diff -Nrcpad gcc-16-20250518/ChangeLog gcc-16-20250525/ChangeLog
*** gcc-16-20250518/ChangeLog	Sun May 18 22:32:06 2025
--- gcc-16-20250525/ChangeLog	Sun May 25 22:32:04 2025
***************
*** 1,3 ****
--- 1,16 ----
+ 2025-05-23  Kishan Parmar  <kishan@linux.ibm.com>
+ 
+ 	* MAINTAINERS: Add myself to write after approval.
+ 
+ 2025-05-23  Dhruv Chawla  <dhruvc@nvidia.com>
+ 
+ 	* MAINTAINERS: Add myself to write after approval and DCO.
+ 
+ 2025-05-21  Stephanos Ioannidis  <root@stephanos.io>
+ 
+ 	* configure.ac: Always add pre-installed heades to search path.
+ 	* configure: Regenerate.
+ 
  2025-05-16  Spencer Abson  <spencer.abson@arm.com>
  
  	* MAINTAINERS: Add myself to write after approval.
diff -Nrcpad gcc-16-20250518/LAST_UPDATED gcc-16-20250525/LAST_UPDATED
*** gcc-16-20250518/LAST_UPDATED	Sun May 18 22:33:30 2025
--- gcc-16-20250525/LAST_UPDATED	Sun May 25 22:32:20 2025
***************
*** 1 ****
! Obtained from git: master revision eb2ea476db2182939f585df7d806225649ee4f62
--- 1 ----
! Obtained from git: master revision 2159f024f63c12fd356748ae8fc106bb9b355688
diff -Nrcpad gcc-16-20250518/MAINTAINERS gcc-16-20250525/MAINTAINERS
*** gcc-16-20250518/MAINTAINERS	Sun May 18 22:32:06 2025
--- gcc-16-20250525/MAINTAINERS	Sun May 25 22:32:04 2025
*************** Stephane Carrez                 ciceron
*** 402,407 ****
--- 402,408 ----
  Gabriel Charette                gchare          <gchare@google.com>
  Arnaud Charlet                  charlet         <charlet@adacore.com>
  Chandra Chavva                  -               <cchavva@redhat.com>
+ Dhruv Chawla                    dhruvc          <dhruvc@nvidia.com>
  Dehao Chen                      dehao           <dehao@google.com>
  Fabien Chêne                    fabien          <fabien@gcc.gnu.org>
  Bin Cheng                       amker           <bin.cheng@linux.alibaba.com>
*************** Maxim Ostapenko                 chefmax
*** 717,722 ****
--- 718,724 ----
  Jeevitha Palanisamy             jeevitha        <jeevitha@linux.ibm.com>
  Patrick Palka                   ppalka          <ppalka@gcc.gnu.org>
  Seongbae Park                   spark           <seongbae.park@gmail.com>
+ Kishan Parmar                   kishan          <kishan@linux.ibm.com>
  Srinath Parvathaneni            sripar01        <srinath.parvathaneni@arm.com>
  Devang Patel                    dpatel          <dpatel@apple.com>
  Andris Pavenis                  andris          <andris.pavenis@iki.fi>
*************** information.
*** 932,937 ****
--- 934,940 ----
  
  
  Soumya AR                                       <soumyaa@nvidia.com>
+ Dhruv Chawla                                    <dhruvc@nvidia.com>
  Juergen Christ                                  <jchrist@linux.ibm.com>
  Giuseppe D'Angelo                               <giuseppe.dangelo@kdab.com>
  Robin Dapp                                      <rdapp.gcc@gmail.com>
diff -Nrcpad gcc-16-20250518/MD5SUMS gcc-16-20250525/MD5SUMS
*** gcc-16-20250518/MD5SUMS	Sun May 18 22:33:38 2025
--- gcc-16-20250525/MD5SUMS	Sun May 25 22:32:24 2025
***************
*** 1,5 ****
  # This file contains the MD5 checksums of the files in the
! # gcc-16-20250518.tar.xz tarball.
  #
  # Besides verifying that all files in the tarball were correctly expanded,
  # it also can be used to determine if any files have changed since the
--- 1,5 ----
  # This file contains the MD5 checksums of the files in the
! # gcc-16-20250525.tar.xz tarball.
  #
  # Besides verifying that all files in the tarball were correctly expanded,
  # it also can be used to determine if any files have changed since the
*************** b8acb527560fc760209d200fcfab8ff4  .githu
*** 21,32 ****
  fe60d87048567d4fe8c8a0ed2448bcc8  COPYING.RUNTIME
  d32239bcb673463ab874e80d47fae504  COPYING3
  6a6a8e020838b23406c81b19c1d46df6  COPYING3.LIB
! 750ee6727a59ccfcd42c7c754a7ffd67  ChangeLog
  fd4ecdf5d672efe2b0e409aca9cf9446  ChangeLog.jit
  09538b708302f1735f6fa05b622ecf5e  ChangeLog.tree-ssa
  24ab760126489e69436a43185dc3d202  INSTALL/README
! 69a78e05dad7ee2d4d1faa09c97dde0e  LAST_UPDATED
! bf48507bebbc2d083f8ff2a5536d4983  MAINTAINERS
  b714b83dd28679b75c5fd3e619d35956  Makefile.def
  9d0808afc70085c5ca8d45062fc59689  Makefile.in
  7c87bc1ac5389b3184deb34c599d184f  Makefile.tpl
--- 21,32 ----
  fe60d87048567d4fe8c8a0ed2448bcc8  COPYING.RUNTIME
  d32239bcb673463ab874e80d47fae504  COPYING3
  6a6a8e020838b23406c81b19c1d46df6  COPYING3.LIB
! 5b0bd2f3846fef147b49d21edfb27410  ChangeLog
  fd4ecdf5d672efe2b0e409aca9cf9446  ChangeLog.jit
  09538b708302f1735f6fa05b622ecf5e  ChangeLog.tree-ssa
  24ab760126489e69436a43185dc3d202  INSTALL/README
! 04e6a407cf82a33adc950af99ab891ed  LAST_UPDATED
! 1fae9b30243be44edfe4dbd7ea871d5f  MAINTAINERS
  b714b83dd28679b75c5fd3e619d35956  Makefile.def
  9d0808afc70085c5ca8d45062fc59689  Makefile.in
  7c87bc1ac5389b3184deb34c599d184f  Makefile.tpl
*************** c37ea1a2f77642729239faeefeabadb1  c++too
*** 46,52 ****
  c64564b7c7563dae5ebe016f340c9cd9  config.guess
  040359150cf11493f973a46d8a25b06b  config.rpath
  111d54aa3a3019adbab413c8fb435f22  config.sub
! 87c303c03b01131d3fbf67b4be4556d4  config/ChangeLog
  e8365ab73da09dccff77a6e2ad006a68  config/acinclude.m4
  e1b259699840442ff915265a77b3a578  config/acx.m4
  6b030f5cf640bdd401ea739f54a667f8  config/asmcfi.m4
--- 46,52 ----
  c64564b7c7563dae5ebe016f340c9cd9  config.guess
  040359150cf11493f973a46d8a25b06b  config.rpath
  111d54aa3a3019adbab413c8fb435f22  config.sub
! f5482e0214c7f58ac6e1b4ca7045bead  config/ChangeLog
  e8365ab73da09dccff77a6e2ad006a68  config/acinclude.m4
  e1b259699840442ff915265a77b3a578  config/acx.m4
  6b030f5cf640bdd401ea739f54a667f8  config/asmcfi.m4
*************** a3bca109766820001668b4d4f41057c6  config
*** 71,76 ****
--- 71,77 ----
  c848c13e0ea39451f067f8d1404d9982  config/bootstrap-lto-locality.mk
  33768879cdb11bf946d977ab6632d169  config/bootstrap-lto-noplugin.mk
  ece3bc716fac1aca84326d40b97a4b4b  config/bootstrap-lto.mk
+ 396cc6dfa851e80723ab6ffc37778a6b  config/bootstrap-native.mk
  f466ea6022e6627a2e3d94bb0cc7eeb9  config/bootstrap-time.mk
  065f6478cf9a6fdc999f666517cfb8b4  config/bootstrap-ubsan.mk
  2ef96b7f5ed3e6a5fd105f2cb18b1887  config/cet.m4
*************** e2dc6b4fd62b77bff96b7951ef74f78f  config
*** 151,159 ****
  7ef51b0adb98e5c5f7aba46d2c7293f1  config/weakref.m4
  0163b672c888aaf1c8ad3e867a0ec9f1  config/zlib.m4
  db74a73c3c9c3cc71edec37c2436e082  config/zstd.m4
! 03e84607a1c4478aa65bd53937ed3aea  configure
! a10daf98a334165ec89e62510a1eb0a0  configure.ac
! b3c924d9b4c64caee2e6d7559e523bb4  contrib/ChangeLog
  5fc435c7928f858246df931ea3f3ece7  contrib/ChangeLog.jit
  7af8d2979bf1a7cfa88e30d05fa22be2  contrib/ChangeLog.tree-ssa
  13605e5ba7b533ecbe3a902b8ebe4079  contrib/analyze_brprob.py
--- 152,160 ----
  7ef51b0adb98e5c5f7aba46d2c7293f1  config/weakref.m4
  0163b672c888aaf1c8ad3e867a0ec9f1  config/zlib.m4
  db74a73c3c9c3cc71edec37c2436e082  config/zstd.m4
! f8cf984b041338224f4741fc5ef0bef6  configure
! 2f2d511befd4187993cfab36cd351319  configure.ac
! 6e5799b7fb0d09afe4d1055df7a1bb5a  contrib/ChangeLog
  5fc435c7928f858246df931ea3f3ece7  contrib/ChangeLog.jit
  7af8d2979bf1a7cfa88e30d05fa22be2  contrib/ChangeLog.tree-ssa
  13605e5ba7b533ecbe3a902b8ebe4079  contrib/analyze_brprob.py
*************** c3217001bd26d7357f97d76467773e6d  contri
*** 184,189 ****
--- 185,191 ----
  3676f3483293ec7cf746b0728e85eb3f  contrib/dg-lint/test-2.c
  5366c5961ca00049e66387009ac4311e  contrib/dg-out-generator.pl
  8d11d67047d66e5a932dfc9ff91893fa  contrib/dglib.pm
+ 1a43c19edffafd7cca44c23265ada323  contrib/diffsummary.py
  5bda781277a8bf1ae8288d346a92cece  contrib/download_prerequisites
  abb4adeec48b5e472bc4fc459600de76  contrib/filter-clang-warnings.py
  332fd0835826d637b5b6cf8db14358a5  contrib/filter_gcc_for_doxygen
*************** a22e70b3f29292d0e628450f4bb11e62  fixinc
*** 514,520 ****
  a916467b91076e631dd8edb7424769c7  gcc/COPYING.LIB
  d32239bcb673463ab874e80d47fae504  gcc/COPYING3
  6a6a8e020838b23406c81b19c1d46df6  gcc/COPYING3.LIB
! 1f8392661ed0dfd1e6677d524d8845f4  gcc/ChangeLog
  51281e73aa07fb62394bd72f3c9299ba  gcc/ChangeLog-1997
  f77af8c9ac412064886b00c5506123b5  gcc/ChangeLog-1998
  00a2e4ead1b289bf69bca0196fed6f9f  gcc/ChangeLog-1999
--- 516,522 ----
  a916467b91076e631dd8edb7424769c7  gcc/COPYING.LIB
  d32239bcb673463ab874e80d47fae504  gcc/COPYING3
  6a6a8e020838b23406c81b19c1d46df6  gcc/COPYING3.LIB
! 0507655c64e71cc84b7c9eb7f1868282  gcc/ChangeLog
  51281e73aa07fb62394bd72f3c9299ba  gcc/ChangeLog-1997
  f77af8c9ac412064886b00c5506123b5  gcc/ChangeLog-1998
  00a2e4ead1b289bf69bca0196fed6f9f  gcc/ChangeLog-1999
*************** fb3fadb88e1d2b3b640cfaaa5ff11780  gcc/Ch
*** 551,569 ****
  3eb07e0b2e542409bf73d359f7f65609  gcc/ChangeLog.ptr
  e13638e26743ba41e6011b76cc00d9a9  gcc/ChangeLog.tree-ssa
  739ab47f6425bcea1d05e4fc0542de54  gcc/ChangeLog.tuples
! fe3d280607c76431fe655254471c72f0  gcc/DATESTAMP
  deb513e591f23901188e22323bd3b1d4  gcc/DEV-PHASE
  eb92e1ff5e982ca07e173e0eb286d243  gcc/FSFChangeLog
  30e1e33411566388b3164558482dc5e6  gcc/FSFChangeLog.10
  36698274bb69e2ada20f5cc434f3caa5  gcc/FSFChangeLog.11
  4dc2573d948287a3722ce977490b026c  gcc/LANGUAGES
! 3be0669d74e7a3a299240fcd4c53411a  gcc/Makefile.in
  ec6799501b2eb2923d5de6a66169dbd2  gcc/ONEWS
  15d6908b4409b0925d9f1c72b56b5cb7  gcc/README.Portability
  cd96bf34cb76c97f86704a59b9ddb18a  gcc/acinclude.m4
  18db4664d7e31002aac43ebcf20e075f  gcc/aclocal.m4
  16a499934b71eb6cf7c0d6899cd6006a  gcc/ada/.gitignore
! 958f4497f92d326a50cab0c4ebe0edb9  gcc/ada/ChangeLog
  c2094c0d3135f9ac89917f162046ee04  gcc/ada/ChangeLog-2001
  fa410b57f5d814d5d3ac3b45f486cdcf  gcc/ada/ChangeLog-2002
  2dbefa7bdc8dc28ec746002028861278  gcc/ada/ChangeLog-2003
--- 553,571 ----
  3eb07e0b2e542409bf73d359f7f65609  gcc/ChangeLog.ptr
  e13638e26743ba41e6011b76cc00d9a9  gcc/ChangeLog.tree-ssa
  739ab47f6425bcea1d05e4fc0542de54  gcc/ChangeLog.tuples
! 7789a8c761f1126a022f72b15db18871  gcc/DATESTAMP
  deb513e591f23901188e22323bd3b1d4  gcc/DEV-PHASE
  eb92e1ff5e982ca07e173e0eb286d243  gcc/FSFChangeLog
  30e1e33411566388b3164558482dc5e6  gcc/FSFChangeLog.10
  36698274bb69e2ada20f5cc434f3caa5  gcc/FSFChangeLog.11
  4dc2573d948287a3722ce977490b026c  gcc/LANGUAGES
! 90d203bb833e9f22ccd67fed734a5bc8  gcc/Makefile.in
  ec6799501b2eb2923d5de6a66169dbd2  gcc/ONEWS
  15d6908b4409b0925d9f1c72b56b5cb7  gcc/README.Portability
  cd96bf34cb76c97f86704a59b9ddb18a  gcc/acinclude.m4
  18db4664d7e31002aac43ebcf20e075f  gcc/aclocal.m4
  16a499934b71eb6cf7c0d6899cd6006a  gcc/ada/.gitignore
! 4505591b551f6e1eab5d9e1198561fb1  gcc/ada/ChangeLog
  c2094c0d3135f9ac89917f162046ee04  gcc/ada/ChangeLog-2001
  fa410b57f5d814d5d3ac3b45f486cdcf  gcc/ada/ChangeLog-2002
  2dbefa7bdc8dc28ec746002028861278  gcc/ada/ChangeLog-2003
*************** ec7cf235c00294fe67198b9bf264f3d9  gcc/ad
*** 837,843 ****
  0cfb73b82bc6277eb801329c392229d2  gcc/ada/freeze.ads
  94e87c9cab4c338fd7a9cd7f89adbc90  gcc/ada/frontend.adb
  6f776be1d84e9d8c996b576c19a4349f  gcc/ada/frontend.ads
! 7d09f66d77b747916fdcfbba221e06d4  gcc/ada/gcc-interface/Make-lang.in
  43779dc97ce084f83c9f5dea1bfcffb4  gcc/ada/gcc-interface/Makefile.in
  b02134e55a04db5c49a710da26b19be1  gcc/ada/gcc-interface/ada-builtin-types.def
  bc1175cb4ea0b9cb5f8751b3f0da7f74  gcc/ada/gcc-interface/ada-builtins.def
--- 839,845 ----
  0cfb73b82bc6277eb801329c392229d2  gcc/ada/freeze.ads
  94e87c9cab4c338fd7a9cd7f89adbc90  gcc/ada/frontend.adb
  6f776be1d84e9d8c996b576c19a4349f  gcc/ada/frontend.ads
! 5a35c64225c4c6aef5080fa37b97e546  gcc/ada/gcc-interface/Make-lang.in
  43779dc97ce084f83c9f5dea1bfcffb4  gcc/ada/gcc-interface/Makefile.in
  b02134e55a04db5c49a710da26b19be1  gcc/ada/gcc-interface/ada-builtin-types.def
  bc1175cb4ea0b9cb5f8751b3f0da7f74  gcc/ada/gcc-interface/ada-builtins.def
*************** f808dbcc1ad6add5a0867c4b3e03fc4d  gcc/bu
*** 3204,3210 ****
  d8ff60ecebd67b2be7141da80578a9ef  gcc/builtins.cc
  d7a735fed7d7781add6ff1f190c2496f  gcc/builtins.def
  bd61b50b47560dc1324bf507bea5d87e  gcc/builtins.h
! f21727cd9fab73dfb7f496681707a696  gcc/c-family/ChangeLog
  ea3fa1f4d7390a105fa3caab4f79aaf7  gcc/c-family/ChangeLog.gimple-classes
  823fe168bb0f63a39de62d9f0251a1b5  gcc/c-family/c-ada-spec.cc
  4e83011bee68d9607834ed5335191d65  gcc/c-family/c-ada-spec.h
--- 3206,3212 ----
  d8ff60ecebd67b2be7141da80578a9ef  gcc/builtins.cc
  d7a735fed7d7781add6ff1f190c2496f  gcc/builtins.def
  bd61b50b47560dc1324bf507bea5d87e  gcc/builtins.h
! 23c67511bb682b5260b02be1aa252dce  gcc/c-family/ChangeLog
  ea3fa1f4d7390a105fa3caab4f79aaf7  gcc/c-family/ChangeLog.gimple-classes
  823fe168bb0f63a39de62d9f0251a1b5  gcc/c-family/c-ada-spec.cc
  4e83011bee68d9607834ed5335191d65  gcc/c-family/c-ada-spec.h
*************** ef8691fea2743b186609ec02d8c35859  gcc/c-
*** 3214,3220 ****
  c6ac8fb15a8d6272184d999f651d660d  gcc/c-family/c-common.h
  1c57db57b8673a678e1501b694ea87e0  gcc/c-family/c-cppbuiltin.cc
  01db2d5cca29943c49bb372f2137d874  gcc/c-family/c-dump.cc
! 53e39536dbd251b4c218e15e99f21a0d  gcc/c-family/c-format.cc
  89a27efffabf06afdd7dee7495d2591c  gcc/c-family/c-format.h
  33e75548501d8294a77fd654bc8d4d39  gcc/c-family/c-gimplify.cc
  4d15aede5a4841d6489aa40ad1304c00  gcc/c-family/c-indentation.cc
--- 3216,3222 ----
  c6ac8fb15a8d6272184d999f651d660d  gcc/c-family/c-common.h
  1c57db57b8673a678e1501b694ea87e0  gcc/c-family/c-cppbuiltin.cc
  01db2d5cca29943c49bb372f2137d874  gcc/c-family/c-dump.cc
! 3406e6deaa6e96339c86962c3c82e169  gcc/c-family/c-format.cc
  89a27efffabf06afdd7dee7495d2591c  gcc/c-family/c-format.h
  33e75548501d8294a77fd654bc8d4d39  gcc/c-family/c-gimplify.cc
  4d15aede5a4841d6489aa40ad1304c00  gcc/c-family/c-indentation.cc
*************** cc50b703ddacf4f5ef66bd38576c5e1f  gcc/cg
*** 3298,3322 ****
  b87eab2b04054f0d3cd20768be99c655  gcc/cgraphclones.cc
  3be8ee84d005d8a1f5a65ed6a7fce76a  gcc/cgraphunit.cc
  70fa61377ff65ad3f25778a40159f510  gcc/cif-code.def
! cdb15177fb54b2bbb9962a4a2014b5c5  gcc/cobol/ChangeLog
  0e25dd48b4c3e56f9d9b604cd8980f36  gcc/cobol/Make-lang.in
  d6e5c9435942e9ec3f1d2e83926b5b0c  gcc/cobol/cbldiag.h
! 0fc59bb3626b6cda209f53824261beb1  gcc/cobol/cdf-copy.cc
  3bb5c2a5f2ca5af128d40c5e880848cf  gcc/cobol/cdf.y
! f0dbfcf1dedffa22b25991dbdc846baf  gcc/cobol/cdfval.h
  77fc5e59eed5f55ff8b66d9138ca6c18  gcc/cobol/cobol-system.h
  8a1232cc40a34e1a92e07d4d85b2e2aa  gcc/cobol/cobol1.cc
  5985e1898b04e553a91bdc474c56311f  gcc/cobol/config-lang.in
  aab9bcdb44bef72e1c3a8cd069bfcccd  gcc/cobol/convert.cc
! 85e293b3cfd63dd6ec31e1b03363d8de  gcc/cobol/copybook.h
  d82104539470e81b006b5f9227229da7  gcc/cobol/dts.h
  cd566058e56e0bdd6d5fc6174d575702  gcc/cobol/except.cc
  9099d4eaec925397d6d3a4d11d080a4c  gcc/cobol/exceptg.h
! e41169e986263d176984bceb2cd04a66  gcc/cobol/gcobc
! d44f9332607dd9c0ad1d7dd811e5a531  gcc/cobol/gcobol.1
  527925049a81a36c06220d368570f55a  gcc/cobol/gcobol.3
  e9f9397b294013c218ab16870d43e8ef  gcc/cobol/gcobolspec.cc
! 86cfe20ef46b0cf116a784f55d6fbb54  gcc/cobol/genapi.cc
  9405cedcadb1d8d4dc1ec68fc2fb0c59  gcc/cobol/genapi.h
  b04330097798bdf9cbc4959b4ecf7ce8  gcc/cobol/gengen.cc
  5a15fbb14271aa588750f652642e3b68  gcc/cobol/gengen.h
--- 3300,3324 ----
  b87eab2b04054f0d3cd20768be99c655  gcc/cgraphclones.cc
  3be8ee84d005d8a1f5a65ed6a7fce76a  gcc/cgraphunit.cc
  70fa61377ff65ad3f25778a40159f510  gcc/cif-code.def
! 1da340c12b96090f0b62deb04dfff7b2  gcc/cobol/ChangeLog
  0e25dd48b4c3e56f9d9b604cd8980f36  gcc/cobol/Make-lang.in
  d6e5c9435942e9ec3f1d2e83926b5b0c  gcc/cobol/cbldiag.h
! 9e7a4b13beb5b83f4daacc78af0ac72d  gcc/cobol/cdf-copy.cc
  3bb5c2a5f2ca5af128d40c5e880848cf  gcc/cobol/cdf.y
! 8cb1f53df078dd651d781e05997ba213  gcc/cobol/cdfval.h
  77fc5e59eed5f55ff8b66d9138ca6c18  gcc/cobol/cobol-system.h
  8a1232cc40a34e1a92e07d4d85b2e2aa  gcc/cobol/cobol1.cc
  5985e1898b04e553a91bdc474c56311f  gcc/cobol/config-lang.in
  aab9bcdb44bef72e1c3a8cd069bfcccd  gcc/cobol/convert.cc
! c667c1d76610da33128e9202898b39ef  gcc/cobol/copybook.h
  d82104539470e81b006b5f9227229da7  gcc/cobol/dts.h
  cd566058e56e0bdd6d5fc6174d575702  gcc/cobol/except.cc
  9099d4eaec925397d6d3a4d11d080a4c  gcc/cobol/exceptg.h
! 24c537bb1367d796de8c91d7fb8ce910  gcc/cobol/gcobc
! 78da9811c8766f6fe50c4c0282cfd56b  gcc/cobol/gcobol.1
  527925049a81a36c06220d368570f55a  gcc/cobol/gcobol.3
  e9f9397b294013c218ab16870d43e8ef  gcc/cobol/gcobolspec.cc
! 9e37c8e8883f3c043bd5bf4392bd91f9  gcc/cobol/genapi.cc
  9405cedcadb1d8d4dc1ec68fc2fb0c59  gcc/cobol/genapi.h
  b04330097798bdf9cbc4959b4ecf7ce8  gcc/cobol/gengen.cc
  5a15fbb14271aa588750f652642e3b68  gcc/cobol/gengen.h
*************** d44e8c86d57fb704b6c1fbab3464fb9a  gcc/co
*** 3329,3348 ****
  2c85ade938027e95c4c411b384f6ad11  gcc/cobol/lang-specs.h
  4ab99742b15962360c2189eb9cdb087c  gcc/cobol/lang.opt
  746a2d46b3bc2a5f5663a9d64a78a674  gcc/cobol/lang.opt.urls
! e0d7a16fdf4749523dfa969aa882d709  gcc/cobol/lexio.cc
  20795df25934313075a740d861e58496  gcc/cobol/lexio.h
! 6add8ee58faad412b514f335c6c38d5c  gcc/cobol/parse.y
! 35404a016051a4bf4b9309fe72f6de1c  gcc/cobol/parse_ante.h
  4d55488629c09ff19bd872e7dd9d0fc7  gcc/cobol/parse_util.h
! adf2e210ca55762410bdf29f664fb01d  gcc/cobol/scan.l
! 06ec1421141ba815740f317c4b5cc19f  gcc/cobol/scan_ante.h
  e15d0bd1bbc8d73dee00f50180bfcb54  gcc/cobol/scan_post.h
  31c4d4468924864effced0de842cfc10  gcc/cobol/show_parse.h
  d75653f25ec3b747265e4ab78aa71521  gcc/cobol/structs.cc
  be06e098e0c2eb8f8ac2f0094bf53181  gcc/cobol/structs.h
! f550a49042ffb223019372e14cc5684c  gcc/cobol/symbols.cc
! 930d109039ba3166fa066b87d043bf86  gcc/cobol/symbols.h
! 036b7c0fd665dd2cee65ec858597b18f  gcc/cobol/symfind.cc
  a7b20717b0839af4783bead169c2ab02  gcc/cobol/token_names.h
  94ee230280ef44983fee5c81648f8669  gcc/cobol/udf/stored-char-length.cbl
  6ba2cbbb6288a394c97e5d88faf5098c  gcc/cobol/util.cc
--- 3331,3350 ----
  2c85ade938027e95c4c411b384f6ad11  gcc/cobol/lang-specs.h
  4ab99742b15962360c2189eb9cdb087c  gcc/cobol/lang.opt
  746a2d46b3bc2a5f5663a9d64a78a674  gcc/cobol/lang.opt.urls
! d4e05726ccfdcf6fa5da466988b55543  gcc/cobol/lexio.cc
  20795df25934313075a740d861e58496  gcc/cobol/lexio.h
! fd5f21d1ea0f5ba2e12955a22e443a58  gcc/cobol/parse.y
! e44d4370366ebe1eb8d69b795d1de676  gcc/cobol/parse_ante.h
  4d55488629c09ff19bd872e7dd9d0fc7  gcc/cobol/parse_util.h
! 5296ce4bd85b19aa8fcfbb6c5df161e7  gcc/cobol/scan.l
! 04b8a11796b1997e1bca2267b95c872c  gcc/cobol/scan_ante.h
  e15d0bd1bbc8d73dee00f50180bfcb54  gcc/cobol/scan_post.h
  31c4d4468924864effced0de842cfc10  gcc/cobol/show_parse.h
  d75653f25ec3b747265e4ab78aa71521  gcc/cobol/structs.cc
  be06e098e0c2eb8f8ac2f0094bf53181  gcc/cobol/structs.h
! 8d15623a479c31a46d282cb6f3847f85  gcc/cobol/symbols.cc
! 378e043a4dcc6e53dfe34adb1407158f  gcc/cobol/symbols.h
! e441ad4a4e4a660cbe2d37713bd9a088  gcc/cobol/symfind.cc
  a7b20717b0839af4783bead169c2ab02  gcc/cobol/token_names.h
  94ee230280ef44983fee5c81648f8669  gcc/cobol/udf/stored-char-length.cbl
  6ba2cbbb6288a394c97e5d88faf5098c  gcc/cobol/util.cc
*************** d0fd2d6b92855f5ea2dcf1212cdff3ec  gcc/co
*** 3355,3361 ****
  f55010fab8b9aabea82c3ac50d031028  gcc/collect2.h
  47b3611844b583f418ce3aaf051c492a  gcc/color-macros.h
  7041e62f0f582b09331732fef4bb9545  gcc/combine-stack-adj.cc
! 1d60d5dffeede460a04cc9dcb0369003  gcc/combine.cc
  2b9ccf7fc2473ef7e36aee9bcf170843  gcc/common.md
  8045185ca8e24e72801a20d223f8095d  gcc/common.opt
  1993ece31020fdc23b391ee45140e8cb  gcc/common.opt.urls
--- 3357,3363 ----
  f55010fab8b9aabea82c3ac50d031028  gcc/collect2.h
  47b3611844b583f418ce3aaf051c492a  gcc/color-macros.h
  7041e62f0f582b09331732fef4bb9545  gcc/combine-stack-adj.cc
! 5d00831740184b5f4f8f133a3a1ffc16  gcc/combine.cc
  2b9ccf7fc2473ef7e36aee9bcf170843  gcc/common.md
  8045185ca8e24e72801a20d223f8095d  gcc/common.opt
  1993ece31020fdc23b391ee45140e8cb  gcc/common.opt.urls
*************** e6e86df919407a02a2bcc6baffb28dd6  gcc/co
*** 3381,3390 ****
  e52e97d4d4876d6657fdd48e9f622383  gcc/common/config/frv/frv-common.cc
  2da12f05a7597886b6b659f44fb2d0b0  gcc/common/config/gcn/gcn-common.cc
  cba8bad9b28e5a0f8934b00becb13d4a  gcc/common/config/h8300/h8300-common.cc
! 7b838bc6221e0cb6ec58686d071843ee  gcc/common/config/i386/cpuinfo.h
! b06faef897df2bc2d0e0e1a477f767c8  gcc/common/config/i386/i386-common.cc
! 319d43918a10f58e085c55aa15f20b48  gcc/common/config/i386/i386-cpuinfo.h
! 905a09c0cc645c808afd0e7038f31aa3  gcc/common/config/i386/i386-isas.h
  2a64c5f639b347964e652ebb1add9831  gcc/common/config/ia64/ia64-common.cc
  94b8ff9b1f75e2aaff5033327ccfb449  gcc/common/config/iq2000/iq2000-common.cc
  fd1d75b5f0b2cfac12e5ed2e83377f77  gcc/common/config/lm32/lm32-common.cc
--- 3383,3392 ----
  e52e97d4d4876d6657fdd48e9f622383  gcc/common/config/frv/frv-common.cc
  2da12f05a7597886b6b659f44fb2d0b0  gcc/common/config/gcn/gcn-common.cc
  cba8bad9b28e5a0f8934b00becb13d4a  gcc/common/config/h8300/h8300-common.cc
! b37309f1b28f107ba1954a2a91a61511  gcc/common/config/i386/cpuinfo.h
! eced44c54b29315b29b920d069a16aad  gcc/common/config/i386/i386-common.cc
! 9578d58dfbd0a39d8cb71180552ad36a  gcc/common/config/i386/i386-cpuinfo.h
! 539245ae5afaff8f57da7ed327bfd7e5  gcc/common/config/i386/i386-isas.h
  2a64c5f639b347964e652ebb1add9831  gcc/common/config/ia64/ia64-common.cc
  94b8ff9b1f75e2aaff5033327ccfb449  gcc/common/config/iq2000/iq2000-common.cc
  fd1d75b5f0b2cfac12e5ed2e83377f77  gcc/common/config/lm32/lm32-common.cc
*************** f842f1b8595f3ac795ba92c2b07085e6  gcc/co
*** 3403,3409 ****
  03a53ecd36b397fbe0846ead66505e2d  gcc/common/config/pa/pa-common.cc
  1fbcfc1a92bb13e4405bc75767cf8a36  gcc/common/config/pdp11/pdp11-common.cc
  7ee5967300d3c96a608eea63008aa893  gcc/common/config/pru/pru-common.cc
! 8fa44c1e552752496b4ba4b17ce64d9a  gcc/common/config/riscv/riscv-common.cc
  8a5a4ee26b110f44497208d1b31e3503  gcc/common/config/riscv/riscv-ext-bitmask.def
  08537bef63b33fd56aeb2a292c9a207a  gcc/common/config/rs6000/rs6000-common.cc
  9ddaceac9f81b4798f64241b273f8e1c  gcc/common/config/rx/rx-common.cc
--- 3405,3411 ----
  03a53ecd36b397fbe0846ead66505e2d  gcc/common/config/pa/pa-common.cc
  1fbcfc1a92bb13e4405bc75767cf8a36  gcc/common/config/pdp11/pdp11-common.cc
  7ee5967300d3c96a608eea63008aa893  gcc/common/config/pru/pru-common.cc
! cdbda143d3c43b1cdf4492aca972d5d2  gcc/common/config/riscv/riscv-common.cc
  8a5a4ee26b110f44497208d1b31e3503  gcc/common/config/riscv/riscv-ext-bitmask.def
  08537bef63b33fd56aeb2a292c9a207a  gcc/common/config/rs6000/rs6000-common.cc
  9ddaceac9f81b4798f64241b273f8e1c  gcc/common/config/rx/rx-common.cc
*************** b5a916bb9dd788754ac9e4ad7174ee74  gcc/co
*** 3418,3424 ****
  b209201703dd766f76ff5e16b99191e5  gcc/compare-elim.cc
  618780fbce0ce0cb6f9b86e079ce4e54  gcc/conditions.h
  1b4bc58c657bf910929d06d51bc8fa6c  gcc/config.build
! a0c14a7dd75780980d7e89625c260a33  gcc/config.gcc
  053bb14b428d0f073932e88b9a29a8bd  gcc/config.host
  1d528f9807496430cc01191e59f745d3  gcc/config.in
  8e697813dc96ca90f5d0f4c196efe2cc  gcc/config/README
--- 3420,3426 ----
  b209201703dd766f76ff5e16b99191e5  gcc/compare-elim.cc
  618780fbce0ce0cb6f9b86e079ce4e54  gcc/conditions.h
  1b4bc58c657bf910929d06d51bc8fa6c  gcc/config.build
! baea24fe2fdaa63d9f58bc74893116f8  gcc/config.gcc
  053bb14b428d0f073932e88b9a29a8bd  gcc/config.host
  1d528f9807496430cc01191e59f745d3  gcc/config.in
  8e697813dc96ca90f5d0f4c196efe2cc  gcc/config/README
*************** e2d80b89552da0c6b4cb6bede3b2e573  gcc/co
*** 3473,3485 ****
  2578221253cb8c19e9f778140a8cf9af  gcc/config/aarch64/aarch64-sve-builtins.cc
  30d08305d5bc784af521254aea449949  gcc/config/aarch64/aarch64-sve-builtins.def
  5ef25fd86c1c16a4a6fb3f74e12802b4  gcc/config/aarch64/aarch64-sve-builtins.h
! ccb1f3e2a01fe07be7feaab29bf773d9  gcc/config/aarch64/aarch64-sve.md
! ba46ae529f856e893a1e7b589bd02f1a  gcc/config/aarch64/aarch64-sve2.md
  805529fa07916adcabb727f19ebd8dd2  gcc/config/aarch64/aarch64-sys-regs.def
  065e0643d90a8831e9495b5ce2c12b0d  gcc/config/aarch64/aarch64-tune.md
  06480b67fa44a0b9fa7de2ed778a3df9  gcc/config/aarch64/aarch64-tuning-flags.def
! a2493e870eb12f5d646c24f2949e4cd3  gcc/config/aarch64/aarch64-vxworks.h
! e3cae0fe7f7009e12da032f7fc2f0c56  gcc/config/aarch64/aarch64.cc
  4c2226a017b612867a61db1f7929ad43  gcc/config/aarch64/aarch64.h
  71f148c60e64686f63307ac425ac331d  gcc/config/aarch64/aarch64.md
  84c23cd68c90a9be4b986aa7009ba1c9  gcc/config/aarch64/aarch64.opt
--- 3475,3487 ----
  2578221253cb8c19e9f778140a8cf9af  gcc/config/aarch64/aarch64-sve-builtins.cc
  30d08305d5bc784af521254aea449949  gcc/config/aarch64/aarch64-sve-builtins.def
  5ef25fd86c1c16a4a6fb3f74e12802b4  gcc/config/aarch64/aarch64-sve-builtins.h
! 9f3eb88ee9eb2b0790e38fde3982c230  gcc/config/aarch64/aarch64-sve.md
! 5fadf27df621c41bae0181b584bb27f0  gcc/config/aarch64/aarch64-sve2.md
  805529fa07916adcabb727f19ebd8dd2  gcc/config/aarch64/aarch64-sys-regs.def
  065e0643d90a8831e9495b5ce2c12b0d  gcc/config/aarch64/aarch64-tune.md
  06480b67fa44a0b9fa7de2ed778a3df9  gcc/config/aarch64/aarch64-tuning-flags.def
! a5cfcce7c9dd86a597161f8bde3497bc  gcc/config/aarch64/aarch64-vxworks.h
! 02703f37fbb7954c3fc6c91f3e54e50a  gcc/config/aarch64/aarch64.cc
  4c2226a017b612867a61db1f7929ad43  gcc/config/aarch64/aarch64.h
  71f148c60e64686f63307ac425ac331d  gcc/config/aarch64/aarch64.md
  84c23cd68c90a9be4b986aa7009ba1c9  gcc/config/aarch64/aarch64.opt
*************** e432241ef743dc9fad65a3e982e51711  gcc/co
*** 3720,3726 ****
  f208fab795fa9231cb51c748bd50e7e5  gcc/config/arm/netbsd-eabi.h
  79c1c27fe924ef728f21bd95a8c3ea71  gcc/config/arm/netbsd-elf.h
  8f026aba2fb3043f536516c1ed3776c7  gcc/config/arm/parsecpu.awk
! 134342ef2be8d21823594ff1dd4221f9  gcc/config/arm/predicates.md
  1f3ea8d6e519c40935905506e989956d  gcc/config/arm/rtems.h
  708681c9ad5a879b29922f565c5b60e5  gcc/config/arm/semi.h
  ed31ef487dcad82d59af7752f594a2cf  gcc/config/arm/symbian.h
--- 3722,3728 ----
  f208fab795fa9231cb51c748bd50e7e5  gcc/config/arm/netbsd-eabi.h
  79c1c27fe924ef728f21bd95a8c3ea71  gcc/config/arm/netbsd-elf.h
  8f026aba2fb3043f536516c1ed3776c7  gcc/config/arm/parsecpu.awk
! 01640d955417b5775f509bc99bca0857  gcc/config/arm/predicates.md
  1f3ea8d6e519c40935905506e989956d  gcc/config/arm/rtems.h
  708681c9ad5a879b29922f565c5b60e5  gcc/config/arm/semi.h
  ed31ef487dcad82d59af7752f594a2cf  gcc/config/arm/symbian.h
*************** e881567a284d0c4c6fd23ecaecaa29f7  gcc/co
*** 4062,4108 ****
  d5344f5586a4fdddcf32cfad79672651  gcc/config/i386/athlon.md
  c7639653fc509c53955783e5c3d3ed63  gcc/config/i386/atom.md
  e4ad129bfdb387d691c45180574d648e  gcc/config/i386/att.h
! 530845165e814163a34b6e6782763ea6  gcc/config/i386/avx10_2-512bf16intrin.h
! ecc1c16f801882fa2e1ed99c97694993  gcc/config/i386/avx10_2-512convertintrin.h
! 36c896a4416082bcb046eb2b200a71c3  gcc/config/i386/avx10_2-512mediaintrin.h
! c2d107314aa5790478bb819993a09aa9  gcc/config/i386/avx10_2-512minmaxintrin.h
! a9c0fdd5dbcb4b5619b2b59aff7f21ff  gcc/config/i386/avx10_2-512satcvtintrin.h
! d9fb23a5076ec2994e9413c0c6ad9627  gcc/config/i386/avx10_2bf16intrin.h
! c2a3fe52895b1689c1c46af985a10daa  gcc/config/i386/avx10_2convertintrin.h
  284b65d9f14985fcf610d8d1a59a3b88  gcc/config/i386/avx10_2copyintrin.h
! e982b5c4c994f88d7dbf190bc95d301a  gcc/config/i386/avx10_2mediaintrin.h
! 93ae3650d874a59c2d485f29e70de7c3  gcc/config/i386/avx10_2minmaxintrin.h
! 76fca18019ab697cc45565b2a2943e86  gcc/config/i386/avx10_2satcvtintrin.h
  3f8272d8581e1bde11dd3f83be612b91  gcc/config/i386/avx2intrin.h
  fe68438cc28695e7cdc08fb1954473a6  gcc/config/i386/avx5124fmapsintrin.h
  269bc88329fe3299cb64cf24f0f85b4a  gcc/config/i386/avx5124vnniwintrin.h
! 80ead52d90457a96977d9482f1254b8a  gcc/config/i386/avx512bf16intrin.h
! e9b9358b628e4040b334ff032d0cb784  gcc/config/i386/avx512bf16vlintrin.h
! a9963c0b128642f52978c8cb2d32a68c  gcc/config/i386/avx512bitalgintrin.h
! c1fc31ec69b0065086d103b08aca2f23  gcc/config/i386/avx512bitalgvlintrin.h
! 546c407b866a77d9240a3a5727b48ec3  gcc/config/i386/avx512bwintrin.h
! ae1b4c6f7035a7fc66f800cdedd78c5e  gcc/config/i386/avx512cdintrin.h
! fb2e991ddb8de2529d8960917b1cc83d  gcc/config/i386/avx512dqintrin.h
  05b3938836c9d1ace98da5f3d10ae80b  gcc/config/i386/avx512erintrin.h
! 72a4402f7b627fc345c910ea9995fc17  gcc/config/i386/avx512fintrin.h
! ae7f11115b7c5e36ce7237c09c80809b  gcc/config/i386/avx512fp16intrin.h
! acb15109c41ed9f0e033dcd858cadf41  gcc/config/i386/avx512fp16vlintrin.h
! 647554a4a9e084e9fe896d356d43d103  gcc/config/i386/avx512ifmaintrin.h
! 300920112d2fe5bdee006dddf5624253  gcc/config/i386/avx512ifmavlintrin.h
  3f0e65318cf0d058fa5cf1169a299797  gcc/config/i386/avx512pfintrin.h
! 33a531dc31ce0d1c85f5f8c22ca63320  gcc/config/i386/avx512vbmi2intrin.h
! 02eabd21f8dab7e2b4b03ff027ae918e  gcc/config/i386/avx512vbmi2vlintrin.h
! a95e559cafcbe1707116b6aaccee4cb7  gcc/config/i386/avx512vbmiintrin.h
! 2df836c25fd2c0499d2ebcc4536111c8  gcc/config/i386/avx512vbmivlintrin.h
! 84d3ca871407c95e349add7bfe30992f  gcc/config/i386/avx512vlbwintrin.h
! be67a6aa9595b3464c385b45434405f6  gcc/config/i386/avx512vldqintrin.h
! 15504f73f1b3d9c979c60a7310d6e49d  gcc/config/i386/avx512vlintrin.h
! fb58bf09bd9dd3cefb0ec1bd2deb7a81  gcc/config/i386/avx512vnniintrin.h
! ce066eeb43746666f7e3e5188c11e95d  gcc/config/i386/avx512vnnivlintrin.h
! ead9494b72066feb1de3238755795127  gcc/config/i386/avx512vp2intersectintrin.h
! f063234c437657749130fe13b8e8abfd  gcc/config/i386/avx512vp2intersectvlintrin.h
! cadf5277c07439c1a3607114fe438249  gcc/config/i386/avx512vpopcntdqintrin.h
! 42dbd0c7fe569ba29707bf1304978d08  gcc/config/i386/avx512vpopcntdqvlintrin.h
  494d53ace84e57b34fe580b6278043f7  gcc/config/i386/avxifmaintrin.h
  4816ed469267de0a8cb214de7fe772ff  gcc/config/i386/avxintrin.h
  37040c1c84cf60b51c61056a8dc8ff8b  gcc/config/i386/avxmath.h
--- 4064,4105 ----
  d5344f5586a4fdddcf32cfad79672651  gcc/config/i386/athlon.md
  c7639653fc509c53955783e5c3d3ed63  gcc/config/i386/atom.md
  e4ad129bfdb387d691c45180574d648e  gcc/config/i386/att.h
! 4d7e33724e59f6e1b2ece3d783b6f148  gcc/config/i386/avx10_2bf16intrin.h
! 90f2d1436ca0d98dd30c10d69045883e  gcc/config/i386/avx10_2convertintrin.h
  284b65d9f14985fcf610d8d1a59a3b88  gcc/config/i386/avx10_2copyintrin.h
! 478199ec3a1ffbcce3526921dd56ba5e  gcc/config/i386/avx10_2mediaintrin.h
! a728d38fca57743f95169d8fcf6922c1  gcc/config/i386/avx10_2minmaxintrin.h
! 00ab667a2196e1cb5f09738a1a8e04e4  gcc/config/i386/avx10_2satcvtintrin.h
  3f8272d8581e1bde11dd3f83be612b91  gcc/config/i386/avx2intrin.h
  fe68438cc28695e7cdc08fb1954473a6  gcc/config/i386/avx5124fmapsintrin.h
  269bc88329fe3299cb64cf24f0f85b4a  gcc/config/i386/avx5124vnniwintrin.h
! 95f2f9caf84c6d824ef09104e7c44334  gcc/config/i386/avx512bf16intrin.h
! bc9196fc44f5c18cc9c742b908853b01  gcc/config/i386/avx512bf16vlintrin.h
! 1c696fd17531ec6e57128c367d20a59e  gcc/config/i386/avx512bitalgintrin.h
! 5bdbd6274d160a8302d228f7291c70b4  gcc/config/i386/avx512bitalgvlintrin.h
! a8ab654c725276de489d77af27ca6be2  gcc/config/i386/avx512bwintrin.h
! 8e8fb51bdc761dc7d57ebd1ec6d7e1cf  gcc/config/i386/avx512cdintrin.h
! b1110d9f8f990239ca4006510e7e12a2  gcc/config/i386/avx512dqintrin.h
  05b3938836c9d1ace98da5f3d10ae80b  gcc/config/i386/avx512erintrin.h
! b45efcb7bbc1904be5aee344403fd028  gcc/config/i386/avx512fintrin.h
! c553205d2953756b12b27e68d83e31f3  gcc/config/i386/avx512fp16intrin.h
! eab78c440059749b0f88d6998ce6ec03  gcc/config/i386/avx512fp16vlintrin.h
! 8db7287cb22353e534be8e59990bbbf6  gcc/config/i386/avx512ifmaintrin.h
! 49b61b9a5cd64ae7b8fe857758184f6b  gcc/config/i386/avx512ifmavlintrin.h
  3f0e65318cf0d058fa5cf1169a299797  gcc/config/i386/avx512pfintrin.h
! 3d2ed7e22f260573733577179c0c886f  gcc/config/i386/avx512vbmi2intrin.h
! 906f1dffaf28a8e9e3ed28852ef3c7ea  gcc/config/i386/avx512vbmi2vlintrin.h
! f961e5e1a5c5cd9a30adf8c133be2e31  gcc/config/i386/avx512vbmiintrin.h
! d86e456ce81f995a9f879aa5e5122be7  gcc/config/i386/avx512vbmivlintrin.h
! 0da09182c536df3d17a93e5d3588b470  gcc/config/i386/avx512vlbwintrin.h
! 697adaaa965dbb9eda7484d5d0df5a91  gcc/config/i386/avx512vldqintrin.h
! 41cf60f549c8297984f2db1ae269d2fe  gcc/config/i386/avx512vlintrin.h
! e3b48920935563cf7f55321d332e3983  gcc/config/i386/avx512vnniintrin.h
! 5b75942169e2dc30d4e1c5040d4b42f0  gcc/config/i386/avx512vnnivlintrin.h
! 7c07b1e91dc8ce5e3f251ab94ade3acf  gcc/config/i386/avx512vp2intersectintrin.h
! 72e2fa1588751bda6d28de5199836701  gcc/config/i386/avx512vp2intersectvlintrin.h
! 88068a98b8d8d2785c87032c5e4d76dd  gcc/config/i386/avx512vpopcntdqintrin.h
! d13f2af3d66b0378f5787df7be22f666  gcc/config/i386/avx512vpopcntdqvlintrin.h
  494d53ace84e57b34fe580b6278043f7  gcc/config/i386/avxifmaintrin.h
  4816ed469267de0a8cb214de7fe772ff  gcc/config/i386/avxintrin.h
  37040c1c84cf60b51c61056a8dc8ff8b  gcc/config/i386/avxmath.h
*************** ed2254bdda3903cf7bffcad423af98ae  gcc/co
*** 4131,4137 ****
  3880d2a102ee1c35b73e26dea425f8ed  gcc/config/i386/cpuid.h
  f700a1d35423658eaa2b4908da695bda  gcc/config/i386/cross-stdarg.h
  82964c7428d66bf1874c63a65b858957  gcc/config/i386/crtdll.h
! a88cd1f0f7f1bf0a6d51c7239f2cf7a2  gcc/config/i386/cygming.h
  f2a2f556815a6dc38e47cca165d51ea3  gcc/config/i386/cygwin-stdint.h
  1868c3b9e51f09941105430ebd8c2286  gcc/config/i386/cygwin-w64.h
  47570db058e06dc2ab076ed2f9cf4242  gcc/config/i386/cygwin.h
--- 4128,4134 ----
  3880d2a102ee1c35b73e26dea425f8ed  gcc/config/i386/cpuid.h
  f700a1d35423658eaa2b4908da695bda  gcc/config/i386/cross-stdarg.h
  82964c7428d66bf1874c63a65b858957  gcc/config/i386/crtdll.h
! f8f2f3d70464037d7bd8bae81910ae7f  gcc/config/i386/cygming.h
  f2a2f556815a6dc38e47cca165d51ea3  gcc/config/i386/cygwin-stdint.h
  1868c3b9e51f09941105430ebd8c2286  gcc/config/i386/cygwin-w64.h
  47570db058e06dc2ab076ed2f9cf4242  gcc/config/i386/cygwin.h
*************** a2bf0873375fc2ab681bcd55a2b23e26  gcc/co
*** 4146,4152 ****
  a5346c37d189bcadf27fd946fe2c2566  gcc/config/i386/djgpp.opt
  1b346c8cab1daa697ecd6c31e8e0e1d5  gcc/config/i386/djgpp.opt.urls
  0ada511dcea9cb884e7aed714cecb141  gcc/config/i386/dragonfly.h
! fee6d2534a6e114692c649906a840579  gcc/config/i386/driver-i386.cc
  8db059b2a4621231dcdc591159eace91  gcc/config/i386/driver-mingw32.cc
  436804c1d1ef71b2a318f01e7e91c190  gcc/config/i386/emmintrin.h
  def0edea16aac07cf3e0e7d2daf27455  gcc/config/i386/enqcmdintrin.h
--- 4143,4149 ----
  a5346c37d189bcadf27fd946fe2c2566  gcc/config/i386/djgpp.opt
  1b346c8cab1daa697ecd6c31e8e0e1d5  gcc/config/i386/djgpp.opt.urls
  0ada511dcea9cb884e7aed714cecb141  gcc/config/i386/dragonfly.h
! ed4eda2945e84d0efb4049e23cdf06d9  gcc/config/i386/driver-i386.cc
  8db059b2a4621231dcdc591159eace91  gcc/config/i386/driver-mingw32.cc
  436804c1d1ef71b2a318f01e7e91c190  gcc/config/i386/emmintrin.h
  def0edea16aac07cf3e0e7d2daf27455  gcc/config/i386/enqcmdintrin.h
*************** e108c439db2df07c2f3568b86334ec16  gcc/co
*** 4159,4165 ****
  633192932be295b101e6b91080050160  gcc/config/i386/gas.h
  23aca983be5fc469ede4a142e9209e33  gcc/config/i386/gcc-auto-profile
  cf7550e185f085130597d96f3f750f56  gcc/config/i386/geode.md
! e3e4c1c0ab1eada4ce85ea1b7027b980  gcc/config/i386/gfniintrin.h
  880c7b716fd97054162f5aa17551d9fb  gcc/config/i386/glm.md
  e8c6dfb76bfeef3e0c5e0213e90b208e  gcc/config/i386/gmm_malloc.h
  5b54bf669fa632b792f0126b87c43855  gcc/config/i386/gnu-property.cc
--- 4156,4162 ----
  633192932be295b101e6b91080050160  gcc/config/i386/gas.h
  23aca983be5fc469ede4a142e9209e33  gcc/config/i386/gcc-auto-profile
  cf7550e185f085130597d96f3f750f56  gcc/config/i386/geode.md
! 0fa60b566e6b6bb6418eccdb74f0fd79  gcc/config/i386/gfniintrin.h
  880c7b716fd97054162f5aa17551d9fb  gcc/config/i386/glm.md
  e8c6dfb76bfeef3e0c5e0213e90b208e  gcc/config/i386/gmm_malloc.h
  5b54bf669fa632b792f0126b87c43855  gcc/config/i386/gnu-property.cc
*************** ebf8fdac06861901e2744eb4d97b15c5  gcc/co
*** 4175,4209 ****
  c527fd639b424e1e0a95494e13e8cad2  gcc/config/i386/hresetintrin.h
  597ec35a360b8b37f5d1e4483b508834  gcc/config/i386/i386-builtin-types.awk
  5090ae3207d0bedc79ecdcec7c2cb71b  gcc/config/i386/i386-builtin-types.def
! 5d41403b2bcce8b60a14478d49fc1d63  gcc/config/i386/i386-builtin.def
! e772636bf04161d74c6568f788415fe3  gcc/config/i386/i386-builtins.cc
  d3fb594d11281112ff8d8f304a000c4e  gcc/config/i386/i386-builtins.h
! b1d3b888c9cd80df50837a2c205587f2  gcc/config/i386/i386-c.cc
  54909bb70e074c14dcf4499a5baedc54  gcc/config/i386/i386-d.cc
  172dcd61afc5800b61ebb688838d9adc  gcc/config/i386/i386-d.h
! a1dfdb55f640d8ab83744394b890ee36  gcc/config/i386/i386-expand.cc
  c9c3969c00808c9b6809fbeab3e4a1d2  gcc/config/i386/i386-expand.h
  a2d9d361545bc99dfd0850cfdf4008c1  gcc/config/i386/i386-features.cc
  1ee34fa5f2ae92fd7d48419d8fc529f8  gcc/config/i386/i386-features.h
! 6eb6541c33da88d0910200287b50cdff  gcc/config/i386/i386-isa.def
  795643c7d23acf02568d7fa7acad0138  gcc/config/i386/i386-modes.def
! a97f792ecc42136eee12cf1271ed8254  gcc/config/i386/i386-options.cc
  08c877d750ab52ddb4fe7c99c90d62de  gcc/config/i386/i386-options.h
  02c486451c524cfc143358e07b88cd70  gcc/config/i386/i386-opts.h
  2b4efb0edf861dd06ddc1445aa9e4d05  gcc/config/i386/i386-passes.def
! 7dd71be4a8025886ac81f45c0080cf30  gcc/config/i386/i386-protos.h
  5b778b3296ea91dab0ca82338ca6828d  gcc/config/i386/i386-rust-and-jit.inc
  b19c27e8a900f9eeb7d73e2bb4b8d313  gcc/config/i386/i386-rust.cc
  24065393854cd1e08e3285bd707210fe  gcc/config/i386/i386-rust.h
! dad57426fb9648de613243577895ec79  gcc/config/i386/i386.cc
! e3623d578e96daf8701066579cfb6dd7  gcc/config/i386/i386.h
! 16210ad84699ffa38621d9d560fd063f  gcc/config/i386/i386.md
! ea8b7d9e98fea8671919d0f7fad86757  gcc/config/i386/i386.opt
! 56dd2039e03b3ae92142eb68be464b98  gcc/config/i386/i386.opt.urls
  f22876926ff4a2cb67b105ac266c72ea  gcc/config/i386/i386elf.h
  12088706f0584b21b2bf165c3cde88e8  gcc/config/i386/ia32intrin.h
  116503ecbb821bb13293049d85a641f9  gcc/config/i386/iamcu.h
! d12d9311d16a9670fc2aedc12471da02  gcc/config/i386/immintrin.h
  619372cf439740085d314ec3bd4aaef7  gcc/config/i386/k6.md
  f25ac919a919b558d8b3364eb84ea8d0  gcc/config/i386/keylockerintrin.h
  dea7969b20f10da9e23e939ae4566e50  gcc/config/i386/kfreebsd-gnu.h
--- 4172,4206 ----
  c527fd639b424e1e0a95494e13e8cad2  gcc/config/i386/hresetintrin.h
  597ec35a360b8b37f5d1e4483b508834  gcc/config/i386/i386-builtin-types.awk
  5090ae3207d0bedc79ecdcec7c2cb71b  gcc/config/i386/i386-builtin-types.def
! 81059d1444982c18f0d455534dec5fa5  gcc/config/i386/i386-builtin.def
! 652c102e7218f6248806f6cfbae988ed  gcc/config/i386/i386-builtins.cc
  d3fb594d11281112ff8d8f304a000c4e  gcc/config/i386/i386-builtins.h
! a4a1a27264871bfba9de0f4fbdb4f3ac  gcc/config/i386/i386-c.cc
  54909bb70e074c14dcf4499a5baedc54  gcc/config/i386/i386-d.cc
  172dcd61afc5800b61ebb688838d9adc  gcc/config/i386/i386-d.h
! 42e783c69179913641c796350a28c8be  gcc/config/i386/i386-expand.cc
  c9c3969c00808c9b6809fbeab3e4a1d2  gcc/config/i386/i386-expand.h
  a2d9d361545bc99dfd0850cfdf4008c1  gcc/config/i386/i386-features.cc
  1ee34fa5f2ae92fd7d48419d8fc529f8  gcc/config/i386/i386-features.h
! 66732512f01bad0bbb26cb3c09ec773e  gcc/config/i386/i386-isa.def
  795643c7d23acf02568d7fa7acad0138  gcc/config/i386/i386-modes.def
! ae55d83d5b332e663522f2352f5a3282  gcc/config/i386/i386-options.cc
  08c877d750ab52ddb4fe7c99c90d62de  gcc/config/i386/i386-options.h
  02c486451c524cfc143358e07b88cd70  gcc/config/i386/i386-opts.h
  2b4efb0edf861dd06ddc1445aa9e4d05  gcc/config/i386/i386-passes.def
! 8c6095a5b42bb540cec543f02f62b2e8  gcc/config/i386/i386-protos.h
  5b778b3296ea91dab0ca82338ca6828d  gcc/config/i386/i386-rust-and-jit.inc
  b19c27e8a900f9eeb7d73e2bb4b8d313  gcc/config/i386/i386-rust.cc
  24065393854cd1e08e3285bd707210fe  gcc/config/i386/i386-rust.h
! 78d20fa951c51eb623997a6948444b3d  gcc/config/i386/i386.cc
! 12bd0bfd0392d37d28f0d3a075c22b32  gcc/config/i386/i386.h
! 8a6e365060f13dd33aedf4d0582a8b82  gcc/config/i386/i386.md
! 23985b411cb15228b631691265bfefe9  gcc/config/i386/i386.opt
! 59cb9adff8fe9d24eed1cfac0c5bf62c  gcc/config/i386/i386.opt.urls
  f22876926ff4a2cb67b105ac266c72ea  gcc/config/i386/i386elf.h
  12088706f0584b21b2bf165c3cde88e8  gcc/config/i386/ia32intrin.h
  116503ecbb821bb13293049d85a641f9  gcc/config/i386/iamcu.h
! c6ca30784c5f9b9bba1468fd43cc6d35  gcc/config/i386/immintrin.h
  619372cf439740085d314ec3bd4aaef7  gcc/config/i386/k6.md
  f25ac919a919b558d8b3364eb84ea8d0  gcc/config/i386/keylockerintrin.h
  dea7969b20f10da9e23e939ae4566e50  gcc/config/i386/kfreebsd-gnu.h
*************** fc41e4ebf77dd1f54ddeec4e60428d5e  gcc/co
*** 4242,4248 ****
  1d9e8c2f64fa31f36bfe9ac83a296943  gcc/config/i386/pmmintrin.h
  62337355ef8c4334a0cc9c1db0cfc0da  gcc/config/i386/popcntintrin.h
  d17b84bc85c341e7f386b3b24b231070  gcc/config/i386/ppro.md
! d6bd6278617fe9d514e6ef828650ca74  gcc/config/i386/predicates.md
  e10e34eef814ce6c5e09777d378d36d3  gcc/config/i386/prfchiintrin.h
  eed7a3601ce61f497dcfc5655e5da7a6  gcc/config/i386/prfchwintrin.h
  bc11b09d2de8ba6b9ec2392f1cebdbd9  gcc/config/i386/raointintrin.h
--- 4239,4245 ----
  1d9e8c2f64fa31f36bfe9ac83a296943  gcc/config/i386/pmmintrin.h
  62337355ef8c4334a0cc9c1db0cfc0da  gcc/config/i386/popcntintrin.h
  d17b84bc85c341e7f386b3b24b231070  gcc/config/i386/ppro.md
! 9c85851b72f0bbb06a73847971935906  gcc/config/i386/predicates.md
  e10e34eef814ce6c5e09777d378d36d3  gcc/config/i386/prfchiintrin.h
  eed7a3601ce61f497dcfc5655e5da7a6  gcc/config/i386/prfchwintrin.h
  bc11b09d2de8ba6b9ec2392f1cebdbd9  gcc/config/i386/raointintrin.h
*************** de4e89bc042c6bc7eb093bda5d33a266  gcc/co
*** 4260,4266 ****
  380f2e50c7d803059b0e7617da00460f  gcc/config/i386/sm4intrin.h
  a24296639492577352dd1309b136bc9a  gcc/config/i386/smmintrin.h
  f98c4d94bf04187a2905e9f4ce7d589b  gcc/config/i386/sol2.h
! 3bd09bc92c0efa4720dfce67cbcf0ea9  gcc/config/i386/sse.md
  7c6ff828c11c2892168a2e450559dcb6  gcc/config/i386/ssemath.h
  7ada9f54207701e1d29fd03ea990e163  gcc/config/i386/stringop.def
  9f75a2e9a9bf20db0bef264cabe77a29  gcc/config/i386/subst.md
--- 4257,4263 ----
  380f2e50c7d803059b0e7617da00460f  gcc/config/i386/sm4intrin.h
  a24296639492577352dd1309b136bc9a  gcc/config/i386/smmintrin.h
  f98c4d94bf04187a2905e9f4ce7d589b  gcc/config/i386/sol2.h
! 6439dd83f5a5ec6d9f8e6e803e561b6e  gcc/config/i386/sse.md
  7c6ff828c11c2892168a2e450559dcb6  gcc/config/i386/ssemath.h
  7ada9f54207701e1d29fd03ea990e163  gcc/config/i386/stringop.def
  9f75a2e9a9bf20db0bef264cabe77a29  gcc/config/i386/subst.md
*************** a9a16c9a0392331206ab87b0f5ada2a4  gcc/co
*** 4294,4301 ****
  63bbd60b280c8122cecb0a068842e3a1  gcc/config/i386/unix.h
  3ac34e7abde394a27cd919a4963c7165  gcc/config/i386/usermsrintrin.h
  81edd33206e44c8dbcd4165f97407774  gcc/config/i386/utf8-mingw32.rc
! bb7fbe1711b8d69830d191e068afd925  gcc/config/i386/vaesintrin.h
! 224c0033cf3aafdb6428207c347474da  gcc/config/i386/vpclmulqdqintrin.h
  4087526e72b1416518a691cd91b2ccf2  gcc/config/i386/vxworks.h
  57e5a1fc82f45eb8a7bd1ab0cfdc7da0  gcc/config/i386/vxworksae.h
  3b21f19e6c48a18aad5fd22fb4332936  gcc/config/i386/waitpkgintrin.h
--- 4291,4298 ----
  63bbd60b280c8122cecb0a068842e3a1  gcc/config/i386/unix.h
  3ac34e7abde394a27cd919a4963c7165  gcc/config/i386/usermsrintrin.h
  81edd33206e44c8dbcd4165f97407774  gcc/config/i386/utf8-mingw32.rc
! 008a375a5edb8c9238fcea9c44eebe0c  gcc/config/i386/vaesintrin.h
! 5f34b2b553cd11dcb08206e8d64338fe  gcc/config/i386/vpclmulqdqintrin.h
  4087526e72b1416518a691cd91b2ccf2  gcc/config/i386/vxworks.h
  57e5a1fc82f45eb8a7bd1ab0cfdc7da0  gcc/config/i386/vxworksae.h
  3b21f19e6c48a18aad5fd22fb4332936  gcc/config/i386/waitpkgintrin.h
*************** d2676839c4d7a7bcd706a386c029aea2  gcc/co
*** 4537,4543 ****
  cd06662d679aac52aa61b8507723384a  gcc/config/microblaze/linux.h
  9bc1818e3b430b758bafdf04bac27f5b  gcc/config/microblaze/microblaze-c.cc
  c1cdfa70252d5e45a9df69ddc7a1ddcb  gcc/config/microblaze/microblaze-protos.h
! fb4fce2ce2666749d7629dcae411e92d  gcc/config/microblaze/microblaze.cc
  0a4fb603eb9a1c6e31bb8fa7e38b16d1  gcc/config/microblaze/microblaze.h
  b3a2d37f3594f70e239fba70728cc641  gcc/config/microblaze/microblaze.md
  3da1e85fbc11c0a5b746cb77b96a06f3  gcc/config/microblaze/microblaze.opt
--- 4534,4540 ----
  cd06662d679aac52aa61b8507723384a  gcc/config/microblaze/linux.h
  9bc1818e3b430b758bafdf04bac27f5b  gcc/config/microblaze/microblaze-c.cc
  c1cdfa70252d5e45a9df69ddc7a1ddcb  gcc/config/microblaze/microblaze-protos.h
! 4c138f09ea3287125c33d2faf8f2ffa3  gcc/config/microblaze/microblaze.cc
  0a4fb603eb9a1c6e31bb8fa7e38b16d1  gcc/config/microblaze/microblaze.h
  b3a2d37f3594f70e239fba70728cc641  gcc/config/microblaze/microblaze.md
  3da1e85fbc11c0a5b746cb77b96a06f3  gcc/config/microblaze/microblaze.opt
*************** ebf8910d051b106d1df6e35d39dc1eac  gcc/co
*** 4729,4735 ****
  d80723a846c00c3e96b8a65daaa757f2  gcc/config/nds32/nds32-fpu.md
  a55a211a345737e1f464e576bd9baea5  gcc/config/nds32/nds32-graywolf.md
  7180d93466f00b5ea58f7b78a553fca0  gcc/config/nds32/nds32-intrinsic.cc
! e9804cf8b4657ba7abfb30a9e23ce032  gcc/config/nds32/nds32-intrinsic.md
  9ff128391e35cadac99cb2df82942133  gcc/config/nds32/nds32-isr.cc
  d94163fd5e4660359b8b12a0d90ed1bd  gcc/config/nds32/nds32-linux.opt
  a93f916906721665c3595705369b9c96  gcc/config/nds32/nds32-linux.opt.urls
--- 4726,4732 ----
  d80723a846c00c3e96b8a65daaa757f2  gcc/config/nds32/nds32-fpu.md
  a55a211a345737e1f464e576bd9baea5  gcc/config/nds32/nds32-graywolf.md
  7180d93466f00b5ea58f7b78a553fca0  gcc/config/nds32/nds32-intrinsic.cc
! 70205469134b824d0862774e43743034  gcc/config/nds32/nds32-intrinsic.md
  9ff128391e35cadac99cb2df82942133  gcc/config/nds32/nds32-isr.cc
  d94163fd5e4660359b8b12a0d90ed1bd  gcc/config/nds32/nds32-linux.opt
  a93f916906721665c3595705369b9c96  gcc/config/nds32/nds32-linux.opt.urls
*************** f58d4380ee68891690f4302989ce00cb  gcc/co
*** 4827,4833 ****
  42bcbace87662d4e287c97d35ad8a07f  gcc/config/pa/pa-64.h
  e5d0569b6f22fcc3b7c04ffc10f948a8  gcc/config/pa/pa-d.cc
  9b9d3426728f4e028f0188a35e2f2ce3  gcc/config/pa/pa-d.h
! 2922a5a179fdd7e9f592c1a0705a59ae  gcc/config/pa/pa-hpux.h
  83160c1e500c5a73ed6a65d83ba1f32d  gcc/config/pa/pa-hpux.opt
  c72bd414f990a9fee6e01780673cdd56  gcc/config/pa/pa-hpux.opt.urls
  f6d8fb7b076da94980d5e21094cad327  gcc/config/pa/pa-hpux1010.h
--- 4824,4830 ----
  42bcbace87662d4e287c97d35ad8a07f  gcc/config/pa/pa-64.h
  e5d0569b6f22fcc3b7c04ffc10f948a8  gcc/config/pa/pa-d.cc
  9b9d3426728f4e028f0188a35e2f2ce3  gcc/config/pa/pa-d.h
! 24d035b216da675faa3b938f2f5ba840  gcc/config/pa/pa-hpux.h
  83160c1e500c5a73ed6a65d83ba1f32d  gcc/config/pa/pa-hpux.opt
  c72bd414f990a9fee6e01780673cdd56  gcc/config/pa/pa-hpux.opt.urls
  f6d8fb7b076da94980d5e21094cad327  gcc/config/pa/pa-hpux1010.h
*************** d6da8f84e5835bd14f146fc765bcb39d  gcc/co
*** 4892,4908 ****
  cd13b51383c99c08d86250b61fed3805  gcc/config/pru/pru.opt.urls
  540013c309ceb3efb2b16d728b1fc726  gcc/config/pru/t-pru
  a5e691ce14017f2a89283ed510bb78fd  gcc/config/riscv/arch-canonicalize
! 43b890ca35154f45c415b5830719600a  gcc/config/riscv/autovec-opt.md
  4032274539da6915927b3fb611848f38  gcc/config/riscv/autovec.md
! a76fc69ac639b44a9d8c4ec7520c0e75  gcc/config/riscv/bitmanip.md
! 0a28e5e046394c81a6a87e3ee05c1df9  gcc/config/riscv/constraints.md
  4e0968dc35562b151fd162778542718f  gcc/config/riscv/corev.def
  d404c19d5b1a2aca0a73917bb692bd96  gcc/config/riscv/corev.md
  a8964e5c7fad78fa42fc5b8f0dc2e91b  gcc/config/riscv/crypto.md
  70cc6640001ff23ac9b647ea784ffb2b  gcc/config/riscv/elf.h
  9a5e3c714ef42f079425c3c0af8184dc  gcc/config/riscv/freebsd.h
  8b83b20385b0cc79dbd5378c1df1bb6a  gcc/config/riscv/gen-riscv-ext-opt.cc
! 05875760265091a14073c94ceb2b4592  gcc/config/riscv/gen-riscv-ext-texi.cc
  fdf40414be0404faa2f689ccff02d68d  gcc/config/riscv/generic-ooo.md
  a124ceec225b4a292b25b31a9a635a5e  gcc/config/riscv/generic-vector-ooo.md
  b7e955ddfed9efbb0296ef639c095e2a  gcc/config/riscv/generic.md
--- 4889,4905 ----
  cd13b51383c99c08d86250b61fed3805  gcc/config/pru/pru.opt.urls
  540013c309ceb3efb2b16d728b1fc726  gcc/config/pru/t-pru
  a5e691ce14017f2a89283ed510bb78fd  gcc/config/riscv/arch-canonicalize
! 16758263c2b4e1f25075a6baeb22e0a0  gcc/config/riscv/autovec-opt.md
  4032274539da6915927b3fb611848f38  gcc/config/riscv/autovec.md
! 3a923d5960324ed1cd044158c2de7acd  gcc/config/riscv/bitmanip.md
! c21886991e632848d5622ed5a3188f75  gcc/config/riscv/constraints.md
  4e0968dc35562b151fd162778542718f  gcc/config/riscv/corev.def
  d404c19d5b1a2aca0a73917bb692bd96  gcc/config/riscv/corev.md
  a8964e5c7fad78fa42fc5b8f0dc2e91b  gcc/config/riscv/crypto.md
  70cc6640001ff23ac9b647ea784ffb2b  gcc/config/riscv/elf.h
  9a5e3c714ef42f079425c3c0af8184dc  gcc/config/riscv/freebsd.h
  8b83b20385b0cc79dbd5378c1df1bb6a  gcc/config/riscv/gen-riscv-ext-opt.cc
! d88ea862a5be7784a17a698cc6a7c5e5  gcc/config/riscv/gen-riscv-ext-texi.cc
  fdf40414be0404faa2f689ccff02d68d  gcc/config/riscv/generic-ooo.md
  a124ceec225b4a292b25b31a9a635a5e  gcc/config/riscv/generic-vector-ooo.md
  b7e955ddfed9efbb0296ef639c095e2a  gcc/config/riscv/generic.md
*************** d8e970a7377ae8ee7892f014d5bbc979  gcc/co
*** 4910,4915 ****
--- 4907,4913 ----
  473ed80ccf8dc1ff43e427a45cca3a1e  gcc/config/riscv/gnu.h
  4e30eb4d51786f677ce1c181647193e1  gcc/config/riscv/iterators.md
  85139511ec0cad0144207dc8efc0ed90  gcc/config/riscv/linux.h
+ 22c4239b709147e20546aaa492483d43  gcc/config/riscv/mips-p8700.md
  52728cfca05017f727570e4e983fc5fa  gcc/config/riscv/multilib-generator
  80e8994ee9e6abf380e68aca6443d157  gcc/config/riscv/peephole.md
  a3d3fa9142d4e2ed34ead146941c574a  gcc/config/riscv/pic.md
*************** d7a63bbbf6653fc311084e8bb09d713b  gcc/co
*** 4918,4924 ****
  3b5651b95f6a076ccd28e73bae600e52  gcc/config/riscv/riscv-builtins.cc
  815f99489b9dbc6b6a08ca988978b261  gcc/config/riscv/riscv-c.cc
  3b7012a7d47b9aaf163e890d3e29013e  gcc/config/riscv/riscv-cmo.def
! f039a446b908189e7bac54e9eed4aa0e  gcc/config/riscv/riscv-cores.def
  173996678a5bf2b1b40e30fe260109b4  gcc/config/riscv/riscv-d.cc
  790bd2a5355776ab5ebf4c7814489760  gcc/config/riscv/riscv-d.h
  9848282285cd3a3e21f6181f220f6ba9  gcc/config/riscv/riscv-ext-corev.def
--- 4916,4922 ----
  3b5651b95f6a076ccd28e73bae600e52  gcc/config/riscv/riscv-builtins.cc
  815f99489b9dbc6b6a08ca988978b261  gcc/config/riscv/riscv-c.cc
  3b7012a7d47b9aaf163e890d3e29013e  gcc/config/riscv/riscv-cmo.def
! 7b92928ed434be950fbfc66adbdbc9e8  gcc/config/riscv/riscv-cores.def
  173996678a5bf2b1b40e30fe260109b4  gcc/config/riscv/riscv-d.cc
  790bd2a5355776ab5ebf4c7814489760  gcc/config/riscv/riscv-d.h
  9848282285cd3a3e21f6181f220f6ba9  gcc/config/riscv/riscv-ext-corev.def
*************** abebc96ebce10e6cdf4f183d4fe9253f  gcc/co
*** 4931,4939 ****
  1b0b6b632f747d9387ef25821e8673b4  gcc/config/riscv/riscv-feature-bits.h
  b467d35485b39b25863e918609a322d0  gcc/config/riscv/riscv-ftypes.def
  b1bc6d82a24b7b0e658a43956a37419c  gcc/config/riscv/riscv-modes.def
! d92f21798d5d0f0004b88f9020133f13  gcc/config/riscv/riscv-opts.h
  2c59654f5f7fe2689efd370c0441b6bd  gcc/config/riscv/riscv-passes.def
! 02bd5d07b4bddc7504151f3f1e2aee01  gcc/config/riscv/riscv-protos.h
  446f0f39c6f980e246ea56f1233e9271  gcc/config/riscv/riscv-scalar-crypto.def
  8599f55379a8c8fc0b569c7401645a66  gcc/config/riscv/riscv-selftests.cc
  da4e034d23a8f2754b1dfce0122f286e  gcc/config/riscv/riscv-shorten-memrefs.cc
--- 4929,4937 ----
  1b0b6b632f747d9387ef25821e8673b4  gcc/config/riscv/riscv-feature-bits.h
  b467d35485b39b25863e918609a322d0  gcc/config/riscv/riscv-ftypes.def
  b1bc6d82a24b7b0e658a43956a37419c  gcc/config/riscv/riscv-modes.def
! 7390332430a5dbea60088aecf71a533e  gcc/config/riscv/riscv-opts.h
  2c59654f5f7fe2689efd370c0441b6bd  gcc/config/riscv/riscv-passes.def
! 00de4eb7cff73486569ffe3670da7941  gcc/config/riscv/riscv-protos.h
  446f0f39c6f980e246ea56f1233e9271  gcc/config/riscv/riscv-scalar-crypto.def
  8599f55379a8c8fc0b569c7401645a66  gcc/config/riscv/riscv-selftests.cc
  da4e034d23a8f2754b1dfce0122f286e  gcc/config/riscv/riscv-shorten-memrefs.cc
*************** da4e034d23a8f2754b1dfce0122f286e  gcc/co
*** 4941,4947 ****
  5934e743da72bdc74e1d53f049b127fc  gcc/config/riscv/riscv-string.cc
  f2f90e0d4af72ad1c79aba2821be11b4  gcc/config/riscv/riscv-subset.h
  be3e0da2403121c429e21501de9c9b5f  gcc/config/riscv/riscv-target-attr.cc
! 4cbbf5da024adfc46f4d953b73b5e9b3  gcc/config/riscv/riscv-v.cc
  0d419e9df116fed7ce6e0ae15131417e  gcc/config/riscv/riscv-v.h
  c5f3161dedd668dfb126ffb191cfb236  gcc/config/riscv/riscv-vect-permconst.cc
  8bb68ed754e01cc6cbd31b250968d7f6  gcc/config/riscv/riscv-vector-builtins-bases.cc
--- 4939,4945 ----
  5934e743da72bdc74e1d53f049b127fc  gcc/config/riscv/riscv-string.cc
  f2f90e0d4af72ad1c79aba2821be11b4  gcc/config/riscv/riscv-subset.h
  be3e0da2403121c429e21501de9c9b5f  gcc/config/riscv/riscv-target-attr.cc
! 121616f8e0ac1bc00f18def6efadd07d  gcc/config/riscv/riscv-v.cc
  0d419e9df116fed7ce6e0ae15131417e  gcc/config/riscv/riscv-v.h
  c5f3161dedd668dfb126ffb191cfb236  gcc/config/riscv/riscv-vect-permconst.cc
  8bb68ed754e01cc6cbd31b250968d7f6  gcc/config/riscv/riscv-vector-builtins-bases.cc
*************** bdc5f6caf56fd0411faf705e9c32ccd4  gcc/co
*** 4953,4968 ****
  e4137796901da09141309284b35af93c  gcc/config/riscv/riscv-vector-builtins.cc
  74c291180c302842c646af24c77d184c  gcc/config/riscv/riscv-vector-builtins.def
  f75c79d146d75e5489bb9983fcdd05f6  gcc/config/riscv/riscv-vector-builtins.h
! 7a7cc1051558e6d9890d9fc402d76691  gcc/config/riscv/riscv-vector-costs.cc
  bd7a0d0d03ad4788f6cf7579df11a66e  gcc/config/riscv/riscv-vector-costs.h
  f51037a9e437f8e9ce7215b2da5ad4e2  gcc/config/riscv/riscv-vector-switch.def
  3c65f952c8116cc22f135cab9b639d28  gcc/config/riscv/riscv-vsetvl.cc
  16b7359c0b12895c0d7452fc89879a1a  gcc/config/riscv/riscv-vsetvl.def
  7082a18dbfc574d47bf71f4d50dd30f9  gcc/config/riscv/riscv-zicfilp.cc
! 3d7af594a68891f22005410aa1f5b10f  gcc/config/riscv/riscv.cc
  1153302a8d65cedebba8e1a3f67931b2  gcc/config/riscv/riscv.h
! 03c4b28769423854beeddf4f8fc50582  gcc/config/riscv/riscv.md
! 1295f122f0bd70a8d7f55e0607e77ab4  gcc/config/riscv/riscv.opt
  d1d34490d8b53ec20d70ed9e2e56e3ab  gcc/config/riscv/riscv.opt.urls
  374e3c204946cff8c4be2bcad6641830  gcc/config/riscv/riscv_bitmanip.h
  a8044652cefd826404f261518f9e2321  gcc/config/riscv/riscv_crypto.h
--- 4951,4966 ----
  e4137796901da09141309284b35af93c  gcc/config/riscv/riscv-vector-builtins.cc
  74c291180c302842c646af24c77d184c  gcc/config/riscv/riscv-vector-builtins.def
  f75c79d146d75e5489bb9983fcdd05f6  gcc/config/riscv/riscv-vector-builtins.h
! 65ec1ed9e89dd3e0ac6f1970dad075b9  gcc/config/riscv/riscv-vector-costs.cc
  bd7a0d0d03ad4788f6cf7579df11a66e  gcc/config/riscv/riscv-vector-costs.h
  f51037a9e437f8e9ce7215b2da5ad4e2  gcc/config/riscv/riscv-vector-switch.def
  3c65f952c8116cc22f135cab9b639d28  gcc/config/riscv/riscv-vsetvl.cc
  16b7359c0b12895c0d7452fc89879a1a  gcc/config/riscv/riscv-vsetvl.def
  7082a18dbfc574d47bf71f4d50dd30f9  gcc/config/riscv/riscv-zicfilp.cc
! e0fd0f44787e05dbaa4e7351077bf9dc  gcc/config/riscv/riscv.cc
  1153302a8d65cedebba8e1a3f67931b2  gcc/config/riscv/riscv.h
! 80eb1b2e57c5210d62f3ce508190ae70  gcc/config/riscv/riscv.md
! 9ea65ab93a9cc69269d47111131897e5  gcc/config/riscv/riscv.opt
  d1d34490d8b53ec20d70ed9e2e56e3ab  gcc/config/riscv/riscv.opt.urls
  374e3c204946cff8c4be2bcad6641830  gcc/config/riscv/riscv_bitmanip.h
  a8044652cefd826404f261518f9e2321  gcc/config/riscv/riscv_crypto.h
*************** bcf728ad2379630774fd5bb529d4ee86  gcc/co
*** 4995,5001 ****
  fd8e9517de64ab23821ea1284ea6d7f6  gcc/config/riscv/thead.md
  b5e46305db1116cc1758b504ea37fe74  gcc/config/riscv/vector-bfloat16.md
  88f7597398d0c8b8b87baba5fd207996  gcc/config/riscv/vector-crypto.md
! dd17e61a3fc5d99d2e421388d0bb6728  gcc/config/riscv/vector-iterators.md
  2aac5fc6721c093a0f679d0e14d196e1  gcc/config/riscv/vector.md
  4ffde0be9b9a0efe78c98b4407d00397  gcc/config/riscv/xiangshan.md
  0f64aaa114ab62a1a46f7ac422d6a129  gcc/config/riscv/zc.md
--- 4993,4999 ----
  fd8e9517de64ab23821ea1284ea6d7f6  gcc/config/riscv/thead.md
  b5e46305db1116cc1758b504ea37fe74  gcc/config/riscv/vector-bfloat16.md
  88f7597398d0c8b8b87baba5fd207996  gcc/config/riscv/vector-crypto.md
! 48377612cee1b361a5ead40b972cff2a  gcc/config/riscv/vector-iterators.md
  2aac5fc6721c093a0f679d0e14d196e1  gcc/config/riscv/vector.md
  4ffde0be9b9a0efe78c98b4407d00397  gcc/config/riscv/xiangshan.md
  0f64aaa114ab62a1a46f7ac422d6a129  gcc/config/riscv/zc.md
*************** e963c6f088ae67780aab309ebb8f2403  gcc/co
*** 5327,5333 ****
  8e7da647ebac15f0fb906b5d8eabbcae  gcc/config/sparc/sparc-protos.h
  7f4f47217438bd78895fb1e403843cec  gcc/config/sparc/sparc.cc
  7b50625b5647706a8b3078662269f0b6  gcc/config/sparc/sparc.h
! ca5d61801e838fb883889cacf84b57b8  gcc/config/sparc/sparc.md
  6f932c6d3989e90e2e77ce2f623e6e98  gcc/config/sparc/sparc.opt
  cbc85a5ebb7b3a0099441abc8694a822  gcc/config/sparc/sparc.opt.urls
  058c0b8fd9d648a96b6360d6bb462b5a  gcc/config/sparc/sparclet.md
--- 5325,5331 ----
  8e7da647ebac15f0fb906b5d8eabbcae  gcc/config/sparc/sparc-protos.h
  7f4f47217438bd78895fb1e403843cec  gcc/config/sparc/sparc.cc
  7b50625b5647706a8b3078662269f0b6  gcc/config/sparc/sparc.h
! fa9d02f144f3cf8591787a3c9c6c7b11  gcc/config/sparc/sparc.md
  6f932c6d3989e90e2e77ce2f623e6e98  gcc/config/sparc/sparc.opt
  cbc85a5ebb7b3a0099441abc8694a822  gcc/config/sparc/sparc.opt.urls
  058c0b8fd9d648a96b6360d6bb462b5a  gcc/config/sparc/sparclet.md
*************** fae3f6a9928b5e77047c16385fb6eaa2  gcc/co
*** 5357,5363 ****
  cf8f1ec6b22f77619d0748b31128a406  gcc/config/stormy16/stormy16-protos.h
  aec465d0b6b56ca144afa19b3026946c  gcc/config/stormy16/stormy16.cc
  434e53667b82e4d41b23c5c07f57efb5  gcc/config/stormy16/stormy16.h
! aad4e1f2824f42f41ba193319785aa8f  gcc/config/stormy16/stormy16.md
  b06d94d851e104bc65bc09aa483e1d6f  gcc/config/stormy16/stormy16.opt
  83f5016198e7f4905149f32898b70e29  gcc/config/stormy16/stormy16.opt.urls
  71e59a6ba56b820bb01039036499d82b  gcc/config/t-darwin
--- 5355,5361 ----
  cf8f1ec6b22f77619d0748b31128a406  gcc/config/stormy16/stormy16-protos.h
  aec465d0b6b56ca144afa19b3026946c  gcc/config/stormy16/stormy16.cc
  434e53667b82e4d41b23c5c07f57efb5  gcc/config/stormy16/stormy16.h
! 9afb72fe0b01bd653aeb93ed4665b982  gcc/config/stormy16/stormy16.md
  b06d94d851e104bc65bc09aa483e1d6f  gcc/config/stormy16/stormy16.opt
  83f5016198e7f4905149f32898b70e29  gcc/config/stormy16/stormy16.opt.urls
  71e59a6ba56b820bb01039036499d82b  gcc/config/t-darwin
*************** a9c3cddee4e237141062720b72fe38cd  gcc/co
*** 5504,5510 ****
  5d31df44fc0a5b17beb74ce0ff38e214  gcc/coroutine-passes.cc
  2a5216aefb9cdf4b270ef8e599cc794f  gcc/coverage.cc
  722fb5fda78e55c5af5da72cad78751f  gcc/coverage.h
! 8f5914726b10d7242a4541cb456c3825  gcc/cp/ChangeLog
  70c059f2b75a2fc1bb95a526b21b8cd7  gcc/cp/ChangeLog-1993
  7cbd106e10a0ba7c052bee3fe20671c2  gcc/cp/ChangeLog-1994
  3b1e3ed23ad4363f75e6fd2fbb583dee  gcc/cp/ChangeLog-1995
--- 5502,5508 ----
  5d31df44fc0a5b17beb74ce0ff38e214  gcc/coroutine-passes.cc
  2a5216aefb9cdf4b270ef8e599cc794f  gcc/coverage.cc
  722fb5fda78e55c5af5da72cad78751f  gcc/coverage.h
! cfdacfd5d45b6c5704cd06d6cb26bdbc  gcc/cp/ChangeLog
  70c059f2b75a2fc1bb95a526b21b8cd7  gcc/cp/ChangeLog-1993
  7cbd106e10a0ba7c052bee3fe20671c2  gcc/cp/ChangeLog-1994
  3b1e3ed23ad4363f75e6fd2fbb583dee  gcc/cp/ChangeLog-1995
*************** f749639c06fb1a8e259bd762fd131b3f  gcc/cp
*** 5549,5557 ****
  d132f7f4c080ce3048977e23e33b9b1c  gcc/cp/constraint.cc
  613233facbf4b0f1cff770ed6c49c666  gcc/cp/contracts.cc
  1f1cd3a021a2cd25741e252145ee8282  gcc/cp/contracts.h
! 87259690960df0d717f15cbeadc3eea1  gcc/cp/coroutines.cc
  50f398cce18f76ec8d119ddd9d133f78  gcc/cp/coroutines.h
! 541cd71d326520d2f83ccd03638aaa8b  gcc/cp/cp-gimplify.cc
  3bf6da2fd9bef7475fae5ee6d9cdcf15  gcc/cp/cp-lang.cc
  0083c32822e7d365ab0074f1807e8679  gcc/cp/cp-name-hint.h
  a46a06074cd68181251e3541b4689021  gcc/cp/cp-objcp-common.cc
--- 5547,5555 ----
  d132f7f4c080ce3048977e23e33b9b1c  gcc/cp/constraint.cc
  613233facbf4b0f1cff770ed6c49c666  gcc/cp/contracts.cc
  1f1cd3a021a2cd25741e252145ee8282  gcc/cp/contracts.h
! 58646f4e7ea19fc13b47ff6825cca56b  gcc/cp/coroutines.cc
  50f398cce18f76ec8d119ddd9d133f78  gcc/cp/coroutines.h
! 4733988bab1e3fb37a7a14f899f2946e  gcc/cp/cp-gimplify.cc
  3bf6da2fd9bef7475fae5ee6d9cdcf15  gcc/cp/cp-lang.cc
  0083c32822e7d365ab0074f1807e8679  gcc/cp/cp-name-hint.h
  a46a06074cd68181251e3541b4689021  gcc/cp/cp-objcp-common.cc
*************** e5ccdda9d62d96ac397910d0fa391b0a  gcc/cp
*** 5566,5574 ****
  c1cc5dac36866c611933c037cc1d6f2f  gcc/cp/cxxapi-data.csv
  cc9928575f28fafacef718c5c80775db  gcc/cp/decl.cc
  7f116fdc50b24dcb13cdcf096636aef9  gcc/cp/decl.h
! 4c2e12905b64532da506807db1677050  gcc/cp/decl2.cc
  691a10b3246d19925433648ba9a4ea9a  gcc/cp/dump.cc
! fb321e18e88028e7fd051da3ec4f5b6e  gcc/cp/error.cc
  86f47b28d673601022d0205cdd718f9d  gcc/cp/except.cc
  f1581b369c1962c764264b1b2af61ca2  gcc/cp/expr.cc
  3b7c086cfb4ed89e6ae40a09ca796704  gcc/cp/friend.cc
--- 5564,5572 ----
  c1cc5dac36866c611933c037cc1d6f2f  gcc/cp/cxxapi-data.csv
  cc9928575f28fafacef718c5c80775db  gcc/cp/decl.cc
  7f116fdc50b24dcb13cdcf096636aef9  gcc/cp/decl.h
! f4e44eb1343e0b1fd3cbf861ac00bf41  gcc/cp/decl2.cc
  691a10b3246d19925433648ba9a4ea9a  gcc/cp/dump.cc
! 95586d6bf5468a4e5a8bf3c487e638bb  gcc/cp/error.cc
  86f47b28d673601022d0205cdd718f9d  gcc/cp/except.cc
  f1581b369c1962c764264b1b2af61ca2  gcc/cp/expr.cc
  3b7c086cfb4ed89e6ae40a09ca796704  gcc/cp/friend.cc
*************** bcd77de9155d0bae5293da112f650e43  gcc/cp
*** 5579,5590 ****
  ac5d78393361c1bcb930119a896a14ca  gcc/cp/lang-specs.h
  3f94e0ee121cb5771179a202f19104bb  gcc/cp/lex.cc
  aaf76a9b03fd0532d2904aef004fd66a  gcc/cp/logic.cc
! 397b8de2f52e596d7d76347ee016a9b4  gcc/cp/mangle.cc
  936bd061907a7a899c3285cf17b17674  gcc/cp/mapper-client.cc
  6c77b1fab5f6d146677090285a202a50  gcc/cp/mapper-client.h
  44e22b51797f89c9da996523a6d97f1c  gcc/cp/mapper-resolver.cc
  ae7940cd68d15195e055dd97ffe3cce9  gcc/cp/method.cc
! db2455cf9076963e3597e72fa3ef069c  gcc/cp/module.cc
  4b320facb74b0245d0f0959fe26e2e71  gcc/cp/name-lookup.cc
  9644410086c3beb90033e77613e9d1a7  gcc/cp/name-lookup.h
  e7fe06956aada61bcaae5168ad47a9c1  gcc/cp/operators.def
--- 5577,5588 ----
  ac5d78393361c1bcb930119a896a14ca  gcc/cp/lang-specs.h
  3f94e0ee121cb5771179a202f19104bb  gcc/cp/lex.cc
  aaf76a9b03fd0532d2904aef004fd66a  gcc/cp/logic.cc
! 422826d547b58d3ba757dfd5a0276ccb  gcc/cp/mangle.cc
  936bd061907a7a899c3285cf17b17674  gcc/cp/mapper-client.cc
  6c77b1fab5f6d146677090285a202a50  gcc/cp/mapper-client.h
  44e22b51797f89c9da996523a6d97f1c  gcc/cp/mapper-resolver.cc
  ae7940cd68d15195e055dd97ffe3cce9  gcc/cp/method.cc
! 501b5c19afd7e8ed9e052d69d4b8305a  gcc/cp/module.cc
  4b320facb74b0245d0f0959fe26e2e71  gcc/cp/name-lookup.cc
  9644410086c3beb90033e77613e9d1a7  gcc/cp/name-lookup.h
  e7fe06956aada61bcaae5168ad47a9c1  gcc/cp/operators.def
*************** e7fe06956aada61bcaae5168ad47a9c1  gcc/cp
*** 5593,5599 ****
  e8a3a03873c6294ff25a783941b8d8af  gcc/cp/parser.h
  ae60ecc480641515e422efd4efc1a861  gcc/cp/pt.cc
  a121c0a45933b618832614be1fbfd5c7  gcc/cp/ptree.cc
! 0ead9094e2e0b9fd6034c5cb83e232a8  gcc/cp/rtti.cc
  a4930c49ed8f9e6b019399bd1faf86d0  gcc/cp/search.cc
  3096647760bea4d3ef9c62689af2fb16  gcc/cp/semantics.cc
  b58bf61fbfed45af179b7104e72a9486  gcc/cp/std-name-hint.gperf
--- 5591,5597 ----
  e8a3a03873c6294ff25a783941b8d8af  gcc/cp/parser.h
  ae60ecc480641515e422efd4efc1a861  gcc/cp/pt.cc
  a121c0a45933b618832614be1fbfd5c7  gcc/cp/ptree.cc
! ee1ddf1e1b9554bb1a10109ce8c6dee5  gcc/cp/rtti.cc
  a4930c49ed8f9e6b019399bd1faf86d0  gcc/cp/search.cc
  3096647760bea4d3ef9c62689af2fb16  gcc/cp/semantics.cc
  b58bf61fbfed45af179b7104e72a9486  gcc/cp/std-name-hint.gperf
*************** acdfc663791e4321372e79932070d05d  gcc/do
*** 5934,5940 ****
  81ae745aed5479afae430c578fa29055  gcc/doc/cppinternals.texi
  1a2d44757bb0f40b09493ac3863eba93  gcc/doc/cppopts.texi
  14b0532614eb25d7d84e7efd6664ecf3  gcc/doc/cppwarnopts.texi
! 65eb0469dc7d3765cfcb472f4fdab1e8  gcc/doc/extend.texi
  ddcdbcb699f5252a1c1219d92d87ed8b  gcc/doc/fragments.texi
  cd346f0c279f68138ef08c7addc796de  gcc/doc/frontends.texi
  a28615d9873d98f0d5f4ef8dd3e4c39d  gcc/doc/gcc.texi
--- 5932,5938 ----
  81ae745aed5479afae430c578fa29055  gcc/doc/cppinternals.texi
  1a2d44757bb0f40b09493ac3863eba93  gcc/doc/cppopts.texi
  14b0532614eb25d7d84e7efd6664ecf3  gcc/doc/cppwarnopts.texi
! d13487362dc5f7115bb485c5cfe6f268  gcc/doc/extend.texi
  ddcdbcb699f5252a1c1219d92d87ed8b  gcc/doc/fragments.texi
  cd346f0c279f68138ef08c7addc796de  gcc/doc/frontends.texi
  a28615d9873d98f0d5f4ef8dd3e4c39d  gcc/doc/gcc.texi
*************** dc4ccd9843d88bc01c909438dabfd6ab  gcc/do
*** 5949,5964 ****
  e146722b4ab52551483390772327c93f  gcc/doc/gty.texi
  27e2895f33fff82c6e13b5b9e7b8df6b  gcc/doc/headerdirs.texi
  ee4c7654f733cefcb73d4fd24f3e1b82  gcc/doc/hostconfig.texi
! 4b440ddccefc912ad5d4547a76852228  gcc/doc/implement-c.texi
  905955094af017bc0fe064508fd7e578  gcc/doc/implement-cxx.texi
  8bed7c13f2521176c0f9f4f79c920551  gcc/doc/include/fdl.texi
  8787976f426cd52da24a856cd41d87be  gcc/doc/include/funding.texi
  9512a9fe27682edff7dd2ed171bbb853  gcc/doc/include/gcc-common.texi
  95c90bf85d3eab67f348ee3ce0bf4050  gcc/doc/include/gpl_v3.texi
  e9b8122841fbfbbc30fee8ed6613c399  gcc/doc/include/texinfo.tex
! 9452a1b0e4db9a14ba8f8806961ae80b  gcc/doc/install.texi
  0f98706361e63fac2c35c2c4491eaac4  gcc/doc/install.texi2html
! 2e67ae057927275c2e9b59ad1587e6f8  gcc/doc/invoke.texi
  47f1f55b3595acf670eb6193a0cbd933  gcc/doc/languages.texi
  5200cc28a2ab912efe66f0944995c45b  gcc/doc/libgcc.texi
  ef4f00c423089323edef1d3cff31a4a2  gcc/doc/libgdiagnostics/Makefile
--- 5947,5962 ----
  e146722b4ab52551483390772327c93f  gcc/doc/gty.texi
  27e2895f33fff82c6e13b5b9e7b8df6b  gcc/doc/headerdirs.texi
  ee4c7654f733cefcb73d4fd24f3e1b82  gcc/doc/hostconfig.texi
! 7f8c837191ec0fa16d6e1c9183ea31a7  gcc/doc/implement-c.texi
  905955094af017bc0fe064508fd7e578  gcc/doc/implement-cxx.texi
  8bed7c13f2521176c0f9f4f79c920551  gcc/doc/include/fdl.texi
  8787976f426cd52da24a856cd41d87be  gcc/doc/include/funding.texi
  9512a9fe27682edff7dd2ed171bbb853  gcc/doc/include/gcc-common.texi
  95c90bf85d3eab67f348ee3ce0bf4050  gcc/doc/include/gpl_v3.texi
  e9b8122841fbfbbc30fee8ed6613c399  gcc/doc/include/texinfo.tex
! 24cd0b31d695b3e960483721e348224d  gcc/doc/install.texi
  0f98706361e63fac2c35c2c4491eaac4  gcc/doc/install.texi2html
! 119a376efb9ae39379c82993e331310f  gcc/doc/invoke.texi
  47f1f55b3595acf670eb6193a0cbd933  gcc/doc/languages.texi
  5200cc28a2ab912efe66f0944995c45b  gcc/doc/libgcc.texi
  ef4f00c423089323edef1d3cff31a4a2  gcc/doc/libgdiagnostics/Makefile
*************** a1f65f3aec3cc5d5b6505fb976d4c216  gcc/do
*** 5993,5999 ****
  c98feb0a43876ed3ef2fca3c8448e8f8  gcc/doc/lto.texi
  26f08ad01720c082109915a4ec33c80f  gcc/doc/makefile.texi
  2f8484fc473d3a7141e34a260b920ea3  gcc/doc/match-and-simplify.texi
! 10b51d23b748cb98074db7edf9725f42  gcc/doc/md.texi
  8836b7001f069e8dead6a4643108258b  gcc/doc/objc.texi
  9673b2a6dd62d5ac08afb00421e98cdb  gcc/doc/optinfo.texi
  0ae5c8ef7a8ce01c113543a03df7e0df  gcc/doc/options.texi
--- 5991,5997 ----
  c98feb0a43876ed3ef2fca3c8448e8f8  gcc/doc/lto.texi
  26f08ad01720c082109915a4ec33c80f  gcc/doc/makefile.texi
  2f8484fc473d3a7141e34a260b920ea3  gcc/doc/match-and-simplify.texi
! c9c36fbefa306c5ed545b38beb9d0a47  gcc/doc/md.texi
  8836b7001f069e8dead6a4643108258b  gcc/doc/objc.texi
  9673b2a6dd62d5ac08afb00421e98cdb  gcc/doc/optinfo.texi
  0ae5c8ef7a8ce01c113543a03df7e0df  gcc/doc/options.texi
*************** ee33d902cd60afae792843ff15ad6706  gcc/do
*** 6004,6010 ****
  dddeee21c6a9b60cd853f27a5db81c4f  gcc/doc/riscv-ext.texi
  8489e4a02a5daa1d1ae726383b330653  gcc/doc/rtl.texi
  bd20fd07c5ee8f444bf1d3f5e64e066a  gcc/doc/service.texi
! 5f122f3cdde0b1e39391fca5a35ca6e3  gcc/doc/sourcebuild.texi
  14e3ed780980c4fff09173b869e850ed  gcc/doc/standards.texi
  fd3bf27e33907464460ab9208cdd2240  gcc/doc/tm.texi
  06d0869eb2bec892f989f31bcd7da233  gcc/doc/tm.texi.in
--- 6002,6008 ----
  dddeee21c6a9b60cd853f27a5db81c4f  gcc/doc/riscv-ext.texi
  8489e4a02a5daa1d1ae726383b330653  gcc/doc/rtl.texi
  bd20fd07c5ee8f444bf1d3f5e64e066a  gcc/doc/service.texi
! 9aa36a97519b5c95abd0b5ab2af189ce  gcc/doc/sourcebuild.texi
  14e3ed780980c4fff09173b869e850ed  gcc/doc/standards.texi
  fd3bf27e33907464460ab9208cdd2240  gcc/doc/tm.texi
  06d0869eb2bec892f989f31bcd7da233  gcc/doc/tm.texi.in
*************** e518c37d94908385da07142b92ea8cdb  gcc/dw
*** 6030,6041 ****
  186b01005d892edba3b03fc17bd0dc8f  gcc/dwarf2codeview.h
  baaae59ceda4df837a6f62ffb0f29ee7  gcc/dwarf2ctf.cc
  1d0191caafac1774f50a47175d915ea0  gcc/dwarf2ctf.h
! cb14c74668b169646e138781d6e82f93  gcc/dwarf2out.cc
  7ff70632352b65c214e02360ed6d6aae  gcc/dwarf2out.h
  fdd976759ee89958c91a4010e53c0f02  gcc/early-remat.cc
  e0339faf7da1ffc9030bc3a53b41cc1c  gcc/edit-context.cc
  237d0c79a98880d977007c3345019bf8  gcc/edit-context.h
! 2c38bdd0fc19714dd7e1b6705484c5b5  gcc/emit-rtl.cc
  958b8dfdb92b879b9cbab057e540c587  gcc/emit-rtl.h
  22fb4d062235835cdf34b4077884887d  gcc/errors.cc
  7109c06aed199f804c8906e6febd8c9f  gcc/errors.h
--- 6028,6039 ----
  186b01005d892edba3b03fc17bd0dc8f  gcc/dwarf2codeview.h
  baaae59ceda4df837a6f62ffb0f29ee7  gcc/dwarf2ctf.cc
  1d0191caafac1774f50a47175d915ea0  gcc/dwarf2ctf.h
! 47ff7f9e9ca081597e6dd9be5b4d091a  gcc/dwarf2out.cc
  7ff70632352b65c214e02360ed6d6aae  gcc/dwarf2out.h
  fdd976759ee89958c91a4010e53c0f02  gcc/early-remat.cc
  e0339faf7da1ffc9030bc3a53b41cc1c  gcc/edit-context.cc
  237d0c79a98880d977007c3345019bf8  gcc/edit-context.h
! f27a5c4aba40bcd3fec7afbea47fc8ef  gcc/emit-rtl.cc
  958b8dfdb92b879b9cbab057e540c587  gcc/emit-rtl.h
  22fb4d062235835cdf34b4077884887d  gcc/errors.cc
  7109c06aed199f804c8906e6febd8c9f  gcc/errors.h
*************** e67bf1a2587fc7f7361e841145ff4cfb  gcc/es
*** 6047,6053 ****
  29b821359071c4aa7e30220d5cb2d580  gcc/exec-tool.in
  92c5c2d83c0f493838752cabc5c5cb40  gcc/explow.cc
  b5fa845ff578d70e8ceae655d6affc51  gcc/explow.h
! bf1d67a256320e50cdaccef288bcb1b9  gcc/expmed.cc
  dee0d85cc89e81b4cc185f1c3102811e  gcc/expmed.h
  be57bc61b2fcfe917394983b3537e3c4  gcc/expr.cc
  5480b0f834e382e22c92192d7f5a4744  gcc/expr.h
--- 6045,6051 ----
  29b821359071c4aa7e30220d5cb2d580  gcc/exec-tool.in
  92c5c2d83c0f493838752cabc5c5cb40  gcc/explow.cc
  b5fa845ff578d70e8ceae655d6affc51  gcc/explow.h
! a4ee0bae47797ce73f05daef7a07edd4  gcc/expmed.cc
  dee0d85cc89e81b4cc185f1c3102811e  gcc/expmed.h
  be57bc61b2fcfe917394983b3537e3c4  gcc/expr.cc
  5480b0f834e382e22c92192d7f5a4744  gcc/expr.h
*************** a798cdca802a57ffa3473ab610b37c86  gcc/fo
*** 6068,6074 ****
  231ca43a15347c4b57b64ed5be4a7c8e  gcc/fold-const.cc
  f23dec03425a07611492fa2c061cd7d2  gcc/fold-const.h
  cd4e6baf5d162fbd41160606055f8297  gcc/fold-mem-offsets.cc
! 9eb28b00695aed1ee517f94e0a83fe7a  gcc/fortran/ChangeLog
  083c53fadafdcf3be46713838a51e36c  gcc/fortran/ChangeLog-2002
  2a4ca18d211fb2603139354fd16398ed  gcc/fortran/ChangeLog-2003
  e7462609ebd0dd7c874e0fc00e2833aa  gcc/fortran/ChangeLog-2004
--- 6066,6072 ----
  231ca43a15347c4b57b64ed5be4a7c8e  gcc/fold-const.cc
  f23dec03425a07611492fa2c061cd7d2  gcc/fold-const.h
  cd4e6baf5d162fbd41160606055f8297  gcc/fold-mem-offsets.cc
! 590cac4bee8bdf9b5a0e49ad8b4351c5  gcc/fortran/ChangeLog
  083c53fadafdcf3be46713838a51e36c  gcc/fortran/ChangeLog-2002
  2a4ca18d211fb2603139354fd16398ed  gcc/fortran/ChangeLog-2003
  e7462609ebd0dd7c874e0fc00e2833aa  gcc/fortran/ChangeLog-2004
*************** d8e305ea46f72c347ae93f0ab9d8337a  gcc/fo
*** 6167,6173 ****
  710d1b981b11b3456d5e23839efa4675  gcc/fortran/trans-openmp.cc
  0396764dfdf16466c5e59e1744c93a42  gcc/fortran/trans-stmt.cc
  9caf8a2f93e6cf5e2a567a3aa18f957c  gcc/fortran/trans-stmt.h
! 3910394d74aab50fba42ab60b9b75ad3  gcc/fortran/trans-types.cc
  422959ab20fd75df3766a03597227fd2  gcc/fortran/trans-types.h
  54131318d1d1405d58e24ee3cc51e594  gcc/fortran/trans.cc
  54e59c2c0e95e495fc23ebb71f917fc5  gcc/fortran/trans.h
--- 6165,6171 ----
  710d1b981b11b3456d5e23839efa4675  gcc/fortran/trans-openmp.cc
  0396764dfdf16466c5e59e1744c93a42  gcc/fortran/trans-stmt.cc
  9caf8a2f93e6cf5e2a567a3aa18f957c  gcc/fortran/trans-stmt.h
! 85844940ea98853cc5dae2a42043a2fa  gcc/fortran/trans-types.cc
  422959ab20fd75df3766a03597227fd2  gcc/fortran/trans-types.h
  54131318d1d1405d58e24ee3cc51e594  gcc/fortran/trans.cc
  54e59c2c0e95e495fc23ebb71f917fc5  gcc/fortran/trans.h
*************** e931bffabce064f7ea5f757be9effcb4  gcc/ge
*** 6217,6229 ****
  81e93c9118ab0d8b2a582d9db5c3a24a  gcc/genconditions.cc
  94589a8be4e6b4a09f984d7bcb42bd2b  gcc/genconfig.cc
  6c504c77c2a7c2ccfb6423c4fe6d49f4  gcc/genconstants.cc
! eb8c46fd2d0728996c6e89d89086cac5  gcc/genemit.cc
  b41072b25b108fee0e8173bd0d30f0eb  gcc/genenums.cc
  9826edc4e3f840e55d31fd99fc05f28c  gcc/generic-match-head.cc
  d9439dc48b1689d02df9d1ee357d9eb7  gcc/generic-match.h
  a5a23bee543191529294d325e1de0424  gcc/genextract.cc
  695bcd280c318a44bbd0db995e59d905  gcc/genflags.cc
! 446a2730ef08c6f09e7f25d1f7fdb892  gcc/gengenrtl.cc
  f08758617a3d032ae009840210c23753  gcc/gengtype-lex.l
  8b99c04e54d5d4377c4fbf3dcab54659  gcc/gengtype-parse.cc
  fc2add74b25837de88ed3c40f4f1193d  gcc/gengtype-state.cc
--- 6215,6227 ----
  81e93c9118ab0d8b2a582d9db5c3a24a  gcc/genconditions.cc
  94589a8be4e6b4a09f984d7bcb42bd2b  gcc/genconfig.cc
  6c504c77c2a7c2ccfb6423c4fe6d49f4  gcc/genconstants.cc
! 1ec0ecf23ef8739bb011e9f768c4d670  gcc/genemit.cc
  b41072b25b108fee0e8173bd0d30f0eb  gcc/genenums.cc
  9826edc4e3f840e55d31fd99fc05f28c  gcc/generic-match-head.cc
  d9439dc48b1689d02df9d1ee357d9eb7  gcc/generic-match.h
  a5a23bee543191529294d325e1de0424  gcc/genextract.cc
  695bcd280c318a44bbd0db995e59d905  gcc/genflags.cc
! 6292d2f9eac0b030e4ea58e89ebd40a2  gcc/gengenrtl.cc
  f08758617a3d032ae009840210c23753  gcc/gengtype-lex.l
  8b99c04e54d5d4377c4fbf3dcab54659  gcc/gengtype-parse.cc
  fc2add74b25837de88ed3c40f4f1193d  gcc/gengtype-state.cc
*************** d23c1b55e0de2e6e8884410e882b1b87  gcc/ge
*** 6240,6253 ****
  29ee68ccc9844e3580e3e9f6da577778  gcc/genpeep.cc
  28d50caf61c98bed97742228c437ee13  gcc/genpreds.cc
  7ef07a14a26d6ca95f84a510ac497b42  gcc/genrecog.cc
! b3871ec7bfbae048743120701fe55ae0  gcc/gensupport.cc
! b2448ada2a0bff917b804ee48360ab03  gcc/gensupport.h
  c577de233dc1e3d8f4a45bce5107a20c  gcc/gentarget-def.cc
  d285de23bd302c6655bc95327336a8ec  gcc/genversion.cc
  c0aa0732013643fc9d7c8fc68bb85d6d  gcc/ggc-common.cc
  56234852a29fc6118c202cd256865b62  gcc/ggc-internal.h
  474e70e7a6dcba6240b3fe2511616cfa  gcc/ggc-none.cc
! 8b2e3d5367a7b1cfb44670ac1ff6aa6e  gcc/ggc-page.cc
  f6879ae08660f73788b6b784022ca89a  gcc/ggc-tests.cc
  2a2d277a27eda24ce951c4e0b47b5201  gcc/ggc.h
  fc01aba2ef6a14714b1f93c8cf4194e4  gcc/gimple-array-bounds.cc
--- 6238,6251 ----
  29ee68ccc9844e3580e3e9f6da577778  gcc/genpeep.cc
  28d50caf61c98bed97742228c437ee13  gcc/genpreds.cc
  7ef07a14a26d6ca95f84a510ac497b42  gcc/genrecog.cc
! a9256309230010e93a8b24790769ea6d  gcc/gensupport.cc
! 5dcde5b50273b87ac36d108b0a6fe1df  gcc/gensupport.h
  c577de233dc1e3d8f4a45bce5107a20c  gcc/gentarget-def.cc
  d285de23bd302c6655bc95327336a8ec  gcc/genversion.cc
  c0aa0732013643fc9d7c8fc68bb85d6d  gcc/ggc-common.cc
  56234852a29fc6118c202cd256865b62  gcc/ggc-internal.h
  474e70e7a6dcba6240b3fe2511616cfa  gcc/ggc-none.cc
! 3f22c502e69545befd1d9a68f03adb4f  gcc/ggc-page.cc
  f6879ae08660f73788b6b784022ca89a  gcc/ggc-tests.cc
  2a2d277a27eda24ce951c4e0b47b5201  gcc/ggc.h
  fc01aba2ef6a14714b1f93c8cf4194e4  gcc/gimple-array-bounds.cc
*************** a0c225f8a1deb41873e5984a058b0f45  gcc/gi
*** 6271,6279 ****
  9d283d6d05cc10c386454e9c6a25e22a  gcc/gimple-loop-versioning.cc
  de516dc4a59882c258bf01584c25b2de  gcc/gimple-low.cc
  a507a70e7f4b0dd99e594d15a5a9a89b  gcc/gimple-low.h
! d0c07be6406911d79ae5087fbc68d02a  gcc/gimple-lower-bitint.cc
  bb02db160d1eb3a985d3b5dfa8e0566c  gcc/gimple-lower-bitint.h
! da1cba564288415af1f675747c508315  gcc/gimple-match-exports.cc
  144911a83796283e587e0c84378e118d  gcc/gimple-match-head.cc
  9a17a7550e34f5a6aec955c756b185fc  gcc/gimple-match.h
  8dfd9f3f97d0202e55771cf7594fbcb3  gcc/gimple-predicate-analysis.cc
--- 6269,6277 ----
  9d283d6d05cc10c386454e9c6a25e22a  gcc/gimple-loop-versioning.cc
  de516dc4a59882c258bf01584c25b2de  gcc/gimple-low.cc
  a507a70e7f4b0dd99e594d15a5a9a89b  gcc/gimple-low.h
! e43fafe86b4bb2bf4ce755e533b29a1b  gcc/gimple-lower-bitint.cc
  bb02db160d1eb3a985d3b5dfa8e0566c  gcc/gimple-lower-bitint.h
! 0b6c89d0a615bf5016f4e84ab164a6ca  gcc/gimple-match-exports.cc
  144911a83796283e587e0c84378e118d  gcc/gimple-match-head.cc
  9a17a7550e34f5a6aec955c756b185fc  gcc/gimple-match.h
  8dfd9f3f97d0202e55771cf7594fbcb3  gcc/gimple-predicate-analysis.cc
*************** f34f18b0bf45561aad0763e10bc1ecb1  gcc/lr
*** 6662,6668 ****
  f2a9985147f87fd566d4ae2dd8fceabc  gcc/lto-section-names.h
  92ad85d667fb88ca0d727d1081d5a438  gcc/lto-section-out.cc
  022eda68922792984b6370af859619e4  gcc/lto-streamer-in.cc
! 054a9b36fe2ded148a1b5a48f0045193  gcc/lto-streamer-out.cc
  8caf9a68892d64dc294b20c27291b749  gcc/lto-streamer.cc
  89440b8d71857e40c8fa12dd9aa25491  gcc/lto-streamer.h
  e94a0111912c76e65824bb88bf99f44c  gcc/lto-wrapper.cc
--- 6660,6666 ----
  f2a9985147f87fd566d4ae2dd8fceabc  gcc/lto-section-names.h
  92ad85d667fb88ca0d727d1081d5a438  gcc/lto-section-out.cc
  022eda68922792984b6370af859619e4  gcc/lto-streamer-in.cc
! 295f167dcf44ebe2d16bceae99571c42  gcc/lto-streamer-out.cc
  8caf9a68892d64dc294b20c27291b749  gcc/lto-streamer.cc
  89440b8d71857e40c8fa12dd9aa25491  gcc/lto-streamer.h
  e94a0111912c76e65824bb88bf99f44c  gcc/lto-wrapper.cc
*************** e44c0bf9cc0411d7bd57c6585eb6d0e4  gcc/lt
*** 6690,6696 ****
  b417a4bd52371186803e70c49d24764d  gcc/m2/COPYING.RUNTIME
  8f0e2cd40e05189ec81232da84bd6e1a  gcc/m2/COPYING3
  6a6a8e020838b23406c81b19c1d46df6  gcc/m2/COPYING3.LIB
! de93a9cbed2bdc69c17f18891cdbd422  gcc/m2/ChangeLog
  33352ea845a8d2399793299f3e58a218  gcc/m2/Make-lang.in
  93fe99bf456561cd217f1c93d2ab7da7  gcc/m2/Make-maintainer.in
  6a74129fda00ca52ba9f953538250c45  gcc/m2/NEWS
--- 6688,6694 ----
  b417a4bd52371186803e70c49d24764d  gcc/m2/COPYING.RUNTIME
  8f0e2cd40e05189ec81232da84bd6e1a  gcc/m2/COPYING3
  6a6a8e020838b23406c81b19c1d46df6  gcc/m2/COPYING3.LIB
! 4c29c1f1467edefd2bb5034f06901c70  gcc/m2/ChangeLog
  33352ea845a8d2399793299f3e58a218  gcc/m2/Make-lang.in
  93fe99bf456561cd217f1c93d2ab7da7  gcc/m2/Make-maintainer.in
  6a74129fda00ca52ba9f953538250c45  gcc/m2/NEWS
*************** f2f6ad340399124ac1dd7765e1b675a5  gcc/m2
*** 6749,6755 ****
  b3c98d490dd50cdd4e4de316e0deca54  gcc/m2/gm2-compiler/M2GCCDeclare.def
  0334dee0562359e9a335b23e63acc113  gcc/m2/gm2-compiler/M2GCCDeclare.mod
  3d68446acff53fae7c5d6c425f0cf67e  gcc/m2/gm2-compiler/M2GenGCC.def
! 4304e125ac84b77de47e28550c396339  gcc/m2/gm2-compiler/M2GenGCC.mod
  273c623529a07acbf2f80b58e2d7567e  gcc/m2/gm2-compiler/M2Graph.def
  4e2b3a2e0b4cc7af0785ab9e41438e6b  gcc/m2/gm2-compiler/M2Graph.mod
  0d543e40ef3f1bcdf8edf9e06baa1edb  gcc/m2/gm2-compiler/M2LangDump.def
--- 6747,6753 ----
  b3c98d490dd50cdd4e4de316e0deca54  gcc/m2/gm2-compiler/M2GCCDeclare.def
  0334dee0562359e9a335b23e63acc113  gcc/m2/gm2-compiler/M2GCCDeclare.mod
  3d68446acff53fae7c5d6c425f0cf67e  gcc/m2/gm2-compiler/M2GenGCC.def
! 48ce93daedd6c94ddc930c46264bf94a  gcc/m2/gm2-compiler/M2GenGCC.mod
  273c623529a07acbf2f80b58e2d7567e  gcc/m2/gm2-compiler/M2Graph.def
  4e2b3a2e0b4cc7af0785ab9e41438e6b  gcc/m2/gm2-compiler/M2Graph.mod
  0d543e40ef3f1bcdf8edf9e06baa1edb  gcc/m2/gm2-compiler/M2LangDump.def
*************** f9608e9005487c369e6c38949ab36fa1  gcc/m2
*** 7633,7639 ****
  88e10618d6f39a411b34e2245b93307b  gcc/machmode.def
  db2ee1a68662c8370d59f7e4f6cf917b  gcc/machmode.h
  486412acbbb6de10b080e31410a14f33  gcc/main.cc
! 1c7f72caf770418dfd6f1fffa1baa93d  gcc/match.pd
  63bf182c7c3a100e101b2129976be89b  gcc/mcf.cc
  795fbbc034a60f5af7e79dbe3bac65a0  gcc/mem-stats-traits.h
  295dcd7618653c13dcf063266752d06f  gcc/mem-stats.h
--- 7631,7637 ----
  88e10618d6f39a411b34e2245b93307b  gcc/machmode.def
  db2ee1a68662c8370d59f7e4f6cf917b  gcc/machmode.h
  486412acbbb6de10b080e31410a14f33  gcc/main.cc
! 471f52dc9f57af25d4b404e048625cff  gcc/match.pd
  63bf182c7c3a100e101b2129976be89b  gcc/mcf.cc
  795fbbc034a60f5af7e79dbe3bac65a0  gcc/mem-stats-traits.h
  295dcd7618653c13dcf063266752d06f  gcc/mem-stats.h
*************** d6625bf8e7676e7c0d45da5ca515ab06  gcc/re
*** 7805,7811 ****
  d88ebbb33fb2dcd60634dd11046fb909  gcc/ree.cc
  40ff12eae68d7c45fee63cfa20a67634  gcc/reg-notes.def
  d9a5b27b6a11b7f53410e3e8959a2d6b  gcc/reg-stack.cc
! 326cfd57c1bbde18df46f04749c95d4c  gcc/regcprop.cc
  a15f939ddd4de2fc2a6dc44a5344d39f  gcc/regcprop.h
  fcafe43f1a7955c6e00e7b1301dae7ad  gcc/regenerate-attr-urls.py
  3779a015e4f5337a24cf38a89c57eea8  gcc/regenerate-opt-urls.py
--- 7803,7809 ----
  d88ebbb33fb2dcd60634dd11046fb909  gcc/ree.cc
  40ff12eae68d7c45fee63cfa20a67634  gcc/reg-notes.def
  d9a5b27b6a11b7f53410e3e8959a2d6b  gcc/reg-stack.cc
! 5f5e42d9a84ab1e8ffc40fa2cbbd1194  gcc/regcprop.cc
  a15f939ddd4de2fc2a6dc44a5344d39f  gcc/regcprop.h
  fcafe43f1a7955c6e00e7b1301dae7ad  gcc/regenerate-attr-urls.py
  3779a015e4f5337a24cf38a89c57eea8  gcc/regenerate-opt-urls.py
*************** add2ef65d80adc09236eaff62179a1fe  gcc/rt
*** 7848,7854 ****
  f39c55472711c984059aff01fd972f31  gcc/rtl-tests.cc
  1105088521e8de72d332faeda31306c7  gcc/rtl.cc
  41ece3c6a40e9a14609645318016e228  gcc/rtl.def
! e390dda8ed56a23de938d5081f0a8da3  gcc/rtl.h
  4ee5bf7f59df8ad15a444be0bc71cb4e  gcc/rtlanal.cc
  e38f02dbd2d0d8c027ccae4b785f3fb2  gcc/rtlanal.h
  f829c444b36f34672cb4a7b019c4513b  gcc/rtlhash.cc
--- 7846,7852 ----
  f39c55472711c984059aff01fd972f31  gcc/rtl-tests.cc
  1105088521e8de72d332faeda31306c7  gcc/rtl.cc
  41ece3c6a40e9a14609645318016e228  gcc/rtl.def
! 325c220265233bde9a9a0bf35ba8fecb  gcc/rtl.h
  4ee5bf7f59df8ad15a444be0bc71cb4e  gcc/rtlanal.cc
  e38f02dbd2d0d8c027ccae4b785f3fb2  gcc/rtlanal.h
  f829c444b36f34672cb4a7b019c4513b  gcc/rtlhash.cc
*************** b1497a03867668af210c32280876fdd7  gcc/sy
*** 8441,8447 ****
  b4bbfe8a8f62eed5c75429762e88d324  gcc/targhooks.cc
  ae57260b8b60d8b8dfaef3556c3ac5e5  gcc/targhooks.h
  f39fcaa8197187283ccfed40107b426d  gcc/testsuite/.gitattributes
! 2ba6da70ca16b9ebfbaeb9d2ea27ac58  gcc/testsuite/ChangeLog
  47e8e29b649ead73b8a1e4797da470ed  gcc/testsuite/ChangeLog-1993-2007
  35198a9e4fd31b935de8789faabf3351  gcc/testsuite/ChangeLog-2008
  0f19934540750356d1b91595cebfd9a8  gcc/testsuite/ChangeLog-2009
--- 8439,8445 ----
  b4bbfe8a8f62eed5c75429762e88d324  gcc/targhooks.cc
  ae57260b8b60d8b8dfaef3556c3ac5e5  gcc/targhooks.h
  f39fcaa8197187283ccfed40107b426d  gcc/testsuite/.gitattributes
! 12da2c7ca7875baac09fdec412c2e929  gcc/testsuite/ChangeLog
  47e8e29b649ead73b8a1e4797da470ed  gcc/testsuite/ChangeLog-1993-2007
  35198a9e4fd31b935de8789faabf3351  gcc/testsuite/ChangeLog-2008
  0f19934540750356d1b91595cebfd9a8  gcc/testsuite/ChangeLog-2009
*************** bfae96a490c7cba054de8558e4626226  gcc/te
*** 8468,11076 ****
  fea5c64eccba058feddfd469dbdc5077  gcc/testsuite/README.compat
  7a54bd63031c5c648bd6caa0928bacad  gcc/testsuite/README.gcc
  2ad7c00ea00d78f6d6ee090f7894dadc  gcc/testsuite/ada/.gitignore
! 4004844198395fe50ecb798ed5d30f4b  gcc/testsuite/ada/acats/elabd.lst
! b32871a59b0c07cb4eda259b98fa6aab  gcc/testsuite/ada/acats/floatstore.lst
! bb4e4f9d3c0e72730e0bf397d375689c  gcc/testsuite/ada/acats/norun.lst
! 17a66c0b337fb03b6f449227ed33297c  gcc/testsuite/ada/acats/overflow.lst
! 1485f263dfb9303b015015ae88161a8b  gcc/testsuite/ada/acats/run_acats.sh
! 71bb2dcd4df7ad579edf271669be44d6  gcc/testsuite/ada/acats/run_all.sh
! 6467abb463602aeb04583b3822f653f4  gcc/testsuite/ada/acats/run_test.exp
! 5723a26fced8721c3e90e6e7a9ba2a23  gcc/testsuite/ada/acats/stackcheck.lst
! feaec71549d40900aa5bcbd842c9fa57  gcc/testsuite/ada/acats/support/acats26.lst
! 2f262cdb98b38922d7b7f84414f43b84  gcc/testsuite/ada/acats/support/checkfil.ada
! 4edf20410814582eae331707f2ae2c77  gcc/testsuite/ada/acats/support/enumchek.ada
! 8f3ec4fe93c0095e34d79e9a41dde4e9  gcc/testsuite/ada/acats/support/f340a000.a
! b673a17611516bde0712458de61636e8  gcc/testsuite/ada/acats/support/f340a001.a
! b31158ceea90e5246f63aed8b0078e9c  gcc/testsuite/ada/acats/support/f341a00.a
! d3d954612d4f455a32df07aa05816320  gcc/testsuite/ada/acats/support/f390a00.a
! ed3b5aee8f81d147785adce6b48411cd  gcc/testsuite/ada/acats/support/f392a00.a
! 7973b64953275c03e790967bc310010c  gcc/testsuite/ada/acats/support/f392c00.a
! 7b5b9e45fb9003af0e096ca36327031e  gcc/testsuite/ada/acats/support/f392d00.a
! e4733abdf62c401a876d29c3e5a38c34  gcc/testsuite/ada/acats/support/f393a00.a
! c1487dd34771abf18d1144c610fac26e  gcc/testsuite/ada/acats/support/f393b00.a
! b3e35321e808d9e061d1fdef51813016  gcc/testsuite/ada/acats/support/f3a2a00.a
! 798afd3c6228223e07e7c8e3034eb99c  gcc/testsuite/ada/acats/support/f460a00.a
! 316c7cde49ee557a67d39d6b63407811  gcc/testsuite/ada/acats/support/f730a000.a
! 60edd601c25022d0f19b8c45d3d187bb  gcc/testsuite/ada/acats/support/f730a001.a
! 75b2405f0dd739649bda9b92b0d259f4  gcc/testsuite/ada/acats/support/f731a00.a
! 689c49d9ccb5124d47eecb1dcebcc376  gcc/testsuite/ada/acats/support/f940a00.a
! d08e91b98a54c3d471108a6631714033  gcc/testsuite/ada/acats/support/f954a00.a
! f95be63eadf08e7cafbeb33a6794c019  gcc/testsuite/ada/acats/support/fa11a00.a
! 28be0e2126b177ff6d34df7c272a9f2c  gcc/testsuite/ada/acats/support/fa11b00.a
! 2228808bf25eecbd9e02ff343e2dba54  gcc/testsuite/ada/acats/support/fa11c00.a
! 1cb03e4473720d064b6798cf5e185f62  gcc/testsuite/ada/acats/support/fa11d00.a
! ff082a3957be5f526713103bf563e5be  gcc/testsuite/ada/acats/support/fa13a00.a
! dfa6bb61642b6c22f17171fb93cfc97c  gcc/testsuite/ada/acats/support/fa13b00.a
! 54b899e09f3f0bf28db2e007ca6921e5  gcc/testsuite/ada/acats/support/fa21a00.a
! 97d3fd68d030a5d89e98b950d557151d  gcc/testsuite/ada/acats/support/fb20a00.a
! 886f3ad8c51e9e1e01cb7d4ab0b3f47e  gcc/testsuite/ada/acats/support/fb40a00.a
! 045b4b77241122260c9b42a0a85941b8  gcc/testsuite/ada/acats/support/fc50a00.a
! d2c427a2c2e845d2d5991d7e86689284  gcc/testsuite/ada/acats/support/fc51a00.a
! 18eee0e1727cb58b8ca0da52a8f7fbd0  gcc/testsuite/ada/acats/support/fc51b00.a
! 707c153d9868ec6e694e8db161e9a7c7  gcc/testsuite/ada/acats/support/fc51c00.a
! 981a728516c5de4f242cff81d35a1806  gcc/testsuite/ada/acats/support/fc51d00.a
! 992e25818babbd2519c54f2dc5987601  gcc/testsuite/ada/acats/support/fc54a00.a
! f75e17c909e83e1879e87a3ba3ffd7cc  gcc/testsuite/ada/acats/support/fc70a00.a
! cdb7ee32751757a29e821ba020228a0e  gcc/testsuite/ada/acats/support/fc70b00.a
! 8af79a6be55981313da73bc0bb01f617  gcc/testsuite/ada/acats/support/fc70c00.a
! 65011f4705018476715af62324c335b3  gcc/testsuite/ada/acats/support/fcndecl.ada
! 3ce3384936274aa48a8c4a38fa7109ac  gcc/testsuite/ada/acats/support/fd72a00.a
! 5c9a93b4c9f45c15707e4b3b123aee9c  gcc/testsuite/ada/acats/support/fdb0a00.a
! bf9c7650a6f8303b6a69ff5eb2660b15  gcc/testsuite/ada/acats/support/fdd2a00.a
! a77ebc244676daacb1f3a61ae8003e88  gcc/testsuite/ada/acats/support/fxa5a00.a
! f4e9649e424fa9578180b9aee65c8e96  gcc/testsuite/ada/acats/support/fxaca00.a
! caa75442e4dceed0740dfa35a47b5bb6  gcc/testsuite/ada/acats/support/fxacb00.a
! 1855abc6c615b76aa82fb9241571f3d8  gcc/testsuite/ada/acats/support/fxacc00.a
! f88af2b3eb53ad7c8700efbd0f878915  gcc/testsuite/ada/acats/support/fxc6a00.a
! 56ba35dd56ea544c0eb9146769871492  gcc/testsuite/ada/acats/support/fxe2a00.a
! 67770e9161b0f48f3fc9392bd3460272  gcc/testsuite/ada/acats/support/fxf2a00.a
! 6628969f51dd10c56235f9d7420e2d44  gcc/testsuite/ada/acats/support/fxf3a00.a
! 6a9b6ce90538e9126e7e5badc62ddca2  gcc/testsuite/ada/acats/support/impbit.adb
! 1ccb5211fbcff1d5604e6ccee6542df7  gcc/testsuite/ada/acats/support/impdef.a
! 4f2f9bfdfcfd8c5ecaf503416d1cfc5f  gcc/testsuite/ada/acats/support/impdefd.a
! edf70d423a69adebd38e9b29f35a2ba1  gcc/testsuite/ada/acats/support/impdefe.a
! cadfd8a5487a315a6fbd8eef397219e9  gcc/testsuite/ada/acats/support/impdefg.a
! 5d9a0f98d9f15211e0773263febb974b  gcc/testsuite/ada/acats/support/impdefh.a
! f2604ccc5244696793b33e7b83c57c45  gcc/testsuite/ada/acats/support/lencheck.ada
! 79c0994222b2a5fc702eb4bc3dc1ba8e  gcc/testsuite/ada/acats/support/macro.dfs
! 72980ae1a3bbd5b71aa915cefeaebf6e  gcc/testsuite/ada/acats/support/macrodef.adb
! 4d7b79a3ff077d1ab05a78ebcf5a1de3  gcc/testsuite/ada/acats/support/macrosub.ada
! 29539981686659a32e9b3a46eafe0a56  gcc/testsuite/ada/acats/support/repbody.ada
! ec6c02ebb16da7cc117e3a65c06d385a  gcc/testsuite/ada/acats/support/repspec.ada
! 356cf4b2e0cc1e02ef1deddb5567de36  gcc/testsuite/ada/acats/support/spprt13s.tst
! e250c306fa98a053bdf37159af289d57  gcc/testsuite/ada/acats/support/tctouch.ada
! 26945b868319fda8b82f82c677a35562  gcc/testsuite/ada/acats/support/tsttests.dat
! 91c39a37d5651ca4a1e6aa82cd2f1269  gcc/testsuite/ada/acats/support/widechr.a
! dc179b8a7c506c961b229b7ec7d2de53  gcc/testsuite/ada/acats/tests/a/a22006b.ada
! f61ae49f8066de3ba349e39d3a688ea6  gcc/testsuite/ada/acats/tests/a/a22006c.ada
! 54e5a501bbefb19fdf7715f5741fc858  gcc/testsuite/ada/acats/tests/a/a22006d.ada
! 11394a122edd516a587d020bc9ce2e8e  gcc/testsuite/ada/acats/tests/a/a26007a.tst
! aa57a75b85b36a99f6ecaca91a9eed60  gcc/testsuite/ada/acats/tests/a/a27003a.ada
! 054ca4c1bbb5dd701e8781bc92bf9cb8  gcc/testsuite/ada/acats/tests/a/a29003a.ada
! c330e5a362289a57c2ca975a61b4d20c  gcc/testsuite/ada/acats/tests/a/a2a031a.ada
! bbd0059e56828aa342048400c5490233  gcc/testsuite/ada/acats/tests/a/a33003a.ada
! 84de33e1cd2c3a0c2165591a28407805  gcc/testsuite/ada/acats/tests/a/a34017c.ada
! 924373fa4803a6e22fdc43bd0bee31a3  gcc/testsuite/ada/acats/tests/a/a35101b.ada
! be270ea90b999a2136e6cc850543a945  gcc/testsuite/ada/acats/tests/a/a35402a.ada
! 8054f52aa40d34c334d3a4b30222340a  gcc/testsuite/ada/acats/tests/a/a35801f.ada
! 325ee8ec767c6769757ac1eb71d6f515  gcc/testsuite/ada/acats/tests/a/a35902c.ada
! c512e91af19d8cf3307b189ec712dde0  gcc/testsuite/ada/acats/tests/a/a38106d.ada
! 8d608afb4ab9b953fd4dd01b00a90914  gcc/testsuite/ada/acats/tests/a/a38106e.ada
! 28bab0e5eb84a43ad0b4dc06d90f880b  gcc/testsuite/ada/acats/tests/a/a49027a.ada
! 5b6e07973ea9075de594e462d6f0f847  gcc/testsuite/ada/acats/tests/a/a49027b.ada
! 926d6ade013a1456d53a17063495aaf2  gcc/testsuite/ada/acats/tests/a/a49027c.ada
! df2270ff569c843d152cae1fc3606103  gcc/testsuite/ada/acats/tests/a/a54b01a.ada
! 71937fafcd3199a3eda330e7880c1ec5  gcc/testsuite/ada/acats/tests/a/a54b02a.ada
! 1aa0f31635199e1096468f23888a66f4  gcc/testsuite/ada/acats/tests/a/a55b12a.ada
! b0fc7cf66a832e68c808ed89a23340d1  gcc/testsuite/ada/acats/tests/a/a55b13a.ada
! 205552e2dafa2b699b6514e12a35e676  gcc/testsuite/ada/acats/tests/a/a55b14a.ada
! 7a5be75ac2dc323c1dd1e9328c39c6e0  gcc/testsuite/ada/acats/tests/a/a71004a.ada
! 69bd6dadfe4d61041f1998157bcbdb4a  gcc/testsuite/ada/acats/tests/a/a73001i.ada
! 8b949ce02d53bc2b35893d05656ff3c2  gcc/testsuite/ada/acats/tests/a/a73001j.ada
! 3859ef22068457dc5db7b84889f89c07  gcc/testsuite/ada/acats/tests/a/a74105b.ada
! 5200e86147d7eddb31de36b182066003  gcc/testsuite/ada/acats/tests/a/a74106a.ada
! d288f454e96b3840804c86245fd1309c  gcc/testsuite/ada/acats/tests/a/a74106b.ada
! c6c2ff5c654f5fecb72565c1ec890ea8  gcc/testsuite/ada/acats/tests/a/a74106c.ada
! 4526ae74da58946736d1077ca17b0f15  gcc/testsuite/ada/acats/tests/a/a74205e.ada
! a4600113362b659154e0921e8ccc440b  gcc/testsuite/ada/acats/tests/a/a74205f.ada
! 762682eaddf9e0d72ef370ddf52c091c  gcc/testsuite/ada/acats/tests/a/a83009a.ada
! 89be8e66cfa8cf7d9ea962fc92c5bbe6  gcc/testsuite/ada/acats/tests/a/a83009b.ada
! 1a86aa84a5b4a8f2d91898a2a5878109  gcc/testsuite/ada/acats/tests/a/a83a02a.ada
! b50d55495ed25cd5f5f0cc5ce62c33c6  gcc/testsuite/ada/acats/tests/a/a83a02b.ada
! 92d9af0f50f62b8ca3df28d8e4228ec5  gcc/testsuite/ada/acats/tests/a/a83a06a.ada
! 5c0b43d5d9e1251dce20fd8ac69811a8  gcc/testsuite/ada/acats/tests/a/a83a08a.ada
! d847c2fa25d9becc828716d2f6b3924e  gcc/testsuite/ada/acats/tests/a/a83c01c.ada
! 48efd44cb0cc48a4666ca9078d516a19  gcc/testsuite/ada/acats/tests/a/a83c01h.ada
! 9a14ce84b1e63358e8ea5b22b8b58366  gcc/testsuite/ada/acats/tests/a/a83c01i.ada
! d4b236b43806323a12df387d43065ecd  gcc/testsuite/ada/acats/tests/a/a85007d.ada
! 22b51a96b02c7a88f7ef1383e4b6e3ba  gcc/testsuite/ada/acats/tests/a/a85013b.ada
! 401bca9a32ad0d8881ea660bba3ca711  gcc/testsuite/ada/acats/tests/a/a87b59a.ada
! 74d0779474d9d789d09508ba653efc61  gcc/testsuite/ada/acats/tests/a/a95001c.ada
! 4de434af68116383b58aae2d7ff0186e  gcc/testsuite/ada/acats/tests/a/a95074d.ada
! 6dcac89d281ffc1c47dc51dfd7429d9e  gcc/testsuite/ada/acats/tests/a/a97106a.ada
! 672a004e783873caffaddfe2e9ed7184  gcc/testsuite/ada/acats/tests/a/a99006a.ada
! d338cf80520cfcd59896b08557f7334a  gcc/testsuite/ada/acats/tests/a/aa2010a.ada
! c8652c11c39145beb7535ff59feee79b  gcc/testsuite/ada/acats/tests/a/aa2012a.ada
! 64d7f9e70085b7412df08b06b70924f1  gcc/testsuite/ada/acats/tests/a/ac1015b.ada
! f8019419f138b9b0b4e860f560539c52  gcc/testsuite/ada/acats/tests/a/ac3106a.ada
! 599863dbc7677bd83fe020c38e11b4b8  gcc/testsuite/ada/acats/tests/a/ac3206a.ada
! 527cf1506ce6e0451f82e833aba4b6b3  gcc/testsuite/ada/acats/tests/a/ac3207a.ada
! 7c28607179138101a5d7cf088f333028  gcc/testsuite/ada/acats/tests/a/ad7001b.ada
! 810035c64fe589563087a2d2f380f1e4  gcc/testsuite/ada/acats/tests/a/ad7001c0.ada
! 8d92b2b79dbfd08d90c9a238b1e35a05  gcc/testsuite/ada/acats/tests/a/ad7001c1.ada
! 1c1c6e5fb42029a3ff9b1f3b9055c191  gcc/testsuite/ada/acats/tests/a/ad7001d0.ada
! 21257b0cc94669e31a8891cb9ed30e14  gcc/testsuite/ada/acats/tests/a/ad7001d1.ada
! eaa4c7b6b00bcd4bfa2d9883aff64ee8  gcc/testsuite/ada/acats/tests/a/ad7006a.ada
! b93c425e39dd1e4003cb33131862e719  gcc/testsuite/ada/acats/tests/a/ad7101a.ada
! 07e115c2bd0ac4bc085809d9ad65327f  gcc/testsuite/ada/acats/tests/a/ad7101c.ada
! 24888691f9cd0131679078391bf99fb1  gcc/testsuite/ada/acats/tests/a/ad7102a.ada
! 27abfa60261b508014d366ae82e296fe  gcc/testsuite/ada/acats/tests/a/ad7103a.ada
! aec3e74553448f599ae9a51ec65c42ce  gcc/testsuite/ada/acats/tests/a/ad7103c.ada
! d18cab7f102ffc27545ccb4522f82ded  gcc/testsuite/ada/acats/tests/a/ad7104a.ada
! 1b797aacfde0d671d89a45db2a9d5be2  gcc/testsuite/ada/acats/tests/a/ad7201a.ada
! 8c49706fbc8916aacd037e7649ed8213  gcc/testsuite/ada/acats/tests/a/ad7203b.ada
! 129af6b1b47884872132fcfc3787f362  gcc/testsuite/ada/acats/tests/a/ad7205b.ada
! 696b85c4c78cdc9b5448612a22b9ffa3  gcc/testsuite/ada/acats/tests/a/ad8011a.tst
! bfa3fa83b466b71da4126d005e2c701b  gcc/testsuite/ada/acats/tests/a/ada101a.ada
! 178bb6ff2316e9cfb5bd4395e74874ae  gcc/testsuite/ada/acats/tests/a/ae2113a.ada
! 1dd247cf1f02e4384b1f1a58ab2244c0  gcc/testsuite/ada/acats/tests/a/ae2113b.ada
! 5ff7c493a66eb8be0a3e7f89bd4d2512  gcc/testsuite/ada/acats/tests/a/ae3002g.ada
! 2cc8c13fd1203af7f246cee23d3037c3  gcc/testsuite/ada/acats/tests/a/ae3101a.ada
! 3798d627b7336c5fa8805e970e10ec7e  gcc/testsuite/ada/acats/tests/a/ae3702a.ada
! 7a44891c6ee0ec272ded72e61d392bc8  gcc/testsuite/ada/acats/tests/a/ae3709a.ada
! 8a42b2199ecbb25390c8c306c3759312  gcc/testsuite/ada/acats/tests/c2/c23001a.ada
! 8d4b3f4069aeb0e32db3f46e5cb1487b  gcc/testsuite/ada/acats/tests/c2/c23003a.tst
! 95e1beb36e033514e6e4be866042a42a  gcc/testsuite/ada/acats/tests/c2/c23003b.tst
! a765ec985184f6802389b89d0971eede  gcc/testsuite/ada/acats/tests/c2/c23003g.tst
! 53bdd26032ff323b57f3c309b520767e  gcc/testsuite/ada/acats/tests/c2/c23003i.tst
! d8470ff80210b6aeab8ecf5828f8e73c  gcc/testsuite/ada/acats/tests/c2/c23006a.ada
! c175938807f9ed5ec36eed8c2fc47bf2  gcc/testsuite/ada/acats/tests/c2/c23006b.ada
! 1891f1d94ad6f27dc8691abae763b735  gcc/testsuite/ada/acats/tests/c2/c23006c.ada
! 4d2aaab0f8577c4441dfb223b74e9270  gcc/testsuite/ada/acats/tests/c2/c23006d.ada
! d38fc16a6b2a221a8089094d8e595fd0  gcc/testsuite/ada/acats/tests/c2/c23006e.ada
! e4cb34f327ded980acbb2890f276b1b6  gcc/testsuite/ada/acats/tests/c2/c23006f.ada
! 1afe1ff732d7c93eb72aeb763fc3a3e4  gcc/testsuite/ada/acats/tests/c2/c23006g.ada
! d7a2fe8807a7e954f894e43619906c61  gcc/testsuite/ada/acats/tests/c2/c24002d.ada
! 90b7096d0092e8bee54a5e0931480cc3  gcc/testsuite/ada/acats/tests/c2/c24003a.ada
! 8d4b3197420dea97b47fa445d6b7f13e  gcc/testsuite/ada/acats/tests/c2/c24003b.ada
! c0bc49ad0d9faebe7c1bddd17682575b  gcc/testsuite/ada/acats/tests/c2/c24003c.ada
! 474d9480579f044d63ea2312eee797a0  gcc/testsuite/ada/acats/tests/c2/c24106a.ada
! 21abd0c844a441282df97eca59d187ac  gcc/testsuite/ada/acats/tests/c2/c24202d.ada
! f8734f0cb78893a591c1455798f48f34  gcc/testsuite/ada/acats/tests/c2/c24203a.ada
! 303fe85abf30e67b9c26c05c37527377  gcc/testsuite/ada/acats/tests/c2/c24203b.ada
! 4fc421f9d26dd38caa8e66e5f9a8118d  gcc/testsuite/ada/acats/tests/c2/c24207a.ada
! 00805111547e7b0f767a65dbb0216178  gcc/testsuite/ada/acats/tests/c2/c24211a.ada
! 9344f5c2db357b3b873a83422c449d0b  gcc/testsuite/ada/acats/tests/c2/c250001.aw
! fc57da7b290e833c22ee1e312ebea0af  gcc/testsuite/ada/acats/tests/c2/c250002.aw
! fcffacb0c5a7d6bc171b2b62228ef27c  gcc/testsuite/ada/acats/tests/c2/c25001a.ada
! f8101111006b8dfccb57bc9286761546  gcc/testsuite/ada/acats/tests/c2/c25001b.ada
! 4d59f28ccd2a2792f59d358acfb3b645  gcc/testsuite/ada/acats/tests/c2/c26006a.ada
! 2a3847aff34c962069ea9fc46184b49c  gcc/testsuite/ada/acats/tests/c2/c26008a.ada
! 3b3d12a94cdb249ade26bb6fe45121be  gcc/testsuite/ada/acats/tests/c2/c2a001a.ada
! 3fd11c60327272b0e88714377e07694a  gcc/testsuite/ada/acats/tests/c2/c2a001b.ada
! fad7c83b08db79e3d8d41a3abc495609  gcc/testsuite/ada/acats/tests/c2/c2a001c.ada
! 9e58903d92e80dece18b3f5f07c10714  gcc/testsuite/ada/acats/tests/c2/c2a002a.ada
! 80f047f9baf4edce16ae00b242937e09  gcc/testsuite/ada/acats/tests/c2/c2a008a.ada
! 5846b01316c8e35b2ae9271e2ceeb33b  gcc/testsuite/ada/acats/tests/c2/c2a021b.ada
! 6c6e6ac7e7d8151372bf25d5bfcc4638  gcc/testsuite/ada/acats/tests/c3/c32001a.ada
! f44d3e1d8c4deff3e60e49eb14755c7f  gcc/testsuite/ada/acats/tests/c3/c32001b.ada
! 90383af3c35e304193502497e9d9ada0  gcc/testsuite/ada/acats/tests/c3/c32001c.ada
! 6f38031cf1bc7fd3a2530a0a49fc3927  gcc/testsuite/ada/acats/tests/c3/c32001d.ada
! 4cff8a5cde793b9eb72e56ef8588c690  gcc/testsuite/ada/acats/tests/c3/c32001e.ada
! fe386611f5a09953fdbdb423b0673b0b  gcc/testsuite/ada/acats/tests/c3/c32107a.ada
! 6dcc55a41a077f43caf697ae83ae4678  gcc/testsuite/ada/acats/tests/c3/c32107c.ada
! 6bc3a589ff71140e94718588fa9f9c34  gcc/testsuite/ada/acats/tests/c3/c32108a.ada
! 0b55a6ac879d361c4eaa8a25a475c92e  gcc/testsuite/ada/acats/tests/c3/c32108b.ada
! 4520bac74d324253fcf2b48b5c6eea2b  gcc/testsuite/ada/acats/tests/c3/c32111a.ada
! 52ac5c461c7746717a0d789fb2a57377  gcc/testsuite/ada/acats/tests/c3/c32111b.ada
! dabad6f6cae80313a5a888aaa710756d  gcc/testsuite/ada/acats/tests/c3/c32112b.ada
! eebc548a818a1f56ce990f52129e4296  gcc/testsuite/ada/acats/tests/c3/c32113a.ada
! 016d6073dcc33d7b8106082eb7755faa  gcc/testsuite/ada/acats/tests/c3/c32115a.ada
! a613215b48d8c873069bb2d690d5f556  gcc/testsuite/ada/acats/tests/c3/c32115b.ada
! f21dc71d940d5c06af5d22f69eab60f9  gcc/testsuite/ada/acats/tests/c3/c330001.a
! 74812d0708e93af61e096b45e2fc14ec  gcc/testsuite/ada/acats/tests/c3/c330002.a
! 8e5fef6b3dfabbb753bbf97caf8dddae  gcc/testsuite/ada/acats/tests/c3/c332001.a
! d7ae35646e985b47bde736b4aeadaec1  gcc/testsuite/ada/acats/tests/c3/c340001.a
! 029cfe27a33cb66b049fe0d0fb65381b  gcc/testsuite/ada/acats/tests/c3/c34001a.ada
! 7f88e5135c6832cdc88dff48cc8dafee  gcc/testsuite/ada/acats/tests/c3/c34001c.ada
! 8c1764692d7cb0bc17a952ce68b59db8  gcc/testsuite/ada/acats/tests/c3/c34001d.ada
! a08af1aeb3b4af40be4e8250cad56d8d  gcc/testsuite/ada/acats/tests/c3/c34001f.ada
! 796e76f308a9d18762b63a8a7c9fa6ec  gcc/testsuite/ada/acats/tests/c3/c34002a.ada
! 56ca2500660f86690e43b4eb2c63911d  gcc/testsuite/ada/acats/tests/c3/c34002c.ada
! 916814d1426aeb62617f0e647f1425f4  gcc/testsuite/ada/acats/tests/c3/c34003a.ada
! 7848bad56990231ec4964a5294f4d02f  gcc/testsuite/ada/acats/tests/c3/c34003c.ada
! 3f596cd960a8968d7c7892b7351e85fa  gcc/testsuite/ada/acats/tests/c3/c34004a.ada
! f25b6504d96e3e21099abd8a985bfe40  gcc/testsuite/ada/acats/tests/c3/c34004c.ada
! 10feabd33f2004943d36ff9acac0bda3  gcc/testsuite/ada/acats/tests/c3/c34005a.ada
! 9b730174260769c83e1d1f34a482b64c  gcc/testsuite/ada/acats/tests/c3/c34005c.ada
! d8cd66825d35a0c2eee7a2bc22021fde  gcc/testsuite/ada/acats/tests/c3/c34005d.ada
! fd5b17683accebcffccf7d52a88ba813  gcc/testsuite/ada/acats/tests/c3/c34005f.ada
! 5a2119c2d54f4427832bc1c61d913eac  gcc/testsuite/ada/acats/tests/c3/c34005g.ada
! 170b45f6069790926570bd39f97033ea  gcc/testsuite/ada/acats/tests/c3/c34005i.ada
! bdf673ae022cc1b217f6ea84218ef460  gcc/testsuite/ada/acats/tests/c3/c34005j.ada
! 0c6f4909c9db9787b9ca4d3b296a3ae9  gcc/testsuite/ada/acats/tests/c3/c34005l.ada
! 7f1441892699c24f145df474c396124d  gcc/testsuite/ada/acats/tests/c3/c34005m.ada
! f851c156716ece972741b1a161b80b5f  gcc/testsuite/ada/acats/tests/c3/c34005o.ada
! 043754af8734117b693825059b2d22bb  gcc/testsuite/ada/acats/tests/c3/c34005p.ada
! 38b03276fbc9b35694fc4d3d2b1256ef  gcc/testsuite/ada/acats/tests/c3/c34005r.ada
! b1e254368a79c887afcaae46814d1508  gcc/testsuite/ada/acats/tests/c3/c34005s.ada
! 1f4c22b0cf2e5dfbe3648ebb2db7263a  gcc/testsuite/ada/acats/tests/c3/c34005u.ada
! ee6486739b27542ae2e06bf404248adf  gcc/testsuite/ada/acats/tests/c3/c34005v.ada
! 60d73ec320d9ef0db0dc330bb3e04fe5  gcc/testsuite/ada/acats/tests/c3/c34006a.ada
! da0b3e574a91ee0aaaef5268466ab1d1  gcc/testsuite/ada/acats/tests/c3/c34006d.ada
! 8d549731513d1eff1ef01cf7c39e1bb6  gcc/testsuite/ada/acats/tests/c3/c34006f.ada
! 5778d0794027d2195dc52a874d4aa6dc  gcc/testsuite/ada/acats/tests/c3/c34006g.ada
! 0e44ca23e51d865ebba37df074e84cc3  gcc/testsuite/ada/acats/tests/c3/c34006j.ada
! 1f9588c61e9d083a44b37060893f1199  gcc/testsuite/ada/acats/tests/c3/c34006l.ada
! 3111937fe40eda62543e53d0dc0a9b2e  gcc/testsuite/ada/acats/tests/c3/c34007a.ada
! a6c16ebbc095684171bb89cb7ac5b52f  gcc/testsuite/ada/acats/tests/c3/c34007d.ada
! 3f46f4632a1e2839b528dd4edb849c59  gcc/testsuite/ada/acats/tests/c3/c34007f.ada
! 50a6b8b6ab707d4020a210c2f54c5364  gcc/testsuite/ada/acats/tests/c3/c34007g.ada
! 1d08fae78b3684032500b751c4f6b956  gcc/testsuite/ada/acats/tests/c3/c34007i.ada
! 7dec8ab4f2325dfb24a6f4a0712ca647  gcc/testsuite/ada/acats/tests/c3/c34007j.ada
! f2f670c3368d6fdedc0bc830e2f5441f  gcc/testsuite/ada/acats/tests/c3/c34007m.ada
! 12e7a75337b952bbe70b50f44fbf73bd  gcc/testsuite/ada/acats/tests/c3/c34007p.ada
! 4460899978bde8392dbf79b1457fd4c0  gcc/testsuite/ada/acats/tests/c3/c34007r.ada
! 430fadbb7eb89cad332156a43a1cb8a6  gcc/testsuite/ada/acats/tests/c3/c34007s.ada
! 142cd26f56dbefa8cc40ce318e93574b  gcc/testsuite/ada/acats/tests/c3/c34007u.ada
! 01aa55423bd6286a768cfbc7951408e9  gcc/testsuite/ada/acats/tests/c3/c34007v.ada
! 7d2567bb5e4ce686433355b2efa84d99  gcc/testsuite/ada/acats/tests/c3/c34008a.ada
! 9e896dcd16ce62c70c03b6105de6b94c  gcc/testsuite/ada/acats/tests/c3/c34009a.ada
! be1b3bebe697fb006bf9a558f3b0f788  gcc/testsuite/ada/acats/tests/c3/c34009d.ada
! 5880284be01f48d40969f18306c94edd  gcc/testsuite/ada/acats/tests/c3/c34009f.ada
! 679004960f5e177505b2aff13c637ebf  gcc/testsuite/ada/acats/tests/c3/c34009g.ada
! f60aa89944e52f4dca47047e08990f29  gcc/testsuite/ada/acats/tests/c3/c34009j.ada
! 28351985ca5afb785bccaaf7463d1f32  gcc/testsuite/ada/acats/tests/c3/c34009l.ada
! 221f9bd08976154a0a22e9948d8ac7e0  gcc/testsuite/ada/acats/tests/c3/c34011b.ada
! f2175e26a65dbd70c186e6acf1001755  gcc/testsuite/ada/acats/tests/c3/c34012a.ada
! bdde2c516616684b5fe414550d8400ee  gcc/testsuite/ada/acats/tests/c3/c34014a.ada
! 4e8100382b8141c0d056a9fe870b8d06  gcc/testsuite/ada/acats/tests/c3/c34014c.ada
! a8fbccc7b3c28981b57a867a1edabf5d  gcc/testsuite/ada/acats/tests/c3/c34014e.ada
! 75cb51a9c469066a67228b04e8ba11fc  gcc/testsuite/ada/acats/tests/c3/c34014g.ada
! da007fc8719ca70057c035beb9fda7fe  gcc/testsuite/ada/acats/tests/c3/c34014h.ada
! dbcb5a07736736af9834d2938b24e483  gcc/testsuite/ada/acats/tests/c3/c34014n.ada
! afbaca6a68812eaecf17a8eef2a6346e  gcc/testsuite/ada/acats/tests/c3/c34014p.ada
! df14c9b4224ce4cf3fd2d8445cbad0f2  gcc/testsuite/ada/acats/tests/c3/c34014r.ada
! 03948696a8a2d08faa02588806cd388d  gcc/testsuite/ada/acats/tests/c3/c34014t.ada
! 7258de51f19cfc9506908221af84e01f  gcc/testsuite/ada/acats/tests/c3/c34014u.ada
! 360330a2a81712d1ed00c02cbc5e6526  gcc/testsuite/ada/acats/tests/c3/c34018a.ada
! a943a89b3032146b53e937f3a73684da  gcc/testsuite/ada/acats/tests/c3/c340a01.a
! 5a38659efe283303f9d22ebc955ae0d0  gcc/testsuite/ada/acats/tests/c3/c340a02.a
! f694a602dc4b31baf72c096b6e4fb9d5  gcc/testsuite/ada/acats/tests/c3/c341a01.a
! 4ad05d07bd295bd76f3edbc6685ae9b8  gcc/testsuite/ada/acats/tests/c3/c341a02.a
! 49408ab274823bacfccd32176c5bc061  gcc/testsuite/ada/acats/tests/c3/c341a03.a
! ec207723e08de50ca0964ad3318f8235  gcc/testsuite/ada/acats/tests/c3/c341a04.a
! 55b745d015fed5a09de487d8081c09eb  gcc/testsuite/ada/acats/tests/c3/c35003a.ada
! 092ff51133e865dad2cd6192506f9980  gcc/testsuite/ada/acats/tests/c3/c35003b.ada
! 55caad169adcfa6b58689ceb3dc1d505  gcc/testsuite/ada/acats/tests/c3/c35003d.ada
! b2b10d16689d994b421c7f356c4eebe9  gcc/testsuite/ada/acats/tests/c3/c35102a.ada
! 9d1972c0cc4eb7b2203cca27c4e785f1  gcc/testsuite/ada/acats/tests/c3/c352001.a
! 6adbf240f9a88c67e6dc4d9a3ae2f449  gcc/testsuite/ada/acats/tests/c3/c354002.a
! 1c6bd8c5607c8d83b1fb16cf20b35965  gcc/testsuite/ada/acats/tests/c3/c354003.a
! 831543d10fff09679865a63cb6261690  gcc/testsuite/ada/acats/tests/c3/c35502a.ada
! a7c2fa5fc851b6f2ef3d825116c56789  gcc/testsuite/ada/acats/tests/c3/c35502b.ada
! 012ae5aa045c7b944677ea749449b75e  gcc/testsuite/ada/acats/tests/c3/c35502c.ada
! 66ad3541bdd12f2457bc931410567df2  gcc/testsuite/ada/acats/tests/c3/c35502d.tst
! f850859238832c6689133c4b82b2d23a  gcc/testsuite/ada/acats/tests/c3/c35502e.ada
! 1ae0d752d4d7089a159ba37533cac440  gcc/testsuite/ada/acats/tests/c3/c35502f.tst
! 86636a48b0f16cee1e000cf7cdff2dd3  gcc/testsuite/ada/acats/tests/c3/c35502g.ada
! 051f7f33819b5ea42a6810524402160e  gcc/testsuite/ada/acats/tests/c3/c35502h.ada
! 4e03c40da8c9f6a6c779600f4bf06f72  gcc/testsuite/ada/acats/tests/c3/c35502i.ada
! 0ce71c0ba8fc8137892f8032070143cf  gcc/testsuite/ada/acats/tests/c3/c35502j.ada
! 039caaa9e43f4d6e115a8a1f83eeebf1  gcc/testsuite/ada/acats/tests/c3/c35502k.ada
! 211eda1bcd28ea4725982c3228537ce8  gcc/testsuite/ada/acats/tests/c3/c35502l.ada
! 04a6b32af2cf206734bf10b9c20a1a53  gcc/testsuite/ada/acats/tests/c3/c35502m.ada
! 4d2fd9e74373c5a73cc4f819206b0ae4  gcc/testsuite/ada/acats/tests/c3/c35502n.ada
! a2f7774ccd8fe3b58f670146427b1f58  gcc/testsuite/ada/acats/tests/c3/c35502o.ada
! 244d3a03a5bfb9a02be2cde7af593c88  gcc/testsuite/ada/acats/tests/c3/c35502p.ada
! bbea92be5e14aa812d5b0bf50f43ecd2  gcc/testsuite/ada/acats/tests/c3/c35503a.ada
! e45620aeea62423f2a72fa98c32c2629  gcc/testsuite/ada/acats/tests/c3/c35503b.ada
! 6ff5a195541e611e8f795764a46c96c7  gcc/testsuite/ada/acats/tests/c3/c35503c.ada
! ae4f0df020df3fca42928a76d16433e2  gcc/testsuite/ada/acats/tests/c3/c35503d.tst
! 2835676122accf27f7f9912ed7f9b38b  gcc/testsuite/ada/acats/tests/c3/c35503e.ada
! 18bbb578fe3d479a11c962d128286c04  gcc/testsuite/ada/acats/tests/c3/c35503f.tst
! def2f804ca12f62b8b5f42c18fa649c0  gcc/testsuite/ada/acats/tests/c3/c35503g.ada
! 082f524dedff546b67bf566735caa1c1  gcc/testsuite/ada/acats/tests/c3/c35503h.ada
! 85174a7f410200513d18d173743c7474  gcc/testsuite/ada/acats/tests/c3/c35503k.ada
! 57ae4c28160a4dfa61de89bc057c9b02  gcc/testsuite/ada/acats/tests/c3/c35503l.ada
! 5fc96deb857ba3b7ec7ee6040f2b7d93  gcc/testsuite/ada/acats/tests/c3/c35503o.ada
! 02c17920bbabcf5f472c332ee0439df3  gcc/testsuite/ada/acats/tests/c3/c35503p.ada
! 7c0f95cda266f19784cd481570ffcf1a  gcc/testsuite/ada/acats/tests/c3/c35504a.ada
! 58ca27427f3b7371702549078677cd48  gcc/testsuite/ada/acats/tests/c3/c35504b.ada
! c64ed7ab5ced440f95e39eb0465b431f  gcc/testsuite/ada/acats/tests/c3/c35505c.ada
! 8a20049a7aa4dbf5e73f4a4a856df916  gcc/testsuite/ada/acats/tests/c3/c35505e.ada
! fb8432e5868c1977e525882401096430  gcc/testsuite/ada/acats/tests/c3/c35505f.ada
! a3d1f58b38d0f57e89521134057aa0d0  gcc/testsuite/ada/acats/tests/c3/c35507a.ada
! fe46e6e48a084e26027a960dcecf0e7f  gcc/testsuite/ada/acats/tests/c3/c35507b.ada
! 6276ac14d36049ca6fc1d65937918d6d  gcc/testsuite/ada/acats/tests/c3/c35507c.ada
! 38f75633d1d28c38660ac311815075c6  gcc/testsuite/ada/acats/tests/c3/c35507e.ada
! 068b315520036392da2decdadf03f6c9  gcc/testsuite/ada/acats/tests/c3/c35507g.ada
! c2e6c5681cde5371d2678d0afe2a7dbc  gcc/testsuite/ada/acats/tests/c3/c35507h.ada
! 63dad9c02cf9b0faee9f7a4c8f1e9e2d  gcc/testsuite/ada/acats/tests/c3/c35507i.ada
! 1501d4b22ff6ada18bda2bec24e23c79  gcc/testsuite/ada/acats/tests/c3/c35507j.ada
! 09885e80b2822b3187740ca5682c20e8  gcc/testsuite/ada/acats/tests/c3/c35507k.ada
! 7cef3fe8bb6274e0323e822d047490b2  gcc/testsuite/ada/acats/tests/c3/c35507l.ada
! b1e4ee7af4f56f20553663a9e296595e  gcc/testsuite/ada/acats/tests/c3/c35507m.ada
! cecbaaea0b8f341a4305a221c28843fc  gcc/testsuite/ada/acats/tests/c3/c35507n.ada
! 52e0a241e2ad05fa89ecb293e6e2445a  gcc/testsuite/ada/acats/tests/c3/c35507o.ada
! 600e023fcb478381f0a8d0bde64f42ce  gcc/testsuite/ada/acats/tests/c3/c35507p.ada
! f33cc8ac90e96b7b226aaec5ae692195  gcc/testsuite/ada/acats/tests/c3/c35508a.ada
! 7e48a5fa6e02b3658f287da356b209f9  gcc/testsuite/ada/acats/tests/c3/c35508b.ada
! 4b6b6e92f28c0ad3cd4f67af8ad0c06c  gcc/testsuite/ada/acats/tests/c3/c35508c.ada
! 8bbddf95307b94ae0ed7e12152746762  gcc/testsuite/ada/acats/tests/c3/c35508e.ada
! dbe54ec8ce5e33dd88ae24a43cfde531  gcc/testsuite/ada/acats/tests/c3/c35508g.ada
! e637f96ce7f08585f2d85fee50f734ee  gcc/testsuite/ada/acats/tests/c3/c35508h.ada
! 362619ef40ffff0fd56dee7a6a6c51ab  gcc/testsuite/ada/acats/tests/c3/c35508k.ada
! 62ca0e421d4722ad32f139648ece0a60  gcc/testsuite/ada/acats/tests/c3/c35508l.ada
! fab2b9fed9304046c3feed68fb9e7b50  gcc/testsuite/ada/acats/tests/c3/c35508o.ada
! a7e4e9b85072c7fc56cd223463426c4d  gcc/testsuite/ada/acats/tests/c3/c35508p.ada
! bb15d1d296a4eddc9aada6a363360729  gcc/testsuite/ada/acats/tests/c3/c35703a.ada
! 97d3b53eb2177ea6344c1ef49c98377d  gcc/testsuite/ada/acats/tests/c3/c35704a.ada
! 5a690257e776d58a4fd2a23a7ba6c0e9  gcc/testsuite/ada/acats/tests/c3/c35704b.ada
! 52a2a628059a70786108ace7ccd9d08f  gcc/testsuite/ada/acats/tests/c3/c35704c.ada
! 14756c69c53e152b3ede55a2754a4d33  gcc/testsuite/ada/acats/tests/c3/c35704d.ada
! 22b7d640a1b7ab1933a5654507ff5814  gcc/testsuite/ada/acats/tests/c3/c35801d.ada
! 23943917f960018ecdfb861e2c69b545  gcc/testsuite/ada/acats/tests/c3/c35902d.ada
! 1e5392accfe4bd85f17ca7c456747be3  gcc/testsuite/ada/acats/tests/c3/c35904a.ada
! 4c8ee2a79f1878dcbca7246e9e436865  gcc/testsuite/ada/acats/tests/c3/c35904b.ada
! 73fbf4f7e465d5d7fdbee3c99d7cf9ec  gcc/testsuite/ada/acats/tests/c3/c35a02a.ada
! 9f8c6fe2edc1ad0a78efbb5038b9ef99  gcc/testsuite/ada/acats/tests/c3/c35a05a.ada
! 57fc2536f06ceaf5a1604ee5bb5605fd  gcc/testsuite/ada/acats/tests/c3/c35a05d.ada
! ccf547732379c7144c27839f695e8a78  gcc/testsuite/ada/acats/tests/c3/c35a05n.ada
! ef904f577e7d9c35099e7d144f51bcce  gcc/testsuite/ada/acats/tests/c3/c35a05q.ada
! 3682cd83d6b388849e97129de990f52d  gcc/testsuite/ada/acats/tests/c3/c35a07a.ada
! 03e887c344e6bdbdb22118ff77b769fd  gcc/testsuite/ada/acats/tests/c3/c35a07d.ada
! ccdad741543d79671fc5f73037ff418d  gcc/testsuite/ada/acats/tests/c3/c35a08b.ada
! 651df98436a6167a850f437a29dc7a94  gcc/testsuite/ada/acats/tests/c3/c360002.a
! a4c274a3e03fe30e6bc786063bfe78e9  gcc/testsuite/ada/acats/tests/c3/c36104a.ada
! b016b5195b1a9d3c07192416c89e1bee  gcc/testsuite/ada/acats/tests/c3/c36104b.ada
! 43912684d172c672071ee16d854bcff0  gcc/testsuite/ada/acats/tests/c3/c36172a.ada
! 2dc69a4f44addfae37b13335df258285  gcc/testsuite/ada/acats/tests/c3/c36172b.ada
! 4d07671447e230f3eddc684c6a3b557a  gcc/testsuite/ada/acats/tests/c3/c36172c.ada
! 38a8a16720ac5a8741105f6c5f506f2d  gcc/testsuite/ada/acats/tests/c3/c36174a.ada
! 87012e291c8acd51799d9ca8b8fccc32  gcc/testsuite/ada/acats/tests/c3/c36180a.ada
! f887210d32ff420cd8ec888ca5c13b66  gcc/testsuite/ada/acats/tests/c3/c36202c.ada
! c48c400b884ae534788fbff1510b95ba  gcc/testsuite/ada/acats/tests/c3/c36203a.ada
! 93d36d6ba5a23a2f985cc842911a6b2f  gcc/testsuite/ada/acats/tests/c3/c36204a.ada
! 5ae3804a2577f9be85df4c11dd1ba3ab  gcc/testsuite/ada/acats/tests/c3/c36204b.ada
! 95f946b45603237266057103729c0a9c  gcc/testsuite/ada/acats/tests/c3/c36204c.ada
! 1a555d9bc9de255c02e401d7956a5f67  gcc/testsuite/ada/acats/tests/c3/c36204d.ada
! c5d2782fd60778b2578f9cf486e811db  gcc/testsuite/ada/acats/tests/c3/c36205a.ada
! 4842fc730e500b00c7c35f4691be2855  gcc/testsuite/ada/acats/tests/c3/c36205b.ada
! 725f9fbf3157baa9a668acc5e689a06b  gcc/testsuite/ada/acats/tests/c3/c36205c.ada
! a9d6124e64589b143b6b54d575df431b  gcc/testsuite/ada/acats/tests/c3/c36205d.ada
! c016e1338001bb0d007af7bf4e20d911  gcc/testsuite/ada/acats/tests/c3/c36205e.ada
! 299e459d577a85781464563cd621f1b4  gcc/testsuite/ada/acats/tests/c3/c36205f.ada
! 7f182ba91c9a0f80d0e5e5b7e919ac56  gcc/testsuite/ada/acats/tests/c3/c36205g.ada
! 7559d4ebfc8d9c23879d2cc42d3ac0f4  gcc/testsuite/ada/acats/tests/c3/c36205h.ada
! d11eed873d3f614674f193f130b127bb  gcc/testsuite/ada/acats/tests/c3/c36205i.ada
! 65b17684e8953d820a69eb11dc4d63e4  gcc/testsuite/ada/acats/tests/c3/c36205j.ada
! 21f3a9a788ac6136e2b453f0fc99959f  gcc/testsuite/ada/acats/tests/c3/c36205k.ada
! 9884f944a4c4faaee8aaf09a92235c3a  gcc/testsuite/ada/acats/tests/c3/c36205l.ada
! 1552dfb23215604db6043c7d12dfc7a6  gcc/testsuite/ada/acats/tests/c3/c36301a.ada
! eb37821c1c0e190f8c8cd0e7d282bc9e  gcc/testsuite/ada/acats/tests/c3/c36301b.ada
! 236dab07c2bafa07e92d082fc822c8b4  gcc/testsuite/ada/acats/tests/c3/c36302a.ada
! a1b4d4c17da94ac478b85b56fd32bf91  gcc/testsuite/ada/acats/tests/c3/c36304a.ada
! 58595c82c4f76f6be31333ec0267a9c8  gcc/testsuite/ada/acats/tests/c3/c36305a.ada
! 871a3ce65e5d5a824131380a060f18e0  gcc/testsuite/ada/acats/tests/c3/c37002a.ada
! 8415fb7acaf9ab73e2a230b45778e7c8  gcc/testsuite/ada/acats/tests/c3/c37003a.ada
! b93e53c5cd23520b5b0b88e8c4aee165  gcc/testsuite/ada/acats/tests/c3/c37003b.ada
! 0396184f11f01fdd09e40a2432a7850c  gcc/testsuite/ada/acats/tests/c3/c37005a.ada
! 17dc351de12194e77f5fe4b5ffbc733e  gcc/testsuite/ada/acats/tests/c3/c37006a.ada
! 96813863f2ee2182c3f68f999a7ffed2  gcc/testsuite/ada/acats/tests/c3/c37008a.ada
! 9f784c997bf1bb09fe9bf639408dd25c  gcc/testsuite/ada/acats/tests/c3/c37008b.ada
! 5d7d0f22be016c0f9b4bcb1da25ed1a2  gcc/testsuite/ada/acats/tests/c3/c37009a.ada
! ffc6187aa3ecc28b0631a384e1f95a7e  gcc/testsuite/ada/acats/tests/c3/c37010a.ada
! 029c8fb134594e913fe650a5763a4515  gcc/testsuite/ada/acats/tests/c3/c37010b.ada
! 09e452317c2c5a3df881f8bfc5bad1ca  gcc/testsuite/ada/acats/tests/c3/c371001.a
! 194d5579b14c8d78edccb4725e786bbb  gcc/testsuite/ada/acats/tests/c3/c371002.a
! 6508ac6c82ccaf89245ddeb239cf8c65  gcc/testsuite/ada/acats/tests/c3/c371003.a
! efcbd19428af8ce2430d60f7389f98f7  gcc/testsuite/ada/acats/tests/c3/c37102b.ada
! b56d339ed47321b90862af1e6ff54f3c  gcc/testsuite/ada/acats/tests/c3/c37103a.ada
! d2b9a9804b8282550c3233d4c850e203  gcc/testsuite/ada/acats/tests/c3/c37105a.ada
! dff6fe14498b4430a005271952b8508b  gcc/testsuite/ada/acats/tests/c3/c37107a.ada
! cab8fff51d9e7fa6be5dc3722f0805a7  gcc/testsuite/ada/acats/tests/c3/c37108b.ada
! ac1c74612e7098a8b3c19c4233f91b36  gcc/testsuite/ada/acats/tests/c3/c37206a.ada
! da4a6484624a6563a3acad74e59e553f  gcc/testsuite/ada/acats/tests/c3/c37207a.ada
! 793d448b9373aca3bdfbeb16c4cd5664  gcc/testsuite/ada/acats/tests/c3/c37208a.ada
! 19e934b5c86da61793fb4bde9faf4f4a  gcc/testsuite/ada/acats/tests/c3/c37208b.ada
! cfc2d39b74fd2d6964787190ac03afde  gcc/testsuite/ada/acats/tests/c3/c37209a.ada
! a9e5da6e96624ea9e8d99c31a879bea0  gcc/testsuite/ada/acats/tests/c3/c37209b.ada
! 5095a03dbf61f1c7486ce4249ebd4168  gcc/testsuite/ada/acats/tests/c3/c37210a.ada
! 13fd1f169bebade45dcc8f783c4dfba5  gcc/testsuite/ada/acats/tests/c3/c37211a.ada
! 90539e4b0a8ab5a720d93e61332d4bad  gcc/testsuite/ada/acats/tests/c3/c37211b.ada
! b5fb0f0cfa820aa9c8f8a02529b59ae1  gcc/testsuite/ada/acats/tests/c3/c37211c.ada
! 34158bf765252e909102a5071bd1ab0d  gcc/testsuite/ada/acats/tests/c3/c37211d.ada
! 9723d82d289b6c708a4e38619a050c44  gcc/testsuite/ada/acats/tests/c3/c37211e.ada
! 02567718a426a27f1633a5ba46fb39ea  gcc/testsuite/ada/acats/tests/c3/c37213b.ada
! 0db6468aa3789fa4eb8509864bbbba6c  gcc/testsuite/ada/acats/tests/c3/c37213d.ada
! c3ea989d669b26ad147ec1d36d59f8b1  gcc/testsuite/ada/acats/tests/c3/c37213f.ada
! c7d6b08bb4739fe27a9bf7c37153611b  gcc/testsuite/ada/acats/tests/c3/c37213h.ada
! e1a81fd713875796f8f0f1d1d856df2e  gcc/testsuite/ada/acats/tests/c3/c37213j.ada
! 8824529732962a1fb9cbd428d01a57f5  gcc/testsuite/ada/acats/tests/c3/c37213k.ada
! 7c2df003cd7fdc0bffaa00b7e5a76295  gcc/testsuite/ada/acats/tests/c3/c37213l.ada
! d1bb01398cfb6ee5cd12ec89604227fb  gcc/testsuite/ada/acats/tests/c3/c37215b.ada
! f34c6fc15658b1b04a69e1ccf32c7394  gcc/testsuite/ada/acats/tests/c3/c37215d.ada
! ca62cbc7b583fe934a8091c539e55305  gcc/testsuite/ada/acats/tests/c3/c37215f.ada
! 8be60a6919ae5d9ba615eb624746100d  gcc/testsuite/ada/acats/tests/c3/c37215h.ada
! fdd60b015f299bfc5d8e0f9f33334f8e  gcc/testsuite/ada/acats/tests/c3/c37217a.ada
! bb84ce5410a8c6c7127939120ba80cde  gcc/testsuite/ada/acats/tests/c3/c37217b.ada
! 2687c3f166eabbae25fc5e04880d06a3  gcc/testsuite/ada/acats/tests/c3/c37217c.ada
! db9ca52d8b1a818e4d66aea96b3eb964  gcc/testsuite/ada/acats/tests/c3/c37304a.ada
! 59413b6b57aae9caadc41c111c74faed  gcc/testsuite/ada/acats/tests/c3/c37305a.ada
! 2ff906f6262ecd1cfdaffbcda07f1a76  gcc/testsuite/ada/acats/tests/c3/c37306a.ada
! a6f2da7b55ad908aebb841bc6ed9b69e  gcc/testsuite/ada/acats/tests/c3/c37309a.ada
! 54ec04c8663d10e960eb022fed3a9306  gcc/testsuite/ada/acats/tests/c3/c37310a.ada
! ab733e44603296f9e49a292ad601cf74  gcc/testsuite/ada/acats/tests/c3/c37312a.ada
! 75ac97c1a116dcc5edcc7f2b44f304f4  gcc/testsuite/ada/acats/tests/c3/c37402a.ada
! 2d432b792b7c7b0669844add896bb802  gcc/testsuite/ada/acats/tests/c3/c37403a.ada
! 38ed181e9e32218f4a81d412e83c503d  gcc/testsuite/ada/acats/tests/c3/c37404a.ada
! c1cce1fda9f9c6085ecce4e278182d6c  gcc/testsuite/ada/acats/tests/c3/c37404b.ada
! c9abb9613df5a6b0ab399a10551d5070  gcc/testsuite/ada/acats/tests/c3/c37405a.ada
! 1793c94eca80b29526f7ec7a9da864e8  gcc/testsuite/ada/acats/tests/c3/c37411a.ada
! 3d8871a14f5b0b92ab5699036c27161b  gcc/testsuite/ada/acats/tests/c3/c380001.a
! fe1bbd01b7e70108e4de5854ee4c098d  gcc/testsuite/ada/acats/tests/c3/c380002.a
! fb52cd7cb9118b93afa2bc8a309ecdc9  gcc/testsuite/ada/acats/tests/c3/c380003.a
! 7e465d24377190b6eaafcc3fd3125ff9  gcc/testsuite/ada/acats/tests/c3/c380004.a
! c76f2865cda03e9d5c2164052031d578  gcc/testsuite/ada/acats/tests/c3/c38002a.ada
! 5c8aaef6a8da893998485cc8bfb71f48  gcc/testsuite/ada/acats/tests/c3/c38002b.ada
! f8397d669785d9d911c494e0a0b9986a  gcc/testsuite/ada/acats/tests/c3/c38005a.ada
! 36a372c2d5368726208b1f76f95f3c1d  gcc/testsuite/ada/acats/tests/c3/c38005b.ada
! 175ff60b11884803275c5a95d4db9b0f  gcc/testsuite/ada/acats/tests/c3/c38005c.ada
! 7a5b5f5b1ac7d54c9a2cff42582467fb  gcc/testsuite/ada/acats/tests/c3/c38006a.ada
! cc457354e31fc1e63179de33cbefbad9  gcc/testsuite/ada/acats/tests/c3/c38102a.ada
! 2f60ee39cadeb5e04f93c0fb98c2ff78  gcc/testsuite/ada/acats/tests/c3/c38102b.ada
! 773c45b11f80bfa2c11a621982312a41  gcc/testsuite/ada/acats/tests/c3/c38102c.ada
! 2eec2f09807572ff6be386c41f2aa890  gcc/testsuite/ada/acats/tests/c3/c38102d.ada
! ff2ae7294328aba3ca946b298ff89249  gcc/testsuite/ada/acats/tests/c3/c38102e.ada
! 19d2c8a98b84fc28fb173b8ede249f5f  gcc/testsuite/ada/acats/tests/c3/c38104a.ada
! ccdff83c46a0742a6f6c98f395885cf0  gcc/testsuite/ada/acats/tests/c3/c38107a.ada
! 5b807a368e5b577c901a0143b328edd6  gcc/testsuite/ada/acats/tests/c3/c38107b.ada
! 7f519d74032c869b16bf7e4cc3f1757c  gcc/testsuite/ada/acats/tests/c3/c38108a.ada
! 1cdb4b2554cc632c2786a14302f39123  gcc/testsuite/ada/acats/tests/c3/c38108b.ada
! 0c83db01ff09f439f6a7fc807e878547  gcc/testsuite/ada/acats/tests/c3/c38108c0.ada
! 0b0a2c9346188afcf5a240958d58cb60  gcc/testsuite/ada/acats/tests/c3/c38108c1.ada
! 1cea347b513b856254a8e9fed08d945a  gcc/testsuite/ada/acats/tests/c3/c38108c2.ada
! fb749693f49b0edcfffc4444290ac564  gcc/testsuite/ada/acats/tests/c3/c38108d0.ada
! aa2833688968ca7a3e36612070b575f4  gcc/testsuite/ada/acats/tests/c3/c38108d1.ada
! 8e9cd24cf69e1375408ec439a96f964f  gcc/testsuite/ada/acats/tests/c3/c38202a.ada
! 61680b9ec1c444c4faffd8c59cce698a  gcc/testsuite/ada/acats/tests/c3/c3900010.a
! 987d00ae68ea07578bf45fc567352a66  gcc/testsuite/ada/acats/tests/c3/c3900011.am
! 370d5eba0eee3ce909caf87c342f846d  gcc/testsuite/ada/acats/tests/c3/c390002.a
! 6dd703dff40d77030a2c6329094e7802  gcc/testsuite/ada/acats/tests/c3/c390003.a
! 491d840ce3aeb642239cc28533a9ba34  gcc/testsuite/ada/acats/tests/c3/c390004.a
! b04ffb8d071dcf6547533038ef227651  gcc/testsuite/ada/acats/tests/c3/c3900050.a
! dff18ad9fb367bc37acd04d6e08e55bf  gcc/testsuite/ada/acats/tests/c3/c3900051.a
! 2b39948b2af313cbed0046a2bcdcbc9d  gcc/testsuite/ada/acats/tests/c3/c3900052.a
! b4e44c9c1971345223585500a55db164  gcc/testsuite/ada/acats/tests/c3/c3900053.am
! 471e818df49cf1a32357c5b759d21dc9  gcc/testsuite/ada/acats/tests/c3/c3900060.a
! bd65238f7cda09d91e177736cdbcd7ec  gcc/testsuite/ada/acats/tests/c3/c3900061.a
! d3e9ddf4af2eb46f1b086dbc43c75d04  gcc/testsuite/ada/acats/tests/c3/c3900062.a
! bced3ae0c872e2f15b26193b1c9c4c35  gcc/testsuite/ada/acats/tests/c3/c3900063.am
! cd1ae54278fd1b61d5ecd166ecf0671b  gcc/testsuite/ada/acats/tests/c3/c390007.a
! a7cf99b62949613099d6c982d9043098  gcc/testsuite/ada/acats/tests/c3/c390010.a
! 30e5b9a42c18864d89a931830adfd68e  gcc/testsuite/ada/acats/tests/c3/c390011.a
! 1bcaf1b15ae617d49c80e68b55943cc6  gcc/testsuite/ada/acats/tests/c3/c39006a.ada
! 7e954943167e1f1855ce0abf856c9a9b  gcc/testsuite/ada/acats/tests/c3/c39006b.ada
! 14d52be4c2d938b4ae51c17507b6ca25  gcc/testsuite/ada/acats/tests/c3/c39006c0.ada
! c770912acdec8d8fa7169157d99a1382  gcc/testsuite/ada/acats/tests/c3/c39006c1.ada
! fcf5b4e7ecc49a79fc11640baf53f4f6  gcc/testsuite/ada/acats/tests/c3/c39006d.ada
! 86ddd0b2d946750357311d89b5046963  gcc/testsuite/ada/acats/tests/c3/c39006e.ada
! ba4887d359d62403c79f3563b0dfa8f4  gcc/testsuite/ada/acats/tests/c3/c39006f0.ada
! 205b6ff97343a4403e8cb5bc33883547  gcc/testsuite/ada/acats/tests/c3/c39006f1.ada
! 16ddc19c6da0a1642305e4b5fc6058d1  gcc/testsuite/ada/acats/tests/c3/c39006f2.ada
! 59cfdb727f33418fa8de537e14629d71  gcc/testsuite/ada/acats/tests/c3/c39006f3.ada
! f80f760d35130556602f0b683e480d63  gcc/testsuite/ada/acats/tests/c3/c39006g.ada
! cce3352413b69fd05b5ec5195c3a4c00  gcc/testsuite/ada/acats/tests/c3/c39007a.ada
! eab8b6c595bc019ed0d33f826e34e97f  gcc/testsuite/ada/acats/tests/c3/c39007b.ada
! f9502bdaffb8475b46fab174a19f2de9  gcc/testsuite/ada/acats/tests/c3/c39008a.ada
! 44f9dead72582206f122372b79949f92  gcc/testsuite/ada/acats/tests/c3/c39008b.ada
! f7c867df153c4137ff42c73e84cf78bb  gcc/testsuite/ada/acats/tests/c3/c39008c.ada
! 7dfc2d2eea8f430d414e0e9fb3d66efb  gcc/testsuite/ada/acats/tests/c3/c390a010.a
! fe7593d56cc6f8290c29978513afc0e4  gcc/testsuite/ada/acats/tests/c3/c390a011.am
! 11b0510a4ce65e5a57a44f990501c66a  gcc/testsuite/ada/acats/tests/c3/c390a020.a
! 4282bd0ba35b056f1611e8c863c8745e  gcc/testsuite/ada/acats/tests/c3/c390a021.a
! cf96da721f34cf963ac9c04fdedb4a5a  gcc/testsuite/ada/acats/tests/c3/c390a022.am
! 9cc816e53154c542095db060de988727  gcc/testsuite/ada/acats/tests/c3/c390a030.a
! a2ad2209c88d74fd376c9daf08c00e0c  gcc/testsuite/ada/acats/tests/c3/c390a031.am
! 40bd1c7f8a70fb208644304788e8bdc6  gcc/testsuite/ada/acats/tests/c3/c391001.a
! 2dc32344161fe05900a7d0a4fb00a90b  gcc/testsuite/ada/acats/tests/c3/c391002.a
! 1cea1692179d434f0ff9e71ba3af5c1e  gcc/testsuite/ada/acats/tests/c3/c392002.a
! 918e8c097a09a06159f2809df40a1418  gcc/testsuite/ada/acats/tests/c3/c392003.a
! 65856b8c6fecfcf755607b20116e49ef  gcc/testsuite/ada/acats/tests/c3/c392004.a
! add1a6bb172c420d5b75dd9efb48c6bd  gcc/testsuite/ada/acats/tests/c3/c392005.a
! 1e3c83f529cb7a93f087fd5e1d1c8da3  gcc/testsuite/ada/acats/tests/c3/c392008.a
! fdbaa3ed4337e597d16209533ad30839  gcc/testsuite/ada/acats/tests/c3/c392010.a
! 8063c17c7054236de05a0d6a56818802  gcc/testsuite/ada/acats/tests/c3/c392011.a
! 66f6cf830b25e4cba2aeaac6801b02e2  gcc/testsuite/ada/acats/tests/c3/c392013.a
! 3597acb12cde69e45603917fc97c80c0  gcc/testsuite/ada/acats/tests/c3/c392014.a
! 35f1f390e8606d404b61bb05a639d3be  gcc/testsuite/ada/acats/tests/c3/c392a01.a
! ddeb268075e3a716a055f61676497b78  gcc/testsuite/ada/acats/tests/c3/c392c05.a
! ee8edde3e11e29c877773403259133c0  gcc/testsuite/ada/acats/tests/c3/c392c07.a
! cf19325c05dcb02f4dc60d58ef26ea2b  gcc/testsuite/ada/acats/tests/c3/c392d01.a
! acfb41d6d4b4fdec20be56da91d7037d  gcc/testsuite/ada/acats/tests/c3/c392d02.a
! 1db19d15d9fdd4071bc438e73f6c5f60  gcc/testsuite/ada/acats/tests/c3/c392d03.a
! 9913afe2e224eb447dd2ba6e7b6cd62d  gcc/testsuite/ada/acats/tests/c3/c393001.a
! cb66f262f22e933b78a4b4ff7f314ebb  gcc/testsuite/ada/acats/tests/c3/c393007.a
! fa7a91fbda6d3ec270401392bfa2a76e  gcc/testsuite/ada/acats/tests/c3/c393008.a
! 725749e586aef7b3172e0a9f654508c9  gcc/testsuite/ada/acats/tests/c3/c393009.a
! 21bc1c6b2b56e0fe4e98a124b3a43036  gcc/testsuite/ada/acats/tests/c3/c393010.a
! cd6d2722ead0dbebda558b3eed5c7ca4  gcc/testsuite/ada/acats/tests/c3/c393011.a
! 7df68c4f3488082bba3f1654a9ba7910  gcc/testsuite/ada/acats/tests/c3/c393012.a
! 5bf5e79116361f7f6818018607c7b14c  gcc/testsuite/ada/acats/tests/c3/c393a02.a
! 46faa2017a32e6ba0d55237311c2594b  gcc/testsuite/ada/acats/tests/c3/c393a03.a
! eafd936400d5d6d12f0163e2eddfac6b  gcc/testsuite/ada/acats/tests/c3/c393a05.a
! db0cccf9a144062cc832a2649c8b3890  gcc/testsuite/ada/acats/tests/c3/c393a06.a
! 8714b97cca38041a9f7e9366aef2ea6f  gcc/testsuite/ada/acats/tests/c3/c393b12.a
! 7035657702431ed63b2d07b818986f02  gcc/testsuite/ada/acats/tests/c3/c393b13.a
! 53c07ae14d9fb175ce43218b1e343038  gcc/testsuite/ada/acats/tests/c3/c393b14.a
! c2ac600ac5856ef7dd1dbc9289ad5b3a  gcc/testsuite/ada/acats/tests/c3/c3a0001.a
! 031b3fc5f0a32a51bded67c7ecc17317  gcc/testsuite/ada/acats/tests/c3/c3a0002.a
! c31f440d35b722f58fbb9350b06d125c  gcc/testsuite/ada/acats/tests/c3/c3a0003.a
! 2297f4ac861d78f2371edd9c4a2d7c6c  gcc/testsuite/ada/acats/tests/c3/c3a0004.a
! 32ac31994b6e97c7cfc3da69b63041ca  gcc/testsuite/ada/acats/tests/c3/c3a0005.a
! d86e5a6cc083a8024c11012097ddad34  gcc/testsuite/ada/acats/tests/c3/c3a0006.a
! 27a88a8b1aa1655fbfad671608eb6590  gcc/testsuite/ada/acats/tests/c3/c3a0007.a
! 2c75b971c54a5abc55846c25177a2d32  gcc/testsuite/ada/acats/tests/c3/c3a0008.a
! 0b8bb10fc6969853e244dca2a5176000  gcc/testsuite/ada/acats/tests/c3/c3a0009.a
! ed1e9211c87a814c4afe091b58de454c  gcc/testsuite/ada/acats/tests/c3/c3a0010.a
! e9e7d7fe8183ee50353cfccbd67ce241  gcc/testsuite/ada/acats/tests/c3/c3a0011.a
! c7fcc74fd4dfdbaffcb6c91b90a50060  gcc/testsuite/ada/acats/tests/c3/c3a00120.a
! 74ba294edd61c27b3a700c248bd041e9  gcc/testsuite/ada/acats/tests/c3/c3a00121.a
! b5687449024e6ae74c2b54cbbf12b721  gcc/testsuite/ada/acats/tests/c3/c3a00122.am
! e7d92335b6aec84b884e9a11162a306e  gcc/testsuite/ada/acats/tests/c3/c3a0013.a
! 2fdbc8cb627a0ba4818773199ea59e8b  gcc/testsuite/ada/acats/tests/c3/c3a0014.a
! cbdd24e39ac8fba7e5ea4a0975d79298  gcc/testsuite/ada/acats/tests/c3/c3a0015.a
! 21ce522f0e81e68685347a0f9b6064f3  gcc/testsuite/ada/acats/tests/c3/c3a1001.a
! 03f9fa0b3ade6732c9e7b1792aa29352  gcc/testsuite/ada/acats/tests/c3/c3a1002.a
! 73e86224d17f2a8956a1d528195701e5  gcc/testsuite/ada/acats/tests/c3/c3a2001.a
! e2d17cf34da20dd63f46abc38e9461f2  gcc/testsuite/ada/acats/tests/c3/c3a2002.a
! 3c24e7e447372dec84c3b1cf5f273936  gcc/testsuite/ada/acats/tests/c3/c3a2003.a
! cddb5c363c31a2ba7b970cf9dc8e3f5e  gcc/testsuite/ada/acats/tests/c3/c3a2a01.a
! 4247f0b657aa158ef18c1318e9dc8b84  gcc/testsuite/ada/acats/tests/c3/c3a2a02.a
! 383d36d8bd8f651b81f9f034c79f6395  gcc/testsuite/ada/acats/tests/c4/c410001.a
! dc852bc88874efd64494341e97b01bfb  gcc/testsuite/ada/acats/tests/c4/c41101d.ada
! 6f5f34a6a9fa1d906503ce64081a9fb1  gcc/testsuite/ada/acats/tests/c4/c41103a.ada
! 6881243b887f6a08d55ad39f9c71b847  gcc/testsuite/ada/acats/tests/c4/c41103b.ada
! 820fca3a12cccc477a1db295b46c9e89  gcc/testsuite/ada/acats/tests/c4/c41104a.ada
! fdbf47ad957484b7d85a3373d756e376  gcc/testsuite/ada/acats/tests/c4/c41105a.ada
! c4087c229334ce4727fc90657340bea6  gcc/testsuite/ada/acats/tests/c4/c41107a.ada
! 0f8bb517ec2fe5d8ad9dd8f9fcdca333  gcc/testsuite/ada/acats/tests/c4/c41201d.ada
! 381cd3656ffd77067260c0426caad8e4  gcc/testsuite/ada/acats/tests/c4/c41203a.ada
! f16afef9632faa3f3d798b8429057017  gcc/testsuite/ada/acats/tests/c4/c41203b.ada
! 9fbde81e21b268a632cd32dc4a99df30  gcc/testsuite/ada/acats/tests/c4/c41204a.ada
! 67fa52580bd829764d9438c881578136  gcc/testsuite/ada/acats/tests/c4/c41205a.ada
! 7dca543b0fdeefd218298ca3512d4136  gcc/testsuite/ada/acats/tests/c4/c41206a.ada
! 3ab9c169397fc23560a200fb693450fe  gcc/testsuite/ada/acats/tests/c4/c41207a.ada
! 20522dfe7bf33e5e0e855924df96c08e  gcc/testsuite/ada/acats/tests/c4/c41301a.ada
! dae21e7962c8e72b1b61657cc9649578  gcc/testsuite/ada/acats/tests/c4/c41303a.ada
! b50a855a96988b73e7f3549240854176  gcc/testsuite/ada/acats/tests/c4/c41303b.ada
! 2616024a5ab75311dd3da9466dfeb83f  gcc/testsuite/ada/acats/tests/c4/c41303c.ada
! 71212110be4b03b467bc38a722d121d1  gcc/testsuite/ada/acats/tests/c4/c41303e.ada
! 66cc6334eba1dfed1e235d86203cb20f  gcc/testsuite/ada/acats/tests/c4/c41303f.ada
! 924b3910bb06953e81b618bc3e559550  gcc/testsuite/ada/acats/tests/c4/c41303g.ada
! 045ed81e249f894170b499df2db286d6  gcc/testsuite/ada/acats/tests/c4/c41303i.ada
! aa4db5f52bbfc36e5c975658ef97c89a  gcc/testsuite/ada/acats/tests/c4/c41303j.ada
! 0f31fc1511244c83e7abb4baeac80671  gcc/testsuite/ada/acats/tests/c4/c41303k.ada
! f9b758389317dc92073ce01c3c275e91  gcc/testsuite/ada/acats/tests/c4/c41303m.ada
! 71a865e9509e3725fd95b90ec715eaa7  gcc/testsuite/ada/acats/tests/c4/c41303n.ada
! 8981d1c2da09086d412019a04cc8c913  gcc/testsuite/ada/acats/tests/c4/c41303o.ada
! 2dda9c55735424d40aed9757f7a99849  gcc/testsuite/ada/acats/tests/c4/c41303q.ada
! e34e7a4a5a5ba93bc9916cceeaecc9e6  gcc/testsuite/ada/acats/tests/c4/c41303r.ada
! 7030e6ee5fb5761b449dbb4ff5a07765  gcc/testsuite/ada/acats/tests/c4/c41303s.ada
! d79eb627645d3853ea5140161ae28128  gcc/testsuite/ada/acats/tests/c4/c41303u.ada
! bb6f238e4a4ba7e7e7d4a81bc419e03c  gcc/testsuite/ada/acats/tests/c4/c41303v.ada
! 30d2340bbbbe2276772e1fb63e33b4ce  gcc/testsuite/ada/acats/tests/c4/c41303w.ada
! 98d29cda44e41c5ff7947a4026f5e44c  gcc/testsuite/ada/acats/tests/c4/c41304a.ada
! 185701022ded3608ce413730986fd29a  gcc/testsuite/ada/acats/tests/c4/c41304b.ada
! f0ef510c95f135851ebafc318405f773  gcc/testsuite/ada/acats/tests/c4/c41306a.ada
! 5dd0f98f04759d0b25f9631bb3f052ba  gcc/testsuite/ada/acats/tests/c4/c41306b.ada
! 58245b98892f05598c91a37cc2fa0cf7  gcc/testsuite/ada/acats/tests/c4/c41306c.ada
! 78cff154ce4ec882d604897c85256a6f  gcc/testsuite/ada/acats/tests/c4/c41307d.ada
! e4f57f60d8ab4020fa02081676cd97b1  gcc/testsuite/ada/acats/tests/c4/c41309a.ada
! 46615dd040a05118f00cf1a6c269abf8  gcc/testsuite/ada/acats/tests/c4/c41320a.ada
! c87207608b642d6c0770b2213faa6f37  gcc/testsuite/ada/acats/tests/c4/c41321a.ada
! a2f1c6ef57f73e8afee4331c2f6b8836  gcc/testsuite/ada/acats/tests/c4/c41322a.ada
! 5fe80e1ed0d397d7243803f3679b1dcf  gcc/testsuite/ada/acats/tests/c4/c41323a.ada
! 1b628d4729417b726825d3cc545cce88  gcc/testsuite/ada/acats/tests/c4/c41324a.ada
! 34bb464a9c0edf77ba3cf3f225f84fac  gcc/testsuite/ada/acats/tests/c4/c41325a.ada
! 9f472b4f812b18261355bfdb272afaf2  gcc/testsuite/ada/acats/tests/c4/c41326a.ada
! c79f530e375e47fc23508a767283386e  gcc/testsuite/ada/acats/tests/c4/c41327a.ada
! 9dbb72dcbb910f44662d1091a9dcff76  gcc/testsuite/ada/acats/tests/c4/c41328a.ada
! 0449520de7d65d45ed1daf5ca0e4569b  gcc/testsuite/ada/acats/tests/c4/c41401a.ada
! 20918a0804a04dce0cbb4d97b451bb81  gcc/testsuite/ada/acats/tests/c4/c41402a.ada
! 3d9dc352053f7bb2142de6aadd56af67  gcc/testsuite/ada/acats/tests/c4/c41404a.ada
! 3472f5561c379717f19af41f64bf38a3  gcc/testsuite/ada/acats/tests/c4/c420001.a
! 837ffbb47c098000329e8e489cfada64  gcc/testsuite/ada/acats/tests/c4/c42006a.ada
! 3930cedf9786c67a42558e65e855c7fd  gcc/testsuite/ada/acats/tests/c4/c42007e.ada
! fdfa37c01ec576b222ad3107e9e17cd2  gcc/testsuite/ada/acats/tests/c4/c43003a.ada
! 42c7528eba63811a5183af811bdf7a65  gcc/testsuite/ada/acats/tests/c4/c43004a.ada
! fdfe754e9fba94c879707660c35c89c4  gcc/testsuite/ada/acats/tests/c4/c43004c.ada
! d381bf2fc72e35825723db4655f3c38a  gcc/testsuite/ada/acats/tests/c4/c431001.a
! 841914115d2e37bfbd84574493c7019f  gcc/testsuite/ada/acats/tests/c4/c43103a.ada
! dd65d5f3b06487b888840af62334c5a5  gcc/testsuite/ada/acats/tests/c4/c43103b.ada
! 9e71b6045390013211406d2c1bfb4fba  gcc/testsuite/ada/acats/tests/c4/c43104a.ada
! 85abcc7f64ed7b42d6fd3f22c7daeb40  gcc/testsuite/ada/acats/tests/c4/c43105a.ada
! 4ed22cb91cfe0bda94598dd26ceb9c7c  gcc/testsuite/ada/acats/tests/c4/c43105b.ada
! baec9aa149293739f6e8ceac8325d7a0  gcc/testsuite/ada/acats/tests/c4/c43106a.ada
! 1d531018ee649629c5a7552829150451  gcc/testsuite/ada/acats/tests/c4/c43107a.ada
! 05a638c334196cb191ee5128a5996f23  gcc/testsuite/ada/acats/tests/c4/c43108a.ada
! 4ea1f6b615b7799500e7c6933df91e82  gcc/testsuite/ada/acats/tests/c4/c432001.a
! 1e73ca84bb526fa8947ec4278f0151ed  gcc/testsuite/ada/acats/tests/c4/c432002.a
! 6ec2ee48b603324015bd74c07d8eb9fb  gcc/testsuite/ada/acats/tests/c4/c432003.a
! 8e738d9db0574dd56f1158230f5caa4c  gcc/testsuite/ada/acats/tests/c4/c432004.a
! ee94ed306c9c2f72d0f353f3242a51db  gcc/testsuite/ada/acats/tests/c4/c43204a.ada
! e98c1830d22cb2c31e6c97a0f3d96ad7  gcc/testsuite/ada/acats/tests/c4/c43204c.ada
! f0b2f2ebf435459bab0ed10112cc18b6  gcc/testsuite/ada/acats/tests/c4/c43204e.ada
! 7e74d89a8654aef2ebf093dc84b24d10  gcc/testsuite/ada/acats/tests/c4/c43204f.ada
! b266b1d1eaefa26342ce7e3c0eb10f20  gcc/testsuite/ada/acats/tests/c4/c43204g.ada
! 119509db1b0027b3597be4ca5abbb5bb  gcc/testsuite/ada/acats/tests/c4/c43204h.ada
! 67b7aebfc7ddaa75b105ec0d3e496a27  gcc/testsuite/ada/acats/tests/c4/c43204i.ada
! 73152cdcaa60874a7dd488590fdf9d5c  gcc/testsuite/ada/acats/tests/c4/c43205a.ada
! 64f982d0a7b18107f1762424333a65d3  gcc/testsuite/ada/acats/tests/c4/c43205b.ada
! ac552917303ade3bcc90b97b15f26e94  gcc/testsuite/ada/acats/tests/c4/c43205c.ada
! fb0c33a9daed1c4f2a00c26e9de3c09c  gcc/testsuite/ada/acats/tests/c4/c43205d.ada
! d9e706d3db07df4098bbb0e033aed012  gcc/testsuite/ada/acats/tests/c4/c43205e.ada
! 4f3634691d02036c149cdd006248ffe1  gcc/testsuite/ada/acats/tests/c4/c43205g.ada
! 5c21ffd092ad83125d058e3179c4d1bf  gcc/testsuite/ada/acats/tests/c4/c43205h.ada
! bf224ac40af0ffe5b844895ae6ae977a  gcc/testsuite/ada/acats/tests/c4/c43205i.ada
! 80a79cdbdb7c8185dcf0428e7589a584  gcc/testsuite/ada/acats/tests/c4/c43205j.ada
! 7914df26e752133b470cdb5c585686bc  gcc/testsuite/ada/acats/tests/c4/c43205k.ada
! cbadb73b68d71709f2becaa6f356064c  gcc/testsuite/ada/acats/tests/c4/c43206a.ada
! 0fc8105e29d6d23a3a7ddd6510322795  gcc/testsuite/ada/acats/tests/c4/c43207b.ada
! 97244c88eb0cfebd12378341cddfcf4f  gcc/testsuite/ada/acats/tests/c4/c43207d.ada
! f288bdf0f019b0e6deea7f364629093d  gcc/testsuite/ada/acats/tests/c4/c43208a.ada
! 70aa5e04e1aa2e8f2ffff319c6cc960a  gcc/testsuite/ada/acats/tests/c4/c43208b.ada
! 36f70dc294058acb31101eb9c245937b  gcc/testsuite/ada/acats/tests/c4/c43209a.ada
! 31cacbf3a20b821f6eb8f1d74586a51b  gcc/testsuite/ada/acats/tests/c4/c43210a.ada
! 54b7270b96a5d5519d2358a1b98bf7af  gcc/testsuite/ada/acats/tests/c4/c43211a.ada
! a692660520b9e289a7f0ae27c6d52494  gcc/testsuite/ada/acats/tests/c4/c43212a.ada
! c43685e66248fa05c959fb5d231800a7  gcc/testsuite/ada/acats/tests/c4/c43212c.ada
! 9427f327bd00f1850a52dc14567dbf4e  gcc/testsuite/ada/acats/tests/c4/c43214a.ada
! 2b1a3e33f54f7510083e41b401c3befb  gcc/testsuite/ada/acats/tests/c4/c43214b.ada
! 579da18e7294b44fdfc2fb550cccdbf3  gcc/testsuite/ada/acats/tests/c4/c43214c.ada
! 506424b9dbd9ff75e61b488ce4a5879e  gcc/testsuite/ada/acats/tests/c4/c43214d.ada
! 02fcbb175ddd0a1d8c5564d22bf12428  gcc/testsuite/ada/acats/tests/c4/c43214e.ada
! 34cd6d7cf5c8038e227dde683b30b50f  gcc/testsuite/ada/acats/tests/c4/c43214f.ada
! ab7bedd7c7899bfe816d9a4b9ac394d4  gcc/testsuite/ada/acats/tests/c4/c43215a.ada
! 90e0f447154023e2eab627e883738386  gcc/testsuite/ada/acats/tests/c4/c43215b.ada
! f0098152f11a322c39c1479f279dc3d7  gcc/testsuite/ada/acats/tests/c4/c43222a.ada
! bf1baa8817f6afb1d613db2046cb78de  gcc/testsuite/ada/acats/tests/c4/c43224a.ada
! 1e8e32f41f79462323a2f9d9c83d7939  gcc/testsuite/ada/acats/tests/c4/c433001.a
! 196c158a32a4bc1774a4d934b1a6632e  gcc/testsuite/ada/acats/tests/c4/c44003d.ada
! bf440c6d6ead3b13b20d4e127607337e  gcc/testsuite/ada/acats/tests/c4/c44003f.ada
! 2f9030320131a08536fa11fa1a117664  gcc/testsuite/ada/acats/tests/c4/c44003g.ada
! 62ba7a9a25d025dad4ded263e64d8380  gcc/testsuite/ada/acats/tests/c4/c450001.a
! b3687aae227c95d084c9f685c9ca4c80  gcc/testsuite/ada/acats/tests/c4/c45112a.ada
! c7c3ba0d233fb51ade68d7651dd47189  gcc/testsuite/ada/acats/tests/c4/c45112b.ada
! 49306dfa2cb372d1d65b4dd7a47c19e5  gcc/testsuite/ada/acats/tests/c4/c45113a.ada
! aa0781fb6f24f86504e59a47cf77b3d6  gcc/testsuite/ada/acats/tests/c4/c45114b.ada
! f718c72a25e47da1540690be5ff953da  gcc/testsuite/ada/acats/tests/c4/c452001.a
! 20ba3c7cde16d8bed844c4e64cd33e56  gcc/testsuite/ada/acats/tests/c4/c45201a.ada
! 6d4a1adb58c6e8ef73b34a324604ede4  gcc/testsuite/ada/acats/tests/c4/c45201b.ada
! 72aed4b6ea2fe7dfc0a9fdf3bede3751  gcc/testsuite/ada/acats/tests/c4/c45202b.ada
! 84d744855e2972095386f0e272333a6a  gcc/testsuite/ada/acats/tests/c4/c45210a.ada
! 91f826ce1d8f6889145f46e4c0ccada9  gcc/testsuite/ada/acats/tests/c4/c45211a.ada
! fe9117190ab93e4bd66b4015bb5cdba1  gcc/testsuite/ada/acats/tests/c4/c45220a.ada
! 6912810853452af0c8935cfd387c8df5  gcc/testsuite/ada/acats/tests/c4/c45220b.ada
! b394f131a9012e7c03cfd9636d737e6d  gcc/testsuite/ada/acats/tests/c4/c45220c.ada
! ccf331c469a0927819e1eb56e4e00429  gcc/testsuite/ada/acats/tests/c4/c45220d.ada
! 88d3a9ace4677cd3c025906371d2beeb  gcc/testsuite/ada/acats/tests/c4/c45220e.ada
! bba84a4055dd7c551f067e52bbe462e1  gcc/testsuite/ada/acats/tests/c4/c45220f.ada
! c13eaf9a516abfe2b6beda77dc2e3911  gcc/testsuite/ada/acats/tests/c4/c45231a.ada
! 2cca7d5fea02ce521f28a33db34ffa3d  gcc/testsuite/ada/acats/tests/c4/c45231b.dep
! 1bee766d69082269378c86e19c8abe85  gcc/testsuite/ada/acats/tests/c4/c45231c.dep
! a1bdfcd8a7def7dd624d3536e8905d30  gcc/testsuite/ada/acats/tests/c4/c45231d.tst
! 911d91bbd63a8c74f621846268c3e576  gcc/testsuite/ada/acats/tests/c4/c45232b.ada
! 4de95534392888683c8404eeeed6cc46  gcc/testsuite/ada/acats/tests/c4/c45242b.ada
! f2b98c822abe0cd6885e5b49561ac387  gcc/testsuite/ada/acats/tests/c4/c45251a.ada
! 94a924601ada615360bec26fb5450efb  gcc/testsuite/ada/acats/tests/c4/c45252a.ada
! debd13ddcb22bdcbb8a02c69693b66f8  gcc/testsuite/ada/acats/tests/c4/c45252b.ada
! ac031704393af45bbba41661aa36f2aa  gcc/testsuite/ada/acats/tests/c4/c45253a.ada
! fc9f55680d3672e261c2346c11b8ac30  gcc/testsuite/ada/acats/tests/c4/c45262a.ada
! c4104ba41f3003933d2540d2f946ba70  gcc/testsuite/ada/acats/tests/c4/c45262b.ada
! 8b9cb8019cc36523ada4859ea4a5d16a  gcc/testsuite/ada/acats/tests/c4/c45262c.ada
! d03448ead4d0effaab3998536c97bf20  gcc/testsuite/ada/acats/tests/c4/c45262d.ada
! f5c2479fb34a68704e8a8cc34f61a360  gcc/testsuite/ada/acats/tests/c4/c45264a.ada
! b5849bcd08a3c2d9a5d0c2b9e7a3cddd  gcc/testsuite/ada/acats/tests/c4/c45264b.ada
! 8f21912f6834298744357d557cb137f0  gcc/testsuite/ada/acats/tests/c4/c45264c.ada
! adc3cff25d9a3d6a8177af01212d7415  gcc/testsuite/ada/acats/tests/c4/c45265a.ada
! c4c6e9f92d1c15ec8a4b8f04c34a693f  gcc/testsuite/ada/acats/tests/c4/c45271a.ada
! c72a97f0fec20bbb08fc4517b6ddc788  gcc/testsuite/ada/acats/tests/c4/c45272a.ada
! 6b2a1a4bc714bd568da120c02fbf1702  gcc/testsuite/ada/acats/tests/c4/c45273a.ada
! b79ca71dc3632b190bdef98c6e0d142b  gcc/testsuite/ada/acats/tests/c4/c45274a.ada
! 9855409d4983ad2c1546e338fcbd0706  gcc/testsuite/ada/acats/tests/c4/c45274b.ada
! 435926faf09e9e479e1b1f272c13a333  gcc/testsuite/ada/acats/tests/c4/c45274c.ada
! 9115b9a51b29cec2f4c9ff1428f5a615  gcc/testsuite/ada/acats/tests/c4/c45281a.ada
! ecfe4965aad0d9bc1dc0dea01acceae3  gcc/testsuite/ada/acats/tests/c4/c45282a.ada
! 52a7cd2f9612b968a81d14f925d96de2  gcc/testsuite/ada/acats/tests/c4/c45282b.ada
! b3bd1b305af20f17ece9aabad0feaef1  gcc/testsuite/ada/acats/tests/c4/c45291a.ada
! c8d3cf99b5249db2c22ec520cb247e14  gcc/testsuite/ada/acats/tests/c4/c453001.a
! eaeb6ce37e830b736db8d34c6a83bb7d  gcc/testsuite/ada/acats/tests/c4/c45303a.ada
! f1ec15c9cdb65dbf13e1375cf7996f12  gcc/testsuite/ada/acats/tests/c4/c45304a.ada
! 55a19685b3e235e5bb6750cb9d7df962  gcc/testsuite/ada/acats/tests/c4/c45304b.dep
! b4c45f68d1219b0b994968a9828a7b17  gcc/testsuite/ada/acats/tests/c4/c45304c.dep
! 20fb36abf27afac504d4a771e7e63fd0  gcc/testsuite/ada/acats/tests/c4/c45322a.ada
! fab8bce97e1b74f5541c43ebbc38c44b  gcc/testsuite/ada/acats/tests/c4/c45323a.ada
! 0f09ca069bcacb950f308b51658fe4cf  gcc/testsuite/ada/acats/tests/c4/c45331a.ada
! 923c0cd8bc5f7a54a3ff10b7ecd3ae30  gcc/testsuite/ada/acats/tests/c4/c45342a.ada
! 4c687d4debfb2858cbde8d0598741375  gcc/testsuite/ada/acats/tests/c4/c45343a.ada
! fced8cf133a6e38c1bd3f44b383050a5  gcc/testsuite/ada/acats/tests/c4/c45344a.ada
! 046bf7cdbb7aeb33cdf0c17abb97726b  gcc/testsuite/ada/acats/tests/c4/c45345b.ada
! 1b975a926de8c5e1c1a8fd844dbfa809  gcc/testsuite/ada/acats/tests/c4/c45347a.ada
! 5c3a11fd88252878ac174be55d9cbe23  gcc/testsuite/ada/acats/tests/c4/c45347b.ada
! e7b0eaf3fab48f0c61a33030a45c9625  gcc/testsuite/ada/acats/tests/c4/c45347c.ada
! 5862189030beeea86b9e0d08e37c5f1a  gcc/testsuite/ada/acats/tests/c4/c45347d.ada
! 5a4ad439614a0b55cdeae637fcef3913  gcc/testsuite/ada/acats/tests/c4/c45411a.ada
! b55c932d505fe19faf48b3854f91bf92  gcc/testsuite/ada/acats/tests/c4/c45411b.dep
! cc45fca3dbdc169c3f8a8d219a8f3885  gcc/testsuite/ada/acats/tests/c4/c45411c.dep
! 92372898586e4be4330d20dabffa9b47  gcc/testsuite/ada/acats/tests/c4/c45411d.ada
! fdb465fedee3ebd743401e0c8899b0ce  gcc/testsuite/ada/acats/tests/c4/c45413a.ada
! fbd34bfae4961dda3c3e39ae18565fc8  gcc/testsuite/ada/acats/tests/c4/c45431a.ada
! bda2b940e9dc2584f9295b05e0c20b0f  gcc/testsuite/ada/acats/tests/c4/c455001.a
! 87ea1f3d7a54b6c25dba44fd5a571baa  gcc/testsuite/ada/acats/tests/c4/c45502b.dep
! 5a774d039f16514bc6a77bcf387d50ec  gcc/testsuite/ada/acats/tests/c4/c45502c.dep
! cc87ae3a223cabfed863304f12752609  gcc/testsuite/ada/acats/tests/c4/c45503a.ada
! dcadc5c668c2ff77de523cb7dba5b36a  gcc/testsuite/ada/acats/tests/c4/c45503b.dep
! 611398c2ae165df5a3f7381f660f52a0  gcc/testsuite/ada/acats/tests/c4/c45503c.dep
! f89268db15e37b030991c3827ca26c3e  gcc/testsuite/ada/acats/tests/c4/c45504a.ada
! f0cdb8c22aab2695a23fd98a373755b2  gcc/testsuite/ada/acats/tests/c4/c45504b.dep
! b8b4e008dfce1ee201519835a1fa50b8  gcc/testsuite/ada/acats/tests/c4/c45504c.dep
! ce29dbe3d5204283efb96dbcdfd5aac5  gcc/testsuite/ada/acats/tests/c4/c45504d.ada
! 10c91d5e233ba13218dcd66fb790a7be  gcc/testsuite/ada/acats/tests/c4/c45504e.dep
! 92f6aea3aed6ba9df5385c22f904ba43  gcc/testsuite/ada/acats/tests/c4/c45504f.dep
! 0059f05c198e829fac48965c13f56c08  gcc/testsuite/ada/acats/tests/c4/c45505a.ada
! 47a4e48ddd2b3df3c7eb949e7d6692a8  gcc/testsuite/ada/acats/tests/c4/c45523a.ada
! 17fdb2a59175aad9fef05c8cab8509e5  gcc/testsuite/ada/acats/tests/c4/c45531a.ada
! b8d549a63a2c40e579c8ed0a817ba1b3  gcc/testsuite/ada/acats/tests/c4/c45531b.ada
! c131684e4763854670c42c2112418109  gcc/testsuite/ada/acats/tests/c4/c45531c.ada
! c584d6f3f281816f1bd157cd8cc6b33a  gcc/testsuite/ada/acats/tests/c4/c45531d.ada
! 29ba7e7c1042d7979b1c75938b61e862  gcc/testsuite/ada/acats/tests/c4/c45531e.ada
! 47ea14530564cd8e06520e03e074efb3  gcc/testsuite/ada/acats/tests/c4/c45531f.ada
! 974ec868d7bcf66f2a14b7a4e70541b0  gcc/testsuite/ada/acats/tests/c4/c45531g.ada
! be8ef1a126f5c01246a9b635558e69ed  gcc/testsuite/ada/acats/tests/c4/c45531h.ada
! a795638c4621469321aa1212fd6bc01b  gcc/testsuite/ada/acats/tests/c4/c45531i.ada
! 8e8dbc1f05d26be72eaaaaca136d57b8  gcc/testsuite/ada/acats/tests/c4/c45531j.ada
! f7420a86d16f0dda550ad66d998500fa  gcc/testsuite/ada/acats/tests/c4/c45531k.ada
! de637dfbdf31186f46f1f622a7b31d52  gcc/testsuite/ada/acats/tests/c4/c45531l.ada
! 991294aff87680d765e6feb5cca5b1b5  gcc/testsuite/ada/acats/tests/c4/c45531m.dep
! 0494b2e93ef765b57a27be6b00246238  gcc/testsuite/ada/acats/tests/c4/c45531n.dep
! be4ab72a6216470b4aa0865525f98461  gcc/testsuite/ada/acats/tests/c4/c45531o.dep
! bb7d5366acda158c30e39d3074242262  gcc/testsuite/ada/acats/tests/c4/c45531p.dep
! 1328509e95f292ea980a979dedb08b47  gcc/testsuite/ada/acats/tests/c4/c45532a.ada
! 59f6ce63685d98c434d1a7af9b67d1f3  gcc/testsuite/ada/acats/tests/c4/c45532b.ada
! fe5a8b5f9204d89a9d208c19a93b7bbf  gcc/testsuite/ada/acats/tests/c4/c45532c.ada
! b60deea143add2ece22c54e2958db126  gcc/testsuite/ada/acats/tests/c4/c45532d.ada
! dac58571992e1d76d98508be3cbe2bd6  gcc/testsuite/ada/acats/tests/c4/c45532e.ada
! 1d7df94c7041a350156a66e67466f094  gcc/testsuite/ada/acats/tests/c4/c45532f.ada
! 98b8e00c4f5a9bb275a8ea343272d444  gcc/testsuite/ada/acats/tests/c4/c45532g.ada
! 715b35f0ab3ff72859527fd1dce01194  gcc/testsuite/ada/acats/tests/c4/c45532h.ada
! 6f5e0c33dee8484fe564f99b4aa53644  gcc/testsuite/ada/acats/tests/c4/c45532i.ada
! 4ff1755309ac898b71b5b8e71ed4a3b6  gcc/testsuite/ada/acats/tests/c4/c45532j.ada
! 6c58481cb99358f459163a20d20ecd7c  gcc/testsuite/ada/acats/tests/c4/c45532k.ada
! c77d0519f01191df9cdfba659466ec04  gcc/testsuite/ada/acats/tests/c4/c45532l.ada
! d2858511889a915c130e7db15a855e6a  gcc/testsuite/ada/acats/tests/c4/c45532m.dep
! a549269ed45783ccf0d0c93c5328f429  gcc/testsuite/ada/acats/tests/c4/c45532n.dep
! f4b1217bc94832f638629b8949b7def2  gcc/testsuite/ada/acats/tests/c4/c45532o.dep
! 798f26e21ededa5b524a77eeece6382f  gcc/testsuite/ada/acats/tests/c4/c45532p.dep
! 76101d98b4fab21c843f8c72a2bd9d19  gcc/testsuite/ada/acats/tests/c4/c45534b.ada
! b8ae84ef022a3c5728e841755e4bac5e  gcc/testsuite/ada/acats/tests/c4/c45536a.dep
! 28591d736802ebfac3f139de9f8cf2e7  gcc/testsuite/ada/acats/tests/c4/c456001.a
! bc49b87b69b7e8faefa883dc0c55fb68  gcc/testsuite/ada/acats/tests/c4/c45611a.ada
! 3be40e2b85d211f880f0c3afd51a63e8  gcc/testsuite/ada/acats/tests/c4/c45611b.dep
! 969e8cbd817e50baf599dd80133f7e3d  gcc/testsuite/ada/acats/tests/c4/c45611c.dep
! 48d114a182e767e243d7ef95e93e4e19  gcc/testsuite/ada/acats/tests/c4/c45613a.ada
! c3d80667bb998de0b21993ea73edabec  gcc/testsuite/ada/acats/tests/c4/c45613b.dep
! f8ed3027af651e8a9c09b39c0abf883c  gcc/testsuite/ada/acats/tests/c4/c45613c.dep
! cfe72bc879be3b00ef382558884d4b1d  gcc/testsuite/ada/acats/tests/c4/c45614a.ada
! c49e020a85a8868eed26fc38aaab04bf  gcc/testsuite/ada/acats/tests/c4/c45614b.dep
! 41f7a3468254617c1e8fd2e5932a25b4  gcc/testsuite/ada/acats/tests/c4/c45614c.dep
! ac5d52f05c31abf886e8c8c4468e3276  gcc/testsuite/ada/acats/tests/c4/c45631a.ada
! 08c1f1a469e3e9753825625f1a28b1ea  gcc/testsuite/ada/acats/tests/c4/c45631b.dep
! 3d90d62c311cc7457e997be47d4bc90b  gcc/testsuite/ada/acats/tests/c4/c45631c.dep
! 2f244bf1111e453d24ff570db3165fdb  gcc/testsuite/ada/acats/tests/c4/c45632a.ada
! 3e3d1f108ceb3c5be9dad7868239132f  gcc/testsuite/ada/acats/tests/c4/c45632b.dep
! d562e6283ca6c800b69581c080526e08  gcc/testsuite/ada/acats/tests/c4/c45632c.dep
! 2057dc7ea5393bc4be1493fb108ee5fb  gcc/testsuite/ada/acats/tests/c4/c45651a.ada
! c6892aa7717ffbd54f697e3d5db788af  gcc/testsuite/ada/acats/tests/c4/c45662a.ada
! a04b5f03883d1f148e66d75bb8eb5a69  gcc/testsuite/ada/acats/tests/c4/c45662b.ada
! ebd6cdab4f3e678623c2ece9ee770d5e  gcc/testsuite/ada/acats/tests/c4/c45672a.ada
! ac5adcf11bac18511d0fcfabda779d68  gcc/testsuite/ada/acats/tests/c4/c460001.a
! afb5f92407f4912f75eeaef16084757f  gcc/testsuite/ada/acats/tests/c4/c460002.a
! 69401711fe089c368e9218ac971b8e5a  gcc/testsuite/ada/acats/tests/c4/c460004.a
! f7f9cde65ac6273493f88f7cc35065c2  gcc/testsuite/ada/acats/tests/c4/c460005.a
! e0ce32e221b728a5e7cbef5d66bdb49b  gcc/testsuite/ada/acats/tests/c4/c460006.a
! ec69fdc3a65a761d8134bc49e6570216  gcc/testsuite/ada/acats/tests/c4/c460007.a
! 8b03807b80d9f2edc57ad06734bf670f  gcc/testsuite/ada/acats/tests/c4/c460008.a
! 6950bb628b3003b1ceb3b53e6cf246f8  gcc/testsuite/ada/acats/tests/c4/c460009.a
! 5bc44a3344b33409dd851c6b03e885b7  gcc/testsuite/ada/acats/tests/c4/c460010.a
! f62a801d63af2b71a0b6fc1ab47ef7e7  gcc/testsuite/ada/acats/tests/c4/c460011.a
! a2898cc40c52d07d2a1d5f39c8daae42  gcc/testsuite/ada/acats/tests/c4/c460012.a
! 41b9bdba491afbeb94cec249b368498b  gcc/testsuite/ada/acats/tests/c4/c460013.a
! 8caad81fc1b11cdf36c43c5366ffe8c4  gcc/testsuite/ada/acats/tests/c4/c460014.a
! 4578ba3cbcc42767bfa1d9fb8beed52f  gcc/testsuite/ada/acats/tests/c4/c46011a.ada
! 573e5b85d6d0d9289787bcf7f265aea9  gcc/testsuite/ada/acats/tests/c4/c46013a.ada
! ad32d1cce692c7cd1ef8bf3d2f70dee2  gcc/testsuite/ada/acats/tests/c4/c46014a.ada
! 3860375240c7fbeec5ea607c60613d17  gcc/testsuite/ada/acats/tests/c4/c46021a.ada
! 6ca67808bea0b36f928ece90dac5570f  gcc/testsuite/ada/acats/tests/c4/c46024a.ada
! 846bd637f5220b864dde4f2ea9ac8025  gcc/testsuite/ada/acats/tests/c4/c46031a.ada
! 362f593ed41bfc3cc23925318952cbc7  gcc/testsuite/ada/acats/tests/c4/c46032a.ada
! 65b59a01caacc42c4057aa1adad39e9c  gcc/testsuite/ada/acats/tests/c4/c46033a.ada
! bc9fedd5661dbda9254ef00f93819e37  gcc/testsuite/ada/acats/tests/c4/c46041a.ada
! dd2bc24443f9516af6adaf665228f9fb  gcc/testsuite/ada/acats/tests/c4/c46042a.ada
! cc5cd66068669bee0635ba7d5d5b9e4b  gcc/testsuite/ada/acats/tests/c4/c46043b.ada
! 862e92acebb016f9eaff87800084fb00  gcc/testsuite/ada/acats/tests/c4/c46044b.ada
! 8704bc96d1d99d958dd9ba580cc0fcab  gcc/testsuite/ada/acats/tests/c4/c46051a.ada
! 4301c097675c9ae1e1de85cb434e9f91  gcc/testsuite/ada/acats/tests/c4/c46051b.ada
! 0852a062d8fb5318db0fafb3e74e1869  gcc/testsuite/ada/acats/tests/c4/c46051c.ada
! 207b83887faae118af7863a8e7c8b797  gcc/testsuite/ada/acats/tests/c4/c46052a.ada
! 36ddef6a40e98fa6f687083359dcc79c  gcc/testsuite/ada/acats/tests/c4/c46053a.ada
! 7c918ea610224feb8290e7538e4931c0  gcc/testsuite/ada/acats/tests/c4/c46054a.ada
! dcaaa25c241dbab83f2031ac8a166ad0  gcc/testsuite/ada/acats/tests/c4/c460a01.a
! c9d756313dbe8edba8cd79f261be675b  gcc/testsuite/ada/acats/tests/c4/c460a02.a
! 8453f66003fadf1256272c8267ac59fe  gcc/testsuite/ada/acats/tests/c4/c47002a.ada
! a1a15e98aa414e9e0f6c684cc5fc7d3d  gcc/testsuite/ada/acats/tests/c4/c47002b.ada
! 52b6ce3f1ece2252097d9cf94ff704d8  gcc/testsuite/ada/acats/tests/c4/c47002c.ada
! 1b3f120455d714443fa2b8a6510141b3  gcc/testsuite/ada/acats/tests/c4/c47002d.ada
! e24d41d29f205af082effc4960aabff2  gcc/testsuite/ada/acats/tests/c4/c47003a.ada
! 676bb791325a2ce2931c822d1ba079e8  gcc/testsuite/ada/acats/tests/c4/c47004a.ada
! 5768cda2bc4788bb66c01ffbbe818333  gcc/testsuite/ada/acats/tests/c4/c47005a.ada
! 7180522de8601bc47eada08923197c21  gcc/testsuite/ada/acats/tests/c4/c47006a.ada
! 0866501ce0f4c5ac19a1a6701494acf1  gcc/testsuite/ada/acats/tests/c4/c47007a.ada
! f190b1e58c5b9f88edb7c62cc786a5ff  gcc/testsuite/ada/acats/tests/c4/c47008a.ada
! a83ffa688fac3d8d28808297d6c1f8af  gcc/testsuite/ada/acats/tests/c4/c47009a.ada
! 7e410443d7fee4c5025000324c9fa075  gcc/testsuite/ada/acats/tests/c4/c47009b.ada
! bc1787b8c3d0a2828cd39079641a7ae3  gcc/testsuite/ada/acats/tests/c4/c48004a.ada
! 35a79d509102b6efc374a823e03081dd  gcc/testsuite/ada/acats/tests/c4/c48004b.ada
! 520b577b8b19f3e983fa89ee6a4feae4  gcc/testsuite/ada/acats/tests/c4/c48004c.ada
! 4a4dc141e6c0b8734f2f4889a453c041  gcc/testsuite/ada/acats/tests/c4/c48004d.ada
! e1de901127f9fa068bbc1887e40ae286  gcc/testsuite/ada/acats/tests/c4/c48004e.ada
! a21a603107226dd95249e796c50b2988  gcc/testsuite/ada/acats/tests/c4/c48004f.ada
! d05127b0bccfaca8e70b371616b9e949  gcc/testsuite/ada/acats/tests/c4/c48005a.ada
! 93f4d6e87a4f9f685f9aad61502c858c  gcc/testsuite/ada/acats/tests/c4/c48005b.ada
! 794d0af908f9931f0b089116f1e42907  gcc/testsuite/ada/acats/tests/c4/c48006a.ada
! 3df923c9af6683c1bb48881ddb41ddfb  gcc/testsuite/ada/acats/tests/c4/c48006b.ada
! a6c0f722acc9486a7e600dc96ff2d5cd  gcc/testsuite/ada/acats/tests/c4/c48007a.ada
! b2751238701befe768d059585cb34fbe  gcc/testsuite/ada/acats/tests/c4/c48007b.ada
! a069ec763e24859fbddc4f107e410c11  gcc/testsuite/ada/acats/tests/c4/c48007c.ada
! 009ebc3b69f9c31aa88c54a85271399a  gcc/testsuite/ada/acats/tests/c4/c48008a.ada
! 5782d3eeb5e00949ec2f3c7a7ae59650  gcc/testsuite/ada/acats/tests/c4/c48008c.ada
! 36b2b00fc2eaa55063b74bfc4cb91c79  gcc/testsuite/ada/acats/tests/c4/c48009a.ada
! d7356de4b25053ff97c5d99c7daa90a2  gcc/testsuite/ada/acats/tests/c4/c48009b.ada
! 46e9f0e1b269b6b499944395221ae145  gcc/testsuite/ada/acats/tests/c4/c48009c.ada
! 99e82e54208e5f2e641da892789ade00  gcc/testsuite/ada/acats/tests/c4/c48009d.ada
! a4dd405fd63b81dac153b62e7df858e9  gcc/testsuite/ada/acats/tests/c4/c48009e.ada
! a761ea12752cc1827d795f510ed14854  gcc/testsuite/ada/acats/tests/c4/c48009f.ada
! f4d13322456cdc5177a9641ba263e997  gcc/testsuite/ada/acats/tests/c4/c48009g.ada
! 9b3d09b25afb28f96e9c15abc9134ea5  gcc/testsuite/ada/acats/tests/c4/c48009h.ada
! 5ed239b238e9da030fa1d1bbf81e4dc3  gcc/testsuite/ada/acats/tests/c4/c48009i.ada
! dbe1181c1fb1c91cdfc5d5a51327b289  gcc/testsuite/ada/acats/tests/c4/c48009j.ada
! 688a1e8190cac3b78936f0235d3b808d  gcc/testsuite/ada/acats/tests/c4/c48010a.ada
! 48a6ec9afe098c7d148a0d1f652be09e  gcc/testsuite/ada/acats/tests/c4/c48011a.ada
! 18db6e638dc720b6501696a26aa99e58  gcc/testsuite/ada/acats/tests/c4/c48012a.ada
! b30035b53424a29691b261dda34fc58e  gcc/testsuite/ada/acats/tests/c4/c490001.a
! 489ea02e3356b5145fb51c63bb474ea5  gcc/testsuite/ada/acats/tests/c4/c490002.a
! c9523cc2889cfcde83e23c042eedd694  gcc/testsuite/ada/acats/tests/c4/c490003.a
! 6f98fb5a40e92d1a16d6c2a144d613a5  gcc/testsuite/ada/acats/tests/c4/c49020a.ada
! 949b858aea6369cc5f6b92e57a36762e  gcc/testsuite/ada/acats/tests/c4/c49021a.ada
! 61eb9a59008479c0875739f8a38a6058  gcc/testsuite/ada/acats/tests/c4/c49022a.ada
! 371d9a00cb41f67a40d255081149947a  gcc/testsuite/ada/acats/tests/c4/c49022b.ada
! 6cbf71a7cecd0227501309baf6e99545  gcc/testsuite/ada/acats/tests/c4/c49022c.ada
! ae09e5339a3f4903f8fa5d11de07d714  gcc/testsuite/ada/acats/tests/c4/c49023a.ada
! e2d3c0d182fcc8306bf82e940cacf1c0  gcc/testsuite/ada/acats/tests/c4/c49024a.ada
! fa1107ef6dfef6a91126632e0fd40ac9  gcc/testsuite/ada/acats/tests/c4/c49025a.ada
! 8308838bc1d5d9801f0aba7872873b2e  gcc/testsuite/ada/acats/tests/c4/c49026a.ada
! 67dd3195321fffe06e278c7a2dd46fb7  gcc/testsuite/ada/acats/tests/c4/c4a005b.ada
! b4f6152a06508643187aed55fe1b066d  gcc/testsuite/ada/acats/tests/c4/c4a006a.ada
! 5eddb402835a4195abec99f2970765f6  gcc/testsuite/ada/acats/tests/c4/c4a007a.tst
! 1c61fe192df4f7bf89c81bd93f979629  gcc/testsuite/ada/acats/tests/c4/c4a010a.ada
! db5b09d1af5f03cbfc83813c6cef98d9  gcc/testsuite/ada/acats/tests/c4/c4a010b.ada
! 8ea93dd812f5645ad034052c5e9c14bc  gcc/testsuite/ada/acats/tests/c4/c4a011a.ada
! d8a1f20f1b4a1339f232102f757a12c6  gcc/testsuite/ada/acats/tests/c4/c4a012b.ada
! df1956d8e1bdb8b421d8edda86514e73  gcc/testsuite/ada/acats/tests/c4/c4a013a.ada
! f95cf7fe1c6669b86824c685ca90c44f  gcc/testsuite/ada/acats/tests/c4/c4a014a.ada
! 04305b71fc4860700405904b070a802b  gcc/testsuite/ada/acats/tests/c5/c51004a.ada
! c6f0f59f33111f1bb049c5f25022c725  gcc/testsuite/ada/acats/tests/c5/c52005a.ada
! 4497fa9cc187eebee09f422eb12067f6  gcc/testsuite/ada/acats/tests/c5/c52005b.ada
! 31714495e63b10120b8239b0456549ee  gcc/testsuite/ada/acats/tests/c5/c52005c.ada
! c643f87a63f83ab7dedfa0b4647174c9  gcc/testsuite/ada/acats/tests/c5/c52005d.ada
! a717ed0d0e4578d9b1ba1e84a1312d88  gcc/testsuite/ada/acats/tests/c5/c52005e.ada
! e9e335b018c1995e8f516236efc80a20  gcc/testsuite/ada/acats/tests/c5/c52005f.ada
! c475aae75de9114facd3aaa775556697  gcc/testsuite/ada/acats/tests/c5/c52008a.ada
! 87cbbe1931b5cfdb29756f338e098ee1  gcc/testsuite/ada/acats/tests/c5/c52008b.ada
! 67bb5622435b51d6b7a862890b654771  gcc/testsuite/ada/acats/tests/c5/c52009a.ada
! 400c804c17dce5b2cbc92e00f53bdbf7  gcc/testsuite/ada/acats/tests/c5/c52009b.ada
! d656f6cd000039c412836d5baacbff52  gcc/testsuite/ada/acats/tests/c5/c52010a.ada
! 1f26091c9bf683f6970689d5d0980a81  gcc/testsuite/ada/acats/tests/c5/c52011a.ada
! bd17088998a5ebb4a8a3f1ae8ed0fb56  gcc/testsuite/ada/acats/tests/c5/c52011b.ada
! 497212d2daf8375937c749ee7ebcc2df  gcc/testsuite/ada/acats/tests/c5/c52101a.ada
! d79452ecad6774f7462778af7f7ce5eb  gcc/testsuite/ada/acats/tests/c5/c52102a.ada
! c3ffbc3a8172219b7b11be58eb4ee73d  gcc/testsuite/ada/acats/tests/c5/c52102b.ada
! d8b031579b48e0bae598c821fc7f2799  gcc/testsuite/ada/acats/tests/c5/c52102c.ada
! 8545078e881db7a6a84e41583799ee5d  gcc/testsuite/ada/acats/tests/c5/c52102d.ada
! 348fad1e9e6e04b677fd7d942e3416af  gcc/testsuite/ada/acats/tests/c5/c52103a.ada
! 537e555773a4e758b8466c079c2023a1  gcc/testsuite/ada/acats/tests/c5/c52103b.ada
! c118c8520f99ad57e36a1e1ed0ab2549  gcc/testsuite/ada/acats/tests/c5/c52103c.ada
! 161ca114e3549ca32b6abc801f74633d  gcc/testsuite/ada/acats/tests/c5/c52103f.ada
! 553aa64efc629783fc32ef6b352ae6be  gcc/testsuite/ada/acats/tests/c5/c52103g.ada
! 29498cb969386c5b69bd6ba62c7be406  gcc/testsuite/ada/acats/tests/c5/c52103h.ada
! 8026673b1e67673c009f39e569ae1a3e  gcc/testsuite/ada/acats/tests/c5/c52103k.ada
! c6b31cf4833909c9d4dae839511863ec  gcc/testsuite/ada/acats/tests/c5/c52103l.ada
! 6843840acb3dee1ae11cf9365156daaa  gcc/testsuite/ada/acats/tests/c5/c52103m.ada
! 70a2f3db7206a779a035e915788f37f0  gcc/testsuite/ada/acats/tests/c5/c52103p.ada
! a28a2bdec6b574435427b9aeb1c74945  gcc/testsuite/ada/acats/tests/c5/c52103q.ada
! 7b9ecdaf00c3655bb24701195d08a83f  gcc/testsuite/ada/acats/tests/c5/c52103r.ada
! 0c814953f2bf8472a62eb44838f04363  gcc/testsuite/ada/acats/tests/c5/c52103x.ada
! e772fcfb1386e00244d4b143524cc196  gcc/testsuite/ada/acats/tests/c5/c52104a.ada
! 16ef5ba633cf0703eef0f4bc4e6a931e  gcc/testsuite/ada/acats/tests/c5/c52104b.ada
! 0d83ec342af202df515bd811d311775e  gcc/testsuite/ada/acats/tests/c5/c52104c.ada
! 63ba1297346e75dcba0a5bebb9fd7feb  gcc/testsuite/ada/acats/tests/c5/c52104f.ada
! 360c84a7d7a20d6426f39f47175e9e61  gcc/testsuite/ada/acats/tests/c5/c52104g.ada
! 8c2507e3ca68c72c1b2e6d6e118ec32b  gcc/testsuite/ada/acats/tests/c5/c52104h.ada
! 3eb7315199feb380e4633e0fa784d0dc  gcc/testsuite/ada/acats/tests/c5/c52104k.ada
! 1e9c8d887474d4edd8e8cef2ca34972f  gcc/testsuite/ada/acats/tests/c5/c52104l.ada
! 4cd7ce90121345b41e548625afd89238  gcc/testsuite/ada/acats/tests/c5/c52104m.ada
! bb14b1ee179559762fe853803c6f47a0  gcc/testsuite/ada/acats/tests/c5/c52104p.ada
! 11c63d2f8a8f5be641d543c723d95db6  gcc/testsuite/ada/acats/tests/c5/c52104q.ada
! 3e89a5e299b2f10a8bfdddda7e51ad94  gcc/testsuite/ada/acats/tests/c5/c52104r.ada
! cf3c9c7c07a47d92020285624997c09f  gcc/testsuite/ada/acats/tests/c5/c52104x.ada
! c937dcfea0e38e6a3b8af09de0efaf04  gcc/testsuite/ada/acats/tests/c5/c52104y.ada
! b2aa45debad3d8e7603216de3bca00fb  gcc/testsuite/ada/acats/tests/c5/c53007a.ada
! ff458115437146bc66c6f7135942dc7d  gcc/testsuite/ada/acats/tests/c5/c540001.a
! 798fc3cdc6929204af5e109c7b552b96  gcc/testsuite/ada/acats/tests/c5/c54a03a.ada
! 350e6e9e9f439b08c9984e18a29b6144  gcc/testsuite/ada/acats/tests/c5/c54a04a.ada
! 672e5fee1b44c051e35bd39f7cfdd7f6  gcc/testsuite/ada/acats/tests/c5/c54a07a.ada
! 55636ae11b1e87d2920da673ac54f8cf  gcc/testsuite/ada/acats/tests/c5/c54a13a.ada
! fadaa20972179cfa78055a5255aaf701  gcc/testsuite/ada/acats/tests/c5/c54a13b.ada
! 1f2ca9fde851497809ddf860f08ea8dd  gcc/testsuite/ada/acats/tests/c5/c54a13c.ada
! f02b8333b09eadfe396595d861e0c28e  gcc/testsuite/ada/acats/tests/c5/c54a13d.ada
! 37f2526490642267865f8a817c455655  gcc/testsuite/ada/acats/tests/c5/c54a22a.ada
! c4b7807f9faa1bb76d79507d98a0feb3  gcc/testsuite/ada/acats/tests/c5/c54a23a.ada
! 45d1b598e30b318d11d3cfa6a37cc6fa  gcc/testsuite/ada/acats/tests/c5/c54a24a.ada
! adeadf039e14eb8bc2b48ff5572bd812  gcc/testsuite/ada/acats/tests/c5/c54a24b.ada
! 7cf7b4d54a6bca23e102d02570e8d836  gcc/testsuite/ada/acats/tests/c5/c54a42a.ada
! 200024964c0cd6807dda9226ae982125  gcc/testsuite/ada/acats/tests/c5/c54a42b.ada
! b58d58ea8c08f008f3bb0a1f4e37600d  gcc/testsuite/ada/acats/tests/c5/c54a42c.ada
! 7afca27633e115e11ccc09450181d955  gcc/testsuite/ada/acats/tests/c5/c54a42d.ada
! 810d89d05b84beb31789b0ebd7aba86d  gcc/testsuite/ada/acats/tests/c5/c54a42e.ada
! 012f75628d8e37cbd1be10f8f4ba117f  gcc/testsuite/ada/acats/tests/c5/c54a42f.ada
! d45cbd6907b0f421c6aec9b981f052d6  gcc/testsuite/ada/acats/tests/c5/c54a42g.ada
! ef97a2623a512e16e0fda04f277b6ff2  gcc/testsuite/ada/acats/tests/c5/c55b03a.ada
! ad40c92edd66b18fad76286ec1b9c6ae  gcc/testsuite/ada/acats/tests/c5/c55b04a.ada
! aa1f7abf4fbb36f5120549a0305b7862  gcc/testsuite/ada/acats/tests/c5/c55b05a.ada
! 93af4cbae77af58c9e4c76145e3381b0  gcc/testsuite/ada/acats/tests/c5/c55b06a.ada
! 83fb65a1faa9605647ad3455e55fa273  gcc/testsuite/ada/acats/tests/c5/c55b06b.ada
! 1c3a3e590230416971b33336bec05137  gcc/testsuite/ada/acats/tests/c5/c55b07a.dep
! 297ac06b1460ecfad84e5ce426b452d5  gcc/testsuite/ada/acats/tests/c5/c55b07b.dep
! 9f79657a1fb3ec7ad658a79647c5949c  gcc/testsuite/ada/acats/tests/c5/c55b10a.ada
! 1364f5750f4c9a8395cf0b1ae42eee0b  gcc/testsuite/ada/acats/tests/c5/c55b11a.ada
! 20c657742ad353aedf983932ae3ad058  gcc/testsuite/ada/acats/tests/c5/c55b11b.ada
! dcbc66de120373907bc61655da9f5f72  gcc/testsuite/ada/acats/tests/c5/c55b15a.ada
! 46488465caae85e036ca25f7a3861ddb  gcc/testsuite/ada/acats/tests/c5/c55b16a.ada
! 59a61b3784b5cede84a98e874e989bf9  gcc/testsuite/ada/acats/tests/c5/c55c02a.ada
! a665c1df7fabf7499dd2fef8021e5735  gcc/testsuite/ada/acats/tests/c5/c55c02b.ada
! 9722acc7b86adb50f2132a53c9a9ba5f  gcc/testsuite/ada/acats/tests/c5/c56002a.ada
! 0d40a16731d63ec204e884f94b191598  gcc/testsuite/ada/acats/tests/c5/c57003a.ada
! 7bceaaa459e0581dd43947812fb6e226  gcc/testsuite/ada/acats/tests/c5/c57004a.ada
! 30ed2943b27da30ba5be8602f46f6e65  gcc/testsuite/ada/acats/tests/c5/c57004b.ada
! 8a811d9acc70a272fa09cbfe47fdbbc0  gcc/testsuite/ada/acats/tests/c5/c58004c.ada
! 17e55b043903edcc29571ab8bd8aa78c  gcc/testsuite/ada/acats/tests/c5/c58004d.ada
! 7807a279489151c0c870e2d8f12f4502  gcc/testsuite/ada/acats/tests/c5/c58004g.ada
! 1b5dcc2941f69ee8c74a24728bb90d67  gcc/testsuite/ada/acats/tests/c5/c58005a.ada
! 62354e1ba2b765af08aa33a5e09c47df  gcc/testsuite/ada/acats/tests/c5/c58005b.ada
! 9028a4a38fba5ee0a721a8918c7e46c8  gcc/testsuite/ada/acats/tests/c5/c58005h.ada
! fa480782be6698aa97970fcf14c2f19b  gcc/testsuite/ada/acats/tests/c5/c58006a.ada
! 156c239407b9c9b5abfd28b286d35734  gcc/testsuite/ada/acats/tests/c5/c58006b.ada
! 05e86bfca592c5c4d28a7ad45f8d8054  gcc/testsuite/ada/acats/tests/c5/c59002a.ada
! 70857f43256c7a44ec4b50f5aa1b4b0d  gcc/testsuite/ada/acats/tests/c5/c59002b.ada
! 7656b04738b59910b4cd6415feaa6aea  gcc/testsuite/ada/acats/tests/c5/c59002c.ada
! 22c213bb3f4fac53cfad7701e5a6591a  gcc/testsuite/ada/acats/tests/c6/c61008a.ada
! 5fb3b13780dfa407dfa99fcfa590913f  gcc/testsuite/ada/acats/tests/c6/c61009a.ada
! 25cf5d0e53424f3054a20393c002970e  gcc/testsuite/ada/acats/tests/c6/c61010a.ada
! fc4b87310c6618ffbf7d4df1f222a45f  gcc/testsuite/ada/acats/tests/c6/c620001.a
! 2a393ff1326482d8490f5be202d8483c  gcc/testsuite/ada/acats/tests/c6/c620002.a
! 97d97866837d419b1ddcfa6ccda2511e  gcc/testsuite/ada/acats/tests/c6/c62002a.ada
! 29777c913c6649484125c1aa56f0093f  gcc/testsuite/ada/acats/tests/c6/c62003a.ada
! 3e2cc6ba1c79eb1d9f3fe3bbb646cf6b  gcc/testsuite/ada/acats/tests/c6/c62003b.ada
! 624bc88129c0b954774c60019f5435c5  gcc/testsuite/ada/acats/tests/c6/c62004a.ada
! 31c5b507af85354e0db53a078e7c8933  gcc/testsuite/ada/acats/tests/c6/c62006a.ada
! e8a1274fb71dcf0b27d5375c78e8d1d3  gcc/testsuite/ada/acats/tests/c6/c631001.a
! 41a6d9efe5d22a0f96b7c4448831b133  gcc/testsuite/ada/acats/tests/c6/c640001.a
! 67136569bb3a58c14f65e3abd9b96391  gcc/testsuite/ada/acats/tests/c6/c64002b.ada
! 298c0d717f1da2c324c78b6aafedfa91  gcc/testsuite/ada/acats/tests/c6/c64004g.ada
! 0a5ebe2531dcbec11f3d606df5534e5b  gcc/testsuite/ada/acats/tests/c6/c64005a.ada
! 1a7b4a32917f31d77deb5ad294e39f82  gcc/testsuite/ada/acats/tests/c6/c64005b.ada
! 292b4b0e6cf19da205f4d3a1caeee992  gcc/testsuite/ada/acats/tests/c6/c64005c.ada
! db80e980a183a6d0f7c9afd52fae0c87  gcc/testsuite/ada/acats/tests/c6/c64005d0.ada
! f480e72d2a8b3a22347018687fb9f190  gcc/testsuite/ada/acats/tests/c6/c64005da.ada
! 035da89aedf781e8b07eace791889088  gcc/testsuite/ada/acats/tests/c6/c64005db.ada
! 9af982279e39e967d04656170afef341  gcc/testsuite/ada/acats/tests/c6/c64005dc.ada
! 2f3c835897b61c5b02af1bef11a949d6  gcc/testsuite/ada/acats/tests/c6/c641001.a
! f9894df16dafde8c37b5681a9a0b728f  gcc/testsuite/ada/acats/tests/c6/c64103b.ada
! 573a659bd2d30c3c8a3ee7f77390490c  gcc/testsuite/ada/acats/tests/c6/c64103c.ada
! e7242de3cddb62031ef1910e911942df  gcc/testsuite/ada/acats/tests/c6/c64103d.ada
! 6e2e6c719dcbb601e033a3a1528b6db5  gcc/testsuite/ada/acats/tests/c6/c64103e.ada
! aa17757d55d04a8ef672505933d46680  gcc/testsuite/ada/acats/tests/c6/c64103f.ada
! bbb85cc245f09eba3db627d88d52db68  gcc/testsuite/ada/acats/tests/c6/c64104a.ada
! d3f37083469fc62f2aeae2c00e979ad9  gcc/testsuite/ada/acats/tests/c6/c64104b.ada
! 00b5b6264d3df93a1481ca7dd0313957  gcc/testsuite/ada/acats/tests/c6/c64104c.ada
! 0d80f34c16a2ae02db45210c6b66eaa8  gcc/testsuite/ada/acats/tests/c6/c64104d.ada
! 5dc873b400a6675c734e431ac91f74db  gcc/testsuite/ada/acats/tests/c6/c64104e.ada
! 54921e31e5a30e388946a946c10c8954  gcc/testsuite/ada/acats/tests/c6/c64104f.ada
! b763fdc647a8b6c2e8ccdcc7b2e1556c  gcc/testsuite/ada/acats/tests/c6/c64104g.ada
! 0a7c01deaae4401d7fe1f7f78e4e6325  gcc/testsuite/ada/acats/tests/c6/c64104h.ada
! 39b3c50eb36b7e11b1d9e78a7b3f9132  gcc/testsuite/ada/acats/tests/c6/c64104i.ada
! a30f87a67e828d3791f26521921a8f81  gcc/testsuite/ada/acats/tests/c6/c64104j.ada
! 8906347f1c0f027d889a06f25fcc1831  gcc/testsuite/ada/acats/tests/c6/c64104k.ada
! 4cb01879b0f85af48c5474c558534e54  gcc/testsuite/ada/acats/tests/c6/c64104l.ada
! cd1d978bf7503e964f5c0293089096c1  gcc/testsuite/ada/acats/tests/c6/c64104m.ada
! 62990064fd13a84570c91f3d1f71338f  gcc/testsuite/ada/acats/tests/c6/c64104n.ada
! ff64768b090411d3f8232b7dc479db5f  gcc/testsuite/ada/acats/tests/c6/c64104o.ada
! c371cb358b8e763068dd4af101cd7f51  gcc/testsuite/ada/acats/tests/c6/c64105a.ada
! f1cfabbe7fa319f7a90669a5a1d88874  gcc/testsuite/ada/acats/tests/c6/c64105b.ada
! 484938df1d2ea23b4699185521d927ae  gcc/testsuite/ada/acats/tests/c6/c64105c.ada
! 98ba505c37a1fa4544aa7a16f86476d8  gcc/testsuite/ada/acats/tests/c6/c64105d.ada
! 7f5ef4e4117e3403c814c8b2d6248652  gcc/testsuite/ada/acats/tests/c6/c64106a.ada
! c719851b2aa8d7de278a61b4ae401e7f  gcc/testsuite/ada/acats/tests/c6/c64106b.ada
! 99b026e3c033b0bc70bbb34952c61a90  gcc/testsuite/ada/acats/tests/c6/c64106c.ada
! 1ff08389beb50526e6d5946f3ddfa0d2  gcc/testsuite/ada/acats/tests/c6/c64106d.ada
! 19103ed02e019b6f2490bd4285878194  gcc/testsuite/ada/acats/tests/c6/c64107a.ada
! 93d945e280814e3db9cdaa9a9be57e87  gcc/testsuite/ada/acats/tests/c6/c64108a.ada
! 39bf7a6fa5bcfb5ee8e52f5f07fafefc  gcc/testsuite/ada/acats/tests/c6/c64109a.ada
! 7a1023fda1950978c62798e5caff709c  gcc/testsuite/ada/acats/tests/c6/c64109b.ada
! 276b67fe008e97a4988487fc615e1f3c  gcc/testsuite/ada/acats/tests/c6/c64109c.ada
! 80192570a6b338162a9ef9bfc13a4dff  gcc/testsuite/ada/acats/tests/c6/c64109d.ada
! 4719b8ddae4538b59e04d96c932a95d9  gcc/testsuite/ada/acats/tests/c6/c64109e.ada
! ed4b4f3ef743bc7f8f4a6afe5886cae2  gcc/testsuite/ada/acats/tests/c6/c64109f.ada
! 8f7ab91cec27ffbad7b51252ef99b137  gcc/testsuite/ada/acats/tests/c6/c64109g.ada
! 2bb8cec80fd6bc3ed2495c9581ea2a9e  gcc/testsuite/ada/acats/tests/c6/c64109h.ada
! 495be9b835fa97670e1a579d72a3f96d  gcc/testsuite/ada/acats/tests/c6/c64109i.ada
! 547c93bc4be631648c9973120c282a89  gcc/testsuite/ada/acats/tests/c6/c64109j.ada
! 4da6b83416827b9d2d574334772ff2a3  gcc/testsuite/ada/acats/tests/c6/c64109k.ada
! 6217fe2218b5d9ecf085e1b730917030  gcc/testsuite/ada/acats/tests/c6/c64109l.ada
! dde2e62be923a3854e5f1667c4a78def  gcc/testsuite/ada/acats/tests/c6/c64201b.ada
! c3459cee62caf16a8d14f820e16c4f60  gcc/testsuite/ada/acats/tests/c6/c64201c.ada
! e589f5c8d3bb97575b245a37a5f2dffa  gcc/testsuite/ada/acats/tests/c6/c64202a.ada
! 219803e5e3580d21284552cdfe112a0f  gcc/testsuite/ada/acats/tests/c6/c650001.a
! 25c48d1366d3ac13453832dcee471f3f  gcc/testsuite/ada/acats/tests/c6/c65003a.ada
! beca3ad5c25f888eed6dc6b1db750e33  gcc/testsuite/ada/acats/tests/c6/c65003b.ada
! 4eca86193e279acda5aa647dab2bf5bf  gcc/testsuite/ada/acats/tests/c6/c66002a.ada
! 7cbfd161ceac490eb379a5c08eb1945c  gcc/testsuite/ada/acats/tests/c6/c66002c.ada
! 482c9214fae39fbcab58fcbae0b5b5ef  gcc/testsuite/ada/acats/tests/c6/c66002d.ada
! 7a93f84ee40f38fca4afb6cfd5e69a57  gcc/testsuite/ada/acats/tests/c6/c66002e.ada
! 2b60fab145676d717df13cdf9c7a70cb  gcc/testsuite/ada/acats/tests/c6/c66002f.ada
! ea770ca1e9d9fcb8b4460d5921747ef5  gcc/testsuite/ada/acats/tests/c6/c66002g.ada
! 8470fdb16485b4472bee0602f1f98734  gcc/testsuite/ada/acats/tests/c6/c67002a.ada
! 0e2fbb4deae7d888206b0ce77fc4fda5  gcc/testsuite/ada/acats/tests/c6/c67002b.ada
! 308d5f91802e93205222e8ca1f7def1e  gcc/testsuite/ada/acats/tests/c6/c67002c.ada
! 84e0adc30ed2874abaffa33f713cc51b  gcc/testsuite/ada/acats/tests/c6/c67002d.ada
! ddfdc630c5edd58e367ed9b034c039e7  gcc/testsuite/ada/acats/tests/c6/c67002e.ada
! 49b95c1cbdb6c703d2eba605f6f06c92  gcc/testsuite/ada/acats/tests/c6/c67003f.ada
! 213a9e52b5357a07997f1aa43ec82624  gcc/testsuite/ada/acats/tests/c6/c67005a.ada
! ddd7cdd9502a723b17b40bcb1df0e016  gcc/testsuite/ada/acats/tests/c6/c67005b.ada
! 20a99f6c582810cf18b39ab642f4024f  gcc/testsuite/ada/acats/tests/c6/c67005c.ada
! 8ea8c4445f5e72cc88e8dad14b66084e  gcc/testsuite/ada/acats/tests/c6/c67005d.ada
! 69f93d5f57d1b7956ae380ff9f3e5f77  gcc/testsuite/ada/acats/tests/c7/c72001b.ada
! b6fa12bd9fd0f617b4eeded7550722c2  gcc/testsuite/ada/acats/tests/c7/c72002a.ada
! c70f104ca78b3298a442973676af108a  gcc/testsuite/ada/acats/tests/c7/c730001.a
! 7d2edfee282ba04ca7f25bef0f101057  gcc/testsuite/ada/acats/tests/c7/c730002.a
! 7822b69c5c1de14250eaad43da14736b  gcc/testsuite/ada/acats/tests/c7/c730003.a
! ced40d2c1dbfd9c72c43feedd4c9cefc  gcc/testsuite/ada/acats/tests/c7/c730004.a
! d3f7b50b0820bac4ce78abffb5e37744  gcc/testsuite/ada/acats/tests/c7/c73002a.ada
! c70763cb0718b44fa8658ee9ebb8c726  gcc/testsuite/ada/acats/tests/c7/c730a01.a
! 4ecce7babf24585f115e0d288f17e449  gcc/testsuite/ada/acats/tests/c7/c730a02.a
! 9c311ffdc62d1b99a3452b1e38d15e2e  gcc/testsuite/ada/acats/tests/c7/c731001.a
! be09078047844bd86eef86d5755ef273  gcc/testsuite/ada/acats/tests/c7/c74004a.ada
! a0a0a05e6225a07b7bd0f2c049f1dc37  gcc/testsuite/ada/acats/tests/c7/c74203a.ada
! a718857277037741ea3600c1aab95a3d  gcc/testsuite/ada/acats/tests/c7/c74206a.ada
! 0efca36cdb74fc57aec9e1de78e0324f  gcc/testsuite/ada/acats/tests/c7/c74207b.ada
! 7ceb0d1778d1a1bae9687bebd7aad9e3  gcc/testsuite/ada/acats/tests/c7/c74208a.ada
! bf7859fde348fa96735368f14e0a3e25  gcc/testsuite/ada/acats/tests/c7/c74208b.ada
! 7d504e824db220a636160024b4e963d6  gcc/testsuite/ada/acats/tests/c7/c74209a.ada
! 3f31b8eb73e78f20cdcf118aa7d0047c  gcc/testsuite/ada/acats/tests/c7/c74210a.ada
! 442ab4135e3f1fdfffacf000f7b4bda3  gcc/testsuite/ada/acats/tests/c7/c74211a.ada
! 49650c69957d01ffb396db79a35589c4  gcc/testsuite/ada/acats/tests/c7/c74211b.ada
! 30155693ce7b3f29189da859d313eb7d  gcc/testsuite/ada/acats/tests/c7/c74302a.ada
! ed96f028ca11af40b3ba2093a404f55c  gcc/testsuite/ada/acats/tests/c7/c74302b.ada
! b559e9bf4e98700fb810e406c30a34b7  gcc/testsuite/ada/acats/tests/c7/c74305a.ada
! f1b9307b4d428cf0d10bc48805ffb0f3  gcc/testsuite/ada/acats/tests/c7/c74305b.ada
! 5c799bf9e1ec30f40d428bd8dadcb119  gcc/testsuite/ada/acats/tests/c7/c74306a.ada
! d62a4df3fab829d5694cbf9f5cc4cb8e  gcc/testsuite/ada/acats/tests/c7/c74307a.ada
! 933ca49dcfb9ad8fc25ea9a434984d05  gcc/testsuite/ada/acats/tests/c7/c74401d.ada
! 502d8871fd7e5d6399f7536874735597  gcc/testsuite/ada/acats/tests/c7/c74401e.ada
! 2514504f60fcea97d8914fabcb5654cf  gcc/testsuite/ada/acats/tests/c7/c74401k.ada
! 3ca8e77b02dbd7f9e9104dd0fa6de35b  gcc/testsuite/ada/acats/tests/c7/c74401q.ada
! d30f33bfdaf9612ea55c7659c3b5aeb6  gcc/testsuite/ada/acats/tests/c7/c74402a.ada
! cf79bb4fcbdf7ec1cd795607eef8bc10  gcc/testsuite/ada/acats/tests/c7/c74402b.ada
! f6ece8469b7d90aef496ac665f895003  gcc/testsuite/ada/acats/tests/c7/c74406a.ada
! cce5e695d18f537ec2a8d6c26cfc5b0d  gcc/testsuite/ada/acats/tests/c7/c74407b.ada
! 316be518a848dd0954d80de977e40c5b  gcc/testsuite/ada/acats/tests/c7/c74409b.ada
! c751f318a2fe16dadb0c62221c726b70  gcc/testsuite/ada/acats/tests/c7/c760001.a
! f250c0eea5cbe1e05ed28f0a940949ed  gcc/testsuite/ada/acats/tests/c7/c760002.a
! c12d4d7698c111ee3a094c0c2d53522a  gcc/testsuite/ada/acats/tests/c7/c760007.a
! 767d3e26a992541aa6191923e040a107  gcc/testsuite/ada/acats/tests/c7/c760009.a
! 264f06f0190602b655e5f7fefb6822b8  gcc/testsuite/ada/acats/tests/c7/c760010.a
! 31eaca7f3a33de78c9eaa1a92109c6ad  gcc/testsuite/ada/acats/tests/c7/c760011.a
! 522805071c7c096b6eabcd72cf833d9a  gcc/testsuite/ada/acats/tests/c7/c760012.a
! a4f8e8b6876d4b862928b00edca5f5d9  gcc/testsuite/ada/acats/tests/c7/c760013.a
! 45d67d0e3319e953b892c7d115460ecd  gcc/testsuite/ada/acats/tests/c7/c761001.a
! 080dcc3c8d2907579e1673c23433165f  gcc/testsuite/ada/acats/tests/c7/c761002.a
! d0ecfbaed2a882166d23beefe5f4e191  gcc/testsuite/ada/acats/tests/c7/c761003.a
! 553e4393e53175606097eb8c9b415d22  gcc/testsuite/ada/acats/tests/c7/c761004.a
! 4a7c5e1c13695ae75ad3a4df49a55b63  gcc/testsuite/ada/acats/tests/c7/c761005.a
! d4f8faae1d5f7970e56d7a30c10a99c7  gcc/testsuite/ada/acats/tests/c7/c761006.a
! a8b974a47ec1f7a4a5fc2ef06975f069  gcc/testsuite/ada/acats/tests/c7/c761007.a
! 6ca84026fc9a5682d2db1f346eb920cd  gcc/testsuite/ada/acats/tests/c7/c761010.a
! 8f26af4ffb9bc7a2e15aee7b1c0c2346  gcc/testsuite/ada/acats/tests/c7/c761011.a
! d80406039e2bebf54191eec198c10721  gcc/testsuite/ada/acats/tests/c7/c761012.a
! f7baee35e01e625d64802c987ddc4c0d  gcc/testsuite/ada/acats/tests/c8/c83007a.ada
! 9f1228dfaacf209725a2e8d706128a4c  gcc/testsuite/ada/acats/tests/c8/c83012d.ada
! a2e774207100bd5fbb0289bb8ba9f031  gcc/testsuite/ada/acats/tests/c8/c83022a.ada
! c214085c4cbff44807225c3aee9be7db  gcc/testsuite/ada/acats/tests/c8/c83022g0.ada
! 7aeac4b952eedc1419039fc50c66c732  gcc/testsuite/ada/acats/tests/c8/c83022g1.ada
! fedc05f63c2cd512653891054d7d5dad  gcc/testsuite/ada/acats/tests/c8/c83023a.ada
! 94cc28ec1a7a9d2aedbab6f2101d2215  gcc/testsuite/ada/acats/tests/c8/c83024a.ada
! cd79a99f6b5ce8030462ce917a77a33c  gcc/testsuite/ada/acats/tests/c8/c83024e0.ada
! b03af2deceb02b0227f887041379f641  gcc/testsuite/ada/acats/tests/c8/c83024e1.ada
! d7544d2786bfc552a30612041df95429  gcc/testsuite/ada/acats/tests/c8/c83025a.ada
! 881d6130cfcbd30f4a739889d50396da  gcc/testsuite/ada/acats/tests/c8/c83025c.ada
! f35a334aaf4110ea4446247ad6a098f4  gcc/testsuite/ada/acats/tests/c8/c83027a.ada
! 37c08965e5d871d3a35ff35f67e713d8  gcc/testsuite/ada/acats/tests/c8/c83027c.ada
! 32c440ad7d9ac139bbd4251c4fc10cc4  gcc/testsuite/ada/acats/tests/c8/c83028a.ada
! 284725a771243ec2eb877c3bb20240af  gcc/testsuite/ada/acats/tests/c8/c83029a.ada
! 0d4d1e41b05e2587d04c09930491aecd  gcc/testsuite/ada/acats/tests/c8/c83030a.ada
! 736b92fd2fdec116e1e9a28e04fe105a  gcc/testsuite/ada/acats/tests/c8/c83030c.ada
! 8e7b338ab4662f4c219903b9017a3252  gcc/testsuite/ada/acats/tests/c8/c83031a.ada
! 8799fc3b7ae4481b9d03ab137000f62e  gcc/testsuite/ada/acats/tests/c8/c83031c.ada
! 4c6a471797dc4320ecdae183b931f1e8  gcc/testsuite/ada/acats/tests/c8/c83031e.ada
! a6758128580028e639e0a59521425cf0  gcc/testsuite/ada/acats/tests/c8/c83032a.ada
! 72628676c750edbd1f98131cb5571a2f  gcc/testsuite/ada/acats/tests/c8/c83033a.ada
! 9431427fb4aa9f6e7d3a4375ffaecc6c  gcc/testsuite/ada/acats/tests/c8/c83051a.ada
! f2fa97381bbbbba9176ccf7627ee5fd8  gcc/testsuite/ada/acats/tests/c8/c83b02a.ada
! 03bdf2b2546804982387b339182818e7  gcc/testsuite/ada/acats/tests/c8/c83b02b.ada
! 40875d29e98f8a554f57a2cbba7d7b3e  gcc/testsuite/ada/acats/tests/c8/c83e02a.ada
! 14cf40af4f9b58380697256b2d355287  gcc/testsuite/ada/acats/tests/c8/c83e02b.ada
! 200ef6a026cfe27a93be29d96cf214b8  gcc/testsuite/ada/acats/tests/c8/c83e03a.ada
! ad5525a2d740a4d893fcd637c63649fd  gcc/testsuite/ada/acats/tests/c8/c83f01a.ada
! e565198c8053dc81f1f530025b0d226b  gcc/testsuite/ada/acats/tests/c8/c83f01b.ada
! 6d7321886000c19fde08f583e57a7e33  gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada
! b0f89c8df04b680d3d4603f896b4d648  gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada
! faebab8928acaa2b8fbf803db9d9d76e  gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada
! 76e6504b3bae53ff3ed9396d5c7812a4  gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada
! 64bf8f6ff542539524d925d1e5a9cfe4  gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada
! 8a46931f49572809caa7fa3dacf72336  gcc/testsuite/ada/acats/tests/c8/c83f03a.ada
! 12f92031807ee7b6703ecca17d07c9ad  gcc/testsuite/ada/acats/tests/c8/c83f03b.ada
! 2f7e657595b99ed4902cb3ed7aae770f  gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada
! b07043910b1b62a4647fb0958270ab2e  gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada
! 2a8ed5812b7eba602e55bc4cba957511  gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada
! d29900c193533f0d919bf89d2bc8e119  gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada
! a81483935d1a82f02d88010465d1f944  gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada
! 29bd80df35d00ef1384ad39409db64f6  gcc/testsuite/ada/acats/tests/c8/c840001.a
! af9ade351c5ef6a9d951a20d59988380  gcc/testsuite/ada/acats/tests/c8/c84002a.ada
! 66d1e4c5ecfdc60f73f72122f13591ac  gcc/testsuite/ada/acats/tests/c8/c84005a.ada
! aa6a6f80ff85e69f2df4df4eede3b31f  gcc/testsuite/ada/acats/tests/c8/c84008a.ada
! 09c80b3d29e25029f03088427d21bbcc  gcc/testsuite/ada/acats/tests/c8/c84009a.ada
! d7b3488b66a68bdb7c8d505ca3419ac7  gcc/testsuite/ada/acats/tests/c8/c85004b.ada
! 3e0403d2aa151370c2f61352a9f76996  gcc/testsuite/ada/acats/tests/c8/c85005a.ada
! 37c7fd0ed7d0bc32d740e9c53a118651  gcc/testsuite/ada/acats/tests/c8/c85005b.ada
! 1fc662c5706ae3323d79577161aa2b7c  gcc/testsuite/ada/acats/tests/c8/c85005c.ada
! c7c4cd7450d2b2ce6c9f804ab189b71e  gcc/testsuite/ada/acats/tests/c8/c85005d.ada
! 39a019807c800fea7de5ee674f51f3ac  gcc/testsuite/ada/acats/tests/c8/c85005e.ada
! 8d1e127599b478a2675315047b0c481f  gcc/testsuite/ada/acats/tests/c8/c85005f.ada
! 25bfcee3ce65c19279f2e6ae6c7dbfba  gcc/testsuite/ada/acats/tests/c8/c85005g.ada
! 32fef31a23447e83e62b591ccf214749  gcc/testsuite/ada/acats/tests/c8/c85006a.ada
! 52a38ccdb969e742c721e8c6b91f9aee  gcc/testsuite/ada/acats/tests/c8/c85006b.ada
! b8b2355c13723ce1e608404a697d37f1  gcc/testsuite/ada/acats/tests/c8/c85006c.ada
! f9f754296bb969ded99acf18e0d0cc57  gcc/testsuite/ada/acats/tests/c8/c85006d.ada
! 13a5f5c38fb9c62ade83208e0c68d79e  gcc/testsuite/ada/acats/tests/c8/c85006e.ada
! 338359196a7f9ec95687b438473fe4b5  gcc/testsuite/ada/acats/tests/c8/c85006f.ada
! 2009399861eb5a59e17598709aab1ac2  gcc/testsuite/ada/acats/tests/c8/c85006g.ada
! 81de8bcdf2627a437c3e3b841e5fad1d  gcc/testsuite/ada/acats/tests/c8/c85007a.ada
! e357cc223f207047a721ac8e8e18f162  gcc/testsuite/ada/acats/tests/c8/c85007e.ada
! 418333040a3a7bff04eadeddd0acb110  gcc/testsuite/ada/acats/tests/c8/c85009a.ada
! bd6854facde59a298fdff160083dd037  gcc/testsuite/ada/acats/tests/c8/c85011a.ada
! 406a5955e9d949bdd8248e3006f85389  gcc/testsuite/ada/acats/tests/c8/c85013a.ada
! 85235f6d4b44c3da298beab51c59e532  gcc/testsuite/ada/acats/tests/c8/c85014a.ada
! 63d0b09e17f02992f14dc03cc7687879  gcc/testsuite/ada/acats/tests/c8/c85014b.ada
! 8a941d41b729176aeb087812bd185dbb  gcc/testsuite/ada/acats/tests/c8/c85014c.ada
! e1660d68b127c37ec14d42ba45a3b445  gcc/testsuite/ada/acats/tests/c8/c85017a.ada
! 1cad26f34f7ad9a5f58bf9e88765aca9  gcc/testsuite/ada/acats/tests/c8/c85018a.ada
! 9c45b00830d440af2ac60b55d681400a  gcc/testsuite/ada/acats/tests/c8/c85018b.ada
! 8d0a794043808c838cf5adba232cacac  gcc/testsuite/ada/acats/tests/c8/c85019a.ada
! 9b74243be116d7855c67ebe955d78830  gcc/testsuite/ada/acats/tests/c8/c854001.a
! 825c879ca9c376275c17511ad5e00304  gcc/testsuite/ada/acats/tests/c8/c854002.a
! d68292de38c7b9e049e07075bbb8e3be  gcc/testsuite/ada/acats/tests/c8/c854003.a
! 1f1f18804e6fcf9c4e2fbec6349d04b2  gcc/testsuite/ada/acats/tests/c8/c86003a.ada
! e2f34ff3aa901cdf44aa714bfc307b17  gcc/testsuite/ada/acats/tests/c8/c86004a.ada
! d4f2cc5c80e276eb1480de6a342d8b63  gcc/testsuite/ada/acats/tests/c8/c86004b0.ada
! 50f93d108a0bf0919eb0ba1f6e65d7f0  gcc/testsuite/ada/acats/tests/c8/c86004b1.ada
! 6c2d0d9c9429d88e2c6672c71366873c  gcc/testsuite/ada/acats/tests/c8/c86004b2.ada
! 7f6e918b2ef0b5adc4139d9b912bc081  gcc/testsuite/ada/acats/tests/c8/c86004c0.ada
! a2305c116ad2dac3912371b71c441b61  gcc/testsuite/ada/acats/tests/c8/c86004c1.ada
! c7b7606151d38f39564979699b168c79  gcc/testsuite/ada/acats/tests/c8/c86004c2.ada
! 0766251158ffbc052bc7ec6041412761  gcc/testsuite/ada/acats/tests/c8/c86006i.ada
! 69ab336267b976906702c2d0bc1c1e29  gcc/testsuite/ada/acats/tests/c8/c86007a.ada
! 0ac058a1ece69aa243cd82dada40bb30  gcc/testsuite/ada/acats/tests/c8/c87a05a.ada
! fff71eeb0c0e9f16ee678756ea7588a4  gcc/testsuite/ada/acats/tests/c8/c87a05b.ada
! 2fe0ea4d16046c334c399aafeddc01a8  gcc/testsuite/ada/acats/tests/c8/c87b02a.ada
! fcd21b497cf853422b084ed7935381d4  gcc/testsuite/ada/acats/tests/c8/c87b02b.ada
! c0b66a348c2ee10edc5467a8eb009d09  gcc/testsuite/ada/acats/tests/c8/c87b03a.ada
! adac4007a7fd6b1ee9f1f48c55244d47  gcc/testsuite/ada/acats/tests/c8/c87b04a.ada
! 18ccfb1a0d973da4e1686b0c98dfa1a9  gcc/testsuite/ada/acats/tests/c8/c87b04b.ada
! 43cf46342879eb1ffe2f7c8971af6a38  gcc/testsuite/ada/acats/tests/c8/c87b04c.ada
! d0144de0520c60120721d7b571e3985d  gcc/testsuite/ada/acats/tests/c8/c87b05a.ada
! 2b781472cd1369f9eb86a64cd5e4a9d9  gcc/testsuite/ada/acats/tests/c8/c87b06a.ada
! c22a9ce42feb05505f797ccc539112bd  gcc/testsuite/ada/acats/tests/c8/c87b07a.ada
! 5cb748b4c292f38beadd4b397c9748ef  gcc/testsuite/ada/acats/tests/c8/c87b07b.ada
! cd570d3799a0f4ceeabe1513e0c1c809  gcc/testsuite/ada/acats/tests/c8/c87b07c.ada
! 94b970485847bd2d888e33a9e0bbeb1c  gcc/testsuite/ada/acats/tests/c8/c87b07d.ada
! 4a11dd4cf1ef59a68c9760ade0024c31  gcc/testsuite/ada/acats/tests/c8/c87b07e.ada
! e031b7e0f562bef1da7d73abf8e7203d  gcc/testsuite/ada/acats/tests/c8/c87b08a.ada
! ddc6096fff2cbf60aa3fe948c1c569c3  gcc/testsuite/ada/acats/tests/c8/c87b09a.ada
! 427f1fe54f5946c6611f5abe3d23e213  gcc/testsuite/ada/acats/tests/c8/c87b09c.ada
! 4f2d8b50e737f09ccf25f199443471c8  gcc/testsuite/ada/acats/tests/c8/c87b10a.ada
! b3ddde623ffa0748cae187472ed3c706  gcc/testsuite/ada/acats/tests/c8/c87b11a.ada
! 34f04500698b844ee3bbe19fcec6df7b  gcc/testsuite/ada/acats/tests/c8/c87b11b.ada
! 42486daf86c543499fe18e7700c2a2c5  gcc/testsuite/ada/acats/tests/c8/c87b13a.ada
! 343104f8b07cc3cdfea584fb91d7dad0  gcc/testsuite/ada/acats/tests/c8/c87b14a.ada
! 3129f63056e924075c9eef5fb92ff6be  gcc/testsuite/ada/acats/tests/c8/c87b14b.ada
! 9fec6d81e8cfe9a1be8263f1fcff0c24  gcc/testsuite/ada/acats/tests/c8/c87b14c.ada
! c9a24774d85aaa6a9ad204d88ef33dc3  gcc/testsuite/ada/acats/tests/c8/c87b14d.ada
! 75444b8bc412150144d6500a1c98caa1  gcc/testsuite/ada/acats/tests/c8/c87b15a.ada
! b02c9f3d290904a7b941ba27ad5b8cbe  gcc/testsuite/ada/acats/tests/c8/c87b16a.ada
! 352fe9e9dcbad212440a7cb09e0f5a22  gcc/testsuite/ada/acats/tests/c8/c87b17a.ada
! da9c835dde5437b7c6fd41430e0523c7  gcc/testsuite/ada/acats/tests/c8/c87b18a.ada
! 6233d050a9dc22ef89142ebf8f28ccf0  gcc/testsuite/ada/acats/tests/c8/c87b18b.ada
! 8d538ac45635004402030cb4640caa57  gcc/testsuite/ada/acats/tests/c8/c87b19a.ada
! 2095765cd4def145a48bc901ac6dbde1  gcc/testsuite/ada/acats/tests/c8/c87b23a.ada
! 67d87906e113b008e98391cc2776a960  gcc/testsuite/ada/acats/tests/c8/c87b24a.ada
! fd73894f92a9b3a013e87ea2b44c1ee4  gcc/testsuite/ada/acats/tests/c8/c87b24b.ada
! ae8732c293e965d19215928ca5c16d40  gcc/testsuite/ada/acats/tests/c8/c87b26b.ada
! b14d1be798ca4f79c28b996d1e8a7113  gcc/testsuite/ada/acats/tests/c8/c87b27a.ada
! 52b1e1223a0044bd348db0fcb6d79d6b  gcc/testsuite/ada/acats/tests/c8/c87b28a.ada
! a6a5c9403ac6bdbdb2e55d6a25b9f5ed  gcc/testsuite/ada/acats/tests/c8/c87b29a.ada
! b151ba31fb04091b8702bb9da4a0a2fb  gcc/testsuite/ada/acats/tests/c8/c87b30a.ada
! baa7d485e6d766db9246c9606ba3a078  gcc/testsuite/ada/acats/tests/c8/c87b31a.ada
! 78fd2d4c2c4821cfbbf402d3b842e2cc  gcc/testsuite/ada/acats/tests/c8/c87b32a.ada
! 833d7f92c1dba9641ebcb3157ab5d24e  gcc/testsuite/ada/acats/tests/c8/c87b33a.ada
! 36465d48d4bab661c6218ee48524b608  gcc/testsuite/ada/acats/tests/c8/c87b34a.ada
! 561be38a9a0275b65d22f782b23c1f8c  gcc/testsuite/ada/acats/tests/c8/c87b34b.ada
! 1239485e0f456d72c43f397227762788  gcc/testsuite/ada/acats/tests/c8/c87b34c.ada
! 041b7b6888183bbf71655055555c1b87  gcc/testsuite/ada/acats/tests/c8/c87b35c.ada
! ba86ee0565261018e59b1b01d9d63a78  gcc/testsuite/ada/acats/tests/c8/c87b38a.ada
! bee8f2cc8e7a407c5d1e665cafb324a0  gcc/testsuite/ada/acats/tests/c8/c87b39a.ada
! 0149e0004f1fac32a6d0483505f00a77  gcc/testsuite/ada/acats/tests/c8/c87b40a.ada
! 979e8597fe7349e04ef67ff5a9f249ad  gcc/testsuite/ada/acats/tests/c8/c87b41a.ada
! 35740da1bae3e32ad7726fef598ebe03  gcc/testsuite/ada/acats/tests/c8/c87b42a.ada
! c699f8cb33019178eb66bb9b9887fc34  gcc/testsuite/ada/acats/tests/c8/c87b43a.ada
! 284fc10b4e768deed27f6efe5ba660f3  gcc/testsuite/ada/acats/tests/c8/c87b44a.ada
! d1cacfe3528a0559f8572409bdad7960  gcc/testsuite/ada/acats/tests/c8/c87b45a.ada
! 615100562dae434f6237d50c2ce7a859  gcc/testsuite/ada/acats/tests/c8/c87b45c.ada
! ee9fa629414e1ff85ab5a901880627c6  gcc/testsuite/ada/acats/tests/c8/c87b47a.ada
! f01c1e9a040d9bf9e82d5b0bd8308ac2  gcc/testsuite/ada/acats/tests/c8/c87b48a.ada
! 5f12e71520b411de1dcbfb59ca609af5  gcc/testsuite/ada/acats/tests/c8/c87b48b.ada
! 7accae5d8bcb7a6376aeb4769bbc3521  gcc/testsuite/ada/acats/tests/c8/c87b50a.ada
! 49e93ad6fd90f250357c964cfe65bbb4  gcc/testsuite/ada/acats/tests/c8/c87b54a.ada
! 6b87b80aa7e4be221c3a6fcc95a098e2  gcc/testsuite/ada/acats/tests/c8/c87b57a.ada
! e29430c61d05400015468771710caebe  gcc/testsuite/ada/acats/tests/c8/c87b62a.ada
! d69bb1d50cac4c6397e7ef6ac85cec47  gcc/testsuite/ada/acats/tests/c8/c87b62b.ada
! b2cd3c65ecd1e96a0c0812252c334c48  gcc/testsuite/ada/acats/tests/c8/c87b62c.ada
! f48458b6ea766af192adb8d401f368fc  gcc/testsuite/ada/acats/tests/c8/c87b62d.tst
! 91802a6e8fc88eaea2b276279ef7c541  gcc/testsuite/ada/acats/tests/c9/c910001.a
! 92f4e59378989d90d762b2fdfa367275  gcc/testsuite/ada/acats/tests/c9/c910002.a
! 1da7e86ddeb55b8594570c708479d7da  gcc/testsuite/ada/acats/tests/c9/c910003.a
! 3e61dff323d06b22fad060cfc4e6bbe3  gcc/testsuite/ada/acats/tests/c9/c91004b.ada
! 69469a828c0050868f258475fc71f55d  gcc/testsuite/ada/acats/tests/c9/c91004c.ada
! 0ff6798e735543f9ea0902dcd3d33bd4  gcc/testsuite/ada/acats/tests/c9/c91006a.ada
! 7f1ab85728a76023b65305acb8480064  gcc/testsuite/ada/acats/tests/c9/c91007a.ada
! b04d09f1322f0d92c98d41398964503d  gcc/testsuite/ada/acats/tests/c9/c92002a.ada
! 5cb78880eadfd9eac647aba39fa528da  gcc/testsuite/ada/acats/tests/c9/c92003a.ada
! bfa0af83fa76f2092a243ddded4670d8  gcc/testsuite/ada/acats/tests/c9/c92005a.ada
! 379c27e94764b3b61fffdc4a6886f267  gcc/testsuite/ada/acats/tests/c9/c92005b.ada
! a47a031badac4df0d97db8bef1c3bc41  gcc/testsuite/ada/acats/tests/c9/c92006a.ada
! e4aee3e6761bfd67eaa5d1bd1ef57470  gcc/testsuite/ada/acats/tests/c9/c930001.a
! d21857231e61275a32c743ac514d1bc5  gcc/testsuite/ada/acats/tests/c9/c93001a.ada
! 493236f457ba46ba4fee16d542742d6c  gcc/testsuite/ada/acats/tests/c9/c93002a.ada
! 58f568faf270170c72b48115224a9ea8  gcc/testsuite/ada/acats/tests/c9/c93003a.ada
! 7612773970dfbe9066b04bb3ef16a233  gcc/testsuite/ada/acats/tests/c9/c93004a.ada
! ba12024ce449c8f19c903d5b83a7772c  gcc/testsuite/ada/acats/tests/c9/c93004b.ada
! 84f08b2297ca6e587b20b46ac2f4a739  gcc/testsuite/ada/acats/tests/c9/c93004c.ada
! e206bbe8f5a43a6b351e76ac75ac54bf  gcc/testsuite/ada/acats/tests/c9/c93004d.ada
! 00ac7aaad0308e432bf16c8682817a14  gcc/testsuite/ada/acats/tests/c9/c93004f.ada
! 08c88f164d59d4eab6aca557a4a64946  gcc/testsuite/ada/acats/tests/c9/c93005a.ada
! 8e317f80e3b0b4e3561b4aae157d6049  gcc/testsuite/ada/acats/tests/c9/c93005b.ada
! 7d334041be29ea9e8c37717a41e00262  gcc/testsuite/ada/acats/tests/c9/c93005c.ada
! 7eaab6600302226ca2aa221a1baa20b3  gcc/testsuite/ada/acats/tests/c9/c93005d.ada
! f8e495878721a71a7dbdd646b8e0a2f9  gcc/testsuite/ada/acats/tests/c9/c93005e.ada
! 0240c3a7deba6bd32679e222b5fadd86  gcc/testsuite/ada/acats/tests/c9/c93005f.ada
! c50d0176fa8ed0d5d6234013904fc2bf  gcc/testsuite/ada/acats/tests/c9/c93005g.ada
! 6a27b797bf6bf6201d7e22aec1399ef3  gcc/testsuite/ada/acats/tests/c9/c93005h.ada
! 9558fcb539a49a288534eb8b0dd23274  gcc/testsuite/ada/acats/tests/c9/c93006a.ada
! fe32d2d556faa4d361e61f9063f9d19b  gcc/testsuite/ada/acats/tests/c9/c93007a.ada
! e1f28c5786e15914c044ecc368a334c4  gcc/testsuite/ada/acats/tests/c9/c93008a.ada
! f12f826d928a3bc55974d9e4a7a4bced  gcc/testsuite/ada/acats/tests/c9/c93008b.ada
! 84c45a691f716f13c1acb83d5af7418d  gcc/testsuite/ada/acats/tests/c9/c940001.a
! 99f1785334b15c78f6c402eb9581f820  gcc/testsuite/ada/acats/tests/c9/c940002.a
! d4515a061510c374dc4e3b73047c01bd  gcc/testsuite/ada/acats/tests/c9/c940004.a
! 982944ab84b1e87938411f5e230c4afe  gcc/testsuite/ada/acats/tests/c9/c940005.a
! 24e534dd458f6d60deaffb89427151e3  gcc/testsuite/ada/acats/tests/c9/c940006.a
! ae39153ecdb5b40b7e250621dda2a947  gcc/testsuite/ada/acats/tests/c9/c940007.a
! ed93c06c8fbc77ffcb96431dac0e7567  gcc/testsuite/ada/acats/tests/c9/c940010.a
! b5f59a7bcad9207813e580204d7d297d  gcc/testsuite/ada/acats/tests/c9/c940011.a
! 2cc5af1321a3389a051ba331add4436e  gcc/testsuite/ada/acats/tests/c9/c940012.a
! 46c8ffa64ae0068a1674cd8386b42f41  gcc/testsuite/ada/acats/tests/c9/c940013.a
! 9fac2bc0e89e8f222104978b3d1eaf3b  gcc/testsuite/ada/acats/tests/c9/c940014.a
! 004d847da87db0a9fe57406d26459dfd  gcc/testsuite/ada/acats/tests/c9/c940015.a
! 47e9712a5187d745e5ab17e658f2f210  gcc/testsuite/ada/acats/tests/c9/c940016.a
! d6c7936f3b8d4c1d418f288e59676083  gcc/testsuite/ada/acats/tests/c9/c94001a.ada
! dbb8668731806fd13d24f9f4652011a1  gcc/testsuite/ada/acats/tests/c9/c94001b.ada
! 2a37c7d38240abcbac6ce81990a474e8  gcc/testsuite/ada/acats/tests/c9/c94001c.ada
! 5b89b2c47939e01428fda5cdb7b76bfc  gcc/testsuite/ada/acats/tests/c9/c94001e.ada
! 79b95e3bce431f5a1d5d5264c35ba5a9  gcc/testsuite/ada/acats/tests/c9/c94001f.ada
! 77a4dc124639ae407e5aca42c786703a  gcc/testsuite/ada/acats/tests/c9/c94001g.ada
! d99ad4e9eb32c130ce020dfc0891014e  gcc/testsuite/ada/acats/tests/c9/c94002a.ada
! ea931758bd0eaf85c1c1a04b2f7c71de  gcc/testsuite/ada/acats/tests/c9/c94002b.ada
! 131233ea081ac6ea10a1e10fbba005f2  gcc/testsuite/ada/acats/tests/c9/c94002d.ada
! 170256ffad705761ef2331d6d2a07771  gcc/testsuite/ada/acats/tests/c9/c94002e.ada
! 066f90e14b935717dde3fa4b96807563  gcc/testsuite/ada/acats/tests/c9/c94002f.ada
! 8a13ee6acd0d6f24e23333f06259df08  gcc/testsuite/ada/acats/tests/c9/c94002g.ada
! edbadeb0fe0aa698afbadafa8f3436bd  gcc/testsuite/ada/acats/tests/c9/c94004a.ada
! 1b81499cc92f2a4727604818b28d5028  gcc/testsuite/ada/acats/tests/c9/c94004b.ada
! 3a8b33e638dc0e28266a8e016eeec4fe  gcc/testsuite/ada/acats/tests/c9/c94004c.ada
! 2363fc8f9fa540996dd00c6b70dcb3fb  gcc/testsuite/ada/acats/tests/c9/c94005a.ada
! 25c866c01dd0b62ce66fb2d8912da8b6  gcc/testsuite/ada/acats/tests/c9/c94005b.ada
! 58ea156e98cc4536f068259cb7d392ce  gcc/testsuite/ada/acats/tests/c9/c94006a.ada
! 41842cea07ae1bf2ef7a3f649e4ae367  gcc/testsuite/ada/acats/tests/c9/c94007a.ada
! 0d97216a40757079eb2c5929715d2b99  gcc/testsuite/ada/acats/tests/c9/c94007b.ada
! 4c0be4d154afe78593220fcb4ce1db68  gcc/testsuite/ada/acats/tests/c9/c94008a.ada
! 96e113f41f41a01c2196b7773e735c4f  gcc/testsuite/ada/acats/tests/c9/c94008b.ada
! 17f5eb44b8190ee09e9f0ffcffe2e7a4  gcc/testsuite/ada/acats/tests/c9/c94008c.ada
! c810cc6ac3bebe36845e2cba4e525930  gcc/testsuite/ada/acats/tests/c9/c94008d.ada
! ee84f56d88a1ac003b078ea49001e5fa  gcc/testsuite/ada/acats/tests/c9/c94010a.ada
! 136872ec7f9870731797ab20b32f6696  gcc/testsuite/ada/acats/tests/c9/c94011a.ada
! a8508d1bdacc8da03549a92370d18ed0  gcc/testsuite/ada/acats/tests/c9/c94020a.ada
! 54dba96923cbd3444b91d1706e737c16  gcc/testsuite/ada/acats/tests/c9/c940a03.a
! 14ac629d930514b19edd9d5fa73cf107  gcc/testsuite/ada/acats/tests/c9/c95008a.ada
! b48683e2458942b3ffc46be9054c7911  gcc/testsuite/ada/acats/tests/c9/c95009a.ada
! b4adaad3668499bb335d018420c56f91  gcc/testsuite/ada/acats/tests/c9/c95010a.ada
! 2900d4b177d19e9f35c4693ea6b14ec8  gcc/testsuite/ada/acats/tests/c9/c95011a.ada
! 880dc25ba16839f531364b6a8427aab6  gcc/testsuite/ada/acats/tests/c9/c95012a.ada
! 701e89d7711a71b3be5269c5238a18c7  gcc/testsuite/ada/acats/tests/c9/c95021a.ada
! c091dcb9509e234377d2ac8ee75d10e0  gcc/testsuite/ada/acats/tests/c9/c95022a.ada
! 65035c12f67d253a2397d2126f4ba6c6  gcc/testsuite/ada/acats/tests/c9/c95022b.ada
! cc0f07ec1171a66007308281b576f7c4  gcc/testsuite/ada/acats/tests/c9/c95033a.ada
! 4de48cf31bf233b1fdc87aeffb9972de  gcc/testsuite/ada/acats/tests/c9/c95033b.ada
! cc9febfaeca52b7d6647ca62001797e7  gcc/testsuite/ada/acats/tests/c9/c95034a.ada
! d5302e6651eeb53974a9d013a4cdedc8  gcc/testsuite/ada/acats/tests/c9/c95034b.ada
! 60c5c5f334073dc4d79928f49152f582  gcc/testsuite/ada/acats/tests/c9/c95035a.ada
! 3eda3680c647ff3fb263637efebd9f65  gcc/testsuite/ada/acats/tests/c9/c95040a.ada
! 8e8e82ad5bdec76ed6e7c4ae88a3b54f  gcc/testsuite/ada/acats/tests/c9/c95040b.ada
! ed765b423843bd4ca78de15c1b071692  gcc/testsuite/ada/acats/tests/c9/c95040c.ada
! 30e738c92230ba86578f011623e5802a  gcc/testsuite/ada/acats/tests/c9/c95040d.ada
! 168221198b482975d09392b2fcad8a7b  gcc/testsuite/ada/acats/tests/c9/c95041a.ada
! c6313618d1cd8a8218dcd446fd95a86e  gcc/testsuite/ada/acats/tests/c9/c95065a.ada
! 8832636689a3eda560469f04cfa76418  gcc/testsuite/ada/acats/tests/c9/c95065b.ada
! 5aaadcb32b841fad9f31245493b516f6  gcc/testsuite/ada/acats/tests/c9/c95065c.ada
! a39b19410538e12fdfcb7cd54d120b3f  gcc/testsuite/ada/acats/tests/c9/c95065d.ada
! 383b7f01039162f8c331982cca1d1827  gcc/testsuite/ada/acats/tests/c9/c95065e.ada
! c184eac9dc26cf8493bcf20a949ae191  gcc/testsuite/ada/acats/tests/c9/c95065f.ada
! 5b0b09d3d393123f8092b9dd3d7d2634  gcc/testsuite/ada/acats/tests/c9/c95066a.ada
! 645546a6994e4d75b178f9fe0ead2ec8  gcc/testsuite/ada/acats/tests/c9/c95067a.ada
! 0d96b6a028d1fbdc1198cf477386cb10  gcc/testsuite/ada/acats/tests/c9/c95071a.ada
! 1252b71f747f12dc764f40b587be838a  gcc/testsuite/ada/acats/tests/c9/c95072a.ada
! bd5b6bb2bf3ba074df027795aaa7db33  gcc/testsuite/ada/acats/tests/c9/c95072b.ada
! befede1120f2f7955e0b77c883265e25  gcc/testsuite/ada/acats/tests/c9/c95073a.ada
! 48c97fe967f3c5e1bc663c5d91ed55bd  gcc/testsuite/ada/acats/tests/c9/c95074c.ada
! 6aaf0bf21901d478c7f10321b1c232fc  gcc/testsuite/ada/acats/tests/c9/c95076a.ada
! ba053d263ff25d0fe8b66c68cb7bb311  gcc/testsuite/ada/acats/tests/c9/c95078a.ada
! a7e9f0e064ac2a29ebe79a19983758dc  gcc/testsuite/ada/acats/tests/c9/c95080b.ada
! 73fa133c9eac6146a770bb5525331e35  gcc/testsuite/ada/acats/tests/c9/c95082g.ada
! 61f2b9320583cc5ff1eca06b3e8cd887  gcc/testsuite/ada/acats/tests/c9/c95085a.ada
! 9e1cf3433f8341a6b183079a377b0fad  gcc/testsuite/ada/acats/tests/c9/c95085b.ada
! e39dbe6050c2679aa6a7d89c762e8c0a  gcc/testsuite/ada/acats/tests/c9/c95085c.ada
! 6c946d9a6886fc8b7d6145f3958a1016  gcc/testsuite/ada/acats/tests/c9/c95085d.ada
! c8c26f8183027ac456df33b272a0e185  gcc/testsuite/ada/acats/tests/c9/c95085e.ada
! e29633617dcca72904423b7e09ea1401  gcc/testsuite/ada/acats/tests/c9/c95085f.ada
! 3e1d9c4d7627f1b32df23e0787f1ae30  gcc/testsuite/ada/acats/tests/c9/c95085g.ada
! 55b52211957a2231b59c295b91e1bbfe  gcc/testsuite/ada/acats/tests/c9/c95085h.ada
! f472998d938475a0a5b7c61c4a994dbe  gcc/testsuite/ada/acats/tests/c9/c95085i.ada
! e7d6c7d1e457a9097de27a4d4b6df67e  gcc/testsuite/ada/acats/tests/c9/c95085j.ada
! 9dcf6b0120351dbd31ca6b3b07007dda  gcc/testsuite/ada/acats/tests/c9/c95085k.ada
! f65f9568bbdcba31e56e46a1bff7a8a7  gcc/testsuite/ada/acats/tests/c9/c95085l.ada
! 2794ec3980004ff90d3fdda0ebeb57be  gcc/testsuite/ada/acats/tests/c9/c95085m.ada
! cd5e6789b1381a01c8abe9b8efc437eb  gcc/testsuite/ada/acats/tests/c9/c95085n.ada
! ec751b6898b7a50e0c7e413ac04f3096  gcc/testsuite/ada/acats/tests/c9/c95085o.ada
! 4d079ed4815a2d61d769f5571e546504  gcc/testsuite/ada/acats/tests/c9/c95086a.ada
! 3f5ba7557a56b3376b0d11a44977eb6b  gcc/testsuite/ada/acats/tests/c9/c95086b.ada
! 4423694080505c12206b273d44b25a6c  gcc/testsuite/ada/acats/tests/c9/c95086c.ada
! 9ddcd960179a50f19400614669ee58dd  gcc/testsuite/ada/acats/tests/c9/c95086d.ada
! b943966db2007cce0bd0ab55a7241cb6  gcc/testsuite/ada/acats/tests/c9/c95086e.ada
! 63af3fb63913a9ced35b10b55e03d16c  gcc/testsuite/ada/acats/tests/c9/c95086f.ada
! fb4e2598701ac2222961218c56e9989e  gcc/testsuite/ada/acats/tests/c9/c95087a.ada
! 6ca41778e752016a3cb5f39d3655160a  gcc/testsuite/ada/acats/tests/c9/c95087b.ada
! b77cd9cab875027ed13370d439f3d83a  gcc/testsuite/ada/acats/tests/c9/c95087c.ada
! 94c2f92c8d38ace856b3d3a4e46e2f10  gcc/testsuite/ada/acats/tests/c9/c95087d.ada
! 8ace111d2db71af514234c843bcdc774  gcc/testsuite/ada/acats/tests/c9/c95088a.ada
! 3eab89caa6cfdaad3ecaee2fb3a9de67  gcc/testsuite/ada/acats/tests/c9/c95089a.ada
! c23a0d393dfca230669443fa90939e9e  gcc/testsuite/ada/acats/tests/c9/c95090a.ada
! 2dea0b25d5837e3f040a606b74b5bfe7  gcc/testsuite/ada/acats/tests/c9/c95092a.ada
! da5b15c611f0e80c4bd500a6377cf1fb  gcc/testsuite/ada/acats/tests/c9/c95093a.ada
! 411e85f00716bde0eb4bebe2dd4a4b17  gcc/testsuite/ada/acats/tests/c9/c95095a.ada
! 20d01625fd521f83c0fbb4e0d5989f1c  gcc/testsuite/ada/acats/tests/c9/c95095b.ada
! f1a2d7fb3c08ba5c9b45d28b8c434cf9  gcc/testsuite/ada/acats/tests/c9/c95095c.ada
! fe6c832ec4b8584b35ad79ad6f658734  gcc/testsuite/ada/acats/tests/c9/c95095d.ada
! d71ab35932ba486e65cee5d0a7ea6c58  gcc/testsuite/ada/acats/tests/c9/c95095e.ada
! b665ab275e30b4a49c6a32d1c1b8d3b0  gcc/testsuite/ada/acats/tests/c9/c951001.a
! 31bba47fca22f334739b1cb13505c63f  gcc/testsuite/ada/acats/tests/c9/c951002.a
! 380eef904bedee70e470eec6283fe7fa  gcc/testsuite/ada/acats/tests/c9/c953001.a
! 8b4cbf1e111e939494dbd6c9170d9add  gcc/testsuite/ada/acats/tests/c9/c953002.a
! b85e67ebb144368e710912fad26fa9b5  gcc/testsuite/ada/acats/tests/c9/c953003.a
! 349793c14b6ee642849a35ac147f6d28  gcc/testsuite/ada/acats/tests/c9/c954001.a
! 32a2b22071eb90de620dac85832e7e33  gcc/testsuite/ada/acats/tests/c9/c954010.a
! 5c71f334e75e4b81847ba6609055a721  gcc/testsuite/ada/acats/tests/c9/c954011.a
! 0f6b02e34f34de574c7f90adcb78c1d3  gcc/testsuite/ada/acats/tests/c9/c954012.a
! 0af78b179cbaf289947a4b0cc90e1b92  gcc/testsuite/ada/acats/tests/c9/c954013.a
! 498084096b8ec59a36a889374ad9ee3e  gcc/testsuite/ada/acats/tests/c9/c954014.a
! 97799887dcbf60005b2df40f05636514  gcc/testsuite/ada/acats/tests/c9/c954015.a
! 2490fc80b69ada26f8142dacebcc5823  gcc/testsuite/ada/acats/tests/c9/c954016.a
! 23e5c9126dfc78e228cd9ba7e9fd2f4d  gcc/testsuite/ada/acats/tests/c9/c954017.a
! bdfa1b9ada52a8082dfc30a91d56af89  gcc/testsuite/ada/acats/tests/c9/c954018.a
! e039ba87aa8e5a87f7f74695cc19d917  gcc/testsuite/ada/acats/tests/c9/c954019.a
! 718a1dda410ad24ef00a024b2e415626  gcc/testsuite/ada/acats/tests/c9/c954020.a
! 8f5a7fd94fd12664cdd2a1cedfcad90c  gcc/testsuite/ada/acats/tests/c9/c954021.a
! 34dbbc567c8a72d4e43da4684357c65d  gcc/testsuite/ada/acats/tests/c9/c954022.a
! acd00fcab6e1b0d13797a97adc97adb7  gcc/testsuite/ada/acats/tests/c9/c954023.a
! 2b49282ca4813eb7610dffe2400f50ff  gcc/testsuite/ada/acats/tests/c9/c954024.a
! 2331b8760176763cf23ae6f18488082f  gcc/testsuite/ada/acats/tests/c9/c954025.a
! 6bd1092f468dab44c0887902809a3c13  gcc/testsuite/ada/acats/tests/c9/c954026.a
! 97487e5b93226e3c55df7449702ac3da  gcc/testsuite/ada/acats/tests/c9/c954a01.a
! d07c1374471df9299b8057f6479a45e6  gcc/testsuite/ada/acats/tests/c9/c954a02.a
! b1b9ce862c0b325027b8ea2d1d8cc916  gcc/testsuite/ada/acats/tests/c9/c954a03.a
! d02e3ef0eb5c7ba2f412817b49644270  gcc/testsuite/ada/acats/tests/c9/c960001.a
! da6bb14a212aa02754b6596d741c04b8  gcc/testsuite/ada/acats/tests/c9/c960002.a
! 4c5c6b7d7706870241781f97576eef1b  gcc/testsuite/ada/acats/tests/c9/c960004.a
! f703a55c27d27529f63150ba86c8e428  gcc/testsuite/ada/acats/tests/c9/c96001a.ada
! 3551216de1ec0430cae6be8fbba64031  gcc/testsuite/ada/acats/tests/c9/c96004a.ada
! 2f64957621aaee0d11d2f8171f4e6709  gcc/testsuite/ada/acats/tests/c9/c96005a.ada
! 7fad724f14640158cc9929364f0bb44f  gcc/testsuite/ada/acats/tests/c9/c96005b.tst
! 6e3aebd279f9456cefe6dc63b3b9331e  gcc/testsuite/ada/acats/tests/c9/c96005d.ada
! 48530b441ec07b282f87a1b285f46461  gcc/testsuite/ada/acats/tests/c9/c96005f.ada
! 4ea722032f17d484d0a99cb53bc930ac  gcc/testsuite/ada/acats/tests/c9/c96006a.ada
! 83d75c4aa3732428ebf8864a605ee0d4  gcc/testsuite/ada/acats/tests/c9/c96007a.ada
! 031bef964d04e0ec5db2ff1f13daa5c1  gcc/testsuite/ada/acats/tests/c9/c96008a.ada
! f1d6b97aec5c567380c522a41db1aba7  gcc/testsuite/ada/acats/tests/c9/c96008b.ada
! 9f6fd5618561fb30c4c3b3865512f084  gcc/testsuite/ada/acats/tests/c9/c97112a.ada
! 9a595e747efc52363c8c454c5697526c  gcc/testsuite/ada/acats/tests/c9/c97113a.ada
! 0a432c8f0bafafbfd3ca9e2c4c355355  gcc/testsuite/ada/acats/tests/c9/c97114a.ada
! f204e89327ed70fed4f01e37237ed370  gcc/testsuite/ada/acats/tests/c9/c97115a.ada
! ad10c842934da9fd10b075d2eda11b10  gcc/testsuite/ada/acats/tests/c9/c97116a.ada
! 4e1bee03164214d6b948f1c4d7727423  gcc/testsuite/ada/acats/tests/c9/c97117a.ada
! f316b207affd7df5674d718268b31bd7  gcc/testsuite/ada/acats/tests/c9/c97117b.ada
! c15c876df898d95befc462a0646f94e6  gcc/testsuite/ada/acats/tests/c9/c97117c.ada
! 06046e05a2477dc8986dff46f6adb19d  gcc/testsuite/ada/acats/tests/c9/c97118a.ada
! 713383a150292af0da0dc77e7a23ab4b  gcc/testsuite/ada/acats/tests/c9/c97120a.ada
! 1edcf8a00884d843f01295b66b3346ed  gcc/testsuite/ada/acats/tests/c9/c97120b.ada
! d6606fac2f86c01ef106a193d274ec96  gcc/testsuite/ada/acats/tests/c9/c97201a.ada
! 2be86a6c8f33794ef758dfb71bf75acd  gcc/testsuite/ada/acats/tests/c9/c97201b.ada
! 32743b2ed9403b69d98c56734934fa8f  gcc/testsuite/ada/acats/tests/c9/c97201c.ada
! 1feeeccbfc144d846a5fac5dc371b1ab  gcc/testsuite/ada/acats/tests/c9/c97201d.ada
! 4b003338cd3cfce9c7070dea4b8370a1  gcc/testsuite/ada/acats/tests/c9/c97201e.ada
! 383c30d1a9dc6fba56fb3b68b9d8417d  gcc/testsuite/ada/acats/tests/c9/c97201g.ada
! 2a874dccde240e48a4f9b0c6b5175219  gcc/testsuite/ada/acats/tests/c9/c97201h.ada
! a7aec17b036081fd245c141c14cea8c3  gcc/testsuite/ada/acats/tests/c9/c97201x.ada
! 8b04c9ca3ccf2bd719076369af023d12  gcc/testsuite/ada/acats/tests/c9/c97202a.ada
! 096a975a5320d43a7ba562f9f18d94e6  gcc/testsuite/ada/acats/tests/c9/c97203a.ada
! 4470e62031e7933d85cbc73da17fef70  gcc/testsuite/ada/acats/tests/c9/c97203b.ada
! 64b03c91289d25db071b852a88b5d9cb  gcc/testsuite/ada/acats/tests/c9/c97203c.ada
! ddc6cf33bc17eabf4869adcc1d29e3d0  gcc/testsuite/ada/acats/tests/c9/c97204a.ada
! d4911cea3ce93679f126d507a45d22fa  gcc/testsuite/ada/acats/tests/c9/c97204b.ada
! f112637a1de7d372487415fe7c563edd  gcc/testsuite/ada/acats/tests/c9/c97205a.ada
! 5532215767fea9cf0ff3d5a28af0ffbf  gcc/testsuite/ada/acats/tests/c9/c97205b.ada
! 01050a4da75368f4c45e1856db21fe08  gcc/testsuite/ada/acats/tests/c9/c97301a.ada
! 3bb292049b1010404ee847832e15f4fd  gcc/testsuite/ada/acats/tests/c9/c97301b.ada
! dc309970b8d1ee31a4ac51d708f59f23  gcc/testsuite/ada/acats/tests/c9/c97301c.ada
! 85087bd563a15cb83cb82906dd074b46  gcc/testsuite/ada/acats/tests/c9/c97301d.ada
! cf609a3a37b7091f993fde3ebec98b7b  gcc/testsuite/ada/acats/tests/c9/c97301e.ada
! fb0f6367a2cb242d11e68bb0833594c9  gcc/testsuite/ada/acats/tests/c9/c97302a.ada
! ee3941e300e101619899d4ce5e433914  gcc/testsuite/ada/acats/tests/c9/c97303a.ada
! 0c9b0b786acee85921087f08e05ee848  gcc/testsuite/ada/acats/tests/c9/c97303b.ada
! dca0cd362816588d4976d342beb2593d  gcc/testsuite/ada/acats/tests/c9/c97303c.ada
! cb2ab9f96734f02dcf13d24f2e73aec3  gcc/testsuite/ada/acats/tests/c9/c97304a.ada
! d754e67cb299985d2d7ab32f0d7831d4  gcc/testsuite/ada/acats/tests/c9/c97304b.ada
! 2f91d4b7e4df271c291c8528b0ac77c5  gcc/testsuite/ada/acats/tests/c9/c97305a.ada
! 99ee5abaa01d4f88e63554c6c77981a8  gcc/testsuite/ada/acats/tests/c9/c97305b.ada
! 5a1e95417e5dc56ea2eaa24f2cb98647  gcc/testsuite/ada/acats/tests/c9/c97305c.ada
! fa76b14386e1262d53b830ca97f97d45  gcc/testsuite/ada/acats/tests/c9/c97305d.ada
! 6fc73ebaa144622a8c55a755858c8214  gcc/testsuite/ada/acats/tests/c9/c97307a.ada
! 3159a203f1d3e85954c526f58a3919f1  gcc/testsuite/ada/acats/tests/c9/c974001.a
! 0314ba23ab70ea268178d5697c5a9034  gcc/testsuite/ada/acats/tests/c9/c974002.a
! f748892726b6f9f427e087ed38edff1e  gcc/testsuite/ada/acats/tests/c9/c974003.a
! 68b75700dc10aa1f753b947e8cfc83f7  gcc/testsuite/ada/acats/tests/c9/c974004.a
! c9f29dff7d0c7abcfdc4dd10f92cc818  gcc/testsuite/ada/acats/tests/c9/c974005.a
! 58bc14008a240c1458d789aea37231f5  gcc/testsuite/ada/acats/tests/c9/c974006.a
! 6386f90159d93f8e888fc5c7606c48ab  gcc/testsuite/ada/acats/tests/c9/c974007.a
! 091b77c15a7a69901928f3e08e5d560b  gcc/testsuite/ada/acats/tests/c9/c974008.a
! 4286211e8302b327c6fcddd998068801  gcc/testsuite/ada/acats/tests/c9/c974009.a
! 91418d184ffd74f3511f7c7fecf5ad4c  gcc/testsuite/ada/acats/tests/c9/c974010.a
! fb71769796ae10266d6396de27fcd9f3  gcc/testsuite/ada/acats/tests/c9/c974011.a
! 75ae944a2f56bfec34a43bcac81f0f6a  gcc/testsuite/ada/acats/tests/c9/c974012.a
! cf3493d33888a126779c4a1fd8c7e171  gcc/testsuite/ada/acats/tests/c9/c974013.a
! 0100f02b896d741021d8771778c05fe4  gcc/testsuite/ada/acats/tests/c9/c974014.a
! 120dd4802d990998dbefafba1d6bdf05  gcc/testsuite/ada/acats/tests/c9/c980001.a
! 98a89250f238d2d958192b464be9c644  gcc/testsuite/ada/acats/tests/c9/c980002.a
! 387e8d4bc42079cf88da235a35d5db46  gcc/testsuite/ada/acats/tests/c9/c980003.a
! 8c9e7662d2c57ef91bde2dbdd2ceaade  gcc/testsuite/ada/acats/tests/c9/c99004a.ada
! 4a6308ea54645ac0a0ff6750ddff3bee  gcc/testsuite/ada/acats/tests/c9/c99005a.ada
! 0ade252d597ba9f5685bfdbc39ad5126  gcc/testsuite/ada/acats/tests/c9/c9a003a.ada
! f6efef2daeceae0601810ea34d294ebe  gcc/testsuite/ada/acats/tests/c9/c9a004a.ada
! dd8112b4d2ad70bb900170e976687d24  gcc/testsuite/ada/acats/tests/c9/c9a007a.ada
! d7d23b9be56f63a7a3eb64ae5740a50f  gcc/testsuite/ada/acats/tests/c9/c9a009a.ada
! 4a79ec0aad1fb7e6af0cb13c26c8a078  gcc/testsuite/ada/acats/tests/c9/c9a009c.ada
! a6fedb4d1bd7420511136db146b4479f  gcc/testsuite/ada/acats/tests/c9/c9a009f.ada
! 92177b39404bc5c23481f443eee705e0  gcc/testsuite/ada/acats/tests/c9/c9a009g.ada
! 56b8d40db1bb38ab15ba53a518a8e8e3  gcc/testsuite/ada/acats/tests/c9/c9a009h.ada
! 378ed54deee6ae14733d353d1d034e4e  gcc/testsuite/ada/acats/tests/c9/c9a010a.ada
! 7e86b851f4df1a5b809ec8656042b7f1  gcc/testsuite/ada/acats/tests/c9/c9a011a.ada
! 15b92866c3feb68befd87bd433944eee  gcc/testsuite/ada/acats/tests/c9/c9a011b.ada
! 204dadfff9a19c758cd37f55b4c4da7c  gcc/testsuite/ada/acats/tests/ca/ca1003a.ada
! 763e67e5131cf453849af1119c81ab73  gcc/testsuite/ada/acats/tests/ca/ca1004a.ada
! 4dd6d7580352576ccd7263ab195d5863  gcc/testsuite/ada/acats/tests/ca/ca1005a.ada
! 129a313a5c15d69fc95b27e10654ea3b  gcc/testsuite/ada/acats/tests/ca/ca1006a.ada
! 150e449e50b6c5dbc1ef87fb7cbf4fb9  gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada
! 590b512fe8313d2c235285182f8eda0d  gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada
! 75907d5f95c902eae76627ab16c741b7  gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada
! 401ad7f509f398efd9094cfb553d02ca  gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada
! d6d2e55e299aae0f7b20781714e0f6d9  gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada
! e840ac05d90e7ef06dac4303f5747d0c  gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada
! 696cc4292fd590eaf3673d74b1c0c4f9  gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada
! 19ae39e48cdc2ea32ddbde00fdb0bf17  gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada
! c3bd20289c2b3b2422a8e051dfc8b100  gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada
! 010a8d3290ef3a0b00bcbe784544f65f  gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada
! 49dff1e5fe3bc3d0814772fe822732a9  gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada
! 3660d5d1740e1e424e76277266bd8268  gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada
! 2a073bfb3680a6d94b420c58b535dda1  gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada
! 1d0a019e12d9aec35762beffba68a14a  gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada
! 8fe092748b9f031c395eb8aa90296599  gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada
! 2ee859ea2c2cb8cd94e30b6c19c152f7  gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada
! a15e85ff9101c6b7debdc0a508f121b6  gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada
! 03baa6347b38eb86dabe6092928f99a3  gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada
! a81d2aa44c2ded0527dbc731919e9089  gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada
! baa2f985db9330503fee62fb421c3429  gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada
! 9fc93552ea16f09c4c827809b41b3281  gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada
! eb0f6d8e24d16363c032c027a7fb22d5  gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada
! b35c89f01ddf1fa22d017dd159aac614  gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada
! 5077be000dc1a7e1b7b61ca260535b47  gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada
! 0d51872b8ac47d25b56ce86661e1c370  gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada
! 29a9a130e24e0e0ced6be54af8af32af  gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada
! bda7cf51d24fabf05ab2eb537ba61e3b  gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada
! e875db44aa84c70db8ae5e21b37fd9f1  gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada
! 3f26efdf7d61547aec29a83c55db9b2c  gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada
! d41b12fbbd6a609065e3a66751a2bcfd  gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada
! 94d90f2a39051c6c6e6f143035815676  gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada
! 522a519bdf3184fbe9c278d90eaa0c51  gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada
! 457d2a59db3a3a962c68d076c3588ba2  gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada
! bead0060014fd3fff3245a6f20e1ce5d  gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada
! 7043e3690e3b44d0a6dcf5a6e896118c  gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada
! a84d185297f5e0df081a4d1c5691575a  gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada
! 3170507b82e5b87d289d4cc70305ba1c  gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada
! 43efb4507d79b8829492325770ec57e8  gcc/testsuite/ada/acats/tests/ca/ca11001.a
! ac29fbda8eadae439bcd450881bc7149  gcc/testsuite/ada/acats/tests/ca/ca11002.a
! b9954b4449d887004c58cdfadf86900e  gcc/testsuite/ada/acats/tests/ca/ca11003.a
! 5858be41247b333a8e43986902fba588  gcc/testsuite/ada/acats/tests/ca/ca110040.a
! a977e479cabfc8bfede672c52d423864  gcc/testsuite/ada/acats/tests/ca/ca110041.a
! a2118dee2a16348d232ec7617376dade  gcc/testsuite/ada/acats/tests/ca/ca110042.am
! 4a8c0c2b4dd227cfda4c20ad9ff07ace  gcc/testsuite/ada/acats/tests/ca/ca110050.a
! 0583459492312df56b1924ffe5b094bd  gcc/testsuite/ada/acats/tests/ca/ca110051.am
! bc46a97640375fa6c02bac82bd0ea9d4  gcc/testsuite/ada/acats/tests/ca/ca11006.a
! 7a57ba0892ae966f0111911781c328a7  gcc/testsuite/ada/acats/tests/ca/ca11007.a
! 72dc8d276317eabd399e4b72e562434b  gcc/testsuite/ada/acats/tests/ca/ca11008.a
! 33d1886825125a9ff16aafa1d4eeb8ce  gcc/testsuite/ada/acats/tests/ca/ca11009.a
! 6009d53581cd1fedaaa5f8df00bec83f  gcc/testsuite/ada/acats/tests/ca/ca11010.a
! 41dc04e344132ae2173153f802896e15  gcc/testsuite/ada/acats/tests/ca/ca11011.a
! d28dd7fd562acb52e90429450077885b  gcc/testsuite/ada/acats/tests/ca/ca11012.a
! 3b4e1d1303122a2165d7a89e5ca75ec0  gcc/testsuite/ada/acats/tests/ca/ca11013.a
! e80e120c9035b007bb06c2accccbc2b3  gcc/testsuite/ada/acats/tests/ca/ca11014.a
! 97408d6755af6eeab48fe47d27144c12  gcc/testsuite/ada/acats/tests/ca/ca11015.a
! 8b415d0e8ca6c7725a02853b184967b4  gcc/testsuite/ada/acats/tests/ca/ca11016.a
! 5b1b2a824041eeb6d0560a6e32d48287  gcc/testsuite/ada/acats/tests/ca/ca11017.a
! df67588f2af1ce9fe9abd12c930a475a  gcc/testsuite/ada/acats/tests/ca/ca11018.a
! d51c3aaeac91d325c8cea73a18210a18  gcc/testsuite/ada/acats/tests/ca/ca11019.a
! 1740b30abc976744100e38e3bcf58e99  gcc/testsuite/ada/acats/tests/ca/ca11020.a
! 3a6518f945e25a1aeb3ad194d1563dff  gcc/testsuite/ada/acats/tests/ca/ca11021.a
! 5af82e195906ba434bd96462dc39c4c1  gcc/testsuite/ada/acats/tests/ca/ca11022.a
! dccf8acb158b9eac07884aeacd894def  gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada
! 2ed4ef9cb779e0d0250f3094928e85b6  gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada
! d658c78d3feceb2e1e932fd6a6b84b5b  gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada
! 50c4e887be1e9c4b7922f1519eb6c980  gcc/testsuite/ada/acats/tests/ca/ca1106a.ada
! b777b7cb27b27b07d7781e4ffd98a4ac  gcc/testsuite/ada/acats/tests/ca/ca1108a.ada
! 2f0f9c93c1bcab591f855d52670c37f0  gcc/testsuite/ada/acats/tests/ca/ca1108b.ada
! d320add603a2cb7fa5b0b27eb3cf9f99  gcc/testsuite/ada/acats/tests/ca/ca11a01.a
! 564d10a7c04f96788c8960fbe51c939e  gcc/testsuite/ada/acats/tests/ca/ca11a02.a
! c5b8e3a142a8d1aaf458e85e143d2dff  gcc/testsuite/ada/acats/tests/ca/ca11b01.a
! 385324ae1a50700efcc3e91d33d38fa7  gcc/testsuite/ada/acats/tests/ca/ca11b02.a
! f3ab6e0bea1b83fcd4c3a152e700e0bc  gcc/testsuite/ada/acats/tests/ca/ca11c01.a
! 71af51028e9bdd5cbcd5d81ee9beb0b5  gcc/testsuite/ada/acats/tests/ca/ca11c02.a
! 623cecaae9f9690a91d838f3795828e4  gcc/testsuite/ada/acats/tests/ca/ca11c03.a
! d0d1001f9819954c3537dd82876810a2  gcc/testsuite/ada/acats/tests/ca/ca11d010.a
! 9f2dd49cf5ff9af1c2217e51b7065e52  gcc/testsuite/ada/acats/tests/ca/ca11d011.a
! df976f60528d7144894c0dec4d84bc15  gcc/testsuite/ada/acats/tests/ca/ca11d012.a
! 6caa9498e84d76bdc74f46ac12a1a5e2  gcc/testsuite/ada/acats/tests/ca/ca11d013.am
! 0e13dcf32c88dedfbae0b03875ea105d  gcc/testsuite/ada/acats/tests/ca/ca11d02.a
! 352a0f61cf20bb4dd3caf17335850840  gcc/testsuite/ada/acats/tests/ca/ca11d03.a
! 196ff89b7529ee2981f4ecc32c27a27f  gcc/testsuite/ada/acats/tests/ca/ca13001.a
! a30bb2c455fbe1c012213193058ea38a  gcc/testsuite/ada/acats/tests/ca/ca13002.a
! 259d9991bd14633e726a1465b3ce011f  gcc/testsuite/ada/acats/tests/ca/ca13003.a
! 4a04a3ea16a7b5f16f46083006b00231  gcc/testsuite/ada/acats/tests/ca/ca13a01.a
! ef93a0b4b9d9c30a5f19c2e9d20d6e84  gcc/testsuite/ada/acats/tests/ca/ca13a02.a
! 14642bbab92bb9a06637c81126196b6d  gcc/testsuite/ada/acats/tests/ca/ca140230.a
! db8f6b8a7c3fb7fc6f41665ca76898aa  gcc/testsuite/ada/acats/tests/ca/ca140231.a
! 2c51220694c3930837b65093969330e9  gcc/testsuite/ada/acats/tests/ca/ca140232.am
! 97cc025b6e8c23ed35706e0ff98d4305  gcc/testsuite/ada/acats/tests/ca/ca140233.a
! 6df92dded9f1b1b9927e74380e21b606  gcc/testsuite/ada/acats/tests/ca/ca140280.a
! 6d433407d31454677f59a9de849b9a8a  gcc/testsuite/ada/acats/tests/ca/ca140281.a
! c7d9485411a37bafb94c4d619229cf30  gcc/testsuite/ada/acats/tests/ca/ca140282.a
! 0382d20f38d7c210393543ff57720eee  gcc/testsuite/ada/acats/tests/ca/ca140283.am
! 3ddbeeafbf30ff3f598a354d6504380d  gcc/testsuite/ada/acats/tests/ca/ca15003.a
! 3a4f3b580416cb1f523e9f0ac2eae79d  gcc/testsuite/ada/acats/tests/ca/ca200020.a
! 0a900895683bd2063208a7e0ec0179eb  gcc/testsuite/ada/acats/tests/ca/ca200021.a
! 7ba1dcfca4bbc7dddaa33358007ad8be  gcc/testsuite/ada/acats/tests/ca/ca200022.am
! 89e55ace469231379417158d76cef966  gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada
! 4fcb3c9a010c482fd799920396bdff35  gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada
! 74283fc28ee649c49603986ce9271f9b  gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada
! 38f9b878948bab9e22743f449944e3e9  gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada
! 5b863537f3743728296719d32393b9c2  gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada
! bfbaab505e4866cb5784b784957c9a28  gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada
! 0915a28827cb6de231954ac4c117a867  gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada
! be28bd99026e48f3d74a229aea62f3d3  gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada
! bbd409da60934657820661962e6e865f  gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada
! e9823de02e5e243ffbc96966ad66f571  gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada
! 2a6a75cbeb635fa9b353f4456f15887a  gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada
! 9e55a07446b2c4b6f10c94a096696c64  gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada
! 95743db093f3de73eef851e06ace6ae5  gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada
! 9825991acff14d1e11e40a3568bb2e77  gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada
! 1ed6b70320b71de2337bd1e17625341d  gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada
! 2d33ec3a837a5a5e131936b8db94f4eb  gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada
! 40ec1534c1b7d0a29cd8b1199f0a5b64  gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada
! 25e21e36ad48e61821b87c24ac11bca6  gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada
! 084eafcf0c9bde63eb9b0c876f25f904  gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada
! c367605d05bd5ae5bf81c583e66e2720  gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada
! c06ae786d36e4922cea7b5ed9453c9f3  gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada
! e6666b45adcad1b99635211e793ed244  gcc/testsuite/ada/acats/tests/ca/ca2009a.ada
! 091802695ed73e62107b4d4d28c4fa67  gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada
! d4908bcb77941027c20a57e38b3354df  gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada
! 8793e38b06624960b964675c87a7bb50  gcc/testsuite/ada/acats/tests/ca/ca2009d.ada
! ebd60829cd41edbd06d5d34b1c55ad14  gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada
! 84847d496c3551158605ff4d635fd1d6  gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada
! 1b68aafa35a5844624d091cb512b83a3  gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada
! 82a3883dad29bf7e9b2b43d245e96819  gcc/testsuite/ada/acats/tests/ca/ca2011b.ada
! a2806b84bcf970945201d14057ba77fb  gcc/testsuite/ada/acats/tests/ca/ca21001.a
! 9b176edf2b085f407ab53c6e7efa0bf0  gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada
! a4e05800840beaa80583438f2fe8754d  gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada
! c86a5bb82c1bade39f6d9d230f8c9e8e  gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada
! dc43067ded3ab1437027708d7812aadb  gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada
! b4bbe2bad37830cb59bac3673786910c  gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada
! c29e663763861d160ff3432b1e522015  gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada
! e5dcfd787f24d6dfedf73b0e116e1352  gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada
! 248734cc36c6828c5b5d0a7c1293df27  gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada
! 5497b59108e98e726b8af5fae575c343  gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada
! 3ca92f928c3fab5699f3ed1cbb10cca7  gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada
! 15800c833dc097d881eb01771f2ddb56  gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada
! 42a60fa8194ce3db5c65b6814ea59f15  gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada
! 0402a0137d3537a7d4ae11fe9268e188  gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada
! 56d17409bae5c4f8247c69372dada6a7  gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada
! 2ef9cab842c822e5b35867c53e777c18  gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada
! 82b234cda282c69bd1cd3343d6564886  gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada
! 0e13bff44fe10fc5bb9178c91aa8f41b  gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada
! 05dbe877925c828ecc6371bacbfdfa20  gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada
! 86085a25df2bcf17731e5abce3a41858  gcc/testsuite/ada/acats/tests/ca/ca5004a.ada
! 4663b5feb03415ae2fecb74dc9a6d918  gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada
! dac927119e0c75edf0e171d438d99a0b  gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada
! fb2c0908bc96e07939ff5f370be3d576  gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada
! de4ee9e1d0577cbafe35f74312690093  gcc/testsuite/ada/acats/tests/ca/ca5006a.ada
! 953459f6c3ce7331d1cf5e82d075046f  gcc/testsuite/ada/acats/tests/cb/cb10002.a
! a2d96f308f3e7c5c03f4f9d216128c1c  gcc/testsuite/ada/acats/tests/cb/cb1001a.ada
! c9d819541b343e576525a8dc64f50bcc  gcc/testsuite/ada/acats/tests/cb/cb1004a.ada
! cd057227d4389433804bcb77c3065624  gcc/testsuite/ada/acats/tests/cb/cb1005a.ada
! 5335053bd77df186552ab553aed53d59  gcc/testsuite/ada/acats/tests/cb/cb1010a.ada
! 6be3f5adbcfcbc452379f748a85caa57  gcc/testsuite/ada/acats/tests/cb/cb1010c.ada
! 0a7ba5489277a0fcbe1b644ea3d981a3  gcc/testsuite/ada/acats/tests/cb/cb1010d.ada
! 6cae622e32e9824d353863435f37029e  gcc/testsuite/ada/acats/tests/cb/cb20001.a
! f70c8a2a06450a84e9c16c2c896968c2  gcc/testsuite/ada/acats/tests/cb/cb20003.a
! fe4620ca44567358367bbd3cbf625a78  gcc/testsuite/ada/acats/tests/cb/cb20004.a
! 35b97a6a98aab2205d9fafa16376dd73  gcc/testsuite/ada/acats/tests/cb/cb20005.a
! 2eb8439ac2fe1164f75cef3955ed5f7e  gcc/testsuite/ada/acats/tests/cb/cb20006.a
! 14f424c9945ffa51a8ed9b5158035a61  gcc/testsuite/ada/acats/tests/cb/cb20007.a
! 81b37c096b48361109ecfd3c0a735d6f  gcc/testsuite/ada/acats/tests/cb/cb2004a.ada
! c9e534ca3b39a7e52f750d7ada5b1f05  gcc/testsuite/ada/acats/tests/cb/cb2005a.ada
! 5f629a419d744cf6cbdf01ae526e8dfe  gcc/testsuite/ada/acats/tests/cb/cb2006a.ada
! 0f62783e4e017c666e439d08382f4081  gcc/testsuite/ada/acats/tests/cb/cb2007a.ada
! 0af3543016fdd2ab314c8e3f6944bc98  gcc/testsuite/ada/acats/tests/cb/cb20a02.a
! da80eb868ceb5337039000257fc5cf28  gcc/testsuite/ada/acats/tests/cb/cb3003a.ada
! 3dcceb335b81c6314b73ec2a12e496dd  gcc/testsuite/ada/acats/tests/cb/cb3003b.ada
! db5771a4c4d22f1ee3b2043ea42e688e  gcc/testsuite/ada/acats/tests/cb/cb3004a.ada
! 931665965eb67df7de9092d1150d78dc  gcc/testsuite/ada/acats/tests/cb/cb40005.a
! 15fd6a782afdd2e76a85a1ef09b95d91  gcc/testsuite/ada/acats/tests/cb/cb4001a.ada
! f00ebf73158afdcf6ccfa56162d1a7c7  gcc/testsuite/ada/acats/tests/cb/cb4002a.ada
! 9e17c1d3be3c2acc4c4a761cf058d3c6  gcc/testsuite/ada/acats/tests/cb/cb4003a.ada
! 3461f679629a4811d1fce600d7e8b57e  gcc/testsuite/ada/acats/tests/cb/cb4004a.ada
! f2db155f6c22f6b30ca696f825ef8aae  gcc/testsuite/ada/acats/tests/cb/cb4005a.ada
! b611f921d0e5b0b027e6f69faa9d24b4  gcc/testsuite/ada/acats/tests/cb/cb4006a.ada
! baded9fec75a97cb63419083a60cbf79  gcc/testsuite/ada/acats/tests/cb/cb4007a.ada
! a4194c712a3e86aa41f29aec96a8f7a7  gcc/testsuite/ada/acats/tests/cb/cb4008a.ada
! 930c41db090c6c2c54a36228405c48ac  gcc/testsuite/ada/acats/tests/cb/cb4009a.ada
! 72f5c28e26994805b38b887c725d411c  gcc/testsuite/ada/acats/tests/cb/cb4013a.ada
! 7cebdcd4f0159fb009f28f53b4f1d2aa  gcc/testsuite/ada/acats/tests/cb/cb40a01.a
! c5d94b1d4e0e31956d3f563cd7632df6  gcc/testsuite/ada/acats/tests/cb/cb40a020.a
! 1826a245b36f70926f1d010c4bb03b56  gcc/testsuite/ada/acats/tests/cb/cb40a021.am
! dd4b04d0ff15d88ce5e37562087104b8  gcc/testsuite/ada/acats/tests/cb/cb40a030.a
! ce7a78707740e7c8442c44280bd4b429  gcc/testsuite/ada/acats/tests/cb/cb40a031.am
! 27770d52ee37e90d5cd9748807eab53e  gcc/testsuite/ada/acats/tests/cb/cb40a04.a
! fee21ac92aa6b69bea4a12f412715df6  gcc/testsuite/ada/acats/tests/cb/cb41001.a
! 3bbe3f0aeccac5d0203ed045c2ccf49e  gcc/testsuite/ada/acats/tests/cb/cb41002.a
! d456462b7a7e6f3773b86bf24468d231  gcc/testsuite/ada/acats/tests/cb/cb41003.a
! fffb38bf5df913140c6261714aa601ea  gcc/testsuite/ada/acats/tests/cb/cb41004.a
! 01e2daee09a3391b981c7a63ebe0ae28  gcc/testsuite/ada/acats/tests/cb/cb5001a.ada
! 5a22bfb3766d46433b2b7b2f046d0ea9  gcc/testsuite/ada/acats/tests/cb/cb5001b.ada
! 63153559a0add5135a21197c6c8c0a9f  gcc/testsuite/ada/acats/tests/cb/cb5002a.ada
! 52c10586939e5289ffc5276a6a4d9e3e  gcc/testsuite/ada/acats/tests/cc/cc1004a.ada
! abeb72a1acbce60114f56d558d1481a5  gcc/testsuite/ada/acats/tests/cc/cc1005b.ada
! e52fa7b734609c2fde5f5260ff000f57  gcc/testsuite/ada/acats/tests/cc/cc1010a.ada
! 4af2da441a155dbd4ee2be7e5afcdb99  gcc/testsuite/ada/acats/tests/cc/cc1010b.ada
! 3943b41b051f4e223a5fe3b067dd4750  gcc/testsuite/ada/acats/tests/cc/cc1018a.ada
! 8b9f3eb4b897035fcc0c08981fa94cd0  gcc/testsuite/ada/acats/tests/cc/cc1104c.ada
! 6dde1021fb59bfd89f7e89e10c4dc040  gcc/testsuite/ada/acats/tests/cc/cc1107b.ada
! fd9ff835b201890341a69a2bf568186d  gcc/testsuite/ada/acats/tests/cc/cc1111a.ada
! 3a2e06563ce5c65cb9f2734c9b5901b2  gcc/testsuite/ada/acats/tests/cc/cc1204a.ada
! ec00ecaace8abe97b14deef79a927278  gcc/testsuite/ada/acats/tests/cc/cc1207b.ada
! d5b96d46768e2afc1db48bccdd883c3d  gcc/testsuite/ada/acats/tests/cc/cc1220a.ada
! fe4da7912a4f8ebd90feecf1233d1cdd  gcc/testsuite/ada/acats/tests/cc/cc1221a.ada
! 25b2b3dc12b77cbf205ab8f38dcfb77d  gcc/testsuite/ada/acats/tests/cc/cc1221b.ada
! 9145c4850d40180754446ef574cb5fc0  gcc/testsuite/ada/acats/tests/cc/cc1221c.ada
! c4c966046fba1bd9875ab2ac270f27d0  gcc/testsuite/ada/acats/tests/cc/cc1221d.ada
! ec00a589846feb2b9117000ba453bb4d  gcc/testsuite/ada/acats/tests/cc/cc1222a.ada
! 9098cb80c67049808425c47b419fac81  gcc/testsuite/ada/acats/tests/cc/cc1223a.ada
! ebb1accb64bb0bc75b36cc4d7667f11e  gcc/testsuite/ada/acats/tests/cc/cc1224a.ada
! 252dcf9d499b779ceb6ff22b740614f3  gcc/testsuite/ada/acats/tests/cc/cc1225a.tst
! bd7909fda37c73e6a7b55033af7a7073  gcc/testsuite/ada/acats/tests/cc/cc1226b.ada
! 6c7f653283771ea8e72f38f30cca417e  gcc/testsuite/ada/acats/tests/cc/cc1227a.ada
! a59ea76111c1c30abdfc81e140c2ad1e  gcc/testsuite/ada/acats/tests/cc/cc1301a.ada
! 54718ced426c8406bfe76f085e364b70  gcc/testsuite/ada/acats/tests/cc/cc1302a.ada
! 0e4bf36981636de5140e59f431e9a750  gcc/testsuite/ada/acats/tests/cc/cc1304a.ada
! 8b8017d0f141d2d1f196915bb0d9086f  gcc/testsuite/ada/acats/tests/cc/cc1304b.ada
! 5c30254607e6be149633cccc49ed0eed  gcc/testsuite/ada/acats/tests/cc/cc1307a.ada
! 074dfbafa7a711ae864c0c7a3551c2c1  gcc/testsuite/ada/acats/tests/cc/cc1307b.ada
! 99a71a5de9c88311f519834c73dd819d  gcc/testsuite/ada/acats/tests/cc/cc1308a.ada
! f7d1a2abebaff0b7213722ac29bc699a  gcc/testsuite/ada/acats/tests/cc/cc1310a.ada
! 02f17d4f3889eba61e039a52d84ad466  gcc/testsuite/ada/acats/tests/cc/cc1311a.ada
! ab2512302d5429785277d9bb46d6c87b  gcc/testsuite/ada/acats/tests/cc/cc1311b.ada
! 1653180dc4be9e4015e8cad4546ded2c  gcc/testsuite/ada/acats/tests/cc/cc2002a.ada
! 5368d883d7adafccb7c415ab1a83c7f2  gcc/testsuite/ada/acats/tests/cc/cc30001.a
! 9240ec87a1cc555c3c6e829f22480b0f  gcc/testsuite/ada/acats/tests/cc/cc30002.a
! 258d4b8f83d4c17eda45265db8a66c46  gcc/testsuite/ada/acats/tests/cc/cc3004a.ada
! 1422918611096dedc710ededab9fc1d3  gcc/testsuite/ada/acats/tests/cc/cc3007a.ada
! faee4cb0106ee6d683bf7e7a208050dc  gcc/testsuite/ada/acats/tests/cc/cc3007b.ada
! 43f939c986863c3151fb21fae7ad81a8  gcc/testsuite/ada/acats/tests/cc/cc3011a.ada
! e21f329f8aeeeaaf980ab3ae301de7cb  gcc/testsuite/ada/acats/tests/cc/cc3011d.ada
! 021bd9a65cf3be3535547519f5ceb651  gcc/testsuite/ada/acats/tests/cc/cc3012a.ada
! eb08409ceff83c49baa04e734c258681  gcc/testsuite/ada/acats/tests/cc/cc3015a.ada
! 37ffe8fd743867700b2e0249fd73f16b  gcc/testsuite/ada/acats/tests/cc/cc3016b.ada
! 92e8dfd4f50c7e3595bbd6ef5ebb4302  gcc/testsuite/ada/acats/tests/cc/cc3016c.ada
! 3bb5847d2c36a04a53a9dc138c40e34a  gcc/testsuite/ada/acats/tests/cc/cc3016f.ada
! 195ab10c1ca9bbfd5b16ade12e3259e2  gcc/testsuite/ada/acats/tests/cc/cc3016i.ada
! a5976b043f8ea78109e2936d58a009a8  gcc/testsuite/ada/acats/tests/cc/cc3017b.ada
! 21e94c5f1086f6624d5237d010ecc0f2  gcc/testsuite/ada/acats/tests/cc/cc3017c.ada
! 2fb78d8d58d12070086164535de0efda  gcc/testsuite/ada/acats/tests/cc/cc3019a.ada
! a0315fd5149893475278feb9b8d7013b  gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada
! 207f4488242efc2b7a5c80c0cd47410b  gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada
! 5688bc525157eef2f521d23f1a720672  gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada
! e5522bd1515d2f7df4fdd2bafaf481fb  gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada
! 66683952c6c322d9c96e76710460cc02  gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada
! 4e308a4f2724a46a2eb3a8426f98265f  gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada
! cd9a188b6b1ecf3863d42065ce445792  gcc/testsuite/ada/acats/tests/cc/cc3106b.ada
! b1b639f80dbd48bf241b7d05c36362e6  gcc/testsuite/ada/acats/tests/cc/cc3120a.ada
! f06e709416c9d57a31113226d02abf07  gcc/testsuite/ada/acats/tests/cc/cc3120b.ada
! e09fb340ff80c10cbecd4b83e746eef2  gcc/testsuite/ada/acats/tests/cc/cc3121a.ada
! 302527c5f7e5e7497411775d418850b0  gcc/testsuite/ada/acats/tests/cc/cc3123a.ada
! 2575fc22f53f2a5308182459add72a14  gcc/testsuite/ada/acats/tests/cc/cc3125a.ada
! 4f59d6fe9227d671293a8fecd22f9101  gcc/testsuite/ada/acats/tests/cc/cc3125b.ada
! a1164d012410441b7190f2e96d6ce7c6  gcc/testsuite/ada/acats/tests/cc/cc3125c.ada
! 8a71d919069253ce368ef3103ee770c8  gcc/testsuite/ada/acats/tests/cc/cc3125d.ada
! ae116bcf41f79383e2dba5094b290b3f  gcc/testsuite/ada/acats/tests/cc/cc3126a.ada
! de2792bcfe94fa04d80a2c8ecf74db33  gcc/testsuite/ada/acats/tests/cc/cc3127a.ada
! a9709bfb589a677927644fb64dffa39c  gcc/testsuite/ada/acats/tests/cc/cc3128a.ada
! eeae81e69cab3987783ac508ffbebc5c  gcc/testsuite/ada/acats/tests/cc/cc3203a.ada
! a4d077af707d747e7c7f4f145a33e013  gcc/testsuite/ada/acats/tests/cc/cc3207b.ada
! 4525f7929e8bbeab0d61377f11afa3b8  gcc/testsuite/ada/acats/tests/cc/cc3220a.ada
! e8cc62fb0584ebfbe49d22d70abf54f4  gcc/testsuite/ada/acats/tests/cc/cc3221a.ada
! fbf1f50c254b6c5361e7d43b8efa783c  gcc/testsuite/ada/acats/tests/cc/cc3222a.ada
! 06202a4a37521548f15b8f63b30331cf  gcc/testsuite/ada/acats/tests/cc/cc3223a.ada
! d6d9973ddd1a38d34208ece4853e3e54  gcc/testsuite/ada/acats/tests/cc/cc3224a.ada
! 9d8a01fd3692524cef3f688f08e8820e  gcc/testsuite/ada/acats/tests/cc/cc3225a.ada
! 0b4db0bdcd8b5f809a2a0976c2fd65a2  gcc/testsuite/ada/acats/tests/cc/cc3230a.ada
! ecf0a337f74761749dd005a8b934ae2d  gcc/testsuite/ada/acats/tests/cc/cc3231a.ada
! 536583cad34553553ba201c11a12e136  gcc/testsuite/ada/acats/tests/cc/cc3232a.ada
! 29722620be1cef89562f63d778feb319  gcc/testsuite/ada/acats/tests/cc/cc3233a.ada
! 55b7f83f0d13dd0bbbc615bec20f7f58  gcc/testsuite/ada/acats/tests/cc/cc3234a.ada
! 174e858e451ed1d671a07a674320a404  gcc/testsuite/ada/acats/tests/cc/cc3235a.ada
! 1966408531cce82c0dee0cdb997e2d83  gcc/testsuite/ada/acats/tests/cc/cc3236a.ada
! 69f2b9819e916eb5bef41d74a6bf059e  gcc/testsuite/ada/acats/tests/cc/cc3240a.ada
! 134c20d477e6856df2b370dc7cfda1a4  gcc/testsuite/ada/acats/tests/cc/cc3305a.ada
! 6ff147856008d1bc23082c84a6dce358  gcc/testsuite/ada/acats/tests/cc/cc3305b.ada
! 75b310968a34fc081580d58bd1747ea3  gcc/testsuite/ada/acats/tests/cc/cc3305c.ada
! e41c2fcae5aa76bb6cd566a6a34b9e73  gcc/testsuite/ada/acats/tests/cc/cc3305d.ada
! 54ae1b7ff14c3a948a87f71ab9b7ae53  gcc/testsuite/ada/acats/tests/cc/cc3601a.ada
! 1d5d61ff6eda390e054673a067185feb  gcc/testsuite/ada/acats/tests/cc/cc3601c.ada
! 14a6f6048e3bda5108a0dac8dc736e44  gcc/testsuite/ada/acats/tests/cc/cc3602a.ada
! 73b205844c7501b9750b69b66d91e84c  gcc/testsuite/ada/acats/tests/cc/cc3603a.ada
! 509cb0b6a7b3daf93118e0e4310a8889  gcc/testsuite/ada/acats/tests/cc/cc3605a.ada
! b81c8580788eaf032722950c55524548  gcc/testsuite/ada/acats/tests/cc/cc3606a.ada
! 5232a6ea1beea12bb0c271a9c0728bcc  gcc/testsuite/ada/acats/tests/cc/cc3606b.ada
! 2f46f9edadb7856b60273822fbd7c6dc  gcc/testsuite/ada/acats/tests/cc/cc3607b.ada
! 59c4b0341104cc61677baaee002ac38c  gcc/testsuite/ada/acats/tests/cc/cc40001.a
! 6d5d6f00038ccaafe12d5f471a488085  gcc/testsuite/ada/acats/tests/cc/cc50001.a
! 8cb4adfbf6723ce3680f41b59f744fe9  gcc/testsuite/ada/acats/tests/cc/cc50a01.a
! 508d46d79897dc7252508cdafdbbfaa1  gcc/testsuite/ada/acats/tests/cc/cc50a02.a
! 146e71ceb1d037e4099e8ecb6e127614  gcc/testsuite/ada/acats/tests/cc/cc51001.a
! 58d73c0c5456a6a21ebbaef95df38606  gcc/testsuite/ada/acats/tests/cc/cc51002.a
! e096e928fb49f1e659293619c383c7f1  gcc/testsuite/ada/acats/tests/cc/cc51003.a
! a373845361c49771cf3d23fbbfc043de  gcc/testsuite/ada/acats/tests/cc/cc51004.a
! f57dbf49aca26d9bd043ebddae124c8e  gcc/testsuite/ada/acats/tests/cc/cc51006.a
! ed5459250c5b2a65cf4b7a7c678c41b5  gcc/testsuite/ada/acats/tests/cc/cc51007.a
! edb35d02b7ba72e7720c2eaf7fefe5bf  gcc/testsuite/ada/acats/tests/cc/cc51008.a
! 91f9a7214da9eed7db005bf7e3119ddc  gcc/testsuite/ada/acats/tests/cc/cc51a01.a
! 123f5aa956187735f0e077abedfd8f93  gcc/testsuite/ada/acats/tests/cc/cc51b03.a
! 557497dc9fd80ad665e468b409621ee1  gcc/testsuite/ada/acats/tests/cc/cc51d01.a
! 31462b6f268d175f3a915242afd8ea4d  gcc/testsuite/ada/acats/tests/cc/cc51d02.a
! 8b56f900a407dc994866f74c2c67f98e  gcc/testsuite/ada/acats/tests/cc/cc54001.a
! 65d5b89a1c15ad3234bf150dbe3c9235  gcc/testsuite/ada/acats/tests/cc/cc54002.a
! 04d1ce4f2960ed9b647a0bc397f920c2  gcc/testsuite/ada/acats/tests/cc/cc54003.a
! 0e1a91d2dfd0e6b36d65c5cfb02883dc  gcc/testsuite/ada/acats/tests/cc/cc54004.a
! c29ebf7d9a6ed65bca0e83b18c63bbcc  gcc/testsuite/ada/acats/tests/cc/cc70001.a
! eb1b9be669a38ce3989d9340fb2dc933  gcc/testsuite/ada/acats/tests/cc/cc70002.a
! b1df852c3d5deec3247a4e17e9fb4dc6  gcc/testsuite/ada/acats/tests/cc/cc70003.a
! 9f1565b83bb2fa8ee588283eaa27cf37  gcc/testsuite/ada/acats/tests/cc/cc70a01.a
! 0bb1d67b6fb03b14e1b2f2062d01417d  gcc/testsuite/ada/acats/tests/cc/cc70a02.a
! ee68b4ea46957b2abff5e05bc98eeb76  gcc/testsuite/ada/acats/tests/cc/cc70b01.a
! 8c472987131321e68210b34029de25a7  gcc/testsuite/ada/acats/tests/cc/cc70b02.a
! 1a10fab698e0e1c3d985d63a8fd02646  gcc/testsuite/ada/acats/tests/cc/cc70c01.a
! 630e79ef7ad77506e6bc0443bc253106  gcc/testsuite/ada/acats/tests/cc/cc70c02.a
! 0be418cda7e22eca0aa6c889d87f4533  gcc/testsuite/ada/acats/tests/cd/cd10001.a
! 5dd315f72d7b25ba35718d9545b60e5e  gcc/testsuite/ada/acats/tests/cd/cd10002.a
! 4e3da95c629f1132a7605c755936df22  gcc/testsuite/ada/acats/tests/cd/cd1009a.ada
! 75d6166e3a9b874d8b18037b2bbd7774  gcc/testsuite/ada/acats/tests/cd/cd1009b.ada
! fb2d00d22c6dc289be9e7485d1057b88  gcc/testsuite/ada/acats/tests/cd/cd1009d.ada
! 0f7c8765f0bcfd92843011f7699a3515  gcc/testsuite/ada/acats/tests/cd/cd1009e.ada
! 278b82d91f416169138eaedebaee0e88  gcc/testsuite/ada/acats/tests/cd/cd1009f.ada
! c5d7abbf75d5228f8ee64b921461c34d  gcc/testsuite/ada/acats/tests/cd/cd1009g.ada
! 05621471548ccc18ff9a5e104f81afde  gcc/testsuite/ada/acats/tests/cd/cd1009h.ada
! 529178df08dc16ac0af024a1fd6bfb53  gcc/testsuite/ada/acats/tests/cd/cd1009i.ada
! 365257c1306da6752feb59e62ac38bdf  gcc/testsuite/ada/acats/tests/cd/cd1009j.ada
! 03b1bb47c24a014bd2530417d1adf9b2  gcc/testsuite/ada/acats/tests/cd/cd1009k.tst
! 06bdced5a41c98c87e673e382a9688bb  gcc/testsuite/ada/acats/tests/cd/cd1009l.ada
! f8f71aa9e49974d6cf320e70c4b0ecbf  gcc/testsuite/ada/acats/tests/cd/cd1009m.ada
! f29ec324e7b0ec1f2f6dd2240fc728d8  gcc/testsuite/ada/acats/tests/cd/cd1009n.ada
! cae30866eb5c8c2cfb27698eb8ddbde0  gcc/testsuite/ada/acats/tests/cd/cd1009o.ada
! d3eb7538a98ec14ae8d521733ba57af7  gcc/testsuite/ada/acats/tests/cd/cd1009p.ada
! b8730acac7650dbd31ddd035bc69f509  gcc/testsuite/ada/acats/tests/cd/cd1009q.ada
! c358e33b93c2826e889494a0f5ed0843  gcc/testsuite/ada/acats/tests/cd/cd1009r.ada
! bc1961d8c175f48f60b3e9f057a9c72a  gcc/testsuite/ada/acats/tests/cd/cd1009s.ada
! 97707e58ce3c7a72dc76f39b8a718701  gcc/testsuite/ada/acats/tests/cd/cd1009t.tst
! 692d5e6fe6286682bb5eaaa37bbb3deb  gcc/testsuite/ada/acats/tests/cd/cd1009u.tst
! 907fdf446e490f986c267dd4b8d31baf  gcc/testsuite/ada/acats/tests/cd/cd1009v.ada
! 53fd05330599e7a416f8be2f4b93f8db  gcc/testsuite/ada/acats/tests/cd/cd1009w.ada
! 6e1baf3329c3ff434b0b23406203b126  gcc/testsuite/ada/acats/tests/cd/cd1009x.ada
! 992350215516da7fa9fc873f9d5f405e  gcc/testsuite/ada/acats/tests/cd/cd1009y.ada
! fb78c3da6117cb6f992401e7c6afde33  gcc/testsuite/ada/acats/tests/cd/cd1009z.ada
! 5b32d31e23b1f46b777ddb79782d91bc  gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada
! 33753d6d5cc05f96879e603e7e4239ed  gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada
! bb197eb3c945f5f3165b484b8d052169  gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada
! d532f2cddb2a1d42073af8bead380310  gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst
! 31687b0c41570bd2e2caf21db4be46d3  gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada
! e0216b320efd829ccdc65f5d5771bcbb  gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada
! c46fc765c5f46303364ae7f735fd4155  gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada
! e99adb592df5a1337ea0d1ba20e1ea56  gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada
! 356e60fd22404e9284ce91535fb26d24  gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada
! e23985efbd7775125639e267122b2530  gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada
! 960f74b381e41f1c5aca4cb19a43ba24  gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada
! f4445570707e4cfc05845c2942f2a691  gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst
! 38c0ca7c9c40e40a65ebac293401406d  gcc/testsuite/ada/acats/tests/cd/cd20001.a
! 6840d06bfa723e58150ad53215d31eaf  gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada
! 16f1f72fade5db004d66971714b76535  gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada
! 9955b221c78032f3aa68113cb414afea  gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada
! 138413c4349c431ae13135443971a255  gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada
! 2ecbd329e980e8d80615287a05917c3c  gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada
! fa618469f3bfe667b6991f706078ceee  gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada
! 17cd76bca6e556da829dc167dd37416d  gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada
! 165d140694576ed2e1610ce9cf23d710  gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada
! ee7517fa66b44ea029fa5afd44d3dfda  gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada
! 7406649d9c3a6c13d39de22cbbbed6c0  gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada
! 42e0bfe93795136ebcd4a60e074e3d13  gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada
! 3812be2a4f7026b0ea147488e4e11b79  gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada
! b5db777461ec4b929a5d956caae5ab6c  gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada
! 01ec2329faee0b5aa7957719bee0a023  gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada
! 5cfa1167dd7ab84a3f1390d1ef40e5a8  gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada
! 25cf5e2245fd319818051c6d58e33e34  gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada
! fe2d9184c16158b464a66d55f5f012e0  gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada
! c89035c306f20662287a41260e41c440  gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada
! 5a16f63c007776f1d0e621124c28ba40  gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada
! 509f33673d8a806e1fc5c994ecd367a7  gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada
! 9f1153cc00985eff630f5a7529e785a6  gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada
! 3b52721a12cbabf7af952961ab000124  gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada
! b0ce5f538de9c46a7f93bb98b76a16c2  gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada
! fc6c3486ba94594cbb01735d7665ee4c  gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada
! e22ea0a1bf1e45a9cc8941659d5de2bc  gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada
! 800cb5fbfa61381b047623e515b331e9  gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst
! 890942afd45f173d9c7a48fcd9b93b9e  gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst
! ed5c543b1f1e477626a569cf9814e843  gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada
! 8bf8bb847340d421752506f84e4d2970  gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada
! c32d32bcd93ad954d2d4fd55f825977f  gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada
! 1a738e39f3f9e6241c1210e391c74d04  gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada
! 4c72be933f221db34e2a0e081b1987cb  gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada
! 4e115c81a0792d4375dde8dc06949e7d  gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada
! 29657353f6d86b0ea8f7696b58cc2fe9  gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada
! d5241430c4b7db939bd5e77692bf37b4  gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst
! 90bc2d2d244c54d7f4a3cd052f4ec35f  gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst
! c6ae74fd392f1fb6040ba95b1d1ae6f0  gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada
! cdcdd3477a39a731b6a087ee53c8d310  gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada
! 76610aaf77050e2ff007a677818d736b  gcc/testsuite/ada/acats/tests/cd/cd30001.a
! 074a289ffe88ab1f82a7410cb923d4e9  gcc/testsuite/ada/acats/tests/cd/cd30002.a
! 3c6e9682493e7e0159a203d7641e1a2e  gcc/testsuite/ada/acats/tests/cd/cd30003.a
! 58da39f40326823d0b3dcca45acdc03a  gcc/testsuite/ada/acats/tests/cd/cd30004.a
! b20df3bfc89786bd52ff18a24d92a63a  gcc/testsuite/ada/acats/tests/cd/cd300050.am
! 6fc396067544f25307ce6a100bb5ef10  gcc/testsuite/ada/acats/tests/cd/cd300051.c
! 53302b5bf903a58fb95e205690813d78  gcc/testsuite/ada/acats/tests/cd/cd30011.a
! 03b96d80ed2b752193a510629a87cc3c  gcc/testsuite/ada/acats/tests/cd/cd30012.a
! a8163e0d624406b874260e4169d9e49c  gcc/testsuite/ada/acats/tests/cd/cd3014a.ada
! b3c46e3333ad22ce02ee156f3f0bccff  gcc/testsuite/ada/acats/tests/cd/cd3014c.ada
! a341da17e2d571e891434aa086ae7d3e  gcc/testsuite/ada/acats/tests/cd/cd3014d.ada
! 204d7f2709b5ba9cddcb718fc3d8ec18  gcc/testsuite/ada/acats/tests/cd/cd3014f.ada
! a86fa642d37091be0c5e5119e8c46645  gcc/testsuite/ada/acats/tests/cd/cd3015a.ada
! 38a79cfd7d26ff49fc8ee336963b178f  gcc/testsuite/ada/acats/tests/cd/cd3015c.ada
! 516902a49ddef41f79ee415e4edbb912  gcc/testsuite/ada/acats/tests/cd/cd3015e.ada
! 21588812fb8df6d087570f29c23c5d39  gcc/testsuite/ada/acats/tests/cd/cd3015f.ada
! c8a6fa2243d818236602663b274b5ba9  gcc/testsuite/ada/acats/tests/cd/cd3015g.ada
! c31ca49858b05c8ca516526b0e15945f  gcc/testsuite/ada/acats/tests/cd/cd3015h.ada
! c130ab902d51f975c0efadc0d44c9361  gcc/testsuite/ada/acats/tests/cd/cd3015i.ada
! 2fa00ee1e19df0bb0e4dc668c1d238fd  gcc/testsuite/ada/acats/tests/cd/cd3015k.ada
! 0c71d1dfc5a7d7c4d232217c2ef3e00f  gcc/testsuite/ada/acats/tests/cd/cd3021a.ada
! 02bab37ae5532979da2b39be8f1f447f  gcc/testsuite/ada/acats/tests/cd/cd33001.a
! 164945bdb98657e50508d0be9d5e1711  gcc/testsuite/ada/acats/tests/cd/cd33002.a
! fd95d787e27f8f80c3bccc691bf0417d  gcc/testsuite/ada/acats/tests/cd/cd40001.a
! a3f551b50734da9e1de425c6988b1f43  gcc/testsuite/ada/acats/tests/cd/cd4031a.ada
! 1363b8d9d26525600395a9118a1a4041  gcc/testsuite/ada/acats/tests/cd/cd4041a.tst
! 255be84f9bd123a67360189ab2d64cdf  gcc/testsuite/ada/acats/tests/cd/cd4051a.ada
! 37ae7a5703b3780f73cd5ae4eb39621a  gcc/testsuite/ada/acats/tests/cd/cd4051b.ada
! 07adf8476ba0c5e57a2bea963c120c2a  gcc/testsuite/ada/acats/tests/cd/cd4051c.ada
! cf5f11fa4855f5f18dba58d556b7ca63  gcc/testsuite/ada/acats/tests/cd/cd4051d.ada
! 20478b00e54601fd76a247d8a78c4a8f  gcc/testsuite/ada/acats/tests/cd/cd5003a.ada
! 4cff6e4a9ec3d2900f66bfc5693af89a  gcc/testsuite/ada/acats/tests/cd/cd5003b.ada
! d13512a51a4eb52527563404909e596e  gcc/testsuite/ada/acats/tests/cd/cd5003c.ada
! 4652d6ed2c04ade1800842b5dbfdabf9  gcc/testsuite/ada/acats/tests/cd/cd5003d.ada
! 005bf8518b263e4cee4d26c5db87e58b  gcc/testsuite/ada/acats/tests/cd/cd5003e.ada
! 8ff99eb70e788c11615ac412a1a7b4fb  gcc/testsuite/ada/acats/tests/cd/cd5003f.ada
! 719c829d93aa5b1f5984a681101887d3  gcc/testsuite/ada/acats/tests/cd/cd5003g.ada
! a7821be04ce2545857881e21292d5867  gcc/testsuite/ada/acats/tests/cd/cd5003h.ada
! 3491fd905bd30777ef1fbdfae6595acf  gcc/testsuite/ada/acats/tests/cd/cd5003i.ada
! 88b907e17fa7e933c0aa985bcbdba611  gcc/testsuite/ada/acats/tests/cd/cd5011a.ada
! 502c219e404c935fb79b18a5bc9edb77  gcc/testsuite/ada/acats/tests/cd/cd5011c.ada
! 71b7123461788aab03963e62fecc0ba3  gcc/testsuite/ada/acats/tests/cd/cd5011e.ada
! 8ee70bf0284e509f67c72903d25709f7  gcc/testsuite/ada/acats/tests/cd/cd5011g.ada
! 3b37531d4672ce7853d736e20f205d9e  gcc/testsuite/ada/acats/tests/cd/cd5011i.ada
! b1bd44ec7ae1e5e46e2aecd8d6f8f7b7  gcc/testsuite/ada/acats/tests/cd/cd5011k.ada
! b632fa011acdccee9f2b9fb3b5a030bf  gcc/testsuite/ada/acats/tests/cd/cd5011m.ada
! fd5e412763d1e844067af789a1ac1c48  gcc/testsuite/ada/acats/tests/cd/cd5011q.ada
! ee93e2b7d81f47c56f7b7ad4552b21bb  gcc/testsuite/ada/acats/tests/cd/cd5011s.ada
! 47d11b263404f1dd8fe59440a5052207  gcc/testsuite/ada/acats/tests/cd/cd5012a.ada
! 1892070e6feeb321986c5cbbcc427b4a  gcc/testsuite/ada/acats/tests/cd/cd5012b.ada
! ff4f485285269aca5506577d2a0b3b25  gcc/testsuite/ada/acats/tests/cd/cd5012e.ada
! a5f14af29759eeb2088d73d911c87c1f  gcc/testsuite/ada/acats/tests/cd/cd5012f.ada
! e5f28d4028e3550e275facc5a05598e5  gcc/testsuite/ada/acats/tests/cd/cd5012i.ada
! 16dbc766d573615ec2e4899fad17e3bf  gcc/testsuite/ada/acats/tests/cd/cd5012m.ada
! 6cc56f376ceaa00b529da26c6460e8d6  gcc/testsuite/ada/acats/tests/cd/cd5013a.ada
! c0918022f30f205dd1507581efbfdd4d  gcc/testsuite/ada/acats/tests/cd/cd5013c.ada
! 811d55a4a9aee790bed1e966d928fbb2  gcc/testsuite/ada/acats/tests/cd/cd5013e.ada
! 21ba9a45a10469204bf9be2e86069c81  gcc/testsuite/ada/acats/tests/cd/cd5013g.ada
! 4f445e0ed2b7e60f8eb00f85696e3a7d  gcc/testsuite/ada/acats/tests/cd/cd5013i.ada
! 0b15bb9a260246e000106d4512840f2a  gcc/testsuite/ada/acats/tests/cd/cd5013k.ada
! 1da10e9981f9def7bfc6d6c2143211ec  gcc/testsuite/ada/acats/tests/cd/cd5013m.ada
! 08a9e582acca940c3e759a92734c93c9  gcc/testsuite/ada/acats/tests/cd/cd5013o.ada
! 1968e13f319d3b0c07f4c96303157e60  gcc/testsuite/ada/acats/tests/cd/cd5014a.ada
! 7c607413594268a5d4b2292b7cb0413b  gcc/testsuite/ada/acats/tests/cd/cd5014c.ada
! 8fef3117954cc6c0a11bb3f93e364b40  gcc/testsuite/ada/acats/tests/cd/cd5014e.ada
! 0b813473017a44baccc884d20552e8cd  gcc/testsuite/ada/acats/tests/cd/cd5014g.ada
! 527b59a75ca64a8266a57d7a5088fe89  gcc/testsuite/ada/acats/tests/cd/cd5014i.ada
! fc74902958756d067346aa25dc320720  gcc/testsuite/ada/acats/tests/cd/cd5014k.ada
! b77eb1036af76cfb5202f2de49ace505  gcc/testsuite/ada/acats/tests/cd/cd5014m.ada
! ab247e3e629023fbd5f60ebe8227bdb5  gcc/testsuite/ada/acats/tests/cd/cd5014o.ada
! fc0ebe93b10ae9a9d4c3c4a5df942f54  gcc/testsuite/ada/acats/tests/cd/cd5014t.ada
! c00ed5123db97df563396ec85314f780  gcc/testsuite/ada/acats/tests/cd/cd5014v.ada
! bbf572fbf22be12dd2a668dcd54775ea  gcc/testsuite/ada/acats/tests/cd/cd5014x.ada
! 34d86be0b29568cce7a2a466311b3b81  gcc/testsuite/ada/acats/tests/cd/cd5014y.ada
! b56429de483f94a422eb6ca63ee074f9  gcc/testsuite/ada/acats/tests/cd/cd5014z.ada
! aa622725c36aef33e28cfe216e74dbf2  gcc/testsuite/ada/acats/tests/cd/cd70001.a
! 2eb61a4a6db022ec0de56d97cdb58d92  gcc/testsuite/ada/acats/tests/cd/cd7002a.ada
! aaa73d4164232ddfd2c5811f78c69833  gcc/testsuite/ada/acats/tests/cd/cd7007b.ada
! a2455776674d2ad1da3cc32ece807208  gcc/testsuite/ada/acats/tests/cd/cd7101d.ada
! aa55af7af75ac0b3c135078d81fb495f  gcc/testsuite/ada/acats/tests/cd/cd7101e.dep
! 54f3d5f0c03029d0398feadc1fba13fa  gcc/testsuite/ada/acats/tests/cd/cd7101f.dep
! d4c58764ec07d4b64c614f06a404a048  gcc/testsuite/ada/acats/tests/cd/cd7101g.tst
! b19b5291beb6e4d9ba34dc60acc52917  gcc/testsuite/ada/acats/tests/cd/cd7103d.ada
! bc9859e9de09dbae5b873f61d7dd6d25  gcc/testsuite/ada/acats/tests/cd/cd7202a.ada
! 27154e701456e154266de19089be5f95  gcc/testsuite/ada/acats/tests/cd/cd7204b.ada
! 866e238520f9fe6f2e1ebc1c66530b27  gcc/testsuite/ada/acats/tests/cd/cd7204c.ada
! 463ecdd8176f35af59f9b3791565e928  gcc/testsuite/ada/acats/tests/cd/cd72a01.a
! 97e1c7a2d8dcad44f97e8a054d7ddbfa  gcc/testsuite/ada/acats/tests/cd/cd72a02.a
! 094d528313c32d60bc8ef9966a3ba667  gcc/testsuite/ada/acats/tests/cd/cd7305a.ada
! 89a9ca0baa4aea5a158e931fd05972da  gcc/testsuite/ada/acats/tests/cd/cd90001.a
! b35e132e38a1316bb94eb5685e744e45  gcc/testsuite/ada/acats/tests/cd/cd92001.a
! 4acd15be94cdb921d9aaaf1c68bc86bd  gcc/testsuite/ada/acats/tests/cd/cda201a.ada
! 95c680f466bbb6b462cff702c8c051d8  gcc/testsuite/ada/acats/tests/cd/cda201b.ada
! 46aab534344a6aeab59cdc069c0a30a9  gcc/testsuite/ada/acats/tests/cd/cda201c.ada
! 51c51b9e46a1a5740ae0b124d61d55ca  gcc/testsuite/ada/acats/tests/cd/cda201e.ada
! 4d8334f61837b54deaa10e41063c39af  gcc/testsuite/ada/acats/tests/cd/cdb0a01.a
! d60d2f5f8d96507e1b594680a8ddbf8c  gcc/testsuite/ada/acats/tests/cd/cdb0a02.a
! d199627bfc774a32708e179cfe132b55  gcc/testsuite/ada/acats/tests/cd/cdd1001.a
! ecea7d5e451c93f7530aa28e39d75580  gcc/testsuite/ada/acats/tests/cd/cdd2001.a
! 09e97dda9b7ced04ce9c741ad0599d96  gcc/testsuite/ada/acats/tests/cd/cdd2a01.a
! 72e91e49172aabe99c78bb568616e583  gcc/testsuite/ada/acats/tests/cd/cdd2a02.a
! a856f625c37fa5c1f69885ec19e4bc5e  gcc/testsuite/ada/acats/tests/cd/cdd2a03.a
! 317e3f1dc15de17ef49001a1f08c35b3  gcc/testsuite/ada/acats/tests/cd/cde0001.a
! e3c9b20329b0f7e7d60dc55f195727f7  gcc/testsuite/ada/acats/tests/ce/ce2102a.ada
! 56be361ddf744d65d5919f5f77470cfd  gcc/testsuite/ada/acats/tests/ce/ce2102b.ada
! 83c95e98a0edc5913eda034e9803f9a3  gcc/testsuite/ada/acats/tests/ce/ce2102c.tst
! 704cb92cd741551b8c76bb24ab8f01a6  gcc/testsuite/ada/acats/tests/ce/ce2102d.ada
! a4c5c5ff89eb450e4c847a9cebea2a03  gcc/testsuite/ada/acats/tests/ce/ce2102e.ada
! 27760dba95f836989a21b8529a71855d  gcc/testsuite/ada/acats/tests/ce/ce2102f.ada
! fe48a7b7badffee5e6b11bab0b32391a  gcc/testsuite/ada/acats/tests/ce/ce2102g.ada
! d704111bdcdb479f1991a8daee40cdc6  gcc/testsuite/ada/acats/tests/ce/ce2102h.tst
! 660d5113b9badd86759bd83e670ede30  gcc/testsuite/ada/acats/tests/ce/ce2102i.ada
! 8796caaebedc2e2c57dc7e71ff241431  gcc/testsuite/ada/acats/tests/ce/ce2102j.ada
! ceb778fa800778a3993ddc7cd9190c8f  gcc/testsuite/ada/acats/tests/ce/ce2102k.ada
! 23bd39333ef2a75df64af434a8d52288  gcc/testsuite/ada/acats/tests/ce/ce2102l.ada
! 9a4f2b513351918f23c1e1fcc5d48aaa  gcc/testsuite/ada/acats/tests/ce/ce2102m.ada
! 57880455279d766e91fd84c1ad26a38f  gcc/testsuite/ada/acats/tests/ce/ce2102n.ada
! 1658c529498b5b4b8d79ff4a0a362715  gcc/testsuite/ada/acats/tests/ce/ce2102o.ada
! a942f038d4463c45d5c583b1985c7c87  gcc/testsuite/ada/acats/tests/ce/ce2102p.ada
! 8ce185028df0d4e8d8de27e964b87758  gcc/testsuite/ada/acats/tests/ce/ce2102q.ada
! 1439304477a0f927f09dcb2a2639fe66  gcc/testsuite/ada/acats/tests/ce/ce2102r.ada
! a5aff3dd28b5d54dcd3d2367ad10512e  gcc/testsuite/ada/acats/tests/ce/ce2102s.ada
! fab20fee3d01ec0d98c83ae2e0b85bda  gcc/testsuite/ada/acats/tests/ce/ce2102t.ada
! fb506c6fcfe4ce698ff9a830b7c56229  gcc/testsuite/ada/acats/tests/ce/ce2102u.ada
! 6533e0fca22d00bf5e7584ed3a4dc842  gcc/testsuite/ada/acats/tests/ce/ce2102v.ada
! 96597eb49b1372fa65ee2328da95ca07  gcc/testsuite/ada/acats/tests/ce/ce2102w.ada
! 79aea0b4cdef1b6365b9be26c87383b1  gcc/testsuite/ada/acats/tests/ce/ce2102x.ada
! b982e3e68e8a4f04e10e3b2780934046  gcc/testsuite/ada/acats/tests/ce/ce2102y.ada
! d102ee0d07b326b9d4073e60e25ee113  gcc/testsuite/ada/acats/tests/ce/ce2103a.tst
! ae11fc214dfce8e1c5dce5dd8dff9ad9  gcc/testsuite/ada/acats/tests/ce/ce2103b.tst
! 97d4cf14fe4c578c0d86448663834c20  gcc/testsuite/ada/acats/tests/ce/ce2103c.ada
! 99c7332bd6a90a3213eb826d7f902efa  gcc/testsuite/ada/acats/tests/ce/ce2103d.ada
! 60b763cadd79ca8009e41e392d9aa37b  gcc/testsuite/ada/acats/tests/ce/ce2104a.ada
! 4f9096bebf0622c62a3f4358655497af  gcc/testsuite/ada/acats/tests/ce/ce2104b.ada
! f1962e353466d1757ad6a9c641624847  gcc/testsuite/ada/acats/tests/ce/ce2104c.ada
! c687f392201a3d542022c53d87c728c6  gcc/testsuite/ada/acats/tests/ce/ce2104d.ada
! e59622b5be7a0b85f62f4f5dfd87250c  gcc/testsuite/ada/acats/tests/ce/ce2106a.ada
! 0390975b4b078391dba02ca3c8f31638  gcc/testsuite/ada/acats/tests/ce/ce2106b.ada
! 8576613b0fb7cb5404cf64939d34b3af  gcc/testsuite/ada/acats/tests/ce/ce2108e.ada
! 651994d660ec55d3e422ceb303d2034b  gcc/testsuite/ada/acats/tests/ce/ce2108f.ada
! ba5e89f5212818e3e53a4cf7d59d646c  gcc/testsuite/ada/acats/tests/ce/ce2108g.ada
! fb62dbd03a1355b41f3d194167f479aa  gcc/testsuite/ada/acats/tests/ce/ce2108h.ada
! e1df0b3934297c1162437a03a450f12a  gcc/testsuite/ada/acats/tests/ce/ce2109a.ada
! d91a1fcd2695ad63b53b63e0d22d3f22  gcc/testsuite/ada/acats/tests/ce/ce2109b.ada
! 0a95aeffa3822cc96d6f770183b34979  gcc/testsuite/ada/acats/tests/ce/ce2109c.ada
! 329e30bd5ac69971fa84cd76bd66b302  gcc/testsuite/ada/acats/tests/ce/ce2110a.ada
! b63ea51508983167185a0e378c787235  gcc/testsuite/ada/acats/tests/ce/ce2110c.ada
! 385c38395502c50c4f04f16ed172b5c3  gcc/testsuite/ada/acats/tests/ce/ce2111a.ada
! 0cab0967d4b6100c093d83a0daa2ca06  gcc/testsuite/ada/acats/tests/ce/ce2111b.ada
! 1def457c7ded3aa15287b30a02c2c1bf  gcc/testsuite/ada/acats/tests/ce/ce2111c.ada
! e039c87f3e2f30f3b378642cc3d5d3c3  gcc/testsuite/ada/acats/tests/ce/ce2111e.ada
! 607ff5b75e0ac677df365e3867c8b8bc  gcc/testsuite/ada/acats/tests/ce/ce2111f.ada
! 9b55a66cd32d536d65916a0288c480f4  gcc/testsuite/ada/acats/tests/ce/ce2111g.ada
! 9aac3a3d20f722d72f0a97d15db7e6ff  gcc/testsuite/ada/acats/tests/ce/ce2111i.ada
! 451691c716142d6af52540932182f7a8  gcc/testsuite/ada/acats/tests/ce/ce2201a.ada
! a9019ab5c60383a5aec6b4e12cf67546  gcc/testsuite/ada/acats/tests/ce/ce2201b.ada
! 29858e1a8a6dd46bb9164e8c8edbcddf  gcc/testsuite/ada/acats/tests/ce/ce2201c.ada
! 34d8b0e50b71bb424acf20936253736f  gcc/testsuite/ada/acats/tests/ce/ce2201d.dep
! b20fac24f54e723d0cc0d2b283a1a98c  gcc/testsuite/ada/acats/tests/ce/ce2201e.dep
! e5ef319f07f83742ea6dacb674de4c74  gcc/testsuite/ada/acats/tests/ce/ce2201f.ada
! 89d1575c20871ec14a7510e2c7fd7e56  gcc/testsuite/ada/acats/tests/ce/ce2201g.ada
! 06e274ba9cfdca457d343f7d036af0bc  gcc/testsuite/ada/acats/tests/ce/ce2201h.ada
! 819625912e63f1bb0690319469d91d14  gcc/testsuite/ada/acats/tests/ce/ce2201i.ada
! c75df2290aa04176fd8862e092446183  gcc/testsuite/ada/acats/tests/ce/ce2201j.ada
! 5cd3fabcbac1ce5f97eb0c3b7ff68060  gcc/testsuite/ada/acats/tests/ce/ce2201k.ada
! 5f85b515f14775082f0cef057e6c7cec  gcc/testsuite/ada/acats/tests/ce/ce2201l.ada
! dacbb7d19d52906e970100c8a0524fd4  gcc/testsuite/ada/acats/tests/ce/ce2201m.ada
! 45f176910989cfdcd7fdc941f37a5b71  gcc/testsuite/ada/acats/tests/ce/ce2201n.ada
! 376cc7edaf46154ca8f65652b5d6eca4  gcc/testsuite/ada/acats/tests/ce/ce2202a.ada
! 939f3ce3a39c9ca9d86e52320f27ff2c  gcc/testsuite/ada/acats/tests/ce/ce2203a.tst
! ba04f29f243a15d2bbe413b9e0066901  gcc/testsuite/ada/acats/tests/ce/ce2204a.ada
! 2fc36a0b7b4ddb630b023af7c4d90ba7  gcc/testsuite/ada/acats/tests/ce/ce2204b.ada
! 9ef6a168f2e294541459fe7a14263eb5  gcc/testsuite/ada/acats/tests/ce/ce2204c.ada
! b0274d08b84af4b62ad59e3d9ddb07df  gcc/testsuite/ada/acats/tests/ce/ce2204d.ada
! 34418b28be06a3924c3a2584bef259b6  gcc/testsuite/ada/acats/tests/ce/ce2205a.ada
! 5c92fac63d085e6a68726106d482ea42  gcc/testsuite/ada/acats/tests/ce/ce2206a.ada
! fcc7c7c24b495ce3ddaa0f9a580d75ee  gcc/testsuite/ada/acats/tests/ce/ce2208b.ada
! 97568e8cf63e0507c14b35a1a14e20c0  gcc/testsuite/ada/acats/tests/ce/ce2401a.ada
! dcd9e7cbbd7e97c5dd3e3add1eb9dc36  gcc/testsuite/ada/acats/tests/ce/ce2401b.ada
! efcdb258c81995c38e8cc3694b22f6dd  gcc/testsuite/ada/acats/tests/ce/ce2401c.ada
! e7f9dbd6fea160401601272d061289a3  gcc/testsuite/ada/acats/tests/ce/ce2401e.ada
! 1bf5badbcde77492314acef836d8ea11  gcc/testsuite/ada/acats/tests/ce/ce2401f.ada
! eb673da58247c955773ce3b8e1c2d4f3  gcc/testsuite/ada/acats/tests/ce/ce2401h.ada
! 6918301d4740c9f3a5bcdf8763ba341a  gcc/testsuite/ada/acats/tests/ce/ce2401i.ada
! 664a2145b5105ab8ae94b8ba8dca5cdd  gcc/testsuite/ada/acats/tests/ce/ce2401j.ada
! 7f54c0274e46b59b1fec8510f4fc3ad7  gcc/testsuite/ada/acats/tests/ce/ce2401k.ada
! a83a38fe98395d0bb886cb6143eb8170  gcc/testsuite/ada/acats/tests/ce/ce2401l.ada
! 2c4e89aba46a0152400d53a9aed78ba8  gcc/testsuite/ada/acats/tests/ce/ce2402a.ada
! 4e54cd3fcd15e2f31d844365222a85b3  gcc/testsuite/ada/acats/tests/ce/ce2403a.tst
! 4fce3b03a76a452b2433c54b199834ff  gcc/testsuite/ada/acats/tests/ce/ce2404a.ada
! ad81e45a71e09a3713483ae198eae6b0  gcc/testsuite/ada/acats/tests/ce/ce2404b.ada
! 397eb6a738bd1fb16bf404d4581a21e8  gcc/testsuite/ada/acats/tests/ce/ce2405b.ada
! 035cdd8af2147f386ba98eafee6fa53d  gcc/testsuite/ada/acats/tests/ce/ce2406a.ada
! bc1c3fb660e3a1a6cd3c3cd2c20c6f21  gcc/testsuite/ada/acats/tests/ce/ce2407a.ada
! e21a045af5825bcf7bae0f7774bf28bb  gcc/testsuite/ada/acats/tests/ce/ce2407b.ada
! 1ac50c952fbab2fcf2e1391bb697aac1  gcc/testsuite/ada/acats/tests/ce/ce2408a.ada
! fb58d51e1570b9726aa28d10034cf135  gcc/testsuite/ada/acats/tests/ce/ce2408b.ada
! d60b98c48fae643e51060dfd4200371e  gcc/testsuite/ada/acats/tests/ce/ce2409a.ada
! 5b25842de422c3e8d6301447c51d8985  gcc/testsuite/ada/acats/tests/ce/ce2409b.ada
! e03ae0d17d4ce186bb17ad28c1d12c8e  gcc/testsuite/ada/acats/tests/ce/ce2410a.ada
! a10dc12fca4ab67d0e070b8f08878918  gcc/testsuite/ada/acats/tests/ce/ce2410b.ada
! ef01f4584aa6fe18dfca4291aa2b9936  gcc/testsuite/ada/acats/tests/ce/ce2411a.ada
! cfdd50459f606dfd0272b27f902831f0  gcc/testsuite/ada/acats/tests/ce/ce3002b.tst
! 8c7a2401c3fd65042aaf7fbaaebb05d5  gcc/testsuite/ada/acats/tests/ce/ce3002c.tst
! 60cfa1b0514071feae57d422f407bbc6  gcc/testsuite/ada/acats/tests/ce/ce3002d.ada
! f7f30f9bace21926cfd024ab3ae7ed4a  gcc/testsuite/ada/acats/tests/ce/ce3002f.ada
! c4f22dddebf62a993e9a5dca37748e9a  gcc/testsuite/ada/acats/tests/ce/ce3102a.ada
! 019efa14311a98e7532962ec6464bb8e  gcc/testsuite/ada/acats/tests/ce/ce3102b.tst
! dab3a80b1760df07e4cf44cef4f9ca81  gcc/testsuite/ada/acats/tests/ce/ce3102d.ada
! 112884bd382c35480c4248866f3a556e  gcc/testsuite/ada/acats/tests/ce/ce3102e.ada
! 884f6ff3272bb27974b5c059fd940eb8  gcc/testsuite/ada/acats/tests/ce/ce3102f.ada
! 561a9bb3212245b35ea37ed7834ace08  gcc/testsuite/ada/acats/tests/ce/ce3102g.ada
! a5c10d55f5c631bb605e9f92f33b3d83  gcc/testsuite/ada/acats/tests/ce/ce3102h.ada
! 16f9be98787f36d98dd3a0d7c5673f99  gcc/testsuite/ada/acats/tests/ce/ce3102i.ada
! f2fb4988c4b17b901cb57756fa48524d  gcc/testsuite/ada/acats/tests/ce/ce3102j.ada
! 5885ee3beb2611070afd9595b92d024d  gcc/testsuite/ada/acats/tests/ce/ce3102k.ada
! af4fce15977e583c9580c84a57f46000  gcc/testsuite/ada/acats/tests/ce/ce3103a.ada
! 1a359b00af85a86ae636ed8ce9f54011  gcc/testsuite/ada/acats/tests/ce/ce3104a.ada
! 62ae4a6a702993a429980ed85d7d288b  gcc/testsuite/ada/acats/tests/ce/ce3104b.ada
! 3097f1866f5a1a12edc0bd1ad06fcfd7  gcc/testsuite/ada/acats/tests/ce/ce3104c.ada
! ffdd7cea02bf78362b21d5b47923f55a  gcc/testsuite/ada/acats/tests/ce/ce3106a.ada
! c089188b0086e9498b16c61338d1c72e  gcc/testsuite/ada/acats/tests/ce/ce3106b.ada
! 7ec91be55117ceec515d06ff18fd96f6  gcc/testsuite/ada/acats/tests/ce/ce3107a.tst
! 29791bc75974606a36e491a742bb3096  gcc/testsuite/ada/acats/tests/ce/ce3107b.ada
! eb49ffd6a23ce40400cdc2ebf0c8f371  gcc/testsuite/ada/acats/tests/ce/ce3108a.ada
! fd863ff6b1661c6c912d9bf6aebc3bc9  gcc/testsuite/ada/acats/tests/ce/ce3108b.ada
! 97e280eb5834dec4e91bbbc97553b1c7  gcc/testsuite/ada/acats/tests/ce/ce3110a.ada
! 5f42a55944d863fa57d6e12253d4922c  gcc/testsuite/ada/acats/tests/ce/ce3112c.ada
! c9d44fa9ff3ca5a2ccdda83b010c1f54  gcc/testsuite/ada/acats/tests/ce/ce3112d.ada
! f01486f7b41b7e9bb285f2b42444a64f  gcc/testsuite/ada/acats/tests/ce/ce3114a.ada
! 816907364fd976b617fbee2dc8afc858  gcc/testsuite/ada/acats/tests/ce/ce3115a.ada
! 55427ea93a85e61592244d314238e089  gcc/testsuite/ada/acats/tests/ce/ce3201a.ada
! 0a50773e8cb26d94c11adb5533460429  gcc/testsuite/ada/acats/tests/ce/ce3202a.ada
! 06b5bbb44e688a3c0c0ca62e655c32ab  gcc/testsuite/ada/acats/tests/ce/ce3206a.ada
! 98a3e7772f00a7bebd187c6c2d309f82  gcc/testsuite/ada/acats/tests/ce/ce3207a.ada
! f4529439e526335f9525bb157863cc63  gcc/testsuite/ada/acats/tests/ce/ce3301a.ada
! 0a70a8ac8ee35a84b380c07ea541b57f  gcc/testsuite/ada/acats/tests/ce/ce3302a.ada
! 9bac0e06cef0c10689cc849f3c509fcf  gcc/testsuite/ada/acats/tests/ce/ce3303a.ada
! 23c77e761edd8a91671acf3422a0ca06  gcc/testsuite/ada/acats/tests/ce/ce3304a.tst
! d0da64618db56f4abfac0c3b90fa0296  gcc/testsuite/ada/acats/tests/ce/ce3305a.ada
! 3f7e70ff0a93058dd780e3e6e4fefa3d  gcc/testsuite/ada/acats/tests/ce/ce3306a.ada
! 4e1329f66825e0283637c00ca6acc5b6  gcc/testsuite/ada/acats/tests/ce/ce3401a.ada
! df06c67b3b1ea125ef98d5346e81cc7e  gcc/testsuite/ada/acats/tests/ce/ce3402a.ada
! b50c12a694c3c56d3a2cf04d9ca9ccc3  gcc/testsuite/ada/acats/tests/ce/ce3402c.ada
! e2743c970635e3ead26ba550e6c23aab  gcc/testsuite/ada/acats/tests/ce/ce3402d.ada
! c0341031211c513d8c748c61167125fb  gcc/testsuite/ada/acats/tests/ce/ce3402e.ada
! f9deacf7d49917900f3fcee43aee5ca6  gcc/testsuite/ada/acats/tests/ce/ce3403a.ada
! fec31596c967bb1bab6a046e32225c6b  gcc/testsuite/ada/acats/tests/ce/ce3403b.ada
! 7e9202e07d3f865f2ceeb151792c452f  gcc/testsuite/ada/acats/tests/ce/ce3403c.ada
! 64070608c4f9c6a05d1e23408e5beb0d  gcc/testsuite/ada/acats/tests/ce/ce3403d.ada
! d82cac6d273d1fbe65506c1eecff04b9  gcc/testsuite/ada/acats/tests/ce/ce3403e.ada
! 7cdc9d7a9c43884cbedbde28d4954fe4  gcc/testsuite/ada/acats/tests/ce/ce3403f.ada
! dc1a67476ce793079c7af8b2d1b275ac  gcc/testsuite/ada/acats/tests/ce/ce3404a.ada
! 8b982e428bef61a3980b00b8079ad4f2  gcc/testsuite/ada/acats/tests/ce/ce3404b.ada
! 5cc2fbe64ade8df5eced5c397a38020a  gcc/testsuite/ada/acats/tests/ce/ce3404c.ada
! 871605306e645bb8c8952539a05637b2  gcc/testsuite/ada/acats/tests/ce/ce3404d.ada
! 5afe1fa2e94e304b32849dad526b0cb4  gcc/testsuite/ada/acats/tests/ce/ce3405a.ada
! 75e7f1f2e2d338bdbc593c460b1e055f  gcc/testsuite/ada/acats/tests/ce/ce3405c.ada
! d61f321bab45f725f89da9ebd98c7959  gcc/testsuite/ada/acats/tests/ce/ce3405d.ada
! 683881439899376dec46462b7b974e93  gcc/testsuite/ada/acats/tests/ce/ce3406a.ada
! 1d67a6840b438185a99382b830ffe815  gcc/testsuite/ada/acats/tests/ce/ce3406b.ada
! 00a1933b7205d0378d065989609d0e6f  gcc/testsuite/ada/acats/tests/ce/ce3406c.ada
! bc8a2b4d509e438b111cb451ba6c633d  gcc/testsuite/ada/acats/tests/ce/ce3406d.ada
! 0c8f9906304b5f6e2f871a2f56543e48  gcc/testsuite/ada/acats/tests/ce/ce3407a.ada
! d6da13ff2e3c07bb7f9617a04f387915  gcc/testsuite/ada/acats/tests/ce/ce3407b.ada
! bacd5248d5883ef91439cbdd245cbd9a  gcc/testsuite/ada/acats/tests/ce/ce3407c.ada
! babb7fd82795ea56950eb78715c895aa  gcc/testsuite/ada/acats/tests/ce/ce3408a.ada
! e30520b348614e4a8e628b3ea3aad54e  gcc/testsuite/ada/acats/tests/ce/ce3408b.ada
! 5d1d893ced6dbc7d9f25ee4a5fb8e211  gcc/testsuite/ada/acats/tests/ce/ce3408c.ada
! ca268135b5b6d64dc8be3768b6f7edc0  gcc/testsuite/ada/acats/tests/ce/ce3409a.ada
! 6c79cafc53b26bfb3c462c4d01969806  gcc/testsuite/ada/acats/tests/ce/ce3409b.ada
! 153c9a6d9246f682a42cd95552087944  gcc/testsuite/ada/acats/tests/ce/ce3409c.ada
! 62ed81bdf1e56f27f4c2630b320c6b75  gcc/testsuite/ada/acats/tests/ce/ce3409d.ada
! 67051865f07afe2038f84683dece3683  gcc/testsuite/ada/acats/tests/ce/ce3409e.ada
! 36c2b6db90b30d1e89dfe642110ca9be  gcc/testsuite/ada/acats/tests/ce/ce3410a.ada
! 5cf308b315cd2ac4c47ecb7409ef0ba1  gcc/testsuite/ada/acats/tests/ce/ce3410b.ada
! bcebb594f14a81961460c696159ea641  gcc/testsuite/ada/acats/tests/ce/ce3410c.ada
! c28a6aea6e2fa07f6b2e23e3e14876c2  gcc/testsuite/ada/acats/tests/ce/ce3410d.ada
! 8c67058f9e7fc008e387aa622534b5d4  gcc/testsuite/ada/acats/tests/ce/ce3410e.ada
! 4c3d96fe2a475d4a97d07bbd385cd260  gcc/testsuite/ada/acats/tests/ce/ce3411a.ada
! 0a0deabd5d66c7e62d00da0c83ac5dfa  gcc/testsuite/ada/acats/tests/ce/ce3411c.ada
! a8dda42826e8174f0657de7379cb605b  gcc/testsuite/ada/acats/tests/ce/ce3412a.ada
! 040ce75a5a909fb3da32ae0e451bda3e  gcc/testsuite/ada/acats/tests/ce/ce3413a.ada
! 951c9393706295621e4a78e9a1b9e2ee  gcc/testsuite/ada/acats/tests/ce/ce3413b.ada
! c33c707be5a9051ad8c6962035162e25  gcc/testsuite/ada/acats/tests/ce/ce3413c.ada
! 6cb9f4f71827deb077bcc1180c854625  gcc/testsuite/ada/acats/tests/ce/ce3414a.ada
! e5e2298148250ece65cc736cf86b5a00  gcc/testsuite/ada/acats/tests/ce/ce3601a.ada
! 1215dc7327db7704c21d367fe12a1ab9  gcc/testsuite/ada/acats/tests/ce/ce3602a.ada
! 6ccbba350556793177123ad7809e0ff9  gcc/testsuite/ada/acats/tests/ce/ce3602b.ada
! 12843cf2e9816b955ca7962f9bfc627f  gcc/testsuite/ada/acats/tests/ce/ce3602c.ada
! cef84bc67c1c6c0d7583ed454834a34f  gcc/testsuite/ada/acats/tests/ce/ce3602d.ada
! 5e31687529c52bde6efe93242bcbf2f8  gcc/testsuite/ada/acats/tests/ce/ce3603a.ada
! 3dc38686e9ce99632f9e21e584055443  gcc/testsuite/ada/acats/tests/ce/ce3604a.ada
! 98f98beec04bb6905ddea16ed212134f  gcc/testsuite/ada/acats/tests/ce/ce3604b.ada
! 1c7074f06be7b99dab79f14d5dddb060  gcc/testsuite/ada/acats/tests/ce/ce3605a.ada
! 49a30d4306b467f2cd10d4b811cfa231  gcc/testsuite/ada/acats/tests/ce/ce3605b.ada
! b496a8c56eea6c0501a70a96873353f7  gcc/testsuite/ada/acats/tests/ce/ce3605c.ada
! 6f3fe3a52cae3aa00e90c34391f3d16d  gcc/testsuite/ada/acats/tests/ce/ce3605d.ada
! 86bd1f46afec2bf13df76bd0d8ce0514  gcc/testsuite/ada/acats/tests/ce/ce3605e.ada
! 8388e3c1abd488ed32c198647fab80fe  gcc/testsuite/ada/acats/tests/ce/ce3606a.ada
! b3c475457035678aad225b02f0baaf49  gcc/testsuite/ada/acats/tests/ce/ce3606b.ada
! c0471531dea8b138d096c3049a710d34  gcc/testsuite/ada/acats/tests/ce/ce3701a.ada
! 918eb1c7abfa51f1d0f0920c8c6305e7  gcc/testsuite/ada/acats/tests/ce/ce3704a.ada
! fd0817427cf4c02d336138b11d6153a8  gcc/testsuite/ada/acats/tests/ce/ce3704b.ada
! 7fe37fdc40a516882c3388c9405adb57  gcc/testsuite/ada/acats/tests/ce/ce3704c.ada
! 9fb3d924d4a90f6940ec5e4b11a0ce61  gcc/testsuite/ada/acats/tests/ce/ce3704d.ada
! b5466a70b0554788bcffce4b777d7bbd  gcc/testsuite/ada/acats/tests/ce/ce3704e.ada
! 2bd3e088ed3663d0f57172ec9878402c  gcc/testsuite/ada/acats/tests/ce/ce3704f.ada
! c1b7a44976ea643f0821318848d2a333  gcc/testsuite/ada/acats/tests/ce/ce3704m.ada
! fbb2cb08fa9bd676488ed39c0025017d  gcc/testsuite/ada/acats/tests/ce/ce3704n.ada
! ddc6d31452157a248e0315438e717892  gcc/testsuite/ada/acats/tests/ce/ce3704o.ada
! 0f3f07ab9439af00921be7fba20ce330  gcc/testsuite/ada/acats/tests/ce/ce3705a.ada
! 3be84deb5cb9f6d5be7c2cadf68a90f5  gcc/testsuite/ada/acats/tests/ce/ce3705b.ada
! 11a056cf164688fbe30b1b1a85208e47  gcc/testsuite/ada/acats/tests/ce/ce3705c.ada
! e6e83df07a3fab385c58b17a0a43ca83  gcc/testsuite/ada/acats/tests/ce/ce3705d.ada
! c1458b663e297c80390f9cd80c7f5864  gcc/testsuite/ada/acats/tests/ce/ce3705e.ada
! fab53328469c600d972529f33eecee23  gcc/testsuite/ada/acats/tests/ce/ce3706c.ada
! aed136cb2863502616daa378424686d6  gcc/testsuite/ada/acats/tests/ce/ce3706d.ada
! 6344fa066f047ece7e15a9dc9dc4bf76  gcc/testsuite/ada/acats/tests/ce/ce3706f.ada
! 5316d57b3ad4c2e7fdcfa4dcf7de4439  gcc/testsuite/ada/acats/tests/ce/ce3706g.ada
! a778f4b7a5f926d446e0a70ffc718db8  gcc/testsuite/ada/acats/tests/ce/ce3707a.ada
! 478e73d32be1e76a0099cd9a73da79c0  gcc/testsuite/ada/acats/tests/ce/ce3708a.ada
! 818f2f0d5fcc6bdd1c354cc85b1e6640  gcc/testsuite/ada/acats/tests/ce/ce3801a.ada
! 6dc388aa9640dfd68a016a87aedb4e9b  gcc/testsuite/ada/acats/tests/ce/ce3801b.ada
! e7b36818b6b1f0625c96af8481f52f0d  gcc/testsuite/ada/acats/tests/ce/ce3804a.ada
! c3922fdc4d7bd246e803dbcf29ec365b  gcc/testsuite/ada/acats/tests/ce/ce3804b.ada
! eae67ccfbe2e51d92e77fbd2aefd9279  gcc/testsuite/ada/acats/tests/ce/ce3804c.ada
! b6842219efec21bda3be0c99f4cc04b4  gcc/testsuite/ada/acats/tests/ce/ce3804d.ada
! 9eef715602b30b1986cd238ae1f5fc61  gcc/testsuite/ada/acats/tests/ce/ce3804e.ada
! c5996f22c17f572bd9ab7181c9c39831  gcc/testsuite/ada/acats/tests/ce/ce3804f.ada
! 613171f59b0c0405911c4d928abfb0b4  gcc/testsuite/ada/acats/tests/ce/ce3804g.ada
! d992e56c7b48881cc7480a014ee01ce9  gcc/testsuite/ada/acats/tests/ce/ce3804h.ada
! a78767becb4aa2f884469056ae3d7ec4  gcc/testsuite/ada/acats/tests/ce/ce3804i.ada
! a4e5e33e2585ba61ae7ae7ae4db12bb2  gcc/testsuite/ada/acats/tests/ce/ce3804j.ada
! e6928c085b0205ec7db55a9f830ccdd0  gcc/testsuite/ada/acats/tests/ce/ce3804m.ada
! 7193594f0a1b29b3c2845bdce32c53e7  gcc/testsuite/ada/acats/tests/ce/ce3804o.ada
! 4a0b48b429236f9e1c8e6f58dd3bfa28  gcc/testsuite/ada/acats/tests/ce/ce3804p.ada
! 9ac3d952f3c355af267e6a6d9f4a8a79  gcc/testsuite/ada/acats/tests/ce/ce3805a.ada
! c7fd8ecaab44034a4d7e19eaf52d3390  gcc/testsuite/ada/acats/tests/ce/ce3805b.ada
! 1aab796cf0e7689c6edac441d619d28e  gcc/testsuite/ada/acats/tests/ce/ce3806a.ada
! 2e9a765636a0e1133cc203d0def8724d  gcc/testsuite/ada/acats/tests/ce/ce3806b.ada
! bc5e903902196b77527b50b767c2d7da  gcc/testsuite/ada/acats/tests/ce/ce3806c.ada
! ee7b548143b3610a6b8d3fdd4698dc45  gcc/testsuite/ada/acats/tests/ce/ce3806d.ada
! 4ef742156a97e0838a7c68579a62465c  gcc/testsuite/ada/acats/tests/ce/ce3806e.ada
! 48eed75e47db04066ee57577ae8febdf  gcc/testsuite/ada/acats/tests/ce/ce3806f.ada
! fae283383fb9395ac865027e5ecb9495  gcc/testsuite/ada/acats/tests/ce/ce3806g.ada
! 9d6687f5803bfad7ea35a3abcdb5772c  gcc/testsuite/ada/acats/tests/ce/ce3806h.ada
! d3af3076cdba08b0142afed2e6fc0b7b  gcc/testsuite/ada/acats/tests/ce/ce3809a.ada
! 2144655343ab8e0671768264f1de7939  gcc/testsuite/ada/acats/tests/ce/ce3809b.ada
! 94c3af83ea38d2552587ed3285a692b6  gcc/testsuite/ada/acats/tests/ce/ce3810a.ada
! 2b16f8d4e554f10c2a187f8308d7c631  gcc/testsuite/ada/acats/tests/ce/ce3810b.ada
! d426db9733cc34265b461b792b6474ad  gcc/testsuite/ada/acats/tests/ce/ce3815a.ada
! 48a18490ee8614f76691210dd9487c7b  gcc/testsuite/ada/acats/tests/ce/ce3901a.ada
! c0b5bdc86cdd66cb3f89cb34da6bafc6  gcc/testsuite/ada/acats/tests/ce/ce3902b.ada
! a2d6108b8d0296883e3c658639d13b49  gcc/testsuite/ada/acats/tests/ce/ce3904a.ada
! 379cd7598f79bae2f05b0815465e285f  gcc/testsuite/ada/acats/tests/ce/ce3904b.ada
! 49a69ee3b18484263b6f081df965ab54  gcc/testsuite/ada/acats/tests/ce/ce3905a.ada
! c53bbe9b612250e0e99c4238d30a2004  gcc/testsuite/ada/acats/tests/ce/ce3905b.ada
! 72f61386b7953b00b7cff52dfbc382c2  gcc/testsuite/ada/acats/tests/ce/ce3905c.ada
! 2ef4e950bf19d740d3354feb5811b645  gcc/testsuite/ada/acats/tests/ce/ce3905l.ada
! 68ee2e176861f501ee862916a0b9b86e  gcc/testsuite/ada/acats/tests/ce/ce3906a.ada
! d47ad5ee4c0a4fdbf2ea42a44fe42621  gcc/testsuite/ada/acats/tests/ce/ce3906b.ada
! 695b6968a4b0e7d53b5b76fb4f7da0c0  gcc/testsuite/ada/acats/tests/ce/ce3906c.ada
! 90d21e5ea4be7a236bfb40661d560471  gcc/testsuite/ada/acats/tests/ce/ce3906d.ada
! 3462bab257d5dd10bcb9c56813aa1e74  gcc/testsuite/ada/acats/tests/ce/ce3906e.ada
! 2c106bf46db6d9c4c50c01fbe92b517f  gcc/testsuite/ada/acats/tests/ce/ce3906f.ada
! 7c41fbcef2ed668ee19c73f44c696bac  gcc/testsuite/ada/acats/tests/ce/ce3907a.ada
! ee7ec1f6b6ec4c5ef50b1d777026421a  gcc/testsuite/ada/acats/tests/ce/ce3908a.ada
! c4b3b8c1c9564099bdde092389cc2da4  gcc/testsuite/ada/acats/tests/cxa/cxa3001.a
! edb7feb6536121adfd4fd4a2f3d69a3f  gcc/testsuite/ada/acats/tests/cxa/cxa3002.a
! 48392592efa08a198d6e5d7a1a663683  gcc/testsuite/ada/acats/tests/cxa/cxa3003.a
! 7eb11ccdd82615be75ded3c2d5c126d1  gcc/testsuite/ada/acats/tests/cxa/cxa3004.a
! c2cd47ca8ea76b3292a67ce38ad89e35  gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
! 448cbac61205b8887f79bf74d5666a04  gcc/testsuite/ada/acats/tests/cxa/cxa4002.a
! 46d3d97d6347f9b5ec34b3513bcfab40  gcc/testsuite/ada/acats/tests/cxa/cxa4003.a
! 76c3b922526644795e2203573ee488e2  gcc/testsuite/ada/acats/tests/cxa/cxa4004.a
! 4b1514a00cc831e1766e0d36c67e271f  gcc/testsuite/ada/acats/tests/cxa/cxa4005.a
! dcde2eda6ce0a916997883996641ea19  gcc/testsuite/ada/acats/tests/cxa/cxa4006.a
! f528eee5266ffb815aad7b653d5be870  gcc/testsuite/ada/acats/tests/cxa/cxa4007.a
! 413d98fa6eff56c6b83c031c575fd9a6  gcc/testsuite/ada/acats/tests/cxa/cxa4008.a
! d2a3c398ae82b68c1544dbf3384095d7  gcc/testsuite/ada/acats/tests/cxa/cxa4009.a
! bc90a16063bf97bfeb414d4209261109  gcc/testsuite/ada/acats/tests/cxa/cxa4010.a
! b3036ab386ac3ec1d7b58cd50ad31ab9  gcc/testsuite/ada/acats/tests/cxa/cxa4011.a
! 06c61ebbffe294301eb79bc3d5e27c54  gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
! ce3338d13ed9dd0ef83c04e53bed831e  gcc/testsuite/ada/acats/tests/cxa/cxa4013.a
! 0a9e62befb3d93c2c5e8ab93a327a6c2  gcc/testsuite/ada/acats/tests/cxa/cxa4014.a
! aad5ca617d2e40d20e448b613199553e  gcc/testsuite/ada/acats/tests/cxa/cxa4015.a
! 33c5aafe5935daee003a8246d048e812  gcc/testsuite/ada/acats/tests/cxa/cxa4016.a
! d2ac40847abc81d20163d7c521a90575  gcc/testsuite/ada/acats/tests/cxa/cxa4017.a
! 81384a047e321f48d7a9ae881a426324  gcc/testsuite/ada/acats/tests/cxa/cxa4018.a
! 334665c1cb55150c5c9af5013690044a  gcc/testsuite/ada/acats/tests/cxa/cxa4019.a
! c1bd4452ee22a8a6db5adbef47a641cc  gcc/testsuite/ada/acats/tests/cxa/cxa4020.a
! a570e64728464b5d7b98abf94a52b945  gcc/testsuite/ada/acats/tests/cxa/cxa4021.a
! ee35d8c6a0354f56770dd1aaf5f4d51e  gcc/testsuite/ada/acats/tests/cxa/cxa4022.a
! fc34d10875377b841a1d6172f334da36  gcc/testsuite/ada/acats/tests/cxa/cxa4023.a
! 19ec3ce920759c4a2037b89ae3061013  gcc/testsuite/ada/acats/tests/cxa/cxa4024.a
! 84b1823c491f3357731a977527457acf  gcc/testsuite/ada/acats/tests/cxa/cxa4025.a
! 254627e35c72d32a51b7db3824a622ea  gcc/testsuite/ada/acats/tests/cxa/cxa4026.a
! 0c20a4e5aa53f054deaa7ca01817db03  gcc/testsuite/ada/acats/tests/cxa/cxa4027.a
! 59f1d44db17d4f8454b983fa7c7b830b  gcc/testsuite/ada/acats/tests/cxa/cxa4028.a
! a05e073a2fe4ee6230e2a03d167ffce8  gcc/testsuite/ada/acats/tests/cxa/cxa4029.a
! eeef22827a8f3112fb9caff03c0003d3  gcc/testsuite/ada/acats/tests/cxa/cxa4030.a
! bb02ecad7593f15476885383704962db  gcc/testsuite/ada/acats/tests/cxa/cxa4031.a
! e272d6fb88a469d5600466803e241311  gcc/testsuite/ada/acats/tests/cxa/cxa4032.a
! 3f7248dd7e0876538e54ffc83eb5b9f9  gcc/testsuite/ada/acats/tests/cxa/cxa4033.a
! 90cfac79483d313e3e60ee66dd47bbb9  gcc/testsuite/ada/acats/tests/cxa/cxa4034.a
! d5b5e8186c886aee7a112ba901ef5b8c  gcc/testsuite/ada/acats/tests/cxa/cxa5011.a
! a67372b949970924bc0a9dd48dfc4999  gcc/testsuite/ada/acats/tests/cxa/cxa5012.a
! 1bc3b7995dbf8b972dd33ceccc5775f8  gcc/testsuite/ada/acats/tests/cxa/cxa5013.a
! 7f31584ea86307c534d43e91b8d28708  gcc/testsuite/ada/acats/tests/cxa/cxa5015.a
! ee786104570339c108786248363e8be5  gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a
! 59b52d99d8ad7539d9702fd5808604ab  gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a
! e58abfcc53f4c016f65e49a2e76c7c18  gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a
! 07803a06f2f6d9efa364537c4d61d56c  gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a
! 8beb99d4b6c77de021e0fb13ef712afc  gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a
! 4facff6e7577e863bfd71cfc8d80f4dc  gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a
! c3a4baf4aa21b446ccc93a6c7667de6a  gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a
! 6278088ddb4cadb7d9e5d09b9045b4b6  gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a
! cd7c58666aed347e740c0f6fd42f83d6  gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a
! ba78679b1a563e67c0076c1562ccf0f3  gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a
! 96b76cdb631cda2774fc81007f5ec5ee  gcc/testsuite/ada/acats/tests/cxa/cxa8001.a
! 367d7f0f5e6305bdd87092066759b0fa  gcc/testsuite/ada/acats/tests/cxa/cxa8002.a
! 620e6506d3b188143f95bf7e9e7c2a47  gcc/testsuite/ada/acats/tests/cxa/cxa8003.a
! 05afd117ada97a293f198e2915e5c6e6  gcc/testsuite/ada/acats/tests/cxa/cxa9001.a
! 720f2be5a9704866c7199912ce177ec5  gcc/testsuite/ada/acats/tests/cxa/cxa9002.a
! 0eda7d556ffc97096e8bf91c74b55ab0  gcc/testsuite/ada/acats/tests/cxa/cxaa001.a
! 77f8a73011b66fb0023f0f34e63b2b56  gcc/testsuite/ada/acats/tests/cxa/cxaa002.a
! 6251cdd5d4023378cc0f056006946d4b  gcc/testsuite/ada/acats/tests/cxa/cxaa003.a
! 43c30533c4d806156e62989d0b1f26b1  gcc/testsuite/ada/acats/tests/cxa/cxaa004.a
! a3c49183a05e7dd95a555b795d847cdb  gcc/testsuite/ada/acats/tests/cxa/cxaa005.a
! 083ebde448b287604a204632257a8037  gcc/testsuite/ada/acats/tests/cxa/cxaa006.a
! 0ba729490f0276e661094749d283895c  gcc/testsuite/ada/acats/tests/cxa/cxaa007.a
! a5ce4e509ce0ab296bcdd6ac1f1901c4  gcc/testsuite/ada/acats/tests/cxa/cxaa008.a
! 6230c5c5911d68e5e9b6f01dd03cb063  gcc/testsuite/ada/acats/tests/cxa/cxaa009.a
! ce752fa717d1efa1292cf1f5fa1d3e2e  gcc/testsuite/ada/acats/tests/cxa/cxaa010.a
! a1b9e04009fe651e52c78ec25d1e7e02  gcc/testsuite/ada/acats/tests/cxa/cxaa011.a
! 89d82c447c9f9e46ab8b9a1c63021ed6  gcc/testsuite/ada/acats/tests/cxa/cxaa012.a
! 1f2db7b6b53cd6eac4580863a696a7fd  gcc/testsuite/ada/acats/tests/cxa/cxaa013.a
! 2bf5156bd9e88fa709d6514444235132  gcc/testsuite/ada/acats/tests/cxa/cxaa014.a
! ed6390551c08d72768b222a3edb8cc65  gcc/testsuite/ada/acats/tests/cxa/cxaa015.a
! 9b3e529f8cb7b3fd77f82dd49f82a490  gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
! 7147f809c3aae79cfac85e734afed9c2  gcc/testsuite/ada/acats/tests/cxa/cxaa017.a
! cc1a3cfdd0d446ad5ae2882d5b1f089b  gcc/testsuite/ada/acats/tests/cxa/cxaa018.a
! 5a18624d0b2a25da41748146d45600fe  gcc/testsuite/ada/acats/tests/cxa/cxaa019.a
! 541118f0faae1cc95a1d90526336b620  gcc/testsuite/ada/acats/tests/cxa/cxab001.a
! 02e50f3257e2da0b2d211b9ed3e16791  gcc/testsuite/ada/acats/tests/cxa/cxac001.a
! 6788fdbde2fdac4a827fd20b38d8711b  gcc/testsuite/ada/acats/tests/cxa/cxac002.a
! bc2d4997d303b5a8cd8ac49ea128eabc  gcc/testsuite/ada/acats/tests/cxa/cxac003.a
! 0fed3fbdda367e73cc20e053e436b99f  gcc/testsuite/ada/acats/tests/cxa/cxac004.a
! c03fcfa6083accd85e20bd1ddecb7e8e  gcc/testsuite/ada/acats/tests/cxa/cxac005.a
! 1ea54203b702bc16f99a16da31812413  gcc/testsuite/ada/acats/tests/cxa/cxaca01.a
! 177daeac77a726a44c2f67d470718c26  gcc/testsuite/ada/acats/tests/cxa/cxaca02.a
! 56fc9878aa06e841c10ea2264f6970c0  gcc/testsuite/ada/acats/tests/cxa/cxacb01.a
! 66ac8f47c4a79c2e4c270e0af7e2e0ee  gcc/testsuite/ada/acats/tests/cxa/cxacb02.a
! 0709cbd75999d38ff1820f0252b56573  gcc/testsuite/ada/acats/tests/cxa/cxacc01.a
! e9b9a0663c6181302fffd99d8631f3de  gcc/testsuite/ada/acats/tests/cxa/cxaf001.a
! 74275581d2adcd2434f5e7957524b51c  gcc/testsuite/ada/acats/tests/cxb/cxb2001.a
! 801c8a35b2162f9c6264359249bbee69  gcc/testsuite/ada/acats/tests/cxb/cxb2002.a
! bf39b2f4f07ed6a4665a9dda2b002ff4  gcc/testsuite/ada/acats/tests/cxb/cxb2003.a
! 77c85b698809dbb5fb428e06a404c9b9  gcc/testsuite/ada/acats/tests/cxb/cxb3001.a
! 8359205e9055b8be1d9b6762d2ed3539  gcc/testsuite/ada/acats/tests/cxb/cxb3002.a
! 670fd9357c7c7cfa50297d22a291bf67  gcc/testsuite/ada/acats/tests/cxb/cxb3003.a
! 264fa1c95ae6b3be066613d5e0bfc39d  gcc/testsuite/ada/acats/tests/cxb/cxb30040.c
! 834af9fa57783899a0e35eb445000495  gcc/testsuite/ada/acats/tests/cxb/cxb30041.am
! 1f7e6c754cd6392302f6a73881265fcb  gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
! 47cb358f8b5c39994c472ca6162c0605  gcc/testsuite/ada/acats/tests/cxb/cxb30060.c
! 43769c5f0a9930881f7e0db2f6a8a256  gcc/testsuite/ada/acats/tests/cxb/cxb30061.am
! 593282429f5462d5ed18dcd8dcdb51d9  gcc/testsuite/ada/acats/tests/cxb/cxb3007.a
! f846172da7dd713a885e8d2a7d06687e  gcc/testsuite/ada/acats/tests/cxb/cxb3008.a
! d2f1180bb38e13d62efbd9773c8b157b  gcc/testsuite/ada/acats/tests/cxb/cxb3009.a
! 02b32c32297cd44b0d911f2b531c9313  gcc/testsuite/ada/acats/tests/cxb/cxb3010.a
! f8edfe848dc0c6e6f48662c52fb4967d  gcc/testsuite/ada/acats/tests/cxb/cxb3011.a
! 8a65d94bc5bfd4ba3ffa03803fd4161b  gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
! c26417c84de8dd0b5f98086031028262  gcc/testsuite/ada/acats/tests/cxb/cxb30130.c
! 6869325a6624cae77fa352805a94bdba  gcc/testsuite/ada/acats/tests/cxb/cxb30131.c
! f10ef865b96ee70575c8e209dd789a5d  gcc/testsuite/ada/acats/tests/cxb/cxb30132.am
! 1ddc4dd51346e5a28f96af27d7391476  gcc/testsuite/ada/acats/tests/cxb/cxb3014.a
! 95d8e46749c34da8a75a52eda38a1557  gcc/testsuite/ada/acats/tests/cxb/cxb3015.a
! 84585e09a73118e308ad940e05334954  gcc/testsuite/ada/acats/tests/cxb/cxb3016.a
! cbb79c5b42e78b77403051dad62e4b41  gcc/testsuite/ada/acats/tests/cxb/cxb4001.a
! fc709f860964cb89f985c7186e9f4747  gcc/testsuite/ada/acats/tests/cxb/cxb4002.a
! 4f684915a0877f5374cf11b630a78395  gcc/testsuite/ada/acats/tests/cxb/cxb4003.a
! 79754fe98b14164c0947685d39cacbb4  gcc/testsuite/ada/acats/tests/cxb/cxb4004.a
! 85a2ebed857909a39d337814747d6b8e  gcc/testsuite/ada/acats/tests/cxb/cxb4005.a
! 4082371e3fdf72189f00c59a748996d4  gcc/testsuite/ada/acats/tests/cxb/cxb4006.a
! 27abdc5551e4a8d82b4e9b0c64e5887b  gcc/testsuite/ada/acats/tests/cxb/cxb4007.a
! 8cddd50c9a17f7fc8660e979cbf02b3b  gcc/testsuite/ada/acats/tests/cxb/cxb4008.a
! 1b69eacf17c1c91c6952280f3412de5a  gcc/testsuite/ada/acats/tests/cxb/cxb5001.a
! c09620903bb91a1bb4eb42d58e681d41  gcc/testsuite/ada/acats/tests/cxb/cxb5002.a
! d523751f359c8b2cd39c46362a810f62  gcc/testsuite/ada/acats/tests/cxb/cxb5003.a
! 161785b3f8117f52fdfa5e2be103fe50  gcc/testsuite/ada/acats/tests/cxf/cxf1001.a
! 38832640106024eeab3e787b3e1abf12  gcc/testsuite/ada/acats/tests/cxf/cxf2001.a
! 6dbe0dc7ad8bcf924dea296b0e6d64f8  gcc/testsuite/ada/acats/tests/cxf/cxf2002.a
! df30106f75773ccdd081af9128456937  gcc/testsuite/ada/acats/tests/cxf/cxf2003.a
! bbdc713b858e164ba488b05b51a426d4  gcc/testsuite/ada/acats/tests/cxf/cxf2004.a
! 2853070456ab778051ae45509ef31700  gcc/testsuite/ada/acats/tests/cxf/cxf2005.a
! 5289a83b801532cadb9cfc8ca574144c  gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a
! ecb6f7270417d94e1c9636302e69e1fa  gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
! 2ffc00ccfb476a6822050bacce9f38f0  gcc/testsuite/ada/acats/tests/cxf/cxf3001.a
! 5dae288354cb87431755a88817dd365b  gcc/testsuite/ada/acats/tests/cxf/cxf3002.a
! afd49d16a5d04aec633505dca48b0d0a  gcc/testsuite/ada/acats/tests/cxf/cxf3003.a
! c6b3622a1e5b20d69719852a4082e8be  gcc/testsuite/ada/acats/tests/cxf/cxf3004.a
! 1aee0d4b0a06b7063d6235fc8d34096a  gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a
! 57064f6f477f169e4e55de947a9c929c  gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a
! 963266d142d788cf27f6a6c25463a3e4  gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a
! b0edb7a9a3f96101a217a11d890227d0  gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a
! fc92aa9ac0df0e5baa30ead02d831b57  gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a
! 64a24769c1369c7cfdee0cd6e259be8f  gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a
! 9713b92f0463d1404ffce0f6b1e500b0  gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a
! 1e8c052576f82ce44e874eaf39b880b2  gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a
! bb528e8b6f5a51fcb2c85de76f01ccd4  gcc/testsuite/ada/acats/tests/cxg/cxg1001.a
! 31d84efce5cb86f288a534683e15200a  gcc/testsuite/ada/acats/tests/cxg/cxg1002.a
! 5db4d9e6a4cf0ee61e3e4e4ea8093c4e  gcc/testsuite/ada/acats/tests/cxg/cxg1003.a
! 29704ab7c7c7a79f47511599cd5ea610  gcc/testsuite/ada/acats/tests/cxg/cxg1004.a
! 38c19bd2b8b49892b5a8468c5b781d26  gcc/testsuite/ada/acats/tests/cxg/cxg1005.a
! 814368ba96fd7e4cf439f579d9e94c81  gcc/testsuite/ada/acats/tests/cxg/cxg2001.a
! 691b89d2d22e78fce3d8ce8190aceac5  gcc/testsuite/ada/acats/tests/cxg/cxg2002.a
! fd15930c996abc004ebe5f623f8d7e3e  gcc/testsuite/ada/acats/tests/cxg/cxg2003.a
! 9c7ebf167f5adb4ad817f1cfaad15b1e  gcc/testsuite/ada/acats/tests/cxg/cxg2004.a
! 19538696a45a5cd61915e552c0159e21  gcc/testsuite/ada/acats/tests/cxg/cxg2005.a
! b5a9cd918ec505f80bffd4b8d3f81fb7  gcc/testsuite/ada/acats/tests/cxg/cxg2006.a
! d118b202244475fa2d6637a5102c8793  gcc/testsuite/ada/acats/tests/cxg/cxg2007.a
! 911e82a1ca3377a813732860a0062312  gcc/testsuite/ada/acats/tests/cxg/cxg2008.a
! 4fad0b52dda14d215336cc1cd38b7f03  gcc/testsuite/ada/acats/tests/cxg/cxg2009.a
! a7f0790bd1f4db62bb1f94f90b403cca  gcc/testsuite/ada/acats/tests/cxg/cxg2010.a
! 2e25178ea5e5552c5343ba6d8584ba74  gcc/testsuite/ada/acats/tests/cxg/cxg2011.a
! f61b0c35864b0aa5527d3e4a3e81e779  gcc/testsuite/ada/acats/tests/cxg/cxg2012.a
! 1b99769a37ef9c2b58f43910fdd00e6b  gcc/testsuite/ada/acats/tests/cxg/cxg2013.a
! 481025f4913d9ffb0c1ff442b9870591  gcc/testsuite/ada/acats/tests/cxg/cxg2014.a
! 79eb7ca23122446b9f31a5f4d6f8fbc7  gcc/testsuite/ada/acats/tests/cxg/cxg2015.a
! d1362a6e008edbda6db26e148303f3d0  gcc/testsuite/ada/acats/tests/cxg/cxg2016.a
! 84a228b85aa2b3a442a702cb5cf99e63  gcc/testsuite/ada/acats/tests/cxg/cxg2017.a
! db5d4af0d0f84dcaf031081f41020e4a  gcc/testsuite/ada/acats/tests/cxg/cxg2018.a
! 6ca3da628f7936107fe1fd235da62e61  gcc/testsuite/ada/acats/tests/cxg/cxg2019.a
! d8efe67bfdf82292c98f593e60cace57  gcc/testsuite/ada/acats/tests/cxg/cxg2020.a
! 53b94c96558a199ee91e9e94e92f6e6e  gcc/testsuite/ada/acats/tests/cxg/cxg2021.a
! 44df5fa53bb68ac9be22c5db9adb9c5e  gcc/testsuite/ada/acats/tests/cxg/cxg2022.a
! 86432328beb230d12c30455a5259108f  gcc/testsuite/ada/acats/tests/cxg/cxg2023.a
! 7b9353c95978924cfa8ffca95bd2472f  gcc/testsuite/ada/acats/tests/cxg/cxg2024.a
! 4aedd99c5e7383826785e110132437b0  gcc/testsuite/ada/acats/tests/cxh/cxh3001.a
! 30e3860e9003591085363de238d2c0f8  gcc/testsuite/ada/acats/tests/cxh/cxh3002.a
! 2f97ad7e05c98ee16642183b60fb702b  gcc/testsuite/ada/acats/tests/cxh/cxh30030.a
! 726c3a5559867c336b3e41053357bee8  gcc/testsuite/ada/acats/tests/cxh/cxh30031.am
! 5812c7613bb171e922984de8ed304306  gcc/testsuite/ada/acats/tests/cz/cz1101a.ada
! f4be18c06fbff775151b0c6fe4f18831  gcc/testsuite/ada/acats/tests/cz/cz1102a.ada
! 1a17d44787330941af6e6eb9b2f5fdac  gcc/testsuite/ada/acats/tests/cz/cz1103a.ada
! 4fbac816abd03239d980e03cee911122  gcc/testsuite/ada/acats/tests/d/d4a002a.ada
! 9fc88c362bc5e3ac1038838ce2e31e1d  gcc/testsuite/ada/acats/tests/d/d4a002b.ada
! 512d36027df5b67cad136178dabfe4a2  gcc/testsuite/ada/acats/tests/d/d4a004a.ada
! 22af18afdcf3a383d8100e7290a1c40c  gcc/testsuite/ada/acats/tests/d/d4a004b.ada
! 605dc6f15a51dd750ab6fdf7ddcb65a6  gcc/testsuite/ada/acats/tests/e/e28002b.ada
! de9f0ecd5c9bafad769c8b2264e38499  gcc/testsuite/ada/acats/tests/e/e28005d.ada
! 3cacc87e4376898f97bc3ad35305e3b0  gcc/testsuite/ada/acats/tests/e/e52103y.ada
! c92c30f9076000218a22d41126403c34  gcc/testsuite/ada/acats/tests/e/eb4011a.ada
! deba1575fb8b252064041e5d408f53a3  gcc/testsuite/ada/acats/tests/e/eb4012a.ada
! 08131f4b11da03c32ca002338f3e4a59  gcc/testsuite/ada/acats/tests/e/eb4014a.ada
! b8a8e5440cbe69d0ad54064892a114c0  gcc/testsuite/ada/acats/tests/e/ee3203a.ada
! 48040471bf50b07840b3338c9bc7e2c6  gcc/testsuite/ada/acats/tests/e/ee3204a.ada
! 25bff343477de94bd78239442f9ee02a  gcc/testsuite/ada/acats/tests/e/ee3402b.ada
! b057daa29f3fcc66f6affebff75a1be5  gcc/testsuite/ada/acats/tests/e/ee3409f.ada
! 4c52e7caa9bc136f2cba824b2e52e9c6  gcc/testsuite/ada/acats/tests/e/ee3412c.ada
! 76344ab690464f293f3d4ea9ddafa233  gcc/testsuite/ada/acats/tests/l/la140010.a
! 2900850ee7d28fb09a708d15ecb120e8  gcc/testsuite/ada/acats/tests/l/la140011.am
! 3a566254bd6b5a2476b7a0a4d201c6ec  gcc/testsuite/ada/acats/tests/l/la140012.a
! f251861d8f7143c4d6a0139eb5109844  gcc/testsuite/ada/acats/tests/l/la140020.a
! 94e3a842d07a1b065bf9729ba53ec9fd  gcc/testsuite/ada/acats/tests/l/la140021.am
! 951f84109a5b6658e7dd287bbd9bae71  gcc/testsuite/ada/acats/tests/l/la140022.a
! 876db830d93e5c9744a1c290ed00f17f  gcc/testsuite/ada/acats/tests/l/la140030.a
! eaefd12663189709da8ccf17c2c368fa  gcc/testsuite/ada/acats/tests/l/la140031.a
! 7bf8660d1ec101205c05dd17726a229a  gcc/testsuite/ada/acats/tests/l/la140032.am
! 857f64e53ab5de64c7aff62222d11127  gcc/testsuite/ada/acats/tests/l/la140033.a
! 92ca699ccd2c74842385086d5ada22dd  gcc/testsuite/ada/acats/tests/l/la140040.a
! 8b2c5cc4a29ad35fcfa826d7b492bc08  gcc/testsuite/ada/acats/tests/l/la140041.am
! fb8dd82cf673301eecabc122ac171090  gcc/testsuite/ada/acats/tests/l/la140042.a
! 6d5ee36b10609c888874ac66e3f0ee1e  gcc/testsuite/ada/acats/tests/l/la140050.a
! e04923836f3f4282a67d6f89778a6914  gcc/testsuite/ada/acats/tests/l/la140051.a
! bfa5a2187576b86f14423c0040742843  gcc/testsuite/ada/acats/tests/l/la140052.am
! 0d6624b67d8552559b64873f684e581d  gcc/testsuite/ada/acats/tests/l/la140053.a
! 8035d0c6bfa2f3b3a49f58acd52dd8a7  gcc/testsuite/ada/acats/tests/l/la140060.a
! 3d90461eff6991fd8178d6d2118e9ddf  gcc/testsuite/ada/acats/tests/l/la140061.a
! e475cc528675aeae58edde764f9dd718  gcc/testsuite/ada/acats/tests/l/la140062.am
! f022f8aa1d30fb70ecca6f610089b986  gcc/testsuite/ada/acats/tests/l/la140063.a
! c3833b353f97382d992824760c162c7c  gcc/testsuite/ada/acats/tests/l/la140070.a
! c0ccfb9014a2864c4a49d88f46f491c1  gcc/testsuite/ada/acats/tests/l/la140071.a
! 509bb3bfec998a7f16d7a711f508bdc0  gcc/testsuite/ada/acats/tests/l/la140072.am
! 4710fc41166460cc60192a57798054b4  gcc/testsuite/ada/acats/tests/l/la140073.a
! dcb4f9c9fdad375c3fe93310ac6b816e  gcc/testsuite/ada/acats/tests/l/la140080.a
! a3acb845f1ea8cd193aec71beb1ead51  gcc/testsuite/ada/acats/tests/l/la140081.a
! d8f09cb05605e6ee39a41685ba970092  gcc/testsuite/ada/acats/tests/l/la140082.am
! 6d37a12249cd1b2bdf860f7651a462e4  gcc/testsuite/ada/acats/tests/l/la140083.a
! 46655b2b4b88ca82cb0afc6eac22cd7b  gcc/testsuite/ada/acats/tests/l/la140090.a
! 257622cc1c6c259921d7e6c33e23f1ff  gcc/testsuite/ada/acats/tests/l/la140091.a
! 1c00169793ce024a3f35da791e30bbe6  gcc/testsuite/ada/acats/tests/l/la140092.am
! 6a23c4b62a4cac8720e8b7c21ad97d5b  gcc/testsuite/ada/acats/tests/l/la140093.a
! ed2026e1ace460e994b96b42c8f05e9c  gcc/testsuite/ada/acats/tests/l/la140100.a
! 55167329c290c62025473120fca26c7d  gcc/testsuite/ada/acats/tests/l/la140101.a
! 9280256db41c4bec0f36aa69ff060841  gcc/testsuite/ada/acats/tests/l/la140102.am
! 7b092247e539009157e512965ba1fc7a  gcc/testsuite/ada/acats/tests/l/la140103.a
! 6722c5fc30bb307834268e434901c086  gcc/testsuite/ada/acats/tests/l/la140110.a
! 443c0bb26e2eb84889c83a9bccaf9649  gcc/testsuite/ada/acats/tests/l/la140111.a
! 47c6e7a9da351969b20b3d295bb3c115  gcc/testsuite/ada/acats/tests/l/la140112.am
! 4bf0921f6ccd99db94a8a70d2b166fdf  gcc/testsuite/ada/acats/tests/l/la140113.a
! 5c9a0f9992d6d21844e2ba208b7cebbc  gcc/testsuite/ada/acats/tests/l/la140120.a
! 7c0ca86bca64632e57e32b5842ddbe60  gcc/testsuite/ada/acats/tests/l/la140121.a
! 211c1d44471b6a40c3d807f83059ff77  gcc/testsuite/ada/acats/tests/l/la140122.am
! e4cb364e594a0d2463e66f4aa48a914a  gcc/testsuite/ada/acats/tests/l/la140123.a
! 76516f31e5adf9e0fad1886ab83457a4  gcc/testsuite/ada/acats/tests/l/la140130.a
! f3b7f597165821e514288274845f5e54  gcc/testsuite/ada/acats/tests/l/la140131.a
! cb0819afcaf9586c9c95966d2516fb65  gcc/testsuite/ada/acats/tests/l/la140132.am
! 32a943ea5a9287c709fa39655d8668cb  gcc/testsuite/ada/acats/tests/l/la140133.a
! 212943c674757076da046354450e5113  gcc/testsuite/ada/acats/tests/l/la140140.a
! 195b91195befb872c8f723da1d28f132  gcc/testsuite/ada/acats/tests/l/la140141.a
! a6d2954f197001069fb371e8403e8ac6  gcc/testsuite/ada/acats/tests/l/la140142.am
! 57ac76011ccf9054712e1b09ef71bfd9  gcc/testsuite/ada/acats/tests/l/la140143.a
! 7552c854bb4af3c4f87cfe6a7a861610  gcc/testsuite/ada/acats/tests/l/la140150.a
! 5f1dcc1a1c97c253b5809c49c2a326ad  gcc/testsuite/ada/acats/tests/l/la140151.a
! 662ea838e79bbec83ab42275c2111e2a  gcc/testsuite/ada/acats/tests/l/la140152.am
! c80afc3e35ad24a8bb25b5e3d67f2bcb  gcc/testsuite/ada/acats/tests/l/la140153.a
! ebc4ad53e17e21942e69ae80c5b47b77  gcc/testsuite/ada/acats/tests/l/la140160.a
! 117e1792c17a1e2b5ec04bba346f528d  gcc/testsuite/ada/acats/tests/l/la140161.a
! b7744773a1c753b7aa68c166866eb005  gcc/testsuite/ada/acats/tests/l/la140162.am
! 9852ca8047bc9e1bd578767b67254fd2  gcc/testsuite/ada/acats/tests/l/la140163.a
! f7f66fd9abfb1f4931428292cd1fe63d  gcc/testsuite/ada/acats/tests/l/la140170.a
! 2acaa1d866103405c81e05839bd25054  gcc/testsuite/ada/acats/tests/l/la140171.a
! ea5de64993880be50e047e540f521cec  gcc/testsuite/ada/acats/tests/l/la140172.am
! b3e16fff4bf97ee8001c7d4707b01ca8  gcc/testsuite/ada/acats/tests/l/la140173.a
! cef0b6dba566de9e4b3fdd8429f3b573  gcc/testsuite/ada/acats/tests/l/la140180.a
! 3a47eaaf81a03727243aa228f4301a60  gcc/testsuite/ada/acats/tests/l/la140181.a
! a5c23800bfa114aaa25ef21241ca0c43  gcc/testsuite/ada/acats/tests/l/la140182.am
! 831069dc37bbaa6d17e49ec411324925  gcc/testsuite/ada/acats/tests/l/la140183.a
! 9597131b3c0b103f6244907627fbf160  gcc/testsuite/ada/acats/tests/l/la140190.a
! 14063c6684e8dd6c14ea4d18badb550b  gcc/testsuite/ada/acats/tests/l/la140191.a
! 8cbcf00024bdf7530ae51ba8a1ca0bba  gcc/testsuite/ada/acats/tests/l/la140192.am
! 99e2d79f6f50d594ab2f3e503f2db441  gcc/testsuite/ada/acats/tests/l/la140193.a
! ea6d1fb3bdbfc0deaee617b126be28f4  gcc/testsuite/ada/acats/tests/l/la140200.a
! babcd4715ea4f023430dfbe1f896bde1  gcc/testsuite/ada/acats/tests/l/la140201.a
! 64279761de38aa82af4a5638c457c1bf  gcc/testsuite/ada/acats/tests/l/la140202.am
! 7e4b83d0d9265f463e87dcc9fcf0fe5b  gcc/testsuite/ada/acats/tests/l/la140203.a
! b12cced7adaecf2a93250e16cca98cf4  gcc/testsuite/ada/acats/tests/l/la140210.a
! 887401b5f446bce786751fa72e341292  gcc/testsuite/ada/acats/tests/l/la140211.am
! ab173d0eec0bb616f34f81aa48cd950c  gcc/testsuite/ada/acats/tests/l/la140212.a
! 594b0e8144190e578786dbc1bad844dc  gcc/testsuite/ada/acats/tests/l/la140220.a
! f842b35f8c01816efc84f4addd2f93b7  gcc/testsuite/ada/acats/tests/l/la140221.am
! 772553907cc4b151574b52a2b52dc90c  gcc/testsuite/ada/acats/tests/l/la140222.a
! b03871ce6d6f59a7e5a7612e6d89d596  gcc/testsuite/ada/acats/tests/l/la140240.a
! efe4e86bfb690c79c68494f323cac801  gcc/testsuite/ada/acats/tests/l/la140241.a
! 30f55b3747e6fa1b9ef0af765a76ce5a  gcc/testsuite/ada/acats/tests/l/la140242.am
! f95f7a3f483abd92a9bf92b6dc469986  gcc/testsuite/ada/acats/tests/l/la140243.a
! 2db8317b47f3ab8bb9a0f5469169d027  gcc/testsuite/ada/acats/tests/l/la140250.a
! 938965a24a1e6eb44e817ef6a6bcef36  gcc/testsuite/ada/acats/tests/l/la140251.am
! b3d2bc446e9f8766852585be1a71c541  gcc/testsuite/ada/acats/tests/l/la140252.a
! ced69a105f582142776937381fb4ac18  gcc/testsuite/ada/acats/tests/l/la140260.a
! ff927baa2a1a94e581616deb8f88d900  gcc/testsuite/ada/acats/tests/l/la140261.a
! 666740bbcb573799ed4bbd92b8380bac  gcc/testsuite/ada/acats/tests/l/la140262.am
! 2a7b7e46c9fcf98d59cf645dd8488895  gcc/testsuite/ada/acats/tests/l/la140263.a
! b886a43ab960ee3b74b75b1a1895e692  gcc/testsuite/ada/acats/tests/l/la140270.a
! 2f50ecd2b64eb3a3cefb0066c4c043a1  gcc/testsuite/ada/acats/tests/l/la140271.a
! 004386b31584ba3e3f7171f7674e4137  gcc/testsuite/ada/acats/tests/l/la140272.am
! 9c63871113de9b518e90c90fe8e20f28  gcc/testsuite/ada/acats/tests/l/la140273.a
  25005a9265a333af56789fab16cd8e0e  gcc/testsuite/c-c++-common/Waddress-1.c
  81e4d27a297a7ce6fddf1ac2a8961317  gcc/testsuite/c-c++-common/Waddress-2.c
  ae85096226db49d6155303ac5a238c4f  gcc/testsuite/c-c++-common/Waddress-3.c
--- 8466,16721 ----
  fea5c64eccba058feddfd469dbdc5077  gcc/testsuite/README.compat
  7a54bd63031c5c648bd6caa0928bacad  gcc/testsuite/README.gcc
  2ad7c00ea00d78f6d6ee090f7894dadc  gcc/testsuite/ada/.gitignore
! 4004844198395fe50ecb798ed5d30f4b  gcc/testsuite/ada/acats-2/elabd.lst
! b32871a59b0c07cb4eda259b98fa6aab  gcc/testsuite/ada/acats-2/floatstore.lst
! bb4e4f9d3c0e72730e0bf397d375689c  gcc/testsuite/ada/acats-2/norun.lst
! 1485f263dfb9303b015015ae88161a8b  gcc/testsuite/ada/acats-2/run_acats.sh
! eb197d1552fb956ba0e8bad4f0ac3d0d  gcc/testsuite/ada/acats-2/run_all.sh
! 6467abb463602aeb04583b3822f653f4  gcc/testsuite/ada/acats-2/run_test.exp
! 5723a26fced8721c3e90e6e7a9ba2a23  gcc/testsuite/ada/acats-2/stackcheck.lst
! feaec71549d40900aa5bcbd842c9fa57  gcc/testsuite/ada/acats-2/support/acats26.lst
! 2f262cdb98b38922d7b7f84414f43b84  gcc/testsuite/ada/acats-2/support/checkfil.ada
! 4edf20410814582eae331707f2ae2c77  gcc/testsuite/ada/acats-2/support/enumchek.ada
! 8f3ec4fe93c0095e34d79e9a41dde4e9  gcc/testsuite/ada/acats-2/support/f340a000.a
! b673a17611516bde0712458de61636e8  gcc/testsuite/ada/acats-2/support/f340a001.a
! b31158ceea90e5246f63aed8b0078e9c  gcc/testsuite/ada/acats-2/support/f341a00.a
! d3d954612d4f455a32df07aa05816320  gcc/testsuite/ada/acats-2/support/f390a00.a
! ed3b5aee8f81d147785adce6b48411cd  gcc/testsuite/ada/acats-2/support/f392a00.a
! 7973b64953275c03e790967bc310010c  gcc/testsuite/ada/acats-2/support/f392c00.a
! 7b5b9e45fb9003af0e096ca36327031e  gcc/testsuite/ada/acats-2/support/f392d00.a
! e4733abdf62c401a876d29c3e5a38c34  gcc/testsuite/ada/acats-2/support/f393a00.a
! c1487dd34771abf18d1144c610fac26e  gcc/testsuite/ada/acats-2/support/f393b00.a
! b3e35321e808d9e061d1fdef51813016  gcc/testsuite/ada/acats-2/support/f3a2a00.a
! 798afd3c6228223e07e7c8e3034eb99c  gcc/testsuite/ada/acats-2/support/f460a00.a
! 316c7cde49ee557a67d39d6b63407811  gcc/testsuite/ada/acats-2/support/f730a000.a
! 60edd601c25022d0f19b8c45d3d187bb  gcc/testsuite/ada/acats-2/support/f730a001.a
! 75b2405f0dd739649bda9b92b0d259f4  gcc/testsuite/ada/acats-2/support/f731a00.a
! 689c49d9ccb5124d47eecb1dcebcc376  gcc/testsuite/ada/acats-2/support/f940a00.a
! d08e91b98a54c3d471108a6631714033  gcc/testsuite/ada/acats-2/support/f954a00.a
! f95be63eadf08e7cafbeb33a6794c019  gcc/testsuite/ada/acats-2/support/fa11a00.a
! 28be0e2126b177ff6d34df7c272a9f2c  gcc/testsuite/ada/acats-2/support/fa11b00.a
! 2228808bf25eecbd9e02ff343e2dba54  gcc/testsuite/ada/acats-2/support/fa11c00.a
! 1cb03e4473720d064b6798cf5e185f62  gcc/testsuite/ada/acats-2/support/fa11d00.a
! ff082a3957be5f526713103bf563e5be  gcc/testsuite/ada/acats-2/support/fa13a00.a
! dfa6bb61642b6c22f17171fb93cfc97c  gcc/testsuite/ada/acats-2/support/fa13b00.a
! 54b899e09f3f0bf28db2e007ca6921e5  gcc/testsuite/ada/acats-2/support/fa21a00.a
! 97d3fd68d030a5d89e98b950d557151d  gcc/testsuite/ada/acats-2/support/fb20a00.a
! 886f3ad8c51e9e1e01cb7d4ab0b3f47e  gcc/testsuite/ada/acats-2/support/fb40a00.a
! 045b4b77241122260c9b42a0a85941b8  gcc/testsuite/ada/acats-2/support/fc50a00.a
! d2c427a2c2e845d2d5991d7e86689284  gcc/testsuite/ada/acats-2/support/fc51a00.a
! 18eee0e1727cb58b8ca0da52a8f7fbd0  gcc/testsuite/ada/acats-2/support/fc51b00.a
! 707c153d9868ec6e694e8db161e9a7c7  gcc/testsuite/ada/acats-2/support/fc51c00.a
! 981a728516c5de4f242cff81d35a1806  gcc/testsuite/ada/acats-2/support/fc51d00.a
! 992e25818babbd2519c54f2dc5987601  gcc/testsuite/ada/acats-2/support/fc54a00.a
! f75e17c909e83e1879e87a3ba3ffd7cc  gcc/testsuite/ada/acats-2/support/fc70a00.a
! cdb7ee32751757a29e821ba020228a0e  gcc/testsuite/ada/acats-2/support/fc70b00.a
! 8af79a6be55981313da73bc0bb01f617  gcc/testsuite/ada/acats-2/support/fc70c00.a
! 65011f4705018476715af62324c335b3  gcc/testsuite/ada/acats-2/support/fcndecl.ada
! 3ce3384936274aa48a8c4a38fa7109ac  gcc/testsuite/ada/acats-2/support/fd72a00.a
! 5c9a93b4c9f45c15707e4b3b123aee9c  gcc/testsuite/ada/acats-2/support/fdb0a00.a
! bf9c7650a6f8303b6a69ff5eb2660b15  gcc/testsuite/ada/acats-2/support/fdd2a00.a
! a77ebc244676daacb1f3a61ae8003e88  gcc/testsuite/ada/acats-2/support/fxa5a00.a
! f4e9649e424fa9578180b9aee65c8e96  gcc/testsuite/ada/acats-2/support/fxaca00.a
! caa75442e4dceed0740dfa35a47b5bb6  gcc/testsuite/ada/acats-2/support/fxacb00.a
! 1855abc6c615b76aa82fb9241571f3d8  gcc/testsuite/ada/acats-2/support/fxacc00.a
! f88af2b3eb53ad7c8700efbd0f878915  gcc/testsuite/ada/acats-2/support/fxc6a00.a
! 56ba35dd56ea544c0eb9146769871492  gcc/testsuite/ada/acats-2/support/fxe2a00.a
! 67770e9161b0f48f3fc9392bd3460272  gcc/testsuite/ada/acats-2/support/fxf2a00.a
! 6628969f51dd10c56235f9d7420e2d44  gcc/testsuite/ada/acats-2/support/fxf3a00.a
! 6a9b6ce90538e9126e7e5badc62ddca2  gcc/testsuite/ada/acats-2/support/impbit.adb
! 1ccb5211fbcff1d5604e6ccee6542df7  gcc/testsuite/ada/acats-2/support/impdef.a
! f5a3b49034b9c28b2d9965465324a697  gcc/testsuite/ada/acats-2/support/impdefc.a
! 4f2f9bfdfcfd8c5ecaf503416d1cfc5f  gcc/testsuite/ada/acats-2/support/impdefd.a
! edf70d423a69adebd38e9b29f35a2ba1  gcc/testsuite/ada/acats-2/support/impdefe.a
! cadfd8a5487a315a6fbd8eef397219e9  gcc/testsuite/ada/acats-2/support/impdefg.a
! 5d9a0f98d9f15211e0773263febb974b  gcc/testsuite/ada/acats-2/support/impdefh.a
! f2604ccc5244696793b33e7b83c57c45  gcc/testsuite/ada/acats-2/support/lencheck.ada
! 79c0994222b2a5fc702eb4bc3dc1ba8e  gcc/testsuite/ada/acats-2/support/macro.dfs
! 72980ae1a3bbd5b71aa915cefeaebf6e  gcc/testsuite/ada/acats-2/support/macrodef.adb
! 4d7b79a3ff077d1ab05a78ebcf5a1de3  gcc/testsuite/ada/acats-2/support/macrosub.ada
! 29539981686659a32e9b3a46eafe0a56  gcc/testsuite/ada/acats-2/support/repbody.ada
! ec6c02ebb16da7cc117e3a65c06d385a  gcc/testsuite/ada/acats-2/support/repspec.ada
! 356cf4b2e0cc1e02ef1deddb5567de36  gcc/testsuite/ada/acats-2/support/spprt13s.tst
! e250c306fa98a053bdf37159af289d57  gcc/testsuite/ada/acats-2/support/tctouch.ada
! 26945b868319fda8b82f82c677a35562  gcc/testsuite/ada/acats-2/support/tsttests.dat
! 91c39a37d5651ca4a1e6aa82cd2f1269  gcc/testsuite/ada/acats-2/support/widechr.a
! dc179b8a7c506c961b229b7ec7d2de53  gcc/testsuite/ada/acats-2/tests/a/a22006b.ada
! f61ae49f8066de3ba349e39d3a688ea6  gcc/testsuite/ada/acats-2/tests/a/a22006c.ada
! 54e5a501bbefb19fdf7715f5741fc858  gcc/testsuite/ada/acats-2/tests/a/a22006d.ada
! 11394a122edd516a587d020bc9ce2e8e  gcc/testsuite/ada/acats-2/tests/a/a26007a.tst
! aa57a75b85b36a99f6ecaca91a9eed60  gcc/testsuite/ada/acats-2/tests/a/a27003a.ada
! 054ca4c1bbb5dd701e8781bc92bf9cb8  gcc/testsuite/ada/acats-2/tests/a/a29003a.ada
! c330e5a362289a57c2ca975a61b4d20c  gcc/testsuite/ada/acats-2/tests/a/a2a031a.ada
! bbd0059e56828aa342048400c5490233  gcc/testsuite/ada/acats-2/tests/a/a33003a.ada
! 84de33e1cd2c3a0c2165591a28407805  gcc/testsuite/ada/acats-2/tests/a/a34017c.ada
! 924373fa4803a6e22fdc43bd0bee31a3  gcc/testsuite/ada/acats-2/tests/a/a35101b.ada
! be270ea90b999a2136e6cc850543a945  gcc/testsuite/ada/acats-2/tests/a/a35402a.ada
! 8054f52aa40d34c334d3a4b30222340a  gcc/testsuite/ada/acats-2/tests/a/a35801f.ada
! 325ee8ec767c6769757ac1eb71d6f515  gcc/testsuite/ada/acats-2/tests/a/a35902c.ada
! c512e91af19d8cf3307b189ec712dde0  gcc/testsuite/ada/acats-2/tests/a/a38106d.ada
! 8d608afb4ab9b953fd4dd01b00a90914  gcc/testsuite/ada/acats-2/tests/a/a38106e.ada
! 28bab0e5eb84a43ad0b4dc06d90f880b  gcc/testsuite/ada/acats-2/tests/a/a49027a.ada
! 5b6e07973ea9075de594e462d6f0f847  gcc/testsuite/ada/acats-2/tests/a/a49027b.ada
! 926d6ade013a1456d53a17063495aaf2  gcc/testsuite/ada/acats-2/tests/a/a49027c.ada
! df2270ff569c843d152cae1fc3606103  gcc/testsuite/ada/acats-2/tests/a/a54b01a.ada
! 71937fafcd3199a3eda330e7880c1ec5  gcc/testsuite/ada/acats-2/tests/a/a54b02a.ada
! 1aa0f31635199e1096468f23888a66f4  gcc/testsuite/ada/acats-2/tests/a/a55b12a.ada
! b0fc7cf66a832e68c808ed89a23340d1  gcc/testsuite/ada/acats-2/tests/a/a55b13a.ada
! 205552e2dafa2b699b6514e12a35e676  gcc/testsuite/ada/acats-2/tests/a/a55b14a.ada
! 7a5be75ac2dc323c1dd1e9328c39c6e0  gcc/testsuite/ada/acats-2/tests/a/a71004a.ada
! 69bd6dadfe4d61041f1998157bcbdb4a  gcc/testsuite/ada/acats-2/tests/a/a73001i.ada
! 8b949ce02d53bc2b35893d05656ff3c2  gcc/testsuite/ada/acats-2/tests/a/a73001j.ada
! 3859ef22068457dc5db7b84889f89c07  gcc/testsuite/ada/acats-2/tests/a/a74105b.ada
! 5200e86147d7eddb31de36b182066003  gcc/testsuite/ada/acats-2/tests/a/a74106a.ada
! d288f454e96b3840804c86245fd1309c  gcc/testsuite/ada/acats-2/tests/a/a74106b.ada
! c6c2ff5c654f5fecb72565c1ec890ea8  gcc/testsuite/ada/acats-2/tests/a/a74106c.ada
! 4526ae74da58946736d1077ca17b0f15  gcc/testsuite/ada/acats-2/tests/a/a74205e.ada
! a4600113362b659154e0921e8ccc440b  gcc/testsuite/ada/acats-2/tests/a/a74205f.ada
! 762682eaddf9e0d72ef370ddf52c091c  gcc/testsuite/ada/acats-2/tests/a/a83009a.ada
! 89be8e66cfa8cf7d9ea962fc92c5bbe6  gcc/testsuite/ada/acats-2/tests/a/a83009b.ada
! 1a86aa84a5b4a8f2d91898a2a5878109  gcc/testsuite/ada/acats-2/tests/a/a83a02a.ada
! b50d55495ed25cd5f5f0cc5ce62c33c6  gcc/testsuite/ada/acats-2/tests/a/a83a02b.ada
! 92d9af0f50f62b8ca3df28d8e4228ec5  gcc/testsuite/ada/acats-2/tests/a/a83a06a.ada
! 5c0b43d5d9e1251dce20fd8ac69811a8  gcc/testsuite/ada/acats-2/tests/a/a83a08a.ada
! d847c2fa25d9becc828716d2f6b3924e  gcc/testsuite/ada/acats-2/tests/a/a83c01c.ada
! 48efd44cb0cc48a4666ca9078d516a19  gcc/testsuite/ada/acats-2/tests/a/a83c01h.ada
! 9a14ce84b1e63358e8ea5b22b8b58366  gcc/testsuite/ada/acats-2/tests/a/a83c01i.ada
! d4b236b43806323a12df387d43065ecd  gcc/testsuite/ada/acats-2/tests/a/a85007d.ada
! 22b51a96b02c7a88f7ef1383e4b6e3ba  gcc/testsuite/ada/acats-2/tests/a/a85013b.ada
! 401bca9a32ad0d8881ea660bba3ca711  gcc/testsuite/ada/acats-2/tests/a/a87b59a.ada
! 74d0779474d9d789d09508ba653efc61  gcc/testsuite/ada/acats-2/tests/a/a95001c.ada
! 4de434af68116383b58aae2d7ff0186e  gcc/testsuite/ada/acats-2/tests/a/a95074d.ada
! 6dcac89d281ffc1c47dc51dfd7429d9e  gcc/testsuite/ada/acats-2/tests/a/a97106a.ada
! 672a004e783873caffaddfe2e9ed7184  gcc/testsuite/ada/acats-2/tests/a/a99006a.ada
! d338cf80520cfcd59896b08557f7334a  gcc/testsuite/ada/acats-2/tests/a/aa2010a.ada
! c8652c11c39145beb7535ff59feee79b  gcc/testsuite/ada/acats-2/tests/a/aa2012a.ada
! 64d7f9e70085b7412df08b06b70924f1  gcc/testsuite/ada/acats-2/tests/a/ac1015b.ada
! f8019419f138b9b0b4e860f560539c52  gcc/testsuite/ada/acats-2/tests/a/ac3106a.ada
! 599863dbc7677bd83fe020c38e11b4b8  gcc/testsuite/ada/acats-2/tests/a/ac3206a.ada
! 527cf1506ce6e0451f82e833aba4b6b3  gcc/testsuite/ada/acats-2/tests/a/ac3207a.ada
! 7c28607179138101a5d7cf088f333028  gcc/testsuite/ada/acats-2/tests/a/ad7001b.ada
! 810035c64fe589563087a2d2f380f1e4  gcc/testsuite/ada/acats-2/tests/a/ad7001c0.ada
! 8d92b2b79dbfd08d90c9a238b1e35a05  gcc/testsuite/ada/acats-2/tests/a/ad7001c1.ada
! 1c1c6e5fb42029a3ff9b1f3b9055c191  gcc/testsuite/ada/acats-2/tests/a/ad7001d0.ada
! 21257b0cc94669e31a8891cb9ed30e14  gcc/testsuite/ada/acats-2/tests/a/ad7001d1.ada
! eaa4c7b6b00bcd4bfa2d9883aff64ee8  gcc/testsuite/ada/acats-2/tests/a/ad7006a.ada
! b93c425e39dd1e4003cb33131862e719  gcc/testsuite/ada/acats-2/tests/a/ad7101a.ada
! 07e115c2bd0ac4bc085809d9ad65327f  gcc/testsuite/ada/acats-2/tests/a/ad7101c.ada
! 24888691f9cd0131679078391bf99fb1  gcc/testsuite/ada/acats-2/tests/a/ad7102a.ada
! 27abfa60261b508014d366ae82e296fe  gcc/testsuite/ada/acats-2/tests/a/ad7103a.ada
! aec3e74553448f599ae9a51ec65c42ce  gcc/testsuite/ada/acats-2/tests/a/ad7103c.ada
! d18cab7f102ffc27545ccb4522f82ded  gcc/testsuite/ada/acats-2/tests/a/ad7104a.ada
! 1b797aacfde0d671d89a45db2a9d5be2  gcc/testsuite/ada/acats-2/tests/a/ad7201a.ada
! 8c49706fbc8916aacd037e7649ed8213  gcc/testsuite/ada/acats-2/tests/a/ad7203b.ada
! 129af6b1b47884872132fcfc3787f362  gcc/testsuite/ada/acats-2/tests/a/ad7205b.ada
! 696b85c4c78cdc9b5448612a22b9ffa3  gcc/testsuite/ada/acats-2/tests/a/ad8011a.tst
! bfa3fa83b466b71da4126d005e2c701b  gcc/testsuite/ada/acats-2/tests/a/ada101a.ada
! 178bb6ff2316e9cfb5bd4395e74874ae  gcc/testsuite/ada/acats-2/tests/a/ae2113a.ada
! 1dd247cf1f02e4384b1f1a58ab2244c0  gcc/testsuite/ada/acats-2/tests/a/ae2113b.ada
! 5ff7c493a66eb8be0a3e7f89bd4d2512  gcc/testsuite/ada/acats-2/tests/a/ae3002g.ada
! 2cc8c13fd1203af7f246cee23d3037c3  gcc/testsuite/ada/acats-2/tests/a/ae3101a.ada
! 3798d627b7336c5fa8805e970e10ec7e  gcc/testsuite/ada/acats-2/tests/a/ae3702a.ada
! 7a44891c6ee0ec272ded72e61d392bc8  gcc/testsuite/ada/acats-2/tests/a/ae3709a.ada
! 8a42b2199ecbb25390c8c306c3759312  gcc/testsuite/ada/acats-2/tests/c2/c23001a.ada
! 8d4b3f4069aeb0e32db3f46e5cb1487b  gcc/testsuite/ada/acats-2/tests/c2/c23003a.tst
! 95e1beb36e033514e6e4be866042a42a  gcc/testsuite/ada/acats-2/tests/c2/c23003b.tst
! a765ec985184f6802389b89d0971eede  gcc/testsuite/ada/acats-2/tests/c2/c23003g.tst
! 53bdd26032ff323b57f3c309b520767e  gcc/testsuite/ada/acats-2/tests/c2/c23003i.tst
! d8470ff80210b6aeab8ecf5828f8e73c  gcc/testsuite/ada/acats-2/tests/c2/c23006a.ada
! c175938807f9ed5ec36eed8c2fc47bf2  gcc/testsuite/ada/acats-2/tests/c2/c23006b.ada
! 1891f1d94ad6f27dc8691abae763b735  gcc/testsuite/ada/acats-2/tests/c2/c23006c.ada
! 4d2aaab0f8577c4441dfb223b74e9270  gcc/testsuite/ada/acats-2/tests/c2/c23006d.ada
! d38fc16a6b2a221a8089094d8e595fd0  gcc/testsuite/ada/acats-2/tests/c2/c23006e.ada
! e4cb34f327ded980acbb2890f276b1b6  gcc/testsuite/ada/acats-2/tests/c2/c23006f.ada
! 1afe1ff732d7c93eb72aeb763fc3a3e4  gcc/testsuite/ada/acats-2/tests/c2/c23006g.ada
! d7a2fe8807a7e954f894e43619906c61  gcc/testsuite/ada/acats-2/tests/c2/c24002d.ada
! 90b7096d0092e8bee54a5e0931480cc3  gcc/testsuite/ada/acats-2/tests/c2/c24003a.ada
! 8d4b3197420dea97b47fa445d6b7f13e  gcc/testsuite/ada/acats-2/tests/c2/c24003b.ada
! c0bc49ad0d9faebe7c1bddd17682575b  gcc/testsuite/ada/acats-2/tests/c2/c24003c.ada
! 474d9480579f044d63ea2312eee797a0  gcc/testsuite/ada/acats-2/tests/c2/c24106a.ada
! 21abd0c844a441282df97eca59d187ac  gcc/testsuite/ada/acats-2/tests/c2/c24202d.ada
! f8734f0cb78893a591c1455798f48f34  gcc/testsuite/ada/acats-2/tests/c2/c24203a.ada
! 303fe85abf30e67b9c26c05c37527377  gcc/testsuite/ada/acats-2/tests/c2/c24203b.ada
! 4fc421f9d26dd38caa8e66e5f9a8118d  gcc/testsuite/ada/acats-2/tests/c2/c24207a.ada
! 00805111547e7b0f767a65dbb0216178  gcc/testsuite/ada/acats-2/tests/c2/c24211a.ada
! 9344f5c2db357b3b873a83422c449d0b  gcc/testsuite/ada/acats-2/tests/c2/c250001.aw
! fc57da7b290e833c22ee1e312ebea0af  gcc/testsuite/ada/acats-2/tests/c2/c250002.aw
! fcffacb0c5a7d6bc171b2b62228ef27c  gcc/testsuite/ada/acats-2/tests/c2/c25001a.ada
! f8101111006b8dfccb57bc9286761546  gcc/testsuite/ada/acats-2/tests/c2/c25001b.ada
! 4d59f28ccd2a2792f59d358acfb3b645  gcc/testsuite/ada/acats-2/tests/c2/c26006a.ada
! 2a3847aff34c962069ea9fc46184b49c  gcc/testsuite/ada/acats-2/tests/c2/c26008a.ada
! 3b3d12a94cdb249ade26bb6fe45121be  gcc/testsuite/ada/acats-2/tests/c2/c2a001a.ada
! 3fd11c60327272b0e88714377e07694a  gcc/testsuite/ada/acats-2/tests/c2/c2a001b.ada
! fad7c83b08db79e3d8d41a3abc495609  gcc/testsuite/ada/acats-2/tests/c2/c2a001c.ada
! 9e58903d92e80dece18b3f5f07c10714  gcc/testsuite/ada/acats-2/tests/c2/c2a002a.ada
! 80f047f9baf4edce16ae00b242937e09  gcc/testsuite/ada/acats-2/tests/c2/c2a008a.ada
! 5846b01316c8e35b2ae9271e2ceeb33b  gcc/testsuite/ada/acats-2/tests/c2/c2a021b.ada
! 6c6e6ac7e7d8151372bf25d5bfcc4638  gcc/testsuite/ada/acats-2/tests/c3/c32001a.ada
! f44d3e1d8c4deff3e60e49eb14755c7f  gcc/testsuite/ada/acats-2/tests/c3/c32001b.ada
! 90383af3c35e304193502497e9d9ada0  gcc/testsuite/ada/acats-2/tests/c3/c32001c.ada
! 6f38031cf1bc7fd3a2530a0a49fc3927  gcc/testsuite/ada/acats-2/tests/c3/c32001d.ada
! 4cff8a5cde793b9eb72e56ef8588c690  gcc/testsuite/ada/acats-2/tests/c3/c32001e.ada
! fe386611f5a09953fdbdb423b0673b0b  gcc/testsuite/ada/acats-2/tests/c3/c32107a.ada
! 6dcc55a41a077f43caf697ae83ae4678  gcc/testsuite/ada/acats-2/tests/c3/c32107c.ada
! 6bc3a589ff71140e94718588fa9f9c34  gcc/testsuite/ada/acats-2/tests/c3/c32108a.ada
! 0b55a6ac879d361c4eaa8a25a475c92e  gcc/testsuite/ada/acats-2/tests/c3/c32108b.ada
! 4520bac74d324253fcf2b48b5c6eea2b  gcc/testsuite/ada/acats-2/tests/c3/c32111a.ada
! 52ac5c461c7746717a0d789fb2a57377  gcc/testsuite/ada/acats-2/tests/c3/c32111b.ada
! dabad6f6cae80313a5a888aaa710756d  gcc/testsuite/ada/acats-2/tests/c3/c32112b.ada
! eebc548a818a1f56ce990f52129e4296  gcc/testsuite/ada/acats-2/tests/c3/c32113a.ada
! 016d6073dcc33d7b8106082eb7755faa  gcc/testsuite/ada/acats-2/tests/c3/c32115a.ada
! a613215b48d8c873069bb2d690d5f556  gcc/testsuite/ada/acats-2/tests/c3/c32115b.ada
! f21dc71d940d5c06af5d22f69eab60f9  gcc/testsuite/ada/acats-2/tests/c3/c330001.a
! 74812d0708e93af61e096b45e2fc14ec  gcc/testsuite/ada/acats-2/tests/c3/c330002.a
! 8e5fef6b3dfabbb753bbf97caf8dddae  gcc/testsuite/ada/acats-2/tests/c3/c332001.a
! d7ae35646e985b47bde736b4aeadaec1  gcc/testsuite/ada/acats-2/tests/c3/c340001.a
! 029cfe27a33cb66b049fe0d0fb65381b  gcc/testsuite/ada/acats-2/tests/c3/c34001a.ada
! 7f88e5135c6832cdc88dff48cc8dafee  gcc/testsuite/ada/acats-2/tests/c3/c34001c.ada
! 8c1764692d7cb0bc17a952ce68b59db8  gcc/testsuite/ada/acats-2/tests/c3/c34001d.ada
! a08af1aeb3b4af40be4e8250cad56d8d  gcc/testsuite/ada/acats-2/tests/c3/c34001f.ada
! 796e76f308a9d18762b63a8a7c9fa6ec  gcc/testsuite/ada/acats-2/tests/c3/c34002a.ada
! 56ca2500660f86690e43b4eb2c63911d  gcc/testsuite/ada/acats-2/tests/c3/c34002c.ada
! 916814d1426aeb62617f0e647f1425f4  gcc/testsuite/ada/acats-2/tests/c3/c34003a.ada
! 7848bad56990231ec4964a5294f4d02f  gcc/testsuite/ada/acats-2/tests/c3/c34003c.ada
! 3f596cd960a8968d7c7892b7351e85fa  gcc/testsuite/ada/acats-2/tests/c3/c34004a.ada
! f25b6504d96e3e21099abd8a985bfe40  gcc/testsuite/ada/acats-2/tests/c3/c34004c.ada
! 10feabd33f2004943d36ff9acac0bda3  gcc/testsuite/ada/acats-2/tests/c3/c34005a.ada
! 9b730174260769c83e1d1f34a482b64c  gcc/testsuite/ada/acats-2/tests/c3/c34005c.ada
! d8cd66825d35a0c2eee7a2bc22021fde  gcc/testsuite/ada/acats-2/tests/c3/c34005d.ada
! fd5b17683accebcffccf7d52a88ba813  gcc/testsuite/ada/acats-2/tests/c3/c34005f.ada
! 5a2119c2d54f4427832bc1c61d913eac  gcc/testsuite/ada/acats-2/tests/c3/c34005g.ada
! 170b45f6069790926570bd39f97033ea  gcc/testsuite/ada/acats-2/tests/c3/c34005i.ada
! bdf673ae022cc1b217f6ea84218ef460  gcc/testsuite/ada/acats-2/tests/c3/c34005j.ada
! 0c6f4909c9db9787b9ca4d3b296a3ae9  gcc/testsuite/ada/acats-2/tests/c3/c34005l.ada
! 7f1441892699c24f145df474c396124d  gcc/testsuite/ada/acats-2/tests/c3/c34005m.ada
! f851c156716ece972741b1a161b80b5f  gcc/testsuite/ada/acats-2/tests/c3/c34005o.ada
! 043754af8734117b693825059b2d22bb  gcc/testsuite/ada/acats-2/tests/c3/c34005p.ada
! 38b03276fbc9b35694fc4d3d2b1256ef  gcc/testsuite/ada/acats-2/tests/c3/c34005r.ada
! b1e254368a79c887afcaae46814d1508  gcc/testsuite/ada/acats-2/tests/c3/c34005s.ada
! 1f4c22b0cf2e5dfbe3648ebb2db7263a  gcc/testsuite/ada/acats-2/tests/c3/c34005u.ada
! ee6486739b27542ae2e06bf404248adf  gcc/testsuite/ada/acats-2/tests/c3/c34005v.ada
! 60d73ec320d9ef0db0dc330bb3e04fe5  gcc/testsuite/ada/acats-2/tests/c3/c34006a.ada
! da0b3e574a91ee0aaaef5268466ab1d1  gcc/testsuite/ada/acats-2/tests/c3/c34006d.ada
! 8d549731513d1eff1ef01cf7c39e1bb6  gcc/testsuite/ada/acats-2/tests/c3/c34006f.ada
! 5778d0794027d2195dc52a874d4aa6dc  gcc/testsuite/ada/acats-2/tests/c3/c34006g.ada
! 0e44ca23e51d865ebba37df074e84cc3  gcc/testsuite/ada/acats-2/tests/c3/c34006j.ada
! 1f9588c61e9d083a44b37060893f1199  gcc/testsuite/ada/acats-2/tests/c3/c34006l.ada
! 3111937fe40eda62543e53d0dc0a9b2e  gcc/testsuite/ada/acats-2/tests/c3/c34007a.ada
! a6c16ebbc095684171bb89cb7ac5b52f  gcc/testsuite/ada/acats-2/tests/c3/c34007d.ada
! 3f46f4632a1e2839b528dd4edb849c59  gcc/testsuite/ada/acats-2/tests/c3/c34007f.ada
! 50a6b8b6ab707d4020a210c2f54c5364  gcc/testsuite/ada/acats-2/tests/c3/c34007g.ada
! 1d08fae78b3684032500b751c4f6b956  gcc/testsuite/ada/acats-2/tests/c3/c34007i.ada
! 7dec8ab4f2325dfb24a6f4a0712ca647  gcc/testsuite/ada/acats-2/tests/c3/c34007j.ada
! f2f670c3368d6fdedc0bc830e2f5441f  gcc/testsuite/ada/acats-2/tests/c3/c34007m.ada
! 12e7a75337b952bbe70b50f44fbf73bd  gcc/testsuite/ada/acats-2/tests/c3/c34007p.ada
! 4460899978bde8392dbf79b1457fd4c0  gcc/testsuite/ada/acats-2/tests/c3/c34007r.ada
! 430fadbb7eb89cad332156a43a1cb8a6  gcc/testsuite/ada/acats-2/tests/c3/c34007s.ada
! 142cd26f56dbefa8cc40ce318e93574b  gcc/testsuite/ada/acats-2/tests/c3/c34007u.ada
! 01aa55423bd6286a768cfbc7951408e9  gcc/testsuite/ada/acats-2/tests/c3/c34007v.ada
! 7d2567bb5e4ce686433355b2efa84d99  gcc/testsuite/ada/acats-2/tests/c3/c34008a.ada
! 9e896dcd16ce62c70c03b6105de6b94c  gcc/testsuite/ada/acats-2/tests/c3/c34009a.ada
! be1b3bebe697fb006bf9a558f3b0f788  gcc/testsuite/ada/acats-2/tests/c3/c34009d.ada
! 5880284be01f48d40969f18306c94edd  gcc/testsuite/ada/acats-2/tests/c3/c34009f.ada
! 679004960f5e177505b2aff13c637ebf  gcc/testsuite/ada/acats-2/tests/c3/c34009g.ada
! f60aa89944e52f4dca47047e08990f29  gcc/testsuite/ada/acats-2/tests/c3/c34009j.ada
! 28351985ca5afb785bccaaf7463d1f32  gcc/testsuite/ada/acats-2/tests/c3/c34009l.ada
! 221f9bd08976154a0a22e9948d8ac7e0  gcc/testsuite/ada/acats-2/tests/c3/c34011b.ada
! f2175e26a65dbd70c186e6acf1001755  gcc/testsuite/ada/acats-2/tests/c3/c34012a.ada
! bdde2c516616684b5fe414550d8400ee  gcc/testsuite/ada/acats-2/tests/c3/c34014a.ada
! 4e8100382b8141c0d056a9fe870b8d06  gcc/testsuite/ada/acats-2/tests/c3/c34014c.ada
! a8fbccc7b3c28981b57a867a1edabf5d  gcc/testsuite/ada/acats-2/tests/c3/c34014e.ada
! 75cb51a9c469066a67228b04e8ba11fc  gcc/testsuite/ada/acats-2/tests/c3/c34014g.ada
! da007fc8719ca70057c035beb9fda7fe  gcc/testsuite/ada/acats-2/tests/c3/c34014h.ada
! dbcb5a07736736af9834d2938b24e483  gcc/testsuite/ada/acats-2/tests/c3/c34014n.ada
! afbaca6a68812eaecf17a8eef2a6346e  gcc/testsuite/ada/acats-2/tests/c3/c34014p.ada
! df14c9b4224ce4cf3fd2d8445cbad0f2  gcc/testsuite/ada/acats-2/tests/c3/c34014r.ada
! 03948696a8a2d08faa02588806cd388d  gcc/testsuite/ada/acats-2/tests/c3/c34014t.ada
! 7258de51f19cfc9506908221af84e01f  gcc/testsuite/ada/acats-2/tests/c3/c34014u.ada
! 360330a2a81712d1ed00c02cbc5e6526  gcc/testsuite/ada/acats-2/tests/c3/c34018a.ada
! a943a89b3032146b53e937f3a73684da  gcc/testsuite/ada/acats-2/tests/c3/c340a01.a
! 5a38659efe283303f9d22ebc955ae0d0  gcc/testsuite/ada/acats-2/tests/c3/c340a02.a
! f694a602dc4b31baf72c096b6e4fb9d5  gcc/testsuite/ada/acats-2/tests/c3/c341a01.a
! 4ad05d07bd295bd76f3edbc6685ae9b8  gcc/testsuite/ada/acats-2/tests/c3/c341a02.a
! 49408ab274823bacfccd32176c5bc061  gcc/testsuite/ada/acats-2/tests/c3/c341a03.a
! ec207723e08de50ca0964ad3318f8235  gcc/testsuite/ada/acats-2/tests/c3/c341a04.a
! 55b745d015fed5a09de487d8081c09eb  gcc/testsuite/ada/acats-2/tests/c3/c35003a.ada
! 092ff51133e865dad2cd6192506f9980  gcc/testsuite/ada/acats-2/tests/c3/c35003b.ada
! 55caad169adcfa6b58689ceb3dc1d505  gcc/testsuite/ada/acats-2/tests/c3/c35003d.ada
! b2b10d16689d994b421c7f356c4eebe9  gcc/testsuite/ada/acats-2/tests/c3/c35102a.ada
! 9d1972c0cc4eb7b2203cca27c4e785f1  gcc/testsuite/ada/acats-2/tests/c3/c352001.a
! 6adbf240f9a88c67e6dc4d9a3ae2f449  gcc/testsuite/ada/acats-2/tests/c3/c354002.a
! 1c6bd8c5607c8d83b1fb16cf20b35965  gcc/testsuite/ada/acats-2/tests/c3/c354003.a
! 831543d10fff09679865a63cb6261690  gcc/testsuite/ada/acats-2/tests/c3/c35502a.ada
! a7c2fa5fc851b6f2ef3d825116c56789  gcc/testsuite/ada/acats-2/tests/c3/c35502b.ada
! 012ae5aa045c7b944677ea749449b75e  gcc/testsuite/ada/acats-2/tests/c3/c35502c.ada
! 66ad3541bdd12f2457bc931410567df2  gcc/testsuite/ada/acats-2/tests/c3/c35502d.tst
! f850859238832c6689133c4b82b2d23a  gcc/testsuite/ada/acats-2/tests/c3/c35502e.ada
! 1ae0d752d4d7089a159ba37533cac440  gcc/testsuite/ada/acats-2/tests/c3/c35502f.tst
! 86636a48b0f16cee1e000cf7cdff2dd3  gcc/testsuite/ada/acats-2/tests/c3/c35502g.ada
! 051f7f33819b5ea42a6810524402160e  gcc/testsuite/ada/acats-2/tests/c3/c35502h.ada
! 4e03c40da8c9f6a6c779600f4bf06f72  gcc/testsuite/ada/acats-2/tests/c3/c35502i.ada
! 0ce71c0ba8fc8137892f8032070143cf  gcc/testsuite/ada/acats-2/tests/c3/c35502j.ada
! 039caaa9e43f4d6e115a8a1f83eeebf1  gcc/testsuite/ada/acats-2/tests/c3/c35502k.ada
! 211eda1bcd28ea4725982c3228537ce8  gcc/testsuite/ada/acats-2/tests/c3/c35502l.ada
! 04a6b32af2cf206734bf10b9c20a1a53  gcc/testsuite/ada/acats-2/tests/c3/c35502m.ada
! 4d2fd9e74373c5a73cc4f819206b0ae4  gcc/testsuite/ada/acats-2/tests/c3/c35502n.ada
! a2f7774ccd8fe3b58f670146427b1f58  gcc/testsuite/ada/acats-2/tests/c3/c35502o.ada
! 244d3a03a5bfb9a02be2cde7af593c88  gcc/testsuite/ada/acats-2/tests/c3/c35502p.ada
! bbea92be5e14aa812d5b0bf50f43ecd2  gcc/testsuite/ada/acats-2/tests/c3/c35503a.ada
! e45620aeea62423f2a72fa98c32c2629  gcc/testsuite/ada/acats-2/tests/c3/c35503b.ada
! 6ff5a195541e611e8f795764a46c96c7  gcc/testsuite/ada/acats-2/tests/c3/c35503c.ada
! ae4f0df020df3fca42928a76d16433e2  gcc/testsuite/ada/acats-2/tests/c3/c35503d.tst
! 2835676122accf27f7f9912ed7f9b38b  gcc/testsuite/ada/acats-2/tests/c3/c35503e.ada
! 18bbb578fe3d479a11c962d128286c04  gcc/testsuite/ada/acats-2/tests/c3/c35503f.tst
! def2f804ca12f62b8b5f42c18fa649c0  gcc/testsuite/ada/acats-2/tests/c3/c35503g.ada
! 082f524dedff546b67bf566735caa1c1  gcc/testsuite/ada/acats-2/tests/c3/c35503h.ada
! 85174a7f410200513d18d173743c7474  gcc/testsuite/ada/acats-2/tests/c3/c35503k.ada
! 57ae4c28160a4dfa61de89bc057c9b02  gcc/testsuite/ada/acats-2/tests/c3/c35503l.ada
! 5fc96deb857ba3b7ec7ee6040f2b7d93  gcc/testsuite/ada/acats-2/tests/c3/c35503o.ada
! 02c17920bbabcf5f472c332ee0439df3  gcc/testsuite/ada/acats-2/tests/c3/c35503p.ada
! 7c0f95cda266f19784cd481570ffcf1a  gcc/testsuite/ada/acats-2/tests/c3/c35504a.ada
! 58ca27427f3b7371702549078677cd48  gcc/testsuite/ada/acats-2/tests/c3/c35504b.ada
! c64ed7ab5ced440f95e39eb0465b431f  gcc/testsuite/ada/acats-2/tests/c3/c35505c.ada
! 8a20049a7aa4dbf5e73f4a4a856df916  gcc/testsuite/ada/acats-2/tests/c3/c35505e.ada
! fb8432e5868c1977e525882401096430  gcc/testsuite/ada/acats-2/tests/c3/c35505f.ada
! a3d1f58b38d0f57e89521134057aa0d0  gcc/testsuite/ada/acats-2/tests/c3/c35507a.ada
! fe46e6e48a084e26027a960dcecf0e7f  gcc/testsuite/ada/acats-2/tests/c3/c35507b.ada
! 6276ac14d36049ca6fc1d65937918d6d  gcc/testsuite/ada/acats-2/tests/c3/c35507c.ada
! 38f75633d1d28c38660ac311815075c6  gcc/testsuite/ada/acats-2/tests/c3/c35507e.ada
! 068b315520036392da2decdadf03f6c9  gcc/testsuite/ada/acats-2/tests/c3/c35507g.ada
! c2e6c5681cde5371d2678d0afe2a7dbc  gcc/testsuite/ada/acats-2/tests/c3/c35507h.ada
! 63dad9c02cf9b0faee9f7a4c8f1e9e2d  gcc/testsuite/ada/acats-2/tests/c3/c35507i.ada
! 1501d4b22ff6ada18bda2bec24e23c79  gcc/testsuite/ada/acats-2/tests/c3/c35507j.ada
! 09885e80b2822b3187740ca5682c20e8  gcc/testsuite/ada/acats-2/tests/c3/c35507k.ada
! 7cef3fe8bb6274e0323e822d047490b2  gcc/testsuite/ada/acats-2/tests/c3/c35507l.ada
! b1e4ee7af4f56f20553663a9e296595e  gcc/testsuite/ada/acats-2/tests/c3/c35507m.ada
! cecbaaea0b8f341a4305a221c28843fc  gcc/testsuite/ada/acats-2/tests/c3/c35507n.ada
! 52e0a241e2ad05fa89ecb293e6e2445a  gcc/testsuite/ada/acats-2/tests/c3/c35507o.ada
! 600e023fcb478381f0a8d0bde64f42ce  gcc/testsuite/ada/acats-2/tests/c3/c35507p.ada
! f33cc8ac90e96b7b226aaec5ae692195  gcc/testsuite/ada/acats-2/tests/c3/c35508a.ada
! 7e48a5fa6e02b3658f287da356b209f9  gcc/testsuite/ada/acats-2/tests/c3/c35508b.ada
! 4b6b6e92f28c0ad3cd4f67af8ad0c06c  gcc/testsuite/ada/acats-2/tests/c3/c35508c.ada
! 8bbddf95307b94ae0ed7e12152746762  gcc/testsuite/ada/acats-2/tests/c3/c35508e.ada
! dbe54ec8ce5e33dd88ae24a43cfde531  gcc/testsuite/ada/acats-2/tests/c3/c35508g.ada
! e637f96ce7f08585f2d85fee50f734ee  gcc/testsuite/ada/acats-2/tests/c3/c35508h.ada
! 362619ef40ffff0fd56dee7a6a6c51ab  gcc/testsuite/ada/acats-2/tests/c3/c35508k.ada
! 62ca0e421d4722ad32f139648ece0a60  gcc/testsuite/ada/acats-2/tests/c3/c35508l.ada
! fab2b9fed9304046c3feed68fb9e7b50  gcc/testsuite/ada/acats-2/tests/c3/c35508o.ada
! a7e4e9b85072c7fc56cd223463426c4d  gcc/testsuite/ada/acats-2/tests/c3/c35508p.ada
! bb15d1d296a4eddc9aada6a363360729  gcc/testsuite/ada/acats-2/tests/c3/c35703a.ada
! 97d3b53eb2177ea6344c1ef49c98377d  gcc/testsuite/ada/acats-2/tests/c3/c35704a.ada
! 5a690257e776d58a4fd2a23a7ba6c0e9  gcc/testsuite/ada/acats-2/tests/c3/c35704b.ada
! 52a2a628059a70786108ace7ccd9d08f  gcc/testsuite/ada/acats-2/tests/c3/c35704c.ada
! 14756c69c53e152b3ede55a2754a4d33  gcc/testsuite/ada/acats-2/tests/c3/c35704d.ada
! 22b7d640a1b7ab1933a5654507ff5814  gcc/testsuite/ada/acats-2/tests/c3/c35801d.ada
! 23943917f960018ecdfb861e2c69b545  gcc/testsuite/ada/acats-2/tests/c3/c35902d.ada
! 1e5392accfe4bd85f17ca7c456747be3  gcc/testsuite/ada/acats-2/tests/c3/c35904a.ada
! 4c8ee2a79f1878dcbca7246e9e436865  gcc/testsuite/ada/acats-2/tests/c3/c35904b.ada
! 73fbf4f7e465d5d7fdbee3c99d7cf9ec  gcc/testsuite/ada/acats-2/tests/c3/c35a02a.ada
! 9f8c6fe2edc1ad0a78efbb5038b9ef99  gcc/testsuite/ada/acats-2/tests/c3/c35a05a.ada
! 57fc2536f06ceaf5a1604ee5bb5605fd  gcc/testsuite/ada/acats-2/tests/c3/c35a05d.ada
! ccf547732379c7144c27839f695e8a78  gcc/testsuite/ada/acats-2/tests/c3/c35a05n.ada
! ef904f577e7d9c35099e7d144f51bcce  gcc/testsuite/ada/acats-2/tests/c3/c35a05q.ada
! 3682cd83d6b388849e97129de990f52d  gcc/testsuite/ada/acats-2/tests/c3/c35a07a.ada
! 03e887c344e6bdbdb22118ff77b769fd  gcc/testsuite/ada/acats-2/tests/c3/c35a07d.ada
! ccdad741543d79671fc5f73037ff418d  gcc/testsuite/ada/acats-2/tests/c3/c35a08b.ada
! 651df98436a6167a850f437a29dc7a94  gcc/testsuite/ada/acats-2/tests/c3/c360002.a
! a4c274a3e03fe30e6bc786063bfe78e9  gcc/testsuite/ada/acats-2/tests/c3/c36104a.ada
! b016b5195b1a9d3c07192416c89e1bee  gcc/testsuite/ada/acats-2/tests/c3/c36104b.ada
! 43912684d172c672071ee16d854bcff0  gcc/testsuite/ada/acats-2/tests/c3/c36172a.ada
! 2dc69a4f44addfae37b13335df258285  gcc/testsuite/ada/acats-2/tests/c3/c36172b.ada
! 4d07671447e230f3eddc684c6a3b557a  gcc/testsuite/ada/acats-2/tests/c3/c36172c.ada
! 38a8a16720ac5a8741105f6c5f506f2d  gcc/testsuite/ada/acats-2/tests/c3/c36174a.ada
! 87012e291c8acd51799d9ca8b8fccc32  gcc/testsuite/ada/acats-2/tests/c3/c36180a.ada
! f887210d32ff420cd8ec888ca5c13b66  gcc/testsuite/ada/acats-2/tests/c3/c36202c.ada
! c48c400b884ae534788fbff1510b95ba  gcc/testsuite/ada/acats-2/tests/c3/c36203a.ada
! 93d36d6ba5a23a2f985cc842911a6b2f  gcc/testsuite/ada/acats-2/tests/c3/c36204a.ada
! 5ae3804a2577f9be85df4c11dd1ba3ab  gcc/testsuite/ada/acats-2/tests/c3/c36204b.ada
! 95f946b45603237266057103729c0a9c  gcc/testsuite/ada/acats-2/tests/c3/c36204c.ada
! 1a555d9bc9de255c02e401d7956a5f67  gcc/testsuite/ada/acats-2/tests/c3/c36204d.ada
! c5d2782fd60778b2578f9cf486e811db  gcc/testsuite/ada/acats-2/tests/c3/c36205a.ada
! 4842fc730e500b00c7c35f4691be2855  gcc/testsuite/ada/acats-2/tests/c3/c36205b.ada
! 725f9fbf3157baa9a668acc5e689a06b  gcc/testsuite/ada/acats-2/tests/c3/c36205c.ada
! a9d6124e64589b143b6b54d575df431b  gcc/testsuite/ada/acats-2/tests/c3/c36205d.ada
! c016e1338001bb0d007af7bf4e20d911  gcc/testsuite/ada/acats-2/tests/c3/c36205e.ada
! 299e459d577a85781464563cd621f1b4  gcc/testsuite/ada/acats-2/tests/c3/c36205f.ada
! 7f182ba91c9a0f80d0e5e5b7e919ac56  gcc/testsuite/ada/acats-2/tests/c3/c36205g.ada
! 7559d4ebfc8d9c23879d2cc42d3ac0f4  gcc/testsuite/ada/acats-2/tests/c3/c36205h.ada
! d11eed873d3f614674f193f130b127bb  gcc/testsuite/ada/acats-2/tests/c3/c36205i.ada
! 65b17684e8953d820a69eb11dc4d63e4  gcc/testsuite/ada/acats-2/tests/c3/c36205j.ada
! 21f3a9a788ac6136e2b453f0fc99959f  gcc/testsuite/ada/acats-2/tests/c3/c36205k.ada
! 9884f944a4c4faaee8aaf09a92235c3a  gcc/testsuite/ada/acats-2/tests/c3/c36205l.ada
! 1552dfb23215604db6043c7d12dfc7a6  gcc/testsuite/ada/acats-2/tests/c3/c36301a.ada
! eb37821c1c0e190f8c8cd0e7d282bc9e  gcc/testsuite/ada/acats-2/tests/c3/c36301b.ada
! 236dab07c2bafa07e92d082fc822c8b4  gcc/testsuite/ada/acats-2/tests/c3/c36302a.ada
! a1b4d4c17da94ac478b85b56fd32bf91  gcc/testsuite/ada/acats-2/tests/c3/c36304a.ada
! 58595c82c4f76f6be31333ec0267a9c8  gcc/testsuite/ada/acats-2/tests/c3/c36305a.ada
! 871a3ce65e5d5a824131380a060f18e0  gcc/testsuite/ada/acats-2/tests/c3/c37002a.ada
! 8415fb7acaf9ab73e2a230b45778e7c8  gcc/testsuite/ada/acats-2/tests/c3/c37003a.ada
! b93e53c5cd23520b5b0b88e8c4aee165  gcc/testsuite/ada/acats-2/tests/c3/c37003b.ada
! 0396184f11f01fdd09e40a2432a7850c  gcc/testsuite/ada/acats-2/tests/c3/c37005a.ada
! 17dc351de12194e77f5fe4b5ffbc733e  gcc/testsuite/ada/acats-2/tests/c3/c37006a.ada
! 96813863f2ee2182c3f68f999a7ffed2  gcc/testsuite/ada/acats-2/tests/c3/c37008a.ada
! 9f784c997bf1bb09fe9bf639408dd25c  gcc/testsuite/ada/acats-2/tests/c3/c37008b.ada
! 5d7d0f22be016c0f9b4bcb1da25ed1a2  gcc/testsuite/ada/acats-2/tests/c3/c37009a.ada
! ffc6187aa3ecc28b0631a384e1f95a7e  gcc/testsuite/ada/acats-2/tests/c3/c37010a.ada
! 029c8fb134594e913fe650a5763a4515  gcc/testsuite/ada/acats-2/tests/c3/c37010b.ada
! 09e452317c2c5a3df881f8bfc5bad1ca  gcc/testsuite/ada/acats-2/tests/c3/c371001.a
! 194d5579b14c8d78edccb4725e786bbb  gcc/testsuite/ada/acats-2/tests/c3/c371002.a
! 6508ac6c82ccaf89245ddeb239cf8c65  gcc/testsuite/ada/acats-2/tests/c3/c371003.a
! efcbd19428af8ce2430d60f7389f98f7  gcc/testsuite/ada/acats-2/tests/c3/c37102b.ada
! b56d339ed47321b90862af1e6ff54f3c  gcc/testsuite/ada/acats-2/tests/c3/c37103a.ada
! d2b9a9804b8282550c3233d4c850e203  gcc/testsuite/ada/acats-2/tests/c3/c37105a.ada
! dff6fe14498b4430a005271952b8508b  gcc/testsuite/ada/acats-2/tests/c3/c37107a.ada
! cab8fff51d9e7fa6be5dc3722f0805a7  gcc/testsuite/ada/acats-2/tests/c3/c37108b.ada
! ac1c74612e7098a8b3c19c4233f91b36  gcc/testsuite/ada/acats-2/tests/c3/c37206a.ada
! da4a6484624a6563a3acad74e59e553f  gcc/testsuite/ada/acats-2/tests/c3/c37207a.ada
! 793d448b9373aca3bdfbeb16c4cd5664  gcc/testsuite/ada/acats-2/tests/c3/c37208a.ada
! 19e934b5c86da61793fb4bde9faf4f4a  gcc/testsuite/ada/acats-2/tests/c3/c37208b.ada
! cfc2d39b74fd2d6964787190ac03afde  gcc/testsuite/ada/acats-2/tests/c3/c37209a.ada
! a9e5da6e96624ea9e8d99c31a879bea0  gcc/testsuite/ada/acats-2/tests/c3/c37209b.ada
! 5095a03dbf61f1c7486ce4249ebd4168  gcc/testsuite/ada/acats-2/tests/c3/c37210a.ada
! 13fd1f169bebade45dcc8f783c4dfba5  gcc/testsuite/ada/acats-2/tests/c3/c37211a.ada
! 90539e4b0a8ab5a720d93e61332d4bad  gcc/testsuite/ada/acats-2/tests/c3/c37211b.ada
! b5fb0f0cfa820aa9c8f8a02529b59ae1  gcc/testsuite/ada/acats-2/tests/c3/c37211c.ada
! 34158bf765252e909102a5071bd1ab0d  gcc/testsuite/ada/acats-2/tests/c3/c37211d.ada
! 9723d82d289b6c708a4e38619a050c44  gcc/testsuite/ada/acats-2/tests/c3/c37211e.ada
! 02567718a426a27f1633a5ba46fb39ea  gcc/testsuite/ada/acats-2/tests/c3/c37213b.ada
! 0db6468aa3789fa4eb8509864bbbba6c  gcc/testsuite/ada/acats-2/tests/c3/c37213d.ada
! c3ea989d669b26ad147ec1d36d59f8b1  gcc/testsuite/ada/acats-2/tests/c3/c37213f.ada
! c7d6b08bb4739fe27a9bf7c37153611b  gcc/testsuite/ada/acats-2/tests/c3/c37213h.ada
! e1a81fd713875796f8f0f1d1d856df2e  gcc/testsuite/ada/acats-2/tests/c3/c37213j.ada
! 8824529732962a1fb9cbd428d01a57f5  gcc/testsuite/ada/acats-2/tests/c3/c37213k.ada
! 7c2df003cd7fdc0bffaa00b7e5a76295  gcc/testsuite/ada/acats-2/tests/c3/c37213l.ada
! d1bb01398cfb6ee5cd12ec89604227fb  gcc/testsuite/ada/acats-2/tests/c3/c37215b.ada
! f34c6fc15658b1b04a69e1ccf32c7394  gcc/testsuite/ada/acats-2/tests/c3/c37215d.ada
! ca62cbc7b583fe934a8091c539e55305  gcc/testsuite/ada/acats-2/tests/c3/c37215f.ada
! 8be60a6919ae5d9ba615eb624746100d  gcc/testsuite/ada/acats-2/tests/c3/c37215h.ada
! fdd60b015f299bfc5d8e0f9f33334f8e  gcc/testsuite/ada/acats-2/tests/c3/c37217a.ada
! bb84ce5410a8c6c7127939120ba80cde  gcc/testsuite/ada/acats-2/tests/c3/c37217b.ada
! 2687c3f166eabbae25fc5e04880d06a3  gcc/testsuite/ada/acats-2/tests/c3/c37217c.ada
! db9ca52d8b1a818e4d66aea96b3eb964  gcc/testsuite/ada/acats-2/tests/c3/c37304a.ada
! 59413b6b57aae9caadc41c111c74faed  gcc/testsuite/ada/acats-2/tests/c3/c37305a.ada
! 2ff906f6262ecd1cfdaffbcda07f1a76  gcc/testsuite/ada/acats-2/tests/c3/c37306a.ada
! a6f2da7b55ad908aebb841bc6ed9b69e  gcc/testsuite/ada/acats-2/tests/c3/c37309a.ada
! 54ec04c8663d10e960eb022fed3a9306  gcc/testsuite/ada/acats-2/tests/c3/c37310a.ada
! ab733e44603296f9e49a292ad601cf74  gcc/testsuite/ada/acats-2/tests/c3/c37312a.ada
! 75ac97c1a116dcc5edcc7f2b44f304f4  gcc/testsuite/ada/acats-2/tests/c3/c37402a.ada
! 2d432b792b7c7b0669844add896bb802  gcc/testsuite/ada/acats-2/tests/c3/c37403a.ada
! 38ed181e9e32218f4a81d412e83c503d  gcc/testsuite/ada/acats-2/tests/c3/c37404a.ada
! c1cce1fda9f9c6085ecce4e278182d6c  gcc/testsuite/ada/acats-2/tests/c3/c37404b.ada
! c9abb9613df5a6b0ab399a10551d5070  gcc/testsuite/ada/acats-2/tests/c3/c37405a.ada
! 1793c94eca80b29526f7ec7a9da864e8  gcc/testsuite/ada/acats-2/tests/c3/c37411a.ada
! 3d8871a14f5b0b92ab5699036c27161b  gcc/testsuite/ada/acats-2/tests/c3/c380001.a
! fe1bbd01b7e70108e4de5854ee4c098d  gcc/testsuite/ada/acats-2/tests/c3/c380002.a
! fb52cd7cb9118b93afa2bc8a309ecdc9  gcc/testsuite/ada/acats-2/tests/c3/c380003.a
! 7e465d24377190b6eaafcc3fd3125ff9  gcc/testsuite/ada/acats-2/tests/c3/c380004.a
! c76f2865cda03e9d5c2164052031d578  gcc/testsuite/ada/acats-2/tests/c3/c38002a.ada
! 5c8aaef6a8da893998485cc8bfb71f48  gcc/testsuite/ada/acats-2/tests/c3/c38002b.ada
! f8397d669785d9d911c494e0a0b9986a  gcc/testsuite/ada/acats-2/tests/c3/c38005a.ada
! 36a372c2d5368726208b1f76f95f3c1d  gcc/testsuite/ada/acats-2/tests/c3/c38005b.ada
! 175ff60b11884803275c5a95d4db9b0f  gcc/testsuite/ada/acats-2/tests/c3/c38005c.ada
! 7a5b5f5b1ac7d54c9a2cff42582467fb  gcc/testsuite/ada/acats-2/tests/c3/c38006a.ada
! cc457354e31fc1e63179de33cbefbad9  gcc/testsuite/ada/acats-2/tests/c3/c38102a.ada
! 2f60ee39cadeb5e04f93c0fb98c2ff78  gcc/testsuite/ada/acats-2/tests/c3/c38102b.ada
! 773c45b11f80bfa2c11a621982312a41  gcc/testsuite/ada/acats-2/tests/c3/c38102c.ada
! 2eec2f09807572ff6be386c41f2aa890  gcc/testsuite/ada/acats-2/tests/c3/c38102d.ada
! ff2ae7294328aba3ca946b298ff89249  gcc/testsuite/ada/acats-2/tests/c3/c38102e.ada
! 19d2c8a98b84fc28fb173b8ede249f5f  gcc/testsuite/ada/acats-2/tests/c3/c38104a.ada
! ccdff83c46a0742a6f6c98f395885cf0  gcc/testsuite/ada/acats-2/tests/c3/c38107a.ada
! 5b807a368e5b577c901a0143b328edd6  gcc/testsuite/ada/acats-2/tests/c3/c38107b.ada
! 7f519d74032c869b16bf7e4cc3f1757c  gcc/testsuite/ada/acats-2/tests/c3/c38108a.ada
! 1cdb4b2554cc632c2786a14302f39123  gcc/testsuite/ada/acats-2/tests/c3/c38108b.ada
! 0c83db01ff09f439f6a7fc807e878547  gcc/testsuite/ada/acats-2/tests/c3/c38108c0.ada
! 0b0a2c9346188afcf5a240958d58cb60  gcc/testsuite/ada/acats-2/tests/c3/c38108c1.ada
! 1cea347b513b856254a8e9fed08d945a  gcc/testsuite/ada/acats-2/tests/c3/c38108c2.ada
! fb749693f49b0edcfffc4444290ac564  gcc/testsuite/ada/acats-2/tests/c3/c38108d0.ada
! aa2833688968ca7a3e36612070b575f4  gcc/testsuite/ada/acats-2/tests/c3/c38108d1.ada
! 8e9cd24cf69e1375408ec439a96f964f  gcc/testsuite/ada/acats-2/tests/c3/c38202a.ada
! 61680b9ec1c444c4faffd8c59cce698a  gcc/testsuite/ada/acats-2/tests/c3/c3900010.a
! 987d00ae68ea07578bf45fc567352a66  gcc/testsuite/ada/acats-2/tests/c3/c3900011.am
! 370d5eba0eee3ce909caf87c342f846d  gcc/testsuite/ada/acats-2/tests/c3/c390002.a
! 6dd703dff40d77030a2c6329094e7802  gcc/testsuite/ada/acats-2/tests/c3/c390003.a
! 491d840ce3aeb642239cc28533a9ba34  gcc/testsuite/ada/acats-2/tests/c3/c390004.a
! b04ffb8d071dcf6547533038ef227651  gcc/testsuite/ada/acats-2/tests/c3/c3900050.a
! dff18ad9fb367bc37acd04d6e08e55bf  gcc/testsuite/ada/acats-2/tests/c3/c3900051.a
! 2b39948b2af313cbed0046a2bcdcbc9d  gcc/testsuite/ada/acats-2/tests/c3/c3900052.a
! b4e44c9c1971345223585500a55db164  gcc/testsuite/ada/acats-2/tests/c3/c3900053.am
! 471e818df49cf1a32357c5b759d21dc9  gcc/testsuite/ada/acats-2/tests/c3/c3900060.a
! bd65238f7cda09d91e177736cdbcd7ec  gcc/testsuite/ada/acats-2/tests/c3/c3900061.a
! d3e9ddf4af2eb46f1b086dbc43c75d04  gcc/testsuite/ada/acats-2/tests/c3/c3900062.a
! bced3ae0c872e2f15b26193b1c9c4c35  gcc/testsuite/ada/acats-2/tests/c3/c3900063.am
! cd1ae54278fd1b61d5ecd166ecf0671b  gcc/testsuite/ada/acats-2/tests/c3/c390007.a
! a7cf99b62949613099d6c982d9043098  gcc/testsuite/ada/acats-2/tests/c3/c390010.a
! 30e5b9a42c18864d89a931830adfd68e  gcc/testsuite/ada/acats-2/tests/c3/c390011.a
! 1bcaf1b15ae617d49c80e68b55943cc6  gcc/testsuite/ada/acats-2/tests/c3/c39006a.ada
! 7e954943167e1f1855ce0abf856c9a9b  gcc/testsuite/ada/acats-2/tests/c3/c39006b.ada
! 14d52be4c2d938b4ae51c17507b6ca25  gcc/testsuite/ada/acats-2/tests/c3/c39006c0.ada
! c770912acdec8d8fa7169157d99a1382  gcc/testsuite/ada/acats-2/tests/c3/c39006c1.ada
! fcf5b4e7ecc49a79fc11640baf53f4f6  gcc/testsuite/ada/acats-2/tests/c3/c39006d.ada
! 86ddd0b2d946750357311d89b5046963  gcc/testsuite/ada/acats-2/tests/c3/c39006e.ada
! ba4887d359d62403c79f3563b0dfa8f4  gcc/testsuite/ada/acats-2/tests/c3/c39006f0.ada
! 205b6ff97343a4403e8cb5bc33883547  gcc/testsuite/ada/acats-2/tests/c3/c39006f1.ada
! 16ddc19c6da0a1642305e4b5fc6058d1  gcc/testsuite/ada/acats-2/tests/c3/c39006f2.ada
! 59cfdb727f33418fa8de537e14629d71  gcc/testsuite/ada/acats-2/tests/c3/c39006f3.ada
! f80f760d35130556602f0b683e480d63  gcc/testsuite/ada/acats-2/tests/c3/c39006g.ada
! cce3352413b69fd05b5ec5195c3a4c00  gcc/testsuite/ada/acats-2/tests/c3/c39007a.ada
! eab8b6c595bc019ed0d33f826e34e97f  gcc/testsuite/ada/acats-2/tests/c3/c39007b.ada
! f9502bdaffb8475b46fab174a19f2de9  gcc/testsuite/ada/acats-2/tests/c3/c39008a.ada
! 44f9dead72582206f122372b79949f92  gcc/testsuite/ada/acats-2/tests/c3/c39008b.ada
! f7c867df153c4137ff42c73e84cf78bb  gcc/testsuite/ada/acats-2/tests/c3/c39008c.ada
! 7dfc2d2eea8f430d414e0e9fb3d66efb  gcc/testsuite/ada/acats-2/tests/c3/c390a010.a
! fe7593d56cc6f8290c29978513afc0e4  gcc/testsuite/ada/acats-2/tests/c3/c390a011.am
! 11b0510a4ce65e5a57a44f990501c66a  gcc/testsuite/ada/acats-2/tests/c3/c390a020.a
! 4282bd0ba35b056f1611e8c863c8745e  gcc/testsuite/ada/acats-2/tests/c3/c390a021.a
! cf96da721f34cf963ac9c04fdedb4a5a  gcc/testsuite/ada/acats-2/tests/c3/c390a022.am
! 9cc816e53154c542095db060de988727  gcc/testsuite/ada/acats-2/tests/c3/c390a030.a
! a2ad2209c88d74fd376c9daf08c00e0c  gcc/testsuite/ada/acats-2/tests/c3/c390a031.am
! 40bd1c7f8a70fb208644304788e8bdc6  gcc/testsuite/ada/acats-2/tests/c3/c391001.a
! 2dc32344161fe05900a7d0a4fb00a90b  gcc/testsuite/ada/acats-2/tests/c3/c391002.a
! 1cea1692179d434f0ff9e71ba3af5c1e  gcc/testsuite/ada/acats-2/tests/c3/c392002.a
! 918e8c097a09a06159f2809df40a1418  gcc/testsuite/ada/acats-2/tests/c3/c392003.a
! 65856b8c6fecfcf755607b20116e49ef  gcc/testsuite/ada/acats-2/tests/c3/c392004.a
! add1a6bb172c420d5b75dd9efb48c6bd  gcc/testsuite/ada/acats-2/tests/c3/c392005.a
! 1e3c83f529cb7a93f087fd5e1d1c8da3  gcc/testsuite/ada/acats-2/tests/c3/c392008.a
! fdbaa3ed4337e597d16209533ad30839  gcc/testsuite/ada/acats-2/tests/c3/c392010.a
! 8063c17c7054236de05a0d6a56818802  gcc/testsuite/ada/acats-2/tests/c3/c392011.a
! 66f6cf830b25e4cba2aeaac6801b02e2  gcc/testsuite/ada/acats-2/tests/c3/c392013.a
! 3597acb12cde69e45603917fc97c80c0  gcc/testsuite/ada/acats-2/tests/c3/c392014.a
! 35f1f390e8606d404b61bb05a639d3be  gcc/testsuite/ada/acats-2/tests/c3/c392a01.a
! ddeb268075e3a716a055f61676497b78  gcc/testsuite/ada/acats-2/tests/c3/c392c05.a
! ee8edde3e11e29c877773403259133c0  gcc/testsuite/ada/acats-2/tests/c3/c392c07.a
! cf19325c05dcb02f4dc60d58ef26ea2b  gcc/testsuite/ada/acats-2/tests/c3/c392d01.a
! acfb41d6d4b4fdec20be56da91d7037d  gcc/testsuite/ada/acats-2/tests/c3/c392d02.a
! 1db19d15d9fdd4071bc438e73f6c5f60  gcc/testsuite/ada/acats-2/tests/c3/c392d03.a
! 9913afe2e224eb447dd2ba6e7b6cd62d  gcc/testsuite/ada/acats-2/tests/c3/c393001.a
! cb66f262f22e933b78a4b4ff7f314ebb  gcc/testsuite/ada/acats-2/tests/c3/c393007.a
! fa7a91fbda6d3ec270401392bfa2a76e  gcc/testsuite/ada/acats-2/tests/c3/c393008.a
! 725749e586aef7b3172e0a9f654508c9  gcc/testsuite/ada/acats-2/tests/c3/c393009.a
! 21bc1c6b2b56e0fe4e98a124b3a43036  gcc/testsuite/ada/acats-2/tests/c3/c393010.a
! cd6d2722ead0dbebda558b3eed5c7ca4  gcc/testsuite/ada/acats-2/tests/c3/c393011.a
! 7df68c4f3488082bba3f1654a9ba7910  gcc/testsuite/ada/acats-2/tests/c3/c393012.a
! 5bf5e79116361f7f6818018607c7b14c  gcc/testsuite/ada/acats-2/tests/c3/c393a02.a
! 46faa2017a32e6ba0d55237311c2594b  gcc/testsuite/ada/acats-2/tests/c3/c393a03.a
! eafd936400d5d6d12f0163e2eddfac6b  gcc/testsuite/ada/acats-2/tests/c3/c393a05.a
! db0cccf9a144062cc832a2649c8b3890  gcc/testsuite/ada/acats-2/tests/c3/c393a06.a
! 8714b97cca38041a9f7e9366aef2ea6f  gcc/testsuite/ada/acats-2/tests/c3/c393b12.a
! 7035657702431ed63b2d07b818986f02  gcc/testsuite/ada/acats-2/tests/c3/c393b13.a
! 53c07ae14d9fb175ce43218b1e343038  gcc/testsuite/ada/acats-2/tests/c3/c393b14.a
! c2ac600ac5856ef7dd1dbc9289ad5b3a  gcc/testsuite/ada/acats-2/tests/c3/c3a0001.a
! 031b3fc5f0a32a51bded67c7ecc17317  gcc/testsuite/ada/acats-2/tests/c3/c3a0002.a
! c31f440d35b722f58fbb9350b06d125c  gcc/testsuite/ada/acats-2/tests/c3/c3a0003.a
! 2297f4ac861d78f2371edd9c4a2d7c6c  gcc/testsuite/ada/acats-2/tests/c3/c3a0004.a
! 32ac31994b6e97c7cfc3da69b63041ca  gcc/testsuite/ada/acats-2/tests/c3/c3a0005.a
! d86e5a6cc083a8024c11012097ddad34  gcc/testsuite/ada/acats-2/tests/c3/c3a0006.a
! 27a88a8b1aa1655fbfad671608eb6590  gcc/testsuite/ada/acats-2/tests/c3/c3a0007.a
! 2c75b971c54a5abc55846c25177a2d32  gcc/testsuite/ada/acats-2/tests/c3/c3a0008.a
! 0b8bb10fc6969853e244dca2a5176000  gcc/testsuite/ada/acats-2/tests/c3/c3a0009.a
! ed1e9211c87a814c4afe091b58de454c  gcc/testsuite/ada/acats-2/tests/c3/c3a0010.a
! e9e7d7fe8183ee50353cfccbd67ce241  gcc/testsuite/ada/acats-2/tests/c3/c3a0011.a
! c7fcc74fd4dfdbaffcb6c91b90a50060  gcc/testsuite/ada/acats-2/tests/c3/c3a00120.a
! 74ba294edd61c27b3a700c248bd041e9  gcc/testsuite/ada/acats-2/tests/c3/c3a00121.a
! b5687449024e6ae74c2b54cbbf12b721  gcc/testsuite/ada/acats-2/tests/c3/c3a00122.am
! e7d92335b6aec84b884e9a11162a306e  gcc/testsuite/ada/acats-2/tests/c3/c3a0013.a
! 2fdbc8cb627a0ba4818773199ea59e8b  gcc/testsuite/ada/acats-2/tests/c3/c3a0014.a
! cbdd24e39ac8fba7e5ea4a0975d79298  gcc/testsuite/ada/acats-2/tests/c3/c3a0015.a
! 21ce522f0e81e68685347a0f9b6064f3  gcc/testsuite/ada/acats-2/tests/c3/c3a1001.a
! 03f9fa0b3ade6732c9e7b1792aa29352  gcc/testsuite/ada/acats-2/tests/c3/c3a1002.a
! 73e86224d17f2a8956a1d528195701e5  gcc/testsuite/ada/acats-2/tests/c3/c3a2001.a
! e2d17cf34da20dd63f46abc38e9461f2  gcc/testsuite/ada/acats-2/tests/c3/c3a2002.a
! 3c24e7e447372dec84c3b1cf5f273936  gcc/testsuite/ada/acats-2/tests/c3/c3a2003.a
! cddb5c363c31a2ba7b970cf9dc8e3f5e  gcc/testsuite/ada/acats-2/tests/c3/c3a2a01.a
! 4247f0b657aa158ef18c1318e9dc8b84  gcc/testsuite/ada/acats-2/tests/c3/c3a2a02.a
! 383d36d8bd8f651b81f9f034c79f6395  gcc/testsuite/ada/acats-2/tests/c4/c410001.a
! dc852bc88874efd64494341e97b01bfb  gcc/testsuite/ada/acats-2/tests/c4/c41101d.ada
! 6f5f34a6a9fa1d906503ce64081a9fb1  gcc/testsuite/ada/acats-2/tests/c4/c41103a.ada
! 6881243b887f6a08d55ad39f9c71b847  gcc/testsuite/ada/acats-2/tests/c4/c41103b.ada
! 820fca3a12cccc477a1db295b46c9e89  gcc/testsuite/ada/acats-2/tests/c4/c41104a.ada
! fdbf47ad957484b7d85a3373d756e376  gcc/testsuite/ada/acats-2/tests/c4/c41105a.ada
! c4087c229334ce4727fc90657340bea6  gcc/testsuite/ada/acats-2/tests/c4/c41107a.ada
! 0f8bb517ec2fe5d8ad9dd8f9fcdca333  gcc/testsuite/ada/acats-2/tests/c4/c41201d.ada
! 381cd3656ffd77067260c0426caad8e4  gcc/testsuite/ada/acats-2/tests/c4/c41203a.ada
! f16afef9632faa3f3d798b8429057017  gcc/testsuite/ada/acats-2/tests/c4/c41203b.ada
! 9fbde81e21b268a632cd32dc4a99df30  gcc/testsuite/ada/acats-2/tests/c4/c41204a.ada
! 67fa52580bd829764d9438c881578136  gcc/testsuite/ada/acats-2/tests/c4/c41205a.ada
! 7dca543b0fdeefd218298ca3512d4136  gcc/testsuite/ada/acats-2/tests/c4/c41206a.ada
! 3ab9c169397fc23560a200fb693450fe  gcc/testsuite/ada/acats-2/tests/c4/c41207a.ada
! 20522dfe7bf33e5e0e855924df96c08e  gcc/testsuite/ada/acats-2/tests/c4/c41301a.ada
! dae21e7962c8e72b1b61657cc9649578  gcc/testsuite/ada/acats-2/tests/c4/c41303a.ada
! b50a855a96988b73e7f3549240854176  gcc/testsuite/ada/acats-2/tests/c4/c41303b.ada
! 2616024a5ab75311dd3da9466dfeb83f  gcc/testsuite/ada/acats-2/tests/c4/c41303c.ada
! 71212110be4b03b467bc38a722d121d1  gcc/testsuite/ada/acats-2/tests/c4/c41303e.ada
! 66cc6334eba1dfed1e235d86203cb20f  gcc/testsuite/ada/acats-2/tests/c4/c41303f.ada
! 924b3910bb06953e81b618bc3e559550  gcc/testsuite/ada/acats-2/tests/c4/c41303g.ada
! 045ed81e249f894170b499df2db286d6  gcc/testsuite/ada/acats-2/tests/c4/c41303i.ada
! aa4db5f52bbfc36e5c975658ef97c89a  gcc/testsuite/ada/acats-2/tests/c4/c41303j.ada
! 0f31fc1511244c83e7abb4baeac80671  gcc/testsuite/ada/acats-2/tests/c4/c41303k.ada
! f9b758389317dc92073ce01c3c275e91  gcc/testsuite/ada/acats-2/tests/c4/c41303m.ada
! 71a865e9509e3725fd95b90ec715eaa7  gcc/testsuite/ada/acats-2/tests/c4/c41303n.ada
! 8981d1c2da09086d412019a04cc8c913  gcc/testsuite/ada/acats-2/tests/c4/c41303o.ada
! 2dda9c55735424d40aed9757f7a99849  gcc/testsuite/ada/acats-2/tests/c4/c41303q.ada
! e34e7a4a5a5ba93bc9916cceeaecc9e6  gcc/testsuite/ada/acats-2/tests/c4/c41303r.ada
! 7030e6ee5fb5761b449dbb4ff5a07765  gcc/testsuite/ada/acats-2/tests/c4/c41303s.ada
! d79eb627645d3853ea5140161ae28128  gcc/testsuite/ada/acats-2/tests/c4/c41303u.ada
! bb6f238e4a4ba7e7e7d4a81bc419e03c  gcc/testsuite/ada/acats-2/tests/c4/c41303v.ada
! 30d2340bbbbe2276772e1fb63e33b4ce  gcc/testsuite/ada/acats-2/tests/c4/c41303w.ada
! 98d29cda44e41c5ff7947a4026f5e44c  gcc/testsuite/ada/acats-2/tests/c4/c41304a.ada
! 185701022ded3608ce413730986fd29a  gcc/testsuite/ada/acats-2/tests/c4/c41304b.ada
! f0ef510c95f135851ebafc318405f773  gcc/testsuite/ada/acats-2/tests/c4/c41306a.ada
! 5dd0f98f04759d0b25f9631bb3f052ba  gcc/testsuite/ada/acats-2/tests/c4/c41306b.ada
! 58245b98892f05598c91a37cc2fa0cf7  gcc/testsuite/ada/acats-2/tests/c4/c41306c.ada
! 78cff154ce4ec882d604897c85256a6f  gcc/testsuite/ada/acats-2/tests/c4/c41307d.ada
! e4f57f60d8ab4020fa02081676cd97b1  gcc/testsuite/ada/acats-2/tests/c4/c41309a.ada
! 46615dd040a05118f00cf1a6c269abf8  gcc/testsuite/ada/acats-2/tests/c4/c41320a.ada
! c87207608b642d6c0770b2213faa6f37  gcc/testsuite/ada/acats-2/tests/c4/c41321a.ada
! a2f1c6ef57f73e8afee4331c2f6b8836  gcc/testsuite/ada/acats-2/tests/c4/c41322a.ada
! 5fe80e1ed0d397d7243803f3679b1dcf  gcc/testsuite/ada/acats-2/tests/c4/c41323a.ada
! 1b628d4729417b726825d3cc545cce88  gcc/testsuite/ada/acats-2/tests/c4/c41324a.ada
! 34bb464a9c0edf77ba3cf3f225f84fac  gcc/testsuite/ada/acats-2/tests/c4/c41325a.ada
! 9f472b4f812b18261355bfdb272afaf2  gcc/testsuite/ada/acats-2/tests/c4/c41326a.ada
! c79f530e375e47fc23508a767283386e  gcc/testsuite/ada/acats-2/tests/c4/c41327a.ada
! 9dbb72dcbb910f44662d1091a9dcff76  gcc/testsuite/ada/acats-2/tests/c4/c41328a.ada
! 0449520de7d65d45ed1daf5ca0e4569b  gcc/testsuite/ada/acats-2/tests/c4/c41401a.ada
! 20918a0804a04dce0cbb4d97b451bb81  gcc/testsuite/ada/acats-2/tests/c4/c41402a.ada
! 3d9dc352053f7bb2142de6aadd56af67  gcc/testsuite/ada/acats-2/tests/c4/c41404a.ada
! 3472f5561c379717f19af41f64bf38a3  gcc/testsuite/ada/acats-2/tests/c4/c420001.a
! 837ffbb47c098000329e8e489cfada64  gcc/testsuite/ada/acats-2/tests/c4/c42006a.ada
! 3930cedf9786c67a42558e65e855c7fd  gcc/testsuite/ada/acats-2/tests/c4/c42007e.ada
! fdfa37c01ec576b222ad3107e9e17cd2  gcc/testsuite/ada/acats-2/tests/c4/c43003a.ada
! 42c7528eba63811a5183af811bdf7a65  gcc/testsuite/ada/acats-2/tests/c4/c43004a.ada
! fdfe754e9fba94c879707660c35c89c4  gcc/testsuite/ada/acats-2/tests/c4/c43004c.ada
! d381bf2fc72e35825723db4655f3c38a  gcc/testsuite/ada/acats-2/tests/c4/c431001.a
! 841914115d2e37bfbd84574493c7019f  gcc/testsuite/ada/acats-2/tests/c4/c43103a.ada
! dd65d5f3b06487b888840af62334c5a5  gcc/testsuite/ada/acats-2/tests/c4/c43103b.ada
! 9e71b6045390013211406d2c1bfb4fba  gcc/testsuite/ada/acats-2/tests/c4/c43104a.ada
! 85abcc7f64ed7b42d6fd3f22c7daeb40  gcc/testsuite/ada/acats-2/tests/c4/c43105a.ada
! 4ed22cb91cfe0bda94598dd26ceb9c7c  gcc/testsuite/ada/acats-2/tests/c4/c43105b.ada
! baec9aa149293739f6e8ceac8325d7a0  gcc/testsuite/ada/acats-2/tests/c4/c43106a.ada
! 1d531018ee649629c5a7552829150451  gcc/testsuite/ada/acats-2/tests/c4/c43107a.ada
! 05a638c334196cb191ee5128a5996f23  gcc/testsuite/ada/acats-2/tests/c4/c43108a.ada
! 4ea1f6b615b7799500e7c6933df91e82  gcc/testsuite/ada/acats-2/tests/c4/c432001.a
! 1e73ca84bb526fa8947ec4278f0151ed  gcc/testsuite/ada/acats-2/tests/c4/c432002.a
! 6ec2ee48b603324015bd74c07d8eb9fb  gcc/testsuite/ada/acats-2/tests/c4/c432003.a
! 8e738d9db0574dd56f1158230f5caa4c  gcc/testsuite/ada/acats-2/tests/c4/c432004.a
! ee94ed306c9c2f72d0f353f3242a51db  gcc/testsuite/ada/acats-2/tests/c4/c43204a.ada
! e98c1830d22cb2c31e6c97a0f3d96ad7  gcc/testsuite/ada/acats-2/tests/c4/c43204c.ada
! f0b2f2ebf435459bab0ed10112cc18b6  gcc/testsuite/ada/acats-2/tests/c4/c43204e.ada
! 7e74d89a8654aef2ebf093dc84b24d10  gcc/testsuite/ada/acats-2/tests/c4/c43204f.ada
! b266b1d1eaefa26342ce7e3c0eb10f20  gcc/testsuite/ada/acats-2/tests/c4/c43204g.ada
! 119509db1b0027b3597be4ca5abbb5bb  gcc/testsuite/ada/acats-2/tests/c4/c43204h.ada
! 67b7aebfc7ddaa75b105ec0d3e496a27  gcc/testsuite/ada/acats-2/tests/c4/c43204i.ada
! 73152cdcaa60874a7dd488590fdf9d5c  gcc/testsuite/ada/acats-2/tests/c4/c43205a.ada
! 64f982d0a7b18107f1762424333a65d3  gcc/testsuite/ada/acats-2/tests/c4/c43205b.ada
! ac552917303ade3bcc90b97b15f26e94  gcc/testsuite/ada/acats-2/tests/c4/c43205c.ada
! fb0c33a9daed1c4f2a00c26e9de3c09c  gcc/testsuite/ada/acats-2/tests/c4/c43205d.ada
! d9e706d3db07df4098bbb0e033aed012  gcc/testsuite/ada/acats-2/tests/c4/c43205e.ada
! 4f3634691d02036c149cdd006248ffe1  gcc/testsuite/ada/acats-2/tests/c4/c43205g.ada
! 5c21ffd092ad83125d058e3179c4d1bf  gcc/testsuite/ada/acats-2/tests/c4/c43205h.ada
! bf224ac40af0ffe5b844895ae6ae977a  gcc/testsuite/ada/acats-2/tests/c4/c43205i.ada
! 80a79cdbdb7c8185dcf0428e7589a584  gcc/testsuite/ada/acats-2/tests/c4/c43205j.ada
! 7914df26e752133b470cdb5c585686bc  gcc/testsuite/ada/acats-2/tests/c4/c43205k.ada
! cbadb73b68d71709f2becaa6f356064c  gcc/testsuite/ada/acats-2/tests/c4/c43206a.ada
! 0fc8105e29d6d23a3a7ddd6510322795  gcc/testsuite/ada/acats-2/tests/c4/c43207b.ada
! 97244c88eb0cfebd12378341cddfcf4f  gcc/testsuite/ada/acats-2/tests/c4/c43207d.ada
! f288bdf0f019b0e6deea7f364629093d  gcc/testsuite/ada/acats-2/tests/c4/c43208a.ada
! 70aa5e04e1aa2e8f2ffff319c6cc960a  gcc/testsuite/ada/acats-2/tests/c4/c43208b.ada
! 36f70dc294058acb31101eb9c245937b  gcc/testsuite/ada/acats-2/tests/c4/c43209a.ada
! 31cacbf3a20b821f6eb8f1d74586a51b  gcc/testsuite/ada/acats-2/tests/c4/c43210a.ada
! 54b7270b96a5d5519d2358a1b98bf7af  gcc/testsuite/ada/acats-2/tests/c4/c43211a.ada
! a692660520b9e289a7f0ae27c6d52494  gcc/testsuite/ada/acats-2/tests/c4/c43212a.ada
! c43685e66248fa05c959fb5d231800a7  gcc/testsuite/ada/acats-2/tests/c4/c43212c.ada
! 9427f327bd00f1850a52dc14567dbf4e  gcc/testsuite/ada/acats-2/tests/c4/c43214a.ada
! 2b1a3e33f54f7510083e41b401c3befb  gcc/testsuite/ada/acats-2/tests/c4/c43214b.ada
! 579da18e7294b44fdfc2fb550cccdbf3  gcc/testsuite/ada/acats-2/tests/c4/c43214c.ada
! 506424b9dbd9ff75e61b488ce4a5879e  gcc/testsuite/ada/acats-2/tests/c4/c43214d.ada
! 02fcbb175ddd0a1d8c5564d22bf12428  gcc/testsuite/ada/acats-2/tests/c4/c43214e.ada
! 34cd6d7cf5c8038e227dde683b30b50f  gcc/testsuite/ada/acats-2/tests/c4/c43214f.ada
! ab7bedd7c7899bfe816d9a4b9ac394d4  gcc/testsuite/ada/acats-2/tests/c4/c43215a.ada
! 90e0f447154023e2eab627e883738386  gcc/testsuite/ada/acats-2/tests/c4/c43215b.ada
! f0098152f11a322c39c1479f279dc3d7  gcc/testsuite/ada/acats-2/tests/c4/c43222a.ada
! bf1baa8817f6afb1d613db2046cb78de  gcc/testsuite/ada/acats-2/tests/c4/c43224a.ada
! 1e8e32f41f79462323a2f9d9c83d7939  gcc/testsuite/ada/acats-2/tests/c4/c433001.a
! 196c158a32a4bc1774a4d934b1a6632e  gcc/testsuite/ada/acats-2/tests/c4/c44003d.ada
! bf440c6d6ead3b13b20d4e127607337e  gcc/testsuite/ada/acats-2/tests/c4/c44003f.ada
! 2f9030320131a08536fa11fa1a117664  gcc/testsuite/ada/acats-2/tests/c4/c44003g.ada
! 62ba7a9a25d025dad4ded263e64d8380  gcc/testsuite/ada/acats-2/tests/c4/c450001.a
! b3687aae227c95d084c9f685c9ca4c80  gcc/testsuite/ada/acats-2/tests/c4/c45112a.ada
! c7c3ba0d233fb51ade68d7651dd47189  gcc/testsuite/ada/acats-2/tests/c4/c45112b.ada
! 49306dfa2cb372d1d65b4dd7a47c19e5  gcc/testsuite/ada/acats-2/tests/c4/c45113a.ada
! aa0781fb6f24f86504e59a47cf77b3d6  gcc/testsuite/ada/acats-2/tests/c4/c45114b.ada
! f718c72a25e47da1540690be5ff953da  gcc/testsuite/ada/acats-2/tests/c4/c452001.a
! 20ba3c7cde16d8bed844c4e64cd33e56  gcc/testsuite/ada/acats-2/tests/c4/c45201a.ada
! 6d4a1adb58c6e8ef73b34a324604ede4  gcc/testsuite/ada/acats-2/tests/c4/c45201b.ada
! 72aed4b6ea2fe7dfc0a9fdf3bede3751  gcc/testsuite/ada/acats-2/tests/c4/c45202b.ada
! 84d744855e2972095386f0e272333a6a  gcc/testsuite/ada/acats-2/tests/c4/c45210a.ada
! 91f826ce1d8f6889145f46e4c0ccada9  gcc/testsuite/ada/acats-2/tests/c4/c45211a.ada
! fe9117190ab93e4bd66b4015bb5cdba1  gcc/testsuite/ada/acats-2/tests/c4/c45220a.ada
! 6912810853452af0c8935cfd387c8df5  gcc/testsuite/ada/acats-2/tests/c4/c45220b.ada
! b394f131a9012e7c03cfd9636d737e6d  gcc/testsuite/ada/acats-2/tests/c4/c45220c.ada
! ccf331c469a0927819e1eb56e4e00429  gcc/testsuite/ada/acats-2/tests/c4/c45220d.ada
! 88d3a9ace4677cd3c025906371d2beeb  gcc/testsuite/ada/acats-2/tests/c4/c45220e.ada
! bba84a4055dd7c551f067e52bbe462e1  gcc/testsuite/ada/acats-2/tests/c4/c45220f.ada
! c13eaf9a516abfe2b6beda77dc2e3911  gcc/testsuite/ada/acats-2/tests/c4/c45231a.ada
! 2cca7d5fea02ce521f28a33db34ffa3d  gcc/testsuite/ada/acats-2/tests/c4/c45231b.dep
! 1bee766d69082269378c86e19c8abe85  gcc/testsuite/ada/acats-2/tests/c4/c45231c.dep
! a1bdfcd8a7def7dd624d3536e8905d30  gcc/testsuite/ada/acats-2/tests/c4/c45231d.tst
! 911d91bbd63a8c74f621846268c3e576  gcc/testsuite/ada/acats-2/tests/c4/c45232b.ada
! 4de95534392888683c8404eeeed6cc46  gcc/testsuite/ada/acats-2/tests/c4/c45242b.ada
! f2b98c822abe0cd6885e5b49561ac387  gcc/testsuite/ada/acats-2/tests/c4/c45251a.ada
! 94a924601ada615360bec26fb5450efb  gcc/testsuite/ada/acats-2/tests/c4/c45252a.ada
! debd13ddcb22bdcbb8a02c69693b66f8  gcc/testsuite/ada/acats-2/tests/c4/c45252b.ada
! ac031704393af45bbba41661aa36f2aa  gcc/testsuite/ada/acats-2/tests/c4/c45253a.ada
! fc9f55680d3672e261c2346c11b8ac30  gcc/testsuite/ada/acats-2/tests/c4/c45262a.ada
! c4104ba41f3003933d2540d2f946ba70  gcc/testsuite/ada/acats-2/tests/c4/c45262b.ada
! 8b9cb8019cc36523ada4859ea4a5d16a  gcc/testsuite/ada/acats-2/tests/c4/c45262c.ada
! d03448ead4d0effaab3998536c97bf20  gcc/testsuite/ada/acats-2/tests/c4/c45262d.ada
! f5c2479fb34a68704e8a8cc34f61a360  gcc/testsuite/ada/acats-2/tests/c4/c45264a.ada
! b5849bcd08a3c2d9a5d0c2b9e7a3cddd  gcc/testsuite/ada/acats-2/tests/c4/c45264b.ada
! 8f21912f6834298744357d557cb137f0  gcc/testsuite/ada/acats-2/tests/c4/c45264c.ada
! adc3cff25d9a3d6a8177af01212d7415  gcc/testsuite/ada/acats-2/tests/c4/c45265a.ada
! c4c6e9f92d1c15ec8a4b8f04c34a693f  gcc/testsuite/ada/acats-2/tests/c4/c45271a.ada
! c72a97f0fec20bbb08fc4517b6ddc788  gcc/testsuite/ada/acats-2/tests/c4/c45272a.ada
! 6b2a1a4bc714bd568da120c02fbf1702  gcc/testsuite/ada/acats-2/tests/c4/c45273a.ada
! b79ca71dc3632b190bdef98c6e0d142b  gcc/testsuite/ada/acats-2/tests/c4/c45274a.ada
! 9855409d4983ad2c1546e338fcbd0706  gcc/testsuite/ada/acats-2/tests/c4/c45274b.ada
! 435926faf09e9e479e1b1f272c13a333  gcc/testsuite/ada/acats-2/tests/c4/c45274c.ada
! 9115b9a51b29cec2f4c9ff1428f5a615  gcc/testsuite/ada/acats-2/tests/c4/c45281a.ada
! ecfe4965aad0d9bc1dc0dea01acceae3  gcc/testsuite/ada/acats-2/tests/c4/c45282a.ada
! 52a7cd2f9612b968a81d14f925d96de2  gcc/testsuite/ada/acats-2/tests/c4/c45282b.ada
! b3bd1b305af20f17ece9aabad0feaef1  gcc/testsuite/ada/acats-2/tests/c4/c45291a.ada
! c8d3cf99b5249db2c22ec520cb247e14  gcc/testsuite/ada/acats-2/tests/c4/c453001.a
! eaeb6ce37e830b736db8d34c6a83bb7d  gcc/testsuite/ada/acats-2/tests/c4/c45303a.ada
! f1ec15c9cdb65dbf13e1375cf7996f12  gcc/testsuite/ada/acats-2/tests/c4/c45304a.ada
! 55a19685b3e235e5bb6750cb9d7df962  gcc/testsuite/ada/acats-2/tests/c4/c45304b.dep
! b4c45f68d1219b0b994968a9828a7b17  gcc/testsuite/ada/acats-2/tests/c4/c45304c.dep
! 20fb36abf27afac504d4a771e7e63fd0  gcc/testsuite/ada/acats-2/tests/c4/c45322a.ada
! fab8bce97e1b74f5541c43ebbc38c44b  gcc/testsuite/ada/acats-2/tests/c4/c45323a.ada
! 0f09ca069bcacb950f308b51658fe4cf  gcc/testsuite/ada/acats-2/tests/c4/c45331a.ada
! 923c0cd8bc5f7a54a3ff10b7ecd3ae30  gcc/testsuite/ada/acats-2/tests/c4/c45342a.ada
! 4c687d4debfb2858cbde8d0598741375  gcc/testsuite/ada/acats-2/tests/c4/c45343a.ada
! fced8cf133a6e38c1bd3f44b383050a5  gcc/testsuite/ada/acats-2/tests/c4/c45344a.ada
! 046bf7cdbb7aeb33cdf0c17abb97726b  gcc/testsuite/ada/acats-2/tests/c4/c45345b.ada
! 1b975a926de8c5e1c1a8fd844dbfa809  gcc/testsuite/ada/acats-2/tests/c4/c45347a.ada
! 5c3a11fd88252878ac174be55d9cbe23  gcc/testsuite/ada/acats-2/tests/c4/c45347b.ada
! e7b0eaf3fab48f0c61a33030a45c9625  gcc/testsuite/ada/acats-2/tests/c4/c45347c.ada
! 5862189030beeea86b9e0d08e37c5f1a  gcc/testsuite/ada/acats-2/tests/c4/c45347d.ada
! 5a4ad439614a0b55cdeae637fcef3913  gcc/testsuite/ada/acats-2/tests/c4/c45411a.ada
! b55c932d505fe19faf48b3854f91bf92  gcc/testsuite/ada/acats-2/tests/c4/c45411b.dep
! cc45fca3dbdc169c3f8a8d219a8f3885  gcc/testsuite/ada/acats-2/tests/c4/c45411c.dep
! 92372898586e4be4330d20dabffa9b47  gcc/testsuite/ada/acats-2/tests/c4/c45411d.ada
! fdb465fedee3ebd743401e0c8899b0ce  gcc/testsuite/ada/acats-2/tests/c4/c45413a.ada
! fbd34bfae4961dda3c3e39ae18565fc8  gcc/testsuite/ada/acats-2/tests/c4/c45431a.ada
! bda2b940e9dc2584f9295b05e0c20b0f  gcc/testsuite/ada/acats-2/tests/c4/c455001.a
! 87ea1f3d7a54b6c25dba44fd5a571baa  gcc/testsuite/ada/acats-2/tests/c4/c45502b.dep
! 5a774d039f16514bc6a77bcf387d50ec  gcc/testsuite/ada/acats-2/tests/c4/c45502c.dep
! cc87ae3a223cabfed863304f12752609  gcc/testsuite/ada/acats-2/tests/c4/c45503a.ada
! dcadc5c668c2ff77de523cb7dba5b36a  gcc/testsuite/ada/acats-2/tests/c4/c45503b.dep
! 611398c2ae165df5a3f7381f660f52a0  gcc/testsuite/ada/acats-2/tests/c4/c45503c.dep
! f89268db15e37b030991c3827ca26c3e  gcc/testsuite/ada/acats-2/tests/c4/c45504a.ada
! f0cdb8c22aab2695a23fd98a373755b2  gcc/testsuite/ada/acats-2/tests/c4/c45504b.dep
! b8b4e008dfce1ee201519835a1fa50b8  gcc/testsuite/ada/acats-2/tests/c4/c45504c.dep
! ce29dbe3d5204283efb96dbcdfd5aac5  gcc/testsuite/ada/acats-2/tests/c4/c45504d.ada
! 10c91d5e233ba13218dcd66fb790a7be  gcc/testsuite/ada/acats-2/tests/c4/c45504e.dep
! 92f6aea3aed6ba9df5385c22f904ba43  gcc/testsuite/ada/acats-2/tests/c4/c45504f.dep
! 0059f05c198e829fac48965c13f56c08  gcc/testsuite/ada/acats-2/tests/c4/c45505a.ada
! 47a4e48ddd2b3df3c7eb949e7d6692a8  gcc/testsuite/ada/acats-2/tests/c4/c45523a.ada
! 17fdb2a59175aad9fef05c8cab8509e5  gcc/testsuite/ada/acats-2/tests/c4/c45531a.ada
! b8d549a63a2c40e579c8ed0a817ba1b3  gcc/testsuite/ada/acats-2/tests/c4/c45531b.ada
! c131684e4763854670c42c2112418109  gcc/testsuite/ada/acats-2/tests/c4/c45531c.ada
! c584d6f3f281816f1bd157cd8cc6b33a  gcc/testsuite/ada/acats-2/tests/c4/c45531d.ada
! 29ba7e7c1042d7979b1c75938b61e862  gcc/testsuite/ada/acats-2/tests/c4/c45531e.ada
! 47ea14530564cd8e06520e03e074efb3  gcc/testsuite/ada/acats-2/tests/c4/c45531f.ada
! 974ec868d7bcf66f2a14b7a4e70541b0  gcc/testsuite/ada/acats-2/tests/c4/c45531g.ada
! be8ef1a126f5c01246a9b635558e69ed  gcc/testsuite/ada/acats-2/tests/c4/c45531h.ada
! a795638c4621469321aa1212fd6bc01b  gcc/testsuite/ada/acats-2/tests/c4/c45531i.ada
! 8e8dbc1f05d26be72eaaaaca136d57b8  gcc/testsuite/ada/acats-2/tests/c4/c45531j.ada
! f7420a86d16f0dda550ad66d998500fa  gcc/testsuite/ada/acats-2/tests/c4/c45531k.ada
! de637dfbdf31186f46f1f622a7b31d52  gcc/testsuite/ada/acats-2/tests/c4/c45531l.ada
! 991294aff87680d765e6feb5cca5b1b5  gcc/testsuite/ada/acats-2/tests/c4/c45531m.dep
! 0494b2e93ef765b57a27be6b00246238  gcc/testsuite/ada/acats-2/tests/c4/c45531n.dep
! be4ab72a6216470b4aa0865525f98461  gcc/testsuite/ada/acats-2/tests/c4/c45531o.dep
! bb7d5366acda158c30e39d3074242262  gcc/testsuite/ada/acats-2/tests/c4/c45531p.dep
! 1328509e95f292ea980a979dedb08b47  gcc/testsuite/ada/acats-2/tests/c4/c45532a.ada
! 59f6ce63685d98c434d1a7af9b67d1f3  gcc/testsuite/ada/acats-2/tests/c4/c45532b.ada
! fe5a8b5f9204d89a9d208c19a93b7bbf  gcc/testsuite/ada/acats-2/tests/c4/c45532c.ada
! b60deea143add2ece22c54e2958db126  gcc/testsuite/ada/acats-2/tests/c4/c45532d.ada
! dac58571992e1d76d98508be3cbe2bd6  gcc/testsuite/ada/acats-2/tests/c4/c45532e.ada
! 1d7df94c7041a350156a66e67466f094  gcc/testsuite/ada/acats-2/tests/c4/c45532f.ada
! 98b8e00c4f5a9bb275a8ea343272d444  gcc/testsuite/ada/acats-2/tests/c4/c45532g.ada
! 715b35f0ab3ff72859527fd1dce01194  gcc/testsuite/ada/acats-2/tests/c4/c45532h.ada
! 6f5e0c33dee8484fe564f99b4aa53644  gcc/testsuite/ada/acats-2/tests/c4/c45532i.ada
! 4ff1755309ac898b71b5b8e71ed4a3b6  gcc/testsuite/ada/acats-2/tests/c4/c45532j.ada
! 6c58481cb99358f459163a20d20ecd7c  gcc/testsuite/ada/acats-2/tests/c4/c45532k.ada
! c77d0519f01191df9cdfba659466ec04  gcc/testsuite/ada/acats-2/tests/c4/c45532l.ada
! d2858511889a915c130e7db15a855e6a  gcc/testsuite/ada/acats-2/tests/c4/c45532m.dep
! a549269ed45783ccf0d0c93c5328f429  gcc/testsuite/ada/acats-2/tests/c4/c45532n.dep
! f4b1217bc94832f638629b8949b7def2  gcc/testsuite/ada/acats-2/tests/c4/c45532o.dep
! 798f26e21ededa5b524a77eeece6382f  gcc/testsuite/ada/acats-2/tests/c4/c45532p.dep
! 76101d98b4fab21c843f8c72a2bd9d19  gcc/testsuite/ada/acats-2/tests/c4/c45534b.ada
! b8ae84ef022a3c5728e841755e4bac5e  gcc/testsuite/ada/acats-2/tests/c4/c45536a.dep
! 28591d736802ebfac3f139de9f8cf2e7  gcc/testsuite/ada/acats-2/tests/c4/c456001.a
! bc49b87b69b7e8faefa883dc0c55fb68  gcc/testsuite/ada/acats-2/tests/c4/c45611a.ada
! 3be40e2b85d211f880f0c3afd51a63e8  gcc/testsuite/ada/acats-2/tests/c4/c45611b.dep
! 969e8cbd817e50baf599dd80133f7e3d  gcc/testsuite/ada/acats-2/tests/c4/c45611c.dep
! 48d114a182e767e243d7ef95e93e4e19  gcc/testsuite/ada/acats-2/tests/c4/c45613a.ada
! c3d80667bb998de0b21993ea73edabec  gcc/testsuite/ada/acats-2/tests/c4/c45613b.dep
! f8ed3027af651e8a9c09b39c0abf883c  gcc/testsuite/ada/acats-2/tests/c4/c45613c.dep
! cfe72bc879be3b00ef382558884d4b1d  gcc/testsuite/ada/acats-2/tests/c4/c45614a.ada
! c49e020a85a8868eed26fc38aaab04bf  gcc/testsuite/ada/acats-2/tests/c4/c45614b.dep
! 41f7a3468254617c1e8fd2e5932a25b4  gcc/testsuite/ada/acats-2/tests/c4/c45614c.dep
! ac5d52f05c31abf886e8c8c4468e3276  gcc/testsuite/ada/acats-2/tests/c4/c45631a.ada
! 08c1f1a469e3e9753825625f1a28b1ea  gcc/testsuite/ada/acats-2/tests/c4/c45631b.dep
! 3d90d62c311cc7457e997be47d4bc90b  gcc/testsuite/ada/acats-2/tests/c4/c45631c.dep
! 2f244bf1111e453d24ff570db3165fdb  gcc/testsuite/ada/acats-2/tests/c4/c45632a.ada
! 3e3d1f108ceb3c5be9dad7868239132f  gcc/testsuite/ada/acats-2/tests/c4/c45632b.dep
! d562e6283ca6c800b69581c080526e08  gcc/testsuite/ada/acats-2/tests/c4/c45632c.dep
! 2057dc7ea5393bc4be1493fb108ee5fb  gcc/testsuite/ada/acats-2/tests/c4/c45651a.ada
! c6892aa7717ffbd54f697e3d5db788af  gcc/testsuite/ada/acats-2/tests/c4/c45662a.ada
! a04b5f03883d1f148e66d75bb8eb5a69  gcc/testsuite/ada/acats-2/tests/c4/c45662b.ada
! ebd6cdab4f3e678623c2ece9ee770d5e  gcc/testsuite/ada/acats-2/tests/c4/c45672a.ada
! ac5adcf11bac18511d0fcfabda779d68  gcc/testsuite/ada/acats-2/tests/c4/c460001.a
! afb5f92407f4912f75eeaef16084757f  gcc/testsuite/ada/acats-2/tests/c4/c460002.a
! 69401711fe089c368e9218ac971b8e5a  gcc/testsuite/ada/acats-2/tests/c4/c460004.a
! f7f9cde65ac6273493f88f7cc35065c2  gcc/testsuite/ada/acats-2/tests/c4/c460005.a
! e0ce32e221b728a5e7cbef5d66bdb49b  gcc/testsuite/ada/acats-2/tests/c4/c460006.a
! ec69fdc3a65a761d8134bc49e6570216  gcc/testsuite/ada/acats-2/tests/c4/c460007.a
! 8b03807b80d9f2edc57ad06734bf670f  gcc/testsuite/ada/acats-2/tests/c4/c460008.a
! 6950bb628b3003b1ceb3b53e6cf246f8  gcc/testsuite/ada/acats-2/tests/c4/c460009.a
! 5bc44a3344b33409dd851c6b03e885b7  gcc/testsuite/ada/acats-2/tests/c4/c460010.a
! f62a801d63af2b71a0b6fc1ab47ef7e7  gcc/testsuite/ada/acats-2/tests/c4/c460011.a
! a2898cc40c52d07d2a1d5f39c8daae42  gcc/testsuite/ada/acats-2/tests/c4/c460012.a
! 41b9bdba491afbeb94cec249b368498b  gcc/testsuite/ada/acats-2/tests/c4/c460013.a
! 8caad81fc1b11cdf36c43c5366ffe8c4  gcc/testsuite/ada/acats-2/tests/c4/c460014.a
! 4578ba3cbcc42767bfa1d9fb8beed52f  gcc/testsuite/ada/acats-2/tests/c4/c46011a.ada
! 573e5b85d6d0d9289787bcf7f265aea9  gcc/testsuite/ada/acats-2/tests/c4/c46013a.ada
! ad32d1cce692c7cd1ef8bf3d2f70dee2  gcc/testsuite/ada/acats-2/tests/c4/c46014a.ada
! 3860375240c7fbeec5ea607c60613d17  gcc/testsuite/ada/acats-2/tests/c4/c46021a.ada
! 6ca67808bea0b36f928ece90dac5570f  gcc/testsuite/ada/acats-2/tests/c4/c46024a.ada
! 846bd637f5220b864dde4f2ea9ac8025  gcc/testsuite/ada/acats-2/tests/c4/c46031a.ada
! 362f593ed41bfc3cc23925318952cbc7  gcc/testsuite/ada/acats-2/tests/c4/c46032a.ada
! 65b59a01caacc42c4057aa1adad39e9c  gcc/testsuite/ada/acats-2/tests/c4/c46033a.ada
! bc9fedd5661dbda9254ef00f93819e37  gcc/testsuite/ada/acats-2/tests/c4/c46041a.ada
! dd2bc24443f9516af6adaf665228f9fb  gcc/testsuite/ada/acats-2/tests/c4/c46042a.ada
! cc5cd66068669bee0635ba7d5d5b9e4b  gcc/testsuite/ada/acats-2/tests/c4/c46043b.ada
! 862e92acebb016f9eaff87800084fb00  gcc/testsuite/ada/acats-2/tests/c4/c46044b.ada
! 8704bc96d1d99d958dd9ba580cc0fcab  gcc/testsuite/ada/acats-2/tests/c4/c46051a.ada
! 4301c097675c9ae1e1de85cb434e9f91  gcc/testsuite/ada/acats-2/tests/c4/c46051b.ada
! 0852a062d8fb5318db0fafb3e74e1869  gcc/testsuite/ada/acats-2/tests/c4/c46051c.ada
! 207b83887faae118af7863a8e7c8b797  gcc/testsuite/ada/acats-2/tests/c4/c46052a.ada
! 36ddef6a40e98fa6f687083359dcc79c  gcc/testsuite/ada/acats-2/tests/c4/c46053a.ada
! 7c918ea610224feb8290e7538e4931c0  gcc/testsuite/ada/acats-2/tests/c4/c46054a.ada
! dcaaa25c241dbab83f2031ac8a166ad0  gcc/testsuite/ada/acats-2/tests/c4/c460a01.a
! c9d756313dbe8edba8cd79f261be675b  gcc/testsuite/ada/acats-2/tests/c4/c460a02.a
! 8453f66003fadf1256272c8267ac59fe  gcc/testsuite/ada/acats-2/tests/c4/c47002a.ada
! a1a15e98aa414e9e0f6c684cc5fc7d3d  gcc/testsuite/ada/acats-2/tests/c4/c47002b.ada
! 52b6ce3f1ece2252097d9cf94ff704d8  gcc/testsuite/ada/acats-2/tests/c4/c47002c.ada
! 1b3f120455d714443fa2b8a6510141b3  gcc/testsuite/ada/acats-2/tests/c4/c47002d.ada
! e24d41d29f205af082effc4960aabff2  gcc/testsuite/ada/acats-2/tests/c4/c47003a.ada
! 676bb791325a2ce2931c822d1ba079e8  gcc/testsuite/ada/acats-2/tests/c4/c47004a.ada
! 5768cda2bc4788bb66c01ffbbe818333  gcc/testsuite/ada/acats-2/tests/c4/c47005a.ada
! 7180522de8601bc47eada08923197c21  gcc/testsuite/ada/acats-2/tests/c4/c47006a.ada
! 0866501ce0f4c5ac19a1a6701494acf1  gcc/testsuite/ada/acats-2/tests/c4/c47007a.ada
! f190b1e58c5b9f88edb7c62cc786a5ff  gcc/testsuite/ada/acats-2/tests/c4/c47008a.ada
! a83ffa688fac3d8d28808297d6c1f8af  gcc/testsuite/ada/acats-2/tests/c4/c47009a.ada
! 7e410443d7fee4c5025000324c9fa075  gcc/testsuite/ada/acats-2/tests/c4/c47009b.ada
! bc1787b8c3d0a2828cd39079641a7ae3  gcc/testsuite/ada/acats-2/tests/c4/c48004a.ada
! 35a79d509102b6efc374a823e03081dd  gcc/testsuite/ada/acats-2/tests/c4/c48004b.ada
! 520b577b8b19f3e983fa89ee6a4feae4  gcc/testsuite/ada/acats-2/tests/c4/c48004c.ada
! 4a4dc141e6c0b8734f2f4889a453c041  gcc/testsuite/ada/acats-2/tests/c4/c48004d.ada
! e1de901127f9fa068bbc1887e40ae286  gcc/testsuite/ada/acats-2/tests/c4/c48004e.ada
! a21a603107226dd95249e796c50b2988  gcc/testsuite/ada/acats-2/tests/c4/c48004f.ada
! d05127b0bccfaca8e70b371616b9e949  gcc/testsuite/ada/acats-2/tests/c4/c48005a.ada
! 93f4d6e87a4f9f685f9aad61502c858c  gcc/testsuite/ada/acats-2/tests/c4/c48005b.ada
! 794d0af908f9931f0b089116f1e42907  gcc/testsuite/ada/acats-2/tests/c4/c48006a.ada
! 3df923c9af6683c1bb48881ddb41ddfb  gcc/testsuite/ada/acats-2/tests/c4/c48006b.ada
! a6c0f722acc9486a7e600dc96ff2d5cd  gcc/testsuite/ada/acats-2/tests/c4/c48007a.ada
! b2751238701befe768d059585cb34fbe  gcc/testsuite/ada/acats-2/tests/c4/c48007b.ada
! a069ec763e24859fbddc4f107e410c11  gcc/testsuite/ada/acats-2/tests/c4/c48007c.ada
! 009ebc3b69f9c31aa88c54a85271399a  gcc/testsuite/ada/acats-2/tests/c4/c48008a.ada
! 5782d3eeb5e00949ec2f3c7a7ae59650  gcc/testsuite/ada/acats-2/tests/c4/c48008c.ada
! 36b2b00fc2eaa55063b74bfc4cb91c79  gcc/testsuite/ada/acats-2/tests/c4/c48009a.ada
! d7356de4b25053ff97c5d99c7daa90a2  gcc/testsuite/ada/acats-2/tests/c4/c48009b.ada
! 46e9f0e1b269b6b499944395221ae145  gcc/testsuite/ada/acats-2/tests/c4/c48009c.ada
! 99e82e54208e5f2e641da892789ade00  gcc/testsuite/ada/acats-2/tests/c4/c48009d.ada
! a4dd405fd63b81dac153b62e7df858e9  gcc/testsuite/ada/acats-2/tests/c4/c48009e.ada
! a761ea12752cc1827d795f510ed14854  gcc/testsuite/ada/acats-2/tests/c4/c48009f.ada
! f4d13322456cdc5177a9641ba263e997  gcc/testsuite/ada/acats-2/tests/c4/c48009g.ada
! 9b3d09b25afb28f96e9c15abc9134ea5  gcc/testsuite/ada/acats-2/tests/c4/c48009h.ada
! 5ed239b238e9da030fa1d1bbf81e4dc3  gcc/testsuite/ada/acats-2/tests/c4/c48009i.ada
! dbe1181c1fb1c91cdfc5d5a51327b289  gcc/testsuite/ada/acats-2/tests/c4/c48009j.ada
! 688a1e8190cac3b78936f0235d3b808d  gcc/testsuite/ada/acats-2/tests/c4/c48010a.ada
! 48a6ec9afe098c7d148a0d1f652be09e  gcc/testsuite/ada/acats-2/tests/c4/c48011a.ada
! 18db6e638dc720b6501696a26aa99e58  gcc/testsuite/ada/acats-2/tests/c4/c48012a.ada
! b30035b53424a29691b261dda34fc58e  gcc/testsuite/ada/acats-2/tests/c4/c490001.a
! 489ea02e3356b5145fb51c63bb474ea5  gcc/testsuite/ada/acats-2/tests/c4/c490002.a
! c9523cc2889cfcde83e23c042eedd694  gcc/testsuite/ada/acats-2/tests/c4/c490003.a
! 6f98fb5a40e92d1a16d6c2a144d613a5  gcc/testsuite/ada/acats-2/tests/c4/c49020a.ada
! 949b858aea6369cc5f6b92e57a36762e  gcc/testsuite/ada/acats-2/tests/c4/c49021a.ada
! 61eb9a59008479c0875739f8a38a6058  gcc/testsuite/ada/acats-2/tests/c4/c49022a.ada
! 371d9a00cb41f67a40d255081149947a  gcc/testsuite/ada/acats-2/tests/c4/c49022b.ada
! 6cbf71a7cecd0227501309baf6e99545  gcc/testsuite/ada/acats-2/tests/c4/c49022c.ada
! ae09e5339a3f4903f8fa5d11de07d714  gcc/testsuite/ada/acats-2/tests/c4/c49023a.ada
! e2d3c0d182fcc8306bf82e940cacf1c0  gcc/testsuite/ada/acats-2/tests/c4/c49024a.ada
! fa1107ef6dfef6a91126632e0fd40ac9  gcc/testsuite/ada/acats-2/tests/c4/c49025a.ada
! 8308838bc1d5d9801f0aba7872873b2e  gcc/testsuite/ada/acats-2/tests/c4/c49026a.ada
! 67dd3195321fffe06e278c7a2dd46fb7  gcc/testsuite/ada/acats-2/tests/c4/c4a005b.ada
! b4f6152a06508643187aed55fe1b066d  gcc/testsuite/ada/acats-2/tests/c4/c4a006a.ada
! 5eddb402835a4195abec99f2970765f6  gcc/testsuite/ada/acats-2/tests/c4/c4a007a.tst
! 1c61fe192df4f7bf89c81bd93f979629  gcc/testsuite/ada/acats-2/tests/c4/c4a010a.ada
! db5b09d1af5f03cbfc83813c6cef98d9  gcc/testsuite/ada/acats-2/tests/c4/c4a010b.ada
! 8ea93dd812f5645ad034052c5e9c14bc  gcc/testsuite/ada/acats-2/tests/c4/c4a011a.ada
! d8a1f20f1b4a1339f232102f757a12c6  gcc/testsuite/ada/acats-2/tests/c4/c4a012b.ada
! df1956d8e1bdb8b421d8edda86514e73  gcc/testsuite/ada/acats-2/tests/c4/c4a013a.ada
! f95cf7fe1c6669b86824c685ca90c44f  gcc/testsuite/ada/acats-2/tests/c4/c4a014a.ada
! 04305b71fc4860700405904b070a802b  gcc/testsuite/ada/acats-2/tests/c5/c51004a.ada
! c6f0f59f33111f1bb049c5f25022c725  gcc/testsuite/ada/acats-2/tests/c5/c52005a.ada
! 4497fa9cc187eebee09f422eb12067f6  gcc/testsuite/ada/acats-2/tests/c5/c52005b.ada
! 31714495e63b10120b8239b0456549ee  gcc/testsuite/ada/acats-2/tests/c5/c52005c.ada
! c643f87a63f83ab7dedfa0b4647174c9  gcc/testsuite/ada/acats-2/tests/c5/c52005d.ada
! a717ed0d0e4578d9b1ba1e84a1312d88  gcc/testsuite/ada/acats-2/tests/c5/c52005e.ada
! e9e335b018c1995e8f516236efc80a20  gcc/testsuite/ada/acats-2/tests/c5/c52005f.ada
! c475aae75de9114facd3aaa775556697  gcc/testsuite/ada/acats-2/tests/c5/c52008a.ada
! 87cbbe1931b5cfdb29756f338e098ee1  gcc/testsuite/ada/acats-2/tests/c5/c52008b.ada
! 67bb5622435b51d6b7a862890b654771  gcc/testsuite/ada/acats-2/tests/c5/c52009a.ada
! 400c804c17dce5b2cbc92e00f53bdbf7  gcc/testsuite/ada/acats-2/tests/c5/c52009b.ada
! d656f6cd000039c412836d5baacbff52  gcc/testsuite/ada/acats-2/tests/c5/c52010a.ada
! 1f26091c9bf683f6970689d5d0980a81  gcc/testsuite/ada/acats-2/tests/c5/c52011a.ada
! bd17088998a5ebb4a8a3f1ae8ed0fb56  gcc/testsuite/ada/acats-2/tests/c5/c52011b.ada
! 497212d2daf8375937c749ee7ebcc2df  gcc/testsuite/ada/acats-2/tests/c5/c52101a.ada
! d79452ecad6774f7462778af7f7ce5eb  gcc/testsuite/ada/acats-2/tests/c5/c52102a.ada
! c3ffbc3a8172219b7b11be58eb4ee73d  gcc/testsuite/ada/acats-2/tests/c5/c52102b.ada
! d8b031579b48e0bae598c821fc7f2799  gcc/testsuite/ada/acats-2/tests/c5/c52102c.ada
! 8545078e881db7a6a84e41583799ee5d  gcc/testsuite/ada/acats-2/tests/c5/c52102d.ada
! 348fad1e9e6e04b677fd7d942e3416af  gcc/testsuite/ada/acats-2/tests/c5/c52103a.ada
! 537e555773a4e758b8466c079c2023a1  gcc/testsuite/ada/acats-2/tests/c5/c52103b.ada
! c118c8520f99ad57e36a1e1ed0ab2549  gcc/testsuite/ada/acats-2/tests/c5/c52103c.ada
! 161ca114e3549ca32b6abc801f74633d  gcc/testsuite/ada/acats-2/tests/c5/c52103f.ada
! 553aa64efc629783fc32ef6b352ae6be  gcc/testsuite/ada/acats-2/tests/c5/c52103g.ada
! 29498cb969386c5b69bd6ba62c7be406  gcc/testsuite/ada/acats-2/tests/c5/c52103h.ada
! 8026673b1e67673c009f39e569ae1a3e  gcc/testsuite/ada/acats-2/tests/c5/c52103k.ada
! c6b31cf4833909c9d4dae839511863ec  gcc/testsuite/ada/acats-2/tests/c5/c52103l.ada
! 6843840acb3dee1ae11cf9365156daaa  gcc/testsuite/ada/acats-2/tests/c5/c52103m.ada
! 70a2f3db7206a779a035e915788f37f0  gcc/testsuite/ada/acats-2/tests/c5/c52103p.ada
! a28a2bdec6b574435427b9aeb1c74945  gcc/testsuite/ada/acats-2/tests/c5/c52103q.ada
! 7b9ecdaf00c3655bb24701195d08a83f  gcc/testsuite/ada/acats-2/tests/c5/c52103r.ada
! 0c814953f2bf8472a62eb44838f04363  gcc/testsuite/ada/acats-2/tests/c5/c52103x.ada
! e772fcfb1386e00244d4b143524cc196  gcc/testsuite/ada/acats-2/tests/c5/c52104a.ada
! 16ef5ba633cf0703eef0f4bc4e6a931e  gcc/testsuite/ada/acats-2/tests/c5/c52104b.ada
! 0d83ec342af202df515bd811d311775e  gcc/testsuite/ada/acats-2/tests/c5/c52104c.ada
! 63ba1297346e75dcba0a5bebb9fd7feb  gcc/testsuite/ada/acats-2/tests/c5/c52104f.ada
! 360c84a7d7a20d6426f39f47175e9e61  gcc/testsuite/ada/acats-2/tests/c5/c52104g.ada
! 8c2507e3ca68c72c1b2e6d6e118ec32b  gcc/testsuite/ada/acats-2/tests/c5/c52104h.ada
! 3eb7315199feb380e4633e0fa784d0dc  gcc/testsuite/ada/acats-2/tests/c5/c52104k.ada
! 1e9c8d887474d4edd8e8cef2ca34972f  gcc/testsuite/ada/acats-2/tests/c5/c52104l.ada
! 4cd7ce90121345b41e548625afd89238  gcc/testsuite/ada/acats-2/tests/c5/c52104m.ada
! bb14b1ee179559762fe853803c6f47a0  gcc/testsuite/ada/acats-2/tests/c5/c52104p.ada
! 11c63d2f8a8f5be641d543c723d95db6  gcc/testsuite/ada/acats-2/tests/c5/c52104q.ada
! 3e89a5e299b2f10a8bfdddda7e51ad94  gcc/testsuite/ada/acats-2/tests/c5/c52104r.ada
! cf3c9c7c07a47d92020285624997c09f  gcc/testsuite/ada/acats-2/tests/c5/c52104x.ada
! c937dcfea0e38e6a3b8af09de0efaf04  gcc/testsuite/ada/acats-2/tests/c5/c52104y.ada
! b2aa45debad3d8e7603216de3bca00fb  gcc/testsuite/ada/acats-2/tests/c5/c53007a.ada
! ff458115437146bc66c6f7135942dc7d  gcc/testsuite/ada/acats-2/tests/c5/c540001.a
! 798fc3cdc6929204af5e109c7b552b96  gcc/testsuite/ada/acats-2/tests/c5/c54a03a.ada
! 350e6e9e9f439b08c9984e18a29b6144  gcc/testsuite/ada/acats-2/tests/c5/c54a04a.ada
! 672e5fee1b44c051e35bd39f7cfdd7f6  gcc/testsuite/ada/acats-2/tests/c5/c54a07a.ada
! 55636ae11b1e87d2920da673ac54f8cf  gcc/testsuite/ada/acats-2/tests/c5/c54a13a.ada
! fadaa20972179cfa78055a5255aaf701  gcc/testsuite/ada/acats-2/tests/c5/c54a13b.ada
! 1f2ca9fde851497809ddf860f08ea8dd  gcc/testsuite/ada/acats-2/tests/c5/c54a13c.ada
! f02b8333b09eadfe396595d861e0c28e  gcc/testsuite/ada/acats-2/tests/c5/c54a13d.ada
! 37f2526490642267865f8a817c455655  gcc/testsuite/ada/acats-2/tests/c5/c54a22a.ada
! c4b7807f9faa1bb76d79507d98a0feb3  gcc/testsuite/ada/acats-2/tests/c5/c54a23a.ada
! 45d1b598e30b318d11d3cfa6a37cc6fa  gcc/testsuite/ada/acats-2/tests/c5/c54a24a.ada
! adeadf039e14eb8bc2b48ff5572bd812  gcc/testsuite/ada/acats-2/tests/c5/c54a24b.ada
! 7cf7b4d54a6bca23e102d02570e8d836  gcc/testsuite/ada/acats-2/tests/c5/c54a42a.ada
! 200024964c0cd6807dda9226ae982125  gcc/testsuite/ada/acats-2/tests/c5/c54a42b.ada
! b58d58ea8c08f008f3bb0a1f4e37600d  gcc/testsuite/ada/acats-2/tests/c5/c54a42c.ada
! 7afca27633e115e11ccc09450181d955  gcc/testsuite/ada/acats-2/tests/c5/c54a42d.ada
! 810d89d05b84beb31789b0ebd7aba86d  gcc/testsuite/ada/acats-2/tests/c5/c54a42e.ada
! 012f75628d8e37cbd1be10f8f4ba117f  gcc/testsuite/ada/acats-2/tests/c5/c54a42f.ada
! d45cbd6907b0f421c6aec9b981f052d6  gcc/testsuite/ada/acats-2/tests/c5/c54a42g.ada
! ef97a2623a512e16e0fda04f277b6ff2  gcc/testsuite/ada/acats-2/tests/c5/c55b03a.ada
! ad40c92edd66b18fad76286ec1b9c6ae  gcc/testsuite/ada/acats-2/tests/c5/c55b04a.ada
! aa1f7abf4fbb36f5120549a0305b7862  gcc/testsuite/ada/acats-2/tests/c5/c55b05a.ada
! 93af4cbae77af58c9e4c76145e3381b0  gcc/testsuite/ada/acats-2/tests/c5/c55b06a.ada
! 83fb65a1faa9605647ad3455e55fa273  gcc/testsuite/ada/acats-2/tests/c5/c55b06b.ada
! 1c3a3e590230416971b33336bec05137  gcc/testsuite/ada/acats-2/tests/c5/c55b07a.dep
! 297ac06b1460ecfad84e5ce426b452d5  gcc/testsuite/ada/acats-2/tests/c5/c55b07b.dep
! 9f79657a1fb3ec7ad658a79647c5949c  gcc/testsuite/ada/acats-2/tests/c5/c55b10a.ada
! 1364f5750f4c9a8395cf0b1ae42eee0b  gcc/testsuite/ada/acats-2/tests/c5/c55b11a.ada
! 20c657742ad353aedf983932ae3ad058  gcc/testsuite/ada/acats-2/tests/c5/c55b11b.ada
! dcbc66de120373907bc61655da9f5f72  gcc/testsuite/ada/acats-2/tests/c5/c55b15a.ada
! 46488465caae85e036ca25f7a3861ddb  gcc/testsuite/ada/acats-2/tests/c5/c55b16a.ada
! 59a61b3784b5cede84a98e874e989bf9  gcc/testsuite/ada/acats-2/tests/c5/c55c02a.ada
! a665c1df7fabf7499dd2fef8021e5735  gcc/testsuite/ada/acats-2/tests/c5/c55c02b.ada
! 9722acc7b86adb50f2132a53c9a9ba5f  gcc/testsuite/ada/acats-2/tests/c5/c56002a.ada
! 0d40a16731d63ec204e884f94b191598  gcc/testsuite/ada/acats-2/tests/c5/c57003a.ada
! 7bceaaa459e0581dd43947812fb6e226  gcc/testsuite/ada/acats-2/tests/c5/c57004a.ada
! 30ed2943b27da30ba5be8602f46f6e65  gcc/testsuite/ada/acats-2/tests/c5/c57004b.ada
! 8a811d9acc70a272fa09cbfe47fdbbc0  gcc/testsuite/ada/acats-2/tests/c5/c58004c.ada
! 17e55b043903edcc29571ab8bd8aa78c  gcc/testsuite/ada/acats-2/tests/c5/c58004d.ada
! 7807a279489151c0c870e2d8f12f4502  gcc/testsuite/ada/acats-2/tests/c5/c58004g.ada
! 1b5dcc2941f69ee8c74a24728bb90d67  gcc/testsuite/ada/acats-2/tests/c5/c58005a.ada
! 62354e1ba2b765af08aa33a5e09c47df  gcc/testsuite/ada/acats-2/tests/c5/c58005b.ada
! 9028a4a38fba5ee0a721a8918c7e46c8  gcc/testsuite/ada/acats-2/tests/c5/c58005h.ada
! fa480782be6698aa97970fcf14c2f19b  gcc/testsuite/ada/acats-2/tests/c5/c58006a.ada
! 156c239407b9c9b5abfd28b286d35734  gcc/testsuite/ada/acats-2/tests/c5/c58006b.ada
! 05e86bfca592c5c4d28a7ad45f8d8054  gcc/testsuite/ada/acats-2/tests/c5/c59002a.ada
! 70857f43256c7a44ec4b50f5aa1b4b0d  gcc/testsuite/ada/acats-2/tests/c5/c59002b.ada
! 7656b04738b59910b4cd6415feaa6aea  gcc/testsuite/ada/acats-2/tests/c5/c59002c.ada
! 22c213bb3f4fac53cfad7701e5a6591a  gcc/testsuite/ada/acats-2/tests/c6/c61008a.ada
! 5fb3b13780dfa407dfa99fcfa590913f  gcc/testsuite/ada/acats-2/tests/c6/c61009a.ada
! 25cf5d0e53424f3054a20393c002970e  gcc/testsuite/ada/acats-2/tests/c6/c61010a.ada
! fc4b87310c6618ffbf7d4df1f222a45f  gcc/testsuite/ada/acats-2/tests/c6/c620001.a
! 2a393ff1326482d8490f5be202d8483c  gcc/testsuite/ada/acats-2/tests/c6/c620002.a
! 97d97866837d419b1ddcfa6ccda2511e  gcc/testsuite/ada/acats-2/tests/c6/c62002a.ada
! 29777c913c6649484125c1aa56f0093f  gcc/testsuite/ada/acats-2/tests/c6/c62003a.ada
! 3e2cc6ba1c79eb1d9f3fe3bbb646cf6b  gcc/testsuite/ada/acats-2/tests/c6/c62003b.ada
! 624bc88129c0b954774c60019f5435c5  gcc/testsuite/ada/acats-2/tests/c6/c62004a.ada
! 31c5b507af85354e0db53a078e7c8933  gcc/testsuite/ada/acats-2/tests/c6/c62006a.ada
! e8a1274fb71dcf0b27d5375c78e8d1d3  gcc/testsuite/ada/acats-2/tests/c6/c631001.a
! 41a6d9efe5d22a0f96b7c4448831b133  gcc/testsuite/ada/acats-2/tests/c6/c640001.a
! 67136569bb3a58c14f65e3abd9b96391  gcc/testsuite/ada/acats-2/tests/c6/c64002b.ada
! 298c0d717f1da2c324c78b6aafedfa91  gcc/testsuite/ada/acats-2/tests/c6/c64004g.ada
! 0a5ebe2531dcbec11f3d606df5534e5b  gcc/testsuite/ada/acats-2/tests/c6/c64005a.ada
! 1a7b4a32917f31d77deb5ad294e39f82  gcc/testsuite/ada/acats-2/tests/c6/c64005b.ada
! 292b4b0e6cf19da205f4d3a1caeee992  gcc/testsuite/ada/acats-2/tests/c6/c64005c.ada
! db80e980a183a6d0f7c9afd52fae0c87  gcc/testsuite/ada/acats-2/tests/c6/c64005d0.ada
! f480e72d2a8b3a22347018687fb9f190  gcc/testsuite/ada/acats-2/tests/c6/c64005da.ada
! 035da89aedf781e8b07eace791889088  gcc/testsuite/ada/acats-2/tests/c6/c64005db.ada
! 9af982279e39e967d04656170afef341  gcc/testsuite/ada/acats-2/tests/c6/c64005dc.ada
! 2f3c835897b61c5b02af1bef11a949d6  gcc/testsuite/ada/acats-2/tests/c6/c641001.a
! f9894df16dafde8c37b5681a9a0b728f  gcc/testsuite/ada/acats-2/tests/c6/c64103b.ada
! 573a659bd2d30c3c8a3ee7f77390490c  gcc/testsuite/ada/acats-2/tests/c6/c64103c.ada
! e7242de3cddb62031ef1910e911942df  gcc/testsuite/ada/acats-2/tests/c6/c64103d.ada
! 6e2e6c719dcbb601e033a3a1528b6db5  gcc/testsuite/ada/acats-2/tests/c6/c64103e.ada
! aa17757d55d04a8ef672505933d46680  gcc/testsuite/ada/acats-2/tests/c6/c64103f.ada
! bbb85cc245f09eba3db627d88d52db68  gcc/testsuite/ada/acats-2/tests/c6/c64104a.ada
! d3f37083469fc62f2aeae2c00e979ad9  gcc/testsuite/ada/acats-2/tests/c6/c64104b.ada
! 00b5b6264d3df93a1481ca7dd0313957  gcc/testsuite/ada/acats-2/tests/c6/c64104c.ada
! 0d80f34c16a2ae02db45210c6b66eaa8  gcc/testsuite/ada/acats-2/tests/c6/c64104d.ada
! 5dc873b400a6675c734e431ac91f74db  gcc/testsuite/ada/acats-2/tests/c6/c64104e.ada
! 54921e31e5a30e388946a946c10c8954  gcc/testsuite/ada/acats-2/tests/c6/c64104f.ada
! b763fdc647a8b6c2e8ccdcc7b2e1556c  gcc/testsuite/ada/acats-2/tests/c6/c64104g.ada
! 0a7c01deaae4401d7fe1f7f78e4e6325  gcc/testsuite/ada/acats-2/tests/c6/c64104h.ada
! 39b3c50eb36b7e11b1d9e78a7b3f9132  gcc/testsuite/ada/acats-2/tests/c6/c64104i.ada
! a30f87a67e828d3791f26521921a8f81  gcc/testsuite/ada/acats-2/tests/c6/c64104j.ada
! 8906347f1c0f027d889a06f25fcc1831  gcc/testsuite/ada/acats-2/tests/c6/c64104k.ada
! 4cb01879b0f85af48c5474c558534e54  gcc/testsuite/ada/acats-2/tests/c6/c64104l.ada
! cd1d978bf7503e964f5c0293089096c1  gcc/testsuite/ada/acats-2/tests/c6/c64104m.ada
! 62990064fd13a84570c91f3d1f71338f  gcc/testsuite/ada/acats-2/tests/c6/c64104n.ada
! ff64768b090411d3f8232b7dc479db5f  gcc/testsuite/ada/acats-2/tests/c6/c64104o.ada
! c371cb358b8e763068dd4af101cd7f51  gcc/testsuite/ada/acats-2/tests/c6/c64105a.ada
! f1cfabbe7fa319f7a90669a5a1d88874  gcc/testsuite/ada/acats-2/tests/c6/c64105b.ada
! 484938df1d2ea23b4699185521d927ae  gcc/testsuite/ada/acats-2/tests/c6/c64105c.ada
! 98ba505c37a1fa4544aa7a16f86476d8  gcc/testsuite/ada/acats-2/tests/c6/c64105d.ada
! 7f5ef4e4117e3403c814c8b2d6248652  gcc/testsuite/ada/acats-2/tests/c6/c64106a.ada
! c719851b2aa8d7de278a61b4ae401e7f  gcc/testsuite/ada/acats-2/tests/c6/c64106b.ada
! 99b026e3c033b0bc70bbb34952c61a90  gcc/testsuite/ada/acats-2/tests/c6/c64106c.ada
! 1ff08389beb50526e6d5946f3ddfa0d2  gcc/testsuite/ada/acats-2/tests/c6/c64106d.ada
! 19103ed02e019b6f2490bd4285878194  gcc/testsuite/ada/acats-2/tests/c6/c64107a.ada
! 93d945e280814e3db9cdaa9a9be57e87  gcc/testsuite/ada/acats-2/tests/c6/c64108a.ada
! 39bf7a6fa5bcfb5ee8e52f5f07fafefc  gcc/testsuite/ada/acats-2/tests/c6/c64109a.ada
! 7a1023fda1950978c62798e5caff709c  gcc/testsuite/ada/acats-2/tests/c6/c64109b.ada
! 276b67fe008e97a4988487fc615e1f3c  gcc/testsuite/ada/acats-2/tests/c6/c64109c.ada
! 80192570a6b338162a9ef9bfc13a4dff  gcc/testsuite/ada/acats-2/tests/c6/c64109d.ada
! 4719b8ddae4538b59e04d96c932a95d9  gcc/testsuite/ada/acats-2/tests/c6/c64109e.ada
! ed4b4f3ef743bc7f8f4a6afe5886cae2  gcc/testsuite/ada/acats-2/tests/c6/c64109f.ada
! 8f7ab91cec27ffbad7b51252ef99b137  gcc/testsuite/ada/acats-2/tests/c6/c64109g.ada
! 2bb8cec80fd6bc3ed2495c9581ea2a9e  gcc/testsuite/ada/acats-2/tests/c6/c64109h.ada
! 495be9b835fa97670e1a579d72a3f96d  gcc/testsuite/ada/acats-2/tests/c6/c64109i.ada
! 547c93bc4be631648c9973120c282a89  gcc/testsuite/ada/acats-2/tests/c6/c64109j.ada
! 4da6b83416827b9d2d574334772ff2a3  gcc/testsuite/ada/acats-2/tests/c6/c64109k.ada
! 6217fe2218b5d9ecf085e1b730917030  gcc/testsuite/ada/acats-2/tests/c6/c64109l.ada
! dde2e62be923a3854e5f1667c4a78def  gcc/testsuite/ada/acats-2/tests/c6/c64201b.ada
! c3459cee62caf16a8d14f820e16c4f60  gcc/testsuite/ada/acats-2/tests/c6/c64201c.ada
! e589f5c8d3bb97575b245a37a5f2dffa  gcc/testsuite/ada/acats-2/tests/c6/c64202a.ada
! 219803e5e3580d21284552cdfe112a0f  gcc/testsuite/ada/acats-2/tests/c6/c650001.a
! 25c48d1366d3ac13453832dcee471f3f  gcc/testsuite/ada/acats-2/tests/c6/c65003a.ada
! beca3ad5c25f888eed6dc6b1db750e33  gcc/testsuite/ada/acats-2/tests/c6/c65003b.ada
! 4eca86193e279acda5aa647dab2bf5bf  gcc/testsuite/ada/acats-2/tests/c6/c66002a.ada
! 7cbfd161ceac490eb379a5c08eb1945c  gcc/testsuite/ada/acats-2/tests/c6/c66002c.ada
! 482c9214fae39fbcab58fcbae0b5b5ef  gcc/testsuite/ada/acats-2/tests/c6/c66002d.ada
! 7a93f84ee40f38fca4afb6cfd5e69a57  gcc/testsuite/ada/acats-2/tests/c6/c66002e.ada
! 2b60fab145676d717df13cdf9c7a70cb  gcc/testsuite/ada/acats-2/tests/c6/c66002f.ada
! ea770ca1e9d9fcb8b4460d5921747ef5  gcc/testsuite/ada/acats-2/tests/c6/c66002g.ada
! 8470fdb16485b4472bee0602f1f98734  gcc/testsuite/ada/acats-2/tests/c6/c67002a.ada
! 0e2fbb4deae7d888206b0ce77fc4fda5  gcc/testsuite/ada/acats-2/tests/c6/c67002b.ada
! 308d5f91802e93205222e8ca1f7def1e  gcc/testsuite/ada/acats-2/tests/c6/c67002c.ada
! 84e0adc30ed2874abaffa33f713cc51b  gcc/testsuite/ada/acats-2/tests/c6/c67002d.ada
! ddfdc630c5edd58e367ed9b034c039e7  gcc/testsuite/ada/acats-2/tests/c6/c67002e.ada
! 49b95c1cbdb6c703d2eba605f6f06c92  gcc/testsuite/ada/acats-2/tests/c6/c67003f.ada
! 213a9e52b5357a07997f1aa43ec82624  gcc/testsuite/ada/acats-2/tests/c6/c67005a.ada
! ddd7cdd9502a723b17b40bcb1df0e016  gcc/testsuite/ada/acats-2/tests/c6/c67005b.ada
! 20a99f6c582810cf18b39ab642f4024f  gcc/testsuite/ada/acats-2/tests/c6/c67005c.ada
! 8ea8c4445f5e72cc88e8dad14b66084e  gcc/testsuite/ada/acats-2/tests/c6/c67005d.ada
! 69f93d5f57d1b7956ae380ff9f3e5f77  gcc/testsuite/ada/acats-2/tests/c7/c72001b.ada
! b6fa12bd9fd0f617b4eeded7550722c2  gcc/testsuite/ada/acats-2/tests/c7/c72002a.ada
! c70f104ca78b3298a442973676af108a  gcc/testsuite/ada/acats-2/tests/c7/c730001.a
! 7d2edfee282ba04ca7f25bef0f101057  gcc/testsuite/ada/acats-2/tests/c7/c730002.a
! 7822b69c5c1de14250eaad43da14736b  gcc/testsuite/ada/acats-2/tests/c7/c730003.a
! ced40d2c1dbfd9c72c43feedd4c9cefc  gcc/testsuite/ada/acats-2/tests/c7/c730004.a
! d3f7b50b0820bac4ce78abffb5e37744  gcc/testsuite/ada/acats-2/tests/c7/c73002a.ada
! c70763cb0718b44fa8658ee9ebb8c726  gcc/testsuite/ada/acats-2/tests/c7/c730a01.a
! 4ecce7babf24585f115e0d288f17e449  gcc/testsuite/ada/acats-2/tests/c7/c730a02.a
! 9c311ffdc62d1b99a3452b1e38d15e2e  gcc/testsuite/ada/acats-2/tests/c7/c731001.a
! be09078047844bd86eef86d5755ef273  gcc/testsuite/ada/acats-2/tests/c7/c74004a.ada
! a0a0a05e6225a07b7bd0f2c049f1dc37  gcc/testsuite/ada/acats-2/tests/c7/c74203a.ada
! a718857277037741ea3600c1aab95a3d  gcc/testsuite/ada/acats-2/tests/c7/c74206a.ada
! 0efca36cdb74fc57aec9e1de78e0324f  gcc/testsuite/ada/acats-2/tests/c7/c74207b.ada
! 7ceb0d1778d1a1bae9687bebd7aad9e3  gcc/testsuite/ada/acats-2/tests/c7/c74208a.ada
! bf7859fde348fa96735368f14e0a3e25  gcc/testsuite/ada/acats-2/tests/c7/c74208b.ada
! 7d504e824db220a636160024b4e963d6  gcc/testsuite/ada/acats-2/tests/c7/c74209a.ada
! 3f31b8eb73e78f20cdcf118aa7d0047c  gcc/testsuite/ada/acats-2/tests/c7/c74210a.ada
! 442ab4135e3f1fdfffacf000f7b4bda3  gcc/testsuite/ada/acats-2/tests/c7/c74211a.ada
! 49650c69957d01ffb396db79a35589c4  gcc/testsuite/ada/acats-2/tests/c7/c74211b.ada
! 30155693ce7b3f29189da859d313eb7d  gcc/testsuite/ada/acats-2/tests/c7/c74302a.ada
! ed96f028ca11af40b3ba2093a404f55c  gcc/testsuite/ada/acats-2/tests/c7/c74302b.ada
! b559e9bf4e98700fb810e406c30a34b7  gcc/testsuite/ada/acats-2/tests/c7/c74305a.ada
! f1b9307b4d428cf0d10bc48805ffb0f3  gcc/testsuite/ada/acats-2/tests/c7/c74305b.ada
! 5c799bf9e1ec30f40d428bd8dadcb119  gcc/testsuite/ada/acats-2/tests/c7/c74306a.ada
! d62a4df3fab829d5694cbf9f5cc4cb8e  gcc/testsuite/ada/acats-2/tests/c7/c74307a.ada
! 933ca49dcfb9ad8fc25ea9a434984d05  gcc/testsuite/ada/acats-2/tests/c7/c74401d.ada
! 502d8871fd7e5d6399f7536874735597  gcc/testsuite/ada/acats-2/tests/c7/c74401e.ada
! 2514504f60fcea97d8914fabcb5654cf  gcc/testsuite/ada/acats-2/tests/c7/c74401k.ada
! 3ca8e77b02dbd7f9e9104dd0fa6de35b  gcc/testsuite/ada/acats-2/tests/c7/c74401q.ada
! d30f33bfdaf9612ea55c7659c3b5aeb6  gcc/testsuite/ada/acats-2/tests/c7/c74402a.ada
! cf79bb4fcbdf7ec1cd795607eef8bc10  gcc/testsuite/ada/acats-2/tests/c7/c74402b.ada
! f6ece8469b7d90aef496ac665f895003  gcc/testsuite/ada/acats-2/tests/c7/c74406a.ada
! cce5e695d18f537ec2a8d6c26cfc5b0d  gcc/testsuite/ada/acats-2/tests/c7/c74407b.ada
! 316be518a848dd0954d80de977e40c5b  gcc/testsuite/ada/acats-2/tests/c7/c74409b.ada
! c751f318a2fe16dadb0c62221c726b70  gcc/testsuite/ada/acats-2/tests/c7/c760001.a
! f250c0eea5cbe1e05ed28f0a940949ed  gcc/testsuite/ada/acats-2/tests/c7/c760002.a
! c12d4d7698c111ee3a094c0c2d53522a  gcc/testsuite/ada/acats-2/tests/c7/c760007.a
! 767d3e26a992541aa6191923e040a107  gcc/testsuite/ada/acats-2/tests/c7/c760009.a
! 264f06f0190602b655e5f7fefb6822b8  gcc/testsuite/ada/acats-2/tests/c7/c760010.a
! 31eaca7f3a33de78c9eaa1a92109c6ad  gcc/testsuite/ada/acats-2/tests/c7/c760011.a
! 522805071c7c096b6eabcd72cf833d9a  gcc/testsuite/ada/acats-2/tests/c7/c760012.a
! a4f8e8b6876d4b862928b00edca5f5d9  gcc/testsuite/ada/acats-2/tests/c7/c760013.a
! 45d67d0e3319e953b892c7d115460ecd  gcc/testsuite/ada/acats-2/tests/c7/c761001.a
! 080dcc3c8d2907579e1673c23433165f  gcc/testsuite/ada/acats-2/tests/c7/c761002.a
! d0ecfbaed2a882166d23beefe5f4e191  gcc/testsuite/ada/acats-2/tests/c7/c761003.a
! 553e4393e53175606097eb8c9b415d22  gcc/testsuite/ada/acats-2/tests/c7/c761004.a
! 4a7c5e1c13695ae75ad3a4df49a55b63  gcc/testsuite/ada/acats-2/tests/c7/c761005.a
! d4f8faae1d5f7970e56d7a30c10a99c7  gcc/testsuite/ada/acats-2/tests/c7/c761006.a
! a8b974a47ec1f7a4a5fc2ef06975f069  gcc/testsuite/ada/acats-2/tests/c7/c761007.a
! 6ca84026fc9a5682d2db1f346eb920cd  gcc/testsuite/ada/acats-2/tests/c7/c761010.a
! 8f26af4ffb9bc7a2e15aee7b1c0c2346  gcc/testsuite/ada/acats-2/tests/c7/c761011.a
! d80406039e2bebf54191eec198c10721  gcc/testsuite/ada/acats-2/tests/c7/c761012.a
! f7baee35e01e625d64802c987ddc4c0d  gcc/testsuite/ada/acats-2/tests/c8/c83007a.ada
! 9f1228dfaacf209725a2e8d706128a4c  gcc/testsuite/ada/acats-2/tests/c8/c83012d.ada
! a2e774207100bd5fbb0289bb8ba9f031  gcc/testsuite/ada/acats-2/tests/c8/c83022a.ada
! c214085c4cbff44807225c3aee9be7db  gcc/testsuite/ada/acats-2/tests/c8/c83022g0.ada
! 7aeac4b952eedc1419039fc50c66c732  gcc/testsuite/ada/acats-2/tests/c8/c83022g1.ada
! fedc05f63c2cd512653891054d7d5dad  gcc/testsuite/ada/acats-2/tests/c8/c83023a.ada
! 94cc28ec1a7a9d2aedbab6f2101d2215  gcc/testsuite/ada/acats-2/tests/c8/c83024a.ada
! cd79a99f6b5ce8030462ce917a77a33c  gcc/testsuite/ada/acats-2/tests/c8/c83024e0.ada
! b03af2deceb02b0227f887041379f641  gcc/testsuite/ada/acats-2/tests/c8/c83024e1.ada
! d7544d2786bfc552a30612041df95429  gcc/testsuite/ada/acats-2/tests/c8/c83025a.ada
! 881d6130cfcbd30f4a739889d50396da  gcc/testsuite/ada/acats-2/tests/c8/c83025c.ada
! f35a334aaf4110ea4446247ad6a098f4  gcc/testsuite/ada/acats-2/tests/c8/c83027a.ada
! 37c08965e5d871d3a35ff35f67e713d8  gcc/testsuite/ada/acats-2/tests/c8/c83027c.ada
! 32c440ad7d9ac139bbd4251c4fc10cc4  gcc/testsuite/ada/acats-2/tests/c8/c83028a.ada
! 284725a771243ec2eb877c3bb20240af  gcc/testsuite/ada/acats-2/tests/c8/c83029a.ada
! 0d4d1e41b05e2587d04c09930491aecd  gcc/testsuite/ada/acats-2/tests/c8/c83030a.ada
! 736b92fd2fdec116e1e9a28e04fe105a  gcc/testsuite/ada/acats-2/tests/c8/c83030c.ada
! 8e7b338ab4662f4c219903b9017a3252  gcc/testsuite/ada/acats-2/tests/c8/c83031a.ada
! 8799fc3b7ae4481b9d03ab137000f62e  gcc/testsuite/ada/acats-2/tests/c8/c83031c.ada
! 4c6a471797dc4320ecdae183b931f1e8  gcc/testsuite/ada/acats-2/tests/c8/c83031e.ada
! a6758128580028e639e0a59521425cf0  gcc/testsuite/ada/acats-2/tests/c8/c83032a.ada
! 72628676c750edbd1f98131cb5571a2f  gcc/testsuite/ada/acats-2/tests/c8/c83033a.ada
! 9431427fb4aa9f6e7d3a4375ffaecc6c  gcc/testsuite/ada/acats-2/tests/c8/c83051a.ada
! f2fa97381bbbbba9176ccf7627ee5fd8  gcc/testsuite/ada/acats-2/tests/c8/c83b02a.ada
! 03bdf2b2546804982387b339182818e7  gcc/testsuite/ada/acats-2/tests/c8/c83b02b.ada
! 40875d29e98f8a554f57a2cbba7d7b3e  gcc/testsuite/ada/acats-2/tests/c8/c83e02a.ada
! 14cf40af4f9b58380697256b2d355287  gcc/testsuite/ada/acats-2/tests/c8/c83e02b.ada
! 200ef6a026cfe27a93be29d96cf214b8  gcc/testsuite/ada/acats-2/tests/c8/c83e03a.ada
! ad5525a2d740a4d893fcd637c63649fd  gcc/testsuite/ada/acats-2/tests/c8/c83f01a.ada
! e565198c8053dc81f1f530025b0d226b  gcc/testsuite/ada/acats-2/tests/c8/c83f01b.ada
! 6d7321886000c19fde08f583e57a7e33  gcc/testsuite/ada/acats-2/tests/c8/c83f01c0.ada
! b0f89c8df04b680d3d4603f896b4d648  gcc/testsuite/ada/acats-2/tests/c8/c83f01c1.ada
! faebab8928acaa2b8fbf803db9d9d76e  gcc/testsuite/ada/acats-2/tests/c8/c83f01c2.ada
! 76e6504b3bae53ff3ed9396d5c7812a4  gcc/testsuite/ada/acats-2/tests/c8/c83f01d0.ada
! 64bf8f6ff542539524d925d1e5a9cfe4  gcc/testsuite/ada/acats-2/tests/c8/c83f01d1.ada
! 8a46931f49572809caa7fa3dacf72336  gcc/testsuite/ada/acats-2/tests/c8/c83f03a.ada
! 12f92031807ee7b6703ecca17d07c9ad  gcc/testsuite/ada/acats-2/tests/c8/c83f03b.ada
! 2f7e657595b99ed4902cb3ed7aae770f  gcc/testsuite/ada/acats-2/tests/c8/c83f03c0.ada
! b07043910b1b62a4647fb0958270ab2e  gcc/testsuite/ada/acats-2/tests/c8/c83f03c1.ada
! 2a8ed5812b7eba602e55bc4cba957511  gcc/testsuite/ada/acats-2/tests/c8/c83f03c2.ada
! d29900c193533f0d919bf89d2bc8e119  gcc/testsuite/ada/acats-2/tests/c8/c83f03d0.ada
! a81483935d1a82f02d88010465d1f944  gcc/testsuite/ada/acats-2/tests/c8/c83f03d1.ada
! 29bd80df35d00ef1384ad39409db64f6  gcc/testsuite/ada/acats-2/tests/c8/c840001.a
! af9ade351c5ef6a9d951a20d59988380  gcc/testsuite/ada/acats-2/tests/c8/c84002a.ada
! 66d1e4c5ecfdc60f73f72122f13591ac  gcc/testsuite/ada/acats-2/tests/c8/c84005a.ada
! aa6a6f80ff85e69f2df4df4eede3b31f  gcc/testsuite/ada/acats-2/tests/c8/c84008a.ada
! 09c80b3d29e25029f03088427d21bbcc  gcc/testsuite/ada/acats-2/tests/c8/c84009a.ada
! d7b3488b66a68bdb7c8d505ca3419ac7  gcc/testsuite/ada/acats-2/tests/c8/c85004b.ada
! 3e0403d2aa151370c2f61352a9f76996  gcc/testsuite/ada/acats-2/tests/c8/c85005a.ada
! 37c7fd0ed7d0bc32d740e9c53a118651  gcc/testsuite/ada/acats-2/tests/c8/c85005b.ada
! 1fc662c5706ae3323d79577161aa2b7c  gcc/testsuite/ada/acats-2/tests/c8/c85005c.ada
! c7c4cd7450d2b2ce6c9f804ab189b71e  gcc/testsuite/ada/acats-2/tests/c8/c85005d.ada
! 39a019807c800fea7de5ee674f51f3ac  gcc/testsuite/ada/acats-2/tests/c8/c85005e.ada
! 8d1e127599b478a2675315047b0c481f  gcc/testsuite/ada/acats-2/tests/c8/c85005f.ada
! 25bfcee3ce65c19279f2e6ae6c7dbfba  gcc/testsuite/ada/acats-2/tests/c8/c85005g.ada
! 32fef31a23447e83e62b591ccf214749  gcc/testsuite/ada/acats-2/tests/c8/c85006a.ada
! 52a38ccdb969e742c721e8c6b91f9aee  gcc/testsuite/ada/acats-2/tests/c8/c85006b.ada
! b8b2355c13723ce1e608404a697d37f1  gcc/testsuite/ada/acats-2/tests/c8/c85006c.ada
! f9f754296bb969ded99acf18e0d0cc57  gcc/testsuite/ada/acats-2/tests/c8/c85006d.ada
! 13a5f5c38fb9c62ade83208e0c68d79e  gcc/testsuite/ada/acats-2/tests/c8/c85006e.ada
! 338359196a7f9ec95687b438473fe4b5  gcc/testsuite/ada/acats-2/tests/c8/c85006f.ada
! 2009399861eb5a59e17598709aab1ac2  gcc/testsuite/ada/acats-2/tests/c8/c85006g.ada
! 81de8bcdf2627a437c3e3b841e5fad1d  gcc/testsuite/ada/acats-2/tests/c8/c85007a.ada
! e357cc223f207047a721ac8e8e18f162  gcc/testsuite/ada/acats-2/tests/c8/c85007e.ada
! 418333040a3a7bff04eadeddd0acb110  gcc/testsuite/ada/acats-2/tests/c8/c85009a.ada
! bd6854facde59a298fdff160083dd037  gcc/testsuite/ada/acats-2/tests/c8/c85011a.ada
! 406a5955e9d949bdd8248e3006f85389  gcc/testsuite/ada/acats-2/tests/c8/c85013a.ada
! 85235f6d4b44c3da298beab51c59e532  gcc/testsuite/ada/acats-2/tests/c8/c85014a.ada
! 63d0b09e17f02992f14dc03cc7687879  gcc/testsuite/ada/acats-2/tests/c8/c85014b.ada
! 8a941d41b729176aeb087812bd185dbb  gcc/testsuite/ada/acats-2/tests/c8/c85014c.ada
! e1660d68b127c37ec14d42ba45a3b445  gcc/testsuite/ada/acats-2/tests/c8/c85017a.ada
! 1cad26f34f7ad9a5f58bf9e88765aca9  gcc/testsuite/ada/acats-2/tests/c8/c85018a.ada
! 9c45b00830d440af2ac60b55d681400a  gcc/testsuite/ada/acats-2/tests/c8/c85018b.ada
! 8d0a794043808c838cf5adba232cacac  gcc/testsuite/ada/acats-2/tests/c8/c85019a.ada
! 9b74243be116d7855c67ebe955d78830  gcc/testsuite/ada/acats-2/tests/c8/c854001.a
! 825c879ca9c376275c17511ad5e00304  gcc/testsuite/ada/acats-2/tests/c8/c854002.a
! d68292de38c7b9e049e07075bbb8e3be  gcc/testsuite/ada/acats-2/tests/c8/c854003.a
! 1f1f18804e6fcf9c4e2fbec6349d04b2  gcc/testsuite/ada/acats-2/tests/c8/c86003a.ada
! e2f34ff3aa901cdf44aa714bfc307b17  gcc/testsuite/ada/acats-2/tests/c8/c86004a.ada
! d4f2cc5c80e276eb1480de6a342d8b63  gcc/testsuite/ada/acats-2/tests/c8/c86004b0.ada
! 50f93d108a0bf0919eb0ba1f6e65d7f0  gcc/testsuite/ada/acats-2/tests/c8/c86004b1.ada
! 6c2d0d9c9429d88e2c6672c71366873c  gcc/testsuite/ada/acats-2/tests/c8/c86004b2.ada
! 7f6e918b2ef0b5adc4139d9b912bc081  gcc/testsuite/ada/acats-2/tests/c8/c86004c0.ada
! a2305c116ad2dac3912371b71c441b61  gcc/testsuite/ada/acats-2/tests/c8/c86004c1.ada
! c7b7606151d38f39564979699b168c79  gcc/testsuite/ada/acats-2/tests/c8/c86004c2.ada
! 0766251158ffbc052bc7ec6041412761  gcc/testsuite/ada/acats-2/tests/c8/c86006i.ada
! 69ab336267b976906702c2d0bc1c1e29  gcc/testsuite/ada/acats-2/tests/c8/c86007a.ada
! 0ac058a1ece69aa243cd82dada40bb30  gcc/testsuite/ada/acats-2/tests/c8/c87a05a.ada
! fff71eeb0c0e9f16ee678756ea7588a4  gcc/testsuite/ada/acats-2/tests/c8/c87a05b.ada
! 2fe0ea4d16046c334c399aafeddc01a8  gcc/testsuite/ada/acats-2/tests/c8/c87b02a.ada
! fcd21b497cf853422b084ed7935381d4  gcc/testsuite/ada/acats-2/tests/c8/c87b02b.ada
! c0b66a348c2ee10edc5467a8eb009d09  gcc/testsuite/ada/acats-2/tests/c8/c87b03a.ada
! adac4007a7fd6b1ee9f1f48c55244d47  gcc/testsuite/ada/acats-2/tests/c8/c87b04a.ada
! 18ccfb1a0d973da4e1686b0c98dfa1a9  gcc/testsuite/ada/acats-2/tests/c8/c87b04b.ada
! 43cf46342879eb1ffe2f7c8971af6a38  gcc/testsuite/ada/acats-2/tests/c8/c87b04c.ada
! d0144de0520c60120721d7b571e3985d  gcc/testsuite/ada/acats-2/tests/c8/c87b05a.ada
! 2b781472cd1369f9eb86a64cd5e4a9d9  gcc/testsuite/ada/acats-2/tests/c8/c87b06a.ada
! c22a9ce42feb05505f797ccc539112bd  gcc/testsuite/ada/acats-2/tests/c8/c87b07a.ada
! 5cb748b4c292f38beadd4b397c9748ef  gcc/testsuite/ada/acats-2/tests/c8/c87b07b.ada
! cd570d3799a0f4ceeabe1513e0c1c809  gcc/testsuite/ada/acats-2/tests/c8/c87b07c.ada
! 94b970485847bd2d888e33a9e0bbeb1c  gcc/testsuite/ada/acats-2/tests/c8/c87b07d.ada
! 4a11dd4cf1ef59a68c9760ade0024c31  gcc/testsuite/ada/acats-2/tests/c8/c87b07e.ada
! e031b7e0f562bef1da7d73abf8e7203d  gcc/testsuite/ada/acats-2/tests/c8/c87b08a.ada
! ddc6096fff2cbf60aa3fe948c1c569c3  gcc/testsuite/ada/acats-2/tests/c8/c87b09a.ada
! 427f1fe54f5946c6611f5abe3d23e213  gcc/testsuite/ada/acats-2/tests/c8/c87b09c.ada
! 4f2d8b50e737f09ccf25f199443471c8  gcc/testsuite/ada/acats-2/tests/c8/c87b10a.ada
! b3ddde623ffa0748cae187472ed3c706  gcc/testsuite/ada/acats-2/tests/c8/c87b11a.ada
! 34f04500698b844ee3bbe19fcec6df7b  gcc/testsuite/ada/acats-2/tests/c8/c87b11b.ada
! 42486daf86c543499fe18e7700c2a2c5  gcc/testsuite/ada/acats-2/tests/c8/c87b13a.ada
! 343104f8b07cc3cdfea584fb91d7dad0  gcc/testsuite/ada/acats-2/tests/c8/c87b14a.ada
! 3129f63056e924075c9eef5fb92ff6be  gcc/testsuite/ada/acats-2/tests/c8/c87b14b.ada
! 9fec6d81e8cfe9a1be8263f1fcff0c24  gcc/testsuite/ada/acats-2/tests/c8/c87b14c.ada
! c9a24774d85aaa6a9ad204d88ef33dc3  gcc/testsuite/ada/acats-2/tests/c8/c87b14d.ada
! 75444b8bc412150144d6500a1c98caa1  gcc/testsuite/ada/acats-2/tests/c8/c87b15a.ada
! b02c9f3d290904a7b941ba27ad5b8cbe  gcc/testsuite/ada/acats-2/tests/c8/c87b16a.ada
! 352fe9e9dcbad212440a7cb09e0f5a22  gcc/testsuite/ada/acats-2/tests/c8/c87b17a.ada
! da9c835dde5437b7c6fd41430e0523c7  gcc/testsuite/ada/acats-2/tests/c8/c87b18a.ada
! 6233d050a9dc22ef89142ebf8f28ccf0  gcc/testsuite/ada/acats-2/tests/c8/c87b18b.ada
! 8d538ac45635004402030cb4640caa57  gcc/testsuite/ada/acats-2/tests/c8/c87b19a.ada
! 2095765cd4def145a48bc901ac6dbde1  gcc/testsuite/ada/acats-2/tests/c8/c87b23a.ada
! 67d87906e113b008e98391cc2776a960  gcc/testsuite/ada/acats-2/tests/c8/c87b24a.ada
! fd73894f92a9b3a013e87ea2b44c1ee4  gcc/testsuite/ada/acats-2/tests/c8/c87b24b.ada
! ae8732c293e965d19215928ca5c16d40  gcc/testsuite/ada/acats-2/tests/c8/c87b26b.ada
! b14d1be798ca4f79c28b996d1e8a7113  gcc/testsuite/ada/acats-2/tests/c8/c87b27a.ada
! 52b1e1223a0044bd348db0fcb6d79d6b  gcc/testsuite/ada/acats-2/tests/c8/c87b28a.ada
! a6a5c9403ac6bdbdb2e55d6a25b9f5ed  gcc/testsuite/ada/acats-2/tests/c8/c87b29a.ada
! b151ba31fb04091b8702bb9da4a0a2fb  gcc/testsuite/ada/acats-2/tests/c8/c87b30a.ada
! baa7d485e6d766db9246c9606ba3a078  gcc/testsuite/ada/acats-2/tests/c8/c87b31a.ada
! 78fd2d4c2c4821cfbbf402d3b842e2cc  gcc/testsuite/ada/acats-2/tests/c8/c87b32a.ada
! 833d7f92c1dba9641ebcb3157ab5d24e  gcc/testsuite/ada/acats-2/tests/c8/c87b33a.ada
! 36465d48d4bab661c6218ee48524b608  gcc/testsuite/ada/acats-2/tests/c8/c87b34a.ada
! 561be38a9a0275b65d22f782b23c1f8c  gcc/testsuite/ada/acats-2/tests/c8/c87b34b.ada
! 1239485e0f456d72c43f397227762788  gcc/testsuite/ada/acats-2/tests/c8/c87b34c.ada
! 041b7b6888183bbf71655055555c1b87  gcc/testsuite/ada/acats-2/tests/c8/c87b35c.ada
! ba86ee0565261018e59b1b01d9d63a78  gcc/testsuite/ada/acats-2/tests/c8/c87b38a.ada
! bee8f2cc8e7a407c5d1e665cafb324a0  gcc/testsuite/ada/acats-2/tests/c8/c87b39a.ada
! 0149e0004f1fac32a6d0483505f00a77  gcc/testsuite/ada/acats-2/tests/c8/c87b40a.ada
! 979e8597fe7349e04ef67ff5a9f249ad  gcc/testsuite/ada/acats-2/tests/c8/c87b41a.ada
! 35740da1bae3e32ad7726fef598ebe03  gcc/testsuite/ada/acats-2/tests/c8/c87b42a.ada
! c699f8cb33019178eb66bb9b9887fc34  gcc/testsuite/ada/acats-2/tests/c8/c87b43a.ada
! 284fc10b4e768deed27f6efe5ba660f3  gcc/testsuite/ada/acats-2/tests/c8/c87b44a.ada
! d1cacfe3528a0559f8572409bdad7960  gcc/testsuite/ada/acats-2/tests/c8/c87b45a.ada
! 615100562dae434f6237d50c2ce7a859  gcc/testsuite/ada/acats-2/tests/c8/c87b45c.ada
! ee9fa629414e1ff85ab5a901880627c6  gcc/testsuite/ada/acats-2/tests/c8/c87b47a.ada
! f01c1e9a040d9bf9e82d5b0bd8308ac2  gcc/testsuite/ada/acats-2/tests/c8/c87b48a.ada
! 5f12e71520b411de1dcbfb59ca609af5  gcc/testsuite/ada/acats-2/tests/c8/c87b48b.ada
! 7accae5d8bcb7a6376aeb4769bbc3521  gcc/testsuite/ada/acats-2/tests/c8/c87b50a.ada
! 49e93ad6fd90f250357c964cfe65bbb4  gcc/testsuite/ada/acats-2/tests/c8/c87b54a.ada
! 6b87b80aa7e4be221c3a6fcc95a098e2  gcc/testsuite/ada/acats-2/tests/c8/c87b57a.ada
! e29430c61d05400015468771710caebe  gcc/testsuite/ada/acats-2/tests/c8/c87b62a.ada
! d69bb1d50cac4c6397e7ef6ac85cec47  gcc/testsuite/ada/acats-2/tests/c8/c87b62b.ada
! b2cd3c65ecd1e96a0c0812252c334c48  gcc/testsuite/ada/acats-2/tests/c8/c87b62c.ada
! f48458b6ea766af192adb8d401f368fc  gcc/testsuite/ada/acats-2/tests/c8/c87b62d.tst
! 91802a6e8fc88eaea2b276279ef7c541  gcc/testsuite/ada/acats-2/tests/c9/c910001.a
! 92f4e59378989d90d762b2fdfa367275  gcc/testsuite/ada/acats-2/tests/c9/c910002.a
! 1da7e86ddeb55b8594570c708479d7da  gcc/testsuite/ada/acats-2/tests/c9/c910003.a
! 3e61dff323d06b22fad060cfc4e6bbe3  gcc/testsuite/ada/acats-2/tests/c9/c91004b.ada
! 69469a828c0050868f258475fc71f55d  gcc/testsuite/ada/acats-2/tests/c9/c91004c.ada
! 0ff6798e735543f9ea0902dcd3d33bd4  gcc/testsuite/ada/acats-2/tests/c9/c91006a.ada
! 7f1ab85728a76023b65305acb8480064  gcc/testsuite/ada/acats-2/tests/c9/c91007a.ada
! b04d09f1322f0d92c98d41398964503d  gcc/testsuite/ada/acats-2/tests/c9/c92002a.ada
! 5cb78880eadfd9eac647aba39fa528da  gcc/testsuite/ada/acats-2/tests/c9/c92003a.ada
! bfa0af83fa76f2092a243ddded4670d8  gcc/testsuite/ada/acats-2/tests/c9/c92005a.ada
! 379c27e94764b3b61fffdc4a6886f267  gcc/testsuite/ada/acats-2/tests/c9/c92005b.ada
! a47a031badac4df0d97db8bef1c3bc41  gcc/testsuite/ada/acats-2/tests/c9/c92006a.ada
! e4aee3e6761bfd67eaa5d1bd1ef57470  gcc/testsuite/ada/acats-2/tests/c9/c930001.a
! d21857231e61275a32c743ac514d1bc5  gcc/testsuite/ada/acats-2/tests/c9/c93001a.ada
! 493236f457ba46ba4fee16d542742d6c  gcc/testsuite/ada/acats-2/tests/c9/c93002a.ada
! 58f568faf270170c72b48115224a9ea8  gcc/testsuite/ada/acats-2/tests/c9/c93003a.ada
! 7612773970dfbe9066b04bb3ef16a233  gcc/testsuite/ada/acats-2/tests/c9/c93004a.ada
! ba12024ce449c8f19c903d5b83a7772c  gcc/testsuite/ada/acats-2/tests/c9/c93004b.ada
! 84f08b2297ca6e587b20b46ac2f4a739  gcc/testsuite/ada/acats-2/tests/c9/c93004c.ada
! e206bbe8f5a43a6b351e76ac75ac54bf  gcc/testsuite/ada/acats-2/tests/c9/c93004d.ada
! 00ac7aaad0308e432bf16c8682817a14  gcc/testsuite/ada/acats-2/tests/c9/c93004f.ada
! 08c88f164d59d4eab6aca557a4a64946  gcc/testsuite/ada/acats-2/tests/c9/c93005a.ada
! 8e317f80e3b0b4e3561b4aae157d6049  gcc/testsuite/ada/acats-2/tests/c9/c93005b.ada
! 7d334041be29ea9e8c37717a41e00262  gcc/testsuite/ada/acats-2/tests/c9/c93005c.ada
! 7eaab6600302226ca2aa221a1baa20b3  gcc/testsuite/ada/acats-2/tests/c9/c93005d.ada
! f8e495878721a71a7dbdd646b8e0a2f9  gcc/testsuite/ada/acats-2/tests/c9/c93005e.ada
! 0240c3a7deba6bd32679e222b5fadd86  gcc/testsuite/ada/acats-2/tests/c9/c93005f.ada
! c50d0176fa8ed0d5d6234013904fc2bf  gcc/testsuite/ada/acats-2/tests/c9/c93005g.ada
! 6a27b797bf6bf6201d7e22aec1399ef3  gcc/testsuite/ada/acats-2/tests/c9/c93005h.ada
! 9558fcb539a49a288534eb8b0dd23274  gcc/testsuite/ada/acats-2/tests/c9/c93006a.ada
! fe32d2d556faa4d361e61f9063f9d19b  gcc/testsuite/ada/acats-2/tests/c9/c93007a.ada
! e1f28c5786e15914c044ecc368a334c4  gcc/testsuite/ada/acats-2/tests/c9/c93008a.ada
! f12f826d928a3bc55974d9e4a7a4bced  gcc/testsuite/ada/acats-2/tests/c9/c93008b.ada
! 84c45a691f716f13c1acb83d5af7418d  gcc/testsuite/ada/acats-2/tests/c9/c940001.a
! 99f1785334b15c78f6c402eb9581f820  gcc/testsuite/ada/acats-2/tests/c9/c940002.a
! d4515a061510c374dc4e3b73047c01bd  gcc/testsuite/ada/acats-2/tests/c9/c940004.a
! 982944ab84b1e87938411f5e230c4afe  gcc/testsuite/ada/acats-2/tests/c9/c940005.a
! 24e534dd458f6d60deaffb89427151e3  gcc/testsuite/ada/acats-2/tests/c9/c940006.a
! ae39153ecdb5b40b7e250621dda2a947  gcc/testsuite/ada/acats-2/tests/c9/c940007.a
! ed93c06c8fbc77ffcb96431dac0e7567  gcc/testsuite/ada/acats-2/tests/c9/c940010.a
! b5f59a7bcad9207813e580204d7d297d  gcc/testsuite/ada/acats-2/tests/c9/c940011.a
! 2cc5af1321a3389a051ba331add4436e  gcc/testsuite/ada/acats-2/tests/c9/c940012.a
! 46c8ffa64ae0068a1674cd8386b42f41  gcc/testsuite/ada/acats-2/tests/c9/c940013.a
! 9fac2bc0e89e8f222104978b3d1eaf3b  gcc/testsuite/ada/acats-2/tests/c9/c940014.a
! 004d847da87db0a9fe57406d26459dfd  gcc/testsuite/ada/acats-2/tests/c9/c940015.a
! 47e9712a5187d745e5ab17e658f2f210  gcc/testsuite/ada/acats-2/tests/c9/c940016.a
! d6c7936f3b8d4c1d418f288e59676083  gcc/testsuite/ada/acats-2/tests/c9/c94001a.ada
! dbb8668731806fd13d24f9f4652011a1  gcc/testsuite/ada/acats-2/tests/c9/c94001b.ada
! 2a37c7d38240abcbac6ce81990a474e8  gcc/testsuite/ada/acats-2/tests/c9/c94001c.ada
! 5b89b2c47939e01428fda5cdb7b76bfc  gcc/testsuite/ada/acats-2/tests/c9/c94001e.ada
! 79b95e3bce431f5a1d5d5264c35ba5a9  gcc/testsuite/ada/acats-2/tests/c9/c94001f.ada
! 77a4dc124639ae407e5aca42c786703a  gcc/testsuite/ada/acats-2/tests/c9/c94001g.ada
! d99ad4e9eb32c130ce020dfc0891014e  gcc/testsuite/ada/acats-2/tests/c9/c94002a.ada
! ea931758bd0eaf85c1c1a04b2f7c71de  gcc/testsuite/ada/acats-2/tests/c9/c94002b.ada
! 131233ea081ac6ea10a1e10fbba005f2  gcc/testsuite/ada/acats-2/tests/c9/c94002d.ada
! 170256ffad705761ef2331d6d2a07771  gcc/testsuite/ada/acats-2/tests/c9/c94002e.ada
! 066f90e14b935717dde3fa4b96807563  gcc/testsuite/ada/acats-2/tests/c9/c94002f.ada
! 8a13ee6acd0d6f24e23333f06259df08  gcc/testsuite/ada/acats-2/tests/c9/c94002g.ada
! edbadeb0fe0aa698afbadafa8f3436bd  gcc/testsuite/ada/acats-2/tests/c9/c94004a.ada
! 1b81499cc92f2a4727604818b28d5028  gcc/testsuite/ada/acats-2/tests/c9/c94004b.ada
! 3a8b33e638dc0e28266a8e016eeec4fe  gcc/testsuite/ada/acats-2/tests/c9/c94004c.ada
! 2363fc8f9fa540996dd00c6b70dcb3fb  gcc/testsuite/ada/acats-2/tests/c9/c94005a.ada
! 25c866c01dd0b62ce66fb2d8912da8b6  gcc/testsuite/ada/acats-2/tests/c9/c94005b.ada
! 58ea156e98cc4536f068259cb7d392ce  gcc/testsuite/ada/acats-2/tests/c9/c94006a.ada
! 41842cea07ae1bf2ef7a3f649e4ae367  gcc/testsuite/ada/acats-2/tests/c9/c94007a.ada
! 0d97216a40757079eb2c5929715d2b99  gcc/testsuite/ada/acats-2/tests/c9/c94007b.ada
! 4c0be4d154afe78593220fcb4ce1db68  gcc/testsuite/ada/acats-2/tests/c9/c94008a.ada
! 96e113f41f41a01c2196b7773e735c4f  gcc/testsuite/ada/acats-2/tests/c9/c94008b.ada
! 17f5eb44b8190ee09e9f0ffcffe2e7a4  gcc/testsuite/ada/acats-2/tests/c9/c94008c.ada
! c810cc6ac3bebe36845e2cba4e525930  gcc/testsuite/ada/acats-2/tests/c9/c94008d.ada
! ee84f56d88a1ac003b078ea49001e5fa  gcc/testsuite/ada/acats-2/tests/c9/c94010a.ada
! 136872ec7f9870731797ab20b32f6696  gcc/testsuite/ada/acats-2/tests/c9/c94011a.ada
! a8508d1bdacc8da03549a92370d18ed0  gcc/testsuite/ada/acats-2/tests/c9/c94020a.ada
! 54dba96923cbd3444b91d1706e737c16  gcc/testsuite/ada/acats-2/tests/c9/c940a03.a
! 14ac629d930514b19edd9d5fa73cf107  gcc/testsuite/ada/acats-2/tests/c9/c95008a.ada
! b48683e2458942b3ffc46be9054c7911  gcc/testsuite/ada/acats-2/tests/c9/c95009a.ada
! b4adaad3668499bb335d018420c56f91  gcc/testsuite/ada/acats-2/tests/c9/c95010a.ada
! 2900d4b177d19e9f35c4693ea6b14ec8  gcc/testsuite/ada/acats-2/tests/c9/c95011a.ada
! 880dc25ba16839f531364b6a8427aab6  gcc/testsuite/ada/acats-2/tests/c9/c95012a.ada
! 701e89d7711a71b3be5269c5238a18c7  gcc/testsuite/ada/acats-2/tests/c9/c95021a.ada
! c091dcb9509e234377d2ac8ee75d10e0  gcc/testsuite/ada/acats-2/tests/c9/c95022a.ada
! 65035c12f67d253a2397d2126f4ba6c6  gcc/testsuite/ada/acats-2/tests/c9/c95022b.ada
! cc0f07ec1171a66007308281b576f7c4  gcc/testsuite/ada/acats-2/tests/c9/c95033a.ada
! 4de48cf31bf233b1fdc87aeffb9972de  gcc/testsuite/ada/acats-2/tests/c9/c95033b.ada
! cc9febfaeca52b7d6647ca62001797e7  gcc/testsuite/ada/acats-2/tests/c9/c95034a.ada
! d5302e6651eeb53974a9d013a4cdedc8  gcc/testsuite/ada/acats-2/tests/c9/c95034b.ada
! 60c5c5f334073dc4d79928f49152f582  gcc/testsuite/ada/acats-2/tests/c9/c95035a.ada
! 3eda3680c647ff3fb263637efebd9f65  gcc/testsuite/ada/acats-2/tests/c9/c95040a.ada
! 8e8e82ad5bdec76ed6e7c4ae88a3b54f  gcc/testsuite/ada/acats-2/tests/c9/c95040b.ada
! ed765b423843bd4ca78de15c1b071692  gcc/testsuite/ada/acats-2/tests/c9/c95040c.ada
! 30e738c92230ba86578f011623e5802a  gcc/testsuite/ada/acats-2/tests/c9/c95040d.ada
! 168221198b482975d09392b2fcad8a7b  gcc/testsuite/ada/acats-2/tests/c9/c95041a.ada
! c6313618d1cd8a8218dcd446fd95a86e  gcc/testsuite/ada/acats-2/tests/c9/c95065a.ada
! 8832636689a3eda560469f04cfa76418  gcc/testsuite/ada/acats-2/tests/c9/c95065b.ada
! 5aaadcb32b841fad9f31245493b516f6  gcc/testsuite/ada/acats-2/tests/c9/c95065c.ada
! a39b19410538e12fdfcb7cd54d120b3f  gcc/testsuite/ada/acats-2/tests/c9/c95065d.ada
! 383b7f01039162f8c331982cca1d1827  gcc/testsuite/ada/acats-2/tests/c9/c95065e.ada
! c184eac9dc26cf8493bcf20a949ae191  gcc/testsuite/ada/acats-2/tests/c9/c95065f.ada
! 5b0b09d3d393123f8092b9dd3d7d2634  gcc/testsuite/ada/acats-2/tests/c9/c95066a.ada
! 645546a6994e4d75b178f9fe0ead2ec8  gcc/testsuite/ada/acats-2/tests/c9/c95067a.ada
! 0d96b6a028d1fbdc1198cf477386cb10  gcc/testsuite/ada/acats-2/tests/c9/c95071a.ada
! 1252b71f747f12dc764f40b587be838a  gcc/testsuite/ada/acats-2/tests/c9/c95072a.ada
! bd5b6bb2bf3ba074df027795aaa7db33  gcc/testsuite/ada/acats-2/tests/c9/c95072b.ada
! befede1120f2f7955e0b77c883265e25  gcc/testsuite/ada/acats-2/tests/c9/c95073a.ada
! 48c97fe967f3c5e1bc663c5d91ed55bd  gcc/testsuite/ada/acats-2/tests/c9/c95074c.ada
! 6aaf0bf21901d478c7f10321b1c232fc  gcc/testsuite/ada/acats-2/tests/c9/c95076a.ada
! ba053d263ff25d0fe8b66c68cb7bb311  gcc/testsuite/ada/acats-2/tests/c9/c95078a.ada
! a7e9f0e064ac2a29ebe79a19983758dc  gcc/testsuite/ada/acats-2/tests/c9/c95080b.ada
! 73fa133c9eac6146a770bb5525331e35  gcc/testsuite/ada/acats-2/tests/c9/c95082g.ada
! 61f2b9320583cc5ff1eca06b3e8cd887  gcc/testsuite/ada/acats-2/tests/c9/c95085a.ada
! 9e1cf3433f8341a6b183079a377b0fad  gcc/testsuite/ada/acats-2/tests/c9/c95085b.ada
! e39dbe6050c2679aa6a7d89c762e8c0a  gcc/testsuite/ada/acats-2/tests/c9/c95085c.ada
! 6c946d9a6886fc8b7d6145f3958a1016  gcc/testsuite/ada/acats-2/tests/c9/c95085d.ada
! c8c26f8183027ac456df33b272a0e185  gcc/testsuite/ada/acats-2/tests/c9/c95085e.ada
! e29633617dcca72904423b7e09ea1401  gcc/testsuite/ada/acats-2/tests/c9/c95085f.ada
! 3e1d9c4d7627f1b32df23e0787f1ae30  gcc/testsuite/ada/acats-2/tests/c9/c95085g.ada
! 55b52211957a2231b59c295b91e1bbfe  gcc/testsuite/ada/acats-2/tests/c9/c95085h.ada
! f472998d938475a0a5b7c61c4a994dbe  gcc/testsuite/ada/acats-2/tests/c9/c95085i.ada
! e7d6c7d1e457a9097de27a4d4b6df67e  gcc/testsuite/ada/acats-2/tests/c9/c95085j.ada
! 9dcf6b0120351dbd31ca6b3b07007dda  gcc/testsuite/ada/acats-2/tests/c9/c95085k.ada
! f65f9568bbdcba31e56e46a1bff7a8a7  gcc/testsuite/ada/acats-2/tests/c9/c95085l.ada
! 2794ec3980004ff90d3fdda0ebeb57be  gcc/testsuite/ada/acats-2/tests/c9/c95085m.ada
! cd5e6789b1381a01c8abe9b8efc437eb  gcc/testsuite/ada/acats-2/tests/c9/c95085n.ada
! ec751b6898b7a50e0c7e413ac04f3096  gcc/testsuite/ada/acats-2/tests/c9/c95085o.ada
! 4d079ed4815a2d61d769f5571e546504  gcc/testsuite/ada/acats-2/tests/c9/c95086a.ada
! 3f5ba7557a56b3376b0d11a44977eb6b  gcc/testsuite/ada/acats-2/tests/c9/c95086b.ada
! 4423694080505c12206b273d44b25a6c  gcc/testsuite/ada/acats-2/tests/c9/c95086c.ada
! 9ddcd960179a50f19400614669ee58dd  gcc/testsuite/ada/acats-2/tests/c9/c95086d.ada
! b943966db2007cce0bd0ab55a7241cb6  gcc/testsuite/ada/acats-2/tests/c9/c95086e.ada
! 63af3fb63913a9ced35b10b55e03d16c  gcc/testsuite/ada/acats-2/tests/c9/c95086f.ada
! fb4e2598701ac2222961218c56e9989e  gcc/testsuite/ada/acats-2/tests/c9/c95087a.ada
! 6ca41778e752016a3cb5f39d3655160a  gcc/testsuite/ada/acats-2/tests/c9/c95087b.ada
! b77cd9cab875027ed13370d439f3d83a  gcc/testsuite/ada/acats-2/tests/c9/c95087c.ada
! 94c2f92c8d38ace856b3d3a4e46e2f10  gcc/testsuite/ada/acats-2/tests/c9/c95087d.ada
! 8ace111d2db71af514234c843bcdc774  gcc/testsuite/ada/acats-2/tests/c9/c95088a.ada
! 3eab89caa6cfdaad3ecaee2fb3a9de67  gcc/testsuite/ada/acats-2/tests/c9/c95089a.ada
! c23a0d393dfca230669443fa90939e9e  gcc/testsuite/ada/acats-2/tests/c9/c95090a.ada
! 2dea0b25d5837e3f040a606b74b5bfe7  gcc/testsuite/ada/acats-2/tests/c9/c95092a.ada
! da5b15c611f0e80c4bd500a6377cf1fb  gcc/testsuite/ada/acats-2/tests/c9/c95093a.ada
! 411e85f00716bde0eb4bebe2dd4a4b17  gcc/testsuite/ada/acats-2/tests/c9/c95095a.ada
! 20d01625fd521f83c0fbb4e0d5989f1c  gcc/testsuite/ada/acats-2/tests/c9/c95095b.ada
! f1a2d7fb3c08ba5c9b45d28b8c434cf9  gcc/testsuite/ada/acats-2/tests/c9/c95095c.ada
! fe6c832ec4b8584b35ad79ad6f658734  gcc/testsuite/ada/acats-2/tests/c9/c95095d.ada
! d71ab35932ba486e65cee5d0a7ea6c58  gcc/testsuite/ada/acats-2/tests/c9/c95095e.ada
! b665ab275e30b4a49c6a32d1c1b8d3b0  gcc/testsuite/ada/acats-2/tests/c9/c951001.a
! 31bba47fca22f334739b1cb13505c63f  gcc/testsuite/ada/acats-2/tests/c9/c951002.a
! 380eef904bedee70e470eec6283fe7fa  gcc/testsuite/ada/acats-2/tests/c9/c953001.a
! 8b4cbf1e111e939494dbd6c9170d9add  gcc/testsuite/ada/acats-2/tests/c9/c953002.a
! b85e67ebb144368e710912fad26fa9b5  gcc/testsuite/ada/acats-2/tests/c9/c953003.a
! 349793c14b6ee642849a35ac147f6d28  gcc/testsuite/ada/acats-2/tests/c9/c954001.a
! 32a2b22071eb90de620dac85832e7e33  gcc/testsuite/ada/acats-2/tests/c9/c954010.a
! 5c71f334e75e4b81847ba6609055a721  gcc/testsuite/ada/acats-2/tests/c9/c954011.a
! 0f6b02e34f34de574c7f90adcb78c1d3  gcc/testsuite/ada/acats-2/tests/c9/c954012.a
! 0af78b179cbaf289947a4b0cc90e1b92  gcc/testsuite/ada/acats-2/tests/c9/c954013.a
! 498084096b8ec59a36a889374ad9ee3e  gcc/testsuite/ada/acats-2/tests/c9/c954014.a
! 97799887dcbf60005b2df40f05636514  gcc/testsuite/ada/acats-2/tests/c9/c954015.a
! 2490fc80b69ada26f8142dacebcc5823  gcc/testsuite/ada/acats-2/tests/c9/c954016.a
! 23e5c9126dfc78e228cd9ba7e9fd2f4d  gcc/testsuite/ada/acats-2/tests/c9/c954017.a
! bdfa1b9ada52a8082dfc30a91d56af89  gcc/testsuite/ada/acats-2/tests/c9/c954018.a
! e039ba87aa8e5a87f7f74695cc19d917  gcc/testsuite/ada/acats-2/tests/c9/c954019.a
! 718a1dda410ad24ef00a024b2e415626  gcc/testsuite/ada/acats-2/tests/c9/c954020.a
! 8f5a7fd94fd12664cdd2a1cedfcad90c  gcc/testsuite/ada/acats-2/tests/c9/c954021.a
! 34dbbc567c8a72d4e43da4684357c65d  gcc/testsuite/ada/acats-2/tests/c9/c954022.a
! acd00fcab6e1b0d13797a97adc97adb7  gcc/testsuite/ada/acats-2/tests/c9/c954023.a
! 2b49282ca4813eb7610dffe2400f50ff  gcc/testsuite/ada/acats-2/tests/c9/c954024.a
! 2331b8760176763cf23ae6f18488082f  gcc/testsuite/ada/acats-2/tests/c9/c954025.a
! 6bd1092f468dab44c0887902809a3c13  gcc/testsuite/ada/acats-2/tests/c9/c954026.a
! 97487e5b93226e3c55df7449702ac3da  gcc/testsuite/ada/acats-2/tests/c9/c954a01.a
! d07c1374471df9299b8057f6479a45e6  gcc/testsuite/ada/acats-2/tests/c9/c954a02.a
! b1b9ce862c0b325027b8ea2d1d8cc916  gcc/testsuite/ada/acats-2/tests/c9/c954a03.a
! d02e3ef0eb5c7ba2f412817b49644270  gcc/testsuite/ada/acats-2/tests/c9/c960001.a
! da6bb14a212aa02754b6596d741c04b8  gcc/testsuite/ada/acats-2/tests/c9/c960002.a
! 4c5c6b7d7706870241781f97576eef1b  gcc/testsuite/ada/acats-2/tests/c9/c960004.a
! f703a55c27d27529f63150ba86c8e428  gcc/testsuite/ada/acats-2/tests/c9/c96001a.ada
! 3551216de1ec0430cae6be8fbba64031  gcc/testsuite/ada/acats-2/tests/c9/c96004a.ada
! 2f64957621aaee0d11d2f8171f4e6709  gcc/testsuite/ada/acats-2/tests/c9/c96005a.ada
! 7fad724f14640158cc9929364f0bb44f  gcc/testsuite/ada/acats-2/tests/c9/c96005b.tst
! 6e3aebd279f9456cefe6dc63b3b9331e  gcc/testsuite/ada/acats-2/tests/c9/c96005d.ada
! 48530b441ec07b282f87a1b285f46461  gcc/testsuite/ada/acats-2/tests/c9/c96005f.ada
! 4ea722032f17d484d0a99cb53bc930ac  gcc/testsuite/ada/acats-2/tests/c9/c96006a.ada
! 83d75c4aa3732428ebf8864a605ee0d4  gcc/testsuite/ada/acats-2/tests/c9/c96007a.ada
! 031bef964d04e0ec5db2ff1f13daa5c1  gcc/testsuite/ada/acats-2/tests/c9/c96008a.ada
! f1d6b97aec5c567380c522a41db1aba7  gcc/testsuite/ada/acats-2/tests/c9/c96008b.ada
! 9f6fd5618561fb30c4c3b3865512f084  gcc/testsuite/ada/acats-2/tests/c9/c97112a.ada
! 9a595e747efc52363c8c454c5697526c  gcc/testsuite/ada/acats-2/tests/c9/c97113a.ada
! 0a432c8f0bafafbfd3ca9e2c4c355355  gcc/testsuite/ada/acats-2/tests/c9/c97114a.ada
! f204e89327ed70fed4f01e37237ed370  gcc/testsuite/ada/acats-2/tests/c9/c97115a.ada
! ad10c842934da9fd10b075d2eda11b10  gcc/testsuite/ada/acats-2/tests/c9/c97116a.ada
! 4e1bee03164214d6b948f1c4d7727423  gcc/testsuite/ada/acats-2/tests/c9/c97117a.ada
! f316b207affd7df5674d718268b31bd7  gcc/testsuite/ada/acats-2/tests/c9/c97117b.ada
! c15c876df898d95befc462a0646f94e6  gcc/testsuite/ada/acats-2/tests/c9/c97117c.ada
! 06046e05a2477dc8986dff46f6adb19d  gcc/testsuite/ada/acats-2/tests/c9/c97118a.ada
! 713383a150292af0da0dc77e7a23ab4b  gcc/testsuite/ada/acats-2/tests/c9/c97120a.ada
! 1edcf8a00884d843f01295b66b3346ed  gcc/testsuite/ada/acats-2/tests/c9/c97120b.ada
! d6606fac2f86c01ef106a193d274ec96  gcc/testsuite/ada/acats-2/tests/c9/c97201a.ada
! 2be86a6c8f33794ef758dfb71bf75acd  gcc/testsuite/ada/acats-2/tests/c9/c97201b.ada
! 32743b2ed9403b69d98c56734934fa8f  gcc/testsuite/ada/acats-2/tests/c9/c97201c.ada
! 1feeeccbfc144d846a5fac5dc371b1ab  gcc/testsuite/ada/acats-2/tests/c9/c97201d.ada
! 4b003338cd3cfce9c7070dea4b8370a1  gcc/testsuite/ada/acats-2/tests/c9/c97201e.ada
! 383c30d1a9dc6fba56fb3b68b9d8417d  gcc/testsuite/ada/acats-2/tests/c9/c97201g.ada
! 2a874dccde240e48a4f9b0c6b5175219  gcc/testsuite/ada/acats-2/tests/c9/c97201h.ada
! a7aec17b036081fd245c141c14cea8c3  gcc/testsuite/ada/acats-2/tests/c9/c97201x.ada
! 8b04c9ca3ccf2bd719076369af023d12  gcc/testsuite/ada/acats-2/tests/c9/c97202a.ada
! 096a975a5320d43a7ba562f9f18d94e6  gcc/testsuite/ada/acats-2/tests/c9/c97203a.ada
! 4470e62031e7933d85cbc73da17fef70  gcc/testsuite/ada/acats-2/tests/c9/c97203b.ada
! 64b03c91289d25db071b852a88b5d9cb  gcc/testsuite/ada/acats-2/tests/c9/c97203c.ada
! ddc6cf33bc17eabf4869adcc1d29e3d0  gcc/testsuite/ada/acats-2/tests/c9/c97204a.ada
! d4911cea3ce93679f126d507a45d22fa  gcc/testsuite/ada/acats-2/tests/c9/c97204b.ada
! f112637a1de7d372487415fe7c563edd  gcc/testsuite/ada/acats-2/tests/c9/c97205a.ada
! 5532215767fea9cf0ff3d5a28af0ffbf  gcc/testsuite/ada/acats-2/tests/c9/c97205b.ada
! 01050a4da75368f4c45e1856db21fe08  gcc/testsuite/ada/acats-2/tests/c9/c97301a.ada
! 3bb292049b1010404ee847832e15f4fd  gcc/testsuite/ada/acats-2/tests/c9/c97301b.ada
! dc309970b8d1ee31a4ac51d708f59f23  gcc/testsuite/ada/acats-2/tests/c9/c97301c.ada
! 85087bd563a15cb83cb82906dd074b46  gcc/testsuite/ada/acats-2/tests/c9/c97301d.ada
! cf609a3a37b7091f993fde3ebec98b7b  gcc/testsuite/ada/acats-2/tests/c9/c97301e.ada
! fb0f6367a2cb242d11e68bb0833594c9  gcc/testsuite/ada/acats-2/tests/c9/c97302a.ada
! ee3941e300e101619899d4ce5e433914  gcc/testsuite/ada/acats-2/tests/c9/c97303a.ada
! 0c9b0b786acee85921087f08e05ee848  gcc/testsuite/ada/acats-2/tests/c9/c97303b.ada
! dca0cd362816588d4976d342beb2593d  gcc/testsuite/ada/acats-2/tests/c9/c97303c.ada
! cb2ab9f96734f02dcf13d24f2e73aec3  gcc/testsuite/ada/acats-2/tests/c9/c97304a.ada
! d754e67cb299985d2d7ab32f0d7831d4  gcc/testsuite/ada/acats-2/tests/c9/c97304b.ada
! 2f91d4b7e4df271c291c8528b0ac77c5  gcc/testsuite/ada/acats-2/tests/c9/c97305a.ada
! 99ee5abaa01d4f88e63554c6c77981a8  gcc/testsuite/ada/acats-2/tests/c9/c97305b.ada
! 5a1e95417e5dc56ea2eaa24f2cb98647  gcc/testsuite/ada/acats-2/tests/c9/c97305c.ada
! fa76b14386e1262d53b830ca97f97d45  gcc/testsuite/ada/acats-2/tests/c9/c97305d.ada
! 6fc73ebaa144622a8c55a755858c8214  gcc/testsuite/ada/acats-2/tests/c9/c97307a.ada
! 3159a203f1d3e85954c526f58a3919f1  gcc/testsuite/ada/acats-2/tests/c9/c974001.a
! 0314ba23ab70ea268178d5697c5a9034  gcc/testsuite/ada/acats-2/tests/c9/c974002.a
! f748892726b6f9f427e087ed38edff1e  gcc/testsuite/ada/acats-2/tests/c9/c974003.a
! 68b75700dc10aa1f753b947e8cfc83f7  gcc/testsuite/ada/acats-2/tests/c9/c974004.a
! c9f29dff7d0c7abcfdc4dd10f92cc818  gcc/testsuite/ada/acats-2/tests/c9/c974005.a
! 58bc14008a240c1458d789aea37231f5  gcc/testsuite/ada/acats-2/tests/c9/c974006.a
! 6386f90159d93f8e888fc5c7606c48ab  gcc/testsuite/ada/acats-2/tests/c9/c974007.a
! 091b77c15a7a69901928f3e08e5d560b  gcc/testsuite/ada/acats-2/tests/c9/c974008.a
! 4286211e8302b327c6fcddd998068801  gcc/testsuite/ada/acats-2/tests/c9/c974009.a
! 91418d184ffd74f3511f7c7fecf5ad4c  gcc/testsuite/ada/acats-2/tests/c9/c974010.a
! fb71769796ae10266d6396de27fcd9f3  gcc/testsuite/ada/acats-2/tests/c9/c974011.a
! 75ae944a2f56bfec34a43bcac81f0f6a  gcc/testsuite/ada/acats-2/tests/c9/c974012.a
! cf3493d33888a126779c4a1fd8c7e171  gcc/testsuite/ada/acats-2/tests/c9/c974013.a
! 0100f02b896d741021d8771778c05fe4  gcc/testsuite/ada/acats-2/tests/c9/c974014.a
! 120dd4802d990998dbefafba1d6bdf05  gcc/testsuite/ada/acats-2/tests/c9/c980001.a
! 98a89250f238d2d958192b464be9c644  gcc/testsuite/ada/acats-2/tests/c9/c980002.a
! 387e8d4bc42079cf88da235a35d5db46  gcc/testsuite/ada/acats-2/tests/c9/c980003.a
! 8c9e7662d2c57ef91bde2dbdd2ceaade  gcc/testsuite/ada/acats-2/tests/c9/c99004a.ada
! 4a6308ea54645ac0a0ff6750ddff3bee  gcc/testsuite/ada/acats-2/tests/c9/c99005a.ada
! 0ade252d597ba9f5685bfdbc39ad5126  gcc/testsuite/ada/acats-2/tests/c9/c9a003a.ada
! f6efef2daeceae0601810ea34d294ebe  gcc/testsuite/ada/acats-2/tests/c9/c9a004a.ada
! dd8112b4d2ad70bb900170e976687d24  gcc/testsuite/ada/acats-2/tests/c9/c9a007a.ada
! d7d23b9be56f63a7a3eb64ae5740a50f  gcc/testsuite/ada/acats-2/tests/c9/c9a009a.ada
! 4a79ec0aad1fb7e6af0cb13c26c8a078  gcc/testsuite/ada/acats-2/tests/c9/c9a009c.ada
! a6fedb4d1bd7420511136db146b4479f  gcc/testsuite/ada/acats-2/tests/c9/c9a009f.ada
! 92177b39404bc5c23481f443eee705e0  gcc/testsuite/ada/acats-2/tests/c9/c9a009g.ada
! 56b8d40db1bb38ab15ba53a518a8e8e3  gcc/testsuite/ada/acats-2/tests/c9/c9a009h.ada
! 378ed54deee6ae14733d353d1d034e4e  gcc/testsuite/ada/acats-2/tests/c9/c9a010a.ada
! 7e86b851f4df1a5b809ec8656042b7f1  gcc/testsuite/ada/acats-2/tests/c9/c9a011a.ada
! 15b92866c3feb68befd87bd433944eee  gcc/testsuite/ada/acats-2/tests/c9/c9a011b.ada
! 204dadfff9a19c758cd37f55b4c4da7c  gcc/testsuite/ada/acats-2/tests/ca/ca1003a.ada
! 763e67e5131cf453849af1119c81ab73  gcc/testsuite/ada/acats-2/tests/ca/ca1004a.ada
! 4dd6d7580352576ccd7263ab195d5863  gcc/testsuite/ada/acats-2/tests/ca/ca1005a.ada
! 129a313a5c15d69fc95b27e10654ea3b  gcc/testsuite/ada/acats-2/tests/ca/ca1006a.ada
! 150e449e50b6c5dbc1ef87fb7cbf4fb9  gcc/testsuite/ada/acats-2/tests/ca/ca1011a0.ada
! 590b512fe8313d2c235285182f8eda0d  gcc/testsuite/ada/acats-2/tests/ca/ca1011a1.ada
! 75907d5f95c902eae76627ab16c741b7  gcc/testsuite/ada/acats-2/tests/ca/ca1011a2.ada
! 401ad7f509f398efd9094cfb553d02ca  gcc/testsuite/ada/acats-2/tests/ca/ca1011a3.ada
! d6d2e55e299aae0f7b20781714e0f6d9  gcc/testsuite/ada/acats-2/tests/ca/ca1011a4.ada
! e840ac05d90e7ef06dac4303f5747d0c  gcc/testsuite/ada/acats-2/tests/ca/ca1011a5.ada
! 696cc4292fd590eaf3673d74b1c0c4f9  gcc/testsuite/ada/acats-2/tests/ca/ca1011a6.ada
! 19ae39e48cdc2ea32ddbde00fdb0bf17  gcc/testsuite/ada/acats-2/tests/ca/ca1012a0.ada
! c3bd20289c2b3b2422a8e051dfc8b100  gcc/testsuite/ada/acats-2/tests/ca/ca1012a1.ada
! 010a8d3290ef3a0b00bcbe784544f65f  gcc/testsuite/ada/acats-2/tests/ca/ca1012a2.ada
! 49dff1e5fe3bc3d0814772fe822732a9  gcc/testsuite/ada/acats-2/tests/ca/ca1012a3.ada
! 3660d5d1740e1e424e76277266bd8268  gcc/testsuite/ada/acats-2/tests/ca/ca1012a4.ada
! 2a073bfb3680a6d94b420c58b535dda1  gcc/testsuite/ada/acats-2/tests/ca/ca1012b0.ada
! 1d0a019e12d9aec35762beffba68a14a  gcc/testsuite/ada/acats-2/tests/ca/ca1012b2.ada
! 8fe092748b9f031c395eb8aa90296599  gcc/testsuite/ada/acats-2/tests/ca/ca1012b4.ada
! 2ee859ea2c2cb8cd94e30b6c19c152f7  gcc/testsuite/ada/acats-2/tests/ca/ca1013a0.ada
! a15e85ff9101c6b7debdc0a508f121b6  gcc/testsuite/ada/acats-2/tests/ca/ca1013a1.ada
! 03baa6347b38eb86dabe6092928f99a3  gcc/testsuite/ada/acats-2/tests/ca/ca1013a2.ada
! a81d2aa44c2ded0527dbc731919e9089  gcc/testsuite/ada/acats-2/tests/ca/ca1013a3.ada
! baa2f985db9330503fee62fb421c3429  gcc/testsuite/ada/acats-2/tests/ca/ca1013a4.ada
! 9fc93552ea16f09c4c827809b41b3281  gcc/testsuite/ada/acats-2/tests/ca/ca1013a5.ada
! eb0f6d8e24d16363c032c027a7fb22d5  gcc/testsuite/ada/acats-2/tests/ca/ca1013a6.ada
! b35c89f01ddf1fa22d017dd159aac614  gcc/testsuite/ada/acats-2/tests/ca/ca1014a0.ada
! 5077be000dc1a7e1b7b61ca260535b47  gcc/testsuite/ada/acats-2/tests/ca/ca1014a1.ada
! 0d51872b8ac47d25b56ce86661e1c370  gcc/testsuite/ada/acats-2/tests/ca/ca1014a2.ada
! 29a9a130e24e0e0ced6be54af8af32af  gcc/testsuite/ada/acats-2/tests/ca/ca1014a3.ada
! bda7cf51d24fabf05ab2eb537ba61e3b  gcc/testsuite/ada/acats-2/tests/ca/ca1020e0.ada
! e875db44aa84c70db8ae5e21b37fd9f1  gcc/testsuite/ada/acats-2/tests/ca/ca1020e1.ada
! 3f26efdf7d61547aec29a83c55db9b2c  gcc/testsuite/ada/acats-2/tests/ca/ca1020e2.ada
! d41b12fbbd6a609065e3a66751a2bcfd  gcc/testsuite/ada/acats-2/tests/ca/ca1020e3.ada
! 94d90f2a39051c6c6e6f143035815676  gcc/testsuite/ada/acats-2/tests/ca/ca1022a0.ada
! 522a519bdf3184fbe9c278d90eaa0c51  gcc/testsuite/ada/acats-2/tests/ca/ca1022a1.ada
! 457d2a59db3a3a962c68d076c3588ba2  gcc/testsuite/ada/acats-2/tests/ca/ca1022a2.ada
! bead0060014fd3fff3245a6f20e1ce5d  gcc/testsuite/ada/acats-2/tests/ca/ca1022a3.ada
! 7043e3690e3b44d0a6dcf5a6e896118c  gcc/testsuite/ada/acats-2/tests/ca/ca1022a4.ada
! a84d185297f5e0df081a4d1c5691575a  gcc/testsuite/ada/acats-2/tests/ca/ca1022a5.ada
! 3170507b82e5b87d289d4cc70305ba1c  gcc/testsuite/ada/acats-2/tests/ca/ca1022a6.ada
! 43efb4507d79b8829492325770ec57e8  gcc/testsuite/ada/acats-2/tests/ca/ca11001.a
! ac29fbda8eadae439bcd450881bc7149  gcc/testsuite/ada/acats-2/tests/ca/ca11002.a
! b9954b4449d887004c58cdfadf86900e  gcc/testsuite/ada/acats-2/tests/ca/ca11003.a
! 5858be41247b333a8e43986902fba588  gcc/testsuite/ada/acats-2/tests/ca/ca110040.a
! a977e479cabfc8bfede672c52d423864  gcc/testsuite/ada/acats-2/tests/ca/ca110041.a
! a2118dee2a16348d232ec7617376dade  gcc/testsuite/ada/acats-2/tests/ca/ca110042.am
! 4a8c0c2b4dd227cfda4c20ad9ff07ace  gcc/testsuite/ada/acats-2/tests/ca/ca110050.a
! 0583459492312df56b1924ffe5b094bd  gcc/testsuite/ada/acats-2/tests/ca/ca110051.am
! bc46a97640375fa6c02bac82bd0ea9d4  gcc/testsuite/ada/acats-2/tests/ca/ca11006.a
! 7a57ba0892ae966f0111911781c328a7  gcc/testsuite/ada/acats-2/tests/ca/ca11007.a
! 72dc8d276317eabd399e4b72e562434b  gcc/testsuite/ada/acats-2/tests/ca/ca11008.a
! 33d1886825125a9ff16aafa1d4eeb8ce  gcc/testsuite/ada/acats-2/tests/ca/ca11009.a
! 6009d53581cd1fedaaa5f8df00bec83f  gcc/testsuite/ada/acats-2/tests/ca/ca11010.a
! 41dc04e344132ae2173153f802896e15  gcc/testsuite/ada/acats-2/tests/ca/ca11011.a
! d28dd7fd562acb52e90429450077885b  gcc/testsuite/ada/acats-2/tests/ca/ca11012.a
! 3b4e1d1303122a2165d7a89e5ca75ec0  gcc/testsuite/ada/acats-2/tests/ca/ca11013.a
! e80e120c9035b007bb06c2accccbc2b3  gcc/testsuite/ada/acats-2/tests/ca/ca11014.a
! 97408d6755af6eeab48fe47d27144c12  gcc/testsuite/ada/acats-2/tests/ca/ca11015.a
! 8b415d0e8ca6c7725a02853b184967b4  gcc/testsuite/ada/acats-2/tests/ca/ca11016.a
! 5b1b2a824041eeb6d0560a6e32d48287  gcc/testsuite/ada/acats-2/tests/ca/ca11017.a
! df67588f2af1ce9fe9abd12c930a475a  gcc/testsuite/ada/acats-2/tests/ca/ca11018.a
! d51c3aaeac91d325c8cea73a18210a18  gcc/testsuite/ada/acats-2/tests/ca/ca11019.a
! 1740b30abc976744100e38e3bcf58e99  gcc/testsuite/ada/acats-2/tests/ca/ca11020.a
! 3a6518f945e25a1aeb3ad194d1563dff  gcc/testsuite/ada/acats-2/tests/ca/ca11021.a
! 5af82e195906ba434bd96462dc39c4c1  gcc/testsuite/ada/acats-2/tests/ca/ca11022.a
! dccf8acb158b9eac07884aeacd894def  gcc/testsuite/ada/acats-2/tests/ca/ca1102a0.ada
! 2ed4ef9cb779e0d0250f3094928e85b6  gcc/testsuite/ada/acats-2/tests/ca/ca1102a1.ada
! d658c78d3feceb2e1e932fd6a6b84b5b  gcc/testsuite/ada/acats-2/tests/ca/ca1102a2.ada
! 50c4e887be1e9c4b7922f1519eb6c980  gcc/testsuite/ada/acats-2/tests/ca/ca1106a.ada
! b777b7cb27b27b07d7781e4ffd98a4ac  gcc/testsuite/ada/acats-2/tests/ca/ca1108a.ada
! 2f0f9c93c1bcab591f855d52670c37f0  gcc/testsuite/ada/acats-2/tests/ca/ca1108b.ada
! d320add603a2cb7fa5b0b27eb3cf9f99  gcc/testsuite/ada/acats-2/tests/ca/ca11a01.a
! 564d10a7c04f96788c8960fbe51c939e  gcc/testsuite/ada/acats-2/tests/ca/ca11a02.a
! c5b8e3a142a8d1aaf458e85e143d2dff  gcc/testsuite/ada/acats-2/tests/ca/ca11b01.a
! 385324ae1a50700efcc3e91d33d38fa7  gcc/testsuite/ada/acats-2/tests/ca/ca11b02.a
! f3ab6e0bea1b83fcd4c3a152e700e0bc  gcc/testsuite/ada/acats-2/tests/ca/ca11c01.a
! 71af51028e9bdd5cbcd5d81ee9beb0b5  gcc/testsuite/ada/acats-2/tests/ca/ca11c02.a
! 623cecaae9f9690a91d838f3795828e4  gcc/testsuite/ada/acats-2/tests/ca/ca11c03.a
! d0d1001f9819954c3537dd82876810a2  gcc/testsuite/ada/acats-2/tests/ca/ca11d010.a
! 9f2dd49cf5ff9af1c2217e51b7065e52  gcc/testsuite/ada/acats-2/tests/ca/ca11d011.a
! df976f60528d7144894c0dec4d84bc15  gcc/testsuite/ada/acats-2/tests/ca/ca11d012.a
! 6caa9498e84d76bdc74f46ac12a1a5e2  gcc/testsuite/ada/acats-2/tests/ca/ca11d013.am
! 0e13dcf32c88dedfbae0b03875ea105d  gcc/testsuite/ada/acats-2/tests/ca/ca11d02.a
! 352a0f61cf20bb4dd3caf17335850840  gcc/testsuite/ada/acats-2/tests/ca/ca11d03.a
! 196ff89b7529ee2981f4ecc32c27a27f  gcc/testsuite/ada/acats-2/tests/ca/ca13001.a
! a30bb2c455fbe1c012213193058ea38a  gcc/testsuite/ada/acats-2/tests/ca/ca13002.a
! 259d9991bd14633e726a1465b3ce011f  gcc/testsuite/ada/acats-2/tests/ca/ca13003.a
! 4a04a3ea16a7b5f16f46083006b00231  gcc/testsuite/ada/acats-2/tests/ca/ca13a01.a
! ef93a0b4b9d9c30a5f19c2e9d20d6e84  gcc/testsuite/ada/acats-2/tests/ca/ca13a02.a
! 14642bbab92bb9a06637c81126196b6d  gcc/testsuite/ada/acats-2/tests/ca/ca140230.a
! db8f6b8a7c3fb7fc6f41665ca76898aa  gcc/testsuite/ada/acats-2/tests/ca/ca140231.a
! 2c51220694c3930837b65093969330e9  gcc/testsuite/ada/acats-2/tests/ca/ca140232.am
! 97cc025b6e8c23ed35706e0ff98d4305  gcc/testsuite/ada/acats-2/tests/ca/ca140233.a
! 6df92dded9f1b1b9927e74380e21b606  gcc/testsuite/ada/acats-2/tests/ca/ca140280.a
! 6d433407d31454677f59a9de849b9a8a  gcc/testsuite/ada/acats-2/tests/ca/ca140281.a
! c7d9485411a37bafb94c4d619229cf30  gcc/testsuite/ada/acats-2/tests/ca/ca140282.a
! 0382d20f38d7c210393543ff57720eee  gcc/testsuite/ada/acats-2/tests/ca/ca140283.am
! 3ddbeeafbf30ff3f598a354d6504380d  gcc/testsuite/ada/acats-2/tests/ca/ca15003.a
! 3a4f3b580416cb1f523e9f0ac2eae79d  gcc/testsuite/ada/acats-2/tests/ca/ca200020.a
! 0a900895683bd2063208a7e0ec0179eb  gcc/testsuite/ada/acats-2/tests/ca/ca200021.a
! 7ba1dcfca4bbc7dddaa33358007ad8be  gcc/testsuite/ada/acats-2/tests/ca/ca200022.am
! 89e55ace469231379417158d76cef966  gcc/testsuite/ada/acats-2/tests/ca/ca2001h0.ada
! 4fcb3c9a010c482fd799920396bdff35  gcc/testsuite/ada/acats-2/tests/ca/ca2001h1.ada
! 74283fc28ee649c49603986ce9271f9b  gcc/testsuite/ada/acats-2/tests/ca/ca2001h2.ada
! 38f9b878948bab9e22743f449944e3e9  gcc/testsuite/ada/acats-2/tests/ca/ca2001h3.ada
! 5b863537f3743728296719d32393b9c2  gcc/testsuite/ada/acats-2/tests/ca/ca2002a0.ada
! bfbaab505e4866cb5784b784957c9a28  gcc/testsuite/ada/acats-2/tests/ca/ca2002a1.ada
! 0915a28827cb6de231954ac4c117a867  gcc/testsuite/ada/acats-2/tests/ca/ca2002a2.ada
! be28bd99026e48f3d74a229aea62f3d3  gcc/testsuite/ada/acats-2/tests/ca/ca2003a0.ada
! bbd409da60934657820661962e6e865f  gcc/testsuite/ada/acats-2/tests/ca/ca2003a1.ada
! e9823de02e5e243ffbc96966ad66f571  gcc/testsuite/ada/acats-2/tests/ca/ca2004a0.ada
! 2a6a75cbeb635fa9b353f4456f15887a  gcc/testsuite/ada/acats-2/tests/ca/ca2004a1.ada
! 9e55a07446b2c4b6f10c94a096696c64  gcc/testsuite/ada/acats-2/tests/ca/ca2004a2.ada
! 95743db093f3de73eef851e06ace6ae5  gcc/testsuite/ada/acats-2/tests/ca/ca2004a3.ada
! 9825991acff14d1e11e40a3568bb2e77  gcc/testsuite/ada/acats-2/tests/ca/ca2004a4.ada
! 1ed6b70320b71de2337bd1e17625341d  gcc/testsuite/ada/acats-2/tests/ca/ca2007a0.ada
! 2d33ec3a837a5a5e131936b8db94f4eb  gcc/testsuite/ada/acats-2/tests/ca/ca2007a1.ada
! 40ec1534c1b7d0a29cd8b1199f0a5b64  gcc/testsuite/ada/acats-2/tests/ca/ca2007a2.ada
! 25e21e36ad48e61821b87c24ac11bca6  gcc/testsuite/ada/acats-2/tests/ca/ca2007a3.ada
! 084eafcf0c9bde63eb9b0c876f25f904  gcc/testsuite/ada/acats-2/tests/ca/ca2008a0.ada
! c367605d05bd5ae5bf81c583e66e2720  gcc/testsuite/ada/acats-2/tests/ca/ca2008a1.ada
! c06ae786d36e4922cea7b5ed9453c9f3  gcc/testsuite/ada/acats-2/tests/ca/ca2008a2.ada
! e6666b45adcad1b99635211e793ed244  gcc/testsuite/ada/acats-2/tests/ca/ca2009a.ada
! 091802695ed73e62107b4d4d28c4fa67  gcc/testsuite/ada/acats-2/tests/ca/ca2009c0.ada
! d4908bcb77941027c20a57e38b3354df  gcc/testsuite/ada/acats-2/tests/ca/ca2009c1.ada
! 8793e38b06624960b964675c87a7bb50  gcc/testsuite/ada/acats-2/tests/ca/ca2009d.ada
! ebd60829cd41edbd06d5d34b1c55ad14  gcc/testsuite/ada/acats-2/tests/ca/ca2009f0.ada
! 84847d496c3551158605ff4d635fd1d6  gcc/testsuite/ada/acats-2/tests/ca/ca2009f1.ada
! 1b68aafa35a5844624d091cb512b83a3  gcc/testsuite/ada/acats-2/tests/ca/ca2009f2.ada
! 82a3883dad29bf7e9b2b43d245e96819  gcc/testsuite/ada/acats-2/tests/ca/ca2011b.ada
! a2806b84bcf970945201d14057ba77fb  gcc/testsuite/ada/acats-2/tests/ca/ca21001.a
! 9b176edf2b085f407ab53c6e7efa0bf0  gcc/testsuite/ada/acats-2/tests/ca/ca3011a0.ada
! a4e05800840beaa80583438f2fe8754d  gcc/testsuite/ada/acats-2/tests/ca/ca3011a1.ada
! c86a5bb82c1bade39f6d9d230f8c9e8e  gcc/testsuite/ada/acats-2/tests/ca/ca3011a2.ada
! dc43067ded3ab1437027708d7812aadb  gcc/testsuite/ada/acats-2/tests/ca/ca3011a3.ada
! b4bbe2bad37830cb59bac3673786910c  gcc/testsuite/ada/acats-2/tests/ca/ca3011a4.ada
! c29e663763861d160ff3432b1e522015  gcc/testsuite/ada/acats-2/tests/ca/ca5003a0.ada
! e5dcfd787f24d6dfedf73b0e116e1352  gcc/testsuite/ada/acats-2/tests/ca/ca5003a1.ada
! 248734cc36c6828c5b5d0a7c1293df27  gcc/testsuite/ada/acats-2/tests/ca/ca5003a2.ada
! 5497b59108e98e726b8af5fae575c343  gcc/testsuite/ada/acats-2/tests/ca/ca5003a3.ada
! 3ca92f928c3fab5699f3ed1cbb10cca7  gcc/testsuite/ada/acats-2/tests/ca/ca5003a4.ada
! 15800c833dc097d881eb01771f2ddb56  gcc/testsuite/ada/acats-2/tests/ca/ca5003a5.ada
! 42a60fa8194ce3db5c65b6814ea59f15  gcc/testsuite/ada/acats-2/tests/ca/ca5003a6.ada
! 0402a0137d3537a7d4ae11fe9268e188  gcc/testsuite/ada/acats-2/tests/ca/ca5003b0.ada
! 56d17409bae5c4f8247c69372dada6a7  gcc/testsuite/ada/acats-2/tests/ca/ca5003b1.ada
! 2ef9cab842c822e5b35867c53e777c18  gcc/testsuite/ada/acats-2/tests/ca/ca5003b2.ada
! 82b234cda282c69bd1cd3343d6564886  gcc/testsuite/ada/acats-2/tests/ca/ca5003b3.ada
! 0e13bff44fe10fc5bb9178c91aa8f41b  gcc/testsuite/ada/acats-2/tests/ca/ca5003b4.ada
! 05dbe877925c828ecc6371bacbfdfa20  gcc/testsuite/ada/acats-2/tests/ca/ca5003b5.ada
! 86085a25df2bcf17731e5abce3a41858  gcc/testsuite/ada/acats-2/tests/ca/ca5004a.ada
! 4663b5feb03415ae2fecb74dc9a6d918  gcc/testsuite/ada/acats-2/tests/ca/ca5004b0.ada
! dac927119e0c75edf0e171d438d99a0b  gcc/testsuite/ada/acats-2/tests/ca/ca5004b1.ada
! fb2c0908bc96e07939ff5f370be3d576  gcc/testsuite/ada/acats-2/tests/ca/ca5004b2.ada
! de4ee9e1d0577cbafe35f74312690093  gcc/testsuite/ada/acats-2/tests/ca/ca5006a.ada
! 953459f6c3ce7331d1cf5e82d075046f  gcc/testsuite/ada/acats-2/tests/cb/cb10002.a
! a2d96f308f3e7c5c03f4f9d216128c1c  gcc/testsuite/ada/acats-2/tests/cb/cb1001a.ada
! c9d819541b343e576525a8dc64f50bcc  gcc/testsuite/ada/acats-2/tests/cb/cb1004a.ada
! cd057227d4389433804bcb77c3065624  gcc/testsuite/ada/acats-2/tests/cb/cb1005a.ada
! 5335053bd77df186552ab553aed53d59  gcc/testsuite/ada/acats-2/tests/cb/cb1010a.ada
! 6be3f5adbcfcbc452379f748a85caa57  gcc/testsuite/ada/acats-2/tests/cb/cb1010c.ada
! 0a7ba5489277a0fcbe1b644ea3d981a3  gcc/testsuite/ada/acats-2/tests/cb/cb1010d.ada
! 6cae622e32e9824d353863435f37029e  gcc/testsuite/ada/acats-2/tests/cb/cb20001.a
! f70c8a2a06450a84e9c16c2c896968c2  gcc/testsuite/ada/acats-2/tests/cb/cb20003.a
! fe4620ca44567358367bbd3cbf625a78  gcc/testsuite/ada/acats-2/tests/cb/cb20004.a
! 35b97a6a98aab2205d9fafa16376dd73  gcc/testsuite/ada/acats-2/tests/cb/cb20005.a
! 2eb8439ac2fe1164f75cef3955ed5f7e  gcc/testsuite/ada/acats-2/tests/cb/cb20006.a
! 14f424c9945ffa51a8ed9b5158035a61  gcc/testsuite/ada/acats-2/tests/cb/cb20007.a
! 81b37c096b48361109ecfd3c0a735d6f  gcc/testsuite/ada/acats-2/tests/cb/cb2004a.ada
! c9e534ca3b39a7e52f750d7ada5b1f05  gcc/testsuite/ada/acats-2/tests/cb/cb2005a.ada
! 5f629a419d744cf6cbdf01ae526e8dfe  gcc/testsuite/ada/acats-2/tests/cb/cb2006a.ada
! 0f62783e4e017c666e439d08382f4081  gcc/testsuite/ada/acats-2/tests/cb/cb2007a.ada
! 0af3543016fdd2ab314c8e3f6944bc98  gcc/testsuite/ada/acats-2/tests/cb/cb20a02.a
! da80eb868ceb5337039000257fc5cf28  gcc/testsuite/ada/acats-2/tests/cb/cb3003a.ada
! 3dcceb335b81c6314b73ec2a12e496dd  gcc/testsuite/ada/acats-2/tests/cb/cb3003b.ada
! db5771a4c4d22f1ee3b2043ea42e688e  gcc/testsuite/ada/acats-2/tests/cb/cb3004a.ada
! 931665965eb67df7de9092d1150d78dc  gcc/testsuite/ada/acats-2/tests/cb/cb40005.a
! 15fd6a782afdd2e76a85a1ef09b95d91  gcc/testsuite/ada/acats-2/tests/cb/cb4001a.ada
! f00ebf73158afdcf6ccfa56162d1a7c7  gcc/testsuite/ada/acats-2/tests/cb/cb4002a.ada
! 9e17c1d3be3c2acc4c4a761cf058d3c6  gcc/testsuite/ada/acats-2/tests/cb/cb4003a.ada
! 3461f679629a4811d1fce600d7e8b57e  gcc/testsuite/ada/acats-2/tests/cb/cb4004a.ada
! f2db155f6c22f6b30ca696f825ef8aae  gcc/testsuite/ada/acats-2/tests/cb/cb4005a.ada
! b611f921d0e5b0b027e6f69faa9d24b4  gcc/testsuite/ada/acats-2/tests/cb/cb4006a.ada
! baded9fec75a97cb63419083a60cbf79  gcc/testsuite/ada/acats-2/tests/cb/cb4007a.ada
! a4194c712a3e86aa41f29aec96a8f7a7  gcc/testsuite/ada/acats-2/tests/cb/cb4008a.ada
! 930c41db090c6c2c54a36228405c48ac  gcc/testsuite/ada/acats-2/tests/cb/cb4009a.ada
! 72f5c28e26994805b38b887c725d411c  gcc/testsuite/ada/acats-2/tests/cb/cb4013a.ada
! 7cebdcd4f0159fb009f28f53b4f1d2aa  gcc/testsuite/ada/acats-2/tests/cb/cb40a01.a
! c5d94b1d4e0e31956d3f563cd7632df6  gcc/testsuite/ada/acats-2/tests/cb/cb40a020.a
! 1826a245b36f70926f1d010c4bb03b56  gcc/testsuite/ada/acats-2/tests/cb/cb40a021.am
! dd4b04d0ff15d88ce5e37562087104b8  gcc/testsuite/ada/acats-2/tests/cb/cb40a030.a
! ce7a78707740e7c8442c44280bd4b429  gcc/testsuite/ada/acats-2/tests/cb/cb40a031.am
! 27770d52ee37e90d5cd9748807eab53e  gcc/testsuite/ada/acats-2/tests/cb/cb40a04.a
! fee21ac92aa6b69bea4a12f412715df6  gcc/testsuite/ada/acats-2/tests/cb/cb41001.a
! 3bbe3f0aeccac5d0203ed045c2ccf49e  gcc/testsuite/ada/acats-2/tests/cb/cb41002.a
! d456462b7a7e6f3773b86bf24468d231  gcc/testsuite/ada/acats-2/tests/cb/cb41003.a
! fffb38bf5df913140c6261714aa601ea  gcc/testsuite/ada/acats-2/tests/cb/cb41004.a
! 01e2daee09a3391b981c7a63ebe0ae28  gcc/testsuite/ada/acats-2/tests/cb/cb5001a.ada
! 5a22bfb3766d46433b2b7b2f046d0ea9  gcc/testsuite/ada/acats-2/tests/cb/cb5001b.ada
! 63153559a0add5135a21197c6c8c0a9f  gcc/testsuite/ada/acats-2/tests/cb/cb5002a.ada
! 52c10586939e5289ffc5276a6a4d9e3e  gcc/testsuite/ada/acats-2/tests/cc/cc1004a.ada
! abeb72a1acbce60114f56d558d1481a5  gcc/testsuite/ada/acats-2/tests/cc/cc1005b.ada
! e52fa7b734609c2fde5f5260ff000f57  gcc/testsuite/ada/acats-2/tests/cc/cc1010a.ada
! 4af2da441a155dbd4ee2be7e5afcdb99  gcc/testsuite/ada/acats-2/tests/cc/cc1010b.ada
! 3943b41b051f4e223a5fe3b067dd4750  gcc/testsuite/ada/acats-2/tests/cc/cc1018a.ada
! 8b9f3eb4b897035fcc0c08981fa94cd0  gcc/testsuite/ada/acats-2/tests/cc/cc1104c.ada
! 6dde1021fb59bfd89f7e89e10c4dc040  gcc/testsuite/ada/acats-2/tests/cc/cc1107b.ada
! fd9ff835b201890341a69a2bf568186d  gcc/testsuite/ada/acats-2/tests/cc/cc1111a.ada
! 3a2e06563ce5c65cb9f2734c9b5901b2  gcc/testsuite/ada/acats-2/tests/cc/cc1204a.ada
! ec00ecaace8abe97b14deef79a927278  gcc/testsuite/ada/acats-2/tests/cc/cc1207b.ada
! d5b96d46768e2afc1db48bccdd883c3d  gcc/testsuite/ada/acats-2/tests/cc/cc1220a.ada
! fe4da7912a4f8ebd90feecf1233d1cdd  gcc/testsuite/ada/acats-2/tests/cc/cc1221a.ada
! 25b2b3dc12b77cbf205ab8f38dcfb77d  gcc/testsuite/ada/acats-2/tests/cc/cc1221b.ada
! 9145c4850d40180754446ef574cb5fc0  gcc/testsuite/ada/acats-2/tests/cc/cc1221c.ada
! c4c966046fba1bd9875ab2ac270f27d0  gcc/testsuite/ada/acats-2/tests/cc/cc1221d.ada
! ec00a589846feb2b9117000ba453bb4d  gcc/testsuite/ada/acats-2/tests/cc/cc1222a.ada
! 9098cb80c67049808425c47b419fac81  gcc/testsuite/ada/acats-2/tests/cc/cc1223a.ada
! ebb1accb64bb0bc75b36cc4d7667f11e  gcc/testsuite/ada/acats-2/tests/cc/cc1224a.ada
! 252dcf9d499b779ceb6ff22b740614f3  gcc/testsuite/ada/acats-2/tests/cc/cc1225a.tst
! bd7909fda37c73e6a7b55033af7a7073  gcc/testsuite/ada/acats-2/tests/cc/cc1226b.ada
! 6c7f653283771ea8e72f38f30cca417e  gcc/testsuite/ada/acats-2/tests/cc/cc1227a.ada
! a59ea76111c1c30abdfc81e140c2ad1e  gcc/testsuite/ada/acats-2/tests/cc/cc1301a.ada
! 54718ced426c8406bfe76f085e364b70  gcc/testsuite/ada/acats-2/tests/cc/cc1302a.ada
! 0e4bf36981636de5140e59f431e9a750  gcc/testsuite/ada/acats-2/tests/cc/cc1304a.ada
! 8b8017d0f141d2d1f196915bb0d9086f  gcc/testsuite/ada/acats-2/tests/cc/cc1304b.ada
! 5c30254607e6be149633cccc49ed0eed  gcc/testsuite/ada/acats-2/tests/cc/cc1307a.ada
! 074dfbafa7a711ae864c0c7a3551c2c1  gcc/testsuite/ada/acats-2/tests/cc/cc1307b.ada
! 99a71a5de9c88311f519834c73dd819d  gcc/testsuite/ada/acats-2/tests/cc/cc1308a.ada
! f7d1a2abebaff0b7213722ac29bc699a  gcc/testsuite/ada/acats-2/tests/cc/cc1310a.ada
! 02f17d4f3889eba61e039a52d84ad466  gcc/testsuite/ada/acats-2/tests/cc/cc1311a.ada
! ab2512302d5429785277d9bb46d6c87b  gcc/testsuite/ada/acats-2/tests/cc/cc1311b.ada
! 1653180dc4be9e4015e8cad4546ded2c  gcc/testsuite/ada/acats-2/tests/cc/cc2002a.ada
! 5368d883d7adafccb7c415ab1a83c7f2  gcc/testsuite/ada/acats-2/tests/cc/cc30001.a
! 9240ec87a1cc555c3c6e829f22480b0f  gcc/testsuite/ada/acats-2/tests/cc/cc30002.a
! 258d4b8f83d4c17eda45265db8a66c46  gcc/testsuite/ada/acats-2/tests/cc/cc3004a.ada
! 1422918611096dedc710ededab9fc1d3  gcc/testsuite/ada/acats-2/tests/cc/cc3007a.ada
! faee4cb0106ee6d683bf7e7a208050dc  gcc/testsuite/ada/acats-2/tests/cc/cc3007b.ada
! 43f939c986863c3151fb21fae7ad81a8  gcc/testsuite/ada/acats-2/tests/cc/cc3011a.ada
! e21f329f8aeeeaaf980ab3ae301de7cb  gcc/testsuite/ada/acats-2/tests/cc/cc3011d.ada
! 021bd9a65cf3be3535547519f5ceb651  gcc/testsuite/ada/acats-2/tests/cc/cc3012a.ada
! eb08409ceff83c49baa04e734c258681  gcc/testsuite/ada/acats-2/tests/cc/cc3015a.ada
! 37ffe8fd743867700b2e0249fd73f16b  gcc/testsuite/ada/acats-2/tests/cc/cc3016b.ada
! 92e8dfd4f50c7e3595bbd6ef5ebb4302  gcc/testsuite/ada/acats-2/tests/cc/cc3016c.ada
! 3bb5847d2c36a04a53a9dc138c40e34a  gcc/testsuite/ada/acats-2/tests/cc/cc3016f.ada
! 195ab10c1ca9bbfd5b16ade12e3259e2  gcc/testsuite/ada/acats-2/tests/cc/cc3016i.ada
! a5976b043f8ea78109e2936d58a009a8  gcc/testsuite/ada/acats-2/tests/cc/cc3017b.ada
! 21e94c5f1086f6624d5237d010ecc0f2  gcc/testsuite/ada/acats-2/tests/cc/cc3017c.ada
! 2fb78d8d58d12070086164535de0efda  gcc/testsuite/ada/acats-2/tests/cc/cc3019a.ada
! a0315fd5149893475278feb9b8d7013b  gcc/testsuite/ada/acats-2/tests/cc/cc3019b0.ada
! 207f4488242efc2b7a5c80c0cd47410b  gcc/testsuite/ada/acats-2/tests/cc/cc3019b1.ada
! 5688bc525157eef2f521d23f1a720672  gcc/testsuite/ada/acats-2/tests/cc/cc3019b2.ada
! e5522bd1515d2f7df4fdd2bafaf481fb  gcc/testsuite/ada/acats-2/tests/cc/cc3019c0.ada
! 66683952c6c322d9c96e76710460cc02  gcc/testsuite/ada/acats-2/tests/cc/cc3019c1.ada
! 4e308a4f2724a46a2eb3a8426f98265f  gcc/testsuite/ada/acats-2/tests/cc/cc3019c2.ada
! cd9a188b6b1ecf3863d42065ce445792  gcc/testsuite/ada/acats-2/tests/cc/cc3106b.ada
! b1b639f80dbd48bf241b7d05c36362e6  gcc/testsuite/ada/acats-2/tests/cc/cc3120a.ada
! f06e709416c9d57a31113226d02abf07  gcc/testsuite/ada/acats-2/tests/cc/cc3120b.ada
! e09fb340ff80c10cbecd4b83e746eef2  gcc/testsuite/ada/acats-2/tests/cc/cc3121a.ada
! 302527c5f7e5e7497411775d418850b0  gcc/testsuite/ada/acats-2/tests/cc/cc3123a.ada
! 2575fc22f53f2a5308182459add72a14  gcc/testsuite/ada/acats-2/tests/cc/cc3125a.ada
! 4f59d6fe9227d671293a8fecd22f9101  gcc/testsuite/ada/acats-2/tests/cc/cc3125b.ada
! a1164d012410441b7190f2e96d6ce7c6  gcc/testsuite/ada/acats-2/tests/cc/cc3125c.ada
! 8a71d919069253ce368ef3103ee770c8  gcc/testsuite/ada/acats-2/tests/cc/cc3125d.ada
! ae116bcf41f79383e2dba5094b290b3f  gcc/testsuite/ada/acats-2/tests/cc/cc3126a.ada
! de2792bcfe94fa04d80a2c8ecf74db33  gcc/testsuite/ada/acats-2/tests/cc/cc3127a.ada
! a9709bfb589a677927644fb64dffa39c  gcc/testsuite/ada/acats-2/tests/cc/cc3128a.ada
! eeae81e69cab3987783ac508ffbebc5c  gcc/testsuite/ada/acats-2/tests/cc/cc3203a.ada
! a4d077af707d747e7c7f4f145a33e013  gcc/testsuite/ada/acats-2/tests/cc/cc3207b.ada
! 4525f7929e8bbeab0d61377f11afa3b8  gcc/testsuite/ada/acats-2/tests/cc/cc3220a.ada
! e8cc62fb0584ebfbe49d22d70abf54f4  gcc/testsuite/ada/acats-2/tests/cc/cc3221a.ada
! fbf1f50c254b6c5361e7d43b8efa783c  gcc/testsuite/ada/acats-2/tests/cc/cc3222a.ada
! 06202a4a37521548f15b8f63b30331cf  gcc/testsuite/ada/acats-2/tests/cc/cc3223a.ada
! d6d9973ddd1a38d34208ece4853e3e54  gcc/testsuite/ada/acats-2/tests/cc/cc3224a.ada
! 9d8a01fd3692524cef3f688f08e8820e  gcc/testsuite/ada/acats-2/tests/cc/cc3225a.ada
! 0b4db0bdcd8b5f809a2a0976c2fd65a2  gcc/testsuite/ada/acats-2/tests/cc/cc3230a.ada
! ecf0a337f74761749dd005a8b934ae2d  gcc/testsuite/ada/acats-2/tests/cc/cc3231a.ada
! 536583cad34553553ba201c11a12e136  gcc/testsuite/ada/acats-2/tests/cc/cc3232a.ada
! 29722620be1cef89562f63d778feb319  gcc/testsuite/ada/acats-2/tests/cc/cc3233a.ada
! 55b7f83f0d13dd0bbbc615bec20f7f58  gcc/testsuite/ada/acats-2/tests/cc/cc3234a.ada
! 174e858e451ed1d671a07a674320a404  gcc/testsuite/ada/acats-2/tests/cc/cc3235a.ada
! 1966408531cce82c0dee0cdb997e2d83  gcc/testsuite/ada/acats-2/tests/cc/cc3236a.ada
! 69f2b9819e916eb5bef41d74a6bf059e  gcc/testsuite/ada/acats-2/tests/cc/cc3240a.ada
! 134c20d477e6856df2b370dc7cfda1a4  gcc/testsuite/ada/acats-2/tests/cc/cc3305a.ada
! 6ff147856008d1bc23082c84a6dce358  gcc/testsuite/ada/acats-2/tests/cc/cc3305b.ada
! 75b310968a34fc081580d58bd1747ea3  gcc/testsuite/ada/acats-2/tests/cc/cc3305c.ada
! e41c2fcae5aa76bb6cd566a6a34b9e73  gcc/testsuite/ada/acats-2/tests/cc/cc3305d.ada
! 54ae1b7ff14c3a948a87f71ab9b7ae53  gcc/testsuite/ada/acats-2/tests/cc/cc3601a.ada
! 1d5d61ff6eda390e054673a067185feb  gcc/testsuite/ada/acats-2/tests/cc/cc3601c.ada
! 14a6f6048e3bda5108a0dac8dc736e44  gcc/testsuite/ada/acats-2/tests/cc/cc3602a.ada
! 73b205844c7501b9750b69b66d91e84c  gcc/testsuite/ada/acats-2/tests/cc/cc3603a.ada
! 509cb0b6a7b3daf93118e0e4310a8889  gcc/testsuite/ada/acats-2/tests/cc/cc3605a.ada
! b81c8580788eaf032722950c55524548  gcc/testsuite/ada/acats-2/tests/cc/cc3606a.ada
! 5232a6ea1beea12bb0c271a9c0728bcc  gcc/testsuite/ada/acats-2/tests/cc/cc3606b.ada
! 2f46f9edadb7856b60273822fbd7c6dc  gcc/testsuite/ada/acats-2/tests/cc/cc3607b.ada
! 59c4b0341104cc61677baaee002ac38c  gcc/testsuite/ada/acats-2/tests/cc/cc40001.a
! 6d5d6f00038ccaafe12d5f471a488085  gcc/testsuite/ada/acats-2/tests/cc/cc50001.a
! 8cb4adfbf6723ce3680f41b59f744fe9  gcc/testsuite/ada/acats-2/tests/cc/cc50a01.a
! 508d46d79897dc7252508cdafdbbfaa1  gcc/testsuite/ada/acats-2/tests/cc/cc50a02.a
! 146e71ceb1d037e4099e8ecb6e127614  gcc/testsuite/ada/acats-2/tests/cc/cc51001.a
! 58d73c0c5456a6a21ebbaef95df38606  gcc/testsuite/ada/acats-2/tests/cc/cc51002.a
! e096e928fb49f1e659293619c383c7f1  gcc/testsuite/ada/acats-2/tests/cc/cc51003.a
! a373845361c49771cf3d23fbbfc043de  gcc/testsuite/ada/acats-2/tests/cc/cc51004.a
! f57dbf49aca26d9bd043ebddae124c8e  gcc/testsuite/ada/acats-2/tests/cc/cc51006.a
! ed5459250c5b2a65cf4b7a7c678c41b5  gcc/testsuite/ada/acats-2/tests/cc/cc51007.a
! edb35d02b7ba72e7720c2eaf7fefe5bf  gcc/testsuite/ada/acats-2/tests/cc/cc51008.a
! 91f9a7214da9eed7db005bf7e3119ddc  gcc/testsuite/ada/acats-2/tests/cc/cc51a01.a
! 123f5aa956187735f0e077abedfd8f93  gcc/testsuite/ada/acats-2/tests/cc/cc51b03.a
! 557497dc9fd80ad665e468b409621ee1  gcc/testsuite/ada/acats-2/tests/cc/cc51d01.a
! 31462b6f268d175f3a915242afd8ea4d  gcc/testsuite/ada/acats-2/tests/cc/cc51d02.a
! 8b56f900a407dc994866f74c2c67f98e  gcc/testsuite/ada/acats-2/tests/cc/cc54001.a
! 65d5b89a1c15ad3234bf150dbe3c9235  gcc/testsuite/ada/acats-2/tests/cc/cc54002.a
! 04d1ce4f2960ed9b647a0bc397f920c2  gcc/testsuite/ada/acats-2/tests/cc/cc54003.a
! 0e1a91d2dfd0e6b36d65c5cfb02883dc  gcc/testsuite/ada/acats-2/tests/cc/cc54004.a
! c29ebf7d9a6ed65bca0e83b18c63bbcc  gcc/testsuite/ada/acats-2/tests/cc/cc70001.a
! eb1b9be669a38ce3989d9340fb2dc933  gcc/testsuite/ada/acats-2/tests/cc/cc70002.a
! b1df852c3d5deec3247a4e17e9fb4dc6  gcc/testsuite/ada/acats-2/tests/cc/cc70003.a
! 9f1565b83bb2fa8ee588283eaa27cf37  gcc/testsuite/ada/acats-2/tests/cc/cc70a01.a
! 0bb1d67b6fb03b14e1b2f2062d01417d  gcc/testsuite/ada/acats-2/tests/cc/cc70a02.a
! ee68b4ea46957b2abff5e05bc98eeb76  gcc/testsuite/ada/acats-2/tests/cc/cc70b01.a
! 8c472987131321e68210b34029de25a7  gcc/testsuite/ada/acats-2/tests/cc/cc70b02.a
! 1a10fab698e0e1c3d985d63a8fd02646  gcc/testsuite/ada/acats-2/tests/cc/cc70c01.a
! 630e79ef7ad77506e6bc0443bc253106  gcc/testsuite/ada/acats-2/tests/cc/cc70c02.a
! 0be418cda7e22eca0aa6c889d87f4533  gcc/testsuite/ada/acats-2/tests/cd/cd10001.a
! 5dd315f72d7b25ba35718d9545b60e5e  gcc/testsuite/ada/acats-2/tests/cd/cd10002.a
! 4e3da95c629f1132a7605c755936df22  gcc/testsuite/ada/acats-2/tests/cd/cd1009a.ada
! 75d6166e3a9b874d8b18037b2bbd7774  gcc/testsuite/ada/acats-2/tests/cd/cd1009b.ada
! fb2d00d22c6dc289be9e7485d1057b88  gcc/testsuite/ada/acats-2/tests/cd/cd1009d.ada
! 0f7c8765f0bcfd92843011f7699a3515  gcc/testsuite/ada/acats-2/tests/cd/cd1009e.ada
! 278b82d91f416169138eaedebaee0e88  gcc/testsuite/ada/acats-2/tests/cd/cd1009f.ada
! c5d7abbf75d5228f8ee64b921461c34d  gcc/testsuite/ada/acats-2/tests/cd/cd1009g.ada
! 05621471548ccc18ff9a5e104f81afde  gcc/testsuite/ada/acats-2/tests/cd/cd1009h.ada
! 529178df08dc16ac0af024a1fd6bfb53  gcc/testsuite/ada/acats-2/tests/cd/cd1009i.ada
! 365257c1306da6752feb59e62ac38bdf  gcc/testsuite/ada/acats-2/tests/cd/cd1009j.ada
! 03b1bb47c24a014bd2530417d1adf9b2  gcc/testsuite/ada/acats-2/tests/cd/cd1009k.tst
! 06bdced5a41c98c87e673e382a9688bb  gcc/testsuite/ada/acats-2/tests/cd/cd1009l.ada
! f8f71aa9e49974d6cf320e70c4b0ecbf  gcc/testsuite/ada/acats-2/tests/cd/cd1009m.ada
! f29ec324e7b0ec1f2f6dd2240fc728d8  gcc/testsuite/ada/acats-2/tests/cd/cd1009n.ada
! cae30866eb5c8c2cfb27698eb8ddbde0  gcc/testsuite/ada/acats-2/tests/cd/cd1009o.ada
! d3eb7538a98ec14ae8d521733ba57af7  gcc/testsuite/ada/acats-2/tests/cd/cd1009p.ada
! b8730acac7650dbd31ddd035bc69f509  gcc/testsuite/ada/acats-2/tests/cd/cd1009q.ada
! c358e33b93c2826e889494a0f5ed0843  gcc/testsuite/ada/acats-2/tests/cd/cd1009r.ada
! bc1961d8c175f48f60b3e9f057a9c72a  gcc/testsuite/ada/acats-2/tests/cd/cd1009s.ada
! 97707e58ce3c7a72dc76f39b8a718701  gcc/testsuite/ada/acats-2/tests/cd/cd1009t.tst
! 692d5e6fe6286682bb5eaaa37bbb3deb  gcc/testsuite/ada/acats-2/tests/cd/cd1009u.tst
! 907fdf446e490f986c267dd4b8d31baf  gcc/testsuite/ada/acats-2/tests/cd/cd1009v.ada
! 53fd05330599e7a416f8be2f4b93f8db  gcc/testsuite/ada/acats-2/tests/cd/cd1009w.ada
! 6e1baf3329c3ff434b0b23406203b126  gcc/testsuite/ada/acats-2/tests/cd/cd1009x.ada
! 992350215516da7fa9fc873f9d5f405e  gcc/testsuite/ada/acats-2/tests/cd/cd1009y.ada
! fb78c3da6117cb6f992401e7c6afde33  gcc/testsuite/ada/acats-2/tests/cd/cd1009z.ada
! 5b32d31e23b1f46b777ddb79782d91bc  gcc/testsuite/ada/acats-2/tests/cd/cd1c03a.ada
! 33753d6d5cc05f96879e603e7e4239ed  gcc/testsuite/ada/acats-2/tests/cd/cd1c03b.ada
! bb197eb3c945f5f3165b484b8d052169  gcc/testsuite/ada/acats-2/tests/cd/cd1c03c.ada
! d532f2cddb2a1d42073af8bead380310  gcc/testsuite/ada/acats-2/tests/cd/cd1c03e.tst
! 31687b0c41570bd2e2caf21db4be46d3  gcc/testsuite/ada/acats-2/tests/cd/cd1c03f.ada
! e0216b320efd829ccdc65f5d5771bcbb  gcc/testsuite/ada/acats-2/tests/cd/cd1c03g.ada
! c46fc765c5f46303364ae7f735fd4155  gcc/testsuite/ada/acats-2/tests/cd/cd1c03h.ada
! e99adb592df5a1337ea0d1ba20e1ea56  gcc/testsuite/ada/acats-2/tests/cd/cd1c03i.ada
! 356e60fd22404e9284ce91535fb26d24  gcc/testsuite/ada/acats-2/tests/cd/cd1c04a.ada
! e23985efbd7775125639e267122b2530  gcc/testsuite/ada/acats-2/tests/cd/cd1c04d.ada
! 960f74b381e41f1c5aca4cb19a43ba24  gcc/testsuite/ada/acats-2/tests/cd/cd1c04e.ada
! f4445570707e4cfc05845c2942f2a691  gcc/testsuite/ada/acats-2/tests/cd/cd1c06a.tst
! 38c0ca7c9c40e40a65ebac293401406d  gcc/testsuite/ada/acats-2/tests/cd/cd20001.a
! 6840d06bfa723e58150ad53215d31eaf  gcc/testsuite/ada/acats-2/tests/cd/cd2a21a.ada
! 16f1f72fade5db004d66971714b76535  gcc/testsuite/ada/acats-2/tests/cd/cd2a21c.ada
! 9955b221c78032f3aa68113cb414afea  gcc/testsuite/ada/acats-2/tests/cd/cd2a21e.ada
! 138413c4349c431ae13135443971a255  gcc/testsuite/ada/acats-2/tests/cd/cd2a22a.ada
! 2ecbd329e980e8d80615287a05917c3c  gcc/testsuite/ada/acats-2/tests/cd/cd2a22e.ada
! fa618469f3bfe667b6991f706078ceee  gcc/testsuite/ada/acats-2/tests/cd/cd2a22i.ada
! 17cd76bca6e556da829dc167dd37416d  gcc/testsuite/ada/acats-2/tests/cd/cd2a22j.ada
! 165d140694576ed2e1610ce9cf23d710  gcc/testsuite/ada/acats-2/tests/cd/cd2a23a.ada
! ee7517fa66b44ea029fa5afd44d3dfda  gcc/testsuite/ada/acats-2/tests/cd/cd2a23e.ada
! 7406649d9c3a6c13d39de22cbbbed6c0  gcc/testsuite/ada/acats-2/tests/cd/cd2a24a.ada
! 42e0bfe93795136ebcd4a60e074e3d13  gcc/testsuite/ada/acats-2/tests/cd/cd2a24e.ada
! 3812be2a4f7026b0ea147488e4e11b79  gcc/testsuite/ada/acats-2/tests/cd/cd2a24i.ada
! b5db777461ec4b929a5d956caae5ab6c  gcc/testsuite/ada/acats-2/tests/cd/cd2a24j.ada
! 01ec2329faee0b5aa7957719bee0a023  gcc/testsuite/ada/acats-2/tests/cd/cd2a31a.ada
! 5cfa1167dd7ab84a3f1390d1ef40e5a8  gcc/testsuite/ada/acats-2/tests/cd/cd2a31c.ada
! 25cf5e2245fd319818051c6d58e33e34  gcc/testsuite/ada/acats-2/tests/cd/cd2a31e.ada
! fe2d9184c16158b464a66d55f5f012e0  gcc/testsuite/ada/acats-2/tests/cd/cd2a32a.ada
! c89035c306f20662287a41260e41c440  gcc/testsuite/ada/acats-2/tests/cd/cd2a32c.ada
! 5a16f63c007776f1d0e621124c28ba40  gcc/testsuite/ada/acats-2/tests/cd/cd2a32e.ada
! 509f33673d8a806e1fc5c994ecd367a7  gcc/testsuite/ada/acats-2/tests/cd/cd2a32g.ada
! 9f1153cc00985eff630f5a7529e785a6  gcc/testsuite/ada/acats-2/tests/cd/cd2a32i.ada
! 3b52721a12cbabf7af952961ab000124  gcc/testsuite/ada/acats-2/tests/cd/cd2a32j.ada
! b0ce5f538de9c46a7f93bb98b76a16c2  gcc/testsuite/ada/acats-2/tests/cd/cd2a51a.ada
! fc6c3486ba94594cbb01735d7665ee4c  gcc/testsuite/ada/acats-2/tests/cd/cd2a53a.ada
! e22ea0a1bf1e45a9cc8941659d5de2bc  gcc/testsuite/ada/acats-2/tests/cd/cd2a53e.ada
! 800cb5fbfa61381b047623e515b331e9  gcc/testsuite/ada/acats-2/tests/cd/cd2a83c.tst
! 890942afd45f173d9c7a48fcd9b93b9e  gcc/testsuite/ada/acats-2/tests/cd/cd2a91c.tst
! ed5c543b1f1e477626a569cf9814e843  gcc/testsuite/ada/acats-2/tests/cd/cd2b11a.ada
! 8bf8bb847340d421752506f84e4d2970  gcc/testsuite/ada/acats-2/tests/cd/cd2b11b.ada
! c32d32bcd93ad954d2d4fd55f825977f  gcc/testsuite/ada/acats-2/tests/cd/cd2b11d.ada
! 1a738e39f3f9e6241c1210e391c74d04  gcc/testsuite/ada/acats-2/tests/cd/cd2b11e.ada
! 4c72be933f221db34e2a0e081b1987cb  gcc/testsuite/ada/acats-2/tests/cd/cd2b11f.ada
! 4e115c81a0792d4375dde8dc06949e7d  gcc/testsuite/ada/acats-2/tests/cd/cd2b15c.ada
! 29657353f6d86b0ea8f7696b58cc2fe9  gcc/testsuite/ada/acats-2/tests/cd/cd2b16a.ada
! d5241430c4b7db939bd5e77692bf37b4  gcc/testsuite/ada/acats-2/tests/cd/cd2c11a.tst
! 90bc2d2d244c54d7f4a3cd052f4ec35f  gcc/testsuite/ada/acats-2/tests/cd/cd2c11d.tst
! c6ae74fd392f1fb6040ba95b1d1ae6f0  gcc/testsuite/ada/acats-2/tests/cd/cd2d11a.ada
! cdcdd3477a39a731b6a087ee53c8d310  gcc/testsuite/ada/acats-2/tests/cd/cd2d13a.ada
! 76610aaf77050e2ff007a677818d736b  gcc/testsuite/ada/acats-2/tests/cd/cd30001.a
! 074a289ffe88ab1f82a7410cb923d4e9  gcc/testsuite/ada/acats-2/tests/cd/cd30002.a
! 3c6e9682493e7e0159a203d7641e1a2e  gcc/testsuite/ada/acats-2/tests/cd/cd30003.a
! 58da39f40326823d0b3dcca45acdc03a  gcc/testsuite/ada/acats-2/tests/cd/cd30004.a
! 1c50e51c3b821e3d109ed5a501745811  gcc/testsuite/ada/acats-2/tests/cd/cd300050.am
! 56a32782666a26425c694389d3141e71  gcc/testsuite/ada/acats-2/tests/cd/cd300051.c
! 53302b5bf903a58fb95e205690813d78  gcc/testsuite/ada/acats-2/tests/cd/cd30011.a
! 03b96d80ed2b752193a510629a87cc3c  gcc/testsuite/ada/acats-2/tests/cd/cd30012.a
! a8163e0d624406b874260e4169d9e49c  gcc/testsuite/ada/acats-2/tests/cd/cd3014a.ada
! b3c46e3333ad22ce02ee156f3f0bccff  gcc/testsuite/ada/acats-2/tests/cd/cd3014c.ada
! a341da17e2d571e891434aa086ae7d3e  gcc/testsuite/ada/acats-2/tests/cd/cd3014d.ada
! 204d7f2709b5ba9cddcb718fc3d8ec18  gcc/testsuite/ada/acats-2/tests/cd/cd3014f.ada
! a86fa642d37091be0c5e5119e8c46645  gcc/testsuite/ada/acats-2/tests/cd/cd3015a.ada
! 38a79cfd7d26ff49fc8ee336963b178f  gcc/testsuite/ada/acats-2/tests/cd/cd3015c.ada
! 516902a49ddef41f79ee415e4edbb912  gcc/testsuite/ada/acats-2/tests/cd/cd3015e.ada
! 21588812fb8df6d087570f29c23c5d39  gcc/testsuite/ada/acats-2/tests/cd/cd3015f.ada
! c8a6fa2243d818236602663b274b5ba9  gcc/testsuite/ada/acats-2/tests/cd/cd3015g.ada
! c31ca49858b05c8ca516526b0e15945f  gcc/testsuite/ada/acats-2/tests/cd/cd3015h.ada
! c130ab902d51f975c0efadc0d44c9361  gcc/testsuite/ada/acats-2/tests/cd/cd3015i.ada
! 2fa00ee1e19df0bb0e4dc668c1d238fd  gcc/testsuite/ada/acats-2/tests/cd/cd3015k.ada
! 0c71d1dfc5a7d7c4d232217c2ef3e00f  gcc/testsuite/ada/acats-2/tests/cd/cd3021a.ada
! 02bab37ae5532979da2b39be8f1f447f  gcc/testsuite/ada/acats-2/tests/cd/cd33001.a
! 164945bdb98657e50508d0be9d5e1711  gcc/testsuite/ada/acats-2/tests/cd/cd33002.a
! fd95d787e27f8f80c3bccc691bf0417d  gcc/testsuite/ada/acats-2/tests/cd/cd40001.a
! a3f551b50734da9e1de425c6988b1f43  gcc/testsuite/ada/acats-2/tests/cd/cd4031a.ada
! 1363b8d9d26525600395a9118a1a4041  gcc/testsuite/ada/acats-2/tests/cd/cd4041a.tst
! 255be84f9bd123a67360189ab2d64cdf  gcc/testsuite/ada/acats-2/tests/cd/cd4051a.ada
! 37ae7a5703b3780f73cd5ae4eb39621a  gcc/testsuite/ada/acats-2/tests/cd/cd4051b.ada
! 07adf8476ba0c5e57a2bea963c120c2a  gcc/testsuite/ada/acats-2/tests/cd/cd4051c.ada
! cf5f11fa4855f5f18dba58d556b7ca63  gcc/testsuite/ada/acats-2/tests/cd/cd4051d.ada
! 20478b00e54601fd76a247d8a78c4a8f  gcc/testsuite/ada/acats-2/tests/cd/cd5003a.ada
! 4cff6e4a9ec3d2900f66bfc5693af89a  gcc/testsuite/ada/acats-2/tests/cd/cd5003b.ada
! d13512a51a4eb52527563404909e596e  gcc/testsuite/ada/acats-2/tests/cd/cd5003c.ada
! 4652d6ed2c04ade1800842b5dbfdabf9  gcc/testsuite/ada/acats-2/tests/cd/cd5003d.ada
! 005bf8518b263e4cee4d26c5db87e58b  gcc/testsuite/ada/acats-2/tests/cd/cd5003e.ada
! 8ff99eb70e788c11615ac412a1a7b4fb  gcc/testsuite/ada/acats-2/tests/cd/cd5003f.ada
! 719c829d93aa5b1f5984a681101887d3  gcc/testsuite/ada/acats-2/tests/cd/cd5003g.ada
! a7821be04ce2545857881e21292d5867  gcc/testsuite/ada/acats-2/tests/cd/cd5003h.ada
! 3491fd905bd30777ef1fbdfae6595acf  gcc/testsuite/ada/acats-2/tests/cd/cd5003i.ada
! 88b907e17fa7e933c0aa985bcbdba611  gcc/testsuite/ada/acats-2/tests/cd/cd5011a.ada
! 502c219e404c935fb79b18a5bc9edb77  gcc/testsuite/ada/acats-2/tests/cd/cd5011c.ada
! 71b7123461788aab03963e62fecc0ba3  gcc/testsuite/ada/acats-2/tests/cd/cd5011e.ada
! 8ee70bf0284e509f67c72903d25709f7  gcc/testsuite/ada/acats-2/tests/cd/cd5011g.ada
! 3b37531d4672ce7853d736e20f205d9e  gcc/testsuite/ada/acats-2/tests/cd/cd5011i.ada
! b1bd44ec7ae1e5e46e2aecd8d6f8f7b7  gcc/testsuite/ada/acats-2/tests/cd/cd5011k.ada
! b632fa011acdccee9f2b9fb3b5a030bf  gcc/testsuite/ada/acats-2/tests/cd/cd5011m.ada
! fd5e412763d1e844067af789a1ac1c48  gcc/testsuite/ada/acats-2/tests/cd/cd5011q.ada
! ee93e2b7d81f47c56f7b7ad4552b21bb  gcc/testsuite/ada/acats-2/tests/cd/cd5011s.ada
! 47d11b263404f1dd8fe59440a5052207  gcc/testsuite/ada/acats-2/tests/cd/cd5012a.ada
! 1892070e6feeb321986c5cbbcc427b4a  gcc/testsuite/ada/acats-2/tests/cd/cd5012b.ada
! ff4f485285269aca5506577d2a0b3b25  gcc/testsuite/ada/acats-2/tests/cd/cd5012e.ada
! a5f14af29759eeb2088d73d911c87c1f  gcc/testsuite/ada/acats-2/tests/cd/cd5012f.ada
! e5f28d4028e3550e275facc5a05598e5  gcc/testsuite/ada/acats-2/tests/cd/cd5012i.ada
! 16dbc766d573615ec2e4899fad17e3bf  gcc/testsuite/ada/acats-2/tests/cd/cd5012m.ada
! 6cc56f376ceaa00b529da26c6460e8d6  gcc/testsuite/ada/acats-2/tests/cd/cd5013a.ada
! c0918022f30f205dd1507581efbfdd4d  gcc/testsuite/ada/acats-2/tests/cd/cd5013c.ada
! 811d55a4a9aee790bed1e966d928fbb2  gcc/testsuite/ada/acats-2/tests/cd/cd5013e.ada
! 21ba9a45a10469204bf9be2e86069c81  gcc/testsuite/ada/acats-2/tests/cd/cd5013g.ada
! 4f445e0ed2b7e60f8eb00f85696e3a7d  gcc/testsuite/ada/acats-2/tests/cd/cd5013i.ada
! 0b15bb9a260246e000106d4512840f2a  gcc/testsuite/ada/acats-2/tests/cd/cd5013k.ada
! 1da10e9981f9def7bfc6d6c2143211ec  gcc/testsuite/ada/acats-2/tests/cd/cd5013m.ada
! 08a9e582acca940c3e759a92734c93c9  gcc/testsuite/ada/acats-2/tests/cd/cd5013o.ada
! 1968e13f319d3b0c07f4c96303157e60  gcc/testsuite/ada/acats-2/tests/cd/cd5014a.ada
! 7c607413594268a5d4b2292b7cb0413b  gcc/testsuite/ada/acats-2/tests/cd/cd5014c.ada
! 8fef3117954cc6c0a11bb3f93e364b40  gcc/testsuite/ada/acats-2/tests/cd/cd5014e.ada
! 0b813473017a44baccc884d20552e8cd  gcc/testsuite/ada/acats-2/tests/cd/cd5014g.ada
! 527b59a75ca64a8266a57d7a5088fe89  gcc/testsuite/ada/acats-2/tests/cd/cd5014i.ada
! fc74902958756d067346aa25dc320720  gcc/testsuite/ada/acats-2/tests/cd/cd5014k.ada
! b77eb1036af76cfb5202f2de49ace505  gcc/testsuite/ada/acats-2/tests/cd/cd5014m.ada
! ab247e3e629023fbd5f60ebe8227bdb5  gcc/testsuite/ada/acats-2/tests/cd/cd5014o.ada
! fc0ebe93b10ae9a9d4c3c4a5df942f54  gcc/testsuite/ada/acats-2/tests/cd/cd5014t.ada
! c00ed5123db97df563396ec85314f780  gcc/testsuite/ada/acats-2/tests/cd/cd5014v.ada
! bbf572fbf22be12dd2a668dcd54775ea  gcc/testsuite/ada/acats-2/tests/cd/cd5014x.ada
! 34d86be0b29568cce7a2a466311b3b81  gcc/testsuite/ada/acats-2/tests/cd/cd5014y.ada
! b56429de483f94a422eb6ca63ee074f9  gcc/testsuite/ada/acats-2/tests/cd/cd5014z.ada
! aa622725c36aef33e28cfe216e74dbf2  gcc/testsuite/ada/acats-2/tests/cd/cd70001.a
! 2eb61a4a6db022ec0de56d97cdb58d92  gcc/testsuite/ada/acats-2/tests/cd/cd7002a.ada
! aaa73d4164232ddfd2c5811f78c69833  gcc/testsuite/ada/acats-2/tests/cd/cd7007b.ada
! a2455776674d2ad1da3cc32ece807208  gcc/testsuite/ada/acats-2/tests/cd/cd7101d.ada
! aa55af7af75ac0b3c135078d81fb495f  gcc/testsuite/ada/acats-2/tests/cd/cd7101e.dep
! 54f3d5f0c03029d0398feadc1fba13fa  gcc/testsuite/ada/acats-2/tests/cd/cd7101f.dep
! d4c58764ec07d4b64c614f06a404a048  gcc/testsuite/ada/acats-2/tests/cd/cd7101g.tst
! b19b5291beb6e4d9ba34dc60acc52917  gcc/testsuite/ada/acats-2/tests/cd/cd7103d.ada
! bc9859e9de09dbae5b873f61d7dd6d25  gcc/testsuite/ada/acats-2/tests/cd/cd7202a.ada
! 27154e701456e154266de19089be5f95  gcc/testsuite/ada/acats-2/tests/cd/cd7204b.ada
! 866e238520f9fe6f2e1ebc1c66530b27  gcc/testsuite/ada/acats-2/tests/cd/cd7204c.ada
! 463ecdd8176f35af59f9b3791565e928  gcc/testsuite/ada/acats-2/tests/cd/cd72a01.a
! 97e1c7a2d8dcad44f97e8a054d7ddbfa  gcc/testsuite/ada/acats-2/tests/cd/cd72a02.a
! 094d528313c32d60bc8ef9966a3ba667  gcc/testsuite/ada/acats-2/tests/cd/cd7305a.ada
! 89a9ca0baa4aea5a158e931fd05972da  gcc/testsuite/ada/acats-2/tests/cd/cd90001.a
! b35e132e38a1316bb94eb5685e744e45  gcc/testsuite/ada/acats-2/tests/cd/cd92001.a
! 4acd15be94cdb921d9aaaf1c68bc86bd  gcc/testsuite/ada/acats-2/tests/cd/cda201a.ada
! 95c680f466bbb6b462cff702c8c051d8  gcc/testsuite/ada/acats-2/tests/cd/cda201b.ada
! 46aab534344a6aeab59cdc069c0a30a9  gcc/testsuite/ada/acats-2/tests/cd/cda201c.ada
! 51c51b9e46a1a5740ae0b124d61d55ca  gcc/testsuite/ada/acats-2/tests/cd/cda201e.ada
! 4d8334f61837b54deaa10e41063c39af  gcc/testsuite/ada/acats-2/tests/cd/cdb0a01.a
! d60d2f5f8d96507e1b594680a8ddbf8c  gcc/testsuite/ada/acats-2/tests/cd/cdb0a02.a
! d199627bfc774a32708e179cfe132b55  gcc/testsuite/ada/acats-2/tests/cd/cdd1001.a
! ecea7d5e451c93f7530aa28e39d75580  gcc/testsuite/ada/acats-2/tests/cd/cdd2001.a
! 09e97dda9b7ced04ce9c741ad0599d96  gcc/testsuite/ada/acats-2/tests/cd/cdd2a01.a
! 72e91e49172aabe99c78bb568616e583  gcc/testsuite/ada/acats-2/tests/cd/cdd2a02.a
! a856f625c37fa5c1f69885ec19e4bc5e  gcc/testsuite/ada/acats-2/tests/cd/cdd2a03.a
! 317e3f1dc15de17ef49001a1f08c35b3  gcc/testsuite/ada/acats-2/tests/cd/cde0001.a
! e3c9b20329b0f7e7d60dc55f195727f7  gcc/testsuite/ada/acats-2/tests/ce/ce2102a.ada
! 56be361ddf744d65d5919f5f77470cfd  gcc/testsuite/ada/acats-2/tests/ce/ce2102b.ada
! 83c95e98a0edc5913eda034e9803f9a3  gcc/testsuite/ada/acats-2/tests/ce/ce2102c.tst
! 704cb92cd741551b8c76bb24ab8f01a6  gcc/testsuite/ada/acats-2/tests/ce/ce2102d.ada
! a4c5c5ff89eb450e4c847a9cebea2a03  gcc/testsuite/ada/acats-2/tests/ce/ce2102e.ada
! 27760dba95f836989a21b8529a71855d  gcc/testsuite/ada/acats-2/tests/ce/ce2102f.ada
! fe48a7b7badffee5e6b11bab0b32391a  gcc/testsuite/ada/acats-2/tests/ce/ce2102g.ada
! d704111bdcdb479f1991a8daee40cdc6  gcc/testsuite/ada/acats-2/tests/ce/ce2102h.tst
! 660d5113b9badd86759bd83e670ede30  gcc/testsuite/ada/acats-2/tests/ce/ce2102i.ada
! 8796caaebedc2e2c57dc7e71ff241431  gcc/testsuite/ada/acats-2/tests/ce/ce2102j.ada
! ceb778fa800778a3993ddc7cd9190c8f  gcc/testsuite/ada/acats-2/tests/ce/ce2102k.ada
! 23bd39333ef2a75df64af434a8d52288  gcc/testsuite/ada/acats-2/tests/ce/ce2102l.ada
! 9a4f2b513351918f23c1e1fcc5d48aaa  gcc/testsuite/ada/acats-2/tests/ce/ce2102m.ada
! 57880455279d766e91fd84c1ad26a38f  gcc/testsuite/ada/acats-2/tests/ce/ce2102n.ada
! 1658c529498b5b4b8d79ff4a0a362715  gcc/testsuite/ada/acats-2/tests/ce/ce2102o.ada
! a942f038d4463c45d5c583b1985c7c87  gcc/testsuite/ada/acats-2/tests/ce/ce2102p.ada
! 8ce185028df0d4e8d8de27e964b87758  gcc/testsuite/ada/acats-2/tests/ce/ce2102q.ada
! 1439304477a0f927f09dcb2a2639fe66  gcc/testsuite/ada/acats-2/tests/ce/ce2102r.ada
! a5aff3dd28b5d54dcd3d2367ad10512e  gcc/testsuite/ada/acats-2/tests/ce/ce2102s.ada
! fab20fee3d01ec0d98c83ae2e0b85bda  gcc/testsuite/ada/acats-2/tests/ce/ce2102t.ada
! fb506c6fcfe4ce698ff9a830b7c56229  gcc/testsuite/ada/acats-2/tests/ce/ce2102u.ada
! 6533e0fca22d00bf5e7584ed3a4dc842  gcc/testsuite/ada/acats-2/tests/ce/ce2102v.ada
! 96597eb49b1372fa65ee2328da95ca07  gcc/testsuite/ada/acats-2/tests/ce/ce2102w.ada
! 79aea0b4cdef1b6365b9be26c87383b1  gcc/testsuite/ada/acats-2/tests/ce/ce2102x.ada
! b982e3e68e8a4f04e10e3b2780934046  gcc/testsuite/ada/acats-2/tests/ce/ce2102y.ada
! d102ee0d07b326b9d4073e60e25ee113  gcc/testsuite/ada/acats-2/tests/ce/ce2103a.tst
! ae11fc214dfce8e1c5dce5dd8dff9ad9  gcc/testsuite/ada/acats-2/tests/ce/ce2103b.tst
! 97d4cf14fe4c578c0d86448663834c20  gcc/testsuite/ada/acats-2/tests/ce/ce2103c.ada
! 99c7332bd6a90a3213eb826d7f902efa  gcc/testsuite/ada/acats-2/tests/ce/ce2103d.ada
! 60b763cadd79ca8009e41e392d9aa37b  gcc/testsuite/ada/acats-2/tests/ce/ce2104a.ada
! 4f9096bebf0622c62a3f4358655497af  gcc/testsuite/ada/acats-2/tests/ce/ce2104b.ada
! f1962e353466d1757ad6a9c641624847  gcc/testsuite/ada/acats-2/tests/ce/ce2104c.ada
! c687f392201a3d542022c53d87c728c6  gcc/testsuite/ada/acats-2/tests/ce/ce2104d.ada
! e59622b5be7a0b85f62f4f5dfd87250c  gcc/testsuite/ada/acats-2/tests/ce/ce2106a.ada
! 0390975b4b078391dba02ca3c8f31638  gcc/testsuite/ada/acats-2/tests/ce/ce2106b.ada
! 8576613b0fb7cb5404cf64939d34b3af  gcc/testsuite/ada/acats-2/tests/ce/ce2108e.ada
! 651994d660ec55d3e422ceb303d2034b  gcc/testsuite/ada/acats-2/tests/ce/ce2108f.ada
! ba5e89f5212818e3e53a4cf7d59d646c  gcc/testsuite/ada/acats-2/tests/ce/ce2108g.ada
! fb62dbd03a1355b41f3d194167f479aa  gcc/testsuite/ada/acats-2/tests/ce/ce2108h.ada
! e1df0b3934297c1162437a03a450f12a  gcc/testsuite/ada/acats-2/tests/ce/ce2109a.ada
! d91a1fcd2695ad63b53b63e0d22d3f22  gcc/testsuite/ada/acats-2/tests/ce/ce2109b.ada
! 0a95aeffa3822cc96d6f770183b34979  gcc/testsuite/ada/acats-2/tests/ce/ce2109c.ada
! 329e30bd5ac69971fa84cd76bd66b302  gcc/testsuite/ada/acats-2/tests/ce/ce2110a.ada
! b63ea51508983167185a0e378c787235  gcc/testsuite/ada/acats-2/tests/ce/ce2110c.ada
! 385c38395502c50c4f04f16ed172b5c3  gcc/testsuite/ada/acats-2/tests/ce/ce2111a.ada
! 0cab0967d4b6100c093d83a0daa2ca06  gcc/testsuite/ada/acats-2/tests/ce/ce2111b.ada
! 1def457c7ded3aa15287b30a02c2c1bf  gcc/testsuite/ada/acats-2/tests/ce/ce2111c.ada
! e039c87f3e2f30f3b378642cc3d5d3c3  gcc/testsuite/ada/acats-2/tests/ce/ce2111e.ada
! 607ff5b75e0ac677df365e3867c8b8bc  gcc/testsuite/ada/acats-2/tests/ce/ce2111f.ada
! 9b55a66cd32d536d65916a0288c480f4  gcc/testsuite/ada/acats-2/tests/ce/ce2111g.ada
! 9aac3a3d20f722d72f0a97d15db7e6ff  gcc/testsuite/ada/acats-2/tests/ce/ce2111i.ada
! 451691c716142d6af52540932182f7a8  gcc/testsuite/ada/acats-2/tests/ce/ce2201a.ada
! a9019ab5c60383a5aec6b4e12cf67546  gcc/testsuite/ada/acats-2/tests/ce/ce2201b.ada
! 29858e1a8a6dd46bb9164e8c8edbcddf  gcc/testsuite/ada/acats-2/tests/ce/ce2201c.ada
! 34d8b0e50b71bb424acf20936253736f  gcc/testsuite/ada/acats-2/tests/ce/ce2201d.dep
! b20fac24f54e723d0cc0d2b283a1a98c  gcc/testsuite/ada/acats-2/tests/ce/ce2201e.dep
! e5ef319f07f83742ea6dacb674de4c74  gcc/testsuite/ada/acats-2/tests/ce/ce2201f.ada
! 89d1575c20871ec14a7510e2c7fd7e56  gcc/testsuite/ada/acats-2/tests/ce/ce2201g.ada
! 06e274ba9cfdca457d343f7d036af0bc  gcc/testsuite/ada/acats-2/tests/ce/ce2201h.ada
! 819625912e63f1bb0690319469d91d14  gcc/testsuite/ada/acats-2/tests/ce/ce2201i.ada
! c75df2290aa04176fd8862e092446183  gcc/testsuite/ada/acats-2/tests/ce/ce2201j.ada
! 5cd3fabcbac1ce5f97eb0c3b7ff68060  gcc/testsuite/ada/acats-2/tests/ce/ce2201k.ada
! 5f85b515f14775082f0cef057e6c7cec  gcc/testsuite/ada/acats-2/tests/ce/ce2201l.ada
! dacbb7d19d52906e970100c8a0524fd4  gcc/testsuite/ada/acats-2/tests/ce/ce2201m.ada
! 45f176910989cfdcd7fdc941f37a5b71  gcc/testsuite/ada/acats-2/tests/ce/ce2201n.ada
! 376cc7edaf46154ca8f65652b5d6eca4  gcc/testsuite/ada/acats-2/tests/ce/ce2202a.ada
! 939f3ce3a39c9ca9d86e52320f27ff2c  gcc/testsuite/ada/acats-2/tests/ce/ce2203a.tst
! ba04f29f243a15d2bbe413b9e0066901  gcc/testsuite/ada/acats-2/tests/ce/ce2204a.ada
! 2fc36a0b7b4ddb630b023af7c4d90ba7  gcc/testsuite/ada/acats-2/tests/ce/ce2204b.ada
! 9ef6a168f2e294541459fe7a14263eb5  gcc/testsuite/ada/acats-2/tests/ce/ce2204c.ada
! b0274d08b84af4b62ad59e3d9ddb07df  gcc/testsuite/ada/acats-2/tests/ce/ce2204d.ada
! 34418b28be06a3924c3a2584bef259b6  gcc/testsuite/ada/acats-2/tests/ce/ce2205a.ada
! 5c92fac63d085e6a68726106d482ea42  gcc/testsuite/ada/acats-2/tests/ce/ce2206a.ada
! fcc7c7c24b495ce3ddaa0f9a580d75ee  gcc/testsuite/ada/acats-2/tests/ce/ce2208b.ada
! 97568e8cf63e0507c14b35a1a14e20c0  gcc/testsuite/ada/acats-2/tests/ce/ce2401a.ada
! dcd9e7cbbd7e97c5dd3e3add1eb9dc36  gcc/testsuite/ada/acats-2/tests/ce/ce2401b.ada
! efcdb258c81995c38e8cc3694b22f6dd  gcc/testsuite/ada/acats-2/tests/ce/ce2401c.ada
! e7f9dbd6fea160401601272d061289a3  gcc/testsuite/ada/acats-2/tests/ce/ce2401e.ada
! 1bf5badbcde77492314acef836d8ea11  gcc/testsuite/ada/acats-2/tests/ce/ce2401f.ada
! eb673da58247c955773ce3b8e1c2d4f3  gcc/testsuite/ada/acats-2/tests/ce/ce2401h.ada
! 6918301d4740c9f3a5bcdf8763ba341a  gcc/testsuite/ada/acats-2/tests/ce/ce2401i.ada
! 664a2145b5105ab8ae94b8ba8dca5cdd  gcc/testsuite/ada/acats-2/tests/ce/ce2401j.ada
! 7f54c0274e46b59b1fec8510f4fc3ad7  gcc/testsuite/ada/acats-2/tests/ce/ce2401k.ada
! a83a38fe98395d0bb886cb6143eb8170  gcc/testsuite/ada/acats-2/tests/ce/ce2401l.ada
! 2c4e89aba46a0152400d53a9aed78ba8  gcc/testsuite/ada/acats-2/tests/ce/ce2402a.ada
! 4e54cd3fcd15e2f31d844365222a85b3  gcc/testsuite/ada/acats-2/tests/ce/ce2403a.tst
! 4fce3b03a76a452b2433c54b199834ff  gcc/testsuite/ada/acats-2/tests/ce/ce2404a.ada
! ad81e45a71e09a3713483ae198eae6b0  gcc/testsuite/ada/acats-2/tests/ce/ce2404b.ada
! 397eb6a738bd1fb16bf404d4581a21e8  gcc/testsuite/ada/acats-2/tests/ce/ce2405b.ada
! 035cdd8af2147f386ba98eafee6fa53d  gcc/testsuite/ada/acats-2/tests/ce/ce2406a.ada
! bc1c3fb660e3a1a6cd3c3cd2c20c6f21  gcc/testsuite/ada/acats-2/tests/ce/ce2407a.ada
! e21a045af5825bcf7bae0f7774bf28bb  gcc/testsuite/ada/acats-2/tests/ce/ce2407b.ada
! 1ac50c952fbab2fcf2e1391bb697aac1  gcc/testsuite/ada/acats-2/tests/ce/ce2408a.ada
! fb58d51e1570b9726aa28d10034cf135  gcc/testsuite/ada/acats-2/tests/ce/ce2408b.ada
! d60b98c48fae643e51060dfd4200371e  gcc/testsuite/ada/acats-2/tests/ce/ce2409a.ada
! 5b25842de422c3e8d6301447c51d8985  gcc/testsuite/ada/acats-2/tests/ce/ce2409b.ada
! e03ae0d17d4ce186bb17ad28c1d12c8e  gcc/testsuite/ada/acats-2/tests/ce/ce2410a.ada
! a10dc12fca4ab67d0e070b8f08878918  gcc/testsuite/ada/acats-2/tests/ce/ce2410b.ada
! ef01f4584aa6fe18dfca4291aa2b9936  gcc/testsuite/ada/acats-2/tests/ce/ce2411a.ada
! cfdd50459f606dfd0272b27f902831f0  gcc/testsuite/ada/acats-2/tests/ce/ce3002b.tst
! 8c7a2401c3fd65042aaf7fbaaebb05d5  gcc/testsuite/ada/acats-2/tests/ce/ce3002c.tst
! 60cfa1b0514071feae57d422f407bbc6  gcc/testsuite/ada/acats-2/tests/ce/ce3002d.ada
! f7f30f9bace21926cfd024ab3ae7ed4a  gcc/testsuite/ada/acats-2/tests/ce/ce3002f.ada
! c4f22dddebf62a993e9a5dca37748e9a  gcc/testsuite/ada/acats-2/tests/ce/ce3102a.ada
! 019efa14311a98e7532962ec6464bb8e  gcc/testsuite/ada/acats-2/tests/ce/ce3102b.tst
! dab3a80b1760df07e4cf44cef4f9ca81  gcc/testsuite/ada/acats-2/tests/ce/ce3102d.ada
! 112884bd382c35480c4248866f3a556e  gcc/testsuite/ada/acats-2/tests/ce/ce3102e.ada
! 884f6ff3272bb27974b5c059fd940eb8  gcc/testsuite/ada/acats-2/tests/ce/ce3102f.ada
! 561a9bb3212245b35ea37ed7834ace08  gcc/testsuite/ada/acats-2/tests/ce/ce3102g.ada
! a5c10d55f5c631bb605e9f92f33b3d83  gcc/testsuite/ada/acats-2/tests/ce/ce3102h.ada
! 16f9be98787f36d98dd3a0d7c5673f99  gcc/testsuite/ada/acats-2/tests/ce/ce3102i.ada
! f2fb4988c4b17b901cb57756fa48524d  gcc/testsuite/ada/acats-2/tests/ce/ce3102j.ada
! 5885ee3beb2611070afd9595b92d024d  gcc/testsuite/ada/acats-2/tests/ce/ce3102k.ada
! af4fce15977e583c9580c84a57f46000  gcc/testsuite/ada/acats-2/tests/ce/ce3103a.ada
! 1a359b00af85a86ae636ed8ce9f54011  gcc/testsuite/ada/acats-2/tests/ce/ce3104a.ada
! 62ae4a6a702993a429980ed85d7d288b  gcc/testsuite/ada/acats-2/tests/ce/ce3104b.ada
! 3097f1866f5a1a12edc0bd1ad06fcfd7  gcc/testsuite/ada/acats-2/tests/ce/ce3104c.ada
! ffdd7cea02bf78362b21d5b47923f55a  gcc/testsuite/ada/acats-2/tests/ce/ce3106a.ada
! c089188b0086e9498b16c61338d1c72e  gcc/testsuite/ada/acats-2/tests/ce/ce3106b.ada
! 7ec91be55117ceec515d06ff18fd96f6  gcc/testsuite/ada/acats-2/tests/ce/ce3107a.tst
! 29791bc75974606a36e491a742bb3096  gcc/testsuite/ada/acats-2/tests/ce/ce3107b.ada
! eb49ffd6a23ce40400cdc2ebf0c8f371  gcc/testsuite/ada/acats-2/tests/ce/ce3108a.ada
! fd863ff6b1661c6c912d9bf6aebc3bc9  gcc/testsuite/ada/acats-2/tests/ce/ce3108b.ada
! 97e280eb5834dec4e91bbbc97553b1c7  gcc/testsuite/ada/acats-2/tests/ce/ce3110a.ada
! 5f42a55944d863fa57d6e12253d4922c  gcc/testsuite/ada/acats-2/tests/ce/ce3112c.ada
! c9d44fa9ff3ca5a2ccdda83b010c1f54  gcc/testsuite/ada/acats-2/tests/ce/ce3112d.ada
! f01486f7b41b7e9bb285f2b42444a64f  gcc/testsuite/ada/acats-2/tests/ce/ce3114a.ada
! 816907364fd976b617fbee2dc8afc858  gcc/testsuite/ada/acats-2/tests/ce/ce3115a.ada
! 55427ea93a85e61592244d314238e089  gcc/testsuite/ada/acats-2/tests/ce/ce3201a.ada
! 0a50773e8cb26d94c11adb5533460429  gcc/testsuite/ada/acats-2/tests/ce/ce3202a.ada
! 06b5bbb44e688a3c0c0ca62e655c32ab  gcc/testsuite/ada/acats-2/tests/ce/ce3206a.ada
! 98a3e7772f00a7bebd187c6c2d309f82  gcc/testsuite/ada/acats-2/tests/ce/ce3207a.ada
! f4529439e526335f9525bb157863cc63  gcc/testsuite/ada/acats-2/tests/ce/ce3301a.ada
! 0a70a8ac8ee35a84b380c07ea541b57f  gcc/testsuite/ada/acats-2/tests/ce/ce3302a.ada
! 9bac0e06cef0c10689cc849f3c509fcf  gcc/testsuite/ada/acats-2/tests/ce/ce3303a.ada
! 23c77e761edd8a91671acf3422a0ca06  gcc/testsuite/ada/acats-2/tests/ce/ce3304a.tst
! d0da64618db56f4abfac0c3b90fa0296  gcc/testsuite/ada/acats-2/tests/ce/ce3305a.ada
! 3f7e70ff0a93058dd780e3e6e4fefa3d  gcc/testsuite/ada/acats-2/tests/ce/ce3306a.ada
! 4e1329f66825e0283637c00ca6acc5b6  gcc/testsuite/ada/acats-2/tests/ce/ce3401a.ada
! df06c67b3b1ea125ef98d5346e81cc7e  gcc/testsuite/ada/acats-2/tests/ce/ce3402a.ada
! b50c12a694c3c56d3a2cf04d9ca9ccc3  gcc/testsuite/ada/acats-2/tests/ce/ce3402c.ada
! e2743c970635e3ead26ba550e6c23aab  gcc/testsuite/ada/acats-2/tests/ce/ce3402d.ada
! c0341031211c513d8c748c61167125fb  gcc/testsuite/ada/acats-2/tests/ce/ce3402e.ada
! f9deacf7d49917900f3fcee43aee5ca6  gcc/testsuite/ada/acats-2/tests/ce/ce3403a.ada
! fec31596c967bb1bab6a046e32225c6b  gcc/testsuite/ada/acats-2/tests/ce/ce3403b.ada
! 7e9202e07d3f865f2ceeb151792c452f  gcc/testsuite/ada/acats-2/tests/ce/ce3403c.ada
! 64070608c4f9c6a05d1e23408e5beb0d  gcc/testsuite/ada/acats-2/tests/ce/ce3403d.ada
! d82cac6d273d1fbe65506c1eecff04b9  gcc/testsuite/ada/acats-2/tests/ce/ce3403e.ada
! 7cdc9d7a9c43884cbedbde28d4954fe4  gcc/testsuite/ada/acats-2/tests/ce/ce3403f.ada
! dc1a67476ce793079c7af8b2d1b275ac  gcc/testsuite/ada/acats-2/tests/ce/ce3404a.ada
! 8b982e428bef61a3980b00b8079ad4f2  gcc/testsuite/ada/acats-2/tests/ce/ce3404b.ada
! 5cc2fbe64ade8df5eced5c397a38020a  gcc/testsuite/ada/acats-2/tests/ce/ce3404c.ada
! 871605306e645bb8c8952539a05637b2  gcc/testsuite/ada/acats-2/tests/ce/ce3404d.ada
! 5afe1fa2e94e304b32849dad526b0cb4  gcc/testsuite/ada/acats-2/tests/ce/ce3405a.ada
! 75e7f1f2e2d338bdbc593c460b1e055f  gcc/testsuite/ada/acats-2/tests/ce/ce3405c.ada
! d61f321bab45f725f89da9ebd98c7959  gcc/testsuite/ada/acats-2/tests/ce/ce3405d.ada
! 683881439899376dec46462b7b974e93  gcc/testsuite/ada/acats-2/tests/ce/ce3406a.ada
! 1d67a6840b438185a99382b830ffe815  gcc/testsuite/ada/acats-2/tests/ce/ce3406b.ada
! 00a1933b7205d0378d065989609d0e6f  gcc/testsuite/ada/acats-2/tests/ce/ce3406c.ada
! bc8a2b4d509e438b111cb451ba6c633d  gcc/testsuite/ada/acats-2/tests/ce/ce3406d.ada
! 0c8f9906304b5f6e2f871a2f56543e48  gcc/testsuite/ada/acats-2/tests/ce/ce3407a.ada
! d6da13ff2e3c07bb7f9617a04f387915  gcc/testsuite/ada/acats-2/tests/ce/ce3407b.ada
! bacd5248d5883ef91439cbdd245cbd9a  gcc/testsuite/ada/acats-2/tests/ce/ce3407c.ada
! babb7fd82795ea56950eb78715c895aa  gcc/testsuite/ada/acats-2/tests/ce/ce3408a.ada
! e30520b348614e4a8e628b3ea3aad54e  gcc/testsuite/ada/acats-2/tests/ce/ce3408b.ada
! 5d1d893ced6dbc7d9f25ee4a5fb8e211  gcc/testsuite/ada/acats-2/tests/ce/ce3408c.ada
! ca268135b5b6d64dc8be3768b6f7edc0  gcc/testsuite/ada/acats-2/tests/ce/ce3409a.ada
! 6c79cafc53b26bfb3c462c4d01969806  gcc/testsuite/ada/acats-2/tests/ce/ce3409b.ada
! 153c9a6d9246f682a42cd95552087944  gcc/testsuite/ada/acats-2/tests/ce/ce3409c.ada
! 62ed81bdf1e56f27f4c2630b320c6b75  gcc/testsuite/ada/acats-2/tests/ce/ce3409d.ada
! 67051865f07afe2038f84683dece3683  gcc/testsuite/ada/acats-2/tests/ce/ce3409e.ada
! 36c2b6db90b30d1e89dfe642110ca9be  gcc/testsuite/ada/acats-2/tests/ce/ce3410a.ada
! 5cf308b315cd2ac4c47ecb7409ef0ba1  gcc/testsuite/ada/acats-2/tests/ce/ce3410b.ada
! bcebb594f14a81961460c696159ea641  gcc/testsuite/ada/acats-2/tests/ce/ce3410c.ada
! c28a6aea6e2fa07f6b2e23e3e14876c2  gcc/testsuite/ada/acats-2/tests/ce/ce3410d.ada
! 8c67058f9e7fc008e387aa622534b5d4  gcc/testsuite/ada/acats-2/tests/ce/ce3410e.ada
! 4c3d96fe2a475d4a97d07bbd385cd260  gcc/testsuite/ada/acats-2/tests/ce/ce3411a.ada
! 0a0deabd5d66c7e62d00da0c83ac5dfa  gcc/testsuite/ada/acats-2/tests/ce/ce3411c.ada
! a8dda42826e8174f0657de7379cb605b  gcc/testsuite/ada/acats-2/tests/ce/ce3412a.ada
! 040ce75a5a909fb3da32ae0e451bda3e  gcc/testsuite/ada/acats-2/tests/ce/ce3413a.ada
! 951c9393706295621e4a78e9a1b9e2ee  gcc/testsuite/ada/acats-2/tests/ce/ce3413b.ada
! c33c707be5a9051ad8c6962035162e25  gcc/testsuite/ada/acats-2/tests/ce/ce3413c.ada
! 6cb9f4f71827deb077bcc1180c854625  gcc/testsuite/ada/acats-2/tests/ce/ce3414a.ada
! e5e2298148250ece65cc736cf86b5a00  gcc/testsuite/ada/acats-2/tests/ce/ce3601a.ada
! 1215dc7327db7704c21d367fe12a1ab9  gcc/testsuite/ada/acats-2/tests/ce/ce3602a.ada
! 6ccbba350556793177123ad7809e0ff9  gcc/testsuite/ada/acats-2/tests/ce/ce3602b.ada
! 12843cf2e9816b955ca7962f9bfc627f  gcc/testsuite/ada/acats-2/tests/ce/ce3602c.ada
! cef84bc67c1c6c0d7583ed454834a34f  gcc/testsuite/ada/acats-2/tests/ce/ce3602d.ada
! 5e31687529c52bde6efe93242bcbf2f8  gcc/testsuite/ada/acats-2/tests/ce/ce3603a.ada
! 3dc38686e9ce99632f9e21e584055443  gcc/testsuite/ada/acats-2/tests/ce/ce3604a.ada
! 98f98beec04bb6905ddea16ed212134f  gcc/testsuite/ada/acats-2/tests/ce/ce3604b.ada
! 1c7074f06be7b99dab79f14d5dddb060  gcc/testsuite/ada/acats-2/tests/ce/ce3605a.ada
! 49a30d4306b467f2cd10d4b811cfa231  gcc/testsuite/ada/acats-2/tests/ce/ce3605b.ada
! b496a8c56eea6c0501a70a96873353f7  gcc/testsuite/ada/acats-2/tests/ce/ce3605c.ada
! 6f3fe3a52cae3aa00e90c34391f3d16d  gcc/testsuite/ada/acats-2/tests/ce/ce3605d.ada
! 86bd1f46afec2bf13df76bd0d8ce0514  gcc/testsuite/ada/acats-2/tests/ce/ce3605e.ada
! 8388e3c1abd488ed32c198647fab80fe  gcc/testsuite/ada/acats-2/tests/ce/ce3606a.ada
! b3c475457035678aad225b02f0baaf49  gcc/testsuite/ada/acats-2/tests/ce/ce3606b.ada
! c0471531dea8b138d096c3049a710d34  gcc/testsuite/ada/acats-2/tests/ce/ce3701a.ada
! 918eb1c7abfa51f1d0f0920c8c6305e7  gcc/testsuite/ada/acats-2/tests/ce/ce3704a.ada
! fd0817427cf4c02d336138b11d6153a8  gcc/testsuite/ada/acats-2/tests/ce/ce3704b.ada
! 7fe37fdc40a516882c3388c9405adb57  gcc/testsuite/ada/acats-2/tests/ce/ce3704c.ada
! 9fb3d924d4a90f6940ec5e4b11a0ce61  gcc/testsuite/ada/acats-2/tests/ce/ce3704d.ada
! b5466a70b0554788bcffce4b777d7bbd  gcc/testsuite/ada/acats-2/tests/ce/ce3704e.ada
! 2bd3e088ed3663d0f57172ec9878402c  gcc/testsuite/ada/acats-2/tests/ce/ce3704f.ada
! c1b7a44976ea643f0821318848d2a333  gcc/testsuite/ada/acats-2/tests/ce/ce3704m.ada
! fbb2cb08fa9bd676488ed39c0025017d  gcc/testsuite/ada/acats-2/tests/ce/ce3704n.ada
! ddc6d31452157a248e0315438e717892  gcc/testsuite/ada/acats-2/tests/ce/ce3704o.ada
! 0f3f07ab9439af00921be7fba20ce330  gcc/testsuite/ada/acats-2/tests/ce/ce3705a.ada
! 3be84deb5cb9f6d5be7c2cadf68a90f5  gcc/testsuite/ada/acats-2/tests/ce/ce3705b.ada
! 11a056cf164688fbe30b1b1a85208e47  gcc/testsuite/ada/acats-2/tests/ce/ce3705c.ada
! e6e83df07a3fab385c58b17a0a43ca83  gcc/testsuite/ada/acats-2/tests/ce/ce3705d.ada
! c1458b663e297c80390f9cd80c7f5864  gcc/testsuite/ada/acats-2/tests/ce/ce3705e.ada
! fab53328469c600d972529f33eecee23  gcc/testsuite/ada/acats-2/tests/ce/ce3706c.ada
! aed136cb2863502616daa378424686d6  gcc/testsuite/ada/acats-2/tests/ce/ce3706d.ada
! 6344fa066f047ece7e15a9dc9dc4bf76  gcc/testsuite/ada/acats-2/tests/ce/ce3706f.ada
! 5316d57b3ad4c2e7fdcfa4dcf7de4439  gcc/testsuite/ada/acats-2/tests/ce/ce3706g.ada
! a778f4b7a5f926d446e0a70ffc718db8  gcc/testsuite/ada/acats-2/tests/ce/ce3707a.ada
! 478e73d32be1e76a0099cd9a73da79c0  gcc/testsuite/ada/acats-2/tests/ce/ce3708a.ada
! 818f2f0d5fcc6bdd1c354cc85b1e6640  gcc/testsuite/ada/acats-2/tests/ce/ce3801a.ada
! 6dc388aa9640dfd68a016a87aedb4e9b  gcc/testsuite/ada/acats-2/tests/ce/ce3801b.ada
! e7b36818b6b1f0625c96af8481f52f0d  gcc/testsuite/ada/acats-2/tests/ce/ce3804a.ada
! c3922fdc4d7bd246e803dbcf29ec365b  gcc/testsuite/ada/acats-2/tests/ce/ce3804b.ada
! eae67ccfbe2e51d92e77fbd2aefd9279  gcc/testsuite/ada/acats-2/tests/ce/ce3804c.ada
! b6842219efec21bda3be0c99f4cc04b4  gcc/testsuite/ada/acats-2/tests/ce/ce3804d.ada
! 9eef715602b30b1986cd238ae1f5fc61  gcc/testsuite/ada/acats-2/tests/ce/ce3804e.ada
! c5996f22c17f572bd9ab7181c9c39831  gcc/testsuite/ada/acats-2/tests/ce/ce3804f.ada
! 613171f59b0c0405911c4d928abfb0b4  gcc/testsuite/ada/acats-2/tests/ce/ce3804g.ada
! d992e56c7b48881cc7480a014ee01ce9  gcc/testsuite/ada/acats-2/tests/ce/ce3804h.ada
! a78767becb4aa2f884469056ae3d7ec4  gcc/testsuite/ada/acats-2/tests/ce/ce3804i.ada
! a4e5e33e2585ba61ae7ae7ae4db12bb2  gcc/testsuite/ada/acats-2/tests/ce/ce3804j.ada
! e6928c085b0205ec7db55a9f830ccdd0  gcc/testsuite/ada/acats-2/tests/ce/ce3804m.ada
! 7193594f0a1b29b3c2845bdce32c53e7  gcc/testsuite/ada/acats-2/tests/ce/ce3804o.ada
! 4a0b48b429236f9e1c8e6f58dd3bfa28  gcc/testsuite/ada/acats-2/tests/ce/ce3804p.ada
! 9ac3d952f3c355af267e6a6d9f4a8a79  gcc/testsuite/ada/acats-2/tests/ce/ce3805a.ada
! c7fd8ecaab44034a4d7e19eaf52d3390  gcc/testsuite/ada/acats-2/tests/ce/ce3805b.ada
! 1aab796cf0e7689c6edac441d619d28e  gcc/testsuite/ada/acats-2/tests/ce/ce3806a.ada
! 2e9a765636a0e1133cc203d0def8724d  gcc/testsuite/ada/acats-2/tests/ce/ce3806b.ada
! bc5e903902196b77527b50b767c2d7da  gcc/testsuite/ada/acats-2/tests/ce/ce3806c.ada
! ee7b548143b3610a6b8d3fdd4698dc45  gcc/testsuite/ada/acats-2/tests/ce/ce3806d.ada
! 4ef742156a97e0838a7c68579a62465c  gcc/testsuite/ada/acats-2/tests/ce/ce3806e.ada
! 48eed75e47db04066ee57577ae8febdf  gcc/testsuite/ada/acats-2/tests/ce/ce3806f.ada
! fae283383fb9395ac865027e5ecb9495  gcc/testsuite/ada/acats-2/tests/ce/ce3806g.ada
! 9d6687f5803bfad7ea35a3abcdb5772c  gcc/testsuite/ada/acats-2/tests/ce/ce3806h.ada
! d3af3076cdba08b0142afed2e6fc0b7b  gcc/testsuite/ada/acats-2/tests/ce/ce3809a.ada
! 2144655343ab8e0671768264f1de7939  gcc/testsuite/ada/acats-2/tests/ce/ce3809b.ada
! 94c3af83ea38d2552587ed3285a692b6  gcc/testsuite/ada/acats-2/tests/ce/ce3810a.ada
! 2b16f8d4e554f10c2a187f8308d7c631  gcc/testsuite/ada/acats-2/tests/ce/ce3810b.ada
! d426db9733cc34265b461b792b6474ad  gcc/testsuite/ada/acats-2/tests/ce/ce3815a.ada
! 48a18490ee8614f76691210dd9487c7b  gcc/testsuite/ada/acats-2/tests/ce/ce3901a.ada
! c0b5bdc86cdd66cb3f89cb34da6bafc6  gcc/testsuite/ada/acats-2/tests/ce/ce3902b.ada
! a2d6108b8d0296883e3c658639d13b49  gcc/testsuite/ada/acats-2/tests/ce/ce3904a.ada
! 379cd7598f79bae2f05b0815465e285f  gcc/testsuite/ada/acats-2/tests/ce/ce3904b.ada
! 49a69ee3b18484263b6f081df965ab54  gcc/testsuite/ada/acats-2/tests/ce/ce3905a.ada
! c53bbe9b612250e0e99c4238d30a2004  gcc/testsuite/ada/acats-2/tests/ce/ce3905b.ada
! 72f61386b7953b00b7cff52dfbc382c2  gcc/testsuite/ada/acats-2/tests/ce/ce3905c.ada
! 2ef4e950bf19d740d3354feb5811b645  gcc/testsuite/ada/acats-2/tests/ce/ce3905l.ada
! 68ee2e176861f501ee862916a0b9b86e  gcc/testsuite/ada/acats-2/tests/ce/ce3906a.ada
! d47ad5ee4c0a4fdbf2ea42a44fe42621  gcc/testsuite/ada/acats-2/tests/ce/ce3906b.ada
! 695b6968a4b0e7d53b5b76fb4f7da0c0  gcc/testsuite/ada/acats-2/tests/ce/ce3906c.ada
! 90d21e5ea4be7a236bfb40661d560471  gcc/testsuite/ada/acats-2/tests/ce/ce3906d.ada
! 3462bab257d5dd10bcb9c56813aa1e74  gcc/testsuite/ada/acats-2/tests/ce/ce3906e.ada
! 2c106bf46db6d9c4c50c01fbe92b517f  gcc/testsuite/ada/acats-2/tests/ce/ce3906f.ada
! 7c41fbcef2ed668ee19c73f44c696bac  gcc/testsuite/ada/acats-2/tests/ce/ce3907a.ada
! ee7ec1f6b6ec4c5ef50b1d777026421a  gcc/testsuite/ada/acats-2/tests/ce/ce3908a.ada
! c4b3b8c1c9564099bdde092389cc2da4  gcc/testsuite/ada/acats-2/tests/cxa/cxa3001.a
! edb7feb6536121adfd4fd4a2f3d69a3f  gcc/testsuite/ada/acats-2/tests/cxa/cxa3002.a
! 48392592efa08a198d6e5d7a1a663683  gcc/testsuite/ada/acats-2/tests/cxa/cxa3003.a
! 7eb11ccdd82615be75ded3c2d5c126d1  gcc/testsuite/ada/acats-2/tests/cxa/cxa3004.a
! bd60e198cabb483702243c263729427b  gcc/testsuite/ada/acats-2/tests/cxa/cxa4001.a
! 448cbac61205b8887f79bf74d5666a04  gcc/testsuite/ada/acats-2/tests/cxa/cxa4002.a
! 46d3d97d6347f9b5ec34b3513bcfab40  gcc/testsuite/ada/acats-2/tests/cxa/cxa4003.a
! 76c3b922526644795e2203573ee488e2  gcc/testsuite/ada/acats-2/tests/cxa/cxa4004.a
! 4b1514a00cc831e1766e0d36c67e271f  gcc/testsuite/ada/acats-2/tests/cxa/cxa4005.a
! dcde2eda6ce0a916997883996641ea19  gcc/testsuite/ada/acats-2/tests/cxa/cxa4006.a
! f528eee5266ffb815aad7b653d5be870  gcc/testsuite/ada/acats-2/tests/cxa/cxa4007.a
! 413d98fa6eff56c6b83c031c575fd9a6  gcc/testsuite/ada/acats-2/tests/cxa/cxa4008.a
! d2a3c398ae82b68c1544dbf3384095d7  gcc/testsuite/ada/acats-2/tests/cxa/cxa4009.a
! bc90a16063bf97bfeb414d4209261109  gcc/testsuite/ada/acats-2/tests/cxa/cxa4010.a
! b3036ab386ac3ec1d7b58cd50ad31ab9  gcc/testsuite/ada/acats-2/tests/cxa/cxa4011.a
! 06c61ebbffe294301eb79bc3d5e27c54  gcc/testsuite/ada/acats-2/tests/cxa/cxa4012.a
! ce3338d13ed9dd0ef83c04e53bed831e  gcc/testsuite/ada/acats-2/tests/cxa/cxa4013.a
! 0a9e62befb3d93c2c5e8ab93a327a6c2  gcc/testsuite/ada/acats-2/tests/cxa/cxa4014.a
! aad5ca617d2e40d20e448b613199553e  gcc/testsuite/ada/acats-2/tests/cxa/cxa4015.a
! 33c5aafe5935daee003a8246d048e812  gcc/testsuite/ada/acats-2/tests/cxa/cxa4016.a
! d2ac40847abc81d20163d7c521a90575  gcc/testsuite/ada/acats-2/tests/cxa/cxa4017.a
! 81384a047e321f48d7a9ae881a426324  gcc/testsuite/ada/acats-2/tests/cxa/cxa4018.a
! 334665c1cb55150c5c9af5013690044a  gcc/testsuite/ada/acats-2/tests/cxa/cxa4019.a
! c1bd4452ee22a8a6db5adbef47a641cc  gcc/testsuite/ada/acats-2/tests/cxa/cxa4020.a
! a570e64728464b5d7b98abf94a52b945  gcc/testsuite/ada/acats-2/tests/cxa/cxa4021.a
! ee35d8c6a0354f56770dd1aaf5f4d51e  gcc/testsuite/ada/acats-2/tests/cxa/cxa4022.a
! fc34d10875377b841a1d6172f334da36  gcc/testsuite/ada/acats-2/tests/cxa/cxa4023.a
! 19ec3ce920759c4a2037b89ae3061013  gcc/testsuite/ada/acats-2/tests/cxa/cxa4024.a
! 84b1823c491f3357731a977527457acf  gcc/testsuite/ada/acats-2/tests/cxa/cxa4025.a
! 254627e35c72d32a51b7db3824a622ea  gcc/testsuite/ada/acats-2/tests/cxa/cxa4026.a
! 0c20a4e5aa53f054deaa7ca01817db03  gcc/testsuite/ada/acats-2/tests/cxa/cxa4027.a
! 59f1d44db17d4f8454b983fa7c7b830b  gcc/testsuite/ada/acats-2/tests/cxa/cxa4028.a
! a05e073a2fe4ee6230e2a03d167ffce8  gcc/testsuite/ada/acats-2/tests/cxa/cxa4029.a
! eeef22827a8f3112fb9caff03c0003d3  gcc/testsuite/ada/acats-2/tests/cxa/cxa4030.a
! bb02ecad7593f15476885383704962db  gcc/testsuite/ada/acats-2/tests/cxa/cxa4031.a
! e272d6fb88a469d5600466803e241311  gcc/testsuite/ada/acats-2/tests/cxa/cxa4032.a
! 3f7248dd7e0876538e54ffc83eb5b9f9  gcc/testsuite/ada/acats-2/tests/cxa/cxa4033.a
! 90cfac79483d313e3e60ee66dd47bbb9  gcc/testsuite/ada/acats-2/tests/cxa/cxa4034.a
! d5b5e8186c886aee7a112ba901ef5b8c  gcc/testsuite/ada/acats-2/tests/cxa/cxa5011.a
! a67372b949970924bc0a9dd48dfc4999  gcc/testsuite/ada/acats-2/tests/cxa/cxa5012.a
! 1bc3b7995dbf8b972dd33ceccc5775f8  gcc/testsuite/ada/acats-2/tests/cxa/cxa5013.a
! 7f31584ea86307c534d43e91b8d28708  gcc/testsuite/ada/acats-2/tests/cxa/cxa5015.a
! ee786104570339c108786248363e8be5  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a01.a
! 59b52d99d8ad7539d9702fd5808604ab  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a02.a
! e58abfcc53f4c016f65e49a2e76c7c18  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a03.a
! 07803a06f2f6d9efa364537c4d61d56c  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a04.a
! 8beb99d4b6c77de021e0fb13ef712afc  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a05.a
! 4facff6e7577e863bfd71cfc8d80f4dc  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a06.a
! c3a4baf4aa21b446ccc93a6c7667de6a  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a07.a
! 6278088ddb4cadb7d9e5d09b9045b4b6  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a08.a
! cd7c58666aed347e740c0f6fd42f83d6  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a09.a
! ba78679b1a563e67c0076c1562ccf0f3  gcc/testsuite/ada/acats-2/tests/cxa/cxa5a10.a
! 96b76cdb631cda2774fc81007f5ec5ee  gcc/testsuite/ada/acats-2/tests/cxa/cxa8001.a
! 367d7f0f5e6305bdd87092066759b0fa  gcc/testsuite/ada/acats-2/tests/cxa/cxa8002.a
! 620e6506d3b188143f95bf7e9e7c2a47  gcc/testsuite/ada/acats-2/tests/cxa/cxa8003.a
! 05afd117ada97a293f198e2915e5c6e6  gcc/testsuite/ada/acats-2/tests/cxa/cxa9001.a
! 720f2be5a9704866c7199912ce177ec5  gcc/testsuite/ada/acats-2/tests/cxa/cxa9002.a
! 0eda7d556ffc97096e8bf91c74b55ab0  gcc/testsuite/ada/acats-2/tests/cxa/cxaa001.a
! 77f8a73011b66fb0023f0f34e63b2b56  gcc/testsuite/ada/acats-2/tests/cxa/cxaa002.a
! 6251cdd5d4023378cc0f056006946d4b  gcc/testsuite/ada/acats-2/tests/cxa/cxaa003.a
! 43c30533c4d806156e62989d0b1f26b1  gcc/testsuite/ada/acats-2/tests/cxa/cxaa004.a
! a3c49183a05e7dd95a555b795d847cdb  gcc/testsuite/ada/acats-2/tests/cxa/cxaa005.a
! 083ebde448b287604a204632257a8037  gcc/testsuite/ada/acats-2/tests/cxa/cxaa006.a
! 0ba729490f0276e661094749d283895c  gcc/testsuite/ada/acats-2/tests/cxa/cxaa007.a
! a5ce4e509ce0ab296bcdd6ac1f1901c4  gcc/testsuite/ada/acats-2/tests/cxa/cxaa008.a
! 6230c5c5911d68e5e9b6f01dd03cb063  gcc/testsuite/ada/acats-2/tests/cxa/cxaa009.a
! ce752fa717d1efa1292cf1f5fa1d3e2e  gcc/testsuite/ada/acats-2/tests/cxa/cxaa010.a
! a1b9e04009fe651e52c78ec25d1e7e02  gcc/testsuite/ada/acats-2/tests/cxa/cxaa011.a
! 89d82c447c9f9e46ab8b9a1c63021ed6  gcc/testsuite/ada/acats-2/tests/cxa/cxaa012.a
! 1f2db7b6b53cd6eac4580863a696a7fd  gcc/testsuite/ada/acats-2/tests/cxa/cxaa013.a
! 2bf5156bd9e88fa709d6514444235132  gcc/testsuite/ada/acats-2/tests/cxa/cxaa014.a
! ed6390551c08d72768b222a3edb8cc65  gcc/testsuite/ada/acats-2/tests/cxa/cxaa015.a
! 9b3e529f8cb7b3fd77f82dd49f82a490  gcc/testsuite/ada/acats-2/tests/cxa/cxaa016.a
! 7147f809c3aae79cfac85e734afed9c2  gcc/testsuite/ada/acats-2/tests/cxa/cxaa017.a
! cc1a3cfdd0d446ad5ae2882d5b1f089b  gcc/testsuite/ada/acats-2/tests/cxa/cxaa018.a
! 5a18624d0b2a25da41748146d45600fe  gcc/testsuite/ada/acats-2/tests/cxa/cxaa019.a
! 541118f0faae1cc95a1d90526336b620  gcc/testsuite/ada/acats-2/tests/cxa/cxab001.a
! 02e50f3257e2da0b2d211b9ed3e16791  gcc/testsuite/ada/acats-2/tests/cxa/cxac001.a
! 6788fdbde2fdac4a827fd20b38d8711b  gcc/testsuite/ada/acats-2/tests/cxa/cxac002.a
! bc2d4997d303b5a8cd8ac49ea128eabc  gcc/testsuite/ada/acats-2/tests/cxa/cxac003.a
! 0fed3fbdda367e73cc20e053e436b99f  gcc/testsuite/ada/acats-2/tests/cxa/cxac004.a
! c03fcfa6083accd85e20bd1ddecb7e8e  gcc/testsuite/ada/acats-2/tests/cxa/cxac005.a
! 1ea54203b702bc16f99a16da31812413  gcc/testsuite/ada/acats-2/tests/cxa/cxaca01.a
! 177daeac77a726a44c2f67d470718c26  gcc/testsuite/ada/acats-2/tests/cxa/cxaca02.a
! 56fc9878aa06e841c10ea2264f6970c0  gcc/testsuite/ada/acats-2/tests/cxa/cxacb01.a
! 66ac8f47c4a79c2e4c270e0af7e2e0ee  gcc/testsuite/ada/acats-2/tests/cxa/cxacb02.a
! 0709cbd75999d38ff1820f0252b56573  gcc/testsuite/ada/acats-2/tests/cxa/cxacc01.a
! e9b9a0663c6181302fffd99d8631f3de  gcc/testsuite/ada/acats-2/tests/cxa/cxaf001.a
! 74275581d2adcd2434f5e7957524b51c  gcc/testsuite/ada/acats-2/tests/cxb/cxb2001.a
! 801c8a35b2162f9c6264359249bbee69  gcc/testsuite/ada/acats-2/tests/cxb/cxb2002.a
! bf39b2f4f07ed6a4665a9dda2b002ff4  gcc/testsuite/ada/acats-2/tests/cxb/cxb2003.a
! 77c85b698809dbb5fb428e06a404c9b9  gcc/testsuite/ada/acats-2/tests/cxb/cxb3001.a
! 8359205e9055b8be1d9b6762d2ed3539  gcc/testsuite/ada/acats-2/tests/cxb/cxb3002.a
! 670fd9357c7c7cfa50297d22a291bf67  gcc/testsuite/ada/acats-2/tests/cxb/cxb3003.a
! 264fa1c95ae6b3be066613d5e0bfc39d  gcc/testsuite/ada/acats-2/tests/cxb/cxb30040.c
! 834af9fa57783899a0e35eb445000495  gcc/testsuite/ada/acats-2/tests/cxb/cxb30041.am
! 1f7e6c754cd6392302f6a73881265fcb  gcc/testsuite/ada/acats-2/tests/cxb/cxb3005.a
! 47cb358f8b5c39994c472ca6162c0605  gcc/testsuite/ada/acats-2/tests/cxb/cxb30060.c
! 43769c5f0a9930881f7e0db2f6a8a256  gcc/testsuite/ada/acats-2/tests/cxb/cxb30061.am
! 593282429f5462d5ed18dcd8dcdb51d9  gcc/testsuite/ada/acats-2/tests/cxb/cxb3007.a
! f846172da7dd713a885e8d2a7d06687e  gcc/testsuite/ada/acats-2/tests/cxb/cxb3008.a
! d2f1180bb38e13d62efbd9773c8b157b  gcc/testsuite/ada/acats-2/tests/cxb/cxb3009.a
! 02b32c32297cd44b0d911f2b531c9313  gcc/testsuite/ada/acats-2/tests/cxb/cxb3010.a
! f8edfe848dc0c6e6f48662c52fb4967d  gcc/testsuite/ada/acats-2/tests/cxb/cxb3011.a
! 8a65d94bc5bfd4ba3ffa03803fd4161b  gcc/testsuite/ada/acats-2/tests/cxb/cxb3012.a
! c26417c84de8dd0b5f98086031028262  gcc/testsuite/ada/acats-2/tests/cxb/cxb30130.c
! 0fb5e5e773d77b07187a80ff9a521df6  gcc/testsuite/ada/acats-2/tests/cxb/cxb30131.c
! f10ef865b96ee70575c8e209dd789a5d  gcc/testsuite/ada/acats-2/tests/cxb/cxb30132.am
! 1ddc4dd51346e5a28f96af27d7391476  gcc/testsuite/ada/acats-2/tests/cxb/cxb3014.a
! 95d8e46749c34da8a75a52eda38a1557  gcc/testsuite/ada/acats-2/tests/cxb/cxb3015.a
! 84585e09a73118e308ad940e05334954  gcc/testsuite/ada/acats-2/tests/cxb/cxb3016.a
! cbb79c5b42e78b77403051dad62e4b41  gcc/testsuite/ada/acats-2/tests/cxb/cxb4001.a
! fc709f860964cb89f985c7186e9f4747  gcc/testsuite/ada/acats-2/tests/cxb/cxb4002.a
! 4f684915a0877f5374cf11b630a78395  gcc/testsuite/ada/acats-2/tests/cxb/cxb4003.a
! 79754fe98b14164c0947685d39cacbb4  gcc/testsuite/ada/acats-2/tests/cxb/cxb4004.a
! 85a2ebed857909a39d337814747d6b8e  gcc/testsuite/ada/acats-2/tests/cxb/cxb4005.a
! 4082371e3fdf72189f00c59a748996d4  gcc/testsuite/ada/acats-2/tests/cxb/cxb4006.a
! 27abdc5551e4a8d82b4e9b0c64e5887b  gcc/testsuite/ada/acats-2/tests/cxb/cxb4007.a
! 8cddd50c9a17f7fc8660e979cbf02b3b  gcc/testsuite/ada/acats-2/tests/cxb/cxb4008.a
! 1b69eacf17c1c91c6952280f3412de5a  gcc/testsuite/ada/acats-2/tests/cxb/cxb5001.a
! c09620903bb91a1bb4eb42d58e681d41  gcc/testsuite/ada/acats-2/tests/cxb/cxb5002.a
! d523751f359c8b2cd39c46362a810f62  gcc/testsuite/ada/acats-2/tests/cxb/cxb5003.a
! 161785b3f8117f52fdfa5e2be103fe50  gcc/testsuite/ada/acats-2/tests/cxf/cxf1001.a
! 38832640106024eeab3e787b3e1abf12  gcc/testsuite/ada/acats-2/tests/cxf/cxf2001.a
! 6dbe0dc7ad8bcf924dea296b0e6d64f8  gcc/testsuite/ada/acats-2/tests/cxf/cxf2002.a
! df30106f75773ccdd081af9128456937  gcc/testsuite/ada/acats-2/tests/cxf/cxf2003.a
! bbdc713b858e164ba488b05b51a426d4  gcc/testsuite/ada/acats-2/tests/cxf/cxf2004.a
! 2853070456ab778051ae45509ef31700  gcc/testsuite/ada/acats-2/tests/cxf/cxf2005.a
! 5289a83b801532cadb9cfc8ca574144c  gcc/testsuite/ada/acats-2/tests/cxf/cxf2a01.a
! ecb6f7270417d94e1c9636302e69e1fa  gcc/testsuite/ada/acats-2/tests/cxf/cxf2a02.a
! 2ffc00ccfb476a6822050bacce9f38f0  gcc/testsuite/ada/acats-2/tests/cxf/cxf3001.a
! 5dae288354cb87431755a88817dd365b  gcc/testsuite/ada/acats-2/tests/cxf/cxf3002.a
! afd49d16a5d04aec633505dca48b0d0a  gcc/testsuite/ada/acats-2/tests/cxf/cxf3003.a
! c6b3622a1e5b20d69719852a4082e8be  gcc/testsuite/ada/acats-2/tests/cxf/cxf3004.a
! 1aee0d4b0a06b7063d6235fc8d34096a  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a01.a
! 57064f6f477f169e4e55de947a9c929c  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a02.a
! 963266d142d788cf27f6a6c25463a3e4  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a03.a
! b0edb7a9a3f96101a217a11d890227d0  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a04.a
! fc92aa9ac0df0e5baa30ead02d831b57  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a05.a
! 64a24769c1369c7cfdee0cd6e259be8f  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a06.a
! 9713b92f0463d1404ffce0f6b1e500b0  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a07.a
! 1e8c052576f82ce44e874eaf39b880b2  gcc/testsuite/ada/acats-2/tests/cxf/cxf3a08.a
! bb528e8b6f5a51fcb2c85de76f01ccd4  gcc/testsuite/ada/acats-2/tests/cxg/cxg1001.a
! 31d84efce5cb86f288a534683e15200a  gcc/testsuite/ada/acats-2/tests/cxg/cxg1002.a
! 5db4d9e6a4cf0ee61e3e4e4ea8093c4e  gcc/testsuite/ada/acats-2/tests/cxg/cxg1003.a
! 29704ab7c7c7a79f47511599cd5ea610  gcc/testsuite/ada/acats-2/tests/cxg/cxg1004.a
! 38c19bd2b8b49892b5a8468c5b781d26  gcc/testsuite/ada/acats-2/tests/cxg/cxg1005.a
! 814368ba96fd7e4cf439f579d9e94c81  gcc/testsuite/ada/acats-2/tests/cxg/cxg2001.a
! 691b89d2d22e78fce3d8ce8190aceac5  gcc/testsuite/ada/acats-2/tests/cxg/cxg2002.a
! fd15930c996abc004ebe5f623f8d7e3e  gcc/testsuite/ada/acats-2/tests/cxg/cxg2003.a
! 9c7ebf167f5adb4ad817f1cfaad15b1e  gcc/testsuite/ada/acats-2/tests/cxg/cxg2004.a
! 19538696a45a5cd61915e552c0159e21  gcc/testsuite/ada/acats-2/tests/cxg/cxg2005.a
! b5a9cd918ec505f80bffd4b8d3f81fb7  gcc/testsuite/ada/acats-2/tests/cxg/cxg2006.a
! d118b202244475fa2d6637a5102c8793  gcc/testsuite/ada/acats-2/tests/cxg/cxg2007.a
! 911e82a1ca3377a813732860a0062312  gcc/testsuite/ada/acats-2/tests/cxg/cxg2008.a
! 4fad0b52dda14d215336cc1cd38b7f03  gcc/testsuite/ada/acats-2/tests/cxg/cxg2009.a
! a7f0790bd1f4db62bb1f94f90b403cca  gcc/testsuite/ada/acats-2/tests/cxg/cxg2010.a
! 2e25178ea5e5552c5343ba6d8584ba74  gcc/testsuite/ada/acats-2/tests/cxg/cxg2011.a
! f61b0c35864b0aa5527d3e4a3e81e779  gcc/testsuite/ada/acats-2/tests/cxg/cxg2012.a
! 1b99769a37ef9c2b58f43910fdd00e6b  gcc/testsuite/ada/acats-2/tests/cxg/cxg2013.a
! 481025f4913d9ffb0c1ff442b9870591  gcc/testsuite/ada/acats-2/tests/cxg/cxg2014.a
! 79eb7ca23122446b9f31a5f4d6f8fbc7  gcc/testsuite/ada/acats-2/tests/cxg/cxg2015.a
! d1362a6e008edbda6db26e148303f3d0  gcc/testsuite/ada/acats-2/tests/cxg/cxg2016.a
! 84a228b85aa2b3a442a702cb5cf99e63  gcc/testsuite/ada/acats-2/tests/cxg/cxg2017.a
! db5d4af0d0f84dcaf031081f41020e4a  gcc/testsuite/ada/acats-2/tests/cxg/cxg2018.a
! 6ca3da628f7936107fe1fd235da62e61  gcc/testsuite/ada/acats-2/tests/cxg/cxg2019.a
! d8efe67bfdf82292c98f593e60cace57  gcc/testsuite/ada/acats-2/tests/cxg/cxg2020.a
! 53b94c96558a199ee91e9e94e92f6e6e  gcc/testsuite/ada/acats-2/tests/cxg/cxg2021.a
! 44df5fa53bb68ac9be22c5db9adb9c5e  gcc/testsuite/ada/acats-2/tests/cxg/cxg2022.a
! 86432328beb230d12c30455a5259108f  gcc/testsuite/ada/acats-2/tests/cxg/cxg2023.a
! 7b9353c95978924cfa8ffca95bd2472f  gcc/testsuite/ada/acats-2/tests/cxg/cxg2024.a
! 4aedd99c5e7383826785e110132437b0  gcc/testsuite/ada/acats-2/tests/cxh/cxh3001.a
! 30e3860e9003591085363de238d2c0f8  gcc/testsuite/ada/acats-2/tests/cxh/cxh3002.a
! 2f97ad7e05c98ee16642183b60fb702b  gcc/testsuite/ada/acats-2/tests/cxh/cxh30030.a
! 726c3a5559867c336b3e41053357bee8  gcc/testsuite/ada/acats-2/tests/cxh/cxh30031.am
! 5812c7613bb171e922984de8ed304306  gcc/testsuite/ada/acats-2/tests/cz/cz1101a.ada
! f4be18c06fbff775151b0c6fe4f18831  gcc/testsuite/ada/acats-2/tests/cz/cz1102a.ada
! 1a17d44787330941af6e6eb9b2f5fdac  gcc/testsuite/ada/acats-2/tests/cz/cz1103a.ada
! 4fbac816abd03239d980e03cee911122  gcc/testsuite/ada/acats-2/tests/d/d4a002a.ada
! 9fc88c362bc5e3ac1038838ce2e31e1d  gcc/testsuite/ada/acats-2/tests/d/d4a002b.ada
! 512d36027df5b67cad136178dabfe4a2  gcc/testsuite/ada/acats-2/tests/d/d4a004a.ada
! 22af18afdcf3a383d8100e7290a1c40c  gcc/testsuite/ada/acats-2/tests/d/d4a004b.ada
! 605dc6f15a51dd750ab6fdf7ddcb65a6  gcc/testsuite/ada/acats-2/tests/e/e28002b.ada
! de9f0ecd5c9bafad769c8b2264e38499  gcc/testsuite/ada/acats-2/tests/e/e28005d.ada
! 3cacc87e4376898f97bc3ad35305e3b0  gcc/testsuite/ada/acats-2/tests/e/e52103y.ada
! c92c30f9076000218a22d41126403c34  gcc/testsuite/ada/acats-2/tests/e/eb4011a.ada
! deba1575fb8b252064041e5d408f53a3  gcc/testsuite/ada/acats-2/tests/e/eb4012a.ada
! 08131f4b11da03c32ca002338f3e4a59  gcc/testsuite/ada/acats-2/tests/e/eb4014a.ada
! b8a8e5440cbe69d0ad54064892a114c0  gcc/testsuite/ada/acats-2/tests/e/ee3203a.ada
! 48040471bf50b07840b3338c9bc7e2c6  gcc/testsuite/ada/acats-2/tests/e/ee3204a.ada
! 25bff343477de94bd78239442f9ee02a  gcc/testsuite/ada/acats-2/tests/e/ee3402b.ada
! b057daa29f3fcc66f6affebff75a1be5  gcc/testsuite/ada/acats-2/tests/e/ee3409f.ada
! 4c52e7caa9bc136f2cba824b2e52e9c6  gcc/testsuite/ada/acats-2/tests/e/ee3412c.ada
! 76344ab690464f293f3d4ea9ddafa233  gcc/testsuite/ada/acats-2/tests/l/la140010.a
! 2900850ee7d28fb09a708d15ecb120e8  gcc/testsuite/ada/acats-2/tests/l/la140011.am
! 3a566254bd6b5a2476b7a0a4d201c6ec  gcc/testsuite/ada/acats-2/tests/l/la140012.a
! f251861d8f7143c4d6a0139eb5109844  gcc/testsuite/ada/acats-2/tests/l/la140020.a
! 94e3a842d07a1b065bf9729ba53ec9fd  gcc/testsuite/ada/acats-2/tests/l/la140021.am
! 951f84109a5b6658e7dd287bbd9bae71  gcc/testsuite/ada/acats-2/tests/l/la140022.a
! 876db830d93e5c9744a1c290ed00f17f  gcc/testsuite/ada/acats-2/tests/l/la140030.a
! eaefd12663189709da8ccf17c2c368fa  gcc/testsuite/ada/acats-2/tests/l/la140031.a
! 7bf8660d1ec101205c05dd17726a229a  gcc/testsuite/ada/acats-2/tests/l/la140032.am
! 857f64e53ab5de64c7aff62222d11127  gcc/testsuite/ada/acats-2/tests/l/la140033.a
! 92ca699ccd2c74842385086d5ada22dd  gcc/testsuite/ada/acats-2/tests/l/la140040.a
! 8b2c5cc4a29ad35fcfa826d7b492bc08  gcc/testsuite/ada/acats-2/tests/l/la140041.am
! fb8dd82cf673301eecabc122ac171090  gcc/testsuite/ada/acats-2/tests/l/la140042.a
! 6d5ee36b10609c888874ac66e3f0ee1e  gcc/testsuite/ada/acats-2/tests/l/la140050.a
! e04923836f3f4282a67d6f89778a6914  gcc/testsuite/ada/acats-2/tests/l/la140051.a
! bfa5a2187576b86f14423c0040742843  gcc/testsuite/ada/acats-2/tests/l/la140052.am
! 0d6624b67d8552559b64873f684e581d  gcc/testsuite/ada/acats-2/tests/l/la140053.a
! 8035d0c6bfa2f3b3a49f58acd52dd8a7  gcc/testsuite/ada/acats-2/tests/l/la140060.a
! 3d90461eff6991fd8178d6d2118e9ddf  gcc/testsuite/ada/acats-2/tests/l/la140061.a
! e475cc528675aeae58edde764f9dd718  gcc/testsuite/ada/acats-2/tests/l/la140062.am
! f022f8aa1d30fb70ecca6f610089b986  gcc/testsuite/ada/acats-2/tests/l/la140063.a
! c3833b353f97382d992824760c162c7c  gcc/testsuite/ada/acats-2/tests/l/la140070.a
! c0ccfb9014a2864c4a49d88f46f491c1  gcc/testsuite/ada/acats-2/tests/l/la140071.a
! 509bb3bfec998a7f16d7a711f508bdc0  gcc/testsuite/ada/acats-2/tests/l/la140072.am
! 4710fc41166460cc60192a57798054b4  gcc/testsuite/ada/acats-2/tests/l/la140073.a
! dcb4f9c9fdad375c3fe93310ac6b816e  gcc/testsuite/ada/acats-2/tests/l/la140080.a
! a3acb845f1ea8cd193aec71beb1ead51  gcc/testsuite/ada/acats-2/tests/l/la140081.a
! d8f09cb05605e6ee39a41685ba970092  gcc/testsuite/ada/acats-2/tests/l/la140082.am
! 6d37a12249cd1b2bdf860f7651a462e4  gcc/testsuite/ada/acats-2/tests/l/la140083.a
! 46655b2b4b88ca82cb0afc6eac22cd7b  gcc/testsuite/ada/acats-2/tests/l/la140090.a
! 257622cc1c6c259921d7e6c33e23f1ff  gcc/testsuite/ada/acats-2/tests/l/la140091.a
! 1c00169793ce024a3f35da791e30bbe6  gcc/testsuite/ada/acats-2/tests/l/la140092.am
! 6a23c4b62a4cac8720e8b7c21ad97d5b  gcc/testsuite/ada/acats-2/tests/l/la140093.a
! ed2026e1ace460e994b96b42c8f05e9c  gcc/testsuite/ada/acats-2/tests/l/la140100.a
! 55167329c290c62025473120fca26c7d  gcc/testsuite/ada/acats-2/tests/l/la140101.a
! 9280256db41c4bec0f36aa69ff060841  gcc/testsuite/ada/acats-2/tests/l/la140102.am
! 7b092247e539009157e512965ba1fc7a  gcc/testsuite/ada/acats-2/tests/l/la140103.a
! 6722c5fc30bb307834268e434901c086  gcc/testsuite/ada/acats-2/tests/l/la140110.a
! 443c0bb26e2eb84889c83a9bccaf9649  gcc/testsuite/ada/acats-2/tests/l/la140111.a
! 47c6e7a9da351969b20b3d295bb3c115  gcc/testsuite/ada/acats-2/tests/l/la140112.am
! 4bf0921f6ccd99db94a8a70d2b166fdf  gcc/testsuite/ada/acats-2/tests/l/la140113.a
! 5c9a0f9992d6d21844e2ba208b7cebbc  gcc/testsuite/ada/acats-2/tests/l/la140120.a
! 7c0ca86bca64632e57e32b5842ddbe60  gcc/testsuite/ada/acats-2/tests/l/la140121.a
! 211c1d44471b6a40c3d807f83059ff77  gcc/testsuite/ada/acats-2/tests/l/la140122.am
! e4cb364e594a0d2463e66f4aa48a914a  gcc/testsuite/ada/acats-2/tests/l/la140123.a
! 76516f31e5adf9e0fad1886ab83457a4  gcc/testsuite/ada/acats-2/tests/l/la140130.a
! f3b7f597165821e514288274845f5e54  gcc/testsuite/ada/acats-2/tests/l/la140131.a
! cb0819afcaf9586c9c95966d2516fb65  gcc/testsuite/ada/acats-2/tests/l/la140132.am
! 32a943ea5a9287c709fa39655d8668cb  gcc/testsuite/ada/acats-2/tests/l/la140133.a
! 212943c674757076da046354450e5113  gcc/testsuite/ada/acats-2/tests/l/la140140.a
! 195b91195befb872c8f723da1d28f132  gcc/testsuite/ada/acats-2/tests/l/la140141.a
! a6d2954f197001069fb371e8403e8ac6  gcc/testsuite/ada/acats-2/tests/l/la140142.am
! 57ac76011ccf9054712e1b09ef71bfd9  gcc/testsuite/ada/acats-2/tests/l/la140143.a
! 7552c854bb4af3c4f87cfe6a7a861610  gcc/testsuite/ada/acats-2/tests/l/la140150.a
! 5f1dcc1a1c97c253b5809c49c2a326ad  gcc/testsuite/ada/acats-2/tests/l/la140151.a
! 662ea838e79bbec83ab42275c2111e2a  gcc/testsuite/ada/acats-2/tests/l/la140152.am
! c80afc3e35ad24a8bb25b5e3d67f2bcb  gcc/testsuite/ada/acats-2/tests/l/la140153.a
! ebc4ad53e17e21942e69ae80c5b47b77  gcc/testsuite/ada/acats-2/tests/l/la140160.a
! 117e1792c17a1e2b5ec04bba346f528d  gcc/testsuite/ada/acats-2/tests/l/la140161.a
! b7744773a1c753b7aa68c166866eb005  gcc/testsuite/ada/acats-2/tests/l/la140162.am
! 9852ca8047bc9e1bd578767b67254fd2  gcc/testsuite/ada/acats-2/tests/l/la140163.a
! f7f66fd9abfb1f4931428292cd1fe63d  gcc/testsuite/ada/acats-2/tests/l/la140170.a
! 2acaa1d866103405c81e05839bd25054  gcc/testsuite/ada/acats-2/tests/l/la140171.a
! ea5de64993880be50e047e540f521cec  gcc/testsuite/ada/acats-2/tests/l/la140172.am
! b3e16fff4bf97ee8001c7d4707b01ca8  gcc/testsuite/ada/acats-2/tests/l/la140173.a
! cef0b6dba566de9e4b3fdd8429f3b573  gcc/testsuite/ada/acats-2/tests/l/la140180.a
! 3a47eaaf81a03727243aa228f4301a60  gcc/testsuite/ada/acats-2/tests/l/la140181.a
! a5c23800bfa114aaa25ef21241ca0c43  gcc/testsuite/ada/acats-2/tests/l/la140182.am
! 831069dc37bbaa6d17e49ec411324925  gcc/testsuite/ada/acats-2/tests/l/la140183.a
! 9597131b3c0b103f6244907627fbf160  gcc/testsuite/ada/acats-2/tests/l/la140190.a
! 14063c6684e8dd6c14ea4d18badb550b  gcc/testsuite/ada/acats-2/tests/l/la140191.a
! 8cbcf00024bdf7530ae51ba8a1ca0bba  gcc/testsuite/ada/acats-2/tests/l/la140192.am
! 99e2d79f6f50d594ab2f3e503f2db441  gcc/testsuite/ada/acats-2/tests/l/la140193.a
! ea6d1fb3bdbfc0deaee617b126be28f4  gcc/testsuite/ada/acats-2/tests/l/la140200.a
! babcd4715ea4f023430dfbe1f896bde1  gcc/testsuite/ada/acats-2/tests/l/la140201.a
! 64279761de38aa82af4a5638c457c1bf  gcc/testsuite/ada/acats-2/tests/l/la140202.am
! 7e4b83d0d9265f463e87dcc9fcf0fe5b  gcc/testsuite/ada/acats-2/tests/l/la140203.a
! b12cced7adaecf2a93250e16cca98cf4  gcc/testsuite/ada/acats-2/tests/l/la140210.a
! 887401b5f446bce786751fa72e341292  gcc/testsuite/ada/acats-2/tests/l/la140211.am
! ab173d0eec0bb616f34f81aa48cd950c  gcc/testsuite/ada/acats-2/tests/l/la140212.a
! 594b0e8144190e578786dbc1bad844dc  gcc/testsuite/ada/acats-2/tests/l/la140220.a
! f842b35f8c01816efc84f4addd2f93b7  gcc/testsuite/ada/acats-2/tests/l/la140221.am
! 772553907cc4b151574b52a2b52dc90c  gcc/testsuite/ada/acats-2/tests/l/la140222.a
! b03871ce6d6f59a7e5a7612e6d89d596  gcc/testsuite/ada/acats-2/tests/l/la140240.a
! efe4e86bfb690c79c68494f323cac801  gcc/testsuite/ada/acats-2/tests/l/la140241.a
! 30f55b3747e6fa1b9ef0af765a76ce5a  gcc/testsuite/ada/acats-2/tests/l/la140242.am
! f95f7a3f483abd92a9bf92b6dc469986  gcc/testsuite/ada/acats-2/tests/l/la140243.a
! 2db8317b47f3ab8bb9a0f5469169d027  gcc/testsuite/ada/acats-2/tests/l/la140250.a
! 938965a24a1e6eb44e817ef6a6bcef36  gcc/testsuite/ada/acats-2/tests/l/la140251.am
! b3d2bc446e9f8766852585be1a71c541  gcc/testsuite/ada/acats-2/tests/l/la140252.a
! ced69a105f582142776937381fb4ac18  gcc/testsuite/ada/acats-2/tests/l/la140260.a
! ff927baa2a1a94e581616deb8f88d900  gcc/testsuite/ada/acats-2/tests/l/la140261.a
! 666740bbcb573799ed4bbd92b8380bac  gcc/testsuite/ada/acats-2/tests/l/la140262.am
! 2a7b7e46c9fcf98d59cf645dd8488895  gcc/testsuite/ada/acats-2/tests/l/la140263.a
! b886a43ab960ee3b74b75b1a1895e692  gcc/testsuite/ada/acats-2/tests/l/la140270.a
! 2f50ecd2b64eb3a3cefb0066c4c043a1  gcc/testsuite/ada/acats-2/tests/l/la140271.a
! 004386b31584ba3e3f7171f7674e4137  gcc/testsuite/ada/acats-2/tests/l/la140272.am
! 9c63871113de9b518e90c90fe8e20f28  gcc/testsuite/ada/acats-2/tests/l/la140273.a
! 4004844198395fe50ecb798ed5d30f4b  gcc/testsuite/ada/acats-3/elabd.lst
! b32871a59b0c07cb4eda259b98fa6aab  gcc/testsuite/ada/acats-3/floatstore.lst
! bb4e4f9d3c0e72730e0bf397d375689c  gcc/testsuite/ada/acats-3/norun.lst
! 1485f263dfb9303b015015ae88161a8b  gcc/testsuite/ada/acats-3/run_acats.sh
! 9ae03e4c1aaa4540debb8413897d3d8c  gcc/testsuite/ada/acats-3/run_all.sh
! 6467abb463602aeb04583b3822f653f4  gcc/testsuite/ada/acats-3/run_test.exp
! 5723a26fced8721c3e90e6e7a9ba2a23  gcc/testsuite/ada/acats-3/stackcheck.lst
! e2c240adcd56f6817bf504f09f8f37f8  gcc/testsuite/ada/acats-3/support/acats31.lst
! 2f262cdb98b38922d7b7f84414f43b84  gcc/testsuite/ada/acats-3/support/checkfil.ada
! 4edf20410814582eae331707f2ae2c77  gcc/testsuite/ada/acats-3/support/enumchek.ada
! 8f3ec4fe93c0095e34d79e9a41dde4e9  gcc/testsuite/ada/acats-3/support/f340a000.a
! b673a17611516bde0712458de61636e8  gcc/testsuite/ada/acats-3/support/f340a001.a
! b31158ceea90e5246f63aed8b0078e9c  gcc/testsuite/ada/acats-3/support/f341a00.a
! d3d954612d4f455a32df07aa05816320  gcc/testsuite/ada/acats-3/support/f390a00.a
! ed3b5aee8f81d147785adce6b48411cd  gcc/testsuite/ada/acats-3/support/f392a00.a
! 7973b64953275c03e790967bc310010c  gcc/testsuite/ada/acats-3/support/f392c00.a
! 7b5b9e45fb9003af0e096ca36327031e  gcc/testsuite/ada/acats-3/support/f392d00.a
! e4733abdf62c401a876d29c3e5a38c34  gcc/testsuite/ada/acats-3/support/f393a00.a
! c1487dd34771abf18d1144c610fac26e  gcc/testsuite/ada/acats-3/support/f393b00.a
! 62e2d5487aada0ccc1744ab3475cf281  gcc/testsuite/ada/acats-3/support/f394a00.a
! a42dca590b0bfdb848b97329f6d46360  gcc/testsuite/ada/acats-3/support/f3a1a00.a
! b3e35321e808d9e061d1fdef51813016  gcc/testsuite/ada/acats-3/support/f3a2a00.a
! 9cc366af74ec7e926f044bb5155d06ae  gcc/testsuite/ada/acats-3/support/f431a00.a
! c528a968af853505c447f20a88480156  gcc/testsuite/ada/acats-3/support/f433a00.a
! 8272f7274c301332200c1e04a0c1974c  gcc/testsuite/ada/acats-3/support/f452a00.a
! 798afd3c6228223e07e7c8e3034eb99c  gcc/testsuite/ada/acats-3/support/f460a00.a
! d6989b796158be297223806b657f2d4a  gcc/testsuite/ada/acats-3/support/f650a00.a
! 316c7cde49ee557a67d39d6b63407811  gcc/testsuite/ada/acats-3/support/f730a000.a
! 60edd601c25022d0f19b8c45d3d187bb  gcc/testsuite/ada/acats-3/support/f730a001.a
! 75b2405f0dd739649bda9b92b0d259f4  gcc/testsuite/ada/acats-3/support/f731a00.a
! f12fe4ead9a2039676b4c2ad03e2a7c7  gcc/testsuite/ada/acats-3/support/f750a00.a
! d908051b99b685ec40f8c9185676e6a2  gcc/testsuite/ada/acats-3/support/f750b00.a
! bbcbe0173cb32d75903f9a81bf5c4060  gcc/testsuite/ada/acats-3/support/f760a00.a
! 689c49d9ccb5124d47eecb1dcebcc376  gcc/testsuite/ada/acats-3/support/f940a00.a
! d08e91b98a54c3d471108a6631714033  gcc/testsuite/ada/acats-3/support/f954a00.a
! f95be63eadf08e7cafbeb33a6794c019  gcc/testsuite/ada/acats-3/support/fa11a00.a
! 28be0e2126b177ff6d34df7c272a9f2c  gcc/testsuite/ada/acats-3/support/fa11b00.a
! 2228808bf25eecbd9e02ff343e2dba54  gcc/testsuite/ada/acats-3/support/fa11c00.a
! 1cb03e4473720d064b6798cf5e185f62  gcc/testsuite/ada/acats-3/support/fa11d00.a
! ff082a3957be5f526713103bf563e5be  gcc/testsuite/ada/acats-3/support/fa13a00.a
! dfa6bb61642b6c22f17171fb93cfc97c  gcc/testsuite/ada/acats-3/support/fa13b00.a
! b1766ae4ae2012673c7e0c848a4c105e  gcc/testsuite/ada/acats-3/support/fa21a00.a
! 97d3fd68d030a5d89e98b950d557151d  gcc/testsuite/ada/acats-3/support/fb20a00.a
! 886f3ad8c51e9e1e01cb7d4ab0b3f47e  gcc/testsuite/ada/acats-3/support/fb40a00.a
! 045b4b77241122260c9b42a0a85941b8  gcc/testsuite/ada/acats-3/support/fc50a00.a
! d2c427a2c2e845d2d5991d7e86689284  gcc/testsuite/ada/acats-3/support/fc51a00.a
! 18eee0e1727cb58b8ca0da52a8f7fbd0  gcc/testsuite/ada/acats-3/support/fc51b00.a
! 707c153d9868ec6e694e8db161e9a7c7  gcc/testsuite/ada/acats-3/support/fc51c00.a
! 981a728516c5de4f242cff81d35a1806  gcc/testsuite/ada/acats-3/support/fc51d00.a
! 992e25818babbd2519c54f2dc5987601  gcc/testsuite/ada/acats-3/support/fc54a00.a
! f75e17c909e83e1879e87a3ba3ffd7cc  gcc/testsuite/ada/acats-3/support/fc70a00.a
! cdb7ee32751757a29e821ba020228a0e  gcc/testsuite/ada/acats-3/support/fc70b00.a
! 8af79a6be55981313da73bc0bb01f617  gcc/testsuite/ada/acats-3/support/fc70c00.a
! 65011f4705018476715af62324c335b3  gcc/testsuite/ada/acats-3/support/fcndecl.ada
! 3ce3384936274aa48a8c4a38fa7109ac  gcc/testsuite/ada/acats-3/support/fd72a00.a
! 5c9a93b4c9f45c15707e4b3b123aee9c  gcc/testsuite/ada/acats-3/support/fdb0a00.a
! bf9c7650a6f8303b6a69ff5eb2660b15  gcc/testsuite/ada/acats-3/support/fdd2a00.a
! 66196b3c77238fb8c27dd10465e97042  gcc/testsuite/ada/acats-3/support/fdd2b00.a
! a77ebc244676daacb1f3a61ae8003e88  gcc/testsuite/ada/acats-3/support/fxa5a00.a
! f4e9649e424fa9578180b9aee65c8e96  gcc/testsuite/ada/acats-3/support/fxaca00.a
! caa75442e4dceed0740dfa35a47b5bb6  gcc/testsuite/ada/acats-3/support/fxacb00.a
! 1855abc6c615b76aa82fb9241571f3d8  gcc/testsuite/ada/acats-3/support/fxacc00.a
! 1c5af3fa6abb70600f002448cbb84798  gcc/testsuite/ada/acats-3/support/fxaia00.a
! f88af2b3eb53ad7c8700efbd0f878915  gcc/testsuite/ada/acats-3/support/fxc6a00.a
! 56ba35dd56ea544c0eb9146769871492  gcc/testsuite/ada/acats-3/support/fxe2a00.a
! 67770e9161b0f48f3fc9392bd3460272  gcc/testsuite/ada/acats-3/support/fxf2a00.a
! 6628969f51dd10c56235f9d7420e2d44  gcc/testsuite/ada/acats-3/support/fxf3a00.a
! 6a9b6ce90538e9126e7e5badc62ddca2  gcc/testsuite/ada/acats-3/support/impbit.adb
! 6fb74a7e3cf92186f0582ed9ff3261e6  gcc/testsuite/ada/acats-3/support/impdef.a
! 1df1ecb1a1f6d4af019216884e3504ef  gcc/testsuite/ada/acats-3/support/impdefc.a
! 4f2f9bfdfcfd8c5ecaf503416d1cfc5f  gcc/testsuite/ada/acats-3/support/impdefd.a
! edf70d423a69adebd38e9b29f35a2ba1  gcc/testsuite/ada/acats-3/support/impdefe.a
! cadfd8a5487a315a6fbd8eef397219e9  gcc/testsuite/ada/acats-3/support/impdefg.a
! 5d9a0f98d9f15211e0773263febb974b  gcc/testsuite/ada/acats-3/support/impdefh.a
! f2604ccc5244696793b33e7b83c57c45  gcc/testsuite/ada/acats-3/support/lencheck.ada
! 79c0994222b2a5fc702eb4bc3dc1ba8e  gcc/testsuite/ada/acats-3/support/macro.dfs
! 72980ae1a3bbd5b71aa915cefeaebf6e  gcc/testsuite/ada/acats-3/support/macrodef.adb
! 4d7b79a3ff077d1ab05a78ebcf5a1de3  gcc/testsuite/ada/acats-3/support/macrosub.ada
! 42ae695033fed5dcc5b021b3959756b3  gcc/testsuite/ada/acats-3/support/repbody.ada
! ec6c02ebb16da7cc117e3a65c06d385a  gcc/testsuite/ada/acats-3/support/repspec.ada
! 356cf4b2e0cc1e02ef1deddb5567de36  gcc/testsuite/ada/acats-3/support/spprt13s.tst
! d7900dc1365a924faa6718c6f3455730  gcc/testsuite/ada/acats-3/support/tctouch.ada
! 26945b868319fda8b82f82c677a35562  gcc/testsuite/ada/acats-3/support/tsttests.dat
! dc179b8a7c506c961b229b7ec7d2de53  gcc/testsuite/ada/acats-3/tests/a/a22006b.ada
! f61ae49f8066de3ba349e39d3a688ea6  gcc/testsuite/ada/acats-3/tests/a/a22006c.ada
! 54e5a501bbefb19fdf7715f5741fc858  gcc/testsuite/ada/acats-3/tests/a/a22006d.ada
! 11394a122edd516a587d020bc9ce2e8e  gcc/testsuite/ada/acats-3/tests/a/a26007a.tst
! aa57a75b85b36a99f6ecaca91a9eed60  gcc/testsuite/ada/acats-3/tests/a/a27003a.ada
! 054ca4c1bbb5dd701e8781bc92bf9cb8  gcc/testsuite/ada/acats-3/tests/a/a29003a.ada
! c330e5a362289a57c2ca975a61b4d20c  gcc/testsuite/ada/acats-3/tests/a/a2a031a.ada
! bbd0059e56828aa342048400c5490233  gcc/testsuite/ada/acats-3/tests/a/a33003a.ada
! 84de33e1cd2c3a0c2165591a28407805  gcc/testsuite/ada/acats-3/tests/a/a34017c.ada
! 924373fa4803a6e22fdc43bd0bee31a3  gcc/testsuite/ada/acats-3/tests/a/a35101b.ada
! be270ea90b999a2136e6cc850543a945  gcc/testsuite/ada/acats-3/tests/a/a35402a.ada
! 8054f52aa40d34c334d3a4b30222340a  gcc/testsuite/ada/acats-3/tests/a/a35801f.ada
! 325ee8ec767c6769757ac1eb71d6f515  gcc/testsuite/ada/acats-3/tests/a/a35902c.ada
! c512e91af19d8cf3307b189ec712dde0  gcc/testsuite/ada/acats-3/tests/a/a38106d.ada
! 8d608afb4ab9b953fd4dd01b00a90914  gcc/testsuite/ada/acats-3/tests/a/a38106e.ada
! 28bab0e5eb84a43ad0b4dc06d90f880b  gcc/testsuite/ada/acats-3/tests/a/a49027a.ada
! 5b6e07973ea9075de594e462d6f0f847  gcc/testsuite/ada/acats-3/tests/a/a49027b.ada
! 926d6ade013a1456d53a17063495aaf2  gcc/testsuite/ada/acats-3/tests/a/a49027c.ada
! df2270ff569c843d152cae1fc3606103  gcc/testsuite/ada/acats-3/tests/a/a54b01a.ada
! 71937fafcd3199a3eda330e7880c1ec5  gcc/testsuite/ada/acats-3/tests/a/a54b02a.ada
! 1aa0f31635199e1096468f23888a66f4  gcc/testsuite/ada/acats-3/tests/a/a55b12a.ada
! b0fc7cf66a832e68c808ed89a23340d1  gcc/testsuite/ada/acats-3/tests/a/a55b13a.ada
! 205552e2dafa2b699b6514e12a35e676  gcc/testsuite/ada/acats-3/tests/a/a55b14a.ada
! 7a5be75ac2dc323c1dd1e9328c39c6e0  gcc/testsuite/ada/acats-3/tests/a/a71004a.ada
! 69bd6dadfe4d61041f1998157bcbdb4a  gcc/testsuite/ada/acats-3/tests/a/a73001i.ada
! 8b949ce02d53bc2b35893d05656ff3c2  gcc/testsuite/ada/acats-3/tests/a/a73001j.ada
! 3859ef22068457dc5db7b84889f89c07  gcc/testsuite/ada/acats-3/tests/a/a74105b.ada
! 5200e86147d7eddb31de36b182066003  gcc/testsuite/ada/acats-3/tests/a/a74106a.ada
! d288f454e96b3840804c86245fd1309c  gcc/testsuite/ada/acats-3/tests/a/a74106b.ada
! c6c2ff5c654f5fecb72565c1ec890ea8  gcc/testsuite/ada/acats-3/tests/a/a74106c.ada
! 4526ae74da58946736d1077ca17b0f15  gcc/testsuite/ada/acats-3/tests/a/a74205e.ada
! a4600113362b659154e0921e8ccc440b  gcc/testsuite/ada/acats-3/tests/a/a74205f.ada
! 762682eaddf9e0d72ef370ddf52c091c  gcc/testsuite/ada/acats-3/tests/a/a83009a.ada
! 89be8e66cfa8cf7d9ea962fc92c5bbe6  gcc/testsuite/ada/acats-3/tests/a/a83009b.ada
! 1a86aa84a5b4a8f2d91898a2a5878109  gcc/testsuite/ada/acats-3/tests/a/a83a02a.ada
! b50d55495ed25cd5f5f0cc5ce62c33c6  gcc/testsuite/ada/acats-3/tests/a/a83a02b.ada
! 92d9af0f50f62b8ca3df28d8e4228ec5  gcc/testsuite/ada/acats-3/tests/a/a83a06a.ada
! 5c0b43d5d9e1251dce20fd8ac69811a8  gcc/testsuite/ada/acats-3/tests/a/a83a08a.ada
! d847c2fa25d9becc828716d2f6b3924e  gcc/testsuite/ada/acats-3/tests/a/a83c01c.ada
! 48efd44cb0cc48a4666ca9078d516a19  gcc/testsuite/ada/acats-3/tests/a/a83c01h.ada
! 9a14ce84b1e63358e8ea5b22b8b58366  gcc/testsuite/ada/acats-3/tests/a/a83c01i.ada
! d4b236b43806323a12df387d43065ecd  gcc/testsuite/ada/acats-3/tests/a/a85007d.ada
! 22b51a96b02c7a88f7ef1383e4b6e3ba  gcc/testsuite/ada/acats-3/tests/a/a85013b.ada
! 401bca9a32ad0d8881ea660bba3ca711  gcc/testsuite/ada/acats-3/tests/a/a87b59a.ada
! 74d0779474d9d789d09508ba653efc61  gcc/testsuite/ada/acats-3/tests/a/a95001c.ada
! 4de434af68116383b58aae2d7ff0186e  gcc/testsuite/ada/acats-3/tests/a/a95074d.ada
! 6dcac89d281ffc1c47dc51dfd7429d9e  gcc/testsuite/ada/acats-3/tests/a/a97106a.ada
! 672a004e783873caffaddfe2e9ed7184  gcc/testsuite/ada/acats-3/tests/a/a99006a.ada
! d338cf80520cfcd59896b08557f7334a  gcc/testsuite/ada/acats-3/tests/a/aa2010a.ada
! c8652c11c39145beb7535ff59feee79b  gcc/testsuite/ada/acats-3/tests/a/aa2012a.ada
! 64d7f9e70085b7412df08b06b70924f1  gcc/testsuite/ada/acats-3/tests/a/ac1015b.ada
! f8019419f138b9b0b4e860f560539c52  gcc/testsuite/ada/acats-3/tests/a/ac3106a.ada
! 599863dbc7677bd83fe020c38e11b4b8  gcc/testsuite/ada/acats-3/tests/a/ac3206a.ada
! 527cf1506ce6e0451f82e833aba4b6b3  gcc/testsuite/ada/acats-3/tests/a/ac3207a.ada
! 7c28607179138101a5d7cf088f333028  gcc/testsuite/ada/acats-3/tests/a/ad7001b.ada
! 810035c64fe589563087a2d2f380f1e4  gcc/testsuite/ada/acats-3/tests/a/ad7001c0.ada
! 8d92b2b79dbfd08d90c9a238b1e35a05  gcc/testsuite/ada/acats-3/tests/a/ad7001c1.ada
! 1c1c6e5fb42029a3ff9b1f3b9055c191  gcc/testsuite/ada/acats-3/tests/a/ad7001d0.ada
! 21257b0cc94669e31a8891cb9ed30e14  gcc/testsuite/ada/acats-3/tests/a/ad7001d1.ada
! eaa4c7b6b00bcd4bfa2d9883aff64ee8  gcc/testsuite/ada/acats-3/tests/a/ad7006a.ada
! b93c425e39dd1e4003cb33131862e719  gcc/testsuite/ada/acats-3/tests/a/ad7101a.ada
! 07e115c2bd0ac4bc085809d9ad65327f  gcc/testsuite/ada/acats-3/tests/a/ad7101c.ada
! 24888691f9cd0131679078391bf99fb1  gcc/testsuite/ada/acats-3/tests/a/ad7102a.ada
! 27abfa60261b508014d366ae82e296fe  gcc/testsuite/ada/acats-3/tests/a/ad7103a.ada
! aec3e74553448f599ae9a51ec65c42ce  gcc/testsuite/ada/acats-3/tests/a/ad7103c.ada
! d18cab7f102ffc27545ccb4522f82ded  gcc/testsuite/ada/acats-3/tests/a/ad7104a.ada
! 1b797aacfde0d671d89a45db2a9d5be2  gcc/testsuite/ada/acats-3/tests/a/ad7201a.ada
! 8c49706fbc8916aacd037e7649ed8213  gcc/testsuite/ada/acats-3/tests/a/ad7203b.ada
! 129af6b1b47884872132fcfc3787f362  gcc/testsuite/ada/acats-3/tests/a/ad7205b.ada
! 696b85c4c78cdc9b5448612a22b9ffa3  gcc/testsuite/ada/acats-3/tests/a/ad8011a.tst
! bfa3fa83b466b71da4126d005e2c701b  gcc/testsuite/ada/acats-3/tests/a/ada101a.ada
! 178bb6ff2316e9cfb5bd4395e74874ae  gcc/testsuite/ada/acats-3/tests/a/ae2113a.ada
! 1dd247cf1f02e4384b1f1a58ab2244c0  gcc/testsuite/ada/acats-3/tests/a/ae2113b.ada
! 5ff7c493a66eb8be0a3e7f89bd4d2512  gcc/testsuite/ada/acats-3/tests/a/ae3002g.ada
! 2cc8c13fd1203af7f246cee23d3037c3  gcc/testsuite/ada/acats-3/tests/a/ae3101a.ada
! 3798d627b7336c5fa8805e970e10ec7e  gcc/testsuite/ada/acats-3/tests/a/ae3702a.ada
! 7a44891c6ee0ec272ded72e61d392bc8  gcc/testsuite/ada/acats-3/tests/a/ae3709a.ada
! 8a42b2199ecbb25390c8c306c3759312  gcc/testsuite/ada/acats-3/tests/c2/c23001a.ada
! 8d4b3f4069aeb0e32db3f46e5cb1487b  gcc/testsuite/ada/acats-3/tests/c2/c23003a.tst
! 95e1beb36e033514e6e4be866042a42a  gcc/testsuite/ada/acats-3/tests/c2/c23003b.tst
! a765ec985184f6802389b89d0971eede  gcc/testsuite/ada/acats-3/tests/c2/c23003g.tst
! 53bdd26032ff323b57f3c309b520767e  gcc/testsuite/ada/acats-3/tests/c2/c23003i.tst
! d8470ff80210b6aeab8ecf5828f8e73c  gcc/testsuite/ada/acats-3/tests/c2/c23006a.ada
! c175938807f9ed5ec36eed8c2fc47bf2  gcc/testsuite/ada/acats-3/tests/c2/c23006b.ada
! 1891f1d94ad6f27dc8691abae763b735  gcc/testsuite/ada/acats-3/tests/c2/c23006c.ada
! 4d2aaab0f8577c4441dfb223b74e9270  gcc/testsuite/ada/acats-3/tests/c2/c23006d.ada
! d38fc16a6b2a221a8089094d8e595fd0  gcc/testsuite/ada/acats-3/tests/c2/c23006e.ada
! e4cb34f327ded980acbb2890f276b1b6  gcc/testsuite/ada/acats-3/tests/c2/c23006f.ada
! 1afe1ff732d7c93eb72aeb763fc3a3e4  gcc/testsuite/ada/acats-3/tests/c2/c23006g.ada
! d7a2fe8807a7e954f894e43619906c61  gcc/testsuite/ada/acats-3/tests/c2/c24002d.ada
! 90b7096d0092e8bee54a5e0931480cc3  gcc/testsuite/ada/acats-3/tests/c2/c24003a.ada
! 8d4b3197420dea97b47fa445d6b7f13e  gcc/testsuite/ada/acats-3/tests/c2/c24003b.ada
! c0bc49ad0d9faebe7c1bddd17682575b  gcc/testsuite/ada/acats-3/tests/c2/c24003c.ada
! 474d9480579f044d63ea2312eee797a0  gcc/testsuite/ada/acats-3/tests/c2/c24106a.ada
! 21abd0c844a441282df97eca59d187ac  gcc/testsuite/ada/acats-3/tests/c2/c24202d.ada
! f8734f0cb78893a591c1455798f48f34  gcc/testsuite/ada/acats-3/tests/c2/c24203a.ada
! 303fe85abf30e67b9c26c05c37527377  gcc/testsuite/ada/acats-3/tests/c2/c24203b.ada
! 4fc421f9d26dd38caa8e66e5f9a8118d  gcc/testsuite/ada/acats-3/tests/c2/c24207a.ada
! 00805111547e7b0f767a65dbb0216178  gcc/testsuite/ada/acats-3/tests/c2/c24211a.ada
! d5324b037e4f821711b81926469cd3e5  gcc/testsuite/ada/acats-3/tests/c2/c250001.au
! 373ab51281434258bd43bb850031dd33  gcc/testsuite/ada/acats-3/tests/c2/c250002.au
! fcffacb0c5a7d6bc171b2b62228ef27c  gcc/testsuite/ada/acats-3/tests/c2/c25001a.ada
! f8101111006b8dfccb57bc9286761546  gcc/testsuite/ada/acats-3/tests/c2/c25001b.ada
! 4d59f28ccd2a2792f59d358acfb3b645  gcc/testsuite/ada/acats-3/tests/c2/c26006a.ada
! 2a3847aff34c962069ea9fc46184b49c  gcc/testsuite/ada/acats-3/tests/c2/c26008a.ada
! 3b3d12a94cdb249ade26bb6fe45121be  gcc/testsuite/ada/acats-3/tests/c2/c2a001a.ada
! 3fd11c60327272b0e88714377e07694a  gcc/testsuite/ada/acats-3/tests/c2/c2a001b.ada
! fad7c83b08db79e3d8d41a3abc495609  gcc/testsuite/ada/acats-3/tests/c2/c2a001c.ada
! 9e58903d92e80dece18b3f5f07c10714  gcc/testsuite/ada/acats-3/tests/c2/c2a002a.ada
! 80f047f9baf4edce16ae00b242937e09  gcc/testsuite/ada/acats-3/tests/c2/c2a008a.ada
! 5846b01316c8e35b2ae9271e2ceeb33b  gcc/testsuite/ada/acats-3/tests/c2/c2a021b.ada
! 6c6e6ac7e7d8151372bf25d5bfcc4638  gcc/testsuite/ada/acats-3/tests/c3/c32001a.ada
! f44d3e1d8c4deff3e60e49eb14755c7f  gcc/testsuite/ada/acats-3/tests/c3/c32001b.ada
! 90383af3c35e304193502497e9d9ada0  gcc/testsuite/ada/acats-3/tests/c3/c32001c.ada
! 6f38031cf1bc7fd3a2530a0a49fc3927  gcc/testsuite/ada/acats-3/tests/c3/c32001d.ada
! 4cff8a5cde793b9eb72e56ef8588c690  gcc/testsuite/ada/acats-3/tests/c3/c32001e.ada
! fe386611f5a09953fdbdb423b0673b0b  gcc/testsuite/ada/acats-3/tests/c3/c32107a.ada
! 6dcc55a41a077f43caf697ae83ae4678  gcc/testsuite/ada/acats-3/tests/c3/c32107c.ada
! 6bc3a589ff71140e94718588fa9f9c34  gcc/testsuite/ada/acats-3/tests/c3/c32108a.ada
! 0b55a6ac879d361c4eaa8a25a475c92e  gcc/testsuite/ada/acats-3/tests/c3/c32108b.ada
! 4520bac74d324253fcf2b48b5c6eea2b  gcc/testsuite/ada/acats-3/tests/c3/c32111a.ada
! 52ac5c461c7746717a0d789fb2a57377  gcc/testsuite/ada/acats-3/tests/c3/c32111b.ada
! dabad6f6cae80313a5a888aaa710756d  gcc/testsuite/ada/acats-3/tests/c3/c32112b.ada
! eebc548a818a1f56ce990f52129e4296  gcc/testsuite/ada/acats-3/tests/c3/c32113a.ada
! 016d6073dcc33d7b8106082eb7755faa  gcc/testsuite/ada/acats-3/tests/c3/c32115a.ada
! a613215b48d8c873069bb2d690d5f556  gcc/testsuite/ada/acats-3/tests/c3/c32115b.ada
! f21dc71d940d5c06af5d22f69eab60f9  gcc/testsuite/ada/acats-3/tests/c3/c330001.a
! 74812d0708e93af61e096b45e2fc14ec  gcc/testsuite/ada/acats-3/tests/c3/c330002.a
! 8e5fef6b3dfabbb753bbf97caf8dddae  gcc/testsuite/ada/acats-3/tests/c3/c332001.a
! d7ae35646e985b47bde736b4aeadaec1  gcc/testsuite/ada/acats-3/tests/c3/c340001.a
! 029cfe27a33cb66b049fe0d0fb65381b  gcc/testsuite/ada/acats-3/tests/c3/c34001a.ada
! 7f88e5135c6832cdc88dff48cc8dafee  gcc/testsuite/ada/acats-3/tests/c3/c34001c.ada
! 8c1764692d7cb0bc17a952ce68b59db8  gcc/testsuite/ada/acats-3/tests/c3/c34001d.ada
! a08af1aeb3b4af40be4e8250cad56d8d  gcc/testsuite/ada/acats-3/tests/c3/c34001f.ada
! 796e76f308a9d18762b63a8a7c9fa6ec  gcc/testsuite/ada/acats-3/tests/c3/c34002a.ada
! 56ca2500660f86690e43b4eb2c63911d  gcc/testsuite/ada/acats-3/tests/c3/c34002c.ada
! 916814d1426aeb62617f0e647f1425f4  gcc/testsuite/ada/acats-3/tests/c3/c34003a.ada
! 7848bad56990231ec4964a5294f4d02f  gcc/testsuite/ada/acats-3/tests/c3/c34003c.ada
! 3f596cd960a8968d7c7892b7351e85fa  gcc/testsuite/ada/acats-3/tests/c3/c34004a.ada
! f25b6504d96e3e21099abd8a985bfe40  gcc/testsuite/ada/acats-3/tests/c3/c34004c.ada
! 10feabd33f2004943d36ff9acac0bda3  gcc/testsuite/ada/acats-3/tests/c3/c34005a.ada
! 9b730174260769c83e1d1f34a482b64c  gcc/testsuite/ada/acats-3/tests/c3/c34005c.ada
! d8cd66825d35a0c2eee7a2bc22021fde  gcc/testsuite/ada/acats-3/tests/c3/c34005d.ada
! fd5b17683accebcffccf7d52a88ba813  gcc/testsuite/ada/acats-3/tests/c3/c34005f.ada
! 5a2119c2d54f4427832bc1c61d913eac  gcc/testsuite/ada/acats-3/tests/c3/c34005g.ada
! 170b45f6069790926570bd39f97033ea  gcc/testsuite/ada/acats-3/tests/c3/c34005i.ada
! bdf673ae022cc1b217f6ea84218ef460  gcc/testsuite/ada/acats-3/tests/c3/c34005j.ada
! 0c6f4909c9db9787b9ca4d3b296a3ae9  gcc/testsuite/ada/acats-3/tests/c3/c34005l.ada
! 7f1441892699c24f145df474c396124d  gcc/testsuite/ada/acats-3/tests/c3/c34005m.ada
! f851c156716ece972741b1a161b80b5f  gcc/testsuite/ada/acats-3/tests/c3/c34005o.ada
! 44e6ae2ddfccd9120add81bcf05ef268  gcc/testsuite/ada/acats-3/tests/c3/c34005p.ada
! c9bfd44b8febc96560f3ee780cd50a02  gcc/testsuite/ada/acats-3/tests/c3/c34005r.ada
! cd29d3c24de0223ae985376f7363459e  gcc/testsuite/ada/acats-3/tests/c3/c34005s.ada
! 5369d3d26bb15776f47302c2f15c9682  gcc/testsuite/ada/acats-3/tests/c3/c34005u.ada
! b0cfd73e6d9f1d87557f4775248508ea  gcc/testsuite/ada/acats-3/tests/c3/c34005v.ada
! 60d73ec320d9ef0db0dc330bb3e04fe5  gcc/testsuite/ada/acats-3/tests/c3/c34006a.ada
! da0b3e574a91ee0aaaef5268466ab1d1  gcc/testsuite/ada/acats-3/tests/c3/c34006d.ada
! 8d549731513d1eff1ef01cf7c39e1bb6  gcc/testsuite/ada/acats-3/tests/c3/c34006f.ada
! 4ed1c279557b308d6949c373537329cf  gcc/testsuite/ada/acats-3/tests/c3/c34006g.ada
! 90472c17a5088e3d00d57cf3597dc59f  gcc/testsuite/ada/acats-3/tests/c3/c34006j.ada
! 5c3c081fc43ed6dc322f8a13f14b6dba  gcc/testsuite/ada/acats-3/tests/c3/c34006l.ada
! 3111937fe40eda62543e53d0dc0a9b2e  gcc/testsuite/ada/acats-3/tests/c3/c34007a.ada
! a6c16ebbc095684171bb89cb7ac5b52f  gcc/testsuite/ada/acats-3/tests/c3/c34007d.ada
! 3f46f4632a1e2839b528dd4edb849c59  gcc/testsuite/ada/acats-3/tests/c3/c34007f.ada
! 50a6b8b6ab707d4020a210c2f54c5364  gcc/testsuite/ada/acats-3/tests/c3/c34007g.ada
! 1d08fae78b3684032500b751c4f6b956  gcc/testsuite/ada/acats-3/tests/c3/c34007i.ada
! 7dec8ab4f2325dfb24a6f4a0712ca647  gcc/testsuite/ada/acats-3/tests/c3/c34007j.ada
! f2f670c3368d6fdedc0bc830e2f5441f  gcc/testsuite/ada/acats-3/tests/c3/c34007m.ada
! 12e7a75337b952bbe70b50f44fbf73bd  gcc/testsuite/ada/acats-3/tests/c3/c34007p.ada
! 4460899978bde8392dbf79b1457fd4c0  gcc/testsuite/ada/acats-3/tests/c3/c34007r.ada
! 430fadbb7eb89cad332156a43a1cb8a6  gcc/testsuite/ada/acats-3/tests/c3/c34007s.ada
! 142cd26f56dbefa8cc40ce318e93574b  gcc/testsuite/ada/acats-3/tests/c3/c34007u.ada
! 01aa55423bd6286a768cfbc7951408e9  gcc/testsuite/ada/acats-3/tests/c3/c34007v.ada
! 511c5e7943ba2a51ce38527bbf116d2d  gcc/testsuite/ada/acats-3/tests/c3/c34008a.ada
! 9e896dcd16ce62c70c03b6105de6b94c  gcc/testsuite/ada/acats-3/tests/c3/c34009a.ada
! be1b3bebe697fb006bf9a558f3b0f788  gcc/testsuite/ada/acats-3/tests/c3/c34009d.ada
! 5880284be01f48d40969f18306c94edd  gcc/testsuite/ada/acats-3/tests/c3/c34009f.ada
! 679004960f5e177505b2aff13c637ebf  gcc/testsuite/ada/acats-3/tests/c3/c34009g.ada
! f60aa89944e52f4dca47047e08990f29  gcc/testsuite/ada/acats-3/tests/c3/c34009j.ada
! 28351985ca5afb785bccaaf7463d1f32  gcc/testsuite/ada/acats-3/tests/c3/c34009l.ada
! 221f9bd08976154a0a22e9948d8ac7e0  gcc/testsuite/ada/acats-3/tests/c3/c34011b.ada
! f2175e26a65dbd70c186e6acf1001755  gcc/testsuite/ada/acats-3/tests/c3/c34012a.ada
! bdde2c516616684b5fe414550d8400ee  gcc/testsuite/ada/acats-3/tests/c3/c34014a.ada
! 4e8100382b8141c0d056a9fe870b8d06  gcc/testsuite/ada/acats-3/tests/c3/c34014c.ada
! a8fbccc7b3c28981b57a867a1edabf5d  gcc/testsuite/ada/acats-3/tests/c3/c34014e.ada
! 75cb51a9c469066a67228b04e8ba11fc  gcc/testsuite/ada/acats-3/tests/c3/c34014g.ada
! da007fc8719ca70057c035beb9fda7fe  gcc/testsuite/ada/acats-3/tests/c3/c34014h.ada
! dbcb5a07736736af9834d2938b24e483  gcc/testsuite/ada/acats-3/tests/c3/c34014n.ada
! afbaca6a68812eaecf17a8eef2a6346e  gcc/testsuite/ada/acats-3/tests/c3/c34014p.ada
! df14c9b4224ce4cf3fd2d8445cbad0f2  gcc/testsuite/ada/acats-3/tests/c3/c34014r.ada
! 03948696a8a2d08faa02588806cd388d  gcc/testsuite/ada/acats-3/tests/c3/c34014t.ada
! 7258de51f19cfc9506908221af84e01f  gcc/testsuite/ada/acats-3/tests/c3/c34014u.ada
! 360330a2a81712d1ed00c02cbc5e6526  gcc/testsuite/ada/acats-3/tests/c3/c34018a.ada
! a943a89b3032146b53e937f3a73684da  gcc/testsuite/ada/acats-3/tests/c3/c340a01.a
! 5a38659efe283303f9d22ebc955ae0d0  gcc/testsuite/ada/acats-3/tests/c3/c340a02.a
! f694a602dc4b31baf72c096b6e4fb9d5  gcc/testsuite/ada/acats-3/tests/c3/c341a01.a
! 4ad05d07bd295bd76f3edbc6685ae9b8  gcc/testsuite/ada/acats-3/tests/c3/c341a02.a
! 49408ab274823bacfccd32176c5bc061  gcc/testsuite/ada/acats-3/tests/c3/c341a03.a
! ec207723e08de50ca0964ad3318f8235  gcc/testsuite/ada/acats-3/tests/c3/c341a04.a
! 55b745d015fed5a09de487d8081c09eb  gcc/testsuite/ada/acats-3/tests/c3/c35003a.ada
! 092ff51133e865dad2cd6192506f9980  gcc/testsuite/ada/acats-3/tests/c3/c35003b.ada
! 55caad169adcfa6b58689ceb3dc1d505  gcc/testsuite/ada/acats-3/tests/c3/c35003d.ada
! b2b10d16689d994b421c7f356c4eebe9  gcc/testsuite/ada/acats-3/tests/c3/c35102a.ada
! ca3400d0b805977010a922a33d4fc78c  gcc/testsuite/ada/acats-3/tests/c3/c352001.a
! 6adbf240f9a88c67e6dc4d9a3ae2f449  gcc/testsuite/ada/acats-3/tests/c3/c354002.a
! 1c6bd8c5607c8d83b1fb16cf20b35965  gcc/testsuite/ada/acats-3/tests/c3/c354003.a
! 748d8130bd21629fdee8f30be95ddf20  gcc/testsuite/ada/acats-3/tests/c3/c354004.a
! 831543d10fff09679865a63cb6261690  gcc/testsuite/ada/acats-3/tests/c3/c35502a.ada
! a7c2fa5fc851b6f2ef3d825116c56789  gcc/testsuite/ada/acats-3/tests/c3/c35502b.ada
! 012ae5aa045c7b944677ea749449b75e  gcc/testsuite/ada/acats-3/tests/c3/c35502c.ada
! 66ad3541bdd12f2457bc931410567df2  gcc/testsuite/ada/acats-3/tests/c3/c35502d.tst
! f850859238832c6689133c4b82b2d23a  gcc/testsuite/ada/acats-3/tests/c3/c35502e.ada
! 1ae0d752d4d7089a159ba37533cac440  gcc/testsuite/ada/acats-3/tests/c3/c35502f.tst
! 86636a48b0f16cee1e000cf7cdff2dd3  gcc/testsuite/ada/acats-3/tests/c3/c35502g.ada
! 051f7f33819b5ea42a6810524402160e  gcc/testsuite/ada/acats-3/tests/c3/c35502h.ada
! 4e03c40da8c9f6a6c779600f4bf06f72  gcc/testsuite/ada/acats-3/tests/c3/c35502i.ada
! 0ce71c0ba8fc8137892f8032070143cf  gcc/testsuite/ada/acats-3/tests/c3/c35502j.ada
! 039caaa9e43f4d6e115a8a1f83eeebf1  gcc/testsuite/ada/acats-3/tests/c3/c35502k.ada
! 211eda1bcd28ea4725982c3228537ce8  gcc/testsuite/ada/acats-3/tests/c3/c35502l.ada
! 04a6b32af2cf206734bf10b9c20a1a53  gcc/testsuite/ada/acats-3/tests/c3/c35502m.ada
! 4d2fd9e74373c5a73cc4f819206b0ae4  gcc/testsuite/ada/acats-3/tests/c3/c35502n.ada
! a2f7774ccd8fe3b58f670146427b1f58  gcc/testsuite/ada/acats-3/tests/c3/c35502o.ada
! 244d3a03a5bfb9a02be2cde7af593c88  gcc/testsuite/ada/acats-3/tests/c3/c35502p.ada
! bbea92be5e14aa812d5b0bf50f43ecd2  gcc/testsuite/ada/acats-3/tests/c3/c35503a.ada
! e45620aeea62423f2a72fa98c32c2629  gcc/testsuite/ada/acats-3/tests/c3/c35503b.ada
! 6ff5a195541e611e8f795764a46c96c7  gcc/testsuite/ada/acats-3/tests/c3/c35503c.ada
! ae4f0df020df3fca42928a76d16433e2  gcc/testsuite/ada/acats-3/tests/c3/c35503d.tst
! 2835676122accf27f7f9912ed7f9b38b  gcc/testsuite/ada/acats-3/tests/c3/c35503e.ada
! 18bbb578fe3d479a11c962d128286c04  gcc/testsuite/ada/acats-3/tests/c3/c35503f.tst
! def2f804ca12f62b8b5f42c18fa649c0  gcc/testsuite/ada/acats-3/tests/c3/c35503g.ada
! 082f524dedff546b67bf566735caa1c1  gcc/testsuite/ada/acats-3/tests/c3/c35503h.ada
! 85174a7f410200513d18d173743c7474  gcc/testsuite/ada/acats-3/tests/c3/c35503k.ada
! 57ae4c28160a4dfa61de89bc057c9b02  gcc/testsuite/ada/acats-3/tests/c3/c35503l.ada
! 5fc96deb857ba3b7ec7ee6040f2b7d93  gcc/testsuite/ada/acats-3/tests/c3/c35503o.ada
! 02c17920bbabcf5f472c332ee0439df3  gcc/testsuite/ada/acats-3/tests/c3/c35503p.ada
! 7c0f95cda266f19784cd481570ffcf1a  gcc/testsuite/ada/acats-3/tests/c3/c35504a.ada
! 58ca27427f3b7371702549078677cd48  gcc/testsuite/ada/acats-3/tests/c3/c35504b.ada
! c64ed7ab5ced440f95e39eb0465b431f  gcc/testsuite/ada/acats-3/tests/c3/c35505c.ada
! 8a20049a7aa4dbf5e73f4a4a856df916  gcc/testsuite/ada/acats-3/tests/c3/c35505e.ada
! fb8432e5868c1977e525882401096430  gcc/testsuite/ada/acats-3/tests/c3/c35505f.ada
! a3d1f58b38d0f57e89521134057aa0d0  gcc/testsuite/ada/acats-3/tests/c3/c35507a.ada
! fe46e6e48a084e26027a960dcecf0e7f  gcc/testsuite/ada/acats-3/tests/c3/c35507b.ada
! 6276ac14d36049ca6fc1d65937918d6d  gcc/testsuite/ada/acats-3/tests/c3/c35507c.ada
! 38f75633d1d28c38660ac311815075c6  gcc/testsuite/ada/acats-3/tests/c3/c35507e.ada
! 068b315520036392da2decdadf03f6c9  gcc/testsuite/ada/acats-3/tests/c3/c35507g.ada
! c2e6c5681cde5371d2678d0afe2a7dbc  gcc/testsuite/ada/acats-3/tests/c3/c35507h.ada
! 63dad9c02cf9b0faee9f7a4c8f1e9e2d  gcc/testsuite/ada/acats-3/tests/c3/c35507i.ada
! 1501d4b22ff6ada18bda2bec24e23c79  gcc/testsuite/ada/acats-3/tests/c3/c35507j.ada
! 09885e80b2822b3187740ca5682c20e8  gcc/testsuite/ada/acats-3/tests/c3/c35507k.ada
! 7cef3fe8bb6274e0323e822d047490b2  gcc/testsuite/ada/acats-3/tests/c3/c35507l.ada
! b1e4ee7af4f56f20553663a9e296595e  gcc/testsuite/ada/acats-3/tests/c3/c35507m.ada
! cecbaaea0b8f341a4305a221c28843fc  gcc/testsuite/ada/acats-3/tests/c3/c35507n.ada
! 52e0a241e2ad05fa89ecb293e6e2445a  gcc/testsuite/ada/acats-3/tests/c3/c35507o.ada
! 600e023fcb478381f0a8d0bde64f42ce  gcc/testsuite/ada/acats-3/tests/c3/c35507p.ada
! f33cc8ac90e96b7b226aaec5ae692195  gcc/testsuite/ada/acats-3/tests/c3/c35508a.ada
! 7e48a5fa6e02b3658f287da356b209f9  gcc/testsuite/ada/acats-3/tests/c3/c35508b.ada
! 4b6b6e92f28c0ad3cd4f67af8ad0c06c  gcc/testsuite/ada/acats-3/tests/c3/c35508c.ada
! 8bbddf95307b94ae0ed7e12152746762  gcc/testsuite/ada/acats-3/tests/c3/c35508e.ada
! dbe54ec8ce5e33dd88ae24a43cfde531  gcc/testsuite/ada/acats-3/tests/c3/c35508g.ada
! e637f96ce7f08585f2d85fee50f734ee  gcc/testsuite/ada/acats-3/tests/c3/c35508h.ada
! 362619ef40ffff0fd56dee7a6a6c51ab  gcc/testsuite/ada/acats-3/tests/c3/c35508k.ada
! 62ca0e421d4722ad32f139648ece0a60  gcc/testsuite/ada/acats-3/tests/c3/c35508l.ada
! fab2b9fed9304046c3feed68fb9e7b50  gcc/testsuite/ada/acats-3/tests/c3/c35508o.ada
! a7e4e9b85072c7fc56cd223463426c4d  gcc/testsuite/ada/acats-3/tests/c3/c35508p.ada
! bb15d1d296a4eddc9aada6a363360729  gcc/testsuite/ada/acats-3/tests/c3/c35703a.ada
! 97d3b53eb2177ea6344c1ef49c98377d  gcc/testsuite/ada/acats-3/tests/c3/c35704a.ada
! 5a690257e776d58a4fd2a23a7ba6c0e9  gcc/testsuite/ada/acats-3/tests/c3/c35704b.ada
! 52a2a628059a70786108ace7ccd9d08f  gcc/testsuite/ada/acats-3/tests/c3/c35704c.ada
! 14756c69c53e152b3ede55a2754a4d33  gcc/testsuite/ada/acats-3/tests/c3/c35704d.ada
! 22b7d640a1b7ab1933a5654507ff5814  gcc/testsuite/ada/acats-3/tests/c3/c35801d.ada
! 23943917f960018ecdfb861e2c69b545  gcc/testsuite/ada/acats-3/tests/c3/c35902d.ada
! 1e5392accfe4bd85f17ca7c456747be3  gcc/testsuite/ada/acats-3/tests/c3/c35904a.ada
! 4c8ee2a79f1878dcbca7246e9e436865  gcc/testsuite/ada/acats-3/tests/c3/c35904b.ada
! 73fbf4f7e465d5d7fdbee3c99d7cf9ec  gcc/testsuite/ada/acats-3/tests/c3/c35a02a.ada
! 9f8c6fe2edc1ad0a78efbb5038b9ef99  gcc/testsuite/ada/acats-3/tests/c3/c35a05a.ada
! 57fc2536f06ceaf5a1604ee5bb5605fd  gcc/testsuite/ada/acats-3/tests/c3/c35a05d.ada
! ccf547732379c7144c27839f695e8a78  gcc/testsuite/ada/acats-3/tests/c3/c35a05n.ada
! ef904f577e7d9c35099e7d144f51bcce  gcc/testsuite/ada/acats-3/tests/c3/c35a05q.ada
! 3682cd83d6b388849e97129de990f52d  gcc/testsuite/ada/acats-3/tests/c3/c35a07a.ada
! 03e887c344e6bdbdb22118ff77b769fd  gcc/testsuite/ada/acats-3/tests/c3/c35a07d.ada
! ccdad741543d79671fc5f73037ff418d  gcc/testsuite/ada/acats-3/tests/c3/c35a08b.ada
! 651df98436a6167a850f437a29dc7a94  gcc/testsuite/ada/acats-3/tests/c3/c360002.a
! a4c274a3e03fe30e6bc786063bfe78e9  gcc/testsuite/ada/acats-3/tests/c3/c36104a.ada
! b016b5195b1a9d3c07192416c89e1bee  gcc/testsuite/ada/acats-3/tests/c3/c36104b.ada
! 43912684d172c672071ee16d854bcff0  gcc/testsuite/ada/acats-3/tests/c3/c36172a.ada
! 2dc69a4f44addfae37b13335df258285  gcc/testsuite/ada/acats-3/tests/c3/c36172b.ada
! 4d07671447e230f3eddc684c6a3b557a  gcc/testsuite/ada/acats-3/tests/c3/c36172c.ada
! 38a8a16720ac5a8741105f6c5f506f2d  gcc/testsuite/ada/acats-3/tests/c3/c36174a.ada
! 87012e291c8acd51799d9ca8b8fccc32  gcc/testsuite/ada/acats-3/tests/c3/c36180a.ada
! f887210d32ff420cd8ec888ca5c13b66  gcc/testsuite/ada/acats-3/tests/c3/c36202c.ada
! c48c400b884ae534788fbff1510b95ba  gcc/testsuite/ada/acats-3/tests/c3/c36203a.ada
! 93d36d6ba5a23a2f985cc842911a6b2f  gcc/testsuite/ada/acats-3/tests/c3/c36204a.ada
! 5ae3804a2577f9be85df4c11dd1ba3ab  gcc/testsuite/ada/acats-3/tests/c3/c36204b.ada
! 95f946b45603237266057103729c0a9c  gcc/testsuite/ada/acats-3/tests/c3/c36204c.ada
! 1a555d9bc9de255c02e401d7956a5f67  gcc/testsuite/ada/acats-3/tests/c3/c36204d.ada
! c5d2782fd60778b2578f9cf486e811db  gcc/testsuite/ada/acats-3/tests/c3/c36205a.ada
! 4842fc730e500b00c7c35f4691be2855  gcc/testsuite/ada/acats-3/tests/c3/c36205b.ada
! 725f9fbf3157baa9a668acc5e689a06b  gcc/testsuite/ada/acats-3/tests/c3/c36205c.ada
! a9d6124e64589b143b6b54d575df431b  gcc/testsuite/ada/acats-3/tests/c3/c36205d.ada
! c016e1338001bb0d007af7bf4e20d911  gcc/testsuite/ada/acats-3/tests/c3/c36205e.ada
! 299e459d577a85781464563cd621f1b4  gcc/testsuite/ada/acats-3/tests/c3/c36205f.ada
! 7f182ba91c9a0f80d0e5e5b7e919ac56  gcc/testsuite/ada/acats-3/tests/c3/c36205g.ada
! 7559d4ebfc8d9c23879d2cc42d3ac0f4  gcc/testsuite/ada/acats-3/tests/c3/c36205h.ada
! d11eed873d3f614674f193f130b127bb  gcc/testsuite/ada/acats-3/tests/c3/c36205i.ada
! 65b17684e8953d820a69eb11dc4d63e4  gcc/testsuite/ada/acats-3/tests/c3/c36205j.ada
! 21f3a9a788ac6136e2b453f0fc99959f  gcc/testsuite/ada/acats-3/tests/c3/c36205k.ada
! 9884f944a4c4faaee8aaf09a92235c3a  gcc/testsuite/ada/acats-3/tests/c3/c36205l.ada
! 1552dfb23215604db6043c7d12dfc7a6  gcc/testsuite/ada/acats-3/tests/c3/c36301a.ada
! eb37821c1c0e190f8c8cd0e7d282bc9e  gcc/testsuite/ada/acats-3/tests/c3/c36301b.ada
! 236dab07c2bafa07e92d082fc822c8b4  gcc/testsuite/ada/acats-3/tests/c3/c36302a.ada
! a1b4d4c17da94ac478b85b56fd32bf91  gcc/testsuite/ada/acats-3/tests/c3/c36304a.ada
! 58595c82c4f76f6be31333ec0267a9c8  gcc/testsuite/ada/acats-3/tests/c3/c36305a.ada
! 871a3ce65e5d5a824131380a060f18e0  gcc/testsuite/ada/acats-3/tests/c3/c37002a.ada
! 8415fb7acaf9ab73e2a230b45778e7c8  gcc/testsuite/ada/acats-3/tests/c3/c37003a.ada
! b93e53c5cd23520b5b0b88e8c4aee165  gcc/testsuite/ada/acats-3/tests/c3/c37003b.ada
! 0396184f11f01fdd09e40a2432a7850c  gcc/testsuite/ada/acats-3/tests/c3/c37005a.ada
! 17dc351de12194e77f5fe4b5ffbc733e  gcc/testsuite/ada/acats-3/tests/c3/c37006a.ada
! 96813863f2ee2182c3f68f999a7ffed2  gcc/testsuite/ada/acats-3/tests/c3/c37008a.ada
! 9f784c997bf1bb09fe9bf639408dd25c  gcc/testsuite/ada/acats-3/tests/c3/c37008b.ada
! 5d7d0f22be016c0f9b4bcb1da25ed1a2  gcc/testsuite/ada/acats-3/tests/c3/c37009a.ada
! ffc6187aa3ecc28b0631a384e1f95a7e  gcc/testsuite/ada/acats-3/tests/c3/c37010a.ada
! 029c8fb134594e913fe650a5763a4515  gcc/testsuite/ada/acats-3/tests/c3/c37010b.ada
! 09e452317c2c5a3df881f8bfc5bad1ca  gcc/testsuite/ada/acats-3/tests/c3/c371001.a
! 194d5579b14c8d78edccb4725e786bbb  gcc/testsuite/ada/acats-3/tests/c3/c371002.a
! 6508ac6c82ccaf89245ddeb239cf8c65  gcc/testsuite/ada/acats-3/tests/c3/c371003.a
! efcbd19428af8ce2430d60f7389f98f7  gcc/testsuite/ada/acats-3/tests/c3/c37102b.ada
! b56d339ed47321b90862af1e6ff54f3c  gcc/testsuite/ada/acats-3/tests/c3/c37103a.ada
! d2b9a9804b8282550c3233d4c850e203  gcc/testsuite/ada/acats-3/tests/c3/c37105a.ada
! dff6fe14498b4430a005271952b8508b  gcc/testsuite/ada/acats-3/tests/c3/c37107a.ada
! cab8fff51d9e7fa6be5dc3722f0805a7  gcc/testsuite/ada/acats-3/tests/c3/c37108b.ada
! ac1c74612e7098a8b3c19c4233f91b36  gcc/testsuite/ada/acats-3/tests/c3/c37206a.ada
! da4a6484624a6563a3acad74e59e553f  gcc/testsuite/ada/acats-3/tests/c3/c37207a.ada
! 793d448b9373aca3bdfbeb16c4cd5664  gcc/testsuite/ada/acats-3/tests/c3/c37208a.ada
! 19e934b5c86da61793fb4bde9faf4f4a  gcc/testsuite/ada/acats-3/tests/c3/c37208b.ada
! cfc2d39b74fd2d6964787190ac03afde  gcc/testsuite/ada/acats-3/tests/c3/c37209a.ada
! a9e5da6e96624ea9e8d99c31a879bea0  gcc/testsuite/ada/acats-3/tests/c3/c37209b.ada
! 5095a03dbf61f1c7486ce4249ebd4168  gcc/testsuite/ada/acats-3/tests/c3/c37210a.ada
! 13fd1f169bebade45dcc8f783c4dfba5  gcc/testsuite/ada/acats-3/tests/c3/c37211a.ada
! 90539e4b0a8ab5a720d93e61332d4bad  gcc/testsuite/ada/acats-3/tests/c3/c37211b.ada
! b5fb0f0cfa820aa9c8f8a02529b59ae1  gcc/testsuite/ada/acats-3/tests/c3/c37211c.ada
! 34158bf765252e909102a5071bd1ab0d  gcc/testsuite/ada/acats-3/tests/c3/c37211d.ada
! 9723d82d289b6c708a4e38619a050c44  gcc/testsuite/ada/acats-3/tests/c3/c37211e.ada
! 02567718a426a27f1633a5ba46fb39ea  gcc/testsuite/ada/acats-3/tests/c3/c37213b.ada
! 0db6468aa3789fa4eb8509864bbbba6c  gcc/testsuite/ada/acats-3/tests/c3/c37213d.ada
! c3ea989d669b26ad147ec1d36d59f8b1  gcc/testsuite/ada/acats-3/tests/c3/c37213f.ada
! c7d6b08bb4739fe27a9bf7c37153611b  gcc/testsuite/ada/acats-3/tests/c3/c37213h.ada
! e1a81fd713875796f8f0f1d1d856df2e  gcc/testsuite/ada/acats-3/tests/c3/c37213j.ada
! 8824529732962a1fb9cbd428d01a57f5  gcc/testsuite/ada/acats-3/tests/c3/c37213k.ada
! 7c2df003cd7fdc0bffaa00b7e5a76295  gcc/testsuite/ada/acats-3/tests/c3/c37213l.ada
! d1bb01398cfb6ee5cd12ec89604227fb  gcc/testsuite/ada/acats-3/tests/c3/c37215b.ada
! f34c6fc15658b1b04a69e1ccf32c7394  gcc/testsuite/ada/acats-3/tests/c3/c37215d.ada
! ca62cbc7b583fe934a8091c539e55305  gcc/testsuite/ada/acats-3/tests/c3/c37215f.ada
! 8be60a6919ae5d9ba615eb624746100d  gcc/testsuite/ada/acats-3/tests/c3/c37215h.ada
! fdd60b015f299bfc5d8e0f9f33334f8e  gcc/testsuite/ada/acats-3/tests/c3/c37217a.ada
! bb84ce5410a8c6c7127939120ba80cde  gcc/testsuite/ada/acats-3/tests/c3/c37217b.ada
! 2687c3f166eabbae25fc5e04880d06a3  gcc/testsuite/ada/acats-3/tests/c3/c37217c.ada
! db9ca52d8b1a818e4d66aea96b3eb964  gcc/testsuite/ada/acats-3/tests/c3/c37304a.ada
! 59413b6b57aae9caadc41c111c74faed  gcc/testsuite/ada/acats-3/tests/c3/c37305a.ada
! 2ff906f6262ecd1cfdaffbcda07f1a76  gcc/testsuite/ada/acats-3/tests/c3/c37306a.ada
! a6f2da7b55ad908aebb841bc6ed9b69e  gcc/testsuite/ada/acats-3/tests/c3/c37309a.ada
! 54ec04c8663d10e960eb022fed3a9306  gcc/testsuite/ada/acats-3/tests/c3/c37310a.ada
! ab733e44603296f9e49a292ad601cf74  gcc/testsuite/ada/acats-3/tests/c3/c37312a.ada
! 75ac97c1a116dcc5edcc7f2b44f304f4  gcc/testsuite/ada/acats-3/tests/c3/c37402a.ada
! 2d432b792b7c7b0669844add896bb802  gcc/testsuite/ada/acats-3/tests/c3/c37403a.ada
! 38ed181e9e32218f4a81d412e83c503d  gcc/testsuite/ada/acats-3/tests/c3/c37404a.ada
! c1cce1fda9f9c6085ecce4e278182d6c  gcc/testsuite/ada/acats-3/tests/c3/c37404b.ada
! c9abb9613df5a6b0ab399a10551d5070  gcc/testsuite/ada/acats-3/tests/c3/c37405a.ada
! 1793c94eca80b29526f7ec7a9da864e8  gcc/testsuite/ada/acats-3/tests/c3/c37411a.ada
! 3d8871a14f5b0b92ab5699036c27161b  gcc/testsuite/ada/acats-3/tests/c3/c380001.a
! fe1bbd01b7e70108e4de5854ee4c098d  gcc/testsuite/ada/acats-3/tests/c3/c380002.a
! fb52cd7cb9118b93afa2bc8a309ecdc9  gcc/testsuite/ada/acats-3/tests/c3/c380003.a
! 7e465d24377190b6eaafcc3fd3125ff9  gcc/testsuite/ada/acats-3/tests/c3/c380004.a
! c76f2865cda03e9d5c2164052031d578  gcc/testsuite/ada/acats-3/tests/c3/c38002a.ada
! 5c8aaef6a8da893998485cc8bfb71f48  gcc/testsuite/ada/acats-3/tests/c3/c38002b.ada
! f8397d669785d9d911c494e0a0b9986a  gcc/testsuite/ada/acats-3/tests/c3/c38005a.ada
! 36a372c2d5368726208b1f76f95f3c1d  gcc/testsuite/ada/acats-3/tests/c3/c38005b.ada
! 175ff60b11884803275c5a95d4db9b0f  gcc/testsuite/ada/acats-3/tests/c3/c38005c.ada
! cc457354e31fc1e63179de33cbefbad9  gcc/testsuite/ada/acats-3/tests/c3/c38102a.ada
! 2f60ee39cadeb5e04f93c0fb98c2ff78  gcc/testsuite/ada/acats-3/tests/c3/c38102b.ada
! 773c45b11f80bfa2c11a621982312a41  gcc/testsuite/ada/acats-3/tests/c3/c38102c.ada
! 2eec2f09807572ff6be386c41f2aa890  gcc/testsuite/ada/acats-3/tests/c3/c38102d.ada
! ff2ae7294328aba3ca946b298ff89249  gcc/testsuite/ada/acats-3/tests/c3/c38102e.ada
! 19d2c8a98b84fc28fb173b8ede249f5f  gcc/testsuite/ada/acats-3/tests/c3/c38104a.ada
! ccdff83c46a0742a6f6c98f395885cf0  gcc/testsuite/ada/acats-3/tests/c3/c38107a.ada
! 5b807a368e5b577c901a0143b328edd6  gcc/testsuite/ada/acats-3/tests/c3/c38107b.ada
! 7f519d74032c869b16bf7e4cc3f1757c  gcc/testsuite/ada/acats-3/tests/c3/c38108a.ada
! 1cdb4b2554cc632c2786a14302f39123  gcc/testsuite/ada/acats-3/tests/c3/c38108b.ada
! 0c83db01ff09f439f6a7fc807e878547  gcc/testsuite/ada/acats-3/tests/c3/c38108c0.ada
! 0b0a2c9346188afcf5a240958d58cb60  gcc/testsuite/ada/acats-3/tests/c3/c38108c1.ada
! 1cea347b513b856254a8e9fed08d945a  gcc/testsuite/ada/acats-3/tests/c3/c38108c2.ada
! fb749693f49b0edcfffc4444290ac564  gcc/testsuite/ada/acats-3/tests/c3/c38108d0.ada
! aa2833688968ca7a3e36612070b575f4  gcc/testsuite/ada/acats-3/tests/c3/c38108d1.ada
! 61680b9ec1c444c4faffd8c59cce698a  gcc/testsuite/ada/acats-3/tests/c3/c3900010.a
! 987d00ae68ea07578bf45fc567352a66  gcc/testsuite/ada/acats-3/tests/c3/c3900011.am
! 370d5eba0eee3ce909caf87c342f846d  gcc/testsuite/ada/acats-3/tests/c3/c390002.a
! 6dd703dff40d77030a2c6329094e7802  gcc/testsuite/ada/acats-3/tests/c3/c390003.a
! 491d840ce3aeb642239cc28533a9ba34  gcc/testsuite/ada/acats-3/tests/c3/c390004.a
! b04ffb8d071dcf6547533038ef227651  gcc/testsuite/ada/acats-3/tests/c3/c3900050.a
! dff18ad9fb367bc37acd04d6e08e55bf  gcc/testsuite/ada/acats-3/tests/c3/c3900051.a
! 2b39948b2af313cbed0046a2bcdcbc9d  gcc/testsuite/ada/acats-3/tests/c3/c3900052.a
! b4e44c9c1971345223585500a55db164  gcc/testsuite/ada/acats-3/tests/c3/c3900053.am
! 471e818df49cf1a32357c5b759d21dc9  gcc/testsuite/ada/acats-3/tests/c3/c3900060.a
! bd65238f7cda09d91e177736cdbcd7ec  gcc/testsuite/ada/acats-3/tests/c3/c3900061.a
! d3e9ddf4af2eb46f1b086dbc43c75d04  gcc/testsuite/ada/acats-3/tests/c3/c3900062.a
! bced3ae0c872e2f15b26193b1c9c4c35  gcc/testsuite/ada/acats-3/tests/c3/c3900063.am
! cd1ae54278fd1b61d5ecd166ecf0671b  gcc/testsuite/ada/acats-3/tests/c3/c390007.a
! a7cf99b62949613099d6c982d9043098  gcc/testsuite/ada/acats-3/tests/c3/c390010.a
! 30e5b9a42c18864d89a931830adfd68e  gcc/testsuite/ada/acats-3/tests/c3/c390011.a
! fb81397d707bf07d8e9f486812adb73b  gcc/testsuite/ada/acats-3/tests/c3/c390012.a
! 1bcaf1b15ae617d49c80e68b55943cc6  gcc/testsuite/ada/acats-3/tests/c3/c39006a.ada
! 7e954943167e1f1855ce0abf856c9a9b  gcc/testsuite/ada/acats-3/tests/c3/c39006b.ada
! 14d52be4c2d938b4ae51c17507b6ca25  gcc/testsuite/ada/acats-3/tests/c3/c39006c0.ada
! c770912acdec8d8fa7169157d99a1382  gcc/testsuite/ada/acats-3/tests/c3/c39006c1.ada
! fcf5b4e7ecc49a79fc11640baf53f4f6  gcc/testsuite/ada/acats-3/tests/c3/c39006d.ada
! 86ddd0b2d946750357311d89b5046963  gcc/testsuite/ada/acats-3/tests/c3/c39006e.ada
! ba4887d359d62403c79f3563b0dfa8f4  gcc/testsuite/ada/acats-3/tests/c3/c39006f0.ada
! 205b6ff97343a4403e8cb5bc33883547  gcc/testsuite/ada/acats-3/tests/c3/c39006f1.ada
! 16ddc19c6da0a1642305e4b5fc6058d1  gcc/testsuite/ada/acats-3/tests/c3/c39006f2.ada
! 59cfdb727f33418fa8de537e14629d71  gcc/testsuite/ada/acats-3/tests/c3/c39006f3.ada
! f80f760d35130556602f0b683e480d63  gcc/testsuite/ada/acats-3/tests/c3/c39006g.ada
! cce3352413b69fd05b5ec5195c3a4c00  gcc/testsuite/ada/acats-3/tests/c3/c39007a.ada
! eab8b6c595bc019ed0d33f826e34e97f  gcc/testsuite/ada/acats-3/tests/c3/c39007b.ada
! f9502bdaffb8475b46fab174a19f2de9  gcc/testsuite/ada/acats-3/tests/c3/c39008a.ada
! 44f9dead72582206f122372b79949f92  gcc/testsuite/ada/acats-3/tests/c3/c39008b.ada
! f7c867df153c4137ff42c73e84cf78bb  gcc/testsuite/ada/acats-3/tests/c3/c39008c.ada
! 7dfc2d2eea8f430d414e0e9fb3d66efb  gcc/testsuite/ada/acats-3/tests/c3/c390a010.a
! fe7593d56cc6f8290c29978513afc0e4  gcc/testsuite/ada/acats-3/tests/c3/c390a011.am
! 11b0510a4ce65e5a57a44f990501c66a  gcc/testsuite/ada/acats-3/tests/c3/c390a020.a
! 4282bd0ba35b056f1611e8c863c8745e  gcc/testsuite/ada/acats-3/tests/c3/c390a021.a
! cf96da721f34cf963ac9c04fdedb4a5a  gcc/testsuite/ada/acats-3/tests/c3/c390a022.am
! 9cc816e53154c542095db060de988727  gcc/testsuite/ada/acats-3/tests/c3/c390a030.a
! a2ad2209c88d74fd376c9daf08c00e0c  gcc/testsuite/ada/acats-3/tests/c3/c390a031.am
! 40bd1c7f8a70fb208644304788e8bdc6  gcc/testsuite/ada/acats-3/tests/c3/c391001.a
! 2dc32344161fe05900a7d0a4fb00a90b  gcc/testsuite/ada/acats-3/tests/c3/c391002.a
! 3ba7e427374883e2149341da53946561  gcc/testsuite/ada/acats-3/tests/c3/c391003.a
! 1cea1692179d434f0ff9e71ba3af5c1e  gcc/testsuite/ada/acats-3/tests/c3/c392002.a
! 918e8c097a09a06159f2809df40a1418  gcc/testsuite/ada/acats-3/tests/c3/c392003.a
! 65856b8c6fecfcf755607b20116e49ef  gcc/testsuite/ada/acats-3/tests/c3/c392004.a
! add1a6bb172c420d5b75dd9efb48c6bd  gcc/testsuite/ada/acats-3/tests/c3/c392005.a
! 1e3c83f529cb7a93f087fd5e1d1c8da3  gcc/testsuite/ada/acats-3/tests/c3/c392008.a
! 8db6e39b87567029879790dbb400a21a  gcc/testsuite/ada/acats-3/tests/c3/c392010.a
! 8063c17c7054236de05a0d6a56818802  gcc/testsuite/ada/acats-3/tests/c3/c392011.a
! 66f6cf830b25e4cba2aeaac6801b02e2  gcc/testsuite/ada/acats-3/tests/c3/c392013.a
! 3597acb12cde69e45603917fc97c80c0  gcc/testsuite/ada/acats-3/tests/c3/c392014.a
! 37df1e5c85d31f578424e4da3238380f  gcc/testsuite/ada/acats-3/tests/c3/c392015.a
! 35f1f390e8606d404b61bb05a639d3be  gcc/testsuite/ada/acats-3/tests/c3/c392a01.a
! ddeb268075e3a716a055f61676497b78  gcc/testsuite/ada/acats-3/tests/c3/c392c05.a
! ee8edde3e11e29c877773403259133c0  gcc/testsuite/ada/acats-3/tests/c3/c392c07.a
! cf19325c05dcb02f4dc60d58ef26ea2b  gcc/testsuite/ada/acats-3/tests/c3/c392d01.a
! acfb41d6d4b4fdec20be56da91d7037d  gcc/testsuite/ada/acats-3/tests/c3/c392d02.a
! 1db19d15d9fdd4071bc438e73f6c5f60  gcc/testsuite/ada/acats-3/tests/c3/c392d03.a
! 9913afe2e224eb447dd2ba6e7b6cd62d  gcc/testsuite/ada/acats-3/tests/c3/c393001.a
! cb66f262f22e933b78a4b4ff7f314ebb  gcc/testsuite/ada/acats-3/tests/c3/c393007.a
! fa7a91fbda6d3ec270401392bfa2a76e  gcc/testsuite/ada/acats-3/tests/c3/c393008.a
! 725749e586aef7b3172e0a9f654508c9  gcc/testsuite/ada/acats-3/tests/c3/c393009.a
! 21bc1c6b2b56e0fe4e98a124b3a43036  gcc/testsuite/ada/acats-3/tests/c3/c393010.a
! cd6d2722ead0dbebda558b3eed5c7ca4  gcc/testsuite/ada/acats-3/tests/c3/c393011.a
! 7df68c4f3488082bba3f1654a9ba7910  gcc/testsuite/ada/acats-3/tests/c3/c393012.a
! 7a6224b076104b0746f9373372e9765f  gcc/testsuite/ada/acats-3/tests/c3/c393013.a
! 5bf5e79116361f7f6818018607c7b14c  gcc/testsuite/ada/acats-3/tests/c3/c393a02.a
! 46faa2017a32e6ba0d55237311c2594b  gcc/testsuite/ada/acats-3/tests/c3/c393a03.a
! eafd936400d5d6d12f0163e2eddfac6b  gcc/testsuite/ada/acats-3/tests/c3/c393a05.a
! db0cccf9a144062cc832a2649c8b3890  gcc/testsuite/ada/acats-3/tests/c3/c393a06.a
! 8714b97cca38041a9f7e9366aef2ea6f  gcc/testsuite/ada/acats-3/tests/c3/c393b12.a
! 7035657702431ed63b2d07b818986f02  gcc/testsuite/ada/acats-3/tests/c3/c393b13.a
! 53c07ae14d9fb175ce43218b1e343038  gcc/testsuite/ada/acats-3/tests/c3/c393b14.a
! f5434c7e784d26f4723543d890baf070  gcc/testsuite/ada/acats-3/tests/c3/c394001.a
! f0d03a4cc11f4c5a3e849900d93ce5b5  gcc/testsuite/ada/acats-3/tests/c3/c394002.a
! bd76c737ec2888a6256a5b5fc62f5044  gcc/testsuite/ada/acats-3/tests/c3/c394003.a
! c2ac600ac5856ef7dd1dbc9289ad5b3a  gcc/testsuite/ada/acats-3/tests/c3/c3a0001.a
! 031b3fc5f0a32a51bded67c7ecc17317  gcc/testsuite/ada/acats-3/tests/c3/c3a0002.a
! c31f440d35b722f58fbb9350b06d125c  gcc/testsuite/ada/acats-3/tests/c3/c3a0003.a
! 2297f4ac861d78f2371edd9c4a2d7c6c  gcc/testsuite/ada/acats-3/tests/c3/c3a0004.a
! 32ac31994b6e97c7cfc3da69b63041ca  gcc/testsuite/ada/acats-3/tests/c3/c3a0005.a
! d86e5a6cc083a8024c11012097ddad34  gcc/testsuite/ada/acats-3/tests/c3/c3a0006.a
! 27a88a8b1aa1655fbfad671608eb6590  gcc/testsuite/ada/acats-3/tests/c3/c3a0007.a
! 2c75b971c54a5abc55846c25177a2d32  gcc/testsuite/ada/acats-3/tests/c3/c3a0008.a
! 0b8bb10fc6969853e244dca2a5176000  gcc/testsuite/ada/acats-3/tests/c3/c3a0009.a
! ed1e9211c87a814c4afe091b58de454c  gcc/testsuite/ada/acats-3/tests/c3/c3a0010.a
! e9e7d7fe8183ee50353cfccbd67ce241  gcc/testsuite/ada/acats-3/tests/c3/c3a0011.a
! c7fcc74fd4dfdbaffcb6c91b90a50060  gcc/testsuite/ada/acats-3/tests/c3/c3a00120.a
! 74ba294edd61c27b3a700c248bd041e9  gcc/testsuite/ada/acats-3/tests/c3/c3a00121.a
! b5687449024e6ae74c2b54cbbf12b721  gcc/testsuite/ada/acats-3/tests/c3/c3a00122.am
! e7d92335b6aec84b884e9a11162a306e  gcc/testsuite/ada/acats-3/tests/c3/c3a0013.a
! 8ada1257de16782d00affbb40cba5d0f  gcc/testsuite/ada/acats-3/tests/c3/c3a0014.a
! cbdd24e39ac8fba7e5ea4a0975d79298  gcc/testsuite/ada/acats-3/tests/c3/c3a0015.a
! 83572022417c237e0bb0551e51f4f09a  gcc/testsuite/ada/acats-3/tests/c3/c3a0016.a
! aea69c4eb5f92d59235f2df23e757d14  gcc/testsuite/ada/acats-3/tests/c3/c3a0017.a
! 62fa1c6bf50ac7e11e6bad46452e79ef  gcc/testsuite/ada/acats-3/tests/c3/c3a0018.a
! 4027e27b87c42473853d2165e05c8e0f  gcc/testsuite/ada/acats-3/tests/c3/c3a0019.a
! c8eec5b6a8cb02fdf4b8fc3672950275  gcc/testsuite/ada/acats-3/tests/c3/c3a0020.a
! 876c4cbf6611f889104d7b0572ae8147  gcc/testsuite/ada/acats-3/tests/c3/c3a0021.a
! 05a5719220f88bc16adf5f7d5f2eb478  gcc/testsuite/ada/acats-3/tests/c3/c3a0022.a
! d395a766d1e83cd40c121d287e8dc401  gcc/testsuite/ada/acats-3/tests/c3/c3a0023.a
! 18c72364756781cf037aaa928e0aaf6b  gcc/testsuite/ada/acats-3/tests/c3/c3a0024.a
! 5b7c36b7749cfc424cb0c256201cf255  gcc/testsuite/ada/acats-3/tests/c3/c3a0025.a
! 87c70d07250a7103f096a337328bbc92  gcc/testsuite/ada/acats-3/tests/c3/c3a0026.a
! 607293a26ce7e3e441968e95c9ccbba2  gcc/testsuite/ada/acats-3/tests/c3/c3a0027.a
! 2ddeb89db87fb985e7c9ddfcf080e693  gcc/testsuite/ada/acats-3/tests/c3/c3a0028.a
! f14f848057f112325d4e46ed85b5c3c7  gcc/testsuite/ada/acats-3/tests/c3/c3a0029.a
! 02f44410384ce0414b2ff6c941fa903a  gcc/testsuite/ada/acats-3/tests/c3/c3a0030.a
! 21ce522f0e81e68685347a0f9b6064f3  gcc/testsuite/ada/acats-3/tests/c3/c3a1001.a
! 03f9fa0b3ade6732c9e7b1792aa29352  gcc/testsuite/ada/acats-3/tests/c3/c3a1002.a
! 43871a0be958bf53238bf04d1e2b1d12  gcc/testsuite/ada/acats-3/tests/c3/c3a10030.a
! b3b07306d7f9eff4f7e6b0429dcaa05d  gcc/testsuite/ada/acats-3/tests/c3/c3a10031.a
! 878a0b37cc2f4dcce1e34855977f6aa1  gcc/testsuite/ada/acats-3/tests/c3/c3a10032.am
! cafc593ae60aa9bc20c17d81fae12d87  gcc/testsuite/ada/acats-3/tests/c3/c3a10040.a
! e3bbd65bb943a5000a14047b45073b7b  gcc/testsuite/ada/acats-3/tests/c3/c3a10041.a
! f450d70e7af5a3abaa9e98b51d3dd478  gcc/testsuite/ada/acats-3/tests/c3/c3a10042.am
! 73e86224d17f2a8956a1d528195701e5  gcc/testsuite/ada/acats-3/tests/c3/c3a2001.a
! e2d17cf34da20dd63f46abc38e9461f2  gcc/testsuite/ada/acats-3/tests/c3/c3a2002.a
! 3c24e7e447372dec84c3b1cf5f273936  gcc/testsuite/ada/acats-3/tests/c3/c3a2003.a
! cbeca93d733582989633f82f0909acae  gcc/testsuite/ada/acats-3/tests/c3/c3a2004.a
! cddb5c363c31a2ba7b970cf9dc8e3f5e  gcc/testsuite/ada/acats-3/tests/c3/c3a2a01.a
! 4247f0b657aa158ef18c1318e9dc8b84  gcc/testsuite/ada/acats-3/tests/c3/c3a2a02.a
! 383d36d8bd8f651b81f9f034c79f6395  gcc/testsuite/ada/acats-3/tests/c4/c410001.a
! dc852bc88874efd64494341e97b01bfb  gcc/testsuite/ada/acats-3/tests/c4/c41101d.ada
! 6f5f34a6a9fa1d906503ce64081a9fb1  gcc/testsuite/ada/acats-3/tests/c4/c41103a.ada
! b5e4896d791e9edb4152659fc6403ac3  gcc/testsuite/ada/acats-3/tests/c4/c41103b.ada
! 820fca3a12cccc477a1db295b46c9e89  gcc/testsuite/ada/acats-3/tests/c4/c41104a.ada
! fdbf47ad957484b7d85a3373d756e376  gcc/testsuite/ada/acats-3/tests/c4/c41105a.ada
! c4087c229334ce4727fc90657340bea6  gcc/testsuite/ada/acats-3/tests/c4/c41107a.ada
! 0f8bb517ec2fe5d8ad9dd8f9fcdca333  gcc/testsuite/ada/acats-3/tests/c4/c41201d.ada
! 381cd3656ffd77067260c0426caad8e4  gcc/testsuite/ada/acats-3/tests/c4/c41203a.ada
! ad6cf2964a900435614399bbbe277e42  gcc/testsuite/ada/acats-3/tests/c4/c41203b.ada
! 9fbde81e21b268a632cd32dc4a99df30  gcc/testsuite/ada/acats-3/tests/c4/c41204a.ada
! 67fa52580bd829764d9438c881578136  gcc/testsuite/ada/acats-3/tests/c4/c41205a.ada
! 7dca543b0fdeefd218298ca3512d4136  gcc/testsuite/ada/acats-3/tests/c4/c41206a.ada
! 3ab9c169397fc23560a200fb693450fe  gcc/testsuite/ada/acats-3/tests/c4/c41207a.ada
! 17ad22489b459a058eeaf34546fec768  gcc/testsuite/ada/acats-3/tests/c4/c413001.a
! 1b052069034494eeefbb85b95881f7e7  gcc/testsuite/ada/acats-3/tests/c4/c413002.a
! 040de4201fd72e9de123fa9a2143c41d  gcc/testsuite/ada/acats-3/tests/c4/c413003.a
! 4b2fa1ff66b48b9350d8ab977de55848  gcc/testsuite/ada/acats-3/tests/c4/c413004.a
! 6bd3f248a03f035ba1437d5a541753e0  gcc/testsuite/ada/acats-3/tests/c4/c413005.a
! 2615eb7f6f28583edf200225c397e372  gcc/testsuite/ada/acats-3/tests/c4/c413006.a
! 20522dfe7bf33e5e0e855924df96c08e  gcc/testsuite/ada/acats-3/tests/c4/c41301a.ada
! dae21e7962c8e72b1b61657cc9649578  gcc/testsuite/ada/acats-3/tests/c4/c41303a.ada
! b50a855a96988b73e7f3549240854176  gcc/testsuite/ada/acats-3/tests/c4/c41303b.ada
! 2616024a5ab75311dd3da9466dfeb83f  gcc/testsuite/ada/acats-3/tests/c4/c41303c.ada
! 71212110be4b03b467bc38a722d121d1  gcc/testsuite/ada/acats-3/tests/c4/c41303e.ada
! 66cc6334eba1dfed1e235d86203cb20f  gcc/testsuite/ada/acats-3/tests/c4/c41303f.ada
! 924b3910bb06953e81b618bc3e559550  gcc/testsuite/ada/acats-3/tests/c4/c41303g.ada
! 045ed81e249f894170b499df2db286d6  gcc/testsuite/ada/acats-3/tests/c4/c41303i.ada
! aa4db5f52bbfc36e5c975658ef97c89a  gcc/testsuite/ada/acats-3/tests/c4/c41303j.ada
! 0f31fc1511244c83e7abb4baeac80671  gcc/testsuite/ada/acats-3/tests/c4/c41303k.ada
! f9b758389317dc92073ce01c3c275e91  gcc/testsuite/ada/acats-3/tests/c4/c41303m.ada
! 71a865e9509e3725fd95b90ec715eaa7  gcc/testsuite/ada/acats-3/tests/c4/c41303n.ada
! 8981d1c2da09086d412019a04cc8c913  gcc/testsuite/ada/acats-3/tests/c4/c41303o.ada
! 2dda9c55735424d40aed9757f7a99849  gcc/testsuite/ada/acats-3/tests/c4/c41303q.ada
! e34e7a4a5a5ba93bc9916cceeaecc9e6  gcc/testsuite/ada/acats-3/tests/c4/c41303r.ada
! 7030e6ee5fb5761b449dbb4ff5a07765  gcc/testsuite/ada/acats-3/tests/c4/c41303s.ada
! d79eb627645d3853ea5140161ae28128  gcc/testsuite/ada/acats-3/tests/c4/c41303u.ada
! bb6f238e4a4ba7e7e7d4a81bc419e03c  gcc/testsuite/ada/acats-3/tests/c4/c41303v.ada
! 30d2340bbbbe2276772e1fb63e33b4ce  gcc/testsuite/ada/acats-3/tests/c4/c41303w.ada
! 98d29cda44e41c5ff7947a4026f5e44c  gcc/testsuite/ada/acats-3/tests/c4/c41304a.ada
! 185701022ded3608ce413730986fd29a  gcc/testsuite/ada/acats-3/tests/c4/c41304b.ada
! 5dd0f98f04759d0b25f9631bb3f052ba  gcc/testsuite/ada/acats-3/tests/c4/c41306b.ada
! 58245b98892f05598c91a37cc2fa0cf7  gcc/testsuite/ada/acats-3/tests/c4/c41306c.ada
! 78cff154ce4ec882d604897c85256a6f  gcc/testsuite/ada/acats-3/tests/c4/c41307d.ada
! e4f57f60d8ab4020fa02081676cd97b1  gcc/testsuite/ada/acats-3/tests/c4/c41309a.ada
! 46615dd040a05118f00cf1a6c269abf8  gcc/testsuite/ada/acats-3/tests/c4/c41320a.ada
! c87207608b642d6c0770b2213faa6f37  gcc/testsuite/ada/acats-3/tests/c4/c41321a.ada
! a2f1c6ef57f73e8afee4331c2f6b8836  gcc/testsuite/ada/acats-3/tests/c4/c41322a.ada
! 5fe80e1ed0d397d7243803f3679b1dcf  gcc/testsuite/ada/acats-3/tests/c4/c41323a.ada
! 1b628d4729417b726825d3cc545cce88  gcc/testsuite/ada/acats-3/tests/c4/c41324a.ada
! 34bb464a9c0edf77ba3cf3f225f84fac  gcc/testsuite/ada/acats-3/tests/c4/c41325a.ada
! 9f472b4f812b18261355bfdb272afaf2  gcc/testsuite/ada/acats-3/tests/c4/c41326a.ada
! c79f530e375e47fc23508a767283386e  gcc/testsuite/ada/acats-3/tests/c4/c41327a.ada
! 9dbb72dcbb910f44662d1091a9dcff76  gcc/testsuite/ada/acats-3/tests/c4/c41328a.ada
! 0449520de7d65d45ed1daf5ca0e4569b  gcc/testsuite/ada/acats-3/tests/c4/c41401a.ada
! 20918a0804a04dce0cbb4d97b451bb81  gcc/testsuite/ada/acats-3/tests/c4/c41402a.ada
! 3d9dc352053f7bb2142de6aadd56af67  gcc/testsuite/ada/acats-3/tests/c4/c41404a.ada
! 3472f5561c379717f19af41f64bf38a3  gcc/testsuite/ada/acats-3/tests/c4/c420001.a
! 837ffbb47c098000329e8e489cfada64  gcc/testsuite/ada/acats-3/tests/c4/c42006a.ada
! 3930cedf9786c67a42558e65e855c7fd  gcc/testsuite/ada/acats-3/tests/c4/c42007e.ada
! fdfa37c01ec576b222ad3107e9e17cd2  gcc/testsuite/ada/acats-3/tests/c4/c43003a.ada
! 42c7528eba63811a5183af811bdf7a65  gcc/testsuite/ada/acats-3/tests/c4/c43004a.ada
! fdfe754e9fba94c879707660c35c89c4  gcc/testsuite/ada/acats-3/tests/c4/c43004c.ada
! d381bf2fc72e35825723db4655f3c38a  gcc/testsuite/ada/acats-3/tests/c4/c431001.a
! 841914115d2e37bfbd84574493c7019f  gcc/testsuite/ada/acats-3/tests/c4/c43103a.ada
! dd65d5f3b06487b888840af62334c5a5  gcc/testsuite/ada/acats-3/tests/c4/c43103b.ada
! 9e71b6045390013211406d2c1bfb4fba  gcc/testsuite/ada/acats-3/tests/c4/c43104a.ada
! 85abcc7f64ed7b42d6fd3f22c7daeb40  gcc/testsuite/ada/acats-3/tests/c4/c43105a.ada
! 4ed22cb91cfe0bda94598dd26ceb9c7c  gcc/testsuite/ada/acats-3/tests/c4/c43105b.ada
! baec9aa149293739f6e8ceac8325d7a0  gcc/testsuite/ada/acats-3/tests/c4/c43106a.ada
! 1d531018ee649629c5a7552829150451  gcc/testsuite/ada/acats-3/tests/c4/c43107a.ada
! 05a638c334196cb191ee5128a5996f23  gcc/testsuite/ada/acats-3/tests/c4/c43108a.ada
! debcbaad0b35de45ea6e4b666eeea609  gcc/testsuite/ada/acats-3/tests/c4/c431a01.a
! 0f4afa9a95b97dc847470380efc90532  gcc/testsuite/ada/acats-3/tests/c4/c431a02.a
! 65063fafd01ba653c15d798991e31ea3  gcc/testsuite/ada/acats-3/tests/c4/c431a03.a
! 4ea1f6b615b7799500e7c6933df91e82  gcc/testsuite/ada/acats-3/tests/c4/c432001.a
! 1e73ca84bb526fa8947ec4278f0151ed  gcc/testsuite/ada/acats-3/tests/c4/c432002.a
! 6ec2ee48b603324015bd74c07d8eb9fb  gcc/testsuite/ada/acats-3/tests/c4/c432003.a
! 8e738d9db0574dd56f1158230f5caa4c  gcc/testsuite/ada/acats-3/tests/c4/c432004.a
! ccee6b8b7bc155051a378848cc247ecb  gcc/testsuite/ada/acats-3/tests/c4/c432005.a
! ee94ed306c9c2f72d0f353f3242a51db  gcc/testsuite/ada/acats-3/tests/c4/c43204a.ada
! e98c1830d22cb2c31e6c97a0f3d96ad7  gcc/testsuite/ada/acats-3/tests/c4/c43204c.ada
! f0b2f2ebf435459bab0ed10112cc18b6  gcc/testsuite/ada/acats-3/tests/c4/c43204e.ada
! 7e74d89a8654aef2ebf093dc84b24d10  gcc/testsuite/ada/acats-3/tests/c4/c43204f.ada
! b266b1d1eaefa26342ce7e3c0eb10f20  gcc/testsuite/ada/acats-3/tests/c4/c43204g.ada
! 119509db1b0027b3597be4ca5abbb5bb  gcc/testsuite/ada/acats-3/tests/c4/c43204h.ada
! 67b7aebfc7ddaa75b105ec0d3e496a27  gcc/testsuite/ada/acats-3/tests/c4/c43204i.ada
! 73152cdcaa60874a7dd488590fdf9d5c  gcc/testsuite/ada/acats-3/tests/c4/c43205a.ada
! 64f982d0a7b18107f1762424333a65d3  gcc/testsuite/ada/acats-3/tests/c4/c43205b.ada
! ac552917303ade3bcc90b97b15f26e94  gcc/testsuite/ada/acats-3/tests/c4/c43205c.ada
! fb0c33a9daed1c4f2a00c26e9de3c09c  gcc/testsuite/ada/acats-3/tests/c4/c43205d.ada
! d9e706d3db07df4098bbb0e033aed012  gcc/testsuite/ada/acats-3/tests/c4/c43205e.ada
! 4f3634691d02036c149cdd006248ffe1  gcc/testsuite/ada/acats-3/tests/c4/c43205g.ada
! 5c21ffd092ad83125d058e3179c4d1bf  gcc/testsuite/ada/acats-3/tests/c4/c43205h.ada
! bf224ac40af0ffe5b844895ae6ae977a  gcc/testsuite/ada/acats-3/tests/c4/c43205i.ada
! 80a79cdbdb7c8185dcf0428e7589a584  gcc/testsuite/ada/acats-3/tests/c4/c43205j.ada
! 7914df26e752133b470cdb5c585686bc  gcc/testsuite/ada/acats-3/tests/c4/c43205k.ada
! cbadb73b68d71709f2becaa6f356064c  gcc/testsuite/ada/acats-3/tests/c4/c43206a.ada
! 0fc8105e29d6d23a3a7ddd6510322795  gcc/testsuite/ada/acats-3/tests/c4/c43207b.ada
! 97244c88eb0cfebd12378341cddfcf4f  gcc/testsuite/ada/acats-3/tests/c4/c43207d.ada
! f288bdf0f019b0e6deea7f364629093d  gcc/testsuite/ada/acats-3/tests/c4/c43208a.ada
! 99521b78f4e58d62e65acd17c5306220  gcc/testsuite/ada/acats-3/tests/c4/c43208b.ada
! 36f70dc294058acb31101eb9c245937b  gcc/testsuite/ada/acats-3/tests/c4/c43209a.ada
! 31cacbf3a20b821f6eb8f1d74586a51b  gcc/testsuite/ada/acats-3/tests/c4/c43210a.ada
! 54b7270b96a5d5519d2358a1b98bf7af  gcc/testsuite/ada/acats-3/tests/c4/c43211a.ada
! a692660520b9e289a7f0ae27c6d52494  gcc/testsuite/ada/acats-3/tests/c4/c43212a.ada
! c43685e66248fa05c959fb5d231800a7  gcc/testsuite/ada/acats-3/tests/c4/c43212c.ada
! 9427f327bd00f1850a52dc14567dbf4e  gcc/testsuite/ada/acats-3/tests/c4/c43214a.ada
! 2b1a3e33f54f7510083e41b401c3befb  gcc/testsuite/ada/acats-3/tests/c4/c43214b.ada
! 579da18e7294b44fdfc2fb550cccdbf3  gcc/testsuite/ada/acats-3/tests/c4/c43214c.ada
! 506424b9dbd9ff75e61b488ce4a5879e  gcc/testsuite/ada/acats-3/tests/c4/c43214d.ada
! 02fcbb175ddd0a1d8c5564d22bf12428  gcc/testsuite/ada/acats-3/tests/c4/c43214e.ada
! 34cd6d7cf5c8038e227dde683b30b50f  gcc/testsuite/ada/acats-3/tests/c4/c43214f.ada
! ab7bedd7c7899bfe816d9a4b9ac394d4  gcc/testsuite/ada/acats-3/tests/c4/c43215a.ada
! 90e0f447154023e2eab627e883738386  gcc/testsuite/ada/acats-3/tests/c4/c43215b.ada
! f0098152f11a322c39c1479f279dc3d7  gcc/testsuite/ada/acats-3/tests/c4/c43222a.ada
! bf1baa8817f6afb1d613db2046cb78de  gcc/testsuite/ada/acats-3/tests/c4/c43224a.ada
! 1e8e32f41f79462323a2f9d9c83d7939  gcc/testsuite/ada/acats-3/tests/c4/c433001.a
! 6be8523b2e0ccefb268613fe395421ca  gcc/testsuite/ada/acats-3/tests/c4/c433a01.a
! f2b5faadf7994318ad86d30f5d297c77  gcc/testsuite/ada/acats-3/tests/c4/c433a02.a
! e758c7c2655902abd75371fb1d06411d  gcc/testsuite/ada/acats-3/tests/c4/c433a03.a
! 43d476ccf0baa3b45d12a181f1801d72  gcc/testsuite/ada/acats-3/tests/c4/c433a04.a
! 196c158a32a4bc1774a4d934b1a6632e  gcc/testsuite/ada/acats-3/tests/c4/c44003d.ada
! bf440c6d6ead3b13b20d4e127607337e  gcc/testsuite/ada/acats-3/tests/c4/c44003f.ada
! 2f9030320131a08536fa11fa1a117664  gcc/testsuite/ada/acats-3/tests/c4/c44003g.ada
! 62ba7a9a25d025dad4ded263e64d8380  gcc/testsuite/ada/acats-3/tests/c4/c450001.a
! b3687aae227c95d084c9f685c9ca4c80  gcc/testsuite/ada/acats-3/tests/c4/c45112a.ada
! c7c3ba0d233fb51ade68d7651dd47189  gcc/testsuite/ada/acats-3/tests/c4/c45112b.ada
! 49306dfa2cb372d1d65b4dd7a47c19e5  gcc/testsuite/ada/acats-3/tests/c4/c45113a.ada
! aa0781fb6f24f86504e59a47cf77b3d6  gcc/testsuite/ada/acats-3/tests/c4/c45114b.ada
! f718c72a25e47da1540690be5ff953da  gcc/testsuite/ada/acats-3/tests/c4/c452001.a
! 20ba3c7cde16d8bed844c4e64cd33e56  gcc/testsuite/ada/acats-3/tests/c4/c45201a.ada
! 6d4a1adb58c6e8ef73b34a324604ede4  gcc/testsuite/ada/acats-3/tests/c4/c45201b.ada
! 72aed4b6ea2fe7dfc0a9fdf3bede3751  gcc/testsuite/ada/acats-3/tests/c4/c45202b.ada
! 84d744855e2972095386f0e272333a6a  gcc/testsuite/ada/acats-3/tests/c4/c45210a.ada
! 91f826ce1d8f6889145f46e4c0ccada9  gcc/testsuite/ada/acats-3/tests/c4/c45211a.ada
! fe9117190ab93e4bd66b4015bb5cdba1  gcc/testsuite/ada/acats-3/tests/c4/c45220a.ada
! 6912810853452af0c8935cfd387c8df5  gcc/testsuite/ada/acats-3/tests/c4/c45220b.ada
! b394f131a9012e7c03cfd9636d737e6d  gcc/testsuite/ada/acats-3/tests/c4/c45220c.ada
! ccf331c469a0927819e1eb56e4e00429  gcc/testsuite/ada/acats-3/tests/c4/c45220d.ada
! 88d3a9ace4677cd3c025906371d2beeb  gcc/testsuite/ada/acats-3/tests/c4/c45220e.ada
! bba84a4055dd7c551f067e52bbe462e1  gcc/testsuite/ada/acats-3/tests/c4/c45220f.ada
! c13eaf9a516abfe2b6beda77dc2e3911  gcc/testsuite/ada/acats-3/tests/c4/c45231a.ada
! 2cca7d5fea02ce521f28a33db34ffa3d  gcc/testsuite/ada/acats-3/tests/c4/c45231b.dep
! 1bee766d69082269378c86e19c8abe85  gcc/testsuite/ada/acats-3/tests/c4/c45231c.dep
! a1bdfcd8a7def7dd624d3536e8905d30  gcc/testsuite/ada/acats-3/tests/c4/c45231d.tst
! 911d91bbd63a8c74f621846268c3e576  gcc/testsuite/ada/acats-3/tests/c4/c45232b.ada
! 4de95534392888683c8404eeeed6cc46  gcc/testsuite/ada/acats-3/tests/c4/c45242b.ada
! f2b98c822abe0cd6885e5b49561ac387  gcc/testsuite/ada/acats-3/tests/c4/c45251a.ada
! 94a924601ada615360bec26fb5450efb  gcc/testsuite/ada/acats-3/tests/c4/c45252a.ada
! debd13ddcb22bdcbb8a02c69693b66f8  gcc/testsuite/ada/acats-3/tests/c4/c45252b.ada
! ac031704393af45bbba41661aa36f2aa  gcc/testsuite/ada/acats-3/tests/c4/c45253a.ada
! fc9f55680d3672e261c2346c11b8ac30  gcc/testsuite/ada/acats-3/tests/c4/c45262a.ada
! c4104ba41f3003933d2540d2f946ba70  gcc/testsuite/ada/acats-3/tests/c4/c45262b.ada
! 8b9cb8019cc36523ada4859ea4a5d16a  gcc/testsuite/ada/acats-3/tests/c4/c45262c.ada
! d03448ead4d0effaab3998536c97bf20  gcc/testsuite/ada/acats-3/tests/c4/c45262d.ada
! f5c2479fb34a68704e8a8cc34f61a360  gcc/testsuite/ada/acats-3/tests/c4/c45264a.ada
! b5849bcd08a3c2d9a5d0c2b9e7a3cddd  gcc/testsuite/ada/acats-3/tests/c4/c45264b.ada
! 8f21912f6834298744357d557cb137f0  gcc/testsuite/ada/acats-3/tests/c4/c45264c.ada
! adc3cff25d9a3d6a8177af01212d7415  gcc/testsuite/ada/acats-3/tests/c4/c45265a.ada
! c4c6e9f92d1c15ec8a4b8f04c34a693f  gcc/testsuite/ada/acats-3/tests/c4/c45271a.ada
! c72a97f0fec20bbb08fc4517b6ddc788  gcc/testsuite/ada/acats-3/tests/c4/c45272a.ada
! 6b2a1a4bc714bd568da120c02fbf1702  gcc/testsuite/ada/acats-3/tests/c4/c45273a.ada
! b79ca71dc3632b190bdef98c6e0d142b  gcc/testsuite/ada/acats-3/tests/c4/c45274a.ada
! 9855409d4983ad2c1546e338fcbd0706  gcc/testsuite/ada/acats-3/tests/c4/c45274b.ada
! 435926faf09e9e479e1b1f272c13a333  gcc/testsuite/ada/acats-3/tests/c4/c45274c.ada
! 9115b9a51b29cec2f4c9ff1428f5a615  gcc/testsuite/ada/acats-3/tests/c4/c45281a.ada
! ecfe4965aad0d9bc1dc0dea01acceae3  gcc/testsuite/ada/acats-3/tests/c4/c45282a.ada
! 52a7cd2f9612b968a81d14f925d96de2  gcc/testsuite/ada/acats-3/tests/c4/c45282b.ada
! b3bd1b305af20f17ece9aabad0feaef1  gcc/testsuite/ada/acats-3/tests/c4/c45291a.ada
! 5e2f83b478139997a71df86ce9d1694c  gcc/testsuite/ada/acats-3/tests/c4/c452a01.a
! 35c49539c3030fd9c7c002e2fb0544cc  gcc/testsuite/ada/acats-3/tests/c4/c452a02.a
! 8af6afb2d8a0c30080274f19bc0dbbe8  gcc/testsuite/ada/acats-3/tests/c4/c452a03.a
! 7a35f848c66e3fbeaecff44f362c6d10  gcc/testsuite/ada/acats-3/tests/c4/c453001.a
! eaeb6ce37e830b736db8d34c6a83bb7d  gcc/testsuite/ada/acats-3/tests/c4/c45303a.ada
! f1ec15c9cdb65dbf13e1375cf7996f12  gcc/testsuite/ada/acats-3/tests/c4/c45304a.ada
! 55a19685b3e235e5bb6750cb9d7df962  gcc/testsuite/ada/acats-3/tests/c4/c45304b.dep
! b4c45f68d1219b0b994968a9828a7b17  gcc/testsuite/ada/acats-3/tests/c4/c45304c.dep
! 20fb36abf27afac504d4a771e7e63fd0  gcc/testsuite/ada/acats-3/tests/c4/c45322a.ada
! fab8bce97e1b74f5541c43ebbc38c44b  gcc/testsuite/ada/acats-3/tests/c4/c45323a.ada
! 0f09ca069bcacb950f308b51658fe4cf  gcc/testsuite/ada/acats-3/tests/c4/c45331a.ada
! 923c0cd8bc5f7a54a3ff10b7ecd3ae30  gcc/testsuite/ada/acats-3/tests/c4/c45342a.ada
! 4c687d4debfb2858cbde8d0598741375  gcc/testsuite/ada/acats-3/tests/c4/c45343a.ada
! fced8cf133a6e38c1bd3f44b383050a5  gcc/testsuite/ada/acats-3/tests/c4/c45344a.ada
! 046bf7cdbb7aeb33cdf0c17abb97726b  gcc/testsuite/ada/acats-3/tests/c4/c45345b.ada
! 1b975a926de8c5e1c1a8fd844dbfa809  gcc/testsuite/ada/acats-3/tests/c4/c45347a.ada
! 5c3a11fd88252878ac174be55d9cbe23  gcc/testsuite/ada/acats-3/tests/c4/c45347b.ada
! e7b0eaf3fab48f0c61a33030a45c9625  gcc/testsuite/ada/acats-3/tests/c4/c45347c.ada
! 5862189030beeea86b9e0d08e37c5f1a  gcc/testsuite/ada/acats-3/tests/c4/c45347d.ada
! 5a4ad439614a0b55cdeae637fcef3913  gcc/testsuite/ada/acats-3/tests/c4/c45411a.ada
! b55c932d505fe19faf48b3854f91bf92  gcc/testsuite/ada/acats-3/tests/c4/c45411b.dep
! cc45fca3dbdc169c3f8a8d219a8f3885  gcc/testsuite/ada/acats-3/tests/c4/c45411c.dep
! 92372898586e4be4330d20dabffa9b47  gcc/testsuite/ada/acats-3/tests/c4/c45411d.ada
! fdb465fedee3ebd743401e0c8899b0ce  gcc/testsuite/ada/acats-3/tests/c4/c45413a.ada
! fbd34bfae4961dda3c3e39ae18565fc8  gcc/testsuite/ada/acats-3/tests/c4/c45431a.ada
! bda2b940e9dc2584f9295b05e0c20b0f  gcc/testsuite/ada/acats-3/tests/c4/c455001.a
! 87ea1f3d7a54b6c25dba44fd5a571baa  gcc/testsuite/ada/acats-3/tests/c4/c45502b.dep
! 5a774d039f16514bc6a77bcf387d50ec  gcc/testsuite/ada/acats-3/tests/c4/c45502c.dep
! cc87ae3a223cabfed863304f12752609  gcc/testsuite/ada/acats-3/tests/c4/c45503a.ada
! dcadc5c668c2ff77de523cb7dba5b36a  gcc/testsuite/ada/acats-3/tests/c4/c45503b.dep
! 611398c2ae165df5a3f7381f660f52a0  gcc/testsuite/ada/acats-3/tests/c4/c45503c.dep
! f89268db15e37b030991c3827ca26c3e  gcc/testsuite/ada/acats-3/tests/c4/c45504a.ada
! f0cdb8c22aab2695a23fd98a373755b2  gcc/testsuite/ada/acats-3/tests/c4/c45504b.dep
! b8b4e008dfce1ee201519835a1fa50b8  gcc/testsuite/ada/acats-3/tests/c4/c45504c.dep
! ce29dbe3d5204283efb96dbcdfd5aac5  gcc/testsuite/ada/acats-3/tests/c4/c45504d.ada
! 10c91d5e233ba13218dcd66fb790a7be  gcc/testsuite/ada/acats-3/tests/c4/c45504e.dep
! 92f6aea3aed6ba9df5385c22f904ba43  gcc/testsuite/ada/acats-3/tests/c4/c45504f.dep
! 0059f05c198e829fac48965c13f56c08  gcc/testsuite/ada/acats-3/tests/c4/c45505a.ada
! 47a4e48ddd2b3df3c7eb949e7d6692a8  gcc/testsuite/ada/acats-3/tests/c4/c45523a.ada
! 17fdb2a59175aad9fef05c8cab8509e5  gcc/testsuite/ada/acats-3/tests/c4/c45531a.ada
! b8d549a63a2c40e579c8ed0a817ba1b3  gcc/testsuite/ada/acats-3/tests/c4/c45531b.ada
! c131684e4763854670c42c2112418109  gcc/testsuite/ada/acats-3/tests/c4/c45531c.ada
! c584d6f3f281816f1bd157cd8cc6b33a  gcc/testsuite/ada/acats-3/tests/c4/c45531d.ada
! 29ba7e7c1042d7979b1c75938b61e862  gcc/testsuite/ada/acats-3/tests/c4/c45531e.ada
! 47ea14530564cd8e06520e03e074efb3  gcc/testsuite/ada/acats-3/tests/c4/c45531f.ada
! 974ec868d7bcf66f2a14b7a4e70541b0  gcc/testsuite/ada/acats-3/tests/c4/c45531g.ada
! be8ef1a126f5c01246a9b635558e69ed  gcc/testsuite/ada/acats-3/tests/c4/c45531h.ada
! a795638c4621469321aa1212fd6bc01b  gcc/testsuite/ada/acats-3/tests/c4/c45531i.ada
! 8e8dbc1f05d26be72eaaaaca136d57b8  gcc/testsuite/ada/acats-3/tests/c4/c45531j.ada
! f7420a86d16f0dda550ad66d998500fa  gcc/testsuite/ada/acats-3/tests/c4/c45531k.ada
! de637dfbdf31186f46f1f622a7b31d52  gcc/testsuite/ada/acats-3/tests/c4/c45531l.ada
! 991294aff87680d765e6feb5cca5b1b5  gcc/testsuite/ada/acats-3/tests/c4/c45531m.dep
! 0494b2e93ef765b57a27be6b00246238  gcc/testsuite/ada/acats-3/tests/c4/c45531n.dep
! be4ab72a6216470b4aa0865525f98461  gcc/testsuite/ada/acats-3/tests/c4/c45531o.dep
! bb7d5366acda158c30e39d3074242262  gcc/testsuite/ada/acats-3/tests/c4/c45531p.dep
! 1328509e95f292ea980a979dedb08b47  gcc/testsuite/ada/acats-3/tests/c4/c45532a.ada
! 59f6ce63685d98c434d1a7af9b67d1f3  gcc/testsuite/ada/acats-3/tests/c4/c45532b.ada
! fe5a8b5f9204d89a9d208c19a93b7bbf  gcc/testsuite/ada/acats-3/tests/c4/c45532c.ada
! b60deea143add2ece22c54e2958db126  gcc/testsuite/ada/acats-3/tests/c4/c45532d.ada
! dac58571992e1d76d98508be3cbe2bd6  gcc/testsuite/ada/acats-3/tests/c4/c45532e.ada
! 1d7df94c7041a350156a66e67466f094  gcc/testsuite/ada/acats-3/tests/c4/c45532f.ada
! 98b8e00c4f5a9bb275a8ea343272d444  gcc/testsuite/ada/acats-3/tests/c4/c45532g.ada
! 715b35f0ab3ff72859527fd1dce01194  gcc/testsuite/ada/acats-3/tests/c4/c45532h.ada
! 6f5e0c33dee8484fe564f99b4aa53644  gcc/testsuite/ada/acats-3/tests/c4/c45532i.ada
! 4ff1755309ac898b71b5b8e71ed4a3b6  gcc/testsuite/ada/acats-3/tests/c4/c45532j.ada
! 6c58481cb99358f459163a20d20ecd7c  gcc/testsuite/ada/acats-3/tests/c4/c45532k.ada
! c77d0519f01191df9cdfba659466ec04  gcc/testsuite/ada/acats-3/tests/c4/c45532l.ada
! d2858511889a915c130e7db15a855e6a  gcc/testsuite/ada/acats-3/tests/c4/c45532m.dep
! a549269ed45783ccf0d0c93c5328f429  gcc/testsuite/ada/acats-3/tests/c4/c45532n.dep
! f4b1217bc94832f638629b8949b7def2  gcc/testsuite/ada/acats-3/tests/c4/c45532o.dep
! 798f26e21ededa5b524a77eeece6382f  gcc/testsuite/ada/acats-3/tests/c4/c45532p.dep
! 76101d98b4fab21c843f8c72a2bd9d19  gcc/testsuite/ada/acats-3/tests/c4/c45534b.ada
! b8ae84ef022a3c5728e841755e4bac5e  gcc/testsuite/ada/acats-3/tests/c4/c45536a.dep
! 28591d736802ebfac3f139de9f8cf2e7  gcc/testsuite/ada/acats-3/tests/c4/c456001.a
! bc49b87b69b7e8faefa883dc0c55fb68  gcc/testsuite/ada/acats-3/tests/c4/c45611a.ada
! 3be40e2b85d211f880f0c3afd51a63e8  gcc/testsuite/ada/acats-3/tests/c4/c45611b.dep
! 969e8cbd817e50baf599dd80133f7e3d  gcc/testsuite/ada/acats-3/tests/c4/c45611c.dep
! 48d114a182e767e243d7ef95e93e4e19  gcc/testsuite/ada/acats-3/tests/c4/c45613a.ada
! c3d80667bb998de0b21993ea73edabec  gcc/testsuite/ada/acats-3/tests/c4/c45613b.dep
! f8ed3027af651e8a9c09b39c0abf883c  gcc/testsuite/ada/acats-3/tests/c4/c45613c.dep
! cfe72bc879be3b00ef382558884d4b1d  gcc/testsuite/ada/acats-3/tests/c4/c45614a.ada
! c49e020a85a8868eed26fc38aaab04bf  gcc/testsuite/ada/acats-3/tests/c4/c45614b.dep
! 41f7a3468254617c1e8fd2e5932a25b4  gcc/testsuite/ada/acats-3/tests/c4/c45614c.dep
! ac5d52f05c31abf886e8c8c4468e3276  gcc/testsuite/ada/acats-3/tests/c4/c45631a.ada
! 08c1f1a469e3e9753825625f1a28b1ea  gcc/testsuite/ada/acats-3/tests/c4/c45631b.dep
! 3d90d62c311cc7457e997be47d4bc90b  gcc/testsuite/ada/acats-3/tests/c4/c45631c.dep
! 2f244bf1111e453d24ff570db3165fdb  gcc/testsuite/ada/acats-3/tests/c4/c45632a.ada
! 3e3d1f108ceb3c5be9dad7868239132f  gcc/testsuite/ada/acats-3/tests/c4/c45632b.dep
! d562e6283ca6c800b69581c080526e08  gcc/testsuite/ada/acats-3/tests/c4/c45632c.dep
! 2057dc7ea5393bc4be1493fb108ee5fb  gcc/testsuite/ada/acats-3/tests/c4/c45651a.ada
! c6892aa7717ffbd54f697e3d5db788af  gcc/testsuite/ada/acats-3/tests/c4/c45662a.ada
! a04b5f03883d1f148e66d75bb8eb5a69  gcc/testsuite/ada/acats-3/tests/c4/c45662b.ada
! ebd6cdab4f3e678623c2ece9ee770d5e  gcc/testsuite/ada/acats-3/tests/c4/c45672a.ada
! ac5adcf11bac18511d0fcfabda779d68  gcc/testsuite/ada/acats-3/tests/c4/c460001.a
! afb5f92407f4912f75eeaef16084757f  gcc/testsuite/ada/acats-3/tests/c4/c460002.a
! 69401711fe089c368e9218ac971b8e5a  gcc/testsuite/ada/acats-3/tests/c4/c460004.a
! f7f9cde65ac6273493f88f7cc35065c2  gcc/testsuite/ada/acats-3/tests/c4/c460005.a
! e0ce32e221b728a5e7cbef5d66bdb49b  gcc/testsuite/ada/acats-3/tests/c4/c460006.a
! ec69fdc3a65a761d8134bc49e6570216  gcc/testsuite/ada/acats-3/tests/c4/c460007.a
! 8b03807b80d9f2edc57ad06734bf670f  gcc/testsuite/ada/acats-3/tests/c4/c460008.a
! 6950bb628b3003b1ceb3b53e6cf246f8  gcc/testsuite/ada/acats-3/tests/c4/c460009.a
! 5bc44a3344b33409dd851c6b03e885b7  gcc/testsuite/ada/acats-3/tests/c4/c460010.a
! 28b73597d3fa9ae6666a9a63539882fb  gcc/testsuite/ada/acats-3/tests/c4/c460011.a
! a2898cc40c52d07d2a1d5f39c8daae42  gcc/testsuite/ada/acats-3/tests/c4/c460012.a
! 872a8786f130e49cbb2e00930aee116c  gcc/testsuite/ada/acats-3/tests/c4/c460013.a
! 8caad81fc1b11cdf36c43c5366ffe8c4  gcc/testsuite/ada/acats-3/tests/c4/c460014.a
! e833e9d95b6cede57867bf1cfb360b6d  gcc/testsuite/ada/acats-3/tests/c4/c460015.a
! 4578ba3cbcc42767bfa1d9fb8beed52f  gcc/testsuite/ada/acats-3/tests/c4/c46011a.ada
! 573e5b85d6d0d9289787bcf7f265aea9  gcc/testsuite/ada/acats-3/tests/c4/c46013a.ada
! ad32d1cce692c7cd1ef8bf3d2f70dee2  gcc/testsuite/ada/acats-3/tests/c4/c46014a.ada
! 3860375240c7fbeec5ea607c60613d17  gcc/testsuite/ada/acats-3/tests/c4/c46021a.ada
! 6ca67808bea0b36f928ece90dac5570f  gcc/testsuite/ada/acats-3/tests/c4/c46024a.ada
! 846bd637f5220b864dde4f2ea9ac8025  gcc/testsuite/ada/acats-3/tests/c4/c46031a.ada
! 362f593ed41bfc3cc23925318952cbc7  gcc/testsuite/ada/acats-3/tests/c4/c46032a.ada
! 65b59a01caacc42c4057aa1adad39e9c  gcc/testsuite/ada/acats-3/tests/c4/c46033a.ada
! bc9fedd5661dbda9254ef00f93819e37  gcc/testsuite/ada/acats-3/tests/c4/c46041a.ada
! dd2bc24443f9516af6adaf665228f9fb  gcc/testsuite/ada/acats-3/tests/c4/c46042a.ada
! cc5cd66068669bee0635ba7d5d5b9e4b  gcc/testsuite/ada/acats-3/tests/c4/c46043b.ada
! 862e92acebb016f9eaff87800084fb00  gcc/testsuite/ada/acats-3/tests/c4/c46044b.ada
! 8704bc96d1d99d958dd9ba580cc0fcab  gcc/testsuite/ada/acats-3/tests/c4/c46051a.ada
! 4301c097675c9ae1e1de85cb434e9f91  gcc/testsuite/ada/acats-3/tests/c4/c46051b.ada
! 0852a062d8fb5318db0fafb3e74e1869  gcc/testsuite/ada/acats-3/tests/c4/c46051c.ada
! 207b83887faae118af7863a8e7c8b797  gcc/testsuite/ada/acats-3/tests/c4/c46052a.ada
! 36ddef6a40e98fa6f687083359dcc79c  gcc/testsuite/ada/acats-3/tests/c4/c46053a.ada
! 7c918ea610224feb8290e7538e4931c0  gcc/testsuite/ada/acats-3/tests/c4/c46054a.ada
! dcaaa25c241dbab83f2031ac8a166ad0  gcc/testsuite/ada/acats-3/tests/c4/c460a01.a
! c9d756313dbe8edba8cd79f261be675b  gcc/testsuite/ada/acats-3/tests/c4/c460a02.a
! 8453f66003fadf1256272c8267ac59fe  gcc/testsuite/ada/acats-3/tests/c4/c47002a.ada
! a1a15e98aa414e9e0f6c684cc5fc7d3d  gcc/testsuite/ada/acats-3/tests/c4/c47002b.ada
! 52b6ce3f1ece2252097d9cf94ff704d8  gcc/testsuite/ada/acats-3/tests/c4/c47002c.ada
! 1b3f120455d714443fa2b8a6510141b3  gcc/testsuite/ada/acats-3/tests/c4/c47002d.ada
! e24d41d29f205af082effc4960aabff2  gcc/testsuite/ada/acats-3/tests/c4/c47003a.ada
! 676bb791325a2ce2931c822d1ba079e8  gcc/testsuite/ada/acats-3/tests/c4/c47004a.ada
! 5768cda2bc4788bb66c01ffbbe818333  gcc/testsuite/ada/acats-3/tests/c4/c47005a.ada
! 7180522de8601bc47eada08923197c21  gcc/testsuite/ada/acats-3/tests/c4/c47006a.ada
! 0866501ce0f4c5ac19a1a6701494acf1  gcc/testsuite/ada/acats-3/tests/c4/c47007a.ada
! f190b1e58c5b9f88edb7c62cc786a5ff  gcc/testsuite/ada/acats-3/tests/c4/c47008a.ada
! a83ffa688fac3d8d28808297d6c1f8af  gcc/testsuite/ada/acats-3/tests/c4/c47009a.ada
! 7e410443d7fee4c5025000324c9fa075  gcc/testsuite/ada/acats-3/tests/c4/c47009b.ada
! dce2f96009d9046b47877ee487e3b5da  gcc/testsuite/ada/acats-3/tests/c4/c480001.a
! bc1787b8c3d0a2828cd39079641a7ae3  gcc/testsuite/ada/acats-3/tests/c4/c48004a.ada
! 35a79d509102b6efc374a823e03081dd  gcc/testsuite/ada/acats-3/tests/c4/c48004b.ada
! 520b577b8b19f3e983fa89ee6a4feae4  gcc/testsuite/ada/acats-3/tests/c4/c48004c.ada
! 4a4dc141e6c0b8734f2f4889a453c041  gcc/testsuite/ada/acats-3/tests/c4/c48004d.ada
! e1de901127f9fa068bbc1887e40ae286  gcc/testsuite/ada/acats-3/tests/c4/c48004e.ada
! a21a603107226dd95249e796c50b2988  gcc/testsuite/ada/acats-3/tests/c4/c48004f.ada
! d05127b0bccfaca8e70b371616b9e949  gcc/testsuite/ada/acats-3/tests/c4/c48005a.ada
! 93f4d6e87a4f9f685f9aad61502c858c  gcc/testsuite/ada/acats-3/tests/c4/c48005b.ada
! 794d0af908f9931f0b089116f1e42907  gcc/testsuite/ada/acats-3/tests/c4/c48006a.ada
! 3df923c9af6683c1bb48881ddb41ddfb  gcc/testsuite/ada/acats-3/tests/c4/c48006b.ada
! a6c0f722acc9486a7e600dc96ff2d5cd  gcc/testsuite/ada/acats-3/tests/c4/c48007a.ada
! b2751238701befe768d059585cb34fbe  gcc/testsuite/ada/acats-3/tests/c4/c48007b.ada
! a069ec763e24859fbddc4f107e410c11  gcc/testsuite/ada/acats-3/tests/c4/c48007c.ada
! 009ebc3b69f9c31aa88c54a85271399a  gcc/testsuite/ada/acats-3/tests/c4/c48008a.ada
! 5782d3eeb5e00949ec2f3c7a7ae59650  gcc/testsuite/ada/acats-3/tests/c4/c48008c.ada
! 36b2b00fc2eaa55063b74bfc4cb91c79  gcc/testsuite/ada/acats-3/tests/c4/c48009a.ada
! d7356de4b25053ff97c5d99c7daa90a2  gcc/testsuite/ada/acats-3/tests/c4/c48009b.ada
! 46e9f0e1b269b6b499944395221ae145  gcc/testsuite/ada/acats-3/tests/c4/c48009c.ada
! 99e82e54208e5f2e641da892789ade00  gcc/testsuite/ada/acats-3/tests/c4/c48009d.ada
! a4dd405fd63b81dac153b62e7df858e9  gcc/testsuite/ada/acats-3/tests/c4/c48009e.ada
! a761ea12752cc1827d795f510ed14854  gcc/testsuite/ada/acats-3/tests/c4/c48009f.ada
! f4d13322456cdc5177a9641ba263e997  gcc/testsuite/ada/acats-3/tests/c4/c48009g.ada
! 9b3d09b25afb28f96e9c15abc9134ea5  gcc/testsuite/ada/acats-3/tests/c4/c48009h.ada
! 5ed239b238e9da030fa1d1bbf81e4dc3  gcc/testsuite/ada/acats-3/tests/c4/c48009i.ada
! dbe1181c1fb1c91cdfc5d5a51327b289  gcc/testsuite/ada/acats-3/tests/c4/c48009j.ada
! 688a1e8190cac3b78936f0235d3b808d  gcc/testsuite/ada/acats-3/tests/c4/c48010a.ada
! 48a6ec9afe098c7d148a0d1f652be09e  gcc/testsuite/ada/acats-3/tests/c4/c48011a.ada
! 18db6e638dc720b6501696a26aa99e58  gcc/testsuite/ada/acats-3/tests/c4/c48012a.ada
! b30035b53424a29691b261dda34fc58e  gcc/testsuite/ada/acats-3/tests/c4/c490001.a
! 489ea02e3356b5145fb51c63bb474ea5  gcc/testsuite/ada/acats-3/tests/c4/c490002.a
! c9523cc2889cfcde83e23c042eedd694  gcc/testsuite/ada/acats-3/tests/c4/c490003.a
! 6f98fb5a40e92d1a16d6c2a144d613a5  gcc/testsuite/ada/acats-3/tests/c4/c49020a.ada
! 949b858aea6369cc5f6b92e57a36762e  gcc/testsuite/ada/acats-3/tests/c4/c49021a.ada
! 61eb9a59008479c0875739f8a38a6058  gcc/testsuite/ada/acats-3/tests/c4/c49022a.ada
! 371d9a00cb41f67a40d255081149947a  gcc/testsuite/ada/acats-3/tests/c4/c49022b.ada
! 6cbf71a7cecd0227501309baf6e99545  gcc/testsuite/ada/acats-3/tests/c4/c49022c.ada
! ae09e5339a3f4903f8fa5d11de07d714  gcc/testsuite/ada/acats-3/tests/c4/c49023a.ada
! e2d3c0d182fcc8306bf82e940cacf1c0  gcc/testsuite/ada/acats-3/tests/c4/c49024a.ada
! fa1107ef6dfef6a91126632e0fd40ac9  gcc/testsuite/ada/acats-3/tests/c4/c49025a.ada
! 8308838bc1d5d9801f0aba7872873b2e  gcc/testsuite/ada/acats-3/tests/c4/c49026a.ada
! 67dd3195321fffe06e278c7a2dd46fb7  gcc/testsuite/ada/acats-3/tests/c4/c4a005b.ada
! b4f6152a06508643187aed55fe1b066d  gcc/testsuite/ada/acats-3/tests/c4/c4a006a.ada
! 5eddb402835a4195abec99f2970765f6  gcc/testsuite/ada/acats-3/tests/c4/c4a007a.tst
! 1c61fe192df4f7bf89c81bd93f979629  gcc/testsuite/ada/acats-3/tests/c4/c4a010a.ada
! db5b09d1af5f03cbfc83813c6cef98d9  gcc/testsuite/ada/acats-3/tests/c4/c4a010b.ada
! 8ea93dd812f5645ad034052c5e9c14bc  gcc/testsuite/ada/acats-3/tests/c4/c4a011a.ada
! d8a1f20f1b4a1339f232102f757a12c6  gcc/testsuite/ada/acats-3/tests/c4/c4a012b.ada
! df1956d8e1bdb8b421d8edda86514e73  gcc/testsuite/ada/acats-3/tests/c4/c4a013a.ada
! f95cf7fe1c6669b86824c685ca90c44f  gcc/testsuite/ada/acats-3/tests/c4/c4a014a.ada
! 04305b71fc4860700405904b070a802b  gcc/testsuite/ada/acats-3/tests/c5/c51004a.ada
! c6f0f59f33111f1bb049c5f25022c725  gcc/testsuite/ada/acats-3/tests/c5/c52005a.ada
! 4497fa9cc187eebee09f422eb12067f6  gcc/testsuite/ada/acats-3/tests/c5/c52005b.ada
! 31714495e63b10120b8239b0456549ee  gcc/testsuite/ada/acats-3/tests/c5/c52005c.ada
! c643f87a63f83ab7dedfa0b4647174c9  gcc/testsuite/ada/acats-3/tests/c5/c52005d.ada
! a717ed0d0e4578d9b1ba1e84a1312d88  gcc/testsuite/ada/acats-3/tests/c5/c52005e.ada
! e9e335b018c1995e8f516236efc80a20  gcc/testsuite/ada/acats-3/tests/c5/c52005f.ada
! c475aae75de9114facd3aaa775556697  gcc/testsuite/ada/acats-3/tests/c5/c52008a.ada
! 87cbbe1931b5cfdb29756f338e098ee1  gcc/testsuite/ada/acats-3/tests/c5/c52008b.ada
! 67bb5622435b51d6b7a862890b654771  gcc/testsuite/ada/acats-3/tests/c5/c52009a.ada
! 400c804c17dce5b2cbc92e00f53bdbf7  gcc/testsuite/ada/acats-3/tests/c5/c52009b.ada
! d656f6cd000039c412836d5baacbff52  gcc/testsuite/ada/acats-3/tests/c5/c52010a.ada
! 1f26091c9bf683f6970689d5d0980a81  gcc/testsuite/ada/acats-3/tests/c5/c52011a.ada
! bd17088998a5ebb4a8a3f1ae8ed0fb56  gcc/testsuite/ada/acats-3/tests/c5/c52011b.ada
! 4b2866ec2ef631d8e633f08a7aaf873c  gcc/testsuite/ada/acats-3/tests/c5/c52101a.ada
! d79452ecad6774f7462778af7f7ce5eb  gcc/testsuite/ada/acats-3/tests/c5/c52102a.ada
! c3ffbc3a8172219b7b11be58eb4ee73d  gcc/testsuite/ada/acats-3/tests/c5/c52102b.ada
! d8b031579b48e0bae598c821fc7f2799  gcc/testsuite/ada/acats-3/tests/c5/c52102c.ada
! 8545078e881db7a6a84e41583799ee5d  gcc/testsuite/ada/acats-3/tests/c5/c52102d.ada
! 348fad1e9e6e04b677fd7d942e3416af  gcc/testsuite/ada/acats-3/tests/c5/c52103a.ada
! 537e555773a4e758b8466c079c2023a1  gcc/testsuite/ada/acats-3/tests/c5/c52103b.ada
! c118c8520f99ad57e36a1e1ed0ab2549  gcc/testsuite/ada/acats-3/tests/c5/c52103c.ada
! 161ca114e3549ca32b6abc801f74633d  gcc/testsuite/ada/acats-3/tests/c5/c52103f.ada
! 553aa64efc629783fc32ef6b352ae6be  gcc/testsuite/ada/acats-3/tests/c5/c52103g.ada
! 29498cb969386c5b69bd6ba62c7be406  gcc/testsuite/ada/acats-3/tests/c5/c52103h.ada
! 8026673b1e67673c009f39e569ae1a3e  gcc/testsuite/ada/acats-3/tests/c5/c52103k.ada
! c6b31cf4833909c9d4dae839511863ec  gcc/testsuite/ada/acats-3/tests/c5/c52103l.ada
! 6843840acb3dee1ae11cf9365156daaa  gcc/testsuite/ada/acats-3/tests/c5/c52103m.ada
! 70a2f3db7206a779a035e915788f37f0  gcc/testsuite/ada/acats-3/tests/c5/c52103p.ada
! a28a2bdec6b574435427b9aeb1c74945  gcc/testsuite/ada/acats-3/tests/c5/c52103q.ada
! 7b9ecdaf00c3655bb24701195d08a83f  gcc/testsuite/ada/acats-3/tests/c5/c52103r.ada
! 0c814953f2bf8472a62eb44838f04363  gcc/testsuite/ada/acats-3/tests/c5/c52103x.ada
! e772fcfb1386e00244d4b143524cc196  gcc/testsuite/ada/acats-3/tests/c5/c52104a.ada
! 16ef5ba633cf0703eef0f4bc4e6a931e  gcc/testsuite/ada/acats-3/tests/c5/c52104b.ada
! 0d83ec342af202df515bd811d311775e  gcc/testsuite/ada/acats-3/tests/c5/c52104c.ada
! 63ba1297346e75dcba0a5bebb9fd7feb  gcc/testsuite/ada/acats-3/tests/c5/c52104f.ada
! 360c84a7d7a20d6426f39f47175e9e61  gcc/testsuite/ada/acats-3/tests/c5/c52104g.ada
! 8c2507e3ca68c72c1b2e6d6e118ec32b  gcc/testsuite/ada/acats-3/tests/c5/c52104h.ada
! 3eb7315199feb380e4633e0fa784d0dc  gcc/testsuite/ada/acats-3/tests/c5/c52104k.ada
! 1e9c8d887474d4edd8e8cef2ca34972f  gcc/testsuite/ada/acats-3/tests/c5/c52104l.ada
! 4cd7ce90121345b41e548625afd89238  gcc/testsuite/ada/acats-3/tests/c5/c52104m.ada
! bb14b1ee179559762fe853803c6f47a0  gcc/testsuite/ada/acats-3/tests/c5/c52104p.ada
! 11c63d2f8a8f5be641d543c723d95db6  gcc/testsuite/ada/acats-3/tests/c5/c52104q.ada
! 3e89a5e299b2f10a8bfdddda7e51ad94  gcc/testsuite/ada/acats-3/tests/c5/c52104r.ada
! cf3c9c7c07a47d92020285624997c09f  gcc/testsuite/ada/acats-3/tests/c5/c52104x.ada
! c937dcfea0e38e6a3b8af09de0efaf04  gcc/testsuite/ada/acats-3/tests/c5/c52104y.ada
! b2aa45debad3d8e7603216de3bca00fb  gcc/testsuite/ada/acats-3/tests/c5/c53007a.ada
! ff458115437146bc66c6f7135942dc7d  gcc/testsuite/ada/acats-3/tests/c5/c540001.a
! bfd64dd4867f66c56eb6d466f8a84af9  gcc/testsuite/ada/acats-3/tests/c5/c540002.a
! 798fc3cdc6929204af5e109c7b552b96  gcc/testsuite/ada/acats-3/tests/c5/c54a03a.ada
! 350e6e9e9f439b08c9984e18a29b6144  gcc/testsuite/ada/acats-3/tests/c5/c54a04a.ada
! 672e5fee1b44c051e35bd39f7cfdd7f6  gcc/testsuite/ada/acats-3/tests/c5/c54a07a.ada
! 55636ae11b1e87d2920da673ac54f8cf  gcc/testsuite/ada/acats-3/tests/c5/c54a13a.ada
! fadaa20972179cfa78055a5255aaf701  gcc/testsuite/ada/acats-3/tests/c5/c54a13b.ada
! 1f2ca9fde851497809ddf860f08ea8dd  gcc/testsuite/ada/acats-3/tests/c5/c54a13c.ada
! f02b8333b09eadfe396595d861e0c28e  gcc/testsuite/ada/acats-3/tests/c5/c54a13d.ada
! 37f2526490642267865f8a817c455655  gcc/testsuite/ada/acats-3/tests/c5/c54a22a.ada
! c4b7807f9faa1bb76d79507d98a0feb3  gcc/testsuite/ada/acats-3/tests/c5/c54a23a.ada
! 45d1b598e30b318d11d3cfa6a37cc6fa  gcc/testsuite/ada/acats-3/tests/c5/c54a24a.ada
! adeadf039e14eb8bc2b48ff5572bd812  gcc/testsuite/ada/acats-3/tests/c5/c54a24b.ada
! 7cf7b4d54a6bca23e102d02570e8d836  gcc/testsuite/ada/acats-3/tests/c5/c54a42a.ada
! 200024964c0cd6807dda9226ae982125  gcc/testsuite/ada/acats-3/tests/c5/c54a42b.ada
! b58d58ea8c08f008f3bb0a1f4e37600d  gcc/testsuite/ada/acats-3/tests/c5/c54a42c.ada
! 7afca27633e115e11ccc09450181d955  gcc/testsuite/ada/acats-3/tests/c5/c54a42d.ada
! 810d89d05b84beb31789b0ebd7aba86d  gcc/testsuite/ada/acats-3/tests/c5/c54a42e.ada
! 012f75628d8e37cbd1be10f8f4ba117f  gcc/testsuite/ada/acats-3/tests/c5/c54a42f.ada
! d45cbd6907b0f421c6aec9b981f052d6  gcc/testsuite/ada/acats-3/tests/c5/c54a42g.ada
! ef97a2623a512e16e0fda04f277b6ff2  gcc/testsuite/ada/acats-3/tests/c5/c55b03a.ada
! ad40c92edd66b18fad76286ec1b9c6ae  gcc/testsuite/ada/acats-3/tests/c5/c55b04a.ada
! aa1f7abf4fbb36f5120549a0305b7862  gcc/testsuite/ada/acats-3/tests/c5/c55b05a.ada
! 93af4cbae77af58c9e4c76145e3381b0  gcc/testsuite/ada/acats-3/tests/c5/c55b06a.ada
! 83fb65a1faa9605647ad3455e55fa273  gcc/testsuite/ada/acats-3/tests/c5/c55b06b.ada
! 1c3a3e590230416971b33336bec05137  gcc/testsuite/ada/acats-3/tests/c5/c55b07a.dep
! 297ac06b1460ecfad84e5ce426b452d5  gcc/testsuite/ada/acats-3/tests/c5/c55b07b.dep
! 9f79657a1fb3ec7ad658a79647c5949c  gcc/testsuite/ada/acats-3/tests/c5/c55b10a.ada
! 1364f5750f4c9a8395cf0b1ae42eee0b  gcc/testsuite/ada/acats-3/tests/c5/c55b11a.ada
! 20c657742ad353aedf983932ae3ad058  gcc/testsuite/ada/acats-3/tests/c5/c55b11b.ada
! dcbc66de120373907bc61655da9f5f72  gcc/testsuite/ada/acats-3/tests/c5/c55b15a.ada
! 46488465caae85e036ca25f7a3861ddb  gcc/testsuite/ada/acats-3/tests/c5/c55b16a.ada
! 59a61b3784b5cede84a98e874e989bf9  gcc/testsuite/ada/acats-3/tests/c5/c55c02a.ada
! a665c1df7fabf7499dd2fef8021e5735  gcc/testsuite/ada/acats-3/tests/c5/c55c02b.ada
! 9722acc7b86adb50f2132a53c9a9ba5f  gcc/testsuite/ada/acats-3/tests/c5/c56002a.ada
! 0d40a16731d63ec204e884f94b191598  gcc/testsuite/ada/acats-3/tests/c5/c57003a.ada
! 7bceaaa459e0581dd43947812fb6e226  gcc/testsuite/ada/acats-3/tests/c5/c57004a.ada
! 30ed2943b27da30ba5be8602f46f6e65  gcc/testsuite/ada/acats-3/tests/c5/c57004b.ada
! 8a811d9acc70a272fa09cbfe47fdbbc0  gcc/testsuite/ada/acats-3/tests/c5/c58004c.ada
! 17e55b043903edcc29571ab8bd8aa78c  gcc/testsuite/ada/acats-3/tests/c5/c58004d.ada
! 7807a279489151c0c870e2d8f12f4502  gcc/testsuite/ada/acats-3/tests/c5/c58004g.ada
! 1b5dcc2941f69ee8c74a24728bb90d67  gcc/testsuite/ada/acats-3/tests/c5/c58005a.ada
! 62354e1ba2b765af08aa33a5e09c47df  gcc/testsuite/ada/acats-3/tests/c5/c58005b.ada
! 9028a4a38fba5ee0a721a8918c7e46c8  gcc/testsuite/ada/acats-3/tests/c5/c58005h.ada
! fa480782be6698aa97970fcf14c2f19b  gcc/testsuite/ada/acats-3/tests/c5/c58006a.ada
! 156c239407b9c9b5abfd28b286d35734  gcc/testsuite/ada/acats-3/tests/c5/c58006b.ada
! 05e86bfca592c5c4d28a7ad45f8d8054  gcc/testsuite/ada/acats-3/tests/c5/c59002a.ada
! 70857f43256c7a44ec4b50f5aa1b4b0d  gcc/testsuite/ada/acats-3/tests/c5/c59002b.ada
! 8a43db8aaa6ff159f8de6d91d075a607  gcc/testsuite/ada/acats-3/tests/c5/c59002c.ada
! 22c213bb3f4fac53cfad7701e5a6591a  gcc/testsuite/ada/acats-3/tests/c6/c61008a.ada
! 5fb3b13780dfa407dfa99fcfa590913f  gcc/testsuite/ada/acats-3/tests/c6/c61009a.ada
! 25cf5d0e53424f3054a20393c002970e  gcc/testsuite/ada/acats-3/tests/c6/c61010a.ada
! fc4b87310c6618ffbf7d4df1f222a45f  gcc/testsuite/ada/acats-3/tests/c6/c620001.a
! 2a393ff1326482d8490f5be202d8483c  gcc/testsuite/ada/acats-3/tests/c6/c620002.a
! 97d97866837d419b1ddcfa6ccda2511e  gcc/testsuite/ada/acats-3/tests/c6/c62002a.ada
! 29777c913c6649484125c1aa56f0093f  gcc/testsuite/ada/acats-3/tests/c6/c62003a.ada
! 3e2cc6ba1c79eb1d9f3fe3bbb646cf6b  gcc/testsuite/ada/acats-3/tests/c6/c62003b.ada
! 624bc88129c0b954774c60019f5435c5  gcc/testsuite/ada/acats-3/tests/c6/c62004a.ada
! 31c5b507af85354e0db53a078e7c8933  gcc/testsuite/ada/acats-3/tests/c6/c62006a.ada
! e8a1274fb71dcf0b27d5375c78e8d1d3  gcc/testsuite/ada/acats-3/tests/c6/c631001.a
! 41a6d9efe5d22a0f96b7c4448831b133  gcc/testsuite/ada/acats-3/tests/c6/c640001.a
! 17e197839a109a15bfb4d3592d5bdff8  gcc/testsuite/ada/acats-3/tests/c6/c640002.a
! 67136569bb3a58c14f65e3abd9b96391  gcc/testsuite/ada/acats-3/tests/c6/c64002b.ada
! 298c0d717f1da2c324c78b6aafedfa91  gcc/testsuite/ada/acats-3/tests/c6/c64004g.ada
! 0a5ebe2531dcbec11f3d606df5534e5b  gcc/testsuite/ada/acats-3/tests/c6/c64005a.ada
! 1a7b4a32917f31d77deb5ad294e39f82  gcc/testsuite/ada/acats-3/tests/c6/c64005b.ada
! 292b4b0e6cf19da205f4d3a1caeee992  gcc/testsuite/ada/acats-3/tests/c6/c64005c.ada
! db80e980a183a6d0f7c9afd52fae0c87  gcc/testsuite/ada/acats-3/tests/c6/c64005d0.ada
! f480e72d2a8b3a22347018687fb9f190  gcc/testsuite/ada/acats-3/tests/c6/c64005da.ada
! 035da89aedf781e8b07eace791889088  gcc/testsuite/ada/acats-3/tests/c6/c64005db.ada
! 9af982279e39e967d04656170afef341  gcc/testsuite/ada/acats-3/tests/c6/c64005dc.ada
! 2f3c835897b61c5b02af1bef11a949d6  gcc/testsuite/ada/acats-3/tests/c6/c641001.a
! f9894df16dafde8c37b5681a9a0b728f  gcc/testsuite/ada/acats-3/tests/c6/c64103b.ada
! 573a659bd2d30c3c8a3ee7f77390490c  gcc/testsuite/ada/acats-3/tests/c6/c64103c.ada
! e7242de3cddb62031ef1910e911942df  gcc/testsuite/ada/acats-3/tests/c6/c64103d.ada
! 6e2e6c719dcbb601e033a3a1528b6db5  gcc/testsuite/ada/acats-3/tests/c6/c64103e.ada
! aa17757d55d04a8ef672505933d46680  gcc/testsuite/ada/acats-3/tests/c6/c64103f.ada
! bbb85cc245f09eba3db627d88d52db68  gcc/testsuite/ada/acats-3/tests/c6/c64104a.ada
! d3f37083469fc62f2aeae2c00e979ad9  gcc/testsuite/ada/acats-3/tests/c6/c64104b.ada
! 00b5b6264d3df93a1481ca7dd0313957  gcc/testsuite/ada/acats-3/tests/c6/c64104c.ada
! 0d80f34c16a2ae02db45210c6b66eaa8  gcc/testsuite/ada/acats-3/tests/c6/c64104d.ada
! 5dc873b400a6675c734e431ac91f74db  gcc/testsuite/ada/acats-3/tests/c6/c64104e.ada
! 54921e31e5a30e388946a946c10c8954  gcc/testsuite/ada/acats-3/tests/c6/c64104f.ada
! b763fdc647a8b6c2e8ccdcc7b2e1556c  gcc/testsuite/ada/acats-3/tests/c6/c64104g.ada
! 0a7c01deaae4401d7fe1f7f78e4e6325  gcc/testsuite/ada/acats-3/tests/c6/c64104h.ada
! 39b3c50eb36b7e11b1d9e78a7b3f9132  gcc/testsuite/ada/acats-3/tests/c6/c64104i.ada
! a30f87a67e828d3791f26521921a8f81  gcc/testsuite/ada/acats-3/tests/c6/c64104j.ada
! 8906347f1c0f027d889a06f25fcc1831  gcc/testsuite/ada/acats-3/tests/c6/c64104k.ada
! 4cb01879b0f85af48c5474c558534e54  gcc/testsuite/ada/acats-3/tests/c6/c64104l.ada
! cd1d978bf7503e964f5c0293089096c1  gcc/testsuite/ada/acats-3/tests/c6/c64104m.ada
! 62990064fd13a84570c91f3d1f71338f  gcc/testsuite/ada/acats-3/tests/c6/c64104n.ada
! ff64768b090411d3f8232b7dc479db5f  gcc/testsuite/ada/acats-3/tests/c6/c64104o.ada
! c371cb358b8e763068dd4af101cd7f51  gcc/testsuite/ada/acats-3/tests/c6/c64105a.ada
! f1cfabbe7fa319f7a90669a5a1d88874  gcc/testsuite/ada/acats-3/tests/c6/c64105b.ada
! 484938df1d2ea23b4699185521d927ae  gcc/testsuite/ada/acats-3/tests/c6/c64105c.ada
! 98ba505c37a1fa4544aa7a16f86476d8  gcc/testsuite/ada/acats-3/tests/c6/c64105d.ada
! 7f5ef4e4117e3403c814c8b2d6248652  gcc/testsuite/ada/acats-3/tests/c6/c64106a.ada
! c719851b2aa8d7de278a61b4ae401e7f  gcc/testsuite/ada/acats-3/tests/c6/c64106b.ada
! 99b026e3c033b0bc70bbb34952c61a90  gcc/testsuite/ada/acats-3/tests/c6/c64106c.ada
! 1ff08389beb50526e6d5946f3ddfa0d2  gcc/testsuite/ada/acats-3/tests/c6/c64106d.ada
! 19103ed02e019b6f2490bd4285878194  gcc/testsuite/ada/acats-3/tests/c6/c64107a.ada
! 93d945e280814e3db9cdaa9a9be57e87  gcc/testsuite/ada/acats-3/tests/c6/c64108a.ada
! 39bf7a6fa5bcfb5ee8e52f5f07fafefc  gcc/testsuite/ada/acats-3/tests/c6/c64109a.ada
! 7a1023fda1950978c62798e5caff709c  gcc/testsuite/ada/acats-3/tests/c6/c64109b.ada
! 276b67fe008e97a4988487fc615e1f3c  gcc/testsuite/ada/acats-3/tests/c6/c64109c.ada
! 80192570a6b338162a9ef9bfc13a4dff  gcc/testsuite/ada/acats-3/tests/c6/c64109d.ada
! 4719b8ddae4538b59e04d96c932a95d9  gcc/testsuite/ada/acats-3/tests/c6/c64109e.ada
! ed4b4f3ef743bc7f8f4a6afe5886cae2  gcc/testsuite/ada/acats-3/tests/c6/c64109f.ada
! 8f7ab91cec27ffbad7b51252ef99b137  gcc/testsuite/ada/acats-3/tests/c6/c64109g.ada
! 2bb8cec80fd6bc3ed2495c9581ea2a9e  gcc/testsuite/ada/acats-3/tests/c6/c64109h.ada
! 495be9b835fa97670e1a579d72a3f96d  gcc/testsuite/ada/acats-3/tests/c6/c64109i.ada
! 547c93bc4be631648c9973120c282a89  gcc/testsuite/ada/acats-3/tests/c6/c64109j.ada
! 4da6b83416827b9d2d574334772ff2a3  gcc/testsuite/ada/acats-3/tests/c6/c64109k.ada
! 6217fe2218b5d9ecf085e1b730917030  gcc/testsuite/ada/acats-3/tests/c6/c64109l.ada
! dde2e62be923a3854e5f1667c4a78def  gcc/testsuite/ada/acats-3/tests/c6/c64201b.ada
! c3459cee62caf16a8d14f820e16c4f60  gcc/testsuite/ada/acats-3/tests/c6/c64201c.ada
! e589f5c8d3bb97575b245a37a5f2dffa  gcc/testsuite/ada/acats-3/tests/c6/c64202a.ada
! 249c4ba928b3c2a034f8beb44bc9dc87  gcc/testsuite/ada/acats-3/tests/c6/c650002.a
! 1daba8b521ac51502253586af8575c04  gcc/testsuite/ada/acats-3/tests/c6/c650003.a
! 25c48d1366d3ac13453832dcee471f3f  gcc/testsuite/ada/acats-3/tests/c6/c65003a.ada
! beca3ad5c25f888eed6dc6b1db750e33  gcc/testsuite/ada/acats-3/tests/c6/c65003b.ada
! 3d99b1b94c81e0ceb7c56da5b41ffa66  gcc/testsuite/ada/acats-3/tests/c6/c650a01.a
! eceb334eefb06549070d0660d7e209a2  gcc/testsuite/ada/acats-3/tests/c6/c651001.a
! f9c43a72052149152ab5e663d5bf62ee  gcc/testsuite/ada/acats-3/tests/c6/c660001.a
! 4eca86193e279acda5aa647dab2bf5bf  gcc/testsuite/ada/acats-3/tests/c6/c66002a.ada
! 7cbfd161ceac490eb379a5c08eb1945c  gcc/testsuite/ada/acats-3/tests/c6/c66002c.ada
! 482c9214fae39fbcab58fcbae0b5b5ef  gcc/testsuite/ada/acats-3/tests/c6/c66002d.ada
! 7a93f84ee40f38fca4afb6cfd5e69a57  gcc/testsuite/ada/acats-3/tests/c6/c66002e.ada
! 2b60fab145676d717df13cdf9c7a70cb  gcc/testsuite/ada/acats-3/tests/c6/c66002f.ada
! ea770ca1e9d9fcb8b4460d5921747ef5  gcc/testsuite/ada/acats-3/tests/c6/c66002g.ada
! 8470fdb16485b4472bee0602f1f98734  gcc/testsuite/ada/acats-3/tests/c6/c67002a.ada
! 0e2fbb4deae7d888206b0ce77fc4fda5  gcc/testsuite/ada/acats-3/tests/c6/c67002b.ada
! 308d5f91802e93205222e8ca1f7def1e  gcc/testsuite/ada/acats-3/tests/c6/c67002c.ada
! 84e0adc30ed2874abaffa33f713cc51b  gcc/testsuite/ada/acats-3/tests/c6/c67002d.ada
! ddfdc630c5edd58e367ed9b034c039e7  gcc/testsuite/ada/acats-3/tests/c6/c67002e.ada
! 49b95c1cbdb6c703d2eba605f6f06c92  gcc/testsuite/ada/acats-3/tests/c6/c67003f.ada
! 213a9e52b5357a07997f1aa43ec82624  gcc/testsuite/ada/acats-3/tests/c6/c67005a.ada
! ddd7cdd9502a723b17b40bcb1df0e016  gcc/testsuite/ada/acats-3/tests/c6/c67005b.ada
! 20a99f6c582810cf18b39ab642f4024f  gcc/testsuite/ada/acats-3/tests/c6/c67005c.ada
! 8ea8c4445f5e72cc88e8dad14b66084e  gcc/testsuite/ada/acats-3/tests/c6/c67005d.ada
! 69f93d5f57d1b7956ae380ff9f3e5f77  gcc/testsuite/ada/acats-3/tests/c7/c72001b.ada
! b6fa12bd9fd0f617b4eeded7550722c2  gcc/testsuite/ada/acats-3/tests/c7/c72002a.ada
! c70f104ca78b3298a442973676af108a  gcc/testsuite/ada/acats-3/tests/c7/c730001.a
! 7d2edfee282ba04ca7f25bef0f101057  gcc/testsuite/ada/acats-3/tests/c7/c730002.a
! 7822b69c5c1de14250eaad43da14736b  gcc/testsuite/ada/acats-3/tests/c7/c730003.a
! ced40d2c1dbfd9c72c43feedd4c9cefc  gcc/testsuite/ada/acats-3/tests/c7/c730004.a
! d3f7b50b0820bac4ce78abffb5e37744  gcc/testsuite/ada/acats-3/tests/c7/c73002a.ada
! c70763cb0718b44fa8658ee9ebb8c726  gcc/testsuite/ada/acats-3/tests/c7/c730a01.a
! 4ecce7babf24585f115e0d288f17e449  gcc/testsuite/ada/acats-3/tests/c7/c730a02.a
! 9c311ffdc62d1b99a3452b1e38d15e2e  gcc/testsuite/ada/acats-3/tests/c7/c731001.a
! be09078047844bd86eef86d5755ef273  gcc/testsuite/ada/acats-3/tests/c7/c74004a.ada
! a0a0a05e6225a07b7bd0f2c049f1dc37  gcc/testsuite/ada/acats-3/tests/c7/c74203a.ada
! a718857277037741ea3600c1aab95a3d  gcc/testsuite/ada/acats-3/tests/c7/c74206a.ada
! 0efca36cdb74fc57aec9e1de78e0324f  gcc/testsuite/ada/acats-3/tests/c7/c74207b.ada
! 7ceb0d1778d1a1bae9687bebd7aad9e3  gcc/testsuite/ada/acats-3/tests/c7/c74208a.ada
! bf7859fde348fa96735368f14e0a3e25  gcc/testsuite/ada/acats-3/tests/c7/c74208b.ada
! 7d504e824db220a636160024b4e963d6  gcc/testsuite/ada/acats-3/tests/c7/c74209a.ada
! 3f31b8eb73e78f20cdcf118aa7d0047c  gcc/testsuite/ada/acats-3/tests/c7/c74210a.ada
! 442ab4135e3f1fdfffacf000f7b4bda3  gcc/testsuite/ada/acats-3/tests/c7/c74211a.ada
! 49650c69957d01ffb396db79a35589c4  gcc/testsuite/ada/acats-3/tests/c7/c74211b.ada
! 30155693ce7b3f29189da859d313eb7d  gcc/testsuite/ada/acats-3/tests/c7/c74302a.ada
! 73469fa8506968a2026de265efd8a8f5  gcc/testsuite/ada/acats-3/tests/c7/c74302b.ada
! b559e9bf4e98700fb810e406c30a34b7  gcc/testsuite/ada/acats-3/tests/c7/c74305a.ada
! f1b9307b4d428cf0d10bc48805ffb0f3  gcc/testsuite/ada/acats-3/tests/c7/c74305b.ada
! 4d9094e9183691ac1e749b6abac166d7  gcc/testsuite/ada/acats-3/tests/c7/c74306a.ada
! d62a4df3fab829d5694cbf9f5cc4cb8e  gcc/testsuite/ada/acats-3/tests/c7/c74307a.ada
! 933ca49dcfb9ad8fc25ea9a434984d05  gcc/testsuite/ada/acats-3/tests/c7/c74401d.ada
! 502d8871fd7e5d6399f7536874735597  gcc/testsuite/ada/acats-3/tests/c7/c74401e.ada
! 2514504f60fcea97d8914fabcb5654cf  gcc/testsuite/ada/acats-3/tests/c7/c74401k.ada
! 3ca8e77b02dbd7f9e9104dd0fa6de35b  gcc/testsuite/ada/acats-3/tests/c7/c74401q.ada
! d30f33bfdaf9612ea55c7659c3b5aeb6  gcc/testsuite/ada/acats-3/tests/c7/c74402a.ada
! cf79bb4fcbdf7ec1cd795607eef8bc10  gcc/testsuite/ada/acats-3/tests/c7/c74402b.ada
! f6ece8469b7d90aef496ac665f895003  gcc/testsuite/ada/acats-3/tests/c7/c74406a.ada
! cce5e695d18f537ec2a8d6c26cfc5b0d  gcc/testsuite/ada/acats-3/tests/c7/c74407b.ada
! 316be518a848dd0954d80de977e40c5b  gcc/testsuite/ada/acats-3/tests/c7/c74409b.ada
! 78e666497e23ea6be9923b7d66f8d6d0  gcc/testsuite/ada/acats-3/tests/c7/c750b01.a
! c751f318a2fe16dadb0c62221c726b70  gcc/testsuite/ada/acats-3/tests/c7/c760001.a
! f250c0eea5cbe1e05ed28f0a940949ed  gcc/testsuite/ada/acats-3/tests/c7/c760002.a
! c12d4d7698c111ee3a094c0c2d53522a  gcc/testsuite/ada/acats-3/tests/c7/c760007.a
! 767d3e26a992541aa6191923e040a107  gcc/testsuite/ada/acats-3/tests/c7/c760009.a
! 264f06f0190602b655e5f7fefb6822b8  gcc/testsuite/ada/acats-3/tests/c7/c760010.a
! 31eaca7f3a33de78c9eaa1a92109c6ad  gcc/testsuite/ada/acats-3/tests/c7/c760011.a
! 522805071c7c096b6eabcd72cf833d9a  gcc/testsuite/ada/acats-3/tests/c7/c760012.a
! a4f8e8b6876d4b862928b00edca5f5d9  gcc/testsuite/ada/acats-3/tests/c7/c760013.a
! a37ffbe46b838c3dc3e654c0d3ed95a5  gcc/testsuite/ada/acats-3/tests/c7/c760015.a
! 6d1036753e3e9e32f4e5aa75ec3afc72  gcc/testsuite/ada/acats-3/tests/c7/c760a02.a
! 45d67d0e3319e953b892c7d115460ecd  gcc/testsuite/ada/acats-3/tests/c7/c761001.a
! 080dcc3c8d2907579e1673c23433165f  gcc/testsuite/ada/acats-3/tests/c7/c761002.a
! d0ecfbaed2a882166d23beefe5f4e191  gcc/testsuite/ada/acats-3/tests/c7/c761003.a
! 553e4393e53175606097eb8c9b415d22  gcc/testsuite/ada/acats-3/tests/c7/c761004.a
! 4a7c5e1c13695ae75ad3a4df49a55b63  gcc/testsuite/ada/acats-3/tests/c7/c761005.a
! d4f8faae1d5f7970e56d7a30c10a99c7  gcc/testsuite/ada/acats-3/tests/c7/c761006.a
! a8b974a47ec1f7a4a5fc2ef06975f069  gcc/testsuite/ada/acats-3/tests/c7/c761007.a
! 6ca84026fc9a5682d2db1f346eb920cd  gcc/testsuite/ada/acats-3/tests/c7/c761010.a
! 8f26af4ffb9bc7a2e15aee7b1c0c2346  gcc/testsuite/ada/acats-3/tests/c7/c761011.a
! d80406039e2bebf54191eec198c10721  gcc/testsuite/ada/acats-3/tests/c7/c761012.a
! 7eeee1f9268711339cf1323b9bd1841e  gcc/testsuite/ada/acats-3/tests/c7/c761013.a
! f7baee35e01e625d64802c987ddc4c0d  gcc/testsuite/ada/acats-3/tests/c8/c83007a.ada
! 9f1228dfaacf209725a2e8d706128a4c  gcc/testsuite/ada/acats-3/tests/c8/c83012d.ada
! a2e774207100bd5fbb0289bb8ba9f031  gcc/testsuite/ada/acats-3/tests/c8/c83022a.ada
! c214085c4cbff44807225c3aee9be7db  gcc/testsuite/ada/acats-3/tests/c8/c83022g0.ada
! 7aeac4b952eedc1419039fc50c66c732  gcc/testsuite/ada/acats-3/tests/c8/c83022g1.ada
! fedc05f63c2cd512653891054d7d5dad  gcc/testsuite/ada/acats-3/tests/c8/c83023a.ada
! 94cc28ec1a7a9d2aedbab6f2101d2215  gcc/testsuite/ada/acats-3/tests/c8/c83024a.ada
! cd79a99f6b5ce8030462ce917a77a33c  gcc/testsuite/ada/acats-3/tests/c8/c83024e0.ada
! b03af2deceb02b0227f887041379f641  gcc/testsuite/ada/acats-3/tests/c8/c83024e1.ada
! d7544d2786bfc552a30612041df95429  gcc/testsuite/ada/acats-3/tests/c8/c83025a.ada
! 881d6130cfcbd30f4a739889d50396da  gcc/testsuite/ada/acats-3/tests/c8/c83025c.ada
! f35a334aaf4110ea4446247ad6a098f4  gcc/testsuite/ada/acats-3/tests/c8/c83027a.ada
! 37c08965e5d871d3a35ff35f67e713d8  gcc/testsuite/ada/acats-3/tests/c8/c83027c.ada
! 32c440ad7d9ac139bbd4251c4fc10cc4  gcc/testsuite/ada/acats-3/tests/c8/c83028a.ada
! 284725a771243ec2eb877c3bb20240af  gcc/testsuite/ada/acats-3/tests/c8/c83029a.ada
! 0d4d1e41b05e2587d04c09930491aecd  gcc/testsuite/ada/acats-3/tests/c8/c83030a.ada
! 736b92fd2fdec116e1e9a28e04fe105a  gcc/testsuite/ada/acats-3/tests/c8/c83030c.ada
! 8e7b338ab4662f4c219903b9017a3252  gcc/testsuite/ada/acats-3/tests/c8/c83031a.ada
! 8799fc3b7ae4481b9d03ab137000f62e  gcc/testsuite/ada/acats-3/tests/c8/c83031c.ada
! 4c6a471797dc4320ecdae183b931f1e8  gcc/testsuite/ada/acats-3/tests/c8/c83031e.ada
! a6758128580028e639e0a59521425cf0  gcc/testsuite/ada/acats-3/tests/c8/c83032a.ada
! 72628676c750edbd1f98131cb5571a2f  gcc/testsuite/ada/acats-3/tests/c8/c83033a.ada
! 9431427fb4aa9f6e7d3a4375ffaecc6c  gcc/testsuite/ada/acats-3/tests/c8/c83051a.ada
! f2fa97381bbbbba9176ccf7627ee5fd8  gcc/testsuite/ada/acats-3/tests/c8/c83b02a.ada
! 03bdf2b2546804982387b339182818e7  gcc/testsuite/ada/acats-3/tests/c8/c83b02b.ada
! 40875d29e98f8a554f57a2cbba7d7b3e  gcc/testsuite/ada/acats-3/tests/c8/c83e02a.ada
! 14cf40af4f9b58380697256b2d355287  gcc/testsuite/ada/acats-3/tests/c8/c83e02b.ada
! 200ef6a026cfe27a93be29d96cf214b8  gcc/testsuite/ada/acats-3/tests/c8/c83e03a.ada
! ad5525a2d740a4d893fcd637c63649fd  gcc/testsuite/ada/acats-3/tests/c8/c83f01a.ada
! e565198c8053dc81f1f530025b0d226b  gcc/testsuite/ada/acats-3/tests/c8/c83f01b.ada
! 6d7321886000c19fde08f583e57a7e33  gcc/testsuite/ada/acats-3/tests/c8/c83f01c0.ada
! b0f89c8df04b680d3d4603f896b4d648  gcc/testsuite/ada/acats-3/tests/c8/c83f01c1.ada
! faebab8928acaa2b8fbf803db9d9d76e  gcc/testsuite/ada/acats-3/tests/c8/c83f01c2.ada
! 76e6504b3bae53ff3ed9396d5c7812a4  gcc/testsuite/ada/acats-3/tests/c8/c83f01d0.ada
! 64bf8f6ff542539524d925d1e5a9cfe4  gcc/testsuite/ada/acats-3/tests/c8/c83f01d1.ada
! 8a46931f49572809caa7fa3dacf72336  gcc/testsuite/ada/acats-3/tests/c8/c83f03a.ada
! 12f92031807ee7b6703ecca17d07c9ad  gcc/testsuite/ada/acats-3/tests/c8/c83f03b.ada
! 2f7e657595b99ed4902cb3ed7aae770f  gcc/testsuite/ada/acats-3/tests/c8/c83f03c0.ada
! b07043910b1b62a4647fb0958270ab2e  gcc/testsuite/ada/acats-3/tests/c8/c83f03c1.ada
! 2a8ed5812b7eba602e55bc4cba957511  gcc/testsuite/ada/acats-3/tests/c8/c83f03c2.ada
! d29900c193533f0d919bf89d2bc8e119  gcc/testsuite/ada/acats-3/tests/c8/c83f03d0.ada
! a81483935d1a82f02d88010465d1f944  gcc/testsuite/ada/acats-3/tests/c8/c83f03d1.ada
! 29bd80df35d00ef1384ad39409db64f6  gcc/testsuite/ada/acats-3/tests/c8/c840001.a
! af9ade351c5ef6a9d951a20d59988380  gcc/testsuite/ada/acats-3/tests/c8/c84002a.ada
! 66d1e4c5ecfdc60f73f72122f13591ac  gcc/testsuite/ada/acats-3/tests/c8/c84005a.ada
! aa6a6f80ff85e69f2df4df4eede3b31f  gcc/testsuite/ada/acats-3/tests/c8/c84008a.ada
! 09c80b3d29e25029f03088427d21bbcc  gcc/testsuite/ada/acats-3/tests/c8/c84009a.ada
! d7b3488b66a68bdb7c8d505ca3419ac7  gcc/testsuite/ada/acats-3/tests/c8/c85004b.ada
! 3e0403d2aa151370c2f61352a9f76996  gcc/testsuite/ada/acats-3/tests/c8/c85005a.ada
! 37c7fd0ed7d0bc32d740e9c53a118651  gcc/testsuite/ada/acats-3/tests/c8/c85005b.ada
! 1fc662c5706ae3323d79577161aa2b7c  gcc/testsuite/ada/acats-3/tests/c8/c85005c.ada
! c7c4cd7450d2b2ce6c9f804ab189b71e  gcc/testsuite/ada/acats-3/tests/c8/c85005d.ada
! 39a019807c800fea7de5ee674f51f3ac  gcc/testsuite/ada/acats-3/tests/c8/c85005e.ada
! 8d1e127599b478a2675315047b0c481f  gcc/testsuite/ada/acats-3/tests/c8/c85005f.ada
! 25bfcee3ce65c19279f2e6ae6c7dbfba  gcc/testsuite/ada/acats-3/tests/c8/c85005g.ada
! 32fef31a23447e83e62b591ccf214749  gcc/testsuite/ada/acats-3/tests/c8/c85006a.ada
! 52a38ccdb969e742c721e8c6b91f9aee  gcc/testsuite/ada/acats-3/tests/c8/c85006b.ada
! b8b2355c13723ce1e608404a697d37f1  gcc/testsuite/ada/acats-3/tests/c8/c85006c.ada
! f9f754296bb969ded99acf18e0d0cc57  gcc/testsuite/ada/acats-3/tests/c8/c85006d.ada
! 13a5f5c38fb9c62ade83208e0c68d79e  gcc/testsuite/ada/acats-3/tests/c8/c85006e.ada
! 338359196a7f9ec95687b438473fe4b5  gcc/testsuite/ada/acats-3/tests/c8/c85006f.ada
! 2009399861eb5a59e17598709aab1ac2  gcc/testsuite/ada/acats-3/tests/c8/c85006g.ada
! 81de8bcdf2627a437c3e3b841e5fad1d  gcc/testsuite/ada/acats-3/tests/c8/c85007a.ada
! e357cc223f207047a721ac8e8e18f162  gcc/testsuite/ada/acats-3/tests/c8/c85007e.ada
! 418333040a3a7bff04eadeddd0acb110  gcc/testsuite/ada/acats-3/tests/c8/c85009a.ada
! bd6854facde59a298fdff160083dd037  gcc/testsuite/ada/acats-3/tests/c8/c85011a.ada
! 406a5955e9d949bdd8248e3006f85389  gcc/testsuite/ada/acats-3/tests/c8/c85013a.ada
! 847c4a7e1cbd34854fd30fd728898157  gcc/testsuite/ada/acats-3/tests/c8/c85014a.ada
! b69434a64d3c484bdb87a84269e9963f  gcc/testsuite/ada/acats-3/tests/c8/c85014b.ada
! 2f3c5aa4857fe502b1c9c11e032c6935  gcc/testsuite/ada/acats-3/tests/c8/c85014c.ada
! e1660d68b127c37ec14d42ba45a3b445  gcc/testsuite/ada/acats-3/tests/c8/c85017a.ada
! 1cad26f34f7ad9a5f58bf9e88765aca9  gcc/testsuite/ada/acats-3/tests/c8/c85018a.ada
! 9c45b00830d440af2ac60b55d681400a  gcc/testsuite/ada/acats-3/tests/c8/c85018b.ada
! 8d0a794043808c838cf5adba232cacac  gcc/testsuite/ada/acats-3/tests/c8/c85019a.ada
! 5af58d5fd0b267936c4997ebc76c592f  gcc/testsuite/ada/acats-3/tests/c8/c851001.a
! a2bad21f51f5945720e9692701781872  gcc/testsuite/ada/acats-3/tests/c8/c851002.a
! 9b74243be116d7855c67ebe955d78830  gcc/testsuite/ada/acats-3/tests/c8/c854001.a
! 825c879ca9c376275c17511ad5e00304  gcc/testsuite/ada/acats-3/tests/c8/c854002.a
! d68292de38c7b9e049e07075bbb8e3be  gcc/testsuite/ada/acats-3/tests/c8/c854003.a
! 1f1f18804e6fcf9c4e2fbec6349d04b2  gcc/testsuite/ada/acats-3/tests/c8/c86003a.ada
! e2f34ff3aa901cdf44aa714bfc307b17  gcc/testsuite/ada/acats-3/tests/c8/c86004a.ada
! d4f2cc5c80e276eb1480de6a342d8b63  gcc/testsuite/ada/acats-3/tests/c8/c86004b0.ada
! 50f93d108a0bf0919eb0ba1f6e65d7f0  gcc/testsuite/ada/acats-3/tests/c8/c86004b1.ada
! 6c2d0d9c9429d88e2c6672c71366873c  gcc/testsuite/ada/acats-3/tests/c8/c86004b2.ada
! 7f6e918b2ef0b5adc4139d9b912bc081  gcc/testsuite/ada/acats-3/tests/c8/c86004c0.ada
! a2305c116ad2dac3912371b71c441b61  gcc/testsuite/ada/acats-3/tests/c8/c86004c1.ada
! c7b7606151d38f39564979699b168c79  gcc/testsuite/ada/acats-3/tests/c8/c86004c2.ada
! 0766251158ffbc052bc7ec6041412761  gcc/testsuite/ada/acats-3/tests/c8/c86006i.ada
! 69ab336267b976906702c2d0bc1c1e29  gcc/testsuite/ada/acats-3/tests/c8/c86007a.ada
! 0ac058a1ece69aa243cd82dada40bb30  gcc/testsuite/ada/acats-3/tests/c8/c87a05a.ada
! fff71eeb0c0e9f16ee678756ea7588a4  gcc/testsuite/ada/acats-3/tests/c8/c87a05b.ada
! 2fe0ea4d16046c334c399aafeddc01a8  gcc/testsuite/ada/acats-3/tests/c8/c87b02a.ada
! fcd21b497cf853422b084ed7935381d4  gcc/testsuite/ada/acats-3/tests/c8/c87b02b.ada
! c0b66a348c2ee10edc5467a8eb009d09  gcc/testsuite/ada/acats-3/tests/c8/c87b03a.ada
! adac4007a7fd6b1ee9f1f48c55244d47  gcc/testsuite/ada/acats-3/tests/c8/c87b04a.ada
! 18ccfb1a0d973da4e1686b0c98dfa1a9  gcc/testsuite/ada/acats-3/tests/c8/c87b04b.ada
! 43cf46342879eb1ffe2f7c8971af6a38  gcc/testsuite/ada/acats-3/tests/c8/c87b04c.ada
! d0144de0520c60120721d7b571e3985d  gcc/testsuite/ada/acats-3/tests/c8/c87b05a.ada
! 2b781472cd1369f9eb86a64cd5e4a9d9  gcc/testsuite/ada/acats-3/tests/c8/c87b06a.ada
! c22a9ce42feb05505f797ccc539112bd  gcc/testsuite/ada/acats-3/tests/c8/c87b07a.ada
! 5cb748b4c292f38beadd4b397c9748ef  gcc/testsuite/ada/acats-3/tests/c8/c87b07b.ada
! cd570d3799a0f4ceeabe1513e0c1c809  gcc/testsuite/ada/acats-3/tests/c8/c87b07c.ada
! 94b970485847bd2d888e33a9e0bbeb1c  gcc/testsuite/ada/acats-3/tests/c8/c87b07d.ada
! 4a11dd4cf1ef59a68c9760ade0024c31  gcc/testsuite/ada/acats-3/tests/c8/c87b07e.ada
! e031b7e0f562bef1da7d73abf8e7203d  gcc/testsuite/ada/acats-3/tests/c8/c87b08a.ada
! ddc6096fff2cbf60aa3fe948c1c569c3  gcc/testsuite/ada/acats-3/tests/c8/c87b09a.ada
! 427f1fe54f5946c6611f5abe3d23e213  gcc/testsuite/ada/acats-3/tests/c8/c87b09c.ada
! 4f2d8b50e737f09ccf25f199443471c8  gcc/testsuite/ada/acats-3/tests/c8/c87b10a.ada
! b3ddde623ffa0748cae187472ed3c706  gcc/testsuite/ada/acats-3/tests/c8/c87b11a.ada
! 34f04500698b844ee3bbe19fcec6df7b  gcc/testsuite/ada/acats-3/tests/c8/c87b11b.ada
! 42486daf86c543499fe18e7700c2a2c5  gcc/testsuite/ada/acats-3/tests/c8/c87b13a.ada
! 343104f8b07cc3cdfea584fb91d7dad0  gcc/testsuite/ada/acats-3/tests/c8/c87b14a.ada
! 3129f63056e924075c9eef5fb92ff6be  gcc/testsuite/ada/acats-3/tests/c8/c87b14b.ada
! 9fec6d81e8cfe9a1be8263f1fcff0c24  gcc/testsuite/ada/acats-3/tests/c8/c87b14c.ada
! c9a24774d85aaa6a9ad204d88ef33dc3  gcc/testsuite/ada/acats-3/tests/c8/c87b14d.ada
! 75444b8bc412150144d6500a1c98caa1  gcc/testsuite/ada/acats-3/tests/c8/c87b15a.ada
! b02c9f3d290904a7b941ba27ad5b8cbe  gcc/testsuite/ada/acats-3/tests/c8/c87b16a.ada
! 352fe9e9dcbad212440a7cb09e0f5a22  gcc/testsuite/ada/acats-3/tests/c8/c87b17a.ada
! da9c835dde5437b7c6fd41430e0523c7  gcc/testsuite/ada/acats-3/tests/c8/c87b18a.ada
! 6233d050a9dc22ef89142ebf8f28ccf0  gcc/testsuite/ada/acats-3/tests/c8/c87b18b.ada
! 8d538ac45635004402030cb4640caa57  gcc/testsuite/ada/acats-3/tests/c8/c87b19a.ada
! 2095765cd4def145a48bc901ac6dbde1  gcc/testsuite/ada/acats-3/tests/c8/c87b23a.ada
! 67d87906e113b008e98391cc2776a960  gcc/testsuite/ada/acats-3/tests/c8/c87b24a.ada
! fd73894f92a9b3a013e87ea2b44c1ee4  gcc/testsuite/ada/acats-3/tests/c8/c87b24b.ada
! 3477f0a964a425447d80f280e7b45bf2  gcc/testsuite/ada/acats-3/tests/c8/c87b26b.ada
! b14d1be798ca4f79c28b996d1e8a7113  gcc/testsuite/ada/acats-3/tests/c8/c87b27a.ada
! 52b1e1223a0044bd348db0fcb6d79d6b  gcc/testsuite/ada/acats-3/tests/c8/c87b28a.ada
! a6a5c9403ac6bdbdb2e55d6a25b9f5ed  gcc/testsuite/ada/acats-3/tests/c8/c87b29a.ada
! b151ba31fb04091b8702bb9da4a0a2fb  gcc/testsuite/ada/acats-3/tests/c8/c87b30a.ada
! baa7d485e6d766db9246c9606ba3a078  gcc/testsuite/ada/acats-3/tests/c8/c87b31a.ada
! 78fd2d4c2c4821cfbbf402d3b842e2cc  gcc/testsuite/ada/acats-3/tests/c8/c87b32a.ada
! 833d7f92c1dba9641ebcb3157ab5d24e  gcc/testsuite/ada/acats-3/tests/c8/c87b33a.ada
! 36465d48d4bab661c6218ee48524b608  gcc/testsuite/ada/acats-3/tests/c8/c87b34a.ada
! 561be38a9a0275b65d22f782b23c1f8c  gcc/testsuite/ada/acats-3/tests/c8/c87b34b.ada
! 1239485e0f456d72c43f397227762788  gcc/testsuite/ada/acats-3/tests/c8/c87b34c.ada
! 041b7b6888183bbf71655055555c1b87  gcc/testsuite/ada/acats-3/tests/c8/c87b35c.ada
! ba86ee0565261018e59b1b01d9d63a78  gcc/testsuite/ada/acats-3/tests/c8/c87b38a.ada
! bee8f2cc8e7a407c5d1e665cafb324a0  gcc/testsuite/ada/acats-3/tests/c8/c87b39a.ada
! 0149e0004f1fac32a6d0483505f00a77  gcc/testsuite/ada/acats-3/tests/c8/c87b40a.ada
! 598db3dd5aa31e1541f0b3c4292552c9  gcc/testsuite/ada/acats-3/tests/c8/c87b41a.ada
! 35740da1bae3e32ad7726fef598ebe03  gcc/testsuite/ada/acats-3/tests/c8/c87b42a.ada
! c699f8cb33019178eb66bb9b9887fc34  gcc/testsuite/ada/acats-3/tests/c8/c87b43a.ada
! 284fc10b4e768deed27f6efe5ba660f3  gcc/testsuite/ada/acats-3/tests/c8/c87b44a.ada
! d1cacfe3528a0559f8572409bdad7960  gcc/testsuite/ada/acats-3/tests/c8/c87b45a.ada
! 615100562dae434f6237d50c2ce7a859  gcc/testsuite/ada/acats-3/tests/c8/c87b45c.ada
! ee9fa629414e1ff85ab5a901880627c6  gcc/testsuite/ada/acats-3/tests/c8/c87b47a.ada
! f01c1e9a040d9bf9e82d5b0bd8308ac2  gcc/testsuite/ada/acats-3/tests/c8/c87b48a.ada
! 5f12e71520b411de1dcbfb59ca609af5  gcc/testsuite/ada/acats-3/tests/c8/c87b48b.ada
! 7accae5d8bcb7a6376aeb4769bbc3521  gcc/testsuite/ada/acats-3/tests/c8/c87b50a.ada
! 49e93ad6fd90f250357c964cfe65bbb4  gcc/testsuite/ada/acats-3/tests/c8/c87b54a.ada
! 6b87b80aa7e4be221c3a6fcc95a098e2  gcc/testsuite/ada/acats-3/tests/c8/c87b57a.ada
! e29430c61d05400015468771710caebe  gcc/testsuite/ada/acats-3/tests/c8/c87b62a.ada
! d69bb1d50cac4c6397e7ef6ac85cec47  gcc/testsuite/ada/acats-3/tests/c8/c87b62b.ada
! b2cd3c65ecd1e96a0c0812252c334c48  gcc/testsuite/ada/acats-3/tests/c8/c87b62c.ada
! f48458b6ea766af192adb8d401f368fc  gcc/testsuite/ada/acats-3/tests/c8/c87b62d.tst
! 91802a6e8fc88eaea2b276279ef7c541  gcc/testsuite/ada/acats-3/tests/c9/c910001.a
! 92f4e59378989d90d762b2fdfa367275  gcc/testsuite/ada/acats-3/tests/c9/c910002.a
! 1da7e86ddeb55b8594570c708479d7da  gcc/testsuite/ada/acats-3/tests/c9/c910003.a
! 3e61dff323d06b22fad060cfc4e6bbe3  gcc/testsuite/ada/acats-3/tests/c9/c91004b.ada
! 69469a828c0050868f258475fc71f55d  gcc/testsuite/ada/acats-3/tests/c9/c91004c.ada
! 0ff6798e735543f9ea0902dcd3d33bd4  gcc/testsuite/ada/acats-3/tests/c9/c91006a.ada
! 7f1ab85728a76023b65305acb8480064  gcc/testsuite/ada/acats-3/tests/c9/c91007a.ada
! c2fa652957f9477e9fdbf25f5008ae78  gcc/testsuite/ada/acats-3/tests/c9/c920001.a
! b04d09f1322f0d92c98d41398964503d  gcc/testsuite/ada/acats-3/tests/c9/c92002a.ada
! 5cb78880eadfd9eac647aba39fa528da  gcc/testsuite/ada/acats-3/tests/c9/c92003a.ada
! bfa0af83fa76f2092a243ddded4670d8  gcc/testsuite/ada/acats-3/tests/c9/c92005a.ada
! 379c27e94764b3b61fffdc4a6886f267  gcc/testsuite/ada/acats-3/tests/c9/c92005b.ada
! a47a031badac4df0d97db8bef1c3bc41  gcc/testsuite/ada/acats-3/tests/c9/c92006a.ada
! e4aee3e6761bfd67eaa5d1bd1ef57470  gcc/testsuite/ada/acats-3/tests/c9/c930001.a
! d21857231e61275a32c743ac514d1bc5  gcc/testsuite/ada/acats-3/tests/c9/c93001a.ada
! 493236f457ba46ba4fee16d542742d6c  gcc/testsuite/ada/acats-3/tests/c9/c93002a.ada
! 58f568faf270170c72b48115224a9ea8  gcc/testsuite/ada/acats-3/tests/c9/c93003a.ada
! 7612773970dfbe9066b04bb3ef16a233  gcc/testsuite/ada/acats-3/tests/c9/c93004a.ada
! ba12024ce449c8f19c903d5b83a7772c  gcc/testsuite/ada/acats-3/tests/c9/c93004b.ada
! 84f08b2297ca6e587b20b46ac2f4a739  gcc/testsuite/ada/acats-3/tests/c9/c93004c.ada
! e206bbe8f5a43a6b351e76ac75ac54bf  gcc/testsuite/ada/acats-3/tests/c9/c93004d.ada
! 00ac7aaad0308e432bf16c8682817a14  gcc/testsuite/ada/acats-3/tests/c9/c93004f.ada
! 08c88f164d59d4eab6aca557a4a64946  gcc/testsuite/ada/acats-3/tests/c9/c93005a.ada
! 8e317f80e3b0b4e3561b4aae157d6049  gcc/testsuite/ada/acats-3/tests/c9/c93005b.ada
! 7d334041be29ea9e8c37717a41e00262  gcc/testsuite/ada/acats-3/tests/c9/c93005c.ada
! 7eaab6600302226ca2aa221a1baa20b3  gcc/testsuite/ada/acats-3/tests/c9/c93005d.ada
! f8e495878721a71a7dbdd646b8e0a2f9  gcc/testsuite/ada/acats-3/tests/c9/c93005e.ada
! 0240c3a7deba6bd32679e222b5fadd86  gcc/testsuite/ada/acats-3/tests/c9/c93005f.ada
! c50d0176fa8ed0d5d6234013904fc2bf  gcc/testsuite/ada/acats-3/tests/c9/c93005g.ada
! 6a27b797bf6bf6201d7e22aec1399ef3  gcc/testsuite/ada/acats-3/tests/c9/c93005h.ada
! 9558fcb539a49a288534eb8b0dd23274  gcc/testsuite/ada/acats-3/tests/c9/c93006a.ada
! fe32d2d556faa4d361e61f9063f9d19b  gcc/testsuite/ada/acats-3/tests/c9/c93007a.ada
! e1f28c5786e15914c044ecc368a334c4  gcc/testsuite/ada/acats-3/tests/c9/c93008a.ada
! f12f826d928a3bc55974d9e4a7a4bced  gcc/testsuite/ada/acats-3/tests/c9/c93008b.ada
! 84c45a691f716f13c1acb83d5af7418d  gcc/testsuite/ada/acats-3/tests/c9/c940001.a
! 99f1785334b15c78f6c402eb9581f820  gcc/testsuite/ada/acats-3/tests/c9/c940002.a
! d4515a061510c374dc4e3b73047c01bd  gcc/testsuite/ada/acats-3/tests/c9/c940004.a
! 982944ab84b1e87938411f5e230c4afe  gcc/testsuite/ada/acats-3/tests/c9/c940005.a
! 24e534dd458f6d60deaffb89427151e3  gcc/testsuite/ada/acats-3/tests/c9/c940006.a
! ae39153ecdb5b40b7e250621dda2a947  gcc/testsuite/ada/acats-3/tests/c9/c940007.a
! ed93c06c8fbc77ffcb96431dac0e7567  gcc/testsuite/ada/acats-3/tests/c9/c940010.a
! b5f59a7bcad9207813e580204d7d297d  gcc/testsuite/ada/acats-3/tests/c9/c940011.a
! 2cc5af1321a3389a051ba331add4436e  gcc/testsuite/ada/acats-3/tests/c9/c940012.a
! 46c8ffa64ae0068a1674cd8386b42f41  gcc/testsuite/ada/acats-3/tests/c9/c940013.a
! 9fac2bc0e89e8f222104978b3d1eaf3b  gcc/testsuite/ada/acats-3/tests/c9/c940014.a
! 004d847da87db0a9fe57406d26459dfd  gcc/testsuite/ada/acats-3/tests/c9/c940015.a
! 47e9712a5187d745e5ab17e658f2f210  gcc/testsuite/ada/acats-3/tests/c9/c940016.a
! 2e44193305daa3662819696ed485e49e  gcc/testsuite/ada/acats-3/tests/c9/c940017.a
! 6c7757c7f82391d974ee2ade7a1b5023  gcc/testsuite/ada/acats-3/tests/c9/c94001a.ada
! f31231e0a282c4347af1efd6cb3035d8  gcc/testsuite/ada/acats-3/tests/c9/c94001b.ada
! 3b5322b2500d6db6a064276ddcb16f57  gcc/testsuite/ada/acats-3/tests/c9/c94001c.ada
! 5b89b2c47939e01428fda5cdb7b76bfc  gcc/testsuite/ada/acats-3/tests/c9/c94001e.ada
! 79b95e3bce431f5a1d5d5264c35ba5a9  gcc/testsuite/ada/acats-3/tests/c9/c94001f.ada
! 77a4dc124639ae407e5aca42c786703a  gcc/testsuite/ada/acats-3/tests/c9/c94001g.ada
! 459a8334da9a10b07073ee026daace57  gcc/testsuite/ada/acats-3/tests/c9/c94002a.ada
! ea931758bd0eaf85c1c1a04b2f7c71de  gcc/testsuite/ada/acats-3/tests/c9/c94002b.ada
! 131233ea081ac6ea10a1e10fbba005f2  gcc/testsuite/ada/acats-3/tests/c9/c94002d.ada
! 170256ffad705761ef2331d6d2a07771  gcc/testsuite/ada/acats-3/tests/c9/c94002e.ada
! 066f90e14b935717dde3fa4b96807563  gcc/testsuite/ada/acats-3/tests/c9/c94002f.ada
! 8a13ee6acd0d6f24e23333f06259df08  gcc/testsuite/ada/acats-3/tests/c9/c94002g.ada
! 22b53f93e23fb62230789979e589e181  gcc/testsuite/ada/acats-3/tests/c9/c94004a.ada
! ccdf0ff8e75742c50231602193bbcbba  gcc/testsuite/ada/acats-3/tests/c9/c94004b.ada
! 3cc3467fbedd3af4df23952c3bff55fa  gcc/testsuite/ada/acats-3/tests/c9/c94004c.ada
! 7984d0d810ada9646b57c6eaf2e1bc4f  gcc/testsuite/ada/acats-3/tests/c9/c94005a.ada
! 65127423a897761cfafb1a3b3138bb1f  gcc/testsuite/ada/acats-3/tests/c9/c94005b.ada
! 58ea156e98cc4536f068259cb7d392ce  gcc/testsuite/ada/acats-3/tests/c9/c94006a.ada
! f0bba450c8e12f8e7ee2943272781344  gcc/testsuite/ada/acats-3/tests/c9/c94007a.ada
! 0d97216a40757079eb2c5929715d2b99  gcc/testsuite/ada/acats-3/tests/c9/c94007b.ada
! 4c0be4d154afe78593220fcb4ce1db68  gcc/testsuite/ada/acats-3/tests/c9/c94008a.ada
! 96e113f41f41a01c2196b7773e735c4f  gcc/testsuite/ada/acats-3/tests/c9/c94008b.ada
! 17f5eb44b8190ee09e9f0ffcffe2e7a4  gcc/testsuite/ada/acats-3/tests/c9/c94008c.ada
! c810cc6ac3bebe36845e2cba4e525930  gcc/testsuite/ada/acats-3/tests/c9/c94008d.ada
! 03924145894e3041b88074680eceb006  gcc/testsuite/ada/acats-3/tests/c9/c94010a.ada
! 136872ec7f9870731797ab20b32f6696  gcc/testsuite/ada/acats-3/tests/c9/c94011a.ada
! a8508d1bdacc8da03549a92370d18ed0  gcc/testsuite/ada/acats-3/tests/c9/c94020a.ada
! 54dba96923cbd3444b91d1706e737c16  gcc/testsuite/ada/acats-3/tests/c9/c940a03.a
! 14ac629d930514b19edd9d5fa73cf107  gcc/testsuite/ada/acats-3/tests/c9/c95008a.ada
! b48683e2458942b3ffc46be9054c7911  gcc/testsuite/ada/acats-3/tests/c9/c95009a.ada
! b4adaad3668499bb335d018420c56f91  gcc/testsuite/ada/acats-3/tests/c9/c95010a.ada
! 2900d4b177d19e9f35c4693ea6b14ec8  gcc/testsuite/ada/acats-3/tests/c9/c95011a.ada
! 8b06e3c4ff90fbc6c87f0aa942917f64  gcc/testsuite/ada/acats-3/tests/c9/c95012a.ada
! 701e89d7711a71b3be5269c5238a18c7  gcc/testsuite/ada/acats-3/tests/c9/c95021a.ada
! c091dcb9509e234377d2ac8ee75d10e0  gcc/testsuite/ada/acats-3/tests/c9/c95022a.ada
! 65035c12f67d253a2397d2126f4ba6c6  gcc/testsuite/ada/acats-3/tests/c9/c95022b.ada
! cc0f07ec1171a66007308281b576f7c4  gcc/testsuite/ada/acats-3/tests/c9/c95033a.ada
! 4de48cf31bf233b1fdc87aeffb9972de  gcc/testsuite/ada/acats-3/tests/c9/c95033b.ada
! cc9febfaeca52b7d6647ca62001797e7  gcc/testsuite/ada/acats-3/tests/c9/c95034a.ada
! d5302e6651eeb53974a9d013a4cdedc8  gcc/testsuite/ada/acats-3/tests/c9/c95034b.ada
! 60c5c5f334073dc4d79928f49152f582  gcc/testsuite/ada/acats-3/tests/c9/c95035a.ada
! 3eda3680c647ff3fb263637efebd9f65  gcc/testsuite/ada/acats-3/tests/c9/c95040a.ada
! 8e8e82ad5bdec76ed6e7c4ae88a3b54f  gcc/testsuite/ada/acats-3/tests/c9/c95040b.ada
! ed765b423843bd4ca78de15c1b071692  gcc/testsuite/ada/acats-3/tests/c9/c95040c.ada
! 30e738c92230ba86578f011623e5802a  gcc/testsuite/ada/acats-3/tests/c9/c95040d.ada
! 168221198b482975d09392b2fcad8a7b  gcc/testsuite/ada/acats-3/tests/c9/c95041a.ada
! c6313618d1cd8a8218dcd446fd95a86e  gcc/testsuite/ada/acats-3/tests/c9/c95065a.ada
! 8832636689a3eda560469f04cfa76418  gcc/testsuite/ada/acats-3/tests/c9/c95065b.ada
! 5aaadcb32b841fad9f31245493b516f6  gcc/testsuite/ada/acats-3/tests/c9/c95065c.ada
! a39b19410538e12fdfcb7cd54d120b3f  gcc/testsuite/ada/acats-3/tests/c9/c95065d.ada
! 383b7f01039162f8c331982cca1d1827  gcc/testsuite/ada/acats-3/tests/c9/c95065e.ada
! c184eac9dc26cf8493bcf20a949ae191  gcc/testsuite/ada/acats-3/tests/c9/c95065f.ada
! 5b0b09d3d393123f8092b9dd3d7d2634  gcc/testsuite/ada/acats-3/tests/c9/c95066a.ada
! 645546a6994e4d75b178f9fe0ead2ec8  gcc/testsuite/ada/acats-3/tests/c9/c95067a.ada
! 0d96b6a028d1fbdc1198cf477386cb10  gcc/testsuite/ada/acats-3/tests/c9/c95071a.ada
! 1252b71f747f12dc764f40b587be838a  gcc/testsuite/ada/acats-3/tests/c9/c95072a.ada
! bd5b6bb2bf3ba074df027795aaa7db33  gcc/testsuite/ada/acats-3/tests/c9/c95072b.ada
! befede1120f2f7955e0b77c883265e25  gcc/testsuite/ada/acats-3/tests/c9/c95073a.ada
! 48c97fe967f3c5e1bc663c5d91ed55bd  gcc/testsuite/ada/acats-3/tests/c9/c95074c.ada
! 6aaf0bf21901d478c7f10321b1c232fc  gcc/testsuite/ada/acats-3/tests/c9/c95076a.ada
! ba053d263ff25d0fe8b66c68cb7bb311  gcc/testsuite/ada/acats-3/tests/c9/c95078a.ada
! a7e9f0e064ac2a29ebe79a19983758dc  gcc/testsuite/ada/acats-3/tests/c9/c95080b.ada
! 73fa133c9eac6146a770bb5525331e35  gcc/testsuite/ada/acats-3/tests/c9/c95082g.ada
! 61f2b9320583cc5ff1eca06b3e8cd887  gcc/testsuite/ada/acats-3/tests/c9/c95085a.ada
! 9e1cf3433f8341a6b183079a377b0fad  gcc/testsuite/ada/acats-3/tests/c9/c95085b.ada
! e39dbe6050c2679aa6a7d89c762e8c0a  gcc/testsuite/ada/acats-3/tests/c9/c95085c.ada
! 6c946d9a6886fc8b7d6145f3958a1016  gcc/testsuite/ada/acats-3/tests/c9/c95085d.ada
! c8c26f8183027ac456df33b272a0e185  gcc/testsuite/ada/acats-3/tests/c9/c95085e.ada
! e29633617dcca72904423b7e09ea1401  gcc/testsuite/ada/acats-3/tests/c9/c95085f.ada
! 3e1d9c4d7627f1b32df23e0787f1ae30  gcc/testsuite/ada/acats-3/tests/c9/c95085g.ada
! 55b52211957a2231b59c295b91e1bbfe  gcc/testsuite/ada/acats-3/tests/c9/c95085h.ada
! f472998d938475a0a5b7c61c4a994dbe  gcc/testsuite/ada/acats-3/tests/c9/c95085i.ada
! e7d6c7d1e457a9097de27a4d4b6df67e  gcc/testsuite/ada/acats-3/tests/c9/c95085j.ada
! 9dcf6b0120351dbd31ca6b3b07007dda  gcc/testsuite/ada/acats-3/tests/c9/c95085k.ada
! f65f9568bbdcba31e56e46a1bff7a8a7  gcc/testsuite/ada/acats-3/tests/c9/c95085l.ada
! 2794ec3980004ff90d3fdda0ebeb57be  gcc/testsuite/ada/acats-3/tests/c9/c95085m.ada
! cd5e6789b1381a01c8abe9b8efc437eb  gcc/testsuite/ada/acats-3/tests/c9/c95085n.ada
! ec751b6898b7a50e0c7e413ac04f3096  gcc/testsuite/ada/acats-3/tests/c9/c95085o.ada
! 4d079ed4815a2d61d769f5571e546504  gcc/testsuite/ada/acats-3/tests/c9/c95086a.ada
! 3f5ba7557a56b3376b0d11a44977eb6b  gcc/testsuite/ada/acats-3/tests/c9/c95086b.ada
! 4423694080505c12206b273d44b25a6c  gcc/testsuite/ada/acats-3/tests/c9/c95086c.ada
! 9ddcd960179a50f19400614669ee58dd  gcc/testsuite/ada/acats-3/tests/c9/c95086d.ada
! b943966db2007cce0bd0ab55a7241cb6  gcc/testsuite/ada/acats-3/tests/c9/c95086e.ada
! 63af3fb63913a9ced35b10b55e03d16c  gcc/testsuite/ada/acats-3/tests/c9/c95086f.ada
! fb4e2598701ac2222961218c56e9989e  gcc/testsuite/ada/acats-3/tests/c9/c95087a.ada
! 6ca41778e752016a3cb5f39d3655160a  gcc/testsuite/ada/acats-3/tests/c9/c95087b.ada
! b77cd9cab875027ed13370d439f3d83a  gcc/testsuite/ada/acats-3/tests/c9/c95087c.ada
! 94c2f92c8d38ace856b3d3a4e46e2f10  gcc/testsuite/ada/acats-3/tests/c9/c95087d.ada
! 8ace111d2db71af514234c843bcdc774  gcc/testsuite/ada/acats-3/tests/c9/c95088a.ada
! 3eab89caa6cfdaad3ecaee2fb3a9de67  gcc/testsuite/ada/acats-3/tests/c9/c95089a.ada
! c23a0d393dfca230669443fa90939e9e  gcc/testsuite/ada/acats-3/tests/c9/c95090a.ada
! 2dea0b25d5837e3f040a606b74b5bfe7  gcc/testsuite/ada/acats-3/tests/c9/c95092a.ada
! da5b15c611f0e80c4bd500a6377cf1fb  gcc/testsuite/ada/acats-3/tests/c9/c95093a.ada
! 411e85f00716bde0eb4bebe2dd4a4b17  gcc/testsuite/ada/acats-3/tests/c9/c95095a.ada
! 20d01625fd521f83c0fbb4e0d5989f1c  gcc/testsuite/ada/acats-3/tests/c9/c95095b.ada
! f1a2d7fb3c08ba5c9b45d28b8c434cf9  gcc/testsuite/ada/acats-3/tests/c9/c95095c.ada
! fe6c832ec4b8584b35ad79ad6f658734  gcc/testsuite/ada/acats-3/tests/c9/c95095d.ada
! d71ab35932ba486e65cee5d0a7ea6c58  gcc/testsuite/ada/acats-3/tests/c9/c95095e.ada
! b665ab275e30b4a49c6a32d1c1b8d3b0  gcc/testsuite/ada/acats-3/tests/c9/c951001.a
! 31bba47fca22f334739b1cb13505c63f  gcc/testsuite/ada/acats-3/tests/c9/c951002.a
! 380eef904bedee70e470eec6283fe7fa  gcc/testsuite/ada/acats-3/tests/c9/c953001.a
! 8b4cbf1e111e939494dbd6c9170d9add  gcc/testsuite/ada/acats-3/tests/c9/c953002.a
! b85e67ebb144368e710912fad26fa9b5  gcc/testsuite/ada/acats-3/tests/c9/c953003.a
! 349793c14b6ee642849a35ac147f6d28  gcc/testsuite/ada/acats-3/tests/c9/c954001.a
! 32a2b22071eb90de620dac85832e7e33  gcc/testsuite/ada/acats-3/tests/c9/c954010.a
! 5c71f334e75e4b81847ba6609055a721  gcc/testsuite/ada/acats-3/tests/c9/c954011.a
! 0f6b02e34f34de574c7f90adcb78c1d3  gcc/testsuite/ada/acats-3/tests/c9/c954012.a
! 0af78b179cbaf289947a4b0cc90e1b92  gcc/testsuite/ada/acats-3/tests/c9/c954013.a
! 498084096b8ec59a36a889374ad9ee3e  gcc/testsuite/ada/acats-3/tests/c9/c954014.a
! 97799887dcbf60005b2df40f05636514  gcc/testsuite/ada/acats-3/tests/c9/c954015.a
! 2490fc80b69ada26f8142dacebcc5823  gcc/testsuite/ada/acats-3/tests/c9/c954016.a
! 23e5c9126dfc78e228cd9ba7e9fd2f4d  gcc/testsuite/ada/acats-3/tests/c9/c954017.a
! bdfa1b9ada52a8082dfc30a91d56af89  gcc/testsuite/ada/acats-3/tests/c9/c954018.a
! e039ba87aa8e5a87f7f74695cc19d917  gcc/testsuite/ada/acats-3/tests/c9/c954019.a
! 718a1dda410ad24ef00a024b2e415626  gcc/testsuite/ada/acats-3/tests/c9/c954020.a
! 8f5a7fd94fd12664cdd2a1cedfcad90c  gcc/testsuite/ada/acats-3/tests/c9/c954021.a
! 34dbbc567c8a72d4e43da4684357c65d  gcc/testsuite/ada/acats-3/tests/c9/c954022.a
! acd00fcab6e1b0d13797a97adc97adb7  gcc/testsuite/ada/acats-3/tests/c9/c954023.a
! 2b49282ca4813eb7610dffe2400f50ff  gcc/testsuite/ada/acats-3/tests/c9/c954024.a
! 2331b8760176763cf23ae6f18488082f  gcc/testsuite/ada/acats-3/tests/c9/c954025.a
! 6bd1092f468dab44c0887902809a3c13  gcc/testsuite/ada/acats-3/tests/c9/c954026.a
! 97487e5b93226e3c55df7449702ac3da  gcc/testsuite/ada/acats-3/tests/c9/c954a01.a
! d07c1374471df9299b8057f6479a45e6  gcc/testsuite/ada/acats-3/tests/c9/c954a02.a
! b1b9ce862c0b325027b8ea2d1d8cc916  gcc/testsuite/ada/acats-3/tests/c9/c954a03.a
! d02e3ef0eb5c7ba2f412817b49644270  gcc/testsuite/ada/acats-3/tests/c9/c960001.a
! da6bb14a212aa02754b6596d741c04b8  gcc/testsuite/ada/acats-3/tests/c9/c960002.a
! 4c5c6b7d7706870241781f97576eef1b  gcc/testsuite/ada/acats-3/tests/c9/c960004.a
! f703a55c27d27529f63150ba86c8e428  gcc/testsuite/ada/acats-3/tests/c9/c96001a.ada
! 3551216de1ec0430cae6be8fbba64031  gcc/testsuite/ada/acats-3/tests/c9/c96004a.ada
! 2f64957621aaee0d11d2f8171f4e6709  gcc/testsuite/ada/acats-3/tests/c9/c96005a.ada
! 7fad724f14640158cc9929364f0bb44f  gcc/testsuite/ada/acats-3/tests/c9/c96005b.tst
! 6e3aebd279f9456cefe6dc63b3b9331e  gcc/testsuite/ada/acats-3/tests/c9/c96005d.ada
! 48530b441ec07b282f87a1b285f46461  gcc/testsuite/ada/acats-3/tests/c9/c96005f.ada
! 4ea722032f17d484d0a99cb53bc930ac  gcc/testsuite/ada/acats-3/tests/c9/c96006a.ada
! 83d75c4aa3732428ebf8864a605ee0d4  gcc/testsuite/ada/acats-3/tests/c9/c96007a.ada
! 031bef964d04e0ec5db2ff1f13daa5c1  gcc/testsuite/ada/acats-3/tests/c9/c96008a.ada
! f1d6b97aec5c567380c522a41db1aba7  gcc/testsuite/ada/acats-3/tests/c9/c96008b.ada
! 9f6fd5618561fb30c4c3b3865512f084  gcc/testsuite/ada/acats-3/tests/c9/c97112a.ada
! 9a595e747efc52363c8c454c5697526c  gcc/testsuite/ada/acats-3/tests/c9/c97113a.ada
! 0a432c8f0bafafbfd3ca9e2c4c355355  gcc/testsuite/ada/acats-3/tests/c9/c97114a.ada
! f204e89327ed70fed4f01e37237ed370  gcc/testsuite/ada/acats-3/tests/c9/c97115a.ada
! ad10c842934da9fd10b075d2eda11b10  gcc/testsuite/ada/acats-3/tests/c9/c97116a.ada
! 4e1bee03164214d6b948f1c4d7727423  gcc/testsuite/ada/acats-3/tests/c9/c97117a.ada
! f316b207affd7df5674d718268b31bd7  gcc/testsuite/ada/acats-3/tests/c9/c97117b.ada
! c15c876df898d95befc462a0646f94e6  gcc/testsuite/ada/acats-3/tests/c9/c97117c.ada
! 06046e05a2477dc8986dff46f6adb19d  gcc/testsuite/ada/acats-3/tests/c9/c97118a.ada
! 713383a150292af0da0dc77e7a23ab4b  gcc/testsuite/ada/acats-3/tests/c9/c97120a.ada
! 1edcf8a00884d843f01295b66b3346ed  gcc/testsuite/ada/acats-3/tests/c9/c97120b.ada
! d6606fac2f86c01ef106a193d274ec96  gcc/testsuite/ada/acats-3/tests/c9/c97201a.ada
! 2be86a6c8f33794ef758dfb71bf75acd  gcc/testsuite/ada/acats-3/tests/c9/c97201b.ada
! 32743b2ed9403b69d98c56734934fa8f  gcc/testsuite/ada/acats-3/tests/c9/c97201c.ada
! 1feeeccbfc144d846a5fac5dc371b1ab  gcc/testsuite/ada/acats-3/tests/c9/c97201d.ada
! 4b003338cd3cfce9c7070dea4b8370a1  gcc/testsuite/ada/acats-3/tests/c9/c97201e.ada
! 383c30d1a9dc6fba56fb3b68b9d8417d  gcc/testsuite/ada/acats-3/tests/c9/c97201g.ada
! 2a874dccde240e48a4f9b0c6b5175219  gcc/testsuite/ada/acats-3/tests/c9/c97201h.ada
! a7aec17b036081fd245c141c14cea8c3  gcc/testsuite/ada/acats-3/tests/c9/c97201x.ada
! 8b04c9ca3ccf2bd719076369af023d12  gcc/testsuite/ada/acats-3/tests/c9/c97202a.ada
! 096a975a5320d43a7ba562f9f18d94e6  gcc/testsuite/ada/acats-3/tests/c9/c97203a.ada
! 4470e62031e7933d85cbc73da17fef70  gcc/testsuite/ada/acats-3/tests/c9/c97203b.ada
! 64b03c91289d25db071b852a88b5d9cb  gcc/testsuite/ada/acats-3/tests/c9/c97203c.ada
! ddc6cf33bc17eabf4869adcc1d29e3d0  gcc/testsuite/ada/acats-3/tests/c9/c97204a.ada
! d4911cea3ce93679f126d507a45d22fa  gcc/testsuite/ada/acats-3/tests/c9/c97204b.ada
! f112637a1de7d372487415fe7c563edd  gcc/testsuite/ada/acats-3/tests/c9/c97205a.ada
! 5532215767fea9cf0ff3d5a28af0ffbf  gcc/testsuite/ada/acats-3/tests/c9/c97205b.ada
! 01050a4da75368f4c45e1856db21fe08  gcc/testsuite/ada/acats-3/tests/c9/c97301a.ada
! 3bb292049b1010404ee847832e15f4fd  gcc/testsuite/ada/acats-3/tests/c9/c97301b.ada
! dc309970b8d1ee31a4ac51d708f59f23  gcc/testsuite/ada/acats-3/tests/c9/c97301c.ada
! 85087bd563a15cb83cb82906dd074b46  gcc/testsuite/ada/acats-3/tests/c9/c97301d.ada
! cf609a3a37b7091f993fde3ebec98b7b  gcc/testsuite/ada/acats-3/tests/c9/c97301e.ada
! fb0f6367a2cb242d11e68bb0833594c9  gcc/testsuite/ada/acats-3/tests/c9/c97302a.ada
! ee3941e300e101619899d4ce5e433914  gcc/testsuite/ada/acats-3/tests/c9/c97303a.ada
! 0c9b0b786acee85921087f08e05ee848  gcc/testsuite/ada/acats-3/tests/c9/c97303b.ada
! dca0cd362816588d4976d342beb2593d  gcc/testsuite/ada/acats-3/tests/c9/c97303c.ada
! cb2ab9f96734f02dcf13d24f2e73aec3  gcc/testsuite/ada/acats-3/tests/c9/c97304a.ada
! d754e67cb299985d2d7ab32f0d7831d4  gcc/testsuite/ada/acats-3/tests/c9/c97304b.ada
! 2f91d4b7e4df271c291c8528b0ac77c5  gcc/testsuite/ada/acats-3/tests/c9/c97305a.ada
! 99ee5abaa01d4f88e63554c6c77981a8  gcc/testsuite/ada/acats-3/tests/c9/c97305b.ada
! 5a1e95417e5dc56ea2eaa24f2cb98647  gcc/testsuite/ada/acats-3/tests/c9/c97305c.ada
! fa76b14386e1262d53b830ca97f97d45  gcc/testsuite/ada/acats-3/tests/c9/c97305d.ada
! e04c1ec69662c6ad7f314711e132d50b  gcc/testsuite/ada/acats-3/tests/c9/c97307a.ada
! 3159a203f1d3e85954c526f58a3919f1  gcc/testsuite/ada/acats-3/tests/c9/c974001.a
! 0314ba23ab70ea268178d5697c5a9034  gcc/testsuite/ada/acats-3/tests/c9/c974002.a
! f748892726b6f9f427e087ed38edff1e  gcc/testsuite/ada/acats-3/tests/c9/c974003.a
! 68b75700dc10aa1f753b947e8cfc83f7  gcc/testsuite/ada/acats-3/tests/c9/c974004.a
! c9f29dff7d0c7abcfdc4dd10f92cc818  gcc/testsuite/ada/acats-3/tests/c9/c974005.a
! 58bc14008a240c1458d789aea37231f5  gcc/testsuite/ada/acats-3/tests/c9/c974006.a
! 6386f90159d93f8e888fc5c7606c48ab  gcc/testsuite/ada/acats-3/tests/c9/c974007.a
! 091b77c15a7a69901928f3e08e5d560b  gcc/testsuite/ada/acats-3/tests/c9/c974008.a
! 4286211e8302b327c6fcddd998068801  gcc/testsuite/ada/acats-3/tests/c9/c974009.a
! 91418d184ffd74f3511f7c7fecf5ad4c  gcc/testsuite/ada/acats-3/tests/c9/c974010.a
! fb71769796ae10266d6396de27fcd9f3  gcc/testsuite/ada/acats-3/tests/c9/c974011.a
! 75ae944a2f56bfec34a43bcac81f0f6a  gcc/testsuite/ada/acats-3/tests/c9/c974012.a
! cf3493d33888a126779c4a1fd8c7e171  gcc/testsuite/ada/acats-3/tests/c9/c974013.a
! 0100f02b896d741021d8771778c05fe4  gcc/testsuite/ada/acats-3/tests/c9/c974014.a
! 120dd4802d990998dbefafba1d6bdf05  gcc/testsuite/ada/acats-3/tests/c9/c980001.a
! 98a89250f238d2d958192b464be9c644  gcc/testsuite/ada/acats-3/tests/c9/c980002.a
! 387e8d4bc42079cf88da235a35d5db46  gcc/testsuite/ada/acats-3/tests/c9/c980003.a
! 7ac21cbd7f3a077b85429173c95a43ee  gcc/testsuite/ada/acats-3/tests/c9/c990001.a
! 4a6308ea54645ac0a0ff6750ddff3bee  gcc/testsuite/ada/acats-3/tests/c9/c99005a.ada
! 0ade252d597ba9f5685bfdbc39ad5126  gcc/testsuite/ada/acats-3/tests/c9/c9a003a.ada
! f6efef2daeceae0601810ea34d294ebe  gcc/testsuite/ada/acats-3/tests/c9/c9a004a.ada
! dd8112b4d2ad70bb900170e976687d24  gcc/testsuite/ada/acats-3/tests/c9/c9a007a.ada
! d7d23b9be56f63a7a3eb64ae5740a50f  gcc/testsuite/ada/acats-3/tests/c9/c9a009a.ada
! 4a79ec0aad1fb7e6af0cb13c26c8a078  gcc/testsuite/ada/acats-3/tests/c9/c9a009c.ada
! a6fedb4d1bd7420511136db146b4479f  gcc/testsuite/ada/acats-3/tests/c9/c9a009f.ada
! 92177b39404bc5c23481f443eee705e0  gcc/testsuite/ada/acats-3/tests/c9/c9a009g.ada
! 56b8d40db1bb38ab15ba53a518a8e8e3  gcc/testsuite/ada/acats-3/tests/c9/c9a009h.ada
! 378ed54deee6ae14733d353d1d034e4e  gcc/testsuite/ada/acats-3/tests/c9/c9a010a.ada
! 7e86b851f4df1a5b809ec8656042b7f1  gcc/testsuite/ada/acats-3/tests/c9/c9a011a.ada
! 15b92866c3feb68befd87bd433944eee  gcc/testsuite/ada/acats-3/tests/c9/c9a011b.ada
! 204dadfff9a19c758cd37f55b4c4da7c  gcc/testsuite/ada/acats-3/tests/ca/ca1003a.ada
! 763e67e5131cf453849af1119c81ab73  gcc/testsuite/ada/acats-3/tests/ca/ca1004a.ada
! 4dd6d7580352576ccd7263ab195d5863  gcc/testsuite/ada/acats-3/tests/ca/ca1005a.ada
! 129a313a5c15d69fc95b27e10654ea3b  gcc/testsuite/ada/acats-3/tests/ca/ca1006a.ada
! 150e449e50b6c5dbc1ef87fb7cbf4fb9  gcc/testsuite/ada/acats-3/tests/ca/ca1011a0.ada
! 590b512fe8313d2c235285182f8eda0d  gcc/testsuite/ada/acats-3/tests/ca/ca1011a1.ada
! 75907d5f95c902eae76627ab16c741b7  gcc/testsuite/ada/acats-3/tests/ca/ca1011a2.ada
! 401ad7f509f398efd9094cfb553d02ca  gcc/testsuite/ada/acats-3/tests/ca/ca1011a3.ada
! d6d2e55e299aae0f7b20781714e0f6d9  gcc/testsuite/ada/acats-3/tests/ca/ca1011a4.ada
! e840ac05d90e7ef06dac4303f5747d0c  gcc/testsuite/ada/acats-3/tests/ca/ca1011a5.ada
! 696cc4292fd590eaf3673d74b1c0c4f9  gcc/testsuite/ada/acats-3/tests/ca/ca1011a6.ada
! 19ae39e48cdc2ea32ddbde00fdb0bf17  gcc/testsuite/ada/acats-3/tests/ca/ca1012a0.ada
! c3bd20289c2b3b2422a8e051dfc8b100  gcc/testsuite/ada/acats-3/tests/ca/ca1012a1.ada
! 010a8d3290ef3a0b00bcbe784544f65f  gcc/testsuite/ada/acats-3/tests/ca/ca1012a2.ada
! 49dff1e5fe3bc3d0814772fe822732a9  gcc/testsuite/ada/acats-3/tests/ca/ca1012a3.ada
! 3660d5d1740e1e424e76277266bd8268  gcc/testsuite/ada/acats-3/tests/ca/ca1012a4.ada
! 2a073bfb3680a6d94b420c58b535dda1  gcc/testsuite/ada/acats-3/tests/ca/ca1012b0.ada
! 1d0a019e12d9aec35762beffba68a14a  gcc/testsuite/ada/acats-3/tests/ca/ca1012b2.ada
! 8fe092748b9f031c395eb8aa90296599  gcc/testsuite/ada/acats-3/tests/ca/ca1012b4.ada
! 2ee859ea2c2cb8cd94e30b6c19c152f7  gcc/testsuite/ada/acats-3/tests/ca/ca1013a0.ada
! a15e85ff9101c6b7debdc0a508f121b6  gcc/testsuite/ada/acats-3/tests/ca/ca1013a1.ada
! 03baa6347b38eb86dabe6092928f99a3  gcc/testsuite/ada/acats-3/tests/ca/ca1013a2.ada
! a81d2aa44c2ded0527dbc731919e9089  gcc/testsuite/ada/acats-3/tests/ca/ca1013a3.ada
! baa2f985db9330503fee62fb421c3429  gcc/testsuite/ada/acats-3/tests/ca/ca1013a4.ada
! 9fc93552ea16f09c4c827809b41b3281  gcc/testsuite/ada/acats-3/tests/ca/ca1013a5.ada
! eb0f6d8e24d16363c032c027a7fb22d5  gcc/testsuite/ada/acats-3/tests/ca/ca1013a6.ada
! b35c89f01ddf1fa22d017dd159aac614  gcc/testsuite/ada/acats-3/tests/ca/ca1014a0.ada
! 5077be000dc1a7e1b7b61ca260535b47  gcc/testsuite/ada/acats-3/tests/ca/ca1014a1.ada
! 0d51872b8ac47d25b56ce86661e1c370  gcc/testsuite/ada/acats-3/tests/ca/ca1014a2.ada
! 29a9a130e24e0e0ced6be54af8af32af  gcc/testsuite/ada/acats-3/tests/ca/ca1014a3.ada
! bda7cf51d24fabf05ab2eb537ba61e3b  gcc/testsuite/ada/acats-3/tests/ca/ca1020e0.ada
! e875db44aa84c70db8ae5e21b37fd9f1  gcc/testsuite/ada/acats-3/tests/ca/ca1020e1.ada
! 3f26efdf7d61547aec29a83c55db9b2c  gcc/testsuite/ada/acats-3/tests/ca/ca1020e2.ada
! d41b12fbbd6a609065e3a66751a2bcfd  gcc/testsuite/ada/acats-3/tests/ca/ca1020e3.ada
! 94d90f2a39051c6c6e6f143035815676  gcc/testsuite/ada/acats-3/tests/ca/ca1022a0.ada
! 522a519bdf3184fbe9c278d90eaa0c51  gcc/testsuite/ada/acats-3/tests/ca/ca1022a1.ada
! 457d2a59db3a3a962c68d076c3588ba2  gcc/testsuite/ada/acats-3/tests/ca/ca1022a2.ada
! bead0060014fd3fff3245a6f20e1ce5d  gcc/testsuite/ada/acats-3/tests/ca/ca1022a3.ada
! 7043e3690e3b44d0a6dcf5a6e896118c  gcc/testsuite/ada/acats-3/tests/ca/ca1022a4.ada
! a84d185297f5e0df081a4d1c5691575a  gcc/testsuite/ada/acats-3/tests/ca/ca1022a5.ada
! 3170507b82e5b87d289d4cc70305ba1c  gcc/testsuite/ada/acats-3/tests/ca/ca1022a6.ada
! 43efb4507d79b8829492325770ec57e8  gcc/testsuite/ada/acats-3/tests/ca/ca11001.a
! ac29fbda8eadae439bcd450881bc7149  gcc/testsuite/ada/acats-3/tests/ca/ca11002.a
! b9954b4449d887004c58cdfadf86900e  gcc/testsuite/ada/acats-3/tests/ca/ca11003.a
! 5858be41247b333a8e43986902fba588  gcc/testsuite/ada/acats-3/tests/ca/ca110040.a
! a977e479cabfc8bfede672c52d423864  gcc/testsuite/ada/acats-3/tests/ca/ca110041.a
! a2118dee2a16348d232ec7617376dade  gcc/testsuite/ada/acats-3/tests/ca/ca110042.am
! 4a8c0c2b4dd227cfda4c20ad9ff07ace  gcc/testsuite/ada/acats-3/tests/ca/ca110050.a
! 0583459492312df56b1924ffe5b094bd  gcc/testsuite/ada/acats-3/tests/ca/ca110051.am
! bc46a97640375fa6c02bac82bd0ea9d4  gcc/testsuite/ada/acats-3/tests/ca/ca11006.a
! 7a57ba0892ae966f0111911781c328a7  gcc/testsuite/ada/acats-3/tests/ca/ca11007.a
! 72dc8d276317eabd399e4b72e562434b  gcc/testsuite/ada/acats-3/tests/ca/ca11008.a
! 33d1886825125a9ff16aafa1d4eeb8ce  gcc/testsuite/ada/acats-3/tests/ca/ca11009.a
! 6009d53581cd1fedaaa5f8df00bec83f  gcc/testsuite/ada/acats-3/tests/ca/ca11010.a
! 41dc04e344132ae2173153f802896e15  gcc/testsuite/ada/acats-3/tests/ca/ca11011.a
! d28dd7fd562acb52e90429450077885b  gcc/testsuite/ada/acats-3/tests/ca/ca11012.a
! 3b4e1d1303122a2165d7a89e5ca75ec0  gcc/testsuite/ada/acats-3/tests/ca/ca11013.a
! e80e120c9035b007bb06c2accccbc2b3  gcc/testsuite/ada/acats-3/tests/ca/ca11014.a
! 97408d6755af6eeab48fe47d27144c12  gcc/testsuite/ada/acats-3/tests/ca/ca11015.a
! 8b415d0e8ca6c7725a02853b184967b4  gcc/testsuite/ada/acats-3/tests/ca/ca11016.a
! 5b1b2a824041eeb6d0560a6e32d48287  gcc/testsuite/ada/acats-3/tests/ca/ca11017.a
! df67588f2af1ce9fe9abd12c930a475a  gcc/testsuite/ada/acats-3/tests/ca/ca11018.a
! d51c3aaeac91d325c8cea73a18210a18  gcc/testsuite/ada/acats-3/tests/ca/ca11019.a
! 1740b30abc976744100e38e3bcf58e99  gcc/testsuite/ada/acats-3/tests/ca/ca11020.a
! 3a6518f945e25a1aeb3ad194d1563dff  gcc/testsuite/ada/acats-3/tests/ca/ca11021.a
! 5af82e195906ba434bd96462dc39c4c1  gcc/testsuite/ada/acats-3/tests/ca/ca11022.a
! d31f6ffac288a57d18c545c73969474e  gcc/testsuite/ada/acats-3/tests/ca/ca110230.a
! 32e02fe39dfdad12f29d72279adcac6c  gcc/testsuite/ada/acats-3/tests/ca/ca110231.a
! 4dd492832f8d6bd8bd698f639fa6aca4  gcc/testsuite/ada/acats-3/tests/ca/ca110232.am
! dccf8acb158b9eac07884aeacd894def  gcc/testsuite/ada/acats-3/tests/ca/ca1102a0.ada
! 2ed4ef9cb779e0d0250f3094928e85b6  gcc/testsuite/ada/acats-3/tests/ca/ca1102a1.ada
! d658c78d3feceb2e1e932fd6a6b84b5b  gcc/testsuite/ada/acats-3/tests/ca/ca1102a2.ada
! 50c4e887be1e9c4b7922f1519eb6c980  gcc/testsuite/ada/acats-3/tests/ca/ca1106a.ada
! b777b7cb27b27b07d7781e4ffd98a4ac  gcc/testsuite/ada/acats-3/tests/ca/ca1108a.ada
! 2f0f9c93c1bcab591f855d52670c37f0  gcc/testsuite/ada/acats-3/tests/ca/ca1108b.ada
! d320add603a2cb7fa5b0b27eb3cf9f99  gcc/testsuite/ada/acats-3/tests/ca/ca11a01.a
! 564d10a7c04f96788c8960fbe51c939e  gcc/testsuite/ada/acats-3/tests/ca/ca11a02.a
! c5b8e3a142a8d1aaf458e85e143d2dff  gcc/testsuite/ada/acats-3/tests/ca/ca11b01.a
! 385324ae1a50700efcc3e91d33d38fa7  gcc/testsuite/ada/acats-3/tests/ca/ca11b02.a
! f3ab6e0bea1b83fcd4c3a152e700e0bc  gcc/testsuite/ada/acats-3/tests/ca/ca11c01.a
! 71af51028e9bdd5cbcd5d81ee9beb0b5  gcc/testsuite/ada/acats-3/tests/ca/ca11c02.a
! 623cecaae9f9690a91d838f3795828e4  gcc/testsuite/ada/acats-3/tests/ca/ca11c03.a
! d0d1001f9819954c3537dd82876810a2  gcc/testsuite/ada/acats-3/tests/ca/ca11d010.a
! 9f2dd49cf5ff9af1c2217e51b7065e52  gcc/testsuite/ada/acats-3/tests/ca/ca11d011.a
! df976f60528d7144894c0dec4d84bc15  gcc/testsuite/ada/acats-3/tests/ca/ca11d012.a
! 6caa9498e84d76bdc74f46ac12a1a5e2  gcc/testsuite/ada/acats-3/tests/ca/ca11d013.am
! 0e13dcf32c88dedfbae0b03875ea105d  gcc/testsuite/ada/acats-3/tests/ca/ca11d02.a
! 352a0f61cf20bb4dd3caf17335850840  gcc/testsuite/ada/acats-3/tests/ca/ca11d03.a
! 42dc8152c22ab5df110af0816fda6daa  gcc/testsuite/ada/acats-3/tests/ca/ca120010.a
! 4a591a63cf2ea54c815ce845a57db0b6  gcc/testsuite/ada/acats-3/tests/ca/ca120011.a
! 33dd67cd6352e749c80324a52bce1fca  gcc/testsuite/ada/acats-3/tests/ca/ca120012.am
! 85bba90c6d55a072af31e706a101806b  gcc/testsuite/ada/acats-3/tests/ca/ca12002.a
! 196ff89b7529ee2981f4ecc32c27a27f  gcc/testsuite/ada/acats-3/tests/ca/ca13001.a
! a30bb2c455fbe1c012213193058ea38a  gcc/testsuite/ada/acats-3/tests/ca/ca13002.a
! 259d9991bd14633e726a1465b3ce011f  gcc/testsuite/ada/acats-3/tests/ca/ca13003.a
! 4a04a3ea16a7b5f16f46083006b00231  gcc/testsuite/ada/acats-3/tests/ca/ca13a01.a
! ef93a0b4b9d9c30a5f19c2e9d20d6e84  gcc/testsuite/ada/acats-3/tests/ca/ca13a02.a
! 14642bbab92bb9a06637c81126196b6d  gcc/testsuite/ada/acats-3/tests/ca/ca140230.a
! db8f6b8a7c3fb7fc6f41665ca76898aa  gcc/testsuite/ada/acats-3/tests/ca/ca140231.a
! 2c51220694c3930837b65093969330e9  gcc/testsuite/ada/acats-3/tests/ca/ca140232.am
! 97cc025b6e8c23ed35706e0ff98d4305  gcc/testsuite/ada/acats-3/tests/ca/ca140233.a
! 6df92dded9f1b1b9927e74380e21b606  gcc/testsuite/ada/acats-3/tests/ca/ca140280.a
! 6d433407d31454677f59a9de849b9a8a  gcc/testsuite/ada/acats-3/tests/ca/ca140281.a
! c7d9485411a37bafb94c4d619229cf30  gcc/testsuite/ada/acats-3/tests/ca/ca140282.a
! 0382d20f38d7c210393543ff57720eee  gcc/testsuite/ada/acats-3/tests/ca/ca140283.am
! 3ddbeeafbf30ff3f598a354d6504380d  gcc/testsuite/ada/acats-3/tests/ca/ca15003.a
! 3a4f3b580416cb1f523e9f0ac2eae79d  gcc/testsuite/ada/acats-3/tests/ca/ca200020.a
! 0a900895683bd2063208a7e0ec0179eb  gcc/testsuite/ada/acats-3/tests/ca/ca200021.a
! 7ba1dcfca4bbc7dddaa33358007ad8be  gcc/testsuite/ada/acats-3/tests/ca/ca200022.am
! ef72fc262d0290715b645d5b851eb6c6  gcc/testsuite/ada/acats-3/tests/ca/ca200030.a
! 192d203df19b3fbd0783fa037fb0b579  gcc/testsuite/ada/acats-3/tests/ca/ca200031.am
! 89e55ace469231379417158d76cef966  gcc/testsuite/ada/acats-3/tests/ca/ca2001h0.ada
! 4fcb3c9a010c482fd799920396bdff35  gcc/testsuite/ada/acats-3/tests/ca/ca2001h1.ada
! 74283fc28ee649c49603986ce9271f9b  gcc/testsuite/ada/acats-3/tests/ca/ca2001h2.ada
! 38f9b878948bab9e22743f449944e3e9  gcc/testsuite/ada/acats-3/tests/ca/ca2001h3.ada
! 5b863537f3743728296719d32393b9c2  gcc/testsuite/ada/acats-3/tests/ca/ca2002a0.ada
! bfbaab505e4866cb5784b784957c9a28  gcc/testsuite/ada/acats-3/tests/ca/ca2002a1.ada
! 0915a28827cb6de231954ac4c117a867  gcc/testsuite/ada/acats-3/tests/ca/ca2002a2.ada
! be28bd99026e48f3d74a229aea62f3d3  gcc/testsuite/ada/acats-3/tests/ca/ca2003a0.ada
! bbd409da60934657820661962e6e865f  gcc/testsuite/ada/acats-3/tests/ca/ca2003a1.ada
! e9823de02e5e243ffbc96966ad66f571  gcc/testsuite/ada/acats-3/tests/ca/ca2004a0.ada
! 2a6a75cbeb635fa9b353f4456f15887a  gcc/testsuite/ada/acats-3/tests/ca/ca2004a1.ada
! 9e55a07446b2c4b6f10c94a096696c64  gcc/testsuite/ada/acats-3/tests/ca/ca2004a2.ada
! 95743db093f3de73eef851e06ace6ae5  gcc/testsuite/ada/acats-3/tests/ca/ca2004a3.ada
! 9825991acff14d1e11e40a3568bb2e77  gcc/testsuite/ada/acats-3/tests/ca/ca2004a4.ada
! 1ed6b70320b71de2337bd1e17625341d  gcc/testsuite/ada/acats-3/tests/ca/ca2007a0.ada
! 2d33ec3a837a5a5e131936b8db94f4eb  gcc/testsuite/ada/acats-3/tests/ca/ca2007a1.ada
! 40ec1534c1b7d0a29cd8b1199f0a5b64  gcc/testsuite/ada/acats-3/tests/ca/ca2007a2.ada
! 25e21e36ad48e61821b87c24ac11bca6  gcc/testsuite/ada/acats-3/tests/ca/ca2007a3.ada
! 084eafcf0c9bde63eb9b0c876f25f904  gcc/testsuite/ada/acats-3/tests/ca/ca2008a0.ada
! c367605d05bd5ae5bf81c583e66e2720  gcc/testsuite/ada/acats-3/tests/ca/ca2008a1.ada
! c06ae786d36e4922cea7b5ed9453c9f3  gcc/testsuite/ada/acats-3/tests/ca/ca2008a2.ada
! e6666b45adcad1b99635211e793ed244  gcc/testsuite/ada/acats-3/tests/ca/ca2009a.ada
! 091802695ed73e62107b4d4d28c4fa67  gcc/testsuite/ada/acats-3/tests/ca/ca2009c0.ada
! d4908bcb77941027c20a57e38b3354df  gcc/testsuite/ada/acats-3/tests/ca/ca2009c1.ada
! 8793e38b06624960b964675c87a7bb50  gcc/testsuite/ada/acats-3/tests/ca/ca2009d.ada
! ebd60829cd41edbd06d5d34b1c55ad14  gcc/testsuite/ada/acats-3/tests/ca/ca2009f0.ada
! 84847d496c3551158605ff4d635fd1d6  gcc/testsuite/ada/acats-3/tests/ca/ca2009f1.ada
! 1b68aafa35a5844624d091cb512b83a3  gcc/testsuite/ada/acats-3/tests/ca/ca2009f2.ada
! 82a3883dad29bf7e9b2b43d245e96819  gcc/testsuite/ada/acats-3/tests/ca/ca2011b.ada
! a2806b84bcf970945201d14057ba77fb  gcc/testsuite/ada/acats-3/tests/ca/ca21001.a
! 9b176edf2b085f407ab53c6e7efa0bf0  gcc/testsuite/ada/acats-3/tests/ca/ca3011a0.ada
! a4e05800840beaa80583438f2fe8754d  gcc/testsuite/ada/acats-3/tests/ca/ca3011a1.ada
! c86a5bb82c1bade39f6d9d230f8c9e8e  gcc/testsuite/ada/acats-3/tests/ca/ca3011a2.ada
! dc43067ded3ab1437027708d7812aadb  gcc/testsuite/ada/acats-3/tests/ca/ca3011a3.ada
! b4bbe2bad37830cb59bac3673786910c  gcc/testsuite/ada/acats-3/tests/ca/ca3011a4.ada
! c29e663763861d160ff3432b1e522015  gcc/testsuite/ada/acats-3/tests/ca/ca5003a0.ada
! e5dcfd787f24d6dfedf73b0e116e1352  gcc/testsuite/ada/acats-3/tests/ca/ca5003a1.ada
! 248734cc36c6828c5b5d0a7c1293df27  gcc/testsuite/ada/acats-3/tests/ca/ca5003a2.ada
! 5497b59108e98e726b8af5fae575c343  gcc/testsuite/ada/acats-3/tests/ca/ca5003a3.ada
! 3ca92f928c3fab5699f3ed1cbb10cca7  gcc/testsuite/ada/acats-3/tests/ca/ca5003a4.ada
! 15800c833dc097d881eb01771f2ddb56  gcc/testsuite/ada/acats-3/tests/ca/ca5003a5.ada
! 42a60fa8194ce3db5c65b6814ea59f15  gcc/testsuite/ada/acats-3/tests/ca/ca5003a6.ada
! 0402a0137d3537a7d4ae11fe9268e188  gcc/testsuite/ada/acats-3/tests/ca/ca5003b0.ada
! 56d17409bae5c4f8247c69372dada6a7  gcc/testsuite/ada/acats-3/tests/ca/ca5003b1.ada
! 2ef9cab842c822e5b35867c53e777c18  gcc/testsuite/ada/acats-3/tests/ca/ca5003b2.ada
! 82b234cda282c69bd1cd3343d6564886  gcc/testsuite/ada/acats-3/tests/ca/ca5003b3.ada
! 0e13bff44fe10fc5bb9178c91aa8f41b  gcc/testsuite/ada/acats-3/tests/ca/ca5003b4.ada
! 05dbe877925c828ecc6371bacbfdfa20  gcc/testsuite/ada/acats-3/tests/ca/ca5003b5.ada
! 86085a25df2bcf17731e5abce3a41858  gcc/testsuite/ada/acats-3/tests/ca/ca5004a.ada
! 4663b5feb03415ae2fecb74dc9a6d918  gcc/testsuite/ada/acats-3/tests/ca/ca5004b0.ada
! dac927119e0c75edf0e171d438d99a0b  gcc/testsuite/ada/acats-3/tests/ca/ca5004b1.ada
! fb2c0908bc96e07939ff5f370be3d576  gcc/testsuite/ada/acats-3/tests/ca/ca5004b2.ada
! de4ee9e1d0577cbafe35f74312690093  gcc/testsuite/ada/acats-3/tests/ca/ca5006a.ada
! 953459f6c3ce7331d1cf5e82d075046f  gcc/testsuite/ada/acats-3/tests/cb/cb10002.a
! a2d96f308f3e7c5c03f4f9d216128c1c  gcc/testsuite/ada/acats-3/tests/cb/cb1001a.ada
! c9d819541b343e576525a8dc64f50bcc  gcc/testsuite/ada/acats-3/tests/cb/cb1004a.ada
! cd057227d4389433804bcb77c3065624  gcc/testsuite/ada/acats-3/tests/cb/cb1005a.ada
! 5335053bd77df186552ab553aed53d59  gcc/testsuite/ada/acats-3/tests/cb/cb1010a.ada
! 6be3f5adbcfcbc452379f748a85caa57  gcc/testsuite/ada/acats-3/tests/cb/cb1010c.ada
! 0a7ba5489277a0fcbe1b644ea3d981a3  gcc/testsuite/ada/acats-3/tests/cb/cb1010d.ada
! 6cae622e32e9824d353863435f37029e  gcc/testsuite/ada/acats-3/tests/cb/cb20001.a
! f70c8a2a06450a84e9c16c2c896968c2  gcc/testsuite/ada/acats-3/tests/cb/cb20003.a
! fe4620ca44567358367bbd3cbf625a78  gcc/testsuite/ada/acats-3/tests/cb/cb20004.a
! 35b97a6a98aab2205d9fafa16376dd73  gcc/testsuite/ada/acats-3/tests/cb/cb20005.a
! 2eb8439ac2fe1164f75cef3955ed5f7e  gcc/testsuite/ada/acats-3/tests/cb/cb20006.a
! 14f424c9945ffa51a8ed9b5158035a61  gcc/testsuite/ada/acats-3/tests/cb/cb20007.a
! 81b37c096b48361109ecfd3c0a735d6f  gcc/testsuite/ada/acats-3/tests/cb/cb2004a.ada
! c9e534ca3b39a7e52f750d7ada5b1f05  gcc/testsuite/ada/acats-3/tests/cb/cb2005a.ada
! 5f629a419d744cf6cbdf01ae526e8dfe  gcc/testsuite/ada/acats-3/tests/cb/cb2006a.ada
! 0f62783e4e017c666e439d08382f4081  gcc/testsuite/ada/acats-3/tests/cb/cb2007a.ada
! 0af3543016fdd2ab314c8e3f6944bc98  gcc/testsuite/ada/acats-3/tests/cb/cb20a02.a
! 0f3ac1a00f45f79f0d263ea0c18026ea  gcc/testsuite/ada/acats-3/tests/cb/cb30001.a
! da80eb868ceb5337039000257fc5cf28  gcc/testsuite/ada/acats-3/tests/cb/cb3003a.ada
! 3dcceb335b81c6314b73ec2a12e496dd  gcc/testsuite/ada/acats-3/tests/cb/cb3003b.ada
! db5771a4c4d22f1ee3b2043ea42e688e  gcc/testsuite/ada/acats-3/tests/cb/cb3004a.ada
! e4ecbc4431ab3786f6a71727577cf5f2  gcc/testsuite/ada/acats-3/tests/cb/cb40005.a
! 15fd6a782afdd2e76a85a1ef09b95d91  gcc/testsuite/ada/acats-3/tests/cb/cb4001a.ada
! f00ebf73158afdcf6ccfa56162d1a7c7  gcc/testsuite/ada/acats-3/tests/cb/cb4002a.ada
! 9e17c1d3be3c2acc4c4a761cf058d3c6  gcc/testsuite/ada/acats-3/tests/cb/cb4003a.ada
! 3461f679629a4811d1fce600d7e8b57e  gcc/testsuite/ada/acats-3/tests/cb/cb4004a.ada
! f2db155f6c22f6b30ca696f825ef8aae  gcc/testsuite/ada/acats-3/tests/cb/cb4005a.ada
! b611f921d0e5b0b027e6f69faa9d24b4  gcc/testsuite/ada/acats-3/tests/cb/cb4006a.ada
! baded9fec75a97cb63419083a60cbf79  gcc/testsuite/ada/acats-3/tests/cb/cb4007a.ada
! a4194c712a3e86aa41f29aec96a8f7a7  gcc/testsuite/ada/acats-3/tests/cb/cb4008a.ada
! 930c41db090c6c2c54a36228405c48ac  gcc/testsuite/ada/acats-3/tests/cb/cb4009a.ada
! 72f5c28e26994805b38b887c725d411c  gcc/testsuite/ada/acats-3/tests/cb/cb4013a.ada
! 7cebdcd4f0159fb009f28f53b4f1d2aa  gcc/testsuite/ada/acats-3/tests/cb/cb40a01.a
! c5d94b1d4e0e31956d3f563cd7632df6  gcc/testsuite/ada/acats-3/tests/cb/cb40a020.a
! 1826a245b36f70926f1d010c4bb03b56  gcc/testsuite/ada/acats-3/tests/cb/cb40a021.am
! dd4b04d0ff15d88ce5e37562087104b8  gcc/testsuite/ada/acats-3/tests/cb/cb40a030.a
! ce7a78707740e7c8442c44280bd4b429  gcc/testsuite/ada/acats-3/tests/cb/cb40a031.am
! 27770d52ee37e90d5cd9748807eab53e  gcc/testsuite/ada/acats-3/tests/cb/cb40a04.a
! fee21ac92aa6b69bea4a12f412715df6  gcc/testsuite/ada/acats-3/tests/cb/cb41001.a
! 3bbe3f0aeccac5d0203ed045c2ccf49e  gcc/testsuite/ada/acats-3/tests/cb/cb41002.a
! d456462b7a7e6f3773b86bf24468d231  gcc/testsuite/ada/acats-3/tests/cb/cb41003.a
! 52c5e4b6a8d77b120f571623f547a197  gcc/testsuite/ada/acats-3/tests/cb/cb41004.a
! d0966c8e064d920ad9d15b0e1e8acd1b  gcc/testsuite/ada/acats-3/tests/cb/cb42001.a
! f44ad7e2a4e69bd7a329f8d93bb15c88  gcc/testsuite/ada/acats-3/tests/cb/cb42002.a
! e6c3ed65a752c9adb9850b8254371888  gcc/testsuite/ada/acats-3/tests/cb/cb42003.a
! 01e2daee09a3391b981c7a63ebe0ae28  gcc/testsuite/ada/acats-3/tests/cb/cb5001a.ada
! 5a22bfb3766d46433b2b7b2f046d0ea9  gcc/testsuite/ada/acats-3/tests/cb/cb5001b.ada
! 63153559a0add5135a21197c6c8c0a9f  gcc/testsuite/ada/acats-3/tests/cb/cb5002a.ada
! 52c10586939e5289ffc5276a6a4d9e3e  gcc/testsuite/ada/acats-3/tests/cc/cc1004a.ada
! abeb72a1acbce60114f56d558d1481a5  gcc/testsuite/ada/acats-3/tests/cc/cc1005b.ada
! e52fa7b734609c2fde5f5260ff000f57  gcc/testsuite/ada/acats-3/tests/cc/cc1010a.ada
! 4af2da441a155dbd4ee2be7e5afcdb99  gcc/testsuite/ada/acats-3/tests/cc/cc1010b.ada
! 3943b41b051f4e223a5fe3b067dd4750  gcc/testsuite/ada/acats-3/tests/cc/cc1018a.ada
! 8b9f3eb4b897035fcc0c08981fa94cd0  gcc/testsuite/ada/acats-3/tests/cc/cc1104c.ada
! 6dde1021fb59bfd89f7e89e10c4dc040  gcc/testsuite/ada/acats-3/tests/cc/cc1107b.ada
! fd9ff835b201890341a69a2bf568186d  gcc/testsuite/ada/acats-3/tests/cc/cc1111a.ada
! 3a2e06563ce5c65cb9f2734c9b5901b2  gcc/testsuite/ada/acats-3/tests/cc/cc1204a.ada
! ec00ecaace8abe97b14deef79a927278  gcc/testsuite/ada/acats-3/tests/cc/cc1207b.ada
! d5b96d46768e2afc1db48bccdd883c3d  gcc/testsuite/ada/acats-3/tests/cc/cc1220a.ada
! fe4da7912a4f8ebd90feecf1233d1cdd  gcc/testsuite/ada/acats-3/tests/cc/cc1221a.ada
! 25b2b3dc12b77cbf205ab8f38dcfb77d  gcc/testsuite/ada/acats-3/tests/cc/cc1221b.ada
! 9145c4850d40180754446ef574cb5fc0  gcc/testsuite/ada/acats-3/tests/cc/cc1221c.ada
! c4c966046fba1bd9875ab2ac270f27d0  gcc/testsuite/ada/acats-3/tests/cc/cc1221d.ada
! ec00a589846feb2b9117000ba453bb4d  gcc/testsuite/ada/acats-3/tests/cc/cc1222a.ada
! 9098cb80c67049808425c47b419fac81  gcc/testsuite/ada/acats-3/tests/cc/cc1223a.ada
! ebb1accb64bb0bc75b36cc4d7667f11e  gcc/testsuite/ada/acats-3/tests/cc/cc1224a.ada
! 252dcf9d499b779ceb6ff22b740614f3  gcc/testsuite/ada/acats-3/tests/cc/cc1225a.tst
! bd7909fda37c73e6a7b55033af7a7073  gcc/testsuite/ada/acats-3/tests/cc/cc1226b.ada
! 6c7f653283771ea8e72f38f30cca417e  gcc/testsuite/ada/acats-3/tests/cc/cc1227a.ada
! a59ea76111c1c30abdfc81e140c2ad1e  gcc/testsuite/ada/acats-3/tests/cc/cc1301a.ada
! 54718ced426c8406bfe76f085e364b70  gcc/testsuite/ada/acats-3/tests/cc/cc1302a.ada
! 0e4bf36981636de5140e59f431e9a750  gcc/testsuite/ada/acats-3/tests/cc/cc1304a.ada
! 8b8017d0f141d2d1f196915bb0d9086f  gcc/testsuite/ada/acats-3/tests/cc/cc1304b.ada
! 5c30254607e6be149633cccc49ed0eed  gcc/testsuite/ada/acats-3/tests/cc/cc1307a.ada
! 074dfbafa7a711ae864c0c7a3551c2c1  gcc/testsuite/ada/acats-3/tests/cc/cc1307b.ada
! 99a71a5de9c88311f519834c73dd819d  gcc/testsuite/ada/acats-3/tests/cc/cc1308a.ada
! f7d1a2abebaff0b7213722ac29bc699a  gcc/testsuite/ada/acats-3/tests/cc/cc1310a.ada
! 02f17d4f3889eba61e039a52d84ad466  gcc/testsuite/ada/acats-3/tests/cc/cc1311a.ada
! ab2512302d5429785277d9bb46d6c87b  gcc/testsuite/ada/acats-3/tests/cc/cc1311b.ada
! 1653180dc4be9e4015e8cad4546ded2c  gcc/testsuite/ada/acats-3/tests/cc/cc2002a.ada
! 5368d883d7adafccb7c415ab1a83c7f2  gcc/testsuite/ada/acats-3/tests/cc/cc30001.a
! 9240ec87a1cc555c3c6e829f22480b0f  gcc/testsuite/ada/acats-3/tests/cc/cc30002.a
! 9b67ed4b6d94e785f623555841e44c4c  gcc/testsuite/ada/acats-3/tests/cc/cc30003.a
! 7b9e43d5af304e75a87ba957fae6500b  gcc/testsuite/ada/acats-3/tests/cc/cc30004.a
! 258d4b8f83d4c17eda45265db8a66c46  gcc/testsuite/ada/acats-3/tests/cc/cc3004a.ada
! 1422918611096dedc710ededab9fc1d3  gcc/testsuite/ada/acats-3/tests/cc/cc3007a.ada
! faee4cb0106ee6d683bf7e7a208050dc  gcc/testsuite/ada/acats-3/tests/cc/cc3007b.ada
! 43f939c986863c3151fb21fae7ad81a8  gcc/testsuite/ada/acats-3/tests/cc/cc3011a.ada
! e21f329f8aeeeaaf980ab3ae301de7cb  gcc/testsuite/ada/acats-3/tests/cc/cc3011d.ada
! 021bd9a65cf3be3535547519f5ceb651  gcc/testsuite/ada/acats-3/tests/cc/cc3012a.ada
! eb08409ceff83c49baa04e734c258681  gcc/testsuite/ada/acats-3/tests/cc/cc3015a.ada
! 37ffe8fd743867700b2e0249fd73f16b  gcc/testsuite/ada/acats-3/tests/cc/cc3016b.ada
! 92e8dfd4f50c7e3595bbd6ef5ebb4302  gcc/testsuite/ada/acats-3/tests/cc/cc3016c.ada
! 3bb5847d2c36a04a53a9dc138c40e34a  gcc/testsuite/ada/acats-3/tests/cc/cc3016f.ada
! 195ab10c1ca9bbfd5b16ade12e3259e2  gcc/testsuite/ada/acats-3/tests/cc/cc3016i.ada
! a5976b043f8ea78109e2936d58a009a8  gcc/testsuite/ada/acats-3/tests/cc/cc3017b.ada
! 21e94c5f1086f6624d5237d010ecc0f2  gcc/testsuite/ada/acats-3/tests/cc/cc3017c.ada
! 2fb78d8d58d12070086164535de0efda  gcc/testsuite/ada/acats-3/tests/cc/cc3019a.ada
! a0315fd5149893475278feb9b8d7013b  gcc/testsuite/ada/acats-3/tests/cc/cc3019b0.ada
! 207f4488242efc2b7a5c80c0cd47410b  gcc/testsuite/ada/acats-3/tests/cc/cc3019b1.ada
! 5688bc525157eef2f521d23f1a720672  gcc/testsuite/ada/acats-3/tests/cc/cc3019b2.ada
! e5522bd1515d2f7df4fdd2bafaf481fb  gcc/testsuite/ada/acats-3/tests/cc/cc3019c0.ada
! c326bc3fa236d9094e60f3ecabd7d0de  gcc/testsuite/ada/acats-3/tests/cc/cc3019c1.ada
! 4e308a4f2724a46a2eb3a8426f98265f  gcc/testsuite/ada/acats-3/tests/cc/cc3019c2.ada
! cd9a188b6b1ecf3863d42065ce445792  gcc/testsuite/ada/acats-3/tests/cc/cc3106b.ada
! b1b639f80dbd48bf241b7d05c36362e6  gcc/testsuite/ada/acats-3/tests/cc/cc3120a.ada
! f06e709416c9d57a31113226d02abf07  gcc/testsuite/ada/acats-3/tests/cc/cc3120b.ada
! e09fb340ff80c10cbecd4b83e746eef2  gcc/testsuite/ada/acats-3/tests/cc/cc3121a.ada
! 302527c5f7e5e7497411775d418850b0  gcc/testsuite/ada/acats-3/tests/cc/cc3123a.ada
! 2575fc22f53f2a5308182459add72a14  gcc/testsuite/ada/acats-3/tests/cc/cc3125a.ada
! 4f59d6fe9227d671293a8fecd22f9101  gcc/testsuite/ada/acats-3/tests/cc/cc3125b.ada
! a1164d012410441b7190f2e96d6ce7c6  gcc/testsuite/ada/acats-3/tests/cc/cc3125c.ada
! 8a71d919069253ce368ef3103ee770c8  gcc/testsuite/ada/acats-3/tests/cc/cc3125d.ada
! ae116bcf41f79383e2dba5094b290b3f  gcc/testsuite/ada/acats-3/tests/cc/cc3126a.ada
! de2792bcfe94fa04d80a2c8ecf74db33  gcc/testsuite/ada/acats-3/tests/cc/cc3127a.ada
! a9709bfb589a677927644fb64dffa39c  gcc/testsuite/ada/acats-3/tests/cc/cc3128a.ada
! eeae81e69cab3987783ac508ffbebc5c  gcc/testsuite/ada/acats-3/tests/cc/cc3203a.ada
! a4d077af707d747e7c7f4f145a33e013  gcc/testsuite/ada/acats-3/tests/cc/cc3207b.ada
! 4525f7929e8bbeab0d61377f11afa3b8  gcc/testsuite/ada/acats-3/tests/cc/cc3220a.ada
! e8cc62fb0584ebfbe49d22d70abf54f4  gcc/testsuite/ada/acats-3/tests/cc/cc3221a.ada
! fbf1f50c254b6c5361e7d43b8efa783c  gcc/testsuite/ada/acats-3/tests/cc/cc3222a.ada
! 06202a4a37521548f15b8f63b30331cf  gcc/testsuite/ada/acats-3/tests/cc/cc3223a.ada
! d6d9973ddd1a38d34208ece4853e3e54  gcc/testsuite/ada/acats-3/tests/cc/cc3224a.ada
! 9d8a01fd3692524cef3f688f08e8820e  gcc/testsuite/ada/acats-3/tests/cc/cc3225a.ada
! 0b4db0bdcd8b5f809a2a0976c2fd65a2  gcc/testsuite/ada/acats-3/tests/cc/cc3230a.ada
! ecf0a337f74761749dd005a8b934ae2d  gcc/testsuite/ada/acats-3/tests/cc/cc3231a.ada
! 536583cad34553553ba201c11a12e136  gcc/testsuite/ada/acats-3/tests/cc/cc3232a.ada
! 29722620be1cef89562f63d778feb319  gcc/testsuite/ada/acats-3/tests/cc/cc3233a.ada
! 55b7f83f0d13dd0bbbc615bec20f7f58  gcc/testsuite/ada/acats-3/tests/cc/cc3234a.ada
! 174e858e451ed1d671a07a674320a404  gcc/testsuite/ada/acats-3/tests/cc/cc3235a.ada
! 1966408531cce82c0dee0cdb997e2d83  gcc/testsuite/ada/acats-3/tests/cc/cc3236a.ada
! 69f2b9819e916eb5bef41d74a6bf059e  gcc/testsuite/ada/acats-3/tests/cc/cc3240a.ada
! 134c20d477e6856df2b370dc7cfda1a4  gcc/testsuite/ada/acats-3/tests/cc/cc3305a.ada
! 6ff147856008d1bc23082c84a6dce358  gcc/testsuite/ada/acats-3/tests/cc/cc3305b.ada
! 75b310968a34fc081580d58bd1747ea3  gcc/testsuite/ada/acats-3/tests/cc/cc3305c.ada
! e41c2fcae5aa76bb6cd566a6a34b9e73  gcc/testsuite/ada/acats-3/tests/cc/cc3305d.ada
! 54ae1b7ff14c3a948a87f71ab9b7ae53  gcc/testsuite/ada/acats-3/tests/cc/cc3601a.ada
! 1d5d61ff6eda390e054673a067185feb  gcc/testsuite/ada/acats-3/tests/cc/cc3601c.ada
! 14a6f6048e3bda5108a0dac8dc736e44  gcc/testsuite/ada/acats-3/tests/cc/cc3602a.ada
! 73b205844c7501b9750b69b66d91e84c  gcc/testsuite/ada/acats-3/tests/cc/cc3603a.ada
! 509cb0b6a7b3daf93118e0e4310a8889  gcc/testsuite/ada/acats-3/tests/cc/cc3605a.ada
! b81c8580788eaf032722950c55524548  gcc/testsuite/ada/acats-3/tests/cc/cc3606a.ada
! 5232a6ea1beea12bb0c271a9c0728bcc  gcc/testsuite/ada/acats-3/tests/cc/cc3606b.ada
! 2f46f9edadb7856b60273822fbd7c6dc  gcc/testsuite/ada/acats-3/tests/cc/cc3607b.ada
! 59c4b0341104cc61677baaee002ac38c  gcc/testsuite/ada/acats-3/tests/cc/cc40001.a
! 6d5d6f00038ccaafe12d5f471a488085  gcc/testsuite/ada/acats-3/tests/cc/cc50001.a
! 8cb4adfbf6723ce3680f41b59f744fe9  gcc/testsuite/ada/acats-3/tests/cc/cc50a01.a
! 508d46d79897dc7252508cdafdbbfaa1  gcc/testsuite/ada/acats-3/tests/cc/cc50a02.a
! 146e71ceb1d037e4099e8ecb6e127614  gcc/testsuite/ada/acats-3/tests/cc/cc51001.a
! 58d73c0c5456a6a21ebbaef95df38606  gcc/testsuite/ada/acats-3/tests/cc/cc51002.a
! e096e928fb49f1e659293619c383c7f1  gcc/testsuite/ada/acats-3/tests/cc/cc51003.a
! a373845361c49771cf3d23fbbfc043de  gcc/testsuite/ada/acats-3/tests/cc/cc51004.a
! f57dbf49aca26d9bd043ebddae124c8e  gcc/testsuite/ada/acats-3/tests/cc/cc51006.a
! ed5459250c5b2a65cf4b7a7c678c41b5  gcc/testsuite/ada/acats-3/tests/cc/cc51007.a
! edb35d02b7ba72e7720c2eaf7fefe5bf  gcc/testsuite/ada/acats-3/tests/cc/cc51008.a
! 91f9a7214da9eed7db005bf7e3119ddc  gcc/testsuite/ada/acats-3/tests/cc/cc51a01.a
! 123f5aa956187735f0e077abedfd8f93  gcc/testsuite/ada/acats-3/tests/cc/cc51b03.a
! 557497dc9fd80ad665e468b409621ee1  gcc/testsuite/ada/acats-3/tests/cc/cc51d01.a
! 31462b6f268d175f3a915242afd8ea4d  gcc/testsuite/ada/acats-3/tests/cc/cc51d02.a
! 8b56f900a407dc994866f74c2c67f98e  gcc/testsuite/ada/acats-3/tests/cc/cc54001.a
! 65d5b89a1c15ad3234bf150dbe3c9235  gcc/testsuite/ada/acats-3/tests/cc/cc54002.a
! 04d1ce4f2960ed9b647a0bc397f920c2  gcc/testsuite/ada/acats-3/tests/cc/cc54003.a
! 0e1a91d2dfd0e6b36d65c5cfb02883dc  gcc/testsuite/ada/acats-3/tests/cc/cc54004.a
! 78a31a5dec6479884c93ea3280e5c8d6  gcc/testsuite/ada/acats-3/tests/cc/cc60001.a
! c29ebf7d9a6ed65bca0e83b18c63bbcc  gcc/testsuite/ada/acats-3/tests/cc/cc70001.a
! eb1b9be669a38ce3989d9340fb2dc933  gcc/testsuite/ada/acats-3/tests/cc/cc70002.a
! b1df852c3d5deec3247a4e17e9fb4dc6  gcc/testsuite/ada/acats-3/tests/cc/cc70003.a
! 9f1565b83bb2fa8ee588283eaa27cf37  gcc/testsuite/ada/acats-3/tests/cc/cc70a01.a
! 0bb1d67b6fb03b14e1b2f2062d01417d  gcc/testsuite/ada/acats-3/tests/cc/cc70a02.a
! ee68b4ea46957b2abff5e05bc98eeb76  gcc/testsuite/ada/acats-3/tests/cc/cc70b01.a
! 8c472987131321e68210b34029de25a7  gcc/testsuite/ada/acats-3/tests/cc/cc70b02.a
! 1a10fab698e0e1c3d985d63a8fd02646  gcc/testsuite/ada/acats-3/tests/cc/cc70c01.a
! 630e79ef7ad77506e6bc0443bc253106  gcc/testsuite/ada/acats-3/tests/cc/cc70c02.a
! 8cc4511c2ef1cbd2694c11e81a40fba3  gcc/testsuite/ada/acats-3/tests/cd/cd10001.a
! 17bd7ceca16a2b5b05c09e2bf540cb49  gcc/testsuite/ada/acats-3/tests/cd/cd10002.a
! 4e3da95c629f1132a7605c755936df22  gcc/testsuite/ada/acats-3/tests/cd/cd1009a.ada
! 75d6166e3a9b874d8b18037b2bbd7774  gcc/testsuite/ada/acats-3/tests/cd/cd1009b.ada
! fb2d00d22c6dc289be9e7485d1057b88  gcc/testsuite/ada/acats-3/tests/cd/cd1009d.ada
! 0f7c8765f0bcfd92843011f7699a3515  gcc/testsuite/ada/acats-3/tests/cd/cd1009e.ada
! 278b82d91f416169138eaedebaee0e88  gcc/testsuite/ada/acats-3/tests/cd/cd1009f.ada
! c5d7abbf75d5228f8ee64b921461c34d  gcc/testsuite/ada/acats-3/tests/cd/cd1009g.ada
! 05621471548ccc18ff9a5e104f81afde  gcc/testsuite/ada/acats-3/tests/cd/cd1009h.ada
! 529178df08dc16ac0af024a1fd6bfb53  gcc/testsuite/ada/acats-3/tests/cd/cd1009i.ada
! 365257c1306da6752feb59e62ac38bdf  gcc/testsuite/ada/acats-3/tests/cd/cd1009j.ada
! 03b1bb47c24a014bd2530417d1adf9b2  gcc/testsuite/ada/acats-3/tests/cd/cd1009k.tst
! 06bdced5a41c98c87e673e382a9688bb  gcc/testsuite/ada/acats-3/tests/cd/cd1009l.ada
! f8f71aa9e49974d6cf320e70c4b0ecbf  gcc/testsuite/ada/acats-3/tests/cd/cd1009m.ada
! f29ec324e7b0ec1f2f6dd2240fc728d8  gcc/testsuite/ada/acats-3/tests/cd/cd1009n.ada
! cae30866eb5c8c2cfb27698eb8ddbde0  gcc/testsuite/ada/acats-3/tests/cd/cd1009o.ada
! d3eb7538a98ec14ae8d521733ba57af7  gcc/testsuite/ada/acats-3/tests/cd/cd1009p.ada
! b8730acac7650dbd31ddd035bc69f509  gcc/testsuite/ada/acats-3/tests/cd/cd1009q.ada
! c358e33b93c2826e889494a0f5ed0843  gcc/testsuite/ada/acats-3/tests/cd/cd1009r.ada
! bc1961d8c175f48f60b3e9f057a9c72a  gcc/testsuite/ada/acats-3/tests/cd/cd1009s.ada
! 97707e58ce3c7a72dc76f39b8a718701  gcc/testsuite/ada/acats-3/tests/cd/cd1009t.tst
! 692d5e6fe6286682bb5eaaa37bbb3deb  gcc/testsuite/ada/acats-3/tests/cd/cd1009u.tst
! 907fdf446e490f986c267dd4b8d31baf  gcc/testsuite/ada/acats-3/tests/cd/cd1009v.ada
! 53fd05330599e7a416f8be2f4b93f8db  gcc/testsuite/ada/acats-3/tests/cd/cd1009w.ada
! 6e1baf3329c3ff434b0b23406203b126  gcc/testsuite/ada/acats-3/tests/cd/cd1009x.ada
! 992350215516da7fa9fc873f9d5f405e  gcc/testsuite/ada/acats-3/tests/cd/cd1009y.ada
! fb78c3da6117cb6f992401e7c6afde33  gcc/testsuite/ada/acats-3/tests/cd/cd1009z.ada
! 5b32d31e23b1f46b777ddb79782d91bc  gcc/testsuite/ada/acats-3/tests/cd/cd1c03a.ada
! 33753d6d5cc05f96879e603e7e4239ed  gcc/testsuite/ada/acats-3/tests/cd/cd1c03b.ada
! bb197eb3c945f5f3165b484b8d052169  gcc/testsuite/ada/acats-3/tests/cd/cd1c03c.ada
! d532f2cddb2a1d42073af8bead380310  gcc/testsuite/ada/acats-3/tests/cd/cd1c03e.tst
! 31687b0c41570bd2e2caf21db4be46d3  gcc/testsuite/ada/acats-3/tests/cd/cd1c03f.ada
! e0216b320efd829ccdc65f5d5771bcbb  gcc/testsuite/ada/acats-3/tests/cd/cd1c03g.ada
! c46fc765c5f46303364ae7f735fd4155  gcc/testsuite/ada/acats-3/tests/cd/cd1c03h.ada
! e99adb592df5a1337ea0d1ba20e1ea56  gcc/testsuite/ada/acats-3/tests/cd/cd1c03i.ada
! 356e60fd22404e9284ce91535fb26d24  gcc/testsuite/ada/acats-3/tests/cd/cd1c04a.ada
! e23985efbd7775125639e267122b2530  gcc/testsuite/ada/acats-3/tests/cd/cd1c04d.ada
! 960f74b381e41f1c5aca4cb19a43ba24  gcc/testsuite/ada/acats-3/tests/cd/cd1c04e.ada
! f4445570707e4cfc05845c2942f2a691  gcc/testsuite/ada/acats-3/tests/cd/cd1c06a.tst
! 38c0ca7c9c40e40a65ebac293401406d  gcc/testsuite/ada/acats-3/tests/cd/cd20001.a
! 6840d06bfa723e58150ad53215d31eaf  gcc/testsuite/ada/acats-3/tests/cd/cd2a21a.ada
! 16f1f72fade5db004d66971714b76535  gcc/testsuite/ada/acats-3/tests/cd/cd2a21c.ada
! 9955b221c78032f3aa68113cb414afea  gcc/testsuite/ada/acats-3/tests/cd/cd2a21e.ada
! 138413c4349c431ae13135443971a255  gcc/testsuite/ada/acats-3/tests/cd/cd2a22a.ada
! 2ecbd329e980e8d80615287a05917c3c  gcc/testsuite/ada/acats-3/tests/cd/cd2a22e.ada
! fa618469f3bfe667b6991f706078ceee  gcc/testsuite/ada/acats-3/tests/cd/cd2a22i.ada
! 17cd76bca6e556da829dc167dd37416d  gcc/testsuite/ada/acats-3/tests/cd/cd2a22j.ada
! 165d140694576ed2e1610ce9cf23d710  gcc/testsuite/ada/acats-3/tests/cd/cd2a23a.ada
! ee7517fa66b44ea029fa5afd44d3dfda  gcc/testsuite/ada/acats-3/tests/cd/cd2a23e.ada
! 7406649d9c3a6c13d39de22cbbbed6c0  gcc/testsuite/ada/acats-3/tests/cd/cd2a24a.ada
! 42e0bfe93795136ebcd4a60e074e3d13  gcc/testsuite/ada/acats-3/tests/cd/cd2a24e.ada
! 3812be2a4f7026b0ea147488e4e11b79  gcc/testsuite/ada/acats-3/tests/cd/cd2a24i.ada
! b5db777461ec4b929a5d956caae5ab6c  gcc/testsuite/ada/acats-3/tests/cd/cd2a24j.ada
! 01ec2329faee0b5aa7957719bee0a023  gcc/testsuite/ada/acats-3/tests/cd/cd2a31a.ada
! 5cfa1167dd7ab84a3f1390d1ef40e5a8  gcc/testsuite/ada/acats-3/tests/cd/cd2a31c.ada
! 25cf5e2245fd319818051c6d58e33e34  gcc/testsuite/ada/acats-3/tests/cd/cd2a31e.ada
! fe2d9184c16158b464a66d55f5f012e0  gcc/testsuite/ada/acats-3/tests/cd/cd2a32a.ada
! c89035c306f20662287a41260e41c440  gcc/testsuite/ada/acats-3/tests/cd/cd2a32c.ada
! 5a16f63c007776f1d0e621124c28ba40  gcc/testsuite/ada/acats-3/tests/cd/cd2a32e.ada
! 509f33673d8a806e1fc5c994ecd367a7  gcc/testsuite/ada/acats-3/tests/cd/cd2a32g.ada
! 9f1153cc00985eff630f5a7529e785a6  gcc/testsuite/ada/acats-3/tests/cd/cd2a32i.ada
! 3b52721a12cbabf7af952961ab000124  gcc/testsuite/ada/acats-3/tests/cd/cd2a32j.ada
! b0ce5f538de9c46a7f93bb98b76a16c2  gcc/testsuite/ada/acats-3/tests/cd/cd2a51a.ada
! fc6c3486ba94594cbb01735d7665ee4c  gcc/testsuite/ada/acats-3/tests/cd/cd2a53a.ada
! e22ea0a1bf1e45a9cc8941659d5de2bc  gcc/testsuite/ada/acats-3/tests/cd/cd2a53e.ada
! 800cb5fbfa61381b047623e515b331e9  gcc/testsuite/ada/acats-3/tests/cd/cd2a83c.tst
! 890942afd45f173d9c7a48fcd9b93b9e  gcc/testsuite/ada/acats-3/tests/cd/cd2a91c.tst
! 8bf8bb847340d421752506f84e4d2970  gcc/testsuite/ada/acats-3/tests/cd/cd2b11b.ada
! c32d32bcd93ad954d2d4fd55f825977f  gcc/testsuite/ada/acats-3/tests/cd/cd2b11d.ada
! 1a738e39f3f9e6241c1210e391c74d04  gcc/testsuite/ada/acats-3/tests/cd/cd2b11e.ada
! 4c72be933f221db34e2a0e081b1987cb  gcc/testsuite/ada/acats-3/tests/cd/cd2b11f.ada
! 29657353f6d86b0ea8f7696b58cc2fe9  gcc/testsuite/ada/acats-3/tests/cd/cd2b16a.ada
! d5241430c4b7db939bd5e77692bf37b4  gcc/testsuite/ada/acats-3/tests/cd/cd2c11a.tst
! 90bc2d2d244c54d7f4a3cd052f4ec35f  gcc/testsuite/ada/acats-3/tests/cd/cd2c11d.tst
! c6ae74fd392f1fb6040ba95b1d1ae6f0  gcc/testsuite/ada/acats-3/tests/cd/cd2d11a.ada
! cdcdd3477a39a731b6a087ee53c8d310  gcc/testsuite/ada/acats-3/tests/cd/cd2d13a.ada
! 76610aaf77050e2ff007a677818d736b  gcc/testsuite/ada/acats-3/tests/cd/cd30001.a
! 074a289ffe88ab1f82a7410cb923d4e9  gcc/testsuite/ada/acats-3/tests/cd/cd30002.a
! 3c6e9682493e7e0159a203d7641e1a2e  gcc/testsuite/ada/acats-3/tests/cd/cd30003.a
! 58da39f40326823d0b3dcca45acdc03a  gcc/testsuite/ada/acats-3/tests/cd/cd30004.a
! 1c50e51c3b821e3d109ed5a501745811  gcc/testsuite/ada/acats-3/tests/cd/cd300050.am
! 56a32782666a26425c694389d3141e71  gcc/testsuite/ada/acats-3/tests/cd/cd300051.c
! 6975fda95f2626a0f390cafdd2c40ca5  gcc/testsuite/ada/acats-3/tests/cd/cd30008.a
! 6c5358b148b289c9414824f3eca6c829  gcc/testsuite/ada/acats-3/tests/cd/cd30009.a
! 53302b5bf903a58fb95e205690813d78  gcc/testsuite/ada/acats-3/tests/cd/cd30011.a
! 03b96d80ed2b752193a510629a87cc3c  gcc/testsuite/ada/acats-3/tests/cd/cd30012.a
! a8163e0d624406b874260e4169d9e49c  gcc/testsuite/ada/acats-3/tests/cd/cd3014a.ada
! b3c46e3333ad22ce02ee156f3f0bccff  gcc/testsuite/ada/acats-3/tests/cd/cd3014c.ada
! a341da17e2d571e891434aa086ae7d3e  gcc/testsuite/ada/acats-3/tests/cd/cd3014d.ada
! 204d7f2709b5ba9cddcb718fc3d8ec18  gcc/testsuite/ada/acats-3/tests/cd/cd3014f.ada
! a86fa642d37091be0c5e5119e8c46645  gcc/testsuite/ada/acats-3/tests/cd/cd3015a.ada
! 38a79cfd7d26ff49fc8ee336963b178f  gcc/testsuite/ada/acats-3/tests/cd/cd3015c.ada
! 516902a49ddef41f79ee415e4edbb912  gcc/testsuite/ada/acats-3/tests/cd/cd3015e.ada
! 21588812fb8df6d087570f29c23c5d39  gcc/testsuite/ada/acats-3/tests/cd/cd3015f.ada
! c8a6fa2243d818236602663b274b5ba9  gcc/testsuite/ada/acats-3/tests/cd/cd3015g.ada
! c31ca49858b05c8ca516526b0e15945f  gcc/testsuite/ada/acats-3/tests/cd/cd3015h.ada
! c130ab902d51f975c0efadc0d44c9361  gcc/testsuite/ada/acats-3/tests/cd/cd3015i.ada
! 2fa00ee1e19df0bb0e4dc668c1d238fd  gcc/testsuite/ada/acats-3/tests/cd/cd3015k.ada
! 0c71d1dfc5a7d7c4d232217c2ef3e00f  gcc/testsuite/ada/acats-3/tests/cd/cd3021a.ada
! 02bab37ae5532979da2b39be8f1f447f  gcc/testsuite/ada/acats-3/tests/cd/cd33001.a
! 164945bdb98657e50508d0be9d5e1711  gcc/testsuite/ada/acats-3/tests/cd/cd33002.a
! fd95d787e27f8f80c3bccc691bf0417d  gcc/testsuite/ada/acats-3/tests/cd/cd40001.a
! a3f551b50734da9e1de425c6988b1f43  gcc/testsuite/ada/acats-3/tests/cd/cd4031a.ada
! 1363b8d9d26525600395a9118a1a4041  gcc/testsuite/ada/acats-3/tests/cd/cd4041a.tst
! 255be84f9bd123a67360189ab2d64cdf  gcc/testsuite/ada/acats-3/tests/cd/cd4051a.ada
! 37ae7a5703b3780f73cd5ae4eb39621a  gcc/testsuite/ada/acats-3/tests/cd/cd4051b.ada
! 07adf8476ba0c5e57a2bea963c120c2a  gcc/testsuite/ada/acats-3/tests/cd/cd4051c.ada
! cf5f11fa4855f5f18dba58d556b7ca63  gcc/testsuite/ada/acats-3/tests/cd/cd4051d.ada
! 20478b00e54601fd76a247d8a78c4a8f  gcc/testsuite/ada/acats-3/tests/cd/cd5003a.ada
! 4cff6e4a9ec3d2900f66bfc5693af89a  gcc/testsuite/ada/acats-3/tests/cd/cd5003b.ada
! d13512a51a4eb52527563404909e596e  gcc/testsuite/ada/acats-3/tests/cd/cd5003c.ada
! 4652d6ed2c04ade1800842b5dbfdabf9  gcc/testsuite/ada/acats-3/tests/cd/cd5003d.ada
! 005bf8518b263e4cee4d26c5db87e58b  gcc/testsuite/ada/acats-3/tests/cd/cd5003e.ada
! 8ff99eb70e788c11615ac412a1a7b4fb  gcc/testsuite/ada/acats-3/tests/cd/cd5003f.ada
! 719c829d93aa5b1f5984a681101887d3  gcc/testsuite/ada/acats-3/tests/cd/cd5003g.ada
! a7821be04ce2545857881e21292d5867  gcc/testsuite/ada/acats-3/tests/cd/cd5003h.ada
! 3491fd905bd30777ef1fbdfae6595acf  gcc/testsuite/ada/acats-3/tests/cd/cd5003i.ada
! 88b907e17fa7e933c0aa985bcbdba611  gcc/testsuite/ada/acats-3/tests/cd/cd5011a.ada
! 502c219e404c935fb79b18a5bc9edb77  gcc/testsuite/ada/acats-3/tests/cd/cd5011c.ada
! 71b7123461788aab03963e62fecc0ba3  gcc/testsuite/ada/acats-3/tests/cd/cd5011e.ada
! 8ee70bf0284e509f67c72903d25709f7  gcc/testsuite/ada/acats-3/tests/cd/cd5011g.ada
! 3b37531d4672ce7853d736e20f205d9e  gcc/testsuite/ada/acats-3/tests/cd/cd5011i.ada
! b1bd44ec7ae1e5e46e2aecd8d6f8f7b7  gcc/testsuite/ada/acats-3/tests/cd/cd5011k.ada
! b632fa011acdccee9f2b9fb3b5a030bf  gcc/testsuite/ada/acats-3/tests/cd/cd5011m.ada
! fd5e412763d1e844067af789a1ac1c48  gcc/testsuite/ada/acats-3/tests/cd/cd5011q.ada
! ee93e2b7d81f47c56f7b7ad4552b21bb  gcc/testsuite/ada/acats-3/tests/cd/cd5011s.ada
! 47d11b263404f1dd8fe59440a5052207  gcc/testsuite/ada/acats-3/tests/cd/cd5012a.ada
! 1892070e6feeb321986c5cbbcc427b4a  gcc/testsuite/ada/acats-3/tests/cd/cd5012b.ada
! ff4f485285269aca5506577d2a0b3b25  gcc/testsuite/ada/acats-3/tests/cd/cd5012e.ada
! a5f14af29759eeb2088d73d911c87c1f  gcc/testsuite/ada/acats-3/tests/cd/cd5012f.ada
! e5f28d4028e3550e275facc5a05598e5  gcc/testsuite/ada/acats-3/tests/cd/cd5012i.ada
! 16dbc766d573615ec2e4899fad17e3bf  gcc/testsuite/ada/acats-3/tests/cd/cd5012m.ada
! 6cc56f376ceaa00b529da26c6460e8d6  gcc/testsuite/ada/acats-3/tests/cd/cd5013a.ada
! c0918022f30f205dd1507581efbfdd4d  gcc/testsuite/ada/acats-3/tests/cd/cd5013c.ada
! 811d55a4a9aee790bed1e966d928fbb2  gcc/testsuite/ada/acats-3/tests/cd/cd5013e.ada
! 21ba9a45a10469204bf9be2e86069c81  gcc/testsuite/ada/acats-3/tests/cd/cd5013g.ada
! 4f445e0ed2b7e60f8eb00f85696e3a7d  gcc/testsuite/ada/acats-3/tests/cd/cd5013i.ada
! 0b15bb9a260246e000106d4512840f2a  gcc/testsuite/ada/acats-3/tests/cd/cd5013k.ada
! 1da10e9981f9def7bfc6d6c2143211ec  gcc/testsuite/ada/acats-3/tests/cd/cd5013m.ada
! 08a9e582acca940c3e759a92734c93c9  gcc/testsuite/ada/acats-3/tests/cd/cd5013o.ada
! 1968e13f319d3b0c07f4c96303157e60  gcc/testsuite/ada/acats-3/tests/cd/cd5014a.ada
! 7c607413594268a5d4b2292b7cb0413b  gcc/testsuite/ada/acats-3/tests/cd/cd5014c.ada
! 8fef3117954cc6c0a11bb3f93e364b40  gcc/testsuite/ada/acats-3/tests/cd/cd5014e.ada
! 0b813473017a44baccc884d20552e8cd  gcc/testsuite/ada/acats-3/tests/cd/cd5014g.ada
! 527b59a75ca64a8266a57d7a5088fe89  gcc/testsuite/ada/acats-3/tests/cd/cd5014i.ada
! fc74902958756d067346aa25dc320720  gcc/testsuite/ada/acats-3/tests/cd/cd5014k.ada
! b77eb1036af76cfb5202f2de49ace505  gcc/testsuite/ada/acats-3/tests/cd/cd5014m.ada
! ab247e3e629023fbd5f60ebe8227bdb5  gcc/testsuite/ada/acats-3/tests/cd/cd5014o.ada
! fc0ebe93b10ae9a9d4c3c4a5df942f54  gcc/testsuite/ada/acats-3/tests/cd/cd5014t.ada
! c00ed5123db97df563396ec85314f780  gcc/testsuite/ada/acats-3/tests/cd/cd5014v.ada
! bbf572fbf22be12dd2a668dcd54775ea  gcc/testsuite/ada/acats-3/tests/cd/cd5014x.ada
! 34d86be0b29568cce7a2a466311b3b81  gcc/testsuite/ada/acats-3/tests/cd/cd5014y.ada
! b56429de483f94a422eb6ca63ee074f9  gcc/testsuite/ada/acats-3/tests/cd/cd5014z.ada
! aa622725c36aef33e28cfe216e74dbf2  gcc/testsuite/ada/acats-3/tests/cd/cd70001.a
! 2eb61a4a6db022ec0de56d97cdb58d92  gcc/testsuite/ada/acats-3/tests/cd/cd7002a.ada
! aaa73d4164232ddfd2c5811f78c69833  gcc/testsuite/ada/acats-3/tests/cd/cd7007b.ada
! a2455776674d2ad1da3cc32ece807208  gcc/testsuite/ada/acats-3/tests/cd/cd7101d.ada
! aa55af7af75ac0b3c135078d81fb495f  gcc/testsuite/ada/acats-3/tests/cd/cd7101e.dep
! 54f3d5f0c03029d0398feadc1fba13fa  gcc/testsuite/ada/acats-3/tests/cd/cd7101f.dep
! d4c58764ec07d4b64c614f06a404a048  gcc/testsuite/ada/acats-3/tests/cd/cd7101g.tst
! b19b5291beb6e4d9ba34dc60acc52917  gcc/testsuite/ada/acats-3/tests/cd/cd7103d.ada
! bc9859e9de09dbae5b873f61d7dd6d25  gcc/testsuite/ada/acats-3/tests/cd/cd7202a.ada
! 27154e701456e154266de19089be5f95  gcc/testsuite/ada/acats-3/tests/cd/cd7204b.ada
! 866e238520f9fe6f2e1ebc1c66530b27  gcc/testsuite/ada/acats-3/tests/cd/cd7204c.ada
! 463ecdd8176f35af59f9b3791565e928  gcc/testsuite/ada/acats-3/tests/cd/cd72a01.a
! 97e1c7a2d8dcad44f97e8a054d7ddbfa  gcc/testsuite/ada/acats-3/tests/cd/cd72a02.a
! 094d528313c32d60bc8ef9966a3ba667  gcc/testsuite/ada/acats-3/tests/cd/cd7305a.ada
! 89a9ca0baa4aea5a158e931fd05972da  gcc/testsuite/ada/acats-3/tests/cd/cd90001.a
! b35e132e38a1316bb94eb5685e744e45  gcc/testsuite/ada/acats-3/tests/cd/cd92001.a
! 4acd15be94cdb921d9aaaf1c68bc86bd  gcc/testsuite/ada/acats-3/tests/cd/cda201a.ada
! 95c680f466bbb6b462cff702c8c051d8  gcc/testsuite/ada/acats-3/tests/cd/cda201b.ada
! 46aab534344a6aeab59cdc069c0a30a9  gcc/testsuite/ada/acats-3/tests/cd/cda201c.ada
! 51c51b9e46a1a5740ae0b124d61d55ca  gcc/testsuite/ada/acats-3/tests/cd/cda201e.ada
! e5b8e54ff3bc71d8a0f53d66df7260a5  gcc/testsuite/ada/acats-3/tests/cd/cdb0001.a
! 3e8905eddf7e2c220acc4b501f2233a1  gcc/testsuite/ada/acats-3/tests/cd/cdb0002.a
! 4d8334f61837b54deaa10e41063c39af  gcc/testsuite/ada/acats-3/tests/cd/cdb0a01.a
! d60d2f5f8d96507e1b594680a8ddbf8c  gcc/testsuite/ada/acats-3/tests/cd/cdb0a02.a
! d3910d26782aaab53d6acf37e0519685  gcc/testsuite/ada/acats-3/tests/cd/cdd1001.a
! ecea7d5e451c93f7530aa28e39d75580  gcc/testsuite/ada/acats-3/tests/cd/cdd2001.a
! 09e97dda9b7ced04ce9c741ad0599d96  gcc/testsuite/ada/acats-3/tests/cd/cdd2a01.a
! 72e91e49172aabe99c78bb568616e583  gcc/testsuite/ada/acats-3/tests/cd/cdd2a02.a
! 36648315ddf64d4e564a5e05da351b1c  gcc/testsuite/ada/acats-3/tests/cd/cdd2a03.a
! 9ab6f734463584ed4f42316ca9f7798f  gcc/testsuite/ada/acats-3/tests/cd/cdd2b01.a
! 3ce443f0ccbd9dba9e932b0f23c415a2  gcc/testsuite/ada/acats-3/tests/cd/cdd2b03.a
! 317e3f1dc15de17ef49001a1f08c35b3  gcc/testsuite/ada/acats-3/tests/cd/cde0001.a
! e3c9b20329b0f7e7d60dc55f195727f7  gcc/testsuite/ada/acats-3/tests/ce/ce2102a.ada
! 56be361ddf744d65d5919f5f77470cfd  gcc/testsuite/ada/acats-3/tests/ce/ce2102b.ada
! 83c95e98a0edc5913eda034e9803f9a3  gcc/testsuite/ada/acats-3/tests/ce/ce2102c.tst
! 704cb92cd741551b8c76bb24ab8f01a6  gcc/testsuite/ada/acats-3/tests/ce/ce2102d.ada
! a4c5c5ff89eb450e4c847a9cebea2a03  gcc/testsuite/ada/acats-3/tests/ce/ce2102e.ada
! 27760dba95f836989a21b8529a71855d  gcc/testsuite/ada/acats-3/tests/ce/ce2102f.ada
! fe48a7b7badffee5e6b11bab0b32391a  gcc/testsuite/ada/acats-3/tests/ce/ce2102g.ada
! d704111bdcdb479f1991a8daee40cdc6  gcc/testsuite/ada/acats-3/tests/ce/ce2102h.tst
! 660d5113b9badd86759bd83e670ede30  gcc/testsuite/ada/acats-3/tests/ce/ce2102i.ada
! 8796caaebedc2e2c57dc7e71ff241431  gcc/testsuite/ada/acats-3/tests/ce/ce2102j.ada
! ceb778fa800778a3993ddc7cd9190c8f  gcc/testsuite/ada/acats-3/tests/ce/ce2102k.ada
! 23bd39333ef2a75df64af434a8d52288  gcc/testsuite/ada/acats-3/tests/ce/ce2102l.ada
! 9a4f2b513351918f23c1e1fcc5d48aaa  gcc/testsuite/ada/acats-3/tests/ce/ce2102m.ada
! 57880455279d766e91fd84c1ad26a38f  gcc/testsuite/ada/acats-3/tests/ce/ce2102n.ada
! 1658c529498b5b4b8d79ff4a0a362715  gcc/testsuite/ada/acats-3/tests/ce/ce2102o.ada
! a942f038d4463c45d5c583b1985c7c87  gcc/testsuite/ada/acats-3/tests/ce/ce2102p.ada
! 8ce185028df0d4e8d8de27e964b87758  gcc/testsuite/ada/acats-3/tests/ce/ce2102q.ada
! 1439304477a0f927f09dcb2a2639fe66  gcc/testsuite/ada/acats-3/tests/ce/ce2102r.ada
! a5aff3dd28b5d54dcd3d2367ad10512e  gcc/testsuite/ada/acats-3/tests/ce/ce2102s.ada
! fab20fee3d01ec0d98c83ae2e0b85bda  gcc/testsuite/ada/acats-3/tests/ce/ce2102t.ada
! fb506c6fcfe4ce698ff9a830b7c56229  gcc/testsuite/ada/acats-3/tests/ce/ce2102u.ada
! 6533e0fca22d00bf5e7584ed3a4dc842  gcc/testsuite/ada/acats-3/tests/ce/ce2102v.ada
! 96597eb49b1372fa65ee2328da95ca07  gcc/testsuite/ada/acats-3/tests/ce/ce2102w.ada
! 79aea0b4cdef1b6365b9be26c87383b1  gcc/testsuite/ada/acats-3/tests/ce/ce2102x.ada
! b982e3e68e8a4f04e10e3b2780934046  gcc/testsuite/ada/acats-3/tests/ce/ce2102y.ada
! d102ee0d07b326b9d4073e60e25ee113  gcc/testsuite/ada/acats-3/tests/ce/ce2103a.tst
! ae11fc214dfce8e1c5dce5dd8dff9ad9  gcc/testsuite/ada/acats-3/tests/ce/ce2103b.tst
! 97d4cf14fe4c578c0d86448663834c20  gcc/testsuite/ada/acats-3/tests/ce/ce2103c.ada
! 99c7332bd6a90a3213eb826d7f902efa  gcc/testsuite/ada/acats-3/tests/ce/ce2103d.ada
! 60b763cadd79ca8009e41e392d9aa37b  gcc/testsuite/ada/acats-3/tests/ce/ce2104a.ada
! 4f9096bebf0622c62a3f4358655497af  gcc/testsuite/ada/acats-3/tests/ce/ce2104b.ada
! f1962e353466d1757ad6a9c641624847  gcc/testsuite/ada/acats-3/tests/ce/ce2104c.ada
! c687f392201a3d542022c53d87c728c6  gcc/testsuite/ada/acats-3/tests/ce/ce2104d.ada
! e59622b5be7a0b85f62f4f5dfd87250c  gcc/testsuite/ada/acats-3/tests/ce/ce2106a.ada
! 0390975b4b078391dba02ca3c8f31638  gcc/testsuite/ada/acats-3/tests/ce/ce2106b.ada
! 8576613b0fb7cb5404cf64939d34b3af  gcc/testsuite/ada/acats-3/tests/ce/ce2108e.ada
! 651994d660ec55d3e422ceb303d2034b  gcc/testsuite/ada/acats-3/tests/ce/ce2108f.ada
! ba5e89f5212818e3e53a4cf7d59d646c  gcc/testsuite/ada/acats-3/tests/ce/ce2108g.ada
! fb62dbd03a1355b41f3d194167f479aa  gcc/testsuite/ada/acats-3/tests/ce/ce2108h.ada
! e1df0b3934297c1162437a03a450f12a  gcc/testsuite/ada/acats-3/tests/ce/ce2109a.ada
! d91a1fcd2695ad63b53b63e0d22d3f22  gcc/testsuite/ada/acats-3/tests/ce/ce2109b.ada
! 0a95aeffa3822cc96d6f770183b34979  gcc/testsuite/ada/acats-3/tests/ce/ce2109c.ada
! 329e30bd5ac69971fa84cd76bd66b302  gcc/testsuite/ada/acats-3/tests/ce/ce2110a.ada
! b63ea51508983167185a0e378c787235  gcc/testsuite/ada/acats-3/tests/ce/ce2110c.ada
! 385c38395502c50c4f04f16ed172b5c3  gcc/testsuite/ada/acats-3/tests/ce/ce2111a.ada
! 0cab0967d4b6100c093d83a0daa2ca06  gcc/testsuite/ada/acats-3/tests/ce/ce2111b.ada
! 1def457c7ded3aa15287b30a02c2c1bf  gcc/testsuite/ada/acats-3/tests/ce/ce2111c.ada
! e039c87f3e2f30f3b378642cc3d5d3c3  gcc/testsuite/ada/acats-3/tests/ce/ce2111e.ada
! 607ff5b75e0ac677df365e3867c8b8bc  gcc/testsuite/ada/acats-3/tests/ce/ce2111f.ada
! 9b55a66cd32d536d65916a0288c480f4  gcc/testsuite/ada/acats-3/tests/ce/ce2111g.ada
! 9aac3a3d20f722d72f0a97d15db7e6ff  gcc/testsuite/ada/acats-3/tests/ce/ce2111i.ada
! 451691c716142d6af52540932182f7a8  gcc/testsuite/ada/acats-3/tests/ce/ce2201a.ada
! a9019ab5c60383a5aec6b4e12cf67546  gcc/testsuite/ada/acats-3/tests/ce/ce2201b.ada
! 29858e1a8a6dd46bb9164e8c8edbcddf  gcc/testsuite/ada/acats-3/tests/ce/ce2201c.ada
! 34d8b0e50b71bb424acf20936253736f  gcc/testsuite/ada/acats-3/tests/ce/ce2201d.dep
! b20fac24f54e723d0cc0d2b283a1a98c  gcc/testsuite/ada/acats-3/tests/ce/ce2201e.dep
! e5ef319f07f83742ea6dacb674de4c74  gcc/testsuite/ada/acats-3/tests/ce/ce2201f.ada
! 89d1575c20871ec14a7510e2c7fd7e56  gcc/testsuite/ada/acats-3/tests/ce/ce2201g.ada
! 06e274ba9cfdca457d343f7d036af0bc  gcc/testsuite/ada/acats-3/tests/ce/ce2201h.ada
! 819625912e63f1bb0690319469d91d14  gcc/testsuite/ada/acats-3/tests/ce/ce2201i.ada
! c75df2290aa04176fd8862e092446183  gcc/testsuite/ada/acats-3/tests/ce/ce2201j.ada
! 5cd3fabcbac1ce5f97eb0c3b7ff68060  gcc/testsuite/ada/acats-3/tests/ce/ce2201k.ada
! 5f85b515f14775082f0cef057e6c7cec  gcc/testsuite/ada/acats-3/tests/ce/ce2201l.ada
! dacbb7d19d52906e970100c8a0524fd4  gcc/testsuite/ada/acats-3/tests/ce/ce2201m.ada
! 45f176910989cfdcd7fdc941f37a5b71  gcc/testsuite/ada/acats-3/tests/ce/ce2201n.ada
! 376cc7edaf46154ca8f65652b5d6eca4  gcc/testsuite/ada/acats-3/tests/ce/ce2202a.ada
! 939f3ce3a39c9ca9d86e52320f27ff2c  gcc/testsuite/ada/acats-3/tests/ce/ce2203a.tst
! ba04f29f243a15d2bbe413b9e0066901  gcc/testsuite/ada/acats-3/tests/ce/ce2204a.ada
! 2fc36a0b7b4ddb630b023af7c4d90ba7  gcc/testsuite/ada/acats-3/tests/ce/ce2204b.ada
! 9ef6a168f2e294541459fe7a14263eb5  gcc/testsuite/ada/acats-3/tests/ce/ce2204c.ada
! b0274d08b84af4b62ad59e3d9ddb07df  gcc/testsuite/ada/acats-3/tests/ce/ce2204d.ada
! 34418b28be06a3924c3a2584bef259b6  gcc/testsuite/ada/acats-3/tests/ce/ce2205a.ada
! 5c92fac63d085e6a68726106d482ea42  gcc/testsuite/ada/acats-3/tests/ce/ce2206a.ada
! fcc7c7c24b495ce3ddaa0f9a580d75ee  gcc/testsuite/ada/acats-3/tests/ce/ce2208b.ada
! 97568e8cf63e0507c14b35a1a14e20c0  gcc/testsuite/ada/acats-3/tests/ce/ce2401a.ada
! dcd9e7cbbd7e97c5dd3e3add1eb9dc36  gcc/testsuite/ada/acats-3/tests/ce/ce2401b.ada
! efcdb258c81995c38e8cc3694b22f6dd  gcc/testsuite/ada/acats-3/tests/ce/ce2401c.ada
! e7f9dbd6fea160401601272d061289a3  gcc/testsuite/ada/acats-3/tests/ce/ce2401e.ada
! 1bf5badbcde77492314acef836d8ea11  gcc/testsuite/ada/acats-3/tests/ce/ce2401f.ada
! eb673da58247c955773ce3b8e1c2d4f3  gcc/testsuite/ada/acats-3/tests/ce/ce2401h.ada
! 6918301d4740c9f3a5bcdf8763ba341a  gcc/testsuite/ada/acats-3/tests/ce/ce2401i.ada
! 664a2145b5105ab8ae94b8ba8dca5cdd  gcc/testsuite/ada/acats-3/tests/ce/ce2401j.ada
! 7f54c0274e46b59b1fec8510f4fc3ad7  gcc/testsuite/ada/acats-3/tests/ce/ce2401k.ada
! a83a38fe98395d0bb886cb6143eb8170  gcc/testsuite/ada/acats-3/tests/ce/ce2401l.ada
! 2c4e89aba46a0152400d53a9aed78ba8  gcc/testsuite/ada/acats-3/tests/ce/ce2402a.ada
! 4e54cd3fcd15e2f31d844365222a85b3  gcc/testsuite/ada/acats-3/tests/ce/ce2403a.tst
! 4fce3b03a76a452b2433c54b199834ff  gcc/testsuite/ada/acats-3/tests/ce/ce2404a.ada
! ad81e45a71e09a3713483ae198eae6b0  gcc/testsuite/ada/acats-3/tests/ce/ce2404b.ada
! 397eb6a738bd1fb16bf404d4581a21e8  gcc/testsuite/ada/acats-3/tests/ce/ce2405b.ada
! 035cdd8af2147f386ba98eafee6fa53d  gcc/testsuite/ada/acats-3/tests/ce/ce2406a.ada
! bc1c3fb660e3a1a6cd3c3cd2c20c6f21  gcc/testsuite/ada/acats-3/tests/ce/ce2407a.ada
! e21a045af5825bcf7bae0f7774bf28bb  gcc/testsuite/ada/acats-3/tests/ce/ce2407b.ada
! 1ac50c952fbab2fcf2e1391bb697aac1  gcc/testsuite/ada/acats-3/tests/ce/ce2408a.ada
! fb58d51e1570b9726aa28d10034cf135  gcc/testsuite/ada/acats-3/tests/ce/ce2408b.ada
! d60b98c48fae643e51060dfd4200371e  gcc/testsuite/ada/acats-3/tests/ce/ce2409a.ada
! 5b25842de422c3e8d6301447c51d8985  gcc/testsuite/ada/acats-3/tests/ce/ce2409b.ada
! e03ae0d17d4ce186bb17ad28c1d12c8e  gcc/testsuite/ada/acats-3/tests/ce/ce2410a.ada
! a10dc12fca4ab67d0e070b8f08878918  gcc/testsuite/ada/acats-3/tests/ce/ce2410b.ada
! ef01f4584aa6fe18dfca4291aa2b9936  gcc/testsuite/ada/acats-3/tests/ce/ce2411a.ada
! cfdd50459f606dfd0272b27f902831f0  gcc/testsuite/ada/acats-3/tests/ce/ce3002b.tst
! 8c7a2401c3fd65042aaf7fbaaebb05d5  gcc/testsuite/ada/acats-3/tests/ce/ce3002c.tst
! 60cfa1b0514071feae57d422f407bbc6  gcc/testsuite/ada/acats-3/tests/ce/ce3002d.ada
! f7f30f9bace21926cfd024ab3ae7ed4a  gcc/testsuite/ada/acats-3/tests/ce/ce3002f.ada
! c4f22dddebf62a993e9a5dca37748e9a  gcc/testsuite/ada/acats-3/tests/ce/ce3102a.ada
! 019efa14311a98e7532962ec6464bb8e  gcc/testsuite/ada/acats-3/tests/ce/ce3102b.tst
! dab3a80b1760df07e4cf44cef4f9ca81  gcc/testsuite/ada/acats-3/tests/ce/ce3102d.ada
! 112884bd382c35480c4248866f3a556e  gcc/testsuite/ada/acats-3/tests/ce/ce3102e.ada
! 884f6ff3272bb27974b5c059fd940eb8  gcc/testsuite/ada/acats-3/tests/ce/ce3102f.ada
! 561a9bb3212245b35ea37ed7834ace08  gcc/testsuite/ada/acats-3/tests/ce/ce3102g.ada
! a5c10d55f5c631bb605e9f92f33b3d83  gcc/testsuite/ada/acats-3/tests/ce/ce3102h.ada
! 16f9be98787f36d98dd3a0d7c5673f99  gcc/testsuite/ada/acats-3/tests/ce/ce3102i.ada
! f2fb4988c4b17b901cb57756fa48524d  gcc/testsuite/ada/acats-3/tests/ce/ce3102j.ada
! 5885ee3beb2611070afd9595b92d024d  gcc/testsuite/ada/acats-3/tests/ce/ce3102k.ada
! af4fce15977e583c9580c84a57f46000  gcc/testsuite/ada/acats-3/tests/ce/ce3103a.ada
! 1a359b00af85a86ae636ed8ce9f54011  gcc/testsuite/ada/acats-3/tests/ce/ce3104a.ada
! 62ae4a6a702993a429980ed85d7d288b  gcc/testsuite/ada/acats-3/tests/ce/ce3104b.ada
! 3097f1866f5a1a12edc0bd1ad06fcfd7  gcc/testsuite/ada/acats-3/tests/ce/ce3104c.ada
! ffdd7cea02bf78362b21d5b47923f55a  gcc/testsuite/ada/acats-3/tests/ce/ce3106a.ada
! c089188b0086e9498b16c61338d1c72e  gcc/testsuite/ada/acats-3/tests/ce/ce3106b.ada
! 7ec91be55117ceec515d06ff18fd96f6  gcc/testsuite/ada/acats-3/tests/ce/ce3107a.tst
! 29791bc75974606a36e491a742bb3096  gcc/testsuite/ada/acats-3/tests/ce/ce3107b.ada
! eb49ffd6a23ce40400cdc2ebf0c8f371  gcc/testsuite/ada/acats-3/tests/ce/ce3108a.ada
! fd863ff6b1661c6c912d9bf6aebc3bc9  gcc/testsuite/ada/acats-3/tests/ce/ce3108b.ada
! 97e280eb5834dec4e91bbbc97553b1c7  gcc/testsuite/ada/acats-3/tests/ce/ce3110a.ada
! 5f42a55944d863fa57d6e12253d4922c  gcc/testsuite/ada/acats-3/tests/ce/ce3112c.ada
! c9d44fa9ff3ca5a2ccdda83b010c1f54  gcc/testsuite/ada/acats-3/tests/ce/ce3112d.ada
! f01486f7b41b7e9bb285f2b42444a64f  gcc/testsuite/ada/acats-3/tests/ce/ce3114a.ada
! 816907364fd976b617fbee2dc8afc858  gcc/testsuite/ada/acats-3/tests/ce/ce3115a.ada
! 55427ea93a85e61592244d314238e089  gcc/testsuite/ada/acats-3/tests/ce/ce3201a.ada
! 0a50773e8cb26d94c11adb5533460429  gcc/testsuite/ada/acats-3/tests/ce/ce3202a.ada
! 06b5bbb44e688a3c0c0ca62e655c32ab  gcc/testsuite/ada/acats-3/tests/ce/ce3206a.ada
! 98a3e7772f00a7bebd187c6c2d309f82  gcc/testsuite/ada/acats-3/tests/ce/ce3207a.ada
! f4529439e526335f9525bb157863cc63  gcc/testsuite/ada/acats-3/tests/ce/ce3301a.ada
! 0a70a8ac8ee35a84b380c07ea541b57f  gcc/testsuite/ada/acats-3/tests/ce/ce3302a.ada
! 9bac0e06cef0c10689cc849f3c509fcf  gcc/testsuite/ada/acats-3/tests/ce/ce3303a.ada
! 23c77e761edd8a91671acf3422a0ca06  gcc/testsuite/ada/acats-3/tests/ce/ce3304a.tst
! d0da64618db56f4abfac0c3b90fa0296  gcc/testsuite/ada/acats-3/tests/ce/ce3305a.ada
! 3f7e70ff0a93058dd780e3e6e4fefa3d  gcc/testsuite/ada/acats-3/tests/ce/ce3306a.ada
! 4e1329f66825e0283637c00ca6acc5b6  gcc/testsuite/ada/acats-3/tests/ce/ce3401a.ada
! df06c67b3b1ea125ef98d5346e81cc7e  gcc/testsuite/ada/acats-3/tests/ce/ce3402a.ada
! b50c12a694c3c56d3a2cf04d9ca9ccc3  gcc/testsuite/ada/acats-3/tests/ce/ce3402c.ada
! e2743c970635e3ead26ba550e6c23aab  gcc/testsuite/ada/acats-3/tests/ce/ce3402d.ada
! c0341031211c513d8c748c61167125fb  gcc/testsuite/ada/acats-3/tests/ce/ce3402e.ada
! f9deacf7d49917900f3fcee43aee5ca6  gcc/testsuite/ada/acats-3/tests/ce/ce3403a.ada
! fec31596c967bb1bab6a046e32225c6b  gcc/testsuite/ada/acats-3/tests/ce/ce3403b.ada
! 7e9202e07d3f865f2ceeb151792c452f  gcc/testsuite/ada/acats-3/tests/ce/ce3403c.ada
! 64070608c4f9c6a05d1e23408e5beb0d  gcc/testsuite/ada/acats-3/tests/ce/ce3403d.ada
! d82cac6d273d1fbe65506c1eecff04b9  gcc/testsuite/ada/acats-3/tests/ce/ce3403e.ada
! 7cdc9d7a9c43884cbedbde28d4954fe4  gcc/testsuite/ada/acats-3/tests/ce/ce3403f.ada
! dc1a67476ce793079c7af8b2d1b275ac  gcc/testsuite/ada/acats-3/tests/ce/ce3404a.ada
! 8b982e428bef61a3980b00b8079ad4f2  gcc/testsuite/ada/acats-3/tests/ce/ce3404b.ada
! 5cc2fbe64ade8df5eced5c397a38020a  gcc/testsuite/ada/acats-3/tests/ce/ce3404c.ada
! 871605306e645bb8c8952539a05637b2  gcc/testsuite/ada/acats-3/tests/ce/ce3404d.ada
! 5afe1fa2e94e304b32849dad526b0cb4  gcc/testsuite/ada/acats-3/tests/ce/ce3405a.ada
! 75e7f1f2e2d338bdbc593c460b1e055f  gcc/testsuite/ada/acats-3/tests/ce/ce3405c.ada
! d61f321bab45f725f89da9ebd98c7959  gcc/testsuite/ada/acats-3/tests/ce/ce3405d.ada
! 683881439899376dec46462b7b974e93  gcc/testsuite/ada/acats-3/tests/ce/ce3406a.ada
! 1d67a6840b438185a99382b830ffe815  gcc/testsuite/ada/acats-3/tests/ce/ce3406b.ada
! 00a1933b7205d0378d065989609d0e6f  gcc/testsuite/ada/acats-3/tests/ce/ce3406c.ada
! bc8a2b4d509e438b111cb451ba6c633d  gcc/testsuite/ada/acats-3/tests/ce/ce3406d.ada
! 0c8f9906304b5f6e2f871a2f56543e48  gcc/testsuite/ada/acats-3/tests/ce/ce3407a.ada
! d6da13ff2e3c07bb7f9617a04f387915  gcc/testsuite/ada/acats-3/tests/ce/ce3407b.ada
! bacd5248d5883ef91439cbdd245cbd9a  gcc/testsuite/ada/acats-3/tests/ce/ce3407c.ada
! babb7fd82795ea56950eb78715c895aa  gcc/testsuite/ada/acats-3/tests/ce/ce3408a.ada
! e30520b348614e4a8e628b3ea3aad54e  gcc/testsuite/ada/acats-3/tests/ce/ce3408b.ada
! 5d1d893ced6dbc7d9f25ee4a5fb8e211  gcc/testsuite/ada/acats-3/tests/ce/ce3408c.ada
! ca268135b5b6d64dc8be3768b6f7edc0  gcc/testsuite/ada/acats-3/tests/ce/ce3409a.ada
! 6c79cafc53b26bfb3c462c4d01969806  gcc/testsuite/ada/acats-3/tests/ce/ce3409b.ada
! 153c9a6d9246f682a42cd95552087944  gcc/testsuite/ada/acats-3/tests/ce/ce3409c.ada
! 62ed81bdf1e56f27f4c2630b320c6b75  gcc/testsuite/ada/acats-3/tests/ce/ce3409d.ada
! 67051865f07afe2038f84683dece3683  gcc/testsuite/ada/acats-3/tests/ce/ce3409e.ada
! 36c2b6db90b30d1e89dfe642110ca9be  gcc/testsuite/ada/acats-3/tests/ce/ce3410a.ada
! 5cf308b315cd2ac4c47ecb7409ef0ba1  gcc/testsuite/ada/acats-3/tests/ce/ce3410b.ada
! bcebb594f14a81961460c696159ea641  gcc/testsuite/ada/acats-3/tests/ce/ce3410c.ada
! c28a6aea6e2fa07f6b2e23e3e14876c2  gcc/testsuite/ada/acats-3/tests/ce/ce3410d.ada
! 8c67058f9e7fc008e387aa622534b5d4  gcc/testsuite/ada/acats-3/tests/ce/ce3410e.ada
! 4c3d96fe2a475d4a97d07bbd385cd260  gcc/testsuite/ada/acats-3/tests/ce/ce3411a.ada
! 0a0deabd5d66c7e62d00da0c83ac5dfa  gcc/testsuite/ada/acats-3/tests/ce/ce3411c.ada
! a8dda42826e8174f0657de7379cb605b  gcc/testsuite/ada/acats-3/tests/ce/ce3412a.ada
! 040ce75a5a909fb3da32ae0e451bda3e  gcc/testsuite/ada/acats-3/tests/ce/ce3413a.ada
! 951c9393706295621e4a78e9a1b9e2ee  gcc/testsuite/ada/acats-3/tests/ce/ce3413b.ada
! c33c707be5a9051ad8c6962035162e25  gcc/testsuite/ada/acats-3/tests/ce/ce3413c.ada
! 6cb9f4f71827deb077bcc1180c854625  gcc/testsuite/ada/acats-3/tests/ce/ce3414a.ada
! e5e2298148250ece65cc736cf86b5a00  gcc/testsuite/ada/acats-3/tests/ce/ce3601a.ada
! 1215dc7327db7704c21d367fe12a1ab9  gcc/testsuite/ada/acats-3/tests/ce/ce3602a.ada
! 6ccbba350556793177123ad7809e0ff9  gcc/testsuite/ada/acats-3/tests/ce/ce3602b.ada
! 12843cf2e9816b955ca7962f9bfc627f  gcc/testsuite/ada/acats-3/tests/ce/ce3602c.ada
! cef84bc67c1c6c0d7583ed454834a34f  gcc/testsuite/ada/acats-3/tests/ce/ce3602d.ada
! 5e31687529c52bde6efe93242bcbf2f8  gcc/testsuite/ada/acats-3/tests/ce/ce3603a.ada
! 3dc38686e9ce99632f9e21e584055443  gcc/testsuite/ada/acats-3/tests/ce/ce3604a.ada
! 98f98beec04bb6905ddea16ed212134f  gcc/testsuite/ada/acats-3/tests/ce/ce3604b.ada
! 1c7074f06be7b99dab79f14d5dddb060  gcc/testsuite/ada/acats-3/tests/ce/ce3605a.ada
! 49a30d4306b467f2cd10d4b811cfa231  gcc/testsuite/ada/acats-3/tests/ce/ce3605b.ada
! b496a8c56eea6c0501a70a96873353f7  gcc/testsuite/ada/acats-3/tests/ce/ce3605c.ada
! 6f3fe3a52cae3aa00e90c34391f3d16d  gcc/testsuite/ada/acats-3/tests/ce/ce3605d.ada
! 86bd1f46afec2bf13df76bd0d8ce0514  gcc/testsuite/ada/acats-3/tests/ce/ce3605e.ada
! 8388e3c1abd488ed32c198647fab80fe  gcc/testsuite/ada/acats-3/tests/ce/ce3606a.ada
! b3c475457035678aad225b02f0baaf49  gcc/testsuite/ada/acats-3/tests/ce/ce3606b.ada
! c0471531dea8b138d096c3049a710d34  gcc/testsuite/ada/acats-3/tests/ce/ce3701a.ada
! 918eb1c7abfa51f1d0f0920c8c6305e7  gcc/testsuite/ada/acats-3/tests/ce/ce3704a.ada
! fd0817427cf4c02d336138b11d6153a8  gcc/testsuite/ada/acats-3/tests/ce/ce3704b.ada
! 7fe37fdc40a516882c3388c9405adb57  gcc/testsuite/ada/acats-3/tests/ce/ce3704c.ada
! 9fb3d924d4a90f6940ec5e4b11a0ce61  gcc/testsuite/ada/acats-3/tests/ce/ce3704d.ada
! b5466a70b0554788bcffce4b777d7bbd  gcc/testsuite/ada/acats-3/tests/ce/ce3704e.ada
! 2bd3e088ed3663d0f57172ec9878402c  gcc/testsuite/ada/acats-3/tests/ce/ce3704f.ada
! c1b7a44976ea643f0821318848d2a333  gcc/testsuite/ada/acats-3/tests/ce/ce3704m.ada
! fbb2cb08fa9bd676488ed39c0025017d  gcc/testsuite/ada/acats-3/tests/ce/ce3704n.ada
! ddc6d31452157a248e0315438e717892  gcc/testsuite/ada/acats-3/tests/ce/ce3704o.ada
! 0f3f07ab9439af00921be7fba20ce330  gcc/testsuite/ada/acats-3/tests/ce/ce3705a.ada
! 3be84deb5cb9f6d5be7c2cadf68a90f5  gcc/testsuite/ada/acats-3/tests/ce/ce3705b.ada
! 11a056cf164688fbe30b1b1a85208e47  gcc/testsuite/ada/acats-3/tests/ce/ce3705c.ada
! e6e83df07a3fab385c58b17a0a43ca83  gcc/testsuite/ada/acats-3/tests/ce/ce3705d.ada
! c1458b663e297c80390f9cd80c7f5864  gcc/testsuite/ada/acats-3/tests/ce/ce3705e.ada
! fab53328469c600d972529f33eecee23  gcc/testsuite/ada/acats-3/tests/ce/ce3706c.ada
! aed136cb2863502616daa378424686d6  gcc/testsuite/ada/acats-3/tests/ce/ce3706d.ada
! 6344fa066f047ece7e15a9dc9dc4bf76  gcc/testsuite/ada/acats-3/tests/ce/ce3706f.ada
! 5316d57b3ad4c2e7fdcfa4dcf7de4439  gcc/testsuite/ada/acats-3/tests/ce/ce3706g.ada
! a778f4b7a5f926d446e0a70ffc718db8  gcc/testsuite/ada/acats-3/tests/ce/ce3707a.ada
! 478e73d32be1e76a0099cd9a73da79c0  gcc/testsuite/ada/acats-3/tests/ce/ce3708a.ada
! 818f2f0d5fcc6bdd1c354cc85b1e6640  gcc/testsuite/ada/acats-3/tests/ce/ce3801a.ada
! 6dc388aa9640dfd68a016a87aedb4e9b  gcc/testsuite/ada/acats-3/tests/ce/ce3801b.ada
! e7b36818b6b1f0625c96af8481f52f0d  gcc/testsuite/ada/acats-3/tests/ce/ce3804a.ada
! c3922fdc4d7bd246e803dbcf29ec365b  gcc/testsuite/ada/acats-3/tests/ce/ce3804b.ada
! eae67ccfbe2e51d92e77fbd2aefd9279  gcc/testsuite/ada/acats-3/tests/ce/ce3804c.ada
! b6842219efec21bda3be0c99f4cc04b4  gcc/testsuite/ada/acats-3/tests/ce/ce3804d.ada
! 9eef715602b30b1986cd238ae1f5fc61  gcc/testsuite/ada/acats-3/tests/ce/ce3804e.ada
! c5996f22c17f572bd9ab7181c9c39831  gcc/testsuite/ada/acats-3/tests/ce/ce3804f.ada
! 613171f59b0c0405911c4d928abfb0b4  gcc/testsuite/ada/acats-3/tests/ce/ce3804g.ada
! d992e56c7b48881cc7480a014ee01ce9  gcc/testsuite/ada/acats-3/tests/ce/ce3804h.ada
! a78767becb4aa2f884469056ae3d7ec4  gcc/testsuite/ada/acats-3/tests/ce/ce3804i.ada
! a4e5e33e2585ba61ae7ae7ae4db12bb2  gcc/testsuite/ada/acats-3/tests/ce/ce3804j.ada
! e6928c085b0205ec7db55a9f830ccdd0  gcc/testsuite/ada/acats-3/tests/ce/ce3804m.ada
! 7193594f0a1b29b3c2845bdce32c53e7  gcc/testsuite/ada/acats-3/tests/ce/ce3804o.ada
! 4a0b48b429236f9e1c8e6f58dd3bfa28  gcc/testsuite/ada/acats-3/tests/ce/ce3804p.ada
! 9ac3d952f3c355af267e6a6d9f4a8a79  gcc/testsuite/ada/acats-3/tests/ce/ce3805a.ada
! c7fd8ecaab44034a4d7e19eaf52d3390  gcc/testsuite/ada/acats-3/tests/ce/ce3805b.ada
! 1aab796cf0e7689c6edac441d619d28e  gcc/testsuite/ada/acats-3/tests/ce/ce3806a.ada
! 2e9a765636a0e1133cc203d0def8724d  gcc/testsuite/ada/acats-3/tests/ce/ce3806b.ada
! bc5e903902196b77527b50b767c2d7da  gcc/testsuite/ada/acats-3/tests/ce/ce3806c.ada
! ee7b548143b3610a6b8d3fdd4698dc45  gcc/testsuite/ada/acats-3/tests/ce/ce3806d.ada
! 4ef742156a97e0838a7c68579a62465c  gcc/testsuite/ada/acats-3/tests/ce/ce3806e.ada
! 48eed75e47db04066ee57577ae8febdf  gcc/testsuite/ada/acats-3/tests/ce/ce3806f.ada
! fae283383fb9395ac865027e5ecb9495  gcc/testsuite/ada/acats-3/tests/ce/ce3806g.ada
! 9d6687f5803bfad7ea35a3abcdb5772c  gcc/testsuite/ada/acats-3/tests/ce/ce3806h.ada
! d3af3076cdba08b0142afed2e6fc0b7b  gcc/testsuite/ada/acats-3/tests/ce/ce3809a.ada
! 2144655343ab8e0671768264f1de7939  gcc/testsuite/ada/acats-3/tests/ce/ce3809b.ada
! 94c3af83ea38d2552587ed3285a692b6  gcc/testsuite/ada/acats-3/tests/ce/ce3810a.ada
! 2b16f8d4e554f10c2a187f8308d7c631  gcc/testsuite/ada/acats-3/tests/ce/ce3810b.ada
! d426db9733cc34265b461b792b6474ad  gcc/testsuite/ada/acats-3/tests/ce/ce3815a.ada
! 48a18490ee8614f76691210dd9487c7b  gcc/testsuite/ada/acats-3/tests/ce/ce3901a.ada
! c0b5bdc86cdd66cb3f89cb34da6bafc6  gcc/testsuite/ada/acats-3/tests/ce/ce3902b.ada
! a2d6108b8d0296883e3c658639d13b49  gcc/testsuite/ada/acats-3/tests/ce/ce3904a.ada
! 379cd7598f79bae2f05b0815465e285f  gcc/testsuite/ada/acats-3/tests/ce/ce3904b.ada
! 49a69ee3b18484263b6f081df965ab54  gcc/testsuite/ada/acats-3/tests/ce/ce3905a.ada
! c53bbe9b612250e0e99c4238d30a2004  gcc/testsuite/ada/acats-3/tests/ce/ce3905b.ada
! 72f61386b7953b00b7cff52dfbc382c2  gcc/testsuite/ada/acats-3/tests/ce/ce3905c.ada
! 2ef4e950bf19d740d3354feb5811b645  gcc/testsuite/ada/acats-3/tests/ce/ce3905l.ada
! 68ee2e176861f501ee862916a0b9b86e  gcc/testsuite/ada/acats-3/tests/ce/ce3906a.ada
! d47ad5ee4c0a4fdbf2ea42a44fe42621  gcc/testsuite/ada/acats-3/tests/ce/ce3906b.ada
! 695b6968a4b0e7d53b5b76fb4f7da0c0  gcc/testsuite/ada/acats-3/tests/ce/ce3906c.ada
! 90d21e5ea4be7a236bfb40661d560471  gcc/testsuite/ada/acats-3/tests/ce/ce3906d.ada
! 3462bab257d5dd10bcb9c56813aa1e74  gcc/testsuite/ada/acats-3/tests/ce/ce3906e.ada
! 2c106bf46db6d9c4c50c01fbe92b517f  gcc/testsuite/ada/acats-3/tests/ce/ce3906f.ada
! 7c41fbcef2ed668ee19c73f44c696bac  gcc/testsuite/ada/acats-3/tests/ce/ce3907a.ada
! ee7ec1f6b6ec4c5ef50b1d777026421a  gcc/testsuite/ada/acats-3/tests/ce/ce3908a.ada
! c4b3b8c1c9564099bdde092389cc2da4  gcc/testsuite/ada/acats-3/tests/cxa/cxa3001.a
! edb7feb6536121adfd4fd4a2f3d69a3f  gcc/testsuite/ada/acats-3/tests/cxa/cxa3002.a
! 48392592efa08a198d6e5d7a1a663683  gcc/testsuite/ada/acats-3/tests/cxa/cxa3003.a
! 7eb11ccdd82615be75ded3c2d5c126d1  gcc/testsuite/ada/acats-3/tests/cxa/cxa3004.a
! bd60e198cabb483702243c263729427b  gcc/testsuite/ada/acats-3/tests/cxa/cxa4001.a
! 448cbac61205b8887f79bf74d5666a04  gcc/testsuite/ada/acats-3/tests/cxa/cxa4002.a
! 46d3d97d6347f9b5ec34b3513bcfab40  gcc/testsuite/ada/acats-3/tests/cxa/cxa4003.a
! 76c3b922526644795e2203573ee488e2  gcc/testsuite/ada/acats-3/tests/cxa/cxa4004.a
! 4b1514a00cc831e1766e0d36c67e271f  gcc/testsuite/ada/acats-3/tests/cxa/cxa4005.a
! dcde2eda6ce0a916997883996641ea19  gcc/testsuite/ada/acats-3/tests/cxa/cxa4006.a
! f528eee5266ffb815aad7b653d5be870  gcc/testsuite/ada/acats-3/tests/cxa/cxa4007.a
! 413d98fa6eff56c6b83c031c575fd9a6  gcc/testsuite/ada/acats-3/tests/cxa/cxa4008.a
! d2a3c398ae82b68c1544dbf3384095d7  gcc/testsuite/ada/acats-3/tests/cxa/cxa4009.a
! bc90a16063bf97bfeb414d4209261109  gcc/testsuite/ada/acats-3/tests/cxa/cxa4010.a
! b3036ab386ac3ec1d7b58cd50ad31ab9  gcc/testsuite/ada/acats-3/tests/cxa/cxa4011.a
! 06c61ebbffe294301eb79bc3d5e27c54  gcc/testsuite/ada/acats-3/tests/cxa/cxa4012.a
! ce3338d13ed9dd0ef83c04e53bed831e  gcc/testsuite/ada/acats-3/tests/cxa/cxa4013.a
! 0a9e62befb3d93c2c5e8ab93a327a6c2  gcc/testsuite/ada/acats-3/tests/cxa/cxa4014.a
! aad5ca617d2e40d20e448b613199553e  gcc/testsuite/ada/acats-3/tests/cxa/cxa4015.a
! 33c5aafe5935daee003a8246d048e812  gcc/testsuite/ada/acats-3/tests/cxa/cxa4016.a
! d2ac40847abc81d20163d7c521a90575  gcc/testsuite/ada/acats-3/tests/cxa/cxa4017.a
! 81384a047e321f48d7a9ae881a426324  gcc/testsuite/ada/acats-3/tests/cxa/cxa4018.a
! 334665c1cb55150c5c9af5013690044a  gcc/testsuite/ada/acats-3/tests/cxa/cxa4019.a
! c1bd4452ee22a8a6db5adbef47a641cc  gcc/testsuite/ada/acats-3/tests/cxa/cxa4020.a
! a570e64728464b5d7b98abf94a52b945  gcc/testsuite/ada/acats-3/tests/cxa/cxa4021.a
! ee35d8c6a0354f56770dd1aaf5f4d51e  gcc/testsuite/ada/acats-3/tests/cxa/cxa4022.a
! fc34d10875377b841a1d6172f334da36  gcc/testsuite/ada/acats-3/tests/cxa/cxa4023.a
! 19ec3ce920759c4a2037b89ae3061013  gcc/testsuite/ada/acats-3/tests/cxa/cxa4024.a
! 84b1823c491f3357731a977527457acf  gcc/testsuite/ada/acats-3/tests/cxa/cxa4025.a
! 254627e35c72d32a51b7db3824a622ea  gcc/testsuite/ada/acats-3/tests/cxa/cxa4026.a
! 0c20a4e5aa53f054deaa7ca01817db03  gcc/testsuite/ada/acats-3/tests/cxa/cxa4027.a
! 59f1d44db17d4f8454b983fa7c7b830b  gcc/testsuite/ada/acats-3/tests/cxa/cxa4028.a
! a05e073a2fe4ee6230e2a03d167ffce8  gcc/testsuite/ada/acats-3/tests/cxa/cxa4029.a
! eeef22827a8f3112fb9caff03c0003d3  gcc/testsuite/ada/acats-3/tests/cxa/cxa4030.a
! bb02ecad7593f15476885383704962db  gcc/testsuite/ada/acats-3/tests/cxa/cxa4031.a
! e272d6fb88a469d5600466803e241311  gcc/testsuite/ada/acats-3/tests/cxa/cxa4032.a
! 3f7248dd7e0876538e54ffc83eb5b9f9  gcc/testsuite/ada/acats-3/tests/cxa/cxa4033.a
! 90cfac79483d313e3e60ee66dd47bbb9  gcc/testsuite/ada/acats-3/tests/cxa/cxa4034.a
! 5cc03d6967386c435776ef6c5916d72c  gcc/testsuite/ada/acats-3/tests/cxa/cxa4037.a
! d5b5e8186c886aee7a112ba901ef5b8c  gcc/testsuite/ada/acats-3/tests/cxa/cxa5011.a
! a67372b949970924bc0a9dd48dfc4999  gcc/testsuite/ada/acats-3/tests/cxa/cxa5012.a
! 1bc3b7995dbf8b972dd33ceccc5775f8  gcc/testsuite/ada/acats-3/tests/cxa/cxa5013.a
! 7f31584ea86307c534d43e91b8d28708  gcc/testsuite/ada/acats-3/tests/cxa/cxa5015.a
! b236bc272cd2178596f9c2ee66be6978  gcc/testsuite/ada/acats-3/tests/cxa/cxa5016.a
! ee786104570339c108786248363e8be5  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a01.a
! 59b52d99d8ad7539d9702fd5808604ab  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a02.a
! e58abfcc53f4c016f65e49a2e76c7c18  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a03.a
! 07803a06f2f6d9efa364537c4d61d56c  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a04.a
! 8beb99d4b6c77de021e0fb13ef712afc  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a05.a
! 4facff6e7577e863bfd71cfc8d80f4dc  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a06.a
! c3a4baf4aa21b446ccc93a6c7667de6a  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a07.a
! 6278088ddb4cadb7d9e5d09b9045b4b6  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a08.a
! cd7c58666aed347e740c0f6fd42f83d6  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a09.a
! ba78679b1a563e67c0076c1562ccf0f3  gcc/testsuite/ada/acats-3/tests/cxa/cxa5a10.a
! 96b76cdb631cda2774fc81007f5ec5ee  gcc/testsuite/ada/acats-3/tests/cxa/cxa8001.a
! 367d7f0f5e6305bdd87092066759b0fa  gcc/testsuite/ada/acats-3/tests/cxa/cxa8002.a
! 620e6506d3b188143f95bf7e9e7c2a47  gcc/testsuite/ada/acats-3/tests/cxa/cxa8003.a
! 05afd117ada97a293f198e2915e5c6e6  gcc/testsuite/ada/acats-3/tests/cxa/cxa9001.a
! 720f2be5a9704866c7199912ce177ec5  gcc/testsuite/ada/acats-3/tests/cxa/cxa9002.a
! 0eda7d556ffc97096e8bf91c74b55ab0  gcc/testsuite/ada/acats-3/tests/cxa/cxaa001.a
! 77f8a73011b66fb0023f0f34e63b2b56  gcc/testsuite/ada/acats-3/tests/cxa/cxaa002.a
! 6251cdd5d4023378cc0f056006946d4b  gcc/testsuite/ada/acats-3/tests/cxa/cxaa003.a
! 43c30533c4d806156e62989d0b1f26b1  gcc/testsuite/ada/acats-3/tests/cxa/cxaa004.a
! a3c49183a05e7dd95a555b795d847cdb  gcc/testsuite/ada/acats-3/tests/cxa/cxaa005.a
! 083ebde448b287604a204632257a8037  gcc/testsuite/ada/acats-3/tests/cxa/cxaa006.a
! 0ba729490f0276e661094749d283895c  gcc/testsuite/ada/acats-3/tests/cxa/cxaa007.a
! a5ce4e509ce0ab296bcdd6ac1f1901c4  gcc/testsuite/ada/acats-3/tests/cxa/cxaa008.a
! 6230c5c5911d68e5e9b6f01dd03cb063  gcc/testsuite/ada/acats-3/tests/cxa/cxaa009.a
! ce752fa717d1efa1292cf1f5fa1d3e2e  gcc/testsuite/ada/acats-3/tests/cxa/cxaa010.a
! a1b9e04009fe651e52c78ec25d1e7e02  gcc/testsuite/ada/acats-3/tests/cxa/cxaa011.a
! 89d82c447c9f9e46ab8b9a1c63021ed6  gcc/testsuite/ada/acats-3/tests/cxa/cxaa012.a
! 1f2db7b6b53cd6eac4580863a696a7fd  gcc/testsuite/ada/acats-3/tests/cxa/cxaa013.a
! 2bf5156bd9e88fa709d6514444235132  gcc/testsuite/ada/acats-3/tests/cxa/cxaa014.a
! ed6390551c08d72768b222a3edb8cc65  gcc/testsuite/ada/acats-3/tests/cxa/cxaa015.a
! 9b3e529f8cb7b3fd77f82dd49f82a490  gcc/testsuite/ada/acats-3/tests/cxa/cxaa016.a
! 7147f809c3aae79cfac85e734afed9c2  gcc/testsuite/ada/acats-3/tests/cxa/cxaa017.a
! cc1a3cfdd0d446ad5ae2882d5b1f089b  gcc/testsuite/ada/acats-3/tests/cxa/cxaa018.a
! 5a18624d0b2a25da41748146d45600fe  gcc/testsuite/ada/acats-3/tests/cxa/cxaa019.a
! c8ddb9f66c45bca19e451105a1928554  gcc/testsuite/ada/acats-3/tests/cxa/cxaa020.a
! f1700da5096991db07a95ff30f3e800c  gcc/testsuite/ada/acats-3/tests/cxa/cxaa021.a
! 9cf4b832ba930927ff60624e142141b5  gcc/testsuite/ada/acats-3/tests/cxa/cxaa022.a
! 541118f0faae1cc95a1d90526336b620  gcc/testsuite/ada/acats-3/tests/cxa/cxab001.a
! 1330583d0850bb9322928bc49ee307ba  gcc/testsuite/ada/acats-3/tests/cxa/cxab002.au
! 021c3dc06125a2acf83a2c1228022556  gcc/testsuite/ada/acats-3/tests/cxa/cxab003.au
! 08db41fcbeb1f4972a7c86837062b2b0  gcc/testsuite/ada/acats-3/tests/cxa/cxab004.au
! d3528db6190a39ace75489425aefe80e  gcc/testsuite/ada/acats-3/tests/cxa/cxab005.au
! 02e50f3257e2da0b2d211b9ed3e16791  gcc/testsuite/ada/acats-3/tests/cxa/cxac001.a
! 6788fdbde2fdac4a827fd20b38d8711b  gcc/testsuite/ada/acats-3/tests/cxa/cxac002.a
! bc2d4997d303b5a8cd8ac49ea128eabc  gcc/testsuite/ada/acats-3/tests/cxa/cxac003.a
! 0fed3fbdda367e73cc20e053e436b99f  gcc/testsuite/ada/acats-3/tests/cxa/cxac004.a
! c03fcfa6083accd85e20bd1ddecb7e8e  gcc/testsuite/ada/acats-3/tests/cxa/cxac005.a
! 568387fb48e42420dfca3f910e0f3bab  gcc/testsuite/ada/acats-3/tests/cxa/cxac006.a
! a2862d6559ce75bcd1f2978950a518f3  gcc/testsuite/ada/acats-3/tests/cxa/cxac008.a
! 1ea54203b702bc16f99a16da31812413  gcc/testsuite/ada/acats-3/tests/cxa/cxaca01.a
! 177daeac77a726a44c2f67d470718c26  gcc/testsuite/ada/acats-3/tests/cxa/cxaca02.a
! 56fc9878aa06e841c10ea2264f6970c0  gcc/testsuite/ada/acats-3/tests/cxa/cxacb01.a
! 66ac8f47c4a79c2e4c270e0af7e2e0ee  gcc/testsuite/ada/acats-3/tests/cxa/cxacb02.a
! 0709cbd75999d38ff1820f0252b56573  gcc/testsuite/ada/acats-3/tests/cxa/cxacc01.a
! e9b9a0663c6181302fffd99d8631f3de  gcc/testsuite/ada/acats-3/tests/cxa/cxaf001.a
! 3dbc8fe284e967e1e119d7349aa6ec86  gcc/testsuite/ada/acats-3/tests/cxa/cxag001.a
! af20f1f87af0ee8b369035758ff9977a  gcc/testsuite/ada/acats-3/tests/cxa/cxah001.a
! d6c42faa0fd85d4e611808fb977548e4  gcc/testsuite/ada/acats-3/tests/cxa/cxah002.a
! eddef539e76282853ede56713c282716  gcc/testsuite/ada/acats-3/tests/cxa/cxai001.a
! 59511fc7e2dc5eb3d8eb002a41c75a43  gcc/testsuite/ada/acats-3/tests/cxa/cxai002.a
! 2b38ff98548380b587c97df99d39cd14  gcc/testsuite/ada/acats-3/tests/cxa/cxai003.a
! e14cd7fb5b01e29555e3f2a342911d0f  gcc/testsuite/ada/acats-3/tests/cxa/cxai004.a
! de9794abb22fa1f1f095eab53a98b24e  gcc/testsuite/ada/acats-3/tests/cxa/cxai005.a
! 39061bbc816101eda5d75c5f378fd466  gcc/testsuite/ada/acats-3/tests/cxa/cxai006.a
! 6965780bd73fe509452616af98cd38e7  gcc/testsuite/ada/acats-3/tests/cxa/cxaia01.a
! 396d67c5a15e19792a7751d8802f41c3  gcc/testsuite/ada/acats-3/tests/cxa/cxaia02.a
! de5424d724aeebab710236bd11dcf2df  gcc/testsuite/ada/acats-3/tests/cxa/cxaia03.a
! 68bccb5d3055fe7d7a23ccd9ea1fb764  gcc/testsuite/ada/acats-3/tests/cxa/cxaia04.a
! 4dc93038eb6ccea3feac2a6250d9c712  gcc/testsuite/ada/acats-3/tests/cxa/cxaia05.a
! 9338b200af7369b42225ad5ebbc5c607  gcc/testsuite/ada/acats-3/tests/cxa/cxaia06.a
! 74275581d2adcd2434f5e7957524b51c  gcc/testsuite/ada/acats-3/tests/cxb/cxb2001.a
! 801c8a35b2162f9c6264359249bbee69  gcc/testsuite/ada/acats-3/tests/cxb/cxb2002.a
! bf39b2f4f07ed6a4665a9dda2b002ff4  gcc/testsuite/ada/acats-3/tests/cxb/cxb2003.a
! 77c85b698809dbb5fb428e06a404c9b9  gcc/testsuite/ada/acats-3/tests/cxb/cxb3001.a
! 8359205e9055b8be1d9b6762d2ed3539  gcc/testsuite/ada/acats-3/tests/cxb/cxb3002.a
! 670fd9357c7c7cfa50297d22a291bf67  gcc/testsuite/ada/acats-3/tests/cxb/cxb3003.a
! 264fa1c95ae6b3be066613d5e0bfc39d  gcc/testsuite/ada/acats-3/tests/cxb/cxb30040.c
! 834af9fa57783899a0e35eb445000495  gcc/testsuite/ada/acats-3/tests/cxb/cxb30041.am
! 1f7e6c754cd6392302f6a73881265fcb  gcc/testsuite/ada/acats-3/tests/cxb/cxb3005.a
! 47cb358f8b5c39994c472ca6162c0605  gcc/testsuite/ada/acats-3/tests/cxb/cxb30060.c
! 99678670b618e59863715594383e5e7b  gcc/testsuite/ada/acats-3/tests/cxb/cxb30061.am
! 593282429f5462d5ed18dcd8dcdb51d9  gcc/testsuite/ada/acats-3/tests/cxb/cxb3007.a
! f846172da7dd713a885e8d2a7d06687e  gcc/testsuite/ada/acats-3/tests/cxb/cxb3008.a
! d2f1180bb38e13d62efbd9773c8b157b  gcc/testsuite/ada/acats-3/tests/cxb/cxb3009.a
! 02b32c32297cd44b0d911f2b531c9313  gcc/testsuite/ada/acats-3/tests/cxb/cxb3010.a
! f8edfe848dc0c6e6f48662c52fb4967d  gcc/testsuite/ada/acats-3/tests/cxb/cxb3011.a
! db1e20e804e48dbfe6be7dc72d92df77  gcc/testsuite/ada/acats-3/tests/cxb/cxb3012.a
! c26417c84de8dd0b5f98086031028262  gcc/testsuite/ada/acats-3/tests/cxb/cxb30130.c
! 0fb5e5e773d77b07187a80ff9a521df6  gcc/testsuite/ada/acats-3/tests/cxb/cxb30131.c
! f10ef865b96ee70575c8e209dd789a5d  gcc/testsuite/ada/acats-3/tests/cxb/cxb30132.am
! 1ddc4dd51346e5a28f96af27d7391476  gcc/testsuite/ada/acats-3/tests/cxb/cxb3014.a
! 95d8e46749c34da8a75a52eda38a1557  gcc/testsuite/ada/acats-3/tests/cxb/cxb3015.a
! 84585e09a73118e308ad940e05334954  gcc/testsuite/ada/acats-3/tests/cxb/cxb3016.a
! c90918450e648f7980e92c59c3503e79  gcc/testsuite/ada/acats-3/tests/cxb/cxb30170.c
! ea3b3c13a8bde93929e2fbaa2ee14049  gcc/testsuite/ada/acats-3/tests/cxb/cxb30171.a
! 0a60e22dbf627ad27674cdb4536971e5  gcc/testsuite/ada/acats-3/tests/cxb/cxb30172.am
! 24721abe35ae24f15b7aad5d08e6fd32  gcc/testsuite/ada/acats-3/tests/cxb/cxb30230.c
! d2017af833f745dbc8efda20765b9def  gcc/testsuite/ada/acats-3/tests/cxb/cxb30231.am
! cbb79c5b42e78b77403051dad62e4b41  gcc/testsuite/ada/acats-3/tests/cxb/cxb4001.a
! fc709f860964cb89f985c7186e9f4747  gcc/testsuite/ada/acats-3/tests/cxb/cxb4002.a
! 4f684915a0877f5374cf11b630a78395  gcc/testsuite/ada/acats-3/tests/cxb/cxb4003.a
! 79754fe98b14164c0947685d39cacbb4  gcc/testsuite/ada/acats-3/tests/cxb/cxb4004.a
! 85a2ebed857909a39d337814747d6b8e  gcc/testsuite/ada/acats-3/tests/cxb/cxb4005.a
! 4082371e3fdf72189f00c59a748996d4  gcc/testsuite/ada/acats-3/tests/cxb/cxb4006.a
! 27abdc5551e4a8d82b4e9b0c64e5887b  gcc/testsuite/ada/acats-3/tests/cxb/cxb4007.a
! 8cddd50c9a17f7fc8660e979cbf02b3b  gcc/testsuite/ada/acats-3/tests/cxb/cxb4008.a
! 1b69eacf17c1c91c6952280f3412de5a  gcc/testsuite/ada/acats-3/tests/cxb/cxb5001.a
! c09620903bb91a1bb4eb42d58e681d41  gcc/testsuite/ada/acats-3/tests/cxb/cxb5002.a
! d523751f359c8b2cd39c46362a810f62  gcc/testsuite/ada/acats-3/tests/cxb/cxb5003.a
! 161785b3f8117f52fdfa5e2be103fe50  gcc/testsuite/ada/acats-3/tests/cxf/cxf1001.a
! 38832640106024eeab3e787b3e1abf12  gcc/testsuite/ada/acats-3/tests/cxf/cxf2001.a
! 6dbe0dc7ad8bcf924dea296b0e6d64f8  gcc/testsuite/ada/acats-3/tests/cxf/cxf2002.a
! df30106f75773ccdd081af9128456937  gcc/testsuite/ada/acats-3/tests/cxf/cxf2003.a
! bbdc713b858e164ba488b05b51a426d4  gcc/testsuite/ada/acats-3/tests/cxf/cxf2004.a
! 2853070456ab778051ae45509ef31700  gcc/testsuite/ada/acats-3/tests/cxf/cxf2005.a
! 5289a83b801532cadb9cfc8ca574144c  gcc/testsuite/ada/acats-3/tests/cxf/cxf2a01.a
! ecb6f7270417d94e1c9636302e69e1fa  gcc/testsuite/ada/acats-3/tests/cxf/cxf2a02.a
! 2ffc00ccfb476a6822050bacce9f38f0  gcc/testsuite/ada/acats-3/tests/cxf/cxf3001.a
! 5dae288354cb87431755a88817dd365b  gcc/testsuite/ada/acats-3/tests/cxf/cxf3002.a
! afd49d16a5d04aec633505dca48b0d0a  gcc/testsuite/ada/acats-3/tests/cxf/cxf3003.a
! c6b3622a1e5b20d69719852a4082e8be  gcc/testsuite/ada/acats-3/tests/cxf/cxf3004.a
! 1aee0d4b0a06b7063d6235fc8d34096a  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a01.a
! 57064f6f477f169e4e55de947a9c929c  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a02.a
! 963266d142d788cf27f6a6c25463a3e4  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a03.a
! b0edb7a9a3f96101a217a11d890227d0  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a04.a
! fc92aa9ac0df0e5baa30ead02d831b57  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a05.a
! 64a24769c1369c7cfdee0cd6e259be8f  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a06.a
! 9713b92f0463d1404ffce0f6b1e500b0  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a07.a
! 1e8c052576f82ce44e874eaf39b880b2  gcc/testsuite/ada/acats-3/tests/cxf/cxf3a08.a
! bb528e8b6f5a51fcb2c85de76f01ccd4  gcc/testsuite/ada/acats-3/tests/cxg/cxg1001.a
! 31d84efce5cb86f288a534683e15200a  gcc/testsuite/ada/acats-3/tests/cxg/cxg1002.a
! 5db4d9e6a4cf0ee61e3e4e4ea8093c4e  gcc/testsuite/ada/acats-3/tests/cxg/cxg1003.a
! 29704ab7c7c7a79f47511599cd5ea610  gcc/testsuite/ada/acats-3/tests/cxg/cxg1004.a
! 38c19bd2b8b49892b5a8468c5b781d26  gcc/testsuite/ada/acats-3/tests/cxg/cxg1005.a
! cf1886805bf7bef0f8693b1061462c39  gcc/testsuite/ada/acats-3/tests/cxg/cxg2001.a
! 691b89d2d22e78fce3d8ce8190aceac5  gcc/testsuite/ada/acats-3/tests/cxg/cxg2002.a
! fd15930c996abc004ebe5f623f8d7e3e  gcc/testsuite/ada/acats-3/tests/cxg/cxg2003.a
! 9c7ebf167f5adb4ad817f1cfaad15b1e  gcc/testsuite/ada/acats-3/tests/cxg/cxg2004.a
! 19538696a45a5cd61915e552c0159e21  gcc/testsuite/ada/acats-3/tests/cxg/cxg2005.a
! b5a9cd918ec505f80bffd4b8d3f81fb7  gcc/testsuite/ada/acats-3/tests/cxg/cxg2006.a
! d118b202244475fa2d6637a5102c8793  gcc/testsuite/ada/acats-3/tests/cxg/cxg2007.a
! 911e82a1ca3377a813732860a0062312  gcc/testsuite/ada/acats-3/tests/cxg/cxg2008.a
! 4fad0b52dda14d215336cc1cd38b7f03  gcc/testsuite/ada/acats-3/tests/cxg/cxg2009.a
! a7f0790bd1f4db62bb1f94f90b403cca  gcc/testsuite/ada/acats-3/tests/cxg/cxg2010.a
! 2e25178ea5e5552c5343ba6d8584ba74  gcc/testsuite/ada/acats-3/tests/cxg/cxg2011.a
! f61b0c35864b0aa5527d3e4a3e81e779  gcc/testsuite/ada/acats-3/tests/cxg/cxg2012.a
! 1b99769a37ef9c2b58f43910fdd00e6b  gcc/testsuite/ada/acats-3/tests/cxg/cxg2013.a
! 481025f4913d9ffb0c1ff442b9870591  gcc/testsuite/ada/acats-3/tests/cxg/cxg2014.a
! 79eb7ca23122446b9f31a5f4d6f8fbc7  gcc/testsuite/ada/acats-3/tests/cxg/cxg2015.a
! d1362a6e008edbda6db26e148303f3d0  gcc/testsuite/ada/acats-3/tests/cxg/cxg2016.a
! 84a228b85aa2b3a442a702cb5cf99e63  gcc/testsuite/ada/acats-3/tests/cxg/cxg2017.a
! db5d4af0d0f84dcaf031081f41020e4a  gcc/testsuite/ada/acats-3/tests/cxg/cxg2018.a
! 6ca3da628f7936107fe1fd235da62e61  gcc/testsuite/ada/acats-3/tests/cxg/cxg2019.a
! d8efe67bfdf82292c98f593e60cace57  gcc/testsuite/ada/acats-3/tests/cxg/cxg2020.a
! 53b94c96558a199ee91e9e94e92f6e6e  gcc/testsuite/ada/acats-3/tests/cxg/cxg2021.a
! 44df5fa53bb68ac9be22c5db9adb9c5e  gcc/testsuite/ada/acats-3/tests/cxg/cxg2022.a
! 86432328beb230d12c30455a5259108f  gcc/testsuite/ada/acats-3/tests/cxg/cxg2023.a
! 7b9353c95978924cfa8ffca95bd2472f  gcc/testsuite/ada/acats-3/tests/cxg/cxg2024.a
! 4aedd99c5e7383826785e110132437b0  gcc/testsuite/ada/acats-3/tests/cxh/cxh3001.a
! 30e3860e9003591085363de238d2c0f8  gcc/testsuite/ada/acats-3/tests/cxh/cxh3002.a
! 2f97ad7e05c98ee16642183b60fb702b  gcc/testsuite/ada/acats-3/tests/cxh/cxh30030.a
! 726c3a5559867c336b3e41053357bee8  gcc/testsuite/ada/acats-3/tests/cxh/cxh30031.am
! 5812c7613bb171e922984de8ed304306  gcc/testsuite/ada/acats-3/tests/cz/cz1101a.ada
! f4be18c06fbff775151b0c6fe4f18831  gcc/testsuite/ada/acats-3/tests/cz/cz1102a.ada
! 1a17d44787330941af6e6eb9b2f5fdac  gcc/testsuite/ada/acats-3/tests/cz/cz1103a.ada
! 4fbac816abd03239d980e03cee911122  gcc/testsuite/ada/acats-3/tests/d/d4a002a.ada
! 9fc88c362bc5e3ac1038838ce2e31e1d  gcc/testsuite/ada/acats-3/tests/d/d4a002b.ada
! 512d36027df5b67cad136178dabfe4a2  gcc/testsuite/ada/acats-3/tests/d/d4a004a.ada
! 22af18afdcf3a383d8100e7290a1c40c  gcc/testsuite/ada/acats-3/tests/d/d4a004b.ada
! 605dc6f15a51dd750ab6fdf7ddcb65a6  gcc/testsuite/ada/acats-3/tests/e/e28002b.ada
! de9f0ecd5c9bafad769c8b2264e38499  gcc/testsuite/ada/acats-3/tests/e/e28005d.ada
! 3cacc87e4376898f97bc3ad35305e3b0  gcc/testsuite/ada/acats-3/tests/e/e52103y.ada
! c92c30f9076000218a22d41126403c34  gcc/testsuite/ada/acats-3/tests/e/eb4011a.ada
! deba1575fb8b252064041e5d408f53a3  gcc/testsuite/ada/acats-3/tests/e/eb4012a.ada
! 08131f4b11da03c32ca002338f3e4a59  gcc/testsuite/ada/acats-3/tests/e/eb4014a.ada
! b8a8e5440cbe69d0ad54064892a114c0  gcc/testsuite/ada/acats-3/tests/e/ee3203a.ada
! 48040471bf50b07840b3338c9bc7e2c6  gcc/testsuite/ada/acats-3/tests/e/ee3204a.ada
! 25bff343477de94bd78239442f9ee02a  gcc/testsuite/ada/acats-3/tests/e/ee3402b.ada
! b057daa29f3fcc66f6affebff75a1be5  gcc/testsuite/ada/acats-3/tests/e/ee3409f.ada
! 4c52e7caa9bc136f2cba824b2e52e9c6  gcc/testsuite/ada/acats-3/tests/e/ee3412c.ada
! 76344ab690464f293f3d4ea9ddafa233  gcc/testsuite/ada/acats-3/tests/l/la140010.a
! 2900850ee7d28fb09a708d15ecb120e8  gcc/testsuite/ada/acats-3/tests/l/la140011.am
! 3a566254bd6b5a2476b7a0a4d201c6ec  gcc/testsuite/ada/acats-3/tests/l/la140012.a
! f251861d8f7143c4d6a0139eb5109844  gcc/testsuite/ada/acats-3/tests/l/la140020.a
! 94e3a842d07a1b065bf9729ba53ec9fd  gcc/testsuite/ada/acats-3/tests/l/la140021.am
! 951f84109a5b6658e7dd287bbd9bae71  gcc/testsuite/ada/acats-3/tests/l/la140022.a
! 876db830d93e5c9744a1c290ed00f17f  gcc/testsuite/ada/acats-3/tests/l/la140030.a
! eaefd12663189709da8ccf17c2c368fa  gcc/testsuite/ada/acats-3/tests/l/la140031.a
! 7bf8660d1ec101205c05dd17726a229a  gcc/testsuite/ada/acats-3/tests/l/la140032.am
! 857f64e53ab5de64c7aff62222d11127  gcc/testsuite/ada/acats-3/tests/l/la140033.a
! 92ca699ccd2c74842385086d5ada22dd  gcc/testsuite/ada/acats-3/tests/l/la140040.a
! 8b2c5cc4a29ad35fcfa826d7b492bc08  gcc/testsuite/ada/acats-3/tests/l/la140041.am
! fb8dd82cf673301eecabc122ac171090  gcc/testsuite/ada/acats-3/tests/l/la140042.a
! 6d5ee36b10609c888874ac66e3f0ee1e  gcc/testsuite/ada/acats-3/tests/l/la140050.a
! e04923836f3f4282a67d6f89778a6914  gcc/testsuite/ada/acats-3/tests/l/la140051.a
! bfa5a2187576b86f14423c0040742843  gcc/testsuite/ada/acats-3/tests/l/la140052.am
! 0d6624b67d8552559b64873f684e581d  gcc/testsuite/ada/acats-3/tests/l/la140053.a
! 8035d0c6bfa2f3b3a49f58acd52dd8a7  gcc/testsuite/ada/acats-3/tests/l/la140060.a
! 3d90461eff6991fd8178d6d2118e9ddf  gcc/testsuite/ada/acats-3/tests/l/la140061.a
! e475cc528675aeae58edde764f9dd718  gcc/testsuite/ada/acats-3/tests/l/la140062.am
! f022f8aa1d30fb70ecca6f610089b986  gcc/testsuite/ada/acats-3/tests/l/la140063.a
! c3833b353f97382d992824760c162c7c  gcc/testsuite/ada/acats-3/tests/l/la140070.a
! c0ccfb9014a2864c4a49d88f46f491c1  gcc/testsuite/ada/acats-3/tests/l/la140071.a
! 509bb3bfec998a7f16d7a711f508bdc0  gcc/testsuite/ada/acats-3/tests/l/la140072.am
! 4710fc41166460cc60192a57798054b4  gcc/testsuite/ada/acats-3/tests/l/la140073.a
! dcb4f9c9fdad375c3fe93310ac6b816e  gcc/testsuite/ada/acats-3/tests/l/la140080.a
! a3acb845f1ea8cd193aec71beb1ead51  gcc/testsuite/ada/acats-3/tests/l/la140081.a
! d8f09cb05605e6ee39a41685ba970092  gcc/testsuite/ada/acats-3/tests/l/la140082.am
! 6d37a12249cd1b2bdf860f7651a462e4  gcc/testsuite/ada/acats-3/tests/l/la140083.a
! 46655b2b4b88ca82cb0afc6eac22cd7b  gcc/testsuite/ada/acats-3/tests/l/la140090.a
! 257622cc1c6c259921d7e6c33e23f1ff  gcc/testsuite/ada/acats-3/tests/l/la140091.a
! 1c00169793ce024a3f35da791e30bbe6  gcc/testsuite/ada/acats-3/tests/l/la140092.am
! 6a23c4b62a4cac8720e8b7c21ad97d5b  gcc/testsuite/ada/acats-3/tests/l/la140093.a
! ed2026e1ace460e994b96b42c8f05e9c  gcc/testsuite/ada/acats-3/tests/l/la140100.a
! 55167329c290c62025473120fca26c7d  gcc/testsuite/ada/acats-3/tests/l/la140101.a
! 9280256db41c4bec0f36aa69ff060841  gcc/testsuite/ada/acats-3/tests/l/la140102.am
! 7b092247e539009157e512965ba1fc7a  gcc/testsuite/ada/acats-3/tests/l/la140103.a
! 6722c5fc30bb307834268e434901c086  gcc/testsuite/ada/acats-3/tests/l/la140110.a
! 443c0bb26e2eb84889c83a9bccaf9649  gcc/testsuite/ada/acats-3/tests/l/la140111.a
! 47c6e7a9da351969b20b3d295bb3c115  gcc/testsuite/ada/acats-3/tests/l/la140112.am
! 4bf0921f6ccd99db94a8a70d2b166fdf  gcc/testsuite/ada/acats-3/tests/l/la140113.a
! 5c9a0f9992d6d21844e2ba208b7cebbc  gcc/testsuite/ada/acats-3/tests/l/la140120.a
! 7c0ca86bca64632e57e32b5842ddbe60  gcc/testsuite/ada/acats-3/tests/l/la140121.a
! 211c1d44471b6a40c3d807f83059ff77  gcc/testsuite/ada/acats-3/tests/l/la140122.am
! e4cb364e594a0d2463e66f4aa48a914a  gcc/testsuite/ada/acats-3/tests/l/la140123.a
! 76516f31e5adf9e0fad1886ab83457a4  gcc/testsuite/ada/acats-3/tests/l/la140130.a
! f3b7f597165821e514288274845f5e54  gcc/testsuite/ada/acats-3/tests/l/la140131.a
! cb0819afcaf9586c9c95966d2516fb65  gcc/testsuite/ada/acats-3/tests/l/la140132.am
! 32a943ea5a9287c709fa39655d8668cb  gcc/testsuite/ada/acats-3/tests/l/la140133.a
! 212943c674757076da046354450e5113  gcc/testsuite/ada/acats-3/tests/l/la140140.a
! 195b91195befb872c8f723da1d28f132  gcc/testsuite/ada/acats-3/tests/l/la140141.a
! a6d2954f197001069fb371e8403e8ac6  gcc/testsuite/ada/acats-3/tests/l/la140142.am
! 57ac76011ccf9054712e1b09ef71bfd9  gcc/testsuite/ada/acats-3/tests/l/la140143.a
! 7552c854bb4af3c4f87cfe6a7a861610  gcc/testsuite/ada/acats-3/tests/l/la140150.a
! 5f1dcc1a1c97c253b5809c49c2a326ad  gcc/testsuite/ada/acats-3/tests/l/la140151.a
! 662ea838e79bbec83ab42275c2111e2a  gcc/testsuite/ada/acats-3/tests/l/la140152.am
! c80afc3e35ad24a8bb25b5e3d67f2bcb  gcc/testsuite/ada/acats-3/tests/l/la140153.a
! ebc4ad53e17e21942e69ae80c5b47b77  gcc/testsuite/ada/acats-3/tests/l/la140160.a
! 117e1792c17a1e2b5ec04bba346f528d  gcc/testsuite/ada/acats-3/tests/l/la140161.a
! b7744773a1c753b7aa68c166866eb005  gcc/testsuite/ada/acats-3/tests/l/la140162.am
! 9852ca8047bc9e1bd578767b67254fd2  gcc/testsuite/ada/acats-3/tests/l/la140163.a
! f7f66fd9abfb1f4931428292cd1fe63d  gcc/testsuite/ada/acats-3/tests/l/la140170.a
! 2acaa1d866103405c81e05839bd25054  gcc/testsuite/ada/acats-3/tests/l/la140171.a
! ea5de64993880be50e047e540f521cec  gcc/testsuite/ada/acats-3/tests/l/la140172.am
! b3e16fff4bf97ee8001c7d4707b01ca8  gcc/testsuite/ada/acats-3/tests/l/la140173.a
! cef0b6dba566de9e4b3fdd8429f3b573  gcc/testsuite/ada/acats-3/tests/l/la140180.a
! 3a47eaaf81a03727243aa228f4301a60  gcc/testsuite/ada/acats-3/tests/l/la140181.a
! a5c23800bfa114aaa25ef21241ca0c43  gcc/testsuite/ada/acats-3/tests/l/la140182.am
! 831069dc37bbaa6d17e49ec411324925  gcc/testsuite/ada/acats-3/tests/l/la140183.a
! 9597131b3c0b103f6244907627fbf160  gcc/testsuite/ada/acats-3/tests/l/la140190.a
! 14063c6684e8dd6c14ea4d18badb550b  gcc/testsuite/ada/acats-3/tests/l/la140191.a
! 8cbcf00024bdf7530ae51ba8a1ca0bba  gcc/testsuite/ada/acats-3/tests/l/la140192.am
! 99e2d79f6f50d594ab2f3e503f2db441  gcc/testsuite/ada/acats-3/tests/l/la140193.a
! ea6d1fb3bdbfc0deaee617b126be28f4  gcc/testsuite/ada/acats-3/tests/l/la140200.a
! babcd4715ea4f023430dfbe1f896bde1  gcc/testsuite/ada/acats-3/tests/l/la140201.a
! 64279761de38aa82af4a5638c457c1bf  gcc/testsuite/ada/acats-3/tests/l/la140202.am
! 7e4b83d0d9265f463e87dcc9fcf0fe5b  gcc/testsuite/ada/acats-3/tests/l/la140203.a
! b12cced7adaecf2a93250e16cca98cf4  gcc/testsuite/ada/acats-3/tests/l/la140210.a
! 887401b5f446bce786751fa72e341292  gcc/testsuite/ada/acats-3/tests/l/la140211.am
! ab173d0eec0bb616f34f81aa48cd950c  gcc/testsuite/ada/acats-3/tests/l/la140212.a
! 594b0e8144190e578786dbc1bad844dc  gcc/testsuite/ada/acats-3/tests/l/la140220.a
! f842b35f8c01816efc84f4addd2f93b7  gcc/testsuite/ada/acats-3/tests/l/la140221.am
! 772553907cc4b151574b52a2b52dc90c  gcc/testsuite/ada/acats-3/tests/l/la140222.a
! b03871ce6d6f59a7e5a7612e6d89d596  gcc/testsuite/ada/acats-3/tests/l/la140240.a
! efe4e86bfb690c79c68494f323cac801  gcc/testsuite/ada/acats-3/tests/l/la140241.a
! 30f55b3747e6fa1b9ef0af765a76ce5a  gcc/testsuite/ada/acats-3/tests/l/la140242.am
! f95f7a3f483abd92a9bf92b6dc469986  gcc/testsuite/ada/acats-3/tests/l/la140243.a
! 2db8317b47f3ab8bb9a0f5469169d027  gcc/testsuite/ada/acats-3/tests/l/la140250.a
! 938965a24a1e6eb44e817ef6a6bcef36  gcc/testsuite/ada/acats-3/tests/l/la140251.am
! b3d2bc446e9f8766852585be1a71c541  gcc/testsuite/ada/acats-3/tests/l/la140252.a
! ced69a105f582142776937381fb4ac18  gcc/testsuite/ada/acats-3/tests/l/la140260.a
! ff927baa2a1a94e581616deb8f88d900  gcc/testsuite/ada/acats-3/tests/l/la140261.a
! 666740bbcb573799ed4bbd92b8380bac  gcc/testsuite/ada/acats-3/tests/l/la140262.am
! 2a7b7e46c9fcf98d59cf645dd8488895  gcc/testsuite/ada/acats-3/tests/l/la140263.a
! b886a43ab960ee3b74b75b1a1895e692  gcc/testsuite/ada/acats-3/tests/l/la140270.a
! 2f50ecd2b64eb3a3cefb0066c4c043a1  gcc/testsuite/ada/acats-3/tests/l/la140271.a
! 004386b31584ba3e3f7171f7674e4137  gcc/testsuite/ada/acats-3/tests/l/la140272.am
! 9c63871113de9b518e90c90fe8e20f28  gcc/testsuite/ada/acats-3/tests/l/la140273.a
! 4004844198395fe50ecb798ed5d30f4b  gcc/testsuite/ada/acats-4/elabd.lst
! b32871a59b0c07cb4eda259b98fa6aab  gcc/testsuite/ada/acats-4/floatstore.lst
! bb4e4f9d3c0e72730e0bf397d375689c  gcc/testsuite/ada/acats-4/norun.lst
! 1485f263dfb9303b015015ae88161a8b  gcc/testsuite/ada/acats-4/run_acats.sh
! b442a8a57d22fdedfc161e3cc2ae4cff  gcc/testsuite/ada/acats-4/run_all.sh
! 6467abb463602aeb04583b3822f653f4  gcc/testsuite/ada/acats-4/run_test.exp
! 5723a26fced8721c3e90e6e7a9ba2a23  gcc/testsuite/ada/acats-4/stackcheck.lst
! 3ed91c67e7b16c7449a06f626b2b0457  gcc/testsuite/ada/acats-4/support/acats42.lst
! 2f262cdb98b38922d7b7f84414f43b84  gcc/testsuite/ada/acats-4/support/checkfil.ada
! 4edf20410814582eae331707f2ae2c77  gcc/testsuite/ada/acats-4/support/enumchek.ada
! 8f3ec4fe93c0095e34d79e9a41dde4e9  gcc/testsuite/ada/acats-4/support/f340a000.a
! b673a17611516bde0712458de61636e8  gcc/testsuite/ada/acats-4/support/f340a001.a
! b31158ceea90e5246f63aed8b0078e9c  gcc/testsuite/ada/acats-4/support/f341a00.a
! e5659e8b854d73fb80a7d1cb6c5d4925  gcc/testsuite/ada/acats-4/support/f350a00.a
! a3df0325fe284b799591144749e23c78  gcc/testsuite/ada/acats-4/support/f350b00.a
! 8cfe6ef1d589a43b75821a6abbee2ef0  gcc/testsuite/ada/acats-4/support/f360a00.a
! c4075cf1fc60a2a1ca99fb7d74c81ad4  gcc/testsuite/ada/acats-4/support/f360b00.a
! d3d954612d4f455a32df07aa05816320  gcc/testsuite/ada/acats-4/support/f390a00.a
! ed3b5aee8f81d147785adce6b48411cd  gcc/testsuite/ada/acats-4/support/f392a00.a
! 7973b64953275c03e790967bc310010c  gcc/testsuite/ada/acats-4/support/f392c00.a
! 7b5b9e45fb9003af0e096ca36327031e  gcc/testsuite/ada/acats-4/support/f392d00.a
! e4733abdf62c401a876d29c3e5a38c34  gcc/testsuite/ada/acats-4/support/f393a00.a
! c1487dd34771abf18d1144c610fac26e  gcc/testsuite/ada/acats-4/support/f393b00.a
! 62e2d5487aada0ccc1744ab3475cf281  gcc/testsuite/ada/acats-4/support/f394a00.a
! a42dca590b0bfdb848b97329f6d46360  gcc/testsuite/ada/acats-4/support/f3a1a00.a
! b3e35321e808d9e061d1fdef51813016  gcc/testsuite/ada/acats-4/support/f3a2a00.a
! c78e6b8793894afe2644c0ea96672ace  gcc/testsuite/ada/acats-4/support/f416a00.a
! 9cc366af74ec7e926f044bb5155d06ae  gcc/testsuite/ada/acats-4/support/f431a00.a
! c528a968af853505c447f20a88480156  gcc/testsuite/ada/acats-4/support/f433a00.a
! 8272f7274c301332200c1e04a0c1974c  gcc/testsuite/ada/acats-4/support/f452a00.a
! a69fe4858da0afd4136e4c58cd08134e  gcc/testsuite/ada/acats-4/support/f458a00.a
! 798afd3c6228223e07e7c8e3034eb99c  gcc/testsuite/ada/acats-4/support/f460a00.a
! 773d36ae846235e9ee581e0ad2e0f314  gcc/testsuite/ada/acats-4/support/f552a00.a
! 1cfbd2728319bc134c13c90931027a2f  gcc/testsuite/ada/acats-4/support/f611a00.a
! 9f88e134c5d430bcff7b1c4ccc2e4385  gcc/testsuite/ada/acats-4/support/f611b00.a
! d6989b796158be297223806b657f2d4a  gcc/testsuite/ada/acats-4/support/f650a00.a
! bb61b3646b6fffb3baec5749d8cef429  gcc/testsuite/ada/acats-4/support/f650b00.a
! 316c7cde49ee557a67d39d6b63407811  gcc/testsuite/ada/acats-4/support/f730a000.a
! 60edd601c25022d0f19b8c45d3d187bb  gcc/testsuite/ada/acats-4/support/f730a001.a
! 75b2405f0dd739649bda9b92b0d259f4  gcc/testsuite/ada/acats-4/support/f731a00.a
! ccd8e3c3faf25144fe3c561334b303bf  gcc/testsuite/ada/acats-4/support/f732a00.a
! d41b64f601f2f2eeea39391ec09222d9  gcc/testsuite/ada/acats-4/support/f732b00.a
! 7eb08f416a9cfaf82252b8c55ed28a98  gcc/testsuite/ada/acats-4/support/f732c00.a
! f12fe4ead9a2039676b4c2ad03e2a7c7  gcc/testsuite/ada/acats-4/support/f750a00.a
! bbcbe0173cb32d75903f9a81bf5c4060  gcc/testsuite/ada/acats-4/support/f760a00.a
! 689c49d9ccb5124d47eecb1dcebcc376  gcc/testsuite/ada/acats-4/support/f940a00.a
! d08e91b98a54c3d471108a6631714033  gcc/testsuite/ada/acats-4/support/f954a00.a
! f95be63eadf08e7cafbeb33a6794c019  gcc/testsuite/ada/acats-4/support/fa11a00.a
! 28be0e2126b177ff6d34df7c272a9f2c  gcc/testsuite/ada/acats-4/support/fa11b00.a
! 2228808bf25eecbd9e02ff343e2dba54  gcc/testsuite/ada/acats-4/support/fa11c00.a
! 1cb03e4473720d064b6798cf5e185f62  gcc/testsuite/ada/acats-4/support/fa11d00.a
! ff082a3957be5f526713103bf563e5be  gcc/testsuite/ada/acats-4/support/fa13a00.a
! dfa6bb61642b6c22f17171fb93cfc97c  gcc/testsuite/ada/acats-4/support/fa13b00.a
! b1766ae4ae2012673c7e0c848a4c105e  gcc/testsuite/ada/acats-4/support/fa21a00.a
! 97d3fd68d030a5d89e98b950d557151d  gcc/testsuite/ada/acats-4/support/fb20a00.a
! 886f3ad8c51e9e1e01cb7d4ab0b3f47e  gcc/testsuite/ada/acats-4/support/fb40a00.a
! 045b4b77241122260c9b42a0a85941b8  gcc/testsuite/ada/acats-4/support/fc50a00.a
! d2c427a2c2e845d2d5991d7e86689284  gcc/testsuite/ada/acats-4/support/fc51a00.a
! 18eee0e1727cb58b8ca0da52a8f7fbd0  gcc/testsuite/ada/acats-4/support/fc51b00.a
! 707c153d9868ec6e694e8db161e9a7c7  gcc/testsuite/ada/acats-4/support/fc51c00.a
! 981a728516c5de4f242cff81d35a1806  gcc/testsuite/ada/acats-4/support/fc51d00.a
! 992e25818babbd2519c54f2dc5987601  gcc/testsuite/ada/acats-4/support/fc54a00.a
! f75e17c909e83e1879e87a3ba3ffd7cc  gcc/testsuite/ada/acats-4/support/fc70a00.a
! cdb7ee32751757a29e821ba020228a0e  gcc/testsuite/ada/acats-4/support/fc70b00.a
! 8af79a6be55981313da73bc0bb01f617  gcc/testsuite/ada/acats-4/support/fc70c00.a
! 65011f4705018476715af62324c335b3  gcc/testsuite/ada/acats-4/support/fcndecl.ada
! 3ce3384936274aa48a8c4a38fa7109ac  gcc/testsuite/ada/acats-4/support/fd72a00.a
! 5c9a93b4c9f45c15707e4b3b123aee9c  gcc/testsuite/ada/acats-4/support/fdb0a00.a
! eade5334073c90ba1cd88d24e19e32a4  gcc/testsuite/ada/acats-4/support/fdb3a00.a
! bf9c7650a6f8303b6a69ff5eb2660b15  gcc/testsuite/ada/acats-4/support/fdd2a00.a
! 66196b3c77238fb8c27dd10465e97042  gcc/testsuite/ada/acats-4/support/fdd2b00.a
! a77ebc244676daacb1f3a61ae8003e88  gcc/testsuite/ada/acats-4/support/fxa5a00.a
! f4e9649e424fa9578180b9aee65c8e96  gcc/testsuite/ada/acats-4/support/fxaca00.a
! caa75442e4dceed0740dfa35a47b5bb6  gcc/testsuite/ada/acats-4/support/fxacb00.a
! 1855abc6c615b76aa82fb9241571f3d8  gcc/testsuite/ada/acats-4/support/fxacc00.a
! 1c5af3fa6abb70600f002448cbb84798  gcc/testsuite/ada/acats-4/support/fxaia00.a
! 65d5687fc491244cba19146100918127  gcc/testsuite/ada/acats-4/support/fxaib00.a
! f88af2b3eb53ad7c8700efbd0f878915  gcc/testsuite/ada/acats-4/support/fxc6a00.a
! 56ba35dd56ea544c0eb9146769871492  gcc/testsuite/ada/acats-4/support/fxe2a00.a
! 67770e9161b0f48f3fc9392bd3460272  gcc/testsuite/ada/acats-4/support/fxf2a00.a
! 6628969f51dd10c56235f9d7420e2d44  gcc/testsuite/ada/acats-4/support/fxf3a00.a
! 5df9d30ae1696936a050aa76a1791d83  gcc/testsuite/ada/acats-4/support/grade.a
! 3115c4d4fcb7b14e7241219066907a9c  gcc/testsuite/ada/acats-4/support/grd_data.a
! 6a9b6ce90538e9126e7e5badc62ddca2  gcc/testsuite/ada/acats-4/support/impbit.adb
! 161d9fabed753ac0882cff4287914745  gcc/testsuite/ada/acats-4/support/impdef.a
! 1df1ecb1a1f6d4af019216884e3504ef  gcc/testsuite/ada/acats-4/support/impdefc.a
! 4f2f9bfdfcfd8c5ecaf503416d1cfc5f  gcc/testsuite/ada/acats-4/support/impdefd.a
! edf70d423a69adebd38e9b29f35a2ba1  gcc/testsuite/ada/acats-4/support/impdefe.a
! cadfd8a5487a315a6fbd8eef397219e9  gcc/testsuite/ada/acats-4/support/impdefg.a
! 5d9a0f98d9f15211e0773263febb974b  gcc/testsuite/ada/acats-4/support/impdefh.a
! f2604ccc5244696793b33e7b83c57c45  gcc/testsuite/ada/acats-4/support/lencheck.ada
! 79c0994222b2a5fc702eb4bc3dc1ba8e  gcc/testsuite/ada/acats-4/support/macro.dfs
! 72980ae1a3bbd5b71aa915cefeaebf6e  gcc/testsuite/ada/acats-4/support/macrodef.adb
! 4d7b79a3ff077d1ab05a78ebcf5a1de3  gcc/testsuite/ada/acats-4/support/macrosub.ada
! 8cb717a6b9fc55d9e6318b49da956f52  gcc/testsuite/ada/acats-4/support/report.a
! 2b5f4d4023fee6617354705898db933f  gcc/testsuite/ada/acats-4/support/special.a
! 356cf4b2e0cc1e02ef1deddb5567de36  gcc/testsuite/ada/acats-4/support/spprt13s.tst
! 080c7ff4fbd781f8b5ab3030e013661d  gcc/testsuite/ada/acats-4/support/summary.a
! ca9764a7f6a92b2d9bf8fe9ba55ff261  gcc/testsuite/ada/acats-4/support/tctouch.ada
! 4ef387cf65c4278a4f7aa2a7a4736d17  gcc/testsuite/ada/acats-4/support/trace.a
! 133b60ee1b2e82c2ee98457fa66f01fe  gcc/testsuite/ada/acats-4/support/tst_sum.a
! 26945b868319fda8b82f82c677a35562  gcc/testsuite/ada/acats-4/support/tsttests.dat
! 51179826b11327f0aa5f752b2bb4b780  gcc/testsuite/ada/acats-4/support/version.a
! dc179b8a7c506c961b229b7ec7d2de53  gcc/testsuite/ada/acats-4/tests/a/a22006b.ada
! f61ae49f8066de3ba349e39d3a688ea6  gcc/testsuite/ada/acats-4/tests/a/a22006c.ada
! 54e5a501bbefb19fdf7715f5741fc858  gcc/testsuite/ada/acats-4/tests/a/a22006d.ada
! 11394a122edd516a587d020bc9ce2e8e  gcc/testsuite/ada/acats-4/tests/a/a26007a.tst
! aa57a75b85b36a99f6ecaca91a9eed60  gcc/testsuite/ada/acats-4/tests/a/a27003a.ada
! 054ca4c1bbb5dd701e8781bc92bf9cb8  gcc/testsuite/ada/acats-4/tests/a/a29003a.ada
! c330e5a362289a57c2ca975a61b4d20c  gcc/testsuite/ada/acats-4/tests/a/a2a031a.ada
! bbd0059e56828aa342048400c5490233  gcc/testsuite/ada/acats-4/tests/a/a33003a.ada
! 84de33e1cd2c3a0c2165591a28407805  gcc/testsuite/ada/acats-4/tests/a/a34017c.ada
! 924373fa4803a6e22fdc43bd0bee31a3  gcc/testsuite/ada/acats-4/tests/a/a35101b.ada
! be270ea90b999a2136e6cc850543a945  gcc/testsuite/ada/acats-4/tests/a/a35402a.ada
! 8054f52aa40d34c334d3a4b30222340a  gcc/testsuite/ada/acats-4/tests/a/a35801f.ada
! 325ee8ec767c6769757ac1eb71d6f515  gcc/testsuite/ada/acats-4/tests/a/a35902c.ada
! c512e91af19d8cf3307b189ec712dde0  gcc/testsuite/ada/acats-4/tests/a/a38106d.ada
! 8d608afb4ab9b953fd4dd01b00a90914  gcc/testsuite/ada/acats-4/tests/a/a38106e.ada
! 28bab0e5eb84a43ad0b4dc06d90f880b  gcc/testsuite/ada/acats-4/tests/a/a49027a.ada
! 5b6e07973ea9075de594e462d6f0f847  gcc/testsuite/ada/acats-4/tests/a/a49027b.ada
! 926d6ade013a1456d53a17063495aaf2  gcc/testsuite/ada/acats-4/tests/a/a49027c.ada
! df2270ff569c843d152cae1fc3606103  gcc/testsuite/ada/acats-4/tests/a/a54b01a.ada
! 71937fafcd3199a3eda330e7880c1ec5  gcc/testsuite/ada/acats-4/tests/a/a54b02a.ada
! 1aa0f31635199e1096468f23888a66f4  gcc/testsuite/ada/acats-4/tests/a/a55b12a.ada
! b0fc7cf66a832e68c808ed89a23340d1  gcc/testsuite/ada/acats-4/tests/a/a55b13a.ada
! 205552e2dafa2b699b6514e12a35e676  gcc/testsuite/ada/acats-4/tests/a/a55b14a.ada
! 7a5be75ac2dc323c1dd1e9328c39c6e0  gcc/testsuite/ada/acats-4/tests/a/a71004a.ada
! 69bd6dadfe4d61041f1998157bcbdb4a  gcc/testsuite/ada/acats-4/tests/a/a73001i.ada
! 8b949ce02d53bc2b35893d05656ff3c2  gcc/testsuite/ada/acats-4/tests/a/a73001j.ada
! 3859ef22068457dc5db7b84889f89c07  gcc/testsuite/ada/acats-4/tests/a/a74105b.ada
! 5200e86147d7eddb31de36b182066003  gcc/testsuite/ada/acats-4/tests/a/a74106a.ada
! d288f454e96b3840804c86245fd1309c  gcc/testsuite/ada/acats-4/tests/a/a74106b.ada
! c6c2ff5c654f5fecb72565c1ec890ea8  gcc/testsuite/ada/acats-4/tests/a/a74106c.ada
! 4526ae74da58946736d1077ca17b0f15  gcc/testsuite/ada/acats-4/tests/a/a74205e.ada
! a4600113362b659154e0921e8ccc440b  gcc/testsuite/ada/acats-4/tests/a/a74205f.ada
! 762682eaddf9e0d72ef370ddf52c091c  gcc/testsuite/ada/acats-4/tests/a/a83009a.ada
! 89be8e66cfa8cf7d9ea962fc92c5bbe6  gcc/testsuite/ada/acats-4/tests/a/a83009b.ada
! 1a86aa84a5b4a8f2d91898a2a5878109  gcc/testsuite/ada/acats-4/tests/a/a83a02a.ada
! b50d55495ed25cd5f5f0cc5ce62c33c6  gcc/testsuite/ada/acats-4/tests/a/a83a02b.ada
! 92d9af0f50f62b8ca3df28d8e4228ec5  gcc/testsuite/ada/acats-4/tests/a/a83a06a.ada
! 5c0b43d5d9e1251dce20fd8ac69811a8  gcc/testsuite/ada/acats-4/tests/a/a83a08a.ada
! d847c2fa25d9becc828716d2f6b3924e  gcc/testsuite/ada/acats-4/tests/a/a83c01c.ada
! 48efd44cb0cc48a4666ca9078d516a19  gcc/testsuite/ada/acats-4/tests/a/a83c01h.ada
! 9a14ce84b1e63358e8ea5b22b8b58366  gcc/testsuite/ada/acats-4/tests/a/a83c01i.ada
! d4b236b43806323a12df387d43065ecd  gcc/testsuite/ada/acats-4/tests/a/a85007d.ada
! 22b51a96b02c7a88f7ef1383e4b6e3ba  gcc/testsuite/ada/acats-4/tests/a/a85013b.ada
! 401bca9a32ad0d8881ea660bba3ca711  gcc/testsuite/ada/acats-4/tests/a/a87b59a.ada
! 74d0779474d9d789d09508ba653efc61  gcc/testsuite/ada/acats-4/tests/a/a95001c.ada
! 4de434af68116383b58aae2d7ff0186e  gcc/testsuite/ada/acats-4/tests/a/a95074d.ada
! 6dcac89d281ffc1c47dc51dfd7429d9e  gcc/testsuite/ada/acats-4/tests/a/a97106a.ada
! 672a004e783873caffaddfe2e9ed7184  gcc/testsuite/ada/acats-4/tests/a/a99006a.ada
! d338cf80520cfcd59896b08557f7334a  gcc/testsuite/ada/acats-4/tests/a/aa2010a.ada
! c8652c11c39145beb7535ff59feee79b  gcc/testsuite/ada/acats-4/tests/a/aa2012a.ada
! 64d7f9e70085b7412df08b06b70924f1  gcc/testsuite/ada/acats-4/tests/a/ac1015b.ada
! f8019419f138b9b0b4e860f560539c52  gcc/testsuite/ada/acats-4/tests/a/ac3106a.ada
! 599863dbc7677bd83fe020c38e11b4b8  gcc/testsuite/ada/acats-4/tests/a/ac3206a.ada
! 527cf1506ce6e0451f82e833aba4b6b3  gcc/testsuite/ada/acats-4/tests/a/ac3207a.ada
! 7c28607179138101a5d7cf088f333028  gcc/testsuite/ada/acats-4/tests/a/ad7001b.ada
! 810035c64fe589563087a2d2f380f1e4  gcc/testsuite/ada/acats-4/tests/a/ad7001c0.ada
! 8d92b2b79dbfd08d90c9a238b1e35a05  gcc/testsuite/ada/acats-4/tests/a/ad7001c1.ada
! 1c1c6e5fb42029a3ff9b1f3b9055c191  gcc/testsuite/ada/acats-4/tests/a/ad7001d0.ada
! 21257b0cc94669e31a8891cb9ed30e14  gcc/testsuite/ada/acats-4/tests/a/ad7001d1.ada
! eaa4c7b6b00bcd4bfa2d9883aff64ee8  gcc/testsuite/ada/acats-4/tests/a/ad7006a.ada
! b93c425e39dd1e4003cb33131862e719  gcc/testsuite/ada/acats-4/tests/a/ad7101a.ada
! 07e115c2bd0ac4bc085809d9ad65327f  gcc/testsuite/ada/acats-4/tests/a/ad7101c.ada
! 24888691f9cd0131679078391bf99fb1  gcc/testsuite/ada/acats-4/tests/a/ad7102a.ada
! 27abfa60261b508014d366ae82e296fe  gcc/testsuite/ada/acats-4/tests/a/ad7103a.ada
! aec3e74553448f599ae9a51ec65c42ce  gcc/testsuite/ada/acats-4/tests/a/ad7103c.ada
! d18cab7f102ffc27545ccb4522f82ded  gcc/testsuite/ada/acats-4/tests/a/ad7104a.ada
! 1b797aacfde0d671d89a45db2a9d5be2  gcc/testsuite/ada/acats-4/tests/a/ad7201a.ada
! 8c49706fbc8916aacd037e7649ed8213  gcc/testsuite/ada/acats-4/tests/a/ad7203b.ada
! 129af6b1b47884872132fcfc3787f362  gcc/testsuite/ada/acats-4/tests/a/ad7205b.ada
! 696b85c4c78cdc9b5448612a22b9ffa3  gcc/testsuite/ada/acats-4/tests/a/ad8011a.tst
! bfa3fa83b466b71da4126d005e2c701b  gcc/testsuite/ada/acats-4/tests/a/ada101a.ada
! 178bb6ff2316e9cfb5bd4395e74874ae  gcc/testsuite/ada/acats-4/tests/a/ae2113a.ada
! 1dd247cf1f02e4384b1f1a58ab2244c0  gcc/testsuite/ada/acats-4/tests/a/ae2113b.ada
! 5ff7c493a66eb8be0a3e7f89bd4d2512  gcc/testsuite/ada/acats-4/tests/a/ae3002g.ada
! 2cc8c13fd1203af7f246cee23d3037c3  gcc/testsuite/ada/acats-4/tests/a/ae3101a.ada
! 3798d627b7336c5fa8805e970e10ec7e  gcc/testsuite/ada/acats-4/tests/a/ae3702a.ada
! 7a44891c6ee0ec272ded72e61d392bc8  gcc/testsuite/ada/acats-4/tests/a/ae3709a.ada
! 8a42b2199ecbb25390c8c306c3759312  gcc/testsuite/ada/acats-4/tests/c2/c23001a.ada
! 8d4b3f4069aeb0e32db3f46e5cb1487b  gcc/testsuite/ada/acats-4/tests/c2/c23003a.tst
! 95e1beb36e033514e6e4be866042a42a  gcc/testsuite/ada/acats-4/tests/c2/c23003b.tst
! a765ec985184f6802389b89d0971eede  gcc/testsuite/ada/acats-4/tests/c2/c23003g.tst
! 53bdd26032ff323b57f3c309b520767e  gcc/testsuite/ada/acats-4/tests/c2/c23003i.tst
! d8470ff80210b6aeab8ecf5828f8e73c  gcc/testsuite/ada/acats-4/tests/c2/c23006a.ada
! c175938807f9ed5ec36eed8c2fc47bf2  gcc/testsuite/ada/acats-4/tests/c2/c23006b.ada
! 1891f1d94ad6f27dc8691abae763b735  gcc/testsuite/ada/acats-4/tests/c2/c23006c.ada
! 4d2aaab0f8577c4441dfb223b74e9270  gcc/testsuite/ada/acats-4/tests/c2/c23006d.ada
! d38fc16a6b2a221a8089094d8e595fd0  gcc/testsuite/ada/acats-4/tests/c2/c23006e.ada
! e4cb34f327ded980acbb2890f276b1b6  gcc/testsuite/ada/acats-4/tests/c2/c23006f.ada
! 1afe1ff732d7c93eb72aeb763fc3a3e4  gcc/testsuite/ada/acats-4/tests/c2/c23006g.ada
! d7a2fe8807a7e954f894e43619906c61  gcc/testsuite/ada/acats-4/tests/c2/c24002d.ada
! 90b7096d0092e8bee54a5e0931480cc3  gcc/testsuite/ada/acats-4/tests/c2/c24003a.ada
! 8d4b3197420dea97b47fa445d6b7f13e  gcc/testsuite/ada/acats-4/tests/c2/c24003b.ada
! c0bc49ad0d9faebe7c1bddd17682575b  gcc/testsuite/ada/acats-4/tests/c2/c24003c.ada
! 474d9480579f044d63ea2312eee797a0  gcc/testsuite/ada/acats-4/tests/c2/c24106a.ada
! 21abd0c844a441282df97eca59d187ac  gcc/testsuite/ada/acats-4/tests/c2/c24202d.ada
! f8734f0cb78893a591c1455798f48f34  gcc/testsuite/ada/acats-4/tests/c2/c24203a.ada
! 303fe85abf30e67b9c26c05c37527377  gcc/testsuite/ada/acats-4/tests/c2/c24203b.ada
! 4fc421f9d26dd38caa8e66e5f9a8118d  gcc/testsuite/ada/acats-4/tests/c2/c24207a.ada
! 00805111547e7b0f767a65dbb0216178  gcc/testsuite/ada/acats-4/tests/c2/c24211a.ada
! d5324b037e4f821711b81926469cd3e5  gcc/testsuite/ada/acats-4/tests/c2/c250001.au
! 373ab51281434258bd43bb850031dd33  gcc/testsuite/ada/acats-4/tests/c2/c250002.au
! fcffacb0c5a7d6bc171b2b62228ef27c  gcc/testsuite/ada/acats-4/tests/c2/c25001a.ada
! f8101111006b8dfccb57bc9286761546  gcc/testsuite/ada/acats-4/tests/c2/c25001b.ada
! 4d59f28ccd2a2792f59d358acfb3b645  gcc/testsuite/ada/acats-4/tests/c2/c26006a.ada
! 2a3847aff34c962069ea9fc46184b49c  gcc/testsuite/ada/acats-4/tests/c2/c26008a.ada
! 3b3d12a94cdb249ade26bb6fe45121be  gcc/testsuite/ada/acats-4/tests/c2/c2a001a.ada
! 3fd11c60327272b0e88714377e07694a  gcc/testsuite/ada/acats-4/tests/c2/c2a001b.ada
! fad7c83b08db79e3d8d41a3abc495609  gcc/testsuite/ada/acats-4/tests/c2/c2a001c.ada
! 9e58903d92e80dece18b3f5f07c10714  gcc/testsuite/ada/acats-4/tests/c2/c2a002a.ada
! 80f047f9baf4edce16ae00b242937e09  gcc/testsuite/ada/acats-4/tests/c2/c2a008a.ada
! 5846b01316c8e35b2ae9271e2ceeb33b  gcc/testsuite/ada/acats-4/tests/c2/c2a021b.ada
! 6c6e6ac7e7d8151372bf25d5bfcc4638  gcc/testsuite/ada/acats-4/tests/c3/c32001a.ada
! f44d3e1d8c4deff3e60e49eb14755c7f  gcc/testsuite/ada/acats-4/tests/c3/c32001b.ada
! 90383af3c35e304193502497e9d9ada0  gcc/testsuite/ada/acats-4/tests/c3/c32001c.ada
! 6f38031cf1bc7fd3a2530a0a49fc3927  gcc/testsuite/ada/acats-4/tests/c3/c32001d.ada
! 4cff8a5cde793b9eb72e56ef8588c690  gcc/testsuite/ada/acats-4/tests/c3/c32001e.ada
! fe386611f5a09953fdbdb423b0673b0b  gcc/testsuite/ada/acats-4/tests/c3/c32107a.ada
! 6dcc55a41a077f43caf697ae83ae4678  gcc/testsuite/ada/acats-4/tests/c3/c32107c.ada
! 6bc3a589ff71140e94718588fa9f9c34  gcc/testsuite/ada/acats-4/tests/c3/c32108a.ada
! 0b55a6ac879d361c4eaa8a25a475c92e  gcc/testsuite/ada/acats-4/tests/c3/c32108b.ada
! 4520bac74d324253fcf2b48b5c6eea2b  gcc/testsuite/ada/acats-4/tests/c3/c32111a.ada
! 52ac5c461c7746717a0d789fb2a57377  gcc/testsuite/ada/acats-4/tests/c3/c32111b.ada
! dabad6f6cae80313a5a888aaa710756d  gcc/testsuite/ada/acats-4/tests/c3/c32112b.ada
! eebc548a818a1f56ce990f52129e4296  gcc/testsuite/ada/acats-4/tests/c3/c32113a.ada
! 016d6073dcc33d7b8106082eb7755faa  gcc/testsuite/ada/acats-4/tests/c3/c32115a.ada
! a613215b48d8c873069bb2d690d5f556  gcc/testsuite/ada/acats-4/tests/c3/c32115b.ada
! b868f27c234029689c9555ed8a885bd2  gcc/testsuite/ada/acats-4/tests/c3/c324001.a
! fb36723bb91c3a9d38883120ccaa6aae  gcc/testsuite/ada/acats-4/tests/c3/c324002.a
! dc91f5dd73ecfdc1c8c33fa6a97d26eb  gcc/testsuite/ada/acats-4/tests/c3/c324003.a
! c7c1664de55da12625e9233ab7129d51  gcc/testsuite/ada/acats-4/tests/c3/c324004.a
! 76da24ac29375824aa0f98ae3ba41da1  gcc/testsuite/ada/acats-4/tests/c3/c324005.a
! 12b96e76c14a6d44a78de5555b0004d3  gcc/testsuite/ada/acats-4/tests/c3/c324006.a
! f21dc71d940d5c06af5d22f69eab60f9  gcc/testsuite/ada/acats-4/tests/c3/c330001.a
! 74812d0708e93af61e096b45e2fc14ec  gcc/testsuite/ada/acats-4/tests/c3/c330002.a
! 8e5fef6b3dfabbb753bbf97caf8dddae  gcc/testsuite/ada/acats-4/tests/c3/c332001.a
! d7ae35646e985b47bde736b4aeadaec1  gcc/testsuite/ada/acats-4/tests/c3/c340001.a
! 029cfe27a33cb66b049fe0d0fb65381b  gcc/testsuite/ada/acats-4/tests/c3/c34001a.ada
! 7f88e5135c6832cdc88dff48cc8dafee  gcc/testsuite/ada/acats-4/tests/c3/c34001c.ada
! 8c1764692d7cb0bc17a952ce68b59db8  gcc/testsuite/ada/acats-4/tests/c3/c34001d.ada
! a08af1aeb3b4af40be4e8250cad56d8d  gcc/testsuite/ada/acats-4/tests/c3/c34001f.ada
! 796e76f308a9d18762b63a8a7c9fa6ec  gcc/testsuite/ada/acats-4/tests/c3/c34002a.ada
! 56ca2500660f86690e43b4eb2c63911d  gcc/testsuite/ada/acats-4/tests/c3/c34002c.ada
! 916814d1426aeb62617f0e647f1425f4  gcc/testsuite/ada/acats-4/tests/c3/c34003a.ada
! 7848bad56990231ec4964a5294f4d02f  gcc/testsuite/ada/acats-4/tests/c3/c34003c.ada
! 3f596cd960a8968d7c7892b7351e85fa  gcc/testsuite/ada/acats-4/tests/c3/c34004a.ada
! f25b6504d96e3e21099abd8a985bfe40  gcc/testsuite/ada/acats-4/tests/c3/c34004c.ada
! 10feabd33f2004943d36ff9acac0bda3  gcc/testsuite/ada/acats-4/tests/c3/c34005a.ada
! 9b730174260769c83e1d1f34a482b64c  gcc/testsuite/ada/acats-4/tests/c3/c34005c.ada
! d8cd66825d35a0c2eee7a2bc22021fde  gcc/testsuite/ada/acats-4/tests/c3/c34005d.ada
! fd5b17683accebcffccf7d52a88ba813  gcc/testsuite/ada/acats-4/tests/c3/c34005f.ada
! 5a2119c2d54f4427832bc1c61d913eac  gcc/testsuite/ada/acats-4/tests/c3/c34005g.ada
! 170b45f6069790926570bd39f97033ea  gcc/testsuite/ada/acats-4/tests/c3/c34005i.ada
! bdf673ae022cc1b217f6ea84218ef460  gcc/testsuite/ada/acats-4/tests/c3/c34005j.ada
! 0c6f4909c9db9787b9ca4d3b296a3ae9  gcc/testsuite/ada/acats-4/tests/c3/c34005l.ada
! 7f1441892699c24f145df474c396124d  gcc/testsuite/ada/acats-4/tests/c3/c34005m.ada
! f851c156716ece972741b1a161b80b5f  gcc/testsuite/ada/acats-4/tests/c3/c34005o.ada
! 44e6ae2ddfccd9120add81bcf05ef268  gcc/testsuite/ada/acats-4/tests/c3/c34005p.ada
! c9bfd44b8febc96560f3ee780cd50a02  gcc/testsuite/ada/acats-4/tests/c3/c34005r.ada
! cd29d3c24de0223ae985376f7363459e  gcc/testsuite/ada/acats-4/tests/c3/c34005s.ada
! 5369d3d26bb15776f47302c2f15c9682  gcc/testsuite/ada/acats-4/tests/c3/c34005u.ada
! b0cfd73e6d9f1d87557f4775248508ea  gcc/testsuite/ada/acats-4/tests/c3/c34005v.ada
! 60d73ec320d9ef0db0dc330bb3e04fe5  gcc/testsuite/ada/acats-4/tests/c3/c34006a.ada
! da0b3e574a91ee0aaaef5268466ab1d1  gcc/testsuite/ada/acats-4/tests/c3/c34006d.ada
! 8d549731513d1eff1ef01cf7c39e1bb6  gcc/testsuite/ada/acats-4/tests/c3/c34006f.ada
! 4ed1c279557b308d6949c373537329cf  gcc/testsuite/ada/acats-4/tests/c3/c34006g.ada
! 90472c17a5088e3d00d57cf3597dc59f  gcc/testsuite/ada/acats-4/tests/c3/c34006j.ada
! 5c3c081fc43ed6dc322f8a13f14b6dba  gcc/testsuite/ada/acats-4/tests/c3/c34006l.ada
! 3111937fe40eda62543e53d0dc0a9b2e  gcc/testsuite/ada/acats-4/tests/c3/c34007a.ada
! a6c16ebbc095684171bb89cb7ac5b52f  gcc/testsuite/ada/acats-4/tests/c3/c34007d.ada
! 3f46f4632a1e2839b528dd4edb849c59  gcc/testsuite/ada/acats-4/tests/c3/c34007f.ada
! 50a6b8b6ab707d4020a210c2f54c5364  gcc/testsuite/ada/acats-4/tests/c3/c34007g.ada
! 1d08fae78b3684032500b751c4f6b956  gcc/testsuite/ada/acats-4/tests/c3/c34007i.ada
! 7dec8ab4f2325dfb24a6f4a0712ca647  gcc/testsuite/ada/acats-4/tests/c3/c34007j.ada
! f2f670c3368d6fdedc0bc830e2f5441f  gcc/testsuite/ada/acats-4/tests/c3/c34007m.ada
! 12e7a75337b952bbe70b50f44fbf73bd  gcc/testsuite/ada/acats-4/tests/c3/c34007p.ada
! 4460899978bde8392dbf79b1457fd4c0  gcc/testsuite/ada/acats-4/tests/c3/c34007r.ada
! 430fadbb7eb89cad332156a43a1cb8a6  gcc/testsuite/ada/acats-4/tests/c3/c34007s.ada
! 142cd26f56dbefa8cc40ce318e93574b  gcc/testsuite/ada/acats-4/tests/c3/c34007u.ada
! 01aa55423bd6286a768cfbc7951408e9  gcc/testsuite/ada/acats-4/tests/c3/c34007v.ada
! 511c5e7943ba2a51ce38527bbf116d2d  gcc/testsuite/ada/acats-4/tests/c3/c34008a.ada
! 9e896dcd16ce62c70c03b6105de6b94c  gcc/testsuite/ada/acats-4/tests/c3/c34009a.ada
! be1b3bebe697fb006bf9a558f3b0f788  gcc/testsuite/ada/acats-4/tests/c3/c34009d.ada
! 5880284be01f48d40969f18306c94edd  gcc/testsuite/ada/acats-4/tests/c3/c34009f.ada
! 679004960f5e177505b2aff13c637ebf  gcc/testsuite/ada/acats-4/tests/c3/c34009g.ada
! f60aa89944e52f4dca47047e08990f29  gcc/testsuite/ada/acats-4/tests/c3/c34009j.ada
! 28351985ca5afb785bccaaf7463d1f32  gcc/testsuite/ada/acats-4/tests/c3/c34009l.ada
! 221f9bd08976154a0a22e9948d8ac7e0  gcc/testsuite/ada/acats-4/tests/c3/c34011b.ada
! f2175e26a65dbd70c186e6acf1001755  gcc/testsuite/ada/acats-4/tests/c3/c34012a.ada
! bdde2c516616684b5fe414550d8400ee  gcc/testsuite/ada/acats-4/tests/c3/c34014a.ada
! 4e8100382b8141c0d056a9fe870b8d06  gcc/testsuite/ada/acats-4/tests/c3/c34014c.ada
! a8fbccc7b3c28981b57a867a1edabf5d  gcc/testsuite/ada/acats-4/tests/c3/c34014e.ada
! 75cb51a9c469066a67228b04e8ba11fc  gcc/testsuite/ada/acats-4/tests/c3/c34014g.ada
! da007fc8719ca70057c035beb9fda7fe  gcc/testsuite/ada/acats-4/tests/c3/c34014h.ada
! dbcb5a07736736af9834d2938b24e483  gcc/testsuite/ada/acats-4/tests/c3/c34014n.ada
! afbaca6a68812eaecf17a8eef2a6346e  gcc/testsuite/ada/acats-4/tests/c3/c34014p.ada
! df14c9b4224ce4cf3fd2d8445cbad0f2  gcc/testsuite/ada/acats-4/tests/c3/c34014r.ada
! 03948696a8a2d08faa02588806cd388d  gcc/testsuite/ada/acats-4/tests/c3/c34014t.ada
! 7258de51f19cfc9506908221af84e01f  gcc/testsuite/ada/acats-4/tests/c3/c34014u.ada
! 360330a2a81712d1ed00c02cbc5e6526  gcc/testsuite/ada/acats-4/tests/c3/c34018a.ada
! a943a89b3032146b53e937f3a73684da  gcc/testsuite/ada/acats-4/tests/c3/c340a01.a
! 5a38659efe283303f9d22ebc955ae0d0  gcc/testsuite/ada/acats-4/tests/c3/c340a02.a
! f694a602dc4b31baf72c096b6e4fb9d5  gcc/testsuite/ada/acats-4/tests/c3/c341a01.a
! 4ad05d07bd295bd76f3edbc6685ae9b8  gcc/testsuite/ada/acats-4/tests/c3/c341a02.a
! 49408ab274823bacfccd32176c5bc061  gcc/testsuite/ada/acats-4/tests/c3/c341a03.a
! ec207723e08de50ca0964ad3318f8235  gcc/testsuite/ada/acats-4/tests/c3/c341a04.a
! e1b4bc5cb76de92ba443a02d7d37ec5a  gcc/testsuite/ada/acats-4/tests/c3/c350001.a
! 55b745d015fed5a09de487d8081c09eb  gcc/testsuite/ada/acats-4/tests/c3/c35003a.ada
! 092ff51133e865dad2cd6192506f9980  gcc/testsuite/ada/acats-4/tests/c3/c35003b.ada
! 55caad169adcfa6b58689ceb3dc1d505  gcc/testsuite/ada/acats-4/tests/c3/c35003d.ada
! ccab055252a791535f832cc2ef66a495  gcc/testsuite/ada/acats-4/tests/c3/c350a01.a
! 6c9762756ef96e8cfb00b095f55e313e  gcc/testsuite/ada/acats-4/tests/c3/c350a02.a
! 546bb731859512ee6a131ebc54f1d750  gcc/testsuite/ada/acats-4/tests/c3/c350b01.a
! 6a067a557e11fd3288c412da9d4acb4d  gcc/testsuite/ada/acats-4/tests/c3/c350b02.a
! b2b10d16689d994b421c7f356c4eebe9  gcc/testsuite/ada/acats-4/tests/c3/c35102a.ada
! ca3400d0b805977010a922a33d4fc78c  gcc/testsuite/ada/acats-4/tests/c3/c352001.a
! 6adbf240f9a88c67e6dc4d9a3ae2f449  gcc/testsuite/ada/acats-4/tests/c3/c354002.a
! 1c6bd8c5607c8d83b1fb16cf20b35965  gcc/testsuite/ada/acats-4/tests/c3/c354003.a
! 748d8130bd21629fdee8f30be95ddf20  gcc/testsuite/ada/acats-4/tests/c3/c354004.a
! 831543d10fff09679865a63cb6261690  gcc/testsuite/ada/acats-4/tests/c3/c35502a.ada
! a7c2fa5fc851b6f2ef3d825116c56789  gcc/testsuite/ada/acats-4/tests/c3/c35502b.ada
! 012ae5aa045c7b944677ea749449b75e  gcc/testsuite/ada/acats-4/tests/c3/c35502c.ada
! 66ad3541bdd12f2457bc931410567df2  gcc/testsuite/ada/acats-4/tests/c3/c35502d.tst
! f850859238832c6689133c4b82b2d23a  gcc/testsuite/ada/acats-4/tests/c3/c35502e.ada
! 1ae0d752d4d7089a159ba37533cac440  gcc/testsuite/ada/acats-4/tests/c3/c35502f.tst
! 86636a48b0f16cee1e000cf7cdff2dd3  gcc/testsuite/ada/acats-4/tests/c3/c35502g.ada
! 051f7f33819b5ea42a6810524402160e  gcc/testsuite/ada/acats-4/tests/c3/c35502h.ada
! 4e03c40da8c9f6a6c779600f4bf06f72  gcc/testsuite/ada/acats-4/tests/c3/c35502i.ada
! 0ce71c0ba8fc8137892f8032070143cf  gcc/testsuite/ada/acats-4/tests/c3/c35502j.ada
! 039caaa9e43f4d6e115a8a1f83eeebf1  gcc/testsuite/ada/acats-4/tests/c3/c35502k.ada
! 211eda1bcd28ea4725982c3228537ce8  gcc/testsuite/ada/acats-4/tests/c3/c35502l.ada
! 04a6b32af2cf206734bf10b9c20a1a53  gcc/testsuite/ada/acats-4/tests/c3/c35502m.ada
! 4d2fd9e74373c5a73cc4f819206b0ae4  gcc/testsuite/ada/acats-4/tests/c3/c35502n.ada
! a2f7774ccd8fe3b58f670146427b1f58  gcc/testsuite/ada/acats-4/tests/c3/c35502o.ada
! 244d3a03a5bfb9a02be2cde7af593c88  gcc/testsuite/ada/acats-4/tests/c3/c35502p.ada
! bbea92be5e14aa812d5b0bf50f43ecd2  gcc/testsuite/ada/acats-4/tests/c3/c35503a.ada
! e45620aeea62423f2a72fa98c32c2629  gcc/testsuite/ada/acats-4/tests/c3/c35503b.ada
! 6ff5a195541e611e8f795764a46c96c7  gcc/testsuite/ada/acats-4/tests/c3/c35503c.ada
! ae4f0df020df3fca42928a76d16433e2  gcc/testsuite/ada/acats-4/tests/c3/c35503d.tst
! 2835676122accf27f7f9912ed7f9b38b  gcc/testsuite/ada/acats-4/tests/c3/c35503e.ada
! 18bbb578fe3d479a11c962d128286c04  gcc/testsuite/ada/acats-4/tests/c3/c35503f.tst
! def2f804ca12f62b8b5f42c18fa649c0  gcc/testsuite/ada/acats-4/tests/c3/c35503g.ada
! 082f524dedff546b67bf566735caa1c1  gcc/testsuite/ada/acats-4/tests/c3/c35503h.ada
! 85174a7f410200513d18d173743c7474  gcc/testsuite/ada/acats-4/tests/c3/c35503k.ada
! 57ae4c28160a4dfa61de89bc057c9b02  gcc/testsuite/ada/acats-4/tests/c3/c35503l.ada
! 5fc96deb857ba3b7ec7ee6040f2b7d93  gcc/testsuite/ada/acats-4/tests/c3/c35503o.ada
! 02c17920bbabcf5f472c332ee0439df3  gcc/testsuite/ada/acats-4/tests/c3/c35503p.ada
! 7c0f95cda266f19784cd481570ffcf1a  gcc/testsuite/ada/acats-4/tests/c3/c35504a.ada
! 58ca27427f3b7371702549078677cd48  gcc/testsuite/ada/acats-4/tests/c3/c35504b.ada
! c64ed7ab5ced440f95e39eb0465b431f  gcc/testsuite/ada/acats-4/tests/c3/c35505c.ada
! 8a20049a7aa4dbf5e73f4a4a856df916  gcc/testsuite/ada/acats-4/tests/c3/c35505e.ada
! fb8432e5868c1977e525882401096430  gcc/testsuite/ada/acats-4/tests/c3/c35505f.ada
! a3d1f58b38d0f57e89521134057aa0d0  gcc/testsuite/ada/acats-4/tests/c3/c35507a.ada
! fe46e6e48a084e26027a960dcecf0e7f  gcc/testsuite/ada/acats-4/tests/c3/c35507b.ada
! 6276ac14d36049ca6fc1d65937918d6d  gcc/testsuite/ada/acats-4/tests/c3/c35507c.ada
! 38f75633d1d28c38660ac311815075c6  gcc/testsuite/ada/acats-4/tests/c3/c35507e.ada
! 068b315520036392da2decdadf03f6c9  gcc/testsuite/ada/acats-4/tests/c3/c35507g.ada
! c2e6c5681cde5371d2678d0afe2a7dbc  gcc/testsuite/ada/acats-4/tests/c3/c35507h.ada
! 63dad9c02cf9b0faee9f7a4c8f1e9e2d  gcc/testsuite/ada/acats-4/tests/c3/c35507i.ada
! 1501d4b22ff6ada18bda2bec24e23c79  gcc/testsuite/ada/acats-4/tests/c3/c35507j.ada
! 09885e80b2822b3187740ca5682c20e8  gcc/testsuite/ada/acats-4/tests/c3/c35507k.ada
! 7cef3fe8bb6274e0323e822d047490b2  gcc/testsuite/ada/acats-4/tests/c3/c35507l.ada
! b1e4ee7af4f56f20553663a9e296595e  gcc/testsuite/ada/acats-4/tests/c3/c35507m.ada
! cecbaaea0b8f341a4305a221c28843fc  gcc/testsuite/ada/acats-4/tests/c3/c35507n.ada
! 52e0a241e2ad05fa89ecb293e6e2445a  gcc/testsuite/ada/acats-4/tests/c3/c35507o.ada
! 600e023fcb478381f0a8d0bde64f42ce  gcc/testsuite/ada/acats-4/tests/c3/c35507p.ada
! f33cc8ac90e96b7b226aaec5ae692195  gcc/testsuite/ada/acats-4/tests/c3/c35508a.ada
! 7e48a5fa6e02b3658f287da356b209f9  gcc/testsuite/ada/acats-4/tests/c3/c35508b.ada
! 4b6b6e92f28c0ad3cd4f67af8ad0c06c  gcc/testsuite/ada/acats-4/tests/c3/c35508c.ada
! 8bbddf95307b94ae0ed7e12152746762  gcc/testsuite/ada/acats-4/tests/c3/c35508e.ada
! dbe54ec8ce5e33dd88ae24a43cfde531  gcc/testsuite/ada/acats-4/tests/c3/c35508g.ada
! e637f96ce7f08585f2d85fee50f734ee  gcc/testsuite/ada/acats-4/tests/c3/c35508h.ada
! 362619ef40ffff0fd56dee7a6a6c51ab  gcc/testsuite/ada/acats-4/tests/c3/c35508k.ada
! 62ca0e421d4722ad32f139648ece0a60  gcc/testsuite/ada/acats-4/tests/c3/c35508l.ada
! fab2b9fed9304046c3feed68fb9e7b50  gcc/testsuite/ada/acats-4/tests/c3/c35508o.ada
! a7e4e9b85072c7fc56cd223463426c4d  gcc/testsuite/ada/acats-4/tests/c3/c35508p.ada
! bb15d1d296a4eddc9aada6a363360729  gcc/testsuite/ada/acats-4/tests/c3/c35703a.ada
! 97d3b53eb2177ea6344c1ef49c98377d  gcc/testsuite/ada/acats-4/tests/c3/c35704a.ada
! 5a690257e776d58a4fd2a23a7ba6c0e9  gcc/testsuite/ada/acats-4/tests/c3/c35704b.ada
! 52a2a628059a70786108ace7ccd9d08f  gcc/testsuite/ada/acats-4/tests/c3/c35704c.ada
! 14756c69c53e152b3ede55a2754a4d33  gcc/testsuite/ada/acats-4/tests/c3/c35704d.ada
! 22b7d640a1b7ab1933a5654507ff5814  gcc/testsuite/ada/acats-4/tests/c3/c35801d.ada
! 23943917f960018ecdfb861e2c69b545  gcc/testsuite/ada/acats-4/tests/c3/c35902d.ada
! 1e5392accfe4bd85f17ca7c456747be3  gcc/testsuite/ada/acats-4/tests/c3/c35904a.ada
! 4c8ee2a79f1878dcbca7246e9e436865  gcc/testsuite/ada/acats-4/tests/c3/c35904b.ada
! 30b8cbfb52816a7bbebd1319a2a18fb7  gcc/testsuite/ada/acats-4/tests/c3/c35a001.a
! 73fbf4f7e465d5d7fdbee3c99d7cf9ec  gcc/testsuite/ada/acats-4/tests/c3/c35a02a.ada
! 9f8c6fe2edc1ad0a78efbb5038b9ef99  gcc/testsuite/ada/acats-4/tests/c3/c35a05a.ada
! 57fc2536f06ceaf5a1604ee5bb5605fd  gcc/testsuite/ada/acats-4/tests/c3/c35a05d.ada
! ccf547732379c7144c27839f695e8a78  gcc/testsuite/ada/acats-4/tests/c3/c35a05n.ada
! ef904f577e7d9c35099e7d144f51bcce  gcc/testsuite/ada/acats-4/tests/c3/c35a05q.ada
! 3682cd83d6b388849e97129de990f52d  gcc/testsuite/ada/acats-4/tests/c3/c35a07a.ada
! 03e887c344e6bdbdb22118ff77b769fd  gcc/testsuite/ada/acats-4/tests/c3/c35a07d.ada
! ccdad741543d79671fc5f73037ff418d  gcc/testsuite/ada/acats-4/tests/c3/c35a08b.ada
! 651df98436a6167a850f437a29dc7a94  gcc/testsuite/ada/acats-4/tests/c3/c360002.a
! 641f416f8da6932fac352243e8924468  gcc/testsuite/ada/acats-4/tests/c3/c360a01.a
! b231d0b5606e37005d03ba935b4006d2  gcc/testsuite/ada/acats-4/tests/c3/c360a02.a
! 573c52ae71cbedbdf36c3d238ecab8ec  gcc/testsuite/ada/acats-4/tests/c3/c360b01.a
! 6b55489de7bf7431574bc98ad060c22e  gcc/testsuite/ada/acats-4/tests/c3/c360b02.a
! a4c274a3e03fe30e6bc786063bfe78e9  gcc/testsuite/ada/acats-4/tests/c3/c36104a.ada
! b016b5195b1a9d3c07192416c89e1bee  gcc/testsuite/ada/acats-4/tests/c3/c36104b.ada
! 43912684d172c672071ee16d854bcff0  gcc/testsuite/ada/acats-4/tests/c3/c36172a.ada
! 2dc69a4f44addfae37b13335df258285  gcc/testsuite/ada/acats-4/tests/c3/c36172b.ada
! 4d07671447e230f3eddc684c6a3b557a  gcc/testsuite/ada/acats-4/tests/c3/c36172c.ada
! 38a8a16720ac5a8741105f6c5f506f2d  gcc/testsuite/ada/acats-4/tests/c3/c36174a.ada
! 87012e291c8acd51799d9ca8b8fccc32  gcc/testsuite/ada/acats-4/tests/c3/c36180a.ada
! f887210d32ff420cd8ec888ca5c13b66  gcc/testsuite/ada/acats-4/tests/c3/c36202c.ada
! c48c400b884ae534788fbff1510b95ba  gcc/testsuite/ada/acats-4/tests/c3/c36203a.ada
! 93d36d6ba5a23a2f985cc842911a6b2f  gcc/testsuite/ada/acats-4/tests/c3/c36204a.ada
! 5ae3804a2577f9be85df4c11dd1ba3ab  gcc/testsuite/ada/acats-4/tests/c3/c36204b.ada
! 95f946b45603237266057103729c0a9c  gcc/testsuite/ada/acats-4/tests/c3/c36204c.ada
! 1a555d9bc9de255c02e401d7956a5f67  gcc/testsuite/ada/acats-4/tests/c3/c36204d.ada
! c5d2782fd60778b2578f9cf486e811db  gcc/testsuite/ada/acats-4/tests/c3/c36205a.ada
! 4842fc730e500b00c7c35f4691be2855  gcc/testsuite/ada/acats-4/tests/c3/c36205b.ada
! 725f9fbf3157baa9a668acc5e689a06b  gcc/testsuite/ada/acats-4/tests/c3/c36205c.ada
! a9d6124e64589b143b6b54d575df431b  gcc/testsuite/ada/acats-4/tests/c3/c36205d.ada
! c016e1338001bb0d007af7bf4e20d911  gcc/testsuite/ada/acats-4/tests/c3/c36205e.ada
! 299e459d577a85781464563cd621f1b4  gcc/testsuite/ada/acats-4/tests/c3/c36205f.ada
! 7f182ba91c9a0f80d0e5e5b7e919ac56  gcc/testsuite/ada/acats-4/tests/c3/c36205g.ada
! 7559d4ebfc8d9c23879d2cc42d3ac0f4  gcc/testsuite/ada/acats-4/tests/c3/c36205h.ada
! d11eed873d3f614674f193f130b127bb  gcc/testsuite/ada/acats-4/tests/c3/c36205i.ada
! 65b17684e8953d820a69eb11dc4d63e4  gcc/testsuite/ada/acats-4/tests/c3/c36205j.ada
! 21f3a9a788ac6136e2b453f0fc99959f  gcc/testsuite/ada/acats-4/tests/c3/c36205k.ada
! 9884f944a4c4faaee8aaf09a92235c3a  gcc/testsuite/ada/acats-4/tests/c3/c36205l.ada
! 1552dfb23215604db6043c7d12dfc7a6  gcc/testsuite/ada/acats-4/tests/c3/c36301a.ada
! eb37821c1c0e190f8c8cd0e7d282bc9e  gcc/testsuite/ada/acats-4/tests/c3/c36301b.ada
! 236dab07c2bafa07e92d082fc822c8b4  gcc/testsuite/ada/acats-4/tests/c3/c36302a.ada
! a1b4d4c17da94ac478b85b56fd32bf91  gcc/testsuite/ada/acats-4/tests/c3/c36304a.ada
! 58595c82c4f76f6be31333ec0267a9c8  gcc/testsuite/ada/acats-4/tests/c3/c36305a.ada
! 871a3ce65e5d5a824131380a060f18e0  gcc/testsuite/ada/acats-4/tests/c3/c37002a.ada
! 8415fb7acaf9ab73e2a230b45778e7c8  gcc/testsuite/ada/acats-4/tests/c3/c37003a.ada
! b93e53c5cd23520b5b0b88e8c4aee165  gcc/testsuite/ada/acats-4/tests/c3/c37003b.ada
! 0396184f11f01fdd09e40a2432a7850c  gcc/testsuite/ada/acats-4/tests/c3/c37005a.ada
! 17dc351de12194e77f5fe4b5ffbc733e  gcc/testsuite/ada/acats-4/tests/c3/c37006a.ada
! 96813863f2ee2182c3f68f999a7ffed2  gcc/testsuite/ada/acats-4/tests/c3/c37008a.ada
! 9f784c997bf1bb09fe9bf639408dd25c  gcc/testsuite/ada/acats-4/tests/c3/c37008b.ada
! 5d7d0f22be016c0f9b4bcb1da25ed1a2  gcc/testsuite/ada/acats-4/tests/c3/c37009a.ada
! ffc6187aa3ecc28b0631a384e1f95a7e  gcc/testsuite/ada/acats-4/tests/c3/c37010a.ada
! 029c8fb134594e913fe650a5763a4515  gcc/testsuite/ada/acats-4/tests/c3/c37010b.ada
! 09e452317c2c5a3df881f8bfc5bad1ca  gcc/testsuite/ada/acats-4/tests/c3/c371001.a
! 194d5579b14c8d78edccb4725e786bbb  gcc/testsuite/ada/acats-4/tests/c3/c371002.a
! 6508ac6c82ccaf89245ddeb239cf8c65  gcc/testsuite/ada/acats-4/tests/c3/c371003.a
! efcbd19428af8ce2430d60f7389f98f7  gcc/testsuite/ada/acats-4/tests/c3/c37102b.ada
! b56d339ed47321b90862af1e6ff54f3c  gcc/testsuite/ada/acats-4/tests/c3/c37103a.ada
! d2b9a9804b8282550c3233d4c850e203  gcc/testsuite/ada/acats-4/tests/c3/c37105a.ada
! dff6fe14498b4430a005271952b8508b  gcc/testsuite/ada/acats-4/tests/c3/c37107a.ada
! cab8fff51d9e7fa6be5dc3722f0805a7  gcc/testsuite/ada/acats-4/tests/c3/c37108b.ada
! ac1c74612e7098a8b3c19c4233f91b36  gcc/testsuite/ada/acats-4/tests/c3/c37206a.ada
! da4a6484624a6563a3acad74e59e553f  gcc/testsuite/ada/acats-4/tests/c3/c37207a.ada
! 793d448b9373aca3bdfbeb16c4cd5664  gcc/testsuite/ada/acats-4/tests/c3/c37208a.ada
! 19e934b5c86da61793fb4bde9faf4f4a  gcc/testsuite/ada/acats-4/tests/c3/c37208b.ada
! cfc2d39b74fd2d6964787190ac03afde  gcc/testsuite/ada/acats-4/tests/c3/c37209a.ada
! a9e5da6e96624ea9e8d99c31a879bea0  gcc/testsuite/ada/acats-4/tests/c3/c37209b.ada
! 5095a03dbf61f1c7486ce4249ebd4168  gcc/testsuite/ada/acats-4/tests/c3/c37210a.ada
! 13fd1f169bebade45dcc8f783c4dfba5  gcc/testsuite/ada/acats-4/tests/c3/c37211a.ada
! 90539e4b0a8ab5a720d93e61332d4bad  gcc/testsuite/ada/acats-4/tests/c3/c37211b.ada
! b5fb0f0cfa820aa9c8f8a02529b59ae1  gcc/testsuite/ada/acats-4/tests/c3/c37211c.ada
! 34158bf765252e909102a5071bd1ab0d  gcc/testsuite/ada/acats-4/tests/c3/c37211d.ada
! 9723d82d289b6c708a4e38619a050c44  gcc/testsuite/ada/acats-4/tests/c3/c37211e.ada
! 02567718a426a27f1633a5ba46fb39ea  gcc/testsuite/ada/acats-4/tests/c3/c37213b.ada
! 0db6468aa3789fa4eb8509864bbbba6c  gcc/testsuite/ada/acats-4/tests/c3/c37213d.ada
! c3ea989d669b26ad147ec1d36d59f8b1  gcc/testsuite/ada/acats-4/tests/c3/c37213f.ada
! c7d6b08bb4739fe27a9bf7c37153611b  gcc/testsuite/ada/acats-4/tests/c3/c37213h.ada
! e1a81fd713875796f8f0f1d1d856df2e  gcc/testsuite/ada/acats-4/tests/c3/c37213j.ada
! 8824529732962a1fb9cbd428d01a57f5  gcc/testsuite/ada/acats-4/tests/c3/c37213k.ada
! 7c2df003cd7fdc0bffaa00b7e5a76295  gcc/testsuite/ada/acats-4/tests/c3/c37213l.ada
! d1bb01398cfb6ee5cd12ec89604227fb  gcc/testsuite/ada/acats-4/tests/c3/c37215b.ada
! f34c6fc15658b1b04a69e1ccf32c7394  gcc/testsuite/ada/acats-4/tests/c3/c37215d.ada
! ca62cbc7b583fe934a8091c539e55305  gcc/testsuite/ada/acats-4/tests/c3/c37215f.ada
! 8be60a6919ae5d9ba615eb624746100d  gcc/testsuite/ada/acats-4/tests/c3/c37215h.ada
! fdd60b015f299bfc5d8e0f9f33334f8e  gcc/testsuite/ada/acats-4/tests/c3/c37217a.ada
! bb84ce5410a8c6c7127939120ba80cde  gcc/testsuite/ada/acats-4/tests/c3/c37217b.ada
! 2687c3f166eabbae25fc5e04880d06a3  gcc/testsuite/ada/acats-4/tests/c3/c37217c.ada
! db9ca52d8b1a818e4d66aea96b3eb964  gcc/testsuite/ada/acats-4/tests/c3/c37304a.ada
! 59413b6b57aae9caadc41c111c74faed  gcc/testsuite/ada/acats-4/tests/c3/c37305a.ada
! 2ff906f6262ecd1cfdaffbcda07f1a76  gcc/testsuite/ada/acats-4/tests/c3/c37306a.ada
! a6f2da7b55ad908aebb841bc6ed9b69e  gcc/testsuite/ada/acats-4/tests/c3/c37309a.ada
! 54ec04c8663d10e960eb022fed3a9306  gcc/testsuite/ada/acats-4/tests/c3/c37310a.ada
! ab733e44603296f9e49a292ad601cf74  gcc/testsuite/ada/acats-4/tests/c3/c37312a.ada
! 75ac97c1a116dcc5edcc7f2b44f304f4  gcc/testsuite/ada/acats-4/tests/c3/c37402a.ada
! 2d432b792b7c7b0669844add896bb802  gcc/testsuite/ada/acats-4/tests/c3/c37403a.ada
! 38ed181e9e32218f4a81d412e83c503d  gcc/testsuite/ada/acats-4/tests/c3/c37404a.ada
! c1cce1fda9f9c6085ecce4e278182d6c  gcc/testsuite/ada/acats-4/tests/c3/c37404b.ada
! c9abb9613df5a6b0ab399a10551d5070  gcc/testsuite/ada/acats-4/tests/c3/c37405a.ada
! 1793c94eca80b29526f7ec7a9da864e8  gcc/testsuite/ada/acats-4/tests/c3/c37411a.ada
! 3d8871a14f5b0b92ab5699036c27161b  gcc/testsuite/ada/acats-4/tests/c3/c380001.a
! fe1bbd01b7e70108e4de5854ee4c098d  gcc/testsuite/ada/acats-4/tests/c3/c380002.a
! fb52cd7cb9118b93afa2bc8a309ecdc9  gcc/testsuite/ada/acats-4/tests/c3/c380003.a
! 7e465d24377190b6eaafcc3fd3125ff9  gcc/testsuite/ada/acats-4/tests/c3/c380004.a
! c76f2865cda03e9d5c2164052031d578  gcc/testsuite/ada/acats-4/tests/c3/c38002a.ada
! 5c8aaef6a8da893998485cc8bfb71f48  gcc/testsuite/ada/acats-4/tests/c3/c38002b.ada
! f8397d669785d9d911c494e0a0b9986a  gcc/testsuite/ada/acats-4/tests/c3/c38005a.ada
! 36a372c2d5368726208b1f76f95f3c1d  gcc/testsuite/ada/acats-4/tests/c3/c38005b.ada
! 175ff60b11884803275c5a95d4db9b0f  gcc/testsuite/ada/acats-4/tests/c3/c38005c.ada
! cc457354e31fc1e63179de33cbefbad9  gcc/testsuite/ada/acats-4/tests/c3/c38102a.ada
! 2f60ee39cadeb5e04f93c0fb98c2ff78  gcc/testsuite/ada/acats-4/tests/c3/c38102b.ada
! 773c45b11f80bfa2c11a621982312a41  gcc/testsuite/ada/acats-4/tests/c3/c38102c.ada
! 2eec2f09807572ff6be386c41f2aa890  gcc/testsuite/ada/acats-4/tests/c3/c38102d.ada
! ff2ae7294328aba3ca946b298ff89249  gcc/testsuite/ada/acats-4/tests/c3/c38102e.ada
! 19d2c8a98b84fc28fb173b8ede249f5f  gcc/testsuite/ada/acats-4/tests/c3/c38104a.ada
! ccdff83c46a0742a6f6c98f395885cf0  gcc/testsuite/ada/acats-4/tests/c3/c38107a.ada
! 5b807a368e5b577c901a0143b328edd6  gcc/testsuite/ada/acats-4/tests/c3/c38107b.ada
! 7f519d74032c869b16bf7e4cc3f1757c  gcc/testsuite/ada/acats-4/tests/c3/c38108a.ada
! 1cdb4b2554cc632c2786a14302f39123  gcc/testsuite/ada/acats-4/tests/c3/c38108b.ada
! 0c83db01ff09f439f6a7fc807e878547  gcc/testsuite/ada/acats-4/tests/c3/c38108c0.ada
! 0b0a2c9346188afcf5a240958d58cb60  gcc/testsuite/ada/acats-4/tests/c3/c38108c1.ada
! 1cea347b513b856254a8e9fed08d945a  gcc/testsuite/ada/acats-4/tests/c3/c38108c2.ada
! fb749693f49b0edcfffc4444290ac564  gcc/testsuite/ada/acats-4/tests/c3/c38108d0.ada
! aa2833688968ca7a3e36612070b575f4  gcc/testsuite/ada/acats-4/tests/c3/c38108d1.ada
! 61680b9ec1c444c4faffd8c59cce698a  gcc/testsuite/ada/acats-4/tests/c3/c3900010.a
! 987d00ae68ea07578bf45fc567352a66  gcc/testsuite/ada/acats-4/tests/c3/c3900011.am
! 370d5eba0eee3ce909caf87c342f846d  gcc/testsuite/ada/acats-4/tests/c3/c390002.a
! 6dd703dff40d77030a2c6329094e7802  gcc/testsuite/ada/acats-4/tests/c3/c390003.a
! 491d840ce3aeb642239cc28533a9ba34  gcc/testsuite/ada/acats-4/tests/c3/c390004.a
! b04ffb8d071dcf6547533038ef227651  gcc/testsuite/ada/acats-4/tests/c3/c3900050.a
! dff18ad9fb367bc37acd04d6e08e55bf  gcc/testsuite/ada/acats-4/tests/c3/c3900051.a
! 2b39948b2af313cbed0046a2bcdcbc9d  gcc/testsuite/ada/acats-4/tests/c3/c3900052.a
! b4e44c9c1971345223585500a55db164  gcc/testsuite/ada/acats-4/tests/c3/c3900053.am
! 471e818df49cf1a32357c5b759d21dc9  gcc/testsuite/ada/acats-4/tests/c3/c3900060.a
! bd65238f7cda09d91e177736cdbcd7ec  gcc/testsuite/ada/acats-4/tests/c3/c3900061.a
! d3e9ddf4af2eb46f1b086dbc43c75d04  gcc/testsuite/ada/acats-4/tests/c3/c3900062.a
! bced3ae0c872e2f15b26193b1c9c4c35  gcc/testsuite/ada/acats-4/tests/c3/c3900063.am
! cd1ae54278fd1b61d5ecd166ecf0671b  gcc/testsuite/ada/acats-4/tests/c3/c390007.a
! a7cf99b62949613099d6c982d9043098  gcc/testsuite/ada/acats-4/tests/c3/c390010.a
! 30e5b9a42c18864d89a931830adfd68e  gcc/testsuite/ada/acats-4/tests/c3/c390011.a
! fb81397d707bf07d8e9f486812adb73b  gcc/testsuite/ada/acats-4/tests/c3/c390012.a
! 1bcaf1b15ae617d49c80e68b55943cc6  gcc/testsuite/ada/acats-4/tests/c3/c39006a.ada
! 7e954943167e1f1855ce0abf856c9a9b  gcc/testsuite/ada/acats-4/tests/c3/c39006b.ada
! 14d52be4c2d938b4ae51c17507b6ca25  gcc/testsuite/ada/acats-4/tests/c3/c39006c0.ada
! c770912acdec8d8fa7169157d99a1382  gcc/testsuite/ada/acats-4/tests/c3/c39006c1.ada
! fcf5b4e7ecc49a79fc11640baf53f4f6  gcc/testsuite/ada/acats-4/tests/c3/c39006d.ada
! 86ddd0b2d946750357311d89b5046963  gcc/testsuite/ada/acats-4/tests/c3/c39006e.ada
! ba4887d359d62403c79f3563b0dfa8f4  gcc/testsuite/ada/acats-4/tests/c3/c39006f0.ada
! 205b6ff97343a4403e8cb5bc33883547  gcc/testsuite/ada/acats-4/tests/c3/c39006f1.ada
! 16ddc19c6da0a1642305e4b5fc6058d1  gcc/testsuite/ada/acats-4/tests/c3/c39006f2.ada
! 59cfdb727f33418fa8de537e14629d71  gcc/testsuite/ada/acats-4/tests/c3/c39006f3.ada
! f80f760d35130556602f0b683e480d63  gcc/testsuite/ada/acats-4/tests/c3/c39006g.ada
! cce3352413b69fd05b5ec5195c3a4c00  gcc/testsuite/ada/acats-4/tests/c3/c39007a.ada
! eab8b6c595bc019ed0d33f826e34e97f  gcc/testsuite/ada/acats-4/tests/c3/c39007b.ada
! f9502bdaffb8475b46fab174a19f2de9  gcc/testsuite/ada/acats-4/tests/c3/c39008a.ada
! 44f9dead72582206f122372b79949f92  gcc/testsuite/ada/acats-4/tests/c3/c39008b.ada
! f7c867df153c4137ff42c73e84cf78bb  gcc/testsuite/ada/acats-4/tests/c3/c39008c.ada
! 7dfc2d2eea8f430d414e0e9fb3d66efb  gcc/testsuite/ada/acats-4/tests/c3/c390a010.a
! fe7593d56cc6f8290c29978513afc0e4  gcc/testsuite/ada/acats-4/tests/c3/c390a011.am
! 11b0510a4ce65e5a57a44f990501c66a  gcc/testsuite/ada/acats-4/tests/c3/c390a020.a
! 4282bd0ba35b056f1611e8c863c8745e  gcc/testsuite/ada/acats-4/tests/c3/c390a021.a
! cf96da721f34cf963ac9c04fdedb4a5a  gcc/testsuite/ada/acats-4/tests/c3/c390a022.am
! 9cc816e53154c542095db060de988727  gcc/testsuite/ada/acats-4/tests/c3/c390a030.a
! a2ad2209c88d74fd376c9daf08c00e0c  gcc/testsuite/ada/acats-4/tests/c3/c390a031.am
! 40bd1c7f8a70fb208644304788e8bdc6  gcc/testsuite/ada/acats-4/tests/c3/c391001.a
! 2dc32344161fe05900a7d0a4fb00a90b  gcc/testsuite/ada/acats-4/tests/c3/c391002.a
! 3ba7e427374883e2149341da53946561  gcc/testsuite/ada/acats-4/tests/c3/c391003.a
! 1cea1692179d434f0ff9e71ba3af5c1e  gcc/testsuite/ada/acats-4/tests/c3/c392002.a
! 918e8c097a09a06159f2809df40a1418  gcc/testsuite/ada/acats-4/tests/c3/c392003.a
! 65856b8c6fecfcf755607b20116e49ef  gcc/testsuite/ada/acats-4/tests/c3/c392004.a
! add1a6bb172c420d5b75dd9efb48c6bd  gcc/testsuite/ada/acats-4/tests/c3/c392005.a
! 1e3c83f529cb7a93f087fd5e1d1c8da3  gcc/testsuite/ada/acats-4/tests/c3/c392008.a
! 8db6e39b87567029879790dbb400a21a  gcc/testsuite/ada/acats-4/tests/c3/c392010.a
! 8063c17c7054236de05a0d6a56818802  gcc/testsuite/ada/acats-4/tests/c3/c392011.a
! 66f6cf830b25e4cba2aeaac6801b02e2  gcc/testsuite/ada/acats-4/tests/c3/c392013.a
! 3597acb12cde69e45603917fc97c80c0  gcc/testsuite/ada/acats-4/tests/c3/c392014.a
! 37df1e5c85d31f578424e4da3238380f  gcc/testsuite/ada/acats-4/tests/c3/c392015.a
! 35f1f390e8606d404b61bb05a639d3be  gcc/testsuite/ada/acats-4/tests/c3/c392a01.a
! ddeb268075e3a716a055f61676497b78  gcc/testsuite/ada/acats-4/tests/c3/c392c05.a
! ee8edde3e11e29c877773403259133c0  gcc/testsuite/ada/acats-4/tests/c3/c392c07.a
! cf19325c05dcb02f4dc60d58ef26ea2b  gcc/testsuite/ada/acats-4/tests/c3/c392d01.a
! acfb41d6d4b4fdec20be56da91d7037d  gcc/testsuite/ada/acats-4/tests/c3/c392d02.a
! 1db19d15d9fdd4071bc438e73f6c5f60  gcc/testsuite/ada/acats-4/tests/c3/c392d03.a
! 9913afe2e224eb447dd2ba6e7b6cd62d  gcc/testsuite/ada/acats-4/tests/c3/c393001.a
! cb66f262f22e933b78a4b4ff7f314ebb  gcc/testsuite/ada/acats-4/tests/c3/c393007.a
! fa7a91fbda6d3ec270401392bfa2a76e  gcc/testsuite/ada/acats-4/tests/c3/c393008.a
! 725749e586aef7b3172e0a9f654508c9  gcc/testsuite/ada/acats-4/tests/c3/c393009.a
! 21bc1c6b2b56e0fe4e98a124b3a43036  gcc/testsuite/ada/acats-4/tests/c3/c393010.a
! cd6d2722ead0dbebda558b3eed5c7ca4  gcc/testsuite/ada/acats-4/tests/c3/c393011.a
! 7df68c4f3488082bba3f1654a9ba7910  gcc/testsuite/ada/acats-4/tests/c3/c393012.a
! 7a6224b076104b0746f9373372e9765f  gcc/testsuite/ada/acats-4/tests/c3/c393013.a
! 5bf5e79116361f7f6818018607c7b14c  gcc/testsuite/ada/acats-4/tests/c3/c393a02.a
! 46faa2017a32e6ba0d55237311c2594b  gcc/testsuite/ada/acats-4/tests/c3/c393a03.a
! eafd936400d5d6d12f0163e2eddfac6b  gcc/testsuite/ada/acats-4/tests/c3/c393a05.a
! db0cccf9a144062cc832a2649c8b3890  gcc/testsuite/ada/acats-4/tests/c3/c393a06.a
! 8714b97cca38041a9f7e9366aef2ea6f  gcc/testsuite/ada/acats-4/tests/c3/c393b12.a
! 7035657702431ed63b2d07b818986f02  gcc/testsuite/ada/acats-4/tests/c3/c393b13.a
! 53c07ae14d9fb175ce43218b1e343038  gcc/testsuite/ada/acats-4/tests/c3/c393b14.a
! f5434c7e784d26f4723543d890baf070  gcc/testsuite/ada/acats-4/tests/c3/c394001.a
! f0d03a4cc11f4c5a3e849900d93ce5b5  gcc/testsuite/ada/acats-4/tests/c3/c394002.a
! bd76c737ec2888a6256a5b5fc62f5044  gcc/testsuite/ada/acats-4/tests/c3/c394003.a
! c2ac600ac5856ef7dd1dbc9289ad5b3a  gcc/testsuite/ada/acats-4/tests/c3/c3a0001.a
! 031b3fc5f0a32a51bded67c7ecc17317  gcc/testsuite/ada/acats-4/tests/c3/c3a0002.a
! c31f440d35b722f58fbb9350b06d125c  gcc/testsuite/ada/acats-4/tests/c3/c3a0003.a
! 2297f4ac861d78f2371edd9c4a2d7c6c  gcc/testsuite/ada/acats-4/tests/c3/c3a0004.a
! 32ac31994b6e97c7cfc3da69b63041ca  gcc/testsuite/ada/acats-4/tests/c3/c3a0005.a
! d86e5a6cc083a8024c11012097ddad34  gcc/testsuite/ada/acats-4/tests/c3/c3a0006.a
! 27a88a8b1aa1655fbfad671608eb6590  gcc/testsuite/ada/acats-4/tests/c3/c3a0007.a
! 2c75b971c54a5abc55846c25177a2d32  gcc/testsuite/ada/acats-4/tests/c3/c3a0008.a
! 0b8bb10fc6969853e244dca2a5176000  gcc/testsuite/ada/acats-4/tests/c3/c3a0009.a
! ed1e9211c87a814c4afe091b58de454c  gcc/testsuite/ada/acats-4/tests/c3/c3a0010.a
! e9e7d7fe8183ee50353cfccbd67ce241  gcc/testsuite/ada/acats-4/tests/c3/c3a0011.a
! c7fcc74fd4dfdbaffcb6c91b90a50060  gcc/testsuite/ada/acats-4/tests/c3/c3a00120.a
! 74ba294edd61c27b3a700c248bd041e9  gcc/testsuite/ada/acats-4/tests/c3/c3a00121.a
! b5687449024e6ae74c2b54cbbf12b721  gcc/testsuite/ada/acats-4/tests/c3/c3a00122.am
! e7d92335b6aec84b884e9a11162a306e  gcc/testsuite/ada/acats-4/tests/c3/c3a0013.a
! 8ada1257de16782d00affbb40cba5d0f  gcc/testsuite/ada/acats-4/tests/c3/c3a0014.a
! cbdd24e39ac8fba7e5ea4a0975d79298  gcc/testsuite/ada/acats-4/tests/c3/c3a0015.a
! 83572022417c237e0bb0551e51f4f09a  gcc/testsuite/ada/acats-4/tests/c3/c3a0016.a
! aea69c4eb5f92d59235f2df23e757d14  gcc/testsuite/ada/acats-4/tests/c3/c3a0017.a
! 62fa1c6bf50ac7e11e6bad46452e79ef  gcc/testsuite/ada/acats-4/tests/c3/c3a0018.a
! 4027e27b87c42473853d2165e05c8e0f  gcc/testsuite/ada/acats-4/tests/c3/c3a0019.a
! c8eec5b6a8cb02fdf4b8fc3672950275  gcc/testsuite/ada/acats-4/tests/c3/c3a0020.a
! 876c4cbf6611f889104d7b0572ae8147  gcc/testsuite/ada/acats-4/tests/c3/c3a0021.a
! 05a5719220f88bc16adf5f7d5f2eb478  gcc/testsuite/ada/acats-4/tests/c3/c3a0022.a
! d395a766d1e83cd40c121d287e8dc401  gcc/testsuite/ada/acats-4/tests/c3/c3a0023.a
! 18c72364756781cf037aaa928e0aaf6b  gcc/testsuite/ada/acats-4/tests/c3/c3a0024.a
! 5b7c36b7749cfc424cb0c256201cf255  gcc/testsuite/ada/acats-4/tests/c3/c3a0025.a
! 87c70d07250a7103f096a337328bbc92  gcc/testsuite/ada/acats-4/tests/c3/c3a0026.a
! 607293a26ce7e3e441968e95c9ccbba2  gcc/testsuite/ada/acats-4/tests/c3/c3a0027.a
! 2ddeb89db87fb985e7c9ddfcf080e693  gcc/testsuite/ada/acats-4/tests/c3/c3a0028.a
! f14f848057f112325d4e46ed85b5c3c7  gcc/testsuite/ada/acats-4/tests/c3/c3a0029.a
! 02f44410384ce0414b2ff6c941fa903a  gcc/testsuite/ada/acats-4/tests/c3/c3a0030.a
! 21ce522f0e81e68685347a0f9b6064f3  gcc/testsuite/ada/acats-4/tests/c3/c3a1001.a
! 03f9fa0b3ade6732c9e7b1792aa29352  gcc/testsuite/ada/acats-4/tests/c3/c3a1002.a
! 43871a0be958bf53238bf04d1e2b1d12  gcc/testsuite/ada/acats-4/tests/c3/c3a10030.a
! b3b07306d7f9eff4f7e6b0429dcaa05d  gcc/testsuite/ada/acats-4/tests/c3/c3a10031.a
! c879db4cb5243e89cd9eec2822afcfe2  gcc/testsuite/ada/acats-4/tests/c3/c3a10032.am
! cafc593ae60aa9bc20c17d81fae12d87  gcc/testsuite/ada/acats-4/tests/c3/c3a10040.a
! e3bbd65bb943a5000a14047b45073b7b  gcc/testsuite/ada/acats-4/tests/c3/c3a10041.a
! 10fc1a3d9cf835e1deccb8f31b08c78d  gcc/testsuite/ada/acats-4/tests/c3/c3a10042.am
! c6642560f187f450721fda5468cd07bb  gcc/testsuite/ada/acats-4/tests/c3/c3a1005.a
! 73e86224d17f2a8956a1d528195701e5  gcc/testsuite/ada/acats-4/tests/c3/c3a2001.a
! e2d17cf34da20dd63f46abc38e9461f2  gcc/testsuite/ada/acats-4/tests/c3/c3a2002.a
! 3c24e7e447372dec84c3b1cf5f273936  gcc/testsuite/ada/acats-4/tests/c3/c3a2003.a
! cbeca93d733582989633f82f0909acae  gcc/testsuite/ada/acats-4/tests/c3/c3a2004.a
! cddb5c363c31a2ba7b970cf9dc8e3f5e  gcc/testsuite/ada/acats-4/tests/c3/c3a2a01.a
! 4247f0b657aa158ef18c1318e9dc8b84  gcc/testsuite/ada/acats-4/tests/c3/c3a2a02.a
! 383d36d8bd8f651b81f9f034c79f6395  gcc/testsuite/ada/acats-4/tests/c4/c410001.a
! dc852bc88874efd64494341e97b01bfb  gcc/testsuite/ada/acats-4/tests/c4/c41101d.ada
! 6f5f34a6a9fa1d906503ce64081a9fb1  gcc/testsuite/ada/acats-4/tests/c4/c41103a.ada
! b5e4896d791e9edb4152659fc6403ac3  gcc/testsuite/ada/acats-4/tests/c4/c41103b.ada
! 820fca3a12cccc477a1db295b46c9e89  gcc/testsuite/ada/acats-4/tests/c4/c41104a.ada
! fdbf47ad957484b7d85a3373d756e376  gcc/testsuite/ada/acats-4/tests/c4/c41105a.ada
! c4087c229334ce4727fc90657340bea6  gcc/testsuite/ada/acats-4/tests/c4/c41107a.ada
! 0f8bb517ec2fe5d8ad9dd8f9fcdca333  gcc/testsuite/ada/acats-4/tests/c4/c41201d.ada
! 381cd3656ffd77067260c0426caad8e4  gcc/testsuite/ada/acats-4/tests/c4/c41203a.ada
! ad6cf2964a900435614399bbbe277e42  gcc/testsuite/ada/acats-4/tests/c4/c41203b.ada
! 9fbde81e21b268a632cd32dc4a99df30  gcc/testsuite/ada/acats-4/tests/c4/c41204a.ada
! 67fa52580bd829764d9438c881578136  gcc/testsuite/ada/acats-4/tests/c4/c41205a.ada
! 7dca543b0fdeefd218298ca3512d4136  gcc/testsuite/ada/acats-4/tests/c4/c41206a.ada
! 3ab9c169397fc23560a200fb693450fe  gcc/testsuite/ada/acats-4/tests/c4/c41207a.ada
! 17ad22489b459a058eeaf34546fec768  gcc/testsuite/ada/acats-4/tests/c4/c413001.a
! 1b052069034494eeefbb85b95881f7e7  gcc/testsuite/ada/acats-4/tests/c4/c413002.a
! 040de4201fd72e9de123fa9a2143c41d  gcc/testsuite/ada/acats-4/tests/c4/c413003.a
! 4b2fa1ff66b48b9350d8ab977de55848  gcc/testsuite/ada/acats-4/tests/c4/c413004.a
! 6bd3f248a03f035ba1437d5a541753e0  gcc/testsuite/ada/acats-4/tests/c4/c413005.a
! 2615eb7f6f28583edf200225c397e372  gcc/testsuite/ada/acats-4/tests/c4/c413006.a
! a245026cc4c00eb8a44aa405addb8cb8  gcc/testsuite/ada/acats-4/tests/c4/c413007.a
! 20522dfe7bf33e5e0e855924df96c08e  gcc/testsuite/ada/acats-4/tests/c4/c41301a.ada
! dae21e7962c8e72b1b61657cc9649578  gcc/testsuite/ada/acats-4/tests/c4/c41303a.ada
! b50a855a96988b73e7f3549240854176  gcc/testsuite/ada/acats-4/tests/c4/c41303b.ada
! 2616024a5ab75311dd3da9466dfeb83f  gcc/testsuite/ada/acats-4/tests/c4/c41303c.ada
! 71212110be4b03b467bc38a722d121d1  gcc/testsuite/ada/acats-4/tests/c4/c41303e.ada
! 66cc6334eba1dfed1e235d86203cb20f  gcc/testsuite/ada/acats-4/tests/c4/c41303f.ada
! 924b3910bb06953e81b618bc3e559550  gcc/testsuite/ada/acats-4/tests/c4/c41303g.ada
! 045ed81e249f894170b499df2db286d6  gcc/testsuite/ada/acats-4/tests/c4/c41303i.ada
! aa4db5f52bbfc36e5c975658ef97c89a  gcc/testsuite/ada/acats-4/tests/c4/c41303j.ada
! 0f31fc1511244c83e7abb4baeac80671  gcc/testsuite/ada/acats-4/tests/c4/c41303k.ada
! f9b758389317dc92073ce01c3c275e91  gcc/testsuite/ada/acats-4/tests/c4/c41303m.ada
! 71a865e9509e3725fd95b90ec715eaa7  gcc/testsuite/ada/acats-4/tests/c4/c41303n.ada
! 8981d1c2da09086d412019a04cc8c913  gcc/testsuite/ada/acats-4/tests/c4/c41303o.ada
! 2dda9c55735424d40aed9757f7a99849  gcc/testsuite/ada/acats-4/tests/c4/c41303q.ada
! e34e7a4a5a5ba93bc9916cceeaecc9e6  gcc/testsuite/ada/acats-4/tests/c4/c41303r.ada
! 7030e6ee5fb5761b449dbb4ff5a07765  gcc/testsuite/ada/acats-4/tests/c4/c41303s.ada
! d79eb627645d3853ea5140161ae28128  gcc/testsuite/ada/acats-4/tests/c4/c41303u.ada
! bb6f238e4a4ba7e7e7d4a81bc419e03c  gcc/testsuite/ada/acats-4/tests/c4/c41303v.ada
! 30d2340bbbbe2276772e1fb63e33b4ce  gcc/testsuite/ada/acats-4/tests/c4/c41303w.ada
! 98d29cda44e41c5ff7947a4026f5e44c  gcc/testsuite/ada/acats-4/tests/c4/c41304a.ada
! 185701022ded3608ce413730986fd29a  gcc/testsuite/ada/acats-4/tests/c4/c41304b.ada
! 5dd0f98f04759d0b25f9631bb3f052ba  gcc/testsuite/ada/acats-4/tests/c4/c41306b.ada
! 58245b98892f05598c91a37cc2fa0cf7  gcc/testsuite/ada/acats-4/tests/c4/c41306c.ada
! 78cff154ce4ec882d604897c85256a6f  gcc/testsuite/ada/acats-4/tests/c4/c41307d.ada
! e4f57f60d8ab4020fa02081676cd97b1  gcc/testsuite/ada/acats-4/tests/c4/c41309a.ada
! 46615dd040a05118f00cf1a6c269abf8  gcc/testsuite/ada/acats-4/tests/c4/c41320a.ada
! c87207608b642d6c0770b2213faa6f37  gcc/testsuite/ada/acats-4/tests/c4/c41321a.ada
! a2f1c6ef57f73e8afee4331c2f6b8836  gcc/testsuite/ada/acats-4/tests/c4/c41322a.ada
! 5fe80e1ed0d397d7243803f3679b1dcf  gcc/testsuite/ada/acats-4/tests/c4/c41323a.ada
! 1b628d4729417b726825d3cc545cce88  gcc/testsuite/ada/acats-4/tests/c4/c41324a.ada
! 34bb464a9c0edf77ba3cf3f225f84fac  gcc/testsuite/ada/acats-4/tests/c4/c41325a.ada
! 9f472b4f812b18261355bfdb272afaf2  gcc/testsuite/ada/acats-4/tests/c4/c41326a.ada
! c79f530e375e47fc23508a767283386e  gcc/testsuite/ada/acats-4/tests/c4/c41327a.ada
! 9dbb72dcbb910f44662d1091a9dcff76  gcc/testsuite/ada/acats-4/tests/c4/c41328a.ada
! 0449520de7d65d45ed1daf5ca0e4569b  gcc/testsuite/ada/acats-4/tests/c4/c41401a.ada
! 20918a0804a04dce0cbb4d97b451bb81  gcc/testsuite/ada/acats-4/tests/c4/c41402a.ada
! 3d9dc352053f7bb2142de6aadd56af67  gcc/testsuite/ada/acats-4/tests/c4/c41404a.ada
! 8db297c25e467dbfb8c1a1314bd34ba8  gcc/testsuite/ada/acats-4/tests/c4/c416a01.a
! fab54e5e65dd04a9765d38b24bdf4159  gcc/testsuite/ada/acats-4/tests/c4/c416a02.a
! 3472f5561c379717f19af41f64bf38a3  gcc/testsuite/ada/acats-4/tests/c4/c420001.a
! 837ffbb47c098000329e8e489cfada64  gcc/testsuite/ada/acats-4/tests/c4/c42006a.ada
! 3930cedf9786c67a42558e65e855c7fd  gcc/testsuite/ada/acats-4/tests/c4/c42007e.ada
! fdfa37c01ec576b222ad3107e9e17cd2  gcc/testsuite/ada/acats-4/tests/c4/c43003a.ada
! 42c7528eba63811a5183af811bdf7a65  gcc/testsuite/ada/acats-4/tests/c4/c43004a.ada
! fdfe754e9fba94c879707660c35c89c4  gcc/testsuite/ada/acats-4/tests/c4/c43004c.ada
! d381bf2fc72e35825723db4655f3c38a  gcc/testsuite/ada/acats-4/tests/c4/c431001.a
! 7c6edfdcc48d25502cc1a4cf90a36ee9  gcc/testsuite/ada/acats-4/tests/c4/c431002.a
! 4620a9eba6c3761c47e07023e4fac68a  gcc/testsuite/ada/acats-4/tests/c4/c431003.a
! ce966d18555ebee9c5839d96e0ba9dab  gcc/testsuite/ada/acats-4/tests/c4/c431004.a
! 841914115d2e37bfbd84574493c7019f  gcc/testsuite/ada/acats-4/tests/c4/c43103a.ada
! dd65d5f3b06487b888840af62334c5a5  gcc/testsuite/ada/acats-4/tests/c4/c43103b.ada
! 9e71b6045390013211406d2c1bfb4fba  gcc/testsuite/ada/acats-4/tests/c4/c43104a.ada
! 85abcc7f64ed7b42d6fd3f22c7daeb40  gcc/testsuite/ada/acats-4/tests/c4/c43105a.ada
! 4ed22cb91cfe0bda94598dd26ceb9c7c  gcc/testsuite/ada/acats-4/tests/c4/c43105b.ada
! baec9aa149293739f6e8ceac8325d7a0  gcc/testsuite/ada/acats-4/tests/c4/c43106a.ada
! 1d531018ee649629c5a7552829150451  gcc/testsuite/ada/acats-4/tests/c4/c43107a.ada
! 05a638c334196cb191ee5128a5996f23  gcc/testsuite/ada/acats-4/tests/c4/c43108a.ada
! debcbaad0b35de45ea6e4b666eeea609  gcc/testsuite/ada/acats-4/tests/c4/c431a01.a
! 0f4afa9a95b97dc847470380efc90532  gcc/testsuite/ada/acats-4/tests/c4/c431a02.a
! 65063fafd01ba653c15d798991e31ea3  gcc/testsuite/ada/acats-4/tests/c4/c431a03.a
! 4ea1f6b615b7799500e7c6933df91e82  gcc/testsuite/ada/acats-4/tests/c4/c432001.a
! 1e73ca84bb526fa8947ec4278f0151ed  gcc/testsuite/ada/acats-4/tests/c4/c432002.a
! 6ec2ee48b603324015bd74c07d8eb9fb  gcc/testsuite/ada/acats-4/tests/c4/c432003.a
! 8e738d9db0574dd56f1158230f5caa4c  gcc/testsuite/ada/acats-4/tests/c4/c432004.a
! ccee6b8b7bc155051a378848cc247ecb  gcc/testsuite/ada/acats-4/tests/c4/c432005.a
! ee94ed306c9c2f72d0f353f3242a51db  gcc/testsuite/ada/acats-4/tests/c4/c43204a.ada
! e98c1830d22cb2c31e6c97a0f3d96ad7  gcc/testsuite/ada/acats-4/tests/c4/c43204c.ada
! f0b2f2ebf435459bab0ed10112cc18b6  gcc/testsuite/ada/acats-4/tests/c4/c43204e.ada
! 7e74d89a8654aef2ebf093dc84b24d10  gcc/testsuite/ada/acats-4/tests/c4/c43204f.ada
! b266b1d1eaefa26342ce7e3c0eb10f20  gcc/testsuite/ada/acats-4/tests/c4/c43204g.ada
! 119509db1b0027b3597be4ca5abbb5bb  gcc/testsuite/ada/acats-4/tests/c4/c43204h.ada
! 67b7aebfc7ddaa75b105ec0d3e496a27  gcc/testsuite/ada/acats-4/tests/c4/c43204i.ada
! 73152cdcaa60874a7dd488590fdf9d5c  gcc/testsuite/ada/acats-4/tests/c4/c43205a.ada
! 64f982d0a7b18107f1762424333a65d3  gcc/testsuite/ada/acats-4/tests/c4/c43205b.ada
! ac552917303ade3bcc90b97b15f26e94  gcc/testsuite/ada/acats-4/tests/c4/c43205c.ada
! fb0c33a9daed1c4f2a00c26e9de3c09c  gcc/testsuite/ada/acats-4/tests/c4/c43205d.ada
! d9e706d3db07df4098bbb0e033aed012  gcc/testsuite/ada/acats-4/tests/c4/c43205e.ada
! 4f3634691d02036c149cdd006248ffe1  gcc/testsuite/ada/acats-4/tests/c4/c43205g.ada
! 5c21ffd092ad83125d058e3179c4d1bf  gcc/testsuite/ada/acats-4/tests/c4/c43205h.ada
! bf224ac40af0ffe5b844895ae6ae977a  gcc/testsuite/ada/acats-4/tests/c4/c43205i.ada
! 80a79cdbdb7c8185dcf0428e7589a584  gcc/testsuite/ada/acats-4/tests/c4/c43205j.ada
! 7914df26e752133b470cdb5c585686bc  gcc/testsuite/ada/acats-4/tests/c4/c43205k.ada
! cbadb73b68d71709f2becaa6f356064c  gcc/testsuite/ada/acats-4/tests/c4/c43206a.ada
! 0fc8105e29d6d23a3a7ddd6510322795  gcc/testsuite/ada/acats-4/tests/c4/c43207b.ada
! 97244c88eb0cfebd12378341cddfcf4f  gcc/testsuite/ada/acats-4/tests/c4/c43207d.ada
! f288bdf0f019b0e6deea7f364629093d  gcc/testsuite/ada/acats-4/tests/c4/c43208a.ada
! 99521b78f4e58d62e65acd17c5306220  gcc/testsuite/ada/acats-4/tests/c4/c43208b.ada
! 36f70dc294058acb31101eb9c245937b  gcc/testsuite/ada/acats-4/tests/c4/c43209a.ada
! 31cacbf3a20b821f6eb8f1d74586a51b  gcc/testsuite/ada/acats-4/tests/c4/c43210a.ada
! 54b7270b96a5d5519d2358a1b98bf7af  gcc/testsuite/ada/acats-4/tests/c4/c43211a.ada
! a692660520b9e289a7f0ae27c6d52494  gcc/testsuite/ada/acats-4/tests/c4/c43212a.ada
! c43685e66248fa05c959fb5d231800a7  gcc/testsuite/ada/acats-4/tests/c4/c43212c.ada
! 9427f327bd00f1850a52dc14567dbf4e  gcc/testsuite/ada/acats-4/tests/c4/c43214a.ada
! 2b1a3e33f54f7510083e41b401c3befb  gcc/testsuite/ada/acats-4/tests/c4/c43214b.ada
! 579da18e7294b44fdfc2fb550cccdbf3  gcc/testsuite/ada/acats-4/tests/c4/c43214c.ada
! 506424b9dbd9ff75e61b488ce4a5879e  gcc/testsuite/ada/acats-4/tests/c4/c43214d.ada
! 02fcbb175ddd0a1d8c5564d22bf12428  gcc/testsuite/ada/acats-4/tests/c4/c43214e.ada
! 34cd6d7cf5c8038e227dde683b30b50f  gcc/testsuite/ada/acats-4/tests/c4/c43214f.ada
! ab7bedd7c7899bfe816d9a4b9ac394d4  gcc/testsuite/ada/acats-4/tests/c4/c43215a.ada
! 90e0f447154023e2eab627e883738386  gcc/testsuite/ada/acats-4/tests/c4/c43215b.ada
! f0098152f11a322c39c1479f279dc3d7  gcc/testsuite/ada/acats-4/tests/c4/c43222a.ada
! bf1baa8817f6afb1d613db2046cb78de  gcc/testsuite/ada/acats-4/tests/c4/c43224a.ada
! 1e8e32f41f79462323a2f9d9c83d7939  gcc/testsuite/ada/acats-4/tests/c4/c433001.a
! 53871e7c64c41df52983f42504e65ab9  gcc/testsuite/ada/acats-4/tests/c4/c433002.a
! fc22bce48d36a001afa61fcfb22be460  gcc/testsuite/ada/acats-4/tests/c4/c433003.a
! 8638b56212b2480f3a9c035d904df662  gcc/testsuite/ada/acats-4/tests/c4/c433004.a
! fdeb85a1ac15afc69e41a42e68db5c9d  gcc/testsuite/ada/acats-4/tests/c4/c433005.a
! a7aeb76317f06567f6b44cb0b94ba9d9  gcc/testsuite/ada/acats-4/tests/c4/c433006.a
! 21e51f8d9002c30c3170d096a931ddb8  gcc/testsuite/ada/acats-4/tests/c4/c433007.a
! 493a8023e1e31054060d4af24ec45625  gcc/testsuite/ada/acats-4/tests/c4/c433008.a
! 6be8523b2e0ccefb268613fe395421ca  gcc/testsuite/ada/acats-4/tests/c4/c433a01.a
! f2b5faadf7994318ad86d30f5d297c77  gcc/testsuite/ada/acats-4/tests/c4/c433a02.a
! e758c7c2655902abd75371fb1d06411d  gcc/testsuite/ada/acats-4/tests/c4/c433a03.a
! 43d476ccf0baa3b45d12a181f1801d72  gcc/testsuite/ada/acats-4/tests/c4/c433a04.a
! 196c158a32a4bc1774a4d934b1a6632e  gcc/testsuite/ada/acats-4/tests/c4/c44003d.ada
! bf440c6d6ead3b13b20d4e127607337e  gcc/testsuite/ada/acats-4/tests/c4/c44003f.ada
! 2f9030320131a08536fa11fa1a117664  gcc/testsuite/ada/acats-4/tests/c4/c44003g.ada
! 62ba7a9a25d025dad4ded263e64d8380  gcc/testsuite/ada/acats-4/tests/c4/c450001.a
! b3687aae227c95d084c9f685c9ca4c80  gcc/testsuite/ada/acats-4/tests/c4/c45112a.ada
! c7c3ba0d233fb51ade68d7651dd47189  gcc/testsuite/ada/acats-4/tests/c4/c45112b.ada
! 49306dfa2cb372d1d65b4dd7a47c19e5  gcc/testsuite/ada/acats-4/tests/c4/c45113a.ada
! aa0781fb6f24f86504e59a47cf77b3d6  gcc/testsuite/ada/acats-4/tests/c4/c45114b.ada
! ef35f5a0ba2b88cfb85776201f97275c  gcc/testsuite/ada/acats-4/tests/c4/c452001.a
! 3f5197645a6343dc1f808abd156058c3  gcc/testsuite/ada/acats-4/tests/c4/c452002.a
! 3842765bc0a9775ba6885e32c2011e12  gcc/testsuite/ada/acats-4/tests/c4/c452003.a
! 0ae54e3c32a1b328259604b29459b4e1  gcc/testsuite/ada/acats-4/tests/c4/c452004.a
! 840ffc30b1a13681a76761f357af611e  gcc/testsuite/ada/acats-4/tests/c4/c452005.a
! 090b89bd80d0774f20c19f80a89d934c  gcc/testsuite/ada/acats-4/tests/c4/c452006.a
! 20ba3c7cde16d8bed844c4e64cd33e56  gcc/testsuite/ada/acats-4/tests/c4/c45201a.ada
! 6d4a1adb58c6e8ef73b34a324604ede4  gcc/testsuite/ada/acats-4/tests/c4/c45201b.ada
! 72aed4b6ea2fe7dfc0a9fdf3bede3751  gcc/testsuite/ada/acats-4/tests/c4/c45202b.ada
! 84d744855e2972095386f0e272333a6a  gcc/testsuite/ada/acats-4/tests/c4/c45210a.ada
! 91f826ce1d8f6889145f46e4c0ccada9  gcc/testsuite/ada/acats-4/tests/c4/c45211a.ada
! fe9117190ab93e4bd66b4015bb5cdba1  gcc/testsuite/ada/acats-4/tests/c4/c45220a.ada
! 6912810853452af0c8935cfd387c8df5  gcc/testsuite/ada/acats-4/tests/c4/c45220b.ada
! b394f131a9012e7c03cfd9636d737e6d  gcc/testsuite/ada/acats-4/tests/c4/c45220c.ada
! ccf331c469a0927819e1eb56e4e00429  gcc/testsuite/ada/acats-4/tests/c4/c45220d.ada
! 88d3a9ace4677cd3c025906371d2beeb  gcc/testsuite/ada/acats-4/tests/c4/c45220e.ada
! bba84a4055dd7c551f067e52bbe462e1  gcc/testsuite/ada/acats-4/tests/c4/c45220f.ada
! c13eaf9a516abfe2b6beda77dc2e3911  gcc/testsuite/ada/acats-4/tests/c4/c45231a.ada
! 2cca7d5fea02ce521f28a33db34ffa3d  gcc/testsuite/ada/acats-4/tests/c4/c45231b.dep
! 1bee766d69082269378c86e19c8abe85  gcc/testsuite/ada/acats-4/tests/c4/c45231c.dep
! a1bdfcd8a7def7dd624d3536e8905d30  gcc/testsuite/ada/acats-4/tests/c4/c45231d.tst
! 911d91bbd63a8c74f621846268c3e576  gcc/testsuite/ada/acats-4/tests/c4/c45232b.ada
! 4de95534392888683c8404eeeed6cc46  gcc/testsuite/ada/acats-4/tests/c4/c45242b.ada
! f2b98c822abe0cd6885e5b49561ac387  gcc/testsuite/ada/acats-4/tests/c4/c45251a.ada
! 94a924601ada615360bec26fb5450efb  gcc/testsuite/ada/acats-4/tests/c4/c45252a.ada
! debd13ddcb22bdcbb8a02c69693b66f8  gcc/testsuite/ada/acats-4/tests/c4/c45252b.ada
! ac031704393af45bbba41661aa36f2aa  gcc/testsuite/ada/acats-4/tests/c4/c45253a.ada
! fc9f55680d3672e261c2346c11b8ac30  gcc/testsuite/ada/acats-4/tests/c4/c45262a.ada
! c4104ba41f3003933d2540d2f946ba70  gcc/testsuite/ada/acats-4/tests/c4/c45262b.ada
! 8b9cb8019cc36523ada4859ea4a5d16a  gcc/testsuite/ada/acats-4/tests/c4/c45262c.ada
! d03448ead4d0effaab3998536c97bf20  gcc/testsuite/ada/acats-4/tests/c4/c45262d.ada
! f5c2479fb34a68704e8a8cc34f61a360  gcc/testsuite/ada/acats-4/tests/c4/c45264a.ada
! b5849bcd08a3c2d9a5d0c2b9e7a3cddd  gcc/testsuite/ada/acats-4/tests/c4/c45264b.ada
! 8f21912f6834298744357d557cb137f0  gcc/testsuite/ada/acats-4/tests/c4/c45264c.ada
! adc3cff25d9a3d6a8177af01212d7415  gcc/testsuite/ada/acats-4/tests/c4/c45265a.ada
! c4c6e9f92d1c15ec8a4b8f04c34a693f  gcc/testsuite/ada/acats-4/tests/c4/c45271a.ada
! c72a97f0fec20bbb08fc4517b6ddc788  gcc/testsuite/ada/acats-4/tests/c4/c45272a.ada
! 6b2a1a4bc714bd568da120c02fbf1702  gcc/testsuite/ada/acats-4/tests/c4/c45273a.ada
! b79ca71dc3632b190bdef98c6e0d142b  gcc/testsuite/ada/acats-4/tests/c4/c45274a.ada
! 9855409d4983ad2c1546e338fcbd0706  gcc/testsuite/ada/acats-4/tests/c4/c45274b.ada
! 435926faf09e9e479e1b1f272c13a333  gcc/testsuite/ada/acats-4/tests/c4/c45274c.ada
! 9115b9a51b29cec2f4c9ff1428f5a615  gcc/testsuite/ada/acats-4/tests/c4/c45281a.ada
! ecfe4965aad0d9bc1dc0dea01acceae3  gcc/testsuite/ada/acats-4/tests/c4/c45282a.ada
! 52a7cd2f9612b968a81d14f925d96de2  gcc/testsuite/ada/acats-4/tests/c4/c45282b.ada
! b3bd1b305af20f17ece9aabad0feaef1  gcc/testsuite/ada/acats-4/tests/c4/c45291a.ada
! 5e2f83b478139997a71df86ce9d1694c  gcc/testsuite/ada/acats-4/tests/c4/c452a01.a
! 35c49539c3030fd9c7c002e2fb0544cc  gcc/testsuite/ada/acats-4/tests/c4/c452a02.a
! 8af6afb2d8a0c30080274f19bc0dbbe8  gcc/testsuite/ada/acats-4/tests/c4/c452a03.a
! 7a35f848c66e3fbeaecff44f362c6d10  gcc/testsuite/ada/acats-4/tests/c4/c453001.a
! eaeb6ce37e830b736db8d34c6a83bb7d  gcc/testsuite/ada/acats-4/tests/c4/c45303a.ada
! f1ec15c9cdb65dbf13e1375cf7996f12  gcc/testsuite/ada/acats-4/tests/c4/c45304a.ada
! 55a19685b3e235e5bb6750cb9d7df962  gcc/testsuite/ada/acats-4/tests/c4/c45304b.dep
! b4c45f68d1219b0b994968a9828a7b17  gcc/testsuite/ada/acats-4/tests/c4/c45304c.dep
! 20fb36abf27afac504d4a771e7e63fd0  gcc/testsuite/ada/acats-4/tests/c4/c45322a.ada
! fab8bce97e1b74f5541c43ebbc38c44b  gcc/testsuite/ada/acats-4/tests/c4/c45323a.ada
! 0f09ca069bcacb950f308b51658fe4cf  gcc/testsuite/ada/acats-4/tests/c4/c45331a.ada
! 923c0cd8bc5f7a54a3ff10b7ecd3ae30  gcc/testsuite/ada/acats-4/tests/c4/c45342a.ada
! 4c687d4debfb2858cbde8d0598741375  gcc/testsuite/ada/acats-4/tests/c4/c45343a.ada
! fced8cf133a6e38c1bd3f44b383050a5  gcc/testsuite/ada/acats-4/tests/c4/c45344a.ada
! 046bf7cdbb7aeb33cdf0c17abb97726b  gcc/testsuite/ada/acats-4/tests/c4/c45345b.ada
! 1b975a926de8c5e1c1a8fd844dbfa809  gcc/testsuite/ada/acats-4/tests/c4/c45347a.ada
! 5c3a11fd88252878ac174be55d9cbe23  gcc/testsuite/ada/acats-4/tests/c4/c45347b.ada
! e7b0eaf3fab48f0c61a33030a45c9625  gcc/testsuite/ada/acats-4/tests/c4/c45347c.ada
! 5862189030beeea86b9e0d08e37c5f1a  gcc/testsuite/ada/acats-4/tests/c4/c45347d.ada
! 5a4ad439614a0b55cdeae637fcef3913  gcc/testsuite/ada/acats-4/tests/c4/c45411a.ada
! b55c932d505fe19faf48b3854f91bf92  gcc/testsuite/ada/acats-4/tests/c4/c45411b.dep
! cc45fca3dbdc169c3f8a8d219a8f3885  gcc/testsuite/ada/acats-4/tests/c4/c45411c.dep
! 92372898586e4be4330d20dabffa9b47  gcc/testsuite/ada/acats-4/tests/c4/c45411d.ada
! fdb465fedee3ebd743401e0c8899b0ce  gcc/testsuite/ada/acats-4/tests/c4/c45413a.ada
! fbd34bfae4961dda3c3e39ae18565fc8  gcc/testsuite/ada/acats-4/tests/c4/c45431a.ada
! bda2b940e9dc2584f9295b05e0c20b0f  gcc/testsuite/ada/acats-4/tests/c4/c455001.a
! 87ea1f3d7a54b6c25dba44fd5a571baa  gcc/testsuite/ada/acats-4/tests/c4/c45502b.dep
! 5a774d039f16514bc6a77bcf387d50ec  gcc/testsuite/ada/acats-4/tests/c4/c45502c.dep
! cc87ae3a223cabfed863304f12752609  gcc/testsuite/ada/acats-4/tests/c4/c45503a.ada
! dcadc5c668c2ff77de523cb7dba5b36a  gcc/testsuite/ada/acats-4/tests/c4/c45503b.dep
! 611398c2ae165df5a3f7381f660f52a0  gcc/testsuite/ada/acats-4/tests/c4/c45503c.dep
! f89268db15e37b030991c3827ca26c3e  gcc/testsuite/ada/acats-4/tests/c4/c45504a.ada
! f0cdb8c22aab2695a23fd98a373755b2  gcc/testsuite/ada/acats-4/tests/c4/c45504b.dep
! b8b4e008dfce1ee201519835a1fa50b8  gcc/testsuite/ada/acats-4/tests/c4/c45504c.dep
! ce29dbe3d5204283efb96dbcdfd5aac5  gcc/testsuite/ada/acats-4/tests/c4/c45504d.ada
! 10c91d5e233ba13218dcd66fb790a7be  gcc/testsuite/ada/acats-4/tests/c4/c45504e.dep
! 92f6aea3aed6ba9df5385c22f904ba43  gcc/testsuite/ada/acats-4/tests/c4/c45504f.dep
! 0059f05c198e829fac48965c13f56c08  gcc/testsuite/ada/acats-4/tests/c4/c45505a.ada
! 47a4e48ddd2b3df3c7eb949e7d6692a8  gcc/testsuite/ada/acats-4/tests/c4/c45523a.ada
! 17fdb2a59175aad9fef05c8cab8509e5  gcc/testsuite/ada/acats-4/tests/c4/c45531a.ada
! b8d549a63a2c40e579c8ed0a817ba1b3  gcc/testsuite/ada/acats-4/tests/c4/c45531b.ada
! c131684e4763854670c42c2112418109  gcc/testsuite/ada/acats-4/tests/c4/c45531c.ada
! c584d6f3f281816f1bd157cd8cc6b33a  gcc/testsuite/ada/acats-4/tests/c4/c45531d.ada
! 29ba7e7c1042d7979b1c75938b61e862  gcc/testsuite/ada/acats-4/tests/c4/c45531e.ada
! 47ea14530564cd8e06520e03e074efb3  gcc/testsuite/ada/acats-4/tests/c4/c45531f.ada
! 974ec868d7bcf66f2a14b7a4e70541b0  gcc/testsuite/ada/acats-4/tests/c4/c45531g.ada
! be8ef1a126f5c01246a9b635558e69ed  gcc/testsuite/ada/acats-4/tests/c4/c45531h.ada
! a795638c4621469321aa1212fd6bc01b  gcc/testsuite/ada/acats-4/tests/c4/c45531i.ada
! 8e8dbc1f05d26be72eaaaaca136d57b8  gcc/testsuite/ada/acats-4/tests/c4/c45531j.ada
! f7420a86d16f0dda550ad66d998500fa  gcc/testsuite/ada/acats-4/tests/c4/c45531k.ada
! de637dfbdf31186f46f1f622a7b31d52  gcc/testsuite/ada/acats-4/tests/c4/c45531l.ada
! 991294aff87680d765e6feb5cca5b1b5  gcc/testsuite/ada/acats-4/tests/c4/c45531m.dep
! 0494b2e93ef765b57a27be6b00246238  gcc/testsuite/ada/acats-4/tests/c4/c45531n.dep
! be4ab72a6216470b4aa0865525f98461  gcc/testsuite/ada/acats-4/tests/c4/c45531o.dep
! bb7d5366acda158c30e39d3074242262  gcc/testsuite/ada/acats-4/tests/c4/c45531p.dep
! 1328509e95f292ea980a979dedb08b47  gcc/testsuite/ada/acats-4/tests/c4/c45532a.ada
! 59f6ce63685d98c434d1a7af9b67d1f3  gcc/testsuite/ada/acats-4/tests/c4/c45532b.ada
! fe5a8b5f9204d89a9d208c19a93b7bbf  gcc/testsuite/ada/acats-4/tests/c4/c45532c.ada
! b60deea143add2ece22c54e2958db126  gcc/testsuite/ada/acats-4/tests/c4/c45532d.ada
! dac58571992e1d76d98508be3cbe2bd6  gcc/testsuite/ada/acats-4/tests/c4/c45532e.ada
! 1d7df94c7041a350156a66e67466f094  gcc/testsuite/ada/acats-4/tests/c4/c45532f.ada
! 98b8e00c4f5a9bb275a8ea343272d444  gcc/testsuite/ada/acats-4/tests/c4/c45532g.ada
! 715b35f0ab3ff72859527fd1dce01194  gcc/testsuite/ada/acats-4/tests/c4/c45532h.ada
! 6f5e0c33dee8484fe564f99b4aa53644  gcc/testsuite/ada/acats-4/tests/c4/c45532i.ada
! 4ff1755309ac898b71b5b8e71ed4a3b6  gcc/testsuite/ada/acats-4/tests/c4/c45532j.ada
! 6c58481cb99358f459163a20d20ecd7c  gcc/testsuite/ada/acats-4/tests/c4/c45532k.ada
! c77d0519f01191df9cdfba659466ec04  gcc/testsuite/ada/acats-4/tests/c4/c45532l.ada
! d2858511889a915c130e7db15a855e6a  gcc/testsuite/ada/acats-4/tests/c4/c45532m.dep
! a549269ed45783ccf0d0c93c5328f429  gcc/testsuite/ada/acats-4/tests/c4/c45532n.dep
! f4b1217bc94832f638629b8949b7def2  gcc/testsuite/ada/acats-4/tests/c4/c45532o.dep
! 798f26e21ededa5b524a77eeece6382f  gcc/testsuite/ada/acats-4/tests/c4/c45532p.dep
! 76101d98b4fab21c843f8c72a2bd9d19  gcc/testsuite/ada/acats-4/tests/c4/c45534b.ada
! b8ae84ef022a3c5728e841755e4bac5e  gcc/testsuite/ada/acats-4/tests/c4/c45536a.dep
! 28591d736802ebfac3f139de9f8cf2e7  gcc/testsuite/ada/acats-4/tests/c4/c456001.a
! bc49b87b69b7e8faefa883dc0c55fb68  gcc/testsuite/ada/acats-4/tests/c4/c45611a.ada
! 3be40e2b85d211f880f0c3afd51a63e8  gcc/testsuite/ada/acats-4/tests/c4/c45611b.dep
! 969e8cbd817e50baf599dd80133f7e3d  gcc/testsuite/ada/acats-4/tests/c4/c45611c.dep
! 48d114a182e767e243d7ef95e93e4e19  gcc/testsuite/ada/acats-4/tests/c4/c45613a.ada
! c3d80667bb998de0b21993ea73edabec  gcc/testsuite/ada/acats-4/tests/c4/c45613b.dep
! f8ed3027af651e8a9c09b39c0abf883c  gcc/testsuite/ada/acats-4/tests/c4/c45613c.dep
! cfe72bc879be3b00ef382558884d4b1d  gcc/testsuite/ada/acats-4/tests/c4/c45614a.ada
! c49e020a85a8868eed26fc38aaab04bf  gcc/testsuite/ada/acats-4/tests/c4/c45614b.dep
! 41f7a3468254617c1e8fd2e5932a25b4  gcc/testsuite/ada/acats-4/tests/c4/c45614c.dep
! ac5d52f05c31abf886e8c8c4468e3276  gcc/testsuite/ada/acats-4/tests/c4/c45631a.ada
! 08c1f1a469e3e9753825625f1a28b1ea  gcc/testsuite/ada/acats-4/tests/c4/c45631b.dep
! 3d90d62c311cc7457e997be47d4bc90b  gcc/testsuite/ada/acats-4/tests/c4/c45631c.dep
! 2f244bf1111e453d24ff570db3165fdb  gcc/testsuite/ada/acats-4/tests/c4/c45632a.ada
! 3e3d1f108ceb3c5be9dad7868239132f  gcc/testsuite/ada/acats-4/tests/c4/c45632b.dep
! d562e6283ca6c800b69581c080526e08  gcc/testsuite/ada/acats-4/tests/c4/c45632c.dep
! 2057dc7ea5393bc4be1493fb108ee5fb  gcc/testsuite/ada/acats-4/tests/c4/c45651a.ada
! c6892aa7717ffbd54f697e3d5db788af  gcc/testsuite/ada/acats-4/tests/c4/c45662a.ada
! a04b5f03883d1f148e66d75bb8eb5a69  gcc/testsuite/ada/acats-4/tests/c4/c45662b.ada
! ebd6cdab4f3e678623c2ece9ee770d5e  gcc/testsuite/ada/acats-4/tests/c4/c45672a.ada
! 2107107aa88fcbff445eeb6721d2a795  gcc/testsuite/ada/acats-4/tests/c4/c457001.a
! 782508e63800eaec0b936b50b5410242  gcc/testsuite/ada/acats-4/tests/c4/c457002.a
! 757f32d578ee296d56849ff835ee6e46  gcc/testsuite/ada/acats-4/tests/c4/c457003.a
! 5927837898a60dc9e24fd9ab31a0181b  gcc/testsuite/ada/acats-4/tests/c4/c457004.a
! d5497c731458923dd7d696565ebd16fb  gcc/testsuite/ada/acats-4/tests/c4/c457005.a
! 13831df05ca780677357496646bf120d  gcc/testsuite/ada/acats-4/tests/c4/c457006.a
! 9bde840312cf24f530ef335fca0d6c2b  gcc/testsuite/ada/acats-4/tests/c4/c457007.a
! d2ef822c53902b8f3725b8d5c39fc724  gcc/testsuite/ada/acats-4/tests/c4/c458001.a
! f3381be9c883bb29ae72dda9ebb7a7e0  gcc/testsuite/ada/acats-4/tests/c4/c458002.a
! 853b5e1594fad1f14fbbf3f39ef08a7c  gcc/testsuite/ada/acats-4/tests/c4/c458003.a
! c8502736e13993816459df5433071a57  gcc/testsuite/ada/acats-4/tests/c4/c458a01.a
! 9d0f5bebcbf8d9e06b08c2ca023734a4  gcc/testsuite/ada/acats-4/tests/c4/c458a02.a
! ac5adcf11bac18511d0fcfabda779d68  gcc/testsuite/ada/acats-4/tests/c4/c460001.a
! afb5f92407f4912f75eeaef16084757f  gcc/testsuite/ada/acats-4/tests/c4/c460002.a
! 69401711fe089c368e9218ac971b8e5a  gcc/testsuite/ada/acats-4/tests/c4/c460004.a
! f7f9cde65ac6273493f88f7cc35065c2  gcc/testsuite/ada/acats-4/tests/c4/c460005.a
! e0ce32e221b728a5e7cbef5d66bdb49b  gcc/testsuite/ada/acats-4/tests/c4/c460006.a
! ec69fdc3a65a761d8134bc49e6570216  gcc/testsuite/ada/acats-4/tests/c4/c460007.a
! 8b03807b80d9f2edc57ad06734bf670f  gcc/testsuite/ada/acats-4/tests/c4/c460008.a
! 6950bb628b3003b1ceb3b53e6cf246f8  gcc/testsuite/ada/acats-4/tests/c4/c460009.a
! 5bc44a3344b33409dd851c6b03e885b7  gcc/testsuite/ada/acats-4/tests/c4/c460010.a
! 28b73597d3fa9ae6666a9a63539882fb  gcc/testsuite/ada/acats-4/tests/c4/c460011.a
! a2898cc40c52d07d2a1d5f39c8daae42  gcc/testsuite/ada/acats-4/tests/c4/c460012.a
! 872a8786f130e49cbb2e00930aee116c  gcc/testsuite/ada/acats-4/tests/c4/c460013.a
! 8caad81fc1b11cdf36c43c5366ffe8c4  gcc/testsuite/ada/acats-4/tests/c4/c460014.a
! e833e9d95b6cede57867bf1cfb360b6d  gcc/testsuite/ada/acats-4/tests/c4/c460015.a
! 4578ba3cbcc42767bfa1d9fb8beed52f  gcc/testsuite/ada/acats-4/tests/c4/c46011a.ada
! 573e5b85d6d0d9289787bcf7f265aea9  gcc/testsuite/ada/acats-4/tests/c4/c46013a.ada
! ad32d1cce692c7cd1ef8bf3d2f70dee2  gcc/testsuite/ada/acats-4/tests/c4/c46014a.ada
! 3860375240c7fbeec5ea607c60613d17  gcc/testsuite/ada/acats-4/tests/c4/c46021a.ada
! 6ca67808bea0b36f928ece90dac5570f  gcc/testsuite/ada/acats-4/tests/c4/c46024a.ada
! 846bd637f5220b864dde4f2ea9ac8025  gcc/testsuite/ada/acats-4/tests/c4/c46031a.ada
! 362f593ed41bfc3cc23925318952cbc7  gcc/testsuite/ada/acats-4/tests/c4/c46032a.ada
! 65b59a01caacc42c4057aa1adad39e9c  gcc/testsuite/ada/acats-4/tests/c4/c46033a.ada
! bc9fedd5661dbda9254ef00f93819e37  gcc/testsuite/ada/acats-4/tests/c4/c46041a.ada
! dd2bc24443f9516af6adaf665228f9fb  gcc/testsuite/ada/acats-4/tests/c4/c46042a.ada
! cc5cd66068669bee0635ba7d5d5b9e4b  gcc/testsuite/ada/acats-4/tests/c4/c46043b.ada
! 862e92acebb016f9eaff87800084fb00  gcc/testsuite/ada/acats-4/tests/c4/c46044b.ada
! 8704bc96d1d99d958dd9ba580cc0fcab  gcc/testsuite/ada/acats-4/tests/c4/c46051a.ada
! 4301c097675c9ae1e1de85cb434e9f91  gcc/testsuite/ada/acats-4/tests/c4/c46051b.ada
! 0852a062d8fb5318db0fafb3e74e1869  gcc/testsuite/ada/acats-4/tests/c4/c46051c.ada
! 207b83887faae118af7863a8e7c8b797  gcc/testsuite/ada/acats-4/tests/c4/c46052a.ada
! 36ddef6a40e98fa6f687083359dcc79c  gcc/testsuite/ada/acats-4/tests/c4/c46053a.ada
! 7c918ea610224feb8290e7538e4931c0  gcc/testsuite/ada/acats-4/tests/c4/c46054a.ada
! dcaaa25c241dbab83f2031ac8a166ad0  gcc/testsuite/ada/acats-4/tests/c4/c460a01.a
! c9d756313dbe8edba8cd79f261be675b  gcc/testsuite/ada/acats-4/tests/c4/c460a02.a
! bed8a264a57d74944af5e13df9ec0b24  gcc/testsuite/ada/acats-4/tests/c4/c470001.a
! 8453f66003fadf1256272c8267ac59fe  gcc/testsuite/ada/acats-4/tests/c4/c47002a.ada
! a1a15e98aa414e9e0f6c684cc5fc7d3d  gcc/testsuite/ada/acats-4/tests/c4/c47002b.ada
! 52b6ce3f1ece2252097d9cf94ff704d8  gcc/testsuite/ada/acats-4/tests/c4/c47002c.ada
! 1b3f120455d714443fa2b8a6510141b3  gcc/testsuite/ada/acats-4/tests/c4/c47002d.ada
! e24d41d29f205af082effc4960aabff2  gcc/testsuite/ada/acats-4/tests/c4/c47003a.ada
! 676bb791325a2ce2931c822d1ba079e8  gcc/testsuite/ada/acats-4/tests/c4/c47004a.ada
! 5768cda2bc4788bb66c01ffbbe818333  gcc/testsuite/ada/acats-4/tests/c4/c47005a.ada
! 7180522de8601bc47eada08923197c21  gcc/testsuite/ada/acats-4/tests/c4/c47006a.ada
! 0866501ce0f4c5ac19a1a6701494acf1  gcc/testsuite/ada/acats-4/tests/c4/c47007a.ada
! f190b1e58c5b9f88edb7c62cc786a5ff  gcc/testsuite/ada/acats-4/tests/c4/c47008a.ada
! a83ffa688fac3d8d28808297d6c1f8af  gcc/testsuite/ada/acats-4/tests/c4/c47009a.ada
! 7e410443d7fee4c5025000324c9fa075  gcc/testsuite/ada/acats-4/tests/c4/c47009b.ada
! dce2f96009d9046b47877ee487e3b5da  gcc/testsuite/ada/acats-4/tests/c4/c480001.a
! bc1787b8c3d0a2828cd39079641a7ae3  gcc/testsuite/ada/acats-4/tests/c4/c48004a.ada
! 35a79d509102b6efc374a823e03081dd  gcc/testsuite/ada/acats-4/tests/c4/c48004b.ada
! 520b577b8b19f3e983fa89ee6a4feae4  gcc/testsuite/ada/acats-4/tests/c4/c48004c.ada
! 4a4dc141e6c0b8734f2f4889a453c041  gcc/testsuite/ada/acats-4/tests/c4/c48004d.ada
! e1de901127f9fa068bbc1887e40ae286  gcc/testsuite/ada/acats-4/tests/c4/c48004e.ada
! a21a603107226dd95249e796c50b2988  gcc/testsuite/ada/acats-4/tests/c4/c48004f.ada
! d05127b0bccfaca8e70b371616b9e949  gcc/testsuite/ada/acats-4/tests/c4/c48005a.ada
! 93f4d6e87a4f9f685f9aad61502c858c  gcc/testsuite/ada/acats-4/tests/c4/c48005b.ada
! 794d0af908f9931f0b089116f1e42907  gcc/testsuite/ada/acats-4/tests/c4/c48006a.ada
! 3df923c9af6683c1bb48881ddb41ddfb  gcc/testsuite/ada/acats-4/tests/c4/c48006b.ada
! a6c0f722acc9486a7e600dc96ff2d5cd  gcc/testsuite/ada/acats-4/tests/c4/c48007a.ada
! b2751238701befe768d059585cb34fbe  gcc/testsuite/ada/acats-4/tests/c4/c48007b.ada
! a069ec763e24859fbddc4f107e410c11  gcc/testsuite/ada/acats-4/tests/c4/c48007c.ada
! 009ebc3b69f9c31aa88c54a85271399a  gcc/testsuite/ada/acats-4/tests/c4/c48008a.ada
! 5782d3eeb5e00949ec2f3c7a7ae59650  gcc/testsuite/ada/acats-4/tests/c4/c48008c.ada
! 36b2b00fc2eaa55063b74bfc4cb91c79  gcc/testsuite/ada/acats-4/tests/c4/c48009a.ada
! d7356de4b25053ff97c5d99c7daa90a2  gcc/testsuite/ada/acats-4/tests/c4/c48009b.ada
! 46e9f0e1b269b6b499944395221ae145  gcc/testsuite/ada/acats-4/tests/c4/c48009c.ada
! 99e82e54208e5f2e641da892789ade00  gcc/testsuite/ada/acats-4/tests/c4/c48009d.ada
! a4dd405fd63b81dac153b62e7df858e9  gcc/testsuite/ada/acats-4/tests/c4/c48009e.ada
! a761ea12752cc1827d795f510ed14854  gcc/testsuite/ada/acats-4/tests/c4/c48009f.ada
! f4d13322456cdc5177a9641ba263e997  gcc/testsuite/ada/acats-4/tests/c4/c48009g.ada
! 9b3d09b25afb28f96e9c15abc9134ea5  gcc/testsuite/ada/acats-4/tests/c4/c48009h.ada
! 5ed239b238e9da030fa1d1bbf81e4dc3  gcc/testsuite/ada/acats-4/tests/c4/c48009i.ada
! dbe1181c1fb1c91cdfc5d5a51327b289  gcc/testsuite/ada/acats-4/tests/c4/c48009j.ada
! 688a1e8190cac3b78936f0235d3b808d  gcc/testsuite/ada/acats-4/tests/c4/c48010a.ada
! 48a6ec9afe098c7d148a0d1f652be09e  gcc/testsuite/ada/acats-4/tests/c4/c48011a.ada
! 18db6e638dc720b6501696a26aa99e58  gcc/testsuite/ada/acats-4/tests/c4/c48012a.ada
! b30035b53424a29691b261dda34fc58e  gcc/testsuite/ada/acats-4/tests/c4/c490001.a
! 489ea02e3356b5145fb51c63bb474ea5  gcc/testsuite/ada/acats-4/tests/c4/c490002.a
! c9523cc2889cfcde83e23c042eedd694  gcc/testsuite/ada/acats-4/tests/c4/c490003.a
! 6f98fb5a40e92d1a16d6c2a144d613a5  gcc/testsuite/ada/acats-4/tests/c4/c49020a.ada
! 949b858aea6369cc5f6b92e57a36762e  gcc/testsuite/ada/acats-4/tests/c4/c49021a.ada
! 61eb9a59008479c0875739f8a38a6058  gcc/testsuite/ada/acats-4/tests/c4/c49022a.ada
! 371d9a00cb41f67a40d255081149947a  gcc/testsuite/ada/acats-4/tests/c4/c49022b.ada
! 6cbf71a7cecd0227501309baf6e99545  gcc/testsuite/ada/acats-4/tests/c4/c49022c.ada
! ae09e5339a3f4903f8fa5d11de07d714  gcc/testsuite/ada/acats-4/tests/c4/c49023a.ada
! e2d3c0d182fcc8306bf82e940cacf1c0  gcc/testsuite/ada/acats-4/tests/c4/c49024a.ada
! fa1107ef6dfef6a91126632e0fd40ac9  gcc/testsuite/ada/acats-4/tests/c4/c49025a.ada
! 8308838bc1d5d9801f0aba7872873b2e  gcc/testsuite/ada/acats-4/tests/c4/c49026a.ada
! 67dd3195321fffe06e278c7a2dd46fb7  gcc/testsuite/ada/acats-4/tests/c4/c4a005b.ada
! b4f6152a06508643187aed55fe1b066d  gcc/testsuite/ada/acats-4/tests/c4/c4a006a.ada
! 5eddb402835a4195abec99f2970765f6  gcc/testsuite/ada/acats-4/tests/c4/c4a007a.tst
! 1c61fe192df4f7bf89c81bd93f979629  gcc/testsuite/ada/acats-4/tests/c4/c4a010a.ada
! db5b09d1af5f03cbfc83813c6cef98d9  gcc/testsuite/ada/acats-4/tests/c4/c4a010b.ada
! 8ea93dd812f5645ad034052c5e9c14bc  gcc/testsuite/ada/acats-4/tests/c4/c4a011a.ada
! d8a1f20f1b4a1339f232102f757a12c6  gcc/testsuite/ada/acats-4/tests/c4/c4a012b.ada
! df1956d8e1bdb8b421d8edda86514e73  gcc/testsuite/ada/acats-4/tests/c4/c4a013a.ada
! f95cf7fe1c6669b86824c685ca90c44f  gcc/testsuite/ada/acats-4/tests/c4/c4a014a.ada
! 04305b71fc4860700405904b070a802b  gcc/testsuite/ada/acats-4/tests/c5/c51004a.ada
! c6f0f59f33111f1bb049c5f25022c725  gcc/testsuite/ada/acats-4/tests/c5/c52005a.ada
! 4497fa9cc187eebee09f422eb12067f6  gcc/testsuite/ada/acats-4/tests/c5/c52005b.ada
! 31714495e63b10120b8239b0456549ee  gcc/testsuite/ada/acats-4/tests/c5/c52005c.ada
! c643f87a63f83ab7dedfa0b4647174c9  gcc/testsuite/ada/acats-4/tests/c5/c52005d.ada
! a717ed0d0e4578d9b1ba1e84a1312d88  gcc/testsuite/ada/acats-4/tests/c5/c52005e.ada
! e9e335b018c1995e8f516236efc80a20  gcc/testsuite/ada/acats-4/tests/c5/c52005f.ada
! c475aae75de9114facd3aaa775556697  gcc/testsuite/ada/acats-4/tests/c5/c52008a.ada
! 87cbbe1931b5cfdb29756f338e098ee1  gcc/testsuite/ada/acats-4/tests/c5/c52008b.ada
! 67bb5622435b51d6b7a862890b654771  gcc/testsuite/ada/acats-4/tests/c5/c52009a.ada
! 400c804c17dce5b2cbc92e00f53bdbf7  gcc/testsuite/ada/acats-4/tests/c5/c52009b.ada
! d656f6cd000039c412836d5baacbff52  gcc/testsuite/ada/acats-4/tests/c5/c52010a.ada
! 1f26091c9bf683f6970689d5d0980a81  gcc/testsuite/ada/acats-4/tests/c5/c52011a.ada
! bd17088998a5ebb4a8a3f1ae8ed0fb56  gcc/testsuite/ada/acats-4/tests/c5/c52011b.ada
! 4b2866ec2ef631d8e633f08a7aaf873c  gcc/testsuite/ada/acats-4/tests/c5/c52101a.ada
! d79452ecad6774f7462778af7f7ce5eb  gcc/testsuite/ada/acats-4/tests/c5/c52102a.ada
! c3ffbc3a8172219b7b11be58eb4ee73d  gcc/testsuite/ada/acats-4/tests/c5/c52102b.ada
! d8b031579b48e0bae598c821fc7f2799  gcc/testsuite/ada/acats-4/tests/c5/c52102c.ada
! 8545078e881db7a6a84e41583799ee5d  gcc/testsuite/ada/acats-4/tests/c5/c52102d.ada
! 348fad1e9e6e04b677fd7d942e3416af  gcc/testsuite/ada/acats-4/tests/c5/c52103a.ada
! 537e555773a4e758b8466c079c2023a1  gcc/testsuite/ada/acats-4/tests/c5/c52103b.ada
! c118c8520f99ad57e36a1e1ed0ab2549  gcc/testsuite/ada/acats-4/tests/c5/c52103c.ada
! 161ca114e3549ca32b6abc801f74633d  gcc/testsuite/ada/acats-4/tests/c5/c52103f.ada
! 553aa64efc629783fc32ef6b352ae6be  gcc/testsuite/ada/acats-4/tests/c5/c52103g.ada
! 29498cb969386c5b69bd6ba62c7be406  gcc/testsuite/ada/acats-4/tests/c5/c52103h.ada
! 8026673b1e67673c009f39e569ae1a3e  gcc/testsuite/ada/acats-4/tests/c5/c52103k.ada
! c6b31cf4833909c9d4dae839511863ec  gcc/testsuite/ada/acats-4/tests/c5/c52103l.ada
! 6843840acb3dee1ae11cf9365156daaa  gcc/testsuite/ada/acats-4/tests/c5/c52103m.ada
! 70a2f3db7206a779a035e915788f37f0  gcc/testsuite/ada/acats-4/tests/c5/c52103p.ada
! a28a2bdec6b574435427b9aeb1c74945  gcc/testsuite/ada/acats-4/tests/c5/c52103q.ada
! 7b9ecdaf00c3655bb24701195d08a83f  gcc/testsuite/ada/acats-4/tests/c5/c52103r.ada
! 0c814953f2bf8472a62eb44838f04363  gcc/testsuite/ada/acats-4/tests/c5/c52103x.ada
! e772fcfb1386e00244d4b143524cc196  gcc/testsuite/ada/acats-4/tests/c5/c52104a.ada
! 16ef5ba633cf0703eef0f4bc4e6a931e  gcc/testsuite/ada/acats-4/tests/c5/c52104b.ada
! 0d83ec342af202df515bd811d311775e  gcc/testsuite/ada/acats-4/tests/c5/c52104c.ada
! 63ba1297346e75dcba0a5bebb9fd7feb  gcc/testsuite/ada/acats-4/tests/c5/c52104f.ada
! 360c84a7d7a20d6426f39f47175e9e61  gcc/testsuite/ada/acats-4/tests/c5/c52104g.ada
! 8c2507e3ca68c72c1b2e6d6e118ec32b  gcc/testsuite/ada/acats-4/tests/c5/c52104h.ada
! 3eb7315199feb380e4633e0fa784d0dc  gcc/testsuite/ada/acats-4/tests/c5/c52104k.ada
! 1e9c8d887474d4edd8e8cef2ca34972f  gcc/testsuite/ada/acats-4/tests/c5/c52104l.ada
! 4cd7ce90121345b41e548625afd89238  gcc/testsuite/ada/acats-4/tests/c5/c52104m.ada
! bb14b1ee179559762fe853803c6f47a0  gcc/testsuite/ada/acats-4/tests/c5/c52104p.ada
! 11c63d2f8a8f5be641d543c723d95db6  gcc/testsuite/ada/acats-4/tests/c5/c52104q.ada
! 3e89a5e299b2f10a8bfdddda7e51ad94  gcc/testsuite/ada/acats-4/tests/c5/c52104r.ada
! cf3c9c7c07a47d92020285624997c09f  gcc/testsuite/ada/acats-4/tests/c5/c52104x.ada
! c937dcfea0e38e6a3b8af09de0efaf04  gcc/testsuite/ada/acats-4/tests/c5/c52104y.ada
! b2aa45debad3d8e7603216de3bca00fb  gcc/testsuite/ada/acats-4/tests/c5/c53007a.ada
! ff458115437146bc66c6f7135942dc7d  gcc/testsuite/ada/acats-4/tests/c5/c540001.a
! bfd64dd4867f66c56eb6d466f8a84af9  gcc/testsuite/ada/acats-4/tests/c5/c540002.a
! 46869d02196b0737ae882bebe573ab11  gcc/testsuite/ada/acats-4/tests/c5/c540003.a
! 798fc3cdc6929204af5e109c7b552b96  gcc/testsuite/ada/acats-4/tests/c5/c54a03a.ada
! 350e6e9e9f439b08c9984e18a29b6144  gcc/testsuite/ada/acats-4/tests/c5/c54a04a.ada
! 672e5fee1b44c051e35bd39f7cfdd7f6  gcc/testsuite/ada/acats-4/tests/c5/c54a07a.ada
! 55636ae11b1e87d2920da673ac54f8cf  gcc/testsuite/ada/acats-4/tests/c5/c54a13a.ada
! fadaa20972179cfa78055a5255aaf701  gcc/testsuite/ada/acats-4/tests/c5/c54a13b.ada
! 1f2ca9fde851497809ddf860f08ea8dd  gcc/testsuite/ada/acats-4/tests/c5/c54a13c.ada
! f02b8333b09eadfe396595d861e0c28e  gcc/testsuite/ada/acats-4/tests/c5/c54a13d.ada
! 37f2526490642267865f8a817c455655  gcc/testsuite/ada/acats-4/tests/c5/c54a22a.ada
! c4b7807f9faa1bb76d79507d98a0feb3  gcc/testsuite/ada/acats-4/tests/c5/c54a23a.ada
! 45d1b598e30b318d11d3cfa6a37cc6fa  gcc/testsuite/ada/acats-4/tests/c5/c54a24a.ada
! adeadf039e14eb8bc2b48ff5572bd812  gcc/testsuite/ada/acats-4/tests/c5/c54a24b.ada
! 7cf7b4d54a6bca23e102d02570e8d836  gcc/testsuite/ada/acats-4/tests/c5/c54a42a.ada
! 200024964c0cd6807dda9226ae982125  gcc/testsuite/ada/acats-4/tests/c5/c54a42b.ada
! b58d58ea8c08f008f3bb0a1f4e37600d  gcc/testsuite/ada/acats-4/tests/c5/c54a42c.ada
! 7afca27633e115e11ccc09450181d955  gcc/testsuite/ada/acats-4/tests/c5/c54a42d.ada
! 810d89d05b84beb31789b0ebd7aba86d  gcc/testsuite/ada/acats-4/tests/c5/c54a42e.ada
! 012f75628d8e37cbd1be10f8f4ba117f  gcc/testsuite/ada/acats-4/tests/c5/c54a42f.ada
! d45cbd6907b0f421c6aec9b981f052d6  gcc/testsuite/ada/acats-4/tests/c5/c54a42g.ada
! ddf7b3bf2917d68dc7237d88ccc0204c  gcc/testsuite/ada/acats-4/tests/c5/c550001.a
! 71494def43ae66bdb109444f10004a1d  gcc/testsuite/ada/acats-4/tests/c5/c552001.a
! aa5f4a4c3f179238c391eb13a8985b0a  gcc/testsuite/ada/acats-4/tests/c5/c552002.a
! 76027d0eb54a0a2b41680aa7315f2a93  gcc/testsuite/ada/acats-4/tests/c5/c552a01.a
! cec7859fa129b5647f80b83ab83d624a  gcc/testsuite/ada/acats-4/tests/c5/c552a02.a
! ef97a2623a512e16e0fda04f277b6ff2  gcc/testsuite/ada/acats-4/tests/c5/c55b03a.ada
! ad40c92edd66b18fad76286ec1b9c6ae  gcc/testsuite/ada/acats-4/tests/c5/c55b04a.ada
! aa1f7abf4fbb36f5120549a0305b7862  gcc/testsuite/ada/acats-4/tests/c5/c55b05a.ada
! 93af4cbae77af58c9e4c76145e3381b0  gcc/testsuite/ada/acats-4/tests/c5/c55b06a.ada
! 83fb65a1faa9605647ad3455e55fa273  gcc/testsuite/ada/acats-4/tests/c5/c55b06b.ada
! 1c3a3e590230416971b33336bec05137  gcc/testsuite/ada/acats-4/tests/c5/c55b07a.dep
! 297ac06b1460ecfad84e5ce426b452d5  gcc/testsuite/ada/acats-4/tests/c5/c55b07b.dep
! 9f79657a1fb3ec7ad658a79647c5949c  gcc/testsuite/ada/acats-4/tests/c5/c55b10a.ada
! 1364f5750f4c9a8395cf0b1ae42eee0b  gcc/testsuite/ada/acats-4/tests/c5/c55b11a.ada
! 20c657742ad353aedf983932ae3ad058  gcc/testsuite/ada/acats-4/tests/c5/c55b11b.ada
! dcbc66de120373907bc61655da9f5f72  gcc/testsuite/ada/acats-4/tests/c5/c55b15a.ada
! 46488465caae85e036ca25f7a3861ddb  gcc/testsuite/ada/acats-4/tests/c5/c55b16a.ada
! 59a61b3784b5cede84a98e874e989bf9  gcc/testsuite/ada/acats-4/tests/c5/c55c02a.ada
! a665c1df7fabf7499dd2fef8021e5735  gcc/testsuite/ada/acats-4/tests/c5/c55c02b.ada
! 9722acc7b86adb50f2132a53c9a9ba5f  gcc/testsuite/ada/acats-4/tests/c5/c56002a.ada
! 0d40a16731d63ec204e884f94b191598  gcc/testsuite/ada/acats-4/tests/c5/c57003a.ada
! 7bceaaa459e0581dd43947812fb6e226  gcc/testsuite/ada/acats-4/tests/c5/c57004a.ada
! 30ed2943b27da30ba5be8602f46f6e65  gcc/testsuite/ada/acats-4/tests/c5/c57004b.ada
! 8a811d9acc70a272fa09cbfe47fdbbc0  gcc/testsuite/ada/acats-4/tests/c5/c58004c.ada
! 17e55b043903edcc29571ab8bd8aa78c  gcc/testsuite/ada/acats-4/tests/c5/c58004d.ada
! 7807a279489151c0c870e2d8f12f4502  gcc/testsuite/ada/acats-4/tests/c5/c58004g.ada
! 1b5dcc2941f69ee8c74a24728bb90d67  gcc/testsuite/ada/acats-4/tests/c5/c58005a.ada
! 62354e1ba2b765af08aa33a5e09c47df  gcc/testsuite/ada/acats-4/tests/c5/c58005b.ada
! 9028a4a38fba5ee0a721a8918c7e46c8  gcc/testsuite/ada/acats-4/tests/c5/c58005h.ada
! fa480782be6698aa97970fcf14c2f19b  gcc/testsuite/ada/acats-4/tests/c5/c58006a.ada
! 156c239407b9c9b5abfd28b286d35734  gcc/testsuite/ada/acats-4/tests/c5/c58006b.ada
! 05e86bfca592c5c4d28a7ad45f8d8054  gcc/testsuite/ada/acats-4/tests/c5/c59002a.ada
! 70857f43256c7a44ec4b50f5aa1b4b0d  gcc/testsuite/ada/acats-4/tests/c5/c59002b.ada
! 8a43db8aaa6ff159f8de6d91d075a607  gcc/testsuite/ada/acats-4/tests/c5/c59002c.ada
! 22c213bb3f4fac53cfad7701e5a6591a  gcc/testsuite/ada/acats-4/tests/c6/c61008a.ada
! 5fb3b13780dfa407dfa99fcfa590913f  gcc/testsuite/ada/acats-4/tests/c6/c61009a.ada
! 25cf5d0e53424f3054a20393c002970e  gcc/testsuite/ada/acats-4/tests/c6/c61010a.ada
! d9fcff8a398f104841deae581c8799e2  gcc/testsuite/ada/acats-4/tests/c6/c611001.a
! 1c596eb923888eaca6fd79202f043dbd  gcc/testsuite/ada/acats-4/tests/c6/c611a01.a
! 4b14bcffa2dfc4faee34f8fad236bd20  gcc/testsuite/ada/acats-4/tests/c6/c611a020.a
! c5bc6a65126ac3f2e5b501d1a6dc5ef9  gcc/testsuite/ada/acats-4/tests/c6/c611a021.a
! 97b25c097aacb82949283d55609b80ae  gcc/testsuite/ada/acats-4/tests/c6/c611a022.am
! c8ef73caef0e44e548d5b2d0ef567f23  gcc/testsuite/ada/acats-4/tests/c6/c611a030.a
! 05d93264306e23ca555f1720f0ca6088  gcc/testsuite/ada/acats-4/tests/c6/c611a031.a
! 495d26df26f2a9f45a48f74119f88609  gcc/testsuite/ada/acats-4/tests/c6/c611a032.am
! 92eda3db33f6bda53a6969817b1b4515  gcc/testsuite/ada/acats-4/tests/c6/c611a040.a
! bf3f86b68f80669cda9d142f24c08dac  gcc/testsuite/ada/acats-4/tests/c6/c611a041.a
! d12af3ea24a7fd71045e091d6dc76b7a  gcc/testsuite/ada/acats-4/tests/c6/c611a042.a
! 41cd64822100c9e0e473db5f30b5597d  gcc/testsuite/ada/acats-4/tests/c6/c611a043.am
! 5249ac6535c2b1ff0c029514604966d6  gcc/testsuite/ada/acats-4/tests/c6/c611b010.a
! 7cb386d273bd28b23497fe970f2ba064  gcc/testsuite/ada/acats-4/tests/c6/c611b011.a
! bbfbc2539ecfe176545fbe3a2f6bdfbc  gcc/testsuite/ada/acats-4/tests/c6/c611b012.am
! 79c49487a2ca33921bd87ff7359df6e6  gcc/testsuite/ada/acats-4/tests/c6/c611b020.a
! 61cc00f004c712e52d74850dd8b567e5  gcc/testsuite/ada/acats-4/tests/c6/c611b021.a
! 9d034710430c0ebff2a139ef3a053d10  gcc/testsuite/ada/acats-4/tests/c6/c611b022.am
! cd32b83de0638d8709bf12b3a835f9b8  gcc/testsuite/ada/acats-4/tests/c6/c611b030.a
! 7ee45c5b986c04618e80d1439e94c4da  gcc/testsuite/ada/acats-4/tests/c6/c611b031.a
! e6339df34c2c667801bd4625770fe796  gcc/testsuite/ada/acats-4/tests/c6/c611b032.a
! 26829da84bc0132bd6e078850e752808  gcc/testsuite/ada/acats-4/tests/c6/c611b033.am
! fc4b87310c6618ffbf7d4df1f222a45f  gcc/testsuite/ada/acats-4/tests/c6/c620001.a
! 2a393ff1326482d8490f5be202d8483c  gcc/testsuite/ada/acats-4/tests/c6/c620002.a
! 97d97866837d419b1ddcfa6ccda2511e  gcc/testsuite/ada/acats-4/tests/c6/c62002a.ada
! 3e2cc6ba1c79eb1d9f3fe3bbb646cf6b  gcc/testsuite/ada/acats-4/tests/c6/c62003b.ada
! 624bc88129c0b954774c60019f5435c5  gcc/testsuite/ada/acats-4/tests/c6/c62004a.ada
! 31c5b507af85354e0db53a078e7c8933  gcc/testsuite/ada/acats-4/tests/c6/c62006a.ada
! e8a1274fb71dcf0b27d5375c78e8d1d3  gcc/testsuite/ada/acats-4/tests/c6/c631001.a
! 41a6d9efe5d22a0f96b7c4448831b133  gcc/testsuite/ada/acats-4/tests/c6/c640001.a
! 17e197839a109a15bfb4d3592d5bdff8  gcc/testsuite/ada/acats-4/tests/c6/c640002.a
! 67136569bb3a58c14f65e3abd9b96391  gcc/testsuite/ada/acats-4/tests/c6/c64002b.ada
! 298c0d717f1da2c324c78b6aafedfa91  gcc/testsuite/ada/acats-4/tests/c6/c64004g.ada
! 0a5ebe2531dcbec11f3d606df5534e5b  gcc/testsuite/ada/acats-4/tests/c6/c64005a.ada
! 1a7b4a32917f31d77deb5ad294e39f82  gcc/testsuite/ada/acats-4/tests/c6/c64005b.ada
! 292b4b0e6cf19da205f4d3a1caeee992  gcc/testsuite/ada/acats-4/tests/c6/c64005c.ada
! db80e980a183a6d0f7c9afd52fae0c87  gcc/testsuite/ada/acats-4/tests/c6/c64005d0.ada
! f480e72d2a8b3a22347018687fb9f190  gcc/testsuite/ada/acats-4/tests/c6/c64005da.ada
! 035da89aedf781e8b07eace791889088  gcc/testsuite/ada/acats-4/tests/c6/c64005db.ada
! 9af982279e39e967d04656170afef341  gcc/testsuite/ada/acats-4/tests/c6/c64005dc.ada
! 2f3c835897b61c5b02af1bef11a949d6  gcc/testsuite/ada/acats-4/tests/c6/c641001.a
! a6633ae19f4c94c7a696b51eb815aea5  gcc/testsuite/ada/acats-4/tests/c6/c641002.a
! 0ffeddd3b7a5f9395d73d4149990409f  gcc/testsuite/ada/acats-4/tests/c6/c641003.a
! f9894df16dafde8c37b5681a9a0b728f  gcc/testsuite/ada/acats-4/tests/c6/c64103b.ada
! 573a659bd2d30c3c8a3ee7f77390490c  gcc/testsuite/ada/acats-4/tests/c6/c64103c.ada
! e7242de3cddb62031ef1910e911942df  gcc/testsuite/ada/acats-4/tests/c6/c64103d.ada
! 6e2e6c719dcbb601e033a3a1528b6db5  gcc/testsuite/ada/acats-4/tests/c6/c64103e.ada
! aa17757d55d04a8ef672505933d46680  gcc/testsuite/ada/acats-4/tests/c6/c64103f.ada
! bbb85cc245f09eba3db627d88d52db68  gcc/testsuite/ada/acats-4/tests/c6/c64104a.ada
! d3f37083469fc62f2aeae2c00e979ad9  gcc/testsuite/ada/acats-4/tests/c6/c64104b.ada
! 00b5b6264d3df93a1481ca7dd0313957  gcc/testsuite/ada/acats-4/tests/c6/c64104c.ada
! 0d80f34c16a2ae02db45210c6b66eaa8  gcc/testsuite/ada/acats-4/tests/c6/c64104d.ada
! 5dc873b400a6675c734e431ac91f74db  gcc/testsuite/ada/acats-4/tests/c6/c64104e.ada
! 54921e31e5a30e388946a946c10c8954  gcc/testsuite/ada/acats-4/tests/c6/c64104f.ada
! b763fdc647a8b6c2e8ccdcc7b2e1556c  gcc/testsuite/ada/acats-4/tests/c6/c64104g.ada
! 0a7c01deaae4401d7fe1f7f78e4e6325  gcc/testsuite/ada/acats-4/tests/c6/c64104h.ada
! 39b3c50eb36b7e11b1d9e78a7b3f9132  gcc/testsuite/ada/acats-4/tests/c6/c64104i.ada
! a30f87a67e828d3791f26521921a8f81  gcc/testsuite/ada/acats-4/tests/c6/c64104j.ada
! 8906347f1c0f027d889a06f25fcc1831  gcc/testsuite/ada/acats-4/tests/c6/c64104k.ada
! 4cb01879b0f85af48c5474c558534e54  gcc/testsuite/ada/acats-4/tests/c6/c64104l.ada
! cd1d978bf7503e964f5c0293089096c1  gcc/testsuite/ada/acats-4/tests/c6/c64104m.ada
! 62990064fd13a84570c91f3d1f71338f  gcc/testsuite/ada/acats-4/tests/c6/c64104n.ada
! ff64768b090411d3f8232b7dc479db5f  gcc/testsuite/ada/acats-4/tests/c6/c64104o.ada
! c371cb358b8e763068dd4af101cd7f51  gcc/testsuite/ada/acats-4/tests/c6/c64105a.ada
! f1cfabbe7fa319f7a90669a5a1d88874  gcc/testsuite/ada/acats-4/tests/c6/c64105b.ada
! 484938df1d2ea23b4699185521d927ae  gcc/testsuite/ada/acats-4/tests/c6/c64105c.ada
! 98ba505c37a1fa4544aa7a16f86476d8  gcc/testsuite/ada/acats-4/tests/c6/c64105d.ada
! 7f5ef4e4117e3403c814c8b2d6248652  gcc/testsuite/ada/acats-4/tests/c6/c64106a.ada
! c719851b2aa8d7de278a61b4ae401e7f  gcc/testsuite/ada/acats-4/tests/c6/c64106b.ada
! 99b026e3c033b0bc70bbb34952c61a90  gcc/testsuite/ada/acats-4/tests/c6/c64106c.ada
! 1ff08389beb50526e6d5946f3ddfa0d2  gcc/testsuite/ada/acats-4/tests/c6/c64106d.ada
! 19103ed02e019b6f2490bd4285878194  gcc/testsuite/ada/acats-4/tests/c6/c64107a.ada
! 93d945e280814e3db9cdaa9a9be57e87  gcc/testsuite/ada/acats-4/tests/c6/c64108a.ada
! 39bf7a6fa5bcfb5ee8e52f5f07fafefc  gcc/testsuite/ada/acats-4/tests/c6/c64109a.ada
! 7a1023fda1950978c62798e5caff709c  gcc/testsuite/ada/acats-4/tests/c6/c64109b.ada
! 276b67fe008e97a4988487fc615e1f3c  gcc/testsuite/ada/acats-4/tests/c6/c64109c.ada
! 80192570a6b338162a9ef9bfc13a4dff  gcc/testsuite/ada/acats-4/tests/c6/c64109d.ada
! 4719b8ddae4538b59e04d96c932a95d9  gcc/testsuite/ada/acats-4/tests/c6/c64109e.ada
! ed4b4f3ef743bc7f8f4a6afe5886cae2  gcc/testsuite/ada/acats-4/tests/c6/c64109f.ada
! 8f7ab91cec27ffbad7b51252ef99b137  gcc/testsuite/ada/acats-4/tests/c6/c64109g.ada
! 2bb8cec80fd6bc3ed2495c9581ea2a9e  gcc/testsuite/ada/acats-4/tests/c6/c64109h.ada
! 495be9b835fa97670e1a579d72a3f96d  gcc/testsuite/ada/acats-4/tests/c6/c64109i.ada
! 547c93bc4be631648c9973120c282a89  gcc/testsuite/ada/acats-4/tests/c6/c64109j.ada
! 4da6b83416827b9d2d574334772ff2a3  gcc/testsuite/ada/acats-4/tests/c6/c64109k.ada
! 6217fe2218b5d9ecf085e1b730917030  gcc/testsuite/ada/acats-4/tests/c6/c64109l.ada
! dde2e62be923a3854e5f1667c4a78def  gcc/testsuite/ada/acats-4/tests/c6/c64201b.ada
! c3459cee62caf16a8d14f820e16c4f60  gcc/testsuite/ada/acats-4/tests/c6/c64201c.ada
! e589f5c8d3bb97575b245a37a5f2dffa  gcc/testsuite/ada/acats-4/tests/c6/c64202a.ada
! 249c4ba928b3c2a034f8beb44bc9dc87  gcc/testsuite/ada/acats-4/tests/c6/c650002.a
! 1daba8b521ac51502253586af8575c04  gcc/testsuite/ada/acats-4/tests/c6/c650003.a
! 25c48d1366d3ac13453832dcee471f3f  gcc/testsuite/ada/acats-4/tests/c6/c65003a.ada
! beca3ad5c25f888eed6dc6b1db750e33  gcc/testsuite/ada/acats-4/tests/c6/c65003b.ada
! 3d99b1b94c81e0ceb7c56da5b41ffa66  gcc/testsuite/ada/acats-4/tests/c6/c650a01.a
! 0d58812f7951d472279387e8af7bb060  gcc/testsuite/ada/acats-4/tests/c6/c650a02.a
! 4b2af928a9d86212f0ea8ebdbe7456ad  gcc/testsuite/ada/acats-4/tests/c6/c650b01.a
! 1f967f21efb027ccb899006385519718  gcc/testsuite/ada/acats-4/tests/c6/c650b02.a
! a04351077d59b3b3426dccecc6163eaa  gcc/testsuite/ada/acats-4/tests/c6/c650b03.a
! 1de5e1f96f9da1970a0b2697c045ec12  gcc/testsuite/ada/acats-4/tests/c6/c650b04.a
! eceb334eefb06549070d0660d7e209a2  gcc/testsuite/ada/acats-4/tests/c6/c651001.a
! 07bfe712b556edbc55e069cd7d966146  gcc/testsuite/ada/acats-4/tests/c6/c651002.a
! f9c43a72052149152ab5e663d5bf62ee  gcc/testsuite/ada/acats-4/tests/c6/c660001.a
! 4eca86193e279acda5aa647dab2bf5bf  gcc/testsuite/ada/acats-4/tests/c6/c66002a.ada
! 7cbfd161ceac490eb379a5c08eb1945c  gcc/testsuite/ada/acats-4/tests/c6/c66002c.ada
! 482c9214fae39fbcab58fcbae0b5b5ef  gcc/testsuite/ada/acats-4/tests/c6/c66002d.ada
! 7a93f84ee40f38fca4afb6cfd5e69a57  gcc/testsuite/ada/acats-4/tests/c6/c66002e.ada
! 2b60fab145676d717df13cdf9c7a70cb  gcc/testsuite/ada/acats-4/tests/c6/c66002f.ada
! ea770ca1e9d9fcb8b4460d5921747ef5  gcc/testsuite/ada/acats-4/tests/c6/c66002g.ada
! 8470fdb16485b4472bee0602f1f98734  gcc/testsuite/ada/acats-4/tests/c6/c67002a.ada
! 0e2fbb4deae7d888206b0ce77fc4fda5  gcc/testsuite/ada/acats-4/tests/c6/c67002b.ada
! 308d5f91802e93205222e8ca1f7def1e  gcc/testsuite/ada/acats-4/tests/c6/c67002c.ada
! 84e0adc30ed2874abaffa33f713cc51b  gcc/testsuite/ada/acats-4/tests/c6/c67002d.ada
! ddfdc630c5edd58e367ed9b034c039e7  gcc/testsuite/ada/acats-4/tests/c6/c67002e.ada
! 49b95c1cbdb6c703d2eba605f6f06c92  gcc/testsuite/ada/acats-4/tests/c6/c67003f.ada
! 213a9e52b5357a07997f1aa43ec82624  gcc/testsuite/ada/acats-4/tests/c6/c67005a.ada
! ddd7cdd9502a723b17b40bcb1df0e016  gcc/testsuite/ada/acats-4/tests/c6/c67005b.ada
! 20a99f6c582810cf18b39ab642f4024f  gcc/testsuite/ada/acats-4/tests/c6/c67005c.ada
! 8ea8c4445f5e72cc88e8dad14b66084e  gcc/testsuite/ada/acats-4/tests/c6/c67005d.ada
! 95dd8513b921be3378db70f22e9d180f  gcc/testsuite/ada/acats-4/tests/c6/c680001.a
! 69f93d5f57d1b7956ae380ff9f3e5f77  gcc/testsuite/ada/acats-4/tests/c7/c72001b.ada
! b6fa12bd9fd0f617b4eeded7550722c2  gcc/testsuite/ada/acats-4/tests/c7/c72002a.ada
! c70f104ca78b3298a442973676af108a  gcc/testsuite/ada/acats-4/tests/c7/c730001.a
! 7d2edfee282ba04ca7f25bef0f101057  gcc/testsuite/ada/acats-4/tests/c7/c730002.a
! 7822b69c5c1de14250eaad43da14736b  gcc/testsuite/ada/acats-4/tests/c7/c730003.a
! ced40d2c1dbfd9c72c43feedd4c9cefc  gcc/testsuite/ada/acats-4/tests/c7/c730004.a
! d3f7b50b0820bac4ce78abffb5e37744  gcc/testsuite/ada/acats-4/tests/c7/c73002a.ada
! c70763cb0718b44fa8658ee9ebb8c726  gcc/testsuite/ada/acats-4/tests/c7/c730a01.a
! 4ecce7babf24585f115e0d288f17e449  gcc/testsuite/ada/acats-4/tests/c7/c730a02.a
! 9c311ffdc62d1b99a3452b1e38d15e2e  gcc/testsuite/ada/acats-4/tests/c7/c731001.a
! a9056f350c3d0d76cc578591b3395f18  gcc/testsuite/ada/acats-4/tests/c7/c7320010.a
! 6cfee6075a2d53c0ad36a769e93b97cc  gcc/testsuite/ada/acats-4/tests/c7/c7320011.a
! f18b6c2d86e5f63f45c91a16a8a35567  gcc/testsuite/ada/acats-4/tests/c7/c7320012.am
! 09cfa2f7908d35770e884b3ccd4ac9ca  gcc/testsuite/ada/acats-4/tests/c7/c732002.a
! 23a21010d93114620fe76695089ae5c0  gcc/testsuite/ada/acats-4/tests/c7/c732a01.a
! 2ad8a7f7d7d446a951f8a27a7670193f  gcc/testsuite/ada/acats-4/tests/c7/c732a02.a
! ee24df5d8fa3626e4992eedf01a1b7af  gcc/testsuite/ada/acats-4/tests/c7/c732b01.a
! e26da98965834bfffdac83bc5c33005e  gcc/testsuite/ada/acats-4/tests/c7/c732b02.a
! aa466e85b039cc0712d3b4eac04cef8a  gcc/testsuite/ada/acats-4/tests/c7/c732c01.a
! be09078047844bd86eef86d5755ef273  gcc/testsuite/ada/acats-4/tests/c7/c74004a.ada
! a0a0a05e6225a07b7bd0f2c049f1dc37  gcc/testsuite/ada/acats-4/tests/c7/c74203a.ada
! a718857277037741ea3600c1aab95a3d  gcc/testsuite/ada/acats-4/tests/c7/c74206a.ada
! 0efca36cdb74fc57aec9e1de78e0324f  gcc/testsuite/ada/acats-4/tests/c7/c74207b.ada
! 7ceb0d1778d1a1bae9687bebd7aad9e3  gcc/testsuite/ada/acats-4/tests/c7/c74208a.ada
! bf7859fde348fa96735368f14e0a3e25  gcc/testsuite/ada/acats-4/tests/c7/c74208b.ada
! 7d504e824db220a636160024b4e963d6  gcc/testsuite/ada/acats-4/tests/c7/c74209a.ada
! 3f31b8eb73e78f20cdcf118aa7d0047c  gcc/testsuite/ada/acats-4/tests/c7/c74210a.ada
! 442ab4135e3f1fdfffacf000f7b4bda3  gcc/testsuite/ada/acats-4/tests/c7/c74211a.ada
! 49650c69957d01ffb396db79a35589c4  gcc/testsuite/ada/acats-4/tests/c7/c74211b.ada
! 30155693ce7b3f29189da859d313eb7d  gcc/testsuite/ada/acats-4/tests/c7/c74302a.ada
! 73469fa8506968a2026de265efd8a8f5  gcc/testsuite/ada/acats-4/tests/c7/c74302b.ada
! b559e9bf4e98700fb810e406c30a34b7  gcc/testsuite/ada/acats-4/tests/c7/c74305a.ada
! f1b9307b4d428cf0d10bc48805ffb0f3  gcc/testsuite/ada/acats-4/tests/c7/c74305b.ada
! 4d9094e9183691ac1e749b6abac166d7  gcc/testsuite/ada/acats-4/tests/c7/c74306a.ada
! d62a4df3fab829d5694cbf9f5cc4cb8e  gcc/testsuite/ada/acats-4/tests/c7/c74307a.ada
! 933ca49dcfb9ad8fc25ea9a434984d05  gcc/testsuite/ada/acats-4/tests/c7/c74401d.ada
! 502d8871fd7e5d6399f7536874735597  gcc/testsuite/ada/acats-4/tests/c7/c74401e.ada
! 2514504f60fcea97d8914fabcb5654cf  gcc/testsuite/ada/acats-4/tests/c7/c74401k.ada
! 3ca8e77b02dbd7f9e9104dd0fa6de35b  gcc/testsuite/ada/acats-4/tests/c7/c74401q.ada
! d30f33bfdaf9612ea55c7659c3b5aeb6  gcc/testsuite/ada/acats-4/tests/c7/c74402a.ada
! cf79bb4fcbdf7ec1cd795607eef8bc10  gcc/testsuite/ada/acats-4/tests/c7/c74402b.ada
! f6ece8469b7d90aef496ac665f895003  gcc/testsuite/ada/acats-4/tests/c7/c74406a.ada
! cce5e695d18f537ec2a8d6c26cfc5b0d  gcc/testsuite/ada/acats-4/tests/c7/c74407b.ada
! 316be518a848dd0954d80de977e40c5b  gcc/testsuite/ada/acats-4/tests/c7/c74409b.ada
! c751f318a2fe16dadb0c62221c726b70  gcc/testsuite/ada/acats-4/tests/c7/c760001.a
! f250c0eea5cbe1e05ed28f0a940949ed  gcc/testsuite/ada/acats-4/tests/c7/c760002.a
! c12d4d7698c111ee3a094c0c2d53522a  gcc/testsuite/ada/acats-4/tests/c7/c760007.a
! 767d3e26a992541aa6191923e040a107  gcc/testsuite/ada/acats-4/tests/c7/c760009.a
! 264f06f0190602b655e5f7fefb6822b8  gcc/testsuite/ada/acats-4/tests/c7/c760010.a
! 31eaca7f3a33de78c9eaa1a92109c6ad  gcc/testsuite/ada/acats-4/tests/c7/c760011.a
! 522805071c7c096b6eabcd72cf833d9a  gcc/testsuite/ada/acats-4/tests/c7/c760012.a
! a4f8e8b6876d4b862928b00edca5f5d9  gcc/testsuite/ada/acats-4/tests/c7/c760013.a
! 697b41e01dcf464180756bf8fa061c6e  gcc/testsuite/ada/acats-4/tests/c7/c760014.a
! a37ffbe46b838c3dc3e654c0d3ed95a5  gcc/testsuite/ada/acats-4/tests/c7/c760015.a
! 8441053e30427f1a4e9c4016ec935afc  gcc/testsuite/ada/acats-4/tests/c7/c760a01.a
! 6d1036753e3e9e32f4e5aa75ec3afc72  gcc/testsuite/ada/acats-4/tests/c7/c760a02.a
! 3bdb3e1fa871cdbef2d5ffe862d8dce8  gcc/testsuite/ada/acats-4/tests/c7/c760a03.a
! 45d67d0e3319e953b892c7d115460ecd  gcc/testsuite/ada/acats-4/tests/c7/c761001.a
! d0ef4cf494c0c2ec27f3abccd4d36a6f  gcc/testsuite/ada/acats-4/tests/c7/c761002.a
! d0ecfbaed2a882166d23beefe5f4e191  gcc/testsuite/ada/acats-4/tests/c7/c761003.a
! 553e4393e53175606097eb8c9b415d22  gcc/testsuite/ada/acats-4/tests/c7/c761004.a
! 4a7c5e1c13695ae75ad3a4df49a55b63  gcc/testsuite/ada/acats-4/tests/c7/c761005.a
! d4f8faae1d5f7970e56d7a30c10a99c7  gcc/testsuite/ada/acats-4/tests/c7/c761006.a
! a8b974a47ec1f7a4a5fc2ef06975f069  gcc/testsuite/ada/acats-4/tests/c7/c761007.a
! 6ca84026fc9a5682d2db1f346eb920cd  gcc/testsuite/ada/acats-4/tests/c7/c761010.a
! 8f26af4ffb9bc7a2e15aee7b1c0c2346  gcc/testsuite/ada/acats-4/tests/c7/c761011.a
! d80406039e2bebf54191eec198c10721  gcc/testsuite/ada/acats-4/tests/c7/c761012.a
! 7eeee1f9268711339cf1323b9bd1841e  gcc/testsuite/ada/acats-4/tests/c7/c761013.a
! f7baee35e01e625d64802c987ddc4c0d  gcc/testsuite/ada/acats-4/tests/c8/c83007a.ada
! 9f1228dfaacf209725a2e8d706128a4c  gcc/testsuite/ada/acats-4/tests/c8/c83012d.ada
! a2e774207100bd5fbb0289bb8ba9f031  gcc/testsuite/ada/acats-4/tests/c8/c83022a.ada
! c214085c4cbff44807225c3aee9be7db  gcc/testsuite/ada/acats-4/tests/c8/c83022g0.ada
! 7aeac4b952eedc1419039fc50c66c732  gcc/testsuite/ada/acats-4/tests/c8/c83022g1.ada
! fedc05f63c2cd512653891054d7d5dad  gcc/testsuite/ada/acats-4/tests/c8/c83023a.ada
! 94cc28ec1a7a9d2aedbab6f2101d2215  gcc/testsuite/ada/acats-4/tests/c8/c83024a.ada
! cd79a99f6b5ce8030462ce917a77a33c  gcc/testsuite/ada/acats-4/tests/c8/c83024e0.ada
! b03af2deceb02b0227f887041379f641  gcc/testsuite/ada/acats-4/tests/c8/c83024e1.ada
! d7544d2786bfc552a30612041df95429  gcc/testsuite/ada/acats-4/tests/c8/c83025a.ada
! 881d6130cfcbd30f4a739889d50396da  gcc/testsuite/ada/acats-4/tests/c8/c83025c.ada
! f35a334aaf4110ea4446247ad6a098f4  gcc/testsuite/ada/acats-4/tests/c8/c83027a.ada
! 37c08965e5d871d3a35ff35f67e713d8  gcc/testsuite/ada/acats-4/tests/c8/c83027c.ada
! 32c440ad7d9ac139bbd4251c4fc10cc4  gcc/testsuite/ada/acats-4/tests/c8/c83028a.ada
! 284725a771243ec2eb877c3bb20240af  gcc/testsuite/ada/acats-4/tests/c8/c83029a.ada
! 0d4d1e41b05e2587d04c09930491aecd  gcc/testsuite/ada/acats-4/tests/c8/c83030a.ada
! 736b92fd2fdec116e1e9a28e04fe105a  gcc/testsuite/ada/acats-4/tests/c8/c83030c.ada
! 8e7b338ab4662f4c219903b9017a3252  gcc/testsuite/ada/acats-4/tests/c8/c83031a.ada
! 8799fc3b7ae4481b9d03ab137000f62e  gcc/testsuite/ada/acats-4/tests/c8/c83031c.ada
! 4c6a471797dc4320ecdae183b931f1e8  gcc/testsuite/ada/acats-4/tests/c8/c83031e.ada
! a6758128580028e639e0a59521425cf0  gcc/testsuite/ada/acats-4/tests/c8/c83032a.ada
! 72628676c750edbd1f98131cb5571a2f  gcc/testsuite/ada/acats-4/tests/c8/c83033a.ada
! 9431427fb4aa9f6e7d3a4375ffaecc6c  gcc/testsuite/ada/acats-4/tests/c8/c83051a.ada
! e95f7524078ffe1a55c455817320ee94  gcc/testsuite/ada/acats-4/tests/c8/c831001.a
! f2fa97381bbbbba9176ccf7627ee5fd8  gcc/testsuite/ada/acats-4/tests/c8/c83b02a.ada
! 03bdf2b2546804982387b339182818e7  gcc/testsuite/ada/acats-4/tests/c8/c83b02b.ada
! 40875d29e98f8a554f57a2cbba7d7b3e  gcc/testsuite/ada/acats-4/tests/c8/c83e02a.ada
! 14cf40af4f9b58380697256b2d355287  gcc/testsuite/ada/acats-4/tests/c8/c83e02b.ada
! 200ef6a026cfe27a93be29d96cf214b8  gcc/testsuite/ada/acats-4/tests/c8/c83e03a.ada
! ad5525a2d740a4d893fcd637c63649fd  gcc/testsuite/ada/acats-4/tests/c8/c83f01a.ada
! e565198c8053dc81f1f530025b0d226b  gcc/testsuite/ada/acats-4/tests/c8/c83f01b.ada
! 6d7321886000c19fde08f583e57a7e33  gcc/testsuite/ada/acats-4/tests/c8/c83f01c0.ada
! b0f89c8df04b680d3d4603f896b4d648  gcc/testsuite/ada/acats-4/tests/c8/c83f01c1.ada
! faebab8928acaa2b8fbf803db9d9d76e  gcc/testsuite/ada/acats-4/tests/c8/c83f01c2.ada
! 76e6504b3bae53ff3ed9396d5c7812a4  gcc/testsuite/ada/acats-4/tests/c8/c83f01d0.ada
! 64bf8f6ff542539524d925d1e5a9cfe4  gcc/testsuite/ada/acats-4/tests/c8/c83f01d1.ada
! 8a46931f49572809caa7fa3dacf72336  gcc/testsuite/ada/acats-4/tests/c8/c83f03a.ada
! 12f92031807ee7b6703ecca17d07c9ad  gcc/testsuite/ada/acats-4/tests/c8/c83f03b.ada
! 2f7e657595b99ed4902cb3ed7aae770f  gcc/testsuite/ada/acats-4/tests/c8/c83f03c0.ada
! b07043910b1b62a4647fb0958270ab2e  gcc/testsuite/ada/acats-4/tests/c8/c83f03c1.ada
! 2a8ed5812b7eba602e55bc4cba957511  gcc/testsuite/ada/acats-4/tests/c8/c83f03c2.ada
! d29900c193533f0d919bf89d2bc8e119  gcc/testsuite/ada/acats-4/tests/c8/c83f03d0.ada
! a81483935d1a82f02d88010465d1f944  gcc/testsuite/ada/acats-4/tests/c8/c83f03d1.ada
! 29bd80df35d00ef1384ad39409db64f6  gcc/testsuite/ada/acats-4/tests/c8/c840001.a
! b4c025ffcff8bdca75ec3121d2fb4ff7  gcc/testsuite/ada/acats-4/tests/c8/c840002.a
! af9ade351c5ef6a9d951a20d59988380  gcc/testsuite/ada/acats-4/tests/c8/c84002a.ada
! 66d1e4c5ecfdc60f73f72122f13591ac  gcc/testsuite/ada/acats-4/tests/c8/c84005a.ada
! aa6a6f80ff85e69f2df4df4eede3b31f  gcc/testsuite/ada/acats-4/tests/c8/c84008a.ada
! 09c80b3d29e25029f03088427d21bbcc  gcc/testsuite/ada/acats-4/tests/c8/c84009a.ada
! d7b3488b66a68bdb7c8d505ca3419ac7  gcc/testsuite/ada/acats-4/tests/c8/c85004b.ada
! 3e0403d2aa151370c2f61352a9f76996  gcc/testsuite/ada/acats-4/tests/c8/c85005a.ada
! 37c7fd0ed7d0bc32d740e9c53a118651  gcc/testsuite/ada/acats-4/tests/c8/c85005b.ada
! 1fc662c5706ae3323d79577161aa2b7c  gcc/testsuite/ada/acats-4/tests/c8/c85005c.ada
! c7c4cd7450d2b2ce6c9f804ab189b71e  gcc/testsuite/ada/acats-4/tests/c8/c85005d.ada
! 39a019807c800fea7de5ee674f51f3ac  gcc/testsuite/ada/acats-4/tests/c8/c85005e.ada
! 8d1e127599b478a2675315047b0c481f  gcc/testsuite/ada/acats-4/tests/c8/c85005f.ada
! 25bfcee3ce65c19279f2e6ae6c7dbfba  gcc/testsuite/ada/acats-4/tests/c8/c85005g.ada
! 32fef31a23447e83e62b591ccf214749  gcc/testsuite/ada/acats-4/tests/c8/c85006a.ada
! 52a38ccdb969e742c721e8c6b91f9aee  gcc/testsuite/ada/acats-4/tests/c8/c85006b.ada
! b8b2355c13723ce1e608404a697d37f1  gcc/testsuite/ada/acats-4/tests/c8/c85006c.ada
! f9f754296bb969ded99acf18e0d0cc57  gcc/testsuite/ada/acats-4/tests/c8/c85006d.ada
! 13a5f5c38fb9c62ade83208e0c68d79e  gcc/testsuite/ada/acats-4/tests/c8/c85006e.ada
! 338359196a7f9ec95687b438473fe4b5  gcc/testsuite/ada/acats-4/tests/c8/c85006f.ada
! 2009399861eb5a59e17598709aab1ac2  gcc/testsuite/ada/acats-4/tests/c8/c85006g.ada
! 81de8bcdf2627a437c3e3b841e5fad1d  gcc/testsuite/ada/acats-4/tests/c8/c85007a.ada
! e357cc223f207047a721ac8e8e18f162  gcc/testsuite/ada/acats-4/tests/c8/c85007e.ada
! 418333040a3a7bff04eadeddd0acb110  gcc/testsuite/ada/acats-4/tests/c8/c85009a.ada
! bd6854facde59a298fdff160083dd037  gcc/testsuite/ada/acats-4/tests/c8/c85011a.ada
! 406a5955e9d949bdd8248e3006f85389  gcc/testsuite/ada/acats-4/tests/c8/c85013a.ada
! 847c4a7e1cbd34854fd30fd728898157  gcc/testsuite/ada/acats-4/tests/c8/c85014a.ada
! b69434a64d3c484bdb87a84269e9963f  gcc/testsuite/ada/acats-4/tests/c8/c85014b.ada
! 2f3c5aa4857fe502b1c9c11e032c6935  gcc/testsuite/ada/acats-4/tests/c8/c85014c.ada
! e1660d68b127c37ec14d42ba45a3b445  gcc/testsuite/ada/acats-4/tests/c8/c85017a.ada
! 1cad26f34f7ad9a5f58bf9e88765aca9  gcc/testsuite/ada/acats-4/tests/c8/c85018a.ada
! 9c45b00830d440af2ac60b55d681400a  gcc/testsuite/ada/acats-4/tests/c8/c85018b.ada
! 8d0a794043808c838cf5adba232cacac  gcc/testsuite/ada/acats-4/tests/c8/c85019a.ada
! 5af58d5fd0b267936c4997ebc76c592f  gcc/testsuite/ada/acats-4/tests/c8/c851001.a
! a2bad21f51f5945720e9692701781872  gcc/testsuite/ada/acats-4/tests/c8/c851002.a
! 9b74243be116d7855c67ebe955d78830  gcc/testsuite/ada/acats-4/tests/c8/c854001.a
! 825c879ca9c376275c17511ad5e00304  gcc/testsuite/ada/acats-4/tests/c8/c854002.a
! d68292de38c7b9e049e07075bbb8e3be  gcc/testsuite/ada/acats-4/tests/c8/c854003.a
! 1f1f18804e6fcf9c4e2fbec6349d04b2  gcc/testsuite/ada/acats-4/tests/c8/c86003a.ada
! e2f34ff3aa901cdf44aa714bfc307b17  gcc/testsuite/ada/acats-4/tests/c8/c86004a.ada
! d4f2cc5c80e276eb1480de6a342d8b63  gcc/testsuite/ada/acats-4/tests/c8/c86004b0.ada
! 50f93d108a0bf0919eb0ba1f6e65d7f0  gcc/testsuite/ada/acats-4/tests/c8/c86004b1.ada
! 6c2d0d9c9429d88e2c6672c71366873c  gcc/testsuite/ada/acats-4/tests/c8/c86004b2.ada
! 7f6e918b2ef0b5adc4139d9b912bc081  gcc/testsuite/ada/acats-4/tests/c8/c86004c0.ada
! a2305c116ad2dac3912371b71c441b61  gcc/testsuite/ada/acats-4/tests/c8/c86004c1.ada
! c7b7606151d38f39564979699b168c79  gcc/testsuite/ada/acats-4/tests/c8/c86004c2.ada
! 0766251158ffbc052bc7ec6041412761  gcc/testsuite/ada/acats-4/tests/c8/c86006i.ada
! 69ab336267b976906702c2d0bc1c1e29  gcc/testsuite/ada/acats-4/tests/c8/c86007a.ada
! 0ac058a1ece69aa243cd82dada40bb30  gcc/testsuite/ada/acats-4/tests/c8/c87a05a.ada
! fff71eeb0c0e9f16ee678756ea7588a4  gcc/testsuite/ada/acats-4/tests/c8/c87a05b.ada
! 2fe0ea4d16046c334c399aafeddc01a8  gcc/testsuite/ada/acats-4/tests/c8/c87b02a.ada
! fcd21b497cf853422b084ed7935381d4  gcc/testsuite/ada/acats-4/tests/c8/c87b02b.ada
! c0b66a348c2ee10edc5467a8eb009d09  gcc/testsuite/ada/acats-4/tests/c8/c87b03a.ada
! adac4007a7fd6b1ee9f1f48c55244d47  gcc/testsuite/ada/acats-4/tests/c8/c87b04a.ada
! 18ccfb1a0d973da4e1686b0c98dfa1a9  gcc/testsuite/ada/acats-4/tests/c8/c87b04b.ada
! 43cf46342879eb1ffe2f7c8971af6a38  gcc/testsuite/ada/acats-4/tests/c8/c87b04c.ada
! d0144de0520c60120721d7b571e3985d  gcc/testsuite/ada/acats-4/tests/c8/c87b05a.ada
! 2b781472cd1369f9eb86a64cd5e4a9d9  gcc/testsuite/ada/acats-4/tests/c8/c87b06a.ada
! c22a9ce42feb05505f797ccc539112bd  gcc/testsuite/ada/acats-4/tests/c8/c87b07a.ada
! 5cb748b4c292f38beadd4b397c9748ef  gcc/testsuite/ada/acats-4/tests/c8/c87b07b.ada
! cd570d3799a0f4ceeabe1513e0c1c809  gcc/testsuite/ada/acats-4/tests/c8/c87b07c.ada
! 94b970485847bd2d888e33a9e0bbeb1c  gcc/testsuite/ada/acats-4/tests/c8/c87b07d.ada
! 4a11dd4cf1ef59a68c9760ade0024c31  gcc/testsuite/ada/acats-4/tests/c8/c87b07e.ada
! e031b7e0f562bef1da7d73abf8e7203d  gcc/testsuite/ada/acats-4/tests/c8/c87b08a.ada
! ddc6096fff2cbf60aa3fe948c1c569c3  gcc/testsuite/ada/acats-4/tests/c8/c87b09a.ada
! 427f1fe54f5946c6611f5abe3d23e213  gcc/testsuite/ada/acats-4/tests/c8/c87b09c.ada
! 4f2d8b50e737f09ccf25f199443471c8  gcc/testsuite/ada/acats-4/tests/c8/c87b10a.ada
! b3ddde623ffa0748cae187472ed3c706  gcc/testsuite/ada/acats-4/tests/c8/c87b11a.ada
! 34f04500698b844ee3bbe19fcec6df7b  gcc/testsuite/ada/acats-4/tests/c8/c87b11b.ada
! 42486daf86c543499fe18e7700c2a2c5  gcc/testsuite/ada/acats-4/tests/c8/c87b13a.ada
! 343104f8b07cc3cdfea584fb91d7dad0  gcc/testsuite/ada/acats-4/tests/c8/c87b14a.ada
! 3129f63056e924075c9eef5fb92ff6be  gcc/testsuite/ada/acats-4/tests/c8/c87b14b.ada
! 9fec6d81e8cfe9a1be8263f1fcff0c24  gcc/testsuite/ada/acats-4/tests/c8/c87b14c.ada
! c9a24774d85aaa6a9ad204d88ef33dc3  gcc/testsuite/ada/acats-4/tests/c8/c87b14d.ada
! 75444b8bc412150144d6500a1c98caa1  gcc/testsuite/ada/acats-4/tests/c8/c87b15a.ada
! b02c9f3d290904a7b941ba27ad5b8cbe  gcc/testsuite/ada/acats-4/tests/c8/c87b16a.ada
! 352fe9e9dcbad212440a7cb09e0f5a22  gcc/testsuite/ada/acats-4/tests/c8/c87b17a.ada
! da9c835dde5437b7c6fd41430e0523c7  gcc/testsuite/ada/acats-4/tests/c8/c87b18a.ada
! 6233d050a9dc22ef89142ebf8f28ccf0  gcc/testsuite/ada/acats-4/tests/c8/c87b18b.ada
! 8d538ac45635004402030cb4640caa57  gcc/testsuite/ada/acats-4/tests/c8/c87b19a.ada
! 2095765cd4def145a48bc901ac6dbde1  gcc/testsuite/ada/acats-4/tests/c8/c87b23a.ada
! 67d87906e113b008e98391cc2776a960  gcc/testsuite/ada/acats-4/tests/c8/c87b24a.ada
! fd73894f92a9b3a013e87ea2b44c1ee4  gcc/testsuite/ada/acats-4/tests/c8/c87b24b.ada
! 3477f0a964a425447d80f280e7b45bf2  gcc/testsuite/ada/acats-4/tests/c8/c87b26b.ada
! b14d1be798ca4f79c28b996d1e8a7113  gcc/testsuite/ada/acats-4/tests/c8/c87b27a.ada
! 52b1e1223a0044bd348db0fcb6d79d6b  gcc/testsuite/ada/acats-4/tests/c8/c87b28a.ada
! a6a5c9403ac6bdbdb2e55d6a25b9f5ed  gcc/testsuite/ada/acats-4/tests/c8/c87b29a.ada
! b151ba31fb04091b8702bb9da4a0a2fb  gcc/testsuite/ada/acats-4/tests/c8/c87b30a.ada
! baa7d485e6d766db9246c9606ba3a078  gcc/testsuite/ada/acats-4/tests/c8/c87b31a.ada
! 78fd2d4c2c4821cfbbf402d3b842e2cc  gcc/testsuite/ada/acats-4/tests/c8/c87b32a.ada
! 833d7f92c1dba9641ebcb3157ab5d24e  gcc/testsuite/ada/acats-4/tests/c8/c87b33a.ada
! 36465d48d4bab661c6218ee48524b608  gcc/testsuite/ada/acats-4/tests/c8/c87b34a.ada
! 561be38a9a0275b65d22f782b23c1f8c  gcc/testsuite/ada/acats-4/tests/c8/c87b34b.ada
! 1239485e0f456d72c43f397227762788  gcc/testsuite/ada/acats-4/tests/c8/c87b34c.ada
! 041b7b6888183bbf71655055555c1b87  gcc/testsuite/ada/acats-4/tests/c8/c87b35c.ada
! ba86ee0565261018e59b1b01d9d63a78  gcc/testsuite/ada/acats-4/tests/c8/c87b38a.ada
! bee8f2cc8e7a407c5d1e665cafb324a0  gcc/testsuite/ada/acats-4/tests/c8/c87b39a.ada
! 0149e0004f1fac32a6d0483505f00a77  gcc/testsuite/ada/acats-4/tests/c8/c87b40a.ada
! 598db3dd5aa31e1541f0b3c4292552c9  gcc/testsuite/ada/acats-4/tests/c8/c87b41a.ada
! 35740da1bae3e32ad7726fef598ebe03  gcc/testsuite/ada/acats-4/tests/c8/c87b42a.ada
! c699f8cb33019178eb66bb9b9887fc34  gcc/testsuite/ada/acats-4/tests/c8/c87b43a.ada
! 284fc10b4e768deed27f6efe5ba660f3  gcc/testsuite/ada/acats-4/tests/c8/c87b44a.ada
! d1cacfe3528a0559f8572409bdad7960  gcc/testsuite/ada/acats-4/tests/c8/c87b45a.ada
! 615100562dae434f6237d50c2ce7a859  gcc/testsuite/ada/acats-4/tests/c8/c87b45c.ada
! ee9fa629414e1ff85ab5a901880627c6  gcc/testsuite/ada/acats-4/tests/c8/c87b47a.ada
! f01c1e9a040d9bf9e82d5b0bd8308ac2  gcc/testsuite/ada/acats-4/tests/c8/c87b48a.ada
! 5f12e71520b411de1dcbfb59ca609af5  gcc/testsuite/ada/acats-4/tests/c8/c87b48b.ada
! 7accae5d8bcb7a6376aeb4769bbc3521  gcc/testsuite/ada/acats-4/tests/c8/c87b50a.ada
! 49e93ad6fd90f250357c964cfe65bbb4  gcc/testsuite/ada/acats-4/tests/c8/c87b54a.ada
! 6b87b80aa7e4be221c3a6fcc95a098e2  gcc/testsuite/ada/acats-4/tests/c8/c87b57a.ada
! e29430c61d05400015468771710caebe  gcc/testsuite/ada/acats-4/tests/c8/c87b62a.ada
! d69bb1d50cac4c6397e7ef6ac85cec47  gcc/testsuite/ada/acats-4/tests/c8/c87b62b.ada
! b2cd3c65ecd1e96a0c0812252c334c48  gcc/testsuite/ada/acats-4/tests/c8/c87b62c.ada
! f48458b6ea766af192adb8d401f368fc  gcc/testsuite/ada/acats-4/tests/c8/c87b62d.tst
! 91802a6e8fc88eaea2b276279ef7c541  gcc/testsuite/ada/acats-4/tests/c9/c910001.a
! 92f4e59378989d90d762b2fdfa367275  gcc/testsuite/ada/acats-4/tests/c9/c910002.a
! 1da7e86ddeb55b8594570c708479d7da  gcc/testsuite/ada/acats-4/tests/c9/c910003.a
! 3e61dff323d06b22fad060cfc4e6bbe3  gcc/testsuite/ada/acats-4/tests/c9/c91004b.ada
! 69469a828c0050868f258475fc71f55d  gcc/testsuite/ada/acats-4/tests/c9/c91004c.ada
! 0ff6798e735543f9ea0902dcd3d33bd4  gcc/testsuite/ada/acats-4/tests/c9/c91006a.ada
! 7f1ab85728a76023b65305acb8480064  gcc/testsuite/ada/acats-4/tests/c9/c91007a.ada
! 22adff9387682c0ca8610830e345b92d  gcc/testsuite/ada/acats-4/tests/c9/c920001.a
! b04d09f1322f0d92c98d41398964503d  gcc/testsuite/ada/acats-4/tests/c9/c92002a.ada
! 5cb78880eadfd9eac647aba39fa528da  gcc/testsuite/ada/acats-4/tests/c9/c92003a.ada
! bfa0af83fa76f2092a243ddded4670d8  gcc/testsuite/ada/acats-4/tests/c9/c92005a.ada
! 379c27e94764b3b61fffdc4a6886f267  gcc/testsuite/ada/acats-4/tests/c9/c92005b.ada
! a47a031badac4df0d97db8bef1c3bc41  gcc/testsuite/ada/acats-4/tests/c9/c92006a.ada
! e4aee3e6761bfd67eaa5d1bd1ef57470  gcc/testsuite/ada/acats-4/tests/c9/c930001.a
! d21857231e61275a32c743ac514d1bc5  gcc/testsuite/ada/acats-4/tests/c9/c93001a.ada
! 493236f457ba46ba4fee16d542742d6c  gcc/testsuite/ada/acats-4/tests/c9/c93002a.ada
! 58f568faf270170c72b48115224a9ea8  gcc/testsuite/ada/acats-4/tests/c9/c93003a.ada
! 7612773970dfbe9066b04bb3ef16a233  gcc/testsuite/ada/acats-4/tests/c9/c93004a.ada
! ba12024ce449c8f19c903d5b83a7772c  gcc/testsuite/ada/acats-4/tests/c9/c93004b.ada
! 84f08b2297ca6e587b20b46ac2f4a739  gcc/testsuite/ada/acats-4/tests/c9/c93004c.ada
! e206bbe8f5a43a6b351e76ac75ac54bf  gcc/testsuite/ada/acats-4/tests/c9/c93004d.ada
! 00ac7aaad0308e432bf16c8682817a14  gcc/testsuite/ada/acats-4/tests/c9/c93004f.ada
! 08c88f164d59d4eab6aca557a4a64946  gcc/testsuite/ada/acats-4/tests/c9/c93005a.ada
! 8e317f80e3b0b4e3561b4aae157d6049  gcc/testsuite/ada/acats-4/tests/c9/c93005b.ada
! 8eb0f9f63c9ab470b543adb3c28caade  gcc/testsuite/ada/acats-4/tests/c9/c93005c.ada
! ccfed501a2a43dc4278db60a237ef173  gcc/testsuite/ada/acats-4/tests/c9/c93005d.ada
! 6da2e602ea719b27a9fadd13cf58a0ee  gcc/testsuite/ada/acats-4/tests/c9/c93005e.ada
! 5a28c2b6ebeaf58c4051285536f97455  gcc/testsuite/ada/acats-4/tests/c9/c93005f.ada
! 8e1ce84492239de8f44d01e7bbab2ec7  gcc/testsuite/ada/acats-4/tests/c9/c93005g.ada
! e0389f04b32525410edb0e1764eb2cae  gcc/testsuite/ada/acats-4/tests/c9/c93005h.ada
! ae1dfb1e47c089aba0b249b5d1795138  gcc/testsuite/ada/acats-4/tests/c9/c93006a.ada
! fe32d2d556faa4d361e61f9063f9d19b  gcc/testsuite/ada/acats-4/tests/c9/c93007a.ada
! 509a386487b4fdf7b8626c27ec59057a  gcc/testsuite/ada/acats-4/tests/c9/c93008a.ada
! dc50dccfb34abb8364f8236474654aef  gcc/testsuite/ada/acats-4/tests/c9/c93008b.ada
! 84c45a691f716f13c1acb83d5af7418d  gcc/testsuite/ada/acats-4/tests/c9/c940001.a
! 99f1785334b15c78f6c402eb9581f820  gcc/testsuite/ada/acats-4/tests/c9/c940002.a
! d4515a061510c374dc4e3b73047c01bd  gcc/testsuite/ada/acats-4/tests/c9/c940004.a
! 86c687ea248b72e3d5adcf8131c84578  gcc/testsuite/ada/acats-4/tests/c9/c940005.a
! 24e534dd458f6d60deaffb89427151e3  gcc/testsuite/ada/acats-4/tests/c9/c940006.a
! 8d5bcb417b72700c7534142482d06f0e  gcc/testsuite/ada/acats-4/tests/c9/c940007.a
! ed93c06c8fbc77ffcb96431dac0e7567  gcc/testsuite/ada/acats-4/tests/c9/c940010.a
! b5f59a7bcad9207813e580204d7d297d  gcc/testsuite/ada/acats-4/tests/c9/c940011.a
! 2cc5af1321a3389a051ba331add4436e  gcc/testsuite/ada/acats-4/tests/c9/c940012.a
! 46c8ffa64ae0068a1674cd8386b42f41  gcc/testsuite/ada/acats-4/tests/c9/c940013.a
! 9fac2bc0e89e8f222104978b3d1eaf3b  gcc/testsuite/ada/acats-4/tests/c9/c940014.a
! 004d847da87db0a9fe57406d26459dfd  gcc/testsuite/ada/acats-4/tests/c9/c940015.a
! 47e9712a5187d745e5ab17e658f2f210  gcc/testsuite/ada/acats-4/tests/c9/c940016.a
! 2e44193305daa3662819696ed485e49e  gcc/testsuite/ada/acats-4/tests/c9/c940017.a
! 6c7757c7f82391d974ee2ade7a1b5023  gcc/testsuite/ada/acats-4/tests/c9/c94001a.ada
! f31231e0a282c4347af1efd6cb3035d8  gcc/testsuite/ada/acats-4/tests/c9/c94001b.ada
! 3b5322b2500d6db6a064276ddcb16f57  gcc/testsuite/ada/acats-4/tests/c9/c94001c.ada
! 5b89b2c47939e01428fda5cdb7b76bfc  gcc/testsuite/ada/acats-4/tests/c9/c94001e.ada
! 79b95e3bce431f5a1d5d5264c35ba5a9  gcc/testsuite/ada/acats-4/tests/c9/c94001f.ada
! 347ad815d8a6a515224aad7f232c01f1  gcc/testsuite/ada/acats-4/tests/c9/c94001g.ada
! 459a8334da9a10b07073ee026daace57  gcc/testsuite/ada/acats-4/tests/c9/c94002a.ada
! 7c5b2f6bf643455b2a9ae3723678ac9d  gcc/testsuite/ada/acats-4/tests/c9/c94002b.ada
! 131233ea081ac6ea10a1e10fbba005f2  gcc/testsuite/ada/acats-4/tests/c9/c94002d.ada
! ac9ef20d61a82671bc9f9903178dfad3  gcc/testsuite/ada/acats-4/tests/c9/c94002e.ada
! 185375e43237c56b7eac5c7c60549a70  gcc/testsuite/ada/acats-4/tests/c9/c94002f.ada
! c92e66c7cb8460dfad830a44a55c023b  gcc/testsuite/ada/acats-4/tests/c9/c94002g.ada
! 22b53f93e23fb62230789979e589e181  gcc/testsuite/ada/acats-4/tests/c9/c94004a.ada
! ccdf0ff8e75742c50231602193bbcbba  gcc/testsuite/ada/acats-4/tests/c9/c94004b.ada
! 3cc3467fbedd3af4df23952c3bff55fa  gcc/testsuite/ada/acats-4/tests/c9/c94004c.ada
! 7984d0d810ada9646b57c6eaf2e1bc4f  gcc/testsuite/ada/acats-4/tests/c9/c94005a.ada
! 65127423a897761cfafb1a3b3138bb1f  gcc/testsuite/ada/acats-4/tests/c9/c94005b.ada
! 4c92726f34140b40fcaafd808f145d62  gcc/testsuite/ada/acats-4/tests/c9/c94006a.ada
! f0bba450c8e12f8e7ee2943272781344  gcc/testsuite/ada/acats-4/tests/c9/c94007a.ada
! c36dc0cd7c39b73a4713107a2d8948de  gcc/testsuite/ada/acats-4/tests/c9/c94007b.ada
! 4c0be4d154afe78593220fcb4ce1db68  gcc/testsuite/ada/acats-4/tests/c9/c94008a.ada
! 850314f1eadf141918c7bb7f3a507541  gcc/testsuite/ada/acats-4/tests/c9/c94008b.ada
! 70c3314e94c0cc9dd7150d99e6290290  gcc/testsuite/ada/acats-4/tests/c9/c94008c.ada
! 489c52c7c750fcabec8c41e51acb5fc1  gcc/testsuite/ada/acats-4/tests/c9/c94008d.ada
! 03924145894e3041b88074680eceb006  gcc/testsuite/ada/acats-4/tests/c9/c94010a.ada
! 136872ec7f9870731797ab20b32f6696  gcc/testsuite/ada/acats-4/tests/c9/c94011a.ada
! a8508d1bdacc8da03549a92370d18ed0  gcc/testsuite/ada/acats-4/tests/c9/c94020a.ada
! 54dba96923cbd3444b91d1706e737c16  gcc/testsuite/ada/acats-4/tests/c9/c940a03.a
! 593cb74e34ea4102821f9d6492dd3def  gcc/testsuite/ada/acats-4/tests/c9/c950001.a
! 1e9d5f1797e48ec475a9b64cd4628e15  gcc/testsuite/ada/acats-4/tests/c9/c95008a.ada
! b48683e2458942b3ffc46be9054c7911  gcc/testsuite/ada/acats-4/tests/c9/c95009a.ada
! b4adaad3668499bb335d018420c56f91  gcc/testsuite/ada/acats-4/tests/c9/c95010a.ada
! 2900d4b177d19e9f35c4693ea6b14ec8  gcc/testsuite/ada/acats-4/tests/c9/c95011a.ada
! 8b06e3c4ff90fbc6c87f0aa942917f64  gcc/testsuite/ada/acats-4/tests/c9/c95012a.ada
! 334307cb5f8056227c22de2d08cd0211  gcc/testsuite/ada/acats-4/tests/c9/c95021a.ada
! c091dcb9509e234377d2ac8ee75d10e0  gcc/testsuite/ada/acats-4/tests/c9/c95022a.ada
! 65035c12f67d253a2397d2126f4ba6c6  gcc/testsuite/ada/acats-4/tests/c9/c95022b.ada
! cc0f07ec1171a66007308281b576f7c4  gcc/testsuite/ada/acats-4/tests/c9/c95033a.ada
! 4de48cf31bf233b1fdc87aeffb9972de  gcc/testsuite/ada/acats-4/tests/c9/c95033b.ada
! 9a258973fb062d294f4650087b4d0a5f  gcc/testsuite/ada/acats-4/tests/c9/c95034a.ada
! 3d8db74de3a313439a198f8f729ff8d1  gcc/testsuite/ada/acats-4/tests/c9/c95034b.ada
! e9df6b06717b893630f87cfbeaf3639b  gcc/testsuite/ada/acats-4/tests/c9/c95035a.ada
! 3eda3680c647ff3fb263637efebd9f65  gcc/testsuite/ada/acats-4/tests/c9/c95040a.ada
! 86d92231fb9f979c23be2a93dab90d49  gcc/testsuite/ada/acats-4/tests/c9/c95040b.ada
! ed765b423843bd4ca78de15c1b071692  gcc/testsuite/ada/acats-4/tests/c9/c95040c.ada
! 30e738c92230ba86578f011623e5802a  gcc/testsuite/ada/acats-4/tests/c9/c95040d.ada
! 168221198b482975d09392b2fcad8a7b  gcc/testsuite/ada/acats-4/tests/c9/c95041a.ada
! c6313618d1cd8a8218dcd446fd95a86e  gcc/testsuite/ada/acats-4/tests/c9/c95065a.ada
! 8832636689a3eda560469f04cfa76418  gcc/testsuite/ada/acats-4/tests/c9/c95065b.ada
! 5aaadcb32b841fad9f31245493b516f6  gcc/testsuite/ada/acats-4/tests/c9/c95065c.ada
! a39b19410538e12fdfcb7cd54d120b3f  gcc/testsuite/ada/acats-4/tests/c9/c95065d.ada
! 383b7f01039162f8c331982cca1d1827  gcc/testsuite/ada/acats-4/tests/c9/c95065e.ada
! c184eac9dc26cf8493bcf20a949ae191  gcc/testsuite/ada/acats-4/tests/c9/c95065f.ada
! 5b0b09d3d393123f8092b9dd3d7d2634  gcc/testsuite/ada/acats-4/tests/c9/c95066a.ada
! 645546a6994e4d75b178f9fe0ead2ec8  gcc/testsuite/ada/acats-4/tests/c9/c95067a.ada
! 0d96b6a028d1fbdc1198cf477386cb10  gcc/testsuite/ada/acats-4/tests/c9/c95071a.ada
! bd5b6bb2bf3ba074df027795aaa7db33  gcc/testsuite/ada/acats-4/tests/c9/c95072b.ada
! befede1120f2f7955e0b77c883265e25  gcc/testsuite/ada/acats-4/tests/c9/c95073a.ada
! 48c97fe967f3c5e1bc663c5d91ed55bd  gcc/testsuite/ada/acats-4/tests/c9/c95074c.ada
! 6aaf0bf21901d478c7f10321b1c232fc  gcc/testsuite/ada/acats-4/tests/c9/c95076a.ada
! ba053d263ff25d0fe8b66c68cb7bb311  gcc/testsuite/ada/acats-4/tests/c9/c95078a.ada
! a7e9f0e064ac2a29ebe79a19983758dc  gcc/testsuite/ada/acats-4/tests/c9/c95080b.ada
! 73fa133c9eac6146a770bb5525331e35  gcc/testsuite/ada/acats-4/tests/c9/c95082g.ada
! 61f2b9320583cc5ff1eca06b3e8cd887  gcc/testsuite/ada/acats-4/tests/c9/c95085a.ada
! 9e1cf3433f8341a6b183079a377b0fad  gcc/testsuite/ada/acats-4/tests/c9/c95085b.ada
! e39dbe6050c2679aa6a7d89c762e8c0a  gcc/testsuite/ada/acats-4/tests/c9/c95085c.ada
! 6c946d9a6886fc8b7d6145f3958a1016  gcc/testsuite/ada/acats-4/tests/c9/c95085d.ada
! c8c26f8183027ac456df33b272a0e185  gcc/testsuite/ada/acats-4/tests/c9/c95085e.ada
! e29633617dcca72904423b7e09ea1401  gcc/testsuite/ada/acats-4/tests/c9/c95085f.ada
! 3e1d9c4d7627f1b32df23e0787f1ae30  gcc/testsuite/ada/acats-4/tests/c9/c95085g.ada
! 55b52211957a2231b59c295b91e1bbfe  gcc/testsuite/ada/acats-4/tests/c9/c95085h.ada
! f472998d938475a0a5b7c61c4a994dbe  gcc/testsuite/ada/acats-4/tests/c9/c95085i.ada
! e7d6c7d1e457a9097de27a4d4b6df67e  gcc/testsuite/ada/acats-4/tests/c9/c95085j.ada
! 9dcf6b0120351dbd31ca6b3b07007dda  gcc/testsuite/ada/acats-4/tests/c9/c95085k.ada
! f65f9568bbdcba31e56e46a1bff7a8a7  gcc/testsuite/ada/acats-4/tests/c9/c95085l.ada
! 2794ec3980004ff90d3fdda0ebeb57be  gcc/testsuite/ada/acats-4/tests/c9/c95085m.ada
! cd5e6789b1381a01c8abe9b8efc437eb  gcc/testsuite/ada/acats-4/tests/c9/c95085n.ada
! ec751b6898b7a50e0c7e413ac04f3096  gcc/testsuite/ada/acats-4/tests/c9/c95085o.ada
! 4d079ed4815a2d61d769f5571e546504  gcc/testsuite/ada/acats-4/tests/c9/c95086a.ada
! 3f5ba7557a56b3376b0d11a44977eb6b  gcc/testsuite/ada/acats-4/tests/c9/c95086b.ada
! 4423694080505c12206b273d44b25a6c  gcc/testsuite/ada/acats-4/tests/c9/c95086c.ada
! 9ddcd960179a50f19400614669ee58dd  gcc/testsuite/ada/acats-4/tests/c9/c95086d.ada
! b943966db2007cce0bd0ab55a7241cb6  gcc/testsuite/ada/acats-4/tests/c9/c95086e.ada
! 63af3fb63913a9ced35b10b55e03d16c  gcc/testsuite/ada/acats-4/tests/c9/c95086f.ada
! fb4e2598701ac2222961218c56e9989e  gcc/testsuite/ada/acats-4/tests/c9/c95087a.ada
! 6ca41778e752016a3cb5f39d3655160a  gcc/testsuite/ada/acats-4/tests/c9/c95087b.ada
! b77cd9cab875027ed13370d439f3d83a  gcc/testsuite/ada/acats-4/tests/c9/c95087c.ada
! 94c2f92c8d38ace856b3d3a4e46e2f10  gcc/testsuite/ada/acats-4/tests/c9/c95087d.ada
! 8ace111d2db71af514234c843bcdc774  gcc/testsuite/ada/acats-4/tests/c9/c95088a.ada
! 3eab89caa6cfdaad3ecaee2fb3a9de67  gcc/testsuite/ada/acats-4/tests/c9/c95089a.ada
! c23a0d393dfca230669443fa90939e9e  gcc/testsuite/ada/acats-4/tests/c9/c95090a.ada
! 2dea0b25d5837e3f040a606b74b5bfe7  gcc/testsuite/ada/acats-4/tests/c9/c95092a.ada
! da5b15c611f0e80c4bd500a6377cf1fb  gcc/testsuite/ada/acats-4/tests/c9/c95093a.ada
! 411e85f00716bde0eb4bebe2dd4a4b17  gcc/testsuite/ada/acats-4/tests/c9/c95095a.ada
! 20d01625fd521f83c0fbb4e0d5989f1c  gcc/testsuite/ada/acats-4/tests/c9/c95095b.ada
! f1a2d7fb3c08ba5c9b45d28b8c434cf9  gcc/testsuite/ada/acats-4/tests/c9/c95095c.ada
! 3b8c3428be0e17426f9f4fc13d71bfe3  gcc/testsuite/ada/acats-4/tests/c9/c95095d.ada
! d71ab35932ba486e65cee5d0a7ea6c58  gcc/testsuite/ada/acats-4/tests/c9/c95095e.ada
! b665ab275e30b4a49c6a32d1c1b8d3b0  gcc/testsuite/ada/acats-4/tests/c9/c951001.a
! cf8871bf7a3b31099f34c49d8660c890  gcc/testsuite/ada/acats-4/tests/c9/c951002.a
! 380eef904bedee70e470eec6283fe7fa  gcc/testsuite/ada/acats-4/tests/c9/c953001.a
! 8b4cbf1e111e939494dbd6c9170d9add  gcc/testsuite/ada/acats-4/tests/c9/c953002.a
! b85e67ebb144368e710912fad26fa9b5  gcc/testsuite/ada/acats-4/tests/c9/c953003.a
! 349793c14b6ee642849a35ac147f6d28  gcc/testsuite/ada/acats-4/tests/c9/c954001.a
! 32a2b22071eb90de620dac85832e7e33  gcc/testsuite/ada/acats-4/tests/c9/c954010.a
! 5c71f334e75e4b81847ba6609055a721  gcc/testsuite/ada/acats-4/tests/c9/c954011.a
! 0f6b02e34f34de574c7f90adcb78c1d3  gcc/testsuite/ada/acats-4/tests/c9/c954012.a
! 9df6b21dcd077453933aff79109728c8  gcc/testsuite/ada/acats-4/tests/c9/c954013.a
! 498084096b8ec59a36a889374ad9ee3e  gcc/testsuite/ada/acats-4/tests/c9/c954014.a
! 97799887dcbf60005b2df40f05636514  gcc/testsuite/ada/acats-4/tests/c9/c954015.a
! 2490fc80b69ada26f8142dacebcc5823  gcc/testsuite/ada/acats-4/tests/c9/c954016.a
! 23e5c9126dfc78e228cd9ba7e9fd2f4d  gcc/testsuite/ada/acats-4/tests/c9/c954017.a
! bdfa1b9ada52a8082dfc30a91d56af89  gcc/testsuite/ada/acats-4/tests/c9/c954018.a
! e039ba87aa8e5a87f7f74695cc19d917  gcc/testsuite/ada/acats-4/tests/c9/c954019.a
! 718a1dda410ad24ef00a024b2e415626  gcc/testsuite/ada/acats-4/tests/c9/c954020.a
! 8f5a7fd94fd12664cdd2a1cedfcad90c  gcc/testsuite/ada/acats-4/tests/c9/c954021.a
! 34dbbc567c8a72d4e43da4684357c65d  gcc/testsuite/ada/acats-4/tests/c9/c954022.a
! acd00fcab6e1b0d13797a97adc97adb7  gcc/testsuite/ada/acats-4/tests/c9/c954023.a
! 2b49282ca4813eb7610dffe2400f50ff  gcc/testsuite/ada/acats-4/tests/c9/c954024.a
! 26bcb24cd663124317c9acb5f29572c2  gcc/testsuite/ada/acats-4/tests/c9/c954025.a
! 3d08a9c3acd86b2c9e676b1b7428d52e  gcc/testsuite/ada/acats-4/tests/c9/c954026.a
! f6a33c447f57c0517b04392d7f3b4aa6  gcc/testsuite/ada/acats-4/tests/c9/c954027.a
! a58e8d1988af8fca3ca74804c5baee9d  gcc/testsuite/ada/acats-4/tests/c9/c954a01.a
! d07c1374471df9299b8057f6479a45e6  gcc/testsuite/ada/acats-4/tests/c9/c954a02.a
! b1b9ce862c0b325027b8ea2d1d8cc916  gcc/testsuite/ada/acats-4/tests/c9/c954a03.a
! d02e3ef0eb5c7ba2f412817b49644270  gcc/testsuite/ada/acats-4/tests/c9/c960001.a
! da6bb14a212aa02754b6596d741c04b8  gcc/testsuite/ada/acats-4/tests/c9/c960002.a
! 4c5c6b7d7706870241781f97576eef1b  gcc/testsuite/ada/acats-4/tests/c9/c960004.a
! 3acd8b5bcb9a64768ff335d6f3c0802f  gcc/testsuite/ada/acats-4/tests/c9/c96001a.ada
! da6da86c634ab13e2c59ef2e0f66e037  gcc/testsuite/ada/acats-4/tests/c9/c96004a.ada
! 2f64957621aaee0d11d2f8171f4e6709  gcc/testsuite/ada/acats-4/tests/c9/c96005a.ada
! 7fad724f14640158cc9929364f0bb44f  gcc/testsuite/ada/acats-4/tests/c9/c96005b.tst
! 6e3aebd279f9456cefe6dc63b3b9331e  gcc/testsuite/ada/acats-4/tests/c9/c96005d.ada
! 48530b441ec07b282f87a1b285f46461  gcc/testsuite/ada/acats-4/tests/c9/c96005f.ada
! 4ea722032f17d484d0a99cb53bc930ac  gcc/testsuite/ada/acats-4/tests/c9/c96006a.ada
! 83d75c4aa3732428ebf8864a605ee0d4  gcc/testsuite/ada/acats-4/tests/c9/c96007a.ada
! 031bef964d04e0ec5db2ff1f13daa5c1  gcc/testsuite/ada/acats-4/tests/c9/c96008a.ada
! f1d6b97aec5c567380c522a41db1aba7  gcc/testsuite/ada/acats-4/tests/c9/c96008b.ada
! d934b2c088763c44a881ec2055f7c05a  gcc/testsuite/ada/acats-4/tests/c9/c961001.a
! 42ae6b800a394053e192f10d5e9f2932  gcc/testsuite/ada/acats-4/tests/c9/c97112a.ada
! 60aa07cca5e8f5e4b7d0a79c6b74d55c  gcc/testsuite/ada/acats-4/tests/c9/c97113a.ada
! d3c1ec184af46cbef372f5696b266b34  gcc/testsuite/ada/acats-4/tests/c9/c97114a.ada
! 02807471c0330286ea544a5579567337  gcc/testsuite/ada/acats-4/tests/c9/c97115a.ada
! 26b64826d3bd1be74adb7879b1f7c2bb  gcc/testsuite/ada/acats-4/tests/c9/c97116a.ada
! 4e1bee03164214d6b948f1c4d7727423  gcc/testsuite/ada/acats-4/tests/c9/c97117a.ada
! fd17991b93f3552484bd67767dd7c7ff  gcc/testsuite/ada/acats-4/tests/c9/c97117b.ada
! 1e78b3f1d21965db0e71c8f106131bc6  gcc/testsuite/ada/acats-4/tests/c9/c97117c.ada
! f191d3219d72a4add4ab8c70378bf8a9  gcc/testsuite/ada/acats-4/tests/c9/c97118a.ada
! efc7575b03d99c53ecda47137a1597bb  gcc/testsuite/ada/acats-4/tests/c9/c97120a.ada
! c9a13ca3f9047e1c62d7573c2a552f18  gcc/testsuite/ada/acats-4/tests/c9/c97120b.ada
! d6606fac2f86c01ef106a193d274ec96  gcc/testsuite/ada/acats-4/tests/c9/c97201a.ada
! 84d46aa60b0a05e84d69cbccb1a3b8d4  gcc/testsuite/ada/acats-4/tests/c9/c97201b.ada
! 32743b2ed9403b69d98c56734934fa8f  gcc/testsuite/ada/acats-4/tests/c9/c97201c.ada
! 1feeeccbfc144d846a5fac5dc371b1ab  gcc/testsuite/ada/acats-4/tests/c9/c97201d.ada
! 4b003338cd3cfce9c7070dea4b8370a1  gcc/testsuite/ada/acats-4/tests/c9/c97201e.ada
! 383c30d1a9dc6fba56fb3b68b9d8417d  gcc/testsuite/ada/acats-4/tests/c9/c97201g.ada
! 2a874dccde240e48a4f9b0c6b5175219  gcc/testsuite/ada/acats-4/tests/c9/c97201h.ada
! a7aec17b036081fd245c141c14cea8c3  gcc/testsuite/ada/acats-4/tests/c9/c97201x.ada
! 8b04c9ca3ccf2bd719076369af023d12  gcc/testsuite/ada/acats-4/tests/c9/c97202a.ada
! 096a975a5320d43a7ba562f9f18d94e6  gcc/testsuite/ada/acats-4/tests/c9/c97203a.ada
! 4470e62031e7933d85cbc73da17fef70  gcc/testsuite/ada/acats-4/tests/c9/c97203b.ada
! 64b03c91289d25db071b852a88b5d9cb  gcc/testsuite/ada/acats-4/tests/c9/c97203c.ada
! 8820ba0855677ba4eb88ba58afeb783b  gcc/testsuite/ada/acats-4/tests/c9/c97204a.ada
! d4911cea3ce93679f126d507a45d22fa  gcc/testsuite/ada/acats-4/tests/c9/c97204b.ada
! 7d45cd155a83dd7ac338ae2185713729  gcc/testsuite/ada/acats-4/tests/c9/c97205a.ada
! acf42eb169ed97d94717ac061f67ae0a  gcc/testsuite/ada/acats-4/tests/c9/c97205b.ada
! 15fdb55feba1b010ab02767da3fba948  gcc/testsuite/ada/acats-4/tests/c9/c97301a.ada
! 290749e7b52a4f164e55510577176b9a  gcc/testsuite/ada/acats-4/tests/c9/c97301b.ada
! 35cbbf60204d1e52391ace28303dcf3f  gcc/testsuite/ada/acats-4/tests/c9/c97301c.ada
! ccc6a2da670537829e5b747589e65672  gcc/testsuite/ada/acats-4/tests/c9/c97301d.ada
! debc0fe0d35adbe5523204e6de746a43  gcc/testsuite/ada/acats-4/tests/c9/c97301e.ada
! 7fb0028090247956e3df39483acdd63e  gcc/testsuite/ada/acats-4/tests/c9/c97302a.ada
! fa79e177e5672a2e5ec294c27aebcbcf  gcc/testsuite/ada/acats-4/tests/c9/c97303a.ada
! 972e3174910edc4c6aa847cf1eaee9e0  gcc/testsuite/ada/acats-4/tests/c9/c97303b.ada
! 72709aa77c93e4bdc1472ea4622c65a6  gcc/testsuite/ada/acats-4/tests/c9/c97303c.ada
! b5c0f6a57278a89eee76e31418e14fa2  gcc/testsuite/ada/acats-4/tests/c9/c97304a.ada
! b3a69349bfed838a818c2ae32eca91c9  gcc/testsuite/ada/acats-4/tests/c9/c97304b.ada
! bbb0cec48b02d152aff64bf67daf4fd2  gcc/testsuite/ada/acats-4/tests/c9/c97305a.ada
! 522bda7413f7bb569c55a98d2de1b899  gcc/testsuite/ada/acats-4/tests/c9/c97305b.ada
! f4ef7c1a9fda0961493f36a0dd35e00f  gcc/testsuite/ada/acats-4/tests/c9/c97305c.ada
! 08a61c22e9dc33c9f5b70426dd77ba8c  gcc/testsuite/ada/acats-4/tests/c9/c97305d.ada
! e04c1ec69662c6ad7f314711e132d50b  gcc/testsuite/ada/acats-4/tests/c9/c97307a.ada
! 3159a203f1d3e85954c526f58a3919f1  gcc/testsuite/ada/acats-4/tests/c9/c974001.a
! 0314ba23ab70ea268178d5697c5a9034  gcc/testsuite/ada/acats-4/tests/c9/c974002.a
! f748892726b6f9f427e087ed38edff1e  gcc/testsuite/ada/acats-4/tests/c9/c974003.a
! 68b75700dc10aa1f753b947e8cfc83f7  gcc/testsuite/ada/acats-4/tests/c9/c974004.a
! c9f29dff7d0c7abcfdc4dd10f92cc818  gcc/testsuite/ada/acats-4/tests/c9/c974005.a
! 58bc14008a240c1458d789aea37231f5  gcc/testsuite/ada/acats-4/tests/c9/c974006.a
! 6386f90159d93f8e888fc5c7606c48ab  gcc/testsuite/ada/acats-4/tests/c9/c974007.a
! 091b77c15a7a69901928f3e08e5d560b  gcc/testsuite/ada/acats-4/tests/c9/c974008.a
! 4286211e8302b327c6fcddd998068801  gcc/testsuite/ada/acats-4/tests/c9/c974009.a
! 91418d184ffd74f3511f7c7fecf5ad4c  gcc/testsuite/ada/acats-4/tests/c9/c974010.a
! fb71769796ae10266d6396de27fcd9f3  gcc/testsuite/ada/acats-4/tests/c9/c974011.a
! 75ae944a2f56bfec34a43bcac81f0f6a  gcc/testsuite/ada/acats-4/tests/c9/c974012.a
! cf3493d33888a126779c4a1fd8c7e171  gcc/testsuite/ada/acats-4/tests/c9/c974013.a
! 0100f02b896d741021d8771778c05fe4  gcc/testsuite/ada/acats-4/tests/c9/c974014.a
! 120dd4802d990998dbefafba1d6bdf05  gcc/testsuite/ada/acats-4/tests/c9/c980001.a
! 98a89250f238d2d958192b464be9c644  gcc/testsuite/ada/acats-4/tests/c9/c980002.a
! 387e8d4bc42079cf88da235a35d5db46  gcc/testsuite/ada/acats-4/tests/c9/c980003.a
! 7ac21cbd7f3a077b85429173c95a43ee  gcc/testsuite/ada/acats-4/tests/c9/c990001.a
! ea2021deb386c024ed24a2d95220d566  gcc/testsuite/ada/acats-4/tests/c9/c99005a.ada
! de77ae469eab847fef3e1220aa3087ba  gcc/testsuite/ada/acats-4/tests/c9/c9a003a.ada
! f6efef2daeceae0601810ea34d294ebe  gcc/testsuite/ada/acats-4/tests/c9/c9a004a.ada
! c9ad756833c7a77a9c09228f6fe564de  gcc/testsuite/ada/acats-4/tests/c9/c9a007a.ada
! d7d23b9be56f63a7a3eb64ae5740a50f  gcc/testsuite/ada/acats-4/tests/c9/c9a009a.ada
! 4a79ec0aad1fb7e6af0cb13c26c8a078  gcc/testsuite/ada/acats-4/tests/c9/c9a009c.ada
! a6fedb4d1bd7420511136db146b4479f  gcc/testsuite/ada/acats-4/tests/c9/c9a009f.ada
! 92177b39404bc5c23481f443eee705e0  gcc/testsuite/ada/acats-4/tests/c9/c9a009g.ada
! 56b8d40db1bb38ab15ba53a518a8e8e3  gcc/testsuite/ada/acats-4/tests/c9/c9a009h.ada
! 378ed54deee6ae14733d353d1d034e4e  gcc/testsuite/ada/acats-4/tests/c9/c9a010a.ada
! 7e86b851f4df1a5b809ec8656042b7f1  gcc/testsuite/ada/acats-4/tests/c9/c9a011a.ada
! f9c3429a965752694e1fdc1a0bbb60fb  gcc/testsuite/ada/acats-4/tests/c9/c9a011b.ada
! 204dadfff9a19c758cd37f55b4c4da7c  gcc/testsuite/ada/acats-4/tests/ca/ca1003a.ada
! 763e67e5131cf453849af1119c81ab73  gcc/testsuite/ada/acats-4/tests/ca/ca1004a.ada
! 4dd6d7580352576ccd7263ab195d5863  gcc/testsuite/ada/acats-4/tests/ca/ca1005a.ada
! 129a313a5c15d69fc95b27e10654ea3b  gcc/testsuite/ada/acats-4/tests/ca/ca1006a.ada
! 150e449e50b6c5dbc1ef87fb7cbf4fb9  gcc/testsuite/ada/acats-4/tests/ca/ca1011a0.ada
! 590b512fe8313d2c235285182f8eda0d  gcc/testsuite/ada/acats-4/tests/ca/ca1011a1.ada
! 75907d5f95c902eae76627ab16c741b7  gcc/testsuite/ada/acats-4/tests/ca/ca1011a2.ada
! 401ad7f509f398efd9094cfb553d02ca  gcc/testsuite/ada/acats-4/tests/ca/ca1011a3.ada
! d6d2e55e299aae0f7b20781714e0f6d9  gcc/testsuite/ada/acats-4/tests/ca/ca1011a4.ada
! e840ac05d90e7ef06dac4303f5747d0c  gcc/testsuite/ada/acats-4/tests/ca/ca1011a5.ada
! 696cc4292fd590eaf3673d74b1c0c4f9  gcc/testsuite/ada/acats-4/tests/ca/ca1011a6.ada
! 19ae39e48cdc2ea32ddbde00fdb0bf17  gcc/testsuite/ada/acats-4/tests/ca/ca1012a0.ada
! c3bd20289c2b3b2422a8e051dfc8b100  gcc/testsuite/ada/acats-4/tests/ca/ca1012a1.ada
! 010a8d3290ef3a0b00bcbe784544f65f  gcc/testsuite/ada/acats-4/tests/ca/ca1012a2.ada
! 49dff1e5fe3bc3d0814772fe822732a9  gcc/testsuite/ada/acats-4/tests/ca/ca1012a3.ada
! 3660d5d1740e1e424e76277266bd8268  gcc/testsuite/ada/acats-4/tests/ca/ca1012a4.ada
! 2a073bfb3680a6d94b420c58b535dda1  gcc/testsuite/ada/acats-4/tests/ca/ca1012b0.ada
! 1d0a019e12d9aec35762beffba68a14a  gcc/testsuite/ada/acats-4/tests/ca/ca1012b2.ada
! 8fe092748b9f031c395eb8aa90296599  gcc/testsuite/ada/acats-4/tests/ca/ca1012b4.ada
! 2ee859ea2c2cb8cd94e30b6c19c152f7  gcc/testsuite/ada/acats-4/tests/ca/ca1013a0.ada
! a15e85ff9101c6b7debdc0a508f121b6  gcc/testsuite/ada/acats-4/tests/ca/ca1013a1.ada
! 03baa6347b38eb86dabe6092928f99a3  gcc/testsuite/ada/acats-4/tests/ca/ca1013a2.ada
! a81d2aa44c2ded0527dbc731919e9089  gcc/testsuite/ada/acats-4/tests/ca/ca1013a3.ada
! baa2f985db9330503fee62fb421c3429  gcc/testsuite/ada/acats-4/tests/ca/ca1013a4.ada
! 9fc93552ea16f09c4c827809b41b3281  gcc/testsuite/ada/acats-4/tests/ca/ca1013a5.ada
! eb0f6d8e24d16363c032c027a7fb22d5  gcc/testsuite/ada/acats-4/tests/ca/ca1013a6.ada
! b35c89f01ddf1fa22d017dd159aac614  gcc/testsuite/ada/acats-4/tests/ca/ca1014a0.ada
! 5077be000dc1a7e1b7b61ca260535b47  gcc/testsuite/ada/acats-4/tests/ca/ca1014a1.ada
! 0d51872b8ac47d25b56ce86661e1c370  gcc/testsuite/ada/acats-4/tests/ca/ca1014a2.ada
! 29a9a130e24e0e0ced6be54af8af32af  gcc/testsuite/ada/acats-4/tests/ca/ca1014a3.ada
! bda7cf51d24fabf05ab2eb537ba61e3b  gcc/testsuite/ada/acats-4/tests/ca/ca1020e0.ada
! e875db44aa84c70db8ae5e21b37fd9f1  gcc/testsuite/ada/acats-4/tests/ca/ca1020e1.ada
! 3f26efdf7d61547aec29a83c55db9b2c  gcc/testsuite/ada/acats-4/tests/ca/ca1020e2.ada
! d41b12fbbd6a609065e3a66751a2bcfd  gcc/testsuite/ada/acats-4/tests/ca/ca1020e3.ada
! 94d90f2a39051c6c6e6f143035815676  gcc/testsuite/ada/acats-4/tests/ca/ca1022a0.ada
! 522a519bdf3184fbe9c278d90eaa0c51  gcc/testsuite/ada/acats-4/tests/ca/ca1022a1.ada
! 457d2a59db3a3a962c68d076c3588ba2  gcc/testsuite/ada/acats-4/tests/ca/ca1022a2.ada
! bead0060014fd3fff3245a6f20e1ce5d  gcc/testsuite/ada/acats-4/tests/ca/ca1022a3.ada
! 7043e3690e3b44d0a6dcf5a6e896118c  gcc/testsuite/ada/acats-4/tests/ca/ca1022a4.ada
! a84d185297f5e0df081a4d1c5691575a  gcc/testsuite/ada/acats-4/tests/ca/ca1022a5.ada
! 3170507b82e5b87d289d4cc70305ba1c  gcc/testsuite/ada/acats-4/tests/ca/ca1022a6.ada
! 43efb4507d79b8829492325770ec57e8  gcc/testsuite/ada/acats-4/tests/ca/ca11001.a
! ac29fbda8eadae439bcd450881bc7149  gcc/testsuite/ada/acats-4/tests/ca/ca11002.a
! b9954b4449d887004c58cdfadf86900e  gcc/testsuite/ada/acats-4/tests/ca/ca11003.a
! 5858be41247b333a8e43986902fba588  gcc/testsuite/ada/acats-4/tests/ca/ca110040.a
! a977e479cabfc8bfede672c52d423864  gcc/testsuite/ada/acats-4/tests/ca/ca110041.a
! a2118dee2a16348d232ec7617376dade  gcc/testsuite/ada/acats-4/tests/ca/ca110042.am
! 4a8c0c2b4dd227cfda4c20ad9ff07ace  gcc/testsuite/ada/acats-4/tests/ca/ca110050.a
! 0583459492312df56b1924ffe5b094bd  gcc/testsuite/ada/acats-4/tests/ca/ca110051.am
! bc46a97640375fa6c02bac82bd0ea9d4  gcc/testsuite/ada/acats-4/tests/ca/ca11006.a
! 7a57ba0892ae966f0111911781c328a7  gcc/testsuite/ada/acats-4/tests/ca/ca11007.a
! 72dc8d276317eabd399e4b72e562434b  gcc/testsuite/ada/acats-4/tests/ca/ca11008.a
! 33d1886825125a9ff16aafa1d4eeb8ce  gcc/testsuite/ada/acats-4/tests/ca/ca11009.a
! 6009d53581cd1fedaaa5f8df00bec83f  gcc/testsuite/ada/acats-4/tests/ca/ca11010.a
! 41dc04e344132ae2173153f802896e15  gcc/testsuite/ada/acats-4/tests/ca/ca11011.a
! d28dd7fd562acb52e90429450077885b  gcc/testsuite/ada/acats-4/tests/ca/ca11012.a
! 3b4e1d1303122a2165d7a89e5ca75ec0  gcc/testsuite/ada/acats-4/tests/ca/ca11013.a
! e80e120c9035b007bb06c2accccbc2b3  gcc/testsuite/ada/acats-4/tests/ca/ca11014.a
! 97408d6755af6eeab48fe47d27144c12  gcc/testsuite/ada/acats-4/tests/ca/ca11015.a
! 8b415d0e8ca6c7725a02853b184967b4  gcc/testsuite/ada/acats-4/tests/ca/ca11016.a
! 5b1b2a824041eeb6d0560a6e32d48287  gcc/testsuite/ada/acats-4/tests/ca/ca11017.a
! df67588f2af1ce9fe9abd12c930a475a  gcc/testsuite/ada/acats-4/tests/ca/ca11018.a
! d51c3aaeac91d325c8cea73a18210a18  gcc/testsuite/ada/acats-4/tests/ca/ca11019.a
! 1740b30abc976744100e38e3bcf58e99  gcc/testsuite/ada/acats-4/tests/ca/ca11020.a
! 3a6518f945e25a1aeb3ad194d1563dff  gcc/testsuite/ada/acats-4/tests/ca/ca11021.a
! 5af82e195906ba434bd96462dc39c4c1  gcc/testsuite/ada/acats-4/tests/ca/ca11022.a
! d31f6ffac288a57d18c545c73969474e  gcc/testsuite/ada/acats-4/tests/ca/ca110230.a
! 32e02fe39dfdad12f29d72279adcac6c  gcc/testsuite/ada/acats-4/tests/ca/ca110231.a
! 4dd492832f8d6bd8bd698f639fa6aca4  gcc/testsuite/ada/acats-4/tests/ca/ca110232.am
! dccf8acb158b9eac07884aeacd894def  gcc/testsuite/ada/acats-4/tests/ca/ca1102a0.ada
! 2ed4ef9cb779e0d0250f3094928e85b6  gcc/testsuite/ada/acats-4/tests/ca/ca1102a1.ada
! d658c78d3feceb2e1e932fd6a6b84b5b  gcc/testsuite/ada/acats-4/tests/ca/ca1102a2.ada
! 50c4e887be1e9c4b7922f1519eb6c980  gcc/testsuite/ada/acats-4/tests/ca/ca1106a.ada
! b777b7cb27b27b07d7781e4ffd98a4ac  gcc/testsuite/ada/acats-4/tests/ca/ca1108a.ada
! 2f0f9c93c1bcab591f855d52670c37f0  gcc/testsuite/ada/acats-4/tests/ca/ca1108b.ada
! d320add603a2cb7fa5b0b27eb3cf9f99  gcc/testsuite/ada/acats-4/tests/ca/ca11a01.a
! 564d10a7c04f96788c8960fbe51c939e  gcc/testsuite/ada/acats-4/tests/ca/ca11a02.a
! c5b8e3a142a8d1aaf458e85e143d2dff  gcc/testsuite/ada/acats-4/tests/ca/ca11b01.a
! 385324ae1a50700efcc3e91d33d38fa7  gcc/testsuite/ada/acats-4/tests/ca/ca11b02.a
! f3ab6e0bea1b83fcd4c3a152e700e0bc  gcc/testsuite/ada/acats-4/tests/ca/ca11c01.a
! 71af51028e9bdd5cbcd5d81ee9beb0b5  gcc/testsuite/ada/acats-4/tests/ca/ca11c02.a
! 623cecaae9f9690a91d838f3795828e4  gcc/testsuite/ada/acats-4/tests/ca/ca11c03.a
! d0d1001f9819954c3537dd82876810a2  gcc/testsuite/ada/acats-4/tests/ca/ca11d010.a
! 9f2dd49cf5ff9af1c2217e51b7065e52  gcc/testsuite/ada/acats-4/tests/ca/ca11d011.a
! df976f60528d7144894c0dec4d84bc15  gcc/testsuite/ada/acats-4/tests/ca/ca11d012.a
! 6caa9498e84d76bdc74f46ac12a1a5e2  gcc/testsuite/ada/acats-4/tests/ca/ca11d013.am
! 0e13dcf32c88dedfbae0b03875ea105d  gcc/testsuite/ada/acats-4/tests/ca/ca11d02.a
! 352a0f61cf20bb4dd3caf17335850840  gcc/testsuite/ada/acats-4/tests/ca/ca11d03.a
! 42dc8152c22ab5df110af0816fda6daa  gcc/testsuite/ada/acats-4/tests/ca/ca120010.a
! 4a591a63cf2ea54c815ce845a57db0b6  gcc/testsuite/ada/acats-4/tests/ca/ca120011.a
! 33dd67cd6352e749c80324a52bce1fca  gcc/testsuite/ada/acats-4/tests/ca/ca120012.am
! 85bba90c6d55a072af31e706a101806b  gcc/testsuite/ada/acats-4/tests/ca/ca12002.a
! 196ff89b7529ee2981f4ecc32c27a27f  gcc/testsuite/ada/acats-4/tests/ca/ca13001.a
! a30bb2c455fbe1c012213193058ea38a  gcc/testsuite/ada/acats-4/tests/ca/ca13002.a
! 259d9991bd14633e726a1465b3ce011f  gcc/testsuite/ada/acats-4/tests/ca/ca13003.a
! 4a04a3ea16a7b5f16f46083006b00231  gcc/testsuite/ada/acats-4/tests/ca/ca13a01.a
! ef93a0b4b9d9c30a5f19c2e9d20d6e84  gcc/testsuite/ada/acats-4/tests/ca/ca13a02.a
! 14642bbab92bb9a06637c81126196b6d  gcc/testsuite/ada/acats-4/tests/ca/ca140230.a
! db8f6b8a7c3fb7fc6f41665ca76898aa  gcc/testsuite/ada/acats-4/tests/ca/ca140231.a
! 2c51220694c3930837b65093969330e9  gcc/testsuite/ada/acats-4/tests/ca/ca140232.am
! 97cc025b6e8c23ed35706e0ff98d4305  gcc/testsuite/ada/acats-4/tests/ca/ca140233.a
! 6df92dded9f1b1b9927e74380e21b606  gcc/testsuite/ada/acats-4/tests/ca/ca140280.a
! 6d433407d31454677f59a9de849b9a8a  gcc/testsuite/ada/acats-4/tests/ca/ca140281.a
! c7d9485411a37bafb94c4d619229cf30  gcc/testsuite/ada/acats-4/tests/ca/ca140282.a
! 0382d20f38d7c210393543ff57720eee  gcc/testsuite/ada/acats-4/tests/ca/ca140283.am
! 3ddbeeafbf30ff3f598a354d6504380d  gcc/testsuite/ada/acats-4/tests/ca/ca15003.a
! 3a4f3b580416cb1f523e9f0ac2eae79d  gcc/testsuite/ada/acats-4/tests/ca/ca200020.a
! 0a900895683bd2063208a7e0ec0179eb  gcc/testsuite/ada/acats-4/tests/ca/ca200021.a
! 7ba1dcfca4bbc7dddaa33358007ad8be  gcc/testsuite/ada/acats-4/tests/ca/ca200022.am
! ef72fc262d0290715b645d5b851eb6c6  gcc/testsuite/ada/acats-4/tests/ca/ca200030.a
! 192d203df19b3fbd0783fa037fb0b579  gcc/testsuite/ada/acats-4/tests/ca/ca200031.am
! 89e55ace469231379417158d76cef966  gcc/testsuite/ada/acats-4/tests/ca/ca2001h0.ada
! 4fcb3c9a010c482fd799920396bdff35  gcc/testsuite/ada/acats-4/tests/ca/ca2001h1.ada
! 74283fc28ee649c49603986ce9271f9b  gcc/testsuite/ada/acats-4/tests/ca/ca2001h2.ada
! 38f9b878948bab9e22743f449944e3e9  gcc/testsuite/ada/acats-4/tests/ca/ca2001h3.ada
! 5b863537f3743728296719d32393b9c2  gcc/testsuite/ada/acats-4/tests/ca/ca2002a0.ada
! bfbaab505e4866cb5784b784957c9a28  gcc/testsuite/ada/acats-4/tests/ca/ca2002a1.ada
! 0915a28827cb6de231954ac4c117a867  gcc/testsuite/ada/acats-4/tests/ca/ca2002a2.ada
! be28bd99026e48f3d74a229aea62f3d3  gcc/testsuite/ada/acats-4/tests/ca/ca2003a0.ada
! bbd409da60934657820661962e6e865f  gcc/testsuite/ada/acats-4/tests/ca/ca2003a1.ada
! e9823de02e5e243ffbc96966ad66f571  gcc/testsuite/ada/acats-4/tests/ca/ca2004a0.ada
! 2a6a75cbeb635fa9b353f4456f15887a  gcc/testsuite/ada/acats-4/tests/ca/ca2004a1.ada
! 9e55a07446b2c4b6f10c94a096696c64  gcc/testsuite/ada/acats-4/tests/ca/ca2004a2.ada
! 95743db093f3de73eef851e06ace6ae5  gcc/testsuite/ada/acats-4/tests/ca/ca2004a3.ada
! 9825991acff14d1e11e40a3568bb2e77  gcc/testsuite/ada/acats-4/tests/ca/ca2004a4.ada
! 1ed6b70320b71de2337bd1e17625341d  gcc/testsuite/ada/acats-4/tests/ca/ca2007a0.ada
! 2d33ec3a837a5a5e131936b8db94f4eb  gcc/testsuite/ada/acats-4/tests/ca/ca2007a1.ada
! 40ec1534c1b7d0a29cd8b1199f0a5b64  gcc/testsuite/ada/acats-4/tests/ca/ca2007a2.ada
! 25e21e36ad48e61821b87c24ac11bca6  gcc/testsuite/ada/acats-4/tests/ca/ca2007a3.ada
! 084eafcf0c9bde63eb9b0c876f25f904  gcc/testsuite/ada/acats-4/tests/ca/ca2008a0.ada
! c367605d05bd5ae5bf81c583e66e2720  gcc/testsuite/ada/acats-4/tests/ca/ca2008a1.ada
! c06ae786d36e4922cea7b5ed9453c9f3  gcc/testsuite/ada/acats-4/tests/ca/ca2008a2.ada
! e6666b45adcad1b99635211e793ed244  gcc/testsuite/ada/acats-4/tests/ca/ca2009a.ada
! 091802695ed73e62107b4d4d28c4fa67  gcc/testsuite/ada/acats-4/tests/ca/ca2009c0.ada
! d4908bcb77941027c20a57e38b3354df  gcc/testsuite/ada/acats-4/tests/ca/ca2009c1.ada
! 8793e38b06624960b964675c87a7bb50  gcc/testsuite/ada/acats-4/tests/ca/ca2009d.ada
! ebd60829cd41edbd06d5d34b1c55ad14  gcc/testsuite/ada/acats-4/tests/ca/ca2009f0.ada
! 84847d496c3551158605ff4d635fd1d6  gcc/testsuite/ada/acats-4/tests/ca/ca2009f1.ada
! 1b68aafa35a5844624d091cb512b83a3  gcc/testsuite/ada/acats-4/tests/ca/ca2009f2.ada
! 82a3883dad29bf7e9b2b43d245e96819  gcc/testsuite/ada/acats-4/tests/ca/ca2011b.ada
! a2806b84bcf970945201d14057ba77fb  gcc/testsuite/ada/acats-4/tests/ca/ca21001.a
! 950eaccfab4bdda6e5ed0683ee3145b0  gcc/testsuite/ada/acats-4/tests/ca/ca21002.a
! 9b176edf2b085f407ab53c6e7efa0bf0  gcc/testsuite/ada/acats-4/tests/ca/ca3011a0.ada
! a4e05800840beaa80583438f2fe8754d  gcc/testsuite/ada/acats-4/tests/ca/ca3011a1.ada
! c86a5bb82c1bade39f6d9d230f8c9e8e  gcc/testsuite/ada/acats-4/tests/ca/ca3011a2.ada
! dc43067ded3ab1437027708d7812aadb  gcc/testsuite/ada/acats-4/tests/ca/ca3011a3.ada
! b4bbe2bad37830cb59bac3673786910c  gcc/testsuite/ada/acats-4/tests/ca/ca3011a4.ada
! c29e663763861d160ff3432b1e522015  gcc/testsuite/ada/acats-4/tests/ca/ca5003a0.ada
! e5dcfd787f24d6dfedf73b0e116e1352  gcc/testsuite/ada/acats-4/tests/ca/ca5003a1.ada
! 248734cc36c6828c5b5d0a7c1293df27  gcc/testsuite/ada/acats-4/tests/ca/ca5003a2.ada
! 5497b59108e98e726b8af5fae575c343  gcc/testsuite/ada/acats-4/tests/ca/ca5003a3.ada
! 3ca92f928c3fab5699f3ed1cbb10cca7  gcc/testsuite/ada/acats-4/tests/ca/ca5003a4.ada
! 15800c833dc097d881eb01771f2ddb56  gcc/testsuite/ada/acats-4/tests/ca/ca5003a5.ada
! 42a60fa8194ce3db5c65b6814ea59f15  gcc/testsuite/ada/acats-4/tests/ca/ca5003a6.ada
! 0402a0137d3537a7d4ae11fe9268e188  gcc/testsuite/ada/acats-4/tests/ca/ca5003b0.ada
! 56d17409bae5c4f8247c69372dada6a7  gcc/testsuite/ada/acats-4/tests/ca/ca5003b1.ada
! 2ef9cab842c822e5b35867c53e777c18  gcc/testsuite/ada/acats-4/tests/ca/ca5003b2.ada
! 82b234cda282c69bd1cd3343d6564886  gcc/testsuite/ada/acats-4/tests/ca/ca5003b3.ada
! 0e13bff44fe10fc5bb9178c91aa8f41b  gcc/testsuite/ada/acats-4/tests/ca/ca5003b4.ada
! 05dbe877925c828ecc6371bacbfdfa20  gcc/testsuite/ada/acats-4/tests/ca/ca5003b5.ada
! 86085a25df2bcf17731e5abce3a41858  gcc/testsuite/ada/acats-4/tests/ca/ca5004a.ada
! 4663b5feb03415ae2fecb74dc9a6d918  gcc/testsuite/ada/acats-4/tests/ca/ca5004b0.ada
! dac927119e0c75edf0e171d438d99a0b  gcc/testsuite/ada/acats-4/tests/ca/ca5004b1.ada
! fb2c0908bc96e07939ff5f370be3d576  gcc/testsuite/ada/acats-4/tests/ca/ca5004b2.ada
! de4ee9e1d0577cbafe35f74312690093  gcc/testsuite/ada/acats-4/tests/ca/ca5006a.ada
! 953459f6c3ce7331d1cf5e82d075046f  gcc/testsuite/ada/acats-4/tests/cb/cb10002.a
! a2d96f308f3e7c5c03f4f9d216128c1c  gcc/testsuite/ada/acats-4/tests/cb/cb1001a.ada
! c9d819541b343e576525a8dc64f50bcc  gcc/testsuite/ada/acats-4/tests/cb/cb1004a.ada
! cd057227d4389433804bcb77c3065624  gcc/testsuite/ada/acats-4/tests/cb/cb1005a.ada
! 5335053bd77df186552ab553aed53d59  gcc/testsuite/ada/acats-4/tests/cb/cb1010a.ada
! 6be3f5adbcfcbc452379f748a85caa57  gcc/testsuite/ada/acats-4/tests/cb/cb1010c.ada
! 0a7ba5489277a0fcbe1b644ea3d981a3  gcc/testsuite/ada/acats-4/tests/cb/cb1010d.ada
! 6cae622e32e9824d353863435f37029e  gcc/testsuite/ada/acats-4/tests/cb/cb20001.a
! f70c8a2a06450a84e9c16c2c896968c2  gcc/testsuite/ada/acats-4/tests/cb/cb20003.a
! fe4620ca44567358367bbd3cbf625a78  gcc/testsuite/ada/acats-4/tests/cb/cb20004.a
! 35b97a6a98aab2205d9fafa16376dd73  gcc/testsuite/ada/acats-4/tests/cb/cb20005.a
! 2eb8439ac2fe1164f75cef3955ed5f7e  gcc/testsuite/ada/acats-4/tests/cb/cb20006.a
! 14f424c9945ffa51a8ed9b5158035a61  gcc/testsuite/ada/acats-4/tests/cb/cb20007.a
! 81b37c096b48361109ecfd3c0a735d6f  gcc/testsuite/ada/acats-4/tests/cb/cb2004a.ada
! c9e534ca3b39a7e52f750d7ada5b1f05  gcc/testsuite/ada/acats-4/tests/cb/cb2005a.ada
! 5f629a419d744cf6cbdf01ae526e8dfe  gcc/testsuite/ada/acats-4/tests/cb/cb2006a.ada
! 0f62783e4e017c666e439d08382f4081  gcc/testsuite/ada/acats-4/tests/cb/cb2007a.ada
! 0af3543016fdd2ab314c8e3f6944bc98  gcc/testsuite/ada/acats-4/tests/cb/cb20a02.a
! 0f3ac1a00f45f79f0d263ea0c18026ea  gcc/testsuite/ada/acats-4/tests/cb/cb30001.a
! d22425d7abb438c4b8e19712114044f1  gcc/testsuite/ada/acats-4/tests/cb/cb30002.a
! da80eb868ceb5337039000257fc5cf28  gcc/testsuite/ada/acats-4/tests/cb/cb3003a.ada
! 3dcceb335b81c6314b73ec2a12e496dd  gcc/testsuite/ada/acats-4/tests/cb/cb3003b.ada
! db5771a4c4d22f1ee3b2043ea42e688e  gcc/testsuite/ada/acats-4/tests/cb/cb3004a.ada
! e4ecbc4431ab3786f6a71727577cf5f2  gcc/testsuite/ada/acats-4/tests/cb/cb40005.a
! 15fd6a782afdd2e76a85a1ef09b95d91  gcc/testsuite/ada/acats-4/tests/cb/cb4001a.ada
! f00ebf73158afdcf6ccfa56162d1a7c7  gcc/testsuite/ada/acats-4/tests/cb/cb4002a.ada
! 9e17c1d3be3c2acc4c4a761cf058d3c6  gcc/testsuite/ada/acats-4/tests/cb/cb4003a.ada
! 3461f679629a4811d1fce600d7e8b57e  gcc/testsuite/ada/acats-4/tests/cb/cb4004a.ada
! f2db155f6c22f6b30ca696f825ef8aae  gcc/testsuite/ada/acats-4/tests/cb/cb4005a.ada
! b611f921d0e5b0b027e6f69faa9d24b4  gcc/testsuite/ada/acats-4/tests/cb/cb4006a.ada
! baded9fec75a97cb63419083a60cbf79  gcc/testsuite/ada/acats-4/tests/cb/cb4007a.ada
! a4194c712a3e86aa41f29aec96a8f7a7  gcc/testsuite/ada/acats-4/tests/cb/cb4008a.ada
! 930c41db090c6c2c54a36228405c48ac  gcc/testsuite/ada/acats-4/tests/cb/cb4009a.ada
! 72f5c28e26994805b38b887c725d411c  gcc/testsuite/ada/acats-4/tests/cb/cb4013a.ada
! 7cebdcd4f0159fb009f28f53b4f1d2aa  gcc/testsuite/ada/acats-4/tests/cb/cb40a01.a
! c5d94b1d4e0e31956d3f563cd7632df6  gcc/testsuite/ada/acats-4/tests/cb/cb40a020.a
! 1826a245b36f70926f1d010c4bb03b56  gcc/testsuite/ada/acats-4/tests/cb/cb40a021.am
! dd4b04d0ff15d88ce5e37562087104b8  gcc/testsuite/ada/acats-4/tests/cb/cb40a030.a
! ce7a78707740e7c8442c44280bd4b429  gcc/testsuite/ada/acats-4/tests/cb/cb40a031.am
! 27770d52ee37e90d5cd9748807eab53e  gcc/testsuite/ada/acats-4/tests/cb/cb40a04.a
! fee21ac92aa6b69bea4a12f412715df6  gcc/testsuite/ada/acats-4/tests/cb/cb41001.a
! 3bbe3f0aeccac5d0203ed045c2ccf49e  gcc/testsuite/ada/acats-4/tests/cb/cb41002.a
! d456462b7a7e6f3773b86bf24468d231  gcc/testsuite/ada/acats-4/tests/cb/cb41003.a
! 52c5e4b6a8d77b120f571623f547a197  gcc/testsuite/ada/acats-4/tests/cb/cb41004.a
! d0966c8e064d920ad9d15b0e1e8acd1b  gcc/testsuite/ada/acats-4/tests/cb/cb42001.a
! f44ad7e2a4e69bd7a329f8d93bb15c88  gcc/testsuite/ada/acats-4/tests/cb/cb42002.a
! e6c3ed65a752c9adb9850b8254371888  gcc/testsuite/ada/acats-4/tests/cb/cb42003.a
! d8ee6696e0da8f079608aa258739723f  gcc/testsuite/ada/acats-4/tests/cb/cb50001.a
! 01e2daee09a3391b981c7a63ebe0ae28  gcc/testsuite/ada/acats-4/tests/cb/cb5001a.ada
! 5a22bfb3766d46433b2b7b2f046d0ea9  gcc/testsuite/ada/acats-4/tests/cb/cb5001b.ada
! 63153559a0add5135a21197c6c8c0a9f  gcc/testsuite/ada/acats-4/tests/cb/cb5002a.ada
! 52c10586939e5289ffc5276a6a4d9e3e  gcc/testsuite/ada/acats-4/tests/cc/cc1004a.ada
! abeb72a1acbce60114f56d558d1481a5  gcc/testsuite/ada/acats-4/tests/cc/cc1005b.ada
! e52fa7b734609c2fde5f5260ff000f57  gcc/testsuite/ada/acats-4/tests/cc/cc1010a.ada
! 4af2da441a155dbd4ee2be7e5afcdb99  gcc/testsuite/ada/acats-4/tests/cc/cc1010b.ada
! 3943b41b051f4e223a5fe3b067dd4750  gcc/testsuite/ada/acats-4/tests/cc/cc1018a.ada
! 8b9f3eb4b897035fcc0c08981fa94cd0  gcc/testsuite/ada/acats-4/tests/cc/cc1104c.ada
! 6dde1021fb59bfd89f7e89e10c4dc040  gcc/testsuite/ada/acats-4/tests/cc/cc1107b.ada
! fd9ff835b201890341a69a2bf568186d  gcc/testsuite/ada/acats-4/tests/cc/cc1111a.ada
! 3a2e06563ce5c65cb9f2734c9b5901b2  gcc/testsuite/ada/acats-4/tests/cc/cc1204a.ada
! ec00ecaace8abe97b14deef79a927278  gcc/testsuite/ada/acats-4/tests/cc/cc1207b.ada
! d5b96d46768e2afc1db48bccdd883c3d  gcc/testsuite/ada/acats-4/tests/cc/cc1220a.ada
! fe4da7912a4f8ebd90feecf1233d1cdd  gcc/testsuite/ada/acats-4/tests/cc/cc1221a.ada
! 25b2b3dc12b77cbf205ab8f38dcfb77d  gcc/testsuite/ada/acats-4/tests/cc/cc1221b.ada
! 9145c4850d40180754446ef574cb5fc0  gcc/testsuite/ada/acats-4/tests/cc/cc1221c.ada
! c4c966046fba1bd9875ab2ac270f27d0  gcc/testsuite/ada/acats-4/tests/cc/cc1221d.ada
! ec00a589846feb2b9117000ba453bb4d  gcc/testsuite/ada/acats-4/tests/cc/cc1222a.ada
! 9098cb80c67049808425c47b419fac81  gcc/testsuite/ada/acats-4/tests/cc/cc1223a.ada
! ebb1accb64bb0bc75b36cc4d7667f11e  gcc/testsuite/ada/acats-4/tests/cc/cc1224a.ada
! 252dcf9d499b779ceb6ff22b740614f3  gcc/testsuite/ada/acats-4/tests/cc/cc1225a.tst
! bd7909fda37c73e6a7b55033af7a7073  gcc/testsuite/ada/acats-4/tests/cc/cc1226b.ada
! 6c7f653283771ea8e72f38f30cca417e  gcc/testsuite/ada/acats-4/tests/cc/cc1227a.ada
! a59ea76111c1c30abdfc81e140c2ad1e  gcc/testsuite/ada/acats-4/tests/cc/cc1301a.ada
! 54718ced426c8406bfe76f085e364b70  gcc/testsuite/ada/acats-4/tests/cc/cc1302a.ada
! 0e4bf36981636de5140e59f431e9a750  gcc/testsuite/ada/acats-4/tests/cc/cc1304a.ada
! 8b8017d0f141d2d1f196915bb0d9086f  gcc/testsuite/ada/acats-4/tests/cc/cc1304b.ada
! 5c30254607e6be149633cccc49ed0eed  gcc/testsuite/ada/acats-4/tests/cc/cc1307a.ada
! 074dfbafa7a711ae864c0c7a3551c2c1  gcc/testsuite/ada/acats-4/tests/cc/cc1307b.ada
! 99a71a5de9c88311f519834c73dd819d  gcc/testsuite/ada/acats-4/tests/cc/cc1308a.ada
! f7d1a2abebaff0b7213722ac29bc699a  gcc/testsuite/ada/acats-4/tests/cc/cc1310a.ada
! 02f17d4f3889eba61e039a52d84ad466  gcc/testsuite/ada/acats-4/tests/cc/cc1311a.ada
! ab2512302d5429785277d9bb46d6c87b  gcc/testsuite/ada/acats-4/tests/cc/cc1311b.ada
! 1653180dc4be9e4015e8cad4546ded2c  gcc/testsuite/ada/acats-4/tests/cc/cc2002a.ada
! 5368d883d7adafccb7c415ab1a83c7f2  gcc/testsuite/ada/acats-4/tests/cc/cc30001.a
! 9240ec87a1cc555c3c6e829f22480b0f  gcc/testsuite/ada/acats-4/tests/cc/cc30002.a
! 9b67ed4b6d94e785f623555841e44c4c  gcc/testsuite/ada/acats-4/tests/cc/cc30003.a
! 7b9e43d5af304e75a87ba957fae6500b  gcc/testsuite/ada/acats-4/tests/cc/cc30004.a
! 258d4b8f83d4c17eda45265db8a66c46  gcc/testsuite/ada/acats-4/tests/cc/cc3004a.ada
! 1422918611096dedc710ededab9fc1d3  gcc/testsuite/ada/acats-4/tests/cc/cc3007a.ada
! faee4cb0106ee6d683bf7e7a208050dc  gcc/testsuite/ada/acats-4/tests/cc/cc3007b.ada
! 43f939c986863c3151fb21fae7ad81a8  gcc/testsuite/ada/acats-4/tests/cc/cc3011a.ada
! e21f329f8aeeeaaf980ab3ae301de7cb  gcc/testsuite/ada/acats-4/tests/cc/cc3011d.ada
! 021bd9a65cf3be3535547519f5ceb651  gcc/testsuite/ada/acats-4/tests/cc/cc3012a.ada
! eb08409ceff83c49baa04e734c258681  gcc/testsuite/ada/acats-4/tests/cc/cc3015a.ada
! 37ffe8fd743867700b2e0249fd73f16b  gcc/testsuite/ada/acats-4/tests/cc/cc3016b.ada
! 92e8dfd4f50c7e3595bbd6ef5ebb4302  gcc/testsuite/ada/acats-4/tests/cc/cc3016c.ada
! 3bb5847d2c36a04a53a9dc138c40e34a  gcc/testsuite/ada/acats-4/tests/cc/cc3016f.ada
! 195ab10c1ca9bbfd5b16ade12e3259e2  gcc/testsuite/ada/acats-4/tests/cc/cc3016i.ada
! a5976b043f8ea78109e2936d58a009a8  gcc/testsuite/ada/acats-4/tests/cc/cc3017b.ada
! 2fb78d8d58d12070086164535de0efda  gcc/testsuite/ada/acats-4/tests/cc/cc3019a.ada
! a0315fd5149893475278feb9b8d7013b  gcc/testsuite/ada/acats-4/tests/cc/cc3019b0.ada
! 207f4488242efc2b7a5c80c0cd47410b  gcc/testsuite/ada/acats-4/tests/cc/cc3019b1.ada
! 5688bc525157eef2f521d23f1a720672  gcc/testsuite/ada/acats-4/tests/cc/cc3019b2.ada
! e5522bd1515d2f7df4fdd2bafaf481fb  gcc/testsuite/ada/acats-4/tests/cc/cc3019c0.ada
! c326bc3fa236d9094e60f3ecabd7d0de  gcc/testsuite/ada/acats-4/tests/cc/cc3019c1.ada
! 4e308a4f2724a46a2eb3a8426f98265f  gcc/testsuite/ada/acats-4/tests/cc/cc3019c2.ada
! cd9a188b6b1ecf3863d42065ce445792  gcc/testsuite/ada/acats-4/tests/cc/cc3106b.ada
! b1b639f80dbd48bf241b7d05c36362e6  gcc/testsuite/ada/acats-4/tests/cc/cc3120a.ada
! f06e709416c9d57a31113226d02abf07  gcc/testsuite/ada/acats-4/tests/cc/cc3120b.ada
! e09fb340ff80c10cbecd4b83e746eef2  gcc/testsuite/ada/acats-4/tests/cc/cc3121a.ada
! 302527c5f7e5e7497411775d418850b0  gcc/testsuite/ada/acats-4/tests/cc/cc3123a.ada
! 2575fc22f53f2a5308182459add72a14  gcc/testsuite/ada/acats-4/tests/cc/cc3125a.ada
! 4f59d6fe9227d671293a8fecd22f9101  gcc/testsuite/ada/acats-4/tests/cc/cc3125b.ada
! a1164d012410441b7190f2e96d6ce7c6  gcc/testsuite/ada/acats-4/tests/cc/cc3125c.ada
! 8a71d919069253ce368ef3103ee770c8  gcc/testsuite/ada/acats-4/tests/cc/cc3125d.ada
! ae116bcf41f79383e2dba5094b290b3f  gcc/testsuite/ada/acats-4/tests/cc/cc3126a.ada
! de2792bcfe94fa04d80a2c8ecf74db33  gcc/testsuite/ada/acats-4/tests/cc/cc3127a.ada
! a9709bfb589a677927644fb64dffa39c  gcc/testsuite/ada/acats-4/tests/cc/cc3128a.ada
! eeae81e69cab3987783ac508ffbebc5c  gcc/testsuite/ada/acats-4/tests/cc/cc3203a.ada
! a4d077af707d747e7c7f4f145a33e013  gcc/testsuite/ada/acats-4/tests/cc/cc3207b.ada
! 4525f7929e8bbeab0d61377f11afa3b8  gcc/testsuite/ada/acats-4/tests/cc/cc3220a.ada
! e8cc62fb0584ebfbe49d22d70abf54f4  gcc/testsuite/ada/acats-4/tests/cc/cc3221a.ada
! fbf1f50c254b6c5361e7d43b8efa783c  gcc/testsuite/ada/acats-4/tests/cc/cc3222a.ada
! 06202a4a37521548f15b8f63b30331cf  gcc/testsuite/ada/acats-4/tests/cc/cc3223a.ada
! d6d9973ddd1a38d34208ece4853e3e54  gcc/testsuite/ada/acats-4/tests/cc/cc3224a.ada
! 9d8a01fd3692524cef3f688f08e8820e  gcc/testsuite/ada/acats-4/tests/cc/cc3225a.ada
! 0b4db0bdcd8b5f809a2a0976c2fd65a2  gcc/testsuite/ada/acats-4/tests/cc/cc3230a.ada
! ecf0a337f74761749dd005a8b934ae2d  gcc/testsuite/ada/acats-4/tests/cc/cc3231a.ada
! 536583cad34553553ba201c11a12e136  gcc/testsuite/ada/acats-4/tests/cc/cc3232a.ada
! 29722620be1cef89562f63d778feb319  gcc/testsuite/ada/acats-4/tests/cc/cc3233a.ada
! 55b7f83f0d13dd0bbbc615bec20f7f58  gcc/testsuite/ada/acats-4/tests/cc/cc3234a.ada
! 174e858e451ed1d671a07a674320a404  gcc/testsuite/ada/acats-4/tests/cc/cc3235a.ada
! 1966408531cce82c0dee0cdb997e2d83  gcc/testsuite/ada/acats-4/tests/cc/cc3236a.ada
! 69f2b9819e916eb5bef41d74a6bf059e  gcc/testsuite/ada/acats-4/tests/cc/cc3240a.ada
! 134c20d477e6856df2b370dc7cfda1a4  gcc/testsuite/ada/acats-4/tests/cc/cc3305a.ada
! 6ff147856008d1bc23082c84a6dce358  gcc/testsuite/ada/acats-4/tests/cc/cc3305b.ada
! 75b310968a34fc081580d58bd1747ea3  gcc/testsuite/ada/acats-4/tests/cc/cc3305c.ada
! e41c2fcae5aa76bb6cd566a6a34b9e73  gcc/testsuite/ada/acats-4/tests/cc/cc3305d.ada
! 54ae1b7ff14c3a948a87f71ab9b7ae53  gcc/testsuite/ada/acats-4/tests/cc/cc3601a.ada
! 9e57592bc94327a2bb36eb625e6d528f  gcc/testsuite/ada/acats-4/tests/cc/cc3601c.ada
! 14a6f6048e3bda5108a0dac8dc736e44  gcc/testsuite/ada/acats-4/tests/cc/cc3602a.ada
! 73b205844c7501b9750b69b66d91e84c  gcc/testsuite/ada/acats-4/tests/cc/cc3603a.ada
! 509cb0b6a7b3daf93118e0e4310a8889  gcc/testsuite/ada/acats-4/tests/cc/cc3605a.ada
! b81c8580788eaf032722950c55524548  gcc/testsuite/ada/acats-4/tests/cc/cc3606a.ada
! 5232a6ea1beea12bb0c271a9c0728bcc  gcc/testsuite/ada/acats-4/tests/cc/cc3606b.ada
! 2f46f9edadb7856b60273822fbd7c6dc  gcc/testsuite/ada/acats-4/tests/cc/cc3607b.ada
! 59c4b0341104cc61677baaee002ac38c  gcc/testsuite/ada/acats-4/tests/cc/cc40001.a
! 6d5d6f00038ccaafe12d5f471a488085  gcc/testsuite/ada/acats-4/tests/cc/cc50001.a
! 8cb4adfbf6723ce3680f41b59f744fe9  gcc/testsuite/ada/acats-4/tests/cc/cc50a01.a
! 508d46d79897dc7252508cdafdbbfaa1  gcc/testsuite/ada/acats-4/tests/cc/cc50a02.a
! 146e71ceb1d037e4099e8ecb6e127614  gcc/testsuite/ada/acats-4/tests/cc/cc51001.a
! 58d73c0c5456a6a21ebbaef95df38606  gcc/testsuite/ada/acats-4/tests/cc/cc51002.a
! e096e928fb49f1e659293619c383c7f1  gcc/testsuite/ada/acats-4/tests/cc/cc51003.a
! a373845361c49771cf3d23fbbfc043de  gcc/testsuite/ada/acats-4/tests/cc/cc51004.a
! f57dbf49aca26d9bd043ebddae124c8e  gcc/testsuite/ada/acats-4/tests/cc/cc51006.a
! ed5459250c5b2a65cf4b7a7c678c41b5  gcc/testsuite/ada/acats-4/tests/cc/cc51007.a
! edb35d02b7ba72e7720c2eaf7fefe5bf  gcc/testsuite/ada/acats-4/tests/cc/cc51008.a
! ae6cd77fc88f858e2d4f846c2f8fe1fd  gcc/testsuite/ada/acats-4/tests/cc/cc51009.a
! 242a7a64321f47045c3f2f35075d763a  gcc/testsuite/ada/acats-4/tests/cc/cc510100.a
! 6e910b042a7a65244f44ec96328b82aa  gcc/testsuite/ada/acats-4/tests/cc/cc510101.a
! 37c528fdf28a831a131a04af0ef3cb3d  gcc/testsuite/ada/acats-4/tests/cc/cc510102.a
! 04a3af824c0ae9cd56535f5bbb98d6c0  gcc/testsuite/ada/acats-4/tests/cc/cc510103.am
! 1724f2d9a5409939c68b55de2f49656d  gcc/testsuite/ada/acats-4/tests/cc/cc51011.a
! 91f9a7214da9eed7db005bf7e3119ddc  gcc/testsuite/ada/acats-4/tests/cc/cc51a01.a
! 123f5aa956187735f0e077abedfd8f93  gcc/testsuite/ada/acats-4/tests/cc/cc51b03.a
! 557497dc9fd80ad665e468b409621ee1  gcc/testsuite/ada/acats-4/tests/cc/cc51d01.a
! 31462b6f268d175f3a915242afd8ea4d  gcc/testsuite/ada/acats-4/tests/cc/cc51d02.a
! 8b56f900a407dc994866f74c2c67f98e  gcc/testsuite/ada/acats-4/tests/cc/cc54001.a
! 65d5b89a1c15ad3234bf150dbe3c9235  gcc/testsuite/ada/acats-4/tests/cc/cc54002.a
! 04d1ce4f2960ed9b647a0bc397f920c2  gcc/testsuite/ada/acats-4/tests/cc/cc54003.a
! 0e1a91d2dfd0e6b36d65c5cfb02883dc  gcc/testsuite/ada/acats-4/tests/cc/cc54004.a
! 78a31a5dec6479884c93ea3280e5c8d6  gcc/testsuite/ada/acats-4/tests/cc/cc60001.a
! c29ebf7d9a6ed65bca0e83b18c63bbcc  gcc/testsuite/ada/acats-4/tests/cc/cc70001.a
! eb1b9be669a38ce3989d9340fb2dc933  gcc/testsuite/ada/acats-4/tests/cc/cc70002.a
! b1df852c3d5deec3247a4e17e9fb4dc6  gcc/testsuite/ada/acats-4/tests/cc/cc70003.a
! 9f1565b83bb2fa8ee588283eaa27cf37  gcc/testsuite/ada/acats-4/tests/cc/cc70a01.a
! 0bb1d67b6fb03b14e1b2f2062d01417d  gcc/testsuite/ada/acats-4/tests/cc/cc70a02.a
! ee68b4ea46957b2abff5e05bc98eeb76  gcc/testsuite/ada/acats-4/tests/cc/cc70b01.a
! 8c472987131321e68210b34029de25a7  gcc/testsuite/ada/acats-4/tests/cc/cc70b02.a
! 1a10fab698e0e1c3d985d63a8fd02646  gcc/testsuite/ada/acats-4/tests/cc/cc70c01.a
! 630e79ef7ad77506e6bc0443bc253106  gcc/testsuite/ada/acats-4/tests/cc/cc70c02.a
! 8cc4511c2ef1cbd2694c11e81a40fba3  gcc/testsuite/ada/acats-4/tests/cd/cd10001.a
! 17bd7ceca16a2b5b05c09e2bf540cb49  gcc/testsuite/ada/acats-4/tests/cd/cd10002.a
! fb2d00d22c6dc289be9e7485d1057b88  gcc/testsuite/ada/acats-4/tests/cd/cd1009d.ada
! 0f7c8765f0bcfd92843011f7699a3515  gcc/testsuite/ada/acats-4/tests/cd/cd1009e.ada
! 278b82d91f416169138eaedebaee0e88  gcc/testsuite/ada/acats-4/tests/cd/cd1009f.ada
! c5d7abbf75d5228f8ee64b921461c34d  gcc/testsuite/ada/acats-4/tests/cd/cd1009g.ada
! 05621471548ccc18ff9a5e104f81afde  gcc/testsuite/ada/acats-4/tests/cd/cd1009h.ada
! 529178df08dc16ac0af024a1fd6bfb53  gcc/testsuite/ada/acats-4/tests/cd/cd1009i.ada
! 365257c1306da6752feb59e62ac38bdf  gcc/testsuite/ada/acats-4/tests/cd/cd1009j.ada
! 03b1bb47c24a014bd2530417d1adf9b2  gcc/testsuite/ada/acats-4/tests/cd/cd1009k.tst
! f29ec324e7b0ec1f2f6dd2240fc728d8  gcc/testsuite/ada/acats-4/tests/cd/cd1009n.ada
! cae30866eb5c8c2cfb27698eb8ddbde0  gcc/testsuite/ada/acats-4/tests/cd/cd1009o.ada
! d3eb7538a98ec14ae8d521733ba57af7  gcc/testsuite/ada/acats-4/tests/cd/cd1009p.ada
! b8730acac7650dbd31ddd035bc69f509  gcc/testsuite/ada/acats-4/tests/cd/cd1009q.ada
! c358e33b93c2826e889494a0f5ed0843  gcc/testsuite/ada/acats-4/tests/cd/cd1009r.ada
! bc1961d8c175f48f60b3e9f057a9c72a  gcc/testsuite/ada/acats-4/tests/cd/cd1009s.ada
! 97707e58ce3c7a72dc76f39b8a718701  gcc/testsuite/ada/acats-4/tests/cd/cd1009t.tst
! 692d5e6fe6286682bb5eaaa37bbb3deb  gcc/testsuite/ada/acats-4/tests/cd/cd1009u.tst
! 907fdf446e490f986c267dd4b8d31baf  gcc/testsuite/ada/acats-4/tests/cd/cd1009v.ada
! 53fd05330599e7a416f8be2f4b93f8db  gcc/testsuite/ada/acats-4/tests/cd/cd1009w.ada
! 6e1baf3329c3ff434b0b23406203b126  gcc/testsuite/ada/acats-4/tests/cd/cd1009x.ada
! 992350215516da7fa9fc873f9d5f405e  gcc/testsuite/ada/acats-4/tests/cd/cd1009y.ada
! fb78c3da6117cb6f992401e7c6afde33  gcc/testsuite/ada/acats-4/tests/cd/cd1009z.ada
! 7746ed81a04fc97ba7ce7066aca9dc53  gcc/testsuite/ada/acats-4/tests/cd/cd11001.a
! 5b32d31e23b1f46b777ddb79782d91bc  gcc/testsuite/ada/acats-4/tests/cd/cd1c03a.ada
! 33753d6d5cc05f96879e603e7e4239ed  gcc/testsuite/ada/acats-4/tests/cd/cd1c03b.ada
! bb197eb3c945f5f3165b484b8d052169  gcc/testsuite/ada/acats-4/tests/cd/cd1c03c.ada
! d532f2cddb2a1d42073af8bead380310  gcc/testsuite/ada/acats-4/tests/cd/cd1c03e.tst
! 31687b0c41570bd2e2caf21db4be46d3  gcc/testsuite/ada/acats-4/tests/cd/cd1c03f.ada
! e0216b320efd829ccdc65f5d5771bcbb  gcc/testsuite/ada/acats-4/tests/cd/cd1c03g.ada
! c46fc765c5f46303364ae7f735fd4155  gcc/testsuite/ada/acats-4/tests/cd/cd1c03h.ada
! e99adb592df5a1337ea0d1ba20e1ea56  gcc/testsuite/ada/acats-4/tests/cd/cd1c03i.ada
! 356e60fd22404e9284ce91535fb26d24  gcc/testsuite/ada/acats-4/tests/cd/cd1c04a.ada
! e23985efbd7775125639e267122b2530  gcc/testsuite/ada/acats-4/tests/cd/cd1c04d.ada
! 960f74b381e41f1c5aca4cb19a43ba24  gcc/testsuite/ada/acats-4/tests/cd/cd1c04e.ada
! f4445570707e4cfc05845c2942f2a691  gcc/testsuite/ada/acats-4/tests/cd/cd1c06a.tst
! 38c0ca7c9c40e40a65ebac293401406d  gcc/testsuite/ada/acats-4/tests/cd/cd20001.a
! 894fb9467451442679c275e49d3ed9db  gcc/testsuite/ada/acats-4/tests/cd/cd2a21a.ada
! 9955b221c78032f3aa68113cb414afea  gcc/testsuite/ada/acats-4/tests/cd/cd2a21e.ada
! 8dc618f65572488c3498abeb7937c1c0  gcc/testsuite/ada/acats-4/tests/cd/cd2a22a.ada
! 4399f6fecfdde9c331f691aa035178e5  gcc/testsuite/ada/acats-4/tests/cd/cd2a22e.ada
! fa618469f3bfe667b6991f706078ceee  gcc/testsuite/ada/acats-4/tests/cd/cd2a22i.ada
! 17cd76bca6e556da829dc167dd37416d  gcc/testsuite/ada/acats-4/tests/cd/cd2a22j.ada
! 5758562d1787cc2c6c0d717e5f92579e  gcc/testsuite/ada/acats-4/tests/cd/cd2a23a.ada
! ee7517fa66b44ea029fa5afd44d3dfda  gcc/testsuite/ada/acats-4/tests/cd/cd2a23e.ada
! adb319b4b901cc78838f92ff36537b5d  gcc/testsuite/ada/acats-4/tests/cd/cd2a24a.ada
! 480832750af0f53992400b669cfa89c8  gcc/testsuite/ada/acats-4/tests/cd/cd2a24e.ada
! 3812be2a4f7026b0ea147488e4e11b79  gcc/testsuite/ada/acats-4/tests/cd/cd2a24i.ada
! b5db777461ec4b929a5d956caae5ab6c  gcc/testsuite/ada/acats-4/tests/cd/cd2a24j.ada
! d98f71fef01ecaa475c3f7b8bebd0e66  gcc/testsuite/ada/acats-4/tests/cd/cd2a31a.ada
! 25cf5e2245fd319818051c6d58e33e34  gcc/testsuite/ada/acats-4/tests/cd/cd2a31e.ada
! 12fff4322f5854f121a2307be72bd43d  gcc/testsuite/ada/acats-4/tests/cd/cd2a32a.ada
! c89035c306f20662287a41260e41c440  gcc/testsuite/ada/acats-4/tests/cd/cd2a32c.ada
! 3019cefd3cabc0a339ba1bcc2166712a  gcc/testsuite/ada/acats-4/tests/cd/cd2a32e.ada
! 509f33673d8a806e1fc5c994ecd367a7  gcc/testsuite/ada/acats-4/tests/cd/cd2a32g.ada
! 9f1153cc00985eff630f5a7529e785a6  gcc/testsuite/ada/acats-4/tests/cd/cd2a32i.ada
! 3b52721a12cbabf7af952961ab000124  gcc/testsuite/ada/acats-4/tests/cd/cd2a32j.ada
! b0ce5f538de9c46a7f93bb98b76a16c2  gcc/testsuite/ada/acats-4/tests/cd/cd2a51a.ada
! fc6c3486ba94594cbb01735d7665ee4c  gcc/testsuite/ada/acats-4/tests/cd/cd2a53a.ada
! e22ea0a1bf1e45a9cc8941659d5de2bc  gcc/testsuite/ada/acats-4/tests/cd/cd2a53e.ada
! 800cb5fbfa61381b047623e515b331e9  gcc/testsuite/ada/acats-4/tests/cd/cd2a83c.tst
! 890942afd45f173d9c7a48fcd9b93b9e  gcc/testsuite/ada/acats-4/tests/cd/cd2a91c.tst
! 8bf8bb847340d421752506f84e4d2970  gcc/testsuite/ada/acats-4/tests/cd/cd2b11b.ada
! c32d32bcd93ad954d2d4fd55f825977f  gcc/testsuite/ada/acats-4/tests/cd/cd2b11d.ada
! 1a738e39f3f9e6241c1210e391c74d04  gcc/testsuite/ada/acats-4/tests/cd/cd2b11e.ada
! 4c72be933f221db34e2a0e081b1987cb  gcc/testsuite/ada/acats-4/tests/cd/cd2b11f.ada
! 29657353f6d86b0ea8f7696b58cc2fe9  gcc/testsuite/ada/acats-4/tests/cd/cd2b16a.ada
! d5241430c4b7db939bd5e77692bf37b4  gcc/testsuite/ada/acats-4/tests/cd/cd2c11a.tst
! 90bc2d2d244c54d7f4a3cd052f4ec35f  gcc/testsuite/ada/acats-4/tests/cd/cd2c11d.tst
! c6ae74fd392f1fb6040ba95b1d1ae6f0  gcc/testsuite/ada/acats-4/tests/cd/cd2d11a.ada
! cdcdd3477a39a731b6a087ee53c8d310  gcc/testsuite/ada/acats-4/tests/cd/cd2d13a.ada
! 76610aaf77050e2ff007a677818d736b  gcc/testsuite/ada/acats-4/tests/cd/cd30001.a
! 074a289ffe88ab1f82a7410cb923d4e9  gcc/testsuite/ada/acats-4/tests/cd/cd30002.a
! 3c6e9682493e7e0159a203d7641e1a2e  gcc/testsuite/ada/acats-4/tests/cd/cd30003.a
! 58da39f40326823d0b3dcca45acdc03a  gcc/testsuite/ada/acats-4/tests/cd/cd30004.a
! 1c50e51c3b821e3d109ed5a501745811  gcc/testsuite/ada/acats-4/tests/cd/cd300050.am
! 56a32782666a26425c694389d3141e71  gcc/testsuite/ada/acats-4/tests/cd/cd300051.c
! 6cf79585c700a6d44cf9fd6aff68bad8  gcc/testsuite/ada/acats-4/tests/cd/cd30006.a
! de71b44b5cddbf0fcc1e61f4b3bf85d5  gcc/testsuite/ada/acats-4/tests/cd/cd30007.a
! 6975fda95f2626a0f390cafdd2c40ca5  gcc/testsuite/ada/acats-4/tests/cd/cd30008.a
! 6c5358b148b289c9414824f3eca6c829  gcc/testsuite/ada/acats-4/tests/cd/cd30009.a
! d0a53d1355c18b26fb815775269f19ff  gcc/testsuite/ada/acats-4/tests/cd/cd30010.a
! 53302b5bf903a58fb95e205690813d78  gcc/testsuite/ada/acats-4/tests/cd/cd30011.a
! 03b96d80ed2b752193a510629a87cc3c  gcc/testsuite/ada/acats-4/tests/cd/cd30012.a
! f620b9538219fdb8788793f5fb0f4624  gcc/testsuite/ada/acats-4/tests/cd/cd30013.a
! 7129ad85c881b16cee177cd7c1e06336  gcc/testsuite/ada/acats-4/tests/cd/cd30014.a
! a8163e0d624406b874260e4169d9e49c  gcc/testsuite/ada/acats-4/tests/cd/cd3014a.ada
! b3c46e3333ad22ce02ee156f3f0bccff  gcc/testsuite/ada/acats-4/tests/cd/cd3014c.ada
! a341da17e2d571e891434aa086ae7d3e  gcc/testsuite/ada/acats-4/tests/cd/cd3014d.ada
! 204d7f2709b5ba9cddcb718fc3d8ec18  gcc/testsuite/ada/acats-4/tests/cd/cd3014f.ada
! a86fa642d37091be0c5e5119e8c46645  gcc/testsuite/ada/acats-4/tests/cd/cd3015a.ada
! 38a79cfd7d26ff49fc8ee336963b178f  gcc/testsuite/ada/acats-4/tests/cd/cd3015c.ada
! 516902a49ddef41f79ee415e4edbb912  gcc/testsuite/ada/acats-4/tests/cd/cd3015e.ada
! 21588812fb8df6d087570f29c23c5d39  gcc/testsuite/ada/acats-4/tests/cd/cd3015f.ada
! c8a6fa2243d818236602663b274b5ba9  gcc/testsuite/ada/acats-4/tests/cd/cd3015g.ada
! c31ca49858b05c8ca516526b0e15945f  gcc/testsuite/ada/acats-4/tests/cd/cd3015h.ada
! c130ab902d51f975c0efadc0d44c9361  gcc/testsuite/ada/acats-4/tests/cd/cd3015i.ada
! 2fa00ee1e19df0bb0e4dc668c1d238fd  gcc/testsuite/ada/acats-4/tests/cd/cd3015k.ada
! 0c71d1dfc5a7d7c4d232217c2ef3e00f  gcc/testsuite/ada/acats-4/tests/cd/cd3021a.ada
! fd95d787e27f8f80c3bccc691bf0417d  gcc/testsuite/ada/acats-4/tests/cd/cd40001.a
! a3f551b50734da9e1de425c6988b1f43  gcc/testsuite/ada/acats-4/tests/cd/cd4031a.ada
! 1363b8d9d26525600395a9118a1a4041  gcc/testsuite/ada/acats-4/tests/cd/cd4041a.tst
! 255be84f9bd123a67360189ab2d64cdf  gcc/testsuite/ada/acats-4/tests/cd/cd4051a.ada
! 37ae7a5703b3780f73cd5ae4eb39621a  gcc/testsuite/ada/acats-4/tests/cd/cd4051b.ada
! 07adf8476ba0c5e57a2bea963c120c2a  gcc/testsuite/ada/acats-4/tests/cd/cd4051c.ada
! cf5f11fa4855f5f18dba58d556b7ca63  gcc/testsuite/ada/acats-4/tests/cd/cd4051d.ada
! 20478b00e54601fd76a247d8a78c4a8f  gcc/testsuite/ada/acats-4/tests/cd/cd5003a.ada
! 4cff6e4a9ec3d2900f66bfc5693af89a  gcc/testsuite/ada/acats-4/tests/cd/cd5003b.ada
! d13512a51a4eb52527563404909e596e  gcc/testsuite/ada/acats-4/tests/cd/cd5003c.ada
! 4652d6ed2c04ade1800842b5dbfdabf9  gcc/testsuite/ada/acats-4/tests/cd/cd5003d.ada
! 005bf8518b263e4cee4d26c5db87e58b  gcc/testsuite/ada/acats-4/tests/cd/cd5003e.ada
! 8ff99eb70e788c11615ac412a1a7b4fb  gcc/testsuite/ada/acats-4/tests/cd/cd5003f.ada
! 719c829d93aa5b1f5984a681101887d3  gcc/testsuite/ada/acats-4/tests/cd/cd5003g.ada
! a7821be04ce2545857881e21292d5867  gcc/testsuite/ada/acats-4/tests/cd/cd5003h.ada
! 3491fd905bd30777ef1fbdfae6595acf  gcc/testsuite/ada/acats-4/tests/cd/cd5003i.ada
! 88b907e17fa7e933c0aa985bcbdba611  gcc/testsuite/ada/acats-4/tests/cd/cd5011a.ada
! 502c219e404c935fb79b18a5bc9edb77  gcc/testsuite/ada/acats-4/tests/cd/cd5011c.ada
! 71b7123461788aab03963e62fecc0ba3  gcc/testsuite/ada/acats-4/tests/cd/cd5011e.ada
! 8ee70bf0284e509f67c72903d25709f7  gcc/testsuite/ada/acats-4/tests/cd/cd5011g.ada
! 3b37531d4672ce7853d736e20f205d9e  gcc/testsuite/ada/acats-4/tests/cd/cd5011i.ada
! b1bd44ec7ae1e5e46e2aecd8d6f8f7b7  gcc/testsuite/ada/acats-4/tests/cd/cd5011k.ada
! b632fa011acdccee9f2b9fb3b5a030bf  gcc/testsuite/ada/acats-4/tests/cd/cd5011m.ada
! fd5e412763d1e844067af789a1ac1c48  gcc/testsuite/ada/acats-4/tests/cd/cd5011q.ada
! ee93e2b7d81f47c56f7b7ad4552b21bb  gcc/testsuite/ada/acats-4/tests/cd/cd5011s.ada
! 47d11b263404f1dd8fe59440a5052207  gcc/testsuite/ada/acats-4/tests/cd/cd5012a.ada
! 1892070e6feeb321986c5cbbcc427b4a  gcc/testsuite/ada/acats-4/tests/cd/cd5012b.ada
! ff4f485285269aca5506577d2a0b3b25  gcc/testsuite/ada/acats-4/tests/cd/cd5012e.ada
! a5f14af29759eeb2088d73d911c87c1f  gcc/testsuite/ada/acats-4/tests/cd/cd5012f.ada
! e5f28d4028e3550e275facc5a05598e5  gcc/testsuite/ada/acats-4/tests/cd/cd5012i.ada
! 16dbc766d573615ec2e4899fad17e3bf  gcc/testsuite/ada/acats-4/tests/cd/cd5012m.ada
! 6cc56f376ceaa00b529da26c6460e8d6  gcc/testsuite/ada/acats-4/tests/cd/cd5013a.ada
! c0918022f30f205dd1507581efbfdd4d  gcc/testsuite/ada/acats-4/tests/cd/cd5013c.ada
! 811d55a4a9aee790bed1e966d928fbb2  gcc/testsuite/ada/acats-4/tests/cd/cd5013e.ada
! 21ba9a45a10469204bf9be2e86069c81  gcc/testsuite/ada/acats-4/tests/cd/cd5013g.ada
! 4f445e0ed2b7e60f8eb00f85696e3a7d  gcc/testsuite/ada/acats-4/tests/cd/cd5013i.ada
! 0b15bb9a260246e000106d4512840f2a  gcc/testsuite/ada/acats-4/tests/cd/cd5013k.ada
! 1da10e9981f9def7bfc6d6c2143211ec  gcc/testsuite/ada/acats-4/tests/cd/cd5013m.ada
! 08a9e582acca940c3e759a92734c93c9  gcc/testsuite/ada/acats-4/tests/cd/cd5013o.ada
! 1968e13f319d3b0c07f4c96303157e60  gcc/testsuite/ada/acats-4/tests/cd/cd5014a.ada
! 7c607413594268a5d4b2292b7cb0413b  gcc/testsuite/ada/acats-4/tests/cd/cd5014c.ada
! 8fef3117954cc6c0a11bb3f93e364b40  gcc/testsuite/ada/acats-4/tests/cd/cd5014e.ada
! 0b813473017a44baccc884d20552e8cd  gcc/testsuite/ada/acats-4/tests/cd/cd5014g.ada
! 527b59a75ca64a8266a57d7a5088fe89  gcc/testsuite/ada/acats-4/tests/cd/cd5014i.ada
! fc74902958756d067346aa25dc320720  gcc/testsuite/ada/acats-4/tests/cd/cd5014k.ada
! b77eb1036af76cfb5202f2de49ace505  gcc/testsuite/ada/acats-4/tests/cd/cd5014m.ada
! ab247e3e629023fbd5f60ebe8227bdb5  gcc/testsuite/ada/acats-4/tests/cd/cd5014o.ada
! fc0ebe93b10ae9a9d4c3c4a5df942f54  gcc/testsuite/ada/acats-4/tests/cd/cd5014t.ada
! c00ed5123db97df563396ec85314f780  gcc/testsuite/ada/acats-4/tests/cd/cd5014v.ada
! bbf572fbf22be12dd2a668dcd54775ea  gcc/testsuite/ada/acats-4/tests/cd/cd5014x.ada
! 34d86be0b29568cce7a2a466311b3b81  gcc/testsuite/ada/acats-4/tests/cd/cd5014y.ada
! b56429de483f94a422eb6ca63ee074f9  gcc/testsuite/ada/acats-4/tests/cd/cd5014z.ada
! aa622725c36aef33e28cfe216e74dbf2  gcc/testsuite/ada/acats-4/tests/cd/cd70001.a
! 2eb61a4a6db022ec0de56d97cdb58d92  gcc/testsuite/ada/acats-4/tests/cd/cd7002a.ada
! aaa73d4164232ddfd2c5811f78c69833  gcc/testsuite/ada/acats-4/tests/cd/cd7007b.ada
! a2455776674d2ad1da3cc32ece807208  gcc/testsuite/ada/acats-4/tests/cd/cd7101d.ada
! aa55af7af75ac0b3c135078d81fb495f  gcc/testsuite/ada/acats-4/tests/cd/cd7101e.dep
! 54f3d5f0c03029d0398feadc1fba13fa  gcc/testsuite/ada/acats-4/tests/cd/cd7101f.dep
! d4c58764ec07d4b64c614f06a404a048  gcc/testsuite/ada/acats-4/tests/cd/cd7101g.tst
! b19b5291beb6e4d9ba34dc60acc52917  gcc/testsuite/ada/acats-4/tests/cd/cd7103d.ada
! bc9859e9de09dbae5b873f61d7dd6d25  gcc/testsuite/ada/acats-4/tests/cd/cd7202a.ada
! 27154e701456e154266de19089be5f95  gcc/testsuite/ada/acats-4/tests/cd/cd7204b.ada
! 866e238520f9fe6f2e1ebc1c66530b27  gcc/testsuite/ada/acats-4/tests/cd/cd7204c.ada
! 463ecdd8176f35af59f9b3791565e928  gcc/testsuite/ada/acats-4/tests/cd/cd72a01.a
! 97e1c7a2d8dcad44f97e8a054d7ddbfa  gcc/testsuite/ada/acats-4/tests/cd/cd72a02.a
! 094d528313c32d60bc8ef9966a3ba667  gcc/testsuite/ada/acats-4/tests/cd/cd7305a.ada
! 89a9ca0baa4aea5a158e931fd05972da  gcc/testsuite/ada/acats-4/tests/cd/cd90001.a
! b35e132e38a1316bb94eb5685e744e45  gcc/testsuite/ada/acats-4/tests/cd/cd92001.a
! 4acd15be94cdb921d9aaaf1c68bc86bd  gcc/testsuite/ada/acats-4/tests/cd/cda201a.ada
! 95c680f466bbb6b462cff702c8c051d8  gcc/testsuite/ada/acats-4/tests/cd/cda201b.ada
! 46aab534344a6aeab59cdc069c0a30a9  gcc/testsuite/ada/acats-4/tests/cd/cda201c.ada
! 51c51b9e46a1a5740ae0b124d61d55ca  gcc/testsuite/ada/acats-4/tests/cd/cda201e.ada
! e5b8e54ff3bc71d8a0f53d66df7260a5  gcc/testsuite/ada/acats-4/tests/cd/cdb0001.a
! 3e8905eddf7e2c220acc4b501f2233a1  gcc/testsuite/ada/acats-4/tests/cd/cdb0002.a
! 4d8334f61837b54deaa10e41063c39af  gcc/testsuite/ada/acats-4/tests/cd/cdb0a01.a
! d60d2f5f8d96507e1b594680a8ddbf8c  gcc/testsuite/ada/acats-4/tests/cd/cdb0a02.a
! 0d86653c4623915b37f686be9439be22  gcc/testsuite/ada/acats-4/tests/cd/cdb3a01.a
! cc866a4ee33da37e6ec427b9e73ae8ab  gcc/testsuite/ada/acats-4/tests/cd/cdb4001.a
! d3910d26782aaab53d6acf37e0519685  gcc/testsuite/ada/acats-4/tests/cd/cdd1001.a
! ecea7d5e451c93f7530aa28e39d75580  gcc/testsuite/ada/acats-4/tests/cd/cdd2001.a
! 09e97dda9b7ced04ce9c741ad0599d96  gcc/testsuite/ada/acats-4/tests/cd/cdd2a01.a
! 72e91e49172aabe99c78bb568616e583  gcc/testsuite/ada/acats-4/tests/cd/cdd2a02.a
! 36648315ddf64d4e564a5e05da351b1c  gcc/testsuite/ada/acats-4/tests/cd/cdd2a03.a
! 9ab6f734463584ed4f42316ca9f7798f  gcc/testsuite/ada/acats-4/tests/cd/cdd2b01.a
! 68f2a16c4f09dc4c329266f8df2df713  gcc/testsuite/ada/acats-4/tests/cd/cdd2b02.a
! 3ce443f0ccbd9dba9e932b0f23c415a2  gcc/testsuite/ada/acats-4/tests/cd/cdd2b03.a
! 9d778d8fd57f33ce01f19581f56f3ccd  gcc/testsuite/ada/acats-4/tests/cd/cdd2b04.a
! 317e3f1dc15de17ef49001a1f08c35b3  gcc/testsuite/ada/acats-4/tests/cd/cde0001.a
! 5366c384529d40f1900fd221fd1aefb7  gcc/testsuite/ada/acats-4/tests/cd/cde0002.a
! db4fa358a29fb1580529e940fa7534f7  gcc/testsuite/ada/acats-4/tests/cd/cde0003.a
! e3c9b20329b0f7e7d60dc55f195727f7  gcc/testsuite/ada/acats-4/tests/ce/ce2102a.ada
! 56be361ddf744d65d5919f5f77470cfd  gcc/testsuite/ada/acats-4/tests/ce/ce2102b.ada
! 83c95e98a0edc5913eda034e9803f9a3  gcc/testsuite/ada/acats-4/tests/ce/ce2102c.tst
! 704cb92cd741551b8c76bb24ab8f01a6  gcc/testsuite/ada/acats-4/tests/ce/ce2102d.ada
! a4c5c5ff89eb450e4c847a9cebea2a03  gcc/testsuite/ada/acats-4/tests/ce/ce2102e.ada
! 27760dba95f836989a21b8529a71855d  gcc/testsuite/ada/acats-4/tests/ce/ce2102f.ada
! fe48a7b7badffee5e6b11bab0b32391a  gcc/testsuite/ada/acats-4/tests/ce/ce2102g.ada
! d704111bdcdb479f1991a8daee40cdc6  gcc/testsuite/ada/acats-4/tests/ce/ce2102h.tst
! 660d5113b9badd86759bd83e670ede30  gcc/testsuite/ada/acats-4/tests/ce/ce2102i.ada
! 8796caaebedc2e2c57dc7e71ff241431  gcc/testsuite/ada/acats-4/tests/ce/ce2102j.ada
! ceb778fa800778a3993ddc7cd9190c8f  gcc/testsuite/ada/acats-4/tests/ce/ce2102k.ada
! 23bd39333ef2a75df64af434a8d52288  gcc/testsuite/ada/acats-4/tests/ce/ce2102l.ada
! 9a4f2b513351918f23c1e1fcc5d48aaa  gcc/testsuite/ada/acats-4/tests/ce/ce2102m.ada
! 57880455279d766e91fd84c1ad26a38f  gcc/testsuite/ada/acats-4/tests/ce/ce2102n.ada
! 1658c529498b5b4b8d79ff4a0a362715  gcc/testsuite/ada/acats-4/tests/ce/ce2102o.ada
! a942f038d4463c45d5c583b1985c7c87  gcc/testsuite/ada/acats-4/tests/ce/ce2102p.ada
! 8ce185028df0d4e8d8de27e964b87758  gcc/testsuite/ada/acats-4/tests/ce/ce2102q.ada
! 1439304477a0f927f09dcb2a2639fe66  gcc/testsuite/ada/acats-4/tests/ce/ce2102r.ada
! a5aff3dd28b5d54dcd3d2367ad10512e  gcc/testsuite/ada/acats-4/tests/ce/ce2102s.ada
! fab20fee3d01ec0d98c83ae2e0b85bda  gcc/testsuite/ada/acats-4/tests/ce/ce2102t.ada
! fb506c6fcfe4ce698ff9a830b7c56229  gcc/testsuite/ada/acats-4/tests/ce/ce2102u.ada
! 6533e0fca22d00bf5e7584ed3a4dc842  gcc/testsuite/ada/acats-4/tests/ce/ce2102v.ada
! 96597eb49b1372fa65ee2328da95ca07  gcc/testsuite/ada/acats-4/tests/ce/ce2102w.ada
! 79aea0b4cdef1b6365b9be26c87383b1  gcc/testsuite/ada/acats-4/tests/ce/ce2102x.ada
! b982e3e68e8a4f04e10e3b2780934046  gcc/testsuite/ada/acats-4/tests/ce/ce2102y.ada
! d102ee0d07b326b9d4073e60e25ee113  gcc/testsuite/ada/acats-4/tests/ce/ce2103a.tst
! ae11fc214dfce8e1c5dce5dd8dff9ad9  gcc/testsuite/ada/acats-4/tests/ce/ce2103b.tst
! 97d4cf14fe4c578c0d86448663834c20  gcc/testsuite/ada/acats-4/tests/ce/ce2103c.ada
! 99c7332bd6a90a3213eb826d7f902efa  gcc/testsuite/ada/acats-4/tests/ce/ce2103d.ada
! 60b763cadd79ca8009e41e392d9aa37b  gcc/testsuite/ada/acats-4/tests/ce/ce2104a.ada
! 4f9096bebf0622c62a3f4358655497af  gcc/testsuite/ada/acats-4/tests/ce/ce2104b.ada
! f1962e353466d1757ad6a9c641624847  gcc/testsuite/ada/acats-4/tests/ce/ce2104c.ada
! c687f392201a3d542022c53d87c728c6  gcc/testsuite/ada/acats-4/tests/ce/ce2104d.ada
! e59622b5be7a0b85f62f4f5dfd87250c  gcc/testsuite/ada/acats-4/tests/ce/ce2106a.ada
! 0390975b4b078391dba02ca3c8f31638  gcc/testsuite/ada/acats-4/tests/ce/ce2106b.ada
! 8576613b0fb7cb5404cf64939d34b3af  gcc/testsuite/ada/acats-4/tests/ce/ce2108e.ada
! 651994d660ec55d3e422ceb303d2034b  gcc/testsuite/ada/acats-4/tests/ce/ce2108f.ada
! ba5e89f5212818e3e53a4cf7d59d646c  gcc/testsuite/ada/acats-4/tests/ce/ce2108g.ada
! fb62dbd03a1355b41f3d194167f479aa  gcc/testsuite/ada/acats-4/tests/ce/ce2108h.ada
! e1df0b3934297c1162437a03a450f12a  gcc/testsuite/ada/acats-4/tests/ce/ce2109a.ada
! d91a1fcd2695ad63b53b63e0d22d3f22  gcc/testsuite/ada/acats-4/tests/ce/ce2109b.ada
! 0a95aeffa3822cc96d6f770183b34979  gcc/testsuite/ada/acats-4/tests/ce/ce2109c.ada
! 329e30bd5ac69971fa84cd76bd66b302  gcc/testsuite/ada/acats-4/tests/ce/ce2110a.ada
! b63ea51508983167185a0e378c787235  gcc/testsuite/ada/acats-4/tests/ce/ce2110c.ada
! 385c38395502c50c4f04f16ed172b5c3  gcc/testsuite/ada/acats-4/tests/ce/ce2111a.ada
! 0cab0967d4b6100c093d83a0daa2ca06  gcc/testsuite/ada/acats-4/tests/ce/ce2111b.ada
! 1def457c7ded3aa15287b30a02c2c1bf  gcc/testsuite/ada/acats-4/tests/ce/ce2111c.ada
! e039c87f3e2f30f3b378642cc3d5d3c3  gcc/testsuite/ada/acats-4/tests/ce/ce2111e.ada
! 607ff5b75e0ac677df365e3867c8b8bc  gcc/testsuite/ada/acats-4/tests/ce/ce2111f.ada
! 9b55a66cd32d536d65916a0288c480f4  gcc/testsuite/ada/acats-4/tests/ce/ce2111g.ada
! 9aac3a3d20f722d72f0a97d15db7e6ff  gcc/testsuite/ada/acats-4/tests/ce/ce2111i.ada
! 451691c716142d6af52540932182f7a8  gcc/testsuite/ada/acats-4/tests/ce/ce2201a.ada
! a9019ab5c60383a5aec6b4e12cf67546  gcc/testsuite/ada/acats-4/tests/ce/ce2201b.ada
! 29858e1a8a6dd46bb9164e8c8edbcddf  gcc/testsuite/ada/acats-4/tests/ce/ce2201c.ada
! 34d8b0e50b71bb424acf20936253736f  gcc/testsuite/ada/acats-4/tests/ce/ce2201d.dep
! b20fac24f54e723d0cc0d2b283a1a98c  gcc/testsuite/ada/acats-4/tests/ce/ce2201e.dep
! e5ef319f07f83742ea6dacb674de4c74  gcc/testsuite/ada/acats-4/tests/ce/ce2201f.ada
! 89d1575c20871ec14a7510e2c7fd7e56  gcc/testsuite/ada/acats-4/tests/ce/ce2201g.ada
! 06e274ba9cfdca457d343f7d036af0bc  gcc/testsuite/ada/acats-4/tests/ce/ce2201h.ada
! 819625912e63f1bb0690319469d91d14  gcc/testsuite/ada/acats-4/tests/ce/ce2201i.ada
! c75df2290aa04176fd8862e092446183  gcc/testsuite/ada/acats-4/tests/ce/ce2201j.ada
! 5cd3fabcbac1ce5f97eb0c3b7ff68060  gcc/testsuite/ada/acats-4/tests/ce/ce2201k.ada
! 5f85b515f14775082f0cef057e6c7cec  gcc/testsuite/ada/acats-4/tests/ce/ce2201l.ada
! dacbb7d19d52906e970100c8a0524fd4  gcc/testsuite/ada/acats-4/tests/ce/ce2201m.ada
! 45f176910989cfdcd7fdc941f37a5b71  gcc/testsuite/ada/acats-4/tests/ce/ce2201n.ada
! 376cc7edaf46154ca8f65652b5d6eca4  gcc/testsuite/ada/acats-4/tests/ce/ce2202a.ada
! 939f3ce3a39c9ca9d86e52320f27ff2c  gcc/testsuite/ada/acats-4/tests/ce/ce2203a.tst
! ba04f29f243a15d2bbe413b9e0066901  gcc/testsuite/ada/acats-4/tests/ce/ce2204a.ada
! 2fc36a0b7b4ddb630b023af7c4d90ba7  gcc/testsuite/ada/acats-4/tests/ce/ce2204b.ada
! 9ef6a168f2e294541459fe7a14263eb5  gcc/testsuite/ada/acats-4/tests/ce/ce2204c.ada
! b0274d08b84af4b62ad59e3d9ddb07df  gcc/testsuite/ada/acats-4/tests/ce/ce2204d.ada
! 34418b28be06a3924c3a2584bef259b6  gcc/testsuite/ada/acats-4/tests/ce/ce2205a.ada
! 5c92fac63d085e6a68726106d482ea42  gcc/testsuite/ada/acats-4/tests/ce/ce2206a.ada
! fcc7c7c24b495ce3ddaa0f9a580d75ee  gcc/testsuite/ada/acats-4/tests/ce/ce2208b.ada
! 97568e8cf63e0507c14b35a1a14e20c0  gcc/testsuite/ada/acats-4/tests/ce/ce2401a.ada
! dcd9e7cbbd7e97c5dd3e3add1eb9dc36  gcc/testsuite/ada/acats-4/tests/ce/ce2401b.ada
! efcdb258c81995c38e8cc3694b22f6dd  gcc/testsuite/ada/acats-4/tests/ce/ce2401c.ada
! e7f9dbd6fea160401601272d061289a3  gcc/testsuite/ada/acats-4/tests/ce/ce2401e.ada
! 1bf5badbcde77492314acef836d8ea11  gcc/testsuite/ada/acats-4/tests/ce/ce2401f.ada
! eb673da58247c955773ce3b8e1c2d4f3  gcc/testsuite/ada/acats-4/tests/ce/ce2401h.ada
! 6918301d4740c9f3a5bcdf8763ba341a  gcc/testsuite/ada/acats-4/tests/ce/ce2401i.ada
! 664a2145b5105ab8ae94b8ba8dca5cdd  gcc/testsuite/ada/acats-4/tests/ce/ce2401j.ada
! 7f54c0274e46b59b1fec8510f4fc3ad7  gcc/testsuite/ada/acats-4/tests/ce/ce2401k.ada
! a83a38fe98395d0bb886cb6143eb8170  gcc/testsuite/ada/acats-4/tests/ce/ce2401l.ada
! 2c4e89aba46a0152400d53a9aed78ba8  gcc/testsuite/ada/acats-4/tests/ce/ce2402a.ada
! 4e54cd3fcd15e2f31d844365222a85b3  gcc/testsuite/ada/acats-4/tests/ce/ce2403a.tst
! 4fce3b03a76a452b2433c54b199834ff  gcc/testsuite/ada/acats-4/tests/ce/ce2404a.ada
! ad81e45a71e09a3713483ae198eae6b0  gcc/testsuite/ada/acats-4/tests/ce/ce2404b.ada
! 397eb6a738bd1fb16bf404d4581a21e8  gcc/testsuite/ada/acats-4/tests/ce/ce2405b.ada
! 035cdd8af2147f386ba98eafee6fa53d  gcc/testsuite/ada/acats-4/tests/ce/ce2406a.ada
! bc1c3fb660e3a1a6cd3c3cd2c20c6f21  gcc/testsuite/ada/acats-4/tests/ce/ce2407a.ada
! e21a045af5825bcf7bae0f7774bf28bb  gcc/testsuite/ada/acats-4/tests/ce/ce2407b.ada
! 1ac50c952fbab2fcf2e1391bb697aac1  gcc/testsuite/ada/acats-4/tests/ce/ce2408a.ada
! fb58d51e1570b9726aa28d10034cf135  gcc/testsuite/ada/acats-4/tests/ce/ce2408b.ada
! d60b98c48fae643e51060dfd4200371e  gcc/testsuite/ada/acats-4/tests/ce/ce2409a.ada
! 5b25842de422c3e8d6301447c51d8985  gcc/testsuite/ada/acats-4/tests/ce/ce2409b.ada
! e03ae0d17d4ce186bb17ad28c1d12c8e  gcc/testsuite/ada/acats-4/tests/ce/ce2410a.ada
! a10dc12fca4ab67d0e070b8f08878918  gcc/testsuite/ada/acats-4/tests/ce/ce2410b.ada
! ef01f4584aa6fe18dfca4291aa2b9936  gcc/testsuite/ada/acats-4/tests/ce/ce2411a.ada
! cfdd50459f606dfd0272b27f902831f0  gcc/testsuite/ada/acats-4/tests/ce/ce3002b.tst
! 8c7a2401c3fd65042aaf7fbaaebb05d5  gcc/testsuite/ada/acats-4/tests/ce/ce3002c.tst
! 60cfa1b0514071feae57d422f407bbc6  gcc/testsuite/ada/acats-4/tests/ce/ce3002d.ada
! f7f30f9bace21926cfd024ab3ae7ed4a  gcc/testsuite/ada/acats-4/tests/ce/ce3002f.ada
! c4f22dddebf62a993e9a5dca37748e9a  gcc/testsuite/ada/acats-4/tests/ce/ce3102a.ada
! 019efa14311a98e7532962ec6464bb8e  gcc/testsuite/ada/acats-4/tests/ce/ce3102b.tst
! dab3a80b1760df07e4cf44cef4f9ca81  gcc/testsuite/ada/acats-4/tests/ce/ce3102d.ada
! 112884bd382c35480c4248866f3a556e  gcc/testsuite/ada/acats-4/tests/ce/ce3102e.ada
! 884f6ff3272bb27974b5c059fd940eb8  gcc/testsuite/ada/acats-4/tests/ce/ce3102f.ada
! 561a9bb3212245b35ea37ed7834ace08  gcc/testsuite/ada/acats-4/tests/ce/ce3102g.ada
! a5c10d55f5c631bb605e9f92f33b3d83  gcc/testsuite/ada/acats-4/tests/ce/ce3102h.ada
! 16f9be98787f36d98dd3a0d7c5673f99  gcc/testsuite/ada/acats-4/tests/ce/ce3102i.ada
! f2fb4988c4b17b901cb57756fa48524d  gcc/testsuite/ada/acats-4/tests/ce/ce3102j.ada
! 5885ee3beb2611070afd9595b92d024d  gcc/testsuite/ada/acats-4/tests/ce/ce3102k.ada
! af4fce15977e583c9580c84a57f46000  gcc/testsuite/ada/acats-4/tests/ce/ce3103a.ada
! 1a359b00af85a86ae636ed8ce9f54011  gcc/testsuite/ada/acats-4/tests/ce/ce3104a.ada
! 62ae4a6a702993a429980ed85d7d288b  gcc/testsuite/ada/acats-4/tests/ce/ce3104b.ada
! 3097f1866f5a1a12edc0bd1ad06fcfd7  gcc/testsuite/ada/acats-4/tests/ce/ce3104c.ada
! ffdd7cea02bf78362b21d5b47923f55a  gcc/testsuite/ada/acats-4/tests/ce/ce3106a.ada
! c089188b0086e9498b16c61338d1c72e  gcc/testsuite/ada/acats-4/tests/ce/ce3106b.ada
! 7ec91be55117ceec515d06ff18fd96f6  gcc/testsuite/ada/acats-4/tests/ce/ce3107a.tst
! 29791bc75974606a36e491a742bb3096  gcc/testsuite/ada/acats-4/tests/ce/ce3107b.ada
! eb49ffd6a23ce40400cdc2ebf0c8f371  gcc/testsuite/ada/acats-4/tests/ce/ce3108a.ada
! fd863ff6b1661c6c912d9bf6aebc3bc9  gcc/testsuite/ada/acats-4/tests/ce/ce3108b.ada
! 97e280eb5834dec4e91bbbc97553b1c7  gcc/testsuite/ada/acats-4/tests/ce/ce3110a.ada
! 5f42a55944d863fa57d6e12253d4922c  gcc/testsuite/ada/acats-4/tests/ce/ce3112c.ada
! c9d44fa9ff3ca5a2ccdda83b010c1f54  gcc/testsuite/ada/acats-4/tests/ce/ce3112d.ada
! f01486f7b41b7e9bb285f2b42444a64f  gcc/testsuite/ada/acats-4/tests/ce/ce3114a.ada
! 816907364fd976b617fbee2dc8afc858  gcc/testsuite/ada/acats-4/tests/ce/ce3115a.ada
! 55427ea93a85e61592244d314238e089  gcc/testsuite/ada/acats-4/tests/ce/ce3201a.ada
! 0a50773e8cb26d94c11adb5533460429  gcc/testsuite/ada/acats-4/tests/ce/ce3202a.ada
! 06b5bbb44e688a3c0c0ca62e655c32ab  gcc/testsuite/ada/acats-4/tests/ce/ce3206a.ada
! 98a3e7772f00a7bebd187c6c2d309f82  gcc/testsuite/ada/acats-4/tests/ce/ce3207a.ada
! f4529439e526335f9525bb157863cc63  gcc/testsuite/ada/acats-4/tests/ce/ce3301a.ada
! 0a70a8ac8ee35a84b380c07ea541b57f  gcc/testsuite/ada/acats-4/tests/ce/ce3302a.ada
! 9bac0e06cef0c10689cc849f3c509fcf  gcc/testsuite/ada/acats-4/tests/ce/ce3303a.ada
! 23c77e761edd8a91671acf3422a0ca06  gcc/testsuite/ada/acats-4/tests/ce/ce3304a.tst
! d0da64618db56f4abfac0c3b90fa0296  gcc/testsuite/ada/acats-4/tests/ce/ce3305a.ada
! 3f7e70ff0a93058dd780e3e6e4fefa3d  gcc/testsuite/ada/acats-4/tests/ce/ce3306a.ada
! 4e1329f66825e0283637c00ca6acc5b6  gcc/testsuite/ada/acats-4/tests/ce/ce3401a.ada
! df06c67b3b1ea125ef98d5346e81cc7e  gcc/testsuite/ada/acats-4/tests/ce/ce3402a.ada
! b50c12a694c3c56d3a2cf04d9ca9ccc3  gcc/testsuite/ada/acats-4/tests/ce/ce3402c.ada
! e2743c970635e3ead26ba550e6c23aab  gcc/testsuite/ada/acats-4/tests/ce/ce3402d.ada
! c0341031211c513d8c748c61167125fb  gcc/testsuite/ada/acats-4/tests/ce/ce3402e.ada
! f9deacf7d49917900f3fcee43aee5ca6  gcc/testsuite/ada/acats-4/tests/ce/ce3403a.ada
! fec31596c967bb1bab6a046e32225c6b  gcc/testsuite/ada/acats-4/tests/ce/ce3403b.ada
! 7e9202e07d3f865f2ceeb151792c452f  gcc/testsuite/ada/acats-4/tests/ce/ce3403c.ada
! 64070608c4f9c6a05d1e23408e5beb0d  gcc/testsuite/ada/acats-4/tests/ce/ce3403d.ada
! d82cac6d273d1fbe65506c1eecff04b9  gcc/testsuite/ada/acats-4/tests/ce/ce3403e.ada
! 7cdc9d7a9c43884cbedbde28d4954fe4  gcc/testsuite/ada/acats-4/tests/ce/ce3403f.ada
! dc1a67476ce793079c7af8b2d1b275ac  gcc/testsuite/ada/acats-4/tests/ce/ce3404a.ada
! 8b982e428bef61a3980b00b8079ad4f2  gcc/testsuite/ada/acats-4/tests/ce/ce3404b.ada
! 5cc2fbe64ade8df5eced5c397a38020a  gcc/testsuite/ada/acats-4/tests/ce/ce3404c.ada
! 871605306e645bb8c8952539a05637b2  gcc/testsuite/ada/acats-4/tests/ce/ce3404d.ada
! 5afe1fa2e94e304b32849dad526b0cb4  gcc/testsuite/ada/acats-4/tests/ce/ce3405a.ada
! 75e7f1f2e2d338bdbc593c460b1e055f  gcc/testsuite/ada/acats-4/tests/ce/ce3405c.ada
! d61f321bab45f725f89da9ebd98c7959  gcc/testsuite/ada/acats-4/tests/ce/ce3405d.ada
! 683881439899376dec46462b7b974e93  gcc/testsuite/ada/acats-4/tests/ce/ce3406a.ada
! 1d67a6840b438185a99382b830ffe815  gcc/testsuite/ada/acats-4/tests/ce/ce3406b.ada
! 00a1933b7205d0378d065989609d0e6f  gcc/testsuite/ada/acats-4/tests/ce/ce3406c.ada
! bc8a2b4d509e438b111cb451ba6c633d  gcc/testsuite/ada/acats-4/tests/ce/ce3406d.ada
! 0c8f9906304b5f6e2f871a2f56543e48  gcc/testsuite/ada/acats-4/tests/ce/ce3407a.ada
! d6da13ff2e3c07bb7f9617a04f387915  gcc/testsuite/ada/acats-4/tests/ce/ce3407b.ada
! bacd5248d5883ef91439cbdd245cbd9a  gcc/testsuite/ada/acats-4/tests/ce/ce3407c.ada
! babb7fd82795ea56950eb78715c895aa  gcc/testsuite/ada/acats-4/tests/ce/ce3408a.ada
! e30520b348614e4a8e628b3ea3aad54e  gcc/testsuite/ada/acats-4/tests/ce/ce3408b.ada
! 5d1d893ced6dbc7d9f25ee4a5fb8e211  gcc/testsuite/ada/acats-4/tests/ce/ce3408c.ada
! ca268135b5b6d64dc8be3768b6f7edc0  gcc/testsuite/ada/acats-4/tests/ce/ce3409a.ada
! 6c79cafc53b26bfb3c462c4d01969806  gcc/testsuite/ada/acats-4/tests/ce/ce3409b.ada
! 153c9a6d9246f682a42cd95552087944  gcc/testsuite/ada/acats-4/tests/ce/ce3409c.ada
! 62ed81bdf1e56f27f4c2630b320c6b75  gcc/testsuite/ada/acats-4/tests/ce/ce3409d.ada
! 67051865f07afe2038f84683dece3683  gcc/testsuite/ada/acats-4/tests/ce/ce3409e.ada
! 36c2b6db90b30d1e89dfe642110ca9be  gcc/testsuite/ada/acats-4/tests/ce/ce3410a.ada
! 5cf308b315cd2ac4c47ecb7409ef0ba1  gcc/testsuite/ada/acats-4/tests/ce/ce3410b.ada
! bcebb594f14a81961460c696159ea641  gcc/testsuite/ada/acats-4/tests/ce/ce3410c.ada
! c28a6aea6e2fa07f6b2e23e3e14876c2  gcc/testsuite/ada/acats-4/tests/ce/ce3410d.ada
! 8c67058f9e7fc008e387aa622534b5d4  gcc/testsuite/ada/acats-4/tests/ce/ce3410e.ada
! 4c3d96fe2a475d4a97d07bbd385cd260  gcc/testsuite/ada/acats-4/tests/ce/ce3411a.ada
! 0a0deabd5d66c7e62d00da0c83ac5dfa  gcc/testsuite/ada/acats-4/tests/ce/ce3411c.ada
! a8dda42826e8174f0657de7379cb605b  gcc/testsuite/ada/acats-4/tests/ce/ce3412a.ada
! 040ce75a5a909fb3da32ae0e451bda3e  gcc/testsuite/ada/acats-4/tests/ce/ce3413a.ada
! 951c9393706295621e4a78e9a1b9e2ee  gcc/testsuite/ada/acats-4/tests/ce/ce3413b.ada
! c33c707be5a9051ad8c6962035162e25  gcc/testsuite/ada/acats-4/tests/ce/ce3413c.ada
! 6cb9f4f71827deb077bcc1180c854625  gcc/testsuite/ada/acats-4/tests/ce/ce3414a.ada
! e5e2298148250ece65cc736cf86b5a00  gcc/testsuite/ada/acats-4/tests/ce/ce3601a.ada
! 1215dc7327db7704c21d367fe12a1ab9  gcc/testsuite/ada/acats-4/tests/ce/ce3602a.ada
! 6ccbba350556793177123ad7809e0ff9  gcc/testsuite/ada/acats-4/tests/ce/ce3602b.ada
! 12843cf2e9816b955ca7962f9bfc627f  gcc/testsuite/ada/acats-4/tests/ce/ce3602c.ada
! cef84bc67c1c6c0d7583ed454834a34f  gcc/testsuite/ada/acats-4/tests/ce/ce3602d.ada
! 5e31687529c52bde6efe93242bcbf2f8  gcc/testsuite/ada/acats-4/tests/ce/ce3603a.ada
! 3dc38686e9ce99632f9e21e584055443  gcc/testsuite/ada/acats-4/tests/ce/ce3604a.ada
! 98f98beec04bb6905ddea16ed212134f  gcc/testsuite/ada/acats-4/tests/ce/ce3604b.ada
! 1c7074f06be7b99dab79f14d5dddb060  gcc/testsuite/ada/acats-4/tests/ce/ce3605a.ada
! 49a30d4306b467f2cd10d4b811cfa231  gcc/testsuite/ada/acats-4/tests/ce/ce3605b.ada
! b496a8c56eea6c0501a70a96873353f7  gcc/testsuite/ada/acats-4/tests/ce/ce3605c.ada
! 6f3fe3a52cae3aa00e90c34391f3d16d  gcc/testsuite/ada/acats-4/tests/ce/ce3605d.ada
! 86bd1f46afec2bf13df76bd0d8ce0514  gcc/testsuite/ada/acats-4/tests/ce/ce3605e.ada
! 8388e3c1abd488ed32c198647fab80fe  gcc/testsuite/ada/acats-4/tests/ce/ce3606a.ada
! b3c475457035678aad225b02f0baaf49  gcc/testsuite/ada/acats-4/tests/ce/ce3606b.ada
! c0471531dea8b138d096c3049a710d34  gcc/testsuite/ada/acats-4/tests/ce/ce3701a.ada
! 918eb1c7abfa51f1d0f0920c8c6305e7  gcc/testsuite/ada/acats-4/tests/ce/ce3704a.ada
! fd0817427cf4c02d336138b11d6153a8  gcc/testsuite/ada/acats-4/tests/ce/ce3704b.ada
! 7fe37fdc40a516882c3388c9405adb57  gcc/testsuite/ada/acats-4/tests/ce/ce3704c.ada
! 9fb3d924d4a90f6940ec5e4b11a0ce61  gcc/testsuite/ada/acats-4/tests/ce/ce3704d.ada
! b5466a70b0554788bcffce4b777d7bbd  gcc/testsuite/ada/acats-4/tests/ce/ce3704e.ada
! 2bd3e088ed3663d0f57172ec9878402c  gcc/testsuite/ada/acats-4/tests/ce/ce3704f.ada
! c1b7a44976ea643f0821318848d2a333  gcc/testsuite/ada/acats-4/tests/ce/ce3704m.ada
! fbb2cb08fa9bd676488ed39c0025017d  gcc/testsuite/ada/acats-4/tests/ce/ce3704n.ada
! ddc6d31452157a248e0315438e717892  gcc/testsuite/ada/acats-4/tests/ce/ce3704o.ada
! 0f3f07ab9439af00921be7fba20ce330  gcc/testsuite/ada/acats-4/tests/ce/ce3705a.ada
! 3be84deb5cb9f6d5be7c2cadf68a90f5  gcc/testsuite/ada/acats-4/tests/ce/ce3705b.ada
! 11a056cf164688fbe30b1b1a85208e47  gcc/testsuite/ada/acats-4/tests/ce/ce3705c.ada
! e6e83df07a3fab385c58b17a0a43ca83  gcc/testsuite/ada/acats-4/tests/ce/ce3705d.ada
! c1458b663e297c80390f9cd80c7f5864  gcc/testsuite/ada/acats-4/tests/ce/ce3705e.ada
! fab53328469c600d972529f33eecee23  gcc/testsuite/ada/acats-4/tests/ce/ce3706c.ada
! aed136cb2863502616daa378424686d6  gcc/testsuite/ada/acats-4/tests/ce/ce3706d.ada
! 6344fa066f047ece7e15a9dc9dc4bf76  gcc/testsuite/ada/acats-4/tests/ce/ce3706f.ada
! 5316d57b3ad4c2e7fdcfa4dcf7de4439  gcc/testsuite/ada/acats-4/tests/ce/ce3706g.ada
! a778f4b7a5f926d446e0a70ffc718db8  gcc/testsuite/ada/acats-4/tests/ce/ce3707a.ada
! 478e73d32be1e76a0099cd9a73da79c0  gcc/testsuite/ada/acats-4/tests/ce/ce3708a.ada
! 818f2f0d5fcc6bdd1c354cc85b1e6640  gcc/testsuite/ada/acats-4/tests/ce/ce3801a.ada
! 6dc388aa9640dfd68a016a87aedb4e9b  gcc/testsuite/ada/acats-4/tests/ce/ce3801b.ada
! e7b36818b6b1f0625c96af8481f52f0d  gcc/testsuite/ada/acats-4/tests/ce/ce3804a.ada
! c3922fdc4d7bd246e803dbcf29ec365b  gcc/testsuite/ada/acats-4/tests/ce/ce3804b.ada
! eae67ccfbe2e51d92e77fbd2aefd9279  gcc/testsuite/ada/acats-4/tests/ce/ce3804c.ada
! b6842219efec21bda3be0c99f4cc04b4  gcc/testsuite/ada/acats-4/tests/ce/ce3804d.ada
! 9eef715602b30b1986cd238ae1f5fc61  gcc/testsuite/ada/acats-4/tests/ce/ce3804e.ada
! c5996f22c17f572bd9ab7181c9c39831  gcc/testsuite/ada/acats-4/tests/ce/ce3804f.ada
! 613171f59b0c0405911c4d928abfb0b4  gcc/testsuite/ada/acats-4/tests/ce/ce3804g.ada
! d992e56c7b48881cc7480a014ee01ce9  gcc/testsuite/ada/acats-4/tests/ce/ce3804h.ada
! a78767becb4aa2f884469056ae3d7ec4  gcc/testsuite/ada/acats-4/tests/ce/ce3804i.ada
! a4e5e33e2585ba61ae7ae7ae4db12bb2  gcc/testsuite/ada/acats-4/tests/ce/ce3804j.ada
! e6928c085b0205ec7db55a9f830ccdd0  gcc/testsuite/ada/acats-4/tests/ce/ce3804m.ada
! 7193594f0a1b29b3c2845bdce32c53e7  gcc/testsuite/ada/acats-4/tests/ce/ce3804o.ada
! 4a0b48b429236f9e1c8e6f58dd3bfa28  gcc/testsuite/ada/acats-4/tests/ce/ce3804p.ada
! 9ac3d952f3c355af267e6a6d9f4a8a79  gcc/testsuite/ada/acats-4/tests/ce/ce3805a.ada
! c7fd8ecaab44034a4d7e19eaf52d3390  gcc/testsuite/ada/acats-4/tests/ce/ce3805b.ada
! 1aab796cf0e7689c6edac441d619d28e  gcc/testsuite/ada/acats-4/tests/ce/ce3806a.ada
! 2e9a765636a0e1133cc203d0def8724d  gcc/testsuite/ada/acats-4/tests/ce/ce3806b.ada
! bc5e903902196b77527b50b767c2d7da  gcc/testsuite/ada/acats-4/tests/ce/ce3806c.ada
! ee7b548143b3610a6b8d3fdd4698dc45  gcc/testsuite/ada/acats-4/tests/ce/ce3806d.ada
! 4ef742156a97e0838a7c68579a62465c  gcc/testsuite/ada/acats-4/tests/ce/ce3806e.ada
! 48eed75e47db04066ee57577ae8febdf  gcc/testsuite/ada/acats-4/tests/ce/ce3806f.ada
! fae283383fb9395ac865027e5ecb9495  gcc/testsuite/ada/acats-4/tests/ce/ce3806g.ada
! 9d6687f5803bfad7ea35a3abcdb5772c  gcc/testsuite/ada/acats-4/tests/ce/ce3806h.ada
! d3af3076cdba08b0142afed2e6fc0b7b  gcc/testsuite/ada/acats-4/tests/ce/ce3809a.ada
! 2144655343ab8e0671768264f1de7939  gcc/testsuite/ada/acats-4/tests/ce/ce3809b.ada
! 94c3af83ea38d2552587ed3285a692b6  gcc/testsuite/ada/acats-4/tests/ce/ce3810a.ada
! 2b16f8d4e554f10c2a187f8308d7c631  gcc/testsuite/ada/acats-4/tests/ce/ce3810b.ada
! d426db9733cc34265b461b792b6474ad  gcc/testsuite/ada/acats-4/tests/ce/ce3815a.ada
! 48a18490ee8614f76691210dd9487c7b  gcc/testsuite/ada/acats-4/tests/ce/ce3901a.ada
! c0b5bdc86cdd66cb3f89cb34da6bafc6  gcc/testsuite/ada/acats-4/tests/ce/ce3902b.ada
! a2d6108b8d0296883e3c658639d13b49  gcc/testsuite/ada/acats-4/tests/ce/ce3904a.ada
! 379cd7598f79bae2f05b0815465e285f  gcc/testsuite/ada/acats-4/tests/ce/ce3904b.ada
! 49a69ee3b18484263b6f081df965ab54  gcc/testsuite/ada/acats-4/tests/ce/ce3905a.ada
! c53bbe9b612250e0e99c4238d30a2004  gcc/testsuite/ada/acats-4/tests/ce/ce3905b.ada
! 72f61386b7953b00b7cff52dfbc382c2  gcc/testsuite/ada/acats-4/tests/ce/ce3905c.ada
! 2ef4e950bf19d740d3354feb5811b645  gcc/testsuite/ada/acats-4/tests/ce/ce3905l.ada
! 68ee2e176861f501ee862916a0b9b86e  gcc/testsuite/ada/acats-4/tests/ce/ce3906a.ada
! d47ad5ee4c0a4fdbf2ea42a44fe42621  gcc/testsuite/ada/acats-4/tests/ce/ce3906b.ada
! 695b6968a4b0e7d53b5b76fb4f7da0c0  gcc/testsuite/ada/acats-4/tests/ce/ce3906c.ada
! 90d21e5ea4be7a236bfb40661d560471  gcc/testsuite/ada/acats-4/tests/ce/ce3906d.ada
! 3462bab257d5dd10bcb9c56813aa1e74  gcc/testsuite/ada/acats-4/tests/ce/ce3906e.ada
! 2c106bf46db6d9c4c50c01fbe92b517f  gcc/testsuite/ada/acats-4/tests/ce/ce3906f.ada
! 7c41fbcef2ed668ee19c73f44c696bac  gcc/testsuite/ada/acats-4/tests/ce/ce3907a.ada
! ee7ec1f6b6ec4c5ef50b1d777026421a  gcc/testsuite/ada/acats-4/tests/ce/ce3908a.ada
! c4b3b8c1c9564099bdde092389cc2da4  gcc/testsuite/ada/acats-4/tests/cxa/cxa3001.a
! edb7feb6536121adfd4fd4a2f3d69a3f  gcc/testsuite/ada/acats-4/tests/cxa/cxa3002.a
! 48392592efa08a198d6e5d7a1a663683  gcc/testsuite/ada/acats-4/tests/cxa/cxa3003.a
! 7eb11ccdd82615be75ded3c2d5c126d1  gcc/testsuite/ada/acats-4/tests/cxa/cxa3004.a
! 068571e21155e1676645e51e0ac0f685  gcc/testsuite/ada/acats-4/tests/cxa/cxa3005.a
! 64915bdc18bb1833716054a3caefebc1  gcc/testsuite/ada/acats-4/tests/cxa/cxa3006.a
! 76c210bb6bff0646d81957bb2e0900a9  gcc/testsuite/ada/acats-4/tests/cxa/cxa3007.a
! dde0069ab0aadb9bf5f47d79ccf2031b  gcc/testsuite/ada/acats-4/tests/cxa/cxa3008.a
! bd60e198cabb483702243c263729427b  gcc/testsuite/ada/acats-4/tests/cxa/cxa4001.a
! 448cbac61205b8887f79bf74d5666a04  gcc/testsuite/ada/acats-4/tests/cxa/cxa4002.a
! 46d3d97d6347f9b5ec34b3513bcfab40  gcc/testsuite/ada/acats-4/tests/cxa/cxa4003.a
! 76c3b922526644795e2203573ee488e2  gcc/testsuite/ada/acats-4/tests/cxa/cxa4004.a
! 4b1514a00cc831e1766e0d36c67e271f  gcc/testsuite/ada/acats-4/tests/cxa/cxa4005.a
! dcde2eda6ce0a916997883996641ea19  gcc/testsuite/ada/acats-4/tests/cxa/cxa4006.a
! f528eee5266ffb815aad7b653d5be870  gcc/testsuite/ada/acats-4/tests/cxa/cxa4007.a
! 413d98fa6eff56c6b83c031c575fd9a6  gcc/testsuite/ada/acats-4/tests/cxa/cxa4008.a
! d2a3c398ae82b68c1544dbf3384095d7  gcc/testsuite/ada/acats-4/tests/cxa/cxa4009.a
! bc90a16063bf97bfeb414d4209261109  gcc/testsuite/ada/acats-4/tests/cxa/cxa4010.a
! b3036ab386ac3ec1d7b58cd50ad31ab9  gcc/testsuite/ada/acats-4/tests/cxa/cxa4011.a
! 06c61ebbffe294301eb79bc3d5e27c54  gcc/testsuite/ada/acats-4/tests/cxa/cxa4012.a
! ce3338d13ed9dd0ef83c04e53bed831e  gcc/testsuite/ada/acats-4/tests/cxa/cxa4013.a
! 0a9e62befb3d93c2c5e8ab93a327a6c2  gcc/testsuite/ada/acats-4/tests/cxa/cxa4014.a
! aad5ca617d2e40d20e448b613199553e  gcc/testsuite/ada/acats-4/tests/cxa/cxa4015.a
! 33c5aafe5935daee003a8246d048e812  gcc/testsuite/ada/acats-4/tests/cxa/cxa4016.a
! d2ac40847abc81d20163d7c521a90575  gcc/testsuite/ada/acats-4/tests/cxa/cxa4017.a
! 81384a047e321f48d7a9ae881a426324  gcc/testsuite/ada/acats-4/tests/cxa/cxa4018.a
! 334665c1cb55150c5c9af5013690044a  gcc/testsuite/ada/acats-4/tests/cxa/cxa4019.a
! c1bd4452ee22a8a6db5adbef47a641cc  gcc/testsuite/ada/acats-4/tests/cxa/cxa4020.a
! a570e64728464b5d7b98abf94a52b945  gcc/testsuite/ada/acats-4/tests/cxa/cxa4021.a
! ee35d8c6a0354f56770dd1aaf5f4d51e  gcc/testsuite/ada/acats-4/tests/cxa/cxa4022.a
! fc34d10875377b841a1d6172f334da36  gcc/testsuite/ada/acats-4/tests/cxa/cxa4023.a
! 19ec3ce920759c4a2037b89ae3061013  gcc/testsuite/ada/acats-4/tests/cxa/cxa4024.a
! 84b1823c491f3357731a977527457acf  gcc/testsuite/ada/acats-4/tests/cxa/cxa4025.a
! 254627e35c72d32a51b7db3824a622ea  gcc/testsuite/ada/acats-4/tests/cxa/cxa4026.a
! 0c20a4e5aa53f054deaa7ca01817db03  gcc/testsuite/ada/acats-4/tests/cxa/cxa4027.a
! 59f1d44db17d4f8454b983fa7c7b830b  gcc/testsuite/ada/acats-4/tests/cxa/cxa4028.a
! a05e073a2fe4ee6230e2a03d167ffce8  gcc/testsuite/ada/acats-4/tests/cxa/cxa4029.a
! eeef22827a8f3112fb9caff03c0003d3  gcc/testsuite/ada/acats-4/tests/cxa/cxa4030.a
! bb02ecad7593f15476885383704962db  gcc/testsuite/ada/acats-4/tests/cxa/cxa4031.a
! e272d6fb88a469d5600466803e241311  gcc/testsuite/ada/acats-4/tests/cxa/cxa4032.a
! 3f7248dd7e0876538e54ffc83eb5b9f9  gcc/testsuite/ada/acats-4/tests/cxa/cxa4033.a
! 5371a61290fff5fbf4cfd658bf15ee5d  gcc/testsuite/ada/acats-4/tests/cxa/cxa4035.a
! 4a04fc9dd793d73d98dfcfe281cc9aa3  gcc/testsuite/ada/acats-4/tests/cxa/cxa4036.a
! 5cc03d6967386c435776ef6c5916d72c  gcc/testsuite/ada/acats-4/tests/cxa/cxa4037.a
! fb44a942477132fdb687414879625c05  gcc/testsuite/ada/acats-4/tests/cxa/cxa4038.a
! cc1f9976de153ea1097c1f6fa192d3b2  gcc/testsuite/ada/acats-4/tests/cxa/cxa4039.a
! d5b5e8186c886aee7a112ba901ef5b8c  gcc/testsuite/ada/acats-4/tests/cxa/cxa5011.a
! a67372b949970924bc0a9dd48dfc4999  gcc/testsuite/ada/acats-4/tests/cxa/cxa5012.a
! 1bc3b7995dbf8b972dd33ceccc5775f8  gcc/testsuite/ada/acats-4/tests/cxa/cxa5013.a
! 7f31584ea86307c534d43e91b8d28708  gcc/testsuite/ada/acats-4/tests/cxa/cxa5015.a
! b236bc272cd2178596f9c2ee66be6978  gcc/testsuite/ada/acats-4/tests/cxa/cxa5016.a
! ee786104570339c108786248363e8be5  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a01.a
! 59b52d99d8ad7539d9702fd5808604ab  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a02.a
! e58abfcc53f4c016f65e49a2e76c7c18  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a03.a
! 07803a06f2f6d9efa364537c4d61d56c  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a04.a
! 8beb99d4b6c77de021e0fb13ef712afc  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a05.a
! 4facff6e7577e863bfd71cfc8d80f4dc  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a06.a
! c3a4baf4aa21b446ccc93a6c7667de6a  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a07.a
! 6278088ddb4cadb7d9e5d09b9045b4b6  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a08.a
! cd7c58666aed347e740c0f6fd42f83d6  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a09.a
! ba78679b1a563e67c0076c1562ccf0f3  gcc/testsuite/ada/acats-4/tests/cxa/cxa5a10.a
! 96b76cdb631cda2774fc81007f5ec5ee  gcc/testsuite/ada/acats-4/tests/cxa/cxa8001.a
! 367d7f0f5e6305bdd87092066759b0fa  gcc/testsuite/ada/acats-4/tests/cxa/cxa8002.a
! 620e6506d3b188143f95bf7e9e7c2a47  gcc/testsuite/ada/acats-4/tests/cxa/cxa8003.a
! 05afd117ada97a293f198e2915e5c6e6  gcc/testsuite/ada/acats-4/tests/cxa/cxa9001.a
! 720f2be5a9704866c7199912ce177ec5  gcc/testsuite/ada/acats-4/tests/cxa/cxa9002.a
! 0eda7d556ffc97096e8bf91c74b55ab0  gcc/testsuite/ada/acats-4/tests/cxa/cxaa001.a
! 77f8a73011b66fb0023f0f34e63b2b56  gcc/testsuite/ada/acats-4/tests/cxa/cxaa002.a
! 6251cdd5d4023378cc0f056006946d4b  gcc/testsuite/ada/acats-4/tests/cxa/cxaa003.a
! 43c30533c4d806156e62989d0b1f26b1  gcc/testsuite/ada/acats-4/tests/cxa/cxaa004.a
! a3c49183a05e7dd95a555b795d847cdb  gcc/testsuite/ada/acats-4/tests/cxa/cxaa005.a
! 083ebde448b287604a204632257a8037  gcc/testsuite/ada/acats-4/tests/cxa/cxaa006.a
! 0ba729490f0276e661094749d283895c  gcc/testsuite/ada/acats-4/tests/cxa/cxaa007.a
! a5ce4e509ce0ab296bcdd6ac1f1901c4  gcc/testsuite/ada/acats-4/tests/cxa/cxaa008.a
! 6230c5c5911d68e5e9b6f01dd03cb063  gcc/testsuite/ada/acats-4/tests/cxa/cxaa009.a
! ce752fa717d1efa1292cf1f5fa1d3e2e  gcc/testsuite/ada/acats-4/tests/cxa/cxaa010.a
! a1b9e04009fe651e52c78ec25d1e7e02  gcc/testsuite/ada/acats-4/tests/cxa/cxaa011.a
! 89d82c447c9f9e46ab8b9a1c63021ed6  gcc/testsuite/ada/acats-4/tests/cxa/cxaa012.a
! 1f2db7b6b53cd6eac4580863a696a7fd  gcc/testsuite/ada/acats-4/tests/cxa/cxaa013.a
! 2bf5156bd9e88fa709d6514444235132  gcc/testsuite/ada/acats-4/tests/cxa/cxaa014.a
! ed6390551c08d72768b222a3edb8cc65  gcc/testsuite/ada/acats-4/tests/cxa/cxaa015.a
! 9b3e529f8cb7b3fd77f82dd49f82a490  gcc/testsuite/ada/acats-4/tests/cxa/cxaa016.a
! 7147f809c3aae79cfac85e734afed9c2  gcc/testsuite/ada/acats-4/tests/cxa/cxaa017.a
! cc1a3cfdd0d446ad5ae2882d5b1f089b  gcc/testsuite/ada/acats-4/tests/cxa/cxaa018.a
! 5a18624d0b2a25da41748146d45600fe  gcc/testsuite/ada/acats-4/tests/cxa/cxaa019.a
! c8ddb9f66c45bca19e451105a1928554  gcc/testsuite/ada/acats-4/tests/cxa/cxaa020.a
! f1700da5096991db07a95ff30f3e800c  gcc/testsuite/ada/acats-4/tests/cxa/cxaa021.a
! 9cf4b832ba930927ff60624e142141b5  gcc/testsuite/ada/acats-4/tests/cxa/cxaa022.a
! 541118f0faae1cc95a1d90526336b620  gcc/testsuite/ada/acats-4/tests/cxa/cxab001.a
! 1330583d0850bb9322928bc49ee307ba  gcc/testsuite/ada/acats-4/tests/cxa/cxab002.au
! 021c3dc06125a2acf83a2c1228022556  gcc/testsuite/ada/acats-4/tests/cxa/cxab003.au
! 08db41fcbeb1f4972a7c86837062b2b0  gcc/testsuite/ada/acats-4/tests/cxa/cxab004.au
! d3528db6190a39ace75489425aefe80e  gcc/testsuite/ada/acats-4/tests/cxa/cxab005.au
! 02e50f3257e2da0b2d211b9ed3e16791  gcc/testsuite/ada/acats-4/tests/cxa/cxac001.a
! 6788fdbde2fdac4a827fd20b38d8711b  gcc/testsuite/ada/acats-4/tests/cxa/cxac002.a
! bc2d4997d303b5a8cd8ac49ea128eabc  gcc/testsuite/ada/acats-4/tests/cxa/cxac003.a
! 0fed3fbdda367e73cc20e053e436b99f  gcc/testsuite/ada/acats-4/tests/cxa/cxac004.a
! c03fcfa6083accd85e20bd1ddecb7e8e  gcc/testsuite/ada/acats-4/tests/cxa/cxac005.a
! 3e70512f913d06d6e39f59d378b9c72a  gcc/testsuite/ada/acats-4/tests/cxa/cxac006.a
! dafba76724ece929c88e50e2f04a2d63  gcc/testsuite/ada/acats-4/tests/cxa/cxac007.a
! a2862d6559ce75bcd1f2978950a518f3  gcc/testsuite/ada/acats-4/tests/cxa/cxac008.a
! 29be402f887fa9dea33baaae5f966346  gcc/testsuite/ada/acats-4/tests/cxa/cxac009.a
! 1ea54203b702bc16f99a16da31812413  gcc/testsuite/ada/acats-4/tests/cxa/cxaca01.a
! 177daeac77a726a44c2f67d470718c26  gcc/testsuite/ada/acats-4/tests/cxa/cxaca02.a
! 56fc9878aa06e841c10ea2264f6970c0  gcc/testsuite/ada/acats-4/tests/cxa/cxacb01.a
! 66ac8f47c4a79c2e4c270e0af7e2e0ee  gcc/testsuite/ada/acats-4/tests/cxa/cxacb02.a
! 0709cbd75999d38ff1820f0252b56573  gcc/testsuite/ada/acats-4/tests/cxa/cxacc01.a
! e9b9a0663c6181302fffd99d8631f3de  gcc/testsuite/ada/acats-4/tests/cxa/cxaf001.a
! 64bda55ab1e8149633dada5dfa73e125  gcc/testsuite/ada/acats-4/tests/cxa/cxag001.a
! f72f9ec149189650a57ced1c6448365b  gcc/testsuite/ada/acats-4/tests/cxa/cxag002.a
! 064b516330235b3a2c6e323f779ce57a  gcc/testsuite/ada/acats-4/tests/cxa/cxag003.a
! af20f1f87af0ee8b369035758ff9977a  gcc/testsuite/ada/acats-4/tests/cxa/cxah001.a
! aee0909596a410beb82cfadc99316b3b  gcc/testsuite/ada/acats-4/tests/cxa/cxah002.a
! 495aec6bd87708bb8b010e2bbecd3bfc  gcc/testsuite/ada/acats-4/tests/cxa/cxah003.a
! 87e2cded767cde959930567092b74b45  gcc/testsuite/ada/acats-4/tests/cxa/cxai001.a
! cf9871a012454629ea02bb9104dd1d72  gcc/testsuite/ada/acats-4/tests/cxa/cxai002.a
! 7b5ed99a661c8d81a295f69171b3ddf3  gcc/testsuite/ada/acats-4/tests/cxa/cxai003.a
! cee09ca20dfb438247565453fd2da3b6  gcc/testsuite/ada/acats-4/tests/cxa/cxai004.a
! 9448584dfe3798f2a10b3444a4a5e198  gcc/testsuite/ada/acats-4/tests/cxa/cxai005.a
! 3d87b8e8c03fde6814a71b09b00b89d1  gcc/testsuite/ada/acats-4/tests/cxa/cxai006.a
! cc50840d2341ab0eb4ceda48876c803b  gcc/testsuite/ada/acats-4/tests/cxa/cxai007.a
! 39307f81e5bd871e9231d1867b676467  gcc/testsuite/ada/acats-4/tests/cxa/cxai008.a
! f90b4f24fa62b916c10dad03c266a074  gcc/testsuite/ada/acats-4/tests/cxa/cxai009.a
! dd20fccf8410f619b25cbf966a815192  gcc/testsuite/ada/acats-4/tests/cxa/cxai010.a
! 4d7dfcb907478a74b66bf7977738dc6e  gcc/testsuite/ada/acats-4/tests/cxa/cxai011.a
! 0322d5a7e11fa938a6cbe692fe73fb2d  gcc/testsuite/ada/acats-4/tests/cxa/cxai012.a
! d43740abfa9dbe60c86db5d0a996902b  gcc/testsuite/ada/acats-4/tests/cxa/cxai013.a
! 4bf04dd6040663a10cdc66557ef04a87  gcc/testsuite/ada/acats-4/tests/cxa/cxai014.a
! 16613e599c96e04052ee0a08d6fca1ae  gcc/testsuite/ada/acats-4/tests/cxa/cxai015.a
! 3d51ece34f602a854689c633b048232e  gcc/testsuite/ada/acats-4/tests/cxa/cxai016.a
! c0f0dd4f955488f244f677a62c8acb55  gcc/testsuite/ada/acats-4/tests/cxa/cxai017.a
! 8fe3a8a00538ab0bad7e3b6039407332  gcc/testsuite/ada/acats-4/tests/cxa/cxai018.a
! 75244ede00c5597bd1ac99365c7780e8  gcc/testsuite/ada/acats-4/tests/cxa/cxai019.a
! c694fb462f88993b6c63434087d00d8d  gcc/testsuite/ada/acats-4/tests/cxa/cxai020.a
! 66cec384958bbd34083452ee83499529  gcc/testsuite/ada/acats-4/tests/cxa/cxai021.a
! f6d4bce8ba8df49a1c7315b135c3d5e0  gcc/testsuite/ada/acats-4/tests/cxa/cxai022.a
! 52c4c5dc5e47cdfe0c396c828b85d406  gcc/testsuite/ada/acats-4/tests/cxa/cxai023.a
! 17cc000a1cb22812cb82ea68528cb642  gcc/testsuite/ada/acats-4/tests/cxa/cxai024.a
! 1d53d99a0a21e366a6bd7db05abdf093  gcc/testsuite/ada/acats-4/tests/cxa/cxai025.a
! 34674968d7feaa475da1a908b2eda82c  gcc/testsuite/ada/acats-4/tests/cxa/cxai026.a
! 49730eafc3acea832fa944d732929eff  gcc/testsuite/ada/acats-4/tests/cxa/cxai027.a
! 99c1989bf771e1ce115ff327ad7e26dc  gcc/testsuite/ada/acats-4/tests/cxa/cxai028.a
! 138522b9795c0ce324f2bbbbdbf2a9e4  gcc/testsuite/ada/acats-4/tests/cxa/cxai029.a
! b26ffff4623ba2330c463463925f5247  gcc/testsuite/ada/acats-4/tests/cxa/cxai030.a
! 3f9ada9ca43d632fda837d7f718e0cd7  gcc/testsuite/ada/acats-4/tests/cxa/cxai031.a
! 097bfdc8930647a22747b2bdc8b7d141  gcc/testsuite/ada/acats-4/tests/cxa/cxai032.a
! d3055e7cce6588103985fbfbe4b90395  gcc/testsuite/ada/acats-4/tests/cxa/cxai033.a
! 63ab8aacc3a52716e5427c704b694acc  gcc/testsuite/ada/acats-4/tests/cxa/cxai034.a
! ce93a02b20cc46968316a829c7db9195  gcc/testsuite/ada/acats-4/tests/cxa/cxai035.a
! 466c6c8a8045366081c9fd24df4afb06  gcc/testsuite/ada/acats-4/tests/cxa/cxai036.a
! 752fce74ef0e5c6390d38b7ad5ccf4b6  gcc/testsuite/ada/acats-4/tests/cxa/cxaia01.a
! caa672297960b6daf3215c83532dce37  gcc/testsuite/ada/acats-4/tests/cxa/cxaia02.a
! 32f93f75ba46f2ca259c1a1fe4bbbf22  gcc/testsuite/ada/acats-4/tests/cxa/cxaia03.a
! fc061d8da122be070926702ab15de2a8  gcc/testsuite/ada/acats-4/tests/cxa/cxaia04.a
! 07b70846041f675351fd9460b3bd377b  gcc/testsuite/ada/acats-4/tests/cxa/cxaia05.a
! 39dc4ee04a118031a59c5996946688ad  gcc/testsuite/ada/acats-4/tests/cxa/cxaia06.a
! bef631f52e6140b662d657ba85519775  gcc/testsuite/ada/acats-4/tests/cxa/cxaia07.a
! 2df8d8a17cb8c7656532eced5dd8314f  gcc/testsuite/ada/acats-4/tests/cxa/cxaia08.a
! bd2bba92877a6076acd4c85b6a951286  gcc/testsuite/ada/acats-4/tests/cxa/cxaia09.a
! 0cecf92d7fe18aa389851c80b09e123c  gcc/testsuite/ada/acats-4/tests/cxa/cxaia10.a
! af95a8e4f6e0ddda72a785f85ce42eaf  gcc/testsuite/ada/acats-4/tests/cxa/cxaia11.a
! 00fb163b7711912728f3d14858ccc274  gcc/testsuite/ada/acats-4/tests/cxa/cxaia12.a
! 4b9257f93a56fa212d23840deae313f7  gcc/testsuite/ada/acats-4/tests/cxa/cxaia13.a
! 4cc4065b236cc752443496999702f0ea  gcc/testsuite/ada/acats-4/tests/cxa/cxaia14.a
! fb8fefccf32bbc44df1f0394c0a117cb  gcc/testsuite/ada/acats-4/tests/cxa/cxaib01.a
! d516295b5fe2fdffbbeeb2cd3c5e5930  gcc/testsuite/ada/acats-4/tests/cxa/cxaib02.a
! b4c0b1fbbaa4e9aa6f742a2d14c69369  gcc/testsuite/ada/acats-4/tests/cxa/cxaib03.a
! 07ea23f455e26fd092cf9dafc3bed599  gcc/testsuite/ada/acats-4/tests/cxa/cxaib04.a
! 33e178764707b2930a6a5febe854eddd  gcc/testsuite/ada/acats-4/tests/cxa/cxaib05.a
! 3c506ca5649953b872ae117514a80dd1  gcc/testsuite/ada/acats-4/tests/cxa/cxaib06.a
! 6349b97f920cba44b0a5a7a596f4fb77  gcc/testsuite/ada/acats-4/tests/cxa/cxaib07.a
! 639531fc1d32579d74242bee24d9ffb0  gcc/testsuite/ada/acats-4/tests/cxa/cxaib08.a
! 1ffe4210a7406a1db7528ddd1fb5633d  gcc/testsuite/ada/acats-4/tests/cxa/cxaj001.a
! 74275581d2adcd2434f5e7957524b51c  gcc/testsuite/ada/acats-4/tests/cxb/cxb2001.a
! 801c8a35b2162f9c6264359249bbee69  gcc/testsuite/ada/acats-4/tests/cxb/cxb2002.a
! bf39b2f4f07ed6a4665a9dda2b002ff4  gcc/testsuite/ada/acats-4/tests/cxb/cxb2003.a
! 77c85b698809dbb5fb428e06a404c9b9  gcc/testsuite/ada/acats-4/tests/cxb/cxb3001.a
! 8359205e9055b8be1d9b6762d2ed3539  gcc/testsuite/ada/acats-4/tests/cxb/cxb3002.a
! 670fd9357c7c7cfa50297d22a291bf67  gcc/testsuite/ada/acats-4/tests/cxb/cxb3003.a
! 264fa1c95ae6b3be066613d5e0bfc39d  gcc/testsuite/ada/acats-4/tests/cxb/cxb30040.c
! 834af9fa57783899a0e35eb445000495  gcc/testsuite/ada/acats-4/tests/cxb/cxb30041.am
! 1f7e6c754cd6392302f6a73881265fcb  gcc/testsuite/ada/acats-4/tests/cxb/cxb3005.a
! 47cb358f8b5c39994c472ca6162c0605  gcc/testsuite/ada/acats-4/tests/cxb/cxb30060.c
! 99678670b618e59863715594383e5e7b  gcc/testsuite/ada/acats-4/tests/cxb/cxb30061.am
! 593282429f5462d5ed18dcd8dcdb51d9  gcc/testsuite/ada/acats-4/tests/cxb/cxb3007.a
! f846172da7dd713a885e8d2a7d06687e  gcc/testsuite/ada/acats-4/tests/cxb/cxb3008.a
! d2f1180bb38e13d62efbd9773c8b157b  gcc/testsuite/ada/acats-4/tests/cxb/cxb3009.a
! 02b32c32297cd44b0d911f2b531c9313  gcc/testsuite/ada/acats-4/tests/cxb/cxb3010.a
! f8edfe848dc0c6e6f48662c52fb4967d  gcc/testsuite/ada/acats-4/tests/cxb/cxb3011.a
! db1e20e804e48dbfe6be7dc72d92df77  gcc/testsuite/ada/acats-4/tests/cxb/cxb3012.a
! c26417c84de8dd0b5f98086031028262  gcc/testsuite/ada/acats-4/tests/cxb/cxb30130.c
! 0fb5e5e773d77b07187a80ff9a521df6  gcc/testsuite/ada/acats-4/tests/cxb/cxb30131.c
! f10ef865b96ee70575c8e209dd789a5d  gcc/testsuite/ada/acats-4/tests/cxb/cxb30132.am
! 1ddc4dd51346e5a28f96af27d7391476  gcc/testsuite/ada/acats-4/tests/cxb/cxb3014.a
! 95d8e46749c34da8a75a52eda38a1557  gcc/testsuite/ada/acats-4/tests/cxb/cxb3015.a
! 84585e09a73118e308ad940e05334954  gcc/testsuite/ada/acats-4/tests/cxb/cxb3016.a
! c90918450e648f7980e92c59c3503e79  gcc/testsuite/ada/acats-4/tests/cxb/cxb30170.c
! ea3b3c13a8bde93929e2fbaa2ee14049  gcc/testsuite/ada/acats-4/tests/cxb/cxb30171.a
! 0a60e22dbf627ad27674cdb4536971e5  gcc/testsuite/ada/acats-4/tests/cxb/cxb30172.am
! 9bd340b5234a535ac39825c942eab7d3  gcc/testsuite/ada/acats-4/tests/cxb/cxb30180.c
! 482289b47ecc3b4f419e23b04a0877fa  gcc/testsuite/ada/acats-4/tests/cxb/cxb30181.a
! 96816beab90a78445ebd1acb2256400e  gcc/testsuite/ada/acats-4/tests/cxb/cxb30182.am
! a3d2accddecb5d2648c27c4bd7980870  gcc/testsuite/ada/acats-4/tests/cxb/cxb3019.a
! 2d9cdb1ab7f830bca716d071688a6756  gcc/testsuite/ada/acats-4/tests/cxb/cxb3020.a
! ce83dd773ce8b02e32354f3dac59a626  gcc/testsuite/ada/acats-4/tests/cxb/cxb3021.a
! 126bcf8c4cc1d9cf1e0ce07f7371e294  gcc/testsuite/ada/acats-4/tests/cxb/cxb3022.a
! 24721abe35ae24f15b7aad5d08e6fd32  gcc/testsuite/ada/acats-4/tests/cxb/cxb30230.c
! d2017af833f745dbc8efda20765b9def  gcc/testsuite/ada/acats-4/tests/cxb/cxb30231.am
! f39a0c06d8ff233dacf6f158308a6b77  gcc/testsuite/ada/acats-4/tests/cxb/cxb30240.c
! e8c9be3056a762cf4002418418be1ab2  gcc/testsuite/ada/acats-4/tests/cxb/cxb30241.am
! cbb79c5b42e78b77403051dad62e4b41  gcc/testsuite/ada/acats-4/tests/cxb/cxb4001.a
! fc709f860964cb89f985c7186e9f4747  gcc/testsuite/ada/acats-4/tests/cxb/cxb4002.a
! 4f684915a0877f5374cf11b630a78395  gcc/testsuite/ada/acats-4/tests/cxb/cxb4003.a
! 79754fe98b14164c0947685d39cacbb4  gcc/testsuite/ada/acats-4/tests/cxb/cxb4004.a
! 85a2ebed857909a39d337814747d6b8e  gcc/testsuite/ada/acats-4/tests/cxb/cxb4005.a
! 4082371e3fdf72189f00c59a748996d4  gcc/testsuite/ada/acats-4/tests/cxb/cxb4006.a
! 27abdc5551e4a8d82b4e9b0c64e5887b  gcc/testsuite/ada/acats-4/tests/cxb/cxb4007.a
! 8cddd50c9a17f7fc8660e979cbf02b3b  gcc/testsuite/ada/acats-4/tests/cxb/cxb4008.a
! 1b69eacf17c1c91c6952280f3412de5a  gcc/testsuite/ada/acats-4/tests/cxb/cxb5001.a
! c09620903bb91a1bb4eb42d58e681d41  gcc/testsuite/ada/acats-4/tests/cxb/cxb5002.a
! d523751f359c8b2cd39c46362a810f62  gcc/testsuite/ada/acats-4/tests/cxb/cxb5003.a
! 161785b3f8117f52fdfa5e2be103fe50  gcc/testsuite/ada/acats-4/tests/cxf/cxf1001.a
! 38832640106024eeab3e787b3e1abf12  gcc/testsuite/ada/acats-4/tests/cxf/cxf2001.a
! 6dbe0dc7ad8bcf924dea296b0e6d64f8  gcc/testsuite/ada/acats-4/tests/cxf/cxf2002.a
! df30106f75773ccdd081af9128456937  gcc/testsuite/ada/acats-4/tests/cxf/cxf2003.a
! bbdc713b858e164ba488b05b51a426d4  gcc/testsuite/ada/acats-4/tests/cxf/cxf2004.a
! 2853070456ab778051ae45509ef31700  gcc/testsuite/ada/acats-4/tests/cxf/cxf2005.a
! 5289a83b801532cadb9cfc8ca574144c  gcc/testsuite/ada/acats-4/tests/cxf/cxf2a01.a
! ecb6f7270417d94e1c9636302e69e1fa  gcc/testsuite/ada/acats-4/tests/cxf/cxf2a02.a
! 2ffc00ccfb476a6822050bacce9f38f0  gcc/testsuite/ada/acats-4/tests/cxf/cxf3001.a
! 5dae288354cb87431755a88817dd365b  gcc/testsuite/ada/acats-4/tests/cxf/cxf3002.a
! afd49d16a5d04aec633505dca48b0d0a  gcc/testsuite/ada/acats-4/tests/cxf/cxf3003.a
! c6b3622a1e5b20d69719852a4082e8be  gcc/testsuite/ada/acats-4/tests/cxf/cxf3004.a
! 1aee0d4b0a06b7063d6235fc8d34096a  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a01.a
! 57064f6f477f169e4e55de947a9c929c  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a02.a
! 963266d142d788cf27f6a6c25463a3e4  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a03.a
! b0edb7a9a3f96101a217a11d890227d0  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a04.a
! fc92aa9ac0df0e5baa30ead02d831b57  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a05.a
! 64a24769c1369c7cfdee0cd6e259be8f  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a06.a
! 9713b92f0463d1404ffce0f6b1e500b0  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a07.a
! 1e8c052576f82ce44e874eaf39b880b2  gcc/testsuite/ada/acats-4/tests/cxf/cxf3a08.a
! bb528e8b6f5a51fcb2c85de76f01ccd4  gcc/testsuite/ada/acats-4/tests/cxg/cxg1001.a
! 31d84efce5cb86f288a534683e15200a  gcc/testsuite/ada/acats-4/tests/cxg/cxg1002.a
! 5db4d9e6a4cf0ee61e3e4e4ea8093c4e  gcc/testsuite/ada/acats-4/tests/cxg/cxg1003.a
! 29704ab7c7c7a79f47511599cd5ea610  gcc/testsuite/ada/acats-4/tests/cxg/cxg1004.a
! 38c19bd2b8b49892b5a8468c5b781d26  gcc/testsuite/ada/acats-4/tests/cxg/cxg1005.a
! cf1886805bf7bef0f8693b1061462c39  gcc/testsuite/ada/acats-4/tests/cxg/cxg2001.a
! 691b89d2d22e78fce3d8ce8190aceac5  gcc/testsuite/ada/acats-4/tests/cxg/cxg2002.a
! fd15930c996abc004ebe5f623f8d7e3e  gcc/testsuite/ada/acats-4/tests/cxg/cxg2003.a
! 9c7ebf167f5adb4ad817f1cfaad15b1e  gcc/testsuite/ada/acats-4/tests/cxg/cxg2004.a
! 19538696a45a5cd61915e552c0159e21  gcc/testsuite/ada/acats-4/tests/cxg/cxg2005.a
! b5a9cd918ec505f80bffd4b8d3f81fb7  gcc/testsuite/ada/acats-4/tests/cxg/cxg2006.a
! d118b202244475fa2d6637a5102c8793  gcc/testsuite/ada/acats-4/tests/cxg/cxg2007.a
! 911e82a1ca3377a813732860a0062312  gcc/testsuite/ada/acats-4/tests/cxg/cxg2008.a
! 4fad0b52dda14d215336cc1cd38b7f03  gcc/testsuite/ada/acats-4/tests/cxg/cxg2009.a
! a7f0790bd1f4db62bb1f94f90b403cca  gcc/testsuite/ada/acats-4/tests/cxg/cxg2010.a
! 2e25178ea5e5552c5343ba6d8584ba74  gcc/testsuite/ada/acats-4/tests/cxg/cxg2011.a
! f61b0c35864b0aa5527d3e4a3e81e779  gcc/testsuite/ada/acats-4/tests/cxg/cxg2012.a
! 1b99769a37ef9c2b58f43910fdd00e6b  gcc/testsuite/ada/acats-4/tests/cxg/cxg2013.a
! 481025f4913d9ffb0c1ff442b9870591  gcc/testsuite/ada/acats-4/tests/cxg/cxg2014.a
! 79eb7ca23122446b9f31a5f4d6f8fbc7  gcc/testsuite/ada/acats-4/tests/cxg/cxg2015.a
! d1362a6e008edbda6db26e148303f3d0  gcc/testsuite/ada/acats-4/tests/cxg/cxg2016.a
! 84a228b85aa2b3a442a702cb5cf99e63  gcc/testsuite/ada/acats-4/tests/cxg/cxg2017.a
! db5d4af0d0f84dcaf031081f41020e4a  gcc/testsuite/ada/acats-4/tests/cxg/cxg2018.a
! 6ca3da628f7936107fe1fd235da62e61  gcc/testsuite/ada/acats-4/tests/cxg/cxg2019.a
! d8efe67bfdf82292c98f593e60cace57  gcc/testsuite/ada/acats-4/tests/cxg/cxg2020.a
! 53b94c96558a199ee91e9e94e92f6e6e  gcc/testsuite/ada/acats-4/tests/cxg/cxg2021.a
! 44df5fa53bb68ac9be22c5db9adb9c5e  gcc/testsuite/ada/acats-4/tests/cxg/cxg2022.a
! 86432328beb230d12c30455a5259108f  gcc/testsuite/ada/acats-4/tests/cxg/cxg2023.a
! 7b9353c95978924cfa8ffca95bd2472f  gcc/testsuite/ada/acats-4/tests/cxg/cxg2024.a
! 4aedd99c5e7383826785e110132437b0  gcc/testsuite/ada/acats-4/tests/cxh/cxh3001.a
! 30e3860e9003591085363de238d2c0f8  gcc/testsuite/ada/acats-4/tests/cxh/cxh3002.a
! 2f97ad7e05c98ee16642183b60fb702b  gcc/testsuite/ada/acats-4/tests/cxh/cxh30030.a
! 726c3a5559867c336b3e41053357bee8  gcc/testsuite/ada/acats-4/tests/cxh/cxh30031.am
! 5812c7613bb171e922984de8ed304306  gcc/testsuite/ada/acats-4/tests/cz/cz1101a.ada
! f4be18c06fbff775151b0c6fe4f18831  gcc/testsuite/ada/acats-4/tests/cz/cz1102a.ada
! 1a17d44787330941af6e6eb9b2f5fdac  gcc/testsuite/ada/acats-4/tests/cz/cz1103a.ada
! 4fbac816abd03239d980e03cee911122  gcc/testsuite/ada/acats-4/tests/d/d4a002a.ada
! 9fc88c362bc5e3ac1038838ce2e31e1d  gcc/testsuite/ada/acats-4/tests/d/d4a002b.ada
! 512d36027df5b67cad136178dabfe4a2  gcc/testsuite/ada/acats-4/tests/d/d4a004a.ada
! 22af18afdcf3a383d8100e7290a1c40c  gcc/testsuite/ada/acats-4/tests/d/d4a004b.ada
! 605dc6f15a51dd750ab6fdf7ddcb65a6  gcc/testsuite/ada/acats-4/tests/e/e28002b.ada
! de9f0ecd5c9bafad769c8b2264e38499  gcc/testsuite/ada/acats-4/tests/e/e28005d.ada
! 3cacc87e4376898f97bc3ad35305e3b0  gcc/testsuite/ada/acats-4/tests/e/e52103y.ada
! c92c30f9076000218a22d41126403c34  gcc/testsuite/ada/acats-4/tests/e/eb4011a.ada
! deba1575fb8b252064041e5d408f53a3  gcc/testsuite/ada/acats-4/tests/e/eb4012a.ada
! 08131f4b11da03c32ca002338f3e4a59  gcc/testsuite/ada/acats-4/tests/e/eb4014a.ada
! b8a8e5440cbe69d0ad54064892a114c0  gcc/testsuite/ada/acats-4/tests/e/ee3203a.ada
! 48040471bf50b07840b3338c9bc7e2c6  gcc/testsuite/ada/acats-4/tests/e/ee3204a.ada
! 25bff343477de94bd78239442f9ee02a  gcc/testsuite/ada/acats-4/tests/e/ee3402b.ada
! b057daa29f3fcc66f6affebff75a1be5  gcc/testsuite/ada/acats-4/tests/e/ee3409f.ada
! 4c52e7caa9bc136f2cba824b2e52e9c6  gcc/testsuite/ada/acats-4/tests/e/ee3412c.ada
! 76344ab690464f293f3d4ea9ddafa233  gcc/testsuite/ada/acats-4/tests/l/la140010.a
! 2900850ee7d28fb09a708d15ecb120e8  gcc/testsuite/ada/acats-4/tests/l/la140011.am
! 3a566254bd6b5a2476b7a0a4d201c6ec  gcc/testsuite/ada/acats-4/tests/l/la140012.a
! f251861d8f7143c4d6a0139eb5109844  gcc/testsuite/ada/acats-4/tests/l/la140020.a
! 94e3a842d07a1b065bf9729ba53ec9fd  gcc/testsuite/ada/acats-4/tests/l/la140021.am
! 951f84109a5b6658e7dd287bbd9bae71  gcc/testsuite/ada/acats-4/tests/l/la140022.a
! 876db830d93e5c9744a1c290ed00f17f  gcc/testsuite/ada/acats-4/tests/l/la140030.a
! eaefd12663189709da8ccf17c2c368fa  gcc/testsuite/ada/acats-4/tests/l/la140031.a
! 7bf8660d1ec101205c05dd17726a229a  gcc/testsuite/ada/acats-4/tests/l/la140032.am
! 857f64e53ab5de64c7aff62222d11127  gcc/testsuite/ada/acats-4/tests/l/la140033.a
! 92ca699ccd2c74842385086d5ada22dd  gcc/testsuite/ada/acats-4/tests/l/la140040.a
! 8b2c5cc4a29ad35fcfa826d7b492bc08  gcc/testsuite/ada/acats-4/tests/l/la140041.am
! fb8dd82cf673301eecabc122ac171090  gcc/testsuite/ada/acats-4/tests/l/la140042.a
! 6d5ee36b10609c888874ac66e3f0ee1e  gcc/testsuite/ada/acats-4/tests/l/la140050.a
! e04923836f3f4282a67d6f89778a6914  gcc/testsuite/ada/acats-4/tests/l/la140051.a
! bfa5a2187576b86f14423c0040742843  gcc/testsuite/ada/acats-4/tests/l/la140052.am
! 0d6624b67d8552559b64873f684e581d  gcc/testsuite/ada/acats-4/tests/l/la140053.a
! 8035d0c6bfa2f3b3a49f58acd52dd8a7  gcc/testsuite/ada/acats-4/tests/l/la140060.a
! 3d90461eff6991fd8178d6d2118e9ddf  gcc/testsuite/ada/acats-4/tests/l/la140061.a
! e475cc528675aeae58edde764f9dd718  gcc/testsuite/ada/acats-4/tests/l/la140062.am
! f022f8aa1d30fb70ecca6f610089b986  gcc/testsuite/ada/acats-4/tests/l/la140063.a
! c3833b353f97382d992824760c162c7c  gcc/testsuite/ada/acats-4/tests/l/la140070.a
! c0ccfb9014a2864c4a49d88f46f491c1  gcc/testsuite/ada/acats-4/tests/l/la140071.a
! 509bb3bfec998a7f16d7a711f508bdc0  gcc/testsuite/ada/acats-4/tests/l/la140072.am
! 4710fc41166460cc60192a57798054b4  gcc/testsuite/ada/acats-4/tests/l/la140073.a
! dcb4f9c9fdad375c3fe93310ac6b816e  gcc/testsuite/ada/acats-4/tests/l/la140080.a
! a3acb845f1ea8cd193aec71beb1ead51  gcc/testsuite/ada/acats-4/tests/l/la140081.a
! d8f09cb05605e6ee39a41685ba970092  gcc/testsuite/ada/acats-4/tests/l/la140082.am
! 6d37a12249cd1b2bdf860f7651a462e4  gcc/testsuite/ada/acats-4/tests/l/la140083.a
! 46655b2b4b88ca82cb0afc6eac22cd7b  gcc/testsuite/ada/acats-4/tests/l/la140090.a
! 257622cc1c6c259921d7e6c33e23f1ff  gcc/testsuite/ada/acats-4/tests/l/la140091.a
! 1c00169793ce024a3f35da791e30bbe6  gcc/testsuite/ada/acats-4/tests/l/la140092.am
! 6a23c4b62a4cac8720e8b7c21ad97d5b  gcc/testsuite/ada/acats-4/tests/l/la140093.a
! ed2026e1ace460e994b96b42c8f05e9c  gcc/testsuite/ada/acats-4/tests/l/la140100.a
! 55167329c290c62025473120fca26c7d  gcc/testsuite/ada/acats-4/tests/l/la140101.a
! 9280256db41c4bec0f36aa69ff060841  gcc/testsuite/ada/acats-4/tests/l/la140102.am
! 7b092247e539009157e512965ba1fc7a  gcc/testsuite/ada/acats-4/tests/l/la140103.a
! 6722c5fc30bb307834268e434901c086  gcc/testsuite/ada/acats-4/tests/l/la140110.a
! 443c0bb26e2eb84889c83a9bccaf9649  gcc/testsuite/ada/acats-4/tests/l/la140111.a
! 47c6e7a9da351969b20b3d295bb3c115  gcc/testsuite/ada/acats-4/tests/l/la140112.am
! 4bf0921f6ccd99db94a8a70d2b166fdf  gcc/testsuite/ada/acats-4/tests/l/la140113.a
! 5c9a0f9992d6d21844e2ba208b7cebbc  gcc/testsuite/ada/acats-4/tests/l/la140120.a
! 7c0ca86bca64632e57e32b5842ddbe60  gcc/testsuite/ada/acats-4/tests/l/la140121.a
! 211c1d44471b6a40c3d807f83059ff77  gcc/testsuite/ada/acats-4/tests/l/la140122.am
! e4cb364e594a0d2463e66f4aa48a914a  gcc/testsuite/ada/acats-4/tests/l/la140123.a
! 76516f31e5adf9e0fad1886ab83457a4  gcc/testsuite/ada/acats-4/tests/l/la140130.a
! f3b7f597165821e514288274845f5e54  gcc/testsuite/ada/acats-4/tests/l/la140131.a
! cb0819afcaf9586c9c95966d2516fb65  gcc/testsuite/ada/acats-4/tests/l/la140132.am
! 32a943ea5a9287c709fa39655d8668cb  gcc/testsuite/ada/acats-4/tests/l/la140133.a
! 212943c674757076da046354450e5113  gcc/testsuite/ada/acats-4/tests/l/la140140.a
! 195b91195befb872c8f723da1d28f132  gcc/testsuite/ada/acats-4/tests/l/la140141.a
! a6d2954f197001069fb371e8403e8ac6  gcc/testsuite/ada/acats-4/tests/l/la140142.am
! 57ac76011ccf9054712e1b09ef71bfd9  gcc/testsuite/ada/acats-4/tests/l/la140143.a
! 7552c854bb4af3c4f87cfe6a7a861610  gcc/testsuite/ada/acats-4/tests/l/la140150.a
! 5f1dcc1a1c97c253b5809c49c2a326ad  gcc/testsuite/ada/acats-4/tests/l/la140151.a
! 662ea838e79bbec83ab42275c2111e2a  gcc/testsuite/ada/acats-4/tests/l/la140152.am
! c80afc3e35ad24a8bb25b5e3d67f2bcb  gcc/testsuite/ada/acats-4/tests/l/la140153.a
! ebc4ad53e17e21942e69ae80c5b47b77  gcc/testsuite/ada/acats-4/tests/l/la140160.a
! 117e1792c17a1e2b5ec04bba346f528d  gcc/testsuite/ada/acats-4/tests/l/la140161.a
! b7744773a1c753b7aa68c166866eb005  gcc/testsuite/ada/acats-4/tests/l/la140162.am
! 9852ca8047bc9e1bd578767b67254fd2  gcc/testsuite/ada/acats-4/tests/l/la140163.a
! f7f66fd9abfb1f4931428292cd1fe63d  gcc/testsuite/ada/acats-4/tests/l/la140170.a
! 2acaa1d866103405c81e05839bd25054  gcc/testsuite/ada/acats-4/tests/l/la140171.a
! ea5de64993880be50e047e540f521cec  gcc/testsuite/ada/acats-4/tests/l/la140172.am
! b3e16fff4bf97ee8001c7d4707b01ca8  gcc/testsuite/ada/acats-4/tests/l/la140173.a
! cef0b6dba566de9e4b3fdd8429f3b573  gcc/testsuite/ada/acats-4/tests/l/la140180.a
! 3a47eaaf81a03727243aa228f4301a60  gcc/testsuite/ada/acats-4/tests/l/la140181.a
! a5c23800bfa114aaa25ef21241ca0c43  gcc/testsuite/ada/acats-4/tests/l/la140182.am
! 831069dc37bbaa6d17e49ec411324925  gcc/testsuite/ada/acats-4/tests/l/la140183.a
! 9597131b3c0b103f6244907627fbf160  gcc/testsuite/ada/acats-4/tests/l/la140190.a
! 14063c6684e8dd6c14ea4d18badb550b  gcc/testsuite/ada/acats-4/tests/l/la140191.a
! 8cbcf00024bdf7530ae51ba8a1ca0bba  gcc/testsuite/ada/acats-4/tests/l/la140192.am
! 99e2d79f6f50d594ab2f3e503f2db441  gcc/testsuite/ada/acats-4/tests/l/la140193.a
! ea6d1fb3bdbfc0deaee617b126be28f4  gcc/testsuite/ada/acats-4/tests/l/la140200.a
! babcd4715ea4f023430dfbe1f896bde1  gcc/testsuite/ada/acats-4/tests/l/la140201.a
! 64279761de38aa82af4a5638c457c1bf  gcc/testsuite/ada/acats-4/tests/l/la140202.am
! 7e4b83d0d9265f463e87dcc9fcf0fe5b  gcc/testsuite/ada/acats-4/tests/l/la140203.a
! b12cced7adaecf2a93250e16cca98cf4  gcc/testsuite/ada/acats-4/tests/l/la140210.a
! 887401b5f446bce786751fa72e341292  gcc/testsuite/ada/acats-4/tests/l/la140211.am
! ab173d0eec0bb616f34f81aa48cd950c  gcc/testsuite/ada/acats-4/tests/l/la140212.a
! 594b0e8144190e578786dbc1bad844dc  gcc/testsuite/ada/acats-4/tests/l/la140220.a
! f842b35f8c01816efc84f4addd2f93b7  gcc/testsuite/ada/acats-4/tests/l/la140221.am
! 772553907cc4b151574b52a2b52dc90c  gcc/testsuite/ada/acats-4/tests/l/la140222.a
! b03871ce6d6f59a7e5a7612e6d89d596  gcc/testsuite/ada/acats-4/tests/l/la140240.a
! efe4e86bfb690c79c68494f323cac801  gcc/testsuite/ada/acats-4/tests/l/la140241.a
! 30f55b3747e6fa1b9ef0af765a76ce5a  gcc/testsuite/ada/acats-4/tests/l/la140242.am
! f95f7a3f483abd92a9bf92b6dc469986  gcc/testsuite/ada/acats-4/tests/l/la140243.a
! 2db8317b47f3ab8bb9a0f5469169d027  gcc/testsuite/ada/acats-4/tests/l/la140250.a
! 938965a24a1e6eb44e817ef6a6bcef36  gcc/testsuite/ada/acats-4/tests/l/la140251.am
! b3d2bc446e9f8766852585be1a71c541  gcc/testsuite/ada/acats-4/tests/l/la140252.a
! ced69a105f582142776937381fb4ac18  gcc/testsuite/ada/acats-4/tests/l/la140260.a
! ff927baa2a1a94e581616deb8f88d900  gcc/testsuite/ada/acats-4/tests/l/la140261.a
! 666740bbcb573799ed4bbd92b8380bac  gcc/testsuite/ada/acats-4/tests/l/la140262.am
! 2a7b7e46c9fcf98d59cf645dd8488895  gcc/testsuite/ada/acats-4/tests/l/la140263.a
! b886a43ab960ee3b74b75b1a1895e692  gcc/testsuite/ada/acats-4/tests/l/la140270.a
! 2f50ecd2b64eb3a3cefb0066c4c043a1  gcc/testsuite/ada/acats-4/tests/l/la140271.a
! 004386b31584ba3e3f7171f7674e4137  gcc/testsuite/ada/acats-4/tests/l/la140272.am
! 9c63871113de9b518e90c90fe8e20f28  gcc/testsuite/ada/acats-4/tests/l/la140273.a
  25005a9265a333af56789fab16cd8e0e  gcc/testsuite/c-c++-common/Waddress-1.c
  81e4d27a297a7ce6fddf1ac2a8961317  gcc/testsuite/c-c++-common/Waddress-2.c
  ae85096226db49d6155303ac5a238c4f  gcc/testsuite/c-c++-common/Waddress-3.c
*************** af5c71db79db8bbfa151cc192fcfe969  gcc/te
*** 11508,11514 ****
  7f1d10f463b230c4126bf563ca4ecddf  gcc/testsuite/c-c++-common/analyzer/fd-3.c
  50636a97d77b8f9987955e13d490394f  gcc/testsuite/c-c++-common/analyzer/fd-bind-pr107928.c
  2b4e89d6bd86a237296bded464000d70  gcc/testsuite/c-c++-common/analyzer/fd-connect-pr107928.c
! 534ed48a7f159a75a800726d25332803  gcc/testsuite/c-c++-common/analyzer/fd-glibc-byte-stream-socket.c
  70e664750b86ed718173136aa56f69be  gcc/testsuite/c-c++-common/analyzer/fd-manpage-getaddrinfo-client.c
  2a7d531dc598fbf61e8ce805609bcc58  gcc/testsuite/c-c++-common/analyzer/fd-manpage-getaddrinfo-server.c
  e97f066eb1df45c004940dd4bf4a5e8c  gcc/testsuite/c-c++-common/analyzer/fd-meaning.c
--- 17153,17159 ----
  7f1d10f463b230c4126bf563ca4ecddf  gcc/testsuite/c-c++-common/analyzer/fd-3.c
  50636a97d77b8f9987955e13d490394f  gcc/testsuite/c-c++-common/analyzer/fd-bind-pr107928.c
  2b4e89d6bd86a237296bded464000d70  gcc/testsuite/c-c++-common/analyzer/fd-connect-pr107928.c
! 436363dbb083389657570da88ba2cdec  gcc/testsuite/c-c++-common/analyzer/fd-glibc-byte-stream-socket.c
  70e664750b86ed718173136aa56f69be  gcc/testsuite/c-c++-common/analyzer/fd-manpage-getaddrinfo-client.c
  2a7d531dc598fbf61e8ce805609bcc58  gcc/testsuite/c-c++-common/analyzer/fd-manpage-getaddrinfo-server.c
  e97f066eb1df45c004940dd4bf4a5e8c  gcc/testsuite/c-c++-common/analyzer/fd-meaning.c
*************** e42278d4075df8df53e7bdf029fb1b32  gcc/te
*** 11886,11892 ****
  5692f39f9e1eb1d0bffdef5855475c4a  gcc/testsuite/c-c++-common/analyzer/strtok-2.c
  3860c30809fa4f2be07b2f54d0307dea  gcc/testsuite/c-c++-common/analyzer/strtok-3.c
  de1b4a3676e13702041a225852147f89  gcc/testsuite/c-c++-common/analyzer/strtok-4.c
! 78e0479f0949ec5e1ab354025c965109  gcc/testsuite/c-c++-common/analyzer/strtok-cppreference.c
  0198fd684e224cad3647e799760aecc9  gcc/testsuite/c-c++-common/analyzer/switch-enum-pr105273-git-vreportf-2.c
  b76cb1d27db82d1b655fd7715d3a8b9a  gcc/testsuite/c-c++-common/analyzer/switch-wrong-enum.c
  d36f5325a7e5fa9b8ac849be4b6b9226  gcc/testsuite/c-c++-common/analyzer/symbolic-1.c
--- 17531,17537 ----
  5692f39f9e1eb1d0bffdef5855475c4a  gcc/testsuite/c-c++-common/analyzer/strtok-2.c
  3860c30809fa4f2be07b2f54d0307dea  gcc/testsuite/c-c++-common/analyzer/strtok-3.c
  de1b4a3676e13702041a225852147f89  gcc/testsuite/c-c++-common/analyzer/strtok-4.c
! 16d1945e649c7966bf950d04c044e932  gcc/testsuite/c-c++-common/analyzer/strtok-cppreference.c
  0198fd684e224cad3647e799760aecc9  gcc/testsuite/c-c++-common/analyzer/switch-enum-pr105273-git-vreportf-2.c
  b76cb1d27db82d1b655fd7715d3a8b9a  gcc/testsuite/c-c++-common/analyzer/switch-wrong-enum.c
  d36f5325a7e5fa9b8ac849be4b6b9226  gcc/testsuite/c-c++-common/analyzer/symbolic-1.c
*************** ffdb3a28cbf8051dd2ad3d9d4cc9b068  gcc/te
*** 14657,14662 ****
--- 20302,20309 ----
  1575a07d330f581a46e89cdf8fdc04a7  gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob
  c1ff3f157967069935826b9d9be10055  gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob
  1fbecd756e0491800acc29e54bb4740a  gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob
+ 19516cce0fbf1cc247002d9d7b7ca4b4  gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT__2_.cob
+ cd74df35f207526ac9b3e80b12374d94  gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT__2_.out
  ef4ef5dd7192b580f10056381fb739fa  gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob
  f9b9b58c1d970e5ac3ea46939698c0f6  gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob
  9a30d9649e24eb08874d9513d62dae9c  gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob
*************** d94eaf98fb64f996342be49a4c220def  gcc/te
*** 16173,16179 ****
  d1a28daa3c4755a0f709ca07f8c48994  gcc/testsuite/g++.dg/coroutines/pr115858.C
  8496292f23f33e07ff0fe7b9e8f1eb91  gcc/testsuite/g++.dg/coroutines/pr115906-yield.C
  9514f224b21eb90bcef5ab37ae609a92  gcc/testsuite/g++.dg/coroutines/pr115906.C
! b23bcd7c0e520fe5a372838baf5a4e22  gcc/testsuite/g++.dg/coroutines/pr115908.C
  b75b654187426934820f1e2a8a63aaad  gcc/testsuite/g++.dg/coroutines/pr116327-preview-this.C
  36259c7c65f78b7358d2efa4fb0a9e54  gcc/testsuite/g++.dg/coroutines/pr116482.C
  808c70848e15a3d82e09b131dabb149b  gcc/testsuite/g++.dg/coroutines/pr116502.C
--- 21820,21826 ----
  d1a28daa3c4755a0f709ca07f8c48994  gcc/testsuite/g++.dg/coroutines/pr115858.C
  8496292f23f33e07ff0fe7b9e8f1eb91  gcc/testsuite/g++.dg/coroutines/pr115906-yield.C
  9514f224b21eb90bcef5ab37ae609a92  gcc/testsuite/g++.dg/coroutines/pr115906.C
! 01c2de3b3768a7f47dcc1b1c38515ee9  gcc/testsuite/g++.dg/coroutines/pr115908.C
  b75b654187426934820f1e2a8a63aaad  gcc/testsuite/g++.dg/coroutines/pr116327-preview-this.C
  36259c7c65f78b7358d2efa4fb0a9e54  gcc/testsuite/g++.dg/coroutines/pr116482.C
  808c70848e15a3d82e09b131dabb149b  gcc/testsuite/g++.dg/coroutines/pr116502.C
*************** ab314765ac0eb201bb3e11222207ee40  gcc/te
*** 16353,16358 ****
--- 22000,22006 ----
  25fa35420b604bea9857061f35656b5b  gcc/testsuite/g++.dg/coroutines/torture/pr113773.C
  90760c8a1f8f820b4edb0f623596ca78  gcc/testsuite/g++.dg/coroutines/torture/pr115905.C
  980fc5bc26d63a8dc9bc8ac151650f40  gcc/testsuite/g++.dg/coroutines/torture/pr118874.C
+ f5e05a528274f5ccbd128504d532f540  gcc/testsuite/g++.dg/coroutines/torture/pr119916.C
  33c54ba08ef1e709e2fb67d90cc048b4  gcc/testsuite/g++.dg/coroutines/torture/pr92933.C
  56811f88338809bbea0a94b564f9b4da  gcc/testsuite/g++.dg/coroutines/torture/pr95003.C
  2248a954a08f9c689c19929abad2771e  gcc/testsuite/g++.dg/coroutines/torture/pr95519-00-return_void.C
*************** f0b8bd59fbe4178958a8d3d093454011  gcc/te
*** 16370,16377 ****
  fbd5b9659b98a2782504a53f6a2ed13a  gcc/testsuite/g++.dg/coroutines/torture/pr95615-05.C
  bc3eb934e3efbca87efc62810de25ebb  gcc/testsuite/g++.dg/coroutines/torture/pr95615.inc
  0c46a0da3de6e20a370e03838d0a76dd  gcc/testsuite/g++.dg/coroutines/torture/pr98704.C
! 268d67ce285ba96b8d0e8cf7ce79a0c6  gcc/testsuite/g++.dg/coroutines/torture/special-termination-00-sync-completion.C
! 769f8ad9c6a37192347486ae52ba1f81  gcc/testsuite/g++.dg/coroutines/torture/special-termination-01-self-destruct.C
  074cd02b7474e8119248041c10f08ad3  gcc/testsuite/g++.dg/cpp/_Pragma1.C
  8ce78309bd631829da82f2798d24d628  gcc/testsuite/g++.dg/cpp/c++98-pedantic.C
  731959b0908b124d4eee4dab104d68bb  gcc/testsuite/g++.dg/cpp/c++98.C
--- 22018,22025 ----
  fbd5b9659b98a2782504a53f6a2ed13a  gcc/testsuite/g++.dg/coroutines/torture/pr95615-05.C
  bc3eb934e3efbca87efc62810de25ebb  gcc/testsuite/g++.dg/coroutines/torture/pr95615.inc
  0c46a0da3de6e20a370e03838d0a76dd  gcc/testsuite/g++.dg/coroutines/torture/pr98704.C
! 5e7bca6d14a61fe329d1a4e54dd0d041  gcc/testsuite/g++.dg/coroutines/torture/special-termination-00-sync-completion.C
! 729d7261244a4b93f8caf0dadbea7c82  gcc/testsuite/g++.dg/coroutines/torture/special-termination-01-self-destruct.C
  074cd02b7474e8119248041c10f08ad3  gcc/testsuite/g++.dg/cpp/_Pragma1.C
  8ce78309bd631829da82f2798d24d628  gcc/testsuite/g++.dg/cpp/c++98-pedantic.C
  731959b0908b124d4eee4dab104d68bb  gcc/testsuite/g++.dg/cpp/c++98.C
*************** eb8df2f4b1148c5f6b77553d91cb7877  gcc/te
*** 22521,22528 ****
  1f426b6d87ce5765a45728a91f7e3337  gcc/testsuite/g++.dg/debug/dwarf2/pr91887.C
  e03d4790a0350f655bfc579c2cf31194  gcc/testsuite/g++.dg/debug/dwarf2/ptrdmem-1.C
  5d8f03fa19703b37b960eccf4cdd64b6  gcc/testsuite/g++.dg/debug/dwarf2/pubnames-1.C
! a5ad6fdca07e4d5484e1379f8d2daacf  gcc/testsuite/g++.dg/debug/dwarf2/pubnames-2.C
! d90662a62b1701ab0a39b3a98b607032  gcc/testsuite/g++.dg/debug/dwarf2/pubnames-3.C
  5ee5136319eb2e380c30aea5cdd61634  gcc/testsuite/g++.dg/debug/dwarf2/redeclaration-1.C
  2059d1611fd4125683228bd68f4312ee  gcc/testsuite/g++.dg/debug/dwarf2/ref-1.C
  49f64e5b9319be6e42ee1b9a13b65e96  gcc/testsuite/g++.dg/debug/dwarf2/ref-2.C
--- 28169,28176 ----
  1f426b6d87ce5765a45728a91f7e3337  gcc/testsuite/g++.dg/debug/dwarf2/pr91887.C
  e03d4790a0350f655bfc579c2cf31194  gcc/testsuite/g++.dg/debug/dwarf2/ptrdmem-1.C
  5d8f03fa19703b37b960eccf4cdd64b6  gcc/testsuite/g++.dg/debug/dwarf2/pubnames-1.C
! e902f0018029c0167563fab26d234177  gcc/testsuite/g++.dg/debug/dwarf2/pubnames-2.C
! ff0aebcb52c9ae98256ea56197eca1f8  gcc/testsuite/g++.dg/debug/dwarf2/pubnames-3.C
  5ee5136319eb2e380c30aea5cdd61634  gcc/testsuite/g++.dg/debug/dwarf2/redeclaration-1.C
  2059d1611fd4125683228bd68f4312ee  gcc/testsuite/g++.dg/debug/dwarf2/ref-1.C
  49f64e5b9319be6e42ee1b9a13b65e96  gcc/testsuite/g++.dg/debug/dwarf2/ref-2.C
*************** c0af73d2336a3d5ad3f8c4248a0a62ed  gcc/te
*** 27149,27154 ****
--- 32797,32807 ----
  76389676e30dfd9baea1facee1c76338  gcc/testsuite/g++.dg/modules/partial-7_a.C
  0e06abecc27bb525f46512eb0f119c6e  gcc/testsuite/g++.dg/modules/partial-7_b.C
  79e8587ffd09f98267eba54d1d413d9a  gcc/testsuite/g++.dg/modules/partial-7_c.C
+ fe7ccce34dadc65594aff021ec664ae4  gcc/testsuite/g++.dg/modules/partial-8.h
+ 39467f571ec5bbc81c77b71f42f191ec  gcc/testsuite/g++.dg/modules/partial-8_a.C
+ a32d654fe66fc0230bf13e1ddae81478  gcc/testsuite/g++.dg/modules/partial-8_b.C
+ 0751a91a52072cd43bdb9e835344b77f  gcc/testsuite/g++.dg/modules/partial-8_c.C
+ a798035816209d2c2e4c846167cb76a7  gcc/testsuite/g++.dg/modules/partial-8_d.C
  91b28374e0dcc1b056ae3f976924d231  gcc/testsuite/g++.dg/modules/permissive-error-1.C
  48bb134ee9b868f8ffdcdf7732bb8fee  gcc/testsuite/g++.dg/modules/permissive-error-2.C
  fbd0b1dab6ed1e2ae131e2b1eb041193  gcc/testsuite/g++.dg/modules/pmf-1.h
*************** d71ad1e42d5edd10bf65dd64c81a4107  gcc/te
*** 27188,27196 ****
  57c308104a9d589b59baa6c5289ef1ae  gcc/testsuite/g++.dg/modules/pr106761_b.C
  ce1fbbd73d685e48bf6b219484083996  gcc/testsuite/g++.dg/modules/pr106820_a.H
  d7c5aacc3100ff130d9b06f0b4d7b551  gcc/testsuite/g++.dg/modules/pr106820_b.C
- 669553f14966298da7253a85823b66a3  gcc/testsuite/g++.dg/modules/pr113292_a.H
- cd5ddb2e4010c4465cfdaa5041aae30c  gcc/testsuite/g++.dg/modules/pr113292_b.C
- bc73258710da8d559003bba31dc77dac  gcc/testsuite/g++.dg/modules/pr113292_c.C
  d6c4487b2cdfe513fca59a9da2b03d10  gcc/testsuite/g++.dg/modules/pr113580_a.C
  2d13920b57e09bfba57cfacc02b5548b  gcc/testsuite/g++.dg/modules/pr113580_b.C
  b0187e4110d3e1feaedea59af55274e1  gcc/testsuite/g++.dg/modules/pr114005_a.C
--- 32841,32846 ----
*************** f730755494afbfe4a14ce1a907fa3f4f  gcc/te
*** 27459,27464 ****
--- 33109,33125 ----
  f16e5ebd7556493c43cc2faf1b348ae3  gcc/testsuite/g++.dg/modules/tinfo-1.C
  e286ace3527b1df8ed834d790b085543  gcc/testsuite/g++.dg/modules/tinfo-2_a.H
  f8f86df19db8e0f5288eeefb3a4debab  gcc/testsuite/g++.dg/modules/tinfo-2_b.C
+ 6cdce161b1c4d89e8a02e0a6bc6674c0  gcc/testsuite/g++.dg/modules/tinfo-3_a.H
+ 75faed4e1faca06628b51e77deed1c0b  gcc/testsuite/g++.dg/modules/tinfo-3_b.C
+ 669553f14966298da7253a85823b66a3  gcc/testsuite/g++.dg/modules/tls-1_a.H
+ 23c0b242d3480243b10f8309697d2f1b  gcc/testsuite/g++.dg/modules/tls-1_b.C
+ 168d59067b8a00836330b8f61d1f87bb  gcc/testsuite/g++.dg/modules/tls-1_c.C
+ ab623d35244df33926d444309262f796  gcc/testsuite/g++.dg/modules/tls-2_a.C
+ 77a05c0cf06ae7c0baa533082013f4ee  gcc/testsuite/g++.dg/modules/tls-2_b.C
+ d81d0d4fd4552a5200910224730bc335  gcc/testsuite/g++.dg/modules/tls-2_c.C
+ b083c8589d0eadb5801ea871caace113  gcc/testsuite/g++.dg/modules/tls-3.h
+ a0787c854f8ee29bf506219f8818c028  gcc/testsuite/g++.dg/modules/tls-3_a.H
+ 6d8bc33c270c159e50c9e3a855c51a94  gcc/testsuite/g++.dg/modules/tls-3_b.C
  a0161e5171615a705e466f33a67e1fea  gcc/testsuite/g++.dg/modules/tmpl-part-req-1.h
  bcb4b8223c944a14f1f870d40de0d7c5  gcc/testsuite/g++.dg/modules/tmpl-part-req-1_a.H
  7b43023b911064f99874c117b3aeac2b  gcc/testsuite/g++.dg/modules/tmpl-part-req-1_b.C
*************** dec77c25254c2de5dab4763d264bd88b  gcc/te
*** 27669,27674 ****
--- 33330,33337 ----
  a6538f381f12a0cd3a9e46e8089d2b15  gcc/testsuite/g++.dg/modules/using-30_a.C
  8ab0f479bce8892363e18d66cc9e7ba3  gcc/testsuite/g++.dg/modules/using-30_b.C
  d2536d9ce980b930e5bd5e99319d1f01  gcc/testsuite/g++.dg/modules/using-30_c.C
+ c42022b1e3d2c0964d349eec1c2253a7  gcc/testsuite/g++.dg/modules/using-31_a.C
+ b9c78848e5510504b2065d85656d575b  gcc/testsuite/g++.dg/modules/using-31_b.C
  bcc6cc64890192d647d85da41996ed1e  gcc/testsuite/g++.dg/modules/using-4_a.C
  f7d6d7386bd922589ea2e579fdd741e5  gcc/testsuite/g++.dg/modules/using-4_b.C
  0650e45892eb431529641f277d164339  gcc/testsuite/g++.dg/modules/using-5_a.C
*************** fb2dff43314c2b3715f353986395f3c8  gcc/te
*** 27722,27727 ****
--- 33385,33392 ----
  61a0de9a0b291c9828e798d288cd1d63  gcc/testsuite/g++.dg/modules/vtt-2.h
  1f7a42538a18498e42ad3605fc45068e  gcc/testsuite/g++.dg/modules/vtt-2_a.H
  b9e6dd7232aadc013278f66fb1b6943a  gcc/testsuite/g++.dg/modules/vtt-2_b.C
+ 274356b5635e24d5fcb22c624bf3780b  gcc/testsuite/g++.dg/modules/vtt-3_a.C
+ e322c3e2e2a5b94fb9e669c285d188b4  gcc/testsuite/g++.dg/modules/vtt-3_b.C
  3d043c63d5084f569e5780ab69b650f2  gcc/testsuite/g++.dg/modules/warn-spec-1_a.C
  770da3c5d8d08b57e3bb7638ced6ddac  gcc/testsuite/g++.dg/modules/warn-spec-1_b.C
  08df26e13ad9bcaf7746d9df14f81fcb  gcc/testsuite/g++.dg/modules/warn-spec-2_a.C
*************** d2e46c2469499fd1b1cb32a384d6bc81  gcc/te
*** 27778,27783 ****
--- 33443,33449 ----
  91fe29b9b1f08a3ca87595896db03497  gcc/testsuite/g++.dg/opt/alias3.C
  d1eee6f7ae11e9a1e85a05197e331926  gcc/testsuite/g++.dg/opt/alias4.C
  8fc3fdde63f5daa22482a16d86de3ee9  gcc/testsuite/g++.dg/opt/always_inline1.C
+ a8cdf3fcce3ac96fddc691b6de1ea61d  gcc/testsuite/g++.dg/opt/always_inline2.C
  76a1ade7c3b02a35300f798365e098d3  gcc/testsuite/g++.dg/opt/anchor1.C
  a20397e7aec19ce67e72ee637a08a416  gcc/testsuite/g++.dg/opt/anonunion1.C
  f5855f61cbf9d400a44f276598a5db21  gcc/testsuite/g++.dg/opt/array1.C
*************** e20f46b6e703ff1284f1cfe79f6c7f15  gcc/te
*** 43609,43614 ****
--- 49275,49281 ----
  727f3fa86769627fd757f9544ec5e9a4  gcc/testsuite/gcc.dg/bitint-97.c
  a22b186996615c2d8eb05ea8bf3fbf0f  gcc/testsuite/gcc.dg/bitint-98.c
  fb2deb63f2c015cb881ba1519e9cf788  gcc/testsuite/gcc.dg/bitint-99.c
+ c5bef339fb8b3eb78a29a8e428bd4afc  gcc/testsuite/gcc.dg/bitintext.h
  6453b594ca416ac818e19554b58e489e  gcc/testsuite/gcc.dg/boolcomplex-1.c
  29dee620c099065fec233358259a8a12  gcc/testsuite/gcc.dg/bss.c
  7cf86654b95ba4af389e830b28a868e1  gcc/testsuite/gcc.dg/builtin-addc-1.c
*************** ddbb4c428a1399bf8a6f61e6246bd347  gcc/te
*** 45543,45549 ****
  ea8e81ccf9b0e8a7d31a02ddf10f3ae7  gcc/testsuite/gcc.dg/cse_recip.c
  dc6685bcab4cd7ed276483fd8d031507  gcc/testsuite/gcc.dg/ctor1.c
  13a7eb422d70031061c88832496b4b3b  gcc/testsuite/gcc.dg/cwsc0.c
! d9dc93acb42ceaf059f158db6f7ea6d2  gcc/testsuite/gcc.dg/cwsc1.c
  fb2cff7f2512c80434d59d702b80e754  gcc/testsuite/gcc.dg/darwin-20040812-1.c
  e3c60516eb9991f352d93d33fde752d3  gcc/testsuite/gcc.dg/darwin-aligned-globals.c
  3010db4d547a5bce8e8559d5cc724330  gcc/testsuite/gcc.dg/darwin-cfstring-1.c
--- 51210,51216 ----
  ea8e81ccf9b0e8a7d31a02ddf10f3ae7  gcc/testsuite/gcc.dg/cse_recip.c
  dc6685bcab4cd7ed276483fd8d031507  gcc/testsuite/gcc.dg/ctor1.c
  13a7eb422d70031061c88832496b4b3b  gcc/testsuite/gcc.dg/cwsc0.c
! c1e612aca82705aa421876a2ea779ffe  gcc/testsuite/gcc.dg/cwsc1.c
  fb2cff7f2512c80434d59d702b80e754  gcc/testsuite/gcc.dg/darwin-20040812-1.c
  e3c60516eb9991f352d93d33fde752d3  gcc/testsuite/gcc.dg/darwin-aligned-globals.c
  3010db4d547a5bce8e8559d5cc724330  gcc/testsuite/gcc.dg/darwin-cfstring-1.c
*************** ee5011d0e6b7fccb87df0fdf4ed4cdaf  gcc/te
*** 46363,46369 ****
  bd0bf08bda1424362307a0339137a72d  gcc/testsuite/gcc.dg/fold-convminconv-1.c
  eaf814577ce35df4d8865fd97a483ccb  gcc/testsuite/gcc.dg/fold-convnotconv-1.c
  399ab8aec7dfc124d0cca585c4c944be  gcc/testsuite/gcc.dg/fold-convround-1.c
! c55571e5ae8277e8fe34bd30ccbc760a  gcc/testsuite/gcc.dg/fold-copysign-1.c
  bf0e3d583aa40f4309fb7ca85e660b7b  gcc/testsuite/gcc.dg/fold-cstring.c
  34087e25944fd1f9c2f33740cbb9338e  gcc/testsuite/gcc.dg/fold-cstvecshift.c
  5c3c139b120c01c45b23f1afa9f49752  gcc/testsuite/gcc.dg/fold-ctz-1.c
--- 52030,52036 ----
  bd0bf08bda1424362307a0339137a72d  gcc/testsuite/gcc.dg/fold-convminconv-1.c
  eaf814577ce35df4d8865fd97a483ccb  gcc/testsuite/gcc.dg/fold-convnotconv-1.c
  399ab8aec7dfc124d0cca585c4c944be  gcc/testsuite/gcc.dg/fold-convround-1.c
! 3ad306b125e6533a764853e4018baa5c  gcc/testsuite/gcc.dg/fold-copysign-1.c
  bf0e3d583aa40f4309fb7ca85e660b7b  gcc/testsuite/gcc.dg/fold-cstring.c
  34087e25944fd1f9c2f33740cbb9338e  gcc/testsuite/gcc.dg/fold-cstvecshift.c
  5c3c139b120c01c45b23f1afa9f49752  gcc/testsuite/gcc.dg/fold-ctz-1.c
*************** d46511208ba88b755c518bb5aa8112c3  gcc/te
*** 48562,48568 ****
  d2e1206d26231777e76c9f21d67f4425  gcc/testsuite/gcc.dg/memcpy-3.c
  d8e1bd2272d2e582c95e1ac1b65751e9  gcc/testsuite/gcc.dg/memcpy-4.c
  a41ae21b628c0476195ce6dac94a92e9  gcc/testsuite/gcc.dg/memcpy-5.c
! 83ee9b3ae88b49791ab853275953d636  gcc/testsuite/gcc.dg/memcpy-6.c
  2e6979f3473f103c4c6ce0c0c0f8fd2d  gcc/testsuite/gcc.dg/memmove-1.c
  5224fb409821b04de2514e6f18e31023  gcc/testsuite/gcc.dg/memmove-2.c
  e8c4bdf333f001f5a197e7a3ad522e1d  gcc/testsuite/gcc.dg/memmove-3.c
--- 54229,54235 ----
  d2e1206d26231777e76c9f21d67f4425  gcc/testsuite/gcc.dg/memcpy-3.c
  d8e1bd2272d2e582c95e1ac1b65751e9  gcc/testsuite/gcc.dg/memcpy-4.c
  a41ae21b628c0476195ce6dac94a92e9  gcc/testsuite/gcc.dg/memcpy-5.c
! cd715b827680874ba4d68c7e82d6e6e6  gcc/testsuite/gcc.dg/memcpy-6.c
  2e6979f3473f103c4c6ce0c0c0f8fd2d  gcc/testsuite/gcc.dg/memmove-1.c
  5224fb409821b04de2514e6f18e31023  gcc/testsuite/gcc.dg/memmove-2.c
  e8c4bdf333f001f5a197e7a3ad522e1d  gcc/testsuite/gcc.dg/memmove-3.c
*************** c02fa2301e188a2a455f9e563251e0ab  gcc/te
*** 50621,50627 ****
  1d8c36210d3670ed7233860a3ae6d969  gcc/testsuite/gcc.dg/pr55122.c
  2feff382cd1763b0f7fcb4d1fbd09d8c  gcc/testsuite/gcc.dg/pr55150-1.c
  318809cf4617ac74fa55ca4c401067dd  gcc/testsuite/gcc.dg/pr55150-2.c
! aa91db30f4a67a45b35a7ea2607df8a7  gcc/testsuite/gcc.dg/pr55152-2.c
  815043146bd85da5bcefd5235fc403ab  gcc/testsuite/gcc.dg/pr55152.c
  6ce0cac6549a893cdf7f5bffc7f596ba  gcc/testsuite/gcc.dg/pr55153.c
  33b8d22c163e4008eca016572aae682e  gcc/testsuite/gcc.dg/pr55191.c
--- 56288,56294 ----
  1d8c36210d3670ed7233860a3ae6d969  gcc/testsuite/gcc.dg/pr55122.c
  2feff382cd1763b0f7fcb4d1fbd09d8c  gcc/testsuite/gcc.dg/pr55150-1.c
  318809cf4617ac74fa55ca4c401067dd  gcc/testsuite/gcc.dg/pr55150-2.c
! e9600b480b1d58fd2d8390da11f517f3  gcc/testsuite/gcc.dg/pr55152-2.c
  815043146bd85da5bcefd5235fc403ab  gcc/testsuite/gcc.dg/pr55152.c
  6ce0cac6549a893cdf7f5bffc7f596ba  gcc/testsuite/gcc.dg/pr55153.c
  33b8d22c163e4008eca016572aae682e  gcc/testsuite/gcc.dg/pr55191.c
*************** b6afda10a5c27a727b0d08f21d516d4e  gcc/te
*** 52410,52416 ****
  266cb582a2b22ec485ff4459934b2dff  gcc/testsuite/gcc.dg/strlenopt-78.c
  19ad1d7297ba36f34f9d6cafb32b03df  gcc/testsuite/gcc.dg/strlenopt-79.c
  3483f22866ff8ad2f086a39d551abaeb  gcc/testsuite/gcc.dg/strlenopt-8.c
! 8cc7f9a531a1854d32ce03ee927ec368  gcc/testsuite/gcc.dg/strlenopt-80.c
  8acdf4a4e0ea9ee3bbe36483c1d0dd90  gcc/testsuite/gcc.dg/strlenopt-81.c
  464e7743f0ea0b75ab26c7f05d33f499  gcc/testsuite/gcc.dg/strlenopt-82.c
  be5efcec32404d20397399ba100f8930  gcc/testsuite/gcc.dg/strlenopt-83.c
--- 58077,58083 ----
  266cb582a2b22ec485ff4459934b2dff  gcc/testsuite/gcc.dg/strlenopt-78.c
  19ad1d7297ba36f34f9d6cafb32b03df  gcc/testsuite/gcc.dg/strlenopt-79.c
  3483f22866ff8ad2f086a39d551abaeb  gcc/testsuite/gcc.dg/strlenopt-8.c
! d74278cb20b35a255c293a65cb178fc8  gcc/testsuite/gcc.dg/strlenopt-80.c
  8acdf4a4e0ea9ee3bbe36483c1d0dd90  gcc/testsuite/gcc.dg/strlenopt-81.c
  464e7743f0ea0b75ab26c7f05d33f499  gcc/testsuite/gcc.dg/strlenopt-82.c
  be5efcec32404d20397399ba100f8930  gcc/testsuite/gcc.dg/strlenopt-83.c
*************** d74952b1e73d78295fc0ccb16c0a8b6f  gcc/te
*** 52793,52799 ****
--- 58460,58471 ----
  47a60303d4b13f1c3a2aed096ec8343c  gcc/testsuite/gcc.dg/torture/bitint-75.c
  896ba6298bac21304239e8c0dcbadbd9  gcc/testsuite/gcc.dg/torture/bitint-76.c
  2608aa69ac055d04559dce7394b97765  gcc/testsuite/gcc.dg/torture/bitint-77.c
+ e5e2d1086821d7f61f870b51487c30ef  gcc/testsuite/gcc.dg/torture/bitint-78.c
+ 46f45efde03eb55094be29f7a7d477e0  gcc/testsuite/gcc.dg/torture/bitint-79.c
  cf2a2337cf009457d836bd48e49c0af3  gcc/testsuite/gcc.dg/torture/bitint-8.c
+ fa228ee9fbe53472bf0fbc0d82dbf06c  gcc/testsuite/gcc.dg/torture/bitint-80.c
+ 8ccddc7d4c25a0d622af001f456097fb  gcc/testsuite/gcc.dg/torture/bitint-81.c
+ c04a5c86281fcb981a8f28043fe2b87d  gcc/testsuite/gcc.dg/torture/bitint-82.c
  4d03bd57dac0507a44cc15b9afacd8a3  gcc/testsuite/gcc.dg/torture/bitint-9.c
  cf9904d4026e69bddaf745011bbaaab3  gcc/testsuite/gcc.dg/torture/builtin-attr-1.c
  c3c39411545c83e500562780b71883b6  gcc/testsuite/gcc.dg/torture/builtin-complex-1.c
*************** faa7f4600800bdbdaab47877d0fb7746  gcc/te
*** 53469,53474 ****
--- 59141,59148 ----
  52b5e2430d6e31ce28c98ffd5968f540  gcc/testsuite/gcc.dg/torture/pr120122-1.c
  e1b9ad351c56aebfaff790ff4002bf6e  gcc/testsuite/gcc.dg/torture/pr120182.c
  0c3297c6ebf6e4adcaeec164dfe8e9ac  gcc/testsuite/gcc.dg/torture/pr120211-1.c
+ a0d2174875961d5bb3004aad3d93d7d7  gcc/testsuite/gcc.dg/torture/pr120276.c
+ 590593d14c26e1d9ed776d01fc734a3c  gcc/testsuite/gcc.dg/torture/pr120369-1.c
  ded4330fd1cd52783bd9b1761db038ef  gcc/testsuite/gcc.dg/torture/pr16104-1.c
  fc265ee05da2f29f0e92804661cd1f28  gcc/testsuite/gcc.dg/torture/pr17526.c
  01c583edb41b632b835aa892b9c1cb14  gcc/testsuite/gcc.dg/torture/pr17933-1.c
*************** ce5aafb4955372c5794fefbc1ca41606  gcc/te
*** 54806,54812 ****
  4ec1df50bbb7aaccfc074fac7917886d  gcc/testsuite/gcc.dg/tree-ssa/abs-1.c
  b0b5e612a2c704e5987ba249f764ac8f  gcc/testsuite/gcc.dg/tree-ssa/abs-2.c
  19a62d3eff900f9178b8148a3c2dcfde  gcc/testsuite/gcc.dg/tree-ssa/abs-3.c
! e2373ab81a661f181b5a3de4fd940689  gcc/testsuite/gcc.dg/tree-ssa/abs-4.c
  e592268b4e08387e7085ac7d55f533a8  gcc/testsuite/gcc.dg/tree-ssa/absfloat16.c
  1ffb35a31eceb4a5cd948b003ff98d4a  gcc/testsuite/gcc.dg/tree-ssa/addadd-2.c
  9b7a0308ab7d67febabc87a64b5fe6b9  gcc/testsuite/gcc.dg/tree-ssa/addadd.c
--- 60480,60486 ----
  4ec1df50bbb7aaccfc074fac7917886d  gcc/testsuite/gcc.dg/tree-ssa/abs-1.c
  b0b5e612a2c704e5987ba249f764ac8f  gcc/testsuite/gcc.dg/tree-ssa/abs-2.c
  19a62d3eff900f9178b8148a3c2dcfde  gcc/testsuite/gcc.dg/tree-ssa/abs-3.c
! 27c3c80bd18fcc11c266242e9593a9a2  gcc/testsuite/gcc.dg/tree-ssa/abs-4.c
  e592268b4e08387e7085ac7d55f533a8  gcc/testsuite/gcc.dg/tree-ssa/absfloat16.c
  1ffb35a31eceb4a5cd948b003ff98d4a  gcc/testsuite/gcc.dg/tree-ssa/addadd-2.c
  9b7a0308ab7d67febabc87a64b5fe6b9  gcc/testsuite/gcc.dg/tree-ssa/addadd.c
*************** d605c0b7d6a001365bda6d24ef97cbb5  gcc/te
*** 54892,54898 ****
  ac00cf20aa901dad53cb68baa97cc1f8  gcc/testsuite/gcc.dg/tree-ssa/backprop-3.c
  151b70acaafa11170c060a221c5cb1f7  gcc/testsuite/gcc.dg/tree-ssa/backprop-4.c
  9d10ba95e8f24da60dec445a85298578  gcc/testsuite/gcc.dg/tree-ssa/backprop-5.c
! b945d8c281862d959c57df0356e60697  gcc/testsuite/gcc.dg/tree-ssa/backprop-6.c
  ad829088c2d182fe6e84645dc44f07e6  gcc/testsuite/gcc.dg/tree-ssa/bit-assoc.c
  b0045d2d08c49e824e2e272c7dcb35d1  gcc/testsuite/gcc.dg/tree-ssa/bit1neg-1.c
  8dbf4ef5de01b617ef64b9e8fdf74796  gcc/testsuite/gcc.dg/tree-ssa/bitcmp-1.c
--- 60566,60572 ----
  ac00cf20aa901dad53cb68baa97cc1f8  gcc/testsuite/gcc.dg/tree-ssa/backprop-3.c
  151b70acaafa11170c060a221c5cb1f7  gcc/testsuite/gcc.dg/tree-ssa/backprop-4.c
  9d10ba95e8f24da60dec445a85298578  gcc/testsuite/gcc.dg/tree-ssa/backprop-5.c
! efa2bb6bd9a362254dd3391a43a800d2  gcc/testsuite/gcc.dg/tree-ssa/backprop-6.c
  ad829088c2d182fe6e84645dc44f07e6  gcc/testsuite/gcc.dg/tree-ssa/bit-assoc.c
  b0045d2d08c49e824e2e272c7dcb35d1  gcc/testsuite/gcc.dg/tree-ssa/bit1neg-1.c
  8dbf4ef5de01b617ef64b9e8fdf74796  gcc/testsuite/gcc.dg/tree-ssa/bitcmp-1.c
*************** fc8efeaf2ed7c9bba5d4f1717e7e356b  gcc/te
*** 55213,55219 ****
  260a7d066794f7642a568e403fb5e5d4  gcc/testsuite/gcc.dg/tree-ssa/forwprop-39.c
  cb909e7812f73f90414b63042c95d199  gcc/testsuite/gcc.dg/tree-ssa/forwprop-4.c
  eb894750e8c2c762096d861a6009f51a  gcc/testsuite/gcc.dg/tree-ssa/forwprop-40.c
! a7f663adfd228e0c28c58bd9894c4b57  gcc/testsuite/gcc.dg/tree-ssa/forwprop-41.c
  d56422e63543fcf4bf4b78d825c534da  gcc/testsuite/gcc.dg/tree-ssa/forwprop-5.c
  0f6dc2b3b3469af9cd27d5b5cd97353c  gcc/testsuite/gcc.dg/tree-ssa/forwprop-6.c
  a9096c4b5b756bdc9dcc196398730d73  gcc/testsuite/gcc.dg/tree-ssa/forwprop-7.c
--- 60887,60893 ----
  260a7d066794f7642a568e403fb5e5d4  gcc/testsuite/gcc.dg/tree-ssa/forwprop-39.c
  cb909e7812f73f90414b63042c95d199  gcc/testsuite/gcc.dg/tree-ssa/forwprop-4.c
  eb894750e8c2c762096d861a6009f51a  gcc/testsuite/gcc.dg/tree-ssa/forwprop-40.c
! de3171692db53449fdcaa8f1c1e1676c  gcc/testsuite/gcc.dg/tree-ssa/forwprop-41.c
  d56422e63543fcf4bf4b78d825c534da  gcc/testsuite/gcc.dg/tree-ssa/forwprop-5.c
  0f6dc2b3b3469af9cd27d5b5cd97353c  gcc/testsuite/gcc.dg/tree-ssa/forwprop-6.c
  a9096c4b5b756bdc9dcc196398730d73  gcc/testsuite/gcc.dg/tree-ssa/forwprop-7.c
*************** ae492c945415066b7a6a35db28cdd97c  gcc/te
*** 57838,57844 ****
  f2317f19938996a698ef438051827fa8  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-11.c
  6ce36d21bab8c8f0d1ec0445949787e6  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-12.c
  9142a47e0d92eb815a6ab62fb813409b  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-2.c
! 64ebc5c00b3b93cf3fba373248930a4a  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-3.c
  f90613eca1398e841f666ecb38eb4e66  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-5.c
  a538aa2c6d6d5fe669b39929cfc50b18  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-6.c
  6c4cb21484bc65e227288f39312dc57b  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-7.c
--- 63512,63518 ----
  f2317f19938996a698ef438051827fa8  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-11.c
  6ce36d21bab8c8f0d1ec0445949787e6  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-12.c
  9142a47e0d92eb815a6ab62fb813409b  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-2.c
! 4b272a050ae924c04f515cdd65c4da9c  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-3.c
  f90613eca1398e841f666ecb38eb4e66  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-5.c
  a538aa2c6d6d5fe669b39929cfc50b18  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-6.c
  6c4cb21484bc65e227288f39312dc57b  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-7.c
*************** f798ac51e1550c7537bbd99e35e62d16  gcc/te
*** 57857,57863 ****
  48fb739a1edb3a6c802592137ae3b924  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-6.c
  8bbbc4b1c6f342f47fd7ee2222a232c3  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-7.c
  694e0220f13baa716a5985ee126d221a  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-8.c
! bbfa555f864ad9ddaa351a2f0f566625  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-9.c
  97dab4827e773bb05c5e5cb3d3cc4cf1  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/no-dynamic-lmul-1.c
  41e3b09c9cd2e4a261409d6d754d1ea8  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/pr111153-1.c
  28a9a6bfa55b6d61ac5076ddaef032bb  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/pr111317.c
--- 63531,63537 ----
  48fb739a1edb3a6c802592137ae3b924  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-6.c
  8bbbc4b1c6f342f47fd7ee2222a232c3  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-7.c
  694e0220f13baa716a5985ee126d221a  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-8.c
! 9937b597ae9adc5fa7d9e858a542cdfa  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-9.c
  97dab4827e773bb05c5e5cb3d3cc4cf1  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/no-dynamic-lmul-1.c
  41e3b09c9cd2e4a261409d6d754d1ea8  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/pr111153-1.c
  28a9a6bfa55b6d61ac5076ddaef032bb  gcc/testsuite/gcc.dg/vect/costmodel/riscv/rvv/pr111317.c
*************** c317cb696a26bea6d51beb4b38e72094  gcc/te
*** 58796,58802 ****
  226f54e6f293495fd6c000a73ed8b7a3  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s323.c
  61d0197203c46e31e39c8c4f8ad9e853  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s3251.c
  5c71ac7653e5a2836d2465a9f13c6ede  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s331.c
! bf0687fd782a94fee64bb5a6231b7710  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s332.c
  1fa698b706ad7a329bb8f12d8c9de007  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s341.c
  a574c6728b7b30ed7cb79cad1aca2a5b  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s342.c
  e54027ff8457ca286ef1dc9996df732c  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s343.c
--- 64470,64476 ----
  226f54e6f293495fd6c000a73ed8b7a3  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s323.c
  61d0197203c46e31e39c8c4f8ad9e853  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s3251.c
  5c71ac7653e5a2836d2465a9f13c6ede  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s331.c
! 53a5d5cd29c902bc0475399ff4b0f9e6  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s332.c
  1fa698b706ad7a329bb8f12d8c9de007  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s341.c
  a574c6728b7b30ed7cb79cad1aca2a5b  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s342.c
  e54027ff8457ca286ef1dc9996df732c  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s343.c
*************** da2e0ca1db6e6911aecfa27990b0f4e7  gcc/te
*** 58822,58829 ****
  71c7e2710eb0d787abf80641134c8464  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s452.c
  0a53ab45e8069125854b0ad478690528  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s453.c
  8840c708a7f2798298113799bfaaea0b  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s471.c
! 7d9d5fc521d92219b5cd950f9bf40394  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s481.c
! 6d1198c692415eb73b7ee5001abac6ec  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s482.c
  ab963c718fe086a0fc72501588ceb52f  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s491.c
  69786ca5ac25ed37637f1c1fc9a0ea8f  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-va.c
  e66f09a7a57dbc6fd0a0e6f0ae175ceb  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-vag.c
--- 64496,64503 ----
  71c7e2710eb0d787abf80641134c8464  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s452.c
  0a53ab45e8069125854b0ad478690528  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s453.c
  8840c708a7f2798298113799bfaaea0b  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s471.c
! 18638a696cc1001bf4359e5dad5abf55  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s481.c
! 6c5035d692f7ead08fd0b1f21b1b6828  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s482.c
  ab963c718fe086a0fc72501588ceb52f  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s491.c
  69786ca5ac25ed37637f1c1fc9a0ea8f  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-va.c
  e66f09a7a57dbc6fd0a0e6f0ae175ceb  gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-vag.c
*************** b0cb1e21e14035b1194c4f3f4e68becc  gcc/te
*** 59633,59651 ****
  c36c3ad97cfbf1be43ad8307f7b3eba0  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16b.c
  235df25db312428ee0327cc99566c491  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16c.c
  1dedb37c82844ddd86275fde6d32c493  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16d.c
! 28bb9727bb68f19dffb44f934f029e2d  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16e.c
  ce5218ee978fa8c2bf295aa7d2d4c9a5  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
  df907a0bedf6430cc4e5e0086f3ac9ab  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17.c
  30dd07bd633247c311c2eb04d6ecefe8  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17b.c
  8914ba9fbe02eab11aa1bdc58c53f2d5  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17c.c
  2c5804b394976fd97e4251f6e3a5f024  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17d.c
! bf533adb9e5c51763d56908279be7daa  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17e.c
  8bc74210842e1c3ef85cd6b16de4b591  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17f.c
  ee711a645968f35d0d88969943f997df  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18.c
  bb816b62d1cccb292fd79316f6930a5b  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18b.c
  adae6c0d76240f5c777e53659ee248f0  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18c.c
  a3d17e5ab474fc3beb8862101208a853  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18d.c
! b909da935d057e1e3a2fd43bee466656  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18e.c
  c8ce1f539ab725deadb9940aa9fc03d4  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
  b0cd25f77f52d4eebc59d342a34d3672  gcc/testsuite/gcc.dg/vect/vect-simd-clone-19.c
  fcf52e93fe21db4ebf8416abf92ac7cb  gcc/testsuite/gcc.dg/vect/vect-simd-clone-2.c
--- 65307,65325 ----
  c36c3ad97cfbf1be43ad8307f7b3eba0  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16b.c
  235df25db312428ee0327cc99566c491  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16c.c
  1dedb37c82844ddd86275fde6d32c493  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16d.c
! c99a6f17d5c50b5dc9f77be61d2cedbb  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16e.c
  ce5218ee978fa8c2bf295aa7d2d4c9a5  gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
  df907a0bedf6430cc4e5e0086f3ac9ab  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17.c
  30dd07bd633247c311c2eb04d6ecefe8  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17b.c
  8914ba9fbe02eab11aa1bdc58c53f2d5  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17c.c
  2c5804b394976fd97e4251f6e3a5f024  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17d.c
! 83de6bb57b6a762dd73ae2de9741dab7  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17e.c
  8bc74210842e1c3ef85cd6b16de4b591  gcc/testsuite/gcc.dg/vect/vect-simd-clone-17f.c
  ee711a645968f35d0d88969943f997df  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18.c
  bb816b62d1cccb292fd79316f6930a5b  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18b.c
  adae6c0d76240f5c777e53659ee248f0  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18c.c
  a3d17e5ab474fc3beb8862101208a853  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18d.c
! 97451112609f52a56a33737531e88660  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18e.c
  c8ce1f539ab725deadb9940aa9fc03d4  gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
  b0cd25f77f52d4eebc59d342a34d3672  gcc/testsuite/gcc.dg/vect/vect-simd-clone-19.c
  fcf52e93fe21db4ebf8416abf92ac7cb  gcc/testsuite/gcc.dg/vect/vect-simd-clone-2.c
*************** e15fb874d0ae7c74f74b2eb5bd8f8bf3  gcc/te
*** 60352,60363 ****
  0d5ba16c2924cc1abd60d5f6e84bb892  gcc/testsuite/gcc.target/aarch64/acle/rng_1.c
  cb84d7d74821259d1a47775dd18c13c8  gcc/testsuite/gcc.target/aarch64/acle/rng_2.c
  a204aadb3f5fc384dd117c7c09175029  gcc/testsuite/gcc.target/aarch64/acle/rwsr-1.c
! d5b77d8e1a21321e649e6b77802e64c8  gcc/testsuite/gcc.target/aarch64/acle/rwsr-2.c
  90a044b6489e0d51268ae3d5ce15dead  gcc/testsuite/gcc.target/aarch64/acle/rwsr-3.c
  07dc62ae2bcf9c8e358ed99fe06cd5d6  gcc/testsuite/gcc.target/aarch64/acle/rwsr-4.c
  119d4f72bb0ea43c9a5cbee2e61cdd5e  gcc/testsuite/gcc.target/aarch64/acle/rwsr-armv8p9.c
  b478e4234b2713f0df0d417dd9d13425  gcc/testsuite/gcc.target/aarch64/acle/rwsr-ungated.c
! c41c68503dfa6ef4c72faaf77fd40cb2  gcc/testsuite/gcc.target/aarch64/acle/rwsr.c
  10ce3b5edee8a787906dd58121496c70  gcc/testsuite/gcc.target/aarch64/acle/tme.c
  1627c4e768e0f137d5dca5de857b5c77  gcc/testsuite/gcc.target/aarch64/acle/tme_guard-1.c
  b17ad011788c422a42d7da3d5a869239  gcc/testsuite/gcc.target/aarch64/acle/tme_guard-2.c
--- 66026,66037 ----
  0d5ba16c2924cc1abd60d5f6e84bb892  gcc/testsuite/gcc.target/aarch64/acle/rng_1.c
  cb84d7d74821259d1a47775dd18c13c8  gcc/testsuite/gcc.target/aarch64/acle/rng_2.c
  a204aadb3f5fc384dd117c7c09175029  gcc/testsuite/gcc.target/aarch64/acle/rwsr-1.c
! 596da75607dfa463c209980dba2ef791  gcc/testsuite/gcc.target/aarch64/acle/rwsr-2.c
  90a044b6489e0d51268ae3d5ce15dead  gcc/testsuite/gcc.target/aarch64/acle/rwsr-3.c
  07dc62ae2bcf9c8e358ed99fe06cd5d6  gcc/testsuite/gcc.target/aarch64/acle/rwsr-4.c
  119d4f72bb0ea43c9a5cbee2e61cdd5e  gcc/testsuite/gcc.target/aarch64/acle/rwsr-armv8p9.c
  b478e4234b2713f0df0d417dd9d13425  gcc/testsuite/gcc.target/aarch64/acle/rwsr-ungated.c
! 060ba83ef96f0e9ba1957beb7670ae4f  gcc/testsuite/gcc.target/aarch64/acle/rwsr.c
  10ce3b5edee8a787906dd58121496c70  gcc/testsuite/gcc.target/aarch64/acle/tme.c
  1627c4e768e0f137d5dca5de857b5c77  gcc/testsuite/gcc.target/aarch64/acle/tme_guard-1.c
  b17ad011788c422a42d7da3d5a869239  gcc/testsuite/gcc.target/aarch64/acle/tme_guard-2.c
*************** f7353dd395d4a06a8cb38e34a076fb39  gcc/te
*** 61438,61443 ****
--- 67112,67118 ----
  b90f3600518fbc46af4cd4bd1cdb7186  gcc/testsuite/gcc.target/aarch64/ifcvt_multiple_sets_subreg_1.c
  af0e32f53ec629289269248abb106c2e  gcc/testsuite/gcc.target/aarch64/iinline-attr-1.c
  7673570b4adf4ddf395a94b20d54e4bb  gcc/testsuite/gcc.target/aarch64/imm_choice_comparison-1.c
+ f6cdcf70148922242a9b7462db2e04cb  gcc/testsuite/gcc.target/aarch64/imm_choice_comparison-2.c
  6fb81bd92df3487698e7f9bc3ce53f6e  gcc/testsuite/gcc.target/aarch64/imm_choice_comparison.c
  aa9097deb2901881188486bdf9eb3343  gcc/testsuite/gcc.target/aarch64/index.c
  4c1452d0d69f13e180f289e658cda989  gcc/testsuite/gcc.target/aarch64/indirect_return-1.c
*************** d0bcbc3d9ff4ecc6817a33d0d9f3aed3  gcc/te
*** 61910,61916 ****
  48d743cb731002c6490f875730d154df  gcc/testsuite/gcc.target/aarch64/reg-alloc-1.c
  74688db113854841ef6e7ea639b44f4c  gcc/testsuite/gcc.target/aarch64/reg-alloc-2.c
  d6af8901d4df3dbbd85fb4a872ad6e99  gcc/testsuite/gcc.target/aarch64/reg-alloc-3.c
! ae41f7b64717901920ce9a6a8098b825  gcc/testsuite/gcc.target/aarch64/reg-alloc-4.c
  c27a4c6f9c9e7aee309e6f023d713539  gcc/testsuite/gcc.target/aarch64/reload-valid-spoff.c
  12027036f3324e61c799dd687707f327  gcc/testsuite/gcc.target/aarch64/return_address_sign_1.c
  3a6d132840352f3644dba08c59522fcb  gcc/testsuite/gcc.target/aarch64/return_address_sign_2.c
--- 67585,67591 ----
  48d743cb731002c6490f875730d154df  gcc/testsuite/gcc.target/aarch64/reg-alloc-1.c
  74688db113854841ef6e7ea639b44f4c  gcc/testsuite/gcc.target/aarch64/reg-alloc-2.c
  d6af8901d4df3dbbd85fb4a872ad6e99  gcc/testsuite/gcc.target/aarch64/reg-alloc-3.c
! 0ab15f2e56392789e6c87021dce0be6f  gcc/testsuite/gcc.target/aarch64/reg-alloc-4.c
  c27a4c6f9c9e7aee309e6f023d713539  gcc/testsuite/gcc.target/aarch64/reload-valid-spoff.c
  12027036f3324e61c799dd687707f327  gcc/testsuite/gcc.target/aarch64/return_address_sign_1.c
  3a6d132840352f3644dba08c59522fcb  gcc/testsuite/gcc.target/aarch64/return_address_sign_2.c
*************** b6aa615b85ae40b63a22dbc7071fd902  gcc/te
*** 61952,61965 ****
  32f4f51563b0d7be120e5d5009ab1e3e  gcc/testsuite/gcc.target/aarch64/sha3_1.c
  b452d4c86751bd11bf03b8ca21d25bf4  gcc/testsuite/gcc.target/aarch64/sha3_2.c
  7bbc7a27b67681b713096a7ab9ed18a3  gcc/testsuite/gcc.target/aarch64/sha3_3.c
! 720a26afca0daa0c0583c3cbf5f2c7d0  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_1.c
! e35638303a0cd435f199e6e2d3d6e7c6  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_2.c
! 426a463bcea5af95b04b1d22b1bbacc9  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_3.c
! a363537d70052012f4777fd050c01616  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_4.c
! 15ab2e89615616e6256107a14fec5826  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_5.c
! 50727fb397c1155a47819bce866a95bf  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_6.c
! 02194799b94f05acf17b63ab5c06347f  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_7.c
! 18c96dea861729b7500d35a579132122  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_8.c
  a165f88ed1988f9840bbb02ea02df7de  gcc/testsuite/gcc.target/aarch64/shift_and_operator-1.c
  8944288dbff8e1e27c9948e6640f93d5  gcc/testsuite/gcc.target/aarch64/shift_wide_invalid_1.c
  82788cbb043cb268dfa4db7129b0952a  gcc/testsuite/gcc.target/aarch64/shl-combine-2.c
--- 67627,67640 ----
  32f4f51563b0d7be120e5d5009ab1e3e  gcc/testsuite/gcc.target/aarch64/sha3_1.c
  b452d4c86751bd11bf03b8ca21d25bf4  gcc/testsuite/gcc.target/aarch64/sha3_2.c
  7bbc7a27b67681b713096a7ab9ed18a3  gcc/testsuite/gcc.target/aarch64/sha3_3.c
! 8290b001857e70f2bb00f9e9980ea2f1  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_1.c
! d1691b06335c7599e23fe146c1e9bf0d  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_2.c
! 2b4c1d692aa2c1f603c926f7a2622b73  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_3.c
! 6aed31210dfd913f96ccd1b464ac2424  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_4.c
! 2806254d55378ae16f07f3f0c3bfd53e  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_5.c
! f5d057a98c1e37c0afb2e8ff06734df1  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_6.c
! c405a6381ecd38226656193a872614d6  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_7.c
! b561dd4fb4871240c2f7d5ed61ad7bf3  gcc/testsuite/gcc.target/aarch64/shadow_call_stack_8.c
  a165f88ed1988f9840bbb02ea02df7de  gcc/testsuite/gcc.target/aarch64/shift_and_operator-1.c
  8944288dbff8e1e27c9948e6640f93d5  gcc/testsuite/gcc.target/aarch64/shift_wide_invalid_1.c
  82788cbb043cb268dfa4db7129b0952a  gcc/testsuite/gcc.target/aarch64/shl-combine-2.c
*************** c9d369dea4ca29ccd648d788cfb8ea09  gcc/te
*** 62648,62656 ****
  8b77b15e6a3831e3b0fed7e89decf181  gcc/testsuite/gcc.target/aarch64/sme/locally_streaming_2.c
  1cac7b6477b6f8a18e8af2c0382a7c19  gcc/testsuite/gcc.target/aarch64/sme/locally_streaming_3.c
  bbf6f844429d0a09aa8e59fff5c21e3e  gcc/testsuite/gcc.target/aarch64/sme/locally_streaming_4.c
! df9a1b5d24aec3bc8a0ef502ec0a64b9  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_1.c
! 9e8c955b1919174497153e1d3013fee2  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_2.c
! 1e34a9aa245aab348a971503bc5835f8  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_3.c
  22fd87add17434b6187df796a3049a4e  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_4.c
  82a3cecab61caec3898c65f70b69ae31  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_5.c
  7f0a2bc5b5ada7add64168ea0a4c5b53  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_6.c
--- 68323,68331 ----
  8b77b15e6a3831e3b0fed7e89decf181  gcc/testsuite/gcc.target/aarch64/sme/locally_streaming_2.c
  1cac7b6477b6f8a18e8af2c0382a7c19  gcc/testsuite/gcc.target/aarch64/sme/locally_streaming_3.c
  bbf6f844429d0a09aa8e59fff5c21e3e  gcc/testsuite/gcc.target/aarch64/sme/locally_streaming_4.c
! d58cb56f27af67ddaa9934aaac02fa57  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_1.c
! d17183152eaebed55ce739c38fbe9dc7  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_2.c
! e41817248a56088fa5916baafe036a84  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_3.c
  22fd87add17434b6187df796a3049a4e  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_4.c
  82a3cecab61caec3898c65f70b69ae31  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_5.c
  7f0a2bc5b5ada7add64168ea0a4c5b53  gcc/testsuite/gcc.target/aarch64/sme/nonlocal_goto_6.c
*************** e996cd8c829a02c64b035caa943ddf85  gcc/te
*** 63589,63597 ****
  f60705b79c18983e5449cb2640888da9  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-16.c
  88257f5a4ca972bb5e1bc6a5a4eca89e  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-17.c
  14d0d8388a620d2cf045430fae29bb5b  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-18.c
! 6ccb0fbe36746268e24f8912f1eabee6  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-19.c
  d7433841ac09c91656c5bb63b8e8a09a  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-2.c
! 3615b928f50ecd37b55bccdd18e7b615  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-20.c
  4d593b97a712f1c1b227372e57c2b116  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-3.c
  dbd54994dcdef6b44b1f3378ddd01e83  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-4.c
  f4a154bf65900f64fd155fb1f95ddd80  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-5.c
--- 69264,69272 ----
  f60705b79c18983e5449cb2640888da9  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-16.c
  88257f5a4ca972bb5e1bc6a5a4eca89e  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-17.c
  14d0d8388a620d2cf045430fae29bb5b  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-18.c
! db78d726d905a2a406160f39fc4e0ecb  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-19.c
  d7433841ac09c91656c5bb63b8e8a09a  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-2.c
! f334cdf544b1e7205b7bd65b165d83c5  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-20.c
  4d593b97a712f1c1b227372e57c2b116  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-3.c
  dbd54994dcdef6b44b1f3378ddd01e83  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-4.c
  f4a154bf65900f64fd155fb1f95ddd80  gcc/testsuite/gcc.target/aarch64/stack-check-prologue-5.c
*************** a8c77b95bd5326b0cdaee7971136285d  gcc/te
*** 66661,66666 ****
--- 72336,72344 ----
  c22e90c555fd4e08f770dd7e84a27798  gcc/testsuite/gcc.target/aarch64/sve/sel_6.c
  c36c0d859d7358a7cf09605bb6f61e7a  gcc/testsuite/gcc.target/aarch64/sve/shift_1.c
  ab115fc66c3ca381694901b3efd77092  gcc/testsuite/gcc.target/aarch64/sve/shift_2.c
+ a5ae2342f8f72007966a656463efd22c  gcc/testsuite/gcc.target/aarch64/sve/shift_rev_1.c
+ 9e87971c4050e3bb84b6706a071995d7  gcc/testsuite/gcc.target/aarch64/sve/shift_rev_2.c
+ a6c0f7a9c973fa9d847b30b27ee5b521  gcc/testsuite/gcc.target/aarch64/sve/shift_rev_3.c
  b742592bc8045ec0015168c8f288d8a7  gcc/testsuite/gcc.target/aarch64/sve/sibcall_1.c
  490e20f75641a2353722e04a16e7826a  gcc/testsuite/gcc.target/aarch64/sve/simd_imm.c
  f4445d4c3ee24e3e195328a507b2d59e  gcc/testsuite/gcc.target/aarch64/sve/simd_imm_mov.c
*************** c2682b969fcec66bb2ebb2442ff4221b  gcc/te
*** 72198,72203 ****
--- 77876,77882 ----
  95b83592cd208bcb180064639fd1558f  gcc/testsuite/gcc.target/arm/pr115153.c
  39327fb26a438561d0617a9bfe99c59f  gcc/testsuite/gcc.target/arm/pr115188.c
  01f3623877a32b45af0d229eab49f4cf  gcc/testsuite/gcc.target/arm/pr117675.c
+ bc84b25bc522b6ed07bd7885605c00d7  gcc/testsuite/gcc.target/arm/pr120351.c
  3ce2c6a399da67ae36390d522e1f1296  gcc/testsuite/gcc.target/arm/pr19599.c
  3425143e88f989a8f52f345e6237106a  gcc/testsuite/gcc.target/arm/pr26702.c
  fc0dd660f56108005b4f0b142e94d10d  gcc/testsuite/gcc.target/arm/pr37780_1.c
*************** da9a874cc43d515ca40fe91f469c7339  gcc/te
*** 74084,74090 ****
  64889694d1cb3280b3aa71fa1424dec5  gcc/testsuite/gcc.target/i386/auto-init-padding-7.c
  6833c0fc00c0e05839ef7fc0ebe6662f  gcc/testsuite/gcc.target/i386/auto-init-padding-8.c
  549987a73da82c221222811981e79dc3  gcc/testsuite/gcc.target/i386/auto-init-padding-9.c
! 949e17bef72a4235dfc7643eb4503829  gcc/testsuite/gcc.target/i386/avx-1.c
  ce8537ac3337be19a6e276a8fbfccd9e  gcc/testsuite/gcc.target/i386/avx-2.c
  b8752c209e6f3770321077d53e28d157  gcc/testsuite/gcc.target/i386/avx-3.c
  604a63c576a08022e714a4940dc0e904  gcc/testsuite/gcc.target/i386/avx-additional-reg-names.c
--- 79763,79769 ----
  64889694d1cb3280b3aa71fa1424dec5  gcc/testsuite/gcc.target/i386/auto-init-padding-7.c
  6833c0fc00c0e05839ef7fc0ebe6662f  gcc/testsuite/gcc.target/i386/auto-init-padding-8.c
  549987a73da82c221222811981e79dc3  gcc/testsuite/gcc.target/i386/auto-init-padding-9.c
! 6d269f763b677e113f37ab0f5e75583e  gcc/testsuite/gcc.target/i386/avx-1.c
  ce8537ac3337be19a6e276a8fbfccd9e  gcc/testsuite/gcc.target/i386/avx-2.c
  b8752c209e6f3770321077d53e28d157  gcc/testsuite/gcc.target/i386/avx-3.c
  604a63c576a08022e714a4940dc0e904  gcc/testsuite/gcc.target/i386/avx-additional-reg-names.c
*************** e496930891266115a9ceee7c7de0cac4  gcc/te
*** 74687,74805 ****
  196aec2399172c70cc1b6322412ec45d  gcc/testsuite/gcc.target/i386/avx-vzeroupper-7.c
  2dd3d3b02f96ec89ffed6f185b8e940f  gcc/testsuite/gcc.target/i386/avx-vzeroupper-8.c
  280e2807a80caedf3c9b1fd25684032d  gcc/testsuite/gcc.target/i386/avx-vzeroupper-9.c
! 382bf2eb96902652127fed5167872cf2  gcc/testsuite/gcc.target/i386/avx10-check.h
  00a4c8062c1c2d022d49ff16fc125e09  gcc/testsuite/gcc.target/i386/avx10-helper.h
! b27aa1ddd53a79c0f88cd12b55641442  gcc/testsuite/gcc.target/i386/avx10-minmax-helper.h
  d493060b0a2454334d4eb6941a14ad8b  gcc/testsuite/gcc.target/i386/avx10-os-support.h
! ed2c5a322dda676833a6a2b62cb76a85  gcc/testsuite/gcc.target/i386/avx10_1-1.c
! a30416db89e9da2e70a59b20003bb4d5  gcc/testsuite/gcc.target/i386/avx10_1-10.c
! ccf5cf2ee49e7a381837f4609634e8ca  gcc/testsuite/gcc.target/i386/avx10_1-11.c
! 0275eb48fc93fb1b0381c672435bfd9e  gcc/testsuite/gcc.target/i386/avx10_1-12.c
! 1c12c8af717d6d04b0014cf202496995  gcc/testsuite/gcc.target/i386/avx10_1-13.c
! 22f257f78ac947c68408e2726d35eb15  gcc/testsuite/gcc.target/i386/avx10_1-14.c
! e1fddea819425630c552f316eca7a6f8  gcc/testsuite/gcc.target/i386/avx10_1-15.c
! 509833f3299ff11702d32156d18d632e  gcc/testsuite/gcc.target/i386/avx10_1-16.c
! b36513eb245b7260cfb01ee02ed5c959  gcc/testsuite/gcc.target/i386/avx10_1-17.c
! 78bb5aa21a982c1f8615c5c688698c61  gcc/testsuite/gcc.target/i386/avx10_1-18.c
! 695efbb3c6db40a557bcffa5243b22b8  gcc/testsuite/gcc.target/i386/avx10_1-19.c
! 7c185dac02a242d9a05b362ee459ccda  gcc/testsuite/gcc.target/i386/avx10_1-2.c
! 0f57d1da14eab65553a6758c8b9fa0a7  gcc/testsuite/gcc.target/i386/avx10_1-20.c
! 554d2d324a959f862ed8d8aec308b2a6  gcc/testsuite/gcc.target/i386/avx10_1-21.c
! 6753fe19a798f558ed48b9894a5ea72a  gcc/testsuite/gcc.target/i386/avx10_1-22.c
! bf355dd24e6733a708d41af6b2023f26  gcc/testsuite/gcc.target/i386/avx10_1-23.c
! 8171b277bd12f9a75849bb34438003a6  gcc/testsuite/gcc.target/i386/avx10_1-26.c
! 5a6e08c779069590b2aad4e4d6d6bdb7  gcc/testsuite/gcc.target/i386/avx10_1-3.c
! aa544c8cfd5b4f1707812ae00de85376  gcc/testsuite/gcc.target/i386/avx10_1-4.c
! 11ec513f07af5009177e40a6618ab923  gcc/testsuite/gcc.target/i386/avx10_1-7.c
! b683581c63b2ee941258fabef29a46de  gcc/testsuite/gcc.target/i386/avx10_1-8.c
! 85388187fbb199f1012b2dc5a5d2e61b  gcc/testsuite/gcc.target/i386/avx10_1-9.c
! 447bade2bcf4932aed304d256bd6b2b4  gcc/testsuite/gcc.target/i386/avx10_2-512-bf16-1.c
! 00a805f394241a6ef38287e60b0608a7  gcc/testsuite/gcc.target/i386/avx10_2-512-bf16-vector-cmp-1.c
! d813852930ebeb331eecaf9451f402a3  gcc/testsuite/gcc.target/i386/avx10_2-512-bf16-vector-fma-1.c
! 83041dd789bec46cd2b2ef2b6014ea26  gcc/testsuite/gcc.target/i386/avx10_2-512-bf16-vector-operations-1.c
! 2a7207fdabcf640c9737706728b76d62  gcc/testsuite/gcc.target/i386/avx10_2-512-bf16-vector-smaxmin-1.c
! 47cc6642b5f8856c392cd8a5d37a1760  gcc/testsuite/gcc.target/i386/avx10_2-512-convert-1.c
! d9f26d737f76d3cc5c5cb164e361509c  gcc/testsuite/gcc.target/i386/avx10_2-512-media-1.c
! 12e8d42fdf7208ef07d12208fb2ff368  gcc/testsuite/gcc.target/i386/avx10_2-512-minmax-1.c
! d96e4aa4483b1749dd0218b606ccdcc3  gcc/testsuite/gcc.target/i386/avx10_2-512-movrs-1.c
! edaa2a4cb906a884bf5b8980e8935053  gcc/testsuite/gcc.target/i386/avx10_2-512-satcvt-1.c
! 724118ade7dc930d0ec0f1ed3f54246b  gcc/testsuite/gcc.target/i386/avx10_2-512-vaddbf16-2.c
! 462015424956ef9311089ed401d84bce  gcc/testsuite/gcc.target/i386/avx10_2-512-vcmpbf16-2.c
! 95a541f859f77f729fe1851d02debb79  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvt2ph2bf8-2.c
! 797128068e351c55168d6b0bbf558b0a  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvt2ph2bf8s-2.c
! d887034a035518d81049d5a43bb0c9aa  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvt2ph2hf8-2.c
! eae77a4673271b36f25215ad559e38ec  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvt2ph2hf8s-2.c
! 61f1e00c9ec95bab9f94f229bd55b807  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvt2ps2phx-2.c
! 9959f724e10a7a67e33a8e65e53c64ef  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtbf162ibs-2.c
! 8b5d79e3887fd912183bc609d8d4a674  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtbf162iubs-2.c
! c1852d63485c31999a75a6bc33d1ba8e  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtbiasph2bf8-2.c
! 4c90dc5d59a42e125115d34f8f592abc  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtbiasph2bf8s-2.c
! 35577d53b38faf629b79e8d35b708bc1  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtbiasph2hf8-2.c
! cdb23e9180c3075982dbf83f64cc2a32  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtbiasph2hf8s-2.c
! 742e876412bc0fcdafb75f4aeac53273  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvthf82ph-2.c
! 6b3fc2677be9dfb0f0bf5068dd1de279  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtph2bf8-2.c
! b1fd4c823049e39b770916423f7913e0  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtph2bf8s-2.c
! d1aa173f2977316c2c9940c21e509466  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtph2hf8-2.c
! a0ee7099431a88f389b98136a0878f36  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtph2hf8s-2.c
! 1b02a38945bb3586394797a6d8fc6a50  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtph2ibs-2.c
! 12d9cdae2ef83e9b67fabdc88fa960f9  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtph2iubs-2.c
! 4de3dbfc792a6511d5608f58f729834c  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtps2ibs-2.c
! 0e19f48ac1f2516731ce7112bd157267  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvtps2iubs-2.c
! 8fef4acf30d5e55623bafb4b3212d3e4  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttbf162ibs-2.c
! 7d7f5f7e1c5a443e891c740e9e6c4095  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttbf162iubs-2.c
! ff3b0afc2f0c4b1c4681dfa8e9b6fd8a  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttpd2dqs-2.c
! 4a1e00d098055d5a4c9dcbd4c57b3644  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttpd2qqs-2.c
! b795890e217bd8594f667350fe417d93  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttpd2udqs-2.c
! 7481d52ae14c6285d360f4e40d2cb6b1  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttpd2uqqs-2.c
! c8aa014f031b5f0cd5c227a500a43d36  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttph2ibs-2.c
! 0fc7463743b4353316bb76945cca55ca  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttph2iubs-2.c
! 8f9bc8c94f6f41fd23da4162bb64d5e8  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttps2dqs-2.c
! 4e9d89ae203d1f81151e9e46b3a10336  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttps2ibs-2.c
! 0d66a9a294690c1e15c23db3d6f49b91  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttps2iubs-2.c
! a6c4ed440e3b434e12074f44ad0f9ea8  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttps2qqs-2.c
! 44485da53bc8fd21570b0e91a76035d0  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttps2udqs-2.c
! 638b8844314460c6f7dd64ee879351c1  gcc/testsuite/gcc.target/i386/avx10_2-512-vcvttps2uqqs-2.c
! c6f859ad60b2bea049b2d0199e357d79  gcc/testsuite/gcc.target/i386/avx10_2-512-vdivbf16-2.c
! 29358773460da9087f60171f52048e02  gcc/testsuite/gcc.target/i386/avx10_2-512-vdpphps-2.c
! 3d2f6169e71f087f73cc8afa674781de  gcc/testsuite/gcc.target/i386/avx10_2-512-vfmaddXXXbf16-2.c
! 887d8d9ed92c809a9d127e1b982f6106  gcc/testsuite/gcc.target/i386/avx10_2-512-vfmsubXXXbf16-2.c
! 3f6e1f2d5338505ab88f24ee79577970  gcc/testsuite/gcc.target/i386/avx10_2-512-vfnmaddXXXbf16-2.c
! 05a57e09ee42b2934fb1603e5ef49a6d  gcc/testsuite/gcc.target/i386/avx10_2-512-vfnmsubXXXbf16-2.c
! 951555396c789e578cd2f42e81e7e15f  gcc/testsuite/gcc.target/i386/avx10_2-512-vfpclassbf16-2.c
! def366a4a1b8ceec0763e66b284312c0  gcc/testsuite/gcc.target/i386/avx10_2-512-vgetexpbf16-2.c
! b809f4bc2ed34a69f71282a9ec89c650  gcc/testsuite/gcc.target/i386/avx10_2-512-vgetmantbf16-2.c
! 9ec0211f07d0aac4325e00b7fd116b93  gcc/testsuite/gcc.target/i386/avx10_2-512-vmaxbf16-2.c
! 8c2a49daf059bdb92d201ad29499e169  gcc/testsuite/gcc.target/i386/avx10_2-512-vminbf16-2.c
! 25b28cb6b13d757400d33615bb5c6580  gcc/testsuite/gcc.target/i386/avx10_2-512-vminmaxbf16-2.c
! ead2017e7b419000d0090afed68c3b78  gcc/testsuite/gcc.target/i386/avx10_2-512-vminmaxpd-2.c
! d678dd202693efe3c3e50e45af3275e6  gcc/testsuite/gcc.target/i386/avx10_2-512-vminmaxph-2.c
! b6fcfa926992acb5c9038da88a8bb882  gcc/testsuite/gcc.target/i386/avx10_2-512-vminmaxps-2.c
! 713779a5a7821e65d06ffe3fc2964ee3  gcc/testsuite/gcc.target/i386/avx10_2-512-vmpsadbw-2.c
! da69e3882dda67c3434aa3e8c2c1f588  gcc/testsuite/gcc.target/i386/avx10_2-512-vmulbf16-2.c
! c7624f9d689443bc1f235d8af1122d35  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpbssd-2.c
! eda9e6f7fec3e19bd4750e6fb53adad3  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpbssds-2.c
! 47f85246f1aa83f516dfb3b60254c524  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpbsud-2.c
! 61c1e29d33207f481f5b31d08e215c02  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpbsuds-2.c
! 0fb32434ce874e014d4760142a8da612  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpbuud-2.c
! 7fc65fe3f1820ac14135b797b003a5ac  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpbuuds-2.c
! d065e63a771b2015cff671f903a30d02  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpwsud-2.c
! 33fe890d81c82e0ea5c859b1db36edc0  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpwsuds-2.c
! 3c30812e17e1c98ca3470e93cd32f11b  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpwusd-2.c
! 8735664e92addda5d74e2d40501a1dce  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpwusds-2.c
! d349a779cc51a5c2374071be3a9ec517  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpwuud-2.c
! 699033b87faaa17715e28e935b4df930  gcc/testsuite/gcc.target/i386/avx10_2-512-vpdpwuuds-2.c
! 7d30f0f74d39276a9868c45811c04035  gcc/testsuite/gcc.target/i386/avx10_2-512-vrcpbf16-2.c
! 0db1c17c937eca3945d71ca267ff78ee  gcc/testsuite/gcc.target/i386/avx10_2-512-vreducebf16-2.c
! 6fbb9d2435ca738348eebaa20a3f0212  gcc/testsuite/gcc.target/i386/avx10_2-512-vrndscalebf16-2.c
! d6a0e6873615f7dc218bfc6e782a84b1  gcc/testsuite/gcc.target/i386/avx10_2-512-vrsqrtbf16-2.c
! 8ff25ba2a50fe6d0c8d97530e2f48a03  gcc/testsuite/gcc.target/i386/avx10_2-512-vscalefbf16-2.c
! 6aa61438539bbe2ed1456a9f544be42b  gcc/testsuite/gcc.target/i386/avx10_2-512-vsqrtbf16-2.c
! 22922d71e3860e9bf1ea060e84a8556c  gcc/testsuite/gcc.target/i386/avx10_2-512-vsubbf16-2.c
! 36feb302799836bb1447aad4996d4f32  gcc/testsuite/gcc.target/i386/avx10_2-bf16-1.c
! 841bdd237ddc0112739915941b7a41c9  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-cmp-1.c
! f8c33643ad40fac24323d3d941c6f876  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-fma-1.c
! 80f595f8be5c33e21612b362c6774049  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-operations-1.c
! e15fc8536d46cdd4ac348a96109c3117  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-smaxmin-1.c
  417ab35ed9008afe2f322f93299c12d8  gcc/testsuite/gcc.target/i386/avx10_2-builtin-1.c
  a2fc5a1576404e3c308cbd5c09c5efb0  gcc/testsuite/gcc.target/i386/avx10_2-builtin-2.c
  3e38bcafeb4d5b2f7bb1c52ababdf752  gcc/testsuite/gcc.target/i386/avx10_2-comibf-1.c
--- 80366,80387 ----
  196aec2399172c70cc1b6322412ec45d  gcc/testsuite/gcc.target/i386/avx-vzeroupper-7.c
  2dd3d3b02f96ec89ffed6f185b8e940f  gcc/testsuite/gcc.target/i386/avx-vzeroupper-8.c
  280e2807a80caedf3c9b1fd25684032d  gcc/testsuite/gcc.target/i386/avx-vzeroupper-9.c
! 1729a1f762e4d28d34a21d6a5d163d87  gcc/testsuite/gcc.target/i386/avx10-check.h
  00a4c8062c1c2d022d49ff16fc125e09  gcc/testsuite/gcc.target/i386/avx10-helper.h
! 91ee0c4c75970b0663eec27dec967ee1  gcc/testsuite/gcc.target/i386/avx10-minmax-helper.h
  d493060b0a2454334d4eb6941a14ad8b  gcc/testsuite/gcc.target/i386/avx10-os-support.h
! 3ca528977553962fce3bc10b01fc3684  gcc/testsuite/gcc.target/i386/avx10_1-1.c
! 5c3d062a700faeb9c475895d59881aed  gcc/testsuite/gcc.target/i386/avx10_1-2.c
! 83836eb7c19ebd0a3cb10c1b38859560  gcc/testsuite/gcc.target/i386/avx10_1-3.c
! ba28fa2f54eaa9223f6892f84f5a47df  gcc/testsuite/gcc.target/i386/avx10_1-4.c
! f6fc2ac3d31c81e3d9c7b73d90f59b85  gcc/testsuite/gcc.target/i386/avx10_1-5.c
! 6d38cceea8e161aeffa01313f400100c  gcc/testsuite/gcc.target/i386/avx10_1-6.c
! 8171b277bd12f9a75849bb34438003a6  gcc/testsuite/gcc.target/i386/avx10_1-7.c
! 6a8d7e861a7cf49c0c6e9ad05f10a643  gcc/testsuite/gcc.target/i386/avx10_2-bf16-1.c
! c39c590aaa4356d5b403bc01b7783823  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-cmp-1.c
! c5f278f4dccfd134d9a3e2aa2a67703d  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-fma-1.c
! 57227ba784085be4629883789ed368bc  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-operations-1.c
! 76ee3b70f25c64cb9b951d654c13073e  gcc/testsuite/gcc.target/i386/avx10_2-bf16-vector-smaxmin-1.c
  417ab35ed9008afe2f322f93299c12d8  gcc/testsuite/gcc.target/i386/avx10_2-builtin-1.c
  a2fc5a1576404e3c308cbd5c09c5efb0  gcc/testsuite/gcc.target/i386/avx10_2-builtin-2.c
  3e38bcafeb4d5b2f7bb1c52ababdf752  gcc/testsuite/gcc.target/i386/avx10_2-comibf-1.c
*************** a2fc5a1576404e3c308cbd5c09c5efb0  gcc/te
*** 74808,74879 ****
  ddae9e3f25193c53de97e445f19efb5b  gcc/testsuite/gcc.target/i386/avx10_2-comibf-4.c
  1ece947844abac5d130a2fef411986cf  gcc/testsuite/gcc.target/i386/avx10_2-compare-1.c
  3f6ccd6941e539ede6c35d45caf27eb0  gcc/testsuite/gcc.target/i386/avx10_2-compare-1b.c
! 3fa4c5ec2c06f34ee8a29f2f8cefa330  gcc/testsuite/gcc.target/i386/avx10_2-convert-1.c
! 69ae06d7a8759c6b89a5a382af22e912  gcc/testsuite/gcc.target/i386/avx10_2-media-1.c
! 4ce84262e79d77e58404c73de0474235  gcc/testsuite/gcc.target/i386/avx10_2-minmax-1.c
! e1de65e21c6c26d2fdf84a8e600776a2  gcc/testsuite/gcc.target/i386/avx10_2-movrs-1.c
  8e9e5ef765b7c16e78b36440c7cdc81f  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-fast-math-1.c
  4af5f36c571f416f48647ffb75a45045  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-fma-1.c
  060256f3db21d28f61a90f026c37c557  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-operations-1.c
  fa1d703c5c27e1abbf55a158e4d6ee34  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-smaxmin-1.c
! d3b2e3b222506f251ae193405f6e6f11  gcc/testsuite/gcc.target/i386/avx10_2-satcvt-1.c
! 250f1760735592622b647d89908ad24b  gcc/testsuite/gcc.target/i386/avx10_2-vaddbf16-2.c
! 4bd1c7ec61e15679b46b7762ad78309b  gcc/testsuite/gcc.target/i386/avx10_2-vcmpbf16-2.c
  30ba0b108963355c7d6479e5a7a140f7  gcc/testsuite/gcc.target/i386/avx10_2-vcomisbf16-1.c
  42318f176ca12752055da19f248404c5  gcc/testsuite/gcc.target/i386/avx10_2-vcomisbf16-2.c
! efbacbd1e5e86199ddc98826c83e9c29  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2bf8-2.c
! 0e6a0be2c12eb0de3cd51c9c60051bc9  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2bf8s-2.c
! 8c31a27e7cbc4b1d4a238158d9aeafa8  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2hf8-2.c
! 2e75e3881d49d00ea35111aedd32ae29  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2hf8s-2.c
! d986e76532bccf30f316290f3949faa4  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ps2phx-2.c
! 65ef6f13a6afde999322bfe242d0e026  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbf162ibs-2.c
! 09e4572cc342de9523f4ababbe54a907  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbf162iubs-2.c
! cfbfb35c1f1d71854c2575d129fd9e66  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2bf8-2.c
! 56c28b73cbacb21fad6cacff801d0b63  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2bf8s-2.c
! f6fff3853a1311c5fbe4820b7162cff3  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2hf8-2.c
! ce0dafa59b682a7b3093394e8bad5043  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2hf8s-2.c
! d732d1504a431a42c0faf7c294abffb1  gcc/testsuite/gcc.target/i386/avx10_2-vcvthf82ph-2.c
! d7d29d47a65f4892357274a248f3ae64  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2bf8-2.c
! 3e5fb0a326927149fda3a530654b3bb1  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2bf8s-2.c
! 386078aa1ae6302d7faf1b0b671595d2  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2hf8-2.c
! c01eea3f0fb3fdd1560af8e0549d1049  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2hf8s-2.c
! 10a2f507db2398fc42b1ba21dbc3ddd2  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2ibs-2.c
! 80e1612c08d6221892c3414db94be002  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2iubs-2.c
! afd9804542806888860d58ae54c7ea5d  gcc/testsuite/gcc.target/i386/avx10_2-vcvtps2ibs-2.c
! 187d922680fd34d267d7cbb49e1d5c05  gcc/testsuite/gcc.target/i386/avx10_2-vcvtps2iubs-2.c
! 596b98c3cda1fc7f54405c60bbe1f4ae  gcc/testsuite/gcc.target/i386/avx10_2-vcvttbf162ibs-2.c
! f1b9b0211f28f30f8c01361b4d9bdb7b  gcc/testsuite/gcc.target/i386/avx10_2-vcvttbf162iubs-2.c
! 8c499b4796c44a71a4cb197e3d9e185f  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2dqs-2.c
! a9e78cc0e34be38115a8b330a56b48cb  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2qqs-2.c
! a28f8c41f107710c81cd0c250bfc1769  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2udqs-2.c
! 1a13afa5f46126b5efd4a4da74e876cb  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2uqqs-2.c
! 43c1f8e7ba66207ce2a1b14ed5ec2400  gcc/testsuite/gcc.target/i386/avx10_2-vcvttph2ibs-2.c
! 8d0d6b2bd9c0612e1b55cd88968fa34d  gcc/testsuite/gcc.target/i386/avx10_2-vcvttph2iubs-2.c
! 112ec553910ef8854d231d9734189a05  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2dqs-2.c
! f3973129326216c8289fbdbe91b33fd3  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2ibs-2.c
! d3ed8196ad563fbc3d46be10a2338edf  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2iubs-2.c
! fe3c4a512a363ecc21b7c7ee9039c155  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2qqs-2.c
! 62955af6722434b3207f39def0bb610f  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2udqs-2.c
! a49f26f11a398855b3adddeca3d0b29c  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2uqqs-2.c
  c6807ff38360f668f9e6278bb27e0426  gcc/testsuite/gcc.target/i386/avx10_2-vcvttsd2sis-2.c
  6d266ca5f0f721f4a17c5fba5e125c50  gcc/testsuite/gcc.target/i386/avx10_2-vcvttsd2usis-2.c
  8284bb27463f26a72e548788421c3993  gcc/testsuite/gcc.target/i386/avx10_2-vcvttss2sis-2.c
  5d40c24472eeb67d6b0d664a1af3d4f0  gcc/testsuite/gcc.target/i386/avx10_2-vcvttss2usis-2.c
! 50afeccf5f2cb37370321b58795e497f  gcc/testsuite/gcc.target/i386/avx10_2-vdivbf16-2.c
! 7a635fe8231cd04fa3ae65cc232780c8  gcc/testsuite/gcc.target/i386/avx10_2-vdpphps-2.c
! ff386fbf7707a03ec637689e4f0a8bc4  gcc/testsuite/gcc.target/i386/avx10_2-vfmaddXXXbf16-2.c
! 2c71a4daf86567547716668495e7d8df  gcc/testsuite/gcc.target/i386/avx10_2-vfmsubXXXbf16-2.c
! 4d109c39ac8fb11304d996c3d0da4432  gcc/testsuite/gcc.target/i386/avx10_2-vfnmaddXXXbf16-2.c
! 403010950b9561eabcf37c87a0bfa0c5  gcc/testsuite/gcc.target/i386/avx10_2-vfnmsubXXXbf16-2.c
! 33dd14b26f1ca87fb8a4c9c97d6f0e23  gcc/testsuite/gcc.target/i386/avx10_2-vfpclassbf16-2.c
! c063f6289b350e11fce81ecb377f8e3e  gcc/testsuite/gcc.target/i386/avx10_2-vgetexpbf16-2.c
! 1648289c2be074499665dc823fd25a0b  gcc/testsuite/gcc.target/i386/avx10_2-vgetmantbf16-2.c
! e6f7d84899685ffa7e964a4cdd7f3d6a  gcc/testsuite/gcc.target/i386/avx10_2-vmaxbf16-2.c
! daf23e2b0398a7af325c4e7264e5bc16  gcc/testsuite/gcc.target/i386/avx10_2-vminbf16-2.c
! a9c1e32c8065268f0d03e7be38781eca  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxbf16-2.c
! 029119391053caf74484d8c864602c76  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxpd-2.c
! fe9416c35316c6742bd37b518e3f01f8  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxph-2.c
! bac4f34cd375ea90f366d6ed546e5d66  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxps-2.c
  77471989e07bd8949f27b71812165198  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxsd-2.c
  14e503d314837d847a5df8e112535286  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxsh-2.c
  7497d95be6a9bab6d7fb2341ee3c7ff7  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxss-2.c
--- 80390,80512 ----
  ddae9e3f25193c53de97e445f19efb5b  gcc/testsuite/gcc.target/i386/avx10_2-comibf-4.c
  1ece947844abac5d130a2fef411986cf  gcc/testsuite/gcc.target/i386/avx10_2-compare-1.c
  3f6ccd6941e539ede6c35d45caf27eb0  gcc/testsuite/gcc.target/i386/avx10_2-compare-1b.c
! e847665a89849da89fbaae0fed8724e3  gcc/testsuite/gcc.target/i386/avx10_2-convert-1.c
! 9042f995d107933908f24b29657ef1f0  gcc/testsuite/gcc.target/i386/avx10_2-media-1.c
! 56990d02b87728c95a15573638ae1769  gcc/testsuite/gcc.target/i386/avx10_2-minmax-1.c
! 47a5dab35b2b917f1d4c5b6e477f6627  gcc/testsuite/gcc.target/i386/avx10_2-movrs-1.c
  8e9e5ef765b7c16e78b36440c7cdc81f  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-fast-math-1.c
  4af5f36c571f416f48647ffb75a45045  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-fma-1.c
  060256f3db21d28f61a90f026c37c557  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-operations-1.c
  fa1d703c5c27e1abbf55a158e4d6ee34  gcc/testsuite/gcc.target/i386/avx10_2-partial-bf16-vector-smaxmin-1.c
! ccadc66d0451b4914b207bb0c67f5f2a  gcc/testsuite/gcc.target/i386/avx10_2-satcvt-1.c
! 60a72d0c1e55bd425da17835c9d885cb  gcc/testsuite/gcc.target/i386/avx10_2-vaddbf16-2.c
! 43e4fed44125a0ba83d21beca0f9f0ea  gcc/testsuite/gcc.target/i386/avx10_2-vaddbf16-2.h
! 27f8b398de5197386cc63ecae500c030  gcc/testsuite/gcc.target/i386/avx10_2-vcmpbf16-2.c
! 7fc6990f79d3960f3bf970300cdda824  gcc/testsuite/gcc.target/i386/avx10_2-vcmpbf16-2.h
  30ba0b108963355c7d6479e5a7a140f7  gcc/testsuite/gcc.target/i386/avx10_2-vcomisbf16-1.c
  42318f176ca12752055da19f248404c5  gcc/testsuite/gcc.target/i386/avx10_2-vcomisbf16-2.c
! 087d6ef1b54e53ad09215f3f65203f74  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2bf8-2.c
! 3ad0167e77c0598f3ead0d68f18512ee  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2bf8-2.h
! a08bc96d0cbeb4738a8e063bc906d0e8  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2bf8s-2.c
! 28cb2689cc8618525f3696051f942d11  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2bf8s-2.h
! fcaf642da0f609b1d7fdad467c42dd94  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2hf8-2.c
! f51f3ca73895adb5a0d577d37c1e2d56  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2hf8-2.h
! b6a64ad87bd50266f9206d43e597cec6  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2hf8s-2.c
! 05f7db9ce125c23efa051fbd7d4a7608  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ph2hf8s-2.h
! 082aa07e7a1c5d06adb54752a93a810c  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ps2phx-2.c
! 4d51f1ed31b839c1757a3c57fb945534  gcc/testsuite/gcc.target/i386/avx10_2-vcvt2ps2phx-2.h
! a50a7452e788936499597d2cee77d30e  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbf162ibs-2.c
! 988ee4bb97c458f4d5cbe3d5ed364f1d  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbf162ibs-2.h
! 6597046ef03ba0e08c21545639994af2  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbf162iubs-2.c
! cbbfdba14e906608ac3fb692d563bc17  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbf162iubs-2.h
! c0882cd192cf6d66491fd7645e06463e  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2bf8-2.c
! d2200a204130188d6f15c620a638f367  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2bf8-2.h
! b69ceaff7375c3c96328fdc6a1b7fe62  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2bf8s-2.c
! cb75b6699558a0beffa3de6ae51c1042  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2bf8s-2.h
! baf4b5b0fdbc82bb7fdc32f743a756e2  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2hf8-2.c
! 48af39a11563329ac6c59e5ecb1dfbc3  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2hf8-2.h
! 01aeef5a0f5c1490b5f6ba5117f04494  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2hf8s-2.c
! 1586e05e14215ee4a6286517ff05b3f8  gcc/testsuite/gcc.target/i386/avx10_2-vcvtbiasph2hf8s-2.h
! cefbbbc9b90a66ba495bd6a04eab8315  gcc/testsuite/gcc.target/i386/avx10_2-vcvthf82ph-2.c
! 1788001cd25d7ad8a605aceb9c6a76d0  gcc/testsuite/gcc.target/i386/avx10_2-vcvthf82ph-2.h
! f5fc2942d665a9cb04089c4350cc46c0  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2bf8-2.c
! 59b0cd9b0dc818cb603e207f3004a047  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2bf8-2.h
! 712f8d8afd5fcbb49cc402c519270130  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2bf8s-2.c
! 62491607ef39187e74da7b10fcd9cacd  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2bf8s-2.h
! 427e087799f9777a6838f829e28f0621  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2hf8-2.c
! 38771ff846bdbcb6a5d07630616c00f5  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2hf8-2.h
! f097508ec9ccd5b2b675fd493a885c23  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2hf8s-2.c
! 9bbf0833f624f212db0540c20f8a3d74  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2hf8s-2.h
! 09d9e790a450b72b34e6f2950c06bf88  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2ibs-2.c
! 570830f44c134adbad40bcf5b24e4699  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2ibs-2.h
! cec06a6942d3109583bc6cd478bb2cf2  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2iubs-2.c
! f20f760e25b65ebef1394990a82144d9  gcc/testsuite/gcc.target/i386/avx10_2-vcvtph2iubs-2.h
! 65ff536a2511e0687c91cc2091722421  gcc/testsuite/gcc.target/i386/avx10_2-vcvtps2ibs-2.c
! 16d614e5bc3f6fb8757e90b4ff33d712  gcc/testsuite/gcc.target/i386/avx10_2-vcvtps2ibs-2.h
! dd0dee06e7b8d50569762e3582114577  gcc/testsuite/gcc.target/i386/avx10_2-vcvtps2iubs-2.c
! 440a4dff055784e8eda50092c00c1c86  gcc/testsuite/gcc.target/i386/avx10_2-vcvtps2iubs-2.h
! ccff87639d00d3d3d62b5c3281e53d20  gcc/testsuite/gcc.target/i386/avx10_2-vcvttbf162ibs-2.c
! 5f3f75daaa7bd9582716285ada4db591  gcc/testsuite/gcc.target/i386/avx10_2-vcvttbf162ibs-2.h
! eb00e1976a448df8b28636f5e4a08c70  gcc/testsuite/gcc.target/i386/avx10_2-vcvttbf162iubs-2.c
! 718d67bedc62bc346916f918233b79cd  gcc/testsuite/gcc.target/i386/avx10_2-vcvttbf162iubs-2.h
! 4c10ce453fca8e3372cfca5265d8c460  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2dqs-2.c
! b9632b7163f804dae730a5c86a6c48e7  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2dqs-2.h
! b08d3b1dc4487f1d32b1e108f5083ef5  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2qqs-2.c
! ed46b5ebd7c6863e5b1fc01b51641e01  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2qqs-2.h
! 24c0ce1212780018b83f83e3345fb886  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2udqs-2.c
! ce232f8173db76fe23c7dc1d15e62d71  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2udqs-2.h
! 178cea34fdfdbcace9d05de431dcd0a7  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2uqqs-2.c
! 508f4995409e18bd5b5f0cd1ac0f314a  gcc/testsuite/gcc.target/i386/avx10_2-vcvttpd2uqqs-2.h
! cbd720df9ac52d2af7be56df1518770f  gcc/testsuite/gcc.target/i386/avx10_2-vcvttph2ibs-2.c
! 141cecbb8ac35ce4f9329d23f2538a5d  gcc/testsuite/gcc.target/i386/avx10_2-vcvttph2ibs-2.h
! 76c97f34c5f1e26ded2d15f7ffa5c78f  gcc/testsuite/gcc.target/i386/avx10_2-vcvttph2iubs-2.c
! 44ca9d64f1f580ee475f5c9418702504  gcc/testsuite/gcc.target/i386/avx10_2-vcvttph2iubs-2.h
! cc15f7cb4c1f077d7fb2c5af2bb461ec  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2dqs-2.c
! 3119af5f4deb30d04ae5907066f281b3  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2dqs-2.h
! 911a1ef4ea4b027e3128f4f75d178e3d  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2ibs-2.c
! 77d97258e9706e3a7adda1d0c991799b  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2ibs-2.h
! 0c1ecbc8dc1d491a898aec2161718e6a  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2iubs-2.c
! 6a6a08d6248803b7a4ec5e88df3237d9  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2iubs-2.h
! 0681f1f9de0a51159854ee23051536c0  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2qqs-2.c
! d6c5f8d6bcd2215dbaa518a3351581f4  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2qqs-2.h
! 97664ccc3beabd09508caa9137349ebc  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2udqs-2.c
! 12364e518a227dbd31e6ce1744642aac  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2udqs-2.h
! 30a6aa249b4357647f01e69326ad93e8  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2uqqs-2.c
! 66f380c97c90f0da171e96425c47f274  gcc/testsuite/gcc.target/i386/avx10_2-vcvttps2uqqs-2.h
  c6807ff38360f668f9e6278bb27e0426  gcc/testsuite/gcc.target/i386/avx10_2-vcvttsd2sis-2.c
  6d266ca5f0f721f4a17c5fba5e125c50  gcc/testsuite/gcc.target/i386/avx10_2-vcvttsd2usis-2.c
  8284bb27463f26a72e548788421c3993  gcc/testsuite/gcc.target/i386/avx10_2-vcvttss2sis-2.c
  5d40c24472eeb67d6b0d664a1af3d4f0  gcc/testsuite/gcc.target/i386/avx10_2-vcvttss2usis-2.c
! 87787fc9535c769257b4b540caa37165  gcc/testsuite/gcc.target/i386/avx10_2-vdivbf16-2.c
! 6f039130c9482c42a257b6372c76ac81  gcc/testsuite/gcc.target/i386/avx10_2-vdivbf16-2.h
! b13ab1a7a5a5df77adcb5d2f247472c1  gcc/testsuite/gcc.target/i386/avx10_2-vdpphps-2.c
! 8e291933e9ad209435c9b999fff5c9c5  gcc/testsuite/gcc.target/i386/avx10_2-vdpphps-2.h
! d54a627dbe38964bad115644fc3c6068  gcc/testsuite/gcc.target/i386/avx10_2-vfmaddXXXbf16-2.c
! e3dfcb91bb1cca3a72c2f5b777a3659b  gcc/testsuite/gcc.target/i386/avx10_2-vfmaddXXXbf16-2.h
! bef9b863308159df96d3a996cedb5082  gcc/testsuite/gcc.target/i386/avx10_2-vfmsubXXXbf16-2.c
! 1049f5684cefde13a9a99484a2de3bf9  gcc/testsuite/gcc.target/i386/avx10_2-vfmsubXXXbf16-2.h
! 7ca56f983a06d41747df4bbd27b7dfb0  gcc/testsuite/gcc.target/i386/avx10_2-vfnmaddXXXbf16-2.c
! 78de40999e2ed817a9f305e0614dde36  gcc/testsuite/gcc.target/i386/avx10_2-vfnmaddXXXbf16-2.h
! dedd05050052f96acff506caabc00d9d  gcc/testsuite/gcc.target/i386/avx10_2-vfnmsubXXXbf16-2.c
! c615edbb5c2c4fe7ed8e1d738ed2666b  gcc/testsuite/gcc.target/i386/avx10_2-vfnmsubXXXbf16-2.h
! 3715b5b12d74562d942a1968b898f443  gcc/testsuite/gcc.target/i386/avx10_2-vfpclassbf16-2.c
! 94a4f60c6c43931ab643a10c73e7cc74  gcc/testsuite/gcc.target/i386/avx10_2-vfpclassbf16-2.h
! d83d717d3bb4a1ad4929e3d8d79b4cfd  gcc/testsuite/gcc.target/i386/avx10_2-vgetexpbf16-2.c
! 42419a1dc6be8cfd24f2894a99e5be92  gcc/testsuite/gcc.target/i386/avx10_2-vgetexpbf16-2.h
! b6c2c306607906c05ab5c498ada5fb7e  gcc/testsuite/gcc.target/i386/avx10_2-vgetmantbf16-2.c
! 7e4f10fb3ae891a032405ccf0dc65f11  gcc/testsuite/gcc.target/i386/avx10_2-vgetmantbf16-2.h
! 36bee00f18a57f05293e3b240342188a  gcc/testsuite/gcc.target/i386/avx10_2-vmaxbf16-2.c
! 156076023bb7eccbe8fc24b880b5e7a1  gcc/testsuite/gcc.target/i386/avx10_2-vmaxbf16-2.h
! cfd0235428ba0ab4e842cd7fb0f52f49  gcc/testsuite/gcc.target/i386/avx10_2-vminbf16-2.c
! dc5d435a9a8dc8e42a9dce74bc2c60e7  gcc/testsuite/gcc.target/i386/avx10_2-vminbf16-2.h
! 4bd791d7ed4aa180aa8eaeb043996add  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxbf16-2.c
! b34f9d45344f55b01226cab39472944c  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxbf16-2.h
! c87dad5c42e32a5cd16b0b6f937ec15e  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxpd-2.c
! 5bbdf8aeb3fb318a92b9ff11fb7050a2  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxpd-2.h
! 53d5516acafb789682505a8ff031f2cd  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxph-2.c
! 9dfbacd161bb640eed238d06c60ceb97  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxph-2.h
! e1cad27d2c6e4987f5342d56b842c447  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxps-2.c
! 6c0d16ecdcf5c19a25d18cbaf45b8b83  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxps-2.h
  77471989e07bd8949f27b71812165198  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxsd-2.c
  14e503d314837d847a5df8e112535286  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxsh-2.c
  7497d95be6a9bab6d7fb2341ee3c7ff7  gcc/testsuite/gcc.target/i386/avx10_2-vminmaxss-2.c
*************** bac4f34cd375ea90f366d6ed546e5d66  gcc/te
*** 74881,74907 ****
  d682e01b540647186d3c16704c41bdcb  gcc/testsuite/gcc.target/i386/avx10_2-vmovd-2.c
  89612920a4714e332291ac058dbabc2a  gcc/testsuite/gcc.target/i386/avx10_2-vmovw-1.c
  2742c5152774466fc6c04fdf314c3dcd  gcc/testsuite/gcc.target/i386/avx10_2-vmovw-2.c
! 2ef9ffa3024e2f37fdacc1474b594ed3  gcc/testsuite/gcc.target/i386/avx10_2-vmpsadbw-2.c
! a851d1af6e17f5d09aca6ec8387ab81b  gcc/testsuite/gcc.target/i386/avx10_2-vmulbf16-2.c
! 8dcd48a3707535bb80ff9da01015e86a  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbssd-2.c
! 90e7892c4314345a06b4c531498d142a  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbssds-2.c
! b192f2e2a53227cce2068b73d792b62f  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbsud-2.c
! 565d84f7d7c9f773fa77ed374023e747  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbsuds-2.c
! eac45237bdbd9f0d9df4724885d81456  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbuud-2.c
! 08b2bec883ff6b41f2b653f3e57f99a9  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbuuds-2.c
! 3d72a093d5dae735f84963e2bd2d4df5  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwsud-2.c
! 2c532c94d3133e391e9aaee722d371ce  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwsuds-2.c
! cf423a3377bf384cfcc0f48a07238770  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwusd-2.c
! 1839315f68c98be1b4400e7b257c0c6c  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwusds-2.c
! 8d617c8bd0c2c94cf33d923f1ab252b0  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwuud-2.c
! e7c3c71889fc724efd80d122fe31b8c9  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwuuds-2.c
! fd208a95263c19bcec42b0bbc3901da0  gcc/testsuite/gcc.target/i386/avx10_2-vrcpbf16-2.c
! 3b1d2af1799e28e5703acd7c9f0dca05  gcc/testsuite/gcc.target/i386/avx10_2-vreducebf16-2.c
! 661381f2194b009623c4e2acd2730013  gcc/testsuite/gcc.target/i386/avx10_2-vrndscalebf16-2.c
! c0488c5a521cc1841d3c1b743e06f389  gcc/testsuite/gcc.target/i386/avx10_2-vrsqrtbf16-2.c
! 4849c537e99ade3739b53858f5338aea  gcc/testsuite/gcc.target/i386/avx10_2-vscalefbf16-2.c
! 74006c02c7e65781d253063e2649ce9f  gcc/testsuite/gcc.target/i386/avx10_2-vsqrtbf16-2.c
! afc870575b52798b7f7f683850686b45  gcc/testsuite/gcc.target/i386/avx10_2-vsubbf16-2.c
  c1ebd833400b4f1e9d74b7929ccecdb6  gcc/testsuite/gcc.target/i386/avx2-bf16-vec-absneg.c
  a5901d33285892facee8dbfe287ce0d1  gcc/testsuite/gcc.target/i386/avx2-broadcast-pr87767-1.c
  958690bb20e5ef6d9a38def7eb976f13  gcc/testsuite/gcc.target/i386/avx2-check.h
--- 80514,80561 ----
  d682e01b540647186d3c16704c41bdcb  gcc/testsuite/gcc.target/i386/avx10_2-vmovd-2.c
  89612920a4714e332291ac058dbabc2a  gcc/testsuite/gcc.target/i386/avx10_2-vmovw-1.c
  2742c5152774466fc6c04fdf314c3dcd  gcc/testsuite/gcc.target/i386/avx10_2-vmovw-2.c
! 4c185b3c7e8429c94b956f5dd282b361  gcc/testsuite/gcc.target/i386/avx10_2-vmpsadbw-2.c
! 46b3fee4fea97a0caee0bbb6b4d21ba2  gcc/testsuite/gcc.target/i386/avx10_2-vmpsadbw-2.h
! 10966d11c24867abe111c2bf5ad3342f  gcc/testsuite/gcc.target/i386/avx10_2-vmulbf16-2.c
! d26aef734e27572eec31a17f52e67054  gcc/testsuite/gcc.target/i386/avx10_2-vmulbf16-2.h
! 28a72ee93672835273fea2a4347022f3  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbssd-2.c
! c7956203821e5cbe924c65a71b624c9f  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbssd-2.h
! 8c0f87411cc41cf223c4949573a4521f  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbssds-2.c
! 6d209ff7a7cc8c334f6e1a5c56a740e8  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbssds-2.h
! bc5818e4593d8e1cd64266c53777708e  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbsud-2.c
! d3c0bdc863c1c82ab0899d796e2607b9  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbsud-2.h
! 61ae362f554facf5ba290271f061a185  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbsuds-2.c
! ee1a7aa351b5791697b30a7c9f16c9f7  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbsuds-2.h
! 4825ad7e9eedeb3faba3746c1ce0703b  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbuud-2.c
! 407fa0e9d3a035bb86ab4e8e844564d9  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbuud-2.h
! b82ac21bf78df34cf723350526d2bf3b  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbuuds-2.c
! 2878b93e97c0378ac10c24a8373277e1  gcc/testsuite/gcc.target/i386/avx10_2-vpdpbuuds-2.h
! 3055af754174cfc9846fccafefe3d2e7  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwsud-2.c
! 8da8ae7d1c2e2496c0ea84e1fcdfefc2  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwsud-2.h
! a1448bedbc24ad20094b650b8e2ad6c8  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwsuds-2.c
! 3a9c007bfc4eb4ff3330b1a98108b07b  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwsuds-2.h
! 1b4511f37ee127f2832433a7f6d0c60f  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwusd-2.c
! bffe354b3df715e392e01db70d9bcafd  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwusd-2.h
! 8375d5f045e0c247a9877a606a89dd3c  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwusds-2.c
! ad21736395b493c2017dfdabbe045b7c  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwusds-2.h
! 031388b1ae90f9dc3f742324c91933b3  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwuud-2.c
! f52d3a4f104a55cf12089092c1daada5  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwuud-2.h
! 80a2eb28638aa39e13be2f6ce163fe45  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwuuds-2.c
! a29e9de8c709dd9335f2bdfaba72f91a  gcc/testsuite/gcc.target/i386/avx10_2-vpdpwuuds-2.h
! 86e5fff12a3a052acb5273ec076a8eba  gcc/testsuite/gcc.target/i386/avx10_2-vrcpbf16-2.c
! 46b0829ee8b09cea761d62e4d77e9d4a  gcc/testsuite/gcc.target/i386/avx10_2-vrcpbf16-2.h
! a914626199d6837b939d2d9c6724238f  gcc/testsuite/gcc.target/i386/avx10_2-vreducebf16-2.c
! 4a6731fb6fc8f9df24503262433a7482  gcc/testsuite/gcc.target/i386/avx10_2-vreducebf16-2.h
! 5adeedd4d6bc9c16a19620328952d079  gcc/testsuite/gcc.target/i386/avx10_2-vrndscalebf16-2.c
! 159889c9d12a553e6ae1fa0aa856ffad  gcc/testsuite/gcc.target/i386/avx10_2-vrndscalebf16-2.h
! bcd2f6f9d563c1dca35e0919942afb93  gcc/testsuite/gcc.target/i386/avx10_2-vrsqrtbf16-2.c
! f9e28d77b89c8949143aa8c2481886cc  gcc/testsuite/gcc.target/i386/avx10_2-vrsqrtbf16-2.h
! 776caafae159ccdafba686a89c347773  gcc/testsuite/gcc.target/i386/avx10_2-vscalefbf16-2.c
! 499fd99f0a48c0a34d1690877d19c200  gcc/testsuite/gcc.target/i386/avx10_2-vscalefbf16-2.h
! 17186562b12ebc9bda08d4a4b0dab822  gcc/testsuite/gcc.target/i386/avx10_2-vsqrtbf16-2.c
! d81413b6a389b9c429c81094c74985f1  gcc/testsuite/gcc.target/i386/avx10_2-vsqrtbf16-2.h
! 4425ec7a194a3f48dfc1626cf127f5ff  gcc/testsuite/gcc.target/i386/avx10_2-vsubbf16-2.c
! ca61a759f79aa371e5752cff3c0b6ee2  gcc/testsuite/gcc.target/i386/avx10_2-vsubbf16-2.h
  c1ebd833400b4f1e9d74b7929ccecdb6  gcc/testsuite/gcc.target/i386/avx2-bf16-vec-absneg.c
  a5901d33285892facee8dbfe287ce0d1  gcc/testsuite/gcc.target/i386/avx2-broadcast-pr87767-1.c
  958690bb20e5ef6d9a38def7eb976f13  gcc/testsuite/gcc.target/i386/avx2-check.h
*************** f783e66b09f316c2dde663ba5ce3186a  gcc/te
*** 76016,76022 ****
  b38a9c14f87367c694a03c6a85cda093  gcc/testsuite/gcc.target/i386/avx512f-gf2p8affineinvqb-2.c
  e8ed6420b94ba8e4f884b1fed3192afb  gcc/testsuite/gcc.target/i386/avx512f-gf2p8affineqb-2.c
  fbf4c4e93ebbba4e4057d944ad324b7b  gcc/testsuite/gcc.target/i386/avx512f-gf2p8mulb-2.c
! 20288e33f34e2901f9a88eafa9f5ef5b  gcc/testsuite/gcc.target/i386/avx512f-helper.h
  bc1e264d74393600ad6c3dc8e5f9a8c1  gcc/testsuite/gcc.target/i386/avx512f-i32gatherd512-1.c
  970def87f940562db570ac590860c040  gcc/testsuite/gcc.target/i386/avx512f-i32gatherd512-2.c
  368e993e6c8f94205fcb74a268d08265  gcc/testsuite/gcc.target/i386/avx512f-i32gatherpd512-1.c
--- 81670,81676 ----
  b38a9c14f87367c694a03c6a85cda093  gcc/testsuite/gcc.target/i386/avx512f-gf2p8affineinvqb-2.c
  e8ed6420b94ba8e4f884b1fed3192afb  gcc/testsuite/gcc.target/i386/avx512f-gf2p8affineqb-2.c
  fbf4c4e93ebbba4e4057d944ad324b7b  gcc/testsuite/gcc.target/i386/avx512f-gf2p8mulb-2.c
! fe1e00fcba271e150aabe139bea9210e  gcc/testsuite/gcc.target/i386/avx512f-helper.h
  bc1e264d74393600ad6c3dc8e5f9a8c1  gcc/testsuite/gcc.target/i386/avx512f-i32gatherd512-1.c
  970def87f940562db570ac590860c040  gcc/testsuite/gcc.target/i386/avx512f-i32gatherd512-2.c
  368e993e6c8f94205fcb74a268d08265  gcc/testsuite/gcc.target/i386/avx512f-i32gatherpd512-1.c
*************** e5188370fac870f1044da14bdbfa0928  gcc/te
*** 79082,79088 ****
  42bd97eb7c2cc9b7ea74515a0c4cf3ce  gcc/testsuite/gcc.target/i386/no-callee-saved-13.c
  ce847ee191adcc1a562b86eae8463fe1  gcc/testsuite/gcc.target/i386/no-callee-saved-14.c
  28070df22cbeb8bdda40326e1f3db379  gcc/testsuite/gcc.target/i386/no-callee-saved-15.c
! e64677fd1b7c27d60addb63546c0ff37  gcc/testsuite/gcc.target/i386/no-callee-saved-16.c
  603a6e01b2f7a9cfee08f9a76db61c4a  gcc/testsuite/gcc.target/i386/no-callee-saved-17.c
  f6e04015c07dfdbd1fec397006546df4  gcc/testsuite/gcc.target/i386/no-callee-saved-18.c
  ad33c89265b5a7b8d4a875a0abf790b3  gcc/testsuite/gcc.target/i386/no-callee-saved-2.c
--- 84736,84742 ----
  42bd97eb7c2cc9b7ea74515a0c4cf3ce  gcc/testsuite/gcc.target/i386/no-callee-saved-13.c
  ce847ee191adcc1a562b86eae8463fe1  gcc/testsuite/gcc.target/i386/no-callee-saved-14.c
  28070df22cbeb8bdda40326e1f3db379  gcc/testsuite/gcc.target/i386/no-callee-saved-15.c
! 9204056c1841f39e08a93f36fd4f926c  gcc/testsuite/gcc.target/i386/no-callee-saved-16.c
  603a6e01b2f7a9cfee08f9a76db61c4a  gcc/testsuite/gcc.target/i386/no-callee-saved-17.c
  f6e04015c07dfdbd1fec397006546df4  gcc/testsuite/gcc.target/i386/no-callee-saved-18.c
  ad33c89265b5a7b8d4a875a0abf790b3  gcc/testsuite/gcc.target/i386/no-callee-saved-2.c
*************** b72976450abb440a20ee8bbbcbe9d3da  gcc/te
*** 79093,79101 ****
  cb75d1a0c9cbcc1ff35c0ebfc4521d0f  gcc/testsuite/gcc.target/i386/no-callee-saved-7.c
  d2d958ed5eb47397497845d4ec4608e7  gcc/testsuite/gcc.target/i386/no-callee-saved-8.c
  fcdd3649e1c0734d0e2c71c3b6a131b6  gcc/testsuite/gcc.target/i386/no-callee-saved-9.c
- 49a6b1b082b9b1d608b571058ca4a26f  gcc/testsuite/gcc.target/i386/noevex512-1.c
- 20b41d4460b82ac85bee07704906dd4b  gcc/testsuite/gcc.target/i386/noevex512-2.c
- d951ae4cc5d9c709635f329d67545205  gcc/testsuite/gcc.target/i386/noevex512-3.c
  d153cc65f8aad89fc3f4f976c1844c13  gcc/testsuite/gcc.target/i386/nop-mcount.c
  7554f6e1a30e3cc93f33dbad79fc2a68  gcc/testsuite/gcc.target/i386/noplt-1.c
  4db83aa123fc4bac669e5678c3fd01a8  gcc/testsuite/gcc.target/i386/noplt-2.c
--- 84747,84752 ----
*************** a631b59a82e0094f919cb4604edc35d2  gcc/te
*** 79447,79452 ****
--- 85098,85105 ----
  f7b20e275fb7245fb9757294a2d72c1f  gcc/testsuite/gcc.target/i386/pr103771-2.c
  94dae865f304453dfde03d14b8ace0cf  gcc/testsuite/gcc.target/i386/pr103771-3.c
  1d06b4793e0ec6ac430d52bd3ee6f986  gcc/testsuite/gcc.target/i386/pr103771-4.c
+ e0d248b981c3637733cd8ada0c6e7f2f  gcc/testsuite/gcc.target/i386/pr103771-5.c
+ a569933e8bd6c1c90234d58999b8264f  gcc/testsuite/gcc.target/i386/pr103771-6.c
  905c8c3d05e777381083e5dc308f6bbd  gcc/testsuite/gcc.target/i386/pr103771.c
  99c899ad45a3b907e5fe8f05e32242c4  gcc/testsuite/gcc.target/i386/pr103773-2.c
  339445d43abea93de6668ce9bec736ac  gcc/testsuite/gcc.target/i386/pr103773.c
*************** f41bcc9cec5b788807bebdd7850d9984  gcc/te
*** 79690,79696 ****
  19d501a9e83dcf447b7a20813cd5c63e  gcc/testsuite/gcc.target/i386/pr108832.c
  35b08fb233f8e50c79f9031224448ebb  gcc/testsuite/gcc.target/i386/pr108938-1.c
  f06baf49d6978c656ea587aa54eefe45  gcc/testsuite/gcc.target/i386/pr108938-2.c
! 15b6d653d8d25609a9f63a327a37419f  gcc/testsuite/gcc.target/i386/pr108938-3.c
  b2d87acf7076d3345828df49eb24d0c9  gcc/testsuite/gcc.target/i386/pr108938-load-1.c
  53491e3f538a93b51e92b8c8a03197c8  gcc/testsuite/gcc.target/i386/pr108938-load-2.c
  7bdb45a4703b69087f030127552f957b  gcc/testsuite/gcc.target/i386/pr109011-b1.c
--- 85343,85349 ----
  19d501a9e83dcf447b7a20813cd5c63e  gcc/testsuite/gcc.target/i386/pr108832.c
  35b08fb233f8e50c79f9031224448ebb  gcc/testsuite/gcc.target/i386/pr108938-1.c
  f06baf49d6978c656ea587aa54eefe45  gcc/testsuite/gcc.target/i386/pr108938-2.c
! 8dea94ca6cc3659102902173d8461c4d  gcc/testsuite/gcc.target/i386/pr108938-3.c
  b2d87acf7076d3345828df49eb24d0c9  gcc/testsuite/gcc.target/i386/pr108938-load-1.c
  53491e3f538a93b51e92b8c8a03197c8  gcc/testsuite/gcc.target/i386/pr108938-load-2.c
  7bdb45a4703b69087f030127552f957b  gcc/testsuite/gcc.target/i386/pr109011-b1.c
*************** f27b0d61fbaf16e0f8696c50b922015c  gcc/te
*** 79778,79784 ****
  b88aae0d24fb15cc43715836d9bf2c18  gcc/testsuite/gcc.target/i386/pr111023-4b.c
  060012033df7167c54831b5b28cf562c  gcc/testsuite/gcc.target/i386/pr111023-8b.c
  95fbcd7ddaac3c855e985835673182ac  gcc/testsuite/gcc.target/i386/pr111023.c
! 6c9044c726d79ed5847a7ee4c8b1465a  gcc/testsuite/gcc.target/i386/pr111068.c
  9f4b24b8710ca01983411725919ea553  gcc/testsuite/gcc.target/i386/pr111127.c
  ef802a25b2bc4b4b385b11e23da65eb7  gcc/testsuite/gcc.target/i386/pr111225.c
  c9065d2ec6fc0f6750fa18d0a76c0c4c  gcc/testsuite/gcc.target/i386/pr111228.c
--- 85431,85437 ----
  b88aae0d24fb15cc43715836d9bf2c18  gcc/testsuite/gcc.target/i386/pr111023-4b.c
  060012033df7167c54831b5b28cf562c  gcc/testsuite/gcc.target/i386/pr111023-8b.c
  95fbcd7ddaac3c855e985835673182ac  gcc/testsuite/gcc.target/i386/pr111023.c
! a5bdaa68446709fce2f8071ee1434f7d  gcc/testsuite/gcc.target/i386/pr111068.c
  9f4b24b8710ca01983411725919ea553  gcc/testsuite/gcc.target/i386/pr111127.c
  ef802a25b2bc4b4b385b11e23da65eb7  gcc/testsuite/gcc.target/i386/pr111225.c
  c9065d2ec6fc0f6750fa18d0a76c0c4c  gcc/testsuite/gcc.target/i386/pr111228.c
*************** b43e8c56c9033d4c1f8d39f742aab4d4  gcc/te
*** 79796,79803 ****
  603eaebdbc5d49ed79685f9993d08daa  gcc/testsuite/gcc.target/i386/pr111820-2.c
  a02b7dbda2cbde55631a6de0c782cb06  gcc/testsuite/gcc.target/i386/pr111820-3.c
  ca614dc6b270000921a424091862e6bc  gcc/testsuite/gcc.target/i386/pr111845.c
- 66086c14fee56da075b7ab9d5aee985a  gcc/testsuite/gcc.target/i386/pr111889.c
- f9775d524e5b6e1d82ccd6ac42fa6b61  gcc/testsuite/gcc.target/i386/pr111907.c
  6b5d4f53e8a1fd75a906e1a3cc1a449c  gcc/testsuite/gcc.target/i386/pr112276.c
  592fbf1f98a7c30e432c6c49c9e70ab3  gcc/testsuite/gcc.target/i386/pr112325-1.c
  ee7c876119a1d014a83f4ab835388676  gcc/testsuite/gcc.target/i386/pr112325-2.c
--- 85449,85454 ----
*************** bc6fa580d6a8811a7eb7c509c082a543  gcc/te
*** 79946,79954 ****
  5763922897de0d12d2de365c88086059  gcc/testsuite/gcc.target/i386/pr117232-1.c
  e6569d31b927738f61f381656212fbdc  gcc/testsuite/gcc.target/i386/pr117232-apx-1.c
  049c599477a9b98ba1a335deaee5dc79  gcc/testsuite/gcc.target/i386/pr117240_avx.c
! 479a22e091d361b8f0ed8a3d2e44011f  gcc/testsuite/gcc.target/i386/pr117240_avx512f.c
  da692b8fe7fe8e3d33b45f3f919da356  gcc/testsuite/gcc.target/i386/pr117296.c
- 76054ad9340260b4fea8af17fb6e67a6  gcc/testsuite/gcc.target/i386/pr117304-1.c
  917d3074e579c1fad9a86cf1657c1ab6  gcc/testsuite/gcc.target/i386/pr117318.c
  d9c36e68265950d44ce781ce1be85bf6  gcc/testsuite/gcc.target/i386/pr117357.c
  806f0e4354836aef875182ce5a2a2a6c  gcc/testsuite/gcc.target/i386/pr117416-1.c
--- 85597,85604 ----
  5763922897de0d12d2de365c88086059  gcc/testsuite/gcc.target/i386/pr117232-1.c
  e6569d31b927738f61f381656212fbdc  gcc/testsuite/gcc.target/i386/pr117232-apx-1.c
  049c599477a9b98ba1a335deaee5dc79  gcc/testsuite/gcc.target/i386/pr117240_avx.c
! 637caf64e5bf54243a2283b2ad4e6ad9  gcc/testsuite/gcc.target/i386/pr117240_avx512f.c
  da692b8fe7fe8e3d33b45f3f919da356  gcc/testsuite/gcc.target/i386/pr117296.c
  917d3074e579c1fad9a86cf1657c1ab6  gcc/testsuite/gcc.target/i386/pr117318.c
  d9c36e68265950d44ce781ce1be85bf6  gcc/testsuite/gcc.target/i386/pr117357.c
  806f0e4354836aef875182ce5a2a2a6c  gcc/testsuite/gcc.target/i386/pr117416-1.c
*************** b3b074d0d46662a421a46ccd8c6a9024  gcc/te
*** 79970,79976 ****
  240efd923aa4bf46c4d60d1eb61f94ed  gcc/testsuite/gcc.target/i386/pr117860.c
  74ee7dbf306b8ed9f2be2b62f28be23e  gcc/testsuite/gcc.target/i386/pr117926.c
  e08bbff7cf306c118f15daf27a5ece77  gcc/testsuite/gcc.target/i386/pr117930.c
! 20511f0fd6ca86a102c88f9c3065d7a3  gcc/testsuite/gcc.target/i386/pr117946.c
  8b0416c9d908a38bb16eb178f241f986  gcc/testsuite/gcc.target/i386/pr118017.c
  ee3d5d61e5865da192e05b0bf8d281a4  gcc/testsuite/gcc.target/i386/pr118067-2.c
  209b6dcc04de9e64a22573859477e524  gcc/testsuite/gcc.target/i386/pr118067.c
--- 85620,85626 ----
  240efd923aa4bf46c4d60d1eb61f94ed  gcc/testsuite/gcc.target/i386/pr117860.c
  74ee7dbf306b8ed9f2be2b62f28be23e  gcc/testsuite/gcc.target/i386/pr117926.c
  e08bbff7cf306c118f15daf27a5ece77  gcc/testsuite/gcc.target/i386/pr117930.c
! c8bdea6c9ffbbf9001f21d299c7e8460  gcc/testsuite/gcc.target/i386/pr117946.c
  8b0416c9d908a38bb16eb178f241f986  gcc/testsuite/gcc.target/i386/pr118017.c
  ee3d5d61e5865da192e05b0bf8d281a4  gcc/testsuite/gcc.target/i386/pr118067-2.c
  209b6dcc04de9e64a22573859477e524  gcc/testsuite/gcc.target/i386/pr118067.c
*************** e7f6a568e551d3786797d6f56294b949  gcc/te
*** 80009,80014 ****
--- 85659,85666 ----
  b8172e9b0b80f9484c5df81036fc03af  gcc/testsuite/gcc.target/i386/pr118815.c
  0f3590e2e1a5ad51d95272730fbebe25  gcc/testsuite/gcc.target/i386/pr118936.c
  a29824de389210a43ed1b8d66fd67fc4  gcc/testsuite/gcc.target/i386/pr118940.c
+ 72b11cb5abc3f7bc24cf668f7c6c133c  gcc/testsuite/gcc.target/i386/pr118994-1.c
+ e2c348310fb018fd99488d16afdd02a4  gcc/testsuite/gcc.target/i386/pr118994-2.c
  9535f883e80c112c73ae6e362946da10  gcc/testsuite/gcc.target/i386/pr119103.c
  bd75c2f2962774fbfe5a6a6007998c0b  gcc/testsuite/gcc.target/i386/pr119171-1.c
  ccbd1332987abb6ae1d43a2bbd8cc701  gcc/testsuite/gcc.target/i386/pr119171-2.c
*************** bb420ee68e25b3f2c223a9b99a8e7c79  gcc/te
*** 80024,80029 ****
--- 85676,85682 ----
  038406363ec46be9b531268d03546b94  gcc/testsuite/gcc.target/i386/pr119784b.c
  940e784d589973675da003c24eabc2ee  gcc/testsuite/gcc.target/i386/pr119919.c
  0a65f7a12fa8d04fa79c2af4b21b5f14  gcc/testsuite/gcc.target/i386/pr120031.c
+ dd47421a141f36dc244e35b0237335f0  gcc/testsuite/gcc.target/i386/pr120360.c
  b03b1d817538a863277c823b5e4cdf75  gcc/testsuite/gcc.target/i386/pr12092-1.c
  f99f88a6e994ad6e55e065e41bc58f8f  gcc/testsuite/gcc.target/i386/pr12329.c
  8951a1fa31f2d45ef9eacfff6a733f77  gcc/testsuite/gcc.target/i386/pr13366.c
*************** dcfc47d5c6f74562228eb399293c4bc5  gcc/te
*** 80094,80100 ****
  86281a53df1b24c8068e4bf1b184d74b  gcc/testsuite/gcc.target/i386/pr31628.c
  5ce3efb86f23dc0eae07a9a326f046aa  gcc/testsuite/gcc.target/i386/pr31799.c
  9131ed1be82a4a4fecdc9d0aa2021134  gcc/testsuite/gcc.target/i386/pr31854.c
! d8f0d132b6babb11136a862b1d0d3d15  gcc/testsuite/gcc.target/i386/pr31985.c
  dfd05b1f491f52c6fed332039ead357a  gcc/testsuite/gcc.target/i386/pr32000-1.c
  a07b3ac10c2e8d8960d5f94aacc75325  gcc/testsuite/gcc.target/i386/pr32000-2.c
  9b916b67c68cce873259ce7198b6593b  gcc/testsuite/gcc.target/i386/pr32065-1.c
--- 85747,85753 ----
  86281a53df1b24c8068e4bf1b184d74b  gcc/testsuite/gcc.target/i386/pr31628.c
  5ce3efb86f23dc0eae07a9a326f046aa  gcc/testsuite/gcc.target/i386/pr31799.c
  9131ed1be82a4a4fecdc9d0aa2021134  gcc/testsuite/gcc.target/i386/pr31854.c
! 723f65b70ac04de211e2805093263e39  gcc/testsuite/gcc.target/i386/pr31985.c
  dfd05b1f491f52c6fed332039ead357a  gcc/testsuite/gcc.target/i386/pr32000-1.c
  a07b3ac10c2e8d8960d5f94aacc75325  gcc/testsuite/gcc.target/i386/pr32000-2.c
  9b916b67c68cce873259ce7198b6593b  gcc/testsuite/gcc.target/i386/pr32065-1.c
*************** adae3156ab4e2f317ef6a23cbd52a09e  gcc/te
*** 81513,81519 ****
  61421458c0cd694e7f45d147f09c71dd  gcc/testsuite/gcc.target/i386/pr89984-1.c
  4675458af6efdc7039a76f2ca0824f6a  gcc/testsuite/gcc.target/i386/pr89984-2.c
  0fde4fbe7c3ef420d3178fba128d51e7  gcc/testsuite/gcc.target/i386/pr90007.c
! 7110f728cfc3075095fa258ecfd05c36  gcc/testsuite/gcc.target/i386/pr90096.c
  289aed1294f4bdce79570370d9b37d36  gcc/testsuite/gcc.target/i386/pr90178.c
  c04294701860868605e6d4177d1f5a28  gcc/testsuite/gcc.target/i386/pr90193.c
  7201d75d66d22da420434866d606904c  gcc/testsuite/gcc.target/i386/pr90356.c
--- 87166,87172 ----
  61421458c0cd694e7f45d147f09c71dd  gcc/testsuite/gcc.target/i386/pr89984-1.c
  4675458af6efdc7039a76f2ca0824f6a  gcc/testsuite/gcc.target/i386/pr89984-2.c
  0fde4fbe7c3ef420d3178fba128d51e7  gcc/testsuite/gcc.target/i386/pr90007.c
! a7e4330876ef271143c6421ba5f2cf85  gcc/testsuite/gcc.target/i386/pr90096.c
  289aed1294f4bdce79570370d9b37d36  gcc/testsuite/gcc.target/i386/pr90178.c
  c04294701860868605e6d4177d1f5a28  gcc/testsuite/gcc.target/i386/pr90193.c
  7201d75d66d22da420434866d606904c  gcc/testsuite/gcc.target/i386/pr90356.c
*************** a91c690a2baabf7fb9fbf56c14d88bed  gcc/te
*** 82062,82073 ****
  658cdfafdd75c9f80c598bb25abc395a  gcc/testsuite/gcc.target/i386/sm3rnds2-2.c
  527afc04ce7409a5918499d4e09fb6d0  gcc/testsuite/gcc.target/i386/sm4-1.c
  96338096e015f7193d0f7f10183421bd  gcc/testsuite/gcc.target/i386/sm4-avx10_2-1.c
! 3a918eebb60aa0527a09bf0eed85d46e  gcc/testsuite/gcc.target/i386/sm4-avx10_2-512-1.c
! 067ccc2a3bfd020bcb0aad6a5ea7bf81  gcc/testsuite/gcc.target/i386/sm4-check.h
  d3d755c099a0d9093b8e3e5488d4fca0  gcc/testsuite/gcc.target/i386/sm4key4-2.c
! c2dd89a35926b1700011ee749646e975  gcc/testsuite/gcc.target/i386/sm4key4-avx10_2-512-2.c
  aad85a16999958388a426758d91d43f4  gcc/testsuite/gcc.target/i386/sm4rnds4-2.c
! 8c0de90d52d1d031e1825c973b154a93  gcc/testsuite/gcc.target/i386/sm4rnds4-avx10_2-512-2.c
  577e5b7c826e6a9e098a6607865c5e41  gcc/testsuite/gcc.target/i386/smuldi3_highpart.c
  ced55c097c7540a16ac1207e0104aafd  gcc/testsuite/gcc.target/i386/spellcheck-options-1.c
  2e1cd127d43849d529e1e8543aaaba2b  gcc/testsuite/gcc.target/i386/spellcheck-options-2.c
--- 87715,87726 ----
  658cdfafdd75c9f80c598bb25abc395a  gcc/testsuite/gcc.target/i386/sm3rnds2-2.c
  527afc04ce7409a5918499d4e09fb6d0  gcc/testsuite/gcc.target/i386/sm4-1.c
  96338096e015f7193d0f7f10183421bd  gcc/testsuite/gcc.target/i386/sm4-avx10_2-1.c
! 3a918eebb60aa0527a09bf0eed85d46e  gcc/testsuite/gcc.target/i386/sm4-avx10_2-1b.c
! 11e02986892841c63086024b2e08ad24  gcc/testsuite/gcc.target/i386/sm4-check.h
  d3d755c099a0d9093b8e3e5488d4fca0  gcc/testsuite/gcc.target/i386/sm4key4-2.c
! 2114c85ba6940c59c3a11b0d40f7c767  gcc/testsuite/gcc.target/i386/sm4key4-avx10_2-2.c
  aad85a16999958388a426758d91d43f4  gcc/testsuite/gcc.target/i386/sm4rnds4-2.c
! fef15352d3c9af3d2ddf79a74ff8e219  gcc/testsuite/gcc.target/i386/sm4rnds4-avx10_2-2.c
  577e5b7c826e6a9e098a6607865c5e41  gcc/testsuite/gcc.target/i386/smuldi3_highpart.c
  ced55c097c7540a16ac1207e0104aafd  gcc/testsuite/gcc.target/i386/spellcheck-options-1.c
  2e1cd127d43849d529e1e8543aaaba2b  gcc/testsuite/gcc.target/i386/spellcheck-options-2.c
*************** cc8a162617784a2e883a5e726d28ebde  gcc/te
*** 82082,82089 ****
  31f7ce4356be3b5523e49df7d4ad0951  gcc/testsuite/gcc.target/i386/sse-10.c
  49bde97b271274cb2bc26697ce2b19be  gcc/testsuite/gcc.target/i386/sse-11.c
  58aa5102101cd1f9e6b419b54e47a748  gcc/testsuite/gcc.target/i386/sse-12.c
! e5c114215560332e795fd03d0774a1cf  gcc/testsuite/gcc.target/i386/sse-13.c
! 7c71fd55d9167a805cc0741d44086f93  gcc/testsuite/gcc.target/i386/sse-14.c
  92ad37b5ad7426d489b1b6f1ba0f41ea  gcc/testsuite/gcc.target/i386/sse-15.c
  2e7b115c4bd7984925f1a8d17a5faf67  gcc/testsuite/gcc.target/i386/sse-16.c
  f660e67b22cb44e6a6b38a247b1d78c3  gcc/testsuite/gcc.target/i386/sse-17.c
--- 87735,87742 ----
  31f7ce4356be3b5523e49df7d4ad0951  gcc/testsuite/gcc.target/i386/sse-10.c
  49bde97b271274cb2bc26697ce2b19be  gcc/testsuite/gcc.target/i386/sse-11.c
  58aa5102101cd1f9e6b419b54e47a748  gcc/testsuite/gcc.target/i386/sse-12.c
! 9be4cba80e78a06a46b561cc60fdef96  gcc/testsuite/gcc.target/i386/sse-13.c
! e0e664936ff3d81df772a35ce3120342  gcc/testsuite/gcc.target/i386/sse-14.c
  92ad37b5ad7426d489b1b6f1ba0f41ea  gcc/testsuite/gcc.target/i386/sse-15.c
  2e7b115c4bd7984925f1a8d17a5faf67  gcc/testsuite/gcc.target/i386/sse-16.c
  f660e67b22cb44e6a6b38a247b1d78c3  gcc/testsuite/gcc.target/i386/sse-17.c
*************** f660e67b22cb44e6a6b38a247b1d78c3  gcc/te
*** 82092,82100 ****
  bb148b6e9dd40de90aed723794e38216  gcc/testsuite/gcc.target/i386/sse-2.c
  c23a0ea446a060d55e49e48429513f7d  gcc/testsuite/gcc.target/i386/sse-20.c
  d5e7e4c7d488a953399d853e48aa484e  gcc/testsuite/gcc.target/i386/sse-21.c
! 4d640b78b622ff0e4019a625f7bd9acc  gcc/testsuite/gcc.target/i386/sse-22.c
  1c2df57cb3d7d6a3daf4084135ba9b1b  gcc/testsuite/gcc.target/i386/sse-22a.c
! 190413f840db95b97329bd0ecc36af54  gcc/testsuite/gcc.target/i386/sse-23.c
  3fe1d48ff9d52631da56f04cc922a9cb  gcc/testsuite/gcc.target/i386/sse-24.c
  f839ec28fa786a06dabe541954c1b1ae  gcc/testsuite/gcc.target/i386/sse-25.c
  8bb465a190ed3492b3cf000afacb0a9a  gcc/testsuite/gcc.target/i386/sse-26.c
--- 87745,87753 ----
  bb148b6e9dd40de90aed723794e38216  gcc/testsuite/gcc.target/i386/sse-2.c
  c23a0ea446a060d55e49e48429513f7d  gcc/testsuite/gcc.target/i386/sse-20.c
  d5e7e4c7d488a953399d853e48aa484e  gcc/testsuite/gcc.target/i386/sse-21.c
! 6ab292683f48deebb0d49e568a85218b  gcc/testsuite/gcc.target/i386/sse-22.c
  1c2df57cb3d7d6a3daf4084135ba9b1b  gcc/testsuite/gcc.target/i386/sse-22a.c
! 8c367d4df8a50d3b1e4e8f456bef697c  gcc/testsuite/gcc.target/i386/sse-23.c
  3fe1d48ff9d52631da56f04cc922a9cb  gcc/testsuite/gcc.target/i386/sse-24.c
  f839ec28fa786a06dabe541954c1b1ae  gcc/testsuite/gcc.target/i386/sse-25.c
  8bb465a190ed3492b3cf000afacb0a9a  gcc/testsuite/gcc.target/i386/sse-26.c
*************** d9550dbca205ca245040a4868f69e106  gcc/te
*** 82953,82963 ****
  2842007b495cf9a83ae76f07de10dbbf  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-1.c
  dd7ed272907898b9a851cf1fa84d567d  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-2.c
  c7282ac069176bfb3dcc61891051afd2  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-3.c
! 1725f592a3b974b84141d6530be86971  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-4.c
  e125caaf089656a38668d9a76e5a9fd8  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-1.c
  289da27416d1d3ba12c43508573b26b7  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-2.c
  d386259070688fcefcaa2b87d640aefd  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-3.c
! 9c7ac3e0ca2ac2b6081dcfd8b41c5eb7  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-4.c
  784c987777c87b20adb70aefdd43c1ea  gcc/testsuite/gcc.target/i386/volatile-1.c
  df392be222a4275b2813dd6198b59951  gcc/testsuite/gcc.target/i386/volatile-2.c
  a1724ce16bcf831fa3fa93e00649d504  gcc/testsuite/gcc.target/i386/volatile-bitfields-1.c
--- 88606,88616 ----
  2842007b495cf9a83ae76f07de10dbbf  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-1.c
  dd7ed272907898b9a851cf1fa84d567d  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-2.c
  c7282ac069176bfb3dcc61891051afd2  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-3.c
! 768a2f669543d890bd5edfcd058a9aa3  gcc/testsuite/gcc.target/i386/vnniint16-auto-vectorize-4.c
  e125caaf089656a38668d9a76e5a9fd8  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-1.c
  289da27416d1d3ba12c43508573b26b7  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-2.c
  d386259070688fcefcaa2b87d640aefd  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-3.c
! 0dc7aeb0f5451a876670a7b2a5290ece  gcc/testsuite/gcc.target/i386/vnniint8-auto-vectorize-4.c
  784c987777c87b20adb70aefdd43c1ea  gcc/testsuite/gcc.target/i386/volatile-1.c
  df392be222a4275b2813dd6198b59951  gcc/testsuite/gcc.target/i386/volatile-2.c
  a1724ce16bcf831fa3fa93e00649d504  gcc/testsuite/gcc.target/i386/volatile-bitfields-1.c
*************** c032157cf6f27e3a2694462a9e6f23bd  gcc/te
*** 84699,84706 ****
  86877c9cc61dfcd3221d295fe39283b7  gcc/testsuite/gcc.target/nvptx/abi-knr-ret.c
  db33baf84613090251fc255b0eec20d9  gcc/testsuite/gcc.target/nvptx/abi-scalar-arg.c
  76d119f01b5b6a6d59659841410498b7  gcc/testsuite/gcc.target/nvptx/abi-scalar-ret.c
! 4aa817a05665d1357479a6ad2386f84b  gcc/testsuite/gcc.target/nvptx/abi-struct-arg.c
! cf7722359f965eab6fa8fbc9bc9a46a2  gcc/testsuite/gcc.target/nvptx/abi-struct-ret.c
  a130181e569520d8ec50ce126d257deb  gcc/testsuite/gcc.target/nvptx/abi-vararg-1.c
  5c482150fb6b35fd485e1d16dfc98fd8  gcc/testsuite/gcc.target/nvptx/abi-vararg-2.c
  7a09552864da1203b2b1381f3961bfb4  gcc/testsuite/gcc.target/nvptx/abi-vararg-3.c
--- 90352,90359 ----
  86877c9cc61dfcd3221d295fe39283b7  gcc/testsuite/gcc.target/nvptx/abi-knr-ret.c
  db33baf84613090251fc255b0eec20d9  gcc/testsuite/gcc.target/nvptx/abi-scalar-arg.c
  76d119f01b5b6a6d59659841410498b7  gcc/testsuite/gcc.target/nvptx/abi-scalar-ret.c
! d701cfdd0facd50fa388b13e7afab5b8  gcc/testsuite/gcc.target/nvptx/abi-struct-arg.c
! 9cc0f7302300cdfae3f76dfd2b0428ff  gcc/testsuite/gcc.target/nvptx/abi-struct-ret.c
  a130181e569520d8ec50ce126d257deb  gcc/testsuite/gcc.target/nvptx/abi-vararg-1.c
  5c482150fb6b35fd485e1d16dfc98fd8  gcc/testsuite/gcc.target/nvptx/abi-vararg-2.c
  7a09552864da1203b2b1381f3961bfb4  gcc/testsuite/gcc.target/nvptx/abi-vararg-3.c
*************** b4225e859cdd92f35ddd7b8b8b438a8c  gcc/te
*** 87890,87895 ****
--- 93543,93549 ----
  51b1e1bbfe22714ab695a93974508b0e  gcc/testsuite/gcc.target/riscv/arch-53.c
  bec789a6108435830e82b6fdd221cb51  gcc/testsuite/gcc.target/riscv/arch-54.c
  8b84caba9ce32304ca1b5db7befd5c29  gcc/testsuite/gcc.target/riscv/arch-55.c
+ f6c8f50458c8df94ccafb1928e48202a  gcc/testsuite/gcc.target/riscv/arch-56.c
  2cd6ade559b1ab254703146aa7008e18  gcc/testsuite/gcc.target/riscv/arch-6.c
  81519955d6644acb55c78120405494a5  gcc/testsuite/gcc.target/riscv/arch-7.c
  def4ef484e9166f9a01c65a411a9d916  gcc/testsuite/gcc.target/riscv/arch-8.c
*************** daa3032f375d369c3db592013c53266c  gcc/te
*** 87958,87963 ****
--- 93612,93618 ----
  b320d39b4bc35839fa28adaf6f2ed6c0  gcc/testsuite/gcc.target/riscv/compare-debug-1.c
  29d9be01f5b2aa67772e773cf0c9dc51  gcc/testsuite/gcc.target/riscv/compare-debug-2.c
  765643fbc85d2b06ca050b805d914d50  gcc/testsuite/gcc.target/riscv/constraint-R.c
+ fc853c6d51e65d38d06c170746cd7304  gcc/testsuite/gcc.target/riscv/constraint-cR-pair.c
  5735e3b029a3ef436649e16b2a4dbb5f  gcc/testsuite/gcc.target/riscv/constraint-cf-zfinx.c
  eb5af8f9b9993b4069f49d0049d05e87  gcc/testsuite/gcc.target/riscv/constraint-cf.c
  64b74269345e8654ce0d1f33fc7c5a58  gcc/testsuite/gcc.target/riscv/constraint-cr.c
*************** ce38011c6154f93d71861589c50fc10a  gcc/te
*** 88020,88026 ****
  a7d65fd143ca909973c946ae01e9dd76  gcc/testsuite/gcc.target/riscv/cset-sext-rtl32.c
  6d625a6d88d6da5c54d8cb6af2d21d39  gcc/testsuite/gcc.target/riscv/cset-sext-sfb-rtl.c
  5ca7d685b69d4519b33233552c8311ac  gcc/testsuite/gcc.target/riscv/cset-sext-sfb-rtl32.c
! 6a47bcd1d8b087b2e9fc4f822d154b6a  gcc/testsuite/gcc.target/riscv/cset-sext-sfb.c
  a10ac96adfabab51058ec12604b3d129  gcc/testsuite/gcc.target/riscv/cset-sext-thead-rtl.c
  a965f95252267cb184a5b29790f13aae  gcc/testsuite/gcc.target/riscv/cset-sext-thead.c
  0611cd386ffcb0a9439e6c4a3992fcd3  gcc/testsuite/gcc.target/riscv/cset-sext-ventana-rtl.c
--- 93675,93681 ----
  a7d65fd143ca909973c946ae01e9dd76  gcc/testsuite/gcc.target/riscv/cset-sext-rtl32.c
  6d625a6d88d6da5c54d8cb6af2d21d39  gcc/testsuite/gcc.target/riscv/cset-sext-sfb-rtl.c
  5ca7d685b69d4519b33233552c8311ac  gcc/testsuite/gcc.target/riscv/cset-sext-sfb-rtl32.c
! e67f6ec1460fa16f0e0b794a61ed9cd8  gcc/testsuite/gcc.target/riscv/cset-sext-sfb.c
  a10ac96adfabab51058ec12604b3d129  gcc/testsuite/gcc.target/riscv/cset-sext-thead-rtl.c
  a965f95252267cb184a5b29790f13aae  gcc/testsuite/gcc.target/riscv/cset-sext-thead.c
  0611cd386ffcb0a9439e6c4a3992fcd3  gcc/testsuite/gcc.target/riscv/cset-sext-ventana-rtl.c
*************** bba0977f2acac23e269d463cd1b7ba52  gcc/te
*** 88636,88642 ****
  0be9cd6857f2505997bc83cad628e9aa  gcc/testsuite/gcc.target/riscv/pr114139.c
  a7b01bd6393c053eb2052773c0ca4b69  gcc/testsuite/gcc.target/riscv/pr114277.c
  55a41664e9844961c91357e97dc9ba27  gcc/testsuite/gcc.target/riscv/pr114442.c
! 406442864655cfad642a9a03f659bc19  gcc/testsuite/gcc.target/riscv/pr114512.c
  ac7457bb5fc81b14b0c132cfa32ee677  gcc/testsuite/gcc.target/riscv/pr114639-1.c
  8ff44c408c80d6686eacf2c8c9416fb4  gcc/testsuite/gcc.target/riscv/pr114639-2.c
  d23feb07adfb6b3ced3305b407aec532  gcc/testsuite/gcc.target/riscv/pr114639-3.c
--- 94291,94297 ----
  0be9cd6857f2505997bc83cad628e9aa  gcc/testsuite/gcc.target/riscv/pr114139.c
  a7b01bd6393c053eb2052773c0ca4b69  gcc/testsuite/gcc.target/riscv/pr114277.c
  55a41664e9844961c91357e97dc9ba27  gcc/testsuite/gcc.target/riscv/pr114442.c
! 5bbe0709a8dfddcf22a4bc65aa5e494e  gcc/testsuite/gcc.target/riscv/pr114512.c
  ac7457bb5fc81b14b0c132cfa32ee677  gcc/testsuite/gcc.target/riscv/pr114639-1.c
  8ff44c408c80d6686eacf2c8c9416fb4  gcc/testsuite/gcc.target/riscv/pr114639-2.c
  d23feb07adfb6b3ced3305b407aec532  gcc/testsuite/gcc.target/riscv/pr114639-3.c
*************** b62a32eafb5e661786b5ef2b03b30be9  gcc/te
*** 88693,88698 ****
--- 94348,94355 ----
  d7b10be51739976c3b0ea4b16c390ba8  gcc/testsuite/gcc.target/riscv/pr120137.c
  a21d4b9178b49fb0fb65552af24e2832  gcc/testsuite/gcc.target/riscv/pr120154.c
  ea446029e0fd8e2a167fbb85bdedc0cc  gcc/testsuite/gcc.target/riscv/pr120223.c
+ d90629fcb060c4d6b1e7e38318f80843  gcc/testsuite/gcc.target/riscv/pr120333.c
+ 4f37f1ab5c897b7d856cd69b7a0d1b97  gcc/testsuite/gcc.target/riscv/pr120368.c
  37a08389ba95284cc27832767dfc1430  gcc/testsuite/gcc.target/riscv/pr43644.c
  10400130cc47973d43925669f3c795ed  gcc/testsuite/gcc.target/riscv/pr84660.c
  c2ac0b53d6af56f5ec5bded3d252dddc  gcc/testsuite/gcc.target/riscv/pr93202.c
*************** d90ca4ab32f893e58362b7afbe85e6fd  gcc/te
*** 89328,89333 ****
--- 94985,94991 ----
  c1274e3ee15699a124ca1ff4e24fd55b  gcc/testsuite/gcc.target/riscv/rvv/autovec/gather-scatter/strided_store_run-2.c
  c1779350d6b08b51c352226f6a13ffb2  gcc/testsuite/gcc.target/riscv/rvv/autovec/madd-split2-1.c
  03b6c6282f299ea1ba67e487d39d0d18  gcc/testsuite/gcc.target/riscv/rvv/autovec/no-segment.c
+ 85b6b9308922385bec91a059fce74bd9  gcc/testsuite/gcc.target/riscv/rvv/autovec/param-autovec-mode.c
  7da5b354874f99fde1d14c20b0fa76e7  gcc/testsuite/gcc.target/riscv/rvv/autovec/partial/gimple_fold-1.c
  78f17ccf2c8434fe0739b9fd95e2aa43  gcc/testsuite/gcc.target/riscv/rvv/autovec/partial/live-1.c
  cc143b9c26bd55a3825fe0f7577a91fa  gcc/testsuite/gcc.target/riscv/rvv/autovec/partial/live-2.c
*************** f95d4e0ecca41e722099be6b52b3efe7  gcc/te
*** 90952,91007 ****
  35044d6a949091b4c23addf451f035ed  gcc/testsuite/gcc.target/riscv/rvv/autovec/vmv-imm-rv64.c
  0026b1e2310b7242895d290cff3f1e9e  gcc/testsuite/gcc.target/riscv/rvv/autovec/vmv-imm-template.h
  2d052315288cbb1a315add9fb76abbc3  gcc/testsuite/gcc.target/riscv/rvv/autovec/vreinterpet-fixed.c
! 56a9ce5c5dcfb4fe57c2f6c1fe32df19  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c
! 82822ba241edd9fb2945fddf5492d90f  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c
! eee3a3f1b49c06cedf842c2fb35b2051  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c
! affe3a68df8f9f786ef55811254717d8  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c
! e003cbb559836c197833b6f17c3ace01  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u16.c
! 082b528272aa4fab46c58f265a7f5f90  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u32.c
! f2e377498282c46536d48d1924512c14  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u64.c
! 036b7e7ac03d1e4f23e69888563cd145  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u8.c
! e649caba26e0b9c354bb3a904ba8095a  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c
! 046366475c2b9b84a9ed31d7d9498614  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c
! 188a4cda7b1ff5ef305d85fd08b2fd22  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c
! 2e235a15d36e833f721b6099e2014f18  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c
! 13a10e606c1783fc71b8b3be10a245f4  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u16.c
! de72e3c907fff29977cadc265f941af6  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u32.c
! 8f38ce65a8b2d6d3e235b4bd4801cef9  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u64.c
! 3ffe4bfce21c8dc212e81602aecbd859  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u8.c
! 86e8a6c2bc92011a5aebd73f8f3afc05  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c
! 7fcb44166ae9f26520acf46efc7c27c8  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c
! 4bbbd9a6bcbd918fdaf1a36fb4c93cf2  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c
! 0e6a3c963f86e031280efe5d04f87e6a  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c
! 99399fb84fb20842be568308cab7eb12  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u16.c
! c716d39b84d2789f26af932340082be0  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u32.c
! 417ec6454667dbfbb69c3ac3efa1a2a8  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u64.c
! bf04f1c8adc0e50a385323bc78350542  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u8.c
! 674b946bb963de82c123cda93b50d3c0  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c
! 8cd4f324ee8108fc331e2ee25c951f49  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c
! 13d80303f5412dbab02693b7307b5a4c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c
! ae139f2eb3bf9773cd34c21cadd73c82  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c
! 43b6da7a59cc95f802f55f1fb694bc58  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u16.c
! f2b278b63484cb5e96ae1fa96653f5d7  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u32.c
! d8adc94f0b15f16e776ffc682eb0f439  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u64.c
! 5fa2b14a245b769e3e7e64a31a88f22f  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u8.c
! 70d5ed649f6f0b645c6db6ec6ddce5ef  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c
! 2f20d33746cdab4aaabded96b5fb042b  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c
! 8cf295cc76a624d7d1989c2a2a9c9f9d  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c
! 7819cde47e3eaa3a459f10f6860de49f  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c
! d839e62ccf12885a9e6f3470a40674a2  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u16.c
! bc9e7f1e4ec6aa361b8958a2010905f6  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u32.c
! dcc113d4ba56dc7323a958b014d0b381  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u64.c
! b776cb3832531d8d1621f271e5342135  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u8.c
! bc0d2e0e66f98a704fe96b93bdebd524  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c
! bda2f0454a32b45c25e264a790872ade  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c
! 2693160626093b55bc2b7c6046b4075d  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c
! f79813b360305c4178d0b5eee105d217  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c
! 003e4d2685cc92c65098d03202ea3768  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u16.c
! d59cb5031bed6b1e76523a032983af96  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u32.c
! bc3556ff3ac5728c17bd0a16fa879d91  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u64.c
! 33a4c117dd0f736c8ec78a07ff986cd7  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u8.c
! 675ed4b5bb2d840c813b89b6466d55e4  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h
! 0ce3469dc3b2d454675a92f9409386c3  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h
  ccb9cff4438796fd5c2c015df2204a55  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_run.h
  f82d1e3332267f884d6990983f9a5c50  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vadd-run-1-i16.c
  9f3b8184fd845e5425e43d0e12950ff1  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vadd-run-1-i32.c
--- 96610,96665 ----
  35044d6a949091b4c23addf451f035ed  gcc/testsuite/gcc.target/riscv/rvv/autovec/vmv-imm-rv64.c
  0026b1e2310b7242895d290cff3f1e9e  gcc/testsuite/gcc.target/riscv/rvv/autovec/vmv-imm-template.h
  2d052315288cbb1a315add9fb76abbc3  gcc/testsuite/gcc.target/riscv/rvv/autovec/vreinterpet-fixed.c
! 227621b889d0cbccd8b57b75a0300433  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c
! c0929acca222e58c77ad7823d297621c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c
! c89a8346f6325167aaf896fd21f2b36f  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c
! 79818437fbddf807482a893070bffb2b  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c
! 7957ecbc758d321044639b2a484282e3  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u16.c
! 224def4c2257e16654f90f02e4a5757c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u32.c
! 7a290439b713a9d0b0573a94dddf7db0  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u64.c
! 607905fa9f09b30f648b4132b1419d7f  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u8.c
! 2a10483885fdc62512a4123e3652dc1a  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c
! c9a9e9b4e4402d856e5b08399d372cdb  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c
! 231cc1e70194d06df0ebcb9837508576  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c
! fc7fd552014010daccc14f04fe718a32  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c
! d193bd89cfcca47231a6fbe493d084be  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u16.c
! 864659adf1587be8edce2d83163f4d3a  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u32.c
! 28cbc219d97f0e5b3a18e6297326a99b  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u64.c
! be9fec7129a7771cd38118ef1ba52150  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u8.c
! 036e276584dab3bffc3af09cbf5b0141  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c
! 8a9c4fc481905bb569540b64f19dbc7e  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c
! 825999848fac3bdf93405b44ae3759b9  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c
! 963ab6c27a37763c521c1ab2fd30e36c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c
! fbbae994701ac579c50fdb07a14510bb  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u16.c
! 63ce0d532a9576ede889e54193d5d295  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u32.c
! f9a5cab7faf32113892896e96ffda27c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u64.c
! fb9b888da57b9acf705827c02d5f747d  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u8.c
! 8d905ee078aecfbfe3537779f9a7fd54  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c
! 19846f901fed3d3ce5c77f76a14d87aa  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c
! ce3da65e8cc04c67e7ce506fb8743286  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c
! b76d995b847e4d18b96ef5680125006f  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c
! 8c0f1dd3bc69995c2c999cfc7a860740  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u16.c
! bb18f92e6aa3b36e6eec328b193376f8  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u32.c
! 6b55a8ab17169303dce880dbcefaed82  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u64.c
! 5b73cb343085af8df39d7f22cf0c816b  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u8.c
! 964c07ac7d5003040c604320f20fbbaa  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c
! 687abeb06acb6f67010c8c6763c2be77  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c
! b8b5d7e5942a2e78a137f934d762d9d0  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c
! 53005c28be429a38ca739ecd056c4bf3  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c
! f74c1adb250f62bb7fdb0e178f4a8d5e  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u16.c
! a1736f50e8c90210b65fa361c7f7c4fb  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u32.c
! dcb66447fa9681ac20ca66fbfc222284  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u64.c
! a8c923a161cbde04b37ec60379d83743  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u8.c
! 3f268e516d9a10b560592a7f3fd6083c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c
! 903cc24c9edadea8c191ef2715fe627c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c
! 5c72faf16f196ff19a0e59de02ad1e28  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c
! 52bc2fab2454f6e47a8fd94bca83eb4d  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c
! ae225a0763d73897fb894553890d8d94  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u16.c
! dee43b6e6af76584831e8f1937feb6b4  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u32.c
! 72cabf3ce17869bae41454de964e63cb  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u64.c
! a8a8bf4c0f5ea4a2372c9b04047d656d  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u8.c
! f6a301d0db99423158844de969165511  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h
! a330195a1803011649a01040d554bce3  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h
  ccb9cff4438796fd5c2c015df2204a55  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_run.h
  f82d1e3332267f884d6990983f9a5c50  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vadd-run-1-i16.c
  9f3b8184fd845e5425e43d0e12950ff1  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vadd-run-1-i32.c
*************** c997257cfa5d9bea648ef7efa7983d37  gcc/te
*** 91011,91016 ****
--- 96669,96698 ----
  ef81b48e5e8a897c210cce3e761266b6  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vadd-run-1-u32.c
  6872270b4229c383721e1e747891b40e  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vadd-run-1-u64.c
  16f77494fa58ce0796073cd11ebcf8a9  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vadd-run-1-u8.c
+ c3bdac68b5276566075c97accbe309b4  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i16.c
+ a0c95c64253610a3898ae09fa589f583  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i32.c
+ d3e59daefd7047dbd6bd8467b4cd211c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i64.c
+ dfe0d1469cc9bea2a38a44a5b748dae8  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i8.c
+ f45220ac5d3b632c2b85a02c4ba7b949  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u16.c
+ 6c202fff5843e60c2537c34d55f27524  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u32.c
+ fd7186aaa46dcb3f9896b7632d2e89dc  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u64.c
+ daed14994427ff6ab8a37961118d2c0c  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u8.c
+ 90a5b2f99307ef1d58eb01275ec12ab5  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i16.c
+ 73f8419d7d51dd6d9657973ca7153119  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i32.c
+ 6559ebf5f269f0c83f81f6a5726fdaf8  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i64.c
+ 700a3ee7e26d54bf41c1ae316cf8e81e  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i8.c
+ 051cd42c80b1154f8220053f6c96d523  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u16.c
+ 7245f5e0966d792119ec51a8ebb291ba  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u32.c
+ 4cd87b01be0bac5ab9dec32a29319afd  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u64.c
+ 1c1b89506ddf16d88d008bd2d69edd40  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u8.c
+ 8937d0b839506b10a763ee6df5caa4cd  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i16.c
+ 533eedb668b26c7e7bc78800d6f64c07  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i32.c
+ cc285905b88b66b772a37b10056a36dd  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i64.c
+ ab1ea727d2290cb4de9b7e7d2093eec9  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i8.c
+ 0db874f526e1b30f0acdf8ca2319fadf  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u16.c
+ fdff265e90fd902eca5c517ac99fba20  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u32.c
+ 8fad85d94c2ebb8b2c7a97448400e42d  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u64.c
+ abd281c20ca983dae4ef633a58d18c7d  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u8.c
  63ecf62c70647f5af85690b50449a4a3  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsub-run-1-i16.c
  e0a029ed9e4f9f4ab4383ebb4a63f046  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsub-run-1-i32.c
  7ec38b653f84c7041b0b862f361c9822  gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsub-run-1-i64.c
*************** ca8dcbe1d318561f3ba7df5abeff7677  gcc/te
*** 93239,93245 ****
  6e3f79b288eb5a99b23ffcdb5b2986ac  gcc/testsuite/gcc.target/riscv/zba-shNadd-10.c
  7e4c1ee6b9f144dc08101a83a623bb94  gcc/testsuite/gcc.target/riscv/zba-shadd.c
  ee390913829a46a6ce5004198d82bb62  gcc/testsuite/gcc.target/riscv/zba-shadduw.c
! 0daa57867b25115982a5152975ad2886  gcc/testsuite/gcc.target/riscv/zba-slliuw.c
  7897a2dc924c5d59e2471445e59414f7  gcc/testsuite/gcc.target/riscv/zba-zextw.c
  6c5397671f66bec010860dfbc4625631  gcc/testsuite/gcc.target/riscv/zba_zbs_and-1.c
  e5b7fbdf358cbf214660b7e3b239e748  gcc/testsuite/gcc.target/riscv/zbb-andn-orn-01.c
--- 98921,98927 ----
  6e3f79b288eb5a99b23ffcdb5b2986ac  gcc/testsuite/gcc.target/riscv/zba-shNadd-10.c
  7e4c1ee6b9f144dc08101a83a623bb94  gcc/testsuite/gcc.target/riscv/zba-shadd.c
  ee390913829a46a6ce5004198d82bb62  gcc/testsuite/gcc.target/riscv/zba-shadduw.c
! 1e372c3919a67ae0d4e075b9c20347e5  gcc/testsuite/gcc.target/riscv/zba-slliuw.c
  7897a2dc924c5d59e2471445e59414f7  gcc/testsuite/gcc.target/riscv/zba-zextw.c
  6c5397671f66bec010860dfbc4625631  gcc/testsuite/gcc.target/riscv/zba_zbs_and-1.c
  e5b7fbdf358cbf214660b7e3b239e748  gcc/testsuite/gcc.target/riscv/zbb-andn-orn-01.c
*************** a009fbb003840ecc4d7a50c463fa72da  gcc/te
*** 93356,93361 ****
--- 99038,99044 ----
  bb2b3e0ab01f1ec16e989024621b390a  gcc/testsuite/gcc.target/riscv/zihintpause-1.c
  2b3fb44b9845e2008eee1f6ba7b44bc4  gcc/testsuite/gcc.target/riscv/zihintpause-2.c
  b93bb61a6adb25211cec61b639273181  gcc/testsuite/gcc.target/riscv/zihintpause-noarch.c
+ f7d12c5379fd73c039260ba85d51a8a7  gcc/testsuite/gcc.target/riscv/zilsd-code-gen.c
  d96c5cb0ac69fd365634d1203364b2db  gcc/testsuite/gcc.target/riscv/zknd32.c
  6e2cf258e5cd8bad0c1d9153cdb923ad  gcc/testsuite/gcc.target/riscv/zknd64.c
  90d1bacbe4e275bfd699a8d6170e616c  gcc/testsuite/gcc.target/riscv/zkne32.c
*************** b45afeaab70f1f8a13e0efe9b2520a3c  gcc/te
*** 108957,108962 ****
--- 114640,114646 ----
  74e6d5d98b64c8e15038da1eb20fc083  gcc/testsuite/gm2/iso/fail/arraymismatch.mod
  2aeb1840a853d9bd6dd61d9278a7b6a1  gcc/testsuite/gm2/iso/fail/badarray.mod
  5d08cec83a9fd8cfa6b718baa93a2715  gcc/testsuite/gm2/iso/fail/badarray2.mod
+ 58fa04b34b089f4e639362653e1de965  gcc/testsuite/gm2/iso/fail/badarray3.mod
  08d72567eef98d824fdfea58dfd60bd0  gcc/testsuite/gm2/iso/fail/badassignment.mod
  026dcc0bc12873120c33bc438c0da31f  gcc/testsuite/gm2/iso/fail/badexpression.mod
  9dc1926fc7f59c0f1a31e62270e201f0  gcc/testsuite/gm2/iso/fail/badexpression2.mod
*************** eb1595e729e2eaac81c7ffe330d8f24e  gcc/te
*** 115307,115313 ****
  f7940f4f8c24d9f0bf4d062473f55777  gcc/testsuite/lib/scanwpaipa.exp
  23e89ca46b182663a4139064b179545f  gcc/testsuite/lib/target-libpath.exp
  d9a6726c38c578e1cd46631ee7f92d0a  gcc/testsuite/lib/target-supports-dg.exp
! 84a1fe2a7a1b1396bbd041ff182ff927  gcc/testsuite/lib/target-supports.exp
  cfe4a2f0a83382048de060dc6669cbb9  gcc/testsuite/lib/target-utils.exp
  e45ee1a35539730bd823a310ad306ded  gcc/testsuite/lib/timeout-dg.exp
  b755c82fb5ee43ef6c852f23fbdc8704  gcc/testsuite/lib/timeout.exp
--- 120991,120997 ----
  f7940f4f8c24d9f0bf4d062473f55777  gcc/testsuite/lib/scanwpaipa.exp
  23e89ca46b182663a4139064b179545f  gcc/testsuite/lib/target-libpath.exp
  d9a6726c38c578e1cd46631ee7f92d0a  gcc/testsuite/lib/target-supports-dg.exp
! aafe97f37150827f05b7bb18a0b8cae3  gcc/testsuite/lib/target-supports.exp
  cfe4a2f0a83382048de060dc6669cbb9  gcc/testsuite/lib/target-utils.exp
  e45ee1a35539730bd823a310ad306ded  gcc/testsuite/lib/timeout-dg.exp
  b755c82fb5ee43ef6c852f23fbdc8704  gcc/testsuite/lib/timeout.exp
*************** ca42ede542aebd549facd7af1a165d55  gcc/tr
*** 117771,117779 ****
  591222e5199894b9b5d23b1822f7e309  gcc/tree-cfg.h
  ca2c309862705e4161a11efb32eb1ebf  gcc/tree-cfgcleanup.cc
  b528a0932f50504df146d112f7d01a5c  gcc/tree-cfgcleanup.h
! 08af477af99a77369cf1e05fc6fdf3e9  gcc/tree-chrec.cc
  0e4a484c6387f9be0a506783637432f9  gcc/tree-chrec.h
! 8bf7d3cd5470b24f391fbdaf27a7fa3d  gcc/tree-complex.cc
  1a4cfcc258f7e90de06692e266fb2918  gcc/tree-core.h
  77244f55dae576a255f5b69b70774e54  gcc/tree-data-ref.cc
  e43a555cdaab9a97ba3910364910f865  gcc/tree-data-ref.h
--- 123455,123463 ----
  591222e5199894b9b5d23b1822f7e309  gcc/tree-cfg.h
  ca2c309862705e4161a11efb32eb1ebf  gcc/tree-cfgcleanup.cc
  b528a0932f50504df146d112f7d01a5c  gcc/tree-cfgcleanup.h
! 1718a36253ebbb17fe4570fc768216c9  gcc/tree-chrec.cc
  0e4a484c6387f9be0a506783637432f9  gcc/tree-chrec.h
! 631f383225878af718642d2a458aefae  gcc/tree-complex.cc
  1a4cfcc258f7e90de06692e266fb2918  gcc/tree-core.h
  77244f55dae576a255f5b69b70774e54  gcc/tree-data-ref.cc
  e43a555cdaab9a97ba3910364910f865  gcc/tree-data-ref.h
*************** fbd423299c28bb3b3577ec61aba45439  gcc/tr
*** 117890,117897 ****
  339bce59375d7679ec019cf010b6bcbc  gcc/tree-ssanames.h
  5fa0d7c6143cd9e39c30840b9996fa30  gcc/tree-stdarg.cc
  9817789b6289e73955015beb57c609b1  gcc/tree-stdarg.h
! 3036d8f359941475e5cb3cfdd715cab2  gcc/tree-streamer-in.cc
! 58d5ce00761a2f46b9daffbc63a9b1d3  gcc/tree-streamer-out.cc
  22cddc57dea71a3e5c57e033b6f86476  gcc/tree-streamer.cc
  6714826bb9cd5f171a08cbabcb1da8e6  gcc/tree-streamer.h
  1001d7e4347de60f6d9e93f421ad5d6f  gcc/tree-switch-conversion.cc
--- 123574,123581 ----
  339bce59375d7679ec019cf010b6bcbc  gcc/tree-ssanames.h
  5fa0d7c6143cd9e39c30840b9996fa30  gcc/tree-stdarg.cc
  9817789b6289e73955015beb57c609b1  gcc/tree-stdarg.h
! af4c63760c432f66b1c6c8e7e7666699  gcc/tree-streamer-in.cc
! 629c2d175128efb2809d4ed7e08f1a18  gcc/tree-streamer-out.cc
  22cddc57dea71a3e5c57e033b6f86476  gcc/tree-streamer.cc
  6714826bb9cd5f171a08cbabcb1da8e6  gcc/tree-streamer.h
  1001d7e4347de60f6d9e93f421ad5d6f  gcc/tree-switch-conversion.cc
*************** ebb8ac3717c1bf5db4371da2f3cf6af7  gcc/tr
*** 117901,117907 ****
  5d8bb0df796ceea958fd65c5aedb5bce  gcc/tree-vect-generic.cc
  cc0bdf3f684b251509b8552d2d8549a3  gcc/tree-vect-loop-manip.cc
  52844e104e182fdd3e6bb5d9c826f5a6  gcc/tree-vect-loop.cc
! 7bbc2f36be7110e619b5a82723fb9cdb  gcc/tree-vect-patterns.cc
  baa70369c21f662d5e61d1296052d231  gcc/tree-vect-slp-patterns.cc
  39f80d088fedac688a25df45b3a1a8db  gcc/tree-vect-slp.cc
  fbcd8824f307d22466b149001f07dbac  gcc/tree-vect-stmts.cc
--- 123585,123591 ----
  5d8bb0df796ceea958fd65c5aedb5bce  gcc/tree-vect-generic.cc
  cc0bdf3f684b251509b8552d2d8549a3  gcc/tree-vect-loop-manip.cc
  52844e104e182fdd3e6bb5d9c826f5a6  gcc/tree-vect-loop.cc
! da6336ee0c69409d59d2599d74cc5717  gcc/tree-vect-patterns.cc
  baa70369c21f662d5e61d1296052d231  gcc/tree-vect-slp-patterns.cc
  39f80d088fedac688a25df45b3a1a8db  gcc/tree-vect-slp.cc
  fbcd8824f307d22466b149001f07dbac  gcc/tree-vect-stmts.cc
*************** c7399bbb7eadd31d7cd04991cd79c238  includ
*** 118039,118047 ****
  46d6319e8ffc7eabf27cbecd6141a912  libada/configure
  c01f38de8270d558b8d3ecac839d3bbf  libada/configure.ac
  46d3fe6da7a771cc2d5420c4137a6861  libatomic/.gitignore
! 60b4d744144fba44c12174d540047dd4  libatomic/ChangeLog
! 71c1b6c36a41008494bf13a4a0863768  libatomic/Makefile.am
! 4edf5a5514d9eb3764c1536ce393dfb2  libatomic/Makefile.in
  04a8eb275561484cf0d6f8c459a38177  libatomic/acinclude.m4
  d93a7644df6ecd2eda448dcb5b1baeb3  libatomic/aclocal.m4
  b741b38c451feebdcd9aedce6e37b702  libatomic/auto-config.h.in
--- 123723,123731 ----
  46d6319e8ffc7eabf27cbecd6141a912  libada/configure
  c01f38de8270d558b8d3ecac839d3bbf  libada/configure.ac
  46d3fe6da7a771cc2d5420c4137a6861  libatomic/.gitignore
! 7ab098dbb1f57b65cbce1603b9c13b64  libatomic/ChangeLog
! 78b4f847f9673c9414da8064d2d6817b  libatomic/Makefile.am
! 6e273c07f6a054b0b18b59c9421f178b  libatomic/Makefile.in
  04a8eb275561484cf0d6f8c459a38177  libatomic/acinclude.m4
  d93a7644df6ecd2eda448dcb5b1baeb3  libatomic/aclocal.m4
  b741b38c451feebdcd9aedce6e37b702  libatomic/auto-config.h.in
*************** ed3d69739cb2f35407547229f0393f92  libato
*** 118076,118084 ****
  e40da0e8515ee6996456294b571e5572  libatomic/config/x86/fenv.c
  e3229b3119558c9d6d6d8f8676d4f1ce  libatomic/config/x86/host-config.h
  6d8f1d8fc6da675bbeacfbd55dca52c9  libatomic/config/x86/init.c
! eeae1d7549bafa5c8d08aa3bbdb286ad  libatomic/configure
! b8d277f019a2b66002a2fd6d6fd24e6e  libatomic/configure.ac
! 5b299d3064f37df660e846692789df95  libatomic/configure.tgt
  cffc539e08bc3149260124f3eb09e1a1  libatomic/exch_n.c
  35ea85a90d52ccf9efaf3179f1201076  libatomic/fadd_n.c
  5934b0ba904c11c743af25059a8b7092  libatomic/fand_n.c
--- 123760,123768 ----
  e40da0e8515ee6996456294b571e5572  libatomic/config/x86/fenv.c
  e3229b3119558c9d6d6d8f8676d4f1ce  libatomic/config/x86/host-config.h
  6d8f1d8fc6da675bbeacfbd55dca52c9  libatomic/config/x86/init.c
! ed953719e723aa6bd01db503c1b00092  libatomic/configure
! 79fceecd63e79f4dccbe6fe9dd6c997e  libatomic/configure.ac
! 3af5de9020aa1a7aa503e70067cd98d8  libatomic/configure.tgt
  cffc539e08bc3149260124f3eb09e1a1  libatomic/exch_n.c
  35ea85a90d52ccf9efaf3179f1201076  libatomic/fadd_n.c
  5934b0ba904c11c743af25059a8b7092  libatomic/fand_n.c
*************** a3eb5dee2788fe0a6c42502ba658eddd  libffi
*** 118765,118773 ****
  0f3c94e520870e194cf525de7ec404dc  libffi/testsuite/libffi.go/ffitest.h
  6cfb66c1c00023abb2c2276d85f16e77  libffi/testsuite/libffi.go/go.exp
  189dc193fd0e627a2d55b2e84871edc5  libffi/testsuite/libffi.go/static-chain.h
! 5440ac9a2b5e2d39ea89631d6e660bb0  libgcc/ChangeLog
  b1229d68a3a67c6e30daf30379e7bb8f  libgcc/Makefile.in
! 0f39724f440135be7a62bbd4e67e6840  libgcc/config.host
  46412830a2ee8a02503ccc921912c3cf  libgcc/config.in
  9e6d8ec4ff0470579444dbe0a1287f05  libgcc/config/aarch64/__aarch64_have_sme.c
  97101a2593de8c7ed58292fa105ea72f  libgcc/config/aarch64/__arm_sme_state.S
--- 124449,124457 ----
  0f3c94e520870e194cf525de7ec404dc  libffi/testsuite/libffi.go/ffitest.h
  6cfb66c1c00023abb2c2276d85f16e77  libffi/testsuite/libffi.go/go.exp
  189dc193fd0e627a2d55b2e84871edc5  libffi/testsuite/libffi.go/static-chain.h
! f89178c2bbc924180ee712bfaa8dce72  libgcc/ChangeLog
  b1229d68a3a67c6e30daf30379e7bb8f  libgcc/Makefile.in
! 66cc3d23127b54e932766f13d603ec3d  libgcc/config.host
  46412830a2ee8a02503ccc921912c3cf  libgcc/config.in
  9e6d8ec4ff0470579444dbe0a1287f05  libgcc/config/aarch64/__aarch64_have_sme.c
  97101a2593de8c7ed58292fa105ea72f  libgcc/config/aarch64/__arm_sme_state.S
*************** cc4f1d531e4d152879404aa5356c331c  libgcc
*** 118785,118791 ****
  cc057a7bb2bda2a1ca4a54f52ae6347e  libgcc/config/aarch64/gnu-unwind.h
  a077f95c64de11e67e5d9d909ec45b8c  libgcc/config/aarch64/heap-trampoline.c
  d0d4af45fffe18f866536603e6b369ec  libgcc/config/aarch64/libgcc-sme.ver
! dff4f63f801860d329f3c62f135233d4  libgcc/config/aarch64/libgcc-softfp.ver
  fff6214d8f727f1416ce009f15cc5f35  libgcc/config/aarch64/linux-unwind.h
  d09ef2fe232dae56563f13d2b6da6735  libgcc/config/aarch64/lse-init.c
  b2e6d3e9e2af6d58aa7d4238e49990fa  libgcc/config/aarch64/lse.S
--- 124469,124475 ----
  cc057a7bb2bda2a1ca4a54f52ae6347e  libgcc/config/aarch64/gnu-unwind.h
  a077f95c64de11e67e5d9d909ec45b8c  libgcc/config/aarch64/heap-trampoline.c
  d0d4af45fffe18f866536603e6b369ec  libgcc/config/aarch64/libgcc-sme.ver
! 69be64595f7292ff9d22d9790fb1f98c  libgcc/config/aarch64/libgcc-softfp.ver
  fff6214d8f727f1416ce009f15cc5f35  libgcc/config/aarch64/linux-unwind.h
  d09ef2fe232dae56563f13d2b6da6735  libgcc/config/aarch64/lse-init.c
  b2e6d3e9e2af6d58aa7d4238e49990fa  libgcc/config/aarch64/lse.S
*************** c9b91505a24abd3bc6b11e0f094edee0  libgcc
*** 119060,119066 ****
  1aa2fed5799ecd25ee8be582d18e7e78  libgcc/config/gthr-lynx.h
  5196a8b77bc387930fd669d289365a0f  libgcc/config/gthr-rtems.h
  7733368685a8a638218391711d144952  libgcc/config/gthr-vxworks-cond.c
! 245b900eccc4d3ee9d6a6c96c03f8e77  libgcc/config/gthr-vxworks-thread.c
  aa27b5bfc0131bad6a2e347158405b11  libgcc/config/gthr-vxworks-tls.c
  aea1a23d460d879ca86d669a1f8abaee  libgcc/config/gthr-vxworks.c
  470ee5b0a76fa494b19d4db77d46875a  libgcc/config/gthr-vxworks.h
--- 124744,124750 ----
  1aa2fed5799ecd25ee8be582d18e7e78  libgcc/config/gthr-lynx.h
  5196a8b77bc387930fd669d289365a0f  libgcc/config/gthr-rtems.h
  7733368685a8a638218391711d144952  libgcc/config/gthr-vxworks-cond.c
! dae646493dc8bf55c589148500356b21  libgcc/config/gthr-vxworks-thread.c
  aa27b5bfc0131bad6a2e347158405b11  libgcc/config/gthr-vxworks-tls.c
  aea1a23d460d879ca86d669a1f8abaee  libgcc/config/gthr-vxworks.c
  470ee5b0a76fa494b19d4db77d46875a  libgcc/config/gthr-vxworks.h
*************** a9d1ef98019fc8eb83e3cc430fd9aebd  libgcc
*** 119122,119131 ****
  b4252718ecae9a48f0e1ded943735c72  libgcc/config/i386/i386-asm.h
  2a9057631aa6ddf72294b05925a1bd53  libgcc/config/i386/libgcc-bsd.ver
  ba2f94bff41ddb8ec2855634c234c3bd  libgcc/config/i386/libgcc-cygming.ver
! c0eeffed85533a88799ba83ee54ea896  libgcc/config/i386/libgcc-darwin.ver
! 4c9a719068b1a98b718d0f0f0cadff68  libgcc/config/i386/libgcc-glibc.ver
  cf77f65681cb0d27b528daa5ff54d5e0  libgcc/config/i386/libgcc-mingw.ver
! e0c9b41f5b24e4ce4e67af8db1b98658  libgcc/config/i386/libgcc-sol2.ver
  e5d4a4dc91f95ef6c6c9d0342bd9ba87  libgcc/config/i386/linux-unwind.h
  5c92c3c7fee3c941398fd90d67568b39  libgcc/config/i386/morestack.S
  f50ba7e076331ecdf8d8b72d34b8c3cd  libgcc/config/i386/resms64.h
--- 124806,124815 ----
  b4252718ecae9a48f0e1ded943735c72  libgcc/config/i386/i386-asm.h
  2a9057631aa6ddf72294b05925a1bd53  libgcc/config/i386/libgcc-bsd.ver
  ba2f94bff41ddb8ec2855634c234c3bd  libgcc/config/i386/libgcc-cygming.ver
! d270985c9bb872cf2afff7378b5497d8  libgcc/config/i386/libgcc-darwin.ver
! f8058ba26da840ad303390dfe9df2b27  libgcc/config/i386/libgcc-glibc.ver
  cf77f65681cb0d27b528daa5ff54d5e0  libgcc/config/i386/libgcc-mingw.ver
! 01650d63f01d3fa669afabda69fc55e5  libgcc/config/i386/libgcc-sol2.ver
  e5d4a4dc91f95ef6c6c9d0342bd9ba87  libgcc/config/i386/linux-unwind.h
  5c92c3c7fee3c941398fd90d67568b39  libgcc/config/i386/morestack.S
  f50ba7e076331ecdf8d8b72d34b8c3cd  libgcc/config/i386/resms64.h
*************** e831a13e330d0eb6ffa779c755d5fe3d  libgcc
*** 119159,119165 ****
  9d82d05d119f031c6327b2b2a6015871  libgcc/config/i386/t-freebsd
  75e59dd5f976bfaf5efca31aa34d0926  libgcc/config/i386/t-heap-trampoline
  411ab7f31d63e25ae8f98aef0132e384  libgcc/config/i386/t-linux
- 1bbab852ec95edb798886ed925c7e989  libgcc/config/i386/t-mingw-mcfgthread
  226cdff862bdab3d98ad952ff21a40a8  libgcc/config/i386/t-mingw32
  5d85ed8e4ae93489c3433d591a68312c  libgcc/config/i386/t-msabi
  0c1d77cb54c2a81694d96a9ff5e8180c  libgcc/config/i386/t-nto
--- 124843,124848 ----
*************** a6ba6c655b66c26737489f312ef94661  libgcc
*** 119428,119433 ****
--- 125111,125117 ----
  959c208714cbcee52e2db85b1de8fbb8  libgcc/config/microblaze/udivsi3.S
  46acadf369ab54149e0e479fe02e8e53  libgcc/config/microblaze/umodsi3.S
  21a697b3742c466bc6b268a906529ab6  libgcc/config/mingw/t-gthr-win32
+ 1bbab852ec95edb798886ed925c7e989  libgcc/config/mingw/t-mingw-mcfgthread
  80f832afb70afb11a4a1c2e403944b73  libgcc/config/mingw/t-mingw-pthread
  bd20654bad4264867703b8c6fd20a7ff  libgcc/config/mips/crtfastmath.c
  5c5206cd2eec89d93e19d969e54f5881  libgcc/config/mips/crti.S
*************** bf0c23d230e0a178c0b5193ff6a607bc  libgcc
*** 120126,120133 ****
  be4a0a8b74c78a101de66bdfd5901396  libgcc/gthr-single.h
  213fd85cbbcdadf80a904e21cfd67bfd  libgcc/gthr.h
  3ad13985439df4314eccfef65cc8b910  libgcc/hardcfr.c
! 5ccb161e81ace41d0f23963cfeea1124  libgcc/libgcc-std.ver.in
! c011a5992e2e17a6543bf3ffb54cbc2b  libgcc/libgcc2.c
  3eae5dcf87ad630e35576a7e6f1f9486  libgcc/libgcc2.h
  1fcaeb35d9890700f455327224d23e59  libgcc/libgcov-driver-system.c
  590163b168c144b5c440a5e430342c2f  libgcc/libgcov-driver.c
--- 125810,125817 ----
  be4a0a8b74c78a101de66bdfd5901396  libgcc/gthr-single.h
  213fd85cbbcdadf80a904e21cfd67bfd  libgcc/gthr.h
  3ad13985439df4314eccfef65cc8b910  libgcc/hardcfr.c
! b6e8866b16ee1bfc6ef448596d4cb2b4  libgcc/libgcc-std.ver.in
! e29e5078e57079e07efb7e86413302be  libgcc/libgcc2.c
  3eae5dcf87ad630e35576a7e6f1f9486  libgcc/libgcc2.h
  1fcaeb35d9890700f455327224d23e59  libgcc/libgcov-driver-system.c
  590163b168c144b5c440a5e430342c2f  libgcc/libgcov-driver.c
*************** de96265c7729e32d34788d54b20167e0  libgcc
*** 120150,120156 ****
  b501abcd327c6d2c95f76d40d4266a4e  libgcc/soft-fp/adddf3.c
  305a99dae8d1353c9137371842d1a94a  libgcc/soft-fp/addsf3.c
  fe381f26f76f7f8998160bba0429aa49  libgcc/soft-fp/addtf3.c
! 862d968a37d0565154e76a6f60586445  libgcc/soft-fp/bitint.h
  d86da8fd88c560243cc2d5c29e7d9caf  libgcc/soft-fp/bitintpow10.c
  0df1c9dddd6ff4f1de4b75bb05f87fd7  libgcc/soft-fp/bitintpow10.h
  1b314340a7e13d053c2234216b9b01fe  libgcc/soft-fp/brain.h
--- 125834,125840 ----
  b501abcd327c6d2c95f76d40d4266a4e  libgcc/soft-fp/adddf3.c
  305a99dae8d1353c9137371842d1a94a  libgcc/soft-fp/addsf3.c
  fe381f26f76f7f8998160bba0429aa49  libgcc/soft-fp/addtf3.c
! a1277bec9c4f2affe32b91e14dc1eb72  libgcc/soft-fp/bitint.h
  d86da8fd88c560243cc2d5c29e7d9caf  libgcc/soft-fp/bitintpow10.c
  0df1c9dddd6ff4f1de4b75bb05f87fd7  libgcc/soft-fp/bitintpow10.h
  1b314340a7e13d053c2234216b9b01fe  libgcc/soft-fp/brain.h
*************** f017ba40c4699f1549cd341ad688007f  libgcc
*** 120323,120357 ****
  804399bda5c6c23cd3e0cd78c21bc2fd  libgcc/vtv_end_preinit.c
  407de23229097d9b9a4d00e2e9c60c70  libgcc/vtv_start.c
  ba13e8c1385837f9a736ead153be6251  libgcc/vtv_start_preinit.c
! b99124d22d636677b3471a0aae714f66  libgcobol/ChangeLog
  573e7a1dee0641f56d9b797b23dff44b  libgcobol/Makefile.am
  23cf4646d213d05645a0bf48209b374d  libgcobol/Makefile.in
  ff016a65ce3c24bdd22207044f2a126e  libgcobol/README
  8c9140838556aedbca129aeaedf0855b  libgcobol/acinclude.m4
  0bf6afe766a6886d2ac1f175300477f2  libgcobol/aclocal.m4
! 4bcfcd26cbcae0acad6250357010ed20  libgcobol/charmaps.cc
  08bac5426c592bca32b87e76cd4a87a1  libgcobol/charmaps.h
! f929a4f15afe71c4ce5d5075f528be4e  libgcobol/common-defs.h
  55c6d7709ebd3974b38cdddffc6c29f3  libgcobol/config.h.in
  960f1025f03e1402396993e2527513be  libgcobol/configure
  7acbee643dbc269e7c4fddc8279d5bff  libgcobol/configure.ac
  5aec96a7dfdb0d6e7b10cc13d65c53a3  libgcobol/configure.tgt
! dfb3fee8b4c51e1872d66bcc6c4a3e1c  libgcobol/constants.cc
! 50c34404ebdad01c82b97ac6d262d7a2  libgcobol/ec.h
  fbd99afdab52fcee0543b901042350ef  libgcobol/exceptl.h
! 9ae4fae6502f4e31ffd3818d68206d29  libgcobol/gcobolio.h
! 78a9e85e510ce6ae40b2970f215bc476  libgcobol/gfileio.cc
  4c5dc966be490381f53924b2441c9300  libgcobol/gfileio.h
! 4feed2758b460380fb46278ff9ed4c18  libgcobol/gmath.cc
  9b52995346d1f02cab9c3e2b816722d6  libgcobol/gmath.h
! 891bc150793c21e6e16b3b8f83658a31  libgcobol/intrinsic.cc
! b40580a5065188e3a6887000b8ab9de2  libgcobol/io.cc
  b054056cc4fe4de7a78d34e43f2f3bab  libgcobol/io.h
  6fa2e26d11c71898dae520939b992484  libgcobol/libgcobol-fp.h
! 04069199ae10d45ed35b18ebf076d20d  libgcobol/libgcobol.cc
  a92501f6652c6261f981817076ae3254  libgcobol/libgcobol.h
  469e0f6e21e357ff8b53b9d17373a6c8  libgcobol/libgcobol.spec.in
! 93cffe2f9fb0783054d070bd71223ff0  libgcobol/valconv.cc
  04c19ca3fa2ce47103a80f82c288c484  libgcobol/valconv.h
  4b121007ae69b56d576e46ba27dd0617  libgfortran/ChangeLog
  d99469a76bfe825683f8d94fe07b508c  libgfortran/ChangeLog-2002
--- 126007,126041 ----
  804399bda5c6c23cd3e0cd78c21bc2fd  libgcc/vtv_end_preinit.c
  407de23229097d9b9a4d00e2e9c60c70  libgcc/vtv_start.c
  ba13e8c1385837f9a736ead153be6251  libgcc/vtv_start_preinit.c
! 9f7a254b7b112757c79ee24af1228262  libgcobol/ChangeLog
  573e7a1dee0641f56d9b797b23dff44b  libgcobol/Makefile.am
  23cf4646d213d05645a0bf48209b374d  libgcobol/Makefile.in
  ff016a65ce3c24bdd22207044f2a126e  libgcobol/README
  8c9140838556aedbca129aeaedf0855b  libgcobol/acinclude.m4
  0bf6afe766a6886d2ac1f175300477f2  libgcobol/aclocal.m4
! fcc7ca8c9be640166d0722f71ce6c5ef  libgcobol/charmaps.cc
  08bac5426c592bca32b87e76cd4a87a1  libgcobol/charmaps.h
! ca3f2312852a77577256c9a59e0494ac  libgcobol/common-defs.h
  55c6d7709ebd3974b38cdddffc6c29f3  libgcobol/config.h.in
  960f1025f03e1402396993e2527513be  libgcobol/configure
  7acbee643dbc269e7c4fddc8279d5bff  libgcobol/configure.ac
  5aec96a7dfdb0d6e7b10cc13d65c53a3  libgcobol/configure.tgt
! dc7dba3ea14b23da0b28124acfa2ca32  libgcobol/constants.cc
! 641fcbe1c4aa0a6cde86f5b185638e11  libgcobol/ec.h
  fbd99afdab52fcee0543b901042350ef  libgcobol/exceptl.h
! ef8b11373d27f5ca4df73f09c6ccab75  libgcobol/gcobolio.h
! c55cb0079506ce09a3e94d9c8ad17a73  libgcobol/gfileio.cc
  4c5dc966be490381f53924b2441c9300  libgcobol/gfileio.h
! c452346edcf88bc8ab6ef406a68080a7  libgcobol/gmath.cc
  9b52995346d1f02cab9c3e2b816722d6  libgcobol/gmath.h
! 4902cf7b5f1bf2359c189d85e3ad89f9  libgcobol/intrinsic.cc
! 0cf9ce2863c11a8fd875185c371fe6e6  libgcobol/io.cc
  b054056cc4fe4de7a78d34e43f2f3bab  libgcobol/io.h
  6fa2e26d11c71898dae520939b992484  libgcobol/libgcobol-fp.h
! 15e7de0bbfd51efecba4824d8b2c8f5d  libgcobol/libgcobol.cc
  a92501f6652c6261f981817076ae3254  libgcobol/libgcobol.h
  469e0f6e21e357ff8b53b9d17373a6c8  libgcobol/libgcobol.spec.in
! 78eae29429f976b3df0dd2d9df4a2193  libgcobol/valconv.cc
  04c19ca3fa2ce47103a80f82c288c484  libgcobol/valconv.h
  4b121007ae69b56d576e46ba27dd0617  libgfortran/ChangeLog
  d99469a76bfe825683f8d94fe07b508c  libgfortran/ChangeLog-2002
*************** a3a7e9ca6057da9ca42e03e41e1c73f7  libgo/
*** 126914,126920 ****
  dcdf1b680b15b372bdb64cc5107d51b6  libgo/testsuite/libgo-test-support.exp.in
  bf162aa572f7b96b25dbd2b027845d32  libgo/testsuite/libgo.testmain/testmain.exp
  cc9d2a0e34e31ba866a8caf9f46f48f3  libgomp/.gitattributes
! 88a44961be2964ec12e29f92186ba4d2  libgomp/ChangeLog
  0d55aa862aee66efdc5f8d62c94ff8fb  libgomp/ChangeLog.graphite
  883cfea6de23904b83d6bd58a729c866  libgomp/Makefile.am
  54c7bc8277669e3bf5f1a3db179ae206  libgomp/Makefile.in
--- 132598,132604 ----
  dcdf1b680b15b372bdb64cc5107d51b6  libgo/testsuite/libgo-test-support.exp.in
  bf162aa572f7b96b25dbd2b027845d32  libgo/testsuite/libgo.testmain/testmain.exp
  cc9d2a0e34e31ba866a8caf9f46f48f3  libgomp/.gitattributes
! d5e00171faacd4ab21ff8d92b04bd5a1  libgomp/ChangeLog
  0d55aa862aee66efdc5f8d62c94ff8fb  libgomp/ChangeLog.graphite
  883cfea6de23904b83d6bd58a729c866  libgomp/Makefile.am
  54c7bc8277669e3bf5f1a3db179ae206  libgomp/Makefile.in
*************** e42f1e345c7fcd9893f399df22eaed2f  libgom
*** 127601,127607 ****
  cfa794b61d7b642929f4141128dac867  libgomp/testsuite/libgomp.c-c++-common/matrix-simd-1.c
  50746be62833efa7f254f6d21e6a7d34  libgomp/testsuite/libgomp.c-c++-common/matrix-transform-variants-1.h
  6641003248aa3d1115dde398cabf5d6d  libgomp/testsuite/libgomp.c-c++-common/memcpyxd-bias-1.c
! f10b3a5a5035a7c657d48900ff8144a0  libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
  1d83edce1d354aa18fd8d8acf0e56192  libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
  619fdbed63b97f6d4a1e0a1cabf0ebd9  libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
  29710e6fe72aca1f1ab459086956363b  libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
--- 133285,133291 ----
  cfa794b61d7b642929f4141128dac867  libgomp/testsuite/libgomp.c-c++-common/matrix-simd-1.c
  50746be62833efa7f254f6d21e6a7d34  libgomp/testsuite/libgomp.c-c++-common/matrix-transform-variants-1.h
  6641003248aa3d1115dde398cabf5d6d  libgomp/testsuite/libgomp.c-c++-common/memcpyxd-bias-1.c
! 87cada43a2557a6c8c7b870bd75cab00  libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
  1d83edce1d354aa18fd8d8acf0e56192  libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
  619fdbed63b97f6d4a1e0a1cabf0ebd9  libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
  29710e6fe72aca1f1ab459086956363b  libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
*************** e590f10fae9bf053ed7123777b03bf32  libgom
*** 127703,127708 ****
--- 133387,133393 ----
  c1475af16cfcc82bec0d85875d542fdb  libgomp/testsuite/libgomp.c-c++-common/target-41.c
  d87524b525b7f424e584af640f4b038b  libgomp/testsuite/libgomp.c-c++-common/target-42.c
  ae24e1c7b9fc9100ef17c4595417ef54  libgomp/testsuite/libgomp.c-c++-common/target-45.c
+ 4d8aae1b1f6de692fe1f648c2cf17905  libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1-O0.c
  606f84c99a4efc1405feef5c9b230de4  libgomp/testsuite/libgomp.c-c++-common/target-cdtor-1.c
  1120f9e50460c0396d1ae405ffd3e780  libgomp/testsuite/libgomp.c-c++-common/target-has-device-addr-1.c
  038d0072f445d0120f15c605ec76e54a  libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-1.c
*************** b4fc04813771a8801e90ced112679b03  libgom
*** 128923,128928 ****
--- 134608,134614 ----
  de42c25c26112c8021572c2875414fe1  libgomp/testsuite/libgomp.oacc-c++/routine-1-trailing-return-type.C
  e791213d5152b9450d6c3d86211b78cd  libgomp/testsuite/libgomp.oacc-c++/template-reduction.C
  c3cc3d873e54843cfbb40f4c262b6b98  libgomp/testsuite/libgomp.oacc-c++/this.C
+ c3ce4f9d067129eeb94fbbd5ac912cca  libgomp/testsuite/libgomp.oacc-c-c++-common/abi-struct-1.c
  451978dda3b58f6a597aa1b515da90e7  libgomp/testsuite/libgomp.oacc-c-c++-common/abort-1.c
  2187ea0d1f3ce15e1d66e17ed2fecfc6  libgomp/testsuite/libgomp.oacc-c-c++-common/abort-2.c
  659c1e7c321078b832a4fe638bb81184  libgomp/testsuite/libgomp.oacc-c-c++-common/abort-3.c
*************** ad0f604b81bd68d2854d88260581b24f  libgom
*** 129467,129473 ****
  aeaad5052b0b55075519fae4a77d2275  libgomp/testsuite/libgomp.oacc-fortran/lib-1.f90
  463b3f99768cf4a6b78111b273b6de56  libgomp/testsuite/libgomp.oacc-fortran/lib-10.f90
  2cb8539f9bc2791e35d9e5ba01f9b560  libgomp/testsuite/libgomp.oacc-fortran/lib-12.f90
! 2c9dbfa953fb74a2be2be0f010fa0739  libgomp/testsuite/libgomp.oacc-fortran/lib-13.f90
  ed57da4a84299d79c753f649f89caed7  libgomp/testsuite/libgomp.oacc-fortran/lib-14.f90
  91240e943d4c6ac011ae7a5b374f72ef  libgomp/testsuite/libgomp.oacc-fortran/lib-15.f90
  25a129e874b4748b2a86c6b553e0b334  libgomp/testsuite/libgomp.oacc-fortran/lib-16-2.f90
--- 135153,135159 ----
  aeaad5052b0b55075519fae4a77d2275  libgomp/testsuite/libgomp.oacc-fortran/lib-1.f90
  463b3f99768cf4a6b78111b273b6de56  libgomp/testsuite/libgomp.oacc-fortran/lib-10.f90
  2cb8539f9bc2791e35d9e5ba01f9b560  libgomp/testsuite/libgomp.oacc-fortran/lib-12.f90
! bd5b8f0bd81fc6db1c794af4055c7406  libgomp/testsuite/libgomp.oacc-fortran/lib-13.f90
  ed57da4a84299d79c753f649f89caed7  libgomp/testsuite/libgomp.oacc-fortran/lib-14.f90
  91240e943d4c6ac011ae7a5b374f72ef  libgomp/testsuite/libgomp.oacc-fortran/lib-15.f90
  25a129e874b4748b2a86c6b553e0b334  libgomp/testsuite/libgomp.oacc-fortran/lib-16-2.f90
*************** d680e7307fb59fe24f8431e179191f16  libssp
*** 131880,131886 ****
  534c3fb4a88e5c1f70db35c12b7742c3  libssp/vsnprintf-chk.c
  34daeb04a522ee796098df4446d6ce61  libssp/vsprintf-chk.c
  9e2de2e1f20ab0ffa2201164de02824f  libstdc++-v3/.editorconfig
! bdfdd770cfc41eec8441128bf759c36e  libstdc++-v3/ChangeLog
  7aa6c40440a44fcf5ec94c066160c2f8  libstdc++-v3/ChangeLog-1998
  7aff86600b6a1ed3fa87305075a92db0  libstdc++-v3/ChangeLog-1999
  a6f28e8fc9bb07696a9e068b439a3a87  libstdc++-v3/ChangeLog-2000
--- 137566,137572 ----
  534c3fb4a88e5c1f70db35c12b7742c3  libssp/vsnprintf-chk.c
  34daeb04a522ee796098df4446d6ce61  libssp/vsprintf-chk.c
  9e2de2e1f20ab0ffa2201164de02824f  libstdc++-v3/.editorconfig
! e2bda6f183c8c4cb55d15323ead63576  libstdc++-v3/ChangeLog
  7aa6c40440a44fcf5ec94c066160c2f8  libstdc++-v3/ChangeLog-1998
  7aff86600b6a1ed3fa87305075a92db0  libstdc++-v3/ChangeLog-1999
  a6f28e8fc9bb07696a9e068b439a3a87  libstdc++-v3/ChangeLog-2000
*************** d66f986053e4755f0517ff5cfe90b2b5  libstd
*** 132121,132127 ****
  6d16751d668adf69fac47cc69bde7d40  libstdc++-v3/doc/html/api.html
  08920438eea18325b4bfdf979379ff66  libstdc++-v3/doc/html/bk02.html
  47886ba7da131bf3cbf81a27cada5f6f  libstdc++-v3/doc/html/bk03.html
! cbb6c24882a910ad87c8c7a8a8c78839  libstdc++-v3/doc/html/faq.html
  1ae70f0bf94464b036515d333fff8ab2  libstdc++-v3/doc/html/images/confdeps.png
  d7f63b43e9f4c39cf71de7585de522ee  libstdc++-v3/doc/html/images/pbds_balls_and_bins.png
  22eedc841676a98f8ae8b95131ac4d7e  libstdc++-v3/doc/html/images/pbds_binary_priority_queue_int_push.png
--- 137807,137813 ----
  6d16751d668adf69fac47cc69bde7d40  libstdc++-v3/doc/html/api.html
  08920438eea18325b4bfdf979379ff66  libstdc++-v3/doc/html/bk02.html
  47886ba7da131bf3cbf81a27cada5f6f  libstdc++-v3/doc/html/bk03.html
! 2ff76da9446af5dab1f67ad7cafbacaf  libstdc++-v3/doc/html/faq.html
  1ae70f0bf94464b036515d333fff8ab2  libstdc++-v3/doc/html/images/confdeps.png
  d7f63b43e9f4c39cf71de7585de522ee  libstdc++-v3/doc/html/images/pbds_balls_and_bins.png
  22eedc841676a98f8ae8b95131ac4d7e  libstdc++-v3/doc/html/images/pbds_binary_priority_queue_int_push.png
*************** c60c6ae778d5dedae24ac21abf948bdb  libstd
*** 132220,132226 ****
  cc3700f2fde50987f186f23abf98a7b1  libstdc++-v3/doc/html/manual/concept_checking.html
  f3a54a6315d716742603d33f454f2c19  libstdc++-v3/doc/html/manual/concurrency.html
  2bb7c0f8b8c4c8d632b4bb16d5c77345  libstdc++-v3/doc/html/manual/configure.html
! af4e79b9e55fd023eeb0459df34a4a82  libstdc++-v3/doc/html/manual/containers.html
  c7e40c1085e414b3b4d5896db4013205  libstdc++-v3/doc/html/manual/containers_and_c.html
  5905f8be24ae69bb804c3d5a6a4abf7d  libstdc++-v3/doc/html/manual/debug.html
  1bd34529d162b6f3a08d5f2ea4943c6a  libstdc++-v3/doc/html/manual/debug_mode.html
--- 137906,137912 ----
  cc3700f2fde50987f186f23abf98a7b1  libstdc++-v3/doc/html/manual/concept_checking.html
  f3a54a6315d716742603d33f454f2c19  libstdc++-v3/doc/html/manual/concurrency.html
  2bb7c0f8b8c4c8d632b4bb16d5c77345  libstdc++-v3/doc/html/manual/configure.html
! 5328918ec42768cddb06c3e97ef4530c  libstdc++-v3/doc/html/manual/containers.html
  c7e40c1085e414b3b4d5896db4013205  libstdc++-v3/doc/html/manual/containers_and_c.html
  5905f8be24ae69bb804c3d5a6a4abf7d  libstdc++-v3/doc/html/manual/debug.html
  1bd34529d162b6f3a08d5f2ea4943c6a  libstdc++-v3/doc/html/manual/debug_mode.html
*************** afcc2751dae09e088abc1e3175cb94cc  libstd
*** 132240,132248 ****
  561a364254927bdc578ac31f1b66747f  libstdc++-v3/doc/html/manual/ext_demangling.html
  05003e71d54cfdfd4c8291489f8ffa07  libstdc++-v3/doc/html/manual/ext_io.html
  44f8ef8b093904d418755d0e32d700b7  libstdc++-v3/doc/html/manual/ext_iterators.html
! 8f3bd86e04d263ad87cc258c289aae6d  libstdc++-v3/doc/html/manual/ext_numerics.html
  6d380acac52eb8c888a54068e44b16ac  libstdc++-v3/doc/html/manual/ext_preface.html
! 5632eb8ef681cd35b41be7eb7a3d7a98  libstdc++-v3/doc/html/manual/ext_sgi.html
  9b34310c7cb7faa4373ee6683678c457  libstdc++-v3/doc/html/manual/ext_utilities.html
  9e255046a8ef2903114374ed06403045  libstdc++-v3/doc/html/manual/extensions.html
  76cac108e21e304b7607196fb5245e00  libstdc++-v3/doc/html/manual/facets.html
--- 137926,137934 ----
  561a364254927bdc578ac31f1b66747f  libstdc++-v3/doc/html/manual/ext_demangling.html
  05003e71d54cfdfd4c8291489f8ffa07  libstdc++-v3/doc/html/manual/ext_io.html
  44f8ef8b093904d418755d0e32d700b7  libstdc++-v3/doc/html/manual/ext_iterators.html
! ffd5e74a40bbf6623b8ccf687eb584d8  libstdc++-v3/doc/html/manual/ext_numerics.html
  6d380acac52eb8c888a54068e44b16ac  libstdc++-v3/doc/html/manual/ext_preface.html
! 6889f243ab6934ae5f80ea7fa9c69dbf  libstdc++-v3/doc/html/manual/ext_sgi.html
  9b34310c7cb7faa4373ee6683678c457  libstdc++-v3/doc/html/manual/ext_utilities.html
  9e255046a8ef2903114374ed06403045  libstdc++-v3/doc/html/manual/extensions.html
  76cac108e21e304b7607196fb5245e00  libstdc++-v3/doc/html/manual/facets.html
*************** fcdceeabf3a95117ea22e93a0354e564  libstd
*** 132291,132310 ****
  c39b927efcec5ac84139c1490c8ef320  libstdc++-v3/doc/html/manual/traits.html
  530b96535baacfe35df2e65f9dfe7efc  libstdc++-v3/doc/html/manual/unordered_associative.html
  8aa9b7bfbe5a730701f97de49e583432  libstdc++-v3/doc/html/manual/using.html
! 652cd331d7566fb24fe08739f467db7c  libstdc++-v3/doc/html/manual/using_concurrency.html
  f8898e59cc7155a01a17f15a3b853c30  libstdc++-v3/doc/html/manual/using_dual_abi.html
  11dd55e39edb8313b5563e53067c431e  libstdc++-v3/doc/html/manual/using_dynamic_or_shared.html
  09eeb2fa79fb240e032461adcbe2cb4a  libstdc++-v3/doc/html/manual/using_exceptions.html
  91385600a9fbb5f8f29c666917403807  libstdc++-v3/doc/html/manual/using_headers.html
  3411d1e07939e0319750eceefff4b4c2  libstdc++-v3/doc/html/manual/using_macros.html
  e8b86abd99dc9893dfa1bb7533fdc23d  libstdc++-v3/doc/html/manual/using_namespaces.html
! d881fcffb799c09a28d8174ccb1326a2  libstdc++-v3/doc/html/manual/utilities.html
  3d34cd999f3bf3133e40f554b6ba525e  libstdc++-v3/doc/xml/api.xml
  8059eb81f5540dc3ae678ac09e1f3159  libstdc++-v3/doc/xml/authors.xml
  5906074c27c57c65b220c35bbcb2c5ec  libstdc++-v3/doc/xml/book.txml
  44d3a92b83abfb18efac80519c79b44c  libstdc++-v3/doc/xml/chapter.txml
  011b8e6a5442e4dc08f02e7295b644a3  libstdc++-v3/doc/xml/class.txml
! af144d4623f6d57e1bb38450ae860eb1  libstdc++-v3/doc/xml/faq.xml
  ea77580f7e81e2c49aea3f425c01ee2b  libstdc++-v3/doc/xml/gnu/fdl-1.3.xml
  56bb32e9ab9358834c5f8eca2cd0e969  libstdc++-v3/doc/xml/gnu/gpl-3.0.xml
  18a6390297702ec8fd75cbcc525d2005  libstdc++-v3/doc/xml/images/confdeps.dot
--- 137977,137996 ----
  c39b927efcec5ac84139c1490c8ef320  libstdc++-v3/doc/html/manual/traits.html
  530b96535baacfe35df2e65f9dfe7efc  libstdc++-v3/doc/html/manual/unordered_associative.html
  8aa9b7bfbe5a730701f97de49e583432  libstdc++-v3/doc/html/manual/using.html
! 78aa5833e13335bccb9f831528294eb7  libstdc++-v3/doc/html/manual/using_concurrency.html
  f8898e59cc7155a01a17f15a3b853c30  libstdc++-v3/doc/html/manual/using_dual_abi.html
  11dd55e39edb8313b5563e53067c431e  libstdc++-v3/doc/html/manual/using_dynamic_or_shared.html
  09eeb2fa79fb240e032461adcbe2cb4a  libstdc++-v3/doc/html/manual/using_exceptions.html
  91385600a9fbb5f8f29c666917403807  libstdc++-v3/doc/html/manual/using_headers.html
  3411d1e07939e0319750eceefff4b4c2  libstdc++-v3/doc/html/manual/using_macros.html
  e8b86abd99dc9893dfa1bb7533fdc23d  libstdc++-v3/doc/html/manual/using_namespaces.html
! 13c8dfb643338ee235bfc84a29e5d3f2  libstdc++-v3/doc/html/manual/utilities.html
  3d34cd999f3bf3133e40f554b6ba525e  libstdc++-v3/doc/xml/api.xml
  8059eb81f5540dc3ae678ac09e1f3159  libstdc++-v3/doc/xml/authors.xml
  5906074c27c57c65b220c35bbcb2c5ec  libstdc++-v3/doc/xml/book.txml
  44d3a92b83abfb18efac80519c79b44c  libstdc++-v3/doc/xml/chapter.txml
  011b8e6a5442e4dc08f02e7295b644a3  libstdc++-v3/doc/xml/class.txml
! bf9bccd7b0755cfea2731e669eb18a76  libstdc++-v3/doc/xml/faq.xml
  ea77580f7e81e2c49aea3f425c01ee2b  libstdc++-v3/doc/xml/gnu/fdl-1.3.xml
  56bb32e9ab9358834c5f8eca2cd0e969  libstdc++-v3/doc/xml/gnu/gpl-3.0.xml
  18a6390297702ec8fd75cbcc525d2005  libstdc++-v3/doc/xml/images/confdeps.dot
*************** b3f117e4c677e60cf6035cf76714b185  libstd
*** 132499,132512 ****
  af3361d0d0af961859ec0346c38ac8c8  libstdc++-v3/doc/xml/manual/concurrency.xml
  9da4610e32c81714e9188c6852c8dc93  libstdc++-v3/doc/xml/manual/concurrency_extensions.xml
  1baba4ec8761c012c41a2ea967630fe1  libstdc++-v3/doc/xml/manual/configure.xml
! 0af07cc2460e288292186ea8149169ee  libstdc++-v3/doc/xml/manual/containers.xml
  d08c687d9520b2f9d8dd6d973cca9e6a  libstdc++-v3/doc/xml/manual/ctype.xml
  0423695ef5d72eb026dfccb3b68e16ac  libstdc++-v3/doc/xml/manual/debug.xml
  a972c915c47573572139ea9161dec244  libstdc++-v3/doc/xml/manual/debug_mode.xml
  f320f25003678cca910f09ba54c923fc  libstdc++-v3/doc/xml/manual/diagnostics.xml
  3680906036c20b1ccc54e2d06b5a3a24  libstdc++-v3/doc/xml/manual/documentation_hacking.xml
  9691615789c5cdab4a32d141ed8593af  libstdc++-v3/doc/xml/manual/evolution.xml
! f9b28126e916ad19bb8350c6cb6bff95  libstdc++-v3/doc/xml/manual/extensions.xml
  7f1864c7f3c3b2bfde84b7086be97ca7  libstdc++-v3/doc/xml/manual/internals.xml
  fb1b8e4745ce0e8ee919f6013ad8ba87  libstdc++-v3/doc/xml/manual/intro.xml
  01ddfa93b18eebb84ed0144728f9bc9e  libstdc++-v3/doc/xml/manual/io.xml
--- 138185,138198 ----
  af3361d0d0af961859ec0346c38ac8c8  libstdc++-v3/doc/xml/manual/concurrency.xml
  9da4610e32c81714e9188c6852c8dc93  libstdc++-v3/doc/xml/manual/concurrency_extensions.xml
  1baba4ec8761c012c41a2ea967630fe1  libstdc++-v3/doc/xml/manual/configure.xml
! d7100469dfefd97836f3007f2682087d  libstdc++-v3/doc/xml/manual/containers.xml
  d08c687d9520b2f9d8dd6d973cca9e6a  libstdc++-v3/doc/xml/manual/ctype.xml
  0423695ef5d72eb026dfccb3b68e16ac  libstdc++-v3/doc/xml/manual/debug.xml
  a972c915c47573572139ea9161dec244  libstdc++-v3/doc/xml/manual/debug_mode.xml
  f320f25003678cca910f09ba54c923fc  libstdc++-v3/doc/xml/manual/diagnostics.xml
  3680906036c20b1ccc54e2d06b5a3a24  libstdc++-v3/doc/xml/manual/documentation_hacking.xml
  9691615789c5cdab4a32d141ed8593af  libstdc++-v3/doc/xml/manual/evolution.xml
! 250fbd9ce8e61158b22da9b231426c24  libstdc++-v3/doc/xml/manual/extensions.xml
  7f1864c7f3c3b2bfde84b7086be97ca7  libstdc++-v3/doc/xml/manual/internals.xml
  fb1b8e4745ce0e8ee919f6013ad8ba87  libstdc++-v3/doc/xml/manual/intro.xml
  01ddfa93b18eebb84ed0144728f9bc9e  libstdc++-v3/doc/xml/manual/io.xml
*************** bfd38fc5f1090656a5139c94c16ea163  libstd
*** 132535,132543 ****
  2b80feb1b53a8d0895a292620ec430b2  libstdc++-v3/doc/xml/manual/support.xml
  c540dcb615e766afe887215bd7795e42  libstdc++-v3/doc/xml/manual/test.xml
  e2e099be3dd6a4b7a940a7232635ee2c  libstdc++-v3/doc/xml/manual/test_policy_data_structures.xml
! 57bdabb57ce2153ad90ca3b1c6a6edbd  libstdc++-v3/doc/xml/manual/using.xml
  257e301935b13b4b045e571fa248a4d8  libstdc++-v3/doc/xml/manual/using_exceptions.xml
! 74a5acaa32b3d223bd413c1bb5b69ac6  libstdc++-v3/doc/xml/manual/utilities.xml
  c587674e0c370a2d6ccc5213ab3e4e65  libstdc++-v3/doc/xml/spine.xml
  bd966b4a0df6f2a84f9770525581d45c  libstdc++-v3/doc/xsl/customization.xsl.in
  42d14268f2b16c54a6bc2f71538a838c  libstdc++-v3/fragment.am
--- 138221,138229 ----
  2b80feb1b53a8d0895a292620ec430b2  libstdc++-v3/doc/xml/manual/support.xml
  c540dcb615e766afe887215bd7795e42  libstdc++-v3/doc/xml/manual/test.xml
  e2e099be3dd6a4b7a940a7232635ee2c  libstdc++-v3/doc/xml/manual/test_policy_data_structures.xml
! 89a63a549c3438b3bee6bbf18f4c8b3e  libstdc++-v3/doc/xml/manual/using.xml
  257e301935b13b4b045e571fa248a4d8  libstdc++-v3/doc/xml/manual/using_exceptions.xml
! b820e3490221bb85cbf6bcdde0aa8150  libstdc++-v3/doc/xml/manual/utilities.xml
  c587674e0c370a2d6ccc5213ab3e4e65  libstdc++-v3/doc/xml/spine.xml
  bd966b4a0df6f2a84f9770525581d45c  libstdc++-v3/doc/xsl/customization.xsl.in
  42d14268f2b16c54a6bc2f71538a838c  libstdc++-v3/fragment.am
*************** ae425609ae2fe546893a19529f01920c  libstd
*** 132554,132560 ****
  5bf7a6fc5e70783cfa8d69bf57bbad03  libstdc++-v3/include/bits/algorithmfwd.h
  7bc72c71178202a8889ee8eaf3bd46e0  libstdc++-v3/include/bits/align.h
  c2f5862787920c2fc07b4f499e362a00  libstdc++-v3/include/bits/alloc_traits.h
! c124f049cd4f41ebcf3bbfd04df17cf5  libstdc++-v3/include/bits/allocated_ptr.h
  d18c16b3c9c3ab2e7d487de90ec27d17  libstdc++-v3/include/bits/allocator.h
  a65f3932e944795c8e78b00d2e7f11a0  libstdc++-v3/include/bits/atomic_base.h
  7c88fbee1dffec663e740720882b5344  libstdc++-v3/include/bits/atomic_futex.h
--- 138240,138246 ----
  5bf7a6fc5e70783cfa8d69bf57bbad03  libstdc++-v3/include/bits/algorithmfwd.h
  7bc72c71178202a8889ee8eaf3bd46e0  libstdc++-v3/include/bits/align.h
  c2f5862787920c2fc07b4f499e362a00  libstdc++-v3/include/bits/alloc_traits.h
! 752923e212a8a01f4d659889177a76eb  libstdc++-v3/include/bits/allocated_ptr.h
  d18c16b3c9c3ab2e7d487de90ec27d17  libstdc++-v3/include/bits/allocator.h
  a65f3932e944795c8e78b00d2e7f11a0  libstdc++-v3/include/bits/atomic_base.h
  7c88fbee1dffec663e740720882b5344  libstdc++-v3/include/bits/atomic_futex.h
*************** a155d2afa910d24be0955f42c4585228  libstd
*** 132570,132576 ****
  5384dfbb9eb9731df3aca40e40d55350  libstdc++-v3/include/bits/char_traits.h
  195dabcb74f9b313c574745539925b0e  libstdc++-v3/include/bits/charconv.h
  2ac54ed5e0fab6bc6f771ecb2e9a9757  libstdc++-v3/include/bits/chrono.h
! 7fa0d6e1eeff4588d8b8cecee70e9fff  libstdc++-v3/include/bits/chrono_io.h
  2ff73cb405cb01626a751e0fa0f339f3  libstdc++-v3/include/bits/codecvt.h
  23fc42ee8644308c793f44d20f00420e  libstdc++-v3/include/bits/concept_check.h
  e999e0783a5ca2165919f352526501e9  libstdc++-v3/include/bits/cow_string.h
--- 138256,138262 ----
  5384dfbb9eb9731df3aca40e40d55350  libstdc++-v3/include/bits/char_traits.h
  195dabcb74f9b313c574745539925b0e  libstdc++-v3/include/bits/charconv.h
  2ac54ed5e0fab6bc6f771ecb2e9a9757  libstdc++-v3/include/bits/chrono.h
! cc5518c10418c2359bc69e4558d1ad10  libstdc++-v3/include/bits/chrono_io.h
  2ff73cb405cb01626a751e0fa0f339f3  libstdc++-v3/include/bits/codecvt.h
  23fc42ee8644308c793f44d20f00420e  libstdc++-v3/include/bits/concept_check.h
  e999e0783a5ca2165919f352526501e9  libstdc++-v3/include/bits/cow_string.h
*************** e999e0783a5ca2165919f352526501e9  libstd
*** 132580,132586 ****
  be08582d1795753f6e8fb613a7ec9fe0  libstdc++-v3/include/bits/elements_of.h
  397af990234a7f718cce0f629f7d8b13  libstdc++-v3/include/bits/enable_special_members.h
  b194eb42ed4e3bc3a3f65805561d45c8  libstdc++-v3/include/bits/erase_if.h
! a2ea979f878ca6e58859f083a08dd4ae  libstdc++-v3/include/bits/formatfwd.h
  3c1cd1724fd697b7e7c6c0b2233c4c62  libstdc++-v3/include/bits/forward_list.h
  8123372b7074a636b749e1e60f9f2b81  libstdc++-v3/include/bits/forward_list.tcc
  547631f602a86bc167ed71b762904cd9  libstdc++-v3/include/bits/fs_dir.h
--- 138266,138272 ----
  be08582d1795753f6e8fb613a7ec9fe0  libstdc++-v3/include/bits/elements_of.h
  397af990234a7f718cce0f629f7d8b13  libstdc++-v3/include/bits/enable_special_members.h
  b194eb42ed4e3bc3a3f65805561d45c8  libstdc++-v3/include/bits/erase_if.h
! 83f2f221de29b3bd5f910e7b8cc27404  libstdc++-v3/include/bits/formatfwd.h
  3c1cd1724fd697b7e7c6c0b2233c4c62  libstdc++-v3/include/bits/forward_list.h
  8123372b7074a636b749e1e60f9f2b81  libstdc++-v3/include/bits/forward_list.tcc
  547631f602a86bc167ed71b762904cd9  libstdc++-v3/include/bits/fs_dir.h
*************** e447352e9df05640e24a5f9f85d288ce  libstd
*** 132662,132668 ****
  c35a5da0369f3af2e9e202c9c8510914  libstdc++-v3/include/bits/std_function.h
  5b3bd66db6802c89905c016f488a41d0  libstdc++-v3/include/bits/std_mutex.h
  bb19c550085b43f6251959e05791f4c6  libstdc++-v3/include/bits/std_thread.h
! 551d2aa52bb5f639424652a68f20dae7  libstdc++-v3/include/bits/stl_algo.h
  ba1901789908a4eca42f3ec20afebc3a  libstdc++-v3/include/bits/stl_algobase.h
  50378fb402a4f63ad663a2763f5cd08a  libstdc++-v3/include/bits/stl_bvector.h
  8b19d3c29a5f7649b167865966c49a51  libstdc++-v3/include/bits/stl_construct.h
--- 138348,138354 ----
  c35a5da0369f3af2e9e202c9c8510914  libstdc++-v3/include/bits/std_function.h
  5b3bd66db6802c89905c016f488a41d0  libstdc++-v3/include/bits/std_mutex.h
  bb19c550085b43f6251959e05791f4c6  libstdc++-v3/include/bits/std_thread.h
! c8d5adfa5bf86a058ba1965ae82a2d92  libstdc++-v3/include/bits/stl_algo.h
  ba1901789908a4eca42f3ec20afebc3a  libstdc++-v3/include/bits/stl_algobase.h
  50378fb402a4f63ad663a2763f5cd08a  libstdc++-v3/include/bits/stl_bvector.h
  8b19d3c29a5f7649b167865966c49a51  libstdc++-v3/include/bits/stl_construct.h
*************** c48928d63732da42056105c33cf860ff  libstd
*** 132686,132692 ****
  e090d043a8cdc4479dde4340af533938  libstdc++-v3/include/bits/stl_tempbuf.h
  eaceb582a18a6a7ee11227f1fc82b069  libstdc++-v3/include/bits/stl_tree.h
  875a120da5d87944fd151bca22a7703c  libstdc++-v3/include/bits/stl_uninitialized.h
! 9010dbe896c4b5cdce2333682a11059b  libstdc++-v3/include/bits/stl_vector.h
  c021eea8ffb782c5cae76e39deaa7369  libstdc++-v3/include/bits/stream_iterator.h
  69fecd7181ec71c850dba6e19cf9a58c  libstdc++-v3/include/bits/streambuf.tcc
  512415517592a497decfef44b9a855e2  libstdc++-v3/include/bits/streambuf_iterator.h
--- 138372,138378 ----
  e090d043a8cdc4479dde4340af533938  libstdc++-v3/include/bits/stl_tempbuf.h
  eaceb582a18a6a7ee11227f1fc82b069  libstdc++-v3/include/bits/stl_tree.h
  875a120da5d87944fd151bca22a7703c  libstdc++-v3/include/bits/stl_uninitialized.h
! 2b3876a7052223fd5d8ba2a62f835c80  libstdc++-v3/include/bits/stl_vector.h
  c021eea8ffb782c5cae76e39deaa7369  libstdc++-v3/include/bits/stream_iterator.h
  69fecd7181ec71c850dba6e19cf9a58c  libstdc++-v3/include/bits/streambuf.tcc
  512415517592a497decfef44b9a855e2  libstdc++-v3/include/bits/streambuf_iterator.h
*************** a4387732ff6f5fe0fd6bc87c3b3fa197  libstd
*** 132923,132942 ****
  1fdce2bb945b0f1aed415a901ee902aa  libstdc++-v3/include/ext/numeric
  f7e6cac9b3c3e7914f4ec110f4171f0b  libstdc++-v3/include/ext/numeric_traits.h
  7764167e114c092ba1e1921f64f8a7f2  libstdc++-v3/include/ext/pb_ds/assoc_container.hpp
! 41e726c898f6cce1626871277a7c812b  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/bin_search_tree_.hpp
  86d62df690f670934b48412d9a9a98bb  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/constructors_destructor_fn_imps.hpp
  6bc2b6fa5a4a9ab8a24d781858627bb0  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/debug_fn_imps.hpp
  c080d4dbe4cef6b8bfa7ef497cf75fd9  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/erase_fn_imps.hpp
  297454a4a62817dbe7579a071f16ad9f  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/find_fn_imps.hpp
  132f3289421cb221eece6f21679e6d35  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/info_fn_imps.hpp
! 6d9e5523870b8b172668d0911f63b2a2  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/insert_fn_imps.hpp
  c71c53de5903e4b44f525d2436f87a69  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/iterators_fn_imps.hpp
  0c746022576adfe90d96719243949ec5  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/node_iterators.hpp
  ec315910fe67e10bd78aa28ef56e70a8  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/point_iterators.hpp
  4598e014b153eb28eeea8426149181fa  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/policy_access_fn_imps.hpp
  5debaabd3335ff6bd3356d99b70efe90  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/r_erase_fn_imps.hpp
! 46ba3cb3191fd2c8936bf721174929cf  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/rotate_fn_imps.hpp
! 3ab2388e6950106caf4e4ac567e2a0d1  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/split_join_fn_imps.hpp
  2a2524ea43bf488911f55bb885d180c7  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/traits.hpp
  e0ea1a6df9fdc5541cc14407fad6fe33  libstdc++-v3/include/ext/pb_ds/detail/binary_heap_/binary_heap_.hpp
  3320bb430899ed69bf91b1b3d3735432  libstdc++-v3/include/ext/pb_ds/detail/binary_heap_/const_iterator.hpp
--- 138609,138628 ----
  1fdce2bb945b0f1aed415a901ee902aa  libstdc++-v3/include/ext/numeric
  f7e6cac9b3c3e7914f4ec110f4171f0b  libstdc++-v3/include/ext/numeric_traits.h
  7764167e114c092ba1e1921f64f8a7f2  libstdc++-v3/include/ext/pb_ds/assoc_container.hpp
! cc20608c2498454253a55ac23b7236f2  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/bin_search_tree_.hpp
  86d62df690f670934b48412d9a9a98bb  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/constructors_destructor_fn_imps.hpp
  6bc2b6fa5a4a9ab8a24d781858627bb0  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/debug_fn_imps.hpp
  c080d4dbe4cef6b8bfa7ef497cf75fd9  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/erase_fn_imps.hpp
  297454a4a62817dbe7579a071f16ad9f  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/find_fn_imps.hpp
  132f3289421cb221eece6f21679e6d35  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/info_fn_imps.hpp
! 51cc0708995251294d61c24678213f69  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/insert_fn_imps.hpp
  c71c53de5903e4b44f525d2436f87a69  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/iterators_fn_imps.hpp
  0c746022576adfe90d96719243949ec5  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/node_iterators.hpp
  ec315910fe67e10bd78aa28ef56e70a8  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/point_iterators.hpp
  4598e014b153eb28eeea8426149181fa  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/policy_access_fn_imps.hpp
  5debaabd3335ff6bd3356d99b70efe90  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/r_erase_fn_imps.hpp
! 29f8cbbba9ad8ab6beddb2cf9ecde44f  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/rotate_fn_imps.hpp
! eb6212a04833db407f0f16dd068dd30c  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/split_join_fn_imps.hpp
  2a2524ea43bf488911f55bb885d180c7  libstdc++-v3/include/ext/pb_ds/detail/bin_search_tree_/traits.hpp
  e0ea1a6df9fdc5541cc14407fad6fe33  libstdc++-v3/include/ext/pb_ds/detail/binary_heap_/binary_heap_.hpp
  3320bb430899ed69bf91b1b3d3735432  libstdc++-v3/include/ext/pb_ds/detail/binary_heap_/const_iterator.hpp
*************** a37b816c59e13b926667fbac1e98440d  libstd
*** 133100,133106 ****
  eaac5f1234da3b94c6d94eccadfe7d39  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/find_fn_imps.hpp
  3594fb3496fdd42d7fa40bbaebc8363d  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/info_fn_imps.hpp
  fff3b61b18f4cc869a4ae79d002aedc2  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/insert_fn_imps.hpp
! f5c2d4365147e4a4a61c22fbe65de3eb  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/node.hpp
  28c6c756335712d830080a5e4689b955  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/rb_tree_.hpp
  ad9593f4b582796f99b18403f1147dc8  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/split_join_fn_imps.hpp
  75c4dcee348ceb577b9b58fb01c31bfa  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/traits.hpp
--- 138786,138792 ----
  eaac5f1234da3b94c6d94eccadfe7d39  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/find_fn_imps.hpp
  3594fb3496fdd42d7fa40bbaebc8363d  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/info_fn_imps.hpp
  fff3b61b18f4cc869a4ae79d002aedc2  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/insert_fn_imps.hpp
! 0aa24de505c9fc8c71d65787c9bc6dab  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/node.hpp
  28c6c756335712d830080a5e4689b955  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/rb_tree_.hpp
  ad9593f4b582796f99b18403f1147dc8  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/split_join_fn_imps.hpp
  75c4dcee348ceb577b9b58fb01c31bfa  libstdc++-v3/include/ext/pb_ds/detail/rb_tree_map_/traits.hpp
*************** df6fcd9c95476a827df1b04bc62f6393  libstd
*** 133127,133133 ****
  1c384d33f03f55f63fbfd7556cfea367  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/find_fn_imps.hpp
  366ba64e390f58342245f5950e3c6fb8  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/info_fn_imps.hpp
  d6afa8807c4cd1986462d27199befdc5  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/insert_fn_imps.hpp
! 6c681d0ddfc7755ecaea9e69cbe2d835  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/node.hpp
  4e0f1ab2fa4c2d974eab3c74a855a6f6  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/splay_fn_imps.hpp
  1404fb904eae6138b2fdb3d63f95b3c3  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/splay_tree_.hpp
  2efc69c7a1ce5a7f8f1437573e479ede  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/split_join_fn_imps.hpp
--- 138813,138819 ----
  1c384d33f03f55f63fbfd7556cfea367  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/find_fn_imps.hpp
  366ba64e390f58342245f5950e3c6fb8  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/info_fn_imps.hpp
  d6afa8807c4cd1986462d27199befdc5  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/insert_fn_imps.hpp
! 972ea9be4133e9a2af0e156053038ed7  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/node.hpp
  4e0f1ab2fa4c2d974eab3c74a855a6f6  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/splay_fn_imps.hpp
  1404fb904eae6138b2fdb3d63f95b3c3  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/splay_tree_.hpp
  2efc69c7a1ce5a7f8f1437573e479ede  libstdc++-v3/include/ext/pb_ds/detail/splay_tree_/split_join_fn_imps.hpp
*************** ae96a272e65886b9386e26db37971da1  libstd
*** 133276,133282 ****
  c2e511ae49957a9f02446e544d201582  libstdc++-v3/include/std/filesystem
  f178b6bdcfd6bb2ca46e3cdf19989aaf  libstdc++-v3/include/std/flat_map
  8a5fa0a4bb554b2db8c2fed26a6993ca  libstdc++-v3/include/std/flat_set
! 94a087729f822debd1b8fea53b3bac94  libstdc++-v3/include/std/format
  fa4316749922813b44f2ee282452813b  libstdc++-v3/include/std/forward_list
  e790ae6877466aa86b47f36d201e8563  libstdc++-v3/include/std/fstream
  52b0de886d5de3c5cf37079e9e0c831e  libstdc++-v3/include/std/functional
--- 138962,138968 ----
  c2e511ae49957a9f02446e544d201582  libstdc++-v3/include/std/filesystem
  f178b6bdcfd6bb2ca46e3cdf19989aaf  libstdc++-v3/include/std/flat_map
  8a5fa0a4bb554b2db8c2fed26a6993ca  libstdc++-v3/include/std/flat_set
! 185c76e0066f6c1f63b259bc67e3671e  libstdc++-v3/include/std/format
  fa4316749922813b44f2ee282452813b  libstdc++-v3/include/std/forward_list
  e790ae6877466aa86b47f36d201e8563  libstdc++-v3/include/std/fstream
  52b0de886d5de3c5cf37079e9e0c831e  libstdc++-v3/include/std/functional
*************** b944796362aa39fc1cba3747d2247464  libstd
*** 133304,133310 ****
  8883599080e145869428c2dc9e59e2d3  libstdc++-v3/include/std/print
  317c818ab1030cf117c8d8ef03df06aa  libstdc++-v3/include/std/queue
  01746ff9db8573f15b943b0c36cce6a8  libstdc++-v3/include/std/random
! fec0869f0d5bc62d35559515d6ff9efc  libstdc++-v3/include/std/ranges
  a28bf4bed6789b61535d4b05ff48ba76  libstdc++-v3/include/std/ratio
  400d95a1fd416911b5c47562d7a586cf  libstdc++-v3/include/std/regex
  1bad2aed72c4537e7f08d24c1bf7d375  libstdc++-v3/include/std/scoped_allocator
--- 138990,138996 ----
  8883599080e145869428c2dc9e59e2d3  libstdc++-v3/include/std/print
  317c818ab1030cf117c8d8ef03df06aa  libstdc++-v3/include/std/queue
  01746ff9db8573f15b943b0c36cce6a8  libstdc++-v3/include/std/random
! 83f0b1fb9db24c31bf034bd93bb4dec8  libstdc++-v3/include/std/ranges
  a28bf4bed6789b61535d4b05ff48ba76  libstdc++-v3/include/std/ratio
  400d95a1fd416911b5c47562d7a586cf  libstdc++-v3/include/std/regex
  1bad2aed72c4537e7f08d24c1bf7d375  libstdc++-v3/include/std/scoped_allocator
*************** c5a4df8fdbbe4b3d33d0b52db500e16d  libstd
*** 133328,133334 ****
  608edef7344e2e25c7b00170df6fa9e6  libstdc++-v3/include/std/text_encoding
  7cdac9ea092e51e067047e2b3fb2060e  libstdc++-v3/include/std/thread
  af3d3134c33d40c51e1d3493f1fb7cc4  libstdc++-v3/include/std/tuple
! 11b8b579265daeb06b359039ec989bd0  libstdc++-v3/include/std/type_traits
  237682577d22ec3f9f5046abf0acd8e7  libstdc++-v3/include/std/typeindex
  520c52362f53e18f20838693cfd131bf  libstdc++-v3/include/std/unordered_map
  c82be32edefaa23cc1228b092d319315  libstdc++-v3/include/std/unordered_set
--- 139014,139020 ----
  608edef7344e2e25c7b00170df6fa9e6  libstdc++-v3/include/std/text_encoding
  7cdac9ea092e51e067047e2b3fb2060e  libstdc++-v3/include/std/thread
  af3d3134c33d40c51e1d3493f1fb7cc4  libstdc++-v3/include/std/tuple
! 616a544220511645637b756b8541cbbc  libstdc++-v3/include/std/type_traits
  237682577d22ec3f9f5046abf0acd8e7  libstdc++-v3/include/std/typeindex
  520c52362f53e18f20838693cfd131bf  libstdc++-v3/include/std/unordered_map
  c82be32edefaa23cc1228b092d319315  libstdc++-v3/include/std/unordered_set
*************** d100df3b99954e5e2a1e25ac7967528c  libstd
*** 133726,133732 ****
  fa6dd9de47fc1161957dd77bcc925b13  libstdc++-v3/testsuite/17_intro/headers/c++2011/stdc++_multiple_inclusion.cc
  e4a354a67235724c5f38b1fc51630071  libstdc++-v3/testsuite/17_intro/headers/c++2014/parallel_mode.cc
  1b083d4d975f6db8c98c387c2bf43571  libstdc++-v3/testsuite/17_intro/headers/c++2017/parallel_mode.cc
! 0356cb159c4380ee8a1f33c09ac965fc  libstdc++-v3/testsuite/17_intro/names.cc
  d4446489cc9fd961dbc2f15b2b21fca7  libstdc++-v3/testsuite/17_intro/names_fortify.cc
  047ad714f0a1ac010ab86a084dfbeee7  libstdc++-v3/testsuite/17_intro/names_pstl.cc
  441838fc5a4a7a22a784014872e61926  libstdc++-v3/testsuite/17_intro/no_library_allocation.cc
--- 139412,139418 ----
  fa6dd9de47fc1161957dd77bcc925b13  libstdc++-v3/testsuite/17_intro/headers/c++2011/stdc++_multiple_inclusion.cc
  e4a354a67235724c5f38b1fc51630071  libstdc++-v3/testsuite/17_intro/headers/c++2014/parallel_mode.cc
  1b083d4d975f6db8c98c387c2bf43571  libstdc++-v3/testsuite/17_intro/headers/c++2017/parallel_mode.cc
! 7f01089dc29f96fc0646e5f6eac22088  libstdc++-v3/testsuite/17_intro/names.cc
  d4446489cc9fd961dbc2f15b2b21fca7  libstdc++-v3/testsuite/17_intro/names_fortify.cc
  047ad714f0a1ac010ab86a084dfbeee7  libstdc++-v3/testsuite/17_intro/names_pstl.cc
  441838fc5a4a7a22a784014872e61926  libstdc++-v3/testsuite/17_intro/no_library_allocation.cc
*************** ebde987c113a55b32ea322fba95ec3f2  libstd
*** 135689,135695 ****
  de68a2633d601fbfd9f5501202a433c5  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stof.cc
  6b6735c2885477b5563b6455ce0a063c  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoi.cc
  c46e9466d31d10951084cd80a85a6df2  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stol.cc
! 595411d04f967e3ea5a3b14b25374b70  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stold.cc
  8bfb66475758e82e18afb690a98e3300  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoll.cc
  7a0e335930b576532d833cc34357e350  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoul.cc
  89c59f7c29485df591ce3b0741ac26c2  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoull.cc
--- 141375,141381 ----
  de68a2633d601fbfd9f5501202a433c5  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stof.cc
  6b6735c2885477b5563b6455ce0a063c  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoi.cc
  c46e9466d31d10951084cd80a85a6df2  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stol.cc
! fc17d1cda5b1fd12f5cb9cd79de92450  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stold.cc
  8bfb66475758e82e18afb690a98e3300  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoll.cc
  7a0e335930b576532d833cc34357e350  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoul.cc
  89c59f7c29485df591ce3b0741ac26c2  libstdc++-v3/testsuite/21_strings/basic_string/numeric_conversions/char/stoull.cc
*************** e3eb212137f2101dd4ceb83392d4f604  libstd
*** 138089,138095 ****
  7a66bf7f5aca27ddc8ca203f2f55a9b6  libstdc++-v3/testsuite/23_containers/vector/cons/destroy-adl.cc
  03d4bbea96b2b7d622e0f0d4ed285e82  libstdc++-v3/testsuite/23_containers/vector/cons/destructible_debug_neg.cc
  c321498bb25d81efcdb153b4281a5653  libstdc++-v3/testsuite/23_containers/vector/cons/destructible_neg.cc
! e3eb5ec108c278899d4e5ba74e9a28f9  libstdc++-v3/testsuite/23_containers/vector/cons/from_range.cc
  95343136dbd192e25dfe16b3a4eda01d  libstdc++-v3/testsuite/23_containers/vector/cons/moveable.cc
  f1d10ca32c2d09fd89ac466ce1077fce  libstdc++-v3/testsuite/23_containers/vector/cons/moveable2.cc
  7e7b7e0e0333f9178ee8f602413f5ce6  libstdc++-v3/testsuite/23_containers/vector/cons/noexcept_move_construct.cc
--- 143775,143781 ----
  7a66bf7f5aca27ddc8ca203f2f55a9b6  libstdc++-v3/testsuite/23_containers/vector/cons/destroy-adl.cc
  03d4bbea96b2b7d622e0f0d4ed285e82  libstdc++-v3/testsuite/23_containers/vector/cons/destructible_debug_neg.cc
  c321498bb25d81efcdb153b4281a5653  libstdc++-v3/testsuite/23_containers/vector/cons/destructible_neg.cc
! 833017a30b2de971981f574bdc3fd989  libstdc++-v3/testsuite/23_containers/vector/cons/from_range.cc
  95343136dbd192e25dfe16b3a4eda01d  libstdc++-v3/testsuite/23_containers/vector/cons/moveable.cc
  f1d10ca32c2d09fd89ac466ce1077fce  libstdc++-v3/testsuite/23_containers/vector/cons/moveable2.cc
  7e7b7e0e0333f9178ee8f602413f5ce6  libstdc++-v3/testsuite/23_containers/vector/cons/noexcept_move_construct.cc
*************** dc72aaba1141a4d064d97cb11b1948ff  libstd
*** 139173,139178 ****
--- 144859,144865 ----
  e926410ecd98200362050b556c737fe6  libstdc++-v3/testsuite/25_algorithms/unique/requirements/explicit_instantiation/2.cc
  8cbfbe8c64ba99a379dcb9628a6ff052  libstdc++-v3/testsuite/25_algorithms/unique/requirements/explicit_instantiation/pod.cc
  18e3546d23e1a57a6cb1ade1374222f5  libstdc++-v3/testsuite/25_algorithms/unique_copy/1.cc
+ af21e5ed22ae1277398751ff84914c01  libstdc++-v3/testsuite/25_algorithms/unique_copy/120384.cc
  566c21bbd932c2ff2ea7ab5d0d026853  libstdc++-v3/testsuite/25_algorithms/unique_copy/2.cc
  bccc2620741d0bb50ee990ac03515498  libstdc++-v3/testsuite/25_algorithms/unique_copy/26133.cc
  9017b16aa2b3514d77f2217dfa840239  libstdc++-v3/testsuite/25_algorithms/unique_copy/check_type.cc
*************** aa87a2a9dc3943eaea6fd74a739d684e  libstd
*** 140266,140272 ****
  46012fb4c31f720d39ac8181d8f93b3a  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/9555-oa.cc
  c55789b83011162a25fae5a534df8475  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/exceptions_badbit_throw.cc
  29f84588cd31cfd1b105074d9378bc90  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/exceptions_failbit_throw.cc
! f16d41a17fdbe919be3478162a77b9a0  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/hexfloat.cc
  d2a0eb246a96a8167b3794e2ea4912ab  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/lwg4101.cc
  6312d8efa7d92f8d6a16519ac3d21cb8  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/pod/23875.cc
  456db46635888232194e7ccd53e8b6cf  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/wchar_t/1.cc
--- 145953,145959 ----
  46012fb4c31f720d39ac8181d8f93b3a  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/9555-oa.cc
  c55789b83011162a25fae5a534df8475  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/exceptions_badbit_throw.cc
  29f84588cd31cfd1b105074d9378bc90  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/exceptions_failbit_throw.cc
! ee63b856fc7c358bf04e1d7040ecd6ab  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/char/hexfloat.cc
  d2a0eb246a96a8167b3794e2ea4912ab  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/lwg4101.cc
  6312d8efa7d92f8d6a16519ac3d21cb8  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/pod/23875.cc
  456db46635888232194e7ccd53e8b6cf  libstdc++-v3/testsuite/27_io/basic_ostream/inserters_arithmetic/wchar_t/1.cc
*************** a7244ffd437f4addc853cfdd012c5cba  libstd
*** 142770,142776 ****
  c5e2b63672ec2df6fdcba9b4e1ba3ba0  libstdc++-v3/testsuite/std/format/functions/format_to_n.cc
  f859e29ec6cd7017c9d0abc60ed4b8ce  libstdc++-v3/testsuite/std/format/functions/size.cc
  fc7c0a7a8dd0259caaa437eac20a9eca  libstdc++-v3/testsuite/std/format/functions/vformat_to.cc
! 9f02ea2ba64dd911c4f66a5c1fbdc6ad  libstdc++-v3/testsuite/std/format/parse_ctx.cc
  98a750919025b1a6b7cbab28d1aba84a  libstdc++-v3/testsuite/std/format/parse_ctx_neg.cc
  00ee268f5a1f913167de4aeea261dd30  libstdc++-v3/testsuite/std/format/ranges/adaptors.cc
  857552c77c29e3b58e4847f84fc27778  libstdc++-v3/testsuite/std/format/ranges/feature_test.cc
--- 148457,148463 ----
  c5e2b63672ec2df6fdcba9b4e1ba3ba0  libstdc++-v3/testsuite/std/format/functions/format_to_n.cc
  f859e29ec6cd7017c9d0abc60ed4b8ce  libstdc++-v3/testsuite/std/format/functions/size.cc
  fc7c0a7a8dd0259caaa437eac20a9eca  libstdc++-v3/testsuite/std/format/functions/vformat_to.cc
! 341fd71f544307f85453dfa5d899e9df  libstdc++-v3/testsuite/std/format/parse_ctx.cc
  98a750919025b1a6b7cbab28d1aba84a  libstdc++-v3/testsuite/std/format/parse_ctx_neg.cc
  00ee268f5a1f913167de4aeea261dd30  libstdc++-v3/testsuite/std/format/ranges/adaptors.cc
  857552c77c29e3b58e4847f84fc27778  libstdc++-v3/testsuite/std/format/ranges/feature_test.cc
*************** e9ef3f2b572f799b265913487f27690b  libstd
*** 142900,142906 ****
  1cd9b515badcd164d6958b0fbbbb52cf  libstdc++-v3/testsuite/std/time/clock/file/overview.cc
  811bf06fb6123b7a4dc922fa36ba8a06  libstdc++-v3/testsuite/std/time/clock/gps/1.cc
  e9c8ba287435179e8670bb6951a6b4fa  libstdc++-v3/testsuite/std/time/clock/gps/io.cc
! 7d24bd5e236b9d29304e5b9940a2df32  libstdc++-v3/testsuite/std/time/clock/local/io.cc
  13ae31163906c8eda2c2021c882bdc89  libstdc++-v3/testsuite/std/time/clock/system/io.cc
  b3cda48993495a5d2ff69f7f1ad2c695  libstdc++-v3/testsuite/std/time/clock/tai/1.cc
  a87e1152f6bc2804b93ce070a51eeb54  libstdc++-v3/testsuite/std/time/clock/tai/io.cc
--- 148587,148593 ----
  1cd9b515badcd164d6958b0fbbbb52cf  libstdc++-v3/testsuite/std/time/clock/file/overview.cc
  811bf06fb6123b7a4dc922fa36ba8a06  libstdc++-v3/testsuite/std/time/clock/gps/1.cc
  e9c8ba287435179e8670bb6951a6b4fa  libstdc++-v3/testsuite/std/time/clock/gps/io.cc
! 77e52cac2443b4c26b20b6bb1f917624  libstdc++-v3/testsuite/std/time/clock/local/io.cc
  13ae31163906c8eda2c2021c882bdc89  libstdc++-v3/testsuite/std/time/clock/system/io.cc
  b3cda48993495a5d2ff69f7f1ad2c695  libstdc++-v3/testsuite/std/time/clock/tai/1.cc
  a87e1152f6bc2804b93ce070a51eeb54  libstdc++-v3/testsuite/std/time/clock/tai/io.cc
*************** c3f6449e12f804b01646cd21242151c3  libstd
*** 143651,143657 ****
  19c2fa8ba9e2522c878cabf63c5d9665  libstdc++-v3/testsuite/util/performance/time/elapsed_timer.hpp
  c0f380760212f23bd9a8e7a78a05ff79  libstdc++-v3/testsuite/util/performance/time/timing_test_base.hpp
  f229f005fb6b0edfab2a25224f4aa670  libstdc++-v3/testsuite/util/pstl/pstl_test_config.h
! c9e37353b8b63e5ef350dccbc4776562  libstdc++-v3/testsuite/util/pstl/test_utils.h
  4cf92cc043ea255a4575695899068aa8  libstdc++-v3/testsuite/util/regression/basic_type.hpp
  28c3a04a29ae10b23f618124e0c23fab  libstdc++-v3/testsuite/util/regression/common_type.hpp
  1920340387faacc66cc1e6d9fff1c203  libstdc++-v3/testsuite/util/regression/rand/assoc/container_rand_regression_test.h
--- 149338,149344 ----
  19c2fa8ba9e2522c878cabf63c5d9665  libstdc++-v3/testsuite/util/performance/time/elapsed_timer.hpp
  c0f380760212f23bd9a8e7a78a05ff79  libstdc++-v3/testsuite/util/performance/time/timing_test_base.hpp
  f229f005fb6b0edfab2a25224f4aa670  libstdc++-v3/testsuite/util/pstl/pstl_test_config.h
! 55baea8c9c13ca011d239763ff0df1a9  libstdc++-v3/testsuite/util/pstl/test_utils.h
  4cf92cc043ea255a4575695899068aa8  libstdc++-v3/testsuite/util/regression/basic_type.hpp
  28c3a04a29ae10b23f618124e0c23fab  libstdc++-v3/testsuite/util/regression/common_type.hpp
  1920340387faacc66cc1e6d9fff1c203  libstdc++-v3/testsuite/util/regression/rand/assoc/container_rand_regression_test.h
*************** dee72a6a60e99528b0d17bf3ff9a1e15  ltopti
*** 143806,143812 ****
  bc2f6032c98896249eadb56177c7d357  ltsugar.m4
  c30cd33c496505f13d9fbdb6970c7c33  ltversion.m4
  293853a13b7e218e3a4342cf85fbbf25  lt~obsolete.m4
! 3b0f6536f38438b660b7410612a17de2  maintainer-scripts/ChangeLog
  33c7bc2d2c55956dfac85a05d8a80eff  maintainer-scripts/README
  507e832af5f2d63b8a78eef217c807a7  maintainer-scripts/branch_changer.py
  c819510f0d438149c1518bda7b165ac4  maintainer-scripts/bugzilla-close-candidate.py
--- 149493,149499 ----
  bc2f6032c98896249eadb56177c7d357  ltsugar.m4
  c30cd33c496505f13d9fbdb6970c7c33  ltversion.m4
  293853a13b7e218e3a4342cf85fbbf25  lt~obsolete.m4
! 14a378d731b3a3af3bf72c08193ad683  maintainer-scripts/ChangeLog
  33c7bc2d2c55956dfac85a05d8a80eff  maintainer-scripts/README
  507e832af5f2d63b8a78eef217c807a7  maintainer-scripts/branch_changer.py
  c819510f0d438149c1518bda7b165ac4  maintainer-scripts/bugzilla-close-candidate.py
*************** c67f943b672b0dc1c628ebb0e2df97a3  mainta
*** 143816,143822 ****
  33d97164a8610c7abf67eff7d28f47ff  maintainer-scripts/maintainer-addresses
  1fcc4f18e9f9043eaea6c3c990d96d9b  maintainer-scripts/setup.cfg
  1012437849cecda6e54b3948f279ae93  maintainer-scripts/update_version_git
! d5ee8d725eecdfbceac1dafa2748d5f5  maintainer-scripts/update_web_docs_git
  89960da3ee98bea76c62bf0bf235d1f9  maintainer-scripts/update_web_docs_libstdcxx_git
  5f2a276ee7b8decec541391229d03591  missing
  fbe2467afef81c41c166173adeb0ee20  mkdep
--- 149503,149509 ----
  33d97164a8610c7abf67eff7d28f47ff  maintainer-scripts/maintainer-addresses
  1fcc4f18e9f9043eaea6c3c990d96d9b  maintainer-scripts/setup.cfg
  1012437849cecda6e54b3948f279ae93  maintainer-scripts/update_version_git
! fe5245ec8ea53aaa51ffafbaef989713  maintainer-scripts/update_web_docs_git
  89960da3ee98bea76c62bf0bf235d1f9  maintainer-scripts/update_web_docs_libstdcxx_git
  5f2a276ee7b8decec541391229d03591  missing
  fbe2467afef81c41c166173adeb0ee20  mkdep
diff -Nrcpad gcc-16-20250518/config/ChangeLog gcc-16-20250525/config/ChangeLog
*** gcc-16-20250518/config/ChangeLog	Sun May 18 22:32:06 2025
--- gcc-16-20250525/config/ChangeLog	Sun May 25 22:32:04 2025
***************
*** 1,3 ****
--- 1,7 ----
+ 2025-05-23  Andi Kleen  <ak@gcc.gnu.org>
+ 
+ 	* bootstrap-native.mk: New file.
+ 
  2025-04-15  Kyrylo Tkachov  <ktkachov@nvidia.com>
  
  	* bootstrap-lto-locality.mk: New file.
diff -Nrcpad gcc-16-20250518/config/bootstrap-native.mk gcc-16-20250525/config/bootstrap-native.mk
*** gcc-16-20250518/config/bootstrap-native.mk	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/config/bootstrap-native.mk	Sun May 25 22:32:04 2025
***************
*** 0 ****
--- 1 ----
+ BOOT_CFLAGS := -march=native -mtune=native $(BOOT_CFLAGS)
diff -Nrcpad gcc-16-20250518/configure gcc-16-20250525/configure
*** gcc-16-20250518/configure	Sun May 18 22:33:29 2025
--- gcc-16-20250525/configure	Sun May 25 22:32:04 2025
*************** if test x"${build}" = x"${host}" ; then
*** 11595,11607 ****
    LDFLAGS_FOR_BUILD=${LDFLAGS_FOR_BUILD-${LDFLAGS}}
  fi
  
! # On Canadian crosses, we'll be searching the right directories for
! # the previously-installed cross compiler, so don't bother to add
! # flags for directories within the install tree of the compiler
! # being built; programs in there won't even run.
! if test "${build}" = "${host}" && test -d ${srcdir}/gcc; then
    # Search for pre-installed headers if nothing else fits.
!   FLAGS_FOR_TARGET=$FLAGS_FOR_TARGET' -B$(build_tooldir)/bin/ -B$(build_tooldir)/lib/ -isystem $(build_tooldir)/include -isystem $(build_tooldir)/sys-include'
  fi
  
  if test "x${use_gnu_ld}" = x &&
--- 11595,11611 ----
    LDFLAGS_FOR_BUILD=${LDFLAGS_FOR_BUILD-${LDFLAGS}}
  fi
  
! if test -d ${srcdir}/gcc; then
!   # On Canadian crosses, we'll be searching the right directories for the
!   # previously-installed cross compiler, so don't bother to add flags for
!   # executable directories within the install tree of the compiler being built;
!   # programs in there won't even run.
!   if test "${build}" = "${host}"; then
!     FLAGS_FOR_TARGET=$FLAGS_FOR_TARGET' -B$(build_tooldir)/bin/ -B$(build_tooldir)/lib/'
!   fi
! 
    # Search for pre-installed headers if nothing else fits.
!   FLAGS_FOR_TARGET=$FLAGS_FOR_TARGET' -isystem $(build_tooldir)/include -isystem $(build_tooldir)/sys-include'
  fi
  
  if test "x${use_gnu_ld}" = x &&
diff -Nrcpad gcc-16-20250518/configure.ac gcc-16-20250525/configure.ac
*** gcc-16-20250518/configure.ac	Sun May 18 22:32:06 2025
--- gcc-16-20250525/configure.ac	Sun May 25 22:32:04 2025
*************** if test x"${build}" = x"${host}" ; then
*** 3822,3834 ****
    LDFLAGS_FOR_BUILD=${LDFLAGS_FOR_BUILD-${LDFLAGS}}
  fi
  
! # On Canadian crosses, we'll be searching the right directories for
! # the previously-installed cross compiler, so don't bother to add
! # flags for directories within the install tree of the compiler
! # being built; programs in there won't even run.
! if test "${build}" = "${host}" && test -d ${srcdir}/gcc; then
    # Search for pre-installed headers if nothing else fits.
!   FLAGS_FOR_TARGET=$FLAGS_FOR_TARGET' -B$(build_tooldir)/bin/ -B$(build_tooldir)/lib/ -isystem $(build_tooldir)/include -isystem $(build_tooldir)/sys-include'
  fi
  
  if test "x${use_gnu_ld}" = x &&
--- 3822,3838 ----
    LDFLAGS_FOR_BUILD=${LDFLAGS_FOR_BUILD-${LDFLAGS}}
  fi
  
! if test -d ${srcdir}/gcc; then
!   # On Canadian crosses, we'll be searching the right directories for the
!   # previously-installed cross compiler, so don't bother to add flags for
!   # executable directories within the install tree of the compiler being built;
!   # programs in there won't even run.
!   if test "${build}" = "${host}"; then
!     FLAGS_FOR_TARGET=$FLAGS_FOR_TARGET' -B$(build_tooldir)/bin/ -B$(build_tooldir)/lib/'
!   fi
! 
    # Search for pre-installed headers if nothing else fits.
!   FLAGS_FOR_TARGET=$FLAGS_FOR_TARGET' -isystem $(build_tooldir)/include -isystem $(build_tooldir)/sys-include'
  fi
  
  if test "x${use_gnu_ld}" = x &&
diff -Nrcpad gcc-16-20250518/contrib/ChangeLog gcc-16-20250525/contrib/ChangeLog
*** gcc-16-20250518/contrib/ChangeLog	Sun May 18 22:32:06 2025
--- gcc-16-20250525/contrib/ChangeLog	Sun May 25 22:32:04 2025
***************
*** 1,3 ****
--- 1,7 ----
+ 2025-05-23  Andi Kleen  <ak@gcc.gnu.org>
+ 
+ 	* diffsummary.py: New file.
+ 
  2025-05-09  Torbjörn SVENSSON  <torbjorn.svensson@foss.st.com>
  
  	* check_GNU_style_lib.py: Remove literal prefix.
diff -Nrcpad gcc-16-20250518/contrib/diffsummary.py gcc-16-20250525/contrib/diffsummary.py
*** gcc-16-20250518/contrib/diffsummary.py	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/contrib/diffsummary.py	Sun May 25 22:32:04 2025
***************
*** 0 ****
--- 1,103 ----
+ #!/usr/bin/env python3
+ # Show or diff test_summary output to latest posted test result for a platform
+ # test_summary -t | diffsummary.py (compare test result from current build to last posted)
+ # diffsummary.py --show     (only show last posted)
+ from urllib.request import urlopen
+ from html.parser import HTMLParser
+ import time
+ import re
+ import argparse
+ import platform
+ import tempfile
+ import os
+ import sys
+ 
+ baseurl = "https://gcc.gnu.org/pipermail/gcc-testresults/"
+ 
+ ap = argparse.ArgumentParser(description="Diff stdin to latest posted test result and set exit code to result")
+ ap.add_argument("--branch", default="experimental",
+                 help="Branch to match (regex substring match)")
+ ap.add_argument("--arch", default=platform.machine() + ".*" + platform.system().lower(),
+                 help="architecture to match (regex substring match)")
+ ap.add_argument("--retrytime", default=1, type=int,
+                 help="time to wait before fetching next page (fractional seconds)")
+ ap.add_argument("--show", help="Show last test result, but do not diff", action="store_true", default=False)
+ ap.add_argument("--url", help="Show URLs downloaded", action="store_true")
+ ap.add_argument("--diff", help="Diff program to use (default diff)", default="diff")
+ ap.add_argument("--diff-args", help="Diff arguments to use (default -u)", default="-u")
+ ap.add_argument("--skip", type=int, default=0, help="Skip first N posted test results")
+ args = ap.parse_args()
+ 
+ class ParseMonths(HTMLParser):
+     def __init__(self):
+         super().__init__()
+         self.months = []
+     def handle_starttag(self, tag, attrs):
+         if tag == "a" and "thread.html" in attrs[0][1]:
+             self.months.append(attrs[0][1])
+ 
+ class ParseThread(HTMLParser):
+     def __init__(self):
+         super().__init__()
+         self.link = None
+         self.target = []
+     def handle_starttag(self, tag, attrs):
+         if (tag == "a"
+             and attrs[0][1][0].isdigit()
+             and attrs[0][1].endswith(".html")):
+             self.link = attrs[0][1]
+         else:
+             self.link = None
+     def handle_data(self, data):
+         if (self.link
+             and re.search(args.branch, data)
+             and re.search(args.arch, data)):
+             self.target.append(thread.link)
+ 
+ class ParseArticle(HTMLParser):
+     def __init__(self):
+         super().__init__()
+         self.contents = None
+         self.pre = False
+         self.data = None
+     def handle_starttag(self, tag, attrs):
+         self.pre = tag == "pre"
+     def handle_data(self, data):
+         if self.pre and not self.data:
+             self.data = data
+ 
+ def my_urlopen(url):
+     if args.url:
+         print(url)
+     return urlopen(url)
+ 
+ with my_urlopen(baseurl) as index:
+     months = ParseMonths()
+     months.feed(index.read().decode('utf-8'))
+ if len(months.months) == 0:
+     sys.exit("no months found")
+ for month in months.months:
+     with my_urlopen(baseurl + month) as m:
+         thread = ParseThread()
+         thread.feed(m.read().decode('utf-8'))
+         if thread.target:
+             if args.skip > len(thread.target):
+                 args.skip -= len(thread.target)
+                 continue
+             url = (baseurl + month).replace("thread.html", thread.target[-1 - args.skip])
+             with my_urlopen(url) as t:
+                 article = ParseArticle()
+                 article.feed(t.read().decode('utf-8'))
+                 if args.show:
+                     print(article.data)
+                     break
+                 with tempfile.NamedTemporaryFile(delete=False) as tf:
+                     tf.write(article.data.encode('utf-8'))
+                     tf.close()
+                     cmd = f"{args.diff} {args.diff_args} - {tf.name}"
+                     print(cmd)
+                     ret = os.system(cmd)
+                     os.unlink(tf.name)
+                     sys.exit(ret)
+                 break
+         time.sleep(args.retrytime)
diff -Nrcpad gcc-16-20250518/gcc/ChangeLog gcc-16-20250525/gcc/ChangeLog
*** gcc-16-20250518/gcc/ChangeLog	Sun May 18 22:32:06 2025
--- gcc-16-20250525/gcc/ChangeLog	Sun May 25 22:32:04 2025
***************
*** 1,3 ****
--- 1,711 ----
+ 2025-05-24  Shreya Munnangi  <smunnangi1@ventanamicro.com>
+ 
+ 	* config/riscv/riscv.cc (synthesize_and): Use a srl+andi+sll
+ 	sequence when the mask fits in a simm12 after shifting by the
+ 	number of trailing zeros.
+ 	Co-authored-by: Jeff Law <jlaw@ventanamicro.com>
+ 
+ 2025-05-24  Pan Li  <pan2.li@intel.com>
+ 
+ 	* config/riscv/riscv-v.cc (expand_vx_binary_vec_dup_vec): Add new
+ 	case for IOR op.
+ 	(expand_vx_binary_vec_vec_dup): Ditto.
+ 	* config/riscv/riscv.cc (riscv_rtx_costs): Ditto.
+ 	* config/riscv/vector-iterators.md: Add new op or to no_shift_vx_ops.
+ 
+ 2025-05-23  Andi Kleen  <ak@gcc.gnu.org>
+ 
+ 	* doc/install.texi: Document bootstrap-native.
+ 
+ 2025-05-23  Andi Kleen  <ak@gcc.gnu.org>
+ 
+ 	PR middle-end/114563
+ 	PR c++/119387
+ 	* ggc-page.cc (struct free_list): New structure.
+ 	(struct page_entry): Point to free_list.
+ 	(find_free_list): New function.
+ 	(find_free_list_order): Dito.
+ 	(alloc_page): Use specific free_list.
+ 	(release_pages): Dito.
+ 	(do_release_pages): Dito.
+ 	(init_ggc): Dito.
+ 	(ggc_print_statistics): Print overflow stat.
+ 	(ggc_pch_read): Use specific free list.
+ 
+ 2025-05-23  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
+ 
+ 	* doc/implement-c.texi (C Implementation): Add missing menu items.
+ 
+ 2025-05-23  Robin Dapp  <rdapp@ventanamicro.com>
+ 
+ 	* common/config/riscv/riscv-common.cc (riscv_subset_list::parse_base_ext):
+ 	Adjust error message.
+ 	(riscv_handle_option): Parse as CPU string first.
+ 	(riscv_expand_arch): Ditto.
+ 	* doc/invoke.texi: Document.
+ 
+ 2025-05-23  Robin Dapp  <rdapp@ventanamicro.com>
+ 
+ 	* config/riscv/riscv-v.cc (autovectorize_vector_modes): Return
+ 	user-specified mode if available.
+ 	* config/riscv/riscv.opt: New param.
+ 
+ 2025-05-23  Robin Dapp  <rdapp@ventanamicro.com>
+ 
+ 	* config/riscv/riscv.cc (singleton_vxrm_need): Init
+ 	saved_vxrm_mode.
+ 
+ 2025-05-23  Robin Dapp  <rdapp@ventanamicro.com>
+ 
+ 	* config/riscv/riscv-vector-costs.cc (compute_estimated_lmul):
+ 	Always use vect_vf_for_cost and TARGET_MIN_VLEN.
+ 
+ 2025-05-23  Dhruv Chawla  <dhruvc@nvidia.com>
+ 	    Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* expmed.cc (expand_rotate_as_vec_perm): Avoid a no-op move if the
+ 	target already provided the result in the expected register.
+ 	* config/aarch64/aarch64.cc (aarch64_vectorize_vec_perm_const):
+ 	Avoid forcing subregs into fresh registers unnecessarily.
+ 	* config/aarch64/aarch64-sve.md: Add define_split for rotate.
+ 	(*v_revvnx8hi): New pattern.
+ 
+ 2025-05-23  Dhruv Chawla  <dhruvc@nvidia.com>
+ 	    Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* config/aarch64/aarch64-sve.md (@aarch64_adr<mode>_shift):
+ 	Match lowered form of ashift.
+ 	(*aarch64_adr<mode>_shift): Likewise.
+ 	(*aarch64_adr_shift_sxtw): Likewise.
+ 	(*aarch64_adr_shift_uxtw): Likewise.
+ 	(<ASHIFT:optab><mode>3): Check amount instead of operands[2] in
+ 	aarch64_sve_<lr>shift_operand.
+ 	(v<optab><mode>3): Generate unpredicated shifts for constant
+ 	operands.
+ 	(@aarch64_pred_<optab><mode>): Convert to a define_expand.
+ 	(*aarch64_pred_<optab><mode>): Create define_insn_and_split pattern
+ 	from @aarch64_pred_<optab><mode>.
+ 	(*post_ra_v_ashl<mode>3): Rename to ...
+ 	(aarch64_vashl<mode>3_const): ... this and remove reload requirement.
+ 	(*post_ra_v_<optab><mode>3): Rename to ...
+ 	(aarch64_v<optab><mode>3_const): ... this and remove reload
+ 	requirement.
+ 	* config/aarch64/aarch64-sve2.md
+ 	(@aarch64_sve_add_<sve_int_op><mode>): Match lowered form of
+ 	SHIFTRT.
+ 	(*aarch64_sve2_sra<mode>): Likewise.
+ 	(*bitmask_shift_plus<mode>): Match lowered form of lshiftrt.
+ 
+ 2025-05-22  Joseph Myers  <josmyers@redhat.com>
+ 
+ 	* doc/implement-c.texi: Document C23 implementation-defined
+ 	behavior.
+ 	(Constant expressions implementation, Types implementation): New
+ 	nodes.
+ 
+ 2025-05-22  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* dwarf2out.cc (loc_list_from_tree_1) <COMPONENT_REF>: Add specific
+ 	handling of bit-fields for big-endian targets.
+ 
+ 2025-05-22  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* config/aarch64/aarch64-vxworks.h (TARGET_OS_USES_R18): Define.
+ 	Update comments.
+ 	* config/aarch64/aarch64.cc (aarch64_conditional_register_usage):
+ 	Mark x18 as fixed on VxWorks.
+ 	(aarch64_override_options_internal): Issue sorry message on
+ 	-fsanitize=shadow-call-stack if TARGET_OS_USES_R18.
+ 
+ 2025-05-22  Shreya Munnangi  <smunnangi1@ventanamicro.com>
+ 
+ 	* config/riscv/riscv.cc (synthesize_and): When profitable, use a three
+ 	shift sequence to clear bits at both upper and lower bits rather than
+ 	synthesizing the constant mask.
+ 
+ 2025-05-22  Siarhei Volkau  <lis8215@gmail.com>
+ 
+ 	PR target/70557
+ 	* config/riscv/riscv.md (movdi_32bit): Add "J" constraint to allow storing 0
+ 	directly to memory.
+ 
+ 2025-05-22  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	PR target/120372
+ 	* config/aarch64/aarch64.cc (aarch64_rtx_costs <case CONST_INSN>): Handle
+ 	if outer is COMPARE and the constant can be handled by the cmp instruction.
+ 
+ 2025-05-22  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	* expmed.cc (canonicalize_comparison): Use rtx_cost directly
+ 	instead of gen_move_insn. Print out the choice if dump is enabled.
+ 
+ 2025-05-22  Jakub Jelinek  <jakub@redhat.com>
+ 
+ 	* gimple-lower-bitint.cc (bitint_extended): New variable.
+ 	(bitint_large_huge::lower_shift_stmt): For LSHIFT_EXPR with
+ 	bitint_extended if lhs has most significant partial limb extend
+ 	it afterwards.
+ 
+ 2025-05-22  Xi Ruoyao  <xry111@xry111.site>
+ 
+ 	* doc/md.texi: Document the 'q' constraint for LoongArch.
+ 
+ 2025-05-22  Jakub Jelinek  <jakub@redhat.com>
+ 
+ 	PR target/120360
+ 	* config/i386/predicates.md (x86_64_neg_const_int_operand): New
+ 	predicate.
+ 	* config/i386/i386.md (*cmp<mode>_plus_1): New pattern.
+ 
+ 2025-05-22  Shreya Munnangi  <smunnangi1@ventanamicro.com>
+ 
+ 	* config/riscv/riscv.cc (synthesize_and): When profitable, use two
+ 	shift combinations to clear high or low bits rather than synthsizing
+ 	the constant.
+ 
+ 2025-05-22  Pengxuan Zheng  <quic_pzheng@quicinc.com>
+ 
+ 	* config/aarch64/aarch64.cc (aarch64_evpc_reencode): Copy zero_op0_p and
+ 	zero_op1_p from d to newd.
+ 
+ 2025-05-21  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	PR rtl-optimization/120090
+ 	* combine.cc (gen_lowpart_for_combine_no_emit): New function.
+ 	(RTL_HOOKS_GEN_LOWPART_NO_EMIT): Set to gen_lowpart_for_combine_no_emit.
+ 
+ 2025-05-21  Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	* config/riscv/riscv.md ((x << C1) + C2): Tighten split condition
+ 	and generate more efficient code when splitting.
+ 
+ 2025-05-21  Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	PR target/120368
+ 	* config/riscv/riscv.md (shift with masked shift count): Fix
+ 	opcode when generating an SImode shift on rv64.
+ 
+ 2025-05-21  Pan Li  <pan2.li@intel.com>
+ 
+ 	* config/riscv/riscv-v.cc (expand_vx_binary_vec_dup_vec): Add new
+ 	case for rtx code AND.
+ 	(expand_vx_binary_vec_vec_dup): Ditto.
+ 	* config/riscv/riscv.cc (riscv_rtx_costs): Ditto.
+ 	* config/riscv/vector-iterators.md: Add new op and to no_shift_vx_ops.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* gensupport.h (needs_barrier_p): Delete.
+ 	* gensupport.cc (needs_barrier_p): Likewise.
+ 	* rtl.h (always_void_p): Return true for PC, RETURN and SIMPLE_RETURN.
+ 	(expand_opcode): New enum class.
+ 	(expand_rtx, complete_seq): Declare.
+ 	* emit-rtl.cc (rtx_expander): New class.
+ 	(expand_rtx, complete_seq): New functions.
+ 	* gengenrtl.cc (special_rtx, excluded_rtx): Add a cross-reference
+ 	comment.
+ 	* genemit.cc (FIRST_CODE): New constant.
+ 	(print_code): Delete.
+ 	(generator::file, generator::used, generator::sequence_type): Delete.
+ 	(generator::bytes): New member variable.
+ 	(generator::generator): Update accordingly.
+ 	(generator::gen_rtx_scratch): Delete.
+ 	(generator::add_uint, generator::add_opcode, generator::add_code)
+ 	(generator::add_match_operator, generator::add_exp)
+ 	(generator::add_vec, generator::gen_table): New member functions.
+ 	(generator::gen_exp): Rewrite to use a bytecode expansion.
+ 	(generator::gen_emit_seq): Likewise.
+ 	(start_gen_insn): Return the C++ expression for the operands array.
+ 	(gen_insn, gen_expand, gen_split): Update callers accordingly.
+ 	(emit_c_code): Remove use of _val.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (clobber_pat::code): Delete.
+ 	(maybe_queue_insn): Don't set clobber_pat::code.
+ 	(output_add_clobbers): Remove info argument and output the two
+ 	REG and SCRATCH cases directly.
+ 	(main): Update call accordingly.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (generator::gen_exp): Report an error for 's' operands.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (generator::gen_exp): Raise an error if we see
+ 	an 'L' operand.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (generator::used): Update comment.
+ 	(generator::gen_exp): Remove handling of null unused arrays.
+ 	(gen_insn, gen_expand): Always pass a used array.
+ 	(output_add_clobbers): Note why the used array is null here.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (generator): New structure.
+ 	(gen_rtx_scratch, gen_exp, gen_emit_seq): Turn into member
+ 	functions of generator.
+ 	(gen_insn, gen_expand, gen_split, output_add_clobbers): Update
+ 	users accordingly.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (gen_rtx_scratch, gen_exp): Use operands[%d] rather than
+ 	operand%d.
+ 	(start_gen_insn): Mark the incoming arguments as const and store
+ 	them to an operands array.
+ 	(gen_expand, gen_split): Remove copies into and out of the operands
+ 	array.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (start_gen_insn): New function, split out from...
+ 	(gen_insn, gen_expand): ...here.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (queue): New static variable.
+ 	(maybe_queue_insn): New function, split out from...
+ 	(gen_insn): ...here.
+ 	(queue_expand): New function, split out from...
+ 	(gen_expand): ...here.
+ 	(gen_split): New function, split out from...
+ 	(queue_split): ...here.
+ 	(main): Queue definitions for later processing rather than
+ 	emitting them on the fly.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* genemit.cc (gen_exp): Make the info argument a constant reference.
+ 	(gen_emit_seq, gen_insn, gen_expand, gen_split): Likewise.
+ 	(output_add_clobbers): Likewise.
+ 	(main): Update calls accordingly.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* config/sparc/sparc.md (zero_extendhisi2, zero_extendhidi2)
+ 	(extendhisi2, extendqihi2, extendqisi2, extendqidi2)
+ 	(extendhidi2): Use operands[0] and operands[1] instead of
+ 	operand0 and operand1.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* config/stormy16/stormy16.md (negsi2): Remove unused assignment.
+ 
+ 2025-05-21  Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	PR target/100837
+ 	* config/nds32/nds32-intrinsic.md (unspec_get_pending_int): Use
+ 	a local variable instead of operands[2].
+ 
+ 2025-05-21  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	PR middle-end/120369
+ 	* tree-complex.cc (gimple_expand_builtin_cabs): Return early
+ 	if the LHS of cabs is null.
+ 
+ 2025-05-21  Co-Authored-By: Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	* config/riscv/riscv-protos.h (synthesize_and): Prototype.
+ 	* config/riscv/riscv.cc (synthesize_and): New function.
+ 	* config/riscv/riscv.md (and<mode>3): Use it.
+ 
+ 2025-05-21  liuhongt  <hongtao.liu@intel.com>
+ 
+ 	PR middle-end/118994
+ 	* match.pd ((a >> 1) + (b >> 1) + ((a | b) & 1) to
+ 	.AVG_CEIL (a, b)): New pattern.
+ 	((a | b) - ((a ^ b) >> 1) to .AVG_CEIL (a, b)): Ditto.
+ 
+ 2025-05-20  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	* Makefile.in (gimple-match-exports.o-warn): Remove.
+ 	* gimple-match-exports.cc (gimple_extract): Remove valueize_condition
+ 	argument.
+ 	(gimple_extract_op): Update call to gimple_extract.
+ 	(gimple_simplify): Likewise. Also remove valueize_condition lambda.
+ 
+ 2025-05-20  Umesh Kalappa  <ukalappa.mips@gmail.com>
+ 
+ 	* config/riscv/mips-p8700.md (mips_p8700_dummies): New
+ 	reservation.
+ 	(mips_p8700_unknown): Reservation for all the dummies.
+ 
+ 2025-05-20  Umesh Kalappa  <ukalappa.mips@gmail.com>
+ 
+ 	* config/riscv/mips-p8700.md: New scheduler model.
+ 	* config/riscv/riscv-cores.def (mips-p87000): New tuning model
+ 	and core architecture.
+ 	* config/riscv/riscv-opts.h (riscv_microarchitecture_type); Add
+ 	mips-p8700.
+ 	* config/riscv/riscv.cc (mips_p8700_tune_info): New uarch
+ 	tuning parameters.
+ 	* config/riscv/riscv.md (tune): Add mips_p8700.
+ 	Include mips-p8700.md
+ 	* doc/invoke.texi: Document tune/cpu options for the MIPS P8700.
+ 	Co-authored-by: Jeff Law <jlaw@ventanamicro.com>
+ 
+ 2025-05-20  Jakub Jelinek  <jakub@redhat.com>
+ 
+ 	* tree-chrec.cc (convert_affine_scev): Use signed_type_for instead of
+ 	build_nonstandard_integer_type.
+ 
+ 2025-05-20  Jakub Jelinek  <jakub@redhat.com>
+ 
+ 	* gimple-lower-bitint.cc (bitint_big_endian): New variable.
+ 	(bitint_precision_kind): Set it.
+ 	(struct bitint_large_huge): Add unsigned argument to
+ 	finish_arith_overflow.
+ 	(bitint_large_huge::limb_access_type): Handle bitint_big_endian.
+ 	(bitint_large_huge::handle_operand): Likewise.
+ 	(bitint_large_huge::handle_cast): Likewise.
+ 	(bitint_large_huge::handle_bit_field_ref): Likewise.
+ 	(bitint_large_huge::handle_load): Likewise.
+ 	(bitint_large_huge::lower_shift_stmt): Likewise.
+ 	(bitint_large_huge::finish_arith_overflow): Likewise.
+ 	Add nelts argument.
+ 	(bitint_large_huge::lower_addsub_overflow): Handle bitint_big_endian.
+ 	Adjust finish_arith_overflow caller.
+ 	(bitint_large_huge::lower_mul_overflow): Likewise.
+ 	(bitint_large_huge::lower_bit_query): Handle bitint_big_endian.
+ 	(bitint_large_huge::lower_stmt): Likewise.
+ 	(build_bitint_stmt_ssa_conflicts): Likewise.
+ 	(gimple_lower_bitint): Likewise.
+ 
+ 2025-05-20  Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	* config/riscv/bitmanip.md (various splits): Avoid writing the output
+ 	more than once when trivially possible.
+ 
+ 2025-05-20  liuhongt  <hongtao.liu@intel.com>
+ 
+ 	PR tree-optimization/103771
+ 	* match.pd (cond_expr_convert_p): Extend the match to handle
+ 	REAL_CST.
+ 	* tree-vect-patterns.cc
+ 	(vect_recog_cond_expr_convert_pattern): Handle REAL_CST.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* config/riscv/autovec-opt.md: Leverage the new add func to
+ 	expand the vx insn.
+ 	* config/riscv/riscv-protos.h (expand_vx_binary_vec_dup_vec): Add
+ 	new func decl to expand format v = vop(vec_dup(x), v).
+ 	(expand_vx_binary_vec_vec_dup): Diito but for format
+ 	v = vop(v, vec_dup(x)).
+ 	* config/riscv/riscv-v.cc (expand_vx_binary_vec_dup_vec): Add new
+ 	func impl to expand vx for v = vop(vec_dup(x), v).
+ 	(expand_vx_binary_vec_vec_dup): Diito but for another format
+ 	v = vop(v, vec_dup(x)).
+ 
+ 2025-05-19  Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	PR target/120333
+ 	* config/riscv/bitmanip.md: Remove bext formed from left+right
+ 	shift patterns.
+ 
+ 2025-05-19  John David Anglin  <danglin@gcc.gnu.org>
+ 
+ 	* config/pa/pa-hpux.h (TARGET_HAVE_LIBATOMIC): Define.
+ 	(HAVE_sync_compare_and_swapqi): Likewise.
+ 	(HAVE_sync_compare_and_swaphi): Likewise.
+ 	(HAVE_sync_compare_and_swapsi): Likewise.
+ 	(HAVE_sync_compare_and_swapdi): Likewise.
+ 
+ 2025-05-19  Thomas Schwinge  <tschwinge@baylibre.com>
+ 
+ 	PR lto/120308
+ 	* lto-streamer-out.cc (hash_tree): Don't handle 'TYPE_EMPTY_P' for
+ 	'lto_stream_offload_p'.
+ 	* tree-streamer-in.cc (unpack_ts_type_common_value_fields):
+ 	Likewise.
+ 	* tree-streamer-out.cc (pack_ts_type_common_value_fields):
+ 	Likewise.
+ 
+ 2025-05-19  Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	* config/riscv/riscv.cc (synthesize_ior_xor): Initialize OUTPUT and
+ 	verify it's non-null before emitting the final copy insn.
+ 
+ 2025-05-19  Richard Earnshaw  <rearnsha@arm.com>
+ 
+ 	PR target/120351
+ 	* config/arm/predicates.md (mem_noofs_operand): Also check the op
+ 	is a valid memory_operand.
+ 
+ 2025-05-19  Dongyan Chen  <chendongyan@isrc.iscas.ac.cn>
+ 
+ 	* common/config/riscv/riscv-common.cc (get_riscv_ext_info): Fix argument type.
+ 	(riscv_subset_list::check_implied_ext): Type conversion.
+ 
+ 2025-05-19  zhusonghe  <zhusonghe@eswincomputing.com>
+ 
+ 	* config/riscv/gen-riscv-ext-texi.cc (struct version_t):rename
+ 	major/minor to major_version/minor_version.
+ 
+ 2025-05-19  Kito Cheng  <kito.cheng@sifive.com>
+ 
+ 	* config/riscv/riscv.cc (riscv_legitimize_move): Handle
+ 	load/store with odd-even reg pair.
+ 	(riscv_split_64bit_move_p): Don't split load/store if zilsd enabled.
+ 	(riscv_hard_regno_mode_ok): Only allow even reg can be used for
+ 	64 bits mode for zilsd.
+ 
+ 2025-05-19  Jennifer Schmitz  <jschmitz@nvidia.com>
+ 
+ 	PR middle-end/120276
+ 	* regcprop.cc (copy_value): Return in case of unordered modes.
+ 
+ 2025-05-19  Kito Cheng  <kito.cheng@sifive.com>
+ 
+ 	* config/riscv/constraints.md (cR): New constraint.
+ 	* doc/md.texi (Machine Constraints::RISC-V): Document the new cR
+ 	constraint.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* config.gcc: Remove 512 intrin file.
+ 	* config/i386/avx10_2-512bf16intrin.h:
+ 	Removed and combined to ...
+ 	* config/i386/avx10_2bf16intrin.h: ... this.
+ 	* config/i386/avx10_2-512convertintrin.h:
+ 	Removed and combined to ...
+ 	* config/i386/avx10_2convertintrin.h: ... this.
+ 	* config/i386/avx10_2-512mediaintrin.h:
+ 	Removed and combined to ...
+ 	* config/i386/avx10_2mediaintrin.h: ... this.
+ 	* config/i386/avx10_2-512minmaxintrin.h:
+ 	Removed and combined to ...
+ 	* config/i386/avx10_2minmaxintrin.h: ... this.
+ 	* config/i386/avx10_2-512satcvtintrin.h:
+ 	Removed and combined to ...
+ 	* config/i386/avx10_2satcvtintrin.h: ... this.
+ 	* config/i386/immintrin.h: Remove 512 intrin file.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* config/i386/sse.md (VF1_VF2_AVX10_2): Removed.
+ 	(VF2_AVX10_2): Ditto.
+ 	(VI1248_AVX10_2): Ditto.
+ 	(VFH_AVX10_2): Ditto.
+ 	(VF1_AVX10_2): Ditto.
+ 	(VHF_AVX10_2): Ditto.
+ 	(VBF_AVX10_2): Ditto.
+ 	(VI8_AVX10_2): Ditto.
+ 	(VI2_AVX10_2): Ditto.
+ 	(VBF): New.
+ 	(div<mode>3): Use VBF instead of AVX10.2 ones.
+ 	(vec_cmp<mode><avx512fmaskmodelower>): Ditto.
+ 	(avx10_2_cvt2ps2phx_<mode><mask_name><round_name>):
+ 	Use VHF_AVX512VL instead of AVX10.2 ones.
+ 	(vcvt<convertfp8_pack><mode><mask_name>): Ditto.
+ 	(vcvthf82ph<mode><mask_name>): Ditto.
+ 	(VHF_AVX10_2_2): Remove not needed TARGET_AVX10_2.
+ 	(usdot_prod<sseunpackmodelower><mode>): Use VI2_AVX512F
+ 	instead of AVX10.2 ones.
+ 	(vdpphps_<mode>): Use VF1_AVX512VL instead of AVX10.2 ones.
+ 	(vdpphps_<mode>_mask): Ditto.
+ 	(vdpphps_<mode>_maskz): Ditto.
+ 	(vdpphps_<mode>_maskz_1): Ditto.
+ 	(avx10_2_scalefbf16_<mode><mask_name>): Use VBF instead of
+ 	AVX10.2 ones.
+ 	(<code><mode>3): Ditto.
+ 	(avx10_2_<code>bf16_<mode><mask_name>): Ditto.
+ 	(avx10_2_fmaddbf16_<mode>_maskz); Ditto.
+ 	(avx10_2_fmaddbf16_<mode><sd_maskz_name>): Ditto.
+ 	(avx10_2_fmaddbf16_<mode>_mask): Ditto.
+ 	(avx10_2_fmaddbf16_<mode>_mask3): Ditto.
+ 	(avx10_2_fnmaddbf16_<mode>_maskz): Ditto.
+ 	(avx10_2_fnmaddbf16_<mode><sd_maskz_name>): Ditto.
+ 	(avx10_2_fnmaddbf16_<mode>_mask): Ditto.
+ 	(avx10_2_fnmaddbf16_<mode>_mask3): Ditto.
+ 	(avx10_2_fmsubbf16_<mode>_maskz); Ditto.
+ 	(avx10_2_fmsubbf16_<mode><sd_maskz_name>): Ditto.
+ 	(avx10_2_fmsubbf16_<mode>_mask): Ditto.
+ 	(avx10_2_fmsubbf16_<mode>_mask3): Ditto.
+ 	(avx10_2_fnmsubbf16_<mode>_maskz): Ditto.
+ 	(avx10_2_fnmsubbf16_<mode><sd_maskz_name>): Ditto.
+ 	(avx10_2_fnmsubbf16_<mode>_mask): Ditto.
+ 	(avx10_2_fnmsubbf16_<mode>_mask3): Ditto.
+ 	(avx10_2_rsqrtbf16_<mode><mask_name>): Ditto.
+ 	(avx10_2_sqrtbf16_<mode><mask_name>): Ditto.
+ 	(avx10_2_rcpbf16_<mode><mask_name>): Ditto.
+ 	(avx10_2_getexpbf16_<mode><mask_name>): Ditto.
+ 	(avx10_2_<bf16immop>bf16_<mode><mask_name>): Ditto.
+ 	(avx10_2_fpclassbf16_<mode><mask_scalar_merge_name>): Ditto.
+ 	(avx10_2_cmpbf16_<mode><mask_scalar_merge_name>): Ditto.
+ 	(avx10_2_cvt<sat_cvt_trunc_prefix>bf162i<sat_cvt_sign_prefix>bs<mode><mask_name>):
+ 	Ditto.
+ 	(avx10_2_cvtph2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_name>):
+ 	Use VHF_AVX512VL instead of AVX10.2 ones.
+ 	(avx10_2_cvttph2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_saeonly_name>):
+ 	Ditto.
+ 	(avx10_2_cvtps2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_name>):
+ 	Use VF1_AVX512VL instead of AVX10.2 ones.
+ 	(avx10_2_cvttps2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_saeonly_name>):
+ 	Ditto.
+ 	(avx10_2_vcvtt<castmode>2<sat_cvt_sign_prefix>dqs<mode><mask_name><round_saeonly_name>):
+ 	Use VF instead of AVX10.2 ones.
+ 	(avx10_2_vcvttpd2<sat_cvt_sign_prefix>qqs<mode><mask_name><round_saeonly_name>):
+ 	Use VF2 instead of AVX10.2 ones.
+ 	(avx10_2_vcvttps2<sat_cvt_sign_prefix>qqs<mode><mask_name><round_saeonly_name>):
+ 	Use VI8 instead of AVX10.2 ones.
+ 	(avx10_2_minmaxbf16_<mode><mask_name>): Use VBF instead of
+ 	AVX10.2 ones.
+ 	(avx10_2_minmaxp<mode><mask_name><round_saeonly_name>):
+ 	Use VFH_AVX512VL instead of AVX10.2 ones.
+ 	(avx10_2_vmovrs<ssemodesuffix><mode><mask_name>):
+ 	Use VI1248_AVX512VLBW instead of AVX10.2 ones.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* common/config/i386/cpuinfo.h
+ 	(get_available_features): Remove feature set for AVX10_1_256.
+ 	* common/config/i386/i386-common.cc
+ 	(OPTION_MASK_ISA2_EVEX512_SET): Removed.
+ 	(OPTION_MASK_ISA2_AVX10_1_256_SET): Removed.
+ 	(OPTION_MASK_ISA_AVX10_1_SET): Imply all AVX512 features.
+ 	(OPTION_MASK_ISA2_AVX10_1_SET): Ditto.
+ 	(OPTION_MASK_ISA2_AVX2_UNSET): Remove AVX10_1_UNSET.
+ 	(OPTION_MASK_ISA2_EVEX512_UNSET): Removed.
+ 	(OPTION_MASK_ISA2_AVX10_1_UNSET): Remove AVX10_1_256.
+ 	(OPTION_MASK_ISA2_AVX512F_UNSET): Unset AVX10_1.
+ 	(ix86_handle_option): Remove special handling for AVX512/AVX10.1
+ 	options, evex512 and avx10_1_256. Modify ISA set for AVX10 options.
+ 	* common/config/i386/i386-cpuinfo.h
+ 	(enum feature_priority): Remove P_AVX10_1_256.
+ 	(enum processor_features): Remove FEATURE_AVX10_1_256.
+ 	* common/config/i386/i386-isas.h: Remove avx10.1-256/512.
+ 	* config/i386/avx512bf16intrin.h: Rollback target push before
+ 	evex512 is introduced.
+ 	* config/i386/avx512bf16vlintrin.h: Ditto.
+ 	* config/i386/avx512bitalgintrin.h: Ditto.
+ 	* config/i386/avx512bitalgvlintrin.h: Ditto.
+ 	* config/i386/avx512bwintrin.h: Ditto.
+ 	* config/i386/avx512cdintrin.h: Ditto.
+ 	* config/i386/avx512dqintrin.h: Ditto.
+ 	* config/i386/avx512fintrin.h: Ditto.
+ 	* config/i386/avx512fp16intrin.h: Ditto.
+ 	* config/i386/avx512fp16vlintrin.h: Ditto.
+ 	* config/i386/avx512ifmaintrin.h: Ditto.
+ 	* config/i386/avx512ifmavlintrin.h: Ditto.
+ 	* config/i386/avx512vbmi2intrin.h: Ditto.
+ 	* config/i386/avx512vbmi2vlintrin.h: Ditto.
+ 	* config/i386/avx512vbmiintrin.h: Ditto.
+ 	* config/i386/avx512vbmivlintrin.h: Ditto.
+ 	* config/i386/avx512vlbwintrin.h: Ditto.
+ 	* config/i386/avx512vldqintrin.h: Ditto.
+ 	* config/i386/avx512vlintrin.h: Ditto.
+ 	* config/i386/avx512vnniintrin.h: Ditto.
+ 	* config/i386/avx512vnnivlintrin.h: Ditto.
+ 	* config/i386/avx512vp2intersectintrin.h: Ditto.
+ 	* config/i386/avx512vp2intersectvlintrin.h: Ditto.
+ 	* config/i386/avx512vpopcntdqintrin.h: Ditto.
+ 	* config/i386/avx512vpopcntdqvlintrin.h: Ditto.
+ 	* config/i386/gfniintrin.h: Ditto.
+ 	* config/i386/vaesintrin.h: Ditto.
+ 	* config/i386/vpclmulqdqintrin.h: Ditto.
+ 	* config/i386/driver-i386.cc (check_avx512_features): Removed.
+ 	(host_detect_local_cpu): Remove -march=native special handling.
+ 	* config/i386/i386-builtins.cc
+ 	(ix86_vectorize_builtin_gather): Remove TARGET_EVEX512.
+ 	* config/i386/i386-c.cc
+ 	(ix86_target_macros_internal): Remove EVEX512 and AVX10_1_256.
+ 	* config/i386/i386-expand.cc
+ 	(ix86_valid_mask_cmp_mode): Remove TARGET_EVEX512.
+ 	(ix86_expand_int_sse_cmp): Ditto.
+ 	(ix86_vector_duplicate_simode_const): Ditto.
+ 	(ix86_expand_vector_init_duplicate): Ditto.
+ 	(ix86_expand_vector_init_one_nonzero): Ditto.
+ 	(ix86_emit_swsqrtsf): Ditto.
+ 	(ix86_vectorize_vec_perm_const): Ditto.
+ 	(ix86_expand_vecop_qihi2): Ditto.
+ 	(ix86_expand_sse2_mulvxdi3): Ditto.
+ 	(ix86_gen_bcst_mem): Ditto.
+ 	* config/i386/i386-isa.def (EVEX512): Removed.
+ 	(AVX10_1_256): Ditto.
+ 	* config/i386/i386-options.cc
+ 	(isa2_opts): Remove evex512 and avx10.1-256.
+ 	(ix86_function_specific_save): Remove no_avx512_explicit and
+ 	no_avx10_1_explicit.
+ 	(ix86_function_specific_restore): Ditto.
+ 	(ix86_valid_target_attribute_inner_p): Remove evex512 and
+ 	avx10.1-256/512.
+ 	(ix86_valid_target_attribute_tree): Remove special handling
+ 	to rerun ix86_option_override_internal for AVX10.1-256.
+ 	(ix86_option_override_internal): Remove warning handling.
+ 	(ix86_simd_clone_adjust): Remove evex512.
+ 	* config/i386/i386.cc
+ 	(type_natural_mode): Remove TARGET_EVEX512.
+ 	(ix86_return_in_memory): Ditto.
+ 	(standard_sse_constant_p): Ditto.
+ 	(standard_sse_constant_opcode): Ditto.
+ 	(ix86_get_ssemov): Ditto.
+ 	(ix86_legitimate_constant_p): Ditto.
+ 	(ix86_vectorize_builtin_scatter): Ditto.
+ 	(ix86_hard_regno_mode_ok): Ditto.
+ 	(ix86_set_reg_reg_cost): Ditto.
+ 	(ix86_rtx_costs): Ditto.
+ 	(ix86_vector_mode_supported_p): Ditto.
+ 	(ix86_preferred_simd_mode): Ditto.
+ 	(ix86_autovectorize_vector_modes): Ditto.
+ 	(ix86_get_mask_mode): Ditto.
+ 	(ix86_simd_clone_compute_vecsize_and_simdlen): Ditto.
+ 	(ix86_simd_clone_usable): Ditto.
+ 	* config/i386/i386.h (BIGGEST_ALIGNMENT): Ditto.
+ 	(MOVE_MAX): Ditto.
+ 	(STORE_MAX_PIECES): Ditto.
+ 	(PTA_SKYLAKE_AVX512): Remove PTA_EVEX512.
+ 	(PTA_CANNONLAKE): Ditto.
+ 	(PTA_ZNVER4): Ditto.
+ 	(PTA_GRANITERAPIDS): Use PTA_AVX10_1.
+ 	(PTA_DIAMONDRAPIDS): Use PTA_GRANITERAPIDS.
+ 	* config/i386/i386.md: Remove TARGET_EVEX512, avx512f_512
+ 	and avx512bw_512.
+ 	* config/i386/i386.opt: Remove ix86_no_avx512_explicit,
+ 	ix86_no_avx10_1_explicit, mevex512, mavx10.1-256/512 and
+ 	warning for mavx10.1. Modify option comment.
+ 	* config/i386/i386.opt.urls: Remove evex512 and avx10.1-256/512.
+ 	* config/i386/predicates.md: Remove TARGET_EVEX512.
+ 	* config/i386/sse.md: Ditto.
+ 	* doc/extend.texi: Remove avx10.1-256/512. Modify avx10.1 doc.
+ 	* doc/invoke.texi: Remove avx10.1-256/512 and evex512.
+ 	* doc/sourcebuild.texi: Remove avx10.1-256/512.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* config/i386/i386-builtin.def
+ 	(BDESC): Remove OPTION_MASK_ISA2_EVEX512.
+ 	* config/i386/i386-builtins.cc
+ 	(ix86_init_mmx_sse_builtins): Ditto.
+ 
+ 2025-05-18  Dimitar Dimitrov  <dimitar@dinux.eu>
+ 	    Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	PR target/119966
+ 	* emit-rtl.cc (validate_subreg): Do not exit immediately for
+ 	paradoxical subregs.  Filter subsequent tests which are
+ 	not valid for paradoxical subregs.
+ 
+ 2025-05-18  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* dwarf2out.cc (loc_list_from_tree_1) <COMPONENT_REF>: Do not bail
+ 	out when the size is not a multiple of a byte.
+ 	Deal with bit-fields whose size is not a multiple of a byte when
+ 	dereferencing an address.
+ 
+ 2025-05-18  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	* gimple-fold.cc (mark_lhs_in_seq_for_dce): Make
+ 	non-static.
+ 	* gimple-fold.h (mark_lhs_in_seq_for_dce): Declare.
+ 	* tree-ssa-phiopt.cc (match_simplify_replacement): Use
+ 	mark_lhs_in_seq_for_dce instead of manually looping.
+ 
  2025-05-17  Jeff Law  <jlaw@ventanamicro.com>
  
  	* config/riscv/riscv-vect-permconst.cc (vector_permconst:process_bb):
diff -Nrcpad gcc-16-20250518/gcc/DATESTAMP gcc-16-20250525/gcc/DATESTAMP
*** gcc-16-20250518/gcc/DATESTAMP	Sun May 18 22:32:06 2025
--- gcc-16-20250525/gcc/DATESTAMP	Sun May 25 22:32:04 2025
***************
*** 1 ****
! 20250518
--- 1 ----
! 20250525
diff -Nrcpad gcc-16-20250518/gcc/Makefile.in gcc-16-20250525/gcc/Makefile.in
*** gcc-16-20250518/gcc/Makefile.in	Sun May 18 22:32:06 2025
--- gcc-16-20250525/gcc/Makefile.in	Sun May 25 22:32:04 2025
*************** gengtype-lex.o-warn = -Wno-error
*** 253,259 ****
  libgcov-util.o-warn = -Wno-error
  libgcov-driver-tool.o-warn = -Wno-error
  libgcov-merge-tool.o-warn = -Wno-error
- gimple-match-exports.o-warn = -Wno-unused
  dfp.o-warn = -Wno-strict-aliasing
  
  # All warnings have to be shut off in stage1 if the compiler used then
--- 253,258 ----
diff -Nrcpad gcc-16-20250518/gcc/ada/ChangeLog gcc-16-20250525/gcc/ada/ChangeLog
*** gcc-16-20250518/gcc/ada/ChangeLog	Sun May 18 22:32:06 2025
--- gcc-16-20250525/gcc/ada/ChangeLog	Sun May 25 22:32:04 2025
***************
*** 1,3 ****
--- 1,7 ----
+ 2025-05-24  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* gcc-interface/Make-lang.in (ACATSDIR): Use acats-2 directory.
+ 
  2025-05-13  Nicolas Boulenguez  <nicolas@debian.org>
  
  	PR ada/87778
diff -Nrcpad gcc-16-20250518/gcc/ada/gcc-interface/Make-lang.in gcc-16-20250525/gcc/ada/gcc-interface/Make-lang.in
*** gcc-16-20250518/gcc/ada/gcc-interface/Make-lang.in	Sun May 18 22:32:06 2025
--- gcc-16-20250525/gcc/ada/gcc-interface/Make-lang.in	Sun May 25 22:32:05 2025
*************** check-ada-subtargets: check-acats-subtar
*** 1108,1114 ****
  # No ada-specific selftests
  selftest-ada:
  
! ACATSDIR = $(TESTSUITEDIR)/ada/acats
  ACATSCMD = run_acats.sh
  
  check_acats_numbers0:=1 2 3 4 5 6 7 8 9
--- 1108,1114 ----
  # No ada-specific selftests
  selftest-ada:
  
! ACATSDIR = $(TESTSUITEDIR)/ada/acats-2
  ACATSCMD = run_acats.sh
  
  check_acats_numbers0:=1 2 3 4 5 6 7 8 9
diff -Nrcpad gcc-16-20250518/gcc/c-family/ChangeLog gcc-16-20250525/gcc/c-family/ChangeLog
*** gcc-16-20250518/gcc/c-family/ChangeLog	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/c-family/ChangeLog	Sun May 25 22:32:05 2025
***************
*** 1,3 ****
--- 1,8 ----
+ 2025-05-23  Jason Merrill  <jason@redhat.com>
+ 
+ 	* c-format.cc (flag_chars_t::validate): Control quoting warnings
+ 	with -Wformat-diag.
+ 
  2025-05-15  Jason Merrill  <jason@redhat.com>
  
  	* c-opts.cc (c_common_post_options): Set flag_coroutines.
diff -Nrcpad gcc-16-20250518/gcc/c-family/c-format.cc gcc-16-20250525/gcc/c-family/c-format.cc
*** gcc-16-20250518/gcc/c-family/c-format.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/c-family/c-format.cc	Sun May 25 22:32:05 2025
*************** flag_chars_t::validate (const format_kin
*** 2124,2130 ****
  	{
  	  format_warning_at_char (format_string_loc, format_string_cst,
  				  format_chars - orig_format_chars - 1,
! 				  OPT_Wformat_,
  				  "%s used within a quoted sequence",
  				  _(s->name));
  	}
--- 2124,2130 ----
  	{
  	  format_warning_at_char (format_string_loc, format_string_cst,
  				  format_chars - orig_format_chars - 1,
! 				  OPT_Wformat_diag,
  				  "%s used within a quoted sequence",
  				  _(s->name));
  	}
*************** flag_chars_t::validate (const format_kin
*** 2137,2143 ****
      {
        format_warning_at_char (format_string_loc, format_string_cst,
  			      format_chars - orig_format_chars,
! 			      OPT_Wformat_,
  			      "%qc conversion used unquoted",
  			      format_char);
      }
--- 2137,2143 ----
      {
        format_warning_at_char (format_string_loc, format_string_cst,
  			      format_chars - orig_format_chars,
! 			      OPT_Wformat_diag,
  			      "%qc conversion used unquoted",
  			      format_char);
      }
diff -Nrcpad gcc-16-20250518/gcc/cobol/ChangeLog gcc-16-20250525/gcc/cobol/ChangeLog
*** gcc-16-20250518/gcc/cobol/ChangeLog	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/ChangeLog	Sun May 25 22:32:05 2025
***************
*** 1,3 ****
--- 1,46 ----
+ 2025-05-20  Robert Dubner  <rdubner@symas.com>
+ 	    James K. Lowden  <jklowden@cobolworx.com>
+ 
+ 	PR cobol/119770
+ 	PR cobol/119772
+ 	PR cobol/119790
+ 	PR cobol/119771
+ 	PR cobol/119810
+ 	PR cobol/119335
+ 	PR cobol/119632
+ 	* cdf-copy.cc (GLOB_BRACE): Eliminate <glob.h>.
+ 	* cdfval.h (_CDF_VAL_H_): Switch to C++ headers.
+ 	* copybook.h (class copybook_elem_t): Eliminate <glob.h>.
+ 	(class copybook_t): Likewise.
+ 	* gcobc: Numerous changes to improve utility.
+ 	* gcobol.1: Correct names in the list of functions.
+ 	* genapi.cc (compare_binary_binary): Use has_attr() function.
+ 	* lexio.cc (cdftext::lex_open): Typo; filename logic.
+ 	(cdftext::process_file): Filename logic.
+ 	* parse.y: Numerous parsing changes.
+ 	* parse_ante.h (new_alphanumeric): C++ includes; changes to temporaries.
+ 	(new_tempnumeric): Likewise.
+ 	(new_tempnumeric_float): Likewise.
+ 	(set_real_from_capacity): Created.
+ 	* scan.l: Use yy_pop_state().
+ 	* scan_ante.h (typed_name): Find figconst from data.initial.
+ 	* symbols.cc (symbol_valid_udf_args): Eliminate.
+ 	(symbols_update): figconst processing.
+ 	(new_temporary_impl): For functions, set .initial to function name.
+ 	(temporaries_t::acquire): Likewise.
+ 	(new_alphanumeric): Likewise.
+ 	(new_temporary): Likewise.
+ 	* symbols.h (_SYMBOLS_H_): Use C++ includes.
+ 	(cbl_figconst_tok): Change handling of figconst.
+ 	(cbl_figconst_field_of): Change handling of figconst.
+ 	(symbol_valid_udf_args): Eliminate.
+ 	* symfind.cc (symbol_match2): Change declaration.
+ 	(symbol_match): Change declaration.
+ 
+ 2025-05-18  Mark Wielaard  <mark@klomp.org>
+ 
+ 	* lang.opt.urls: Regenerated.
+ 
  2025-05-16  Robert Dubner  <rdubner@symas.com>
  
  	* cobol1.cc (cobol_langhook_handle_option): Eliminate OPT_M.
diff -Nrcpad gcc-16-20250518/gcc/cobol/cdf-copy.cc gcc-16-20250525/gcc/cobol/cdf-copy.cc
*** gcc-16-20250518/gcc/cobol/cdf-copy.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/cdf-copy.cc	Sun May 25 22:32:05 2025
***************
*** 35,57 ****
  // We regret any confusion engendered.
  
  #include "config.h"
- #include <glob.h>
  
  #include "cobol-system.h"
  #include "cbldiag.h"
  #include "util.h"
  #include "copybook.h"
  
- // GLOB_BRACE and GLOB_TILDE are BSD extensions.  Provide fallback definitions
- // if necessary.
- #ifndef GLOB_BRACE
- #define GLOB_BRACE 0
- #endif
- 
- #ifndef GLOB_TILDE
- #define GLOB_TILDE 0
- #endif
- 
  #define COUNT_OF(X) (sizeof(X) / sizeof(X[0]))
  
  /*
--- 35,46 ----
***************
*** 86,92 ****
   * space.  This function only applies them.
   */
  
- extern int yydebug;
  const char * cobol_filename();
  bool is_fixed_format();
  bool is_reference_format();
--- 75,80 ----
*************** esc( size_t len, const char input[] ) {
*** 190,201 ****
    return buffer; // caller must strdup static buffer
  }
  
- static int
- glob_error(const char *epath, int eerrno) {
-   dbgmsg("%s: COPY file search: '%s': %s", __func__, epath, xstrerror(eerrno));
-   return 0;
- }
- 
  void
  copybook_directory_add( const char gcob_copybook[] ) {
    if( !gcob_copybook ) return;
--- 178,183 ----
*************** copybook_extension_add( const char ext[]
*** 242,268 ****
    copybook.extensions_add( ext, alt );
  }
  
- extern int yydebug;
  
! const char * copybook_elem_t::extensions;
  
  void
  copybook_t::extensions_add( const char ext[], const char alt[] ) {
!   char *output;
!   if( alt ) {
!     output = xasprintf("%s,%s", ext, alt);
!   } else {
!     output = xstrdup(ext);
!   }
!   gcc_assert(output);
!   if( book.extensions ) {
!     char *s = xasprintf("%s,%s", output, book.extensions);
!     free(const_cast<char*>(book.extensions));
!     free(output);
!     book.extensions = s;
!   } else {
!     book.extensions = output;
!   }
  }
  
  static inline ino_t
--- 224,238 ----
    copybook.extensions_add( ext, alt );
  }
  
  
! std::list<const char *> copybook_elem_t::suffixes {
!   "", ".cpy", ".CPY", ".cbl", ".CBL", ".cob", ".COB"
! };
  
  void
  copybook_t::extensions_add( const char ext[], const char alt[] ) {
!   book.suffixes.push_back(ext);
!   if( alt ) book.suffixes.push_back(alt);
  }
  
  static inline ino_t
*************** inode_of( int fd ) {
*** 276,284 ****
  
  int
  copybook_elem_t::open_file( const char directory[], bool literally ) {
!   int erc;
!   char  *pattern, *copier = xstrdup(cobol_filename());
!   char *dname = NULL;
  
    if ( directory ) {
      dname = xstrdup(directory);
--- 246,252 ----
  
  int
  copybook_elem_t::open_file( const char directory[], bool literally ) {
!   char *dname = NULL, *copier = xstrdup(cobol_filename());
  
    if ( directory ) {
      dname = xstrdup(directory);
*************** copybook_elem_t::open_file( const char d
*** 324,375 ****
    }
    gcc_assert( ! literally );
  
-   if( extensions ) {
-     pattern = xasprintf("%s{,.cpy,.CPY,.cbl,.CBL,.cob,.COB,%s}",
-                         path, this->extensions);
-   } else {
-     pattern = xasprintf("%s{,.cpy,.CPY,.cbl,.CBL,.cob,.COB}", path);
-   }
- 
    free(copier);
  
!   static int flags = GLOB_MARK | GLOB_BRACE | GLOB_TILDE;
!   glob_t globber;
! 
!   if( (erc = glob(pattern, flags, glob_error, &globber)) != 0 ) {
!     switch(erc) {
!     case GLOB_NOSPACE:
!       yywarn("COPY file search: out of memory");
!       break;
!     case GLOB_ABORTED:
!       yywarn("COPY file search: read error");
!       break;
!     case GLOB_NOMATCH:
!       dbgmsg("COPY '%s': no files match %s", this->source.name, pattern);
!     default:
!       break; // caller says no file found
!     }
!     return -1;
!   }
! 
!   free(pattern);
  
!   for( size_t i=0; i < globber.gl_pathc; i++ ) {
!     auto filename = globber.gl_pathv[i];
      if( (this->fd = open(filename, O_RDONLY)) != -1 ) {
        dbgmsg("found copybook file %s", filename);
        this->source.name = xstrdup(filename);
        if( ! cobol_filename(this->source.name, inode_of(fd)) ) {
!         error_msg(source.loc, "recursive copybook: '%s' includes itself", this->source);
!         (void)! close(fd);
!         fd = -1;
        }
!       globfree(&globber);
        return fd;
      }
    }
-   yywarn("could not open copy source for '%s'", source);
  
-   globfree(&globber);
    return -1;
  }
--- 292,317 ----
    }
    gcc_assert( ! literally );
  
    free(copier);
  
!   for( auto suffix : suffixes ) {
!     std::string pattern(path);
!     pattern += suffix;
!     dbgmsg("%s: trying %s", __func__, pattern.c_str());
  
!     auto filename = pattern.c_str();
      if( (this->fd = open(filename, O_RDONLY)) != -1 ) {
        dbgmsg("found copybook file %s", filename);
        this->source.name = xstrdup(filename);
        if( ! cobol_filename(this->source.name, inode_of(fd)) ) {
! 	error_msg(source.loc, "recursive copybook: '%s' includes itself", this->source);
! 	(void)! close(fd);
! 	fd = -1;
        }
!       dbgmsg("%s: opened %s as fd %d", __func__, source.name, fd);
        return fd;
      }
    }
  
    return -1;
  }
diff -Nrcpad gcc-16-20250518/gcc/cobol/cdfval.h gcc-16-20250525/gcc/cobol/cdfval.h
*** gcc-16-20250518/gcc/cobol/cdfval.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/cdfval.h	Sun May 25 22:32:05 2025
***************
*** 32,40 ****
  #ifndef _CDF_VAL_H_
  #define _CDF_VAL_H_
  
! #include <assert.h>
! #include <stdint.h>
! #include <stdlib.h>
  
  bool scanner_parsing();
  
--- 32,40 ----
  #ifndef _CDF_VAL_H_
  #define _CDF_VAL_H_
  
! #include <cassert>
! #include <cstdint>
! #include <cstdlib>
  
  bool scanner_parsing();
  
diff -Nrcpad gcc-16-20250518/gcc/cobol/copybook.h gcc-16-20250525/gcc/cobol/copybook.h
*** gcc-16-20250518/gcc/cobol/copybook.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/copybook.h	Sun May 25 22:32:05 2025
*************** class copybook_elem_t {
*** 65,71 ****
      copybook_loc_t() : name(NULL) {}
    } source, library;
    bool suppress;
!   static const char *extensions;
   public:
    struct { bool source, library; } literally;
    int  fd;
--- 65,71 ----
      copybook_loc_t() : name(NULL) {}
    } source, library;
    bool suppress;
!   static std::list<const char *> suffixes;
   public:
    struct { bool source, library; } literally;
    int  fd;
*************** class copybook_elem_t {
*** 91,97 ****
    }
  
    int open_file( const char dir[], bool literally = false );
-   void extensions_add( const char ext[], const char alt[] );
  
    static inline bool is_quote( const char ch ) {
      return ch == '\'' || ch == '"';
--- 91,96 ----
*************** class copybook_t {
*** 185,196 ****
      this->source(loc, name);
  
      for( auto dir : directories ) {
!       if( true ) {
!         dbgmsg("copybook_t::open '%s' OF '%s' %s",
!                book.source.name,
!                dir? dir: ".",
!                book.literally.source? ", literally" : "" );
!       }
        if( (fd = book.open_file(dir, book.literally.source)) != -1 ) break;
      }
      return fd;
--- 184,193 ----
      this->source(loc, name);
  
      for( auto dir : directories ) {
!       dbgmsg("copybook_t::open '%s' OF '%s' %s",
! 	     book.source.name,
! 	     dir? dir: ".",
! 	     book.literally.source? ", literally" : "" );
        if( (fd = book.open_file(dir, book.literally.source)) != -1 ) break;
      }
      return fd;
diff -Nrcpad gcc-16-20250518/gcc/cobol/gcobc gcc-16-20250525/gcc/cobol/gcobc
*** gcc-16-20250518/gcc/cobol/gcobc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/gcobc	Sun May 25 22:32:05 2025
*************** fi
*** 73,79 ****
  
  exit_status=0
  skip_arg=
! opts="-dialect gnu $copydir ${dialect:--dialect mf} $includes"
  mode=-shared
  
  incomparable="has no comparable gcobol option"
--- 73,79 ----
  
  exit_status=0
  skip_arg=
! opts="$copydir $includes"
  mode=-shared
  
  incomparable="has no comparable gcobol option"
*************** $0 recognizes the following GnuCOBOL cob
*** 103,108 ****
--- 103,111 ----
  $0 recognizes the following GnuCOBOL cobc compilation options:
          -C
          -d, --debug
+         -D
+         -A
+         -Q
          -E
          -g
          --coverage
*************** $0 recognizes the following GnuCOBOL cob
*** 112,135 ****
          --fixed
          -F, --free
          -fimplicit-init
!         -h, --help
!         -save-temps=
!         -save-temps
!         -std=mvs
!         -std=mf
! Options that are the same in gcobol and cobc are passed through verbatim.
! Options that have no analog in gcobol produce a warning message.
! To produce this message, use -HELP.
  To see the constructed cobc command-line, use -echo.
  To override the default cobc, set the "cobc" environment variable.
  By default, gcobc invokes the gcobol the same directory the gcobc resides.
  To override, set the gcobol environment variable.
! EOF
! }
  
! #
! # Simply iterate over the command-line tokens.  We can't use getopts
! # here because it's not designed for single-dash words (e.g. -shared).
  #
  
  for opt in "$@"
--- 115,143 ----
          --fixed
          -F, --free
          -fimplicit-init
!          -h, --help
!          -save-temps=
!          -save-temps
!         -std=mvs -std=mvs-strict
!         -std=mf  -std=mf-strict
!         -std=cobol85 -std=cobol2002 -std=cobol2014
!  Options that are the same in gcobol and cobc are passed through verbatim.
!  Options that have no analog in gcobol produce a warning message.
!  To produce this message, use -HELP.
  To see the constructed cobc command-line, use -echo.
  To override the default cobc, set the "cobc" environment variable.
  By default, gcobc invokes the gcobol the same directory the gcobc resides.
  To override, set the gcobol environment variable.
!  EOF
!  }
  
! dialect="gnu"
! out_set=""
! first=""
! 
!  #
!  # Simply iterate over the command-line tokens.  We can't use getopts
!  # here because it's not designed for single-dash words (e.g. -shared).
  #
  
  for opt in "$@"
*************** do
*** 147,187 ****
                  ;;
          esac
  
!         opts="$opts $pending_arg $opt"
          pending_arg=
          continue
      fi
  
      case $opt in
!         -A | -Q) warn "$opt"
!                  ;;
          -b) mode="-shared"
              ;;
          -c) mode="-c"
              ;;
          --conf=*) warn "$opt"
!                   ;;
!         -C) error "$opt $incomparable"
!             ;;
!         -d | --debug) opts="$opts -fcobol-exceptions=EC-ALL"
!                       warn "$opt implies -fstack-check:"
!                       ;;
!         # -D
!         -E) opts="$opts $opt -fsyntax-only"
              ;;
!         -echo) echo="echo"
                 ;;
  
          -fec=* | -fno-ec=*)
              opt="$(echo "$opt" | sed -E 's/-f(no-)?ec=/-f\1cobol-exceptions=EC-/g')"
!             opts="$opts $opt"
!             ;;
!         -ext)
!             pending_arg=$opt
!             ;;
!         -ext=*) opts="$opts $(echo "$opt" | sed 's/-ext=/-copyext ./')"
!                 ;;
! 
          # A.3 Compiler options
          -fsign=*) warn "$opt" ;;
          -ffold-copy=*) warn "$opt" ;;
--- 155,206 ----
                  ;;
          esac
  
!         opts="$opts $pending_arg$opt"
          pending_arg=
          continue
      fi
  
      case $opt in
! 
!         # pass next parameter to GCC
!         -A)
!             pending_arg=" "
!             ;;
! 
!         # pass next parameter to linker
!         -Q)
!             pending_arg=-Wl,
!             ;;
! 
          -b) mode="-shared"
              ;;
          -c) mode="-c"
              ;;
          --conf=*) warn "$opt"
!                    ;;
!          -C) error "$opt $incomparable"
!              ;;
!         -d | -debug | --debug) opts="$opts -fcobol-exceptions=EC-ALL"
!                        warn "$opt implies -fstack-check:"
!                        ;;
!         # define for preprocessor, note: -D* is directly passed
!         -D)
!             pending_arg=$opt
              ;;
!          -E) opts="$opts $opt -fsyntax-only"
!              ;;
!          -echo) echo="echo"
                 ;;
  
          -fec=* | -fno-ec=*)
              opt="$(echo "$opt" | sed -E 's/-f(no-)?ec=/-f\1cobol-exceptions=EC-/g')"
!              opts="$opts $opt"
!              ;;
!          -ext)
!             pending_arg="$opt "
!              ;;
!          -ext=*) opts="$opts $(echo "$opt" | sed 's/-ext=/-copyext ./')"
!                  ;;
          # A.3 Compiler options
          -fsign=*) warn "$opt" ;;
          -ffold-copy=*) warn "$opt" ;;
*************** do
*** 359,377 ****
          -fnot-register=*) warn "$opt" ;;
          -fregister=*) warn "$opt" ;;
  
!         -fformat=auto ) ;; # gcobol and gnucobol default
  
          -fixed | --fixed | -fformat=fixed | -fformat=variable | -fformat=xcard)
                      # note: variable + xcard are only _more similar_ to fixed than free,
                      # (with changing right-column to 250/255, which isn't supported in gcobol, yet)
!                     opts="$opts -ffixed-form"
!                     ;;
! 
!         -F | -free | --free | -fformat=free | -fformat=* )
!                     # note: "all other formats" are only _more similar_ to free than fixed
!                     opts="$opts -ffree-form"
!                     ;;
  
          -h | --help) opts="$opts --help"
                       ;;
  
--- 378,395 ----
          -fnot-register=*) warn "$opt" ;;
          -fregister=*) warn "$opt" ;;
  
!         -fformat=auto) ;; # gcobol and gnucobol default
  
          -fixed | --fixed | -fformat=fixed | -fformat=variable | -fformat=xcard)
                      # note: variable + xcard are only _more similar_ to fixed than free,
                      # (with changing right-column to 250/255, which isn't supported in gcobol, yet)
!                      opts="$opts -ffixed-form"
!                      ;;
  
+         -F | -free | --free | -fformat=free | -fformat=*)
+                      # note: "all other formats" are only _more similar_ to free than fixed
+                      opts="$opts -ffree-form"
+                      ;;
          -h | --help) opts="$opts --help"
                       ;;
  
*************** do
*** 413,436 ****
                         export GCOBOL_TEMPDIR="$opt"
                         ;;
          -save-temps)  export GCOBOL_TEMPDIR="${PWD:-$(pwd)}"
!                       ;;
!         # -shared is identical
  
!         -std=mvs) opts="$opts -dialect ibm"
                    ;;
!         -std=mf)  opts="$opts -dialect mf"
                    ;;
!         -t | -T | -tlines=* | -P | -P=* | -X | --Xref)
!             warn "$opt (no listing)"
              ;;
-         -q | --brief) warn "$opt"
-                       ;;
-         -v | --verbose) opts="$opts -V"
-                         ;;
-         # note: we want -dumpversion to be passed to gcc
-         -V | --version | -version) opts="$opts --version"
-                                         ;;
- 
          # pass through, strangely -Wall is not supported
          -w | -W | -Wextra) opts="$opts $opt"
               ;;
--- 431,465 ----
                         export GCOBOL_TEMPDIR="$opt"
                         ;;
          -save-temps)  export GCOBOL_TEMPDIR="${PWD:-$(pwd)}"
!                        ;;
!          # -shared is identical
  
!         -std=mvs | -std=mvs-strict | -std=ibm | -std=ibm-strict) dialect=ibm
                    ;;
!         -std=mf | -std=mf-strict)  dialect=mf
                    ;;
!         -std=default)  dialect=gnu  # that's GnuCOBOL's default and GCC's dialect for GnuCOBOL
!                    ;;
!         -std=cobol*)    dialect=""   # GCC COBOL targets COBOL2024 "mostly backward to COBOL85"
!                    ;;
!         -std=*)
!             dialect=""
!             warn "$opt (unkown dialect)"
!                   ;;
!         -P | -P=* | -X | --Xref)
!              warn "$opt (no listing)"
!              ;;
!         -t | -T)
!             # note: -P has an _optional_ arg, so we leave it above
!             ignore_arg "$opt (no listing)"
!             ;;
!          -q | --brief) warn "$opt"
!                        ;;
!          -v | --verbose) opts="$opts -V"
!                          ;;
!          # note: we want -dumpversion to be passed to gcc
!          -V | --version | -version) opts="$opts --version"
              ;;
          # pass through, strangely -Wall is not supported
          -w | -W | -Wextra) opts="$opts $opt"
               ;;
diff -Nrcpad gcc-16-20250518/gcc/cobol/gcobol.1 gcc-16-20250525/gcc/cobol/gcobol.1
*** gcc-16-20250518/gcc/cobol/gcobol.1	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/gcobol.1	Sun May 25 22:32:05 2025
*************** others. They are listed alphabetically b
*** 1167,1220 ****
  .It
  ABS ACOS ANNUITY ASIN ATAN
  .It
! BASECONVERT BIT_OF BIT_TO_CHAR BOOLEAN_OF_INTEGER BYTE_LENGTH
  .It
! CHAR CHAR_NATIONAL COMBINED_DATETIME CONCAT CONVERT COS CURRENT_DATE
  .It
! DATE_OF_INTEGER DATE_TO_YYYYMMDD DAY_OF_INTEGER DAY_TO_YYYYDDD DISPLAY_OF
  .It
! E EXCEPTION_FILE
! EXCEPTION_FILE_N EXCEPTION_LOCATION EXCEPTION_LOCATION_N
! EXCEPTION_STATEMENT EXCEPTION_STATUS EXP EXP10
  .It
! FACTORIAL FIND_STRING
! FORMATTED_CURRENT_DATE FORMATTED_DATE FORMATTED_DATETIME
! FORMATTED_TIME FRACTION_PART
  .It
! HEX_OF HEX_TO_CHAR HIGHEST_ALGEBRAIC
  .It
! INTEGER INTEGER_OF_BOOLEAN INTEGER_OF_DATE INTEGER_OF_DAY
! INTEGER_OF_FORMATTED_DATE INTEGER_PART
  .It
! LENGTH LOCALE_COMPARE
! LOCALE_DATE LOCALE_TIME LOCALE_TIME_FROM_SECONDS LOG LOG10 LOWER_CASE
! LOWEST_ALGEBRAIC
  .It
! MAX MEAN MEDIAN MIDRANGE MIN MOD MODULE_NAME
  .It
! NATIONAL_OF NUMVAL NUMVAL_C NUMVAL_F ORD
  .It
! ORD_MAX ORD_MIN
  .It
! PI PRESENT_VALUE
  .It
  RANDOM RANGE REM REVERSE
  .It
! SECONDS_FROM_FORMATTED_TIME
! SECONDS_PAST_MIDNIGHT SIGN SIN SMALLEST_ALGEBRAIC SQRT
! STANDARD_COMPARE STANDARD_DEVIATION SUBSTITUTE SUM
  .It
! TAN TEST_DATE_YYYYMMDD TEST_DAY_YYYYDDD TEST_FORMATTED_DATETIME
! TEST_NUMVAL TEST_NUMVAL_C TEST_NUMVAL_F TRIM
  .It
! ULENGTH UPOS UPPER_CASE
  USUBSTR USUPPLEMENTARY UUID4 UVALID UWIDTH
  .It
  VARIANCE
  .It
! WHEN_COMPILED
  .It
! YEAR_TO_YYYY
  .El
  .
  .Ss Binary floating point DISPLAY
--- 1167,1220 ----
  .It
  ABS ACOS ANNUITY ASIN ATAN
  .It
! BASECONVERT BIT-OF BIT-TO-CHAR BOOLEAN-OF-INTEGER BYTE-LENGTH
  .It
! CHAR CHAR-NATIONAL COMBINED-DATETIME CONCAT CONVERT COS CURRENT-DATE
  .It
! DATE-OF-INTEGER DATE-TO-YYYYMMDD DAY-OF-INTEGER DAY-TO-YYYYDDD DISPLAY-OF
  .It
! E EXCEPTION-FILE
! EXCEPTION-FILE-N EXCEPTION-LOCATION EXCEPTION-LOCATION-N
! EXCEPTION-STATEMENT EXCEPTION-STATUS EXP EXP10
  .It
! FACTORIAL FIND-STRING
! FORMATTED-CURRENT-DATE FORMATTED-DATE FORMATTED-DATETIME
! FORMATTED-TIME FRACTION-PART
  .It
! HEX-OF HEX-TO-CHAR HIGHEST-ALGEBRAIC
  .It
! INTEGER INTEGER-OF-BOOLEAN INTEGER-OF-DATE INTEGER-OF-DAY
! INTEGER-OF-FORMATTED-DATE INTEGER-PART
  .It
! LENGTH LOCALE-COMPARE
! LOCALE-DATE LOCALE-TIME LOCALE-TIME-FROM-SECONDS LOG LOG10 LOWER-CASE
! LOWEST-ALGEBRAIC
  .It
! MAX MEAN MEDIAN MIDRANGE MIN MOD MODULE-NAME
  .It
! NATIONAL-OF NUMVAL NUMVAL-C NUMVAL-F ORD
  .It
! ORD-MAX ORD-MIN
  .It
! PI PRESENT-VALUE
  .It
  RANDOM RANGE REM REVERSE
  .It
! SECONDS-FROM-FORMATTED-TIME
! SECONDS-PAST-MIDNIGHT SIGN SIN SMALLEST-ALGEBRAIC SQRT
! STANDARD-COMPARE STANDARD-DEVIATION SUBSTITUTE SUM
  .It
! TAN TEST-DATE-YYYYMMDD TEST-DAY-YYYYDDD TEST-FORMATTED-DATETIME
! TEST-NUMVAL TEST-NUMVAL-C TEST-NUMVAL-F TRIM
  .It
! ULENGTH UPOS UPPER-CASE
  USUBSTR USUPPLEMENTARY UUID4 UVALID UWIDTH
  .It
  VARIANCE
  .It
! WHEN-COMPILED
  .It
! YEAR-TO-YYYY
  .El
  .
  .Ss Binary floating point DISPLAY
diff -Nrcpad gcc-16-20250518/gcc/cobol/genapi.cc gcc-16-20250525/gcc/cobol/genapi.cc
*** gcc-16-20250518/gcc/cobol/genapi.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/genapi.cc	Sun May 25 22:32:05 2025
*************** compare_binary_binary(tree return_int,
*** 1969,1976 ****
        {
        gg_printf("compare_binary_binary(): using int64\n", NULL_TREE);
        }
!     left_side  = gg_define_variable( left_side_ref->field->attr & signable_e ? LONG : ULONG );
!     right_side = gg_define_variable(right_side_ref->field->attr & signable_e ? LONG : ULONG );
      }
  
    //tree dummy = gg_define_int();
--- 1969,1976 ----
        {
        gg_printf("compare_binary_binary(): using int64\n", NULL_TREE);
        }
!     left_side  = gg_define_variable( left_side_ref->field->has_attr(signable_e) ? LONG : ULONG );
!     right_side = gg_define_variable(right_side_ref->field->has_attr(signable_e) ? LONG : ULONG );
      }
  
    //tree dummy = gg_define_int();
diff -Nrcpad gcc-16-20250518/gcc/cobol/lexio.cc gcc-16-20250525/gcc/cobol/lexio.cc
*** gcc-16-20250518/gcc/cobol/lexio.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/lexio.cc	Sun May 25 22:32:05 2025
*************** cdftext::lex_open( const char filename[]
*** 1455,1461 ****
  
    int output = open_output();
  
!   // Process any files supplied by the -include comamnd-line option.
    for( auto name : included_files ) {
      int input;
      if( -1 == (input = open(name, O_RDONLY)) ) {
--- 1455,1461 ----
  
    int output = open_output();
  
!   // Process any files supplied by the -include command-line option.
    for( auto name : included_files ) {
      int input;
      if( -1 == (input = open(name, O_RDONLY)) ) {
*************** cdftext::lex_open( const char filename[]
*** 1466,1472 ****
--- 1466,1475 ----
      filespan_t mfile( free_form_reference_format( input ) );
  
      process_file( mfile, output );
+ 
+     cobol_filename_restore(); // process_file restores only for COPY
    }
+   included_files.clear();
  
    cobol_filename(filename, inode_of(input));
    filespan_t mfile( free_form_reference_format( input ) );
*************** cdftext::process_file( filespan_t mfile,
*** 1831,1836 ****
--- 1834,1840 ----
    // indicate current file
    static const char file_push[] = "\f#FILE PUSH ", file_pop[] = "\f#FILE POP\f";
  
+   if( !included_files.empty() ) { ++nfiles; }; // force push/pop of included filename
    if( !second_pass && nfiles++ ) {
      static const char delimiter[] = "\f";
      const char *filename = cobol_filename();
*************** cdftext::process_file( filespan_t mfile,
*** 1918,1923 ****
--- 1922,1928 ----
      std::copy(file_pop, file_pop + strlen(file_pop), ofs);
      out.flush();
    }
+   if( !included_files.empty() ) { --nfiles; };
  }
  
  std::list<span_t>
diff -Nrcpad gcc-16-20250518/gcc/cobol/parse.y gcc-16-20250525/gcc/cobol/parse.y
*** gcc-16-20250518/gcc/cobol/parse.y	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/parse.y	Sun May 25 22:32:05 2025
***************
*** 375,381 ****
  			LSUB "("
  			PARAMETER_kw "PARAMETER"
  			OVERRIDE READY RESET
! 			RSUB ")"
  			SERVICE_RELOAD "SERVICE RELOAD" STAR_CBL "*CBL"
  			SUBSCRIPT SUPPRESS TITLE TRACE USE
  
--- 375,381 ----
  			LSUB "("
  			PARAMETER_kw "PARAMETER"
  			OVERRIDE READY RESET
! 			RSUB")"
  			SERVICE_RELOAD "SERVICE RELOAD" STAR_CBL "*CBL"
  			SUBSCRIPT SUPPRESS TITLE TRACE USE
  
***************
*** 662,668 ****
  %type   <boolean>       all optional sign_leading on_off initialized strong is_signed
  %type   <number>        count data_clauses data_clause
  %type   <number>        nine nines nps relop spaces_etc reserved_value signed
! %type   <number>        variable_type
  %type   <number>        true_false posneg eval_posneg
  %type   <number>        open_io alphabet_etc
  %type   <special_type>  device_name
--- 662,668 ----
  %type   <boolean>       all optional sign_leading on_off initialized strong is_signed
  %type   <number>        count data_clauses data_clause
  %type   <number>        nine nines nps relop spaces_etc reserved_value signed
! %type   <number>        variable_type binary_type
  %type   <number>        true_false posneg eval_posneg
  %type   <number>        open_io alphabet_etc
  %type   <special_type>  device_name
***************
*** 951,957 ****
  %printer { fprintf(yyo, "%s'%.*s'{" HOST_SIZE_T_PRINT_UNSIGNED "} %s",
                          $$.prefix, int($$.len), $$.data, (fmt_size_t)$$.len,
                          $$.symbol_name()); } <literal>
! %printer { fprintf(yyo, "%s (1st of " HOST_SIZE_T_PRINT_UNSIGNED ")",
                          $$->targets.empty()? "" : $$->targets.front().refer.field->name,
                          (fmt_size_t)$$->targets.size() ); } <targets>
  %printer { fprintf(yyo, "#" HOST_SIZE_T_PRINT_UNSIGNED ": %s",
--- 951,957 ----
  %printer { fprintf(yyo, "%s'%.*s'{" HOST_SIZE_T_PRINT_UNSIGNED "} %s",
                          $$.prefix, int($$.len), $$.data, (fmt_size_t)$$.len,
                          $$.symbol_name()); } <literal>
! %printer { fprintf(yyo,"%s (1st of" HOST_SIZE_T_PRINT_UNSIGNED")",
                          $$->targets.empty()? "" : $$->targets.front().refer.field->name,
                          (fmt_size_t)$$->targets.size() ); } <targets>
  %printer { fprintf(yyo, "#" HOST_SIZE_T_PRINT_UNSIGNED ": %s",
*************** opt_clause:     opt_arith
*** 1559,1565 ****
          |       opt_entry
          |       opt_binary
          |       opt_decimal {
! 		  cbl_unimplementedw("type FLOAT-DECIMAL was ignored");
  		}
          |       opt_intermediate
          |       opt_init
--- 1559,1565 ----
          |       opt_entry
          |       opt_binary
          |       opt_decimal {
! 		  cbl_unimplemented("type FLOAT-DECIMAL");
  		}
          |       opt_intermediate
          |       opt_init
*************** fd_clause:      record_desc
*** 2948,2954 ****
                  {
                    auto f = cbl_file_of(symbol_at(file_section_fd));
                    f->attr |= external_e;
!                   cbl_unimplemented("AS LITERAL ");
                  }
          |       fd_linage
          |       fd_report {
--- 2948,2954 ----
                  {
                    auto f = cbl_file_of(symbol_at(file_section_fd));
                    f->attr |= external_e;
!                   cbl_unimplemented("AS LITERAL");
                  }
          |       fd_linage
          |       fd_report {
*************** data_descr:     data_descr1
*** 3362,3370 ****
                  ;
  
  const_value:    cce_expr
!         |       BYTE_LENGTH of name { $name->data.set_real_from_capacity(&$$); }
!         |       LENGTH      of name { $name->data.set_real_from_capacity(&$$); }
!         |       LENGTH_OF   of name { $name->data.set_real_from_capacity(&$$); }
                  ;
  
  value78:        literalism
--- 3362,3372 ----
                  ;
  
  const_value:    cce_expr
!         |       BYTE_LENGTH of name { set_real_from_capacity(@name, $name, &$$); }
!         |       LENGTH      of name { set_real_from_capacity(@name, $name, &$$); }
!         |       LENGTH_OF   of name { set_real_from_capacity(@name, $name, &$$); }
!         |       LENGTH_OF   of binary_type[type] {
! 		                real_from_integer(&$$, VOIDmode, $type, SIGNED); }
                  ;
  
  value78:        literalism
*************** value78:        literalism
*** 3380,3385 ****
--- 3382,3393 ----
  		  data = build_real (float128_type_node, $1);
                    $$ = new cbl_field_data_t(data);
                  }
+         |       reserved_value[value]
+                 {
+ 		  auto field = constant_of(constant_index($value));
+                   $$ = new cbl_field_data_t(field->data);
+                 }
+ 
          |       true_false
                  {
                    cbl_unimplemented("Boolean constant");
*************** data_descr1:    level_name
*** 3413,3418 ****
--- 3421,3441 ----
                      error_msg(@1, "%s was defined by CDF", field.name);
                    }
                  }
+ 
+         |       level_name CONSTANT is_global as reserved_value[value]
+                 {
+                   cbl_field_t& field = *$1;
+                   if( field.level != 1 ) {
+                     error_msg(@1, "%s must be an 01-level data item", field.name);
+                     YYERROR;
+                   }
+                   field.attr |= constant_e;
+                   if( $is_global ) field.attr |= global_e;
+                   field.type = FldLiteralA;
+ 		  auto fig = constant_of(constant_index($value));
+                   field.data = fig->data;
+                 }
+ 
          |       level_name CONSTANT is_global as literalism[lit]
                  {
                    cbl_field_t& field = *$1;
*************** data_descr1:    level_name
*** 3452,3459 ****
  
          |       LEVEL78 NAME[name] VALUE is value78[data]
                  {
!                   if( ! dialect_mf() ) {
!                     dialect_error(@1, "level 78", "mf");
                      YYERROR;
                    }
                    struct cbl_field_t field = { 0, FldLiteralA, FldInvalid,
--- 3475,3482 ----
  
          |       LEVEL78 NAME[name] VALUE is value78[data]
                  {
!                   if( ! (dialect_mf() || dialect_gnu()) ) {
!                     dialect_error(@1, "level 78", "mf or gnu");
                      YYERROR;
                    }
                    struct cbl_field_t field = { 0, FldLiteralA, FldInvalid,
*************** accept:         accept_body end_accept {
*** 5038,5044 ****
  		  switch( $accept_body.func ) {
  		  case accept_done_e:
  		    error_msg(@ec, "ON EXCEPTION valid only "
! 			    "with ENVIRONMENT or COMAMND-LINE(n)");
  		    break;
  		  case accept_command_line_e:
  		    if( $1.from->field == NULL ) { // take next command-line arg
--- 5061,5067 ----
  		  switch( $accept_body.func ) {
  		  case accept_done_e:
  		    error_msg(@ec, "ON EXCEPTION valid only "
! 			    "with ENVIRONMENT or COMMAND-LINE(n)");
  		    break;
  		  case accept_command_line_e:
  		    if( $1.from->field == NULL ) { // take next command-line arg
*************** accept:         accept_body end_accept {
*** 5050,5056 ****
  		      parser_move(*$1.into, *$1.from);
  		      if( $ec.on_error || $ec.not_error ) {
  			error_msg(@ec, "ON EXCEPTION valid only "
! 				"with ENVIRONMENT or COMAMND-LINE(n)");
  		      }
  		    } else {
  		      parser_accept_command_line(*$1.into, *$1.from,
--- 5073,5079 ----
  		      parser_move(*$1.into, *$1.from);
  		      if( $ec.on_error || $ec.not_error ) {
  			error_msg(@ec, "ON EXCEPTION valid only "
! 				"with ENVIRONMENT or COMMAND-LINE(n)");
  		      }
  		    } else {
  		      parser_accept_command_line(*$1.into, *$1.from,
*************** num_value:      scalar // might actually
*** 7025,7030 ****
--- 7048,7062 ----
          |       num_literal { $$ = new_reference($1); }
          |       ADDRESS OF scalar {$$ = $scalar; $$->addr_of = true; }
          |       DETAIL OF scalar {$$ = $scalar; }
+         |       LENGTH_OF binary_type[size] {
+                   location_set(@1);
+                   $$ = new cbl_refer_t( new_tempnumeric() );
+ 		  $$->field->clear_attr(signable_e);
+                   if( dialect_gcc() ) {
+ 		    dialect_error(@1, "LENGTH OF", "ibm");
+                   }
+ 		  parser_set_numeric($$->field, $size);
+ 		}
          |       LENGTH_OF name[val] {
                    location_set(@1);
                    $$ = new cbl_refer_t( new_tempnumeric() );
*************** signed_literal:     num_literal
*** 7251,7256 ****
--- 7283,7297 ----
                    struct cbl_field_t *zero = constant_of(constant_index(ZERO));
                    parser_subtract( $$, zero, $2, current_rounded_mode() );
                  }
+         |       LENGTH_OF binary_type[size] {
+                   location_set(@1);
+                   $$ = new_tempnumeric();
+ 		  $$->clear_attr(signable_e);
+                   if( dialect_gcc() ) {
+ 		    dialect_error(@1, "LENGTH OF", "ibm");
+                   }
+                   parser_set_numeric($$, $size);
+ 		}
          |       LENGTH_OF name[val] {
                    location_set(@1);
                    $$ = new_tempnumeric();
*************** perform_inline: perform_start statements
*** 7505,7510 ****
--- 7546,7552 ----
  		  }
                  }
                  ;
+ 
  perform_start:	%empty %prec LOCATION {
  		  perform_ec_setup();
  		  $$ = 0;
*************** varg1a:         ADDRESS OF scalar {
*** 7809,7814 ****
--- 7851,7865 ----
                  {
                    $$ = new_reference(constant_of(constant_index($1)));
                  }
+         |       LENGTH_OF binary_type[size] {
+                   location_set(@1);
+                   $$ = new cbl_refer_t( new_tempnumeric() );
+ 		  $$->field->clear_attr(signable_e);
+                   if( dialect_gcc() ) {
+ 		    dialect_error(@1, "LENGTH OF", "ibm");
+                   }
+ 		  parser_set_numeric($$->field, $size);
+ 		}
          |       LENGTH_OF name[val] {
                    location_set(@1);
                    $$ = new cbl_refer_t( new_tempnumeric() );
*************** varg1a:         ADDRESS OF scalar {
*** 7833,7838 ****
--- 7884,7893 ----
                  }
                  ;
  
+ binary_type:	BINARY_INTEGER { $$ = $1.capacity; }
+ 	|	COMPUTATIONAL  { $$ = $1.capacity; }
+ 		;
+ 
  literal:        literalism
                  {
                    $$ = $1.isymbol()?
*************** function_udf:   FUNCTION_UDF '(' arg_lis
*** 10108,10114 ****
  		  if( ! current.udf_args_valid(L, $args->refers, params) ) {
  		    YYERROR;
  		  }
!                   $$ = new_temporary_clone(cbl_field_of(symbol_at(L->returning)));
                    std::vector <cbl_ffi_arg_t> args($args->refers.size());
  		  size_t i = 0;
  		  // Pass parameters as defined by the function.
--- 10163,10171 ----
  		  if( ! current.udf_args_valid(L, $args->refers, params) ) {
  		    YYERROR;
  		  }
! 		  const auto returning = cbl_field_of(symbol_at(L->returning));
!                   $$ = new_temporary_clone(returning);
! 		  $$->data.initial = returning->name; // user's name for the field
                    std::vector <cbl_ffi_arg_t> args($args->refers.size());
  		  size_t i = 0;
  		  // Pass parameters as defined by the function.
*************** function_udf:   FUNCTION_UDF '(' arg_lis
*** 10127,10133 ****
                    static cbl_ffi_arg_t *args = NULL;
  
                    auto L = cbl_label_of(symbol_at($1));
!                   $$ = new_temporary_clone(cbl_field_of(symbol_at(L->returning)));
  
                    auto name = new_literal(strlen(L->name), L->name, quoted_e);
                    ast_call( @1, name, $$, narg, args, NULL, NULL, true );
--- 10184,10192 ----
                    static cbl_ffi_arg_t *args = NULL;
  
                    auto L = cbl_label_of(symbol_at($1));
! 		  const auto returning = cbl_field_of(symbol_at(L->returning));
!                   $$ = new_temporary_clone(returning);
! 		  $$->data.initial = returning->name; // user's name for the field
  
                    auto name = new_literal(strlen(L->name), L->name, quoted_e);
                    ast_call( @1, name, $$, narg, args, NULL, NULL, true );
*************** intrinsic:      function_udf
*** 10168,10174 ****
                    $$ = is_numeric(args[0].field)?
                           new_tempnumeric_float() :
                           new_alphanumeric();
! 
                    parser_intrinsic_callv( $$, intrinsic_cname($1),
  					  args.size(), args.data() );
                  }
--- 10227,10233 ----
                    $$ = is_numeric(args[0].field)?
                           new_tempnumeric_float() :
                           new_alphanumeric();
! 		  $$->data.initial = keyword_str($1);
                    parser_intrinsic_callv( $$, intrinsic_cname($1),
  					  args.size(), args.data() );
                  }
*************** intrinsic:      function_udf
*** 10177,10183 ****
                  {
                    static char s[] = "__gg__present_value";
                    location_set(@1);
!                   $$ = new_tempnumeric_float();
                    size_t n = $args->size();
                    assert(n > 0);
                    if( n < 2 ) {
--- 10236,10242 ----
                  {
                    static char s[] = "__gg__present_value";
                    location_set(@1);
!                   $$ = new_tempnumeric_float("PRESENT-VALUE");
                    size_t n = $args->size();
                    assert(n > 0);
                    if( n < 2 ) {
*************** intrinsic:      function_udf
*** 10195,10242 ****
  
  	|       BASECONVERT  '(' varg[r1] varg[r2] varg[r3] ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric();
  		  cbl_unimplemented("BASECONVERT");
                    if( ! intrinsic_call_3($$, BASECONVERT, $r1, $r2, $r3 )) YYERROR;
                  }
          |       BIT_OF  '(' expr[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    if( ! intrinsic_call_1($$, BIT_OF, $r1, @r1)) YYERROR;
                  }
          |       CHAR  '(' expr[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(1);
                    if( ! intrinsic_call_1($$, CHAR, $r1, @r1)) YYERROR;
                  }
  
  	|       CONVERT  '(' varg[r1] convert_src[src] convert_dst[dst] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(1);
  		  cbl_unimplemented("CONVERT");
                    /* if( ! intrinsic_call_3($$, CONVERT, $r1, $src, $dst) ) YYERROR; */
                  }
  
          |       DISPLAY_OF  '(' varg[r1]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    if( ! intrinsic_call_2($$, DISPLAY_OF, $r1, NULL) ) YYERROR;
                  }
          |       DISPLAY_OF  '(' varg[r1] varg[r2]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    if( ! intrinsic_call_2($$, DISPLAY_OF, $r1, $r2) ) YYERROR;
                  }
  
          |       EXCEPTION_FILE filename {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    parser_exception_file( $$, $filename );
                  }
  
          |       FIND_STRING '(' varg[r1] last start_after anycase ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    /* auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e)); */
  		  cbl_unimplemented("FIND_STRING");
                    /* if( ! intrinsic_call_4($$, FIND_STRING, r1, $r2) ) YYERROR; */
--- 10254,10301 ----
  
  	|       BASECONVERT  '(' varg[r1] varg[r2] varg[r3] ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric("BASECONVERT");
  		  cbl_unimplemented("BASECONVERT");
                    if( ! intrinsic_call_3($$, BASECONVERT, $r1, $r2, $r3 )) YYERROR;
                  }
          |       BIT_OF  '(' expr[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric("BIT-OF");
                    if( ! intrinsic_call_1($$, BIT_OF, $r1, @r1)) YYERROR;
                  }
          |       CHAR  '(' expr[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(1,"CHAR");
                    if( ! intrinsic_call_1($$, CHAR, $r1, @r1)) YYERROR;
                  }
  
  	|       CONVERT  '(' varg[r1] convert_src[src] convert_dst[dst] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(1,"CONVERT");
  		  cbl_unimplemented("CONVERT");
                    /* if( ! intrinsic_call_3($$, CONVERT, $r1, $src, $dst) ) YYERROR; */
                  }
  
          |       DISPLAY_OF  '(' varg[r1]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric("DISPLAY-OF");
                    if( ! intrinsic_call_2($$, DISPLAY_OF, $r1, NULL) ) YYERROR;
                  }
          |       DISPLAY_OF  '(' varg[r1] varg[r2]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric("DISPLAY-OF");
                    if( ! intrinsic_call_2($$, DISPLAY_OF, $r1, $r2) ) YYERROR;
                  }
  
          |       EXCEPTION_FILE filename {
                    location_set(@1);
!                   $$ = new_alphanumeric("EXCEPTION-FILE");
                    parser_exception_file( $$, $filename );
                  }
  
          |       FIND_STRING '(' varg[r1] last start_after anycase ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric("FIND-STRING");
                    /* auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e)); */
  		  cbl_unimplemented("FIND_STRING");
                    /* if( ! intrinsic_call_4($$, FIND_STRING, r1, $r2) ) YYERROR; */
*************** intrinsic:      function_udf
*** 10244,10250 ****
  
          |       FORMATTED_DATE '(' DATE_FMT[r1] expr[r2] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATE);
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, FORMATTED_DATE, r1, $r2) ) YYERROR;
                  }
--- 10303,10309 ----
  
          |       FORMATTED_DATE '(' DATE_FMT[r1] expr[r2] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATE, "FORMATTED-DATE");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, FORMATTED_DATE, r1, $r2) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10253,10259 ****
          |       FORMATTED_DATETIME '(' DATETIME_FMT[r1] expr[r2]
                                                          expr[r3] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME);
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    static cbl_refer_t r3(literally_zero);
                    if( ! intrinsic_call_4($$, FORMATTED_DATETIME,
--- 10312,10318 ----
          |       FORMATTED_DATETIME '(' DATETIME_FMT[r1] expr[r2]
                                                          expr[r3] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME, "FORMATTED-DATETIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    static cbl_refer_t r3(literally_zero);
                    if( ! intrinsic_call_4($$, FORMATTED_DATETIME,
*************** intrinsic:      function_udf
*** 10262,10268 ****
          |       FORMATTED_DATETIME '(' DATETIME_FMT[r1] expr[r2]
                                          expr[r3] expr[r4] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME);
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_4($$, FORMATTED_DATETIME,
                                               r1, $r2, $r3, $r4) ) YYERROR;
--- 10321,10327 ----
          |       FORMATTED_DATETIME '(' DATETIME_FMT[r1] expr[r2]
                                          expr[r3] expr[r4] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME, "FORMATTED-DATETIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_4($$, FORMATTED_DATETIME,
                                               r1, $r2, $r3, $r4) ) YYERROR;
*************** intrinsic:      function_udf
*** 10273,10286 ****
          |       FORMATTED_TIME '(' TIME_FMT[r1] expr[r2]
                                                  expr[r3]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME);
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_3($$, FORMATTED_TIME,
                                               r1, $r2, $r3) ) YYERROR;
                  }
          |       FORMATTED_TIME '(' TIME_FMT[r1] expr[r2]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME);
                    auto r3 = new_reference(new_literal("0"));
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_3($$, FORMATTED_TIME,
--- 10332,10345 ----
          |       FORMATTED_TIME '(' TIME_FMT[r1] expr[r2]
                                                  expr[r3]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME, "FORMATTED-DATETIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_3($$, FORMATTED_TIME,
                                               r1, $r2, $r3) ) YYERROR;
                  }
          |       FORMATTED_TIME '(' TIME_FMT[r1] expr[r2]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME, "FORMATTED-TIME");
                    auto r3 = new_reference(new_literal("0"));
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_3($$, FORMATTED_TIME,
*************** intrinsic:      function_udf
*** 10288,10308 ****
                  }
          |       FORMATTED_CURRENT_DATE '(' DATETIME_FMT[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME);
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_1($$, FORMATTED_CURRENT_DATE, r1, @r1) )
                                           YYERROR;
                  }
          |       TEST_FORMATTED_DATETIME '(' DATE_FMT[r1] varg[r2] ')' {
                  location_set(@1);
!                   $$ = new_tempnumeric();
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
                                                r1, $r2) ) YYERROR;
                  }
          |       TEST_FORMATTED_DATETIME '(' TIME_FMT[r1] varg[r2] ')' {
                  location_set(@1);
!                   $$ = new_tempnumeric();
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
                                                r1, $r2) ) YYERROR;
--- 10347,10367 ----
                  }
          |       FORMATTED_CURRENT_DATE '(' DATETIME_FMT[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME, "FORMATTED-CURRENT_DATE");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_1($$, FORMATTED_CURRENT_DATE, r1, @r1) )
                                           YYERROR;
                  }
          |       TEST_FORMATTED_DATETIME '(' DATE_FMT[r1] varg[r2] ')' {
                  location_set(@1);
! 		$$ = new_tempnumeric("TEST-FORMATTED-DATETIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
                                                r1, $r2) ) YYERROR;
                  }
          |       TEST_FORMATTED_DATETIME '(' TIME_FMT[r1] varg[r2] ')' {
                  location_set(@1);
! 		$$ = new_tempnumeric("TEST-FORMATTED-DATETIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
                                                r1, $r2) ) YYERROR;
*************** intrinsic:      function_udf
*** 10310,10323 ****
          |       TEST_FORMATTED_DATETIME '(' DATETIME_FMT[r1] varg[r2] ')'
                  {
                  location_set(@1);
!                   $$ = new_tempnumeric();
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
                                                r1, $r2) ) YYERROR;
                  }
          |       INTEGER_OF_FORMATTED_DATE '(' DATE_FMT[r1] varg[r2] ')' {
                  location_set(@1);
!                   $$ = new_tempnumeric();
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, INTEGER_OF_FORMATTED_DATE,
                                                r1, $r2) ) YYERROR;
--- 10369,10382 ----
          |       TEST_FORMATTED_DATETIME '(' DATETIME_FMT[r1] varg[r2] ')'
                  {
                  location_set(@1);
! 		$$ = new_tempnumeric("TEST-FORMATTED-DATETIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
                                                r1, $r2) ) YYERROR;
                  }
          |       INTEGER_OF_FORMATTED_DATE '(' DATE_FMT[r1] varg[r2] ')' {
                  location_set(@1);
! 		$$ = new_tempnumeric("INTEGER-OF-FORMATTED-DATE");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, INTEGER_OF_FORMATTED_DATE,
                                                r1, $r2) ) YYERROR;
*************** intrinsic:      function_udf
*** 10325,10338 ****
          |       INTEGER_OF_FORMATTED_DATE '(' DATETIME_FMT[r1] varg[r2] ')'
                  {
                  location_set(@1);
!                   $$ = new_tempnumeric();
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, INTEGER_OF_FORMATTED_DATE,
                                                r1, $r2) ) YYERROR;
                  }
          |       SECONDS_FROM_FORMATTED_TIME '(' TIME_FMT[r1] varg[r2] ')' {
                  location_set(@1);
!                   $$ = new_tempnumeric();
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, SECONDS_FROM_FORMATTED_TIME,
                                                r1, $r2) ) YYERROR;
--- 10384,10397 ----
          |       INTEGER_OF_FORMATTED_DATE '(' DATETIME_FMT[r1] varg[r2] ')'
                  {
                  location_set(@1);
! 		$$ = new_tempnumeric("INTEGER-OF-FORMATTED-DATE");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, INTEGER_OF_FORMATTED_DATE,
                                                r1, $r2) ) YYERROR;
                  }
          |       SECONDS_FROM_FORMATTED_TIME '(' TIME_FMT[r1] varg[r2] ')' {
                  location_set(@1);
! 		$$ = new_tempnumeric("SECONDS-FROM-FORMATTED-TIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, SECONDS_FROM_FORMATTED_TIME,
                                                r1, $r2) ) YYERROR;
*************** intrinsic:      function_udf
*** 10340,10346 ****
          |       SECONDS_FROM_FORMATTED_TIME '(' DATETIME_FMT[r1] varg[r2] ')'
                  {
                  location_set(@1);
!                   $$ = new_tempnumeric();
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, SECONDS_FROM_FORMATTED_TIME,
                                                r1, $r2) ) YYERROR;
--- 10399,10405 ----
          |       SECONDS_FROM_FORMATTED_TIME '(' DATETIME_FMT[r1] varg[r2] ')'
                  {
                  location_set(@1);
! 		$$ = new_tempnumeric("SECONDS-FROM-FORMATTED-TIME");
                    auto r1 = new_reference(new_literal(strlen($r1), $r1, quoted_e));
                    if( ! intrinsic_call_2($$, SECONDS_FROM_FORMATTED_TIME,
                                                r1, $r2) ) YYERROR;
*************** intrinsic:      function_udf
*** 10348,10432 ****
  
          |       HEX_OF  '(' varg[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    if( ! intrinsic_call_1($$, HEX_OF, $r1, @r1)) YYERROR;
                  }
  	|	LENGTH '(' tableish[val] ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric();
  		  $$->clear_attr(signable_e);
  		  parser_set_numeric($$, $val->field->size());
  		  if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR;
  		}
  	|	LENGTH '(' varg1a[val] ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric();
  		  $$->clear_attr(signable_e);
  		  parser_set_numeric($$, $val->field->data.capacity);
  		  if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR;
  		}
          |       lopper_case[func] '(' alpha_val[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric($r1->field->data.capacity);
                    if( ! intrinsic_call_1($$, $func, $r1, @r1)) YYERROR;
                  }
  
  	|	MODULE_NAME '(' module_type[type] ')'
  		{
! 		  $$ = new_alphanumeric(sizeof(cbl_name_t));
  		  parser_module_name( $$, $type );
  		}
  
          |       NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale,
                                                        *$r2.arg2, $anycase );
                  }
          |       ORD  '(' alpha_val[r1] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_1($$, ORD, $r1, @r1)) YYERROR;
                  }
          |       RANDOM
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric_float();
                    parser_intrinsic_call_0( $$, intrinsic_cname(RANDOM) );
                  }
          |       RANDOM_SEED expr[r1] ')'
                  { // left parenthesis consumed by lexer
                    location_set(@1);
!                   $$ = new_tempnumeric_float();
                    if( ! intrinsic_call_1($$, RANDOM, $r1, @r1)) YYERROR;
                  }
  
          |       STANDARD_COMPARE  '(' varg[r1] varg[r2] varg[r3] varg[r4] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
  		  cbl_unimplemented("STANDARD-COMPARE");
                    /* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) ) YYERROR; */
                  }
          |       STANDARD_COMPARE  '(' varg[r1] varg[r2] varg[r3]  ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
  		  cbl_unimplemented("STANDARD-COMPARE");
                    /* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) ) YYERROR; */
                  }
          |       STANDARD_COMPARE  '(' varg[r1] varg[r2] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
  		  cbl_unimplemented("STANDARD-COMPARE");
                    /* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) ) YYERROR; */
                  }
  
          |       SUBSTITUTE '(' varg[r1] subst_inputs[inputs] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    std::vector <cbl_substitute_t> args($inputs->size());
                    std::transform( $inputs->begin(), $inputs->end(), args.begin(),
                                    []( const substitution_t& arg ) {
--- 10407,10491 ----
  
          |       HEX_OF  '(' varg[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric("HEX-OF");
                    if( ! intrinsic_call_1($$, HEX_OF, $r1, @r1)) YYERROR;
                  }
  	|	LENGTH '(' tableish[val] ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric("LENGTH");
  		  $$->clear_attr(signable_e);
  		  parser_set_numeric($$, $val->field->size());
  		  if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR;
  		}
  	|	LENGTH '(' varg1a[val] ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric("LENGTH");
  		  $$->clear_attr(signable_e);
  		  parser_set_numeric($$, $val->field->data.capacity);
  		  if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR;
  		}
          |       lopper_case[func] '(' alpha_val[r1] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric($r1->field->data.capacity, "lopper_case[func]");
                    if( ! intrinsic_call_1($$, $func, $r1, @r1)) YYERROR;
                  }
  
  	|	MODULE_NAME '(' module_type[type] ')'
  		{
! 		  $$ = new_alphanumeric(sizeof(cbl_name_t), "MODULE-NAME");
  		  parser_module_name( $$, $type );
  		}
  
          |       NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric("NUMVAL-C");
                    parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale,
                                                        *$r2.arg2, $anycase );
                  }
          |       ORD  '(' alpha_val[r1] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("ORD");
                    if( ! intrinsic_call_1($$, ORD, $r1, @r1)) YYERROR;
                  }
          |       RANDOM
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric_float("RANDOM");
                    parser_intrinsic_call_0( $$, intrinsic_cname(RANDOM) );
                  }
          |       RANDOM_SEED expr[r1] ')'
                  { // left parenthesis consumed by lexer
                    location_set(@1);
!                   $$ = new_tempnumeric_float("RANDOM-SEED");
                    if( ! intrinsic_call_1($$, RANDOM, $r1, @r1)) YYERROR;
                  }
  
          |       STANDARD_COMPARE  '(' varg[r1] varg[r2] varg[r3] varg[r4] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("STANDARD-COMPARE");
  		  cbl_unimplemented("STANDARD-COMPARE");
                    /* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) ) YYERROR; */
                  }
          |       STANDARD_COMPARE  '(' varg[r1] varg[r2] varg[r3]  ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("STANDARD-COMPARE");
  		  cbl_unimplemented("STANDARD-COMPARE");
                    /* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) ) YYERROR; */
                  }
          |       STANDARD_COMPARE  '(' varg[r1] varg[r2] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("STANDARD-COMPARE");
  		  cbl_unimplemented("STANDARD-COMPARE");
                    /* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) ) YYERROR; */
                  }
  
          |       SUBSTITUTE '(' varg[r1] subst_inputs[inputs] ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric("SUBSTITUTE");
                    std::vector <cbl_substitute_t> args($inputs->size());
                    std::transform( $inputs->begin(), $inputs->end(), args.begin(),
                                    []( const substitution_t& arg ) {
*************** intrinsic:      function_udf
*** 10442,10448 ****
  
          |       TEST_NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale,
                                                   *$r2.arg2, $anycase, true );
                  }
--- 10501,10507 ----
  
          |       TEST_NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' {
                    location_set(@1);
!                   $$ = new_tempnumeric("parser_intrinsic_subst($$,");
                    parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale,
                                                   *$r2.arg2, $anycase, true );
                  }
*************** intrinsic:      function_udf
*** 10469,10482 ****
                       YYERROR;
                       break;
                    }
!                   $$ = new_alphanumeric();
                    cbl_refer_t * how = new_reference($trim_trailing);
                    if( ! intrinsic_call_2($$, TRIM, $r1, how) ) YYERROR;
                  }
  
          |       USUBSTR '(' alpha_val[r1] expr[r2] expr[r3]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    if( ! intrinsic_call_3($$, FORMATTED_DATETIME,
                                               $r1, $r2, $r3) ) YYERROR;
                  }
--- 10528,10541 ----
                       YYERROR;
                       break;
                    }
! 		   $$ = new_alphanumeric("TRIM");
                    cbl_refer_t * how = new_reference($trim_trailing);
                    if( ! intrinsic_call_2($$, TRIM, $r1, how) ) YYERROR;
                  }
  
          |       USUBSTR '(' alpha_val[r1] expr[r2] expr[r3]  ')' {
                    location_set(@1);
!                   $$ = new_alphanumeric("USUBSTR");
                    if( ! intrinsic_call_3($$, FORMATTED_DATETIME,
                                               $r1, $r2, $r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10484,10497 ****
          |       intrinsic_I  '(' expr[r1] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_1($$, $1, $r1, @r1)) YYERROR;
                  }
  
          |       intrinsic_N  '(' expr[r1] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric_float();
                    if( ! intrinsic_call_1($$, $1, $r1, @r1)) YYERROR;
                  }
  
--- 10543,10556 ----
          |       intrinsic_I  '(' expr[r1] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric(keyword_str($1));
                    if( ! intrinsic_call_1($$, $1, $r1, @r1)) YYERROR;
                  }
  
          |       intrinsic_N  '(' expr[r1] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric_float(keyword_str($1));
                    if( ! intrinsic_call_1($$, $1, $r1, @r1)) YYERROR;
                  }
  
*************** intrinsic:      function_udf
*** 10501,10517 ****
                    auto type = intrinsic_return_type($1);
                    switch(type) {
                    case FldAlphanumeric:
!                     $$ = new_alphanumeric();
                      break;
                    default:
!                     if( $1 == NUMVAL || $1 == NUMVAL_F )
!                       {
!                       $$ = new_temporary(FldFloat);
!                       }
!                     else
!                       {
!                       $$ = new_temporary(type);
!                       }
                    }
                    if( $1 == NUMVAL_F ) {
  		    if( is_literal($r1->field) && ! is_numeric($r1->field->type) ) {
--- 10560,10573 ----
                    auto type = intrinsic_return_type($1);
                    switch(type) {
                    case FldAlphanumeric:
!                     $$ = new_alphanumeric(keyword_str($1));
                      break;
                    default:
!                     if( $1 == NUMVAL || $1 == NUMVAL_F ) {
! 			$$ = new_temporary(FldFloat, keyword_str($1));
! 		    } else {
!                       $$ = new_temporary(type, keyword_str($1));
! 		    }
                    }
                    if( $1 == NUMVAL_F ) {
  		    if( is_literal($r1->field) && ! is_numeric($r1->field->type) ) {
*************** intrinsic:      function_udf
*** 10526,10532 ****
          |       intrinsic_I2 '(' expr[r1] expr[r2] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
                  }
  
--- 10582,10588 ----
          |       intrinsic_I2 '(' expr[r1] expr[r2] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("intrinsic_I2");
                    if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
                  }
  
*************** intrinsic:      function_udf
*** 10542,10548 ****
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
                                           $r1, r2, r3) ) YYERROR;
                  }
--- 10598,10604 ----
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric("DATE_TO_YYYYMMDD");
                    if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
                                           $r1, r2, r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10558,10564 ****
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
                                           $r1, $r2, r3) ) YYERROR;
                  }
--- 10614,10620 ----
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric("DATE_TO_YYYYMMDD");
                    if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
                                           $r1, $r2, r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10567,10573 ****
                                       expr[r2] expr[r3] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
                                           $r1, $r2, $r3) ) YYERROR;
                  }
--- 10623,10629 ----
                                       expr[r2] expr[r3] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("DATE_TO_YYYYMMDD");
                    if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
                                           $r1, $r2, $r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10584,10590 ****
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
                                           $r1, r2, r3) ) YYERROR;
                  }
--- 10640,10646 ----
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric("DAY_TO_YYYYDDD");
                    if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
                                           $r1, r2, r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10600,10606 ****
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
                                           $r1, $r2, r3) ) YYERROR;
                  }
--- 10656,10662 ----
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric("DAY_TO_YYYYDDD");
                    if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
                                           $r1, $r2, r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10609,10615 ****
                                       expr[r2] expr[r3] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
                                           $r1, $r2, $r3) ) YYERROR;
                  }
--- 10665,10671 ----
                                       expr[r2] expr[r3] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("DAY_TO_YYYYDDD");
                    if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
                                           $r1, $r2, $r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10626,10632 ****
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
                                           $r1, r2, r3) ) YYERROR;
                  }
--- 10682,10688 ----
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric("YEAR_TO_YYYY");
                    if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
                                           $r1, r2, r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10642,10648 ****
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
                                           $r1, $r2, r3) ) YYERROR;
                  }
--- 10698,10704 ----
  
                    parser_intrinsic_call_0( r3->field, "__gg__current_date" );
  
!                   $$ = new_tempnumeric("YEAR_TO_YYYY");
                    if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
                                           $r1, $r2, r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10651,10657 ****
                                       expr[r2] expr[r3] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                    if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
                                           $r1, $r2, $r3) ) YYERROR;
                  }
--- 10707,10713 ----
                                       expr[r2] expr[r3] ')'
                  {
                    location_set(@1);
!                   $$ = new_tempnumeric("YEAR_TO_YYYY");
                    if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
                                           $r1, $r2, $r3) ) YYERROR;
                  }
*************** intrinsic:      function_udf
*** 10659,10683 ****
          |       intrinsic_N2 '(' expr[r1] expr[r2] ')'
                  {
                    location_set(@1);
!                   switch($1)
!                     {
!                     case ANNUITY:
!                       $$ = new_tempnumeric_float();
!                       break;
!                     case COMBINED_DATETIME:
!                       $$ = new_tempnumeric();
!                       break;
!                     case REM:
!                       $$ = new_tempnumeric_float();
!                       break;
!                     }
                    if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
                  }
  
          |       intrinsic_X2 '(' varg[r1] varg[r2] ')'
                  {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
                  }
          |       intrinsic_locale
--- 10715,10739 ----
          |       intrinsic_N2 '(' expr[r1] expr[r2] ')'
                  {
                    location_set(@1);
!                   switch($1) {
! 		  case ANNUITY:
! 		    $$ = new_tempnumeric_float();
! 		    break;
! 		  case COMBINED_DATETIME:
! 		    $$ = new_tempnumeric();
! 		    break;
! 		  case REM:
! 		    $$ = new_tempnumeric_float();
! 		    break;
! 		  }
! 		  $$->data.initial = keyword_str($1); // function name
                    if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
                  }
  
          |       intrinsic_X2 '(' varg[r1] varg[r2] ')'
                  {
                    location_set(@1);
!                   $$ = new_alphanumeric(keyword_str($1));
                    if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
                  }
          |       intrinsic_locale
*************** trim_trailing:  %empty          { $$ = n
*** 10788,10852 ****
  
  intrinsic0:     CURRENT_DATE {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE);
                    parser_intrinsic_call_0( $$, "__gg__current_date" );
                  }
          |       E {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                   parser_intrinsic_call_0( $$, "__gg__e" );
                  }
  
          |       EXCEPTION_FILE_N {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    intrinsic_call_0( $$, EXCEPTION_FILE_N );
                  }
  
          |       EXCEPTION_FILE {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    parser_exception_file( $$ );
                  }
          |       EXCEPTION_LOCATION_N {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    intrinsic_call_0( $$, EXCEPTION_LOCATION_N );
                  }
          |       EXCEPTION_LOCATION {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    intrinsic_call_0( $$, EXCEPTION_LOCATION );
                  }
          |       EXCEPTION_STATEMENT {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    intrinsic_call_0( $$, EXCEPTION_STATEMENT );
                  }
          |       EXCEPTION_STATUS {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                    intrinsic_call_0( $$, EXCEPTION_STATUS );
                  }
  
          |       PI {
                    location_set(@1);
!                   $$ = new_tempnumeric_float();
                   parser_intrinsic_call_0( $$, "__gg__pi" );
                  }
          |       SECONDS_PAST_MIDNIGHT {
                    location_set(@1);
!                   $$ = new_tempnumeric();
                   intrinsic_call_0( $$, SECONDS_PAST_MIDNIGHT );
                  }
          |       UUID4 {
                    location_set(@1);
!                   $$ = new_alphanumeric();
                   parser_intrinsic_call_0( $$, "__gg__uuid4" );
                  }
          |       WHEN_COMPILED {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE); // Returns YYYYMMDDhhmmssss-0500
                   parser_intrinsic_call_0( $$, "__gg__when_compiled" );
                  }
                  ;
--- 10844,10909 ----
  
  intrinsic0:     CURRENT_DATE {
                    location_set(@1);
!                   $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE, "CURRENT-DATE");
                    parser_intrinsic_call_0( $$, "__gg__current_date" );
                  }
          |       E {
                    location_set(@1);
!                   $$ = new_tempnumeric("E");
                   parser_intrinsic_call_0( $$, "__gg__e" );
                  }
  
          |       EXCEPTION_FILE_N {
                    location_set(@1);
!                   $$ = new_alphanumeric("EXCEPTION-FILE-N");
                    intrinsic_call_0( $$, EXCEPTION_FILE_N );
                  }
  
          |       EXCEPTION_FILE {
                    location_set(@1);
!                   $$ = new_alphanumeric("EXCEPTION-FILE");
                    parser_exception_file( $$ );
                  }
          |       EXCEPTION_LOCATION_N {
                    location_set(@1);
!                   $$ = new_alphanumeric("EXCEPTION-LOCATION-N");
                    intrinsic_call_0( $$, EXCEPTION_LOCATION_N );
                  }
          |       EXCEPTION_LOCATION {
                    location_set(@1);
!                   $$ = new_alphanumeric("EXCEPTION-LOCATION");
                    intrinsic_call_0( $$, EXCEPTION_LOCATION );
                  }
          |       EXCEPTION_STATEMENT {
                    location_set(@1);
!                   $$ = new_alphanumeric("EXCEPTION-STATEMENT");
                    intrinsic_call_0( $$, EXCEPTION_STATEMENT );
                  }
          |       EXCEPTION_STATUS {
                    location_set(@1);
!                   $$ = new_alphanumeric("EXCEPTION-STATUS");
                    intrinsic_call_0( $$, EXCEPTION_STATUS );
                  }
  
          |       PI {
                    location_set(@1);
!                   $$ = new_tempnumeric_float("PI");
                   parser_intrinsic_call_0( $$, "__gg__pi" );
                  }
          |       SECONDS_PAST_MIDNIGHT {
                    location_set(@1);
!                   $$ = new_tempnumeric("SECONDS-PAST-MIDNIGHT");
                   intrinsic_call_0( $$, SECONDS_PAST_MIDNIGHT );
                  }
          |       UUID4 {
                    location_set(@1);
!                   $$ = new_alphanumeric("UUID4");
                   parser_intrinsic_call_0( $$, "__gg__uuid4" );
                  }
          |       WHEN_COMPILED {
                    location_set(@1);
! 		  // Returns YYYYMMDDhhmmssss-0500)
!                   $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE, "WHEN-COMPILED"); 
                   parser_intrinsic_call_0( $$, "__gg__when_compiled" );
                  }
                  ;
*************** cbl_figconst_of( const char *value ) {
*** 12879,12884 ****
--- 12936,12969 ----
    return p == eovalues? normal_value_e : p->type;
  }
  
+ int
+ cbl_figconst_tok( const char *value ) {
+   struct values_t {
+     const char *value; int token;
+   } static const values[] = {
+     { constant_of(constant_index(ZERO))->data.initial, ZERO },
+     { constant_of(constant_index(SPACES))->data.initial, SPACES },
+     { constant_of(constant_index(HIGH_VALUES))->data.initial, HIGH_VALUES },
+     { constant_of(constant_index(LOW_VALUES))->data.initial, LOW_VALUES },
+     { constant_of(constant_index(QUOTES))->data.initial, QUOTES },
+     { constant_of(constant_index(NULLS))->data.initial, NULLS },
+   }, *eovalues = values + COUNT_OF(values);
+ 
+   auto p = std::find_if( values, eovalues,
+                          [value]( const values_t& elem ) {
+                            return elem.value == value;
+                          } );
+ 
+   return p == eovalues? 0 : p->token;
+ }
+ 
+ const cbl_field_t *
+ cbl_figconst_field_of( const char *value ) {
+   int token = cbl_figconst_tok(value);
+   return token == 0 ? nullptr : constant_of(constant_index(token));
+ }
+ 
+ 
  cbl_field_attr_t
  literal_attr( const char prefix[] ) {
    switch(strlen(prefix)) {
diff -Nrcpad gcc-16-20250518/gcc/cobol/parse_ante.h gcc-16-20250525/gcc/cobol/parse_ante.h
*** gcc-16-20250518/gcc/cobol/parse_ante.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/parse_ante.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
   * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   */
  
! #include <assert.h>
! #include <string.h>
! #include <stdio.h>
  
  #include <algorithm>
  #include <list>
--- 28,36 ----
   * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   */
  
! #include <cassert>
! #include <cstring>
! #include <cstdio>
  
  #include <algorithm>
  #include <list>
*************** void input_file_status_notify();
*** 109,115 ****
  int yylex(void);
  extern int yydebug;
  
! #include <stdarg.h>
  
  const char *
  consistent_encoding_check( const YYLTYPE& loc, const char input[] ) {
--- 109,115 ----
  int yylex(void);
  extern int yydebug;
  
! #include <cstdarg>
  
  const char *
  consistent_encoding_check( const YYLTYPE& loc, const char input[] ) {
*************** namcpy(const YYLTYPE& loc, cbl_name_t tg
*** 223,229 ****
  }
  
  cbl_field_t *
! new_alphanumeric( size_t capacity = MAXIMUM_ALPHA_LENGTH );
  
  static inline cbl_refer_t *
  new_reference( enum cbl_field_type_t type, const char *initial ) {
--- 223,235 ----
  }
  
  cbl_field_t *
! new_alphanumeric( size_t capacity = MAXIMUM_ALPHA_LENGTH,
! 		  const cbl_name_t name = nullptr );
! 
! static inline cbl_field_t *
! new_alphanumeric( const cbl_name_t name ) {
!   return new_alphanumeric(MAXIMUM_ALPHA_LENGTH, name);
! }
  
  static inline cbl_refer_t *
  new_reference( enum cbl_field_type_t type, const char *initial ) {
*************** char *
*** 2439,2448 ****
  normalize_picture( char picture[] );
  
  static inline cbl_field_t *
! new_tempnumeric(void) { return new_temporary(FldNumericBin5); }
  
  static inline cbl_field_t *
! new_tempnumeric_float(void) { return new_temporary(FldFloat); }
  
  uint32_t
  type_capacity( enum cbl_field_type_t type, uint32_t digits );
--- 2445,2458 ----
  normalize_picture( char picture[] );
  
  static inline cbl_field_t *
! new_tempnumeric(const cbl_name_t name = nullptr) {
!   return new_temporary(FldNumericBin5, name);
! }
  
  static inline cbl_field_t *
! new_tempnumeric_float(const cbl_name_t name = nullptr) {
!   return new_temporary(FldFloat, name);
! }
  
  uint32_t
  type_capacity( enum cbl_field_type_t type, uint32_t digits );
*************** current_field(cbl_field_t * field = NULL
*** 3138,3143 ****
--- 3148,3164 ----
    return local;
  }
  
+ static void
+ set_real_from_capacity( const YYLTYPE& loc,
+ 			cbl_field_t *field,
+ 			REAL_VALUE_TYPE *r ) {
+   if( field == current_field() ) {
+     error_msg(loc, "cannot define %s via self-reference", field->name);
+     return;
+   }
+   field->data.set_real_from_capacity(r);
+ }
+ 
  static struct cbl_special_name_t *
  special_of( const char F[], int L, const char name[] ) {
    struct symbol_elem_t *e = symbol_special(PROGRAM, name);
diff -Nrcpad gcc-16-20250518/gcc/cobol/scan.l gcc-16-20250525/gcc/cobol/scan.l
*** gcc-16-20250518/gcc/cobol/scan.l	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/scan.l	Sun May 25 22:32:05 2025
*************** PROCEDURE{SPC}DIVISION	{ yy_push_state(p
*** 275,281 ****
    IS		{ pop_return IS; }
  
    OPTIONS		{ yy_pop_state(); myless(0); }
!   [[:blank:]]*(ENVIRONMENT|DATA|PROCEDURE)[[:blank:]]+DIVISION/.+\n {
                                    yy_pop_state(); myless(0); }
    [[:blank:]]*AUTHOR[[:blank:].]+{EOL}? {
  				  // Might not have an EOL, but stop on one.
--- 275,281 ----
    IS		{ pop_return IS; }
  
    OPTIONS		{ yy_pop_state(); myless(0); }
!   [[:blank:]]*(ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION/[[:space:].] {
                                    yy_pop_state(); myless(0); }
    [[:blank:]]*AUTHOR[[:blank:].]+{EOL}? {
  				  // Might not have an EOL, but stop on one.
diff -Nrcpad gcc-16-20250518/gcc/cobol/scan_ante.h gcc-16-20250525/gcc/cobol/scan_ante.h
*** gcc-16-20250518/gcc/cobol/scan_ante.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/scan_ante.h	Sun May 25 22:32:05 2025
*************** typed_name( const char name[] ) {
*** 737,742 ****
--- 737,746 ----
      {
        auto f = cbl_field_of(e);
        if( is_constant(f) ) {
+ 	if(  f->data.initial ) {
+ 	  int token = cbl_figconst_tok(f->data.initial);
+ 	  if( token ) return token;
+ 	}
          int token = datetime_format_of(f->data.initial);
          if( token ) {
            yylval.string = xstrdup(f->data.initial);
diff -Nrcpad gcc-16-20250518/gcc/cobol/symbols.cc gcc-16-20250525/gcc/cobol/symbols.cc
*** gcc-16-20250518/gcc/cobol/symbols.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/symbols.cc	Sun May 25 22:32:05 2025
*************** cbl_ffi_arg_t( cbl_ffi_crv_t crv,
*** 257,299 ****
   } while(0)
  
  
- cbl_field_t *
- symbol_valid_udf_args( size_t function, std::list<cbl_refer_t> args ) {
-   auto L = cbl_label_of(symbol_at(function));
-   if( ! L->returning ) {
-     dbgmsg("logic error: %s does not define RETURNING", L->name);
-     return NULL;
-   }
-   auto e = std::find_if( symbol_at(function), symbols_end(),
-                          []( auto symbol ) {
-                            if( symbol.type == SymDataSection ) {
-                              auto section(symbol.elem.section);
-                              return section.type == linkage_sect_e;
-                            }
-                            return false;
-                          } );
-   for( auto arg : args ) {
-     size_t iarg(1);
-     e++; // skip over linkage_sect_e, which appears after the function
-     if( e->type != SymField ) {
-       ERROR_FIELD(arg.field,
-                   "FUNCTION %s has no defined parameter matching arg %zu, '%s'",
-                   L->name, iarg, arg.field->name );
-       return NULL;
-     }
- 
-     auto tgt = cbl_field_of(e);
- 
-     if( ! valid_move(tgt, arg.field) ) {
-       ERROR_FIELD(tgt, "FUNCTION %s arg %zu, '%s' cannot be passed to %s, type %s",
-                 L->name, iarg, arg.field->pretty_name(),
-                 tgt->pretty_name(), 3 + cbl_field_type_str(tgt->type) );
-       return NULL;
-     }
-   }
-   return cbl_field_of(symbol_at(L->returning));
- }
- 
  static const struct cbl_occurs_t nonarray = cbl_occurs_t();
  
  #if 0
--- 257,262 ----
*************** symbols_update( size_t first, bool parse
*** 1847,1852 ****
--- 1810,1824 ----
      if( field->level == 0 && field->is_key_name() ) continue;
      if( is_literal(field) && field->var_decl_node != NULL ) continue;
  
+     // If the field is a constant for a figconstant, just use it. 
+     if( field->level != 0 && field->has_attr(constant_e) ) {
+       auto fig = cbl_figconst_field_of(field->data.initial);
+       if( fig ) {
+ 	field->var_decl_node = fig->var_decl_node;
+ 	continue;
+       }
+     }
+     
      if( field->is_typedef() ) {
        auto isym = end_of_group( symbol_index(p) );
        p = symbol_at(--isym);
*************** using std::deque;
*** 3161,3167 ****
  static deque<cbl_field_t*> stack;
  
  static cbl_field_t *
! new_temporary_impl( enum cbl_field_type_t type )
  {
    extern int yylineno;
    static int nstack, nliteral;
--- 3133,3139 ----
  static deque<cbl_field_t*> stack;
  
  static cbl_field_t *
! new_temporary_impl( enum cbl_field_type_t type, const cbl_name_t name = nullptr )
  {
    extern int yylineno;
    static int nstack, nliteral;
*************** new_temporary_impl( enum cbl_field_type_
*** 3238,3243 ****
--- 3210,3217 ----
      snprintf(f->name, sizeof(f->name), "_stack%d",++nstack);
    }
  
+   f->data.initial = name; // capture e.g. the function name 
+ 
    return f;
  }
  
*************** temporaries_t::reuse( cbl_field_type_t t
*** 3360,3370 ****
  }
  
  cbl_field_t *
! temporaries_t::acquire( cbl_field_type_t type ) {
    cbl_field_t *field = reuse(type);
  
    if( !field ) {
!     field = new_temporary_impl(type);
      add(field);
    }
    return parser_symbol_add2(field); // notify of reuse
--- 3334,3344 ----
  }
  
  cbl_field_t *
! temporaries_t::acquire( cbl_field_type_t type, const cbl_name_t name ) {
    cbl_field_t *field = reuse(type);
  
    if( !field ) {
!     field = new_temporary_impl(type, name);
      add(field);
    }
    return parser_symbol_add2(field); // notify of reuse
*************** symbol_temporaries_free() {
*** 3397,3404 ****
  }
  
  cbl_field_t *
! new_alphanumeric( size_t capacity ) {
!   cbl_field_t * field = new_temporary_impl(FldAlphanumeric);
    field->data.capacity = capacity;
    temporaries.add(field);
    return parser_symbol_add2(field);
--- 3371,3378 ----
  }
  
  cbl_field_t *
! new_alphanumeric( size_t capacity, const cbl_name_t name = nullptr ) {
!   cbl_field_t * field = new_temporary_impl(FldAlphanumeric, name);
    field->data.capacity = capacity;
    temporaries.add(field);
    return parser_symbol_add2(field);
*************** cbl_field_t *
*** 3408,3422 ****
  new_temporary( enum cbl_field_type_t type, const char *initial ) {
    if( ! initial ) {
      assert( ! is_literal(type) ); // Literal type must have literal value.
!     return temporaries.acquire(type);
    }
    if( is_literal(type) ) {
      auto field = temporaries.literal(initial,
                                       type == FldLiteralA? quoted_e : none_e);
      return field;
    }
!   cbl_field_t *field = new_temporary_impl(type);
!   field->data.capacity = strlen(field->data.initial = initial);
    temporaries.add(field);
    parser_symbol_add(field);
  
--- 3382,3395 ----
  new_temporary( enum cbl_field_type_t type, const char *initial ) {
    if( ! initial ) {
      assert( ! is_literal(type) ); // Literal type must have literal value.
!     return temporaries.acquire(type, initial);
    }
    if( is_literal(type) ) {
      auto field = temporaries.literal(initial,
                                       type == FldLiteralA? quoted_e : none_e);
      return field;
    }
!   cbl_field_t *field = new_temporary_impl(type, initial);
    temporaries.add(field);
    parser_symbol_add(field);
  
diff -Nrcpad gcc-16-20250518/gcc/cobol/symbols.h gcc-16-20250525/gcc/cobol/symbols.h
*** gcc-16-20250518/gcc/cobol/symbols.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/symbols.h	Sun May 25 22:32:05 2025
***************
*** 32,42 ****
  #else
  #define _SYMBOLS_H_
  
! #include <assert.h>
! #include <limits.h>
! #include <stdint.h>
! #include <stdlib.h>
! #include <string.h>
  
  #include <algorithm>
  #include <list>
--- 32,42 ----
  #else
  #define _SYMBOLS_H_
  
! #include <cassert>
! #include <climits>
! #include <cstdint>
! #include <cstdlib>
! #include <cstring>
  
  #include <algorithm>
  #include <list>
*************** is_working_storage(uint32_t attr) {
*** 149,154 ****
--- 149,155 ----
    return 0 == (attr & (linkage_e | local_e));
  }
  
+ int cbl_figconst_tok( const char *value );
  enum cbl_figconst_t cbl_figconst_of( const char *value );
  const char * cbl_figconst_str( cbl_figconst_t fig );
  
*************** struct cbl_field_t {
*** 631,636 ****
--- 632,639 ----
    }
  };
  
+ const cbl_field_t * cbl_figconst_field_of( const char *value );
+ 
  // Necessary forward referencea
  struct cbl_label_t;
  struct cbl_refer_t;
*************** class temporaries_t {
*** 1191,1197 ****
  public:
    cbl_field_t * literal( const char value[], uint32_t len, cbl_field_attr_t attr  = none_e );
    cbl_field_t * reuse( cbl_field_type_t type );
!   cbl_field_t * acquire( cbl_field_type_t type );
    cbl_field_t *  add( cbl_field_t *field );
    bool keep( cbl_field_t *field ) { return 1 == used[field->type].erase(field); }
    void dump() const;
--- 1194,1200 ----
  public:
    cbl_field_t * literal( const char value[], uint32_t len, cbl_field_attr_t attr  = none_e );
    cbl_field_t * reuse( cbl_field_type_t type );
!   cbl_field_t * acquire( cbl_field_type_t type, const cbl_name_t name = nullptr );
    cbl_field_t *  add( cbl_field_t *field );
    bool keep( cbl_field_t *field ) { return 1 == used[field->type].erase(field); }
    void dump() const;
*************** symbol_field_same_as( cbl_field_t *tgt,
*** 2353,2362 ****
  
  size_t symbol_file_same_record_area( std::list<cbl_file_t*>& files );
  
- cbl_field_t *
- symbol_valid_udf_args( size_t function,
-                        std::list<cbl_refer_t> args = std::list<cbl_refer_t>() );
- 
  bool symbol_currency_add( const char symbol[], const char sign[] = NULL );
  const char * symbol_currency( char symbol );
  
--- 2356,2361 ----
diff -Nrcpad gcc-16-20250518/gcc/cobol/symfind.cc gcc-16-20250525/gcc/cobol/symfind.cc
*** gcc-16-20250518/gcc/cobol/symfind.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cobol/symfind.cc	Sun May 25 22:32:05 2025
*************** size_t end_of_group( size_t igroup );
*** 421,427 ****
  
  static std::vector<size_t>
  symbol_match2( size_t program,
!                std::list<const char *> names, bool local = true )
  {
    std::vector<size_t> fields;
  
--- 421,427 ----
  
  static std::vector<size_t>
  symbol_match2( size_t program,
!                const std::list<const char *>& names, bool local = true )
  {
    std::vector<size_t> fields;
  
*************** symbol_match2( size_t program,
*** 488,494 ****
   * N-1.
   */
  static symbol_map_t
! symbol_match( size_t program, std::list<const char *> names ) {
    auto matched = symbol_match2( program, names );
    symbol_map_t output;
  
--- 488,494 ----
   * N-1.
   */
  static symbol_map_t
! symbol_match( size_t program, const std::list<const char *>& names ) {
    auto matched = symbol_match2( program, names );
    symbol_map_t output;
  
diff -Nrcpad gcc-16-20250518/gcc/combine.cc gcc-16-20250525/gcc/combine.cc
*** gcc-16-20250518/gcc/combine.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/combine.cc	Sun May 25 22:32:05 2025
*************** static rtx simplify_shift_const (rtx, en
*** 458,463 ****
--- 458,464 ----
  				 int);
  static int recog_for_combine (rtx *, rtx_insn *, rtx *, unsigned = 0, unsigned = 0);
  static rtx gen_lowpart_for_combine (machine_mode, rtx);
+ static rtx gen_lowpart_for_combine_no_emit (machine_mode, rtx);
  static enum rtx_code simplify_compare_const (enum rtx_code, machine_mode,
  					     rtx *, rtx *);
  static enum rtx_code simplify_comparison (enum rtx_code, rtx *, rtx *);
*************** static rtx gen_lowpart_or_truncate (mach
*** 491,497 ****
  
  /* Our implementation of gen_lowpart never emits a new pseudo.  */
  #undef RTL_HOOKS_GEN_LOWPART_NO_EMIT
! #define RTL_HOOKS_GEN_LOWPART_NO_EMIT      gen_lowpart_for_combine
  
  #undef RTL_HOOKS_REG_NONZERO_REG_BITS
  #define RTL_HOOKS_REG_NONZERO_REG_BITS     reg_nonzero_bits_for_combine
--- 492,498 ----
  
  /* Our implementation of gen_lowpart never emits a new pseudo.  */
  #undef RTL_HOOKS_GEN_LOWPART_NO_EMIT
! #define RTL_HOOKS_GEN_LOWPART_NO_EMIT      gen_lowpart_for_combine_no_emit
  
  #undef RTL_HOOKS_REG_NONZERO_REG_BITS
  #define RTL_HOOKS_REG_NONZERO_REG_BITS     reg_nonzero_bits_for_combine
*************** gen_lowpart_for_combine (machine_mode om
*** 11890,11895 ****
--- 11891,11912 ----
   fail:
    return gen_rtx_CLOBBER (omode, const0_rtx);
  }
+ 
+ /* Like gen_lowpart_for_combine but returns NULL_RTX
+    for an error instead of CLOBBER.
+    Note no_emit is not called directly from combine but rather from
+    simplify_rtx and is expecting a NULL on failure rather than
+    a CLOBBER.  */
+ 
+ static rtx
+ gen_lowpart_for_combine_no_emit (machine_mode omode, rtx x)
+ {
+   rtx tem = gen_lowpart_for_combine (omode, x);
+   if (!tem || GET_CODE (tem) == CLOBBER)
+     return NULL_RTX;
+   return tem;
+ }
+ 
  
  /* Try to simplify a comparison between OP0 and a constant OP1,
     where CODE is the comparison code that will be tested, into a
diff -Nrcpad gcc-16-20250518/gcc/common/config/i386/cpuinfo.h gcc-16-20250525/gcc/common/config/i386/cpuinfo.h
*** gcc-16-20250518/gcc/common/config/i386/cpuinfo.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/common/config/i386/cpuinfo.h	Sun May 25 22:32:05 2025
*************** get_available_features (struct __process
*** 1044,1054 ****
  	  /* Fall through.  */
  	case 1:
  	  set_feature (FEATURE_AVX10_1);
- 	  set_feature (FEATURE_AVX10_1_256);
  	  break;
  	default:
  	  set_feature (FEATURE_AVX10_1);
- 	  set_feature (FEATURE_AVX10_1_256);
  	  break;
  	}
      }
--- 1044,1052 ----
diff -Nrcpad gcc-16-20250518/gcc/common/config/i386/i386-common.cc gcc-16-20250525/gcc/common/config/i386/i386-common.cc
*** gcc-16-20250518/gcc/common/config/i386/i386-common.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/common/config/i386/i386-common.cc	Sun May 25 22:32:05 2025
*************** along with GCC; see the file COPYING3.
*** 117,127 ****
  #define OPTION_MASK_ISA2_SHA512_SET OPTION_MASK_ISA2_SHA512
  #define OPTION_MASK_ISA2_SM4_SET OPTION_MASK_ISA2_SM4
  #define OPTION_MASK_ISA2_APX_F_SET OPTION_MASK_ISA2_APX_F
- #define OPTION_MASK_ISA2_EVEX512_SET OPTION_MASK_ISA2_EVEX512
  #define OPTION_MASK_ISA2_USER_MSR_SET OPTION_MASK_ISA2_USER_MSR
! #define OPTION_MASK_ISA2_AVX10_1_256_SET OPTION_MASK_ISA2_AVX10_1_256
  #define OPTION_MASK_ISA2_AVX10_1_SET \
!   (OPTION_MASK_ISA2_AVX10_1_256_SET | OPTION_MASK_ISA2_AVX10_1)
  #define OPTION_MASK_ISA2_AVX10_2_SET \
    (OPTION_MASK_ISA2_AVX10_1_SET | OPTION_MASK_ISA2_AVX10_2)
  #define OPTION_MASK_ISA2_AMX_AVX512_SET \
--- 117,133 ----
  #define OPTION_MASK_ISA2_SHA512_SET OPTION_MASK_ISA2_SHA512
  #define OPTION_MASK_ISA2_SM4_SET OPTION_MASK_ISA2_SM4
  #define OPTION_MASK_ISA2_APX_F_SET OPTION_MASK_ISA2_APX_F
  #define OPTION_MASK_ISA2_USER_MSR_SET OPTION_MASK_ISA2_USER_MSR
! #define OPTION_MASK_ISA_AVX10_1_SET \
!   (OPTION_MASK_ISA_AVX512F_SET | OPTION_MASK_ISA_AVX512CD_SET \
!    | OPTION_MASK_ISA_AVX512DQ_SET | OPTION_MASK_ISA_AVX512BW_SET \
!    | OPTION_MASK_ISA_AVX512VL_SET | OPTION_MASK_ISA_AVX512IFMA_SET \
!    | OPTION_MASK_ISA_AVX512VBMI_SET | OPTION_MASK_ISA_AVX512VBMI2_SET \
!    | OPTION_MASK_ISA_AVX512VNNI_SET | OPTION_MASK_ISA_AVX512VPOPCNTDQ_SET \
!    | OPTION_MASK_ISA_AVX512BITALG_SET)
  #define OPTION_MASK_ISA2_AVX10_1_SET \
!   (OPTION_MASK_ISA2_AVX512FP16_SET | OPTION_MASK_ISA2_AVX512BF16_SET \
!    | OPTION_MASK_ISA2_AVX10_1)
  #define OPTION_MASK_ISA2_AVX10_2_SET \
    (OPTION_MASK_ISA2_AVX10_1_SET | OPTION_MASK_ISA2_AVX10_2)
  #define OPTION_MASK_ISA2_AMX_AVX512_SET \
*************** along with GCC; see the file COPYING3.
*** 245,252 ****
  #define OPTION_MASK_ISA2_AVX2_UNSET \
    (OPTION_MASK_ISA2_AVXIFMA_UNSET | OPTION_MASK_ISA2_AVXVNNI_UNSET \
     | OPTION_MASK_ISA2_AVXVNNIINT8_UNSET | OPTION_MASK_ISA2_AVXNECONVERT_UNSET \
!    | OPTION_MASK_ISA2_AVXVNNIINT16_UNSET | OPTION_MASK_ISA2_AVX512F_UNSET \
!    | OPTION_MASK_ISA2_AVX10_1_UNSET)
  #define OPTION_MASK_ISA_AVX512F_UNSET \
    (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_AVX512CD_UNSET \
     | OPTION_MASK_ISA_AVX512DQ_UNSET | OPTION_MASK_ISA_AVX512BW_UNSET \
--- 251,257 ----
  #define OPTION_MASK_ISA2_AVX2_UNSET \
    (OPTION_MASK_ISA2_AVXIFMA_UNSET | OPTION_MASK_ISA2_AVXVNNI_UNSET \
     | OPTION_MASK_ISA2_AVXVNNIINT8_UNSET | OPTION_MASK_ISA2_AVXNECONVERT_UNSET \
!    | OPTION_MASK_ISA2_AVXVNNIINT16_UNSET | OPTION_MASK_ISA2_AVX512F_UNSET)
  #define OPTION_MASK_ISA_AVX512F_UNSET \
    (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_AVX512CD_UNSET \
     | OPTION_MASK_ISA_AVX512DQ_UNSET | OPTION_MASK_ISA_AVX512BW_UNSET \
*************** along with GCC; see the file COPYING3.
*** 320,330 ****
  #define OPTION_MASK_ISA2_SHA512_UNSET OPTION_MASK_ISA2_SHA512
  #define OPTION_MASK_ISA2_SM4_UNSET OPTION_MASK_ISA2_SM4
  #define OPTION_MASK_ISA2_APX_F_UNSET OPTION_MASK_ISA2_APX_F
- #define OPTION_MASK_ISA2_EVEX512_UNSET OPTION_MASK_ISA2_EVEX512
  #define OPTION_MASK_ISA2_USER_MSR_UNSET OPTION_MASK_ISA2_USER_MSR
  #define OPTION_MASK_ISA2_AVX10_1_UNSET \
!   (OPTION_MASK_ISA2_AVX10_1_256 | OPTION_MASK_ISA2_AVX10_1 \
!    | OPTION_MASK_ISA2_AVX10_2_UNSET)
  #define OPTION_MASK_ISA2_AVX10_2_UNSET \
    (OPTION_MASK_ISA2_AVX10_2 | OPTION_MASK_ISA2_AMX_AVX512_UNSET)
  #define OPTION_MASK_ISA2_AMX_AVX512_UNSET OPTION_MASK_ISA2_AMX_AVX512
--- 325,333 ----
  #define OPTION_MASK_ISA2_SHA512_UNSET OPTION_MASK_ISA2_SHA512
  #define OPTION_MASK_ISA2_SM4_UNSET OPTION_MASK_ISA2_SM4
  #define OPTION_MASK_ISA2_APX_F_UNSET OPTION_MASK_ISA2_APX_F
  #define OPTION_MASK_ISA2_USER_MSR_UNSET OPTION_MASK_ISA2_USER_MSR
  #define OPTION_MASK_ISA2_AVX10_1_UNSET \
!   (OPTION_MASK_ISA2_AVX10_1 | OPTION_MASK_ISA2_AVX10_2_UNSET)
  #define OPTION_MASK_ISA2_AVX10_2_UNSET \
    (OPTION_MASK_ISA2_AVX10_2 | OPTION_MASK_ISA2_AMX_AVX512_UNSET)
  #define OPTION_MASK_ISA2_AMX_AVX512_UNSET OPTION_MASK_ISA2_AMX_AVX512
*************** along with GCC; see the file COPYING3.
*** 375,381 ****
  
  #define OPTION_MASK_ISA2_AVX512F_UNSET \
    (OPTION_MASK_ISA2_AVX512BW_UNSET \
!    | OPTION_MASK_ISA2_AVX512VP2INTERSECT_UNSET)
  #define OPTION_MASK_ISA2_GENERAL_REGS_ONLY_UNSET \
    OPTION_MASK_ISA2_SSE_UNSET
  #define OPTION_MASK_ISA2_AVX_UNSET \
--- 378,385 ----
  
  #define OPTION_MASK_ISA2_AVX512F_UNSET \
    (OPTION_MASK_ISA2_AVX512BW_UNSET \
!    | OPTION_MASK_ISA2_AVX512VP2INTERSECT_UNSET \
!    | OPTION_MASK_ISA2_AVX10_1_UNSET)
  #define OPTION_MASK_ISA2_GENERAL_REGS_ONLY_UNSET \
    OPTION_MASK_ISA2_SSE_UNSET
  #define OPTION_MASK_ISA2_AVX_UNSET \
*************** ix86_handle_option (struct gcc_options *
*** 632,638 ****
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512F_UNSET;
  	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_AVX512F_UNSET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX512F_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 636,641 ----
*************** ix86_handle_option (struct gcc_options *
*** 646,652 ****
  	{
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512CD_UNSET;
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512CD_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 649,654 ----
*************** ix86_handle_option (struct gcc_options *
*** 865,871 ****
  	{
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512VBMI2_UNSET;
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512VBMI2_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 867,872 ----
*************** ix86_handle_option (struct gcc_options *
*** 881,887 ****
  	{
  	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_AVX512FP16_UNSET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX512FP16_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 882,887 ----
*************** ix86_handle_option (struct gcc_options *
*** 895,901 ****
  	{
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512VNNI_UNSET;
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512VNNI_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 895,900 ----
*************** ix86_handle_option (struct gcc_options *
*** 911,917 ****
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512VPOPCNTDQ_UNSET;
  	  opts->x_ix86_isa_flags_explicit
  	    |= OPTION_MASK_ISA_AVX512VPOPCNTDQ_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 910,915 ----
*************** ix86_handle_option (struct gcc_options *
*** 926,932 ****
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512BITALG_UNSET;
  	  opts->x_ix86_isa_flags_explicit
  		|= OPTION_MASK_ISA_AVX512BITALG_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 924,929 ----
*************** ix86_handle_option (struct gcc_options *
*** 942,948 ****
  	{
  	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_AVX512BF16_UNSET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX512BF16_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 939,944 ----
*************** ix86_handle_option (struct gcc_options *
*** 1010,1016 ****
  	{
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512DQ_UNSET;
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512DQ_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 1006,1011 ----
*************** ix86_handle_option (struct gcc_options *
*** 1026,1032 ****
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512BW_UNSET;
  	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_AVX512BW_UNSET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX512BW_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 1021,1026 ----
*************** ix86_handle_option (struct gcc_options *
*** 1040,1046 ****
  	{
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512VL_UNSET;
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512VL_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 1034,1039 ----
*************** ix86_handle_option (struct gcc_options *
*** 1054,1060 ****
  	{
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512IFMA_UNSET;
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512IFMA_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 1047,1052 ----
*************** ix86_handle_option (struct gcc_options *
*** 1068,1074 ****
  	{
  	  opts->x_ix86_isa_flags &= ~OPTION_MASK_ISA_AVX512VBMI_UNSET;
  	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX512VBMI_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
  	}
        return true;
  
--- 1060,1065 ----
*************** ix86_handle_option (struct gcc_options *
*** 1335,1354 ****
  	}
        return true;
  
-     case OPT_mevex512:
-       if (value)
- 	{
- 	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_EVEX512_SET;
- 	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_EVEX512_SET;
- 	}
-       else
- 	{
- 	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_EVEX512_UNSET;
- 	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_EVEX512_UNSET;
- 	  opts->x_ix86_no_avx512_explicit = 1;
- 	}
-       return true;
- 
      case OPT_musermsr:
        if (value)
  	{
--- 1326,1331 ----
*************** ix86_handle_option (struct gcc_options *
*** 1362,1396 ****
  	}
        return true;
  
-     case OPT_mavx10_1_256:
-       if (value)
- 	{
- 	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_AVX10_1_256_SET;
- 	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_1_256_SET;
- 	  opts->x_ix86_isa_flags |= OPTION_MASK_ISA_AVX2_SET;
- 	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX2_SET;
- 	}
-       else
- 	{
- 	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_AVX10_1_UNSET;
- 	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_1_UNSET;
- 	  opts->x_ix86_no_avx10_1_explicit = 1;
- 	}
-       return true;
- 
      case OPT_mavx10_1:
        if (value)
  	{
  	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_AVX10_1_SET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_1_SET;
! 	  opts->x_ix86_isa_flags |= OPTION_MASK_ISA_AVX2_SET;
! 	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX2_SET;
  	}
        else
  	{
  	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_AVX10_1_UNSET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_1_UNSET;
- 	  opts->x_ix86_no_avx10_1_explicit = 1;
  	}
        return true;
  
--- 1339,1356 ----
  	}
        return true;
  
      case OPT_mavx10_1:
        if (value)
  	{
  	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_AVX10_1_SET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_1_SET;
! 	  opts->x_ix86_isa_flags |= OPTION_MASK_ISA_AVX10_1_SET;
! 	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX10_1_SET;
  	}
        else
  	{
  	  opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_AVX10_1_UNSET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_1_UNSET;
  	}
        return true;
  
*************** ix86_handle_option (struct gcc_options *
*** 1399,1406 ****
  	{
  	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_AVX10_2_SET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_2_SET;
! 	  opts->x_ix86_isa_flags |= OPTION_MASK_ISA_AVX2_SET;
! 	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX2_SET;
  	}
        else
  	{
--- 1359,1366 ----
  	{
  	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_AVX10_2_SET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AVX10_2_SET;
! 	  opts->x_ix86_isa_flags |= OPTION_MASK_ISA_AVX10_1_SET;
! 	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX10_1_SET;
  	}
        else
  	{
*************** ix86_handle_option (struct gcc_options *
*** 1414,1421 ****
  	{
  	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_AMX_AVX512_SET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AMX_AVX512_SET;
! 	  opts->x_ix86_isa_flags |= OPTION_MASK_ISA_AVX2_SET;
! 	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX2_SET;
  	}
        else
  	{
--- 1374,1381 ----
  	{
  	  opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_AMX_AVX512_SET;
  	  opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA2_AMX_AVX512_SET;
! 	  opts->x_ix86_isa_flags |= OPTION_MASK_ISA_AVX10_1_SET;
! 	  opts->x_ix86_isa_flags_explicit |= OPTION_MASK_ISA_AVX10_1_SET;
  	}
        else
  	{
diff -Nrcpad gcc-16-20250518/gcc/common/config/i386/i386-cpuinfo.h gcc-16-20250525/gcc/common/config/i386/i386-cpuinfo.h
*** gcc-16-20250518/gcc/common/config/i386/i386-cpuinfo.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/common/config/i386/i386-cpuinfo.h	Sun May 25 22:32:05 2025
*************** enum feature_priority
*** 148,155 ****
    P_AVX512F,
    P_PROC_AVX512F,
    P_X86_64_V4,
!   P_AVX10_1_256,
!   P_AVX10_1,
    P_PROC_AVX10_1,
    P_PROC_DYNAMIC
  };
--- 148,154 ----
    P_AVX512F,
    P_PROC_AVX512F,
    P_X86_64_V4,
!   P_AVX10_1 = 34,
    P_PROC_AVX10_1,
    P_PROC_DYNAMIC
  };
*************** enum processor_features
*** 266,273 ****
    FEATURE_SM4,
    FEATURE_APX_F,
    FEATURE_USER_MSR,
!   FEATURE_AVX10_1_256,
!   FEATURE_AVX10_1,
    FEATURE_AVX10_2 = 116,
    FEATURE_AMX_AVX512,
    FEATURE_AMX_TF32,
--- 265,271 ----
    FEATURE_SM4,
    FEATURE_APX_F,
    FEATURE_USER_MSR,
!   FEATURE_AVX10_1 = 114,
    FEATURE_AVX10_2 = 116,
    FEATURE_AMX_AVX512,
    FEATURE_AMX_TF32,
diff -Nrcpad gcc-16-20250518/gcc/common/config/i386/i386-isas.h gcc-16-20250525/gcc/common/config/i386/i386-isas.h
*** gcc-16-20250518/gcc/common/config/i386/i386-isas.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/common/config/i386/i386-isas.h	Sun May 25 22:32:05 2025
*************** ISA_NAMES_TABLE_START
*** 183,191 ****
    ISA_NAMES_TABLE_ENTRY("sm4", FEATURE_SM4, P_NONE, "-msm4")
    ISA_NAMES_TABLE_ENTRY("apxf", FEATURE_APX_F, P_NONE, "-mapxf")
    ISA_NAMES_TABLE_ENTRY("usermsr", FEATURE_USER_MSR, P_NONE, "-musermsr")
-   ISA_NAMES_TABLE_ENTRY("avx10.1-256", FEATURE_AVX10_1_256, P_AVX10_1_256, "-mavx10.1-256")
    ISA_NAMES_TABLE_ENTRY("avx10.1", FEATURE_AVX10_1, P_AVX10_1, "-mavx10.1")
-   ISA_NAMES_TABLE_ENTRY("avx10.1-512", FEATURE_AVX10_1, P_AVX10_1, "-mavx10.1-512")
    ISA_NAMES_TABLE_ENTRY("avx10.2", FEATURE_AVX10_2, P_NONE, "-mavx10.2")
    ISA_NAMES_TABLE_ENTRY("amx-avx512", FEATURE_AMX_AVX512, P_NONE,
  			"-mamx-avx512")
--- 183,189 ----
diff -Nrcpad gcc-16-20250518/gcc/common/config/riscv/riscv-common.cc gcc-16-20250525/gcc/common/config/riscv/riscv-common.cc
*** gcc-16-20250518/gcc/common/config/riscv/riscv-common.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/common/config/riscv/riscv-common.cc	Sun May 25 22:32:05 2025
*************** static const std::unordered_map<std::str
*** 215,221 ****
  };
  
  static const riscv_ext_info_t &
! get_riscv_ext_info (const std::string &ext)
  {
    auto itr = riscv_ext_infos.find (ext);
    if (itr == riscv_ext_infos.end ())
--- 215,221 ----
  };
  
  static const riscv_ext_info_t &
! get_riscv_ext_info (const char * ext)
  {
    auto itr = riscv_ext_infos.find (ext);
    if (itr == riscv_ext_infos.end ())
*************** riscv_subset_list::parse_base_ext (const
*** 980,987 ****
      }
    else
      {
!       error_at (m_loc, "%<-march=%s%>: ISA string must begin with rv32, rv64 "
! 		"or Profiles", m_arch);
        return NULL;
      }
  
--- 980,988 ----
      }
    else
      {
!       error_at (m_loc, "%<-march=%s%>: ISA string must begin with rv32, rv64,"
! 		" a supported RVA profile or refer to a supported CPU",
! 		m_arch);
        return NULL;
      }
  
*************** riscv_subset_list::check_implied_ext ()
*** 1112,1118 ****
    for (itr = m_head; itr != NULL; itr = itr->next)
      {
        auto &ext = *itr;
!       auto &ext_info = get_riscv_ext_info (ext.name);
        for (auto &implied_ext : ext_info.implied_exts ())
  	{
  	  if (!implied_ext.match (this))
--- 1113,1119 ----
    for (itr = m_head; itr != NULL; itr = itr->next)
      {
        auto &ext = *itr;
!       auto &ext_info = get_riscv_ext_info (ext.name.c_str ());
        for (auto &implied_ext : ext_info.implied_exts ())
  	{
  	  if (!implied_ext.match (this))
*************** riscv_handle_option (struct gcc_options
*** 1708,1714 ****
    switch (decoded->opt_index)
      {
      case OPT_march_:
!       riscv_parse_arch_string (decoded->arg, opts, loc);
        return true;
  
      case OPT_mcpu_:
--- 1709,1716 ----
    switch (decoded->opt_index)
      {
      case OPT_march_:
!       if (riscv_find_cpu (decoded->arg) == NULL)
! 	riscv_parse_arch_string (decoded->arg, opts, loc);
        return true;
  
      case OPT_mcpu_:
*************** riscv_handle_option (struct gcc_options
*** 1725,1739 ****
  /* Expand arch string with implied extensions.  */
  
  const char *
! riscv_expand_arch (int argc ATTRIBUTE_UNUSED,
  		   const char **argv)
  {
    gcc_assert (argc == 1);
    location_t loc = UNKNOWN_LOCATION;
!   riscv_parse_arch_string (argv[0], NULL, loc);
    const std::string arch = riscv_arch_str (false);
!   if (arch.length())
!     return xasprintf ("-march=%s", arch.c_str());
    else
      return "";
  }
--- 1727,1744 ----
  /* Expand arch string with implied extensions.  */
  
  const char *
! riscv_expand_arch (int argc,
  		   const char **argv)
  {
    gcc_assert (argc == 1);
    location_t loc = UNKNOWN_LOCATION;
!   /* Try to interpret the arch as CPU first.  */
!   const char *arch_str = riscv_expand_arch_from_cpu (argc, argv);
!   if (!strlen (arch_str))
!     riscv_parse_arch_string (argv[0], NULL, loc);
    const std::string arch = riscv_arch_str (false);
!   if (arch.length ())
!     return xasprintf ("-march=%s", arch.c_str ());
    else
      return "";
  }
diff -Nrcpad gcc-16-20250518/gcc/config/aarch64/aarch64-sve.md gcc-16-20250525/gcc/config/aarch64/aarch64-sve.md
*** gcc-16-20250518/gcc/config/aarch64/aarch64-sve.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/aarch64/aarch64-sve.md	Sun May 25 22:32:05 2025
***************
*** 3317,3322 ****
--- 3317,3377 ----
  ;; - REVW
  ;; -------------------------------------------------------------------------
  
+ (define_split
+   [(set (match_operand:SVE_FULL_HSDI 0 "register_operand")
+ 	(rotate:SVE_FULL_HSDI
+ 	  (match_operand:SVE_FULL_HSDI 1 "register_operand")
+ 	  (match_operand:SVE_FULL_HSDI 2 "aarch64_constant_vector_operand")))]
+   "TARGET_SVE && can_create_pseudo_p ()"
+   [(set (match_dup 3)
+ 	(ashift:SVE_FULL_HSDI (match_dup 1)
+ 			      (match_dup 2)))
+    (set (match_dup 0)
+ 	(plus:SVE_FULL_HSDI
+ 	  (lshiftrt:SVE_FULL_HSDI (match_dup 1)
+ 				  (match_dup 4))
+ 	  (match_dup 3)))]
+   {
+     if (aarch64_emit_opt_vec_rotate (operands[0], operands[1], operands[2]))
+       DONE;
+ 
+     if (!TARGET_SVE2)
+       FAIL;
+ 
+     operands[3] = gen_reg_rtx (<MODE>mode);
+     HOST_WIDE_INT shift_amount =
+       INTVAL (unwrap_const_vec_duplicate (operands[2]));
+     int bitwidth = GET_MODE_UNIT_BITSIZE (<MODE>mode);
+     operands[4] = aarch64_simd_gen_const_vector_dup (<MODE>mode,
+ 						     bitwidth - shift_amount);
+   }
+ )
+ 
+ ;; The RTL combiners are able to combine "ior (ashift, ashiftrt)" to a "bswap".
+ ;; Match that as well.
+ (define_insn_and_split "*v_revvnx8hi"
+   [(parallel
+     [(set (match_operand:VNx8HI 0 "register_operand" "=w")
+ 	  (bswap:VNx8HI (match_operand 1 "register_operand" "w")))
+      (clobber (match_scratch:VNx8BI 2 "=Upl"))])]
+   "TARGET_SVE"
+   "#"
+   "&& 1"
+   [(set (match_dup 0)
+ 	(unspec:VNx8HI
+ 	  [(match_dup 2)
+ 	   (unspec:VNx8HI
+ 	     [(match_dup 1)]
+ 	     UNSPEC_REVB)]
+ 	  UNSPEC_PRED_X))]
+   {
+     if (!can_create_pseudo_p ())
+       emit_move_insn (operands[2], CONSTM1_RTX (VNx8BImode));
+     else
+       operands[2] = aarch64_ptrue_reg (VNx8BImode);
+   }
+ )
+ 
  ;; Predicated integer unary operations.
  (define_insn "@aarch64_pred_<optab><mode>"
    [(set (match_operand:SVE_FULL_I 0 "register_operand")
***************
*** 4234,4313 ****
  (define_expand "@aarch64_adr<mode>_shift"
    [(set (match_operand:SVE_FULL_SDI 0 "register_operand")
  	(plus:SVE_FULL_SDI
! 	  (unspec:SVE_FULL_SDI
! 	    [(match_dup 4)
! 	     (ashift:SVE_FULL_SDI
! 	       (match_operand:SVE_FULL_SDI 2 "register_operand")
! 	       (match_operand:SVE_FULL_SDI 3 "const_1_to_3_operand"))]
! 	    UNSPEC_PRED_X)
  	  (match_operand:SVE_FULL_SDI 1 "register_operand")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
-   {
-     operands[4] = CONSTM1_RTX (<VPRED>mode);
-   }
  )
  
! (define_insn_and_rewrite "*aarch64_adr<mode>_shift"
    [(set (match_operand:SVE_24I 0 "register_operand" "=w")
  	(plus:SVE_24I
! 	  (unspec:SVE_24I
! 	    [(match_operand 4)
! 	     (ashift:SVE_24I
! 	       (match_operand:SVE_24I 2 "register_operand" "w")
! 	       (match_operand:SVE_24I 3 "const_1_to_3_operand"))]
! 	    UNSPEC_PRED_X)
  	  (match_operand:SVE_24I 1 "register_operand" "w")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
    "adr\t%0.<Vctype>, [%1.<Vctype>, %2.<Vctype>, lsl %3]"
-   "&& !CONSTANT_P (operands[4])"
-   {
-     operands[4] = CONSTM1_RTX (<VPRED>mode);
-   }
  )
  
  ;; Same, but with the index being sign-extended from the low 32 bits.
  (define_insn_and_rewrite "*aarch64_adr_shift_sxtw"
    [(set (match_operand:VNx2DI 0 "register_operand" "=w")
  	(plus:VNx2DI
! 	  (unspec:VNx2DI
! 	    [(match_operand 4)
! 	     (ashift:VNx2DI
! 	       (unspec:VNx2DI
! 		 [(match_operand 5)
! 		  (sign_extend:VNx2DI
! 		    (truncate:VNx2SI
! 		      (match_operand:VNx2DI 2 "register_operand" "w")))]
! 		 UNSPEC_PRED_X)
! 	       (match_operand:VNx2DI 3 "const_1_to_3_operand"))]
! 	    UNSPEC_PRED_X)
  	  (match_operand:VNx2DI 1 "register_operand" "w")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
    "adr\t%0.d, [%1.d, %2.d, sxtw %3]"
!   "&& (!CONSTANT_P (operands[4]) || !CONSTANT_P (operands[5]))"
    {
!     operands[5] = operands[4] = CONSTM1_RTX (VNx2BImode);
    }
  )
  
  ;; Same, but with the index being zero-extended from the low 32 bits.
! (define_insn_and_rewrite "*aarch64_adr_shift_uxtw"
    [(set (match_operand:VNx2DI 0 "register_operand" "=w")
  	(plus:VNx2DI
! 	  (unspec:VNx2DI
! 	    [(match_operand 5)
! 	     (ashift:VNx2DI
! 	       (and:VNx2DI
! 		 (match_operand:VNx2DI 2 "register_operand" "w")
! 		 (match_operand:VNx2DI 4 "aarch64_sve_uxtw_immediate"))
! 	       (match_operand:VNx2DI 3 "const_1_to_3_operand"))]
! 	    UNSPEC_PRED_X)
  	  (match_operand:VNx2DI 1 "register_operand" "w")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
    "adr\t%0.d, [%1.d, %2.d, uxtw %3]"
-   "&& !CONSTANT_P (operands[5])"
-   {
-     operands[5] = CONSTM1_RTX (VNx2BImode);
-   }
  )
  
  ;; -------------------------------------------------------------------------
--- 4289,4345 ----
  (define_expand "@aarch64_adr<mode>_shift"
    [(set (match_operand:SVE_FULL_SDI 0 "register_operand")
  	(plus:SVE_FULL_SDI
! 	  (ashift:SVE_FULL_SDI
! 	    (match_operand:SVE_FULL_SDI 2 "register_operand")
! 	    (match_operand:SVE_FULL_SDI 3 "const_1_to_3_operand"))
  	  (match_operand:SVE_FULL_SDI 1 "register_operand")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
  )
  
! (define_insn "*aarch64_adr<mode>_shift"
    [(set (match_operand:SVE_24I 0 "register_operand" "=w")
  	(plus:SVE_24I
! 	  (ashift:SVE_24I
! 	    (match_operand:SVE_24I 2 "register_operand" "w")
! 	    (match_operand:SVE_24I 3 "const_1_to_3_operand"))
  	  (match_operand:SVE_24I 1 "register_operand" "w")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
    "adr\t%0.<Vctype>, [%1.<Vctype>, %2.<Vctype>, lsl %3]"
  )
  
  ;; Same, but with the index being sign-extended from the low 32 bits.
  (define_insn_and_rewrite "*aarch64_adr_shift_sxtw"
    [(set (match_operand:VNx2DI 0 "register_operand" "=w")
  	(plus:VNx2DI
! 	  (ashift:VNx2DI
! 	    (unspec:VNx2DI
! 	      [(match_operand 4)
! 	       (sign_extend:VNx2DI
! 		 (truncate:VNx2SI
! 		   (match_operand:VNx2DI 2 "register_operand" "w")))]
! 	     UNSPEC_PRED_X)
! 	    (match_operand:VNx2DI 3 "const_1_to_3_operand"))
  	  (match_operand:VNx2DI 1 "register_operand" "w")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
    "adr\t%0.d, [%1.d, %2.d, sxtw %3]"
!   "&& !CONSTANT_P (operands[4])"
    {
!     operands[4] = CONSTM1_RTX (VNx2BImode);
    }
  )
  
  ;; Same, but with the index being zero-extended from the low 32 bits.
! (define_insn "*aarch64_adr_shift_uxtw"
    [(set (match_operand:VNx2DI 0 "register_operand" "=w")
  	(plus:VNx2DI
! 	  (ashift:VNx2DI
! 	    (and:VNx2DI
! 	      (match_operand:VNx2DI 2 "register_operand" "w")
! 	      (match_operand:VNx2DI 4 "aarch64_sve_uxtw_immediate"))
! 	    (match_operand:VNx2DI 3 "const_1_to_3_operand"))
  	  (match_operand:VNx2DI 1 "register_operand" "w")))]
    "TARGET_SVE && TARGET_NON_STREAMING"
    "adr\t%0.d, [%1.d, %2.d, uxtw %3]"
  )
  
  ;; -------------------------------------------------------------------------
***************
*** 4899,4905 ****
      if (CONST_INT_P (operands[2]))
        {
  	amount = gen_const_vec_duplicate (<MODE>mode, operands[2]);
! 	if (!aarch64_sve_<lr>shift_operand (operands[2], <MODE>mode))
  	  amount = force_reg (<MODE>mode, amount);
        }
      else
--- 4931,4937 ----
      if (CONST_INT_P (operands[2]))
        {
  	amount = gen_const_vec_duplicate (<MODE>mode, operands[2]);
! 	if (!aarch64_sve_<lr>shift_operand (amount, <MODE>mode))
  	  amount = force_reg (<MODE>mode, amount);
        }
      else
***************
*** 4923,4937 ****
  	  UNSPEC_PRED_X))]
    "TARGET_SVE"
    {
      operands[3] = aarch64_ptrue_reg (<VPRED>mode);
    }
  )
  
! ;; Shift by a vector, predicated with a PTRUE.  We don't actually need
! ;; the predicate for the first alternative, but using Upa or X isn't
! ;; likely to gain much and would make the instruction seem less uniform
! ;; to the register allocator.
! (define_insn_and_split "@aarch64_pred_<optab><mode>"
    [(set (match_operand:SVE_I 0 "register_operand")
  	(unspec:SVE_I
  	  [(match_operand:<VPRED> 1 "register_operand")
--- 4955,4994 ----
  	  UNSPEC_PRED_X))]
    "TARGET_SVE"
    {
+     if (CONSTANT_P (operands[2]))
+       {
+ 	emit_insn (gen_aarch64_v<optab><mode>3_const (operands[0], operands[1],
+ 						      operands[2]));
+ 	DONE;
+       }
      operands[3] = aarch64_ptrue_reg (<VPRED>mode);
    }
  )
  
! ;; Shift by a vector, predicated with a PTRUE.
! (define_expand "@aarch64_pred_<optab><mode>"
!   [(set (match_operand:SVE_I 0 "register_operand")
! 	(unspec:SVE_I
! 	  [(match_operand:<VPRED> 1 "register_operand")
! 	   (ASHIFT:SVE_I
! 	     (match_operand:SVE_I 2 "register_operand")
! 	     (match_operand:SVE_I 3 "aarch64_sve_<lr>shift_operand"))]
! 	  UNSPEC_PRED_X))]
!   "TARGET_SVE"
!   {
!     if (CONSTANT_P (operands[3]))
!       {
! 	emit_insn (gen_aarch64_v<optab><mode>3_const (operands[0], operands[2],
! 						      operands[3]));
! 	DONE;
!       }
!   }
! )
! 
! ;; We don't actually need the predicate for the first alternative, but
! ;; using Upa or X isn't likely to gain much and would make the instruction
! ;; seem less uniform to the register allocator.
! (define_insn_and_split "*aarch64_pred_<optab><mode>"
    [(set (match_operand:SVE_I 0 "register_operand")
  	(unspec:SVE_I
  	  [(match_operand:<VPRED> 1 "register_operand")
***************
*** 4946,4978 ****
       [ w        , Upl , w , 0     ; *              ] <shift>r\t%0.<Vetype>, %1/m, %3.<Vetype>, %2.<Vetype>
       [ ?&w      , Upl , w , w     ; yes            ] movprfx\t%0, %2\;<shift>\t%0.<Vetype>, %1/m, %0.<Vetype>, %3.<Vetype>
    }
!   "&& reload_completed
!    && !register_operand (operands[3], <MODE>mode)"
    [(set (match_dup 0) (ASHIFT:SVE_I (match_dup 2) (match_dup 3)))]
    ""
  )
  
! ;; Unpredicated shift operations by a constant (post-RA only).
  ;; These are generated by splitting a predicated instruction whose
  ;; predicate is unused.
! (define_insn "*post_ra_v_ashl<mode>3"
    [(set (match_operand:SVE_I 0 "register_operand")
  	(ashift:SVE_I
  	  (match_operand:SVE_I 1 "register_operand")
  	  (match_operand:SVE_I 2 "aarch64_simd_lshift_imm")))]
!   "TARGET_SVE && reload_completed"
    {@ [ cons: =0 , 1 , 2   ]
       [ w	, w , vs1 ] add\t%0.<Vetype>, %1.<Vetype>, %1.<Vetype>
       [ w	, w , Dl  ] lsl\t%0.<Vetype>, %1.<Vetype>, #%2
    }
  )
  
! (define_insn "*post_ra_v_<optab><mode>3"
    [(set (match_operand:SVE_I 0 "register_operand" "=w")
  	(SHIFTRT:SVE_I
  	  (match_operand:SVE_I 1 "register_operand" "w")
  	  (match_operand:SVE_I 2 "aarch64_simd_rshift_imm")))]
!   "TARGET_SVE && reload_completed"
    "<shift>\t%0.<Vetype>, %1.<Vetype>, #%2"
  )
  
--- 5003,5034 ----
       [ w        , Upl , w , 0     ; *              ] <shift>r\t%0.<Vetype>, %1/m, %3.<Vetype>, %2.<Vetype>
       [ ?&w      , Upl , w , w     ; yes            ] movprfx\t%0, %2\;<shift>\t%0.<Vetype>, %1/m, %0.<Vetype>, %3.<Vetype>
    }
!   "&& !register_operand (operands[3], <MODE>mode)"
    [(set (match_dup 0) (ASHIFT:SVE_I (match_dup 2) (match_dup 3)))]
    ""
  )
  
! ;; Unpredicated shift operations by a constant.
  ;; These are generated by splitting a predicated instruction whose
  ;; predicate is unused.
! (define_insn "aarch64_vashl<mode>3_const"
    [(set (match_operand:SVE_I 0 "register_operand")
  	(ashift:SVE_I
  	  (match_operand:SVE_I 1 "register_operand")
  	  (match_operand:SVE_I 2 "aarch64_simd_lshift_imm")))]
!   "TARGET_SVE"
    {@ [ cons: =0 , 1 , 2   ]
       [ w	, w , vs1 ] add\t%0.<Vetype>, %1.<Vetype>, %1.<Vetype>
       [ w	, w , Dl  ] lsl\t%0.<Vetype>, %1.<Vetype>, #%2
    }
  )
  
! (define_insn "aarch64_v<optab><mode>3_const"
    [(set (match_operand:SVE_I 0 "register_operand" "=w")
  	(SHIFTRT:SVE_I
  	  (match_operand:SVE_I 1 "register_operand" "w")
  	  (match_operand:SVE_I 2 "aarch64_simd_rshift_imm")))]
!   "TARGET_SVE"
    "<shift>\t%0.<Vetype>, %1.<Vetype>, #%2"
  )
  
diff -Nrcpad gcc-16-20250518/gcc/config/aarch64/aarch64-sve2.md gcc-16-20250525/gcc/config/aarch64/aarch64-sve2.md
*** gcc-16-20250518/gcc/config/aarch64/aarch64-sve2.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/aarch64/aarch64-sve2.md	Sun May 25 22:32:05 2025
***************
*** 1932,1971 ****
  (define_expand "@aarch64_sve_add_<sve_int_op><mode>"
    [(set (match_operand:SVE_FULL_I 0 "register_operand")
  	(plus:SVE_FULL_I
! 	  (unspec:SVE_FULL_I
! 	    [(match_dup 4)
! 	     (SHIFTRT:SVE_FULL_I
! 	       (match_operand:SVE_FULL_I 2 "register_operand")
! 	       (match_operand:SVE_FULL_I 3 "aarch64_simd_rshift_imm"))]
! 	    UNSPEC_PRED_X)
! 	 (match_operand:SVE_FULL_I 1 "register_operand")))]
    "TARGET_SVE2"
-   {
-     operands[4] = CONSTM1_RTX (<VPRED>mode);
-   }
  )
  
  ;; Pattern-match SSRA and USRA as a predicated operation whose predicate
  ;; isn't needed.
! (define_insn_and_rewrite "*aarch64_sve2_sra<mode>"
    [(set (match_operand:SVE_FULL_I 0 "register_operand")
  	(plus:SVE_FULL_I
! 	  (unspec:SVE_FULL_I
! 	    [(match_operand 4)
! 	     (SHIFTRT:SVE_FULL_I
! 	       (match_operand:SVE_FULL_I 2 "register_operand")
! 	       (match_operand:SVE_FULL_I 3 "aarch64_simd_rshift_imm"))]
! 	    UNSPEC_PRED_X)
  	 (match_operand:SVE_FULL_I 1 "register_operand")))]
    "TARGET_SVE2"
    {@ [ cons: =0 , 1 , 2 ; attrs: movprfx ]
       [ w        , 0 , w ; *              ] <sra_op>sra\t%0.<Vetype>, %2.<Vetype>, #%3
       [ ?&w      , w , w ; yes            ] movprfx\t%0, %1\;<sra_op>sra\t%0.<Vetype>, %2.<Vetype>, #%3
    }
-   "&& !CONSTANT_P (operands[4])"
-   {
-     operands[4] = CONSTM1_RTX (<VPRED>mode);
-   }
  )
  
  ;; SRSRA and URSRA.
--- 1932,1958 ----
  (define_expand "@aarch64_sve_add_<sve_int_op><mode>"
    [(set (match_operand:SVE_FULL_I 0 "register_operand")
  	(plus:SVE_FULL_I
! 	  (SHIFTRT:SVE_FULL_I
! 	    (match_operand:SVE_FULL_I 2 "register_operand")
! 	    (match_operand:SVE_FULL_I 3 "aarch64_simd_rshift_imm"))
! 	  (match_operand:SVE_FULL_I 1 "register_operand")))]
    "TARGET_SVE2"
  )
  
  ;; Pattern-match SSRA and USRA as a predicated operation whose predicate
  ;; isn't needed.
! (define_insn "*aarch64_sve2_sra<mode>"
    [(set (match_operand:SVE_FULL_I 0 "register_operand")
  	(plus:SVE_FULL_I
! 	  (SHIFTRT:SVE_FULL_I
! 	    (match_operand:SVE_FULL_I 2 "register_operand")
! 	    (match_operand:SVE_FULL_I 3 "aarch64_simd_rshift_imm"))
  	 (match_operand:SVE_FULL_I 1 "register_operand")))]
    "TARGET_SVE2"
    {@ [ cons: =0 , 1 , 2 ; attrs: movprfx ]
       [ w        , 0 , w ; *              ] <sra_op>sra\t%0.<Vetype>, %2.<Vetype>, #%3
       [ ?&w      , w , w ; yes            ] movprfx\t%0, %1\;<sra_op>sra\t%0.<Vetype>, %2.<Vetype>, #%3
    }
  )
  
  ;; SRSRA and URSRA.
***************
*** 2715,2731 ****
  ;; Optimize ((a + b) >> n) where n is half the bitsize of the vector
  (define_insn "*bitmask_shift_plus<mode>"
    [(set (match_operand:SVE_FULL_HSDI 0 "register_operand" "=w")
! 	(unspec:SVE_FULL_HSDI
! 	   [(match_operand:<VPRED> 1)
! 	    (lshiftrt:SVE_FULL_HSDI
! 	      (plus:SVE_FULL_HSDI
! 		(match_operand:SVE_FULL_HSDI 2 "register_operand" "w")
! 		(match_operand:SVE_FULL_HSDI 3 "register_operand" "w"))
! 	      (match_operand:SVE_FULL_HSDI 4
! 		 "aarch64_simd_shift_imm_vec_exact_top" ""))]
!           UNSPEC_PRED_X))]
    "TARGET_SVE2"
!   "addhnb\t%0.<Ventype>, %2.<Vetype>, %3.<Vetype>"
  )
  
  ;; -------------------------------------------------------------------------
--- 2702,2715 ----
  ;; Optimize ((a + b) >> n) where n is half the bitsize of the vector
  (define_insn "*bitmask_shift_plus<mode>"
    [(set (match_operand:SVE_FULL_HSDI 0 "register_operand" "=w")
! 	(lshiftrt:SVE_FULL_HSDI
! 	  (plus:SVE_FULL_HSDI
! 	    (match_operand:SVE_FULL_HSDI 1 "register_operand" "w")
! 	    (match_operand:SVE_FULL_HSDI 2 "register_operand" "w"))
! 	  (match_operand:SVE_FULL_HSDI 3
! 	    "aarch64_simd_shift_imm_vec_exact_top" "")))]
    "TARGET_SVE2"
!   "addhnb\t%0.<Ventype>, %1.<Vetype>, %2.<Vetype>"
  )
  
  ;; -------------------------------------------------------------------------
diff -Nrcpad gcc-16-20250518/gcc/config/aarch64/aarch64-vxworks.h gcc-16-20250525/gcc/config/aarch64/aarch64-vxworks.h
*** gcc-16-20250518/gcc/config/aarch64/aarch64-vxworks.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/aarch64/aarch64-vxworks.h	Sun May 25 22:32:05 2025
*************** along with GCC; see the file COPYING3.
*** 66,74 ****
  #define VXWORKS_PERSONALITY "llvm"
  
  /* VxWorks uses R18 as a TCB pointer.  We must pick something else as
!    the static chain and R18 needs to be claimed "fixed".  Until we
!    arrange to override the common parts of the port family to
!    acknowledge the latter, configure --with-specs="-ffixed-r18".  */
  #undef  STATIC_CHAIN_REGNUM
  #define STATIC_CHAIN_REGNUM 9
! 
--- 66,73 ----
  #define VXWORKS_PERSONALITY "llvm"
  
  /* VxWorks uses R18 as a TCB pointer.  We must pick something else as
!    the static chain and R18 needs to be claimed "fixed" (TARGET_OS_USES_R18
!    does that in aarch64_conditional_register_usage).  */
  #undef  STATIC_CHAIN_REGNUM
  #define STATIC_CHAIN_REGNUM 9
! #define TARGET_OS_USES_R18
diff -Nrcpad gcc-16-20250518/gcc/config/aarch64/aarch64.cc gcc-16-20250525/gcc/config/aarch64/aarch64.cc
*** gcc-16-20250518/gcc/config/aarch64/aarch64.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/aarch64/aarch64.cc	Sun May 25 22:32:05 2025
*************** aarch64_rtx_costs (rtx x, machine_mode m
*** 14578,14583 ****
--- 14578,14590 ----
  	 we don't need to consider that here.  */
        if (x == const0_rtx)
  	*cost = 0;
+       /* If the outer is a COMPARE which is used by the middle-end
+ 	 and the constant fits how the cmp instruction allows, say the cost
+ 	 is the same as 1 insn.  */
+       else if (outer == COMPARE
+ 	       && (aarch64_uimm12_shift (INTVAL (x))
+ 		   || aarch64_uimm12_shift (-UINTVAL (x))))
+ 	*cost = COSTS_N_INSNS (1);
        else
  	{
  	  /* To an approximation, building any other constant is
*************** aarch64_override_options_internal (struc
*** 18819,18827 ****
        aarch64_stack_protector_guard_offset = offs;
      }
  
!   if ((flag_sanitize & SANITIZE_SHADOW_CALL_STACK)
!       && !fixed_regs[R18_REGNUM])
!     error ("%<-fsanitize=shadow-call-stack%> requires %<-ffixed-x18%>");
  
    aarch64_feature_flags isa_flags = aarch64_get_isa_flags (opts);
    if ((isa_flags & (AARCH64_FL_SM_ON | AARCH64_FL_ZA_ON))
--- 18826,18841 ----
        aarch64_stack_protector_guard_offset = offs;
      }
  
!   if ((flag_sanitize & SANITIZE_SHADOW_CALL_STACK))
!     {
!       if (!fixed_regs[R18_REGNUM])
! 	error ("%<-fsanitize=shadow-call-stack%> requires %<-ffixed-x18%>");
! #ifdef TARGET_OS_USES_R18
!       else
! 	sorry ("%<-fsanitize=shadow-call-stack%> conflicts with the use of"
! 	       " register x18 by the target operating system");
! #endif
!     }
  
    aarch64_feature_flags isa_flags = aarch64_get_isa_flags (opts);
    if ((isa_flags & (AARCH64_FL_SM_ON | AARCH64_FL_ZA_ON))
*************** aarch64_conditional_register_usage (void
*** 22039,22044 ****
--- 22053,22066 ----
        fixed_regs[SPECULATION_SCRATCH_REGNUM] = 1;
        call_used_regs[SPECULATION_SCRATCH_REGNUM] = 1;
      }
+ 
+ #ifdef TARGET_OS_USES_R18
+   /* R18 is the STATIC_CHAIN_REGNUM on most aarch64 ports, but VxWorks
+      uses it as the TCB, so aarch64-vxworks.h overrides
+      STATIC_CHAIN_REGNUM, and here we mark R18 as fixed.  */
+   fixed_regs[R18_REGNUM] = 1;
+   call_used_regs[R18_REGNUM] = 1;
+ #endif
  }
  
  /* Implement TARGET_MEMBER_TYPE_FORCES_BLK.  */
*************** aarch64_evpc_trn (struct expand_vec_perm
*** 26327,26333 ****
  static bool
  aarch64_evpc_reencode (struct expand_vec_perm_d *d)
  {
!   expand_vec_perm_d newd = {};
  
    /* The subregs that we'd create are not supported for big-endian SVE;
       see aarch64_modes_compatible_p for details.  */
--- 26349,26355 ----
  static bool
  aarch64_evpc_reencode (struct expand_vec_perm_d *d)
  {
!   expand_vec_perm_d newd;
  
    /* The subregs that we'd create are not supported for big-endian SVE;
       see aarch64_modes_compatible_p for details.  */
*************** aarch64_evpc_reencode (struct expand_vec
*** 26353,26358 ****
--- 26375,26382 ----
    newd.op1 = d->op1 ? gen_lowpart (new_mode, d->op1) : NULL;
    newd.testing_p = d->testing_p;
    newd.one_vector_p = d->one_vector_p;
+   newd.zero_op0_p = d->zero_op0_p;
+   newd.zero_op1_p = d->zero_op1_p;
  
    newd.perm.new_vector (newpermindices.encoding (), newd.one_vector_p ? 1 : 2,
  			newpermindices.nelts_per_input ());
*************** aarch64_vectorize_vec_perm_const (machin
*** 27067,27077 ****
    d.op_mode = op_mode;
    d.op_vec_flags = aarch64_classify_vector_mode (d.op_mode);
    d.target = target;
!   d.op0 = op0 ? force_reg (op_mode, op0) : NULL_RTX;
    if (op0 && d.one_vector_p)
      d.op1 = copy_rtx (d.op0);
    else
!     d.op1 = op1 ? force_reg (op_mode, op1) : NULL_RTX;
    d.testing_p = !target;
  
    if (!d.testing_p)
--- 27091,27107 ----
    d.op_mode = op_mode;
    d.op_vec_flags = aarch64_classify_vector_mode (d.op_mode);
    d.target = target;
!   d.op0 = op0;
!   if (d.op0 && !register_operand (d.op0, op_mode))
!     d.op0 = force_reg (op_mode, d.op0);
    if (op0 && d.one_vector_p)
      d.op1 = copy_rtx (d.op0);
    else
!     {
!       d.op1 = op1;
!       if (d.op1 && !register_operand (d.op1, op_mode))
!        d.op1 = force_reg (op_mode, d.op1);
!     }
    d.testing_p = !target;
  
    if (!d.testing_p)
diff -Nrcpad gcc-16-20250518/gcc/config/arm/predicates.md gcc-16-20250525/gcc/config/arm/predicates.md
*** gcc-16-20250518/gcc/config/arm/predicates.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/arm/predicates.md	Sun May 25 22:32:05 2025
***************
*** 901,907 ****
  
  (define_predicate "mem_noofs_operand"
    (and (match_code "mem")
!        (match_code "reg" "0")))
  
  (define_predicate "call_insn_operand"
    (ior (and (match_code "symbol_ref")
--- 901,908 ----
  
  (define_predicate "mem_noofs_operand"
    (and (match_code "mem")
!        (match_code "reg" "0")
!        (match_operand 0 "memory_operand")))
  
  (define_predicate "call_insn_operand"
    (ior (and (match_code "symbol_ref")
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2-512bf16intrin.h gcc-16-20250525/gcc/config/i386/avx10_2-512bf16intrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2-512bf16intrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2-512bf16intrin.h	Thu Jan  1 00:00:00 1970
***************
*** 1,681 ****
- /* Copyright (C) 2024-2025 Free Software Foundation, Inc.
- 
-    This file is part of GCC.
- 
-    GCC is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 3, or (at your option)
-    any later version.
- 
-    GCC is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
- 
-    Under Section 7 of GPL version 3, you are granted additional
-    permissions described in the GCC Runtime Library Exception, version
-    3.1, as published by the Free Software Foundation.
- 
-    You should have received a copy of the GNU General Public License and
-    a copy of the GCC Runtime Library Exception along with this program;
-    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
-    <http://www.gnu.org/licenses/>.  */
- 
- #ifndef _IMMINTRIN_H_INCLUDED
- #error "Never use <avx10_2-512bf16intrin.h> directly; include <immintrin.h> instead."
- #endif
- 
- #ifndef _AVX10_2_512BF16INTRIN_H_INCLUDED
- #define _AVX10_2_512BF16INTRIN_H_INCLUDED
- 
- #if !defined (__AVX10_2__)
- #pragma GCC push_options
- #pragma GCC target("avx10.2")
- #define __DISABLE_AVX10_2__
- #endif /* __AVX10_2__ */
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_add_pbh (__m512bh __A, __m512bh __B)
- {
-   return (__m512bh) __builtin_ia32_addbf16512 (__A, __B);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_add_pbh (__m512bh __W, __mmask32 __U,
- 		     __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_addbf16512_mask (__A, __B, __W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_add_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_addbf16512_mask (__A, __B,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_sub_pbh (__m512bh __A, __m512bh __B)
- {
-   return (__m512bh) __builtin_ia32_subbf16512 (__A, __B);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_sub_pbh (__m512bh __W, __mmask32 __U,
- 		     __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_subbf16512_mask (__A, __B, __W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_sub_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_subbf16512_mask (__A, __B,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mul_pbh (__m512bh __A, __m512bh __B)
- {
-   return (__m512bh) __builtin_ia32_mulbf16512 (__A, __B);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_mul_pbh (__m512bh __W, __mmask32 __U,
- 		     __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_mulbf16512_mask (__A, __B, __W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_mul_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_mulbf16512_mask (__A, __B,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_div_pbh (__m512bh __A, __m512bh __B)
- {
-   return (__m512bh) __builtin_ia32_divbf16512 (__A, __B);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_div_pbh (__m512bh __W, __mmask32 __U,
- 		     __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_divbf16512_mask (__A, __B, __W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_div_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_divbf16512_mask (__A, __B,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_max_pbh (__m512bh __A, __m512bh __B)
- {
-   return (__m512bh) __builtin_ia32_maxbf16512 (__A, __B);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_max_pbh (__m512bh __W, __mmask32 __U,
- 		     __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_maxbf16512_mask (__A, __B, __W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_max_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_maxbf16512_mask (__A, __B,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_min_pbh (__m512bh __A, __m512bh __B)
- {
-   return (__m512bh) __builtin_ia32_minbf16512 (__A, __B);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_min_pbh (__m512bh __W, __mmask32 __U,
- 		     __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_minbf16512_mask (__A, __B, __W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_min_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_minbf16512_mask (__A, __B,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_scalef_pbh (__m512bh __A, __m512bh __B)
- {
-   return (__m512bh) __builtin_ia32_scalefbf16512 (__A, __B);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_scalef_pbh (__m512bh __W, __mmask32 __U,
- 			__m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_scalefbf16512_mask (__A, __B, __W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_scalef_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
- {
-   return (__m512bh)
-     __builtin_ia32_scalefbf16512_mask (__A, __B,
- 				       (__v32bf) _mm512_setzero_si512 (),
- 				       __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_fmadd_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fmaddbf16512_mask (__A, __B, __C, (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_fmadd_pbh (__m512bh __A, __mmask32 __U,
- 		       __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fmaddbf16512_mask (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask3_fmadd_pbh (__m512bh __A, __m512bh __B,
- 			__m512bh __C, __mmask32 __U)
- {
-   return (__m512bh)
-     __builtin_ia32_fmaddbf16512_mask3 (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_fmadd_pbh (__mmask32 __U, __m512bh __A,
- 			  __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fmaddbf16512_maskz (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_fmsub_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fmsubbf16512_mask (__A, __B, __C, (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_fmsub_pbh (__m512bh __A, __mmask32 __U,
- 		       __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fmsubbf16512_mask (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask3_fmsub_pbh (__m512bh __A, __m512bh __B,
- 			__m512bh __C, __mmask32 __U)
- {
-   return (__m512bh)
-     __builtin_ia32_fmsubbf16512_mask3 (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_fmsub_pbh (__mmask32 __U, __m512bh __A,
- 			__m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fmsubbf16512_maskz (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_fnmadd_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmaddbf16512_mask (__A, __B, __C, (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_fnmadd_pbh (__m512bh __A, __mmask32 __U,
- 			__m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmaddbf16512_mask (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask3_fnmadd_pbh (__m512bh __A, __m512bh __B,
- 			 __m512bh __C, __mmask32 __U)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmaddbf16512_mask3 (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_fnmadd_pbh (__mmask32 __U, __m512bh __A,
- 			 __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmaddbf16512_maskz (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_fnmsub_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmsubbf16512_mask (__A, __B, __C, (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_fnmsub_pbh (__m512bh __A, __mmask32 __U,
- 			__m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmsubbf16512_mask (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask3_fnmsub_pbh (__m512bh __A, __m512bh __B,
- 			 __m512bh __C, __mmask32 __U)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmsubbf16512_mask3 (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_fnmsub_pbh (__mmask32 __U, __m512bh __A,
- 			 __m512bh __B, __m512bh __C)
- {
-   return (__m512bh)
-     __builtin_ia32_fnmsubbf16512_maskz (__A, __B, __C, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_rsqrt_pbh (__m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_rsqrtbf16512_mask (__A,
- 				      (__v32bf) _mm512_setzero_si512 (),
- 				      (__mmask32) -1);
- 
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_rsqrt_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_rsqrtbf16512_mask (__A,  __W,  __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_rsqrt_pbh (__mmask32 __U, __m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_rsqrtbf16512_mask (__A,
- 				      (__v32bf) _mm512_setzero_si512 (),
- 				      __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_sqrt_pbh (__m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_sqrtbf16512_mask (__A,
- 				     (__v32bf) _mm512_setzero_si512 (),
- 				     (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_sqrt_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_sqrtbf16512_mask (__A,  __W,  __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_sqrt_pbh (__mmask32 __U, __m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_sqrtbf16512_mask (__A,
- 				     (__v32bf) _mm512_setzero_si512 (),
- 				     __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_rcp_pbh (__m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_rcpbf16512_mask (__A,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_rcp_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_rcpbf16512_mask (__A,  __W,  __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_rcp_pbh (__mmask32 __U, __m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_rcpbf16512_mask (__A,
- 				    (__v32bf) _mm512_setzero_si512 (),
- 				    __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_getexp_pbh (__m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_getexpbf16512_mask (__A,
- 				       (__v32bf) _mm512_setzero_si512 (),
- 				       (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_getexp_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512bh) __builtin_ia32_getexpbf16512_mask (__A,  __W,  __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_getexp_pbh (__mmask32 __U, __m512bh __A)
- {
-   return (__m512bh)
-     __builtin_ia32_getexpbf16512_mask (__A,
- 				       (__v32bf) _mm512_setzero_si512 (),
- 				       __U);
- }
- 
- /* Intrinsics vrndscalebf16.  */
- #ifdef __OPTIMIZE__
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_roundscale_pbh (__m512bh __A, int B)
- {
-   return (__m512bh)
-     __builtin_ia32_rndscalebf16512_mask (__A, B,
- 					 (__v32bf) _mm512_setzero_si512 (),
- 					 (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_roundscale_pbh (__m512bh __W, __mmask32 __U, __m512bh __A, int B)
- {
-   return (__m512bh)
-     __builtin_ia32_rndscalebf16512_mask (__A, B, __W,  __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_roundscale_pbh (__mmask32 __U, __m512bh __A, int B)
- {
-   return (__m512bh)
-     __builtin_ia32_rndscalebf16512_mask (__A, B,
- 					 (__v32bf) _mm512_setzero_si512 (),
- 					 __U);
- }
- 
- #else
- #define _mm512_roundscale_pbh(A, B)					      \
-   (__builtin_ia32_rndscalebf16512_mask ((A), (B),			      \
- 					(__v32bf) _mm512_setzero_si512 (),    \
- 					(__mmask32) -1))
- 
- #define _mm512_mask_roundscale_pbh(A, B, C, D)	    		      \
-   (__builtin_ia32_rndscalebf16512_mask ((C), (D), (A), (B)))
- 
- #define _mm512_maskz_roundscale_pbh(A, B, C)				      \
-   (__builtin_ia32_rndscalebf16512_mask ((B), (C),			      \
- 					(__v32bf) _mm512_setzero_si512 (),    \
- 					(A)))
- 
- #endif /* __OPTIMIZE__ */
- 
- /* Intrinsics vreducebf16.  */
- #ifdef __OPTIMIZE__
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_reduce_pbh (__m512bh __A, int B)
- {
-   return (__m512bh)
-     __builtin_ia32_reducebf16512_mask (__A, B,
- 				       (__v32bf) _mm512_setzero_si512 (),
- 				       (__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_reduce_pbh (__m512bh __W, __mmask32 __U,
- 			__m512bh __A, int B)
- {
-   return (__m512bh)
-     __builtin_ia32_reducebf16512_mask (__A, B, __W,  __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_reduce_pbh (__mmask32 __U, __m512bh __A, int B)
- {
-   return (__m512bh)
-     __builtin_ia32_reducebf16512_mask (__A, B,
- 					  (__v32bf) _mm512_setzero_si512 (),
- 					  __U);
- }
- 
- #else
- #define _mm512_reduce_pbh(A, B)					      \
-   (__builtin_ia32_reducebf16512_mask ((A), (B),			      \
- 				      (__v32bf) _mm512_setzero_si512 (),   \
- 				      (__mmask32) -1))
- 
- #define _mm512_mask_reduce_pbh(A, B, C, D)				      \
-   (__builtin_ia32_reducebf16512_mask ((C), (D), (A), (B)))
- 
- #define _mm512_maskz_reduce_pbh(A, B, C)				      \
-   (__builtin_ia32_reducebf16512_mask ((B), (C),			      \
- 				      (__v32bf) _mm512_setzero_si512 (),      \
- 				      (A)))
- 
- #endif /* __OPTIMIZE__ */
- 
- /* Intrinsics vgetmantbf16.  */
- #ifdef __OPTIMIZE__
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_getmant_pbh (__m512bh __A, _MM_MANTISSA_NORM_ENUM __B,
- 		    _MM_MANTISSA_SIGN_ENUM __C)
- {
-   return (__m512bh)
-     __builtin_ia32_getmantbf16512_mask (__A, (int) (__C << 2) | __B,
- 					(__v32bf) _mm512_setzero_si512 (),
- 					(__mmask32) -1);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_getmant_pbh (__m512bh __W, __mmask32 __U, __m512bh __A,
- 			 _MM_MANTISSA_NORM_ENUM __B,
- 			 _MM_MANTISSA_SIGN_ENUM __C)
- {
-   return (__m512bh)
-     __builtin_ia32_getmantbf16512_mask (__A, (int) (__C << 2) | __B,
- 					__W, __U);
- }
- 
- extern __inline__ __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_getmant_pbh (__mmask32 __U, __m512bh __A,
- 			  _MM_MANTISSA_NORM_ENUM __B,
- 			  _MM_MANTISSA_SIGN_ENUM __C)
- {
-   return (__m512bh)
-     __builtin_ia32_getmantbf16512_mask (__A, (int) (__C << 2) | __B,
- 					(__v32bf) _mm512_setzero_si512 (),
- 					__U);
- }
- 
- #else
- #define _mm512_getmant_pbh(A, B, C)					      \
-   (__builtin_ia32_getmantbf16512_mask ((A), (int)(((C)<<2) | (B)),	      \
- 				       (__v32bf) _mm512_setzero_si512 (),     \
- 				       (__mmask32) -1))
- 
- #define _mm512_mask_getmant_pbh(A, B, C, D, E)				      \
-   (__builtin_ia32_getmantbf16512_mask ((C), (int)(((D)<<2) | (E)), (A), (B)))
- 
- #define _mm512_maskz_getmant_pbh(A, B, C, D)				      \
-   (__builtin_ia32_getmantbf16512_mask ((B), (int)(((C)<<2) | (D)),	      \
- 				       (__v32bf) _mm512_setzero_si512 (),     \
- 					  (A)))
- 
- #endif /* __OPTIMIZE__ */
- 
- /* Intrinsics vfpclassbf16.  */
- #ifdef __OPTIMIZE__
- extern __inline __mmask32
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_fpclass_pbh_mask (__mmask32 __U, __m512bh __A,
- 			      const int __imm)
- {
-   return (__mmask32)
-     __builtin_ia32_fpclassbf16512_mask (__A, __imm, __U);
- }
- 
- extern __inline __mmask32
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_fpclass_pbh_mask (__m512bh __A, const int __imm)
- {
-   return (__mmask32)
-     __builtin_ia32_fpclassbf16512_mask (__A, __imm,
- 					(__mmask32) -1);
- }
- 
- #else
- #define _mm512_mask_fpclass_pbh_mask(U, X, C)				   \
-   ((__mmask32) __builtin_ia32_fpclassbf16512_mask (			   \
-       (__v32bf) (__m512bh) (X), (int) (C), (__mmask32) (U)))
- 
- #define _mm512_fpclass_pbh_mask(X, C)					   \
-   ((__mmask32) __builtin_ia32_fpclassbf16512_mask (			   \
-       (__v32bf) (__m512bh) (X), (int) (C), (__mmask32) (-1)))
- #endif /* __OPIMTIZE__ */
- 
- 
- /* Intrinsics vcmpbf16.  */
- #ifdef __OPTIMIZE__
- extern __inline __mmask32
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cmp_pbh_mask (__mmask32 __U, __m512bh __A, __m512bh __B,
- 			  const int __imm)
- {
-   return (__mmask32)
-     __builtin_ia32_cmpbf16512_mask (__A, __B, __imm, __U);
- }
- 
- extern __inline __mmask32
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cmp_pbh_mask (__m512bh __A, __m512bh __B, const int __imm)
- {
-   return (__mmask32)
-     __builtin_ia32_cmpbf16512_mask (__A, __B, __imm,
- 				    (__mmask32) -1);
- }
- 
- #else
- #define _mm512_mask_cmp_pbh_mask(A, B, C, D)				\
-   ((__mmask32) __builtin_ia32_cmpbf16512_mask ((B), (C), (D), (A)))
- 
- #define _mm512_cmp_pbh_mask(A, B, C)					\
-   ((__mmask32) __builtin_ia32_cmpbf16512_mask ((A), (B), (C), (-1)))
- 
- #endif /* __OPIMTIZE__ */
- 
- #ifdef __DISABLE_AVX10_2__
- #undef __DISABLE_AVX10_2__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX10_2__ */
- 
- #endif /* _AVX10_2_512BF16INTRIN_H_INCLUDED */
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2-512convertintrin.h gcc-16-20250525/gcc/config/i386/avx10_2-512convertintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2-512convertintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2-512convertintrin.h	Thu Jan  1 00:00:00 1970
***************
*** 1,572 ****
- /* Copyright (C) 2024-2025 Free Software Foundation, Inc.
- 
-    This file is part of GCC.
- 
-    GCC is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 3, or (at your option)
-    any later version.
- 
-    GCC is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
- 
-    Under Section 7 of GPL version 3, you are granted additional
-    permissions described in the GCC Runtime Library Exception, version
-    3.1, as published by the Free Software Foundation.
- 
-    You should have received a copy of the GNU General Public License and
-    a copy of the GCC Runtime Library Exception along with this program;
-    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
-    <http://www.gnu.org/licenses/>.  */
- 
- #ifndef _IMMINTRIN_H_INCLUDED
- #error "Never use <avx10_2-512convertintrin.h> directly; include <immintrin.h> instead."
- #endif // _IMMINTRIN_H_INCLUDED
- 
- #ifndef __AVX10_2_512CONVERTINTRIN_H_INCLUDED
- #define __AVX10_2_512CONVERTINTRIN_H_INCLUDED
- 
- #ifndef __AVX10_2__
- #pragma GCC push_options
- #pragma GCC target("avx10.2")
- #define __DISABLE_AVX10_2__
- #endif /* __AVX10_2__ */
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtx2ps_ph (__m512 __A, __m512 __B)
- {
-   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
- 							     (__v16sf) __B,
- 							     (__v32hf)
- 							     _mm512_setzero_ph (),
- 							     (__mmask32) -1,
- 							     _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtx2ps_ph (__m512h __W, __mmask32 __U, __m512 __A,
- 			__m512 __B)
- {
-   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
- 							     (__v16sf) __B,
- 							     (__v32hf) __W,
- 							     (__mmask32) __U,
- 							     _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtx2ps_ph (__mmask32 __U, __m512 __A, __m512 __B)
- {
-   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
- 							     (__v16sf) __B,
- 							     (__v32hf)
- 							     _mm512_setzero_ph (),
- 							     (__mmask32) __U,
- 							     _MM_FROUND_CUR_DIRECTION);
- }
- 
- #ifdef __OPTIMIZE__
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtx_round2ps_ph (__m512 __A, __m512 __B, const int __R)
- {
-   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
- 							    (__v16sf) __B,
- 							    (__v32hf)
- 							    _mm512_setzero_ph (),
- 							    (__mmask32) -1,
- 							    __R);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtx_round2ps_ph (__m512h __W, __mmask32 __U, __m512 __A,
- 			      __m512 __B, const int __R)
- {
-   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
- 							    (__v16sf) __B,
- 							    (__v32hf) __W,
- 							    (__mmask32) __U,
- 							    __R);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtx_round2ps_ph (__mmask32 __U, __m512 __A,
- 			       __m512 __B, const int __R)
- {
-   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
- 							    (__v16sf) __B,
- 							    (__v32hf)
- 							    _mm512_setzero_ph (),
- 							    (__mmask32) __U,
- 							    __R);
- }
- 
- #else
- #define _mm512_cvtx_round2ps_ph(A, B, R) \
-   ((__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) (A), \
- 						       (__v16sf) (B), \
- 						       (__v32hf) \
- 						       (_mm512_setzero_ph ()), \
- 						       (__mmask32) (-1), \
- 						       (R)))
- #define _mm512_mask_cvtx_round2ps_ph(W, U, A, B, R) \
-   ((__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) (A), \
- 						       (__v16sf) (B), \
- 						       (__v32hf) (W), \
- 						       (__mmask32) (U), \
- 						       (R)))
- #define _mm512_maskz_cvtx_round2ps_ph(U, A, B, R) \
-   ((__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) (A), \
- 						       (__v16sf) (B), \
- 						       (__v32hf) \
- 						       (_mm512_setzero_ph ()), \
- 						       (__mmask32) (U), \
- 						       (R)))
- #endif  /* __OPTIMIZE__  */
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtbiasph_bf8 (__m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2bf8512_mask ((__v64qi) __A,
- 							  (__v32hf) __B,
- 							  (__v32qi)(__m256i)
- 							  _mm256_undefined_si256 (),
- 							  (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtbiasph_bf8 (__m256i __W, __mmask32 __U,
- 			   __m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2bf8512_mask ((__v64qi) __A,
- 							  (__v32hf) __B,
- 							  (__v32qi)(__m256i) __W,
- 							  (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtbiasph_bf8 (__mmask32 __U, __m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2bf8512_mask ((__v64qi) __A,
- 							  (__v32hf) __B,
- 							  (__v32qi)(__m256i)
- 							  _mm256_setzero_si256 (),
- 							  (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvts_biasph_bf8 (__m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2bf8s512_mask ((__v64qi) __A,
- 							   (__v32hf) __B,
- 							   (__v32qi)(__m256i)
- 							   _mm256_undefined_si256 (),
- 							   (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvts_biasph_bf8 (__m256i __W, __mmask32 __U,
- 			     __m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2bf8s512_mask ((__v64qi) __A,
- 							   (__v32hf) __B,
- 							   (__v32qi)(__m256i) __W,
- 							   (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvts_biasph_bf8 (__mmask32 __U, __m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2bf8s512_mask ((__v64qi) __A,
- 							   (__v32hf) __B,
- 							   (__v32qi)(__m256i)
- 							   _mm256_setzero_si256 (),
- 							   (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtbiasph_hf8 (__m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2hf8512_mask ((__v64qi) __A,
- 							  (__v32hf) __B,
- 							  (__v32qi)(__m256i)
- 					 		  _mm256_undefined_si256 (),
- 							  (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtbiasph_hf8 (__m256i __W, __mmask32 __U, __m512i __A,
- 			   __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2hf8512_mask ((__v64qi) __A,
- 							  (__v32hf) __B,
- 							  (__v32qi)(__m256i) __W,
- 							  (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtbiasph_hf8 (__mmask32 __U, __m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2hf8512_mask ((__v64qi) __A,
- 							  (__v32hf) __B,
- 							  (__v32qi)(__m256i)
- 							  _mm256_setzero_si256 (),
- 							  (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvts_biasph_hf8 (__m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2hf8s512_mask ((__v64qi) __A,
- 							   (__v32hf) __B,
- 							   (__v32qi)(__m256i)
- 							   _mm256_undefined_si256 (),
- 							   (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvts_biasph_hf8 (__m256i __W, __mmask32 __U,
- 			     __m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2hf8s512_mask ((__v64qi) __A,
- 							   (__v32hf) __B,
- 							   (__v32qi)(__m256i) __W,
- 							   (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvts_biasph_hf8 (__mmask32 __U, __m512i __A, __m512h __B)
- {
-   return (__m256i) __builtin_ia32_vcvtbiasph2hf8s512_mask ((__v64qi) __A,
- 							   (__v32hf) __B,
- 							   (__v32qi)(__m256i)
- 							   _mm256_setzero_si256 (),
- 							   (__mmask32) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvt2ph_bf8 (__m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2bf8512_mask ((__v32hf) __A,
- 						       (__v32hf) __B,
- 						       (__v64qi)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask64) -1);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvt2ph_bf8 (__m512i __W, __mmask64 __U,
- 			__m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2bf8512_mask ((__v32hf) __A,
- 						       (__v32hf) __B,
- 						       (__v64qi) __W,
- 						       (__mmask64) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvt2ph_bf8 (__mmask64 __U,  __m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2bf8512_mask ((__v32hf) __A,
- 						       (__v32hf) __B,
- 						       (__v64qi)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask64) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvts_2ph_bf8 (__m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2bf8s512_mask ((__v32hf) __A,
- 							(__v32hf) __B,
- 							(__v64qi)
- 							_mm512_setzero_si512 (),
- 							(__mmask64) -1);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvts_2ph_bf8 (__m512i __W, __mmask64 __U,
- 			  __m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2bf8s512_mask ((__v32hf) __A,
- 							(__v32hf) __B,
- 							(__v64qi) __W,
- 							(__mmask64) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvts_2ph_bf8 (__mmask64 __U, __m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2bf8s512_mask ((__v32hf) __A,
- 							(__v32hf) __B,
- 							(__v64qi)
- 							_mm512_setzero_si512 (),
- 							(__mmask64) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvt2ph_hf8 (__m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2hf8512_mask ((__v32hf) __A,
- 						       (__v32hf) __B,
- 						       (__v64qi)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask64) -1);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvt2ph_hf8 (__m512i __W, __mmask64 __U,
- 			__m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2hf8512_mask ((__v32hf) __A,
- 						       (__v32hf) __B,
- 						       (__v64qi) __W,
- 						       (__mmask64) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvt2ph_hf8 (__mmask64 __U, __m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2hf8512_mask ((__v32hf) __A,
- 						       (__v32hf) __B,
- 						       (__v64qi)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask64) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvts_2ph_hf8 (__m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2hf8s512_mask ((__v32hf) __A,
- 							(__v32hf) __B,
- 							(__v64qi)
- 							_mm512_setzero_si512 (),
- 							(__mmask64) -1);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvts_2ph_hf8 (__m512i __W, __mmask64 __U,
- 			  __m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2hf8s512_mask ((__v32hf) __A,
- 							(__v32hf) __B,
- 							(__v64qi) __W,
- 							(__mmask64) __U);
- }
- 
- extern __inline__ __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvts_2ph_hf8 (__mmask64 __U, __m512h __A, __m512h __B)
- {
-   return (__m512i) __builtin_ia32_vcvt2ph2hf8s512_mask ((__v32hf) __A,
- 							(__v32hf) __B,
- 							(__v64qi)
- 							_mm512_setzero_si512 (),
- 							(__mmask64) __U);
- }
- 
- extern __inline__ __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvthf8_ph (__m256i __A)
- {
-   return (__m512h) __builtin_ia32_vcvthf82ph512_mask ((__v32qi) __A,
- 						      (__v32hf) (__m512h)
- 						      _mm512_undefined_ph (),
- 						      (__mmask32) -1);
- }
- 
- extern __inline__ __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvthf8_ph (__m512h __W, __mmask32 __U, __m256i __A)
- {
-   return (__m512h) __builtin_ia32_vcvthf82ph512_mask ((__v32qi) __A,
- 						      (__v32hf) (__m512h) __W,
- 						      (__mmask32) __U);
- }
- 
- extern __inline__ __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvthf8_ph (__mmask32 __U, __m256i __A)
- {
-   return (__m512h) __builtin_ia32_vcvthf82ph512_mask ((__v32qi) __A,
- 						      (__v32hf) (__m512h)
- 						      _mm512_setzero_ph (),
- 						      (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtph_bf8 (__m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2bf8512_mask ((__v32hf) __A,
- 						      (__v32qi) (__m256i)
- 						      _mm256_undefined_si256 (),
- 						      (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtph_bf8 (__m256i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2bf8512_mask ((__v32hf) __A,
- 						      (__v32qi) (__m256i) __W,
- 						      (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtph_bf8 (__mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2bf8512_mask ((__v32hf) __A,
- 						      (__v32qi) (__m256i)
- 						      _mm256_setzero_si256 (),
- 						      (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvts_ph_bf8 (__m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2bf8s512_mask ((__v32hf) __A,
- 						       (__v32qi) (__m256i)
- 						       _mm256_undefined_si256 (),
- 						       (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvts_ph_bf8 (__m256i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2bf8s512_mask ((__v32hf) __A,
- 						       (__v32qi) (__m256i) __W,
- 						       (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvts_ph_bf8 (__mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2bf8s512_mask ((__v32hf) __A,
- 						       (__v32qi) (__m256i)
- 						       _mm256_setzero_si256 (),
- 						       (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtph_hf8 (__m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2hf8512_mask ((__v32hf) __A,
- 						      (__v32qi) (__m256i)
- 						      _mm256_undefined_si256 (),
- 						      (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtph_hf8 (__m256i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2hf8512_mask ((__v32hf) __A,
- 						      (__v32qi)(__m256i) __W,
- 						      (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtph_hf8 (__mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2hf8512_mask ((__v32hf) __A,
- 						      (__v32qi) (__m256i)
- 						      _mm256_setzero_si256 (),
- 						      (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvts_ph_hf8 (__m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2hf8s512_mask ((__v32hf) __A,
- 						       (__v32qi) (__m256i)
- 						       _mm256_undefined_si256 (),
- 						       (__mmask32) -1);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvts_ph_hf8 (__m256i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2hf8s512_mask ((__v32hf) __A,
- 						       (__v32qi) (__m256i) __W,
- 						       (__mmask32) __U);
- }
- 
- extern __inline__ __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvts_ph_hf8 (__mmask32 __U, __m512h __A)
- {
-   return (__m256i) __builtin_ia32_vcvtph2hf8s512_mask ((__v32hf) __A,
- 						       (__v32qi) (__m256i)
- 						       _mm256_setzero_si256 (),
- 						       (__mmask32) __U);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtbf8_ph (__m256i __A)
- {
-   return (__m512h) _mm512_castsi512_ph ((__m512i) _mm512_slli_epi16 (
- 	 (__m512i) _mm512_cvtepi8_epi16 (__A), 8));
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtbf8_ph (__m512h __S, __mmask32 __U, __m256i __A)
- {
-   return (__m512h) _mm512_castsi512_ph ((__m512i) _mm512_mask_slli_epi16 (
- 	 (__m512i) __S, __U, (__m512i) _mm512_cvtepi8_epi16 (__A), 8));
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtbf8_ph (__mmask32 __U, __m256i __A)
- {
-   return (__m512h) _mm512_castsi512_ph ((__m512i) _mm512_slli_epi16 (
- 	 (__m512i) _mm512_maskz_cvtepi8_epi16 (__U, __A), 8));
- }
- 
- #ifdef __DISABLE_AVX10_2__
- #undef __DISABLE_AVX10_2__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX10_2__ */
- 
- #endif /* __AVX10_2_512CONVERTINTRIN_H_INCLUDED */
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2-512mediaintrin.h gcc-16-20250525/gcc/config/i386/avx10_2-512mediaintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2-512mediaintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2-512mediaintrin.h	Thu Jan  1 00:00:00 1970
***************
*** 1,514 ****
- /* Copyright (C) 2024-2025 Free Software Foundation, Inc.
- 
-    This file is part of GCC.
- 
-    GCC is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 3, or (at your option)
-    any later version.
- 
-    GCC is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
- 
-    Under Section 7 of GPL version 3, you are granted additional
-    permissions described in the GCC Runtime Library Exception, version
-    3.1, as published by the Free Software Foundation.
- 
-    You should have received a copy of the GNU General Public License and
-    a copy of the GCC Runtime Library Exception along with this program;
-    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
-    <http://www.gnu.org/licenses/>.  */
- 
- #if !defined _IMMINTRIN_H_INCLUDED
- #error "Never use <avx10_2-512mediaintrin.h> directly; include <immintrin.h> instead."
- #endif
- 
- #ifndef _AVX10_2_512MEDIAINTRIN_H_INCLUDED
- #define _AVX10_2_512MEDIAINTRIN_H_INCLUDED
- 
- #if !defined(__AVX10_2__)
- #pragma GCC push_options
- #pragma GCC target("avx10.2")
- #define __DISABLE_AVX10_2__
- #endif /* __AVX10_2__ */
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpbssd_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbssd512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpbssd_epi32 (__m512i __W, __mmask16 __U,
- 			  __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbssd_v16si_mask ((__v16si) __W,
- 					(__v16si) __A,
- 					(__v16si) __B,
- 					(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpbssd_epi32 (__mmask16 __U, __m512i __W,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbssd_v16si_maskz ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpbssds_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbssds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpbssds_epi32 (__m512i __W, __mmask16 __U,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbssds_v16si_mask ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpbssds_epi32 (__mmask16 __U, __m512i __W,
- 			    __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbssds_v16si_maskz ((__v16si) __W,
- 					  (__v16si) __A,
- 					  (__v16si) __B,
- 					  (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpbsud_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbsud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpbsud_epi32 (__m512i __W, __mmask16 __U,
- 			  __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbsud_v16si_mask ((__v16si) __W,
- 					(__v16si) __A,
- 					(__v16si) __B,
- 					(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpbsud_epi32 (__mmask16 __U, __m512i __W,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbsud_v16si_maskz ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpbsuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbsuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpbsuds_epi32 (__m512i __W, __mmask16 __U,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbsuds_v16si_mask ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpbsuds_epi32 (__mmask16 __U, __m512i __W,
- 			    __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbsuds_v16si_maskz ((__v16si) __W,
- 					  (__v16si) __A,
- 					  (__v16si) __B,
- 					  (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpbuud_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbuud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpbuud_epi32 (__m512i __W, __mmask16 __U,
- 			  __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbuud_v16si_mask ((__v16si) __W,
- 					(__v16si) __A,
- 					(__v16si) __B,
- 					(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpbuud_epi32 (__mmask16 __U, __m512i __W,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbuud_v16si_maskz ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpbuuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbuuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpbuuds_epi32 (__m512i __W, __mmask16 __U,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbuuds_v16si_mask ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpbuuds_epi32 (__mmask16 __U, __m512i __W,
- 			    __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpbuuds_v16si_maskz ((__v16si) __W,
- 					  (__v16si) __A,
- 					  (__v16si) __B,
- 					  (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpwsud_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwsud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpwsud_epi32 (__m512i __W, __mmask16 __U,
- 			  __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwsud_v16si_mask ((__v16si) __W,
- 					(__v16si) __A,
- 					(__v16si) __B,
- 					(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpwsud_epi32 (__mmask16 __U, __m512i __W,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwsud_v16si_maskz ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpwsuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwsuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpwsuds_epi32 (__m512i __W, __mmask16 __U,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwsuds_v16si_mask ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpwsuds_epi32 (__mmask16 __U, __m512i __W,
- 			    __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwsuds_v16si_maskz ((__v16si) __W,
- 					  (__v16si) __A,
- 					  (__v16si) __B,
- 					  (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpwusd_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwusd512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpwusd_epi32 (__m512i __W, __mmask16 __U,
- 			  __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwusd_v16si_mask ((__v16si) __W,
- 					(__v16si) __A,
- 					(__v16si) __B,
- 					(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpwusd_epi32 (__mmask16 __U, __m512i __W,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwusd_v16si_maskz ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpwusds_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwusds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpwusds_epi32 (__m512i __W, __mmask16 __U,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwusds_v16si_mask ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpwusds_epi32 (__mmask16 __U, __m512i __W,
- 			    __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwusds_v16si_maskz ((__v16si) __W,
- 					  (__v16si) __A,
- 					  (__v16si) __B,
- 					  (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpwuud_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwuud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpwuud_epi32 (__m512i __W, __mmask16 __U,
- 			  __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwuud_v16si_mask ((__v16si) __W,
- 					(__v16si) __A,
- 					(__v16si) __B,
- 					(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpwuud_epi32 (__mmask16 __U, __m512i __W,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwuud_v16si_maskz ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpwuuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwuuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpwuuds_epi32 (__m512i __W, __mmask16 __U,
- 			   __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwuuds_v16si_mask ((__v16si) __W,
- 					 (__v16si) __A,
- 					 (__v16si) __B,
- 					 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpwuuds_epi32 (__mmask16 __U, __m512i __W,
- 			    __m512i __A, __m512i __B)
- {
-   return (__m512i)
-     __builtin_ia32_vpdpwuuds_v16si_maskz ((__v16si) __W,
- 					  (__v16si) __A,
- 					  (__v16si) __B,
- 					  (__mmask16) __U);
- }
- 
- extern __inline __m512
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_dpph_ps (__m512 __W, __m512h __A, __m512h __B)
- {
-   return (__m512)
-     __builtin_ia32_vdpphps512_mask ((__v16sf) __W,
- 				    (__v16sf) __A,
- 				    (__v16sf) __B,
- 				    (__mmask16) -1);
- }
- 
- extern __inline __m512
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_dpph_ps (__m512 __W, __mmask16 __U, __m512h __A,
- 		     __m512h __B)
- {
-   return (__m512)
-     __builtin_ia32_vdpphps512_mask ((__v16sf) __W,
- 				    (__v16sf) __A,
- 				    (__v16sf) __B,
- 				    (__mmask16) __U);
- }
- 
- extern __inline __m512
- __attribute__((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_dpph_ps (__mmask16 __U, __m512 __W, __m512h __A,
- 		      __m512h __B)
- {
-   return (__m512)
-     __builtin_ia32_vdpphps512_maskz ((__v16sf) __W,
- 				     (__v16sf) __A,
- 				     (__v16sf) __B,
- 				     (__mmask16) __U);
- }
- 
- #ifdef __OPTIMIZE__
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mpsadbw_epu8 (__m512i __X, __m512i __Y, const int __M)
- {
-   return (__m512i) __builtin_ia32_mpsadbw512 ((__v64qi) __X,
- 					      (__v64qi) __Y,
- 					      __M);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_mpsadbw_epu8 (__m512i __W, __mmask32 __U, __m512i __X,
- 			  __m512i __Y, const int __M)
- {
-   return (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi) __X,
- 						   (__v64qi) __Y,
- 						   __M,
- 						   (__v32hi) __W,
- 						   __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_mpsadbw_epu8 (__mmask32 __U, __m512i __X,
- 			   __m512i __Y, const int __M)
- {
-   return (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi) __X,
- 						   (__v64qi) __Y,
- 						   __M,
- 						   (__v32hi) _mm512_setzero_epi32 (),
- 						   __U);
- }
- #else
- #define _mm512_mpsadbw_epu8(X, Y, M)					\
-   (__m512i) __builtin_ia32_mpsadbw512 ((__v64qi)(__m512i)(X),		\
- 				       (__v64qi)(__m512i)(Y), (int)(M))
- 
- #define _mm512_mask_mpsadbw_epu8(W, U, X, Y, M)				\
-   (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi)(__m512i)(X),	\
- 					    (__v64qi)(__m512i)(Y),	\
- 					    (int)(M),			\
- 					    (__v32hi)(__m512i)(W),	\
- 					    (__mmask32)(U))
- 
- #define _mm512_maskz_mpsadbw_epu8(U, X, Y, M)				\
-   (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi)(__m512i)(X),	\
- 					    (__v64qi)(__m512i)(Y),	\
- 					    (int)(M),			\
- 					    (__v32hi) _mm512_setzero_epi32 (),	\
- 					    (__mmask32)(U))
- #endif
- 
- #ifdef __DISABLE_AVX10_2__
- #undef __DISABLE_AVX10_2__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX10_2__ */
- 
- #endif /* __AVX10_2_512MEDIAINTRIN_H_INCLUDED */
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2-512minmaxintrin.h gcc-16-20250525/gcc/config/i386/avx10_2-512minmaxintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2-512minmaxintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2-512minmaxintrin.h	Thu Jan  1 00:00:00 1970
***************
*** 1,489 ****
- /* Copyright (C) 2024-2025 Free Software Foundation, Inc.
-    This file is part of GCC.
-    GCC is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 3, or (at your option)
-    any later version.
-    GCC is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-    Under Section 7 of GPL version 3, you are granted additional
-    permissions described in the GCC Runtime Library Exception, version
-    3.1, as published by the Free Software Foundation.
-    You should have received a copy of the GNU General Public License and
-    a copy of the GCC Runtime Library Exception along with this program;
-    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
-    <http://www.gnu.org/licenses/>.  */
- 
- #if !defined _IMMINTRIN_H_INCLUDED
- #error "Never use <avx10_2-512minmaxintrin.h> directly; include <immintrin.h> instead."
- #endif
- 
- #ifndef _AVX10_2_512MINMAXINTRIN_H_INCLUDED
- #define _AVX10_2_512MINMAXINTRIN_H_INCLUDED
- 
- #if !defined (__AVX10_2__)
- #pragma GCC push_options
- #pragma GCC target("avx10.2")
- #define __DISABLE_AVX10_2__
- #endif /* __AVX10_2__ */
- 
- #ifdef __OPTIMIZE__
- extern __inline __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_minmax_pbh (__m512bh __A, __m512bh __B, const int __C)
- {
-   return (__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) __A,
- 						       (__v32bf) __B,
- 						       __C,
- 						       (__v32bf)(__m512bh)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask32) -1);
- }
- 
- extern __inline __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_minmax_pbh (__m512bh __W, __mmask32 __U,
- 			__m512bh __A, __m512bh __B, const int __C)
- {
-   return (__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) __A,
- 						       (__v32bf) __B,
- 						       __C,
- 						       (__v32bf) __W,
- 						       (__mmask32) __U);
- }
- 
- extern __inline __m512bh
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_minmax_pbh (__mmask32 __U, __m512bh __A,
- 			 __m512bh __B, const int __C)
- {
-   return (__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) __A,
- 						       (__v32bf) __B,
- 						       __C,
- 						       (__v32bf)(__m512bh)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask32) __U);
- }
- 
- extern __inline __m512d
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_minmax_pd (__m512d __A, __m512d __B, const int __C)
- {
-   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
- 							  (__v8df) __B,
- 							  __C,
- 							  (__v8df)
- 							  _mm512_undefined_pd (),
- 							  (__mmask8) -1,
- 							  _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512d
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_minmax_pd (__m512d __W, __mmask8 __U, __m512d __A,
- 		       __m512d __B, const int __C)
- {
-   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
- 							  (__v8df) __B,
- 							  __C,
- 							  (__v8df) __W,
- 							  (__mmask8) __U,
- 							  _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512d
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_minmax_pd (__mmask8 __U, __m512d __A, __m512d __B,
- 			const int __C)
- {
-   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
- 							  (__v8df) __B,
- 							  __C,
- 							  (__v8df)
- 							  _mm512_setzero_pd (),
- 							  (__mmask8) __U,
- 							  _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512d
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_minmax_round_pd (__m512d __A, __m512d __B, const int __C,
- 			const int __R)
- {
-   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
- 							  (__v8df) __B,
- 							  __C,
- 							  (__v8df)
- 							  _mm512_undefined_pd (),
- 							  (__mmask8) -1, __R);
- }
- 
- extern __inline __m512d
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_minmax_round_pd (__m512d __W, __mmask8 __U, __m512d __A,
- 			     __m512d __B, const int __C, const int __R)
- {
-   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
- 							  (__v8df) __B,
- 							  __C,
- 							  (__v8df) __W,
- 							  (__mmask8) __U, __R);
- }
- 
- extern __inline __m512d
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_minmax_round_pd (__mmask8 __U, __m512d __A, __m512d __B,
- 			      const int __C, const int __R)
- {
-   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
- 							  (__v8df) __B,
- 							  __C,
- 							  (__v8df)
- 							  _mm512_setzero_pd (),
- 							  (__mmask8) __U, __R);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_minmax_ph (__m512h __A, __m512h __B, const int __C)
- {
-   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
- 							  (__v32hf) __B,
- 							  __C,
- 							  (__v32hf)
- 							  _mm512_undefined_ph (),
- 							  (__mmask32) -1,
- 							  _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_minmax_ph (__m512h __W, __mmask32 __U, __m512h __A,
- 		       __m512h __B, const int __C)
- {
-   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
- 							  (__v32hf) __B,
- 							  __C,
- 							  (__v32hf) __W,
- 							  (__mmask32) __U,
- 							  _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_minmax_ph (__mmask32 __U, __m512h __A, __m512h __B,
- 			const int __C)
- {
-   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
- 							  (__v32hf) __B,
- 							  __C,
- 							  (__v32hf)
- 							  _mm512_setzero_ph (),
- 							  (__mmask32) __U,
- 							  _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_minmax_round_ph (__m512h __A, __m512h __B, const int __C, const int __R)
- {
-   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
- 							  (__v32hf) __B,
- 							  __C,
- 							  (__v32hf)
- 							  _mm512_undefined_ph (),
- 							  (__mmask32) -1, __R);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_minmax_round_ph (__m512h __W, __mmask32 __U, __m512h __A,
- 			     __m512h __B, const int __C, const int __R)
- {
-   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
- 							  (__v32hf) __B,
- 							  __C,
- 							  (__v32hf) __W,
- 							  (__mmask32) __U, __R);
- }
- 
- extern __inline __m512h
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_minmax_round_ph (__mmask32 __U, __m512h __A, __m512h __B,
- 			      const int __C, const int __R)
- {
-   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
- 							  (__v32hf) __B,
- 							  __C,
- 							  (__v32hf)
- 							  _mm512_setzero_ph (),
- 							  (__mmask32) __U, __R);
- }
- 
- extern __inline __m512
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_minmax_ps (__m512 __A, __m512 __B, const int __C)
- {
-   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
- 							 (__v16sf) __B,
- 							 __C,
- 							 (__v16sf)
- 							 _mm512_undefined_ps (),
- 							 (__mmask16) -1,
- 							 _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_minmax_ps (__m512 __W, __mmask16 __U, __m512 __A,
- 		       __m512 __B, const int __C)
- {
-   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
- 							 (__v16sf) __B,
- 							 __C,
- 							 (__v16sf) __W,
- 							 (__mmask16) __U,
- 							 _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_minmax_ps (__mmask16 __U, __m512 __A, __m512 __B,
- 			const int __C)
- {
-   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
- 							 (__v16sf) __B,
- 							 __C,
- 							 (__v16sf)
- 							 _mm512_setzero_ps (),
- 							 (__mmask16) __U,
- 							 _MM_FROUND_CUR_DIRECTION);
- }
- 
- extern __inline __m512
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_minmax_round_ps (__m512 __A, __m512 __B, const int __C, const int __R)
- {
-   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
- 							 (__v16sf) __B,
- 							 __C,
- 							 (__v16sf)
- 							 _mm512_undefined_ps (),
- 							 (__mmask16) -1, __R);
- }
- 
- extern __inline __m512
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_minmax_round_ps (__m512 __W, __mmask16 __U, __m512 __A,
- 			     __m512 __B, const int __C, const int __R)
- {
-   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
- 							 (__v16sf) __B,
- 							 __C,
- 							 (__v16sf) __W,
- 							 (__mmask16) __U, __R);
- }
- 
- extern __inline __m512
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_minmax_round_ps (__mmask16 __U, __m512 __A, __m512 __B,
- 			      const int __C, const int __R)
- {
-   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
- 							 (__v16sf) __B,
- 							 __C,
- 							 (__v16sf)
- 							 _mm512_setzero_ps (),
- 							 (__mmask16) __U, __R);
- }
- 
- #else
- #define _mm512_minmax_pbh(A, B, C)					      \
-   ((__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) (A),		      \
- 						 (__v32bf) (B),		      \
- 						 (int) (C),		      \
- 						 (__v32bf) (__m512bh)	      \
- 						 _mm512_setzero_si512 (),     \
- 						 (__mmask32) (-1)))
- 
- #define _mm512_mask_minmax_pbh(W, U, A, B, C)				      \
-   ((__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) (A),		      \
- 						 (__v32bf) (B), 	      \
- 						 (int) (C),		      \
- 						 (__v32bf) (__m512bh) (W),    \
- 						 (__mmask32) (U)))
- 
- #define _mm512_maskz_minmax_pbh(U, A, B, C)				      \
-   ((__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) (A),		      \
- 						 (__v32bf) (B),		      \
- 						 (int) (C),		      \
- 						 (__v32bf) (__m512bh)	      \
- 						 _mm512_setzero_si512 (),     \
- 						 (__mmask32) (U)))
- 
- #define _mm512_minmax_round_pd(A, B, C, R)				      \
-   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
- 						    (__v8df) (B),	      \
- 						    (int) (C),		      \
- 						    (__v8df) (__m512d)	      \
- 						    _mm512_undefined_pd (),   \
- 						    (__mmask8) (-1),	      \
- 						    (int) (R)))
- 
- #define _mm512_mask_minmax_round_pd(W, U, A, B, C, R)			      \
-   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
- 						    (__v8df) (B),	      \
- 						    (int) (C),		      \
- 						    (__v8df) (__m512d) (W),   \
- 						    (__mmask8) (U),	      \
- 						    (int) (R)))
- 
- #define _mm512_maskz_minmax_round_pd(U, A, B, C, R)			      \
-   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
- 						    (__v8df) (B),	      \
- 						    (int) (C),		      \
- 						    (__v8df) (__m512d)	      \
- 						    _mm512_setzero_pd (),     \
- 						    (__mmask8) (U), 	      \
- 						    (int) (R)))
- 
- #define _mm512_minmax_round_ph(A, B, C, R)				      \
-   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
- 						    (__v32hf) (B),	      \
- 						    (int) (C),		      \
- 						    (__v32hf) (__m512h)	      \
- 						    _mm512_undefined_ph (),   \
- 						    (__mmask32) (-1),	      \
- 						    (int) (R)))
- 
- #define _mm512_mask_minmax_round_ph(W, U, A, B, C, R)			      \
-   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
- 						    (__v32hf) (B),	      \
- 						    (int) (C),		      \
- 						    (__v32hf) (__m512h) (W),  \
- 						    (__mmask32) (U),	      \
- 						    (int) (R)))
- 
- #define _mm512_maskz_minmax_round_ph(U, A, B, C, R)			      \
-   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
- 						    (__v32hf) (B),	      \
- 						    (int) (C),		      \
- 						    (__v32hf) (__m512h)	      \
- 						    _mm512_setzero_ph (),     \
- 						    (__mmask32) (U),	      \
- 						    (int) (R)))
- 
- #define _mm512_minmax_round_ps(A, B, C, R)				      \
-   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
- 						   (__v16sf) (B),	      \
- 						   (int) (C),		      \
- 						   (__v16sf) (__m512)	      \
- 						   _mm512_undefined_ps (),    \
- 						   (__mmask16) (-1),	      \
- 						   (int) (R)))
- 
- #define _mm512_mask_minmax_round_ps(W, U, A, B, C, R)			      \
-   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
- 						   (__v16sf) (B),	      \
- 						   (int) (C),		      \
- 						   (__v16sf) (__m512) (W),    \
- 						   (__mmask16) (U),	      \
- 						   (int) (R)))
- 
- #define _mm512_maskz_minmax_round_ps(U, A, B, C, R)			      \
-   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A), 	      \
- 						   (__v16sf) (B),	      \
- 						   (int) (C),		      \
- 						   (__v16sf) (__m512)	      \
- 						   _mm512_setzero_ps (),      \
- 						   (__mmask16) (U),	      \
- 						   (int) (R)))
- 
- #define _mm512_minmax_pd(A, B, C)					      \
-   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
- 						    (__v8df) (B),	      \
- 						    (int) (C),		      \
- 						    (__v8df) (__m512d)	      \
- 						    _mm512_undefined_pd (),   \
- 						    (__mmask8) (-1),	      \
- 						    _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_mask_minmax_pd(W, U, A, B, C)				      \
-   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
- 						    (__v8df) (B),	      \
- 						    (int) (C),		      \
- 						    (__v8df) (__m512d) (W),   \
- 						    (__mmask8) (U),	      \
- 						    _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_maskz_minmax_pd(U, A, B, C)				      \
-   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
- 						    (__v8df) (B),	      \
- 						    (int) (C),		      \
- 						    (__v8df) (__m512d)	      \
- 						    _mm512_setzero_pd (),     \
- 						    (__mmask8) (U),	      \
- 						    _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_minmax_ph(A, B, C)					      \
-   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
- 						    (__v32hf) (B),	      \
- 						    (int) (C),		      \
- 						    (__v32hf) (__m512h)	      \
- 						    _mm512_undefined_ph (),   \
- 						    (__mmask32) (-1),	      \
- 						    _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_mask_minmax_ph(W, U, A, B, C)				      \
-   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
- 						    (__v32hf) (B),	      \
- 						    (int) (C),		      \
- 						    (__v32hf) (__m512h) (W),  \
- 						    (__mmask32) (U),	      \
- 						    _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_maskz_minmax_ph(U, A, B, C)				      \
-   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
- 						    (__v32hf) (B),	      \
- 						    (int) (C),		      \
- 						    (__v32hf) (__m512h)	      \
- 						    _mm512_setzero_ph (),     \
- 						    (__mmask32) (U),	      \
- 						    _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_minmax_ps(A, B, C)					      \
-   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
- 						   (__v16sf) (B),	      \
- 						   (int) (C),		      \
- 						   (__v16sf) (__m512)	      \
- 						   _mm512_undefined_ps (),    \
- 						   (__mmask16) (-1),	      \
- 						   _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_mask_minmax_ps(W, U, A, B, C)				      \
-   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
- 						   (__v16sf) (B),	      \
- 						   (int) (C),		      \
- 						   (__v16sf) (__m512) (W),    \
- 						   (__mmask16) (U),	      \
- 						   _MM_FROUND_CUR_DIRECTION))
- 
- #define _mm512_maskz_minmax_ps(U, A, B, C)				      \
-   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
- 						   (__v16sf) (B),	      \
- 						   (int) (C),		      \
- 						   (__v16sf) (__m512)	      \
- 						   _mm512_setzero_ps (),      \
- 						   (__mmask16) (U),	      \
- 						   _MM_FROUND_CUR_DIRECTION))
- 
- #endif
- 
- #ifdef __DISABLE_AVX10_2__
- #undef __DISABLE_AVX10_2__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX10_2__ */
- 
- #endif /* _AVX10_2_512MINMAXINTRIN_H_INCLUDED */
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2-512satcvtintrin.h gcc-16-20250525/gcc/config/i386/avx10_2-512satcvtintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2-512satcvtintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2-512satcvtintrin.h	Thu Jan  1 00:00:00 1970
***************
*** 1,1575 ****
- /* Copyright (C) 2024-2025 Free Software Foundation, Inc.
- 
-    This file is part of GCC.
- 
-    GCC is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 3, or (at your option)
-    any later version.
- 
-    GCC is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
- 
-    Under Section 7 of GPL version 3, you are granted additional
-    permissions described in the GCC Runtime Library Exception, version
-    3.1, as published by the Free Software Foundation.
- 
-    You should have received a copy of the GNU General Public License and
-    a copy of the GCC Runtime Library Exception along with this program;
-    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
-    <http://www.gnu.org/licenses/>.  */
- 
- #if !defined _IMMINTRIN_H_INCLUDED
- #error "Never use <avx10_2-512satcvtintrin.h> directly; include <immintrin.h> instead."
- #endif
- 
- #ifndef _AVX10_2_512SATCVTINTRIN_H_INCLUDED
- #define _AVX10_2_512SATCVTINTRIN_H_INCLUDED
- 
- #if !defined (__AVX10_2__)
- #pragma GCC push_options
- #pragma GCC target("avx10.2")
- #define __DISABLE_AVX10_2__
- #endif /* __AVX10_2__ */
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_bf16_epi8 (__m512bh __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtbf162ibs512_mask ((__v32bf) __A,
- 						  (__v32hi)
- 						  _mm512_undefined_si512 (),
- 						  (__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_bf16_epi8 (__m512i __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512i) __builtin_ia32_cvtbf162ibs512_mask ((__v32bf) __A,
- 						       (__v32hi) __W,
- 						       (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_bf16_epi8 (__mmask32 __U, __m512bh __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtbf162ibs512_mask ((__v32bf) __A,
- 						  (__v32hi)
- 						  _mm512_setzero_si512 (),
- 						  (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_bf16_epu8 (__m512bh __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtbf162iubs512_mask ((__v32bf) __A,
- 						   (__v32hi)
- 						   _mm512_undefined_si512 (),
- 						   (__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_bf16_epu8 (__m512i __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512i) __builtin_ia32_cvtbf162iubs512_mask ((__v32bf) __A,
- 							(__v32hi) __W,
- 							(__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_bf16_epu8 (__mmask32 __U, __m512bh __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtbf162iubs512_mask ((__v32bf) __A,
- 						   (__v32hi)
- 						   _mm512_setzero_si512 (),
- 						   (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_bf16_epi8 (__m512bh __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvttbf162ibs512_mask ((__v32bf) __A,
- 						   (__v32hi)
- 						   _mm512_undefined_si512 (),
- 						   (__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_bf16_epi8 (__m512i __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512i) __builtin_ia32_cvttbf162ibs512_mask ((__v32bf) __A,
- 							(__v32hi) __W,
- 							(__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_bf16_epi8 (__mmask32 __U, __m512bh __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvttbf162ibs512_mask ((__v32bf) __A,
- 						   (__v32hi)
- 						   _mm512_setzero_si512 (),
- 						   (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_bf16_epu8 (__m512bh __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttbf162iubs512_mask ((__v32bf) __A,
- 					  (__v32hi) _mm512_undefined_si512 (),
- 					  (__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_bf16_epu8 (__m512i __W, __mmask32 __U, __m512bh __A)
- {
-   return (__m512i) __builtin_ia32_cvttbf162iubs512_mask ((__v32bf) __A,
- 							 (__v32hi) __W,
- 							 (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_bf16_epu8 (__mmask32 __U, __m512bh __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttbf162iubs512_mask ((__v32bf) __A,
- 					  (__v32hi)
- 					  _mm512_setzero_si512 (),
- 					  (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_ph_epi8 (__m512h __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2ibs512_mask ((__v32hf) __A,
- 						(__v32hi)
- 						_mm512_undefined_si512 (),
- 						(__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_ph_epi8 (__m512i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m512i) __builtin_ia32_cvtph2ibs512_mask ((__v32hf) __A,
- 						     (__v32hi) __W,
- 						     (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_ph_epi8 (__mmask32 __U, __m512h __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2ibs512_mask ((__v32hf) __A,
- 						(__v32hi)
- 						_mm512_setzero_si512 (),
- 						(__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_ph_epu8 (__m512h __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2iubs512_mask ((__v32hf) __A,
- 						 (__v32hi)
- 						 _mm512_undefined_si512 (),
- 						 (__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_ph_epu8 (__m512i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m512i) __builtin_ia32_cvtph2iubs512_mask ((__v32hf) __A,
- 						      (__v32hi) __W,
- 						      (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_ph_epu8 (__mmask32 __U, __m512h __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2iubs512_mask ((__v32hf) __A,
- 						 (__v32hi)
- 						 _mm512_setzero_si512 (),
- 						 (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_ps_epi8 (__m512 __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2ibs512_mask ((__v16sf) __A,
- 						(__v16si)
- 						_mm512_undefined_si512 (),
- 						(__mmask16) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_ps_epi8 (__m512i __W, __mmask16 __U, __m512 __A)
- {
-   return (__m512i) __builtin_ia32_cvtps2ibs512_mask ((__v16sf) __A,
- 						     (__v16si) __W,
- 						     (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_ps_epi8 (__mmask16 __U, __m512 __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2ibs512_mask ((__v16sf) __A,
- 						(__v16si)
- 						_mm512_setzero_si512 (),
- 						(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_ps_epu8 (__m512 __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2iubs512_mask ((__v16sf) __A,
- 						 (__v16si)
- 						 _mm512_undefined_si512 (),
- 						 (__mmask16) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_ps_epu8 (__m512i __W, __mmask16 __U, __m512 __A)
- {
-   return (__m512i) __builtin_ia32_cvtps2iubs512_mask ((__v16sf) __A,
- 						      (__v16si) __W,
- 						      (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_ps_epu8 (__mmask16 __U, __m512 __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2iubs512_mask ((__v16sf) __A,
- 						 (__v16si)
- 						 _mm512_setzero_si512 (),
- 						 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_ph_epi8 (__m512h __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttph2ibs512_mask ((__v32hf) __A,
- 				       (__v32hi)
- 				       _mm512_undefined_si512 (),
- 				       (__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_ph_epi8 (__m512i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m512i) __builtin_ia32_cvttph2ibs512_mask ((__v32hf) __A,
- 						      (__v32hi) __W,
- 						      (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_ph_epi8 (__mmask32 __U, __m512h __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvttph2ibs512_mask ((__v32hf) __A,
- 						 (__v32hi)
- 						 _mm512_setzero_si512 (),
- 						 (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_ph_epu8 (__m512h __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttph2iubs512_mask ((__v32hf) __A,
- 					(__v32hi)
- 					_mm512_undefined_si512 (),
- 					(__mmask32) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_ph_epu8 (__m512i __W, __mmask32 __U, __m512h __A)
- {
-   return (__m512i) __builtin_ia32_cvttph2iubs512_mask ((__v32hf) __A,
- 						       (__v32hi) __W,
- 						       (__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_ph_epu8 (__mmask32 __U, __m512h __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttph2iubs512_mask ((__v32hf) __A,
- 					(__v32hi)
- 					_mm512_setzero_si512 (),
- 					(__mmask32) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_ps_epi8 (__m512 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2ibs512_mask ((__v16sf) __A,
- 				       (__v16si)
- 				       _mm512_undefined_si512 (),
- 				       (__mmask16) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_ps_epi8 (__m512i __W, __mmask16 __U, __m512 __A)
- {
-   return (__m512i) __builtin_ia32_cvttps2ibs512_mask ((__v16sf) __A,
- 						      (__v16si) __W,
- 						      (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_ps_epi8 (__mmask16 __U, __m512 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2ibs512_mask ((__v16sf) __A,
- 				       (__v16si)
- 				       _mm512_setzero_si512 (),
- 				       (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_ps_epu8 (__m512 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2iubs512_mask ((__v16sf) __A,
- 					(__v16si)
- 					_mm512_undefined_si512 (),
- 					(__mmask16) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_ps_epu8 (__m512i __W, __mmask16 __U, __m512 __A)
- {
-   return (__m512i) __builtin_ia32_cvttps2iubs512_mask ((__v16sf) __A,
- 						       (__v16si) __W,
- 						       (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_ps_epu8 (__mmask16 __U, __m512 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2iubs512_mask ((__v16sf) __A,
- 					(__v16si)
- 					_mm512_setzero_si512 (),
- 					(__mmask16) __U);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_pd_epi32 (__m512d __A)
- {
-   return (__m256i)
-     __builtin_ia32_cvttpd2dqs512_mask ((__v8df) __A,
- 				       (__v8si)
- 				       _mm256_undefined_si256 (),
- 				       (__mmask8) -1);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_pd_epi32 (__m256i __W, __mmask8 __U, __m512d __A)
- {
-   return (__m256i) __builtin_ia32_cvttpd2dqs512_mask ((__v8df) __A,
- 						      (__v8si) __W,
- 						      (__mmask8) __U);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_pd_epi32 (__mmask8 __U, __m512d __A)
- {
-   return
-     (__m256i) __builtin_ia32_cvttpd2dqs512_mask ((__v8df) __A,
- 						 (__v8si)
- 						 _mm256_setzero_si256 (),
- 						 (__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_pd_epi64 (__m512d __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttpd2qqs512_mask ((__v8df) __A,
- 				       (__v8di)
- 				       _mm512_undefined_si512 (),
- 				       (__mmask8) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_pd_epi64 (__m512i __W, __mmask8 __U, __m512d __A)
- {
-   return (__m512i) __builtin_ia32_cvttpd2qqs512_mask ((__v8df) __A,
- 						      (__v8di) __W,
- 						      (__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_pd_epi64 (__mmask8 __U, __m512d __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvttpd2qqs512_mask ((__v8df) __A,
- 						 (__v8di)
- 						 _mm512_setzero_si512 (),
- 						 (__mmask8) __U);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_pd_epu32 (__m512d __A)
- {
-   return (__m256i)
-     __builtin_ia32_cvttpd2udqs512_mask ((__v8df) __A,
- 					(__v8si)
- 					_mm256_undefined_si256 (),
- 					(__mmask8) -1);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_pd_epu32 (__m256i __W, __mmask8 __U, __m512d __A)
- {
-   return (__m256i) __builtin_ia32_cvttpd2udqs512_mask ((__v8df) __A,
- 						       (__v8si) __W,
- 						       (__mmask8) __U);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_pd_epu32 (__mmask8 __U, __m512d __A)
- {
-   return
-     (__m256i) __builtin_ia32_cvttpd2udqs512_mask ((__v8df) __A,
- 						  (__v8si)
- 						  _mm256_setzero_si256 (),
- 						  (__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_pd_epu64 (__m512d __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttpd2uqqs512_mask ((__v8df) __A,
- 					(__v8di)
- 					_mm512_undefined_si512 (),
- 					(__mmask8) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_pd_epu64 (__m512i __W, __mmask8 __U, __m512d __A)
- {
-   return (__m512i) __builtin_ia32_cvttpd2uqqs512_mask ((__v8df) __A,
- 						       (__v8di) __W,
- 						       (__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_pd_epu64 (__mmask8 __U, __m512d __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttpd2uqqs512_mask ((__v8df) __A,
- 					(__v8di)
- 					_mm512_setzero_si512 (),
- 					(__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_ps_epi32 (__m512 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2dqs512_mask ((__v16sf) __A,
- 				       (__v16si)
- 				       _mm512_undefined_si512 (),
- 				       (__mmask16) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_ps_epi32 (__m512i __W, __mmask16 __U, __m512 __A)
- {
-   return (__m512i) __builtin_ia32_cvttps2dqs512_mask ((__v16sf) __A,
- 						      (__v16si) __W,
- 						      (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_ps_epi32 (__mmask16 __U, __m512 __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvttps2dqs512_mask ((__v16sf) __A,
- 						 (__v16si)
- 						 _mm512_setzero_si512 (),
- 						 (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_ps_epi64 (__m256 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2qqs512_mask ((__v8sf) __A,
- 				       (__v8di)
- 				       _mm512_undefined_si512 (),
- 				       (__mmask8) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_ps_epi64 (__m512i __W, __mmask8 __U, __m256 __A)
- {
-   return (__m512i) __builtin_ia32_cvttps2qqs512_mask ((__v8sf) __A,
- 						      (__v8di) __W,
- 						      (__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_ps_epi64 (__mmask8 __U, __m256 __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvttps2qqs512_mask ((__v8sf) __A,
- 						 (__v8di)
- 						 _mm512_setzero_si512 (),
- 						 (__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_ps_epu32 (__m512 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2udqs512_mask ((__v16sf) __A,
- 					(__v16si)
- 					_mm512_undefined_si512 (),
- 					(__mmask16) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_ps_epu32 (__m512i __W, __mmask16 __U, __m512 __A)
- {
-   return (__m512i) __builtin_ia32_cvttps2udqs512_mask ((__v16sf) __A,
- 						       (__v16si) __W,
- 						       (__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_ps_epu32 (__mmask16 __U, __m512 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2udqs512_mask ((__v16sf) __A,
- 					(__v16si)
- 					_mm512_setzero_si512 (),
- 					(__mmask16) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_ps_epu64 (__m256 __A)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2uqqs512_mask ((__v8sf) __A,
- 					(__v8di)
- 					_mm512_undefined_si512 (),
- 					(__mmask8) -1);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_ps_epu64 (__m512i __W, __mmask8 __U, __m256 __A)
- {
-   return (__m512i) __builtin_ia32_cvttps2uqqs512_mask ((__v8sf) __A,
- 						       (__v8di) __W,
- 						       (__mmask8) __U);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_ps_epu64 (__mmask8 __U, __m256 __A)
- {
-   return
-     (__m512i) __builtin_ia32_cvttps2uqqs512_mask ((__v8sf) __A,
- 						  (__v8di)
- 						  _mm512_setzero_si512 (),
- 						  (__mmask8) __U);
- }
- 
- #ifdef __OPTIMIZE__
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_roundph_epi8 (__m512h __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) __A,
- 						      (__v32hi)
- 						      _mm512_undefined_si512 (),
- 						      (__mmask32) -1,
- 						      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_roundph_epi8 (__m512i __W, __mmask32 __U, __m512h __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) __A,
- 							   (__v32hi) __W,
- 							   (__mmask32) __U,
- 							   __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_roundph_epi8 (__mmask32 __U, __m512h __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) __A,
- 						      (__v32hi)
- 						      _mm512_setzero_si512 (),
- 						      (__mmask32) __U,
- 						      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_roundph_epu8 (__m512h __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) __A,
- 						       (__v32hi)
- 						       _mm512_undefined_si512 (),
- 						       (__mmask32) -1,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_roundph_epu8 (__m512i __W, __mmask32 __U, __m512h __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) __A,
- 							    (__v32hi) __W,
- 							    (__mmask32) __U,
- 							    __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_roundph_epu8 (__mmask32 __U, __m512h __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) __A,
- 						       (__v32hi)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask32) __U,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_roundps_epi8 (__m512 __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) __A,
- 						      (__v16si)
- 						      _mm512_undefined_si512 (),
- 						      (__mmask16) -1,
- 						      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_roundps_epi8 (__m512i __W, __mmask16 __U, __m512 __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) __A,
- 							   (__v16si) __W,
- 							   (__mmask16) __U,
- 							   __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_roundps_epi8 (__mmask16 __U, __m512 __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) __A,
- 						      (__v16si)
- 						      _mm512_setzero_si512 (),
- 						      (__mmask16) __U,
- 						      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvts_roundps_epu8 (__m512 __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) __A,
- 						       (__v16si)
- 						       _mm512_undefined_si512 (),
- 						       (__mmask16) -1,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvts_roundps_epu8 (__m512i __W, __mmask16 __U, __m512 __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) __A,
- 							    (__v16si) __W,
- 							    (__mmask16) __U,
- 							    __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvts_roundps_epu8 (__mmask16 __U, __m512 __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) __A,
- 						       (__v16si)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask16) __U,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_roundph_epi8 (__m512h __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) __A,
- 					     (__v32hi)
- 					     _mm512_undefined_si512 (),
- 					     (__mmask32) -1,
- 					     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_roundph_epi8 (__m512i __W, __mmask32 __U, __m512h __A,
- 				  const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) __A,
- 							    (__v32hi) __W,
- 							    (__mmask32) __U,
- 							    __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_roundph_epi8 (__mmask32 __U, __m512h __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) __A,
- 						       (__v32hi)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask32) __U,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_roundph_epu8 (__m512h __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) __A,
- 					      (__v32hi)
- 					      _mm512_undefined_si512 (),
- 					      (__mmask32) -1,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_roundph_epu8 (__m512i __W, __mmask32 __U, __m512h __A,
- 				  const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) __A,
- 							     (__v32hi) __W,
- 							     (__mmask32) __U,
- 							     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_roundph_epu8 (__mmask32 __U, __m512h __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) __A,
- 					      (__v32hi)
- 					      _mm512_setzero_si512 (),
- 					      (__mmask32) __U,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_roundps_epi8 (__m512 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) __A,
- 					     (__v16si)
- 					     _mm512_undefined_si512 (),
- 					     (__mmask16) -1,
- 					     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_roundps_epi8 (__m512i __W, __mmask16 __U, __m512 __A,
- 				  const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) __A,
- 							    (__v16si) __W,
- 							    (__mmask16) __U,
- 							    __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_roundps_epi8 (__mmask16 __U, __m512 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) __A,
- 					     (__v16si)
- 					     _mm512_setzero_si512 (),
- 					     (__mmask16) __U,
- 					     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_ipcvtts_roundps_epu8 (__m512 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) __A,
- 					      (__v16si)
- 					      _mm512_undefined_si512 (),
- 					      (__mmask16) -1,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_ipcvtts_roundps_epu8 (__m512i __W, __mmask16 __U, __m512 __A,
- 				  const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) __A,
- 							     (__v16si) __W,
- 							     (__mmask16) __U,
- 							     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_ipcvtts_roundps_epu8 (__mmask16 __U, __m512 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) __A,
- 					      (__v16si)
- 					      _mm512_setzero_si512 (),
- 					      (__mmask16) __U,
- 					      __R);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundpd_epi32 (__m512d __A, const int __R)
- {
-   return (__m256i)
-     __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) __A,
- 					     (__v8si)
- 					     _mm256_undefined_si256 (),
- 					     (__mmask8) -1,
- 					     __R);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundpd_epi32 (__m256i __W, __mmask8 __U, __m512d __A,
- 				 const int __R)
- {
-   return (__m256i) __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) __A,
- 							    (__v8si) __W,
- 							    (__mmask8) __U,
- 							    __R);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundpd_epi32 (__mmask8 __U, __m512d __A, const int __R)
- {
-   return
-     (__m256i) __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) __A,
- 						       (__v8si)
- 						       _mm256_setzero_si256 (),
- 						       (__mmask8) __U,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundpd_epi64 (__m512d __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) __A,
- 					     (__v8di)
- 					     _mm512_undefined_si512 (),
- 					     (__mmask8) -1,
- 					     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundpd_epi64 (__m512i __W, __mmask8 __U, __m512d __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) __A,
- 							    (__v8di) __W,
- 							    (__mmask8) __U,
- 							    __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundpd_epi64 (__mmask8 __U, __m512d __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) __A,
- 						       (__v8di)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask8) __U,
- 						       __R);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundpd_epu32 (__m512d __A, const int __R)
- {
-   return (__m256i)
-     __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) __A,
- 					      (__v8si)
- 					      _mm256_undefined_si256 (),
- 					      (__mmask8) -1,
- 					      __R);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundpd_epu32 (__m256i __W, __mmask8 __U, __m512d __A,
- 				 const int __R)
- {
-   return (__m256i) __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) __A,
- 							     (__v8si) __W,
- 							     (__mmask8) __U,
- 							     __R);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundpd_epu32 (__mmask8 __U, __m512d __A, const int __R)
- {
-   return
-     (__m256i) __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) __A,
- 							(__v8si)
- 							_mm256_setzero_si256 (),
- 							(__mmask8) __U,
- 							__R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundpd_epu64 (__m512d __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) __A,
- 					      (__v8di)
- 					      _mm512_undefined_si512 (),
- 					      (__mmask8) -1,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundpd_epu64 (__m512i __W, __mmask8 __U, __m512d __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) __A,
- 							     (__v8di) __W,
- 							     (__mmask8) __U,
- 							     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundpd_epu64 (__mmask8 __U, __m512d __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) __A,
- 					      (__v8di)
- 					      _mm512_setzero_si512 (),
- 					      (__mmask8) __U,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundps_epi32 (__m512 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) __A,
- 					     (__v16si)
- 					     _mm512_undefined_si512 (),
- 					     (__mmask16) -1,
- 					     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundps_epi32 (__m512i __W, __mmask16 __U, __m512 __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) __A,
- 							    (__v16si) __W,
- 							    (__mmask16) __U,
- 							    __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundps_epi32 (__mmask16 __U, __m512 __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) __A,
- 						       (__v16si)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask16) __U,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundps_epi64 (__m256 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) __A,
- 					     (__v8di)
- 					     _mm512_undefined_si512 (),
- 					     (__mmask8) -1,
- 					     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundps_epi64 (__m512i __W, __mmask8 __U, __m256 __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) __A,
- 							    (__v8di) __W,
- 							    (__mmask8) __U,
- 							    __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundps_epi64 (__mmask8 __U, __m256 __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) __A,
- 						       (__v8di)
- 						       _mm512_setzero_si512 (),
- 						       (__mmask8) __U,
- 						       __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundps_epu32 (__m512 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) __A,
- 					      (__v16si)
- 					      _mm512_undefined_si512 (),
- 					      (__mmask16) -1,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundps_epu32 (__m512i __W, __mmask16 __U, __m512 __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) __A,
- 							     (__v16si) __W,
- 							     (__mmask16) __U,
- 							     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundps_epu32 (__mmask16 __U, __m512 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) __A,
- 					      (__v16si)
- 					      _mm512_setzero_si512 (),
- 					      (__mmask16) __U,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_cvtts_roundps_epu64 (__m256 __A, const int __R)
- {
-   return (__m512i)
-     __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) __A,
- 					      (__v8di)
- 					      _mm512_undefined_si512 (),
- 					      (__mmask8) -1,
- 					      __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_mask_cvtts_roundps_epu64 (__m512i __W, __mmask8 __U, __m256 __A,
- 				 const int __R)
- {
-   return (__m512i) __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) __A,
- 							     (__v8di) __W,
- 							     (__mmask8) __U,
- 							     __R);
- }
- 
- extern __inline __m512i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm512_maskz_cvtts_roundps_epu64 (__mmask8 __U, __m256 __A, const int __R)
- {
-   return
-     (__m512i) __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) __A,
- 							(__v8di)
- 							_mm512_setzero_si512 (),
- 							(__mmask8) __U,
- 							__R);
- }
- #else
- #define _mm512_ipcvts_roundph_epi8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) (A), \
- 					   (__v32hi) \
- 					   (_mm512_undefined_si512 ()), \
- 					   (__mmask32) (-1), \
- 					   (R)))
- 
- #define _mm512_mask_ipcvts_roundph_epi8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) (A), \
- 						     (__v32hi) (W), \
- 						     (__mmask32) (U), \
- 						     (R)))
- 
- #define _mm512_maskz_ipcvts_roundph_epi8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) (A), \
- 					   (__v32hi) \
- 					   (_mm512_setzero_si512 ()), \
- 					   (__mmask32) (U), \
- 					   (R)))
- 
- #define _mm512_ipcvts_roundph_epu8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) (A), \
- 					    (__v32hi) \
- 					    (_mm512_undefined_si512 ()), \
- 					    (__mmask32) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_ipcvts_roundph_epu8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) (A), \
- 						      (__v32hi) (W), \
- 						      (__mmask32) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_ipcvts_roundph_epu8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) (A), \
- 					    (__v32hi) \
- 					    (_mm512_setzero_si512 ()), \
- 					    (__mmask32) (U), \
- 					    (R)))
- 
- #define _mm512_ipcvts_roundps_epi8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) (A), \
- 					   (__v16si) \
- 					   (_mm512_undefined_si512 ()), \
- 					   (__mmask16) (-1), \
- 					   (R)))
- 
- #define _mm512_mask_ipcvts_roundps_epi8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) (A), \
- 						     (__v16si) (W), \
- 						     (__mmask16) (U), \
- 						     (R)))
- 
- #define _mm512_maskz_ipcvts_roundps_epi8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) (A), \
- 					   (__v16si) \
- 					   (_mm512_setzero_si512 ()), \
- 					   (__mmask16) (U), \
- 					   (R)))
- 
- #define _mm512_ipcvts_roundps_epu8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) (A), \
- 					    (__v16si) \
- 					    (_mm512_undefined_si512 ()), \
- 					    (__mmask16) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_ipcvts_roundps_epu8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) (A), \
- 						      (__v16si) (W), \
- 						      (__mmask16) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_ipcvts_roundps_epu8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) (A), \
- 					    (__v16si) \
- 					    (_mm512_setzero_si512 ()), \
- 					    (__mmask16) (U), \
- 					    (R)))
- 
- #define _mm512_ipcvtts_roundph_epi8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) (A), \
- 					    (__v32hi) \
- 					    (_mm512_undefined_si512 ()), \
- 					    (__mmask32) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_ipcvtts_roundph_epi8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) (A), \
- 						      (__v32hi) (W), \
- 						      (__mmask32) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_ipcvtts_roundph_epi8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) (A), \
- 					    (__v32hi) \
- 					    (_mm512_setzero_si512 ()), \
- 					    (__mmask32) (U), \
- 					    (R)))
- 
- #define _mm512_ipcvtts_roundph_epu8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) (A), \
- 					     (__v32hi) \
- 					     (_mm512_undefined_si512 ()), \
- 					     (__mmask32) (-1), \
- 					     (R)))
- 
- #define _mm512_mask_ipcvtts_roundph_epu8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) (A), \
- 						       (__v32hi) (W), \
- 						       (__mmask32) (U), \
- 						       (R)))
- 
- #define _mm512_maskz_ipcvtts_roundph_epu8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) (A), \
- 					     (__v32hi) \
- 					     (_mm512_setzero_si512 ()), \
- 					     (__mmask32) (U), \
- 					     (R)))
- 
- #define _mm512_ipcvtts_roundps_epi8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) (A), \
- 					    (__v16si) \
- 					    (_mm512_undefined_si512 ()), \
- 					    (__mmask16) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_ipcvtts_roundps_epi8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) (A), \
- 						      (__v16si) (W), \
- 						      (__mmask16) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_ipcvtts_roundps_epi8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) (A), \
- 					    (__v16si) \
- 					    (_mm512_setzero_si512 ()), \
- 					    (__mmask16) (U), \
- 					    (R)))
- 
- #define _mm512_ipcvtts_roundps_epu8(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) (A), \
- 					     (__v16si) \
- 					     (_mm512_undefined_si512 ()), \
- 					     (__mmask16) (-1), \
- 					     (R)))
- 
- #define _mm512_mask_ipcvtts_roundps_epu8(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) (A), \
- 						       (__v16si) (W), \
- 						       (__mmask16) (U), \
- 						       (R)))
- 
- #define _mm512_maskz_ipcvtts_roundps_epu8(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) (A), \
- 					     (__v16si) \
- 					     (_mm512_setzero_si512 ()), \
- 					     (__mmask16) (U), \
- 					     (R)))
- 
- #define _mm512_cvtts_roundpd_epi32(A, R) \
-   ((__m256i) \
-    __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) (A), \
- 					    (__v8si) \
- 					    (_mm256_undefined_si256 ()), \
- 					    (__mmask8) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_cvtts_roundpd_epi32(W, U, A, R) \
-   ((__m256i) __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) (A), \
- 						      (__v8si) (W), \
- 						      (__mmask8) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_cvtts_roundpd_epi32(U, A, R) \
-   ((__m256i) \
-    __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) (A), \
- 					    (__v8si) \
- 					    (_mm256_setzero_si256 ()), \
- 					    (__mmask8) (U), \
- 					    (R)))
- 
- #define _mm512_cvtts_roundpd_epi64(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) (A), \
- 					    (__v8di) \
- 					    (_mm512_undefined_si512 ()), \
- 					    (__mmask8) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_cvtts_roundpd_epi64(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) (A), \
- 						      (__v8di) (W), \
- 						      (__mmask8) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_cvtts_roundpd_epi64(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) (A), \
- 					    (__v8di) \
- 					    (_mm512_setzero_si512 ()), \
- 					    (__mmask8) (U), \
- 					    (R)))
- 
- #define _mm512_cvtts_roundpd_epu32(A, R) \
-   ((__m256i) \
-    __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) (A), \
- 					     (__v8si) \
- 					     (_mm256_undefined_si256 ()), \
- 					     (__mmask8) (-1), \
- 					     (R)))
- 
- #define _mm512_mask_cvtts_roundpd_epu32(W, U, A, R) \
-   ((__m256i) __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) (A), \
- 						       (__v8si) (W), \
- 						       (__mmask8) (U), \
- 						       (R)))
- 
- #define _mm512_maskz_cvtts_roundpd_epu32(U, A, R) \
-   ((__m256i) \
-    __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) (A), \
- 					     (__v8si) \
- 					     (_mm256_setzero_si256 ()), \
- 					     (__mmask8) (U), \
- 					     (R)))
- 
- #define _mm512_cvtts_roundpd_epu64(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) (A), \
- 					     (__v8di) \
- 					     (_mm512_undefined_si512 ()), \
- 					     (__mmask8) (-1), \
- 					     (R)))
- 
- #define _mm512_mask_cvtts_roundpd_epu64(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) (A), \
- 						       (__v8di) (W), \
- 						       (__mmask8) (U), \
- 						       (R)))
- 
- #define _mm512_maskz_cvtts_roundpd_epu64(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) (A), \
- 					     (__v8di) \
- 					     (_mm512_setzero_si512 ()), \
- 					     (__mmask8) (U), \
- 					     (R)))
- 
- #define _mm512_cvtts_roundps_epi32(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) (A), \
- 					    (__v16si) \
- 					    (_mm512_undefined_si512 ()), \
- 					    (__mmask16) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_cvtts_roundps_epi32(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) (A), \
- 						      (__v16si) (W), \
- 						      (__mmask16) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_cvtts_roundps_epi32(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) (A), \
- 					    (__v16si) \
- 					    (_mm512_setzero_si512 ()), \
- 					    (__mmask16) (U), \
- 					    (R)))
- 
- #define _mm512_cvtts_roundps_epi64(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) (A), \
- 					    (__v8di) \
- 					    (_mm512_undefined_si512 ()), \
- 					    (__mmask8) (-1), \
- 					    (R)))
- 
- #define _mm512_mask_cvtts_roundps_epi64(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) (A), \
- 						      (__v8di) (W), \
- 						      (__mmask8) (U), \
- 						      (R)))
- 
- #define _mm512_maskz_cvtts_roundps_epi64(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) (A), \
- 					    (__v8di) \
- 					    (_mm512_setzero_si512 ()), \
- 					    (__mmask8) (U), \
- 					    (R)))
- 
- #define _mm512_cvtts_roundps_epu32(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) (A), \
- 					     (__v16si) \
- 					     (_mm512_undefined_si512 ()), \
- 					     (__mmask16) (-1), \
- 					     (R)))
- 
- #define _mm512_mask_cvtts_roundps_epu32(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) (A), \
- 						       (__v16si) (W), \
- 						       (__mmask16) (U), \
- 						       (R)))
- 
- #define _mm512_maskz_cvtts_roundps_epu32(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) (A), \
- 					     (__v16si) \
- 					     (_mm512_setzero_si512 ()), \
- 					     (__mmask16) (U), \
- 					     (R)))
- 
- #define _mm512_cvtts_roundps_epu64(A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) (A), \
- 					     (__v8di) \
- 					     (_mm512_undefined_si512 ()), \
- 					     (__mmask8) (-1), \
- 					     (R)))
- 
- #define _mm512_mask_cvtts_roundps_epu64(W, U, A, R) \
-   ((__m512i) __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) (A), \
- 						       (__v8di) (W), \
- 						       (__mmask8) (U), \
- 						       (R)))
- 
- #define _mm512_maskz_cvtts_roundps_epu64(U, A, R) \
-   ((__m512i) \
-    __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) (A), \
- 					     (__v8di) \
- 					     (_mm512_setzero_si512 ()), \
- 					     (__mmask8) (U), \
- 					     (R)))
- #endif
- 
- #ifdef __DISABLE_AVX10_2__
- #undef __DISABLE_AVX10_2__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX10_2__ */
- 
- #endif /* _AVX10_2_512SATCVTINTRIN_H_INCLUDED */
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2bf16intrin.h gcc-16-20250525/gcc/config/i386/avx10_2bf16intrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2bf16intrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2bf16intrin.h	Sun May 25 22:32:05 2025
***************
*** 34,39 ****
--- 34,65 ----
  #define __DISABLE_AVX10_2__
  #endif /* __AVX10_2__ */
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_add_pbh (__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh) __builtin_ia32_addbf16512 (__A, __B);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_add_pbh (__m512bh __W, __mmask32 __U,
+ 		     __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_addbf16512_mask (__A, __B, __W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_add_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_addbf16512_mask (__A, __B,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_add_pbh (__m256bh __A, __m256bh __B)
*************** _mm_maskz_add_pbh (__mmask8 __U, __m128b
*** 86,91 ****
--- 112,143 ----
  				    __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_sub_pbh (__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh) __builtin_ia32_subbf16512 (__A, __B);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_sub_pbh (__m512bh __W, __mmask32 __U,
+ 		     __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_subbf16512_mask (__A, __B, __W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_sub_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_subbf16512_mask (__A, __B,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_sub_pbh (__m256bh __A, __m256bh __B)
*************** _mm_maskz_sub_pbh (__mmask8 __U, __m128b
*** 138,143 ****
--- 190,221 ----
  				    __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mul_pbh (__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh) __builtin_ia32_mulbf16512 (__A, __B);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_mul_pbh (__m512bh __W, __mmask32 __U,
+ 		     __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_mulbf16512_mask (__A, __B, __W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_mul_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_mulbf16512_mask (__A, __B,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_mul_pbh (__m256bh __A, __m256bh __B)
*************** _mm_maskz_mul_pbh (__mmask8 __U, __m128b
*** 190,195 ****
--- 268,299 ----
  				    __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_div_pbh (__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh) __builtin_ia32_divbf16512 (__A, __B);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_div_pbh (__m512bh __W, __mmask32 __U,
+ 		     __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_divbf16512_mask (__A, __B, __W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_div_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_divbf16512_mask (__A, __B,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_div_pbh (__m256bh __A, __m256bh __B)
*************** _mm_maskz_div_pbh (__mmask8 __U, __m128b
*** 242,247 ****
--- 346,377 ----
  				    __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_max_pbh (__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh) __builtin_ia32_maxbf16512 (__A, __B);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_max_pbh (__m512bh __W, __mmask32 __U,
+ 		     __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_maxbf16512_mask (__A, __B, __W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_max_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_maxbf16512_mask (__A, __B,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_max_pbh (__m256bh __A, __m256bh __B)
*************** _mm_maskz_max_pbh (__mmask8 __U, __m128b
*** 294,299 ****
--- 424,455 ----
  				    __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_min_pbh (__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh) __builtin_ia32_minbf16512 (__A, __B);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_min_pbh (__m512bh __W, __mmask32 __U,
+ 		     __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_minbf16512_mask (__A, __B, __W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_min_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_minbf16512_mask (__A, __B,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_min_pbh (__m256bh __A, __m256bh __B)
*************** _mm_maskz_min_pbh (__mmask8 __U, __m128b
*** 346,351 ****
--- 502,533 ----
  				    __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_scalef_pbh (__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh) __builtin_ia32_scalefbf16512 (__A, __B);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_scalef_pbh (__m512bh __W, __mmask32 __U,
+ 			__m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_scalefbf16512_mask (__A, __B, __W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_scalef_pbh (__mmask32 __U, __m512bh __A, __m512bh __B)
+ {
+   return (__m512bh)
+     __builtin_ia32_scalefbf16512_mask (__A, __B,
+ 				       (__v32bf) _mm512_setzero_si512 (),
+ 				       __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_scalef_pbh (__m256bh __A, __m256bh __B)
*************** _mm_maskz_scalef_pbh (__mmask8 __U, __m1
*** 398,403 ****
--- 580,620 ----
  				       __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_fmadd_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmaddbf16512_mask (__A, __B, __C, (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_fmadd_pbh (__m512bh __A, __mmask32 __U,
+ 		       __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmaddbf16512_mask (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask3_fmadd_pbh (__m512bh __A, __m512bh __B,
+ 			__m512bh __C, __mmask32 __U)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmaddbf16512_mask3 (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_fmadd_pbh (__mmask32 __U, __m512bh __A,
+ 			  __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmaddbf16512_maskz (__A, __B, __C, __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_fmadd_pbh (__m256bh __A, __m256bh __B, __m256bh __C)
*************** _mm_maskz_fmadd_pbh (__mmask8 __U, __m12
*** 468,473 ****
--- 685,725 ----
      __builtin_ia32_fmaddbf16128_maskz (__A, __B, __C, __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_fmsub_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmsubbf16512_mask (__A, __B, __C, (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_fmsub_pbh (__m512bh __A, __mmask32 __U,
+ 		       __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmsubbf16512_mask (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask3_fmsub_pbh (__m512bh __A, __m512bh __B,
+ 			__m512bh __C, __mmask32 __U)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmsubbf16512_mask3 (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_fmsub_pbh (__mmask32 __U, __m512bh __A,
+ 			__m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fmsubbf16512_maskz (__A, __B, __C, __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_fmsub_pbh (__m256bh __A, __m256bh __B, __m256bh __C)
*************** _mm_maskz_fmsub_pbh (__mmask8 __U, __m12
*** 537,542 ****
--- 789,829 ----
      __builtin_ia32_fmsubbf16128_maskz (__A, __B, __C, __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_fnmadd_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmaddbf16512_mask (__A, __B, __C, (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_fnmadd_pbh (__m512bh __A, __mmask32 __U,
+ 			__m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmaddbf16512_mask (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask3_fnmadd_pbh (__m512bh __A, __m512bh __B,
+ 			 __m512bh __C, __mmask32 __U)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmaddbf16512_mask3 (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_fnmadd_pbh (__mmask32 __U, __m512bh __A,
+ 			 __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmaddbf16512_maskz (__A, __B, __C, __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_fnmadd_pbh (__m256bh __A, __m256bh __B, __m256bh __C)
*************** _mm_maskz_fnmadd_pbh (__mmask8 __U, __m1
*** 607,612 ****
--- 894,934 ----
      __builtin_ia32_fnmaddbf16128_maskz (__A, __B, __C, __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_fnmsub_pbh (__m512bh __A, __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmsubbf16512_mask (__A, __B, __C, (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_fnmsub_pbh (__m512bh __A, __mmask32 __U,
+ 			__m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmsubbf16512_mask (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask3_fnmsub_pbh (__m512bh __A, __m512bh __B,
+ 			 __m512bh __C, __mmask32 __U)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmsubbf16512_mask3 (__A, __B, __C, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_fnmsub_pbh (__mmask32 __U, __m512bh __A,
+ 			 __m512bh __B, __m512bh __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_fnmsubbf16512_maskz (__A, __B, __C, __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_fnmsub_pbh (__m256bh __A, __m256bh __B, __m256bh __C)
*************** _mm_maskz_fnmsub_pbh (__mmask8 __U, __m1
*** 677,682 ****
--- 999,1033 ----
      __builtin_ia32_fnmsubbf16128_maskz (__A, __B, __C, __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_rsqrt_pbh (__m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_rsqrtbf16512_mask (__A,
+ 				      (__v32bf) _mm512_setzero_si512 (),
+ 				      (__mmask32) -1);
+ 
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_rsqrt_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_rsqrtbf16512_mask (__A,  __W,  __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_rsqrt_pbh (__mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_rsqrtbf16512_mask (__A,
+ 				      (__v32bf) _mm512_setzero_si512 (),
+ 				      __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_rsqrt_pbh (__m256bh __A)
*************** _mm_maskz_rsqrt_pbh (__mmask8 __U, __m12
*** 733,738 ****
--- 1084,1117 ----
  				      __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_sqrt_pbh (__m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_sqrtbf16512_mask (__A,
+ 				     (__v32bf) _mm512_setzero_si512 (),
+ 				     (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_sqrt_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_sqrtbf16512_mask (__A,  __W,  __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_sqrt_pbh (__mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_sqrtbf16512_mask (__A,
+ 				     (__v32bf) _mm512_setzero_si512 (),
+ 				     __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_sqrt_pbh (__m256bh __A)
*************** _mm_maskz_sqrt_pbh (__mmask8 __U, __m128
*** 789,794 ****
--- 1168,1201 ----
  				     __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_rcp_pbh (__m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_rcpbf16512_mask (__A,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_rcp_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_rcpbf16512_mask (__A,  __W,  __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_rcp_pbh (__mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_rcpbf16512_mask (__A,
+ 				    (__v32bf) _mm512_setzero_si512 (),
+ 				    __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_rcp_pbh (__m256bh __A)
*************** _mm_maskz_rcp_pbh (__mmask8 __U, __m128b
*** 845,850 ****
--- 1252,1284 ----
  				    __U);
  }
  
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_getexp_pbh (__m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_getexpbf16512_mask (__A,
+ 				       (__v32bf) _mm512_setzero_si512 (),
+ 				       (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_getexp_pbh (__m512bh __W, __mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh) __builtin_ia32_getexpbf16512_mask (__A,  __W,  __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_getexp_pbh (__mmask32 __U, __m512bh __A)
+ {
+   return (__m512bh)
+     __builtin_ia32_getexpbf16512_mask (__A,
+ 				       (__v32bf) _mm512_setzero_si512 (),
+ 				       __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_getexp_pbh (__m256bh __A)
*************** _mm_maskz_getexp_pbh (__mmask8 __U, __m1
*** 903,908 ****
--- 1337,1370 ----
  
  /* Intrinsics vrndscalebf16.  */
  #ifdef __OPTIMIZE__
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_roundscale_pbh (__m512bh __A, int B)
+ {
+   return (__m512bh)
+     __builtin_ia32_rndscalebf16512_mask (__A, B,
+ 					 (__v32bf) _mm512_setzero_si512 (),
+ 					 (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_roundscale_pbh (__m512bh __W, __mmask32 __U, __m512bh __A, int B)
+ {
+   return (__m512bh)
+     __builtin_ia32_rndscalebf16512_mask (__A, B, __W,  __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_roundscale_pbh (__mmask32 __U, __m512bh __A, int B)
+ {
+   return (__m512bh)
+     __builtin_ia32_rndscalebf16512_mask (__A, B,
+ 					 (__v32bf) _mm512_setzero_si512 (),
+ 					 __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_roundscale_pbh (__m256bh __A, int B)
*************** _mm_maskz_roundscale_pbh (__mmask8 __U,
*** 962,967 ****
--- 1424,1442 ----
  }
  
  #else
+ #define _mm512_roundscale_pbh(A, B)					      \
+   (__builtin_ia32_rndscalebf16512_mask ((A), (B),			      \
+ 					(__v32bf) _mm512_setzero_si512 (),    \
+ 					(__mmask32) -1))
+ 
+ #define _mm512_mask_roundscale_pbh(A, B, C, D)	    		      \
+   (__builtin_ia32_rndscalebf16512_mask ((C), (D), (A), (B)))
+ 
+ #define _mm512_maskz_roundscale_pbh(A, B, C)				      \
+   (__builtin_ia32_rndscalebf16512_mask ((B), (C),			      \
+ 					(__v32bf) _mm512_setzero_si512 (),    \
+ 					(A)))
+ 
  #define _mm256_roundscale_pbh(A, B)					      \
    (__builtin_ia32_rndscalebf16256_mask ((A), (B),			      \
  					(__v16bf) _mm256_setzero_si256 (),    \
*************** _mm_maskz_roundscale_pbh (__mmask8 __U,
*** 992,997 ****
--- 1467,1501 ----
  
  /* Intrinsics vreducebf16.  */
  #ifdef __OPTIMIZE__
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_reduce_pbh (__m512bh __A, int B)
+ {
+   return (__m512bh)
+     __builtin_ia32_reducebf16512_mask (__A, B,
+ 				       (__v32bf) _mm512_setzero_si512 (),
+ 				       (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_reduce_pbh (__m512bh __W, __mmask32 __U,
+ 			__m512bh __A, int B)
+ {
+   return (__m512bh)
+     __builtin_ia32_reducebf16512_mask (__A, B, __W,  __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_reduce_pbh (__mmask32 __U, __m512bh __A, int B)
+ {
+   return (__m512bh)
+     __builtin_ia32_reducebf16512_mask (__A, B,
+ 					  (__v32bf) _mm512_setzero_si512 (),
+ 					  __U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_reduce_pbh (__m256bh __A, int B)
*************** _mm_maskz_reduce_pbh (__mmask8 __U, __m1
*** 1051,1056 ****
--- 1555,1573 ----
  }
  
  #else
+ #define _mm512_reduce_pbh(A, B)					      \
+   (__builtin_ia32_reducebf16512_mask ((A), (B),			      \
+ 				      (__v32bf) _mm512_setzero_si512 (),   \
+ 				      (__mmask32) -1))
+ 
+ #define _mm512_mask_reduce_pbh(A, B, C, D)				      \
+   (__builtin_ia32_reducebf16512_mask ((C), (D), (A), (B)))
+ 
+ #define _mm512_maskz_reduce_pbh(A, B, C)				      \
+   (__builtin_ia32_reducebf16512_mask ((B), (C),			      \
+ 				      (__v32bf) _mm512_setzero_si512 (),      \
+ 				      (A)))
+ 
  #define _mm256_reduce_pbh(A, B)					      \
    (__builtin_ia32_reducebf16256_mask ((A), (B),			      \
  				      (__v16bf) _mm256_setzero_si256 (),      \
*************** _mm_maskz_reduce_pbh (__mmask8 __U, __m1
*** 1082,1087 ****
--- 1599,1638 ----
  
  /* Intrinsics vgetmantbf16.  */
  #ifdef __OPTIMIZE__
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_getmant_pbh (__m512bh __A, _MM_MANTISSA_NORM_ENUM __B,
+ 		    _MM_MANTISSA_SIGN_ENUM __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_getmantbf16512_mask (__A, (int) (__C << 2) | __B,
+ 					(__v32bf) _mm512_setzero_si512 (),
+ 					(__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_getmant_pbh (__m512bh __W, __mmask32 __U, __m512bh __A,
+ 			 _MM_MANTISSA_NORM_ENUM __B,
+ 			 _MM_MANTISSA_SIGN_ENUM __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_getmantbf16512_mask (__A, (int) (__C << 2) | __B,
+ 					__W, __U);
+ }
+ 
+ extern __inline__ __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_getmant_pbh (__mmask32 __U, __m512bh __A,
+ 			  _MM_MANTISSA_NORM_ENUM __B,
+ 			  _MM_MANTISSA_SIGN_ENUM __C)
+ {
+   return (__m512bh)
+     __builtin_ia32_getmantbf16512_mask (__A, (int) (__C << 2) | __B,
+ 					(__v32bf) _mm512_setzero_si512 (),
+ 					__U);
+ }
+ 
  extern __inline__ __m256bh
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_getmant_pbh (__m256bh __A, _MM_MANTISSA_NORM_ENUM __B,
*************** _mm_maskz_getmant_pbh (__mmask8 __U, __m
*** 1151,1156 ****
--- 1702,1720 ----
  }
  
  #else
+ #define _mm512_getmant_pbh(A, B, C)					      \
+   (__builtin_ia32_getmantbf16512_mask ((A), (int)(((C)<<2) | (B)),	      \
+ 				       (__v32bf) _mm512_setzero_si512 (),     \
+ 				       (__mmask32) -1))
+ 
+ #define _mm512_mask_getmant_pbh(A, B, C, D, E)				      \
+   (__builtin_ia32_getmantbf16512_mask ((C), (int)(((D)<<2) | (E)), (A), (B)))
+ 
+ #define _mm512_maskz_getmant_pbh(A, B, C, D)				      \
+   (__builtin_ia32_getmantbf16512_mask ((B), (int)(((C)<<2) | (D)),	      \
+ 				       (__v32bf) _mm512_setzero_si512 (),     \
+ 					  (A)))
+ 
  #define _mm256_getmant_pbh(A, B, C)					      \
    (__builtin_ia32_getmantbf16256_mask ((A), (int)(((C)<<2) | (B)),	      \
  				       (__v16bf) _mm256_setzero_si256 (),     \
*************** _mm_maskz_getmant_pbh (__mmask8 __U, __m
*** 1180,1185 ****
--- 1744,1767 ----
  
  /* Intrinsics vfpclassbf16.  */
  #ifdef __OPTIMIZE__
+ extern __inline __mmask32
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_fpclass_pbh_mask (__mmask32 __U, __m512bh __A,
+ 			      const int __imm)
+ {
+   return (__mmask32)
+     __builtin_ia32_fpclassbf16512_mask (__A, __imm, __U);
+ }
+ 
+ extern __inline __mmask32
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_fpclass_pbh_mask (__m512bh __A, const int __imm)
+ {
+   return (__mmask32)
+     __builtin_ia32_fpclassbf16512_mask (__A, __imm,
+ 					(__mmask32) -1);
+ }
+ 
  extern __inline __mmask16
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_mask_fpclass_pbh_mask (__mmask16 __U, __m256bh __A,
*************** _mm_fpclass_pbh_mask (__m128bh __A, cons
*** 1214,1219 ****
--- 1796,1809 ----
  }
  
  #else
+ #define _mm512_mask_fpclass_pbh_mask(U, X, C)				   \
+   ((__mmask32) __builtin_ia32_fpclassbf16512_mask (			   \
+       (__v32bf) (__m512bh) (X), (int) (C), (__mmask32) (U)))
+ 
+ #define _mm512_fpclass_pbh_mask(X, C)					   \
+   ((__mmask32) __builtin_ia32_fpclassbf16512_mask (			   \
+       (__v32bf) (__m512bh) (X), (int) (C), (__mmask32) (-1)))
+ 
  #define _mm256_mask_fpclass_pbh_mask(U, A, B)			      \
    ((__mmask16) __builtin_ia32_fpclassbf16256_mask ((A), (B), (U)))
  
*************** _mm_fpclass_pbh_mask (__m128bh __A, cons
*** 1233,1238 ****
--- 1823,1846 ----
  
  /* Intrinsics vcmpbf16.  */
  #ifdef __OPTIMIZE__
+ extern __inline __mmask32
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cmp_pbh_mask (__mmask32 __U, __m512bh __A, __m512bh __B,
+ 			  const int __imm)
+ {
+   return (__mmask32)
+     __builtin_ia32_cmpbf16512_mask (__A, __B, __imm, __U);
+ }
+ 
+ extern __inline __mmask32
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cmp_pbh_mask (__m512bh __A, __m512bh __B, const int __imm)
+ {
+   return (__mmask32)
+     __builtin_ia32_cmpbf16512_mask (__A, __B, __imm,
+ 				    (__mmask32) -1);
+ }
+ 
  extern __inline __mmask16
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_mask_cmp_pbh_mask (__mmask16 __U, __m256bh __A,
*************** _mm_cmp_pbh_mask (__m128bh __A, __m128bh
*** 1268,1273 ****
--- 1876,1887 ----
  }
  
  #else
+ #define _mm512_mask_cmp_pbh_mask(A, B, C, D)				\
+   ((__mmask32) __builtin_ia32_cmpbf16512_mask ((B), (C), (D), (A)))
+ 
+ #define _mm512_cmp_pbh_mask(A, B, C)					\
+   ((__mmask32) __builtin_ia32_cmpbf16512_mask ((A), (B), (C), (-1)))
+ 
  #define _mm256_mask_cmp_pbh_mask(A, B, C, D)			      \
    ((__mmask16) __builtin_ia32_cmpbf16256_mask ((B), (C), (D), (A)))
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2convertintrin.h gcc-16-20250525/gcc/config/i386/avx10_2convertintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2convertintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2convertintrin.h	Sun May 25 22:32:05 2025
*************** _mm256_maskz_cvtx2ps_ph ( __mmask16 __U,
*** 98,103 ****
--- 98,200 ----
  						       (__mmask16) __U);
  }
  
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtx2ps_ph (__m512 __A, __m512 __B)
+ {
+   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
+ 							     (__v16sf) __B,
+ 							     (__v32hf)
+ 							     _mm512_setzero_ph (),
+ 							     (__mmask32) -1,
+ 							     _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtx2ps_ph (__m512h __W, __mmask32 __U, __m512 __A,
+ 			__m512 __B)
+ {
+   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
+ 							     (__v16sf) __B,
+ 							     (__v32hf) __W,
+ 							     (__mmask32) __U,
+ 							     _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtx2ps_ph (__mmask32 __U, __m512 __A, __m512 __B)
+ {
+   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
+ 							     (__v16sf) __B,
+ 							     (__v32hf)
+ 							     _mm512_setzero_ph (),
+ 							     (__mmask32) __U,
+ 							     _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ #ifdef __OPTIMIZE__
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtx_round2ps_ph (__m512 __A, __m512 __B, const int __R)
+ {
+   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
+ 							    (__v16sf) __B,
+ 							    (__v32hf)
+ 							    _mm512_setzero_ph (),
+ 							    (__mmask32) -1,
+ 							    __R);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtx_round2ps_ph (__m512h __W, __mmask32 __U, __m512 __A,
+ 			      __m512 __B, const int __R)
+ {
+   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
+ 							    (__v16sf) __B,
+ 							    (__v32hf) __W,
+ 							    (__mmask32) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtx_round2ps_ph (__mmask32 __U, __m512 __A,
+ 			      __m512 __B, const int __R)
+ {
+   return (__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) __A,
+ 							    (__v16sf) __B,
+ 							    (__v32hf)
+ 							    _mm512_setzero_ph (),
+ 							    (__mmask32) __U,
+ 							    __R);
+ }
+ 
+ #else
+ #define _mm512_cvtx_round2ps_ph(A, B, R) \
+   ((__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) (A), \
+ 						       (__v16sf) (B), \
+ 						       (__v32hf) \
+ 						       (_mm512_setzero_ph ()), \
+ 						       (__mmask32) (-1), \
+ 						       (R)))
+ #define _mm512_mask_cvtx_round2ps_ph(W, U, A, B, R) \
+   ((__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) (A), \
+ 						       (__v16sf) (B), \
+ 						       (__v32hf) (W), \
+ 						       (__mmask32) (U), \
+ 						       (R)))
+ #define _mm512_maskz_cvtx_round2ps_ph(U, A, B, R) \
+   ((__m512h) __builtin_ia32_vcvt2ps2phx512_mask_round ((__v16sf) (A), \
+ 						       (__v16sf) (B), \
+ 						       (__v32hf) \
+ 						       (_mm512_setzero_ph ()), \
+ 						       (__mmask32) (U), \
+ 						       (R)))
+ #endif  /* __OPTIMIZE__  */
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvtbiasph_bf8 (__m128i __A, __m128h __B)
*************** _mm256_maskz_cvtbiasph_bf8 (__mmask16 __
*** 161,166 ****
--- 258,296 ----
  							  (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtbiasph_bf8 (__m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2bf8512_mask ((__v64qi) __A,
+ 							  (__v32hf) __B,
+ 							  (__v32qi)(__m256i)
+ 							  _mm256_undefined_si256 (),
+ 							  (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtbiasph_bf8 (__m256i __W, __mmask32 __U,
+ 			   __m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2bf8512_mask ((__v64qi) __A,
+ 							  (__v32hf) __B,
+ 							  (__v32qi)(__m256i) __W,
+ 							  (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtbiasph_bf8 (__mmask32 __U, __m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2bf8512_mask ((__v64qi) __A,
+ 							  (__v32hf) __B,
+ 							  (__v32qi)(__m256i)
+ 							  _mm256_setzero_si256 (),
+ 							  (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvts_biasph_bf8 (__m128i __A, __m128h __B)
*************** _mm256_maskz_cvts_biasph_bf8 (__mmask16
*** 224,229 ****
--- 354,392 ----
  							   (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvts_biasph_bf8 (__m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2bf8s512_mask ((__v64qi) __A,
+ 							   (__v32hf) __B,
+ 							   (__v32qi)(__m256i)
+ 							   _mm256_undefined_si256 (),
+ 							   (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvts_biasph_bf8 (__m256i __W, __mmask32 __U,
+ 			     __m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2bf8s512_mask ((__v64qi) __A,
+ 							   (__v32hf) __B,
+ 							   (__v32qi)(__m256i) __W,
+ 							   (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvts_biasph_bf8 (__mmask32 __U, __m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2bf8s512_mask ((__v64qi) __A,
+ 							   (__v32hf) __B,
+ 							   (__v32qi)(__m256i)
+ 							   _mm256_setzero_si256 (),
+ 							   (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvtbiasph_hf8 (__m128i __A, __m128h __B)
*************** _mm256_maskz_cvtbiasph_hf8 (__mmask16 __
*** 287,292 ****
--- 450,488 ----
  							  (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtbiasph_hf8 (__m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2hf8512_mask ((__v64qi) __A,
+ 							  (__v32hf) __B,
+ 							  (__v32qi)(__m256i)
+ 					 		  _mm256_undefined_si256 (),
+ 							  (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtbiasph_hf8 (__m256i __W, __mmask32 __U, __m512i __A,
+ 			   __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2hf8512_mask ((__v64qi) __A,
+ 							  (__v32hf) __B,
+ 							  (__v32qi)(__m256i) __W,
+ 							  (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtbiasph_hf8 (__mmask32 __U, __m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2hf8512_mask ((__v64qi) __A,
+ 							  (__v32hf) __B,
+ 							  (__v32qi)(__m256i)
+ 							  _mm256_setzero_si256 (),
+ 							  (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvts_biasph_hf8 (__m128i __A, __m128h __B)
*************** _mm256_maskz_cvts_biasph_hf8 (__mmask16
*** 350,355 ****
--- 546,584 ----
  							   (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvts_biasph_hf8 (__m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2hf8s512_mask ((__v64qi) __A,
+ 							   (__v32hf) __B,
+ 							   (__v32qi)(__m256i)
+ 							   _mm256_undefined_si256 (),
+ 							   (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvts_biasph_hf8 (__m256i __W, __mmask32 __U,
+ 			     __m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2hf8s512_mask ((__v64qi) __A,
+ 							   (__v32hf) __B,
+ 							   (__v32qi)(__m256i) __W,
+ 							   (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvts_biasph_hf8 (__mmask32 __U, __m512i __A, __m512h __B)
+ {
+   return (__m256i) __builtin_ia32_vcvtbiasph2hf8s512_mask ((__v64qi) __A,
+ 							   (__v32hf) __B,
+ 							   (__v32qi)(__m256i)
+ 							   _mm256_setzero_si256 (),
+ 							   (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvt2ph_bf8 (__m128h __A, __m128h __B)
*************** _mm256_maskz_cvt2ph_bf8 (__mmask32 __U,
*** 416,421 ****
--- 645,683 ----
  						       (__mmask32) __U);
  }
  
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvt2ph_bf8 (__m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2bf8512_mask ((__v32hf) __A,
+ 						       (__v32hf) __B,
+ 						       (__v64qi)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask64) -1);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvt2ph_bf8 (__m512i __W, __mmask64 __U,
+ 			__m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2bf8512_mask ((__v32hf) __A,
+ 						       (__v32hf) __B,
+ 						       (__v64qi) __W,
+ 						       (__mmask64) __U);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvt2ph_bf8 (__mmask64 __U,  __m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2bf8512_mask ((__v32hf) __A,
+ 						       (__v32hf) __B,
+ 						       (__v64qi)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask64) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvts_2ph_bf8 (__m128h __A, __m128h __B)
*************** _mm256_maskz_cvts_2ph_bf8 (__mmask32 __U
*** 482,487 ****
--- 744,782 ----
  							(__mmask32) __U);
  }
  
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvts_2ph_bf8 (__m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2bf8s512_mask ((__v32hf) __A,
+ 							(__v32hf) __B,
+ 							(__v64qi)
+ 							_mm512_setzero_si512 (),
+ 							(__mmask64) -1);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvts_2ph_bf8 (__m512i __W, __mmask64 __U,
+ 			  __m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2bf8s512_mask ((__v32hf) __A,
+ 							(__v32hf) __B,
+ 							(__v64qi) __W,
+ 							(__mmask64) __U);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvts_2ph_bf8 (__mmask64 __U, __m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2bf8s512_mask ((__v32hf) __A,
+ 							(__v32hf) __B,
+ 							(__v64qi)
+ 							_mm512_setzero_si512 (),
+ 							(__mmask64) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvt2ph_hf8 (__m128h __A, __m128h __B)
*************** _mm256_maskz_cvt2ph_hf8 (__mmask32 __U,
*** 548,553 ****
--- 843,881 ----
  						       (__mmask32) __U);
  }
  
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvt2ph_hf8 (__m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2hf8512_mask ((__v32hf) __A,
+ 						       (__v32hf) __B,
+ 						       (__v64qi)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask64) -1);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvt2ph_hf8 (__m512i __W, __mmask64 __U,
+ 			__m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2hf8512_mask ((__v32hf) __A,
+ 						       (__v32hf) __B,
+ 						       (__v64qi) __W,
+ 						       (__mmask64) __U);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvt2ph_hf8 (__mmask64 __U, __m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2hf8512_mask ((__v32hf) __A,
+ 						       (__v32hf) __B,
+ 						       (__v64qi)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask64) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvts_2ph_hf8 (__m128h __A, __m128h __B)
*************** _mm256_maskz_cvts_2ph_hf8 (__mmask32 __U
*** 614,619 ****
--- 942,980 ----
  							(__mmask32) __U);
  }
  
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvts_2ph_hf8 (__m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2hf8s512_mask ((__v32hf) __A,
+ 							(__v32hf) __B,
+ 							(__v64qi)
+ 							_mm512_setzero_si512 (),
+ 							(__mmask64) -1);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvts_2ph_hf8 (__m512i __W, __mmask64 __U,
+ 			  __m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2hf8s512_mask ((__v32hf) __A,
+ 							(__v32hf) __B,
+ 							(__v64qi) __W,
+ 							(__mmask64) __U);
+ }
+ 
+ extern __inline__ __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvts_2ph_hf8 (__mmask64 __U, __m512h __A, __m512h __B)
+ {
+   return (__m512i) __builtin_ia32_vcvt2ph2hf8s512_mask ((__v32hf) __A,
+ 							(__v32hf) __B,
+ 							(__v64qi)
+ 							_mm512_setzero_si512 (),
+ 							(__mmask64) __U);
+ }
+ 
  extern __inline__ __m128h
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvthf8_ph (__m128i __A)
*************** _mm256_maskz_cvthf8_ph (__mmask16 __U, _
*** 672,677 ****
--- 1033,1067 ----
  						      (__mmask16) __U);
  }
  
+ extern __inline__ __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvthf8_ph (__m256i __A)
+ {
+   return (__m512h) __builtin_ia32_vcvthf82ph512_mask ((__v32qi) __A,
+ 						      (__v32hf) (__m512h)
+ 						      _mm512_undefined_ph (),
+ 						      (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvthf8_ph (__m512h __W, __mmask32 __U, __m256i __A)
+ {
+   return (__m512h) __builtin_ia32_vcvthf82ph512_mask ((__v32qi) __A,
+ 						      (__v32hf) (__m512h) __W,
+ 						      (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvthf8_ph (__mmask32 __U, __m256i __A)
+ {
+   return (__m512h) __builtin_ia32_vcvthf82ph512_mask ((__v32qi) __A,
+ 						      (__v32hf) (__m512h)
+ 						      _mm512_setzero_ph (),
+ 						      (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvtph_bf8 (__m128h __A)
*************** _mm256_maskz_cvtph_bf8 (__mmask16 __U, _
*** 730,735 ****
--- 1120,1154 ----
  						      (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtph_bf8 (__m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2bf8512_mask ((__v32hf) __A,
+ 						      (__v32qi) (__m256i)
+ 						      _mm256_undefined_si256 (),
+ 						      (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtph_bf8 (__m256i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2bf8512_mask ((__v32hf) __A,
+ 						      (__v32qi) (__m256i) __W,
+ 						      (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtph_bf8 (__mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2bf8512_mask ((__v32hf) __A,
+ 						      (__v32qi) (__m256i)
+ 						      _mm256_setzero_si256 (),
+ 						      (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvts_ph_bf8 (__m128h __A)
*************** _mm256_maskz_cvts_ph_bf8 (__mmask16 __U,
*** 788,793 ****
--- 1207,1241 ----
  						       (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvts_ph_bf8 (__m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2bf8s512_mask ((__v32hf) __A,
+ 						       (__v32qi) (__m256i)
+ 						       _mm256_undefined_si256 (),
+ 						       (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvts_ph_bf8 (__m256i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2bf8s512_mask ((__v32hf) __A,
+ 						       (__v32qi) (__m256i) __W,
+ 						       (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvts_ph_bf8 (__mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2bf8s512_mask ((__v32hf) __A,
+ 						       (__v32qi) (__m256i)
+ 						       _mm256_setzero_si256 (),
+ 						       (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvtph_hf8 (__m128h __A)
*************** _mm256_maskz_cvtph_hf8 (__mmask16 __U, _
*** 846,851 ****
--- 1294,1328 ----
  						      (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtph_hf8 (__m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2hf8512_mask ((__v32hf) __A,
+ 						      (__v32qi) (__m256i)
+ 						      _mm256_undefined_si256 (),
+ 						      (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtph_hf8 (__m256i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2hf8512_mask ((__v32hf) __A,
+ 						      (__v32qi)(__m256i) __W,
+ 						      (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtph_hf8 (__mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2hf8512_mask ((__v32hf) __A,
+ 						      (__v32qi) (__m256i)
+ 						      _mm256_setzero_si256 (),
+ 						      (__mmask32) __U);
+ }
+ 
  extern __inline__ __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvts_ph_hf8 (__m128h __A)
*************** _mm256_maskz_cvts_ph_hf8 (__mmask16 __U,
*** 904,909 ****
--- 1381,1415 ----
  						       (__mmask16) __U);
  }
  
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvts_ph_hf8 (__m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2hf8s512_mask ((__v32hf) __A,
+ 						       (__v32qi) (__m256i)
+ 						       _mm256_undefined_si256 (),
+ 						       (__mmask32) -1);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvts_ph_hf8 (__m256i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2hf8s512_mask ((__v32hf) __A,
+ 						       (__v32qi) (__m256i) __W,
+ 						       (__mmask32) __U);
+ }
+ 
+ extern __inline__ __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvts_ph_hf8 (__mmask32 __U, __m512h __A)
+ {
+   return (__m256i) __builtin_ia32_vcvtph2hf8s512_mask ((__v32hf) __A,
+ 						       (__v32qi) (__m256i)
+ 						       _mm256_setzero_si256 (),
+ 						       (__mmask32) __U);
+ }
+ 
  extern __inline __m128h
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvtbf8_ph (__m128i __A)
*************** _mm256_maskz_cvtbf8_ph (__mmask16 __U, _
*** 952,957 ****
--- 1458,1487 ----
  	 (__m256i) _mm256_maskz_cvtepi8_epi16 (__U, __A), 8));
  }
  
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtbf8_ph (__m256i __A)
+ {
+   return (__m512h) _mm512_castsi512_ph ((__m512i) _mm512_slli_epi16 (
+ 	 (__m512i) _mm512_cvtepi8_epi16 (__A), 8));
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtbf8_ph (__m512h __S, __mmask32 __U, __m256i __A)
+ {
+   return (__m512h) _mm512_castsi512_ph ((__m512i) _mm512_mask_slli_epi16 (
+ 	 (__m512i) __S, __U, (__m512i) _mm512_cvtepi8_epi16 (__A), 8));
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtbf8_ph (__mmask32 __U, __m256i __A)
+ {
+   return (__m512h) _mm512_castsi512_ph ((__m512i) _mm512_slli_epi16 (
+ 	 (__m512i) _mm512_maskz_cvtepi8_epi16 (__U, __A), 8));
+ }
+ 
  #ifdef __DISABLE_AVX10_2__
  #undef __DISABLE_AVX10_2__
  #pragma GCC pop_options
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2mediaintrin.h gcc-16-20250525/gcc/config/i386/avx10_2mediaintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2mediaintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2mediaintrin.h	Sun May 25 22:32:05 2025
*************** _mm256_maskz_dpbuuds_epi32 (__mmask8 __U
*** 394,399 ****
--- 394,591 ----
  					 (__mmask8) __U);
  }
  
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpbssd_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbssd512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpbssd_epi32 (__m512i __W, __mmask16 __U,
+ 			  __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbssd_v16si_mask ((__v16si) __W,
+ 					(__v16si) __A,
+ 					(__v16si) __B,
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpbssd_epi32 (__mmask16 __U, __m512i __W,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbssd_v16si_maskz ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpbssds_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbssds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpbssds_epi32 (__m512i __W, __mmask16 __U,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbssds_v16si_mask ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpbssds_epi32 (__mmask16 __U, __m512i __W,
+ 			    __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbssds_v16si_maskz ((__v16si) __W,
+ 					  (__v16si) __A,
+ 					  (__v16si) __B,
+ 					  (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpbsud_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbsud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpbsud_epi32 (__m512i __W, __mmask16 __U,
+ 			  __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbsud_v16si_mask ((__v16si) __W,
+ 					(__v16si) __A,
+ 					(__v16si) __B,
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpbsud_epi32 (__mmask16 __U, __m512i __W,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbsud_v16si_maskz ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpbsuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbsuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpbsuds_epi32 (__m512i __W, __mmask16 __U,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbsuds_v16si_mask ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpbsuds_epi32 (__mmask16 __U, __m512i __W,
+ 			    __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbsuds_v16si_maskz ((__v16si) __W,
+ 					  (__v16si) __A,
+ 					  (__v16si) __B,
+ 					  (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpbuud_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbuud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpbuud_epi32 (__m512i __W, __mmask16 __U,
+ 			  __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbuud_v16si_mask ((__v16si) __W,
+ 					(__v16si) __A,
+ 					(__v16si) __B,
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpbuud_epi32 (__mmask16 __U, __m512i __W,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbuud_v16si_maskz ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpbuuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbuuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpbuuds_epi32 (__m512i __W, __mmask16 __U,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbuuds_v16si_mask ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpbuuds_epi32 (__mmask16 __U, __m512i __W,
+ 			    __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpbuuds_v16si_maskz ((__v16si) __W,
+ 					  (__v16si) __A,
+ 					  (__v16si) __B,
+ 					  (__mmask16) __U);
+ }
+ 
  extern __inline __m128i
  __attribute__((__gnu_inline__, __always_inline__, __artificial__))
  _mm_mask_dpwsud_epi32 (__m128i __W, __mmask8 __U,
*************** _mm256_maskz_dpwuuds_epi32 (__mmask8 __U
*** 682,687 ****
--- 874,1106 ----
  					 (__mmask8) __U);
  }
  
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpwsud_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwsud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpwsud_epi32 (__m512i __W, __mmask16 __U,
+ 			  __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwsud_v16si_mask ((__v16si) __W,
+ 					(__v16si) __A,
+ 					(__v16si) __B,
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpwsud_epi32 (__mmask16 __U, __m512i __W,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwsud_v16si_maskz ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpwsuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwsuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpwsuds_epi32 (__m512i __W, __mmask16 __U,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwsuds_v16si_mask ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpwsuds_epi32 (__mmask16 __U, __m512i __W,
+ 			    __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwsuds_v16si_maskz ((__v16si) __W,
+ 					  (__v16si) __A,
+ 					  (__v16si) __B,
+ 					  (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpwusd_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwusd512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpwusd_epi32 (__m512i __W, __mmask16 __U,
+ 			  __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwusd_v16si_mask ((__v16si) __W,
+ 					(__v16si) __A,
+ 					(__v16si) __B,
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpwusd_epi32 (__mmask16 __U, __m512i __W,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwusd_v16si_maskz ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpwusds_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwusds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpwusds_epi32 (__m512i __W, __mmask16 __U,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwusds_v16si_mask ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpwusds_epi32 (__mmask16 __U, __m512i __W,
+ 			    __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwusds_v16si_maskz ((__v16si) __W,
+ 					  (__v16si) __A,
+ 					  (__v16si) __B,
+ 					  (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpwuud_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwuud512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpwuud_epi32 (__m512i __W, __mmask16 __U,
+ 			  __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwuud_v16si_mask ((__v16si) __W,
+ 					(__v16si) __A,
+ 					(__v16si) __B,
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpwuud_epi32 (__mmask16 __U, __m512i __W,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwuud_v16si_maskz ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpwuuds_epi32 (__m512i __W, __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwuuds512 ((__v16si) __W, (__v16si) __A, (__v16si) __B);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpwuuds_epi32 (__m512i __W, __mmask16 __U,
+ 			   __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwuuds_v16si_mask ((__v16si) __W,
+ 					 (__v16si) __A,
+ 					 (__v16si) __B,
+ 					 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpwuuds_epi32 (__mmask16 __U, __m512i __W,
+ 			    __m512i __A, __m512i __B)
+ {
+   return (__m512i)
+     __builtin_ia32_vpdpwuuds_v16si_maskz ((__v16si) __W,
+ 					  (__v16si) __A,
+ 					  (__v16si) __B,
+ 					  (__mmask16) __U);
+ }
+ 
+ extern __inline __m512
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_dpph_ps (__m512 __W, __m512h __A, __m512h __B)
+ {
+   return (__m512)
+     __builtin_ia32_vdpphps512_mask ((__v16sf) __W,
+ 				    (__v16sf) __A,
+ 				    (__v16sf) __B,
+ 				    (__mmask16) -1);
+ }
+ 
+ extern __inline __m512
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_dpph_ps (__m512 __W, __mmask16 __U, __m512h __A,
+ 		     __m512h __B)
+ {
+   return (__m512)
+     __builtin_ia32_vdpphps512_mask ((__v16sf) __W,
+ 				    (__v16sf) __A,
+ 				    (__v16sf) __B,
+ 				    (__mmask16) __U);
+ }
+ 
+ extern __inline __m512
+ __attribute__((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_dpph_ps (__mmask16 __U, __m512 __W, __m512h __A,
+ 		      __m512h __B)
+ {
+   return (__m512)
+     __builtin_ia32_vdpphps512_maskz ((__v16sf) __W,
+ 				     (__v16sf) __A,
+ 				     (__v16sf) __B,
+ 				     (__mmask16) __U);
+ }
+ 
  extern __inline __m256
  __attribute__((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_dpph_ps (__m256 __W, __m256h __A, __m256h __B)
*************** _mm256_maskz_mpsadbw_epu8 (__mmask16 __U
*** 800,805 ****
--- 1219,1257 ----
  						   (__v16hi) _mm256_setzero_si256 (),
  						   __U);
  }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mpsadbw_epu8 (__m512i __X, __m512i __Y, const int __M)
+ {
+   return (__m512i) __builtin_ia32_mpsadbw512 ((__v64qi) __X,
+ 					      (__v64qi) __Y,
+ 					      __M);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_mpsadbw_epu8 (__m512i __W, __mmask32 __U, __m512i __X,
+ 			  __m512i __Y, const int __M)
+ {
+   return (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi) __X,
+ 						   (__v64qi) __Y,
+ 						   __M,
+ 						   (__v32hi) __W,
+ 						   __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_mpsadbw_epu8 (__mmask32 __U, __m512i __X,
+ 			   __m512i __Y, const int __M)
+ {
+   return (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi) __X,
+ 						   (__v64qi) __Y,
+ 						   __M,
+ 						   (__v32hi) _mm512_setzero_epi32 (),
+ 						   __U);
+ }
  #else
  #define _mm_mask_mpsadbw_epu8(W, U, X, Y, M)				\
    (__m128i) __builtin_ia32_mpsadbw128_mask ((__v16qi)(__m128i)(X),	\
*************** _mm256_maskz_mpsadbw_epu8 (__mmask16 __U
*** 829,834 ****
--- 1281,1303 ----
  					    (__v16hi) _mm256_setzero_si256 (),	\
  					    (__mmask16)(U))
  
+ #define _mm512_mpsadbw_epu8(X, Y, M)					\
+   (__m512i) __builtin_ia32_mpsadbw512 ((__v64qi)(__m512i)(X),		\
+ 				       (__v64qi)(__m512i)(Y), (int)(M))
+ 
+ #define _mm512_mask_mpsadbw_epu8(W, U, X, Y, M)				\
+   (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi)(__m512i)(X),	\
+ 					    (__v64qi)(__m512i)(Y),	\
+ 					    (int)(M),			\
+ 					    (__v32hi)(__m512i)(W),	\
+ 					    (__mmask32)(U))
+ 
+ #define _mm512_maskz_mpsadbw_epu8(U, X, Y, M)				\
+   (__m512i) __builtin_ia32_mpsadbw512_mask ((__v64qi)(__m512i)(X),	\
+ 					    (__v64qi)(__m512i)(Y),	\
+ 					    (int)(M),			\
+ 					    (__v32hi) _mm512_setzero_epi32 (),	\
+ 					    (__mmask32)(U))
  #endif
  
  #ifdef __DISABLE_AVX10_2__
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2minmaxintrin.h gcc-16-20250525/gcc/config/i386/avx10_2minmaxintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2minmaxintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2minmaxintrin.h	Sun May 25 22:32:05 2025
*************** _mm256_maskz_minmax_pbh (__mmask16 __U,
*** 103,108 ****
--- 103,145 ----
  						       (__mmask16) __U);
  }
  
+ extern __inline __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_minmax_pbh (__m512bh __A, __m512bh __B, const int __C)
+ {
+   return (__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) __A,
+ 						       (__v32bf) __B,
+ 						       __C,
+ 						       (__v32bf)(__m512bh)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask32) -1);
+ }
+ 
+ extern __inline __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_minmax_pbh (__m512bh __W, __mmask32 __U,
+ 			__m512bh __A, __m512bh __B, const int __C)
+ {
+   return (__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) __A,
+ 						       (__v32bf) __B,
+ 						       __C,
+ 						       (__v32bf) __W,
+ 						       (__mmask32) __U);
+ }
+ 
+ extern __inline __m512bh
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_minmax_pbh (__mmask32 __U, __m512bh __A,
+ 			 __m512bh __B, const int __C)
+ {
+   return (__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) __A,
+ 						       (__v32bf) __B,
+ 						       __C,
+ 						       (__v32bf)(__m512bh)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask32) __U);
+ }
+ 
  extern __inline __m128d
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_minmax_pd (__m128d __A, __m128d __B, const int __C)
*************** _mm256_maskz_minmax_pd (__mmask8 __U, __
*** 169,174 ****
--- 206,289 ----
  		   (__mmask8) __U);
  }
  
+ extern __inline __m512d
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_minmax_pd (__m512d __A, __m512d __B, const int __C)
+ {
+   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
+ 							  (__v8df) __B,
+ 							  __C,
+ 							  (__v8df)
+ 							  _mm512_undefined_pd (),
+ 							  (__mmask8) -1,
+ 							  _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512d
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_minmax_pd (__m512d __W, __mmask8 __U, __m512d __A,
+ 		       __m512d __B, const int __C)
+ {
+   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
+ 							  (__v8df) __B,
+ 							  __C,
+ 							  (__v8df) __W,
+ 							  (__mmask8) __U,
+ 							  _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512d
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_minmax_pd (__mmask8 __U, __m512d __A, __m512d __B,
+ 			const int __C)
+ {
+   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
+ 							  (__v8df) __B,
+ 							  __C,
+ 							  (__v8df)
+ 							  _mm512_setzero_pd (),
+ 							  (__mmask8) __U,
+ 							  _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512d
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_minmax_round_pd (__m512d __A, __m512d __B, const int __C,
+ 			const int __R)
+ {
+   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
+ 							  (__v8df) __B,
+ 							  __C,
+ 							  (__v8df)
+ 							  _mm512_undefined_pd (),
+ 							  (__mmask8) -1, __R);
+ }
+ 
+ extern __inline __m512d
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_minmax_round_pd (__m512d __W, __mmask8 __U, __m512d __A,
+ 			     __m512d __B, const int __C, const int __R)
+ {
+   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
+ 							  (__v8df) __B,
+ 							  __C,
+ 							  (__v8df) __W,
+ 							  (__mmask8) __U, __R);
+ }
+ 
+ extern __inline __m512d
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_minmax_round_pd (__mmask8 __U, __m512d __A, __m512d __B,
+ 			      const int __C, const int __R)
+ {
+   return (__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) __A,
+ 							  (__v8df) __B,
+ 							  __C,
+ 							  (__v8df)
+ 							  _mm512_setzero_pd (),
+ 							  (__mmask8) __U, __R);
+ }
+ 
  extern __inline __m128h
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_minmax_ph (__m128h __A, __m128h __B, const int __C)
*************** _mm256_maskz_minmax_ph (__mmask16 __U, _
*** 235,240 ****
--- 350,432 ----
  		  (__mmask16) __U);
  }
  
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_minmax_ph (__m512h __A, __m512h __B, const int __C)
+ {
+   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
+ 							  (__v32hf) __B,
+ 							  __C,
+ 							  (__v32hf)
+ 							  _mm512_undefined_ph (),
+ 							  (__mmask32) -1,
+ 							  _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_minmax_ph (__m512h __W, __mmask32 __U, __m512h __A,
+ 		       __m512h __B, const int __C)
+ {
+   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
+ 							  (__v32hf) __B,
+ 							  __C,
+ 							  (__v32hf) __W,
+ 							  (__mmask32) __U,
+ 							  _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_minmax_ph (__mmask32 __U, __m512h __A, __m512h __B,
+ 			const int __C)
+ {
+   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
+ 							  (__v32hf) __B,
+ 							  __C,
+ 							  (__v32hf)
+ 							  _mm512_setzero_ph (),
+ 							  (__mmask32) __U,
+ 							  _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_minmax_round_ph (__m512h __A, __m512h __B, const int __C, const int __R)
+ {
+   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
+ 							  (__v32hf) __B,
+ 							  __C,
+ 							  (__v32hf)
+ 							  _mm512_undefined_ph (),
+ 							  (__mmask32) -1, __R);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_minmax_round_ph (__m512h __W, __mmask32 __U, __m512h __A,
+ 			     __m512h __B, const int __C, const int __R)
+ {
+   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
+ 							  (__v32hf) __B,
+ 							  __C,
+ 							  (__v32hf) __W,
+ 							  (__mmask32) __U, __R);
+ }
+ 
+ extern __inline __m512h
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_minmax_round_ph (__mmask32 __U, __m512h __A, __m512h __B,
+ 			      const int __C, const int __R)
+ {
+   return (__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) __A,
+ 							  (__v32hf) __B,
+ 							  __C,
+ 							  (__v32hf)
+ 							  _mm512_setzero_ph (),
+ 							  (__mmask32) __U, __R);
+ }
+ 
  extern __inline __m128
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_minmax_ps (__m128 __A, __m128 __B, const int __C)
*************** _mm256_maskz_minmax_ps (__mmask8 __U, __
*** 301,306 ****
--- 493,575 ----
  		  (__mmask8) __U);
  }
  
+ extern __inline __m512
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_minmax_ps (__m512 __A, __m512 __B, const int __C)
+ {
+   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
+ 							 (__v16sf) __B,
+ 							 __C,
+ 							 (__v16sf)
+ 							 _mm512_undefined_ps (),
+ 							 (__mmask16) -1,
+ 							 _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_minmax_ps (__m512 __W, __mmask16 __U, __m512 __A,
+ 		       __m512 __B, const int __C)
+ {
+   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
+ 							 (__v16sf) __B,
+ 							 __C,
+ 							 (__v16sf) __W,
+ 							 (__mmask16) __U,
+ 							 _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_minmax_ps (__mmask16 __U, __m512 __A, __m512 __B,
+ 			const int __C)
+ {
+   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
+ 							 (__v16sf) __B,
+ 							 __C,
+ 							 (__v16sf)
+ 							 _mm512_setzero_ps (),
+ 							 (__mmask16) __U,
+ 							 _MM_FROUND_CUR_DIRECTION);
+ }
+ 
+ extern __inline __m512
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_minmax_round_ps (__m512 __A, __m512 __B, const int __C, const int __R)
+ {
+   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
+ 							 (__v16sf) __B,
+ 							 __C,
+ 							 (__v16sf)
+ 							 _mm512_undefined_ps (),
+ 							 (__mmask16) -1, __R);
+ }
+ 
+ extern __inline __m512
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_minmax_round_ps (__m512 __W, __mmask16 __U, __m512 __A,
+ 			     __m512 __B, const int __C, const int __R)
+ {
+   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
+ 							 (__v16sf) __B,
+ 							 __C,
+ 							 (__v16sf) __W,
+ 							 (__mmask16) __U, __R);
+ }
+ 
+ extern __inline __m512
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_minmax_round_ps (__mmask16 __U, __m512 __A, __m512 __B,
+ 			      const int __C, const int __R)
+ {
+   return (__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) __A,
+ 							 (__v16sf) __B,
+ 							 __C,
+ 							 (__v16sf)
+ 							 _mm512_setzero_ps (),
+ 							 (__mmask16) __U, __R);
+ }
+ 
  extern __inline __m128d
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_minmax_sd (__m128d __A, __m128d __B, const int __C)
*************** _mm_maskz_minmax_round_ss (__mmask8 __U,
*** 580,585 ****
--- 849,877 ----
  						 _mm256_setzero_si256 (),     \
  						 (__mmask16) (U)))
  
+ #define _mm512_minmax_pbh(A, B, C)					      \
+   ((__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) (A),		      \
+ 						 (__v32bf) (B),		      \
+ 						 (int) (C),		      \
+ 						 (__v32bf) (__m512bh)	      \
+ 						 _mm512_setzero_si512 (),     \
+ 						 (__mmask32) (-1)))
+ 
+ #define _mm512_mask_minmax_pbh(W, U, A, B, C)				      \
+   ((__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) (A),		      \
+ 						 (__v32bf) (B), 	      \
+ 						 (int) (C),		      \
+ 						 (__v32bf) (__m512bh) (W),    \
+ 						 (__mmask32) (U)))
+ 
+ #define _mm512_maskz_minmax_pbh(U, A, B, C)				      \
+   ((__m512bh) __builtin_ia32_minmaxbf16512_mask ((__v32bf) (A),		      \
+ 						 (__v32bf) (B),		      \
+ 						 (int) (C),		      \
+ 						 (__v32bf) (__m512bh)	      \
+ 						 _mm512_setzero_si512 (),     \
+ 						 (__mmask32) (U)))
+ 
  #define _mm_minmax_pd(A, B, C)						      \
    ((__m128d) __builtin_ia32_minmaxpd128_mask ((__v2df) (A),		      \
  					      (__v2df) (B),		      \
*************** _mm_maskz_minmax_round_ss (__mmask8 __U,
*** 626,631 ****
--- 918,975 ----
  					      _mm256_setzero_pd (),	      \
  					      (__mmask8) (U)))
  
+ #define _mm512_minmax_pd(A, B, C)					      \
+   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
+ 						    (__v8df) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v8df) (__m512d)	      \
+ 						    _mm512_undefined_pd (),   \
+ 						    (__mmask8) (-1),	      \
+ 						    _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_mask_minmax_pd(W, U, A, B, C)				      \
+   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
+ 						    (__v8df) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v8df) (__m512d) (W),   \
+ 						    (__mmask8) (U),	      \
+ 						    _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_maskz_minmax_pd(U, A, B, C)				      \
+   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
+ 						    (__v8df) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v8df) (__m512d)	      \
+ 						    _mm512_setzero_pd (),     \
+ 						    (__mmask8) (U),	      \
+ 						    _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_minmax_round_pd(A, B, C, R)				      \
+   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
+ 						    (__v8df) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v8df) (__m512d)	      \
+ 						    _mm512_undefined_pd (),   \
+ 						    (__mmask8) (-1),	      \
+ 						    (int) (R)))
+ 
+ #define _mm512_mask_minmax_round_pd(W, U, A, B, C, R)			      \
+   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
+ 						    (__v8df) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v8df) (__m512d) (W),   \
+ 						    (__mmask8) (U),	      \
+ 						    (int) (R)))
+ 
+ #define _mm512_maskz_minmax_round_pd(U, A, B, C, R)			      \
+   ((__m512d) __builtin_ia32_minmaxpd512_mask_round ((__v8df) (A),	      \
+ 						    (__v8df) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v8df) (__m512d)	      \
+ 						    _mm512_setzero_pd (),     \
+ 						    (__mmask8) (U), 	      \
+ 						    (int) (R)))
+ 
  #define _mm_minmax_ph(A, B, C)						      \
    ((__m128h) __builtin_ia32_minmaxph128_mask ((__v8hf) (A),		      \
  					      (__v8hf) (B),		      \
*************** _mm_maskz_minmax_round_ss (__mmask8 __U,
*** 672,677 ****
--- 1016,1073 ----
  					      _mm256_setzero_ph (),	      \
  					      (__mmask16) (U)))
  
+ #define _mm512_minmax_ph(A, B, C)					      \
+   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
+ 						    (__v32hf) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v32hf) (__m512h)	      \
+ 						    _mm512_undefined_ph (),   \
+ 						    (__mmask32) (-1),	      \
+ 						    _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_mask_minmax_ph(W, U, A, B, C)				      \
+   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
+ 						    (__v32hf) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v32hf) (__m512h) (W),  \
+ 						    (__mmask32) (U),	      \
+ 						    _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_maskz_minmax_ph(U, A, B, C)				      \
+   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
+ 						    (__v32hf) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v32hf) (__m512h)	      \
+ 						    _mm512_setzero_ph (),     \
+ 						    (__mmask32) (U),	      \
+ 						    _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_minmax_round_ph(A, B, C, R)				      \
+   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
+ 						    (__v32hf) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v32hf) (__m512h)	      \
+ 						    _mm512_undefined_ph (),   \
+ 						    (__mmask32) (-1),	      \
+ 						    (int) (R)))
+ 
+ #define _mm512_mask_minmax_round_ph(W, U, A, B, C, R)			      \
+   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
+ 						    (__v32hf) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v32hf) (__m512h) (W),  \
+ 						    (__mmask32) (U),	      \
+ 						    (int) (R)))
+ 
+ #define _mm512_maskz_minmax_round_ph(U, A, B, C, R)			      \
+   ((__m512h) __builtin_ia32_minmaxph512_mask_round ((__v32hf) (A),	      \
+ 						    (__v32hf) (B),	      \
+ 						    (int) (C),		      \
+ 						    (__v32hf) (__m512h)	      \
+ 						    _mm512_setzero_ph (),     \
+ 						    (__mmask32) (U),	      \
+ 						    (int) (R)))
+ 
  #define _mm_minmax_ps(A, B, C)						      \
    ((__m128) __builtin_ia32_minmaxps128_mask ((__v4sf) (A),		      \
  					     (__v4sf) (B),		      \
*************** _mm_maskz_minmax_round_ss (__mmask8 __U,
*** 718,723 ****
--- 1114,1171 ----
  					     _mm256_setzero_ps (),	      \
  					     (__mmask8) (U)))
  
+ #define _mm512_minmax_ps(A, B, C)					      \
+   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
+ 						   (__v16sf) (B),	      \
+ 						   (int) (C),		      \
+ 						   (__v16sf) (__m512)	      \
+ 						   _mm512_undefined_ps (),    \
+ 						   (__mmask16) (-1),	      \
+ 						   _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_mask_minmax_ps(W, U, A, B, C)				      \
+   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
+ 						   (__v16sf) (B),	      \
+ 						   (int) (C),		      \
+ 						   (__v16sf) (__m512) (W),    \
+ 						   (__mmask16) (U),	      \
+ 						   _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_maskz_minmax_ps(U, A, B, C)				      \
+   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
+ 						   (__v16sf) (B),	      \
+ 						   (int) (C),		      \
+ 						   (__v16sf) (__m512)	      \
+ 						   _mm512_setzero_ps (),      \
+ 						   (__mmask16) (U),	      \
+ 						   _MM_FROUND_CUR_DIRECTION))
+ 
+ #define _mm512_minmax_round_ps(A, B, C, R)				      \
+   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
+ 						   (__v16sf) (B),	      \
+ 						   (int) (C),		      \
+ 						   (__v16sf) (__m512)	      \
+ 						   _mm512_undefined_ps (),    \
+ 						   (__mmask16) (-1),	      \
+ 						   (int) (R)))
+ 
+ #define _mm512_mask_minmax_round_ps(W, U, A, B, C, R)			      \
+   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A),	      \
+ 						   (__v16sf) (B),	      \
+ 						   (int) (C),		      \
+ 						   (__v16sf) (__m512) (W),    \
+ 						   (__mmask16) (U),	      \
+ 						   (int) (R)))
+ 
+ #define _mm512_maskz_minmax_round_ps(U, A, B, C, R)			      \
+   ((__m512) __builtin_ia32_minmaxps512_mask_round ((__v16sf) (A), 	      \
+ 						   (__v16sf) (B),	      \
+ 						   (int) (C),		      \
+ 						   (__v16sf) (__m512)	      \
+ 						   _mm512_setzero_ps (),      \
+ 						   (__mmask16) (U),	      \
+ 						   (int) (R)))
+ 
  #define _mm_minmax_round_sd(A, B, C, R)					      \
    ((__m128d) __builtin_ia32_minmaxsd_mask_round ((__v2df) (A),		      \
  						 (__v2df) (B),		      \
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx10_2satcvtintrin.h gcc-16-20250525/gcc/config/i386/avx10_2satcvtintrin.h
*** gcc-16-20250518/gcc/config/i386/avx10_2satcvtintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx10_2satcvtintrin.h	Sun May 25 22:32:05 2025
*************** _mm_maskz_ipcvts_bf16_epi8 (__mmask8 __U
*** 63,99 ****
  						       (__mmask8) __U);
  }
  
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm256_ipcvts_bf16_epi8 (__m256bh __A)
- {
-   return
-     (__m256i) __builtin_ia32_cvtbf162ibs256_mask ((__v16bf) __A,
- 						  (__v16hi)
- 						  _mm256_undefined_si256 (),
- 						  (__mmask16) -1);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm256_mask_ipcvts_bf16_epi8 (__m256i __W, __mmask16 __U, __m256bh __A)
- {
-   return (__m256i) __builtin_ia32_cvtbf162ibs256_mask ((__v16bf) __A,
- 						       (__v16hi) __W,
- 						       (__mmask16) __U);
- }
- 
- extern __inline __m256i
- __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
- _mm256_maskz_ipcvts_bf16_epi8 (__mmask16 __U, __m256bh __A)
- {
-   return
-     (__m256i) __builtin_ia32_cvtbf162ibs256_mask ((__v16bf) __A,
- 						  (__v16hi)
- 						  _mm256_setzero_si256 (),
- 						  (__mmask16) __U);
- }
- 
  extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_ipcvts_bf16_epu8 (__m128bh __A)
--- 63,68 ----
*************** _mm_maskz_ipcvts_bf16_epu8 (__mmask8 __U
*** 127,132 ****
--- 96,132 ----
  
  extern __inline __m256i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm256_ipcvts_bf16_epi8 (__m256bh __A)
+ {
+   return
+     (__m256i) __builtin_ia32_cvtbf162ibs256_mask ((__v16bf) __A,
+ 						  (__v16hi)
+ 						  _mm256_undefined_si256 (),
+ 						  (__mmask16) -1);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm256_mask_ipcvts_bf16_epi8 (__m256i __W, __mmask16 __U, __m256bh __A)
+ {
+   return (__m256i) __builtin_ia32_cvtbf162ibs256_mask ((__v16bf) __A,
+ 						       (__v16hi) __W,
+ 						       (__mmask16) __U);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm256_maskz_ipcvts_bf16_epi8 (__mmask16 __U, __m256bh __A)
+ {
+   return
+     (__m256i) __builtin_ia32_cvtbf162ibs256_mask ((__v16bf) __A,
+ 						  (__v16hi)
+ 						  _mm256_setzero_si256 (),
+ 						  (__mmask16) __U);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm256_ipcvts_bf16_epu8 (__m256bh __A)
  {
    return
*************** _mm256_maskz_ipcvts_bf16_epu8 (__mmask16
*** 156,275 ****
  						   (__mmask16) __U);
  }
  
! extern __inline __m128i
! __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_ipcvts_ph_epi8 (__m128h __A)
! {
!   return (__m128i) __builtin_ia32_cvtph2ibs128_mask ((__v8hf) __A,
! 						     (__v8hi)
! 						     _mm_undefined_si128 (),
! 						     (__mmask8) -1);
! }
! 
! extern __inline __m128i
! __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_mask_ipcvts_ph_epi8 (__m128i __W, __mmask8 __U, __m128h __A)
! {
!   return (__m128i) __builtin_ia32_cvtph2ibs128_mask ((__v8hf) __A,
! 						     (__v8hi) __W,
! 						     (__mmask8) __U);
! }
! 
! extern __inline __m128i
! __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_maskz_ipcvts_ph_epi8 (__mmask8 __U, __m128h __A)
! {
!   return (__m128i) __builtin_ia32_cvtph2ibs128_mask ((__v8hf) __A,
! 						     (__v8hi)
! 						     _mm_setzero_si128 (),
! 						     (__mmask8) __U);
! }
! 
! extern __inline __m128i
! __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_ipcvts_ph_epu8 (__m128h __A)
! {
!   return (__m128i) __builtin_ia32_cvtph2iubs128_mask ((__v8hf) __A,
! 						      (__v8hi)
! 						      _mm_undefined_si128 (),
! 						      (__mmask8) -1);
! }
! 
! extern __inline __m128i
! __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_mask_ipcvts_ph_epu8 (__m128i __W, __mmask8 __U, __m128h __A)
! {
!   return (__m128i) __builtin_ia32_cvtph2iubs128_mask ((__v8hf) __A,
! 						      (__v8hi) __W,
! 						      (__mmask8) __U);
! }
! 
! extern __inline __m128i
! __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_maskz_ipcvts_ph_epu8 (__mmask8 __U, __m128h __A)
! {
!   return (__m128i) __builtin_ia32_cvtph2iubs128_mask ((__v8hf) __A,
! 						      (__v8hi)
! 						      _mm_setzero_si128 (),
! 						      (__mmask8) __U);
! }
! 
! extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_ipcvts_ps_epi8 (__m128 __A)
  {
!   return (__m128i) __builtin_ia32_cvtps2ibs128_mask ((__v4sf) __A,
! 						     (__v4si)
! 						     _mm_undefined_si128 (),
! 						     (__mmask8) -1);
  }
  
! extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_mask_ipcvts_ps_epi8 (__m128i __W, __mmask8 __U, __m128 __A)
  {
!   return (__m128i) __builtin_ia32_cvtps2ibs128_mask ((__v4sf) __A,
! 						     (__v4si) __W,
! 						     (__mmask8) __U);
  }
  
! extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_maskz_ipcvts_ps_epi8 (__mmask8 __U, __m128 __A)
  {
!   return (__m128i) __builtin_ia32_cvtps2ibs128_mask ((__v4sf) __A,
! 						     (__v4si)
! 						     _mm_setzero_si128 (),
! 						     (__mmask8) __U);
  }
  
! extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_ipcvts_ps_epu8 (__m128 __A)
  {
!   return (__m128i) __builtin_ia32_cvtps2iubs128_mask ((__v4sf) __A,
! 						      (__v4si)
! 						      _mm_undefined_si128 (),
! 						      (__mmask8) -1);
  }
  
! extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_mask_ipcvts_ps_epu8 (__m128i __W, __mmask8 __U, __m128 __A)
  {
!   return (__m128i) __builtin_ia32_cvtps2iubs128_mask ((__v4sf) __A,
! 						      (__v4si) __W,
! 						      (__mmask8) __U);
  }
  
! extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm_maskz_ipcvts_ps_epu8 (__mmask8 __U, __m128 __A)
  {
!   return (__m128i) __builtin_ia32_cvtps2iubs128_mask ((__v4sf) __A,
! 						      (__v4si)
! 						      _mm_setzero_si128 (),
! 						      (__mmask8) __U);
  }
  
  extern __inline __m128i
--- 156,221 ----
  						   (__mmask16) __U);
  }
  
! extern __inline __m512i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm512_ipcvts_bf16_epi8 (__m512bh __A)
  {
!   return
!     (__m512i) __builtin_ia32_cvtbf162ibs512_mask ((__v32bf) __A,
! 						  (__v32hi)
! 						  _mm512_undefined_si512 (),
! 						  (__mmask32) -1);
  }
  
! extern __inline __m512i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm512_mask_ipcvts_bf16_epi8 (__m512i __W, __mmask32 __U, __m512bh __A)
  {
!   return (__m512i) __builtin_ia32_cvtbf162ibs512_mask ((__v32bf) __A,
! 						       (__v32hi) __W,
! 						       (__mmask32) __U);
  }
  
! extern __inline __m512i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm512_maskz_ipcvts_bf16_epi8 (__mmask32 __U, __m512bh __A)
  {
!   return
!     (__m512i) __builtin_ia32_cvtbf162ibs512_mask ((__v32bf) __A,
! 						  (__v32hi)
! 						  _mm512_setzero_si512 (),
! 						  (__mmask32) __U);
  }
  
! extern __inline __m512i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm512_ipcvts_bf16_epu8 (__m512bh __A)
  {
!   return
!     (__m512i) __builtin_ia32_cvtbf162iubs512_mask ((__v32bf) __A,
! 						   (__v32hi)
! 						   _mm512_undefined_si512 (),
! 						   (__mmask32) -1);
  }
  
! extern __inline __m512i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm512_mask_ipcvts_bf16_epu8 (__m512i __W, __mmask32 __U, __m512bh __A)
  {
!   return (__m512i) __builtin_ia32_cvtbf162iubs512_mask ((__v32bf) __A,
! 							(__v32hi) __W,
! 							(__mmask32) __U);
  }
  
! extern __inline __m512i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
! _mm512_maskz_ipcvts_bf16_epu8 (__mmask32 __U, __m512bh __A)
  {
!   return
!     (__m512i) __builtin_ia32_cvtbf162iubs512_mask ((__v32bf) __A,
! 						   (__v32hi)
! 						   _mm512_setzero_si512 (),
! 						   (__mmask32) __U);
  }
  
  extern __inline __m128i
*************** _mm256_maskz_ipcvtts_bf16_epu8 (__mmask1
*** 390,395 ****
--- 336,518 ----
  					  (__mmask16) __U);
  }
  
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_bf16_epi8 (__m512bh __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttbf162ibs512_mask ((__v32bf) __A,
+ 						   (__v32hi)
+ 						   _mm512_undefined_si512 (),
+ 						   (__mmask32) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_bf16_epi8 (__m512i __W, __mmask32 __U, __m512bh __A)
+ {
+   return (__m512i) __builtin_ia32_cvttbf162ibs512_mask ((__v32bf) __A,
+ 							(__v32hi) __W,
+ 							(__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_bf16_epi8 (__mmask32 __U, __m512bh __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttbf162ibs512_mask ((__v32bf) __A,
+ 						   (__v32hi)
+ 						   _mm512_setzero_si512 (),
+ 						   (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_bf16_epu8 (__m512bh __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttbf162iubs512_mask ((__v32bf) __A,
+ 					  (__v32hi) _mm512_undefined_si512 (),
+ 					  (__mmask32) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_bf16_epu8 (__m512i __W, __mmask32 __U, __m512bh __A)
+ {
+   return (__m512i) __builtin_ia32_cvttbf162iubs512_mask ((__v32bf) __A,
+ 							 (__v32hi) __W,
+ 							 (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_bf16_epu8 (__mmask32 __U, __m512bh __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttbf162iubs512_mask ((__v32bf) __A,
+ 					  (__v32hi)
+ 					  _mm512_setzero_si512 (),
+ 					  (__mmask32) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_ipcvts_ph_epi8 (__m128h __A)
+ {
+   return (__m128i) __builtin_ia32_cvtph2ibs128_mask ((__v8hf) __A,
+ 						     (__v8hi)
+ 						     _mm_undefined_si128 (),
+ 						     (__mmask8) -1);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_mask_ipcvts_ph_epi8 (__m128i __W, __mmask8 __U, __m128h __A)
+ {
+   return (__m128i) __builtin_ia32_cvtph2ibs128_mask ((__v8hf) __A,
+ 						     (__v8hi) __W,
+ 						     (__mmask8) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_maskz_ipcvts_ph_epi8 (__mmask8 __U, __m128h __A)
+ {
+   return (__m128i) __builtin_ia32_cvtph2ibs128_mask ((__v8hf) __A,
+ 						     (__v8hi)
+ 						     _mm_setzero_si128 (),
+ 						     (__mmask8) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_ipcvts_ph_epu8 (__m128h __A)
+ {
+   return (__m128i) __builtin_ia32_cvtph2iubs128_mask ((__v8hf) __A,
+ 						      (__v8hi)
+ 						      _mm_undefined_si128 (),
+ 						      (__mmask8) -1);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_mask_ipcvts_ph_epu8 (__m128i __W, __mmask8 __U, __m128h __A)
+ {
+   return (__m128i) __builtin_ia32_cvtph2iubs128_mask ((__v8hf) __A,
+ 						      (__v8hi) __W,
+ 						      (__mmask8) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_maskz_ipcvts_ph_epu8 (__mmask8 __U, __m128h __A)
+ {
+   return (__m128i) __builtin_ia32_cvtph2iubs128_mask ((__v8hf) __A,
+ 						      (__v8hi)
+ 						      _mm_setzero_si128 (),
+ 						      (__mmask8) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_ipcvts_ps_epi8 (__m128 __A)
+ {
+   return (__m128i) __builtin_ia32_cvtps2ibs128_mask ((__v4sf) __A,
+ 						     (__v4si)
+ 						     _mm_undefined_si128 (),
+ 						     (__mmask8) -1);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_mask_ipcvts_ps_epi8 (__m128i __W, __mmask8 __U, __m128 __A)
+ {
+   return (__m128i) __builtin_ia32_cvtps2ibs128_mask ((__v4sf) __A,
+ 						     (__v4si) __W,
+ 						     (__mmask8) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_maskz_ipcvts_ps_epi8 (__mmask8 __U, __m128 __A)
+ {
+   return (__m128i) __builtin_ia32_cvtps2ibs128_mask ((__v4sf) __A,
+ 						     (__v4si)
+ 						     _mm_setzero_si128 (),
+ 						     (__mmask8) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_ipcvts_ps_epu8 (__m128 __A)
+ {
+   return (__m128i) __builtin_ia32_cvtps2iubs128_mask ((__v4sf) __A,
+ 						      (__v4si)
+ 						      _mm_undefined_si128 (),
+ 						      (__mmask8) -1);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_mask_ipcvts_ps_epu8 (__m128i __W, __mmask8 __U, __m128 __A)
+ {
+   return (__m128i) __builtin_ia32_cvtps2iubs128_mask ((__v4sf) __A,
+ 						      (__v4si) __W,
+ 						      (__mmask8) __U);
+ }
+ 
+ extern __inline __m128i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm_maskz_ipcvts_ps_epu8 (__mmask8 __U, __m128 __A)
+ {
+   return (__m128i) __builtin_ia32_cvtps2iubs128_mask ((__v4sf) __A,
+ 						      (__v4si)
+ 						      _mm_setzero_si128 (),
+ 						      (__mmask8) __U);
+ }
+ 
  extern __inline __m128i
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_ipcvtts_ph_epi8 (__m128h __A)
*************** _mm256_maskz_cvtts_ps_epu64 (__mmask8 __
*** 1234,1239 ****
--- 1357,2772 ----
  						  (__mmask8) __U);
  }
  
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_ph_epi8 (__m512h __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2ibs512_mask ((__v32hf) __A,
+ 						(__v32hi)
+ 						_mm512_undefined_si512 (),
+ 						(__mmask32) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_ph_epi8 (__m512i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m512i) __builtin_ia32_cvtph2ibs512_mask ((__v32hf) __A,
+ 						     (__v32hi) __W,
+ 						     (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_ph_epi8 (__mmask32 __U, __m512h __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2ibs512_mask ((__v32hf) __A,
+ 						(__v32hi)
+ 						_mm512_setzero_si512 (),
+ 						(__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_ph_epu8 (__m512h __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2iubs512_mask ((__v32hf) __A,
+ 						 (__v32hi)
+ 						 _mm512_undefined_si512 (),
+ 						 (__mmask32) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_ph_epu8 (__m512i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m512i) __builtin_ia32_cvtph2iubs512_mask ((__v32hf) __A,
+ 						      (__v32hi) __W,
+ 						      (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_ph_epu8 (__mmask32 __U, __m512h __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2iubs512_mask ((__v32hf) __A,
+ 						 (__v32hi)
+ 						 _mm512_setzero_si512 (),
+ 						 (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_ps_epi8 (__m512 __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2ibs512_mask ((__v16sf) __A,
+ 						(__v16si)
+ 						_mm512_undefined_si512 (),
+ 						(__mmask16) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_ps_epi8 (__m512i __W, __mmask16 __U, __m512 __A)
+ {
+   return (__m512i) __builtin_ia32_cvtps2ibs512_mask ((__v16sf) __A,
+ 						     (__v16si) __W,
+ 						     (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_ps_epi8 (__mmask16 __U, __m512 __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2ibs512_mask ((__v16sf) __A,
+ 						(__v16si)
+ 						_mm512_setzero_si512 (),
+ 						(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_ps_epu8 (__m512 __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2iubs512_mask ((__v16sf) __A,
+ 						 (__v16si)
+ 						 _mm512_undefined_si512 (),
+ 						 (__mmask16) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_ps_epu8 (__m512i __W, __mmask16 __U, __m512 __A)
+ {
+   return (__m512i) __builtin_ia32_cvtps2iubs512_mask ((__v16sf) __A,
+ 						      (__v16si) __W,
+ 						      (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_ps_epu8 (__mmask16 __U, __m512 __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2iubs512_mask ((__v16sf) __A,
+ 						 (__v16si)
+ 						 _mm512_setzero_si512 (),
+ 						 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_ph_epi8 (__m512h __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttph2ibs512_mask ((__v32hf) __A,
+ 				       (__v32hi)
+ 				       _mm512_undefined_si512 (),
+ 				       (__mmask32) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_ph_epi8 (__m512i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m512i) __builtin_ia32_cvttph2ibs512_mask ((__v32hf) __A,
+ 						      (__v32hi) __W,
+ 						      (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_ph_epi8 (__mmask32 __U, __m512h __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttph2ibs512_mask ((__v32hf) __A,
+ 						 (__v32hi)
+ 						 _mm512_setzero_si512 (),
+ 						 (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_ph_epu8 (__m512h __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttph2iubs512_mask ((__v32hf) __A,
+ 					(__v32hi)
+ 					_mm512_undefined_si512 (),
+ 					(__mmask32) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_ph_epu8 (__m512i __W, __mmask32 __U, __m512h __A)
+ {
+   return (__m512i) __builtin_ia32_cvttph2iubs512_mask ((__v32hf) __A,
+ 						       (__v32hi) __W,
+ 						       (__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_ph_epu8 (__mmask32 __U, __m512h __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttph2iubs512_mask ((__v32hf) __A,
+ 					(__v32hi)
+ 					_mm512_setzero_si512 (),
+ 					(__mmask32) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_ps_epi8 (__m512 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2ibs512_mask ((__v16sf) __A,
+ 				       (__v16si)
+ 				       _mm512_undefined_si512 (),
+ 				       (__mmask16) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_ps_epi8 (__m512i __W, __mmask16 __U, __m512 __A)
+ {
+   return (__m512i) __builtin_ia32_cvttps2ibs512_mask ((__v16sf) __A,
+ 						      (__v16si) __W,
+ 						      (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_ps_epi8 (__mmask16 __U, __m512 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2ibs512_mask ((__v16sf) __A,
+ 				       (__v16si)
+ 				       _mm512_setzero_si512 (),
+ 				       (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_ps_epu8 (__m512 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2iubs512_mask ((__v16sf) __A,
+ 					(__v16si)
+ 					_mm512_undefined_si512 (),
+ 					(__mmask16) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_ps_epu8 (__m512i __W, __mmask16 __U, __m512 __A)
+ {
+   return (__m512i) __builtin_ia32_cvttps2iubs512_mask ((__v16sf) __A,
+ 						       (__v16si) __W,
+ 						       (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_ps_epu8 (__mmask16 __U, __m512 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2iubs512_mask ((__v16sf) __A,
+ 					(__v16si)
+ 					_mm512_setzero_si512 (),
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_pd_epi32 (__m512d __A)
+ {
+   return (__m256i)
+     __builtin_ia32_cvttpd2dqs512_mask ((__v8df) __A,
+ 				       (__v8si)
+ 				       _mm256_undefined_si256 (),
+ 				       (__mmask8) -1);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_pd_epi32 (__m256i __W, __mmask8 __U, __m512d __A)
+ {
+   return (__m256i) __builtin_ia32_cvttpd2dqs512_mask ((__v8df) __A,
+ 						      (__v8si) __W,
+ 						      (__mmask8) __U);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_pd_epi32 (__mmask8 __U, __m512d __A)
+ {
+   return
+     (__m256i) __builtin_ia32_cvttpd2dqs512_mask ((__v8df) __A,
+ 						 (__v8si)
+ 						 _mm256_setzero_si256 (),
+ 						 (__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_pd_epi64 (__m512d __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttpd2qqs512_mask ((__v8df) __A,
+ 				       (__v8di)
+ 				       _mm512_undefined_si512 (),
+ 				       (__mmask8) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_pd_epi64 (__m512i __W, __mmask8 __U, __m512d __A)
+ {
+   return (__m512i) __builtin_ia32_cvttpd2qqs512_mask ((__v8df) __A,
+ 						      (__v8di) __W,
+ 						      (__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_pd_epi64 (__mmask8 __U, __m512d __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttpd2qqs512_mask ((__v8df) __A,
+ 						 (__v8di)
+ 						 _mm512_setzero_si512 (),
+ 						 (__mmask8) __U);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_pd_epu32 (__m512d __A)
+ {
+   return (__m256i)
+     __builtin_ia32_cvttpd2udqs512_mask ((__v8df) __A,
+ 					(__v8si)
+ 					_mm256_undefined_si256 (),
+ 					(__mmask8) -1);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_pd_epu32 (__m256i __W, __mmask8 __U, __m512d __A)
+ {
+   return (__m256i) __builtin_ia32_cvttpd2udqs512_mask ((__v8df) __A,
+ 						       (__v8si) __W,
+ 						       (__mmask8) __U);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_pd_epu32 (__mmask8 __U, __m512d __A)
+ {
+   return
+     (__m256i) __builtin_ia32_cvttpd2udqs512_mask ((__v8df) __A,
+ 						  (__v8si)
+ 						  _mm256_setzero_si256 (),
+ 						  (__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_pd_epu64 (__m512d __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttpd2uqqs512_mask ((__v8df) __A,
+ 					(__v8di)
+ 					_mm512_undefined_si512 (),
+ 					(__mmask8) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_pd_epu64 (__m512i __W, __mmask8 __U, __m512d __A)
+ {
+   return (__m512i) __builtin_ia32_cvttpd2uqqs512_mask ((__v8df) __A,
+ 						       (__v8di) __W,
+ 						       (__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_pd_epu64 (__mmask8 __U, __m512d __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttpd2uqqs512_mask ((__v8df) __A,
+ 					(__v8di)
+ 					_mm512_setzero_si512 (),
+ 					(__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_ps_epi32 (__m512 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2dqs512_mask ((__v16sf) __A,
+ 				       (__v16si)
+ 				       _mm512_undefined_si512 (),
+ 				       (__mmask16) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_ps_epi32 (__m512i __W, __mmask16 __U, __m512 __A)
+ {
+   return (__m512i) __builtin_ia32_cvttps2dqs512_mask ((__v16sf) __A,
+ 						      (__v16si) __W,
+ 						      (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_ps_epi32 (__mmask16 __U, __m512 __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttps2dqs512_mask ((__v16sf) __A,
+ 						 (__v16si)
+ 						 _mm512_setzero_si512 (),
+ 						 (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_ps_epi64 (__m256 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2qqs512_mask ((__v8sf) __A,
+ 				       (__v8di)
+ 				       _mm512_undefined_si512 (),
+ 				       (__mmask8) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_ps_epi64 (__m512i __W, __mmask8 __U, __m256 __A)
+ {
+   return (__m512i) __builtin_ia32_cvttps2qqs512_mask ((__v8sf) __A,
+ 						      (__v8di) __W,
+ 						      (__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_ps_epi64 (__mmask8 __U, __m256 __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttps2qqs512_mask ((__v8sf) __A,
+ 						 (__v8di)
+ 						 _mm512_setzero_si512 (),
+ 						 (__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_ps_epu32 (__m512 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2udqs512_mask ((__v16sf) __A,
+ 					(__v16si)
+ 					_mm512_undefined_si512 (),
+ 					(__mmask16) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_ps_epu32 (__m512i __W, __mmask16 __U, __m512 __A)
+ {
+   return (__m512i) __builtin_ia32_cvttps2udqs512_mask ((__v16sf) __A,
+ 						       (__v16si) __W,
+ 						       (__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_ps_epu32 (__mmask16 __U, __m512 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2udqs512_mask ((__v16sf) __A,
+ 					(__v16si)
+ 					_mm512_setzero_si512 (),
+ 					(__mmask16) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_ps_epu64 (__m256 __A)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2uqqs512_mask ((__v8sf) __A,
+ 					(__v8di)
+ 					_mm512_undefined_si512 (),
+ 					(__mmask8) -1);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_ps_epu64 (__m512i __W, __mmask8 __U, __m256 __A)
+ {
+   return (__m512i) __builtin_ia32_cvttps2uqqs512_mask ((__v8sf) __A,
+ 						       (__v8di) __W,
+ 						       (__mmask8) __U);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_ps_epu64 (__mmask8 __U, __m256 __A)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttps2uqqs512_mask ((__v8sf) __A,
+ 						  (__v8di)
+ 						  _mm512_setzero_si512 (),
+ 						  (__mmask8) __U);
+ }
+ 
+ #ifdef __OPTIMIZE__
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_roundph_epi8 (__m512h __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) __A,
+ 						      (__v32hi)
+ 						      _mm512_undefined_si512 (),
+ 						      (__mmask32) -1,
+ 						      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_roundph_epi8 (__m512i __W, __mmask32 __U, __m512h __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) __A,
+ 							   (__v32hi) __W,
+ 							   (__mmask32) __U,
+ 							   __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_roundph_epi8 (__mmask32 __U, __m512h __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) __A,
+ 						      (__v32hi)
+ 						      _mm512_setzero_si512 (),
+ 						      (__mmask32) __U,
+ 						      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_roundph_epu8 (__m512h __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) __A,
+ 						       (__v32hi)
+ 						       _mm512_undefined_si512 (),
+ 						       (__mmask32) -1,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_roundph_epu8 (__m512i __W, __mmask32 __U, __m512h __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) __A,
+ 							    (__v32hi) __W,
+ 							    (__mmask32) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_roundph_epu8 (__mmask32 __U, __m512h __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) __A,
+ 						       (__v32hi)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask32) __U,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_roundps_epi8 (__m512 __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) __A,
+ 						      (__v16si)
+ 						      _mm512_undefined_si512 (),
+ 						      (__mmask16) -1,
+ 						      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_roundps_epi8 (__m512i __W, __mmask16 __U, __m512 __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) __A,
+ 							   (__v16si) __W,
+ 							   (__mmask16) __U,
+ 							   __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_roundps_epi8 (__mmask16 __U, __m512 __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) __A,
+ 						      (__v16si)
+ 						      _mm512_setzero_si512 (),
+ 						      (__mmask16) __U,
+ 						      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvts_roundps_epu8 (__m512 __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) __A,
+ 						       (__v16si)
+ 						       _mm512_undefined_si512 (),
+ 						       (__mmask16) -1,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvts_roundps_epu8 (__m512i __W, __mmask16 __U, __m512 __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) __A,
+ 							    (__v16si) __W,
+ 							    (__mmask16) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvts_roundps_epu8 (__mmask16 __U, __m512 __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) __A,
+ 						       (__v16si)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask16) __U,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_roundph_epi8 (__m512h __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) __A,
+ 					     (__v32hi)
+ 					     _mm512_undefined_si512 (),
+ 					     (__mmask32) -1,
+ 					     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_roundph_epi8 (__m512i __W, __mmask32 __U, __m512h __A,
+ 				  const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) __A,
+ 							    (__v32hi) __W,
+ 							    (__mmask32) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_roundph_epi8 (__mmask32 __U, __m512h __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) __A,
+ 						       (__v32hi)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask32) __U,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_roundph_epu8 (__m512h __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) __A,
+ 					      (__v32hi)
+ 					      _mm512_undefined_si512 (),
+ 					      (__mmask32) -1,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_roundph_epu8 (__m512i __W, __mmask32 __U, __m512h __A,
+ 				  const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) __A,
+ 							     (__v32hi) __W,
+ 							     (__mmask32) __U,
+ 							     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_roundph_epu8 (__mmask32 __U, __m512h __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) __A,
+ 					      (__v32hi)
+ 					      _mm512_setzero_si512 (),
+ 					      (__mmask32) __U,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_roundps_epi8 (__m512 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) __A,
+ 					     (__v16si)
+ 					     _mm512_undefined_si512 (),
+ 					     (__mmask16) -1,
+ 					     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_roundps_epi8 (__m512i __W, __mmask16 __U, __m512 __A,
+ 				  const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) __A,
+ 							    (__v16si) __W,
+ 							    (__mmask16) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_roundps_epi8 (__mmask16 __U, __m512 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) __A,
+ 					     (__v16si)
+ 					     _mm512_setzero_si512 (),
+ 					     (__mmask16) __U,
+ 					     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_ipcvtts_roundps_epu8 (__m512 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) __A,
+ 					      (__v16si)
+ 					      _mm512_undefined_si512 (),
+ 					      (__mmask16) -1,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_ipcvtts_roundps_epu8 (__m512i __W, __mmask16 __U, __m512 __A,
+ 				  const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) __A,
+ 							     (__v16si) __W,
+ 							     (__mmask16) __U,
+ 							     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_ipcvtts_roundps_epu8 (__mmask16 __U, __m512 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) __A,
+ 					      (__v16si)
+ 					      _mm512_setzero_si512 (),
+ 					      (__mmask16) __U,
+ 					      __R);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundpd_epi32 (__m512d __A, const int __R)
+ {
+   return (__m256i)
+     __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) __A,
+ 					     (__v8si)
+ 					     _mm256_undefined_si256 (),
+ 					     (__mmask8) -1,
+ 					     __R);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundpd_epi32 (__m256i __W, __mmask8 __U, __m512d __A,
+ 				 const int __R)
+ {
+   return (__m256i) __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) __A,
+ 							    (__v8si) __W,
+ 							    (__mmask8) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundpd_epi32 (__mmask8 __U, __m512d __A, const int __R)
+ {
+   return
+     (__m256i) __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) __A,
+ 						       (__v8si)
+ 						       _mm256_setzero_si256 (),
+ 						       (__mmask8) __U,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundpd_epi64 (__m512d __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) __A,
+ 					     (__v8di)
+ 					     _mm512_undefined_si512 (),
+ 					     (__mmask8) -1,
+ 					     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundpd_epi64 (__m512i __W, __mmask8 __U, __m512d __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) __A,
+ 							    (__v8di) __W,
+ 							    (__mmask8) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundpd_epi64 (__mmask8 __U, __m512d __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) __A,
+ 						       (__v8di)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask8) __U,
+ 						       __R);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundpd_epu32 (__m512d __A, const int __R)
+ {
+   return (__m256i)
+     __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) __A,
+ 					      (__v8si)
+ 					      _mm256_undefined_si256 (),
+ 					      (__mmask8) -1,
+ 					      __R);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundpd_epu32 (__m256i __W, __mmask8 __U, __m512d __A,
+ 				 const int __R)
+ {
+   return (__m256i) __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) __A,
+ 							     (__v8si) __W,
+ 							     (__mmask8) __U,
+ 							     __R);
+ }
+ 
+ extern __inline __m256i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundpd_epu32 (__mmask8 __U, __m512d __A, const int __R)
+ {
+   return
+     (__m256i) __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) __A,
+ 							(__v8si)
+ 							_mm256_setzero_si256 (),
+ 							(__mmask8) __U,
+ 							__R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundpd_epu64 (__m512d __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) __A,
+ 					      (__v8di)
+ 					      _mm512_undefined_si512 (),
+ 					      (__mmask8) -1,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundpd_epu64 (__m512i __W, __mmask8 __U, __m512d __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) __A,
+ 							     (__v8di) __W,
+ 							     (__mmask8) __U,
+ 							     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundpd_epu64 (__mmask8 __U, __m512d __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) __A,
+ 					      (__v8di)
+ 					      _mm512_setzero_si512 (),
+ 					      (__mmask8) __U,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundps_epi32 (__m512 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) __A,
+ 					     (__v16si)
+ 					     _mm512_undefined_si512 (),
+ 					     (__mmask16) -1,
+ 					     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundps_epi32 (__m512i __W, __mmask16 __U, __m512 __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) __A,
+ 							    (__v16si) __W,
+ 							    (__mmask16) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundps_epi32 (__mmask16 __U, __m512 __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) __A,
+ 						       (__v16si)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask16) __U,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundps_epi64 (__m256 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) __A,
+ 					     (__v8di)
+ 					     _mm512_undefined_si512 (),
+ 					     (__mmask8) -1,
+ 					     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundps_epi64 (__m512i __W, __mmask8 __U, __m256 __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) __A,
+ 							    (__v8di) __W,
+ 							    (__mmask8) __U,
+ 							    __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundps_epi64 (__mmask8 __U, __m256 __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) __A,
+ 						       (__v8di)
+ 						       _mm512_setzero_si512 (),
+ 						       (__mmask8) __U,
+ 						       __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundps_epu32 (__m512 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) __A,
+ 					      (__v16si)
+ 					      _mm512_undefined_si512 (),
+ 					      (__mmask16) -1,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundps_epu32 (__m512i __W, __mmask16 __U, __m512 __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) __A,
+ 							     (__v16si) __W,
+ 							     (__mmask16) __U,
+ 							     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundps_epu32 (__mmask16 __U, __m512 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) __A,
+ 					      (__v16si)
+ 					      _mm512_setzero_si512 (),
+ 					      (__mmask16) __U,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_cvtts_roundps_epu64 (__m256 __A, const int __R)
+ {
+   return (__m512i)
+     __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) __A,
+ 					      (__v8di)
+ 					      _mm512_undefined_si512 (),
+ 					      (__mmask8) -1,
+ 					      __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_mask_cvtts_roundps_epu64 (__m512i __W, __mmask8 __U, __m256 __A,
+ 				 const int __R)
+ {
+   return (__m512i) __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) __A,
+ 							     (__v8di) __W,
+ 							     (__mmask8) __U,
+ 							     __R);
+ }
+ 
+ extern __inline __m512i
+ __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
+ _mm512_maskz_cvtts_roundps_epu64 (__mmask8 __U, __m256 __A, const int __R)
+ {
+   return
+     (__m512i) __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) __A,
+ 							(__v8di)
+ 							_mm512_setzero_si512 (),
+ 							(__mmask8) __U,
+ 							__R);
+ }
+ #else
+ #define _mm512_ipcvts_roundph_epi8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) (A), \
+ 					   (__v32hi) \
+ 					   (_mm512_undefined_si512 ()), \
+ 					   (__mmask32) (-1), \
+ 					   (R)))
+ 
+ #define _mm512_mask_ipcvts_roundph_epi8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) (A), \
+ 						     (__v32hi) (W), \
+ 						     (__mmask32) (U), \
+ 						     (R)))
+ 
+ #define _mm512_maskz_ipcvts_roundph_epi8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtph2ibs512_mask_round ((__v32hf) (A), \
+ 					   (__v32hi) \
+ 					   (_mm512_setzero_si512 ()), \
+ 					   (__mmask32) (U), \
+ 					   (R)))
+ 
+ #define _mm512_ipcvts_roundph_epu8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) (A), \
+ 					    (__v32hi) \
+ 					    (_mm512_undefined_si512 ()), \
+ 					    (__mmask32) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_ipcvts_roundph_epu8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) (A), \
+ 						      (__v32hi) (W), \
+ 						      (__mmask32) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_ipcvts_roundph_epu8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtph2iubs512_mask_round ((__v32hf) (A), \
+ 					    (__v32hi) \
+ 					    (_mm512_setzero_si512 ()), \
+ 					    (__mmask32) (U), \
+ 					    (R)))
+ 
+ #define _mm512_ipcvts_roundps_epi8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) (A), \
+ 					   (__v16si) \
+ 					   (_mm512_undefined_si512 ()), \
+ 					   (__mmask16) (-1), \
+ 					   (R)))
+ 
+ #define _mm512_mask_ipcvts_roundps_epi8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) (A), \
+ 						     (__v16si) (W), \
+ 						     (__mmask16) (U), \
+ 						     (R)))
+ 
+ #define _mm512_maskz_ipcvts_roundps_epi8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtps2ibs512_mask_round ((__v16sf) (A), \
+ 					   (__v16si) \
+ 					   (_mm512_setzero_si512 ()), \
+ 					   (__mmask16) (U), \
+ 					   (R)))
+ 
+ #define _mm512_ipcvts_roundps_epu8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) (A), \
+ 					    (__v16si) \
+ 					    (_mm512_undefined_si512 ()), \
+ 					    (__mmask16) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_ipcvts_roundps_epu8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) (A), \
+ 						      (__v16si) (W), \
+ 						      (__mmask16) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_ipcvts_roundps_epu8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvtps2iubs512_mask_round ((__v16sf) (A), \
+ 					    (__v16si) \
+ 					    (_mm512_setzero_si512 ()), \
+ 					    (__mmask16) (U), \
+ 					    (R)))
+ 
+ #define _mm512_ipcvtts_roundph_epi8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) (A), \
+ 					    (__v32hi) \
+ 					    (_mm512_undefined_si512 ()), \
+ 					    (__mmask32) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_ipcvtts_roundph_epi8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) (A), \
+ 						      (__v32hi) (W), \
+ 						      (__mmask32) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_ipcvtts_roundph_epi8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttph2ibs512_mask_round ((__v32hf) (A), \
+ 					    (__v32hi) \
+ 					    (_mm512_setzero_si512 ()), \
+ 					    (__mmask32) (U), \
+ 					    (R)))
+ 
+ #define _mm512_ipcvtts_roundph_epu8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) (A), \
+ 					     (__v32hi) \
+ 					     (_mm512_undefined_si512 ()), \
+ 					     (__mmask32) (-1), \
+ 					     (R)))
+ 
+ #define _mm512_mask_ipcvtts_roundph_epu8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) (A), \
+ 						       (__v32hi) (W), \
+ 						       (__mmask32) (U), \
+ 						       (R)))
+ 
+ #define _mm512_maskz_ipcvtts_roundph_epu8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttph2iubs512_mask_round ((__v32hf) (A), \
+ 					     (__v32hi) \
+ 					     (_mm512_setzero_si512 ()), \
+ 					     (__mmask32) (U), \
+ 					     (R)))
+ 
+ #define _mm512_ipcvtts_roundps_epi8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) (A), \
+ 					    (__v16si) \
+ 					    (_mm512_undefined_si512 ()), \
+ 					    (__mmask16) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_ipcvtts_roundps_epi8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) (A), \
+ 						      (__v16si) (W), \
+ 						      (__mmask16) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_ipcvtts_roundps_epi8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2ibs512_mask_round ((__v16sf) (A), \
+ 					    (__v16si) \
+ 					    (_mm512_setzero_si512 ()), \
+ 					    (__mmask16) (U), \
+ 					    (R)))
+ 
+ #define _mm512_ipcvtts_roundps_epu8(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) (A), \
+ 					     (__v16si) \
+ 					     (_mm512_undefined_si512 ()), \
+ 					     (__mmask16) (-1), \
+ 					     (R)))
+ 
+ #define _mm512_mask_ipcvtts_roundps_epu8(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) (A), \
+ 						       (__v16si) (W), \
+ 						       (__mmask16) (U), \
+ 						       (R)))
+ 
+ #define _mm512_maskz_ipcvtts_roundps_epu8(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2iubs512_mask_round ((__v16sf) (A), \
+ 					     (__v16si) \
+ 					     (_mm512_setzero_si512 ()), \
+ 					     (__mmask16) (U), \
+ 					     (R)))
+ 
+ #define _mm512_cvtts_roundpd_epi32(A, R) \
+   ((__m256i) \
+    __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) (A), \
+ 					    (__v8si) \
+ 					    (_mm256_undefined_si256 ()), \
+ 					    (__mmask8) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_cvtts_roundpd_epi32(W, U, A, R) \
+   ((__m256i) __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) (A), \
+ 						      (__v8si) (W), \
+ 						      (__mmask8) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_cvtts_roundpd_epi32(U, A, R) \
+   ((__m256i) \
+    __builtin_ia32_cvttpd2dqs512_mask_round ((__v8df) (A), \
+ 					    (__v8si) \
+ 					    (_mm256_setzero_si256 ()), \
+ 					    (__mmask8) (U), \
+ 					    (R)))
+ 
+ #define _mm512_cvtts_roundpd_epi64(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) (A), \
+ 					    (__v8di) \
+ 					    (_mm512_undefined_si512 ()), \
+ 					    (__mmask8) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_cvtts_roundpd_epi64(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) (A), \
+ 						      (__v8di) (W), \
+ 						      (__mmask8) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_cvtts_roundpd_epi64(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttpd2qqs512_mask_round ((__v8df) (A), \
+ 					    (__v8di) \
+ 					    (_mm512_setzero_si512 ()), \
+ 					    (__mmask8) (U), \
+ 					    (R)))
+ 
+ #define _mm512_cvtts_roundpd_epu32(A, R) \
+   ((__m256i) \
+    __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) (A), \
+ 					     (__v8si) \
+ 					     (_mm256_undefined_si256 ()), \
+ 					     (__mmask8) (-1), \
+ 					     (R)))
+ 
+ #define _mm512_mask_cvtts_roundpd_epu32(W, U, A, R) \
+   ((__m256i) __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) (A), \
+ 						       (__v8si) (W), \
+ 						       (__mmask8) (U), \
+ 						       (R)))
+ 
+ #define _mm512_maskz_cvtts_roundpd_epu32(U, A, R) \
+   ((__m256i) \
+    __builtin_ia32_cvttpd2udqs512_mask_round ((__v8df) (A), \
+ 					     (__v8si) \
+ 					     (_mm256_setzero_si256 ()), \
+ 					     (__mmask8) (U), \
+ 					     (R)))
+ 
+ #define _mm512_cvtts_roundpd_epu64(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) (A), \
+ 					     (__v8di) \
+ 					     (_mm512_undefined_si512 ()), \
+ 					     (__mmask8) (-1), \
+ 					     (R)))
+ 
+ #define _mm512_mask_cvtts_roundpd_epu64(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) (A), \
+ 						       (__v8di) (W), \
+ 						       (__mmask8) (U), \
+ 						       (R)))
+ 
+ #define _mm512_maskz_cvtts_roundpd_epu64(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttpd2uqqs512_mask_round ((__v8df) (A), \
+ 					     (__v8di) \
+ 					     (_mm512_setzero_si512 ()), \
+ 					     (__mmask8) (U), \
+ 					     (R)))
+ 
+ #define _mm512_cvtts_roundps_epi32(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) (A), \
+ 					    (__v16si) \
+ 					    (_mm512_undefined_si512 ()), \
+ 					    (__mmask16) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_cvtts_roundps_epi32(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) (A), \
+ 						      (__v16si) (W), \
+ 						      (__mmask16) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_cvtts_roundps_epi32(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2dqs512_mask_round ((__v16sf) (A), \
+ 					    (__v16si) \
+ 					    (_mm512_setzero_si512 ()), \
+ 					    (__mmask16) (U), \
+ 					    (R)))
+ 
+ #define _mm512_cvtts_roundps_epi64(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) (A), \
+ 					    (__v8di) \
+ 					    (_mm512_undefined_si512 ()), \
+ 					    (__mmask8) (-1), \
+ 					    (R)))
+ 
+ #define _mm512_mask_cvtts_roundps_epi64(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) (A), \
+ 						      (__v8di) (W), \
+ 						      (__mmask8) (U), \
+ 						      (R)))
+ 
+ #define _mm512_maskz_cvtts_roundps_epi64(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2qqs512_mask_round ((__v8sf) (A), \
+ 					    (__v8di) \
+ 					    (_mm512_setzero_si512 ()), \
+ 					    (__mmask8) (U), \
+ 					    (R)))
+ 
+ #define _mm512_cvtts_roundps_epu32(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) (A), \
+ 					     (__v16si) \
+ 					     (_mm512_undefined_si512 ()), \
+ 					     (__mmask16) (-1), \
+ 					     (R)))
+ 
+ #define _mm512_mask_cvtts_roundps_epu32(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) (A), \
+ 						       (__v16si) (W), \
+ 						       (__mmask16) (U), \
+ 						       (R)))
+ 
+ #define _mm512_maskz_cvtts_roundps_epu32(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2udqs512_mask_round ((__v16sf) (A), \
+ 					     (__v16si) \
+ 					     (_mm512_setzero_si512 ()), \
+ 					     (__mmask16) (U), \
+ 					     (R)))
+ 
+ #define _mm512_cvtts_roundps_epu64(A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) (A), \
+ 					     (__v8di) \
+ 					     (_mm512_undefined_si512 ()), \
+ 					     (__mmask8) (-1), \
+ 					     (R)))
+ 
+ #define _mm512_mask_cvtts_roundps_epu64(W, U, A, R) \
+   ((__m512i) __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) (A), \
+ 						       (__v8di) (W), \
+ 						       (__mmask8) (U), \
+ 						       (R)))
+ 
+ #define _mm512_maskz_cvtts_roundps_epu64(U, A, R) \
+   ((__m512i) \
+    __builtin_ia32_cvttps2uqqs512_mask_round ((__v8sf) (A), \
+ 					     (__v8di) \
+ 					     (_mm512_setzero_si512 ()), \
+ 					     (__mmask8) (U), \
+ 					     (R)))
+ #endif
+ 
  extern __inline int
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm_cvtts_sd_epi32 (__m128d __A)
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512bf16intrin.h gcc-16-20250525/gcc/config/i386/avx512bf16intrin.h
*** gcc-16-20250518/gcc/config/i386/avx512bf16intrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512bf16intrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512BF16INTRIN_H_INCLUDED
  #define _AVX512BF16INTRIN_H_INCLUDED
  
! #if !defined (__AVX512BF16__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512bf16,no-evex512")
  #define __DISABLE_AVX512BF16__
  #endif /* __AVX512BF16__ */
  
--- 28,36 ----
  #ifndef _AVX512BF16INTRIN_H_INCLUDED
  #define _AVX512BF16INTRIN_H_INCLUDED
  
! #if !defined (__AVX512BF16__)
  #pragma GCC push_options
! #pragma GCC target("avx512bf16")
  #define __DISABLE_AVX512BF16__
  #endif /* __AVX512BF16__ */
  
*************** _mm_cvtsbh_ss (__bf16 __A)
*** 42,58 ****
    return __builtin_ia32_cvtbf2sf (__A);
  }
  
- #ifdef __DISABLE_AVX512BF16__
- #undef __DISABLE_AVX512BF16__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX512BF16__ */
- 
- #if !defined (__AVX512BF16__) || !defined (__EVEX512__)
- #pragma GCC push_options
- #pragma GCC target("avx512bf16,evex512")
- #define __DISABLE_AVX512BF16_512__
- #endif /* __AVX512BF16_512__ */
- 
  /* Internal data types for implementing the intrinsics.  */
  typedef __bf16 __v32bf __attribute__ ((__vector_size__ (64)));
  
--- 42,47 ----
*************** _mm512_mask_cvtpbh_ps (__m512 __S, __mma
*** 155,162 ****
  	 (__m512i)_mm512_cvtepi16_epi32 ((__m256i)__A), 16)));
  }
  
! #ifdef __DISABLE_AVX512BF16_512__
! #undef __DISABLE_AVX512BF16_512__
  #pragma GCC pop_options
  #endif /* __DISABLE_AVX512BF16_512__ */
  
--- 144,151 ----
  	 (__m512i)_mm512_cvtepi16_epi32 ((__m256i)__A), 16)));
  }
  
! #ifdef __DISABLE_AVX512BF16__
! #undef __DISABLE_AVX512BF16__
  #pragma GCC pop_options
  #endif /* __DISABLE_AVX512BF16_512__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512bf16vlintrin.h gcc-16-20250525/gcc/config/i386/avx512bf16vlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512bf16vlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512bf16vlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512BF16VLINTRIN_H_INCLUDED
  #define _AVX512BF16VLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512BF16__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512bf16,avx512vl,no-evex512")
  #define __DISABLE_AVX512BF16VL__
  #endif /* __AVX512BF16__ */
  
--- 28,36 ----
  #ifndef _AVX512BF16VLINTRIN_H_INCLUDED
  #define _AVX512BF16VLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512BF16__)
  #pragma GCC push_options
! #pragma GCC target("avx512bf16,avx512vl")
  #define __DISABLE_AVX512BF16VL__
  #endif /* __AVX512BF16__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512bitalgintrin.h gcc-16-20250525/gcc/config/i386/avx512bitalgintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512bitalgintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512bitalgintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512BITALGINTRIN_H_INCLUDED
  #define _AVX512BITALGINTRIN_H_INCLUDED
  
! #if !defined (__AVX512BITALG__) || !defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512bitalg,evex512")
  #define __DISABLE_AVX512BITALG__
  #endif /* __AVX512BITALG__ */
  
--- 28,36 ----
  #ifndef _AVX512BITALGINTRIN_H_INCLUDED
  #define _AVX512BITALGINTRIN_H_INCLUDED
  
! #if !defined (__AVX512BITALG__)
  #pragma GCC push_options
! #pragma GCC target("avx512bitalg")
  #define __DISABLE_AVX512BITALG__
  #endif /* __AVX512BITALG__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512bitalgvlintrin.h gcc-16-20250525/gcc/config/i386/avx512bitalgvlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512bitalgvlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512bitalgvlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512BITALGVLINTRIN_H_INCLUDED
  #define _AVX512BITALGVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512BITALG__) || !defined(__AVX512VL__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512bitalg,avx512vl,no-evex512")
  #define __DISABLE_AVX512BITALGVL__
  #endif /* __AVX512BITALGVL__ */
  
--- 28,36 ----
  #ifndef _AVX512BITALGVLINTRIN_H_INCLUDED
  #define _AVX512BITALGVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512BITALG__) || !defined(__AVX512VL__)
  #pragma GCC push_options
! #pragma GCC target("avx512bitalg,avx512vl")
  #define __DISABLE_AVX512BITALGVL__
  #endif /* __AVX512BITALGVL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512bwintrin.h gcc-16-20250525/gcc/config/i386/avx512bwintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512bwintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512bwintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512BWINTRIN_H_INCLUDED
  #define _AVX512BWINTRIN_H_INCLUDED
  
! #if !defined (__AVX512BW__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512bw,no-evex512")
  #define __DISABLE_AVX512BW__
  #endif /* __AVX512BW__ */
  
--- 28,36 ----
  #ifndef _AVX512BWINTRIN_H_INCLUDED
  #define _AVX512BWINTRIN_H_INCLUDED
  
! #if !defined (__AVX512BW__)
  #pragma GCC push_options
! #pragma GCC target("avx512bw")
  #define __DISABLE_AVX512BW__
  #endif /* __AVX512BW__ */
  
*************** _kandn_mask64 (__mmask64 __A, __mmask64
*** 346,362 ****
    return (__mmask64) __builtin_ia32_kandndi ((__mmask64) __A, (__mmask64) __B);
  }
  
- #ifdef __DISABLE_AVX512BW__
- #undef __DISABLE_AVX512BW__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX512BW__ */
- 
- #if !defined (__AVX512BW__) || !defined (__EVEX512__)
- #pragma GCC push_options
- #pragma GCC target("avx512bw,evex512")
- #define __DISABLE_AVX512BW_512__
- #endif /* __AVX512BW_512__ */
- 
  /* Internal data types for implementing the intrinsics.  */
  typedef short __v32hi __attribute__ ((__vector_size__ (64)));
  typedef short __v32hi_u __attribute__ ((__vector_size__ (64),	\
--- 346,351 ----
*************** _mm512_bsrli_epi128 (__m512i __A, const
*** 3369,3376 ****
  
  #endif
  
! #ifdef __DISABLE_AVX512BW_512__
! #undef __DISABLE_AVX512BW_512__
  #pragma GCC pop_options
  #endif /* __DISABLE_AVX512BW_512__ */
  
--- 3358,3365 ----
  
  #endif
  
! #ifdef __DISABLE_AVX512BW__
! #undef __DISABLE_AVX512BW__
  #pragma GCC pop_options
  #endif /* __DISABLE_AVX512BW_512__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512cdintrin.h gcc-16-20250525/gcc/config/i386/avx512cdintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512cdintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512cdintrin.h	Sun May 25 22:32:05 2025
***************
*** 30,36 ****
  
  #ifndef __AVX512CD__
  #pragma GCC push_options
! #pragma GCC target("avx512cd,evex512")
  #define __DISABLE_AVX512CD__
  #endif /* __AVX512CD__ */
  
--- 30,36 ----
  
  #ifndef __AVX512CD__
  #pragma GCC push_options
! #pragma GCC target("avx512cd")
  #define __DISABLE_AVX512CD__
  #endif /* __AVX512CD__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512dqintrin.h gcc-16-20250525/gcc/config/i386/avx512dqintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512dqintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512dqintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512DQINTRIN_H_INCLUDED
  #define _AVX512DQINTRIN_H_INCLUDED
  
! #if !defined (__AVX512DQ__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512dq,no-evex512")
  #define __DISABLE_AVX512DQ__
  #endif /* __AVX512DQ__ */
  
--- 28,36 ----
  #ifndef _AVX512DQINTRIN_H_INCLUDED
  #define _AVX512DQINTRIN_H_INCLUDED
  
! #if !defined (__AVX512DQ__)
  #pragma GCC push_options
! #pragma GCC target("avx512dq")
  #define __DISABLE_AVX512DQ__
  #endif /* __AVX512DQ__ */
  
*************** _mm_mask_fpclass_sd_mask (__mmask8 __U,
*** 639,655 ****
  
  #endif
  
- #ifdef __DISABLE_AVX512DQ__
- #undef __DISABLE_AVX512DQ__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX512DQ__ */
- 
- #if !defined (__AVX512DQ__) || !defined (__EVEX512__)
- #pragma GCC push_options
- #pragma GCC target("avx512dq,evex512")
- #define __DISABLE_AVX512DQ_512__
- #endif /* __AVX512DQ_512__ */
- 
  extern __inline __m512d
  __attribute__ ((__gnu_inline__, __always_inline__, __artificial__))
  _mm512_broadcast_f64x2 (__m128d __A)
--- 639,644 ----
*************** _mm512_fpclass_ps_mask (__m512 __A, cons
*** 2897,2905 ****
  
  #endif
  
! #ifdef __DISABLE_AVX512DQ_512__
! #undef __DISABLE_AVX512DQ_512__
  #pragma GCC pop_options
! #endif /* __DISABLE_AVX512DQ_512__ */
  
  #endif /* _AVX512DQINTRIN_H_INCLUDED */
--- 2886,2894 ----
  
  #endif
  
! #ifdef __DISABLE_AVX512DQ__
! #undef __DISABLE_AVX512DQ__
  #pragma GCC pop_options
! #endif /* __DISABLE_AVX512DQ__ */
  
  #endif /* _AVX512DQINTRIN_H_INCLUDED */
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512fintrin.h gcc-16-20250525/gcc/config/i386/avx512fintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512fintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512fintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512FINTRIN_H_INCLUDED
  #define _AVX512FINTRIN_H_INCLUDED
  
! #if !defined (__AVX512F__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512f,no-evex512")
  #define __DISABLE_AVX512F__
  #endif /* __AVX512F__ */
  
--- 28,36 ----
  #ifndef _AVX512FINTRIN_H_INCLUDED
  #define _AVX512FINTRIN_H_INCLUDED
  
! #if !defined (__AVX512F__)
  #pragma GCC push_options
! #pragma GCC target("avx512f")
  #define __DISABLE_AVX512F__
  #endif /* __AVX512F__ */
  
*************** typedef enum
*** 54,64 ****
    _MM_MANT_SIGN_nan		/* DEST = NaN if sign(SRC) = 1 */
  } _MM_MANTISSA_SIGN_ENUM;
  
! /* These _mm{,256}_avx512* intrins are duplicated from their _mm{,256}_* forms
!    from AVX2 or before.  We need to add them to prevent target option mismatch
!    when calling AVX512 intrins implemented with these intrins under no-evex512
!    function attribute.  All AVX512 intrins calling those AVX2 intrins or
!    before will change their calls to these AVX512 version.  */
  extern __inline __m128 __attribute__((__gnu_inline__, __always_inline__, __artificial__))
  _mm_avx512_undefined_ps (void)
  {
--- 54,65 ----
    _MM_MANT_SIGN_nan		/* DEST = NaN if sign(SRC) = 1 */
  } _MM_MANTISSA_SIGN_ENUM;
  
! /* These _mm{,256}_avx512* intrins are initially duplicated from their
!    _mm{,256}_* forms from AVX2 or before.  At that time, e need to add them
!    to prevent target option mismatch when calling AVX512 intrins implemented
!    with these intrins under no-evex512 function attribute.  Thess intrins will
!    still be here to avoid huge changes.  All AVX512 intrins calling those AVX2
!    intrins or before have changed their calls to these AVX512 version.  */
  extern __inline __m128 __attribute__((__gnu_inline__, __always_inline__, __artificial__))
  _mm_avx512_undefined_ps (void)
  {
*************** _mm_mask_cmp_ss_mask (__mmask8 __M, __m1
*** 3802,3818 ****
  
  #endif
  
- #ifdef __DISABLE_AVX512F__
- #undef __DISABLE_AVX512F__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX512F__ */
- 
- #if !defined (__AVX512F__) || !defined (__EVEX512__)
- #pragma GCC push_options
- #pragma GCC target("avx512f,evex512")
- #define __DISABLE_AVX512F_512__
- #endif /* __AVX512F_512__ */
- 
  /* Internal data types for implementing the intrinsics.  */
  typedef double __v8df __attribute__ ((__vector_size__ (64)));
  typedef float __v16sf __attribute__ ((__vector_size__ (64)));
--- 3803,3808 ----
*************** _mm512_mask_reduce_max_pd (__mmask8 __U,
*** 16609,16617 ****
  
  #undef __MM512_REDUCE_OP
  
! #ifdef __DISABLE_AVX512F_512__
! #undef __DISABLE_AVX512F_512__
  #pragma GCC pop_options
! #endif /* __DISABLE_AVX512F_512__ */
  
  #endif /* _AVX512FINTRIN_H_INCLUDED */
--- 16599,16607 ----
  
  #undef __MM512_REDUCE_OP
  
! #ifdef __DISABLE_AVX512F__
! #undef __DISABLE_AVX512F__
  #pragma GCC pop_options
! #endif /* __DISABLE_AVX512F__ */
  
  #endif /* _AVX512FINTRIN_H_INCLUDED */
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512fp16intrin.h gcc-16-20250525/gcc/config/i386/avx512fp16intrin.h
*** gcc-16-20250518/gcc/config/i386/avx512fp16intrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512fp16intrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512FP16INTRIN_H_INCLUDED
  #define _AVX512FP16INTRIN_H_INCLUDED
  
! #if !defined (__AVX512FP16__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512fp16,no-evex512")
  #define __DISABLE_AVX512FP16__
  #endif /* __AVX512FP16__ */
  
--- 28,36 ----
  #ifndef _AVX512FP16INTRIN_H_INCLUDED
  #define _AVX512FP16INTRIN_H_INCLUDED
  
! #if !defined (__AVX512FP16__)
  #pragma GCC push_options
! #pragma GCC target("avx512fp16")
  #define __DISABLE_AVX512FP16__
  #endif /* __AVX512FP16__ */
  
*************** _mm_maskz_fmul_round_sch (__mmask8 __A,
*** 2852,2868 ****
  #define _mm_maskz_cmul_round_sch(U, A, B, R)			      \
    _mm_maskz_fcmul_round_sch ((U), (A), (B), (R))
  
- #ifdef __DISABLE_AVX512FP16__
- #undef __DISABLE_AVX512FP16__
- #pragma GCC pop_options
- #endif /* __DISABLE_AVX512FP16__ */
- 
- #if !defined (__AVX512FP16__) || !defined (__EVEX512__)
- #pragma GCC push_options
- #pragma GCC target("avx512fp16,evex512")
- #define __DISABLE_AVX512FP16_512__
- #endif /* __AVX512FP16_512__ */
- 
  typedef _Float16 __v32hf __attribute__ ((__vector_size__ (64)));
  typedef _Float16 __m512h __attribute__ ((__vector_size__ (64), __may_alias__));
  typedef _Float16 __m512h_u __attribute__ ((__vector_size__ (64),	\
--- 2852,2857 ----
*************** _mm512_set1_pch (_Float16 _Complex __A)
*** 7238,7246 ****
  #define _mm512_maskz_cmul_round_pch(U, A, B, R)			      \
    _mm512_maskz_fcmul_round_pch ((U), (A), (B), (R))
  
! #ifdef __DISABLE_AVX512FP16_512__
! #undef __DISABLE_AVX512FP16_512__
  #pragma GCC pop_options
! #endif /* __DISABLE_AVX512FP16_512__ */
  
  #endif /* _AVX512FP16INTRIN_H_INCLUDED */
--- 7227,7235 ----
  #define _mm512_maskz_cmul_round_pch(U, A, B, R)			      \
    _mm512_maskz_fcmul_round_pch ((U), (A), (B), (R))
  
! #ifdef __DISABLE_AVX512FP16__
! #undef __DISABLE_AVX512FP16__
  #pragma GCC pop_options
! #endif /* __DISABLE_AVX512FP16__ */
  
  #endif /* _AVX512FP16INTRIN_H_INCLUDED */
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512fp16vlintrin.h gcc-16-20250525/gcc/config/i386/avx512fp16vlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512fp16vlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512fp16vlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef __AVX512FP16VLINTRIN_H_INCLUDED
  #define __AVX512FP16VLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512FP16__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512fp16,avx512vl,no-evex512")
  #define __DISABLE_AVX512FP16VL__
  #endif /* __AVX512FP16VL__ */
  
--- 28,36 ----
  #ifndef __AVX512FP16VLINTRIN_H_INCLUDED
  #define __AVX512FP16VLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512FP16__)
  #pragma GCC push_options
! #pragma GCC target("avx512fp16,avx512vl")
  #define __DISABLE_AVX512FP16VL__
  #endif /* __AVX512FP16VL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512ifmaintrin.h gcc-16-20250525/gcc/config/i386/avx512ifmaintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512ifmaintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512ifmaintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512IFMAINTRIN_H_INCLUDED
  #define _AVX512IFMAINTRIN_H_INCLUDED
  
! #if !defined (__AVX512IFMA__) || !defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512ifma,evex512")
  #define __DISABLE_AVX512IFMA__
  #endif /* __AVX512IFMA__ */
  
--- 28,36 ----
  #ifndef _AVX512IFMAINTRIN_H_INCLUDED
  #define _AVX512IFMAINTRIN_H_INCLUDED
  
! #if !defined (__AVX512IFMA__)
  #pragma GCC push_options
! #pragma GCC target("avx512ifma")
  #define __DISABLE_AVX512IFMA__
  #endif /* __AVX512IFMA__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512ifmavlintrin.h gcc-16-20250525/gcc/config/i386/avx512ifmavlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512ifmavlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512ifmavlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512IFMAVLINTRIN_H_INCLUDED
  #define _AVX512IFMAVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512IFMA__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512ifma,avx512vl,no-evex512")
  #define __DISABLE_AVX512IFMAVL__
  #endif /* __AVX512IFMAVL__ */
  
--- 28,36 ----
  #ifndef _AVX512IFMAVLINTRIN_H_INCLUDED
  #define _AVX512IFMAVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512IFMA__)
  #pragma GCC push_options
! #pragma GCC target("avx512ifma,avx512vl")
  #define __DISABLE_AVX512IFMAVL__
  #endif /* __AVX512IFMAVL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vbmi2intrin.h gcc-16-20250525/gcc/config/i386/avx512vbmi2intrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vbmi2intrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vbmi2intrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef __AVX512VBMI2INTRIN_H_INCLUDED
  #define __AVX512VBMI2INTRIN_H_INCLUDED
  
! #if !defined(__AVX512VBMI2__) || !defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi2,evex512")
  #define __DISABLE_AVX512VBMI2__
  #endif /* __AVX512VBMI2__ */
  
--- 28,36 ----
  #ifndef __AVX512VBMI2INTRIN_H_INCLUDED
  #define __AVX512VBMI2INTRIN_H_INCLUDED
  
! #if !defined(__AVX512VBMI2__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi2")
  #define __DISABLE_AVX512VBMI2__
  #endif /* __AVX512VBMI2__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vbmi2vlintrin.h gcc-16-20250525/gcc/config/i386/avx512vbmi2vlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vbmi2vlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vbmi2vlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VBMI2VLINTRIN_H_INCLUDED
  #define _AVX512VBMI2VLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512VBMI2__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi2,avx512vl,no-evex512")
  #define __DISABLE_AVX512VBMI2VL__
  #endif /* __AVX512VBMIVL__ */
  
--- 28,36 ----
  #ifndef _AVX512VBMI2VLINTRIN_H_INCLUDED
  #define _AVX512VBMI2VLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512VBMI2__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi2,avx512vl")
  #define __DISABLE_AVX512VBMI2VL__
  #endif /* __AVX512VBMIVL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vbmiintrin.h gcc-16-20250525/gcc/config/i386/avx512vbmiintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vbmiintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vbmiintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VBMIINTRIN_H_INCLUDED
  #define _AVX512VBMIINTRIN_H_INCLUDED
  
! #if !defined (__AVX512VBMI__) || !defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi,evex512")
  #define __DISABLE_AVX512VBMI__
  #endif /* __AVX512VBMI__ */
  
--- 28,36 ----
  #ifndef _AVX512VBMIINTRIN_H_INCLUDED
  #define _AVX512VBMIINTRIN_H_INCLUDED
  
! #if !defined (__AVX512VBMI__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi")
  #define __DISABLE_AVX512VBMI__
  #endif /* __AVX512VBMI__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vbmivlintrin.h gcc-16-20250525/gcc/config/i386/avx512vbmivlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vbmivlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vbmivlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VBMIVLINTRIN_H_INCLUDED
  #define _AVX512VBMIVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512VBMI__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi,avx512vl,no-evex512")
  #define __DISABLE_AVX512VBMIVL__
  #endif /* __AVX512VBMIVL__ */
  
--- 28,36 ----
  #ifndef _AVX512VBMIVLINTRIN_H_INCLUDED
  #define _AVX512VBMIVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512VBMI__)
  #pragma GCC push_options
! #pragma GCC target("avx512vbmi,avx512vl")
  #define __DISABLE_AVX512VBMIVL__
  #endif /* __AVX512VBMIVL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vlbwintrin.h gcc-16-20250525/gcc/config/i386/avx512vlbwintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vlbwintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vlbwintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VLBWINTRIN_H_INCLUDED
  #define _AVX512VLBWINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512BW__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl,avx512bw,no-evex512")
  #define __DISABLE_AVX512VLBW__
  #endif /* __AVX512VLBW__ */
  
--- 28,36 ----
  #ifndef _AVX512VLBWINTRIN_H_INCLUDED
  #define _AVX512VLBWINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512BW__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl,avx512bw")
  #define __DISABLE_AVX512VLBW__
  #endif /* __AVX512VLBW__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vldqintrin.h gcc-16-20250525/gcc/config/i386/avx512vldqintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vldqintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vldqintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VLDQINTRIN_H_INCLUDED
  #define _AVX512VLDQINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512DQ__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl,avx512dq,no-evex512")
  #define __DISABLE_AVX512VLDQ__
  #endif /* __AVX512VLDQ__ */
  
--- 28,36 ----
  #ifndef _AVX512VLDQINTRIN_H_INCLUDED
  #define _AVX512VLDQINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512DQ__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl,avx512dq")
  #define __DISABLE_AVX512VLDQ__
  #endif /* __AVX512VLDQ__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vlintrin.h gcc-16-20250525/gcc/config/i386/avx512vlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VLINTRIN_H_INCLUDED
  #define _AVX512VLINTRIN_H_INCLUDED
  
! #if !defined (__AVX512VL__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl,no-evex512")
  #define __DISABLE_AVX512VL__
  #endif /* __AVX512VL__ */
  
--- 28,36 ----
  #ifndef _AVX512VLINTRIN_H_INCLUDED
  #define _AVX512VLINTRIN_H_INCLUDED
  
! #if !defined (__AVX512VL__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl")
  #define __DISABLE_AVX512VL__
  #endif /* __AVX512VL__ */
  
*************** _mm256_permutex_pd (__m256d __X, const i
*** 13650,13656 ****
  
  #if !defined (__AVX512CD__) || !defined (__AVX512VL__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl,avx512cd,no-evex512")
  #define __DISABLE_AVX512VLCD__
  #endif
  
--- 13650,13656 ----
  
  #if !defined (__AVX512CD__) || !defined (__AVX512VL__)
  #pragma GCC push_options
! #pragma GCC target("avx512vl,avx512cd")
  #define __DISABLE_AVX512VLCD__
  #endif
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vnniintrin.h gcc-16-20250525/gcc/config/i386/avx512vnniintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vnniintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vnniintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef __AVX512VNNIINTRIN_H_INCLUDED
  #define __AVX512VNNIINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VNNI__) || !defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vnni,evex512")
  #define __DISABLE_AVX512VNNI__
  #endif /* __AVX512VNNI__ */
  
--- 28,36 ----
  #ifndef __AVX512VNNIINTRIN_H_INCLUDED
  #define __AVX512VNNIINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VNNI__)
  #pragma GCC push_options
! #pragma GCC target("avx512vnni")
  #define __DISABLE_AVX512VNNI__
  #endif /* __AVX512VNNI__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vnnivlintrin.h gcc-16-20250525/gcc/config/i386/avx512vnnivlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vnnivlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vnnivlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VNNIVLINTRIN_H_INCLUDED
  #define _AVX512VNNIVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512VNNI__) || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vnni,avx512vl,no-evex512")
  #define __DISABLE_AVX512VNNIVL__
  #endif /* __AVX512VNNIVL__ */
  
--- 28,36 ----
  #ifndef _AVX512VNNIVLINTRIN_H_INCLUDED
  #define _AVX512VNNIVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VL__) || !defined(__AVX512VNNI__)
  #pragma GCC push_options
! #pragma GCC target("avx512vnni,avx512vl")
  #define __DISABLE_AVX512VNNIVL__
  #endif /* __AVX512VNNIVL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vp2intersectintrin.h gcc-16-20250525/gcc/config/i386/avx512vp2intersectintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vp2intersectintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vp2intersectintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VP2INTERSECTINTRIN_H_INCLUDED
  #define _AVX512VP2INTERSECTINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VP2INTERSECT__) || !defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vp2intersect,evex512")
  #define __DISABLE_AVX512VP2INTERSECT__
  #endif /* __AVX512VP2INTERSECT__ */
  
--- 28,36 ----
  #ifndef _AVX512VP2INTERSECTINTRIN_H_INCLUDED
  #define _AVX512VP2INTERSECTINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VP2INTERSECT__)
  #pragma GCC push_options
! #pragma GCC target("avx512vp2intersect")
  #define __DISABLE_AVX512VP2INTERSECT__
  #endif /* __AVX512VP2INTERSECT__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vp2intersectvlintrin.h gcc-16-20250525/gcc/config/i386/avx512vp2intersectvlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vp2intersectvlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vp2intersectvlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,37 ****
  #ifndef _AVX512VP2INTERSECTVLINTRIN_H_INCLUDED
  #define _AVX512VP2INTERSECTVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VP2INTERSECT__) || !defined(__AVX512VL__) \
!   || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vp2intersect,avx512vl,no-evex512")
  #define __DISABLE_AVX512VP2INTERSECTVL__
  #endif /* __AVX512VP2INTERSECTVL__ */
  
--- 28,36 ----
  #ifndef _AVX512VP2INTERSECTVLINTRIN_H_INCLUDED
  #define _AVX512VP2INTERSECTVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VP2INTERSECT__) || !defined(__AVX512VL__)
  #pragma GCC push_options
! #pragma GCC target("avx512vp2intersect,avx512vl")
  #define __DISABLE_AVX512VP2INTERSECTVL__
  #endif /* __AVX512VP2INTERSECTVL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vpopcntdqintrin.h gcc-16-20250525/gcc/config/i386/avx512vpopcntdqintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vpopcntdqintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vpopcntdqintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _AVX512VPOPCNTDQINTRIN_H_INCLUDED
  #define _AVX512VPOPCNTDQINTRIN_H_INCLUDED
  
! #if !defined (__AVX512VPOPCNTDQ__) || !defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vpopcntdq,evex512")
  #define __DISABLE_AVX512VPOPCNTDQ__
  #endif /* __AVX512VPOPCNTDQ__ */
  
--- 28,36 ----
  #ifndef _AVX512VPOPCNTDQINTRIN_H_INCLUDED
  #define _AVX512VPOPCNTDQINTRIN_H_INCLUDED
  
! #if !defined (__AVX512VPOPCNTDQ__)
  #pragma GCC push_options
! #pragma GCC target("avx512vpopcntdq")
  #define __DISABLE_AVX512VPOPCNTDQ__
  #endif /* __AVX512VPOPCNTDQ__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/avx512vpopcntdqvlintrin.h gcc-16-20250525/gcc/config/i386/avx512vpopcntdqvlintrin.h
*** gcc-16-20250518/gcc/config/i386/avx512vpopcntdqvlintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/avx512vpopcntdqvlintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,37 ****
  #ifndef _AVX512VPOPCNTDQVLINTRIN_H_INCLUDED
  #define _AVX512VPOPCNTDQVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VPOPCNTDQ__) || !defined(__AVX512VL__) \
!   || defined (__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("avx512vpopcntdq,avx512vl,no-evex512")
  #define __DISABLE_AVX512VPOPCNTDQVL__
  #endif /* __AVX512VPOPCNTDQVL__ */
  
--- 28,36 ----
  #ifndef _AVX512VPOPCNTDQVLINTRIN_H_INCLUDED
  #define _AVX512VPOPCNTDQVLINTRIN_H_INCLUDED
  
! #if !defined(__AVX512VPOPCNTDQ__) || !defined(__AVX512VL__)
  #pragma GCC push_options
! #pragma GCC target("avx512vpopcntdq,avx512vl")
  #define __DISABLE_AVX512VPOPCNTDQVL__
  #endif /* __AVX512VPOPCNTDQVL__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/cygming.h gcc-16-20250525/gcc/config/i386/cygming.h
*** gcc-16-20250518/gcc/config/i386/cygming.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/cygming.h	Sun May 25 22:32:05 2025
*************** do {							\
*** 246,254 ****
  #undef ASM_OUTPUT_LABELREF
  #define  ASM_OUTPUT_LABELREF(STREAM, NAME)	\
  do {						\
    if ((NAME)[0] != FASTCALL_PREFIX)		\
!     fputs (user_label_prefix, (STREAM));	\
!   fputs ((NAME), (STREAM));			\
  } while (0)
  
  /* This does much the same in memory rather than to a stream.  */
--- 246,255 ----
  #undef ASM_OUTPUT_LABELREF
  #define  ASM_OUTPUT_LABELREF(STREAM, NAME)	\
  do {						\
+   const char *prefix = "";			\
    if ((NAME)[0] != FASTCALL_PREFIX)		\
!     prefix = user_label_prefix;			\
!   ix86_asm_output_labelref ((STREAM), prefix, (NAME));	\
  } while (0)
  
  /* This does much the same in memory rather than to a stream.  */
diff -Nrcpad gcc-16-20250518/gcc/config/i386/driver-i386.cc gcc-16-20250525/gcc/config/i386/driver-i386.cc
*** gcc-16-20250518/gcc/config/i386/driver-i386.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/driver-i386.cc	Sun May 25 22:32:05 2025
*************** detect_caches_intel (bool xeon_mp, unsig
*** 374,406 ****
  #define has_feature(f) \
    has_cpu_feature (&cpu_model, cpu_features2, f)
  
- /* We will emit a warning when using AVX10.1 and AVX512 options with one
-    enabled and the other disabled.  Add this function to avoid push "-mno-"
-    options under this scenario for -march=native.  */
- 
- bool check_avx512_features (__processor_model &cpu_model,
- 			    unsigned int (&cpu_features2)[SIZE_OF_CPU_FEATURES],
- 			    const enum processor_features feature)
- {
-   if (has_feature (FEATURE_AVX10_1_256)
-       && ((feature == FEATURE_AVX512F)
- 	  || (feature == FEATURE_AVX512CD)
- 	  || (feature == FEATURE_AVX512DQ)
- 	  || (feature == FEATURE_AVX512BW)
- 	  || (feature == FEATURE_AVX512VL)
- 	  || (feature == FEATURE_AVX512IFMA)
- 	  || (feature == FEATURE_AVX512VBMI)
- 	  || (feature == FEATURE_AVX512VBMI2)
- 	  || (feature == FEATURE_AVX512VNNI)
- 	  || (feature == FEATURE_AVX512VPOPCNTDQ)
- 	  || (feature == FEATURE_AVX512BITALG)
- 	  || (feature == FEATURE_AVX512FP16)
- 	  || (feature == FEATURE_AVX512BF16)))
-     return false;
- 
-   return true;
- }
- 
  /* This will be called by the spec parser in gcc.cc when it sees
     a %:local_cpu_detect(args) construct.  Currently it will be
     called with either "arch [32|64]" or "tune [32|64]" as argument
--- 374,379 ----
*************** const char *host_detect_local_cpu (int a
*** 909,920 ****
  		  options = concat (options, " ",
  				    isa_names_table[i].option, NULL);
  	      }
! 	    /* Never push -mno-avx10.1-{256,512} under -march=native to
! 	       avoid unnecessary warnings when building libraries.  */
! 	    else if (isa_names_table[i].feature != FEATURE_AVX10_1_256
! 		     && isa_names_table[i].feature != FEATURE_AVX10_1
! 		     && check_avx512_features (cpu_model, cpu_features2,
! 					       isa_names_table[i].feature))
  	      options = concat (options, neg_option,
  				isa_names_table[i].option + 2, NULL);
  	  }
--- 882,888 ----
  		  options = concat (options, " ",
  				    isa_names_table[i].option, NULL);
  	      }
! 	    else
  	      options = concat (options, neg_option,
  				isa_names_table[i].option + 2, NULL);
  	  }
diff -Nrcpad gcc-16-20250518/gcc/config/i386/gfniintrin.h gcc-16-20250525/gcc/config/i386/gfniintrin.h
*** gcc-16-20250518/gcc/config/i386/gfniintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/gfniintrin.h	Sun May 25 22:32:05 2025
*************** _mm256_maskz_gf2p8affine_epi64_epi8 (__m
*** 297,305 ****
  #pragma GCC pop_options
  #endif /* __GFNIAVX512VLBW__ */
  
! #if !defined(__GFNI__) || !defined(__EVEX512__) || !defined(__AVX512F__)
  #pragma GCC push_options
! #pragma GCC target("gfni,avx512f,evex512")
  #define __DISABLE_GFNIAVX512F__
  #endif /* __GFNIAVX512F__ */
  
--- 297,305 ----
  #pragma GCC pop_options
  #endif /* __GFNIAVX512VLBW__ */
  
! #if !defined(__GFNI__) || !defined(__AVX512F__)
  #pragma GCC push_options
! #pragma GCC target("gfni,avx512f")
  #define __DISABLE_GFNIAVX512F__
  #endif /* __GFNIAVX512F__ */
  
*************** _mm512_gf2p8affine_epi64_epi8 (__m512i _
*** 341,349 ****
  #pragma GCC pop_options
  #endif /* __GFNIAVX512F__ */
  
! #if !defined(__GFNI__) || !defined(__EVEX512__) || !defined(__AVX512BW__)
  #pragma GCC push_options
! #pragma GCC target("gfni,avx512bw,evex512")
  #define __DISABLE_GFNIAVX512FBW__
  #endif /* __GFNIAVX512FBW__ */
  
--- 341,349 ----
  #pragma GCC pop_options
  #endif /* __GFNIAVX512F__ */
  
! #if !defined(__GFNI__) || !defined(__AVX512BW__)
  #pragma GCC push_options
! #pragma GCC target("gfni,avx512bw")
  #define __DISABLE_GFNIAVX512FBW__
  #endif /* __GFNIAVX512FBW__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386-builtin.def gcc-16-20250525/gcc/config/i386/i386-builtin.def
*** gcc-16-20250518/gcc/config/i386/i386-builtin.def	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386-builtin.def	Sun May 25 22:32:05 2025
*************** BDESC (OPTION_MASK_ISA_AVX2, 0, CODE_FOR
*** 204,256 ****
  BDESC (OPTION_MASK_ISA_AVX2, 0, CODE_FOR_avx2_maskstoreq256, "__builtin_ia32_maskstoreq256", IX86_BUILTIN_MASKSTOREQ256, UNKNOWN, (int) VOID_FTYPE_PV4DI_V4DI_V4DI)
  
  /* AVX512F */
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressstorev16sf_mask, "__builtin_ia32_compressstoresf512_mask", IX86_BUILTIN_COMPRESSPSSTORE512, UNKNOWN, (int) VOID_FTYPE_PV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressstorev16si_mask, "__builtin_ia32_compressstoresi512_mask", IX86_BUILTIN_PCOMPRESSDSTORE512, UNKNOWN, (int) VOID_FTYPE_PV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressstorev8df_mask, "__builtin_ia32_compressstoredf512_mask", IX86_BUILTIN_COMPRESSPDSTORE512, UNKNOWN, (int) VOID_FTYPE_PV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressstorev8di_mask, "__builtin_ia32_compressstoredi512_mask", IX86_BUILTIN_PCOMPRESSQSTORE512, UNKNOWN, (int) VOID_FTYPE_PV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv16sf_mask, "__builtin_ia32_expandloadsf512_mask", IX86_BUILTIN_EXPANDPSLOAD512, UNKNOWN, (int) V16SF_FTYPE_PCV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv16sf_maskz, "__builtin_ia32_expandloadsf512_maskz", IX86_BUILTIN_EXPANDPSLOAD512Z, UNKNOWN, (int) V16SF_FTYPE_PCV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv16si_mask, "__builtin_ia32_expandloadsi512_mask", IX86_BUILTIN_PEXPANDDLOAD512, UNKNOWN, (int) V16SI_FTYPE_PCV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv16si_maskz, "__builtin_ia32_expandloadsi512_maskz", IX86_BUILTIN_PEXPANDDLOAD512Z, UNKNOWN, (int) V16SI_FTYPE_PCV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv8df_mask, "__builtin_ia32_expandloaddf512_mask", IX86_BUILTIN_EXPANDPDLOAD512, UNKNOWN, (int) V8DF_FTYPE_PCV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv8df_maskz, "__builtin_ia32_expandloaddf512_maskz", IX86_BUILTIN_EXPANDPDLOAD512Z, UNKNOWN, (int) V8DF_FTYPE_PCV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv8di_mask, "__builtin_ia32_expandloaddi512_mask", IX86_BUILTIN_PEXPANDQLOAD512, UNKNOWN, (int) V8DI_FTYPE_PCV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv8di_maskz, "__builtin_ia32_expandloaddi512_maskz", IX86_BUILTIN_PEXPANDQLOAD512Z, UNKNOWN, (int) V8DI_FTYPE_PCV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv16si_mask, "__builtin_ia32_loaddqusi512_mask", IX86_BUILTIN_LOADDQUSI512, UNKNOWN, (int) V16SI_FTYPE_PCINT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv8di_mask, "__builtin_ia32_loaddqudi512_mask", IX86_BUILTIN_LOADDQUDI512, UNKNOWN, (int) V8DI_FTYPE_PCINT64_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv8df_mask, "__builtin_ia32_loadupd512_mask", IX86_BUILTIN_LOADUPD512, UNKNOWN, (int) V8DF_FTYPE_PCDOUBLE_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv16sf_mask, "__builtin_ia32_loadups512_mask", IX86_BUILTIN_LOADUPS512, UNKNOWN, (int) V16SF_FTYPE_PCFLOAT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv16sf_mask, "__builtin_ia32_loadaps512_mask", IX86_BUILTIN_LOADAPS512, UNKNOWN, (int) V16SF_FTYPE_PCV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv16si_mask, "__builtin_ia32_movdqa32load512_mask", IX86_BUILTIN_MOVDQA32LOAD512, UNKNOWN, (int) V16SI_FTYPE_PCV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv8df_mask, "__builtin_ia32_loadapd512_mask", IX86_BUILTIN_LOADAPD512, UNKNOWN, (int) V8DF_FTYPE_PCV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv8di_mask, "__builtin_ia32_movdqa64load512_mask", IX86_BUILTIN_MOVDQA64LOAD512, UNKNOWN, (int) V8DI_FTYPE_PCV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_movntv16sf, "__builtin_ia32_movntps512", IX86_BUILTIN_MOVNTPS512, UNKNOWN, (int) VOID_FTYPE_PFLOAT_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_movntv8df, "__builtin_ia32_movntpd512", IX86_BUILTIN_MOVNTPD512, UNKNOWN, (int) VOID_FTYPE_PDOUBLE_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_movntv8di, "__builtin_ia32_movntdq512", IX86_BUILTIN_MOVNTDQ512, UNKNOWN, (int) VOID_FTYPE_PV8DI_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_movntdqa, "__builtin_ia32_movntdqa512", IX86_BUILTIN_MOVNTDQA512, UNKNOWN, (int) V8DI_FTYPE_PV8DI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev16si_mask, "__builtin_ia32_storedqusi512_mask", IX86_BUILTIN_STOREDQUSI512, UNKNOWN, (int) VOID_FTYPE_PINT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev8di_mask, "__builtin_ia32_storedqudi512_mask", IX86_BUILTIN_STOREDQUDI512, UNKNOWN, (int) VOID_FTYPE_PINT64_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev8df_mask, "__builtin_ia32_storeupd512_mask", IX86_BUILTIN_STOREUPD512, UNKNOWN, (int) VOID_FTYPE_PDOUBLE_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev8div8si2_mask_store, "__builtin_ia32_pmovusqd512mem_mask", IX86_BUILTIN_PMOVUSQD512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev8div8si2_mask_store, "__builtin_ia32_pmovsqd512mem_mask", IX86_BUILTIN_PMOVSQD512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev8div8si2_mask_store, "__builtin_ia32_pmovqd512mem_mask", IX86_BUILTIN_PMOVQD512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev8div8hi2_mask_store, "__builtin_ia32_pmovusqw512mem_mask", IX86_BUILTIN_PMOVUSQW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev8div8hi2_mask_store, "__builtin_ia32_pmovsqw512mem_mask", IX86_BUILTIN_PMOVSQW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev8div8hi2_mask_store, "__builtin_ia32_pmovqw512mem_mask", IX86_BUILTIN_PMOVQW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev16siv16hi2_mask_store, "__builtin_ia32_pmovusdw512mem_mask", IX86_BUILTIN_PMOVUSDW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev16siv16hi2_mask_store, "__builtin_ia32_pmovsdw512mem_mask", IX86_BUILTIN_PMOVSDW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev16siv16hi2_mask_store, "__builtin_ia32_pmovdw512mem_mask", IX86_BUILTIN_PMOVDW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev8div16qi2_mask_store_2, "__builtin_ia32_pmovqb512mem_mask", IX86_BUILTIN_PMOVQB512_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev8div16qi2_mask_store_2, "__builtin_ia32_pmovusqb512mem_mask", IX86_BUILTIN_PMOVUSQB512_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev8div16qi2_mask_store_2, "__builtin_ia32_pmovsqb512mem_mask", IX86_BUILTIN_PMOVSQB512_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev16siv16qi2_mask_store, "__builtin_ia32_pmovusdb512mem_mask", IX86_BUILTIN_PMOVUSDB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev16siv16qi2_mask_store, "__builtin_ia32_pmovsdb512mem_mask", IX86_BUILTIN_PMOVSDB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev16siv16qi2_mask_store, "__builtin_ia32_pmovdb512mem_mask", IX86_BUILTIN_PMOVDB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev16sf_mask, "__builtin_ia32_storeups512_mask", IX86_BUILTIN_STOREUPS512, UNKNOWN, (int) VOID_FTYPE_PFLOAT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev16sf_mask, "__builtin_ia32_storeaps512_mask", IX86_BUILTIN_STOREAPS512, UNKNOWN, (int) VOID_FTYPE_PV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev16si_mask, "__builtin_ia32_movdqa32store512_mask", IX86_BUILTIN_MOVDQA32STORE512, UNKNOWN, (int) VOID_FTYPE_PV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev8df_mask, "__builtin_ia32_storeapd512_mask", IX86_BUILTIN_STOREAPD512, UNKNOWN, (int) VOID_FTYPE_PV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_storev8di_mask, "__builtin_ia32_movdqa64store512_mask", IX86_BUILTIN_MOVDQA64STORE512, UNKNOWN, (int) VOID_FTYPE_PV8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loaddf_mask, "__builtin_ia32_loadsd_mask", IX86_BUILTIN_LOADSD_MASK, UNKNOWN, (int) V2DF_FTYPE_PCDOUBLE_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadsf_mask, "__builtin_ia32_loadss_mask", IX86_BUILTIN_LOADSS_MASK, UNKNOWN, (int) V4SF_FTYPE_PCFLOAT_V4SF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storedf_mask, "__builtin_ia32_storesd_mask", IX86_BUILTIN_STORESD_MASK, UNKNOWN, (int) VOID_FTYPE_PDOUBLE_V2DF_UQI)
--- 204,256 ----
  BDESC (OPTION_MASK_ISA_AVX2, 0, CODE_FOR_avx2_maskstoreq256, "__builtin_ia32_maskstoreq256", IX86_BUILTIN_MASKSTOREQ256, UNKNOWN, (int) VOID_FTYPE_PV4DI_V4DI_V4DI)
  
  /* AVX512F */
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressstorev16sf_mask, "__builtin_ia32_compressstoresf512_mask", IX86_BUILTIN_COMPRESSPSSTORE512, UNKNOWN, (int) VOID_FTYPE_PV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressstorev16si_mask, "__builtin_ia32_compressstoresi512_mask", IX86_BUILTIN_PCOMPRESSDSTORE512, UNKNOWN, (int) VOID_FTYPE_PV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressstorev8df_mask, "__builtin_ia32_compressstoredf512_mask", IX86_BUILTIN_COMPRESSPDSTORE512, UNKNOWN, (int) VOID_FTYPE_PV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressstorev8di_mask, "__builtin_ia32_compressstoredi512_mask", IX86_BUILTIN_PCOMPRESSQSTORE512, UNKNOWN, (int) VOID_FTYPE_PV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv16sf_mask, "__builtin_ia32_expandloadsf512_mask", IX86_BUILTIN_EXPANDPSLOAD512, UNKNOWN, (int) V16SF_FTYPE_PCV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv16sf_maskz, "__builtin_ia32_expandloadsf512_maskz", IX86_BUILTIN_EXPANDPSLOAD512Z, UNKNOWN, (int) V16SF_FTYPE_PCV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv16si_mask, "__builtin_ia32_expandloadsi512_mask", IX86_BUILTIN_PEXPANDDLOAD512, UNKNOWN, (int) V16SI_FTYPE_PCV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv16si_maskz, "__builtin_ia32_expandloadsi512_maskz", IX86_BUILTIN_PEXPANDDLOAD512Z, UNKNOWN, (int) V16SI_FTYPE_PCV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv8df_mask, "__builtin_ia32_expandloaddf512_mask", IX86_BUILTIN_EXPANDPDLOAD512, UNKNOWN, (int) V8DF_FTYPE_PCV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv8df_maskz, "__builtin_ia32_expandloaddf512_maskz", IX86_BUILTIN_EXPANDPDLOAD512Z, UNKNOWN, (int) V8DF_FTYPE_PCV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv8di_mask, "__builtin_ia32_expandloaddi512_mask", IX86_BUILTIN_PEXPANDQLOAD512, UNKNOWN, (int) V8DI_FTYPE_PCV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv8di_maskz, "__builtin_ia32_expandloaddi512_maskz", IX86_BUILTIN_PEXPANDQLOAD512Z, UNKNOWN, (int) V8DI_FTYPE_PCV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv16si_mask, "__builtin_ia32_loaddqusi512_mask", IX86_BUILTIN_LOADDQUSI512, UNKNOWN, (int) V16SI_FTYPE_PCINT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv8di_mask, "__builtin_ia32_loaddqudi512_mask", IX86_BUILTIN_LOADDQUDI512, UNKNOWN, (int) V8DI_FTYPE_PCINT64_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv8df_mask, "__builtin_ia32_loadupd512_mask", IX86_BUILTIN_LOADUPD512, UNKNOWN, (int) V8DF_FTYPE_PCDOUBLE_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv16sf_mask, "__builtin_ia32_loadups512_mask", IX86_BUILTIN_LOADUPS512, UNKNOWN, (int) V16SF_FTYPE_PCFLOAT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv16sf_mask, "__builtin_ia32_loadaps512_mask", IX86_BUILTIN_LOADAPS512, UNKNOWN, (int) V16SF_FTYPE_PCV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv16si_mask, "__builtin_ia32_movdqa32load512_mask", IX86_BUILTIN_MOVDQA32LOAD512, UNKNOWN, (int) V16SI_FTYPE_PCV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv8df_mask, "__builtin_ia32_loadapd512_mask", IX86_BUILTIN_LOADAPD512, UNKNOWN, (int) V8DF_FTYPE_PCV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv8di_mask, "__builtin_ia32_movdqa64load512_mask", IX86_BUILTIN_MOVDQA64LOAD512, UNKNOWN, (int) V8DI_FTYPE_PCV8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movntv16sf, "__builtin_ia32_movntps512", IX86_BUILTIN_MOVNTPS512, UNKNOWN, (int) VOID_FTYPE_PFLOAT_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movntv8df, "__builtin_ia32_movntpd512", IX86_BUILTIN_MOVNTPD512, UNKNOWN, (int) VOID_FTYPE_PDOUBLE_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movntv8di, "__builtin_ia32_movntdq512", IX86_BUILTIN_MOVNTDQ512, UNKNOWN, (int) VOID_FTYPE_PV8DI_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movntdqa, "__builtin_ia32_movntdqa512", IX86_BUILTIN_MOVNTDQA512, UNKNOWN, (int) V8DI_FTYPE_PV8DI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev16si_mask, "__builtin_ia32_storedqusi512_mask", IX86_BUILTIN_STOREDQUSI512, UNKNOWN, (int) VOID_FTYPE_PINT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev8di_mask, "__builtin_ia32_storedqudi512_mask", IX86_BUILTIN_STOREDQUDI512, UNKNOWN, (int) VOID_FTYPE_PINT64_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev8df_mask, "__builtin_ia32_storeupd512_mask", IX86_BUILTIN_STOREUPD512, UNKNOWN, (int) VOID_FTYPE_PDOUBLE_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev8div8si2_mask_store, "__builtin_ia32_pmovusqd512mem_mask", IX86_BUILTIN_PMOVUSQD512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev8div8si2_mask_store, "__builtin_ia32_pmovsqd512mem_mask", IX86_BUILTIN_PMOVSQD512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev8div8si2_mask_store, "__builtin_ia32_pmovqd512mem_mask", IX86_BUILTIN_PMOVQD512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev8div8hi2_mask_store, "__builtin_ia32_pmovusqw512mem_mask", IX86_BUILTIN_PMOVUSQW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev8div8hi2_mask_store, "__builtin_ia32_pmovsqw512mem_mask", IX86_BUILTIN_PMOVSQW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev8div8hi2_mask_store, "__builtin_ia32_pmovqw512mem_mask", IX86_BUILTIN_PMOVQW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev16siv16hi2_mask_store, "__builtin_ia32_pmovusdw512mem_mask", IX86_BUILTIN_PMOVUSDW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev16siv16hi2_mask_store, "__builtin_ia32_pmovsdw512mem_mask", IX86_BUILTIN_PMOVSDW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev16siv16hi2_mask_store, "__builtin_ia32_pmovdw512mem_mask", IX86_BUILTIN_PMOVDW512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev8div16qi2_mask_store_2, "__builtin_ia32_pmovqb512mem_mask", IX86_BUILTIN_PMOVQB512_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev8div16qi2_mask_store_2, "__builtin_ia32_pmovusqb512mem_mask", IX86_BUILTIN_PMOVUSQB512_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev8div16qi2_mask_store_2, "__builtin_ia32_pmovsqb512mem_mask", IX86_BUILTIN_PMOVSQB512_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev16siv16qi2_mask_store, "__builtin_ia32_pmovusdb512mem_mask", IX86_BUILTIN_PMOVUSDB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev16siv16qi2_mask_store, "__builtin_ia32_pmovsdb512mem_mask", IX86_BUILTIN_PMOVSDB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev16siv16qi2_mask_store, "__builtin_ia32_pmovdb512mem_mask", IX86_BUILTIN_PMOVDB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev16sf_mask, "__builtin_ia32_storeups512_mask", IX86_BUILTIN_STOREUPS512, UNKNOWN, (int) VOID_FTYPE_PFLOAT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev16sf_mask, "__builtin_ia32_storeaps512_mask", IX86_BUILTIN_STOREAPS512, UNKNOWN, (int) VOID_FTYPE_PV16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev16si_mask, "__builtin_ia32_movdqa32store512_mask", IX86_BUILTIN_MOVDQA32STORE512, UNKNOWN, (int) VOID_FTYPE_PV16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev8df_mask, "__builtin_ia32_storeapd512_mask", IX86_BUILTIN_STOREAPD512, UNKNOWN, (int) VOID_FTYPE_PV8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storev8di_mask, "__builtin_ia32_movdqa64store512_mask", IX86_BUILTIN_MOVDQA64STORE512, UNKNOWN, (int) VOID_FTYPE_PV8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loaddf_mask, "__builtin_ia32_loadsd_mask", IX86_BUILTIN_LOADSD_MASK, UNKNOWN, (int) V2DF_FTYPE_PCDOUBLE_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadsf_mask, "__builtin_ia32_loadss_mask", IX86_BUILTIN_LOADSS_MASK, UNKNOWN, (int) V4SF_FTYPE_PCFLOAT_V4SF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_storedf_mask, "__builtin_ia32_storesd_mask", IX86_BUILTIN_STORESD_MASK, UNKNOWN, (int) VOID_FTYPE_PDOUBLE_V2DF_UQI)
*************** BDESC (OPTION_MASK_ISA_64BIT, OPTION_MAS
*** 297,310 ****
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_CMPCCXADD, CODE_FOR_cmpccxadd_di, "__builtin_ia32_cmpccxadd64", IX86_BUILTIN_CMPCCXADD64, UNKNOWN, (int) LONGLONG_FTYPE_PLONGLONG_LONGLONG_LONGLONG_INT)
  
  /* AVX512BW */
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_loadv32hi_mask, "__builtin_ia32_loaddquhi512_mask", IX86_BUILTIN_LOADDQUHI512_MASK, UNKNOWN, (int) V32HI_FTYPE_PCSHORT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_loadv64qi_mask, "__builtin_ia32_loaddquqi512_mask", IX86_BUILTIN_LOADDQUQI512_MASK, UNKNOWN, (int) V64QI_FTYPE_PCCHAR_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_storev32hi_mask, "__builtin_ia32_storedquhi512_mask", IX86_BUILTIN_STOREDQUHI512_MASK, UNKNOWN, (int) VOID_FTYPE_PSHORT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_storev64qi_mask, "__builtin_ia32_storedquqi512_mask", IX86_BUILTIN_STOREDQUQI512_MASK, UNKNOWN, (int) VOID_FTYPE_PCHAR_V64QI_UDI)
  
  /* AVX512VP2INTERSECT */
! BDESC (0, OPTION_MASK_ISA2_AVX512VP2INTERSECT | OPTION_MASK_ISA2_EVEX512, CODE_FOR_nothing, "__builtin_ia32_2intersectd512", IX86_BUILTIN_2INTERSECTD512, UNKNOWN, (int) VOID_FTYPE_PUHI_PUHI_V16SI_V16SI)
! BDESC (0, OPTION_MASK_ISA2_AVX512VP2INTERSECT | OPTION_MASK_ISA2_EVEX512, CODE_FOR_nothing, "__builtin_ia32_2intersectq512", IX86_BUILTIN_2INTERSECTQ512, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V8DI_V8DI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectd256", IX86_BUILTIN_2INTERSECTD256, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectq256", IX86_BUILTIN_2INTERSECTQ256, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V4DI_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectd128", IX86_BUILTIN_2INTERSECTD128, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V4SI_V4SI)
--- 297,310 ----
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_CMPCCXADD, CODE_FOR_cmpccxadd_di, "__builtin_ia32_cmpccxadd64", IX86_BUILTIN_CMPCCXADD64, UNKNOWN, (int) LONGLONG_FTYPE_PLONGLONG_LONGLONG_LONGLONG_INT)
  
  /* AVX512BW */
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_loadv32hi_mask, "__builtin_ia32_loaddquhi512_mask", IX86_BUILTIN_LOADDQUHI512_MASK, UNKNOWN, (int) V32HI_FTYPE_PCSHORT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_loadv64qi_mask, "__builtin_ia32_loaddquqi512_mask", IX86_BUILTIN_LOADDQUQI512_MASK, UNKNOWN, (int) V64QI_FTYPE_PCCHAR_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_storev32hi_mask, "__builtin_ia32_storedquhi512_mask", IX86_BUILTIN_STOREDQUHI512_MASK, UNKNOWN, (int) VOID_FTYPE_PSHORT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_storev64qi_mask, "__builtin_ia32_storedquqi512_mask", IX86_BUILTIN_STOREDQUQI512_MASK, UNKNOWN, (int) VOID_FTYPE_PCHAR_V64QI_UDI)
  
  /* AVX512VP2INTERSECT */
! BDESC (0, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectd512", IX86_BUILTIN_2INTERSECTD512, UNKNOWN, (int) VOID_FTYPE_PUHI_PUHI_V16SI_V16SI)
! BDESC (0, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectq512", IX86_BUILTIN_2INTERSECTQ512, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V8DI_V8DI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectd256", IX86_BUILTIN_2INTERSECTD256, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectq256", IX86_BUILTIN_2INTERSECTQ256, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V4DI_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512VP2INTERSECT, CODE_FOR_nothing, "__builtin_ia32_2intersectd128", IX86_BUILTIN_2INTERSECTD128, UNKNOWN, (int) VOID_FTYPE_PUQI_PUQI_V4SI_V4SI)
*************** BDESC (OPTION_MASK_ISA_AVX512BW | OPTION
*** 411,419 ****
  BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_ss_truncatev16hiv16qi2_mask_store, "__builtin_ia32_pmovswb256mem_mask", IX86_BUILTIN_PMOVSWB256_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_us_truncatev8hiv8qi2_mask_store_2, "__builtin_ia32_pmovuswb128mem_mask", IX86_BUILTIN_PMOVUSWB128_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_us_truncatev16hiv16qi2_mask_store, "__builtin_ia32_pmovuswb256mem_mask", IX86_BUILTIN_PMOVUSWB256_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_us_truncatev32hiv32qi2_mask_store, "__builtin_ia32_pmovuswb512mem_mask", IX86_BUILTIN_PMOVUSWB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_ss_truncatev32hiv32qi2_mask_store, "__builtin_ia32_pmovswb512mem_mask", IX86_BUILTIN_PMOVSWB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_truncatev32hiv32qi2_mask_store, "__builtin_ia32_pmovwb512mem_mask", IX86_BUILTIN_PMOVWB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32HI_USI)
  
  /* AVX512FP16 */
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_loadhf_mask, "__builtin_ia32_loadsh_mask", IX86_BUILTIN_LOADSH_MASK, UNKNOWN, (int) V8HF_FTYPE_PCFLOAT16_V8HF_UQI)
--- 411,419 ----
  BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_ss_truncatev16hiv16qi2_mask_store, "__builtin_ia32_pmovswb256mem_mask", IX86_BUILTIN_PMOVSWB256_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_us_truncatev8hiv8qi2_mask_store_2, "__builtin_ia32_pmovuswb128mem_mask", IX86_BUILTIN_PMOVUSWB128_MEM, UNKNOWN, (int) VOID_FTYPE_PUDI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_us_truncatev16hiv16qi2_mask_store, "__builtin_ia32_pmovuswb256mem_mask", IX86_BUILTIN_PMOVUSWB256_MEM, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_us_truncatev32hiv32qi2_mask_store, "__builtin_ia32_pmovuswb512mem_mask", IX86_BUILTIN_PMOVUSWB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_ss_truncatev32hiv32qi2_mask_store, "__builtin_ia32_pmovswb512mem_mask", IX86_BUILTIN_PMOVSWB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_truncatev32hiv32qi2_mask_store, "__builtin_ia32_pmovwb512mem_mask", IX86_BUILTIN_PMOVWB512_MEM, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32HI_USI)
  
  /* AVX512FP16 */
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_loadhf_mask, "__builtin_ia32_loadsh_mask", IX86_BUILTIN_LOADSH_MASK, UNKNOWN, (int) V8HF_FTYPE_PCFLOAT16_V8HF_UQI)
*************** BDESC (OPTION_MASK_ISA_PKU, 0, CODE_FOR_
*** 434,450 ****
  BDESC (OPTION_MASK_ISA_PKU, 0, CODE_FOR_wrpkru,  "__builtin_ia32_wrpkru", IX86_BUILTIN_WRPKRU, UNKNOWN, (int) VOID_FTYPE_UNSIGNED)
  
  /* VBMI2 */
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_compressstorev64qi_mask, "__builtin_ia32_compressstoreuqi512_mask", IX86_BUILTIN_PCOMPRESSBSTORE512, UNKNOWN, (int) VOID_FTYPE_PV64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_compressstorev32hi_mask, "__builtin_ia32_compressstoreuhi512_mask", IX86_BUILTIN_PCOMPRESSWSTORE512, UNKNOWN, (int) VOID_FTYPE_PV32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev32qi_mask, "__builtin_ia32_compressstoreuqi256_mask", IX86_BUILTIN_PCOMPRESSBSTORE256, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev16qi_mask, "__builtin_ia32_compressstoreuqi128_mask", IX86_BUILTIN_PCOMPRESSBSTORE128, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16QI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev16hi_mask, "__builtin_ia32_compressstoreuhi256_mask", IX86_BUILTIN_PCOMPRESSWSTORE256, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev8hi_mask, "__builtin_ia32_compressstoreuhi128_mask", IX86_BUILTIN_PCOMPRESSWSTORE128, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8HI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv64qi_mask, "__builtin_ia32_expandloadqi512_mask", IX86_BUILTIN_PEXPANDBLOAD512, UNKNOWN, (int) V64QI_FTYPE_PCV64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv64qi_maskz, "__builtin_ia32_expandloadqi512_maskz", IX86_BUILTIN_PEXPANDBLOAD512Z, UNKNOWN, (int) V64QI_FTYPE_PCV64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv32hi_mask, "__builtin_ia32_expandloadhi512_mask", IX86_BUILTIN_PEXPANDWLOAD512, UNKNOWN, (int) V32HI_FTYPE_PCV32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv32hi_maskz, "__builtin_ia32_expandloadhi512_maskz", IX86_BUILTIN_PEXPANDWLOAD512Z, UNKNOWN, (int) V32HI_FTYPE_PCV32HI_V32HI_USI)
  
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_mask, "__builtin_ia32_expandloadqi256_mask", IX86_BUILTIN_PEXPANDBLOAD256, UNKNOWN, (int) V32QI_FTYPE_PCV32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_maskz, "__builtin_ia32_expandloadqi256_maskz", IX86_BUILTIN_PEXPANDBLOAD256Z, UNKNOWN, (int) V32QI_FTYPE_PCV32QI_V32QI_USI)
--- 434,450 ----
  BDESC (OPTION_MASK_ISA_PKU, 0, CODE_FOR_wrpkru,  "__builtin_ia32_wrpkru", IX86_BUILTIN_WRPKRU, UNKNOWN, (int) VOID_FTYPE_UNSIGNED)
  
  /* VBMI2 */
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_compressstorev64qi_mask, "__builtin_ia32_compressstoreuqi512_mask", IX86_BUILTIN_PCOMPRESSBSTORE512, UNKNOWN, (int) VOID_FTYPE_PV64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_compressstorev32hi_mask, "__builtin_ia32_compressstoreuhi512_mask", IX86_BUILTIN_PCOMPRESSWSTORE512, UNKNOWN, (int) VOID_FTYPE_PV32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev32qi_mask, "__builtin_ia32_compressstoreuqi256_mask", IX86_BUILTIN_PCOMPRESSBSTORE256, UNKNOWN, (int) VOID_FTYPE_PV32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev16qi_mask, "__builtin_ia32_compressstoreuqi128_mask", IX86_BUILTIN_PCOMPRESSBSTORE128, UNKNOWN, (int) VOID_FTYPE_PV16QI_V16QI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev16hi_mask, "__builtin_ia32_compressstoreuhi256_mask", IX86_BUILTIN_PCOMPRESSWSTORE256, UNKNOWN, (int) VOID_FTYPE_PV16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressstorev8hi_mask, "__builtin_ia32_compressstoreuhi128_mask", IX86_BUILTIN_PCOMPRESSWSTORE128, UNKNOWN, (int) VOID_FTYPE_PV8HI_V8HI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv64qi_mask, "__builtin_ia32_expandloadqi512_mask", IX86_BUILTIN_PEXPANDBLOAD512, UNKNOWN, (int) V64QI_FTYPE_PCV64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv64qi_maskz, "__builtin_ia32_expandloadqi512_maskz", IX86_BUILTIN_PEXPANDBLOAD512Z, UNKNOWN, (int) V64QI_FTYPE_PCV64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv32hi_mask, "__builtin_ia32_expandloadhi512_mask", IX86_BUILTIN_PEXPANDWLOAD512, UNKNOWN, (int) V32HI_FTYPE_PCV32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv32hi_maskz, "__builtin_ia32_expandloadhi512_maskz", IX86_BUILTIN_PEXPANDWLOAD512Z, UNKNOWN, (int) V32HI_FTYPE_PCV32HI_V32HI_USI)
  
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_mask, "__builtin_ia32_expandloadqi256_mask", IX86_BUILTIN_PEXPANDBLOAD256, UNKNOWN, (int) V32QI_FTYPE_PCV32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_maskz, "__builtin_ia32_expandloadqi256_maskz", IX86_BUILTIN_PEXPANDBLOAD256Z, UNKNOWN, (int) V32QI_FTYPE_PCV32QI_V32QI_USI)
*************** BDESC (OPTION_MASK_ISA_BMI2, 0, CODE_FOR
*** 1384,1613 ****
  BDESC (OPTION_MASK_ISA_BMI2 | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_bmi2_pext_di3, "__builtin_ia32_pext_di", IX86_BUILTIN_PEXT64, UNKNOWN, (int) UINT64_FTYPE_UINT64_UINT64)
  
  /* AVX512F */
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_si512_256si, "__builtin_ia32_si512_256si", IX86_BUILTIN_SI512_SI256, UNKNOWN, (int) V16SI_FTYPE_V8SI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ps512_256ps, "__builtin_ia32_ps512_256ps", IX86_BUILTIN_PS512_PS256, UNKNOWN, (int) V16SF_FTYPE_V8SF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_pd512_256pd, "__builtin_ia32_pd512_256pd", IX86_BUILTIN_PD512_PD256, UNKNOWN, (int) V8DF_FTYPE_V4DF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_si512_si, "__builtin_ia32_si512_si", IX86_BUILTIN_SI512_SI, UNKNOWN, (int) V16SI_FTYPE_V4SI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ps512_ps, "__builtin_ia32_ps512_ps", IX86_BUILTIN_PS512_PS, UNKNOWN, (int) V16SF_FTYPE_V4SF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_pd512_pd, "__builtin_ia32_pd512_pd", IX86_BUILTIN_PD512_PD, UNKNOWN, (int) V8DF_FTYPE_V2DF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_alignv16si_mask, "__builtin_ia32_alignd512_mask", IX86_BUILTIN_ALIGND512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_alignv8di_mask, "__builtin_ia32_alignq512_mask", IX86_BUILTIN_ALIGNQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_blendmv16si, "__builtin_ia32_blendmd_512_mask", IX86_BUILTIN_BLENDMD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_blendmv8df, "__builtin_ia32_blendmpd_512_mask", IX86_BUILTIN_BLENDMPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_blendmv16sf, "__builtin_ia32_blendmps_512_mask", IX86_BUILTIN_BLENDMPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_blendmv8di, "__builtin_ia32_blendmq_512_mask", IX86_BUILTIN_BLENDMQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_broadcastv16sf_mask, "__builtin_ia32_broadcastf32x4_512", IX86_BUILTIN_BROADCASTF32X4_512, UNKNOWN, (int) V16SF_FTYPE_V4SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_broadcastv8df_mask, "__builtin_ia32_broadcastf64x4_512", IX86_BUILTIN_BROADCASTF64X4_512, UNKNOWN, (int) V8DF_FTYPE_V4DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_broadcastv16si_mask, "__builtin_ia32_broadcasti32x4_512", IX86_BUILTIN_BROADCASTI32X4_512, UNKNOWN, (int) V16SI_FTYPE_V4SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_broadcastv8di_mask, "__builtin_ia32_broadcasti64x4_512", IX86_BUILTIN_BROADCASTI64X4_512, UNKNOWN, (int) V8DI_FTYPE_V4DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vec_dupv8df_mask, "__builtin_ia32_broadcastsd512", IX86_BUILTIN_BROADCASTSD512, UNKNOWN, (int) V8DF_FTYPE_V2DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vec_dupv16sf_mask, "__builtin_ia32_broadcastss512", IX86_BUILTIN_BROADCASTSS512, UNKNOWN, (int) V16SF_FTYPE_V4SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cmpv16si3_mask, "__builtin_ia32_cmpd512_mask", IX86_BUILTIN_CMPD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cmpv8di3_mask, "__builtin_ia32_cmpq512_mask", IX86_BUILTIN_CMPQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressv8df_mask, "__builtin_ia32_compressdf512_mask", IX86_BUILTIN_COMPRESSPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressv16sf_mask, "__builtin_ia32_compresssf512_mask", IX86_BUILTIN_COMPRESSPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatv8siv8df2_mask, "__builtin_ia32_cvtdq2pd512_mask", IX86_BUILTIN_CVTDQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8SI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vcvtps2ph512_mask_sae,  "__builtin_ia32_vcvtps2ph512_mask", IX86_BUILTIN_CVTPS2PH512, UNKNOWN, (int) V16HI_FTYPE_V16SF_INT_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatunsv8siv8df2_mask, "__builtin_ia32_cvtudq2pd512_mask", IX86_BUILTIN_CVTUDQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8SI_V8DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_cvtusi2sd32, "__builtin_ia32_cvtusi2sd32", IX86_BUILTIN_CVTUSI2SD32, UNKNOWN, (int) V2DF_FTYPE_V2DF_UINT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv8df_mask, "__builtin_ia32_expanddf512_mask", IX86_BUILTIN_EXPANDPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv8df_maskz, "__builtin_ia32_expanddf512_maskz", IX86_BUILTIN_EXPANDPD512Z, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv16sf_mask, "__builtin_ia32_expandsf512_mask", IX86_BUILTIN_EXPANDPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv16sf_maskz, "__builtin_ia32_expandsf512_maskz", IX86_BUILTIN_EXPANDPS512Z, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vextractf32x4_mask, "__builtin_ia32_extractf32x4_mask", IX86_BUILTIN_EXTRACTF32X4, UNKNOWN, (int) V4SF_FTYPE_V16SF_INT_V4SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vextractf64x4_mask, "__builtin_ia32_extractf64x4_mask", IX86_BUILTIN_EXTRACTF64X4, UNKNOWN, (int) V4DF_FTYPE_V8DF_INT_V4DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vextracti32x4_mask, "__builtin_ia32_extracti32x4_mask", IX86_BUILTIN_EXTRACTI32X4, UNKNOWN, (int) V4SI_FTYPE_V16SI_INT_V4SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vextracti64x4_mask, "__builtin_ia32_extracti64x4_mask", IX86_BUILTIN_EXTRACTI64X4, UNKNOWN, (int) V4DI_FTYPE_V8DI_INT_V4DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vinsertf32x4_mask, "__builtin_ia32_insertf32x4_mask", IX86_BUILTIN_INSERTF32X4, UNKNOWN, (int) V16SF_FTYPE_V16SF_V4SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vinsertf64x4_mask, "__builtin_ia32_insertf64x4_mask", IX86_BUILTIN_INSERTF64X4, UNKNOWN, (int) V8DF_FTYPE_V8DF_V4DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vinserti32x4_mask, "__builtin_ia32_inserti32x4_mask", IX86_BUILTIN_INSERTI32X4, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vinserti64x4_mask, "__builtin_ia32_inserti64x4_mask", IX86_BUILTIN_INSERTI64X4, UNKNOWN, (int) V8DI_FTYPE_V8DI_V4DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv8df_mask, "__builtin_ia32_movapd512_mask", IX86_BUILTIN_MOVAPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv16sf_mask, "__builtin_ia32_movaps512_mask", IX86_BUILTIN_MOVAPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_movddup512_mask, "__builtin_ia32_movddup512_mask", IX86_BUILTIN_MOVDDUP512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv16si_mask, "__builtin_ia32_movdqa32_512_mask", IX86_BUILTIN_MOVDQA32_512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_loadv8di_mask, "__builtin_ia32_movdqa64_512_mask", IX86_BUILTIN_MOVDQA64_512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_movshdup512_mask, "__builtin_ia32_movshdup512_mask", IX86_BUILTIN_MOVSHDUP512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_movsldup512_mask, "__builtin_ia32_movsldup512_mask", IX86_BUILTIN_MOVSLDUP512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_absv16si2_mask, "__builtin_ia32_pabsd512_mask", IX86_BUILTIN_PABSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_absv8di2_mask, "__builtin_ia32_pabsq512_mask", IX86_BUILTIN_PABSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv16si3_mask, "__builtin_ia32_paddd512_mask", IX86_BUILTIN_PADDD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv8di3_mask, "__builtin_ia32_paddq512_mask", IX86_BUILTIN_PADDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_andv16si3_mask, "__builtin_ia32_pandd512_mask", IX86_BUILTIN_PANDD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_andnotv16si3_mask, "__builtin_ia32_pandnd512_mask", IX86_BUILTIN_PANDND512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_andnotv8di3_mask, "__builtin_ia32_pandnq512_mask", IX86_BUILTIN_PANDNQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_andv8di3_mask, "__builtin_ia32_pandq512_mask", IX86_BUILTIN_PANDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vec_dupv16si_mask, "__builtin_ia32_pbroadcastd512", IX86_BUILTIN_PBROADCASTD512, UNKNOWN, (int) V16SI_FTYPE_V4SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vec_dup_gprv16si_mask, "__builtin_ia32_pbroadcastd512_gpr_mask", IX86_BUILTIN_PBROADCASTD512_GPR, UNKNOWN, (int) V16SI_FTYPE_SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512cd_maskb_vec_dupv8di, "__builtin_ia32_broadcastmb512", IX86_BUILTIN_PBROADCASTMB512, UNKNOWN, (int) V8DI_FTYPE_UQI)
! BDESC (OPTION_MASK_ISA_AVX512CD, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512cd_maskw_vec_dupv16si, "__builtin_ia32_broadcastmw512", IX86_BUILTIN_PBROADCASTMW512, UNKNOWN, (int) V16SI_FTYPE_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vec_dupv8di_mask, "__builtin_ia32_pbroadcastq512", IX86_BUILTIN_PBROADCASTQ512, UNKNOWN, (int) V8DI_FTYPE_V2DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vec_dup_gprv8di_mask, "__builtin_ia32_pbroadcastq512_gpr_mask", IX86_BUILTIN_PBROADCASTQ512_GPR, UNKNOWN, (int) V8DI_FTYPE_DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_eqv16si3_mask, "__builtin_ia32_pcmpeqd512_mask", IX86_BUILTIN_PCMPEQD512_MASK, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_eqv8di3_mask, "__builtin_ia32_pcmpeqq512_mask", IX86_BUILTIN_PCMPEQQ512_MASK, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_gtv16si3_mask, "__builtin_ia32_pcmpgtd512_mask", IX86_BUILTIN_PCMPGTD512_MASK, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_gtv8di3_mask, "__builtin_ia32_pcmpgtq512_mask", IX86_BUILTIN_PCMPGTQ512_MASK, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressv16si_mask, "__builtin_ia32_compresssi512_mask", IX86_BUILTIN_PCOMPRESSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_compressv8di_mask, "__builtin_ia32_compressdi512_mask", IX86_BUILTIN_PCOMPRESSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv16si_mask, "__builtin_ia32_expandsi512_mask", IX86_BUILTIN_PEXPANDD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv16si_maskz, "__builtin_ia32_expandsi512_maskz", IX86_BUILTIN_PEXPANDD512Z, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv8di_mask, "__builtin_ia32_expanddi512_mask", IX86_BUILTIN_PEXPANDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_expandv8di_maskz, "__builtin_ia32_expanddi512_maskz", IX86_BUILTIN_PEXPANDQ512Z, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv16si3_mask, "__builtin_ia32_pmaxsd512_mask", IX86_BUILTIN_PMAXSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv8di3_mask, "__builtin_ia32_pmaxsq512_mask", IX86_BUILTIN_PMAXSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_umaxv16si3_mask, "__builtin_ia32_pmaxud512_mask", IX86_BUILTIN_PMAXUD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_umaxv8di3_mask, "__builtin_ia32_pmaxuq512_mask", IX86_BUILTIN_PMAXUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv16si3_mask, "__builtin_ia32_pminsd512_mask", IX86_BUILTIN_PMINSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv8di3_mask, "__builtin_ia32_pminsq512_mask", IX86_BUILTIN_PMINSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_uminv16si3_mask, "__builtin_ia32_pminud512_mask", IX86_BUILTIN_PMINUD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_uminv8di3_mask, "__builtin_ia32_pminuq512_mask", IX86_BUILTIN_PMINUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev16siv16qi2_mask, "__builtin_ia32_pmovdb512_mask", IX86_BUILTIN_PMOVDB512, UNKNOWN, (int) V16QI_FTYPE_V16SI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev16siv16hi2_mask, "__builtin_ia32_pmovdw512_mask", IX86_BUILTIN_PMOVDW512, UNKNOWN, (int) V16HI_FTYPE_V16SI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev8div16qi2_mask, "__builtin_ia32_pmovqb512_mask", IX86_BUILTIN_PMOVQB512, UNKNOWN, (int) V16QI_FTYPE_V8DI_V16QI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev8div8si2_mask, "__builtin_ia32_pmovqd512_mask", IX86_BUILTIN_PMOVQD512, UNKNOWN, (int) V8SI_FTYPE_V8DI_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_truncatev8div8hi2_mask, "__builtin_ia32_pmovqw512_mask", IX86_BUILTIN_PMOVQW512, UNKNOWN, (int) V8HI_FTYPE_V8DI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev16siv16qi2_mask, "__builtin_ia32_pmovsdb512_mask", IX86_BUILTIN_PMOVSDB512, UNKNOWN, (int) V16QI_FTYPE_V16SI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev16siv16hi2_mask, "__builtin_ia32_pmovsdw512_mask", IX86_BUILTIN_PMOVSDW512, UNKNOWN, (int) V16HI_FTYPE_V16SI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev8div16qi2_mask, "__builtin_ia32_pmovsqb512_mask", IX86_BUILTIN_PMOVSQB512, UNKNOWN, (int) V16QI_FTYPE_V8DI_V16QI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev8div8si2_mask, "__builtin_ia32_pmovsqd512_mask", IX86_BUILTIN_PMOVSQD512, UNKNOWN, (int) V8SI_FTYPE_V8DI_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ss_truncatev8div8hi2_mask, "__builtin_ia32_pmovsqw512_mask", IX86_BUILTIN_PMOVSQW512, UNKNOWN, (int) V8HI_FTYPE_V8DI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sign_extendv16qiv16si2_mask, "__builtin_ia32_pmovsxbd512_mask", IX86_BUILTIN_PMOVSXBD512, UNKNOWN, (int) V16SI_FTYPE_V16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sign_extendv8qiv8di2_mask, "__builtin_ia32_pmovsxbq512_mask", IX86_BUILTIN_PMOVSXBQ512, UNKNOWN, (int) V8DI_FTYPE_V16QI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sign_extendv8siv8di2_mask, "__builtin_ia32_pmovsxdq512_mask", IX86_BUILTIN_PMOVSXDQ512, UNKNOWN, (int) V8DI_FTYPE_V8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sign_extendv16hiv16si2_mask, "__builtin_ia32_pmovsxwd512_mask", IX86_BUILTIN_PMOVSXWD512, UNKNOWN, (int) V16SI_FTYPE_V16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sign_extendv8hiv8di2_mask, "__builtin_ia32_pmovsxwq512_mask", IX86_BUILTIN_PMOVSXWQ512, UNKNOWN, (int) V8DI_FTYPE_V8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev16siv16qi2_mask, "__builtin_ia32_pmovusdb512_mask", IX86_BUILTIN_PMOVUSDB512, UNKNOWN, (int) V16QI_FTYPE_V16SI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev16siv16hi2_mask, "__builtin_ia32_pmovusdw512_mask", IX86_BUILTIN_PMOVUSDW512, UNKNOWN, (int) V16HI_FTYPE_V16SI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev8div16qi2_mask, "__builtin_ia32_pmovusqb512_mask", IX86_BUILTIN_PMOVUSQB512, UNKNOWN, (int) V16QI_FTYPE_V8DI_V16QI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev8div8si2_mask, "__builtin_ia32_pmovusqd512_mask", IX86_BUILTIN_PMOVUSQD512, UNKNOWN, (int) V8SI_FTYPE_V8DI_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_us_truncatev8div8hi2_mask, "__builtin_ia32_pmovusqw512_mask", IX86_BUILTIN_PMOVUSQW512, UNKNOWN, (int) V8HI_FTYPE_V8DI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_zero_extendv16qiv16si2_mask, "__builtin_ia32_pmovzxbd512_mask", IX86_BUILTIN_PMOVZXBD512, UNKNOWN, (int) V16SI_FTYPE_V16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_zero_extendv8qiv8di2_mask, "__builtin_ia32_pmovzxbq512_mask", IX86_BUILTIN_PMOVZXBQ512, UNKNOWN, (int) V8DI_FTYPE_V16QI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_zero_extendv8siv8di2_mask, "__builtin_ia32_pmovzxdq512_mask", IX86_BUILTIN_PMOVZXDQ512, UNKNOWN, (int) V8DI_FTYPE_V8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_zero_extendv16hiv16si2_mask, "__builtin_ia32_pmovzxwd512_mask", IX86_BUILTIN_PMOVZXWD512, UNKNOWN, (int) V16SI_FTYPE_V16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_zero_extendv8hiv8di2_mask, "__builtin_ia32_pmovzxwq512_mask", IX86_BUILTIN_PMOVZXWQ512, UNKNOWN, (int) V8DI_FTYPE_V8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vec_widen_smult_even_v16si_mask, "__builtin_ia32_pmuldq512_mask", IX86_BUILTIN_PMULDQ512, UNKNOWN, (int) V8DI_FTYPE_V16SI_V16SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_mulv16si3_mask, "__builtin_ia32_pmulld512_mask"  , IX86_BUILTIN_PMULLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vec_widen_umult_even_v16si_mask, "__builtin_ia32_pmuludq512_mask", IX86_BUILTIN_PMULUDQ512, UNKNOWN, (int) V8DI_FTYPE_V16SI_V16SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_iorv16si3_mask, "__builtin_ia32_pord512_mask", IX86_BUILTIN_PORD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_iorv8di3_mask, "__builtin_ia32_porq512_mask", IX86_BUILTIN_PORQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rolv16si_mask, "__builtin_ia32_prold512_mask", IX86_BUILTIN_PROLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rolv8di_mask, "__builtin_ia32_prolq512_mask", IX86_BUILTIN_PROLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rolvv16si_mask, "__builtin_ia32_prolvd512_mask", IX86_BUILTIN_PROLVD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rolvv8di_mask, "__builtin_ia32_prolvq512_mask", IX86_BUILTIN_PROLVQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rorv16si_mask, "__builtin_ia32_prord512_mask", IX86_BUILTIN_PRORD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rorv8di_mask, "__builtin_ia32_prorq512_mask", IX86_BUILTIN_PRORQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rorvv16si_mask, "__builtin_ia32_prorvd512_mask", IX86_BUILTIN_PRORVD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rorvv8di_mask, "__builtin_ia32_prorvq512_mask", IX86_BUILTIN_PRORVQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_pshufdv3_mask, "__builtin_ia32_pshufd512_mask", IX86_BUILTIN_PSHUFD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashlv16si3_mask, "__builtin_ia32_pslld512_mask", IX86_BUILTIN_PSLLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashlv16si3_mask, "__builtin_ia32_pslldi512_mask", IX86_BUILTIN_PSLLDI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashlv8di3_mask, "__builtin_ia32_psllq512_mask", IX86_BUILTIN_PSLLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashlv8di3_mask, "__builtin_ia32_psllqi512_mask", IX86_BUILTIN_PSLLQI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ashlvv16si_mask, "__builtin_ia32_psllv16si_mask", IX86_BUILTIN_PSLLVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ashlvv8di_mask, "__builtin_ia32_psllv8di_mask", IX86_BUILTIN_PSLLVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashrv16si3_mask, "__builtin_ia32_psrad512_mask", IX86_BUILTIN_PSRAD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashrv16si3_mask, "__builtin_ia32_psradi512_mask", IX86_BUILTIN_PSRADI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashrv8di3_mask, "__builtin_ia32_psraq512_mask", IX86_BUILTIN_PSRAQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashrv8di3_mask, "__builtin_ia32_psraqi512_mask", IX86_BUILTIN_PSRAQI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ashrvv16si_mask, "__builtin_ia32_psrav16si_mask", IX86_BUILTIN_PSRAVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ashrvv8di_mask, "__builtin_ia32_psrav8di_mask", IX86_BUILTIN_PSRAVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_lshrv16si3_mask, "__builtin_ia32_psrld512_mask", IX86_BUILTIN_PSRLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_lshrv16si3_mask, "__builtin_ia32_psrldi512_mask", IX86_BUILTIN_PSRLDI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_lshrv8di3_mask, "__builtin_ia32_psrlq512_mask", IX86_BUILTIN_PSRLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_lshrv8di3_mask, "__builtin_ia32_psrlqi512_mask", IX86_BUILTIN_PSRLQI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_lshrvv16si_mask, "__builtin_ia32_psrlv16si_mask", IX86_BUILTIN_PSRLVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_lshrvv8di_mask, "__builtin_ia32_psrlv8di_mask", IX86_BUILTIN_PSRLVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv16si3_mask, "__builtin_ia32_psubd512_mask", IX86_BUILTIN_PSUBD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv8di3_mask, "__builtin_ia32_psubq512_mask", IX86_BUILTIN_PSUBQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_testmv16si3_mask, "__builtin_ia32_ptestmd512", IX86_BUILTIN_PTESTMD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_testmv8di3_mask, "__builtin_ia32_ptestmq512", IX86_BUILTIN_PTESTMQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_testnmv16si3_mask, "__builtin_ia32_ptestnmd512", IX86_BUILTIN_PTESTNMD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_testnmv8di3_mask, "__builtin_ia32_ptestnmq512", IX86_BUILTIN_PTESTNMQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_interleave_highv16si_mask, "__builtin_ia32_punpckhdq512_mask", IX86_BUILTIN_PUNPCKHDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_interleave_highv8di_mask, "__builtin_ia32_punpckhqdq512_mask", IX86_BUILTIN_PUNPCKHQDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_interleave_lowv16si_mask, "__builtin_ia32_punpckldq512_mask", IX86_BUILTIN_PUNPCKLDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_interleave_lowv8di_mask, "__builtin_ia32_punpcklqdq512_mask", IX86_BUILTIN_PUNPCKLQDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_xorv16si3_mask, "__builtin_ia32_pxord512_mask", IX86_BUILTIN_PXORD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_xorv8di3_mask, "__builtin_ia32_pxorq512_mask", IX86_BUILTIN_PXORQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_rcp14v8df_mask, "__builtin_ia32_rcp14pd512_mask", IX86_BUILTIN_RCP14PD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_rcp14v16sf_mask, "__builtin_ia32_rcp14ps512_mask", IX86_BUILTIN_RCP14PS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v2df, "__builtin_ia32_rcp14sd", IX86_BUILTIN_RCP14SD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v2df_mask, "__builtin_ia32_rcp14sd_mask", IX86_BUILTIN_RCP14SDMASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v4sf, "__builtin_ia32_rcp14ss", IX86_BUILTIN_RCP14SS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v4sf_mask, "__builtin_ia32_rcp14ss_mask", IX86_BUILTIN_RCP14SSMASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_rsqrt14v8df_mask, "__builtin_ia32_rsqrt14pd512_mask", IX86_BUILTIN_RSQRT14PD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_rsqrt14v16sf_mask, "__builtin_ia32_rsqrt14ps512_mask", IX86_BUILTIN_RSQRT14PS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14v2df, "__builtin_ia32_rsqrt14sd", IX86_BUILTIN_RSQRT14SD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14_v2df_mask, "__builtin_ia32_rsqrt14sd_mask", IX86_BUILTIN_RSQRT14SDMASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14v4sf, "__builtin_ia32_rsqrt14ss", IX86_BUILTIN_RSQRT14SS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14_v4sf_mask, "__builtin_ia32_rsqrt14ss_mask", IX86_BUILTIN_RSQRT14SSMASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_shufpd512_mask, "__builtin_ia32_shufpd512_mask", IX86_BUILTIN_SHUFPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_shufps512_mask, "__builtin_ia32_shufps512_mask", IX86_BUILTIN_SHUFPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_shuf_f32x4_mask, "__builtin_ia32_shuf_f32x4_mask", IX86_BUILTIN_SHUF_F32x4, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_shuf_f64x2_mask, "__builtin_ia32_shuf_f64x2_mask", IX86_BUILTIN_SHUF_F64x2, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_shuf_i32x4_mask, "__builtin_ia32_shuf_i32x4_mask", IX86_BUILTIN_SHUF_I32x4, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_shuf_i64x2_mask, "__builtin_ia32_shuf_i64x2_mask", IX86_BUILTIN_SHUF_I64x2, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ucmpv16si3_mask, "__builtin_ia32_ucmpd512_mask", IX86_BUILTIN_UCMPD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_ucmpv8di3_mask, "__builtin_ia32_ucmpq512_mask", IX86_BUILTIN_UCMPQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_unpckhpd512_mask, "__builtin_ia32_unpckhpd512_mask", IX86_BUILTIN_UNPCKHPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_unpckhps512_mask, "__builtin_ia32_unpckhps512_mask", IX86_BUILTIN_UNPCKHPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_unpcklpd512_mask, "__builtin_ia32_unpcklpd512_mask", IX86_BUILTIN_UNPCKLPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_unpcklps512_mask,  "__builtin_ia32_unpcklps512_mask", IX86_BUILTIN_UNPCKLPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, OPTION_MASK_ISA2_EVEX512, CODE_FOR_clzv16si2_mask, "__builtin_ia32_vplzcntd_512_mask", IX86_BUILTIN_VPCLZCNTD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, OPTION_MASK_ISA2_EVEX512, CODE_FOR_clzv8di2_mask, "__builtin_ia32_vplzcntq_512_mask", IX86_BUILTIN_VPCLZCNTQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512CD, OPTION_MASK_ISA2_EVEX512, CODE_FOR_conflictv16si_mask, "__builtin_ia32_vpconflictsi_512_mask", IX86_BUILTIN_VPCONFLICTD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, OPTION_MASK_ISA2_EVEX512, CODE_FOR_conflictv8di_mask, "__builtin_ia32_vpconflictdi_512_mask", IX86_BUILTIN_VPCONFLICTQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_permv8df_mask, "__builtin_ia32_permdf512_mask", IX86_BUILTIN_VPERMDF512, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_permv8di_mask, "__builtin_ia32_permdi512_mask", IX86_BUILTIN_VPERMDI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermi2varv16si3_mask, "__builtin_ia32_vpermi2vard512_mask", IX86_BUILTIN_VPERMI2VARD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermi2varv8df3_mask, "__builtin_ia32_vpermi2varpd512_mask", IX86_BUILTIN_VPERMI2VARPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermi2varv16sf3_mask, "__builtin_ia32_vpermi2varps512_mask", IX86_BUILTIN_VPERMI2VARPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SI_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermi2varv8di3_mask, "__builtin_ia32_vpermi2varq512_mask", IX86_BUILTIN_VPERMI2VARQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermilv8df_mask, "__builtin_ia32_vpermilpd512_mask", IX86_BUILTIN_VPERMILPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermilv16sf_mask, "__builtin_ia32_vpermilps512_mask", IX86_BUILTIN_VPERMILPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermilvarv8df3_mask, "__builtin_ia32_vpermilvarpd512_mask", IX86_BUILTIN_VPERMILVARPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermilvarv16sf3_mask, "__builtin_ia32_vpermilvarps512_mask", IX86_BUILTIN_VPERMILVARPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SI_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv16si3_mask, "__builtin_ia32_vpermt2vard512_mask", IX86_BUILTIN_VPERMT2VARD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv16si3_maskz, "__builtin_ia32_vpermt2vard512_maskz", IX86_BUILTIN_VPERMT2VARD512_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv8df3_mask, "__builtin_ia32_vpermt2varpd512_mask", IX86_BUILTIN_VPERMT2VARPD512, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv8df3_maskz, "__builtin_ia32_vpermt2varpd512_maskz", IX86_BUILTIN_VPERMT2VARPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv16sf3_mask, "__builtin_ia32_vpermt2varps512_mask", IX86_BUILTIN_VPERMT2VARPS512, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv16sf3_maskz, "__builtin_ia32_vpermt2varps512_maskz", IX86_BUILTIN_VPERMT2VARPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv8di3_mask, "__builtin_ia32_vpermt2varq512_mask", IX86_BUILTIN_VPERMT2VARQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vpermt2varv8di3_maskz, "__builtin_ia32_vpermt2varq512_maskz", IX86_BUILTIN_VPERMT2VARQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_permvarv8df_mask, "__builtin_ia32_permvardf512_mask", IX86_BUILTIN_VPERMVARDF512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_permvarv8di_mask, "__builtin_ia32_permvardi512_mask", IX86_BUILTIN_VPERMVARDI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_permvarv16sf_mask, "__builtin_ia32_permvarsf512_mask", IX86_BUILTIN_VPERMVARSF512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SI_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_permvarv16si_mask, "__builtin_ia32_permvarsi512_mask", IX86_BUILTIN_VPERMVARSI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vternlogv16si_mask, "__builtin_ia32_pternlogd512_mask", IX86_BUILTIN_VTERNLOGD512_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vternlogv16si_maskz, "__builtin_ia32_pternlogd512_maskz", IX86_BUILTIN_VTERNLOGD512_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vternlogv8di_mask, "__builtin_ia32_pternlogq512_mask", IX86_BUILTIN_VTERNLOGQ512_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vternlogv8di_maskz, "__builtin_ia32_pternlogq512_maskz", IX86_BUILTIN_VTERNLOGQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_INT_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movdf_mask, "__builtin_ia32_movesd_mask", IX86_BUILTIN_MOVSD_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movsf_mask, "__builtin_ia32_movess_mask", IX86_BUILTIN_MOVSS_MASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_copysignv16sf3,  "__builtin_ia32_copysignps512", IX86_BUILTIN_CPYSGNPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_copysignv8df3,  "__builtin_ia32_copysignpd512", IX86_BUILTIN_CPYSGNPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sqrtv8df2, "__builtin_ia32_sqrtpd512", IX86_BUILTIN_SQRTPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sqrtv16sf2, "__builtin_ia32_sqrtps512", IX86_BUILTIN_SQRTPS_NR512, UNKNOWN, (int) V16SF_FTYPE_V16SF)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_rndscalev32hf, "__builtin_ia32_floorph512", IX86_BUILTIN_FLOORPH512, (enum rtx_code) ROUND_FLOOR, (int) V32HF_FTYPE_V32HF_ROUND)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_rndscalev32hf, "__builtin_ia32_ceilph512", IX86_BUILTIN_CEILPH512, (enum rtx_code) ROUND_CEIL, (int) V32HF_FTYPE_V32HF_ROUND)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_rndscalev32hf, "__builtin_ia32_truncph512", IX86_BUILTIN_TRUNCPH512, (enum rtx_code) ROUND_TRUNC, (int) V32HF_FTYPE_V32HF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundps512, "__builtin_ia32_floorps512", IX86_BUILTIN_FLOORPS512, (enum rtx_code) ROUND_FLOOR, (int) V16SF_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundps512, "__builtin_ia32_ceilps512", IX86_BUILTIN_CEILPS512, (enum rtx_code) ROUND_CEIL, (int) V16SF_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundps512, "__builtin_ia32_truncps512", IX86_BUILTIN_TRUNCPS512, (enum rtx_code) ROUND_TRUNC, (int) V16SF_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundpd512, "__builtin_ia32_floorpd512", IX86_BUILTIN_FLOORPD512, (enum rtx_code) ROUND_FLOOR, (int) V8DF_FTYPE_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundpd512, "__builtin_ia32_ceilpd512", IX86_BUILTIN_CEILPD512, (enum rtx_code) ROUND_CEIL, (int) V8DF_FTYPE_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundpd512, "__builtin_ia32_truncpd512", IX86_BUILTIN_TRUNCPD512, (enum rtx_code) ROUND_TRUNC, (int) V8DF_FTYPE_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fix_notruncv16sfv16si, "__builtin_ia32_cvtps2dq512", IX86_BUILTIN_CVTPS2DQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vec_pack_sfix_v8df, "__builtin_ia32_vec_pack_sfix512", IX86_BUILTIN_VEC_PACK_SFIX512, UNKNOWN, (int) V16SI_FTYPE_V8DF_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_roundv16sf2_sfix, "__builtin_ia32_roundps_az_sfix512", IX86_BUILTIN_ROUNDPS_AZ_SFIX512, UNKNOWN, (int) V16SI_FTYPE_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundps512_sfix, "__builtin_ia32_floorps_sfix512", IX86_BUILTIN_FLOORPS_SFIX512, (enum rtx_code) ROUND_FLOOR, (int) V16SI_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundps512_sfix, "__builtin_ia32_ceilps_sfix512", IX86_BUILTIN_CEILPS_SFIX512, (enum rtx_code) ROUND_CEIL, (int) V16SI_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_roundv8df2_vec_pack_sfix, "__builtin_ia32_roundpd_az_vec_pack_sfix512", IX86_BUILTIN_ROUNDPD_AZ_VEC_PACK_SFIX512, UNKNOWN, (int) V16SI_FTYPE_V8DF_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundpd_vec_pack_sfix512, "__builtin_ia32_floorpd_vec_pack_sfix512", IX86_BUILTIN_FLOORPD_VEC_PACK_SFIX512, (enum rtx_code) ROUND_FLOOR, (int) V16SI_FTYPE_V8DF_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_roundpd_vec_pack_sfix512, "__builtin_ia32_ceilpd_vec_pack_sfix512", IX86_BUILTIN_CEILPD_VEC_PACK_SFIX512, (enum rtx_code) ROUND_CEIL, (int) V16SI_FTYPE_V8DF_V8DF_ROUND)
  
  /* Mask arithmetic operations */
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_kashiftqi, "__builtin_ia32_kshiftliqi", IX86_BUILTIN_KSHIFTLI8, UNKNOWN, (int) UQI_FTYPE_UQI_UQI_CONST)
--- 1384,1613 ----
  BDESC (OPTION_MASK_ISA_BMI2 | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_bmi2_pext_di3, "__builtin_ia32_pext_di", IX86_BUILTIN_PEXT64, UNKNOWN, (int) UINT64_FTYPE_UINT64_UINT64)
  
  /* AVX512F */
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_si512_256si, "__builtin_ia32_si512_256si", IX86_BUILTIN_SI512_SI256, UNKNOWN, (int) V16SI_FTYPE_V8SI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ps512_256ps, "__builtin_ia32_ps512_256ps", IX86_BUILTIN_PS512_PS256, UNKNOWN, (int) V16SF_FTYPE_V8SF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_pd512_256pd, "__builtin_ia32_pd512_256pd", IX86_BUILTIN_PD512_PD256, UNKNOWN, (int) V8DF_FTYPE_V4DF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_si512_si, "__builtin_ia32_si512_si", IX86_BUILTIN_SI512_SI, UNKNOWN, (int) V16SI_FTYPE_V4SI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ps512_ps, "__builtin_ia32_ps512_ps", IX86_BUILTIN_PS512_PS, UNKNOWN, (int) V16SF_FTYPE_V4SF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_pd512_pd, "__builtin_ia32_pd512_pd", IX86_BUILTIN_PD512_PD, UNKNOWN, (int) V8DF_FTYPE_V2DF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_alignv16si_mask, "__builtin_ia32_alignd512_mask", IX86_BUILTIN_ALIGND512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_alignv8di_mask, "__builtin_ia32_alignq512_mask", IX86_BUILTIN_ALIGNQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_blendmv16si, "__builtin_ia32_blendmd_512_mask", IX86_BUILTIN_BLENDMD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_blendmv8df, "__builtin_ia32_blendmpd_512_mask", IX86_BUILTIN_BLENDMPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_blendmv16sf, "__builtin_ia32_blendmps_512_mask", IX86_BUILTIN_BLENDMPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_blendmv8di, "__builtin_ia32_blendmq_512_mask", IX86_BUILTIN_BLENDMQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_broadcastv16sf_mask, "__builtin_ia32_broadcastf32x4_512", IX86_BUILTIN_BROADCASTF32X4_512, UNKNOWN, (int) V16SF_FTYPE_V4SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_broadcastv8df_mask, "__builtin_ia32_broadcastf64x4_512", IX86_BUILTIN_BROADCASTF64X4_512, UNKNOWN, (int) V8DF_FTYPE_V4DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_broadcastv16si_mask, "__builtin_ia32_broadcasti32x4_512", IX86_BUILTIN_BROADCASTI32X4_512, UNKNOWN, (int) V16SI_FTYPE_V4SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_broadcastv8di_mask, "__builtin_ia32_broadcasti64x4_512", IX86_BUILTIN_BROADCASTI64X4_512, UNKNOWN, (int) V8DI_FTYPE_V4DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vec_dupv8df_mask, "__builtin_ia32_broadcastsd512", IX86_BUILTIN_BROADCASTSD512, UNKNOWN, (int) V8DF_FTYPE_V2DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vec_dupv16sf_mask, "__builtin_ia32_broadcastss512", IX86_BUILTIN_BROADCASTSS512, UNKNOWN, (int) V16SF_FTYPE_V4SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_cmpv16si3_mask, "__builtin_ia32_cmpd512_mask", IX86_BUILTIN_CMPD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_cmpv8di3_mask, "__builtin_ia32_cmpq512_mask", IX86_BUILTIN_CMPQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressv8df_mask, "__builtin_ia32_compressdf512_mask", IX86_BUILTIN_COMPRESSPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressv16sf_mask, "__builtin_ia32_compresssf512_mask", IX86_BUILTIN_COMPRESSPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_floatv8siv8df2_mask, "__builtin_ia32_cvtdq2pd512_mask", IX86_BUILTIN_CVTDQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8SI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vcvtps2ph512_mask_sae,  "__builtin_ia32_vcvtps2ph512_mask", IX86_BUILTIN_CVTPS2PH512, UNKNOWN, (int) V16HI_FTYPE_V16SF_INT_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_floatunsv8siv8df2_mask, "__builtin_ia32_cvtudq2pd512_mask", IX86_BUILTIN_CVTUDQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8SI_V8DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_cvtusi2sd32, "__builtin_ia32_cvtusi2sd32", IX86_BUILTIN_CVTUSI2SD32, UNKNOWN, (int) V2DF_FTYPE_V2DF_UINT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv8df_mask, "__builtin_ia32_expanddf512_mask", IX86_BUILTIN_EXPANDPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv8df_maskz, "__builtin_ia32_expanddf512_maskz", IX86_BUILTIN_EXPANDPD512Z, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv16sf_mask, "__builtin_ia32_expandsf512_mask", IX86_BUILTIN_EXPANDPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv16sf_maskz, "__builtin_ia32_expandsf512_maskz", IX86_BUILTIN_EXPANDPS512Z, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vextractf32x4_mask, "__builtin_ia32_extractf32x4_mask", IX86_BUILTIN_EXTRACTF32X4, UNKNOWN, (int) V4SF_FTYPE_V16SF_INT_V4SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vextractf64x4_mask, "__builtin_ia32_extractf64x4_mask", IX86_BUILTIN_EXTRACTF64X4, UNKNOWN, (int) V4DF_FTYPE_V8DF_INT_V4DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vextracti32x4_mask, "__builtin_ia32_extracti32x4_mask", IX86_BUILTIN_EXTRACTI32X4, UNKNOWN, (int) V4SI_FTYPE_V16SI_INT_V4SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vextracti64x4_mask, "__builtin_ia32_extracti64x4_mask", IX86_BUILTIN_EXTRACTI64X4, UNKNOWN, (int) V4DI_FTYPE_V8DI_INT_V4DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vinsertf32x4_mask, "__builtin_ia32_insertf32x4_mask", IX86_BUILTIN_INSERTF32X4, UNKNOWN, (int) V16SF_FTYPE_V16SF_V4SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vinsertf64x4_mask, "__builtin_ia32_insertf64x4_mask", IX86_BUILTIN_INSERTF64X4, UNKNOWN, (int) V8DF_FTYPE_V8DF_V4DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vinserti32x4_mask, "__builtin_ia32_inserti32x4_mask", IX86_BUILTIN_INSERTI32X4, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vinserti64x4_mask, "__builtin_ia32_inserti64x4_mask", IX86_BUILTIN_INSERTI64X4, UNKNOWN, (int) V8DI_FTYPE_V8DI_V4DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv8df_mask, "__builtin_ia32_movapd512_mask", IX86_BUILTIN_MOVAPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv16sf_mask, "__builtin_ia32_movaps512_mask", IX86_BUILTIN_MOVAPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movddup512_mask, "__builtin_ia32_movddup512_mask", IX86_BUILTIN_MOVDDUP512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv16si_mask, "__builtin_ia32_movdqa32_512_mask", IX86_BUILTIN_MOVDQA32_512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_loadv8di_mask, "__builtin_ia32_movdqa64_512_mask", IX86_BUILTIN_MOVDQA64_512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movshdup512_mask, "__builtin_ia32_movshdup512_mask", IX86_BUILTIN_MOVSHDUP512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movsldup512_mask, "__builtin_ia32_movsldup512_mask", IX86_BUILTIN_MOVSLDUP512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_absv16si2_mask, "__builtin_ia32_pabsd512_mask", IX86_BUILTIN_PABSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_absv8di2_mask, "__builtin_ia32_pabsq512_mask", IX86_BUILTIN_PABSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_addv16si3_mask, "__builtin_ia32_paddd512_mask", IX86_BUILTIN_PADDD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_addv8di3_mask, "__builtin_ia32_paddq512_mask", IX86_BUILTIN_PADDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_andv16si3_mask, "__builtin_ia32_pandd512_mask", IX86_BUILTIN_PANDD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_andnotv16si3_mask, "__builtin_ia32_pandnd512_mask", IX86_BUILTIN_PANDND512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_andnotv8di3_mask, "__builtin_ia32_pandnq512_mask", IX86_BUILTIN_PANDNQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_andv8di3_mask, "__builtin_ia32_pandq512_mask", IX86_BUILTIN_PANDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vec_dupv16si_mask, "__builtin_ia32_pbroadcastd512", IX86_BUILTIN_PBROADCASTD512, UNKNOWN, (int) V16SI_FTYPE_V4SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vec_dup_gprv16si_mask, "__builtin_ia32_pbroadcastd512_gpr_mask", IX86_BUILTIN_PBROADCASTD512_GPR, UNKNOWN, (int) V16SI_FTYPE_SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, 0, CODE_FOR_avx512cd_maskb_vec_dupv8di, "__builtin_ia32_broadcastmb512", IX86_BUILTIN_PBROADCASTMB512, UNKNOWN, (int) V8DI_FTYPE_UQI)
! BDESC (OPTION_MASK_ISA_AVX512CD, 0, CODE_FOR_avx512cd_maskw_vec_dupv16si, "__builtin_ia32_broadcastmw512", IX86_BUILTIN_PBROADCASTMW512, UNKNOWN, (int) V16SI_FTYPE_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vec_dupv8di_mask, "__builtin_ia32_pbroadcastq512", IX86_BUILTIN_PBROADCASTQ512, UNKNOWN, (int) V8DI_FTYPE_V2DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vec_dup_gprv8di_mask, "__builtin_ia32_pbroadcastq512_gpr_mask", IX86_BUILTIN_PBROADCASTQ512_GPR, UNKNOWN, (int) V8DI_FTYPE_DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_eqv16si3_mask, "__builtin_ia32_pcmpeqd512_mask", IX86_BUILTIN_PCMPEQD512_MASK, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_eqv8di3_mask, "__builtin_ia32_pcmpeqq512_mask", IX86_BUILTIN_PCMPEQQ512_MASK, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_gtv16si3_mask, "__builtin_ia32_pcmpgtd512_mask", IX86_BUILTIN_PCMPGTD512_MASK, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_gtv8di3_mask, "__builtin_ia32_pcmpgtq512_mask", IX86_BUILTIN_PCMPGTQ512_MASK, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressv16si_mask, "__builtin_ia32_compresssi512_mask", IX86_BUILTIN_PCOMPRESSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_compressv8di_mask, "__builtin_ia32_compressdi512_mask", IX86_BUILTIN_PCOMPRESSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv16si_mask, "__builtin_ia32_expandsi512_mask", IX86_BUILTIN_PEXPANDD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv16si_maskz, "__builtin_ia32_expandsi512_maskz", IX86_BUILTIN_PEXPANDD512Z, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_expandv8di_mask, "__builtin_ia32_expanddi512_mask", IX86_BUILTIN_PEXPANDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_expandv8di_maskz, "__builtin_ia32_expanddi512_maskz", IX86_BUILTIN_PEXPANDQ512Z, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_smaxv16si3_mask, "__builtin_ia32_pmaxsd512_mask", IX86_BUILTIN_PMAXSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_smaxv8di3_mask, "__builtin_ia32_pmaxsq512_mask", IX86_BUILTIN_PMAXSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_umaxv16si3_mask, "__builtin_ia32_pmaxud512_mask", IX86_BUILTIN_PMAXUD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_umaxv8di3_mask, "__builtin_ia32_pmaxuq512_mask", IX86_BUILTIN_PMAXUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sminv16si3_mask, "__builtin_ia32_pminsd512_mask", IX86_BUILTIN_PMINSD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sminv8di3_mask, "__builtin_ia32_pminsq512_mask", IX86_BUILTIN_PMINSQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_uminv16si3_mask, "__builtin_ia32_pminud512_mask", IX86_BUILTIN_PMINUD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_uminv8di3_mask, "__builtin_ia32_pminuq512_mask", IX86_BUILTIN_PMINUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev16siv16qi2_mask, "__builtin_ia32_pmovdb512_mask", IX86_BUILTIN_PMOVDB512, UNKNOWN, (int) V16QI_FTYPE_V16SI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev16siv16hi2_mask, "__builtin_ia32_pmovdw512_mask", IX86_BUILTIN_PMOVDW512, UNKNOWN, (int) V16HI_FTYPE_V16SI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev8div16qi2_mask, "__builtin_ia32_pmovqb512_mask", IX86_BUILTIN_PMOVQB512, UNKNOWN, (int) V16QI_FTYPE_V8DI_V16QI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev8div8si2_mask, "__builtin_ia32_pmovqd512_mask", IX86_BUILTIN_PMOVQD512, UNKNOWN, (int) V8SI_FTYPE_V8DI_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_truncatev8div8hi2_mask, "__builtin_ia32_pmovqw512_mask", IX86_BUILTIN_PMOVQW512, UNKNOWN, (int) V8HI_FTYPE_V8DI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev16siv16qi2_mask, "__builtin_ia32_pmovsdb512_mask", IX86_BUILTIN_PMOVSDB512, UNKNOWN, (int) V16QI_FTYPE_V16SI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev16siv16hi2_mask, "__builtin_ia32_pmovsdw512_mask", IX86_BUILTIN_PMOVSDW512, UNKNOWN, (int) V16HI_FTYPE_V16SI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev8div16qi2_mask, "__builtin_ia32_pmovsqb512_mask", IX86_BUILTIN_PMOVSQB512, UNKNOWN, (int) V16QI_FTYPE_V8DI_V16QI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev8div8si2_mask, "__builtin_ia32_pmovsqd512_mask", IX86_BUILTIN_PMOVSQD512, UNKNOWN, (int) V8SI_FTYPE_V8DI_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ss_truncatev8div8hi2_mask, "__builtin_ia32_pmovsqw512_mask", IX86_BUILTIN_PMOVSQW512, UNKNOWN, (int) V8HI_FTYPE_V8DI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sign_extendv16qiv16si2_mask, "__builtin_ia32_pmovsxbd512_mask", IX86_BUILTIN_PMOVSXBD512, UNKNOWN, (int) V16SI_FTYPE_V16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sign_extendv8qiv8di2_mask, "__builtin_ia32_pmovsxbq512_mask", IX86_BUILTIN_PMOVSXBQ512, UNKNOWN, (int) V8DI_FTYPE_V16QI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sign_extendv8siv8di2_mask, "__builtin_ia32_pmovsxdq512_mask", IX86_BUILTIN_PMOVSXDQ512, UNKNOWN, (int) V8DI_FTYPE_V8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sign_extendv16hiv16si2_mask, "__builtin_ia32_pmovsxwd512_mask", IX86_BUILTIN_PMOVSXWD512, UNKNOWN, (int) V16SI_FTYPE_V16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sign_extendv8hiv8di2_mask, "__builtin_ia32_pmovsxwq512_mask", IX86_BUILTIN_PMOVSXWQ512, UNKNOWN, (int) V8DI_FTYPE_V8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev16siv16qi2_mask, "__builtin_ia32_pmovusdb512_mask", IX86_BUILTIN_PMOVUSDB512, UNKNOWN, (int) V16QI_FTYPE_V16SI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev16siv16hi2_mask, "__builtin_ia32_pmovusdw512_mask", IX86_BUILTIN_PMOVUSDW512, UNKNOWN, (int) V16HI_FTYPE_V16SI_V16HI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev8div16qi2_mask, "__builtin_ia32_pmovusqb512_mask", IX86_BUILTIN_PMOVUSQB512, UNKNOWN, (int) V16QI_FTYPE_V8DI_V16QI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev8div8si2_mask, "__builtin_ia32_pmovusqd512_mask", IX86_BUILTIN_PMOVUSQD512, UNKNOWN, (int) V8SI_FTYPE_V8DI_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_us_truncatev8div8hi2_mask, "__builtin_ia32_pmovusqw512_mask", IX86_BUILTIN_PMOVUSQW512, UNKNOWN, (int) V8HI_FTYPE_V8DI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_zero_extendv16qiv16si2_mask, "__builtin_ia32_pmovzxbd512_mask", IX86_BUILTIN_PMOVZXBD512, UNKNOWN, (int) V16SI_FTYPE_V16QI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_zero_extendv8qiv8di2_mask, "__builtin_ia32_pmovzxbq512_mask", IX86_BUILTIN_PMOVZXBQ512, UNKNOWN, (int) V8DI_FTYPE_V16QI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_zero_extendv8siv8di2_mask, "__builtin_ia32_pmovzxdq512_mask", IX86_BUILTIN_PMOVZXDQ512, UNKNOWN, (int) V8DI_FTYPE_V8SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_zero_extendv16hiv16si2_mask, "__builtin_ia32_pmovzxwd512_mask", IX86_BUILTIN_PMOVZXWD512, UNKNOWN, (int) V16SI_FTYPE_V16HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_zero_extendv8hiv8di2_mask, "__builtin_ia32_pmovzxwq512_mask", IX86_BUILTIN_PMOVZXWQ512, UNKNOWN, (int) V8DI_FTYPE_V8HI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_vec_widen_smult_even_v16si_mask, "__builtin_ia32_pmuldq512_mask", IX86_BUILTIN_PMULDQ512, UNKNOWN, (int) V8DI_FTYPE_V16SI_V16SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_mulv16si3_mask, "__builtin_ia32_pmulld512_mask"  , IX86_BUILTIN_PMULLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_vec_widen_umult_even_v16si_mask, "__builtin_ia32_pmuludq512_mask", IX86_BUILTIN_PMULUDQ512, UNKNOWN, (int) V8DI_FTYPE_V16SI_V16SI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_iorv16si3_mask, "__builtin_ia32_pord512_mask", IX86_BUILTIN_PORD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_iorv8di3_mask, "__builtin_ia32_porq512_mask", IX86_BUILTIN_PORQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rolv16si_mask, "__builtin_ia32_prold512_mask", IX86_BUILTIN_PROLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rolv8di_mask, "__builtin_ia32_prolq512_mask", IX86_BUILTIN_PROLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rolvv16si_mask, "__builtin_ia32_prolvd512_mask", IX86_BUILTIN_PROLVD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rolvv8di_mask, "__builtin_ia32_prolvq512_mask", IX86_BUILTIN_PROLVQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rorv16si_mask, "__builtin_ia32_prord512_mask", IX86_BUILTIN_PRORD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rorv8di_mask, "__builtin_ia32_prorq512_mask", IX86_BUILTIN_PRORQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rorvv16si_mask, "__builtin_ia32_prorvd512_mask", IX86_BUILTIN_PRORVD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rorvv8di_mask, "__builtin_ia32_prorvq512_mask", IX86_BUILTIN_PRORVQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_pshufdv3_mask, "__builtin_ia32_pshufd512_mask", IX86_BUILTIN_PSHUFD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashlv16si3_mask, "__builtin_ia32_pslld512_mask", IX86_BUILTIN_PSLLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashlv16si3_mask, "__builtin_ia32_pslldi512_mask", IX86_BUILTIN_PSLLDI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashlv8di3_mask, "__builtin_ia32_psllq512_mask", IX86_BUILTIN_PSLLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashlv8di3_mask, "__builtin_ia32_psllqi512_mask", IX86_BUILTIN_PSLLQI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ashlvv16si_mask, "__builtin_ia32_psllv16si_mask", IX86_BUILTIN_PSLLVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ashlvv8di_mask, "__builtin_ia32_psllv8di_mask", IX86_BUILTIN_PSLLVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashrv16si3_mask, "__builtin_ia32_psrad512_mask", IX86_BUILTIN_PSRAD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashrv16si3_mask, "__builtin_ia32_psradi512_mask", IX86_BUILTIN_PSRADI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashrv8di3_mask, "__builtin_ia32_psraq512_mask", IX86_BUILTIN_PSRAQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_ashrv8di3_mask, "__builtin_ia32_psraqi512_mask", IX86_BUILTIN_PSRAQI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ashrvv16si_mask, "__builtin_ia32_psrav16si_mask", IX86_BUILTIN_PSRAVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ashrvv8di_mask, "__builtin_ia32_psrav8di_mask", IX86_BUILTIN_PSRAVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_lshrv16si3_mask, "__builtin_ia32_psrld512_mask", IX86_BUILTIN_PSRLD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V4SI_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_lshrv16si3_mask, "__builtin_ia32_psrldi512_mask", IX86_BUILTIN_PSRLDI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_INT_V16SI_UHI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_lshrv8di3_mask, "__builtin_ia32_psrlq512_mask", IX86_BUILTIN_PSRLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_lshrv8di3_mask, "__builtin_ia32_psrlqi512_mask", IX86_BUILTIN_PSRLQI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_lshrvv16si_mask, "__builtin_ia32_psrlv16si_mask", IX86_BUILTIN_PSRLVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_lshrvv8di_mask, "__builtin_ia32_psrlv8di_mask", IX86_BUILTIN_PSRLVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_subv16si3_mask, "__builtin_ia32_psubd512_mask", IX86_BUILTIN_PSUBD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_subv8di3_mask, "__builtin_ia32_psubq512_mask", IX86_BUILTIN_PSUBQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_testmv16si3_mask, "__builtin_ia32_ptestmd512", IX86_BUILTIN_PTESTMD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_testmv8di3_mask, "__builtin_ia32_ptestmq512", IX86_BUILTIN_PTESTMQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_testnmv16si3_mask, "__builtin_ia32_ptestnmd512", IX86_BUILTIN_PTESTNMD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_testnmv8di3_mask, "__builtin_ia32_ptestnmq512", IX86_BUILTIN_PTESTNMQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_interleave_highv16si_mask, "__builtin_ia32_punpckhdq512_mask", IX86_BUILTIN_PUNPCKHDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_interleave_highv8di_mask, "__builtin_ia32_punpckhqdq512_mask", IX86_BUILTIN_PUNPCKHQDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_interleave_lowv16si_mask, "__builtin_ia32_punpckldq512_mask", IX86_BUILTIN_PUNPCKLDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_interleave_lowv8di_mask, "__builtin_ia32_punpcklqdq512_mask", IX86_BUILTIN_PUNPCKLQDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_xorv16si3_mask, "__builtin_ia32_pxord512_mask", IX86_BUILTIN_PXORD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_xorv8di3_mask, "__builtin_ia32_pxorq512_mask", IX86_BUILTIN_PXORQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rcp14v8df_mask, "__builtin_ia32_rcp14pd512_mask", IX86_BUILTIN_RCP14PD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rcp14v16sf_mask, "__builtin_ia32_rcp14ps512_mask", IX86_BUILTIN_RCP14PS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v2df, "__builtin_ia32_rcp14sd", IX86_BUILTIN_RCP14SD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v2df_mask, "__builtin_ia32_rcp14sd_mask", IX86_BUILTIN_RCP14SDMASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v4sf, "__builtin_ia32_rcp14ss", IX86_BUILTIN_RCP14SS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_srcp14v4sf_mask, "__builtin_ia32_rcp14ss_mask", IX86_BUILTIN_RCP14SSMASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14v8df_mask, "__builtin_ia32_rsqrt14pd512_mask", IX86_BUILTIN_RSQRT14PD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14v16sf_mask, "__builtin_ia32_rsqrt14ps512_mask", IX86_BUILTIN_RSQRT14PS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14v2df, "__builtin_ia32_rsqrt14sd", IX86_BUILTIN_RSQRT14SD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14_v2df_mask, "__builtin_ia32_rsqrt14sd_mask", IX86_BUILTIN_RSQRT14SDMASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14v4sf, "__builtin_ia32_rsqrt14ss", IX86_BUILTIN_RSQRT14SS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_rsqrt14_v4sf_mask, "__builtin_ia32_rsqrt14ss_mask", IX86_BUILTIN_RSQRT14SSMASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_shufpd512_mask, "__builtin_ia32_shufpd512_mask", IX86_BUILTIN_SHUFPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_shufps512_mask, "__builtin_ia32_shufps512_mask", IX86_BUILTIN_SHUFPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_shuf_f32x4_mask, "__builtin_ia32_shuf_f32x4_mask", IX86_BUILTIN_SHUF_F32x4, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_shuf_f64x2_mask, "__builtin_ia32_shuf_f64x2_mask", IX86_BUILTIN_SHUF_F64x2, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_shuf_i32x4_mask, "__builtin_ia32_shuf_i32x4_mask", IX86_BUILTIN_SHUF_I32x4, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_shuf_i64x2_mask, "__builtin_ia32_shuf_i64x2_mask", IX86_BUILTIN_SHUF_I64x2, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ucmpv16si3_mask, "__builtin_ia32_ucmpd512_mask", IX86_BUILTIN_UCMPD512, UNKNOWN, (int) UHI_FTYPE_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_ucmpv8di3_mask, "__builtin_ia32_ucmpq512_mask", IX86_BUILTIN_UCMPQ512, UNKNOWN, (int) UQI_FTYPE_V8DI_V8DI_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_unpckhpd512_mask, "__builtin_ia32_unpckhpd512_mask", IX86_BUILTIN_UNPCKHPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_unpckhps512_mask, "__builtin_ia32_unpckhps512_mask", IX86_BUILTIN_UNPCKHPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_unpcklpd512_mask, "__builtin_ia32_unpcklpd512_mask", IX86_BUILTIN_UNPCKLPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_unpcklps512_mask,  "__builtin_ia32_unpcklps512_mask", IX86_BUILTIN_UNPCKLPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, 0, CODE_FOR_clzv16si2_mask, "__builtin_ia32_vplzcntd_512_mask", IX86_BUILTIN_VPCLZCNTD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, 0, CODE_FOR_clzv8di2_mask, "__builtin_ia32_vplzcntq_512_mask", IX86_BUILTIN_VPCLZCNTQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512CD, 0, CODE_FOR_conflictv16si_mask, "__builtin_ia32_vpconflictsi_512_mask", IX86_BUILTIN_VPCONFLICTD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512CD, 0, CODE_FOR_conflictv8di_mask, "__builtin_ia32_vpconflictdi_512_mask", IX86_BUILTIN_VPCONFLICTQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_permv8df_mask, "__builtin_ia32_permdf512_mask", IX86_BUILTIN_VPERMDF512, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_permv8di_mask, "__builtin_ia32_permdi512_mask", IX86_BUILTIN_VPERMDI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermi2varv16si3_mask, "__builtin_ia32_vpermi2vard512_mask", IX86_BUILTIN_VPERMI2VARD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermi2varv8df3_mask, "__builtin_ia32_vpermi2varpd512_mask", IX86_BUILTIN_VPERMI2VARPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermi2varv16sf3_mask, "__builtin_ia32_vpermi2varps512_mask", IX86_BUILTIN_VPERMI2VARPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SI_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermi2varv8di3_mask, "__builtin_ia32_vpermi2varq512_mask", IX86_BUILTIN_VPERMI2VARQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermilv8df_mask, "__builtin_ia32_vpermilpd512_mask", IX86_BUILTIN_VPERMILPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermilv16sf_mask, "__builtin_ia32_vpermilps512_mask", IX86_BUILTIN_VPERMILPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermilvarv8df3_mask, "__builtin_ia32_vpermilvarpd512_mask", IX86_BUILTIN_VPERMILVARPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermilvarv16sf3_mask, "__builtin_ia32_vpermilvarps512_mask", IX86_BUILTIN_VPERMILVARPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SI_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv16si3_mask, "__builtin_ia32_vpermt2vard512_mask", IX86_BUILTIN_VPERMT2VARD512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv16si3_maskz, "__builtin_ia32_vpermt2vard512_maskz", IX86_BUILTIN_VPERMT2VARD512_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv8df3_mask, "__builtin_ia32_vpermt2varpd512_mask", IX86_BUILTIN_VPERMT2VARPD512, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv8df3_maskz, "__builtin_ia32_vpermt2varpd512_maskz", IX86_BUILTIN_VPERMT2VARPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv16sf3_mask, "__builtin_ia32_vpermt2varps512_mask", IX86_BUILTIN_VPERMT2VARPS512, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv16sf3_maskz, "__builtin_ia32_vpermt2varps512_maskz", IX86_BUILTIN_VPERMT2VARPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv8di3_mask, "__builtin_ia32_vpermt2varq512_mask", IX86_BUILTIN_VPERMT2VARQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vpermt2varv8di3_maskz, "__builtin_ia32_vpermt2varq512_maskz", IX86_BUILTIN_VPERMT2VARQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_permvarv8df_mask, "__builtin_ia32_permvardf512_mask", IX86_BUILTIN_VPERMVARDF512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DI_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_permvarv8di_mask, "__builtin_ia32_permvardi512_mask", IX86_BUILTIN_VPERMVARDI512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_permvarv16sf_mask, "__builtin_ia32_permvarsf512_mask", IX86_BUILTIN_VPERMVARSF512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SI_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_permvarv16si_mask, "__builtin_ia32_permvarsi512_mask", IX86_BUILTIN_VPERMVARSI512, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vternlogv16si_mask, "__builtin_ia32_pternlogd512_mask", IX86_BUILTIN_VTERNLOGD512_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vternlogv16si_maskz, "__builtin_ia32_pternlogd512_maskz", IX86_BUILTIN_VTERNLOGD512_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vternlogv8di_mask, "__builtin_ia32_pternlogq512_mask", IX86_BUILTIN_VTERNLOGQ512_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vternlogv8di_maskz, "__builtin_ia32_pternlogq512_maskz", IX86_BUILTIN_VTERNLOGQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_INT_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movdf_mask, "__builtin_ia32_movesd_mask", IX86_BUILTIN_MOVSD_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_movsf_mask, "__builtin_ia32_movess_mask", IX86_BUILTIN_MOVSS_MASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_copysignv16sf3,  "__builtin_ia32_copysignps512", IX86_BUILTIN_CPYSGNPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_copysignv8df3,  "__builtin_ia32_copysignpd512", IX86_BUILTIN_CPYSGNPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sqrtv8df2, "__builtin_ia32_sqrtpd512", IX86_BUILTIN_SQRTPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sqrtv16sf2, "__builtin_ia32_sqrtps512", IX86_BUILTIN_SQRTPS_NR512, UNKNOWN, (int) V16SF_FTYPE_V16SF)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_rndscalev32hf, "__builtin_ia32_floorph512", IX86_BUILTIN_FLOORPH512, (enum rtx_code) ROUND_FLOOR, (int) V32HF_FTYPE_V32HF_ROUND)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_rndscalev32hf, "__builtin_ia32_ceilph512", IX86_BUILTIN_CEILPH512, (enum rtx_code) ROUND_CEIL, (int) V32HF_FTYPE_V32HF_ROUND)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_rndscalev32hf, "__builtin_ia32_truncph512", IX86_BUILTIN_TRUNCPH512, (enum rtx_code) ROUND_TRUNC, (int) V32HF_FTYPE_V32HF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundps512, "__builtin_ia32_floorps512", IX86_BUILTIN_FLOORPS512, (enum rtx_code) ROUND_FLOOR, (int) V16SF_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundps512, "__builtin_ia32_ceilps512", IX86_BUILTIN_CEILPS512, (enum rtx_code) ROUND_CEIL, (int) V16SF_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundps512, "__builtin_ia32_truncps512", IX86_BUILTIN_TRUNCPS512, (enum rtx_code) ROUND_TRUNC, (int) V16SF_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundpd512, "__builtin_ia32_floorpd512", IX86_BUILTIN_FLOORPD512, (enum rtx_code) ROUND_FLOOR, (int) V8DF_FTYPE_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundpd512, "__builtin_ia32_ceilpd512", IX86_BUILTIN_CEILPD512, (enum rtx_code) ROUND_CEIL, (int) V8DF_FTYPE_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundpd512, "__builtin_ia32_truncpd512", IX86_BUILTIN_TRUNCPD512, (enum rtx_code) ROUND_TRUNC, (int) V8DF_FTYPE_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fix_notruncv16sfv16si, "__builtin_ia32_cvtps2dq512", IX86_BUILTIN_CVTPS2DQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vec_pack_sfix_v8df, "__builtin_ia32_vec_pack_sfix512", IX86_BUILTIN_VEC_PACK_SFIX512, UNKNOWN, (int) V16SI_FTYPE_V8DF_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_roundv16sf2_sfix, "__builtin_ia32_roundps_az_sfix512", IX86_BUILTIN_ROUNDPS_AZ_SFIX512, UNKNOWN, (int) V16SI_FTYPE_V16SF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundps512_sfix, "__builtin_ia32_floorps_sfix512", IX86_BUILTIN_FLOORPS_SFIX512, (enum rtx_code) ROUND_FLOOR, (int) V16SI_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundps512_sfix, "__builtin_ia32_ceilps_sfix512", IX86_BUILTIN_CEILPS_SFIX512, (enum rtx_code) ROUND_CEIL, (int) V16SI_FTYPE_V16SF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_roundv8df2_vec_pack_sfix, "__builtin_ia32_roundpd_az_vec_pack_sfix512", IX86_BUILTIN_ROUNDPD_AZ_VEC_PACK_SFIX512, UNKNOWN, (int) V16SI_FTYPE_V8DF_V8DF)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundpd_vec_pack_sfix512, "__builtin_ia32_floorpd_vec_pack_sfix512", IX86_BUILTIN_FLOORPD_VEC_PACK_SFIX512, (enum rtx_code) ROUND_FLOOR, (int) V16SI_FTYPE_V8DF_V8DF_ROUND)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_roundpd_vec_pack_sfix512, "__builtin_ia32_ceilpd_vec_pack_sfix512", IX86_BUILTIN_CEILPD_VEC_PACK_SFIX512, (enum rtx_code) ROUND_CEIL, (int) V16SI_FTYPE_V8DF_V8DF_ROUND)
  
  /* Mask arithmetic operations */
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_kashiftqi, "__builtin_ia32_kshiftliqi", IX86_BUILTIN_KSHIFTLI8, UNKNOWN, (int) UQI_FTYPE_UQI_UQI_CONST)
*************** BDESC (OPTION_MASK_ISA_AVX512VL, 0, CODE
*** 2433,2568 ****
  BDESC (OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_cmpv4sf3_mask, "__builtin_ia32_cmpps128_mask", IX86_BUILTIN_CMPPS128_MASK, UNKNOWN, (int) UQI_FTYPE_V4SF_V4SF_INT_UQI)
  
  /* AVX512DQ.  */
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_broadcastv16sf_mask, "__builtin_ia32_broadcastf32x2_512_mask", IX86_BUILTIN_BROADCASTF32x2_512, UNKNOWN, (int) V16SF_FTYPE_V4SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_broadcastv16si_mask, "__builtin_ia32_broadcasti32x2_512_mask", IX86_BUILTIN_BROADCASTI32x2_512, UNKNOWN, (int) V16SI_FTYPE_V4SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_broadcastv8df_mask_1, "__builtin_ia32_broadcastf64x2_512_mask", IX86_BUILTIN_BROADCASTF64X2_512, UNKNOWN, (int) V8DF_FTYPE_V2DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_broadcastv8di_mask_1, "__builtin_ia32_broadcasti64x2_512_mask", IX86_BUILTIN_BROADCASTI64X2_512, UNKNOWN, (int) V8DI_FTYPE_V2DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_broadcastv16sf_mask_1, "__builtin_ia32_broadcastf32x8_512_mask", IX86_BUILTIN_BROADCASTF32X8_512, UNKNOWN, (int) V16SF_FTYPE_V8SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_broadcastv16si_mask_1, "__builtin_ia32_broadcasti32x8_512_mask", IX86_BUILTIN_BROADCASTI32X8_512, UNKNOWN, (int) V16SI_FTYPE_V8SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vextractf64x2_mask, "__builtin_ia32_extractf64x2_512_mask", IX86_BUILTIN_EXTRACTF64X2_512, UNKNOWN, (int) V2DF_FTYPE_V8DF_INT_V2DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vextractf32x8_mask, "__builtin_ia32_extractf32x8_mask", IX86_BUILTIN_EXTRACTF32X8, UNKNOWN, (int) V8SF_FTYPE_V16SF_INT_V8SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vextracti64x2_mask, "__builtin_ia32_extracti64x2_512_mask", IX86_BUILTIN_EXTRACTI64X2_512, UNKNOWN, (int) V2DI_FTYPE_V8DI_INT_V2DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vextracti32x8_mask, "__builtin_ia32_extracti32x8_mask", IX86_BUILTIN_EXTRACTI32X8, UNKNOWN, (int) V8SI_FTYPE_V16SI_INT_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_reducepv8df_mask, "__builtin_ia32_reducepd512_mask", IX86_BUILTIN_REDUCEPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_reducepv16sf_mask, "__builtin_ia32_reduceps512_mask", IX86_BUILTIN_REDUCEPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_mulv8di3_mask, "__builtin_ia32_pmullq512_mask", IX86_BUILTIN_PMULLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_xorv8df3_mask, "__builtin_ia32_xorpd512_mask", IX86_BUILTIN_XORPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_xorv16sf3_mask, "__builtin_ia32_xorps512_mask", IX86_BUILTIN_XORPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_iorv8df3_mask, "__builtin_ia32_orpd512_mask", IX86_BUILTIN_ORPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_iorv16sf3_mask, "__builtin_ia32_orps512_mask", IX86_BUILTIN_ORPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_andv8df3_mask, "__builtin_ia32_andpd512_mask", IX86_BUILTIN_ANDPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_andv16sf3_mask, "__builtin_ia32_andps512_mask", IX86_BUILTIN_ANDPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_andnotv8df3_mask, "__builtin_ia32_andnpd512_mask", IX86_BUILTIN_ANDNPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_andnotv16sf3_mask, "__builtin_ia32_andnps512_mask", IX86_BUILTIN_ANDNPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vinsertf32x8_mask, "__builtin_ia32_insertf32x8_mask", IX86_BUILTIN_INSERTF32X8, UNKNOWN, (int) V16SF_FTYPE_V16SF_V8SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vinserti32x8_mask, "__builtin_ia32_inserti32x8_mask", IX86_BUILTIN_INSERTI32X8, UNKNOWN, (int) V16SI_FTYPE_V16SI_V8SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vinsertf64x2_mask, "__builtin_ia32_insertf64x2_512_mask", IX86_BUILTIN_INSERTF64X2_512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V2DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_vinserti64x2_mask, "__builtin_ia32_inserti64x2_512_mask", IX86_BUILTIN_INSERTI64X2_512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_fpclassv8df_mask, "__builtin_ia32_fpclasspd512_mask", IX86_BUILTIN_FPCLASSPD512, UNKNOWN, (int) QI_FTYPE_V8DF_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_fpclassv16sf_mask, "__builtin_ia32_fpclassps512_mask", IX86_BUILTIN_FPCLASSPS512, UNKNOWN, (int) HI_FTYPE_V16SF_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtd2maskv16si, "__builtin_ia32_cvtd2mask512", IX86_BUILTIN_CVTD2MASK512, UNKNOWN, (int) UHI_FTYPE_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtq2maskv8di, "__builtin_ia32_cvtq2mask512", IX86_BUILTIN_CVTQ2MASK512, UNKNOWN, (int) UQI_FTYPE_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtmask2dv16si, "__builtin_ia32_cvtmask2d512", IX86_BUILTIN_CVTMASK2D512, UNKNOWN, (int) V16SI_FTYPE_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtmask2qv8di, "__builtin_ia32_cvtmask2q512", IX86_BUILTIN_CVTMASK2Q512, UNKNOWN, (int) V8DI_FTYPE_UQI)
  
  /* AVX512BW.  */
  BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_kunpcksi, "__builtin_ia32_kunpcksi", IX86_BUILTIN_KUNPCKWD, UNKNOWN, (int) USI_FTYPE_USI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_kunpckdi, "__builtin_ia32_kunpckdi", IX86_BUILTIN_KUNPCKDQ, UNKNOWN, (int) UDI_FTYPE_UDI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_packusdw_mask, "__builtin_ia32_packusdw512_mask",  IX86_BUILTIN_PACKUSDW512, UNKNOWN, (int) V32HI_FTYPE_V16SI_V16SI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_ashlv4ti3, "__builtin_ia32_pslldq512", IX86_BUILTIN_PSLLDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_lshrv4ti3, "__builtin_ia32_psrldq512", IX86_BUILTIN_PSRLDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_packssdw_mask, "__builtin_ia32_packssdw512_mask",  IX86_BUILTIN_PACKSSDW512, UNKNOWN, (int) V32HI_FTYPE_V16SI_V16SI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_palignrv4ti, "__builtin_ia32_palignr512", IX86_BUILTIN_PALIGNR512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_palignrv64qi_mask, "__builtin_ia32_palignr512_mask", IX86_BUILTIN_PALIGNR512_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_UDI_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_loadv32hi_mask, "__builtin_ia32_movdquhi512_mask", IX86_BUILTIN_MOVDQUHI512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_loadv64qi_mask, "__builtin_ia32_movdquqi512_mask", IX86_BUILTIN_MOVDQUQI512_MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_psadbw, "__builtin_ia32_psadbw512", IX86_BUILTIN_PSADBW512, UNKNOWN, (int) V8DI_FTYPE_V64QI_V64QI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_dbpsadbwv32hi_mask, "__builtin_ia32_dbpsadbw512_mask", IX86_BUILTIN_DBPSADBW512, UNKNOWN, (int) V32HI_FTYPE_V64QI_V64QI_INT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vec_dupv64qi_mask, "__builtin_ia32_pbroadcastb512_mask", IX86_BUILTIN_PBROADCASTB512, UNKNOWN, (int) V64QI_FTYPE_V16QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vec_dup_gprv64qi_mask, "__builtin_ia32_pbroadcastb512_gpr_mask", IX86_BUILTIN_PBROADCASTB512_GPR, UNKNOWN, (int) V64QI_FTYPE_QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vec_dupv32hi_mask, "__builtin_ia32_pbroadcastw512_mask", IX86_BUILTIN_PBROADCASTW512, UNKNOWN, (int) V32HI_FTYPE_V8HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vec_dup_gprv32hi_mask, "__builtin_ia32_pbroadcastw512_gpr_mask", IX86_BUILTIN_PBROADCASTW512_GPR, UNKNOWN, (int) V32HI_FTYPE_HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_sign_extendv32qiv32hi2_mask, "__builtin_ia32_pmovsxbw512_mask", IX86_BUILTIN_PMOVSXBW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_zero_extendv32qiv32hi2_mask, "__builtin_ia32_pmovzxbw512_mask", IX86_BUILTIN_PMOVZXBW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_permvarv32hi_mask, "__builtin_ia32_permvarhi512_mask", IX86_BUILTIN_VPERMVARHI512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vpermt2varv32hi3_mask, "__builtin_ia32_vpermt2varhi512_mask", IX86_BUILTIN_VPERMT2VARHI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vpermt2varv32hi3_maskz, "__builtin_ia32_vpermt2varhi512_maskz", IX86_BUILTIN_VPERMT2VARHI512_MASKZ, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vpermi2varv32hi3_mask, "__builtin_ia32_vpermi2varhi512_mask", IX86_BUILTIN_VPERMI2VARHI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_uavgv64qi3_mask, "__builtin_ia32_pavgb512_mask", IX86_BUILTIN_PAVGB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_uavgv32hi3_mask, "__builtin_ia32_pavgw512_mask", IX86_BUILTIN_PAVGW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv64qi3_mask, "__builtin_ia32_paddb512_mask", IX86_BUILTIN_PADDB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv64qi3_mask, "__builtin_ia32_psubb512_mask", IX86_BUILTIN_PSUBB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sssubv64qi3_mask, "__builtin_ia32_psubsb512_mask", IX86_BUILTIN_PSUBSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ssaddv64qi3_mask, "__builtin_ia32_paddsb512_mask", IX86_BUILTIN_PADDSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ussubv64qi3_mask, "__builtin_ia32_psubusb512_mask", IX86_BUILTIN_PSUBUSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_usaddv64qi3_mask, "__builtin_ia32_paddusb512_mask", IX86_BUILTIN_PADDUSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv32hi3_mask, "__builtin_ia32_psubw512_mask", IX86_BUILTIN_PSUBW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv32hi3_mask, "__builtin_ia32_paddw512_mask", IX86_BUILTIN_PADDW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sssubv32hi3_mask, "__builtin_ia32_psubsw512_mask", IX86_BUILTIN_PSUBSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ssaddv32hi3_mask, "__builtin_ia32_paddsw512_mask", IX86_BUILTIN_PADDSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ussubv32hi3_mask, "__builtin_ia32_psubusw512_mask", IX86_BUILTIN_PSUBUSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_usaddv32hi3_mask, "__builtin_ia32_paddusw512_mask", IX86_BUILTIN_PADDUSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_umaxv32hi3_mask, "__builtin_ia32_pmaxuw512_mask", IX86_BUILTIN_PMAXUW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv32hi3_mask, "__builtin_ia32_pmaxsw512_mask", IX86_BUILTIN_PMAXSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_uminv32hi3_mask, "__builtin_ia32_pminuw512_mask", IX86_BUILTIN_PMINUW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv32hi3_mask, "__builtin_ia32_pminsw512_mask", IX86_BUILTIN_PMINSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_umaxv64qi3_mask, "__builtin_ia32_pmaxub512_mask", IX86_BUILTIN_PMAXUB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv64qi3_mask, "__builtin_ia32_pmaxsb512_mask", IX86_BUILTIN_PMAXSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_uminv64qi3_mask, "__builtin_ia32_pminub512_mask", IX86_BUILTIN_PMINUB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv64qi3_mask, "__builtin_ia32_pminsb512_mask", IX86_BUILTIN_PMINSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_truncatev32hiv32qi2_mask, "__builtin_ia32_pmovwb512_mask", IX86_BUILTIN_PMOVWB512, UNKNOWN, (int) V32QI_FTYPE_V32HI_V32QI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_ss_truncatev32hiv32qi2_mask, "__builtin_ia32_pmovswb512_mask", IX86_BUILTIN_PMOVSWB512, UNKNOWN, (int) V32QI_FTYPE_V32HI_V32QI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_us_truncatev32hiv32qi2_mask, "__builtin_ia32_pmovuswb512_mask", IX86_BUILTIN_PMOVUSWB512, UNKNOWN, (int) V32QI_FTYPE_V32HI_V32QI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_umulhrswv32hi3_mask, "__builtin_ia32_pmulhrsw512_mask", IX86_BUILTIN_PMULHRSW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_umulv32hi3_highpart_mask, "__builtin_ia32_pmulhuw512_mask" , IX86_BUILTIN_PMULHUW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_smulv32hi3_highpart_mask, "__builtin_ia32_pmulhw512_mask"  , IX86_BUILTIN_PMULHW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_mulv32hi3_mask, "__builtin_ia32_pmullw512_mask", IX86_BUILTIN_PMULLW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashlv32hi3_mask, "__builtin_ia32_psllwi512_mask", IX86_BUILTIN_PSLLWI512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashlv32hi3_mask, "__builtin_ia32_psllw512_mask", IX86_BUILTIN_PSLLW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V8HI_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_packsswb_mask, "__builtin_ia32_packsswb512_mask",  IX86_BUILTIN_PACKSSWB512, UNKNOWN, (int) V64QI_FTYPE_V32HI_V32HI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_packuswb_mask, "__builtin_ia32_packuswb512_mask",  IX86_BUILTIN_PACKUSWB512, UNKNOWN, (int) V64QI_FTYPE_V32HI_V32HI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_ashrvv32hi_mask, "__builtin_ia32_psrav32hi_mask", IX86_BUILTIN_PSRAVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_pmaddubsw512v32hi_mask, "__builtin_ia32_pmaddubsw512_mask", IX86_BUILTIN_PMADDUBSW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V64QI_V64QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_pmaddwd512v32hi_mask, "__builtin_ia32_pmaddwd512_mask", IX86_BUILTIN_PMADDWD512_MASK, UNKNOWN, (int) V16SI_FTYPE_V32HI_V32HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_lshrvv32hi_mask, "__builtin_ia32_psrlv32hi_mask", IX86_BUILTIN_PSRLVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_interleave_highv64qi_mask, "__builtin_ia32_punpckhbw512_mask", IX86_BUILTIN_PUNPCKHBW512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_interleave_highv32hi_mask, "__builtin_ia32_punpckhwd512_mask", IX86_BUILTIN_PUNPCKHWD512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_interleave_lowv64qi_mask, "__builtin_ia32_punpcklbw512_mask", IX86_BUILTIN_PUNPCKLBW512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_interleave_lowv32hi_mask, "__builtin_ia32_punpcklwd512_mask", IX86_BUILTIN_PUNPCKLWD512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_pshufbv64qi3_mask, "__builtin_ia32_pshufb512_mask", IX86_BUILTIN_PSHUFB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_pshufhwv32hi_mask, "__builtin_ia32_pshufhw512_mask", IX86_BUILTIN_PSHUFHW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_pshuflwv32hi_mask, "__builtin_ia32_pshuflw512_mask", IX86_BUILTIN_PSHUFLW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashrv32hi3_mask, "__builtin_ia32_psrawi512_mask", IX86_BUILTIN_PSRAWI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_ashrv32hi3_mask, "__builtin_ia32_psraw512_mask", IX86_BUILTIN_PSRAW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V8HI_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_lshrv32hi3_mask, "__builtin_ia32_psrlwi512_mask", IX86_BUILTIN_PSRLWI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_lshrv32hi3_mask, "__builtin_ia32_psrlw512_mask", IX86_BUILTIN_PSRLW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V8HI_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cvtb2maskv64qi, "__builtin_ia32_cvtb2mask512", IX86_BUILTIN_CVTB2MASK512, UNKNOWN, (int) UDI_FTYPE_V64QI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cvtw2maskv32hi, "__builtin_ia32_cvtw2mask512", IX86_BUILTIN_CVTW2MASK512, UNKNOWN, (int) USI_FTYPE_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cvtmask2bv64qi, "__builtin_ia32_cvtmask2b512", IX86_BUILTIN_CVTMASK2B512, UNKNOWN, (int) V64QI_FTYPE_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cvtmask2wv32hi, "__builtin_ia32_cvtmask2w512", IX86_BUILTIN_CVTMASK2W512, UNKNOWN, (int) V32HI_FTYPE_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_eqv64qi3_mask, "__builtin_ia32_pcmpeqb512_mask", IX86_BUILTIN_PCMPEQB512_MASK, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_eqv32hi3_mask, "__builtin_ia32_pcmpeqw512_mask", IX86_BUILTIN_PCMPEQW512_MASK, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_gtv64qi3_mask, "__builtin_ia32_pcmpgtb512_mask", IX86_BUILTIN_PCMPGTB512_MASK, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_gtv32hi3_mask, "__builtin_ia32_pcmpgtw512_mask", IX86_BUILTIN_PCMPGTW512_MASK, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_testmv64qi3_mask, "__builtin_ia32_ptestmb512", IX86_BUILTIN_PTESTMB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_testmv32hi3_mask, "__builtin_ia32_ptestmw512", IX86_BUILTIN_PTESTMW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_testnmv64qi3_mask, "__builtin_ia32_ptestnmb512", IX86_BUILTIN_PTESTNMB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_testnmv32hi3_mask, "__builtin_ia32_ptestnmw512", IX86_BUILTIN_PTESTNMW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_ashlvv32hi_mask, "__builtin_ia32_psllv32hi_mask", IX86_BUILTIN_PSLLVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_absv64qi2_mask, "__builtin_ia32_pabsb512_mask", IX86_BUILTIN_PABSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_absv32hi2_mask, "__builtin_ia32_pabsw512_mask", IX86_BUILTIN_PABSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_blendmv32hi, "__builtin_ia32_blendmw_512_mask", IX86_BUILTIN_BLENDMW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_blendmv64qi, "__builtin_ia32_blendmb_512_mask", IX86_BUILTIN_BLENDMB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cmpv64qi3_mask, "__builtin_ia32_cmpb512_mask", IX86_BUILTIN_CMPB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_INT_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cmpv32hi3_mask, "__builtin_ia32_cmpw512_mask", IX86_BUILTIN_CMPW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_INT_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_ucmpv64qi3_mask, "__builtin_ia32_ucmpb512_mask", IX86_BUILTIN_UCMPB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_INT_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_ucmpv32hi3_mask, "__builtin_ia32_ucmpw512_mask", IX86_BUILTIN_UCMPW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_INT_USI)
  
  /* AVX512IFMA */
! BDESC (OPTION_MASK_ISA_AVX512IFMA, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpmadd52luqv8di_mask, "__builtin_ia32_vpmadd52luq512_mask", IX86_BUILTIN_VPMADD52LUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512IFMA, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpmadd52luqv8di_maskz, "__builtin_ia32_vpmadd52luq512_maskz", IX86_BUILTIN_VPMADD52LUQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512IFMA, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpmadd52huqv8di_mask, "__builtin_ia32_vpmadd52huq512_mask", IX86_BUILTIN_VPMADD52HUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512IFMA, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpmadd52huqv8di_maskz, "__builtin_ia32_vpmadd52huq512_maskz", IX86_BUILTIN_VPMADD52HUQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmadd52luqv4di_mask, "__builtin_ia32_vpmadd52luq256_mask", IX86_BUILTIN_VPMADD52LUQ256, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmadd52luqv4di_maskz, "__builtin_ia32_vpmadd52luq256_maskz", IX86_BUILTIN_VPMADD52LUQ256_MASKZ, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmadd52huqv4di_mask, "__builtin_ia32_vpmadd52huq256_mask", IX86_BUILTIN_VPMADD52HUQ256, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
--- 2433,2568 ----
  BDESC (OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_cmpv4sf3_mask, "__builtin_ia32_cmpps128_mask", IX86_BUILTIN_CMPPS128_MASK, UNKNOWN, (int) UQI_FTYPE_V4SF_V4SF_INT_UQI)
  
  /* AVX512DQ.  */
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_broadcastv16sf_mask, "__builtin_ia32_broadcastf32x2_512_mask", IX86_BUILTIN_BROADCASTF32x2_512, UNKNOWN, (int) V16SF_FTYPE_V4SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_broadcastv16si_mask, "__builtin_ia32_broadcasti32x2_512_mask", IX86_BUILTIN_BROADCASTI32x2_512, UNKNOWN, (int) V16SI_FTYPE_V4SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_broadcastv8df_mask_1, "__builtin_ia32_broadcastf64x2_512_mask", IX86_BUILTIN_BROADCASTF64X2_512, UNKNOWN, (int) V8DF_FTYPE_V2DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_broadcastv8di_mask_1, "__builtin_ia32_broadcasti64x2_512_mask", IX86_BUILTIN_BROADCASTI64X2_512, UNKNOWN, (int) V8DI_FTYPE_V2DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_broadcastv16sf_mask_1, "__builtin_ia32_broadcastf32x8_512_mask", IX86_BUILTIN_BROADCASTF32X8_512, UNKNOWN, (int) V16SF_FTYPE_V8SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_broadcastv16si_mask_1, "__builtin_ia32_broadcasti32x8_512_mask", IX86_BUILTIN_BROADCASTI32X8_512, UNKNOWN, (int) V16SI_FTYPE_V8SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vextractf64x2_mask, "__builtin_ia32_extractf64x2_512_mask", IX86_BUILTIN_EXTRACTF64X2_512, UNKNOWN, (int) V2DF_FTYPE_V8DF_INT_V2DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vextractf32x8_mask, "__builtin_ia32_extractf32x8_mask", IX86_BUILTIN_EXTRACTF32X8, UNKNOWN, (int) V8SF_FTYPE_V16SF_INT_V8SF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vextracti64x2_mask, "__builtin_ia32_extracti64x2_512_mask", IX86_BUILTIN_EXTRACTI64X2_512, UNKNOWN, (int) V2DI_FTYPE_V8DI_INT_V2DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vextracti32x8_mask, "__builtin_ia32_extracti32x8_mask", IX86_BUILTIN_EXTRACTI32X8, UNKNOWN, (int) V8SI_FTYPE_V16SI_INT_V8SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducepv8df_mask, "__builtin_ia32_reducepd512_mask", IX86_BUILTIN_REDUCEPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducepv16sf_mask, "__builtin_ia32_reduceps512_mask", IX86_BUILTIN_REDUCEPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_mulv8di3_mask, "__builtin_ia32_pmullq512_mask", IX86_BUILTIN_PMULLQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_xorv8df3_mask, "__builtin_ia32_xorpd512_mask", IX86_BUILTIN_XORPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_xorv16sf3_mask, "__builtin_ia32_xorps512_mask", IX86_BUILTIN_XORPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_iorv8df3_mask, "__builtin_ia32_orpd512_mask", IX86_BUILTIN_ORPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_iorv16sf3_mask, "__builtin_ia32_orps512_mask", IX86_BUILTIN_ORPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_andv8df3_mask, "__builtin_ia32_andpd512_mask", IX86_BUILTIN_ANDPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_andv16sf3_mask, "__builtin_ia32_andps512_mask", IX86_BUILTIN_ANDPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512f_andnotv8df3_mask, "__builtin_ia32_andnpd512_mask", IX86_BUILTIN_ANDNPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512f_andnotv16sf3_mask, "__builtin_ia32_andnps512_mask", IX86_BUILTIN_ANDNPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vinsertf32x8_mask, "__builtin_ia32_insertf32x8_mask", IX86_BUILTIN_INSERTF32X8, UNKNOWN, (int) V16SF_FTYPE_V16SF_V8SF_INT_V16SF_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vinserti32x8_mask, "__builtin_ia32_inserti32x8_mask", IX86_BUILTIN_INSERTI32X8, UNKNOWN, (int) V16SI_FTYPE_V16SI_V8SI_INT_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vinsertf64x2_mask, "__builtin_ia32_insertf64x2_512_mask", IX86_BUILTIN_INSERTF64X2_512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V2DF_INT_V8DF_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_vinserti64x2_mask, "__builtin_ia32_inserti64x2_512_mask", IX86_BUILTIN_INSERTI64X2_512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V2DI_INT_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_fpclassv8df_mask, "__builtin_ia32_fpclasspd512_mask", IX86_BUILTIN_FPCLASSPD512, UNKNOWN, (int) QI_FTYPE_V8DF_INT_UQI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_fpclassv16sf_mask, "__builtin_ia32_fpclassps512_mask", IX86_BUILTIN_FPCLASSPS512, UNKNOWN, (int) HI_FTYPE_V16SF_INT_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512f_cvtd2maskv16si, "__builtin_ia32_cvtd2mask512", IX86_BUILTIN_CVTD2MASK512, UNKNOWN, (int) UHI_FTYPE_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512f_cvtq2maskv8di, "__builtin_ia32_cvtq2mask512", IX86_BUILTIN_CVTQ2MASK512, UNKNOWN, (int) UQI_FTYPE_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512f_cvtmask2dv16si, "__builtin_ia32_cvtmask2d512", IX86_BUILTIN_CVTMASK2D512, UNKNOWN, (int) V16SI_FTYPE_UHI)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512f_cvtmask2qv8di, "__builtin_ia32_cvtmask2q512", IX86_BUILTIN_CVTMASK2Q512, UNKNOWN, (int) V8DI_FTYPE_UQI)
  
  /* AVX512BW.  */
  BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_kunpcksi, "__builtin_ia32_kunpcksi", IX86_BUILTIN_KUNPCKWD, UNKNOWN, (int) USI_FTYPE_USI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_kunpckdi, "__builtin_ia32_kunpckdi", IX86_BUILTIN_KUNPCKDQ, UNKNOWN, (int) UDI_FTYPE_UDI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_packusdw_mask, "__builtin_ia32_packusdw512_mask",  IX86_BUILTIN_PACKUSDW512, UNKNOWN, (int) V32HI_FTYPE_V16SI_V16SI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_ashlv4ti3, "__builtin_ia32_pslldq512", IX86_BUILTIN_PSLLDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_lshrv4ti3, "__builtin_ia32_psrldq512", IX86_BUILTIN_PSRLDQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_INT_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_packssdw_mask, "__builtin_ia32_packssdw512_mask",  IX86_BUILTIN_PACKSSDW512, UNKNOWN, (int) V32HI_FTYPE_V16SI_V16SI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_palignrv4ti, "__builtin_ia32_palignr512", IX86_BUILTIN_PALIGNR512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_palignrv64qi_mask, "__builtin_ia32_palignr512_mask", IX86_BUILTIN_PALIGNR512_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_UDI_CONVERT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_loadv32hi_mask, "__builtin_ia32_movdquhi512_mask", IX86_BUILTIN_MOVDQUHI512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_loadv64qi_mask, "__builtin_ia32_movdquqi512_mask", IX86_BUILTIN_MOVDQUQI512_MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512f_psadbw, "__builtin_ia32_psadbw512", IX86_BUILTIN_PSADBW512, UNKNOWN, (int) V8DI_FTYPE_V64QI_V64QI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_dbpsadbwv32hi_mask, "__builtin_ia32_dbpsadbw512_mask", IX86_BUILTIN_DBPSADBW512, UNKNOWN, (int) V32HI_FTYPE_V64QI_V64QI_INT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_vec_dupv64qi_mask, "__builtin_ia32_pbroadcastb512_mask", IX86_BUILTIN_PBROADCASTB512, UNKNOWN, (int) V64QI_FTYPE_V16QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_vec_dup_gprv64qi_mask, "__builtin_ia32_pbroadcastb512_gpr_mask", IX86_BUILTIN_PBROADCASTB512_GPR, UNKNOWN, (int) V64QI_FTYPE_QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_vec_dupv32hi_mask, "__builtin_ia32_pbroadcastw512_mask", IX86_BUILTIN_PBROADCASTW512, UNKNOWN, (int) V32HI_FTYPE_V8HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_vec_dup_gprv32hi_mask, "__builtin_ia32_pbroadcastw512_gpr_mask", IX86_BUILTIN_PBROADCASTW512_GPR, UNKNOWN, (int) V32HI_FTYPE_HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_sign_extendv32qiv32hi2_mask, "__builtin_ia32_pmovsxbw512_mask", IX86_BUILTIN_PMOVSXBW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_zero_extendv32qiv32hi2_mask, "__builtin_ia32_pmovzxbw512_mask", IX86_BUILTIN_PMOVZXBW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_permvarv32hi_mask, "__builtin_ia32_permvarhi512_mask", IX86_BUILTIN_VPERMVARHI512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_vpermt2varv32hi3_mask, "__builtin_ia32_vpermt2varhi512_mask", IX86_BUILTIN_VPERMT2VARHI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_vpermt2varv32hi3_maskz, "__builtin_ia32_vpermt2varhi512_maskz", IX86_BUILTIN_VPERMT2VARHI512_MASKZ, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_vpermi2varv32hi3_mask, "__builtin_ia32_vpermi2varhi512_mask", IX86_BUILTIN_VPERMI2VARHI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_uavgv64qi3_mask, "__builtin_ia32_pavgb512_mask", IX86_BUILTIN_PAVGB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_uavgv32hi3_mask, "__builtin_ia32_pavgw512_mask", IX86_BUILTIN_PAVGW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_addv64qi3_mask, "__builtin_ia32_paddb512_mask", IX86_BUILTIN_PADDB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_subv64qi3_mask, "__builtin_ia32_psubb512_mask", IX86_BUILTIN_PSUBB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_sssubv64qi3_mask, "__builtin_ia32_psubsb512_mask", IX86_BUILTIN_PSUBSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ssaddv64qi3_mask, "__builtin_ia32_paddsb512_mask", IX86_BUILTIN_PADDSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ussubv64qi3_mask, "__builtin_ia32_psubusb512_mask", IX86_BUILTIN_PSUBUSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_usaddv64qi3_mask, "__builtin_ia32_paddusb512_mask", IX86_BUILTIN_PADDUSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_subv32hi3_mask, "__builtin_ia32_psubw512_mask", IX86_BUILTIN_PSUBW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_addv32hi3_mask, "__builtin_ia32_paddw512_mask", IX86_BUILTIN_PADDW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_sssubv32hi3_mask, "__builtin_ia32_psubsw512_mask", IX86_BUILTIN_PSUBSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ssaddv32hi3_mask, "__builtin_ia32_paddsw512_mask", IX86_BUILTIN_PADDSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ussubv32hi3_mask, "__builtin_ia32_psubusw512_mask", IX86_BUILTIN_PSUBUSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_usaddv32hi3_mask, "__builtin_ia32_paddusw512_mask", IX86_BUILTIN_PADDUSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_umaxv32hi3_mask, "__builtin_ia32_pmaxuw512_mask", IX86_BUILTIN_PMAXUW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_smaxv32hi3_mask, "__builtin_ia32_pmaxsw512_mask", IX86_BUILTIN_PMAXSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_uminv32hi3_mask, "__builtin_ia32_pminuw512_mask", IX86_BUILTIN_PMINUW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_sminv32hi3_mask, "__builtin_ia32_pminsw512_mask", IX86_BUILTIN_PMINSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_umaxv64qi3_mask, "__builtin_ia32_pmaxub512_mask", IX86_BUILTIN_PMAXUB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_smaxv64qi3_mask, "__builtin_ia32_pmaxsb512_mask", IX86_BUILTIN_PMAXSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_uminv64qi3_mask, "__builtin_ia32_pminub512_mask", IX86_BUILTIN_PMINUB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_sminv64qi3_mask, "__builtin_ia32_pminsb512_mask", IX86_BUILTIN_PMINSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_truncatev32hiv32qi2_mask, "__builtin_ia32_pmovwb512_mask", IX86_BUILTIN_PMOVWB512, UNKNOWN, (int) V32QI_FTYPE_V32HI_V32QI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_ss_truncatev32hiv32qi2_mask, "__builtin_ia32_pmovswb512_mask", IX86_BUILTIN_PMOVSWB512, UNKNOWN, (int) V32QI_FTYPE_V32HI_V32QI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_us_truncatev32hiv32qi2_mask, "__builtin_ia32_pmovuswb512_mask", IX86_BUILTIN_PMOVUSWB512, UNKNOWN, (int) V32QI_FTYPE_V32HI_V32QI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_umulhrswv32hi3_mask, "__builtin_ia32_pmulhrsw512_mask", IX86_BUILTIN_PMULHRSW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_umulv32hi3_highpart_mask, "__builtin_ia32_pmulhuw512_mask" , IX86_BUILTIN_PMULHUW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_smulv32hi3_highpart_mask, "__builtin_ia32_pmulhw512_mask"  , IX86_BUILTIN_PMULHW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_mulv32hi3_mask, "__builtin_ia32_pmullw512_mask", IX86_BUILTIN_PMULLW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ashlv32hi3_mask, "__builtin_ia32_psllwi512_mask", IX86_BUILTIN_PSLLWI512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ashlv32hi3_mask, "__builtin_ia32_psllw512_mask", IX86_BUILTIN_PSLLW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V8HI_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_packsswb_mask, "__builtin_ia32_packsswb512_mask",  IX86_BUILTIN_PACKSSWB512, UNKNOWN, (int) V64QI_FTYPE_V32HI_V32HI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_packuswb_mask, "__builtin_ia32_packuswb512_mask",  IX86_BUILTIN_PACKUSWB512, UNKNOWN, (int) V64QI_FTYPE_V32HI_V32HI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_ashrvv32hi_mask, "__builtin_ia32_psrav32hi_mask", IX86_BUILTIN_PSRAVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_pmaddubsw512v32hi_mask, "__builtin_ia32_pmaddubsw512_mask", IX86_BUILTIN_PMADDUBSW512_MASK, UNKNOWN, (int) V32HI_FTYPE_V64QI_V64QI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_pmaddwd512v32hi_mask, "__builtin_ia32_pmaddwd512_mask", IX86_BUILTIN_PMADDWD512_MASK, UNKNOWN, (int) V16SI_FTYPE_V32HI_V32HI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_lshrvv32hi_mask, "__builtin_ia32_psrlv32hi_mask", IX86_BUILTIN_PSRLVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_interleave_highv64qi_mask, "__builtin_ia32_punpckhbw512_mask", IX86_BUILTIN_PUNPCKHBW512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_interleave_highv32hi_mask, "__builtin_ia32_punpckhwd512_mask", IX86_BUILTIN_PUNPCKHWD512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_interleave_lowv64qi_mask, "__builtin_ia32_punpcklbw512_mask", IX86_BUILTIN_PUNPCKLBW512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_interleave_lowv32hi_mask, "__builtin_ia32_punpcklwd512_mask", IX86_BUILTIN_PUNPCKLWD512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_pshufbv64qi3_mask, "__builtin_ia32_pshufb512_mask", IX86_BUILTIN_PSHUFB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_pshufhwv32hi_mask, "__builtin_ia32_pshufhw512_mask", IX86_BUILTIN_PSHUFHW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_pshuflwv32hi_mask, "__builtin_ia32_pshuflw512_mask", IX86_BUILTIN_PSHUFLW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ashrv32hi3_mask, "__builtin_ia32_psrawi512_mask", IX86_BUILTIN_PSRAWI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_ashrv32hi3_mask, "__builtin_ia32_psraw512_mask", IX86_BUILTIN_PSRAW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V8HI_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_lshrv32hi3_mask, "__builtin_ia32_psrlwi512_mask", IX86_BUILTIN_PSRLWI512, UNKNOWN, (int) V32HI_FTYPE_V32HI_INT_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_lshrv32hi3_mask, "__builtin_ia32_psrlw512_mask", IX86_BUILTIN_PSRLW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V8HI_V32HI_USI_COUNT)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_cvtb2maskv64qi, "__builtin_ia32_cvtb2mask512", IX86_BUILTIN_CVTB2MASK512, UNKNOWN, (int) UDI_FTYPE_V64QI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_cvtw2maskv32hi, "__builtin_ia32_cvtw2mask512", IX86_BUILTIN_CVTW2MASK512, UNKNOWN, (int) USI_FTYPE_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_cvtmask2bv64qi, "__builtin_ia32_cvtmask2b512", IX86_BUILTIN_CVTMASK2B512, UNKNOWN, (int) V64QI_FTYPE_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_cvtmask2wv32hi, "__builtin_ia32_cvtmask2w512", IX86_BUILTIN_CVTMASK2W512, UNKNOWN, (int) V32HI_FTYPE_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_eqv64qi3_mask, "__builtin_ia32_pcmpeqb512_mask", IX86_BUILTIN_PCMPEQB512_MASK, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_eqv32hi3_mask, "__builtin_ia32_pcmpeqw512_mask", IX86_BUILTIN_PCMPEQW512_MASK, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_gtv64qi3_mask, "__builtin_ia32_pcmpgtb512_mask", IX86_BUILTIN_PCMPGTB512_MASK, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_gtv32hi3_mask, "__builtin_ia32_pcmpgtw512_mask", IX86_BUILTIN_PCMPGTW512_MASK, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_testmv64qi3_mask, "__builtin_ia32_ptestmb512", IX86_BUILTIN_PTESTMB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_testmv32hi3_mask, "__builtin_ia32_ptestmw512", IX86_BUILTIN_PTESTMW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_testnmv64qi3_mask, "__builtin_ia32_ptestnmb512", IX86_BUILTIN_PTESTNMB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_testnmv32hi3_mask, "__builtin_ia32_ptestnmw512", IX86_BUILTIN_PTESTNMW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_ashlvv32hi_mask, "__builtin_ia32_psllv32hi_mask", IX86_BUILTIN_PSLLVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_absv64qi2_mask, "__builtin_ia32_pabsb512_mask", IX86_BUILTIN_PABSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_absv32hi2_mask, "__builtin_ia32_pabsw512_mask", IX86_BUILTIN_PABSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_blendmv32hi, "__builtin_ia32_blendmw_512_mask", IX86_BUILTIN_BLENDMW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_blendmv64qi, "__builtin_ia32_blendmb_512_mask", IX86_BUILTIN_BLENDMB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_cmpv64qi3_mask, "__builtin_ia32_cmpb512_mask", IX86_BUILTIN_CMPB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_INT_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_cmpv32hi3_mask, "__builtin_ia32_cmpw512_mask", IX86_BUILTIN_CMPW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_INT_USI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_ucmpv64qi3_mask, "__builtin_ia32_ucmpb512_mask", IX86_BUILTIN_UCMPB512, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_INT_UDI)
! BDESC (OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_avx512bw_ucmpv32hi3_mask, "__builtin_ia32_ucmpw512_mask", IX86_BUILTIN_UCMPW512, UNKNOWN, (int) USI_FTYPE_V32HI_V32HI_INT_USI)
  
  /* AVX512IFMA */
! BDESC (OPTION_MASK_ISA_AVX512IFMA, 0, CODE_FOR_vpmadd52luqv8di_mask, "__builtin_ia32_vpmadd52luq512_mask", IX86_BUILTIN_VPMADD52LUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512IFMA, 0, CODE_FOR_vpmadd52luqv8di_maskz, "__builtin_ia32_vpmadd52luq512_maskz", IX86_BUILTIN_VPMADD52LUQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512IFMA, 0, CODE_FOR_vpmadd52huqv8di_mask, "__builtin_ia32_vpmadd52huq512_mask", IX86_BUILTIN_VPMADD52HUQ512, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512IFMA, 0, CODE_FOR_vpmadd52huqv8di_maskz, "__builtin_ia32_vpmadd52huq512_maskz", IX86_BUILTIN_VPMADD52HUQ512_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmadd52luqv4di_mask, "__builtin_ia32_vpmadd52luq256_mask", IX86_BUILTIN_VPMADD52LUQ256, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmadd52luqv4di_maskz, "__builtin_ia32_vpmadd52luq256_maskz", IX86_BUILTIN_VPMADD52LUQ256_MASKZ, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmadd52huqv4di_mask, "__builtin_ia32_vpmadd52huq256_mask", IX86_BUILTIN_VPMADD52HUQ256, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
*************** BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTI
*** 2577,2589 ****
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXIFMA, CODE_FOR_vpmadd52huqv2di, "__builtin_ia32_vpmadd52huq128", IX86_BUINTIN_VPMADD52HUQ128, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI)
  
  /* AVX512VBMI */
! BDESC (OPTION_MASK_ISA_AVX512VBMI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpmultishiftqbv64qi_mask, "__builtin_ia32_vpmultishiftqb512_mask", IX86_BUILTIN_VPMULTISHIFTQB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmultishiftqbv32qi_mask, "__builtin_ia32_vpmultishiftqb256_mask", IX86_BUILTIN_VPMULTISHIFTQB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmultishiftqbv16qi_mask, "__builtin_ia32_vpmultishiftqb128_mask", IX86_BUILTIN_VPMULTISHIFTQB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_permvarv64qi_mask, "__builtin_ia32_permvarqi512_mask", IX86_BUILTIN_VPERMVARQI512_MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vpermt2varv64qi3_mask, "__builtin_ia32_vpermt2varqi512_mask", IX86_BUILTIN_VPERMT2VARQI512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vpermt2varv64qi3_maskz, "__builtin_ia32_vpermt2varqi512_maskz", IX86_BUILTIN_VPERMT2VARQI512_MASKZ, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_vpermi2varv64qi3_mask, "__builtin_ia32_vpermi2varqi512_mask", IX86_BUILTIN_VPERMI2VARQI512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_permvarv32qi_mask, "__builtin_ia32_permvarqi256_mask", IX86_BUILTIN_VPERMVARQI256_MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_permvarv16qi_mask, "__builtin_ia32_permvarqi128_mask", IX86_BUILTIN_VPERMVARQI128_MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_V16QI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpermt2varv32qi3_mask, "__builtin_ia32_vpermt2varqi256_mask", IX86_BUILTIN_VPERMT2VARQI256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
--- 2577,2589 ----
  BDESC (OPTION_MASK_ISA_AVX512IFMA | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXIFMA, CODE_FOR_vpmadd52huqv2di, "__builtin_ia32_vpmadd52huq128", IX86_BUINTIN_VPMADD52HUQ128, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI)
  
  /* AVX512VBMI */
! BDESC (OPTION_MASK_ISA_AVX512VBMI, 0, CODE_FOR_vpmultishiftqbv64qi_mask, "__builtin_ia32_vpmultishiftqb512_mask", IX86_BUILTIN_VPMULTISHIFTQB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmultishiftqbv32qi_mask, "__builtin_ia32_vpmultishiftqb256_mask", IX86_BUILTIN_VPMULTISHIFTQB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpmultishiftqbv16qi_mask, "__builtin_ia32_vpmultishiftqb128_mask", IX86_BUILTIN_VPMULTISHIFTQB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, 0, CODE_FOR_avx512bw_permvarv64qi_mask, "__builtin_ia32_permvarqi512_mask", IX86_BUILTIN_VPERMVARQI512_MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, 0, CODE_FOR_avx512bw_vpermt2varv64qi3_mask, "__builtin_ia32_vpermt2varqi512_mask", IX86_BUILTIN_VPERMT2VARQI512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, 0, CODE_FOR_avx512bw_vpermt2varv64qi3_maskz, "__builtin_ia32_vpermt2varqi512_maskz", IX86_BUILTIN_VPERMT2VARQI512_MASKZ, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI, 0, CODE_FOR_avx512bw_vpermi2varv64qi3_mask, "__builtin_ia32_vpermi2varqi512_mask", IX86_BUILTIN_VPERMI2VARQI512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_permvarv32qi_mask, "__builtin_ia32_permvarqi256_mask", IX86_BUILTIN_VPERMVARQI256_MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_permvarv16qi_mask, "__builtin_ia32_permvarqi128_mask", IX86_BUILTIN_VPERMVARQI128_MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_V16QI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpermt2varv32qi3_mask, "__builtin_ia32_vpermt2varqi256_mask", IX86_BUILTIN_VPERMT2VARQI256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
*************** BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTI
*** 2594,2609 ****
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpermi2varv16qi3_mask, "__builtin_ia32_vpermi2varqi128_mask", IX86_BUILTIN_VPERMI2VARQI128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_V16QI_UHI)
  
  /* VBMI2 */
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_compressv64qi_mask, "__builtin_ia32_compressqi512_mask", IX86_BUILTIN_PCOMPRESSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_compressv32hi_mask, "__builtin_ia32_compresshi512_mask", IX86_BUILTIN_PCOMPRESSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv32qi_mask, "__builtin_ia32_compressqi256_mask", IX86_BUILTIN_PCOMPRESSB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv16qi_mask, "__builtin_ia32_compressqi128_mask", IX86_BUILTIN_PCOMPRESSB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv16hi_mask, "__builtin_ia32_compresshi256_mask", IX86_BUILTIN_PCOMPRESSW256, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv8hi_mask, "__builtin_ia32_compresshi128_mask", IX86_BUILTIN_PCOMPRESSW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv64qi_mask, "__builtin_ia32_expandqi512_mask", IX86_BUILTIN_PEXPANDB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv64qi_maskz, "__builtin_ia32_expandqi512_maskz", IX86_BUILTIN_PEXPANDB512Z, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv32hi_mask, "__builtin_ia32_expandhi512_mask", IX86_BUILTIN_PEXPANDW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_expandv32hi_maskz, "__builtin_ia32_expandhi512_maskz", IX86_BUILTIN_PEXPANDW512Z, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_mask, "__builtin_ia32_expandqi256_mask", IX86_BUILTIN_PEXPANDB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_maskz, "__builtin_ia32_expandqi256_maskz", IX86_BUILTIN_PEXPANDB256Z, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv16qi_mask, "__builtin_ia32_expandqi128_mask", IX86_BUILTIN_PEXPANDB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_UHI)
--- 2594,2609 ----
  BDESC (OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpermi2varv16qi3_mask, "__builtin_ia32_vpermi2varqi128_mask", IX86_BUILTIN_VPERMI2VARQI128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_V16QI_UHI)
  
  /* VBMI2 */
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_compressv64qi_mask, "__builtin_ia32_compressqi512_mask", IX86_BUILTIN_PCOMPRESSB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_compressv32hi_mask, "__builtin_ia32_compresshi512_mask", IX86_BUILTIN_PCOMPRESSW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv32qi_mask, "__builtin_ia32_compressqi256_mask", IX86_BUILTIN_PCOMPRESSB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv16qi_mask, "__builtin_ia32_compressqi128_mask", IX86_BUILTIN_PCOMPRESSB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv16hi_mask, "__builtin_ia32_compresshi256_mask", IX86_BUILTIN_PCOMPRESSW256, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_compressv8hi_mask, "__builtin_ia32_compresshi128_mask", IX86_BUILTIN_PCOMPRESSW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv64qi_mask, "__builtin_ia32_expandqi512_mask", IX86_BUILTIN_PEXPANDB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv64qi_maskz, "__builtin_ia32_expandqi512_maskz", IX86_BUILTIN_PEXPANDB512Z, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv32hi_mask, "__builtin_ia32_expandhi512_mask", IX86_BUILTIN_PEXPANDW512, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_expandv32hi_maskz, "__builtin_ia32_expandhi512_maskz", IX86_BUILTIN_PEXPANDW512Z, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_mask, "__builtin_ia32_expandqi256_mask", IX86_BUILTIN_PEXPANDB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv32qi_maskz, "__builtin_ia32_expandqi256_maskz", IX86_BUILTIN_PEXPANDB256Z, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv16qi_mask, "__builtin_ia32_expandqi128_mask", IX86_BUILTIN_PEXPANDB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_UHI)
*************** BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPT
*** 2612,2675 ****
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv16hi_maskz, "__builtin_ia32_expandhi256_maskz", IX86_BUILTIN_PEXPANDW256Z, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv8hi_mask, "__builtin_ia32_expandhi128_mask", IX86_BUILTIN_PEXPANDW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv8hi_maskz, "__builtin_ia32_expandhi128_maskz", IX86_BUILTIN_PEXPANDW128Z, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrd_v32hi, "__builtin_ia32_vpshrd_v32hi", IX86_BUILTIN_VPSHRDV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrd_v32hi_mask, "__builtin_ia32_vpshrd_v32hi_mask", IX86_BUILTIN_VPSHRDV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT_V32HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v16hi, "__builtin_ia32_vpshrd_v16hi", IX86_BUILTIN_VPSHRDV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v16hi_mask, "__builtin_ia32_vpshrd_v16hi_mask", IX86_BUILTIN_VPSHRDV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8hi, "__builtin_ia32_vpshrd_v8hi", IX86_BUILTIN_VPSHRDV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8hi_mask, "__builtin_ia32_vpshrd_v8hi_mask", IX86_BUILTIN_VPSHRDV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT_V8HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrd_v16si, "__builtin_ia32_vpshrd_v16si", IX86_BUILTIN_VPSHRDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrd_v16si_mask, "__builtin_ia32_vpshrd_v16si_mask", IX86_BUILTIN_VPSHRDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8si, "__builtin_ia32_vpshrd_v8si", IX86_BUILTIN_VPSHRDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8si_mask, "__builtin_ia32_vpshrd_v8si_mask", IX86_BUILTIN_VPSHRDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4si, "__builtin_ia32_vpshrd_v4si", IX86_BUILTIN_VPSHRDV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4si_mask, "__builtin_ia32_vpshrd_v4si_mask", IX86_BUILTIN_VPSHRDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT_V4SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrd_v8di, "__builtin_ia32_vpshrd_v8di", IX86_BUILTIN_VPSHRDV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrd_v8di_mask, "__builtin_ia32_vpshrd_v8di_mask", IX86_BUILTIN_VPSHRDV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4di, "__builtin_ia32_vpshrd_v4di", IX86_BUILTIN_VPSHRDV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4di_mask, "__builtin_ia32_vpshrd_v4di_mask", IX86_BUILTIN_VPSHRDV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v2di, "__builtin_ia32_vpshrd_v2di", IX86_BUILTIN_VPSHRDV2DI, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v2di_mask, "__builtin_ia32_vpshrd_v2di_mask", IX86_BUILTIN_VPSHRDV2DI_MASK, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT_V2DI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshld_v32hi, "__builtin_ia32_vpshld_v32hi", IX86_BUILTIN_VPSHLDV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshld_v32hi_mask, "__builtin_ia32_vpshld_v32hi_mask", IX86_BUILTIN_VPSHLDV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT_V32HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v16hi, "__builtin_ia32_vpshld_v16hi", IX86_BUILTIN_VPSHLDV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v16hi_mask, "__builtin_ia32_vpshld_v16hi_mask", IX86_BUILTIN_VPSHLDV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8hi, "__builtin_ia32_vpshld_v8hi", IX86_BUILTIN_VPSHLDV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8hi_mask, "__builtin_ia32_vpshld_v8hi_mask", IX86_BUILTIN_VPSHLDV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT_V8HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshld_v16si, "__builtin_ia32_vpshld_v16si", IX86_BUILTIN_VPSHLDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshld_v16si_mask, "__builtin_ia32_vpshld_v16si_mask", IX86_BUILTIN_VPSHLDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8si, "__builtin_ia32_vpshld_v8si", IX86_BUILTIN_VPSHLDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8si_mask, "__builtin_ia32_vpshld_v8si_mask", IX86_BUILTIN_VPSHLDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4si, "__builtin_ia32_vpshld_v4si", IX86_BUILTIN_VPSHLDV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4si_mask, "__builtin_ia32_vpshld_v4si_mask", IX86_BUILTIN_VPSHLDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT_V4SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshld_v8di, "__builtin_ia32_vpshld_v8di", IX86_BUILTIN_VPSHLDV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshld_v8di_mask, "__builtin_ia32_vpshld_v8di_mask", IX86_BUILTIN_VPSHLDV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4di, "__builtin_ia32_vpshld_v4di", IX86_BUILTIN_VPSHLDV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4di_mask, "__builtin_ia32_vpshld_v4di_mask", IX86_BUILTIN_VPSHLDV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v2di, "__builtin_ia32_vpshld_v2di", IX86_BUILTIN_VPSHLDV2DI, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v2di_mask, "__builtin_ia32_vpshld_v2di_mask", IX86_BUILTIN_VPSHLDV2DI_MASK, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT_V2DI_INT)
  
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v32hi, "__builtin_ia32_vpshrdv_v32hi", IX86_BUILTIN_VPSHRDVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v32hi_mask, "__builtin_ia32_vpshrdv_v32hi_mask", IX86_BUILTIN_VPSHRDVV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v32hi_maskz, "__builtin_ia32_vpshrdv_v32hi_maskz", IX86_BUILTIN_VPSHRDVV32HI_MASKZ, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v16hi, "__builtin_ia32_vpshrdv_v16hi", IX86_BUILTIN_VPSHRDVV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v16hi_mask, "__builtin_ia32_vpshrdv_v16hi_mask", IX86_BUILTIN_VPSHRDVV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v16hi_maskz, "__builtin_ia32_vpshrdv_v16hi_maskz", IX86_BUILTIN_VPSHRDVV16HI_MASKZ, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8hi, "__builtin_ia32_vpshrdv_v8hi", IX86_BUILTIN_VPSHRDVV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8hi_mask, "__builtin_ia32_vpshrdv_v8hi_mask", IX86_BUILTIN_VPSHRDVV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8hi_maskz, "__builtin_ia32_vpshrdv_v8hi_maskz", IX86_BUILTIN_VPSHRDVV8HI_MASKZ, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v16si, "__builtin_ia32_vpshrdv_v16si", IX86_BUILTIN_VPSHRDVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v16si_mask, "__builtin_ia32_vpshrdv_v16si_mask", IX86_BUILTIN_VPSHRDVV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v16si_maskz, "__builtin_ia32_vpshrdv_v16si_maskz", IX86_BUILTIN_VPSHRDVV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8si, "__builtin_ia32_vpshrdv_v8si", IX86_BUILTIN_VPSHRDVV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8si_mask, "__builtin_ia32_vpshrdv_v8si_mask", IX86_BUILTIN_VPSHRDVV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8si_maskz, "__builtin_ia32_vpshrdv_v8si_maskz", IX86_BUILTIN_VPSHRDVV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4si, "__builtin_ia32_vpshrdv_v4si", IX86_BUILTIN_VPSHRDVV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4si_mask, "__builtin_ia32_vpshrdv_v4si_mask", IX86_BUILTIN_VPSHRDVV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4si_maskz, "__builtin_ia32_vpshrdv_v4si_maskz", IX86_BUILTIN_VPSHRDVV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v8di, "__builtin_ia32_vpshrdv_v8di", IX86_BUILTIN_VPSHRDVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v8di_mask, "__builtin_ia32_vpshrdv_v8di_mask", IX86_BUILTIN_VPSHRDVV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshrdv_v8di_maskz, "__builtin_ia32_vpshrdv_v8di_maskz", IX86_BUILTIN_VPSHRDVV8DI_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4di, "__builtin_ia32_vpshrdv_v4di", IX86_BUILTIN_VPSHRDVV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4di_mask, "__builtin_ia32_vpshrdv_v4di_mask", IX86_BUILTIN_VPSHRDVV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4di_maskz, "__builtin_ia32_vpshrdv_v4di_maskz", IX86_BUILTIN_VPSHRDVV4DI_MASKZ, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
--- 2612,2675 ----
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv16hi_maskz, "__builtin_ia32_expandhi256_maskz", IX86_BUILTIN_PEXPANDW256Z, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv8hi_mask, "__builtin_ia32_expandhi128_mask", IX86_BUILTIN_PEXPANDW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_expandv8hi_maskz, "__builtin_ia32_expandhi128_maskz", IX86_BUILTIN_PEXPANDW128Z, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrd_v32hi, "__builtin_ia32_vpshrd_v32hi", IX86_BUILTIN_VPSHRDV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrd_v32hi_mask, "__builtin_ia32_vpshrd_v32hi_mask", IX86_BUILTIN_VPSHRDV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT_V32HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v16hi, "__builtin_ia32_vpshrd_v16hi", IX86_BUILTIN_VPSHRDV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v16hi_mask, "__builtin_ia32_vpshrd_v16hi_mask", IX86_BUILTIN_VPSHRDV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8hi, "__builtin_ia32_vpshrd_v8hi", IX86_BUILTIN_VPSHRDV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8hi_mask, "__builtin_ia32_vpshrd_v8hi_mask", IX86_BUILTIN_VPSHRDV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT_V8HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrd_v16si, "__builtin_ia32_vpshrd_v16si", IX86_BUILTIN_VPSHRDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrd_v16si_mask, "__builtin_ia32_vpshrd_v16si_mask", IX86_BUILTIN_VPSHRDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8si, "__builtin_ia32_vpshrd_v8si", IX86_BUILTIN_VPSHRDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v8si_mask, "__builtin_ia32_vpshrd_v8si_mask", IX86_BUILTIN_VPSHRDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4si, "__builtin_ia32_vpshrd_v4si", IX86_BUILTIN_VPSHRDV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4si_mask, "__builtin_ia32_vpshrd_v4si_mask", IX86_BUILTIN_VPSHRDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT_V4SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrd_v8di, "__builtin_ia32_vpshrd_v8di", IX86_BUILTIN_VPSHRDV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrd_v8di_mask, "__builtin_ia32_vpshrd_v8di_mask", IX86_BUILTIN_VPSHRDV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4di, "__builtin_ia32_vpshrd_v4di", IX86_BUILTIN_VPSHRDV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v4di_mask, "__builtin_ia32_vpshrd_v4di_mask", IX86_BUILTIN_VPSHRDV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v2di, "__builtin_ia32_vpshrd_v2di", IX86_BUILTIN_VPSHRDV2DI, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrd_v2di_mask, "__builtin_ia32_vpshrd_v2di_mask", IX86_BUILTIN_VPSHRDV2DI_MASK, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT_V2DI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshld_v32hi, "__builtin_ia32_vpshld_v32hi", IX86_BUILTIN_VPSHLDV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshld_v32hi_mask, "__builtin_ia32_vpshld_v32hi_mask", IX86_BUILTIN_VPSHLDV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_INT_V32HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v16hi, "__builtin_ia32_vpshld_v16hi", IX86_BUILTIN_VPSHLDV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v16hi_mask, "__builtin_ia32_vpshld_v16hi_mask", IX86_BUILTIN_VPSHLDV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_INT_V16HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8hi, "__builtin_ia32_vpshld_v8hi", IX86_BUILTIN_VPSHLDV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8hi_mask, "__builtin_ia32_vpshld_v8hi_mask", IX86_BUILTIN_VPSHLDV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_INT_V8HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshld_v16si, "__builtin_ia32_vpshld_v16si", IX86_BUILTIN_VPSHLDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshld_v16si_mask, "__builtin_ia32_vpshld_v16si_mask", IX86_BUILTIN_VPSHLDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_INT_V16SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8si, "__builtin_ia32_vpshld_v8si", IX86_BUILTIN_VPSHLDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v8si_mask, "__builtin_ia32_vpshld_v8si_mask", IX86_BUILTIN_VPSHLDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_INT_V8SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4si, "__builtin_ia32_vpshld_v4si", IX86_BUILTIN_VPSHLDV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4si_mask, "__builtin_ia32_vpshld_v4si_mask", IX86_BUILTIN_VPSHLDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_INT_V4SI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshld_v8di, "__builtin_ia32_vpshld_v8di", IX86_BUILTIN_VPSHLDV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshld_v8di_mask, "__builtin_ia32_vpshld_v8di_mask", IX86_BUILTIN_VPSHLDV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT_V8DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4di, "__builtin_ia32_vpshld_v4di", IX86_BUILTIN_VPSHLDV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v4di_mask, "__builtin_ia32_vpshld_v4di_mask", IX86_BUILTIN_VPSHLDV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT_V4DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v2di, "__builtin_ia32_vpshld_v2di", IX86_BUILTIN_VPSHLDV2DI, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshld_v2di_mask, "__builtin_ia32_vpshld_v2di_mask", IX86_BUILTIN_VPSHLDV2DI_MASK, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT_V2DI_INT)
  
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v32hi, "__builtin_ia32_vpshrdv_v32hi", IX86_BUILTIN_VPSHRDVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v32hi_mask, "__builtin_ia32_vpshrdv_v32hi_mask", IX86_BUILTIN_VPSHRDVV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v32hi_maskz, "__builtin_ia32_vpshrdv_v32hi_maskz", IX86_BUILTIN_VPSHRDVV32HI_MASKZ, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v16hi, "__builtin_ia32_vpshrdv_v16hi", IX86_BUILTIN_VPSHRDVV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v16hi_mask, "__builtin_ia32_vpshrdv_v16hi_mask", IX86_BUILTIN_VPSHRDVV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v16hi_maskz, "__builtin_ia32_vpshrdv_v16hi_maskz", IX86_BUILTIN_VPSHRDVV16HI_MASKZ, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8hi, "__builtin_ia32_vpshrdv_v8hi", IX86_BUILTIN_VPSHRDVV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8hi_mask, "__builtin_ia32_vpshrdv_v8hi_mask", IX86_BUILTIN_VPSHRDVV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8hi_maskz, "__builtin_ia32_vpshrdv_v8hi_maskz", IX86_BUILTIN_VPSHRDVV8HI_MASKZ, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v16si, "__builtin_ia32_vpshrdv_v16si", IX86_BUILTIN_VPSHRDVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v16si_mask, "__builtin_ia32_vpshrdv_v16si_mask", IX86_BUILTIN_VPSHRDVV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v16si_maskz, "__builtin_ia32_vpshrdv_v16si_maskz", IX86_BUILTIN_VPSHRDVV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8si, "__builtin_ia32_vpshrdv_v8si", IX86_BUILTIN_VPSHRDVV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8si_mask, "__builtin_ia32_vpshrdv_v8si_mask", IX86_BUILTIN_VPSHRDVV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v8si_maskz, "__builtin_ia32_vpshrdv_v8si_maskz", IX86_BUILTIN_VPSHRDVV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4si, "__builtin_ia32_vpshrdv_v4si", IX86_BUILTIN_VPSHRDVV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4si_mask, "__builtin_ia32_vpshrdv_v4si_mask", IX86_BUILTIN_VPSHRDVV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4si_maskz, "__builtin_ia32_vpshrdv_v4si_maskz", IX86_BUILTIN_VPSHRDVV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v8di, "__builtin_ia32_vpshrdv_v8di", IX86_BUILTIN_VPSHRDVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v8di_mask, "__builtin_ia32_vpshrdv_v8di_mask", IX86_BUILTIN_VPSHRDVV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshrdv_v8di_maskz, "__builtin_ia32_vpshrdv_v8di_maskz", IX86_BUILTIN_VPSHRDVV8DI_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4di, "__builtin_ia32_vpshrdv_v4di", IX86_BUILTIN_VPSHRDVV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4di_mask, "__builtin_ia32_vpshrdv_v4di_mask", IX86_BUILTIN_VPSHRDVV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v4di_maskz, "__builtin_ia32_vpshrdv_v4di_maskz", IX86_BUILTIN_VPSHRDVV4DI_MASKZ, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
*************** BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPT
*** 2677,2703 ****
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v2di_mask, "__builtin_ia32_vpshrdv_v2di_mask", IX86_BUILTIN_VPSHRDVV2DI_MASK, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v2di_maskz, "__builtin_ia32_vpshrdv_v2di_maskz", IX86_BUILTIN_VPSHRDVV2DI_MASKZ, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v32hi, "__builtin_ia32_vpshldv_v32hi", IX86_BUILTIN_VPSHLDVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v32hi_mask, "__builtin_ia32_vpshldv_v32hi_mask", IX86_BUILTIN_VPSHLDVV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v32hi_maskz, "__builtin_ia32_vpshldv_v32hi_maskz", IX86_BUILTIN_VPSHLDVV32HI_MASKZ, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v16hi, "__builtin_ia32_vpshldv_v16hi", IX86_BUILTIN_VPSHLDVV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v16hi_mask, "__builtin_ia32_vpshldv_v16hi_mask", IX86_BUILTIN_VPSHLDVV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v16hi_maskz, "__builtin_ia32_vpshldv_v16hi_maskz", IX86_BUILTIN_VPSHLDVV16HI_MASKZ, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8hi, "__builtin_ia32_vpshldv_v8hi", IX86_BUILTIN_VPSHLDVV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8hi_mask, "__builtin_ia32_vpshldv_v8hi_mask", IX86_BUILTIN_VPSHLDVV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8hi_maskz, "__builtin_ia32_vpshldv_v8hi_maskz", IX86_BUILTIN_VPSHLDVV8HI_MASKZ, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v16si, "__builtin_ia32_vpshldv_v16si", IX86_BUILTIN_VPSHLDVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v16si_mask, "__builtin_ia32_vpshldv_v16si_mask", IX86_BUILTIN_VPSHLDVV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v16si_maskz, "__builtin_ia32_vpshldv_v16si_maskz", IX86_BUILTIN_VPSHLDVV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8si, "__builtin_ia32_vpshldv_v8si", IX86_BUILTIN_VPSHLDVV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8si_mask, "__builtin_ia32_vpshldv_v8si_mask", IX86_BUILTIN_VPSHLDVV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8si_maskz, "__builtin_ia32_vpshldv_v8si_maskz", IX86_BUILTIN_VPSHLDVV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4si, "__builtin_ia32_vpshldv_v4si", IX86_BUILTIN_VPSHLDVV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4si_mask, "__builtin_ia32_vpshldv_v4si_mask", IX86_BUILTIN_VPSHLDVV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4si_maskz, "__builtin_ia32_vpshldv_v4si_maskz", IX86_BUILTIN_VPSHLDVV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v8di, "__builtin_ia32_vpshldv_v8di", IX86_BUILTIN_VPSHLDVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v8di_mask, "__builtin_ia32_vpshldv_v8di_mask", IX86_BUILTIN_VPSHLDVV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpshldv_v8di_maskz, "__builtin_ia32_vpshldv_v8di_maskz", IX86_BUILTIN_VPSHLDVV8DI_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4di, "__builtin_ia32_vpshldv_v4di", IX86_BUILTIN_VPSHLDVV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4di_mask, "__builtin_ia32_vpshldv_v4di_mask", IX86_BUILTIN_VPSHLDVV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4di_maskz, "__builtin_ia32_vpshldv_v4di_maskz", IX86_BUILTIN_VPSHLDVV4DI_MASKZ, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
--- 2677,2703 ----
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v2di_mask, "__builtin_ia32_vpshrdv_v2di_mask", IX86_BUILTIN_VPSHRDVV2DI_MASK, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshrdv_v2di_maskz, "__builtin_ia32_vpshrdv_v2di_maskz", IX86_BUILTIN_VPSHRDVV2DI_MASKZ, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v32hi, "__builtin_ia32_vpshldv_v32hi", IX86_BUILTIN_VPSHLDVV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v32hi_mask, "__builtin_ia32_vpshldv_v32hi_mask", IX86_BUILTIN_VPSHLDVV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v32hi_maskz, "__builtin_ia32_vpshldv_v32hi_maskz", IX86_BUILTIN_VPSHLDVV32HI_MASKZ, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v16hi, "__builtin_ia32_vpshldv_v16hi", IX86_BUILTIN_VPSHLDVV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v16hi_mask, "__builtin_ia32_vpshldv_v16hi_mask", IX86_BUILTIN_VPSHLDVV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v16hi_maskz, "__builtin_ia32_vpshldv_v16hi_maskz", IX86_BUILTIN_VPSHLDVV16HI_MASKZ, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8hi, "__builtin_ia32_vpshldv_v8hi", IX86_BUILTIN_VPSHLDVV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8hi_mask, "__builtin_ia32_vpshldv_v8hi_mask", IX86_BUILTIN_VPSHLDVV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8hi_maskz, "__builtin_ia32_vpshldv_v8hi_maskz", IX86_BUILTIN_VPSHLDVV8HI_MASKZ, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v16si, "__builtin_ia32_vpshldv_v16si", IX86_BUILTIN_VPSHLDVV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v16si_mask, "__builtin_ia32_vpshldv_v16si_mask", IX86_BUILTIN_VPSHLDVV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v16si_maskz, "__builtin_ia32_vpshldv_v16si_maskz", IX86_BUILTIN_VPSHLDVV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8si, "__builtin_ia32_vpshldv_v8si", IX86_BUILTIN_VPSHLDVV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8si_mask, "__builtin_ia32_vpshldv_v8si_mask", IX86_BUILTIN_VPSHLDVV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v8si_maskz, "__builtin_ia32_vpshldv_v8si_maskz", IX86_BUILTIN_VPSHLDVV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4si, "__builtin_ia32_vpshldv_v4si", IX86_BUILTIN_VPSHLDVV4SI, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4si_mask, "__builtin_ia32_vpshldv_v4si_mask", IX86_BUILTIN_VPSHLDVV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4si_maskz, "__builtin_ia32_vpshldv_v4si_maskz", IX86_BUILTIN_VPSHLDVV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v8di, "__builtin_ia32_vpshldv_v8di", IX86_BUILTIN_VPSHLDVV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v8di_mask, "__builtin_ia32_vpshldv_v8di_mask", IX86_BUILTIN_VPSHLDVV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
! BDESC (OPTION_MASK_ISA_AVX512VBMI2, 0, CODE_FOR_vpshldv_v8di_maskz, "__builtin_ia32_vpshldv_v8di_maskz", IX86_BUILTIN_VPSHLDVV8DI_MASKZ, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_V8DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4di, "__builtin_ia32_vpshldv_v4di", IX86_BUILTIN_VPSHLDVV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4di_mask, "__builtin_ia32_vpshldv_v4di_mask", IX86_BUILTIN_VPSHLDVV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v4di_maskz, "__builtin_ia32_vpshldv_v4di_maskz", IX86_BUILTIN_VPSHLDVV4DI_MASKZ, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_V4DI_UQI)
*************** BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPT
*** 2706,2725 ****
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v2di_maskz, "__builtin_ia32_vpshldv_v2di_maskz", IX86_BUILTIN_VPSHLDVV2DI_MASKZ, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI_UQI)
  
  /* GFNI */
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vgf2p8affineinvqb_v64qi, "__builtin_ia32_vgf2p8affineinvqb_v64qi", IX86_BUILTIN_VGF2P8AFFINEINVQB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vgf2p8affineinvqb_v64qi_mask, "__builtin_ia32_vgf2p8affineinvqb_v64qi_mask", IX86_BUILTIN_VGF2P8AFFINEINVQB512MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vgf2p8affineinvqb_v32qi, "__builtin_ia32_vgf2p8affineinvqb_v32qi", IX86_BUILTIN_VGF2P8AFFINEINVQB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8affineinvqb_v32qi_mask, "__builtin_ia32_vgf2p8affineinvqb_v32qi_mask", IX86_BUILTIN_VGF2P8AFFINEINVQB256MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT_V32QI_USI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_SSE2, 0, CODE_FOR_vgf2p8affineinvqb_v16qi, "__builtin_ia32_vgf2p8affineinvqb_v16qi", IX86_BUILTIN_VGF2P8AFFINEINVQB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vgf2p8affineinvqb_v16qi_mask, "__builtin_ia32_vgf2p8affineinvqb_v16qi_mask", IX86_BUILTIN_VGF2P8AFFINEINVQB128MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vgf2p8affineqb_v64qi, "__builtin_ia32_vgf2p8affineqb_v64qi", IX86_BUILTIN_VGF2P8AFFINEQB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vgf2p8affineqb_v64qi_mask, "__builtin_ia32_vgf2p8affineqb_v64qi_mask", IX86_BUILTIN_VGF2P8AFFINEQB512MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vgf2p8affineqb_v32qi, "__builtin_ia32_vgf2p8affineqb_v32qi", IX86_BUILTIN_VGF2P8AFFINEQB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8affineqb_v32qi_mask, "__builtin_ia32_vgf2p8affineqb_v32qi_mask", IX86_BUILTIN_VGF2P8AFFINEQB256MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT_V32QI_USI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_SSE2, 0, CODE_FOR_vgf2p8affineqb_v16qi, "__builtin_ia32_vgf2p8affineqb_v16qi", IX86_BUILTIN_VGF2P8AFFINEQB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vgf2p8affineqb_v16qi_mask, "__builtin_ia32_vgf2p8affineqb_v16qi_mask", IX86_BUILTIN_VGF2P8AFFINEQB128MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vgf2p8mulb_v64qi, "__builtin_ia32_vgf2p8mulb_v64qi", IX86_BUILTIN_VGF2P8MULB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512BW, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vgf2p8mulb_v64qi_mask, "__builtin_ia32_vgf2p8mulb_v64qi_mask", IX86_BUILTIN_VGF2P8MULB512MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vgf2p8mulb_v32qi, "__builtin_ia32_vgf2p8mulb_v32qi", IX86_BUILTIN_VGF2P8MULB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8mulb_v32qi_mask, "__builtin_ia32_vgf2p8mulb_v32qi_mask", IX86_BUILTIN_VGF2P8MULB256MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_SSE2, 0, CODE_FOR_vgf2p8mulb_v16qi, "__builtin_ia32_vgf2p8mulb_v16qi", IX86_BUILTIN_VGF2P8MULB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
--- 2706,2725 ----
  BDESC (OPTION_MASK_ISA_AVX512VBMI2 | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpshldv_v2di_maskz, "__builtin_ia32_vpshldv_v2di_maskz", IX86_BUILTIN_VPSHLDVV2DI_MASKZ, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_V2DI_UQI)
  
  /* GFNI */
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_vgf2p8affineinvqb_v64qi, "__builtin_ia32_vgf2p8affineinvqb_v64qi", IX86_BUILTIN_VGF2P8AFFINEINVQB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8affineinvqb_v64qi_mask, "__builtin_ia32_vgf2p8affineinvqb_v64qi_mask", IX86_BUILTIN_VGF2P8AFFINEINVQB512MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vgf2p8affineinvqb_v32qi, "__builtin_ia32_vgf2p8affineinvqb_v32qi", IX86_BUILTIN_VGF2P8AFFINEINVQB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8affineinvqb_v32qi_mask, "__builtin_ia32_vgf2p8affineinvqb_v32qi_mask", IX86_BUILTIN_VGF2P8AFFINEINVQB256MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT_V32QI_USI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_SSE2, 0, CODE_FOR_vgf2p8affineinvqb_v16qi, "__builtin_ia32_vgf2p8affineinvqb_v16qi", IX86_BUILTIN_VGF2P8AFFINEINVQB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vgf2p8affineinvqb_v16qi_mask, "__builtin_ia32_vgf2p8affineinvqb_v16qi_mask", IX86_BUILTIN_VGF2P8AFFINEINVQB128MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_vgf2p8affineqb_v64qi, "__builtin_ia32_vgf2p8affineqb_v64qi", IX86_BUILTIN_VGF2P8AFFINEQB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8affineqb_v64qi_mask, "__builtin_ia32_vgf2p8affineqb_v64qi_mask", IX86_BUILTIN_VGF2P8AFFINEQB512MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_INT_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vgf2p8affineqb_v32qi, "__builtin_ia32_vgf2p8affineqb_v32qi", IX86_BUILTIN_VGF2P8AFFINEQB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8affineqb_v32qi_mask, "__builtin_ia32_vgf2p8affineqb_v32qi_mask", IX86_BUILTIN_VGF2P8AFFINEQB256MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_INT_V32QI_USI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_SSE2, 0, CODE_FOR_vgf2p8affineqb_v16qi, "__builtin_ia32_vgf2p8affineqb_v16qi", IX86_BUILTIN_VGF2P8AFFINEQB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vgf2p8affineqb_v16qi_mask, "__builtin_ia32_vgf2p8affineqb_v16qi_mask", IX86_BUILTIN_VGF2P8AFFINEQB128MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_INT_V16QI_UHI)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_vgf2p8mulb_v64qi, "__builtin_ia32_vgf2p8mulb_v64qi", IX86_BUILTIN_VGF2P8MULB512, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
! BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8mulb_v64qi_mask, "__builtin_ia32_vgf2p8mulb_v64qi_mask", IX86_BUILTIN_VGF2P8MULB512MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vgf2p8mulb_v32qi, "__builtin_ia32_vgf2p8mulb_v32qi", IX86_BUILTIN_VGF2P8MULB256, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_AVX512BW, 0, CODE_FOR_vgf2p8mulb_v32qi_mask, "__builtin_ia32_vgf2p8mulb_v32qi_mask", IX86_BUILTIN_VGF2P8MULB256MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_GFNI | OPTION_MASK_ISA_SSE2, 0, CODE_FOR_vgf2p8mulb_v16qi, "__builtin_ia32_vgf2p8mulb_v16qi", IX86_BUILTIN_VGF2P8MULB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
*************** BDESC (OPTION_MASK_ISA_GFNI | OPTION_MAS
*** 2727,2735 ****
  
  /* AVX512_VNNI */
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpbusd_v16si, "__builtin_ia32_vpdpbusd_v16si", IX86_BUILTIN_VPDPBUSDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpbusd_v16si_mask, "__builtin_ia32_vpdpbusd_v16si_mask", IX86_BUILTIN_VPDPBUSDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpbusd_v16si_maskz, "__builtin_ia32_vpdpbusd_v16si_maskz", IX86_BUILTIN_VPDPBUSDV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpbusd_v8si, "__builtin_ia32_vpdpbusd_v8si", IX86_BUILTIN_VPDPBUSDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v8si_mask, "__builtin_ia32_vpdpbusd_v8si_mask", IX86_BUILTIN_VPDPBUSDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v8si_maskz, "__builtin_ia32_vpdpbusd_v8si_maskz", IX86_BUILTIN_VPDPBUSDV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
--- 2727,2735 ----
  
  /* AVX512_VNNI */
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpbusd_v16si, "__builtin_ia32_vpdpbusd_v16si", IX86_BUILTIN_VPDPBUSDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpbusd_v16si_mask, "__builtin_ia32_vpdpbusd_v16si_mask", IX86_BUILTIN_VPDPBUSDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpbusd_v16si_maskz, "__builtin_ia32_vpdpbusd_v16si_maskz", IX86_BUILTIN_VPDPBUSDV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpbusd_v8si, "__builtin_ia32_vpdpbusd_v8si", IX86_BUILTIN_VPDPBUSDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v8si_mask, "__builtin_ia32_vpdpbusd_v8si_mask", IX86_BUILTIN_VPDPBUSDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v8si_maskz, "__builtin_ia32_vpdpbusd_v8si_maskz", IX86_BUILTIN_VPDPBUSDV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
*************** BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTI
*** 2737,2745 ****
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v4si_mask, "__builtin_ia32_vpdpbusd_v4si_mask", IX86_BUILTIN_VPDPBUSDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v4si_maskz, "__builtin_ia32_vpdpbusd_v4si_maskz", IX86_BUILTIN_VPDPBUSDV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpbusds_v16si, "__builtin_ia32_vpdpbusds_v16si", IX86_BUILTIN_VPDPBUSDSV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpbusds_v16si_mask, "__builtin_ia32_vpdpbusds_v16si_mask", IX86_BUILTIN_VPDPBUSDSV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpbusds_v16si_maskz, "__builtin_ia32_vpdpbusds_v16si_maskz", IX86_BUILTIN_VPDPBUSDSV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpbusds_v8si, "__builtin_ia32_vpdpbusds_v8si", IX86_BUILTIN_VPDPBUSDSV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v8si_mask, "__builtin_ia32_vpdpbusds_v8si_mask", IX86_BUILTIN_VPDPBUSDSV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v8si_maskz, "__builtin_ia32_vpdpbusds_v8si_maskz", IX86_BUILTIN_VPDPBUSDSV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
--- 2737,2745 ----
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v4si_mask, "__builtin_ia32_vpdpbusd_v4si_mask", IX86_BUILTIN_VPDPBUSDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusd_v4si_maskz, "__builtin_ia32_vpdpbusd_v4si_maskz", IX86_BUILTIN_VPDPBUSDV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpbusds_v16si, "__builtin_ia32_vpdpbusds_v16si", IX86_BUILTIN_VPDPBUSDSV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpbusds_v16si_mask, "__builtin_ia32_vpdpbusds_v16si_mask", IX86_BUILTIN_VPDPBUSDSV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpbusds_v16si_maskz, "__builtin_ia32_vpdpbusds_v16si_maskz", IX86_BUILTIN_VPDPBUSDSV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpbusds_v8si, "__builtin_ia32_vpdpbusds_v8si", IX86_BUILTIN_VPDPBUSDSV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v8si_mask, "__builtin_ia32_vpdpbusds_v8si_mask", IX86_BUILTIN_VPDPBUSDSV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v8si_maskz, "__builtin_ia32_vpdpbusds_v8si_maskz", IX86_BUILTIN_VPDPBUSDSV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
*************** BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTI
*** 2747,2755 ****
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v4si_mask, "__builtin_ia32_vpdpbusds_v4si_mask", IX86_BUILTIN_VPDPBUSDSV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v4si_maskz, "__builtin_ia32_vpdpbusds_v4si_maskz", IX86_BUILTIN_VPDPBUSDSV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpwssd_v16si, "__builtin_ia32_vpdpwssd_v16si", IX86_BUILTIN_VPDPWSSDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpwssd_v16si_mask, "__builtin_ia32_vpdpwssd_v16si_mask", IX86_BUILTIN_VPDPWSSDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpwssd_v16si_maskz, "__builtin_ia32_vpdpwssd_v16si_maskz", IX86_BUILTIN_VPDPWSSDV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpwssd_v8si, "__builtin_ia32_vpdpwssd_v8si", IX86_BUILTIN_VPDPWSSDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v8si_mask, "__builtin_ia32_vpdpwssd_v8si_mask", IX86_BUILTIN_VPDPWSSDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v8si_maskz, "__builtin_ia32_vpdpwssd_v8si_maskz", IX86_BUILTIN_VPDPWSSDV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
--- 2747,2755 ----
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v4si_mask, "__builtin_ia32_vpdpbusds_v4si_mask", IX86_BUILTIN_VPDPBUSDSV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpbusds_v4si_maskz, "__builtin_ia32_vpdpbusds_v4si_maskz", IX86_BUILTIN_VPDPBUSDSV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpwssd_v16si, "__builtin_ia32_vpdpwssd_v16si", IX86_BUILTIN_VPDPWSSDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpwssd_v16si_mask, "__builtin_ia32_vpdpwssd_v16si_mask", IX86_BUILTIN_VPDPWSSDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpwssd_v16si_maskz, "__builtin_ia32_vpdpwssd_v16si_maskz", IX86_BUILTIN_VPDPWSSDV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpwssd_v8si, "__builtin_ia32_vpdpwssd_v8si", IX86_BUILTIN_VPDPWSSDV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v8si_mask, "__builtin_ia32_vpdpwssd_v8si_mask", IX86_BUILTIN_VPDPWSSDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v8si_maskz, "__builtin_ia32_vpdpwssd_v8si_maskz", IX86_BUILTIN_VPDPWSSDV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
*************** BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTI
*** 2757,2765 ****
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v4si_mask, "__builtin_ia32_vpdpwssd_v4si_mask", IX86_BUILTIN_VPDPWSSDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v4si_maskz, "__builtin_ia32_vpdpwssd_v4si_maskz", IX86_BUILTIN_VPDPWSSDV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpwssds_v16si, "__builtin_ia32_vpdpwssds_v16si", IX86_BUILTIN_VPDPWSSDSV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpwssds_v16si_mask, "__builtin_ia32_vpdpwssds_v16si_mask", IX86_BUILTIN_VPDPWSSDSV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpdpwssds_v16si_maskz, "__builtin_ia32_vpdpwssds_v16si_maskz", IX86_BUILTIN_VPDPWSSDSV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpwssds_v8si, "__builtin_ia32_vpdpwssds_v8si", IX86_BUILTIN_VPDPWSSDSV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssds_v8si_mask, "__builtin_ia32_vpdpwssds_v8si_mask", IX86_BUILTIN_VPDPWSSDSV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssds_v8si_maskz, "__builtin_ia32_vpdpwssds_v8si_maskz", IX86_BUILTIN_VPDPWSSDSV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
--- 2757,2765 ----
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v4si_mask, "__builtin_ia32_vpdpwssd_v4si_mask", IX86_BUILTIN_VPDPWSSDV4SI_MASK, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssd_v4si_maskz, "__builtin_ia32_vpdpwssd_v4si_maskz", IX86_BUILTIN_VPDPWSSDV4SI_MASKZ, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI_V4SI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpwssds_v16si, "__builtin_ia32_vpdpwssds_v16si", IX86_BUILTIN_VPDPWSSDSV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpwssds_v16si_mask, "__builtin_ia32_vpdpwssds_v16si_mask", IX86_BUILTIN_VPDPWSSDSV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VNNI, 0, CODE_FOR_vpdpwssds_v16si_maskz, "__builtin_ia32_vpdpwssds_v16si_maskz", IX86_BUILTIN_VPDPWSSDSV16SI_MASKZ, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_V16SI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXVNNI, CODE_FOR_vpdpwssds_v8si, "__builtin_ia32_vpdpwssds_v8si", IX86_BUILTIN_VPDPWSSDSV8SI, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssds_v8si_mask, "__builtin_ia32_vpdpwssds_v8si_mask", IX86_BUILTIN_VPDPWSSDSV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpdpwssds_v8si_maskz, "__builtin_ia32_vpdpwssds_v8si_maskz", IX86_BUILTIN_VPDPWSSDSV8SI_MASKZ, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_V8SI_UQI)
*************** BDESC (0, OPTION_MASK_ISA2_AVXVNNIINT16
*** 2798,2810 ****
  /* VPCLMULQDQ */
  BDESC (OPTION_MASK_ISA_VPCLMULQDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpclmulqdq_v2di, "__builtin_ia32_vpclmulqdq_v2di", IX86_BUILTIN_VPCLMULQDQ2, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT)
  BDESC (OPTION_MASK_ISA_VPCLMULQDQ | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vpclmulqdq_v4di, "__builtin_ia32_vpclmulqdq_v4di", IX86_BUILTIN_VPCLMULQDQ4, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT)
! BDESC (OPTION_MASK_ISA_VPCLMULQDQ | OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpclmulqdq_v8di, "__builtin_ia32_vpclmulqdq_v8di", IX86_BUILTIN_VPCLMULQDQ8, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT)
  
  /* VPOPCNTDQ */
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv16si, "__builtin_ia32_vpopcountd_v16si", IX86_BUILTIN_VPOPCOUNTDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv16si_mask, "__builtin_ia32_vpopcountd_v16si_mask", IX86_BUILTIN_VPOPCOUNTDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv8di, "__builtin_ia32_vpopcountq_v8di", IX86_BUILTIN_VPOPCOUNTQV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv8di_mask, "__builtin_ia32_vpopcountq_v8di_mask", IX86_BUILTIN_VPOPCOUNTQV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
  
  BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv4di, "__builtin_ia32_vpopcountq_v4di", IX86_BUILTIN_VPOPCOUNTQV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv4di_mask, "__builtin_ia32_vpopcountq_v4di_mask", IX86_BUILTIN_VPOPCOUNTQV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_UQI)
--- 2798,2810 ----
  /* VPCLMULQDQ */
  BDESC (OPTION_MASK_ISA_VPCLMULQDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpclmulqdq_v2di, "__builtin_ia32_vpclmulqdq_v2di", IX86_BUILTIN_VPCLMULQDQ2, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT)
  BDESC (OPTION_MASK_ISA_VPCLMULQDQ | OPTION_MASK_ISA_AVX, 0, CODE_FOR_vpclmulqdq_v4di, "__builtin_ia32_vpclmulqdq_v4di", IX86_BUILTIN_VPCLMULQDQ4, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_INT)
! BDESC (OPTION_MASK_ISA_VPCLMULQDQ | OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_vpclmulqdq_v8di, "__builtin_ia32_vpclmulqdq_v8di", IX86_BUILTIN_VPCLMULQDQ8, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_INT)
  
  /* VPOPCNTDQ */
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, 0, CODE_FOR_vpopcountv16si, "__builtin_ia32_vpopcountd_v16si", IX86_BUILTIN_VPOPCOUNTDV16SI, UNKNOWN, (int) V16SI_FTYPE_V16SI)
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, 0, CODE_FOR_vpopcountv16si_mask, "__builtin_ia32_vpopcountd_v16si_mask", IX86_BUILTIN_VPOPCOUNTDV16SI_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SI_V16SI_UHI)
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, 0, CODE_FOR_vpopcountv8di, "__builtin_ia32_vpopcountq_v8di", IX86_BUILTIN_VPOPCOUNTQV8DI, UNKNOWN, (int) V8DI_FTYPE_V8DI)
! BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ, 0, CODE_FOR_vpopcountv8di_mask, "__builtin_ia32_vpopcountq_v8di_mask", IX86_BUILTIN_VPOPCOUNTQV8DI_MASK, UNKNOWN, (int) V8DI_FTYPE_V8DI_V8DI_UQI)
  
  BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv4di, "__builtin_ia32_vpopcountq_v4di", IX86_BUILTIN_VPOPCOUNTQV4DI, UNKNOWN, (int) V4DI_FTYPE_V4DI)
  BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv4di_mask, "__builtin_ia32_vpopcountq_v4di_mask", IX86_BUILTIN_VPOPCOUNTQV4DI_MASK, UNKNOWN, (int) V4DI_FTYPE_V4DI_V4DI_UQI)
*************** BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ |
*** 2816,2836 ****
  BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv8si_mask, "__builtin_ia32_vpopcountd_v8si_mask", IX86_BUILTIN_VPOPCOUNTDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_UHI)
  
  /* BITALG */
! BDESC (OPTION_MASK_ISA_AVX512BITALG, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv64qi, "__builtin_ia32_vpopcountb_v64qi", IX86_BUILTIN_VPOPCOUNTBV64QI, UNKNOWN, (int) V64QI_FTYPE_V64QI)
! BDESC (OPTION_MASK_ISA_AVX512BITALG, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv64qi_mask, "__builtin_ia32_vpopcountb_v64qi_mask", IX86_BUILTIN_VPOPCOUNTBV64QI_MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv32qi, "__builtin_ia32_vpopcountb_v32qi", IX86_BUILTIN_VPOPCOUNTBV32QI, UNKNOWN, (int) V32QI_FTYPE_V32QI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv32qi_mask, "__builtin_ia32_vpopcountb_v32qi_mask", IX86_BUILTIN_VPOPCOUNTBV32QI_MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16qi, "__builtin_ia32_vpopcountb_v16qi", IX86_BUILTIN_VPOPCOUNTBV16QI, UNKNOWN, (int) V16QI_FTYPE_V16QI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16qi_mask, "__builtin_ia32_vpopcountb_v16qi_mask", IX86_BUILTIN_VPOPCOUNTBV16QI_MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_UHI)
  
! BDESC (OPTION_MASK_ISA_AVX512BITALG, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv32hi, "__builtin_ia32_vpopcountw_v32hi", IX86_BUILTIN_VPOPCOUNTWV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512BITALG, OPTION_MASK_ISA2_EVEX512, CODE_FOR_vpopcountv32hi_mask, "__builtin_ia32_vpopcountw_v32hi_mask", IX86_BUILTIN_VPOPCOUNTQV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16hi, "__builtin_ia32_vpopcountw_v16hi", IX86_BUILTIN_VPOPCOUNTWV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16hi_mask, "__builtin_ia32_vpopcountw_v16hi_mask", IX86_BUILTIN_VPOPCOUNTQV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv8hi, "__builtin_ia32_vpopcountw_v8hi", IX86_BUILTIN_VPOPCOUNTWV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv8hi_mask, "__builtin_ia32_vpopcountw_v8hi_mask", IX86_BUILTIN_VPOPCOUNTQV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512BITALG, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512vl_vpshufbitqmbv64qi_mask, "__builtin_ia32_vpshufbitqmb512_mask", IX86_BUILTIN_VPSHUFBITQMB512_MASK, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpshufbitqmbv32qi_mask, "__builtin_ia32_vpshufbitqmb256_mask", IX86_BUILTIN_VPSHUFBITQMB256_MASK, UNKNOWN, (int) USI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpshufbitqmbv16qi_mask, "__builtin_ia32_vpshufbitqmb128_mask", IX86_BUILTIN_VPSHUFBITQMB128_MASK, UNKNOWN, (int) UHI_FTYPE_V16QI_V16QI_UHI)
  
--- 2816,2836 ----
  BDESC (OPTION_MASK_ISA_AVX512VPOPCNTDQ | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv8si_mask, "__builtin_ia32_vpopcountd_v8si_mask", IX86_BUILTIN_VPOPCOUNTDV8SI_MASK, UNKNOWN, (int) V8SI_FTYPE_V8SI_V8SI_UHI)
  
  /* BITALG */
! BDESC (OPTION_MASK_ISA_AVX512BITALG, 0, CODE_FOR_vpopcountv64qi, "__builtin_ia32_vpopcountb_v64qi", IX86_BUILTIN_VPOPCOUNTBV64QI, UNKNOWN, (int) V64QI_FTYPE_V64QI)
! BDESC (OPTION_MASK_ISA_AVX512BITALG, 0, CODE_FOR_vpopcountv64qi_mask, "__builtin_ia32_vpopcountb_v64qi_mask", IX86_BUILTIN_VPOPCOUNTBV64QI_MASK, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv32qi, "__builtin_ia32_vpopcountb_v32qi", IX86_BUILTIN_VPOPCOUNTBV32QI, UNKNOWN, (int) V32QI_FTYPE_V32QI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv32qi_mask, "__builtin_ia32_vpopcountb_v32qi_mask", IX86_BUILTIN_VPOPCOUNTBV32QI_MASK, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16qi, "__builtin_ia32_vpopcountb_v16qi", IX86_BUILTIN_VPOPCOUNTBV16QI, UNKNOWN, (int) V16QI_FTYPE_V16QI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16qi_mask, "__builtin_ia32_vpopcountb_v16qi_mask", IX86_BUILTIN_VPOPCOUNTBV16QI_MASK, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI_UHI)
  
! BDESC (OPTION_MASK_ISA_AVX512BITALG, 0, CODE_FOR_vpopcountv32hi, "__builtin_ia32_vpopcountw_v32hi", IX86_BUILTIN_VPOPCOUNTWV32HI, UNKNOWN, (int) V32HI_FTYPE_V32HI)
! BDESC (OPTION_MASK_ISA_AVX512BITALG, 0, CODE_FOR_vpopcountv32hi_mask, "__builtin_ia32_vpopcountw_v32hi_mask", IX86_BUILTIN_VPOPCOUNTQV32HI_MASK, UNKNOWN, (int) V32HI_FTYPE_V32HI_V32HI_USI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16hi, "__builtin_ia32_vpopcountw_v16hi", IX86_BUILTIN_VPOPCOUNTWV16HI, UNKNOWN, (int) V16HI_FTYPE_V16HI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv16hi_mask, "__builtin_ia32_vpopcountw_v16hi_mask", IX86_BUILTIN_VPOPCOUNTQV16HI_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_UHI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv8hi, "__builtin_ia32_vpopcountw_v8hi", IX86_BUILTIN_VPOPCOUNTWV8HI, UNKNOWN, (int) V8HI_FTYPE_V8HI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_vpopcountv8hi_mask, "__builtin_ia32_vpopcountw_v8hi_mask", IX86_BUILTIN_VPOPCOUNTQV8HI_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_UQI)
  
! BDESC (OPTION_MASK_ISA_AVX512BITALG, 0, CODE_FOR_avx512vl_vpshufbitqmbv64qi_mask, "__builtin_ia32_vpshufbitqmb512_mask", IX86_BUILTIN_VPSHUFBITQMB512_MASK, UNKNOWN, (int) UDI_FTYPE_V64QI_V64QI_UDI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpshufbitqmbv32qi_mask, "__builtin_ia32_vpshufbitqmb256_mask", IX86_BUILTIN_VPSHUFBITQMB256_MASK, UNKNOWN, (int) USI_FTYPE_V32QI_V32QI_USI)
  BDESC (OPTION_MASK_ISA_AVX512BITALG | OPTION_MASK_ISA_AVX512VL, 0, CODE_FOR_avx512vl_vpshufbitqmbv16qi_mask, "__builtin_ia32_vpshufbitqmb128_mask", IX86_BUILTIN_VPSHUFBITQMB128_MASK, UNKNOWN, (int) UHI_FTYPE_V16QI_V16QI_UHI)
  
*************** BDESC (0, OPTION_MASK_ISA2_RDPID, CODE_F
*** 2840,2878 ****
  /* VAES.  */
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdec_v16qi, "__builtin_ia32_vaesdec_v16qi", IX86_BUILTIN_VAESDEC16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdec_v32qi, "__builtin_ia32_vaesdec_v32qi", IX86_BUILTIN_VAESDEC32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES | OPTION_MASK_ISA2_EVEX512, CODE_FOR_vaesdec_v64qi, "__builtin_ia32_vaesdec_v64qi", IX86_BUILTIN_VAESDEC64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdeclast_v16qi, "__builtin_ia32_vaesdeclast_v16qi", IX86_BUILTIN_VAESDECLAST16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdeclast_v32qi, "__builtin_ia32_vaesdeclast_v32qi", IX86_BUILTIN_VAESDECLAST32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES | OPTION_MASK_ISA2_EVEX512, CODE_FOR_vaesdeclast_v64qi, "__builtin_ia32_vaesdeclast_v64qi", IX86_BUILTIN_VAESDECLAST64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenc_v16qi, "__builtin_ia32_vaesenc_v16qi", IX86_BUILTIN_VAESENC16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenc_v32qi, "__builtin_ia32_vaesenc_v32qi", IX86_BUILTIN_VAESENC32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES | OPTION_MASK_ISA2_EVEX512, CODE_FOR_vaesenc_v64qi, "__builtin_ia32_vaesenc_v64qi", IX86_BUILTIN_VAESENC64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenclast_v16qi, "__builtin_ia32_vaesenclast_v16qi", IX86_BUILTIN_VAESENCLAST16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenclast_v32qi, "__builtin_ia32_vaesenclast_v32qi", IX86_BUILTIN_VAESENCLAST32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES | OPTION_MASK_ISA2_EVEX512, CODE_FOR_vaesenclast_v64qi, "__builtin_ia32_vaesenclast_v64qi", IX86_BUILTIN_VAESENCLAST64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  
  /* BF16 */
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtne2ps2bf16_v32bf, "__builtin_ia32_cvtne2ps2bf16_v32bf", IX86_BUILTIN_CVTNE2PS2BF16_V32BF, UNKNOWN, (int) V32BF_FTYPE_V16SF_V16SF)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtne2ps2bf16_v32bf_mask, "__builtin_ia32_cvtne2ps2bf16_v32bf_mask", IX86_BUILTIN_CVTNE2PS2BF16_V32BF_MASK, UNKNOWN, (int) V32BF_FTYPE_V16SF_V16SF_V32BF_USI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtne2ps2bf16_v32bf_maskz, "__builtin_ia32_cvtne2ps2bf16_v32bf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V32BF_MASKZ, UNKNOWN, (int) V32BF_FTYPE_V16SF_V16SF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v16bf, "__builtin_ia32_cvtne2ps2bf16_v16bf", IX86_BUILTIN_CVTNE2PS2BF16_V16BF, UNKNOWN, (int) V16BF_FTYPE_V8SF_V8SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v16bf_mask, "__builtin_ia32_cvtne2ps2bf16_v16bf_mask", IX86_BUILTIN_CVTNE2PS2BF16_V16BF_MASK, UNKNOWN, (int) V16BF_FTYPE_V8SF_V8SF_V16BF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v16bf_maskz, "__builtin_ia32_cvtne2ps2bf16_v16bf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V16BF_MASKZ, UNKNOWN, (int) V16BF_FTYPE_V8SF_V8SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v8bf, "__builtin_ia32_cvtne2ps2bf16_v8bf", IX86_BUILTIN_CVTNE2PS2BF16_V8BF, UNKNOWN, (int) V8BF_FTYPE_V4SF_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v8bf_mask, "__builtin_ia32_cvtne2ps2bf16_v8bf_mask", IX86_BUILTIN_CVTNE2PS2BF16_V8BF_MASK, UNKNOWN, (int) V8BF_FTYPE_V4SF_V4SF_V8BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v8bf_maskz, "__builtin_ia32_cvtne2ps2bf16_v8bf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V8BF_MASKZ, UNKNOWN, (int) V8BF_FTYPE_V4SF_V4SF_UQI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtneps2bf16_v16sf, "__builtin_ia32_cvtneps2bf16_v16sf", IX86_BUILTIN_CVTNEPS2BF16_V16SF, UNKNOWN, (int) V16BF_FTYPE_V16SF)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtneps2bf16_v16sf_mask, "__builtin_ia32_cvtneps2bf16_v16sf_mask", IX86_BUILTIN_CVTNEPS2BF16_V16SF_MASK, UNKNOWN, (int) V16BF_FTYPE_V16SF_V16BF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtneps2bf16_v16sf_maskz, "__builtin_ia32_cvtneps2bf16_v16sf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V16SF_MASKZ, UNKNOWN, (int) V16BF_FTYPE_V16SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXNECONVERT | OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_vcvtneps2bf16_v8sf, "__builtin_ia32_cvtneps2bf16_v8sf", IX86_BUILTIN_CVTNEPS2BF16_V8SF, UNKNOWN, (int) V8BF_FTYPE_V8SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v8sf_mask, "__builtin_ia32_cvtneps2bf16_v8sf_mask", IX86_BUILTIN_CVTNEPS2BF16_V8SF_MASK, UNKNOWN, (int) V8BF_FTYPE_V8SF_V8BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v8sf_maskz, "__builtin_ia32_cvtneps2bf16_v8sf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V8SF_MASKZ, UNKNOWN, (int) V8BF_FTYPE_V8SF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXNECONVERT | OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_vcvtneps2bf16_v4sf, "__builtin_ia32_cvtneps2bf16_v4sf", IX86_BUILTIN_CVTNEPS2BF16_V4SF, UNKNOWN, (int) V8BF_FTYPE_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v4sf_mask, "__builtin_ia32_cvtneps2bf16_v4sf_mask", IX86_BUILTIN_CVTNEPS2BF16_V4SF_MASK, UNKNOWN, (int) V8BF_FTYPE_V4SF_V8BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v4sf_maskz, "__builtin_ia32_cvtneps2bf16_v4sf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V4SF_MASKZ, UNKNOWN, (int) V8BF_FTYPE_V4SF_UQI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_dpbf16ps_v16sf, "__builtin_ia32_dpbf16ps_v16sf", IX86_BUILTIN_DPBF16PS_V16SF, UNKNOWN, (int) V16SF_FTYPE_V16SF_V32BF_V32BF)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_dpbf16ps_v16sf_mask, "__builtin_ia32_dpbf16ps_v16sf_mask", IX86_BUILTIN_DPBF16PS_V16SF_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V32BF_V32BF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_dpbf16ps_v16sf_maskz, "__builtin_ia32_dpbf16ps_v16sf_maskz", IX86_BUILTIN_DPBF16PS_V16SF_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V32BF_V32BF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v8sf, "__builtin_ia32_dpbf16ps_v8sf", IX86_BUILTIN_DPBF16PS_V8SF, UNKNOWN, (int) V8SF_FTYPE_V8SF_V16BF_V16BF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v8sf_mask, "__builtin_ia32_dpbf16ps_v8sf_mask", IX86_BUILTIN_DPBF16PS_V8SF_MASK, UNKNOWN, (int) V8SF_FTYPE_V8SF_V16BF_V16BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v8sf_maskz, "__builtin_ia32_dpbf16ps_v8sf_maskz", IX86_BUILTIN_DPBF16PS_V8SF_MASKZ, UNKNOWN, (int) V8SF_FTYPE_V8SF_V16BF_V16BF_UQI)
--- 2840,2878 ----
  /* VAES.  */
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdec_v16qi, "__builtin_ia32_vaesdec_v16qi", IX86_BUILTIN_VAESDEC16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdec_v32qi, "__builtin_ia32_vaesdec_v32qi", IX86_BUILTIN_VAESDEC32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdec_v64qi, "__builtin_ia32_vaesdec_v64qi", IX86_BUILTIN_VAESDEC64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdeclast_v16qi, "__builtin_ia32_vaesdeclast_v16qi", IX86_BUILTIN_VAESDECLAST16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdeclast_v32qi, "__builtin_ia32_vaesdeclast_v32qi", IX86_BUILTIN_VAESDECLAST32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesdeclast_v64qi, "__builtin_ia32_vaesdeclast_v64qi", IX86_BUILTIN_VAESDECLAST64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenc_v16qi, "__builtin_ia32_vaesenc_v16qi", IX86_BUILTIN_VAESENC16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenc_v32qi, "__builtin_ia32_vaesenc_v32qi", IX86_BUILTIN_VAESENC32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenc_v64qi, "__builtin_ia32_vaesenc_v64qi", IX86_BUILTIN_VAESENC64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenclast_v16qi, "__builtin_ia32_vaesenclast_v16qi", IX86_BUILTIN_VAESENCLAST16, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI)
  BDESC (OPTION_MASK_ISA_AVX, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenclast_v32qi, "__builtin_ia32_vaesenclast_v32qi", IX86_BUILTIN_VAESENCLAST32, UNKNOWN, (int) V32QI_FTYPE_V32QI_V32QI)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_VAES, CODE_FOR_vaesenclast_v64qi, "__builtin_ia32_vaesenclast_v64qi", IX86_BUILTIN_VAESENCLAST64, UNKNOWN, (int) V64QI_FTYPE_V64QI_V64QI)
  
  /* BF16 */
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v32bf, "__builtin_ia32_cvtne2ps2bf16_v32bf", IX86_BUILTIN_CVTNE2PS2BF16_V32BF, UNKNOWN, (int) V32BF_FTYPE_V16SF_V16SF)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v32bf_mask, "__builtin_ia32_cvtne2ps2bf16_v32bf_mask", IX86_BUILTIN_CVTNE2PS2BF16_V32BF_MASK, UNKNOWN, (int) V32BF_FTYPE_V16SF_V16SF_V32BF_USI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v32bf_maskz, "__builtin_ia32_cvtne2ps2bf16_v32bf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V32BF_MASKZ, UNKNOWN, (int) V32BF_FTYPE_V16SF_V16SF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v16bf, "__builtin_ia32_cvtne2ps2bf16_v16bf", IX86_BUILTIN_CVTNE2PS2BF16_V16BF, UNKNOWN, (int) V16BF_FTYPE_V8SF_V8SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v16bf_mask, "__builtin_ia32_cvtne2ps2bf16_v16bf_mask", IX86_BUILTIN_CVTNE2PS2BF16_V16BF_MASK, UNKNOWN, (int) V16BF_FTYPE_V8SF_V8SF_V16BF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v16bf_maskz, "__builtin_ia32_cvtne2ps2bf16_v16bf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V16BF_MASKZ, UNKNOWN, (int) V16BF_FTYPE_V8SF_V8SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v8bf, "__builtin_ia32_cvtne2ps2bf16_v8bf", IX86_BUILTIN_CVTNE2PS2BF16_V8BF, UNKNOWN, (int) V8BF_FTYPE_V4SF_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v8bf_mask, "__builtin_ia32_cvtne2ps2bf16_v8bf_mask", IX86_BUILTIN_CVTNE2PS2BF16_V8BF_MASK, UNKNOWN, (int) V8BF_FTYPE_V4SF_V4SF_V8BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtne2ps2bf16_v8bf_maskz, "__builtin_ia32_cvtne2ps2bf16_v8bf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V8BF_MASKZ, UNKNOWN, (int) V8BF_FTYPE_V4SF_V4SF_UQI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v16sf, "__builtin_ia32_cvtneps2bf16_v16sf", IX86_BUILTIN_CVTNEPS2BF16_V16SF, UNKNOWN, (int) V16BF_FTYPE_V16SF)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v16sf_mask, "__builtin_ia32_cvtneps2bf16_v16sf_mask", IX86_BUILTIN_CVTNEPS2BF16_V16SF_MASK, UNKNOWN, (int) V16BF_FTYPE_V16SF_V16BF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v16sf_maskz, "__builtin_ia32_cvtneps2bf16_v16sf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V16SF_MASKZ, UNKNOWN, (int) V16BF_FTYPE_V16SF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXNECONVERT | OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_vcvtneps2bf16_v8sf, "__builtin_ia32_cvtneps2bf16_v8sf", IX86_BUILTIN_CVTNEPS2BF16_V8SF, UNKNOWN, (int) V8BF_FTYPE_V8SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v8sf_mask, "__builtin_ia32_cvtneps2bf16_v8sf_mask", IX86_BUILTIN_CVTNEPS2BF16_V8SF_MASK, UNKNOWN, (int) V8BF_FTYPE_V8SF_V8BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v8sf_maskz, "__builtin_ia32_cvtneps2bf16_v8sf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V8SF_MASKZ, UNKNOWN, (int) V8BF_FTYPE_V8SF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVXNECONVERT | OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_vcvtneps2bf16_v4sf, "__builtin_ia32_cvtneps2bf16_v4sf", IX86_BUILTIN_CVTNEPS2BF16_V4SF, UNKNOWN, (int) V8BF_FTYPE_V4SF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v4sf_mask, "__builtin_ia32_cvtneps2bf16_v4sf_mask", IX86_BUILTIN_CVTNEPS2BF16_V4SF_MASK, UNKNOWN, (int) V8BF_FTYPE_V4SF_V8BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_cvtneps2bf16_v4sf_maskz, "__builtin_ia32_cvtneps2bf16_v4sf_maskz", IX86_BUILTIN_CVTNE2PS2BF16_V4SF_MASKZ, UNKNOWN, (int) V8BF_FTYPE_V4SF_UQI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v16sf, "__builtin_ia32_dpbf16ps_v16sf", IX86_BUILTIN_DPBF16PS_V16SF, UNKNOWN, (int) V16SF_FTYPE_V16SF_V32BF_V32BF)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v16sf_mask, "__builtin_ia32_dpbf16ps_v16sf_mask", IX86_BUILTIN_DPBF16PS_V16SF_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V32BF_V32BF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v16sf_maskz, "__builtin_ia32_dpbf16ps_v16sf_maskz", IX86_BUILTIN_DPBF16PS_V16SF_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V32BF_V32BF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v8sf, "__builtin_ia32_dpbf16ps_v8sf", IX86_BUILTIN_DPBF16PS_V8SF, UNKNOWN, (int) V8SF_FTYPE_V8SF_V16BF_V16BF)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v8sf_mask, "__builtin_ia32_dpbf16ps_v8sf_mask", IX86_BUILTIN_DPBF16PS_V8SF_MASK, UNKNOWN, (int) V8SF_FTYPE_V8SF_V16BF_V16BF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512BF16, CODE_FOR_avx512f_dpbf16ps_v8sf_maskz, "__builtin_ia32_dpbf16ps_v8sf_maskz", IX86_BUILTIN_DPBF16PS_V8SF_MASKZ, UNKNOWN, (int) V8SF_FTYPE_V8SF_V16BF_V16BF_UQI)
*************** BDESC (OPTION_MASK_ISA_SSE2, 0, CODE_FOR
*** 2885,2924 ****
  /* AVX512FP16.  */
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_addv8hf3_mask, "__builtin_ia32_addph128_mask", IX86_BUILTIN_ADDPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_addv16hf3_mask, "__builtin_ia32_addph256_mask", IX86_BUILTIN_ADDPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv32hf3_mask, "__builtin_ia32_addph512_mask", IX86_BUILTIN_ADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_subv8hf3_mask, "__builtin_ia32_subph128_mask", IX86_BUILTIN_SUBPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_subv16hf3_mask, "__builtin_ia32_subph256_mask", IX86_BUILTIN_SUBPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv32hf3_mask, "__builtin_ia32_subph512_mask", IX86_BUILTIN_SUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_mulv8hf3_mask, "__builtin_ia32_mulph128_mask", IX86_BUILTIN_MULPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_mulv16hf3_mask, "__builtin_ia32_mulph256_mask", IX86_BUILTIN_MULPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_mulv32hf3_mask, "__builtin_ia32_mulph512_mask", IX86_BUILTIN_MULPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_divv8hf3_mask, "__builtin_ia32_divph128_mask", IX86_BUILTIN_DIVPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_divv16hf3_mask, "__builtin_ia32_divph256_mask", IX86_BUILTIN_DIVPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_divv32hf3_mask, "__builtin_ia32_divph512_mask", IX86_BUILTIN_DIVPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmaddv8hf3_mask, "__builtin_ia32_addsh_mask", IX86_BUILTIN_ADDSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsubv8hf3_mask, "__builtin_ia32_subsh_mask", IX86_BUILTIN_SUBSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmmulv8hf3_mask, "__builtin_ia32_mulsh_mask", IX86_BUILTIN_MULSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmdivv8hf3_mask, "__builtin_ia32_divsh_mask", IX86_BUILTIN_DIVSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_smaxv8hf3_mask, "__builtin_ia32_maxph128_mask", IX86_BUILTIN_MAXPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_smaxv16hf3_mask, "__builtin_ia32_maxph256_mask", IX86_BUILTIN_MAXPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv32hf3_mask, "__builtin_ia32_maxph512_mask", IX86_BUILTIN_MAXPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_sminv8hf3_mask, "__builtin_ia32_minph128_mask", IX86_BUILTIN_MINPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_sminv16hf3_mask, "__builtin_ia32_minph256_mask", IX86_BUILTIN_MINPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv32hf3_mask, "__builtin_ia32_minph512_mask", IX86_BUILTIN_MINPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsmaxv8hf3_mask, "__builtin_ia32_maxsh_mask", IX86_BUILTIN_MAXSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsminv8hf3_mask, "__builtin_ia32_minsh_mask", IX86_BUILTIN_MINSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_cmpv8hf3_mask, "__builtin_ia32_cmpph128_mask", IX86_BUILTIN_CMPPH128_MASK, UNKNOWN, (int) UQI_FTYPE_V8HF_V8HF_INT_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_cmpv16hf3_mask, "__builtin_ia32_cmpph256_mask", IX86_BUILTIN_CMPPH256_MASK, UNKNOWN, (int) UHI_FTYPE_V16HF_V16HF_INT_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cmpv32hf3_mask, "__builtin_ia32_cmpph512_mask", IX86_BUILTIN_CMPPH512_MASK, UNKNOWN, (int) USI_FTYPE_V32HF_V32HF_INT_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_sqrtv8hf2_mask, "__builtin_ia32_sqrtph128_mask", IX86_BUILTIN_SQRTPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_sqrtv16hf2_mask, "__builtin_ia32_sqrtph256_mask", IX86_BUILTIN_SQRTPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rsqrtv8hf2_mask, "__builtin_ia32_rsqrtph128_mask", IX86_BUILTIN_RSQRTPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rsqrtv16hf2_mask, "__builtin_ia32_rsqrtph256_mask", IX86_BUILTIN_RSQRTPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_rsqrtv32hf2_mask, "__builtin_ia32_rsqrtph512_mask", IX86_BUILTIN_RSQRTPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmrsqrtv8hf2_mask, "__builtin_ia32_rsqrtsh_mask", IX86_BUILTIN_RSQRTSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rcpv8hf2_mask, "__builtin_ia32_rcpph128_mask", IX86_BUILTIN_RCPPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rcpv16hf2_mask, "__builtin_ia32_rcpph256_mask", IX86_BUILTIN_RCPPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_rcpv32hf2_mask, "__builtin_ia32_rcpph512_mask", IX86_BUILTIN_RCPPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmrcpv8hf2_mask, "__builtin_ia32_rcpsh_mask", IX86_BUILTIN_RCPSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_scalefv8hf_mask, "__builtin_ia32_scalefph128_mask", IX86_BUILTIN_SCALEFPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_scalefv16hf_mask, "__builtin_ia32_scalefph256_mask", IX86_BUILTIN_SCALEFPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
--- 2885,2924 ----
  /* AVX512FP16.  */
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_addv8hf3_mask, "__builtin_ia32_addph128_mask", IX86_BUILTIN_ADDPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_addv16hf3_mask, "__builtin_ia32_addph256_mask", IX86_BUILTIN_ADDPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_addv32hf3_mask, "__builtin_ia32_addph512_mask", IX86_BUILTIN_ADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_subv8hf3_mask, "__builtin_ia32_subph128_mask", IX86_BUILTIN_SUBPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_subv16hf3_mask, "__builtin_ia32_subph256_mask", IX86_BUILTIN_SUBPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_subv32hf3_mask, "__builtin_ia32_subph512_mask", IX86_BUILTIN_SUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_mulv8hf3_mask, "__builtin_ia32_mulph128_mask", IX86_BUILTIN_MULPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_mulv16hf3_mask, "__builtin_ia32_mulph256_mask", IX86_BUILTIN_MULPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_mulv32hf3_mask, "__builtin_ia32_mulph512_mask", IX86_BUILTIN_MULPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_divv8hf3_mask, "__builtin_ia32_divph128_mask", IX86_BUILTIN_DIVPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_divv16hf3_mask, "__builtin_ia32_divph256_mask", IX86_BUILTIN_DIVPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_divv32hf3_mask, "__builtin_ia32_divph512_mask", IX86_BUILTIN_DIVPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmaddv8hf3_mask, "__builtin_ia32_addsh_mask", IX86_BUILTIN_ADDSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsubv8hf3_mask, "__builtin_ia32_subsh_mask", IX86_BUILTIN_SUBSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmmulv8hf3_mask, "__builtin_ia32_mulsh_mask", IX86_BUILTIN_MULSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmdivv8hf3_mask, "__builtin_ia32_divsh_mask", IX86_BUILTIN_DIVSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_smaxv8hf3_mask, "__builtin_ia32_maxph128_mask", IX86_BUILTIN_MAXPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_smaxv16hf3_mask, "__builtin_ia32_maxph256_mask", IX86_BUILTIN_MAXPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_smaxv32hf3_mask, "__builtin_ia32_maxph512_mask", IX86_BUILTIN_MAXPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_sminv8hf3_mask, "__builtin_ia32_minph128_mask", IX86_BUILTIN_MINPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_sminv16hf3_mask, "__builtin_ia32_minph256_mask", IX86_BUILTIN_MINPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_sminv32hf3_mask, "__builtin_ia32_minph512_mask", IX86_BUILTIN_MINPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsmaxv8hf3_mask, "__builtin_ia32_maxsh_mask", IX86_BUILTIN_MAXSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsminv8hf3_mask, "__builtin_ia32_minsh_mask", IX86_BUILTIN_MINSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_cmpv8hf3_mask, "__builtin_ia32_cmpph128_mask", IX86_BUILTIN_CMPPH128_MASK, UNKNOWN, (int) UQI_FTYPE_V8HF_V8HF_INT_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_cmpv16hf3_mask, "__builtin_ia32_cmpph256_mask", IX86_BUILTIN_CMPPH256_MASK, UNKNOWN, (int) UHI_FTYPE_V16HF_V16HF_INT_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_cmpv32hf3_mask, "__builtin_ia32_cmpph512_mask", IX86_BUILTIN_CMPPH512_MASK, UNKNOWN, (int) USI_FTYPE_V32HF_V32HF_INT_USI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_sqrtv8hf2_mask, "__builtin_ia32_sqrtph128_mask", IX86_BUILTIN_SQRTPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_sqrtv16hf2_mask, "__builtin_ia32_sqrtph256_mask", IX86_BUILTIN_SQRTPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rsqrtv8hf2_mask, "__builtin_ia32_rsqrtph128_mask", IX86_BUILTIN_RSQRTPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rsqrtv16hf2_mask, "__builtin_ia32_rsqrtph256_mask", IX86_BUILTIN_RSQRTPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rsqrtv32hf2_mask, "__builtin_ia32_rsqrtph512_mask", IX86_BUILTIN_RSQRTPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmrsqrtv8hf2_mask, "__builtin_ia32_rsqrtsh_mask", IX86_BUILTIN_RSQRTSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rcpv8hf2_mask, "__builtin_ia32_rcpph128_mask", IX86_BUILTIN_RCPPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rcpv16hf2_mask, "__builtin_ia32_rcpph256_mask", IX86_BUILTIN_RCPPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_rcpv32hf2_mask, "__builtin_ia32_rcpph512_mask", IX86_BUILTIN_RCPPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmrcpv8hf2_mask, "__builtin_ia32_rcpsh_mask", IX86_BUILTIN_RCPSH_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_scalefv8hf_mask, "__builtin_ia32_scalefph128_mask", IX86_BUILTIN_SCALEFPH128_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_scalefv16hf_mask, "__builtin_ia32_scalefph256_mask", IX86_BUILTIN_SCALEFPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_V16HF_UHI)
*************** BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_
*** 2928,2934 ****
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_rndscalev16hf_mask, "__builtin_ia32_rndscaleph256_mask", IX86_BUILTIN_RNDSCALEPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_INT_V16HF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512dq_fpclassv16hf_mask, "__builtin_ia32_fpclassph256_mask", IX86_BUILTIN_FPCLASSPH256, UNKNOWN, (int) HI_FTYPE_V16HF_INT_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512dq_fpclassv8hf_mask, "__builtin_ia32_fpclassph128_mask", IX86_BUILTIN_FPCLASSPH128, UNKNOWN, (int) QI_FTYPE_V8HF_INT_UQI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_fpclassv32hf_mask, "__builtin_ia32_fpclassph512_mask", IX86_BUILTIN_FPCLASSPH512, UNKNOWN, (int) SI_FTYPE_V32HF_INT_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512dq_vmfpclassv8hf_mask, "__builtin_ia32_fpclasssh_mask", IX86_BUILTIN_FPCLASSSH_MASK, UNKNOWN, (int) QI_FTYPE_V8HF_INT_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_getexpv16hf_mask, "__builtin_ia32_getexpph256_mask", IX86_BUILTIN_GETEXPPH256, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_getexpv8hf_mask, "__builtin_ia32_getexpph128_mask", IX86_BUILTIN_GETEXPPH128, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
--- 2928,2934 ----
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_rndscalev16hf_mask, "__builtin_ia32_rndscaleph256_mask", IX86_BUILTIN_RNDSCALEPH256_MASK, UNKNOWN, (int) V16HF_FTYPE_V16HF_INT_V16HF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512dq_fpclassv16hf_mask, "__builtin_ia32_fpclassph256_mask", IX86_BUILTIN_FPCLASSPH256, UNKNOWN, (int) HI_FTYPE_V16HF_INT_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512dq_fpclassv8hf_mask, "__builtin_ia32_fpclassph128_mask", IX86_BUILTIN_FPCLASSPH128, UNKNOWN, (int) QI_FTYPE_V8HF_INT_UQI)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512dq_fpclassv32hf_mask, "__builtin_ia32_fpclassph512_mask", IX86_BUILTIN_FPCLASSPH512, UNKNOWN, (int) SI_FTYPE_V32HF_INT_USI)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512dq_vmfpclassv8hf_mask, "__builtin_ia32_fpclasssh_mask", IX86_BUILTIN_FPCLASSSH_MASK, UNKNOWN, (int) QI_FTYPE_V8HF_INT_UQI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512vl_getexpv16hf_mask, "__builtin_ia32_getexpph256_mask", IX86_BUILTIN_GETEXPPH256, UNKNOWN, (int) V16HF_FTYPE_V16HF_V16HF_UHI)
  BDESC (OPTION_MASK_ISA_AVX512VL, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_getexpv8hf_mask, "__builtin_ia32_getexpph128_mask", IX86_BUILTIN_GETEXPPH128, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_UQI)
*************** BDESC_END (ARGS, ROUND_ARGS)
*** 3366,3391 ****
  
  /* AVX512F.  */
  BDESC_FIRST (round_args, ROUND_ARGS,
!        OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv8df3_mask_round, "__builtin_ia32_addpd512_mask", IX86_BUILTIN_ADDPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv16sf3_mask_round, "__builtin_ia32_addps512_mask", IX86_BUILTIN_ADDPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmaddv2df3_round, "__builtin_ia32_addsd_round", IX86_BUILTIN_ADDSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmaddv2df3_mask_round, "__builtin_ia32_addsd_mask_round", IX86_BUILTIN_ADDSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmaddv4sf3_round, "__builtin_ia32_addss_round", IX86_BUILTIN_ADDSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmaddv4sf3_mask_round, "__builtin_ia32_addss_mask_round", IX86_BUILTIN_ADDSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cmpv8df3_mask_round, "__builtin_ia32_cmppd512_mask", IX86_BUILTIN_CMPPD512, UNKNOWN, (int) UQI_FTYPE_V8DF_V8DF_INT_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cmpv16sf3_mask_round, "__builtin_ia32_cmpps512_mask", IX86_BUILTIN_CMPPS512, UNKNOWN, (int) UHI_FTYPE_V16SF_V16SF_INT_UHI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmcmpv2df3_mask_round, "__builtin_ia32_cmpsd_mask", IX86_BUILTIN_CMPSD_MASK, UNKNOWN, (int) UQI_FTYPE_V2DF_V2DF_INT_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmcmpv4sf3_mask_round, "__builtin_ia32_cmpss_mask", IX86_BUILTIN_CMPSS_MASK, UNKNOWN, (int) UQI_FTYPE_V4SF_V4SF_INT_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_comi_round, "__builtin_ia32_vcomisd", IX86_BUILTIN_COMIDF, UNKNOWN, (int) INT_FTYPE_V2DF_V2DF_INT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_comi_round, "__builtin_ia32_vcomiss", IX86_BUILTIN_COMISF, UNKNOWN, (int) INT_FTYPE_V4SF_V4SF_INT_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatv16siv16sf2_mask_round, "__builtin_ia32_cvtdq2ps512_mask", IX86_BUILTIN_CVTDQ2PS512, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtpd2dq512_mask_round, "__builtin_ia32_cvtpd2dq512_mask", IX86_BUILTIN_CVTPD2DQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtpd2ps512_mask_round,  "__builtin_ia32_cvtpd2ps512_mask", IX86_BUILTIN_CVTPD2PS512, UNKNOWN, (int) V8SF_FTYPE_V8DF_V8SF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_fixuns_notruncv8dfv8si2_mask_round, "__builtin_ia32_cvtpd2udq512_mask", IX86_BUILTIN_CVTPD2UDQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_vcvtph2ps512_mask_round,  "__builtin_ia32_vcvtph2ps512_mask", IX86_BUILTIN_CVTPH2PS512, UNKNOWN, (int) V16SF_FTYPE_V16HI_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fix_notruncv16sfv16si_mask_round, "__builtin_ia32_cvtps2dq512_mask", IX86_BUILTIN_CVTPS2DQ512_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_cvtps2pd512_mask_round, "__builtin_ia32_cvtps2pd512_mask", IX86_BUILTIN_CVTPS2PD512, UNKNOWN, (int) V8DF_FTYPE_V8SF_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fixuns_notruncv16sfv16si_mask_round, "__builtin_ia32_cvtps2udq512_mask", IX86_BUILTIN_CVTPS2UDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtsd2ss_round, "__builtin_ia32_cvtsd2ss_round", IX86_BUILTIN_CVTSD2SS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtsd2ss_mask_round, "__builtin_ia32_cvtsd2ss_mask_round", IX86_BUILTIN_CVTSD2SS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V2DF_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_sse2_cvtsi2sdq_round, "__builtin_ia32_cvtsi2sd64", IX86_BUILTIN_CVTSI2SD64, UNKNOWN, (int) V2DF_FTYPE_V2DF_INT64_INT)
--- 3366,3391 ----
  
  /* AVX512F.  */
  BDESC_FIRST (round_args, ROUND_ARGS,
!        OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_addv8df3_mask_round, "__builtin_ia32_addpd512_mask", IX86_BUILTIN_ADDPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_addv16sf3_mask_round, "__builtin_ia32_addps512_mask", IX86_BUILTIN_ADDPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmaddv2df3_round, "__builtin_ia32_addsd_round", IX86_BUILTIN_ADDSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmaddv2df3_mask_round, "__builtin_ia32_addsd_mask_round", IX86_BUILTIN_ADDSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmaddv4sf3_round, "__builtin_ia32_addss_round", IX86_BUILTIN_ADDSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmaddv4sf3_mask_round, "__builtin_ia32_addss_mask_round", IX86_BUILTIN_ADDSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_cmpv8df3_mask_round, "__builtin_ia32_cmppd512_mask", IX86_BUILTIN_CMPPD512, UNKNOWN, (int) UQI_FTYPE_V8DF_V8DF_INT_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_cmpv16sf3_mask_round, "__builtin_ia32_cmpps512_mask", IX86_BUILTIN_CMPPS512, UNKNOWN, (int) UHI_FTYPE_V16SF_V16SF_INT_UHI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmcmpv2df3_mask_round, "__builtin_ia32_cmpsd_mask", IX86_BUILTIN_CMPSD_MASK, UNKNOWN, (int) UQI_FTYPE_V2DF_V2DF_INT_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmcmpv4sf3_mask_round, "__builtin_ia32_cmpss_mask", IX86_BUILTIN_CMPSS_MASK, UNKNOWN, (int) UQI_FTYPE_V4SF_V4SF_INT_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_comi_round, "__builtin_ia32_vcomisd", IX86_BUILTIN_COMIDF, UNKNOWN, (int) INT_FTYPE_V2DF_V2DF_INT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_comi_round, "__builtin_ia32_vcomiss", IX86_BUILTIN_COMISF, UNKNOWN, (int) INT_FTYPE_V4SF_V4SF_INT_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_floatv16siv16sf2_mask_round, "__builtin_ia32_cvtdq2ps512_mask", IX86_BUILTIN_CVTDQ2PS512, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_cvtpd2dq512_mask_round, "__builtin_ia32_cvtpd2dq512_mask", IX86_BUILTIN_CVTPD2DQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_cvtpd2ps512_mask_round,  "__builtin_ia32_cvtpd2ps512_mask", IX86_BUILTIN_CVTPD2PS512, UNKNOWN, (int) V8SF_FTYPE_V8DF_V8SF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_fixuns_notruncv8dfv8si2_mask_round, "__builtin_ia32_cvtpd2udq512_mask", IX86_BUILTIN_CVTPD2UDQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vcvtph2ps512_mask_round,  "__builtin_ia32_vcvtph2ps512_mask", IX86_BUILTIN_CVTPH2PS512, UNKNOWN, (int) V16SF_FTYPE_V16HI_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fix_notruncv16sfv16si_mask_round, "__builtin_ia32_cvtps2dq512_mask", IX86_BUILTIN_CVTPS2DQ512_MASK, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_cvtps2pd512_mask_round, "__builtin_ia32_cvtps2pd512_mask", IX86_BUILTIN_CVTPS2PD512, UNKNOWN, (int) V8DF_FTYPE_V8SF_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fixuns_notruncv16sfv16si_mask_round, "__builtin_ia32_cvtps2udq512_mask", IX86_BUILTIN_CVTPS2UDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtsd2ss_round, "__builtin_ia32_cvtsd2ss_round", IX86_BUILTIN_CVTSD2SS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtsd2ss_mask_round, "__builtin_ia32_cvtsd2ss_mask_round", IX86_BUILTIN_CVTSD2SS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V2DF_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_sse2_cvtsi2sdq_round, "__builtin_ia32_cvtsi2sd64", IX86_BUILTIN_CVTSI2SD64, UNKNOWN, (int) V2DF_FTYPE_V2DF_INT64_INT)
*************** BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_
*** 3393,3464 ****
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_sse_cvtsi2ssq_round, "__builtin_ia32_cvtsi2ss64", IX86_BUILTIN_CVTSI2SS64, UNKNOWN, (int) V4SF_FTYPE_V4SF_INT64_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtss2sd_round, "__builtin_ia32_cvtss2sd_round", IX86_BUILTIN_CVTSS2SD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtss2sd_mask_round, "__builtin_ia32_cvtss2sd_mask_round", IX86_BUILTIN_CVTSS2SD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V4SF_V2DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fix_truncv8dfv8si2_mask_round, "__builtin_ia32_cvttpd2dq512_mask", IX86_BUILTIN_CVTTPD2DQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fixuns_truncv8dfv8si2_mask_round, "__builtin_ia32_cvttpd2udq512_mask", IX86_BUILTIN_CVTTPD2UDQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fix_truncv16sfv16si2_mask_round, "__builtin_ia32_cvttps2dq512_mask", IX86_BUILTIN_CVTTPS2DQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fixuns_truncv16sfv16si2_mask_round, "__builtin_ia32_cvttps2udq512_mask", IX86_BUILTIN_CVTTPS2UDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatunsv16siv16sf2_mask_round, "__builtin_ia32_cvtudq2ps512_mask", IX86_BUILTIN_CVTUDQ2PS512, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_cvtusi2sd64_round, "__builtin_ia32_cvtusi2sd64", IX86_BUILTIN_CVTUSI2SD64, UNKNOWN, (int) V2DF_FTYPE_V2DF_UINT64_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_cvtusi2ss32_round, "__builtin_ia32_cvtusi2ss32", IX86_BUILTIN_CVTUSI2SS32, UNKNOWN, (int) V4SF_FTYPE_V4SF_UINT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_cvtusi2ss64_round, "__builtin_ia32_cvtusi2ss64", IX86_BUILTIN_CVTUSI2SS64, UNKNOWN, (int) V4SF_FTYPE_V4SF_UINT64_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_divv8df3_mask_round, "__builtin_ia32_divpd512_mask", IX86_BUILTIN_DIVPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_divv16sf3_mask_round, "__builtin_ia32_divps512_mask", IX86_BUILTIN_DIVPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmdivv2df3_round, "__builtin_ia32_divsd_round", IX86_BUILTIN_DIVSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmdivv2df3_mask_round, "__builtin_ia32_divsd_mask_round", IX86_BUILTIN_DIVSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmdivv4sf3_round, "__builtin_ia32_divss_round", IX86_BUILTIN_DIVSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmdivv4sf3_mask_round, "__builtin_ia32_divss_mask_round", IX86_BUILTIN_DIVSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fixupimmv8df_mask_round, "__builtin_ia32_fixupimmpd512_mask", IX86_BUILTIN_FIXUPIMMPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DI_INT_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fixupimmv8df_maskz_round, "__builtin_ia32_fixupimmpd512_maskz", IX86_BUILTIN_FIXUPIMMPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DI_INT_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fixupimmv16sf_mask_round, "__builtin_ia32_fixupimmps512_mask", IX86_BUILTIN_FIXUPIMMPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SI_INT_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fixupimmv16sf_maskz_round, "__builtin_ia32_fixupimmps512_maskz", IX86_BUILTIN_FIXUPIMMPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SI_INT_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv2df_mask_round, "__builtin_ia32_fixupimmsd_mask", IX86_BUILTIN_FIXUPIMMSD128_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DI_INT_QI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv2df_maskz_round, "__builtin_ia32_fixupimmsd_maskz", IX86_BUILTIN_FIXUPIMMSD128_MASKZ, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DI_INT_QI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv4sf_mask_round, "__builtin_ia32_fixupimmss_mask", IX86_BUILTIN_FIXUPIMMSS128_MASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SI_INT_QI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv4sf_maskz_round, "__builtin_ia32_fixupimmss_maskz", IX86_BUILTIN_FIXUPIMMSS128_MASKZ, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SI_INT_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_getexpv8df_mask_round, "__builtin_ia32_getexppd512_mask", IX86_BUILTIN_GETEXPPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_getexpv16sf_mask_round, "__builtin_ia32_getexpps512_mask", IX86_BUILTIN_GETEXPPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv2df_round, "__builtin_ia32_getexpsd128_round", IX86_BUILTIN_GETEXPSD128, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv2df_mask_round, "__builtin_ia32_getexpsd_mask_round", IX86_BUILTIN_GETEXPSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv4sf_round, "__builtin_ia32_getexpss128_round", IX86_BUILTIN_GETEXPSS128, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv4sf_mask_round, "__builtin_ia32_getexpss_mask_round", IX86_BUILTIN_GETEXPSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_getmantv8df_mask_round, "__builtin_ia32_getmantpd512_mask", IX86_BUILTIN_GETMANTPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_getmantv16sf_mask_round, "__builtin_ia32_getmantps512_mask", IX86_BUILTIN_GETMANTPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv2df_round, "__builtin_ia32_getmantsd_round", IX86_BUILTIN_GETMANTSD128, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv2df_mask_round, "__builtin_ia32_getmantsd_mask_round", IX86_BUILTIN_GETMANTSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv4sf_round, "__builtin_ia32_getmantss_round", IX86_BUILTIN_GETMANTSS128, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv4sf_mask_round, "__builtin_ia32_getmantss_mask_round", IX86_BUILTIN_GETMANTSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv8df3_mask_round, "__builtin_ia32_maxpd512_mask", IX86_BUILTIN_MAXPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv16sf3_mask_round, "__builtin_ia32_maxps512_mask", IX86_BUILTIN_MAXPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsmaxv2df3_round, "__builtin_ia32_maxsd_round", IX86_BUILTIN_MAXSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsmaxv2df3_mask_round, "__builtin_ia32_maxsd_mask_round", IX86_BUILTIN_MAXSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsmaxv4sf3_round, "__builtin_ia32_maxss_round", IX86_BUILTIN_MAXSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsmaxv4sf3_mask_round, "__builtin_ia32_maxss_mask_round", IX86_BUILTIN_MAXSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv8df3_mask_round, "__builtin_ia32_minpd512_mask", IX86_BUILTIN_MINPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv16sf3_mask_round, "__builtin_ia32_minps512_mask", IX86_BUILTIN_MINPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsminv2df3_round, "__builtin_ia32_minsd_round", IX86_BUILTIN_MINSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsminv2df3_mask_round, "__builtin_ia32_minsd_mask_round", IX86_BUILTIN_MINSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsminv4sf3_round, "__builtin_ia32_minss_round", IX86_BUILTIN_MINSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsminv4sf3_mask_round, "__builtin_ia32_minss_mask_round", IX86_BUILTIN_MINSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_mulv8df3_mask_round, "__builtin_ia32_mulpd512_mask", IX86_BUILTIN_MULPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_mulv16sf3_mask_round, "__builtin_ia32_mulps512_mask", IX86_BUILTIN_MULPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmmulv2df3_round, "__builtin_ia32_mulsd_round", IX86_BUILTIN_MULSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmmulv2df3_mask_round, "__builtin_ia32_mulsd_mask_round", IX86_BUILTIN_MULSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmmulv4sf3_round, "__builtin_ia32_mulss_round", IX86_BUILTIN_MULSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmmulv4sf3_mask_round, "__builtin_ia32_mulss_mask_round", IX86_BUILTIN_MULSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rndscalev8df_mask_round, "__builtin_ia32_rndscalepd_mask", IX86_BUILTIN_RNDSCALEPD, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_rndscalev16sf_mask_round, "__builtin_ia32_rndscaleps_mask", IX86_BUILTIN_RNDSCALEPS, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rndscalev2df_mask_round, "__builtin_ia32_rndscalesd_mask_round", IX86_BUILTIN_RNDSCALESD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rndscalev4sf_mask_round, "__builtin_ia32_rndscaless_mask_round", IX86_BUILTIN_RNDSCALESS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_scalefv8df_mask_round, "__builtin_ia32_scalefpd512_mask", IX86_BUILTIN_SCALEFPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_scalefv16sf_mask_round, "__builtin_ia32_scalefps512_mask", IX86_BUILTIN_SCALEFPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmscalefv2df_mask_round, "__builtin_ia32_scalefsd_mask_round", IX86_BUILTIN_SCALEFSD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmscalefv4sf_mask_round, "__builtin_ia32_scalefss_mask_round", IX86_BUILTIN_SCALEFSS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sqrtv8df2_mask_round, "__builtin_ia32_sqrtpd512_mask", IX86_BUILTIN_SQRTPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_sqrtv16sf2_mask_round, "__builtin_ia32_sqrtps512_mask", IX86_BUILTIN_SQRTPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsqrtv2df2_mask_round, "__builtin_ia32_sqrtsd_mask_round", IX86_BUILTIN_SQRTSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsqrtv4sf2_mask_round, "__builtin_ia32_sqrtss_mask_round", IX86_BUILTIN_SQRTSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv8df3_mask_round, "__builtin_ia32_subpd512_mask", IX86_BUILTIN_SUBPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv16sf3_mask_round, "__builtin_ia32_subps512_mask", IX86_BUILTIN_SUBPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsubv2df3_round, "__builtin_ia32_subsd_round", IX86_BUILTIN_SUBSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsubv2df3_mask_round, "__builtin_ia32_subsd_mask_round", IX86_BUILTIN_SUBSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsubv4sf3_round, "__builtin_ia32_subss_round", IX86_BUILTIN_SUBSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
--- 3393,3464 ----
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_sse_cvtsi2ssq_round, "__builtin_ia32_cvtsi2ss64", IX86_BUILTIN_CVTSI2SS64, UNKNOWN, (int) V4SF_FTYPE_V4SF_INT64_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtss2sd_round, "__builtin_ia32_cvtss2sd_round", IX86_BUILTIN_CVTSS2SD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_cvtss2sd_mask_round, "__builtin_ia32_cvtss2sd_mask_round", IX86_BUILTIN_CVTSS2SD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V4SF_V2DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_unspec_fix_truncv8dfv8si2_mask_round, "__builtin_ia32_cvttpd2dq512_mask", IX86_BUILTIN_CVTTPD2DQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_unspec_fixuns_truncv8dfv8si2_mask_round, "__builtin_ia32_cvttpd2udq512_mask", IX86_BUILTIN_CVTTPD2UDQ512, UNKNOWN, (int) V8SI_FTYPE_V8DF_V8SI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_unspec_fix_truncv16sfv16si2_mask_round, "__builtin_ia32_cvttps2dq512_mask", IX86_BUILTIN_CVTTPS2DQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_unspec_fixuns_truncv16sfv16si2_mask_round, "__builtin_ia32_cvttps2udq512_mask", IX86_BUILTIN_CVTTPS2UDQ512, UNKNOWN, (int) V16SI_FTYPE_V16SF_V16SI_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_floatunsv16siv16sf2_mask_round, "__builtin_ia32_cvtudq2ps512_mask", IX86_BUILTIN_CVTUDQ2PS512, UNKNOWN, (int) V16SF_FTYPE_V16SI_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_cvtusi2sd64_round, "__builtin_ia32_cvtusi2sd64", IX86_BUILTIN_CVTUSI2SD64, UNKNOWN, (int) V2DF_FTYPE_V2DF_UINT64_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_cvtusi2ss32_round, "__builtin_ia32_cvtusi2ss32", IX86_BUILTIN_CVTUSI2SS32, UNKNOWN, (int) V4SF_FTYPE_V4SF_UINT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_cvtusi2ss64_round, "__builtin_ia32_cvtusi2ss64", IX86_BUILTIN_CVTUSI2SS64, UNKNOWN, (int) V4SF_FTYPE_V4SF_UINT64_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_divv8df3_mask_round, "__builtin_ia32_divpd512_mask", IX86_BUILTIN_DIVPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_divv16sf3_mask_round, "__builtin_ia32_divps512_mask", IX86_BUILTIN_DIVPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmdivv2df3_round, "__builtin_ia32_divsd_round", IX86_BUILTIN_DIVSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmdivv2df3_mask_round, "__builtin_ia32_divsd_mask_round", IX86_BUILTIN_DIVSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmdivv4sf3_round, "__builtin_ia32_divss_round", IX86_BUILTIN_DIVSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmdivv4sf3_mask_round, "__builtin_ia32_divss_mask_round", IX86_BUILTIN_DIVSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fixupimmv8df_mask_round, "__builtin_ia32_fixupimmpd512_mask", IX86_BUILTIN_FIXUPIMMPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DI_INT_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fixupimmv8df_maskz_round, "__builtin_ia32_fixupimmpd512_maskz", IX86_BUILTIN_FIXUPIMMPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DI_INT_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fixupimmv16sf_mask_round, "__builtin_ia32_fixupimmps512_mask", IX86_BUILTIN_FIXUPIMMPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SI_INT_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fixupimmv16sf_maskz_round, "__builtin_ia32_fixupimmps512_maskz", IX86_BUILTIN_FIXUPIMMPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SI_INT_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv2df_mask_round, "__builtin_ia32_fixupimmsd_mask", IX86_BUILTIN_FIXUPIMMSD128_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DI_INT_QI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv2df_maskz_round, "__builtin_ia32_fixupimmsd_maskz", IX86_BUILTIN_FIXUPIMMSD128_MASKZ, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DI_INT_QI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv4sf_mask_round, "__builtin_ia32_fixupimmss_mask", IX86_BUILTIN_FIXUPIMMSS128_MASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SI_INT_QI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sfixupimmv4sf_maskz_round, "__builtin_ia32_fixupimmss_maskz", IX86_BUILTIN_FIXUPIMMSS128_MASKZ, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SI_INT_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_getexpv8df_mask_round, "__builtin_ia32_getexppd512_mask", IX86_BUILTIN_GETEXPPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_getexpv16sf_mask_round, "__builtin_ia32_getexpps512_mask", IX86_BUILTIN_GETEXPPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv2df_round, "__builtin_ia32_getexpsd128_round", IX86_BUILTIN_GETEXPSD128, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv2df_mask_round, "__builtin_ia32_getexpsd_mask_round", IX86_BUILTIN_GETEXPSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv4sf_round, "__builtin_ia32_getexpss128_round", IX86_BUILTIN_GETEXPSS128, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sgetexpv4sf_mask_round, "__builtin_ia32_getexpss_mask_round", IX86_BUILTIN_GETEXPSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_getmantv8df_mask_round, "__builtin_ia32_getmantpd512_mask", IX86_BUILTIN_GETMANTPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_getmantv16sf_mask_round, "__builtin_ia32_getmantps512_mask", IX86_BUILTIN_GETMANTPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv2df_round, "__builtin_ia32_getmantsd_round", IX86_BUILTIN_GETMANTSD128, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv2df_mask_round, "__builtin_ia32_getmantsd_mask_round", IX86_BUILTIN_GETMANTSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv4sf_round, "__builtin_ia32_getmantss_round", IX86_BUILTIN_GETMANTSS128, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vgetmantv4sf_mask_round, "__builtin_ia32_getmantss_mask_round", IX86_BUILTIN_GETMANTSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_smaxv8df3_mask_round, "__builtin_ia32_maxpd512_mask", IX86_BUILTIN_MAXPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_smaxv16sf3_mask_round, "__builtin_ia32_maxps512_mask", IX86_BUILTIN_MAXPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsmaxv2df3_round, "__builtin_ia32_maxsd_round", IX86_BUILTIN_MAXSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsmaxv2df3_mask_round, "__builtin_ia32_maxsd_mask_round", IX86_BUILTIN_MAXSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsmaxv4sf3_round, "__builtin_ia32_maxss_round", IX86_BUILTIN_MAXSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsmaxv4sf3_mask_round, "__builtin_ia32_maxss_mask_round", IX86_BUILTIN_MAXSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sminv8df3_mask_round, "__builtin_ia32_minpd512_mask", IX86_BUILTIN_MINPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sminv16sf3_mask_round, "__builtin_ia32_minps512_mask", IX86_BUILTIN_MINPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsminv2df3_round, "__builtin_ia32_minsd_round", IX86_BUILTIN_MINSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsminv2df3_mask_round, "__builtin_ia32_minsd_mask_round", IX86_BUILTIN_MINSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsminv4sf3_round, "__builtin_ia32_minss_round", IX86_BUILTIN_MINSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsminv4sf3_mask_round, "__builtin_ia32_minss_mask_round", IX86_BUILTIN_MINSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_mulv8df3_mask_round, "__builtin_ia32_mulpd512_mask", IX86_BUILTIN_MULPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_mulv16sf3_mask_round, "__builtin_ia32_mulps512_mask", IX86_BUILTIN_MULPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmmulv2df3_round, "__builtin_ia32_mulsd_round", IX86_BUILTIN_MULSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmmulv2df3_mask_round, "__builtin_ia32_mulsd_mask_round", IX86_BUILTIN_MULSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmmulv4sf3_round, "__builtin_ia32_mulss_round", IX86_BUILTIN_MULSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmmulv4sf3_mask_round, "__builtin_ia32_mulss_mask_round", IX86_BUILTIN_MULSS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rndscalev8df_mask_round, "__builtin_ia32_rndscalepd_mask", IX86_BUILTIN_RNDSCALEPD, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rndscalev16sf_mask_round, "__builtin_ia32_rndscaleps_mask", IX86_BUILTIN_RNDSCALEPS, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rndscalev2df_mask_round, "__builtin_ia32_rndscalesd_mask_round", IX86_BUILTIN_RNDSCALESD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_rndscalev4sf_mask_round, "__builtin_ia32_rndscaless_mask_round", IX86_BUILTIN_RNDSCALESS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_scalefv8df_mask_round, "__builtin_ia32_scalefpd512_mask", IX86_BUILTIN_SCALEFPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_scalefv16sf_mask_round, "__builtin_ia32_scalefps512_mask", IX86_BUILTIN_SCALEFPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmscalefv2df_mask_round, "__builtin_ia32_scalefsd_mask_round", IX86_BUILTIN_SCALEFSD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmscalefv4sf_mask_round, "__builtin_ia32_scalefss_mask_round", IX86_BUILTIN_SCALEFSS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sqrtv8df2_mask_round, "__builtin_ia32_sqrtpd512_mask", IX86_BUILTIN_SQRTPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_sqrtv16sf2_mask_round, "__builtin_ia32_sqrtps512_mask", IX86_BUILTIN_SQRTPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsqrtv2df2_mask_round, "__builtin_ia32_sqrtsd_mask_round", IX86_BUILTIN_SQRTSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsqrtv4sf2_mask_round, "__builtin_ia32_sqrtss_mask_round", IX86_BUILTIN_SQRTSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_subv8df3_mask_round, "__builtin_ia32_subpd512_mask", IX86_BUILTIN_SUBPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_subv16sf3_mask_round, "__builtin_ia32_subps512_mask", IX86_BUILTIN_SUBPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsubv2df3_round, "__builtin_ia32_subsd_round", IX86_BUILTIN_SUBSD_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse2_vmsubv2df3_mask_round, "__builtin_ia32_subsd_mask_round", IX86_BUILTIN_SUBSD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_sse_vmsubv4sf3_round, "__builtin_ia32_subss_round", IX86_BUILTIN_SUBSS_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT)
*************** BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_
*** 3479,3490 ****
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_unspec_sse_cvttss2siq_round, "__builtin_ia32_vcvttss2si64", IX86_BUILTIN_VCVTTSS2SI64, UNKNOWN, (int) INT64_FTYPE_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_unspec_avx512f_vcvttss2usi_round, "__builtin_ia32_vcvttss2usi32", IX86_BUILTIN_VCVTTSS2USI32, UNKNOWN, (int) UINT_FTYPE_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_unspec_avx512f_vcvttss2usiq_round, "__builtin_ia32_vcvttss2usi64", IX86_BUILTIN_VCVTTSS2USI64, UNKNOWN, (int) UINT64_FTYPE_V4SF_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmadd_v8df_mask_round, "__builtin_ia32_vfmaddpd512_mask", IX86_BUILTIN_VFMADDPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmadd_v8df_mask3_round, "__builtin_ia32_vfmaddpd512_mask3", IX86_BUILTIN_VFMADDPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmadd_v8df_maskz_round, "__builtin_ia32_vfmaddpd512_maskz", IX86_BUILTIN_VFMADDPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmadd_v16sf_mask_round, "__builtin_ia32_vfmaddps512_mask", IX86_BUILTIN_VFMADDPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmadd_v16sf_mask3_round, "__builtin_ia32_vfmaddps512_mask3", IX86_BUILTIN_VFMADDPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmadd_v16sf_maskz_round, "__builtin_ia32_vfmaddps512_maskz", IX86_BUILTIN_VFMADDPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_fmai_vmfmadd_v2df_round, "__builtin_ia32_vfmaddsd3_round", IX86_BUILTIN_VFMADDSD3_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_fmai_vmfmadd_v4sf_round, "__builtin_ia32_vfmaddss3_round", IX86_BUILTIN_VFMADDSS3_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmadd_v2df_mask_round, "__builtin_ia32_vfmaddsd3_mask", IX86_BUILTIN_VFMADDSD3_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
--- 3479,3490 ----
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_unspec_sse_cvttss2siq_round, "__builtin_ia32_vcvttss2si64", IX86_BUILTIN_VCVTTSS2SI64, UNKNOWN, (int) INT64_FTYPE_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_unspec_avx512f_vcvttss2usi_round, "__builtin_ia32_vcvttss2usi32", IX86_BUILTIN_VCVTTSS2USI32, UNKNOWN, (int) UINT_FTYPE_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_64BIT, 0, CODE_FOR_unspec_avx512f_vcvttss2usiq_round, "__builtin_ia32_vcvttss2usi64", IX86_BUILTIN_VCVTTSS2USI64, UNKNOWN, (int) UINT64_FTYPE_V4SF_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmadd_v8df_mask_round, "__builtin_ia32_vfmaddpd512_mask", IX86_BUILTIN_VFMADDPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmadd_v8df_mask3_round, "__builtin_ia32_vfmaddpd512_mask3", IX86_BUILTIN_VFMADDPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmadd_v8df_maskz_round, "__builtin_ia32_vfmaddpd512_maskz", IX86_BUILTIN_VFMADDPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmadd_v16sf_mask_round, "__builtin_ia32_vfmaddps512_mask", IX86_BUILTIN_VFMADDPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmadd_v16sf_mask3_round, "__builtin_ia32_vfmaddps512_mask3", IX86_BUILTIN_VFMADDPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmadd_v16sf_maskz_round, "__builtin_ia32_vfmaddps512_maskz", IX86_BUILTIN_VFMADDPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_fmai_vmfmadd_v2df_round, "__builtin_ia32_vfmaddsd3_round", IX86_BUILTIN_VFMADDSD3_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_fmai_vmfmadd_v4sf_round, "__builtin_ia32_vfmaddss3_round", IX86_BUILTIN_VFMADDSS3_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmadd_v2df_mask_round, "__builtin_ia32_vfmaddsd3_mask", IX86_BUILTIN_VFMADDSD3_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_V2DF_UQI_INT)
*************** BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_
*** 3495,3594 ****
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmadd_v4sf_mask3_round, "__builtin_ia32_vfmaddss3_mask3", IX86_BUILTIN_VFMADDSS3_MASK3, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmadd_v4sf_maskz_round, "__builtin_ia32_vfmaddss3_maskz", IX86_BUILTIN_VFMADDSS3_MASKZ, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmsub_v4sf_mask3_round, "__builtin_ia32_vfmsubss3_mask3", IX86_BUILTIN_VFMSUBSS3_MASK3, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmaddsub_v8df_mask_round, "__builtin_ia32_vfmaddsubpd512_mask", IX86_BUILTIN_VFMADDSUBPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmaddsub_v8df_mask3_round, "__builtin_ia32_vfmaddsubpd512_mask3", IX86_BUILTIN_VFMADDSUBPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmaddsub_v8df_maskz_round, "__builtin_ia32_vfmaddsubpd512_maskz", IX86_BUILTIN_VFMADDSUBPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmaddsub_v16sf_mask_round, "__builtin_ia32_vfmaddsubps512_mask", IX86_BUILTIN_VFMADDSUBPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmaddsub_v16sf_mask3_round, "__builtin_ia32_vfmaddsubps512_mask3", IX86_BUILTIN_VFMADDSUBPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmaddsub_v16sf_maskz_round, "__builtin_ia32_vfmaddsubps512_maskz", IX86_BUILTIN_VFMADDSUBPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsubadd_v8df_mask3_round, "__builtin_ia32_vfmsubaddpd512_mask3", IX86_BUILTIN_VFMSUBADDPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsubadd_v16sf_mask3_round, "__builtin_ia32_vfmsubaddps512_mask3", IX86_BUILTIN_VFMSUBADDPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsub_v8df_mask_round, "__builtin_ia32_vfmsubpd512_mask", IX86_BUILTIN_VFMSUBPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsub_v8df_mask3_round, "__builtin_ia32_vfmsubpd512_mask3", IX86_BUILTIN_VFMSUBPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsub_v8df_maskz_round, "__builtin_ia32_vfmsubpd512_maskz", IX86_BUILTIN_VFMSUBPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsub_v16sf_mask_round, "__builtin_ia32_vfmsubps512_mask", IX86_BUILTIN_VFMSUBPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsub_v16sf_mask3_round, "__builtin_ia32_vfmsubps512_mask3", IX86_BUILTIN_VFMSUBPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fmsub_v16sf_maskz_round, "__builtin_ia32_vfmsubps512_maskz", IX86_BUILTIN_VFMSUBPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmadd_v8df_mask_round, "__builtin_ia32_vfnmaddpd512_mask", IX86_BUILTIN_VFNMADDPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmadd_v8df_mask3_round, "__builtin_ia32_vfnmaddpd512_mask3", IX86_BUILTIN_VFNMADDPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmadd_v8df_maskz_round, "__builtin_ia32_vfnmaddpd512_maskz", IX86_BUILTIN_VFNMADDPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmadd_v16sf_mask_round, "__builtin_ia32_vfnmaddps512_mask", IX86_BUILTIN_VFNMADDPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmadd_v16sf_mask3_round, "__builtin_ia32_vfnmaddps512_mask3", IX86_BUILTIN_VFNMADDPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmadd_v16sf_maskz_round, "__builtin_ia32_vfnmaddps512_maskz", IX86_BUILTIN_VFNMADDPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmsub_v8df_mask_round, "__builtin_ia32_vfnmsubpd512_mask", IX86_BUILTIN_VFNMSUBPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmsub_v8df_mask3_round, "__builtin_ia32_vfnmsubpd512_mask3", IX86_BUILTIN_VFNMSUBPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmsub_v8df_maskz_round, "__builtin_ia32_vfnmsubpd512_maskz", IX86_BUILTIN_VFNMSUBPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmsub_v16sf_mask_round, "__builtin_ia32_vfnmsubps512_mask", IX86_BUILTIN_VFNMSUBPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmsub_v16sf_mask3_round, "__builtin_ia32_vfnmsubps512_mask3", IX86_BUILTIN_VFNMSUBPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512f_fnmsub_v16sf_maskz_round, "__builtin_ia32_vfnmsubps512_maskz", IX86_BUILTIN_VFNMSUBPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  
  /* AVX512DQ.  */
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_reducepv8df_mask_round, "__builtin_ia32_reducepd512_mask_round", IX86_BUILTIN_REDUCEPD512_MASK_ROUND, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_reducepv16sf_mask_round, "__builtin_ia32_reduceps512_mask_round", IX86_BUILTIN_REDUCEPS512_MASK_ROUND, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_UHI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducesv2df_mask_round, "__builtin_ia32_reducesd_mask_round", IX86_BUILTIN_REDUCESD128_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducesv4sf_mask_round, "__builtin_ia32_reducess_mask_round", IX86_BUILTIN_REDUCESS128_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_rangesv2df_mask_round, "__builtin_ia32_rangesd128_mask_round", IX86_BUILTIN_RANGESD128, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_rangesv4sf_mask_round, "__builtin_ia32_rangess128_mask_round", IX86_BUILTIN_RANGESS128, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_fix_notruncv8dfv8di2_mask_round, "__builtin_ia32_cvtpd2qq512_mask", IX86_BUILTIN_CVTPD2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_cvtps2qqv8di_mask_round, "__builtin_ia32_cvtps2qq512_mask", IX86_BUILTIN_CVTPS2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_fixuns_notruncv8dfv8di2_mask_round, "__builtin_ia32_cvtpd2uqq512_mask", IX86_BUILTIN_CVTPD2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_cvtps2uqqv8di_mask_round, "__builtin_ia32_cvtps2uqq512_mask", IX86_BUILTIN_CVTPS2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatv8div8sf2_mask_round, "__builtin_ia32_cvtqq2ps512_mask", IX86_BUILTIN_CVTQQ2PS512, UNKNOWN, (int) V8SF_FTYPE_V8DI_V8SF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatunsv8div8sf2_mask_round, "__builtin_ia32_cvtuqq2ps512_mask", IX86_BUILTIN_CVTUQQ2PS512, UNKNOWN, (int) V8SF_FTYPE_V8DI_V8SF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatv8div8df2_mask_round, "__builtin_ia32_cvtqq2pd512_mask", IX86_BUILTIN_CVTQQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_floatunsv8div8df2_mask_round, "__builtin_ia32_cvtuqq2pd512_mask", IX86_BUILTIN_CVTUQQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fix_truncv8sfv8di2_mask_round, "__builtin_ia32_cvttps2qq512_mask", IX86_BUILTIN_CVTTPS2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fixuns_truncv8sfv8di2_mask_round, "__builtin_ia32_cvttps2uqq512_mask", IX86_BUILTIN_CVTTPS2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fix_truncv8dfv8di2_mask_round, "__builtin_ia32_cvttpd2qq512_mask", IX86_BUILTIN_CVTTPD2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_fixuns_truncv8dfv8di2_mask_round, "__builtin_ia32_cvttpd2uqq512_mask", IX86_BUILTIN_CVTTPD2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_rangepv16sf_mask_round, "__builtin_ia32_rangeps512_mask", IX86_BUILTIN_RANGEPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_INT_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512dq_rangepv8df_mask_round, "__builtin_ia32_rangepd512_mask", IX86_BUILTIN_RANGEPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_INT_V8DF_QI_INT)
  
  /* AVX512FP16.  */
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_addv32hf3_mask_round, "__builtin_ia32_addph512_mask_round", IX86_BUILTIN_ADDPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_subv32hf3_mask_round, "__builtin_ia32_subph512_mask_round", IX86_BUILTIN_SUBPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_mulv32hf3_mask_round, "__builtin_ia32_mulph512_mask_round", IX86_BUILTIN_MULPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_divv32hf3_mask_round, "__builtin_ia32_divph512_mask_round", IX86_BUILTIN_DIVPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmaddv8hf3_mask_round, "__builtin_ia32_addsh_mask_round", IX86_BUILTIN_ADDSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsubv8hf3_mask_round, "__builtin_ia32_subsh_mask_round", IX86_BUILTIN_SUBSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmmulv8hf3_mask_round, "__builtin_ia32_mulsh_mask_round", IX86_BUILTIN_MULSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmdivv8hf3_mask_round, "__builtin_ia32_divsh_mask_round", IX86_BUILTIN_DIVSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_smaxv32hf3_mask_round, "__builtin_ia32_maxph512_mask_round", IX86_BUILTIN_MAXPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_sminv32hf3_mask_round, "__builtin_ia32_minph512_mask_round", IX86_BUILTIN_MINPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsmaxv8hf3_mask_round, "__builtin_ia32_maxsh_mask_round", IX86_BUILTIN_MAXSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsminv8hf3_mask_round, "__builtin_ia32_minsh_mask_round", IX86_BUILTIN_MINSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_cmpv32hf3_mask_round, "__builtin_ia32_cmpph512_mask_round", IX86_BUILTIN_CMPPH512_MASK_ROUND, UNKNOWN, (int) USI_FTYPE_V32HF_V32HF_INT_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmcmpv8hf3_mask_round, "__builtin_ia32_cmpsh_mask_round", IX86_BUILTIN_CMPSH_MASK_ROUND, UNKNOWN, (int) UQI_FTYPE_V8HF_V8HF_INT_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_sqrtv32hf2_mask_round, "__builtin_ia32_sqrtph512_mask_round", IX86_BUILTIN_SQRTPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsqrtv8hf2_mask_round, "__builtin_ia32_sqrtsh_mask_round", IX86_BUILTIN_SQRTSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_scalefv32hf_mask_round, "__builtin_ia32_scalefph512_mask_round", IX86_BUILTIN_SCALEFPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmscalefv8hf_mask_round, "__builtin_ia32_scalefsh_mask_round", IX86_BUILTIN_SCALEFSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_reducepv32hf_mask_round, "__builtin_ia32_reduceph512_mask_round", IX86_BUILTIN_REDUCEPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_INT_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_reducesv8hf_mask_round, "__builtin_ia32_reducesh_mask_round", IX86_BUILTIN_REDUCESH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_INT_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_rndscalev32hf_mask_round, "__builtin_ia32_rndscaleph512_mask_round", IX86_BUILTIN_RNDSCALEPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_INT_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_rndscalev8hf_mask_round, "__builtin_ia32_rndscalesh_mask_round", IX86_BUILTIN_RNDSCALESH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_INT_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_getexpv32hf_mask_round, "__builtin_ia32_getexpph512_mask", IX86_BUILTIN_GETEXPPH512, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_sgetexpv8hf_mask_round, "__builtin_ia32_getexpsh_mask_round", IX86_BUILTIN_GETEXPSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_getmantv32hf_mask_round, "__builtin_ia32_getmantph512_mask", IX86_BUILTIN_GETMANTPH512, UNKNOWN, (int) V32HF_FTYPE_V32HF_INT_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vgetmantv8hf_mask_round, "__builtin_ia32_getmantsh_mask_round", IX86_BUILTIN_GETMANTSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_INT_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtph2dq_v16si_mask_round, "__builtin_ia32_vcvtph2dq512_mask_round", IX86_BUILTIN_VCVTPH2DQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtph2udq_v16si_mask_round, "__builtin_ia32_vcvtph2udq512_mask_round", IX86_BUILTIN_VCVTPH2UDQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_avx512fp16_fix_truncv16si2_mask_round, "__builtin_ia32_vcvttph2dq512_mask_round", IX86_BUILTIN_VCVTTPH2DQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_avx512fp16_fixuns_truncv16si2_mask_round, "__builtin_ia32_vcvttph2udq512_mask_round", IX86_BUILTIN_VCVTTPH2UDQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtph2qq_v8di_mask_round, "__builtin_ia32_vcvtph2qq512_mask_round", IX86_BUILTIN_VCVTPH2QQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtph2uqq_v8di_mask_round, "__builtin_ia32_vcvtph2uqq512_mask_round", IX86_BUILTIN_VCVTPH2UQQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_avx512fp16_fix_truncv8di2_mask_round, "__builtin_ia32_vcvttph2qq512_mask_round", IX86_BUILTIN_VCVTTPH2QQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_avx512fp16_fixuns_truncv8di2_mask_round, "__builtin_ia32_vcvttph2uqq512_mask_round", IX86_BUILTIN_VCVTTPH2UQQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtph2w_v32hi_mask_round, "__builtin_ia32_vcvtph2w512_mask_round", IX86_BUILTIN_VCVTPH2W512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtph2uw_v32hi_mask_round, "__builtin_ia32_vcvtph2uw512_mask_round", IX86_BUILTIN_VCVTPH2UW512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_avx512fp16_fix_truncv32hi2_mask_round, "__builtin_ia32_vcvttph2w512_mask_round", IX86_BUILTIN_VCVTTPH2W512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_unspec_avx512fp16_fixuns_truncv32hi2_mask_round, "__builtin_ia32_vcvttph2uw512_mask_round", IX86_BUILTIN_VCVTTPH2UW512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtw2ph_v32hi_mask_round, "__builtin_ia32_vcvtw2ph512_mask_round", IX86_BUILTIN_VCVTW2PH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HI_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtuw2ph_v32hi_mask_round, "__builtin_ia32_vcvtuw2ph512_mask_round", IX86_BUILTIN_VCVTUW2PH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HI_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtdq2ph_v16si_mask_round, "__builtin_ia32_vcvtdq2ph512_mask_round", IX86_BUILTIN_VCVTDQ2PH512_MASK_ROUND, UNKNOWN, (int) V16HF_FTYPE_V16SI_V16HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtudq2ph_v16si_mask_round, "__builtin_ia32_vcvtudq2ph512_mask_round", IX86_BUILTIN_VCVTUDQ2PH512_MASK_ROUND, UNKNOWN, (int) V16HF_FTYPE_V16SI_V16HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtqq2ph_v8di_mask_round, "__builtin_ia32_vcvtqq2ph512_mask_round", IX86_BUILTIN_VCVTQQ2PH512_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8DI_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtuqq2ph_v8di_mask_round, "__builtin_ia32_vcvtuqq2ph512_mask_round", IX86_BUILTIN_VCVTUQQ2PH512_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8DI_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2si_round, "__builtin_ia32_vcvtsh2si32_round", IX86_BUILTIN_VCVTSH2SI32_ROUND, UNKNOWN, (int) INT_FTYPE_V8HF_INT)
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2siq_round, "__builtin_ia32_vcvtsh2si64_round", IX86_BUILTIN_VCVTSH2SI64_ROUND, UNKNOWN, (int) INT64_FTYPE_V8HF_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2usi_round, "__builtin_ia32_vcvtsh2usi32_round", IX86_BUILTIN_VCVTSH2USI32_ROUND, UNKNOWN, (int) UINT_FTYPE_V8HF_INT)
--- 3495,3594 ----
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmadd_v4sf_mask3_round, "__builtin_ia32_vfmaddss3_mask3", IX86_BUILTIN_VFMADDSS3_MASK3, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmadd_v4sf_maskz_round, "__builtin_ia32_vfmaddss3_maskz", IX86_BUILTIN_VFMADDSS3_MASKZ, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_vmfmsub_v4sf_mask3_round, "__builtin_ia32_vfmsubss3_mask3", IX86_BUILTIN_VFMSUBSS3_MASK3, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmaddsub_v8df_mask_round, "__builtin_ia32_vfmaddsubpd512_mask", IX86_BUILTIN_VFMADDSUBPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmaddsub_v8df_mask3_round, "__builtin_ia32_vfmaddsubpd512_mask3", IX86_BUILTIN_VFMADDSUBPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmaddsub_v8df_maskz_round, "__builtin_ia32_vfmaddsubpd512_maskz", IX86_BUILTIN_VFMADDSUBPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmaddsub_v16sf_mask_round, "__builtin_ia32_vfmaddsubps512_mask", IX86_BUILTIN_VFMADDSUBPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmaddsub_v16sf_mask3_round, "__builtin_ia32_vfmaddsubps512_mask3", IX86_BUILTIN_VFMADDSUBPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmaddsub_v16sf_maskz_round, "__builtin_ia32_vfmaddsubps512_maskz", IX86_BUILTIN_VFMADDSUBPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsubadd_v8df_mask3_round, "__builtin_ia32_vfmsubaddpd512_mask3", IX86_BUILTIN_VFMSUBADDPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsubadd_v16sf_mask3_round, "__builtin_ia32_vfmsubaddps512_mask3", IX86_BUILTIN_VFMSUBADDPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsub_v8df_mask_round, "__builtin_ia32_vfmsubpd512_mask", IX86_BUILTIN_VFMSUBPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsub_v8df_mask3_round, "__builtin_ia32_vfmsubpd512_mask3", IX86_BUILTIN_VFMSUBPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsub_v8df_maskz_round, "__builtin_ia32_vfmsubpd512_maskz", IX86_BUILTIN_VFMSUBPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsub_v16sf_mask_round, "__builtin_ia32_vfmsubps512_mask", IX86_BUILTIN_VFMSUBPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsub_v16sf_mask3_round, "__builtin_ia32_vfmsubps512_mask3", IX86_BUILTIN_VFMSUBPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fmsub_v16sf_maskz_round, "__builtin_ia32_vfmsubps512_maskz", IX86_BUILTIN_VFMSUBPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmadd_v8df_mask_round, "__builtin_ia32_vfnmaddpd512_mask", IX86_BUILTIN_VFNMADDPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmadd_v8df_mask3_round, "__builtin_ia32_vfnmaddpd512_mask3", IX86_BUILTIN_VFNMADDPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmadd_v8df_maskz_round, "__builtin_ia32_vfnmaddpd512_maskz", IX86_BUILTIN_VFNMADDPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmadd_v16sf_mask_round, "__builtin_ia32_vfnmaddps512_mask", IX86_BUILTIN_VFNMADDPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmadd_v16sf_mask3_round, "__builtin_ia32_vfnmaddps512_mask3", IX86_BUILTIN_VFNMADDPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmadd_v16sf_maskz_round, "__builtin_ia32_vfnmaddps512_maskz", IX86_BUILTIN_VFNMADDPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmsub_v8df_mask_round, "__builtin_ia32_vfnmsubpd512_mask", IX86_BUILTIN_VFNMSUBPD512_MASK, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmsub_v8df_mask3_round, "__builtin_ia32_vfnmsubpd512_mask3", IX86_BUILTIN_VFNMSUBPD512_MASK3, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmsub_v8df_maskz_round, "__builtin_ia32_vfnmsubpd512_maskz", IX86_BUILTIN_VFNMSUBPD512_MASKZ, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmsub_v16sf_mask_round, "__builtin_ia32_vfnmsubps512_mask", IX86_BUILTIN_VFNMSUBPS512_MASK, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmsub_v16sf_mask3_round, "__builtin_ia32_vfnmsubps512_mask3", IX86_BUILTIN_VFNMSUBPS512_MASK3, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512F, 0, CODE_FOR_avx512f_fnmsub_v16sf_maskz_round, "__builtin_ia32_vfnmsubps512_maskz", IX86_BUILTIN_VFNMSUBPS512_MASKZ, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_V16SF_HI_INT)
  
  /* AVX512DQ.  */
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducepv8df_mask_round, "__builtin_ia32_reducepd512_mask_round", IX86_BUILTIN_REDUCEPD512_MASK_ROUND, UNKNOWN, (int) V8DF_FTYPE_V8DF_INT_V8DF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducepv16sf_mask_round, "__builtin_ia32_reduceps512_mask_round", IX86_BUILTIN_REDUCEPS512_MASK_ROUND, UNKNOWN, (int) V16SF_FTYPE_V16SF_INT_V16SF_UHI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducesv2df_mask_round, "__builtin_ia32_reducesd_mask_round", IX86_BUILTIN_REDUCESD128_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_reducesv4sf_mask_round, "__builtin_ia32_reducess_mask_round", IX86_BUILTIN_REDUCESS128_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_rangesv2df_mask_round, "__builtin_ia32_rangesd128_mask_round", IX86_BUILTIN_RANGESD128, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI_INT)
  BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_rangesv4sf_mask_round, "__builtin_ia32_rangess128_mask_round", IX86_BUILTIN_RANGESS128, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_fix_notruncv8dfv8di2_mask_round, "__builtin_ia32_cvtpd2qq512_mask", IX86_BUILTIN_CVTPD2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_cvtps2qqv8di_mask_round, "__builtin_ia32_cvtps2qq512_mask", IX86_BUILTIN_CVTPS2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_fixuns_notruncv8dfv8di2_mask_round, "__builtin_ia32_cvtpd2uqq512_mask", IX86_BUILTIN_CVTPD2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_cvtps2uqqv8di_mask_round, "__builtin_ia32_cvtps2uqq512_mask", IX86_BUILTIN_CVTPS2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_floatv8div8sf2_mask_round, "__builtin_ia32_cvtqq2ps512_mask", IX86_BUILTIN_CVTQQ2PS512, UNKNOWN, (int) V8SF_FTYPE_V8DI_V8SF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_floatunsv8div8sf2_mask_round, "__builtin_ia32_cvtuqq2ps512_mask", IX86_BUILTIN_CVTUQQ2PS512, UNKNOWN, (int) V8SF_FTYPE_V8DI_V8SF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_floatv8div8df2_mask_round, "__builtin_ia32_cvtqq2pd512_mask", IX86_BUILTIN_CVTQQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_floatunsv8div8df2_mask_round, "__builtin_ia32_cvtuqq2pd512_mask", IX86_BUILTIN_CVTUQQ2PD512, UNKNOWN, (int) V8DF_FTYPE_V8DI_V8DF_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_unspec_fix_truncv8sfv8di2_mask_round, "__builtin_ia32_cvttps2qq512_mask", IX86_BUILTIN_CVTTPS2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_unspec_fixuns_truncv8sfv8di2_mask_round, "__builtin_ia32_cvttps2uqq512_mask", IX86_BUILTIN_CVTTPS2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8SF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_unspec_fix_truncv8dfv8di2_mask_round, "__builtin_ia32_cvttpd2qq512_mask", IX86_BUILTIN_CVTTPD2QQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_unspec_fixuns_truncv8dfv8di2_mask_round, "__builtin_ia32_cvttpd2uqq512_mask", IX86_BUILTIN_CVTTPD2UQQ512, UNKNOWN, (int) V8DI_FTYPE_V8DF_V8DI_QI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_rangepv16sf_mask_round, "__builtin_ia32_rangeps512_mask", IX86_BUILTIN_RANGEPS512, UNKNOWN, (int) V16SF_FTYPE_V16SF_V16SF_INT_V16SF_HI_INT)
! BDESC (OPTION_MASK_ISA_AVX512DQ, 0, CODE_FOR_avx512dq_rangepv8df_mask_round, "__builtin_ia32_rangepd512_mask", IX86_BUILTIN_RANGEPD512, UNKNOWN, (int) V8DF_FTYPE_V8DF_V8DF_INT_V8DF_QI_INT)
  
  /* AVX512FP16.  */
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_addv32hf3_mask_round, "__builtin_ia32_addph512_mask_round", IX86_BUILTIN_ADDPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_subv32hf3_mask_round, "__builtin_ia32_subph512_mask_round", IX86_BUILTIN_SUBPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_mulv32hf3_mask_round, "__builtin_ia32_mulph512_mask_round", IX86_BUILTIN_MULPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_divv32hf3_mask_round, "__builtin_ia32_divph512_mask_round", IX86_BUILTIN_DIVPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmaddv8hf3_mask_round, "__builtin_ia32_addsh_mask_round", IX86_BUILTIN_ADDSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsubv8hf3_mask_round, "__builtin_ia32_subsh_mask_round", IX86_BUILTIN_SUBSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmmulv8hf3_mask_round, "__builtin_ia32_mulsh_mask_round", IX86_BUILTIN_MULSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmdivv8hf3_mask_round, "__builtin_ia32_divsh_mask_round", IX86_BUILTIN_DIVSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_smaxv32hf3_mask_round, "__builtin_ia32_maxph512_mask_round", IX86_BUILTIN_MAXPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_sminv32hf3_mask_round, "__builtin_ia32_minph512_mask_round", IX86_BUILTIN_MINPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsmaxv8hf3_mask_round, "__builtin_ia32_maxsh_mask_round", IX86_BUILTIN_MAXSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsminv8hf3_mask_round, "__builtin_ia32_minsh_mask_round", IX86_BUILTIN_MINSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_cmpv32hf3_mask_round, "__builtin_ia32_cmpph512_mask_round", IX86_BUILTIN_CMPPH512_MASK_ROUND, UNKNOWN, (int) USI_FTYPE_V32HF_V32HF_INT_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmcmpv8hf3_mask_round, "__builtin_ia32_cmpsh_mask_round", IX86_BUILTIN_CMPSH_MASK_ROUND, UNKNOWN, (int) UQI_FTYPE_V8HF_V8HF_INT_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_sqrtv32hf2_mask_round, "__builtin_ia32_sqrtph512_mask_round", IX86_BUILTIN_SQRTPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vmsqrtv8hf2_mask_round, "__builtin_ia32_sqrtsh_mask_round", IX86_BUILTIN_SQRTSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_scalefv32hf_mask_round, "__builtin_ia32_scalefph512_mask_round", IX86_BUILTIN_SCALEFPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmscalefv8hf_mask_round, "__builtin_ia32_scalefsh_mask_round", IX86_BUILTIN_SCALEFSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_reducepv32hf_mask_round, "__builtin_ia32_reduceph512_mask_round", IX86_BUILTIN_REDUCEPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_INT_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_reducesv8hf_mask_round, "__builtin_ia32_reducesh_mask_round", IX86_BUILTIN_REDUCESH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_INT_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_rndscalev32hf_mask_round, "__builtin_ia32_rndscaleph512_mask_round", IX86_BUILTIN_RNDSCALEPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_INT_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_rndscalev8hf_mask_round, "__builtin_ia32_rndscalesh_mask_round", IX86_BUILTIN_RNDSCALESH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_INT_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_getexpv32hf_mask_round, "__builtin_ia32_getexpph512_mask", IX86_BUILTIN_GETEXPPH512, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_sgetexpv8hf_mask_round, "__builtin_ia32_getexpsh_mask_round", IX86_BUILTIN_GETEXPSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_getmantv32hf_mask_round, "__builtin_ia32_getmantph512_mask", IX86_BUILTIN_GETMANTPH512, UNKNOWN, (int) V32HF_FTYPE_V32HF_INT_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vgetmantv8hf_mask_round, "__builtin_ia32_getmantsh_mask_round", IX86_BUILTIN_GETMANTSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_INT_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtph2dq_v16si_mask_round, "__builtin_ia32_vcvtph2dq512_mask_round", IX86_BUILTIN_VCVTPH2DQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtph2udq_v16si_mask_round, "__builtin_ia32_vcvtph2udq512_mask_round", IX86_BUILTIN_VCVTPH2UDQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_unspec_avx512fp16_fix_truncv16si2_mask_round, "__builtin_ia32_vcvttph2dq512_mask_round", IX86_BUILTIN_VCVTTPH2DQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_unspec_avx512fp16_fixuns_truncv16si2_mask_round, "__builtin_ia32_vcvttph2udq512_mask_round", IX86_BUILTIN_VCVTTPH2UDQ512_MASK_ROUND, UNKNOWN, (int) V16SI_FTYPE_V16HF_V16SI_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtph2qq_v8di_mask_round, "__builtin_ia32_vcvtph2qq512_mask_round", IX86_BUILTIN_VCVTPH2QQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtph2uqq_v8di_mask_round, "__builtin_ia32_vcvtph2uqq512_mask_round", IX86_BUILTIN_VCVTPH2UQQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_unspec_avx512fp16_fix_truncv8di2_mask_round, "__builtin_ia32_vcvttph2qq512_mask_round", IX86_BUILTIN_VCVTTPH2QQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_unspec_avx512fp16_fixuns_truncv8di2_mask_round, "__builtin_ia32_vcvttph2uqq512_mask_round", IX86_BUILTIN_VCVTTPH2UQQ512_MASK_ROUND, UNKNOWN, (int) V8DI_FTYPE_V8HF_V8DI_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtph2w_v32hi_mask_round, "__builtin_ia32_vcvtph2w512_mask_round", IX86_BUILTIN_VCVTPH2W512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtph2uw_v32hi_mask_round, "__builtin_ia32_vcvtph2uw512_mask_round", IX86_BUILTIN_VCVTPH2UW512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_unspec_avx512fp16_fix_truncv32hi2_mask_round, "__builtin_ia32_vcvttph2w512_mask_round", IX86_BUILTIN_VCVTTPH2W512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_unspec_avx512fp16_fixuns_truncv32hi2_mask_round, "__builtin_ia32_vcvttph2uw512_mask_round", IX86_BUILTIN_VCVTTPH2UW512_MASK_ROUND, UNKNOWN, (int) V32HI_FTYPE_V32HF_V32HI_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtw2ph_v32hi_mask_round, "__builtin_ia32_vcvtw2ph512_mask_round", IX86_BUILTIN_VCVTW2PH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HI_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtuw2ph_v32hi_mask_round, "__builtin_ia32_vcvtuw2ph512_mask_round", IX86_BUILTIN_VCVTUW2PH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HI_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtdq2ph_v16si_mask_round, "__builtin_ia32_vcvtdq2ph512_mask_round", IX86_BUILTIN_VCVTDQ2PH512_MASK_ROUND, UNKNOWN, (int) V16HF_FTYPE_V16SI_V16HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtudq2ph_v16si_mask_round, "__builtin_ia32_vcvtudq2ph512_mask_round", IX86_BUILTIN_VCVTUDQ2PH512_MASK_ROUND, UNKNOWN, (int) V16HF_FTYPE_V16SI_V16HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtqq2ph_v8di_mask_round, "__builtin_ia32_vcvtqq2ph512_mask_round", IX86_BUILTIN_VCVTQQ2PH512_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8DI_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtuqq2ph_v8di_mask_round, "__builtin_ia32_vcvtuqq2ph512_mask_round", IX86_BUILTIN_VCVTUQQ2PH512_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8DI_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2si_round, "__builtin_ia32_vcvtsh2si32_round", IX86_BUILTIN_VCVTSH2SI32_ROUND, UNKNOWN, (int) INT_FTYPE_V8HF_INT)
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2siq_round, "__builtin_ia32_vcvtsh2si64_round", IX86_BUILTIN_VCVTSH2SI64_ROUND, UNKNOWN, (int) INT64_FTYPE_V8HF_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2usi_round, "__builtin_ia32_vcvtsh2usi32_round", IX86_BUILTIN_VCVTSH2USI32_ROUND, UNKNOWN, (int) UINT_FTYPE_V8HF_INT)
*************** BDESC (0, OPTION_MASK_ISA2_AVX512FP16, C
*** 3601,3632 ****
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsi2shq_round, "__builtin_ia32_vcvtsi2sh64_round", IX86_BUILTIN_VCVTSI2SH64_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_INT64_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtusi2sh_round, "__builtin_ia32_vcvtusi2sh32_round", IX86_BUILTIN_VCVTUSI2SH32_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_UINT_INT)
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtusi2shq_round, "__builtin_ia32_vcvtusi2sh64_round", IX86_BUILTIN_VCVTUSI2SH64_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_UINT64_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_float_extend_phv8df2_mask_round, "__builtin_ia32_vcvtph2pd512_mask_round", IX86_BUILTIN_VCVTPH2PD512_MASK_ROUND, UNKNOWN, (int) V8DF_FTYPE_V8HF_V8DF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_float_extend_phv16sf2_mask_round, "__builtin_ia32_vcvtph2psx512_mask_round", IX86_BUILTIN_VCVTPH2PSX512_MASK_ROUND, UNKNOWN, (int) V16SF_FTYPE_V16HF_V16SF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtpd2ph_v8df_mask_round, "__builtin_ia32_vcvtpd2ph512_mask_round", IX86_BUILTIN_VCVTPD2PH512_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8DF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512fp16_vcvtps2ph_v16sf_mask_round, "__builtin_ia32_vcvtps2phx512_mask_round", IX86_BUILTIN_VCVTPS2PHX512_MASK_ROUND, UNKNOWN, (int) V16HF_FTYPE_V16SF_V16HF_UHI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2ss_mask_round, "__builtin_ia32_vcvtsh2ss_mask_round", IX86_BUILTIN_VCVTSH2SS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V8HF_V4SF_V4SF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2sd_mask_round, "__builtin_ia32_vcvtsh2sd_mask_round", IX86_BUILTIN_VCVTSH2SD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V8HF_V2DF_V2DF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtss2sh_mask_round, "__builtin_ia32_vcvtss2sh_mask_round", IX86_BUILTIN_VCVTSS2SH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V4SF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsd2sh_mask_round, "__builtin_ia32_vcvtsd2sh_mask_round", IX86_BUILTIN_VCVTSD2SH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V2DF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmaddsub_v32hf_mask_round, "__builtin_ia32_vfmaddsubph512_mask", IX86_BUILTIN_VFMADDSUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmaddsub_v32hf_mask3_round, "__builtin_ia32_vfmaddsubph512_mask3", IX86_BUILTIN_VFMADDSUBPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmaddsub_v32hf_maskz_round, "__builtin_ia32_vfmaddsubph512_maskz", IX86_BUILTIN_VFMADDSUBPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmsubadd_v32hf_mask_round, "__builtin_ia32_vfmsubaddph512_mask", IX86_BUILTIN_VFMSUBADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmsubadd_v32hf_mask3_round, "__builtin_ia32_vfmsubaddph512_mask3", IX86_BUILTIN_VFMSUBADDPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmsubadd_v32hf_maskz_round, "__builtin_ia32_vfmsubaddph512_maskz", IX86_BUILTIN_VFMSUBADDPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmadd_v32hf_mask_round, "__builtin_ia32_vfmaddph512_mask", IX86_BUILTIN_VFMADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmadd_v32hf_mask3_round, "__builtin_ia32_vfmaddph512_mask3", IX86_BUILTIN_VFMADDPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmadd_v32hf_maskz_round, "__builtin_ia32_vfmaddph512_maskz", IX86_BUILTIN_VFMADDPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fnmadd_v32hf_mask_round, "__builtin_ia32_vfnmaddph512_mask", IX86_BUILTIN_VFNMADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fnmadd_v32hf_mask3_round, "__builtin_ia32_vfnmaddph512_mask3", IX86_BUILTIN_VFNMADDPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fnmadd_v32hf_maskz_round, "__builtin_ia32_vfnmaddph512_maskz", IX86_BUILTIN_VFNMADDPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmsub_v32hf_mask_round, "__builtin_ia32_vfmsubph512_mask", IX86_BUILTIN_VFMSUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmsub_v32hf_mask3_round, "__builtin_ia32_vfmsubph512_mask3", IX86_BUILTIN_VFMSUBPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmsub_v32hf_maskz_round, "__builtin_ia32_vfmsubph512_maskz", IX86_BUILTIN_VFMSUBPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fnmsub_v32hf_mask_round, "__builtin_ia32_vfnmsubph512_mask", IX86_BUILTIN_VFNMSUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fnmsub_v32hf_mask3_round, "__builtin_ia32_vfnmsubph512_mask3", IX86_BUILTIN_VFNMSUBPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fnmsub_v32hf_maskz_round, "__builtin_ia32_vfnmsubph512_maskz", IX86_BUILTIN_VFNMSUBPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmadd_v8hf_mask_round, "__builtin_ia32_vfmaddsh3_mask", IX86_BUILTIN_VFMADDSH3_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmadd_v8hf_mask3_round, "__builtin_ia32_vfmaddsh3_mask3", IX86_BUILTIN_VFMADDSH3_MASK3, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmadd_v8hf_maskz_round, "__builtin_ia32_vfmaddsh3_maskz", IX86_BUILTIN_VFMADDSH3_MASKZ, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
--- 3601,3632 ----
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsi2shq_round, "__builtin_ia32_vcvtsi2sh64_round", IX86_BUILTIN_VCVTSI2SH64_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_INT64_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtusi2sh_round, "__builtin_ia32_vcvtusi2sh32_round", IX86_BUILTIN_VCVTUSI2SH32_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_UINT_INT)
  BDESC (OPTION_MASK_ISA_64BIT, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtusi2shq_round, "__builtin_ia32_vcvtusi2sh64_round", IX86_BUILTIN_VCVTUSI2SH64_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_UINT64_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_float_extend_phv8df2_mask_round, "__builtin_ia32_vcvtph2pd512_mask_round", IX86_BUILTIN_VCVTPH2PD512_MASK_ROUND, UNKNOWN, (int) V8DF_FTYPE_V8HF_V8DF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_float_extend_phv16sf2_mask_round, "__builtin_ia32_vcvtph2psx512_mask_round", IX86_BUILTIN_VCVTPH2PSX512_MASK_ROUND, UNKNOWN, (int) V16SF_FTYPE_V16HF_V16SF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtpd2ph_v8df_mask_round, "__builtin_ia32_vcvtpd2ph512_mask_round", IX86_BUILTIN_VCVTPD2PH512_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8DF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtps2ph_v16sf_mask_round, "__builtin_ia32_vcvtps2phx512_mask_round", IX86_BUILTIN_VCVTPS2PHX512_MASK_ROUND, UNKNOWN, (int) V16HF_FTYPE_V16SF_V16HF_UHI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2ss_mask_round, "__builtin_ia32_vcvtsh2ss_mask_round", IX86_BUILTIN_VCVTSH2SS_MASK_ROUND, UNKNOWN, (int) V4SF_FTYPE_V8HF_V4SF_V4SF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsh2sd_mask_round, "__builtin_ia32_vcvtsh2sd_mask_round", IX86_BUILTIN_VCVTSH2SD_MASK_ROUND, UNKNOWN, (int) V2DF_FTYPE_V8HF_V2DF_V2DF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtss2sh_mask_round, "__builtin_ia32_vcvtss2sh_mask_round", IX86_BUILTIN_VCVTSS2SH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V4SF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_vcvtsd2sh_mask_round, "__builtin_ia32_vcvtsd2sh_mask_round", IX86_BUILTIN_VCVTSD2SH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V2DF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmaddsub_v32hf_mask_round, "__builtin_ia32_vfmaddsubph512_mask", IX86_BUILTIN_VFMADDSUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmaddsub_v32hf_mask3_round, "__builtin_ia32_vfmaddsubph512_mask3", IX86_BUILTIN_VFMADDSUBPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmaddsub_v32hf_maskz_round, "__builtin_ia32_vfmaddsubph512_maskz", IX86_BUILTIN_VFMADDSUBPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmsubadd_v32hf_mask_round, "__builtin_ia32_vfmsubaddph512_mask", IX86_BUILTIN_VFMSUBADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmsubadd_v32hf_mask3_round, "__builtin_ia32_vfmsubaddph512_mask3", IX86_BUILTIN_VFMSUBADDPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmsubadd_v32hf_maskz_round, "__builtin_ia32_vfmsubaddph512_maskz", IX86_BUILTIN_VFMSUBADDPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmadd_v32hf_mask_round, "__builtin_ia32_vfmaddph512_mask", IX86_BUILTIN_VFMADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmadd_v32hf_mask3_round, "__builtin_ia32_vfmaddph512_mask3", IX86_BUILTIN_VFMADDPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmadd_v32hf_maskz_round, "__builtin_ia32_vfmaddph512_maskz", IX86_BUILTIN_VFMADDPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fnmadd_v32hf_mask_round, "__builtin_ia32_vfnmaddph512_mask", IX86_BUILTIN_VFNMADDPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fnmadd_v32hf_mask3_round, "__builtin_ia32_vfnmaddph512_mask3", IX86_BUILTIN_VFNMADDPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fnmadd_v32hf_maskz_round, "__builtin_ia32_vfnmaddph512_maskz", IX86_BUILTIN_VFNMADDPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmsub_v32hf_mask_round, "__builtin_ia32_vfmsubph512_mask", IX86_BUILTIN_VFMSUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmsub_v32hf_mask3_round, "__builtin_ia32_vfmsubph512_mask3", IX86_BUILTIN_VFMSUBPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmsub_v32hf_maskz_round, "__builtin_ia32_vfmsubph512_maskz", IX86_BUILTIN_VFMSUBPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fnmsub_v32hf_mask_round, "__builtin_ia32_vfnmsubph512_mask", IX86_BUILTIN_VFNMSUBPH512_MASK, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fnmsub_v32hf_mask3_round, "__builtin_ia32_vfnmsubph512_mask3", IX86_BUILTIN_VFNMSUBPH512_MASK3, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fnmsub_v32hf_maskz_round, "__builtin_ia32_vfnmsubph512_maskz", IX86_BUILTIN_VFNMSUBPH512_MASKZ, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_USI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmadd_v8hf_mask_round, "__builtin_ia32_vfmaddsh3_mask", IX86_BUILTIN_VFMADDSH3_MASK, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmadd_v8hf_mask3_round, "__builtin_ia32_vfmaddsh3_mask3", IX86_BUILTIN_VFMADDSH3_MASK3, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmadd_v8hf_maskz_round, "__builtin_ia32_vfmaddsh3_maskz", IX86_BUILTIN_VFMADDSH3_MASKZ, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
*************** BDESC (0, OPTION_MASK_ISA2_AVX512FP16, C
*** 3634,3651 ****
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfnmadd_v8hf_mask3_round, "__builtin_ia32_vfnmaddsh3_mask3", IX86_BUILTIN_VFNMADDSH3_MASK3, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfnmadd_v8hf_maskz_round, "__builtin_ia32_vfnmaddsh3_maskz", IX86_BUILTIN_VFNMADDSH3_MASKZ, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmsub_v8hf_mask3_round, "__builtin_ia32_vfmsubsh3_mask3", IX86_BUILTIN_VFMSUBSH3_MASK3, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_fma_fmaddc_v32hf_round, "__builtin_ia32_vfmaddcph512_round", IX86_BUILTIN_VFMADDCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmaddc_v32hf_mask1_round, "__builtin_ia32_vfmaddcph512_mask_round", IX86_BUILTIN_VFMADDCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmaddc_v32hf_mask_round, "__builtin_ia32_vfmaddcph512_mask3_round", IX86_BUILTIN_VFMADDCPH512_MASK3_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmaddc_v32hf_maskz_round, "__builtin_ia32_vfmaddcph512_maskz_round", IX86_BUILTIN_VFMADDCPH512_MASKZ_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_fma_fcmaddc_v32hf_round, "__builtin_ia32_vfcmaddcph512_round", IX86_BUILTIN_VFCMADDCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fcmaddc_v32hf_mask1_round, "__builtin_ia32_vfcmaddcph512_mask_round", IX86_BUILTIN_VFCMADDCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fcmaddc_v32hf_mask_round, "__builtin_ia32_vfcmaddcph512_mask3_round", IX86_BUILTIN_VFCMADDCPH512_MASK3_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fcmaddc_v32hf_maskz_round, "__builtin_ia32_vfcmaddcph512_maskz_round", IX86_BUILTIN_VFCMADDCPH512_MASKZ_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fcmulc_v32hf_round, "__builtin_ia32_vfcmulcph512_round", IX86_BUILTIN_VFCMULCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fcmulc_v32hf_mask_round, "__builtin_ia32_vfcmulcph512_mask_round", IX86_BUILTIN_VFCMULCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmulc_v32hf_round, "__builtin_ia32_vfmulcph512_round", IX86_BUILTIN_VFMULCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16 | OPTION_MASK_ISA2_EVEX512, CODE_FOR_avx512bw_fmulc_v32hf_mask_round, "__builtin_ia32_vfmulcph512_mask_round", IX86_BUILTIN_VFMULCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_fma_fcmaddcsh_v8hf_round, "__builtin_ia32_vfcmaddcsh_round", IX86_BUILTIN_VFCMADDCSH_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_fcmaddcsh_v8hf_mask1_round, "__builtin_ia32_vfcmaddcsh_mask_round", IX86_BUILTIN_VFCMADDCSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_fcmaddcsh_v8hf_mask3_round, "__builtin_ia32_vfcmaddcsh_mask3_round", IX86_BUILTIN_VFCMADDCSH_MASK3_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
--- 3634,3651 ----
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfnmadd_v8hf_mask3_round, "__builtin_ia32_vfnmaddsh3_mask3", IX86_BUILTIN_VFNMADDSH3_MASK3, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfnmadd_v8hf_maskz_round, "__builtin_ia32_vfnmaddsh3_maskz", IX86_BUILTIN_VFNMADDSH3_MASKZ, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512f_vmfmsub_v8hf_mask3_round, "__builtin_ia32_vfmsubsh3_mask3", IX86_BUILTIN_VFMSUBSH3_MASK3, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_fma_fmaddc_v32hf_round, "__builtin_ia32_vfmaddcph512_round", IX86_BUILTIN_VFMADDCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmaddc_v32hf_mask1_round, "__builtin_ia32_vfmaddcph512_mask_round", IX86_BUILTIN_VFMADDCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmaddc_v32hf_mask_round, "__builtin_ia32_vfmaddcph512_mask3_round", IX86_BUILTIN_VFMADDCPH512_MASK3_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmaddc_v32hf_maskz_round, "__builtin_ia32_vfmaddcph512_maskz_round", IX86_BUILTIN_VFMADDCPH512_MASKZ_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_fma_fcmaddc_v32hf_round, "__builtin_ia32_vfcmaddcph512_round", IX86_BUILTIN_VFCMADDCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fcmaddc_v32hf_mask1_round, "__builtin_ia32_vfcmaddcph512_mask_round", IX86_BUILTIN_VFCMADDCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fcmaddc_v32hf_mask_round, "__builtin_ia32_vfcmaddcph512_mask3_round", IX86_BUILTIN_VFCMADDCPH512_MASK3_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fcmaddc_v32hf_maskz_round, "__builtin_ia32_vfcmaddcph512_maskz_round", IX86_BUILTIN_VFCMADDCPH512_MASKZ_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fcmulc_v32hf_round, "__builtin_ia32_vfcmulcph512_round", IX86_BUILTIN_VFCMULCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fcmulc_v32hf_mask_round, "__builtin_ia32_vfcmulcph512_mask_round", IX86_BUILTIN_VFCMULCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmulc_v32hf_round, "__builtin_ia32_vfmulcph512_round", IX86_BUILTIN_VFMULCPH512_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_INT)
! BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512bw_fmulc_v32hf_mask_round, "__builtin_ia32_vfmulcph512_mask_round", IX86_BUILTIN_VFMULCPH512_MASK_ROUND, UNKNOWN, (int) V32HF_FTYPE_V32HF_V32HF_V32HF_UHI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_fma_fcmaddcsh_v8hf_round, "__builtin_ia32_vfcmaddcsh_round", IX86_BUILTIN_VFCMADDCSH_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_fcmaddcsh_v8hf_mask1_round, "__builtin_ia32_vfcmaddcsh_mask_round", IX86_BUILTIN_VFCMADDCSH_MASK_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
  BDESC (0, OPTION_MASK_ISA2_AVX512FP16, CODE_FOR_avx512fp16_fcmaddcsh_v8hf_mask3_round, "__builtin_ia32_vfcmaddcsh_mask3_round", IX86_BUILTIN_VFCMADDCSH_MASK3_ROUND, UNKNOWN, (int) V8HF_FTYPE_V8HF_V8HF_V8HF_UQI_INT)
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386-builtins.cc gcc-16-20250525/gcc/config/i386/i386-builtins.cc
*** gcc-16-20250518/gcc/config/i386/i386-builtins.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386-builtins.cc	Sun May 25 22:32:05 2025
*************** ix86_init_mmx_sse_builtins (void)
*** 801,902 ****
  		    IX86_BUILTIN_GATHERALTDIV8SI);
  
    /* AVX512F */
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gathersiv16sf",
  		    V16SF_FTYPE_V16SF_PCVOID_V16SI_HI_INT,
  		    IX86_BUILTIN_GATHER3SIV16SF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gathersiv8df",
  		    V8DF_FTYPE_V8DF_PCVOID_V8SI_QI_INT,
  		    IX86_BUILTIN_GATHER3SIV8DF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gatherdiv16sf",
  		    V8SF_FTYPE_V8SF_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV16SF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gatherdiv8df",
  		    V8DF_FTYPE_V8DF_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV8DF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gathersiv16si",
  		    V16SI_FTYPE_V16SI_PCVOID_V16SI_HI_INT,
  		    IX86_BUILTIN_GATHER3SIV16SI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gathersiv8di",
  		    V8DI_FTYPE_V8DI_PCVOID_V8SI_QI_INT,
  		    IX86_BUILTIN_GATHER3SIV8DI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gatherdiv16si",
  		    V8SI_FTYPE_V8SI_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV16SI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gatherdiv8di",
  		    V8DI_FTYPE_V8DI_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV8DI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gather3altsiv8df ",
  		    V8DF_FTYPE_V8DF_PCDOUBLE_V16SI_QI_INT,
  		    IX86_BUILTIN_GATHER3ALTSIV8DF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gather3altdiv16sf ",
  		    V16SF_FTYPE_V16SF_PCFLOAT_V8DI_HI_INT,
  		    IX86_BUILTIN_GATHER3ALTDIV16SF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gather3altsiv8di ",
  		    V8DI_FTYPE_V8DI_PCINT64_V16SI_QI_INT,
  		    IX86_BUILTIN_GATHER3ALTSIV8DI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  		    "__builtin_ia32_gather3altdiv16si ",
  		    V16SI_FTYPE_V16SI_PCINT_V8DI_HI_INT,
  		    IX86_BUILTIN_GATHER3ALTDIV16SI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scattersiv16sf",
  	       VOID_FTYPE_PVOID_HI_V16SI_V16SF_INT,
  	       IX86_BUILTIN_SCATTERSIV16SF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scattersiv8df",
  	       VOID_FTYPE_PVOID_QI_V8SI_V8DF_INT,
  	       IX86_BUILTIN_SCATTERSIV8DF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatterdiv16sf",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8SF_INT,
  	       IX86_BUILTIN_SCATTERDIV16SF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatterdiv8df",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8DF_INT,
  	       IX86_BUILTIN_SCATTERDIV8DF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scattersiv16si",
  	       VOID_FTYPE_PVOID_HI_V16SI_V16SI_INT,
  	       IX86_BUILTIN_SCATTERSIV16SI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scattersiv8di",
  	       VOID_FTYPE_PVOID_QI_V8SI_V8DI_INT,
  	       IX86_BUILTIN_SCATTERSIV8DI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatterdiv16si",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8SI_INT,
  	       IX86_BUILTIN_SCATTERDIV16SI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatterdiv8di",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8DI_INT,
  	       IX86_BUILTIN_SCATTERDIV8DI);
--- 801,902 ----
  		    IX86_BUILTIN_GATHERALTDIV8SI);
  
    /* AVX512F */
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gathersiv16sf",
  		    V16SF_FTYPE_V16SF_PCVOID_V16SI_HI_INT,
  		    IX86_BUILTIN_GATHER3SIV16SF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gathersiv8df",
  		    V8DF_FTYPE_V8DF_PCVOID_V8SI_QI_INT,
  		    IX86_BUILTIN_GATHER3SIV8DF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gatherdiv16sf",
  		    V8SF_FTYPE_V8SF_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV16SF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gatherdiv8df",
  		    V8DF_FTYPE_V8DF_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV8DF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gathersiv16si",
  		    V16SI_FTYPE_V16SI_PCVOID_V16SI_HI_INT,
  		    IX86_BUILTIN_GATHER3SIV16SI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gathersiv8di",
  		    V8DI_FTYPE_V8DI_PCVOID_V8SI_QI_INT,
  		    IX86_BUILTIN_GATHER3SIV8DI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gatherdiv16si",
  		    V8SI_FTYPE_V8SI_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV16SI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gatherdiv8di",
  		    V8DI_FTYPE_V8DI_PCVOID_V8DI_QI_INT,
  		    IX86_BUILTIN_GATHER3DIV8DI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gather3altsiv8df ",
  		    V8DF_FTYPE_V8DF_PCDOUBLE_V16SI_QI_INT,
  		    IX86_BUILTIN_GATHER3ALTSIV8DF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gather3altdiv16sf ",
  		    V16SF_FTYPE_V16SF_PCFLOAT_V8DI_HI_INT,
  		    IX86_BUILTIN_GATHER3ALTDIV16SF);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gather3altsiv8di ",
  		    V8DI_FTYPE_V8DI_PCINT64_V16SI_QI_INT,
  		    IX86_BUILTIN_GATHER3ALTSIV8DI);
  
!   def_builtin_pure (OPTION_MASK_ISA_AVX512F, 0,
  		    "__builtin_ia32_gather3altdiv16si ",
  		    V16SI_FTYPE_V16SI_PCINT_V8DI_HI_INT,
  		    IX86_BUILTIN_GATHER3ALTDIV16SI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scattersiv16sf",
  	       VOID_FTYPE_PVOID_HI_V16SI_V16SF_INT,
  	       IX86_BUILTIN_SCATTERSIV16SF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scattersiv8df",
  	       VOID_FTYPE_PVOID_QI_V8SI_V8DF_INT,
  	       IX86_BUILTIN_SCATTERSIV8DF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatterdiv16sf",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8SF_INT,
  	       IX86_BUILTIN_SCATTERDIV16SF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatterdiv8df",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8DF_INT,
  	       IX86_BUILTIN_SCATTERDIV8DF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scattersiv16si",
  	       VOID_FTYPE_PVOID_HI_V16SI_V16SI_INT,
  	       IX86_BUILTIN_SCATTERSIV16SI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scattersiv8di",
  	       VOID_FTYPE_PVOID_QI_V8SI_V8DI_INT,
  	       IX86_BUILTIN_SCATTERSIV8DI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatterdiv16si",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8SI_INT,
  	       IX86_BUILTIN_SCATTERDIV16SI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatterdiv8di",
  	       VOID_FTYPE_PVOID_QI_V8DI_V8DI_INT,
  	       IX86_BUILTIN_SCATTERDIV8DI);
*************** ix86_init_mmx_sse_builtins (void)
*** 1046,1067 ****
  	       VOID_FTYPE_PVOID_QI_V2DI_V2DI_INT,
  	       IX86_BUILTIN_SCATTERDIV2DI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatteraltsiv8df ",
  	       VOID_FTYPE_PDOUBLE_QI_V16SI_V8DF_INT,
  	       IX86_BUILTIN_SCATTERALTSIV8DF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatteraltdiv16sf ",
  	       VOID_FTYPE_PFLOAT_HI_V8DI_V16SF_INT,
  	       IX86_BUILTIN_SCATTERALTDIV16SF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatteraltsiv8di ",
  	       VOID_FTYPE_PLONGLONG_QI_V16SI_V8DI_INT,
  	       IX86_BUILTIN_SCATTERALTSIV8DI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, OPTION_MASK_ISA2_EVEX512,
  	       "__builtin_ia32_scatteraltdiv16si ",
  	       VOID_FTYPE_PINT_HI_V8DI_V16SI_INT,
  	       IX86_BUILTIN_SCATTERALTDIV16SI);
--- 1046,1067 ----
  	       VOID_FTYPE_PVOID_QI_V2DI_V2DI_INT,
  	       IX86_BUILTIN_SCATTERDIV2DI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatteraltsiv8df ",
  	       VOID_FTYPE_PDOUBLE_QI_V16SI_V8DF_INT,
  	       IX86_BUILTIN_SCATTERALTSIV8DF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatteraltdiv16sf ",
  	       VOID_FTYPE_PFLOAT_HI_V8DI_V16SF_INT,
  	       IX86_BUILTIN_SCATTERALTDIV16SF);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatteraltsiv8di ",
  	       VOID_FTYPE_PLONGLONG_QI_V16SI_V8DI_INT,
  	       IX86_BUILTIN_SCATTERALTSIV8DI);
  
!   def_builtin (OPTION_MASK_ISA_AVX512F, 0,
  	       "__builtin_ia32_scatteraltdiv16si ",
  	       VOID_FTYPE_PINT_HI_V8DI_V16SI_INT,
  	       IX86_BUILTIN_SCATTERALTDIV16SI);
*************** ix86_vectorize_builtin_gather (const_tre
*** 1676,1682 ****
    enum ix86_builtins code;
    const machine_mode mode = TYPE_MODE (TREE_TYPE (mem_vectype));
  
!   if ((!TARGET_AVX512F || !TARGET_EVEX512) && GET_MODE_SIZE (mode) == 64)
      return NULL_TREE;
  
    if (! TARGET_AVX2
--- 1676,1682 ----
    enum ix86_builtins code;
    const machine_mode mode = TYPE_MODE (TREE_TYPE (mem_vectype));
  
!   if (!TARGET_AVX512F && GET_MODE_SIZE (mode) == 64)
      return NULL_TREE;
  
    if (! TARGET_AVX2
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386-c.cc gcc-16-20250525/gcc/config/i386/i386-c.cc
*** gcc-16-20250518/gcc/config/i386/i386-c.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386-c.cc	Sun May 25 22:32:05 2025
*************** ix86_target_macros_internal (HOST_WIDE_I
*** 729,740 ****
      def_or_undef (parse_in, "__SHA512__");
    if (isa_flag2 & OPTION_MASK_ISA2_SM4)
      def_or_undef (parse_in, "__SM4__");
-   if (isa_flag2 & OPTION_MASK_ISA2_EVEX512)
-     def_or_undef (parse_in, "__EVEX512__");
    if (isa_flag2 & OPTION_MASK_ISA2_USER_MSR)
      def_or_undef (parse_in, "__USER_MSR__");
-   if (isa_flag2 & OPTION_MASK_ISA2_AVX10_1_256)
-     def_or_undef (parse_in, "__AVX10_1_256__");
    if (isa_flag2 & OPTION_MASK_ISA2_AVX10_1)
      def_or_undef (parse_in, "__AVX10_1__");
    if (isa_flag2 & OPTION_MASK_ISA2_APX_F)
--- 729,736 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386-expand.cc gcc-16-20250525/gcc/config/i386/i386-expand.cc
*** gcc-16-20250518/gcc/config/i386/i386-expand.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386-expand.cc	Sun May 25 22:32:05 2025
*************** ix86_valid_mask_cmp_mode (machine_mode m
*** 4188,4194 ****
    if ((inner_mode == QImode || inner_mode == HImode) && !TARGET_AVX512BW)
      return false;
  
!   return (vector_size == 64 && TARGET_EVEX512) || TARGET_AVX512VL;
  }
  
  /* Return true if integer mask comparison should be used.  */
--- 4188,4194 ----
    if ((inner_mode == QImode || inner_mode == HImode) && !TARGET_AVX512BW)
      return false;
  
!   return vector_size == 64 || TARGET_AVX512VL;
  }
  
  /* Return true if integer mask comparison should be used.  */
*************** ix86_expand_int_sse_cmp (rtx dest, enum
*** 5026,5032 ****
  	      && GET_MODE_SIZE (GET_MODE_INNER (mode)) >= 4
  	      /* Don't do it if not using integer masks and we'd end up with
  		 the right values in the registers though.  */
! 	      && ((GET_MODE_SIZE (mode) == 64 && TARGET_EVEX512)
  		  || !vector_all_ones_operand (optrue, data_mode)
  		  || opfalse != CONST0_RTX (data_mode))))
  	{
--- 5026,5032 ----
  	      && GET_MODE_SIZE (GET_MODE_INNER (mode)) >= 4
  	      /* Don't do it if not using integer masks and we'd end up with
  		 the right values in the registers though.  */
! 	      && (GET_MODE_SIZE (mode) == 64
  		  || !vector_all_ones_operand (optrue, data_mode)
  		  || opfalse != CONST0_RTX (data_mode))))
  	{
*************** ix86_vector_duplicate_simode_const (mach
*** 16189,16195 ****
      {
      case VEC_BCAST_PXOR:
        if ((mode == V8SImode && !TARGET_AVX2)
! 	  || (mode == V16SImode && !(TARGET_AVX512F && TARGET_EVEX512)))
  	return false;
        emit_move_insn (target, CONST0_RTX (mode));
        return true;
--- 16189,16195 ----
      {
      case VEC_BCAST_PXOR:
        if ((mode == V8SImode && !TARGET_AVX2)
! 	  || (mode == V16SImode && !TARGET_AVX512F))
  	return false;
        emit_move_insn (target, CONST0_RTX (mode));
        return true;
*************** ix86_vector_duplicate_simode_const (mach
*** 16197,16203 ****
      case VEC_BCAST_PCMPEQ:
        if ((mode == V4SImode && !TARGET_SSE2)
  	  || (mode == V8SImode && !TARGET_AVX2)
! 	  || (mode == V16SImode && !(TARGET_AVX512F && TARGET_EVEX512)))
  	return false;
        emit_move_insn (target, CONSTM1_RTX (mode));
        return true;
--- 16197,16203 ----
      case VEC_BCAST_PCMPEQ:
        if ((mode == V4SImode && !TARGET_SSE2)
  	  || (mode == V8SImode && !TARGET_AVX2)
! 	  || (mode == V16SImode && !TARGET_AVX512F))
  	return false;
        emit_move_insn (target, CONSTM1_RTX (mode));
        return true;
*************** ix86_vector_duplicate_simode_const (mach
*** 16217,16223 ****
  	  tmp2 = gen_reg_rtx (V32QImode);
  	  emit_insn (gen_absv32qi2 (tmp2, tmp1));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW && TARGET_EVEX512)
  	{
  	  tmp1 = gen_reg_rtx (V64QImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V64QImode));
--- 16217,16223 ----
  	  tmp2 = gen_reg_rtx (V32QImode);
  	  emit_insn (gen_absv32qi2 (tmp2, tmp1));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW)
  	{
  	  tmp1 = gen_reg_rtx (V64QImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V64QImode));
*************** ix86_vector_duplicate_simode_const (mach
*** 16243,16249 ****
  	  tmp2 = gen_reg_rtx (V32QImode);
  	  emit_insn (gen_addv32qi3 (tmp2, tmp1, tmp1));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW && TARGET_EVEX512)
  	{
  	  tmp1 = gen_reg_rtx (V64QImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V64QImode));
--- 16243,16249 ----
  	  tmp2 = gen_reg_rtx (V32QImode);
  	  emit_insn (gen_addv32qi3 (tmp2, tmp1, tmp1));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW)
  	{
  	  tmp1 = gen_reg_rtx (V64QImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V64QImode));
*************** ix86_vector_duplicate_simode_const (mach
*** 16269,16275 ****
  	  tmp2 = gen_reg_rtx (V16HImode);
  	  emit_insn (gen_lshrv16hi3 (tmp2, tmp1, GEN_INT (entry->arg)));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW && TARGET_EVEX512)
  	{
  	  tmp1 = gen_reg_rtx (V32HImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V32HImode));
--- 16269,16275 ----
  	  tmp2 = gen_reg_rtx (V16HImode);
  	  emit_insn (gen_lshrv16hi3 (tmp2, tmp1, GEN_INT (entry->arg)));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW)
  	{
  	  tmp1 = gen_reg_rtx (V32HImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V32HImode));
*************** ix86_vector_duplicate_simode_const (mach
*** 16295,16301 ****
  	  emit_insn (gen_lshrv8si3 (target, tmp1, GEN_INT (entry->arg)));
  	  return true;
  	}
!       else if (mode == V16SImode && TARGET_AVX512F && TARGET_EVEX512)
  	{
  	  tmp1 = gen_reg_rtx (V16SImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V16SImode));
--- 16295,16301 ----
  	  emit_insn (gen_lshrv8si3 (target, tmp1, GEN_INT (entry->arg)));
  	  return true;
  	}
!       else if (mode == V16SImode && TARGET_AVX512F)
  	{
  	  tmp1 = gen_reg_rtx (V16SImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V16SImode));
*************** ix86_vector_duplicate_simode_const (mach
*** 16321,16327 ****
  	  tmp2 = gen_reg_rtx (V16HImode);
  	  emit_insn (gen_ashlv16hi3 (tmp2, tmp1, GEN_INT (entry->arg)));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW && TARGET_EVEX512)
  	{
  	  tmp1 = gen_reg_rtx (V32HImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V32HImode));
--- 16321,16327 ----
  	  tmp2 = gen_reg_rtx (V16HImode);
  	  emit_insn (gen_ashlv16hi3 (tmp2, tmp1, GEN_INT (entry->arg)));
  	}
!       else if (mode == V16SImode && TARGET_AVX512BW)
  	{
  	  tmp1 = gen_reg_rtx (V32HImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V32HImode));
*************** ix86_vector_duplicate_simode_const (mach
*** 16347,16353 ****
  	  emit_insn (gen_ashlv8si3 (target, tmp1, GEN_INT (entry->arg)));
  	  return true;
  	}
!       else if (mode == V16SImode && TARGET_AVX512F && TARGET_EVEX512)
  	{
  	  tmp1 = gen_reg_rtx (V16SImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V16SImode));
--- 16347,16353 ----
  	  emit_insn (gen_ashlv8si3 (target, tmp1, GEN_INT (entry->arg)));
  	  return true;
  	}
!       else if (mode == V16SImode && TARGET_AVX512F)
  	{
  	  tmp1 = gen_reg_rtx (V16SImode);
  	  emit_move_insn (tmp1, CONSTM1_RTX (V16SImode));
*************** ix86_expand_vector_init_duplicate (bool
*** 16717,16723 ****
  
      case E_V32HFmode:
      case E_V32BFmode:
-       gcc_assert (TARGET_EVEX512);
        if (TARGET_AVX512BW)
  	return ix86_vector_duplicate_value (mode, target, val);
        else
--- 16717,16722 ----
*************** ix86_expand_vector_init_one_nonzero (boo
*** 16770,16778 ****
    bool use_vector_set = false;
    rtx (*gen_vec_set_0) (rtx, rtx, rtx) = NULL;
  
-   if (GET_MODE_SIZE (mode) == 64 && !TARGET_EVEX512)
-     return false;
- 
    switch (mode)
      {
      case E_V2DImode:
--- 16769,16774 ----
*************** ix86_emit_swsqrtsf (rtx res, rtx a, mach
*** 19434,19440 ****
  
    unsigned vector_size = GET_MODE_SIZE (mode);
    if (TARGET_FMA
!       || (TARGET_AVX512F && TARGET_EVEX512 && vector_size == 64)
        || (TARGET_AVX512VL && (vector_size == 32 || vector_size == 16)))
      emit_insn (gen_rtx_SET (e2,
  			    gen_rtx_FMA (mode, e0, x0, mthree)));
--- 19430,19436 ----
  
    unsigned vector_size = GET_MODE_SIZE (mode);
    if (TARGET_FMA
!       || (TARGET_AVX512F && vector_size == 64)
        || (TARGET_AVX512VL && (vector_size == 32 || vector_size == 16)))
      emit_insn (gen_rtx_SET (e2,
  			    gen_rtx_FMA (mode, e0, x0, mthree)));
*************** ix86_vectorize_vec_perm_const (machine_m
*** 24360,24368 ****
    unsigned int i, nelt, which;
    bool two_args;
  
-   if (GET_MODE_SIZE (vmode) == 64 && !TARGET_EVEX512)
-     return false;
- 
    /* For HF and BF mode vector, convert it to HI using subreg.  */
    if (GET_MODE_INNER (vmode) == HFmode || GET_MODE_INNER (vmode) == BFmode)
      {
--- 24356,24361 ----
*************** ix86_expand_vecop_qihi2 (enum rtx_code c
*** 24904,24910 ****
       ix86_expand_vecop_qihi.  */
    if (!TARGET_AVX512BW
        || (qimode == V16QImode && !TARGET_AVX512VL)
-       || (qimode == V32QImode && !TARGET_EVEX512)
        /* There are no V64HImode instructions.  */
        || qimode == V64QImode)
       return false;
--- 24897,24902 ----
*************** ix86_expand_sse2_mulvxdi3 (rtx op0, rtx
*** 25373,25379 ****
    machine_mode mode = GET_MODE (op0);
    rtx t1, t2, t3, t4, t5, t6;
  
!   if (TARGET_AVX512DQ && TARGET_EVEX512 && mode == V8DImode)
      emit_insn (gen_avx512dq_mulv8di3 (op0, op1, op2));
    else if (TARGET_AVX512DQ && TARGET_AVX512VL && mode == V4DImode)
      emit_insn (gen_avx512dq_mulv4di3 (op0, op1, op2));
--- 25365,25371 ----
    machine_mode mode = GET_MODE (op0);
    rtx t1, t2, t3, t4, t5, t6;
  
!   if (TARGET_AVX512DQ && mode == V8DImode)
      emit_insn (gen_avx512dq_mulv8di3 (op0, op1, op2));
    else if (TARGET_AVX512DQ && TARGET_AVX512VL && mode == V4DImode)
      emit_insn (gen_avx512dq_mulv4di3 (op0, op1, op2));
*************** ix86_gen_bcst_mem (machine_mode mode, rt
*** 26202,26209 ****
  {
    if (!TARGET_AVX512F
        || !CONST_VECTOR_P (x)
!       || (!TARGET_AVX512VL
! 	  && (GET_MODE_SIZE (mode) != 64 || !TARGET_EVEX512))
        || !VALID_BCST_MODE_P (GET_MODE_INNER (mode))
  	 /* Disallow HFmode broadcast.  */
        || GET_MODE_SIZE (GET_MODE_INNER (mode)) < 4)
--- 26194,26200 ----
  {
    if (!TARGET_AVX512F
        || !CONST_VECTOR_P (x)
!       || (!TARGET_AVX512VL && GET_MODE_SIZE (mode) != 64)
        || !VALID_BCST_MODE_P (GET_MODE_INNER (mode))
  	 /* Disallow HFmode broadcast.  */
        || GET_MODE_SIZE (GET_MODE_INNER (mode)) < 4)
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386-isa.def gcc-16-20250525/gcc/config/i386/i386-isa.def
*** gcc-16-20250518/gcc/config/i386/i386-isa.def	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386-isa.def	Sun May 25 22:32:05 2025
*************** DEF_PTA(SHA512)
*** 118,125 ****
  DEF_PTA(SM4)
  DEF_PTA(APX_F)
  DEF_PTA(USER_MSR)
- DEF_PTA(EVEX512)
- DEF_PTA(AVX10_1_256)
  DEF_PTA(AVX10_1)
  DEF_PTA(AVX10_2)
  DEF_PTA(AMX_AVX512)
--- 118,123 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386-options.cc gcc-16-20250525/gcc/config/i386/i386-options.cc
*** gcc-16-20250518/gcc/config/i386/i386-options.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386-options.cc	Sun May 25 22:32:05 2025
*************** static struct ix86_target_opts isa2_opts
*** 259,267 ****
    { "-msm3",		OPTION_MASK_ISA2_SM3 },
    { "-msha512",		OPTION_MASK_ISA2_SHA512 },
    { "-msm4",            OPTION_MASK_ISA2_SM4 },
-   { "-mevex512",	OPTION_MASK_ISA2_EVEX512 },
    { "-musermsr",	OPTION_MASK_ISA2_USER_MSR },
-   { "-mavx10.1-256",	OPTION_MASK_ISA2_AVX10_1_256 },
    { "-mavx10.1",	OPTION_MASK_ISA2_AVX10_1 },
    { "-mavx10.2",	OPTION_MASK_ISA2_AVX10_2 },
    { "-mamx-avx512",	OPTION_MASK_ISA2_AMX_AVX512 },
--- 259,265 ----
*************** ix86_function_specific_save (struct cl_t
*** 713,720 ****
    ptr->x_ix86_apx_features = opts->x_ix86_apx_features;
    ptr->x_ix86_isa_flags_explicit = opts->x_ix86_isa_flags_explicit;
    ptr->x_ix86_isa_flags2_explicit = opts->x_ix86_isa_flags2_explicit;
-   ptr->x_ix86_no_avx512_explicit = opts->x_ix86_no_avx512_explicit;
-   ptr->x_ix86_no_avx10_1_explicit = opts->x_ix86_no_avx10_1_explicit;
    ptr->x_recip_mask_explicit = opts->x_recip_mask_explicit;
    ptr->x_ix86_arch_string = opts->x_ix86_arch_string;
    ptr->x_ix86_tune_string = opts->x_ix86_tune_string;
--- 711,716 ----
*************** ix86_function_specific_restore (struct g
*** 858,865 ****
    opts->x_ix86_apx_features = ptr->x_ix86_apx_features;
    opts->x_ix86_isa_flags_explicit = ptr->x_ix86_isa_flags_explicit;
    opts->x_ix86_isa_flags2_explicit = ptr->x_ix86_isa_flags2_explicit;
-   opts->x_ix86_no_avx512_explicit = ptr->x_ix86_no_avx512_explicit;
-   opts->x_ix86_no_avx10_1_explicit = ptr->x_ix86_no_avx10_1_explicit;
    opts->x_recip_mask_explicit = ptr->x_recip_mask_explicit;
    opts->x_ix86_arch_string = ptr->x_ix86_arch_string;
    opts->x_ix86_tune_string = ptr->x_ix86_tune_string;
--- 854,859 ----
*************** ix86_valid_target_attribute_inner_p (tre
*** 1131,1141 ****
      IX86_ATTR_ISA ("sha512", OPT_msha512),
      IX86_ATTR_ISA ("sm4", OPT_msm4),
      IX86_ATTR_ISA ("apxf", OPT_mapxf),
-     IX86_ATTR_ISA ("evex512", OPT_mevex512),
      IX86_ATTR_ISA ("usermsr", OPT_musermsr),
-     IX86_ATTR_ISA ("avx10.1-256", OPT_mavx10_1_256),
      IX86_ATTR_ISA ("avx10.1", OPT_mavx10_1),
-     IX86_ATTR_ISA ("avx10.1-512", OPT_mavx10_1),
      IX86_ATTR_ISA ("avx10.2", OPT_mavx10_2),
      IX86_ATTR_ISA ("amx-avx512", OPT_mamx_avx512),
      IX86_ATTR_ISA ("amx-tf32", OPT_mamx_tf32),
--- 1125,1132 ----
*************** ix86_valid_target_attribute_tree (tree f
*** 1429,1446 ****
  					    target_clone_attr))
      return error_mark_node;
  
-   /* AVX10.1-256 will enable only 256 bit AVX512F features by setting all
-      AVX512 related ISA flags and not setting EVEX512.  When it is used
-      with avx512 related function attribute, we need to enable 512 bit to
-      align with the command line behavior.  Manually set EVEX512 for this
-      scenario.  */
-   if ((def->x_ix86_isa_flags2 & OPTION_MASK_ISA2_AVX10_1_256)
-       && (opts->x_ix86_isa_flags & OPTION_MASK_ISA_AVX512F)
-       && (opts->x_ix86_isa_flags_explicit & OPTION_MASK_ISA_AVX512F)
-       && !(def->x_ix86_isa_flags2_explicit & OPTION_MASK_ISA2_EVEX512)
-       && !(opts->x_ix86_isa_flags2_explicit & OPTION_MASK_ISA2_EVEX512))
-     opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_EVEX512;
- 
    /* If the changed options are different from the default, rerun
       ix86_option_override_internal, and then save the options away.
       The string options are attribute options, and will be undone
--- 1420,1425 ----
*************** ix86_valid_target_attribute_tree (tree f
*** 1451,1460 ****
        || option_strings[IX86_FUNCTION_SPECIFIC_ARCH]
        || option_strings[IX86_FUNCTION_SPECIFIC_TUNE]
        || enum_opts_set.x_ix86_fpmath
!       || enum_opts_set.x_prefer_vector_width_type
!       || (!(def->x_ix86_isa_flags2_explicit & OPTION_MASK_ISA2_AVX10_1_256)
! 	  && (opts->x_ix86_isa_flags2_explicit
! 	      & OPTION_MASK_ISA2_AVX10_1_256)))
      {
        /* If we are using the default tune= or arch=, undo the string assigned,
  	 and use the default.  */
--- 1430,1436 ----
        || option_strings[IX86_FUNCTION_SPECIFIC_ARCH]
        || option_strings[IX86_FUNCTION_SPECIFIC_TUNE]
        || enum_opts_set.x_ix86_fpmath
!       || enum_opts_set.x_prefer_vector_width_type)
      {
        /* If we are using the default tune= or arch=, undo the string assigned,
  	 and use the default.  */
*************** ix86_option_override_internal (bool main
*** 2018,2024 ****
  			       struct gcc_options *opts_set)
  {
    unsigned int i;
!   unsigned HOST_WIDE_INT ix86_arch_mask, avx512_isa_flags, avx512_isa_flags2;
    const bool ix86_tune_specified = (opts->x_ix86_tune_string != NULL);
  
    /* -mrecip options.  */
--- 1994,2000 ----
  			       struct gcc_options *opts_set)
  {
    unsigned int i;
!   unsigned HOST_WIDE_INT ix86_arch_mask;
    const bool ix86_tune_specified = (opts->x_ix86_tune_string != NULL);
  
    /* -mrecip options.  */
*************** ix86_option_override_internal (bool main
*** 2037,2051 ****
        { "vec-sqrt",  RECIP_MASK_VEC_SQRT },
      };
  
-   avx512_isa_flags = OPTION_MASK_ISA_AVX512F | OPTION_MASK_ISA_AVX512CD
-     | OPTION_MASK_ISA_AVX512DQ | OPTION_MASK_ISA_AVX512BW
-     | OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_AVX512IFMA
-     | OPTION_MASK_ISA_AVX512VBMI | OPTION_MASK_ISA_AVX512VBMI2
-     | OPTION_MASK_ISA_AVX512VNNI | OPTION_MASK_ISA_AVX512VPOPCNTDQ
-     | OPTION_MASK_ISA_AVX512BITALG;
-   avx512_isa_flags2 = OPTION_MASK_ISA2_AVX512FP16
-     | OPTION_MASK_ISA2_AVX512BF16;
- 
    /* Turn off both OPTION_MASK_ABI_64 and OPTION_MASK_ABI_X32 if
       TARGET_64BIT_DEFAULT is true and TARGET_64BIT is false.  */
    if (TARGET_64BIT_DEFAULT && !TARGET_64BIT_P (opts->x_ix86_isa_flags))
--- 2013,2018 ----
*************** ix86_option_override_internal (bool main
*** 2667,2773 ****
        &= ~((OPTION_MASK_ISA_BMI | OPTION_MASK_ISA_BMI2 | OPTION_MASK_ISA_TBM)
  	   & ~opts->x_ix86_isa_flags_explicit);
  
-   /* Emit a warning if AVX10.1 options is used with AVX512/EVEX512 options except
-      for the following option combinations:
-      1. Both AVX10.1-512 and AVX512 with 512 bit vector width are enabled with no
- 	explicit disable on other AVX512 features.
-      2. Both AVX10.1-256 and AVX512 w/o 512 bit vector width are enabled with no
- 	explicit disable on other AVX512 features.
-      3. Both AVX10.1 and AVX512 are disabled.  */
-   if (TARGET_AVX10_1_P (opts->x_ix86_isa_flags2))
-     {
-       if (opts->x_ix86_no_avx512_explicit
- 	  && (((~(avx512_isa_flags & opts->x_ix86_isa_flags)
- 	       & (avx512_isa_flags & opts->x_ix86_isa_flags_explicit)))
- 	      || ((~((avx512_isa_flags2 | OPTION_MASK_ISA2_EVEX512)
- 		     & opts->x_ix86_isa_flags2)
- 		   & ((avx512_isa_flags2 | OPTION_MASK_ISA2_EVEX512)
- 		      & opts->x_ix86_isa_flags2_explicit)))))
- 	warning (0, "%<-mno-evex512%> or %<-mno-avx512XXX%> cannot disable "
- 		    "AVX10 instructions when AVX10.1-512 is available in GCC 15, "
- 		    "behavior will change to it will disable that part of "
- 		    "AVX512 instructions since GCC 16");
-     }
-   else if (TARGET_AVX10_1_256_P (opts->x_ix86_isa_flags2))
-     {
-       if (TARGET_EVEX512_P (opts->x_ix86_isa_flags2)
- 	  && (OPTION_MASK_ISA2_EVEX512 & opts->x_ix86_isa_flags2_explicit))
- 	{
- 	  if (!TARGET_AVX512F_P (opts->x_ix86_isa_flags)
- 	      || !(OPTION_MASK_ISA_AVX512F & opts->x_ix86_isa_flags_explicit))
- 	    {
- 	      /* We should not emit 512 bit instructions under AVX10.1-256
- 		 when EVEX512 is enabled w/o any AVX512 features enabled.
- 		 Disable EVEX512 bit for this.  */
- 	      warning (0, "Using %<-mevex512%> without any AVX512 features "
- 			  "enabled together with AVX10.1 only will not enable "
- 			  "any AVX512 or AVX10.1-512 features, using 256 as "
- 			  "max vector size");
- 	      opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA2_EVEX512;
- 	    }
- 	  else
- 	    warning (0, "Vector size conflicts between AVX10.1 and AVX512, "
- 			"using 512 as max vector size");
- 	}
-       else if (TARGET_AVX512F_P (opts->x_ix86_isa_flags)
- 	       && (opts->x_ix86_isa_flags_explicit & OPTION_MASK_ISA_AVX512F)
- 	       && !(OPTION_MASK_ISA2_EVEX512
- 		    & opts->x_ix86_isa_flags2_explicit))
- 	warning (0, "Vector size conflicts between AVX10.1 and AVX512, using "
- 		    "512 as max vector size");
-       else if (opts->x_ix86_no_avx512_explicit
- 	       && (((~(avx512_isa_flags & opts->x_ix86_isa_flags)
- 		    & (avx512_isa_flags & opts->x_ix86_isa_flags_explicit)))
- 		   || ((~(avx512_isa_flags2 & opts->x_ix86_isa_flags2)
- 			& (avx512_isa_flags2
- 			   & opts->x_ix86_isa_flags2_explicit)))))
- 	warning (0, "%<-mno-avx512XXX%> cannot disable AVX10 instructions "
- 		    "when AVX10 is available in GCC 15, behavior will change "
- 		    "to it will disable that part of AVX512 instructions since "
- 		    "GCC 16");
-     }
-   else if (TARGET_AVX512F_P (opts->x_ix86_isa_flags)
- 	   && (OPTION_MASK_ISA_AVX512F & opts->x_ix86_isa_flags_explicit))
-     {
-       if (opts->x_ix86_no_avx10_1_explicit
- 	  && ((OPTION_MASK_ISA2_AVX10_1_256 | OPTION_MASK_ISA2_AVX10_1)
- 	      & opts->x_ix86_isa_flags2_explicit))
- 	{
- 	  warning (0, "%<-mno-avx10.1-256, -mno-avx10.1-512%> cannot disable "
- 		      "AVX512 instructions when %<-mavx512XXX%> in GCC 15, "
- 		      "behavior will change to it will disable all the "
- 		      "instructions in GCC 16");
- 	  /* Reset those unset AVX512 flags set by AVX10 options when AVX10 is
- 	     disabled.  */
- 	  if (OPTION_MASK_ISA2_AVX10_1_256 & opts->x_ix86_isa_flags2_explicit)
- 	    {
- 	      opts->x_ix86_isa_flags = (~avx512_isa_flags
- 					& opts->x_ix86_isa_flags)
- 		| (avx512_isa_flags & opts->x_ix86_isa_flags
- 		   & opts->x_ix86_isa_flags_explicit);
- 	      opts->x_ix86_isa_flags2 = (~avx512_isa_flags2
- 					 & opts->x_ix86_isa_flags2)
- 		| (avx512_isa_flags2 & opts->x_ix86_isa_flags2
- 		   & opts->x_ix86_isa_flags2_explicit);
- 	    }
- 	}
-     }
- 
-   /* Set EVEX512 if one of the following conditions meets:
-      1. AVX512 is enabled while EVEX512 is not explicitly set/unset.
-      2. AVX10.1-512 is enabled.  */
-   if (TARGET_AVX10_1_P (opts->x_ix86_isa_flags2)
-       || (TARGET_AVX512F_P (opts->x_ix86_isa_flags)
- 	  && !(opts->x_ix86_isa_flags2_explicit & OPTION_MASK_ISA2_EVEX512)))
-     opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA2_EVEX512;
- 
-   /* Enable all AVX512 related ISAs when AVX10.1 is enabled.  */
-   if (TARGET_AVX10_1_256_P (opts->x_ix86_isa_flags2))
-     {
-       opts->x_ix86_isa_flags |= avx512_isa_flags;
-       opts->x_ix86_isa_flags2 |= avx512_isa_flags2;
-     }
- 
    /* Validate -mpreferred-stack-boundary= value or default it to
       PREFERRED_STACK_BOUNDARY_DEFAULT.  */
    ix86_preferred_stack_boundary = PREFERRED_STACK_BOUNDARY_DEFAULT;
--- 2634,2639 ----
*************** ix86_option_override_internal (bool main
*** 3042,3049 ****
  	  opts->x_ix86_move_max = opts->x_prefer_vector_width_type;
  	  if (opts_set->x_ix86_move_max == PVW_NONE)
  	    {
! 	      if (TARGET_AVX512F_P (opts->x_ix86_isa_flags)
! 		  && TARGET_EVEX512_P (opts->x_ix86_isa_flags2))
  		opts->x_ix86_move_max = PVW_AVX512;
  	      /* Align with vectorizer to avoid potential STLF issue.  */
  	      else if (TARGET_AVX_P (opts->x_ix86_isa_flags))
--- 2908,2914 ----
  	  opts->x_ix86_move_max = opts->x_prefer_vector_width_type;
  	  if (opts_set->x_ix86_move_max == PVW_NONE)
  	    {
! 	      if (TARGET_AVX512F_P (opts->x_ix86_isa_flags))
  		opts->x_ix86_move_max = PVW_AVX512;
  	      /* Align with vectorizer to avoid potential STLF issue.  */
  	      else if (TARGET_AVX_P (opts->x_ix86_isa_flags))
*************** ix86_option_override_internal (bool main
*** 3069,3076 ****
  	  opts->x_ix86_store_max = opts->x_prefer_vector_width_type;
  	  if (opts_set->x_ix86_store_max == PVW_NONE)
  	    {
! 	      if (TARGET_AVX512F_P (opts->x_ix86_isa_flags)
! 		  && TARGET_EVEX512_P (opts->x_ix86_isa_flags2))
  		opts->x_ix86_store_max = PVW_AVX512;
  	      /* Align with vectorizer to avoid potential STLF issue.  */
  	      else if (TARGET_AVX_P (opts->x_ix86_isa_flags))
--- 2934,2940 ----
  	  opts->x_ix86_store_max = opts->x_prefer_vector_width_type;
  	  if (opts_set->x_ix86_store_max == PVW_NONE)
  	    {
! 	      if (TARGET_AVX512F_P (opts->x_ix86_isa_flags))
  		opts->x_ix86_store_max = PVW_AVX512;
  	      /* Align with vectorizer to avoid potential STLF issue.  */
  	      else if (TARGET_AVX_P (opts->x_ix86_isa_flags))
*************** ix86_simd_clone_adjust (struct cgraph_no
*** 3367,3379 ****
      case 'e':
        if (TARGET_PREFER_AVX256)
  	{
! 	  if (!TARGET_AVX512F || !TARGET_EVEX512)
! 	    str = "avx512f,evex512,prefer-vector-width=512";
  	  else
  	    str = "prefer-vector-width=512";
  	}
!       else if (!TARGET_AVX512F || !TARGET_EVEX512)
! 	str = "avx512f,evex512";
        break;
      default:
        gcc_unreachable ();
--- 3231,3243 ----
      case 'e':
        if (TARGET_PREFER_AVX256)
  	{
! 	  if (!TARGET_AVX512F)
! 	    str = "avx512f,prefer-vector-width=512";
  	  else
  	    str = "prefer-vector-width=512";
  	}
!       else if (!TARGET_AVX512F)
! 	str = "avx512f";
        break;
      default:
        gcc_unreachable ();
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386-protos.h gcc-16-20250525/gcc/config/i386/i386-protos.h
*** gcc-16-20250518/gcc/config/i386/i386-protos.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386-protos.h	Sun May 25 22:32:05 2025
*************** extern int ix86_attr_length_vex_default
*** 199,204 ****
--- 199,205 ----
  extern rtx ix86_libcall_value (machine_mode);
  extern bool ix86_function_arg_regno_p (int);
  extern void ix86_asm_output_function_label (FILE *, const char *, tree);
+ extern void ix86_asm_output_labelref (FILE *, const char *, const char *);
  extern void ix86_call_abi_override (const_tree);
  extern int ix86_reg_parm_stack_space (const_tree);
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386.cc gcc-16-20250525/gcc/config/i386/i386.cc
*** gcc-16-20250518/gcc/config/i386/i386.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386.cc	Sun May 25 22:32:05 2025
*************** ix86_asm_output_function_label (FILE *ou
*** 1716,1721 ****
--- 1716,1734 ----
      }
  }
  
+ /* Output a user-defined label.  In AT&T syntax, registers are prefixed
+    with %, so labels require no punctuation.  In Intel syntax, registers
+    are unprefixed, so labels may clash with registers or other operators,
+    and require quoting.  */
+ void
+ ix86_asm_output_labelref (FILE *file, const char *prefix, const char *label)
+ {
+   if (ASSEMBLER_DIALECT == ASM_ATT)
+     fprintf (file, "%s%s", prefix, label);
+   else
+     fprintf (file, "\"%s%s\"", prefix, label);
+ }
+ 
  /* Implementation of call abi switching target hook. Specific to FNDECL
     the specific call register sets are set.  See also
     ix86_conditional_register_usage for more details.  */
*************** type_natural_mode (const_tree type, cons
*** 1997,2004 ****
  	    if (GET_MODE_NUNITS (mode) == TYPE_VECTOR_SUBPARTS (type)
  		&& GET_MODE_INNER (mode) == innermode)
  	      {
! 		if (size == 64 && (!TARGET_AVX512F || !TARGET_EVEX512)
! 		    && !TARGET_IAMCU)
  		  {
  		    static bool warnedavx512f;
  		    static bool warnedavx512f_ret;
--- 2010,2016 ----
  	    if (GET_MODE_NUNITS (mode) == TYPE_VECTOR_SUBPARTS (type)
  		&& GET_MODE_INNER (mode) == innermode)
  	      {
! 		if (size == 64 && !TARGET_AVX512F && !TARGET_IAMCU)
  		  {
  		    static bool warnedavx512f;
  		    static bool warnedavx512f_ret;
*************** ix86_return_in_memory (const_tree type,
*** 4421,4427 ****
  
  	  /* AVX512F values are returned in ZMM0 if available.  */
  	  if (size == 64)
! 	    return !TARGET_AVX512F || !TARGET_EVEX512;
  	}
  
        if (mode == XFmode)
--- 4433,4439 ----
  
  	  /* AVX512F values are returned in ZMM0 if available.  */
  	  if (size == 64)
! 	    return !TARGET_AVX512F;
  	}
  
        if (mode == XFmode)
*************** standard_sse_constant_p (rtx x, machine_
*** 5375,5381 ****
        switch (GET_MODE_SIZE (mode))
  	{
  	case 64:
! 	  if (TARGET_AVX512F && TARGET_EVEX512)
  	    return 2;
  	  break;
  	case 32:
--- 5387,5393 ----
        switch (GET_MODE_SIZE (mode))
  	{
  	case 64:
! 	  if (TARGET_AVX512F)
  	    return 2;
  	  break;
  	case 32:
*************** standard_sse_constant_opcode (rtx_insn *
*** 5428,5437 ****
  	    {
  	      if (TARGET_AVX512VL)
  		return "vpxord\t%x0, %x0, %x0";
- 	      else if (TARGET_EVEX512)
- 		return "vpxord\t%g0, %g0, %g0";
  	      else
! 		gcc_unreachable ();
  	    }
  	  return "vpxor\t%x0, %x0, %x0";
  
--- 5440,5447 ----
  	    {
  	      if (TARGET_AVX512VL)
  		return "vpxord\t%x0, %x0, %x0";
  	      else
! 		return "vpxord\t%g0, %g0, %g0";
  	    }
  	  return "vpxor\t%x0, %x0, %x0";
  
*************** standard_sse_constant_opcode (rtx_insn *
*** 5447,5465 ****
  		{
  		  if (TARGET_AVX512VL)
  		    return "vxorpd\t%x0, %x0, %x0";
- 		  else if (TARGET_EVEX512)
- 		    return "vxorpd\t%g0, %g0, %g0";
  		  else
! 		    gcc_unreachable ();
  		}
  	      else
  		{
  		  if (TARGET_AVX512VL)
  		    return "vpxorq\t%x0, %x0, %x0";
- 		  else if (TARGET_EVEX512)
- 		    return "vpxorq\t%g0, %g0, %g0";
  		  else
! 		    gcc_unreachable ();
  		}
  	    }
  	  return "vxorpd\t%x0, %x0, %x0";
--- 5457,5471 ----
  		{
  		  if (TARGET_AVX512VL)
  		    return "vxorpd\t%x0, %x0, %x0";
  		  else
! 		    return "vxorpd\t%g0, %g0, %g0";
  		}
  	      else
  		{
  		  if (TARGET_AVX512VL)
  		    return "vpxorq\t%x0, %x0, %x0";
  		  else
! 		    return "vpxorq\t%g0, %g0, %g0";
  		}
  	    }
  	  return "vxorpd\t%x0, %x0, %x0";
*************** standard_sse_constant_opcode (rtx_insn *
*** 5476,5494 ****
  		{
  		  if (TARGET_AVX512VL)
  		    return "vxorps\t%x0, %x0, %x0";
- 		  else if (TARGET_EVEX512)
- 		    return "vxorps\t%g0, %g0, %g0";
  		  else
! 		    gcc_unreachable ();
  		}
  	      else
  		{
  		  if (TARGET_AVX512VL)
  		    return "vpxord\t%x0, %x0, %x0";
- 		  else if (TARGET_EVEX512)
- 		    return "vpxord\t%g0, %g0, %g0";
  		  else
! 		    gcc_unreachable ();
  		}
  	    }
  	  return "vxorps\t%x0, %x0, %x0";
--- 5482,5496 ----
  		{
  		  if (TARGET_AVX512VL)
  		    return "vxorps\t%x0, %x0, %x0";
  		  else
! 		    return "vxorps\t%g0, %g0, %g0";
  		}
  	      else
  		{
  		  if (TARGET_AVX512VL)
  		    return "vpxord\t%x0, %x0, %x0";
  		  else
! 		    return "vpxord\t%g0, %g0, %g0";
  		}
  	    }
  	  return "vxorps\t%x0, %x0, %x0";
*************** standard_sse_constant_opcode (rtx_insn *
*** 5509,5515 ****
  	case MODE_XI:
  	case MODE_V8DF:
  	case MODE_V16SF:
! 	  gcc_assert (TARGET_AVX512F && TARGET_EVEX512);
  	  return "vpternlogd\t{$0xFF, %g0, %g0, %g0|%g0, %g0, %g0, 0xFF}";
  
  	case MODE_OI:
--- 5511,5517 ----
  	case MODE_XI:
  	case MODE_V8DF:
  	case MODE_V16SF:
! 	  gcc_assert (TARGET_AVX512F);
  	  return "vpternlogd\t{$0xFF, %g0, %g0, %g0|%g0, %g0, %g0, 0xFF}";
  
  	case MODE_OI:
*************** standard_sse_constant_opcode (rtx_insn *
*** 5525,5534 ****
  	    {
  	      if (TARGET_AVX512VL)
  		return "vpternlogd\t{$0xFF, %0, %0, %0|%0, %0, %0, 0xFF}";
- 	      else if (TARGET_EVEX512)
- 		return "vpternlogd\t{$0xFF, %g0, %g0, %g0|%g0, %g0, %g0, 0xFF}";
  	      else
! 		gcc_unreachable ();
  	    }
  	  return (TARGET_AVX
  		  ? "vpcmpeqd\t%0, %0, %0"
--- 5527,5534 ----
  	    {
  	      if (TARGET_AVX512VL)
  		return "vpternlogd\t{$0xFF, %0, %0, %0|%0, %0, %0, 0xFF}";
  	      else
! 		return "vpternlogd\t{$0xFF, %g0, %g0, %g0|%g0, %g0, %g0, 0xFF}";
  	    }
  	  return (TARGET_AVX
  		  ? "vpcmpeqd\t%0, %0, %0"
*************** standard_sse_constant_opcode (rtx_insn *
*** 5542,5548 ****
      {
        if (GET_MODE_SIZE (mode) == 64)
  	{
! 	  gcc_assert (TARGET_AVX512F && TARGET_EVEX512);
  	  return "vpcmpeqd\t%t0, %t0, %t0";
  	}
        else if (GET_MODE_SIZE (mode) == 32)
--- 5542,5548 ----
      {
        if (GET_MODE_SIZE (mode) == 64)
  	{
! 	  gcc_assert (TARGET_AVX512F);
  	  return "vpcmpeqd\t%t0, %t0, %t0";
  	}
        else if (GET_MODE_SIZE (mode) == 32)
*************** standard_sse_constant_opcode (rtx_insn *
*** 5554,5560 ****
      }
    else if (vector_all_ones_zero_extend_quarter_operand (x, mode))
      {
!       gcc_assert (TARGET_AVX512F && TARGET_EVEX512);
        return "vpcmpeqd\t%x0, %x0, %x0";
      }
  
--- 5554,5560 ----
      }
    else if (vector_all_ones_zero_extend_quarter_operand (x, mode))
      {
!       gcc_assert (TARGET_AVX512F);
        return "vpcmpeqd\t%x0, %x0, %x0";
      }
  
*************** ix86_get_ssemov (rtx *operands, unsigned
*** 5665,5672 ****
  	  || memory_operand (operands[1], mode))
  	gcc_unreachable ();
        size = 64;
-       /* We need TARGET_EVEX512 to move into zmm register.  */
-       gcc_assert (TARGET_EVEX512);
        switch (type)
  	{
  	case opcode_int:
--- 5665,5670 ----
*************** ix86_legitimate_constant_p (machine_mode
*** 11419,11425 ****
  	case E_OImode:
  	case E_XImode:
  	  if (!standard_sse_constant_p (x, mode)
! 	      && GET_MODE_SIZE (TARGET_AVX512F && TARGET_EVEX512
  				? XImode
  				: (TARGET_AVX
  				   ? OImode
--- 11417,11423 ----
  	case E_OImode:
  	case E_XImode:
  	  if (!standard_sse_constant_p (x, mode)
! 	      && GET_MODE_SIZE (TARGET_AVX512F
  				? XImode
  				: (TARGET_AVX
  				   ? OImode
*************** ix86_vectorize_builtin_scatter (const_tr
*** 20316,20329 ****
  {
    bool si;
    enum ix86_builtins code;
-   const machine_mode mode = TYPE_MODE (TREE_TYPE (vectype));
  
    if (!TARGET_AVX512F)
      return NULL_TREE;
  
-   if (!TARGET_EVEX512 && GET_MODE_SIZE (mode) == 64)
-     return NULL_TREE;
- 
    if (known_eq (TYPE_VECTOR_SUBPARTS (vectype), 2u)
        ? !TARGET_USE_SCATTER_2PARTS
        : (known_eq (TYPE_VECTOR_SUBPARTS (vectype), 4u)
--- 20314,20323 ----
*************** ix86_hard_regno_mode_ok (unsigned int re
*** 21445,21451 ****
  	  - any of 512-bit wide vector mode
  	  - any scalar mode.  */
        if (TARGET_AVX512F
! 	  && ((VALID_AVX512F_REG_OR_XI_MODE (mode) && TARGET_EVEX512)
  	      || VALID_AVX512F_SCALAR_MODE (mode)))
  	return true;
  
--- 21439,21445 ----
  	  - any of 512-bit wide vector mode
  	  - any scalar mode.  */
        if (TARGET_AVX512F
! 	  && ((VALID_AVX512F_REG_OR_XI_MODE (mode))
  	      || VALID_AVX512F_SCALAR_MODE (mode)))
  	return true;
  
*************** ix86_set_reg_reg_cost (machine_mode mode
*** 21687,21693 ****
  
      case MODE_VECTOR_INT:
      case MODE_VECTOR_FLOAT:
!       if ((TARGET_AVX512F && TARGET_EVEX512 && VALID_AVX512F_REG_MODE (mode))
  	  || (TARGET_AVX && VALID_AVX256_REG_MODE (mode))
  	  || (TARGET_SSE2 && VALID_SSE2_REG_MODE (mode))
  	  || (TARGET_SSE && VALID_SSE_REG_MODE (mode))
--- 21681,21687 ----
  
      case MODE_VECTOR_INT:
      case MODE_VECTOR_FLOAT:
!       if ((TARGET_AVX512F && VALID_AVX512F_REG_MODE (mode))
  	  || (TARGET_AVX && VALID_AVX256_REG_MODE (mode))
  	  || (TARGET_SSE2 && VALID_SSE2_REG_MODE (mode))
  	  || (TARGET_SSE && VALID_SSE_REG_MODE (mode))
*************** ix86_rtx_costs (rtx x, machine_mode mode
*** 22143,22151 ****
  
    /* Handling different vternlog variants.  */
    if ((GET_MODE_SIZE (mode) == 64
!        ? (TARGET_AVX512F && TARGET_EVEX512)
         : (TARGET_AVX512VL
! 	  || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)))
        && GET_MODE_SIZE (mode) >= 16
        && outer_code_i == SET
        && ternlog_operand (x, mode))
--- 22137,22145 ----
  
    /* Handling different vternlog variants.  */
    if ((GET_MODE_SIZE (mode) == 64
!        ? TARGET_AVX512F
         : (TARGET_AVX512VL
! 	  || (TARGET_AVX512F && !TARGET_PREFER_AVX256)))
        && GET_MODE_SIZE (mode) >= 16
        && outer_code_i == SET
        && ternlog_operand (x, mode))
*************** ix86_rtx_costs (rtx x, machine_mode mode
*** 22494,22501 ****
  	{
  	  /* (ior (not ...) ...) can be a single insn in AVX512.  */
  	  if (GET_CODE (XEXP (x, 0)) == NOT && TARGET_AVX512F
! 	      && ((TARGET_EVEX512
! 		   && GET_MODE_SIZE (mode) == 64)
  		  || (TARGET_AVX512VL
  		      && (GET_MODE_SIZE (mode) == 32
  			  || GET_MODE_SIZE (mode) == 16))))
--- 22488,22494 ----
  	{
  	  /* (ior (not ...) ...) can be a single insn in AVX512.  */
  	  if (GET_CODE (XEXP (x, 0)) == NOT && TARGET_AVX512F
! 	      && (GET_MODE_SIZE (mode) == 64
  		  || (TARGET_AVX512VL
  		      && (GET_MODE_SIZE (mode) == 32
  			  || GET_MODE_SIZE (mode) == 16))))
*************** ix86_rtx_costs (rtx x, machine_mode mode
*** 22586,22593 ****
  
  	      /* (and (not ...) (not ...)) can be a single insn in AVX512.  */
  	      if (GET_CODE (right) == NOT && TARGET_AVX512F
! 		  && ((TARGET_EVEX512
! 		       && GET_MODE_SIZE (mode) == 64)
  		      || (TARGET_AVX512VL
  			  && (GET_MODE_SIZE (mode) == 32
  			      || GET_MODE_SIZE (mode) == 16))))
--- 22579,22585 ----
  
  	      /* (and (not ...) (not ...)) can be a single insn in AVX512.  */
  	      if (GET_CODE (right) == NOT && TARGET_AVX512F
! 		  && (GET_MODE_SIZE (mode) == 64
  		      || (TARGET_AVX512VL
  			  && (GET_MODE_SIZE (mode) == 32
  			      || GET_MODE_SIZE (mode) == 16))))
*************** ix86_rtx_costs (rtx x, machine_mode mode
*** 22657,22664 ****
  	{
  	  /* (not (xor ...)) can be a single insn in AVX512.  */
  	  if (GET_CODE (XEXP (x, 0)) == XOR && TARGET_AVX512F
! 	      && ((TARGET_EVEX512
! 		   && GET_MODE_SIZE (mode) == 64)
  		  || (TARGET_AVX512VL
  		      && (GET_MODE_SIZE (mode) == 32
  			  || GET_MODE_SIZE (mode) == 16))))
--- 22649,22655 ----
  	{
  	  /* (not (xor ...)) can be a single insn in AVX512.  */
  	  if (GET_CODE (XEXP (x, 0)) == XOR && TARGET_AVX512F
! 	      && (GET_MODE_SIZE (mode) == 64
  		  || (TARGET_AVX512VL
  		      && (GET_MODE_SIZE (mode) == 32
  			  || GET_MODE_SIZE (mode) == 16))))
*************** ix86_vector_mode_supported_p (machine_mo
*** 24570,24576 ****
      return true;
    if (TARGET_AVX && VALID_AVX256_REG_MODE (mode))
      return true;
!   if (TARGET_AVX512F && TARGET_EVEX512 && VALID_AVX512F_REG_MODE (mode))
      return true;
    if ((TARGET_MMX || TARGET_MMX_WITH_SSE)
        && VALID_MMX_REG_MODE (mode))
--- 24561,24567 ----
      return true;
    if (TARGET_AVX && VALID_AVX256_REG_MODE (mode))
      return true;
!   if (TARGET_AVX512F && VALID_AVX512F_REG_MODE (mode))
      return true;
    if ((TARGET_MMX || TARGET_MMX_WITH_SSE)
        && VALID_MMX_REG_MODE (mode))
*************** ix86_builtin_vectorization_cost (enum ve
*** 25194,25205 ****
  	  /* One vinserti128 for combining two SSE vectors for AVX256.  */
  	  else if (GET_MODE_BITSIZE (mode) == 256)
  	    return ((n - 2) * ix86_cost->sse_op
! 		    + ix86_vec_cost (mode, ix86_cost->addss));
  	  /* One vinserti64x4 and two vinserti128 for combining SSE
  	     and AVX256 vectors to AVX512.  */
  	  else if (GET_MODE_BITSIZE (mode) == 512)
! 	    return ((n - 4) * ix86_cost->sse_op
! 		    + 3 * ix86_vec_cost (mode, ix86_cost->addss));
  	  gcc_unreachable ();
  	}
  
--- 25185,25202 ----
  	  /* One vinserti128 for combining two SSE vectors for AVX256.  */
  	  else if (GET_MODE_BITSIZE (mode) == 256)
  	    return ((n - 2) * ix86_cost->sse_op
! 		    + ix86_vec_cost (mode, ix86_cost->sse_op));
  	  /* One vinserti64x4 and two vinserti128 for combining SSE
  	     and AVX256 vectors to AVX512.  */
  	  else if (GET_MODE_BITSIZE (mode) == 512)
! 	    {
! 	      machine_mode half_mode
! 		= mode_for_vector (GET_MODE_INNER (mode),
! 				   GET_MODE_NUNITS (mode) / 2).require ();
! 	      return ((n - 4) * ix86_cost->sse_op
! 		      + 2 * ix86_vec_cost (half_mode, ix86_cost->sse_op)
! 		      + ix86_vec_cost (mode, ix86_cost->sse_op));
! 	    }
  	  gcc_unreachable ();
  	}
  
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25367,25373 ****
    switch (mode)
      {
      case E_QImode:
!       if (TARGET_AVX512BW && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
  	return V64QImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V32QImode;
--- 25364,25370 ----
    switch (mode)
      {
      case E_QImode:
!       if (TARGET_AVX512BW && !TARGET_PREFER_AVX256)
  	return V64QImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V32QImode;
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25375,25381 ****
  	return V16QImode;
  
      case E_HImode:
!       if (TARGET_AVX512BW && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
  	return V32HImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V16HImode;
--- 25372,25378 ----
  	return V16QImode;
  
      case E_HImode:
!       if (TARGET_AVX512BW && !TARGET_PREFER_AVX256)
  	return V32HImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V16HImode;
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25383,25389 ****
  	return V8HImode;
  
      case E_SImode:
!       if (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
  	return V16SImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V8SImode;
--- 25380,25386 ----
  	return V8HImode;
  
      case E_SImode:
!       if (TARGET_AVX512F && !TARGET_PREFER_AVX256)
  	return V16SImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V8SImode;
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25391,25397 ****
  	return V4SImode;
  
      case E_DImode:
!       if (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
  	return V8DImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V4DImode;
--- 25388,25394 ----
  	return V4SImode;
  
      case E_DImode:
!       if (TARGET_AVX512F && !TARGET_PREFER_AVX256)
  	return V8DImode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V4DImode;
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25405,25420 ****
  	    {
  	      if (TARGET_PREFER_AVX128)
  		return V8HFmode;
! 	      else if (TARGET_PREFER_AVX256 || !TARGET_EVEX512)
  		return V16HFmode;
  	    }
! 	  if (TARGET_EVEX512)
! 	    return V32HFmode;
  	}
        return word_mode;
  
      case E_BFmode:
!       if (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
  	return V32BFmode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V16BFmode;
--- 25402,25416 ----
  	    {
  	      if (TARGET_PREFER_AVX128)
  		return V8HFmode;
! 	      else if (TARGET_PREFER_AVX256)
  		return V16HFmode;
  	    }
! 	  return V32HFmode;
  	}
        return word_mode;
  
      case E_BFmode:
!       if (TARGET_AVX512F && !TARGET_PREFER_AVX256)
  	return V32BFmode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V16BFmode;
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25422,25428 ****
  	return V8BFmode;
  
      case E_SFmode:
!       if (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
  	return V16SFmode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V8SFmode;
--- 25418,25424 ----
  	return V8BFmode;
  
      case E_SFmode:
!       if (TARGET_AVX512F && !TARGET_PREFER_AVX256)
  	return V16SFmode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V8SFmode;
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25430,25436 ****
  	return V4SFmode;
  
      case E_DFmode:
!       if (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
  	return V8DFmode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V4DFmode;
--- 25426,25432 ----
  	return V4SFmode;
  
      case E_DFmode:
!       if (TARGET_AVX512F && !TARGET_PREFER_AVX256)
  	return V8DFmode;
        else if (TARGET_AVX && !TARGET_PREFER_AVX128)
  	return V4DFmode;
*************** ix86_preferred_simd_mode (scalar_mode mo
*** 25450,25462 ****
  static unsigned int
  ix86_autovectorize_vector_modes (vector_modes *modes, bool all)
  {
!   if (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)
      {
        modes->safe_push (V64QImode);
        modes->safe_push (V32QImode);
        modes->safe_push (V16QImode);
      }
!   else if (TARGET_AVX512F && TARGET_EVEX512 && all)
      {
        modes->safe_push (V32QImode);
        modes->safe_push (V16QImode);
--- 25446,25458 ----
  static unsigned int
  ix86_autovectorize_vector_modes (vector_modes *modes, bool all)
  {
!   if (TARGET_AVX512F && !TARGET_PREFER_AVX256)
      {
        modes->safe_push (V64QImode);
        modes->safe_push (V32QImode);
        modes->safe_push (V16QImode);
      }
!   else if (TARGET_AVX512F && all)
      {
        modes->safe_push (V32QImode);
        modes->safe_push (V16QImode);
*************** ix86_get_mask_mode (machine_mode data_mo
*** 25494,25500 ****
    unsigned elem_size = vector_size / nunits;
  
    /* Scalar mask case.  */
!   if ((TARGET_AVX512F && TARGET_EVEX512 && vector_size == 64)
        || (TARGET_AVX512VL && (vector_size == 32 || vector_size == 16))
        /* AVX512FP16 only supports vector comparison
  	 to kmask for _Float16.  */
--- 25490,25496 ----
    unsigned elem_size = vector_size / nunits;
  
    /* Scalar mask case.  */
!   if ((TARGET_AVX512F && vector_size == 64)
        || (TARGET_AVX512VL && (vector_size == 32 || vector_size == 16))
        /* AVX512FP16 only supports vector comparison
  	 to kmask for _Float16.  */
*************** ix86_vector_costs::add_stmt_cost (int co
*** 26058,26064 ****
  	      else
  		{
  		  m_num_gpr_needed[where]++;
! 		  stmt_cost += COSTS_N_INSNS (ix86_cost->integer_to_sse) / 2;
  		}
  	    }
  	}
--- 26054,26075 ----
  	      else
  		{
  		  m_num_gpr_needed[where]++;
! 
! 		  int cost = COSTS_N_INSNS (ix86_cost->integer_to_sse) / 2;
! 
! 		  /* For integer construction, the number of actual GPR -> XMM
! 		     moves will be somewhere between 0 and n.
! 		     We do not have very good idea about actual number, since
! 		     the source may be a constant, memory or a chain of
! 		     instructions that will be later converted by
! 		     scalar-to-vector pass.  */
! 		  if (kind == vec_construct
! 		      && GET_MODE_BITSIZE (mode) == 256)
! 		    cost *= 2;
! 		  else if (kind == vec_construct
! 			   && GET_MODE_BITSIZE (mode) == 512)
! 		    cost *= 3;
! 		  stmt_cost += cost;
  		}
  	    }
  	}
*************** ix86_simd_clone_compute_vecsize_and_simd
*** 26281,26287 ****
      {
        /* If the function isn't exported, we can pick up just one ISA
  	 for the clones.  */
!       if (TARGET_AVX512F && TARGET_EVEX512)
  	clonei->vecsize_mangle = 'e';
        else if (TARGET_AVX2)
  	clonei->vecsize_mangle = 'd';
--- 26292,26298 ----
      {
        /* If the function isn't exported, we can pick up just one ISA
  	 for the clones.  */
!       if (TARGET_AVX512F)
  	clonei->vecsize_mangle = 'e';
        else if (TARGET_AVX2)
  	clonei->vecsize_mangle = 'd';
*************** ix86_simd_clone_usable (struct cgraph_no
*** 26373,26389 ****
  	return -1;
        if (!TARGET_AVX)
  	return 0;
!       return (TARGET_AVX512F && TARGET_EVEX512) ? 3 : TARGET_AVX2 ? 2 : 1;
      case 'c':
        if (!TARGET_AVX)
  	return -1;
!       return (TARGET_AVX512F && TARGET_EVEX512) ? 2 : TARGET_AVX2 ? 1 : 0;
      case 'd':
        if (!TARGET_AVX2)
  	return -1;
!       return (TARGET_AVX512F && TARGET_EVEX512) ? 1 : 0;
      case 'e':
!       if (!TARGET_AVX512F || !TARGET_EVEX512)
  	return -1;
        return 0;
      default:
--- 26384,26400 ----
  	return -1;
        if (!TARGET_AVX)
  	return 0;
!       return TARGET_AVX512F ? 3 : TARGET_AVX2 ? 2 : 1;
      case 'c':
        if (!TARGET_AVX)
  	return -1;
!       return TARGET_AVX512F ? 2 : TARGET_AVX2 ? 1 : 0;
      case 'd':
        if (!TARGET_AVX2)
  	return -1;
!       return TARGET_AVX512F ? 1 : 0;
      case 'e':
!       if (!TARGET_AVX512F)
  	return -1;
        return 0;
      default:
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386.h gcc-16-20250525/gcc/config/i386/i386.h
*** gcc-16-20250518/gcc/config/i386/i386.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386.h	Sun May 25 22:32:05 2025
*************** extern const char *host_detect_local_cpu
*** 816,822 ****
     TARGET_ABSOLUTE_BIGGEST_ALIGNMENT.  */
  
  #define BIGGEST_ALIGNMENT \
!   (TARGET_IAMCU ? 32 : ((TARGET_AVX512F && TARGET_EVEX512) \
  			? 512 : (TARGET_AVX ? 256 : 128)))
  
  /* Maximum stack alignment.  */
--- 816,822 ----
     TARGET_ABSOLUTE_BIGGEST_ALIGNMENT.  */
  
  #define BIGGEST_ALIGNMENT \
!   (TARGET_IAMCU ? 32 : (TARGET_AVX512F \
  			? 512 : (TARGET_AVX ? 256 : 128)))
  
  /* Maximum stack alignment.  */
*************** typedef struct ix86_args {
*** 1895,1901 ****
     MOVE_MAX_PIECES defaults to MOVE_MAX.  */
  
  #define MOVE_MAX \
!   ((TARGET_AVX512F && TARGET_EVEX512\
      && (ix86_move_max == PVW_AVX512 \
  	|| ix86_store_max == PVW_AVX512)) \
     ? 64 \
--- 1895,1901 ----
     MOVE_MAX_PIECES defaults to MOVE_MAX.  */
  
  #define MOVE_MAX \
!   ((TARGET_AVX512F \
      && (ix86_move_max == PVW_AVX512 \
  	|| ix86_store_max == PVW_AVX512)) \
     ? 64 \
*************** typedef struct ix86_args {
*** 1914,1920 ****
     store_by_pieces of 16/32/64 bytes.  */
  #define STORE_MAX_PIECES \
    (TARGET_INTER_UNIT_MOVES_TO_VEC \
!    ? ((TARGET_AVX512F && TARGET_EVEX512 && ix86_store_max == PVW_AVX512) \
        ? 64 \
        : ((TARGET_AVX \
  	  && ix86_store_max >= PVW_AVX256) \
--- 1914,1920 ----
     store_by_pieces of 16/32/64 bytes.  */
  #define STORE_MAX_PIECES \
    (TARGET_INTER_UNIT_MOVES_TO_VEC \
!    ? ((TARGET_AVX512F && ix86_store_max == PVW_AVX512) \
        ? 64 \
        : ((TARGET_AVX \
  	  && ix86_store_max >= PVW_AVX256) \
*************** extern unsigned int const svr4_debugger_
*** 2267,2272 ****
--- 2267,2279 ----
    } while (0)
  #endif
  
+ /* In Intel syntax, we have to quote user-defined labels that would
+    match (unprefixed) registers or operators.  */
+ 
+ #undef ASM_OUTPUT_LABELREF
+ #define ASM_OUTPUT_LABELREF(STREAM, NAME)	\
+   ix86_asm_output_labelref ((STREAM), user_label_prefix, (NAME))
+ 
  /* Under some conditions we need jump tables in the text section,
     because the assembler cannot handle label differences between
     sections.  */
*************** constexpr wide_int_bitmask PTA_SKYLAKE =
*** 2408,2420 ****
    | PTA_CLFLUSHOPT | PTA_XSAVEC | PTA_XSAVES | PTA_SGX;
  constexpr wide_int_bitmask PTA_SKYLAKE_AVX512 = PTA_SKYLAKE | PTA_AVX512F
    | PTA_AVX512CD | PTA_AVX512VL | PTA_AVX512BW | PTA_AVX512DQ | PTA_PKU
!   | PTA_CLWB | PTA_EVEX512;
  constexpr wide_int_bitmask PTA_CASCADELAKE = PTA_SKYLAKE_AVX512
    | PTA_AVX512VNNI;
  constexpr wide_int_bitmask PTA_COOPERLAKE = PTA_CASCADELAKE | PTA_AVX512BF16;
  constexpr wide_int_bitmask PTA_CANNONLAKE = PTA_SKYLAKE | PTA_AVX512F
    | PTA_AVX512CD | PTA_AVX512VL | PTA_AVX512BW | PTA_AVX512DQ | PTA_PKU
!   | PTA_AVX512VBMI | PTA_AVX512IFMA | PTA_SHA | PTA_EVEX512;
  constexpr wide_int_bitmask PTA_ICELAKE_CLIENT = PTA_CANNONLAKE | PTA_AVX512VNNI
    | PTA_GFNI | PTA_VAES | PTA_AVX512VBMI2 | PTA_VPCLMULQDQ | PTA_AVX512BITALG
    | PTA_RDPID | PTA_AVX512VPOPCNTDQ;
--- 2415,2427 ----
    | PTA_CLFLUSHOPT | PTA_XSAVEC | PTA_XSAVES | PTA_SGX;
  constexpr wide_int_bitmask PTA_SKYLAKE_AVX512 = PTA_SKYLAKE | PTA_AVX512F
    | PTA_AVX512CD | PTA_AVX512VL | PTA_AVX512BW | PTA_AVX512DQ | PTA_PKU
!   | PTA_CLWB;
  constexpr wide_int_bitmask PTA_CASCADELAKE = PTA_SKYLAKE_AVX512
    | PTA_AVX512VNNI;
  constexpr wide_int_bitmask PTA_COOPERLAKE = PTA_CASCADELAKE | PTA_AVX512BF16;
  constexpr wide_int_bitmask PTA_CANNONLAKE = PTA_SKYLAKE | PTA_AVX512F
    | PTA_AVX512CD | PTA_AVX512VL | PTA_AVX512BW | PTA_AVX512DQ | PTA_PKU
!   | PTA_AVX512VBMI | PTA_AVX512IFMA | PTA_SHA;
  constexpr wide_int_bitmask PTA_ICELAKE_CLIENT = PTA_CANNONLAKE | PTA_AVX512VNNI
    | PTA_GFNI | PTA_VAES | PTA_AVX512VBMI2 | PTA_VPCLMULQDQ | PTA_AVX512BITALG
    | PTA_RDPID | PTA_AVX512VPOPCNTDQ;
*************** constexpr wide_int_bitmask PTA_ALDERLAKE
*** 2444,2450 ****
  constexpr wide_int_bitmask PTA_SIERRAFOREST = PTA_ALDERLAKE | PTA_AVXIFMA
    | PTA_AVXVNNIINT8 | PTA_AVXNECONVERT | PTA_CMPCCXADD | PTA_ENQCMD | PTA_UINTR;
  constexpr wide_int_bitmask PTA_GRANITERAPIDS = PTA_SAPPHIRERAPIDS | PTA_AMX_FP16
!   | PTA_PREFETCHI;
  constexpr wide_int_bitmask PTA_GRANITERAPIDS_D = PTA_GRANITERAPIDS
    | PTA_AMX_COMPLEX;
  constexpr wide_int_bitmask PTA_GRANDRIDGE = PTA_SIERRAFOREST;
--- 2451,2457 ----
  constexpr wide_int_bitmask PTA_SIERRAFOREST = PTA_ALDERLAKE | PTA_AVXIFMA
    | PTA_AVXVNNIINT8 | PTA_AVXNECONVERT | PTA_CMPCCXADD | PTA_ENQCMD | PTA_UINTR;
  constexpr wide_int_bitmask PTA_GRANITERAPIDS = PTA_SAPPHIRERAPIDS | PTA_AMX_FP16
!   | PTA_PREFETCHI | PTA_AVX10_1;
  constexpr wide_int_bitmask PTA_GRANITERAPIDS_D = PTA_GRANITERAPIDS
    | PTA_AMX_COMPLEX;
  constexpr wide_int_bitmask PTA_GRANDRIDGE = PTA_SIERRAFOREST;
*************** constexpr wide_int_bitmask PTA_CLEARWATE
*** 2456,2471 ****
    | PTA_AVXVNNIINT16 | PTA_SHA512 | PTA_SM3 | PTA_SM4 | PTA_USER_MSR
    | PTA_PREFETCHI;
  constexpr wide_int_bitmask PTA_PANTHERLAKE = PTA_ARROWLAKE_S | PTA_PREFETCHI;
! constexpr wide_int_bitmask PTA_DIAMONDRAPIDS = PTA_SKYLAKE | PTA_PKU | PTA_SHA
!   | PTA_GFNI | PTA_VAES | PTA_VPCLMULQDQ | PTA_RDPID | PTA_PCONFIG
!   | PTA_WBNOINVD | PTA_CLWB | PTA_MOVDIRI | PTA_MOVDIR64B | PTA_ENQCMD
!   | PTA_CLDEMOTE | PTA_PTWRITE | PTA_WAITPKG | PTA_SERIALIZE | PTA_TSXLDTRK
!   | PTA_AMX_TILE | PTA_AMX_INT8 | PTA_AMX_BF16 | PTA_UINTR | PTA_AVXVNNI
!   | PTA_AMX_FP16 | PTA_PREFETCHI | PTA_AMX_COMPLEX | PTA_AVX10_1_256
!   | PTA_AVX10_1 | PTA_AVXIFMA | PTA_AVXNECONVERT | PTA_AVXVNNIINT16
!   | PTA_AVXVNNIINT8 | PTA_CMPCCXADD | PTA_SHA512 | PTA_SM3 | PTA_SM4
!   | PTA_AVX10_2 | PTA_APX_F | PTA_AMX_AVX512 | PTA_AMX_FP8 | PTA_AMX_TF32
!   | PTA_AMX_TRANSPOSE | PTA_MOVRS | PTA_AMX_MOVRS | PTA_USER_MSR;
  
  constexpr wide_int_bitmask PTA_BDVER1 = PTA_64BIT | PTA_MMX | PTA_SSE
    | PTA_SSE2 | PTA_SSE3 | PTA_SSE4A | PTA_CX16 | PTA_ABM | PTA_SSSE3
--- 2463,2473 ----
    | PTA_AVXVNNIINT16 | PTA_SHA512 | PTA_SM3 | PTA_SM4 | PTA_USER_MSR
    | PTA_PREFETCHI;
  constexpr wide_int_bitmask PTA_PANTHERLAKE = PTA_ARROWLAKE_S | PTA_PREFETCHI;
! constexpr wide_int_bitmask PTA_DIAMONDRAPIDS = PTA_GRANITERAPIDS_D
!   | PTA_AVXIFMA | PTA_AVXNECONVERT | PTA_AVXVNNIINT16 | PTA_AVXVNNIINT8
!   | PTA_CMPCCXADD | PTA_SHA512 | PTA_SM3 | PTA_SM4 | PTA_AVX10_2
!   | PTA_APX_F | PTA_AMX_AVX512 | PTA_AMX_FP8 | PTA_AMX_TF32 | PTA_AMX_TRANSPOSE
!   | PTA_MOVRS | PTA_AMX_MOVRS | PTA_USER_MSR;
  
  constexpr wide_int_bitmask PTA_BDVER1 = PTA_64BIT | PTA_MMX | PTA_SSE
    | PTA_SSE2 | PTA_SSE3 | PTA_SSE4A | PTA_CX16 | PTA_ABM | PTA_SSSE3
*************** constexpr wide_int_bitmask PTA_ZNVER3 =
*** 2492,2498 ****
  constexpr wide_int_bitmask PTA_ZNVER4 = PTA_ZNVER3 | PTA_AVX512F | PTA_AVX512DQ
    | PTA_AVX512IFMA | PTA_AVX512CD | PTA_AVX512BW | PTA_AVX512VL
    | PTA_AVX512BF16 | PTA_AVX512VBMI | PTA_AVX512VBMI2 | PTA_GFNI
!   | PTA_AVX512VNNI | PTA_AVX512BITALG | PTA_AVX512VPOPCNTDQ | PTA_EVEX512;
  constexpr wide_int_bitmask PTA_ZNVER5 = PTA_ZNVER4 | PTA_AVXVNNI
    | PTA_MOVDIRI | PTA_MOVDIR64B | PTA_AVX512VP2INTERSECT | PTA_PREFETCHI;
  
--- 2494,2500 ----
  constexpr wide_int_bitmask PTA_ZNVER4 = PTA_ZNVER3 | PTA_AVX512F | PTA_AVX512DQ
    | PTA_AVX512IFMA | PTA_AVX512CD | PTA_AVX512BW | PTA_AVX512VL
    | PTA_AVX512BF16 | PTA_AVX512VBMI | PTA_AVX512VBMI2 | PTA_GFNI
!   | PTA_AVX512VNNI | PTA_AVX512BITALG | PTA_AVX512VPOPCNTDQ;
  constexpr wide_int_bitmask PTA_ZNVER5 = PTA_ZNVER4 | PTA_AVXVNNI
    | PTA_MOVDIRI | PTA_MOVDIR64B | PTA_AVX512VP2INTERSECT | PTA_PREFETCHI;
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386.md gcc-16-20250525/gcc/config/i386/i386.md
*** gcc-16-20250518/gcc/config/i386/i386.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386.md	Sun May 25 22:32:05 2025
***************
*** 581,592 ****
  (define_attr "isa" "base,x64,nox64,x64_sse2,x64_sse4,x64_sse4_noavx,
  		    x64_avx,x64_avx512bw,x64_avx512dq,apx_ndd,apx_ndd_64,
  		    sse_noavx,sse2,sse2_noavx,sse3,sse3_noavx,sse4,sse4_noavx,
! 		    avx,noavx,avx2,noavx2,bmi,bmi2,fma4,fma,avx512f,avx512f_512,
! 		    noavx512f,avx512bw,avx512bw_512,noavx512bw,avx512dq,
! 		    noavx512dq,fma_or_avx512vl,avx512vl,noavx512vl,avxvnni,
! 		    avx512vnnivl,avx512fp16,avxifma,avx512ifmavl,avxneconvert,
! 		    avx512bf16vl,vpclmulqdqvl,avx_noavx512f,avx_noavx512vl,
! 		    vaes_avx512vl,noapx_nf,avx10_2"
    (const_string "base"))
  
  ;; The (bounding maximum) length of an instruction immediate.
--- 581,591 ----
  (define_attr "isa" "base,x64,nox64,x64_sse2,x64_sse4,x64_sse4_noavx,
  		    x64_avx,x64_avx512bw,x64_avx512dq,apx_ndd,apx_ndd_64,
  		    sse_noavx,sse2,sse2_noavx,sse3,sse3_noavx,sse4,sse4_noavx,
! 		    avx,noavx,avx2,noavx2,bmi,bmi2,fma4,fma,avx512f,noavx512f,
! 		    avx512bw,noavx512bw,avx512dq,noavx512dq,fma_or_avx512vl,
! 		    avx512vl,noavx512vl,avxvnni,avx512vnnivl,avx512fp16,avxifma,
! 		    avx512ifmavl,avxneconvert,avx512bf16vl,vpclmulqdqvl,
! 		    avx_noavx512f,avx_noavx512vl,vaes_avx512vl,noapx_nf,avx10_2"
    (const_string "base"))
  
  ;; The (bounding maximum) length of an instruction immediate.
***************
*** 956,967 ****
  	 (eq_attr "isa" "fma_or_avx512vl")
  	   (symbol_ref "TARGET_FMA || TARGET_AVX512VL")
  	 (eq_attr "isa" "avx512f") (symbol_ref "TARGET_AVX512F")
- 	 (eq_attr "isa" "avx512f_512")
- 	   (symbol_ref "TARGET_AVX512F && TARGET_EVEX512")
  	 (eq_attr "isa" "noavx512f") (symbol_ref "!TARGET_AVX512F")
  	 (eq_attr "isa" "avx512bw") (symbol_ref "TARGET_AVX512BW")
- 	 (eq_attr "isa" "avx512bw_512")
- 	   (symbol_ref "TARGET_AVX512BW && TARGET_EVEX512")
  	 (eq_attr "isa" "noavx512bw") (symbol_ref "!TARGET_AVX512BW")
  	 (eq_attr "isa" "avx512dq") (symbol_ref "TARGET_AVX512DQ")
  	 (eq_attr "isa" "noavx512dq") (symbol_ref "!TARGET_AVX512DQ")
--- 955,962 ----
***************
*** 1497,1503 ****
  		[(reg:CC FLAGS_REG) (const_int 0)])
  	       (label_ref (match_operand 3))
  	       (pc)))]
!   "TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256"
  {
    ix86_expand_branch (GET_CODE (operands[0]),
  		      operands[1], operands[2], operands[3]);
--- 1492,1498 ----
  		[(reg:CC FLAGS_REG) (const_int 0)])
  	       (label_ref (match_operand 3))
  	       (pc)))]
!   "TARGET_AVX512F && !TARGET_PREFER_AVX256"
  {
    ix86_expand_branch (GET_CODE (operands[0]),
  		      operands[1], operands[2], operands[3]);
***************
*** 1604,1609 ****
--- 1599,1618 ----
    [(set_attr "type" "icmp")
     (set_attr "mode" "<MODE>")])
  
+ (define_insn "*cmp<mode>_plus_1"
+   [(set (reg FLAGS_REG)
+ 	(compare
+ 	  (plus:SWI (match_operand:SWI 0 "nonimmediate_operand" "<r>m")
+ 		    (match_operand:SWI 1 "x86_64_neg_const_int_operand" "n"))
+ 	  (const_int 0)))]
+   "ix86_match_ccmode (insn, CCGOCmode)"
+ {
+   operands[1] = gen_int_mode (-INTVAL (operands[1]), <MODE>mode);
+   return "cmp{<imodesuffix>}\t{%1, %0|%0, %1}";
+ }
+   [(set_attr "type" "icmp")
+    (set_attr "mode" "<MODE>")])
+ 
  (define_insn "*cmpqi_ext<mode>_1"
    [(set (reg FLAGS_REG)
  	(compare
***************
*** 2376,2382 ****
  (define_expand "movxi"
    [(set (match_operand:XI 0 "nonimmediate_operand")
  	(match_operand:XI 1 "general_operand"))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "ix86_expand_vector_move (XImode, operands); DONE;")
  
  (define_expand "movoi"
--- 2385,2391 ----
  (define_expand "movxi"
    [(set (match_operand:XI 0 "nonimmediate_operand")
  	(match_operand:XI 1 "general_operand"))]
!   "TARGET_AVX512F"
    "ix86_expand_vector_move (XImode, operands); DONE;")
  
  (define_expand "movoi"
***************
*** 2452,2458 ****
  (define_insn "*movxi_internal_avx512f"
    [(set (match_operand:XI 0 "nonimmediate_operand"		"=v,v ,v ,m")
  	(match_operand:XI 1 "nonimmediate_or_sse_const_operand" " C,BC,vm,v"))]
!   "TARGET_AVX512F && TARGET_EVEX512
     && (register_operand (operands[0], XImode)
         || register_operand (operands[1], XImode))"
  {
--- 2461,2467 ----
  (define_insn "*movxi_internal_avx512f"
    [(set (match_operand:XI 0 "nonimmediate_operand"		"=v,v ,v ,m")
  	(match_operand:XI 1 "nonimmediate_or_sse_const_operand" " C,BC,vm,v"))]
!   "TARGET_AVX512F
     && (register_operand (operands[0], XImode)
         || register_operand (operands[1], XImode))"
  {
***************
*** 4416,4422 ****
  	       (eq_attr "alternative" "11")
  		 (const_string "DI")
  	       (eq_attr "alternative" "5")
! 		 (cond [(and (match_test "TARGET_AVX512F && TARGET_EVEX512")
  			     (not (match_test "TARGET_PREFER_AVX256")))
  			  (const_string "V16SF")
  			(match_test "TARGET_AVX")
--- 4425,4431 ----
  	       (eq_attr "alternative" "11")
  		 (const_string "DI")
  	       (eq_attr "alternative" "5")
! 		 (cond [(and (match_test "TARGET_AVX512F")
  			     (not (match_test "TARGET_PREFER_AVX256")))
  			  (const_string "V16SF")
  			(match_test "TARGET_AVX")
***************
*** 5484,5490 ****
     (set_attr "memory" "none")
     (set (attr "enabled")
       (if_then_else (eq_attr "alternative" "2")
!        (symbol_ref "TARGET_AVX512F && TARGET_EVEX512
  		    && !TARGET_AVX512VL && !TARGET_PREFER_AVX256")
         (const_string "*")))])
  
--- 5493,5499 ----
     (set_attr "memory" "none")
     (set (attr "enabled")
       (if_then_else (eq_attr "alternative" "2")
!        (symbol_ref "TARGET_AVX512F
  		    && !TARGET_AVX512VL && !TARGET_PREFER_AVX256")
         (const_string "*")))])
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386.opt gcc-16-20250525/gcc/config/i386/i386.opt
*** gcc-16-20250518/gcc/config/i386/i386.opt	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386.opt	Sun May 25 22:32:05 2025
*************** HOST_WIDE_INT ix86_isa_flags_explicit
*** 36,48 ****
  Variable
  HOST_WIDE_INT ix86_isa_flags2_explicit
  
- ; Indicate if AVX512 and AVX10.1 are explicitly set no.
- Variable
- int ix86_no_avx512_explicit = 0
- 
- Variable
- int ix86_no_avx10_1_explicit = 0
- 
  ; Additional target flags
  Variable
  int ix86_target_flags
--- 36,41 ----
*************** HOST_WIDE_INT x_ix86_isa_flags2_explicit
*** 103,116 ****
  TargetSave
  HOST_WIDE_INT x_ix86_isa_flags_explicit
  
- ;; which flags were passed by the user
- TargetSave
- HOST_WIDE_INT x_ix86_no_avx512_explicit
- 
- ;; which flags were passed by the user
- TargetSave
- HOST_WIDE_INT x_ix86_no_avx10_1_explicit
- 
  ;; whether -mtune was not specified
  TargetSave
  unsigned char tune_defaulted
--- 96,101 ----
*************** mapx-inline-asm-use-gpr32
*** 1351,1388 ****
  Target Var(ix86_apx_inline_asm_use_gpr32) Init(0)
  Enable GPR32 in inline asm when APX_F enabled.
  
- mevex512
- Target Mask(ISA2_EVEX512) Var(ix86_isa_flags2) Save Warn(%<-mevex512%> will be deprecated in GCC 16 due to all machines 512 bit vector size supported)
- Support 512 bit vector built-in functions and code generation.
- 
  musermsr
  Target Mask(ISA2_USER_MSR) Var(ix86_isa_flags2) Save
  Support USER_MSR built-in functions and code generation.
  
- mavx10.1-256
- Target Mask(ISA2_AVX10_1_256) Var(ix86_isa_flags2) Save Warn(%<-mavx10.1%> is aliased to 512 bit since GCC14.3 and GCC15.1 while %<-mavx10.1-256%> and %<-mavx10.1-512%> will be deprecated in GCC 16 due to all machines 512 bit vector size supported)
- Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2,
- and AVX10.1-256 built-in functions and code generation.
- 
  mavx10.1
! Target Mask(ISA2_AVX10_1) Var(ix86_isa_flags2) Save Warn(%<-mavx10.1%> is aliased to 512 bit since GCC14.3 and GCC15.1 while %<-mavx10.1-256%> and %<-mavx10.1-512%> will be deprecated in GCC 16 due to all machines 512 bit vector size supported)
! Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2,
! and AVX10.1-512 built-in functions and code generation.
! 
! mavx10.1-512
! Target Alias(mavx10.1)
  Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2,
! and AVX10.1-512 built-in functions and code generation.
  
  mavx10.2
  Target Mask(ISA2_AVX10_2) Var(ix86_isa_flags2) Save
  Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2,
! AVX10.1-512 and AVX10.2 built-in functions and code generation.
  
  mamx-avx512
  Target Mask(ISA2_AMX_AVX512) Var(ix86_isa_flags2) Save
! Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2, AVX10.1-512,
! AVX10.2 and AMX-AVX512 built-in functions and code generation.
  
  mamx-tf32
  Target Mask(ISA2_AMX_TF32) Var(ix86_isa_flags2) Save
--- 1336,1359 ----
  Target Var(ix86_apx_inline_asm_use_gpr32) Init(0)
  Enable GPR32 in inline asm when APX_F enabled.
  
  musermsr
  Target Mask(ISA2_USER_MSR) Var(ix86_isa_flags2) Save
  Support USER_MSR built-in functions and code generation.
  
  mavx10.1
! Target Mask(ISA2_AVX10_1) Var(ix86_isa_flags2) Save
  Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2,
! and AVX10.1 built-in functions and code generation.
  
  mavx10.2
  Target Mask(ISA2_AVX10_2) Var(ix86_isa_flags2) Save
  Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2,
! AVX10.1 and AVX10.2 built-in functions and code generation.
  
  mamx-avx512
  Target Mask(ISA2_AMX_AVX512) Var(ix86_isa_flags2) Save
! Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX, AVX2,
! AVX10.1, AVX10.2 and AMX-AVX512 built-in functions and code generation.
  
  mamx-tf32
  Target Mask(ISA2_AMX_TF32) Var(ix86_isa_flags2) Save
diff -Nrcpad gcc-16-20250518/gcc/config/i386/i386.opt.urls gcc-16-20250525/gcc/config/i386/i386.opt.urls
*** gcc-16-20250518/gcc/config/i386/i386.opt.urls	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/i386.opt.urls	Sun May 25 22:32:05 2025
*************** UrlSuffix(gcc/x86-Options.html#index-map
*** 590,610 ****
  mapx-inline-asm-use-gpr32
  UrlSuffix(gcc/x86-Options.html#index-mapx-inline-asm-use-gpr32)
  
- mevex512
- UrlSuffix(gcc/x86-Options.html#index-mevex512)
- 
  musermsr
  UrlSuffix(gcc/x86-Options.html#index-musermsr)
  
- mavx10.1-256
- UrlSuffix(gcc/x86-Options.html#index-mavx10_002e1-256)
- 
  mavx10.1
  UrlSuffix(gcc/x86-Options.html#index-mavx10_002e1)
  
- mavx10.1-512
- UrlSuffix(gcc/x86-Options.html#index-mavx10_002e1-512)
- 
  mavx10.2
  UrlSuffix(gcc/x86-Options.html#index-mavx10_002e2)
  
--- 590,601 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/immintrin.h gcc-16-20250525/gcc/config/i386/immintrin.h
*** gcc-16-20250518/gcc/config/i386/immintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/immintrin.h	Sun May 25 22:32:05 2025
***************
*** 148,171 ****
  
  #include <avx10_2mediaintrin.h>
  
- #include <avx10_2-512mediaintrin.h>
- 
  #include <avx10_2convertintrin.h>
  
- #include <avx10_2-512convertintrin.h>
- 
  #include <avx10_2bf16intrin.h>
  
- #include <avx10_2-512bf16intrin.h>
- 
  #include <avx10_2satcvtintrin.h>
  
- #include <avx10_2-512satcvtintrin.h>
- 
  #include <avx10_2minmaxintrin.h>
  
- #include <avx10_2-512minmaxintrin.h>
- 
  #include <avx10_2copyintrin.h>
  
  #include <movrsintrin.h>
--- 148,161 ----
diff -Nrcpad gcc-16-20250518/gcc/config/i386/predicates.md gcc-16-20250525/gcc/config/i386/predicates.md
*** gcc-16-20250518/gcc/config/i386/predicates.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/predicates.md	Sun May 25 22:32:05 2025
***************
*** 393,398 ****
--- 393,415 ----
    return false;
  })
  
+ ;; Return true if VALUE is a constant integer whose negation satisfies
+ ;; x86_64_immediate_operand.
+ (define_predicate "x86_64_neg_const_int_operand"
+   (match_code "const_int")
+ {
+   HOST_WIDE_INT val = -UINTVAL (op);
+   if (mode == DImode && trunc_int_for_mode (val, SImode) != val)
+     return false;
+   if (flag_cf_protection & CF_BRANCH)
+     {
+       unsigned HOST_WIDE_INT endbr = TARGET_64BIT ? 0xfa1e0ff3 : 0xfb1e0ff3;
+       if ((val & HOST_WIDE_INT_C (0xffffffff)) == endbr)
+ 	return false;
+     }
+   return true;
+ })
+ 
  ;; Return true if VALUE is a constant integer whose low and high words satisfy
  ;; x86_64_immediate_operand.
  (define_predicate "x86_64_hilo_int_operand"
***************
*** 1280,1287 ****
    (and (match_code "vec_duplicate")
         (and (match_test "TARGET_AVX512F")
  	    (ior (match_test "TARGET_AVX512VL")
! 		 (and (match_test "GET_MODE_SIZE (GET_MODE (op)) == 64")
! 		      (match_test "TARGET_EVEX512"))))
         (match_test "VALID_BCST_MODE_P (GET_MODE_INNER (GET_MODE (op)))")
         (match_test "GET_MODE (XEXP (op, 0))
  		    == GET_MODE_INNER (GET_MODE (op))")
--- 1297,1303 ----
    (and (match_code "vec_duplicate")
         (and (match_test "TARGET_AVX512F")
  	    (ior (match_test "TARGET_AVX512VL")
! 		 (match_test "GET_MODE_SIZE (GET_MODE (op)) == 64")))
         (match_test "VALID_BCST_MODE_P (GET_MODE_INNER (GET_MODE (op)))")
         (match_test "GET_MODE (XEXP (op, 0))
  		    == GET_MODE_INNER (GET_MODE (op))")
diff -Nrcpad gcc-16-20250518/gcc/config/i386/sse.md gcc-16-20250525/gcc/config/i386/sse.md
*** gcc-16-20250518/gcc/config/i386/sse.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/sse.md	Sun May 25 22:32:05 2025
***************
*** 279,341 ****
  
  ;; All vector modes including V?TImode, used in move patterns.
  (define_mode_iterator VMOVE
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")  (V4DI "TARGET_AVX") V2DI
!    (V4TI "TARGET_AVX512F && TARGET_EVEX512") (V2TI "TARGET_AVX") V1TI
!    (V32HF "TARGET_AVX512F && TARGET_EVEX512") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F && TARGET_EVEX512") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")  (V4DF "TARGET_AVX") V2DF])
  
  ;; All AVX-512{F,VL} vector modes without HF. Supposed TARGET_AVX512F baseline.
  (define_mode_iterator V48_AVX512VL
!   [(V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    (V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
!    (V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    (V8DF "TARGET_EVEX512") (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator V48_256_512_AVX512VL
!   [(V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL")
!    (V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL")
!    (V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL")
!    (V8DF "TARGET_EVEX512") (V4DF "TARGET_AVX512VL")])
  
  ;; All AVX-512{F,VL} vector modes. Supposed TARGET_AVX512F baseline.
  (define_mode_iterator V48H_AVX512VL
!   [(V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    (V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
!    (V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    (V8DF "TARGET_EVEX512") (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  ;; 1,2 byte AVX-512{BW,VL} vector modes. Supposed TARGET_AVX512BW baseline.
  (define_mode_iterator VI12_AVX512VL
!   [(V64QI "TARGET_EVEX512") (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")
!    (V32HI "TARGET_EVEX512") (V16HI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI12HFBF_AVX512VL
!   [(V64QI "TARGET_EVEX512") (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")
!    (V32HI "TARGET_EVEX512") (V16HI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")
!    (V32HF "TARGET_EVEX512") (V16HF "TARGET_AVX512VL") (V8HF "TARGET_AVX512VL")
!    (V32BF "TARGET_EVEX512") (V16BF "TARGET_AVX512VL") (V8BF "TARGET_AVX512VL")])
  
  (define_mode_iterator VI1_AVX512VL
!   [(V64QI "TARGET_EVEX512") (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")])
  
  ;; All vector modes
  (define_mode_iterator V
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")  (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512F && TARGET_EVEX512") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F && TARGET_EVEX512") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")  (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")])
  
  ;; All 128bit vector modes
  (define_mode_iterator V_128
--- 279,341 ----
  
  ;; All vector modes including V?TImode, used in move patterns.
  (define_mode_iterator VMOVE
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F")  (V4DI "TARGET_AVX") V2DI
!    (V4TI "TARGET_AVX512F") (V2TI "TARGET_AVX") V1TI
!    (V32HF "TARGET_AVX512F") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F")  (V4DF "TARGET_AVX") V2DF])
  
  ;; All AVX-512{F,VL} vector modes without HF. Supposed TARGET_AVX512F baseline.
  (define_mode_iterator V48_AVX512VL
!   [V16SI (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    V8DI (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
!    V16SF (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    V8DF (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator V48_256_512_AVX512VL
!   [V16SI (V8SI "TARGET_AVX512VL")
!    V8DI (V4DI "TARGET_AVX512VL")
!    V16SF (V8SF "TARGET_AVX512VL")
!    V8DF (V4DF "TARGET_AVX512VL")])
  
  ;; All AVX-512{F,VL} vector modes. Supposed TARGET_AVX512F baseline.
  (define_mode_iterator V48H_AVX512VL
!   [V16SI (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    V8DI (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
!    (V32HF "TARGET_AVX512FP16")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    V16SF (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    V8DF (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  ;; 1,2 byte AVX-512{BW,VL} vector modes. Supposed TARGET_AVX512BW baseline.
  (define_mode_iterator VI12_AVX512VL
!   [V64QI (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")
!    V32HI (V16HI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI12HFBF_AVX512VL
!   [V64QI (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")
!    V32HI (V16HI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")
!    V32HF (V16HF "TARGET_AVX512VL") (V8HF "TARGET_AVX512VL")
!    V32BF (V16BF "TARGET_AVX512VL") (V8BF "TARGET_AVX512VL")])
  
  (define_mode_iterator VI1_AVX512VL
!   [V64QI (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")])
  
  ;; All vector modes
  (define_mode_iterator V
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F")  (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512F") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F")  (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")])
  
  ;; All 128bit vector modes
  (define_mode_iterator V_128
***************
*** 352,405 ****
  
  ;; All 512bit vector modes
  (define_mode_iterator V_512
!   [(V64QI "TARGET_EVEX512") (V32HI "TARGET_EVEX512")
!    (V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")
!    (V16SF "TARGET_EVEX512") (V8DF "TARGET_EVEX512")
!    (V32HF "TARGET_EVEX512") (V32BF "TARGET_EVEX512")])
  
  ;; All 256bit and 512bit vector modes
  (define_mode_iterator V_256_512
    [V32QI V16HI V16HF V16BF V8SI V4DI V8SF V4DF
!    (V64QI "TARGET_AVX512F && TARGET_EVEX512")
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512")
!    (V32HF "TARGET_AVX512F && TARGET_EVEX512")
!    (V32BF "TARGET_AVX512F && TARGET_EVEX512")
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")])
  
  ;; All vector float modes
  (define_mode_iterator VF
!   [(V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512") (V4DF "TARGET_AVX")
     (V2DF "TARGET_SSE2")])
  
  (define_mode_iterator VF1_VF2_AVX512DQ
!   [(V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512DQ && TARGET_EVEX512")
     (V4DF "TARGET_AVX512DQ && TARGET_AVX512VL")
     (V2DF "TARGET_AVX512DQ && TARGET_AVX512VL")])
  
- (define_mode_iterator VF1_VF2_AVX10_2
-   [(V16SF "TARGET_AVX10_2") V8SF V4SF
-    (V8DF "TARGET_AVX10_2") V4DF V2DF])
- 
  (define_mode_iterator VFH
!   [(V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512") (V4DF "TARGET_AVX")
     (V2DF "TARGET_SSE2")])
  
  (define_mode_iterator VF_BHSD
!   [(V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512")
     (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")
     (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")
     (V32BF "TARGET_AVX10_2")
     (V16BF "TARGET_AVX10_2")
--- 352,395 ----
  
  ;; All 512bit vector modes
  (define_mode_iterator V_512
!   [V64QI V32HI V16SI V8DI
!    V16SF V8DF V32HF V32BF])
  
  ;; All 256bit and 512bit vector modes
  (define_mode_iterator V_256_512
    [V32QI V16HI V16HF V16BF V8SI V4DI V8SF V4DF
!    (V64QI "TARGET_AVX512F") (V32HI "TARGET_AVX512F")
!    (V32HF "TARGET_AVX512F") (V32BF "TARGET_AVX512F")
!    (V16SI "TARGET_AVX512F") (V8DI "TARGET_AVX512F")
!    (V16SF "TARGET_AVX512F") (V8DF "TARGET_AVX512F")])
  
  ;; All vector float modes
  (define_mode_iterator VF
!   [(V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX")
     (V2DF "TARGET_SSE2")])
  
  (define_mode_iterator VF1_VF2_AVX512DQ
!   [(V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512DQ")
     (V4DF "TARGET_AVX512DQ && TARGET_AVX512VL")
     (V2DF "TARGET_AVX512DQ && TARGET_AVX512VL")])
  
  (define_mode_iterator VFH
!   [(V32HF "TARGET_AVX512FP16")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX")
     (V2DF "TARGET_SSE2")])
  
  (define_mode_iterator VF_BHSD
!   [(V32HF "TARGET_AVX512FP16")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16SF "TARGET_AVX512F")
     (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F")
     (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")
     (V32BF "TARGET_AVX10_2")
     (V16BF "TARGET_AVX10_2")
***************
*** 408,419 ****
  
  ;; 128-, 256- and 512-bit float vector modes for bitwise operations
  (define_mode_iterator VFB
!   [(V32BF "TARGET_AVX512F && TARGET_EVEX512")
     (V16BF "TARGET_AVX") (V8BF "TARGET_SSE2")
!    (V32HF "TARGET_AVX512F && TARGET_EVEX512")
     (V16HF "TARGET_AVX") (V8HF "TARGET_SSE2")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")
     (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")])
  
  ;; 128- and 256-bit float vector modes
--- 398,409 ----
  
  ;; 128-, 256- and 512-bit float vector modes for bitwise operations
  (define_mode_iterator VFB
!   [(V32BF "TARGET_AVX512F")
     (V16BF "TARGET_AVX") (V8BF "TARGET_SSE2")
!    (V32HF "TARGET_AVX512F")
     (V16HF "TARGET_AVX") (V8HF "TARGET_SSE2")
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F")
     (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")])
  
  ;; 128- and 256-bit float vector modes
***************
*** 430,473 ****
  
  ;; All SFmode vector float modes
  (define_mode_iterator VF1
!   [(V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF])
  
  (define_mode_iterator VF1_AVX2
!   [(V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX2") V4SF])
  
  ;; 128- and 256-bit SF vector modes
  (define_mode_iterator VF1_128_256
    [(V8SF "TARGET_AVX") V4SF])
  
  (define_mode_iterator VF1_128_256VL
!   [(V8SF "TARGET_EVEX512") (V4SF "TARGET_AVX512VL")])
  
  ;; All DFmode vector float modes
  (define_mode_iterator VF2
!   [(V8DF "TARGET_AVX512F && TARGET_EVEX512") (V4DF "TARGET_AVX") V2DF])
! 
! (define_mode_iterator VF2_AVX10_2
!   [(V8DF "TARGET_AVX10_2") V4DF V2DF])
  
  ;; All DFmode & HFmode & BFmode vector float modes
  (define_mode_iterator VF2HB
!   [(V32BF "TARGET_AVX10_2")
!    (V16BF "TARGET_AVX10_2")
!    (V8BF "TARGET_AVX10_2")
!    (V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512") (V4DF "TARGET_AVX") V2DF])
  
  ;; 128- and 256-bit DF vector modes
  (define_mode_iterator VF2_128_256
    [(V4DF "TARGET_AVX") V2DF])
  
  (define_mode_iterator VF2_512_256
!   [(V8DF "TARGET_AVX512F && TARGET_EVEX512") V4DF])
  
  (define_mode_iterator VF2_512_256VL
!   [(V8DF "TARGET_EVEX512") (V4DF "TARGET_AVX512VL")])
  
  ;; All 128bit vector SF/DF modes
  (define_mode_iterator VF_128
--- 420,458 ----
  
  ;; All SFmode vector float modes
  (define_mode_iterator VF1
!   [(V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF])
  
  (define_mode_iterator VF1_AVX2
!   [(V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX2") V4SF])
  
  ;; 128- and 256-bit SF vector modes
  (define_mode_iterator VF1_128_256
    [(V8SF "TARGET_AVX") V4SF])
  
  (define_mode_iterator VF1_128_256VL
!   [V8SF (V4SF "TARGET_AVX512VL")])
  
  ;; All DFmode vector float modes
  (define_mode_iterator VF2
!   [(V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX") V2DF])
  
  ;; All DFmode & HFmode & BFmode vector float modes
  (define_mode_iterator VF2HB
!   [(V32BF "TARGET_AVX10_2") (V16BF "TARGET_AVX10_2")
!    (V8BF "TARGET_AVX10_2") (V32HF "TARGET_AVX512FP16")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX") V2DF])
  
  ;; 128- and 256-bit DF vector modes
  (define_mode_iterator VF2_128_256
    [(V4DF "TARGET_AVX") V2DF])
  
  (define_mode_iterator VF2_512_256
!   [(V8DF "TARGET_AVX512F") V4DF])
  
  (define_mode_iterator VF2_512_256VL
!   [V8DF (V4DF "TARGET_AVX512VL")])
  
  ;; All 128bit vector SF/DF modes
  (define_mode_iterator VF_128
***************
*** 484,531 ****
  
  ;; All 512bit vector float modes
  (define_mode_iterator VF_512
!   [(V16SF "TARGET_EVEX512") (V8DF "TARGET_EVEX512")])
  
  ;; All 512bit vector float modes for bitwise operations
  (define_mode_iterator VFB_512
!   [(V32BF "TARGET_EVEX512")
!    (V32HF "TARGET_EVEX512")
!    (V16SF "TARGET_EVEX512")
!    (V8DF "TARGET_EVEX512")])
  
  (define_mode_iterator V24F_128
    [V4SF V8HF V8BF])
  
  (define_mode_iterator VI48_AVX512VL
!   [(V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    (V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI1248_AVX512VLBW
!   [(V64QI "TARGET_AVX512BW && TARGET_EVEX512")
     (V32QI "TARGET_AVX512VL && TARGET_AVX512BW")
     (V16QI "TARGET_AVX512VL && TARGET_AVX512BW")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
     (V16HI "TARGET_AVX512VL && TARGET_AVX512BW")
     (V8HI "TARGET_AVX512VL && TARGET_AVX512BW")
!    (V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    (V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
! 
! (define_mode_iterator VI1248_AVX10_2
!   [(V64QI "TARGET_AVX10_2") V32QI V16QI
!    (V32HI "TARGET_AVX10_2") V16HI V8HI
!    (V16SI "TARGET_AVX10_2") V8SI V4SI
!    (V8DI "TARGET_AVX10_2") V4DI V2DI])
  
  (define_mode_iterator VF_AVX512VL
!   [(V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    (V8DF "TARGET_EVEX512") (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator VFH_AVX512VL
!   [(V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    (V8DF "TARGET_EVEX512") (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator V48_AVX512VL_4
    [(V4SF "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
--- 469,507 ----
  
  ;; All 512bit vector float modes
  (define_mode_iterator VF_512
!   [V16SF V8DF])
  
  ;; All 512bit vector float modes for bitwise operations
  (define_mode_iterator VFB_512
!   [V32BF V32HF V16SF V8DF])
  
  (define_mode_iterator V24F_128
    [V4SF V8HF V8BF])
  
  (define_mode_iterator VI48_AVX512VL
!   [V16SI (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    V8DI (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI1248_AVX512VLBW
!   [(V64QI "TARGET_AVX512BW")
     (V32QI "TARGET_AVX512VL && TARGET_AVX512BW")
     (V16QI "TARGET_AVX512VL && TARGET_AVX512BW")
!    (V32HI "TARGET_AVX512BW")
     (V16HI "TARGET_AVX512VL && TARGET_AVX512BW")
     (V8HI "TARGET_AVX512VL && TARGET_AVX512BW")
!    V16SI (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    V8DI (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VF_AVX512VL
!   [V16SF (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    V8DF (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator VFH_AVX512VL
!   [(V32HF "TARGET_AVX512FP16")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    V16SF (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    V8DF (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator V48_AVX512VL_4
    [(V4SF "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
***************
*** 537,609 ****
  (define_mode_iterator V8_AVX512VL_2
    [(V2DF "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
- (define_mode_iterator VFH_AVX10_2
-   [(V32HF "TARGET_AVX10_2") V16HF V8HF
-    (V16SF "TARGET_AVX10_2") V8SF V4SF
-    (V8DF "TARGET_AVX10_2") V4DF V2DF])
- 
  (define_mode_iterator VF2_AVX512VL
!   [(V8DF "TARGET_EVEX512") (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator VF1_AVX512VL
!   [(V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")])
  
  (define_mode_iterator VF1_AVX512BW
!   [(V16SF "TARGET_AVX512BW && TARGET_EVEX512") (V8SF "TARGET_AVX2") V4SF])
! 
! (define_mode_iterator VF1_AVX10_2
!   [(V16SF "TARGET_AVX10_2") V8SF V4SF])
  
  (define_mode_iterator VHFBF
!   [(V32HF "TARGET_EVEX512") V16HF V8HF
!    (V32BF "TARGET_EVEX512") V16BF V8BF])
  (define_mode_iterator VHFBF_256 [V16HF V16BF])
  (define_mode_iterator VHFBF_128 [V8HF V8BF])
  
  (define_mode_iterator VHF_AVX512VL
!   [(V32HF "TARGET_EVEX512") (V16HF "TARGET_AVX512VL") (V8HF "TARGET_AVX512VL")])
  
  (define_mode_iterator VHFBF_AVX512VL
!   [(V32HF "TARGET_EVEX512") (V16HF "TARGET_AVX512VL") (V8HF "TARGET_AVX512VL")
!    (V32BF "TARGET_EVEX512") (V16BF "TARGET_AVX512VL") (V8BF "TARGET_AVX512VL")])
! 
! (define_mode_iterator VHF_AVX10_2
!   [(V32HF "TARGET_AVX10_2") V16HF V8HF])
  
! (define_mode_iterator VBF_AVX10_2
!   [(V32BF "TARGET_AVX10_2") V16BF V8BF])
  
  ;; All vector integer modes
  (define_mode_iterator VI
!   [(V16SI "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!    (V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
     (V8SI "TARGET_AVX") V4SI
     (V4DI "TARGET_AVX") V2DI])
  
  ;; All vector integer and HF modes
  (define_mode_iterator VIHFBF
!   [(V16SI "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!    (V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V8SI "TARGET_AVX") V4SI
!    (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512BW && TARGET_EVEX512") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512BW && TARGET_EVEX512") (V16BF "TARGET_AVX") V8BF])
  
  (define_mode_iterator VI_AVX2
!   [(V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX2") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI_AVX_AVX512F
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX") V2DI])
  
  ;; All QImode vector integer modes
  (define_mode_iterator VI1
--- 513,570 ----
  (define_mode_iterator V8_AVX512VL_2
    [(V2DF "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VF2_AVX512VL
!   [V8DF (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_mode_iterator VF1_AVX512VL
!   [V16SF (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")])
  
  (define_mode_iterator VF1_AVX512BW
!   [(V16SF "TARGET_AVX512BW") (V8SF "TARGET_AVX2") V4SF])
  
  (define_mode_iterator VHFBF
!   [V32HF V16HF V8HF V32BF V16BF V8BF])
  (define_mode_iterator VHFBF_256 [V16HF V16BF])
  (define_mode_iterator VHFBF_128 [V8HF V8BF])
  
  (define_mode_iterator VHF_AVX512VL
!   [V32HF (V16HF "TARGET_AVX512VL") (V8HF "TARGET_AVX512VL")])
  
  (define_mode_iterator VHFBF_AVX512VL
!   [V32HF (V16HF "TARGET_AVX512VL") (V8HF "TARGET_AVX512VL")
!    V32BF (V16BF "TARGET_AVX512VL") (V8BF "TARGET_AVX512VL")])
  
! (define_mode_iterator VBF
!   [V32BF V16BF V8BF])
  
  ;; All vector integer modes
  (define_mode_iterator VI
!   [(V16SI "TARGET_AVX512F") (V8DI "TARGET_AVX512F")
!    (V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX") V8HI
     (V8SI "TARGET_AVX") V4SI
     (V4DI "TARGET_AVX") V2DI])
  
  ;; All vector integer and HF modes
  (define_mode_iterator VIHFBF
!   [(V16SI "TARGET_AVX512F") (V8DI "TARGET_AVX512F")
!    (V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX") V8HI
!    (V8SI "TARGET_AVX") V4SI (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512BW") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512BW") (V16BF "TARGET_AVX") V8BF])
  
  (define_mode_iterator VI_AVX2
!   [(V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX2") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI_AVX_AVX512F
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX") V2DI])
  
  ;; All QImode vector integer modes
  (define_mode_iterator VI1
***************
*** 621,676 ****
    (V8SI "TARGET_AVX") (V4DI "TARGET_AVX")])
  
  (define_mode_iterator VI8
!   [(V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX") V2DI])
! 
! (define_mode_iterator VI8_AVX10_2
!   [(V8DI "TARGET_AVX10_2") V4DI V2DI])
  
  (define_mode_iterator VI8_FVL
!   [(V8DI "TARGET_AVX512F && TARGET_EVEX512") V4DI (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI8_AVX512VL
!   [(V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI8_256_512
!   [(V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI1_AVX2
    [(V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI1_AVX512
!   [(V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI1_AVX512F
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI])
  
  (define_mode_iterator VI1_AVX512VNNI
!   [(V64QI "TARGET_AVX512VNNI && TARGET_EVEX512") (V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI1_AVX512VNNIBW
!   [(V64QI "(TARGET_AVX512BW || TARGET_AVX512VNNI) && TARGET_EVEX512")
     (V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI12_256_512_AVX512VL
!   [(V64QI "TARGET_EVEX512") (V32QI "TARGET_AVX512VL")
!    (V32HI "TARGET_EVEX512") (V16HI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI2_AVX2
    [(V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI2_AVX2_AVX512BW
!   [(V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI2_AVX512F
!   [(V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI2_AVX512VNNIBW
!   [(V32HI "(TARGET_AVX512BW || TARGET_AVX512VNNI) && TARGET_EVEX512")
     (V16HI "TARGET_AVX2") V8HI])
  
- (define_mode_iterator VI2_AVX10_2
-   [(V32HI "TARGET_AVX10_2") V16HI V8HI])
- 
  (define_mode_iterator VI4_AVX
    [(V8SI "TARGET_AVX") V4SI])
  
--- 582,631 ----
    (V8SI "TARGET_AVX") (V4DI "TARGET_AVX")])
  
  (define_mode_iterator VI8
!   [(V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX") V2DI])
  
  (define_mode_iterator VI8_FVL
!   [(V8DI "TARGET_AVX512F") V4DI (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI8_AVX512VL
!   [V8DI (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI8_256_512
!   [V8DI (V4DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI1_AVX2
    [(V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI1_AVX512
!   [(V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI1_AVX512F
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI])
  
  (define_mode_iterator VI1_AVX512VNNI
!   [(V64QI "TARGET_AVX512VNNI") (V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI1_AVX512VNNIBW
!   [(V64QI "TARGET_AVX512BW || TARGET_AVX512VNNI")
     (V32QI "TARGET_AVX2") V16QI])
  
  (define_mode_iterator VI12_256_512_AVX512VL
!   [V64QI (V32QI "TARGET_AVX512VL")
!    V32HI (V16HI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI2_AVX2
    [(V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI2_AVX2_AVX512BW
!   [(V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI2_AVX512F
!   [(V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI2_AVX512VNNIBW
!   [(V32HI "TARGET_AVX512BW || TARGET_AVX512VNNI")
     (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI4_AVX
    [(V8SI "TARGET_AVX") V4SI])
  
***************
*** 678,742 ****
    [(V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI4_AVX512F
!   [(V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI4_AVX512VL
!   [(V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI4_AVX10_2
    [(V16SI "TARGET_AVX10_2") V8SI V4SI])
  
  (define_mode_iterator VI48_AVX512F_AVX512VL
!   [V4SI V8SI (V16SI "TARGET_AVX512F && TARGET_EVEX512")
     (V2DI "TARGET_AVX512VL") (V4DI "TARGET_AVX512VL")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")])
  
  (define_mode_iterator VI2_AVX512VL
!   [(V8HI "TARGET_AVX512VL") (V16HI "TARGET_AVX512VL") (V32HI "TARGET_EVEX512")])
  
  (define_mode_iterator VI2HFBF_AVX512VL
!   [(V8HI "TARGET_AVX512VL") (V16HI "TARGET_AVX512VL") (V32HI "TARGET_EVEX512")
!    (V8HF "TARGET_AVX512VL") (V16HF "TARGET_AVX512VL") (V32HF "TARGET_EVEX512")
!    (V8BF "TARGET_AVX512VL") (V16BF "TARGET_AVX512VL") (V32BF "TARGET_EVEX512")])
  
  (define_mode_iterator VI2H_AVX512VL
!   [(V8HI "TARGET_AVX512VL") (V16HI "TARGET_AVX512VL") (V32HI "TARGET_EVEX512")
!    (V8SI "TARGET_AVX512VL") (V16SI "TARGET_EVEX512")
!    (V8DI "TARGET_EVEX512")])
  
  (define_mode_iterator VI1_AVX512VL_F
!   [V32QI (V16QI "TARGET_AVX512VL") (V64QI "TARGET_AVX512F && TARGET_EVEX512")])
  
  (define_mode_iterator VI8_AVX2_AVX512BW
!   [(V8DI "TARGET_AVX512BW && TARGET_EVEX512") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI8_AVX2
    [(V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI8_AVX2_AVX512F
!   [(V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI8_AVX_AVX512F
!   [(V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX")])
  
  (define_mode_iterator VI4_128_8_256
    [V4SI V4DI])
  
  ;; All V8D* modes
  (define_mode_iterator V8FI
!   [(V8DF "TARGET_EVEX512") (V8DI "TARGET_EVEX512")])
  
  ;; All V16S* modes
  (define_mode_iterator V16FI
!   [(V16SF "TARGET_EVEX512") (V16SI "TARGET_EVEX512")])
  
  ;; ??? We should probably use TImode instead.
  (define_mode_iterator VIMAX_AVX2_AVX512BW
!   [(V4TI "TARGET_AVX512BW && TARGET_EVEX512") (V2TI "TARGET_AVX2") V1TI])
  
  ;; Suppose TARGET_AVX512BW as baseline
  (define_mode_iterator VIMAX_AVX512VL
!   [(V4TI "TARGET_EVEX512") (V2TI "TARGET_AVX512VL") (V1TI "TARGET_AVX512VL")])
  
  (define_mode_iterator VIMAX_AVX2
    [(V2TI "TARGET_AVX2") V1TI])
--- 633,696 ----
    [(V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI4_AVX512F
!   [(V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI4_AVX512VL
!   [V16SI (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI4_AVX10_2
    [(V16SI "TARGET_AVX10_2") V8SI V4SI])
  
  (define_mode_iterator VI48_AVX512F_AVX512VL
!   [V4SI V8SI (V16SI "TARGET_AVX512F")
     (V2DI "TARGET_AVX512VL") (V4DI "TARGET_AVX512VL")
!    (V8DI "TARGET_AVX512F")])
  
  (define_mode_iterator VI2_AVX512VL
!   [(V8HI "TARGET_AVX512VL") (V16HI "TARGET_AVX512VL") V32HI])
  
  (define_mode_iterator VI2HFBF_AVX512VL
!   [(V8HI "TARGET_AVX512VL") (V16HI "TARGET_AVX512VL") V32HI
!    (V8HF "TARGET_AVX512VL") (V16HF "TARGET_AVX512VL") V32HF
!    (V8BF "TARGET_AVX512VL") (V16BF "TARGET_AVX512VL") V32BF])
  
  (define_mode_iterator VI2H_AVX512VL
!   [(V8HI "TARGET_AVX512VL") (V16HI "TARGET_AVX512VL") V32HI
!    (V8SI "TARGET_AVX512VL") V16SI V8DI])
  
  (define_mode_iterator VI1_AVX512VL_F
!   [V32QI (V16QI "TARGET_AVX512VL") (V64QI "TARGET_AVX512F")])
  
  (define_mode_iterator VI8_AVX2_AVX512BW
!   [(V8DI "TARGET_AVX512BW") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI8_AVX2
    [(V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI8_AVX2_AVX512F
!   [(V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI8_AVX_AVX512F
!   [(V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX")])
  
  (define_mode_iterator VI4_128_8_256
    [V4SI V4DI])
  
  ;; All V8D* modes
  (define_mode_iterator V8FI
!   [V8DF V8DI])
  
  ;; All V16S* modes
  (define_mode_iterator V16FI
!   [V16SF V16SI])
  
  ;; ??? We should probably use TImode instead.
  (define_mode_iterator VIMAX_AVX2_AVX512BW
!   [(V4TI "TARGET_AVX512BW") (V2TI "TARGET_AVX2") V1TI])
  
  ;; Suppose TARGET_AVX512BW as baseline
  (define_mode_iterator VIMAX_AVX512VL
!   [V4TI (V2TI "TARGET_AVX512VL") (V1TI "TARGET_AVX512VL")])
  
  (define_mode_iterator VIMAX_AVX2
    [(V2TI "TARGET_AVX2") V1TI])
***************
*** 746,762 ****
     (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI12_AVX2_AVX512BW
!   [(V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI24_AVX2
    [(V16HI "TARGET_AVX2") V8HI
     (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI124_AVX2_24_AVX512F_1_AVX512BW
!   [(V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI124_AVX2
    [(V32QI "TARGET_AVX2") V16QI
--- 700,716 ----
     (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI12_AVX2_AVX512BW
!   [(V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX2") V8HI])
  
  (define_mode_iterator VI24_AVX2
    [(V16HI "TARGET_AVX2") V8HI
     (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI124_AVX2_24_AVX512F_1_AVX512BW
!   [(V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI124_AVX2
    [(V32QI "TARGET_AVX2") V16QI
***************
*** 764,780 ****
     (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI248_AVX512VL
!   [(V32HI "TARGET_EVEX512") (V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")
     (V16HI "TARGET_AVX512VL") (V8SI "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI248_AVX512VLBW
!   [(V32HI "TARGET_AVX512BW && TARGET_EVEX512")
     (V16HI "TARGET_AVX512VL && TARGET_AVX512BW")
     (V8HI "TARGET_AVX512VL && TARGET_AVX512BW")
!    (V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    (V8DI "TARGET_EVEX512") (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI48_AVX2
    [(V8SI "TARGET_AVX2") V4SI
--- 718,734 ----
     (V8SI "TARGET_AVX2") V4SI])
  
  (define_mode_iterator VI248_AVX512VL
!   [V32HI V16SI V8DI
     (V16HI "TARGET_AVX512VL") (V8SI "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI248_AVX512VLBW
!   [(V32HI "TARGET_AVX512BW")
     (V16HI "TARGET_AVX512VL && TARGET_AVX512BW")
     (V8HI "TARGET_AVX512VL && TARGET_AVX512BW")
!    V16SI (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    V8DI (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI48_AVX2
    [(V8SI "TARGET_AVX2") V4SI
***************
*** 786,802 ****
     (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI248_AVX2_8_AVX512F_24_AVX512BW
!   [(V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512BW && TARGET_EVEX512") (V8SI "TARGET_AVX2") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI248_AVX512BW
!   [(V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16SI "TARGET_EVEX512")
!    (V8DI "TARGET_EVEX512")])
  
  (define_mode_iterator VI248_AVX512BW_AVX512VL
!   [(V32HI "TARGET_AVX512BW && TARGET_EVEX512") 
!    (V4DI "TARGET_AVX512VL") (V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")])
  
  ;; Suppose TARGET_AVX512VL as baseline
  (define_mode_iterator VI248_AVX512BW_1
--- 740,755 ----
     (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI248_AVX2_8_AVX512F_24_AVX512BW
!   [(V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512BW") (V8SI "TARGET_AVX2") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX2") V2DI])
  
  (define_mode_iterator VI248_AVX512BW
!   [(V32HI "TARGET_AVX512BW") V16SI V8DI])
  
  (define_mode_iterator VI248_AVX512BW_AVX512VL
!   [(V32HI "TARGET_AVX512BW")
!    (V4DI "TARGET_AVX512VL") V16SI V8DI])
  
  ;; Suppose TARGET_AVX512VL as baseline
  (define_mode_iterator VI248_AVX512BW_1
***************
*** 810,825 ****
    V4DI V2DI])
     
  (define_mode_iterator VI48_AVX512F
!   [(V16SI "TARGET_AVX512F && TARGET_EVEX512") V8SI V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") V4DI V2DI])
  
  (define_mode_iterator VI48_AVX_AVX512F
!   [(V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX") V2DI])
  
  (define_mode_iterator VI12_AVX_AVX512F
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI])
  
  (define_mode_iterator V48_128_256
    [V4SF V2DF
--- 763,778 ----
    V4DI V2DI])
     
  (define_mode_iterator VI48_AVX512F
!   [(V16SI "TARGET_AVX512F") V8SI V4SI
!    (V8DI "TARGET_AVX512F") V4DI V2DI])
  
  (define_mode_iterator VI48_AVX_AVX512F
!   [(V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX") V2DI])
  
  (define_mode_iterator VI12_AVX_AVX512F
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI])
  
  (define_mode_iterator V48_128_256
    [V4SF V2DF
***************
*** 960,969 ****
  (define_mode_iterator VI248_128 [V8HI V4SI V2DI])
  (define_mode_iterator VI248_256 [V16HI V8SI V4DI])
  (define_mode_iterator VI248_512
!   [(V32HI "TARGET_EVEX512") (V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")])
  (define_mode_iterator VI48_128 [V4SI V2DI])
  (define_mode_iterator VI148_512
!   [(V64QI "TARGET_EVEX512") (V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")])
  (define_mode_iterator VI148_256 [V32QI V8SI V4DI])
  (define_mode_iterator VI148_128 [V16QI V4SI V2DI])
  
--- 913,922 ----
  (define_mode_iterator VI248_128 [V8HI V4SI V2DI])
  (define_mode_iterator VI248_256 [V16HI V8SI V4DI])
  (define_mode_iterator VI248_512
!   [V32HI V16SI V8DI])
  (define_mode_iterator VI48_128 [V4SI V2DI])
  (define_mode_iterator VI148_512
!   [V64QI V16SI V8DI])
  (define_mode_iterator VI148_256 [V32QI V8SI V4DI])
  (define_mode_iterator VI148_128 [V16QI V4SI V2DI])
  
***************
*** 971,1045 ****
  (define_mode_iterator VI124_256 [V32QI V16HI V8SI])
  (define_mode_iterator VI124_256_AVX512F_AVX512BW
    [V32QI V16HI V8SI
!    (V64QI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512")])
  (define_mode_iterator VI48_256 [V8SI V4DI])
  (define_mode_iterator VI48_512
!   [(V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")])
  (define_mode_iterator VI4_256_8_512 [V8SI V8DI])
  (define_mode_iterator VI_AVX512BW
!   [(V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V64QI "TARGET_AVX512BW && TARGET_EVEX512")])
  (define_mode_iterator VIHFBF_AVX512BW
!   [(V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V64QI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V32HF "TARGET_AVX512BW && TARGET_EVEX512")
!    (V32BF "TARGET_AVX512BW && TARGET_EVEX512")])
  
  ;; Int-float size matches
  (define_mode_iterator VI2F_256_512
!   [V16HI (V32HI "TARGET_EVEX512")
!    V16HF (V32HF "TARGET_EVEX512")
!    V16BF (V32BF "TARGET_EVEX512")])
  (define_mode_iterator VI4F_128 [V4SI V4SF])
  (define_mode_iterator VI8F_128 [V2DI V2DF])
  (define_mode_iterator VI4F_256 [V8SI V8SF])
  (define_mode_iterator VI8F_256 [V4DI V4DF])
  (define_mode_iterator VI4F_256_512
!   [V8SI V8SF
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512")])
  (define_mode_iterator VI48F_256_512
    [V8SI V8SF
!   (V16SI "TARGET_AVX512F && TARGET_EVEX512")
!   (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!   (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!   (V8DF "TARGET_AVX512F && TARGET_EVEX512")
!   (V4DI "TARGET_AVX512VL") (V4DF  "TARGET_AVX512VL")])
  (define_mode_iterator VF48H_AVX512VL
!   [(V8DF "TARGET_EVEX512") (V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL")])
  
  (define_mode_iterator VF48_128
    [V2DF V4SF])
  
  (define_mode_iterator VI48F
!   [(V16SI "TARGET_EVEX512") (V16SF "TARGET_EVEX512")
!    (V8DI "TARGET_EVEX512") (V8DF "TARGET_EVEX512")
     (V8SI "TARGET_AVX512VL") (V8SF "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  (define_mode_iterator VI12_VI48F_AVX512VL
!   [(V16SI "TARGET_AVX512F && TARGET_EVEX512")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")
     (V8SI "TARGET_AVX512VL") (V8SF "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")
!    (V64QI "TARGET_EVEX512") (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")
!    (V32HI "TARGET_EVEX512") (V16HI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI48F_256 [V8SI V8SF V4DI V4DF])
  
  (define_mode_iterator V8_128 [V8HI V8HF V8BF])
  (define_mode_iterator V16_256 [V16HI V16HF V16BF])
  (define_mode_iterator V32_512
!  [(V32HI "TARGET_EVEX512") (V32HF "TARGET_EVEX512") (V32BF "TARGET_EVEX512")])
  
  ;; Mapping from float mode to required SSE level
  (define_mode_attr sse
--- 924,985 ----
  (define_mode_iterator VI124_256 [V32QI V16HI V8SI])
  (define_mode_iterator VI124_256_AVX512F_AVX512BW
    [V32QI V16HI V8SI
!    (V64QI "TARGET_AVX512BW") (V32HI "TARGET_AVX512BW")
!    (V16SI "TARGET_AVX512F")])
  (define_mode_iterator VI48_256 [V8SI V4DI])
  (define_mode_iterator VI48_512
!   [V16SI V8DI])
  (define_mode_iterator VI4_256_8_512 [V8SI V8DI])
  (define_mode_iterator VI_AVX512BW
!   [V16SI V8DI
!    (V32HI "TARGET_AVX512BW") (V64QI "TARGET_AVX512BW")])
  (define_mode_iterator VIHFBF_AVX512BW
!   [V16SI V8DI
!    (V32HI "TARGET_AVX512BW") (V64QI "TARGET_AVX512BW")
!    (V32HF "TARGET_AVX512BW") (V32BF "TARGET_AVX512BW")])
  
  ;; Int-float size matches
  (define_mode_iterator VI2F_256_512
!   [V16HI V32HI V16HF V32HF V16BF V32BF])
  (define_mode_iterator VI4F_128 [V4SI V4SF])
  (define_mode_iterator VI8F_128 [V2DI V2DF])
  (define_mode_iterator VI4F_256 [V8SI V8SF])
  (define_mode_iterator VI8F_256 [V4DI V4DF])
  (define_mode_iterator VI4F_256_512
!   [V8SI V8SF (V16SI "TARGET_AVX512F") (V16SF "TARGET_AVX512F")])
  (define_mode_iterator VI48F_256_512
    [V8SI V8SF
!    (V16SI "TARGET_AVX512F") (V16SF "TARGET_AVX512F")
!    (V8DI "TARGET_AVX512F") (V8DF "TARGET_AVX512F")
!    (V4DI "TARGET_AVX512VL") (V4DF  "TARGET_AVX512VL")])
  (define_mode_iterator VF48H_AVX512VL
!   [V8DF V16SF (V8SF "TARGET_AVX512VL")])
  
  (define_mode_iterator VF48_128
    [V2DF V4SF])
  
  (define_mode_iterator VI48F
!   [V16SI V16SF V8DI V8DF
     (V8SI "TARGET_AVX512VL") (V8SF "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  (define_mode_iterator VI12_VI48F_AVX512VL
!   [(V16SI "TARGET_AVX512F") (V16SF "TARGET_AVX512F")
!    (V8DI "TARGET_AVX512F") (V8DF "TARGET_AVX512F")
     (V8SI "TARGET_AVX512VL") (V8SF "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")
!    V64QI (V16QI "TARGET_AVX512VL") (V32QI "TARGET_AVX512VL")
!    V32HI (V16HI "TARGET_AVX512VL") (V8HI "TARGET_AVX512VL")])
  
  (define_mode_iterator VI48F_256 [V8SI V8SF V4DI V4DF])
  
  (define_mode_iterator V8_128 [V8HI V8HF V8BF])
  (define_mode_iterator V16_256 [V16HI V16HF V16BF])
  (define_mode_iterator V32_512
!  [V32HI V32HF V32BF])
  
  ;; Mapping from float mode to required SSE level
  (define_mode_attr sse
***************
*** 1451,1457 ****
  ;; Mix-n-match
  (define_mode_iterator AVX256MODE2P [V8SI V8SF V4DF])
  (define_mode_iterator AVX512MODE2P
!   [(V16SI "TARGET_EVEX512") (V16SF "TARGET_EVEX512") (V8DF "TARGET_EVEX512")])
  
  ;; Mapping for dbpsabbw modes
  (define_mode_attr dbpsadbwmode
--- 1391,1397 ----
  ;; Mix-n-match
  (define_mode_iterator AVX256MODE2P [V8SI V8SF V4DF])
  (define_mode_iterator AVX512MODE2P
!   [V16SI V16SF V8DF])
  
  ;; Mapping for dbpsabbw modes
  (define_mode_attr dbpsadbwmode
***************
*** 2059,2069 ****
  (define_mode_iterator STORENT_MODE
    [(DI "TARGET_SSE2 && TARGET_64BIT") (SI "TARGET_SSE2")
     (SF "TARGET_SSE4A") (DF "TARGET_SSE4A")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!    (V4DI "TARGET_AVX") (V2DI "TARGET_SSE2")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")
!    (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")])
  
  (define_expand "storent<mode>"
    [(set (match_operand:STORENT_MODE 0 "memory_operand")
--- 1999,2007 ----
  (define_mode_iterator STORENT_MODE
    [(DI "TARGET_SSE2 && TARGET_64BIT") (SI "TARGET_SSE2")
     (SF "TARGET_SSE4A") (DF "TARGET_SSE4A")
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX") (V2DI "TARGET_SSE2")
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")])
  
  (define_expand "storent<mode>"
    [(set (match_operand:STORENT_MODE 0 "memory_operand")
***************
*** 2867,2876 ****
  })
  
  (define_expand "div<mode>3"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand")
! 	(div:VBF_AVX10_2
! 	  (match_operand:VBF_AVX10_2 1 "register_operand")
! 	  (match_operand:VBF_AVX10_2 2 "vector_operand")))]
    "TARGET_AVX10_2"
  {
    if (TARGET_RECIP_VEC_DIV
--- 2805,2814 ----
  })
  
  (define_expand "div<mode>3"
!   [(set (match_operand:VBF 0 "register_operand")
! 	(div:VBF
! 	  (match_operand:VBF 1 "register_operand")
! 	  (match_operand:VBF 2 "vector_operand")))]
    "TARGET_AVX10_2"
  {
    if (TARGET_RECIP_VEC_DIV
***************
*** 3907,3921 ****
  (define_mode_iterator REDUC_PLUS_MODE
   [(V4DF "TARGET_AVX") (V8SF "TARGET_AVX")
    (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!   (V8DF "TARGET_AVX512F && TARGET_EVEX512")
!   (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!   (V32HF "TARGET_AVX512FP16 && TARGET_AVX512VL && TARGET_EVEX512")
    (V32QI "TARGET_AVX") (V16HI "TARGET_AVX")
    (V8SI "TARGET_AVX")  (V4DI "TARGET_AVX")
!   (V64QI "TARGET_AVX512F && TARGET_EVEX512")
!   (V32HI "TARGET_AVX512F && TARGET_EVEX512")
!   (V16SI "TARGET_AVX512F && TARGET_EVEX512")
!   (V8DI "TARGET_AVX512F && TARGET_EVEX512")])
  
  (define_expand "reduc_plus_scal_<mode>"
   [(plus:REDUC_PLUS_MODE
--- 3845,3856 ----
  (define_mode_iterator REDUC_PLUS_MODE
   [(V4DF "TARGET_AVX") (V8SF "TARGET_AVX")
    (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!   (V8DF "TARGET_AVX512F") (V16SF "TARGET_AVX512F")
!   (V32HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
    (V32QI "TARGET_AVX") (V16HI "TARGET_AVX")
    (V8SI "TARGET_AVX")  (V4DI "TARGET_AVX")
!   (V64QI "TARGET_AVX512F") (V32HI "TARGET_AVX512F")
!   (V16SI "TARGET_AVX512F") (V8DI "TARGET_AVX512F")])
  
  (define_expand "reduc_plus_scal_<mode>"
   [(plus:REDUC_PLUS_MODE
***************
*** 3958,3970 ****
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8SI "TARGET_AVX2") (V4DI "TARGET_AVX2")
     (V8SF "TARGET_AVX") (V4DF "TARGET_AVX")
!    (V64QI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V32HF "TARGET_AVX512FP16 && TARGET_AVX512VL && TARGET_EVEX512")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")])
  
  (define_expand "reduc_<code>_scal_<mode>"
    [(smaxmin:REDUC_SMINMAX_MODE
--- 3893,3903 ----
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8SI "TARGET_AVX2") (V4DI "TARGET_AVX2")
     (V8SF "TARGET_AVX") (V4DF "TARGET_AVX")
!    (V64QI "TARGET_AVX512BW")
!    (V32HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V32HI "TARGET_AVX512BW") (V16SI "TARGET_AVX512F")
!    (V8DI "TARGET_AVX512F") (V16SF "TARGET_AVX512F")
!    (V8DF "TARGET_AVX512F")])
  
  (define_expand "reduc_<code>_scal_<mode>"
    [(smaxmin:REDUC_SMINMAX_MODE
***************
*** 4073,4082 ****
  (define_mode_iterator REDUC_ANY_LOGIC_MODE
   [(V32QI "TARGET_AVX") (V16HI "TARGET_AVX")
    (V8SI "TARGET_AVX")  (V4DI "TARGET_AVX")
!   (V64QI "TARGET_AVX512F && TARGET_EVEX512")
!   (V32HI "TARGET_AVX512F && TARGET_EVEX512")
!   (V16SI "TARGET_AVX512F && TARGET_EVEX512")
!   (V8DI "TARGET_AVX512F && TARGET_EVEX512")])
  
  (define_expand "reduc_<code>_scal_<mode>"
   [(any_logic:REDUC_ANY_LOGIC_MODE
--- 4006,4013 ----
  (define_mode_iterator REDUC_ANY_LOGIC_MODE
   [(V32QI "TARGET_AVX") (V16HI "TARGET_AVX")
    (V8SI "TARGET_AVX")  (V4DI "TARGET_AVX")
!   (V64QI "TARGET_AVX512F") (V32HI "TARGET_AVX512F")
!   (V16SI "TARGET_AVX512F") (V8DI "TARGET_AVX512F")])
  
  (define_expand "reduc_<code>_scal_<mode>"
   [(any_logic:REDUC_ANY_LOGIC_MODE
***************
*** 4999,5006 ****
  (define_expand "vec_cmp<mode><avx512fmaskmodelower>"
    [(set (match_operand:<avx512fmaskmode> 0 "register_operand")
  	(match_operator:<avx512fmaskmode> 1 ""
! 	  [(match_operand:VBF_AVX10_2 2 "register_operand")
! 	   (match_operand:VBF_AVX10_2 3 "nonimmediate_operand")]))]
    "TARGET_AVX10_2"
  {
    bool ok = ix86_expand_mask_vec_cmp (operands[0], GET_CODE (operands[1]),
--- 4930,4937 ----
  (define_expand "vec_cmp<mode><avx512fmaskmodelower>"
    [(set (match_operand:<avx512fmaskmode> 0 "register_operand")
  	(match_operator:<avx512fmaskmode> 1 ""
! 	  [(match_operand:VBF 2 "register_operand")
! 	   (match_operand:VBF 3 "nonimmediate_operand")]))]
    "TARGET_AVX10_2"
  {
    bool ok = ix86_expand_mask_vec_cmp (operands[0], GET_CODE (operands[1]),
***************
*** 5649,5655 ****
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx,avx512vl,avx512f_512")
     (set_attr "type" "sselog")
     (set_attr "prefix" "orig,vex,evex,evex")
     (set (attr "mode")
--- 5580,5586 ----
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx,avx512vl,avx512f")
     (set_attr "type" "sselog")
     (set_attr "prefix" "orig,vex,evex,evex")
     (set (attr "mode")
***************
*** 5706,5712 ****
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx_noavx512vl,avx512vl,avx512f_512")
     (set_attr "addr" "*,gpr16,*,*")
     (set_attr "type" "sselog")
     (set (attr "prefix_data16")
--- 5637,5643 ----
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx_noavx512f,avx512vl,avx512f")
     (set_attr "addr" "*,gpr16,*,*")
     (set_attr "type" "sselog")
     (set (attr "prefix_data16")
***************
*** 5779,5785 ****
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx,avx512vl,avx512f_512")
     (set_attr "type" "sselog")
     (set_attr "prefix" "orig,vex,evex,evex")
     (set (attr "mode")
--- 5710,5716 ----
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx,avx512vl,avx512f")
     (set_attr "type" "sselog")
     (set_attr "prefix" "orig,vex,evex,evex")
     (set (attr "mode")
***************
*** 5841,5847 ****
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx,avx512vl,avx512f_512")
     (set_attr "type" "sselog")
     (set (attr "prefix_data16")
       (if_then_else
--- 5772,5778 ----
    output_asm_insn (buf, operands);
    return "";
  }
!   [(set_attr "isa" "noavx,avx,avx512vl,avx512f")
     (set_attr "type" "sselog")
     (set (attr "prefix_data16")
       (if_then_else
***************
*** 5887,5901 ****
     (V2DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
     (V8SF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
     (V4DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")
!    (HF "TARGET_AVX512FP16")
!    (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")
!    (V8BF "TARGET_AVX10_2")
!    (V16BF "TARGET_AVX10_2")
!    (V32BF "TARGET_AVX10_2")])
  
  (define_expand "fma<mode>4"
    [(set (match_operand:FMAMODEM 0 "register_operand")
--- 5818,5827 ----
     (V2DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
     (V8SF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
     (V4DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
!    (V16SF "TARGET_AVX512F") (V8DF "TARGET_AVX512F")
!    (HF "TARGET_AVX512FP16") (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
!    (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL") (V32HF "TARGET_AVX512FP16")
!    (V8BF "TARGET_AVX10_2") (V16BF "TARGET_AVX10_2") (V32BF "TARGET_AVX10_2")])
  
  (define_expand "fma<mode>4"
    [(set (match_operand:FMAMODEM 0 "register_operand")
***************
*** 5933,5940 ****
    (V2DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
    (V8SF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
    (V4DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
!   (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!   (V8DF "TARGET_AVX512F && TARGET_EVEX512")])
  
  (define_mode_iterator FMAMODE
    [SF DF V4SF V2DF V8SF V4DF])
--- 5859,5865 ----
    (V2DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
    (V8SF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
    (V4DF "TARGET_FMA || TARGET_FMA4 || TARGET_AVX512VL")
!   (V16SF "TARGET_AVX512F") (V8DF "TARGET_AVX512F")])
  
  (define_mode_iterator FMAMODE
    [SF DF V4SF V2DF V8SF V4DF])
***************
*** 6004,6017 ****
  
  ;; Suppose AVX-512F as baseline
  (define_mode_iterator VFH_SF_AVX512VL
!   [(V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (HF "TARGET_AVX512FP16")
!    SF (V16SF "TARGET_EVEX512")
!    (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    DF (V8DF "TARGET_EVEX512")
!    (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_insn "<sd_mask_codefor>fma_fmadd_<mode><sd_maskz_name><round_name>"
    [(set (match_operand:VFH_SF_AVX512VL 0 "register_operand" "=v,v,v")
--- 5929,5940 ----
  
  ;; Suppose AVX-512F as baseline
  (define_mode_iterator VFH_SF_AVX512VL
!   [(V32HF "TARGET_AVX512FP16")
     (V16HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (V8HF "TARGET_AVX512FP16 && TARGET_AVX512VL")
     (HF "TARGET_AVX512FP16")
!    SF V16SF (V8SF "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
!    DF V8DF (V4DF "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")])
  
  (define_insn "<sd_mask_codefor>fma_fmadd_<mode><sd_maskz_name><round_name>"
    [(set (match_operand:VFH_SF_AVX512VL 0 "register_operand" "=v,v,v")
***************
*** 8759,8765 ****
  	(unspec:V16SI
  	  [(match_operand:V16SF 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_FIX_NOTRUNC))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtps2dq\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 8682,8688 ----
  	(unspec:V16SI
  	  [(match_operand:V16SF 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_FIX_NOTRUNC))]
!   "TARGET_AVX512F"
    "vcvtps2dq\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 8827,8833 ****
  	(unspec:V16SI
  	  [(match_operand:V16SF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_VCVTT_U))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvttps2<vcvtt_suffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 8750,8756 ----
  	(unspec:V16SI
  	  [(match_operand:V16SF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_VCVTT_U))]
!   "TARGET_AVX512F"
    "vcvttps2<vcvtt_suffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 8837,8843 ****
    [(set (match_operand:V16SI 0 "register_operand" "=v")
  	(any_fix:V16SI
  	  (match_operand:V16SF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvttps2<fixsuffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 8760,8766 ----
    [(set (match_operand:V16SI 0 "register_operand" "=v")
  	(any_fix:V16SI
  	  (match_operand:V16SF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")))]
!   "TARGET_AVX512F"
    "vcvttps2<fixsuffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 9425,9431 ****
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtdq2pd\t{%t1, %0|%0, %t1}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 9348,9354 ----
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F"
    "vcvtdq2pd\t{%t1, %0|%0, %t1}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 9461,9467 ****
  	(unspec:V8SI
  	  [(match_operand:V8DF 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_FIX_NOTRUNC))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtpd2dq\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 9384,9390 ----
  	(unspec:V8SI
  	  [(match_operand:V8DF 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_FIX_NOTRUNC))]
!   "TARGET_AVX512F"
    "vcvtpd2dq\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 9620,9626 ****
  	(unspec:V8SI
  	  [(match_operand:V8DF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_VCVTT_U))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvttpd2<vcvtt_suffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 9543,9549 ----
  	(unspec:V8SI
  	  [(match_operand:V8DF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_VCVTT_U))]
!   "TARGET_AVX512F"
    "vcvttpd2<vcvtt_suffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 9630,9636 ****
    [(set (match_operand:V8SI 0 "register_operand" "=v")
  	(any_fix:V8SI
  	  (match_operand:V8DF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvttpd2<fixsuffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 9553,9559 ----
    [(set (match_operand:V8SI 0 "register_operand" "=v")
  	(any_fix:V8SI
  	  (match_operand:V8DF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")))]
!   "TARGET_AVX512F"
    "vcvttpd2<fixsuffix>dq\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 10146,10152 ****
    [(set (match_operand:V8SF 0 "register_operand" "=v")
  	(float_truncate:V8SF
  	  (match_operand:V8DF 1 "<round_nimm_predicate>" "<round_constraint>")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtpd2ps\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 10069,10075 ----
    [(set (match_operand:V8SF 0 "register_operand" "=v")
  	(float_truncate:V8SF
  	  (match_operand:V8DF 1 "<round_nimm_predicate>" "<round_constraint>")))]
!   "TARGET_AVX512F"
    "vcvtpd2ps\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 10308,10314 ****
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtps2pd\t{%t1, %0|%0, %t1}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 10231,10237 ----
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F"
    "vcvtps2pd\t{%t1, %0|%0, %t1}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 10514,10520 ****
     (set (match_operand:V8DF 0 "register_operand")
  	(float_extend:V8DF
  	  (match_dup 2)))]
! "TARGET_AVX512F && TARGET_EVEX512"
  "operands[2] = gen_reg_rtx (V8SFmode);")
  
  (define_expand "vec_unpacks_lo_v4sf"
--- 10437,10443 ----
     (set (match_operand:V8DF 0 "register_operand")
  	(float_extend:V8DF
  	  (match_dup 2)))]
! "TARGET_AVX512F"
  "operands[2] = gen_reg_rtx (V8SFmode);")
  
  (define_expand "vec_unpacks_lo_v4sf"
***************
*** 10652,10658 ****
     (set (match_operand:V8DF 0 "register_operand")
  	(float:V8DF
  	  (match_dup 2)))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "operands[2] = gen_reg_rtx (V8SImode);")
  
  (define_expand "vec_unpacks_float_lo_v16si"
--- 10575,10581 ----
     (set (match_operand:V8DF 0 "register_operand")
  	(float:V8DF
  	  (match_dup 2)))]
!   "TARGET_AVX512F"
    "operands[2] = gen_reg_rtx (V8SImode);")
  
  (define_expand "vec_unpacks_float_lo_v16si"
***************
*** 10664,10670 ****
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_expand "vec_unpacku_float_hi_v4si"
    [(set (match_dup 5)
--- 10587,10593 ----
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F")
  
  (define_expand "vec_unpacku_float_hi_v4si"
    [(set (match_dup 5)
***************
*** 10760,10766 ****
  (define_expand "vec_unpacku_float_hi_v16si"
    [(match_operand:V8DF 0 "register_operand")
     (match_operand:V16SI 1 "register_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    REAL_VALUE_TYPE TWO32r;
    rtx k, x, tmp[4];
--- 10683,10689 ----
  (define_expand "vec_unpacku_float_hi_v16si"
    [(match_operand:V8DF 0 "register_operand")
     (match_operand:V16SI 1 "register_operand")]
!   "TARGET_AVX512F"
  {
    REAL_VALUE_TYPE TWO32r;
    rtx k, x, tmp[4];
***************
*** 10809,10815 ****
  (define_expand "vec_unpacku_float_lo_v16si"
    [(match_operand:V8DF 0 "register_operand")
     (match_operand:V16SI 1 "nonimmediate_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    REAL_VALUE_TYPE TWO32r;
    rtx k, x, tmp[3];
--- 10732,10738 ----
  (define_expand "vec_unpacku_float_lo_v16si"
    [(match_operand:V8DF 0 "register_operand")
     (match_operand:V16SI 1 "nonimmediate_operand")]
!   "TARGET_AVX512F"
  {
    REAL_VALUE_TYPE TWO32r;
    rtx k, x, tmp[3];
***************
*** 10903,10909 ****
    [(match_operand:V16SI 0 "register_operand")
     (match_operand:V8DF 1 "nonimmediate_operand")
     (match_operand:V8DF 2 "nonimmediate_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    rtx r1, r2;
  
--- 10826,10832 ----
    [(match_operand:V16SI 0 "register_operand")
     (match_operand:V8DF 1 "nonimmediate_operand")
     (match_operand:V8DF 2 "nonimmediate_operand")]
!   "TARGET_AVX512F"
  {
    rtx r1, r2;
  
***************
*** 11018,11024 ****
    [(match_operand:V16SI 0 "register_operand")
     (match_operand:V8DF 1 "nonimmediate_operand")
     (match_operand:V8DF 2 "nonimmediate_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    rtx r1, r2;
  
--- 10941,10947 ----
    [(match_operand:V16SI 0 "register_operand")
     (match_operand:V8DF 1 "nonimmediate_operand")
     (match_operand:V8DF 2 "nonimmediate_operand")]
!   "TARGET_AVX512F"
  {
    rtx r1, r2;
  
***************
*** 11211,11217 ****
  		     (const_int 11) (const_int 27)
  		     (const_int 14) (const_int 30)
  		     (const_int 15) (const_int 31)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vunpckhps\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 11134,11140 ----
  		     (const_int 11) (const_int 27)
  		     (const_int 14) (const_int 30)
  		     (const_int 15) (const_int 31)])))]
!   "TARGET_AVX512F"
    "vunpckhps\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 11299,11305 ****
  		     (const_int 9) (const_int 25)
  		     (const_int 12) (const_int 28)
  		     (const_int 13) (const_int 29)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vunpcklps\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 11222,11228 ----
  		     (const_int 9) (const_int 25)
  		     (const_int 12) (const_int 28)
  		     (const_int 13) (const_int 29)])))]
!   "TARGET_AVX512F"
    "vunpcklps\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 11439,11445 ****
  		     (const_int 11) (const_int 11)
  		     (const_int 13) (const_int 13)
  		     (const_int 15) (const_int 15)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vmovshdup\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "sse")
     (set_attr "prefix" "evex")
--- 11362,11368 ----
  		     (const_int 11) (const_int 11)
  		     (const_int 13) (const_int 13)
  		     (const_int 15) (const_int 15)])))]
!   "TARGET_AVX512F"
    "vmovshdup\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "sse")
     (set_attr "prefix" "evex")
***************
*** 11492,11498 ****
  		     (const_int 10) (const_int 10)
  		     (const_int 12) (const_int 12)
  		     (const_int 14) (const_int 14)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vmovsldup\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "sse")
     (set_attr "prefix" "evex")
--- 11415,11421 ----
  		     (const_int 10) (const_int 10)
  		     (const_int 12) (const_int 12)
  		     (const_int 14) (const_int 14)])))]
!   "TARGET_AVX512F"
    "vmovsldup\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "sse")
     (set_attr "prefix" "evex")
***************
*** 12452,12460 ****
     (V8SF "32x4") (V8SI "32x4") (V4DF "64x2") (V4DI "64x2")])
  
  (define_mode_iterator AVX512_VEC
!   [(V8DF "TARGET_AVX512DQ && TARGET_EVEX512")
!    (V8DI "TARGET_AVX512DQ && TARGET_EVEX512")
!    (V16SF "TARGET_EVEX512") (V16SI "TARGET_EVEX512")])
  
  (define_expand "<extract_type>_vextract<shuffletype><extract_suf>_mask"
    [(match_operand:<ssequartermode> 0 "nonimmediate_operand")
--- 12375,12381 ----
     (V8SF "32x4") (V8SI "32x4") (V4DF "64x2") (V4DI "64x2")])
  
  (define_mode_iterator AVX512_VEC
!   [(V8DF "TARGET_AVX512DQ") (V8DI "TARGET_AVX512DQ") V16SF V16SI])
  
  (define_expand "<extract_type>_vextract<shuffletype><extract_suf>_mask"
    [(match_operand:<ssequartermode> 0 "nonimmediate_operand")
***************
*** 12623,12631 ****
    [(V16SF "32x8") (V16SI "32x8") (V8DF "64x4") (V8DI "64x4")])
  
  (define_mode_iterator AVX512_VEC_2
!   [(V16SF "TARGET_AVX512DQ && TARGET_EVEX512")
!    (V16SI "TARGET_AVX512DQ && TARGET_EVEX512")
!    (V8DF "TARGET_EVEX512") (V8DI "TARGET_EVEX512")])
  
  (define_expand "<extract_type_2>_vextract<shuffletype><extract_suf_2>_mask"
    [(match_operand:<ssehalfvecmode> 0 "nonimmediate_operand")
--- 12544,12550 ----
    [(V16SF "32x8") (V16SI "32x8") (V8DF "64x4") (V8DI "64x4")])
  
  (define_mode_iterator AVX512_VEC_2
!   [(V16SF "TARGET_AVX512DQ") (V16SI "TARGET_AVX512DQ") V8DF V8DI])
  
  (define_expand "<extract_type_2>_vextract<shuffletype><extract_suf_2>_mask"
    [(match_operand:<ssehalfvecmode> 0 "nonimmediate_operand")
***************
*** 13186,13192 ****
  		     (const_int 26) (const_int 27)
  		     (const_int 28) (const_int 29)
  		     (const_int 30) (const_int 31)])))]
!   "TARGET_AVX512F && TARGET_EVEX512
     && !(MEM_P (operands[0]) && MEM_P (operands[1]))"
  {
    if (TARGET_AVX512VL
--- 13105,13111 ----
  		     (const_int 26) (const_int 27)
  		     (const_int 28) (const_int 29)
  		     (const_int 30) (const_int 31)])))]
!   "TARGET_AVX512F
     && !(MEM_P (operands[0]) && MEM_P (operands[1]))"
  {
    if (TARGET_AVX512VL
***************
*** 13235,13241 ****
  		     (const_int 58) (const_int 59)
  		     (const_int 60) (const_int 61)
  		     (const_int 62) (const_int 63)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vextracti64x4\t{$0x1, %1, %0|%0, %1, 0x1}"
    [(set_attr "type" "sselog1")
     (set_attr "length_immediate" "1")
--- 13154,13160 ----
  		     (const_int 58) (const_int 59)
  		     (const_int 60) (const_int 61)
  		     (const_int 62) (const_int 63)])))]
!   "TARGET_AVX512F"
    "vextracti64x4\t{$0x1, %1, %0|%0, %1, 0x1}"
    [(set_attr "type" "sselog1")
     (set_attr "length_immediate" "1")
***************
*** 13333,13347 ****
  
  ;; Modes handled by vec_extract patterns.
  (define_mode_iterator VEC_EXTRACT_MODE
!   [(V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512BW && TARGET_EVEX512") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512BW && TARGET_EVEX512") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512") (V4DF "TARGET_AVX") V2DF
!    (V4TI "TARGET_AVX512F && TARGET_EVEX512") (V2TI "TARGET_AVX")])
  
  (define_expand "vec_extract<mode><ssescalarmodelower>"
    [(match_operand:<ssescalarmode> 0 "register_operand")
--- 13252,13266 ----
  
  ;; Modes handled by vec_extract patterns.
  (define_mode_iterator VEC_EXTRACT_MODE
!   [(V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512BW") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512BW") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX") V2DF
!    (V4TI "TARGET_AVX512F") (V2TI "TARGET_AVX")])
  
  (define_expand "vec_extract<mode><ssescalarmodelower>"
    [(match_operand:<ssescalarmode> 0 "register_operand")
***************
*** 13383,13389 ****
  		     (const_int 3) (const_int 11)
  		     (const_int 5) (const_int 13)
  		     (const_int 7) (const_int 15)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vunpckhpd\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 13302,13308 ----
  		     (const_int 3) (const_int 11)
  		     (const_int 5) (const_int 13)
  		     (const_int 7) (const_int 15)])))]
!   "TARGET_AVX512F"
    "vunpckhpd\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 13497,13503 ****
  		     (const_int 2) (const_int 10)
  		     (const_int 4) (const_int 12)
  		     (const_int 6) (const_int 14)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vmovddup\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "sselog1")
     (set_attr "prefix" "evex")
--- 13416,13422 ----
  		     (const_int 2) (const_int 10)
  		     (const_int 4) (const_int 12)
  		     (const_int 6) (const_int 14)])))]
!   "TARGET_AVX512F"
    "vmovddup\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "sselog1")
     (set_attr "prefix" "evex")
***************
*** 13513,13519 ****
  		     (const_int 2) (const_int 10)
  		     (const_int 4) (const_int 12)
  		     (const_int 6) (const_int 14)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vunpcklpd\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 13432,13438 ----
  		     (const_int 2) (const_int 10)
  		     (const_int 4) (const_int 12)
  		     (const_int 6) (const_int 14)])))]
!   "TARGET_AVX512F"
    "vunpcklpd\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 13725,13731 ****
  	   (match_operand:SI 4 "const_0_to_255_operand")]
  	  UNSPEC_VTERNLOG))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
  /* Disallow embeded broadcast for vector HFmode since
     it's not real AVX512FP16 instruction.  */
    && (GET_MODE_SIZE (GET_MODE_INNER (<MODE>mode)) >= 4
--- 13644,13650 ----
  	   (match_operand:SI 4 "const_0_to_255_operand")]
  	  UNSPEC_VTERNLOG))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
  /* Disallow embeded broadcast for vector HFmode since
     it's not real AVX512FP16 instruction.  */
    && (GET_MODE_SIZE (GET_MODE_INNER (<MODE>mode)) >= 4
***************
*** 13807,13813 ****
    [(set (match_operand:V 0 "register_operand")
  	(match_operand:V 1 "ternlog_operand"))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()"
    "#"
    "&& 1"
--- 13726,13732 ----
    [(set (match_operand:V 0 "register_operand")
  	(match_operand:V 1 "ternlog_operand"))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()"
    "#"
    "&& 1"
***************
*** 13837,13843 ****
  	    (match_operand:V 3 "regmem_or_bitnot_regmem_operand")
  	    (match_operand:V 4 "regmem_or_bitnot_regmem_operand"))))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()
     && (rtx_equal_p (STRIP_UNARY (operands[1]),
  		    STRIP_UNARY (operands[4]))
--- 13756,13762 ----
  	    (match_operand:V 3 "regmem_or_bitnot_regmem_operand")
  	    (match_operand:V 4 "regmem_or_bitnot_regmem_operand"))))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()
     && (rtx_equal_p (STRIP_UNARY (operands[1]),
  		    STRIP_UNARY (operands[4]))
***************
*** 13922,13928 ****
  	    (match_operand:V 3 "regmem_or_bitnot_regmem_operand"))
  	  (match_operand:V 4 "regmem_or_bitnot_regmem_operand")))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()
     && (rtx_equal_p (STRIP_UNARY (operands[1]),
  		    STRIP_UNARY (operands[4]))
--- 13841,13847 ----
  	    (match_operand:V 3 "regmem_or_bitnot_regmem_operand"))
  	  (match_operand:V 4 "regmem_or_bitnot_regmem_operand")))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()
     && (rtx_equal_p (STRIP_UNARY (operands[1]),
  		    STRIP_UNARY (operands[4]))
***************
*** 14006,14012 ****
  	    (match_operand:V 2 "regmem_or_bitnot_regmem_operand"))
  	  (match_operand:V 3 "regmem_or_bitnot_regmem_operand")))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()"
    "#"
    "&& 1"
--- 13925,13931 ----
  	    (match_operand:V 2 "regmem_or_bitnot_regmem_operand"))
  	  (match_operand:V 3 "regmem_or_bitnot_regmem_operand")))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
     && ix86_pre_reload_split ()"
    "#"
    "&& 1"
***************
*** 14156,14162 ****
     (match_operand:SI 3 "const_0_to_255_operand")
     (match_operand:V16SF 4 "register_operand")
     (match_operand:HI 5 "register_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    int mask = INTVAL (operands[3]);
    emit_insn (gen_avx512f_shufps512_1_mask (operands[0], operands[1], operands[2],
--- 14075,14081 ----
     (match_operand:SI 3 "const_0_to_255_operand")
     (match_operand:V16SF 4 "register_operand")
     (match_operand:HI 5 "register_operand")]
!   "TARGET_AVX512F"
  {
    int mask = INTVAL (operands[3]);
    emit_insn (gen_avx512f_shufps512_1_mask (operands[0], operands[1], operands[2],
***************
*** 14343,14349 ****
  		     (match_operand 16  "const_12_to_15_operand")
  		     (match_operand 17  "const_28_to_31_operand")
  		     (match_operand 18  "const_28_to_31_operand")])))]
!   "TARGET_AVX512F && TARGET_EVEX512
     && (INTVAL (operands[3]) == (INTVAL (operands[7]) - 4)
         && INTVAL (operands[4]) == (INTVAL (operands[8]) - 4)
         && INTVAL (operands[5]) == (INTVAL (operands[9]) - 4)
--- 14262,14268 ----
  		     (match_operand 16  "const_12_to_15_operand")
  		     (match_operand 17  "const_28_to_31_operand")
  		     (match_operand 18  "const_28_to_31_operand")])))]
!   "TARGET_AVX512F
     && (INTVAL (operands[3]) == (INTVAL (operands[7]) - 4)
         && INTVAL (operands[4]) == (INTVAL (operands[8]) - 4)
         && INTVAL (operands[5]) == (INTVAL (operands[9]) - 4)
***************
*** 14378,14384 ****
     (match_operand:SI 3 "const_0_to_255_operand")
     (match_operand:V8DF 4 "register_operand")
     (match_operand:QI 5 "register_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    int mask = INTVAL (operands[3]);
    emit_insn (gen_avx512f_shufpd512_1_mask (operands[0], operands[1], operands[2],
--- 14297,14303 ----
     (match_operand:SI 3 "const_0_to_255_operand")
     (match_operand:V8DF 4 "register_operand")
     (match_operand:QI 5 "register_operand")]
!   "TARGET_AVX512F"
  {
    int mask = INTVAL (operands[3]);
    emit_insn (gen_avx512f_shufpd512_1_mask (operands[0], operands[1], operands[2],
***************
*** 14408,14414 ****
  		     (match_operand 8 "const_12_to_13_operand")
  		     (match_operand 9 "const_6_to_7_operand")
  		     (match_operand 10 "const_14_to_15_operand")])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    int mask;
    mask = INTVAL (operands[3]);
--- 14327,14333 ----
  		     (match_operand 8 "const_12_to_13_operand")
  		     (match_operand 9 "const_6_to_7_operand")
  		     (match_operand 10 "const_14_to_15_operand")])))]
!   "TARGET_AVX512F"
  {
    int mask;
    mask = INTVAL (operands[3]);
***************
*** 14540,14546 ****
  		     (const_int 3) (const_int 11)
  		     (const_int 5) (const_int 13)
  		     (const_int 7) (const_int 15)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpunpckhqdq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 14459,14465 ----
  		     (const_int 3) (const_int 11)
  		     (const_int 5) (const_int 13)
  		     (const_int 7) (const_int 15)])))]
!   "TARGET_AVX512F"
    "vpunpckhqdq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 14590,14596 ****
  		     (const_int 2) (const_int 10)
  		     (const_int 4) (const_int 12)
  		     (const_int 6) (const_int 14)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpunpcklqdq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 14509,14515 ----
  		     (const_int 2) (const_int 10)
  		     (const_int 4) (const_int 12)
  		     (const_int 6) (const_int 14)])))]
!   "TARGET_AVX512F"
    "vpunpcklqdq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 14956,14962 ****
     (set_attr "mode" "V2DF,DF,V8DF")
     (set (attr "enabled")
  	(cond [(eq_attr "alternative" "2")
! 		 (symbol_ref "TARGET_AVX512F && TARGET_EVEX512
  			      && !TARGET_AVX512VL && !TARGET_PREFER_AVX256")
  	       (match_test "<mask_avx512vl_condition>")
  	         (const_string "*")
--- 14875,14881 ----
     (set_attr "mode" "V2DF,DF,V8DF")
     (set (attr "enabled")
  	(cond [(eq_attr "alternative" "2")
! 		 (symbol_ref "TARGET_AVX512F
  			      && !TARGET_AVX512VL && !TARGET_PREFER_AVX256")
  	       (match_test "<mask_avx512vl_condition>")
  	         (const_string "*")
***************
*** 15041,15053 ****
    [(set (match_operand:PMOV_DST_MODE_1 0 "nonimmediate_operand")
  	(truncate:PMOV_DST_MODE_1
  	  (match_operand:<pmov_src_mode> 1 "register_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_insn "*avx512f_<code><pmov_src_lower><mode>2"
    [(set (match_operand:PMOV_DST_MODE_1 0 "nonimmediate_operand" "=v,m")
  	(any_truncate:PMOV_DST_MODE_1
  	  (match_operand:<pmov_src_mode> 1 "register_operand" "v,v")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<trunsuffix><pmov_suff_1>\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
--- 14960,14972 ----
    [(set (match_operand:PMOV_DST_MODE_1 0 "nonimmediate_operand")
  	(truncate:PMOV_DST_MODE_1
  	  (match_operand:<pmov_src_mode> 1 "register_operand")))]
!   "TARGET_AVX512F")
  
  (define_insn "*avx512f_<code><pmov_src_lower><mode>2"
    [(set (match_operand:PMOV_DST_MODE_1 0 "nonimmediate_operand" "=v,m")
  	(any_truncate:PMOV_DST_MODE_1
  	  (match_operand:<pmov_src_mode> 1 "register_operand" "v,v")))]
!   "TARGET_AVX512F"
    "vpmov<trunsuffix><pmov_suff_1>\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
***************
*** 15069,15075 ****
  		     (const_int 10) (const_int 11)
  		     (const_int 12) (const_int 13)
  		     (const_int 14) (const_int 15)])))]
!   "TARGET_AVX512BW && TARGET_EVEX512 && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
--- 14988,14994 ----
  		     (const_int 10) (const_int 11)
  		     (const_int 12) (const_int 13)
  		     (const_int 14) (const_int 15)])))]
!   "TARGET_AVX512BW && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
***************
*** 15094,15100 ****
  		     (const_int 10) (const_int 11)
  		     (const_int 12) (const_int 13)
  		     (const_int 14) (const_int 15)])))]
!   "TARGET_AVX512BW && TARGET_EVEX512 && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
--- 15013,15019 ----
  		     (const_int 10) (const_int 11)
  		     (const_int 12) (const_int 13)
  		     (const_int 14) (const_int 15)])))]
!   "TARGET_AVX512BW && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
***************
*** 15178,15184 ****
  		     (const_int 2) (const_int 3)
  		     (const_int 4) (const_int 5)
  		     (const_int 6) (const_int 7)])))]
!   "TARGET_AVX512F && TARGET_EVEX512 && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
--- 15097,15103 ----
  		     (const_int 2) (const_int 3)
  		     (const_int 4) (const_int 5)
  		     (const_int 6) (const_int 7)])))]
!   "TARGET_AVX512F && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
***************
*** 15194,15200 ****
          (match_operand:<pmov_src_mode> 1 "register_operand" "v,v"))
        (match_operand:PMOV_DST_MODE_1 2 "nonimm_or_0_operand" "0C,0")
        (match_operand:<avx512fmaskmode> 3 "register_operand" "Yk,Yk")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<trunsuffix><pmov_suff_1>\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
--- 15113,15119 ----
          (match_operand:<pmov_src_mode> 1 "register_operand" "v,v"))
        (match_operand:PMOV_DST_MODE_1 2 "nonimm_or_0_operand" "0C,0")
        (match_operand:<avx512fmaskmode> 3 "register_operand" "Yk,Yk")))]
!   "TARGET_AVX512F"
    "vpmov<trunsuffix><pmov_suff_1>\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
***************
*** 15208,15226 ****
          (match_operand:<pmov_src_mode> 1 "register_operand"))
        (match_dup 0)
        (match_operand:<avx512fmaskmode> 2 "register_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_expand "truncv32hiv32qi2"
    [(set (match_operand:V32QI 0 "nonimmediate_operand")
  	(truncate:V32QI
  	  (match_operand:V32HI 1 "register_operand")))]
!   "TARGET_AVX512BW && TARGET_EVEX512")
  
  (define_insn "avx512bw_<code>v32hiv32qi2"
    [(set (match_operand:V32QI 0 "nonimmediate_operand" "=v,m")
  	(any_truncate:V32QI
  	    (match_operand:V32HI 1 "register_operand" "v,v")))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpmov<trunsuffix>wb\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
--- 15127,15145 ----
          (match_operand:<pmov_src_mode> 1 "register_operand"))
        (match_dup 0)
        (match_operand:<avx512fmaskmode> 2 "register_operand")))]
!   "TARGET_AVX512F")
  
  (define_expand "truncv32hiv32qi2"
    [(set (match_operand:V32QI 0 "nonimmediate_operand")
  	(truncate:V32QI
  	  (match_operand:V32HI 1 "register_operand")))]
!   "TARGET_AVX512BW")
  
  (define_insn "avx512bw_<code>v32hiv32qi2"
    [(set (match_operand:V32QI 0 "nonimmediate_operand" "=v,m")
  	(any_truncate:V32QI
  	    (match_operand:V32HI 1 "register_operand" "v,v")))]
!   "TARGET_AVX512BW"
    "vpmov<trunsuffix>wb\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
***************
*** 15250,15256 ****
  		     (const_int 26) (const_int 27)
  		     (const_int 28) (const_int 29)
  		     (const_int 30) (const_int 31)])))]
!   "TARGET_AVX512VBMI && TARGET_EVEX512 && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
--- 15169,15175 ----
  		     (const_int 26) (const_int 27)
  		     (const_int 28) (const_int 29)
  		     (const_int 30) (const_int 31)])))]
!   "TARGET_AVX512VBMI && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
***************
*** 15266,15272 ****
          (match_operand:V32HI 1 "register_operand" "v,v"))
        (match_operand:V32QI 2 "nonimm_or_0_operand" "0C,0")
        (match_operand:SI 3 "register_operand" "Yk,Yk")))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpmov<trunsuffix>wb\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
--- 15185,15191 ----
          (match_operand:V32HI 1 "register_operand" "v,v"))
        (match_operand:V32QI 2 "nonimm_or_0_operand" "0C,0")
        (match_operand:SI 3 "register_operand" "Yk,Yk")))]
!   "TARGET_AVX512BW"
    "vpmov<trunsuffix>wb\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "none,store")
***************
*** 15280,15286 ****
          (match_operand:V32HI 1 "register_operand"))
        (match_dup 0)
        (match_operand:SI 2 "register_operand")))]
!   "TARGET_AVX512BW && TARGET_EVEX512")
  
  (define_mode_iterator PMOV_DST_MODE_2
    [V4SI V8HI (V16QI "TARGET_AVX512BW")])
--- 15199,15205 ----
          (match_operand:V32HI 1 "register_operand"))
        (match_dup 0)
        (match_operand:SI 2 "register_operand")))]
!   "TARGET_AVX512BW")
  
  (define_mode_iterator PMOV_DST_MODE_2
    [V4SI V8HI (V16QI "TARGET_AVX512BW")])
***************
*** 16138,16144 ****
    [(set (match_operand:V8QI 0 "register_operand")
  	(truncate:V8QI
  	    (match_operand:V8DI 1 "register_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    rtx op0 = gen_reg_rtx (V16QImode);
  
--- 16057,16063 ----
    [(set (match_operand:V8QI 0 "register_operand")
  	(truncate:V8QI
  	    (match_operand:V8DI 1 "register_operand")))]
!   "TARGET_AVX512F"
  {
    rtx op0 = gen_reg_rtx (V16QImode);
  
***************
*** 16158,16164 ****
  			      (const_int 0) (const_int 0)
  			      (const_int 0) (const_int 0)
  			      (const_int 0) (const_int 0)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<trunsuffix>qb\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 16077,16083 ----
  			      (const_int 0) (const_int 0)
  			      (const_int 0) (const_int 0)
  			      (const_int 0) (const_int 0)])))]
!   "TARGET_AVX512F"
    "vpmov<trunsuffix>qb\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 16168,16174 ****
    [(set (match_operand:V8QI 0 "memory_operand" "=m")
  	(any_truncate:V8QI
  	  (match_operand:V8DI 1 "register_operand" "v")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<trunsuffix>qb\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "store")
--- 16087,16093 ----
    [(set (match_operand:V8QI 0 "memory_operand" "=m")
  	(any_truncate:V8QI
  	  (match_operand:V8DI 1 "register_operand" "v")))]
!   "TARGET_AVX512F"
    "vpmov<trunsuffix>qb\t{%1, %0|%0, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "store")
***************
*** 16180,16186 ****
  	(subreg:DI
  	  (any_truncate:V8QI
  	    (match_operand:V8DI 1 "register_operand")) 0))]
!   "TARGET_AVX512F && TARGET_EVEX512 && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
--- 16099,16105 ----
  	(subreg:DI
  	  (any_truncate:V8QI
  	    (match_operand:V8DI 1 "register_operand")) 0))]
!   "TARGET_AVX512F && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
***************
*** 16204,16210 ****
                            (const_int 0) (const_int 0)
                            (const_int 0) (const_int 0)
                            (const_int 0) (const_int 0)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<trunsuffix>qb\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 16123,16129 ----
                            (const_int 0) (const_int 0)
                            (const_int 0) (const_int 0)
                            (const_int 0) (const_int 0)])))]
!   "TARGET_AVX512F"
    "vpmov<trunsuffix>qb\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 16225,16231 ****
  			  (const_int 0) (const_int 0)
  			  (const_int 0) (const_int 0)
  			  (const_int 0) (const_int 0)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<trunsuffix>qb\t{%1, %0%{%2%}%{z%}|%0%{%2%}%{z%}, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 16144,16150 ----
  			  (const_int 0) (const_int 0)
  			  (const_int 0) (const_int 0)
  			  (const_int 0) (const_int 0)])))]
!   "TARGET_AVX512F"
    "vpmov<trunsuffix>qb\t{%1, %0%{%2%}%{z%}|%0%{%2%}%{z%}, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 16238,16244 ****
  	    (match_operand:V8DI 1 "register_operand" "v"))
  	(match_dup 0)
  	(match_operand:QI 2 "register_operand" "Yk")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<trunsuffix>qb\t{%1, %0%{%2%}|%0%{%2%}, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "store")
--- 16157,16163 ----
  	    (match_operand:V8DI 1 "register_operand" "v"))
  	(match_dup 0)
  	(match_operand:QI 2 "register_operand" "Yk")))]
!   "TARGET_AVX512F"
    "vpmov<trunsuffix>qb\t{%1, %0%{%2%}|%0%{%2%}, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "memory" "store")
***************
*** 16250,16256 ****
     (any_truncate:V8QI
      (match_operand:V8DI 1 "register_operand"))
     (match_operand:QI 2 "register_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    operands[0] = adjust_address_nv (operands[0], V8QImode, 0);
    emit_insn (gen_avx512f_<code>v8div16qi2_mask_store_1 (operands[0],
--- 16169,16175 ----
     (any_truncate:V8QI
      (match_operand:V8DI 1 "register_operand"))
     (match_operand:QI 2 "register_operand")]
!   "TARGET_AVX512F"
  {
    operands[0] = adjust_address_nv (operands[0], V8QImode, 0);
    emit_insn (gen_avx512f_<code>v8div16qi2_mask_store_1 (operands[0],
***************
*** 16507,16513 ****
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "ix86_fixup_binary_operands_no_copy (MULT, V16SImode, operands);")
  
  (define_insn "*vec_widen_umult_even_v16si<mask_name>"
--- 16426,16432 ----
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F"
    "ix86_fixup_binary_operands_no_copy (MULT, V16SImode, operands);")
  
  (define_insn "*vec_widen_umult_even_v16si<mask_name>"
***************
*** 16527,16533 ****
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F && TARGET_EVEX512
     && !(MEM_P (operands[1]) && MEM_P (operands[2]))"
    "vpmuludq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sseimul")
--- 16446,16452 ----
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F
     && !(MEM_P (operands[1]) && MEM_P (operands[2]))"
    "vpmuludq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sseimul")
***************
*** 16623,16629 ****
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "ix86_fixup_binary_operands_no_copy (MULT, V16SImode, operands);")
  
  (define_insn "*vec_widen_smult_even_v16si<mask_name>"
--- 16542,16548 ----
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F"
    "ix86_fixup_binary_operands_no_copy (MULT, V16SImode, operands);")
  
  (define_insn "*vec_widen_smult_even_v16si<mask_name>"
***************
*** 16643,16649 ****
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F && TARGET_EVEX512
     && !(MEM_P (operands[1]) && MEM_P (operands[2]))"
    "vpmuldq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sseimul")
--- 16562,16568 ----
                           (const_int 4) (const_int 6)
                           (const_int 8) (const_int 10)
                           (const_int 12) (const_int 14)])))))]
!   "TARGET_AVX512F
     && !(MEM_P (operands[1]) && MEM_P (operands[2]))"
    "vpmuldq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sseimul")
***************
*** 17045,17051 ****
    "TARGET_SSE2"
  {
    /* Try with vnni instructions.  */
!   if ((<MODE_SIZE> == 64 && TARGET_AVX512VNNI && TARGET_EVEX512)
        || (<MODE_SIZE> < 64
  	  && ((TARGET_AVX512VNNI && TARGET_AVX512VL) || TARGET_AVXVNNI)))
      {
--- 16964,16970 ----
    "TARGET_SSE2"
  {
    /* Try with vnni instructions.  */
!   if ((<MODE_SIZE> == 64 && TARGET_AVX512VNNI)
        || (<MODE_SIZE> < 64
  	  && ((TARGET_AVX512VNNI && TARGET_AVX512VL) || TARGET_AVXVNNI)))
      {
***************
*** 17138,17144 ****
     (match_operand:V64QI 1 "register_operand")
     (match_operand:V64QI 2 "nonimmediate_operand")
     (match_operand:V16SI 3 "nonimmediate_operand")]
!   "TARGET_AVX512BW && TARGET_EVEX512"
  {
    rtx t1 = gen_reg_rtx (V8DImode);
    rtx t2 = gen_reg_rtx (V16SImode);
--- 17057,17063 ----
     (match_operand:V64QI 1 "register_operand")
     (match_operand:V64QI 2 "nonimmediate_operand")
     (match_operand:V16SI 3 "nonimmediate_operand")]
!   "TARGET_AVX512BW"
  {
    rtx t1 = gen_reg_rtx (V8DImode);
    rtx t2 = gen_reg_rtx (V16SImode);
***************
*** 18376,18388 ****
     (V8SI "TARGET_AVX2") (V4DI "TARGET_AVX2")
     (V8SF "TARGET_AVX2") (V4DF "TARGET_AVX2")
     (V16HF "TARGET_AVX512FP16")
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512")
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
!    (V64QI "TARGET_AVX512VBMI && TARGET_EVEX512")
!    (V32HF "TARGET_AVX512FP16 && TARGET_EVEX512")])
  
  (define_expand "vec_perm<mode>"
    [(match_operand:VEC_PERM_AVX2 0 "register_operand")
--- 18295,18304 ----
     (V8SI "TARGET_AVX2") (V4DI "TARGET_AVX2")
     (V8SF "TARGET_AVX2") (V4DF "TARGET_AVX2")
     (V16HF "TARGET_AVX512FP16")
!    (V16SF "TARGET_AVX512F") (V8DF "TARGET_AVX512F")
!    (V16SI "TARGET_AVX512F") (V8DI "TARGET_AVX512F")
!    (V32HI "TARGET_AVX512BW") (V64QI "TARGET_AVX512VBMI")
!    (V32HF "TARGET_AVX512FP16")])
  
  (define_expand "vec_perm<mode>"
    [(match_operand:VEC_PERM_AVX2 0 "register_operand")
***************
*** 18409,18415 ****
  {
    operands[2] = CONSTM1_RTX (<MODE>mode);
  
!   if (!TARGET_AVX512F || (!TARGET_AVX512VL && !TARGET_EVEX512))
      operands[2] = force_reg (<MODE>mode, operands[2]);
  })
  
--- 18325,18331 ----
  {
    operands[2] = CONSTM1_RTX (<MODE>mode);
  
!   if (!TARGET_AVX512F)
      operands[2] = force_reg (<MODE>mode, operands[2]);
  })
  
***************
*** 18418,18424 ****
  	(xor:VI (match_operand:VI 1 "bcst_vector_operand"     " 0, m,Br")
  		(match_operand:VI 2 "vector_all_ones_operand" "BC,BC,BC")))]
    "TARGET_AVX512F
-    && (<MODE_SIZE> == 64 || TARGET_AVX512VL || TARGET_EVEX512)
     && (!<mask_applied>
         || <ssescalarmode>mode == SImode
         || <ssescalarmode>mode == DImode)"
--- 18334,18339 ----
***************
*** 18485,18491 ****
  		(match_operand:VI 2 "vector_all_ones_operand" "BC,BC,BC")))
     (unspec [(match_operand:VI 3 "register_operand" "0,0,0")]
       UNSPEC_INSN_FALSE_DEP)]
!   "TARGET_AVX512F && (<MODE_SIZE> == 64 || TARGET_AVX512VL || TARGET_EVEX512)"
  {
    if (TARGET_AVX512VL)
      return "vpternlog<ternlogsuffix>\t{$0x55, %1, %0, %0<mask_operand3>|%0<mask_operand3>, %0, %1, 0x55}";
--- 18400,18406 ----
  		(match_operand:VI 2 "vector_all_ones_operand" "BC,BC,BC")))
     (unspec [(match_operand:VI 3 "register_operand" "0,0,0")]
       UNSPEC_INSN_FALSE_DEP)]
!   "TARGET_AVX512F"
  {
    if (TARGET_AVX512VL)
      return "vpternlog<ternlogsuffix>\t{$0x55, %1, %0, %0<mask_operand3>|%0<mask_operand3>, %0, %1, 0x55}";
***************
*** 18509,18515 ****
  	  (not:<ssescalarmode>
  	    (match_operand:<ssescalarmode> 1 "nonimmediate_operand"))))]
    "<MODE_SIZE> == 64 || TARGET_AVX512VL
!    || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)"
    [(set (match_dup 0)
  	(xor:VI48_AVX512F
  	  (vec_duplicate:VI48_AVX512F (match_dup 1))
--- 18424,18430 ----
  	  (not:<ssescalarmode>
  	    (match_operand:<ssescalarmode> 1 "nonimmediate_operand"))))]
    "<MODE_SIZE> == 64 || TARGET_AVX512VL
!    || (TARGET_AVX512F && !TARGET_PREFER_AVX256)"
    [(set (match_dup 0)
  	(xor:VI48_AVX512F
  	  (vec_duplicate:VI48_AVX512F (match_dup 1))
***************
*** 18663,18670 ****
  		 (symbol_ref "<MODE_SIZE> == 64 || TARGET_AVX512VL")
  	       (eq_attr "alternative" "4")
  		 (symbol_ref "<MODE_SIZE> == 64 || TARGET_AVX512VL
! 			      || (TARGET_AVX512F && TARGET_EVEX512
! 				  && !TARGET_PREFER_AVX256)")
  	      ]
  	      (const_string "*")))])
  
--- 18578,18584 ----
  		 (symbol_ref "<MODE_SIZE> == 64 || TARGET_AVX512VL")
  	       (eq_attr "alternative" "4")
  		 (symbol_ref "<MODE_SIZE> == 64 || TARGET_AVX512VL
! 			      || (TARGET_AVX512F && !TARGET_PREFER_AVX256)")
  	      ]
  	      (const_string "*")))])
  
***************
*** 18708,18714 ****
  	      (match_operand:<ssescalarmode> 1 "nonimmediate_operand")))
  	  (match_operand:VI 2 "vector_operand")))]
    "<MODE_SIZE> == 64 || TARGET_AVX512VL
!    || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)"
    [(set (match_dup 3)
  	(vec_duplicate:VI (match_dup 1)))
     (set (match_dup 0)
--- 18622,18628 ----
  	      (match_operand:<ssescalarmode> 1 "nonimmediate_operand")))
  	  (match_operand:VI 2 "vector_operand")))]
    "<MODE_SIZE> == 64 || TARGET_AVX512VL
!    || (TARGET_AVX512F && !TARGET_PREFER_AVX256)"
    [(set (match_dup 3)
  	(vec_duplicate:VI (match_dup 1)))
     (set (match_dup 0)
***************
*** 18723,18729 ****
  	      (match_operand:<ssescalarmode> 1 "nonimmediate_operand")))
  	  (match_operand:VI 2 "vector_operand")))]
    "<MODE_SIZE> == 64 || TARGET_AVX512VL
!    || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256)"
    [(set (match_dup 3)
  	(vec_duplicate:VI (match_dup 1)))
     (set (match_dup 0)
--- 18637,18643 ----
  	      (match_operand:<ssescalarmode> 1 "nonimmediate_operand")))
  	  (match_operand:VI 2 "vector_operand")))]
    "<MODE_SIZE> == 64 || TARGET_AVX512VL
!    || (TARGET_AVX512F && !TARGET_PREFER_AVX256)"
    [(set (match_dup 3)
  	(vec_duplicate:VI (match_dup 1)))
     (set (match_dup 0)
***************
*** 19017,19023 ****
  	    (match_operand:VI 1 "bcst_vector_operand" "0,m,  0,vBr"))
  	  (match_operand:VI 2 "bcst_vector_operand"   "m,0,vBr,  0")))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
     && (register_operand (operands[1], <MODE>mode)
         || register_operand (operands[2], <MODE>mode))"
  {
--- 18931,18937 ----
  	    (match_operand:VI 1 "bcst_vector_operand" "0,m,  0,vBr"))
  	  (match_operand:VI 2 "bcst_vector_operand"   "m,0,vBr,  0")))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
     && (register_operand (operands[1], <MODE>mode)
         || register_operand (operands[2], <MODE>mode))"
  {
***************
*** 19050,19056 ****
  	    (match_operand:VI 1 "bcst_vector_operand" "%0, 0")
  	    (match_operand:VI 2 "bcst_vector_operand" " m,vBr"))))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
     && (register_operand (operands[1], <MODE>mode)
         || register_operand (operands[2], <MODE>mode))"
  {
--- 18964,18970 ----
  	    (match_operand:VI 1 "bcst_vector_operand" "%0, 0")
  	    (match_operand:VI 2 "bcst_vector_operand" " m,vBr"))))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
     && (register_operand (operands[1], <MODE>mode)
         || register_operand (operands[2], <MODE>mode))"
  {
***************
*** 19081,19087 ****
  	  (not:VI (match_operand:VI 1 "bcst_vector_operand" "%0, 0"))
  	  (not:VI (match_operand:VI 2 "bcst_vector_operand" "m,vBr"))))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && TARGET_EVEX512 && !TARGET_PREFER_AVX256))
     && (register_operand (operands[1], <MODE>mode)
         || register_operand (operands[2], <MODE>mode))"
  {
--- 18995,19001 ----
  	  (not:VI (match_operand:VI 1 "bcst_vector_operand" "%0, 0"))
  	  (not:VI (match_operand:VI 2 "bcst_vector_operand" "m,vBr"))))]
    "(<MODE_SIZE> == 64 || TARGET_AVX512VL
!     || (TARGET_AVX512F && !TARGET_PREFER_AVX256))
     && (register_operand (operands[1], <MODE>mode)
         || register_operand (operands[2], <MODE>mode))"
  {
***************
*** 19103,19109 ****
  		      (const_string "*")))])
  
  (define_mode_iterator AVX512ZEXTMASK
!   [(DI "TARGET_AVX512BW && TARGET_EVEX512") (SI "TARGET_AVX512BW") HI])
  
  (define_insn "<avx512>_testm<mode>3<mask_scalar_merge_name>"
    [(set (match_operand:<avx512fmaskmode> 0 "register_operand" "=k")
--- 19017,19023 ----
  		      (const_string "*")))])
  
  (define_mode_iterator AVX512ZEXTMASK
!   [(DI "TARGET_AVX512BW") (SI "TARGET_AVX512BW") HI])
  
  (define_insn "<avx512>_testm<mode>3<mask_scalar_merge_name>"
    [(set (match_operand:<avx512fmaskmode> 0 "register_operand" "=k")
***************
*** 19352,19358 ****
  		     (const_int 60) (const_int 61)
  		     (const_int 62) (const_int 63)])))]
  
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpacksswb\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "<mask_prefix>")
--- 19266,19272 ----
  		     (const_int 60) (const_int 61)
  		     (const_int 62) (const_int 63)])))]
  
!   "TARGET_AVX512BW"
    "vpacksswb\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "<mask_prefix>")
***************
*** 19421,19427 ****
  		     (const_int 14)  (const_int 15)
  		     (const_int 28)  (const_int 29)
  		     (const_int 30)  (const_int 31)])))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpackssdw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "<mask_prefix>")
--- 19335,19341 ----
  		     (const_int 14)  (const_int 15)
  		     (const_int 28)  (const_int 29)
  		     (const_int 30)  (const_int 31)])))]
!   "TARGET_AVX512BW"
    "vpackssdw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "<mask_prefix>")
***************
*** 19483,19489 ****
  		     (const_int 61) (const_int 125)
  		     (const_int 62) (const_int 126)
  		     (const_int 63) (const_int 127)])))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpunpckhbw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 19397,19403 ----
  		     (const_int 61) (const_int 125)
  		     (const_int 62) (const_int 126)
  		     (const_int 63) (const_int 127)])))]
!   "TARGET_AVX512BW"
    "vpunpckhbw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 19579,19585 ****
  		     (const_int 53) (const_int 117)
  		     (const_int 54) (const_int 118)
  		     (const_int 55) (const_int 119)])))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpunpcklbw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 19493,19499 ----
  		     (const_int 53) (const_int 117)
  		     (const_int 54) (const_int 118)
  		     (const_int 55) (const_int 119)])))]
!   "TARGET_AVX512BW"
    "vpunpcklbw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 19803,19809 ****
  		     (const_int 11) (const_int 27)
  		     (const_int 14) (const_int 30)
  		     (const_int 15) (const_int 31)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpunpckhdq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 19717,19723 ----
  		     (const_int 11) (const_int 27)
  		     (const_int 14) (const_int 30)
  		     (const_int 15) (const_int 31)])))]
!   "TARGET_AVX512F"
    "vpunpckhdq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 19858,19864 ****
  		     (const_int 9) (const_int 25)
  		     (const_int 12) (const_int 28)
  		     (const_int 13) (const_int 29)])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpunpckldq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 19772,19778 ----
  		     (const_int 9) (const_int 25)
  		     (const_int 12) (const_int 28)
  		     (const_int 13) (const_int 29)])))]
!   "TARGET_AVX512F"
    "vpunpckldq\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 20564,20570 ****
     (match_operand:SI 2 "const_0_to_255_operand")
     (match_operand:V16SI 3 "register_operand")
     (match_operand:HI 4 "register_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    int mask = INTVAL (operands[2]);
    emit_insn (gen_avx512f_pshufd_1_mask (operands[0], operands[1],
--- 20478,20484 ----
     (match_operand:SI 2 "const_0_to_255_operand")
     (match_operand:V16SI 3 "register_operand")
     (match_operand:HI 4 "register_operand")]
!   "TARGET_AVX512F"
  {
    int mask = INTVAL (operands[2]);
    emit_insn (gen_avx512f_pshufd_1_mask (operands[0], operands[1],
***************
*** 20608,20614 ****
  		     (match_operand 15 "const_12_to_15_operand")
  		     (match_operand 16 "const_12_to_15_operand")
  		     (match_operand 17 "const_12_to_15_operand")])))]
!   "TARGET_AVX512F && TARGET_EVEX512
     && INTVAL (operands[2]) + 4 == INTVAL (operands[6])
     && INTVAL (operands[3]) + 4 == INTVAL (operands[7])
     && INTVAL (operands[4]) + 4 == INTVAL (operands[8])
--- 20522,20528 ----
  		     (match_operand 15 "const_12_to_15_operand")
  		     (match_operand 16 "const_12_to_15_operand")
  		     (match_operand 17 "const_12_to_15_operand")])))]
!   "TARGET_AVX512F
     && INTVAL (operands[2]) + 4 == INTVAL (operands[6])
     && INTVAL (operands[3]) + 4 == INTVAL (operands[7])
     && INTVAL (operands[4]) + 4 == INTVAL (operands[8])
***************
*** 20774,20780 ****
  	  [(match_operand:V32HI 1 "nonimmediate_operand" "vm")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_PSHUFLW))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpshuflw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 20688,20694 ----
  	  [(match_operand:V32HI 1 "nonimmediate_operand" "vm")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_PSHUFLW))]
!   "TARGET_AVX512BW"
    "vpshuflw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 20950,20956 ****
  	  [(match_operand:V32HI 1 "nonimmediate_operand" "vm")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_PSHUFHW))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpshufhw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
--- 20864,20870 ----
  	  [(match_operand:V32HI 1 "nonimmediate_operand" "vm")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_PSHUFHW))]
!   "TARGET_AVX512BW"
    "vpshufhw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "prefix" "evex")
***************
*** 21484,21490 ****
  	  (match_operand:V4TI 1 "register_operand" "v")
  	  (parallel
  	    [(match_operand:SI 2 "const_0_to_3_operand")])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vextracti32x4\t{%2, %1, %0|%0, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "length_immediate" "1")
--- 21398,21404 ----
  	  (match_operand:V4TI 1 "register_operand" "v")
  	  (parallel
  	    [(match_operand:SI 2 "const_0_to_3_operand")])))]
!   "TARGET_AVX512F"
    "vextracti32x4\t{%2, %1, %0|%0, %1, %2}"
    [(set_attr "type" "sselog")
     (set_attr "length_immediate" "1")
***************
*** 21492,21498 ****
     (set_attr "mode" "XI")])
  
  (define_mode_iterator VEXTRACTI128_MODE
!   [(V4TI "TARGET_AVX512F && TARGET_EVEX512") V2TI])
  
  (define_split
    [(set (match_operand:TI 0 "nonimmediate_operand")
--- 21406,21412 ----
     (set_attr "mode" "XI")])
  
  (define_mode_iterator VEXTRACTI128_MODE
!   [(V4TI "TARGET_AVX512F") V2TI])
  
  (define_split
    [(set (match_operand:TI 0 "nonimmediate_operand")
***************
*** 21515,21521 ****
     && VECTOR_MODE_P (GET_MODE (operands[1]))
     && ((TARGET_SSE && GET_MODE_SIZE (GET_MODE (operands[1])) == 16)
         || (TARGET_AVX && GET_MODE_SIZE (GET_MODE (operands[1])) == 32)
!        || (TARGET_AVX512F && TARGET_EVEX512
  	   && GET_MODE_SIZE (GET_MODE (operands[1])) == 64))
     && (<MODE>mode == SImode || TARGET_64BIT || MEM_P (operands[0]))"
    [(set (match_dup 0) (vec_select:SWI48x (match_dup 1)
--- 21429,21435 ----
     && VECTOR_MODE_P (GET_MODE (operands[1]))
     && ((TARGET_SSE && GET_MODE_SIZE (GET_MODE (operands[1])) == 16)
         || (TARGET_AVX && GET_MODE_SIZE (GET_MODE (operands[1])) == 32)
!        || (TARGET_AVX512F
  	   && GET_MODE_SIZE (GET_MODE (operands[1])) == 64))
     && (<MODE>mode == SImode || TARGET_64BIT || MEM_P (operands[0]))"
    [(set (match_dup 0) (vec_select:SWI48x (match_dup 1)
***************
*** 22890,22896 ****
  				   (const_int 1) (const_int 1)
  				   (const_int 1) (const_int 1)]))
  	    (const_int 1))))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpmulhrsw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sseimul")
     (set_attr "prefix" "evex")
--- 22804,22810 ----
  				   (const_int 1) (const_int 1)
  				   (const_int 1) (const_int 1)]))
  	    (const_int 1))))]
!   "TARGET_AVX512BW"
    "vpmulhrsw\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
    [(set_attr "type" "sseimul")
     (set_attr "prefix" "evex")
***************
*** 23404,23413 ****
  ;; Mode iterator to handle singularity w/ absence of V2DI and V4DI
  ;; modes for abs instruction on pre AVX-512 targets.
  (define_mode_iterator VI1248_AVX512VL_AVX512BW
!   [(V64QI "TARGET_AVX512BW && TARGET_EVEX512") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX2") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL")])
  
  (define_insn "*abs<mode>2"
--- 23318,23327 ----
  ;; Mode iterator to handle singularity w/ absence of V2DI and V4DI
  ;; modes for abs instruction on pre AVX-512 targets.
  (define_mode_iterator VI1248_AVX512VL_AVX512BW
!   [(V64QI "TARGET_AVX512BW") (V32QI "TARGET_AVX2") V16QI
!    (V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX2") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX2") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL")])
  
  (define_insn "*abs<mode>2"
***************
*** 24235,24241 ****
    [(set (match_operand:V32HI 0 "register_operand" "=v")
  	(any_extend:V32HI
  	  (match_operand:V32QI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "vpmov<extsuffix>bw\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 24149,24155 ----
    [(set (match_operand:V32HI 0 "register_operand" "=v")
  	(any_extend:V32HI
  	  (match_operand:V32QI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512BW"
    "vpmov<extsuffix>bw\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 24249,24255 ****
  	    (match_operand:V64QI 2 "const0_operand"))
  	  (match_parallel 3 "pmovzx_parallel"
  	    [(match_operand 4 "const_int_operand")])))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V32HI (match_dup 1)))]
--- 24163,24169 ----
  	    (match_operand:V64QI 2 "const0_operand"))
  	  (match_parallel 3 "pmovzx_parallel"
  	    [(match_operand 4 "const_int_operand")])))]
!   "TARGET_AVX512BW"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V32HI (match_dup 1)))]
***************
*** 24269,24275 ****
  	    (match_operand:V64QI 3 "const0_operand"))
  	  (match_parallel 4 "pmovzx_parallel"
  	    [(match_operand 5 "const_int_operand")])))]
!   "TARGET_AVX512BW && TARGET_EVEX512"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V32HI (match_dup 1)))]
--- 24183,24189 ----
  	    (match_operand:V64QI 3 "const0_operand"))
  	  (match_parallel 4 "pmovzx_parallel"
  	    [(match_operand 5 "const_int_operand")])))]
!   "TARGET_AVX512BW"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V32HI (match_dup 1)))]
***************
*** 24282,24288 ****
    [(set (match_operand:V32HI 0 "register_operand")
  	(any_extend:V32HI
  	  (match_operand:V32QI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512BW && TARGET_EVEX512")
  
  (define_insn "sse4_1_<code>v8qiv8hi2<mask_name>"
    [(set (match_operand:V8HI 0 "register_operand" "=Yr,*x,Yw")
--- 24196,24202 ----
    [(set (match_operand:V32HI 0 "register_operand")
  	(any_extend:V32HI
  	  (match_operand:V32QI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512BW")
  
  (define_insn "sse4_1_<code>v8qiv8hi2<mask_name>"
    [(set (match_operand:V8HI 0 "register_operand" "=Yr,*x,Yw")
***************
*** 24430,24436 ****
    [(set (match_operand:V16SI 0 "register_operand" "=v")
  	(any_extend:V16SI
  	  (match_operand:V16QI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<extsuffix>bd\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 24344,24350 ----
    [(set (match_operand:V16SI 0 "register_operand" "=v")
  	(any_extend:V16SI
  	  (match_operand:V16QI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F"
    "vpmov<extsuffix>bd\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 24440,24446 ****
    [(set (match_operand:V16SI 0 "register_operand")
  	(any_extend:V16SI
  	  (match_operand:V16QI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_insn "avx2_<code>v8qiv8si2<mask_name>"
    [(set (match_operand:V8SI 0 "register_operand" "=v")
--- 24354,24360 ----
    [(set (match_operand:V16SI 0 "register_operand")
  	(any_extend:V16SI
  	  (match_operand:V16QI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F")
  
  (define_insn "avx2_<code>v8qiv8si2<mask_name>"
    [(set (match_operand:V8SI 0 "register_operand" "=v")
***************
*** 24573,24579 ****
    [(set (match_operand:V16SI 0 "register_operand" "=v")
  	(any_extend:V16SI
  	  (match_operand:V16HI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<extsuffix>wd\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 24487,24493 ----
    [(set (match_operand:V16SI 0 "register_operand" "=v")
  	(any_extend:V16SI
  	  (match_operand:V16HI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F"
    "vpmov<extsuffix>wd\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 24583,24589 ****
    [(set (match_operand:V16SI 0 "register_operand")
  	(any_extend:V16SI
  	  (match_operand:V16HI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_insn_and_split "avx512f_zero_extendv16hiv16si2_1"
    [(set (match_operand:V32HI 0 "register_operand" "=v")
--- 24497,24503 ----
    [(set (match_operand:V16SI 0 "register_operand")
  	(any_extend:V16SI
  	  (match_operand:V16HI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F")
  
  (define_insn_and_split "avx512f_zero_extendv16hiv16si2_1"
    [(set (match_operand:V32HI 0 "register_operand" "=v")
***************
*** 24593,24599 ****
  	    (match_operand:V32HI 2 "const0_operand"))
  	  (match_parallel 3 "pmovzx_parallel"
  	    [(match_operand 4 "const_int_operand")])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V16SI (match_dup 1)))]
--- 24507,24513 ----
  	    (match_operand:V32HI 2 "const0_operand"))
  	  (match_parallel 3 "pmovzx_parallel"
  	    [(match_operand 4 "const_int_operand")])))]
!   "TARGET_AVX512F"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V16SI (match_dup 1)))]
***************
*** 24817,24823 ****
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<extsuffix>bq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 24731,24737 ----
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F"
    "vpmov<extsuffix>bq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 24827,24833 ****
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8QI 1 "memory_operand" "m")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<extsuffix>bq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 24741,24747 ----
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8QI 1 "memory_operand" "m")))]
!   "TARGET_AVX512F"
    "vpmov<extsuffix>bq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 24845,24851 ****
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F && TARGET_EVEX512 && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
--- 24759,24765 ----
  		       (const_int 2) (const_int 3)
  		       (const_int 4) (const_int 5)
  		       (const_int 6) (const_int 7)]))))]
!   "TARGET_AVX512F && ix86_pre_reload_split ()"
    "#"
    "&& 1"
    [(set (match_dup 0)
***************
*** 24856,24862 ****
    [(set (match_operand:V8DI 0 "register_operand")
  	(any_extend:V8DI
  	  (match_operand:V8QI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    if (!MEM_P (operands[1]))
      {
--- 24770,24776 ----
    [(set (match_operand:V8DI 0 "register_operand")
  	(any_extend:V8DI
  	  (match_operand:V8QI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F"
  {
    if (!MEM_P (operands[1]))
      {
***************
*** 24998,25004 ****
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8HI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<extsuffix>wq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 24912,24918 ----
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8HI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F"
    "vpmov<extsuffix>wq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 25008,25014 ****
    [(set (match_operand:V8DI 0 "register_operand")
  	(any_extend:V8DI
  	  (match_operand:V8HI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_insn "avx2_<code>v4hiv4di2<mask_name>"
    [(set (match_operand:V4DI 0 "register_operand" "=v")
--- 24922,24928 ----
    [(set (match_operand:V8DI 0 "register_operand")
  	(any_extend:V8DI
  	  (match_operand:V8HI 1 "nonimmediate_operand")))]
!   "TARGET_AVX512F")
  
  (define_insn "avx2_<code>v4hiv4di2<mask_name>"
    [(set (match_operand:V4DI 0 "register_operand" "=v")
***************
*** 25135,25141 ****
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8SI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vpmov<extsuffix>dq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
--- 25049,25055 ----
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8SI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F"
    "vpmov<extsuffix>dq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
    [(set_attr "type" "ssemov")
     (set_attr "prefix" "evex")
***************
*** 25149,25155 ****
  	    (match_operand:V16SI 2 "const0_operand"))
  	  (match_parallel 3 "pmovzx_parallel"
  	    [(match_operand 4 "const_int_operand")])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V8DI (match_dup 1)))]
--- 25063,25069 ----
  	    (match_operand:V16SI 2 "const0_operand"))
  	  (match_parallel 3 "pmovzx_parallel"
  	    [(match_operand 4 "const_int_operand")])))]
!   "TARGET_AVX512F"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V8DI (match_dup 1)))]
***************
*** 25168,25174 ****
  	    (match_operand:V16SI 3 "const0_operand"))
  	  (match_parallel 4 "pmovzx_parallel"
  	    [(match_operand 5 "const_int_operand")])))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V8DI (match_dup 1)))]
--- 25082,25088 ----
  	    (match_operand:V16SI 3 "const0_operand"))
  	  (match_parallel 4 "pmovzx_parallel"
  	    [(match_operand 5 "const_int_operand")])))]
!   "TARGET_AVX512F"
    "#"
    "&& reload_completed"
    [(set (match_dup 0) (zero_extend:V8DI (match_dup 1)))]
***************
*** 25180,25186 ****
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8SI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_insn "avx2_<code>v4siv4di2<mask_name>"
    [(set (match_operand:V4DI 0 "register_operand" "=v")
--- 25094,25100 ----
    [(set (match_operand:V8DI 0 "register_operand" "=v")
  	(any_extend:V8DI
  	  (match_operand:V8SI 1 "nonimmediate_operand" "vm")))]
!   "TARGET_AVX512F")
  
  (define_insn "avx2_<code>v4siv4di2<mask_name>"
    [(set (match_operand:V4DI 0 "register_operand" "=v")
***************
*** 25581,25587 ****
    [(match_operand:V16SI 0 "register_operand")
     (match_operand:V16SF 1 "nonimmediate_operand")
     (match_operand:SI 2 "const_0_to_15_operand")]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    rtx tmp = gen_reg_rtx (V16SFmode);
    emit_insn (gen_avx512f_rndscalev16sf (tmp, operands[1], operands[2]));
--- 25495,25501 ----
    [(match_operand:V16SI 0 "register_operand")
     (match_operand:V16SF 1 "nonimmediate_operand")
     (match_operand:SI 2 "const_0_to_15_operand")]
!   "TARGET_AVX512F"
  {
    rtx tmp = gen_reg_rtx (V16SFmode);
    emit_insn (gen_avx512f_rndscalev16sf (tmp, operands[1], operands[2]));
***************
*** 26799,26805 ****
  	(ashiftrt:V8DI
  	  (match_operand:V8DI 1 "register_operand")
  	  (match_operand:V8DI 2 "nonimmediate_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_expand "vashrv4di3"
    [(set (match_operand:V4DI 0 "register_operand")
--- 26713,26719 ----
  	(ashiftrt:V8DI
  	  (match_operand:V8DI 1 "register_operand")
  	  (match_operand:V8DI 2 "nonimmediate_operand")))]
!   "TARGET_AVX512F")
  
  (define_expand "vashrv4di3"
    [(set (match_operand:V4DI 0 "register_operand")
***************
*** 26890,26896 ****
    [(set (match_operand:V16SI 0 "register_operand")
  	(ashiftrt:V16SI (match_operand:V16SI 1 "register_operand")
  		        (match_operand:V16SI 2 "nonimmediate_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512")
  
  (define_expand "vashrv8si3"
    [(set (match_operand:V8SI 0 "register_operand")
--- 26804,26810 ----
    [(set (match_operand:V16SI 0 "register_operand")
  	(ashiftrt:V16SI (match_operand:V16SI 1 "register_operand")
  		        (match_operand:V16SI 2 "nonimmediate_operand")))]
!   "TARGET_AVX512F")
  
  (define_expand "vashrv8si3"
    [(set (match_operand:V8SI 0 "register_operand")
***************
*** 27333,27344 ****
     (set_attr "mode" "OI")])
  
  (define_mode_attr pbroadcast_evex_isa
!   [(V64QI "avx512bw_512") (V32QI "avx512bw") (V16QI "avx512bw")
!    (V32HI "avx512bw_512") (V16HI "avx512bw") (V8HI "avx512bw")
!    (V16SI "avx512f_512") (V8SI "avx512f") (V4SI "avx512f")
!    (V8DI "avx512f_512") (V4DI "avx512f") (V2DI "avx512f")
!    (V32HF "avx512bw_512") (V16HF "avx512bw") (V8HF "avx512bw")
!    (V32BF "avx512bw_512") (V16BF "avx512bw") (V8BF "avx512bw")])
  
  (define_insn "avx2_pbroadcast<mode>"
    [(set (match_operand:VIHFBF 0 "register_operand" "=x,v")
--- 27247,27258 ----
     (set_attr "mode" "OI")])
  
  (define_mode_attr pbroadcast_evex_isa
!   [(V64QI "avx512bw") (V32QI "avx512bw") (V16QI "avx512bw")
!    (V32HI "avx512bw") (V16HI "avx512bw") (V8HI "avx512bw")
!    (V16SI "avx512f") (V8SI "avx512f") (V4SI "avx512f")
!    (V8DI "avx512f") (V4DI "avx512f") (V2DI "avx512f")
!    (V32HF "avx512bw") (V16HF "avx512bw") (V8HF "avx512bw")
!    (V32BF "avx512bw") (V16BF "avx512bw") (V8BF "avx512bw")])
  
  (define_insn "avx2_pbroadcast<mode>"
    [(set (match_operand:VIHFBF 0 "register_operand" "=x,v")
***************
*** 27882,27888 ****
     (set (attr "enabled")
  	(if_then_else (eq_attr "alternative" "1")
  		      (symbol_ref "TARGET_AVX512F && !TARGET_AVX512VL
! 				   && TARGET_EVEX512 && !TARGET_PREFER_AVX256")
  		      (const_string "*")))])
  
  (define_insn "*vec_dupv4si"
--- 27796,27802 ----
     (set (attr "enabled")
  	(if_then_else (eq_attr "alternative" "1")
  		      (symbol_ref "TARGET_AVX512F && !TARGET_AVX512VL
! 				   && !TARGET_PREFER_AVX256")
  		      (const_string "*")))])
  
  (define_insn "*vec_dupv4si"
***************
*** 27910,27916 ****
     (set (attr "enabled")
  	(if_then_else (eq_attr "alternative" "1")
  		      (symbol_ref "TARGET_AVX512F && !TARGET_AVX512VL
! 				   && TARGET_EVEX512 && !TARGET_PREFER_AVX256")
  		      (const_string "*")))])
  
  (define_insn "*vec_dupv2di"
--- 27824,27830 ----
     (set (attr "enabled")
  	(if_then_else (eq_attr "alternative" "1")
  		      (symbol_ref "TARGET_AVX512F && !TARGET_AVX512VL
! 				   && !TARGET_PREFER_AVX256")
  		      (const_string "*")))])
  
  (define_insn "*vec_dupv2di"
***************
*** 27941,27948 ****
  	(if_then_else
  	  (eq_attr "alternative" "2")
  	  (symbol_ref "TARGET_AVX512VL
! 		       || (TARGET_AVX512F && TARGET_EVEX512
! 			   && !TARGET_PREFER_AVX256)")
  	  (const_string "*")))])
  
  (define_insn "avx2_vbroadcasti128_<mode>"
--- 27855,27861 ----
  	(if_then_else
  	  (eq_attr "alternative" "2")
  	  (symbol_ref "TARGET_AVX512VL
! 		       || (TARGET_AVX512F && !TARGET_PREFER_AVX256)")
  	  (const_string "*")))])
  
  (define_insn "avx2_vbroadcasti128_<mode>"
***************
*** 28022,28028 ****
    [(set_attr "type" "ssemov")
     (set_attr "prefix_extra" "1")
     (set_attr "prefix" "maybe_evex")
!    (set_attr "isa" "avx2,noavx2,avx2,avx512f_512,noavx2")
     (set_attr "mode" "<sseinsnmode>,V8SF,<sseinsnmode>,<sseinsnmode>,V8SF")])
  
  (define_split
--- 27935,27941 ----
    [(set_attr "type" "ssemov")
     (set_attr "prefix_extra" "1")
     (set_attr "prefix" "maybe_evex")
!    (set_attr "isa" "avx2,noavx2,avx2,avx512f,noavx2")
     (set_attr "mode" "<sseinsnmode>,V8SF,<sseinsnmode>,<sseinsnmode>,V8SF")])
  
  (define_split
***************
*** 28086,28093 ****
  
  ;; For broadcast[i|f]32x2.  Yes there is no v4sf version, only v4si.
  (define_mode_iterator VI4F_BRCST32x2
!   [(V16SI "TARGET_EVEX512") (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    (V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL")])
  
  (define_mode_attr 64x2mode
    [(V8DF "V2DF") (V8DI "V2DI") (V4DI "V2DI") (V4DF "V2DF")])
--- 27999,28006 ----
  
  ;; For broadcast[i|f]32x2.  Yes there is no v4sf version, only v4si.
  (define_mode_iterator VI4F_BRCST32x2
!   [V16SI (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
!    V16SF (V8SF "TARGET_AVX512VL")])
  
  (define_mode_attr 64x2mode
    [(V8DF "V2DF") (V8DI "V2DI") (V4DI "V2DI") (V4DF "V2DF")])
***************
*** 28137,28144 ****
  
  ;; For broadcast[i|f]64x2
  (define_mode_iterator VI8F_BRCST64x2
!   [(V8DI "TARGET_EVEX512") (V8DF "TARGET_EVEX512")
!    (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")])
  
  (define_insn "<mask_codefor>avx512dq_broadcast<mode><mask_name>_1"
    [(set (match_operand:VI8F_BRCST64x2 0 "register_operand" "=v,v")
--- 28050,28056 ----
  
  ;; For broadcast[i|f]64x2
  (define_mode_iterator VI8F_BRCST64x2
!   [V8DI V8DF (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")])
  
  (define_insn "<mask_codefor>avx512dq_broadcast<mode><mask_name>_1"
    [(set (match_operand:VI8F_BRCST64x2 0 "register_operand" "=v,v")
***************
*** 28194,28220 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_mode_iterator VPERMI2
!   [(V16SI "TARGET_EVEX512") (V16SF "TARGET_EVEX512")
!    (V8DI "TARGET_EVEX512") (V8DF "TARGET_EVEX512")
     (V8SI "TARGET_AVX512VL") (V8SF "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
     (V16HI "TARGET_AVX512BW && TARGET_AVX512VL")
     (V8HI "TARGET_AVX512BW && TARGET_AVX512VL")
!    (V64QI "TARGET_AVX512VBMI && TARGET_EVEX512")
     (V32QI "TARGET_AVX512VBMI && TARGET_AVX512VL")
     (V16QI "TARGET_AVX512VBMI && TARGET_AVX512VL")])
  
  (define_mode_iterator VPERMI2I
!   [(V16SI "TARGET_EVEX512") (V8DI "TARGET_EVEX512")
     (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
!    (V32HI "TARGET_AVX512BW && TARGET_EVEX512")
     (V16HI "TARGET_AVX512BW && TARGET_AVX512VL")
     (V8HI "TARGET_AVX512BW && TARGET_AVX512VL")
!    (V64QI "TARGET_AVX512VBMI && TARGET_EVEX512")
     (V32QI "TARGET_AVX512VBMI && TARGET_AVX512VL")
     (V16QI "TARGET_AVX512VBMI && TARGET_AVX512VL")])
  
--- 28106,28131 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_mode_iterator VPERMI2
!   [V16SI V16SF V8DI V8DF
     (V8SI "TARGET_AVX512VL") (V8SF "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V4DF "TARGET_AVX512VL")
     (V4SI "TARGET_AVX512VL") (V4SF "TARGET_AVX512VL")
     (V2DI "TARGET_AVX512VL") (V2DF "TARGET_AVX512VL")
!    (V32HI "TARGET_AVX512BW")
     (V16HI "TARGET_AVX512BW && TARGET_AVX512VL")
     (V8HI "TARGET_AVX512BW && TARGET_AVX512VL")
!    (V64QI "TARGET_AVX512VBMI")
     (V32QI "TARGET_AVX512VBMI && TARGET_AVX512VL")
     (V16QI "TARGET_AVX512VBMI && TARGET_AVX512VL")])
  
  (define_mode_iterator VPERMI2I
!   [V16SI V8DI
     (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")
     (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
!    (V32HI "TARGET_AVX512BW")
     (V16HI "TARGET_AVX512BW && TARGET_AVX512VL")
     (V8HI "TARGET_AVX512BW && TARGET_AVX512VL")
!    (V64QI "TARGET_AVX512VBMI")
     (V32QI "TARGET_AVX512VBMI && TARGET_AVX512VL")
     (V16QI "TARGET_AVX512VBMI && TARGET_AVX512VL")])
  
***************
*** 28889,28917 ****
  
  ;; Modes handled by vec_init expanders.
  (define_mode_iterator VEC_INIT_MODE
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512F && TARGET_EVEX512") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F && TARGET_EVEX512") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512")
!    (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")
!    (V4TI "TARGET_AVX512F && TARGET_EVEX512") (V2TI "TARGET_AVX")])
  
  ;; Likewise, but for initialization from half sized vectors.
  ;; Thus, these are all VEC_INIT_MODE modes except V2??.
  (define_mode_iterator VEC_INIT_HALF_MODE
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512") (V4DI "TARGET_AVX")
!    (V32HF "TARGET_AVX512F && TARGET_EVEX512") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F && TARGET_EVEX512") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F && TARGET_EVEX512") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F && TARGET_EVEX512") (V4DF "TARGET_AVX")
!    (V4TI "TARGET_AVX512F && TARGET_EVEX512")])
  
  (define_expand "vec_init<mode><ssescalarmodelower>"
    [(match_operand:VEC_INIT_MODE 0 "register_operand")
--- 28800,28827 ----
  
  ;; Modes handled by vec_init expanders.
  (define_mode_iterator VEC_INIT_MODE
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX") V2DI
!    (V32HF "TARGET_AVX512F") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX") (V2DF "TARGET_SSE2")
!    (V4TI "TARGET_AVX512F") (V2TI "TARGET_AVX")])
  
  ;; Likewise, but for initialization from half sized vectors.
  ;; Thus, these are all VEC_INIT_MODE modes except V2??.
  (define_mode_iterator VEC_INIT_HALF_MODE
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX")
!    (V32HF "TARGET_AVX512F") (V16HF "TARGET_AVX") V8HF
!    (V32BF "TARGET_AVX512F") (V16BF "TARGET_AVX") V8BF
!    (V16SF "TARGET_AVX512F") (V8SF "TARGET_AVX") V4SF
!    (V8DF "TARGET_AVX512F") (V4DF "TARGET_AVX")
!    (V4TI "TARGET_AVX512F")])
  
  (define_expand "vec_init<mode><ssescalarmodelower>"
    [(match_operand:VEC_INIT_MODE 0 "register_operand")
***************
*** 29172,29178 ****
  	(unspec:V16SF
  	  [(match_operand:V16HI 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_VCVTPH2PS))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtph2ps\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 29082,29088 ----
  	(unspec:V16SF
  	  [(match_operand:V16HI 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_VCVTPH2PS))]
!   "TARGET_AVX512F"
    "vcvtph2ps\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 29262,29268 ****
  	   UNSPEC_VCVTPS2PH)
  	 (match_operand:V16HI 3 "nonimm_or_0_operand")
  	 (match_operand:HI 4 "register_operand")))]
!   "TARGET_AVX512F && TARGET_EVEX512"
  {
    int round = INTVAL (operands[2]);
    /* Separate {sae} from rounding control imm,
--- 29172,29178 ----
  	   UNSPEC_VCVTPS2PH)
  	 (match_operand:V16HI 3 "nonimm_or_0_operand")
  	 (match_operand:HI 4 "register_operand")))]
!   "TARGET_AVX512F"
  {
    int round = INTVAL (operands[2]);
    /* Separate {sae} from rounding control imm,
***************
*** 29281,29287 ****
  	  [(match_operand:V16SF 1 "register_operand" "v")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_VCVTPS2PH))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtps2ph\t{%2, <round_saeonly_mask_op3>%1, %0<mask_operand3>|%0<mask_operand3>, %1<round_saeonly_mask_op3>, %2}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 29191,29197 ----
  	  [(match_operand:V16SF 1 "register_operand" "v")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_VCVTPS2PH))]
!   "TARGET_AVX512F"
    "vcvtps2ph\t{%2, <round_saeonly_mask_op3>%1, %0<mask_operand3>|%0<mask_operand3>, %1<round_saeonly_mask_op3>, %2}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 29293,29299 ****
  	  [(match_operand:V16SF 1 "register_operand" "v")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_VCVTPS2PH))]
!   "TARGET_AVX512F && TARGET_EVEX512"
    "vcvtps2ph\t{%2, %1, %0<merge_mask_operand3>|%0<merge_mask_operand3>, %1, %2}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
--- 29203,29209 ----
  	  [(match_operand:V16SF 1 "register_operand" "v")
  	   (match_operand:SI 2 "const_0_to_255_operand")]
  	  UNSPEC_VCVTPS2PH))]
!   "TARGET_AVX512F"
    "vcvtps2ph\t{%2, %1, %0<merge_mask_operand3>|%0<merge_mask_operand3>, %1, %2}"
    [(set_attr "type" "ssecvt")
     (set_attr "prefix" "evex")
***************
*** 30272,30278 ****
  	   (match_operand:V8DI 2 "register_operand" "v")
  	   (match_operand:V8DI 3 "nonimmediate_operand" "vm")]
  	  VPMADD52))]
!   "TARGET_AVX512IFMA && TARGET_EVEX512"
    "vpmadd52<vpmadd52type>\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr "type" "ssemuladd")
     (set_attr "prefix" "evex")
--- 30182,30188 ----
  	   (match_operand:V8DI 2 "register_operand" "v")
  	   (match_operand:V8DI 3 "nonimmediate_operand" "vm")]
  	  VPMADD52))]
!   "TARGET_AVX512IFMA"
    "vpmadd52<vpmadd52type>\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr "type" "ssemuladd")
     (set_attr "prefix" "evex")
***************
*** 30643,30649 ****
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPBUSD))]
!   "TARGET_AVX512VNNI && TARGET_EVEX512"
    "vpdpbusd\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
--- 30553,30559 ----
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPBUSD))]
!   "TARGET_AVX512VNNI"
    "vpdpbusd\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
***************
*** 30712,30718 ****
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPBUSDS))]
!   "TARGET_AVX512VNNI && TARGET_EVEX512"
    "vpdpbusds\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
--- 30622,30628 ----
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPBUSDS))]
!   "TARGET_AVX512VNNI"
    "vpdpbusds\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
***************
*** 30781,30787 ****
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPWSSD))]
!   "TARGET_AVX512VNNI && TARGET_EVEX512"
    "vpdpwssd\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
--- 30691,30697 ----
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPWSSD))]
!   "TARGET_AVX512VNNI"
    "vpdpwssd\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
***************
*** 30850,30856 ****
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPWSSDS))]
!   "TARGET_AVX512VNNI && TARGET_EVEX512"
    "vpdpwssds\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
--- 30760,30766 ----
  	   (match_operand:V16SI 2 "register_operand" "v")
  	   (match_operand:V16SI 3 "nonimmediate_operand" "vm")]
  	  UNSPEC_VPDPWSSDS))]
!   "TARGET_AVX512VNNI"
    "vpdpwssds\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr ("prefix") ("evex"))])
  
***************
*** 31006,31013 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_mode_iterator VI48_AVX512VP2VL
!   [(V8DI "TARGET_EVEX512")
!    (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
     (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")])
  
  (define_mode_iterator MASK_DWI [P2QI P2HI])
--- 30916,30922 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_mode_iterator VI48_AVX512VP2VL
!   [V8DI (V4DI "TARGET_AVX512VL") (V2DI "TARGET_AVX512VL")
     (V8SI "TARGET_AVX512VL") (V4SI "TARGET_AVX512VL")])
  
  (define_mode_iterator MASK_DWI [P2QI P2HI])
***************
*** 31049,31060 ****
  	(unspec:P2HI [(match_operand:V16SI 1 "register_operand" "v")
  		      (match_operand:V16SI 2 "vector_operand" "vm")]
  		UNSPEC_VP2INTERSECT))]
!   "TARGET_AVX512VP2INTERSECT && TARGET_EVEX512"
    "vp2intersectd\t{%2, %1, %0|%0, %1, %2}"
    [(set_attr ("prefix") ("evex"))])
  
  (define_mode_iterator VF_AVX512BF16VL
!   [(V32BF "TARGET_EVEX512") (V16BF "TARGET_AVX512VL") (V8BF "TARGET_AVX512VL")])
  ;; Converting from BF to SF
  (define_mode_attr bf16_cvt_2sf
    [(V32BF  "V16SF") (V16BF  "V8SF") (V8BF  "V4SF")])
--- 30958,30969 ----
  	(unspec:P2HI [(match_operand:V16SI 1 "register_operand" "v")
  		      (match_operand:V16SI 2 "vector_operand" "vm")]
  		UNSPEC_VP2INTERSECT))]
!   "TARGET_AVX512VP2INTERSECT"
    "vp2intersectd\t{%2, %1, %0|%0, %1, %2}"
    [(set_attr ("prefix") ("evex"))])
  
  (define_mode_iterator VF_AVX512BF16VL
!   [V32BF (V16BF "TARGET_AVX512VL") (V8BF "TARGET_AVX512VL")])
  ;; Converting from BF to SF
  (define_mode_attr bf16_cvt_2sf
    [(V32BF  "V16SF") (V16BF  "V8SF") (V8BF  "V4SF")])
***************
*** 31174,31180 ****
    "vcvtneps2bf16{x}\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}")
  
  (define_mode_iterator VF1_AVX512_256
!   [(V16SF "TARGET_EVEX512") (V8SF "TARGET_AVX512VL")])
  
  (define_expand "avx512f_cvtneps2bf16_<mode>_maskz"
    [(match_operand:<sf_cvt_bf16> 0 "register_operand")
--- 31083,31089 ----
    "vcvtneps2bf16{x}\t{%1, %0%{%3%}%N2|%0%{%3%}%N2, %1}")
  
  (define_mode_iterator VF1_AVX512_256
!   [V16SF (V8SF "TARGET_AVX512VL")])
  
  (define_expand "avx512f_cvtneps2bf16_<mode>_maskz"
    [(match_operand:<sf_cvt_bf16> 0 "register_operand")
***************
*** 31220,31226 ****
    [(set (match_operand:V16BF 0 "register_operand")
  	(float_truncate:V16BF
  	  (match_operand:V16SF 1 "nonimmediate_operand")))]
!   "TARGET_AVX512BW && TARGET_EVEX512
     && !HONOR_NANS (BFmode) && !flag_rounding_math
     && (flag_unsafe_math_optimizations || TARGET_AVX512BF16)"
  {
--- 31129,31135 ----
    [(set (match_operand:V16BF 0 "register_operand")
  	(float_truncate:V16BF
  	  (match_operand:V16SF 1 "nonimmediate_operand")))]
!   "TARGET_AVX512BW
     && !HONOR_NANS (BFmode) && !flag_rounding_math
     && (flag_unsafe_math_optimizations || TARGET_AVX512BF16)"
  {
***************
*** 31504,31513 ****
  ;;	vinserti64x4	$0x1, %ymm15, %zmm15, %zmm15
  
  (define_mode_iterator INT_BROADCAST_MODE
!   [(V64QI "TARGET_AVX512F && TARGET_EVEX512") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F && TARGET_EVEX512") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F && TARGET_EVEX512") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_EVEX512 && TARGET_64BIT")
     (V4DI "TARGET_AVX && TARGET_64BIT") (V2DI "TARGET_64BIT")])
  
  ;; Broadcast from an integer.  NB: Enable broadcast only if we can move
--- 31413,31422 ----
  ;;	vinserti64x4	$0x1, %ymm15, %zmm15, %zmm15
  
  (define_mode_iterator INT_BROADCAST_MODE
!   [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI
!    (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI
!    (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX") V4SI
!    (V8DI "TARGET_AVX512F && TARGET_64BIT")
     (V4DI "TARGET_AVX && TARGET_64BIT") (V2DI "TARGET_64BIT")])
  
  ;; Broadcast from an integer.  NB: Enable broadcast only if we can move
***************
*** 31781,31788 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_cvt2ps2phx_<mode><mask_name><round_name>"
!   [(set (match_operand:VHF_AVX10_2 0 "register_operand" "=v")
! 	(vec_concat:VHF_AVX10_2
  	  (float_truncate:<ssehalfvecmode>
  	    (match_operand:<ssePSmode> 2 "<round_nimm_predicate>" "<round_constraint>"))
  	  (float_truncate:<ssehalfvecmode>
--- 31690,31697 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_cvt2ps2phx_<mode><mask_name><round_name>"
!   [(set (match_operand:VHF_AVX512VL 0 "register_operand" "=v")
! 	(vec_concat:VHF_AVX512VL
  	  (float_truncate:<ssehalfvecmode>
  	    (match_operand:<ssePSmode> 2 "<round_nimm_predicate>" "<round_constraint>"))
  	  (float_truncate:<ssehalfvecmode>
***************
*** 31806,31813 ****
  (define_insn "vcvt<convertfp8_pack><mode><mask_name>"
    [(set (match_operand:<ssebvecmode> 0 "register_operand" "=v")
  	(unspec:<ssebvecmode>
! 	  [(match_operand:VHF_AVX10_2 1 "register_operand" "v")
! 	   (match_operand:VHF_AVX10_2 2 "nonimmediate_operand" "vm")]
  	  UNSPEC_CONVERTFP8_PACK))]
    "TARGET_AVX10_2"
    "vcvt<convertfp8_pack>\t{%2, %1, %0<mask_operand3>|%0<mask_operand2>, %1, %2}"
--- 31715,31722 ----
  (define_insn "vcvt<convertfp8_pack><mode><mask_name>"
    [(set (match_operand:<ssebvecmode> 0 "register_operand" "=v")
  	(unspec:<ssebvecmode>
! 	  [(match_operand:VHF_AVX512VL 1 "register_operand" "v")
! 	   (match_operand:VHF_AVX512VL 2 "nonimmediate_operand" "vm")]
  	  UNSPEC_CONVERTFP8_PACK))]
    "TARGET_AVX10_2"
    "vcvt<convertfp8_pack>\t{%2, %1, %0<mask_operand3>|%0<mask_operand2>, %1, %2}"
***************
*** 31890,31896 ****
    [(set_attr "prefix" "evex")])
  
  (define_mode_iterator VHF_AVX10_2_2
!   [(V32HF "TARGET_AVX10_2") V16HF])
  
  (define_insn "vcvt<biasph2fp8_pack><mode><mask_name>"
    [(set (match_operand:<ssebvecmode_2> 0 "register_operand" "=v")
--- 31799,31805 ----
    [(set_attr "prefix" "evex")])
  
  (define_mode_iterator VHF_AVX10_2_2
!   [V32HF V16HF])
  
  (define_insn "vcvt<biasph2fp8_pack><mode><mask_name>"
    [(set (match_operand:<ssebvecmode_2> 0 "register_operand" "=v")
***************
*** 31987,31994 ****
    [(set_attr "prefix" "evex")])
  
  (define_insn "vcvthf82ph<mode><mask_name>"
!   [(set (match_operand:VHF_AVX10_2 0 "register_operand" "=v")
! 	(unspec:VHF_AVX10_2
  	  [(match_operand:<ssebvecmode_2> 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_VCVTHF82PH))]
    "TARGET_AVX10_2"
--- 31896,31903 ----
    [(set_attr "prefix" "evex")])
  
  (define_insn "vcvthf82ph<mode><mask_name>"
!   [(set (match_operand:VHF_AVX512VL 0 "register_operand" "=v")
! 	(unspec:VHF_AVX512VL
  	  [(match_operand:<ssebvecmode_2> 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_VCVTHF82PH))]
    "TARGET_AVX10_2"
***************
*** 32010,32017 ****
  
  (define_expand "usdot_prod<sseunpackmodelower><mode>"
    [(match_operand:<sseunpackmode> 0 "register_operand")
!    (match_operand:VI2_AVX10_2 1 "register_operand")
!    (match_operand:VI2_AVX10_2 2 "register_operand")
     (match_operand:<sseunpackmode> 3 "register_operand")]
    "TARGET_AVXVNNIINT16 || TARGET_AVX10_2"
  {
--- 31919,31926 ----
  
  (define_expand "usdot_prod<sseunpackmodelower><mode>"
    [(match_operand:<sseunpackmode> 0 "register_operand")
!    (match_operand:VI2_AVX512F 1 "register_operand")
!    (match_operand:VI2_AVX512F 2 "register_operand")
     (match_operand:<sseunpackmode> 3 "register_operand")]
    "TARGET_AVXVNNIINT16 || TARGET_AVX10_2"
  {
***************
*** 32028,32035 ****
  
  (define_expand "udot_prod<sseunpackmodelower><mode>"
    [(match_operand:<sseunpackmode> 0 "register_operand")
!    (match_operand:VI2_AVX10_2 1 "register_operand")
!    (match_operand:VI2_AVX10_2 2 "register_operand")
     (match_operand:<sseunpackmode> 3 "register_operand")]
    "TARGET_AVXVNNIINT16 || TARGET_AVX10_2"
  {
--- 31937,31944 ----
  
  (define_expand "udot_prod<sseunpackmodelower><mode>"
    [(match_operand:<sseunpackmode> 0 "register_operand")
!    (match_operand:VI2_AVX512F 1 "register_operand")
!    (match_operand:VI2_AVX512F 2 "register_operand")
     (match_operand:<sseunpackmode> 3 "register_operand")]
    "TARGET_AVXVNNIINT16 || TARGET_AVX10_2"
  {
***************
*** 32108,32130 ****
     [(set_attr "prefix" "evex")])
  
  (define_insn "vdpphps_<mode>"
!   [(set (match_operand:VF1_AVX10_2 0 "register_operand" "=v")
! 	(unspec:VF1_AVX10_2
! 	  [(match_operand:VF1_AVX10_2 1 "register_operand" "0")
! 	   (match_operand:VF1_AVX10_2 2 "register_operand" "v")
! 	   (match_operand:VF1_AVX10_2 3 "nonimmediate_operand" "vm")]
  	   UNSPEC_VDPPHPS))]
    "TARGET_AVX10_2"
    "vdpphps\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr "prefix" "evex")])
  
  (define_insn "vdpphps_<mode>_mask"
!   [(set (match_operand:VF1_AVX10_2 0 "register_operand" "=v")
! 	(vec_merge:VF1_AVX10_2
! 	  (unspec:VF1_AVX10_2
! 	    [(match_operand:VF1_AVX10_2 1 "register_operand" "0")
! 	     (match_operand:VF1_AVX10_2 2 "register_operand" "v")
! 	     (match_operand:VF1_AVX10_2 3 "nonimmediate_operand" "vm")]
  	    UNSPEC_VDPPHPS)
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
--- 32017,32039 ----
     [(set_attr "prefix" "evex")])
  
  (define_insn "vdpphps_<mode>"
!   [(set (match_operand:VF1_AVX512VL 0 "register_operand" "=v")
! 	(unspec:VF1_AVX512VL
! 	  [(match_operand:VF1_AVX512VL 1 "register_operand" "0")
! 	   (match_operand:VF1_AVX512VL 2 "register_operand" "v")
! 	   (match_operand:VF1_AVX512VL 3 "nonimmediate_operand" "vm")]
  	   UNSPEC_VDPPHPS))]
    "TARGET_AVX10_2"
    "vdpphps\t{%3, %2, %0|%0, %2, %3}"
    [(set_attr "prefix" "evex")])
  
  (define_insn "vdpphps_<mode>_mask"
!   [(set (match_operand:VF1_AVX512VL 0 "register_operand" "=v")
! 	(vec_merge:VF1_AVX512VL
! 	  (unspec:VF1_AVX512VL
! 	    [(match_operand:VF1_AVX512VL 1 "register_operand" "0")
! 	     (match_operand:VF1_AVX512VL 2 "register_operand" "v")
! 	     (match_operand:VF1_AVX512VL 3 "nonimmediate_operand" "vm")]
  	    UNSPEC_VDPPHPS)
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
***************
*** 32133,32142 ****
    [(set_attr "prefix" "evex")])
  
  (define_expand "vdpphps_<mode>_maskz"
!   [(match_operand:VF1_AVX10_2 0 "register_operand")
!    (match_operand:VF1_AVX10_2 1 "register_operand")
!    (match_operand:VF1_AVX10_2 2 "register_operand")
!    (match_operand:VF1_AVX10_2 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
  {
--- 32042,32051 ----
    [(set_attr "prefix" "evex")])
  
  (define_expand "vdpphps_<mode>_maskz"
!   [(match_operand:VF1_AVX512VL 0 "register_operand")
!    (match_operand:VF1_AVX512VL 1 "register_operand")
!    (match_operand:VF1_AVX512VL 2 "register_operand")
!    (match_operand:VF1_AVX512VL 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
  {
***************
*** 32146,32205 ****
  })
  
  (define_insn "vdpphps_<mode>_maskz_1"
!   [(set (match_operand:VF1_AVX10_2 0 "register_operand" "=v")
! 	(vec_merge:VF1_AVX10_2
! 	  (unspec:VF1_AVX10_2
! 	    [(match_operand:VF1_AVX10_2 1 "register_operand" "0")
! 	     (match_operand:VF1_AVX10_2 2 "register_operand" "v")
! 	     (match_operand:VF1_AVX10_2 3 "nonimmediate_operand" "vm")]
  	    UNSPEC_VDPPHPS)
! 	  (match_operand:VF1_AVX10_2 4 "const0_operand" "C")
  	  (match_operand:<avx512fmaskmode> 5 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
    "vdpphps\t{%3, %2, %0%{%5%}%N4|%0%{%5%}%N4, %2, %3}"
    [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_scalefbf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
!       (unspec:VBF_AVX10_2
! 	[(match_operand:VBF_AVX10_2 1 "register_operand" "v")
! 	 (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")]
         UNSPEC_VSCALEFBF16))]
     "TARGET_AVX10_2"
     "vscalefbf16\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
     [(set_attr "prefix" "evex")])
  
  (define_expand "<code><mode>3"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand")
!      (smaxmin:VBF_AVX10_2
!        (match_operand:VBF_AVX10_2 1 "register_operand")
!        (match_operand:VBF_AVX10_2 2 "nonimmediate_operand")))]
    "TARGET_AVX10_2")
  
  (define_insn "avx10_2_<code>bf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
!       (smaxmin:VBF_AVX10_2
! 	 (match_operand:VBF_AVX10_2 1 "register_operand" "v")
! 	 (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")))]
     "TARGET_AVX10_2"
     "v<maxmin_float>bf16\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
     [(set_attr "prefix" "evex")
      (set_attr "mode" "<MODE>")])
  
  (define_insn "avx10_2_<insn>bf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
!       (plusminusmultdiv:VBF_AVX10_2
! 	(match_operand:VBF_AVX10_2 1 "register_operand" "v")
! 	(match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")))]
     "TARGET_AVX10_2"
     "v<insn>bf16\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
     [(set_attr "prefix" "evex")])
  
  (define_expand "avx10_2_fmaddbf16_<mode>_maskz"
!   [(match_operand:VBF_AVX10_2 0 "register_operand")
!    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
--- 32055,32114 ----
  })
  
  (define_insn "vdpphps_<mode>_maskz_1"
!   [(set (match_operand:VF1_AVX512VL 0 "register_operand" "=v")
! 	(vec_merge:VF1_AVX512VL
! 	  (unspec:VF1_AVX512VL
! 	    [(match_operand:VF1_AVX512VL 1 "register_operand" "0")
! 	     (match_operand:VF1_AVX512VL 2 "register_operand" "v")
! 	     (match_operand:VF1_AVX512VL 3 "nonimmediate_operand" "vm")]
  	    UNSPEC_VDPPHPS)
! 	  (match_operand:VF1_AVX512VL 4 "const0_operand" "C")
  	  (match_operand:<avx512fmaskmode> 5 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
    "vdpphps\t{%3, %2, %0%{%5%}%N4|%0%{%5%}%N4, %2, %3}"
    [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_scalefbf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
!       (unspec:VBF
! 	[(match_operand:VBF 1 "register_operand" "v")
! 	 (match_operand:VBF 2 "nonimmediate_operand" "vm")]
         UNSPEC_VSCALEFBF16))]
     "TARGET_AVX10_2"
     "vscalefbf16\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
     [(set_attr "prefix" "evex")])
  
  (define_expand "<code><mode>3"
!   [(set (match_operand:VBF 0 "register_operand")
!      (smaxmin:VBF
!        (match_operand:VBF 1 "register_operand")
!        (match_operand:VBF 2 "nonimmediate_operand")))]
    "TARGET_AVX10_2")
  
  (define_insn "avx10_2_<code>bf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
!       (smaxmin:VBF
! 	 (match_operand:VBF 1 "register_operand" "v")
! 	 (match_operand:VBF 2 "nonimmediate_operand" "vm")))]
     "TARGET_AVX10_2"
     "v<maxmin_float>bf16\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
     [(set_attr "prefix" "evex")
      (set_attr "mode" "<MODE>")])
  
  (define_insn "avx10_2_<insn>bf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
!       (plusminusmultdiv:VBF
! 	(match_operand:VBF 1 "register_operand" "v")
! 	(match_operand:VBF 2 "nonimmediate_operand" "vm")))]
     "TARGET_AVX10_2"
     "v<insn>bf16\t{%2, %1, %0<mask_operand3>|%0<mask_operand3>, %1, %2}"
     [(set_attr "prefix" "evex")])
  
  (define_expand "avx10_2_fmaddbf16_<mode>_maskz"
!   [(match_operand:VBF 0 "register_operand")
!    (match_operand:VBF 1 "nonimmediate_operand")
!    (match_operand:VBF 2 "nonimmediate_operand")
!    (match_operand:VBF 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
***************
*** 32211,32221 ****
    })
  
  (define_insn "avx10_2_fmaddbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v,v")
! 	  (fma:VBF_AVX10_2
! 	    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%0,0,v")
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v,vm")
! 	    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm,0")))]
    "TARGET_AVX10_2"
    "@
     vfmadd132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
--- 32120,32130 ----
    })
  
  (define_insn "avx10_2_fmaddbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v,v")
! 	  (fma:VBF
! 	    (match_operand:VBF 1 "nonimmediate_operand" "%0,0,v")
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm,v,vm")
! 	    (match_operand:VBF 3 "nonimmediate_operand" "v,vm,0")))]
    "TARGET_AVX10_2"
    "@
     vfmadd132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
***************
*** 32226,32237 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmaddbf16_<mode>_mask"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	     (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "0,0")
! 	     (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v")
! 	     (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm"))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
--- 32135,32146 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmaddbf16_<mode>_mask"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	     (match_operand:VBF 1 "nonimmediate_operand" "0,0")
! 	     (match_operand:VBF 2 "nonimmediate_operand" "vm,v")
! 	     (match_operand:VBF 3 "nonimmediate_operand" "v,vm"))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
***************
*** 32243,32254 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmaddbf16_<mode>_mask3"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	     (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%v")
! 	     (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")
! 	     (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "0"))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
--- 32152,32163 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmaddbf16_<mode>_mask3"
!   [(set (match_operand:VBF 0 "register_operand" "=v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	     (match_operand:VBF 1 "nonimmediate_operand" "%v")
! 	     (match_operand:VBF 2 "nonimmediate_operand" "vm")
! 	     (match_operand:VBF 3 "nonimmediate_operand" "0"))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
***************
*** 32258,32267 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_expand "avx10_2_fnmaddbf16_<mode>_maskz"
!   [(match_operand:VBF_AVX10_2 0 "register_operand")
!    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
--- 32167,32176 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_expand "avx10_2_fnmaddbf16_<mode>_maskz"
!   [(match_operand:VBF 0 "register_operand")
!    (match_operand:VBF 1 "nonimmediate_operand")
!    (match_operand:VBF 2 "nonimmediate_operand")
!    (match_operand:VBF 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
***************
*** 32273,32284 ****
    })
  
  (define_insn "avx10_2_fnmaddbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v,v")
! 	  (fma:VBF_AVX10_2
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%0,0,v"))
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v,vm")
! 	    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm,0")))]
    "TARGET_AVX10_2"
    "@
     vfnmadd132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
--- 32182,32193 ----
    })
  
  (define_insn "avx10_2_fnmaddbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v,v")
! 	  (fma:VBF
! 	    (neg:VBF
! 	      (match_operand:VBF 1 "nonimmediate_operand" "%0,0,v"))
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm,v,vm")
! 	    (match_operand:VBF 3 "nonimmediate_operand" "v,vm,0")))]
    "TARGET_AVX10_2"
    "@
     vfnmadd132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
***************
*** 32289,32301 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmaddbf16_<mode>_mask"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "0,0"))
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v")
! 	    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm"))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
--- 32198,32210 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmaddbf16_<mode>_mask"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	    (neg:VBF
! 	      (match_operand:VBF 1 "nonimmediate_operand" "0,0"))
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm,v")
! 	    (match_operand:VBF 3 "nonimmediate_operand" "v,vm"))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
***************
*** 32307,32319 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmaddbf16_<mode>_mask3"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%v"))
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")
! 	    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "0"))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
--- 32216,32228 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmaddbf16_<mode>_mask3"
!   [(set (match_operand:VBF 0 "register_operand" "=v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	    (neg:VBF
! 	      (match_operand:VBF 1 "nonimmediate_operand" "%v"))
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm")
! 	    (match_operand:VBF 3 "nonimmediate_operand" "0"))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
***************
*** 32323,32332 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_expand "avx10_2_fmsubbf16_<mode>_maskz"
!   [(match_operand:VBF_AVX10_2 0 "register_operand")
!    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
--- 32232,32241 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_expand "avx10_2_fmsubbf16_<mode>_maskz"
!   [(match_operand:VBF 0 "register_operand")
!    (match_operand:VBF 1 "nonimmediate_operand")
!    (match_operand:VBF 2 "nonimmediate_operand")
!    (match_operand:VBF 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
***************
*** 32338,32349 ****
    })
  
  (define_insn "avx10_2_fmsubbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v,v")
! 	  (fma:VBF_AVX10_2
! 	    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%0,0,v")
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v,vm")
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm,0"))))]
    "TARGET_AVX10_2"
    "@
     vfmsub132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
--- 32247,32258 ----
    })
  
  (define_insn "avx10_2_fmsubbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v,v")
! 	  (fma:VBF
! 	    (match_operand:VBF 1 "nonimmediate_operand" "%0,0,v")
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm,v,vm")
! 	    (neg:VBF
! 	      (match_operand:VBF 3 "nonimmediate_operand" "v,vm,0"))))]
    "TARGET_AVX10_2"
    "@
     vfmsub132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
***************
*** 32354,32366 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmsubbf16_<mode>_mask"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "0,0")
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v")
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm")))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
--- 32263,32275 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmsubbf16_<mode>_mask"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	    (match_operand:VBF 1 "nonimmediate_operand" "0,0")
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm,v")
! 	    (neg:VBF
! 	      (match_operand:VBF 3 "nonimmediate_operand" "v,vm")))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
***************
*** 32372,32384 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmsubbf16_<mode>_mask3"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%v")
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "0")))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
--- 32281,32293 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fmsubbf16_<mode>_mask3"
!   [(set (match_operand:VBF 0 "register_operand" "=v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	    (match_operand:VBF 1 "nonimmediate_operand" "%v")
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm")
! 	    (neg:VBF
! 	      (match_operand:VBF 3 "nonimmediate_operand" "0")))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
***************
*** 32388,32397 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_expand "avx10_2_fnmsubbf16_<mode>_maskz"
!   [(match_operand:VBF_AVX10_2 0 "register_operand")
!    (match_operand:VBF_AVX10_2 1 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand")
!    (match_operand:VBF_AVX10_2 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
--- 32297,32306 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_expand "avx10_2_fnmsubbf16_<mode>_maskz"
!   [(match_operand:VBF 0 "register_operand")
!    (match_operand:VBF 1 "nonimmediate_operand")
!    (match_operand:VBF 2 "nonimmediate_operand")
!    (match_operand:VBF 3 "nonimmediate_operand")
     (match_operand:<avx512fmaskmode> 4 "register_operand")]
    "TARGET_AVX10_2"
    {
***************
*** 32403,32415 ****
    })
  
  (define_insn "avx10_2_fnmsubbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v,v")
! 	  (fma:VBF_AVX10_2
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%0,0,v"))
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v,vm")
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm,0"))))]
    "TARGET_AVX10_2"
    "@
     vfnmsub132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
--- 32312,32324 ----
    })
  
  (define_insn "avx10_2_fnmsubbf16_<mode><sd_maskz_name>"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v,v")
! 	  (fma:VBF
! 	    (neg:VBF
! 	      (match_operand:VBF 1 "nonimmediate_operand" "%0,0,v"))
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm,v,vm")
! 	    (neg:VBF
! 	      (match_operand:VBF 3 "nonimmediate_operand" "v,vm,0"))))]
    "TARGET_AVX10_2"
    "@
     vfnmsub132bf16\t{%2, %3, %0<sd_mask_op4>|%0<sd_mask_op4>, %3, %2}
***************
*** 32420,32433 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmsubbf16_<mode>_mask"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v,v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "0,0"))
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm,v")
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "v,vm")))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
--- 32329,32342 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmsubbf16_<mode>_mask"
!   [(set (match_operand:VBF 0 "register_operand" "=v,v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	    (neg:VBF
! 	      (match_operand:VBF 1 "nonimmediate_operand" "0,0"))
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm,v")
! 	    (neg:VBF
! 	      (match_operand:VBF 3 "nonimmediate_operand" "v,vm")))
  	  (match_dup 1)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk,Yk")))]
    "TARGET_AVX10_2"
***************
*** 32439,32452 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmsubbf16_<mode>_mask3"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	(vec_merge:VBF_AVX10_2
! 	  (fma:VBF_AVX10_2
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "%v"))
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")
! 	    (neg:VBF_AVX10_2
! 	      (match_operand:VBF_AVX10_2 3 "nonimmediate_operand" "0")))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
--- 32348,32361 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_fnmsubbf16_<mode>_mask3"
!   [(set (match_operand:VBF 0 "register_operand" "=v")
! 	(vec_merge:VBF
! 	  (fma:VBF
! 	    (neg:VBF
! 	      (match_operand:VBF 1 "nonimmediate_operand" "%v"))
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm")
! 	    (neg:VBF
! 	      (match_operand:VBF 3 "nonimmediate_operand" "0")))
  	  (match_dup 3)
  	  (match_operand:<avx512fmaskmode> 4 "register_operand" "Yk")))]
    "TARGET_AVX10_2"
***************
*** 32456,32490 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_rsqrtbf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	 (unspec:VBF_AVX10_2
! 	   [(match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_RSQRT))]
     "TARGET_AVX10_2"
     "vrsqrtbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
     [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_sqrtbf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	 (sqrt:VBF_AVX10_2
! 	   (match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "vm")))]
     "TARGET_AVX10_2"
     "vsqrtbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
     [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_rcpbf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	 (unspec:VBF_AVX10_2
! 	   [(match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_RCP))]
     "TARGET_AVX10_2"
     "vrcpbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
     [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_getexpbf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	 (unspec:VBF_AVX10_2
! 	   [(match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_GETEXP))]
     "TARGET_AVX10_2"
     "vgetexpbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
--- 32365,32399 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_rsqrtbf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
! 	 (unspec:VBF
! 	   [(match_operand:VBF 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_RSQRT))]
     "TARGET_AVX10_2"
     "vrsqrtbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
     [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_sqrtbf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
! 	 (sqrt:VBF
! 	   (match_operand:VBF 1 "nonimmediate_operand" "vm")))]
     "TARGET_AVX10_2"
     "vsqrtbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
     [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_rcpbf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
! 	 (unspec:VBF
! 	   [(match_operand:VBF 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_RCP))]
     "TARGET_AVX10_2"
     "vrcpbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
     [(set_attr "prefix" "evex")])
  
  (define_insn "avx10_2_getexpbf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
! 	 (unspec:VBF
! 	   [(match_operand:VBF 1 "nonimmediate_operand" "vm")]
  	  UNSPEC_GETEXP))]
     "TARGET_AVX10_2"
     "vgetexpbf16\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
***************
*** 32501,32509 ****
      (UNSPEC_VGETMANTBF16 "getmant")])
  
  (define_insn "avx10_2_<bf16immop>bf16_<mode><mask_name>"
!    [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
! 	 (unspec:VBF_AVX10_2
! 	   [(match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "vm")
  	    (match_operand:SI 2 "const_0_to_255_operand")]
  	  BF16IMMOP))]
     "TARGET_AVX10_2"
--- 32410,32418 ----
      (UNSPEC_VGETMANTBF16 "getmant")])
  
  (define_insn "avx10_2_<bf16immop>bf16_<mode><mask_name>"
!    [(set (match_operand:VBF 0 "register_operand" "=v")
! 	 (unspec:VBF
! 	   [(match_operand:VBF 1 "nonimmediate_operand" "vm")
  	    (match_operand:SI 2 "const_0_to_255_operand")]
  	  BF16IMMOP))]
     "TARGET_AVX10_2"
***************
*** 32513,32519 ****
  (define_insn "avx10_2_fpclassbf16_<mode><mask_scalar_merge_name>"
     [(set (match_operand:<avx512fmaskmode> 0 "register_operand" "=k")
  	 (unspec:<avx512fmaskmode>
! 	   [(match_operand:VBF_AVX10_2 1 "nonimmediate_operand" "vm")
  	    (match_operand 2 "const_0_to_255_operand")]
  	  UNSPEC_VFPCLASSBF16))]
     "TARGET_AVX10_2"
--- 32422,32428 ----
  (define_insn "avx10_2_fpclassbf16_<mode><mask_scalar_merge_name>"
     [(set (match_operand:<avx512fmaskmode> 0 "register_operand" "=k")
  	 (unspec:<avx512fmaskmode>
! 	   [(match_operand:VBF 1 "nonimmediate_operand" "vm")
  	    (match_operand 2 "const_0_to_255_operand")]
  	  UNSPEC_VFPCLASSBF16))]
     "TARGET_AVX10_2"
***************
*** 32523,32530 ****
  (define_insn "avx10_2_cmpbf16_<mode><mask_scalar_merge_name>"
     [(set (match_operand:<avx512fmaskmode> 0 "register_operand" "=k")
  	 (unspec:<avx512fmaskmode>
! 	   [(match_operand:VBF_AVX10_2 1 "register_operand" "v")
! 	    (match_operand:VBF_AVX10_2 2 "nonimmediate_operand" "vm")
  	    (match_operand 3 "const_0_to_31_operand" "n")]
  	  UNSPEC_PCMP))]
     "TARGET_AVX10_2"
--- 32432,32439 ----
  (define_insn "avx10_2_cmpbf16_<mode><mask_scalar_merge_name>"
     [(set (match_operand:<avx512fmaskmode> 0 "register_operand" "=k")
  	 (unspec:<avx512fmaskmode>
! 	   [(match_operand:VBF 1 "register_operand" "v")
! 	    (match_operand:VBF 2 "nonimmediate_operand" "vm")
  	    (match_operand 3 "const_0_to_31_operand" "n")]
  	  UNSPEC_PCMP))]
     "TARGET_AVX10_2"
***************
*** 32562,32568 ****
  (define_insn "avx10_2_cvt<sat_cvt_trunc_prefix>bf162i<sat_cvt_sign_prefix>bs<mode><mask_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VBF_AVX10_2 1 "vector_operand" "vm")]
  	  UNSPEC_CVT_BF16_IBS_ITER))]
   "TARGET_AVX10_2"
   "vcvt<sat_cvt_trunc_prefix>bf162i<sat_cvt_sign_prefix>bs\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
--- 32471,32477 ----
  (define_insn "avx10_2_cvt<sat_cvt_trunc_prefix>bf162i<sat_cvt_sign_prefix>bs<mode><mask_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VBF 1 "vector_operand" "vm")]
  	  UNSPEC_CVT_BF16_IBS_ITER))]
   "TARGET_AVX10_2"
   "vcvt<sat_cvt_trunc_prefix>bf162i<sat_cvt_sign_prefix>bs\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
***************
*** 32577,32583 ****
  (define_insn "avx10_2_cvtph2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VHF_AVX10_2 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_CVT_PH_IBS_ITER))]
   "TARGET_AVX10_2 && <round_mode512bit_condition>"
   "vcvtph2i<sat_cvt_sign_prefix>bs\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
--- 32486,32492 ----
  (define_insn "avx10_2_cvtph2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VHF_AVX512VL 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_CVT_PH_IBS_ITER))]
   "TARGET_AVX10_2 && <round_mode512bit_condition>"
   "vcvtph2i<sat_cvt_sign_prefix>bs\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
***************
*** 32592,32598 ****
  (define_insn "avx10_2_cvttph2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VHF_AVX10_2 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_CVTT_PH_IBS_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvttph2i<sat_cvt_sign_prefix>bs\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
--- 32501,32507 ----
  (define_insn "avx10_2_cvttph2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VHF_AVX512VL 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_CVTT_PH_IBS_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvttph2i<sat_cvt_sign_prefix>bs\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
***************
*** 32607,32613 ****
  (define_insn "avx10_2_cvtps2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VF1_AVX10_2 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_CVT_PS_IBS_ITER))]
   "TARGET_AVX10_2 && <round_mode512bit_condition>"
   "vcvtps2i<sat_cvt_sign_prefix>bs\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
--- 32516,32522 ----
  (define_insn "avx10_2_cvtps2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VF1_AVX512VL 1 "<round_nimm_predicate>" "<round_constraint>")]
  	  UNSPEC_CVT_PS_IBS_ITER))]
   "TARGET_AVX10_2 && <round_mode512bit_condition>"
   "vcvtps2i<sat_cvt_sign_prefix>bs\t{<round_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_mask_op2>}"
***************
*** 32622,32628 ****
  (define_insn "avx10_2_cvttps2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VF1_AVX10_2 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_CVTT_PS_IBS_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvttps2i<sat_cvt_sign_prefix>bs\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
--- 32531,32537 ----
  (define_insn "avx10_2_cvttps2i<sat_cvt_sign_prefix>bs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<sseintvecmode> 0 "register_operand" "=v")
         (unspec:<sseintvecmode>
! 	  [(match_operand:VF1_AVX512VL 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_CVTT_PS_IBS_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvttps2i<sat_cvt_sign_prefix>bs\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
***************
*** 32641,32647 ****
  (define_insn "avx10_2_vcvtt<castmode>2<sat_cvt_sign_prefix>dqs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<VEC_GATHER_IDXSI> 0 "register_operand" "=v")
         (unspec:<VEC_GATHER_IDXSI>
! 	  [(match_operand:VF1_VF2_AVX10_2 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_SAT_CVT_DS_SIGN_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvtt<castmode>2<sat_cvt_sign_prefix>dqs<pd2dqssuff>\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
--- 32550,32556 ----
  (define_insn "avx10_2_vcvtt<castmode>2<sat_cvt_sign_prefix>dqs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<VEC_GATHER_IDXSI> 0 "register_operand" "=v")
         (unspec:<VEC_GATHER_IDXSI>
! 	  [(match_operand:VF 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_SAT_CVT_DS_SIGN_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvtt<castmode>2<sat_cvt_sign_prefix>dqs<pd2dqssuff>\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
***************
*** 32652,32658 ****
  (define_insn "avx10_2_vcvttpd2<sat_cvt_sign_prefix>qqs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<VEC_GATHER_IDXDI> 0 "register_operand" "=v")
         (unspec:<VEC_GATHER_IDXDI>
! 	  [(match_operand:VF2_AVX10_2 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_SAT_CVT_DS_SIGN_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvttpd2<sat_cvt_sign_prefix>qqs\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
--- 32561,32567 ----
  (define_insn "avx10_2_vcvttpd2<sat_cvt_sign_prefix>qqs<mode><mask_name><round_saeonly_name>"
   [(set (match_operand:<VEC_GATHER_IDXDI> 0 "register_operand" "=v")
         (unspec:<VEC_GATHER_IDXDI>
! 	  [(match_operand:VF2 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_SAT_CVT_DS_SIGN_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
   "vcvttpd2<sat_cvt_sign_prefix>qqs\t{<round_saeonly_mask_op2>%1, %0<mask_operand2>|%0<mask_operand2>, %1<round_saeonly_mask_op2>}"
***************
*** 32661,32668 ****
    (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_vcvttps2<sat_cvt_sign_prefix>qqs<mode><mask_name><round_saeonly_name>"
!  [(set (match_operand:VI8_AVX10_2 0 "register_operand" "=v")
!        (unspec:VI8_AVX10_2
  	  [(match_operand:<vpckfloat_temp_mode> 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_SAT_CVT_DS_SIGN_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
--- 32570,32577 ----
    (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_vcvttps2<sat_cvt_sign_prefix>qqs<mode><mask_name><round_saeonly_name>"
!  [(set (match_operand:VI8 0 "register_operand" "=v")
!        (unspec:VI8
  	  [(match_operand:<vpckfloat_temp_mode> 1 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")]
  	  UNSPEC_SAT_CVT_DS_SIGN_ITER))]
   "TARGET_AVX10_2 && <round_saeonly_mode512bit_condition>"
***************
*** 32698,32707 ****
   (set_attr "mode" "<MODE>")])
  
  (define_insn "avx10_2_minmaxbf16_<mode><mask_name>"
!   [(set (match_operand:VBF_AVX10_2 0 "register_operand" "=v")
!     (unspec:VBF_AVX10_2
!       [(match_operand:VBF_AVX10_2 1 "register_operand" "v")
!        (match_operand:VBF_AVX10_2 2 "bcst_vector_operand" "vmBr")
         (match_operand:SI 3 "const_0_to_255_operand")]
         UNSPEC_MINMAXBF16))]
    "TARGET_AVX10_2"
--- 32607,32616 ----
   (set_attr "mode" "<MODE>")])
  
  (define_insn "avx10_2_minmaxbf16_<mode><mask_name>"
!   [(set (match_operand:VBF 0 "register_operand" "=v")
!     (unspec:VBF
!       [(match_operand:VBF 1 "register_operand" "v")
!        (match_operand:VBF 2 "bcst_vector_operand" "vmBr")
         (match_operand:SI 3 "const_0_to_255_operand")]
         UNSPEC_MINMAXBF16))]
    "TARGET_AVX10_2"
***************
*** 32710,32719 ****
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_minmaxp<mode><mask_name><round_saeonly_name>"
!   [(set (match_operand:VFH_AVX10_2 0 "register_operand" "=v")
!     (unspec:VFH_AVX10_2
!       [(match_operand:VFH_AVX10_2 1 "register_operand" "v")
!        (match_operand:VFH_AVX10_2 2 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")
         (match_operand:SI 3 "const_0_to_255_operand")]
        UNSPEC_MINMAX))]
    "TARGET_AVX10_2"
--- 32619,32628 ----
     (set_attr "mode" "<sseinsnmode>")])
  
  (define_insn "avx10_2_minmaxp<mode><mask_name><round_saeonly_name>"
!   [(set (match_operand:VFH_AVX512VL 0 "register_operand" "=v")
!     (unspec:VFH_AVX512VL
!       [(match_operand:VFH_AVX512VL 1 "register_operand" "v")
!        (match_operand:VFH_AVX512VL 2 "<round_saeonly_nimm_predicate>" "<round_saeonly_constraint>")
         (match_operand:SI 3 "const_0_to_255_operand")]
        UNSPEC_MINMAX))]
    "TARGET_AVX10_2"
***************
*** 32737,32745 ****
     (set_attr "mode" "<ssescalarmode>")])
  
  (define_insn "avx10_2_vmovrs<ssemodesuffix><mode><mask_name>"
!   [(set (match_operand:VI1248_AVX10_2 0 "register_operand" "=v")
! 	(unspec:VI1248_AVX10_2
! 	  [(match_operand:VI1248_AVX10_2 1 "memory_operand" "m")]
  	  UNSPEC_VMOVRS))]
    "TARGET_AVX10_2 && TARGET_MOVRS"
    "vmovrs<ssemodesuffix>\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
--- 32646,32654 ----
     (set_attr "mode" "<ssescalarmode>")])
  
  (define_insn "avx10_2_vmovrs<ssemodesuffix><mode><mask_name>"
!   [(set (match_operand:VI1248_AVX512VLBW 0 "register_operand" "=v")
! 	(unspec:VI1248_AVX512VLBW
! 	  [(match_operand:VI1248_AVX512VLBW 1 "memory_operand" "m")]
  	  UNSPEC_VMOVRS))]
    "TARGET_AVX10_2 && TARGET_MOVRS"
    "vmovrs<ssemodesuffix>\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}"
diff -Nrcpad gcc-16-20250518/gcc/config/i386/vaesintrin.h gcc-16-20250525/gcc/config/i386/vaesintrin.h
*** gcc-16-20250518/gcc/config/i386/vaesintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/vaesintrin.h	Sun May 25 22:32:05 2025
*************** _mm256_aesenclast_epi128 (__m256i __A, _
*** 66,74 ****
  #endif /* __DISABLE_VAES__ */
  
  
! #if !defined(__VAES__) || !defined(__AVX512F__) || !defined(__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("vaes,avx512f,evex512")
  #define __DISABLE_VAESF__
  #endif /* __VAES__ */
  
--- 66,74 ----
  #endif /* __DISABLE_VAES__ */
  
  
! #if !defined(__VAES__) || !defined(__AVX512F__)
  #pragma GCC push_options
! #pragma GCC target("vaes,avx512f")
  #define __DISABLE_VAESF__
  #endif /* __VAES__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/i386/vpclmulqdqintrin.h gcc-16-20250525/gcc/config/i386/vpclmulqdqintrin.h
*** gcc-16-20250518/gcc/config/i386/vpclmulqdqintrin.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/i386/vpclmulqdqintrin.h	Sun May 25 22:32:05 2025
***************
*** 28,36 ****
  #ifndef _VPCLMULQDQINTRIN_H_INCLUDED
  #define _VPCLMULQDQINTRIN_H_INCLUDED
  
! #if !defined(__VPCLMULQDQ__) || !defined(__AVX512F__) || !defined(__EVEX512__)
  #pragma GCC push_options
! #pragma GCC target("vpclmulqdq,avx512f,evex512")
  #define __DISABLE_VPCLMULQDQF__
  #endif /* __VPCLMULQDQF__ */
  
--- 28,36 ----
  #ifndef _VPCLMULQDQINTRIN_H_INCLUDED
  #define _VPCLMULQDQINTRIN_H_INCLUDED
  
! #if !defined(__VPCLMULQDQ__) || !defined(__AVX512F__)
  #pragma GCC push_options
! #pragma GCC target("vpclmulqdq,avx512f")
  #define __DISABLE_VPCLMULQDQF__
  #endif /* __VPCLMULQDQF__ */
  
diff -Nrcpad gcc-16-20250518/gcc/config/microblaze/microblaze.cc gcc-16-20250525/gcc/config/microblaze/microblaze.cc
*** gcc-16-20250518/gcc/config/microblaze/microblaze.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/microblaze/microblaze.cc	Sun May 25 22:32:05 2025
*************** section *sdata2_section;
*** 239,244 ****
--- 239,248 ----
  #define TARGET_HAVE_TLS true
  #endif
  
+ /* MicroBlaze does not do speculative execution.  */
+ #undef  TARGET_HAVE_SPECULATION_SAFE_VALUE
+ #define TARGET_HAVE_SPECULATION_SAFE_VALUE speculation_safe_value_not_needed
+ 
  /* Return truth value if a CONST_DOUBLE is ok to be a legitimate constant.  */
  static bool
  microblaze_const_double_ok (rtx op, machine_mode mode)
diff -Nrcpad gcc-16-20250518/gcc/config/nds32/nds32-intrinsic.md gcc-16-20250525/gcc/config/nds32/nds32-intrinsic.md
*** gcc-16-20250518/gcc/config/nds32/nds32-intrinsic.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/nds32/nds32-intrinsic.md	Sun May 25 22:32:05 2025
***************
*** 333,362 ****
    ""
  {
    rtx system_reg = NULL_RTX;
  
    /* Set system register form nds32_intrinsic_register_names[].  */
    if ((INTVAL (operands[1]) >= NDS32_INT_H0)
        && (INTVAL (operands[1]) <= NDS32_INT_H15))
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND__);
!       operands[2] = GEN_INT (31 - INTVAL (operands[1]));
      }
    else if (INTVAL (operands[1]) == NDS32_INT_SWI)
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND__);
!       operands[2] = GEN_INT (15);
      }
    else if ((INTVAL (operands[1]) >= NDS32_INT_H16)
  	   && (INTVAL (operands[1]) <= NDS32_INT_H31))
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND2__);
!       operands[2] = GEN_INT (31 - INTVAL (operands[1]));
      }
    else if ((INTVAL (operands[1]) >= NDS32_INT_H32)
  	   && (INTVAL (operands[1]) <= NDS32_INT_H63))
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND3__);
!       operands[2] = GEN_INT (31 - (INTVAL (operands[1]) - 32));
      }
    else
      error ("%<get_pending_int%> not support %<NDS32_INT_ALZ%>,"
--- 333,363 ----
    ""
  {
    rtx system_reg = NULL_RTX;
+   rtx shift_amt = NULL_RTX;
  
    /* Set system register form nds32_intrinsic_register_names[].  */
    if ((INTVAL (operands[1]) >= NDS32_INT_H0)
        && (INTVAL (operands[1]) <= NDS32_INT_H15))
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND__);
!       shift_amt = GEN_INT (31 - INTVAL (operands[1]));
      }
    else if (INTVAL (operands[1]) == NDS32_INT_SWI)
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND__);
!       shift_amt = GEN_INT (15);
      }
    else if ((INTVAL (operands[1]) >= NDS32_INT_H16)
  	   && (INTVAL (operands[1]) <= NDS32_INT_H31))
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND2__);
!       shift_amt = GEN_INT (31 - INTVAL (operands[1]));
      }
    else if ((INTVAL (operands[1]) >= NDS32_INT_H32)
  	   && (INTVAL (operands[1]) <= NDS32_INT_H63))
      {
        system_reg = GEN_INT (__NDS32_REG_INT_PEND3__);
!       shift_amt = GEN_INT (31 - (INTVAL (operands[1]) - 32));
      }
    else
      error ("%<get_pending_int%> not support %<NDS32_INT_ALZ%>,"
***************
*** 366,372 ****
    if (system_reg != NULL_RTX)
      {
        emit_insn (gen_unspec_volatile_mfsr (operands[0], system_reg));
!       emit_insn (gen_ashlsi3 (operands[0], operands[0], operands[2]));
        emit_insn (gen_lshrsi3 (operands[0], operands[0], GEN_INT (31)));
        emit_insn (gen_unspec_dsb ());
      }
--- 367,373 ----
    if (system_reg != NULL_RTX)
      {
        emit_insn (gen_unspec_volatile_mfsr (operands[0], system_reg));
!       emit_insn (gen_ashlsi3 (operands[0], operands[0], shift_amt));
        emit_insn (gen_lshrsi3 (operands[0], operands[0], GEN_INT (31)));
        emit_insn (gen_unspec_dsb ());
      }
diff -Nrcpad gcc-16-20250518/gcc/config/pa/pa-hpux.h gcc-16-20250525/gcc/config/pa/pa-hpux.h
*** gcc-16-20250518/gcc/config/pa/pa-hpux.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/pa/pa-hpux.h	Sun May 25 22:32:05 2025
*************** along with GCC; see the file COPYING3.
*** 114,116 ****
--- 114,130 ----
  
  #undef TARGET_LIBC_HAS_FUNCTION
  #define TARGET_LIBC_HAS_FUNCTION no_c99_libc_has_function
+ 
+ /* Assume we have libatomic if sync libcalls are disabled.  */
+ #undef TARGET_HAVE_LIBATOMIC
+ #define TARGET_HAVE_LIBATOMIC (!flag_sync_libcalls)
+ 
+ /* The SYNC operations are implemented as library functions, not
+    INSN patterns.  As a result, the HAVE defines for the patterns are
+    not defined.  We need to define them to generate the corresponding
+    __GCC_HAVE_SYNC_COMPARE_AND_SWAP_* and __GCC_ATOMIC_*_LOCK_FREE
+    defines.  */
+ #define HAVE_sync_compare_and_swapqi (flag_sync_libcalls)
+ #define HAVE_sync_compare_and_swaphi (flag_sync_libcalls)
+ #define HAVE_sync_compare_and_swapsi (flag_sync_libcalls)
+ #define HAVE_sync_compare_and_swapdi (flag_sync_libcalls)
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/autovec-opt.md gcc-16-20250525/gcc/config/riscv/autovec-opt.md
*** gcc-16-20250518/gcc/config/riscv/autovec-opt.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/autovec-opt.md	Sun May 25 22:32:05 2025
***************
*** 1691,1715 ****
    "&& 1"
    [(const_int 0)]
    {
!     rtx ops[] = {operands[0], operands[2], operands[1]};
!     riscv_vector::emit_vlmax_insn (code_for_pred_scalar (<CODE>, <MODE>mode),
! 				   riscv_vector::BINARY_OP, ops);
    }
    [(set_attr "type" "vialu")])
  
  (define_insn_and_split "*<optab>_vx_<mode>"
   [(set (match_operand:V_VLSI    0 "register_operand")
         (any_int_binop_no_shift_vx:V_VLSI
! 	 (match_operand:V_VLSI  2 "<binop_rhs2_predicate>")
  	 (vec_duplicate:V_VLSI
! 	   (match_operand:<VEL> 1 "register_operand"))))]
    "TARGET_VECTOR && can_create_pseudo_p ()"
    "#"
    "&& 1"
    [(const_int 0)]
    {
!     rtx ops[] = {operands[0], operands[2], operands[1]};
!     riscv_vector::emit_vlmax_insn (code_for_pred_scalar (<CODE>, <MODE>mode),
! 				   riscv_vector::BINARY_OP, ops);
    }
    [(set_attr "type" "vialu")])
--- 1691,1715 ----
    "&& 1"
    [(const_int 0)]
    {
!     riscv_vector::expand_vx_binary_vec_dup_vec (operands[0], operands[2],
! 						operands[1], <CODE>,
! 						<MODE>mode);
    }
    [(set_attr "type" "vialu")])
  
  (define_insn_and_split "*<optab>_vx_<mode>"
   [(set (match_operand:V_VLSI    0 "register_operand")
         (any_int_binop_no_shift_vx:V_VLSI
! 	 (match_operand:V_VLSI  1 "<binop_rhs2_predicate>")
  	 (vec_duplicate:V_VLSI
! 	   (match_operand:<VEL> 2 "register_operand"))))]
    "TARGET_VECTOR && can_create_pseudo_p ()"
    "#"
    "&& 1"
    [(const_int 0)]
    {
!     riscv_vector::expand_vx_binary_vec_vec_dup (operands[0], operands[1],
! 						operands[2], <CODE>,
! 						<MODE>mode);
    }
    [(set_attr "type" "vialu")])
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/bitmanip.md gcc-16-20250525/gcc/config/riscv/bitmanip.md
*** gcc-16-20250518/gcc/config/riscv/bitmanip.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/bitmanip.md	Sun May 25 22:32:05 2025
***************
*** 1,4 ****
! ;; Machine description for RISC-V Bit Manipulation operations.
  ;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
  
  ;; This file is part of GCC.
--- 1,4 ----
! ;); Machine description for RISC-V Bit Manipulation operations.
  ;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
  
  ;; This file is part of GCC.
***************
*** 68,90 ****
    [(set (match_operand:DI 0 "register_operand")
  	(zero_extend:DI (plus:SI (ashift:SI (subreg:SI (match_operand:DI 1 "register_operand") 0)
  						       (match_operand:QI 2 "imm123_operand"))
! 				 (subreg:SI (match_operand:DI 3 "register_operand") 0))))]
    "TARGET_64BIT && TARGET_ZBA"
!   [(set (match_dup 0) (plus:DI (ashift:DI (match_dup 1) (match_dup 2)) (match_dup 3)))
!    (set (match_dup 0) (zero_extend:DI (subreg:SI (match_dup 0) 0)))])
  
  (define_split
    [(set (match_operand:DI 0 "register_operand")
  	(zero_extend:DI (plus:SI (subreg:SI (and:DI (ashift:DI (match_operand:DI 1 "register_operand")
  							       (match_operand:QI 2 "imm123_operand"))
  						    (match_operand:DI 3 "consecutive_bits_operand")) 0)
! 				 (subreg:SI (match_operand:DI 4 "register_operand") 0))))]
    "TARGET_64BIT && TARGET_ZBA
     && riscv_shamt_matches_mask_p (INTVAL (operands[2]), INTVAL (operands[3]))
     /* Ensure the mask includes all the bits in SImode.  */
     && ((INTVAL (operands[3]) & (HOST_WIDE_INT_1U << 31)) != 0)"
!   [(set (match_dup 0) (plus:DI (ashift:DI (match_dup 1) (match_dup 2)) (match_dup 4)))
!    (set (match_dup 0) (zero_extend:DI (subreg:SI (match_dup 0) 0)))])
  
  ; Make sure that an andi followed by a sh[123]add remains a two instruction
  ; sequence--and is not torn apart into slli, slri, add.
--- 68,92 ----
    [(set (match_operand:DI 0 "register_operand")
  	(zero_extend:DI (plus:SI (ashift:SI (subreg:SI (match_operand:DI 1 "register_operand") 0)
  						       (match_operand:QI 2 "imm123_operand"))
! 				 (subreg:SI (match_operand:DI 3 "register_operand") 0))))
!    (clobber (match_operand:DI 4 "register_operand"))]
    "TARGET_64BIT && TARGET_ZBA"
!   [(set (match_dup 4) (plus:DI (ashift:DI (match_dup 1) (match_dup 2)) (match_dup 3)))
!    (set (match_dup 0) (zero_extend:DI (subreg:SI (match_dup 4) 0)))])
  
  (define_split
    [(set (match_operand:DI 0 "register_operand")
  	(zero_extend:DI (plus:SI (subreg:SI (and:DI (ashift:DI (match_operand:DI 1 "register_operand")
  							       (match_operand:QI 2 "imm123_operand"))
  						    (match_operand:DI 3 "consecutive_bits_operand")) 0)
! 				 (subreg:SI (match_operand:DI 4 "register_operand") 0))))
!    (clobber (match_operand:DI 5 "register_operand"))]
    "TARGET_64BIT && TARGET_ZBA
     && riscv_shamt_matches_mask_p (INTVAL (operands[2]), INTVAL (operands[3]))
     /* Ensure the mask includes all the bits in SImode.  */
     && ((INTVAL (operands[3]) & (HOST_WIDE_INT_1U << 31)) != 0)"
!   [(set (match_dup 5) (plus:DI (ashift:DI (match_dup 1) (match_dup 2)) (match_dup 4)))
!    (set (match_dup 0) (zero_extend:DI (subreg:SI (match_dup 5) 0)))])
  
  ; Make sure that an andi followed by a sh[123]add remains a two instruction
  ; sequence--and is not torn apart into slli, slri, add.
***************
*** 195,207 ****
  					     (match_operand:QI 2 "imm123_operand"))
  				  (match_operand 3 "consecutive_bits32_operand"))
  			  (match_operand:DI 4 "register_operand"))
! 		 (match_operand 5 "immediate_operand")))]
    "TARGET_64BIT && TARGET_ZBA"
!   [(set (match_dup 0)
  	(plus:DI (and:DI (ashift:DI (match_dup 1) (match_dup 2))
  			 (match_dup 3))
  		 (match_dup 4)))
!    (set (match_dup 0) (plus:DI (match_dup 0) (match_dup 5)))])
  
  ;; ZBB extension.
  
--- 197,210 ----
  					     (match_operand:QI 2 "imm123_operand"))
  				  (match_operand 3 "consecutive_bits32_operand"))
  			  (match_operand:DI 4 "register_operand"))
! 		 (match_operand 5 "immediate_operand")))
!    (clobber (match_operand:DI 6 "register_operand"))]
    "TARGET_64BIT && TARGET_ZBA"
!   [(set (match_dup 6)
  	(plus:DI (and:DI (ashift:DI (match_dup 1) (match_dup 2))
  			 (match_dup 3))
  		 (match_dup 4)))
!    (set (match_dup 0) (plus:DI (match_dup 6) (match_dup 5)))])
  
  ;; ZBB extension.
  
***************
*** 846,863 ****
  (define_insn_and_split "*bclri<mode>_nottwobits"
    [(set (match_operand:X 0 "register_operand" "=r")
  	(and:X (match_operand:X 1 "register_operand" "r")
! 	       (match_operand:X 2 "const_nottwobits_not_arith_operand" "i")))]
    "TARGET_ZBS && !paradoxical_subreg_p (operands[1])"
    "#"
    "&& reload_completed"
!   [(set (match_dup 0) (and:X (match_dup 1) (match_dup 3)))
!    (set (match_dup 0) (and:X (match_dup 0) (match_dup 4)))]
  {
! 	unsigned HOST_WIDE_INT bits = ~UINTVAL (operands[2]);
! 	unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (bits);
  
! 	operands[3] = GEN_INT (~bits | topbit);
! 	operands[4] = GEN_INT (~topbit);
  }
  [(set_attr "type" "bitmanip")])
  
--- 849,867 ----
  (define_insn_and_split "*bclri<mode>_nottwobits"
    [(set (match_operand:X 0 "register_operand" "=r")
  	(and:X (match_operand:X 1 "register_operand" "r")
! 	       (match_operand:X 2 "const_nottwobits_not_arith_operand" "i")))
!    (clobber (match_scratch:X 3 "=&r"))]
    "TARGET_ZBS && !paradoxical_subreg_p (operands[1])"
    "#"
    "&& reload_completed"
!   [(set (match_dup 3) (and:X (match_dup 1) (match_dup 4)))
!    (set (match_dup 0) (and:X (match_dup 3) (match_dup 5)))]
  {
!   unsigned HOST_WIDE_INT bits = ~UINTVAL (operands[2]);
!   unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (bits);
  
!   operands[4] = GEN_INT (~bits | topbit);
!   operands[5] = GEN_INT (~topbit);
  }
  [(set_attr "type" "bitmanip")])
  
***************
*** 866,884 ****
  (define_insn_and_split "*bclridisi_nottwobits"
    [(set (match_operand:DI 0 "register_operand" "=r")
  	(and:DI (match_operand:DI 1 "register_operand" "r")
! 		(match_operand:DI 2 "const_nottwobits_not_arith_operand" "i")))]
    "TARGET_64BIT && TARGET_ZBS
     && clz_hwi (~UINTVAL (operands[2])) > 33"
    "#"
    "&& reload_completed"
!   [(set (match_dup 0) (and:DI (match_dup 1) (match_dup 3)))
!    (set (match_dup 0) (and:DI (match_dup 0) (match_dup 4)))]
  {
! 	unsigned HOST_WIDE_INT bits = ~UINTVAL (operands[2]);
! 	unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (bits);
  
! 	operands[3] = GEN_INT (~bits | topbit);
! 	operands[4] = GEN_INT (~topbit);
  }
  [(set_attr "type" "bitmanip")])
  
--- 870,889 ----
  (define_insn_and_split "*bclridisi_nottwobits"
    [(set (match_operand:DI 0 "register_operand" "=r")
  	(and:DI (match_operand:DI 1 "register_operand" "r")
! 		(match_operand:DI 2 "const_nottwobits_not_arith_operand" "i")))
!    (clobber (match_scratch:DI 3 "=&r"))]
    "TARGET_64BIT && TARGET_ZBS
     && clz_hwi (~UINTVAL (operands[2])) > 33"
    "#"
    "&& reload_completed"
!   [(set (match_dup 3) (and:DI (match_dup 1) (match_dup 4)))
!    (set (match_dup 0) (and:DI (match_dup 3) (match_dup 5)))]
  {
!   unsigned HOST_WIDE_INT bits = ~UINTVAL (operands[2]);
!   unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (bits);
  
!   operands[4] = GEN_INT (~bits | topbit);
!   operands[5] = GEN_INT (~topbit);
  }
  [(set_attr "type" "bitmanip")])
  
***************
*** 1011,1022 ****
    [(set (match_operand:X 0 "register_operand")
  	(and:X (not:X (lshiftrt:X (match_operand:X 1 "register_operand")
  				  (match_operand:QI 2 "register_operand")))
! 	       (const_int 1)))]
    "TARGET_ZBS"
!   [(set (match_dup 0) (zero_extract:X (match_dup 1)
  				      (const_int 1)
  				      (match_dup 2)))
!    (set (match_dup 0) (xor:X (match_dup 0) (const_int 1)))]
    "operands[2] = gen_lowpart (<MODE>mode, operands[2]);")
  
  ;; We can create a polarity-reversed mask (i.e. bit N -> { set = 0, clear = -1 })
--- 1016,1028 ----
    [(set (match_operand:X 0 "register_operand")
  	(and:X (not:X (lshiftrt:X (match_operand:X 1 "register_operand")
  				  (match_operand:QI 2 "register_operand")))
! 	       (const_int 1)))
!    (clobber (match_operand:X 3 "register_operand"))]
    "TARGET_ZBS"
!   [(set (match_dup 3) (zero_extract:X (match_dup 1)
  				      (const_int 1)
  				      (match_dup 2)))
!    (set (match_dup 0) (xor:X (match_dup 3) (const_int 1)))]
    "operands[2] = gen_lowpart (<MODE>mode, operands[2]);")
  
  ;; We can create a polarity-reversed mask (i.e. bit N -> { set = 0, clear = -1 })
***************
*** 1027,1054 ****
         (neg:GPR (eq:GPR (zero_extract:GPR (match_operand:GPR 1 "register_operand")
                                            (const_int 1)
                                            (match_operand 2))
!                         (const_int 0))))]
    "TARGET_ZBS"
!   [(set (match_dup 0) (zero_extract:GPR (match_dup 1) (const_int 1) (match_dup 2)))
!    (set (match_dup 0) (plus:GPR (match_dup 0) (const_int -1)))])
  
  ;; Catch those cases where we can use a bseti/binvi + ori/xori or
  ;; bseti/binvi + bseti/binvi instead of a lui + addi + or/xor sequence.
  (define_insn_and_split "*<or_optab>i<mode>_extrabit"
    [(set (match_operand:X 0 "register_operand" "=r")
  	(any_or:X (match_operand:X 1 "register_operand" "r")
! 	          (match_operand:X 2 "uimm_extra_bit_or_twobits" "i")))]
    "TARGET_ZBS && !single_bit_mask_operand (operands[2], VOIDmode)"
    "#"
    "&& reload_completed"
!   [(set (match_dup 0) (<or_optab>:X (match_dup 1) (match_dup 3)))
!    (set (match_dup 0) (<or_optab>:X (match_dup 0) (match_dup 4)))]
  {
    unsigned HOST_WIDE_INT bits = UINTVAL (operands[2]);
    unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (bits);
  
!   operands[3] = GEN_INT (bits &~ topbit);
!   operands[4] = GEN_INT (topbit);
  }
  [(set_attr "type" "bitmanip")])
  
--- 1033,1062 ----
         (neg:GPR (eq:GPR (zero_extract:GPR (match_operand:GPR 1 "register_operand")
                                            (const_int 1)
                                            (match_operand 2))
! 			(const_int 0))))
!    (clobber (match_operand:X 3 "register_operand"))]
    "TARGET_ZBS"
!   [(set (match_dup 3) (zero_extract:GPR (match_dup 1) (const_int 1) (match_dup 2)))
!    (set (match_dup 0) (plus:GPR (match_dup 3) (const_int -1)))])
  
  ;; Catch those cases where we can use a bseti/binvi + ori/xori or
  ;; bseti/binvi + bseti/binvi instead of a lui + addi + or/xor sequence.
  (define_insn_and_split "*<or_optab>i<mode>_extrabit"
    [(set (match_operand:X 0 "register_operand" "=r")
  	(any_or:X (match_operand:X 1 "register_operand" "r")
! 		  (match_operand:X 2 "uimm_extra_bit_or_twobits" "i")))
!    (clobber (match_scratch:X 3 "=&r"))]
    "TARGET_ZBS && !single_bit_mask_operand (operands[2], VOIDmode)"
    "#"
    "&& reload_completed"
!   [(set (match_dup 3) (<or_optab>:X (match_dup 1) (match_dup 4)))
!    (set (match_dup 0) (<or_optab>:X (match_dup 3) (match_dup 5)))]
  {
    unsigned HOST_WIDE_INT bits = UINTVAL (operands[2]);
    unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (bits);
  
!   operands[4] = GEN_INT (bits &~ topbit);
!   operands[5] = GEN_INT (topbit);
  }
  [(set_attr "type" "bitmanip")])
  
***************
*** 1056,1073 ****
  (define_insn_and_split "*andi<mode>_extrabit"
    [(set (match_operand:X 0 "register_operand" "=r")
  	(and:X (match_operand:X 1 "register_operand" "r")
! 	       (match_operand:X 2 "not_uimm_extra_bit_or_nottwobits" "i")))]
    "TARGET_ZBS && !not_single_bit_mask_operand (operands[2], VOIDmode)"
    "#"
    "&& reload_completed"
!   [(set (match_dup 0) (and:X (match_dup 1) (match_dup 3)))
!    (set (match_dup 0) (and:X (match_dup 0) (match_dup 4)))]
  {
    unsigned HOST_WIDE_INT bits = UINTVAL (operands[2]);
    unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (~bits);
  
!   operands[3] = GEN_INT (bits | topbit);
!   operands[4] = GEN_INT (~topbit);
  }
  [(set_attr "type" "bitmanip")])
  
--- 1064,1082 ----
  (define_insn_and_split "*andi<mode>_extrabit"
    [(set (match_operand:X 0 "register_operand" "=r")
  	(and:X (match_operand:X 1 "register_operand" "r")
! 	       (match_operand:X 2 "not_uimm_extra_bit_or_nottwobits" "i")))
!    (clobber (match_scratch:X 3 "=&r"))]
    "TARGET_ZBS && !not_single_bit_mask_operand (operands[2], VOIDmode)"
    "#"
    "&& reload_completed"
!   [(set (match_dup 3) (and:X (match_dup 1) (match_dup 4)))
!    (set (match_dup 0) (and:X (match_dup 3) (match_dup 5)))]
  {
    unsigned HOST_WIDE_INT bits = UINTVAL (operands[2]);
    unsigned HOST_WIDE_INT topbit = HOST_WIDE_INT_1U << floor_log2 (~bits);
  
!   operands[4] = GEN_INT (bits | topbit);
!   operands[5] = GEN_INT (~topbit);
  }
  [(set_attr "type" "bitmanip")])
  
***************
*** 1337,1368 ****
    "bext\t%0,%1,%2"
    [(set_attr "type" "bitmanip")])
  
- 
- ;; Single bit extraction by first shifting it into the sign bit, then
- ;; shifting it down to the low bit.
- (define_insn "*bext<mode>_position_masked"
-   [(set (match_operand:X 0 "register_operand" "=r")
- 	(lshiftrt:X (ashift:X (match_operand:X 1 "register_operand" "r")
- 			      (match_operand:QI 2 "register_operand" "r"))
- 		    (match_operand:X 3 "bitpos_mask_operand" "n")))]
-   "TARGET_ZBS"
-   "bext\t%0,%1,%2"
-   [(set_attr "type" "bitmanip")])
- 
- ;; Single bit extraction by shifting into the low bit, but with the
- ;; position formed with a subreg of a mask.
- (define_insn "*bext<mode>_position_masked_subreg"
-   [(set (match_operand:X 0 "register_operand" "=r")
- 	(lshiftrt:X
- 	 (ashift:X (match_operand:X 1 "register_operand" "r")
- 		   (subreg:QI
- 		    (and:X (match_operand:X 2 "register_operand" "r")
- 			   (match_operand:X 3 "bitpos_mask_operand" "n")) 0))
- 	 (match_operand:X 4 "bitpos_mask_operand" "n")))]
-   "TARGET_ZBS"
-   "bext\t%0,%1,%2"
-   [(set_attr "type" "bitmanip")])
- 
  ;; This has shown up in testing.  In particular we end up with an
  ;; immediate input.  We can load that into a register and target
  ;; one of the above bext patterns.
--- 1346,1351 ----
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/constraints.md gcc-16-20250525/gcc/config/riscv/constraints.md
*** gcc-16-20250518/gcc/config/riscv/constraints.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/constraints.md	Sun May 25 22:32:05 2025
***************
*** 43,48 ****
--- 43,52 ----
  (define_register_constraint "cf" "TARGET_HARD_FLOAT ? RVC_FP_REGS : (TARGET_ZFINX ? RVC_GR_REGS : NO_REGS)"
    "RVC floating-point registers (f8-f15), if available, reuse GPR as FPR when use zfinx.")
  
+ (define_register_constraint "cR" "RVC_GR_REGS"
+   "Even-odd RVC general purpose register (x8-x15)."
+   "regno % 2 == 0")
+ 
  ;; General constraints
  
  (define_constraint "I"
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/gen-riscv-ext-texi.cc gcc-16-20250525/gcc/config/riscv/gen-riscv-ext-texi.cc
*** gcc-16-20250518/gcc/config/riscv/gen-riscv-ext-texi.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/gen-riscv-ext-texi.cc	Sun May 25 22:32:05 2025
***************
*** 6,27 ****
  
  struct version_t
  {
!   int major;
!   int minor;
    version_t (int major, int minor,
  	     enum riscv_isa_spec_class spec = ISA_SPEC_CLASS_NONE)
!     : major (major), minor (minor)
    {}
    bool operator<(const version_t &other) const
    {
!     if (major != other.major)
!       return major < other.major;
!     return minor < other.minor;
    }
  
    bool operator== (const version_t &other) const
    {
!     return major == other.major && minor == other.minor;
    }
  };
  
--- 6,27 ----
  
  struct version_t
  {
!   int major_version;
!   int minor_version;
    version_t (int major, int minor,
  	     enum riscv_isa_spec_class spec = ISA_SPEC_CLASS_NONE)
!     : major_version (major), minor_version (minor)
    {}
    bool operator<(const version_t &other) const
    {
!     if (major_version != other.major_version)
!       return major_version < other.major_version;
!     return minor_version < other.minor_version;
    }
  
    bool operator== (const version_t &other) const
    {
!     return major_version == other.major_version && minor_version == other.minor_version;
    }
  };
  
*************** print_ext_doc_entry (const std::string &
*** 39,45 ****
    printf ("@tab");
    for (const auto &version : unique_versions)
      {
!       printf (" %d.%d", version.major, version.minor);
      }
    printf ("\n");
    printf ("@tab %s", full_name.c_str ());
--- 39,45 ----
    printf ("@tab");
    for (const auto &version : unique_versions)
      {
!       printf (" %d.%d", version.major_version, version.minor_version);
      }
    printf ("\n");
    printf ("@tab %s", full_name.c_str ());
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/mips-p8700.md gcc-16-20250525/gcc/config/riscv/mips-p8700.md
*** gcc-16-20250518/gcc/config/riscv/mips-p8700.md	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/config/riscv/mips-p8700.md	Sun May 25 22:32:05 2025
***************
*** 0 ****
--- 1,167 ----
+ ;; DFA-based pipeline description for MIPS P8700.
+ ;;
+ ;; Copyright (C) 2025 Free Software Foundation, Inc.
+ ;;
+ ;; This file is part of GCC.
+ ;;
+ ;; GCC is free software; you can redistribute it and/or modify it
+ ;; under the terms of the GNU General Public License as published
+ ;; by the Free Software Foundation; either version 3, or (at your
+ ;; option) any later version.
+ 
+ ;; GCC is distributed in the hope that it will be useful, but WITHOUT
+ ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ ;; License for more details.
+ 
+ ;; You should have received a copy of the GNU General Public License
+ ;; along with GCC; see the file COPYING3.  If not see
+ ;; <http://www.gnu.org/licenses/>.
+ 
+ (define_automaton "mips_p8700_agen_alq_pipe, mips_p8700_mdu_pipe, mips_p8700_fpu_pipe")
+ 
+ ;; The address generation queue (AGQ) has AL2, CTISTD and LDSTA pipes
+ (define_cpu_unit "mips_p8700_agq, mips_p8700_al2, mips_p8700_ctistd, mips_p8700_lsu"
+ 		 "mips_p8700_agen_alq_pipe")
+ 
+ (define_cpu_unit "mips_p8700_gpmul, mips_p8700_gpdiv" "mips_p8700_mdu_pipe")
+ 
+ ;; The arithmetic-logic-unit queue (ALQ) has ALU pipe
+ (define_cpu_unit "mips_p8700_alq, mips_p8700_alu" "mips_p8700_agen_alq_pipe")
+ 
+ ;; The floating-point-unit queue (FPQ) has short and long pipes
+ (define_cpu_unit "mips_p8700_fpu_short, mips_p8700_fpu_long" "mips_p8700_fpu_pipe")
+ 
+ ;; Long FPU pipeline.
+ (define_cpu_unit "mips_p8700_fpu_apu" "mips_p8700_fpu_pipe")
+ 
+ ;; P8700 unsupported insns are mapped to dummies reservations
+ (define_reservation "mips_p8700_dummies"
+  "mips_p8700_agq |  mips_p8700_al2 |  mips_p8700_ctistd |  mips_p8700_lsu |
+  mips_p8700_fpu_short |  mips_p8700_fpu_long")
+ 
+ (define_reservation "mips_p8700_agq_al2" "mips_p8700_agq, mips_p8700_al2")
+ (define_reservation "mips_p8700_agq_ctistd" "mips_p8700_agq, mips_p8700_ctistd")
+ (define_reservation "mips_p8700_agq_lsu" "mips_p8700_agq, mips_p8700_lsu")
+ (define_reservation "mips_p8700_alq_alu" "mips_p8700_alq, mips_p8700_alu")
+ 
+ ;;
+ ;; FPU pipe
+ ;;
+ 
+ (define_insn_reservation "mips_p8700_fpu_fadd" 4
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fadd"))
+   "mips_p8700_fpu_long, mips_p8700_fpu_apu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fabs" 2
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fcmp,fmove"))
+   "mips_p8700_fpu_short, mips_p8700_fpu_apu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fload" 8
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fpload"))
+   "mips_p8700_agq_lsu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fstore" 1
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fpstore"))
+   "mips_p8700_agq_lsu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fmadd" 8
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fmadd"))
+   "mips_p8700_fpu_long, mips_p8700_fpu_apu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fmul" 5
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fmul"))
+   "mips_p8700_fpu_long, mips_p8700_fpu_apu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_div" 17
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fdiv,fsqrt"))
+   "mips_p8700_fpu_long, mips_p8700_fpu_apu*17")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fcvt" 4
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "fcvt,fcvt_i2f,fcvt_f2i"))
+   "mips_p8700_fpu_long, mips_p8700_fpu_apu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fmtc" 7
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "mtc"))
+   "mips_p8700_agq_lsu")
+ 
+ (define_insn_reservation "mips_p8700_fpu_fmfc" 7
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "mfc"))
+   "mips_p8700_agq_lsu")
+ 
+ ;;
+ ;; Integer pipe
+ ;;
+ 
+ (define_insn_reservation "mips_p8700_int_load" 4
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "load"))
+   "mips_p8700_agq_lsu")
+ 
+ (define_insn_reservation "mips_p8700_int_store" 3
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "store"))
+   "mips_p8700_agq_lsu")
+ 
+ (define_insn_reservation "mips_p8700_int_arith_1" 1
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "unknown,const,arith,shift,slt,multi,auipc,logical,move,bitmanip,min,max,minu,maxu,clz,ctz,rotate,atomic,condmove,crypto,mvpair,zicond"))
+   "mips_p8700_alq_alu | mips_p8700_agq_al2")
+ 
+ (define_insn_reservation "mips_p8700_int_nop" 0
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "nop"))
+   "mips_p8700_alq_alu | mips_p8700_agq_al2")
+ 
+ (define_insn_reservation "mips_p8700_dsp_mult" 4
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "imul,cpop,clmul"))
+   "mips_p8700_gpmul")
+ 
+ (define_insn_reservation "mips_p8700_int_div" 8
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "idiv"))
+   "mips_p8700_gpdiv*5")
+ 
+ (define_insn_reservation "mips_p8700_int_branch" 1
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "branch,jump,ret,sfb_alu,trap"))
+   "mips_p8700_agq_ctistd")
+ 
+ (define_insn_reservation "mips_p8700_int_call" 2
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "call,jalr"))
+   "mips_p8700_agq_ctistd")
+ 
+ ;; mips-p8700 dummies insn and placeholder that had no mapping to p8700 hardware.
+ (define_insn_reservation "mips_p8700_unknown" 1
+   (and (eq_attr "tune" "mips_p8700")
+        (eq_attr "type" "rdvlenb,rdvl,wrvxrm,wrfrm,
+    rdfrm,vsetvl,vsetvl_pre,vlde,vste,vldm,vstm,vlds,vsts,
+    vldux,vldox,vstux,vstox,vldff,vldr,vstr,
+    vlsegde,vssegte,vlsegds,vssegts,vlsegdux,vlsegdox,vssegtux,vssegtox,vlsegdff,
+    vialu,viwalu,vext,vicalu,vshift,vnshift,vicmp,viminmax,
+    vimul,vidiv,viwmul,vimuladd,sf_vqmacc,viwmuladd,vimerge,vimov,
+    vsalu,vaalu,vsmul,vsshift,vnclip,sf_vfnrclip,
+    vfalu,vfwalu,vfmul,vfdiv,vfwmul,vfmuladd,vfwmuladd,vfsqrt,vfrecp,
+    vfcmp,vfminmax,vfsgnj,vfclass,vfmerge,vfmov,
+    vfcvtitof,vfcvtftoi,vfwcvtitof,vfwcvtftoi,
+    vfwcvtftof,vfncvtitof,vfncvtftoi,vfncvtftof,
+    vired,viwred,vfredu,vfredo,vfwredu,vfwredo,
+    vmalu,vmpop,vmffs,vmsfs,vmiota,vmidx,vimovvx,vimovxv,vfmovvf,vfmovfv,
+    vslideup,vslidedown,vislide1up,vislide1down,vfslide1up,vfslide1down,
+    vgather,vcompress,vmov,vector,vandn,vbrev,vbrev8,vrev8,vclz,vctz,vcpop,vrol,vror,vwsll,
+    vclmul,vclmulh,vghsh,vgmul,vaesef,vaesem,vaesdf,vaesdm,vaeskf1,vaeskf2,vaesz,
+    vsha2ms,vsha2ch,vsha2cl,vsm4k,vsm4r,vsm3me,vsm3c,vfncvtbf16,vfwcvtbf16,vfwmaccbf16,
+    sf_vc,sf_vc_se"))
+   "mips_p8700_dummies")
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv-cores.def gcc-16-20250525/gcc/config/riscv/riscv-cores.def
*** gcc-16-20250518/gcc/config/riscv/riscv-cores.def	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv-cores.def	Sun May 25 22:32:05 2025
*************** RISCV_TUNE("xt-c920v2", generic, generic
*** 50,55 ****
--- 50,56 ----
  RISCV_TUNE("xiangshan-nanhu", xiangshan, xiangshan_nanhu_tune_info)
  RISCV_TUNE("generic-ooo", generic_ooo, generic_ooo_tune_info)
  RISCV_TUNE("size", generic, optimize_size_tune_info)
+ RISCV_TUNE("mips-p8700", mips_p8700, mips_p8700_tune_info)
  
  #undef RISCV_TUNE
  
*************** RISCV_CORE("xiangshan-nanhu",      "rv64
*** 152,155 ****
--- 153,160 ----
  			      "zbkb_zbkc_zbkx_zknd_zkne_zknh_zksed_zksh_"
  			      "svinval_zicbom_zicboz",
  			      "xiangshan-nanhu")
+ 
+ RISCV_CORE("mips-p8700",     	"rv64imafd_zicsr_zmmul_"
+ 			      "zaamo_zalrsc_zba_zbb",
+ 			      "mips-p8700")
  #undef RISCV_CORE
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv-opts.h gcc-16-20250525/gcc/config/riscv/riscv-opts.h
*** gcc-16-20250518/gcc/config/riscv/riscv-opts.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv-opts.h	Sun May 25 22:32:05 2025
*************** enum riscv_microarchitecture_type {
*** 58,64 ****
    sifive_p400,
    sifive_p600,
    xiangshan,
!   generic_ooo
  };
  extern enum riscv_microarchitecture_type riscv_microarchitecture;
  
--- 58,65 ----
    sifive_p400,
    sifive_p600,
    xiangshan,
!   generic_ooo,
!   mips_p8700,
  };
  extern enum riscv_microarchitecture_type riscv_microarchitecture;
  
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv-protos.h gcc-16-20250525/gcc/config/riscv/riscv-protos.h
*** gcc-16-20250518/gcc/config/riscv/riscv-protos.h	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv-protos.h	Sun May 25 22:32:05 2025
*************** extern void riscv_expand_ustrunc (rtx, r
*** 141,146 ****
--- 141,147 ----
  extern void riscv_expand_sstrunc (rtx, rtx);
  extern int riscv_register_move_cost (machine_mode, reg_class_t, reg_class_t);
  extern bool synthesize_ior_xor (rtx_code, rtx [3]);
+ extern bool synthesize_and (rtx [3]);
  
  #ifdef RTX_CODE
  extern void riscv_expand_int_scc (rtx, enum rtx_code, rtx, rtx, bool *invert_ptr = 0);
*************** void expand_vec_oct_ustrunc (rtx, rtx, m
*** 667,672 ****
--- 668,675 ----
  			     machine_mode);
  void expand_vec_oct_sstrunc (rtx, rtx, machine_mode, machine_mode,
  			     machine_mode);
+ void expand_vx_binary_vec_dup_vec (rtx, rtx, rtx, rtx_code, machine_mode);
+ void expand_vx_binary_vec_vec_dup (rtx, rtx, rtx, rtx_code, machine_mode);
  #endif
  bool sew64_scalar_helper (rtx *, rtx *, rtx, machine_mode,
  			  bool, void (*)(rtx *, rtx), enum avl_type);
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv-v.cc gcc-16-20250525/gcc/config/riscv/riscv-v.cc
*** gcc-16-20250518/gcc/config/riscv/riscv-v.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv-v.cc	Sun May 25 22:32:05 2025
*************** autovectorize_vector_modes (vector_modes
*** 2821,2826 ****
--- 2821,2848 ----
  	i++;
  	size = base_size / (1U << i);
       }
+ 
+   /* If the user specified the exact mode to use look if it is available and
+      remove all other ones before returning.  */
+   if (riscv_autovec_mode)
+     {
+       auto_vector_modes ms;
+       ms.safe_splice (*modes);
+       modes->truncate (0);
+ 
+       for (machine_mode mode : ms)
+ 	{
+ 	  if (!strcmp (GET_MODE_NAME (mode), riscv_autovec_mode))
+ 	    {
+ 	      modes->safe_push (mode);
+ 	      return 0;
+ 	    }
+ 	}
+ 
+       /* Nothing found, fall back to regular handling.  */
+       modes->safe_splice (ms);
+     }
+ 
    /* Enable LOOP_VINFO comparison in COST model.  */
    return VECT_COMPARE_COSTS;
  }
*************** expand_vec_oct_sstrunc (rtx op_0, rtx op
*** 5498,5503 ****
--- 5520,5578 ----
    expand_vec_double_sstrunc (op_0, quad_rtx, quad_mode);
  }
  
+ /* Expand the binary vx combine with the format like v2 = vop(vec_dup(x), v1).
+    Aka the first op comes from the vec_duplicate, and the second op is
+    the vector reg.  */
+ 
+ void
+ expand_vx_binary_vec_dup_vec (rtx op_0, rtx op_1, rtx op_2,
+ 			      rtx_code code, machine_mode mode)
+ {
+   enum insn_code icode;
+ 
+   switch (code)
+     {
+     case PLUS:
+     case AND:
+     case IOR:
+       icode = code_for_pred_scalar (code, mode);
+       break;
+     case MINUS:
+       icode = code_for_pred_sub_reverse_scalar (mode);
+       break;
+     default:
+       gcc_unreachable ();
+     }
+ 
+   rtx ops[] = {op_0, op_1, op_2};
+   emit_vlmax_insn (icode, riscv_vector::BINARY_OP, ops);
+ }
+ 
+ /* Expand the binary vx combine with the format like v2 = vop(v1, vec_dup(x)).
+    Aka the second op comes from the vec_duplicate, and the first op is
+    the vector reg.  */
+ 
+ void
+ expand_vx_binary_vec_vec_dup (rtx op_0, rtx op_1, rtx op_2,
+ 			      rtx_code code, machine_mode mode)
+ {
+   enum insn_code icode;
+ 
+   switch (code)
+     {
+     case MINUS:
+     case AND:
+     case IOR:
+       icode = code_for_pred_scalar (code, mode);
+       break;
+     default:
+       gcc_unreachable ();
+     }
+ 
+   rtx ops[] = {op_0, op_1, op_2};
+   emit_vlmax_insn (icode, riscv_vector::BINARY_OP, ops);
+ }
+ 
  /* Vectorize popcount by the Wilkes-Wheeler-Gill algorithm that libgcc uses as
     well.  */
  void
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv-vector-costs.cc gcc-16-20250525/gcc/config/riscv/riscv-vector-costs.cc
*** gcc-16-20250518/gcc/config/riscv/riscv-vector-costs.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv-vector-costs.cc	Sun May 25 22:32:05 2025
*************** compute_local_program_points (
*** 205,213 ****
  	      if (!is_gimple_assign_or_call (gsi_stmt (si)))
  		continue;
  	      stmt_vec_info stmt_info = vinfo->lookup_stmt (gsi_stmt (si));
! 	      enum stmt_vec_info_type type
! 		= STMT_VINFO_TYPE (vect_stmt_to_vectorize (stmt_info));
! 	      if (type != undef_vec_info_type)
  		{
  		  stmt_point info = {point, gsi_stmt (si), stmt_info};
  		  program_points.safe_push (info);
--- 205,211 ----
  	      if (!is_gimple_assign_or_call (gsi_stmt (si)))
  		continue;
  	      stmt_vec_info stmt_info = vinfo->lookup_stmt (gsi_stmt (si));
! 	      if (STMT_VINFO_RELEVANT_P (stmt_info))
  		{
  		  stmt_point info = {point, gsi_stmt (si), stmt_info};
  		  program_points.safe_push (info);
*************** compute_estimated_lmul (loop_vec_info lo
*** 626,632 ****
    int regno_alignment = riscv_get_v_regno_alignment (loop_vinfo->vector_mode);
    if (riscv_v_ext_vls_mode_p (loop_vinfo->vector_mode))
      return regno_alignment;
!   else if (known_eq (LOOP_VINFO_SLP_UNROLLING_FACTOR (loop_vinfo), 1U))
      {
        int estimated_vf = vect_vf_for_cost (loop_vinfo);
        int estimated_lmul = estimated_vf * GET_MODE_BITSIZE (mode).to_constant ()
--- 624,630 ----
    int regno_alignment = riscv_get_v_regno_alignment (loop_vinfo->vector_mode);
    if (riscv_v_ext_vls_mode_p (loop_vinfo->vector_mode))
      return regno_alignment;
!   else
      {
        int estimated_vf = vect_vf_for_cost (loop_vinfo);
        int estimated_lmul = estimated_vf * GET_MODE_BITSIZE (mode).to_constant ()
*************** compute_estimated_lmul (loop_vec_info lo
*** 636,660 ****
        else
  	return estimated_lmul;
      }
-   else
-     {
-       /* Estimate the VLA SLP LMUL.  */
-       if (regno_alignment > RVV_M1)
- 	return regno_alignment;
-       else if (mode != QImode
- 	       || LOOP_VINFO_SLP_UNROLLING_FACTOR (loop_vinfo).is_constant ())
- 	{
- 	  int ratio;
- 	  if (can_div_trunc_p (BYTES_PER_RISCV_VECTOR,
- 			       GET_MODE_SIZE (loop_vinfo->vector_mode), &ratio))
- 	    {
- 	      if (ratio == 1)
- 		return RVV_M4;
- 	      else if (ratio == 2)
- 		return RVV_M2;
- 	    }
- 	}
-     }
    return 0;
  }
  
--- 634,639 ----
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv.cc gcc-16-20250525/gcc/config/riscv/riscv.cc
*** gcc-16-20250518/gcc/config/riscv/riscv.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv.cc	Sun May 25 22:32:05 2025
*************** static const struct riscv_tune_param opt
*** 642,647 ****
--- 642,669 ----
    NULL,						/* loop_align */
  };
  
+ /* Costs to use when optimizing for MIPS P8700 */
+ static const struct riscv_tune_param mips_p8700_tune_info = {
+   {COSTS_N_INSNS (4), COSTS_N_INSNS (4)},	/* fp_add */
+   {COSTS_N_INSNS (5), COSTS_N_INSNS (5)},	/* fp_mul */
+   {COSTS_N_INSNS (17), COSTS_N_INSNS (17)},	/* fp_div */
+   {COSTS_N_INSNS (5), COSTS_N_INSNS (5)},	/* int_mul */
+   {COSTS_N_INSNS (8), COSTS_N_INSNS (8)},	/* int_div */
+   4,            /* issue_rate */
+   8,            /* branch_cost */
+   4,            /* memory_cost */
+   8,            /* fmv_cost */
+   true,         /* slow_unaligned_access */
+   false,        /* vector_unaligned_access */
+   true,         /* use_divmod_expansion */
+   false,        /* overlap_op_by_pieces */
+   RISCV_FUSE_NOTHING,				/* fusible_ops */
+   NULL,         /* vector cost */
+   NULL,         /* function_align */
+   NULL,         /* jump_align */
+   NULL,         /* loop_align */
+ };
+ 
  static bool riscv_avoid_shrink_wrapping_separate ();
  static tree riscv_handle_fndecl_attribute (tree *, tree, tree, int, bool *);
  static tree riscv_handle_type_attribute (tree *, tree, tree, int, bool *);
*************** riscv_legitimize_move (machine_mode mode
*** 3740,3745 ****
--- 3762,3787 ----
        return true;
      }
  
+   if (TARGET_ZILSD
+       && (GET_MODE_UNIT_SIZE (mode) == (UNITS_PER_WORD * 2))
+       && ((REG_P (dest) && MEM_P (src))
+ 	  || (MEM_P (dest) && REG_P (src)))
+       && can_create_pseudo_p ())
+     {
+       rtx reg = REG_P (dest) ? dest : src;
+       unsigned regno = REGNO (reg);
+       /* ZILSD requires an even-odd register pair, let RA to
+ 	 fix the constraint if the reg is hard reg and not even reg.  */
+       if ((regno < FIRST_PSEUDO_REGISTER)
+ 	  && (regno % 2) != 0)
+ 	{
+ 	  rtx tmp = gen_reg_rtx (GET_MODE (reg));
+ 	  emit_move_insn (tmp, src);
+ 	  emit_move_insn (dest, tmp);
+ 	  return true;
+ 	}
+     }
+ 
    /* RISC-V GCC may generate non-legitimate address due to we provide some
       pattern for optimize access PIC local symbol and it's make GCC generate
       unrecognizable instruction during optimizing.  */
*************** riscv_rtx_costs (rtx x, machine_mode mod
*** 3874,3879 ****
--- 3916,3923 ----
  		break;
  	      case PLUS:
  	      case MINUS:
+ 	      case AND:
+ 	      case IOR:
  		{
  		  rtx op_0 = XEXP (x, 0);
  		  rtx op_1 = XEXP (x, 1);
*************** riscv_split_64bit_move_p (rtx dest, rtx
*** 4576,4581 ****
--- 4620,4638 ----
    if (TARGET_64BIT)
      return false;
  
+   /* Zilsd provides load/store with even-odd register pair. */
+   if (TARGET_ZILSD
+       && (((REG_P (dest) && MEM_P (src))
+ 	  || (MEM_P (dest) && REG_P (src)))))
+     {
+       rtx reg = REG_P (dest) ? dest : src;
+       unsigned regno = REGNO (reg);
+       /* GCC may still generating some load/store with odd-even reg pair
+ 	 because the ABI handling, but that's fine, just split that later.  */
+       if (GP_REG_P (regno))
+ 	return (regno < FIRST_PSEUDO_REGISTER) && ((regno % 2) != 0);
+     }
+ 
    /* There is no need to split if the FLI instruction in the `Zfa` extension can be used.  */
    if (satisfies_constraint_zfli (src))
      return false;
*************** riscv_hard_regno_mode_ok (unsigned int r
*** 9798,9803 ****
--- 9855,9866 ----
        if (riscv_v_ext_mode_p (mode))
  	return false;
  
+       /* Zilsd require load/store with even-odd reg pair.  */
+       if (TARGET_ZILSD
+ 	  && (GET_MODE_UNIT_SIZE (mode) == (UNITS_PER_WORD * 2))
+ 	  && ((regno % 2) != 0))
+ 	return false;
+ 
        if (!GP_REG_P (regno + nregs - 1))
  	return false;
      }
*************** singleton_vxrm_need (void)
*** 12259,12265 ****
    /* Walk the IL noting if VXRM is needed and if there's more than one
       mode needed.  */
    bool found = false;
!   int saved_vxrm_mode;
    for (rtx_insn *insn = get_insns (); insn; insn = NEXT_INSN (insn))
      {
        if (!INSN_P (insn) || DEBUG_INSN_P (insn))
--- 12322,12328 ----
    /* Walk the IL noting if VXRM is needed and if there's more than one
       mode needed.  */
    bool found = false;
!   int saved_vxrm_mode = VXRM_MODE_NONE;
    for (rtx_insn *insn = get_insns (); insn; insn = NEXT_INSN (insn))
      {
        if (!INSN_P (insn) || DEBUG_INSN_P (insn))
*************** synthesize_ior_xor (rtx_code code, rtx o
*** 14239,14245 ****
       we clear bits in IVAL.  Once IVAL is zero, then synthesis of the
       operation is complete.  */
    unsigned HOST_WIDE_INT ival = INTVAL (operands[2]);
!   
    /* Check if we want to use [x]ori. Then get the remaining bits
       and decrease the budget by one. */
    if ((ival & HOST_WIDE_INT_UC (0x7ff)) != 0)
--- 14302,14308 ----
       we clear bits in IVAL.  Once IVAL is zero, then synthesis of the
       operation is complete.  */
    unsigned HOST_WIDE_INT ival = INTVAL (operands[2]);
! 
    /* Check if we want to use [x]ori. Then get the remaining bits
       and decrease the budget by one. */
    if ((ival & HOST_WIDE_INT_UC (0x7ff)) != 0)
*************** synthesize_ior_xor (rtx_code code, rtx o
*** 14374,14387 ****
  	}
      }
  
!   /* If after accounting for bseti the remaining budget has 
       gone to less than zero, it forces the value into a
       register and performs the IOR operation.  It returns
       TRUE to the caller so the caller knows code generation
       is complete. */
    if (budget < 0)
      {
!       rtx x = force_reg (word_mode, operands[2]); 
        x = gen_rtx_fmt_ee (code, word_mode, operands[1], x);
        emit_insn (gen_rtx_SET (operands[0], x));
        return true;
--- 14437,14450 ----
  	}
      }
  
!   /* If after accounting for bseti the remaining budget has
       gone to less than zero, it forces the value into a
       register and performs the IOR operation.  It returns
       TRUE to the caller so the caller knows code generation
       is complete. */
    if (budget < 0)
      {
!       rtx x = force_reg (word_mode, operands[2]);
        x = gen_rtx_fmt_ee (code, word_mode, operands[1], x);
        emit_insn (gen_rtx_SET (operands[0], x));
        return true;
*************** synthesize_ior_xor (rtx_code code, rtx o
*** 14390,14396 ****
    /* Synthesis is better than loading the constant.  */
    ival = INTVAL (operands[2]);
    rtx input = operands[1];
!   rtx output;
  
    /* Emit the [x]ori insn that sets the low 11 bits into
       the proper state.  */
--- 14453,14459 ----
    /* Synthesis is better than loading the constant.  */
    ival = INTVAL (operands[2]);
    rtx input = operands[1];
!   rtx output = NULL_RTX;
  
    /* Emit the [x]ori insn that sets the low 11 bits into
       the proper state.  */
*************** synthesize_ior_xor (rtx_code code, rtx o
*** 14405,14412 ****
      }
  
    /* We figure out a single bit as a constant and
!      generate a CONST_INT node for that.  Then we 
!      construct the IOR node, then the SET node and 
       emit it.  An IOR with a suitable constant that is
       a single bit will be implemented with a bseti. */
    while (ival)
--- 14468,14475 ----
      }
  
    /* We figure out a single bit as a constant and
!      generate a CONST_INT node for that.  Then we
!      construct the IOR node, then the SET node and
       emit it.  An IOR with a suitable constant that is
       a single bit will be implemented with a bseti. */
    while (ival)
*************** synthesize_ior_xor (rtx_code code, rtx o
*** 14419,14428 ****
--- 14482,14642 ----
        input = output;
        ival &= ~tmpval;
      }
+ 
+   gcc_assert (output);
    emit_move_insn (operands[0], output);
    return true;
  }
  
+ /* Synthesize OPERANDS[0] = OPERANDS[1] & OPERANDS[2].
+ 
+     OPERANDS[0] and OPERANDS[1] will be a REG and may be the same
+     REG.
+ 
+     OPERANDS[2] is a CONST_INT.
+ 
+     Return TRUE if the operation was fully synthesized and the caller
+     need not generate additional code.  Return FALSE if the operation
+     was not synthesized and the caller is responsible for emitting the
+     proper sequence.  */
+ 
+ bool
+ synthesize_and (rtx operands[3])
+ {
+   /* Trivial cases that don't need synthesis.  */
+   if (SMALL_OPERAND (INTVAL (operands[2]))
+      || (TARGET_ZBS && not_single_bit_mask_operand (operands[2], word_mode)))
+     return false;
+ 
+   /* If the second operand is a mode mask, emit an extension
+      insn instead.  */
+   if (CONST_INT_P (operands[2]))
+     {
+       enum machine_mode tmode = VOIDmode;
+       if (UINTVAL (operands[2]) == GET_MODE_MASK (HImode))
+ 	tmode = HImode;
+       else if (UINTVAL (operands[2]) == GET_MODE_MASK (SImode))
+ 	tmode = SImode;
+ 
+       if (tmode != VOIDmode)
+ 	{
+ 	  rtx tmp = gen_lowpart (tmode, operands[1]);
+ 	  emit_insn (gen_extend_insn (operands[0], tmp, word_mode, tmode, 1));
+ 	  return true;
+ 	}
+     }
+ 
+   /* The number of instructions to synthesize the constant is a good
+      estimate of the budget.  That does not account for out of order
+      execution an fusion in the constant synthesis those would naturally
+      decrease the budget.  It also does not account for the AND at
+      the end of the sequence which would increase the budget. */
+   int budget = riscv_const_insns (operands[2], true);
+   rtx input = NULL_RTX;
+   rtx output = NULL_RTX;
+ 
+   /* Left shift + right shift to clear high bits.  */
+   if (budget >= 2 && p2m1_shift_operand (operands[2], word_mode))
+     {
+       int count = (GET_MODE_BITSIZE (GET_MODE (operands[1])).to_constant ()
+ 		   - exact_log2 (INTVAL (operands[2]) + 1));
+       rtx x = gen_rtx_ASHIFT (word_mode, operands[1], GEN_INT (count));
+       output = gen_reg_rtx (word_mode);
+       emit_insn (gen_rtx_SET (output, x));
+       input = output;
+       x = gen_rtx_LSHIFTRT (word_mode, input, GEN_INT (count));
+       emit_insn (gen_rtx_SET (operands[0], x));
+       return true;
+     }
+ 
+   /* Clears a bunch of low bits with only high bits set.  */
+   unsigned HOST_WIDE_INT t = ~INTVAL (operands[2]);
+   if (budget >= 2 && exact_log2 (t + 1) >= 0)
+     {
+       int count = ctz_hwi (INTVAL (operands[2]));
+       rtx x = gen_rtx_LSHIFTRT (word_mode, operands[1], GEN_INT (count));
+       output = gen_reg_rtx (word_mode);
+       emit_insn (gen_rtx_SET (output, x));
+       input = output;
+       x = gen_rtx_ASHIFT (word_mode, input, GEN_INT (count));
+       emit_insn (gen_rtx_SET (operands[0], x));
+       return true;
+     }
+ 
+   /* If we shift right to eliminate the trailing zeros and
+      the result is a SMALL_OPERAND, then it's a shift right,
+      andi and shift left.  */
+   t = INTVAL (operands[2]);
+   t >>= ctz_hwi (t);
+   if (budget >= 3 && SMALL_OPERAND (t) && popcount_hwi (t) > 2)
+     {
+       /* Shift right to clear the low order bits.  */
+       unsigned HOST_WIDE_INT count = ctz_hwi (INTVAL (operands[2]));
+       rtx x = gen_rtx_LSHIFTRT (word_mode, operands[1], GEN_INT (count));
+       output = gen_reg_rtx (word_mode);
+       emit_insn (gen_rtx_SET (output, x));
+       input = output;
+ 
+       /* Now emit the ANDI.  */
+       unsigned HOST_WIDE_INT mask = INTVAL (operands[2]);
+       mask >>= ctz_hwi (mask);
+       x = gen_rtx_AND (word_mode, input, GEN_INT (mask));
+       output = gen_reg_rtx (word_mode);
+       emit_insn (gen_rtx_SET (output, x));
+       input = output;
+ 
+       /* Shift left to move bits into position.  */
+       count = INTVAL (operands[2]);
+       count = ctz_hwi (count);
+       x = gen_rtx_ASHIFT (word_mode, input, GEN_INT (count));
+       emit_insn (gen_rtx_SET (operands[0], x));
+       return true;
+     }
+ 
+   /* If there are all zeros, except for a run of 1s somewhere in the middle
+      of the constant, then this is at worst 3 shifts.  */
+   t = INTVAL (operands[2]);
+   if (budget >= 3
+       && consecutive_bits_operand (GEN_INT (t), word_mode)
+       && popcount_hwi (t) > 3)
+     {
+       /* Shift right to clear the low order bits.  */
+       int count = ctz_hwi (INTVAL (operands[2]));
+       rtx x = gen_rtx_LSHIFTRT (word_mode, operands[1], GEN_INT (count));
+       output = gen_reg_rtx (word_mode);
+       emit_insn (gen_rtx_SET (output, x));
+       input = output;
+ 
+       /* Shift left to clear the high order bits.  */
+       count += clz_hwi (INTVAL (operands[2])) % BITS_PER_WORD;
+       x = gen_rtx_ASHIFT (word_mode, input, GEN_INT (count));
+       output = gen_reg_rtx (word_mode);
+       emit_insn (gen_rtx_SET (output, x));
+       input = output;
+ 
+       /* And shift back right to put the bits into position.  */
+       count = clz_hwi (INTVAL (operands[2])) % BITS_PER_WORD;
+       x = gen_rtx_LSHIFTRT (word_mode, input, GEN_INT (count));
+       emit_insn (gen_rtx_SET (operands[0], x));
+       return true;
+     }
+ 
+   /* If the remaining budget has gone to less than zero, it
+      forces the value into a register and performs the AND
+      operation.  It returns TRUE to the caller so the caller
+      knows code generation is complete.
+      FIXME: This is hacked to always be enabled until the last
+      patch in the series is enabled.  */
+   if (1)
+     {
+       rtx x = force_reg (word_mode, operands[2]);
+       x = gen_rtx_AND (word_mode, operands[1], x);
+       emit_insn (gen_rtx_SET (operands[0], x));
+       return true;
+     }
+ }
+ 
+ 
  /* Initialize the GCC target structure.  */
  #undef TARGET_ASM_ALIGNED_HI_OP
  #define TARGET_ASM_ALIGNED_HI_OP "\t.half\t"
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv.md gcc-16-20250525/gcc/config/riscv/riscv.md
*** gcc-16-20250518/gcc/config/riscv/riscv.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv.md	Sun May 25 22:32:05 2025
***************
*** 672,678 ****
  ;; Microarchitectures we know how to tune for.
  ;; Keep this in sync with enum riscv_microarchitecture.
  (define_attr "tune"
!   "generic,sifive_7,sifive_p400,sifive_p600,xiangshan,generic_ooo"
    (const (symbol_ref "((enum attr_tune) riscv_microarchitecture)")))
  
  ;; Describe a user's asm statement.
--- 672,678 ----
  ;; Microarchitectures we know how to tune for.
  ;; Keep this in sync with enum riscv_microarchitecture.
  (define_attr "tune"
!   "generic,sifive_7,sifive_p400,sifive_p600,xiangshan,generic_ooo,mips_p8700"
    (const (symbol_ref "((enum attr_tune) riscv_microarchitecture)")))
  
  ;; Describe a user's asm statement.
***************
*** 1724,1749 ****
  (define_expand "and<mode>3"
    [(set (match_operand:X                0 "register_operand")
          (and:X (match_operand:X 1 "register_operand")
! 	       (match_operand:X 2 "arith_or_mode_mask_or_zbs_operand")))]
    ""
  {
!   /* If the second operand is a mode mask, emit an extension
!      insn instead.  */
!   if (CONST_INT_P (operands[2]))
!     {
!       enum machine_mode tmode = VOIDmode;
!       if (UINTVAL (operands[2]) == GET_MODE_MASK (HImode))
! 	tmode = HImode;
!       else if (UINTVAL (operands[2]) == GET_MODE_MASK (SImode))
! 	tmode = SImode;
! 
!       if (tmode != VOIDmode)
! 	{
! 	  rtx tmp = gen_lowpart (tmode, operands[1]);
! 	  emit_insn (gen_extend_insn (operands[0], tmp, <MODE>mode, tmode, 1));
! 	  DONE;
! 	}
!     }
  })
  
  (define_insn "*and<mode>3"
--- 1724,1734 ----
  (define_expand "and<mode>3"
    [(set (match_operand:X                0 "register_operand")
          (and:X (match_operand:X 1 "register_operand")
! 	       (match_operand:X 2 "reg_or_const_int_operand")))]
    ""
  {
!   if (CONST_INT_P (operands[2]) && synthesize_and (operands))
!     DONE;
  })
  
  (define_insn "*and<mode>3"
***************
*** 2516,2523 ****
  })
  
  (define_insn "*movdi_32bit"
!   [(set (match_operand:DI 0 "nonimmediate_operand" "=r,r,r,m,  *f,*f,*r,*f,*m,r")
! 	(match_operand:DI 1 "move_operand"         " r,i,m,r,*J*r,*m,*f,*f,*f,vp"))]
    "!TARGET_64BIT
     && (register_operand (operands[0], DImode)
         || reg_or_0_operand (operands[1], DImode))"
--- 2501,2508 ----
  })
  
  (define_insn "*movdi_32bit"
!   [(set (match_operand:DI 0 "nonimmediate_operand" "=r,r,r, m,  *f,*f,*r,*f,*m,r")
! 	(match_operand:DI 1 "move_operand"         " r,i,m,rJ,*J*r,*m,*f,*f,*f,vp"))]
    "!TARGET_64BIT
     && (register_operand (operands[0], DImode)
         || reg_or_0_operand (operands[1], DImode))"
***************
*** 2953,2959 ****
  	       (match_operand:GPR2 2 "register_operand"  "r")
  	       (match_operand 3 "<GPR:shiftm1>"))])))]
    ""
!   "<insn>\t%0,%1,%2"
    [(set_attr "type" "shift")
     (set_attr "mode" "<GPR:MODE>")])
  
--- 2938,2951 ----
  	       (match_operand:GPR2 2 "register_operand"  "r")
  	       (match_operand 3 "<GPR:shiftm1>"))])))]
    ""
! {
!   /* If the shift mode is not word mode, then it must be the
!      case that we're generating rv64 code, but this is a 32-bit
!      operation.  Thus we need to use the "w" variant.  */
!   if (E_<GPR:MODE>mode != word_mode)
!     return "<insn>w\t%0,%1,%2";
!   return "<insn>\t%0,%1,%2";
! }
    [(set_attr "type" "shift")
     (set_attr "mode" "<GPR:MODE>")])
  
***************
*** 4712,4734 ****
  			    (match_operand 2 "const_int_operand" "n"))
  		 (match_operand 3 "const_int_operand" "n")))
     (clobber (match_scratch:DI 4 "=&r"))]
!   "(TARGET_64BIT && riscv_const_insns (operands[3], false) == 1)"
    "#"
    "&& reload_completed"
    [(const_int 0)]
    "{
!      rtx x = gen_rtx_ASHIFT (DImode, operands[1], operands[2]);
!      emit_insn (gen_rtx_SET (operands[0], x));
! 
!      /* If the constant fits in a simm12, use it directly as we do not
! 	get another good chance to optimize things again.  */
!      if (!SMALL_OPERAND (INTVAL (operands[3])))
         emit_move_insn (operands[4], operands[3]);
       else
         operands[4] = operands[3];
  
!      x = gen_rtx_PLUS (DImode, operands[0], operands[4]);
!      emit_insn (gen_rtx_SET (operands[0], x));
       DONE;
     }"
    [(set_attr "type" "arith")])
--- 4704,4741 ----
  			    (match_operand 2 "const_int_operand" "n"))
  		 (match_operand 3 "const_int_operand" "n")))
     (clobber (match_scratch:DI 4 "=&r"))]
!   "(TARGET_64BIT
!     && riscv_const_insns (operands[3], false) == 1
!     && riscv_const_insns (GEN_INT (INTVAL (operands[3])
! 			  << INTVAL (operands[2])), false) != 1)"
    "#"
    "&& reload_completed"
    [(const_int 0)]
    "{
!      /* Prefer to generate shNadd when we can, even over using an
! 	immediate form.  If we're not going to be able to generate
! 	a shNadd, then use the constant directly if it fits in a
! 	simm12 field since we won't get another chance to optimize this.  */
!      if ((TARGET_ZBA && imm123_operand (operands[2], word_mode))
! 	 || !SMALL_OPERAND (INTVAL (operands[3])))
         emit_move_insn (operands[4], operands[3]);
       else
         operands[4] = operands[3];
  
!      if (TARGET_ZBA && imm123_operand (operands[2], word_mode))
!        {
! 	 rtx x = gen_rtx_ASHIFT (DImode, operands[1], operands[2]);
! 	 x = gen_rtx_PLUS (DImode, x, operands[4]);
! 	 emit_insn (gen_rtx_SET (operands[0], x));
!        }
!      else
!        {
! 	 rtx x = gen_rtx_ASHIFT (DImode, operands[1], operands[2]);
! 	 emit_insn (gen_rtx_SET (operands[0], x));
! 	 x = gen_rtx_PLUS (DImode, operands[0], operands[4]);
! 	 emit_insn (gen_rtx_SET (operands[0], x));
!        }
! 
       DONE;
     }"
    [(set_attr "type" "arith")])
***************
*** 4849,4851 ****
--- 4856,4859 ----
  (include "zc.md")
  (include "corev.md")
  (include "xiangshan.md")
+ (include "mips-p8700.md")
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/riscv.opt gcc-16-20250525/gcc/config/riscv/riscv.opt
*** gcc-16-20250518/gcc/config/riscv/riscv.opt	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/riscv.opt	Sun May 25 22:32:05 2025
*************** Max number of bytes to compare as part o
*** 286,291 ****
--- 286,295 ----
  Target RejectNegative Joined UInteger Var(gpr2vr_cost) Init(GPR2VR_COST_UNPROVIDED)
  Set the cost value of the rvv instruction when operate from GPR to VR.
  
+ -param=riscv-autovec-mode=
+ Target Undocumented RejectNegative Joined Var(riscv_autovec_mode) Save
+ Set the only autovec mode to try.
+ 
  Enum
  Name(rvv_max_lmul) Type(enum rvv_max_lmul_enum)
  The RVV possible LMUL (-mrvv-max-lmul=):
diff -Nrcpad gcc-16-20250518/gcc/config/riscv/vector-iterators.md gcc-16-20250525/gcc/config/riscv/vector-iterators.md
*** gcc-16-20250518/gcc/config/riscv/vector-iterators.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/riscv/vector-iterators.md	Sun May 25 22:32:05 2025
***************
*** 4042,4048 ****
  ])
  
  (define_code_iterator any_int_binop_no_shift_vx [
!   plus minus
  ])
  
  (define_code_iterator any_int_unop [neg not])
--- 4042,4048 ----
  ])
  
  (define_code_iterator any_int_binop_no_shift_vx [
!   plus minus and ior
  ])
  
  (define_code_iterator any_int_unop [neg not])
diff -Nrcpad gcc-16-20250518/gcc/config/sparc/sparc.md gcc-16-20250525/gcc/config/sparc/sparc.md
*** gcc-16-20250518/gcc/config/sparc/sparc.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/sparc/sparc.md	Sun May 25 22:32:05 2025
***************
*** 3014,3030 ****
    rtx shift_16 = GEN_INT (16);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operand1) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operand1);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operand1 = XEXP (operand1, 0);
      }
  
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operand1, op1_subbyte),
  			  shift_16));
!   emit_insn (gen_lshrsi3 (operand0, temp, shift_16));
    DONE;
  })
  
--- 3014,3031 ----
    rtx shift_16 = GEN_INT (16);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operands[1]) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operands[1]);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operands[1] = XEXP (operands[1], 0);
      }
  
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operands[1],
! 						op1_subbyte),
  			  shift_16));
!   emit_insn (gen_lshrsi3 (operands[0], temp, shift_16));
    DONE;
  })
  
***************
*** 3097,3113 ****
    rtx shift_48 = GEN_INT (48);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operand1) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operand1);
        op1_subbyte /= GET_MODE_SIZE (DImode);
        op1_subbyte *= GET_MODE_SIZE (DImode);
!       operand1 = XEXP (operand1, 0);
      }
  
!   emit_insn (gen_ashldi3 (temp, gen_rtx_SUBREG (DImode, operand1, op1_subbyte),
  			  shift_48));
!   emit_insn (gen_lshrdi3 (operand0, temp, shift_48));
    DONE;
  })
  
--- 3098,3115 ----
    rtx shift_48 = GEN_INT (48);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operands[1]) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operands[1]);
        op1_subbyte /= GET_MODE_SIZE (DImode);
        op1_subbyte *= GET_MODE_SIZE (DImode);
!       operands[1] = XEXP (operands[1], 0);
      }
  
!   emit_insn (gen_ashldi3 (temp, gen_rtx_SUBREG (DImode, operands[1],
! 						op1_subbyte),
  			  shift_48));
!   emit_insn (gen_lshrdi3 (operands[0], temp, shift_48));
    DONE;
  })
  
***************
*** 3283,3299 ****
    rtx shift_16 = GEN_INT (16);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operand1) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operand1);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operand1 = XEXP (operand1, 0);
      }
  
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operand1, op1_subbyte),
  			  shift_16));
!   emit_insn (gen_ashrsi3 (operand0, temp, shift_16));
    DONE;
  })
  
--- 3285,3302 ----
    rtx shift_16 = GEN_INT (16);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operands[1]) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operands[1]);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operands[1] = XEXP (operands[1], 0);
      }
  
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operands[1],
! 						op1_subbyte),
  			  shift_16));
!   emit_insn (gen_ashrsi3 (operands[0], temp, shift_16));
    DONE;
  })
  
***************
*** 3315,3339 ****
    int op1_subbyte = 0;
    int op0_subbyte = 0;
  
!   if (GET_CODE (operand1) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operand1);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operand1 = XEXP (operand1, 0);
      }
!   if (GET_CODE (operand0) == SUBREG)
      {
!       op0_subbyte = SUBREG_BYTE (operand0);
        op0_subbyte /= GET_MODE_SIZE (SImode);
        op0_subbyte *= GET_MODE_SIZE (SImode);
!       operand0 = XEXP (operand0, 0);
      }
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operand1, op1_subbyte),
  			  shift_24));
!   if (GET_MODE (operand0) != SImode)
!     operand0 = gen_rtx_SUBREG (SImode, operand0, op0_subbyte);
!   emit_insn (gen_ashrsi3 (operand0, temp, shift_24));
    DONE;
  })
  
--- 3318,3343 ----
    int op1_subbyte = 0;
    int op0_subbyte = 0;
  
!   if (GET_CODE (operands[1]) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operands[1]);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operands[1] = XEXP (operands[1], 0);
      }
!   if (GET_CODE (operands[0]) == SUBREG)
      {
!       op0_subbyte = SUBREG_BYTE (operands[0]);
        op0_subbyte /= GET_MODE_SIZE (SImode);
        op0_subbyte *= GET_MODE_SIZE (SImode);
!       operands[0] = XEXP (operands[0], 0);
      }
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operands[1],
! 						op1_subbyte),
  			  shift_24));
!   if (GET_MODE (operands[0]) != SImode)
!     operands[0] = gen_rtx_SUBREG (SImode, operands[0], op0_subbyte);
!   emit_insn (gen_ashrsi3 (operands[0], temp, shift_24));
    DONE;
  })
  
***************
*** 3354,3370 ****
    rtx shift_24 = GEN_INT (24);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operand1) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operand1);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operand1 = XEXP (operand1, 0);
      }
  
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operand1, op1_subbyte),
  			  shift_24));
!   emit_insn (gen_ashrsi3 (operand0, temp, shift_24));
    DONE;
  })
  
--- 3358,3375 ----
    rtx shift_24 = GEN_INT (24);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operands[1]) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operands[1]);
        op1_subbyte /= GET_MODE_SIZE (SImode);
        op1_subbyte *= GET_MODE_SIZE (SImode);
!       operands[1] = XEXP (operands[1], 0);
      }
  
!   emit_insn (gen_ashlsi3 (temp, gen_rtx_SUBREG (SImode, operands[1],
! 						op1_subbyte),
  			  shift_24));
!   emit_insn (gen_ashrsi3 (operands[0], temp, shift_24));
    DONE;
  })
  
***************
*** 3385,3401 ****
    rtx shift_56 = GEN_INT (56);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operand1) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operand1);
        op1_subbyte /= GET_MODE_SIZE (DImode);
        op1_subbyte *= GET_MODE_SIZE (DImode);
!       operand1 = XEXP (operand1, 0);
      }
  
!   emit_insn (gen_ashldi3 (temp, gen_rtx_SUBREG (DImode, operand1, op1_subbyte),
  			  shift_56));
!   emit_insn (gen_ashrdi3 (operand0, temp, shift_56));
    DONE;
  })
  
--- 3390,3407 ----
    rtx shift_56 = GEN_INT (56);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operands[1]) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operands[1]);
        op1_subbyte /= GET_MODE_SIZE (DImode);
        op1_subbyte *= GET_MODE_SIZE (DImode);
!       operands[1] = XEXP (operands[1], 0);
      }
  
!   emit_insn (gen_ashldi3 (temp, gen_rtx_SUBREG (DImode, operands[1],
! 						op1_subbyte),
  			  shift_56));
!   emit_insn (gen_ashrdi3 (operands[0], temp, shift_56));
    DONE;
  })
  
***************
*** 3416,3432 ****
    rtx shift_48 = GEN_INT (48);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operand1) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operand1);
        op1_subbyte /= GET_MODE_SIZE (DImode);
        op1_subbyte *= GET_MODE_SIZE (DImode);
!       operand1 = XEXP (operand1, 0);
      }
  
!   emit_insn (gen_ashldi3 (temp, gen_rtx_SUBREG (DImode, operand1, op1_subbyte),
  			  shift_48));
!   emit_insn (gen_ashrdi3 (operand0, temp, shift_48));
    DONE;
  })
  
--- 3422,3439 ----
    rtx shift_48 = GEN_INT (48);
    int op1_subbyte = 0;
  
!   if (GET_CODE (operands[1]) == SUBREG)
      {
!       op1_subbyte = SUBREG_BYTE (operands[1]);
        op1_subbyte /= GET_MODE_SIZE (DImode);
        op1_subbyte *= GET_MODE_SIZE (DImode);
!       operands[1] = XEXP (operands[1], 0);
      }
  
!   emit_insn (gen_ashldi3 (temp, gen_rtx_SUBREG (DImode, operands[1],
! 						op1_subbyte),
  			  shift_48));
!   emit_insn (gen_ashrdi3 (operands[0], temp, shift_48));
    DONE;
  })
  
diff -Nrcpad gcc-16-20250518/gcc/config/stormy16/stormy16.md gcc-16-20250525/gcc/config/stormy16/stormy16.md
*** gcc-16-20250518/gcc/config/stormy16/stormy16.md	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config/stormy16/stormy16.md	Sun May 25 22:32:05 2025
***************
*** 702,709 ****
    [(parallel [(set (match_operand:SI 0 "register_operand" "")
  		   (neg:SI (match_operand:SI 1 "register_operand" "")))
  	      (clobber (reg:BI CARRY_REG))])]
!   ""
!   { operands[2] = gen_reg_rtx (HImode); })
  
  (define_insn_and_split "*negsi2_internal"
    [(set (match_operand:SI 0 "register_operand" "=&r")
--- 702,708 ----
    [(parallel [(set (match_operand:SI 0 "register_operand" "")
  		   (neg:SI (match_operand:SI 1 "register_operand" "")))
  	      (clobber (reg:BI CARRY_REG))])]
!   "")
  
  (define_insn_and_split "*negsi2_internal"
    [(set (match_operand:SI 0 "register_operand" "=&r")
diff -Nrcpad gcc-16-20250518/gcc/config.gcc gcc-16-20250525/gcc/config.gcc
*** gcc-16-20250518/gcc/config.gcc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/config.gcc	Sun May 25 22:32:05 2025
*************** i[34567]86-*-* | x86_64-*-*)
*** 452,465 ****
  		       cmpccxaddintrin.h amxfp16intrin.h prfchiintrin.h
  		       raointintrin.h amxcomplexintrin.h avxvnniint16intrin.h
  		       sm3intrin.h sha512intrin.h sm4intrin.h usermsrintrin.h
! 		       avx10_2mediaintrin.h avx10_2-512mediaintrin.h
! 		       avx10_2convertintrin.h avx10_2-512convertintrin.h
! 		       avx10_2bf16intrin.h avx10_2-512bf16intrin.h
! 		       avx10_2satcvtintrin.h avx10_2-512satcvtintrin.h
! 		       avx10_2minmaxintrin.h avx10_2-512minmaxintrin.h
! 		       avx10_2copyintrin.h amxavx512intrin.h amxtf32intrin.h
! 		       amxtransposeintrin.h amxfp8intrin.h movrsintrin.h
! 		       amxmovrsintrin.h"
  	;;
  ia64-*-*)
  	extra_headers=ia64intrin.h
--- 452,462 ----
  		       cmpccxaddintrin.h amxfp16intrin.h prfchiintrin.h
  		       raointintrin.h amxcomplexintrin.h avxvnniint16intrin.h
  		       sm3intrin.h sha512intrin.h sm4intrin.h usermsrintrin.h
! 		       avx10_2mediaintrin.h avx10_2convertintrin.h
! 		       avx10_2bf16intrin.h avx10_2satcvtintrin.h
! 		       avx10_2minmaxintrin.h avx10_2copyintrin.h
! 		       amxavx512intrin.h amxtf32intrin.h amxtransposeintrin.h
! 		       amxfp8intrin.h movrsintrin.h amxmovrsintrin.h"
  	;;
  ia64-*-*)
  	extra_headers=ia64intrin.h
diff -Nrcpad gcc-16-20250518/gcc/cp/ChangeLog gcc-16-20250525/gcc/cp/ChangeLog
*** gcc-16-20250518/gcc/cp/ChangeLog	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/ChangeLog	Sun May 25 22:32:06 2025
***************
*** 1,3 ****
--- 1,66 ----
+ 2025-05-23  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120363
+ 	* decl2.cc (get_tls_init_fn): Set context as global_namespace.
+ 	(get_tls_wrapper_fn): Likewise.
+ 
+ 2025-05-23  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120414
+ 	* module.cc (trees_in::tree_node): Allow reading a USING_DECL
+ 	when streaming tt_data_member.
+ 
+ 2025-05-23  Jason Merrill  <jason@redhat.com>
+ 
+ 	* mangle.cc (mangle_decl_string): Don't push_tinst_level.
+ 
+ 2025-05-22  Jason Merrill  <jason@redhat.com>
+ 
+ 	PR c++/120935
+ 	* cp-gimplify.cc (cp_fold): Check always_inline.
+ 
+ 2025-05-21  Iain Sandoe  <iain@sandoe.co.uk>
+ 
+ 	* coroutines.cc
+ 	(cp_coroutine_transform::build_ramp_function): Replace ramp
+ 	cleanup try-catch block with eh-only cleanup statements.
+ 
+ 2025-05-21  Iain Sandoe  <iain@sandoe.co.uk>
+ 
+ 	* coroutines.cc
+ 	(cp_coroutine_transform::build_ramp_function): Use
+ 	decltype(auto) to determine the type of the temporary
+ 	get_return_object.
+ 
+ 2025-05-21  Iain Sandoe  <iain@sandoe.co.uk>
+ 
+ 	PR c++/119916
+ 	* coroutines.cc
+ 	(cp_coroutine_transform::wrap_original_function_body): Do not
+ 	initialise initial_await_resume_called here...
+ 	(cp_coroutine_transform::build_ramp_function): ... but here.
+ 	When the coroutine is not void, initialize a GRO object from
+ 	promise.get_return_object().  Use this as the argument to the
+ 	return expression.  Use a regular cleanup for the GRO, since
+ 	it is ramp-local.
+ 
+ 2025-05-20  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120349
+ 	* module.cc (trees_out::core_bools): Always mark vtables as
+ 	DECL_EXTERNAL.
+ 
+ 2025-05-20  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120013
+ 	* module.cc (trees_in::install_entity): Handle re-registering
+ 	the inner TYPE_DECL of a partial specialisation.
+ 
+ 2025-05-20  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120350
+ 	* rtti.cc (get_tinfo_decl_direct): Mark TREE_ADDRESSABLE.
+ 
  2025-05-16  Ville Voutilainen  <ville.voutilainen@gmail.com>
  
  	* cp-gimplify.cc (cp_fold): Do the conversion unconditionally, even for same-type cases.
diff -Nrcpad gcc-16-20250518/gcc/cp/coroutines.cc gcc-16-20250525/gcc/cp/coroutines.cc
*** gcc-16-20250518/gcc/cp/coroutines.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/coroutines.cc	Sun May 25 22:32:06 2025
*************** cp_coroutine_transform::wrap_original_fu
*** 4451,4457 ****
        tree i_a_r_c
  	= coro_build_artificial_var (loc, coro_frame_i_a_r_c_id,
  				     boolean_type_node, orig_fn_decl,
! 				     boolean_false_node);
        DECL_CHAIN (i_a_r_c) = var_list;
        var_list = i_a_r_c;
        add_decl_expr (i_a_r_c);
--- 4451,4457 ----
        tree i_a_r_c
  	= coro_build_artificial_var (loc, coro_frame_i_a_r_c_id,
  				     boolean_type_node, orig_fn_decl,
! 				     NULL_TREE);
        DECL_CHAIN (i_a_r_c) = var_list;
        var_list = i_a_r_c;
        add_decl_expr (i_a_r_c);
*************** cp_coroutine_transform::build_ramp_funct
*** 4866,4912 ****
    coro_fp = pushdecl (coro_fp);
    add_decl_expr (coro_fp);
  
-   tree coro_promise_live = NULL_TREE;
-   tree coro_gro_live = NULL_TREE;
-   if (flag_exceptions)
-     {
-       /* Signal that we need to clean up the promise object on exception.  */
-       coro_promise_live
- 	= coro_build_and_push_artificial_var (loc, "_Coro_promise_live",
- 					      boolean_type_node, orig_fn_decl,
- 					      boolean_false_node);
- 
-       /* When the get-return-object is in the RETURN slot, we need to arrange
- 	 for cleanup on exception.  */
-       coro_gro_live
- 	= coro_build_and_push_artificial_var (loc, "_Coro_gro_live",
- 					      boolean_type_node, orig_fn_decl,
- 					      boolean_false_node);
- 
-       /* To signal that we need to cleanup copied function args.  */
-       if (DECL_ARGUMENTS (orig_fn_decl))
- 	for (tree arg = DECL_ARGUMENTS (orig_fn_decl); arg != NULL;
- 	     arg = DECL_CHAIN (arg))
- 	  {
- 	    param_info *parm_i = param_uses.get (arg);
- 	    if (parm_i->trivial_dtor)
- 	      continue;
- 	    parm_i->guard_var = pushdecl (parm_i->guard_var);
- 	    add_decl_expr (parm_i->guard_var);
- 	  }
-     }
- 
-   /* deref the frame pointer, to use in member access code.  */
-   tree deref_fp
-     = cp_build_indirect_ref (loc, coro_fp, RO_UNARY_STAR,
- 			     tf_warning_or_error);
-   tree frame_needs_free
-     = coro_build_and_push_artificial_var_with_dve (loc,
- 						   coro_frame_needs_free_id,
- 						   boolean_type_node,
- 						   orig_fn_decl, NULL_TREE,
- 						   deref_fp);
- 
    /* Build the frame.  */
  
    /* The CO_FRAME internal function is a mechanism to allow the middle end
--- 4866,4871 ----
*************** cp_coroutine_transform::build_ramp_funct
*** 4950,4985 ****
        finish_if_stmt (if_stmt);
      }
  
    /* For now, once allocation has succeeded we always assume that this needs
       destruction, there's no impl. for frame allocation elision.  */
!   r = cp_build_init_expr (frame_needs_free, boolean_true_node);
!   finish_expr_stmt (r);
! 
!   /* Set up the promise.  */
!   tree p
!     = coro_build_and_push_artificial_var_with_dve (loc, coro_promise_id,
! 						   promise_type, orig_fn_decl,
! 						   NULL_TREE, deref_fp);
  
-   /* Up to now any exception thrown will propagate directly to the caller.
-      This is OK since the only source of such exceptions would be in allocation
-      of the coroutine frame, and therefore the ramp will not have initialized
-      any further state.  From here, we will track state that needs explicit
-      destruction in the case that promise or g.r.o setup fails or an exception
-      is thrown from the initial suspend expression.  */
-   tree ramp_try_block = NULL_TREE;
-   tree ramp_try_stmts = NULL_TREE;
    tree iarc_x = NULL_TREE;
    if (flag_exceptions)
      {
        iarc_x
  	= coro_build_and_push_artificial_var_with_dve (loc,
  						       coro_frame_i_a_r_c_id,
  						       boolean_type_node,
! 						       orig_fn_decl, NULL_TREE,
  						       deref_fp);
!       ramp_try_block = begin_try_block ();
!       ramp_try_stmts = begin_compound_stmt (BCS_TRY_BLOCK);
      }
  
    /* Put the resumer and destroyer functions in.  */
--- 4909,4955 ----
        finish_if_stmt (if_stmt);
      }
  
+   /* Dereference the frame pointer, to use in member access code.  */
+   tree deref_fp
+     = cp_build_indirect_ref (loc, coro_fp, RO_UNARY_STAR, tf_warning_or_error);
+ 
    /* For now, once allocation has succeeded we always assume that this needs
       destruction, there's no impl. for frame allocation elision.  */
!   tree frame_needs_free
!     = coro_build_and_push_artificial_var_with_dve (loc,
! 						   coro_frame_needs_free_id,
! 						   boolean_type_node,
! 						   orig_fn_decl,
! 						   boolean_true_node,
! 						   deref_fp);
!   /* Although it appears to be unused here the frame entry is needed and we
!      just set it true.  */
!   TREE_USED (frame_needs_free) = true;
  
    tree iarc_x = NULL_TREE;
+   tree coro_before_return = NULL_TREE;
    if (flag_exceptions)
      {
+       coro_before_return
+ 	= coro_build_and_push_artificial_var (loc, "_Coro_before_return",
+ 					      boolean_type_node, orig_fn_decl,
+ 					      boolean_true_node);
        iarc_x
  	= coro_build_and_push_artificial_var_with_dve (loc,
  						       coro_frame_i_a_r_c_id,
  						       boolean_type_node,
! 						       orig_fn_decl,
! 						       boolean_false_node,
  						       deref_fp);
!       tree frame_cleanup = push_stmt_list ();
!       tree do_fr_cleanup
! 	= build1_loc (loc, TRUTH_NOT_EXPR, boolean_type_node, iarc_x);
!       do_fr_cleanup = build2_loc (loc, TRUTH_AND_EXPR, boolean_type_node,
! 				  coro_before_return, do_fr_cleanup);
!       r = build3 (COND_EXPR, void_type_node, do_fr_cleanup,
! 			     delete_frame_call, void_node);
!       finish_expr_stmt (r);
!       push_cleanup (coro_fp, pop_stmt_list (frame_cleanup), /*eh_only*/true);
      }
  
    /* Put the resumer and destroyer functions in.  */
*************** cp_coroutine_transform::build_ramp_funct
*** 5052,5075 ****
  					tf_warning_or_error);
  	    }
  	  finish_expr_stmt (r);
! 	  if (!parm.trivial_dtor)
  	    {
- 	      param_dtor_list.safe_push (parm.field_id);
- 	      /* Cleanup this frame copy on exception.  */
  	      parm.fr_copy_dtor
  		= cxx_maybe_build_cleanup (fld_idx, tf_warning_or_error);
! 	      if (flag_exceptions)
  		{
! 		  /* This var is now live.  */
! 		  r = build_modify_expr (loc, parm.guard_var,
! 					 boolean_type_node, INIT_EXPR, loc,
! 					 boolean_true_node, boolean_type_node);
  		  finish_expr_stmt (r);
  		}
  	    }
  	}
      }
  
    if (type_build_ctor_call (promise_type))
      {
        /* Construct the promise object [dcl.fct.def.coroutine] / 5.7.
--- 5022,5059 ----
  					tf_warning_or_error);
  	    }
  	  finish_expr_stmt (r);
! 
! 	  /* Arrange for parm copies to be cleaned up when an exception is
! 	     thrown before initial await resume.  */
! 	  if (flag_exceptions && !parm.trivial_dtor)
  	    {
  	      parm.fr_copy_dtor
  		= cxx_maybe_build_cleanup (fld_idx, tf_warning_or_error);
! 	      if (parm.fr_copy_dtor && parm.fr_copy_dtor != error_mark_node)
  		{
! 		  param_dtor_list.safe_push (parm.field_id);
! 		  tree param_cleanup = push_stmt_list ();
! 		  tree do_cleanup
! 		    = build1_loc (loc, TRUTH_NOT_EXPR, boolean_type_node, iarc_x);
! 		  do_cleanup
! 		    = build2_loc (loc, TRUTH_AND_EXPR, boolean_type_node,
! 				  coro_before_return, do_cleanup);
! 		  r = build3_loc (loc, COND_EXPR, void_type_node, do_cleanup,
! 				  parm.fr_copy_dtor, void_node);
  		  finish_expr_stmt (r);
+ 		  push_cleanup (fld_idx, pop_stmt_list (param_cleanup),
+ 				/*eh_only*/true);
  		}
  	    }
  	}
      }
  
+   /* Set up the promise.  */
+   tree p
+     = coro_build_and_push_artificial_var_with_dve (loc, coro_promise_id,
+ 						   promise_type, orig_fn_decl,
+ 						   NULL_TREE, deref_fp);
+ 
    if (type_build_ctor_call (promise_type))
      {
        /* Construct the promise object [dcl.fct.def.coroutine] / 5.7.
*************** cp_coroutine_transform::build_ramp_funct
*** 5103,5113 ****
  	finish_expr_stmt (r);
      }
  
!   tree promise_dtor = cxx_maybe_build_cleanup (p, tf_warning_or_error);;
!   if (flag_exceptions && promise_dtor)
      {
!       r = cp_build_init_expr (coro_promise_live, boolean_true_node);
!       finish_expr_stmt (r);
      }
  
    tree get_ro
--- 5087,5108 ----
  	finish_expr_stmt (r);
      }
  
!   if (flag_exceptions)
      {
!       tree promise_dtor = cxx_maybe_build_cleanup (p, tf_warning_or_error);
!       /* If the promise is live, then run its dtor if that's available.  */
!       if (promise_dtor && promise_dtor != error_mark_node)
! 	{
! 	  tree promise_cleanup = push_stmt_list ();
! 	  tree do_cleanup
! 	    = build1_loc (loc, TRUTH_NOT_EXPR, boolean_type_node, iarc_x);
! 	  do_cleanup = build2_loc (loc, TRUTH_AND_EXPR, boolean_type_node,
! 				   coro_before_return, do_cleanup);
! 	  r = build3 (COND_EXPR, void_type_node, do_cleanup,
! 		      promise_dtor, void_node);
! 	  finish_expr_stmt (r);
! 	  push_cleanup (p, pop_stmt_list (promise_cleanup), /*eh_only*/true);
! 	}
      }
  
    tree get_ro
*************** cp_coroutine_transform::build_ramp_funct
*** 5122,5129 ****
    /* Check for a bad get return object type.
       [dcl.fct.def.coroutine] / 7 requires:
       The expression promise.get_return_object() is used to initialize the
!      returned reference or prvalue result object ... */
!   tree gro_type = TREE_TYPE (get_ro);
    if (VOID_TYPE_P (gro_type) && !void_ramp_p)
      {
        error_at (fn_start, "no viable conversion from %<void%> provided by"
--- 5117,5127 ----
    /* Check for a bad get return object type.
       [dcl.fct.def.coroutine] / 7 requires:
       The expression promise.get_return_object() is used to initialize the
!      returned reference or prvalue result object ...
!      When we use a local to hold this, it is decltype(auto).  */
!   tree gro_type
!     = finish_decltype_type (get_ro, /*id_expression_or_member_access_p*/false,
! 			    tf_warning_or_error);
    if (VOID_TYPE_P (gro_type) && !void_ramp_p)
      {
        error_at (fn_start, "no viable conversion from %<void%> provided by"
*************** cp_coroutine_transform::build_ramp_funct
*** 5136,5304 ****
      (loc, coro_resume_index_id, short_unsigned_type_node,  orig_fn_decl,
       build_zero_cst (short_unsigned_type_node), deref_fp);
  
!   if (flag_exceptions && iarc_x)
!     {
!       r = cp_build_init_expr (iarc_x, boolean_false_node);
!       finish_expr_stmt (r);
!     }
! 
!   /* Used for return objects in the RESULT slot.  */
!   tree ret_val_dtor = NULL_TREE;
!   tree retval = NULL_TREE;
  
    /* [dcl.fct.def.coroutine] / 7
       The expression promise.get_return_object() is used to initialize the
       glvalue result or prvalue result object of a call to a coroutine.  */
  
!   /* We must manage the cleanups ourselves, because the responsibility for
!      them changes after the initial suspend.  However, any use of
!      cxx_maybe_build_cleanup () can set the throwing_cleanup flag.  */
!   cp_function_chain->throwing_cleanup = false;
    if (void_ramp_p)
      /* We still want to call the method, even if the result is unused.  */
!     r = get_ro;
    else
      {
!       /* The initial section of finish_return_expr ().  */
!       bool no_warning;
!       bool dangling;
!       /* Without a relevant location, bad conversions in check_return_expr
! 	 result in unusable diagnostics, since there is not even a mention
! 	 of the relevant function.  Here we carry out the first part of
! 	 finish_return_expr().  */
!       input_location = fn_start;
!       r = check_return_expr (get_ro, &no_warning, &dangling);
!       input_location = UNKNOWN_LOCATION;
!       gcc_checking_assert (!dangling);
!       /* Check for bad things.  */
!       if (!r || r == error_mark_node)
! 	return false;
!       if (!aggregate_value_p (fn_return_type, orig_fn_decl)
! 	  && TREE_CODE (r) == INIT_EXPR)
! 	{
! 	  /* If fn_return_type doesn't need to be returned in memory, normally
! 	     gimplify_return_expr redirects the INIT_EXPR to a temporary.  But
! 	     r isn't wrapped in the RETURN_EXPR, so we need to do the
! 	     redirection here as well.  See PR118874.  */
! 	  tree temp = create_temporary_var (fn_return_type);
! 	  add_decl_expr (temp);
! 	  retval = copy_node (r);
! 	  TREE_OPERAND (r, 0) = temp;
! 	  TREE_OPERAND (retval, 1) = temp;
! 	}
!       else
! 	retval = DECL_RESULT (orig_fn_decl);
!     }
! 
!   finish_expr_stmt (r);
  
!   if (TYPE_HAS_NONTRIVIAL_DESTRUCTOR (fn_return_type))
!     /* If some part of the initalization code (prior to the await_resume
!        of the initial suspend expression), then we need to clean up the
!        return value.  */
!     ret_val_dtor = cxx_maybe_build_cleanup (DECL_RESULT (orig_fn_decl),
! 					    tf_warning_or_error);
  
!   /* If we have a live g.r.o in the return slot, then signal this for exception
!      cleanup.  */
!   if (flag_exceptions && ret_val_dtor)
!     {
!       r = cp_build_init_expr (coro_gro_live, boolean_true_node);
        finish_expr_stmt (r);
      }
  
    /* Start the coroutine body.  */
    r = build_call_expr_loc (fn_start, resumer, 1, coro_fp);
    finish_expr_stmt (r);
  
-   /* The ramp is done, we just need the return statement, which we build from
-      the return object we constructed before we called the actor.  */
- 
-   r = retval;
- 
-   /* The reminder of finish_return_expr ().  */
-   r = build_stmt (loc, RETURN_EXPR, r);
-   r = maybe_cleanup_point_expr_void (r);
-   r = add_stmt (r);
- 
    if (flag_exceptions)
      {
!       finish_compound_stmt (ramp_try_stmts);
!       finish_try_block (ramp_try_block);
!       tree handler = begin_handler ();
!       finish_handler_parms (NULL_TREE, handler); /* catch (...) */
! 
!       /* If we have a live G.R.O in the return slot, then run its DTOR.  */
!       if (ret_val_dtor && ret_val_dtor != error_mark_node)
! 	{
! 	  tree gro_d_if = begin_if_stmt ();
! 	  finish_if_stmt_cond (coro_gro_live, gro_d_if);
! 	  finish_expr_stmt (ret_val_dtor);
! 	  finish_then_clause (gro_d_if);
! 	  finish_if_stmt (gro_d_if);
! 	}
! 
!       /* Before initial resume is called, the responsibility for cleanup on
! 	 exception falls to the ramp.  After that, the coroutine body code
! 	 should do the cleanup.  This is signalled by the flag
! 	 'initial_await_resume_called'.  */
! 
!       tree not_iarc
! 	= build1_loc (loc, TRUTH_NOT_EXPR, boolean_type_node, iarc_x);
!       tree cleanup_if = begin_if_stmt ();
!       finish_if_stmt_cond (not_iarc, cleanup_if);
!       /* If the promise is live, then run its dtor if that's available.  */
!       if (promise_dtor && promise_dtor != error_mark_node)
! 	{
! 	  tree promise_d_if = begin_if_stmt ();
! 	  finish_if_stmt_cond (coro_promise_live, promise_d_if);
! 	  finish_expr_stmt (promise_dtor);
! 	  finish_then_clause (promise_d_if);
! 	  finish_if_stmt (promise_d_if);
! 	}
! 
!       /* Clean up any frame copies of parms with non-trivial dtors.
! 	 Do this in reverse order from their creation.  */
!       auto_vec<param_info *> worklist;
!       if (DECL_ARGUMENTS (orig_fn_decl))
! 	for (tree arg = DECL_ARGUMENTS (orig_fn_decl); arg != NULL;
! 	     arg = DECL_CHAIN (arg))
! 	  {
! 	    param_info *parm_i = param_uses.get (arg);
! 	    if (parm_i->trivial_dtor)
! 	      continue;
! 	    worklist.safe_push (parm_i);
! 	  }
!       while (!worklist.is_empty ())
! 	{
! 	  param_info *parm_i = worklist.pop ();
! 	  if (parm_i->fr_copy_dtor && parm_i->fr_copy_dtor != error_mark_node)
! 	    {
! 	      tree dtor_if = begin_if_stmt ();
! 	      finish_if_stmt_cond (parm_i->guard_var, dtor_if);
! 	      finish_expr_stmt (parm_i->fr_copy_dtor);
! 	      finish_then_clause (dtor_if);
! 	      finish_if_stmt (dtor_if);
! 	    }
! 	}
  
!       /* No delete the frame if required.  */
!       tree fnf_if = begin_if_stmt ();
!       finish_if_stmt_cond (frame_needs_free, fnf_if);
!       finish_expr_stmt (delete_frame_call);
!       finish_then_clause (fnf_if);
!       finish_if_stmt (fnf_if);
  
!       /* Finished cleanups conditional on "initial resume is not called".  */
!       finish_then_clause (cleanup_if);
!       finish_if_stmt (cleanup_if);
  
-       tree rethrow = build_throw (loc, NULL_TREE, tf_warning_or_error);
-       suppress_warning (rethrow);
-       finish_expr_stmt (rethrow);
-       finish_handler (handler);
-       finish_handler_sequence (ramp_try_block);
-     }
    finish_compound_stmt (ramp_fnbody);
    return true;
  }
--- 5134,5189 ----
      (loc, coro_resume_index_id, short_unsigned_type_node,  orig_fn_decl,
       build_zero_cst (short_unsigned_type_node), deref_fp);
  
!   /* We must manage the cleanups ourselves, with the exception of the g_r_o,
!      because the responsibility for them changes after the initial suspend.
!      However, any use of cxx_maybe_build_cleanup () in preceding code can
!      set the throwing_cleanup flag.  */
!   cp_function_chain->throwing_cleanup = false;
  
    /* [dcl.fct.def.coroutine] / 7
       The expression promise.get_return_object() is used to initialize the
       glvalue result or prvalue result object of a call to a coroutine.  */
  
!   tree coro_gro = NULL_TREE;
    if (void_ramp_p)
      /* We still want to call the method, even if the result is unused.  */
!     finish_expr_stmt (get_ro);
    else
      {
!       /* Per CWG2563, we keep the result of promise.get_return_object () in
! 	 a temp which is then used to intialize the return object, including
! 	 NVRO.  */
  
!       /* Temporary var to hold the g_r_o across the function body.  */
!       coro_gro
! 	= coro_build_and_push_artificial_var (loc, "_Coro_gro", gro_type,
! 					      orig_fn_decl, NULL_TREE);
  
!       r = cp_build_init_expr (coro_gro, STRIP_REFERENCE_REF (get_ro));
        finish_expr_stmt (r);
+       tree coro_gro_cleanup
+ 	= cxx_maybe_build_cleanup (coro_gro, tf_warning_or_error);
+       if (coro_gro_cleanup)
+ 	push_cleanup (coro_gro, coro_gro_cleanup, /*eh_only*/false);
      }
  
    /* Start the coroutine body.  */
    r = build_call_expr_loc (fn_start, resumer, 1, coro_fp);
    finish_expr_stmt (r);
  
    if (flag_exceptions)
      {
!       r = cp_build_modify_expr (input_location, coro_before_return, NOP_EXPR,
! 				boolean_false_node, tf_warning_or_error);
!       finish_expr_stmt (r);
!     }
  
!   /* The ramp is done, we just need the return statement, which we build from
!      the return object we constructed before we called the actor.  */
  
!   r = void_ramp_p ? NULL_TREE : convert_from_reference (coro_gro);
!   finish_return_stmt (r);
  
    finish_compound_stmt (ramp_fnbody);
    return true;
  }
diff -Nrcpad gcc-16-20250518/gcc/cp/cp-gimplify.cc gcc-16-20250525/gcc/cp/cp-gimplify.cc
*** gcc-16-20250518/gcc/cp/cp-gimplify.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/cp-gimplify.cc	Sun May 25 22:32:06 2025
*************** cp_fold (tree x, fold_flags_t flags)
*** 3441,3447 ****
  	   Do constexpr expansion of expressions where the call itself is not
  	   constant, but the call followed by an INDIRECT_REF is.  */
  	if (callee && DECL_DECLARED_CONSTEXPR_P (callee)
! 	    && !flag_no_inline)
  	  {
  	    mce_value manifestly_const_eval = mce_unknown;
  	    if (flags & ff_mce_false)
--- 3441,3449 ----
  	   Do constexpr expansion of expressions where the call itself is not
  	   constant, but the call followed by an INDIRECT_REF is.  */
  	if (callee && DECL_DECLARED_CONSTEXPR_P (callee)
! 	    && (!flag_no_inline
! 		|| lookup_attribute ("always_inline",
! 				     DECL_ATTRIBUTES (callee))))
  	  {
  	    mce_value manifestly_const_eval = mce_unknown;
  	    if (flags & ff_mce_false)
diff -Nrcpad gcc-16-20250518/gcc/cp/decl2.cc gcc-16-20250525/gcc/cp/decl2.cc
*** gcc-16-20250518/gcc/cp/decl2.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/decl2.cc	Sun May 25 22:32:06 2025
*************** get_tls_init_fn (tree var)
*** 4028,4033 ****
--- 4028,4034 ----
        SET_DECL_LANGUAGE (fn, lang_c);
        TREE_PUBLIC (fn) = TREE_PUBLIC (var);
        DECL_ARTIFICIAL (fn) = true;
+       DECL_CONTEXT (fn) = FROB_CONTEXT (global_namespace);
        DECL_COMDAT (fn) = DECL_COMDAT (var);
        DECL_EXTERNAL (fn) = DECL_EXTERNAL (var);
        if (DECL_ONE_ONLY (var))
*************** get_tls_wrapper_fn (tree var)
*** 4087,4093 ****
        TREE_PUBLIC (fn) = TREE_PUBLIC (var);
        DECL_ARTIFICIAL (fn) = true;
        DECL_IGNORED_P (fn) = 1;
!       DECL_CONTEXT (fn) = DECL_CONTEXT (var);
        /* The wrapper is inline and emitted everywhere var is used.  */
        DECL_DECLARED_INLINE_P (fn) = true;
        if (TREE_PUBLIC (var))
--- 4088,4094 ----
        TREE_PUBLIC (fn) = TREE_PUBLIC (var);
        DECL_ARTIFICIAL (fn) = true;
        DECL_IGNORED_P (fn) = 1;
!       DECL_CONTEXT (fn) = FROB_CONTEXT (global_namespace);
        /* The wrapper is inline and emitted everywhere var is used.  */
        DECL_DECLARED_INLINE_P (fn) = true;
        if (TREE_PUBLIC (var))
diff -Nrcpad gcc-16-20250518/gcc/cp/error.cc gcc-16-20250525/gcc/cp/error.cc
*** gcc-16-20250518/gcc/cp/error.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/error.cc	Sun May 25 22:32:06 2025
*************** dump_template_bindings (cxx_pretty_print
*** 541,552 ****
  	  /* If the template argument repeats the template parameter (T = T),
  	     skip the parameter.*/
  	  if (arg && TREE_CODE (arg) == TEMPLATE_TYPE_PARM
! 		&& TREE_CODE (parm_i) == TREE_LIST
! 		&& TREE_CODE (TREE_VALUE (parm_i)) == TYPE_DECL
! 		&& TREE_CODE (TREE_TYPE (TREE_VALUE (parm_i)))
! 		     == TEMPLATE_TYPE_PARM
! 		&& DECL_NAME (TREE_VALUE (parm_i))
! 		     == DECL_NAME (TREE_CHAIN (arg)))
  	    continue;
  
  	  semicolon_or_introducer ();
--- 541,553 ----
  	  /* If the template argument repeats the template parameter (T = T),
  	     skip the parameter.*/
  	  if (arg && TREE_CODE (arg) == TEMPLATE_TYPE_PARM
! 	      && arg == TYPE_MAIN_VARIANT (arg)
! 	      && TREE_CODE (parm_i) == TREE_LIST
! 	      && TREE_CODE (TREE_VALUE (parm_i)) == TYPE_DECL
! 	      && (TREE_CODE (TREE_TYPE (TREE_VALUE (parm_i)))
! 		  == TEMPLATE_TYPE_PARM)
! 	      && (DECL_NAME (TREE_VALUE (parm_i))
! 		  == DECL_NAME (TYPE_STUB_DECL (arg))))
  	    continue;
  
  	  semicolon_or_introducer ();
diff -Nrcpad gcc-16-20250518/gcc/cp/mangle.cc gcc-16-20250525/gcc/cp/mangle.cc
*** gcc-16-20250518/gcc/cp/mangle.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/mangle.cc	Sun May 25 22:32:06 2025
*************** static tree
*** 4452,4474 ****
  mangle_decl_string (const tree decl)
  {
    tree result;
!   tree saved_fn = NULL_TREE;
!   bool template_p = false;
  
    /* We shouldn't be trying to mangle an uninstantiated template.  */
    gcc_assert (!type_dependent_expression_p (decl));
  
!   if (DECL_LANG_SPECIFIC (decl) && DECL_USE_TEMPLATE (decl))
!     {
!       struct tinst_level *tl = current_instantiation ();
!       if ((!tl || tl->maybe_get_node () != decl)
! 	  && push_tinst_level (decl))
! 	{
! 	  template_p = true;
! 	  saved_fn = current_function_decl;
! 	  current_function_decl = NULL_TREE;
! 	}
!     }
    iloc_sentinel ils (DECL_SOURCE_LOCATION (decl));
  
    start_mangling (decl);
--- 4452,4463 ----
  mangle_decl_string (const tree decl)
  {
    tree result;
!   tree saved_fn = current_function_decl;
  
    /* We shouldn't be trying to mangle an uninstantiated template.  */
    gcc_assert (!type_dependent_expression_p (decl));
  
!   current_function_decl = NULL_TREE;
    iloc_sentinel ils (DECL_SOURCE_LOCATION (decl));
  
    start_mangling (decl);
*************** mangle_decl_string (const tree decl)
*** 4483,4494 ****
      fprintf (stderr, "mangle_decl_string = '%s'\n\n",
  	     IDENTIFIER_POINTER (result));
  
!   if (template_p)
!     {
!       pop_tinst_level ();
!       current_function_decl = saved_fn;
!     }
! 
    return result;
  }
  
--- 4472,4478 ----
      fprintf (stderr, "mangle_decl_string = '%s'\n\n",
  	     IDENTIFIER_POINTER (result));
  
!   current_function_decl = saved_fn;
    return result;
  }
  
diff -Nrcpad gcc-16-20250518/gcc/cp/module.cc gcc-16-20250525/gcc/cp/module.cc
*** gcc-16-20250518/gcc/cp/module.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/module.cc	Sun May 25 22:32:06 2025
*************** trees_out::core_bools (tree t, bits_out&
*** 5724,5732 ****
  	   DECL_NOT_REALLY_EXTERN -> base.not_really_extern
  	     == that was a lie, it is here  */
  
- 	/* decl_flag_1 is DECL_EXTERNAL. Things we emit here, might
- 	   well be external from the POV of an importer.  */
  	bool is_external = t->decl_common.decl_flag_1;
  	if (!is_external
  	    && VAR_OR_FUNCTION_DECL_P (t)
  	    && get_importer_interface (t) == importer_interface::external)
--- 5724,5736 ----
  	   DECL_NOT_REALLY_EXTERN -> base.not_really_extern
  	     == that was a lie, it is here  */
  
  	bool is_external = t->decl_common.decl_flag_1;
+ 	/* maybe_emit_vtables relies on vtables being marked as
+ 	   DECL_EXTERNAL and DECL_NOT_REALLY_EXTERN before processing.  */
+ 	if (!is_external && VAR_P (t) && DECL_VTABLE_OR_VTT_P (t))
+ 	  is_external = true;
+ 	/* Things we emit here might well be external from the POV of an
+ 	   importer.  */
  	if (!is_external
  	    && VAR_OR_FUNCTION_DECL_P (t)
  	    && get_importer_interface (t) == importer_interface::external)
*************** trees_in::install_entity (tree decl)
*** 8083,8100 ****
        gcc_checking_assert (!existed);
        slot = ident;
      }
!   else if (state->is_partition ())
      {
-       /* The decl is already in the entity map, but we see it again now from a
- 	 partition: we want to overwrite if the original decl wasn't also from
- 	 a (possibly different) partition.  Otherwise, for things like template
- 	 instantiations, make_dependency might not realise that this is also
- 	 provided from a partition and should be considered part of this module
- 	 (and thus always emitted into the primary interface's CMI).  */
        unsigned *slot = entity_map->get (DECL_UID (decl));
!       module_state *imp = import_entity_module (*slot);
!       if (!imp->is_partition ())
! 	*slot = ident;
      }
  
    return true;
--- 8087,8123 ----
        gcc_checking_assert (!existed);
        slot = ident;
      }
!   else
      {
        unsigned *slot = entity_map->get (DECL_UID (decl));
! 
!       /* The entity must be in the entity map already.  However, DECL may
! 	 be the DECL_TEMPLATE_RESULT of an existing partial specialisation
! 	 if we matched it while streaming another instantiation; in this
! 	 case we already registered that TEMPLATE_DECL.  */
!       if (!slot)
! 	{
! 	  tree type = TREE_TYPE (decl);
! 	  gcc_checking_assert (TREE_CODE (decl) == TYPE_DECL
! 			       && CLASS_TYPE_P (type)
! 			       && CLASSTYPE_TEMPLATE_SPECIALIZATION (type));
! 	  slot = entity_map->get (DECL_UID (CLASSTYPE_TI_TEMPLATE (type)));
! 	}
!       gcc_checking_assert (slot);
! 
!       if (state->is_partition ())
! 	{
! 	  /* The decl is already in the entity map, but we see it again now
! 	     from a partition: we want to overwrite if the original decl
! 	     wasn't also from a (possibly different) partition.  Otherwise,
! 	     for things like template instantiations, make_dependency might
! 	     not realise that this is also provided from a partition and
! 	     should be considered part of this module (and thus always
! 	     emitted into the primary interface's CMI).  */
! 	  module_state *imp = import_entity_module (*slot);
! 	  if (!imp->is_partition ())
! 	    *slot = ident;
! 	}
      }
  
    return true;
*************** trees_in::tree_node (bool is_use)
*** 10489,10495 ****
  	      res = lookup_field_ident (ctx, u ());
  
  	    if (!res
! 		|| TREE_CODE (res) != FIELD_DECL
  		|| DECL_CONTEXT (res) != ctx)
  	      res = NULL_TREE;
  	  }
--- 10512,10519 ----
  	      res = lookup_field_ident (ctx, u ());
  
  	    if (!res
! 		|| (TREE_CODE (res) != FIELD_DECL
! 		    && TREE_CODE (res) != USING_DECL)
  		|| DECL_CONTEXT (res) != ctx)
  	      res = NULL_TREE;
  	  }
diff -Nrcpad gcc-16-20250518/gcc/cp/rtti.cc gcc-16-20250525/gcc/cp/rtti.cc
*** gcc-16-20250518/gcc/cp/rtti.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/cp/rtti.cc	Sun May 25 22:32:06 2025
*************** get_tinfo_decl_direct (tree type, tree n
*** 468,473 ****
--- 468,474 ----
        DECL_IGNORED_P (d) = 1;
        TREE_READONLY (d) = 1;
        TREE_STATIC (d) = 1;
+       TREE_ADDRESSABLE (d) = 1;
        /* Tell equal_address_to that different tinfo decls never
  	 overlap.  */
        if (vec_safe_is_empty (unemitted_tinfo_decls))
diff -Nrcpad gcc-16-20250518/gcc/doc/extend.texi gcc-16-20250525/gcc/doc/extend.texi
*** gcc-16-20250518/gcc/doc/extend.texi	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/doc/extend.texi	Sun May 25 22:32:06 2025
*************** Enable/disable the generation of the USE
*** 6684,6706 ****
  Enable/disable the generation of the APX features, including
  EGPR, PUSH2POP2, NDD and PPX.
  
- @cindex @code{target("avx10.1-256")} function attribute, x86
- @item avx10.1-256
- @itemx no-avx10.1-256
- Enable the generation of the AVX10.1 instructions with 256 bit support.
- Disable the generation of the AVX10.1 instructions.
- 
  @cindex @code{target("avx10.1")} function attribute, x86
  @item avx10.1
  @itemx no-avx10.1
! Enable the generation of the AVX10.1 instructions with 512 bit support.
! Disable the generation of the AVX10.1 instructions.
! 
! @cindex @code{target("avx10.1-512")} function attribute, x86
! @item avx10.1-512
! @itemx no-avx10.1-512
! Enable the generation of the AVX10.1 instructions with 512 bit support.
! Disable the generation of the AVX10.1 instructions.
  
  @cindex @code{target("avx10.2")} function attribute, x86
  @item avx10.2
--- 6684,6693 ----
  Enable/disable the generation of the APX features, including
  EGPR, PUSH2POP2, NDD and PPX.
  
  @cindex @code{target("avx10.1")} function attribute, x86
  @item avx10.1
  @itemx no-avx10.1
! Enable/Disable the generation of the AVX10.1 instructions.
  
  @cindex @code{target("avx10.2")} function attribute, x86
  @item avx10.2
diff -Nrcpad gcc-16-20250518/gcc/doc/implement-c.texi gcc-16-20250525/gcc/doc/implement-c.texi
*** gcc-16-20250518/gcc/doc/implement-c.texi	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/doc/implement-c.texi	Sun May 25 22:32:06 2025
*************** A conforming implementation of ISO C is
*** 10,17 ****
  choice of behavior in each of the areas that are designated
  ``implementation defined''.  The following lists all such areas,
  along with the section numbers from the ISO/IEC 9899:1990, ISO/IEC
! 9899:1999 and ISO/IEC 9899:2011 standards.  Some areas are only
! implementation-defined in one version of the standard.
  
  Some choices depend on the externally determined ABI for the platform
  (including standard character encodings) which GCC follows; these are
--- 10,17 ----
  choice of behavior in each of the areas that are designated
  ``implementation defined''.  The following lists all such areas,
  along with the section numbers from the ISO/IEC 9899:1990, ISO/IEC
! 9899:1999, ISO/IEC 9899:2011 and ISO/IEC 9899:2024 standards.  Some
! areas are only implementation-defined in one version of the standard.
  
  Some choices depend on the externally determined ABI for the platform
  (including standard character encodings) which GCC follows; these are
*************** a freestanding environment); refer to th
*** 30,39 ****
--- 30,41 ----
  * Characters implementation::
  * Integers implementation::
  * Floating point implementation::
+ * Constant expressions implementation::
  * Arrays and pointers implementation::
  * Hints implementation::
  * Structures unions enumerations and bit-fields implementation::
  * Qualifiers implementation::
+ * Types implementation::
  * Declarators implementation::
  * Statements implementation::
  * Preprocessing directives implementation::
*************** a freestanding environment); refer to th
*** 47,61 ****
  
  @itemize @bullet
  @item
! @cite{How a diagnostic is identified (C90 3.7, C99 and C11 3.10, C90,
! C99 and C11 5.1.1.3).}
  
  Diagnostics consist of all the output sent to stderr by GCC@.
  
  @item
  @cite{Whether each nonempty sequence of white-space characters other than
  new-line is retained or replaced by one space character in translation
! phase 3 (C90, C99 and C11 5.1.1.2).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
--- 49,63 ----
  
  @itemize @bullet
  @item
! @cite{How a diagnostic is identified (C90 3.7, C99 and C11 3.10, C23
! 3.13, C90, C99 and C11 5.1.1.3, C23 5.2.1.3).}
  
  Diagnostics consist of all the output sent to stderr by GCC@.
  
  @item
  @cite{Whether each nonempty sequence of white-space characters other than
  new-line is retained or replaced by one space character in translation
! phase 3 (C90, C99 and C11 5.1.1.2, C23 5.2.1.2).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
*************** of the C library, and are not defined by
*** 72,78 ****
  @item
  @cite{The mapping between physical source file multibyte characters
  and the source character set in translation phase 1 (C90, C99 and C11
! 5.1.1.2).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
--- 74,80 ----
  @item
  @cite{The mapping between physical source file multibyte characters
  and the source character set in translation phase 1 (C90, C99 and C11
! 5.1.1.2, C23 5.2.1.2).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
*************** behavior, cpp, The C Preprocessor}.
*** 85,98 ****
  @itemize @bullet
  @item
  @cite{Which additional multibyte characters may appear in identifiers
! and their correspondence to universal character names (C99 and C11 6.4.2).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
  
  @item
  @cite{The number of significant initial characters in an identifier
! (C90 6.1.2, C90, C99 and C11 5.2.4.1, C99 and C11 6.4.2).}
  
  For internal names, all characters are significant.  For external names,
  the number of significant characters are defined by the linker; for
--- 87,102 ----
  @itemize @bullet
  @item
  @cite{Which additional multibyte characters may appear in identifiers
! and their correspondence to universal character names (C99 and C11
! 6.4.2, C23 6.4.3).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
  
  @item
  @cite{The number of significant initial characters in an identifier
! (C90 6.1.2, C90, C99 and C11 5.2.4.1, C23 5.3.5.2, C99 and C11 6.4.2,
! C23 6.4.3).}
  
  For internal names, all characters are significant.  For external names,
  the number of significant characters are defined by the linker; for
*************** almost all targets, all characters are s
*** 102,108 ****
  @cite{Whether case distinctions are significant in an identifier with
  external linkage (C90 6.1.2).}
  
! This is a property of the linker.  C99 and C11 require that case distinctions
  are always significant in identifiers with external linkage and
  systems without this property are not supported by GCC@.
  
--- 106,112 ----
  @cite{Whether case distinctions are significant in an identifier with
  external linkage (C90 6.1.2).}
  
! This is a property of the linker.  C99 and later require that case distinctions
  are always significant in identifiers with external linkage and
  systems without this property are not supported by GCC@.
  
*************** systems without this property are not su
*** 113,146 ****
  
  @itemize @bullet
  @item
! @cite{The number of bits in a byte (C90 3.4, C99 and C11 3.6).}
  
  Determined by ABI@.
  
  @item
  @cite{The values of the members of the execution character set (C90,
! C99 and C11 5.2.1).}
  
  Determined by ABI@.
  
  @item
  @cite{The unique value of the member of the execution character set produced
  for each of the standard alphabetic escape sequences (C90, C99 and C11
! 5.2.2).}
  
  Determined by ABI@.
  
  @item
  @cite{The value of a @code{char} object into which has been stored any
  character other than a member of the basic execution character set
! (C90 6.1.2.5, C99 and C11 6.2.5).}
  
  Determined by ABI@.
  
  @item
  @cite{Which of @code{signed char} or @code{unsigned char} has the same
  range, representation, and behavior as ``plain'' @code{char} (C90
! 6.1.2.5, C90 6.2.1.1, C99 and C11 6.2.5, C99 and C11 6.3.1.1).}
  
  @opindex fsigned-char
  @opindex funsigned-char
--- 117,151 ----
  
  @itemize @bullet
  @item
! @cite{The number of bits in a byte (C90 3.4, C99 and C11 3.6, C23 3.7).}
  
  Determined by ABI@.
  
  @item
  @cite{The values of the members of the execution character set (C90,
! C99 and C11 5.2.1, C23 5.3.1).}
  
  Determined by ABI@.
  
  @item
  @cite{The unique value of the member of the execution character set produced
  for each of the standard alphabetic escape sequences (C90, C99 and C11
! 5.2.2, C23 5.3.3).}
  
  Determined by ABI@.
  
  @item
  @cite{The value of a @code{char} object into which has been stored any
  character other than a member of the basic execution character set
! (C90 6.1.2.5, C99, C11 and C23 6.2.5).}
  
  Determined by ABI@.
  
  @item
  @cite{Which of @code{signed char} or @code{unsigned char} has the same
  range, representation, and behavior as ``plain'' @code{char} (C90
! 6.1.2.5, C90 6.2.1.1, C99, C11 and C23 6.2.5, C99 and C11 6.3.1.1, C23
! 6.3.2.1).}
  
  @opindex fsigned-char
  @opindex funsigned-char
*************** Determined by ABI@.  The options @option
*** 149,164 ****
  Options Controlling C Dialect}.
  
  @item
  @cite{The mapping of members of the source character set (in character
  constants and string literals) to members of the execution character
! set (C90 6.1.3.4, C99 and C11 6.4.4.4, C90, C99 and C11 5.1.1.2).}
  
  Determined by ABI@.
  
  @item
  @cite{The value of an integer character constant containing more than one
  character or containing a character or escape sequence that does not map
! to a single-byte execution character (C90 6.1.3.4, C99 and C11 6.4.4.4).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
--- 154,185 ----
  Options Controlling C Dialect}.
  
  @item
+ @cite{The literal encoding, which maps of the characters of the
+ execution character set to the values in a character constant or
+ string literal (C23 6.2.9, C23 6.4.5.5).}
+ 
+ Determined by ABI@.
+ 
+ @item
+ @cite{The wide literal encoding, of the characters of the execution
+ character set to the values in a @code{wchar_t} character constant or
+ @code{wchar_t} string literal (C23 6.2.9, C23 6.4.5.5).}
+ 
+ Determined by ABI@.
+ 
+ @item
  @cite{The mapping of members of the source character set (in character
  constants and string literals) to members of the execution character
! set (C90 6.1.3.4, C99 and C11 6.4.4.4, C23 6.4.5.5, C90, C99 and C11
! 5.1.1.2, C23 5.2.1.2).}
  
  Determined by ABI@.
  
  @item
  @cite{The value of an integer character constant containing more than one
  character or containing a character or escape sequence that does not map
! to a single-byte execution character (C90 6.1.3.4, C99 and C11
! 6.4.4.4, C23 6.4.5.5).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
*************** multibyte character or a single multibyt
*** 169,175 ****
  multiple members of the extended execution character set, or
  containing a multibyte character or escape sequence not represented in
  the extended execution character set (C90 6.1.3.4, C99 and C11
! 6.4.4.4).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
--- 190,196 ----
  multiple members of the extended execution character set, or
  containing a multibyte character or escape sequence not represented in
  the extended execution character set (C90 6.1.3.4, C99 and C11
! 6.4.4.4, C23 6.4.5.5).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
*************** behavior, cpp, The C Preprocessor}.
*** 178,184 ****
  @cite{The current locale used to convert a wide character constant consisting
  of a single multibyte character that maps to a member of the extended
  execution character set into a corresponding wide character code (C90
! 6.1.3.4, C99 and C11 6.4.4.4).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
--- 199,205 ----
  @cite{The current locale used to convert a wide character constant consisting
  of a single multibyte character that maps to a member of the extended
  execution character set into a corresponding wide character code (C90
! 6.1.3.4, C99 and C11 6.4.4.4, C23 6.4.5.5).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
*************** Such tokens may not be concatenated.
*** 192,198 ****
  
  @item
  @cite{The current locale used to convert a wide string literal into
! corresponding wide character codes (C90 6.1.4, C99 and C11 6.4.5).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
--- 213,219 ----
  
  @item
  @cite{The current locale used to convert a wide string literal into
! corresponding wide character codes (C90 6.1.4, C99 and C11 6.4.5, C23 6.4.6).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
*************** behavior, cpp, The C Preprocessor}.
*** 200,206 ****
  @item
  @cite{The value of a string literal containing a multibyte character or escape
  sequence not represented in the execution character set (C90 6.1.4,
! C99 and C11 6.4.5).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
--- 221,227 ----
  @item
  @cite{The value of a string literal containing a multibyte character or escape
  sequence not represented in the execution character set (C90 6.1.4,
! C99 and C11 6.4.5, C23 6.4.6).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.
*************** behavior, cpp, The C Preprocessor}.
*** 209,215 ****
  @cite{The encoding of any of @code{wchar_t}, @code{char16_t}, and
  @code{char32_t} where the corresponding standard encoding macro
  (@code{__STDC_ISO_10646__}, @code{__STDC_UTF_16__}, or
! @code{__STDC_UTF_32__}) is not defined (C11 6.10.8.2).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.  @code{char16_t} and
--- 230,236 ----
  @cite{The encoding of any of @code{wchar_t}, @code{char16_t}, and
  @code{char32_t} where the corresponding standard encoding macro
  (@code{__STDC_ISO_10646__}, @code{__STDC_UTF_16__}, or
! @code{__STDC_UTF_32__}) is not defined (C11 6.10.8.2, C23 6.10.10.3).}
  
  @xref{Implementation-defined behavior, , Implementation-defined
  behavior, cpp, The C Preprocessor}.  @code{char16_t} and
*************** respectively.
*** 223,230 ****
  
  @itemize @bullet
  @item
! @cite{Any extended integer types that exist in the implementation (C99
! and C11 6.2.5).}
  
  GCC does not support any extended integer types.
  @c The __mode__ attribute might create types of precisions not
--- 244,251 ----
  
  @itemize @bullet
  @item
! @cite{Any extended integer types that exist in the implementation (C99,
! C11 and C23 6.2.5).}
  
  GCC does not support any extended integer types.
  @c The __mode__ attribute might create types of precisions not
*************** two's complement, or one's complement, a
*** 240,250 ****
  is a trap representation or an ordinary value (C99 and C11 6.2.6.2).}
  
  GCC supports only two's complement integer types, and all bit patterns
! are ordinary values.
  
  @item
  @cite{The rank of any extended integer type relative to another extended
! integer type with the same precision (C99 and C11 6.3.1.1).}
  
  GCC does not support any extended integer types.
  @c If it did, there would only be one of each precision and signedness.
--- 261,272 ----
  is a trap representation or an ordinary value (C99 and C11 6.2.6.2).}
  
  GCC supports only two's complement integer types, and all bit patterns
! are ordinary values.  C23 requires signed integer types to be two's
! complement.
  
  @item
  @cite{The rank of any extended integer type relative to another extended
! integer type with the same precision (C99 and C11 6.3.1.1, C23 6.3.2.1).}
  
  GCC does not support any extended integer types.
  @c If it did, there would only be one of each precision and signedness.
*************** GCC does not support any extended intege
*** 252,265 ****
  @item
  @cite{The result of, or the signal raised by, converting an integer to a
  signed integer type when the value cannot be represented in an object of
! that type (C90 6.2.1.2, C99 and C11 6.3.1.3).}
  
  For conversion to a type of width @math{N}, the value is reduced
  modulo @math{2^N} to be within range of the type; no signal is raised.
  
  @item
  @cite{The results of some bitwise operations on signed integers (C90
! 6.3, C99 and C11 6.5).}
  
  Bitwise operators act on the representation of the value including
  both the sign and value bits, where the sign bit is considered
--- 274,287 ----
  @item
  @cite{The result of, or the signal raised by, converting an integer to a
  signed integer type when the value cannot be represented in an object of
! that type (C90 6.2.1.2, C99 and C11 6.3.1.3, C23 6.3.2.3).}
  
  For conversion to a type of width @math{N}, the value is reduced
  modulo @math{2^N} to be within range of the type; no signal is raised.
  
  @item
  @cite{The results of some bitwise operations on signed integers (C90
! 6.3, C99 and C11 6.5, C23 6.5.1).}
  
  Bitwise operators act on the representation of the value including
  both the sign and value bits, where the sign bit is considered
*************** immediately above the highest-value valu
*** 267,273 ****
  on negative numbers by sign extension.
  
  As an extension to the C language, GCC does not use the latitude given in
! C99 and C11 only to treat certain aspects of signed @samp{<<} as undefined.
  However, @option{-fsanitize=shift} (and @option{-fsanitize=undefined}) will
  diagnose such cases.  They are also diagnosed where constant
  expressions are required.
--- 289,295 ----
  on negative numbers by sign extension.
  
  As an extension to the C language, GCC does not use the latitude given in
! C99 and later to treat certain aspects of signed @samp{<<} as undefined.
  However, @option{-fsanitize=shift} (and @option{-fsanitize=undefined}) will
  diagnose such cases.  They are also diagnosed where constant
  expressions are required.
*************** expressions are required.
*** 275,281 ****
  @item
  @cite{The sign of the remainder on integer division (C90 6.3.5).}
  
! GCC always follows the C99 and C11 requirement that the result of division is
  truncated towards zero.
  
  @end itemize
--- 297,303 ----
  @item
  @cite{The sign of the remainder on integer division (C90 6.3.5).}
  
! GCC always follows the C99 and later requirement that the result of division is
  truncated towards zero.
  
  @end itemize
*************** truncated towards zero.
*** 287,320 ****
  @item
  @cite{The accuracy of the floating-point operations and of the library
  functions in @code{<math.h>} and @code{<complex.h>} that return floating-point
! results (C90, C99 and C11 5.2.4.2.2).}
  
  The accuracy is unknown.
  
  @item
  @cite{The rounding behaviors characterized by non-standard values
  of @code{FLT_ROUNDS}
! (C90, C99 and C11 5.2.4.2.2).}
  
  GCC does not use such values.
  
  @item
  @cite{The evaluation methods characterized by non-standard negative
! values of @code{FLT_EVAL_METHOD} (C99 and C11 5.2.4.2.2).}
  
  GCC does not use such values.
  
  @item
  @cite{The direction of rounding when an integer is converted to a
  floating-point number that cannot exactly represent the original
! value (C90 6.2.1.3, C99 and C11 6.3.1.4).}
  
  C99 Annex F is followed.
  
  @item
  @cite{The direction of rounding when a floating-point number is
  converted to a narrower floating-point number (C90 6.2.1.4, C99 and C11
! 6.3.1.5).}
  
  C99 Annex F is followed.
  
--- 309,354 ----
  @item
  @cite{The accuracy of the floating-point operations and of the library
  functions in @code{<math.h>} and @code{<complex.h>} that return floating-point
! results (C90, C99 and C11 5.2.4.2.2, C23 5.3.5.3.3).}
  
  The accuracy is unknown.
  
  @item
  @cite{The rounding behaviors characterized by non-standard values
  of @code{FLT_ROUNDS}
! (C90, C99 and C11 5.2.4.2.2, C23 5.3.5.3.3).}
  
  GCC does not use such values.
  
  @item
  @cite{The evaluation methods characterized by non-standard negative
! values of @code{FLT_EVAL_METHOD} (C99 and C11 5.2.4.2.2, C23 5.3.5.3.3).}
  
  GCC does not use such values.
  
  @item
+ @cite{The evaluation methods characterized by non-standard negative
+ values of @code{DEC_EVAL_METHOD} (C23 5.3.5.3.4).}
+ 
+ GCC does not use such values.
+ 
+ @item
+ @cite{If decimal floating types are supported (C23 6.2.5).}
+ 
+ These are supported for certain AArch64, i386, x86-64, PowerPC and
+ S/390 targets only.
+ 
+ @item
  @cite{The direction of rounding when an integer is converted to a
  floating-point number that cannot exactly represent the original
! value (C90 6.2.1.3, C99 and C11 6.3.1.4, C23 6.3.2.4).}
  
  C99 Annex F is followed.
  
  @item
  @cite{The direction of rounding when a floating-point number is
  converted to a narrower floating-point number (C90 6.2.1.4, C99 and C11
! 6.3.1.5, C23 6.3.2.5).}
  
  C99 Annex F is followed.
  
*************** C99 Annex F is followed.
*** 322,334 ****
  @cite{How the nearest representable value or the larger or smaller
  representable value immediately adjacent to the nearest representable
  value is chosen for certain floating constants (C90 6.1.3.1, C99 and C11
! 6.4.4.2).}
  
  C99 Annex F is followed.
  
  @item
  @cite{Whether and how floating expressions are contracted when not
! disallowed by the @code{FP_CONTRACT} pragma (C99 and C11 6.5).}
  
  Expressions are currently only contracted if @option{-ffp-contract=fast},
  @option{-funsafe-math-optimizations} or @option{-ffast-math} are used.
--- 356,369 ----
  @cite{How the nearest representable value or the larger or smaller
  representable value immediately adjacent to the nearest representable
  value is chosen for certain floating constants (C90 6.1.3.1, C99 and C11
! 6.4.4.2, C23 6.4.5.3).}
  
  C99 Annex F is followed.
  
  @item
  @cite{Whether and how floating expressions are contracted when not
! disallowed by the @code{FP_CONTRACT} pragma (C99 and C11 6.5, C23
! 6.5.1).}
  
  Expressions are currently only contracted if @option{-ffp-contract=fast},
  @option{-funsafe-math-optimizations} or @option{-ffast-math} are used.
*************** This is subject to change.
*** 336,342 ****
  
  @item
  @cite{The default state for the @code{FENV_ACCESS} pragma (C99 and C11
! 7.6.1).}
  
  This pragma is not implemented, but the default is to ``off'' unless
  @option{-frounding-math} is used and @option{-fno-trapping-math} is not
--- 371,377 ----
  
  @item
  @cite{The default state for the @code{FENV_ACCESS} pragma (C99 and C11
! 7.6.1, C23 7.6.2).}
  
  This pragma is not implemented, but the default is to ``off'' unless
  @option{-frounding-math} is used and @option{-fno-trapping-math} is not
*************** in which case it is ``on''.
*** 344,358 ****
  
  @item
  @cite{Additional floating-point exceptions, rounding modes, environments,
! and classifications, and their macro names (C99 and C11 7.6, C99 and
! C11 7.12).}
  
  This is dependent on the implementation of the C library, and is not
  defined by GCC itself.
  
  @item
  @cite{The default state for the @code{FP_CONTRACT} pragma (C99 and C11
! 7.12.2).}
  
  This pragma is not implemented.  Expressions are currently only
  contracted if @option{-ffp-contract=fast},
--- 379,393 ----
  
  @item
  @cite{Additional floating-point exceptions, rounding modes, environments,
! and classifications, and their macro names (C99, C11 and C23 7.6, C99,
! C11 and C23 7.12).}
  
  This is dependent on the implementation of the C library, and is not
  defined by GCC itself.
  
  @item
  @cite{The default state for the @code{FP_CONTRACT} pragma (C99 and C11
! 7.12.2, C23 7.12.3).}
  
  This pragma is not implemented.  Expressions are currently only
  contracted if @option{-ffp-contract=fast},
*************** defined by GCC itself.
*** 377,389 ****
  
  @end itemize
  
  @node Arrays and pointers implementation
  @section Arrays and Pointers
  
  @itemize @bullet
  @item
  @cite{The result of converting a pointer to an integer or
! vice versa (C90 6.3.4, C99 and C11 6.3.2.3).}
  
  A cast from pointer to integer discards most-significant bits if the
  pointer representation is larger than the integer type,
--- 412,443 ----
  
  @end itemize
  
+ @node Constant expressions implementation
+ @section Constant expressions
+ 
+ @itemize @bullet
+ @item
+ @cite{Whether or not an expression not explicitly sanctioned by this
+ document is an extended constant expression, whether or not such
+ extended constant expressions can be used in the same contexts as this
+ document, and whether or not such extended constant expressions can
+ affect potentially detectable semantic changes in the program (C23
+ 6.6).}
+ 
+ The only extended constant expressions are those using other GNU
+ extensions to the C language.  Such extended constant expressions
+ include integer constant expressions and arithmetic constant
+ expressions.
+ 
+ @end itemize
+ 
  @node Arrays and pointers implementation
  @section Arrays and Pointers
  
  @itemize @bullet
  @item
  @cite{The result of converting a pointer to an integer or
! vice versa (C90 6.3.4, C99 and C11 6.3.2.3, C23 6.3.3.3).}
  
  A cast from pointer to integer discards most-significant bits if the
  pointer representation is larger than the integer type,
*************** C99 and C11 6.5.6/8.
*** 410,416 ****
  
  @item
  @cite{The size of the result of subtracting two pointers to elements
! of the same array (C90 6.3.6, C99 and C11 6.5.6).}
  
  The value is as specified in the standard and the type is determined
  by the ABI@.
--- 464,470 ----
  
  @item
  @cite{The size of the result of subtracting two pointers to elements
! of the same array (C90 6.3.6, C99 and C11 6.5.6, C23 6.5.7).}
  
  The value is as specified in the standard and the type is determined
  by the ABI@.
*************** by the ABI@.
*** 423,429 ****
  @itemize @bullet
  @item
  @cite{The extent to which suggestions made by using the @code{register}
! storage-class specifier are effective (C90 6.5.1, C99 and C11 6.7.1).}
  
  The @code{register} specifier affects code generation only in these ways:
  
--- 477,484 ----
  @itemize @bullet
  @item
  @cite{The extent to which suggestions made by using the @code{register}
! storage-class specifier are effective (C90 6.5.1, C99 and C11 6.7.1,
! C23 6.7.2).}
  
  The @code{register} specifier affects code generation only in these ways:
  
*************** in registers unless they are marked @cod
*** 448,454 ****
  
  @item
  @cite{The extent to which suggestions made by using the inline function
! specifier are effective (C99 and C11 6.7.4).}
  
  GCC will not inline any functions if the @option{-fno-inline} option is
  used or if @option{-O0} is used.  Otherwise, GCC may still be unable to
--- 503,509 ----
  
  @item
  @cite{The extent to which suggestions made by using the inline function
! specifier are effective (C99 and C11 6.7.4, C23 6.7.5).}
  
  GCC will not inline any functions if the @option{-fno-inline} option is
  used or if @option{-O0} is used.  Otherwise, GCC may still be unable to
*************** may be a trap representation.
*** 472,478 ****
  @item
  @cite{Whether a ``plain'' @code{int} bit-field is treated as a
  @code{signed int} bit-field or as an @code{unsigned int} bit-field
! (C90 6.5.2, C90 6.5.2.1, C99 and C11 6.7.2, C99 and C11 6.7.2.1).}
  
  @opindex funsigned-bitfields
  By default it is treated as @code{signed int} but this may be changed
--- 527,534 ----
  @item
  @cite{Whether a ``plain'' @code{int} bit-field is treated as a
  @code{signed int} bit-field or as an @code{unsigned int} bit-field
! (C90 6.5.2, C90 6.5.2.1, C99 and C11 6.7.2, C23 6.7.3, C99 and C11
! 6.7.2.1, C23 6.7.3.2).}
  
  @opindex funsigned-bitfields
  By default it is treated as @code{signed int} but this may be changed
*************** by the @option{-funsigned-bitfields} opt
*** 480,516 ****
  
  @item
  @cite{Allowable bit-field types other than @code{_Bool}, @code{signed int},
! and @code{unsigned int} (C99 and C11 6.7.2.1).}
  
  Other integer types, such as @code{long int}, and enumerated types are
  permitted even in strictly conforming mode.
  
  @item
! @cite{Whether atomic types are permitted for bit-fields (C11 6.7.2.1).}
  
  Atomic types are not permitted for bit-fields.
  
  @item
  @cite{Whether a bit-field can straddle a storage-unit boundary (C90
! 6.5.2.1, C99 and C11 6.7.2.1).}
  
  Determined by ABI@.
  
  @item
  @cite{The order of allocation of bit-fields within a unit (C90
! 6.5.2.1, C99 and C11 6.7.2.1).}
  
  Determined by ABI@.
  
  @item
  @cite{The alignment of non-bit-field members of structures (C90
! 6.5.2.1, C99 and C11 6.7.2.1).}
  
  Determined by ABI@.
  
  @item
  @cite{The integer type compatible with each enumerated type (C90
! 6.5.2.2, C99 and C11 6.7.2.2).}
  
  @opindex fshort-enums
  Normally, the type is @code{unsigned int} if there are no negative
--- 536,573 ----
  
  @item
  @cite{Allowable bit-field types other than @code{_Bool}, @code{signed int},
! and @code{unsigned int} (C99 and C11 6.7.2.1, C23 6.7.3.2).}
  
  Other integer types, such as @code{long int}, and enumerated types are
  permitted even in strictly conforming mode.
  
  @item
! @cite{Whether atomic types are permitted for bit-fields (C11 6.7.2.1,
! C23 6.7.3.2).}
  
  Atomic types are not permitted for bit-fields.
  
  @item
  @cite{Whether a bit-field can straddle a storage-unit boundary (C90
! 6.5.2.1, C99 and C11 6.7.2.1, C23 6.7.3.2).}
  
  Determined by ABI@.
  
  @item
  @cite{The order of allocation of bit-fields within a unit (C90
! 6.5.2.1, C99 and C11 6.7.2.1, C23 6.7.3.2).}
  
  Determined by ABI@.
  
  @item
  @cite{The alignment of non-bit-field members of structures (C90
! 6.5.2.1, C99 and C11 6.7.2.1, C23 6.7.3.2).}
  
  Determined by ABI@.
  
  @item
  @cite{The integer type compatible with each enumerated type (C90
! 6.5.2.2, C99 and C11 6.7.2.2, C23 6.7.3.3).}
  
  @opindex fshort-enums
  Normally, the type is @code{unsigned int} if there are no negative
*************** determined by the ABI@.
*** 538,544 ****
  @itemize @bullet
  @item
  @cite{What constitutes an access to an object that has volatile-qualified
! type (C90 6.5.3, C99 and C11 6.7.3).}
  
  Such an object is normally accessed by pointers and used for accessing
  hardware.  In most expressions, it is intuitively obvious what is a read
--- 595,601 ----
  @itemize @bullet
  @item
  @cite{What constitutes an access to an object that has volatile-qualified
! type (C90 6.5.3, C99 and C11 6.7.3, C23 6.7.4).}
  
  Such an object is normally accessed by pointers and used for accessing
  hardware.  In most expressions, it is intuitively obvious what is a read
*************** object's declared type were @code{volati
*** 584,589 ****
--- 641,672 ----
  
  @end itemize
  
+ @node Types implementation
+ @section Types
+ 
+ @itemize @bullet
+ @item
+ @cite{A program forms the composite type of an enumerated type and a
+ non-enumeration integer type (C23 6.2.7).}
+ 
+ The composite type is the enumerated type.
+ 
+ @item
+ @cite{Whether or not it is supported for a declaration for which a
+ type is inferred to contain a pointer, array, or function declarator
+ (C23 6.7.10).}
+ 
+ This is not supported.
+ 
+ @item
+ @cite{Whether or not it is supported for a declaration for which a
+ type is inferred to contain no or more than one declarators (C23
+ 6.7.10).}
+ 
+ This is not supported.
+ 
+ @end itemize
+ 
  @node Declarators implementation
  @section Declarators
  
*************** implementation-defined behavior.
*** 618,665 ****
  @itemize @bullet
  @item
  @cite{The locations within @code{#pragma} directives where header name
! preprocessing tokens are recognized (C11 6.4, C11 6.4.7).}
  
  @item
  @cite{How sequences in both forms of header names are mapped to headers
! or external source file names (C90 6.1.7, C99 and C11 6.4.7).}
  
  @item
  @cite{Whether the value of a character constant in a constant expression
  that controls conditional inclusion matches the value of the same character
! constant in the execution character set (C90 6.8.1, C99 and C11 6.10.1).}
  
  @item
  @cite{Whether the value of a single-character character constant in a
  constant expression that controls conditional inclusion may have a
! negative value (C90 6.8.1, C99 and C11 6.10.1).}
  
  @item
  @cite{The places that are searched for an included @samp{<>} delimited
  header, and how the places are specified or the header is
! identified (C90 6.8.2, C99 and C11 6.10.2).}
  
  @item
  @cite{How the named source file is searched for in an included @samp{""}
! delimited header (C90 6.8.2, C99 and C11 6.10.2).}
  
  @item
  @cite{The method by which preprocessing tokens (possibly resulting from
  macro expansion) in a @code{#include} directive are combined into a header
! name (C90 6.8.2, C99 and C11 6.10.2).}
  
  @item
  @cite{The nesting limit for @code{#include} processing (C90 6.8.2, C99
! and C11 6.10.2).}
  
  @item
  @cite{Whether the @samp{#} operator inserts a @samp{\} character before
  the @samp{\} character that begins a universal character name in a
! character constant or string literal (C99 and C11 6.10.3.2).}
  
  @item
  @cite{The behavior on each recognized non-@code{STDC #pragma}
! directive (C90 6.8.6, C99 and C11 6.10.6).}
  
  @xref{Pragmas, , Pragmas, cpp, The C Preprocessor}, for details of
  pragmas accepted by GCC on all targets.  @xref{Pragmas, , Pragmas
--- 701,770 ----
  @itemize @bullet
  @item
  @cite{The locations within @code{#pragma} directives where header name
! preprocessing tokens are recognized (C11 and C23 6.4, C11 6.4.7, C23
! 6.4.8).}
  
  @item
  @cite{How sequences in both forms of header names are mapped to headers
! or external source file names (C90 6.1.7, C99 and C11 6.4.7, C23
! 6.4.8).}
  
  @item
  @cite{Whether the value of a character constant in a constant expression
  that controls conditional inclusion matches the value of the same character
! constant in the execution character set (C90 6.8.1, C99 and C11
! 6.10.1, C23 6.10.2).}
  
  @item
  @cite{Whether the value of a single-character character constant in a
  constant expression that controls conditional inclusion may have a
! negative value (C90 6.8.1, C99 and C11 6.10.1, C23 6.10.2).}
  
  @item
  @cite{The places that are searched for an included @samp{<>} delimited
  header, and how the places are specified or the header is
! identified (C90 6.8.2, C99 and C11 6.10.2, C23 6.10.3).}
  
  @item
  @cite{How the named source file is searched for in an included @samp{""}
! delimited header (C90 6.8.2, C99 and C11 6.10.2, C23 6.10.3).}
! 
! @item
! @cite{How the named resource file is searched for in an embedded @samp{""}
! delimited resource name (C23 6.10.4).}
  
  @item
  @cite{The method by which preprocessing tokens (possibly resulting from
  macro expansion) in a @code{#include} directive are combined into a header
! name (C90 6.8.2, C99 and C11 6.10.2, C23 6.10.3).}
  
  @item
  @cite{The nesting limit for @code{#include} processing (C90 6.8.2, C99
! and C11 6.10.2, C23 6.10.3).}
! 
! @item
! @cite{The method by which preprocessing tokens (possibly resulting
! from macro expansion) in a @code{#embed} directive are combined into a
! resource name (C23 6.10.4).}
! 
! @item
! @cite{The mapping between a resource's data and the values of the
! integer constant expressions, if any, in the replacement of a
! @code{#embed} directive (C23 6.10.4).}
! 
! @item
! @cite{The width of a resource located by the @code{#embed} directive
! (C23 6.10.4).}
  
  @item
  @cite{Whether the @samp{#} operator inserts a @samp{\} character before
  the @samp{\} character that begins a universal character name in a
! character constant or string literal (C99 and C11 6.10.3.2, C23
! 6.10.5.3).}
  
  @item
  @cite{The behavior on each recognized non-@code{STDC #pragma}
! directive (C90 6.8.6, C99 and C11 6.10.6, C23 6.10.8).}
  
  @xref{Pragmas, , Pragmas, cpp, The C Preprocessor}, for details of
  pragmas accepted by GCC on all targets.  @xref{Pragmas, , Pragmas
*************** Accepted by GCC}, for details of target-
*** 668,674 ****
  @item
  @cite{The definitions for @code{__DATE__} and @code{__TIME__} when
  respectively, the date and time of translation are not available (C90
! 6.8.8, C99 6.10.8, C11 6.10.8.1).}
  
  @end itemize
  
--- 773,779 ----
  @item
  @cite{The definitions for @code{__DATE__} and @code{__TIME__} when
  respectively, the date and time of translation are not available (C90
! 6.8.8, C99 6.10.8, C11 6.10.8.1, C23 6.10.10.2).}
  
  @end itemize
  
*************** of the C library, and are not defined by
*** 681,687 ****
  @itemize @bullet
  @item
  @cite{The null pointer constant to which the macro @code{NULL} expands
! (C90 7.1.6, C99 7.17, C11 7.19).}
  
  In @code{<stddef.h>}, @code{NULL} expands to @code{((void *)0)}.  GCC
  does not provide the other headers which define @code{NULL} and some
--- 786,792 ----
  @itemize @bullet
  @item
  @cite{The null pointer constant to which the macro @code{NULL} expands
! (C90 7.1.6, C99 7.17, C11 7.19, C23 7.21).}
  
  In @code{<stddef.h>}, @code{NULL} expands to @code{((void *)0)}.  GCC
  does not provide the other headers which define @code{NULL} and some
*************** library implementations may use other de
*** 696,709 ****
  @item
  @cite{The values or expressions assigned to the macros specified in the
  headers @code{<float.h>}, @code{<limits.h>}, and @code{<stdint.h>}
! (C90, C99 and C11 5.2.4.2, C99 7.18.2, C99 7.18.3, C11 7.20.2, C11 7.20.3).}
  
  Determined by ABI@.
  
  @item
  @cite{The result of attempting to indirectly access an object with
  automatic or thread storage duration from a thread other than the one
! with which it is associated (C11 6.2.4).}
  
  Such accesses are supported, subject to the same requirements for
  synchronization for concurrent accesses as for concurrent accesses to
--- 801,815 ----
  @item
  @cite{The values or expressions assigned to the macros specified in the
  headers @code{<float.h>}, @code{<limits.h>}, and @code{<stdint.h>}
! (C90, C99 and C11 5.2.4.2, C23 5.3.5.3, C99 7.18.2, C99 7.18.3, C11
! 7.20.2, C11 7.20.3, C23 7.22).}
  
  Determined by ABI@.
  
  @item
  @cite{The result of attempting to indirectly access an object with
  automatic or thread storage duration from a thread other than the one
! with which it is associated (C11 and C23 6.2.4).}
  
  Such accesses are supported, subject to the same requirements for
  synchronization for concurrent accesses as for concurrent accesses to
*************** any object.
*** 711,724 ****
  
  @item
  @cite{The number, order, and encoding of bytes in any object
! (when not explicitly specified in this International Standard) (C99
! and C11 6.2.6.1).}
  
  Determined by ABI@.
  
  @item
  @cite{Whether any extended alignments are supported and the contexts
! in which they are supported (C11 6.2.8).}
  
  Extended alignments up to @math{2^{28}} (bytes) are supported for
  objects of automatic storage duration.  Alignments supported for
--- 817,830 ----
  
  @item
  @cite{The number, order, and encoding of bytes in any object
! (when not explicitly specified in this International Standard) (C99,
! C11 and C23 6.2.6.1).}
  
  Determined by ABI@.
  
  @item
  @cite{Whether any extended alignments are supported and the contexts
! in which they are supported (C11 and C23 6.2.8).}
  
  Extended alignments up to @math{2^{28}} (bytes) are supported for
  objects of automatic storage duration.  Alignments supported for
*************** ABI.
*** 727,739 ****
  
  @item
  @cite{Valid alignment values other than those returned by an _Alignof
! expression for fundamental types, if any (C11 6.2.8).}
  
  Valid alignments are powers of 2 up to and including @math{2^{28}}.
  
  @item
  @cite{The value of the result of the @code{sizeof} and @code{_Alignof}
! operators (C90 6.3.3.4, C99 and C11 6.5.3.4).}
  
  Determined by ABI@.
  
--- 833,845 ----
  
  @item
  @cite{Valid alignment values other than those returned by an _Alignof
! expression for fundamental types, if any (C11 and C23 6.2.8).}
  
  Valid alignments are powers of 2 up to and including @math{2^{28}}.
  
  @item
  @cite{The value of the result of the @code{sizeof} and @code{_Alignof}
! operators (C90 6.3.3.4, C99 and C11 6.5.3.4, C23 6.5.4.5).}
  
  Determined by ABI@.
  
diff -Nrcpad gcc-16-20250518/gcc/doc/install.texi gcc-16-20250525/gcc/doc/install.texi
*** gcc-16-20250518/gcc/doc/install.texi	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/doc/install.texi	Sun May 25 22:32:06 2025
*************** Removes any @option{-O}-started option f
*** 3144,3149 ****
--- 3144,3156 ----
  @itemx @samp{bootstrap-Og}
  Analogous to @code{bootstrap-O1}.
  
+ @item @samp{bootstrap-native}
+ @itemx @samp{bootstrap-native}
+ Optimize the compiler code for the build host, if supported by the
+ architecture. Note this only affects the compiler, not the targeted
+ code. If you want the later, choose options suitable to the target you
+ are looking for. For example @samp{--with-cpu} would be a good starting point.
+ 
  @item @samp{bootstrap-lto}
  Enables Link-Time Optimization for host tools during bootstrapping.
  @samp{BUILD_CONFIG=bootstrap-lto} is equivalent to adding
diff -Nrcpad gcc-16-20250518/gcc/doc/invoke.texi gcc-16-20250525/gcc/doc/invoke.texi
*** gcc-16-20250518/gcc/doc/invoke.texi	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/doc/invoke.texi	Sun May 25 22:32:06 2025
*************** See RS/6000 and PowerPC Options.
*** 1268,1274 ****
  -mfence-tso  -mno-fence-tso
  -mdiv  -mno-div
  -misa-spec=@var{ISA-spec-string}
! -march=@var{ISA-string|Profiles|Profiles_ISA-string}
  -mtune=@var{processor-string}
  -mpreferred-stack-boundary=@var{num}
  -msmall-data-limit=@var{N-bytes}
--- 1268,1274 ----
  -mfence-tso  -mno-fence-tso
  -mdiv  -mno-div
  -misa-spec=@var{ISA-spec-string}
! -march=@var{ISA-string|Profiles|Profiles_ISA-string|CPU/processor string}
  -mtune=@var{processor-string}
  -mpreferred-stack-boundary=@var{num}
  -msmall-data-limit=@var{N-bytes}
*************** See RS/6000 and PowerPC Options.
*** 1496,1503 ****
  -mamx-tile  -mamx-int8  -mamx-bf16 -muintr -mhreset -mavxvnni -mamx-fp8
  -mavx512fp16 -mavxifma -mavxvnniint8 -mavxneconvert -mcmpccxadd -mamx-fp16
  -mprefetchi -mraoint -mamx-complex -mavxvnniint16 -msm3 -msha512 -msm4 -mapxf
! -musermsr -mavx10.1 -mavx10.1-256 -mavx10.1-512 -mevex512 -mavx10.2
! -mamx-avx512 -mamx-tf32 -mamx-transpose -mmovrs -mamx-movrs
  -mcldemote  -mms-bitfields  -mno-align-stringops  -minline-all-stringops
  -minline-stringops-dynamically  -mstringop-strategy=@var{alg}
  -mkl -mwidekl
--- 1496,1503 ----
  -mamx-tile  -mamx-int8  -mamx-bf16 -muintr -mhreset -mavxvnni -mamx-fp8
  -mavx512fp16 -mavxifma -mavxvnniint8 -mavxneconvert -mcmpccxadd -mamx-fp16
  -mprefetchi -mraoint -mamx-complex -mavxvnniint16 -msm3 -msha512 -msm4 -mapxf
! -musermsr -mavx10.1 -mavx10.2 -mamx-avx512 -mamx-tf32 -mamx-transpose -mmovrs
! -mamx-movrs
  -mcldemote  -mms-bitfields  -mno-align-stringops  -minline-all-stringops
  -minline-stringops-dynamically  -mstringop-strategy=@var{alg}
  -mkl -mwidekl
*************** extension set if they weren't added expl
*** 31163,31174 ****
  @item -mcpu=@var{processor-string}
  Use architecture of and optimize the output for the given processor, specified
  by particular CPU name.
! Permissible values for this option are: @samp{sifive-e20}, @samp{sifive-e21},
! @samp{sifive-e24}, @samp{sifive-e31}, @samp{sifive-e34}, @samp{sifive-e76},
! @samp{sifive-s21}, @samp{sifive-s51}, @samp{sifive-s54}, @samp{sifive-s76},
! @samp{sifive-u54}, @samp{sifive-u74}, @samp{sifive-x280}, @samp{sifive-xp450},
! @samp{sifive-x670}, @samp{thead-c906}, @samp{tt-ascalon-d8}, @samp{xiangshan-nanhu},
! @samp{xt-c908}, @samp{xt-c908v}, @samp{xt-c910}, @samp{xt-c910v2},
  @samp{xt-c920}, @samp{xt-c920v2}.
  
  Note that @option{-mcpu} does not override @option{-march} or @option{-mtune}.
--- 31163,31174 ----
  @item -mcpu=@var{processor-string}
  Use architecture of and optimize the output for the given processor, specified
  by particular CPU name.
! Permissible values for this option are: @samp{mips-p8700}, @samp{sifive-e20},
! @samp{sifive-e21}, @samp{sifive-e24}, @samp{sifive-e31}, @samp{sifive-e34},
! @samp{sifive-e76}, @samp{sifive-s21}, @samp{sifive-s51}, @samp{sifive-s54},
! @samp{sifive-s76}, @samp{sifive-u54}, @samp{sifive-u74}, @samp{sifive-x280},
! @samp{sifive-xp450}, @samp{sifive-x670}, @samp{thead-c906}, @samp{tt-ascalon-d8},
! @samp{xiangshan-nanhu}, @samp{xt-c908}, @samp{xt-c908v}, @samp{xt-c910}, @samp{xt-c910v2},
  @samp{xt-c920}, @samp{xt-c920v2}.
  
  Note that @option{-mcpu} does not override @option{-march} or @option{-mtune}.
*************** Note that @option{-mcpu} does not overri
*** 31177,31183 ****
  @item -mtune=@var{processor-string}
  Optimize the output for the given processor, specified by microarchitecture or
  particular CPU name.  Permissible values for this option are:
! @samp{generic-ooo}, @samp{rocket}, @samp{sifive-3-series},
  @samp{sifive-5-series}, @samp{sifive-7-series}, @samp{size},
  @samp{sifive-p400-series}, @samp{sifive-p600-series}, and all valid options for
  @option{-mcpu=}.
--- 31177,31183 ----
  @item -mtune=@var{processor-string}
  Optimize the output for the given processor, specified by microarchitecture or
  particular CPU name.  Permissible values for this option are:
! @samp{generic-ooo}, @samp{mips-p8700}, @samp{rocket}, @samp{sifive-3-series},
  @samp{sifive-5-series}, @samp{sifive-7-series}, @samp{size},
  @samp{sifive-p400-series}, @samp{sifive-p600-series}, and all valid options for
  @option{-mcpu=}.
*************** preferred alignment to @option{-mpreferr
*** 35742,35753 ****
  @opindex mavx10.1
  @itemx -mavx10.1
  @need 200
- @opindex mavx10.1-256
- @itemx -mavx10.1-256
- @need 200
- @opindex mavx10.1-512
- @itemx -mavx10.1-512
- @need 200
  @opindex mavx10.2
  @itemx -mavx10.2
  @need 200
--- 35742,35747 ----
*************** To invoke egpr usage in inline asm, use
*** 36536,36546 ****
  -mapx-inline-asm-use-gpr32 and user should ensure the instruction
  supports EGPR.
  
- @opindex mevex512
- @item -mevex512
- @itemx -mno-evex512
- Enables/disables 512-bit vector. It will be default on if AVX512F is enabled.
- 
  @end table
  
  These @samp{-m} switches are supported in addition to the above
--- 36530,36535 ----
diff -Nrcpad gcc-16-20250518/gcc/doc/md.texi gcc-16-20250525/gcc/doc/md.texi
*** gcc-16-20250518/gcc/doc/md.texi	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/doc/md.texi	Sun May 25 22:32:06 2025
*************** A signed 16-bit constant.
*** 2918,2923 ****
--- 2918,2926 ----
  A memory operand whose address is formed by a base register and offset
  that is suitable for use in instructions with the same addressing mode
  as @code{st.w} and @code{ld.w}.
+ @item q
+ A general-purpose register except for $r0 and $r1 (for the csrxchg
+ instruction)
  @item I
  A signed 12-bit constant (for arithmetic instructions).
  @item K
*************** RVC general purpose register (x8-x15).
*** 3694,3699 ****
--- 3697,3705 ----
  RVC floating-point registers (f8-f15), if available, reuse GPR as FPR when use
  zfinx.
  
+ @item cR
+ Even-odd RVC general purpose register pair.
+ 
  @item R
  Even-odd general purpose register pair.
  
diff -Nrcpad gcc-16-20250518/gcc/doc/sourcebuild.texi gcc-16-20250525/gcc/doc/sourcebuild.texi
*** gcc-16-20250518/gcc/doc/sourcebuild.texi	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/doc/sourcebuild.texi	Sun May 25 22:32:06 2025
*************** Target supports compiling @code{avx} ins
*** 2619,2633 ****
  @item avx_runtime
  Target supports the execution of @code{avx} instructions.
  
- @item avx10.1-256
- Target supports the execution of @code{avx10.1-256} instructions.
- 
  @item avx10.1
  Target supports the execution of @code{avx10.1} instructions.
  
- @item avx10.1-512
- Target supports the execution of @code{avx10.1-512} instructions.
- 
  @item avx10.2
  Target supports the execution of @code{avx10.2} instructions.
  
--- 2619,2627 ----
diff -Nrcpad gcc-16-20250518/gcc/dwarf2out.cc gcc-16-20250525/gcc/dwarf2out.cc
*** gcc-16-20250518/gcc/dwarf2out.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/dwarf2out.cc	Sun May 25 22:32:06 2025
*************** loc_list_from_tree_1 (tree loc, int want
*** 19764,19781 ****
  	    {
  	      if (TYPE_UNSIGNED (TREE_TYPE (loc)))
  		{
! 		  const unsigned HOST_WIDE_INT mask
! 		    = (HOST_WIDE_INT_1U << bitsize) - 1;
! 		  add_loc_descr (&deref, uint_loc_descriptor (mask));
! 		  add_loc_descr (&deref, new_loc_descr (DW_OP_and, 0, 0));
  		}
  	      else
  		{
! 		  const unsigned HOST_WIDE_INT shift
  		    = DWARF2_ADDR_SIZE * BITS_PER_UNIT - bitsize;
! 		  add_loc_descr (&deref, uint_loc_descriptor (shift));
! 		  add_loc_descr (&deref, new_loc_descr (DW_OP_shl, 0, 0));
! 		  add_loc_descr (&deref, uint_loc_descriptor (shift));
  		  add_loc_descr (&deref, new_loc_descr (DW_OP_shra, 0, 0));
  		}
  	    }
--- 19764,19798 ----
  	    {
  	      if (TYPE_UNSIGNED (TREE_TYPE (loc)))
  		{
! 		  if (BYTES_BIG_ENDIAN)
! 		    {
! 		      const unsigned HOST_WIDE_INT shift
! 			= size * BITS_PER_UNIT - bitsize;
! 		      add_loc_descr (&deref, uint_loc_descriptor (shift));
! 		      add_loc_descr (&deref, new_loc_descr (DW_OP_shr, 0, 0));
! 		    }
! 		  else
! 		    {
! 		      const unsigned HOST_WIDE_INT mask
! 			= (HOST_WIDE_INT_1U << bitsize) - 1;
! 		      add_loc_descr (&deref, uint_loc_descriptor (mask));
! 		      add_loc_descr (&deref, new_loc_descr (DW_OP_and, 0, 0));
! 		    }
  		}
  	      else
  		{
! 		  const unsigned HOST_WIDE_INT shiftr
  		    = DWARF2_ADDR_SIZE * BITS_PER_UNIT - bitsize;
! 		  const unsigned HOST_WIDE_INT shiftl
! 		    = BYTES_BIG_ENDIAN
! 		      ? (DWARF2_ADDR_SIZE - size) * BITS_PER_UNIT
! 		      : shiftr;
! 		  if (shiftl > 0)
! 		    {
! 		      add_loc_descr (&deref, uint_loc_descriptor (shiftl));
! 		      add_loc_descr (&deref, new_loc_descr (DW_OP_shl, 0, 0));
! 		    }
! 		  add_loc_descr (&deref, uint_loc_descriptor (shiftr));
  		  add_loc_descr (&deref, new_loc_descr (DW_OP_shra, 0, 0));
  		}
  	    }
diff -Nrcpad gcc-16-20250518/gcc/emit-rtl.cc gcc-16-20250525/gcc/emit-rtl.cc
*** gcc-16-20250518/gcc/emit-rtl.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/emit-rtl.cc	Sun May 25 22:32:06 2025
*************** along with GCC; see the file COPYING3.
*** 64,69 ****
--- 64,70 ----
  #include "gimple.h"
  #include "gimple-ssa.h"
  #include "gimplify.h"
+ #include "bbitmap.h"
  
  struct target_rtl default_target_rtl;
  #if SWITCHABLE_TARGET
*************** gen_int_shift_amount (machine_mode, poly
*** 6788,6793 ****
--- 6789,7085 ----
    return gen_int_mode (value, shift_mode);
  }
  
+ namespace {
+ /* Helper class for expanding an rtx using the encoding generated by
+    genemit.cc.  The code needs to be kept in sync with there.  */
+ 
+ class rtx_expander
+ {
+ public:
+   rtx_expander (const uint8_t *, rtx *);
+ 
+   rtx get_rtx ();
+   rtvec get_rtvec ();
+   void expand_seq ();
+ 
+ protected:
+   uint64_t get_uint ();
+   machine_mode get_mode () { return machine_mode (get_uint ()); }
+   char *get_string ();
+   rtx get_shared_operand ();
+   rtx get_unshared_operand ();
+ 
+   rtx get_rtx (expand_opcode);
+   rtx get_rtx (rtx_code, machine_mode);
+ 
+   /* Points to the first unread byte.  */
+   const uint8_t *m_seq;
+ 
+   /* The operands passed to the gen_* function.  */
+   rtx *m_operands;
+ 
+   /* A bitmap of operands that have already been used to replace a
+      MATCH_OPERAND or MATCH_DUP.  In order to ensure correct sharing,
+      further replacements need to use a copy of the operand, rather than
+      the original rtx.  */
+   bbitmap<MAX_RECOG_OPERANDS> m_used;
+ };
+ }
+ 
+ rtx_expander::rtx_expander (const uint8_t *seq, rtx *operands)
+   : m_seq (seq), m_operands (operands), m_used ()
+ {}
+ 
+ /* Read and return the next encoded "BEB128" integer.  */
+ 
+ inline uint64_t
+ rtx_expander::get_uint ()
+ {
+   const uint8_t *seq = m_seq;
+   uint64_t res = 0;
+   do
+     res = (res << 7) | (*seq & 127);
+   while (*seq++ >= 128);
+   m_seq = seq;
+   return res;
+ }
+ 
+ /* Read an operand number and return the associated operand rtx,
+    without copying it.  */
+ 
+ rtx
+ rtx_expander::get_shared_operand ()
+ {
+   return m_operands[get_uint ()];
+ }
+ 
+ /* Read an operand number and return a correctly-shared instance of
+    the associated operand rtx.  This can be either the original rtx
+    or a copy.  */
+ 
+ rtx
+ rtx_expander::get_unshared_operand ()
+ {
+   auto opno = get_uint ();
+   auto mask = m_used.from_index (opno);
+   if (m_used & mask)
+     return copy_rtx (m_operands[opno]);
+ 
+   m_used |= mask;
+   return m_operands[opno];
+ }
+ 
+ /* Read an encoded rtx.  */
+ 
+ rtx
+ rtx_expander::get_rtx ()
+ {
+   auto FIRST_CODE = (unsigned) expand_opcode::FIRST_CODE;
+   auto opcode = get_uint ();
+   if (opcode < FIRST_CODE)
+     return get_rtx (expand_opcode (opcode));
+   return get_rtx (rtx_code (opcode - FIRST_CODE), NUM_MACHINE_MODES);
+ }
+ 
+ /* Read an encoded rtx that starts with the given opcode.  */
+ 
+ rtx
+ rtx_expander::get_rtx (expand_opcode opcode)
+ {
+   switch (opcode)
+     {
+     case expand_opcode::NO_RTX:
+       return NULL_RTX;
+ 
+     case expand_opcode::MATCH_OPERAND:
+       return get_unshared_operand ();
+ 
+     case expand_opcode::MATCH_OPERATOR_WITH_MODE:
+       {
+ 	auto mode = get_mode ();
+ 	auto op = get_shared_operand ();
+ 	return get_rtx (GET_CODE (op), mode);
+       }
+ 
+     case expand_opcode::MATCH_OPERATOR:
+       {
+ 	auto op = get_shared_operand ();
+ 	return get_rtx (GET_CODE (op), GET_MODE (op));
+       }
+ 
+     case expand_opcode::MATCH_PARALLEL:
+       return get_shared_operand ();
+ 
+     case expand_opcode::CLOBBER_REG:
+       {
+ 	auto mode = get_mode ();
+ 	auto regno = get_uint ();
+ 	return gen_hard_reg_clobber (mode, regno);
+       }
+ 
+     case expand_opcode::FIRST_CODE:
+       break;
+     }
+   gcc_unreachable ();
+ }
+ 
+ /* Read the rest of an rtx of code CODE.  If such rtxes are not always
+    VOIDmode, MODE is the mode that the rtx should have, or NUM_MACHINE_MODES
+    if the mode is encoded at the current iterator position.  */
+ 
+ rtx
+ rtx_expander::get_rtx (rtx_code code, machine_mode mode)
+ {
+   switch (code)
+     {
+       /* Please keep the cases below in sync with gengenrtl.cc:special_rtx.  */
+ 
+     case EXPR_LIST:
+     case INSN_LIST:
+     case INSN:
+       gcc_unreachable ();
+ 
+     case CONST_INT:
+       return GEN_INT (get_uint ());
+ 
+     case REG:
+       if (mode == NUM_MACHINE_MODES)
+ 	mode = get_mode ();
+       return gen_rtx_REG (mode, get_uint ());
+ 
+     case SUBREG:
+       {
+ 	if (mode == NUM_MACHINE_MODES)
+ 	  mode = get_mode ();
+ 	auto reg = get_rtx ();
+ 	auto byte = get_uint ();
+ 	return gen_rtx_SUBREG (mode, reg, byte);
+       }
+ 
+     case MEM:
+       if (mode == NUM_MACHINE_MODES)
+ 	mode = get_mode ();
+       return gen_rtx_MEM (mode, get_rtx ());
+ 
+     case PC:
+       return pc_rtx;
+ 
+     case RETURN:
+       return ret_rtx;
+ 
+     case SIMPLE_RETURN:
+       return simple_return_rtx;
+ 
+     case CONST_VECTOR:
+       if (mode == NUM_MACHINE_MODES)
+ 	mode = get_mode ();
+       return gen_rtx_CONST_VECTOR (mode, get_rtvec ());
+ 
+       /* Please keep the cases below in sync with
+ 	 gengenrtl.cc:excluded_rtx.  */
+ 
+     case VAR_LOCATION:
+       gcc_unreachable ();
+ 
+     case CONST_DOUBLE:
+       /* genemit.cc only accepts zero const_doubles.  */
+       if (mode == NUM_MACHINE_MODES)
+ 	mode = get_mode ();
+       return CONST0_RTX (mode);
+ 
+     case CONST_WIDE_INT:
+     case CONST_POLY_INT:
+     case CONST_FIXED:
+       gcc_unreachable ();
+ 
+     default:
+       break;
+     }
+ 
+   rtx x = rtx_alloc (code);
+   if (!always_void_p (code))
+     {
+       if (mode == NUM_MACHINE_MODES)
+ 	mode = get_mode ();
+       PUT_MODE_RAW (x, mode);
+     }
+ 
+   const char *fmt = GET_RTX_FORMAT (code);
+   for (unsigned int i = 0; fmt[i]; ++i)
+     switch (fmt[i])
+       {
+ 	/* Please keep these cases in sync with
+ 	   gengenrtl.cc:type_from_format.  */
+ 
+       case 'i':
+ 	XINT (x, i) = get_uint ();
+ 	break;
+ 
+       case 'L':
+       case 'w':
+       case 'p':
+       case 's':
+ 	gcc_unreachable ();
+ 
+       case 'e':  case 'u':
+ 	XEXP (x, i) = get_rtx ();
+ 	break;
+ 
+       case 'E':
+ 	XVEC (x, i) = get_rtvec ();
+ 	break;
+ 
+       case 't':
+       case 'B':
+       default:
+ 	gcc_unreachable ();
+       }
+ 
+   return x;
+ }
+ 
+ /* Read an encoded rtvec.  */
+ 
+ rtvec
+ rtx_expander::get_rtvec ()
+ {
+   unsigned int len = get_uint ();
+   rtvec v = rtvec_alloc (len);
+   for (unsigned int i = 0; i < len; ++i)
+     RTVEC_ELT (v, i) = get_rtx ();
+   return v;
+ }
+ 
+ /* Read and emit an encoded sequence of instructions.  */
+ 
+ void
+ rtx_expander::expand_seq ()
+ {
+   unsigned int len = get_uint ();
+   for (unsigned int i = 0; i < len; ++i)
+     emit (get_rtx (), i < len - 1);
+ }
+ 
+ /* Read an rtx from the bytecode in SEQ, which was generated by genemit.cc.
+    Replace operand placeholders with the values given in OPERANDS.  */
+ 
+ rtx
+ expand_rtx (const uint8_t *seq, rtx *operands)
+ {
+   return rtx_expander (seq, operands).get_rtx ();
+ }
+ 
+ /* Read and emit a sequence of instructions from the bytecode in SEQ,
+    which was generated by genemit.cc.  Replace operand placeholders with
+    the values given in OPERANDS.  */
+ 
+ rtx_insn *
+ complete_seq (const uint8_t *seq, rtx *operands)
+ {
+   rtx_expander (seq, operands).expand_seq ();
+   return end_sequence ();
+ }
+ 
  /* Initialize fields of rtl_data related to stack alignment.  */
  
  void
diff -Nrcpad gcc-16-20250518/gcc/expmed.cc gcc-16-20250525/gcc/expmed.cc
*** gcc-16-20250518/gcc/expmed.cc	Sun May 18 22:32:07 2025
--- gcc-16-20250525/gcc/expmed.cc	Sun May 25 22:32:06 2025
*************** expand_rotate_as_vec_perm (machine_mode
*** 6324,6330 ****
  			     qimode, perm_dst);
    if (!res)
      return NULL_RTX;
!   emit_move_insn (dst, lowpart_subreg (mode, res, qimode));
    return dst;
  }
  
--- 6324,6331 ----
  			     qimode, perm_dst);
    if (!res)
      return NULL_RTX;
!   if (!rtx_equal_p (res, perm_dst))
!     emit_move_insn (dst, lowpart_subreg (mode, res, qimode));
    return dst;
  }
  
*************** canonicalize_comparison (machine_mode mo
*** 6408,6425 ****
    if (overflow)
      return;
  
-   /* The following creates a pseudo; if we cannot do that, bail out.  */
-   if (!can_create_pseudo_p ())
-     return;
- 
-   rtx reg = gen_rtx_REG (mode, LAST_VIRTUAL_REGISTER + 1);
    rtx new_imm = immed_wide_int_const (imm_modif, mode);
  
!   rtx_insn *old_rtx = gen_move_insn (reg, *imm);
!   rtx_insn *new_rtx = gen_move_insn (reg, new_imm);
  
    /* Update the immediate and the code.  */
!   if (insn_cost (old_rtx, true) > insn_cost (new_rtx, true))
      {
        *code = equivalent_cmp_code (*code);
        *imm = new_imm;
--- 6409,6433 ----
    if (overflow)
      return;
  
    rtx new_imm = immed_wide_int_const (imm_modif, mode);
  
!   int old_cost = rtx_cost (*imm, mode, COMPARE, 0, true);
!   int new_cost = rtx_cost (new_imm, mode, COMPARE, 0, true);
! 
!   if (dump_file && (dump_flags & TDF_DETAILS))
!     {
!       fprintf (dump_file, ";; cmp: %s, old cst: ",
! 	       GET_RTX_NAME (*code));
!       print_rtl (dump_file, *imm);
!       fprintf (dump_file, " new cst: ");
!       print_rtl (dump_file, new_imm);
!       fprintf (dump_file, "\n");
!       fprintf (dump_file, ";; old cst cost: %d, new cst cost: %d\n",
! 	       old_cost, new_cost);
!     }
  
    /* Update the immediate and the code.  */
!   if (old_cost > new_cost)
      {
        *code = equivalent_cmp_code (*code);
        *imm = new_imm;
diff -Nrcpad gcc-16-20250518/gcc/fortran/ChangeLog gcc-16-20250525/gcc/fortran/ChangeLog
*** gcc-16-20250518/gcc/fortran/ChangeLog	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/fortran/ChangeLog	Sun May 25 22:32:06 2025
***************
*** 1,3 ****
--- 1,10 ----
+ 2025-05-19  Harald Anlauf  <anlauf@gmx.de>
+ 
+ 	PR fortran/120099
+ 	* trans-types.cc (gfc_return_by_reference): Intrinsic functions
+ 	returning complex numbers may return their result by reference
+ 	with -ff2c.
+ 
  2025-05-15  Harald Anlauf  <anlauf@gmx.de>
  
  	PR fortran/85750
diff -Nrcpad gcc-16-20250518/gcc/fortran/trans-types.cc gcc-16-20250525/gcc/fortran/trans-types.cc
*** gcc-16-20250518/gcc/fortran/trans-types.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/fortran/trans-types.cc	Sun May 25 22:32:06 2025
*************** gfc_return_by_reference (gfc_symbol * sy
*** 3231,3243 ****
  
    /* Possibly return complex numbers by reference for g77 compatibility.
       We don't do this for calls to intrinsics (as the library uses the
!      -fno-f2c calling convention), nor for calls to functions which always
       require an explicit interface, as no compatibility problems can
       arise there.  */
    if (flag_f2c && sym->ts.type == BT_COMPLEX
        && !sym->attr.pointer
        && !sym->attr.allocatable
!       && !sym->attr.intrinsic && !sym->attr.always_explicit)
      return 1;
  
    return 0;
--- 3231,3244 ----
  
    /* Possibly return complex numbers by reference for g77 compatibility.
       We don't do this for calls to intrinsics (as the library uses the
!      -fno-f2c calling convention) except for calls to specific wrappers
!      (_gfortran_f2c_specific_*), nor for calls to functions which always
       require an explicit interface, as no compatibility problems can
       arise there.  */
    if (flag_f2c && sym->ts.type == BT_COMPLEX
        && !sym->attr.pointer
        && !sym->attr.allocatable
!       && !sym->attr.always_explicit)
      return 1;
  
    return 0;
diff -Nrcpad gcc-16-20250518/gcc/genemit.cc gcc-16-20250525/gcc/genemit.cc
*** gcc-16-20250518/gcc/genemit.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/genemit.cc	Sun May 25 22:32:06 2025
*************** struct clobber_pat
*** 39,45 ****
    int first_clobber;
    struct clobber_pat *next;
    int has_hard_reg;
-   rtx_code code;
  } *clobber_list;
  
  /* Records one insn that uses the clobber list.  */
--- 39,44 ----
*************** static void output_peephole2_scratches	(
*** 55,204 ****
  /* True for <X>_optab if that optab isn't allowed to fail.  */
  static bool nofail_optabs[NUM_OPTABS];
  
! static void
! print_code (RTX_CODE code, FILE *file)
  {
!   const char *p1;
!   for (p1 = GET_RTX_NAME (code); *p1; p1++)
!     fprintf (file, "%c", TOUPPER (*p1));
! }
  
! static void
! gen_rtx_scratch (rtx x, enum rtx_code subroutine_type, FILE *file)
  {
!   if (subroutine_type == DEFINE_PEEPHOLE2)
      {
!       fprintf (file, "operand%d", XINT (x, 0));
      }
!   else
      {
!       fprintf (file, "gen_rtx_SCRATCH (%smode)", GET_MODE_NAME (GET_MODE (x)));
      }
  }
  
! /* Print a C expression to construct an RTX just like X,
!    substituting any operand references appearing within.  */
  
! static void
! gen_exp (rtx x, enum rtx_code subroutine_type, char *used, md_rtx_info *info,
! 	 FILE *file)
  {
-   RTX_CODE code;
-   int i;
-   int len;
-   const char *fmt;
-   const char *sep = "";
- 
    if (x == 0)
      {
!       fprintf (file, "NULL_RTX");
        return;
      }
  
!   code = GET_CODE (x);
! 
    switch (code)
      {
      case MATCH_OPERAND:
      case MATCH_DUP:
!       if (used)
! 	{
! 	  if (used[XINT (x, 0)])
! 	    {
! 	      fprintf (file, "copy_rtx (operand%d)", XINT (x, 0));
! 	      return;
! 	    }
! 	  used[XINT (x, 0)] = 1;
! 	}
!       fprintf (file, "operand%d", XINT (x, 0));
        return;
  
      case MATCH_OP_DUP:
-       fprintf (file, "gen_rtx_fmt_");
-       for (i = 0; i < XVECLEN (x, 1); i++)
- 	fprintf (file, "e");
-       fprintf (file, " (GET_CODE (operand%d), ", XINT (x, 0));
        if (GET_MODE (x) == VOIDmode)
! 	fprintf (file, "GET_MODE (operand%d)", XINT (x, 0));
        else
! 	fprintf (file, "%smode", GET_MODE_NAME (GET_MODE (x)));
!       for (i = 0; i < XVECLEN (x, 1); i++)
! 	{
! 	  fprintf (file, ",\n\t\t");
! 	  gen_exp (XVECEXP (x, 1, i), subroutine_type, used, info, file);
! 	}
!       fprintf (file, ")");
        return;
  
      case MATCH_OPERATOR:
!       fprintf (file, "gen_rtx_fmt_");
!       for (i = 0; i < XVECLEN (x, 2); i++)
! 	fprintf (file, "e");
!       fprintf (file, " (GET_CODE (operand%d)", XINT (x, 0));
!       fprintf (file, ", %smode", GET_MODE_NAME (GET_MODE (x)));
!       for (i = 0; i < XVECLEN (x, 2); i++)
! 	{
! 	  fprintf (file, ",\n\t\t");
! 	  gen_exp (XVECEXP (x, 2, i), subroutine_type, used, info, file);
! 	}
!       fprintf (file, ")");
        return;
  
      case MATCH_PARALLEL:
      case MATCH_PAR_DUP:
!       fprintf (file, "operand%d", XINT (x, 0));
        return;
  
      case MATCH_SCRATCH:
!       gen_rtx_scratch (x, subroutine_type, file);
        return;
  
-     case PC:
-       fprintf (file, "pc_rtx");
-       return;
-     case RETURN:
-       fprintf (file, "ret_rtx");
-       return;
-     case SIMPLE_RETURN:
-       fprintf (file, "simple_return_rtx");
-       return;
      case CLOBBER:
        if (REG_P (XEXP (x, 0)))
  	{
! 	  fprintf (file, "gen_hard_reg_clobber (%smode, %i)",
! 		  GET_MODE_NAME (GET_MODE (XEXP (x, 0))),
! 		  REGNO (XEXP (x, 0)));
  	  return;
  	}
        break;
  
      case CONST_INT:
!       if (INTVAL (x) == 0)
! 	fprintf (file, "const0_rtx");
!       else if (INTVAL (x) == 1)
! 	fprintf (file, "const1_rtx");
!       else if (INTVAL (x) == -1)
! 	fprintf (file, "constm1_rtx");
!       else if (-MAX_SAVED_CONST_INT <= INTVAL (x)
! 	       && INTVAL (x) <= MAX_SAVED_CONST_INT)
! 	fprintf (file, "const_int_rtx[MAX_SAVED_CONST_INT + (%d)]",
! 		(int) INTVAL (x));
!       else if (INTVAL (x) == STORE_FLAG_VALUE)
! 	fprintf (file, "const_true_rtx");
!       else
! 	{
! 	  fprintf (file, "GEN_INT (");
! 	  fprintf (file, HOST_WIDE_INT_PRINT_DEC_C, INTVAL (x));
! 	  fprintf (file, ")");
! 	}
        return;
  
      case CONST_DOUBLE:
        /* Handle `const_double_zero' rtx.  */
        if (CONST_DOUBLE_REAL_VALUE (x)->cl == rvc_zero)
  	{
! 	  fprintf (file, "CONST_DOUBLE_ATOF (\"0\", %smode)",
! 		  GET_MODE_NAME (GET_MODE (x)));
  	  return;
  	}
        /* Fall through.  */
--- 54,188 ----
  /* True for <X>_optab if that optab isn't allowed to fail.  */
  static bool nofail_optabs[NUM_OPTABS];
  
! /* A list of the md constructs that need a gen_* function.  */
! static vec<md_rtx_info> queue;
! 
! unsigned FIRST_CODE = (unsigned) expand_opcode::FIRST_CODE;
! 
! /* A structure used to generate code for a particular expansion.  */
! struct generator
  {
!   generator (const md_rtx_info &info) : info (info) {}
  
!   void add_uint (uint64_t);
!   void add_opcode (expand_opcode opcode) { add_uint ((unsigned) opcode); }
!   void add_code (rtx_code code) { add_uint (FIRST_CODE + (unsigned) code); }
!   void add_match_operator (machine_mode, int, rtvec);
!   void add_exp (rtx);
!   void add_vec (rtvec);
! 
!   const char *gen_table (FILE *, const char *);
!   const char *gen_exp (FILE *, rtx);
!   const char *gen_emit_seq (FILE *, rtvec);
! 
!   /* The construct that we're expanding.  */
!   const md_rtx_info info;
! 
!   /* Used to build up the encoding of the expanded rtx sequence.  */
!   auto_vec<uint8_t> bytes;
! };
! 
! /* Add VALUE to the encoding using "BEB128" (big-endian version of LEB128).
!    This is slightly easier for the consumer.  */
! 
! void
! generator::add_uint (uint64_t value)
  {
!   int shift = 0;
!   while ((value >> shift >> 7) > 0)
!     shift += 7;
!   do
      {
!       bytes.safe_push (((value >> shift) & 127) | (shift > 0 ? 128 : 0));
!       shift -= 7;
      }
!   while (shift >= 0);
! }
! 
! /* Add the rtx expansion of a MATCH_OPERATOR or MATCH_OP_DUP.  OPNO is the
!    number of the matched operand.  MODE is the mode that the rtx should have,
!    or NUM_MACHINE_MODES if the operand's original mode should be retained.
!    VEC is the vector of suboperands, which replace those of the original
!    operand.  */
! 
! void
! generator::add_match_operator (machine_mode mode, int opno, rtvec vec)
! {
!   if (mode != NUM_MACHINE_MODES)
      {
!       add_opcode (expand_opcode::MATCH_OPERATOR_WITH_MODE);
!       add_uint (mode);
      }
+   else
+     add_opcode (expand_opcode::MATCH_OPERATOR);
+   add_uint (opno);
+   for (int i = 0; i < GET_NUM_ELEM (vec); i++)
+     add_exp (RTVEC_ELT (vec, i));
  }
  
! /* Add the expansion of X to the encoding.  */
  
! void
! generator::add_exp (rtx x)
  {
    if (x == 0)
      {
!       add_opcode (expand_opcode::NO_RTX);
        return;
      }
  
!   auto code = GET_CODE (x);
    switch (code)
      {
      case MATCH_OPERAND:
      case MATCH_DUP:
!       add_opcode (expand_opcode::MATCH_OPERAND);
!       add_uint (XINT (x, 0));
        return;
  
      case MATCH_OP_DUP:
        if (GET_MODE (x) == VOIDmode)
! 	add_match_operator (NUM_MACHINE_MODES, XINT (x, 0), XVEC (x, 1));
        else
! 	add_match_operator (GET_MODE (x), XINT (x, 0), XVEC (x, 1));
        return;
  
      case MATCH_OPERATOR:
!       add_match_operator (GET_MODE (x), XINT (x, 0), XVEC (x, 2));
        return;
  
      case MATCH_PARALLEL:
      case MATCH_PAR_DUP:
!       add_opcode (expand_opcode::MATCH_PARALLEL);
!       add_uint (XINT (x, 0));
        return;
  
      case MATCH_SCRATCH:
!       add_code (SCRATCH);
!       add_uint (GET_MODE (x));
        return;
  
      case CLOBBER:
        if (REG_P (XEXP (x, 0)))
  	{
! 	  add_opcode (expand_opcode::CLOBBER_REG);
! 	  add_uint (GET_MODE (XEXP (x, 0)));
! 	  add_uint (REGNO (XEXP (x, 0)));
  	  return;
  	}
        break;
  
      case CONST_INT:
!       add_code (CONST_INT);
!       add_uint (UINTVAL (x));
        return;
  
      case CONST_DOUBLE:
        /* Handle `const_double_zero' rtx.  */
        if (CONST_DOUBLE_REAL_VALUE (x)->cl == rvc_zero)
  	{
! 	  add_code (CONST_DOUBLE);
! 	  add_uint (GET_MODE (x));
  	  return;
  	}
        /* Fall through.  */
*************** gen_exp (rtx x, enum rtx_code subroutine
*** 212,307 ****
        break;
      }
  
!   fprintf (file, "gen_rtx_");
!   print_code (code, file);
!   fprintf (file, " (");
    if (!always_void_p (code))
!     {
!       fprintf (file, "%smode", GET_MODE_NAME (GET_MODE (x)));
!       sep = ",\n\t";
!     }
  
!   fmt = GET_RTX_FORMAT (code);
!   len = GET_RTX_LENGTH (code);
!   for (i = 0; i < len; i++)
      {
        if (fmt[i] == '0')
  	break;
-       fputs (sep, file);
        switch (fmt[i])
  	{
  	case 'e': case 'u':
! 	  gen_exp (XEXP (x, i), subroutine_type, used, info, file);
  	  break;
  
  	case 'i':
! 	  fprintf (file, "%u", XINT (x, i));
  	  break;
  
  	case 'L':
! 	  fprintf (file, "%llu", (unsigned long long) XLOC (x, i));
  	  break;
  
  	case 'r':
! 	  fprintf (file, "%u", REGNO (x));
  	  break;
  
  	case 'p':
  	  /* We don't have a way of parsing polynomial offsets yet,
  	     and hopefully never will.  */
! 	  fprintf (file, "%d", SUBREG_BYTE (x).to_constant ());
! 	  break;
! 
! 	case 's':
! 	  fprintf (file, "\"%s\"", XSTR (x, i));
  	  break;
  
  	case 'E':
! 	  {
! 	    int j;
! 	    fprintf (file, "gen_rtvec (%d", XVECLEN (x, i));
! 	    for (j = 0; j < XVECLEN (x, i); j++)
! 	      {
! 		fprintf (file, ",\n\t\t");
! 		gen_exp (XVECEXP (x, i, j), subroutine_type, used, info, file);
! 	      }
! 	    fprintf (file, ")");
! 	    break;
! 	  }
  
  	default:
  	  gcc_unreachable ();
  	}
-       sep = ",\n\t";
      }
-   fprintf (file, ")");
  }
  
! /* Output code to emit the instruction patterns in VEC, with each element
!    becoming a separate instruction.  USED is as for gen_exp.  */
  
! static void
! gen_emit_seq (rtvec vec, char *used, md_rtx_info *info, FILE *file)
  {
!   for (int i = 0, len = GET_NUM_ELEM (vec); i < len; ++i)
!     {
!       bool last_p = (i == len - 1);
!       rtx next = RTVEC_ELT (vec, i);
!       if (const char *name = get_emit_function (next))
! 	{
! 	  fprintf (file, "  %s (", name);
! 	  gen_exp (next, DEFINE_EXPAND, used, info, file);
! 	  fprintf (file, ");\n");
! 	  if (!last_p && needs_barrier_p (next))
! 	    fprintf (file, "  emit_barrier ();");
! 	}
!       else
! 	{
! 	  fprintf (file, "  emit (");
! 	  gen_exp (next, DEFINE_EXPAND, used, info, file);
! 	  fprintf (file, ", %s);\n", last_p ? "false" : "true");
! 	}
!     }
  }
  
  /* Emit the given C code to the output file.  The code is allowed to
--- 196,291 ----
        break;
      }
  
!   add_code (code);
    if (!always_void_p (code))
!     add_uint (GET_MODE (x));
  
!   auto fmt = GET_RTX_FORMAT (code);
!   unsigned int len = GET_RTX_LENGTH (code);
!   for (unsigned int i = 0; i < len; i++)
      {
        if (fmt[i] == '0')
  	break;
        switch (fmt[i])
  	{
  	case 'e': case 'u':
! 	  add_exp (XEXP (x, i));
  	  break;
  
  	case 'i':
! 	  add_uint (XUINT (x, i));
  	  break;
  
  	case 'L':
! 	case 's':
! 	  fatal_at (info.loc, "'%s' rtxes are not supported in this context",
! 		    GET_RTX_NAME (code));
  	  break;
  
  	case 'r':
! 	  add_uint (REGNO (x));
  	  break;
  
  	case 'p':
  	  /* We don't have a way of parsing polynomial offsets yet,
  	     and hopefully never will.  */
! 	  add_uint (SUBREG_BYTE (x).to_constant ());
  	  break;
  
  	case 'E':
! 	  add_vec (XVEC (x, i));
! 	  break;
  
  	default:
  	  gcc_unreachable ();
  	}
      }
  }
  
! /* Add the expansion of rtx vector VEC to the encoding.  */
  
! void
! generator::add_vec (rtvec vec)
  {
!   add_uint (GET_NUM_ELEM (vec));
!   for (int i = 0; i < GET_NUM_ELEM (vec); ++i)
!     add_exp (RTVEC_ELT (vec, i));
! }
! 
! /* Emit the encoding as a static C++ array called NAME.  Return NAME.  */
! 
! const char *
! generator::gen_table (FILE *file, const char *name)
! {
!   fprintf (file, "  static const uint8_t %s[] = {", name);
!   for (size_t i = 0; i < bytes.length (); ++i)
!     fprintf (file, "%s%s 0x%02x",
! 	     i == 0 ? "" : ",",
! 	     i % 8 == 0 ? "\n    " : "",
! 	     bytes[i]);
!   fprintf (file, "\n  };\n");
!   return name;
! }
! 
! /* Output the code necessary for generating rtx X and return the name
!    of the C++ array that contains the encoding.  */
! 
! const char *
! generator::gen_exp (FILE *file, rtx x)
! {
!   add_exp (x);
!   return gen_table (file, "expand_encoding");
! }
! 
! /* Output the code necessary for emitting each element of VEC as a separate
!    instruction.  Return the name of the C++ array that contains the
!    encoding.  */
! 
! const char *
! generator::gen_emit_seq (FILE *file, rtvec vec)
! {
!   add_vec (vec);
!   return gen_table (file, "expand_encoding");
  }
  
  /* Emit the given C code to the output file.  The code is allowed to
*************** static void
*** 312,323 ****
  emit_c_code (const char *code, bool can_fail_p, const char *name, FILE *file)
  {
    if (can_fail_p)
!     fprintf (file, "#define FAIL return (end_sequence (), _val)\n");
    else
      fprintf (file, "#define FAIL _Pragma (\"GCC error \\\"%s cannot FAIL\\\"\")"
  	    " (void)0\n", name);
!   fprintf (file, "#define DONE return (_val = get_insns (), "
! 	  "end_sequence (), _val)\n");
  
    rtx_reader_ptr->print_md_ptr_loc (code, file);
    fprintf (file, "%s\n", code);
--- 296,306 ----
  emit_c_code (const char *code, bool can_fail_p, const char *name, FILE *file)
  {
    if (can_fail_p)
!     fprintf (file, "#define FAIL return (end_sequence (), nullptr)\n");
    else
      fprintf (file, "#define FAIL _Pragma (\"GCC error \\\"%s cannot FAIL\\\"\")"
  	    " (void)0\n", name);
!   fprintf (file, "#define DONE return end_sequence ()\n");
  
    rtx_reader_ptr->print_md_ptr_loc (code, file);
    fprintf (file, "%s\n", code);
*************** emit_c_code (const char *code, bool can_
*** 326,344 ****
    fprintf (file, "#undef FAIL\n");
  }
  
! /* Generate the `gen_...' function for a DEFINE_INSN.  */
  
  static void
! gen_insn (md_rtx_info *info, FILE *file)
  {
-   struct pattern_stats stats;
-   int i;
- 
    /* See if the pattern for this insn ends with a group of CLOBBERs of (hard)
       registers or MATCH_SCRATCHes.  If so, store away the information for
       later.  */
  
!   rtx insn = info->def;
    if (XVEC (insn, 1))
      {
        int has_hard_reg = 0;
--- 309,325 ----
    fprintf (file, "#undef FAIL\n");
  }
  
! /* Process the DEFINE_INSN in LOC, and queue it if it needs a gen_*
!    function.  */
  
  static void
! maybe_queue_insn (const md_rtx_info &info)
  {
    /* See if the pattern for this insn ends with a group of CLOBBERs of (hard)
       registers or MATCH_SCRATCHes.  If so, store away the information for
       later.  */
  
!   rtx insn = info.def;
    if (XVEC (insn, 1))
      {
        int has_hard_reg = 0;
*************** gen_insn (md_rtx_info *info, FILE *file)
*** 349,354 ****
--- 330,336 ----
  	  && GET_CODE (RTVEC_ELT (pattern, 0)) == PARALLEL)
  	pattern = XVEC (RTVEC_ELT (pattern, 0), 0);
  
+       int i;
        for (i = GET_NUM_ELEM (pattern) - 1; i > 0; i--)
  	{
  	  if (GET_CODE (RTVEC_ELT (pattern, i)) != CLOBBER)
*************** gen_insn (md_rtx_info *info, FILE *file)
*** 366,372 ****
  	  struct clobber_ent *link = XNEW (struct clobber_ent);
  	  int j;
  
! 	  link->code_number = info->index;
  
  	  /* See if any previous CLOBBER_LIST entry is the same as this
  	     one.  */
--- 348,354 ----
  	  struct clobber_ent *link = XNEW (struct clobber_ent);
  	  int j;
  
! 	  link->code_number = info.index;
  
  	  /* See if any previous CLOBBER_LIST entry is the same as this
  	     one.  */
*************** gen_insn (md_rtx_info *info, FILE *file)
*** 407,413 ****
  	      p->first_clobber = i + 1;
  	      p->next = clobber_list;
  	      p->has_hard_reg = has_hard_reg;
- 	      p->code = GET_CODE (insn);
  	      clobber_list = p;
  	    }
  
--- 389,394 ----
*************** gen_insn (md_rtx_info *info, FILE *file)
*** 422,495 ****
    if (XSTR (insn, 0)[0] == 0 || XSTR (insn, 0)[0] == '*')
      return;
  
!   fprintf (file, "/* %s:%d */\n", info->loc.filename, info->loc.lineno);
  
!   /* Find out how many operands this function has.  */
!   get_pattern_stats (&stats, XVEC (insn, 1));
!   if (stats.max_dup_opno > stats.max_opno)
!     fatal_at (info->loc, "match_dup operand number has no match_operand");
  
!   /* Output the function name and argument declarations.  */
!   fprintf (file, "rtx\ngen_%s (", XSTR (insn, 0));
    if (stats.num_generator_args)
!     for (i = 0; i < stats.num_generator_args; i++)
!       if (i)
! 	fprintf (file, ",\n\trtx operand%d ATTRIBUTE_UNUSED", i);
!       else
! 	fprintf (file, "rtx operand%d ATTRIBUTE_UNUSED", i);
    else
      fprintf (file, "void");
    fprintf (file, ")\n");
    fprintf (file, "{\n");
  
    /* Output code to construct and return the rtl for the instruction body.  */
  
    rtx pattern = add_implicit_parallel (XVEC (insn, 1));
!   /* ??? This is the traditional behavior, but seems suspect.  */
!   char *used = (XVECLEN (insn, 1) == 1
! 		? NULL
! 		: XCNEWVEC (char, stats.num_generator_args));
!   fprintf (file, "  return ");
!   gen_exp (pattern, DEFINE_INSN, used, info, file);
!   fprintf (file, ";\n}\n\n");
!   XDELETEVEC (used);
  }
  
! /* Generate the `gen_...' function for a DEFINE_EXPAND.  */
  
  static void
! gen_expand (md_rtx_info *info, FILE *file)
  {
!   struct pattern_stats stats;
!   int i;
!   char *used;
! 
!   rtx expand = info->def;
    if (strlen (XSTR (expand, 0)) == 0)
!     fatal_at (info->loc, "define_expand lacks a name");
    if (XVEC (expand, 1) == 0)
!     fatal_at (info->loc, "define_expand for %s lacks a pattern",
  	      XSTR (expand, 0));
  
    /* Find out how many operands this function has.  */
    get_pattern_stats (&stats, XVEC (expand, 1));
    if (stats.min_scratch_opno != -1
        && stats.min_scratch_opno <= MAX (stats.max_opno, stats.max_dup_opno))
!     fatal_at (info->loc, "define_expand for %s needs to have match_scratch "
! 			 "numbers above all other operands", XSTR (expand, 0));
  
    /* Output the function name and argument declarations.  */
!   fprintf (file, "rtx\ngen_%s (", XSTR (expand, 0));
!   if (stats.num_generator_args)
!     for (i = 0; i < stats.num_generator_args; i++)
!       if (i)
! 	fprintf (file, ",\n\trtx operand%d", i);
!       else
! 	fprintf (file, "rtx operand%d", i);
!   else
!     fprintf (file, "void");
!   fprintf (file, ")\n");
!   fprintf (file, "{\n");
  
    /* If we don't have any C code to write, only one insn is being written,
       and no MATCH_DUPs are present, we can just return the desired insn
--- 403,500 ----
    if (XSTR (insn, 0)[0] == 0 || XSTR (insn, 0)[0] == '*')
      return;
  
!   queue.safe_push (info);
! }
  
! /* Output the function name, argument declarations, and initial function
!    body for a pattern called NAME, given that it has the properties
!    in STATS.  Return the C++ expression for the operands array.  */
  
! static const char *
! start_gen_insn (FILE *file, const char *name, const pattern_stats &stats)
! {
!   fprintf (file, "rtx\ngen_%s (", name);
    if (stats.num_generator_args)
!     for (int i = 0; i < stats.num_generator_args; i++)
!       fprintf (file, "%sconst rtx operand%d", i == 0 ? "" : ", ", i);
    else
      fprintf (file, "void");
    fprintf (file, ")\n");
    fprintf (file, "{\n");
+   if (stats.num_generator_args)
+     {
+       fprintf (file, "  rtx operands[%d] ATTRIBUTE_UNUSED = {",
+ 	       stats.num_operand_vars);
+       for (int i = 0; i < stats.num_generator_args; i++)
+ 	fprintf (file, "%s operand%d", i == 0 ? "" : ",", i);
+       fprintf (file, " };\n");
+       return "operands";
+     }
+ 
+   if (stats.num_operand_vars != 0)
+     {
+       fprintf (file, "  rtx operands[%d] ATTRIBUTE_UNUSED;\n",
+ 	       stats.num_operand_vars);
+       return "operands";
+     }
+ 
+   return "nullptr";
+ }
+ 
+ /* Generate the `gen_...' function for a DEFINE_INSN.  */
+ 
+ static void
+ gen_insn (const md_rtx_info &info, FILE *file)
+ {
+   struct pattern_stats stats;
+ 
+   /* Find out how many operands this function has.  */
+   rtx insn = info.def;
+   get_pattern_stats (&stats, XVEC (insn, 1));
+   if (stats.max_dup_opno > stats.max_opno)
+     fatal_at (info.loc, "match_dup operand number has no match_operand");
+ 
+   /* Output the function name and argument declarations.  */
+   const char *operands = start_gen_insn (file, XSTR (insn, 0), stats);
  
    /* Output code to construct and return the rtl for the instruction body.  */
  
    rtx pattern = add_implicit_parallel (XVEC (insn, 1));
!   const char *table = generator (info).gen_exp (file, pattern);
!   fprintf (file, "  return expand_rtx (%s, %s);\n}\n\n", table, operands);
  }
  
! /* Process and queue the DEFINE_EXPAND in INFO.  */
  
  static void
! queue_expand (const md_rtx_info &info)
  {
!   rtx expand = info.def;
    if (strlen (XSTR (expand, 0)) == 0)
!     fatal_at (info.loc, "define_expand lacks a name");
    if (XVEC (expand, 1) == 0)
!     fatal_at (info.loc, "define_expand for %s lacks a pattern",
  	      XSTR (expand, 0));
+   queue.safe_push (info);
+ }
+ 
+ /* Generate the `gen_...' function for a DEFINE_EXPAND.  */
+ 
+ static void
+ gen_expand (const md_rtx_info &info, FILE *file)
+ {
+   struct pattern_stats stats;
  
    /* Find out how many operands this function has.  */
+   rtx expand = info.def;
    get_pattern_stats (&stats, XVEC (expand, 1));
    if (stats.min_scratch_opno != -1
        && stats.min_scratch_opno <= MAX (stats.max_opno, stats.max_dup_opno))
!     fatal_at (info.loc, "define_expand for %s needs to have match_scratch "
! 	      "numbers above all other operands", XSTR (expand, 0));
  
    /* Output the function name and argument declarations.  */
!   const char *operands = start_gen_insn (file, XSTR (expand, 0), stats);
  
    /* If we don't have any C code to write, only one insn is being written,
       and no MATCH_DUPs are present, we can just return the desired insn
*************** gen_expand (md_rtx_info *info, FILE *fil
*** 498,514 ****
        && stats.max_opno >= stats.max_dup_opno
        && XVECLEN (expand, 1) == 1)
      {
!       fprintf (file, "  return ");
!       gen_exp (XVECEXP (expand, 1, 0), DEFINE_EXPAND, NULL, info, file);
!       fprintf (file, ";\n}\n\n");
        return;
      }
  
-   /* For each operand referred to only with MATCH_DUPs,
-      make a local variable.  */
-   for (i = stats.num_generator_args; i <= stats.max_dup_opno; i++)
-     fprintf (file, "  rtx operand%d;\n", i);
-   fprintf (file, "  rtx_insn *_val = 0;\n");
    fprintf (file, "  start_sequence ();\n");
  
    /* The fourth operand of DEFINE_EXPAND is some code to be executed
--- 503,514 ----
        && stats.max_opno >= stats.max_dup_opno
        && XVECLEN (expand, 1) == 1)
      {
!       rtx pattern = XVECEXP (expand, 1, 0);
!       const char *table = generator (info).gen_exp (file, pattern);
!       fprintf (file, "  return expand_rtx (%s, %s);\n}\n\n", table, operands);
        return;
      }
  
    fprintf (file, "  start_sequence ();\n");
  
    /* The fourth operand of DEFINE_EXPAND is some code to be executed
*************** gen_expand (md_rtx_info *info, FILE *fil
*** 520,531 ****
    if (XSTR (expand, 3) && *XSTR (expand, 3))
      {
        fprintf (file, "  {\n");
-       if (stats.num_operand_vars > 0)
- 	fprintf (file, "    rtx operands[%d];\n", stats.num_operand_vars);
- 
-       /* Output code to copy the arguments into `operands'.  */
-       for (i = 0; i < stats.num_generator_args; i++)
- 	fprintf (file, "    operands[%d] = operand%d;\n", i, i);
  
        /* Output the special code to be executed before the sequence
  	 is generated.  */
--- 520,525 ----
*************** gen_expand (md_rtx_info *info, FILE *fil
*** 539,630 ****
  	}
        emit_c_code (XSTR (expand, 3), can_fail_p, XSTR (expand, 0), file);
  
-       /* Output code to copy the arguments back out of `operands'
- 	 (unless we aren't going to use them at all).  */
-       if (XVEC (expand, 1) != 0)
- 	{
- 	  for (i = 0; i <= MAX (stats.max_opno, stats.max_dup_opno); i++)
- 	    {
- 	      fprintf (file, "    operand%d = operands[%d];\n", i, i);
- 	      fprintf (file, "    (void) operand%d;\n", i);
- 	    }
- 	}
        fprintf (file, "  }\n");
      }
  
!   used = XCNEWVEC (char, stats.num_operand_vars);
!   gen_emit_seq (XVEC (expand, 1), used, info, file);
!   XDELETEVEC (used);
  
!   /* Call `get_insns' to extract the list of all the
!      insns emitted within this gen_... function.  */
  
!   fprintf (file, "  _val = get_insns ();\n");
!   fprintf (file, "  end_sequence ();\n");
!   fprintf (file, "  return _val;\n}\n\n");
  }
  
! /* Like gen_expand, but generates insns resulting from splitting SPLIT.  */
  
  static void
! gen_split (md_rtx_info *info, FILE *file)
  {
    struct pattern_stats stats;
!   int i;
!   rtx split = info->def;
    const char *const name =
      ((GET_CODE (split) == DEFINE_PEEPHOLE2) ? "peephole2" : "split");
    const char *unused;
-   char *used;
- 
-   if (XVEC (split, 0) == 0)
-     fatal_at (info->loc, "%s lacks a pattern",
- 	      GET_RTX_NAME (GET_CODE (split)));
-   else if (XVEC (split, 2) == 0)
-     fatal_at (info->loc, "%s lacks a replacement pattern",
- 	      GET_RTX_NAME (GET_CODE (split)));
  
    /* Find out how many operands this function has.  */
  
    get_pattern_stats (&stats, XVEC (split, 2));
    unused = (stats.num_operand_vars == 0 ? " ATTRIBUTE_UNUSED" : "");
-   used = XCNEWVEC (char, stats.num_operand_vars);
  
    /* Output the prototype, function name and argument declarations.  */
    if (GET_CODE (split) == DEFINE_PEEPHOLE2)
      {
        fprintf (file, "extern rtx_insn *gen_%s_%d (rtx_insn *, rtx *);\n",
! 	      name, info->index);
        fprintf (file, "rtx_insn *\ngen_%s_%d (rtx_insn *curr_insn ATTRIBUTE_UNUSED,"
  	      " rtx *operands%s)\n",
! 	      name, info->index, unused);
      }
    else
      {
        fprintf (file, "extern rtx_insn *gen_split_%d (rtx_insn *, rtx *);\n",
! 	      info->index);
        fprintf (file, "rtx_insn *\ngen_split_%d "
  	      "(rtx_insn *curr_insn ATTRIBUTE_UNUSED, rtx *operands%s)\n",
! 	      info->index, unused);
      }
    fprintf (file, "{\n");
  
-   /* Declare all local variables.  */
-   for (i = 0; i < stats.num_operand_vars; i++)
-     fprintf (file, "  rtx operand%d;\n", i);
-   fprintf (file, "  rtx_insn *_val = NULL;\n");
- 
    if (GET_CODE (split) == DEFINE_PEEPHOLE2)
      output_peephole2_scratches (split, file);
  
!   const char *fn = info->loc.filename;
    for (const char *p = fn; *p; p++)
      if (*p == '/')
        fn = p + 1;
  
    fprintf (file, "  if (dump_file)\n");
    fprintf (file, "    fprintf (dump_file, \"Splitting with gen_%s_%d (%s:%d)\\n\");\n",
! 	  name, info->index, fn, info->loc.lineno);
  
    fprintf (file, "  start_sequence ();\n");
  
--- 533,608 ----
  	}
        emit_c_code (XSTR (expand, 3), can_fail_p, XSTR (expand, 0), file);
  
        fprintf (file, "  }\n");
      }
  
!   const char *table = generator (info).gen_emit_seq (file, XVEC (expand, 1));
!   fprintf (file, "  return complete_seq (%s, %s);\n}\n\n", table, operands);
! }
  
! /* Process and queue the DEFINE_SPLIT or DEFINE_PEEPHOLE2 in INFO.  */
  
! static void
! queue_split (const md_rtx_info &info)
! {
!   rtx split = info.def;
! 
!   if (XVEC (split, 0) == 0)
!     fatal_at (info.loc, "%s lacks a pattern",
! 	      GET_RTX_NAME (GET_CODE (split)));
!   if (XVEC (split, 2) == 0)
!     fatal_at (info.loc, "%s lacks a replacement pattern",
! 	      GET_RTX_NAME (GET_CODE (split)));
! 
!   queue.safe_push (info);
  }
  
! /* Generate the `gen_...' function for a DEFINE_SPLIT or DEFINE_PEEPHOLE2.  */
  
  static void
! gen_split (const md_rtx_info &info, FILE *file)
  {
    struct pattern_stats stats;
!   rtx split = info.def;
    const char *const name =
      ((GET_CODE (split) == DEFINE_PEEPHOLE2) ? "peephole2" : "split");
    const char *unused;
  
    /* Find out how many operands this function has.  */
  
    get_pattern_stats (&stats, XVEC (split, 2));
    unused = (stats.num_operand_vars == 0 ? " ATTRIBUTE_UNUSED" : "");
  
    /* Output the prototype, function name and argument declarations.  */
    if (GET_CODE (split) == DEFINE_PEEPHOLE2)
      {
        fprintf (file, "extern rtx_insn *gen_%s_%d (rtx_insn *, rtx *);\n",
! 	      name, info.index);
        fprintf (file, "rtx_insn *\ngen_%s_%d (rtx_insn *curr_insn ATTRIBUTE_UNUSED,"
  	      " rtx *operands%s)\n",
! 	      name, info.index, unused);
      }
    else
      {
        fprintf (file, "extern rtx_insn *gen_split_%d (rtx_insn *, rtx *);\n",
! 	      info.index);
        fprintf (file, "rtx_insn *\ngen_split_%d "
  	      "(rtx_insn *curr_insn ATTRIBUTE_UNUSED, rtx *operands%s)\n",
! 	      info.index, unused);
      }
    fprintf (file, "{\n");
  
    if (GET_CODE (split) == DEFINE_PEEPHOLE2)
      output_peephole2_scratches (split, file);
  
!   const char *fn = info.loc.filename;
    for (const char *p = fn; *p; p++)
      if (*p == '/')
        fn = p + 1;
  
    fprintf (file, "  if (dump_file)\n");
    fprintf (file, "    fprintf (dump_file, \"Splitting with gen_%s_%d (%s:%d)\\n\");\n",
! 	  name, info.index, fn, info.loc.lineno);
  
    fprintf (file, "  start_sequence ();\n");
  
*************** gen_split (md_rtx_info *info, FILE *file
*** 634,656 ****
    if (XSTR (split, 3))
      emit_c_code (XSTR (split, 3), true, name, file);
  
!   /* Output code to copy the arguments back out of `operands'  */
!   for (i = 0; i < stats.num_operand_vars; i++)
!     {
!       fprintf (file, "  operand%d = operands[%d];\n", i, i);
!       fprintf (file, "  (void) operand%d;\n", i);
!     }
! 
!   gen_emit_seq (XVEC (split, 2), used, info, file);
! 
!   /* Call `get_insns' to make a list of all the
!      insns emitted within this gen_... function.  */
! 
!   fprintf (file, "  _val = get_insns ();\n");
!   fprintf (file, "  end_sequence ();\n");
!   fprintf (file, "  return _val;\n}\n\n");
! 
!   free (used);
  }
  
  /* Write a function, `add_clobbers', that is given a PARALLEL of sufficient
--- 612,619 ----
    if (XSTR (split, 3))
      emit_c_code (XSTR (split, 3), true, name, file);
  
!   const char *table = generator (info).gen_emit_seq (file, XVEC (split, 2));
!   fprintf (file, "  return complete_seq (%s, %s);\n}\n\n", table, "operands");
  }
  
  /* Write a function, `add_clobbers', that is given a PARALLEL of sufficient
*************** gen_split (md_rtx_info *info, FILE *file
*** 658,664 ****
     the end of the vector.  */
  
  static void
! output_add_clobbers (md_rtx_info *info, FILE *file)
  {
    struct clobber_pat *clobber;
    struct clobber_ent *ent;
--- 621,627 ----
     the end of the vector.  */
  
  static void
! output_add_clobbers (FILE *file)
  {
    struct clobber_pat *clobber;
    struct clobber_ent *ent;
*************** output_add_clobbers (md_rtx_info *info,
*** 676,685 ****
  
        for (i = clobber->first_clobber; i < GET_NUM_ELEM (clobber->pattern); i++)
  	{
! 	  fprintf (file, "      XVECEXP (pattern, 0, %d) = ", i);
! 	  gen_exp (RTVEC_ELT (clobber->pattern, i),
! 		   clobber->code, NULL, info, file);
! 	  fprintf (file, ";\n");
  	}
  
        fprintf (file, "      break;\n\n");
--- 639,654 ----
  
        for (i = clobber->first_clobber; i < GET_NUM_ELEM (clobber->pattern); i++)
  	{
! 	  fprintf (file, "    XVECEXP (pattern, 0, %d) ="
! 		   " gen_rtx_CLOBBER (VOIDmode, ", i);
! 	  rtx x = XEXP (RTVEC_ELT (clobber->pattern, i), 0);
! 	  if (REG_P (x))
! 	    fprintf (file, "gen_rtx_REG (%smode, %d)",
! 		     GET_MODE_NAME (GET_MODE (x)), REGNO (x));
! 	  else
! 	    fprintf (file, "gen_rtx_SCRATCH (%smode)",
! 		     GET_MODE_NAME (GET_MODE (x)));
! 	  fprintf (file, ");\n");
  	}
  
        fprintf (file, "      break;\n\n");
*************** main (int argc, const char **argv)
*** 951,978 ****
  
    /* Read the machine description.  */
    while (read_md_rtx (&info))
      {
        file = choose_output (output_files, file_idx);
  
        switch (GET_CODE (info.def))
  	{
  	case DEFINE_INSN:
! 	  gen_insn (&info, file);
  	  break;
  
  	case DEFINE_EXPAND:
! 	  fprintf (file, "/* %s:%d */\n", info.loc.filename, info.loc.lineno);
! 	  gen_expand (&info, file);
  	  break;
  
  	case DEFINE_SPLIT:
- 	  fprintf (file, "/* %s:%d */\n", info.loc.filename, info.loc.lineno);
- 	  gen_split (&info, file);
- 	  break;
- 
  	case DEFINE_PEEPHOLE2:
! 	  fprintf (file, "/* %s:%d */\n", info.loc.filename, info.loc.lineno);
! 	  gen_split (&info, file);
  	  break;
  
  	default:
--- 920,962 ----
  
    /* Read the machine description.  */
    while (read_md_rtx (&info))
+     switch (GET_CODE (info.def))
+       {
+       case DEFINE_INSN:
+ 	maybe_queue_insn (info);
+ 	break;
+ 
+       case DEFINE_EXPAND:
+ 	queue_expand (info);
+ 	break;
+ 
+       case DEFINE_SPLIT:
+       case DEFINE_PEEPHOLE2:
+ 	queue_split (info);
+ 	break;
+ 
+       default:
+ 	break;
+       }
+ 
+   for (auto &info : queue)
      {
        file = choose_output (output_files, file_idx);
  
+       fprintf (file, "/* %s:%d */\n", info.loc.filename, info.loc.lineno);
        switch (GET_CODE (info.def))
  	{
  	case DEFINE_INSN:
! 	  gen_insn (info, file);
  	  break;
  
  	case DEFINE_EXPAND:
! 	  gen_expand (info, file);
  	  break;
  
  	case DEFINE_SPLIT:
  	case DEFINE_PEEPHOLE2:
! 	  gen_split (info, file);
  	  break;
  
  	default:
*************** main (int argc, const char **argv)
*** 984,990 ****
  
    /* Write out the routines to add CLOBBERs to a pattern and say whether they
       clobber a hard reg.  */
!   output_add_clobbers (&info, file);
    output_added_clobbers_hard_reg_p (file);
  
    for (overloaded_name *oname = rtx_reader_ptr->get_overloads ();
--- 968,974 ----
  
    /* Write out the routines to add CLOBBERs to a pattern and say whether they
       clobber a hard reg.  */
!   output_add_clobbers (file);
    output_added_clobbers_hard_reg_p (file);
  
    for (overloaded_name *oname = rtx_reader_ptr->get_overloads ();
diff -Nrcpad gcc-16-20250518/gcc/gengenrtl.cc gcc-16-20250525/gcc/gengenrtl.cc
*** gcc-16-20250518/gcc/gengenrtl.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/gengenrtl.cc	Sun May 25 22:32:06 2025
*************** always_void_p (int idx)
*** 136,142 ****
  
  /* Return nonzero if the RTL code given by index IDX is one that we should
     generate a gen_rtx_raw_FOO macro for, not gen_rtx_FOO (because gen_rtx_FOO
!    is a wrapper in emit-rtl.cc).  */
  
  static int
  special_rtx (int idx)
--- 136,145 ----
  
  /* Return nonzero if the RTL code given by index IDX is one that we should
     generate a gen_rtx_raw_FOO macro for, not gen_rtx_FOO (because gen_rtx_FOO
!    is a wrapper in emit-rtl.cc).
! 
!    This list of codes needs to be kept in sync with the switch statement
!    in emit-rtl.cc:rtx_expander::get_rtx.  */
  
  static int
  special_rtx (int idx)
*************** special_rtx (int idx)
*** 156,162 ****
  
  /* Return nonzero if the RTL code given by index IDX is one that we should
     generate no macro for at all (because gen_rtx_FOO is never used or
!    cannot have the obvious interface).  */
  
  static int
  excluded_rtx (int idx)
--- 159,168 ----
  
  /* Return nonzero if the RTL code given by index IDX is one that we should
     generate no macro for at all (because gen_rtx_FOO is never used or
!    cannot have the obvious interface).
! 
!    This list of codes needs to be kept in sync with the switch statement
!    in emit-rtl.cc:rtx_expander::get_rtx.  */
  
  static int
  excluded_rtx (int idx)
diff -Nrcpad gcc-16-20250518/gcc/gensupport.cc gcc-16-20250525/gcc/gensupport.cc
*** gcc-16-20250518/gcc/gensupport.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/gensupport.cc	Sun May 25 22:32:06 2025
*************** get_emit_function (rtx x)
*** 3764,3779 ****
      }
  }
  
- /* Return true if we must emit a barrier after pattern X.  */
- 
- bool
- needs_barrier_p (rtx x)
- {
-   return (GET_CODE (x) == SET
- 	  && GET_CODE (SET_DEST (x)) == PC
- 	  && GET_CODE (SET_SRC (x)) == LABEL_REF);
- }
- 
  #define NS "NULL"
  #define ZS "'\\0'"
  #define OPTAB_CL(o, p, c, b, l)    { #o, p, #b, ZS, #l, o, c, UNKNOWN, 1 },
--- 3764,3769 ----
diff -Nrcpad gcc-16-20250518/gcc/gensupport.h gcc-16-20250525/gcc/gensupport.h
*** gcc-16-20250518/gcc/gensupport.h	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/gensupport.h	Sun May 25 22:32:06 2025
*************** extern void get_pattern_stats (struct pa
*** 229,235 ****
  extern void compute_test_codes (rtx, file_location, char *);
  extern file_location get_file_location (rtx);
  extern const char *get_emit_function (rtx);
- extern bool needs_barrier_p (rtx);
  extern bool find_optab (optab_pattern *, const char *);
  extern FILE *choose_output (const vec<FILE *> &, unsigned &);
  
--- 229,234 ----
diff -Nrcpad gcc-16-20250518/gcc/ggc-page.cc gcc-16-20250525/gcc/ggc-page.cc
*** gcc-16-20250518/gcc/ggc-page.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/ggc-page.cc	Sun May 25 22:32:06 2025
*************** static struct
*** 234,239 ****
--- 234,241 ----
  }
  inverse_table[NUM_ORDERS];
  
+ struct free_list;
+ 
  /* A page_entry records the status of an allocation page.  This
     structure is dynamically sized to fit the bitmap in_use_p.  */
  struct page_entry
*************** struct page_entry
*** 251,256 ****
--- 253,261 ----
       of the host system page size.)  */
    size_t bytes;
  
+   /* Free list of this page size.  */
+   struct free_list *free_list;
+ 
    /* The address at which the memory is allocated.  */
    char *page;
  
*************** struct free_object
*** 368,373 ****
--- 373,387 ----
  };
  #endif
  
+ constexpr int num_free_list = 8;
+ 
+ /* A free_list for pages with BYTES size.  */
+ struct free_list
+ {
+   size_t bytes;
+   page_entry *free_pages;
+ };
+ 
  /* The rest of the global variables.  */
  static struct ggc_globals
  {
*************** static struct ggc_globals
*** 412,419 ****
    int dev_zero_fd;
  #endif
  
!   /* A cache of free system pages.  */
!   page_entry *free_pages;
  
  #ifdef USING_MALLOC_PAGE_GROUPS
    page_group *page_groups;
--- 426,433 ----
    int dev_zero_fd;
  #endif
  
!   /* A cache of free system pages. Entry 0 is fallback.  */
!   struct free_list free_lists[num_free_list];
  
  #ifdef USING_MALLOC_PAGE_GROUPS
    page_group *page_groups;
*************** static struct ggc_globals
*** 488,493 ****
--- 502,510 ----
  
      /* The overhead for each of the allocation orders.  */
      unsigned long long total_overhead_per_order[NUM_ORDERS];
+ 
+     /* Number of fallbacks.  */
+     unsigned long long fallback;
    } stats;
  } G;
  
*************** clear_page_group_in_use (page_group *gro
*** 754,759 ****
--- 771,812 ----
  }
  #endif
  
+ /* Find a free list for ENTRY_SIZE.  */
+ 
+ static inline struct free_list *
+ find_free_list (size_t entry_size)
+ {
+   int i;
+   for (i = 1; i < num_free_list; i++)
+     {
+       if (G.free_lists[i].bytes == entry_size)
+ 	return &G.free_lists[i];
+       if (G.free_lists[i].bytes == 0)
+ 	{
+ 	  G.free_lists[i].bytes = entry_size;
+ 	  return &G.free_lists[i];
+ 	}
+     }
+   /* Fallback. Does this happen?  */
+   if (GATHER_STATISTICS)
+     G.stats.fallback++;
+   return &G.free_lists[0];
+ }
+ 
+ /* Fast lookup of free_list by order.  */
+ 
+ static struct free_list *cache_free_list[NUM_ORDERS];
+ 
+ /* Faster way to find a free list by ORDER for BYTES.  */
+ 
+ static inline struct free_list *
+ find_free_list_order (unsigned order, size_t bytes)
+ {
+   if (cache_free_list[order] == NULL)
+     cache_free_list[order] = find_free_list (bytes);
+   return cache_free_list[order];
+ }
+ 
  /* Allocate a new page for allocating objects of size 2^ORDER,
     and return an entry for it.  The entry is not added to the
     appropriate page_table list.  */
*************** alloc_page (unsigned order)
*** 770,775 ****
--- 823,829 ----
  #ifdef USING_MALLOC_PAGE_GROUPS
    page_group *group;
  #endif
+   struct free_list *free_list;
  
    num_objects = OBJECTS_PER_PAGE (order);
    bitmap_size = BITMAP_SIZE (num_objects + 1);
*************** alloc_page (unsigned order)
*** 782,789 ****
    entry = NULL;
    page = NULL;
  
    /* Check the list of free pages for one we can use.  */
!   for (pp = &G.free_pages, p = *pp; p; pp = &p->next, p = *pp)
      if (p->bytes == entry_size)
        break;
  
--- 836,845 ----
    entry = NULL;
    page = NULL;
  
+   free_list = find_free_list_order (order, entry_size);
+ 
    /* Check the list of free pages for one we can use.  */
!   for (pp = &free_list->free_pages, p = *pp; p; pp = &p->next, p = *pp)
      if (p->bytes == entry_size)
        break;
  
*************** alloc_page (unsigned order)
*** 816,822 ****
        /* We want just one page.  Allocate a bunch of them and put the
  	 extras on the freelist.  (Can only do this optimization with
  	 mmap for backing store.)  */
!       struct page_entry *e, *f = G.free_pages;
        int i, entries = GGC_QUIRE_SIZE;
  
        page = alloc_anon (NULL, G.pagesize * GGC_QUIRE_SIZE, false);
--- 872,878 ----
        /* We want just one page.  Allocate a bunch of them and put the
  	 extras on the freelist.  (Can only do this optimization with
  	 mmap for backing store.)  */
!       struct page_entry *e, *f = free_list->free_pages;
        int i, entries = GGC_QUIRE_SIZE;
  
        page = alloc_anon (NULL, G.pagesize * GGC_QUIRE_SIZE, false);
*************** alloc_page (unsigned order)
*** 833,844 ****
  	  e = XCNEWVAR (struct page_entry, page_entry_size);
  	  e->order = order;
  	  e->bytes = G.pagesize;
  	  e->page = page + (i << G.lg_pagesize);
  	  e->next = f;
  	  f = e;
  	}
  
!       G.free_pages = f;
      }
    else
      page = alloc_anon (NULL, entry_size, true);
--- 889,901 ----
  	  e = XCNEWVAR (struct page_entry, page_entry_size);
  	  e->order = order;
  	  e->bytes = G.pagesize;
+ 	  e->free_list = free_list;
  	  e->page = page + (i << G.lg_pagesize);
  	  e->next = f;
  	  f = e;
  	}
  
!       free_list->free_pages = f;
      }
    else
      page = alloc_anon (NULL, entry_size, true);
*************** alloc_page (unsigned order)
*** 904,915 ****
  	      e = XCNEWVAR (struct page_entry, page_entry_size);
  	      e->order = order;
  	      e->bytes = G.pagesize;
  	      e->page = a;
  	      e->group = group;
  	      e->next = f;
  	      f = e;
  	    }
! 	  G.free_pages = f;
  	}
      }
  #endif
--- 961,973 ----
  	      e = XCNEWVAR (struct page_entry, page_entry_size);
  	      e->order = order;
  	      e->bytes = G.pagesize;
+ 	      e->free_list = free_list;
  	      e->page = a;
  	      e->group = group;
  	      e->next = f;
  	      f = e;
  	    }
! 	  free_list->free_pages = f;
  	}
      }
  #endif
*************** alloc_page (unsigned order)
*** 918,923 ****
--- 976,982 ----
      entry = XCNEWVAR (struct page_entry, page_entry_size);
  
    entry->bytes = entry_size;
+   entry->free_list = free_list;
    entry->page = page;
    entry->context_depth = G.context_depth;
    entry->order = order;
*************** free_page (page_entry *entry)
*** 1006,1019 ****
  
    adjust_depth ();
  
!   entry->next = G.free_pages;
!   G.free_pages = entry;
  }
  
! /* Release the free page cache to the system.  */
  
  static void
! release_pages (void)
  {
    size_t n1 = 0;
    size_t n2 = 0;
--- 1065,1079 ----
  
    adjust_depth ();
  
!   struct free_list *free_list = entry->free_list;
!   entry->next = free_list->free_pages;
!   free_list->free_pages = entry;
  }
  
! /* Release the free page cache for FREE_LIST to the system.  */
  
  static void
! do_release_pages (struct free_list *free_list)
  {
    size_t n1 = 0;
    size_t n2 = 0;
*************** release_pages (void)
*** 1031,1037 ****
       This does not always work because the free_pages list is only
       approximately sorted. */
  
!   p = G.free_pages;
    prev = NULL;
    while (p)
      {
--- 1091,1097 ----
       This does not always work because the free_pages list is only
       approximately sorted. */
  
!   p = free_list->free_pages;
    prev = NULL;
    while (p)
      {
*************** release_pages (void)
*** 1060,1066 ****
  	  if (prev)
  	    prev->next = p;
            else
!             G.free_pages = p;
            G.bytes_mapped -= mapped_len;
  	  n1 += len;
  	  continue;
--- 1120,1126 ----
  	  if (prev)
  	    prev->next = p;
            else
! 	    free_list->free_pages = p;
            G.bytes_mapped -= mapped_len;
  	  n1 += len;
  	  continue;
*************** release_pages (void)
*** 1071,1077 ****
    /* Now give back the fragmented pages to the OS, but keep the address
       space to reuse it next time. */
  
!   for (p = G.free_pages; p; )
      {
        if (p->discarded)
          {
--- 1131,1137 ----
    /* Now give back the fragmented pages to the OS, but keep the address
       space to reuse it next time. */
  
!   for (p = free_list->free_pages; p; )
      {
        if (p->discarded)
          {
*************** release_pages (void)
*** 1108,1114 ****
    size_t len;
  
    /* Gather up adjacent pages so they are unmapped together.  */
!   p = G.free_pages;
  
    while (p)
      {
--- 1168,1174 ----
    size_t len;
  
    /* Gather up adjacent pages so they are unmapped together.  */
!   p = free_list->free_pages;
  
    while (p)
      {
*************** release_pages (void)
*** 1131,1144 ****
        G.bytes_mapped -= len;
      }
  
!   G.free_pages = NULL;
  #endif
  #ifdef USING_MALLOC_PAGE_GROUPS
    page_entry **pp, *p;
    page_group **gp, *g;
  
    /* Remove all pages from free page groups from the list.  */
!   pp = &G.free_pages;
    while ((p = *pp) != NULL)
      if (p->group->in_use == 0)
        {
--- 1191,1204 ----
        G.bytes_mapped -= len;
      }
  
!   free_list->free_pages = NULL;
  #endif
  #ifdef USING_MALLOC_PAGE_GROUPS
    page_entry **pp, *p;
    page_group **gp, *g;
  
    /* Remove all pages from free page groups from the list.  */
!   pp = &free_list->free_pages;
    while ((p = *pp) != NULL)
      if (p->group->in_use == 0)
        {
*************** release_pages (void)
*** 1172,1177 ****
--- 1232,1246 ----
      }
  }
  
+ /* Release the free page cache to the system.  */
+ 
+ static void
+ release_pages ()
+ {
+   for (int i = 0; i < num_free_list; i++)
+     do_release_pages (&G.free_lists[i]);
+ }
+ 
  /* This table provides a fast way to determine ceil(log_2(size)) for
     allocation requests.  The minimum allocation size is eight bytes.  */
  #define NUM_SIZE_LOOKUP 512
*************** init_ggc (void)
*** 1801,1809 ****
      /* We have a good page, might as well hold onto it...  */
      e = XCNEW (struct page_entry);
      e->bytes = G.pagesize;
      e->page = p;
!     e->next = G.free_pages;
!     G.free_pages = e;
    }
  #endif
  
--- 1870,1879 ----
      /* We have a good page, might as well hold onto it...  */
      e = XCNEW (struct page_entry);
      e->bytes = G.pagesize;
+     e->free_list = find_free_list (G.pagesize);
      e->page = p;
!     e->next = e->free_list->free_pages;
!     e->free_list->free_pages = e;
    }
  #endif
  
*************** ggc_print_statistics (void)
*** 2404,2409 ****
--- 2474,2482 ----
        fprintf (stderr, "Total Allocated under 128B:              "
  	       PRsa (9) "\n",
  	       SIZE_AMOUNT (G.stats.total_allocated_under128));
+       fprintf (stderr, "Number of free list fallbacks:           "
+ 	       PRsa (9) "\n",
+ 	       SIZE_AMOUNT (G.stats.fallback));
  
        for (i = 0; i < NUM_ORDERS; i++)
  	if (G.stats.total_allocated_per_order[i])
*************** ggc_pch_read (FILE *f, void *addr)
*** 2677,2682 ****
--- 2750,2756 ----
  					    - sizeof (long)
  					    + BITMAP_SIZE (num_objs + 1)));
        entry->bytes = bytes;
+       entry->free_list = find_free_list (bytes);
        entry->page = offs;
        entry->context_depth = 0;
        offs += bytes;
diff -Nrcpad gcc-16-20250518/gcc/gimple-lower-bitint.cc gcc-16-20250525/gcc/gimple-lower-bitint.cc
*** gcc-16-20250518/gcc/gimple-lower-bitint.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/gimple-lower-bitint.cc	Sun May 25 22:32:06 2025
*************** enum bitint_prec_kind {
*** 77,82 ****
--- 77,83 ----
  
  static int small_max_prec, mid_min_prec, large_min_prec, huge_min_prec;
  static int limb_prec;
+ static bool bitint_big_endian, bitint_extended;
  
  /* Categorize _BitInt(PREC) as small, middle, large or huge.  */
  
*************** bitint_precision_kind (int prec)
*** 101,106 ****
--- 102,109 ----
        small_max_prec = prec;
        return bitint_prec_small;
      }
+   bitint_big_endian = info.big_endian;
+   bitint_extended = info.extended;
    if (!large_min_prec
        && GET_MODE_PRECISION (limb_mode) < MAX_FIXED_MODE_SIZE)
      large_min_prec = MAX_FIXED_MODE_SIZE + 1;
*************** struct bitint_large_huge
*** 453,459 ****
    tree arith_overflow_extract_bits (unsigned int, unsigned int, tree,
  				    unsigned int, bool);
    void finish_arith_overflow (tree, tree, tree, tree, tree, tree, gimple *,
! 			      tree_code);
    void lower_addsub_overflow (tree, gimple *);
    void lower_mul_overflow (tree, gimple *);
    void lower_cplxpart_stmt (tree, gimple *);
--- 456,462 ----
    tree arith_overflow_extract_bits (unsigned int, unsigned int, tree,
  				    unsigned int, bool);
    void finish_arith_overflow (tree, tree, tree, tree, tree, tree, gimple *,
! 			      unsigned, tree_code);
    void lower_addsub_overflow (tree, gimple *);
    void lower_mul_overflow (tree, gimple *);
    void lower_cplxpart_stmt (tree, gimple *);
*************** bitint_large_huge::limb_access_type (tre
*** 594,600 ****
    unsigned HOST_WIDE_INT i = tree_to_uhwi (idx);
    unsigned int prec = TYPE_PRECISION (type);
    gcc_assert (i * limb_prec < prec);
!   if ((i + 1) * limb_prec <= prec)
      return m_limb_type;
    else
      return build_nonstandard_integer_type (prec % limb_prec,
--- 597,605 ----
    unsigned HOST_WIDE_INT i = tree_to_uhwi (idx);
    unsigned int prec = TYPE_PRECISION (type);
    gcc_assert (i * limb_prec < prec);
!   if (bitint_big_endian
!       ? (i != 0 || (prec % limb_prec) == 0)
!       : (i + 1) * limb_prec <= prec)
      return m_limb_type;
    else
      return build_nonstandard_integer_type (prec % limb_prec,
*************** bitint_large_huge::handle_operand (tree
*** 886,891 ****
--- 891,898 ----
  	      m_data.safe_push (NULL_TREE);
  	      m_data.safe_push (NULL_TREE);
  	    }
+ 	  if (bitint_big_endian)
+ 	    i = CEIL (TYPE_PRECISION (TREE_TYPE (op)), limb_prec) - 1 - i;
  	  if (limb_prec != HOST_BITS_PER_WIDE_INT)
  	    {
  	      wide_int w = wi::rshift (wi::to_wide (op), i * limb_prec,
*************** bitint_large_huge::handle_operand (tree
*** 964,985 ****
  	      min_prec = CEIL (min_prec, 2 * limb_prec) * (2 * limb_prec);
  	      tree type = build_bitint_type (min_prec, 1);
  	      tree c = tree_output_constant_def (fold_convert (type, op));
! 	      tree idx2 = make_ssa_name (sizetype);
! 	      g = gimple_build_assign (idx2, PLUS_EXPR, idx, size_one_node);
  	      insert_before (g);
! 	      g = gimple_build_cond (LT_EXPR, idx,
! 				     size_int (min_prec / limb_prec),
! 				     NULL_TREE, NULL_TREE);
  	      edge edge_true, edge_false;
  	      if_then (g, (min_prec >= (prec - rem) / 2
  			   ? profile_probability::likely ()
  			   : profile_probability::unlikely ()),
  		       edge_true, edge_false);
! 	      tree c1 = limb_access (TREE_TYPE (op), c, idx, false);
  	      g = gimple_build_assign (make_ssa_name (TREE_TYPE (c1)), c1);
  	      insert_before (g);
  	      c1 = gimple_assign_lhs (g);
! 	      tree c2 = limb_access (TREE_TYPE (op), c, idx2, false);
  	      g = gimple_build_assign (make_ssa_name (TREE_TYPE (c2)), c2);
  	      insert_before (g);
  	      c2 = gimple_assign_lhs (g);
--- 971,1011 ----
  	      min_prec = CEIL (min_prec, 2 * limb_prec) * (2 * limb_prec);
  	      tree type = build_bitint_type (min_prec, 1);
  	      tree c = tree_output_constant_def (fold_convert (type, op));
! 	      tree ridx = idx;
! 	      if (bitint_big_endian)
! 		{
! 		  ridx = make_ssa_name (sizetype);
! 		  g = gimple_build_assign (ridx, PLUS_EXPR, idx,
! 					   size_int (min_prec / limb_prec
! 						     - ((HOST_WIDE_INT)
! 							CEIL (prec,
! 							      limb_prec))));
! 		  insert_before (g);
! 		}
! 	      tree ridx2 = make_ssa_name (sizetype);
! 	      g = gimple_build_assign (ridx2, PLUS_EXPR, ridx,
! 				       bitint_big_endian
! 				       ? size_int (-1) : size_one_node);
  	      insert_before (g);
! 	      if (bitint_big_endian)
! 		g = gimple_build_cond (GE_EXPR, idx,
! 				       size_int (CEIL (prec, limb_prec)
! 						 - min_prec / limb_prec),
! 				       NULL_TREE, NULL_TREE);
! 	      else
! 		g = gimple_build_cond (LT_EXPR, idx,
! 				       size_int (min_prec / limb_prec),
! 				       NULL_TREE, NULL_TREE);
  	      edge edge_true, edge_false;
  	      if_then (g, (min_prec >= (prec - rem) / 2
  			   ? profile_probability::likely ()
  			   : profile_probability::unlikely ()),
  		       edge_true, edge_false);
! 	      tree c1 = limb_access (TREE_TYPE (op), c, ridx, false);
  	      g = gimple_build_assign (make_ssa_name (TREE_TYPE (c1)), c1);
  	      insert_before (g);
  	      c1 = gimple_assign_lhs (g);
! 	      tree c2 = limb_access (TREE_TYPE (op), c, ridx2, false);
  	      g = gimple_build_assign (make_ssa_name (TREE_TYPE (c2)), c2);
  	      insert_before (g);
  	      c2 = gimple_assign_lhs (g);
*************** bitint_large_huge::handle_operand (tree
*** 1014,1046 ****
  	      m_data[m_data_cnt + 1] = integer_type_node;
  	    }
  	  t = m_data[m_data_cnt];
! 	  if (m_data[m_data_cnt + 1] == NULL_TREE)
  	    {
! 	      t = limb_access (TREE_TYPE (op), t, idx, false);
! 	      g = gimple_build_assign (make_ssa_name (TREE_TYPE (t)), t);
  	      insert_before (g);
- 	      t = gimple_assign_lhs (g);
  	    }
! 	}
!       else if (m_data[m_data_cnt + 1] == NULL_TREE)
! 	{
! 	  t = limb_access (TREE_TYPE (op), m_data[m_data_cnt], idx, false);
  	  g = gimple_build_assign (make_ssa_name (TREE_TYPE (t)), t);
  	  insert_before (g);
  	  t = gimple_assign_lhs (g);
  	}
!       else
! 	t = m_data[m_data_cnt + 1];
!       if (m_data[m_data_cnt + 1] == integer_type_node)
  	{
  	  unsigned int prec = TYPE_PRECISION (TREE_TYPE (op));
  	  unsigned rem = prec % ((m_upwards_2limb ? 2 : 1) * limb_prec);
  	  int ext = wi::neg_p (wi::to_wide (op)) ? -1 : 0;
  	  tree c = m_data[m_data_cnt];
  	  unsigned min_prec = TYPE_PRECISION (TREE_TYPE (c));
! 	  g = gimple_build_cond (LT_EXPR, idx,
! 				 size_int (min_prec / limb_prec),
! 				 NULL_TREE, NULL_TREE);
  	  edge edge_true, edge_false;
  	  if_then (g, (min_prec >= (prec - rem) / 2
  		       ? profile_probability::likely ()
--- 1040,1085 ----
  	      m_data[m_data_cnt + 1] = integer_type_node;
  	    }
  	  t = m_data[m_data_cnt];
! 	}
!       else
! 	t = m_data[m_data_cnt + 1];
!       if (m_data[m_data_cnt + 1] == NULL_TREE)
! 	{
! 	  tree ridx = idx;
! 	  unsigned int prec = TYPE_PRECISION (TREE_TYPE (op));
! 	  tree c = m_data[m_data_cnt];
! 	  unsigned int min_prec = TYPE_PRECISION (TREE_TYPE (c));
! 	  if (bitint_big_endian
! 	      && CEIL (min_prec, limb_prec) != CEIL (prec, limb_prec))
  	    {
! 	      ridx = make_ssa_name (sizetype);
! 	      g = gimple_build_assign (ridx, PLUS_EXPR, idx,
! 				       size_int (CEIL (min_prec, limb_prec)
! 						 - ((HOST_WIDE_INT)
! 						    CEIL (prec, limb_prec))));
  	      insert_before (g);
  	    }
! 	  t = limb_access (TREE_TYPE (op), c, ridx, false);
  	  g = gimple_build_assign (make_ssa_name (TREE_TYPE (t)), t);
  	  insert_before (g);
  	  t = gimple_assign_lhs (g);
  	}
!       else if (m_data[m_data_cnt + 1] == integer_type_node)
  	{
  	  unsigned int prec = TYPE_PRECISION (TREE_TYPE (op));
  	  unsigned rem = prec % ((m_upwards_2limb ? 2 : 1) * limb_prec);
  	  int ext = wi::neg_p (wi::to_wide (op)) ? -1 : 0;
  	  tree c = m_data[m_data_cnt];
  	  unsigned min_prec = TYPE_PRECISION (TREE_TYPE (c));
! 	  if (bitint_big_endian)
! 	    g = gimple_build_cond (GE_EXPR, idx,
! 				   size_int (CEIL (prec, limb_prec)
! 					     - min_prec / limb_prec),
! 				   NULL_TREE, NULL_TREE);
! 	  else
! 	    g = gimple_build_cond (LT_EXPR, idx,
! 				   size_int (min_prec / limb_prec),
! 				   NULL_TREE, NULL_TREE);
  	  edge edge_true, edge_false;
  	  if_then (g, (min_prec >= (prec - rem) / 2
  		       ? profile_probability::likely ()
*************** bitint_large_huge::handle_operand (tree
*** 1048,1054 ****
  		   edge_true, edge_false);
  	  if (min_prec > (unsigned) limb_prec)
  	    {
! 	      c = limb_access (TREE_TYPE (op), c, idx, false);
  	      g = gimple_build_assign (make_ssa_name (TREE_TYPE (c)), c);
  	      insert_before (g);
  	      c = gimple_assign_lhs (g);
--- 1087,1104 ----
  		   edge_true, edge_false);
  	  if (min_prec > (unsigned) limb_prec)
  	    {
! 	      tree ridx = idx;
! 	      if (bitint_big_endian)
! 		{
! 		  ridx = make_ssa_name (sizetype);
! 		  g = gimple_build_assign (ridx, PLUS_EXPR, idx,
! 					   size_int (min_prec / limb_prec
! 						     - ((HOST_WIDE_INT)
! 							CEIL (prec,
! 							      limb_prec))));
! 		  insert_before (g);
! 		}
! 	      c = limb_access (TREE_TYPE (op), c, ridx, false);
  	      g = gimple_build_assign (make_ssa_name (TREE_TYPE (c)), c);
  	      insert_before (g);
  	      c = gimple_assign_lhs (g);
*************** bitint_large_huge::handle_cast (tree lhs
*** 1312,1318 ****
  		      && (m_upwards_2limb * limb_prec
  			  < TYPE_PRECISION (lhs_type))))))
  	{
! 	  rhs1 = handle_operand (rhs1, idx);
  	  if (tree_fits_uhwi_p (idx))
  	    {
  	      tree type = limb_access_type (lhs_type, idx);
--- 1362,1385 ----
  		      && (m_upwards_2limb * limb_prec
  			  < TYPE_PRECISION (lhs_type))))))
  	{
! 	  tree ridx = idx;
! 	  if (bitint_big_endian
! 	      && (CEIL (TYPE_PRECISION (lhs_type), limb_prec)
! 		  != CEIL (TYPE_PRECISION (rhs_type), limb_prec)))
! 	    {
! 	      HOST_WIDE_INT diff = CEIL (TYPE_PRECISION (rhs_type), limb_prec);
! 	      diff -= CEIL (TYPE_PRECISION (lhs_type), limb_prec);
! 	      if (tree_fits_uhwi_p (idx))
! 		ridx = size_int (tree_to_uhwi (idx) + diff);
! 	      else
! 		{
! 		  tree t = make_ssa_name (sizetype);
! 		  g = gimple_build_assign (t, PLUS_EXPR, idx, size_int (diff));
! 		  insert_before (g);
! 		  ridx = t;
! 		}
! 	    }
! 	  rhs1 = handle_operand (rhs1, ridx);
  	  if (tree_fits_uhwi_p (idx))
  	    {
  	      tree type = limb_access_type (lhs_type, idx);
*************** bitint_large_huge::handle_cast (tree lhs
*** 1327,1332 ****
--- 1394,1401 ----
  		      - !TYPE_UNSIGNED (rhs_type)) / limb_prec;
        /* Indexes >= than this always contain an extension.  */
        unsigned high = CEIL ((unsigned) TYPE_PRECISION (rhs_type), limb_prec);
+       unsigned lcnt = CEIL ((unsigned) TYPE_PRECISION (lhs_type), limb_prec);
+       unsigned lowe = bitint_big_endian ? lcnt - 1 - low : low;
        bool save_first = m_first;
        if (m_first)
  	{
*************** bitint_large_huge::handle_cast (tree lhs
*** 1351,1357 ****
  	      else
  		gsi_next (&m_gsi);
  	      m_data_cnt = save_data_cnt + 3;
! 	      t = handle_operand (rhs1, size_int (low));
  	      m_first = false;
  	      m_data[save_data_cnt + 2]
  		= build_int_cst (NULL_TREE, m_data_cnt);
--- 1420,1427 ----
  	      else
  		gsi_next (&m_gsi);
  	      m_data_cnt = save_data_cnt + 3;
! 	      t = handle_operand (rhs1, size_int (bitint_big_endian
! 						  ? high - 1 - low : low));
  	      m_first = false;
  	      m_data[save_data_cnt + 2]
  		= build_int_cst (NULL_TREE, m_data_cnt);
*************** bitint_large_huge::handle_cast (tree lhs
*** 1389,1394 ****
--- 1459,1476 ----
  	  if (m_upwards_2limb
  	      && low >= m_upwards_2limb - m_first)
  	    {
+ 	      if (bitint_big_endian
+ 		  && (CEIL (TYPE_PRECISION (lhs_type), limb_prec)
+ 		      != CEIL (TYPE_PRECISION (rhs_type), limb_prec)))
+ 		{
+ 		  HOST_WIDE_INT diff
+ 		    = CEIL (TYPE_PRECISION (rhs_type), limb_prec);
+ 		  diff -= CEIL (TYPE_PRECISION (lhs_type), limb_prec);
+ 		  tree t = make_ssa_name (sizetype);
+ 		  g = gimple_build_assign (t, PLUS_EXPR, idx, size_int (diff));
+ 		  insert_before (g);
+ 		  idx = t;
+ 		}
  	      rhs1 = handle_operand (rhs1, idx);
  	      if (m_first)
  		m_data[save_data_cnt + 2]
*************** bitint_large_huge::handle_cast (tree lhs
*** 1410,1422 ****
  	       emits.  So, instead of special-casing that, emit a
  	       low <= low comparison which cfg cleanup will clean up
  	       at the end of the pass.  */
! 	    idxc = size_int (low);
! 	  g = gimple_build_cond (single_comparison ? LT_EXPR : LE_EXPR,
! 				 idxc, size_int (low), NULL_TREE, NULL_TREE);
  	  edge edge_true_true, edge_true_false, edge_false;
  	  if_then_if_then_else (g, (single_comparison ? NULL
  				    : gimple_build_cond (EQ_EXPR, idx,
! 							 size_int (low),
  							 NULL_TREE,
  							 NULL_TREE)),
  				profile_probability::likely (),
--- 1492,1509 ----
  	       emits.  So, instead of special-casing that, emit a
  	       low <= low comparison which cfg cleanup will clean up
  	       at the end of the pass.  */
! 	    idxc = size_int (lowe);
! 	  if (bitint_big_endian)
! 	    g = gimple_build_cond (single_comparison ? GT_EXPR : GE_EXPR,
! 				   idxc, size_int (lowe),
! 				   NULL_TREE, NULL_TREE);
! 	  else
! 	    g = gimple_build_cond (single_comparison ? LT_EXPR : LE_EXPR,
! 				   idxc, size_int (low), NULL_TREE, NULL_TREE);
  	  edge edge_true_true, edge_true_false, edge_false;
  	  if_then_if_then_else (g, (single_comparison ? NULL
  				    : gimple_build_cond (EQ_EXPR, idx,
! 							 size_int (lowe),
  							 NULL_TREE,
  							 NULL_TREE)),
  				profile_probability::likely (),
*************** bitint_large_huge::handle_cast (tree lhs
*** 1425,1431 ****
  	  bool save_cast_conditional = m_cast_conditional;
  	  m_cast_conditional = true;
  	  m_bitfld_load = 0;
! 	  tree t1 = handle_operand (rhs1, idx), t2 = NULL_TREE;
  	  if (m_first)
  	    m_data[save_data_cnt + 2]
  	      = build_int_cst (NULL_TREE, m_data_cnt);
--- 1512,1529 ----
  	  bool save_cast_conditional = m_cast_conditional;
  	  m_cast_conditional = true;
  	  m_bitfld_load = 0;
! 	  tree t1 = idx, t2 = NULL_TREE;
! 	  if (bitint_big_endian
! 	      && (CEIL (TYPE_PRECISION (lhs_type), limb_prec)
! 		  != CEIL (TYPE_PRECISION (rhs_type), limb_prec)))
! 	    {
! 	      HOST_WIDE_INT diff = CEIL (TYPE_PRECISION (rhs_type), limb_prec);
! 	      diff -= CEIL (TYPE_PRECISION (lhs_type), limb_prec);
! 	      t1 = make_ssa_name (sizetype);
! 	      g = gimple_build_assign (t1, PLUS_EXPR, idx, size_int (diff));
! 	      insert_before (g);
! 	    }
! 	  t1 = handle_operand (rhs1, t1);
  	  if (m_first)
  	    m_data[save_data_cnt + 2]
  	      = build_int_cst (NULL_TREE, m_data_cnt);
*************** bitint_large_huge::handle_cast (tree lhs
*** 1442,1448 ****
  		  m_data[m_bitfld_load] = m_data[m_bitfld_load + 2];
  		  m_bitfld_load = 0;
  		}
! 	      t2 = handle_operand (rhs1, size_int (low));
  	      if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (t2)))
  		t2 = add_cast (m_limb_type, t2);
  	      if (!TYPE_UNSIGNED (rhs_type) && m_upwards_2limb)
--- 1540,1547 ----
  		  m_data[m_bitfld_load] = m_data[m_bitfld_load + 2];
  		  m_bitfld_load = 0;
  		}
! 	      t2 = handle_operand (rhs1, size_int (bitint_big_endian
! 						   ? high - 1 - low : low));
  	      if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (t2)))
  		t2 = add_cast (m_limb_type, t2);
  	      if (!TYPE_UNSIGNED (rhs_type) && m_upwards_2limb)
*************** bitint_large_huge::handle_cast (tree lhs
*** 1548,1563 ****
        else
  	{
  	  unsigned tidx = tree_to_uhwi (idx);
  	  if (tidx < low)
  	    {
! 	      t = handle_operand (rhs1, idx);
  	      if (m_first)
  		m_data[save_data_cnt + 2]
  		  = build_int_cst (NULL_TREE, m_data_cnt);
  	    }
  	  else if (tidx < high)
  	    {
! 	      t = handle_operand (rhs1, size_int (low));
  	      if (m_first)
  		m_data[save_data_cnt + 2]
  		  = build_int_cst (NULL_TREE, m_data_cnt);
--- 1647,1666 ----
        else
  	{
  	  unsigned tidx = tree_to_uhwi (idx);
+ 	  if (bitint_big_endian)
+ 	    tidx = lcnt - 1 - tidx;
  	  if (tidx < low)
  	    {
! 	      t = handle_operand (rhs1, (bitint_big_endian
! 					 ? size_int (high - 1 - tidx) : idx));
  	      if (m_first)
  		m_data[save_data_cnt + 2]
  		  = build_int_cst (NULL_TREE, m_data_cnt);
  	    }
  	  else if (tidx < high)
  	    {
! 	      t = handle_operand (rhs1, size_int (bitint_big_endian
! 						  ? high - 1 - low : low));
  	      if (m_first)
  		m_data[save_data_cnt + 2]
  		  = build_int_cst (NULL_TREE, m_data_cnt);
*************** bitint_large_huge::handle_cast (tree lhs
*** 1580,1586 ****
  	    {
  	      if (TYPE_UNSIGNED (rhs_type) && m_first)
  		{
! 		  handle_operand (rhs1, size_zero_node);
  		  m_data[save_data_cnt + 2]
  		    = build_int_cst (NULL_TREE, m_data_cnt);
  		}
--- 1683,1691 ----
  	    {
  	      if (TYPE_UNSIGNED (rhs_type) && m_first)
  		{
! 		  handle_operand (rhs1, (bitint_big_endian
! 					 ? size_int (high - 1)
! 					 : size_zero_node));
  		  m_data[save_data_cnt + 2]
  		    = build_int_cst (NULL_TREE, m_data_cnt);
  		}
*************** bitint_large_huge::handle_cast (tree lhs
*** 1695,1707 ****
  	  m_data.safe_push (r2);
  	  m_data.safe_push (rext);
  	}
        if (tree_fits_uhwi_p (idx))
  	{
  	  tree type = limb_access_type (lhs_type, idx);
! 	  if (integer_zerop (idx))
  	    t = m_data[m_data_cnt];
  	  else if (TYPE_PRECISION (rhs_type) > limb_prec
! 		   && integer_onep (idx))
  	    t = m_data[m_data_cnt + 1];
  	  else
  	    t = m_data[m_data_cnt + 2];
--- 1800,1816 ----
  	  m_data.safe_push (r2);
  	  m_data.safe_push (rext);
  	}
+       unsigned lcnt = CEIL ((unsigned) TYPE_PRECISION (lhs_type), limb_prec);
        if (tree_fits_uhwi_p (idx))
  	{
  	  tree type = limb_access_type (lhs_type, idx);
! 	  if (bitint_big_endian
! 	      ? tree_to_uhwi (idx) == lcnt - 1 : integer_zerop (idx))
  	    t = m_data[m_data_cnt];
  	  else if (TYPE_PRECISION (rhs_type) > limb_prec
! 		   && (bitint_big_endian
! 		       ? tree_to_uhwi (idx) == lcnt - 2
! 		       : integer_onep (idx)))
  	    t = m_data[m_data_cnt + 1];
  	  else
  	    t = m_data[m_data_cnt + 2];
*************** bitint_large_huge::handle_cast (tree lhs
*** 1710,1722 ****
  	  m_data_cnt += 3;
  	  return t;
  	}
!       g = gimple_build_cond (NE_EXPR, idx, size_zero_node,
  			     NULL_TREE, NULL_TREE);
        edge e2, e3, e4 = NULL;
        if_then (g, profile_probability::likely (), e2, e3);
        if (m_data[m_data_cnt + 1])
  	{
! 	  g = gimple_build_cond (EQ_EXPR, idx, size_one_node,
  				 NULL_TREE, NULL_TREE);
  	  insert_before (g);
  	  edge e5 = split_block (gsi_bb (m_gsi), g);
--- 1819,1835 ----
  	  m_data_cnt += 3;
  	  return t;
  	}
!       g = gimple_build_cond (NE_EXPR, idx,
! 			     bitint_big_endian
! 			     ? size_int (lcnt - 1) : size_zero_node,
  			     NULL_TREE, NULL_TREE);
        edge e2, e3, e4 = NULL;
        if_then (g, profile_probability::likely (), e2, e3);
        if (m_data[m_data_cnt + 1])
  	{
! 	  g = gimple_build_cond (EQ_EXPR, idx,
! 				 bitint_big_endian
! 				 ? size_int (lcnt - 2) : size_one_node,
  				 NULL_TREE, NULL_TREE);
  	  insert_before (g);
  	  edge e5 = split_block (gsi_bb (m_gsi), g);
*************** bitint_large_huge::handle_bit_field_ref
*** 1750,1760 ****
  	m_data.safe_push (NULL);
        ++m_data_cnt;
        unsigned HOST_WIDE_INT sz = tree_to_uhwi (TYPE_SIZE (m_limb_type));
        tree bfr = build3 (BIT_FIELD_REF, m_limb_type,
  			 TREE_OPERAND (op, 0),
  			 TYPE_SIZE (m_limb_type),
  			 size_binop (PLUS_EXPR, TREE_OPERAND (op, 2),
! 				     bitsize_int (tree_to_uhwi (idx) * sz)));
        tree r = make_ssa_name (m_limb_type);
        gimple *g = gimple_build_assign (r, bfr);
        insert_before (g);
--- 1863,1876 ----
  	m_data.safe_push (NULL);
        ++m_data_cnt;
        unsigned HOST_WIDE_INT sz = tree_to_uhwi (TYPE_SIZE (m_limb_type));
+       unsigned i = tree_to_uhwi (idx);
+       if (bitint_big_endian)
+ 	i = CEIL (TYPE_PRECISION (TREE_TYPE (op)), limb_prec) - 1 - i;
        tree bfr = build3 (BIT_FIELD_REF, m_limb_type,
  			 TREE_OPERAND (op, 0),
  			 TYPE_SIZE (m_limb_type),
  			 size_binop (PLUS_EXPR, TREE_OPERAND (op, 2),
! 				     bitsize_int (i * sz)));
        tree r = make_ssa_name (m_limb_type);
        gimple *g = gimple_build_assign (r, bfr);
        insert_before (g);
*************** bitint_large_huge::handle_load (gimple *
*** 1868,1879 ****
        /* For little-endian, we can allow as inputs bit-fields
  	 which start at a limb boundary.  */
        gcc_assert (tree_fits_uhwi_p (DECL_FIELD_BIT_OFFSET (fld)));
!       if (DECL_OFFSET_ALIGN (fld) >= TYPE_ALIGN (TREE_TYPE (rhs1))
  	  && (tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld)) % limb_prec) == 0)
  	goto normal_load;
!       /* Even if DECL_FIELD_BIT_OFFSET (fld) is a multiple of UNITS_PER_BIT,
  	 handle it normally for now.  */
!       if ((tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld)) % BITS_PER_UNIT) == 0)
  	goto normal_load;
        tree repr = DECL_BIT_FIELD_REPRESENTATIVE (fld);
        poly_int64 bitoffset;
--- 1984,1997 ----
        /* For little-endian, we can allow as inputs bit-fields
  	 which start at a limb boundary.  */
        gcc_assert (tree_fits_uhwi_p (DECL_FIELD_BIT_OFFSET (fld)));
!       if (!bitint_big_endian
! 	  && DECL_OFFSET_ALIGN (fld) >= TYPE_ALIGN (TREE_TYPE (rhs1))
  	  && (tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld)) % limb_prec) == 0)
  	goto normal_load;
!       /* Even if DECL_FIELD_BIT_OFFSET (fld) is a multiple of BITS_PER_UNIT,
  	 handle it normally for now.  */
!       if (!bitint_big_endian
! 	  && (tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld)) % BITS_PER_UNIT) == 0)
  	goto normal_load;
        tree repr = DECL_BIT_FIELD_REPRESENTATIVE (fld);
        poly_int64 bitoffset;
*************** bitint_large_huge::handle_load (gimple *
*** 1895,1903 ****
        HOST_WIDE_INT bo = bitoffset.to_constant ();
        unsigned bo_idx = (unsigned HOST_WIDE_INT) bo / limb_prec;
        unsigned bo_bit = (unsigned HOST_WIDE_INT) bo % limb_prec;
        if (m_first)
  	{
! 	  if (m_upwards)
  	    {
  	      gimple_stmt_iterator save_gsi = m_gsi;
  	      m_gsi = m_init_gsi;
--- 2013,2031 ----
        HOST_WIDE_INT bo = bitoffset.to_constant ();
        unsigned bo_idx = (unsigned HOST_WIDE_INT) bo / limb_prec;
        unsigned bo_bit = (unsigned HOST_WIDE_INT) bo % limb_prec;
+       unsigned bo_last = 0;
+       unsigned bo_shift = bo_bit;
+       unsigned nelts = CEIL (TYPE_PRECISION (rhs_type), limb_prec);
+       if (bitint_big_endian)
+ 	{
+ 	  bo_last = CEIL (TYPE_PRECISION (rhs_type) + bo_bit, limb_prec) - 1;
+ 	  bo_shift = (TYPE_PRECISION (rhs_type) + bo_bit) % limb_prec;
+ 	  if (bo_shift)
+ 	    bo_shift = limb_prec - bo_shift;
+ 	}
        if (m_first)
  	{
! 	  if (m_upwards && bo_shift)
  	    {
  	      gimple_stmt_iterator save_gsi = m_gsi;
  	      m_gsi = m_init_gsi;
*************** bitint_large_huge::handle_load (gimple *
*** 1905,1911 ****
  		m_gsi = gsi_after_labels (gsi_bb (m_gsi));
  	      else
  		gsi_next (&m_gsi);
! 	      tree t = limb_access (NULL_TREE, nrhs1, size_int (bo_idx), true);
  	      tree iv = make_ssa_name (m_limb_type);
  	      g = gimple_build_assign (iv, t);
  	      insert_before (g);
--- 2033,2040 ----
  		m_gsi = gsi_after_labels (gsi_bb (m_gsi));
  	      else
  		gsi_next (&m_gsi);
! 	      tree t = limb_access (NULL_TREE, nrhs1,
! 				    size_int (bo_idx + bo_last), true);
  	      tree iv = make_ssa_name (m_limb_type);
  	      g = gimple_build_assign (iv, t);
  	      insert_before (g);
*************** bitint_large_huge::handle_load (gimple *
*** 1947,1953 ****
  	    }
  	}
  
!       tree nidx0 = NULL_TREE, nidx1;
        tree iv = m_data[m_data_cnt];
        if (m_cast_conditional && iv)
  	{
--- 2076,2082 ----
  	    }
  	}
  
!       tree nidx0 = NULL_TREE, nidx1 = NULL_TREE;
        tree iv = m_data[m_data_cnt];
        if (m_cast_conditional && iv)
  	{
*************** bitint_large_huge::handle_load (gimple *
*** 1958,1965 ****
  	{
  	  unsigned prec = TYPE_PRECISION (rhs_type);
  	  unsigned HOST_WIDE_INT i = tree_to_uhwi (idx);
  	  gcc_assert (i * limb_prec < prec);
! 	  nidx1 = size_int (i + bo_idx + 1);
  	  if ((i + 1) * limb_prec > prec)
  	    {
  	      prec %= limb_prec;
--- 2087,2098 ----
  	{
  	  unsigned prec = TYPE_PRECISION (rhs_type);
  	  unsigned HOST_WIDE_INT i = tree_to_uhwi (idx);
+ 	  if (bitint_big_endian)
+ 	    i = nelts - 1 - i;
  	  gcc_assert (i * limb_prec < prec);
! 	  if (bo_shift)
! 	    nidx1 = size_int (bo_idx + (bitint_big_endian
! 					? bo_last - i - 1 : i + 1));
  	  if ((i + 1) * limb_prec > prec)
  	    {
  	      prec %= limb_prec;
*************** bitint_large_huge::handle_load (gimple *
*** 1967,1992 ****
  		nidx1 = NULL_TREE;
  	    }
  	  if (!iv)
! 	    nidx0 = size_int (i + bo_idx);
  	}
        else
  	{
  	  if (!iv)
  	    {
! 	      if (bo_idx == 0)
  		nidx0 = idx;
  	      else
  		{
  		  nidx0 = make_ssa_name (sizetype);
  		  g = gimple_build_assign (nidx0, PLUS_EXPR, idx,
! 					   size_int (bo_idx));
  		  insert_before (g);
  		}
  	    }
- 	  nidx1 = make_ssa_name (sizetype);
- 	  g = gimple_build_assign (nidx1, PLUS_EXPR, idx,
- 				   size_int (bo_idx + 1));
- 	  insert_before (g);
  	}
  
        tree iv2 = NULL_TREE;
--- 2100,2137 ----
  		nidx1 = NULL_TREE;
  	    }
  	  if (!iv)
! 	    nidx0 = size_int (bo_idx + (bitint_big_endian ? bo_last - i : i));
  	}
        else
  	{
+ 	  HOST_WIDE_INT adj = bo_idx;
+ 	  if (bitint_big_endian)
+ 	    adj += (HOST_WIDE_INT) bo_last + 1 - nelts;
  	  if (!iv)
  	    {
! 	      if (adj == 0)
  		nidx0 = idx;
  	      else
  		{
  		  nidx0 = make_ssa_name (sizetype);
  		  g = gimple_build_assign (nidx0, PLUS_EXPR, idx,
! 					   size_int (adj));
! 		  insert_before (g);
! 		}
! 	    }
! 	  if (bo_shift)
! 	    {
! 	      if (bitint_big_endian && adj == 1)
! 		nidx1 = idx;
! 	      else
! 		{
! 		  nidx1 = make_ssa_name (sizetype);
! 		  g = gimple_build_assign (nidx1, PLUS_EXPR, idx,
! 					   size_int (adj + (bitint_big_endian
! 							    ? -1 : 1)));
  		  insert_before (g);
  		}
  	    }
  	}
  
        tree iv2 = NULL_TREE;
*************** bitint_large_huge::handle_load (gimple *
*** 1996,2002 ****
  	  iv = make_ssa_name (m_limb_type);
  	  g = gimple_build_assign (iv, t);
  	  insert_before (g);
! 	  gcc_assert (!eh);
  	}
        if (nidx1)
  	{
--- 2141,2156 ----
  	  iv = make_ssa_name (m_limb_type);
  	  g = gimple_build_assign (iv, t);
  	  insert_before (g);
! 	  if (eh)
! 	    {
! 	      maybe_duplicate_eh_stmt (g, stmt);
! 	      if (eh_edge)
! 		{
! 		  edge e = split_block (gsi_bb (m_gsi), g);
! 		  m_gsi = gsi_after_labels (e->dest);
! 		  add_eh_edge (e->src, eh_edge);
! 		}
! 	    }
  	}
        if (nidx1)
  	{
*************** bitint_large_huge::handle_load (gimple *
*** 2012,2018 ****
  	  if (conditional)
  	    {
  	      g = gimple_build_cond (NE_EXPR, idx,
! 				     size_int (prec / limb_prec),
  				     NULL_TREE, NULL_TREE);
  	      if_then (g, profile_probability::likely (),
  		       edge_true, edge_false);
--- 2166,2174 ----
  	  if (conditional)
  	    {
  	      g = gimple_build_cond (NE_EXPR, idx,
! 				     bitint_big_endian
! 				     ? size_zero_node
! 				     : size_int (prec / limb_prec),
  				     NULL_TREE, NULL_TREE);
  	      if_then (g, profile_probability::likely (),
  		       edge_true, edge_false);
*************** bitint_large_huge::handle_load (gimple *
*** 2050,2064 ****
  	      iv2 = iv3;
  	    }
  	}
!       g = gimple_build_assign (make_ssa_name (m_limb_type), RSHIFT_EXPR,
! 			       iv, build_int_cst (unsigned_type_node, bo_bit));
!       insert_before (g);
!       iv = gimple_assign_lhs (g);
        if (iv2)
  	{
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), LSHIFT_EXPR,
  				   iv2, build_int_cst (unsigned_type_node,
! 						       limb_prec - bo_bit));
  	  insert_before (g);
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), BIT_IOR_EXPR,
  				   gimple_assign_lhs (g), iv);
--- 2206,2224 ----
  	      iv2 = iv3;
  	    }
  	}
!       if (bo_shift)
! 	{
! 	  g = gimple_build_assign (make_ssa_name (m_limb_type), RSHIFT_EXPR,
! 				   iv, build_int_cst (unsigned_type_node,
! 						      bo_shift));
! 	  insert_before (g);
! 	  iv = gimple_assign_lhs (g);
! 	}
        if (iv2)
  	{
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), LSHIFT_EXPR,
  				   iv2, build_int_cst (unsigned_type_node,
! 						       limb_prec - bo_shift));
  	  insert_before (g);
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), BIT_IOR_EXPR,
  				   gimple_assign_lhs (g), iv);
*************** bitint_large_huge::handle_operand_addr (
*** 2221,2226 ****
--- 2381,2388 ----
  {
    wide_int w;
    location_t loc_save = m_loc;
+   tree ret = NULL_TREE;
+   int precs = 0;
    if ((TREE_CODE (TREE_TYPE (op)) != BITINT_TYPE
         || bitint_precision_kind (TREE_TYPE (op)) < bitint_prec_large)
        && TREE_CODE (op) != INTEGER_CST)
*************** bitint_large_huge::handle_operand_addr (
*** 2244,2273 ****
  	 limb mode smaller than half of largest supported normal
  	 integral type, this will not be needed.  */
        gcc_assert (nelts <= 2);
!       if (prec_stored)
! 	*prec_stored = (TYPE_UNSIGNED (op_type)
! 			? TYPE_PRECISION (op_type)
! 			: -TYPE_PRECISION (op_type));
        if (*prec <= limb_prec && *prec >= -limb_prec)
  	{
  	  nelts = 1;
! 	  if (prec_stored)
  	    {
! 	      if (TYPE_UNSIGNED (op_type))
! 		{
! 		  if (*prec_stored > limb_prec)
! 		    *prec_stored = limb_prec;
! 		}
! 	      else if (*prec_stored < -limb_prec)
! 		*prec_stored = -limb_prec;
  	    }
  	}
        tree atype = build_array_type_nelts (m_limb_type, nelts);
        tree var = create_tmp_var (atype);
        tree t1 = op;
        if (!useless_type_conversion_p (m_limb_type, op_type))
  	t1 = add_cast (m_limb_type, t1);
!       tree v = build4 (ARRAY_REF, m_limb_type, var, size_zero_node,
  		       NULL_TREE, NULL_TREE);
        gimple *g = gimple_build_assign (v, t1);
        insert_before (g);
--- 2406,2434 ----
  	 limb mode smaller than half of largest supported normal
  	 integral type, this will not be needed.  */
        gcc_assert (nelts <= 2);
!       precs = (TYPE_UNSIGNED (op_type)
! 	       ? TYPE_PRECISION (op_type) : -TYPE_PRECISION (op_type));
        if (*prec <= limb_prec && *prec >= -limb_prec)
  	{
  	  nelts = 1;
! 	  if (TYPE_UNSIGNED (op_type))
  	    {
! 	      if (precs > limb_prec)
! 		precs = limb_prec;
  	    }
+ 	  else if (precs < -limb_prec)
+ 	    precs = -limb_prec;
  	}
+       if (prec_stored)
+ 	*prec_stored = precs;
        tree atype = build_array_type_nelts (m_limb_type, nelts);
        tree var = create_tmp_var (atype);
        tree t1 = op;
        if (!useless_type_conversion_p (m_limb_type, op_type))
  	t1 = add_cast (m_limb_type, t1);
!       tree v = build4 (ARRAY_REF, m_limb_type, var,
! 		       bitint_big_endian && nelts > 1
! 		       ? size_one_node : size_zero_node,
  		       NULL_TREE, NULL_TREE);
        gimple *g = gimple_build_assign (v, t1);
        insert_before (g);
*************** bitint_large_huge::handle_operand_addr (
*** 2279,2290 ****
  	  insert_before (g);
  	  tree t2 = gimple_assign_lhs (g);
  	  t2 = add_cast (m_limb_type, t2);
! 	  v = build4 (ARRAY_REF, m_limb_type, var, size_one_node,
  		      NULL_TREE, NULL_TREE);
  	  g = gimple_build_assign (v, t2);
  	  insert_before (g);
  	}
!       tree ret = build_fold_addr_expr (var);
        if (!stmt_ends_bb_p (gsi_stmt (m_gsi)))
  	{
  	  tree clobber = build_clobber (atype, CLOBBER_STORAGE_END);
--- 2440,2452 ----
  	  insert_before (g);
  	  tree t2 = gimple_assign_lhs (g);
  	  t2 = add_cast (m_limb_type, t2);
! 	  v = build4 (ARRAY_REF, m_limb_type, var,
! 		      bitint_big_endian ? size_zero_node : size_one_node,
  		      NULL_TREE, NULL_TREE);
  	  g = gimple_build_assign (v, t2);
  	  insert_before (g);
  	}
!       ret = build_fold_addr_expr (var);
        if (!stmt_ends_bb_p (gsi_stmt (m_gsi)))
  	{
  	  tree clobber = build_clobber (atype, CLOBBER_STORAGE_END);
*************** bitint_large_huge::handle_operand_addr (
*** 2292,2298 ****
  	  gsi_insert_after (&m_gsi, g, GSI_SAME_STMT);
  	}
        m_loc = loc_save;
!       return ret;
      }
    switch (TREE_CODE (op))
      {
--- 2454,2460 ----
  	  gsi_insert_after (&m_gsi, g, GSI_SAME_STMT);
  	}
        m_loc = loc_save;
!       goto do_ret;
      }
    switch (TREE_CODE (op))
      {
*************** bitint_large_huge::handle_operand_addr (
*** 2301,2315 ****
  	  || !bitmap_bit_p (m_names, SSA_NAME_VERSION (op)))
  	{
  	  gimple *g = SSA_NAME_DEF_STMT (op);
- 	  tree ret;
  	  m_loc = gimple_location (g);
  	  if (gimple_assign_load_p (g))
  	    {
  	      *prec = range_to_prec (op, NULL);
  	      if (prec_stored)
! 		*prec_stored = (TYPE_UNSIGNED (TREE_TYPE (op))
! 				? TYPE_PRECISION (TREE_TYPE (op))
! 				: -TYPE_PRECISION (TREE_TYPE (op)));
  	      ret = build_fold_addr_expr (gimple_assign_rhs1 (g));
  	      ret = force_gimple_operand_gsi (&m_gsi, ret, true,
  					      NULL_TREE, true, GSI_SAME_STMT);
--- 2463,2477 ----
  	  || !bitmap_bit_p (m_names, SSA_NAME_VERSION (op)))
  	{
  	  gimple *g = SSA_NAME_DEF_STMT (op);
  	  m_loc = gimple_location (g);
  	  if (gimple_assign_load_p (g))
  	    {
  	      *prec = range_to_prec (op, NULL);
+ 	      precs = (TYPE_UNSIGNED (TREE_TYPE (op))
+ 		       ? TYPE_PRECISION (TREE_TYPE (op))
+ 		       : -TYPE_PRECISION (TREE_TYPE (op)));
  	      if (prec_stored)
! 		*prec_stored = precs;
  	      ret = build_fold_addr_expr (gimple_assign_rhs1 (g));
  	      ret = force_gimple_operand_gsi (&m_gsi, ret, true,
  					      NULL_TREE, true, GSI_SAME_STMT);
*************** bitint_large_huge::handle_operand_addr (
*** 2317,2324 ****
  	  else if (gimple_code (g) == GIMPLE_NOP)
  	    {
  	      *prec = TYPE_UNSIGNED (TREE_TYPE (op)) ? limb_prec : -limb_prec;
  	      if (prec_stored)
! 		*prec_stored = *prec;
  	      tree var = create_tmp_var (m_limb_type);
  	      TREE_ADDRESSABLE (var) = 1;
  	      ret = build_fold_addr_expr (var);
--- 2479,2487 ----
  	  else if (gimple_code (g) == GIMPLE_NOP)
  	    {
  	      *prec = TYPE_UNSIGNED (TREE_TYPE (op)) ? limb_prec : -limb_prec;
+ 	      precs = *prec;
  	      if (prec_stored)
! 		*prec_stored = precs;
  	      tree var = create_tmp_var (m_limb_type);
  	      TREE_ADDRESSABLE (var) = 1;
  	      ret = build_fold_addr_expr (var);
*************** bitint_large_huge::handle_operand_addr (
*** 2346,2351 ****
--- 2509,2515 ----
  		  tree rhs_type = TREE_TYPE (rhs1);
  		  int prec_stored_val = 0;
  		  ret = handle_operand_addr (rhs1, g, &prec_stored_val, prec);
+ 		  precs = prec_stored_val;
  		  if (TYPE_PRECISION (lhs_type) > TYPE_PRECISION (rhs_type))
  		    {
  		      if (TYPE_UNSIGNED (lhs_type)
*************** bitint_large_huge::handle_operand_addr (
*** 2378,2395 ****
  		}
  	    }
  	  m_loc = loc_save;
! 	  return ret;
  	}
        else
  	{
  	  int p = var_to_partition (m_map, op);
  	  gcc_assert (m_vars[p] != NULL_TREE);
  	  *prec = range_to_prec (op, stmt);
  	  if (prec_stored)
! 	    *prec_stored = (TYPE_UNSIGNED (TREE_TYPE (op))
! 			    ? TYPE_PRECISION (TREE_TYPE (op))
! 			    : -TYPE_PRECISION (TREE_TYPE (op)));
! 	  return build_fold_addr_expr (m_vars[p]);
  	}
      case INTEGER_CST:
        unsigned int min_prec, mp;
--- 2542,2561 ----
  		}
  	    }
  	  m_loc = loc_save;
! 	  goto do_ret;
  	}
        else
  	{
  	  int p = var_to_partition (m_map, op);
  	  gcc_assert (m_vars[p] != NULL_TREE);
  	  *prec = range_to_prec (op, stmt);
+ 	  precs = (TYPE_UNSIGNED (TREE_TYPE (op))
+ 		   ? TYPE_PRECISION (TREE_TYPE (op))
+ 		   : -TYPE_PRECISION (TREE_TYPE (op)));
  	  if (prec_stored)
! 	    *prec_stored = precs;
! 	  ret = build_fold_addr_expr (m_vars[p]);
! 	  goto do_ret;
  	}
      case INTEGER_CST:
        unsigned int min_prec, mp;
*************** bitint_large_huge::handle_operand_addr (
*** 2430,2447 ****
  	      type = build_bitint_type (mp, 1);
  	    }
  	}
        if (prec_stored)
! 	{
! 	  if (tree_int_cst_sgn (op) >= 0)
! 	    *prec_stored = MAX (TYPE_PRECISION (type), 1);
! 	  else
! 	    *prec_stored = MIN ((int) -TYPE_PRECISION (type), -2);
! 	}
        op = tree_output_constant_def (fold_convert (type, op));
!       return build_fold_addr_expr (op);
      default:
        gcc_unreachable ();
      }
  }
  
  /* Helper function, create a loop before the current location,
--- 2596,2632 ----
  	      type = build_bitint_type (mp, 1);
  	    }
  	}
+       if (tree_int_cst_sgn (op) >= 0)
+ 	precs = MAX (TYPE_PRECISION (type), 1);
+       else
+ 	precs = MIN ((int) -TYPE_PRECISION (type), -2);
        if (prec_stored)
! 	*prec_stored = precs;
        op = tree_output_constant_def (fold_convert (type, op));
!       ret = build_fold_addr_expr (op);
!       goto do_ret;
      default:
        gcc_unreachable ();
      }
+ do_ret:
+   if (bitint_big_endian && prec_stored == NULL)
+     {
+       int p1 = *prec < 0 ? -*prec : *prec;
+       int p2 = precs < 0 ? -precs : precs;
+       int c1 = CEIL (p1, limb_prec);
+       int c2 = CEIL (p2, limb_prec);
+       gcc_assert (c1 <= c2);
+       if (c1 != c2)
+ 	{
+ 	  gimple *g
+ 	    = gimple_build_assign (make_ssa_name (TREE_TYPE (ret)),
+ 				   POINTER_PLUS_EXPR, ret,
+ 				   size_int ((c2 - c1) * m_limb_size));
+ 	  insert_before (g);
+ 	  ret = gimple_assign_lhs (g);
+ 	}
+     }
+   return ret;
  }
  
  /* Helper function, create a loop before the current location,
*************** bitint_large_huge::lower_mergeable_stmt
*** 2518,2523 ****
--- 2703,2711 ----
    tree nlhs = NULL_TREE;
    unsigned HOST_WIDE_INT bo_idx = 0;
    unsigned HOST_WIDE_INT bo_bit = 0;
+   unsigned bo_shift = 0;
+   unsigned bo_last = 0;
+   bool bo_be_p = false;
    tree bf_cur = NULL_TREE, bf_next = NULL_TREE;
    if (gimple_store_p (stmt))
      {
*************** bitint_large_huge::lower_mergeable_stmt
*** 2544,2550 ****
  	  tree repr = DECL_BIT_FIELD_REPRESENTATIVE (fld);
  	  poly_int64 bitoffset;
  	  poly_uint64 field_offset, repr_offset;
! 	  if ((tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld)) % BITS_PER_UNIT) == 0)
  	    nlhs = lhs;
  	  else
  	    {
--- 2732,2740 ----
  	  tree repr = DECL_BIT_FIELD_REPRESENTATIVE (fld);
  	  poly_int64 bitoffset;
  	  poly_uint64 field_offset, repr_offset;
! 	  if (!bitint_big_endian
! 	      && (tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld))
! 		  % BITS_PER_UNIT) == 0)
  	    nlhs = lhs;
  	  else
  	    {
*************** bitint_large_huge::lower_mergeable_stmt
*** 2566,2571 ****
--- 2756,2770 ----
  	      HOST_WIDE_INT bo = bitoffset.to_constant ();
  	      bo_idx = (unsigned HOST_WIDE_INT) bo / limb_prec;
  	      bo_bit = (unsigned HOST_WIDE_INT) bo % limb_prec;
+ 	      bo_shift = bo_bit;
+ 	      if (bitint_big_endian)
+ 		{
+ 		  bo_last = CEIL (prec + bo_bit, limb_prec) - 1;
+ 		  bo_shift = (prec + bo_bit) % limb_prec;
+ 		  bo_be_p = true;
+ 		  if (bo_shift)
+ 		    bo_shift = limb_prec - bo_shift;
+ 		}
  	    }
  	}
      }
*************** bitint_large_huge::lower_mergeable_stmt
*** 2609,2615 ****
        rem = (prec % (2 * limb_prec));
        end = (prec - rem) / limb_prec;
        cnt = 2 + CEIL (rem, limb_prec);
!       idx = idx_first = create_loop (size_zero_node, &idx_next);
      }
  
    basic_block edge_bb = NULL;
--- 2808,2816 ----
        rem = (prec % (2 * limb_prec));
        end = (prec - rem) / limb_prec;
        cnt = 2 + CEIL (rem, limb_prec);
!       idx = idx_first = create_loop (bitint_big_endian
! 				     ? size_int (cnt - 2 + end - 1)
! 				     : size_zero_node, &idx_next);
      }
  
    basic_block edge_bb = NULL;
*************** bitint_large_huge::lower_mergeable_stmt
*** 2632,2645 ****
      = (prec != (unsigned) TYPE_PRECISION (type)
         && (CEIL ((unsigned) TYPE_PRECISION (type), limb_prec)
  	   > CEIL (prec, limb_prec)));
  
    for (unsigned i = 0; i < cnt; i++)
      {
        m_data_cnt = 0;
        if (kind == bitint_prec_large)
! 	idx = size_int (i);
        else if (i >= 2)
! 	idx = size_int (end + (i > 2));
        if (eq_p)
  	{
  	  rhs1 = handle_operand (cmp_op1, idx);
--- 2833,2850 ----
      = (prec != (unsigned) TYPE_PRECISION (type)
         && (CEIL ((unsigned) TYPE_PRECISION (type), limb_prec)
  	   > CEIL (prec, limb_prec)));
+   unsigned dst_idx_off = 0;
+   if (separate_ext && bitint_big_endian)
+     dst_idx_off = (CEIL ((unsigned) TYPE_PRECISION (type), limb_prec)
+ 		   - CEIL (prec, limb_prec));
  
    for (unsigned i = 0; i < cnt; i++)
      {
        m_data_cnt = 0;
        if (kind == bitint_prec_large)
! 	idx = size_int (bitint_big_endian ? cnt - 1 - i : i);
        else if (i >= 2)
! 	idx = size_int (bitint_big_endian ? cnt - 1 - i : end + (i > 2));
        if (eq_p)
  	{
  	  rhs1 = handle_operand (cmp_op1, idx);
*************** bitint_large_huge::lower_mergeable_stmt
*** 2666,2687 ****
  	  if (sext && i == cnt - 1)
  	    ext = rhs1;
  	  tree nidx = idx;
! 	  if (bo_idx)
  	    {
  	      if (tree_fits_uhwi_p (idx))
! 		nidx = size_int (tree_to_uhwi (idx) + bo_idx);
  	      else
  		{
  		  nidx = make_ssa_name (sizetype);
  		  g = gimple_build_assign (nidx, PLUS_EXPR, idx,
! 					   size_int (bo_idx));
  		  insert_before (g);
  		}
  	    }
  	  bool done = false;
  	  basic_block new_bb = NULL;
  	  /* Handle stores into bit-fields.  */
! 	  if (bo_bit)
  	    {
  	      if (i == 0)
  		{
--- 2871,2897 ----
  	  if (sext && i == cnt - 1)
  	    ext = rhs1;
  	  tree nidx = idx;
! 	  HOST_WIDE_INT adj = bo_idx;
! 	  if (bo_be_p)
! 	    adj += bo_last - (CEIL (prec, limb_prec) - 1);
! 	  else
! 	    adj += dst_idx_off;
! 	  if (adj)
  	    {
  	      if (tree_fits_uhwi_p (idx))
! 		nidx = size_int (tree_to_uhwi (idx) + adj);
  	      else
  		{
  		  nidx = make_ssa_name (sizetype);
  		  g = gimple_build_assign (nidx, PLUS_EXPR, idx,
! 					   size_int (adj));
  		  insert_before (g);
  		}
  	    }
  	  bool done = false;
  	  basic_block new_bb = NULL;
  	  /* Handle stores into bit-fields.  */
! 	  if (bo_shift)
  	    {
  	      if (i == 0)
  		{
*************** bitint_large_huge::lower_mergeable_stmt
*** 2692,2698 ****
  					   idx, &bf_next);
  		      bf_next = m_data.pop ();
  		      bf_cur = m_data.pop ();
! 		      g = gimple_build_cond (EQ_EXPR, idx, size_zero_node,
  					     NULL_TREE, NULL_TREE);
  		      edge edge_true;
  		      if_then_else (g, profile_probability::unlikely (),
--- 2902,2912 ----
  					   idx, &bf_next);
  		      bf_next = m_data.pop ();
  		      bf_cur = m_data.pop ();
! 		      g = gimple_build_cond (EQ_EXPR, idx,
! 					     bitint_big_endian
! 					     ? size_int (CEIL (prec,
! 							       limb_prec) - 1)
! 					     : size_zero_node,
  					     NULL_TREE, NULL_TREE);
  		      edge edge_true;
  		      if_then_else (g, profile_probability::unlikely (),
*************** bitint_large_huge::lower_mergeable_stmt
*** 2700,2709 ****
  		      new_bb = e2->dest;
  		    }
  		  tree ftype
! 		    = build_nonstandard_integer_type (limb_prec - bo_bit, 1);
  		  tree bfr = build_bit_field_ref (ftype, unshare_expr (nlhs),
! 						  limb_prec - bo_bit,
! 						  bo_idx * limb_prec + bo_bit);
  		  tree t = add_cast (ftype, rhs1);
  		  g = gimple_build_assign (bfr, t);
  		  insert_before (g);
--- 2914,2927 ----
  		      new_bb = e2->dest;
  		    }
  		  tree ftype
! 		    = build_nonstandard_integer_type (limb_prec - bo_shift, 1);
  		  tree bfr = build_bit_field_ref (ftype, unshare_expr (nlhs),
! 						  limb_prec - bo_shift,
! 						  bitint_big_endian
! 						  ? (bo_idx + bo_last)
! 						    * limb_prec
! 						  : bo_idx * limb_prec
! 						    + bo_bit);
  		  tree t = add_cast (ftype, rhs1);
  		  g = gimple_build_assign (bfr, t);
  		  insert_before (g);
*************** bitint_large_huge::lower_mergeable_stmt
*** 2733,2743 ****
  		  tree t3 = make_ssa_name (m_limb_type);
  		  g = gimple_build_assign (t1, RSHIFT_EXPR, bf_cur,
  					   build_int_cst (unsigned_type_node,
! 							  limb_prec - bo_bit));
  		  insert_before (g);
  		  g = gimple_build_assign (t2, LSHIFT_EXPR, rhs1,
  					   build_int_cst (unsigned_type_node,
! 							  bo_bit));
  		  insert_before (g);
  		  bf_cur = rhs1;
  		  g = gimple_build_assign (t3, BIT_IOR_EXPR, t1, t2);
--- 2951,2962 ----
  		  tree t3 = make_ssa_name (m_limb_type);
  		  g = gimple_build_assign (t1, RSHIFT_EXPR, bf_cur,
  					   build_int_cst (unsigned_type_node,
! 							  limb_prec
! 							  - bo_shift));
  		  insert_before (g);
  		  g = gimple_build_assign (t2, LSHIFT_EXPR, rhs1,
  					   build_int_cst (unsigned_type_node,
! 							  bo_shift));
  		  insert_before (g);
  		  bf_cur = rhs1;
  		  g = gimple_build_assign (t3, BIT_IOR_EXPR, t1, t2);
*************** bitint_large_huge::lower_mergeable_stmt
*** 2760,2780 ****
  		{
  		  unsigned int tprec = TYPE_PRECISION (type);
  		  unsigned int rprec = (tprec - 1) % limb_prec + 1;
! 		  if (rprec + bo_bit < (unsigned) limb_prec)
  		    {
  		      tree ftype
! 			= build_nonstandard_integer_type (rprec + bo_bit, 1);
  		      tree bfr
  			= build_bit_field_ref (ftype, unshare_expr (nlhs),
! 					       rprec + bo_bit,
! 					       (bo_idx + tprec / limb_prec)
! 					       * limb_prec);
  		      tree t = add_cast (ftype, rhs1);
  		      g = gimple_build_assign (bfr, t);
  		      done = true;
  		      bf_cur = NULL_TREE;
  		    }
! 		  else if (rprec + bo_bit == (unsigned) limb_prec)
  		    bf_cur = NULL_TREE;
  		}
  	      /* Otherwise, stores to any other lhs.  */
--- 2979,3001 ----
  		{
  		  unsigned int tprec = TYPE_PRECISION (type);
  		  unsigned int rprec = (tprec - 1) % limb_prec + 1;
! 		  if (rprec + bo_shift < (unsigned) limb_prec)
  		    {
  		      tree ftype
! 			= build_nonstandard_integer_type (rprec + bo_shift, 1);
  		      tree bfr
  			= build_bit_field_ref (ftype, unshare_expr (nlhs),
! 					       rprec + bo_shift,
! 					       bitint_big_endian
! 					       ? bo_idx * limb_prec + bo_bit
! 					       : (bo_idx + tprec / limb_prec)
! 						 * limb_prec);
  		      tree t = add_cast (ftype, rhs1);
  		      g = gimple_build_assign (bfr, t);
  		      done = true;
  		      bf_cur = NULL_TREE;
  		    }
! 		  else if (rprec + bo_shift == (unsigned) limb_prec)
  		    bf_cur = NULL_TREE;
  		}
  	      /* Otherwise, stores to any other lhs.  */
*************** bitint_large_huge::lower_mergeable_stmt
*** 2807,2822 ****
  	    {
  	      idx = make_ssa_name (sizetype);
  	      g = gimple_build_assign (idx, PLUS_EXPR, idx_first,
! 				       size_one_node);
  	      insert_before (g);
  	    }
  	  else
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx_first,
! 				       size_int (2));
  	      insert_before (g);
! 	      g = gimple_build_cond (NE_EXPR, idx_next, size_int (end),
! 				     NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      if (eq_p)
  		m_gsi = gsi_after_labels (edge_bb);
--- 3028,3048 ----
  	    {
  	      idx = make_ssa_name (sizetype);
  	      g = gimple_build_assign (idx, PLUS_EXPR, idx_first,
! 				       bitint_big_endian
! 				       ? size_int (-1) : size_one_node);
  	      insert_before (g);
  	    }
  	  else
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx_first,
! 				       size_int (bitint_big_endian ? -2 : 2));
  	      insert_before (g);
! 	      if (bitint_big_endian)
! 		g = gimple_build_cond (NE_EXPR, idx_first, size_int (cnt - 1),
! 				       NULL_TREE, NULL_TREE);
! 	      else
! 		g = gimple_build_cond (NE_EXPR, idx_next, size_int (end),
! 				       NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      if (eq_p)
  		m_gsi = gsi_after_labels (edge_bb);
*************** bitint_large_huge::lower_mergeable_stmt
*** 2844,2875 ****
        kind = bitint_precision_kind (type);
        unsigned start = CEIL (prec, limb_prec);
        prec = TYPE_PRECISION (type);
        idx = idx_first = idx_next = NULL_TREE;
!       if (prec <= (start + 2 + (bo_bit != 0)) * limb_prec)
  	kind = bitint_prec_large;
        if (kind == bitint_prec_large)
! 	cnt = CEIL (prec, limb_prec) - start;
        else
  	{
  	  rem = prec % limb_prec;
  	  end = (prec - rem) / limb_prec;
! 	  cnt = (bo_bit != 0) + 1 + (rem != 0);
  	}
        for (unsigned i = 0; i < cnt; i++)
  	{
! 	  if (kind == bitint_prec_large || (i == 0 && bo_bit != 0))
! 	    idx = size_int (start + i);
! 	  else if (i == cnt - 1 && (rem != 0))
! 	    idx = size_int (end);
! 	  else if (i == (bo_bit != 0))
! 	    idx = create_loop (size_int (start + i), &idx_next);
  	  rhs1 = ext;
  	  if (bf_cur != NULL_TREE && bf_cur != ext)
  	    {
  	      tree t1 = make_ssa_name (m_limb_type);
  	      g = gimple_build_assign (t1, RSHIFT_EXPR, bf_cur,
  				       build_int_cst (unsigned_type_node,
! 						      limb_prec - bo_bit));
  	      insert_before (g);
  	      if (integer_zerop (ext))
  		rhs1 = t1;
--- 3070,3109 ----
        kind = bitint_precision_kind (type);
        unsigned start = CEIL (prec, limb_prec);
        prec = TYPE_PRECISION (type);
+       unsigned total = CEIL (prec, limb_prec);
        idx = idx_first = idx_next = NULL_TREE;
!       if (prec <= (start + 2 + (bo_shift != 0)) * limb_prec)
  	kind = bitint_prec_large;
        if (kind == bitint_prec_large)
! 	cnt = total - start;
        else
  	{
  	  rem = prec % limb_prec;
  	  end = (prec - rem) / limb_prec;
! 	  cnt = (bo_shift != 0) + 1 + (rem != 0);
  	}
+       if (bitint_big_endian && bo_shift != 0 && (prec % limb_prec) == 0)
+ 	++total;
        for (unsigned i = 0; i < cnt; i++)
  	{
! 	  if (kind == bitint_prec_large || (i == 0 && bo_shift != 0))
! 	    idx = size_int (bo_idx
! 			    + (bitint_big_endian
! 			       ? total - 1 - start - i : start + i));
! 	  else if (i == cnt - 1 && rem != 0)
! 	    idx = size_int (bo_idx + (bitint_big_endian ? 0 : end));
! 	  else if (i == (bo_shift != 0))
! 	    idx = create_loop (size_int (bo_idx
! 					 + (bitint_big_endian
! 					    ? total - 1 - start - i
! 					    : start + i)), &idx_next);
  	  rhs1 = ext;
  	  if (bf_cur != NULL_TREE && bf_cur != ext)
  	    {
  	      tree t1 = make_ssa_name (m_limb_type);
  	      g = gimple_build_assign (t1, RSHIFT_EXPR, bf_cur,
  				       build_int_cst (unsigned_type_node,
! 						      limb_prec - bo_shift));
  	      insert_before (g);
  	      if (integer_zerop (ext))
  		rhs1 = t1;
*************** bitint_large_huge::lower_mergeable_stmt
*** 2879,2932 ****
  		  rhs1 = make_ssa_name (m_limb_type);
  		  g = gimple_build_assign (t2, LSHIFT_EXPR, ext,
  					   build_int_cst (unsigned_type_node,
! 							  bo_bit));
  		  insert_before (g);
  		  g = gimple_build_assign (rhs1, BIT_IOR_EXPR, t1, t2);
  		  insert_before (g);
  		}
  	      bf_cur = ext;
  	    }
- 	  tree nidx = idx;
- 	  if (bo_idx)
- 	    {
- 	      if (tree_fits_uhwi_p (idx))
- 		nidx = size_int (tree_to_uhwi (idx) + bo_idx);
- 	      else
- 		{
- 		  nidx = make_ssa_name (sizetype);
- 		  g = gimple_build_assign (nidx, PLUS_EXPR, idx,
- 					   size_int (bo_idx));
- 		  insert_before (g);
- 		}
- 	    }
  	  bool done = false;
  	  /* Handle bit-field access to partial last limb if needed.  */
  	  if (nlhs && i == cnt - 1)
  	    {
  	      unsigned int tprec = TYPE_PRECISION (type);
  	      unsigned int rprec = (tprec - 1) % limb_prec + 1;
! 	      if (rprec + bo_bit < (unsigned) limb_prec)
  		{
  		  tree ftype
! 		    = build_nonstandard_integer_type (rprec + bo_bit, 1);
  		  tree bfr
  		    = build_bit_field_ref (ftype, unshare_expr (nlhs),
! 					   rprec + bo_bit,
! 					   (bo_idx + tprec / limb_prec)
! 					   * limb_prec);
  		  tree t = add_cast (ftype, rhs1);
  		  g = gimple_build_assign (bfr, t);
  		  done = true;
  		  bf_cur = NULL_TREE;
  		}
! 	      else if (rprec + bo_bit == (unsigned) limb_prec)
  		bf_cur = NULL_TREE;
  	    }
  	  /* Otherwise, stores to any other lhs.  */
  	  if (!done)
  	    {
  	      tree l = limb_access (nlhs ? NULL_TREE : lhs_type,
! 				    nlhs ? nlhs : lhs, nidx, true);
  	      g = gimple_build_assign (l, rhs1);
  	    }
  	  insert_before (g);
--- 3113,3155 ----
  		  rhs1 = make_ssa_name (m_limb_type);
  		  g = gimple_build_assign (t2, LSHIFT_EXPR, ext,
  					   build_int_cst (unsigned_type_node,
! 							  bo_shift));
  		  insert_before (g);
  		  g = gimple_build_assign (rhs1, BIT_IOR_EXPR, t1, t2);
  		  insert_before (g);
  		}
  	      bf_cur = ext;
  	    }
  	  bool done = false;
  	  /* Handle bit-field access to partial last limb if needed.  */
  	  if (nlhs && i == cnt - 1)
  	    {
  	      unsigned int tprec = TYPE_PRECISION (type);
  	      unsigned int rprec = (tprec - 1) % limb_prec + 1;
! 	      if (rprec + bo_shift < (unsigned) limb_prec)
  		{
  		  tree ftype
! 		    = build_nonstandard_integer_type (rprec + bo_shift, 1);
  		  tree bfr
  		    = build_bit_field_ref (ftype, unshare_expr (nlhs),
! 					   rprec + bo_shift,
! 					   bitint_big_endian
! 					   ? bo_idx * limb_prec + bo_bit
! 					   : (bo_idx + tprec / limb_prec)
! 					     * limb_prec);
  		  tree t = add_cast (ftype, rhs1);
  		  g = gimple_build_assign (bfr, t);
  		  done = true;
  		  bf_cur = NULL_TREE;
  		}
! 	      else if (rprec + bo_shift == (unsigned) limb_prec)
  		bf_cur = NULL_TREE;
  	    }
  	  /* Otherwise, stores to any other lhs.  */
  	  if (!done)
  	    {
  	      tree l = limb_access (nlhs ? NULL_TREE : lhs_type,
! 				    nlhs ? nlhs : lhs, idx, true);
  	      g = gimple_build_assign (l, rhs1);
  	    }
  	  insert_before (g);
*************** bitint_large_huge::lower_mergeable_stmt
*** 2940,2952 ****
  		  add_eh_edge (e->src, find_edge (gimple_bb (stmt), eh_pad));
  		}
  	    }
! 	  if (kind == bitint_prec_huge && i == (bo_bit != 0))
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 				       size_one_node);
  	      insert_before (g);
! 	      g = gimple_build_cond (NE_EXPR, idx_next, size_int (end),
! 				     NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      m_gsi = gsi_for_stmt (stmt);
  	      m_bb = NULL;
--- 3163,3184 ----
  		  add_eh_edge (e->src, find_edge (gimple_bb (stmt), eh_pad));
  		}
  	    }
! 	  if (kind == bitint_prec_huge && i == (bo_shift != 0))
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 				       bitint_big_endian
! 				       ? size_int (-1) : size_one_node);
  	      insert_before (g);
! 	      if (bitint_big_endian && rem != 0)
! 		g = gimple_build_cond (NE_EXPR, idx,
! 				       size_int (bo_idx + 1),
! 				       NULL_TREE, NULL_TREE);
! 	      else
! 		g = gimple_build_cond (NE_EXPR, idx_next,
! 				       size_int (bo_idx
! 						 + (bitint_big_endian
! 						    ? 0 : end)),
! 				       NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      m_gsi = gsi_for_stmt (stmt);
  	      m_bb = NULL;
*************** bitint_large_huge::lower_mergeable_stmt
*** 2956,2974 ****
    if (bf_cur != NULL_TREE)
      {
        unsigned int tprec = TYPE_PRECISION (type);
!       unsigned int rprec = (tprec + bo_bit) % limb_prec;
        tree ftype = build_nonstandard_integer_type (rprec, 1);
        tree bfr = build_bit_field_ref (ftype, unshare_expr (nlhs),
  				      rprec,
! 				      (bo_idx + (tprec + bo_bit) / limb_prec)
! 				      * limb_prec);
        rhs1 = bf_cur;
        if (bf_cur != ext)
  	{
  	  rhs1 = make_ssa_name (TREE_TYPE (rhs1));
  	  g = gimple_build_assign (rhs1, RSHIFT_EXPR, bf_cur,
  				   build_int_cst (unsigned_type_node,
! 						  limb_prec - bo_bit));
  	  insert_before (g);
  	}
        rhs1 = add_cast (ftype, rhs1);
--- 3188,3208 ----
    if (bf_cur != NULL_TREE)
      {
        unsigned int tprec = TYPE_PRECISION (type);
!       unsigned int rprec = (tprec + bo_shift) % limb_prec;
        tree ftype = build_nonstandard_integer_type (rprec, 1);
        tree bfr = build_bit_field_ref (ftype, unshare_expr (nlhs),
  				      rprec,
! 				      bitint_big_endian
! 				      ? bo_idx * limb_prec + bo_bit
! 				      : (bo_idx + (tprec + bo_bit) / limb_prec)
! 					* limb_prec);
        rhs1 = bf_cur;
        if (bf_cur != ext)
  	{
  	  rhs1 = make_ssa_name (TREE_TYPE (rhs1));
  	  g = gimple_build_assign (rhs1, RSHIFT_EXPR, bf_cur,
  				   build_int_cst (unsigned_type_node,
! 						  limb_prec - bo_shift));
  	  insert_before (g);
  	}
        rhs1 = add_cast (ftype, rhs1);
*************** bitint_large_huge::lower_comparison_stmt
*** 3039,3045 ****
        && (cmp_code == GE_EXPR || cmp_code == LT_EXPR))
      {
        unsigned end = CEIL ((unsigned) TYPE_PRECISION (type), limb_prec) - 1;
!       tree idx = size_int (end);
        m_data_cnt = 0;
        tree rhs1 = handle_operand (cmp_op1, idx);
        if (TYPE_UNSIGNED (TREE_TYPE (rhs1)))
--- 3273,3279 ----
        && (cmp_code == GE_EXPR || cmp_code == LT_EXPR))
      {
        unsigned end = CEIL ((unsigned) TYPE_PRECISION (type), limb_prec) - 1;
!       tree idx = size_int (bitint_big_endian ? 0 : end);
        m_data_cnt = 0;
        tree rhs1 = handle_operand (cmp_op1, idx);
        if (TYPE_UNSIGNED (TREE_TYPE (rhs1)))
*************** bitint_large_huge::lower_comparison_stmt
*** 3080,3090 ****
      {
        m_data_cnt = 0;
        if (kind == bitint_prec_large)
! 	idx = size_int (cnt - i - 1);
        else if (i == cnt - 1)
! 	idx = create_loop (size_int (end - 1), &idx_next);
        else
! 	idx = size_int (end);
        tree rhs1 = handle_operand (cmp_op1, idx);
        tree rhs2 = handle_operand (cmp_op2, idx);
        if (i == 0
--- 3314,3325 ----
      {
        m_data_cnt = 0;
        if (kind == bitint_prec_large)
! 	idx = size_int (bitint_big_endian ? i : cnt - i - 1);
        else if (i == cnt - 1)
! 	idx = create_loop (size_int (bitint_big_endian ? cnt - 1 : end - 1),
! 			   &idx_next);
        else
! 	idx = size_int (bitint_big_endian ? 0 : end);
        tree rhs1 = handle_operand (cmp_op1, idx);
        tree rhs2 = handle_operand (cmp_op2, idx);
        if (i == 0
*************** bitint_large_huge::lower_comparison_stmt
*** 3118,3126 ****
        m_first = false;
        if (kind == bitint_prec_huge && i == cnt - 1)
  	{
! 	  g = gimple_build_assign (idx_next, PLUS_EXPR, idx, size_int (-1));
  	  insert_before (g);
! 	  g = gimple_build_cond (NE_EXPR, idx, size_zero_node,
  				 NULL_TREE, NULL_TREE);
  	  insert_before (g);
  	  edge true_edge, false_edge;
--- 3353,3366 ----
        m_first = false;
        if (kind == bitint_prec_huge && i == cnt - 1)
  	{
! 	  g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 				   bitint_big_endian ? size_one_node
! 				   : size_int (-1));
  	  insert_before (g);
! 	  g = gimple_build_cond (NE_EXPR, idx,
! 				 bitint_big_endian
! 				 ? size_int (end - 1 + (cnt != 1))
! 				 : size_zero_node,
  				 NULL_TREE, NULL_TREE);
  	  insert_before (g);
  	  edge true_edge, false_edge;
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3174,3180 ****
       size_t n2 = n / limb_prec;
       size_t n3 = n1 != 0;
       unsigned n4 = (limb_prec - n1) % limb_prec;
!      (for power of 2 limb_prec n4 can be -n1 & (limb_prec)).  */
    if (TREE_CODE (n) == INTEGER_CST)
      {
        tree lp = build_int_cst (TREE_TYPE (n), limb_prec);
--- 3414,3420 ----
       size_t n2 = n / limb_prec;
       size_t n3 = n1 != 0;
       unsigned n4 = (limb_prec - n1) % limb_prec;
!      (for power of 2 limb_prec n4 can be -n1 & limb_prec).  */
    if (TREE_CODE (n) == INTEGER_CST)
      {
        tree lp = build_int_cst (TREE_TYPE (n), limb_prec);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3290,3296 ****
  	     dst[idx] = ext;  */
        tree pmn3;
        if (TYPE_UNSIGNED (type) && prec % limb_prec == 0)
! 	pmn3 = p;
        else if (TREE_CODE (n3) == INTEGER_CST)
  	pmn3 = int_const_binop (MINUS_EXPR, p, n3);
        else
--- 3530,3538 ----
  	     dst[idx] = ext;  */
        tree pmn3;
        if (TYPE_UNSIGNED (type) && prec % limb_prec == 0)
! 	pmn3 = bitint_big_endian ? size_zero_node : p;
!       else if (bitint_big_endian)
! 	pmn3 = n3;
        else if (TREE_CODE (n3) == INTEGER_CST)
  	pmn3 = int_const_binop (MINUS_EXPR, p, n3);
        else
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3299,3314 ****
  	  g = gimple_build_assign (pmn3, MINUS_EXPR, p, n3);
  	  insert_before (g);
  	}
!       g = gimple_build_cond (LT_EXPR, n2, pmn3, NULL_TREE, NULL_TREE);
        edge edge_true, edge_false;
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        tree idx_next;
!       tree idx = create_loop (n2, &idx_next);
        tree idxmn2 = make_ssa_name (sizetype);
        tree idxpn3 = make_ssa_name (sizetype);
!       g = gimple_build_assign (idxmn2, MINUS_EXPR, idx, n2);
        insert_before (g);
!       g = gimple_build_assign (idxpn3, PLUS_EXPR, idx, n3);
        insert_before (g);
        m_data_cnt = 0;
        tree t1 = handle_operand (rhs1, idx);
--- 3541,3574 ----
  	  g = gimple_build_assign (pmn3, MINUS_EXPR, p, n3);
  	  insert_before (g);
  	}
!       tree pmn2 = NULL_TREE;
!       if (bitint_big_endian)
! 	{
! 	  if (TREE_CODE (n2) == INTEGER_CST)
! 	    pmn2 = int_const_binop (MINUS_EXPR, p, n2);
! 	  else
! 	    {
! 	      pmn2 = make_ssa_name (sizetype);
! 	      g = gimple_build_assign (pmn2, MINUS_EXPR, p, n2);
! 	      insert_before (g);
! 	    }
! 	  g = gimple_build_cond (GT_EXPR, pmn2, pmn3, NULL_TREE, NULL_TREE);
! 	}
!       else
! 	g = gimple_build_cond (LT_EXPR, n2, pmn3, NULL_TREE, NULL_TREE);
        edge edge_true, edge_false;
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        tree idx_next;
!       tree idx = create_loop (bitint_big_endian ? pmn2 : n2, &idx_next);
        tree idxmn2 = make_ssa_name (sizetype);
        tree idxpn3 = make_ssa_name (sizetype);
!       g = gimple_build_assign (idxmn2,
! 			       bitint_big_endian ? PLUS_EXPR : MINUS_EXPR,
! 			       idx, n2);
        insert_before (g);
!       g = gimple_build_assign (idxpn3,
! 			       bitint_big_endian ? MINUS_EXPR : PLUS_EXPR,
! 			       idx, n3);
        insert_before (g);
        m_data_cnt = 0;
        tree t1 = handle_operand (rhs1, idx);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3333,3341 ****
        tree l = limb_access (TREE_TYPE (lhs), obj, idxmn2, true);
        g = gimple_build_assign (l, t1);
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx, size_one_node);
        insert_before (g);
!       g = gimple_build_cond (LT_EXPR, idx_next, pmn3, NULL_TREE, NULL_TREE);
        insert_before (g);
        idx = make_ssa_name (sizetype);
        m_gsi = gsi_for_stmt (final_stmt);
--- 3593,3604 ----
        tree l = limb_access (TREE_TYPE (lhs), obj, idxmn2, true);
        g = gimple_build_assign (l, t1);
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 			       bitint_big_endian ? size_int (-1)
! 						 : size_one_node);
        insert_before (g);
!       g = gimple_build_cond (bitint_big_endian ? GT_EXPR : LT_EXPR,
! 			     idx_next, pmn3, NULL_TREE, NULL_TREE);
        insert_before (g);
        idx = make_ssa_name (sizetype);
        m_gsi = gsi_for_stmt (final_stmt);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3343,3359 ****
        edge_false = find_edge (edge_false->src, gsi_bb (m_gsi));
        edge_true = EDGE_PRED (gsi_bb (m_gsi),
  			     EDGE_PRED (gsi_bb (m_gsi), 0) == edge_false);
!       add_phi_arg (phi, n2, edge_false, UNKNOWN_LOCATION);
        add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
        m_data_cnt = 0;
!       tree ms = handle_operand (rhs1, p);
        tree ext = ms;
        if (!types_compatible_p (TREE_TYPE (ms), m_limb_type))
  	ext = add_cast (m_limb_type, ms);
        if (!(TYPE_UNSIGNED (type) && prec % limb_prec == 0)
  	  && !integer_zerop (n3))
  	{
! 	  g = gimple_build_cond (LT_EXPR, idx, p, NULL_TREE, NULL_TREE);
  	  if_then (g, profile_probability::likely (), edge_true, edge_false);
  	  m_data_cnt = 0;
  	  t1 = handle_operand (rhs1, idx);
--- 3606,3627 ----
        edge_false = find_edge (edge_false->src, gsi_bb (m_gsi));
        edge_true = EDGE_PRED (gsi_bb (m_gsi),
  			     EDGE_PRED (gsi_bb (m_gsi), 0) == edge_false);
!       add_phi_arg (phi, bitint_big_endian ? pmn2 : n2, edge_false,
! 		   UNKNOWN_LOCATION);
        add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
        m_data_cnt = 0;
!       tree ms = handle_operand (rhs1, bitint_big_endian ? size_zero_node : p);
        tree ext = ms;
        if (!types_compatible_p (TREE_TYPE (ms), m_limb_type))
  	ext = add_cast (m_limb_type, ms);
        if (!(TYPE_UNSIGNED (type) && prec % limb_prec == 0)
  	  && !integer_zerop (n3))
  	{
! 	  if (bitint_big_endian)
! 	    g = gimple_build_cond (GT_EXPR, idx, size_zero_node,
! 				   NULL_TREE, NULL_TREE);
! 	  else
! 	    g = gimple_build_cond (LT_EXPR, idx, p, NULL_TREE, NULL_TREE);
  	  if_then (g, profile_probability::likely (), edge_true, edge_false);
  	  m_data_cnt = 0;
  	  t1 = handle_operand (rhs1, idx);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3370,3382 ****
  	  insert_before (g);
  	  t1 = gimple_assign_lhs (g);
  	  idxmn2 = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idxmn2, MINUS_EXPR, idx, n2);
  	  insert_before (g);
  	  l = limb_access (TREE_TYPE (lhs), obj, idxmn2, true);
  	  g = gimple_build_assign (l, t1);
  	  insert_before (g);
  	  idx_next = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idx_next, PLUS_EXPR, idx, size_one_node);
  	  insert_before (g);
  	  m_gsi = gsi_for_stmt (final_stmt);
  	  tree nidx = make_ssa_name (sizetype);
--- 3638,3653 ----
  	  insert_before (g);
  	  t1 = gimple_assign_lhs (g);
  	  idxmn2 = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idxmn2, bitint_big_endian
! 					   ? PLUS_EXPR : MINUS_EXPR, idx, n2);
  	  insert_before (g);
  	  l = limb_access (TREE_TYPE (lhs), obj, idxmn2, true);
  	  g = gimple_build_assign (l, t1);
  	  insert_before (g);
  	  idx_next = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 				   bitint_big_endian
! 				   ? size_int (-1) : size_one_node);
  	  insert_before (g);
  	  m_gsi = gsi_for_stmt (final_stmt);
  	  tree nidx = make_ssa_name (sizetype);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3388,3394 ****
  	  add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
  	  idx = nidx;
  	}
!       g = gimple_build_assign (make_ssa_name (sizetype), MINUS_EXPR, idx, n2);
        insert_before (g);
        idx = gimple_assign_lhs (g);
        tree sext = ext;
--- 3659,3667 ----
  	  add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
  	  idx = nidx;
  	}
!       g = gimple_build_assign (make_ssa_name (sizetype),
! 			       bitint_big_endian ? PLUS_EXPR : MINUS_EXPR,
! 			       idx, n2);
        insert_before (g);
        idx = gimple_assign_lhs (g);
        tree sext = ext;
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3414,3431 ****
        g = gimple_build_assign (l, t1);
        insert_before (g);
        g = gimple_build_assign (make_ssa_name (sizetype), PLUS_EXPR, idx,
! 			       size_one_node);
        insert_before (g);
!       idx = gimple_assign_lhs (g);
!       g = gimple_build_cond (LE_EXPR, idx, p, NULL_TREE, NULL_TREE);
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        idx = create_loop (idx, &idx_next);
        l = limb_access (TREE_TYPE (lhs), obj, idx, true);
        g = gimple_build_assign (l, ext);
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx, size_one_node);
        insert_before (g);
!       g = gimple_build_cond (LE_EXPR, idx_next, p, NULL_TREE, NULL_TREE);
        insert_before (g);
      }
    else
--- 3687,3721 ----
        g = gimple_build_assign (l, t1);
        insert_before (g);
        g = gimple_build_assign (make_ssa_name (sizetype), PLUS_EXPR, idx,
! 			       bitint_big_endian
! 			       ? size_int (-1) : size_one_node);
        insert_before (g);
!       if (bitint_big_endian)
! 	{
! 	  tree new_idx = gimple_assign_lhs (g);
! 	  g = gimple_build_cond (NE_EXPR, idx, size_zero_node,
! 				 NULL_TREE, NULL_TREE);
! 	  idx = new_idx;
! 	}
!       else
! 	{
! 	  idx = gimple_assign_lhs (g);
! 	  g = gimple_build_cond (LE_EXPR, idx, p, NULL_TREE, NULL_TREE);
! 	}
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        idx = create_loop (idx, &idx_next);
        l = limb_access (TREE_TYPE (lhs), obj, idx, true);
        g = gimple_build_assign (l, ext);
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 			       bitint_big_endian
! 			       ? size_int (-1) : size_one_node);
        insert_before (g);
!       if (bitint_big_endian)
! 	g = gimple_build_cond (NE_EXPR, idx, size_zero_node,
! 			       NULL_TREE, NULL_TREE);
!       else
! 	g = gimple_build_cond (LE_EXPR, idx_next, p, NULL_TREE, NULL_TREE);
        insert_before (g);
      }
    else
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3457,3462 ****
--- 3747,3764 ----
  	  g = gimple_build_assign (n2pn3, PLUS_EXPR, n2, n3);
  	  insert_before (g);
  	}
+       if (bitint_big_endian)
+ 	{
+ 	  if (TREE_CODE (n2pn3) == INTEGER_CST)
+ 	    n2pn3 = int_const_binop (MINUS_EXPR, p, n2pn3);
+ 	  else
+ 	    {
+ 	      g = gimple_build_assign (make_ssa_name (sizetype),
+ 				       MINUS_EXPR, p, n2pn3);
+ 	      insert_before (g);
+ 	      n2pn3 = gimple_assign_lhs (g);
+ 	    }
+ 	}
        /* For LSHIFT_EXPR, we can use handle_operand with non-INTEGER_CST
  	 idx even to access the most significant partial limb.  */
        m_var_msb = true;
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3465,3481 ****
  	   counts.  Emit if (true) condition that can be optimized later.  */
  	g = gimple_build_cond (NE_EXPR, boolean_true_node, boolean_false_node,
  			       NULL_TREE, NULL_TREE);
        else
  	g = gimple_build_cond (LE_EXPR, n2pn3, p, NULL_TREE, NULL_TREE);
        edge edge_true, edge_false;
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        tree idx_next;
!       tree idx = create_loop (p, &idx_next);
        tree idxmn2 = make_ssa_name (sizetype);
        tree idxmn2mn3 = make_ssa_name (sizetype);
!       g = gimple_build_assign (idxmn2, MINUS_EXPR, idx, n2);
        insert_before (g);
!       g = gimple_build_assign (idxmn2mn3, MINUS_EXPR, idxmn2, n3);
        insert_before (g);
        m_data_cnt = 0;
        tree t1 = handle_operand (rhs1, idxmn2);
--- 3767,3791 ----
  	   counts.  Emit if (true) condition that can be optimized later.  */
  	g = gimple_build_cond (NE_EXPR, boolean_true_node, boolean_false_node,
  			       NULL_TREE, NULL_TREE);
+       else if (bitint_big_endian)
+ 	g = gimple_build_cond (NE_EXPR, n2pn3, size_int (-1), NULL_TREE,
+ 			       NULL_TREE);
        else
  	g = gimple_build_cond (LE_EXPR, n2pn3, p, NULL_TREE, NULL_TREE);
        edge edge_true, edge_false;
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        tree idx_next;
!       tree idx = create_loop (bitint_big_endian ? size_zero_node : p,
! 			      &idx_next);
        tree idxmn2 = make_ssa_name (sizetype);
        tree idxmn2mn3 = make_ssa_name (sizetype);
!       g = gimple_build_assign (idxmn2,
! 			       bitint_big_endian ? PLUS_EXPR : MINUS_EXPR,
! 			       idx, n2);
        insert_before (g);
!       g = gimple_build_assign (idxmn2mn3,
! 			       bitint_big_endian ? PLUS_EXPR : MINUS_EXPR,
! 			       idxmn2, n3);
        insert_before (g);
        m_data_cnt = 0;
        tree t1 = handle_operand (rhs1, idxmn2);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3500,3509 ****
        tree l = limb_access (TREE_TYPE (lhs), obj, idx, true);
        g = gimple_build_assign (l, t1);
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx, size_int (-1));
        insert_before (g);
        tree sn2pn3 = add_cast (ssizetype, n2pn3);
!       g = gimple_build_cond (GE_EXPR, add_cast (ssizetype, idx_next), sn2pn3,
  			     NULL_TREE, NULL_TREE);
        insert_before (g);
        idx = make_ssa_name (sizetype);
--- 3810,3822 ----
        tree l = limb_access (TREE_TYPE (lhs), obj, idx, true);
        g = gimple_build_assign (l, t1);
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 			       bitint_big_endian
! 			       ? size_one_node : size_int (-1));
        insert_before (g);
        tree sn2pn3 = add_cast (ssizetype, n2pn3);
!       g = gimple_build_cond (bitint_big_endian ? LE_EXPR : GE_EXPR,
! 			     add_cast (ssizetype, idx_next), sn2pn3,
  			     NULL_TREE, NULL_TREE);
        insert_before (g);
        idx = make_ssa_name (sizetype);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3512,3518 ****
        edge_false = find_edge (edge_false->src, gsi_bb (m_gsi));
        edge_true = EDGE_PRED (gsi_bb (m_gsi),
  			     EDGE_PRED (gsi_bb (m_gsi), 0) == edge_false);
!       add_phi_arg (phi, p, edge_false, UNKNOWN_LOCATION);
        add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
        m_data_cnt = 0;
        if (!integer_zerop (n3))
--- 3825,3832 ----
        edge_false = find_edge (edge_false->src, gsi_bb (m_gsi));
        edge_true = EDGE_PRED (gsi_bb (m_gsi),
  			     EDGE_PRED (gsi_bb (m_gsi), 0) == edge_false);
!       add_phi_arg (phi, bitint_big_endian ? size_zero_node : p,
! 		   edge_false, UNKNOWN_LOCATION);
        add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
        m_data_cnt = 0;
        if (!integer_zerop (n3))
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3521,3527 ****
  				 NULL_TREE, NULL_TREE);
  	  if_then (g, profile_probability::likely (), edge_true, edge_false);
  	  idxmn2 = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idxmn2, MINUS_EXPR, idx, n2);
  	  insert_before (g);
  	  m_data_cnt = 0;
  	  t1 = handle_operand (rhs1, idxmn2);
--- 3835,3843 ----
  				 NULL_TREE, NULL_TREE);
  	  if_then (g, profile_probability::likely (), edge_true, edge_false);
  	  idxmn2 = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idxmn2,
! 				   bitint_big_endian ? PLUS_EXPR : MINUS_EXPR,
! 				   idx, n2);
  	  insert_before (g);
  	  m_data_cnt = 0;
  	  t1 = handle_operand (rhs1, idxmn2);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3533,3539 ****
  	  g = gimple_build_assign (l, t1);
  	  insert_before (g);
  	  idx_next = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idx_next, PLUS_EXPR, idx, size_int (-1));
  	  insert_before (g);
  	  m_gsi = gsi_for_stmt (final_stmt);
  	  tree nidx = make_ssa_name (sizetype);
--- 3849,3857 ----
  	  g = gimple_build_assign (l, t1);
  	  insert_before (g);
  	  idx_next = make_ssa_name (sizetype);
! 	  g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 				   bitint_big_endian
! 				   ? size_one_node : size_int (-1));
  	  insert_before (g);
  	  m_gsi = gsi_for_stmt (final_stmt);
  	  tree nidx = make_ssa_name (sizetype);
*************** bitint_large_huge::lower_shift_stmt (tre
*** 3545,3562 ****
  	  add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
  	  idx = nidx;
  	}
!       g = gimple_build_cond (GE_EXPR, add_cast (ssizetype, idx),
! 			     ssize_int (0), NULL_TREE, NULL_TREE);
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        idx = create_loop (idx, &idx_next);
        l = limb_access (TREE_TYPE (lhs), obj, idx, true);
        g = gimple_build_assign (l, build_zero_cst (m_limb_type));
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx, size_int (-1));
        insert_before (g);
!       g = gimple_build_cond (GE_EXPR, add_cast (ssizetype, idx_next),
! 			     ssize_int (0), NULL_TREE, NULL_TREE);
        insert_before (g);
      }
  }
  
--- 3863,3905 ----
  	  add_phi_arg (phi, idx_next, edge_true, UNKNOWN_LOCATION);
  	  idx = nidx;
  	}
!       if (bitint_big_endian)
! 	g = gimple_build_cond (LE_EXPR, idx, p, NULL_TREE, NULL_TREE);
!       else
! 	g = gimple_build_cond (GE_EXPR, add_cast (ssizetype, idx),
! 			       ssize_int (0), NULL_TREE, NULL_TREE);
        if_then (g, profile_probability::likely (), edge_true, edge_false);
        idx = create_loop (idx, &idx_next);
        l = limb_access (TREE_TYPE (lhs), obj, idx, true);
        g = gimple_build_assign (l, build_zero_cst (m_limb_type));
        insert_before (g);
!       g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 			       bitint_big_endian
! 			       ? size_one_node : size_int (-1));
        insert_before (g);
!       if (bitint_big_endian)
! 	g = gimple_build_cond (LE_EXPR, idx_next, p, NULL_TREE, NULL_TREE);
!       else
! 	g = gimple_build_cond (GE_EXPR, add_cast (ssizetype, idx_next),
! 			       ssize_int (0), NULL_TREE, NULL_TREE);
        insert_before (g);
+       if (bitint_extended && prec % limb_prec != 0)
+ 	{
+ 	  /* The most significant limb has been updated either in the
+ 	     loop or in the if after it.  To simplify the code, just
+ 	     read it back from memory and extend.  */
+ 	  m_gsi = gsi_after_labels (edge_false->dest);
+ 	  idx = bitint_big_endian ? size_zero_node : p;
+ 	  tree l = limb_access (TREE_TYPE (lhs), obj, idx, true);
+ 	  tree type = limb_access_type (TREE_TYPE (lhs), idx);
+ 	  tree v = make_ssa_name (m_limb_type);
+ 	  g = gimple_build_assign (v, l);
+ 	  insert_before (g);
+ 	  v = add_cast (type, v);
+ 	  l = limb_access (TREE_TYPE (lhs), obj, idx, true);
+ 	  g = gimple_build_assign (l, add_cast (m_limb_type, v));
+ 	  insert_before (g);
+ 	}
      }
  }
  
*************** bitint_large_huge::arith_overflow_extrac
*** 3803,3809 ****
  void
  bitint_large_huge::finish_arith_overflow (tree var, tree obj, tree type,
  					  tree ovf, tree lhs, tree orig_obj,
! 					  gimple *stmt, tree_code code)
  {
    gimple *g;
  
--- 4146,4153 ----
  void
  bitint_large_huge::finish_arith_overflow (tree var, tree obj, tree type,
  					  tree ovf, tree lhs, tree orig_obj,
! 					  gimple *stmt, unsigned nelts,
! 					  tree_code code)
  {
    gimple *g;
  
*************** bitint_large_huge::finish_arith_overflow
*** 3821,3827 ****
  	  && bitint_precision_kind (type) == bitint_prec_middle)
  	lhs_type = build_nonstandard_integer_type (TYPE_PRECISION (type),
  						   TYPE_UNSIGNED (type));
!       tree r1 = limb_access (NULL_TREE, var, size_int (0), true);
        g = gimple_build_assign (make_ssa_name (m_limb_type), r1);
        insert_before (g);
        r1 = gimple_assign_lhs (g);
--- 4165,4173 ----
  	  && bitint_precision_kind (type) == bitint_prec_middle)
  	lhs_type = build_nonstandard_integer_type (TYPE_PRECISION (type),
  						   TYPE_UNSIGNED (type));
!       tree r1 = limb_access (NULL_TREE, var,
! 			     bitint_big_endian
! 			     ? size_int (nelts - 1) : size_zero_node, true);
        g = gimple_build_assign (make_ssa_name (m_limb_type), r1);
        insert_before (g);
        r1 = gimple_assign_lhs (g);
*************** bitint_large_huge::finish_arith_overflow
*** 3829,3835 ****
  	r1 = add_cast (lhs_type, r1);
        if (TYPE_PRECISION (lhs_type) > limb_prec)
  	{
! 	  tree r2 = limb_access (NULL_TREE, var, size_int (1), true);
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), r2);
  	  insert_before (g);
  	  r2 = gimple_assign_lhs (g);
--- 4175,4183 ----
  	r1 = add_cast (lhs_type, r1);
        if (TYPE_PRECISION (lhs_type) > limb_prec)
  	{
! 	  tree r2 = limb_access (NULL_TREE, var,
! 				 bitint_big_endian
! 				 ? size_int (nelts - 2) : size_one_node, true);
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), r2);
  	  insert_before (g);
  	  r2 = gimple_assign_lhs (g);
*************** bitint_large_huge::finish_arith_overflow
*** 3854,3898 ****
      }
    else
      {
!       unsigned HOST_WIDE_INT nelts = 0;
        tree atype = NULL_TREE;
        if (obj)
  	{
! 	  nelts = tree_to_uhwi (TYPE_SIZE (TREE_TYPE (obj))) / limb_prec;
  	  if (orig_obj == NULL_TREE)
! 	    nelts >>= 1;
! 	  atype = build_array_type_nelts (m_limb_type, nelts);
  	}
        if (var && obj)
  	{
  	  tree v1, v2;
! 	  tree zero;
  	  if (orig_obj == NULL_TREE)
  	    {
! 	      zero = build_zero_cst (build_pointer_type (TREE_TYPE (obj)));
  	      v1 = build2 (MEM_REF, atype,
! 			   build_fold_addr_expr (unshare_expr (obj)), zero);
  	    }
  	  else if (!useless_type_conversion_p (atype, TREE_TYPE (obj)))
  	    v1 = build1 (VIEW_CONVERT_EXPR, atype, unshare_expr (obj));
  	  else
  	    v1 = unshare_expr (obj);
! 	  zero = build_zero_cst (build_pointer_type (TREE_TYPE (var)));
! 	  v2 = build2 (MEM_REF, atype, build_fold_addr_expr (var), zero);
  	  g = gimple_build_assign (v1, v2);
  	  insert_before (g);
  	}
        if (orig_obj == NULL_TREE && obj)
  	{
  	  ovf = add_cast (m_limb_type, ovf);
! 	  tree l = limb_access (NULL_TREE, obj, size_int (nelts), true);
  	  g = gimple_build_assign (l, ovf);
  	  insert_before (g);
! 	  if (nelts > 1)
  	    {
! 	      atype = build_array_type_nelts (m_limb_type, nelts - 1);
  	      tree off = build_int_cst (build_pointer_type (TREE_TYPE (obj)),
! 					(nelts + 1) * m_limb_size);
  	      tree v1 = build2 (MEM_REF, atype,
  				build_fold_addr_expr (unshare_expr (obj)),
  				off);
--- 4202,4266 ----
      }
    else
      {
!       unsigned HOST_WIDE_INT obj_nelts = 0;
        tree atype = NULL_TREE;
        if (obj)
  	{
! 	  obj_nelts = tree_to_uhwi (TYPE_SIZE (TREE_TYPE (obj))) / limb_prec;
  	  if (orig_obj == NULL_TREE)
! 	    obj_nelts >>= 1;
! 	  atype = build_array_type_nelts (m_limb_type, obj_nelts);
  	}
        if (var && obj)
  	{
  	  tree v1, v2;
! 	  tree off;
  	  if (orig_obj == NULL_TREE)
  	    {
! 	      off = build_zero_cst (build_pointer_type (TREE_TYPE (obj)));
  	      v1 = build2 (MEM_REF, atype,
! 			   build_fold_addr_expr (unshare_expr (obj)), off);
  	    }
  	  else if (!useless_type_conversion_p (atype, TREE_TYPE (obj)))
  	    v1 = build1 (VIEW_CONVERT_EXPR, atype, unshare_expr (obj));
  	  else
  	    v1 = unshare_expr (obj);
! 	  off = build_int_cst (build_pointer_type (TREE_TYPE (var)),
! 			       bitint_big_endian
! 			       ? (nelts - obj_nelts) * m_limb_size : 0);
! 	  v2 = build2 (MEM_REF, atype, build_fold_addr_expr (var), off);
  	  g = gimple_build_assign (v1, v2);
  	  insert_before (g);
  	}
+       else if (obj && bitint_big_endian && nelts != obj_nelts)
+ 	{
+ 	  gcc_assert (nelts > obj_nelts);
+ 	  tree fn = builtin_decl_implicit (BUILT_IN_MEMMOVE);
+ 	  tree off = build_int_cst (build_pointer_type (TREE_TYPE (obj)),
+ 				    (nelts - obj_nelts) * m_limb_size);
+ 	  tree src = build2 (MEM_REF, atype,
+ 			     build_fold_addr_expr (unshare_expr (obj)), off);
+ 	  g = gimple_build_call (fn, 3,
+ 				 build_fold_addr_expr (unshare_expr (obj)),
+ 				 src, build_int_cst (size_type_node,
+ 						     obj_nelts * m_limb_size));
+ 	  insert_before (g);
+ 	}
        if (orig_obj == NULL_TREE && obj)
  	{
  	  ovf = add_cast (m_limb_type, ovf);
! 	  tree l = limb_access (NULL_TREE, obj,
! 				size_int (bitint_big_endian
! 					  ? obj_nelts * 2 - 1 : obj_nelts),
! 				true);
  	  g = gimple_build_assign (l, ovf);
  	  insert_before (g);
! 	  if (obj_nelts > 1)
  	    {
! 	      atype = build_array_type_nelts (m_limb_type, obj_nelts - 1);
  	      tree off = build_int_cst (build_pointer_type (TREE_TYPE (obj)),
! 					(obj_nelts + !bitint_big_endian)
! 					* m_limb_size);
  	      tree v1 = build2 (MEM_REF, atype,
  				build_fold_addr_expr (unshare_expr (obj)),
  				off);
*************** bitint_large_huge::lower_addsub_overflow
*** 4127,4144 ****
  
    int prec4 = ovf != NULL_TREE ? prec : prec3;
    bitint_prec_kind kind = bitint_precision_kind (prec4);
!   unsigned cnt, rem = 0, fin = 0;
    tree idx = NULL_TREE, idx_first = NULL_TREE, idx_next = NULL_TREE;
    bool last_ovf = (ovf == NULL_TREE
  		   && CEIL (prec2, limb_prec) > CEIL (prec3, limb_prec));
    if (kind != bitint_prec_huge)
!     cnt = CEIL (prec4, limb_prec) + last_ovf;
    else
      {
!       rem = (prec4 % (2 * limb_prec));
        fin = (prec4 - rem) / limb_prec;
        cnt = 2 + CEIL (rem, limb_prec) + last_ovf;
!       idx = idx_first = create_loop (size_zero_node, &idx_next);
      }
  
    if (kind == bitint_prec_huge)
--- 4495,4515 ----
  
    int prec4 = ovf != NULL_TREE ? prec : prec3;
    bitint_prec_kind kind = bitint_precision_kind (prec4);
!   unsigned cnt, rem = 0, fin = 0, nelts;
    tree idx = NULL_TREE, idx_first = NULL_TREE, idx_next = NULL_TREE;
    bool last_ovf = (ovf == NULL_TREE
  		   && CEIL (prec2, limb_prec) > CEIL (prec3, limb_prec));
    if (kind != bitint_prec_huge)
!     nelts = cnt = CEIL (prec4, limb_prec) + last_ovf;
    else
      {
!       rem = prec4 % (2 * limb_prec);
        fin = (prec4 - rem) / limb_prec;
        cnt = 2 + CEIL (rem, limb_prec) + last_ovf;
!       nelts = fin + cnt - 2;
!       idx = idx_first = create_loop (bitint_big_endian
! 				     ? size_int (nelts - 1) : size_zero_node,
! 				     &idx_next);
      }
  
    if (kind == bitint_prec_huge)
*************** bitint_large_huge::lower_addsub_overflow
*** 4172,4190 ****
        m_data_cnt = 0;
        tree rhs1, rhs2;
        if (kind != bitint_prec_huge)
! 	idx = size_int (i);
        else if (i >= 2)
! 	idx = size_int (fin + i - 2);
        if (!last_ovf || i < cnt - 1)
  	{
  	  if (type0 != TREE_TYPE (arg0))
! 	    rhs1 = handle_cast (type0, arg0, idx);
  	  else
! 	    rhs1 = handle_operand (arg0, idx);
  	  if (type1 != TREE_TYPE (arg1))
! 	    rhs2 = handle_cast (type1, arg1, idx);
  	  else
! 	    rhs2 = handle_operand (arg1, idx);
  	  if (i == 0)
  	    data_cnt = m_data_cnt;
  	  if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (rhs1)))
--- 4543,4594 ----
        m_data_cnt = 0;
        tree rhs1, rhs2;
        if (kind != bitint_prec_huge)
! 	idx = size_int (bitint_big_endian ? nelts - 1 - i : i);
        else if (i >= 2)
! 	idx = size_int (bitint_big_endian ? nelts + 1 - fin - i : fin + i - 2);
        if (!last_ovf || i < cnt - 1)
  	{
+ 	  tree idx0 = idx, idx1 = idx;
+ 	  if (bitint_big_endian
+ 	      && CEIL ((unsigned) TYPE_PRECISION (type0), limb_prec) != nelts)
+ 	    {
+ 	      HOST_WIDE_INT diff
+ 		= ((HOST_WIDE_INT) CEIL (TYPE_PRECISION (type0), limb_prec)
+ 		   - (HOST_WIDE_INT) nelts);
+ 	      if (tree_fits_uhwi_p (idx))
+ 		idx0 = size_int (tree_to_uhwi (idx) + diff);
+ 	      else
+ 		{
+ 		  idx0 = make_ssa_name (sizetype);
+ 		  g = gimple_build_assign (idx0, PLUS_EXPR, idx,
+ 					   size_int (diff));
+ 		  insert_before (g);
+ 		}
+ 	    }
  	  if (type0 != TREE_TYPE (arg0))
! 	    rhs1 = handle_cast (type0, arg0, idx0);
  	  else
! 	    rhs1 = handle_operand (arg0, idx0);
! 	  if (bitint_big_endian
! 	      && CEIL ((unsigned) TYPE_PRECISION (type1), limb_prec) != nelts)
! 	    {
! 	      HOST_WIDE_INT diff
! 		= ((HOST_WIDE_INT) CEIL (TYPE_PRECISION (type1), limb_prec)
! 		   - (HOST_WIDE_INT) nelts);
! 	      if (tree_fits_uhwi_p (idx))
! 		idx1 = size_int (tree_to_uhwi (idx) + diff);
! 	      else
! 		{
! 		  idx1 = make_ssa_name (sizetype);
! 		  g = gimple_build_assign (idx1, PLUS_EXPR, idx,
! 					   size_int (diff));
! 		  insert_before (g);
! 		}
! 	    }
  	  if (type1 != TREE_TYPE (arg1))
! 	    rhs2 = handle_cast (type1, arg1, idx1);
  	  else
! 	    rhs2 = handle_operand (arg1, idx1);
  	  if (i == 0)
  	    data_cnt = m_data_cnt;
  	  if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (rhs1)))
*************** bitint_large_huge::lower_addsub_overflow
*** 4240,4245 ****
--- 4644,4651 ----
  	  if (tree_fits_uhwi_p (idx))
  	    {
  	      unsigned limb = tree_to_uhwi (idx);
+ 	      if (bitint_big_endian)
+ 		limb = nelts - 1 - limb;
  	      if (limb >= startlimb && limb <= endlimb)
  		{
  		  tree l = arith_overflow_extract_bits (start, end, rhs,
*************** bitint_large_huge::lower_addsub_overflow
*** 4296,4309 ****
  		    cmp_code = EQ_EXPR;
  		  else
  		    cmp_code = GT_EXPR;
! 		  g = gimple_build_cond (cmp_code, idx, size_int (startlimb),
! 					 NULL_TREE, NULL_TREE);
  		  edge edge_true_true, edge_true_false, edge_false;
  		  gimple *g2 = NULL;
  		  if (!single_comparison)
  		    g2 = gimple_build_cond (NE_EXPR, idx,
! 					    size_int (startlimb), NULL_TREE,
! 					    NULL_TREE);
  		  if_then_if_then_else (g, g2, profile_probability::likely (),
  					profile_probability::likely (),
  					edge_true_true, edge_true_false,
--- 4702,4723 ----
  		    cmp_code = EQ_EXPR;
  		  else
  		    cmp_code = GT_EXPR;
! 		  if (bitint_big_endian)
! 		    g = gimple_build_cond (swap_tree_comparison (cmp_code),
! 					   idx, size_int (nelts - 1
! 							  - startlimb),
! 					   NULL_TREE, NULL_TREE);
! 		  else
! 		    g = gimple_build_cond (cmp_code, idx, size_int (startlimb),
! 					   NULL_TREE, NULL_TREE);
  		  edge edge_true_true, edge_true_false, edge_false;
  		  gimple *g2 = NULL;
  		  if (!single_comparison)
  		    g2 = gimple_build_cond (NE_EXPR, idx,
! 					    size_int (bitint_big_endian
! 						      ? nelts - 1 - startlimb
! 						      : startlimb),
! 					    NULL_TREE, NULL_TREE);
  		  if_then_if_then_else (g, g2, profile_probability::likely (),
  					profile_probability::likely (),
  					edge_true_true, edge_true_false,
*************** bitint_large_huge::lower_addsub_overflow
*** 4377,4383 ****
  
        if (var || obj)
  	{
! 	  if (tree_fits_uhwi_p (idx) && tree_to_uhwi (idx) >= prec_limbs)
  	    ;
  	  else if (!tree_fits_uhwi_p (idx)
  		   && (unsigned) prec < (fin - (i == 0)) * limb_prec)
--- 4791,4800 ----
  
        if (var || obj)
  	{
! 	  if (tree_fits_uhwi_p (idx)
! 	      && (bitint_big_endian
! 		  ? nelts - 1 - tree_to_uhwi (idx)
! 		  : tree_to_uhwi (idx)) >= prec_limbs)
  	    ;
  	  else if (!tree_fits_uhwi_p (idx)
  		   && (unsigned) prec < (fin - (i == 0)) * limb_prec)
*************** bitint_large_huge::lower_addsub_overflow
*** 4386,4410 ****
  		= (((unsigned) prec % limb_prec) == 0
  		   || prec_limbs + 1 >= fin
  		   || (prec_limbs & 1) == (i & 1));
! 	      g = gimple_build_cond (LE_EXPR, idx, size_int (prec_limbs - 1),
! 				     NULL_TREE, NULL_TREE);
  	      gimple *g2 = NULL;
  	      if (!single_comparison)
  		g2 = gimple_build_cond (EQ_EXPR, idx,
! 					size_int (prec_limbs - 1),
  					NULL_TREE, NULL_TREE);
  	      edge edge_true_true, edge_true_false, edge_false;
  	      if_then_if_then_else (g, g2, profile_probability::likely (),
  				    profile_probability::unlikely (),
  				    edge_true_true, edge_true_false,
  				    edge_false);
! 	      tree l = limb_access (type, var ? var : obj, idx, true);
  	      g = gimple_build_assign (l, rhs);
  	      insert_before (g);
  	      if (!single_comparison)
  		{
  		  m_gsi = gsi_after_labels (edge_true_true->src);
! 		  tree plm1idx = size_int (prec_limbs - 1);
  		  tree plm1type = limb_access_type (type, plm1idx);
  		  l = limb_access (type, var ? var : obj, plm1idx, true);
  		  if (!useless_type_conversion_p (plm1type, TREE_TYPE (rhs)))
--- 4803,4850 ----
  		= (((unsigned) prec % limb_prec) == 0
  		   || prec_limbs + 1 >= fin
  		   || (prec_limbs & 1) == (i & 1));
! 	      if (bitint_big_endian)
! 		g = gimple_build_cond (GE_EXPR, idx,
! 				       size_int (nelts - prec_limbs),
! 				       NULL_TREE, NULL_TREE);
! 	      else
! 		g = gimple_build_cond (LE_EXPR, idx, size_int (prec_limbs - 1),
! 				       NULL_TREE, NULL_TREE);
  	      gimple *g2 = NULL;
  	      if (!single_comparison)
  		g2 = gimple_build_cond (EQ_EXPR, idx,
! 					size_int (bitint_big_endian
! 						  ? nelts - prec_limbs
! 						  : prec_limbs - 1),
  					NULL_TREE, NULL_TREE);
  	      edge edge_true_true, edge_true_false, edge_false;
  	      if_then_if_then_else (g, g2, profile_probability::likely (),
  				    profile_probability::unlikely (),
  				    edge_true_true, edge_true_false,
  				    edge_false);
! 	      tree idxl = idx;
! 	      if (bitint_big_endian && prec_limbs != nelts)
! 		{
! 		  HOST_WIDE_INT diff = ((HOST_WIDE_INT) prec_limbs
! 					- (HOST_WIDE_INT) nelts);
! 		  if (tree_fits_uhwi_p (idx))
! 		    idxl = size_int (tree_to_uhwi (idx) + diff);
! 		  else
! 		    {
! 		      idxl = make_ssa_name (sizetype);
! 		      g = gimple_build_assign (idxl, PLUS_EXPR, idx,
! 					       size_int (diff));
! 		      insert_before (g);
! 		    }
! 		}
! 	      tree l = limb_access (type, var ? var : obj, idxl, true);
  	      g = gimple_build_assign (l, rhs);
  	      insert_before (g);
  	      if (!single_comparison)
  		{
  		  m_gsi = gsi_after_labels (edge_true_true->src);
! 		  tree plm1idx = size_int (bitint_big_endian
! 					   ? 0 : prec_limbs - 1);
  		  tree plm1type = limb_access_type (type, plm1idx);
  		  l = limb_access (type, var ? var : obj, plm1idx, true);
  		  if (!useless_type_conversion_p (plm1type, TREE_TYPE (rhs)))
*************** bitint_large_huge::lower_addsub_overflow
*** 4419,4425 ****
  	    }
  	  else
  	    {
! 	      tree l = limb_access (type, var ? var : obj, idx, true);
  	      if (!useless_type_conversion_p (TREE_TYPE (l), TREE_TYPE (rhs)))
  		rhs = add_cast (TREE_TYPE (l), rhs);
  	      g = gimple_build_assign (l, rhs);
--- 4859,4880 ----
  	    }
  	  else
  	    {
! 	      tree idxl = idx;
! 	      if (bitint_big_endian && prec_limbs != nelts)
! 		{
! 		  HOST_WIDE_INT diff = ((HOST_WIDE_INT) prec_limbs
! 					- (HOST_WIDE_INT) nelts);
! 		  if (tree_fits_uhwi_p (idx))
! 		    idxl = size_int (tree_to_uhwi (idx) + diff);
! 		  else
! 		    {
! 		      idxl = make_ssa_name (sizetype);
! 		      g = gimple_build_assign (idxl, PLUS_EXPR, idx,
! 					       size_int (diff));
! 		      insert_before (g);
! 		    }
! 		}
! 	      tree l = limb_access (type, var ? var : obj, idxl, true);
  	      if (!useless_type_conversion_p (TREE_TYPE (l), TREE_TYPE (rhs)))
  		rhs = add_cast (TREE_TYPE (l), rhs);
  	      g = gimple_build_assign (l, rhs);
*************** bitint_large_huge::lower_addsub_overflow
*** 4433,4448 ****
  	    {
  	      idx = make_ssa_name (sizetype);
  	      g = gimple_build_assign (idx, PLUS_EXPR, idx_first,
! 				       size_one_node);
  	      insert_before (g);
  	    }
  	  else
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx_first,
! 				       size_int (2));
  	      insert_before (g);
! 	      g = gimple_build_cond (NE_EXPR, idx_next, size_int (fin),
! 				     NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      m_gsi = gsi_for_stmt (final_stmt);
  	      m_bb = NULL;
--- 4888,4909 ----
  	    {
  	      idx = make_ssa_name (sizetype);
  	      g = gimple_build_assign (idx, PLUS_EXPR, idx_first,
! 				       bitint_big_endian
! 				       ? size_int (-1) : size_one_node);
  	      insert_before (g);
  	    }
  	  else
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx_first,
! 				       size_int (bitint_big_endian ? -2 : 2));
  	      insert_before (g);
! 	      if (bitint_big_endian)
! 		g = gimple_build_cond (NE_EXPR, idx_first,
! 				       size_int (nelts + 1 - fin),
! 				       NULL_TREE, NULL_TREE);
! 	      else
! 		g = gimple_build_cond (NE_EXPR, idx_next, size_int (fin),
! 				       NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      m_gsi = gsi_for_stmt (final_stmt);
  	      m_bb = NULL;
*************** bitint_large_huge::lower_addsub_overflow
*** 4450,4456 ****
  	}
      }
  
!   finish_arith_overflow (var, obj, type, ovf, lhs, orig_obj, stmt, code);
  }
  
  /* Lower a .MUL_OVERFLOW call with at least one large/huge _BitInt
--- 4911,4918 ----
  	}
      }
  
!   finish_arith_overflow (var, obj, type, ovf, lhs, orig_obj, stmt,
! 			 prec_limbs, code);
  }
  
  /* Lower a .MUL_OVERFLOW call with at least one large/huge _BitInt
*************** bitint_large_huge::lower_mul_overflow (t
*** 4538,4543 ****
--- 5000,5006 ----
      {
        unsigned startlimb = start / limb_prec;
        unsigned endlimb = (end - 1) / limb_prec;
+       unsigned nelts = CEIL (MAX (prec, prec2), limb_prec);
        unsigned cnt;
        bool use_loop = false;
        if (startlimb == endlimb)
*************** bitint_large_huge::lower_mul_overflow (t
*** 4557,4563 ****
        if (cnt == 1)
  	{
  	  tree l = limb_access (NULL_TREE, var ? var : obj,
! 				size_int (startlimb), true);
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), l);
  	  insert_before (g);
  	  l = arith_overflow_extract_bits (start, end, gimple_assign_lhs (g),
--- 5020,5028 ----
        if (cnt == 1)
  	{
  	  tree l = limb_access (NULL_TREE, var ? var : obj,
! 				size_int (bitint_big_endian
! 					  ? nelts - 1 - startlimb
! 					  :  startlimb), true);
  	  g = gimple_build_assign (make_ssa_name (m_limb_type), l);
  	  insert_before (g);
  	  l = arith_overflow_extract_bits (start, end, gimple_assign_lhs (g),
*************** bitint_large_huge::lower_mul_overflow (t
*** 4591,4610 ****
  	    {
  	      tree idx, idx_next = NULL_TREE;
  	      if (i == 0)
! 		idx = size_int (startlimb);
  	      else if (i == 2)
! 		idx = size_int (endlimb);
  	      else if (use_loop)
! 		idx = create_loop (size_int (startlimb + 1), &idx_next);
  	      else
! 		idx = size_int (startlimb + 1);
  	      tree l = limb_access (NULL_TREE, var ? var : obj, idx, true);
  	      g = gimple_build_assign (make_ssa_name (m_limb_type), l);
  	      insert_before (g);
  	      l = gimple_assign_lhs (g);
  	      if (i == 0 || i == 2)
  		l = arith_overflow_extract_bits (start, end, l,
! 						 tree_to_uhwi (idx),
  						 check_zero);
  	      if (i == 0 && !check_zero)
  		{
--- 5056,5080 ----
  	    {
  	      tree idx, idx_next = NULL_TREE;
  	      if (i == 0)
! 		idx = size_int (bitint_big_endian
! 				? nelts - 1 - startlimb : startlimb);
  	      else if (i == 2)
! 		idx = size_int (bitint_big_endian
! 				? nelts - 1 - endlimb : endlimb);
  	      else if (use_loop)
! 		idx = create_loop (size_int (bitint_big_endian
! 					     ? nelts - startlimb - 2
! 					     : startlimb + 1), &idx_next);
  	      else
! 		idx = size_int (bitint_big_endian
! 				? nelts - startlimb - 2 : startlimb + 1);
  	      tree l = limb_access (NULL_TREE, var ? var : obj, idx, true);
  	      g = gimple_build_assign (make_ssa_name (m_limb_type), l);
  	      insert_before (g);
  	      l = gimple_assign_lhs (g);
  	      if (i == 0 || i == 2)
  		l = arith_overflow_extract_bits (start, end, l,
! 						 i == 0 ? startlimb : endlimb,
  						 check_zero);
  	      if (i == 0 && !check_zero)
  		{
*************** bitint_large_huge::lower_mul_overflow (t
*** 4632,4642 ****
  	      if (i == 1 && use_loop)
  		{
  		  g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 					   size_one_node);
  		  insert_before (g);
! 		  g = gimple_build_cond (NE_EXPR, idx_next,
! 					 size_int (endlimb + (cnt == 2)),
! 					 NULL_TREE, NULL_TREE);
  		  insert_before (g);
  		  edge true_edge, false_edge;
  		  extract_true_false_edges_from_block (gsi_bb (m_gsi),
--- 5102,5119 ----
  	      if (i == 1 && use_loop)
  		{
  		  g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 					   bitint_big_endian
! 					   ? size_int (-1) : size_one_node);
  		  insert_before (g);
! 		  if (bitint_big_endian)
! 		    g = gimple_build_cond (NE_EXPR, idx,
! 					   size_int (nelts - endlimb
! 						     - (cnt == 2)),
! 					   NULL_TREE, NULL_TREE);
! 		  else
! 		    g = gimple_build_cond (NE_EXPR, idx_next,
! 					   size_int (endlimb + (cnt == 2)),
! 					   NULL_TREE, NULL_TREE);
  		  insert_before (g);
  		  edge true_edge, false_edge;
  		  extract_true_false_edges_from_block (gsi_bb (m_gsi),
*************** bitint_large_huge::lower_mul_overflow (t
*** 4661,4667 ****
  	}
      }
  
!   finish_arith_overflow (var, obj, type, ovf, lhs, orig_obj, stmt, MULT_EXPR);
  }
  
  /* Lower REALPART_EXPR or IMAGPART_EXPR stmt extracting part of result from
--- 5138,5145 ----
  	}
      }
  
!   finish_arith_overflow (var, obj, type, ovf, lhs, orig_obj, stmt,
! 			 CEIL (MAX (prec, prec2), limb_prec), MULT_EXPR);
  }
  
  /* Lower REALPART_EXPR or IMAGPART_EXPR stmt extracting part of result from
*************** bitint_large_huge::lower_bit_query (gimp
*** 4833,4851 ****
      }
    tree fndecl = builtin_decl_explicit (fcode), res = NULL_TREE;
    unsigned cnt = 0, rem = 0, end = 0, prec = TYPE_PRECISION (type);
    struct bq_details { edge e; tree val, addend; } *bqp = NULL;
    basic_block edge_bb = NULL;
    if (m_upwards)
      {
        tree idx = NULL_TREE, idx_first = NULL_TREE, idx_next = NULL_TREE;
        if (kind == bitint_prec_large)
! 	cnt = CEIL (prec, limb_prec);
        else
  	{
  	  rem = (prec % (2 * limb_prec));
  	  end = (prec - rem) / limb_prec;
  	  cnt = 2 + CEIL (rem, limb_prec);
! 	  idx = idx_first = create_loop (size_zero_node, &idx_next);
  	}
  
        if (ifn == IFN_CTZ || ifn == IFN_FFS)
--- 5311,5332 ----
      }
    tree fndecl = builtin_decl_explicit (fcode), res = NULL_TREE;
    unsigned cnt = 0, rem = 0, end = 0, prec = TYPE_PRECISION (type);
+   unsigned nelts = CEIL (prec, limb_prec);
    struct bq_details { edge e; tree val, addend; } *bqp = NULL;
    basic_block edge_bb = NULL;
    if (m_upwards)
      {
        tree idx = NULL_TREE, idx_first = NULL_TREE, idx_next = NULL_TREE;
        if (kind == bitint_prec_large)
! 	cnt = nelts;
        else
  	{
  	  rem = (prec % (2 * limb_prec));
  	  end = (prec - rem) / limb_prec;
  	  cnt = 2 + CEIL (rem, limb_prec);
! 	  idx = idx_first = create_loop (bitint_big_endian
! 					 ? size_int (nelts - 1)
! 					 : size_zero_node, &idx_next);
  	}
  
        if (ifn == IFN_CTZ || ifn == IFN_FFS)
*************** bitint_large_huge::lower_bit_query (gimp
*** 4867,4875 ****
  	{
  	  m_data_cnt = 0;
  	  if (kind == bitint_prec_large)
! 	    idx = size_int (i);
  	  else if (i >= 2)
! 	    idx = size_int (end + (i > 2));
  
  	  tree rhs1 = handle_operand (arg0, idx);
  	  if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (rhs1)))
--- 5348,5357 ----
  	{
  	  m_data_cnt = 0;
  	  if (kind == bitint_prec_large)
! 	    idx = size_int (bitint_big_endian ? nelts - 1 - i : i);
  	  else if (i >= 2)
! 	    idx = size_int (bitint_big_endian
! 			    ? nelts - 1 - end - (i > 2) : end + (i > 2));
  
  	  tree rhs1 = handle_operand (arg0, idx);
  	  if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (rhs1)))
*************** bitint_large_huge::lower_bit_query (gimp
*** 4909,4915 ****
  	      if (tree_fits_uhwi_p (idx))
  		bqp[i].addend
  		  = build_int_cst (integer_type_node,
! 				   tree_to_uhwi (idx) * limb_prec
  				   + (ifn == IFN_FFS));
  	      else
  		{
--- 5391,5399 ----
  	      if (tree_fits_uhwi_p (idx))
  		bqp[i].addend
  		  = build_int_cst (integer_type_node,
! 				   (bitint_big_endian
! 				    ? nelts - 1 - tree_to_uhwi (idx)
! 				    : tree_to_uhwi (idx)) * limb_prec
  				   + (ifn == IFN_FFS));
  	      else
  		{
*************** bitint_large_huge::lower_bit_query (gimp
*** 4968,4983 ****
  		{
  		  idx = make_ssa_name (sizetype);
  		  g = gimple_build_assign (idx, PLUS_EXPR, idx_first,
! 					   size_one_node);
  		  insert_before (g);
  		}
  	      else
  		{
  		  g = gimple_build_assign (idx_next, PLUS_EXPR, idx_first,
! 					   size_int (2));
  		  insert_before (g);
! 		  g = gimple_build_cond (NE_EXPR, idx_next, size_int (end),
! 					 NULL_TREE, NULL_TREE);
  		  insert_before (g);
  		  if (ifn == IFN_CTZ || ifn == IFN_FFS)
  		    m_gsi = gsi_after_labels (edge_bb);
--- 5452,5474 ----
  		{
  		  idx = make_ssa_name (sizetype);
  		  g = gimple_build_assign (idx, PLUS_EXPR, idx_first,
! 					   bitint_big_endian
! 					   ? size_int (-1) : size_one_node);
  		  insert_before (g);
  		}
  	      else
  		{
  		  g = gimple_build_assign (idx_next, PLUS_EXPR, idx_first,
! 					   size_int (bitint_big_endian
! 						     ? -2 : 2));
  		  insert_before (g);
! 		  if (bitint_big_endian)
! 		    g = gimple_build_cond (NE_EXPR, idx_first,
! 					   size_int (cnt - 1),
! 					   NULL_TREE, NULL_TREE);
! 		  else
! 		    g = gimple_build_cond (NE_EXPR, idx_next, size_int (end),
! 					   NULL_TREE, NULL_TREE);
  		  insert_before (g);
  		  if (ifn == IFN_CTZ || ifn == IFN_FFS)
  		    m_gsi = gsi_after_labels (edge_bb);
*************** bitint_large_huge::lower_bit_query (gimp
*** 4993,4999 ****
        tree idx = NULL_TREE, idx_next = NULL_TREE, first = NULL_TREE;
        int sub_one = 0;
        if (kind == bitint_prec_large)
! 	cnt = CEIL (prec, limb_prec);
        else
  	{
  	  rem = prec % limb_prec;
--- 5484,5490 ----
        tree idx = NULL_TREE, idx_next = NULL_TREE, first = NULL_TREE;
        int sub_one = 0;
        if (kind == bitint_prec_large)
! 	cnt = nelts;
        else
  	{
  	  rem = prec % limb_prec;
*************** bitint_large_huge::lower_bit_query (gimp
*** 5026,5036 ****
  	{
  	  m_data_cnt = 0;
  	  if (kind == bitint_prec_large)
! 	    idx = size_int (cnt - i - 1);
  	  else if (i == cnt - 1)
! 	    idx = create_loop (size_int (end - 1), &idx_next);
  	  else
! 	    idx = size_int (end);
  
  	  tree rhs1 = handle_operand (arg0, idx);
  	  if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (rhs1)))
--- 5517,5528 ----
  	{
  	  m_data_cnt = 0;
  	  if (kind == bitint_prec_large)
! 	    idx = size_int (bitint_big_endian ? i : cnt - i - 1);
  	  else if (i == cnt - 1)
! 	    idx = create_loop (size_int (bitint_big_endian ? i : end - 1),
! 			       &idx_next);
  	  else
! 	    idx = bitint_big_endian ? size_zero_node : size_int (end);
  
  	  tree rhs1 = handle_operand (arg0, idx);
  	  if (!useless_type_conversion_p (m_limb_type, TREE_TYPE (rhs1)))
*************** bitint_large_huge::lower_bit_query (gimp
*** 5115,5121 ****
  	    bqp[i].addend
  	      = build_int_cst (integer_type_node,
  			       (int) prec
! 			       - (((int) tree_to_uhwi (idx) + 1)
  				  * limb_prec) - sub_one);
  	  else
  	    {
--- 5607,5615 ----
  	    bqp[i].addend
  	      = build_int_cst (integer_type_node,
  			       (int) prec
! 			       - (((int) (bitint_big_endian
! 					  ? nelts - 1 - tree_to_uhwi (idx)
! 					  : tree_to_uhwi (idx)) + 1)
  				  * limb_prec) - sub_one);
  	  else
  	    {
*************** bitint_large_huge::lower_bit_query (gimp
*** 5136,5144 ****
  	  if (kind == bitint_prec_huge && i == cnt - 1)
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 				       size_int (-1));
  	      insert_before (g);
! 	      g = gimple_build_cond (NE_EXPR, idx, size_zero_node,
  				     NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      edge true_edge, false_edge;
--- 5630,5641 ----
  	  if (kind == bitint_prec_huge && i == cnt - 1)
  	    {
  	      g = gimple_build_assign (idx_next, PLUS_EXPR, idx,
! 				       bitint_big_endian
! 				       ? size_one_node : size_int (-1));
  	      insert_before (g);
! 	      g = gimple_build_cond (NE_EXPR, idx,
! 				     bitint_big_endian
! 				     ? size_int (nelts - 1) : size_zero_node,
  				     NULL_TREE, NULL_TREE);
  	      insert_before (g);
  	      edge true_edge, false_edge;
*************** bitint_large_huge::lower_stmt (gimple *s
*** 5667,5680 ****
  						   TYPE_UNSIGNED (lhs_type));
        m_data_cnt = 0;
        tree rhs1 = gimple_assign_rhs1 (stmt);
!       tree r1 = handle_operand (rhs1, size_int (0));
        if (!useless_type_conversion_p (lhs_type, TREE_TYPE (r1)))
  	r1 = add_cast (lhs_type, r1);
        if (TYPE_PRECISION (lhs_type) > limb_prec)
  	{
  	  m_data_cnt = 0;
  	  m_first = false;
! 	  tree r2 = handle_operand (rhs1, size_int (1));
  	  r2 = add_cast (lhs_type, r2);
  	  g = gimple_build_assign (make_ssa_name (lhs_type), LSHIFT_EXPR, r2,
  				   build_int_cst (unsigned_type_node,
--- 6164,6181 ----
  						   TYPE_UNSIGNED (lhs_type));
        m_data_cnt = 0;
        tree rhs1 = gimple_assign_rhs1 (stmt);
!       unsigned int prec = TYPE_PRECISION (TREE_TYPE (rhs1));
!       unsigned int cnt = CEIL (prec, limb_prec);
!       tree r1 = handle_operand (rhs1, size_int (bitint_big_endian
! 						? cnt - 1 : 0));
        if (!useless_type_conversion_p (lhs_type, TREE_TYPE (r1)))
  	r1 = add_cast (lhs_type, r1);
        if (TYPE_PRECISION (lhs_type) > limb_prec)
  	{
  	  m_data_cnt = 0;
  	  m_first = false;
! 	  tree r2 = handle_operand (rhs1, size_int (bitint_big_endian
! 						    ? cnt - 2 : 1));
  	  r2 = add_cast (lhs_type, r2);
  	  g = gimple_build_assign (make_ssa_name (lhs_type), LSHIFT_EXPR, r2,
  				   build_int_cst (unsigned_type_node,
*************** bitint_dom_walker::before_dom_children (
*** 5867,5873 ****
  	      tree fld = TREE_OPERAND (rhs1, 1);
  	      /* For little-endian, we can allow as inputs bit-fields
  		 which start at a limb boundary.  */
! 	      if (DECL_OFFSET_ALIGN (fld) >= TYPE_ALIGN (TREE_TYPE (rhs1))
  		  && tree_fits_uhwi_p (DECL_FIELD_BIT_OFFSET (fld))
  		  && (tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld))
  		      % limb_prec) == 0)
--- 6368,6375 ----
  	      tree fld = TREE_OPERAND (rhs1, 1);
  	      /* For little-endian, we can allow as inputs bit-fields
  		 which start at a limb boundary.  */
! 	      if (!bitint_big_endian
! 		  && DECL_OFFSET_ALIGN (fld) >= TYPE_ALIGN (TREE_TYPE (rhs1))
  		  && tree_fits_uhwi_p (DECL_FIELD_BIT_OFFSET (fld))
  		  && (tree_to_uhwi (DECL_FIELD_BIT_OFFSET (fld))
  		      % limb_prec) == 0)
*************** build_bitint_stmt_ssa_conflicts (gimple
*** 5969,5977 ****
--- 6471,6576 ----
  	    }
  	}
      }
+   else if (bitint_big_endian
+ 	   && is_gimple_call (stmt)
+ 	   && gimple_call_internal_p (stmt))
+     switch (gimple_call_internal_fn (stmt))
+       {
+       case IFN_ADD_OVERFLOW:
+       case IFN_SUB_OVERFLOW:
+       case IFN_UBSAN_CHECK_ADD:
+       case IFN_UBSAN_CHECK_SUB:
+       case IFN_MUL_OVERFLOW:
+       case IFN_UBSAN_CHECK_MUL:
+ 	lhs = gimple_call_lhs (stmt);
+ 	if (lhs)
+ 	  muldiv_p = true;
+ 	break;
+       default:
+ 	break;
+       }
  
+   auto_vec<tree, 16> worklist;
    ssa_op_iter iter;
    tree var;
+   /* On little-endian, mergeable ops process limbs from 0 up so except
+      for multiplication/division/modulo there is no risk in using the
+      same underlying variable for lhs and some operand, even when casts
+      are involved, the lhs limb is stored only after processing the source
+      limbs with the same index.
+      For multiplication/division/modulo, the libgcc library function requires
+      no aliasing between result and sources.
+      On big-endian, even mergeable ops limb processing can be problematic
+      though, because it can apply various index corrections e.g. when there
+      is a cast from operand with different number of limbs.  So, make the
+      lhs conflict with all the operands which are (for now virtually) used on
+      the current stmt if there is any mismatch in the number of limbs between
+      operands and the lhs.  */
+   if (bitint_big_endian && lhs && !muldiv_p)
+     {
+       tree ltype = TREE_TYPE (lhs);
+       if (TREE_CODE (ltype) == COMPLEX_TYPE)
+ 	muldiv_p = true;
+       else if (TREE_CODE (lhs) == SSA_NAME
+ 	       && TREE_CODE (ltype) == BITINT_TYPE
+ 	       && bitint_precision_kind (ltype) >= bitint_prec_large)
+ 	{
+ 	  unsigned lnelts = CEIL (TYPE_PRECISION (ltype), limb_prec);
+ 	  FOR_EACH_SSA_TREE_OPERAND (var, stmt, iter, SSA_OP_USE)
+ 	    {
+ 	      tree type = TREE_TYPE (var);
+ 	      if (TREE_CODE (type) == COMPLEX_TYPE)
+ 		type = TREE_TYPE (type);
+ 	      if (TREE_CODE (type) == BITINT_TYPE
+ 		  && bitint_precision_kind (type) >= bitint_prec_large)
+ 		{
+ 		  if (bitmap_bit_p (names, SSA_NAME_VERSION (var)))
+ 		    {
+ 		      unsigned nelts = CEIL (TYPE_PRECISION (type), limb_prec);
+ 		      if (TREE_CODE (TREE_TYPE (var)) == COMPLEX_TYPE
+ 			  || lnelts != nelts)
+ 			{
+ 			  muldiv_p = true;
+ 			  break;
+ 			}
+ 		    }
+ 		  else
+ 		    worklist.safe_push (var);
+ 		}
+ 	    }
+ 
+ 	  while (!muldiv_p && worklist.length () > 0)
+ 	    {
+ 	      tree s = worklist.pop ();
+ 	      FOR_EACH_SSA_TREE_OPERAND (var, SSA_NAME_DEF_STMT (s), iter,
+ 					 SSA_OP_USE)
+ 		{
+ 		  tree type = TREE_TYPE (var);
+ 		  if (TREE_CODE (type) == COMPLEX_TYPE)
+ 		    type = TREE_TYPE (type);
+ 		  if (TREE_CODE (type) == BITINT_TYPE
+ 		      && bitint_precision_kind (type) >= bitint_prec_large)
+ 		    {
+ 		      if (bitmap_bit_p (names, SSA_NAME_VERSION (var)))
+ 			{
+ 			  unsigned nelts = CEIL (TYPE_PRECISION (type),
+ 						 limb_prec);
+ 			  if (TREE_CODE (TREE_TYPE (var)) == COMPLEX_TYPE
+ 			      || lnelts != nelts)
+ 			    {
+ 			      muldiv_p = true;
+ 			      break;
+ 			    }
+ 			}
+ 		      else
+ 			worklist.safe_push (var);
+ 		    }
+ 		}
+ 	    }
+ 	  worklist.truncate (0);
+ 	}
+     }
+ 
    if (!muldiv_p)
      {
        /* For stmts with more than one SSA_NAME definition pretend all the
*************** build_bitint_stmt_ssa_conflicts (gimple
*** 5995,6001 ****
  	def (live, var, graph);
      }
  
-   auto_vec<tree, 16> worklist;
    FOR_EACH_SSA_TREE_OPERAND (var, stmt, iter, SSA_OP_USE)
      {
        tree type = TREE_TYPE (var);
--- 6594,6599 ----
*************** gimple_lower_bitint (void)
*** 6072,6077 ****
--- 6670,6676 ----
  {
    small_max_prec = mid_min_prec = large_min_prec = huge_min_prec = 0;
    limb_prec = 0;
+   bitint_big_endian = false;
  
    unsigned int i;
    for (i = 0; i < num_ssa_names; ++i)
*************** gimple_lower_bitint (void)
*** 7056,7064 ****
  			  break;
  			}
  		      if (TREE_CODE (TREE_TYPE (c)) == INTEGER_TYPE)
! 			g = gimple_build_assign (build1 (VIEW_CONVERT_EXPR,
! 							 TREE_TYPE (c), v1),
! 						 c);
  		      else
  			{
  			  unsigned HOST_WIDE_INT nelts
--- 7655,7679 ----
  			  break;
  			}
  		      if (TREE_CODE (TREE_TYPE (c)) == INTEGER_TYPE)
! 			{
! 			  if (bitint_big_endian)
! 			    {
! 			      tree ptype = build_pointer_type (TREE_TYPE (v1));
! 			      tree sz1 = TYPE_SIZE_UNIT (TREE_TYPE (v1));
! 			      tree sz2 = TYPE_SIZE_UNIT (TREE_TYPE (c));
! 			      tree off = build_int_cst (ptype,
! 							tree_to_uhwi (sz1)
! 							- tree_to_uhwi (sz2));
! 			      tree vd = build2 (MEM_REF, TREE_TYPE (c),
! 						build_fold_addr_expr (v1),
! 						off);
! 			      g = gimple_build_assign (vd, c);
! 			    }
! 			  else
! 			    g = gimple_build_assign (build1 (VIEW_CONVERT_EXPR,
! 							     TREE_TYPE (c),
! 							     v1), c);
! 			}
  		      else
  			{
  			  unsigned HOST_WIDE_INT nelts
*************** gimple_lower_bitint (void)
*** 7067,7074 ****
  			  tree vtype
  			    = build_array_type_nelts (large_huge.m_limb_type,
  						      nelts);
! 			  g = gimple_build_assign (build1 (VIEW_CONVERT_EXPR,
! 							   vtype, v1),
  						   build1 (VIEW_CONVERT_EXPR,
  							   vtype, c));
  			}
--- 7682,7702 ----
  			  tree vtype
  			    = build_array_type_nelts (large_huge.m_limb_type,
  						      nelts);
! 			  tree vd;
! 			  if (bitint_big_endian)
! 			    {
! 			      tree ptype = build_pointer_type (TREE_TYPE (v1));
! 			      tree sz1 = TYPE_SIZE_UNIT (TREE_TYPE (v1));
! 			      tree sz2 = TYPE_SIZE_UNIT (vtype);
! 			      tree off = build_int_cst (ptype,
! 							tree_to_uhwi (sz1)
! 							- tree_to_uhwi (sz2));
! 			      vd = build2 (MEM_REF, vtype,
! 					   build_fold_addr_expr (v1), off);
! 			    }
! 			  else
! 			    vd = build1 (VIEW_CONVERT_EXPR, vtype, v1);
! 			  g = gimple_build_assign (vd,
  						   build1 (VIEW_CONVERT_EXPR,
  							   vtype, c));
  			}
*************** gimple_lower_bitint (void)
*** 7084,7090 ****
  						  nelts);
  		      tree ptype = build_pointer_type (TREE_TYPE (v1));
  		      tree off;
! 		      if (c)
  			off = fold_convert (ptype,
  					    TYPE_SIZE_UNIT (TREE_TYPE (c)));
  		      else
--- 7712,7718 ----
  						  nelts);
  		      tree ptype = build_pointer_type (TREE_TYPE (v1));
  		      tree off;
! 		      if (c && !bitint_big_endian)
  			off = fold_convert (ptype,
  					    TYPE_SIZE_UNIT (TREE_TYPE (c)));
  		      else
*************** gimple_lower_bitint (void)
*** 7096,7102 ****
  		  else
  		    {
  		      tree vd = v1;
! 		      if (c)
  			{
  			  tree ptype = build_pointer_type (TREE_TYPE (v1));
  			  tree off
--- 7724,7730 ----
  		  else
  		    {
  		      tree vd = v1;
! 		      if (c && !bitint_big_endian)
  			{
  			  tree ptype = build_pointer_type (TREE_TYPE (v1));
  			  tree off
diff -Nrcpad gcc-16-20250518/gcc/gimple-match-exports.cc gcc-16-20250525/gcc/gimple-match-exports.cc
*** gcc-16-20250518/gcc/gimple-match-exports.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/gimple-match-exports.cc	Sun May 25 22:32:06 2025
*************** gimple_simplify (combined_fn fn, tree ty
*** 720,735 ****
     describe STMT in RES_OP, returning true on success.  Before recording
     an operand, call:
  
!    - VALUEIZE_CONDITION for a COND_EXPR condition
!    - VALUEIZE_OP for every other top-level operand
  
!    Both routines take a tree argument and returns a tree.  */
  
! template<typename ValueizeOp, typename ValueizeCondition>
  inline bool
  gimple_extract (gimple *stmt, gimple_match_op *res_op,
! 		ValueizeOp valueize_op,
! 		ValueizeCondition valueize_condition)
  {
    switch (gimple_code (stmt))
      {
--- 720,733 ----
     describe STMT in RES_OP, returning true on success.  Before recording
     an operand, call:
  
!    - VALUEIZE_OP for all top-level operand
  
!    This routine takes a tree argument and returns a tree.  */
  
! template<typename ValueizeOp>
  inline bool
  gimple_extract (gimple *stmt, gimple_match_op *res_op,
! 		ValueizeOp valueize_op)
  {
    switch (gimple_code (stmt))
      {
*************** bool
*** 858,864 ****
  gimple_extract_op (gimple *stmt, gimple_match_op *res_op)
  {
    auto nop = [](tree op) { return op; };
!   return gimple_extract (stmt, res_op, nop, nop);
  }
  
  /* The main STMT based simplification entry.  It is used by the fold_stmt
--- 856,862 ----
  gimple_extract_op (gimple *stmt, gimple_match_op *res_op)
  {
    auto nop = [](tree op) { return op; };
!   return gimple_extract (stmt, res_op, nop);
  }
  
  /* The main STMT based simplification entry.  It is used by the fold_stmt
*************** gimple_simplify (gimple *stmt, gimple_ma
*** 873,910 ****
      {
        return do_valueize (op, top_valueize, valueized);
      };
-   auto valueize_condition = [&](tree op) -> tree
-     {
-       bool cond_valueized = false;
-       tree lhs = do_valueize (TREE_OPERAND (op, 0), top_valueize,
- 			      cond_valueized);
-       tree rhs = do_valueize (TREE_OPERAND (op, 1), top_valueize,
- 			      cond_valueized);
-       gimple_match_op res_op2 (res_op->cond, TREE_CODE (op),
- 			       TREE_TYPE (op), lhs, rhs);
-       if ((gimple_resimplify2 (seq, &res_op2, valueize)
- 	   || cond_valueized)
- 	  && res_op2.code.is_tree_code ())
- 	{
- 	  auto code = tree_code (res_op2.code);
- 	  if (TREE_CODE_CLASS (code) == tcc_comparison)
- 	    {
- 	      valueized = true;
- 	      return build2 (code, TREE_TYPE (op),
- 			     res_op2.ops[0], res_op2.ops[1]);
- 	    }
- 	  else if (code == SSA_NAME
- 		   || code == INTEGER_CST
- 		   || code == VECTOR_CST)
- 	    {
- 	      valueized = true;
- 	      return res_op2.ops[0];
- 	    }
- 	}
-       return valueize_op (op);
-     };
  
!   if (!gimple_extract (stmt, res_op, valueize_op, valueize_condition))
      return false;
  
    if (res_op->code.is_internal_fn ())
--- 871,878 ----
      {
        return do_valueize (op, top_valueize, valueized);
      };
  
!   if (!gimple_extract (stmt, res_op, valueize_op))
      return false;
  
    if (res_op->code.is_internal_fn ())
diff -Nrcpad gcc-16-20250518/gcc/lto-streamer-out.cc gcc-16-20250525/gcc/lto-streamer-out.cc
*** gcc-16-20250518/gcc/lto-streamer-out.cc	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/lto-streamer-out.cc	Sun May 25 22:32:06 2025
*************** hash_tree (struct streamer_tree_cache_d
*** 1398,1404 ****
        hstate.commit_flag ();
        hstate.add_int (TYPE_PRECISION_RAW (t));
        hstate.add_int (TYPE_ALIGN (t));
!       hstate.add_int (TYPE_EMPTY_P (t));
      }
  
    if (CODE_CONTAINS_STRUCT (code, TS_TRANSLATION_UNIT_DECL))
--- 1398,1405 ----
        hstate.commit_flag ();
        hstate.add_int (TYPE_PRECISION_RAW (t));
        hstate.add_int (TYPE_ALIGN (t));
!       if (!lto_stream_offload_p)
! 	hstate.add_int (TYPE_EMPTY_P (t));
      }
  
    if (CODE_CONTAINS_STRUCT (code, TS_TRANSLATION_UNIT_DECL))
diff -Nrcpad gcc-16-20250518/gcc/m2/ChangeLog gcc-16-20250525/gcc/m2/ChangeLog
*** gcc-16-20250518/gcc/m2/ChangeLog	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/m2/ChangeLog	Sun May 25 22:32:06 2025
***************
*** 1,3 ****
--- 1,10 ----
+ 2025-05-22  Gaius Mulley  <gaiusmod2@gmail.com>
+ 
+ 	PR modula2/120389
+ 	* gm2-compiler/M2GenGCC.mod (CodeXIndr): Check to see that
+ 	the type of left is assignment compatible with the type of
+ 	right.
+ 
  2025-05-13  Gaius Mulley  <gaiusmod2@gmail.com>
  
  	PR modula2/120253
diff -Nrcpad gcc-16-20250518/gcc/m2/gm2-compiler/M2GenGCC.mod gcc-16-20250525/gcc/m2/gm2-compiler/M2GenGCC.mod
*** gcc-16-20250518/gcc/m2/gm2-compiler/M2GenGCC.mod	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/m2/gm2-compiler/M2GenGCC.mod	Sun May 25 22:32:06 2025
*************** BEGIN
*** 8229,8234 ****
--- 8229,8242 ----
     type := SkipType (type) ;
     DeclareConstant (rightpos, right) ;
     DeclareConstructor (rightpos, quad, right) ;
+    IF StrictTypeChecking AND
+       (NOT AssignmentTypeCompatible (xindrpos, "", GetType (left), right))
+    THEN
+       MetaErrorT2 (tokenno,
+                    'assignment check caught mismatch between {%1Ead} and {%2ad}',
+                    left, right) ;
+       SubQuad (quad)
+    END ;
     IF IsProcType(SkipType(type))
     THEN
        BuildAssignmentStatement (location, BuildIndirect (location, Mod2Gcc (left), GetPointerType ()), Mod2Gcc (right))
diff -Nrcpad gcc-16-20250518/gcc/match.pd gcc-16-20250525/gcc/match.pd
*** gcc-16-20250518/gcc/match.pd	Sun May 18 22:32:08 2025
--- gcc-16-20250525/gcc/match.pd	Sun May 25 22:32:06 2025
*************** and,
*** 11360,11365 ****
--- 11360,11396 ----
         && single_use (@4)
         && single_use (@5))))
  
+ /* Floating point or integer comparison and floating point conversion
+    with REAL_CST.  */
+ (match (cond_expr_convert_p @0 @2 @3 @6)
+  (cond (simple_comparison@6 @0 @1) (REAL_CST@2) (convert@5 @3))
+   (if (!flag_trapping_math
+        && SCALAR_FLOAT_TYPE_P (type)
+        && SCALAR_FLOAT_TYPE_P (TREE_TYPE (@3))
+        && !operand_equal_p (TYPE_SIZE (type),
+ 			    TYPE_SIZE (TREE_TYPE (@0)))
+        && operand_equal_p (TYPE_SIZE (TREE_TYPE (@0)),
+ 			   TYPE_SIZE (TREE_TYPE (@3)))
+        && single_use (@5)
+        && (flag_unsafe_math_optimizations
+ 	   || exact_real_truncate (TYPE_MODE (TREE_TYPE (@3)),
+ 				   &TREE_REAL_CST (@2))))))
+ 
+ /* Floating point or integer comparison and floating point conversion
+    with REAL_CST.  */
+ (match (cond_expr_convert_p @0 @2 @3 @6)
+  (cond (simple_comparison@6 @0 @1) (convert@4 @2) (REAL_CST@3))
+   (if (!flag_trapping_math
+        && SCALAR_FLOAT_TYPE_P (type)
+        && SCALAR_FLOAT_TYPE_P (TREE_TYPE (@2))
+        && !operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (TREE_TYPE (@0)))
+        && operand_equal_p (TYPE_SIZE (TREE_TYPE (@0)),
+ 			   TYPE_SIZE (TREE_TYPE (@2)))
+        && single_use (@4)
+        && (flag_unsafe_math_optimizations
+ 	   || exact_real_truncate (TYPE_MODE (TREE_TYPE (@2)),
+ 				   &TREE_REAL_CST (@3))))))
+ 
  (for bit_op (bit_and bit_ior bit_xor)
   (match (bitwise_induction_p @0 @2 @3)
    (bit_op:c
*************** and,
*** 11455,11457 ****
--- 11486,11511 ----
        }
        (if (full_perm_p)
  	(vec_perm (op@3 @0 @1) @3 @2))))))
+ 
+ #if GIMPLE
+ /* Simplify (a >> 1) + (b >> 1) + ((a | b) & 1) to .AVG_CEIL (a, b).
+    Similar for (a | b) - ((a ^ b) >> 1).  */
+ 
+ (simplify
+   (plus:c
+     (plus (rshift @0 integer_onep@1) (rshift @2 @1))
+     (bit_and (bit_ior @0 @2) integer_onep@3))
+   (if (cfun && (cfun->curr_properties & PROP_last_full_fold) != 0
+       && VECTOR_TYPE_P (type)
+       && direct_internal_fn_supported_p (IFN_AVG_CEIL, type, OPTIMIZE_FOR_BOTH))
+       (IFN_AVG_CEIL @0 @2)))
+ 
+ (simplify
+   (minus
+     (bit_ior @0 @2)
+     (rshift (bit_xor @0 @2) integer_onep@1))
+   (if (cfun && (cfun->curr_properties & PROP_last_full_fold) != 0
+       && VECTOR_TYPE_P (type)
+       && direct_internal_fn_supported_p (IFN_AVG_CEIL, type, OPTIMIZE_FOR_BOTH))
+       (IFN_AVG_CEIL @0 @2)))
+ #endif
diff -Nrcpad gcc-16-20250518/gcc/regcprop.cc gcc-16-20250525/gcc/regcprop.cc
*** gcc-16-20250518/gcc/regcprop.cc	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/regcprop.cc	Sun May 25 22:32:06 2025
*************** copy_value (rtx dest, rtx src, struct va
*** 332,337 ****
--- 332,341 ----
    if (vd->e[sr].mode == VOIDmode)
      set_value_regno (sr, vd->e[dr].mode, vd);
  
+   else if (!ordered_p (GET_MODE_PRECISION (vd->e[sr].mode),
+ 		       GET_MODE_PRECISION (GET_MODE (src))))
+     return;
+ 
    /* If we are narrowing the input to a smaller number of hard regs,
       and it is in big endian, we are really extracting a high part.
       Since we generally associate a low part of a value with the value itself,
diff -Nrcpad gcc-16-20250518/gcc/rtl.h gcc-16-20250525/gcc/rtl.h
*** gcc-16-20250518/gcc/rtl.h	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/rtl.h	Sun May 25 22:32:06 2025
*************** const_vector_encoded_nelts (const_rtx x)
*** 2074,2080 ****
  inline bool
  always_void_p (enum rtx_code code)
  {
!   return code == SET;
  }
  
  /* A structure to hold all available cost information about an rtl
--- 2074,2090 ----
  inline bool
  always_void_p (enum rtx_code code)
  {
!   switch (code)
!     {
!     case SET:
!     case PC:
!     case RETURN:
!     case SIMPLE_RETURN:
!       return true;
! 
!     default:
!       return false;
!     }
  }
  
  /* A structure to hold all available cost information about an rtl
*************** extern enum rtx_code classify_insn (rtx)
*** 3020,3025 ****
--- 3030,3065 ----
  extern void dump_rtx_statistics (void);
  
  /* In emit-rtl.cc */
+ 
+ /* Opcodes used in the bytecode generated by genemit.cc.  */
+ enum class expand_opcode {
+   /* NULL_RTX.  */
+   NO_RTX,
+ 
+   /* A (match_operand N) or (match_dup N).  Followed by the operand number.  */
+   MATCH_OPERAND,
+ 
+   /* A (match_operator N) or (match_op_dup N) that preserves the original mode.
+      Followed by the operand number.  */
+   MATCH_OPERATOR,
+ 
+   /* A (match_operator N) or (match_op_dup N) that overrides the original mode.
+      Followed by the new mode and by the operand number.  */
+   MATCH_OPERATOR_WITH_MODE,
+ 
+   /* A (match_parallel N) or (match_par_dup N).  Followed by the operand
+      number.  */
+   MATCH_PARALLEL,
+ 
+   /* A (clobber (reg:M R)).  Followed by M and R.  */
+   CLOBBER_REG,
+ 
+   /* FIRST_CODE + X represents a normal rtx with code X.  */
+   FIRST_CODE
+ };
+ 
+ extern rtx expand_rtx (const uint8_t *, rtx *);
+ extern rtx_insn *complete_seq (const uint8_t *, rtx *);
  extern rtx copy_rtx_if_shared (rtx);
  
  /* In rtl.cc */
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ChangeLog gcc-16-20250525/gcc/testsuite/ChangeLog
*** gcc-16-20250518/gcc/testsuite/ChangeLog	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ChangeLog	Sun May 25 22:32:07 2025
***************
*** 1,3 ****
--- 1,9197 ----
+ 2025-05-24  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* ada/acats-4/elabd.lst: New file.
+ 	* ada/acats-4/floatstore.lst: Likewise.
+ 	* ada/acats-4/norun.lst: Likewise.
+ 	* ada/acats-4/run_acats.sh: Likewise.
+ 	* ada/acats-4/run_all.sh: Likewise.
+ 	* ada/acats-4/run_test.exp: Likewise.
+ 	* ada/acats-4/stackcheck.lst: Likewise.
+ 	* ada/acats-4/support/acats42.lst: Likewise.
+ 	* ada/acats-4/support/checkfil.ada: Likewise.
+ 	* ada/acats-4/support/enumchek.ada: Likewise.
+ 	* ada/acats-4/support/f340a000.a: Likewise.
+ 	* ada/acats-4/support/f340a001.a: Likewise.
+ 	* ada/acats-4/support/f341a00.a: Likewise.
+ 	* ada/acats-4/support/f350a00.a: Likewise.
+ 	* ada/acats-4/support/f350b00.a: Likewise.
+ 	* ada/acats-4/support/f360a00.a: Likewise.
+ 	* ada/acats-4/support/f360b00.a: Likewise.
+ 	* ada/acats-4/support/f390a00.a: Likewise.
+ 	* ada/acats-4/support/f392a00.a: Likewise.
+ 	* ada/acats-4/support/f392c00.a: Likewise.
+ 	* ada/acats-4/support/f392d00.a: Likewise.
+ 	* ada/acats-4/support/f393a00.a: Likewise.
+ 	* ada/acats-4/support/f393b00.a: Likewise.
+ 	* ada/acats-4/support/f394a00.a: Likewise.
+ 	* ada/acats-4/support/f3a1a00.a: Likewise.
+ 	* ada/acats-4/support/f3a2a00.a: Likewise.
+ 	* ada/acats-4/support/f416a00.a: Likewise.
+ 	* ada/acats-4/support/f431a00.a: Likewise.
+ 	* ada/acats-4/support/f433a00.a: Likewise.
+ 	* ada/acats-4/support/f452a00.a: Likewise.
+ 	* ada/acats-4/support/f458a00.a: Likewise.
+ 	* ada/acats-4/support/f460a00.a: Likewise.
+ 	* ada/acats-4/support/f552a00.a: Likewise.
+ 	* ada/acats-4/support/f611a00.a: Likewise.
+ 	* ada/acats-4/support/f611b00.a: Likewise.
+ 	* ada/acats-4/support/f650a00.a: Likewise.
+ 	* ada/acats-4/support/f650b00.a: Likewise.
+ 	* ada/acats-4/support/f730a000.a: Likewise.
+ 	* ada/acats-4/support/f730a001.a: Likewise.
+ 	* ada/acats-4/support/f731a00.a: Likewise.
+ 	* ada/acats-4/support/f732a00.a: Likewise.
+ 	* ada/acats-4/support/f732b00.a: Likewise.
+ 	* ada/acats-4/support/f732c00.a: Likewise.
+ 	* ada/acats-4/support/f750a00.a: Likewise.
+ 	* ada/acats-4/support/f760a00.a: Likewise.
+ 	* ada/acats-4/support/f940a00.a: Likewise.
+ 	* ada/acats-4/support/f954a00.a: Likewise.
+ 	* ada/acats-4/support/fa11a00.a: Likewise.
+ 	* ada/acats-4/support/fa11b00.a: Likewise.
+ 	* ada/acats-4/support/fa11c00.a: Likewise.
+ 	* ada/acats-4/support/fa11d00.a: Likewise.
+ 	* ada/acats-4/support/fa13a00.a: Likewise.
+ 	* ada/acats-4/support/fa13b00.a: Likewise.
+ 	* ada/acats-4/support/fa21a00.a: Likewise.
+ 	* ada/acats-4/support/fb20a00.a: Likewise.
+ 	* ada/acats-4/support/fb40a00.a: Likewise.
+ 	* ada/acats-4/support/fc50a00.a: Likewise.
+ 	* ada/acats-4/support/fc51a00.a: Likewise.
+ 	* ada/acats-4/support/fc51b00.a: Likewise.
+ 	* ada/acats-4/support/fc51c00.a: Likewise.
+ 	* ada/acats-4/support/fc51d00.a: Likewise.
+ 	* ada/acats-4/support/fc54a00.a: Likewise.
+ 	* ada/acats-4/support/fc70a00.a: Likewise.
+ 	* ada/acats-4/support/fc70b00.a: Likewise.
+ 	* ada/acats-4/support/fc70c00.a: Likewise.
+ 	* ada/acats-4/support/fcndecl.ada: Likewise.
+ 	* ada/acats-4/support/fd72a00.a: Likewise.
+ 	* ada/acats-4/support/fdb0a00.a: Likewise.
+ 	* ada/acats-4/support/fdb3a00.a: Likewise.
+ 	* ada/acats-4/support/fdd2a00.a: Likewise.
+ 	* ada/acats-4/support/fdd2b00.a: Likewise.
+ 	* ada/acats-4/support/fxa5a00.a: Likewise.
+ 	* ada/acats-4/support/fxaca00.a: Likewise.
+ 	* ada/acats-4/support/fxacb00.a: Likewise.
+ 	* ada/acats-4/support/fxacc00.a: Likewise.
+ 	* ada/acats-4/support/fxaia00.a: Likewise.
+ 	* ada/acats-4/support/fxaib00.a: Likewise.
+ 	* ada/acats-4/support/fxc6a00.a: Likewise.
+ 	* ada/acats-4/support/fxe2a00.a: Likewise.
+ 	* ada/acats-4/support/fxf2a00.a: Likewise.
+ 	* ada/acats-4/support/fxf3a00.a: Likewise.
+ 	* ada/acats-4/support/grade.a: Likewise.
+ 	* ada/acats-4/support/grd_data.a: Likewise.
+ 	* ada/acats-4/support/impbit.adb: Likewise.
+ 	* ada/acats-4/support/impdef.a: Likewise.
+ 	* ada/acats-4/support/impdefc.a: Likewise.
+ 	* ada/acats-4/support/impdefd.a: Likewise.
+ 	* ada/acats-4/support/impdefe.a: Likewise.
+ 	* ada/acats-4/support/impdefg.a: Likewise.
+ 	* ada/acats-4/support/impdefh.a: Likewise.
+ 	* ada/acats-4/support/lencheck.ada: Likewise.
+ 	* ada/acats-4/support/macro.dfs: Likewise.
+ 	* ada/acats-4/support/macrodef.adb: Likewise.
+ 	* ada/acats-4/support/macrosub.ada: Likewise.
+ 	* ada/acats-4/support/report.a: Likewise.
+ 	* ada/acats-4/support/special.a: Likewise.
+ 	* ada/acats-4/support/spprt13s.tst: Likewise.
+ 	* ada/acats-4/support/summary.a: Likewise.
+ 	* ada/acats-4/support/tctouch.ada: Likewise.
+ 	* ada/acats-4/support/trace.a: Likewise.
+ 	* ada/acats-4/support/tst_sum.a: Likewise.
+ 	* ada/acats-4/support/tsttests.dat: Likewise.
+ 	* ada/acats-4/support/version.a: Likewise.
+ 	* ada/acats-4/tests/a/a22006b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a22006c.ada: Likewise.
+ 	* ada/acats-4/tests/a/a22006d.ada: Likewise.
+ 	* ada/acats-4/tests/a/a26007a.tst: Likewise.
+ 	* ada/acats-4/tests/a/a27003a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a29003a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a2a031a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a33003a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a34017c.ada: Likewise.
+ 	* ada/acats-4/tests/a/a35101b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a35402a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a35801f.ada: Likewise.
+ 	* ada/acats-4/tests/a/a35902c.ada: Likewise.
+ 	* ada/acats-4/tests/a/a38106d.ada: Likewise.
+ 	* ada/acats-4/tests/a/a38106e.ada: Likewise.
+ 	* ada/acats-4/tests/a/a49027a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a49027b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a49027c.ada: Likewise.
+ 	* ada/acats-4/tests/a/a54b01a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a54b02a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a55b12a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a55b13a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a55b14a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a71004a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a73001i.ada: Likewise.
+ 	* ada/acats-4/tests/a/a73001j.ada: Likewise.
+ 	* ada/acats-4/tests/a/a74105b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a74106a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a74106b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a74106c.ada: Likewise.
+ 	* ada/acats-4/tests/a/a74205e.ada: Likewise.
+ 	* ada/acats-4/tests/a/a74205f.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83009a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83009b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83a02a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83a02b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83a06a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83a08a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83c01c.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83c01h.ada: Likewise.
+ 	* ada/acats-4/tests/a/a83c01i.ada: Likewise.
+ 	* ada/acats-4/tests/a/a85007d.ada: Likewise.
+ 	* ada/acats-4/tests/a/a85013b.ada: Likewise.
+ 	* ada/acats-4/tests/a/a87b59a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a95001c.ada: Likewise.
+ 	* ada/acats-4/tests/a/a95074d.ada: Likewise.
+ 	* ada/acats-4/tests/a/a97106a.ada: Likewise.
+ 	* ada/acats-4/tests/a/a99006a.ada: Likewise.
+ 	* ada/acats-4/tests/a/aa2010a.ada: Likewise.
+ 	* ada/acats-4/tests/a/aa2012a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ac1015b.ada: Likewise.
+ 	* ada/acats-4/tests/a/ac3106a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ac3206a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ac3207a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7001b.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7001c0.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7001c1.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7001d0.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7001d1.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7006a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7101a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7101c.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7102a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7103a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7103c.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7104a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7201a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7203b.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad7205b.ada: Likewise.
+ 	* ada/acats-4/tests/a/ad8011a.tst: Likewise.
+ 	* ada/acats-4/tests/a/ada101a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ae2113a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ae2113b.ada: Likewise.
+ 	* ada/acats-4/tests/a/ae3002g.ada: Likewise.
+ 	* ada/acats-4/tests/a/ae3101a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ae3702a.ada: Likewise.
+ 	* ada/acats-4/tests/a/ae3709a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23001a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23003a.tst: Likewise.
+ 	* ada/acats-4/tests/c2/c23003b.tst: Likewise.
+ 	* ada/acats-4/tests/c2/c23003g.tst: Likewise.
+ 	* ada/acats-4/tests/c2/c23003i.tst: Likewise.
+ 	* ada/acats-4/tests/c2/c23006a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23006b.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23006c.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23006d.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23006e.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23006f.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c23006g.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24002d.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24003a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24003b.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24003c.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24106a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24202d.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24203a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24203b.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24207a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c24211a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c250001.au: Likewise.
+ 	* ada/acats-4/tests/c2/c250002.au: Likewise.
+ 	* ada/acats-4/tests/c2/c25001a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c25001b.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c26006a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c26008a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c2a001a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c2a001b.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c2a001c.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c2a002a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c2a008a.ada: Likewise.
+ 	* ada/acats-4/tests/c2/c2a021b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32001a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32001b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32001c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32001d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32001e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32107a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32107c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32108a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32108b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32111a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32111b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32112b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32113a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32115a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c32115b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c324001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c324002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c324003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c324004.a: Likewise.
+ 	* ada/acats-4/tests/c3/c324005.a: Likewise.
+ 	* ada/acats-4/tests/c3/c324006.a: Likewise.
+ 	* ada/acats-4/tests/c3/c330001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c330002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c332001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c340001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c34001a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34001c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34001d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34001f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34002a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34002c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34003a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34003c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34004a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34004c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005i.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005m.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005o.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005p.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005r.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005s.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005u.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34005v.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34006a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34006d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34006f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34006g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34006j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34006l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007i.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007m.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007p.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007r.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007s.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007u.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34007v.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34008a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34009a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34009d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34009f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34009g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34009j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34009l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34011b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34012a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014n.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014p.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014r.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014t.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34014u.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c34018a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c340a01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c340a02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c341a01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c341a02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c341a03.a: Likewise.
+ 	* ada/acats-4/tests/c3/c341a04.a: Likewise.
+ 	* ada/acats-4/tests/c3/c350001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c35003a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35003b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35003d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c350a01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c350a02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c350b01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c350b02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c35102a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c352001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c354002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c354003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c354004.a: Likewise.
+ 	* ada/acats-4/tests/c3/c35502a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502d.tst: Likewise.
+ 	* ada/acats-4/tests/c3/c35502e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502f.tst: Likewise.
+ 	* ada/acats-4/tests/c3/c35502g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502i.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502k.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502m.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502n.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502o.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35502p.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503d.tst: Likewise.
+ 	* ada/acats-4/tests/c3/c35503e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503f.tst: Likewise.
+ 	* ada/acats-4/tests/c3/c35503g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503k.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503o.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35503p.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35504a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35504b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35505c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35505e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35505f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507i.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507k.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507m.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507n.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507o.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35507p.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508k.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508o.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35508p.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35703a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35704a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35704b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35704c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35704d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35801d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35902d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35904a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35904b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c35a02a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a05a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a05d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a05n.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a05q.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a07a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a07d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c35a08b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c360002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c360a01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c360a02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c360b01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c360b02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c36104a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36104b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36172a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36172b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36172c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36174a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36180a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36202c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36203a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36204a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36204b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36204c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36204d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205i.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205k.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36205l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36301a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36301b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36302a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36304a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c36305a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37002a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37003a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37003b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37005a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37006a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37008a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37008b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37009a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37010a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37010b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c371001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c371002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c371003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c37102b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37103a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37105a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37107a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37108b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37206a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37207a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37208a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37208b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37209a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37209b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37210a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37211a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37211b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37211c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37211d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37211e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37213b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37213d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37213f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37213h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37213j.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37213k.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37213l.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37215b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37215d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37215f.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37215h.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37217a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37217b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37217c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37304a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37305a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37306a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37309a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37310a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37312a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37402a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37403a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37404a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37404b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37405a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c37411a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c380001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c380002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c380003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c380004.a: Likewise.
+ 	* ada/acats-4/tests/c3/c38002a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38002b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38005a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38005b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38005c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38102a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38102b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38102c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38102d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38102e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38104a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38107a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38107b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38108a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38108b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38108c0.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38108c1.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38108c2.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38108d0.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c38108d1.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c3900010.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900011.am: Likewise.
+ 	* ada/acats-4/tests/c3/c390002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390004.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900050.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900051.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900052.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900053.am: Likewise.
+ 	* ada/acats-4/tests/c3/c3900060.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900061.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900062.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3900063.am: Likewise.
+ 	* ada/acats-4/tests/c3/c390007.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390010.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390011.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390012.a: Likewise.
+ 	* ada/acats-4/tests/c3/c39006a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006c0.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006c1.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006d.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006e.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006f0.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006f1.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006f2.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006f3.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39006g.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39007a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39007b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39008a.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39008b.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c39008c.ada: Likewise.
+ 	* ada/acats-4/tests/c3/c390a010.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390a011.am: Likewise.
+ 	* ada/acats-4/tests/c3/c390a020.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390a021.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390a022.am: Likewise.
+ 	* ada/acats-4/tests/c3/c390a030.a: Likewise.
+ 	* ada/acats-4/tests/c3/c390a031.am: Likewise.
+ 	* ada/acats-4/tests/c3/c391001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c391002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c391003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392004.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392005.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392008.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392010.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392011.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392013.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392014.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392015.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392a01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392c05.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392c07.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392d01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392d02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c392d03.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393007.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393008.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393009.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393010.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393011.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393012.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393013.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393a02.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393a03.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393a05.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393a06.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393b12.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393b13.a: Likewise.
+ 	* ada/acats-4/tests/c3/c393b14.a: Likewise.
+ 	* ada/acats-4/tests/c3/c394001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c394002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c394003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0004.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0005.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0006.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0007.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0008.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0009.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0010.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0011.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a00120.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a00121.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a00122.am: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0013.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0014.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0015.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0016.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0017.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0018.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0019.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0020.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0021.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0022.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0023.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0024.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0025.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0026.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0027.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0028.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0029.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a0030.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a1001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a1002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a10030.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a10031.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a10032.am: Likewise.
+ 	* ada/acats-4/tests/c3/c3a10040.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a10041.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a10042.am: Likewise.
+ 	* ada/acats-4/tests/c3/c3a1005.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a2001.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a2002.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a2003.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a2004.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a2a01.a: Likewise.
+ 	* ada/acats-4/tests/c3/c3a2a02.a: Likewise.
+ 	* ada/acats-4/tests/c4/c410001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c41101d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41103a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41103b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41104a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41105a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41107a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41201d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41203a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41203b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41204a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41205a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41206a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41207a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c413001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c413002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c413003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c413004.a: Likewise.
+ 	* ada/acats-4/tests/c4/c413005.a: Likewise.
+ 	* ada/acats-4/tests/c4/c413006.a: Likewise.
+ 	* ada/acats-4/tests/c4/c413007.a: Likewise.
+ 	* ada/acats-4/tests/c4/c41301a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303g.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303i.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303j.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303k.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303m.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303n.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303o.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303q.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303r.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303s.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303u.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303v.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41303w.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41304a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41304b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41306b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41306c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41307d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41309a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41320a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41321a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41322a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41323a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41324a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41325a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41326a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41327a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41328a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41401a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41402a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c41404a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c416a01.a: Likewise.
+ 	* ada/acats-4/tests/c4/c416a02.a: Likewise.
+ 	* ada/acats-4/tests/c4/c420001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c42006a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c42007e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43003a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43004a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43004c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c431001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c431002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c431003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c431004.a: Likewise.
+ 	* ada/acats-4/tests/c4/c43103a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43103b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43104a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43105a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43105b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43106a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43107a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43108a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c431a01.a: Likewise.
+ 	* ada/acats-4/tests/c4/c431a02.a: Likewise.
+ 	* ada/acats-4/tests/c4/c431a03.a: Likewise.
+ 	* ada/acats-4/tests/c4/c432001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c432002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c432003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c432004.a: Likewise.
+ 	* ada/acats-4/tests/c4/c432005.a: Likewise.
+ 	* ada/acats-4/tests/c4/c43204a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43204c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43204e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43204f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43204g.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43204h.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43204i.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205g.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205h.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205i.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205j.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43205k.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43206a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43207b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43207d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43208a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43208b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43209a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43210a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43211a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43212a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43212c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43214a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43214b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43214c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43214d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43214e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43214f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43215a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43215b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43222a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c43224a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c433001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433004.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433005.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433006.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433007.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433008.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433a01.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433a02.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433a03.a: Likewise.
+ 	* ada/acats-4/tests/c4/c433a04.a: Likewise.
+ 	* ada/acats-4/tests/c4/c44003d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c44003f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c44003g.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c450001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c45112a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45112b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45113a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45114b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c452001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c452002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c452003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c452004.a: Likewise.
+ 	* ada/acats-4/tests/c4/c452005.a: Likewise.
+ 	* ada/acats-4/tests/c4/c452006.a: Likewise.
+ 	* ada/acats-4/tests/c4/c45201a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45201b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45202b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45210a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45211a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45220a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45220b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45220c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45220d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45220e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45220f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45231a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45231b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45231c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45231d.tst: Likewise.
+ 	* ada/acats-4/tests/c4/c45232b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45242b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45251a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45252a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45252b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45253a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45262a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45262b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45262c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45262d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45264a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45264b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45264c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45265a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45271a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45272a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45273a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45274a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45274b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45274c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45281a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45282a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45282b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45291a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c452a01.a: Likewise.
+ 	* ada/acats-4/tests/c4/c452a02.a: Likewise.
+ 	* ada/acats-4/tests/c4/c452a03.a: Likewise.
+ 	* ada/acats-4/tests/c4/c453001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c45303a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45304a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45304b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45304c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45322a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45323a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45331a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45342a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45343a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45344a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45345b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45347a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45347b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45347c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45347d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45411a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45411b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45411c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45411d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45413a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45431a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c455001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c45502b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45502c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45503a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45503b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45503c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45504a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45504b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45504c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45504d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45504e.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45504f.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45505a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45523a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531g.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531h.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531i.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531j.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531k.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531l.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45531m.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45531n.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45531o.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45531p.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45532a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532g.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532h.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532i.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532j.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532k.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532l.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45532m.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45532n.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45532o.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45532p.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45534b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45536a.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c456001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c45611a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45611b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45611c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45613a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45613b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45613c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45614a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45614b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45614c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45631a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45631b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45631c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45632a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45632b.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45632c.dep: Likewise.
+ 	* ada/acats-4/tests/c4/c45651a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45662a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45662b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c45672a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c457001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c457002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c457003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c457004.a: Likewise.
+ 	* ada/acats-4/tests/c4/c457005.a: Likewise.
+ 	* ada/acats-4/tests/c4/c457006.a: Likewise.
+ 	* ada/acats-4/tests/c4/c457007.a: Likewise.
+ 	* ada/acats-4/tests/c4/c458001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c458002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c458003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c458a01.a: Likewise.
+ 	* ada/acats-4/tests/c4/c458a02.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460004.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460005.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460006.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460007.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460008.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460009.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460010.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460011.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460012.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460013.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460014.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460015.a: Likewise.
+ 	* ada/acats-4/tests/c4/c46011a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46013a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46014a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46021a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46024a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46031a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46032a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46033a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46041a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46042a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46043b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46044b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46051a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46051b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46051c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46052a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46053a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c46054a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c460a01.a: Likewise.
+ 	* ada/acats-4/tests/c4/c460a02.a: Likewise.
+ 	* ada/acats-4/tests/c4/c470001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c47002a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47002b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47002c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47002d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47003a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47004a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47005a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47006a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47007a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47008a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47009a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c47009b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c480001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c48004a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48004b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48004c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48004d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48004e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48004f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48005a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48005b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48006a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48006b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48007a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48007b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48007c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48008a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48008c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009d.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009e.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009f.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009g.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009h.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009i.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48009j.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48010a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48011a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c48012a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c490001.a: Likewise.
+ 	* ada/acats-4/tests/c4/c490002.a: Likewise.
+ 	* ada/acats-4/tests/c4/c490003.a: Likewise.
+ 	* ada/acats-4/tests/c4/c49020a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49021a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49022a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49022b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49022c.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49023a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49024a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49025a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c49026a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a005b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a006a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a007a.tst: Likewise.
+ 	* ada/acats-4/tests/c4/c4a010a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a010b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a011a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a012b.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a013a.ada: Likewise.
+ 	* ada/acats-4/tests/c4/c4a014a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c51004a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52005a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52005b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52005c.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52005d.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52005e.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52005f.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52008a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52008b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52009a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52009b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52010a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52011a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52011b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52101a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52102a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52102b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52102c.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52102d.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103c.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103f.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103g.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103h.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103k.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103l.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103m.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103p.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103q.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103r.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52103x.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104c.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104f.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104g.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104h.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104k.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104l.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104m.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104p.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104q.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104r.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104x.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c52104y.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c53007a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c540001.a: Likewise.
+ 	* ada/acats-4/tests/c5/c540002.a: Likewise.
+ 	* ada/acats-4/tests/c5/c540003.a: Likewise.
+ 	* ada/acats-4/tests/c5/c54a03a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a04a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a07a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a13a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a13b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a13c.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a13d.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a22a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a23a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a24a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a24b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a42a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a42b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a42c.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a42d.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a42e.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a42f.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c54a42g.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c550001.a: Likewise.
+ 	* ada/acats-4/tests/c5/c552001.a: Likewise.
+ 	* ada/acats-4/tests/c5/c552002.a: Likewise.
+ 	* ada/acats-4/tests/c5/c552a01.a: Likewise.
+ 	* ada/acats-4/tests/c5/c552a02.a: Likewise.
+ 	* ada/acats-4/tests/c5/c55b03a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b04a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b05a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b06a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b06b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b07a.dep: Likewise.
+ 	* ada/acats-4/tests/c5/c55b07b.dep: Likewise.
+ 	* ada/acats-4/tests/c5/c55b10a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b11a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b11b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b15a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55b16a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55c02a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c55c02b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c56002a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c57003a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c57004a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c57004b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58004c.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58004d.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58004g.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58005a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58005b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58005h.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58006a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c58006b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c59002a.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c59002b.ada: Likewise.
+ 	* ada/acats-4/tests/c5/c59002c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c61008a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c61009a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c61010a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c611001.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a01.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a020.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a021.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a022.am: Likewise.
+ 	* ada/acats-4/tests/c6/c611a030.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a031.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a032.am: Likewise.
+ 	* ada/acats-4/tests/c6/c611a040.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a041.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a042.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611a043.am: Likewise.
+ 	* ada/acats-4/tests/c6/c611b010.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611b011.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611b012.am: Likewise.
+ 	* ada/acats-4/tests/c6/c611b020.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611b021.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611b022.am: Likewise.
+ 	* ada/acats-4/tests/c6/c611b030.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611b031.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611b032.a: Likewise.
+ 	* ada/acats-4/tests/c6/c611b033.am: Likewise.
+ 	* ada/acats-4/tests/c6/c620001.a: Likewise.
+ 	* ada/acats-4/tests/c6/c620002.a: Likewise.
+ 	* ada/acats-4/tests/c6/c62002a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c62003b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c62004a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c62006a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c631001.a: Likewise.
+ 	* ada/acats-4/tests/c6/c640001.a: Likewise.
+ 	* ada/acats-4/tests/c6/c640002.a: Likewise.
+ 	* ada/acats-4/tests/c6/c64002b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64004g.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64005a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64005b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64005c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64005d0.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64005da.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64005db.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64005dc.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c641001.a: Likewise.
+ 	* ada/acats-4/tests/c6/c641002.a: Likewise.
+ 	* ada/acats-4/tests/c6/c641003.a: Likewise.
+ 	* ada/acats-4/tests/c6/c64103b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64103c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64103d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64103e.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64103f.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104e.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104f.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104g.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104h.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104i.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104j.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104k.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104l.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104m.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104n.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64104o.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64105a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64105b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64105c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64105d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64106a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64106b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64106c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64106d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64107a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64108a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109e.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109f.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109g.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109h.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109i.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109j.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109k.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64109l.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64201b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64201c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c64202a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c650002.a: Likewise.
+ 	* ada/acats-4/tests/c6/c650003.a: Likewise.
+ 	* ada/acats-4/tests/c6/c65003a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c65003b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c650a01.a: Likewise.
+ 	* ada/acats-4/tests/c6/c650a02.a: Likewise.
+ 	* ada/acats-4/tests/c6/c650b01.a: Likewise.
+ 	* ada/acats-4/tests/c6/c650b02.a: Likewise.
+ 	* ada/acats-4/tests/c6/c650b03.a: Likewise.
+ 	* ada/acats-4/tests/c6/c650b04.a: Likewise.
+ 	* ada/acats-4/tests/c6/c651001.a: Likewise.
+ 	* ada/acats-4/tests/c6/c651002.a: Likewise.
+ 	* ada/acats-4/tests/c6/c660001.a: Likewise.
+ 	* ada/acats-4/tests/c6/c66002a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c66002c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c66002d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c66002e.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c66002f.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c66002g.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67002a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67002b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67002c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67002d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67002e.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67003f.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67005a.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67005b.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67005c.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c67005d.ada: Likewise.
+ 	* ada/acats-4/tests/c6/c680001.a: Likewise.
+ 	* ada/acats-4/tests/c7/c72001b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c72002a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c730001.a: Likewise.
+ 	* ada/acats-4/tests/c7/c730002.a: Likewise.
+ 	* ada/acats-4/tests/c7/c730003.a: Likewise.
+ 	* ada/acats-4/tests/c7/c730004.a: Likewise.
+ 	* ada/acats-4/tests/c7/c73002a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c730a01.a: Likewise.
+ 	* ada/acats-4/tests/c7/c730a02.a: Likewise.
+ 	* ada/acats-4/tests/c7/c731001.a: Likewise.
+ 	* ada/acats-4/tests/c7/c7320010.a: Likewise.
+ 	* ada/acats-4/tests/c7/c7320011.a: Likewise.
+ 	* ada/acats-4/tests/c7/c7320012.am: Likewise.
+ 	* ada/acats-4/tests/c7/c732002.a: Likewise.
+ 	* ada/acats-4/tests/c7/c732a01.a: Likewise.
+ 	* ada/acats-4/tests/c7/c732a02.a: Likewise.
+ 	* ada/acats-4/tests/c7/c732b01.a: Likewise.
+ 	* ada/acats-4/tests/c7/c732b02.a: Likewise.
+ 	* ada/acats-4/tests/c7/c732c01.a: Likewise.
+ 	* ada/acats-4/tests/c7/c74004a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74203a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74206a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74207b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74208a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74208b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74209a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74210a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74211a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74211b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74302a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74302b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74305a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74305b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74306a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74307a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74401d.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74401e.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74401k.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74401q.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74402a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74402b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74406a.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74407b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c74409b.ada: Likewise.
+ 	* ada/acats-4/tests/c7/c760001.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760002.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760007.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760009.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760010.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760011.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760012.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760013.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760014.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760015.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760a01.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760a02.a: Likewise.
+ 	* ada/acats-4/tests/c7/c760a03.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761001.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761002.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761003.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761004.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761005.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761006.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761007.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761010.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761011.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761012.a: Likewise.
+ 	* ada/acats-4/tests/c7/c761013.a: Likewise.
+ 	* ada/acats-4/tests/c8/c83007a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83012d.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83022a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83022g0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83022g1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83023a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83024a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83024e0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83024e1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83025a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83025c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83027a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83027c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83028a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83029a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83030a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83030c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83031a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83031c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83031e.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83032a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83033a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83051a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c831001.a: Likewise.
+ 	* ada/acats-4/tests/c8/c83b02a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83b02b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83e02a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83e02b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83e03a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f01a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f01b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f01c0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f01c1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f01c2.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f01d0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f01d1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f03a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f03b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f03c0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f03c1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f03c2.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f03d0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c83f03d1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c840001.a: Likewise.
+ 	* ada/acats-4/tests/c8/c840002.a: Likewise.
+ 	* ada/acats-4/tests/c8/c84002a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c84005a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c84008a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c84009a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85004b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85005a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85005b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85005c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85005d.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85005e.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85005f.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85005g.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85006a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85006b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85006c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85006d.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85006e.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85006f.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85006g.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85007a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85007e.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85009a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85011a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85013a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85014a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85014b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85014c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85017a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85018a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85018b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c85019a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c851001.a: Likewise.
+ 	* ada/acats-4/tests/c8/c851002.a: Likewise.
+ 	* ada/acats-4/tests/c8/c854001.a: Likewise.
+ 	* ada/acats-4/tests/c8/c854002.a: Likewise.
+ 	* ada/acats-4/tests/c8/c854003.a: Likewise.
+ 	* ada/acats-4/tests/c8/c86003a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86004a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86004b0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86004b1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86004b2.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86004c0.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86004c1.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86004c2.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86006i.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c86007a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87a05a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87a05b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b02a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b02b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b03a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b04a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b04b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b04c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b05a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b06a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b07a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b07b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b07c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b07d.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b07e.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b08a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b09a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b09c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b10a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b11a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b11b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b13a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b14a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b14b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b14c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b14d.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b15a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b16a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b17a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b18a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b18b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b19a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b23a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b24a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b24b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b26b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b27a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b28a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b29a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b30a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b31a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b32a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b33a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b34a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b34b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b34c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b35c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b38a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b39a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b40a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b41a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b42a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b43a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b44a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b45a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b45c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b47a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b48a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b48b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b50a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b54a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b57a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b62a.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b62b.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b62c.ada: Likewise.
+ 	* ada/acats-4/tests/c8/c87b62d.tst: Likewise.
+ 	* ada/acats-4/tests/c9/c910001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c910002.a: Likewise.
+ 	* ada/acats-4/tests/c9/c910003.a: Likewise.
+ 	* ada/acats-4/tests/c9/c91004b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c91004c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c91006a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c91007a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c920001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c92002a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c92003a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c92005a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c92005b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c92006a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c930001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c93001a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93002a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93003a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93004a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93004b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93004c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93004d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93004f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005g.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93005h.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93006a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93007a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93008a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c93008b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c940001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940002.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940004.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940005.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940006.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940007.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940010.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940011.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940012.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940013.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940014.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940015.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940016.a: Likewise.
+ 	* ada/acats-4/tests/c9/c940017.a: Likewise.
+ 	* ada/acats-4/tests/c9/c94001a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94001b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94001c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94001e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94001f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94001g.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94002a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94002b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94002d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94002e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94002f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94002g.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94004a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94004b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94004c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94005a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94005b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94006a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94007a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94007b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94008a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94008b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94008c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94008d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94010a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94011a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c94020a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c940a03.a: Likewise.
+ 	* ada/acats-4/tests/c9/c950001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c95008a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95009a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95010a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95011a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95012a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95021a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95022a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95022b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95033a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95033b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95034a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95034b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95035a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95040a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95040b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95040c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95040d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95041a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95065a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95065b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95065c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95065d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95065e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95065f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95066a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95067a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95071a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95072b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95073a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95074c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95076a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95078a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95080b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95082g.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085g.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085h.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085i.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085j.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085k.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085l.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085m.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085n.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95085o.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95086a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95086b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95086c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95086d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95086e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95086f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95087a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95087b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95087c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95087d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95088a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95089a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95090a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95092a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95093a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95095a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95095b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95095c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95095d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c95095e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c951001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c951002.a: Likewise.
+ 	* ada/acats-4/tests/c9/c953001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c953002.a: Likewise.
+ 	* ada/acats-4/tests/c9/c953003.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954010.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954011.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954012.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954013.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954014.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954015.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954016.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954017.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954018.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954019.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954020.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954021.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954022.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954023.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954024.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954025.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954026.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954027.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954a01.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954a02.a: Likewise.
+ 	* ada/acats-4/tests/c9/c954a03.a: Likewise.
+ 	* ada/acats-4/tests/c9/c960001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c960002.a: Likewise.
+ 	* ada/acats-4/tests/c9/c960004.a: Likewise.
+ 	* ada/acats-4/tests/c9/c96001a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96004a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96005a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96005b.tst: Likewise.
+ 	* ada/acats-4/tests/c9/c96005d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96005f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96006a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96007a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96008a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c96008b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c961001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c97112a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97113a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97114a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97115a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97116a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97117a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97117b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97117c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97118a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97120a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97120b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201g.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201h.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97201x.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97202a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97203a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97203b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97203c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97204a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97204b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97205a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97205b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97301a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97301b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97301c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97301d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97301e.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97302a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97303a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97303b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97303c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97304a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97304b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97305a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97305b.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97305c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97305d.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c97307a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c974001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974002.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974003.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974004.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974005.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974006.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974007.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974008.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974009.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974010.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974011.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974012.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974013.a: Likewise.
+ 	* ada/acats-4/tests/c9/c974014.a: Likewise.
+ 	* ada/acats-4/tests/c9/c980001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c980002.a: Likewise.
+ 	* ada/acats-4/tests/c9/c980003.a: Likewise.
+ 	* ada/acats-4/tests/c9/c990001.a: Likewise.
+ 	* ada/acats-4/tests/c9/c99005a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a003a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a004a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a007a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a009a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a009c.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a009f.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a009g.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a009h.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a010a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a011a.ada: Likewise.
+ 	* ada/acats-4/tests/c9/c9a011b.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1003a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1004a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1005a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1006a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1011a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1011a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1011a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1011a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1011a4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1011a5.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1011a6.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012a4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012b0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012b2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1012b4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1013a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1013a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1013a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1013a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1013a4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1013a5.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1013a6.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1014a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1014a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1014a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1014a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1020e0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1020e1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1020e2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1020e3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1022a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1022a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1022a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1022a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1022a4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1022a5.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1022a6.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca11001.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11002.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11003.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca110040.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca110041.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca110042.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca110050.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca110051.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca11006.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11007.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11008.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11009.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11010.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11011.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11012.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11013.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11014.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11015.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11016.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11017.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11018.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11019.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11020.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11021.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11022.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca110230.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca110231.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca110232.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca1102a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1102a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1102a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1106a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1108a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca1108b.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca11a01.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11a02.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11b01.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11b02.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11c01.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11c02.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11c03.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11d010.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11d011.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11d012.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11d013.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca11d02.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca11d03.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca120010.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca120011.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca120012.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca12002.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca13001.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca13002.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca13003.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca13a01.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca13a02.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca140230.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca140231.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca140232.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca140233.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca140280.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca140281.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca140282.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca140283.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca15003.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca200020.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca200021.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca200022.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca200030.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca200031.am: Likewise.
+ 	* ada/acats-4/tests/ca/ca2001h0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2001h1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2001h2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2001h3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2002a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2002a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2002a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2003a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2003a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2004a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2004a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2004a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2004a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2004a4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2007a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2007a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2007a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2007a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2008a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2008a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2008a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2009a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2009c0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2009c1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2009d.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2009f0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2009f1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2009f2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca2011b.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca21001.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca21002.a: Likewise.
+ 	* ada/acats-4/tests/ca/ca3011a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca3011a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca3011a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca3011a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca3011a4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003a0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003a1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003a2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003a3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003a4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003a5.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003a6.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003b0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003b1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003b2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003b3.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003b4.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5003b5.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5004a.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5004b0.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5004b1.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5004b2.ada: Likewise.
+ 	* ada/acats-4/tests/ca/ca5006a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb10002.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb1001a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb1004a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb1005a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb1010a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb1010c.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb1010d.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb20001.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb20003.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb20004.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb20005.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb20006.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb20007.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb2004a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb2005a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb2006a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb2007a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb20a02.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb30001.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb30002.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb3003a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb3003b.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb3004a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb40005.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb4001a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4002a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4003a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4004a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4005a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4006a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4007a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4008a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4009a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb4013a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb40a01.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb40a020.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb40a021.am: Likewise.
+ 	* ada/acats-4/tests/cb/cb40a030.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb40a031.am: Likewise.
+ 	* ada/acats-4/tests/cb/cb40a04.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb41001.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb41002.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb41003.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb41004.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb42001.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb42002.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb42003.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb50001.a: Likewise.
+ 	* ada/acats-4/tests/cb/cb5001a.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb5001b.ada: Likewise.
+ 	* ada/acats-4/tests/cb/cb5002a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1004a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1005b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1010a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1010b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1018a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1104c.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1107b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1111a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1204a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1207b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1220a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1221a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1221b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1221c.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1221d.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1222a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1223a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1224a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1225a.tst: Likewise.
+ 	* ada/acats-4/tests/cc/cc1226b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1227a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1301a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1302a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1304a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1304b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1307a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1307b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1308a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1310a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1311a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc1311b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc2002a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc30001.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc30002.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc30003.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc30004.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc3004a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3007a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3007b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3011a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3011d.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3012a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3015a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3016b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3016c.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3016f.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3016i.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3017b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3019a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3019b0.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3019b1.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3019b2.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3019c0.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3019c1.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3019c2.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3106b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3120a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3120b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3121a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3123a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3125a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3125b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3125c.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3125d.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3126a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3127a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3128a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3203a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3207b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3220a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3221a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3222a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3223a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3224a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3225a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3230a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3231a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3232a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3233a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3234a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3235a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3236a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3240a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3305a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3305b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3305c.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3305d.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3601a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3601c.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3602a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3603a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3605a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3606a.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3606b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc3607b.ada: Likewise.
+ 	* ada/acats-4/tests/cc/cc40001.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc50001.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc50a01.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc50a02.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51001.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51002.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51003.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51004.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51006.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51007.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51008.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51009.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc510100.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc510101.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc510102.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc510103.am: Likewise.
+ 	* ada/acats-4/tests/cc/cc51011.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51a01.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51b03.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51d01.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc51d02.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc54001.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc54002.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc54003.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc54004.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc60001.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70001.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70002.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70003.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70a01.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70a02.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70b01.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70b02.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70c01.a: Likewise.
+ 	* ada/acats-4/tests/cc/cc70c02.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd10001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd10002.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009f.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009h.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009j.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009k.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009n.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009o.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009p.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009q.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009r.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009s.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009t.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009u.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009v.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009w.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009x.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009y.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1009z.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd11001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03e.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03f.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03h.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c03i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c04a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c04d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c04e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd1c06a.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd20001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a21a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a21e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a22a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a22e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a22i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a22j.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a23a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a23e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a24a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a24e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a24i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a24j.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a31a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a31e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a32a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a32c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a32e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a32g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a32i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a32j.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a51a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a53a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a53e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a83c.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd2a91c.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd2b11b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2b11d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2b11e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2b11f.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2b16a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2c11a.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd2c11d.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd2d11a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd2d13a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd30001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30002.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30003.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30004.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd300050.am: Likewise.
+ 	* ada/acats-4/tests/cd/cd300051.c: Likewise.
+ 	* ada/acats-4/tests/cd/cd30006.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30007.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30008.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30009.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30010.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30011.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30012.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30013.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd30014.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd3014a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3014c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3014d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3014f.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015f.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015h.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3015k.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd3021a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd40001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd4031a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd4041a.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd4051a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd4051b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd4051c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd4051d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003f.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003h.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5003i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011k.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011m.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011q.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5011s.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5012a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5012b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5012e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5012f.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5012i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5012m.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013k.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013m.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5013o.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014g.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014i.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014k.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014m.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014o.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014t.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014v.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014x.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014y.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd5014z.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd70001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd7002a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd7007b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd7101d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd7101e.dep: Likewise.
+ 	* ada/acats-4/tests/cd/cd7101f.dep: Likewise.
+ 	* ada/acats-4/tests/cd/cd7101g.tst: Likewise.
+ 	* ada/acats-4/tests/cd/cd7103d.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd7202a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd7204b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd7204c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd72a01.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd72a02.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd7305a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cd90001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cd92001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cda201a.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cda201b.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cda201c.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cda201e.ada: Likewise.
+ 	* ada/acats-4/tests/cd/cdb0001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdb0002.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdb0a01.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdb0a02.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdb3a01.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdb4001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd1001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2a01.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2a02.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2a03.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2b01.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2b02.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2b03.a: Likewise.
+ 	* ada/acats-4/tests/cd/cdd2b04.a: Likewise.
+ 	* ada/acats-4/tests/cd/cde0001.a: Likewise.
+ 	* ada/acats-4/tests/cd/cde0002.a: Likewise.
+ 	* ada/acats-4/tests/cd/cde0003.a: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102c.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102h.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102i.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102j.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102k.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102l.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102m.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102n.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102o.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102p.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102q.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102r.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102s.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102t.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102u.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102v.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102w.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102x.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2102y.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2103a.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce2103b.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce2103c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2103d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2104a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2104b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2104c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2104d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2106a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2106b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2108e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2108f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2108g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2108h.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2109a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2109b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2109c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2110a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2110c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2111a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2111b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2111c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2111e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2111f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2111g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2111i.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201d.dep: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201e.dep: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201h.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201i.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201j.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201k.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201l.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201m.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2201n.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2202a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2203a.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce2204a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2204b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2204c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2204d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2205a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2206a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2208b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401h.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401i.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401j.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401k.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2401l.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2402a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2403a.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce2404a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2404b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2405b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2406a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2407a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2407b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2408a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2408b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2409a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2409b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2410a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2410b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce2411a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3002b.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce3002c.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce3002d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3002f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102b.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102h.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102i.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102j.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3102k.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3103a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3104a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3104b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3104c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3106a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3106b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3107a.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce3107b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3108a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3108b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3110a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3112c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3112d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3114a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3115a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3201a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3202a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3206a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3207a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3301a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3302a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3303a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3304a.tst: Likewise.
+ 	* ada/acats-4/tests/ce/ce3305a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3306a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3401a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3402a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3402c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3402d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3402e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3403a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3403b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3403c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3403d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3403e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3403f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3404a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3404b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3404c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3404d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3405a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3405c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3405d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3406a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3406b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3406c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3406d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3407a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3407b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3407c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3408a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3408b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3408c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3409a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3409b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3409c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3409d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3409e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3410a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3410b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3410c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3410d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3410e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3411a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3411c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3412a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3413a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3413b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3413c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3414a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3601a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3602a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3602b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3602c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3602d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3603a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3604a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3604b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3605a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3605b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3605c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3605d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3605e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3606a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3606b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3701a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704m.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704n.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3704o.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3705a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3705b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3705c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3705d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3705e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3706c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3706d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3706f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3706g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3707a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3708a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3801a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3801b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804h.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804i.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804j.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804m.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804o.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3804p.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3805a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3805b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806g.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3806h.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3809a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3809b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3810a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3810b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3815a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3901a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3902b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3904a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3904b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3905a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3905b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3905c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3905l.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3906a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3906b.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3906c.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3906d.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3906e.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3906f.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3907a.ada: Likewise.
+ 	* ada/acats-4/tests/ce/ce3908a.ada: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3004.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3005.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3006.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3007.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa3008.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4004.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4005.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4006.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4007.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4008.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4009.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4010.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4011.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4012.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4013.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4014.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4015.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4016.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4017.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4018.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4019.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4020.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4021.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4022.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4023.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4024.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4025.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4026.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4027.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4028.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4029.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4030.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4031.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4032.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4033.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4035.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4036.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4037.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4038.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa4039.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5011.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5012.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5013.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5015.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5016.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a01.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a02.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a03.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a04.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a05.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a06.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a07.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a08.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a09.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa5a10.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa8001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa8002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa8003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa9001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxa9002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa004.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa005.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa006.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa007.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa008.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa009.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa010.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa011.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa012.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa013.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa014.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa015.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa016.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa017.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa018.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa019.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa020.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa021.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaa022.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxab001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxab002.au: Likewise.
+ 	* ada/acats-4/tests/cxa/cxab003.au: Likewise.
+ 	* ada/acats-4/tests/cxa/cxab004.au: Likewise.
+ 	* ada/acats-4/tests/cxa/cxab005.au: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac004.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac005.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac006.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac007.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac008.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxac009.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaca01.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaca02.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxacb01.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxacb02.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxacc01.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaf001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxag001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxag002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxag003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxah001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxah002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxah003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai001.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai002.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai003.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai004.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai005.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai006.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai007.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai008.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai009.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai010.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai011.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai012.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai013.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai014.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai015.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai016.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai017.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai018.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai019.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai020.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai021.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai022.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai023.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai024.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai025.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai026.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai027.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai028.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai029.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai030.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai031.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai032.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai033.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai034.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai035.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxai036.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia01.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia02.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia03.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia04.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia05.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia06.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia07.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia08.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia09.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia10.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia11.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia12.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia13.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaia14.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib01.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib02.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib03.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib04.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib05.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib06.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib07.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaib08.a: Likewise.
+ 	* ada/acats-4/tests/cxa/cxaj001.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb2001.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb2002.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb2003.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3001.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3002.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3003.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30040.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30041.am: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3005.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30060.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30061.am: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3007.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3008.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3009.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3010.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3011.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3012.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30130.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30131.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30132.am: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3014.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3015.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3016.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30170.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30171.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30172.am: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30180.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30181.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30182.am: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3019.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3020.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3021.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb3022.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30230.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30231.am: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30240.c: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb30241.am: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4001.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4002.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4003.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4004.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4005.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4006.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4007.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb4008.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb5001.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb5002.a: Likewise.
+ 	* ada/acats-4/tests/cxb/cxb5003.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf1001.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf2001.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf2002.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf2003.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf2004.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf2005.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf2a01.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf2a02.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3001.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3002.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3003.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3004.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a01.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a02.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a03.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a04.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a05.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a06.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a07.a: Likewise.
+ 	* ada/acats-4/tests/cxf/cxf3a08.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg1001.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg1002.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg1003.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg1004.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg1005.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2001.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2002.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2003.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2004.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2005.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2006.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2007.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2008.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2009.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2010.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2011.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2012.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2013.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2014.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2015.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2016.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2017.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2018.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2019.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2020.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2021.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2022.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2023.a: Likewise.
+ 	* ada/acats-4/tests/cxg/cxg2024.a: Likewise.
+ 	* ada/acats-4/tests/cxh/cxh3001.a: Likewise.
+ 	* ada/acats-4/tests/cxh/cxh3002.a: Likewise.
+ 	* ada/acats-4/tests/cxh/cxh30030.a: Likewise.
+ 	* ada/acats-4/tests/cxh/cxh30031.am: Likewise.
+ 	* ada/acats-4/tests/cz/cz1101a.ada: Likewise.
+ 	* ada/acats-4/tests/cz/cz1102a.ada: Likewise.
+ 	* ada/acats-4/tests/cz/cz1103a.ada: Likewise.
+ 	* ada/acats-4/tests/d/d4a002a.ada: Likewise.
+ 	* ada/acats-4/tests/d/d4a002b.ada: Likewise.
+ 	* ada/acats-4/tests/d/d4a004a.ada: Likewise.
+ 	* ada/acats-4/tests/d/d4a004b.ada: Likewise.
+ 	* ada/acats-4/tests/e/e28002b.ada: Likewise.
+ 	* ada/acats-4/tests/e/e28005d.ada: Likewise.
+ 	* ada/acats-4/tests/e/e52103y.ada: Likewise.
+ 	* ada/acats-4/tests/e/eb4011a.ada: Likewise.
+ 	* ada/acats-4/tests/e/eb4012a.ada: Likewise.
+ 	* ada/acats-4/tests/e/eb4014a.ada: Likewise.
+ 	* ada/acats-4/tests/e/ee3203a.ada: Likewise.
+ 	* ada/acats-4/tests/e/ee3204a.ada: Likewise.
+ 	* ada/acats-4/tests/e/ee3402b.ada: Likewise.
+ 	* ada/acats-4/tests/e/ee3409f.ada: Likewise.
+ 	* ada/acats-4/tests/e/ee3412c.ada: Likewise.
+ 	* ada/acats-4/tests/l/la140010.a: Likewise.
+ 	* ada/acats-4/tests/l/la140011.am: Likewise.
+ 	* ada/acats-4/tests/l/la140012.a: Likewise.
+ 	* ada/acats-4/tests/l/la140020.a: Likewise.
+ 	* ada/acats-4/tests/l/la140021.am: Likewise.
+ 	* ada/acats-4/tests/l/la140022.a: Likewise.
+ 	* ada/acats-4/tests/l/la140030.a: Likewise.
+ 	* ada/acats-4/tests/l/la140031.a: Likewise.
+ 	* ada/acats-4/tests/l/la140032.am: Likewise.
+ 	* ada/acats-4/tests/l/la140033.a: Likewise.
+ 	* ada/acats-4/tests/l/la140040.a: Likewise.
+ 	* ada/acats-4/tests/l/la140041.am: Likewise.
+ 	* ada/acats-4/tests/l/la140042.a: Likewise.
+ 	* ada/acats-4/tests/l/la140050.a: Likewise.
+ 	* ada/acats-4/tests/l/la140051.a: Likewise.
+ 	* ada/acats-4/tests/l/la140052.am: Likewise.
+ 	* ada/acats-4/tests/l/la140053.a: Likewise.
+ 	* ada/acats-4/tests/l/la140060.a: Likewise.
+ 	* ada/acats-4/tests/l/la140061.a: Likewise.
+ 	* ada/acats-4/tests/l/la140062.am: Likewise.
+ 	* ada/acats-4/tests/l/la140063.a: Likewise.
+ 	* ada/acats-4/tests/l/la140070.a: Likewise.
+ 	* ada/acats-4/tests/l/la140071.a: Likewise.
+ 	* ada/acats-4/tests/l/la140072.am: Likewise.
+ 	* ada/acats-4/tests/l/la140073.a: Likewise.
+ 	* ada/acats-4/tests/l/la140080.a: Likewise.
+ 	* ada/acats-4/tests/l/la140081.a: Likewise.
+ 	* ada/acats-4/tests/l/la140082.am: Likewise.
+ 	* ada/acats-4/tests/l/la140083.a: Likewise.
+ 	* ada/acats-4/tests/l/la140090.a: Likewise.
+ 	* ada/acats-4/tests/l/la140091.a: Likewise.
+ 	* ada/acats-4/tests/l/la140092.am: Likewise.
+ 	* ada/acats-4/tests/l/la140093.a: Likewise.
+ 	* ada/acats-4/tests/l/la140100.a: Likewise.
+ 	* ada/acats-4/tests/l/la140101.a: Likewise.
+ 	* ada/acats-4/tests/l/la140102.am: Likewise.
+ 	* ada/acats-4/tests/l/la140103.a: Likewise.
+ 	* ada/acats-4/tests/l/la140110.a: Likewise.
+ 	* ada/acats-4/tests/l/la140111.a: Likewise.
+ 	* ada/acats-4/tests/l/la140112.am: Likewise.
+ 	* ada/acats-4/tests/l/la140113.a: Likewise.
+ 	* ada/acats-4/tests/l/la140120.a: Likewise.
+ 	* ada/acats-4/tests/l/la140121.a: Likewise.
+ 	* ada/acats-4/tests/l/la140122.am: Likewise.
+ 	* ada/acats-4/tests/l/la140123.a: Likewise.
+ 	* ada/acats-4/tests/l/la140130.a: Likewise.
+ 	* ada/acats-4/tests/l/la140131.a: Likewise.
+ 	* ada/acats-4/tests/l/la140132.am: Likewise.
+ 	* ada/acats-4/tests/l/la140133.a: Likewise.
+ 	* ada/acats-4/tests/l/la140140.a: Likewise.
+ 	* ada/acats-4/tests/l/la140141.a: Likewise.
+ 	* ada/acats-4/tests/l/la140142.am: Likewise.
+ 	* ada/acats-4/tests/l/la140143.a: Likewise.
+ 	* ada/acats-4/tests/l/la140150.a: Likewise.
+ 	* ada/acats-4/tests/l/la140151.a: Likewise.
+ 	* ada/acats-4/tests/l/la140152.am: Likewise.
+ 	* ada/acats-4/tests/l/la140153.a: Likewise.
+ 	* ada/acats-4/tests/l/la140160.a: Likewise.
+ 	* ada/acats-4/tests/l/la140161.a: Likewise.
+ 	* ada/acats-4/tests/l/la140162.am: Likewise.
+ 	* ada/acats-4/tests/l/la140163.a: Likewise.
+ 	* ada/acats-4/tests/l/la140170.a: Likewise.
+ 	* ada/acats-4/tests/l/la140171.a: Likewise.
+ 	* ada/acats-4/tests/l/la140172.am: Likewise.
+ 	* ada/acats-4/tests/l/la140173.a: Likewise.
+ 	* ada/acats-4/tests/l/la140180.a: Likewise.
+ 	* ada/acats-4/tests/l/la140181.a: Likewise.
+ 	* ada/acats-4/tests/l/la140182.am: Likewise.
+ 	* ada/acats-4/tests/l/la140183.a: Likewise.
+ 	* ada/acats-4/tests/l/la140190.a: Likewise.
+ 	* ada/acats-4/tests/l/la140191.a: Likewise.
+ 	* ada/acats-4/tests/l/la140192.am: Likewise.
+ 	* ada/acats-4/tests/l/la140193.a: Likewise.
+ 	* ada/acats-4/tests/l/la140200.a: Likewise.
+ 	* ada/acats-4/tests/l/la140201.a: Likewise.
+ 	* ada/acats-4/tests/l/la140202.am: Likewise.
+ 	* ada/acats-4/tests/l/la140203.a: Likewise.
+ 	* ada/acats-4/tests/l/la140210.a: Likewise.
+ 	* ada/acats-4/tests/l/la140211.am: Likewise.
+ 	* ada/acats-4/tests/l/la140212.a: Likewise.
+ 	* ada/acats-4/tests/l/la140220.a: Likewise.
+ 	* ada/acats-4/tests/l/la140221.am: Likewise.
+ 	* ada/acats-4/tests/l/la140222.a: Likewise.
+ 	* ada/acats-4/tests/l/la140240.a: Likewise.
+ 	* ada/acats-4/tests/l/la140241.a: Likewise.
+ 	* ada/acats-4/tests/l/la140242.am: Likewise.
+ 	* ada/acats-4/tests/l/la140243.a: Likewise.
+ 	* ada/acats-4/tests/l/la140250.a: Likewise.
+ 	* ada/acats-4/tests/l/la140251.am: Likewise.
+ 	* ada/acats-4/tests/l/la140252.a: Likewise.
+ 	* ada/acats-4/tests/l/la140260.a: Likewise.
+ 	* ada/acats-4/tests/l/la140261.a: Likewise.
+ 	* ada/acats-4/tests/l/la140262.am: Likewise.
+ 	* ada/acats-4/tests/l/la140263.a: Likewise.
+ 	* ada/acats-4/tests/l/la140270.a: Likewise.
+ 	* ada/acats-4/tests/l/la140271.a: Likewise.
+ 	* ada/acats-4/tests/l/la140272.am: Likewise.
+ 	* ada/acats-4/tests/l/la140273.a: Likewise.
+ 
+ 2025-05-24  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* ada/acats-3/elabd.lst: New file.
+ 	* ada/acats-3/floatstore.lst: Likewise.
+ 	* ada/acats-3/norun.lst: Likewise.
+ 	* ada/acats-3/run_acats.sh: Likewise.
+ 	* ada/acats-3/run_all.sh: Likewise.
+ 	* ada/acats-3/run_test.exp: Likewise.
+ 	* ada/acats-3/stackcheck.lst: Likewise.
+ 	* ada/acats-3/support/acats31.lst: Likewise.
+ 	* ada/acats-3/support/checkfil.ada: Likewise.
+ 	* ada/acats-3/support/enumchek.ada: Likewise.
+ 	* ada/acats-3/support/f340a000.a: Likewise.
+ 	* ada/acats-3/support/f340a001.a: Likewise.
+ 	* ada/acats-3/support/f341a00.a: Likewise.
+ 	* ada/acats-3/support/f390a00.a: Likewise.
+ 	* ada/acats-3/support/f392a00.a: Likewise.
+ 	* ada/acats-3/support/f392c00.a: Likewise.
+ 	* ada/acats-3/support/f392d00.a: Likewise.
+ 	* ada/acats-3/support/f393a00.a: Likewise.
+ 	* ada/acats-3/support/f393b00.a: Likewise.
+ 	* ada/acats-3/support/f394a00.a: Likewise.
+ 	* ada/acats-3/support/f3a1a00.a: Likewise.
+ 	* ada/acats-3/support/f3a2a00.a: Likewise.
+ 	* ada/acats-3/support/f431a00.a: Likewise.
+ 	* ada/acats-3/support/f433a00.a: Likewise.
+ 	* ada/acats-3/support/f452a00.a: Likewise.
+ 	* ada/acats-3/support/f460a00.a: Likewise.
+ 	* ada/acats-3/support/f650a00.a: Likewise.
+ 	* ada/acats-3/support/f730a000.a: Likewise.
+ 	* ada/acats-3/support/f730a001.a: Likewise.
+ 	* ada/acats-3/support/f731a00.a: Likewise.
+ 	* ada/acats-3/support/f750a00.a: Likewise.
+ 	* ada/acats-3/support/f750b00.a: Likewise.
+ 	* ada/acats-3/support/f760a00.a: Likewise.
+ 	* ada/acats-3/support/f940a00.a: Likewise.
+ 	* ada/acats-3/support/f954a00.a: Likewise.
+ 	* ada/acats-3/support/fa11a00.a: Likewise.
+ 	* ada/acats-3/support/fa11b00.a: Likewise.
+ 	* ada/acats-3/support/fa11c00.a: Likewise.
+ 	* ada/acats-3/support/fa11d00.a: Likewise.
+ 	* ada/acats-3/support/fa13a00.a: Likewise.
+ 	* ada/acats-3/support/fa13b00.a: Likewise.
+ 	* ada/acats-3/support/fa21a00.a: Likewise.
+ 	* ada/acats-3/support/fb20a00.a: Likewise.
+ 	* ada/acats-3/support/fb40a00.a: Likewise.
+ 	* ada/acats-3/support/fc50a00.a: Likewise.
+ 	* ada/acats-3/support/fc51a00.a: Likewise.
+ 	* ada/acats-3/support/fc51b00.a: Likewise.
+ 	* ada/acats-3/support/fc51c00.a: Likewise.
+ 	* ada/acats-3/support/fc51d00.a: Likewise.
+ 	* ada/acats-3/support/fc54a00.a: Likewise.
+ 	* ada/acats-3/support/fc70a00.a: Likewise.
+ 	* ada/acats-3/support/fc70b00.a: Likewise.
+ 	* ada/acats-3/support/fc70c00.a: Likewise.
+ 	* ada/acats-3/support/fcndecl.ada: Likewise.
+ 	* ada/acats-3/support/fd72a00.a: Likewise.
+ 	* ada/acats-3/support/fdb0a00.a: Likewise.
+ 	* ada/acats-3/support/fdd2a00.a: Likewise.
+ 	* ada/acats-3/support/fdd2b00.a: Likewise.
+ 	* ada/acats-3/support/fxa5a00.a: Likewise.
+ 	* ada/acats-3/support/fxaca00.a: Likewise.
+ 	* ada/acats-3/support/fxacb00.a: Likewise.
+ 	* ada/acats-3/support/fxacc00.a: Likewise.
+ 	* ada/acats-3/support/fxaia00.a: Likewise.
+ 	* ada/acats-3/support/fxc6a00.a: Likewise.
+ 	* ada/acats-3/support/fxe2a00.a: Likewise.
+ 	* ada/acats-3/support/fxf2a00.a: Likewise.
+ 	* ada/acats-3/support/fxf3a00.a: Likewise.
+ 	* ada/acats-3/support/impbit.adb: Likewise.
+ 	* ada/acats-3/support/impdef.a: Likewise.
+ 	* ada/acats-3/support/impdefc.a: Likewise.
+ 	* ada/acats-3/support/impdefd.a: Likewise.
+ 	* ada/acats-3/support/impdefe.a: Likewise.
+ 	* ada/acats-3/support/impdefg.a: Likewise.
+ 	* ada/acats-3/support/impdefh.a: Likewise.
+ 	* ada/acats-3/support/lencheck.ada: Likewise.
+ 	* ada/acats-3/support/macro.dfs: Likewise.
+ 	* ada/acats-3/support/macrodef.adb: Likewise.
+ 	* ada/acats-3/support/macrosub.ada: Likewise.
+ 	* ada/acats-3/support/repbody.ada: Likewise.
+ 	* ada/acats-3/support/repspec.ada: Likewise.
+ 	* ada/acats-3/support/spprt13s.tst: Likewise.
+ 	* ada/acats-3/support/tctouch.ada: Likewise.
+ 	* ada/acats-3/support/tsttests.dat: Likewise.
+ 	* ada/acats-3/tests/a/a22006b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a22006c.ada: Likewise.
+ 	* ada/acats-3/tests/a/a22006d.ada: Likewise.
+ 	* ada/acats-3/tests/a/a26007a.tst: Likewise.
+ 	* ada/acats-3/tests/a/a27003a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a29003a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a2a031a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a33003a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a34017c.ada: Likewise.
+ 	* ada/acats-3/tests/a/a35101b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a35402a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a35801f.ada: Likewise.
+ 	* ada/acats-3/tests/a/a35902c.ada: Likewise.
+ 	* ada/acats-3/tests/a/a38106d.ada: Likewise.
+ 	* ada/acats-3/tests/a/a38106e.ada: Likewise.
+ 	* ada/acats-3/tests/a/a49027a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a49027b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a49027c.ada: Likewise.
+ 	* ada/acats-3/tests/a/a54b01a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a54b02a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a55b12a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a55b13a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a55b14a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a71004a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a73001i.ada: Likewise.
+ 	* ada/acats-3/tests/a/a73001j.ada: Likewise.
+ 	* ada/acats-3/tests/a/a74105b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a74106a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a74106b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a74106c.ada: Likewise.
+ 	* ada/acats-3/tests/a/a74205e.ada: Likewise.
+ 	* ada/acats-3/tests/a/a74205f.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83009a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83009b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83a02a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83a02b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83a06a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83a08a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83c01c.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83c01h.ada: Likewise.
+ 	* ada/acats-3/tests/a/a83c01i.ada: Likewise.
+ 	* ada/acats-3/tests/a/a85007d.ada: Likewise.
+ 	* ada/acats-3/tests/a/a85013b.ada: Likewise.
+ 	* ada/acats-3/tests/a/a87b59a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a95001c.ada: Likewise.
+ 	* ada/acats-3/tests/a/a95074d.ada: Likewise.
+ 	* ada/acats-3/tests/a/a97106a.ada: Likewise.
+ 	* ada/acats-3/tests/a/a99006a.ada: Likewise.
+ 	* ada/acats-3/tests/a/aa2010a.ada: Likewise.
+ 	* ada/acats-3/tests/a/aa2012a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ac1015b.ada: Likewise.
+ 	* ada/acats-3/tests/a/ac3106a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ac3206a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ac3207a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7001b.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7001c0.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7001c1.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7001d0.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7001d1.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7006a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7101a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7101c.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7102a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7103a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7103c.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7104a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7201a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7203b.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad7205b.ada: Likewise.
+ 	* ada/acats-3/tests/a/ad8011a.tst: Likewise.
+ 	* ada/acats-3/tests/a/ada101a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ae2113a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ae2113b.ada: Likewise.
+ 	* ada/acats-3/tests/a/ae3002g.ada: Likewise.
+ 	* ada/acats-3/tests/a/ae3101a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ae3702a.ada: Likewise.
+ 	* ada/acats-3/tests/a/ae3709a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23001a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23003a.tst: Likewise.
+ 	* ada/acats-3/tests/c2/c23003b.tst: Likewise.
+ 	* ada/acats-3/tests/c2/c23003g.tst: Likewise.
+ 	* ada/acats-3/tests/c2/c23003i.tst: Likewise.
+ 	* ada/acats-3/tests/c2/c23006a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23006b.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23006c.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23006d.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23006e.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23006f.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c23006g.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24002d.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24003a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24003b.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24003c.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24106a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24202d.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24203a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24203b.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24207a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c24211a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c250001.au: Likewise.
+ 	* ada/acats-3/tests/c2/c250002.au: Likewise.
+ 	* ada/acats-3/tests/c2/c25001a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c25001b.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c26006a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c26008a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c2a001a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c2a001b.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c2a001c.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c2a002a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c2a008a.ada: Likewise.
+ 	* ada/acats-3/tests/c2/c2a021b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32001a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32001b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32001c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32001d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32001e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32107a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32107c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32108a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32108b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32111a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32111b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32112b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32113a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32115a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c32115b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c330001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c330002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c332001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c340001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c34001a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34001c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34001d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34001f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34002a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34002c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34003a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34003c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34004a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34004c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005i.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005m.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005o.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005p.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005r.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005s.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005u.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34005v.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34006a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34006d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34006f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34006g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34006j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34006l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007i.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007m.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007p.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007r.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007s.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007u.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34007v.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34008a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34009a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34009d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34009f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34009g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34009j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34009l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34011b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34012a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014n.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014p.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014r.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014t.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34014u.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c34018a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c340a01.a: Likewise.
+ 	* ada/acats-3/tests/c3/c340a02.a: Likewise.
+ 	* ada/acats-3/tests/c3/c341a01.a: Likewise.
+ 	* ada/acats-3/tests/c3/c341a02.a: Likewise.
+ 	* ada/acats-3/tests/c3/c341a03.a: Likewise.
+ 	* ada/acats-3/tests/c3/c341a04.a: Likewise.
+ 	* ada/acats-3/tests/c3/c35003a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35003b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35003d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35102a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c352001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c354002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c354003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c354004.a: Likewise.
+ 	* ada/acats-3/tests/c3/c35502a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502d.tst: Likewise.
+ 	* ada/acats-3/tests/c3/c35502e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502f.tst: Likewise.
+ 	* ada/acats-3/tests/c3/c35502g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502i.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502k.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502m.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502n.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502o.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35502p.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503d.tst: Likewise.
+ 	* ada/acats-3/tests/c3/c35503e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503f.tst: Likewise.
+ 	* ada/acats-3/tests/c3/c35503g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503k.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503o.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35503p.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35504a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35504b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35505c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35505e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35505f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507i.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507k.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507m.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507n.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507o.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35507p.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508k.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508o.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35508p.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35703a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35704a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35704b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35704c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35704d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35801d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35902d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35904a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35904b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a02a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a05a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a05d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a05n.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a05q.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a07a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a07d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c35a08b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c360002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c36104a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36104b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36172a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36172b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36172c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36174a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36180a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36202c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36203a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36204a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36204b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36204c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36204d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205i.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205k.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36205l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36301a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36301b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36302a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36304a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c36305a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37002a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37003a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37003b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37005a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37006a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37008a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37008b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37009a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37010a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37010b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c371001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c371002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c371003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c37102b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37103a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37105a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37107a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37108b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37206a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37207a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37208a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37208b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37209a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37209b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37210a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37211a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37211b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37211c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37211d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37211e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37213b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37213d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37213f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37213h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37213j.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37213k.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37213l.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37215b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37215d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37215f.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37215h.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37217a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37217b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37217c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37304a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37305a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37306a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37309a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37310a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37312a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37402a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37403a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37404a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37404b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37405a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c37411a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c380001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c380002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c380003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c380004.a: Likewise.
+ 	* ada/acats-3/tests/c3/c38002a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38002b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38005a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38005b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38005c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38102a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38102b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38102c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38102d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38102e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38104a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38107a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38107b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38108a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38108b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38108c0.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38108c1.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38108c2.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38108d0.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c38108d1.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c3900010.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900011.am: Likewise.
+ 	* ada/acats-3/tests/c3/c390002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390004.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900050.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900051.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900052.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900053.am: Likewise.
+ 	* ada/acats-3/tests/c3/c3900060.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900061.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900062.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3900063.am: Likewise.
+ 	* ada/acats-3/tests/c3/c390007.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390010.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390011.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390012.a: Likewise.
+ 	* ada/acats-3/tests/c3/c39006a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006c0.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006c1.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006d.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006e.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006f0.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006f1.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006f2.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006f3.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39006g.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39007a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39007b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39008a.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39008b.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c39008c.ada: Likewise.
+ 	* ada/acats-3/tests/c3/c390a010.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390a011.am: Likewise.
+ 	* ada/acats-3/tests/c3/c390a020.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390a021.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390a022.am: Likewise.
+ 	* ada/acats-3/tests/c3/c390a030.a: Likewise.
+ 	* ada/acats-3/tests/c3/c390a031.am: Likewise.
+ 	* ada/acats-3/tests/c3/c391001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c391002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c391003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392004.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392005.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392008.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392010.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392011.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392013.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392014.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392015.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392a01.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392c05.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392c07.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392d01.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392d02.a: Likewise.
+ 	* ada/acats-3/tests/c3/c392d03.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393007.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393008.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393009.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393010.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393011.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393012.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393013.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393a02.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393a03.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393a05.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393a06.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393b12.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393b13.a: Likewise.
+ 	* ada/acats-3/tests/c3/c393b14.a: Likewise.
+ 	* ada/acats-3/tests/c3/c394001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c394002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c394003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0004.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0005.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0006.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0007.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0008.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0009.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0010.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0011.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a00120.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a00121.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a00122.am: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0013.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0014.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0015.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0016.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0017.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0018.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0019.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0020.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0021.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0022.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0023.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0024.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0025.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0026.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0027.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0028.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0029.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a0030.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a1001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a1002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a10030.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a10031.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a10032.am: Likewise.
+ 	* ada/acats-3/tests/c3/c3a10040.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a10041.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a10042.am: Likewise.
+ 	* ada/acats-3/tests/c3/c3a2001.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a2002.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a2003.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a2004.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a2a01.a: Likewise.
+ 	* ada/acats-3/tests/c3/c3a2a02.a: Likewise.
+ 	* ada/acats-3/tests/c4/c410001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c41101d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41103a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41103b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41104a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41105a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41107a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41201d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41203a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41203b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41204a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41205a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41206a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41207a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c413001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c413002.a: Likewise.
+ 	* ada/acats-3/tests/c4/c413003.a: Likewise.
+ 	* ada/acats-3/tests/c4/c413004.a: Likewise.
+ 	* ada/acats-3/tests/c4/c413005.a: Likewise.
+ 	* ada/acats-3/tests/c4/c413006.a: Likewise.
+ 	* ada/acats-3/tests/c4/c41301a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303g.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303i.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303j.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303k.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303m.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303n.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303o.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303q.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303r.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303s.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303u.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303v.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41303w.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41304a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41304b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41306b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41306c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41307d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41309a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41320a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41321a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41322a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41323a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41324a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41325a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41326a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41327a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41328a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41401a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41402a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c41404a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c420001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c42006a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c42007e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43003a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43004a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43004c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c431001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c43103a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43103b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43104a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43105a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43105b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43106a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43107a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43108a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c431a01.a: Likewise.
+ 	* ada/acats-3/tests/c4/c431a02.a: Likewise.
+ 	* ada/acats-3/tests/c4/c431a03.a: Likewise.
+ 	* ada/acats-3/tests/c4/c432001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c432002.a: Likewise.
+ 	* ada/acats-3/tests/c4/c432003.a: Likewise.
+ 	* ada/acats-3/tests/c4/c432004.a: Likewise.
+ 	* ada/acats-3/tests/c4/c432005.a: Likewise.
+ 	* ada/acats-3/tests/c4/c43204a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43204c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43204e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43204f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43204g.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43204h.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43204i.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205g.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205h.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205i.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205j.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43205k.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43206a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43207b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43207d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43208a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43208b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43209a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43210a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43211a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43212a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43212c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43214a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43214b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43214c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43214d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43214e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43214f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43215a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43215b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43222a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c43224a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c433001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c433a01.a: Likewise.
+ 	* ada/acats-3/tests/c4/c433a02.a: Likewise.
+ 	* ada/acats-3/tests/c4/c433a03.a: Likewise.
+ 	* ada/acats-3/tests/c4/c433a04.a: Likewise.
+ 	* ada/acats-3/tests/c4/c44003d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c44003f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c44003g.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c450001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c45112a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45112b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45113a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45114b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c452001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c45201a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45201b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45202b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45210a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45211a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45220a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45220b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45220c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45220d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45220e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45220f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45231a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45231b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45231c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45231d.tst: Likewise.
+ 	* ada/acats-3/tests/c4/c45232b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45242b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45251a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45252a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45252b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45253a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45262a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45262b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45262c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45262d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45264a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45264b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45264c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45265a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45271a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45272a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45273a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45274a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45274b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45274c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45281a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45282a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45282b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45291a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c452a01.a: Likewise.
+ 	* ada/acats-3/tests/c4/c452a02.a: Likewise.
+ 	* ada/acats-3/tests/c4/c452a03.a: Likewise.
+ 	* ada/acats-3/tests/c4/c453001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c45303a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45304a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45304b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45304c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45322a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45323a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45331a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45342a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45343a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45344a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45345b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45347a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45347b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45347c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45347d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45411a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45411b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45411c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45411d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45413a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45431a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c455001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c45502b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45502c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45503a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45503b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45503c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45504a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45504b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45504c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45504d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45504e.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45504f.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45505a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45523a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531g.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531h.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531i.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531j.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531k.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531l.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45531m.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45531n.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45531o.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45531p.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45532a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532g.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532h.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532i.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532j.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532k.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532l.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45532m.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45532n.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45532o.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45532p.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45534b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45536a.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c456001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c45611a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45611b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45611c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45613a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45613b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45613c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45614a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45614b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45614c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45631a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45631b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45631c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45632a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45632b.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45632c.dep: Likewise.
+ 	* ada/acats-3/tests/c4/c45651a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45662a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45662b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c45672a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c460001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460002.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460004.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460005.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460006.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460007.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460008.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460009.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460010.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460011.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460012.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460013.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460014.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460015.a: Likewise.
+ 	* ada/acats-3/tests/c4/c46011a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46013a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46014a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46021a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46024a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46031a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46032a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46033a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46041a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46042a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46043b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46044b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46051a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46051b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46051c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46052a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46053a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c46054a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c460a01.a: Likewise.
+ 	* ada/acats-3/tests/c4/c460a02.a: Likewise.
+ 	* ada/acats-3/tests/c4/c47002a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47002b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47002c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47002d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47003a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47004a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47005a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47006a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47007a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47008a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47009a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c47009b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c480001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c48004a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48004b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48004c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48004d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48004e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48004f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48005a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48005b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48006a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48006b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48007a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48007b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48007c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48008a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48008c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009d.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009e.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009f.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009g.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009h.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009i.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48009j.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48010a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48011a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c48012a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c490001.a: Likewise.
+ 	* ada/acats-3/tests/c4/c490002.a: Likewise.
+ 	* ada/acats-3/tests/c4/c490003.a: Likewise.
+ 	* ada/acats-3/tests/c4/c49020a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49021a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49022a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49022b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49022c.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49023a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49024a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49025a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c49026a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a005b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a006a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a007a.tst: Likewise.
+ 	* ada/acats-3/tests/c4/c4a010a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a010b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a011a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a012b.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a013a.ada: Likewise.
+ 	* ada/acats-3/tests/c4/c4a014a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c51004a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52005a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52005b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52005c.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52005d.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52005e.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52005f.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52008a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52008b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52009a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52009b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52010a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52011a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52011b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52101a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52102a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52102b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52102c.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52102d.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103c.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103f.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103g.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103h.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103k.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103l.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103m.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103p.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103q.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103r.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52103x.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104c.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104f.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104g.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104h.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104k.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104l.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104m.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104p.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104q.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104r.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104x.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c52104y.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c53007a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c540001.a: Likewise.
+ 	* ada/acats-3/tests/c5/c540002.a: Likewise.
+ 	* ada/acats-3/tests/c5/c54a03a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a04a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a07a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a13a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a13b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a13c.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a13d.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a22a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a23a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a24a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a24b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a42a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a42b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a42c.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a42d.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a42e.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a42f.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c54a42g.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b03a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b04a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b05a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b06a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b06b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b07a.dep: Likewise.
+ 	* ada/acats-3/tests/c5/c55b07b.dep: Likewise.
+ 	* ada/acats-3/tests/c5/c55b10a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b11a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b11b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b15a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55b16a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55c02a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c55c02b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c56002a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c57003a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c57004a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c57004b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58004c.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58004d.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58004g.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58005a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58005b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58005h.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58006a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c58006b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c59002a.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c59002b.ada: Likewise.
+ 	* ada/acats-3/tests/c5/c59002c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c61008a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c61009a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c61010a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c620001.a: Likewise.
+ 	* ada/acats-3/tests/c6/c620002.a: Likewise.
+ 	* ada/acats-3/tests/c6/c62002a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c62003a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c62003b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c62004a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c62006a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c631001.a: Likewise.
+ 	* ada/acats-3/tests/c6/c640001.a: Likewise.
+ 	* ada/acats-3/tests/c6/c640002.a: Likewise.
+ 	* ada/acats-3/tests/c6/c64002b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64004g.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64005a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64005b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64005c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64005d0.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64005da.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64005db.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64005dc.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c641001.a: Likewise.
+ 	* ada/acats-3/tests/c6/c64103b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64103c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64103d.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64103e.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64103f.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104d.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104e.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104f.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104g.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104h.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104i.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104j.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104k.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104l.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104m.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104n.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64104o.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64105a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64105b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64105c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64105d.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64106a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64106b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64106c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64106d.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64107a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64108a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109d.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109e.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109f.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109g.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109h.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109i.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109j.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109k.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64109l.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64201b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64201c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c64202a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c650002.a: Likewise.
+ 	* ada/acats-3/tests/c6/c650003.a: Likewise.
+ 	* ada/acats-3/tests/c6/c65003a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c65003b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c650a01.a: Likewise.
+ 	* ada/acats-3/tests/c6/c651001.a: Likewise.
+ 	* ada/acats-3/tests/c6/c660001.a: Likewise.
+ 	* ada/acats-3/tests/c6/c66002a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c66002c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c66002d.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c66002e.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c66002f.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c66002g.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67002a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67002b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67002c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67002d.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67002e.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67003f.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67005a.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67005b.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67005c.ada: Likewise.
+ 	* ada/acats-3/tests/c6/c67005d.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c72001b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c72002a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c730001.a: Likewise.
+ 	* ada/acats-3/tests/c7/c730002.a: Likewise.
+ 	* ada/acats-3/tests/c7/c730003.a: Likewise.
+ 	* ada/acats-3/tests/c7/c730004.a: Likewise.
+ 	* ada/acats-3/tests/c7/c73002a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c730a01.a: Likewise.
+ 	* ada/acats-3/tests/c7/c730a02.a: Likewise.
+ 	* ada/acats-3/tests/c7/c731001.a: Likewise.
+ 	* ada/acats-3/tests/c7/c74004a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74203a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74206a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74207b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74208a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74208b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74209a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74210a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74211a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74211b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74302a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74302b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74305a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74305b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74306a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74307a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74401d.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74401e.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74401k.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74401q.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74402a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74402b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74406a.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74407b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c74409b.ada: Likewise.
+ 	* ada/acats-3/tests/c7/c750b01.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760001.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760002.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760007.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760009.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760010.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760011.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760012.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760013.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760015.a: Likewise.
+ 	* ada/acats-3/tests/c7/c760a02.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761001.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761002.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761003.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761004.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761005.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761006.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761007.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761010.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761011.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761012.a: Likewise.
+ 	* ada/acats-3/tests/c7/c761013.a: Likewise.
+ 	* ada/acats-3/tests/c8/c83007a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83012d.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83022a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83022g0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83022g1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83023a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83024a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83024e0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83024e1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83025a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83025c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83027a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83027c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83028a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83029a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83030a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83030c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83031a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83031c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83031e.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83032a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83033a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83051a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83b02a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83b02b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83e02a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83e02b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83e03a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f01a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f01b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f01c0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f01c1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f01c2.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f01d0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f01d1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f03a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f03b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f03c0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f03c1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f03c2.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f03d0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c83f03d1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c840001.a: Likewise.
+ 	* ada/acats-3/tests/c8/c84002a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c84005a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c84008a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c84009a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85004b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85005a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85005b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85005c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85005d.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85005e.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85005f.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85005g.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85006a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85006b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85006c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85006d.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85006e.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85006f.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85006g.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85007a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85007e.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85009a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85011a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85013a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85014a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85014b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85014c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85017a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85018a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85018b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c85019a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c851001.a: Likewise.
+ 	* ada/acats-3/tests/c8/c851002.a: Likewise.
+ 	* ada/acats-3/tests/c8/c854001.a: Likewise.
+ 	* ada/acats-3/tests/c8/c854002.a: Likewise.
+ 	* ada/acats-3/tests/c8/c854003.a: Likewise.
+ 	* ada/acats-3/tests/c8/c86003a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86004a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86004b0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86004b1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86004b2.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86004c0.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86004c1.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86004c2.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86006i.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c86007a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87a05a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87a05b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b02a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b02b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b03a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b04a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b04b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b04c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b05a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b06a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b07a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b07b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b07c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b07d.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b07e.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b08a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b09a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b09c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b10a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b11a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b11b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b13a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b14a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b14b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b14c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b14d.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b15a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b16a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b17a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b18a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b18b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b19a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b23a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b24a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b24b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b26b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b27a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b28a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b29a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b30a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b31a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b32a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b33a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b34a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b34b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b34c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b35c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b38a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b39a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b40a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b41a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b42a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b43a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b44a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b45a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b45c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b47a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b48a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b48b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b50a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b54a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b57a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b62a.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b62b.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b62c.ada: Likewise.
+ 	* ada/acats-3/tests/c8/c87b62d.tst: Likewise.
+ 	* ada/acats-3/tests/c9/c910001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c910002.a: Likewise.
+ 	* ada/acats-3/tests/c9/c910003.a: Likewise.
+ 	* ada/acats-3/tests/c9/c91004b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c91004c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c91006a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c91007a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c920001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c92002a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c92003a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c92005a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c92005b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c92006a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c930001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c93001a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93002a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93003a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93004a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93004b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93004c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93004d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93004f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005g.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93005h.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93006a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93007a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93008a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c93008b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c940001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940002.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940004.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940005.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940006.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940007.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940010.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940011.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940012.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940013.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940014.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940015.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940016.a: Likewise.
+ 	* ada/acats-3/tests/c9/c940017.a: Likewise.
+ 	* ada/acats-3/tests/c9/c94001a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94001b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94001c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94001e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94001f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94001g.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94002a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94002b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94002d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94002e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94002f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94002g.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94004a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94004b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94004c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94005a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94005b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94006a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94007a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94007b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94008a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94008b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94008c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94008d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94010a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94011a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c94020a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c940a03.a: Likewise.
+ 	* ada/acats-3/tests/c9/c95008a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95009a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95010a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95011a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95012a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95021a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95022a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95022b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95033a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95033b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95034a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95034b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95035a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95040a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95040b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95040c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95040d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95041a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95065a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95065b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95065c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95065d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95065e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95065f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95066a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95067a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95071a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95072a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95072b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95073a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95074c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95076a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95078a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95080b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95082g.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085g.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085h.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085i.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085j.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085k.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085l.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085m.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085n.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95085o.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95086a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95086b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95086c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95086d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95086e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95086f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95087a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95087b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95087c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95087d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95088a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95089a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95090a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95092a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95093a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95095a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95095b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95095c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95095d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c95095e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c951001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c951002.a: Likewise.
+ 	* ada/acats-3/tests/c9/c953001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c953002.a: Likewise.
+ 	* ada/acats-3/tests/c9/c953003.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954010.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954011.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954012.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954013.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954014.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954015.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954016.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954017.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954018.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954019.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954020.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954021.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954022.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954023.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954024.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954025.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954026.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954a01.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954a02.a: Likewise.
+ 	* ada/acats-3/tests/c9/c954a03.a: Likewise.
+ 	* ada/acats-3/tests/c9/c960001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c960002.a: Likewise.
+ 	* ada/acats-3/tests/c9/c960004.a: Likewise.
+ 	* ada/acats-3/tests/c9/c96001a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96004a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96005a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96005b.tst: Likewise.
+ 	* ada/acats-3/tests/c9/c96005d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96005f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96006a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96007a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96008a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c96008b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97112a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97113a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97114a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97115a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97116a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97117a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97117b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97117c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97118a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97120a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97120b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201g.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201h.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97201x.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97202a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97203a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97203b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97203c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97204a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97204b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97205a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97205b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97301a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97301b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97301c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97301d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97301e.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97302a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97303a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97303b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97303c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97304a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97304b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97305a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97305b.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97305c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97305d.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c97307a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c974001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974002.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974003.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974004.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974005.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974006.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974007.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974008.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974009.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974010.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974011.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974012.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974013.a: Likewise.
+ 	* ada/acats-3/tests/c9/c974014.a: Likewise.
+ 	* ada/acats-3/tests/c9/c980001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c980002.a: Likewise.
+ 	* ada/acats-3/tests/c9/c980003.a: Likewise.
+ 	* ada/acats-3/tests/c9/c990001.a: Likewise.
+ 	* ada/acats-3/tests/c9/c99005a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a003a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a004a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a007a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a009a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a009c.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a009f.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a009g.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a009h.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a010a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a011a.ada: Likewise.
+ 	* ada/acats-3/tests/c9/c9a011b.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1003a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1004a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1005a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1006a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1011a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1011a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1011a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1011a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1011a4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1011a5.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1011a6.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012a4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012b0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012b2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1012b4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1013a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1013a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1013a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1013a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1013a4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1013a5.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1013a6.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1014a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1014a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1014a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1014a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1020e0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1020e1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1020e2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1020e3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1022a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1022a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1022a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1022a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1022a4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1022a5.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1022a6.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca11001.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11002.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11003.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca110040.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca110041.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca110042.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca110050.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca110051.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca11006.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11007.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11008.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11009.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11010.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11011.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11012.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11013.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11014.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11015.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11016.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11017.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11018.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11019.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11020.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11021.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11022.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca110230.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca110231.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca110232.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca1102a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1102a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1102a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1106a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1108a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca1108b.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca11a01.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11a02.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11b01.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11b02.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11c01.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11c02.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11c03.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11d010.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11d011.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11d012.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11d013.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca11d02.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca11d03.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca120010.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca120011.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca120012.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca12002.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca13001.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca13002.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca13003.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca13a01.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca13a02.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca140230.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca140231.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca140232.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca140233.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca140280.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca140281.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca140282.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca140283.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca15003.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca200020.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca200021.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca200022.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca200030.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca200031.am: Likewise.
+ 	* ada/acats-3/tests/ca/ca2001h0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2001h1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2001h2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2001h3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2002a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2002a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2002a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2003a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2003a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2004a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2004a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2004a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2004a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2004a4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2007a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2007a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2007a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2007a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2008a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2008a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2008a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2009a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2009c0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2009c1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2009d.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2009f0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2009f1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2009f2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca2011b.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca21001.a: Likewise.
+ 	* ada/acats-3/tests/ca/ca3011a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca3011a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca3011a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca3011a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca3011a4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003a0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003a1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003a2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003a3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003a4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003a5.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003a6.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003b0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003b1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003b2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003b3.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003b4.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5003b5.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5004a.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5004b0.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5004b1.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5004b2.ada: Likewise.
+ 	* ada/acats-3/tests/ca/ca5006a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb10002.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb1001a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb1004a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb1005a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb1010a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb1010c.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb1010d.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb20001.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb20003.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb20004.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb20005.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb20006.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb20007.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb2004a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb2005a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb2006a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb2007a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb20a02.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb30001.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb3003a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb3003b.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb3004a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb40005.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb4001a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4002a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4003a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4004a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4005a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4006a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4007a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4008a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4009a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb4013a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb40a01.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb40a020.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb40a021.am: Likewise.
+ 	* ada/acats-3/tests/cb/cb40a030.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb40a031.am: Likewise.
+ 	* ada/acats-3/tests/cb/cb40a04.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb41001.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb41002.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb41003.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb41004.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb42001.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb42002.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb42003.a: Likewise.
+ 	* ada/acats-3/tests/cb/cb5001a.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb5001b.ada: Likewise.
+ 	* ada/acats-3/tests/cb/cb5002a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1004a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1005b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1010a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1010b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1018a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1104c.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1107b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1111a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1204a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1207b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1220a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1221a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1221b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1221c.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1221d.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1222a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1223a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1224a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1225a.tst: Likewise.
+ 	* ada/acats-3/tests/cc/cc1226b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1227a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1301a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1302a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1304a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1304b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1307a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1307b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1308a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1310a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1311a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc1311b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc2002a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc30001.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc30002.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc30003.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc30004.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc3004a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3007a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3007b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3011a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3011d.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3012a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3015a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3016b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3016c.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3016f.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3016i.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3017b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3017c.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3019a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3019b0.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3019b1.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3019b2.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3019c0.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3019c1.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3019c2.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3106b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3120a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3120b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3121a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3123a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3125a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3125b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3125c.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3125d.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3126a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3127a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3128a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3203a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3207b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3220a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3221a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3222a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3223a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3224a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3225a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3230a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3231a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3232a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3233a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3234a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3235a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3236a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3240a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3305a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3305b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3305c.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3305d.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3601a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3601c.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3602a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3603a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3605a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3606a.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3606b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc3607b.ada: Likewise.
+ 	* ada/acats-3/tests/cc/cc40001.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc50001.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc50a01.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc50a02.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51001.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51002.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51003.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51004.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51006.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51007.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51008.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51a01.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51b03.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51d01.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc51d02.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc54001.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc54002.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc54003.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc54004.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc60001.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70001.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70002.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70003.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70a01.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70a02.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70b01.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70b02.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70c01.a: Likewise.
+ 	* ada/acats-3/tests/cc/cc70c02.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd10001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd10002.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009f.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009h.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009j.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009k.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009l.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009m.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009n.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009o.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009p.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009q.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009r.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009s.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009t.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009u.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009v.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009w.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009x.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009y.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1009z.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03e.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03f.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03h.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c03i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c04a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c04d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c04e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd1c06a.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd20001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a21a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a21c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a21e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a22a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a22e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a22i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a22j.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a23a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a23e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a24a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a24e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a24i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a24j.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a31a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a31c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a31e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a32a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a32c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a32e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a32g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a32i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a32j.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a51a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a53a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a53e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a83c.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd2a91c.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd2b11b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2b11d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2b11e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2b11f.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2b16a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2c11a.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd2c11d.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd2d11a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd2d13a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd30001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd30002.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd30003.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd30004.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd300050.am: Likewise.
+ 	* ada/acats-3/tests/cd/cd300051.c: Likewise.
+ 	* ada/acats-3/tests/cd/cd30008.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd30009.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd30011.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd30012.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd3014a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3014c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3014d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3014f.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015f.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015h.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3015k.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd3021a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd33001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd33002.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd40001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd4031a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd4041a.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd4051a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd4051b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd4051c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd4051d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003f.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003h.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5003i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011k.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011m.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011q.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5011s.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5012a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5012b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5012e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5012f.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5012i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5012m.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013k.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013m.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5013o.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014g.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014i.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014k.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014m.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014o.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014t.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014v.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014x.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014y.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd5014z.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd70001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd7002a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd7007b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd7101d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd7101e.dep: Likewise.
+ 	* ada/acats-3/tests/cd/cd7101f.dep: Likewise.
+ 	* ada/acats-3/tests/cd/cd7101g.tst: Likewise.
+ 	* ada/acats-3/tests/cd/cd7103d.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd7202a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd7204b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd7204c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd72a01.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd72a02.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd7305a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cd90001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cd92001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cda201a.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cda201b.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cda201c.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cda201e.ada: Likewise.
+ 	* ada/acats-3/tests/cd/cdb0001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdb0002.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdb0a01.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdb0a02.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdd1001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdd2001.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdd2a01.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdd2a02.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdd2a03.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdd2b01.a: Likewise.
+ 	* ada/acats-3/tests/cd/cdd2b03.a: Likewise.
+ 	* ada/acats-3/tests/cd/cde0001.a: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102c.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102h.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102i.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102j.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102k.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102l.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102m.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102n.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102o.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102p.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102q.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102r.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102s.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102t.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102u.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102v.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102w.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102x.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2102y.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2103a.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce2103b.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce2103c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2103d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2104a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2104b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2104c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2104d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2106a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2106b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2108e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2108f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2108g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2108h.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2109a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2109b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2109c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2110a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2110c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2111a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2111b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2111c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2111e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2111f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2111g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2111i.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201d.dep: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201e.dep: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201h.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201i.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201j.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201k.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201l.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201m.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2201n.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2202a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2203a.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce2204a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2204b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2204c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2204d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2205a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2206a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2208b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401h.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401i.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401j.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401k.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2401l.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2402a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2403a.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce2404a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2404b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2405b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2406a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2407a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2407b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2408a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2408b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2409a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2409b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2410a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2410b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce2411a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3002b.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce3002c.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce3002d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3002f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102b.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102h.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102i.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102j.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3102k.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3103a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3104a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3104b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3104c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3106a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3106b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3107a.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce3107b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3108a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3108b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3110a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3112c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3112d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3114a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3115a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3201a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3202a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3206a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3207a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3301a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3302a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3303a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3304a.tst: Likewise.
+ 	* ada/acats-3/tests/ce/ce3305a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3306a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3401a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3402a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3402c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3402d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3402e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3403a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3403b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3403c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3403d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3403e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3403f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3404a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3404b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3404c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3404d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3405a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3405c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3405d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3406a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3406b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3406c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3406d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3407a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3407b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3407c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3408a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3408b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3408c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3409a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3409b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3409c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3409d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3409e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3410a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3410b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3410c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3410d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3410e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3411a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3411c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3412a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3413a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3413b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3413c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3414a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3601a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3602a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3602b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3602c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3602d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3603a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3604a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3604b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3605a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3605b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3605c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3605d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3605e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3606a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3606b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3701a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704m.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704n.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3704o.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3705a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3705b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3705c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3705d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3705e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3706c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3706d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3706f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3706g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3707a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3708a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3801a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3801b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804h.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804i.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804j.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804m.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804o.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3804p.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3805a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3805b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806g.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3806h.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3809a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3809b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3810a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3810b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3815a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3901a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3902b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3904a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3904b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3905a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3905b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3905c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3905l.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3906a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3906b.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3906c.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3906d.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3906e.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3906f.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3907a.ada: Likewise.
+ 	* ada/acats-3/tests/ce/ce3908a.ada: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa3001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa3002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa3003.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa3004.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4003.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4004.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4005.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4006.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4007.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4008.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4009.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4010.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4011.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4012.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4013.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4014.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4015.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4016.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4017.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4018.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4019.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4020.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4021.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4022.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4023.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4024.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4025.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4026.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4027.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4028.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4029.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4030.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4031.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4032.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4033.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4034.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa4037.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5011.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5012.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5013.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5015.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5016.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a01.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a02.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a03.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a04.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a05.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a06.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a07.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a08.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a09.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa5a10.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa8001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa8002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa8003.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa9001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxa9002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa003.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa004.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa005.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa006.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa007.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa008.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa009.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa010.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa011.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa012.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa013.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa014.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa015.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa016.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa017.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa018.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa019.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa020.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa021.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaa022.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxab001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxab002.au: Likewise.
+ 	* ada/acats-3/tests/cxa/cxab003.au: Likewise.
+ 	* ada/acats-3/tests/cxa/cxab004.au: Likewise.
+ 	* ada/acats-3/tests/cxa/cxab005.au: Likewise.
+ 	* ada/acats-3/tests/cxa/cxac001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxac002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxac003.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxac004.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxac005.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxac006.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxac008.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaca01.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaca02.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxacb01.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxacb02.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxacc01.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaf001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxag001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxah001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxah002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxai001.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxai002.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxai003.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxai004.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxai005.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxai006.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaia01.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaia02.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaia03.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaia04.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaia05.a: Likewise.
+ 	* ada/acats-3/tests/cxa/cxaia06.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb2001.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb2002.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb2003.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3001.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3002.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3003.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30040.c: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30041.am: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3005.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30060.c: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30061.am: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3007.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3008.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3009.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3010.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3011.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3012.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30130.c: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30131.c: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30132.am: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3014.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3015.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb3016.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30170.c: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30171.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30172.am: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30230.c: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb30231.am: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4001.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4002.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4003.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4004.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4005.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4006.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4007.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb4008.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb5001.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb5002.a: Likewise.
+ 	* ada/acats-3/tests/cxb/cxb5003.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf1001.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf2001.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf2002.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf2003.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf2004.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf2005.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf2a01.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf2a02.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3001.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3002.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3003.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3004.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a01.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a02.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a03.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a04.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a05.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a06.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a07.a: Likewise.
+ 	* ada/acats-3/tests/cxf/cxf3a08.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg1001.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg1002.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg1003.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg1004.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg1005.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2001.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2002.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2003.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2004.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2005.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2006.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2007.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2008.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2009.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2010.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2011.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2012.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2013.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2014.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2015.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2016.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2017.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2018.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2019.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2020.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2021.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2022.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2023.a: Likewise.
+ 	* ada/acats-3/tests/cxg/cxg2024.a: Likewise.
+ 	* ada/acats-3/tests/cxh/cxh3001.a: Likewise.
+ 	* ada/acats-3/tests/cxh/cxh3002.a: Likewise.
+ 	* ada/acats-3/tests/cxh/cxh30030.a: Likewise.
+ 	* ada/acats-3/tests/cxh/cxh30031.am: Likewise.
+ 	* ada/acats-3/tests/cz/cz1101a.ada: Likewise.
+ 	* ada/acats-3/tests/cz/cz1102a.ada: Likewise.
+ 	* ada/acats-3/tests/cz/cz1103a.ada: Likewise.
+ 	* ada/acats-3/tests/d/d4a002a.ada: Likewise.
+ 	* ada/acats-3/tests/d/d4a002b.ada: Likewise.
+ 	* ada/acats-3/tests/d/d4a004a.ada: Likewise.
+ 	* ada/acats-3/tests/d/d4a004b.ada: Likewise.
+ 	* ada/acats-3/tests/e/e28002b.ada: Likewise.
+ 	* ada/acats-3/tests/e/e28005d.ada: Likewise.
+ 	* ada/acats-3/tests/e/e52103y.ada: Likewise.
+ 	* ada/acats-3/tests/e/eb4011a.ada: Likewise.
+ 	* ada/acats-3/tests/e/eb4012a.ada: Likewise.
+ 	* ada/acats-3/tests/e/eb4014a.ada: Likewise.
+ 	* ada/acats-3/tests/e/ee3203a.ada: Likewise.
+ 	* ada/acats-3/tests/e/ee3204a.ada: Likewise.
+ 	* ada/acats-3/tests/e/ee3402b.ada: Likewise.
+ 	* ada/acats-3/tests/e/ee3409f.ada: Likewise.
+ 	* ada/acats-3/tests/e/ee3412c.ada: Likewise.
+ 	* ada/acats-3/tests/l/la140010.a: Likewise.
+ 	* ada/acats-3/tests/l/la140011.am: Likewise.
+ 	* ada/acats-3/tests/l/la140012.a: Likewise.
+ 	* ada/acats-3/tests/l/la140020.a: Likewise.
+ 	* ada/acats-3/tests/l/la140021.am: Likewise.
+ 	* ada/acats-3/tests/l/la140022.a: Likewise.
+ 	* ada/acats-3/tests/l/la140030.a: Likewise.
+ 	* ada/acats-3/tests/l/la140031.a: Likewise.
+ 	* ada/acats-3/tests/l/la140032.am: Likewise.
+ 	* ada/acats-3/tests/l/la140033.a: Likewise.
+ 	* ada/acats-3/tests/l/la140040.a: Likewise.
+ 	* ada/acats-3/tests/l/la140041.am: Likewise.
+ 	* ada/acats-3/tests/l/la140042.a: Likewise.
+ 	* ada/acats-3/tests/l/la140050.a: Likewise.
+ 	* ada/acats-3/tests/l/la140051.a: Likewise.
+ 	* ada/acats-3/tests/l/la140052.am: Likewise.
+ 	* ada/acats-3/tests/l/la140053.a: Likewise.
+ 	* ada/acats-3/tests/l/la140060.a: Likewise.
+ 	* ada/acats-3/tests/l/la140061.a: Likewise.
+ 	* ada/acats-3/tests/l/la140062.am: Likewise.
+ 	* ada/acats-3/tests/l/la140063.a: Likewise.
+ 	* ada/acats-3/tests/l/la140070.a: Likewise.
+ 	* ada/acats-3/tests/l/la140071.a: Likewise.
+ 	* ada/acats-3/tests/l/la140072.am: Likewise.
+ 	* ada/acats-3/tests/l/la140073.a: Likewise.
+ 	* ada/acats-3/tests/l/la140080.a: Likewise.
+ 	* ada/acats-3/tests/l/la140081.a: Likewise.
+ 	* ada/acats-3/tests/l/la140082.am: Likewise.
+ 	* ada/acats-3/tests/l/la140083.a: Likewise.
+ 	* ada/acats-3/tests/l/la140090.a: Likewise.
+ 	* ada/acats-3/tests/l/la140091.a: Likewise.
+ 	* ada/acats-3/tests/l/la140092.am: Likewise.
+ 	* ada/acats-3/tests/l/la140093.a: Likewise.
+ 	* ada/acats-3/tests/l/la140100.a: Likewise.
+ 	* ada/acats-3/tests/l/la140101.a: Likewise.
+ 	* ada/acats-3/tests/l/la140102.am: Likewise.
+ 	* ada/acats-3/tests/l/la140103.a: Likewise.
+ 	* ada/acats-3/tests/l/la140110.a: Likewise.
+ 	* ada/acats-3/tests/l/la140111.a: Likewise.
+ 	* ada/acats-3/tests/l/la140112.am: Likewise.
+ 	* ada/acats-3/tests/l/la140113.a: Likewise.
+ 	* ada/acats-3/tests/l/la140120.a: Likewise.
+ 	* ada/acats-3/tests/l/la140121.a: Likewise.
+ 	* ada/acats-3/tests/l/la140122.am: Likewise.
+ 	* ada/acats-3/tests/l/la140123.a: Likewise.
+ 	* ada/acats-3/tests/l/la140130.a: Likewise.
+ 	* ada/acats-3/tests/l/la140131.a: Likewise.
+ 	* ada/acats-3/tests/l/la140132.am: Likewise.
+ 	* ada/acats-3/tests/l/la140133.a: Likewise.
+ 	* ada/acats-3/tests/l/la140140.a: Likewise.
+ 	* ada/acats-3/tests/l/la140141.a: Likewise.
+ 	* ada/acats-3/tests/l/la140142.am: Likewise.
+ 	* ada/acats-3/tests/l/la140143.a: Likewise.
+ 	* ada/acats-3/tests/l/la140150.a: Likewise.
+ 	* ada/acats-3/tests/l/la140151.a: Likewise.
+ 	* ada/acats-3/tests/l/la140152.am: Likewise.
+ 	* ada/acats-3/tests/l/la140153.a: Likewise.
+ 	* ada/acats-3/tests/l/la140160.a: Likewise.
+ 	* ada/acats-3/tests/l/la140161.a: Likewise.
+ 	* ada/acats-3/tests/l/la140162.am: Likewise.
+ 	* ada/acats-3/tests/l/la140163.a: Likewise.
+ 	* ada/acats-3/tests/l/la140170.a: Likewise.
+ 	* ada/acats-3/tests/l/la140171.a: Likewise.
+ 	* ada/acats-3/tests/l/la140172.am: Likewise.
+ 	* ada/acats-3/tests/l/la140173.a: Likewise.
+ 	* ada/acats-3/tests/l/la140180.a: Likewise.
+ 	* ada/acats-3/tests/l/la140181.a: Likewise.
+ 	* ada/acats-3/tests/l/la140182.am: Likewise.
+ 	* ada/acats-3/tests/l/la140183.a: Likewise.
+ 	* ada/acats-3/tests/l/la140190.a: Likewise.
+ 	* ada/acats-3/tests/l/la140191.a: Likewise.
+ 	* ada/acats-3/tests/l/la140192.am: Likewise.
+ 	* ada/acats-3/tests/l/la140193.a: Likewise.
+ 	* ada/acats-3/tests/l/la140200.a: Likewise.
+ 	* ada/acats-3/tests/l/la140201.a: Likewise.
+ 	* ada/acats-3/tests/l/la140202.am: Likewise.
+ 	* ada/acats-3/tests/l/la140203.a: Likewise.
+ 	* ada/acats-3/tests/l/la140210.a: Likewise.
+ 	* ada/acats-3/tests/l/la140211.am: Likewise.
+ 	* ada/acats-3/tests/l/la140212.a: Likewise.
+ 	* ada/acats-3/tests/l/la140220.a: Likewise.
+ 	* ada/acats-3/tests/l/la140221.am: Likewise.
+ 	* ada/acats-3/tests/l/la140222.a: Likewise.
+ 	* ada/acats-3/tests/l/la140240.a: Likewise.
+ 	* ada/acats-3/tests/l/la140241.a: Likewise.
+ 	* ada/acats-3/tests/l/la140242.am: Likewise.
+ 	* ada/acats-3/tests/l/la140243.a: Likewise.
+ 	* ada/acats-3/tests/l/la140250.a: Likewise.
+ 	* ada/acats-3/tests/l/la140251.am: Likewise.
+ 	* ada/acats-3/tests/l/la140252.a: Likewise.
+ 	* ada/acats-3/tests/l/la140260.a: Likewise.
+ 	* ada/acats-3/tests/l/la140261.a: Likewise.
+ 	* ada/acats-3/tests/l/la140262.am: Likewise.
+ 	* ada/acats-3/tests/l/la140263.a: Likewise.
+ 	* ada/acats-3/tests/l/la140270.a: Likewise.
+ 	* ada/acats-3/tests/l/la140271.a: Likewise.
+ 	* ada/acats-3/tests/l/la140272.am: Likewise.
+ 	* ada/acats-3/tests/l/la140273.a: Likewise.
+ 
+ 2025-05-24  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* ada/acats-2/run_all.sh: Minor tweaks in comments.
+ 	* ada/acats-2/tests/cd/cd300050.am: Upgrade to 2.6K revision.
+ 	* ada/acats-2/tests/cd/cd300051.c: Likewise.
+ 	* ada/acats-2/tests/cxa/cxa4001.a: Likewise.
+ 	* ada/acats-2/tests/cxb/cxb30131.c: Likewise.
+ 
+ 2025-05-24  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* ada/acats/*: Rename into ada/acats-2/*.
+ 	* ada/acats-2/run_all.sh: Adjust to above renaming.
+ 	* ada/acats-2/support/impdefc.a: New file.
+ 	* ada/acats-2/elabd.lst: New file.
+ 	* ada/acats-2/floatstore.lst: New file.
+ 	* ada/acats-2/norun.lst: New file.
+ 	* ada/acats-2/run_acats.sh: New file.
+ 	* ada/acats-2/run_test.exp: New file.
+ 	* ada/acats-2/stackcheck.lst: New file.
+ 	* ada/acats-2/support/acats26.lst: New file.
+ 	* ada/acats-2/support/checkfil.ada: New file.
+ 	* ada/acats-2/support/enumchek.ada: New file.
+ 	* ada/acats-2/support/f340a000.a: New file.
+ 	* ada/acats-2/support/f340a001.a: New file.
+ 	* ada/acats-2/support/f341a00.a: New file.
+ 	* ada/acats-2/support/f390a00.a: New file.
+ 	* ada/acats-2/support/f392a00.a: New file.
+ 	* ada/acats-2/support/f392c00.a: New file.
+ 	* ada/acats-2/support/f392d00.a: New file.
+ 	* ada/acats-2/support/f393a00.a: New file.
+ 	* ada/acats-2/support/f393b00.a: New file.
+ 	* ada/acats-2/support/f3a2a00.a: New file.
+ 	* ada/acats-2/support/f460a00.a: New file.
+ 	* ada/acats-2/support/f730a000.a: New file.
+ 	* ada/acats-2/support/f730a001.a: New file.
+ 	* ada/acats-2/support/f731a00.a: New file.
+ 	* ada/acats-2/support/f940a00.a: New file.
+ 	* ada/acats-2/support/f954a00.a: New file.
+ 	* ada/acats-2/support/fa11a00.a: New file.
+ 	* ada/acats-2/support/fa11b00.a: New file.
+ 	* ada/acats-2/support/fa11c00.a: New file.
+ 	* ada/acats-2/support/fa11d00.a: New file.
+ 	* ada/acats-2/support/fa13a00.a: New file.
+ 	* ada/acats-2/support/fa13b00.a: New file.
+ 	* ada/acats-2/support/fa21a00.a: New file.
+ 	* ada/acats-2/support/fb20a00.a: New file.
+ 	* ada/acats-2/support/fb40a00.a: New file.
+ 	* ada/acats-2/support/fc50a00.a: New file.
+ 	* ada/acats-2/support/fc51a00.a: New file.
+ 	* ada/acats-2/support/fc51b00.a: New file.
+ 	* ada/acats-2/support/fc51c00.a: New file.
+ 	* ada/acats-2/support/fc51d00.a: New file.
+ 	* ada/acats-2/support/fc54a00.a: New file.
+ 	* ada/acats-2/support/fc70a00.a: New file.
+ 	* ada/acats-2/support/fc70b00.a: New file.
+ 	* ada/acats-2/support/fc70c00.a: New file.
+ 	* ada/acats-2/support/fcndecl.ada: New file.
+ 	* ada/acats-2/support/fd72a00.a: New file.
+ 	* ada/acats-2/support/fdb0a00.a: New file.
+ 	* ada/acats-2/support/fdd2a00.a: New file.
+ 	* ada/acats-2/support/fxa5a00.a: New file.
+ 	* ada/acats-2/support/fxaca00.a: New file.
+ 	* ada/acats-2/support/fxacb00.a: New file.
+ 	* ada/acats-2/support/fxacc00.a: New file.
+ 	* ada/acats-2/support/fxc6a00.a: New file.
+ 	* ada/acats-2/support/fxe2a00.a: New file.
+ 	* ada/acats-2/support/fxf2a00.a: New file.
+ 	* ada/acats-2/support/fxf3a00.a: New file.
+ 	* ada/acats-2/support/impbit.adb: New file.
+ 	* ada/acats-2/support/impdef.a: New file.
+ 	* ada/acats-2/support/impdefd.a: New file.
+ 	* ada/acats-2/support/impdefe.a: New file.
+ 	* ada/acats-2/support/impdefg.a: New file.
+ 	* ada/acats-2/support/impdefh.a: New file.
+ 	* ada/acats-2/support/lencheck.ada: New file.
+ 	* ada/acats-2/support/macro.dfs: New file.
+ 	* ada/acats-2/support/macrodef.adb: New file.
+ 	* ada/acats-2/support/macrosub.ada: New file.
+ 	* ada/acats-2/support/repbody.ada: New file.
+ 	* ada/acats-2/support/repspec.ada: New file.
+ 	* ada/acats-2/support/spprt13s.tst: New file.
+ 	* ada/acats-2/support/tctouch.ada: New file.
+ 	* ada/acats-2/support/tsttests.dat: New file.
+ 	* ada/acats-2/support/widechr.a: New file.
+ 	* ada/acats-2/tests/a/a22006b.ada: New file.
+ 	* ada/acats-2/tests/a/a22006c.ada: New file.
+ 	* ada/acats-2/tests/a/a22006d.ada: New file.
+ 	* ada/acats-2/tests/a/a26007a.tst: New file.
+ 	* ada/acats-2/tests/a/a27003a.ada: New file.
+ 	* ada/acats-2/tests/a/a29003a.ada: New file.
+ 	* ada/acats-2/tests/a/a2a031a.ada: New file.
+ 	* ada/acats-2/tests/a/a33003a.ada: New file.
+ 	* ada/acats-2/tests/a/a34017c.ada: New file.
+ 	* ada/acats-2/tests/a/a35101b.ada: New file.
+ 	* ada/acats-2/tests/a/a35402a.ada: New file.
+ 	* ada/acats-2/tests/a/a35801f.ada: New file.
+ 	* ada/acats-2/tests/a/a35902c.ada: New file.
+ 	* ada/acats-2/tests/a/a38106d.ada: New file.
+ 	* ada/acats-2/tests/a/a38106e.ada: New file.
+ 	* ada/acats-2/tests/a/a49027a.ada: New file.
+ 	* ada/acats-2/tests/a/a49027b.ada: New file.
+ 	* ada/acats-2/tests/a/a49027c.ada: New file.
+ 	* ada/acats-2/tests/a/a54b01a.ada: New file.
+ 	* ada/acats-2/tests/a/a54b02a.ada: New file.
+ 	* ada/acats-2/tests/a/a55b12a.ada: New file.
+ 	* ada/acats-2/tests/a/a55b13a.ada: New file.
+ 	* ada/acats-2/tests/a/a55b14a.ada: New file.
+ 	* ada/acats-2/tests/a/a71004a.ada: New file.
+ 	* ada/acats-2/tests/a/a73001i.ada: New file.
+ 	* ada/acats-2/tests/a/a73001j.ada: New file.
+ 	* ada/acats-2/tests/a/a74105b.ada: New file.
+ 	* ada/acats-2/tests/a/a74106a.ada: New file.
+ 	* ada/acats-2/tests/a/a74106b.ada: New file.
+ 	* ada/acats-2/tests/a/a74106c.ada: New file.
+ 	* ada/acats-2/tests/a/a74205e.ada: New file.
+ 	* ada/acats-2/tests/a/a74205f.ada: New file.
+ 	* ada/acats-2/tests/a/a83009a.ada: New file.
+ 	* ada/acats-2/tests/a/a83009b.ada: New file.
+ 	* ada/acats-2/tests/a/a83a02a.ada: New file.
+ 	* ada/acats-2/tests/a/a83a02b.ada: New file.
+ 	* ada/acats-2/tests/a/a83a06a.ada: New file.
+ 	* ada/acats-2/tests/a/a83a08a.ada: New file.
+ 	* ada/acats-2/tests/a/a83c01c.ada: New file.
+ 	* ada/acats-2/tests/a/a83c01h.ada: New file.
+ 	* ada/acats-2/tests/a/a83c01i.ada: New file.
+ 	* ada/acats-2/tests/a/a85007d.ada: New file.
+ 	* ada/acats-2/tests/a/a85013b.ada: New file.
+ 	* ada/acats-2/tests/a/a87b59a.ada: New file.
+ 	* ada/acats-2/tests/a/a95001c.ada: New file.
+ 	* ada/acats-2/tests/a/a95074d.ada: New file.
+ 	* ada/acats-2/tests/a/a97106a.ada: New file.
+ 	* ada/acats-2/tests/a/a99006a.ada: New file.
+ 	* ada/acats-2/tests/a/aa2010a.ada: New file.
+ 	* ada/acats-2/tests/a/aa2012a.ada: New file.
+ 	* ada/acats-2/tests/a/ac1015b.ada: New file.
+ 	* ada/acats-2/tests/a/ac3106a.ada: New file.
+ 	* ada/acats-2/tests/a/ac3206a.ada: New file.
+ 	* ada/acats-2/tests/a/ac3207a.ada: New file.
+ 	* ada/acats-2/tests/a/ad7001b.ada: New file.
+ 	* ada/acats-2/tests/a/ad7001c0.ada: New file.
+ 	* ada/acats-2/tests/a/ad7001c1.ada: New file.
+ 	* ada/acats-2/tests/a/ad7001d0.ada: New file.
+ 	* ada/acats-2/tests/a/ad7001d1.ada: New file.
+ 	* ada/acats-2/tests/a/ad7006a.ada: New file.
+ 	* ada/acats-2/tests/a/ad7101a.ada: New file.
+ 	* ada/acats-2/tests/a/ad7101c.ada: New file.
+ 	* ada/acats-2/tests/a/ad7102a.ada: New file.
+ 	* ada/acats-2/tests/a/ad7103a.ada: New file.
+ 	* ada/acats-2/tests/a/ad7103c.ada: New file.
+ 	* ada/acats-2/tests/a/ad7104a.ada: New file.
+ 	* ada/acats-2/tests/a/ad7201a.ada: New file.
+ 	* ada/acats-2/tests/a/ad7203b.ada: New file.
+ 	* ada/acats-2/tests/a/ad7205b.ada: New file.
+ 	* ada/acats-2/tests/a/ad8011a.tst: New file.
+ 	* ada/acats-2/tests/a/ada101a.ada: New file.
+ 	* ada/acats-2/tests/a/ae2113a.ada: New file.
+ 	* ada/acats-2/tests/a/ae2113b.ada: New file.
+ 	* ada/acats-2/tests/a/ae3002g.ada: New file.
+ 	* ada/acats-2/tests/a/ae3101a.ada: New file.
+ 	* ada/acats-2/tests/a/ae3702a.ada: New file.
+ 	* ada/acats-2/tests/a/ae3709a.ada: New file.
+ 	* ada/acats-2/tests/c2/c23001a.ada: New file.
+ 	* ada/acats-2/tests/c2/c23003a.tst: New file.
+ 	* ada/acats-2/tests/c2/c23003b.tst: New file.
+ 	* ada/acats-2/tests/c2/c23003g.tst: New file.
+ 	* ada/acats-2/tests/c2/c23003i.tst: New file.
+ 	* ada/acats-2/tests/c2/c23006a.ada: New file.
+ 	* ada/acats-2/tests/c2/c23006b.ada: New file.
+ 	* ada/acats-2/tests/c2/c23006c.ada: New file.
+ 	* ada/acats-2/tests/c2/c23006d.ada: New file.
+ 	* ada/acats-2/tests/c2/c23006e.ada: New file.
+ 	* ada/acats-2/tests/c2/c23006f.ada: New file.
+ 	* ada/acats-2/tests/c2/c23006g.ada: New file.
+ 	* ada/acats-2/tests/c2/c24002d.ada: New file.
+ 	* ada/acats-2/tests/c2/c24003a.ada: New file.
+ 	* ada/acats-2/tests/c2/c24003b.ada: New file.
+ 	* ada/acats-2/tests/c2/c24003c.ada: New file.
+ 	* ada/acats-2/tests/c2/c24106a.ada: New file.
+ 	* ada/acats-2/tests/c2/c24202d.ada: New file.
+ 	* ada/acats-2/tests/c2/c24203a.ada: New file.
+ 	* ada/acats-2/tests/c2/c24203b.ada: New file.
+ 	* ada/acats-2/tests/c2/c24207a.ada: New file.
+ 	* ada/acats-2/tests/c2/c24211a.ada: New file.
+ 	* ada/acats-2/tests/c2/c250001.aw: New file.
+ 	* ada/acats-2/tests/c2/c250002.aw: New file.
+ 	* ada/acats-2/tests/c2/c25001a.ada: New file.
+ 	* ada/acats-2/tests/c2/c25001b.ada: New file.
+ 	* ada/acats-2/tests/c2/c26006a.ada: New file.
+ 	* ada/acats-2/tests/c2/c26008a.ada: New file.
+ 	* ada/acats-2/tests/c2/c2a001a.ada: New file.
+ 	* ada/acats-2/tests/c2/c2a001b.ada: New file.
+ 	* ada/acats-2/tests/c2/c2a001c.ada: New file.
+ 	* ada/acats-2/tests/c2/c2a002a.ada: New file.
+ 	* ada/acats-2/tests/c2/c2a008a.ada: New file.
+ 	* ada/acats-2/tests/c2/c2a021b.ada: New file.
+ 	* ada/acats-2/tests/c3/c32001a.ada: New file.
+ 	* ada/acats-2/tests/c3/c32001b.ada: New file.
+ 	* ada/acats-2/tests/c3/c32001c.ada: New file.
+ 	* ada/acats-2/tests/c3/c32001d.ada: New file.
+ 	* ada/acats-2/tests/c3/c32001e.ada: New file.
+ 	* ada/acats-2/tests/c3/c32107a.ada: New file.
+ 	* ada/acats-2/tests/c3/c32107c.ada: New file.
+ 	* ada/acats-2/tests/c3/c32108a.ada: New file.
+ 	* ada/acats-2/tests/c3/c32108b.ada: New file.
+ 	* ada/acats-2/tests/c3/c32111a.ada: New file.
+ 	* ada/acats-2/tests/c3/c32111b.ada: New file.
+ 	* ada/acats-2/tests/c3/c32112b.ada: New file.
+ 	* ada/acats-2/tests/c3/c32113a.ada: New file.
+ 	* ada/acats-2/tests/c3/c32115a.ada: New file.
+ 	* ada/acats-2/tests/c3/c32115b.ada: New file.
+ 	* ada/acats-2/tests/c3/c330001.a: New file.
+ 	* ada/acats-2/tests/c3/c330002.a: New file.
+ 	* ada/acats-2/tests/c3/c332001.a: New file.
+ 	* ada/acats-2/tests/c3/c340001.a: New file.
+ 	* ada/acats-2/tests/c3/c34001a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34001c.ada: New file.
+ 	* ada/acats-2/tests/c3/c34001d.ada: New file.
+ 	* ada/acats-2/tests/c3/c34001f.ada: New file.
+ 	* ada/acats-2/tests/c3/c34002a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34002c.ada: New file.
+ 	* ada/acats-2/tests/c3/c34003a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34003c.ada: New file.
+ 	* ada/acats-2/tests/c3/c34004a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34004c.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005c.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005d.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005f.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005g.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005i.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005j.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005l.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005m.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005o.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005p.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005r.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005s.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005u.ada: New file.
+ 	* ada/acats-2/tests/c3/c34005v.ada: New file.
+ 	* ada/acats-2/tests/c3/c34006a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34006d.ada: New file.
+ 	* ada/acats-2/tests/c3/c34006f.ada: New file.
+ 	* ada/acats-2/tests/c3/c34006g.ada: New file.
+ 	* ada/acats-2/tests/c3/c34006j.ada: New file.
+ 	* ada/acats-2/tests/c3/c34006l.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007d.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007f.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007g.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007i.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007j.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007m.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007p.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007r.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007s.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007u.ada: New file.
+ 	* ada/acats-2/tests/c3/c34007v.ada: New file.
+ 	* ada/acats-2/tests/c3/c34008a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34009a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34009d.ada: New file.
+ 	* ada/acats-2/tests/c3/c34009f.ada: New file.
+ 	* ada/acats-2/tests/c3/c34009g.ada: New file.
+ 	* ada/acats-2/tests/c3/c34009j.ada: New file.
+ 	* ada/acats-2/tests/c3/c34009l.ada: New file.
+ 	* ada/acats-2/tests/c3/c34011b.ada: New file.
+ 	* ada/acats-2/tests/c3/c34012a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014a.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014c.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014e.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014g.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014h.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014n.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014p.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014r.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014t.ada: New file.
+ 	* ada/acats-2/tests/c3/c34014u.ada: New file.
+ 	* ada/acats-2/tests/c3/c34018a.ada: New file.
+ 	* ada/acats-2/tests/c3/c340a01.a: New file.
+ 	* ada/acats-2/tests/c3/c340a02.a: New file.
+ 	* ada/acats-2/tests/c3/c341a01.a: New file.
+ 	* ada/acats-2/tests/c3/c341a02.a: New file.
+ 	* ada/acats-2/tests/c3/c341a03.a: New file.
+ 	* ada/acats-2/tests/c3/c341a04.a: New file.
+ 	* ada/acats-2/tests/c3/c35003a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35003b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35003d.ada: New file.
+ 	* ada/acats-2/tests/c3/c35102a.ada: New file.
+ 	* ada/acats-2/tests/c3/c352001.a: New file.
+ 	* ada/acats-2/tests/c3/c354002.a: New file.
+ 	* ada/acats-2/tests/c3/c354003.a: New file.
+ 	* ada/acats-2/tests/c3/c35502a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502c.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502d.tst: New file.
+ 	* ada/acats-2/tests/c3/c35502e.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502f.tst: New file.
+ 	* ada/acats-2/tests/c3/c35502g.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502h.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502i.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502j.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502k.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502l.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502m.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502n.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502o.ada: New file.
+ 	* ada/acats-2/tests/c3/c35502p.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503c.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503d.tst: New file.
+ 	* ada/acats-2/tests/c3/c35503e.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503f.tst: New file.
+ 	* ada/acats-2/tests/c3/c35503g.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503h.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503k.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503l.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503o.ada: New file.
+ 	* ada/acats-2/tests/c3/c35503p.ada: New file.
+ 	* ada/acats-2/tests/c3/c35504a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35504b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35505c.ada: New file.
+ 	* ada/acats-2/tests/c3/c35505e.ada: New file.
+ 	* ada/acats-2/tests/c3/c35505f.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507c.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507e.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507g.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507h.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507i.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507j.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507k.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507l.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507m.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507n.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507o.ada: New file.
+ 	* ada/acats-2/tests/c3/c35507p.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508c.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508e.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508g.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508h.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508k.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508l.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508o.ada: New file.
+ 	* ada/acats-2/tests/c3/c35508p.ada: New file.
+ 	* ada/acats-2/tests/c3/c35703a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35704a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35704b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35704c.ada: New file.
+ 	* ada/acats-2/tests/c3/c35704d.ada: New file.
+ 	* ada/acats-2/tests/c3/c35801d.ada: New file.
+ 	* ada/acats-2/tests/c3/c35902d.ada: New file.
+ 	* ada/acats-2/tests/c3/c35904a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35904b.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a02a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a05a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a05d.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a05n.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a05q.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a07a.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a07d.ada: New file.
+ 	* ada/acats-2/tests/c3/c35a08b.ada: New file.
+ 	* ada/acats-2/tests/c3/c360002.a: New file.
+ 	* ada/acats-2/tests/c3/c36104a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36104b.ada: New file.
+ 	* ada/acats-2/tests/c3/c36172a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36172b.ada: New file.
+ 	* ada/acats-2/tests/c3/c36172c.ada: New file.
+ 	* ada/acats-2/tests/c3/c36174a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36180a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36202c.ada: New file.
+ 	* ada/acats-2/tests/c3/c36203a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36204a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36204b.ada: New file.
+ 	* ada/acats-2/tests/c3/c36204c.ada: New file.
+ 	* ada/acats-2/tests/c3/c36204d.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205b.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205c.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205d.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205e.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205f.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205g.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205h.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205i.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205j.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205k.ada: New file.
+ 	* ada/acats-2/tests/c3/c36205l.ada: New file.
+ 	* ada/acats-2/tests/c3/c36301a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36301b.ada: New file.
+ 	* ada/acats-2/tests/c3/c36302a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36304a.ada: New file.
+ 	* ada/acats-2/tests/c3/c36305a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37002a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37003a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37003b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37005a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37006a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37008a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37008b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37009a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37010a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37010b.ada: New file.
+ 	* ada/acats-2/tests/c3/c371001.a: New file.
+ 	* ada/acats-2/tests/c3/c371002.a: New file.
+ 	* ada/acats-2/tests/c3/c371003.a: New file.
+ 	* ada/acats-2/tests/c3/c37102b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37103a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37105a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37107a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37108b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37206a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37207a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37208a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37208b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37209a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37209b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37210a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37211a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37211b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37211c.ada: New file.
+ 	* ada/acats-2/tests/c3/c37211d.ada: New file.
+ 	* ada/acats-2/tests/c3/c37211e.ada: New file.
+ 	* ada/acats-2/tests/c3/c37213b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37213d.ada: New file.
+ 	* ada/acats-2/tests/c3/c37213f.ada: New file.
+ 	* ada/acats-2/tests/c3/c37213h.ada: New file.
+ 	* ada/acats-2/tests/c3/c37213j.ada: New file.
+ 	* ada/acats-2/tests/c3/c37213k.ada: New file.
+ 	* ada/acats-2/tests/c3/c37213l.ada: New file.
+ 	* ada/acats-2/tests/c3/c37215b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37215d.ada: New file.
+ 	* ada/acats-2/tests/c3/c37215f.ada: New file.
+ 	* ada/acats-2/tests/c3/c37215h.ada: New file.
+ 	* ada/acats-2/tests/c3/c37217a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37217b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37217c.ada: New file.
+ 	* ada/acats-2/tests/c3/c37304a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37305a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37306a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37309a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37310a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37312a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37402a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37403a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37404a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37404b.ada: New file.
+ 	* ada/acats-2/tests/c3/c37405a.ada: New file.
+ 	* ada/acats-2/tests/c3/c37411a.ada: New file.
+ 	* ada/acats-2/tests/c3/c380001.a: New file.
+ 	* ada/acats-2/tests/c3/c380002.a: New file.
+ 	* ada/acats-2/tests/c3/c380003.a: New file.
+ 	* ada/acats-2/tests/c3/c380004.a: New file.
+ 	* ada/acats-2/tests/c3/c38002a.ada: New file.
+ 	* ada/acats-2/tests/c3/c38002b.ada: New file.
+ 	* ada/acats-2/tests/c3/c38005a.ada: New file.
+ 	* ada/acats-2/tests/c3/c38005b.ada: New file.
+ 	* ada/acats-2/tests/c3/c38005c.ada: New file.
+ 	* ada/acats-2/tests/c3/c38006a.ada: New file.
+ 	* ada/acats-2/tests/c3/c38102a.ada: New file.
+ 	* ada/acats-2/tests/c3/c38102b.ada: New file.
+ 	* ada/acats-2/tests/c3/c38102c.ada: New file.
+ 	* ada/acats-2/tests/c3/c38102d.ada: New file.
+ 	* ada/acats-2/tests/c3/c38102e.ada: New file.
+ 	* ada/acats-2/tests/c3/c38104a.ada: New file.
+ 	* ada/acats-2/tests/c3/c38107a.ada: New file.
+ 	* ada/acats-2/tests/c3/c38107b.ada: New file.
+ 	* ada/acats-2/tests/c3/c38108a.ada: New file.
+ 	* ada/acats-2/tests/c3/c38108b.ada: New file.
+ 	* ada/acats-2/tests/c3/c38108c0.ada: New file.
+ 	* ada/acats-2/tests/c3/c38108c1.ada: New file.
+ 	* ada/acats-2/tests/c3/c38108c2.ada: New file.
+ 	* ada/acats-2/tests/c3/c38108d0.ada: New file.
+ 	* ada/acats-2/tests/c3/c38108d1.ada: New file.
+ 	* ada/acats-2/tests/c3/c38202a.ada: New file.
+ 	* ada/acats-2/tests/c3/c3900010.a: New file.
+ 	* ada/acats-2/tests/c3/c3900011.am: New file.
+ 	* ada/acats-2/tests/c3/c390002.a: New file.
+ 	* ada/acats-2/tests/c3/c390003.a: New file.
+ 	* ada/acats-2/tests/c3/c390004.a: New file.
+ 	* ada/acats-2/tests/c3/c3900050.a: New file.
+ 	* ada/acats-2/tests/c3/c3900051.a: New file.
+ 	* ada/acats-2/tests/c3/c3900052.a: New file.
+ 	* ada/acats-2/tests/c3/c3900053.am: New file.
+ 	* ada/acats-2/tests/c3/c3900060.a: New file.
+ 	* ada/acats-2/tests/c3/c3900061.a: New file.
+ 	* ada/acats-2/tests/c3/c3900062.a: New file.
+ 	* ada/acats-2/tests/c3/c3900063.am: New file.
+ 	* ada/acats-2/tests/c3/c390007.a: New file.
+ 	* ada/acats-2/tests/c3/c390010.a: New file.
+ 	* ada/acats-2/tests/c3/c390011.a: New file.
+ 	* ada/acats-2/tests/c3/c39006a.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006b.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006c0.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006c1.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006d.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006e.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006f0.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006f1.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006f2.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006f3.ada: New file.
+ 	* ada/acats-2/tests/c3/c39006g.ada: New file.
+ 	* ada/acats-2/tests/c3/c39007a.ada: New file.
+ 	* ada/acats-2/tests/c3/c39007b.ada: New file.
+ 	* ada/acats-2/tests/c3/c39008a.ada: New file.
+ 	* ada/acats-2/tests/c3/c39008b.ada: New file.
+ 	* ada/acats-2/tests/c3/c39008c.ada: New file.
+ 	* ada/acats-2/tests/c3/c390a010.a: New file.
+ 	* ada/acats-2/tests/c3/c390a011.am: New file.
+ 	* ada/acats-2/tests/c3/c390a020.a: New file.
+ 	* ada/acats-2/tests/c3/c390a021.a: New file.
+ 	* ada/acats-2/tests/c3/c390a022.am: New file.
+ 	* ada/acats-2/tests/c3/c390a030.a: New file.
+ 	* ada/acats-2/tests/c3/c390a031.am: New file.
+ 	* ada/acats-2/tests/c3/c391001.a: New file.
+ 	* ada/acats-2/tests/c3/c391002.a: New file.
+ 	* ada/acats-2/tests/c3/c392002.a: New file.
+ 	* ada/acats-2/tests/c3/c392003.a: New file.
+ 	* ada/acats-2/tests/c3/c392004.a: New file.
+ 	* ada/acats-2/tests/c3/c392005.a: New file.
+ 	* ada/acats-2/tests/c3/c392008.a: New file.
+ 	* ada/acats-2/tests/c3/c392010.a: New file.
+ 	* ada/acats-2/tests/c3/c392011.a: New file.
+ 	* ada/acats-2/tests/c3/c392013.a: New file.
+ 	* ada/acats-2/tests/c3/c392014.a: New file.
+ 	* ada/acats-2/tests/c3/c392a01.a: New file.
+ 	* ada/acats-2/tests/c3/c392c05.a: New file.
+ 	* ada/acats-2/tests/c3/c392c07.a: New file.
+ 	* ada/acats-2/tests/c3/c392d01.a: New file.
+ 	* ada/acats-2/tests/c3/c392d02.a: New file.
+ 	* ada/acats-2/tests/c3/c392d03.a: New file.
+ 	* ada/acats-2/tests/c3/c393001.a: New file.
+ 	* ada/acats-2/tests/c3/c393007.a: New file.
+ 	* ada/acats-2/tests/c3/c393008.a: New file.
+ 	* ada/acats-2/tests/c3/c393009.a: New file.
+ 	* ada/acats-2/tests/c3/c393010.a: New file.
+ 	* ada/acats-2/tests/c3/c393011.a: New file.
+ 	* ada/acats-2/tests/c3/c393012.a: New file.
+ 	* ada/acats-2/tests/c3/c393a02.a: New file.
+ 	* ada/acats-2/tests/c3/c393a03.a: New file.
+ 	* ada/acats-2/tests/c3/c393a05.a: New file.
+ 	* ada/acats-2/tests/c3/c393a06.a: New file.
+ 	* ada/acats-2/tests/c3/c393b12.a: New file.
+ 	* ada/acats-2/tests/c3/c393b13.a: New file.
+ 	* ada/acats-2/tests/c3/c393b14.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0001.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0002.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0003.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0004.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0005.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0006.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0007.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0008.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0009.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0010.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0011.a: New file.
+ 	* ada/acats-2/tests/c3/c3a00120.a: New file.
+ 	* ada/acats-2/tests/c3/c3a00121.a: New file.
+ 	* ada/acats-2/tests/c3/c3a00122.am: New file.
+ 	* ada/acats-2/tests/c3/c3a0013.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0014.a: New file.
+ 	* ada/acats-2/tests/c3/c3a0015.a: New file.
+ 	* ada/acats-2/tests/c3/c3a1001.a: New file.
+ 	* ada/acats-2/tests/c3/c3a1002.a: New file.
+ 	* ada/acats-2/tests/c3/c3a2001.a: New file.
+ 	* ada/acats-2/tests/c3/c3a2002.a: New file.
+ 	* ada/acats-2/tests/c3/c3a2003.a: New file.
+ 	* ada/acats-2/tests/c3/c3a2a01.a: New file.
+ 	* ada/acats-2/tests/c3/c3a2a02.a: New file.
+ 	* ada/acats-2/tests/c4/c410001.a: New file.
+ 	* ada/acats-2/tests/c4/c41101d.ada: New file.
+ 	* ada/acats-2/tests/c4/c41103a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41103b.ada: New file.
+ 	* ada/acats-2/tests/c4/c41104a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41105a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41107a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41201d.ada: New file.
+ 	* ada/acats-2/tests/c4/c41203a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41203b.ada: New file.
+ 	* ada/acats-2/tests/c4/c41204a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41205a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41206a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41207a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41301a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303b.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303c.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303e.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303f.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303g.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303i.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303j.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303k.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303m.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303n.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303o.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303q.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303r.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303s.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303u.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303v.ada: New file.
+ 	* ada/acats-2/tests/c4/c41303w.ada: New file.
+ 	* ada/acats-2/tests/c4/c41304a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41304b.ada: New file.
+ 	* ada/acats-2/tests/c4/c41306a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41306b.ada: New file.
+ 	* ada/acats-2/tests/c4/c41306c.ada: New file.
+ 	* ada/acats-2/tests/c4/c41307d.ada: New file.
+ 	* ada/acats-2/tests/c4/c41309a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41320a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41321a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41322a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41323a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41324a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41325a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41326a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41327a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41328a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41401a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41402a.ada: New file.
+ 	* ada/acats-2/tests/c4/c41404a.ada: New file.
+ 	* ada/acats-2/tests/c4/c420001.a: New file.
+ 	* ada/acats-2/tests/c4/c42006a.ada: New file.
+ 	* ada/acats-2/tests/c4/c42007e.ada: New file.
+ 	* ada/acats-2/tests/c4/c43003a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43004a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43004c.ada: New file.
+ 	* ada/acats-2/tests/c4/c431001.a: New file.
+ 	* ada/acats-2/tests/c4/c43103a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43103b.ada: New file.
+ 	* ada/acats-2/tests/c4/c43104a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43105a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43105b.ada: New file.
+ 	* ada/acats-2/tests/c4/c43106a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43107a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43108a.ada: New file.
+ 	* ada/acats-2/tests/c4/c432001.a: New file.
+ 	* ada/acats-2/tests/c4/c432002.a: New file.
+ 	* ada/acats-2/tests/c4/c432003.a: New file.
+ 	* ada/acats-2/tests/c4/c432004.a: New file.
+ 	* ada/acats-2/tests/c4/c43204a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43204c.ada: New file.
+ 	* ada/acats-2/tests/c4/c43204e.ada: New file.
+ 	* ada/acats-2/tests/c4/c43204f.ada: New file.
+ 	* ada/acats-2/tests/c4/c43204g.ada: New file.
+ 	* ada/acats-2/tests/c4/c43204h.ada: New file.
+ 	* ada/acats-2/tests/c4/c43204i.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205b.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205c.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205d.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205e.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205g.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205h.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205i.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205j.ada: New file.
+ 	* ada/acats-2/tests/c4/c43205k.ada: New file.
+ 	* ada/acats-2/tests/c4/c43206a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43207b.ada: New file.
+ 	* ada/acats-2/tests/c4/c43207d.ada: New file.
+ 	* ada/acats-2/tests/c4/c43208a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43208b.ada: New file.
+ 	* ada/acats-2/tests/c4/c43209a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43210a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43211a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43212a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43212c.ada: New file.
+ 	* ada/acats-2/tests/c4/c43214a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43214b.ada: New file.
+ 	* ada/acats-2/tests/c4/c43214c.ada: New file.
+ 	* ada/acats-2/tests/c4/c43214d.ada: New file.
+ 	* ada/acats-2/tests/c4/c43214e.ada: New file.
+ 	* ada/acats-2/tests/c4/c43214f.ada: New file.
+ 	* ada/acats-2/tests/c4/c43215a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43215b.ada: New file.
+ 	* ada/acats-2/tests/c4/c43222a.ada: New file.
+ 	* ada/acats-2/tests/c4/c43224a.ada: New file.
+ 	* ada/acats-2/tests/c4/c433001.a: New file.
+ 	* ada/acats-2/tests/c4/c44003d.ada: New file.
+ 	* ada/acats-2/tests/c4/c44003f.ada: New file.
+ 	* ada/acats-2/tests/c4/c44003g.ada: New file.
+ 	* ada/acats-2/tests/c4/c450001.a: New file.
+ 	* ada/acats-2/tests/c4/c45112a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45112b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45113a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45114b.ada: New file.
+ 	* ada/acats-2/tests/c4/c452001.a: New file.
+ 	* ada/acats-2/tests/c4/c45201a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45201b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45202b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45210a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45211a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45220a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45220b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45220c.ada: New file.
+ 	* ada/acats-2/tests/c4/c45220d.ada: New file.
+ 	* ada/acats-2/tests/c4/c45220e.ada: New file.
+ 	* ada/acats-2/tests/c4/c45220f.ada: New file.
+ 	* ada/acats-2/tests/c4/c45231a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45231b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45231c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45231d.tst: New file.
+ 	* ada/acats-2/tests/c4/c45232b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45242b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45251a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45252a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45252b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45253a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45262a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45262b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45262c.ada: New file.
+ 	* ada/acats-2/tests/c4/c45262d.ada: New file.
+ 	* ada/acats-2/tests/c4/c45264a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45264b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45264c.ada: New file.
+ 	* ada/acats-2/tests/c4/c45265a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45271a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45272a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45273a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45274a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45274b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45274c.ada: New file.
+ 	* ada/acats-2/tests/c4/c45281a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45282a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45282b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45291a.ada: New file.
+ 	* ada/acats-2/tests/c4/c453001.a: New file.
+ 	* ada/acats-2/tests/c4/c45303a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45304a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45304b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45304c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45322a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45323a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45331a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45342a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45343a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45344a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45345b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45347a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45347b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45347c.ada: New file.
+ 	* ada/acats-2/tests/c4/c45347d.ada: New file.
+ 	* ada/acats-2/tests/c4/c45411a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45411b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45411c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45411d.ada: New file.
+ 	* ada/acats-2/tests/c4/c45413a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45431a.ada: New file.
+ 	* ada/acats-2/tests/c4/c455001.a: New file.
+ 	* ada/acats-2/tests/c4/c45502b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45502c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45503a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45503b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45503c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45504a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45504b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45504c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45504d.ada: New file.
+ 	* ada/acats-2/tests/c4/c45504e.dep: New file.
+ 	* ada/acats-2/tests/c4/c45504f.dep: New file.
+ 	* ada/acats-2/tests/c4/c45505a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45523a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531c.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531d.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531e.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531f.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531g.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531h.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531i.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531j.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531k.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531l.ada: New file.
+ 	* ada/acats-2/tests/c4/c45531m.dep: New file.
+ 	* ada/acats-2/tests/c4/c45531n.dep: New file.
+ 	* ada/acats-2/tests/c4/c45531o.dep: New file.
+ 	* ada/acats-2/tests/c4/c45531p.dep: New file.
+ 	* ada/acats-2/tests/c4/c45532a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532c.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532d.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532e.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532f.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532g.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532h.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532i.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532j.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532k.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532l.ada: New file.
+ 	* ada/acats-2/tests/c4/c45532m.dep: New file.
+ 	* ada/acats-2/tests/c4/c45532n.dep: New file.
+ 	* ada/acats-2/tests/c4/c45532o.dep: New file.
+ 	* ada/acats-2/tests/c4/c45532p.dep: New file.
+ 	* ada/acats-2/tests/c4/c45534b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45536a.dep: New file.
+ 	* ada/acats-2/tests/c4/c456001.a: New file.
+ 	* ada/acats-2/tests/c4/c45611a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45611b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45611c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45613a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45613b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45613c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45614a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45614b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45614c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45631a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45631b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45631c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45632a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45632b.dep: New file.
+ 	* ada/acats-2/tests/c4/c45632c.dep: New file.
+ 	* ada/acats-2/tests/c4/c45651a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45662a.ada: New file.
+ 	* ada/acats-2/tests/c4/c45662b.ada: New file.
+ 	* ada/acats-2/tests/c4/c45672a.ada: New file.
+ 	* ada/acats-2/tests/c4/c460001.a: New file.
+ 	* ada/acats-2/tests/c4/c460002.a: New file.
+ 	* ada/acats-2/tests/c4/c460004.a: New file.
+ 	* ada/acats-2/tests/c4/c460005.a: New file.
+ 	* ada/acats-2/tests/c4/c460006.a: New file.
+ 	* ada/acats-2/tests/c4/c460007.a: New file.
+ 	* ada/acats-2/tests/c4/c460008.a: New file.
+ 	* ada/acats-2/tests/c4/c460009.a: New file.
+ 	* ada/acats-2/tests/c4/c460010.a: New file.
+ 	* ada/acats-2/tests/c4/c460011.a: New file.
+ 	* ada/acats-2/tests/c4/c460012.a: New file.
+ 	* ada/acats-2/tests/c4/c460013.a: New file.
+ 	* ada/acats-2/tests/c4/c460014.a: New file.
+ 	* ada/acats-2/tests/c4/c46011a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46013a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46014a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46021a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46024a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46031a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46032a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46033a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46041a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46042a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46043b.ada: New file.
+ 	* ada/acats-2/tests/c4/c46044b.ada: New file.
+ 	* ada/acats-2/tests/c4/c46051a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46051b.ada: New file.
+ 	* ada/acats-2/tests/c4/c46051c.ada: New file.
+ 	* ada/acats-2/tests/c4/c46052a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46053a.ada: New file.
+ 	* ada/acats-2/tests/c4/c46054a.ada: New file.
+ 	* ada/acats-2/tests/c4/c460a01.a: New file.
+ 	* ada/acats-2/tests/c4/c460a02.a: New file.
+ 	* ada/acats-2/tests/c4/c47002a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47002b.ada: New file.
+ 	* ada/acats-2/tests/c4/c47002c.ada: New file.
+ 	* ada/acats-2/tests/c4/c47002d.ada: New file.
+ 	* ada/acats-2/tests/c4/c47003a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47004a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47005a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47006a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47007a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47008a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47009a.ada: New file.
+ 	* ada/acats-2/tests/c4/c47009b.ada: New file.
+ 	* ada/acats-2/tests/c4/c48004a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48004b.ada: New file.
+ 	* ada/acats-2/tests/c4/c48004c.ada: New file.
+ 	* ada/acats-2/tests/c4/c48004d.ada: New file.
+ 	* ada/acats-2/tests/c4/c48004e.ada: New file.
+ 	* ada/acats-2/tests/c4/c48004f.ada: New file.
+ 	* ada/acats-2/tests/c4/c48005a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48005b.ada: New file.
+ 	* ada/acats-2/tests/c4/c48006a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48006b.ada: New file.
+ 	* ada/acats-2/tests/c4/c48007a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48007b.ada: New file.
+ 	* ada/acats-2/tests/c4/c48007c.ada: New file.
+ 	* ada/acats-2/tests/c4/c48008a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48008c.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009b.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009c.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009d.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009e.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009f.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009g.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009h.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009i.ada: New file.
+ 	* ada/acats-2/tests/c4/c48009j.ada: New file.
+ 	* ada/acats-2/tests/c4/c48010a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48011a.ada: New file.
+ 	* ada/acats-2/tests/c4/c48012a.ada: New file.
+ 	* ada/acats-2/tests/c4/c490001.a: New file.
+ 	* ada/acats-2/tests/c4/c490002.a: New file.
+ 	* ada/acats-2/tests/c4/c490003.a: New file.
+ 	* ada/acats-2/tests/c4/c49020a.ada: New file.
+ 	* ada/acats-2/tests/c4/c49021a.ada: New file.
+ 	* ada/acats-2/tests/c4/c49022a.ada: New file.
+ 	* ada/acats-2/tests/c4/c49022b.ada: New file.
+ 	* ada/acats-2/tests/c4/c49022c.ada: New file.
+ 	* ada/acats-2/tests/c4/c49023a.ada: New file.
+ 	* ada/acats-2/tests/c4/c49024a.ada: New file.
+ 	* ada/acats-2/tests/c4/c49025a.ada: New file.
+ 	* ada/acats-2/tests/c4/c49026a.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a005b.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a006a.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a007a.tst: New file.
+ 	* ada/acats-2/tests/c4/c4a010a.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a010b.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a011a.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a012b.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a013a.ada: New file.
+ 	* ada/acats-2/tests/c4/c4a014a.ada: New file.
+ 	* ada/acats-2/tests/c5/c51004a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52005a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52005b.ada: New file.
+ 	* ada/acats-2/tests/c5/c52005c.ada: New file.
+ 	* ada/acats-2/tests/c5/c52005d.ada: New file.
+ 	* ada/acats-2/tests/c5/c52005e.ada: New file.
+ 	* ada/acats-2/tests/c5/c52005f.ada: New file.
+ 	* ada/acats-2/tests/c5/c52008a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52008b.ada: New file.
+ 	* ada/acats-2/tests/c5/c52009a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52009b.ada: New file.
+ 	* ada/acats-2/tests/c5/c52010a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52011a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52011b.ada: New file.
+ 	* ada/acats-2/tests/c5/c52101a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52102a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52102b.ada: New file.
+ 	* ada/acats-2/tests/c5/c52102c.ada: New file.
+ 	* ada/acats-2/tests/c5/c52102d.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103b.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103c.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103f.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103g.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103h.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103k.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103l.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103m.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103p.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103q.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103r.ada: New file.
+ 	* ada/acats-2/tests/c5/c52103x.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104a.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104b.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104c.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104f.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104g.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104h.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104k.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104l.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104m.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104p.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104q.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104r.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104x.ada: New file.
+ 	* ada/acats-2/tests/c5/c52104y.ada: New file.
+ 	* ada/acats-2/tests/c5/c53007a.ada: New file.
+ 	* ada/acats-2/tests/c5/c540001.a: New file.
+ 	* ada/acats-2/tests/c5/c54a03a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a04a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a07a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a13a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a13b.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a13c.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a13d.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a22a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a23a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a24a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a24b.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a42a.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a42b.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a42c.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a42d.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a42e.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a42f.ada: New file.
+ 	* ada/acats-2/tests/c5/c54a42g.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b03a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b04a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b05a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b06a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b06b.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b07a.dep: New file.
+ 	* ada/acats-2/tests/c5/c55b07b.dep: New file.
+ 	* ada/acats-2/tests/c5/c55b10a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b11a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b11b.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b15a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55b16a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55c02a.ada: New file.
+ 	* ada/acats-2/tests/c5/c55c02b.ada: New file.
+ 	* ada/acats-2/tests/c5/c56002a.ada: New file.
+ 	* ada/acats-2/tests/c5/c57003a.ada: New file.
+ 	* ada/acats-2/tests/c5/c57004a.ada: New file.
+ 	* ada/acats-2/tests/c5/c57004b.ada: New file.
+ 	* ada/acats-2/tests/c5/c58004c.ada: New file.
+ 	* ada/acats-2/tests/c5/c58004d.ada: New file.
+ 	* ada/acats-2/tests/c5/c58004g.ada: New file.
+ 	* ada/acats-2/tests/c5/c58005a.ada: New file.
+ 	* ada/acats-2/tests/c5/c58005b.ada: New file.
+ 	* ada/acats-2/tests/c5/c58005h.ada: New file.
+ 	* ada/acats-2/tests/c5/c58006a.ada: New file.
+ 	* ada/acats-2/tests/c5/c58006b.ada: New file.
+ 	* ada/acats-2/tests/c5/c59002a.ada: New file.
+ 	* ada/acats-2/tests/c5/c59002b.ada: New file.
+ 	* ada/acats-2/tests/c5/c59002c.ada: New file.
+ 	* ada/acats-2/tests/c6/c61008a.ada: New file.
+ 	* ada/acats-2/tests/c6/c61009a.ada: New file.
+ 	* ada/acats-2/tests/c6/c61010a.ada: New file.
+ 	* ada/acats-2/tests/c6/c620001.a: New file.
+ 	* ada/acats-2/tests/c6/c620002.a: New file.
+ 	* ada/acats-2/tests/c6/c62002a.ada: New file.
+ 	* ada/acats-2/tests/c6/c62003a.ada: New file.
+ 	* ada/acats-2/tests/c6/c62003b.ada: New file.
+ 	* ada/acats-2/tests/c6/c62004a.ada: New file.
+ 	* ada/acats-2/tests/c6/c62006a.ada: New file.
+ 	* ada/acats-2/tests/c6/c631001.a: New file.
+ 	* ada/acats-2/tests/c6/c640001.a: New file.
+ 	* ada/acats-2/tests/c6/c64002b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64004g.ada: New file.
+ 	* ada/acats-2/tests/c6/c64005a.ada: New file.
+ 	* ada/acats-2/tests/c6/c64005b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64005c.ada: New file.
+ 	* ada/acats-2/tests/c6/c64005d0.ada: New file.
+ 	* ada/acats-2/tests/c6/c64005da.ada: New file.
+ 	* ada/acats-2/tests/c6/c64005db.ada: New file.
+ 	* ada/acats-2/tests/c6/c64005dc.ada: New file.
+ 	* ada/acats-2/tests/c6/c641001.a: New file.
+ 	* ada/acats-2/tests/c6/c64103b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64103c.ada: New file.
+ 	* ada/acats-2/tests/c6/c64103d.ada: New file.
+ 	* ada/acats-2/tests/c6/c64103e.ada: New file.
+ 	* ada/acats-2/tests/c6/c64103f.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104a.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104c.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104d.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104e.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104f.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104g.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104h.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104i.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104j.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104k.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104l.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104m.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104n.ada: New file.
+ 	* ada/acats-2/tests/c6/c64104o.ada: New file.
+ 	* ada/acats-2/tests/c6/c64105a.ada: New file.
+ 	* ada/acats-2/tests/c6/c64105b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64105c.ada: New file.
+ 	* ada/acats-2/tests/c6/c64105d.ada: New file.
+ 	* ada/acats-2/tests/c6/c64106a.ada: New file.
+ 	* ada/acats-2/tests/c6/c64106b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64106c.ada: New file.
+ 	* ada/acats-2/tests/c6/c64106d.ada: New file.
+ 	* ada/acats-2/tests/c6/c64107a.ada: New file.
+ 	* ada/acats-2/tests/c6/c64108a.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109a.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109c.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109d.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109e.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109f.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109g.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109h.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109i.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109j.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109k.ada: New file.
+ 	* ada/acats-2/tests/c6/c64109l.ada: New file.
+ 	* ada/acats-2/tests/c6/c64201b.ada: New file.
+ 	* ada/acats-2/tests/c6/c64201c.ada: New file.
+ 	* ada/acats-2/tests/c6/c64202a.ada: New file.
+ 	* ada/acats-2/tests/c6/c650001.a: New file.
+ 	* ada/acats-2/tests/c6/c65003a.ada: New file.
+ 	* ada/acats-2/tests/c6/c65003b.ada: New file.
+ 	* ada/acats-2/tests/c6/c66002a.ada: New file.
+ 	* ada/acats-2/tests/c6/c66002c.ada: New file.
+ 	* ada/acats-2/tests/c6/c66002d.ada: New file.
+ 	* ada/acats-2/tests/c6/c66002e.ada: New file.
+ 	* ada/acats-2/tests/c6/c66002f.ada: New file.
+ 	* ada/acats-2/tests/c6/c66002g.ada: New file.
+ 	* ada/acats-2/tests/c6/c67002a.ada: New file.
+ 	* ada/acats-2/tests/c6/c67002b.ada: New file.
+ 	* ada/acats-2/tests/c6/c67002c.ada: New file.
+ 	* ada/acats-2/tests/c6/c67002d.ada: New file.
+ 	* ada/acats-2/tests/c6/c67002e.ada: New file.
+ 	* ada/acats-2/tests/c6/c67003f.ada: New file.
+ 	* ada/acats-2/tests/c6/c67005a.ada: New file.
+ 	* ada/acats-2/tests/c6/c67005b.ada: New file.
+ 	* ada/acats-2/tests/c6/c67005c.ada: New file.
+ 	* ada/acats-2/tests/c6/c67005d.ada: New file.
+ 	* ada/acats-2/tests/c7/c72001b.ada: New file.
+ 	* ada/acats-2/tests/c7/c72002a.ada: New file.
+ 	* ada/acats-2/tests/c7/c730001.a: New file.
+ 	* ada/acats-2/tests/c7/c730002.a: New file.
+ 	* ada/acats-2/tests/c7/c730003.a: New file.
+ 	* ada/acats-2/tests/c7/c730004.a: New file.
+ 	* ada/acats-2/tests/c7/c73002a.ada: New file.
+ 	* ada/acats-2/tests/c7/c730a01.a: New file.
+ 	* ada/acats-2/tests/c7/c730a02.a: New file.
+ 	* ada/acats-2/tests/c7/c731001.a: New file.
+ 	* ada/acats-2/tests/c7/c74004a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74203a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74206a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74207b.ada: New file.
+ 	* ada/acats-2/tests/c7/c74208a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74208b.ada: New file.
+ 	* ada/acats-2/tests/c7/c74209a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74210a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74211a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74211b.ada: New file.
+ 	* ada/acats-2/tests/c7/c74302a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74302b.ada: New file.
+ 	* ada/acats-2/tests/c7/c74305a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74305b.ada: New file.
+ 	* ada/acats-2/tests/c7/c74306a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74307a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74401d.ada: New file.
+ 	* ada/acats-2/tests/c7/c74401e.ada: New file.
+ 	* ada/acats-2/tests/c7/c74401k.ada: New file.
+ 	* ada/acats-2/tests/c7/c74401q.ada: New file.
+ 	* ada/acats-2/tests/c7/c74402a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74402b.ada: New file.
+ 	* ada/acats-2/tests/c7/c74406a.ada: New file.
+ 	* ada/acats-2/tests/c7/c74407b.ada: New file.
+ 	* ada/acats-2/tests/c7/c74409b.ada: New file.
+ 	* ada/acats-2/tests/c7/c760001.a: New file.
+ 	* ada/acats-2/tests/c7/c760002.a: New file.
+ 	* ada/acats-2/tests/c7/c760007.a: New file.
+ 	* ada/acats-2/tests/c7/c760009.a: New file.
+ 	* ada/acats-2/tests/c7/c760010.a: New file.
+ 	* ada/acats-2/tests/c7/c760011.a: New file.
+ 	* ada/acats-2/tests/c7/c760012.a: New file.
+ 	* ada/acats-2/tests/c7/c760013.a: New file.
+ 	* ada/acats-2/tests/c7/c761001.a: New file.
+ 	* ada/acats-2/tests/c7/c761002.a: New file.
+ 	* ada/acats-2/tests/c7/c761003.a: New file.
+ 	* ada/acats-2/tests/c7/c761004.a: New file.
+ 	* ada/acats-2/tests/c7/c761005.a: New file.
+ 	* ada/acats-2/tests/c7/c761006.a: New file.
+ 	* ada/acats-2/tests/c7/c761007.a: New file.
+ 	* ada/acats-2/tests/c7/c761010.a: New file.
+ 	* ada/acats-2/tests/c7/c761011.a: New file.
+ 	* ada/acats-2/tests/c7/c761012.a: New file.
+ 	* ada/acats-2/tests/c8/c83007a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83012d.ada: New file.
+ 	* ada/acats-2/tests/c8/c83022a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83022g0.ada: New file.
+ 	* ada/acats-2/tests/c8/c83022g1.ada: New file.
+ 	* ada/acats-2/tests/c8/c83023a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83024a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83024e0.ada: New file.
+ 	* ada/acats-2/tests/c8/c83024e1.ada: New file.
+ 	* ada/acats-2/tests/c8/c83025a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83025c.ada: New file.
+ 	* ada/acats-2/tests/c8/c83027a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83027c.ada: New file.
+ 	* ada/acats-2/tests/c8/c83028a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83029a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83030a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83030c.ada: New file.
+ 	* ada/acats-2/tests/c8/c83031a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83031c.ada: New file.
+ 	* ada/acats-2/tests/c8/c83031e.ada: New file.
+ 	* ada/acats-2/tests/c8/c83032a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83033a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83051a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83b02a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83b02b.ada: New file.
+ 	* ada/acats-2/tests/c8/c83e02a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83e02b.ada: New file.
+ 	* ada/acats-2/tests/c8/c83e03a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f01a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f01b.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f01c0.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f01c1.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f01c2.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f01d0.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f01d1.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f03a.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f03b.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f03c0.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f03c1.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f03c2.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f03d0.ada: New file.
+ 	* ada/acats-2/tests/c8/c83f03d1.ada: New file.
+ 	* ada/acats-2/tests/c8/c840001.a: New file.
+ 	* ada/acats-2/tests/c8/c84002a.ada: New file.
+ 	* ada/acats-2/tests/c8/c84005a.ada: New file.
+ 	* ada/acats-2/tests/c8/c84008a.ada: New file.
+ 	* ada/acats-2/tests/c8/c84009a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85004b.ada: New file.
+ 	* ada/acats-2/tests/c8/c85005a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85005b.ada: New file.
+ 	* ada/acats-2/tests/c8/c85005c.ada: New file.
+ 	* ada/acats-2/tests/c8/c85005d.ada: New file.
+ 	* ada/acats-2/tests/c8/c85005e.ada: New file.
+ 	* ada/acats-2/tests/c8/c85005f.ada: New file.
+ 	* ada/acats-2/tests/c8/c85005g.ada: New file.
+ 	* ada/acats-2/tests/c8/c85006a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85006b.ada: New file.
+ 	* ada/acats-2/tests/c8/c85006c.ada: New file.
+ 	* ada/acats-2/tests/c8/c85006d.ada: New file.
+ 	* ada/acats-2/tests/c8/c85006e.ada: New file.
+ 	* ada/acats-2/tests/c8/c85006f.ada: New file.
+ 	* ada/acats-2/tests/c8/c85006g.ada: New file.
+ 	* ada/acats-2/tests/c8/c85007a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85007e.ada: New file.
+ 	* ada/acats-2/tests/c8/c85009a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85011a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85013a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85014a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85014b.ada: New file.
+ 	* ada/acats-2/tests/c8/c85014c.ada: New file.
+ 	* ada/acats-2/tests/c8/c85017a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85018a.ada: New file.
+ 	* ada/acats-2/tests/c8/c85018b.ada: New file.
+ 	* ada/acats-2/tests/c8/c85019a.ada: New file.
+ 	* ada/acats-2/tests/c8/c854001.a: New file.
+ 	* ada/acats-2/tests/c8/c854002.a: New file.
+ 	* ada/acats-2/tests/c8/c854003.a: New file.
+ 	* ada/acats-2/tests/c8/c86003a.ada: New file.
+ 	* ada/acats-2/tests/c8/c86004a.ada: New file.
+ 	* ada/acats-2/tests/c8/c86004b0.ada: New file.
+ 	* ada/acats-2/tests/c8/c86004b1.ada: New file.
+ 	* ada/acats-2/tests/c8/c86004b2.ada: New file.
+ 	* ada/acats-2/tests/c8/c86004c0.ada: New file.
+ 	* ada/acats-2/tests/c8/c86004c1.ada: New file.
+ 	* ada/acats-2/tests/c8/c86004c2.ada: New file.
+ 	* ada/acats-2/tests/c8/c86006i.ada: New file.
+ 	* ada/acats-2/tests/c8/c86007a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87a05a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87a05b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b02a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b02b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b03a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b04a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b04b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b04c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b05a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b06a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b07a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b07b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b07c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b07d.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b07e.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b08a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b09a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b09c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b10a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b11a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b11b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b13a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b14a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b14b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b14c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b14d.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b15a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b16a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b17a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b18a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b18b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b19a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b23a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b24a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b24b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b26b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b27a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b28a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b29a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b30a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b31a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b32a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b33a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b34a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b34b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b34c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b35c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b38a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b39a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b40a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b41a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b42a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b43a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b44a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b45a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b45c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b47a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b48a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b48b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b50a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b54a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b57a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b62a.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b62b.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b62c.ada: New file.
+ 	* ada/acats-2/tests/c8/c87b62d.tst: New file.
+ 	* ada/acats-2/tests/c9/c910001.a: New file.
+ 	* ada/acats-2/tests/c9/c910002.a: New file.
+ 	* ada/acats-2/tests/c9/c910003.a: New file.
+ 	* ada/acats-2/tests/c9/c91004b.ada: New file.
+ 	* ada/acats-2/tests/c9/c91004c.ada: New file.
+ 	* ada/acats-2/tests/c9/c91006a.ada: New file.
+ 	* ada/acats-2/tests/c9/c91007a.ada: New file.
+ 	* ada/acats-2/tests/c9/c92002a.ada: New file.
+ 	* ada/acats-2/tests/c9/c92003a.ada: New file.
+ 	* ada/acats-2/tests/c9/c92005a.ada: New file.
+ 	* ada/acats-2/tests/c9/c92005b.ada: New file.
+ 	* ada/acats-2/tests/c9/c92006a.ada: New file.
+ 	* ada/acats-2/tests/c9/c930001.a: New file.
+ 	* ada/acats-2/tests/c9/c93001a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93002a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93003a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93004a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93004b.ada: New file.
+ 	* ada/acats-2/tests/c9/c93004c.ada: New file.
+ 	* ada/acats-2/tests/c9/c93004d.ada: New file.
+ 	* ada/acats-2/tests/c9/c93004f.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005b.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005c.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005d.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005e.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005f.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005g.ada: New file.
+ 	* ada/acats-2/tests/c9/c93005h.ada: New file.
+ 	* ada/acats-2/tests/c9/c93006a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93007a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93008a.ada: New file.
+ 	* ada/acats-2/tests/c9/c93008b.ada: New file.
+ 	* ada/acats-2/tests/c9/c940001.a: New file.
+ 	* ada/acats-2/tests/c9/c940002.a: New file.
+ 	* ada/acats-2/tests/c9/c940004.a: New file.
+ 	* ada/acats-2/tests/c9/c940005.a: New file.
+ 	* ada/acats-2/tests/c9/c940006.a: New file.
+ 	* ada/acats-2/tests/c9/c940007.a: New file.
+ 	* ada/acats-2/tests/c9/c940010.a: New file.
+ 	* ada/acats-2/tests/c9/c940011.a: New file.
+ 	* ada/acats-2/tests/c9/c940012.a: New file.
+ 	* ada/acats-2/tests/c9/c940013.a: New file.
+ 	* ada/acats-2/tests/c9/c940014.a: New file.
+ 	* ada/acats-2/tests/c9/c940015.a: New file.
+ 	* ada/acats-2/tests/c9/c940016.a: New file.
+ 	* ada/acats-2/tests/c9/c94001a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94001b.ada: New file.
+ 	* ada/acats-2/tests/c9/c94001c.ada: New file.
+ 	* ada/acats-2/tests/c9/c94001e.ada: New file.
+ 	* ada/acats-2/tests/c9/c94001f.ada: New file.
+ 	* ada/acats-2/tests/c9/c94001g.ada: New file.
+ 	* ada/acats-2/tests/c9/c94002a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94002b.ada: New file.
+ 	* ada/acats-2/tests/c9/c94002d.ada: New file.
+ 	* ada/acats-2/tests/c9/c94002e.ada: New file.
+ 	* ada/acats-2/tests/c9/c94002f.ada: New file.
+ 	* ada/acats-2/tests/c9/c94002g.ada: New file.
+ 	* ada/acats-2/tests/c9/c94004a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94004b.ada: New file.
+ 	* ada/acats-2/tests/c9/c94004c.ada: New file.
+ 	* ada/acats-2/tests/c9/c94005a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94005b.ada: New file.
+ 	* ada/acats-2/tests/c9/c94006a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94007a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94007b.ada: New file.
+ 	* ada/acats-2/tests/c9/c94008a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94008b.ada: New file.
+ 	* ada/acats-2/tests/c9/c94008c.ada: New file.
+ 	* ada/acats-2/tests/c9/c94008d.ada: New file.
+ 	* ada/acats-2/tests/c9/c94010a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94011a.ada: New file.
+ 	* ada/acats-2/tests/c9/c94020a.ada: New file.
+ 	* ada/acats-2/tests/c9/c940a03.a: New file.
+ 	* ada/acats-2/tests/c9/c95008a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95009a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95010a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95011a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95012a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95021a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95022a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95022b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95033a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95033b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95034a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95034b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95035a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95040a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95040b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95040c.ada: New file.
+ 	* ada/acats-2/tests/c9/c95040d.ada: New file.
+ 	* ada/acats-2/tests/c9/c95041a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95065a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95065b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95065c.ada: New file.
+ 	* ada/acats-2/tests/c9/c95065d.ada: New file.
+ 	* ada/acats-2/tests/c9/c95065e.ada: New file.
+ 	* ada/acats-2/tests/c9/c95065f.ada: New file.
+ 	* ada/acats-2/tests/c9/c95066a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95067a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95071a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95072a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95072b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95073a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95074c.ada: New file.
+ 	* ada/acats-2/tests/c9/c95076a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95078a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95080b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95082g.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085c.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085d.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085e.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085f.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085g.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085h.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085i.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085j.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085k.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085l.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085m.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085n.ada: New file.
+ 	* ada/acats-2/tests/c9/c95085o.ada: New file.
+ 	* ada/acats-2/tests/c9/c95086a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95086b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95086c.ada: New file.
+ 	* ada/acats-2/tests/c9/c95086d.ada: New file.
+ 	* ada/acats-2/tests/c9/c95086e.ada: New file.
+ 	* ada/acats-2/tests/c9/c95086f.ada: New file.
+ 	* ada/acats-2/tests/c9/c95087a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95087b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95087c.ada: New file.
+ 	* ada/acats-2/tests/c9/c95087d.ada: New file.
+ 	* ada/acats-2/tests/c9/c95088a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95089a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95090a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95092a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95093a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95095a.ada: New file.
+ 	* ada/acats-2/tests/c9/c95095b.ada: New file.
+ 	* ada/acats-2/tests/c9/c95095c.ada: New file.
+ 	* ada/acats-2/tests/c9/c95095d.ada: New file.
+ 	* ada/acats-2/tests/c9/c95095e.ada: New file.
+ 	* ada/acats-2/tests/c9/c951001.a: New file.
+ 	* ada/acats-2/tests/c9/c951002.a: New file.
+ 	* ada/acats-2/tests/c9/c953001.a: New file.
+ 	* ada/acats-2/tests/c9/c953002.a: New file.
+ 	* ada/acats-2/tests/c9/c953003.a: New file.
+ 	* ada/acats-2/tests/c9/c954001.a: New file.
+ 	* ada/acats-2/tests/c9/c954010.a: New file.
+ 	* ada/acats-2/tests/c9/c954011.a: New file.
+ 	* ada/acats-2/tests/c9/c954012.a: New file.
+ 	* ada/acats-2/tests/c9/c954013.a: New file.
+ 	* ada/acats-2/tests/c9/c954014.a: New file.
+ 	* ada/acats-2/tests/c9/c954015.a: New file.
+ 	* ada/acats-2/tests/c9/c954016.a: New file.
+ 	* ada/acats-2/tests/c9/c954017.a: New file.
+ 	* ada/acats-2/tests/c9/c954018.a: New file.
+ 	* ada/acats-2/tests/c9/c954019.a: New file.
+ 	* ada/acats-2/tests/c9/c954020.a: New file.
+ 	* ada/acats-2/tests/c9/c954021.a: New file.
+ 	* ada/acats-2/tests/c9/c954022.a: New file.
+ 	* ada/acats-2/tests/c9/c954023.a: New file.
+ 	* ada/acats-2/tests/c9/c954024.a: New file.
+ 	* ada/acats-2/tests/c9/c954025.a: New file.
+ 	* ada/acats-2/tests/c9/c954026.a: New file.
+ 	* ada/acats-2/tests/c9/c954a01.a: New file.
+ 	* ada/acats-2/tests/c9/c954a02.a: New file.
+ 	* ada/acats-2/tests/c9/c954a03.a: New file.
+ 	* ada/acats-2/tests/c9/c960001.a: New file.
+ 	* ada/acats-2/tests/c9/c960002.a: New file.
+ 	* ada/acats-2/tests/c9/c960004.a: New file.
+ 	* ada/acats-2/tests/c9/c96001a.ada: New file.
+ 	* ada/acats-2/tests/c9/c96004a.ada: New file.
+ 	* ada/acats-2/tests/c9/c96005a.ada: New file.
+ 	* ada/acats-2/tests/c9/c96005b.tst: New file.
+ 	* ada/acats-2/tests/c9/c96005d.ada: New file.
+ 	* ada/acats-2/tests/c9/c96005f.ada: New file.
+ 	* ada/acats-2/tests/c9/c96006a.ada: New file.
+ 	* ada/acats-2/tests/c9/c96007a.ada: New file.
+ 	* ada/acats-2/tests/c9/c96008a.ada: New file.
+ 	* ada/acats-2/tests/c9/c96008b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97112a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97113a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97114a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97115a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97116a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97117a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97117b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97117c.ada: New file.
+ 	* ada/acats-2/tests/c9/c97118a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97120a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97120b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201c.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201d.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201e.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201g.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201h.ada: New file.
+ 	* ada/acats-2/tests/c9/c97201x.ada: New file.
+ 	* ada/acats-2/tests/c9/c97202a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97203a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97203b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97203c.ada: New file.
+ 	* ada/acats-2/tests/c9/c97204a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97204b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97205a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97205b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97301a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97301b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97301c.ada: New file.
+ 	* ada/acats-2/tests/c9/c97301d.ada: New file.
+ 	* ada/acats-2/tests/c9/c97301e.ada: New file.
+ 	* ada/acats-2/tests/c9/c97302a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97303a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97303b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97303c.ada: New file.
+ 	* ada/acats-2/tests/c9/c97304a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97304b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97305a.ada: New file.
+ 	* ada/acats-2/tests/c9/c97305b.ada: New file.
+ 	* ada/acats-2/tests/c9/c97305c.ada: New file.
+ 	* ada/acats-2/tests/c9/c97305d.ada: New file.
+ 	* ada/acats-2/tests/c9/c97307a.ada: New file.
+ 	* ada/acats-2/tests/c9/c974001.a: New file.
+ 	* ada/acats-2/tests/c9/c974002.a: New file.
+ 	* ada/acats-2/tests/c9/c974003.a: New file.
+ 	* ada/acats-2/tests/c9/c974004.a: New file.
+ 	* ada/acats-2/tests/c9/c974005.a: New file.
+ 	* ada/acats-2/tests/c9/c974006.a: New file.
+ 	* ada/acats-2/tests/c9/c974007.a: New file.
+ 	* ada/acats-2/tests/c9/c974008.a: New file.
+ 	* ada/acats-2/tests/c9/c974009.a: New file.
+ 	* ada/acats-2/tests/c9/c974010.a: New file.
+ 	* ada/acats-2/tests/c9/c974011.a: New file.
+ 	* ada/acats-2/tests/c9/c974012.a: New file.
+ 	* ada/acats-2/tests/c9/c974013.a: New file.
+ 	* ada/acats-2/tests/c9/c974014.a: New file.
+ 	* ada/acats-2/tests/c9/c980001.a: New file.
+ 	* ada/acats-2/tests/c9/c980002.a: New file.
+ 	* ada/acats-2/tests/c9/c980003.a: New file.
+ 	* ada/acats-2/tests/c9/c99004a.ada: New file.
+ 	* ada/acats-2/tests/c9/c99005a.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a003a.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a004a.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a007a.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a009a.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a009c.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a009f.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a009g.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a009h.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a010a.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a011a.ada: New file.
+ 	* ada/acats-2/tests/c9/c9a011b.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1003a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1004a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1005a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1006a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1011a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1011a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1011a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1011a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1011a4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1011a5.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1011a6.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012a4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012b0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012b2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1012b4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1013a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1013a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1013a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1013a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1013a4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1013a5.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1013a6.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1014a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1014a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1014a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1014a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1020e0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1020e1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1020e2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1020e3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1022a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1022a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1022a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1022a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1022a4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1022a5.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1022a6.ada: New file.
+ 	* ada/acats-2/tests/ca/ca11001.a: New file.
+ 	* ada/acats-2/tests/ca/ca11002.a: New file.
+ 	* ada/acats-2/tests/ca/ca11003.a: New file.
+ 	* ada/acats-2/tests/ca/ca110040.a: New file.
+ 	* ada/acats-2/tests/ca/ca110041.a: New file.
+ 	* ada/acats-2/tests/ca/ca110042.am: New file.
+ 	* ada/acats-2/tests/ca/ca110050.a: New file.
+ 	* ada/acats-2/tests/ca/ca110051.am: New file.
+ 	* ada/acats-2/tests/ca/ca11006.a: New file.
+ 	* ada/acats-2/tests/ca/ca11007.a: New file.
+ 	* ada/acats-2/tests/ca/ca11008.a: New file.
+ 	* ada/acats-2/tests/ca/ca11009.a: New file.
+ 	* ada/acats-2/tests/ca/ca11010.a: New file.
+ 	* ada/acats-2/tests/ca/ca11011.a: New file.
+ 	* ada/acats-2/tests/ca/ca11012.a: New file.
+ 	* ada/acats-2/tests/ca/ca11013.a: New file.
+ 	* ada/acats-2/tests/ca/ca11014.a: New file.
+ 	* ada/acats-2/tests/ca/ca11015.a: New file.
+ 	* ada/acats-2/tests/ca/ca11016.a: New file.
+ 	* ada/acats-2/tests/ca/ca11017.a: New file.
+ 	* ada/acats-2/tests/ca/ca11018.a: New file.
+ 	* ada/acats-2/tests/ca/ca11019.a: New file.
+ 	* ada/acats-2/tests/ca/ca11020.a: New file.
+ 	* ada/acats-2/tests/ca/ca11021.a: New file.
+ 	* ada/acats-2/tests/ca/ca11022.a: New file.
+ 	* ada/acats-2/tests/ca/ca1102a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1102a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1102a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1106a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1108a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca1108b.ada: New file.
+ 	* ada/acats-2/tests/ca/ca11a01.a: New file.
+ 	* ada/acats-2/tests/ca/ca11a02.a: New file.
+ 	* ada/acats-2/tests/ca/ca11b01.a: New file.
+ 	* ada/acats-2/tests/ca/ca11b02.a: New file.
+ 	* ada/acats-2/tests/ca/ca11c01.a: New file.
+ 	* ada/acats-2/tests/ca/ca11c02.a: New file.
+ 	* ada/acats-2/tests/ca/ca11c03.a: New file.
+ 	* ada/acats-2/tests/ca/ca11d010.a: New file.
+ 	* ada/acats-2/tests/ca/ca11d011.a: New file.
+ 	* ada/acats-2/tests/ca/ca11d012.a: New file.
+ 	* ada/acats-2/tests/ca/ca11d013.am: New file.
+ 	* ada/acats-2/tests/ca/ca11d02.a: New file.
+ 	* ada/acats-2/tests/ca/ca11d03.a: New file.
+ 	* ada/acats-2/tests/ca/ca13001.a: New file.
+ 	* ada/acats-2/tests/ca/ca13002.a: New file.
+ 	* ada/acats-2/tests/ca/ca13003.a: New file.
+ 	* ada/acats-2/tests/ca/ca13a01.a: New file.
+ 	* ada/acats-2/tests/ca/ca13a02.a: New file.
+ 	* ada/acats-2/tests/ca/ca140230.a: New file.
+ 	* ada/acats-2/tests/ca/ca140231.a: New file.
+ 	* ada/acats-2/tests/ca/ca140232.am: New file.
+ 	* ada/acats-2/tests/ca/ca140233.a: New file.
+ 	* ada/acats-2/tests/ca/ca140280.a: New file.
+ 	* ada/acats-2/tests/ca/ca140281.a: New file.
+ 	* ada/acats-2/tests/ca/ca140282.a: New file.
+ 	* ada/acats-2/tests/ca/ca140283.am: New file.
+ 	* ada/acats-2/tests/ca/ca15003.a: New file.
+ 	* ada/acats-2/tests/ca/ca200020.a: New file.
+ 	* ada/acats-2/tests/ca/ca200021.a: New file.
+ 	* ada/acats-2/tests/ca/ca200022.am: New file.
+ 	* ada/acats-2/tests/ca/ca2001h0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2001h1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2001h2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2001h3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2002a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2002a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2002a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2003a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2003a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2004a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2004a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2004a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2004a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2004a4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2007a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2007a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2007a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2007a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2008a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2008a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2008a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2009a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2009c0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2009c1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2009d.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2009f0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2009f1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2009f2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca2011b.ada: New file.
+ 	* ada/acats-2/tests/ca/ca21001.a: New file.
+ 	* ada/acats-2/tests/ca/ca3011a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca3011a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca3011a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca3011a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca3011a4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003a0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003a1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003a2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003a3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003a4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003a5.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003a6.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003b0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003b1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003b2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003b3.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003b4.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5003b5.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5004a.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5004b0.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5004b1.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5004b2.ada: New file.
+ 	* ada/acats-2/tests/ca/ca5006a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb10002.a: New file.
+ 	* ada/acats-2/tests/cb/cb1001a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb1004a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb1005a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb1010a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb1010c.ada: New file.
+ 	* ada/acats-2/tests/cb/cb1010d.ada: New file.
+ 	* ada/acats-2/tests/cb/cb20001.a: New file.
+ 	* ada/acats-2/tests/cb/cb20003.a: New file.
+ 	* ada/acats-2/tests/cb/cb20004.a: New file.
+ 	* ada/acats-2/tests/cb/cb20005.a: New file.
+ 	* ada/acats-2/tests/cb/cb20006.a: New file.
+ 	* ada/acats-2/tests/cb/cb20007.a: New file.
+ 	* ada/acats-2/tests/cb/cb2004a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb2005a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb2006a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb2007a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb20a02.a: New file.
+ 	* ada/acats-2/tests/cb/cb3003a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb3003b.ada: New file.
+ 	* ada/acats-2/tests/cb/cb3004a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb40005.a: New file.
+ 	* ada/acats-2/tests/cb/cb4001a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4002a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4003a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4004a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4005a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4006a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4007a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4008a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4009a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb4013a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb40a01.a: New file.
+ 	* ada/acats-2/tests/cb/cb40a020.a: New file.
+ 	* ada/acats-2/tests/cb/cb40a021.am: New file.
+ 	* ada/acats-2/tests/cb/cb40a030.a: New file.
+ 	* ada/acats-2/tests/cb/cb40a031.am: New file.
+ 	* ada/acats-2/tests/cb/cb40a04.a: New file.
+ 	* ada/acats-2/tests/cb/cb41001.a: New file.
+ 	* ada/acats-2/tests/cb/cb41002.a: New file.
+ 	* ada/acats-2/tests/cb/cb41003.a: New file.
+ 	* ada/acats-2/tests/cb/cb41004.a: New file.
+ 	* ada/acats-2/tests/cb/cb5001a.ada: New file.
+ 	* ada/acats-2/tests/cb/cb5001b.ada: New file.
+ 	* ada/acats-2/tests/cb/cb5002a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1004a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1005b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1010a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1010b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1018a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1104c.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1107b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1111a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1204a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1207b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1220a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1221a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1221b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1221c.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1221d.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1222a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1223a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1224a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1225a.tst: New file.
+ 	* ada/acats-2/tests/cc/cc1226b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1227a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1301a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1302a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1304a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1304b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1307a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1307b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1308a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1310a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1311a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc1311b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc2002a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc30001.a: New file.
+ 	* ada/acats-2/tests/cc/cc30002.a: New file.
+ 	* ada/acats-2/tests/cc/cc3004a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3007a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3007b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3011a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3011d.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3012a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3015a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3016b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3016c.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3016f.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3016i.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3017b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3017c.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3019a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3019b0.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3019b1.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3019b2.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3019c0.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3019c1.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3019c2.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3106b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3120a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3120b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3121a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3123a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3125a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3125b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3125c.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3125d.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3126a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3127a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3128a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3203a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3207b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3220a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3221a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3222a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3223a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3224a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3225a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3230a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3231a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3232a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3233a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3234a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3235a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3236a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3240a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3305a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3305b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3305c.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3305d.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3601a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3601c.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3602a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3603a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3605a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3606a.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3606b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc3607b.ada: New file.
+ 	* ada/acats-2/tests/cc/cc40001.a: New file.
+ 	* ada/acats-2/tests/cc/cc50001.a: New file.
+ 	* ada/acats-2/tests/cc/cc50a01.a: New file.
+ 	* ada/acats-2/tests/cc/cc50a02.a: New file.
+ 	* ada/acats-2/tests/cc/cc51001.a: New file.
+ 	* ada/acats-2/tests/cc/cc51002.a: New file.
+ 	* ada/acats-2/tests/cc/cc51003.a: New file.
+ 	* ada/acats-2/tests/cc/cc51004.a: New file.
+ 	* ada/acats-2/tests/cc/cc51006.a: New file.
+ 	* ada/acats-2/tests/cc/cc51007.a: New file.
+ 	* ada/acats-2/tests/cc/cc51008.a: New file.
+ 	* ada/acats-2/tests/cc/cc51a01.a: New file.
+ 	* ada/acats-2/tests/cc/cc51b03.a: New file.
+ 	* ada/acats-2/tests/cc/cc51d01.a: New file.
+ 	* ada/acats-2/tests/cc/cc51d02.a: New file.
+ 	* ada/acats-2/tests/cc/cc54001.a: New file.
+ 	* ada/acats-2/tests/cc/cc54002.a: New file.
+ 	* ada/acats-2/tests/cc/cc54003.a: New file.
+ 	* ada/acats-2/tests/cc/cc54004.a: New file.
+ 	* ada/acats-2/tests/cc/cc70001.a: New file.
+ 	* ada/acats-2/tests/cc/cc70002.a: New file.
+ 	* ada/acats-2/tests/cc/cc70003.a: New file.
+ 	* ada/acats-2/tests/cc/cc70a01.a: New file.
+ 	* ada/acats-2/tests/cc/cc70a02.a: New file.
+ 	* ada/acats-2/tests/cc/cc70b01.a: New file.
+ 	* ada/acats-2/tests/cc/cc70b02.a: New file.
+ 	* ada/acats-2/tests/cc/cc70c01.a: New file.
+ 	* ada/acats-2/tests/cc/cc70c02.a: New file.
+ 	* ada/acats-2/tests/cd/cd10001.a: New file.
+ 	* ada/acats-2/tests/cd/cd10002.a: New file.
+ 	* ada/acats-2/tests/cd/cd1009a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009f.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009h.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009j.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009k.tst: New file.
+ 	* ada/acats-2/tests/cd/cd1009l.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009m.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009n.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009o.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009p.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009q.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009r.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009s.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009t.tst: New file.
+ 	* ada/acats-2/tests/cd/cd1009u.tst: New file.
+ 	* ada/acats-2/tests/cd/cd1009v.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009w.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009x.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009y.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1009z.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c03a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c03b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c03c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c03e.tst: New file.
+ 	* ada/acats-2/tests/cd/cd1c03f.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c03g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c03h.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c03i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c04a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c04d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c04e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd1c06a.tst: New file.
+ 	* ada/acats-2/tests/cd/cd20001.a: New file.
+ 	* ada/acats-2/tests/cd/cd2a21a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a21c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a21e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a22a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a22e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a22i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a22j.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a23a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a23e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a24a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a24e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a24i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a24j.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a31a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a31c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a31e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a32a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a32c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a32e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a32g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a32i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a32j.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a51a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a53a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a53e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2a83c.tst: New file.
+ 	* ada/acats-2/tests/cd/cd2a91c.tst: New file.
+ 	* ada/acats-2/tests/cd/cd2b11a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2b11b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2b11d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2b11e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2b11f.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2b15c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2b16a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2c11a.tst: New file.
+ 	* ada/acats-2/tests/cd/cd2c11d.tst: New file.
+ 	* ada/acats-2/tests/cd/cd2d11a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd2d13a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd30001.a: New file.
+ 	* ada/acats-2/tests/cd/cd30002.a: New file.
+ 	* ada/acats-2/tests/cd/cd30003.a: New file.
+ 	* ada/acats-2/tests/cd/cd30004.a: New file.
+ 	* ada/acats-2/tests/cd/cd300050.am: New file.
+ 	* ada/acats-2/tests/cd/cd300051.c: New file.
+ 	* ada/acats-2/tests/cd/cd30011.a: New file.
+ 	* ada/acats-2/tests/cd/cd30012.a: New file.
+ 	* ada/acats-2/tests/cd/cd3014a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3014c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3014d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3014f.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015f.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015h.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3015k.ada: New file.
+ 	* ada/acats-2/tests/cd/cd3021a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd33001.a: New file.
+ 	* ada/acats-2/tests/cd/cd33002.a: New file.
+ 	* ada/acats-2/tests/cd/cd40001.a: New file.
+ 	* ada/acats-2/tests/cd/cd4031a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd4041a.tst: New file.
+ 	* ada/acats-2/tests/cd/cd4051a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd4051b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd4051c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd4051d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003f.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003h.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5003i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011k.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011m.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011q.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5011s.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5012a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5012b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5012e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5012f.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5012i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5012m.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013k.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013m.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5013o.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014e.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014g.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014i.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014k.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014m.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014o.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014t.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014v.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014x.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014y.ada: New file.
+ 	* ada/acats-2/tests/cd/cd5014z.ada: New file.
+ 	* ada/acats-2/tests/cd/cd70001.a: New file.
+ 	* ada/acats-2/tests/cd/cd7002a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd7007b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd7101d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd7101e.dep: New file.
+ 	* ada/acats-2/tests/cd/cd7101f.dep: New file.
+ 	* ada/acats-2/tests/cd/cd7101g.tst: New file.
+ 	* ada/acats-2/tests/cd/cd7103d.ada: New file.
+ 	* ada/acats-2/tests/cd/cd7202a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd7204b.ada: New file.
+ 	* ada/acats-2/tests/cd/cd7204c.ada: New file.
+ 	* ada/acats-2/tests/cd/cd72a01.a: New file.
+ 	* ada/acats-2/tests/cd/cd72a02.a: New file.
+ 	* ada/acats-2/tests/cd/cd7305a.ada: New file.
+ 	* ada/acats-2/tests/cd/cd90001.a: New file.
+ 	* ada/acats-2/tests/cd/cd92001.a: New file.
+ 	* ada/acats-2/tests/cd/cda201a.ada: New file.
+ 	* ada/acats-2/tests/cd/cda201b.ada: New file.
+ 	* ada/acats-2/tests/cd/cda201c.ada: New file.
+ 	* ada/acats-2/tests/cd/cda201e.ada: New file.
+ 	* ada/acats-2/tests/cd/cdb0a01.a: New file.
+ 	* ada/acats-2/tests/cd/cdb0a02.a: New file.
+ 	* ada/acats-2/tests/cd/cdd1001.a: New file.
+ 	* ada/acats-2/tests/cd/cdd2001.a: New file.
+ 	* ada/acats-2/tests/cd/cdd2a01.a: New file.
+ 	* ada/acats-2/tests/cd/cdd2a02.a: New file.
+ 	* ada/acats-2/tests/cd/cdd2a03.a: New file.
+ 	* ada/acats-2/tests/cd/cde0001.a: New file.
+ 	* ada/acats-2/tests/ce/ce2102a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102c.tst: New file.
+ 	* ada/acats-2/tests/ce/ce2102d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102h.tst: New file.
+ 	* ada/acats-2/tests/ce/ce2102i.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102j.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102k.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102l.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102m.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102n.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102o.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102p.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102q.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102r.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102s.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102t.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102u.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102v.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102w.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102x.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2102y.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2103a.tst: New file.
+ 	* ada/acats-2/tests/ce/ce2103b.tst: New file.
+ 	* ada/acats-2/tests/ce/ce2103c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2103d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2104a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2104b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2104c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2104d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2106a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2106b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2108e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2108f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2108g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2108h.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2109a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2109b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2109c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2110a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2110c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2111a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2111b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2111c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2111e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2111f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2111g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2111i.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201d.dep: New file.
+ 	* ada/acats-2/tests/ce/ce2201e.dep: New file.
+ 	* ada/acats-2/tests/ce/ce2201f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201h.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201i.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201j.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201k.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201l.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201m.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2201n.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2202a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2203a.tst: New file.
+ 	* ada/acats-2/tests/ce/ce2204a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2204b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2204c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2204d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2205a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2206a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2208b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401h.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401i.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401j.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401k.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2401l.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2402a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2403a.tst: New file.
+ 	* ada/acats-2/tests/ce/ce2404a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2404b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2405b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2406a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2407a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2407b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2408a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2408b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2409a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2409b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2410a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2410b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce2411a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3002b.tst: New file.
+ 	* ada/acats-2/tests/ce/ce3002c.tst: New file.
+ 	* ada/acats-2/tests/ce/ce3002d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3002f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102b.tst: New file.
+ 	* ada/acats-2/tests/ce/ce3102d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102h.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102i.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102j.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3102k.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3103a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3104a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3104b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3104c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3106a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3106b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3107a.tst: New file.
+ 	* ada/acats-2/tests/ce/ce3107b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3108a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3108b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3110a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3112c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3112d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3114a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3115a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3201a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3202a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3206a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3207a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3301a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3302a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3303a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3304a.tst: New file.
+ 	* ada/acats-2/tests/ce/ce3305a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3306a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3401a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3402a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3402c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3402d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3402e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3403a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3403b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3403c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3403d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3403e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3403f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3404a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3404b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3404c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3404d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3405a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3405c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3405d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3406a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3406b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3406c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3406d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3407a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3407b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3407c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3408a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3408b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3408c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3409a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3409b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3409c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3409d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3409e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3410a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3410b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3410c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3410d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3410e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3411a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3411c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3412a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3413a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3413b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3413c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3414a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3601a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3602a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3602b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3602c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3602d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3603a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3604a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3604b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3605a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3605b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3605c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3605d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3605e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3606a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3606b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3701a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704m.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704n.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3704o.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3705a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3705b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3705c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3705d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3705e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3706c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3706d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3706f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3706g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3707a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3708a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3801a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3801b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804h.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804i.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804j.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804m.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804o.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3804p.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3805a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3805b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806g.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3806h.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3809a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3809b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3810a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3810b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3815a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3901a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3902b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3904a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3904b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3905a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3905b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3905c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3905l.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3906a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3906b.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3906c.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3906d.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3906e.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3906f.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3907a.ada: New file.
+ 	* ada/acats-2/tests/ce/ce3908a.ada: New file.
+ 	* ada/acats-2/tests/cxa/cxa3001.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa3002.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa3003.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa3004.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4001.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4002.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4003.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4004.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4005.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4006.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4007.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4008.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4009.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4010.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4011.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4012.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4013.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4014.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4015.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4016.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4017.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4018.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4019.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4020.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4021.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4022.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4023.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4024.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4025.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4026.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4027.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4028.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4029.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4030.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4031.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4032.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4033.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa4034.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5011.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5012.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5013.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5015.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a01.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a02.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a03.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a04.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a05.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a06.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a07.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a08.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a09.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa5a10.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa8001.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa8002.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa8003.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa9001.a: New file.
+ 	* ada/acats-2/tests/cxa/cxa9002.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa001.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa002.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa003.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa004.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa005.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa006.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa007.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa008.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa009.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa010.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa011.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa012.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa013.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa014.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa015.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa016.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa017.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa018.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaa019.a: New file.
+ 	* ada/acats-2/tests/cxa/cxab001.a: New file.
+ 	* ada/acats-2/tests/cxa/cxac001.a: New file.
+ 	* ada/acats-2/tests/cxa/cxac002.a: New file.
+ 	* ada/acats-2/tests/cxa/cxac003.a: New file.
+ 	* ada/acats-2/tests/cxa/cxac004.a: New file.
+ 	* ada/acats-2/tests/cxa/cxac005.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaca01.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaca02.a: New file.
+ 	* ada/acats-2/tests/cxa/cxacb01.a: New file.
+ 	* ada/acats-2/tests/cxa/cxacb02.a: New file.
+ 	* ada/acats-2/tests/cxa/cxacc01.a: New file.
+ 	* ada/acats-2/tests/cxa/cxaf001.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb2001.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb2002.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb2003.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3001.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3002.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3003.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb30040.c: New file.
+ 	* ada/acats-2/tests/cxb/cxb30041.am: New file.
+ 	* ada/acats-2/tests/cxb/cxb3005.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb30060.c: New file.
+ 	* ada/acats-2/tests/cxb/cxb30061.am: New file.
+ 	* ada/acats-2/tests/cxb/cxb3007.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3008.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3009.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3010.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3011.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3012.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb30130.c: New file.
+ 	* ada/acats-2/tests/cxb/cxb30131.c: New file.
+ 	* ada/acats-2/tests/cxb/cxb30132.am: New file.
+ 	* ada/acats-2/tests/cxb/cxb3014.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3015.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb3016.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4001.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4002.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4003.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4004.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4005.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4006.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4007.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb4008.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb5001.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb5002.a: New file.
+ 	* ada/acats-2/tests/cxb/cxb5003.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf1001.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf2001.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf2002.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf2003.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf2004.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf2005.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf2a01.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf2a02.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3001.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3002.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3003.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3004.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a01.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a02.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a03.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a04.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a05.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a06.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a07.a: New file.
+ 	* ada/acats-2/tests/cxf/cxf3a08.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg1001.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg1002.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg1003.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg1004.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg1005.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2001.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2002.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2003.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2004.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2005.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2006.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2007.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2008.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2009.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2010.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2011.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2012.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2013.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2014.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2015.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2016.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2017.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2018.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2019.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2020.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2021.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2022.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2023.a: New file.
+ 	* ada/acats-2/tests/cxg/cxg2024.a: New file.
+ 	* ada/acats-2/tests/cxh/cxh3001.a: New file.
+ 	* ada/acats-2/tests/cxh/cxh3002.a: New file.
+ 	* ada/acats-2/tests/cxh/cxh30030.a: New file.
+ 	* ada/acats-2/tests/cxh/cxh30031.am: New file.
+ 	* ada/acats-2/tests/cz/cz1101a.ada: New file.
+ 	* ada/acats-2/tests/cz/cz1102a.ada: New file.
+ 	* ada/acats-2/tests/cz/cz1103a.ada: New file.
+ 	* ada/acats-2/tests/d/d4a002a.ada: New file.
+ 	* ada/acats-2/tests/d/d4a002b.ada: New file.
+ 	* ada/acats-2/tests/d/d4a004a.ada: New file.
+ 	* ada/acats-2/tests/d/d4a004b.ada: New file.
+ 	* ada/acats-2/tests/e/e28002b.ada: New file.
+ 	* ada/acats-2/tests/e/e28005d.ada: New file.
+ 	* ada/acats-2/tests/e/e52103y.ada: New file.
+ 	* ada/acats-2/tests/e/eb4011a.ada: New file.
+ 	* ada/acats-2/tests/e/eb4012a.ada: New file.
+ 	* ada/acats-2/tests/e/eb4014a.ada: New file.
+ 	* ada/acats-2/tests/e/ee3203a.ada: New file.
+ 	* ada/acats-2/tests/e/ee3204a.ada: New file.
+ 	* ada/acats-2/tests/e/ee3402b.ada: New file.
+ 	* ada/acats-2/tests/e/ee3409f.ada: New file.
+ 	* ada/acats-2/tests/e/ee3412c.ada: New file.
+ 	* ada/acats-2/tests/l/la140010.a: New file.
+ 	* ada/acats-2/tests/l/la140011.am: New file.
+ 	* ada/acats-2/tests/l/la140012.a: New file.
+ 	* ada/acats-2/tests/l/la140020.a: New file.
+ 	* ada/acats-2/tests/l/la140021.am: New file.
+ 	* ada/acats-2/tests/l/la140022.a: New file.
+ 	* ada/acats-2/tests/l/la140030.a: New file.
+ 	* ada/acats-2/tests/l/la140031.a: New file.
+ 	* ada/acats-2/tests/l/la140032.am: New file.
+ 	* ada/acats-2/tests/l/la140033.a: New file.
+ 	* ada/acats-2/tests/l/la140040.a: New file.
+ 	* ada/acats-2/tests/l/la140041.am: New file.
+ 	* ada/acats-2/tests/l/la140042.a: New file.
+ 	* ada/acats-2/tests/l/la140050.a: New file.
+ 	* ada/acats-2/tests/l/la140051.a: New file.
+ 	* ada/acats-2/tests/l/la140052.am: New file.
+ 	* ada/acats-2/tests/l/la140053.a: New file.
+ 	* ada/acats-2/tests/l/la140060.a: New file.
+ 	* ada/acats-2/tests/l/la140061.a: New file.
+ 	* ada/acats-2/tests/l/la140062.am: New file.
+ 	* ada/acats-2/tests/l/la140063.a: New file.
+ 	* ada/acats-2/tests/l/la140070.a: New file.
+ 	* ada/acats-2/tests/l/la140071.a: New file.
+ 	* ada/acats-2/tests/l/la140072.am: New file.
+ 	* ada/acats-2/tests/l/la140073.a: New file.
+ 	* ada/acats-2/tests/l/la140080.a: New file.
+ 	* ada/acats-2/tests/l/la140081.a: New file.
+ 	* ada/acats-2/tests/l/la140082.am: New file.
+ 	* ada/acats-2/tests/l/la140083.a: New file.
+ 	* ada/acats-2/tests/l/la140090.a: New file.
+ 	* ada/acats-2/tests/l/la140091.a: New file.
+ 	* ada/acats-2/tests/l/la140092.am: New file.
+ 	* ada/acats-2/tests/l/la140093.a: New file.
+ 	* ada/acats-2/tests/l/la140100.a: New file.
+ 	* ada/acats-2/tests/l/la140101.a: New file.
+ 	* ada/acats-2/tests/l/la140102.am: New file.
+ 	* ada/acats-2/tests/l/la140103.a: New file.
+ 	* ada/acats-2/tests/l/la140110.a: New file.
+ 	* ada/acats-2/tests/l/la140111.a: New file.
+ 	* ada/acats-2/tests/l/la140112.am: New file.
+ 	* ada/acats-2/tests/l/la140113.a: New file.
+ 	* ada/acats-2/tests/l/la140120.a: New file.
+ 	* ada/acats-2/tests/l/la140121.a: New file.
+ 	* ada/acats-2/tests/l/la140122.am: New file.
+ 	* ada/acats-2/tests/l/la140123.a: New file.
+ 	* ada/acats-2/tests/l/la140130.a: New file.
+ 	* ada/acats-2/tests/l/la140131.a: New file.
+ 	* ada/acats-2/tests/l/la140132.am: New file.
+ 	* ada/acats-2/tests/l/la140133.a: New file.
+ 	* ada/acats-2/tests/l/la140140.a: New file.
+ 	* ada/acats-2/tests/l/la140141.a: New file.
+ 	* ada/acats-2/tests/l/la140142.am: New file.
+ 	* ada/acats-2/tests/l/la140143.a: New file.
+ 	* ada/acats-2/tests/l/la140150.a: New file.
+ 	* ada/acats-2/tests/l/la140151.a: New file.
+ 	* ada/acats-2/tests/l/la140152.am: New file.
+ 	* ada/acats-2/tests/l/la140153.a: New file.
+ 	* ada/acats-2/tests/l/la140160.a: New file.
+ 	* ada/acats-2/tests/l/la140161.a: New file.
+ 	* ada/acats-2/tests/l/la140162.am: New file.
+ 	* ada/acats-2/tests/l/la140163.a: New file.
+ 	* ada/acats-2/tests/l/la140170.a: New file.
+ 	* ada/acats-2/tests/l/la140171.a: New file.
+ 	* ada/acats-2/tests/l/la140172.am: New file.
+ 	* ada/acats-2/tests/l/la140173.a: New file.
+ 	* ada/acats-2/tests/l/la140180.a: New file.
+ 	* ada/acats-2/tests/l/la140181.a: New file.
+ 	* ada/acats-2/tests/l/la140182.am: New file.
+ 	* ada/acats-2/tests/l/la140183.a: New file.
+ 	* ada/acats-2/tests/l/la140190.a: New file.
+ 	* ada/acats-2/tests/l/la140191.a: New file.
+ 	* ada/acats-2/tests/l/la140192.am: New file.
+ 	* ada/acats-2/tests/l/la140193.a: New file.
+ 	* ada/acats-2/tests/l/la140200.a: New file.
+ 	* ada/acats-2/tests/l/la140201.a: New file.
+ 	* ada/acats-2/tests/l/la140202.am: New file.
+ 	* ada/acats-2/tests/l/la140203.a: New file.
+ 	* ada/acats-2/tests/l/la140210.a: New file.
+ 	* ada/acats-2/tests/l/la140211.am: New file.
+ 	* ada/acats-2/tests/l/la140212.a: New file.
+ 	* ada/acats-2/tests/l/la140220.a: New file.
+ 	* ada/acats-2/tests/l/la140221.am: New file.
+ 	* ada/acats-2/tests/l/la140222.a: New file.
+ 	* ada/acats-2/tests/l/la140240.a: New file.
+ 	* ada/acats-2/tests/l/la140241.a: New file.
+ 	* ada/acats-2/tests/l/la140242.am: New file.
+ 	* ada/acats-2/tests/l/la140243.a: New file.
+ 	* ada/acats-2/tests/l/la140250.a: New file.
+ 	* ada/acats-2/tests/l/la140251.am: New file.
+ 	* ada/acats-2/tests/l/la140252.a: New file.
+ 	* ada/acats-2/tests/l/la140260.a: New file.
+ 	* ada/acats-2/tests/l/la140261.a: New file.
+ 	* ada/acats-2/tests/l/la140262.am: New file.
+ 	* ada/acats-2/tests/l/la140263.a: New file.
+ 	* ada/acats-2/tests/l/la140270.a: New file.
+ 	* ada/acats-2/tests/l/la140271.a: New file.
+ 	* ada/acats-2/tests/l/la140272.am: New file.
+ 	* ada/acats-2/tests/l/la140273.a: New file.
+ 
+ 2025-05-24  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c: Add asm check
+ 	for vor.vx combine.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u8.c: Ditto.
+ 
+ 2025-05-24  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c: Add test cases
+ 	for vor vx combine case 0 on GR2VR cost.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h: Add test
+ 	data for vor.vx run test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i16.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i32.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i64.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-i8.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u16.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u32.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u64.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vor-run-1-u8.c: New test.
+ 
+ 2025-05-23  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120363
+ 	* g++.dg/modules/pr113292_a.H: Move to...
+ 	* g++.dg/modules/tls-1_a.H: ...here.
+ 	* g++.dg/modules/pr113292_b.C: Move to...
+ 	* g++.dg/modules/tls-1_b.C: ...here.
+ 	* g++.dg/modules/pr113292_c.C: Move to...
+ 	* g++.dg/modules/tls-1_c.C: ...here.
+ 	* g++.dg/modules/tls-2_a.C: New test.
+ 	* g++.dg/modules/tls-2_b.C: New test.
+ 	* g++.dg/modules/tls-2_c.C: New test.
+ 	* g++.dg/modules/tls-3.h: New test.
+ 	* g++.dg/modules/tls-3_a.H: New test.
+ 	* g++.dg/modules/tls-3_b.C: New test.
+ 
+ 2025-05-23  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120414
+ 	* g++.dg/modules/using-31_a.C: New test.
+ 	* g++.dg/modules/using-31_b.C: New test.
+ 
+ 2025-05-23  Robin Dapp  <rdapp@ventanamicro.com>
+ 
+ 	* gcc.target/riscv/arch-56.c: New test.
+ 
+ 2025-05-23  Robin Dapp  <rdapp@ventanamicro.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/param-autovec-mode.c: New test.
+ 
+ 2025-05-23  Robin Dapp  <rdapp@ventanamicro.com>
+ 
+ 	* gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul4-3.c: Adjust
+ 	expectations.
+ 	* gcc.dg/vect/costmodel/riscv/rvv/dynamic-lmul8-9.c: Ditto.
+ 
+ 2025-05-23  Dhruv Chawla  <dhruvc@nvidia.com>
+ 	    Richard Sandiford  <richard.sandiford@arm.com>
+ 
+ 	* gcc.target/aarch64/sve/shift_rev_1.c: New test.
+ 	* gcc.target/aarch64/sve/shift_rev_2.c: Likewise.
+ 	* gcc.target/aarch64/sve/shift_rev_3.c: Likewise.
+ 
+ 2025-05-22  Gaius Mulley  <gaiusmod2@gmail.com>
+ 
+ 	PR modula2/120389
+ 	* gm2/iso/fail/badarray3.mod: New test.
+ 
+ 2025-05-22  Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	* ada/acats/overflow.lst: Delete.
+ 	* ada/acats/run_all.sh: Do not process overflow.lst.
+ 
+ 2025-05-22  Jason Merrill  <jason@redhat.com>
+ 
+ 	* g++.dg/opt/always_inline2.C: Correct PR number.
+ 
+ 2025-05-22  Jason Merrill  <jason@redhat.com>
+ 
+ 	PR c++/120935
+ 	* g++.dg/opt/always_inline2.C: New test.
+ 	* g++.dg/debug/dwarf2/pubnames-2.C: Suppress -fimplicit-constexpr.
+ 	* g++.dg/debug/dwarf2/pubnames-3.C: Likewise.
+ 
+ 2025-05-22  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.dg/cwsc1.c (CHAIN, aarch64): x9 instead x18 for __vxworks.
+ 	* gcc.target/aarch64/reg-alloc-4.c: Drop x18-assigned asm
+ 	operand on vxworks.
+ 	* gcc.target/aarch64/shadow_call_stack_1.c: Don't expect
+ 	-ffixed-x18 error on vxworks, but rather the sorry message.
+ 	* gcc.target/aarch64/shadow_call_stack_2.c: Skip on vxworks.
+ 	* gcc.target/aarch64/shadow_call_stack_3.c: Likewise.
+ 	* gcc.target/aarch64/shadow_call_stack_4.c: Likewise.
+ 	* gcc.target/aarch64/shadow_call_stack_5.c: Likewise.
+ 	* gcc.target/aarch64/shadow_call_stack_6.c: Likewise.
+ 	* gcc.target/aarch64/shadow_call_stack_7.c: Likewise.
+ 	* gcc.target/aarch64/shadow_call_stack_8.c: Likewise.
+ 	* gcc.target/aarch64/stack-check-prologue-19.c: Likewise.
+ 	* gcc.target/aarch64/stack-check-prologue-20.c: Likewise.
+ 
+ 2025-05-22  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	PR target/120372
+ 	* gcc.target/aarch64/imm_choice_comparison-2.c: New test.
+ 
+ 2025-05-22  Jakub Jelinek  <jakub@redhat.com>
+ 
+ 	* gcc.dg/bitintext.h: New file.
+ 	* gcc.dg/torture/bitint-82.c: New test.
+ 
+ 2025-05-22  Christophe Lyon  <christophe.lyon@linaro.org>
+ 
+ 	* lib/target-supports.exp (check_effective_target_arm_v8_1a_neon_ok_nocache): Use
+ 	-mcpu=unset on arm only.
+ 	(check_effective_target_arm_v8_2a_fp16_scalar_ok_nocache): Likewise.
+ 	(check_effective_target_arm_v8_2a_fp16_neon_ok_nocache): Likewise.
+ 	(check_effective_target_arm_v8_2a_dotprod_neon_ok_nocache): Likewise.
+ 	(check_effective_target_arm_v8_2a_i8mm_ok_nocache): Likewise.
+ 	(check_effective_target_arm_v8_2a_bf16_neon_ok_nocache): Likewise.
+ 	(check_effective_target_arm_v8_3a_complex_neon_ok_nocache): Likewise.
+ 	(check_effective_target_arm_v8_3a_fp16_complex_neon_ok_nocache): Likewise.
+ 
+ 2025-05-22  Jakub Jelinek  <jakub@redhat.com>
+ 
+ 	PR target/120360
+ 	* gcc.target/i386/pr120360.c: New test.
+ 
+ 2025-05-22  Dongyan Chen  <chendongyan@isrc.iscas.ac.cn>
+ 
+ 	* gcc.target/riscv/cset-sext-sfb.c: Skip for -Oz.
+ 	* gcc.target/riscv/zba-slliuw.c: Skip for -Og.
+ 
+ 2025-05-21  Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	PR target/120368
+ 	* gcc.target/riscv/pr120368.c: New test.
+ 
+ 2025-05-21  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c: Add asm check
+ 	for vand.vx combine.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u8.c: Ditto.
+ 
+ 2025-05-21  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c: Add test cases
+ 	for vand vx combine case 0 on GR2VR cost.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u16.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u32.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u64.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u8.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u16.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u32.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u64.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u8.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u16.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u32.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u64.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u8.c: Ditto
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h: Add test
+ 	data for vand.vx run test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i16.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i32.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i64.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-i8.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u16.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u32.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u64.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vand-run-1-u8.c: New test.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.dg/vect/vect-simd-clone-16e.c: Expect fewer calls on ia32.
+ 	* gcc.dg/vect/vect-simd-clone-17e.c: Likewise.
+ 	* gcc.dg/vect/vect-simd-clone-18e.c: Likewise.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.target/i386/pr31985.c: Add -fomit-frame-pointer.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.target/i386/pr108938-3.c: Add -msse2.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.target/i386/no-callee-saved-16.c: Add -fomit-frame-pointer.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.dg/vect/tsvc/vect-tsvc-s332.c: Require vect_early_break_hw.
+ 	* gcc.dg/vect/tsvc/vect-tsvc-s481.c: Likewise.
+ 	* gcc.dg/vect/tsvc/vect-tsvc-s482.c: Likewise.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.dg/tree-ssa/forwprop-41.c: Add -msse on x86.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.dg/strlenopt-80.c: Bump to -msse2.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.dg/memcpy-6.c: Bump to -msse2.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.dg/fold-copysign-1.c: Bump to sse2 on ia32.
+ 	* gcc.dg/pr55152-2.c: Likewise.
+ 	* gcc.dg/tree-ssa/abs-4.c: Likewise.
+ 	* gcc.dg/tree-ssa/backprop-6.c: Likewise.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.target/aarch64/sme/nonlocal_goto_1.c: Match
+ 	vxworks cache-clearing function as well.
+ 	* gcc.target/aarch64/sme/nonlocal_goto_2.c: Likewise.
+ 	* gcc.target/aarch64/sme/nonlocal_goto_3.c: Likewise.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* gcc.target/aarch64/acle/rwsr.c: Use uint64_t.
+ 	* gcc.target/aarch64/acle/rwsr-2.c: Likewise.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* c-c++-common/analyzer/strtok-cppreference.c
+ 	(__STDC_WANT_LIB_EXT1__): Define to 1.
+ 
+ 2025-05-21  Alexandre Oliva  <oliva@adacore.com>
+ 
+ 	* c-c++-common/analyzer/fd-glibc-byte-stream-socket.c: Skip on
+ 	vxworks with C++ < 11.
+ 
+ 2025-05-21  Iain Sandoe  <iain@sandoe.co.uk>
+ 
+ 	* g++.dg/coroutines/pr115908.C: Count promise construction
+ 	and destruction. Run the test and XFAIL it.
+ 
+ 2025-05-21  Iain Sandoe  <iain@sandoe.co.uk>
+ 
+ 	PR c++/119916
+ 	* g++.dg/coroutines/torture/special-termination-00-sync-completion.C:
+ 	Amend for CWG2563 expected behaviour.
+ 	* g++.dg/coroutines/torture/special-termination-01-self-destruct.C:
+ 	Likewise.
+ 	* g++.dg/coroutines/torture/pr119916.C: New test.
+ 
+ 2025-05-21  Andrew Pinski  <quic_apinski@quicinc.com>
+ 
+ 	PR middle-end/120369
+ 	* gcc.dg/torture/pr120369-1.c: New test.
+ 
+ 2025-05-21  liuhongt  <hongtao.liu@intel.com>
+ 
+ 	* gcc.target/i386/pr118994-1.c: New test.
+ 	* gcc.target/i386/pr118994-2.c: New test.
+ 
+ 2025-05-20  Robert Dubner  <rdubner@symas.com>
+ 
+ 	* cobol.dg/group2/FUNCTION_SQRT__2_.cob: Testcase.
+ 	* cobol.dg/group2/FUNCTION_SQRT__2_.out: Known-good for the testcase.
+ 
+ 2025-05-20  Jakub Jelinek  <jakub@redhat.com>
+ 
+ 	* gcc.dg/torture/bitint-78.c: New test.
+ 	* gcc.dg/torture/bitint-79.c: New test.
+ 	* gcc.dg/torture/bitint-80.c: New test.
+ 	* gcc.dg/torture/bitint-81.c: New test.
+ 
+ 2025-05-20  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120349
+ 	* g++.dg/modules/vtt-3_a.C: New test.
+ 	* g++.dg/modules/vtt-3_b.C: New test.
+ 
+ 2025-05-20  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120013
+ 	* g++.dg/modules/partial-8.h: New test.
+ 	* g++.dg/modules/partial-8_a.C: New test.
+ 	* g++.dg/modules/partial-8_b.C: New test.
+ 	* g++.dg/modules/partial-8_c.C: New test.
+ 	* g++.dg/modules/partial-8_d.C: New test.
+ 
+ 2025-05-20  Nathaniel Shead  <nathanieloshead@gmail.com>
+ 
+ 	PR c++/120350
+ 	* g++.dg/modules/tinfo-3_a.H: New test.
+ 	* g++.dg/modules/tinfo-3_b.C: New test.
+ 
+ 2025-05-20  liuhongt  <hongtao.liu@intel.com>
+ 
+ 	* gcc.target/i386/pr103771-5.c: New test.
+ 	* gcc.target/i386/pr103771-6.c: New test.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c: Extract
+ 	define T as type for testing.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u8.c: Ditto.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c: Add asm check
+ 	for vrsub with GR2VR cost 2.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-u8.c: Ditto.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c: Add asm check
+ 	for vrsub with GR2VR cost 1.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-u8.c: Ditto.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c: Add asm check
+ 	for vrsub case 1 with GR2VR cost 0.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-u8.c: Ditto.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c: Add asm check
+ 	for vrsub with GR2VR cost is 15.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-3-u8.c: Ditto.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c: Add vrsub asm
+ 	dump check.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-2-u8.c: Ditto.
+ 
+ 2025-05-20  Pan Li  <pan2.li@intel.com>
+ 
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c: Add vrsub asm check.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u16.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u32.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u64.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-u8.c: Ditto.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h: Add test helper
+ 	macros for vx binary reversed.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h: Add test
+ 	data for vrsub.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i16.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i32.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i64.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-i8.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u16.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u32.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u64.c: New test.
+ 	* gcc.target/riscv/rvv/autovec/vx_vf/vx_vrsub-run-1-u8.c: New test.
+ 
+ 2025-05-19  Jeff Law  <jlaw@ventanamicro.com>
+ 
+ 	PR target/120333
+ 	* gcc.target/riscv/pr114512.c: Update expected output.
+ 	* gcc.target/riscv/pr120333.c: New test.
+ 
+ 2025-05-19  Thomas Schwinge  <tschwinge@baylibre.com>
+ 
+ 	PR lto/120308
+ 	* gcc.target/nvptx/abi-struct-arg.c: Add empty structure testing.
+ 	* gcc.target/nvptx/abi-struct-ret.c: Likewise.
+ 
+ 2025-05-19  Richard Earnshaw  <rearnsha@arm.com>
+ 
+ 	PR target/120351
+ 	* gcc.target/arm/pr120351.c: New test.
+ 
+ 2025-05-19  Kito Cheng  <kito.cheng@sifive.com>
+ 
+ 	* gcc.target/riscv/zilsd-code-gen.c: New test.
+ 
+ 2025-05-19  Jennifer Schmitz  <jschmitz@nvidia.com>
+ 
+ 	PR middle-end/120276
+ 	* gcc.dg/torture/pr120276.c: New test.
+ 
+ 2025-05-19  Kito Cheng  <kito.cheng@sifive.com>
+ 
+ 	* gcc.target/riscv/constraint-cR-pair.c: New test case.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* gcc.target/i386/avx10_2-512-bf16-1.c: Removed and combined ...
+ 	* gcc.target/i386/avx10_2-bf16-1.c: ... to this.
+ 	* gcc.target/i386/avx10_2-512-bf16-vector-cmp-1.c: Removed and
+ 	combined ...
+ 	* gcc.target/i386/avx10_2-bf16-vector-cmp-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-bf16-vector-fma-1.c: Removed and
+ 	combined ...
+ 	* gcc.target/i386/avx10_2-bf16-vector-fma-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-bf16-vector-operations-1.c: Removed
+ 	and combined ...
+ 	* gcc.target/i386/avx10_2-bf16-vector-operations-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-bf16-vector-smaxmin-1.c: Removed
+ 	and combined ...
+ 	* gcc.target/i386/avx10_2-bf16-vector-smaxmin-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-convert-1.c: Removed and combined ...
+ 	* gcc.target/i386/avx10_2-convert-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-media-1.c: Removed and combined ...
+ 	* gcc.target/i386/avx10_2-media-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-minmax-1.c: Removed and combined ...
+ 	* gcc.target/i386/avx10_2-minmax-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-movrs-1.c: Removed and combined ...
+ 	* gcc.target/i386/avx10_2-movrs-1.c:... to this.
+ 	* gcc.target/i386/avx10_2-512-satcvt-1.c: Removed and combined ...
+ 	* gcc.target/i386/avx10_2-satcvt-1.c:... to this.
+ 	* gcc.target/i386/sm4-avx10_2-512-1.c: Move to...
+ 	* gcc.target/i386/sm4-avx10_2-1b.c: ...here.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* gcc.target/i386/avx10-check.h: Remove AVX10_512BIT.
+ 	* gcc.target/i386/avx10-minmax-helper.h: Ditto.
+ 	* gcc.target/i386/avx10_2-vaddbf16-2.c: Add 512 test.
+ 	* gcc.target/i386/avx10_2-vcmpbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvt2ph2bf8-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvt2ph2bf8s-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvt2ph2hf8-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvt2ph2hf8s-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvt2ps2phx-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtbf162ibs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtbf162iubs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2bf8-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2bf8s-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2hf8-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2hf8s-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvthf82ph-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtph2bf8-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtph2bf8s-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtph2hf8-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtph2hf8s-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtph2ibs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtph2iubs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtps2ibs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvtps2iubs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttbf162ibs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttbf162iubs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttpd2dqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttpd2qqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttpd2udqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttpd2uqqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttph2ibs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttph2iubs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttps2dqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttps2ibs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttps2iubs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttps2qqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttps2udqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vcvttps2uqqs-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vdivbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vdpphps-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vfmaddXXXbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vfmsubXXXbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vfnmaddXXXbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vfnmsubXXXbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vfpclassbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vgetexpbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vgetmantbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vmaxbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vminbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vminmaxbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vminmaxpd-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vminmaxph-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vminmaxps-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vmpsadbw-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vmulbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpbssd-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpbssds-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpbsud-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpbsuds-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpbuud-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpbuuds-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpwsud-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpwsuds-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpwusd-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpwusds-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpwuud-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vpdpwuuds-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vrcpbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vreducebf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vrndscalebf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vrsqrtbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vscalefbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vsqrtbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx10_2-vsubbf16-2.c: Ditto.
+ 	* gcc.target/i386/avx512f-helper.h: Remove AVX10_512BIT.
+ 	* gcc.target/i386/sm4-check.h: Use AVX10_2.
+ 	* gcc.target/i386/avx10_2-512-vaddbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vaddbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcmpbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcmpbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvt2ph2bf8-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvt2ph2bf8-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvt2ph2bf8s-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvt2ph2bf8s-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvt2ph2hf8-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvt2ph2hf8-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvt2ph2hf8s-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvt2ph2hf8s-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvt2ps2phx-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvt2ps2phx-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtbf162ibs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtbf162ibs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtbf162iubs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtbf162iubs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtbiasph2bf8-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2bf8-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtbiasph2bf8s-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2bf8s-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtbiasph2hf8-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2hf8-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtbiasph2hf8s-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtbiasph2hf8s-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvthf82ph-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvthf82ph-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtph2bf8-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtph2bf8-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtph2bf8s-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtph2bf8s-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtph2hf8-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtph2hf8-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtph2hf8s-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtph2hf8s-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtph2ibs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtph2ibs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtph2iubs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtph2iubs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtps2ibs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtps2ibs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvtps2iubs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvtps2iubs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttbf162ibs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttbf162ibs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttbf162iubs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttbf162iubs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttpd2dqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttpd2dqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttpd2qqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttpd2qqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttpd2udqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttpd2udqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttpd2uqqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttpd2uqqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttph2ibs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttph2ibs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttph2iubs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttph2iubs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttps2dqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttps2dqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttps2ibs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttps2ibs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttps2iubs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttps2iubs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttps2qqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttps2qqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttps2udqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttps2udqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vcvttps2uqqs-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vcvttps2uqqs-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vdivbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vdivbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vdpphps-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vdpphps-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vfmaddXXXbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vfmaddXXXbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vfmsubXXXbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vfmsubXXXbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vfnmaddXXXbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vfnmaddXXXbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vfnmsubXXXbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vfnmsubXXXbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vfpclassbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vfpclassbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vgetexpbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vgetexpbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vgetmantbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vgetmantbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vmaxbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vmaxbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vminbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vminbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vminmaxbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vminmaxbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vminmaxpd-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vminmaxpd-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vminmaxph-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vminmaxph-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vminmaxps-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vminmaxps-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vmpsadbw-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vmpsadbw-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vmulbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vmulbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpbssd-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpbssd-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpbssds-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpbssds-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpbsud-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpbsud-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpbsuds-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpbsuds-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpbuud-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpbuud-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpbuuds-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpbuuds-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpwsud-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpwsud-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpwsuds-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpwsuds-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpwusd-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpwusd-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpwusds-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpwusds-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpwuud-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpwuud-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vpdpwuuds-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vpdpwuuds-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vrcpbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vrcpbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vreducebf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vreducebf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vrndscalebf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vrndscalebf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vrsqrtbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vrsqrtbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vscalefbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vscalefbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vsqrtbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vsqrtbf16-2.h: ...here.
+ 	* gcc.target/i386/avx10_2-512-vsubbf16-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/avx10_2-vsubbf16-2.h: ...here.
+ 	* gcc.target/i386/sm4key4-avx10_2-512-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/sm4key4-avx10_2-2.c: ...here.
+ 	* gcc.target/i386/sm4rnds4-avx10_2-512-2.c:
+ 	Remove 512 test. Move to...
+ 	* gcc.target/i386/sm4rnds4-avx10_2-2.c: ...here.
+ 	* gcc.target/i386/vnniint16-auto-vectorize-4.c: Use AVX10_SCALAR
+ 	for 512 bit test.
+ 	* gcc.target/i386/vnniint8-auto-vectorize-4.c: Ditto.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* gcc.target/i386/avx-1.c: Combine tests and change
+ 	intrin file name.
+ 	* gcc.target/i386/sse-13.c: Ditto.
+ 	* gcc.target/i386/sse-14.c: Ditto.
+ 	* gcc.target/i386/sse-22.c: Ditto.
+ 	* gcc.target/i386/sse-23.c: Ditto.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* gcc.target/i386/avx10_1-1.c: Remove warning.
+ 	* gcc.target/i386/avx10_1-2.c: Ditto.
+ 	* gcc.target/i386/avx10_1-3.c: Ditto.
+ 	* gcc.target/i386/avx10_1-4.c: Ditto.
+ 	* gcc.target/i386/pr111068.c: Ditto.
+ 	* gcc.target/i386/pr117946.c: Ditto.
+ 	* gcc.target/i386/pr117240_avx512f.c: Remove -mevex512 and
+ 	warning.
+ 	* gcc.target/i386/avx10_1-11.c: Rename to ...
+ 	* gcc.target/i386/avx10_1-5.c: ... this. Remove warning.
+ 	* gcc.target/i386/avx10_1-12.c: Rename to ...
+ 	* gcc.target/i386/avx10_1-6.c: ... this. Remove warning.
+ 	* gcc.target/i386/avx10_1-26.c: Rename to ...
+ 	* gcc.target/i386/avx10_1-7.c: ... this. Remove warning.
+ 	The origin avx10_1-7.c is removed.
+ 	* gcc.target/i386/avx10_1-10.c: Removed.
+ 	* gcc.target/i386/avx10_1-13.c: Removed.
+ 	* gcc.target/i386/avx10_1-14.c: Removed.
+ 	* gcc.target/i386/avx10_1-15.c: Removed.
+ 	* gcc.target/i386/avx10_1-16.c: Removed.
+ 	* gcc.target/i386/avx10_1-17.c: Removed.
+ 	* gcc.target/i386/avx10_1-18.c: Removed.
+ 	* gcc.target/i386/avx10_1-19.c: Removed.
+ 	* gcc.target/i386/avx10_1-20.c: Removed.
+ 	* gcc.target/i386/avx10_1-21.c: Removed.
+ 	* gcc.target/i386/avx10_1-22.c: Removed.
+ 	* gcc.target/i386/avx10_1-23.c: Removed.
+ 	* gcc.target/i386/avx10_1-8.c: Removed.
+ 	* gcc.target/i386/avx10_1-9.c: Removed.
+ 	* gcc.target/i386/noevex512-1.c: Removed.
+ 	* gcc.target/i386/noevex512-2.c: Removed.
+ 	* gcc.target/i386/noevex512-3.c: Removed.
+ 	* gcc.target/i386/pr111889.c: Removed.
+ 	* gcc.target/i386/pr111907.c: Removed.
+ 
+ 2025-05-19  Haochen Jiang  <haochen.jiang@intel.com>
+ 
+ 	* gcc.target/i386/pr90096.c: Adjust error message.
+ 	* gcc.target/i386/pr117304-1.c: Removed.
+ 
  2025-05-17  Yuao Ma  <c8ef@outlook.com>
  
  	* gcc.dg/builtins-1.c: Builtin codegen test.
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/elabd.lst gcc-16-20250525/gcc/testsuite/ada/acats/elabd.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats/elabd.lst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/elabd.lst	Thu Jan  1 00:00:00 1970
***************
*** 1,5 ****
- c731001
- c854002
- ca11018
- ca11019
- ca5006a
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/floatstore.lst gcc-16-20250525/gcc/testsuite/ada/acats/floatstore.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats/floatstore.lst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/floatstore.lst	Thu Jan  1 00:00:00 1970
***************
*** 1 ****
- cxg2021
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/norun.lst gcc-16-20250525/gcc/testsuite/ada/acats/norun.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats/norun.lst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/norun.lst	Thu Jan  1 00:00:00 1970
***************
*** 1,2 ****
- # Tests must be sorted in alphabetical order
- templat
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/overflow.lst gcc-16-20250525/gcc/testsuite/ada/acats/overflow.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats/overflow.lst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/overflow.lst	Thu Jan  1 00:00:00 1970
***************
*** 1,17 ****
- c45632a
- c45632b
- c45632c
- c45504a
- c45504b
- c45504c
- c45613a
- c45613b
- c45613c
- c45304a
- c45304b
- c45304c
- c46014a
- c460008
- c460011
- c4a012b
- cb20004
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/run_acats.sh gcc-16-20250525/gcc/testsuite/ada/acats/run_acats.sh
*** gcc-16-20250518/gcc/testsuite/ada/acats/run_acats.sh	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/run_acats.sh	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- #!/bin/sh
- 
- if [ "$testdir" = "" ]; then
-    echo You must use make check or make check-ada
-    exit 1
- fi
- 
- # Provide which replacement.
- #
- # type -p is missing from Solaris 2 /bin/sh and /bin/ksh (ksh88), but both
- # ksh93 and bash have it.
- # type output format differs between ksh88 and ksh93, so avoid it if
- # type -p is present.  Unfortunately, HP-UX /bin/sh ignores -p with type.
- # Fall back to whence which ksh88 and ksh93 provide, but bash does not.
- 
- which () {
-     path=`type -p $* 2>/dev/null` && { echo $path | awk '{print $NF}'; return 0; }
-     path=`type $* 2>/dev/null` && { echo $path | awk '{print $NF}'; return 0; }
-     path=`whence $* 2>/dev/null` && { echo $path; return 0; }
-     return 1
- }
- 
- # Set up environment to use the Ada compiler from the object tree
- 
- host_gnatchop=`which gnatchop`
- host_gnatmake=`which gnatmake`
- ROOT=`${PWDCMD-pwd}`
- BASE=`cd $ROOT/../../..; ${PWDCMD-pwd}`
- 
- PATH=$BASE:$ROOT:$PATH
- ADA_INCLUDE_PATH=$BASE/ada/rts
- LD_LIBRARY_PATH=$ADA_INCLUDE_PATH:$BASE:$LD_LIBRARY_PATH
- ADA_OBJECTS_PATH=$ADA_INCLUDE_PATH
- 
- if [ ! -d $ADA_INCLUDE_PATH ]; then
-    echo gnatlib missing, exiting.
-    exit 1
- fi
- 
- if [ ! -f $BASE/gnatchop ]; then
-    echo gnattools missing, exiting.
-    exit 1
- fi
- 
- if [ ! -f $BASE/gnatmake ]; then
-    echo gnattools missing, exiting.
-    exit 1
- fi
- 
- export PATH ADA_INCLUDE_PATH ADA_OBJECTS_PATH BASE LD_LIBRARY_PATH
- 
- echo '#!/bin/sh' > host_gnatchop
- echo PATH=`dirname $host_gnatchop`:'$PATH' >> host_gnatchop
- echo unset ADA_INCLUDE_PATH ADA_OBJECTS_PATH GCC_EXEC_PREFIX >> host_gnatchop
- echo export PATH >> host_gnatchop
- echo exec gnatchop '"$@"' >> host_gnatchop
- 
- chmod +x host_gnatchop
- 
- echo '#!/bin/sh' > host_gnatmake
- echo PATH=`dirname $host_gnatmake`:'$PATH' >> host_gnatmake
- echo unset ADA_INCLUDE_PATH ADA_OBJECTS_PATH GCC_EXEC_PREFIX >> host_gnatmake
- echo export PATH >> host_gnatmake
- echo exec gnatmake '"$@"' >> host_gnatmake
- 
- chmod +x host_gnatmake
- 
- # Limit the stack to 16MB for stack checking
- ulimit -s 16384
- 
- exec $testdir/run_all.sh ${1+"$@"}
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/run_all.sh gcc-16-20250525/gcc/testsuite/ada/acats/run_all.sh
*** gcc-16-20250518/gcc/testsuite/ada/acats/run_all.sh	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/run_all.sh	Thu Jan  1 00:00:00 1970
***************
*** 1,407 ****
- #!/bin/sh
- # Run ACATS with the GNU Ada compiler
- 
- # The following functions are to be customized if you run in cross
- # environment or want to change compilation flags.  Note that for
- # tests requiring checks not turned on by default, this script
- # automatically adds the needed flags to pass (ie: -gnato or -gnatE).
- 
- # gccflags="-O3 -funroll-loops"
- # gnatflags="-gnatn"
- 
- gccflags="-O2"
- gnatflags="-gnatws"
- 
- # End of customization section.
- 
- # Perform arithmetic evaluation on the ARGs, and store the result in the
- # global $as_val. Take advantage of shells that can avoid forks. The arguments
- # must be portable across $(()) and expr.
- if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
-   eval 'as_fn_arith ()
-   {
-     as_val=$(( $* ))
-   }'
- else
-   as_fn_arith ()
-   {
-     as_val=`expr "$@" || test $? -eq 1`
-   }
- fi # as_fn_arith
- 
- display_noeol () {
-   printf "$@"
-   printf "$@" >> $dir/acats.sum
-   printf "$@" >> $dir/acats.log
- }
- 
- display () {
-   echo "$@"
-   echo "$@" >> $dir/acats.sum
-   echo "$@" >> $dir/acats.log
- }
- 
- log () {
-   echo "$@" >> $dir/acats.sum
-   echo "$@" >> $dir/acats.log
- }
- 
- dir=`${PWDCMD-pwd}`
- 
- if [ "$dir" = "$testdir" ]; then
-   echo "error: srcdir must be different than objdir, exiting."
-   exit 1
- fi
- 
- GCC="$BASE/xgcc -B$BASE/"
- 
- target_gnatchop () {
-   $BASE/gnatchop --GCC="$BASE/xgcc" $*
- }
- 
- target_gnatmake () {
-   echo $BASE/gnatmake --GNATBIND=$BASE/gnatbind --GNATLINK=$BASE/gnatlink --GCC="$GCC" $gnatflags $gccflags $* -largs $EXTERNAL_OBJECTS --GCC="$GCC"
-   $BASE/gnatmake --GNATBIND=$BASE/gnatbind --GNATLINK=$BASE/gnatlink --GCC="$GCC" $gnatflags $gccflags $* -largs $EXTERNAL_OBJECTS --GCC="$GCC"
- }
- 
- target_gcc () {
-   $GCC $gccflags $*
- }
- 
- target_run () {
-   eval $EXPECT -f $testdir/run_test.exp $*
- }
- 
- clean_dir () {
-   rm -f "$binmain" *.o *.ali > /dev/null 2>&1
- }
- 
- find_main () {
-   ls ${i}?.adb > ${i}.lst 2> /dev/null
-   ls ${i}*m.adb >> ${i}.lst 2> /dev/null
-   ls ${i}.adb >> ${i}.lst 2> /dev/null
-   main=`tail -1 ${i}.lst`
- }
- 
- EXTERNAL_OBJECTS=""
- # Global variable to communicate external objects to link with.
- 
- rm -f $dir/acats.sum $dir/acats.log
- 
- display "Test Run By $USER on `date`"
- 
- display "		=== acats configuration ==="
- 
- target=`$GCC -dumpmachine`
- 
- display target gcc is $GCC
- display `$GCC -v 2>&1`
- display host=`gcc -dumpmachine`
- display target=$target
- display `type gnatmake`
- gnatls -v >> $dir/acats.log
- display ""
- 
- if [ -n "$GCC_RUNTEST_PARALLELIZE_DIR" ]; then
-   dir_support=$dir/../acats/support
- 
-   rm -rf $dir/run
-   mv $dir/tests $dir/tests.$$ 2> /dev/null
-   rm -rf $dir/tests.$$ &
-   mkdir -p $dir/run
- 
-   cp -pr $dir/../acats/tests $dir/
- else
-   dir_support=$dir/support
- 
- display "		=== acats support ==="
- display_noeol "Generating support files..."
- 
- rm -rf $dir/support
- mkdir -p $dir/support
- cd $dir/support
- 
- cp $testdir/support/*.ada $testdir/support/*.a $testdir/support/*.tst $dir/support
- 
- # Find out the size in bit of an address on the target
- target_gnatmake $testdir/support/impbit.adb >> $dir/acats.log 2>&1
- if [ $? -ne 0 ]; then
-    display "**** Failed to compile impbit"
-    exit 1
- fi
- target_run $dir/support/impbit > $dir/support/impbit.out 2>&1
- target_bit=`cat $dir/support/impbit.out`
- echo target_bit="$target_bit" >> $dir/acats.log
- 
- case "$target_bit" in
-   *32*)
-     target_max_int="9223372036854775807"
-     target_min_int="-9223372036854775808"
-     ;;
-   *64*)
-     target_max_int="170141183460469231731687303715884105727"
-     target_min_int="-170141183460469231731687303715884105728"
-     ;;
-   *)
-     display "**** Unsupported bits per word"
-     exit 1
- esac
- 
- echo target_max_insn="$target_max_int" >> $dir/acats.log
- echo target_min_insn="$target_min_int" >> $dir/acats.log
- 
- # Find out a suitable asm statement
- # Adapted from configure.ac gcc_cv_as_dwarf2_debug_line
- case "$target" in
-   ia64*-*-* | s390*-*-*)
-     target_insn="nop 0"
-     ;;
-   mmix-*-*)
-     target_insn="swym 0"
-     ;;
-   *)
-     target_insn="nop"
-     ;;
- esac
- echo target_insn="$target_insn" >> $dir/acats.log
- 
- sed -e "s,ACATS4GNATDIR,$dir,g" \
-   < $testdir/support/impdef.a > $dir/support/impdef.a
- sed -e "s,ACATS4GNATDIR,$dir,g" \
-   -e "s,ACATS4GNATBIT,$target_bit,g" \
-   -e "s,ACATS4GNATINSN,$target_insn,g" \
-   -e "s,ACATS4GNATMAXINT,$target_max_int,g" \
-   -e "s,ACATS4GNATMININT,$target_min_int,g" \
-   < $testdir/support/macro.dfs > $dir/support/MACRO.DFS
- sed -e "s,ACATS4GNATDIR,$dir,g" \
-   < $testdir/support/tsttests.dat > $dir/support/TSTTESTS.DAT
- 
- cp $testdir/tests/cd/*.c $dir/support
- cp $testdir/tests/cxb/*.c $dir/support
- grep -v '^#' $testdir/norun.lst | sort > $dir/support/norun.lst
- 
- rm -rf $dir/run
- mv $dir/tests $dir/tests.$$ 2> /dev/null
- rm -rf $dir/tests.$$ &
- mkdir -p $dir/run
- 
- cp -pr $testdir/tests $dir/
- 
- for i in $dir/support/*.ada $dir/support/*.a; do 
-    host_gnatchop $i >> $dir/acats.log 2>&1
- done
- 
- # These tools are used to preprocess some ACATS sources
- # they need to be compiled native on the host.
- 
- host_gnatmake -q -gnatws macrosub.adb
- if [ $? -ne 0 ]; then
-    display "**** Failed to compile macrosub"
-    exit 1
- fi
- ./macrosub > macrosub.out 2>&1
- 
- gcc -c cd300051.c
- host_gnatmake -q -gnatws widechr.adb
- if [ $? -ne 0 ]; then
-    display "**** Failed to compile widechr"
-    exit 1
- fi
- ./widechr > widechr.out 2>&1
- 
- rm -f $dir/support/macrosub
- rm -f $dir/support/widechr
- rm -f $dir/support/*.ali
- rm -f $dir/support/*.o
- 
- display " done."
- 
- # From here, all compilations will be made by the target compiler
- 
- display_noeol "Compiling support files..."
- 
- target_gcc -c *.c
- if [ $? -ne 0 ]; then
-    display "**** Failed to compile C code"
-    exit 1
- fi
- 
- target_gnatchop *.adt >> $dir/acats.log 2>&1
- 
- target_gnatmake -c -gnato -gnatE *.ads >> $dir/acats.log 2>&1
- target_gnatmake -c -gnato -gnatE *.adb >> $dir/acats.log 2>&1
- 
- display " done."
- display ""
- 
- fi
- 
- display "		=== acats tests ==="
- 
- if [ $# -eq 0 ]; then
-    chapters=`cd $dir/tests; echo [a-z]*`
- else
-    chapters=$*
- fi
- 
- glob_countn=0
- glob_countok=0
- glob_countu=0
- par_count=0
- par_countm=0
- par_last=
- 
- for chapter in $chapters; do
-    # Used to generate support once and finish after that.
-    [ "$chapter" = "NONE" ] && continue
- 
-    display Running chapter $chapter ...
- 
-    if [ ! -d $dir/tests/$chapter ]; then
-       display "*** CHAPTER $chapter does not exist, skipping."
-       display ""
-       continue
-    fi
- 
-    cd $dir/tests/$chapter
-    ls *.a *.ada *.adt *.am *.dep 2> /dev/null | sed -e 's/\(.*\)\..*/\1/g' | \
-    cut -c1-7 | sort | uniq | comm -23 - $dir_support/norun.lst \
-      > $dir/tests/$chapter/${chapter}.lst 
-    countn=`wc -l < $dir/tests/$chapter/${chapter}.lst`
-    as_fn_arith $glob_countn + $countn
-    glob_countn=$as_val
-    for i in `cat $dir/tests/$chapter/${chapter}.lst`; do 
- 
-       # If running multiple run_all.sh jobs in parallel, decide
-       # if we should run this test in the current instance.
-       if [ -n "$GCC_RUNTEST_PARALLELIZE_DIR" ]; then
- 	 case "$i" in
- 	    # Ugh, some tests have inter-test dependencies, those
- 	    # tests have to be scheduled on the same parallel instance
- 	    # as previous test.
- 	    ce2108f | ce2108h | ce3112d) ;;
- 	    # All others can be hopefully scheduled freely.
- 	    *)
- 	       as_fn_arith $par_countm + 1
- 	       par_countm=$as_val
- 	       [ $par_countm -eq 10 ] && par_countm=0
- 	       if [ $par_countm -eq 1 ]; then
- 		  as_fn_arith $par_count + 1
- 		  par_count=$as_val
- 		  if mkdir $GCC_RUNTEST_PARALLELIZE_DIR/$par_count 2>/dev/null; then
- 		     par_last=1
- 		  else
- 		     par_last=
- 		  fi
- 	       fi;;
- 	 esac
- 	 if [ -z "$par_last" ]; then
- 	    as_fn_arith $glob_countn - 1
- 	    glob_countn=$as_val
- 	    continue
- 	 fi
-       fi
- 
-       extraflags="-gnat95"
-       grep $i $testdir/overflow.lst > /dev/null 2>&1
-       if [ $? -eq 0 ]; then
-          extraflags="$extraflags -gnato"
-       fi
-       grep $i $testdir/elabd.lst > /dev/null 2>&1
-       if [ $? -eq 0 ]; then
-          extraflags="$extraflags -gnatE"
-       fi
-       grep $i $testdir/floatstore.lst > /dev/null 2>&1
-       if [ $? -eq 0 ]; then
-          extraflags="$extraflags -ffloat-store"
-       fi
-       grep $i $testdir/stackcheck.lst > /dev/null 2>&1
-       if [ $? -eq 0 ]; then
-          extraflags="$extraflags -fstack-check"
-       fi
-       test=$dir/tests/$chapter/$i
-       mkdir $test && cd $test >> $dir/acats.log 2>&1
- 
-       if [ $? -ne 0 ]; then
-          display "FAIL:	$i"
-          failed="${failed}${i} "
-          clean_dir
-          continue
-       fi
- 
-       target_gnatchop -c -w `ls ${test}*.a ${test}*.ada ${test}*.adt ${test}*.am ${test}*.dep 2> /dev/null` >> $dir/acats.log 2>&1
-       main=""
-       find_main
-       if [ -z "$main" ]; then
-          sync
-          find_main
-       fi
-       binmain=`echo $main | sed -e 's/\(.*\)\..*/\1/g'`
-       echo "BUILD $main" >> $dir/acats.log
-       EXTERNAL_OBJECTS=""
-       case $i in
-         cxb30*) EXTERNAL_OBJECTS="$dir_support/cxb30040.o $dir_support/cxb30060.o $dir_support/cxb30130.o $dir_support/cxb30131.o";;
-         ca1020e) rm -f ca1020e_func1.adb ca1020e_func2.adb ca1020e_proc1.adb ca1020e_proc2.adb > /dev/null 2>&1;;
-         ca14028) rm -f ca14028_func2.ads ca14028_func3.ads ca14028_proc1.ads ca14028_proc3.ads > /dev/null 2>&1;;
-       esac
-       if [ "$main" = "" ]; then
-          display "FAIL:	$i"
-          failed="${failed}${i} "
-          clean_dir
-          continue
-       fi
- 
-       target_gnatmake $extraflags -I$dir_support $main >> $dir/acats.log 2>&1
-       if [ $? -ne 0 ]; then
-          display "FAIL:	$i"
-          failed="${failed}${i} "
-          clean_dir
-          continue
-       fi
- 
-       echo "RUN $binmain" >> $dir/acats.log
-       cd $dir/run
-       if [ ! -x $dir/tests/$chapter/$i/$binmain ]; then
-          sync
-       fi
-       target_run $dir/tests/$chapter/$i/$binmain > $dir/tests/$chapter/$i/${i}.log 2>&1
-       cd $dir/tests/$chapter/$i
-       cat ${i}.log >> $dir/acats.log
-       egrep -e '(==== |\+\+\+\+ |\!\!\!\! )' ${i}.log > /dev/null 2>&1
-       if [ $? -ne 0 ]; then
-          grep 'tasking not implemented' ${i}.log > /dev/null 2>&1
- 
-          if [ $? -ne 0 ]; then
-             display "FAIL:	$i"
-             failed="${failed}${i} "
-          else
-             log "UNSUPPORTED:	$i"
-             as_fn_arith $glob_countn - 1
-             glob_countn=$as_val
-             as_fn_arith $glob_countu + 1
-             glob_countu=$as_val
-          fi
-       else
-          log "PASS:	$i"
-          as_fn_arith $glob_countok + 1
-          glob_countok=$as_val
-       fi
-       clean_dir
-    done
- done
- 
- display "		=== acats Summary ==="
- display "# of expected passes		$glob_countok"
- display "# of unexpected failures	`expr $glob_countn - $glob_countok`"
- 
- if [ $glob_countu -ne 0 ]; then
-    display "# of unsupported tests		$glob_countu"
- fi
- 
- if [ $glob_countok -ne $glob_countn ]; then
-    display "*** FAILURES: $failed"
- fi
- 
- display "$0 completed at `date`"
- 
- exit 0
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/run_test.exp gcc-16-20250525/gcc/testsuite/ada/acats/run_test.exp
*** gcc-16-20250518/gcc/testsuite/ada/acats/run_test.exp	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/run_test.exp	Thu Jan  1 00:00:00 1970
***************
*** 1,13 ****
- #!/usr/bin/expect -f
- 
- if {[info exists env(DEJAGNU_TIMEOUT)]} {
-     set timeout $env(DEJAGNU_TIMEOUT)
- } else {
-     set timeout 300 
- }
- 
- spawn -noecho $argv
- expect timeout {
-     send_user "Program timed out.\n"
-     exit 1
- }
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/stackcheck.lst gcc-16-20250525/gcc/testsuite/ada/acats/stackcheck.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats/stackcheck.lst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/stackcheck.lst	Thu Jan  1 00:00:00 1970
***************
*** 1,6 ****
- c52103x
- c52104x
- c52104y
- cb1010a
- cb1010c
- cb1010d
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/acats26.lst gcc-16-20250525/gcc/testsuite/ada/acats/support/acats26.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/acats26.lst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/acats26.lst	Thu Jan  1 00:00:00 1970
***************
*** 1,4332 ****
- a22006b.ada
- a22006c.ada
- a22006d.ada
- a26007a.tst
- a27003a.ada
- a29003a.ada
- a2a031a.ada
- a33003a.ada
- a34017c.ada
- a35101b.ada
- a35402a.ada
- a35801f.ada
- a35902c.ada
- a38106d.ada
- a38106e.ada
- a49027a.ada
- a49027b.ada
- a49027c.ada
- a54b01a.ada
- a54b02a.ada
- a55b12a.ada
- a55b13a.ada
- a55b14a.ada
- a71004a.ada
- a73001i.ada
- a73001j.ada
- a74105b.ada
- a74106a.ada
- a74106b.ada
- a74106c.ada
- a74205e.ada
- a74205f.ada
- a83009a.ada
- a83009b.ada
- a83a02a.ada
- a83a02b.ada
- a83a06a.ada
- a83a08a.ada
- a83c01c.ada
- a83c01h.ada
- a83c01i.ada
- a85007d.ada
- a85013b.ada
- a87b59a.ada
- a95001c.ada
- a95074d.ada
- a97106a.ada
- a99006a.ada
- aa2010a.ada
- aa2012a.ada
- acats25.lst
- ac1015b.ada
- ac3106a.ada
- ac3206a.ada
- ac3207a.ada
- ad7001b.ada
- ad7001c0.ada
- ad7001c1.ada
- ad7001d0.ada
- ad7001d1.ada
- ad7006a.ada
- ad7101a.ada
- ad7101c.ada
- ad7102a.ada
- ad7103a.ada
- ad7103c.ada
- ad7104a.ada
- ad7201a.ada
- ad7203b.ada
- ad7205b.ada
- ad8011a.tst
- ada101a.ada
- ae2113a.ada
- ae2113b.ada
- ae3002g.ada
- ae3101a.ada
- ae3702a.ada
- ae3709a.ada
- b22001a.tst
- b22001b.tst
- b22001c.tst
- b22001d.tst
- b22001e.tst
- b22001f.tst
- b22001g.tst
- b22001h.ada
- b22001i.tst
- b22001j.tst
- b22001k.tst
- b22001l.tst
- b22001m.tst
- b22001n.tst
- b23002a.ada
- b23004a.ada
- b23004b.ada
- b24001a.ada
- b24001b.ada
- b24001c.ada
- b24005a.ada
- b24005b.ada
- b24007a.ada
- b24009a.ada
- b24009b.ada
- b24104a.ada
- b24204a.ada
- b24204b.ada
- b24204c.ada
- b24204d.ada
- b24204e.ada
- b24204f.ada
- b24205a.ada
- b24206a.ada
- b24206b.ada
- b24211b.ada
- b25002a.ada
- b25002b.ada
- b26001a.ada
- b26002a.ada
- b26005a.ada
- b28001a.ada
- b28001b.ada
- b28001c.ada
- b28001d.ada
- b28001e.ada
- b28001f.ada
- b28001g.ada
- b28001h.ada
- b28001i.ada
- b28001j.ada
- b28001k.ada
- b28001l.ada
- b28001m.ada
- b28001n.ada
- b28001o.ada
- b28001p.ada
- b28001q.ada
- b28001r.ada
- b28001s.ada
- b28001t.ada
- b28001u.ada
- b28001v.ada
- b28001w.ada
- b29001a.ada
- b2a003a.ada
- b2a003b.ada
- b2a003c.ada
- b2a003d.ada
- b2a003e.ada
- b2a003f.ada
- b2a005a.ada
- b2a005b.ada
- b2a007a.ada
- b2a010a.ada
- b2a021a.ada
- b32101a.ada
- b32103a.ada
- b32104a.ada
- b32106a.ada
- b32201a.ada
- b32202a.ada
- b32202b.ada
- b32202c.ada
- b330001.a
- b33001a.ada
- b33101a.ada
- b33102a.ada
- b33102b.ada
- b33102c.ada
- b33102d.ada
- b33102e.ada
- b33201a.ada
- b33201b.ada
- b33201c.ada
- b33201d.ada
- b33201e.ada
- b33204a.ada
- b33205a.ada
- b33302a.ada
- b34001b.ada
- b34001e.ada
- b34002b.ada
- b34003b.ada
- b34004b.ada
- b34005b.ada
- b34005e.ada
- b34005h.ada
- b34005k.ada
- b34005n.ada
- b34005q.ada
- b34005t.ada
- b34006b.ada
- b34006e.ada
- b34006h.ada
- b34006k.ada
- b34007b.ada
- b34007e.ada
- b34007h.ada
- b34007k.ada
- b34007n.ada
- b34007q.ada
- b34007t.ada
- b34008b.ada
- b34009b.ada
- b34009e.ada
- b34009h.ada
- b34009k.ada
- b34011a.ada
- b34014b.ada
- b34014d.ada
- b34014f.ada
- b34014i.ada
- b34014m.ada
- b34014o.ada
- b34014q.ada
- b34014s.ada
- b34014v.ada
- b34014z.ada
- b35004a.ada
- b35101a.ada
- b35103a.ada
- b35103b.ada
- b35302a.ada
- b354001.a
- b35401a.ada
- b35401b.ada
- b35403a.ada
- b35501a.ada
- b35501b.ada
- b35506a.ada
- b35506b.ada
- b35506c.ada
- b35506d.ada
- b35701a.ada
- b35709a.ada
- b35901a.ada
- b35901c.ada
- b35901d.ada
- b35a01a.ada
- b35a08a.ada
- b360001.a
- b36001a.ada
- b36002a.ada
- b36101a.ada
- b36102a.ada
- b36103a.ada
- b36105c.dep
- b36171a.ada
- b36171b.ada
- b36171c.ada
- b36171d.ada
- b36171e.ada
- b36171f.ada
- b36171g.ada
- b36171h.ada
- b36171i.ada
- b36201a.ada
- b36307a.ada
- b370001.a
- b370002.a
- b37004a.ada
- b37004b.ada
- b37004c.ada
- b37004d.ada
- b37004e.ada
- b37004f.ada
- b37004g.ada
- b3710010.a
- b3710011.a
- b3710012.a
- b3710013.a
- b3710014.am
- b37101a.ada
- b37102a.ada
- b37104a.ada
- b37106a.ada
- b37201a.ada
- b37201b.ada
- b37203a.ada
- b37301i.ada
- b37301j.ada
- b37302a.ada
- b37303a.ada
- b37309b.ada
- b37310b.ada
- b37311a.ada
- b37401a.ada
- b37409b.ada
- b380001.a
- b38003a.ada
- b38003b.ada
- b38003c.ada
- b38003d.ada
- b38008a.ada
- b38008b.ada
- b38009a.ada
- b38009d.ada
- b38101a.ada
- b38101b.ada
- b38101c.ada
- b38103a.ada
- b38103b.ada
- b38103c0.ada
- b38103c1.ada
- b38103c2.ada
- b38103c3.ada
- b38103d.ada
- b38103e0.ada
- b38103e1.ada
- b38105a.ada
- b38105b.ada
- b38203a.ada
- b390001.a
- b391001.a
- b391002.a
- b391003.a
- b391004.a
- b392001.a
- b392002.a
- b392003.a
- b392004.a
- b392005.a
- b392006.a
- b392007.a
- b392008.a
- b392009.a
- b392010.a
- b392011.a
- b393001.a
- b393002.a
- b393003.a
- b393004.a
- b393005.a
- b393006.a
- b393007.a
- b3a0001.a
- b3a0002.a
- b3a0003.a
- b3a0004.a
- b3a2002.a
- b3a2003.a
- b3a2004.a
- b3a2005.a
- b3a2006.a
- b3a2007.a
- b3a2008.a
- b3a2009.a
- b3a2010.a
- b3a2011.a
- b3a2012.a
- b3a2013.a
- b3a2014.a
- b3a2015.a
- b3a2016.a
- b41101a.ada
- b41101c.ada
- b41201a.ada
- b41201c.ada
- b41202c.ada
- b41202d.ada
- b41324b.ada
- b41325b.ada
- b41327b.ada
- b420001.a
- b430001.a
- b43001m.ada
- b43002d.ada
- b43002e.ada
- b43002f.ada
- b43002g.ada
- b43002h.ada
- b43002i.ada
- b43002j.ada
- b43002k.ada
- b43005a.ada
- b43005b.ada
- b43005f.ada
- b43101a.ada
- b43102a.ada
- b43102b.ada
- b43105c.ada
- b43201a.ada
- b43201c.ada
- b43201d.ada
- b43202a.ada
- b43202c.ada
- b43209b.ada
- b43221a.ada
- b43221b.ada
- b43223a.ada
- b44001a.ada
- b44001b.ada
- b44002b.ada
- b44002c.ada
- b44004a.ada
- b44004b.ada
- b44004c.ada
- b44004d.ada
- b44004e.ada
- b45102a.ada
- b45116a.ada
- b45121a.ada
- b45204a.ada
- b45205a.ada
- b45206c.ada
- b45207a.ada
- b45207b.ada
- b45207c.ada
- b45207d.ada
- b45207g.ada
- b45207h.ada
- b45207i.ada
- b45207j.ada
- b45207m.ada
- b45207n.ada
- b45207o.ada
- b45207p.ada
- b45207s.ada
- b45207t.ada
- b45207u.ada
- b45207v.ada
- b45208a.ada
- b45208b.ada
- b45208c.ada
- b45208g.ada
- b45208h.ada
- b45208i.ada
- b45208m.ada
- b45208n.ada
- b45208s.ada
- b45208t.ada
- b45209a.ada
- b45209b.ada
- b45209c.ada
- b45209d.ada
- b45209e.ada
- b45209f.ada
- b45209g.ada
- b45209h.ada
- b45209i.ada
- b45209j.ada
- b45209k.ada
- b45221a.ada
- b45261a.ada
- b45261b.ada
- b45261c.ada
- b45261d.ada
- b45301a.ada
- b45301b.ada
- b45301c.ada
- b45302a.ada
- b45341a.ada
- b455002.a
- b45501a.ada
- b45501b.ada
- b45501c.ada
- b45522a.ada
- b45537a.ada
- b45601a.ada
- b45625a.ada
- b45661a.ada
- b460001.a
- b460002.a
- b460004.a
- b460005.a
- b460006.a
- b46002a.ada
- b46003a.ada
- b46004a.ada
- b46004b.ada
- b46004c.ada
- b46004d.ada
- b46004e.ada
- b46005a.ada
- b47001a.ada
- b480001.a
- b48001a.ada
- b48001b.ada
- b48002a.ada
- b48002b.ada
- b48002c.ada
- b48002d.ada
- b48002e.ada
- b48002g.ada
- b48003a.ada
- b48003b.ada
- b48003c.ada
- b48003d.ada
- b48003e.ada
- b490001.a
- b490002.a
- b49002a.ada
- b49004a.ada
- b49005a.ada
- b49007a.ada
- b49007b.ada
- b49008a.ada
- b49008c.ada
- b49009b.ada
- b49009c.ada
- b49010a.ada
- b49011a.ada
- b4a010c.ada
- b4a016a.ada
- b51001a.ada
- b51004b.ada
- b51004c.ada
- b52002a.ada
- b52002b.ada
- b52002c.ada
- b52002d.ada
- b52002e.ada
- b52002f.ada
- b52002g.ada
- b52004a.ada
- b52004b.ada
- b52004c.ada
- b52004d.dep
- b52004e.dep
- b53001a.ada
- b53001b.ada
- b53002a.ada
- b53002b.ada
- b53009a.ada
- b53009b.ada
- b53009c.ada
- b54a01b.ada
- b54a01f.ada
- b54a01g.ada
- b54a01l.ada
- b54a05a.ada
- b54a05b.ada
- b54a10a.ada
- b54a12a.ada
- b54a20a.ada
- b54a21a.ada
- b54a25a.ada
- b54a60a.ada
- b54a60b.ada
- b54b01b.tst
- b54b01c.ada
- b54b02b.ada
- b54b02c.ada
- b54b02d.ada
- b54b04a.ada
- b54b04b.ada
- b54b05a.ada
- b54b06a.ada
- b55a01a.ada
- b55a01d.ada
- b55a01e.ada
- b55a01j.ada
- b55a01k.ada
- b55a01l.ada
- b55a01n.ada
- b55a01o.ada
- b55a01t.ada
- b55a01u.ada
- b55a01v.ada
- b55b01a.ada
- b55b01b.ada
- b55b09b.ada
- b55b09c.dep
- b55b09d.dep
- b55b12b.ada
- b55b12c.ada
- b55b17a.ada
- b55b17b.ada
- b55b17c.ada
- b55b18a.ada
- b56001a.ada
- b56001d.ada
- b56001e.ada
- b56001f.ada
- b56001g.ada
- b56001h.ada
- b57001a.ada
- b57001b.ada
- b57001c.ada
- b57001d.ada
- b58001a.ada
- b58002a.ada
- b58002b.ada
- b58002c.ada
- b58003a.ada
- b58003b.ada
- b59001a.ada
- b59001c.ada
- b59001d.ada
- b59001e.ada
- b59001f.ada
- b59001g.ada
- b59001h.ada
- b59001i.ada
- b610001.a
- b61001f.ada
- b61005a.ada
- b61006a.ada
- b61011a.ada
- b62001a.ada
- b62001b.ada
- b62001c.ada
- b62001d.ada
- b63001a.ada
- b63001b.ada
- b63005a.ada
- b63005b.ada
- b63006a.ada
- b63009a.ada
- b63009b.ada
- b63009c0.ada
- b63009c1.ada
- b63009c2.ada
- b63009c3.ada
- b63103a.ada
- b64002a.ada
- b64002c.ada
- b64003a.ada
- b64004a.ada
- b64004b.ada
- b64004c.ada
- b64004d.ada
- b64004e.ada
- b64004f.ada
- b641001.a
- b64101a.ada
- b64201a.ada
- b65001a.ada
- b65002a.ada
- b65002b.ada
- b660001.a
- b660002.a
- b66001a.ada
- b66001b.ada
- b66001c.ada
- b66001d.ada
- b67001a.ada
- b67001b.ada
- b67001c.ada
- b67001d.ada
- b67001h.ada
- b67001i.ada
- b67001j.ada
- b67001k.ada
- b67004a.ada
- b71001a.ada
- b71001b.ada
- b71001c.ada
- b71001d.ada
- b71001f.ada
- b71001g.ada
- b71001h.ada
- b71001i.ada
- b71001j.ada
- b71001l.ada
- b71001m.ada
- b71001n.ada
- b71001o.ada
- b71001p.ada
- b71001r.ada
- b71001t.ada
- b71001u.ada
- b71001v.ada
- b7200010.a
- b7200011.a
- b7200012.a
- b7200013.a
- b7200014.a
- b7200015.a
- b7200016.a
- b730001.a
- b730002.a
- b730003.a
- b730004.a
- b730005.a
- b7300060.a
- b7300061.a
- b7300062.a
- b7300063.am
- b73001a.ada
- b73001b.ada
- b73001c.ada
- b73001d.ada
- b73001e.ada
- b73001f.ada
- b73001g.ada
- b73001h.ada
- b73004a.ada
- b73004b0.ada
- b73004b1.ada
- b73004b2.ada
- b7310010.a
- b7310011.a
- b7310012.a
- b7310013.a
- b7310014.a
- b7310015.a
- b7310016.am
- b731a01.a
- b731a02.a
- b740001.a
- b74001a.ada
- b74001b.ada
- b74101a.ada
- b74101b.ada
- b74103a.ada
- b74103d.ada
- b74103e.ada
- b74103g.ada
- b74103i.ada
- b74104a.ada
- b74105a.ada
- b74105c.ada
- b74201a.ada
- b74202a.ada
- b74202b.ada
- b74202c.ada
- b74202d.ada
- b74203b.ada
- b74203c.ada
- b74203d.ada
- b74203e.ada
- b74205a.ada
- b74207a.ada
- b74304a.ada
- b74304b.ada
- b74304c.ada
- b74404a.ada
- b74404b.ada
- b74409a.ada
- b810001.a
- b830001.a
- b8300020.a
- b8300021.a
- b8300022.a
- b8300023.a
- b8300024.a
- b8300025.am
- b83001a.ada
- b83003a.ada
- b83003b0.ada
- b83003b1.ada
- b83003b2.ada
- b83003b3.ada
- b83003b4.ada
- b83003c.ada
- b83004a.ada
- b83004b0.ada
- b83004b1.ada
- b83004b2.ada
- b83004b3.ada
- b83004c0.ada
- b83004c1.ada
- b83004c2.ada
- b83004d0.ada
- b83004d1.ada
- b83004d2.ada
- b83004d3.ada
- b83006a.ada
- b83006b.ada
- b83008a.ada
- b83008b.ada
- b83011a.ada
- b83023b.ada
- b83024b.ada
- b83024f0.ada
- b83024f1.ada
- b83024f2.ada
- b83024f3.ada
- b83026b.ada
- b83027b.ada
- b83027d.ada
- b83028b.ada
- b83029b.ada
- b83030b.ada
- b83030d.ada
- b83031b.ada
- b83031d.ada
- b83031f.ada
- b83032b.ada
- b83033b.ada
- b83041e.ada
- b83a01a.ada
- b83a01b.ada
- b83a01c.ada
- b83a05a.ada
- b83a06b.ada
- b83a06h.ada
- b83a07a.ada
- b83a07b.ada
- b83a07c.ada
- b83a08b.ada
- b83a09a.ada
- b83b01a.ada
- b83b02c.ada
- b83e01a.ada
- b83e01b.ada
- b83e01c.ada
- b83e01d.ada
- b83e01e0.ada
- b83e01e1.ada
- b83e01e2.ada
- b83e01e3.ada
- b83e01f0.ada
- b83e01f1.ada
- b83e01f2.ada
- b83e01f3.ada
- b83e01f4.ada
- b83e01f5.ada
- b83e01f6.ada
- b83e11a.ada
- b83f02a.ada
- b83f02b.ada
- b83f02c.ada
- b840001.a
- b84001a.ada
- b84002b.ada
- b84004a.ada
- b84005b.ada
- b84006a.ada
- b84007a.ada
- b84008b.ada
- b85001a.ada
- b85001b.ada
- b85001c.ada
- b85001d.ada
- b85001e.ada
- b85001f.ada
- b85001g.ada
- b85001h.ada
- b85001i.ada
- b85001j.ada
- b85001k.ada
- b85001l.ada
- b85002a.ada
- b85003a.ada
- b85003b.ada
- b85004a.ada
- b85008f.ada
- b85008g.ada
- b85008h.ada
- b85010a.ada
- b85010b.ada
- b85012a.ada
- b85013c.ada
- b85013d.ada
- b85015a.ada
- b8510010.a
- b8510011.a
- b8510012.am
- b854001.a
- b86001a0.ada
- b86001a1.ada
- b87b23b.ada
- b87b26a.ada
- b87b48c.ada
- b91001b.ada
- b91001c.ada
- b91001d.ada
- b91001e.ada
- b91001f.ada
- b91001g.ada
- b91002a.ada
- b91002b.ada
- b91002c.ada
- b91002d.ada
- b91002e.ada
- b91002f.ada
- b91002g.ada
- b91002h.ada
- b91002i.ada
- b91002j.ada
- b91002k.ada
- b91002l.ada
- b91003a.ada
- b91003b.ada
- b91003c.ada
- b91003d.ada
- b91003e.ada
- b91004a.ada
- b91005a.ada
- b92001a.ada
- b92001b.ada
- b940001.a
- b940002.a
- b940003.a
- b940004.a
- b940005.a
- b940006.a
- b940007.a
- b95001a.ada
- b95001b.ada
- b95001d.ada
- b95002a.ada
- b95003a.ada
- b95004a.ada
- b95004b.ada
- b95006a.ada
- b95006b.ada
- b95006c.ada
- b95006d.ada
- b95007a.ada
- b95007b.ada
- b95020a.ada
- b95020b0.ada
- b95020b1.ada
- b95020b2.ada
- b95030a.ada
- b95031a.ada
- b95032a.ada
- b95061a.ada
- b95061b.ada
- b95061c.ada
- b95061d.ada
- b95061e.ada
- b95061f.ada
- b95061g.ada
- b95062a.ada
- b95063a.ada
- b95064a.ada
- b95068a.ada
- b95070a.ada
- b95080a.ada
- b95080c.ada
- b95081a.ada
- b95082a.ada
- b95082b.ada
- b95082c.ada
- b95082d.ada
- b95082e.ada
- b95082f.ada
- b95083a.ada
- b95094a.ada
- b95094b.ada
- b95094c.ada
- b951001.a
- b952001.a
- b952002.a
- b952003.a
- b952004.a
- b954001.a
- b954003.a
- b954004.a
- b960001.a
- b96002a.ada
- b97102b.ada
- b97102c.ada
- b97102d.ada
- b97102f.ada
- b97102g.ada
- b97102h.ada
- b97102i.ada
- b97103a.ada
- b97103b.ada
- b97103d.ada
- b97103e.ada
- b97103f.ada
- b97103g.ada
- b97104a.ada
- b97104b.ada
- b97104c.ada
- b97104d.ada
- b97104e.ada
- b97104f.ada
- b97104g.ada
- b97107a.ada
- b97108a.ada
- b97108b.ada
- b97109a.ada
- b97110a.ada
- b97110b.ada
- b97111a.ada
- b97206a.ada
- b97306a.ada
- b99001a.ada
- b99001b.ada
- b99002a.ada
- b99002b.ada
- b99002c.ada
- b99003a.ada
- b9a001a.ada
- b9a001b.ada
- ba1001a0.ada
- ba1001a1.ada
- ba1001a4.ada
- ba1001ac.ada
- ba1001d.ada
- ba1010a0.ada
- ba1010a1.ada
- ba1010a2.ada
- ba1010a3.ada
- ba1010b0.ada
- ba1010b1.ada
- ba1010b2.ada
- ba1010b4.ada
- ba1010b5.ada
- ba1010b6.ada
- ba1010b7.ada
- ba1010b8.ada
- ba1010c0.ada
- ba1010c1.ada
- ba1010c2.ada
- ba1010c3.ada
- ba1010c4.ada
- ba1010c5.ada
- ba1010c6.ada
- ba1010d0.ada
- ba1010d1.ada
- ba1010d2.ada
- ba1010d3.ada
- ba1010e0.ada
- ba1010e1.ada
- ba1010e2.ada
- ba1010e3.ada
- ba1010e4.ada
- ba1010e5.ada
- ba1010e6.ada
- ba1010f0.ada
- ba1010f1.ada
- ba1010f3.ada
- ba1010f4.ada
- ba1010f5.ada
- ba1010f6.ada
- ba1010f7.ada
- ba1010f8.ada
- ba1010g0.ada
- ba1010g2.ada
- ba1010g3.ada
- ba1010g4.ada
- ba1010g5.ada
- ba1010h0.ada
- ba1010h2.ada
- ba1010i0.ada
- ba1010i1.ada
- ba1010i3.ada
- ba1010i4.ada
- ba1010j0.ada
- ba1010j1.ada
- ba1010j2.ada
- ba1010j4.ada
- ba1010j5.ada
- ba1010j6.ada
- ba1010j7.ada
- ba1010j8.ada
- ba1010k0.ada
- ba1010k1.ada
- ba1010k2.ada
- ba1010k3.ada
- ba1010k4.ada
- ba1010k5.ada
- ba1010k6.ada
- ba1010l0.ada
- ba1010l1.ada
- ba1010l2.ada
- ba1010l3.ada
- ba1010l4.ada
- ba1010l5.ada
- ba1010l6.ada
- ba1010m0.ada
- ba1010m1.ada
- ba1010m3.ada
- ba1010m4.ada
- ba1010m5.ada
- ba1010m6.ada
- ba1010m7.ada
- ba1010m8.ada
- ba1010n0.ada
- ba1010n2.ada
- ba1010n3.ada
- ba1010n4.ada
- ba1010n5.ada
- ba1010p0.ada
- ba1010p2.ada
- ba1010q0.ada
- ba1010q1.ada
- ba1010q3.ada
- ba1010q4.ada
- ba1011b0.ada
- ba1011b1.ada
- ba1011b2.ada
- ba1011b3.ada
- ba1011b4.ada
- ba1011b5.ada
- ba1011b6.ada
- ba1011b7.ada
- ba1011b8.ada
- ba1011c0.ada
- ba1011c1.ada
- ba1011c2.ada
- ba1011c3.ada
- ba1011c4.ada
- ba1011c5.ada
- ba1011c6.ada
- ba1011c7.ada
- ba1011c8.ada
- ba1020a0.ada
- ba1020a1.ada
- ba1020a2.ada
- ba1020a3.ada
- ba1020a4.ada
- ba1020a5.ada
- ba1020a6.ada
- ba1020a7.ada
- ba1020a8.ada
- ba1020b0.ada
- ba1020b1.ada
- ba1020b2.ada
- ba1020b3.ada
- ba1020b4.ada
- ba1020b5.ada
- ba1020b6.ada
- ba1020c0.ada
- ba1020c1.ada
- ba1020c2.ada
- ba1020c3.ada
- ba1020c4.ada
- ba1020c5.ada
- ba1020f0.ada
- ba1020f1.ada
- ba1020f2.ada
- ba11001.a
- ba11002.a
- ba11003.a
- ba11004.a
- ba11005.a
- ba11007.a
- ba11008.a
- ba11009.a
- ba11010.a
- ba11011.a
- ba11012.a
- ba1101a.ada
- ba1101b0.ada
- ba1101b1.ada
- ba1101b2.ada
- ba1101b3.ada
- ba1101b4.ada
- ba1101c0.ada
- ba1101c1.ada
- ba1101c2.ada
- ba1101c3.ada
- ba1101c4.ada
- ba1101c5.ada
- ba1101c6.ada
- ba1101e0.ada
- ba1101e1.ada
- ba1101f.ada
- ba1101g.ada
- ba1109a0.ada
- ba1109a1.ada
- ba1109a2.ada
- ba1110a0.ada
- ba1110a1.ada
- ba1110a2.ada
- ba1110a3.ada
- ba1110a4.ada
- ba1110a5.ada
- ba12001.a
- ba12002.a
- ba12003.a
- ba12004.a
- ba12005.a
- ba12007.a
- ba12008.a
- ba13b01.a
- ba13b02.a
- ba15001.a
- ba150020.a
- ba150021.a
- ba150022.a
- ba150023.a
- ba150024.a
- ba150025.a
- ba150026.a
- ba150027.a
- ba150028.a
- ba150029.am
- ba2001a.ada
- ba2001b.ada
- ba2001c.ada
- ba2001d.ada
- ba2001f0.ada
- ba2001f1.ada
- ba2001f2.ada
- ba2003b0.ada
- ba2003b1.ada
- ba2011a0.ada
- ba2011a1.ada
- ba2011a2.ada
- ba2011a3.ada
- ba2011a4.ada
- ba2011a5.ada
- ba2011a6.ada
- ba2011a7.ada
- ba2011a8.ada
- ba2011a9.ada
- ba2013a.ada
- ba2013b.ada
- ba21001.a
- ba21002.a
- ba210030.a
- ba210031.a
- ba210032.a
- ba210033.a
- ba210034.a
- ba210035.a
- ba210040.a
- ba210041.a
- ba210042.a
- ba210043.a
- ba210044.a
- ba210045.am
- ba21a01.a
- ba21a02.a
- ba3001a0.ada
- ba3001a1.ada
- ba3001a2.ada
- ba3001a3.ada
- ba3001b0.ada
- ba3001b1.ada
- ba3001c0.ada
- ba3001c1.ada
- ba3001e0.ada
- ba3001e1.ada
- ba3001e2.ada
- ba3001e3.ada
- ba3001f0.ada
- ba3001f1.ada
- ba3001f2.ada
- ba3001f3.ada
- ba3006a0.ada
- ba3006a1.ada
- ba3006a2.ada
- ba3006a3.ada
- ba3006a4.ada
- ba3006a5.ada
- ba3006a6.ada
- ba3006b0.ada
- ba3006b1.ada
- ba3006b2.ada
- ba3006b3.ada
- ba3006b4.ada
- bb10001.a
- bb20001.a
- bb2001a.ada
- bb2002a.ada
- bb2003a.ada
- bb2003b.ada
- bb2003c.ada
- bb3001a.ada
- bb3002a.ada
- bc1001a.ada
- bc1002a.ada
- bc1005a.ada
- bc1008a.ada
- bc1008b.ada
- bc1008c.ada
- bc1009a.ada
- bc1011a.ada
- bc1011b.ada
- bc1011c.ada
- bc1012a.ada
- bc1013a.ada
- bc1014a.ada
- bc1014b.ada
- bc1016a.ada
- bc1016b.ada
- bc1101a.ada
- bc1102a.ada
- bc1103a.ada
- bc1106a.ada
- bc1107a.ada
- bc1109a.ada
- bc1109b.ada
- bc1109c.ada
- bc1109d.ada
- bc1110a.ada
- bc1201a.ada
- bc1201b.ada
- bc1201c.ada
- bc1201d.ada
- bc1201e.ada
- bc1201f.ada
- bc1201g.ada
- bc1201h.ada
- bc1201i.ada
- bc1201j.ada
- bc1201k.ada
- bc1201l.ada
- bc1202a.ada
- bc1202c.ada
- bc1202e.ada
- bc1202f.ada
- bc1202g.ada
- bc1203a.ada
- bc1205a.ada
- bc1206a.ada
- bc1207a.ada
- bc1208a.ada
- bc1226a.ada
- bc1230a.ada
- bc1303a.ada
- bc1303b.ada
- bc1303c.ada
- bc1303d.ada
- bc1303e.ada
- bc1303f.ada
- bc1303g.ada
- bc1306a.ada
- bc2001b.ada
- bc2001c.ada
- bc2001d.ada
- bc2001e.ada
- bc2004a.ada
- bc2004b.ada
- bc30001.a
- bc3001a.ada
- bc3002a.ada
- bc3002b.ada
- bc3002c.ada
- bc3002d.ada
- bc3002e.ada
- bc3005a.ada
- bc3005b.ada
- bc3005c.ada
- bc3006a.ada
- bc3009c.ada
- bc3011b.ada
- bc3013a.ada
- bc3016g.ada
- bc3018a.ada
- bc3101a.ada
- bc3101b.ada
- bc3102a.ada
- bc3102b.ada
- bc3103b.ada
- bc3123c.ada
- bc3201a.ada
- bc3201b.ada
- bc3201c.ada
- bc3202a.ada
- bc3202b.ada
- bc3202c.ada
- bc3202d.ada
- bc3205c.ada
- bc3301a.ada
- bc3301b.ada
- bc3302a.ada
- bc3302b.ada
- bc3303a.ada
- bc3304a.ada
- bc3401a.ada
- bc3401b.ada
- bc3402a.ada
- bc3402b.ada
- bc3403a.ada
- bc3403b.ada
- bc3403c.ada
- bc3404a.ada
- bc3404b.ada
- bc3404c.ada
- bc3404d.ada
- bc3404e.ada
- bc3404f.ada
- bc3405a.ada
- bc3405b.ada
- bc3405d.ada
- bc3405e.ada
- bc3405f.ada
- bc3501a.ada
- bc3501b.ada
- bc3501c.ada
- bc3501d.ada
- bc3501e.ada
- bc3501f.ada
- bc3501g.ada
- bc3501h.ada
- bc3501i.ada
- bc3501j.ada
- bc3501k.ada
- bc3502a.ada
- bc3502b.ada
- bc3502c.ada
- bc3502d.ada
- bc3502e.ada
- bc3502f.ada
- bc3502g.ada
- bc3502h.ada
- bc3502i.ada
- bc3502j.ada
- bc3502k.ada
- bc3502l.ada
- bc3502m.ada
- bc3502n.ada
- bc3502o.ada
- bc3503a.ada
- bc3503c.ada
- bc3503d.ada
- bc3503e.ada
- bc3503f.ada
- bc3604a.ada
- bc3604b.ada
- bc3607a.ada
- bc40001.a
- bc40002.a
- bc50001.a
- bc50002.a
- bc50003.a
- bc50004.a
- bc51002.a
- bc51003.a
- bc51004.a
- bc51005.a
- bc51006.a
- bc51007.a
- bc51011.a
- bc51012.a
- bc51013.a
- bc51015.a
- bc51016.a
- bc51017.a
- bc51018.a
- bc51019.a
- bc51020.a
- bc51b01.a
- bc51b02.a
- bc51c01.a
- bc51c02.a
- bc53001.a
- bc53002.a
- bc54001.a
- bc54002.a
- bc54003.a
- bc54a01.a
- bc54a02.a
- bc54a03.a
- bc54a04.a
- bc54a05.a
- bc54a06.a
- bc70001.a
- bc70002.a
- bc70003.a
- bc70004.a
- bc70005.a
- bc70006.a
- bc70007.a
- bc70008.a
- bc70009.a
- bc70010.a
- bd1b01a.ada
- bd1b02b.ada
- bd1b03c.ada
- bd1b05e.ada
- bd1b06j.ada
- bd2001b.ada
- bd2a01h.ada
- bd2a02a.tst
- bd2a03a.ada
- bd2a03b.ada
- bd2a06a.ada
- bd2a25a.ada
- bd2a35a.ada
- bd2a45a.ada
- bd2a55a.ada
- bd2a55b.ada
- bd2a67a.ada
- bd2a77a.ada
- bd2a85a.ada
- bd2a85b.ada
- bd2b01c.ada
- bd2b02a.ada
- bd2b03a.ada
- bd2b03b.ada
- bd2b03c.ada
- bd2c01d.tst
- bd2c02a.tst
- bd2c03a.tst
- bd2d01c.ada
- bd2d01d.ada
- bd2d02a.ada
- bd2d03a.ada
- bd2d03b.ada
- bd3001a.ada
- bd3001b.ada
- bd3001c.ada
- bd3002a.ada
- bd3003a.ada
- bd3003b.ada
- bd3012a.ada
- bd3013a.ada
- bd4001a.ada
- bd4002a.ada
- bd4003a.ada
- bd4003b.ada
- bd4003c.ada
- bd4006a.tst
- bd4007a.ada
- bd4009a.ada
- bd4011a.ada
- bd5001a.ada
- bd5005a.ada
- bd5005d.ada
- bd5102a.ada
- bd5102b.ada
- bd5103a.ada
- bd5104a.ada
- bd7001a.ada
- bd7101h.ada
- bd7201c.ada
- bd7203a.ada
- bd7204a.ada
- bd7205a.ada
- bd7301a.ada
- bd7302a.ada
- bd8001a.tst
- bd8002a.tst
- bd8003a.tst
- bd8004a.tst
- bd8004b.tst
- bd8004c.tst
- bdb0a01.a
- bdd2001.a
- bdd2002.a
- bde0001.a
- bde0002.a
- bde0003.a
- bde0004.a
- bde0005.a
- bde0006.a
- bde0007.a
- bde0008.a
- bde0009.a
- bde0010.a
- be2101e.ada
- be2101j.ada
- be2114a.ada
- be2116a.ada
- be2208a.ada
- be3002a.ada
- be3002e.ada
- be3205a.ada
- be3301c.ada
- be3606c.ada
- be3703a.ada
- be3802a.ada
- be3803a.ada
- be3902a.ada
- be3903a.ada
- bxa8001.a
- bxac001.a
- bxac002.a
- bxac003.a
- bxac004.a
- bxac005.a
- bxc3001.a
- bxc3002.a
- bxc5001.a
- bxc6001.a
- bxc6002.a
- bxc6003.a
- bxc6a01.a
- bxc6a02.a
- bxc6a03.a
- bxc6a04.a
- bxd1001.a
- bxd1002.a
- bxe2007.a
- bxe2008.a
- bxe2009.a
- bxe2010.a
- bxe2011.a
- bxe2012.a
- bxe2013.a
- bxe2a01.a
- bxe2a02.a
- bxe2a03.a
- bxe2a04.a
- bxe2a05.a
- bxe2a06.a
- bxe4001.a
- bxf1001.a
- bxh4001.a
- bxh4002.a
- bxh4003.a
- bxh4004.a
- bxh4005.a
- bxh4006.a
- bxh4007.a
- bxh4008.a
- bxh4009.a
- bxh4010.a
- bxh4011.a
- bxh4012.a
- bxh4013.a
- c23001a.ada
- c23003a.tst
- c23003b.tst
- c23003g.tst
- c23003i.tst
- c23006a.ada
- c23006b.ada
- c23006c.ada
- c23006d.ada
- c23006e.ada
- c23006f.ada
- c23006g.ada
- c24002d.ada
- c24003a.ada
- c24003b.ada
- c24003c.ada
- c24106a.ada
- c24202d.ada
- c24203a.ada
- c24203b.ada
- c24207a.ada
- c24211a.ada
- c250001.aw
- c250002.aw
- c25001a.ada
- c25001b.ada
- c26006a.ada
- c26008a.ada
- c2a001a.ada
- c2a001b.ada
- c2a001c.ada
- c2a002a.ada
- c2a008a.ada
- c2a021b.ada
- c32001a.ada
- c32001b.ada
- c32001c.ada
- c32001d.ada
- c32001e.ada
- c32107a.ada
- c32107c.ada
- c32108a.ada
- c32108b.ada
- c32111a.ada
- c32111b.ada
- c32112b.ada
- c32113a.ada
- c32115a.ada
- c32115b.ada
- c330001.a
- c330002.a
- c332001.a
- c340001.a
- c34001a.ada
- c34001c.ada
- c34001d.ada
- c34001f.ada
- c34002a.ada
- c34002c.ada
- c34003a.ada
- c34003c.ada
- c34004a.ada
- c34004c.ada
- c34005a.ada
- c34005c.ada
- c34005d.ada
- c34005f.ada
- c34005g.ada
- c34005i.ada
- c34005j.ada
- c34005l.ada
- c34005m.ada
- c34005o.ada
- c34005p.ada
- c34005r.ada
- c34005s.ada
- c34005u.ada
- c34005v.ada
- c34006a.ada
- c34006d.ada
- c34006f.ada
- c34006g.ada
- c34006j.ada
- c34006l.ada
- c34007a.ada
- c34007d.ada
- c34007f.ada
- c34007g.ada
- c34007i.ada
- c34007j.ada
- c34007m.ada
- c34007p.ada
- c34007r.ada
- c34007s.ada
- c34007u.ada
- c34007v.ada
- c34008a.ada
- c34009a.ada
- c34009d.ada
- c34009f.ada
- c34009g.ada
- c34009j.ada
- c34009l.ada
- c34011b.ada
- c34012a.ada
- c34014a.ada
- c34014c.ada
- c34014e.ada
- c34014g.ada
- c34014h.ada
- c34014n.ada
- c34014p.ada
- c34014r.ada
- c34014t.ada
- c34014u.ada
- c34018a.ada
- c340a01.a
- c340a02.a
- c341a01.a
- c341a02.a
- c341a03.a
- c341a04.a
- c35003a.ada
- c35003b.ada
- c35003d.ada
- c35102a.ada
- c352001.a
- c354002.a
- c354003.a
- c35502a.ada
- c35502b.ada
- c35502c.ada
- c35502d.tst
- c35502e.ada
- c35502f.tst
- c35502g.ada
- c35502h.ada
- c35502i.ada
- c35502j.ada
- c35502k.ada
- c35502l.ada
- c35502m.ada
- c35502n.ada
- c35502o.ada
- c35502p.ada
- c35503a.ada
- c35503b.ada
- c35503c.ada
- c35503d.tst
- c35503e.ada
- c35503f.tst
- c35503g.ada
- c35503h.ada
- c35503k.ada
- c35503l.ada
- c35503o.ada
- c35503p.ada
- c35504a.ada
- c35504b.ada
- c35505c.ada
- c35505e.ada
- c35505f.ada
- c35507a.ada
- c35507b.ada
- c35507c.ada
- c35507e.ada
- c35507g.ada
- c35507h.ada
- c35507i.ada
- c35507j.ada
- c35507k.ada
- c35507l.ada
- c35507m.ada
- c35507n.ada
- c35507o.ada
- c35507p.ada
- c35508a.ada
- c35508b.ada
- c35508c.ada
- c35508e.ada
- c35508g.ada
- c35508h.ada
- c35508k.ada
- c35508l.ada
- c35508o.ada
- c35508p.ada
- c35703a.ada
- c35704a.ada
- c35704b.ada
- c35704c.ada
- c35704d.ada
- c35801d.ada
- c35902d.ada
- c35904a.ada
- c35904b.ada
- c35a02a.ada
- c35a05a.ada
- c35a05d.ada
- c35a05n.ada
- c35a05q.ada
- c35a07a.ada
- c35a07d.ada
- c35a08b.ada
- c360002.a
- c36104a.ada
- c36104b.ada
- c36172a.ada
- c36172b.ada
- c36172c.ada
- c36174a.ada
- c36180a.ada
- c36202c.ada
- c36203a.ada
- c36204a.ada
- c36204b.ada
- c36204c.ada
- c36204d.ada
- c36205a.ada
- c36205b.ada
- c36205c.ada
- c36205d.ada
- c36205e.ada
- c36205f.ada
- c36205g.ada
- c36205h.ada
- c36205i.ada
- c36205j.ada
- c36205k.ada
- c36205l.ada
- c36301a.ada
- c36301b.ada
- c36302a.ada
- c36304a.ada
- c36305a.ada
- c37002a.ada
- c37003a.ada
- c37003b.ada
- c37005a.ada
- c37006a.ada
- c37008a.ada
- c37008b.ada
- c37009a.ada
- c37010a.ada
- c37010b.ada
- c371001.a
- c371002.a
- c371003.a
- c37102b.ada
- c37103a.ada
- c37105a.ada
- c37107a.ada
- c37108b.ada
- c37206a.ada
- c37207a.ada
- c37208a.ada
- c37208b.ada
- c37209a.ada
- c37209b.ada
- c37210a.ada
- c37211a.ada
- c37211b.ada
- c37211c.ada
- c37211d.ada
- c37211e.ada
- c37213b.ada
- c37213d.ada
- c37213f.ada
- c37213h.ada
- c37213j.ada
- c37213k.ada
- c37213l.ada
- c37215b.ada
- c37215d.ada
- c37215f.ada
- c37215h.ada
- c37217a.ada
- c37217b.ada
- c37217c.ada
- c37304a.ada
- c37305a.ada
- c37306a.ada
- c37309a.ada
- c37310a.ada
- c37312a.ada
- c37402a.ada
- c37403a.ada
- c37404a.ada
- c37404b.ada
- c37405a.ada
- c37411a.ada
- c380001.a
- c380002.a
- c380003.a
- c380004.a
- c38002a.ada
- c38002b.ada
- c38005a.ada
- c38005b.ada
- c38005c.ada
- c38006a.ada
- c38102a.ada
- c38102b.ada
- c38102c.ada
- c38102d.ada
- c38102e.ada
- c38104a.ada
- c38107a.ada
- c38107b.ada
- c38108a.ada
- c38108b.ada
- c38108c0.ada
- c38108c1.ada
- c38108c2.ada
- c38108d0.ada
- c38108d1.ada
- c38202a.ada
- c3900010.a
- c3900011.am
- c390002.a
- c390003.a
- c390004.a
- c3900050.a
- c3900051.a
- c3900052.a
- c3900053.am
- c3900060.a
- c3900061.a
- c3900062.a
- c3900063.am
- c390007.a
- c390010.a
- c390011.a
- c39006a.ada
- c39006b.ada
- c39006c0.ada
- c39006c1.ada
- c39006d.ada
- c39006e.ada
- c39006f0.ada
- c39006f1.ada
- c39006f2.ada
- c39006f3.ada
- c39006g.ada
- c39007a.ada
- c39007b.ada
- c39008a.ada
- c39008b.ada
- c39008c.ada
- c390a010.a
- c390a011.am
- c390a020.a
- c390a021.a
- c390a022.am
- c390a030.a
- c390a031.am
- c391001.a
- c391002.a
- c392002.a
- c392003.a
- c392004.a
- c392005.a
- c392008.a
- c392010.a
- c392011.a
- c392013.a
- c392014.a
- c392a01.a
- c392c05.a
- c392c07.a
- c392d01.a
- c392d02.a
- c392d03.a
- c393001.a
- c393007.a
- c393008.a
- c393009.a
- c393010.a
- c393011.a
- c393012.a
- c393a02.a
- c393a03.a
- c393a05.a
- c393a06.a
- c393b12.a
- c393b13.a
- c393b14.a
- c3a0001.a
- c3a0002.a
- c3a0003.a
- c3a0004.a
- c3a0005.a
- c3a0006.a
- c3a0007.a
- c3a0008.a
- c3a0009.a
- c3a0010.a
- c3a0011.a
- c3a00120.a
- c3a00121.a
- c3a00122.am
- c3a0013.a
- c3a0014.a
- c3a0015.a
- c3a1001.a
- c3a1002.a
- c3a2001.a
- c3a2002.a
- c3a2003.a
- c3a2a01.a
- c3a2a02.a
- c410001.a
- c41101d.ada
- c41103a.ada
- c41103b.ada
- c41104a.ada
- c41105a.ada
- c41107a.ada
- c41201d.ada
- c41203a.ada
- c41203b.ada
- c41204a.ada
- c41205a.ada
- c41206a.ada
- c41207a.ada
- c41301a.ada
- c41303a.ada
- c41303b.ada
- c41303c.ada
- c41303e.ada
- c41303f.ada
- c41303g.ada
- c41303i.ada
- c41303j.ada
- c41303k.ada
- c41303m.ada
- c41303n.ada
- c41303o.ada
- c41303q.ada
- c41303r.ada
- c41303s.ada
- c41303u.ada
- c41303v.ada
- c41303w.ada
- c41304a.ada
- c41304b.ada
- c41306a.ada
- c41306b.ada
- c41306c.ada
- c41307d.ada
- c41309a.ada
- c41320a.ada
- c41321a.ada
- c41322a.ada
- c41323a.ada
- c41324a.ada
- c41325a.ada
- c41326a.ada
- c41327a.ada
- c41328a.ada
- c41401a.ada
- c41402a.ada
- c41404a.ada
- c420001.a
- c42006a.ada
- c42007e.ada
- c43003a.ada
- c43004a.ada
- c43004c.ada
- c431001.a
- c43103a.ada
- c43103b.ada
- c43104a.ada
- c43105a.ada
- c43105b.ada
- c43106a.ada
- c43107a.ada
- c43108a.ada
- c432001.a
- c432002.a
- c432003.a
- c432004.a
- c43204a.ada
- c43204c.ada
- c43204e.ada
- c43204f.ada
- c43204g.ada
- c43204h.ada
- c43204i.ada
- c43205a.ada
- c43205b.ada
- c43205c.ada
- c43205d.ada
- c43205e.ada
- c43205g.ada
- c43205h.ada
- c43205i.ada
- c43205j.ada
- c43205k.ada
- c43206a.ada
- c43207b.ada
- c43207d.ada
- c43208a.ada
- c43208b.ada
- c43209a.ada
- c43210a.ada
- c43211a.ada
- c43212a.ada
- c43212c.ada
- c43214a.ada
- c43214b.ada
- c43214c.ada
- c43214d.ada
- c43214e.ada
- c43214f.ada
- c43215a.ada
- c43215b.ada
- c43222a.ada
- c43224a.ada
- c433001.a
- c44003d.ada
- c44003f.ada
- c44003g.ada
- c450001.a
- c45112a.ada
- c45112b.ada
- c45113a.ada
- c45114b.ada
- c452001.a
- c45201a.ada
- c45201b.ada
- c45202b.ada
- c45210a.ada
- c45211a.ada
- c45220a.ada
- c45220b.ada
- c45220c.ada
- c45220d.ada
- c45220e.ada
- c45220f.ada
- c45231a.ada
- c45231b.dep
- c45231c.dep
- c45231d.tst
- c45232b.ada
- c45242b.ada
- c45251a.ada
- c45252a.ada
- c45252b.ada
- c45253a.ada
- c45262a.ada
- c45262b.ada
- c45262c.ada
- c45262d.ada
- c45264a.ada
- c45264b.ada
- c45264c.ada
- c45265a.ada
- c45271a.ada
- c45272a.ada
- c45273a.ada
- c45274a.ada
- c45274b.ada
- c45274c.ada
- c45281a.ada
- c45282a.ada
- c45282b.ada
- c45291a.ada
- c45303a.ada
- c45304a.ada
- c45304b.dep
- c45304c.dep
- c45322a.ada
- c45323a.ada
- c45331a.ada
- c45342a.ada
- c45343a.ada
- c45344a.ada
- c45345b.ada
- c45347a.ada
- c45347b.ada
- c45347c.ada
- c45347d.ada
- c45411a.ada
- c45411b.dep
- c45411c.dep
- c45411d.ada
- c45413a.ada
- c45431a.ada
- c455001.a
- c45502b.dep
- c45502c.dep
- c45503a.ada
- c45503b.dep
- c45503c.dep
- c45504a.ada
- c45504b.dep
- c45504c.dep
- c45504d.ada
- c45504e.dep
- c45504f.dep
- c45505a.ada
- c45523a.ada
- c45531a.ada
- c45531b.ada
- c45531c.ada
- c45531d.ada
- c45531e.ada
- c45531f.ada
- c45531g.ada
- c45531h.ada
- c45531i.ada
- c45531j.ada
- c45531k.ada
- c45531l.ada
- c45531m.dep
- c45531n.dep
- c45531o.dep
- c45531p.dep
- c45532a.ada
- c45532b.ada
- c45532c.ada
- c45532d.ada
- c45532e.ada
- c45532f.ada
- c45532g.ada
- c45532h.ada
- c45532i.ada
- c45532j.ada
- c45532k.ada
- c45532l.ada
- c45532m.dep
- c45532n.dep
- c45532o.dep
- c45532p.dep
- c45534b.ada
- c45536a.dep
- c456001.a
- c45611a.ada
- c45611b.dep
- c45611c.dep
- c45613a.ada
- c45613b.dep
- c45613c.dep
- c45614a.ada
- c45614b.dep
- c45614c.dep
- c45631a.ada
- c45631b.dep
- c45631c.dep
- c45632a.ada
- c45632b.dep
- c45632c.dep
- c45651a.ada
- c45662a.ada
- c45662b.ada
- c45672a.ada
- c460001.a
- c460002.a
- c460004.a
- c460005.a
- c460006.a
- c460007.a
- c460008.a
- c460009.a
- c460010.a
- c460011.a
- c460012.a
- c46011a.ada
- c46013a.ada
- c46014a.ada
- c46021a.ada
- c46024a.ada
- c46031a.ada
- c46032a.ada
- c46033a.ada
- c46041a.ada
- c46042a.ada
- c46043b.ada
- c46044b.ada
- c46051a.ada
- c46051b.ada
- c46051c.ada
- c46052a.ada
- c46053a.ada
- c46054a.ada
- c460a01.a
- c460a02.a
- c47002a.ada
- c47002b.ada
- c47002c.ada
- c47002d.ada
- c47003a.ada
- c47004a.ada
- c47005a.ada
- c47006a.ada
- c47007a.ada
- c47008a.ada
- c47009a.ada
- c47009b.ada
- c48004a.ada
- c48004b.ada
- c48004c.ada
- c48004d.ada
- c48004e.ada
- c48004f.ada
- c48005a.ada
- c48005b.ada
- c48006a.ada
- c48006b.ada
- c48007a.ada
- c48007b.ada
- c48007c.ada
- c48008a.ada
- c48008c.ada
- c48009a.ada
- c48009b.ada
- c48009c.ada
- c48009d.ada
- c48009e.ada
- c48009f.ada
- c48009g.ada
- c48009h.ada
- c48009i.ada
- c48009j.ada
- c48010a.ada
- c48011a.ada
- c48012a.ada
- c490001.a
- c490002.a
- c490003.a
- c49020a.ada
- c49021a.ada
- c49022a.ada
- c49022b.ada
- c49022c.ada
- c49023a.ada
- c49024a.ada
- c49025a.ada
- c49026a.ada
- c4a005b.ada
- c4a006a.ada
- c4a007a.tst
- c4a010a.ada
- c4a010b.ada
- c4a011a.ada
- c4a012b.ada
- c4a013a.ada
- c4a014a.ada
- c51004a.ada
- c52005a.ada
- c52005b.ada
- c52005c.ada
- c52005d.ada
- c52005e.ada
- c52005f.ada
- c52008a.ada
- c52008b.ada
- c52009a.ada
- c52009b.ada
- c52010a.ada
- c52011a.ada
- c52011b.ada
- c52101a.ada
- c52102a.ada
- c52102b.ada
- c52102c.ada
- c52102d.ada
- c52103a.ada
- c52103b.ada
- c52103c.ada
- c52103f.ada
- c52103g.ada
- c52103h.ada
- c52103k.ada
- c52103l.ada
- c52103m.ada
- c52103p.ada
- c52103q.ada
- c52103r.ada
- c52103x.ada
- c52104a.ada
- c52104b.ada
- c52104c.ada
- c52104f.ada
- c52104g.ada
- c52104h.ada
- c52104k.ada
- c52104l.ada
- c52104m.ada
- c52104p.ada
- c52104q.ada
- c52104r.ada
- c52104x.ada
- c52104y.ada
- c53007a.ada
- c540001.a
- c54a03a.ada
- c54a04a.ada
- c54a07a.ada
- c54a13a.ada
- c54a13b.ada
- c54a13c.ada
- c54a13d.ada
- c54a22a.ada
- c54a23a.ada
- c54a24a.ada
- c54a24b.ada
- c54a42a.ada
- c54a42b.ada
- c54a42c.ada
- c54a42d.ada
- c54a42e.ada
- c54a42f.ada
- c54a42g.ada
- c55b03a.ada
- c55b04a.ada
- c55b05a.ada
- c55b06a.ada
- c55b06b.ada
- c55b07a.dep
- c55b07b.dep
- c55b10a.ada
- c55b11a.ada
- c55b11b.ada
- c55b15a.ada
- c55b16a.ada
- c55c02a.ada
- c55c02b.ada
- c56002a.ada
- c57003a.ada
- c57004a.ada
- c57004b.ada
- c58004c.ada
- c58004d.ada
- c58004g.ada
- c58005a.ada
- c58005b.ada
- c58005h.ada
- c58006a.ada
- c58006b.ada
- c59002a.ada
- c59002b.ada
- c59002c.ada
- c61008a.ada
- c61009a.ada
- c61010a.ada
- c62002a.ada
- c62003a.ada
- c62003b.ada
- c62004a.ada
- c62006a.ada
- c631001.a
- c640001.a
- c64002b.ada
- c64004g.ada
- c64005a.ada
- c64005b.ada
- c64005c.ada
- c64005d0.ada
- c64005da.ada
- c64005db.ada
- c64005dc.ada
- c641001.a
- c64103b.ada
- c64103c.ada
- c64103d.ada
- c64103e.ada
- c64103f.ada
- c64104a.ada
- c64104b.ada
- c64104c.ada
- c64104d.ada
- c64104e.ada
- c64104f.ada
- c64104g.ada
- c64104h.ada
- c64104i.ada
- c64104j.ada
- c64104k.ada
- c64104l.ada
- c64104m.ada
- c64104n.ada
- c64104o.ada
- c64105a.ada
- c64105b.ada
- c64105c.ada
- c64105d.ada
- c64106a.ada
- c64106b.ada
- c64106c.ada
- c64106d.ada
- c64107a.ada
- c64108a.ada
- c64109a.ada
- c64109b.ada
- c64109c.ada
- c64109d.ada
- c64109e.ada
- c64109f.ada
- c64109g.ada
- c64109h.ada
- c64109i.ada
- c64109j.ada
- c64109k.ada
- c64109l.ada
- c64201b.ada
- c64201c.ada
- c64202a.ada
- c650001.a
- c65003a.ada
- c65003b.ada
- c66002a.ada
- c66002c.ada
- c66002d.ada
- c66002e.ada
- c66002f.ada
- c66002g.ada
- c67002a.ada
- c67002b.ada
- c67002c.ada
- c67002d.ada
- c67002e.ada
- c67003f.ada
- c67005a.ada
- c67005b.ada
- c67005c.ada
- c67005d.ada
- c72001b.ada
- c72002a.ada
- c730001.a
- c730002.a
- c730003.a
- c730004.a
- c73002a.ada
- c730a01.a
- c730a02.a
- c731001.a
- c74004a.ada
- c74203a.ada
- c74206a.ada
- c74207b.ada
- c74208a.ada
- c74208b.ada
- c74209a.ada
- c74210a.ada
- c74211a.ada
- c74211b.ada
- c74302a.ada
- c74302b.ada
- c74305a.ada
- c74305b.ada
- c74306a.ada
- c74307a.ada
- c74401d.ada
- c74401e.ada
- c74401k.ada
- c74401q.ada
- c74402a.ada
- c74402b.ada
- c74406a.ada
- c74407b.ada
- c74409b.ada
- c760001.a
- c760002.a
- c760007.a
- c760009.a
- c760010.a
- c760011.a
- c760012.a
- c760013.a
- c761001.a
- c761002.a
- c761003.a
- c761004.a
- c761005.a
- c761006.a
- c761007.a
- c761010.a
- c761011.a
- c761012.a
- c83007a.ada
- c83012d.ada
- c83022a.ada
- c83022g0.ada
- c83022g1.ada
- c83023a.ada
- c83024a.ada
- c83024e0.ada
- c83024e1.ada
- c83025a.ada
- c83025c.ada
- c83027a.ada
- c83027c.ada
- c83028a.ada
- c83029a.ada
- c83030a.ada
- c83030c.ada
- c83031a.ada
- c83031c.ada
- c83031e.ada
- c83032a.ada
- c83033a.ada
- c83051a.ada
- c83b02a.ada
- c83b02b.ada
- c83e02a.ada
- c83e02b.ada
- c83e03a.ada
- c83f01a.ada
- c83f01b.ada
- c83f01c0.ada
- c83f01c1.ada
- c83f01c2.ada
- c83f01d0.ada
- c83f01d1.ada
- c83f03a.ada
- c83f03b.ada
- c83f03c0.ada
- c83f03c1.ada
- c83f03c2.ada
- c83f03d0.ada
- c83f03d1.ada
- c840001.a
- c84002a.ada
- c84005a.ada
- c84008a.ada
- c84009a.ada
- c85004b.ada
- c85005a.ada
- c85005b.ada
- c85005c.ada
- c85005d.ada
- c85005e.ada
- c85005f.ada
- c85005g.ada
- c85006a.ada
- c85006b.ada
- c85006c.ada
- c85006d.ada
- c85006e.ada
- c85006f.ada
- c85006g.ada
- c85007a.ada
- c85007e.ada
- c85009a.ada
- c85011a.ada
- c85013a.ada
- c85014a.ada
- c85014b.ada
- c85014c.ada
- c85017a.ada
- c85018a.ada
- c85018b.ada
- c85019a.ada
- c854001.a
- c854002.a
- c854003.a
- c86003a.ada
- c86004a.ada
- c86004b0.ada
- c86004b1.ada
- c86004b2.ada
- c86004c0.ada
- c86004c1.ada
- c86004c2.ada
- c86006i.ada
- c86007a.ada
- c87a05a.ada
- c87a05b.ada
- c87b02a.ada
- c87b02b.ada
- c87b03a.ada
- c87b04a.ada
- c87b04b.ada
- c87b04c.ada
- c87b05a.ada
- c87b06a.ada
- c87b07a.ada
- c87b07b.ada
- c87b07c.ada
- c87b07d.ada
- c87b07e.ada
- c87b08a.ada
- c87b09a.ada
- c87b09c.ada
- c87b10a.ada
- c87b11a.ada
- c87b11b.ada
- c87b13a.ada
- c87b14a.ada
- c87b14b.ada
- c87b14c.ada
- c87b14d.ada
- c87b15a.ada
- c87b16a.ada
- c87b17a.ada
- c87b18a.ada
- c87b18b.ada
- c87b19a.ada
- c87b23a.ada
- c87b24a.ada
- c87b24b.ada
- c87b26b.ada
- c87b27a.ada
- c87b28a.ada
- c87b29a.ada
- c87b30a.ada
- c87b31a.ada
- c87b32a.ada
- c87b33a.ada
- c87b34a.ada
- c87b34b.ada
- c87b34c.ada
- c87b35c.ada
- c87b38a.ada
- c87b39a.ada
- c87b40a.ada
- c87b41a.ada
- c87b42a.ada
- c87b43a.ada
- c87b44a.ada
- c87b45a.ada
- c87b45c.ada
- c87b47a.ada
- c87b48a.ada
- c87b48b.ada
- c87b50a.ada
- c87b54a.ada
- c87b57a.ada
- c87b62a.ada
- c87b62b.ada
- c87b62c.ada
- c87b62d.tst
- c910001.a
- c910002.a
- c910003.a
- c91004b.ada
- c91004c.ada
- c91006a.ada
- c91007a.ada
- c92002a.ada
- c92003a.ada
- c92005a.ada
- c92005b.ada
- c92006a.ada
- c930001.a
- c93001a.ada
- c93002a.ada
- c93003a.ada
- c93004a.ada
- c93004b.ada
- c93004c.ada
- c93004d.ada
- c93004f.ada
- c93005a.ada
- c93005b.ada
- c93005c.ada
- c93005d.ada
- c93005e.ada
- c93005f.ada
- c93005g.ada
- c93005h.ada
- c93006a.ada
- c93007a.ada
- c93008a.ada
- c93008b.ada
- c940001.a
- c940002.a
- c940004.a
- c940005.a
- c940006.a
- c940007.a
- c940010.a
- c940011.a
- c940012.a
- c940013.a
- c940014.a
- c940015.a
- c940016.a
- c94001a.ada
- c94001b.ada
- c94001c.ada
- c94001e.ada
- c94001f.ada
- c94001g.ada
- c94002a.ada
- c94002b.ada
- c94002d.ada
- c94002e.ada
- c94002f.ada
- c94002g.ada
- c94004a.ada
- c94004b.ada
- c94004c.ada
- c94005a.ada
- c94005b.ada
- c94006a.ada
- c94007a.ada
- c94007b.ada
- c94008a.ada
- c94008b.ada
- c94008c.ada
- c94008d.ada
- c94010a.ada
- c94011a.ada
- c94020a.ada
- c940a03.a
- c95008a.ada
- c95009a.ada
- c95010a.ada
- c95011a.ada
- c95012a.ada
- c95021a.ada
- c95022a.ada
- c95022b.ada
- c95033a.ada
- c95033b.ada
- c95034a.ada
- c95034b.ada
- c95035a.ada
- c95040a.ada
- c95040b.ada
- c95040c.ada
- c95040d.ada
- c95041a.ada
- c95065a.ada
- c95065b.ada
- c95065c.ada
- c95065d.ada
- c95065e.ada
- c95065f.ada
- c95066a.ada
- c95067a.ada
- c95071a.ada
- c95072a.ada
- c95072b.ada
- c95073a.ada
- c95074c.ada
- c95076a.ada
- c95078a.ada
- c95080b.ada
- c95082g.ada
- c95085a.ada
- c95085b.ada
- c95085c.ada
- c95085d.ada
- c95085e.ada
- c95085f.ada
- c95085g.ada
- c95085h.ada
- c95085i.ada
- c95085j.ada
- c95085k.ada
- c95085l.ada
- c95085m.ada
- c95085n.ada
- c95085o.ada
- c95086a.ada
- c95086b.ada
- c95086c.ada
- c95086d.ada
- c95086e.ada
- c95086f.ada
- c95087a.ada
- c95087b.ada
- c95087c.ada
- c95087d.ada
- c95088a.ada
- c95089a.ada
- c95090a.ada
- c95092a.ada
- c95093a.ada
- c95095a.ada
- c95095b.ada
- c95095c.ada
- c95095d.ada
- c95095e.ada
- c951001.a
- c951002.a
- c953001.a
- c953002.a
- c953003.a
- c954001.a
- c954010.a
- c954011.a
- c954012.a
- c954013.a
- c954014.a
- c954015.a
- c954016.a
- c954017.a
- c954018.a
- c954019.a
- c954020.a
- c954021.a
- c954022.a
- c954023.a
- c954024.a
- c954025.a
- c954026.a
- c954a01.a
- c954a02.a
- c954a03.a
- c960001.a
- c960002.a
- c960004.a
- c96001a.ada
- c96004a.ada
- c96005a.ada
- c96005b.tst
- c96005d.ada
- c96005f.ada
- c96006a.ada
- c96007a.ada
- c96008a.ada
- c96008b.ada
- c97112a.ada
- c97113a.ada
- c97114a.ada
- c97115a.ada
- c97116a.ada
- c97117a.ada
- c97117b.ada
- c97117c.ada
- c97118a.ada
- c97120a.ada
- c97120b.ada
- c97201a.ada
- c97201b.ada
- c97201c.ada
- c97201d.ada
- c97201e.ada
- c97201g.ada
- c97201h.ada
- c97201x.ada
- c97202a.ada
- c97203a.ada
- c97203b.ada
- c97203c.ada
- c97204a.ada
- c97204b.ada
- c97205a.ada
- c97205b.ada
- c97301a.ada
- c97301b.ada
- c97301c.ada
- c97301d.ada
- c97301e.ada
- c97302a.ada
- c97303a.ada
- c97303b.ada
- c97303c.ada
- c97304a.ada
- c97304b.ada
- c97305a.ada
- c97305b.ada
- c97305c.ada
- c97305d.ada
- c97307a.ada
- c974001.a
- c974002.a
- c974003.a
- c974004.a
- c974005.a
- c974006.a
- c974007.a
- c974008.a
- c974009.a
- c974010.a
- c974011.a
- c974012.a
- c974013.a
- c974014.a
- c980001.a
- c980002.a
- c980003.a
- c99004a.ada
- c99005a.ada
- c9a003a.ada
- c9a004a.ada
- c9a007a.ada
- c9a009a.ada
- c9a009c.ada
- c9a009f.ada
- c9a009g.ada
- c9a009h.ada
- c9a010a.ada
- c9a011a.ada
- c9a011b.ada
- ca1003a.ada
- ca1004a.ada
- ca1005a.ada
- ca1006a.ada
- ca1011a0.ada
- ca1011a1.ada
- ca1011a2.ada
- ca1011a3.ada
- ca1011a4.ada
- ca1011a5.ada
- ca1011a6.ada
- ca1012a0.ada
- ca1012a1.ada
- ca1012a2.ada
- ca1012a3.ada
- ca1012a4.ada
- ca1012b0.ada
- ca1012b2.ada
- ca1012b4.ada
- ca1013a0.ada
- ca1013a1.ada
- ca1013a2.ada
- ca1013a3.ada
- ca1013a4.ada
- ca1013a5.ada
- ca1013a6.ada
- ca1014a0.ada
- ca1014a1.ada
- ca1014a2.ada
- ca1014a3.ada
- ca1020e0.ada
- ca1020e1.ada
- ca1020e2.ada
- ca1020e3.ada
- ca1022a0.ada
- ca1022a1.ada
- ca1022a2.ada
- ca1022a3.ada
- ca1022a4.ada
- ca1022a5.ada
- ca1022a6.ada
- ca11001.a
- ca11002.a
- ca11003.a
- ca110040.a
- ca110041.a
- ca110042.am
- ca110050.a
- ca110051.am
- ca11006.a
- ca11007.a
- ca11008.a
- ca11009.a
- ca11010.a
- ca11011.a
- ca11012.a
- ca11013.a
- ca11014.a
- ca11015.a
- ca11016.a
- ca11017.a
- ca11018.a
- ca11019.a
- ca11020.a
- ca11021.a
- ca11022.a
- ca1102a0.ada
- ca1102a1.ada
- ca1102a2.ada
- ca1106a.ada
- ca1108a.ada
- ca1108b.ada
- ca11a01.a
- ca11a02.a
- ca11b01.a
- ca11b02.a
- ca11c01.a
- ca11c02.a
- ca11c03.a
- ca11d010.a
- ca11d011.a
- ca11d012.a
- ca11d013.am
- ca11d02.a
- ca11d03.a
- ca13001.a
- ca13002.a
- ca13003.a
- ca13a01.a
- ca13a02.a
- ca140230.a
- ca140231.a
- ca140232.am
- ca140233.a
- ca140280.a
- ca140281.a
- ca140282.a
- ca140283.am
- ca15003.a
- ca200020.a
- ca200021.a
- ca200022.am
- ca2001h0.ada
- ca2001h1.ada
- ca2001h2.ada
- ca2001h3.ada
- ca2002a0.ada
- ca2002a1.ada
- ca2002a2.ada
- ca2003a0.ada
- ca2003a1.ada
- ca2004a0.ada
- ca2004a1.ada
- ca2004a2.ada
- ca2004a3.ada
- ca2004a4.ada
- ca2007a0.ada
- ca2007a1.ada
- ca2007a2.ada
- ca2007a3.ada
- ca2008a0.ada
- ca2008a1.ada
- ca2008a2.ada
- ca2009a.ada
- ca2009c0.ada
- ca2009c1.ada
- ca2009d.ada
- ca2009f0.ada
- ca2009f1.ada
- ca2009f2.ada
- ca2011b.ada
- ca21001.a
- ca3011a0.ada
- ca3011a1.ada
- ca3011a2.ada
- ca3011a3.ada
- ca3011a4.ada
- ca5003a0.ada
- ca5003a1.ada
- ca5003a2.ada
- ca5003a3.ada
- ca5003a4.ada
- ca5003a5.ada
- ca5003a6.ada
- ca5003b0.ada
- ca5003b1.ada
- ca5003b2.ada
- ca5003b3.ada
- ca5003b4.ada
- ca5003b5.ada
- ca5004a.ada
- ca5004b0.ada
- ca5004b1.ada
- ca5004b2.ada
- ca5006a.ada
- cb10002.a
- cb1001a.ada
- cb1004a.ada
- cb1005a.ada
- cb1010a.ada
- cb1010c.ada
- cb1010d.ada
- cb20001.a
- cb20003.a
- cb20004.a
- cb20005.a
- cb20006.a
- cb20007.a
- cb2004a.ada
- cb2005a.ada
- cb2006a.ada
- cb2007a.ada
- cb20a02.a
- cb3003a.ada
- cb3003b.ada
- cb3004a.ada
- cb40005.a
- cb4001a.ada
- cb4002a.ada
- cb4003a.ada
- cb4004a.ada
- cb4005a.ada
- cb4006a.ada
- cb4007a.ada
- cb4008a.ada
- cb4009a.ada
- cb4013a.ada
- cb40a01.a
- cb40a020.a
- cb40a021.am
- cb40a030.a
- cb40a031.am
- cb40a04.a
- cb41001.a
- cb41002.a
- cb41003.a
- cb41004.a
- cb5001a.ada
- cb5001b.ada
- cb5002a.ada
- cc1004a.ada
- cc1005b.ada
- cc1010a.ada
- cc1010b.ada
- cc1018a.ada
- cc1104c.ada
- cc1107b.ada
- cc1111a.ada
- cc1204a.ada
- cc1207b.ada
- cc1220a.ada
- cc1221a.ada
- cc1221b.ada
- cc1221c.ada
- cc1221d.ada
- cc1222a.ada
- cc1223a.ada
- cc1224a.ada
- cc1225a.tst
- cc1226b.ada
- cc1227a.ada
- cc1301a.ada
- cc1302a.ada
- cc1304a.ada
- cc1304b.ada
- cc1307a.ada
- cc1307b.ada
- cc1308a.ada
- cc1310a.ada
- cc1311a.ada
- cc1311b.ada
- cc2002a.ada
- cc30001.a
- cc30002.a
- cc3004a.ada
- cc3007a.ada
- cc3007b.ada
- cc3011a.ada
- cc3011d.ada
- cc3012a.ada
- cc3015a.ada
- cc3016b.ada
- cc3016c.ada
- cc3016f.ada
- cc3016i.ada
- cc3017b.ada
- cc3017c.ada
- cc3019a.ada
- cc3019b0.ada
- cc3019b1.ada
- cc3019b2.ada
- cc3019c0.ada
- cc3019c1.ada
- cc3019c2.ada
- cc3106b.ada
- cc3120a.ada
- cc3120b.ada
- cc3121a.ada
- cc3123a.ada
- cc3125a.ada
- cc3125b.ada
- cc3125c.ada
- cc3125d.ada
- cc3126a.ada
- cc3127a.ada
- cc3128a.ada
- cc3203a.ada
- cc3207b.ada
- cc3220a.ada
- cc3221a.ada
- cc3222a.ada
- cc3223a.ada
- cc3224a.ada
- cc3225a.ada
- cc3230a.ada
- cc3231a.ada
- cc3232a.ada
- cc3233a.ada
- cc3234a.ada
- cc3235a.ada
- cc3236a.ada
- cc3240a.ada
- cc3305a.ada
- cc3305b.ada
- cc3305c.ada
- cc3305d.ada
- cc3601a.ada
- cc3601c.ada
- cc3602a.ada
- cc3603a.ada
- cc3605a.ada
- cc3606a.ada
- cc3606b.ada
- cc3607b.ada
- cc40001.a
- cc50001.a
- cc50a01.a
- cc50a02.a
- cc51001.a
- cc51002.a
- cc51003.a
- cc51004.a
- cc51006.a
- cc51007.a
- cc51008.a
- cc51a01.a
- cc51b03.a
- cc51d01.a
- cc51d02.a
- cc54001.a
- cc54002.a
- cc54003.a
- cc54004.a
- cc70001.a
- cc70002.a
- cc70003.a
- cc70a01.a
- cc70a02.a
- cc70b01.a
- cc70b02.a
- cc70c01.a
- cc70c02.a
- cd10001.a
- cd10002.a
- cd1009a.ada
- cd1009b.ada
- cd1009d.ada
- cd1009e.ada
- cd1009f.ada
- cd1009g.ada
- cd1009h.ada
- cd1009i.ada
- cd1009j.ada
- cd1009k.tst
- cd1009l.ada
- cd1009m.ada
- cd1009n.ada
- cd1009o.ada
- cd1009p.ada
- cd1009q.ada
- cd1009r.ada
- cd1009s.ada
- cd1009t.tst
- cd1009u.tst
- cd1009v.ada
- cd1009w.ada
- cd1009x.ada
- cd1009y.ada
- cd1009z.ada
- cd1c03a.ada
- cd1c03b.ada
- cd1c03c.ada
- cd1c03e.tst
- cd1c03f.ada
- cd1c03g.ada
- cd1c03h.ada
- cd1c03i.ada
- cd1c04a.ada
- cd1c04d.ada
- cd1c04e.ada
- cd1c06a.tst
- cd20001.a
- cd2a21a.ada
- cd2a21c.ada
- cd2a21e.ada
- cd2a22a.ada
- cd2a22e.ada
- cd2a22i.ada
- cd2a22j.ada
- cd2a23a.ada
- cd2a23e.ada
- cd2a24a.ada
- cd2a24e.ada
- cd2a24i.ada
- cd2a24j.ada
- cd2a31a.ada
- cd2a31c.ada
- cd2a31e.ada
- cd2a32a.ada
- cd2a32c.ada
- cd2a32e.ada
- cd2a32g.ada
- cd2a32i.ada
- cd2a32j.ada
- cd2a51a.ada
- cd2a53a.ada
- cd2a53e.ada
- cd2a83c.tst
- cd2a91c.tst
- cd2b11a.ada
- cd2b11b.ada
- cd2b11d.ada
- cd2b11e.ada
- cd2b11f.ada
- cd2b15c.ada
- cd2b16a.ada
- cd2c11a.tst
- cd2c11d.tst
- cd2d11a.ada
- cd2d13a.ada
- cd30001.a
- cd30002.a
- cd30003.a
- cd30004.a
- cd300050.am
- cd300051.c
- cd3014a.ada
- cd3014c.ada
- cd3014d.ada
- cd3014f.ada
- cd3015a.ada
- cd3015c.ada
- cd3015e.ada
- cd3015f.ada
- cd3015g.ada
- cd3015h.ada
- cd3015i.ada
- cd3015k.ada
- cd3021a.ada
- cd33001.a
- cd33002.a
- cd40001.a
- cd4031a.ada
- cd4041a.tst
- cd4051a.ada
- cd4051b.ada
- cd4051c.ada
- cd4051d.ada
- cd5003a.ada
- cd5003b.ada
- cd5003c.ada
- cd5003d.ada
- cd5003e.ada
- cd5003f.ada
- cd5003g.ada
- cd5003h.ada
- cd5003i.ada
- cd5011a.ada
- cd5011c.ada
- cd5011e.ada
- cd5011g.ada
- cd5011i.ada
- cd5011k.ada
- cd5011m.ada
- cd5011q.ada
- cd5011s.ada
- cd5012a.ada
- cd5012b.ada
- cd5012e.ada
- cd5012f.ada
- cd5012i.ada
- cd5012m.ada
- cd5013a.ada
- cd5013c.ada
- cd5013e.ada
- cd5013g.ada
- cd5013i.ada
- cd5013k.ada
- cd5013m.ada
- cd5013o.ada
- cd5014a.ada
- cd5014c.ada
- cd5014e.ada
- cd5014g.ada
- cd5014i.ada
- cd5014k.ada
- cd5014m.ada
- cd5014o.ada
- cd5014t.ada
- cd5014v.ada
- cd5014x.ada
- cd5014y.ada
- cd5014z.ada
- cd70001.a
- cd7002a.ada
- cd7007b.ada
- cd7101d.ada
- cd7101e.dep
- cd7101f.dep
- cd7101g.tst
- cd7103d.ada
- cd7202a.ada
- cd7204b.ada
- cd7204c.ada
- cd72a01.a
- cd72a02.a
- cd7305a.ada
- cd90001.a
- cd92001.a
- cda201a.ada
- cda201b.ada
- cda201c.ada
- cda201e.ada
- cdb0a01.a
- cdb0a02.a
- cdd1001.a
- cdd2001.a
- cdd2a01.a
- cdd2a02.a
- cdd2a03.a
- cde0001.a
- ce2102a.ada
- ce2102b.ada
- ce2102c.tst
- ce2102d.ada
- ce2102e.ada
- ce2102f.ada
- ce2102g.ada
- ce2102h.tst
- ce2102i.ada
- ce2102j.ada
- ce2102k.ada
- ce2102l.ada
- ce2102m.ada
- ce2102n.ada
- ce2102o.ada
- ce2102p.ada
- ce2102q.ada
- ce2102r.ada
- ce2102s.ada
- ce2102t.ada
- ce2102u.ada
- ce2102v.ada
- ce2102w.ada
- ce2102x.ada
- ce2102y.ada
- ce2103a.tst
- ce2103b.tst
- ce2103c.ada
- ce2103d.ada
- ce2104a.ada
- ce2104b.ada
- ce2104c.ada
- ce2104d.ada
- ce2106a.ada
- ce2106b.ada
- ce2108e.ada
- ce2108f.ada
- ce2108g.ada
- ce2108h.ada
- ce2109a.ada
- ce2109b.ada
- ce2109c.ada
- ce2110a.ada
- ce2110c.ada
- ce2111a.ada
- ce2111b.ada
- ce2111c.ada
- ce2111e.ada
- ce2111f.ada
- ce2111g.ada
- ce2111i.ada
- ce2201a.ada
- ce2201b.ada
- ce2201c.ada
- ce2201d.dep
- ce2201e.dep
- ce2201f.ada
- ce2201g.ada
- ce2201h.ada
- ce2201i.ada
- ce2201j.ada
- ce2201k.ada
- ce2201l.ada
- ce2201m.ada
- ce2201n.ada
- ce2202a.ada
- ce2203a.tst
- ce2204a.ada
- ce2204b.ada
- ce2204c.ada
- ce2204d.ada
- ce2205a.ada
- ce2206a.ada
- ce2208b.ada
- ce2401a.ada
- ce2401b.ada
- ce2401c.ada
- ce2401e.ada
- ce2401f.ada
- ce2401h.ada
- ce2401i.ada
- ce2401j.ada
- ce2401k.ada
- ce2401l.ada
- ce2402a.ada
- ce2403a.tst
- ce2404a.ada
- ce2404b.ada
- ce2405b.ada
- ce2406a.ada
- ce2407a.ada
- ce2407b.ada
- ce2408a.ada
- ce2408b.ada
- ce2409a.ada
- ce2409b.ada
- ce2410a.ada
- ce2410b.ada
- ce2411a.ada
- ce3002b.tst
- ce3002c.tst
- ce3002d.ada
- ce3002f.ada
- ce3102a.ada
- ce3102b.tst
- ce3102d.ada
- ce3102e.ada
- ce3102f.ada
- ce3102g.ada
- ce3102h.ada
- ce3102i.ada
- ce3102j.ada
- ce3102k.ada
- ce3103a.ada
- ce3104a.ada
- ce3104b.ada
- ce3104c.ada
- ce3106a.ada
- ce3106b.ada
- ce3107a.tst
- ce3107b.ada
- ce3108a.ada
- ce3108b.ada
- ce3110a.ada
- ce3112c.ada
- ce3112d.ada
- ce3114a.ada
- ce3115a.ada
- ce3201a.ada
- ce3202a.ada
- ce3206a.ada
- ce3207a.ada
- ce3301a.ada
- ce3302a.ada
- ce3303a.ada
- ce3304a.tst
- ce3305a.ada
- ce3306a.ada
- ce3401a.ada
- ce3402a.ada
- ce3402c.ada
- ce3402d.ada
- ce3402e.ada
- ce3403a.ada
- ce3403b.ada
- ce3403c.ada
- ce3403d.ada
- ce3403e.ada
- ce3403f.ada
- ce3404a.ada
- ce3404b.ada
- ce3404c.ada
- ce3404d.ada
- ce3405a.ada
- ce3405c.ada
- ce3405d.ada
- ce3406a.ada
- ce3406b.ada
- ce3406c.ada
- ce3406d.ada
- ce3407a.ada
- ce3407b.ada
- ce3407c.ada
- ce3408a.ada
- ce3408b.ada
- ce3408c.ada
- ce3409a.ada
- ce3409b.ada
- ce3409c.ada
- ce3409d.ada
- ce3409e.ada
- ce3410a.ada
- ce3410b.ada
- ce3410c.ada
- ce3410d.ada
- ce3410e.ada
- ce3411a.ada
- ce3411c.ada
- ce3412a.ada
- ce3413a.ada
- ce3413b.ada
- ce3413c.ada
- ce3414a.ada
- ce3601a.ada
- ce3602a.ada
- ce3602b.ada
- ce3602c.ada
- ce3602d.ada
- ce3603a.ada
- ce3604a.ada
- ce3604b.ada
- ce3605a.ada
- ce3605b.ada
- ce3605c.ada
- ce3605d.ada
- ce3605e.ada
- ce3606a.ada
- ce3606b.ada
- ce3701a.ada
- ce3704a.ada
- ce3704b.ada
- ce3704c.ada
- ce3704d.ada
- ce3704e.ada
- ce3704f.ada
- ce3704m.ada
- ce3704n.ada
- ce3704o.ada
- ce3705a.ada
- ce3705b.ada
- ce3705c.ada
- ce3705d.ada
- ce3705e.ada
- ce3706c.ada
- ce3706d.ada
- ce3706f.ada
- ce3706g.ada
- ce3707a.ada
- ce3708a.ada
- ce3801a.ada
- ce3801b.ada
- ce3804a.ada
- ce3804b.ada
- ce3804c.ada
- ce3804d.ada
- ce3804e.ada
- ce3804f.ada
- ce3804g.ada
- ce3804h.ada
- ce3804i.ada
- ce3804j.ada
- ce3804m.ada
- ce3804o.ada
- ce3804p.ada
- ce3805a.ada
- ce3805b.ada
- ce3806a.ada
- ce3806b.ada
- ce3806c.ada
- ce3806d.ada
- ce3806e.ada
- ce3806f.ada
- ce3806g.ada
- ce3806h.ada
- ce3809a.ada
- ce3809b.ada
- ce3810a.ada
- ce3810b.ada
- ce3815a.ada
- ce3901a.ada
- ce3902b.ada
- ce3904a.ada
- ce3904b.ada
- ce3905a.ada
- ce3905b.ada
- ce3905c.ada
- ce3905l.ada
- ce3906a.ada
- ce3906b.ada
- ce3906c.ada
- ce3906d.ada
- ce3906e.ada
- ce3906f.ada
- ce3907a.ada
- ce3908a.ada
- checkfil.ada
- coverage.txt
- cxa3001.a
- cxa3002.a
- cxa3003.a
- cxa3004.a
- cxa4001.a
- cxa4002.a
- cxa4003.a
- cxa4004.a
- cxa4005.a
- cxa4006.a
- cxa4007.a
- cxa4008.a
- cxa4009.a
- cxa4010.a
- cxa4011.a
- cxa4012.a
- cxa4013.a
- cxa4014.a
- cxa4015.a
- cxa4016.a
- cxa4017.a
- cxa4018.a
- cxa4019.a
- cxa4020.a
- cxa4021.a
- cxa4022.a
- cxa4023.a
- cxa4024.a
- cxa4025.a
- cxa4026.a
- cxa4027.a
- cxa4028.a
- cxa4029.a
- cxa4030.a
- cxa4031.a
- cxa4032.a
- cxa4033.a
- cxa4034.a
- cxa5011.a
- cxa5012.a
- cxa5013.a
- cxa5015.a
- cxa5a01.a
- cxa5a02.a
- cxa5a03.a
- cxa5a04.a
- cxa5a05.a
- cxa5a06.a
- cxa5a07.a
- cxa5a08.a
- cxa5a09.a
- cxa5a10.a
- cxa8001.a
- cxa8002.a
- cxa8003.a
- cxa9001.a
- cxa9002.a
- cxaa001.a
- cxaa002.a
- cxaa003.a
- cxaa004.a
- cxaa005.a
- cxaa006.a
- cxaa007.a
- cxaa008.a
- cxaa009.a
- cxaa010.a
- cxaa011.a
- cxaa012.a
- cxaa013.a
- cxaa014.a
- cxaa015.a
- cxaa016.a
- cxaa017.a
- cxaa018.a
- cxaa019.a
- cxab001.a
- cxac001.a
- cxac002.a
- cxac003.a
- cxac004.a
- cxac005.a
- cxaca01.a
- cxaca02.a
- cxacb01.a
- cxacb02.a
- cxacc01.a
- cxaf001.a
- cxb2001.a
- cxb2002.a
- cxb2003.a
- cxb3001.a
- cxb3002.a
- cxb3003.a
- cxb30040.c
- cxb30041.am
- cxb3005.a
- cxb30060.c
- cxb30061.am
- cxb3007.a
- cxb3008.a
- cxb3009.a
- cxb3010.a
- cxb3011.a
- cxb3012.a
- cxb30130.c
- cxb30131.c
- cxb30132.am
- cxb3014.a
- cxb3015.a
- cxb3016.a
- cxb4001.a
- cxb4002.a
- cxb4003.a
- cxb4004.a
- cxb4005.a
- cxb4006.a
- cxb4007.a
- cxb4008.a
- cxb40090.cbl
- cxb40091.cbl
- cxb40092.cbl
- cxb40093.am
- cxb5001.a
- cxb5002.a
- cxb5003.a
- cxb50040.ftn
- cxb50041.ftn
- cxb50042.am
- cxb50050.ftn
- cxb50051.ftn
- cxb50052.am
- cxc3001.a
- cxc3002.a
- cxc3003.a
- cxc3004.a
- cxc3005.a
- cxc3006.a
- cxc3007.a
- cxc3008.a
- cxc3009.a
- cxc6001.a
- cxc6002.a
- cxc6003.a
- cxc7001.a
- cxc7002.a
- cxc7003.a
- cxc7004.a
- cxd1001.a
- cxd1002.a
- cxd1003.a
- cxd1004.a
- cxd1005.a
- cxd1006.a
- cxd1007.a
- cxd1008.a
- cxd2001.a
- cxd2002.a
- cxd2003.a
- cxd2004.a
- cxd2006.a
- cxd2007.a
- cxd2008.a
- cxd3001.a
- cxd3002.a
- cxd3003.a
- cxd4001.a
- cxd4002.a
- cxd4003.a
- cxd4004.a
- cxd4005.a
- cxd4006.a
- cxd4007.a
- cxd4008.a
- cxd4009.a
- cxd4010.a
- cxd5001.a
- cxd6001.a
- cxd6002.a
- cxd6003.a
- cxd8001.a
- cxd8002.a
- cxd8003.a
- cxd9001.a
- cxda001.a
- cxda002.a
- cxda003.a
- cxda004.a
- cxdb001.a
- cxdb002.a
- cxdb003.a
- cxdb004.a
- cxe1001.a
- cxe2001.a
- cxe2002.a
- cxe4001.a
- cxe4002.a
- cxe4003.a
- cxe4004.a
- cxe4005.a
- cxe4006.a
- cxe5001.a
- cxe5002.a
- cxe5003.a
- cxf1001.a
- cxf2001.a
- cxf2002.a
- cxf2003.a
- cxf2004.a
- cxf2005.a
- cxf2a01.a
- cxf2a02.a
- cxf3001.a
- cxf3002.a
- cxf3003.a
- cxf3004.a
- cxf3a01.a
- cxf3a02.a
- cxf3a03.a
- cxf3a04.a
- cxf3a05.a
- cxf3a06.a
- cxf3a07.a
- cxf3a08.a
- cxg1001.a
- cxg1002.a
- cxg1003.a
- cxg1004.a
- cxg1005.a
- cxg2001.a
- cxg2002.a
- cxg2003.a
- cxg2004.a
- cxg2005.a
- cxg2006.a
- cxg2007.a
- cxg2008.a
- cxg2009.a
- cxg2010.a
- cxg2011.a
- cxg2012.a
- cxg2013.a
- cxg2014.a
- cxg2015.a
- cxg2016.a
- cxg2017.a
- cxg2018.a
- cxg2019.a
- cxg2020.a
- cxg2021.a
- cxg2022.a
- cxg2023.a
- cxg2024.a
- cxh1001.a
- cxh3001.a
- cxh3002.a
- cxh30030.a
- cxh30031.am
- cz00004.a
- cz1101a.ada
- cz1102a.ada
- cz1103a.ada
- d4a002a.ada
- d4a002b.ada
- d4a004a.ada
- d4a004b.ada
- e28002b.ada
- e28005d.ada
- e52103y.ada
- eb4011a.ada
- eb4012a.ada
- eb4014a.ada
- ee3203a.ada
- ee3204a.ada
- ee3402b.ada
- ee3409f.ada
- ee3412c.ada
- enumchek.ada
- f340a000.a
- f340a001.a
- f341a00.a
- f390a00.a
- f392a00.a
- f392c00.a
- f392d00.a
- f393a00.a
- f393b00.a
- f3a2a00.a
- f460a00.a
- f730a000.a
- f730a001.a
- f731a00.a
- f940a00.a
- f954a00.a
- fa11a00.a
- fa11b00.a
- fa11c00.a
- fa11d00.a
- fa13a00.a
- fa13b00.a
- fa21a00.a
- fb20a00.a
- fb40a00.a
- fc50a00.a
- fc51a00.a
- fc51b00.a
- fc51c00.a
- fc51d00.a
- fc54a00.a
- fc70a00.a
- fc70b00.a
- fc70c00.a
- fcndecl.ada
- fd72a00.a
- fdb0a00.a
- fdd2a00.a
- fxa5a00.a
- fxaca00.a
- fxacb00.a
- fxacc00.a
- fxc6a00.a
- fxe2a00.a
- fxf2a00.a
- fxf3a00.a
- impdef.a
- impdefc.a
- impdefd.a
- impdefe.a
- impdefg.a
- impdefh.a
- la140010.a
- la140011.am
- la140012.a
- la140020.a
- la140021.am
- la140022.a
- la140030.a
- la140031.a
- la140032.am
- la140033.a
- la140040.a
- la140041.am
- la140042.a
- la140050.a
- la140051.a
- la140052.am
- la140053.a
- la140060.a
- la140061.a
- la140062.am
- la140063.a
- la140070.a
- la140071.a
- la140072.am
- la140073.a
- la140080.a
- la140081.a
- la140082.am
- la140083.a
- la140090.a
- la140091.a
- la140092.am
- la140093.a
- la140100.a
- la140101.a
- la140102.am
- la140103.a
- la140110.a
- la140111.a
- la140112.am
- la140113.a
- la140120.a
- la140121.a
- la140122.am
- la140123.a
- la140130.a
- la140131.a
- la140132.am
- la140133.a
- la140140.a
- la140141.a
- la140142.am
- la140143.a
- la140150.a
- la140151.a
- la140152.am
- la140153.a
- la140160.a
- la140161.a
- la140162.am
- la140163.a
- la140170.a
- la140171.a
- la140172.am
- la140173.a
- la140180.a
- la140181.a
- la140182.am
- la140183.a
- la140190.a
- la140191.a
- la140192.am
- la140193.a
- la140200.a
- la140201.a
- la140202.am
- la140203.a
- la140210.a
- la140211.am
- la140212.a
- la140220.a
- la140221.am
- la140222.a
- la140240.a
- la140241.a
- la140242.am
- la140243.a
- la140250.a
- la140251.am
- la140252.a
- la140260.a
- la140261.a
- la140262.am
- la140263.a
- la140270.a
- la140271.a
- la140272.am
- la140273.a
- la200010.a
- la200011.a
- la200012.am
- la5001a0.ada
- la5001a1.ada
- la5001a2.ada
- la5001a3.ada
- la5001a4.ada
- la5001a5.ada
- la5001a6.ada
- la5001a7.ada
- la5007a0.ada
- la5007a1.ada
- la5007b0.ada
- la5007b1.ada
- la5007c0.ada
- la5007c1.ada
- la5007d0.ada
- la5007d1.ada
- la5007e0.ada
- la5007e1.ada
- la5007f0.ada
- la5007f1.ada
- la5007g0.ada
- la5007g1.ada
- la5008a0.ada
- la5008a1.ada
- la5008b0.ada
- la5008b1.ada
- la5008c0.ada
- la5008c1.ada
- la5008d0.ada
- la5008d1.ada
- la5008e0.ada
- la5008e1.ada
- la5008f0.ada
- la5008f1.ada
- la5008g0.ada
- la5008g1.ada
- lc300010.a
- lc300011.a
- lc300012.am
- lc300020.a
- lc300021.a
- lc300022.am
- lc300030.a
- lc300031.a
- lc300032.am
- lencheck.ada
- lxd70010.a
- lxd70011.a
- lxd70012.am
- lxd70030.a
- lxd70031.a
- lxd70032.am
- lxd70040.a
- lxd70041.a
- lxd70042.am
- lxd70050.a
- lxd70051.a
- lxd70052.am
- lxd70060.a
- lxd70061.a
- lxd70062.am
- lxd70070.a
- lxd70071.a
- lxd70072.am
- lxd70080.a
- lxd70081.a
- lxd70082.am
- lxd70090.a
- lxd70091.a
- lxd70092.am
- lxe30010.am
- lxe30011.am
- lxe30020.am
- lxe30021.am
- lxh40010.a
- lxh40011.a
- lxh40012.am
- lxh40020.a
- lxh40021.a
- lxh40022.am
- lxh40030.a
- lxh40031.a
- lxh40032.a
- lxh40033.am
- lxh40040.a
- lxh40041.a
- lxh40042.a
- lxh40043.am
- lxh40050.a
- lxh40051.a
- lxh40052.a
- lxh40053.am
- lxh40060.a
- lxh40061.a
- lxh40062.a
- lxh40063.am
- lxh40070.a
- lxh40071.a
- lxh40072.a
- lxh40073.am
- lxh40080.a
- lxh40081.a
- lxh40082.a
- lxh40083.a
- lxh40084.am
- lxh40090.a
- lxh40091.a
- lxh40092.a
- lxh40093.am
- lxh40100.a
- lxh40101.a
- lxh40102.a
- lxh40103.am
- lxh40110.a
- lxh40111.a
- lxh40112.am
- lxh40120.a
- lxh40121.a
- lxh40122.a
- lxh40123.am
- lxh40130.a
- lxh40131.a
- lxh40132.a
- lxh40133.am
- lxh40140.a
- lxh40141.a
- lxh40142.am
- macro.dfs
- macrosub.ada
- repbody.ada
- repspec.ada
- spprt13s.tst
- tctouch.ada
- testobj.txt
- tsttests.dat
- ug-apxa.doc
- ug-apxa.pdf
- ug-apxa.txt
- ug-apxb.doc
- ug-apxb.pdf
- ug-apxb.txt
- ug-apxc.doc
- ug-apxc.pdf
- ug-apxc.txt
- ug-apxd.doc
- ug-apxd.pdf
- ug-apxd.txt
- ug-body.doc
- ug-body.pdf
- ug-body.txt
- widechr.a
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/checkfil.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/checkfil.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/checkfil.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/checkfil.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,197 ****
- -- CHECK_FILE.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- THIS IS A PROCEDURE USED BY MANY OF THE CHAPTER 14 TESTS TO CHECK THE
- -- CONTENTS OF A TEXT FILE.
- 
- -- THIS PROCEDURE ASSUMES THE FILE PARAMETER PASSED TO IT IS AN OPEN
- -- TEXT FILE.
- 
- -- THE STRING PARAMETER CONTAINS THE CHARACTERS THAT ARE SUPPOSED TO BE
- -- IN THE TEXT FILE.  A '#' CHARACTER IS USED IN THE STRING TO DENOTE 
- -- THE END OF A LINE.  A '@' CHARACTER IS USED TO DENOTE THE END OF A 
- -- PAGE. A '%' CHARACTER IS USED TO DENOTE THE END OF THE TEXT FILE.
- -- THESE SYMBOLS SHOULD NOT BE USED AS TEXT OUTPUT.
- 
- -- SPS 11/30/82
- -- JBG 2/3/83
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CHECK_FILE (FILE: IN OUT FILE_TYPE; CONTENTS : STRING) IS
- 
-      X : CHARACTER;
-      COL_COUNT : POSITIVE_COUNT := 1;
-      LINE_COUNT : POSITIVE_COUNT := 1;
-      PAGE_COUNT : POSITIVE_COUNT := 1;
-      TRAILING_BLANKS_MSG_WRITTEN : BOOLEAN := FALSE;
-      STOP_PROCESSING : EXCEPTION;
- 
-      PROCEDURE CHECK_END_OF_LINE (EXPECT_END_OF_PAGE : BOOLEAN) IS
-      BEGIN
- 
- -- SKIP OVER ANY TRAILING BLANKS.  AN IMPLEMENTATION CAN LEGALLY
- -- APPEND BLANKS TO THE END OF ANY LINE.
- 
-           WHILE NOT END_OF_LINE (FILE) LOOP
-                GET (FILE, X);
-                IF X /= ' ' THEN
-                     FAILED ("FROM CHECK_FILE: END OF LINE EXPECTED - " &
-                             X & " ENCOUNTERED");
-                     RAISE STOP_PROCESSING;
-                ELSE
-                     IF NOT TRAILING_BLANKS_MSG_WRITTEN THEN
-                          COMMENT ("FROM CHECK_FILE: " &
-                                   "THIS IMPLEMENTATION PADS " &
-                                   "LINES WITH BLANKS");
-                          TRAILING_BLANKS_MSG_WRITTEN := TRUE;
-                     END IF;
-                END IF;
-           END LOOP;
- 
-           IF LINE_COUNT /= LINE (FILE) THEN
-                FAILED ("FROM CHECK_FILE: " &
-                        "LINE COUNT INCORRECT - EXPECTED " &
-                        POSITIVE_COUNT'IMAGE(LINE_COUNT) &
-                        " GOT FROM FILE " & 
-                        POSITIVE_COUNT'IMAGE(LINE(FILE)));
-           END IF;
- 
- -- NOTE:  DO NOT SKIP_LINE WHEN AT END OF PAGE BECAUSE SKIP_LINE WILL
- --        ALSO SKIP THE PAGE TERMINATOR.  SEE RM 14.3.5 PARAGRAPH 1.
- 
-           IF NOT EXPECT_END_OF_PAGE THEN
-                IF END_OF_PAGE (FILE) THEN
-                     FAILED ("FROM CHECK_FILE: PREMATURE END OF PAGE");
-                     RAISE STOP_PROCESSING;
-                ELSE
-                     SKIP_LINE (FILE);
-                     LINE_COUNT := LINE_COUNT + 1;
-                END IF;
-           END IF;
-           COL_COUNT := 1;
-      END CHECK_END_OF_LINE;
- 
-      PROCEDURE CHECK_END_OF_PAGE IS
-      BEGIN
-           IF NOT END_OF_PAGE (FILE) THEN
-                FAILED ("FROM CHECK_FILE: " &
-                        "END_OF_PAGE NOT WHERE EXPECTED");
-                RAISE STOP_PROCESSING;
-           ELSE
-                IF PAGE_COUNT /= PAGE (FILE) THEN
-                     FAILED ("FROM CHECK_FILE: " &
-                             "PAGE COUNT INCORRECT - EXPECTED " &
-                             POSITIVE_COUNT'IMAGE (PAGE_COUNT) &
-                             " GOT FROM FILE " &
-                             POSITIVE_COUNT'IMAGE (PAGE(FILE)));
-                END IF;
- 
-                SKIP_PAGE (FILE);
-                PAGE_COUNT := PAGE_COUNT + 1;
-                LINE_COUNT := 1;
-           END IF;
-      END CHECK_END_OF_PAGE;
- 
- BEGIN
- 
-      RESET (FILE, IN_FILE);
-      SET_LINE_LENGTH (STANDARD_OUTPUT, 0);
-      SET_PAGE_LENGTH (STANDARD_OUTPUT, 0);
- 
-      FOR I IN 1 .. CONTENTS'LENGTH LOOP
- 
-           BEGIN
-                CASE CONTENTS (I) IS
-                     WHEN '#' =>
-                          CHECK_END_OF_LINE (CONTENTS (I + 1) = '@');
-                     WHEN '@' =>
-                          CHECK_END_OF_PAGE;
-                     WHEN '%' =>
-                          IF NOT END_OF_FILE (FILE) THEN
-                               FAILED ("FROM CHECK_FILE: " &
-                                       "END_OF_FILE NOT WHERE EXPECTED");
-                               RAISE STOP_PROCESSING;
-                          END IF;
-                     WHEN OTHERS =>
-                          IF COL_COUNT /= COL(FILE) THEN
-                               FAILED ("FROM CHECK_FILE: " &
-                                       "COL COUNT INCORRECT - " &
-                                       "EXPECTED " & POSITIVE_COUNT'
-                                       IMAGE(COL_COUNT) & " GOT FROM " &
-                                       "FILE " & POSITIVE_COUNT'IMAGE
-                                       (COL(FILE)));
-                          END IF;
-                          GET (FILE, X);
-                          COL_COUNT := COL_COUNT + 1;
-                          IF X /= CONTENTS (I) THEN
-                               FAILED("FROM CHECK_FILE: " &
-                                      "FILE DOES NOT CONTAIN CORRECT " &
-                                      "OUTPUT - EXPECTED " & CONTENTS(I) 
-                                      & " - GOT " & X);
-                               RAISE STOP_PROCESSING;
-                          END IF;
-                END CASE;
-           EXCEPTION
-                WHEN STOP_PROCESSING =>
-                     COMMENT ("FROM CHECK_FILE: " &
-                              "LAST CHARACTER IN FOLLOWING STRING " &
-                              "REVEALED ERROR: " & CONTENTS (1 .. I));
-                     EXIT;
-           END;
-  
-      END LOOP;
- 
- EXCEPTION
-      WHEN STATUS_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "STATUS_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN MODE_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "MODE_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN NAME_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "NAME_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN USE_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "USE_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN DEVICE_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "DEVICE_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN END_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "END_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN DATA_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "DATA_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN LAYOUT_ERROR =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "LAYOUT_ERROR RAISED - FILE CHECKING INCOMPLETE");
-      WHEN OTHERS =>
-           FAILED ("FROM CHECK_FILE: " &
-                   "SOME EXCEPTION RAISED - FILE CHECKING INCOMPLETE");
- 
- END CHECK_FILE;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/enumchek.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/enumchek.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/enumchek.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/enumchek.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE ACVC
- -- CHAPTER 13 C TESTS. IT IS INSTANTIATED WITH TWO TYPES. THE FIRST IS AN
- -- ENUMERATION TYPE FOR WHICH AN ENUMERATION CLAUSE HAS BEEN GIVEN, AND THE
- -- SECOND IS AN INTEGER TYPE WHOSE 'SIZE IS THE SAME AS THE 'SIZE OF THIS
- -- ENUMERATION TYPE.
- 
- -- THE PROCEDURE ENUM_CHECK IS THEN CALLED WITH THREE ARGUMENTS. THE FIRST IS
- -- AN ENUMERATION LITERAL FROM THE ENUMERATION TYPE, THE SECOND IS AN INTEGER
- -- LITERAL WHICH IS THE VALUE OF THE EXPECTED REPRESENTATION (TAKEN FROM THE
- -- ENUMERATION REPRESENTATION CLAUSE), AND THE THIRD IS A STRING DESCRIBING OR
- -- NAMING THE TYPE (USED IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS).
- 
- -- THE CHECK IS TO CONVERT THE ENUMERATION VALUE TO A BOOLEAN ARRAY WITH A
- -- LENGTH CORRESONDING TO THE 'SIZE OF THE ENUMERATION TYPE. AN INTEGER TYPE
- -- IS THEN CREATED WITH THIS SAME 'SIZE, AND THE REQUIRED REPRESENTATION VALUE
- -- IS CONVERTED FROM THIS TYPE TO A BOOLEAN ARRAY WITH THE SAME LENGTH. THE
- -- TWO BOOLEAN ARRAYS ARE THEN COMPARED AND SHOULD BE EQUAL. THE CONVERSIONS
- -- ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF UNCHECKED_CONVERSION.
- 
- -- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE AUTHORIZED
- 
- GENERIC
- 
-    TYPE ENUM_TYPE IS PRIVATE;
-    TYPE INT_TYPE IS RANGE <>;
- 
- PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE;
- 		      REP_VALUE  : INT_TYPE;
- 		      TYPE_ID	 : STRING);
- 
- 
- WITH UNCHECKED_CONVERSION;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE;
- 		      REP_VALUE  : INT_TYPE;
- 		      TYPE_ID	 : STRING) IS
- 
-    TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. ENUM_TYPE'SIZE) OF BOOLEAN;
-    PRAGMA PACK (BIT_ARRAY_TYPE);
- 
-    FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (ENUM_TYPE, BIT_ARRAY_TYPE);
-    FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (INT_TYPE, BIT_ARRAY_TYPE);
- 
-    BIT_ARRAY_1 : BIT_ARRAY_TYPE;
-    BIT_ARRAY_2 : BIT_ARRAY_TYPE;
- 
-    INT_VALUE : INT_TYPE := INT_TYPE (REP_VALUE);
- 
- BEGIN
- 
-    -- VERIFY CORRECT CALL (THIS IS A SANITY CHECK ON THE TEST ITSELF)
- 
-    IF ENUM_TYPE'SIZE /= INT_TYPE'SIZE THEN
-       FAILED ("ERROR IN ENUM_CHECK CALL: SIZES DO NOT MATCH");
-    END IF;
- 
-    BIT_ARRAY_1 := TO_BITS (TEST_VALUE);
-    BIT_ARRAY_2 := TO_BITS (INT_VALUE);
- 
-    IF BIT_ARRAY_1 /= BIT_ARRAY_2 THEN
-       FAILED ("CHECK ON REPRESENTATION OF TYPE " & TYPE_ID & " FAILED.");
-    END IF;
- 
- END ENUM_CHECK;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f340a000.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f340a000.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f340a000.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f340a000.a	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- F340A000.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This file simulates a generic linked list abstraction for use in tests
- --      covering tagged types and type extensions.
- --
- -- TEST FILES:
- --      This foundation consists of the following files:
- --
- --      => F340A000.A
- --         F340A001.A
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma
- --                          Elaborate_Body.
- --
- --!
- 
- generic  -- Singly-linked list abstraction.
-    type Parent_Type is tagged private;                   -- Actual is parent
- package F340A000 is                                      -- tagged type.
- 
-    pragma Elaborate_Body;
- 
- 
-    -- Declarations for visible linked list nodes:
- 
-    type Node_Type;
- 
-    type Node_Ptr is access Node_Type;
- 
-    type Node_Type is new Parent_Type with record         -- Record extension
-       Next : Node_Ptr := null;                           -- of parent type.
-    end record;
- 
- 
-    -- Inherits primitive operations of actual type corresponding
-    -- to Parent_Type.
- 
-    -- Add node at head of list.
-    procedure Add (Item : in     Node_Ptr;
-                   Head : in out Node_Ptr);
- 
-    -- Remove node from head of list and return it.
-    procedure Remove (Head : in out Node_Ptr;
-                      Item :    out Node_Ptr);
- 
- 
- 
-    -- Declarations for private linked list nodes:
- 
-    type Priv_Node_Type is new Parent_Type with private;  -- Private extension
-                                                          -- of parent type.
- 
-    -- Inherits primitive operations of actual parameter corresponding
-    -- to Parent_Type.
- 
- 
-    type Priv_Node_Ptr is access Priv_Node_Type;
- 
- 
-    -- Add node at head of list.
-    procedure Add (Item : in     Priv_Node_Ptr;
-                   Head : in out Priv_Node_Ptr);
- 
-    -- Remove node from head of list and return it.
-    procedure Remove (Head : in out Priv_Node_Ptr;
-                      Item :    out Priv_Node_Ptr);
-                      
- 
- private
- 
-    type Priv_Node_Type is new Parent_Type with record
-       Next : Priv_Node_Ptr := null;
-    end record;
- 
- end F340A000;
- 
- 
-      --==================================================================--
- 
- 
- package body F340A000 is  -- Singly-linked list abstraction.
- 
-    procedure Add (Item : in     Node_Ptr;
-                   Head : in out Node_Ptr) is
-    begin
-       if Item /= null then
-          Item.Next := Head;
-          Head := Item;
-       end if;
-    end Add;
- 
- 
-    procedure Remove (Head : in out Node_Ptr;
-                      Item :    out Node_Ptr) is
-    begin
-       Item := Head;
-       if Head /= null then
-          Head := Head.Next;
-       end if;
-    end Remove;
- 
- 
-    procedure Add (Item : in     Priv_Node_Ptr;
-                   Head : in out Priv_Node_Ptr) is
-    begin
-       if Item /= null then
-          Item.Next := Head;
-          Head := Item;
-       end if;
-    end Add;
- 
- 
-    procedure Remove (Head : in out Priv_Node_Ptr;
-                      Item :    out Priv_Node_Ptr) is
-    begin
-       Item := Head;
-       if Head /= null then
-          Head := Head.Next;
-       end if;
-    end Remove;
- 
- 
- end F340A000;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f340a001.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f340a001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f340a001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f340a001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- F340A001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This file declares a tagged type and primitive subprogram for use in
- --      tests covering tagged types and type extensions.
- --
- -- TEST FILES:
- --      The following files comprise this foundation:
- --
- --         F340A000.A
- --      => F340A001.A
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package F340A001 is  -- Book definitions.
- 
- 
-    type Text_Ptr is access String;
- 
-    type Book_Type is tagged record                      -- Root tagged type.
-       Title  : Text_Ptr;
-       Author : Text_Ptr;
-    end record;
- 
- 
-    procedure Create_Book (Title  : in     Text_Ptr;     -- Primitive operation
-                           Author : in     Text_Ptr;     -- of root tagged type.
-                           Book   :    out Book_Type);
-                           
- 
- end F340A001;
- 
- 
-      --==================================================================--
- 
- 
- package body F340A001 is  -- Book definitions.
- 
- 
-    procedure Create_Book (Title  : in     Text_Ptr;
-                           Author : in     Text_Ptr;
-                           Book   :    out Book_Type) is
-    begin
-       Book.Title  := Title;
-       Book.Author := Author;
-    end Create_Book;
-                           
- 
- end F340A001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f341a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f341a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f341a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f341a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- F341A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides a simple class hierarchy (a root type and two
- --      levels of derivation from it) to use in testing the basic OO features
- --      related to tagged types.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package F341A00_0 is   -- package Bank
- 
-   type Dollar_Amount  is new Float;  
-  
-    type Account is tagged
-       record
-         Current_Balance: Dollar_Amount;
-       end record;
- 
-    -- Primitive operations.
- 
-    procedure Deposit        (A : in out Account; 
-                              X : in     Dollar_Amount);
-    procedure Withdrawal     (A : in out Account; 
-                              X : in     Dollar_Amount);
-    function  Balance        (A : in     Account) return Dollar_Amount;
-    procedure Service_Charge (A : in out Account);
-    procedure Add_Interest   (A : in out Account);
-    procedure Open           (A : in out Account);
- 
- end F341A00_0;
- 
- 
-      --=================================================================--
- 
- 
- package body F341A00_0 is
- 
-    -- Primitive operations for type Account.
- 
-    procedure Deposit (A : in out Account; 
-                       X : in     Dollar_Amount) is
-    begin
-       A.Current_Balance := A.Current_Balance + X;
-    end Deposit;
- 
-    --
- 
-    procedure Withdrawal (A : in out Account; 
-                          X : in     Dollar_Amount) is
-    begin
-       A.Current_Balance := A.Current_Balance - X;
-    end Withdrawal;
- 
-    --
- 
-    function  Balance (A : in     Account) return Dollar_Amount is
-    begin
-       return (A.Current_Balance);
-    end Balance;
- 
-    --
- 
-    procedure Service_Charge (A : in out Account) is
-    begin
-       A.Current_Balance := A.Current_Balance - 5.00;
-    end Service_Charge;
- 
-    --
- 
-    procedure Add_Interest (A : in out Account) is
-       -- No interest accumulated on this type of account.
-       Interest_On_Account : Dollar_Amount := 0.00;
-    begin
-       A.Current_Balance := A.Current_Balance + Interest_On_Account;
-    end Add_Interest;
- 
-    --
- 
-    procedure Open (A : in out Account) is
-       Initial_Deposit : Dollar_Amount := 10.00;
-    begin
-       A.Current_Balance := Initial_Deposit;
-    end Open;
- 
- end F341A00_0;
- 
- 
-      --=================================================================--
- 
- 
- with F341A00_0;
- 
- package F341A00_1 is    -- package Checking
- 
-    package Bank renames F341A00_0;
- 
-    type Account is new Bank.Account with 
-       record
-          Overdraft_Fee : Bank.Dollar_Amount;
-       end record;
- 
- 
-    -- Inherited primitive operations.
-    -- procedure Deposit       (A : in out Account; X : in Bank.Dollar_Amount);
-    -- procedure Withdrawal    (A : in out Account; X : in Bank.Dollar_Amount);
-    -- function  Balance       (A : in     Account) return Bank.Dollar_Amount;
-    -- procedure Service_Charge(A : in out Account);
-    -- procedure Add_Interest  (A : in out Account);
- 
-    -- Overridden primitive operation.
-    procedure Open (A : in out Account);
- 
- end F341A00_1;
- 
- 
-      --=================================================================--
- 
- 
- package body F341A00_1 is
- 
-    -- Overridden primitive operation.
- 
-    procedure Open (A : in out Account) is
-       Check_Guarantee : Bank.Dollar_Amount :=  10.00;
-       Initial_Deposit : Bank.Dollar_Amount := 100.00;
-    begin
-       A.Current_Balance := Initial_Deposit;
-       A.Overdraft_Fee   := Check_Guarantee;
-    end Open;
- 
- end F341A00_1;
- 
- 
-      --=================================================================--
- 
- 
- with F341A00_0;  -- package Bank
- with F341A00_1;  -- package Checking
- 
- package F341A00_2 is    -- package Interest_Checking 
- 
-    package Bank     renames F341A00_0;
-    package Checking renames F341A00_1;
- 
-    subtype Interest_Rate is Bank.Dollar_Amount digits 4;  
- 
-    Current_Rate : Interest_Rate := 0.030;
- 
-    type Account is new Checking.Account with
-       record
-          Rate : Interest_Rate;
-       end record;
- 
-    -- "Twice" inherited primitive operations (Bank.Account, Checking.Account)
-    -- procedure Deposit       (A : in out Account; X : in Bank.Dollar_Amount);
-    -- procedure Withdrawal    (A : in out Account; X : in Bank.Dollar_Amount);
-    -- function  Balance       (A : in     Account) return Bank.Dollar_Amount;
-    -- procedure Service_Charge(A : in out Account);
- 
-    -- Overridden primitive operations.
-    procedure Add_Interest (A : in out Account);
-    procedure Open         (A : in out Account);
- 
- end F341A00_2;
- 
- 
-      --=================================================================--
- 
- 
- package body F341A00_2 is
- 
-    -- Overridden primitive operations.
- 
-    procedure Add_Interest (A : in out Account) is
-       use type Bank.Dollar_Amount;
-       Interest_On_Account : Bank.Dollar_Amount
-                           := Bank.Dollar_Amount(A.Current_Balance * A.Rate);
-    begin
-       A.Current_Balance := A.Current_Balance + Interest_On_Account;
-    end Add_Interest;
- 
-    procedure Open (A : in out Account) is
-       Initial_Deposit : Bank.Dollar_Amount := 1000.00;
-    begin
-       Checking.Open (Checking.Account (A));
-       A.Current_Balance := Initial_Deposit;
-       A.Rate            := Current_Rate;
-    end Open;
- 
- end F341A00_2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f390a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f390a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f390a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f390a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- F390A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This file declares the root type and primitive subprograms of an
- --      alert system abstraction, to be used for tests covering tagged
- --      types and type extensions.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Added pragma Elaborate for Ada.Calendar.
- --
- --!
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package F390A00 is  -- Alert system abstraction.
- 
- 
-    -- Declarations used by component Display_On and procedure Display.
- 
-    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
-    type Display_Counters is array (Device_Enum) of Natural;
- 
-    Display_Count_For : Display_Counters := (others => 0);
- 
- 
-    -- Declarations used by component Arrival_Time.
- 
-    Default_Time : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1901, 1, 1);
-    Alert_Time   : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1991, 6, 15);
- 
- 
- 
-    type Alert_Type is tagged record                   -- Root tagged type.
-       Arrival_Time : Ada.Calendar.Time := Default_Time;
-       Display_On   : Device_Enum   := Null_Device;
-    end record;
- 
- 
-    procedure Display (A : in Alert_Type);             -- To be inherited by
-                                                       -- all derivatives.
- 
-    procedure Handle (A : in out Alert_Type);          -- To be overridden by
-                                                       -- all derivatives.
- 
- end F390A00;
- 
- 
-      --==================================================================--
- 
- 
- package body F390A00 is  -- Alert system abstraction.
- 
- 
-    procedure Display (A : in Alert_Type) is
-    begin
-       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
-    end Display;
- 
- 
-    procedure Handle (A : in out Alert_Type) is
-    begin
-       A.Arrival_Time := Alert_Time;
-       Display (A);
-    end Handle;
- 
- 
- end F390A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f392a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f392a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f392a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f392a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,200 ****
- -- F392A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides a basis for tests needing a hierarchy of
- --      types to check object-oriented features.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package F392A00 is          -- package Accounts
- 
-    --
-    -- Types and subtypes.
-    --
- 
-    type Dollar_Amount  is new Float; 
-    type Interest_Rate  is delta 0.001 range 0.000 .. 1.000;
-    type Account_Types  is (Bank, Savings, Preferred, Total);
-    type Account_Counter is array (Account_Types) of Integer;
-    type Account_Rep is (President, Manager, New_Account_Manager, Teller);
- 
-    --
-    -- Constants.
-    --
- 
-    Opening_Balance           : constant Dollar_Amount := 100.00;
-    Current_Rate              : constant Interest_Rate := 0.030;
-    Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00;
- 
-    --
-    -- Global Variables
-    --
- 
-    Bank_Reserve         : Dollar_Amount   := 0.00;
-    Daily_Representative : Account_Rep     := New_Account_Manager;
-    Number_Of_Accounts   : Account_Counter := (Bank      => 0,
-                                               Savings   => 0,
-                                               Preferred => 0,
-                                               Total     => 0);
-    --
-    -- Account types and their primitive operations.
-    --
- 
-    -- Root type.
- 
-    type Bank_Account is tagged
-       record
-          Balance : Dollar_Amount;
-       end record;
- 
-    -- Primitive operations of Bank_Account.
- 
-    procedure Increment_Bank_Reserve (Acct : in     Bank_Account);
-    procedure Assign_Representative  (Acct : in     Bank_Account);
-    procedure Increment_Counters     (Acct : in     Bank_Account);
-    procedure Open                   (Acct : in out Bank_Account);
- 
-    --
-                           
-    type Savings_Account is new Bank_Account with
-       record
-          Rate : Interest_Rate;
-       end record;
- 
-    -- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account).
- 
-    -- Primitive operations (Overridden).
-    procedure Assign_Representative (Acct : in     Savings_Account);
-    procedure Increment_Counters    (Acct : in     Savings_Account);
-    procedure Open                  (Acct : in out Savings_Account);
-                           
-    --
- 
-    type Preferred_Account is new Savings_Account with
-       record
-          Minimum_Balance : Dollar_Amount;
-       end record;
- 
-    -- Procedure Increment_Bank_Reserve inherited twice.
-    -- Procedure Assign_Representative inherited from parent (Savings_Account).
- 
-    -- Primitive operations (Overridden).
-    procedure Increment_Counters (Acct : in     Preferred_Account);
-    procedure Open               (Acct : in out Preferred_Account);
- 
-    -- Function used to verify Open operation for Preferred_Account objects.
-    function Verify_Open (Acct : in Preferred_Account) return Boolean;
- 
-    
- end F392A00;
- 
- 
-      --=================================================================--
- 
- 
- package body F392A00 is
- 
-    --
-    -- Primitive operations for Bank_Account.
-    --
- 
-    procedure Increment_Bank_Reserve (Acct : in Bank_Account) is
-    begin
-       Bank_Reserve := Bank_Reserve + Acct.Balance;
-    end Increment_Bank_Reserve;
- 
-    procedure Assign_Representative (Acct : in Bank_Account) is
-    begin
-       Daily_Representative := Teller;
-    end Assign_Representative;
- 
-    procedure Increment_Counters (Acct : in Bank_Account) is
-    begin
-       Number_Of_Accounts (Bank)  := Number_Of_Accounts (Bank) + 1;
-       Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
-    end Increment_Counters;
- 
-    procedure Open (Acct : in out Bank_Account) is
-    begin
-       Acct.Balance := Opening_Balance;
-    end Open;
- 
- 
-    --
-    -- Overridden operations for Savings_Account type.
-    --
- 
-    procedure Assign_Representative (Acct : in Savings_Account) is
-    begin
-       Daily_Representative := Manager;
-    end Assign_Representative;
- 
-    procedure Increment_Counters (Acct : in Savings_Account) is
-    begin
-       Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1;
-       Number_Of_Accounts (Total)   := Number_Of_Accounts (Total) + 1;
-    end Increment_Counters;
- 
-    procedure Open (Acct : in out Savings_Account) is
-    begin
-       Open (Bank_Account(Acct));
-       Acct.Rate := Current_Rate;
-       Acct.Balance := 2.0 * Opening_Balance;
-    end Open;
-      
- 
-    --
-    -- Overridden operation for Preferred_Account type.
-    --
-                      
-    procedure Increment_Counters (Acct : in Preferred_Account) is
-    begin
-       Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1;
-       Number_Of_Accounts (Total)     := Number_Of_Accounts (Total) + 1;
-    end Increment_Counters;
- 
-    procedure Open (Acct : in out Preferred_Account) is
-    begin
-       Open (Savings_Account(Acct));
-       Acct.Minimum_Balance := Preferred_Minimum_Balance;
-       Acct.Balance := Acct.Minimum_Balance;
-    end Open;
- 
-    --
-    -- Function used to verify Open operation for Preferred_Account objects.
-    --
- 
-    function Verify_Open (Acct : in Preferred_Account) return Boolean is
-    begin                                                    
-       return (Acct.Balance         = Preferred_Minimum_Balance and
-               Acct.Rate            = Current_Rate              and
-               Acct.Minimum_Balance = Preferred_Minimum_Balance);
-    end Verify_Open;
- 
- end F392A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f392c00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f392c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f392c00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f392c00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- F392C00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides a basis for tagged type and dispatching
- --      tests.  Each test describes the utilizations.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      24 OCT 95   SAIC    Updated for ACVC 2.0.1
- --
- --!
- 
- package F392C00_1 is  -- Switches
- 
-   type Toggle is tagged private;    ---------------------------------- Toggle
- 
-   function Create return Toggle;
-   procedure Flip   ( It : in out Toggle );
-   function On      ( It : Toggle'Class ) return Boolean;
-   function Off     ( It : Toggle'Class ) return Boolean;
- 
-   type Dimmer is new Toggle with private;    ------------------------- Dimmer
- 
-   type Luminance is range 0..100;
- 
-   function  Create return Dimmer;
-   procedure Flip    ( It : in out Dimmer );
-   procedure Brighten( It : in out Dimmer;
-                       By : in Luminance := 10 );
-   procedure Dim     ( It : in out Dimmer;
-                       By : in Luminance := 10 );
-   function Intensity( It : Dimmer ) return Luminance;
- 
-   type Auto_Dimmer is new Dimmer with private;    --------------- Auto_Dimmer
- 
-   function  Create return Auto_Dimmer;
-   procedure Flip      ( It: in out Auto_Dimmer );
-   procedure Set_Auto  ( It: in out Auto_Dimmer );
-   procedure Clear_Auto( It: in out Auto_Dimmer );
-   -- procedure Set_Manual( It: in out Auto_Dimmer ) renames Clear_Auto;
-   procedure Set_Cutin ( It: in out Auto_Dimmer; Lumens: in Luminance );
-   procedure Set_Cutout( It: in out Auto_Dimmer; Lumens: in Luminance );
- 
-   function Auto            ( It: Auto_Dimmer ) return Boolean;
-   function Cutout_Threshold( It: Auto_Dimmer ) return Luminance;
-   function Cutin_Threshold ( It: Auto_Dimmer ) return Luminance;
- 
-   function TC_CW_TI( Key : Character ) return Toggle'Class;
- 
-   function TC_Non_Disp( It: Toggle ) return Boolean;
-   function TC_Non_Disp( It: Dimmer ) return Boolean;
-   function TC_Non_Disp( It: Auto_Dimmer ) return Boolean;
- 
- private
- 
-   type Toggle is tagged record
-     On : Boolean := False;
-   end record;
- 
-   type Dimmer is new Toggle with record
-     Intensity : Luminance := 100;
-   end record;  
- 
-   type Auto_Dimmer is new Dimmer with record
-     Cutout_Threshold : Luminance := 60;
-     Cutin_Threshold  : Luminance := 40;
-     Auto_Engaged     : Boolean := False;
-   end record;  
- 
- end F392C00_1;
- 
- with TCTouch;
- package body F392C00_1 is
- 
-   function Create return Toggle is
-   begin
-     TCTouch.Touch( '1' );  ------------------------------------------------ 1
-     return Toggle'( On => True );
-   end Create;
- 
-   function Create return Dimmer is
-   begin
-     TCTouch.Touch( '2' );  ------------------------------------------------ 2
-     return Dimmer'( On => True, Intensity => 75 );
-   end Create;
- 
-   function Create return Auto_Dimmer is
-   begin
-     TCTouch.Touch( '3' );  ------------------------------------------------ 3
-     return  Auto_Dimmer'( On => True, Intensity => 25,
-                           Cutout_Threshold | Cutin_Threshold => 50,
-                           Auto_Engaged => True );
-   end Create;
- 
-   procedure Flip   ( It : in out Toggle ) is
-   begin
-     TCTouch.Touch( 'A' );  ------------------------------------------------ A
-     It.On := not It.On;
-   end Flip;
- 
-   function On( It : Toggle'Class ) return Boolean is
-   begin
-     TCTouch.Touch( 'B' );  ------------------------------------------------ B
-     return It.On;
-   end On;
- 
-   function Off( It : Toggle'Class ) return Boolean is
-   begin
-     TCTouch.Touch( 'C' );  ------------------------------------------------ C
-     return not It.On;
-   end Off;
- 
-   procedure Brighten( It : in out Dimmer;
-                       By : in Luminance := 10 ) is
-   begin
-     TCTouch.Touch( 'D' );  ------------------------------------------------ D
-     if (It.Intensity+By) <= Luminance'Last then
-       It.Intensity := It.Intensity+By;
-     else
-       It.Intensity := Luminance'Last;
-     end if;
-   end Brighten;
- 
-   procedure Dim     ( It : in out Dimmer;
-                       By : in Luminance := 10 ) is
-   begin
-     TCTouch.Touch( 'E' );  ------------------------------------------------ E
-     if (It.Intensity-By) >= Luminance'First then
-       It.Intensity := It.Intensity-By;
-     else
-       It.Intensity := Luminance'First;
-     end if;
-   end Dim;
- 
-   function Intensity( It : Dimmer ) return Luminance is
-   begin
-     TCTouch.Touch( 'F' );  ------------------------------------------------ F
-     if On(It) then
-       return It.Intensity;
-     else
-       return Luminance'First;
-     end if;
-   end Intensity;
- 
-   procedure Flip    ( It : in out Dimmer ) is
-   begin
-     TCTouch.Touch( 'G' );  ------------------------------------------------ G
-     if On( It ) and (It.Intensity < 50) then
-       It.Intensity := Luminance'Last - It.Intensity;
-     else
-       Flip( Toggle( It ) );
-     end if;
-   end Flip;
- 
-   procedure Set_Auto  ( It: in out Auto_Dimmer ) is
-   begin
-     TCTouch.Touch( 'H' );  ------------------------------------------------ H
-     It.Auto_Engaged := True;
-   end Set_Auto;
- 
-   procedure Clear_Auto( It: in out Auto_Dimmer ) is
-   begin
-     TCTouch.Touch( 'I' );  ------------------------------------------------ I
-     It.Auto_Engaged := False;
-   end Clear_Auto;
- 
-   function  Auto           ( It: Auto_Dimmer ) return Boolean is
-   begin
-     TCTouch.Touch( 'J' );  ------------------------------------------------ J
-     return It.Auto_Engaged;
-   end Auto;
- 
-   procedure Flip     ( It: in out Auto_Dimmer ) is
-   begin
-     TCTouch.Touch( 'K' );  ------------------------------------------------ K
-     if It.Auto_Engaged then
-       if Off(It) then
-        Flip( Dimmer( It ) );
-       else
-        It.Auto_Engaged := False;
-       end if;
-     else
-       Flip( Dimmer( It ) );
-     end if;
-   end Flip;
- 
-   procedure Set_Cutin ( It : in out Auto_Dimmer;
-                         Lumens : in Luminance) is
-   begin
-     TCTouch.Touch( 'L' );  ------------------------------------------------ L
-     It.Cutin_Threshold := Lumens;
-   end Set_Cutin;
- 
-   procedure Set_Cutout( It : in out Auto_Dimmer;
-                         Lumens : in Luminance) is
-   begin
-     TCTouch.Touch( 'M' );  ------------------------------------------------ M
-     It.Cutout_Threshold := Lumens;
-   end Set_Cutout;
- 
-   function Cutout_Threshold( It : Auto_Dimmer ) return Luminance is
-   begin
-     TCTouch.Touch( 'N' );  ------------------------------------------------ N
-     return It.Cutout_Threshold;
-   end Cutout_Threshold;
- 
-   function Cutin_Threshold ( It : Auto_Dimmer ) return Luminance is
-   begin
-     TCTouch.Touch( 'O' );  ------------------------------------------------ O
-     return It.Cutin_Threshold;
-   end Cutin_Threshold;
- 
-   function TC_CW_TI( Key : Character ) return Toggle'Class is
-   begin
-     TCTouch.Touch( 'W' );  ------------------------------------------------ W
-     case Key is
-       when 'T' | 't' => return Toggle'( On => True );
-       when 'D' | 'd' => return Dimmer'( On => True, Intensity => 75 );
-       when 'A' | 'a' => return Auto_Dimmer'( On => True, Intensity => 25,
-                                  Cutout_Threshold | Cutin_Threshold => 50,
-                                  Auto_Engaged => True );
-       when others => null;
-     end case;
-   end TC_CW_TI;
- 
-   function TC_Non_Disp( It: Toggle ) return Boolean is
-   begin
-     TCTouch.Touch( 'X' );  ------------------------------------------------ X
-     return It.On;
-   end TC_Non_Disp;
- 
-   function TC_Non_Disp( It: Dimmer ) return Boolean is
-   begin
-     TCTouch.Touch( 'Y' );  ------------------------------------------------ Y
-     return It.On;
-   end TC_Non_Disp;
- 
-   function TC_Non_Disp( It: Auto_Dimmer ) return Boolean is
-   begin
-     TCTouch.Touch( 'Z' );  ------------------------------------------------ Z
-     return It.On;
-   end TC_Non_Disp;
- 
- end F392C00_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f392d00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f392d00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f392d00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f392d00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- F392D00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares parent tagged types and subprograms for use 
- --      in tests covering dispatching operations.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package F392D00 is
- 
-    type Depth_Of_Field is range 5 .. 100;  
-    type Shutter_Speed  is (One, Two_Fifty, Four_Hundred, Thousand);
- 
-    type Remote_Camera is tagged record
-       DOF    : Depth_Of_Field := 10;
-       Shutter: Shutter_Speed  := One;
-    end record;
- 
-    -- ...Other declarations.
- 
-    procedure Focus (C     : in out Remote_Camera;
-                     Depth : in     Depth_Of_Field);
- 
-    procedure Self_Test (C: in out Remote_Camera'Class);
- 
-    -- ...Other operations.
- 
- private
- 
-    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
-                                 Speed : in     Shutter_Speed);
- 
-    -- For the basic remote camera, shutter speed might be set as a function of
-    -- focus perhaps, thus it is declared as a private operation (usable
-    -- only internally within the abstraction).
- 
- 
- end F392D00;
- 
- 
-      --==================================================================--
- 
- 
- package body F392D00 is
- 
-    procedure Focus (C     : in out Remote_Camera;
-                     Depth : in     Depth_Of_Field) is
-    begin
-       -- Artificial for testing purposes.
-       C.DOF := 46;
-    end Focus;
- 
-    -----------------------------------------------------------
-    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
-                                 Speed : in     Shutter_Speed) is
-    begin
-       -- Artificial for testing purposes.
-       C.Shutter := Thousand;
-    end Set_Shutter_Speed;
- 
-    -----------------------------------------------------------
-    procedure Self_Test (C: in out Remote_Camera'Class) is
-       TC_Dummy_Depth : constant Depth_Of_Field := 23;
-       TC_Dummy_Speed : constant Shutter_Speed  := Four_Hundred;
-    begin
- 
-       -- Test focus at various depths:
-       Focus(C, TC_Dummy_Depth);
-       -- ...Additional calls to Focus.
- 
-       -- Test various shutter speeds:
-       Set_Shutter_Speed(C, TC_Dummy_Speed);
-       -- ...Additional calls to Set_Shutter_Speed.
- 
-    end Self_Test;
- 
- end F392D00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f393a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f393a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f393a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f393a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,245 ****
- -- F393A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides a simple background for a class family
- --      based on an abstract type.  It is to be used to test the
- --      dispatching of various forms of subprogram defined/inherited and
- --      overridden with the abstract type.
- --
- --  type                       procedures                  functions
- --  ----                       ----------                  ---------
- --  Object                     Initialize, Swap(abstract)  Create(abstract)
- --        Object'Class                                     Initialized
- --    Windmill is new Object   Swap, Stop, Add_Spin        Create, Spin
- --      Pump is new Windmill   Set_Rate                    Create, Rate
- --      Mill is new Windmill   Swap, Stop                  Create
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-  
- package F393A00_0 is
-    procedure TC_Touch ( A_Tag : Character );
-    procedure TC_Validate( Expected: String; Message: String );
- end F393A00_0;
-  
- with Report;
- package body F393A00_0 is
-    Expectation : String(1..20);
-    Finger      : Natural := 0;
-  
-    procedure TC_Touch ( A_Tag : Character ) is
-    begin
-      Finger := Finger+1;
-      Expectation(Finger) := A_Tag;
-    end TC_Touch;
-  
-    procedure TC_Validate( Expected: String; Message: String ) is
-    begin
-      if Expectation(1..Finger) /= Expected then
-        Report.Failed( Message & " Expecting: " & Expected 
-  			     & " Got: " & Expectation(1..Finger) );
-      end if;
-      Finger := 0;
-    end TC_Validate;
- end F393A00_0;
-  
- ----------------------------------------------------------------------
-  
- package F393A00_1 is
-    type Object is abstract tagged private;
-    procedure Initialize( An_Object: in out Object );
-    function  Initialized( An_Object: Object'Class ) return Boolean;
-    procedure Swap( A,B: in out Object ) is abstract;
-    function  Create return Object is abstract;
- private
-    type Object is abstract tagged record
-      Initialized : Boolean := False;
-    end record;
- end F393A00_1;
-  
- with F393A00_0;
- package body F393A00_1 is
-    procedure Initialize( An_Object: in out Object ) is
-    begin
-      An_Object.Initialized := True;
-      F393A00_0.TC_Touch('a');
-    end Initialize;
-  
-    function  Initialized( An_Object: Object'Class ) return Boolean is
-    begin
-      F393A00_0.TC_Touch('b');
-      return An_Object.Initialized;
-    end Initialized;
- end F393A00_1;
-  
- ----------------------------------------------------------------------
-  
- with F393A00_1;
- package F393A00_2 is
-  
-    type Rotational_Measurement is range -1_000 .. 1_000;
-    type Windmill is new F393A00_1.Object with private;
-  
-    procedure Swap( A,B: in out Windmill );  
-  
-    function  Create return Windmill;        
-  
-    procedure Add_Spin( To_Mill : in out Windmill;
-  		      RPMs    : in     Rotational_Measurement );
-  
-    procedure Stop( Mill : in out Windmill );
-  
-    function  Spin( Mill : Windmill ) return Rotational_Measurement;
-  
- private
-    type Windmill is new F393A00_1.Object with
-      record
-        Spin : Rotational_Measurement := 0;
-      end record;
- end F393A00_2;
-  
- with F393A00_0;
- package body F393A00_2 is
-  
-    procedure Swap( A,B: in out Windmill ) is
-      T : constant Windmill := B;
-    begin
-      F393A00_0.TC_Touch('c');
-      B := A;
-      A := T;
-    end Swap;
-  
-    function  Create return Windmill is
-      A_Mill : Windmill;
-    begin
-      F393A00_0.TC_Touch('d');
-      return A_Mill;
-    end Create;
-  
-    procedure Add_Spin( To_Mill : in out Windmill;
-  		      RPMs    : in     Rotational_Measurement ) is
-    begin
-      F393A00_0.TC_Touch('e');
-      To_Mill.Spin := To_Mill.Spin + RPMs;
-    end Add_Spin;
-  
-    procedure Stop( Mill : in out Windmill ) is
-    begin
-      F393A00_0.TC_Touch('f');
-      Mill.Spin := 0;
-    end Stop;
-  
-    function  Spin( Mill : Windmill ) return Rotational_Measurement is
-    begin
-      F393A00_0.TC_Touch('g');
-      return Mill.Spin;
-    end Spin;
-  
- end F393A00_2;
-  
- ----------------------------------------------------------------------
-  
- with F393A00_2;
- package F393A00_3 is
-    type Pump is new F393A00_2.Windmill with private;
-    function Create return Pump;
-  
-    type Gallons_Per_Revolution is digits 3;
-    procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution);
-    function  Rate( Of_Pump: Pump ) return Gallons_Per_Revolution;
- private
-    type Pump is new F393A00_2.Windmill with
-      record
-        GPRPM : Gallons_Per_Revolution := 0.0; -- Gallons/RPM
-      end record;
- end F393A00_3;
-  
- with F393A00_0;
- package body F393A00_3 is
-    function Create return Pump is
-      Sump : Pump;
-    begin
-      F393A00_0.TC_Touch('h');
-      return Sump;
-    end Create;
-  
-    procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution)
-    is
-    begin
-      F393A00_0.TC_Touch('i');
-      A_Pump.GPRPM := To_Rate;
-    end Set_Rate;
-  
-    function  Rate( Of_Pump: Pump ) return Gallons_Per_Revolution is
-    begin
-      F393A00_0.TC_Touch('j');
-      return Of_Pump.GPRPM;
-    end Rate;
- end F393A00_3;
-  
- ----------------------------------------------------------------------
- 
- with F393A00_2;
- with F393A00_3;
- package F393A00_4 is
-    type Mill is new F393A00_2.Windmill with private;
-  
-    procedure Swap( A,B: in out Mill );
-    function  Create return Mill;
-    procedure Stop( It: in out Mill );
-  private
-    type Mill is new F393A00_2.Windmill with
-      record
-        Pump: F393A00_3.Pump := F393A00_3.Create;
-      end record;
- end F393A00_4;
-  
- with F393A00_0;
- package body F393A00_4 is
-    procedure Swap( A,B: in out Mill ) is
-      T: constant Mill := A;
-    begin
-      F393A00_0.TC_Touch('k');
-      A := B;
-      B := T;
-    end Swap;
-  
-    function  Create return Mill is
-      A_Mill : Mill;
-    begin
-      F393A00_0.TC_Touch('l');
-      return A_Mill;
-    end Create;
-  
-    procedure Stop( It: in out Mill ) is
-    begin
-      F393A00_0.TC_Touch('m');
-      F393A00_3.Stop( It.Pump ); 
-      F393A00_2.Stop( F393A00_2.Windmill( It ) ); 
-    end Stop;
- end F393A00_4;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f393b00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f393b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f393b00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f393b00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- F393B00.A   
-  -- Alert_Foundation
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- FOUNDATION DESCRIPTION:
-  --      This package declares three abstract types for use in C660 series 
-  --      tests, Alert, Special_Alert, and Private_Alert.
-  --      It models (in miniature) an application situation in which an 
-  --      abstraction is defined in terms of structure (record and operations 
-  --      on the record) but not in terms of content (record is null).  It 
-  --      also models a situation in which an abstraction includes some 
-  --      specific, implementation dependent, information.
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  package F393B00 is
-     type Alert is abstract tagged null record;  -- abstract type
-                                                 -- see procedure Handle below
-  
-     procedure Handle (A : in out Alert) is abstract;
-                                                 -- abstract procedure, 
-                                                 -- explicitly declared
-  
-  
-     type Private_Alert is abstract tagged private;
-  
-     procedure Handle (PA : in out Private_Alert) is abstract;
-                                                 -- ensures that Private_Alert
-                                                 -- is visibly abstract
-  
-  
-     type Status_Kind is (Practice, Real, Dont_Care);
-     type Urgency_Kind is (Low, Medium, High);
-  
-     type Practice_Alert is new Alert with record
-       Status : Status_Kind := Dont_Care;
-       Urgency : Urgency_Kind := Low;
-     end record;
-  
-     procedure Handle (PA : in out Practice_Alert);
-                                                 -- overrides inherited Handle
-  
-  
-  
-     type Device is (Teletype, Console, Big_Screen);
-  
-     type Special_Alert (Age : Integer) is 
-       abstract new Practice_Alert with record
-         Display : Device;
-       end record;
-  
-     procedure Handle (SA : in out Special_Alert) is abstract; 
-                                                 -- overrides inherited Handle
-  
-  private
-     subtype Implementation_Detail is Integer range 1..10;
-  
-     type Private_Alert is abstract tagged record
-       Private_Field : Implementation_Detail := 1;
-     end record;
-  
-   
-  end F393B00;
-  
-  --=======================================================================--
-  
-  package body F393B00 is
-  
-       procedure Handle (PA : in out Practice_Alert) is
-         begin
-           PA.Status := Real;
-           PA.Urgency := Medium;
-         end Handle;
-  
-  end F393B00;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f3a2a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f3a2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f3a2a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f3a2a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- F3A2A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares support types and subprograms for testing
- --      run-time accessibility checks.
- --
- -- CHANGE HISTORY:
- --      01 May 95   SAIC    Initial prerelease version.
- --
- --!
- 
- package F3A2A00 is
- 
-    type Tagged_Type is tagged record
-       C: Integer := 0;
-    end record;
- 
-    type Array_Type is array (1 .. 10) of Tagged_Type;
- 
-    type AccTag_L0      is access all Tagged_Type;
-    type AccTagClass_L0 is access all Tagged_Type'Class;
- 
-    type AccArr_L0 is access all Array_Type;
- 
-    X_L0 : Tagged_Type;
- 
- 
-    type TC_Result_Kind is (OK, P_E, O_E);
- 
-    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
-                                  Expected: in TC_Result_Kind;
-                                  Message : in String);
- end F3A2A00;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body F3A2A00 is
- 
-    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
-                                  Expected: in TC_Result_Kind;
-                                  Message : in String) is
-    begin
-       if Actual /= Expected then
-          case Actual is
-             when OK  =>
-                Report.Failed ("No exception raised: "         & Message);
-             when P_E =>
-                Report.Failed ("Program_Error raised: "        & Message);
-             when O_E =>
-                Report.Failed ("Unexpected exception raised: " & Message);
-          end case;
-       end if;
-    end TC_Display_Results;
- 
- end F3A2A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f460a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f460a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f460a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f460a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- F460A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares support types and subprograms for testing
- --      run-time accessibility checks.
- --
- -- CHANGE HISTORY:
- --      11 May 95   SAIC    Initial prerelease version.
- --      24 Apr 96   SAIC    Modified Array_Type.
- --
- --!
- 
- package F460A00 is
- 
-    type Tagged_Type is tagged record
-       C : Integer := 0;
-    end record;
- 
-    type Derived_Tagged_Type is new Tagged_Type with record
-       D : String (1 .. 4) := "void";
-    end record;
- 
-    type Composite_Type (D: access Tagged_Type) is limited record
-       C : Boolean;
-    end record;
- 
-    type Array_Type is array (1 .. 10) of Tagged_Type;
- 
-    type AccTag_L0      is access constant Tagged_Type;
-    type AccTagClass_L0 is access all      Tagged_Type'Class;
- 
-    type AccArr_L0 is access all Array_Type;
- 
-    X_DerivedTag : aliased Derived_Tagged_Type;
-    PTagClass_L0 : AccTagClass_L0 := X_DerivedTag'Access;
- 
-    type TC_Result_Kind is (OK, UN_Init, PE_Exception, Others_Exception);
- 
-    procedure TC_Check_Results (Actual  : in TC_Result_Kind;
-                                Expected: in TC_Result_Kind;
-                                Message : in String);
- end F460A00;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body F460A00 is
- 
-    procedure TC_Check_Results (Actual  : in TC_Result_Kind;
-                                Expected: in TC_Result_Kind;
-                                Message : in String) is
-    begin
-       if Actual /= Expected then
-          case Actual is
-             when OK | UN_Init  =>
-                Report.Failed ("No exception raised: "         & Message);
-             when PE_Exception =>
-                Report.Failed ("Program_Error raised: "        & Message);
-             when Others_Exception =>
-                Report.Failed ("Unexpected exception raised: " & Message);
-          end case;
-       end if;
-    end TC_Check_Results;
- 
- end F460A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f730a000.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f730a000.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f730a000.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f730a000.a	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- F730A000.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This file simulates a generic linked list abstraction for use in tests
- --      covering tagged types and type extensions.
- --
- -- TEST FILES:
- --      This foundation consists of the following files:
- --
- --      => F730A000.A
- --         F730A001.A
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      03 Aug 96   SAIC    ACVC 2.1: Modified prologue. Added pragma
- --                          Elaborate_Body. Removed extraneous record
- --                          extension.
- --
- --!
- 
- generic  -- Singly-linked list abstraction.
-    type Parent_Type is tagged private;                   -- Actual is parent
- package F730A000 is                                      -- tagged type.
- 
-    pragma Elaborate_Body;
- 
- 
-    -- Declarations for private linked list nodes:
- 
-    type Priv_Node_Type is new Parent_Type with private;  -- Private extension
-                                                          -- of parent type.
- 
-    -- Inherits primitive operations of actual parameter corresponding
-    -- to Parent_Type.
- 
- 
-    type Priv_Node_Ptr is access Priv_Node_Type;
- 
- 
-    -- Add node at head of list.
-    procedure Add (Item : in     Priv_Node_Ptr;
-                   Head : in out Priv_Node_Ptr);
- 
-    -- Remove node from head of list and return it.
-    procedure Remove (Head : in out Priv_Node_Ptr;
-                      Item :    out Priv_Node_Ptr);
-                      
- 
- private
- 
-    type Priv_Node_Type is new Parent_Type with record
-       Next : Priv_Node_Ptr := null;
-    end record;
- 
- end F730A000;
- 
- 
-      --==================================================================--
- 
- 
- package body F730A000 is  -- Singly-linked list abstraction.
- 
- 
-    procedure Add (Item : in     Priv_Node_Ptr;
-                   Head : in out Priv_Node_Ptr) is
-    begin
-       if Item /= null then
-          Item.Next := Head;
-          Head := Item;
-       end if;
-    end Add;
- 
- 
-    procedure Remove (Head : in out Priv_Node_Ptr;
-                      Item :    out Priv_Node_Ptr) is
-    begin
-       Item := Head;
-       if Head /= null then
-          Head := Head.Next;
-       end if;
-    end Remove;
- 
- 
- end F730A000;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f730a001.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f730a001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f730a001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f730a001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- F730A001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This file declares a tagged type and primitive subprogram for use in
- --      tests covering tagged types and type extensions.
- --
- -- TEST FILES:
- --      The following files comprise this foundation:
- --
- --         F730A000.A
- --      => F730A001.A
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package F730A001 is  -- Book definitions.
- 
- 
-    type Text_Ptr is access String;
- 
-    type Book_Type is tagged record                      -- Root tagged type.
-       Title  : Text_Ptr;
-       Author : Text_Ptr;
-    end record;
- 
- 
-    procedure Create_Book (Title  : in     Text_Ptr;     -- Primitive operation
-                           Author : in     Text_Ptr;     -- of root tagged type.
-                           Book   :    out Book_Type);
-                           
- 
- end F730A001;
- 
- 
-      --==================================================================--
- 
- 
- package body F730A001 is  -- Book definitions.
- 
- 
-    procedure Create_Book (Title  : in     Text_Ptr;
-                           Author : in     Text_Ptr;
-                           Book   :    out Book_Type) is
-    begin
-       Book.Title  := Title;
-       Book.Author := Author;
-    end Create_Book;
-                           
- 
- end F730A001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f731a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f731a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f731a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f731a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- F731A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares parent tagged types and subprograms for use 
- --      in tests covering operations of private types and private extensions.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package F731A00 is
- 
-    type Parent is tagged private;
- 
-    function Vis_Op (P: Parent) return Boolean;
- 
- private
- 
-    type Parent is tagged record
-       Component : Integer := 1;
-    end record;
- 
-    function Pri_Op (P: Parent) return Boolean;
- 
- end F731A00;
- 
- 
-      --==================================================================--
- 
- 
- package body F731A00 is
-    function Vis_Op (P: Parent) return Boolean is
-    begin
-       return True;
-    end Vis_Op;
- 
-    function Pri_Op (P: Parent) return Boolean is 
-    begin
-       return False;
-    end Pri_Op;
- 
- end F731A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f940a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f940a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f940a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f940a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- F940A00.A
- --
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation contains test control code for tests covering 
- --      the protected record.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package F940A00 is
-      -- Interlock_Foundation
-    
-   protected type Interlock_Type is
-     entry Post;
-     entry Consume;
-   private
-     Int_Count : Integer := 0;
-   end Interlock_Type;
- 
-   protected Counter is                 -- used to count the number of
-     procedure Increment;               -- resources that have been granted
-     procedure Decrement;               -- to tasks
-     function Number return integer;
-   private
-     Count : Integer := 0;
-   end Counter;
- 
- end F940A00;
-  -- Interlock_Foundation
- 
- --===================================--
- 
- package body F940A00 is
-           -- Interlock_Foundation
- 
-   protected body Interlock_Type is
- 
-     entry Post when true is
-     begin
-       Int_Count := Int_Count + 1;
-     end Post;
- 
-     entry Consume when Int_Count > 0 is
-     begin
-       Int_Count := Int_Count - 1;
-     end Consume;
- 
-   end Interlock_Type;
- 
- 
-   protected body Counter is
- 
-     procedure Increment is
-       begin
-         Count := Count + 1;
-       end Increment;
- 
-     procedure Decrement is
-       begin
-         Count := Count - 1;
-       end Decrement;
- 
-     function Number return Integer is 
-       begin
-         return Count;
-       end Number;
- 
-   end Counter;
- 
- end F940A00;
-  -- Interlock_Foundation
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/f954a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/f954a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/f954a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/f954a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- F954A00.A
- --
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      This file contains foundation code for tests covering the requeue
- --      statement.
- --
- -- TEST DESCRIPTION:
- --      See prologues of specific tests.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package F954A00 is  -- Printer device abstraction.
- 
- 
-    -- Model a printer device driver as a protected type. A printer remains
-    -- unavailable while data is printing. The printer generates an interrupt
-    -- when printing is complete, after which the printer is again made
-    -- available.
- 
- 
-    type Printers_Info is tagged record
-       Some_Info : Integer;
-    end record;
- 
-                --==============================================--
- 
-    protected type Printers is   -- Device driver for printer.
- 
-       procedure Start_Printing (File_Name : String);  -- Begin printing on
-                                                       -- printer.
- 
-       procedure Handle_Interrupt;                     -- Handle interrupt from
-                                                       -- printer.
- 
-       entry Done_Printing;                            -- Wait until printer is
-                                                       -- done.
- 
-       function Available return Boolean;              -- Return value of Ready.
-       function Is_Done return Boolean;                -- Return value of Done.
- 
-    private
- 
-       Ready : Boolean := True;                        -- Entry barrier.
-       Done  : Boolean := True;                        -- Testing flag.
- 
-    end Printers;
- 
-                --==============================================--
- 
-    Number_Of_Printers : constant := 2;
- 
-    type Printer_ID is range 1 .. Number_Of_Printers;
- 
-    type Printer_Array is array (Printer_ID) of Printers;
-    type Info_Array    is array (Printer_ID) of Printers_Info;
- 
-    Printer       : Printer_Array;
-    Printer_Info  : constant Info_Array  := ( (Some_Info => 1),
-                                              (Some_Info => 2) ); 
- 
- end F954A00;
- 
- 
-      --==================================================================--
- 
- 
- package body F954A00 is  -- Printer server abstraction.
- 
- 
-    protected body Printers is
- 
-       procedure Start_Printing (File_Name : String) is
-       begin
-          Ready := False;                              -- Block other requests
-          Done  := False;                              -- for this printer
-          -- Send data to the printer...               -- and begin printing.
-       end Start_Printing;
- 
- 
-       -- Set the "not ready" one-shot
-       entry Done_Printing when Ready is               -- Callers wait here
-       begin                                           -- until printing is
-          Done := True;                                -- done (signaled by a
-       end Done_Printing;                              -- printer interrupt).
- 
- 
-       procedure Handle_Interrupt is                   -- Called when the 
-       begin                                           -- printer interrupts,
-          Ready := True;                               -- indicating that
-       end Handle_Interrupt;                           -- printing is done.
- 
- 
-       function Available return Boolean is            -- Artifice for test
-       begin                                           -- purposes: checks
-          return (Ready);                              -- whether printer is
-       end Available;                                  -- still printing.
- 
- 
-       function Is_Done return Boolean is              -- Artifice for test
-       begin                                           -- purposes: checks
-          return (Done);                               -- whether Done_Printing
-       end Is_Done;                                    -- entry was executed.
- 
-    end Printers;
- 
- 
- end F954A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- FA11A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares a tagged type and primitive subprograms in
- --      a parent package.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FA11A00 is     -- Widget_Pkg
- -- This package represents processing of widgets in a window system.  It 
- -- contains a tagged type that can be extended by its children.
- 
-    type Widget_Length is range 1 .. 100;
- 
-    type Widget is tagged                     -- Parent tagged type
-       record            
-          Width, Height : Widget_Length;
-          -- More components to be added by extension
-       end record;
- 
-    -- To be inherited by its children derivatives.
-    procedure Set_Width (The_Widget : in out Widget; 
-                         W          : in     Widget_Length);      
-                        
-    -- To be inherited by its children derivatives.
-    procedure Set_Height (The_Widget : in out Widget;    
-                          H          : in     Widget_Length);    
- 
- end FA11A00;        -- Widget_Pkg
- 
- --=======================================================================--
- 
- package body FA11A00 is     -- Widget_Pkg
- 
-    procedure Set_Width (The_Widget : in out Widget; 
-                         W          : in Widget_Length) is
-    begin
-       The_Widget.Width := W;
-    end Set_Width;
-    -------------------------------------------------------
-    procedure Set_Height (The_Widget : in out Widget; 
-                          H          : in Widget_Length) is
-    begin
-       The_Widget.Height := H;
-    end Set_Height;
- 
- end FA11A00;     -- Widget_Pkg
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11b00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11b00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11b00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- FA11B00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares parent types and operations that can
- --      be inherited by its children.  
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FA11B00 is          -- Application_One_Widget
- -- This foundation simulates code that might be obtained as an already
- -- implemented set of objects and services, perhaps from a source code
- -- vendor.  It represents processing of widgets in a window system.  
- -- These widgets all have the same characteristics, but they are application 
- -- specific, so we do not allow assignment of an App_1_Widget to App_2_Widget.
- 
- -- The dimension measurement is in pixels (dots on the screen).
-    type Pixels is range 0 .. 10_000;
-    type Widget_Id is new Integer;
-    type Widget_Color_Enum is (Amber, Green, White, None);
-    subtype Widget_Label_Str is string (1 .. 15);
- 
-    type Widget_Location is 
-      record
-         X_Location, Y_Location : Pixels;
-      end record;
- 
-    type Widget_Size is 
-      record
-         X_Length, Y_Length : Pixels;
-      end record;
- 
-    -- NOTE : not a tagged record.    
-    type App1_Widget (Maximum_Size : Pixels := Pixels'Last) 
-       is record          -- Parent type
-          Size          : Widget_Size       := (Maximum_Size, Maximum_Size);
-          ID            : Widget_Id         := 1;
-          Location      : Widget_Location   := (0,0);
-          Color         : Widget_Color_Enum := None;
-          Label         : Widget_Label_Str  := "               ";
-       end record;
- 
-    -- Primitive operation of type Widget.
-    -- To be inherited by its children derivatives.
-    procedure App1_Widget_Specific_Oper (The_Widget : in out App1_Widget; 
-                                         I          : in     Widget_Id;
-                                         C          : in     Widget_Color_Enum;
-                                         L          : in     Widget_Label_Str);
-                        
- end FA11B00;                -- Application_One_Widget
- 
- --=======================================================================--
- 
- package body FA11B00 is     -- Application_One_Widget
- 
-    procedure Set_Color (The_Widget : in out App1_Widget; 
-                         C          : in     Widget_Color_Enum) is
-    begin
-       The_Widget.Color := C;
-    end Set_Color;
-    -------------------------------------------------------------
-    procedure Set_Label (The_Widget : in out App1_Widget; 
-                         L          : in     Widget_Label_Str) is
-    begin
-       The_Widget.Label := L;
-    end Set_Label;
-    -------------------------------------------------------------
-    procedure Set_Id (The_Widget : in out App1_Widget; 
-                      I          : in     Widget_Id) is
-    begin
-       The_Widget.Id := I;
-    end Set_Id;
-    -------------------------------------------------------------
-    procedure App1_Widget_Specific_Oper 
-      (The_Widget : in out App1_Widget; 
-       I          : in     Widget_Id;
-       C          : in     Widget_Color_Enum;
-       L          : in     Widget_Label_Str) is
-    begin
-       Set_Color    (The_Widget, C);
-       Set_Label    (The_Widget, L);
-       Set_Id       (The_Widget, I);
-    end App1_Widget_Specific_Oper;
- 
- end FA11B00;                -- Application_One_Widget
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11c00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11c00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11c00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- FA11C00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares parent types and operations that can
- --      be inherited by its children.  
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FA11C00_0 is         -- Package Animal
- 
-    type Kilogram_Weight_Type is new Natural;
-    subtype Species_Name_Type is String (1 .. 20);
- 
-    type Animal is tagged
-       record
-          Common_Name : Species_Name_Type;
-          Weight      : Kilogram_Weight_Type;
-       end record;
- 
-    function Image (A : Animal) return String;
- 
- end FA11C00_0;               -- Package Animal
- 
-      --=================================================================--
- 
- package body FA11C00_0 is    -- Package body Animal
- 
-    function Image (A : Animal) return String is
-    begin
-       return ("Animal Species:  " & A.Common_Name);
-    end Image;
- 
- end FA11C00_0;               -- Package body Animal
- 
-      --=================================================================--
- 
- package FA11C00_0.FA11C00_1 is         -- Package Animal.Mammal
- 
-    type Hair_Color_Type is (Black, Brown, Blonde, Grey, White, Red);
- 
-    type Mammal is new Animal with
-       record
-          Hair_Color : Hair_Color_Type;
-       end record;
- 
-    function Image (M : Mammal) return String;
- 
- end FA11C00_0.FA11C00_1;               -- Package Animal.Mammal
- 
-      --=================================================================--
- 
- package body FA11C00_0.FA11C00_1 is    -- Package body Animal.Mammal
- 
-    function Image (M : Mammal) return String is
-    begin
-       return ("Mammal Species:  " & M.Common_Name);
-    end Image;
- 
- end FA11C00_0.FA11C00_1;               -- Package body Animal.Mammal
- 
-      --=================================================================--
- 
- package FA11C00_0.FA11C00_1.FA11C00_2 is -- Package Animal.Mammal.Primate
- 
-    type Habitat_Type is (Arboreal, Terrestrial);
- 
-    type Primate is new Mammal with
-       record
-          Habitat : Habitat_Type;
-       end record;
- 
-    function Image (P : Primate) return String;
- 
- end FA11C00_0.FA11C00_1.FA11C00_2;       -- Package Animal.Mammal.Primate
- 
-      --=================================================================--
- 
-                                          -- Package body Animal.Mammal.Primate
- package body FA11C00_0.FA11C00_1.FA11C00_2 is 
- 
-    function Image (P : Primate) return String is
-    begin
-       return ("Primate Species: " & P.Common_Name);
-    end Image;
- 
- end FA11C00_0.FA11C00_1.FA11C00_2;       -- Package body Animal.Mammal.Primate
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11d00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11d00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fa11d00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fa11d00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- FA11D00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares parent types and operations that can
- --      be inherited by its children.  
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Dec 94   SAIC    Modified type Int_Type
- --
- --!
- 
- package FA11D00 is  -- Complex_Definition_Pkg
- 
-    -- Simulate a complex number support package. Complex numbers
-    -- are treated as coordinates in the Cartesian plane.
- 
-    type Int_Type is range -200 .. 100;
- 
-    type Complex_Type is record
-       Real : Int_Type;
-       Imag : Int_Type;
-    end record;
- 
-    Zero        : constant Complex_Type := (Real => 0, Imag => 0);
-    One         : constant Complex_Type := (Real => 1, Imag => 0);
-    Check_Value : constant Complex_Type := (Real => 17, Imag => 23);
- 
-    Add_Error       : exception;              
-    Subtract_Error  : exception;              
-    Divide_Error    : exception;              
-    Multiply_Error  : exception;              
- 
-    TC_Handled_In_Caller,                     
-    TC_Handled_In_Child_Pkg_Proc,
-    TC_Handled_In_Child_Pkg_Func,
-    TC_Handled_In_Grandchild_Pkg_Proc,
-    TC_Handled_In_Grandchild_Pkg_Func,
-    TC_Handled_In_Child_Sub,
-    TC_Propagated_To_Caller : boolean := False;
- 
-    function Complex (Real, Imag : Int_Type)
-      return Complex_Type;                             
- 
- end FA11D00;     -- Complex_Definition_Pkg
- 
- --=======================================================================--
- 
- package body FA11D00 is  -- Complex_Definition_Pkg
-    function Complex (Real, Imag : Int_Type) return Complex_Type is
-    begin
-       return (Real, Imag);
-    end Complex;
- 
- end FA11D00;     -- Complex_Definition_Pkg
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fa13a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fa13a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fa13a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fa13a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,171 ****
- -- FA13A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation code is used to check visibility of separate
- --      subunit of child packages.
- --      Declares a package containing type definitions; package will be
- --      with'ed by the root of the elevator abstraction.
- --
- --      Declare an elevator abstraction in a parent root package which manages 
- --      basic operations.  This package has a private part.  Declare a 
- --      private child package which calculates the floors for going up or 
- --      down.  Declare a public child package which provides the actual 
- --      operations.  
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Simulates a fragment of an elevator operation application.
- 
- package FA13A00_0 is                      -- Building Manager
- 
-    type Electrical_Power is (Off, V120, V240);
-    Power : Electrical_Power := V120;
- 
-    -- other type definitions and procedure declarations in real application.
- 
- end FA13A00_0;
- 
- -- No bodies provided for FA13A00_0.
- 
-      --==================================================================--
- 
- package FA13A00_1 is                      -- Basic Elevator Operations
- 
-    type Call_Waiting_Type is private;
-    type Floor is (Basement, Floor1, Floor2, Floor3, Penthouse);
-    type Floor_No is range Floor'Pos(Floor'First) .. Floor'Pos(Floor'Last);
-    Current_Floor : Floor   := Floor1;
- 
-    TC_Operation  : boolean := true;       
- 
-    procedure Call (F : in Floor; C : in out Call_Waiting_Type);
-    procedure Clear_Calls (C : in out Call_Waiting_Type);
- 
- private
-    type Call_Waiting_Type is array (Floor) of boolean;
-    Call_Waiting : Call_Waiting_Type := (others => false);
- 
- end FA13A00_1;
- 
- 
-      --==================================================================--
- 
- package body FA13A00_1 is              
- 
-    -- Call the elevator.
- 
-    procedure Call (F : in Floor; C : in out Call_Waiting_Type) is
-    begin
-       C (F) := true;
-    end Call;
- 
-    --------------------------------------------
- 
-    -- Clear all calls of the elevator.
- 
-    procedure Clear_Calls (C : in out Call_Waiting_Type) is
-    begin
-       C := (others => false);
-    end Clear_Calls;
- 
- end FA13A00_1;
- 
-      --==================================================================--
- 
- -- Private child package of an elevator application.  This package calculates
- -- how many floors to go up or down.
- 
- private package FA13A00_1.FA13A00_2 is    -- Floor Calculation
- 
-    -- Other type definitions in real application.
- 
-    procedure Up (HowMany : in Floor_No);
-                  
-    procedure Down (HowMany : in Floor_No);
- 
- end FA13A00_1.FA13A00_2;
- 
-      --==================================================================--
- 
- package body FA13A00_1.FA13A00_2 is              
- 
-    -- Go up from the current floor.
- 
-    procedure Up (HowMany : in Floor_No) is
-    begin
-       Current_Floor := Floor'val (Floor'pos (Current_Floor) + HowMany);
-    end Up;
- 
-    --------------------------------------------
- 
-    -- Go down from the current floor.
- 
-    procedure Down (HowMany : in Floor_No) is
-    begin
-       Current_Floor := Floor'val (Floor'pos (Current_Floor) - HowMany);
-    end Down;
- 
- end FA13A00_1.FA13A00_2;
- 
-      --==================================================================--
- 
- -- Public child package of an elevator application.  This package provides
- -- the actual operation of the elevator.
- 
- package FA13A00_1.FA13A00_3 is            -- Move Elevator  
- 
-    -- Other type definitions in real application.
- 
-    procedure Move_Elevator (F : in     Floor;
-                             C : in out Call_Waiting_Type);
- 
- end FA13A00_1.FA13A00_3;
- 
-      --==================================================================--
- 
- with FA13A00_1.FA13A00_2;                 -- Floor Calculation
- 
- package body FA13A00_1.FA13A00_3 is              
- 
-    -- Going up or down depends on the current floor.
- 
-    procedure Move_Elevator (F : in     Floor;
-                             C : in out Call_Waiting_Type) is
-    begin
-       if F > Current_Floor then
-          FA13A00_1.FA13A00_2.Up (Floor'Pos (F) - Floor'Pos (Current_Floor));
-          FA13A00_1.Call (F, C);
-       elsif F < Current_Floor then
-          FA13A00_1.FA13A00_2.Down (Floor'Pos (Current_Floor) - Floor'Pos (F));
-          FA13A00_1.Call (F, C);
-       end if;
- 
-    end Move_Elevator;
- 
- end FA13A00_1.FA13A00_3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fa13b00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fa13b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fa13b00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fa13b00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- FA13B00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation code is used to check visibility of separate
- --      subunit of child packages.
- --      Declares a package containing type definitions and a private
- --      part; package will be with'ed by the parent's body of the subunits.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FA13B00_0 is             
- 
-    -- Type definitions.
- 
-    type Visible_Integer is range 1 .. 10;
- 
-    type Private_Record is private;
- 
-    type Visible_Tagged is tagged
-       record
-          PR : Private_Record;
-       end record;
- 
-    type Private_Tagged is tagged private;
- 
-    Visible_Num : Visible_Integer := 7;
- 
-    -- Subprogram definitions.
- 
-    function Assign_Visible_Tagged (I : Visible_Integer) 
-      return Visible_Tagged;
- 
-    function Assign_Private_Tagged (I : Visible_Integer) 
-      return Private_Tagged;
- 
- private
- 
-    -- Type definitions.
- 
-    type Private_Integer is range 11 .. 20;
- 
-    type Private_Record is
-       record
-          VI : Visible_Integer;
-       end record;
- 
-    type Private_Tagged is tagged
-       record
-          VI : Visible_Integer;
-       end record;
- 
-    -- Object definitions.
- 
-    Private_Num : Visible_Integer :=  6;
- 
- end FA13B00_0;
- 
-      --==================================================================--
- 
- package body FA13B00_0 is             
- 
-    function Assign_Visible_Tagged(I : Visible_Integer) 
-      return Visible_Tagged is
-      VT : Visible_Tagged := (PR => (VI => I));
-    begin
-      return VT;
-    end Assign_Visible_Tagged;
- 
-    -------------------------------------------------------
- 
-    function Assign_Private_Tagged (I : Visible_Integer) 
-      return Private_Tagged is
-      PT : Private_Tagged := (VI => I);
-    begin
-      return PT;
-    end Assign_Private_Tagged;
- 
-    -------------------------------------------------------
- 
- end FA13B00_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fa21a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fa21a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fa21a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fa21a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- FA21A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares various supporting types, objects, and
- --      subprograms for use in tests checking preelaborability.
- --
- -- CHANGE HISTORY:
- --      20 Mar 95   SAIC    Initial prerelease version.
- --
- --!
- 
- with Ada.Finalization; -- Preelaborated library unit.
- package FA21A00 is
- 
-    pragma Preelaborate (FA21A00);
- 
- 
-    type My_Int is new Integer range 0 .. 100;
-    function Func return My_Int;                 -- Non-static function.
- 
-    subtype Idx is Natural range 1 .. 5;
- 
-    Three : constant My_Int :=  3;
-    Ten   :          My_Int := 10;               -- Non-static.
- 
-    type RecWithDisc (D: My_Int) is record
-       Twice: My_Int := D*2;
-    end record;
- 
-    type RecCallDefault is record
-       C : My_Int := Func;
-       D : My_Int := 0;
-    end record;
- 
-    type RecPrimDefault is record
-       C : My_Int := Ten;
-    end record;
- 
-    type Tag is tagged record
-       C : My_Int;
-    end record;
- 
-    type AccTag is access all Tag;
- 
-    Tag1: aliased Tag;                                                 -- OK.
- 
-    type My_Controlled is new Ada.Finalization.Controlled with record
-       C : My_Int;
-    end record;
- 
-    type ContComp is tagged record
-       C: My_Controlled;
-    end record;
- 
-    task type Tsk (D: My_Int);
- 
-    protected type Prot is
-       entry E;
-    end Prot;
- 
-    type Priv is tagged private;
- 
-    type PrivComp is array (1 .. 5) of Priv;
- 
-    type Pri_Ext is new Tag with private;
- 
-    type PriExtComp is array (1 .. 5) of Pri_Ext;
- 
- private
- 
-    type Priv is tagged record
-       B: Boolean;
-    end record;
- 
-    type Pri_Ext is new Tag with record
-       N: String (1 .. 5);
-    end record;
- 
- end FA21A00;
- 
- 
-      --===================================================================--
- 
- 
- package body FA21A00 is
- 
-    task body Tsk is
-    begin
-       null;
-    end Tsk;
- 
-    protected body Prot is
-       entry E when False is
-       begin
-          null;
-       end E;
-    end Prot;
- 
-    function Func return My_Int is
-    begin
-       return 0;
-    end Func;
- 
- end FA21A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fb20a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fb20a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fb20a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fb20a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- FB20A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This test performs a search for the first instance of a specified 
- --      substring within a specified string, returning boolean result.
- --      (Case insensitive analysis)  Both the string and the substring are 
- --      made upper case.  Successive slices are taken from the input string
- --      and compared with the substring. If a match is found, the search is 
- --      terminated immediately. The search continues until the last index 
- --      position from which a substring-length slice can be constructed is
- --      passed. 
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FB20A00 is
- 
-    function Find ( Str : in String ;           
-                    Sub : in String ) return Boolean;
- 
- end FB20A00;
- 
-      --=================================================================--
- 
- package body FB20A00 is
-                  
-    function Find ( Str : in String ;          
-                    Sub : in String ) return Boolean is
- 
-       New_Str : String (Str'First .. Str'Last);
-       New_Sub : String (Sub'First .. Sub'Last);
- 
-       Pos : Integer := Str'First ;             -- Character index.
- 
-                  
-       function Upper_Case (Str : in String) return String is
-          subtype Upper is Character range 'A' .. 'Z' ;
-          subtype Lower is Character range 'a' .. 'z' ;
-          Ret : String (Str'First .. Str'Last) ;
-          Pos : Integer;
-       begin
-          for I in Str'Range loop
-             if ( Str (I) in Lower ) then
-                Pos := Upper'Pos (Upper'First) +
-                       ( Lower'Pos (Str(I)) - Lower'Pos(Lower'First) ) ;
-                Ret (I) := Upper'Val (Pos) ;
-             else
-                Ret (I) := Str (I);
-             end if ;
-          end loop ;
-          return (Ret) ;
-       end Upper_Case;
- 
-    begin
- 
-       
-       New_Str := Upper_Case (Str);             -- Convert Str and Sub to upper 
-       New_Sub := Upper_Case (Sub);             -- case for comparison.
- 
-       while ( Pos <= New_Str'Last-New_Sub'Length+1 )  -- Search until no more 
-         and then                                      -- sub-string-length 
-         ( New_Str ( Pos .. Pos+New_Sub'Length-1 ) /= New_Sub ) -- slices
-                                                                -- remain.
-       loop
-          Pos := Pos + 1 ;
-       end loop ;
- 
-       if ( Pos > New_Str'Last-New_Sub'Length+1 ) then  -- Substring not found.
-          return (False);
-       else
-          return (True);
-       end if ;
- 
-    end Find;
- 
- end FB20A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fb40a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fb40a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fb40a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fb40a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- FB40A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation package contains global variables, types, a user
- --      defined exception, and two subprograms used to increment the 
- --      global variables.
- --      See prologues of specific tests for specific information.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package FB40A00 is               -- package Text_Parser
- 
-    -- Global Variables
- 
-    AlphaNumeric_Count,
-    Non_AlphaNumeric_Count : Natural := 0;
- 
- 
-    -- Types
- 
-    type String_Pointer_Type is access String;
- 
- 
-    -- Exceptions
- 
-    Completed_Text_Processing : exception;   
- 
-    -- Subprograms
- 
-    procedure Increment_AlphaNumeric_Count;   
-    procedure Increment_Non_AlphaNumeric_Count;   
- 
- end FB40A00;
- 
- 
-      --=================================================================--
- 
- 
- package body FB40A00 is
- 
- 
-    procedure Increment_AlphaNumeric_Count is
-    begin
-       AlphaNumeric_Count := AlphaNumeric_Count + 1;
-    end Increment_AlphaNumeric_Count;
- 
- 
-    procedure Increment_Non_AlphaNumeric_Count is
-    begin
-       Non_AlphaNumeric_Count := Non_AlphaNumeric_Count + 1;
-    end Increment_Non_AlphaNumeric_Count;
- 
- 
- end FB40A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc50a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc50a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc50a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc50a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- FC50A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares various tagged types which will be passed as
- --      actuals to generic formal tagged private types. It also declares
- --      various objects of these types, which will be used for testing.
- --      The types defined are both discriminated and nondiscriminated.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FC50A00 is
- 
- --
- -- Nonlimited tagged types:
- --
- 
-    type Count_Type is tagged record                     -- Nondiscriminated
-       Count : Integer := 0;                             -- type.
-    end record;
- 
- 
-    subtype Str_Len  is Natural range 0 .. 100;
-    subtype Stu_ID   is String (1 .. 5);
-    subtype Dept_ID  is String (1 .. 4);
-    subtype Emp_ID   is String (1 .. 9);
-    type    Status   is (Student, Faculty, Staff);
-    subtype Reserved is Positive range 1 .. 50;
- 
- 
-    type Person_Type (Stat : Status;                     -- Discriminated
-                      NameLen, AddrLen : Str_Len) is     -- type.
-      tagged record                                 
-       Name    : String (1 .. NameLen);
-       Address : String (1 .. AddrLen);
-       case Stat is
-          when Student =>
-             Student_ID  : Stu_ID;
-          when Faculty =>
-             Department  : Dept_ID;
-          when Staff   =>
-             Employee_ID : Emp_ID;
-       end case;
-    end record;
- 
- 
-    type VIPerson_Type is new Person_Type with record    -- Extension of
-       Parking_Space : Reserved;                         -- discriminated type.
-    end record;
- 
- 
-    -- Testing entities: ------------------------------------------------
- 
-    TC_Count_Item     : constant Count_Type    := (Count => 111);
-    TC_Default_Count  : constant Count_Type    := (Count => 0);
- 
-    TC_Person_Item    : constant Person_Type   :=
-      (Faculty, 18, 17, "Eccles, John Scott", "Popham House, Lee", "0931");
-    TC_Default_Person : constant Person_Type   :=
-      (Student, 0, 0, "", "", "00000");
- 
-    TC_VIPerson_Item  : constant VIPerson_Type := (TC_Person_Item with 1);
- 
-    ---------------------------------------------------------------------
- 
- 
- end FC50A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- FC51A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation defines a fraction type abstraction. Fractions are
- --      implemented as records with two scalar components: a numerator
- --      of type integer and a denominator of type positive. Fractions are
- --      created via an overloaded "/" operator.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FC51A00 is   -- Fraction type abstraction.
- 
-    type Fraction_Type is private;
- 
-    -- Create a fraction object by integer division.
-    function "/" (Left, Right : Integer) return Fraction_Type;
- 
-    -- Change the sign of a fraction.
-    function "-" (Frac : Fraction_Type) return Fraction_Type;
- 
-    -- Return value of numerator as integer.
-    function Numerator (Frac : Fraction_Type) return Integer;
- 
-    -- Return value of denominator as integer.
-    function Denominator (Frac : Fraction_Type) return Integer;
- 
-    -- ... Other operations on fraction types.
- 
- private
- 
-    type Fraction_Type is record
-       Numerator   : Integer;
-       Denominator : Positive;
-    end record;
- 
- end FC51A00;
- 
- 
-      --==================================================================--
- 
- 
- package body FC51A00 is
- 
-    function "/" (Left, Right : Integer) return Fraction_Type is
-       Result : Fraction_Type;
-    begin
-       Result.Numerator   := Left;
-       Result.Denominator := Right;
-       return Result;
-    end "/";
- 
- 
-    function "-" (Frac : Fraction_Type) return Fraction_Type is
-       Result : Fraction_Type := Frac;
-    begin
-       Result.Numerator := -(Result.Numerator);
-       return Result;
-    end "-";
- 
- 
-    function Numerator (Frac : Fraction_Type) return Integer is
-    begin
-       return (Frac.Numerator);
-    end Numerator;
- 
- 
-    function Denominator (Frac : Fraction_Type) return Integer is
-    begin
-       return (Frac.Denominator);
-    end Denominator;
- 
- 
- end FC51A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51b00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51b00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51b00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- FC51B00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares a set of tagged and untagged indefinite
- --      subtypes.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FC51B00 is  -- Type definitions.
- 
-    subtype Size is Natural range 1 .. 4;
- 
-    type Matrix is array                                 -- Unconstrained array
-      (Size range <>, Size range <>) of Integer;         -- type.
- 
-    type Square (Side : Size) is record                  -- Unconstrained record
-       Mat : Matrix (1 .. Side, 1 .. Side);              -- with undefaulted
-    end record;                                          -- discriminants.
- 
-    type Square_Pair (Dimension : Size) is tagged record -- Unconstrained tagged
-       Left  : Square (Dimension);                       -- type.
-       Right : Square (Dimension);
-    end record;
- 
-    type Vector is tagged record                         -- Constrained tagged
-       Mat : Matrix (1 .. 3, 1 .. 1);                    -- type (used to get
-    end record;                                          -- class-wide type).
- 
-    generic  -- Template for a generic formal package.
-       type Vectors (<>) is new Vector with private;     -- Type with unknown
-    package Signature is end;                            -- discriminants.
- 
- end FC51B00;
- 
- 
- -- No body for FC51B00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51c00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51c00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51c00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- FC51C00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares a hierarchy of tagged types, which includes
- --      both abstract and non-abstract types, and which have both abstract
- --      and non-abstract primitive subprograms.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      03 Nov 95   SAIC    ACVC 2.0.1 fixes: Deleted primitive operation Proc
- --                          of Concrete_Root.
- --      11 Aug 96   SAIC    ACVC 2.1: Changed procedure bodies to update
- --                          actual parameters.
- --
- --!
- 
- package FC51C00 is
- 
- --
- -- Non-abstract ultimate ancestor type:
- --
- 
-    type Concrete_Root is tagged null record;
- 
-    function Func (P: Concrete_Root) return Concrete_Root;    -- Abstract when
-                                                              -- inherited.
- 
- 
- --
- -- Abstract descendant of non-abstract ultimate ancestor:
- --
- 
-    type Abstract_Child is abstract new Concrete_Root with null record;
- 
-    -- Inherits:
-    -- function Func (P: Abstract_Child) return Abstract_Child is abstract;
- 
-    procedure Proc (P: in out Abstract_Child) is abstract;    -- Abstract.
-    procedure New_Proc (P : out Abstract_Child) is abstract;  -- Abstract.
- 
-    
- 
- --
- -- Non-abstract descendant of abstract descendant:
- --
- 
-    type Concrete_GrandChild is new Abstract_Child with null record;
- 
-    function Func (P: Concrete_GrandChild) return Concrete_GrandChild;
- 
-    procedure Proc (P: in out Concrete_GrandChild);
-    procedure New_Proc (P : out Concrete_GrandChild);
- 
-    
- end FC51C00;
- 
- 
-      --===================================================================--
- 
- 
- package body FC51C00 is
- 
-    Value : Concrete_GrandChild;
- 
- 
-    function Func (P: Concrete_Root) return Concrete_Root is
-    begin
-       return P;
-    end Func;
- 
- 
-    function Func (P: Concrete_GrandChild) return Concrete_GrandChild is
-    begin
-       return P;
-    end Func;
- 
- 
-    procedure Proc (P: in out Concrete_GrandChild) is
-    begin
-       P := Value;
-    end Proc;
- 
- 
-    procedure New_Proc (P : out Concrete_GrandChild) is
-    begin
-       P := Value;
-    end New_Proc;
- 
- end FC51C00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51d00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51d00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc51d00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc51d00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- FC51D00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation defines a generic list abstraction. List elements can
- --      be of any (nonlimited) type. Lists are implemented as arrays of
- --      pointers and are only two elements in length.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic
-    type Element_Type (<>) is private;
- package FC51D00 is  -- This package simulates a generic list abstraction.
- 
-    -- The definition of List_Type below is purely artificial; its validity
-    -- in the context of the abstraction is irrelevant to the feature being
-    -- tested.
- 
-    type Element_Ptr is access Element_Type;
- 
-    subtype List_Size is Natural range 1 .. 2;
-    type List_Type is array (List_Size) of Element_Ptr;
- 
-    function  View_Element (I : List_Size; L : List_Type) return Element_Type;
- 
-    procedure Write_Element (I : in     List_Size;
-                             L : in out List_Type;
-                             E : in     Element_Type);
- 
-    -- ... Other list operations for Element_Type.
- 
- end FC51D00;
- 
- 
-      --==================================================================--
- 
- 
- package body FC51D00 is
- 
-    -- The implementations of the operations below are purely artificial; the
-    -- validity of their implementations in the context of the abstraction is
-    -- irrelevant to the feature being tested.
- 
-    function View_Element (I : List_Size; L : List_Type) return Element_Type is
-    begin
-       return L(I).all;
-    end View_Element;
- 
- 
-    procedure Write_Element (I : in     List_Size;
-                             L : in out List_Type;
-                             E : in     Element_Type) is
-    begin
-       L(I) := new Element_Type'(E);
-    end Write_Element;
- 
- end FC51D00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc54a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc54a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc54a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc54a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- FC54A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares various types which will serve as designated
- --      types for tests involving generic formal access types (including
- --      access-to-subprogram types).
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FC54A00 is
- 
- 
-    -- Discrete (integer) types:
- 
-    Bits : constant := 8;                    -- Named number.
- 
-    type    Numerals           is range -256 .. 255;
-    type    New_Numerals       is new Numerals range -128 .. 127;
-    subtype Positives          is Numerals range 0 .. 255;
-    subtype Same_Numerals      is Numerals;
-    subtype Numerals_Static    is Numerals range -2**Bits .. 2**Bits - 1;
- 
-    Min  : Numerals  := Numerals'First;      -- Variable.
-    Max  : Integer   := 255;                 -- Variable.
- 
-    subtype Numerals_Nonstatic is Numerals  range Min .. 255;
-    subtype Positive_Nonstatic is Positives range 0 .. Positives(Max);
-    subtype Pos_Dupl_Nonstatic is Positives range 0 .. Positives(Max);
-    subtype Pos_Attr_Nonstatic is Positives range Positive_Nonstatic'Range;
- 
- 
- 
-    -- Floating point types:
- 
-    type    Float_Type       is digits 3;
-    type    New_Float        is new Float_Type;
-    subtype Float_100        is Float_Type range 0.0 .. 100.0;
-    subtype Same_Float       is Float_Type;
- 
-    Hundred : constant := 100.0;             -- Named number.
- 
-    type    Float_With_Range is digits 3 range 0.0 .. 100.0;
-    subtype Float_Same_Range is Float_With_Range range 0.0 .. Hundred;
- 
- 
- 
-    -- Tagged record types:
- 
-    subtype Lengths is Natural range 0 .. 50;
- 
-    type Parent is abstract tagged null record;
- 
-    type Tag (Len: Lengths) is new Parent with record
-       Msg : String (1 .. Len);
-    end record;
- 
-    type New_Tag is new Tag with record
-       Sent : Boolean;
-    end record;
- 
-    subtype Same_Tag is Tag;
- 
-    Twenty : constant := 20;                 -- Named number.
- 
-    subtype Tag20      is Tag (Len => 20);
-    subtype Tag25      is Tag (25);
-    subtype Tag_Twenty is Tag (Twenty);
- 
-    My_Len : Lengths := Twenty;              -- Variable.
-    subtype Sub_Length is Lengths range 1 .. My_Len;
- 
-    subtype Tag20_Nonstatic      is Tag (Len => Sub_Length'Last);
-    subtype Tag20_Dupl_Nonstatic is Tag (Sub_Length'Last);
-    subtype Tag20_Same_Nonstatic is Tag20_Nonstatic;
-    subtype Tag20_Var_Nonstatic  is Tag (Len => My_Len);
- 
- 
- 
-    -- Access types (designated type is tagged):
- 
-    type Tagged_Ptr         is access Tag;
-    type Tag_Class_Ptr      is access Tag'Class;
- 
-    subtype Msg_Ptr_Static  is Tagged_Ptr(Twenty);
- 
- 
- 
-    -- Array types:
- 
-    type    New_String  is new String;
-    subtype Same_String is String;
- 
-    Ten : constant := 10;                    -- Named number.
- 
-    subtype Msg_Static  is     String(1 .. Ten);
-    type    Msg10       is new String(1 .. 10);
-    subtype Msg20       is     String(1 .. 20);
- 
-    Size : Positive := 10;
- 
-    subtype Msg_Nonstatic      is String(1 .. Size);
-    subtype Msg_Dupl_Nonstatic is String(1 .. Size);
-    subtype Msg_Same_Nonstatic is Msg_Nonstatic;
- 
- 
- end FC54A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc70a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc70a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc70a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc70a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- FC70A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This file simulates a generic complex integer support package, to be
- --      used for tests covering generic formal packages.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic               -- Complex integer abstraction.
-    type Int_Type is range <>;
- package FC70A00 is
- 
-    -- Simulate a generic complex integer support package. Complex integers
-    -- are treated as coordinates in the Cartesian plane.
- 
- 
-    type Complex_Type is private;
- 
-    Zero : constant Complex_Type;                      -- (0,0).
-    One  : constant Complex_Type;                      -- (1,0).
- 
- 
-    function "-" (Right : Complex_Type)                -- Invert a complex
-      return Complex_Type;                             -- integer.
- 
-    function "+" (Left, Right : Complex_Type)          -- Add two complex
-      return Complex_Type;                             -- integers.
- 
-    function "*" (Left, Right : Complex_Type)          -- Multiply two complex
-      return Complex_Type;                             -- integers.
- 
-    function Reciprocal (Right : Complex_Type)         -- Return the reciprocal
-      return Complex_Type;                             -- of a complex integer.
- 
-    function Complex (Real, Imag : Int_Type)           -- Create a complex
-      return Complex_Type;                             -- integer.
- 
- private
-    
-    type Complex_Type is record
-       Real : Int_Type;
-       Imag : Int_Type;
-    end record;
- 
-    Zero : constant Complex_Type := (Real => 0, Imag => 0);
-    One  : constant Complex_Type := (Real => 1, Imag => 0);
- 
- end FC70A00;
- 
- 
-      --==================================================================--
- 
- 
- package body FC70A00 is  -- Complex integer abstraction.
- 
-    function Complex (Real, Imag : Int_Type) return Complex_Type is
-    begin
-       return ( (Real, Imag) );
-    end Complex;
- 
-                --==============================================--
- 
-    function "-" (Right : Complex_Type) return Complex_Type is
-    begin
-       return ( (-Right.Real, -Right.Imag) );
-    end "-";
- 
-                --==============================================--
- 
-    function "+" (Left, Right : Complex_Type) return Complex_Type is
-    begin
-       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
-    end "+";
- 
-                --==============================================--
- 
-    function "*" (Left, Right : Complex_Type) return Complex_Type is
-    begin
-       return ( (Real => (Left.Real * Right.Real) - (Left.Imag * Right.Imag),
-                 Imag => (Left.Imag * Right.Real) + (Left.Real * Right.Imag)) );
-    end "*";
- 
-                --==============================================--
- 
-    function Reciprocal (Right : Complex_Type) return Complex_Type is
-       Denominator : Int_Type := Right.Real**2 + Right.Imag**2;
-    begin  -- NOTE: Results are truncated.
-       return ( (Right.Real/Denominator, -Right.Imag/Denominator) );
-    end Reciprocal;
- 
- end FC70A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc70b00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc70b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc70b00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc70b00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- FC70B00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation defines a generic list abstraction. List elements can
- --      be of any (nonlimited) type. Lists are implemented as singly linked
- --      lists. Access to list elements is sequential. For each list, pointers
- --      are maintained to the first and last elements in the list, as well as
- --      the next element to be accessed.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic                           -- List abstraction.
-    type Element_Type is private;  -- List elems can be of any nonlimited type.
- package FC70B00 is
- 
-    type List_Type is limited private;
- 
-    -- Return true if current element is last in the list.
-    function End_Of_List (L : List_Type) return Boolean;
- 
-    -- Read current element value; do NOT advance "current" pointer.
-    procedure View_Element (L : in List_Type; E : out Element_Type);
- 
-    -- Read from current element and advance "current" pointer.
-    procedure Read_Element (L : in out List_Type; E : out Element_Type);
- 
-    -- Write to current element and advance "current" pointer.
-    procedure Write_Element (L : in out List_Type; E : in Element_Type);
- 
-    -- Add element to end of list.
-    procedure Add_Element (L : in out List_Type; E : in Element_Type);
- 
-    -- Set "current" pointer to first list element.
-    procedure Reset (L : in out List_Type);
- 
- private
- 
-    type Node_Type;
-    type Node_Pointer is access Node_Type;
- 
-    type Node_Type is record
-       Item : Element_Type;
-       Next : Node_Pointer;
-    end record;
- 
-    type List_Type is record
-       First   : Node_Pointer;
-       Current : Node_Pointer;
-       Last    : Node_Pointer;
-    end record;
- 
- end FC70B00;
- 
- 
-      --==================================================================--
- 
- 
- package body FC70B00 is
- 
-    function End_Of_List (L : List_Type) return Boolean is
-    begin
-       return (L.Current = null);
-    end End_Of_List;
- 
- 
-    procedure View_Element (L : in List_Type; E : out Element_Type) is
-    begin
-       -- ... Error-checking code omitted for brevity.
-       E := L.Current.Item;               -- Retrieve current element.
-    end View_Element;
- 
- 
-    procedure Read_Element (L : in out List_Type; E : out Element_Type) is
-    begin
-       -- ... Error-checking code omitted for brevity.
-       E         := L.Current.Item;       -- Retrieve current element.
-       L.Current := L.Current.Next;       -- Advance "current" pointer.
-    end Read_Element;
- 
- 
-    procedure Write_Element (L : in out List_Type; E : in Element_Type) is
-    begin
-       -- ... Error-checking code omitted for brevity.
-       L.Current.Item := E;               -- Write to current element.
-       L.Current      := L.Current.Next;  -- Advance "current" pointer.
-    end Write_Element;
- 
- 
-    procedure Add_Element (L : in out List_Type; E : in Element_Type) is
-       New_Node : Node_Pointer := new Node_Type'(E, null); 
-    begin
-       if L.First = null then             -- No elements in list, so add new
-          L.First := New_Node;            -- element at beginning of list.
-       else
-          L.Last.Next := New_Node;        -- Add new element at end of list.
-       end if;
-       L.Last := New_Node;                -- Set last-in-list pointer.
-    end Add_Element;
- 
- 
-    procedure Reset (L : in out List_Type) is
-    begin
-       L.Current := L.First;              -- Set "current" pointer to first
-    end Reset;                            -- list element.
- 
- 
- end FC70B00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fc70c00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fc70c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fc70c00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fc70c00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- FC70C00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation defines a generic list abstraction in two packages.
- --      The first package declares the types, the second declares the
- --      operations. List elements can be of any (nonlimited) type. Lists are
- --      implemented as singly linked lists. Access to list elements is
- --      sequential. For each list, pointers are maintained to the first and
- --      last elements in the list, as well as the next element to be accessed.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic             
-    type Element_Type is private;  -- List elems may be of any nonlimited type.
- package FC70C00_0 is              -- List abstraction.
- 
-    type Node_Type;
-    type Node_Pointer is access Node_Type;
- 
-    type Node_Type is record
-       Item : Element_Type;
-       Next : Node_Pointer;
-    end record;
- 
-    type List_Type is record
-       First   : Node_Pointer;
-       Current : Node_Pointer;
-       Last    : Node_Pointer;
-    end record;
- 
- end FC70C00_0;
- 
- 
-      --==================================================================--
- 
- 
- -- No body for FC70C00_0;
- 
- 
-      --==================================================================--
- 
- 
- with FC70C00_0;                -- List abstraction.
- generic
-    with package List_Mgr is new FC70C00_0 (<>);
- package FC70C00_1 is           -- Basic list operations.
- 
-    -- Return true if current element is last in the list.
-    function End_Of_List (L : List_Mgr.List_Type) return Boolean;
- 
-    -- Set "current" pointer to first list element.
-    procedure Reset (L : in out List_Mgr.List_Type);
- 
- end FC70C00_1;
- 
- 
-      --==================================================================--
- 
- 
- package body FC70C00_1 is
- 
-    function End_Of_List (L : List_Mgr.List_Type) return Boolean is
-       use List_Mgr;  -- Renders "=" directly visible.
-    begin
-       return (L.Current = null);
-    end End_Of_List;
- 
- 
-    procedure Reset (L : in out List_Mgr.List_Type) is
-    begin
-       L.Current := L.First;                 -- Set "current" pointer to first
-    end Reset;                               -- list element.
- 
- end FC70C00_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fcndecl.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/fcndecl.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fcndecl.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fcndecl.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- FCNDECL.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- PACKAGE THAT MAY BE MODIFIED TO DECLARE FUNCTIONS THAT RETURN
- -- VALUES USABLE FOR INITIALIZATION OF CONSTANTS IN PACKAGE SPPRT13.
- 
- WITH SYSTEM;
- PACKAGE FCNDECL IS
- -- INSERT FUNCTION DECLARATIONS AS NEEDED.
- 
-   type Mem is array (1 .. 100) of Long_Long_Integer;
-   Var0: Mem;
-   Var1: Mem;
-   Var2: Mem;
- 
-   Var_Addr : constant System.Address := Var0'address;
-   Var_Addr1: constant System.Address := Var1'address;
-   Var_Addr2: constant System.Address := Var2'address;
- 
-   Ent0: Mem;
-   Ent1: Mem;
-   Ent2: Mem;
- 
-   Entry_Addr : constant System.Address := Ent0'address;
-   Entry_Addr1: constant System.Address := Ent0'address;
-   Entry_Addr2: constant System.Address := Ent0'address;
- 
- END FCNDECL;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fd72a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fd72a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fd72a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fd72a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- FD72A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides a basis for testing package
- --      System.Address_To_Access_Conversions
- --
- -- TEST FILES:
- --      The following files comprise this foundation:
- --
- --         FD72A00.A
- --
- -- CHANGE HISTORY:
- --      08 FEB 96   SAIC    Initial version
- --
- --!
- 
- with Impdef;
- with System.Storage_Elements;
- package FD72A00 is
-   use System;
- 
-   subtype Number is System.Storage_Elements.Integer_Address;
- 
-   package Num_IO renames Impdef.Address_Value_IO;
- 
-     -- the following conversions To/From Hex are to prevent optimizers from
-     -- optimizing out the otherwise senseless identity conversions, and
-     -- given the unknown nature of the type Number, the Identity operations
-     -- provided in Report will not suffice to this cause.
- 
-     function Address_To_Hex( Adder: System.Address ) return String;
- 
-     function Hex_To_Address( Hex: access String ) return System.Address;
- 
- end FD72A00;
- 
- package body FD72A00 is
- 
-     function Address_To_Hex( Adder: System.Address ) return String is
-       S : String(1..64)
-        := "uninitializedDEFuninitializedDEFuninitializedDEFuninitializedDEF";
-       DeBlank : Positive := S'First;
-     begin
-       Num_IO.Put( S, Number( System.Storage_Elements.To_Integer( Adder ) ),
-                   Base => 16 );
-       while S(DeBlank) = ' ' loop
-         DeBlank := DeBlank +1;
-       end loop;
-       return S(DeBlank..S'Last);
-     end Address_To_Hex;
- 
-     function Hex_To_Address( Hex: access String ) return System.Address is
-       The_Number : Number;
-       Tail       : Natural;
-     begin
-       Num_IO.Get( Hex.all, The_Number, Tail );
-       return System.Storage_Elements.To_Address(
-                       System.Storage_Elements.Integer_Address( The_Number ) );
-     end Hex_To_Address;
- 
- end FD72A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fdb0a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fdb0a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fdb0a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fdb0a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- FDB0A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides the basis for testing package
- --      System.Storage_Pools.  It provides simple implementations of
- --      Allocate and Deallocate that have the side effect of calling
- --      TCTouch.Touch when they are called.
- --
- -- CHANGE HISTORY:
- --      02 JUN 95   SAIC   Initial version
- --      05 APR 96   SAIC   Fixed header for 2.1
- --      02 JUL 98   EDS    Swapped Pool.Avail change with overflow check
- --!
- 
- ---------------------------------------------------------------- FDB0A00
- 
- with Report;
- with System.Storage_Pools;
- with System.Storage_Elements;
- package FDB0A00 is
- 
-   type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count )
-      is new System.Storage_Pools.Root_Storage_Pool with private;
- 
-   procedure Allocate(
-     Pool : in out Stack_Heap;
-     Storage_Address : out System.Address;
-     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
-     Alignment : in System.Storage_Elements.Storage_Count);
- 
-   procedure Deallocate(
-     Pool : in out Stack_Heap;
-     Storage_Address : in System.Address;
-     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
-     Alignment : in System.Storage_Elements.Storage_Count);
- 
-   function Storage_Size( Pool: in Stack_Heap )
-            return System.Storage_Elements.Storage_Count;
- 
-   function TC_Largest_Request return System.Storage_Elements.Storage_Count;
- 
-   Pool_Overflow : exception;
- 
- private
- 
-   type Data_Array is array(System.Storage_Elements.Storage_Count range <>)
-                      of System.Storage_Elements.Storage_Element;
- 
-   type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count )
-      is new System.Storage_Pools.Root_Storage_Pool with record
-        Data  : Data_Array(1..Water_Line);
-        Avail : System.Storage_Elements.Storage_Count := 1;
-   end record;
- 
- end FDB0A00;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body FDB0A00 is
- 
-   Largest_Request_On_Record : System.Storage_Elements.Storage_Count := 0;
- 
-   procedure Allocate(
-     Pool : in out Stack_Heap;
-     Storage_Address : out System.Address;
-     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
-     Alignment : in System.Storage_Elements.Storage_Count) is
-       use type System.Storage_Elements.Storage_Offset;
-   begin
-     TCTouch.Touch('A');  --------------------------------------------------- A
- 
-     -- set the pointer to the next correctly aligned available address
-     Pool.Avail := Pool.Avail
-                 + (Alignment - (Pool.Data(Pool.Avail)'Address mod Alignment));
- 
-     -- check for overflow
-     if Pool.Avail + Size_In_Storage_Elements > Pool.Water_Line then
-       raise Pool_Overflow;
-     end if;
- 
-     -- set the resulting address to that address
-     Storage_Address := Pool.Data(Pool.Avail)'Address;
- 
-     -- update the housekeeping
-     Pool.Avail := Pool.Avail + Size_In_Storage_Elements;
-     Largest_Request_On_Record
-       := System.Storage_Elements.Storage_Count'Max(Largest_Request_On_Record,
-                                                    Size_In_Storage_Elements);
-   exception
-     when Constraint_Error => raise Pool_Overflow;  -- in case I missed an edge
-   end Allocate;
- 
-   procedure Deallocate(
-     Pool : in out Stack_Heap;
-     Storage_Address : in System.Address;
-     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
-     Alignment : in System.Storage_Elements.Storage_Count) is
-   begin
-     TCTouch.Touch('D');  --------------------------------------------------- D
- 
-     -- for the purposes of validation, the simplest possible implementation
-     -- of Deallocate is shown below:
- 
-     null;
- 
-   end Deallocate;
- 
-   function Storage_Size( Pool: in Stack_Heap )
-            return System.Storage_Elements.Storage_Count is
-   begin
-     TCTouch.Touch('S');  --------------------------------------------------- S
-     return Pool.Water_Line;
-   end Storage_Size;
- 
-   function TC_Largest_Request return System.Storage_Elements.Storage_Count is
-   begin
-     return Largest_Request_On_Record;
-   end TC_Largest_Request;
- 
- end FDB0A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fdd2a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fdd2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fdd2a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fdd2a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- FDD2A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides the basis for testing user-defined stream
- --      attributes. It provides operations which count calls to stream
- --      attributes.
- --
- -- CHANGE HISTORY:
- --    30 JUL 2001   PHL   Initial version.
- --     5 DEC 2001   RLB   Reformatted for ACATS.
- --
- 
- with Ada.Streams;
- use Ada.Streams;
- package FDD2A00 is
- 
-     type Kinds is (Read, Write, Input, Output);
-     type Counts is array (Kinds) of Natural;
- 
- 
-     type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
-         record
-             First : Stream_Element_Offset := 1;
-             Last : Stream_Element_Offset := 0;
-             Contents : Stream_Element_Array (1 .. Size);
-         end record;
- 
-     procedure Clear (Stream : in out My_Stream);
- 
-     procedure Read (Stream : in out My_Stream;
-                     Item : out Stream_Element_Array;
-                     Last : out Stream_Element_Offset);
- 
-     procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
- 
- 
-     generic
-         type T (<>) is limited private;
-         with procedure Actual_Write
-                           (Stream : access Root_Stream_Type'Class; Item : T);
-         with function Actual_Input
-                          (Stream : access Root_Stream_Type'Class) return T;
-         with procedure Actual_Read (Stream : access Root_Stream_Type'Class;
-                                     Item : out T);
-         with procedure Actual_Output
-                           (Stream : access Root_Stream_Type'Class; Item : T);
-     package Counting_Stream_Ops is
- 
-         procedure Write (Stream : access Root_Stream_Type'Class; Item : T);
-         function Input (Stream : access Root_Stream_Type'Class) return T;
-         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T);
-         procedure Output (Stream : access Root_Stream_Type'Class; Item : T);
- 
-         function Get_Counts return Counts;
- 
-     end Counting_Stream_Ops;
- 
- end FDD2A00;
- package body FDD2A00 is
- 
-     procedure Clear (Stream : in out My_Stream) is
-     begin
-         Stream.First := 1;
-         Stream.Last := 0;
-     end Clear;
- 
-     procedure Read (Stream : in out My_Stream;
-                     Item : out Stream_Element_Array;
-                     Last : out Stream_Element_Offset) is
-     begin
-         if Item'Length >= Stream.Last - Stream.First + 1 then
-             Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
-                Stream.Contents (Stream.First .. Stream.Last);
-             Last := Item'First + Stream.Last - Stream.First;
-             Stream.First := Stream.Last + 1;
-         else
-             Item := Stream.Contents (Stream.First ..
-                                         Stream.First + Item'Length - 1);
-             Last := Item'Last;
-             Stream.First := Stream.First + Item'Length;
-         end if;
-     end Read;
- 
-     procedure Write (Stream : in out My_Stream;
-                      Item : in Stream_Element_Array) is
-     begin
-         Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
-         Stream.Last := Stream.Last + Item'Length;
-     end Write;
- 
- 
-     package body Counting_Stream_Ops is
-         Cnts : Counts := (others => 0);
- 
-         procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
-         begin
-             Cnts (Write) := Cnts (Write) + 1;
-             Actual_Write (Stream, Item);
-         end Write;
- 
-         function Input (Stream : access Root_Stream_Type'Class) return T is
-         begin
-             Cnts (Input) := Cnts (Input) + 1;
-             return Actual_Input (Stream);
-         end Input;
- 
-         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
-         begin
-             Cnts (Read) := Cnts (Read) + 1;
-             Actual_Read (Stream, Item);
-         end Read;
- 
-         procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
-         begin
-             Cnts (Output) := Cnts (Output) + 1;
-             Actual_Output (Stream, Item);
-         end Output;
- 
-         function Get_Counts return Counts is
-         begin
-             return Cnts;
-         end Get_Counts;
- 
-     end Counting_Stream_Ops;
- 
- end FDD2A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxa5a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxa5a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxa5a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxa5a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- FXA5A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation package contains constants and a function used in 
- --      the evaluation of the Generic Elementary Functions.
- --
- -- CHANGE HISTORY:
- --      06 Mar 95   SAIC    Initial prerelease version.
- --      03 Apr 95   SAIC    Corrected error in context clause.
- --      12 Jun 95   SAIC    Added procedure Dont_Optimize.  Added New_Float
- --                          type, and overload of function 
- --                          Result_Within_Range.
- --
- --!
- 
- with Ada.Numerics;
- with Report;
- 
- package FXA5A00 is
- 
-    -- Constants.
- 
-    Epsilon               : constant Float := Float'Model_Epsilon;
-    Small                 : constant Float := Float'Model_Small;
-    Large                 : constant Float := Float'Safe_Last;
-    Minus_Large           : constant Float := Float'Safe_First; 
- 
-    Half_Pi               : constant Float := Ada.Numerics.Pi / 2.0;
-    Two_Pi                : constant Float := Ada.Numerics.Pi * 2.0;
- 
-    Floating_Delta        : constant Float :=  0.05;
-    One_Plus_Delta        : constant Float :=  1.0 + Floating_Delta;
-    One_Minus_Delta       : constant Float :=  1.0 - Floating_Delta;
-    Minus_One_Plus_Delta  : constant Float := -1.0 + Floating_Delta;
-    Minus_One_Minus_Delta : constant Float := -1.0 - Floating_Delta;
- 
- 
-    type New_Float is new Float digits 6;
- 
-    function Result_Within_Range (Result          : Float;
-                                  Expected_Result : Float;
-                                  Relative_Error  : Float) return Boolean;
- 
-    function Result_Within_Range (Result          : New_Float;
-                                  Expected_Result : Float;
-                                  Relative_Error  : Float) return Boolean;
- 
-    -- This procedure is designed to defeat optimization attempts by an 
-    -- implementation in cases where an exception is specifically raised
-    -- in a test to test a prescribed exception result condition.
-    -- The parameter Num is a unique identifier for location purposes within
-    -- the test.
- 
-    generic
-       type Eval_Type is digits <>;
-    procedure Dont_Optimize (Check_Result : Eval_Type; 
-                             Num          : Integer);
- 
- end FXA5A00;
- 
- ---
- 
- package body FXA5A00 is
- 
- 
-    function Result_Within_Range (Result          : Float;
-                                  Expected_Result : Float;
-                                  Relative_Error  : Float) return Boolean is
-    begin
-       return (Result <= Expected_Result + Relative_Error) and 
-              (Result >= Expected_Result - Relative_Error);
-    end Result_Within_Range;
- 
- 
-    function Result_Within_Range (Result          : New_Float;
-                                  Expected_Result : Float;
-                                  Relative_Error  : Float) return Boolean is
-    begin
-       return (Float(Result) <= Expected_Result + Relative_Error) and 
-              (Float(Result) >= Expected_Result - Relative_Error);
-    end Result_Within_Range;
- 
- 
-    procedure Dont_Optimize (Check_Result : Eval_Type; 
-                             Num          : Integer) is
-    begin
-       -- Note that the use of Minus_Large here is simply as a "dummy" value,
-       -- designed to indicate use of the Check_Result parameter, and has no
-       -- pass/fail significance to any test using this procedure.
-       --
-       if Float(Check_Result) = Minus_Large then
-          Report.Comment("Attempted Defeat of Optimization ONLY -- Not " &
-                         "a cause for test failure! "                    & 
-                         "Result = Minus_Large, Case:" & Integer'Image(Num));
-       end if;
-    end Dont_Optimize;
- 
- end FXA5A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxaca00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxaca00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxaca00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxaca00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- FXACA00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation consists of type definitions and object declarations 
- --      used by tests of Stream_IO functionality.
- --      Objects of both record types specified below (discriminated records
- --      with defaults, and discriminated records w/o defaults that have the
- --      discriminant included in a representation clause for the type) should 
- --      have their discriminants included in the stream when using 'Write 
- --      Likewise, discriminants should be extracted from the stream when
- --      using 'Read.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- with ImpDef;
- 
- package FXACA00 is
- 
-    type Origin_Type is (Foreign, Domestic);
- 
-    for Origin_Type'Size use 1;   -- Forces objects of the type to be
-                                  -- representable in 1 bit, used in rep clause
-                                  -- below for Sales_Record_Type.
- 
-    type Product_Type (Manufacture : Origin_Type := Domestic) is
-       record
-          Item : String (1..8);               
-          ID   : Natural range 1..100;
-          case Manufacture is
-             when Foreign  =>
-                Importer : String (1..10);
-             when Domestic =>
-                Distributor : String (1..10);
-          end case;
-       end record;
- 
- 
-    type Sales_Record_Type (Buyer : Origin_Type) is   -- No default provided
-       record                                         -- for the discriminant.
-          Name      : String (1..6);
-          Sale_Item : Boolean := False;
-          case Buyer is
-             when Foreign  =>
-                Quantity_Discount : Boolean;
-             when Domestic =>
-                Cash_Discount : Boolean;
-          end case;
-       end record;
- 
- 
-    String_Bits : constant := ImpDef.Char_Bits * 6 - 1;
- 
-    -- This discriminated record type has a representation clause that 
-    -- includes the discriminant of the object of this type.
- 
-    for Sales_Record_Type use                    
-       record                                    
-          Name              at 0 range 0..String_Bits;    
-          Sale_Item         at ImpDef.Next_Storage_Slot range 0..0;     
-          Buyer             at ImpDef.Next_Storage_Slot range 1..1;     
-          Quantity_Discount at ImpDef.Next_Storage_Slot range 2..2;
-          Cash_Discount     at ImpDef.Next_Storage_Slot range 3..3;
-       end record;
- 
- 
-    type Timespan_Type is (Week, Month, Year);
- 
-    type Sales_Statistics_Type is 
-       array (Timespan_Type) of natural range 0 .. 500;
- 
- 
-    -- Object Declarations
- 
- 
-    Product_01 : Product_Type := (Domestic, "Product1", 1, "Distrib 01");
-    Product_02 : Product_Type (Manufacture => Foreign) := (Foreign,
-                                                           "Product2",
-                                                           2,
-                                                           "Importer02");
-    Product_03 : Product_Type (Foreign) := (Manufacture => Foreign,
-                                            Item        => "Product3",
-                                            ID          => 3,
-                                            Importer    => "Importer03");
-    --
- 
-    Sale_Count_01 : Integer := 2;
-    Sale_Count_02 : Integer := 0;
-    Sale_Count_03 : Integer := 3;
- 
-    --
- 
-    Sale_Rec_01 : Sales_Record_Type (Domestic) := 
-      (Domestic, "Buyer1", False, True);
-    Sale_Rec_02 : Sales_Record_Type (Domestic) := 
-      (Domestic, "Buyer2", True,  False);
- 
-    Sale_Rec_03 : Sales_Record_Type (Buyer => Foreign) := 
-      (Buyer => Foreign, Name => "Buyer3", Sale_Item => True, 
-       Quantity_Discount => True);
- 
-    Sale_Rec_04 : Sales_Record_Type (Foreign) := 
-      (Foreign, "Buyer4", True, False);
-    Sale_Rec_05 : Sales_Record_Type (Buyer => Foreign) := (Foreign,
-                                                           "Buyer5",
-                                                           False,
-                                                           False);
-    --
- 
-                                                        
-    Product_01_Stats : Sales_Statistics_Type := (2,4,8);
-    Product_02_Stats : Sales_Statistics_Type := (Week  =>  0,
-                                                 Month =>  5,
-                                                 Year  => 10);
-    Product_03_Stats : Sales_Statistics_Type := (3, 6, others => 12);
- 
- 
- end FXACA00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxacb00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxacb00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxacb00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxacb00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- FXACB00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation consists of type definitions and object declarations 
- --      used by tests of Stream_IO functionality.
- --      These types include an unconstrained array type, and a discriminated 
- --      record without a default discriminant, specifically chosen for use in 
- --      demonstrating the capabilities of 'Output and 'Input. 
- --      
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FXACB00 is
- 
-    type    Customer_Type          is (Residence, Apartment, Commercial);
-    type    Electric_Usage_Type    is range 0..100000;
-    type    Months_In_Service_Type is range 1..12;
-    type    Quarterly_Period_Type  is (Spring, Summer, Autumn, Winter);
-    subtype Month_In_Quarter_Type  is Positive range 1..3;
-    type    Service_History_Type   is 
-      array (Quarterly_Period_Type range <>, Month_In_Quarter_Type range <>) 
-      of Electric_Usage_Type;
- 
- 
-    type Service_Type (Customer : Customer_Type) is
-       record
-          Name       : String (1..21);               
-          Account_ID : Natural range 0..100;
-          case Customer is
-             when Residence | Apartment =>
-                Low_Income_Credit : Boolean := False;
-             when Commercial            =>
-                Baseline_Allowance : Natural range 0..1000;
-                Quantity_Discount  : Boolean := False;
-          end case;
-       end record;
- 
- 
-    -- Object Declarations
- 
- 
-    Customer1 : Service_Type (Residence) := 
-      (Residence, "1221 Morningstar Lane", 44, False); 
-    Customer2 : Service_Type (Apartment) := (Customer => Apartment,
-                                             Account_ID => 67,
-                                             Name => "15 South Front St. #8",
-                                             Low_Income_Credit => True);
-    Customer3 : Service_Type (Commercial) := (Commercial,
-                                              "12442 Central Avenue ", 
-                                              100, 
-                                              Baseline_Allowance => 938, 
-                                              Quantity_Discount  => True);
- 
-    --
- 
-    C1_Months : Months_In_Service_Type := 10;
-    C2_Months : Months_In_Service_Type :=  2;
-    C3_Months : Months_In_Service_Type := 12;
-    
-    --
- 
-    C1_Service_History : 
-      Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) := 
-        (Spring => (1 => 35, 2 => 39, 3 => 32),
-         Summer => (1 => 34, 2 => 33, 3 => 39),
-         Autumn => (1 => 45, 2 => 40, 3 => 38),
-         Winter => (1 => 53, 2 =>  0, 3 =>  0));
-   
-    C2_Service_History : 
-      Service_History_Type (Quarterly_Period_Type range Spring..Summer, 
-                            Month_In_Quarter_Type) := 
-        (Spring => (23, 22, 0), Summer => (0, 0, 0));
- 
-    C3_Service_History :
-      Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) := 
-        (others => (others => 200));
- 
-    --
- 
-    Total_Customers_In_Service : constant Natural := 3;
- 
- end FXACB00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxacc00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxacc00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxacc00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxacc00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- FXACC00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation consists of a tagged type definition and several
- --      record extensions.  Objects of each type have also been declared 
- --      and given initial values.
- --      
- --      Visual Description of Type Extensions:
- --      
- --                         type Ticket_Request
- --                                  |
- --                   _______________|_________________
- --                  |                                 |
- --                  |                                 |
- --         type Subscriber_Request             type VIP_Request
- --                                                    |
- --                                                    |
- --                                             type Last_Minute_Request
- --      
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Calendar;
- 
- package FXACC00 is
- 
-    type    Location_Type      is (Backstage, Orchestra, Center, Back, Balcony);
-    type    Quantity_Type      is range 1 .. 100;
-    subtype Season_Ticket_Type is Positive range 1 .. 1750;
-    type    VIP_Status_Type    is (Mayor, City_Council, Visitor);
-    type    Donation_Type      is (To_Charity, To_Theatre, Personal);
- 
-    Show_Of_Appreciation : constant Boolean := True;
- 
-    type Ticket_Request is tagged
-       record
-          Location          : Location_Type;
-          Number_Of_Tickets : Quantity_Type;
-       end record;
- 
- 
-    type Subscriber_Request is new Ticket_Request with
-       record
-          Subscription_Number : Season_Ticket_Type;
-       end record;
- 
- 
-    type VIP_Request is new Ticket_Request with
-       record
-          Rank : VIP_Status_Type;
-       end record;
- 
- 
-    type Last_Minute_Request (Special_Consideration : Boolean) 
-      is new VIP_Request with
-       record
-          Time_of_Request : Ada.Calendar.Time;
-          case Special_Consideration is
-             when True  => Donation : Donation_Type;
-             when False => null;
-          end case;
-       end record;
- 
- 
-    -- Object Declarations.
- 
- 
-    Box_Office_Request     : Ticket_Request := 
-                               (Location          => Back, 
-                                Number_Of_Tickets => 2);
- 
-    Summer_Subscription    : Subscriber_Request := 
-                               (Ticket_Request'(Box_Office_Request) 
-                                with Subscription_Number => 567);  
- 
-    Mayoral_Ticket_Request : VIP_Request := 
-                               (Location          => Backstage,
-                                Number_Of_Tickets => 6,
-                                Rank              => Mayor);
-                                             
-    Late_Request           : Last_Minute_Request (Show_Of_Appreciation) :=
-                               (Special_Consideration => Show_Of_Appreciation, 
-                                Location              => Orchestra, 
-                                Number_Of_Tickets     => 2, 
-                                Rank                  => City_Council,
-                                Time_Of_Request       => Ada.Calendar.Clock,
-                                Donation              => To_Charity);
- 
- 
- end FXACC00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxc6a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxc6a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxc6a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxc6a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,162 ****
- -- FXC6A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --     This foundation declares various volatile and non-volatile types. Some
- --     are by-reference types, and some allow pass-by-copy.
- --
- -- CHANGE HISTORY:
- --      23 Jan 96   SAIC    Initial version for ACVC 2.1.
- --      02 DEC 97   EDS     Removed Pragma Volatile applied to composite types.
- --      27 AUG 99   RLB     Repaired so Nonvolatile_Tagged really is
- --                          Nonvolatile.
- --!
- 
- package FXC6A00 is
- 
-    type Roman is ('I', 'V', 'X', 'L', 'C', 'D', 'M');  -- By-copy type.
- 
-    type Acc_Roman is access all Roman;
- 
- 
-    type Tagged_Type is tagged record                   -- By-reference type.
-       C: Natural;
-    end record;
- 
- 
-    type Volatile_Tagged is new Tagged_Type with record -- Volatile by-reference
-       R1: Roman;                                       -- type.
-    end record;
-    pragma Volatile (Volatile_Tagged);
- 
-    type Acc_Volatile_Tagged is access all Volatile_Tagged;
- 
-                                                        -- By-reference type.
-    type NonVolatile_Tagged is new Tagged_Type with record
-       R2: aliased Roman;
-    end record;
- 
- 
-    task type Task_Type is                              -- By-reference type.
-       entry Calculate (C: in out Natural);
-    end Task_Type;
- 
-    type Acc_Task_Type is access all Task_Type;
- 
- 
-    protected type Protected_Type is                    -- By-reference type.
-       procedure Op;
-    private
-       Count : Natural := 0;
-    end Protected_Type;
- 
- 
-    protected type Volatile_Protected is                -- Volatile by-reference
-       procedure Handler;                               -- type.
-       pragma Interrupt_Handler (Handler);
- 
-       function Handled return Boolean;
-    private
-       Was_Handled : Boolean := False;
-    end Volatile_Protected;
-    pragma Volatile (Volatile_Protected);
- 
-    type Acc_Vol_Protected is access all Volatile_Protected;
- 
- 
-    type Record_Type is record                          -- Allows pass-by-copy.
-       C: String(1 .. 2);
-    end record;
- 
- 
-    type Volatile_Record is limited record              -- Volatile by-reference
-       C: String(1 .. 2);                               -- type.
-    end record;
-    pragma Volatile (Volatile_Record);
- 
- 
-    type Composite_Type is record                       -- By-reference type.
-       C: Tagged_Type;
-       D: aliased Volatile_Tagged;                      -- Volatile component.
-    end record;
- 
- 
-    type Private_Type is private;                       -- By-reference type.
- 
- 
-    type Array_Type is array (1..3) of Tagged_Type;     -- By-reference type.
-    pragma Volatile_Components (Array_Type);
- 
-    type Acc_Array_Type is access all Array_Type;
- 
- 
-    type Lim_Private_Type is limited private;           -- By-copy type.
- 
- private
- 
-    type Private_Type is new Tagged_Type with record
-       D: Character;
-    end record;
- 
- 
-    type Lim_Private_Type is new Integer;
- 
- end FXC6A00;
- 
- 
-      --==================================================================--
- 
- 
- package body FXC6A00 is
- 
-    task body Task_Type is
-    begin
-       accept Calculate (C: in out Natural) do
-          C := C * 10;
-       end Calculate;
-    end Task_Type;
- 
- 
-    protected body Protected_Type is
-       procedure Op is
-       begin
-          Count := Count + 1;
-       end Op;
-    end Protected_Type;
- 
- 
-    protected body Volatile_Protected is
-       procedure Handler is
-       begin
-          Was_Handled := True;
-       end Handler;
- 
-       function Handled return Boolean is
-       begin
-          return Was_Handled;
-       end Handled;
-    end Volatile_Protected;
- 
- end FXC6A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxe2a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxe2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxe2a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxe2a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- FXE2A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation provides a Declared Pure package, a Shared Passive 
- --      package, a Remote Types package and a normal, unrestricted package. 
- --
- --      It is used by tests checking the interrelationship between the 
- --      categorized packages
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- --====================================================================
- 
- -- This is a DECLARED PURE package
- --
- package FXE2A00_0 is
- 
-    pragma pure (FXE2A00_0);
- 
-    type Type_From_0 is (Red, Orange, Yellow);
- 
- 
- end FXE2A00_0;
- 
- 
- --====================================================================
- 
- -- This is a SHARED_PASSIVE package
- --
- package FXE2A00_1 is
- 
- 
-    pragma shared_passive (FXE2A00_1);
-    
-    type Type_From_1 is (Blue, Indigo, Violet);
- 
- end FXE2A00_1;
- 
- 
- --====================================================================
- 
- -- This is a REMOTE TYPES package
- --
- package FXE2A00_2 is
- 
-    pragma Remote_Types (FXE2A00_2);
- 
-    type Type_From_2 is (Red, Orange, Yellow, Green, Blue, Indigo, Violet); 
- 
- end FXE2A00_2;
- 
- 
- --====================================================================
- 
- -- This is a NORMAL unrestricted package which has no categorization
- --
- package FXE2A00_4 is
- 
-    type Type_From_4 is (Black, White);
- 
- end FXE2A00_4;
- 
- --====================================================================
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxf2a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxf2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxf2a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxf2a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- FXF2A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation declares supporting objects, types and a generic
- --      function for testing decimal fixed point operations.
- --
- --      The generic function contains a loop which steps through two arrays:
- --      one of binary operations and one of operands. For each iteration, the
- --      current operation is performed on the current operand and a variable
- --      "Result" e.g.:
- --
- --                   Result := Operation(2)(Operand(3), Result);
- --
- --      The result of each operation is cumulated in Result and returned to
- --      the caller when the loop completes.
- --
- -- CHANGE HISTORY:
- --      12 Mar 96   SAIC    Prerelease version for ACVC 2.1.
- --
- --!
- 
- package FXF2A00 is
- 
-    Loop_Count : constant := 30000;             -- # test iterations.
-    Optr_Count : constant :=     6;             -- # operations in op sequence.
-    Opnd_Count : constant :=     5;             -- # different operands.
- 
-    type Loop_Range is range 1 .. Loop_Count;   -- range 1 .. 30000.
-    type Optr_Range is mod Optr_Count;          -- range 0 .. 5.
-    type Opnd_Range is mod Opnd_Count;          -- range 0 .. 4.
- 
- 
-    generic
- 
-       type Decimal_Fixed is delta <> digits <>;
- 
-       type Operator_Ptr is access
-         function (L, R : Decimal_Fixed) return Decimal_Fixed;
- 
-       type Operator_Table is array (Optr_Range) of Operator_Ptr;
-       type Operand_Table  is array (Opnd_Range) of Decimal_Fixed;
- 
-    function Operations_Loop (Initial : Decimal_Fixed;
-                              Operator: Operator_Table;
-                              Operand : Operand_Table) return Decimal_Fixed;
- 
- end FXF2A00;
- 
- 
-      --==================================================================--
- 
- 
- package body FXF2A00 is
- 
-    function Operations_Loop (Initial : Decimal_Fixed;
-                              Operator: Operator_Table;
-                              Operand : Operand_Table) return Decimal_Fixed is
- 
-       Result     : Decimal_Fixed := Initial;  -- Cumulator.
-       Optr_Index : Optr_Range := 0;           -- Index into operations table.
-       Opnd_Index : Opnd_Range := 0;           -- Index into operand table.
- 
-    begin
-       for Count in Loop_Range loop
-          Result     := Operator(Optr_Index) (Result, Operand(Opnd_Index));
-          Optr_Index := Optr_Index + 1;        -- Modular addition.
-          Opnd_Index := Opnd_Index + 1;        -- Modular addition.
-       end loop;
- 
-       return Result;
-    end Operations_Loop;
- 
- end FXF2A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/fxf3a00.a gcc-16-20250525/gcc/testsuite/ada/acats/support/fxf3a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/fxf3a00.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/fxf3a00.a	Thu Jan  1 00:00:00 1970
***************
*** 1,330 ****
- -- FXF3A00.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      This foundation contains decimal data values, valid and invalid
- --      Picture strings, and Edited Output result strings that will be used
- --      in tests of Appendix F.3.
- --      Note:  In this foundation package, the effect of "Table Driven Data"
- --      is achieved using a series of arrays to hold the various data items.
- --      Since the data items (Picture strings, Edited Output) are often of
- --      different lengths, the arrays are defined to contain pointers to 
- --      string values, thereby allowing the "tables" to hold string data of
- --      different sizes.
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Feb 95   SAIC    Picture string, decimal data, and edited_output
- --                          modifications.
- --      23 Feb 95   SAIC    Picture string modification.
- --      10 Mar 95   SAIC    Added explanatory comments.
- --      15 Nov 95   SAIC    Corrected picture string for ACVC 2.0.1.
- --      06 Oct 96   SAIC    Corrected invalid picture strings.
- --      13 Feb 97   PWB.CTA Deleted invalid picture string.
- --      17 Feb 97   PWB.CTA Added leading blank to two picture strings
- --!
- 
- with Ada.Text_IO.Editing;
- 
- package FXF3A00 is
- 
-    Number_Of_NDP_Items            : constant :=  12; -- No Decimal Places.
-    Number_Of_2DP_Items            : constant :=  20; -- Two Decimal Places.
-    Number_Of_Valid_Strings        : constant :=  40;
-    Number_Of_FF_Strings           : constant :=   4; -- French Francs
-    Number_Of_DM_Strings           : constant :=   5; -- Deutchemarks
-    Number_Of_CHF_Strings          : constant :=   1; -- Swiss Francs
-    Number_Of_Foreign_Strings      : constant :=   Number_Of_FF_Strings +
-                                                   Number_Of_DM_Strings +
-                                                   Number_Of_CHF_Strings; 
-    Number_Of_Invalid_Strings       : constant :=  25;
-    Number_Of_Erroneous_Conditions  : constant :=   3;
-    Number_Of_Edited_Output_Strings : constant :=  32;
- 
-    -- The following string is to be used as a picture string with length 
-    -- beyond the maximum (Max_Picture_Length) that is supported by the 
-    -- implementation.  
- 
-    A_Picture_String_Too_Long       : constant 
-      String (1..Ada.Text_IO.Editing.Max_Picture_Length + 1) := (others => '9');
- 
- 
-    type Str_Ptr is access String;
- 
-    type Decimal_Type_NDP is delta 1.0  digits 16;  -- no decimal places
-    type Decimal_Type_2DP is delta 0.01 digits 16;  -- two decimal places
- 
-    type Data_Array_Type_1 is array (Integer range <>) of Decimal_Type_NDP;
-    type Data_Array_Type_2 is array (Integer range <>) of Decimal_Type_2DP;
- 
- 
-    type Picture_String_Array_Type        is 
-      array (Integer range <>) of Str_Ptr;
- 
-    type Edited_Output_Results_Array_Type is 
-      array (Integer range <>) of Str_Ptr;
- 
- 
- 
-   Data_With_NDP : Data_Array_Type_1 (1..Number_Of_NDP_Items) := 
-                      ( 1 => 1234.0,
-                        2 => 51234.0,
-                        3 => -1234.0,
-                        4 => 1234.0,
-                        5 => 1.0,
-                        6 => 0.0,
-                        7 => -10.0,
-                        8 => -1.0,
-                        9 => 1234.0,
-                       10 => 1.0,
-                       11 => 36.0,
-                       12 => 0.0
-                      );
- 
- 
-    Data_With_2DP : Data_Array_Type_2 (1..Number_Of_2DP_Items) := 
-                      ( 1 => 123456.78,
-                        2 => 123456.78,
-                        3 => 0.0,
-                        4 => 0.20,
-                        5 => 123456.00,
-                        6 => -123456.78,
-                        7 => 123456.78,
-                        8 => -12.34,
-                        9 => 1.23,
-                       10 => 12.34,
- 
-         -- Items 11-20 are used with picture strings in evaluating use of
-         -- foreign currency symbols.
- 
-                       11 => 123456.78,
-                       12 => 123456.78,
-                       13 => 32.10,
-                       14 => -5432.10,
-                       15 => -1234.57,
-                       16 => 123456.78,
-                       17 => 12.34,
-                       18 => 12.34,
-                       19 => 1.23,
-                       20 => 12345.67
-                      );
- 
- 
- 
-    Valid_Strings   : Picture_String_Array_Type 
-                        (1..Number_Of_Valid_Strings) := 
- 
-         -- Items 1-10 are used in conjunction with Data_With_2DP values
-         -- to produce edited output strings, as well as in tests of
-         -- function Valid.
- 
-                        ( 1 => new String'("-###**_***_**9.99"),
-                          2 => new String'("-$**_***_**9.99"),
-                          3 => new String'("-$$$$$$.$$"),
-                          4 => new String'("-$$$$$$.$$"),
-                          5 => new String'("+BBBZZ_ZZZ_ZZZ.ZZ"),
-                          6 => new String'("--_---_---_--9"),
-                          7 => new String'("-$_$$$_$$$_$$9.99"),
-                          8 => new String'("<$$_$$$9.99>"),
-                          9 => new String'("$_$$9.99"),
-                         10 => new String'("$$9.99"),
- 
-         -- Items 11-22 are used in conjunction with Data_With_NDP values
-         -- to produce edited output strings.
- 
-                         11 => new String'("ZZZZ9"),
-                         12 => new String'("ZZZZ9"),
-                         13 => new String'("<#Z_ZZ9>"),
-                         14 => new String'("<#Z_ZZ9>"),
-                         15 => new String'("ZZZ.ZZ"),
-                         16 => new String'("ZZZ.ZZ"),
-                         17 => new String'("<###99>"),
-                         18 => new String'("ZZZZZ-"),
-                         19 => new String'("$$$$9"),
-                         20 => new String'("$$$$$"),
-                         21 => new String'("<###99>"),
-                         22 => new String'("$$$$9"),
- 
-         -- Items 23-40 are used in validation of the Valid, To_Picture, and
-         -- Pic_String subprograms of package Text_IO.Editing, and are not
-         -- used to generate edited output.
- 
-                         23 => new String'("zZzZzZzZzZzZzZzZzZ"),
-                         24 => new String'("999999999999999999"),
-                         25 => new String'("******************"),
-                         26 => new String'("$$$$$$$$$$$$$$$$$$"),
-                         27 => new String'("9999/9999B9999_999909999"),
-                         28 => new String'("+999999999999999999"),
-                         29 => new String'("-999999999999999999"),
-                         30 => new String'("999999999999999999+"),
-                         31 => new String'("999999999999999999-"),
-                         32 => new String'("<<<_<<<_<<<_<<<_<<<_<<9>"),
-                         33 => new String'("++++++++++++++++++++"),
-                         34 => new String'("--------------------"),
-                         35 => new String'("zZzZzZzZzZzZzZzZzZ.zZ"),
-                         36 => new String'("******************.99"),
-                         37 => new String'("$$$$$$$$$$$$$$$$$$.99"),
- 
-        -- The following string has length 30, which is the minimum value 
-        -- that must be supported for Max_Picture_Length.
- 
-                         38 => new String'("9_999_999_999_999_999_999BB.99"),
-                         39 => new String'("<<<_<<<_<<<_<<<.99>"),
-                         40 => new String'("ZZZZZZZZZZZZZZZZZ+")
-                        );
- 
- 
- 
-    Foreign_Strings : Picture_String_Array_Type 
-                        (1..Number_Of_Foreign_Strings) :=
- 
-        -- These strings are going to be used in conjunction with non-default
-        -- values for Currency string, Radix mark, and Separator in calls to
-        -- Image and Put, as well as in tests of function Valid.
- 
-                        ( 1 => new String'("-###**_***_**9.99"),    -- FF
-                          2 => new String'("-$**_***_**9.99"),      -- FF
-                          3 => new String'("<###z_ZZ9.99>"),        -- FF
-                          4 => new String'("<###Z_ZZ9.99>"),        -- FF
-                          5 => new String'("<<<<_<<<.<<###>"),      -- DM
-                          6 => new String'("-$_$$$_$$$_$$9.99"),    -- DM
-                          7 => new String'("$z99.99"),              -- DM
-                          8 => new String'("$$$9.99"),              -- DM
-                          9 => new String'("$_$$9.99"),             -- DM
-                         10 => new String'("###_###_##9.99")        -- CHF
-                        );
- 
- 
- 
-    Invalid_Strings : Picture_String_Array_Type 
-                        (1..Number_Of_Invalid_Strings) := 
-        --
-        -- The RM references to the right of these invalid picture strings
-        -- indicates which of the composition constraints of picture strings
-        -- is violated by the particular string (and all following strings
-        -- until another reference is presented).  However, certain strings
-        -- violate multiple of the constraints.
-        --
-                        ( 1 => new String'("<<<"),        
-                          2 => new String'("<<>>"),       
-                          3 => new String'("<<<9_B0/$DB"),
-                          4 => new String'("+BB"),        
-                          5 => new String'("<-"),
-                          6 => new String'("<CR"),
-                          7 => new String'("<db"),
-                          8 => new String'("<<BBBcr"),    
-                          9 => new String'("<<__DB"),
-                         10 => new String'("<<<++++_++-"),
-                         11 => new String'("-999.99>"),   
-                         12 => new String'("+++9.99+"),
-                         13 => new String'("++++>>"),     
-                         14 => new String'("->"),
-                         15 => new String'("++9-"),  
-                         16 => new String'("---999999->"),
-                         17 => new String'("+++-"),       
-                         18 => new String'("+++_+++_+.--"),
-                         19 => new String'("--B.BB+>"),
-                         20 => new String'("$$#$"),       
-                         21 => new String'("#B$$$$"),
-                         22 => new String'("**Z"),        
-                         23 => new String'("ZZZzzz*"),
-                         24 => new String'("9.99DB(2)"), 
-                         25 => new String'(A_Picture_String_Too_Long)
-                        );
- 
- 
-    Edited_Output : Edited_Output_Results_Array_Type
-                      (1..Number_Of_Edited_Output_Strings) :=   
- 
-         -- The following 10 edited output strings result from the first 10
-         -- valid strings when used with the first 10 Data_With_2DP numeric 
-         -- values.
-                            ( 1 => new String'("   $***123,456.78"),
-                              2 => new String'(" $***123,456.78"),
-                              3 => new String'("          "),
-                              4 => new String'("      $.20"),
-                              5 => new String'("+      123,456.00"),
-                              6 => new String'("      -123,457"),
-                              7 => new String'("      $123,456.78"),
-                              8 => new String'("(    $12.34)"),
-                              9 => new String'("   $1.23"),
-                             10 => new String'("$12.34"),
- 
-         -- The following 10 edited output strings correspond to the 10 foreign
-         -- currency picture strings (the currency string is supplied at the
-         -- time of the call to Editing.Image or Editing.Put), when used in
-         -- conjunction with Data_With_2DP items 11-20
- 
-                             11 => new String'("  FF***123.456,78"),
-                             12 => new String'(" FF***123.456,78"),
-                             13 => new String'("  FF   32,10 "),
-                             14 => new String'("( FF5.432,10)"), 
-                             15 => new String'("  (1,234.57DM )"),
-                             16 => new String'("      DM123,456.78"), 
-                             17 => new String'("DM 12.34"),
-                             18 => new String'(" DM12.34"),
-                             19 => new String'("   DM1.23"),
-                             20 => new String'("  CHF12,345.67"),
- 
-         -- The following 12 edited output strings correspond to the 12 
-         -- Data_With_NDP items formatted using Valid_String items 11-22.
-         -- This combination shows decimal data with no decimal places 
-         -- formatted using picture strings.
- 
-                             21 => new String'(" 1234"),
-                             22 => new String'("51234"),
-                             23 => new String'("($1,234)"),
-                             24 => new String'(" $1,234 "),
-                             25 => new String'("  1.00"),
-                             26 => new String'("      "),
-                             27 => new String'("(  $10)"),
-                             28 => new String'("    1-"),
-                             29 => new String'("$1234"),
-                             30 => new String'("   $1"),
-                             31 => new String'("   $36 "),
-                             32 => new String'("   $0")
-                            );
- 
- 
- 
-    -- The following data is used to create exception situations in tests of
-    -- the Edited Output capabilities of package Ada.Text_IO.Editing.  The data
-    -- are not themselves erroneous, but will produce exceptions based on the
-    -- data/picture string combination used.
- 
-    Erroneous_Data : Data_Array_Type_2 (1..Number_Of_Erroneous_Conditions) :=
-                      ( 1 => 12.34,
-                        2 => -12.34,
-                        3 => 51234.0
-                      );
- 
-    Erroneous_Strings : Picture_String_Array_Type 
-                          (1..Number_Of_Erroneous_Conditions) :=
-                            ( 1 => new String'("9.99"),
-                              2 => new String'("99.99"),
-                              3 => new String'("$$$$9")
-                            );
- 
- end FXF3A00;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/impbit.adb gcc-16-20250525/gcc/testsuite/ada/acats/support/impbit.adb
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/impbit.adb	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/impbit.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,6 ****
- with System;
- with Ada.Text_IO;
- procedure Impbit is
- begin
-    Ada.Text_IO.Put_Line (System.Address'Size'Img);
- end Impbit;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/impdef.a gcc-16-20250525/gcc/testsuite/ada/acats/support/impdef.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/impdef.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/impdef.a	Thu Jan  1 00:00:00 1970
***************
*** 1,385 ****
- -- IMPDEF.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- DESCRIPTION:
- --     This package provides tailorable entities for a particular
- --     implementation.  Each entity may be modified to suit the needs
- --     of the implementation.  Default values are provided to act as
- --     a guide.
- --
- --     The entities in this package are those which are used in at least
- --     one core test. Entities which are used exclusively in tests for
- --     annexes C-H are located in annex-specific child units of this package.
- --
- -- CHANGE HISTORY:
- --     12 DEC 93   SAIC    Initial PreRelease version
- --     02 DEC 94   SAIC    Second  PreRelease version
- --     16 May 95   SAIC    Added constants specific to tests of the random
- --                         number generator.
- --     16 May 95   SAIC    Added Max_RPC_Call_Time constant.
- --     17 Jul 95   SAIC    Added Non_State_String constant.
- --     21 Aug 95   SAIC    Created from existing IMPSPEC.ADA and IMPBODY.ADA
- --                         files.
- --     30 Oct 95   SAIC    Added external name string constants.
- --     24 Jan 96   SAIC    Added alignment constants.
- --     29 Jan 96   SAIC    Moved entities not used in core tests into annex-
- --                         specific child packages. Adjusted commentary.
- --                         Renamed Validating_System_Programming_Annex to
- --                         Validating_Annex_C. Added similar Validating_Annex_?
- --                         constants for the other non-core annexes (D-H).
- --     01 Mar 96   SAIC    Added external name string constants.
- --     21 Mar 96   SAIC    Added external name string constants.
- --     02 May 96   SAIC    Removed constants for draft test CXA5014, which was
- --                         removed from the tentative ACVC 2.1 suite.
- --                         Added constants for use with FXACA00.
- --     06 Jun 96   SAIC    Added constants for wide character test files.
- --     11 Dec 96   SAIC    Updated constants for wide character test files.
- --     13 Dec 96   SAIC    Added Address_Value_IO
- --     13 Sep 99   RLB     Added more external name string constants.
- --     16 Sep 99   RLB     Corrected definition of Non_State_String constant.
- --
- --!
- 
- with Report;
- with Ada.Text_IO;
- with System.Storage_Elements;
- 
- package ImpDef is
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following boolean constants indicate whether this validation will
-    -- include any of annexes C-H. The values of these booleans affect the
-    -- behavior of the test result reporting software.
-    --
-    --    True  means the associated annex IS included in the validation.
-    --    False means the associated annex is NOT included.
- 
-    Validating_Annex_C : constant Boolean := True;
-    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
- 
-    Validating_Annex_D : constant Boolean := True;
-    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
- 
-    Validating_Annex_E : constant Boolean := True;
-    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
- 
-    Validating_Annex_F : constant Boolean := True;
-    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
- 
-    Validating_Annex_G : constant Boolean := True;
-    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
- 
-    Validating_Annex_H : constant Boolean := True;
-    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This is the minimum time required to allow another task to get
-    -- control.  It is expected that the task is on the Ready queue.
-    -- A duration of 0.0 would normally be sufficient but some number
-    -- greater than that is expected.
- 
-    Minimum_Task_Switch : constant Duration := 0.001;
-    --                                         ^^^ --- MODIFY HERE AS NEEDED
- 
-    -- The above constant has been chosen for use with delay statements in the
-    -- GCC testsuite so that they do not take too long, but may be too small.
- 
-    Long_Minimum_Task_Switch : constant Duration := 0.1;
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This is the time required to activate another task and allow it
-    -- to run to its first accept statement.  We are considering a simple task
-    -- with very few Ada statements before the accept.  An implementation is
-    -- free to specify a delay of several seconds, or even minutes if need be.
-    -- The main effect of specifying a longer delay than necessary will be an
-    -- extension of the time needed to run the associated tests.
- 
-    Switch_To_New_Task : constant Duration := 0.001;
-    --                                        ^^^ -- MODIFY HERE AS NEEDED
- 
-    -- The above constant has been chosen for use with delay statements in the
-    -- GCC testsuite so that they do not take too long, but may be too small.
- 
-    Long_Switch_To_New_Task : constant Duration := 0.1;
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This is the time which will clear the queues of other tasks
-    -- waiting to run.  It is expected that this will be about five
-    -- times greater than Switch_To_New_Task.
- 
-    Clear_Ready_Queue : constant Duration := 0.1;
-    --                                       ^^^ --- MODIFY HERE AS NEEDED
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- Some implementations will boot with the time set to 1901/1/1/0.0
-    -- When a delay of Delay_For_Time_Past is given, the implementation
-    -- guarantees that a subsequent call to Ada.Calendar.Time_Of(1901,1,1)
-    -- will yield a time that has already passed (for example, when used in
-    -- a delay_until statement).
- 
-    Delay_For_Time_Past : constant Duration := 0.001;
-    --                                         ^^^ --- MODIFY HERE AS NEEDED
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- Minimum time interval between calls to the time dependent Reset
-    -- procedures in Float_Random and Discrete_Random packages that is
-    -- guaranteed to initiate different sequences.  See RM A.5.2(45).
- 
-    Time_Dependent_Reset : constant Duration := 0.001;
-    --                                          ^^^ --- MODIFY HERE AS NEEDED
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- Test CXA5013 will loop, trying to generate the required sequence
-    -- of random numbers.  If the RNG is faulty, the required sequence
-    -- will never be generated.  Delay_Per_Random_Test is a time-out value
-    -- which allows the test to run for a period of time after which the
-    -- test is failed if the required sequence has not been produced.
-    -- This value should be the time allowed for the test to run before it
-    -- times out.  It should be long enough to allow multiple (independent)
-    -- runs of the testing code, each generating up to 1000 random
-    -- numbers.
- 
-    Delay_Per_Random_Test : constant Duration := 0.001;
-    --                                           ^^^ --- MODIFY HERE AS NEEDED
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The time required to execute this procedure must be greater than the
-    -- time slice unit on implementations which use time slicing.  For
-    -- implementations which do not use time slicing the body can be null.
- 
-    procedure Exceed_Time_Slice;
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This constant must not depict a random number generator state value.
-    -- Using this string in a call to function Value from either the
-    -- Discrete_Random or Float_Random packages will result in
-    -- Constraint_Error or Program_Error (expected result in test CXA5012).
-    -- If there is no such string, set it to "**NONE**".
- 
-    Non_State_String : constant String := "By No Means A State";
-    --           MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This string constant must be a legal external tag value as used by
-    -- CD10001 for the type Some_Tagged_Type in the representation
-    -- specification for the value of 'External_Tag.
- 
-    External_Tag_Value : constant String := "implementation_defined";
-    --             MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^^^^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following address constant must be a valid address to locate
-    -- the C program CD30005_1.  It is shown here as a named number;
-    -- the implementation may choose to type the constant as appropriate.
- 
-    function Cd30005_Proc (X : Integer) return Integer;
-    pragma Import (C, Cd30005_Proc, "_cd30005_1");
-  
-    pragma Linker_Options ("ACATS4GNATDIR/support/cd300051.o");
-  
-    CD30005_1_Foreign_Address : constant System.Address:= Cd30005_Proc'Address;
-  
-    -- CD30005_1_Foreign_Address : constant System.Address:=
-    --          System.Storage_Elements.To_Address ( 16#0000_0000# )
-    --                    MODIFY HERE AS REQUIRED --- ^^^^^^^^^^^^^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following string constant must be the external name resulting
-    -- from the C compilation of CD30005_1.  The string will be used as an
-    -- argument to pragma Import.
- 
-    CD30005_1_External_Name : constant String := "_cd30005_1";
-    --                  MODIFY HERE AS NEEDED --- ^^^^^^^^^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following constants should represent the largest default alignment
-    -- value and the largest alignment value supported by the linker.
-    -- See RM 13.3(35).
- 
-    Max_Default_Alignment : constant := Standard'Maximum_Alignment;
-    --                                  ^ --- MODIFY HERE AS NEEDED
- 
-    Max_Linker_Alignment  : constant := Standard'Maximum_Alignment;
-    --                                  ^ --- MODIFY HERE AS NEEDED
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following string constants must be the external names resulting
-    -- from the C compilation of CXB30040.C, CXB30060.C, CXB30130.C, and
-    -- CXB30131.C.  The strings will be used as arguments to pragma Import.
- 
-    CXB30040_External_Name : constant String := "CXB30040";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB30060_External_Name : constant String := "CXB30060";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB30130_External_Name : constant String := "CXB30130";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB30131_External_Name : constant String := "CXB30131";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following string constants must be the external names resulting
-    -- from the COBOL compilation of CXB40090.CBL, CXB40091.CBL, and
-    -- CXB40092.CBL.  The strings will be used as arguments to pragma Import.
- 
-    CXB40090_External_Name : constant String := "CXB40090";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB40091_External_Name : constant String := "CXB40091";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB40092_External_Name : constant String := "CXB40092";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following string constants must be the external names resulting
-    -- from the Fortran compilation of CXB50040.FTN, CXB50041.FTN,
-    -- CXB50050.FTN, and CXB50051.FTN.
-    --
-    -- The strings will be used as arguments to pragma Import.
-    --
-    -- Note that the use of these four string constants will be split between
-    -- two tests, CXB5004 and CXB5005.
- 
-    CXB50040_External_Name : constant String := "CXB50040";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB50041_External_Name : constant String := "CXB50041";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB50050_External_Name : constant String := "CXB50050";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
-    CXB50051_External_Name : constant String := "CXB50051";
-    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following constants have been defined for use with the
-    -- representation clause in FXACA00 of type Sales_Record_Type.
-    --
-    -- Char_Bits should be an integer at least as large as the number
-    -- of bits needed to hold a character in an array.
-    -- A value of 6 * Char_Bits will be used in a representation clause
-    -- to reserve space for a six character string.
-    --
-    -- Next_Storage_Slot should indicate the next storage unit in the record
-    -- representation clause that does not overlap the storage designated for
-    -- the six character string.
- 
-    Char_Bits         : constant := 8;
-    --     MODIFY HERE AS NEEDED ---^
- 
-    Next_Storage_Slot : constant := 6;
-    --     MODIFY HERE AS NEEDED ---^
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following string constant must be the path name for the .AW
-    -- files that will be processed by the Wide Character processor to
-    -- create the C250001 and C250002 tests.  The Wide Character processor
-    -- will expect to find the files to process at this location.
- 
-    Test_Path_Root : constant String :=
-      "ACATS4GNATDIR/tests/c2/";
-    -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ --- MODIFY HERE AS NEEDED
- 
-    -- The following two strings must not be modified unless the .AW file
-    -- names have been changed.  The Wide Character processor will use
-    -- these strings to find the .AW files used in creating the C250001
-    -- and C250002 tests.
- 
-   Wide_Character_Test : constant String := Test_Path_Root & "c250001";
-   Upper_Latin_Test    : constant String := Test_Path_Root & "c250002";
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following instance of Integer_IO or Modular_IO must be supplied
-    -- in order for test CD72A02 to compile correctly.
-    -- Depending on the choice of base type used for the type
-    -- System.Storage_Elements.Integer_Address; one of the two instances will
-    -- be correct.  Comment out the incorrect instance.
- 
-    -- package Address_Value_IO is
-    --     new Ada.Text_IO.Integer_IO(System.Storage_Elements.Integer_Address);
- 
-    package Address_Value_IO is
-         new Ada.Text_IO.Modular_IO(System.Storage_Elements.Integer_Address);
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The following constants have been defined for use with various delay
-    -- statements in the GCC testsuite so that they do not take too long.
- 
-    One_Second : constant Duration := 0.001;
-    One_Long_Second : constant Duration := 0.1;
- 
- end ImpDef;
- 
- 
-      --==================================================================--
- 
- 
- package body ImpDef is
- 
-    -- NOTE: These are example bodies.  It is expected that implementors
-    --       will write their own versions of these routines.
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The time required to execute this procedure must be greater than the
-    -- time slice unit on implementations which use time slicing.  For
-    -- implementations which do not use time slicing the body can be null.
- 
-    Procedure Exceed_Time_Slice is
-       T : Integer := 0;
-       Loop_Max : constant Integer := 4_000;
-    begin
-       for I in 1..Loop_Max loop
-          T := Report.Ident_Int (1) * Report.Ident_Int (2);
-       end loop;
-    end Exceed_Time_Slice;
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
- end ImpDef;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefd.a gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefd.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefd.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefd.a	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- IMPDEFD.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- DESCRIPTION:
- --     This package provides tailorable entities for a particular
- --     implementation.  Each entity may be modified to suit the needs
- --     of the implementation.  Default values are provided to act as
- --     a guide.
- --
- --     The entities in this package are those which are used exclusively
- --     in tests for Annex D (Real-Time Systems).
- -- 
- -- APPLICABILITY CRITERIA:
- --     This package is only required for implementations validating the
- --     Real-Time Systems Annex.
- -- 
- -- CHANGE HISTORY:
- --     29 Jan 96   SAIC    Initial version for ACVC 2.1.
- --     27 Aug 98   EDS     Removed Processor_Type value Time_Slice
- --!
-  
- package ImpDef.Annex_D is
-  
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This constant is the maximum storage size that can be specified
-    -- for a task.  A single task that has this size must be able to
-    -- run.  Ideally, this value is large enough that two tasks of this
-    -- size cannot run at the same time.  If the value is too small then
-    -- test CXDC001 may take longer to run.  See the test for further
-    -- information.
- 
-    Maximum_Task_Storage_Size : constant := 16_000_000;
-    --                                      ^^^^^^^^^^ --- MODIFY HERE AS NEEDED
-    
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- Indicates the type of processor on which the tests are running.
- 
-    type Processor_Type is (Uni_Processor, Multi_Processor);
- 
-    Processor : constant Processor_Type := Uni_Processor;
-    --                                     ^^^^^^^^^^^ --- MODIFY HERE AS NEEDED
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
- end ImpDef.Annex_D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefe.a gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefe.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefe.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefe.a	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- IMPDEFE.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- DESCRIPTION:
- --     This package provides tailorable entities for a particular
- --     implementation.  Each entity may be modified to suit the needs
- --     of the implementation.  Default values are provided to act as
- --     a guide.
- --
- --     The entities in this package are those which are used exclusively
- --     in tests for Annex E (Distributed Systems).
- -- 
- -- APPLICABILITY CRITERIA:
- --     This package is only required for implementations validating the
- --     Distributed Systems Annex.
- -- 
- -- CHANGE HISTORY:
- --     29 Jan 96   SAIC    Initial version for ACVC 2.1.
- --
- --!
-  
- package ImpDef.Annex_E is
-  
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- The Max_RPC_Call_Time value is the longest time a test needs to wait for
-    -- an RPC to complete.  Included in this time is the time for the called
-    -- procedure to make a task entry call where the task is ready to accept
-    -- the call.
- 
-    Max_RPC_Call_Time : constant Duration := 2.0;
-    --                                       ^^^  --- MODIFY HERE AS NEEDED
-  
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
- end ImpDef.Annex_E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefg.a gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefg.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefg.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefg.a	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- IMPDEFG.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- DESCRIPTION:
- --     This package provides tailorable entities for a particular
- --     implementation.  Each entity may be modified to suit the needs
- --     of the implementation.  Default values are provided to act as
- --     a guide.
- --
- --     The entities in this package are those which are used exclusively
- --     in tests for Annex G (Numerics).
- -- 
- -- APPLICABILITY CRITERIA:
- --     This package is only required for implementations validating the
- --     Numerics Annex.
- -- 
- -- CHANGE HISTORY:
- --     29 Jan 96   SAIC    Initial version for ACVC 2.1.
- --
- --!
-  
- package ImpDef.Annex_G is
-  
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This function must return a "negative zero" value for implementations
-    -- for which Float'Signed_Zeros is True.
- 
-    function Negative_Zero return Float;
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
- end ImpDef.Annex_G;
- 
- 
-      --==================================================================--
- 
-  
- package body ImpDef.Annex_G is
- 
-    -- NOTE: These are example bodies.  It is expected that implementors
-    --       will write their own versions of these routines.
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
-    -- This function must return a negative zero value for implementations
-    -- for which Float'Signed_Zeros is True.
-    --
-    -- The default body simply returns a negated literal 0.0.  If the
-    -- default body does not return the value corresponding to a negatively
-    -- signed zero for the implementation under test, it must be replaced
-    -- by one which does.  See RM A.5.3(13).
- 
-    function Negative_Zero return Float is
-    begin
-       return -0.0;      -- Note: If this value is not negative zero for the
-                         --       implementation, use of this "default" value
-                         --       could result in false failures in
-                         --       implementations where Float'Signed_Zeros
-                         --       is True.
- 
-    -- ^^^^^^^^^^^^^^^^^^^^  MODIFY THIS BODY AS NEEDED  ^^^^^^^^^^^^^^^^^^^^
- 
-    end Negative_Zero;
- 
- --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
- 
- end ImpDef.Annex_G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefh.a gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefh.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/impdefh.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/impdefh.a	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- IMPDEFH.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- DESCRIPTION:
- --      This package is used to define those values that are implementation
- --      defined for use with validating the Safety and Security special needs
- --      annex, Annex-H.
- --
- -- APPLICABILITY CRITERIA:
- --     This package is only required for implementations validating the
- --     Safety and Security Annex.
- --
- -- CHANGE HISTORY:
- --      13 FEB 96   SAIC    Initial version
- --      25 NOV 96   SAIC    Revised for release 2.1
- --
- --!
- 
- package Impdef.Annex_H is
- 
-   type Scalar_To_Normalize is
-        (   Id0,  Id1,  Id2,  Id3,  Id4,  Id5,  Id6,  Id7,  Id8,  Id9,
-           Id10, Id11, Id12, Id13, Id14, Id15, Id16, Id17, Id18, Id19,
-           Id20, Id21, Id22, Id23, Id24, Id25, Id26, Id27, Id28, Id29,
-           Id30, Id31, Id32, Id33, Id34, Id35, Id36, Id37, Id38, Id39,
-           Id40, Id41, Id42, Id43, Id44, Id45, Id46, Id47, Id48, Id49,
-           Id50, Id51, Id52, Id53, Id54, Id55, Id56, Id57, Id58, Id59,
-           Id60, Id61, Id62, Id63, Id64, Id65, Id66, Id67, Id68, Id69,
-           Id70, Id71, Id72, Id73, Id74, Id75, Id76, Id77, Id78, Id79,
-           Id80, Id81, Id82, Id83, Id84, Id85, Id86, Id87, Id88, Id89,
-           Id90, Id91, Id92, Id93, Id94, Id95, Id96, Id97, Id98, Id99,
-           IdA0, IdA1, IdA2, IdA3, IdA4, IdA5, IdA6, IdA7, IdA8, IdA9,
-           IdB0, IdB1, IdB2, IdB3, IdB4, IdB5, IdB6 );
- 
-   -- NO MODIFICATION NEEDED TO TYPE SCALAR_TO_NORMALIZE.  DO NOT MODIFY.
- 
-   type Small_Number is range 1..100;
- 
-   -- NO MODIFICATION NEEDED TO TYPE SMALL_NUMBER.  DO NOT MODIFY.
- 
- --=====================================================================
-   -- When the value documented in H.1(5) as the predictable initial value
-   -- for an uninitialized object of the type Scalar_To_Normalize
-   -- (an enumeration type containing 127 identifiers) is to be in the range
-   -- Id0..IdB6, set the following constant to True; otherwise leave it set
-   -- to False.
- 
-   Default_For_Scalar_To_Normalize_Is_In_Range : constant Boolean := False;
-   --                                      MODIFY HERE AS NEEDED --- ^^^^^
- 
- --=====================================================================
-   -- If the above constant Default_For_Scalar_To_Normalize_Is_In_Range is
-   -- set True, the following constant must be set to the value documented
-   -- in H.1(5) as the predictable initial value for the type
-   -- Scalar_To_Normalize.
- 
-   Default_For_Scalar_To_Normalize : constant Scalar_To_Normalize := Id0;
-   --                                      MODIFY HERE AS NEEDED --- ^^^
- 
- --=====================================================================
-   -- When the value documented in H.1(5) as the predictable initial value
-   -- for an uninitialized object of the type Small_Number
-   -- (an integer type containing 100 values) is to be in the range
-   -- 1..100, set the following constant to True; otherwise leave it set
-   -- to False.
- 
-   Default_For_Small_Number_Is_In_Range : constant Boolean := False;
-   --                               MODIFY HERE AS NEEDED --- ^^^^^
- 
- --=====================================================================
-   -- If the above constant Default_For_Small_Number_Is_In_Range is
-   -- set True, the following constant must be set to the value documented
-   -- in H.1(5) as the predictable initial value for the type Small_Number.
- 
-   Default_For_Small_Number : constant Small_Number := 100;
-   --                        MODIFY HERE AS NEEDED --- ^^^
- 
- --=====================================================================
- 
- end Impdef.Annex_H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/lencheck.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/lencheck.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/lencheck.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/lencheck.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE 
- -- ACVC CHAPTER 13 C TESTS. IT IS INSTANTIATED FOR A TYPE WHOSE 
- -- REPRESENTATION IS TO BE CHECKED, AND THEN THE PROCEDURE REP_CHECK 
- -- IS CALLED WITH TWO ARGUMENTS, THE FIRST IS A VALUE OF THE TYPE TO 
- -- BE CHECKED, AND THE SECOND IS A STRING DESCRIBING OR NAMING THE 
- -- TYPE (FOR USE IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS)
- 
- -- THE CHECK IS TO CONVERT THE VALUE TO A PACKED BOOLEAN ARRAY WITH A 
- -- LENGTH CORRESPONDING TO THE 'SIZE OF THE TYPE, AND THEN CONVERT IT 
- -- BACK AGAIN AND CHECK THAT THE SAME VALUE IS OBTAINED. THE 
- -- CONVERSIONS ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF 
- -- UNCHECKED_CONVERSION.
- 
- -- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE 
- --                             AUTHORIZED
- -- DHH 03/27/89 CHANGED REP_CHECK TO LENGTH_CHECK BY ADDING A THIRD
- --              PARAMETER TO GIVE LENGTH EXPECTED AND BY DOING A BIT TO
- --              BIT COPY OF THE UNCHECKED CONVERSION BOOLEAN ARRAY SO 
- --              A STRAIGHT COMPARE OF THE TWO VALUES CAN BE DONE.
- 
- GENERIC
- 
-    TYPE TEST_TYPE IS PRIVATE;
- 
- PROCEDURE LENGTH_CHECK (TEST_VALUE      : TEST_TYPE; 
-                         EXPECTED_LENGTH : INTEGER;
-                         TYPE_ID         : STRING);
- 
- WITH UNCHECKED_CONVERSION;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE LENGTH_CHECK (TEST_VALUE      : TEST_TYPE; 
-                         EXPECTED_LENGTH : INTEGER;
-                         TYPE_ID         : STRING) IS
-    LEN : CONSTANT INTEGER := EXPECTED_LENGTH;
-    TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. LEN) OF BOOLEAN;
-    PRAGMA PACK (BIT_ARRAY_TYPE);
-    TYPE NEW_BIT_ARRAY_TYPE IS ARRAY (1 .. 3) OF BIT_ARRAY_TYPE;
- 
-    FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (TEST_TYPE,
-                                                  BIT_ARRAY_TYPE);
-    FUNCTION FROM_BITS IS NEW UNCHECKED_CONVERSION (BIT_ARRAY_TYPE,
-                                                    TEST_TYPE);
- 
-    BIT_ARRAY : BIT_ARRAY_TYPE := (OTHERS => FALSE);
- 
-    BIT_ARRAY_NEW : NEW_BIT_ARRAY_TYPE := (OTHERS => (OTHERS => FALSE));
- BEGIN
- 
-    BIT_ARRAY := TO_BITS (TEST_VALUE);
- 
-    FOR I IN 1 .. LEN LOOP
-         BIT_ARRAY_NEW(IDENT_INT(1)) (IDENT_INT(I)) := BIT_ARRAY(I);
-    END LOOP;
- 
-    IF TEST_VALUE /= FROM_BITS (BIT_ARRAY_NEW(1)) THEN
-       FAILED ("CHECK ON REPRESENTATION FOR " & TYPE_ID & " FAILED.");
-    END IF;
- 
- END LENGTH_CHECK;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/macro.dfs gcc-16-20250525/gcc/testsuite/ada/acats/support/macro.dfs
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/macro.dfs	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/macro.dfs	Thu Jan  1 00:00:00 1970
***************
*** 1,300 ****
- -- MACRO.DFS
- -- THIS FILE CONTAINS THE MACRO DEFINITIONS USED IN THE ACVC TESTS.
- -- THESE DEFINITIONS ARE USED BY THE ACVC TEST PRE-PROCESSOR,
- -- MACROSUB. MACROSUB WILL CALCULATE VALUES FOR THOSE MACRO SYMBOLS 
- -- WHOSE DEFINITIONS DEPEND ON THE VALUE OF MAX_IN_LEN (NAMELY, THE
- -- VALUES OF THE MACRO SYMBOLS BIG_ID1, BIG_ID2, BIG_ID3, BIG_ID4,
- -- BIG_STRING1, BIG_STRING2, MAX_STRING_LITERAL, BIG_INT_LIT, BIG_REAL_LIT, 
- -- AND BLANKS).  THEREFORE, ANY VALUES GIVEN IN THIS FILE FOR THOSE
- -- MACRO SYMBOLS WILL BE IGNORED BY MACROSUB.  
- 
- -- NOTE: AS REQUIRED BY THE MACROSUB PROGRAM, THE FIRST MACRO DEFINED
- -- IN THIS FILE IS $MAX_IN_LEN.  THE NEXT 5 MACRO DEFINITIONS
- -- ARE FOR THOSE MACRO SYMBOLS THAT DEPEND ON THE VALUE OF
- -- MAX_IN_LEN.  THESE ARE IN ALPHABETIC ORDER.  FOLLOWING THESE
- -- ARE 36 MORE DEFINITIONS, ALSO IN ALPHABETIC ORDER.
- 
- -- EACH DEFINITION IS ACCORDING TO THE FOLLOWING FORMAT:
- 
- -- A. A NUMBER OF LINES PRECEDED BY THE ADA COMMENT DELIMITER, --.
- --    THE FIRST OF THESE LINES CONTAINS THE MACRO SYMBOL AS IT APPEARS
- --    IN THE TEST FILES (WITH THE DOLLAR SIGN).  THE NEXT FEW "COMMENT"
- --    LINES CONTAIN A DESCRIPTION OF THE VALUE TO BE SUBSTITUTED.
- --    THE REMAINING "COMMENT" LINES, THE FIRST OF WHICH BEGINS WITH THE
- --    WORDS "USED IN:  " (NO QUOTES), CONTAIN A LIST OF THE TEST FILES
- --    (WITHOUT THE .TST EXTENSION) IN WHICH THE MACRO SYMBOL APPEARS.
- --    EACH TEST FILE NAME IS PRECEDED BY ONE OR MORE BLANKS.
- -- B. A LINE, WITHOUT THE COMMENT DELIMITER, CONSISTING OF THE 
- --    IDENTIFIER (WITHOUT THE DOLLAR SIGN) OF THE MACRO SYMBOL,
- --    FOLLOWED BY A SPACE OR TAB, FOLLOWED BY THE VALUE TO BE
- --    SUBSTITUTED.  IN THE DISTRIBUTION FILE, A SAMPLE VALUE IS
- --    PROVIDED; THIS VALUE MUST BE REPLACED BY A VALUE APPROPRIATE TO
- --    THE IMPLEMENTATION.
- 
- -- DEFINITIONS ARE SEPARATED BY ONE OR MORE EMPTY LINES.
- -- THE LIST OF DEFINITIONS BEGINS AFTER THE FOLLOWING EMPTY LINE.
- 
- -- $MAX_IN_LEN                                                          
- -- AN INTEGER LITERAL GIVING THE MAXIMUM LENGTH PERMITTED BY THE   
- -- COMPILER FOR A LINE OF ADA SOURCE CODE (NOT INCLUDING AN END-OF-LINE
- -- CHARACTER).                                             
- -- USED IN:  A26007A                          
- MAX_IN_LEN                200            
- 					
- -- $MAX_STRING_LITERAL
- -- A STRING LITERAL CONSISTING OF $MAX_IN_LEN CHARACTERS (INCLUDING THE
- -- QUOTE CHARACTERS).
- -- USED IN:  A26007A
- MAX_STRING_LITERAL	"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
- 
- -- $BIG_ID1                                      
- -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN. 
- -- THE MACROSUB PROGRAM WILL SUPPLY AN IDENTIFIER IN WHICH THE   
- -- LAST CHARACTER IS '1' AND ALL OTHERS ARE 'A'.       
- -- USED IN:  C23003A  C23003B  C23003G  C23003I
- --           C35502D  C35502F
- BIG_ID1  AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA1
- 						
- -- $BIG_ID2                                        
- -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
- -- DIFFERING FROM $BIG_ID1 ONLY IN THE LAST CHARACTER.  THE MACROSUB
- -- PROGRAM WILL USE '2' AS THE LAST CHARACTER.         
- -- USED IN:  C23003A  C23003B  B23003F  C23003G  C23003I   
- BIG_ID2  AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2
- 
- -- $BIG_ID3                                                
- -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN.
- -- MACROSUB WILL USE '3' AS THE "MIDDLE" CHARACTER; ALL OTHERS ARE 'A'.
- -- USED IN:  C23003A  C23003B  C23003G  C23003I
- BIG_ID3  AAAAAAAAAAAAAAAAAAAAAAAAAAAAA3AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- 
- -- $BIG_ID4                                            
- -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
- -- DIFFERING FROM $BIG_ID3 ONLY IN THE MIDDLE CHARACTER.  MACROSUB
- -- WILL USE '4' AS THE MIDDLE CHARACTER.                      
- -- USED IN:  C23003A  C23003B  C23003G  C23003I
- BIG_ID4  AAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- 							
- -- $BIG_STRING1                                                
- -- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING2
- -- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
- -- USED IN:  C35502D  C35502F              
- BIG_STRING1  "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"            
- 							
- -- $BIG_STRING2                                            
- -- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING1
- -- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
- -- USED IN:  C35502D  C35502F                              
- BIG_STRING2  "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA1"                
- 
- -- $BLANKS                                                   
- -- A SEQUENCE OF ($MAX_IN_LEN - 20) BLANKS.            
- -- USED IN:  B22001A  B22001B  B22001C  B22001D  B22001E  B22001F
- --           B22001G  B22001I  B22001J  B22001K  B22001L  B22001M 
- --           B22001N                                             
- --      <       LIMITS OF SAMPLE SHOWN BY ANGLE BRACKETS           >
- BLANKS                                                      
- 								
- -- $ACC_SIZE                                                
- -- AN INTEGER LITERAL WHOSE VALUE IS THE MINIMUM NUMBER OF BITS
- -- SUFFICIENT TO HOLD ANY VALUE OF AN ACCESS TYPE.         
- -- USED IN:  CD2A83C  BD2A02A
- ACC_SIZE                  ACATS4GNATBIT
- 			
- -- $ALIGNMENT                                    
- -- A VALUE THAT IS LEGITIMATE FOR USE IN A RECORD ALIGNMENT CLAUSE.
- -- USED IN:  CD4041A BD4006A                                 
- ALIGNMENT 4                                 
- 
- -- $COUNT_LAST                                     
- -- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.COUNT'LAST. 
- -- USED IN:  CE3002B                                
- COUNT_LAST                2147483647                  
- 			
- -- $ENTRY_ADDRESS                                     
- -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY 
- -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.   
- -- USED IN:  SPPRT13SP                                
- ENTRY_ADDRESS  ENTRY_ADDR                      
- 
- -- $ENTRY_ADDRESS1                            
- -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
- -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.  THE ADDRESS
- -- MUST BE DISTINCT FROM THAT USED IN $ENTRY_ADDRESS.       
- -- USED IN:  SPPRT13SP                                   
- ENTRY_ADDRESS1  ENTRY_ADDR1                   
- 			
- -- $ENTRY_ADDRESS2                      
- -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY 
- -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.  THE ADDRESS
- -- MUST BE DISTINCT FROM THOSE USED IN $ENTRY_ADDRESS      
- -- AND $ENTRY_ADDRESS1.                         
- -- USED IN:  SPPRT13SP                  
- ENTRY_ADDRESS2  ENTRY_ADDR2            
- 			
- -- $FIELD_LAST                            
- -- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.FIELD'LAST. 
- -- USED IN:  CE3002C                            
- FIELD_LAST                255               
- 					
- -- $FORM_STRING                           
- -- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE MEETS BOTH
- -- CONDITIONS: (1) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
- -- AN APPROPRIATE LINE-LENGTH FOR THE FILE, (2) THERE IS A VALUE 
- -- OF TYPE TEXT_IO.COUNT THAT IS NOT AN APPROPRIATE PAGE-LENGTH 
- -- FOR THE FILE.                   
- -- IF IT IS NOT POSSIBLE TO SATISFY BOTH CONDITIONS, THEN SUBSTITUTE
- -- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE SATISFIES ONE
- -- OF THE CONDITIONS.  IF IT IS NOT POSSIBLE TO SATISFY EITHER CONDITION,
- -- THEN SUBSTITUTE THE NULL STRING ("").     
- -- USED IN:  CE3304A                 
- FORM_STRING               ""           
- 							
- -- $FORM_STRING2                              
- -- A STRING LITERAL SPECIFYING THAT THE CAPACITY OF THE FILE IS
- -- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION 
- -- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL 
- -- "CANNOT_RESTRICT_FILE_CAPACITY".                          
- -- USED IN:  CE2203A  CE2403A                 
- FORM_STRING2              "CANNOT_RESTRICT_FILE_CAPACITY" 
- 					
- -- $GREATER_THAN_DURATION              
- -- A REAL LITERAL WHOSE VALUE (NOT SUBJECT TO ROUND-OFF ERROR 
- -- IF POSSIBLE) LIES BETWEEN DURATION'BASE'LAST AND DURATION'LAST.  IF
- -- NO SUCH VALUES EXIST, USE A VALUE IN DURATION'RANGE.  
- -- USED IN:  C96005B                                 
- GREATER_THAN_DURATION     86_000.0         
- 	
- 							
- 						
- 
- -- $ILLEGAL_EXTERNAL_FILE_NAME1             
- -- AN ILLEGAL EXTERNAL FILE NAME (E.G., TOO LONG, CONTAINING INVALID
- -- CHARACTERS, CONTAINING WILD-CARD CHARACTERS, OR SPECIFYING A 
- -- NONEXISTENT DIRECTORY).                             
- -- USED IN:  CE2102C  CE2102H  CE2103A  CE2103B  CE3102B  CE3107A
- ILLEGAL_EXTERNAL_FILE_NAME1       /NODIRECTORY/FILENAME
- 	
- -- $ILLEGAL_EXTERNAL_FILE_NAME2                  
- -- AN ILLEGAL EXTERNAL FILE NAME, DIFFERENT FROM $ILLEGAL_EXTERNAL_FILE_NAME1.
- -- USED IN:  CE2102C  CE2102H  CE2103A  CE2103B  CE3102B    
- ILLEGAL_EXTERNAL_FILE_NAME2       /@@/@@/@@\@@\@@\@@
- 							
- -- $INAPPROPRIATE_LINE_LENGTH                      
- -- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH 
- -- FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
- -- USED IN:  CE3304A                                 
- INAPPROPRIATE_LINE_LENGTH -1                     
- 							
- -- $INAPPROPRIATE_PAGE_LENGTH                    
- -- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH
- -- FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
- -- USED IN:  CE3304A                              
- INAPPROPRIATE_PAGE_LENGTH -1              
- 
- -- $INTEGER_FIRST                            
- -- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS INTEGER'FIRST.
- -- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
- -- BLANKS.                        
- -- USED IN:  C35503F  B54B01B                  
- INTEGER_FIRST             -2147483648      
- 			
- -- $INTEGER_LAST                             
- -- AN INTEGER LITERAL WHOSE VALUE IS INTEGER'LAST.  THE LITERAL MUST
- -- NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING BLANKS. 
- -- USED IN:  C35503F  B54B01B         
- INTEGER_LAST              2147483647                 
- 
- 
- -- $LESS_THAN_DURATION                
- -- A REAL LITERAL (WITH SIGN) WHOSE VALUE (NOT SUBJECT TO
- -- ROUND-OFF ERROR IF POSSIBLE) LIES BETWEEN DURATION'BASE'FIRST AND
- -- DURATION'FIRST.  IF NO SUCH VALUES EXIST, USE A VALUE IN
- -- DURATION'RANGE.                                 
- -- USED IN:  C96005B                           
- LESS_THAN_DURATION        -86_400.0      
- 
- 	
- -- $MACHINE_CODE_STATEMENT       
- -- A VALID MACHINE CODE STATEMENT AS SPECIFIED IN THE PACKAGE 
- -- MACHINE_CODE.  IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE
- -- CODE THEN USE THE ADA NULL STATEMENT (I.E. NULL; ).   
- -- USED IN:  AD8011A  BD8001A  BD8002A  BD8004A  BD8004B
- MACHINE_CODE_STATEMENT     Asm_Insn'(Asm ("ACATS4GNATINSN"));       
- 						
- -- $MAX_INT                                     
- -- AN INTEGER LITERAL WHOSE VALUE IS SYSTEM.MAX_INT.
- -- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
- -- BLANKS.                                                      
- -- USED IN:  C35503D  C35503F  C4A007A 
- MAX_INT                  ACATS4GNATMAXINT
- 
- 					
- -- $MIN_INT                                     
- -- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS SYSTEM.MIN_INT.
- -- THE LITERAL MUST NOT CONTAIN UNDERSCORES OR LEADING OR TRAILING
- -- BLANKS.                                                    
- -- USED IN:  C35503D  C35503F  
- MIN_INT                  ACATS4GNATMININT
- 						
- -- $NAME                                               
- -- THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN INTEGER,
- -- SHORT_INTEGER, OR LONG_INTEGER.                          
- -- (IMPLEMENTATIONS WHICH HAVE NO SUCH TYPES SHOULD USE AN UNDEFINED
- -- IDENTIFIER SUCH AS   NO_SUCH_TYPE_AVAILABLE.)                  
- -- USED IN:  C45231D  CD7101G  
- NAME  LONG_LONG_INTEGER                                 
- 							
- -- $OPTIONAL_DISC                                       
- -- A DISCRIMINANT USED AS THE DISCRIMINANT PART OF $RECORD_NAME.
- -- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED THEN SUBSTITUTE
- -- NO_SUCH_MACHINE_CODE_DISC.                            
- -- USED IN:  BD8002A
- OPTIONAL_DISC             
- 							
- -- $RECORD_DEFINITION                                   
- -- THE RECORD TYPE DEFINITION (WITH FINAL SEMICOLON) FOR THE TYPE THAT
- -- WAS USED IN THE MACRO $RECORD_NAME, AS DECLARED IN PACKAGE    
- -- MACHINE_CODE.  IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE,
- -- THEN USE A NULL RECORD DEFINITION                             
- -- USED IN:  BD8002A                                   
- RECORD_DEFINITION         RECORD  ASM : STRING (1..4); END RECORD;
- 							
- -- $RECORD_NAME
- -- A VALID RECORD TYPE NAME THAT IS DEFINED IN PACKAGE MACHINE_CODE.
- -- IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE THEN 
- -- USE THE NAME "NO_SUCH_MACHINE_CODE_TYPE"
- -- USED IN:  BD8002A
- RECORD_NAME	Asm_Insn
- 
- -- $TASK_SIZE                                       
- -- AN INTEGER LITERAL WHOSE VALUE IS THE NUMBER OF BITS REQUIRED TO
- -- HOLD A TASK OBJECT.                                       
- -- USED IN:  CD2A91C 
- TASK_SIZE                 ACATS4GNATBIT
- 							
- -- $TASK_STORAGE_SIZE                                 
- -- THE NUMBER OF STORAGE UNITS REQUIRED FOR A TASK ACTIVATION.
- -- USED IN:  BD2C01D  BD2C02A  BD2C03A  C87B62D  CD1009K  CD1009T  
- --           CD1009U  CD1C03E  CD1C06A  CD2C11A  CC1225A  CD2C11D
- TASK_STORAGE_SIZE 32768                                         
- 							
- -- $VARIABLE_ADDRESS                              
- -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
- -- IMPLEMENTATION.                                           
- -- USED IN:  SPPRT13SP                                 
- VARIABLE_ADDRESS  VAR_ADDR
- 							
- -- $VARIABLE_ADDRESS1                                   
- -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
- -- IMPLEMENTATION.  THE ADDRESS MUST BE DISTINCT FROM THAT USED IN
- -- THE MACRO $VARIABLE_ADDRESS.                              
- -- USED IN:  SPPRT13SP                                       
- VARIABLE_ADDRESS1  VAR_ADDR1
- 							
- -- $VARIABLE_ADDRESS2                    
- -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
- -- IMPLEMENTATION.  THE ADDRESS MUST BE DISTINCT FROM THOSE USED IN
- -- THE MACROS $VARIABLE_ADDRESS AND $VARIABLE_ADDRESS1.          
- -- USED IN:  SPPRT13SP                                    
- VARIABLE_ADDRESS2  VAR_ADDR2
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/macrodef.adb gcc-16-20250525/gcc/testsuite/ada/acats/support/macrodef.adb
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/macrodef.adb	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/macrodef.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,11 ****
- with Ada.Text_IO;
- with System;
- procedure Macrodef is
- begin
-    Ada.Text_IO.Put_Line ("Integer'First = " & Integer'Image (Integer'First));
-    Ada.Text_IO.Put_Line ("Integer'Last = " & Integer'Image (Integer'Last));
-    Ada.Text_IO.Put_Line ("System.Min_Int = " & Long_Long_Integer'Image (System.Min_Int));
-    Ada.Text_IO.Put_Line ("System.Max_Int = " & Long_Long_Integer'Image (System.Max_Int));
-    Ada.Text_IO.Put_Line ("Ada.Text_IO.Count'Last = " & Ada.Text_IO.Count'Image (Ada.Text_IO.Count'Last));
-    Ada.Text_IO.Put_Line ("Ada.Text_IO.Field'Last = " & Ada.Text_IO.Field'Image (Ada.Text_IO.Field'Last));
- end Macrodef;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/macrosub.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/macrosub.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/macrosub.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/macrosub.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,548 ****
- -- MACROSUB.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -----------------------------------------------------------------------
- --                                                                   --
- --   THIS PROGRAM IS CALLED MACROSUB.  IT IS USED TO REPLACE THE     --
- --   MACROS IN THE ACVC TEST SUITE WITH THEIR PROPER VALUES.  THE    --
- --   STEPS LISTED BELOW SHOULD BE FOLLOWED TO ENSURE PROPER RUNNING  --
- --   OF THE MACROSUB PROGRAM:                                        --
- --                                                                   --
- --           1) Edit the file MACRO.DFS (included with the testtape) --
- --              and insert your macro values.  The macros which use  --
- --              the value of MAX_IN_LEN are calculated automatically --
- --              and do not need to be entered.                       --
- --                                                                   --
- --           2) Create a file called TSTTESTS.DAT which includes all --
- --              of the .TST test file names and their directory      --
- --              specifications, if necessary.  If a different name   --
- --              other than TSTTESTS.DAT is used, this name must be   --
- --              substituted in the MACROSUB.ADA file.                --
- --                                                                   --
- --           3) Compile and link MACROSUB.                           --
- --                                                                   --
- --           4) Run the MACROSUB program.                            --
- --                                                                   --
- --   WHEN THE PROGRAM FINISHES RUNNING, THE MACROS WILL HAVE BEEN    --
- --   REPLACED WITH THE APPROPRIATE VALUES FROM MACRO.DFS.            --
- --                                                                   --
- --                                                                   --
- --                                                                   --
- -- HISTORY:                                                          --
- --     BCB 04/17/90  CHANGED MODE OF CALC_MAX_VALS TO OUT.  CHANGED  --
- --                   VALUE OF MAX_VAL_LENGTH FROM 512 TO 400.  ADDED --
- --                   EXCEPTION HANDLER SO PROGRAM DOES NOT CRASH IF  --
- --                   AN EXCEPTION IS RAISED.  ADDED MESSAGES TO      --
- --                   REPORT PROGRESS OF PROGRAM.  CHANGED PROGRAM SO --
- --                   IT DOES NOT ABORT IF A FILE CANNOT BE FOUND.    --
- --                   MODIFIED PROGRAM SO IT ACCEPTS FILENAMES WITH   --
- --                   VERSION NUMBERS.                                --
- -----------------------------------------------------------------------
- 
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PACKAGE DEFS IS
- 
- -----------------------------------------------------------------------
- --                                                                   --
- --   THIS PACKAGE IS USED BY MACROSUB.ADA, PARSEMAC.ADA, AND BY      --
- --   GETSUBS.ADA.  THE PACKAGE CONTAINS VARIABLE DECLARATIONS WHICH  --
- --   NEED TO BE KNOWN BY ALL OF THE PROCEDURES AND PACKAGES WHICH    --
- --   MAKE UP THE PROGRAM.                                            --
- --                                                                   --
- -----------------------------------------------------------------------
- 
-      MAX_VAL_LENGTH : CONSTANT INTEGER := 400;
- 
-      SUBTYPE VAL_STRING IS STRING (1..MAX_VAL_LENGTH);
- 
-      TYPE REC_TYPE IS RECORD
-           MACRO_NAME : STRING (1..80);
-           NAME_LENGTH, VALUE_LENGTH : INTEGER;
-           MACRO_VALUE : VAL_STRING;
-      END RECORD;
- 
-      TYPE TABLE_TYPE IS ARRAY (1..100) OF REC_TYPE;
- 
-      SYMBOL_TABLE : TABLE_TYPE;
- 
-      NUM_MACROS : INTEGER;
- 
- END DEFS;
- 
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH DEFS;
- USE DEFS;
- 
- PACKAGE GETSUBS IS
- 
- ------------------------------------------------------------------------
- --                                                                    --
- --  THIS PACKAGE IS USED BY MACROSUB.ADA FOR READING FROM MACRO.DFS   --
- --  THE VALUES FOR THE MACRO SUBSTITUTIONS FOR A TEST TAPE.           --
- --                                                                    --
- ------------------------------------------------------------------------
- 
-      MAC_FILE, LINE_LEN : EXCEPTION;
- 
-      PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER;
-                              CALCULATED : OUT BOOLEAN);
- 
-      PROCEDURE FILL_TABLE;
- 
- END GETSUBS;
- 
- PACKAGE BODY GETSUBS IS
- 
- -----------------------------------------------------------------------
- --                                                                   --
- --    PROCEDURE CALC_MAX_VALS CALCULATES THE VALUE FOR THE MACRO     --
- --    READ FROM MACRO.DFS IF ITS LENGTH IS EQUAL OR NEARLY EQUAL TO  --
- --    MAX_IN_LEN.  IT THEN RETURNS A FLAG SET TO TRUE IF A VALUE WAS --
- --    CALCULATED, FALSE IF ONE WAS NOT.                              --
- --                                                                   --
- -----------------------------------------------------------------------
- 
-      PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER;
-                              CALCULATED : OUT BOOLEAN) IS
- 
-      BEGIN
- 
-           IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = "BIG_ID1"
-                THEN SYMBOL_TABLE (INDEX).MACRO_VALUE (1..MAX_IN_LEN) :=
-                (1..(MAX_IN_LEN-1) => 'A') & "1";
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BIG_ID2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..MAX_IN_LEN) := (1..(MAX_IN_LEN-1) => 'A') & "2";
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BIG_ID3" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "3" &
-                ((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A');
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BIG_ID4" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "4" &
-                ((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A');
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BIG_STRING1" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..(MAX_IN_LEN + 1)/2 + 2) :=
-                           '"' & (1..(MAX_IN_LEN + 1)/2 => 'A') & '"';
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BIG_STRING2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2) :=
-                '"' & (2..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 => 'A') &
-                '1' & '"';
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "MAX_STRING_LITERAL" THEN SYMBOL_TABLE (INDEX).
-                MACRO_VALUE (1..MAX_IN_LEN) := '"' &
-                (1..MAX_IN_LEN-2 => 'A') & '"';
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BIG_INT_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..MAX_IN_LEN)  := (1..MAX_IN_LEN-3 => '0') & "298";
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BIG_REAL_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..MAX_IN_LEN) := (1..MAX_IN_LEN-5 => '0') & "690.0";
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "MAX_LEN_INT_BASED_LITERAL" THEN
-                SYMBOL_TABLE (INDEX).
-                MACRO_VALUE (1..MAX_IN_LEN) := "2:" &
-                (1..MAX_IN_LEN - 5 => '0') & "11:";
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "MAX_LEN_REAL_BASED_LITERAL" THEN SYMBOL_TABLE (INDEX).
-                MACRO_VALUE (1..MAX_IN_LEN) := "16:" &
-                (1..MAX_IN_LEN - 7 => '0') & "F.E:";
-                CALCULATED := TRUE;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BLANKS" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
-                (1..MAX_IN_LEN-20) := (1..MAX_IN_LEN-20 => ' ');
-                CALCULATED := TRUE;
-           ELSE
-                CALCULATED := FALSE;
-           END IF;
-           IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                "BLANKS" THEN SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
-                MAX_IN_LEN - 20;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                 "BIG_STRING1" THEN
-                SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
-                            (MAX_IN_LEN + 1)/2 + 2;
-           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
-                 "BIG_STRING2" THEN
-                SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
-                       MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2;
-           ELSE SYMBOL_TABLE (INDEX).VALUE_LENGTH := MAX_IN_LEN;
-           END IF;
-      END CALC_MAX_VALS;
- 
- -----------------------------------------------------------------------
- --                                                                   --
- --    PROCEDURE FILL_TABLE READS THE MACRO NAMES AND MACRO VALUES IN --
- --    FROM MACRO.DFS AND STORES THEM IN THE SYMBOL TABLE.  PROCEDURE --
- --    CALC_MAX_VALS IS CALLED TO DETERMINE IF THE MACRO VALUE SHOULD --
- --    BE CALCULATED OR READ FROM MACRO.DFS.                          --
- --                                                                   --
- -----------------------------------------------------------------------
- 
-      PROCEDURE FILL_TABLE IS
- 
-           INFILE1 : FILE_TYPE;
-           MACRO_FILE : CONSTANT STRING := "MACRO.DFS";
-           A_LINE : VAL_STRING;
-           I, INDEX, LENGTH, HOLD, A_LENGTH, NAME : INTEGER;
-           MAX_IN_LEN : INTEGER := 1;
-           CALCULATED : BOOLEAN;
- 
-      BEGIN
-           INDEX := 1;
-           BEGIN
-                OPEN (INFILE1, IN_FILE, MACRO_FILE);
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     PUT_LINE ("** ERROR: MACRO FILE " & MACRO_FILE &
-                               " NOT FOUND.");
-                     RAISE MAC_FILE;
-           END;
-           WHILE NOT END_OF_FILE (INFILE1) LOOP
-                GET_LINE (INFILE1, A_LINE, A_LENGTH);
-                IF A_LENGTH > 0 AND A_LINE (1..2) /= "--" AND
-                   A_LINE (1) /= ' ' AND A_LINE (1) /= ASCII.HT THEN
-                     I := 1;
-                     WHILE I <= A_LENGTH AND THEN
-                            ((A_LINE (I) IN 'A'..'Z') OR
-                             (A_LINE (I) IN '0'..'9') OR
-                             A_LINE (I) = '_') LOOP
-                          I := I + 1;
-                     END LOOP;
-                     I := I - 1;
-                     LENGTH := I;
-                     BEGIN
-                          SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) :=
-                               A_LINE (1..I);
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               PUT_LINE ("** ERROR: LINE LENGTH IS " &
-                                         "GREATER THAN MAX_VAL_LENGTH.");
-                               RAISE LINE_LEN;
-                     END;
-                     SYMBOL_TABLE (INDEX).NAME_LENGTH := I;
-                     CALC_MAX_VALS (INDEX, LENGTH, MAX_IN_LEN,
-                                    CALCULATED);
-                     IF NOT CALCULATED THEN
-                          I := I + 1;
-                          WHILE A_LINE (I) = ' ' OR A_LINE (I) =
-                            ASCII.HT LOOP
-                               I := I + 1;
-                               IF SYMBOL_TABLE (INDEX).MACRO_NAME
-                                    (1..LENGTH) = "BLANKS" THEN
-                                    EXIT;
-                               END IF;
-                          END LOOP;
-                          HOLD := I;
- 
- -- MACRO VALUE BEGINS AT POSITION HOLD.
- -- NOW FIND WHERE IT ENDS BY STARTING AT THE END OF THE INPUT
- -- LINE AND SEARCHING BACKWARD FOR A NON-BLANK.
- 
-                          I := A_LENGTH;
-                          WHILE I > HOLD AND THEN (A_LINE (I) = ' '
-                             OR A_LINE(I) = ASCII.HT) LOOP
-                               I := I - 1;
-                          END LOOP;
-                          LENGTH := I - HOLD + 1;
-                          SYMBOL_TABLE (INDEX).MACRO_VALUE (1..LENGTH)
-                               := A_LINE (HOLD..I);
-                          SYMBOL_TABLE (INDEX).VALUE_LENGTH := LENGTH;
-                          NAME := SYMBOL_TABLE (INDEX).NAME_LENGTH;
-                          IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..NAME) =
-                               "MAX_IN_LEN" THEN MAX_IN_LEN :=
-                               INTEGER'VALUE (SYMBOL_TABLE (INDEX).
-                               MACRO_VALUE (1..LENGTH));
-                          END IF;
-                     END IF;
-                     INDEX := INDEX + 1;
-                END IF;
-           END LOOP;
-           NUM_MACROS := INDEX - 1;
-           CLOSE (INFILE1);
-      END FILL_TABLE;
- 
- BEGIN
-      NULL;
- END GETSUBS;
- 
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH DEFS;
- USE DEFS;
- 
- PACKAGE PARSEMAC IS
- 
- ------------------------------------------------------------------------
- --                                                                    --
- --   THIS PACKAGE IS USED BY MACROSUB.ADA FOR FINDING A MACRO TO      --
- --   SUBSTITUTE.  MACRO SUBSTITUTIONS ARE MADE IN *.TST TESTS IN THE  --
- --   ACVC TEST SUITE.  THIS PROCEDURE IS CURRENTLY SET UP FOR ACVC    --
- --   VERSION 1.10.                                                    --
- --                                                                    --
- ------------------------------------------------------------------------
- 
-      PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING;
-                                A_LENGTH : IN INTEGER;
-                                PTR : IN OUT INTEGER;
-                                MACRO : OUT STRING;
-                                MACRO_LEN : IN OUT INTEGER);
- 
- 
-      PROCEDURE WHICH_MACRO (MACRO : IN STRING;
-                             MACRO_LEN : IN INTEGER;
-                             TEMP_MACRO : OUT STRING;
-                             TEMP_MACRO_LEN : IN OUT INTEGER);
- 
- END PARSEMAC;
- 
- PACKAGE BODY PARSEMAC IS
- 
- -----------------------------------------------------------------------
- --    PROCEDURE LOOK_FOR_MACRO LOOKS FOR A DOLLAR SIGN WHICH SIGNALS --
- --    THE START OF A MACRO IN THE *.TST FILES.  IT THEN COUNTS       --
- --    CHARACTERS UNTIL A <LETTER>, <NUMBER>, OR <_> IS NOT FOUND.    --
- --    RETURN PARAMETERS SEND THE BEGINNING POINTER AND LENGTH OF THE --
- --    MACRO BACK TO THE MAIN PROGRAM.  ALSO RETURNED IS THE MACRO    --
- --    STRING.                                                        --
- -----------------------------------------------------------------------
- 
-      PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING;
-                                A_LENGTH : IN INTEGER;
-                                PTR : IN OUT INTEGER;
-                                MACRO : OUT STRING;
-                                MACRO_LEN : IN OUT INTEGER) IS
- 
-      II, J : INTEGER := INTEGER'LAST;
- 
-      BEGIN
-           FOR I IN PTR..A_LENGTH LOOP
-                IF A_LINE (I) = '$' THEN
-                     II := I+1;
-                     EXIT;
-                END IF;
-                II := I;
-           END LOOP;
-           IF II < A_LENGTH THEN    -- DOLLAR SIGN IS FOUND.
-                J := II;
-                WHILE J <= A_LENGTH AND THEN ((A_LINE(J) IN 'A'..'Z') OR
-                       (A_LINE(J) IN '0'..'9') OR
-                        A_LINE(J) = '_') LOOP
-                        J := J+1;
-                END LOOP;
-                J := J-1;
-                MACRO_LEN := (J-II+1);
-                MACRO (1..MACRO_LEN) := A_LINE (II .. J);
-                              -- DON'T INCLUDE THE DOLLAR SIGN
-                PTR := J+1;
-           ELSE
-                MACRO_LEN := 0;
-           END IF;
-      RETURN;
-      END LOOK_FOR_MACRO;
- 
- ------------------------------------------------------------------------
- --    PROCEDURE WHICH_MACRO COMPARES THE INPUT MACRO STRING TO A      --
- --    VALUE READ FROM MACRO.DFS AND STORED IN THE SYMBOL TABLE AND    --
- --    RETURNS THE MACRO SUBSTITUTION STRING BACK TO THE MAIN PROGRAM. --
- ------------------------------------------------------------------------
- 
-      PROCEDURE WHICH_MACRO (MACRO : IN STRING;
-                             MACRO_LEN : IN INTEGER;
-                             TEMP_MACRO : OUT STRING;
-                             TEMP_MACRO_LEN : IN OUT INTEGER) IS
- 
-      BEGIN
-           FOR INDEX IN 1 .. NUM_MACROS LOOP
-                IF MACRO (1..MACRO_LEN) =
-                   SYMBOL_TABLE (INDEX).MACRO_NAME
-                       (1..SYMBOL_TABLE (INDEX).NAME_LENGTH) THEN
-                     TEMP_MACRO_LEN :=
-                       SYMBOL_TABLE (INDEX).VALUE_LENGTH;
-                     TEMP_MACRO (1..TEMP_MACRO_LEN) :=
-                       SYMBOL_TABLE (INDEX).MACRO_VALUE
-                         (1..TEMP_MACRO_LEN);
-                     EXIT;
-                END IF;
-                IF INDEX = NUM_MACROS THEN
-                     PUT_LINE ("** ERROR: MACRO " & MACRO (1..MACRO_LEN)
-                               & " NOT FOUND.  UPDATE PROGRAM.");
-                     TEMP_MACRO_LEN := MACRO_LEN;
-                     TEMP_MACRO (1..TEMP_MACRO_LEN) :=
-                        MACRO (1..MACRO_LEN);
-                END IF;
-           END LOOP;
- 
-      END WHICH_MACRO;
- 
- BEGIN
-      NULL;
- END PARSEMAC;
- 
- WITH TEXT_IO, GETSUBS, PARSEMAC, DEFS;
- USE TEXT_IO, GETSUBS, PARSEMAC, DEFS;
- 
- PROCEDURE MACROSUB IS
- 
- ------------------------------------------------------------------------
- --                                                                    --
- --    MACROSUB IS THE MAIN PROGRAM THAT CALLS PROCEDURES IN TWO       --
- --    PACKAGES, GETSUBS AND PARSEMAC.  THIS PROGRAM IS USED TO MAKE   --
- --    THE MACRO SUBSTITUTIONS FOR TST TESTS IN THE ACVC TEST SUITE.   --
- --                                                                    --
- ------------------------------------------------------------------------
- 
-      INFILE1, INFILE2, OUTFILE1     : FILE_TYPE;
-      FNAME, MACRO                   : VAL_STRING;
-      LENGTH, A_LENGTH, PTR,
-      TEMP_MACRO_LENGTH, MACRO_LEN, FILE_COUNT : INTEGER := 0;
-      A_LINE, TEMP_MACRO, TEMP_LINE, NEW_LINE : VAL_STRING;
-      END_OF_LINE_SEARCH, FLAG       : BOOLEAN := FALSE;
-      TESTS_FILE                     : CONSTANT STRING := "TSTTESTS.DAT";
-      TSTTESTS,FILE_CRE              : EXCEPTION;
- 
- BEGIN
-      PUT_LINE ("BEGINNING MACRO SUBSTITUTIONS.");
-      FILL_TABLE;
-      BEGIN
-           OPEN (INFILE2, IN_FILE, TESTS_FILE);
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                PUT_LINE ("** ERROR: ERROR DURING OPENING OF " &
-                          "TSTTESTS.DAT");
-                RAISE TSTTESTS;
-      END;
-      WHILE NOT END_OF_FILE (INFILE2) LOOP
-           GET_LINE (INFILE2, FNAME, LENGTH);
-           FILE_COUNT := FILE_COUNT + 1;
-           BEGIN
-                OPEN (INFILE1, IN_FILE, FNAME(1..LENGTH));
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     PUT_LINE ("** ERROR: ERROR DURING OPENING OF " &
-                               FNAME(1..LENGTH) & ".");
-                     FLAG := TRUE;
-           END;
-           IF NOT FLAG THEN
-                PUT_LINE ("WORKING ON " & FNAME(1..LENGTH));
-                IF FILE_COUNT = 70 THEN
-                     PUT_LINE ("MACRO SUBSTITUTIONS HALF COMPLETED.");
-                END IF;
-                FOR I IN REVERSE 1 .. LENGTH LOOP
-                     IF FNAME(I) = ';' THEN
-                          LENGTH := I - 1;
-                          EXIT;
-                     END IF;
-                END LOOP;
-                IF FNAME (LENGTH-2..LENGTH) = "TST" THEN
-                     FNAME (LENGTH-2..LENGTH) := "ADT";
-                ELSIF FNAME (LENGTH-2..LENGTH) = "tst" THEN
-                     FNAME (LENGTH-2..LENGTH) := "adt";
-                END IF;
-                BEGIN
-                     CREATE (OUTFILE1, OUT_FILE, FNAME (1..LENGTH));
-                EXCEPTION
-                     WHEN OTHERS =>
-                          PUT_LINE ("** ERROR: EXCEPTION RAISED DURING" &
-                                    " ATTEMPTED CREATION OF " &
-                                    FNAME(1..LENGTH) & ".");
-                          RAISE FILE_CRE;
-                END;
-                WHILE NOT END_OF_FILE (INFILE1) LOOP
-                     GET_LINE (INFILE1, A_LINE, A_LENGTH);
-                     IF A_LENGTH > 0 AND A_LINE(1..2) /= "--" THEN
-                          END_OF_LINE_SEARCH := FALSE;
-                          PTR := 1;
-                          WHILE NOT END_OF_LINE_SEARCH LOOP
-                               LOOK_FOR_MACRO (A_LINE, A_LENGTH, PTR,
-                                               MACRO, MACRO_LEN);
-                               IF MACRO_LEN = 0 THEN
-                                    END_OF_LINE_SEARCH := TRUE;
-                               ELSE --  SEE WHICH MACRO IT IS
-                                    WHICH_MACRO (MACRO, MACRO_LEN,
-                                        TEMP_MACRO, TEMP_MACRO_LENGTH);
-                               END IF;
-                               IF NOT END_OF_LINE_SEARCH THEN
-                                    IF PTR-MACRO_LEN-2 > 0 THEN
-                                  -- IF MACRO IS NOT FIRST ON THE LINE
-                                         NEW_LINE (1..PTR-MACRO_LEN-2)
-                                          := A_LINE(1..PTR-MACRO_LEN -2);
-                                  -- THE OLD LINE UNTIL THE DOLLAR SIGN
-                                    END IF;
-                                    NEW_LINE(PTR-MACRO_LEN-1 ..
-                                             TEMP_MACRO_LENGTH +
-                                             (PTR-MACRO_LEN) - 2) :=
-                                        TEMP_MACRO(1..TEMP_MACRO_LENGTH);
-                                    IF PTR <= A_LENGTH THEN
-                                  -- IF MACRO IS NOT LAST ON THE LINE
-                                         NEW_LINE (TEMP_MACRO_LENGTH +
-                                              PTR-MACRO_LEN - 1 ..
-                                              TEMP_MACRO_LENGTH - 1 +
-                                              A_LENGTH - MACRO_LEN) :=
-                                              A_LINE (PTR..A_LENGTH);
-                                    ELSE
-                                         END_OF_LINE_SEARCH := TRUE;
-                                    END IF;
-                                    A_LENGTH := A_LENGTH +
-                                                TEMP_MACRO_LENGTH -
-                                                MACRO_LEN - 1;
-                                    A_LINE (1..A_LENGTH) :=
-                                           NEW_LINE (1..A_LENGTH);
-                                    PTR := PTR - MACRO_LEN +
-                                           TEMP_MACRO_LENGTH - 1;
-                               END IF;
-                          END LOOP;
-                     END IF;
-                     PUT_LINE (OUTFILE1, A_LINE (1..A_LENGTH));
-                END LOOP;
-                CLOSE (OUTFILE1);
-                CLOSE (INFILE1);
-           ELSE
-                FLAG := FALSE;
-           END IF;
-      END LOOP;
-      CLOSE (INFILE2);
-      PUT_LINE ("MACRO SUBSTITUTIONS COMPLETED.");
- EXCEPTION
-      WHEN MAC_FILE | LINE_LEN | TSTTESTS | FILE_CRE =>
-           NULL;
-      WHEN OTHERS =>
-           PUT_LINE ("UNEXPECTED EXCEPTION RAISED");
- END MACROSUB;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/repbody.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/repbody.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/repbody.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/repbody.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,330 ****
- -- REPBODY.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- HISTORY:
- --      DCB 04/27/80
- --      JRK 6/10/80
- --      JRK 11/12/80
- --      JRK 8/6/81
- --      JRK 10/27/82
- --      JRK 6/1/84
- --      JRK 11/18/85  ADDED PRAGMA ELABORATE.
- --      PWB 07/29/87  ADDED STATUS ACTION_REQUIRED AND
- --                    PROCEDURE SPECIAL_ACTION.
- --      TBN 08/20/87  ADDED FUNCTION LEGAL_FILE_NAME.
- --      BCB 05/17/90  MODIFIED TO ALLOW OUTPUT TO DIRECT_IO FILE.
- --                    ADDED TIME-STAMP.
- --      LDC 05/17/90  REMOVED OUTPUT TO DIRECT_IO FILE.
- --      WMC 08/11/92  UPDATED ACVC VERSION STRING TO "9X BASIC".
- --      DTN 07/05/92  UPDATED ACVC VERSION STRING TO
- --                    "ACVC 2.0 JULY 6 1993 DRAFT".
- --      WMC 01/24/94  MODIFIED LEGAL_FILE_NAME TO ALLOW FIVE POSSIBLE
- --                    FILE NAMES (INCREASED RANGE OF TYPE FILE_NUM TO 1..5).
- --      WMC 11/06/94  UPDATED ACVC VERSION STRING TO
- --                    "ACVC 2.0 NOVEMBER 6 1994 DRAFT".
- --      DTN 12/04/94  UPDATED ACVC VERSION STRING TO
- --                    "ACVC 2.0".
- --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_CHAR.
- --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_STR.
- --      DTN 11/21/95  UPDATED ACVC VERSION STRING TO
- --                    "ACVC 2.0.1".
- --      DTN 12/14/95  UPDATED ACVC VERSION STRING TO
- --                    "ACVC 2.1".
- --      EDS 12/17/97  UPDATED ACVC VERSION STRING TO
- --                    "2.2".
- --      RLB  3/16/00  UPDATED ACATS VERSION STRING TO "2.3".
- --                    CHANGED VARIOUS STRINGS TO READ "ACATS".
- --      RLB  3/22/01  UPDATED ACATS VERSION STRING TO "2.4".
- --      RLB  3/29/02  UPDATED ACATS VERSION STRING TO "2.5".
- --      RLB  3/06/07  UPDATED ACATS VERSION STRING TO "2.6".
- 
- WITH TEXT_IO, CALENDAR;
- USE TEXT_IO, CALENDAR;
- PRAGMA ELABORATE (TEXT_IO, CALENDAR);
- 
- PACKAGE BODY REPORT IS
- 
-      TYPE STATUS IS (PASS, FAIL, DOES_NOT_APPLY, ACTION_REQUIRED,
-                      UNKNOWN);
- 
-      TYPE TIME_INTEGER IS RANGE 0 .. 86_400;
- 
-      TEST_STATUS : STATUS := FAIL;
- 
-      MAX_NAME_LEN : CONSTANT := 15;     -- MAXIMUM TEST NAME LENGTH.
-      TEST_NAME : STRING (1..MAX_NAME_LEN);
- 
-      NO_NAME : CONSTANT STRING (1..7) := "NO_NAME";
-      TEST_NAME_LEN : INTEGER RANGE 0..MAX_NAME_LEN := 0;
- 
- 
- 
-      ACATS_VERSION : CONSTANT STRING := "2.6";
-                                        -- VERSION OF ACATS BEING RUN (X.XX).
- 
-      PROCEDURE PUT_MSG (MSG : STRING) IS
-           -- WRITE MESSAGE.  LONG MESSAGES ARE FOLDED (AND INDENTED).
-           MAX_LEN : CONSTANT INTEGER RANGE 50..150 := 72;  -- MAXIMUM
-                                         -- OUTPUT LINE LENGTH.
-           INDENT : CONSTANT INTEGER := TEST_NAME_LEN + 9;  -- AMOUNT TO
-                                         -- INDENT CONTINUATION LINES.
-           I : INTEGER := 0;             -- CURRENT INDENTATION.
-           M : INTEGER := MSG'FIRST;     -- START OF MESSAGE SLICE.
-           N : INTEGER;                  -- END OF MESSAGE SLICE.
-      BEGIN
-           LOOP
-                IF I + (MSG'LAST-M+1) > MAX_LEN THEN
-                     N := M + (MAX_LEN-I) - 1;
-                     IF MSG (N) /= ' ' THEN
-                          WHILE N >= M AND THEN MSG (N+1) /= ' ' LOOP
-                               N := N - 1;
-                          END LOOP;
-                          IF N < M THEN
-                               N := M + (MAX_LEN-I) - 1;
-                          END IF;
-                     END IF;
-                ELSE N := MSG'LAST;
-                END IF;
-                SET_COL (STANDARD_OUTPUT, TEXT_IO.COUNT (I+1));
-                PUT_LINE (STANDARD_OUTPUT, MSG (M..N));
-                I := INDENT;
-                M := N + 1;
-                WHILE M <= MSG'LAST AND THEN MSG (M) = ' ' LOOP
-                     M := M + 1;
-                END LOOP;
-                EXIT WHEN M > MSG'LAST;
-           END LOOP;
-      END PUT_MSG;
- 
-      FUNCTION TIME_STAMP RETURN STRING IS
-           TIME_NOW : CALENDAR.TIME;
-           YEAR,
-           MONTH,
-           DAY,
-           HOUR,
-           MINUTE,
-           SECOND : TIME_INTEGER := 1;
- 
-           FUNCTION CONVERT (NUMBER : TIME_INTEGER) RETURN STRING IS
-                STR : STRING (1..2) := (OTHERS => '0');
-                DEC_DIGIT : CONSTANT STRING := "0123456789";
-                NUM : TIME_INTEGER := NUMBER;
-           BEGIN
-                IF NUM = 0 THEN
-                     RETURN STR;
-                ELSE
-                     NUM := NUM MOD 100;
-                     STR (2) := DEC_DIGIT (INTEGER (NUM MOD 10 + 1));
-                     NUM := NUM / 10;
-                     STR (1) := DEC_DIGIT (INTEGER (NUM + 1));
-                     RETURN STR;
-                END IF;
-           END CONVERT;
-      BEGIN
-           TIME_NOW := CALENDAR.CLOCK;
-           SPLIT (TIME_NOW, YEAR_NUMBER (YEAR), MONTH_NUMBER (MONTH),
-                   DAY_NUMBER (DAY), DAY_DURATION (SECOND));
-           HOUR := SECOND / 3600;
-           SECOND := SECOND MOD 3600;
-           MINUTE := SECOND / 60;
-           SECOND := SECOND MOD 60;
-           RETURN (CONVERT (TIME_INTEGER (YEAR)) & "-" &
-                   CONVERT (TIME_INTEGER (MONTH)) & "-" &
-                   CONVERT (TIME_INTEGER (DAY)) & " " &
-                   CONVERT (TIME_INTEGER (HOUR)) & ":" &
-                   CONVERT (TIME_INTEGER (MINUTE)) & ":" &
-                   CONVERT (TIME_INTEGER (SECOND)));
-      END TIME_STAMP;
- 
-      PROCEDURE TEST (NAME : STRING; DESCR : STRING) IS
-      BEGIN
-           TEST_STATUS := PASS;
-           IF NAME'LENGTH <= MAX_NAME_LEN THEN
-                TEST_NAME_LEN := NAME'LENGTH;
-           ELSE TEST_NAME_LEN := MAX_NAME_LEN;
-           END IF;
-           TEST_NAME (1..TEST_NAME_LEN) :=
-                     NAME (NAME'FIRST .. NAME'FIRST+TEST_NAME_LEN-1);
- 
-           PUT_MSG ("");
-           PUT_MSG (",.,. " & TEST_NAME (1..TEST_NAME_LEN) & " " &
-                    "ACATS " & ACATS_VERSION & " " & TIME_STAMP);
-           PUT_MSG ("---- " & TEST_NAME (1..TEST_NAME_LEN) & " " &
-                    DESCR & ".");
-      END TEST;
- 
-      PROCEDURE COMMENT (DESCR : STRING) IS
-      BEGIN
-           PUT_MSG ("   - " & TEST_NAME (1..TEST_NAME_LEN) & " " &
-                    DESCR & ".");
-      END COMMENT;
- 
-      PROCEDURE FAILED (DESCR : STRING) IS
-      BEGIN
-           TEST_STATUS := FAIL;
-           PUT_MSG ("   * " & TEST_NAME (1..TEST_NAME_LEN) & " " &
-                    DESCR & ".");
-      END FAILED;
- 
-      PROCEDURE NOT_APPLICABLE (DESCR : STRING) IS
-      BEGIN
-           IF TEST_STATUS = PASS OR TEST_STATUS = ACTION_REQUIRED THEN
-                TEST_STATUS := DOES_NOT_APPLY;
-           END IF;
-           PUT_MSG ("   + " & TEST_NAME (1..TEST_NAME_LEN) & " " &
-                    DESCR & ".");
-      END NOT_APPLICABLE;
- 
-      PROCEDURE SPECIAL_ACTION (DESCR : STRING) IS
-      BEGIN
-           IF TEST_STATUS = PASS THEN
-                TEST_STATUS := ACTION_REQUIRED;
-           END IF;
-           PUT_MSG ("   ! " & TEST_NAME (1..TEST_NAME_LEN) & " " &
-                    DESCR & ".");
-      END SPECIAL_ACTION;
- 
-      PROCEDURE RESULT IS
-      BEGIN
-           CASE TEST_STATUS IS
-           WHEN PASS =>
-                PUT_MSG ("==== " & TEST_NAME (1..TEST_NAME_LEN) &
-                         " PASSED ============================.");
-           WHEN DOES_NOT_APPLY =>
-                PUT_MSG ("++++ " & TEST_NAME (1..TEST_NAME_LEN) &
-                         " NOT-APPLICABLE ++++++++++++++++++++.");
-           WHEN ACTION_REQUIRED =>
-                PUT_MSG ("!!!! " & TEST_NAME (1..TEST_NAME_LEN) &
-                         " TENTATIVELY PASSED !!!!!!!!!!!!!!!!.");
-                PUT_MSG ("!!!! " & (1..TEST_NAME_LEN => ' ') &
-                         " SEE '!' COMMENTS FOR SPECIAL NOTES!!");
-           WHEN OTHERS =>
-                PUT_MSG ("**** " & TEST_NAME (1..TEST_NAME_LEN) &
-                         " FAILED ****************************.");
-           END CASE;
-           TEST_STATUS := FAIL;
-           TEST_NAME_LEN := NO_NAME'LENGTH;
-           TEST_NAME (1..TEST_NAME_LEN) := NO_NAME;
-      END RESULT;
- 
-      FUNCTION IDENT_INT (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           IF EQUAL (X, X) THEN          -- ALWAYS EQUAL.
-                RETURN X;                -- ALWAYS EXECUTED.
-           END IF;
-           RETURN 0;                     -- NEVER EXECUTED.
-      END IDENT_INT;
- 
-      FUNCTION IDENT_CHAR (X : CHARACTER) RETURN CHARACTER IS
-      BEGIN
-           IF EQUAL (CHARACTER'POS(X), CHARACTER'POS(X)) THEN  -- ALWAYS
-                                         -- EQUAL.
-                RETURN X;                -- ALWAYS EXECUTED.
-           END IF;
-           RETURN '0';                   -- NEVER EXECUTED.
-      END IDENT_CHAR;
- 
-      FUNCTION IDENT_WIDE_CHAR (X : WIDE_CHARACTER) RETURN WIDE_CHARACTER IS
-      BEGIN
-           IF EQUAL (WIDE_CHARACTER'POS(X), WIDE_CHARACTER'POS(X)) THEN
-                                         -- ALWAYS EQUAL.
-                RETURN X;                -- ALWAYS EXECUTED.
-           END IF;
-           RETURN '0';                   -- NEVER EXECUTED.
-      END IDENT_WIDE_CHAR;
- 
-      FUNCTION IDENT_BOOL (X : BOOLEAN) RETURN BOOLEAN IS
-      BEGIN
-           IF EQUAL (BOOLEAN'POS(X), BOOLEAN'POS(X)) THEN  -- ALWAYS
-                                         -- EQUAL.
-                RETURN X;                -- ALWAYS EXECUTED.
-           END IF;
-           RETURN FALSE;                 -- NEVER EXECUTED.
-      END IDENT_BOOL;
- 
-      FUNCTION IDENT_STR (X : STRING) RETURN STRING IS
-      BEGIN
-           IF EQUAL (X'LENGTH, X'LENGTH) THEN  -- ALWAYS EQUAL.
-                RETURN X;                -- ALWAYS EXECUTED.
-           END IF;
-           RETURN "";                    -- NEVER EXECUTED.
-      END IDENT_STR;
- 
-      FUNCTION IDENT_WIDE_STR (X : WIDE_STRING) RETURN WIDE_STRING IS
-      BEGIN
-           IF EQUAL (X'LENGTH, X'LENGTH) THEN  -- ALWAYS EQUAL.
-                RETURN X;                -- ALWAYS EXECUTED.
-           END IF;
-           RETURN "";                    -- NEVER EXECUTED.
-      END IDENT_WIDE_STR;
- 
-      FUNCTION EQUAL (X, Y : INTEGER) RETURN BOOLEAN IS
-           REC_LIMIT : CONSTANT INTEGER RANGE 1..100 := 3;  -- RECURSION
-                                         -- LIMIT.
-           Z : BOOLEAN;                  -- RESULT.
-      BEGIN
-           IF X < 0 THEN
-                IF Y < 0 THEN
-                     Z := EQUAL (-X, -Y);
-                ELSE Z := FALSE;
-                END IF;
-           ELSIF X > REC_LIMIT THEN
-                Z := EQUAL (REC_LIMIT, Y-X+REC_LIMIT);
-           ELSIF X > 0 THEN
-                Z := EQUAL (X-1, Y-1);
-           ELSE Z := Y = 0;
-           END IF;
-           RETURN Z;
-      EXCEPTION
-           WHEN OTHERS =>
-                RETURN X = Y;
-      END EQUAL;
- 
-      FUNCTION LEGAL_FILE_NAME (X : FILE_NUM := 1;
-                                NAM : STRING := "")
-                               RETURN STRING IS
-           SUFFIX : STRING (2..6);
-      BEGIN
-           IF NAM = "" THEN
-                SUFFIX := TEST_NAME(3..7);
-           ELSE
-                SUFFIX := NAM(3..7);
-           END IF;
- 
-           CASE X IS
-                WHEN 1 => RETURN ('X' & SUFFIX);
-                WHEN 2 => RETURN ('Y' & SUFFIX);
-                WHEN 3 => RETURN ('Z' & SUFFIX);
-                WHEN 4 => RETURN ('V' & SUFFIX);
-                WHEN 5 => RETURN ('W' & SUFFIX);
-           END CASE;
-      END LEGAL_FILE_NAME;
- 
- BEGIN
- 
-      TEST_NAME_LEN := NO_NAME'LENGTH;
-      TEST_NAME (1..TEST_NAME_LEN) := NO_NAME;
- 
- END REPORT;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/repspec.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/repspec.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/repspec.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/repspec.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- REPSPEC.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- PURPOSE:
- --      THIS REPORT PACKAGE PROVIDES THE MECHANISM FOR REPORTING THE
- --      PASS/FAIL/NOT-APPLICABLE RESULTS OF EXECUTABLE (CLASSES A, C,
- --      D, E, AND L) TESTS.
- 
- --      IT ALSO PROVIDES THE MECHANISM FOR GUARANTEEING THAT CERTAIN
- --      VALUES BECOME DYNAMIC (NOT KNOWN AT COMPILE-TIME).
- 
- -- HISTORY:
- --      JRK 12/13/79
- --      JRK 06/10/80
- --      JRK 08/06/81
- --      JRK 10/27/82
- --      JRK 06/01/84
- --      PWB 07/30/87  ADDED PROCEDURE SPECIAL_ACTION.
- --      TBN 08/20/87  ADDED FUNCTION LEGAL_FILE_NAME.
- --      BCB 05/17/90  ADDED FUNCTION TIME_STAMP.
- --      WMC 01/24/94  INCREASED RANGE OF TYPE FILE_NUM FROM 1..3 TO 1..5.
- --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_CHAR.
- --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_STR.
- 
- PACKAGE REPORT IS
- 
-      SUBTYPE FILE_NUM IS INTEGER RANGE 1..5;
- 
-   -- THE REPORT ROUTINES.
- 
-      PROCEDURE TEST           -- THIS ROUTINE MUST BE INVOKED AT THE
-                               -- START OF A TEST, BEFORE ANY OF THE
-                               -- OTHER REPORT ROUTINES ARE INVOKED.
-                               -- IT SAVES THE TEST NAME AND OUTPUTS THE
-                               -- NAME AND DESCRIPTION.
-         ( NAME : STRING;      -- TEST NAME, E.G., "C23001A-AB".
-           DESCR : STRING      -- BRIEF DESCRIPTION OF TEST, E.G.,
-                               -- "UPPER/LOWER CASE EQUIVALENCE IN " &
-                               -- "IDENTIFIERS".
-         );
- 
-      PROCEDURE FAILED         -- OUTPUT A FAILURE MESSAGE.  SHOULD BE
-                               -- INVOKED SEPARATELY TO REPORT THE
-                               -- FAILURE OF EACH SUBTEST WITHIN A TEST.
-         ( DESCR : STRING      -- BRIEF DESCRIPTION OF WHAT FAILED.
-                               -- SHOULD BE PHRASED AS:
-                               -- "(FAILED BECAUSE) ...REASON...".
-         );
- 
-      PROCEDURE NOT_APPLICABLE -- OUTPUT A NOT-APPLICABLE MESSAGE.
-                               -- SHOULD BE INVOKED SEPARATELY TO REPORT
-                               -- THE NON-APPLICABILITY OF EACH SUBTEST
-                               -- WITHIN A TEST.
-         ( DESCR : STRING      -- BRIEF DESCRIPTION OF WHAT IS
-                               -- NOT-APPLICABLE. SHOULD BE PHRASED AS:
-                               -- "(NOT-APPLICABLE BECAUSE)...REASON...".
-         );
- 
-      PROCEDURE SPECIAL_ACTION -- OUTPUT A MESSAGE DESCRIBING SPECIAL
-                               -- ACTIONS TO BE TAKEN.
-                               -- SHOULD BE INVOKED SEPARATELY TO GIVE
-                               -- EACH SPECIAL ACTION.
-         ( DESCR : STRING      -- BRIEF DESCRIPTION OF ACTION TO BE
-                               -- TAKEN.
-         );
- 
-      PROCEDURE COMMENT        -- OUTPUT A COMMENT MESSAGE.
-         ( DESCR : STRING      -- THE MESSAGE.
-         );
- 
-      PROCEDURE RESULT;        -- THIS ROUTINE MUST BE INVOKED AT THE
-                               -- END OF A TEST.  IT OUTPUTS A MESSAGE
-                               -- INDICATING WHETHER THE TEST AS A
-                               -- WHOLE HAS PASSED, FAILED, IS
-                               -- NOT-APPLICABLE, OR HAS TENTATIVELY
-                               -- PASSED PENDING SPECIAL ACTIONS.
- 
-   -- THE DYNAMIC VALUE ROUTINES.
- 
-      -- EVEN WITH STATIC ARGUMENTS, THESE FUNCTIONS WILL HAVE DYNAMIC
-      -- RESULTS.
- 
-      FUNCTION IDENT_INT       -- AN IDENTITY FUNCTION FOR TYPE INTEGER.
-         ( X : INTEGER         -- THE ARGUMENT.
-         ) RETURN INTEGER;     -- X.
- 
-      FUNCTION IDENT_CHAR      -- AN IDENTITY FUNCTION FOR TYPE
-                               -- CHARACTER.
-         ( X : CHARACTER       -- THE ARGUMENT.
-         ) RETURN CHARACTER;   -- X.
- 
-      FUNCTION IDENT_WIDE_CHAR -- AN IDENTITY FUNCTION FOR TYPE
-                               -- WIDE_CHARACTER.
-         ( X : WIDE_CHARACTER  -- THE ARGUMENT.
-         ) RETURN WIDE_CHARACTER; -- X.
- 
-      FUNCTION IDENT_BOOL      -- AN IDENTITY FUNCTION FOR TYPE BOOLEAN.
-         ( X : BOOLEAN         -- THE ARGUMENT.
-         ) RETURN BOOLEAN;     -- X.
- 
-      FUNCTION IDENT_STR       -- AN IDENTITY FUNCTION FOR TYPE STRING.
-         ( X : STRING          -- THE ARGUMENT.
-         ) RETURN STRING;      -- X.
- 
-      FUNCTION IDENT_WIDE_STR  -- AN IDENTITY FUNCTION FOR TYPE WIDE_STRING.
-         ( X : WIDE_STRING     -- THE ARGUMENT.
-         ) RETURN WIDE_STRING; -- X.
- 
-      FUNCTION EQUAL           -- A RECURSIVE EQUALITY FUNCTION FOR TYPE
-                               -- INTEGER.
-         ( X, Y : INTEGER      -- THE ARGUMENTS.
-         ) RETURN BOOLEAN;     -- X = Y.
- 
- -- OTHER UTILITY ROUTINES.
- 
-      FUNCTION LEGAL_FILE_NAME -- A FUNCTION TO GENERATE LEGAL EXTERNAL
-                               -- FILE NAMES.
-         ( X : FILE_NUM := 1;  -- DETERMINES FIRST CHARACTER OF NAME.
-           NAM : STRING := ""  -- DETERMINES REST OF NAME.
-         ) RETURN STRING;      -- THE GENERATED NAME.
- 
-      FUNCTION TIME_STAMP      -- A FUNCTION TO GENERATE THE TIME AND
-                               -- DATE TO PLACE IN THE OUTPUT OF AN ACVC
-                               -- TEST.
-           RETURN STRING;      -- THE TIME AND DATE.
- 
- END REPORT;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/spprt13s.tst gcc-16-20250525/gcc/testsuite/ada/acats/support/spprt13s.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/spprt13s.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/spprt13s.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- SPPRT13SP.TST
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- SPECIFICATION FOR PACKAGE SPPRT13
- 
- -- PURPOSE:
- --     THIS PACKAGE CONTAINS CONSTANTS OF TYPE SYSTEM.ADDRESS.
- --     THESE CONSTANTS ARE USED BY SELECTED CHAPTER 13 TESTS,
- --     BY PARTS OF THE AVAT SYSTEM, AND BY ISOLATED TESTS FOR
- --     OTHER CHAPTERS.
- 
- -- MACRO SUBSTITUTIONS:
- --     $VARIABLE_ADDRESS, $VARIABLE_ADDRESS1, AND $VARIABLE_ADDRESS2 ARE
- --     EXPRESSIONS YIELDING LEGAL ADDRESSES FOR VARIABLES FOR THIS
- --     IMPLEMENTATION.
- 
- --     $ENTRY_ADDRESS, $ENTRY_ADDRESS1, AND $ENTRY_ADDRESS2 ARE
- --     EXPRESSIONS YIELDING LEGAL ADDRESSES FOR TASK ENTRIES
- --     (I.E., FOR INTERRUPTS) FOR THIS IMPLEMENTATION.
- 
- --     IF NO EXPRESSIONS CAN BE GIVEN THAT ARE SATISFACTORY FOR THE
- --     VALUES OF THESE CONSTANTS, THEN DECLARE SUITABLE FUNCTIONS
- --     IN THE SPECIFICATION OF PACKAGE FCNDECL, CREATE A PACKAGE BODY
- --     CONTAINING BODIES FOR THE FUNCTIONS, AND REPLACE THE MACROS WITH
- --     APPROPRIATE FUNCTION CALLS.
- 
- WITH FCNDECL; USE FCNDECL;
- WITH SYSTEM;
- PACKAGE SPPRT13 IS
- 
-         VARIABLE_ADDRESS  : CONSTANT SYSTEM.ADDRESS :=
-                             $VARIABLE_ADDRESS;
-         VARIABLE_ADDRESS1 : CONSTANT SYSTEM.ADDRESS :=
-                             $VARIABLE_ADDRESS1;
-         VARIABLE_ADDRESS2 : CONSTANT SYSTEM.ADDRESS :=
-                             $VARIABLE_ADDRESS2;
- 
-         ENTRY_ADDRESS  : CONSTANT SYSTEM.ADDRESS :=
-                             $ENTRY_ADDRESS;
-         ENTRY_ADDRESS1 : CONSTANT SYSTEM.ADDRESS :=
-                             $ENTRY_ADDRESS1;
-         ENTRY_ADDRESS2 : CONSTANT SYSTEM.ADDRESS :=
-                             $ENTRY_ADDRESS2;
- 
- END SPPRT13;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/tctouch.ada gcc-16-20250525/gcc/testsuite/ada/acats/support/tctouch.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/tctouch.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/tctouch.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,265 ****
- -- TCTouch.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FOUNDATION DESCRIPTION:
- --      The tools in this foundation are not peculiar to any particular
- --      aspect of the language, but simplify the test writing and reading
- --      process.  Assert and Assert_Not are used to reduce the textual
- --      overhead of the test-that-this-condition-is-(not)-true paradigm.
- --      Touch and Validate are used to simplify tracing an expected path
- --      of execution.
- --      A tag comment of the form:
- --
- --      TCTouch.Touch( 'A' ); ----------------------------------------- A
- --
- --      is recommended to improve readability of this feature.
- --
- --      Report.Test must be called before any of the procedures in this
- --      package with the exception of Touch.
- --      The usage paradigm is to call Touch in locations in the test where you
- --      want a trace of execution.  Each call to Touch should have a unique
- --      character associated with it.  At each place where a check can
- --      reasonably be performed to determine correct execution of a
- --      sub-test, a call to Validate should be made.  The first parameter
- --      passed to Validate is the expected string of characters produced by
- --      call(s) to Touch in the subtest just executed.  The second parameter
- --      is the message to pass to Report.Failed if the expected sequence was
- --      not executed.
- --
- --      Validate should always be called after calls to Touch before a test
- --      completes.
- --
- --      In the event that calls may have been made to Touch that are not
- --      intended to be recorded, or, the failure of a previous subtest may
- --      leave Touch calls "Unvalidated", the procedure Flush will reset the
- --      tracker to the "empty" state.  Flush does not make any calls to
- --      Report.
- --
- --      Calls to Assert and Assert_Not are to replace the idiom:
- --
- --         if BadCondition then  -- or if not PositiveTest then
- --           Report.Failed(Message);
- --         end if;
- --
- --      with:
- --
- --         Assert_Not( BadCondition, Message ); -- or
- --         Assert( PositiveTest, Message );
- --
- --      Implementation_Check is for use with tests that cross the boundary
- --      between the core and the Special Needs Annexes.  There are several
- --      instances where language in the core becomes enforceable only when
- --      a Special Needs Annex is supported.  Implementation_Check should be
- --      called in place of Report.Failed in these cases; it examines the
- --      constants in Impdef that indicate if the particular Special Needs
- --      Annex is being validated with this validation; and acts accordingly.
- --
- --      The constant Foundation_ID contains the internal change version
- --      for this software.
- --
- -- ERROR CONDITIONS:
- --
- --      It is an error to perform more than Max_Touch_Count (80) calls to
- --      Touch without a subsequent call to Validate.  To do so will cause
- --      a false test failure.
- --
- -- CHANGE HISTORY:
- --     02 JUN 94   SAIC    Initial version
- --     27 OCT 94   SAIC    Revised version
- --     07 AUG 95   SAIC    Added Implementation_Check
- --     07 FEB 96   SAIC    Changed to match new Impdef for 2.1
- --     16 MAR 00   RLB     Changed foundation id to reflect test suite version.
- --     22 MAR 01   RLB     Changed foundation id to reflect test suite version.
- --     29 MAR 02   RLB     Changed foundation id to reflect test suite version.
- --     06 MAR 07   RLB     Changed foundation id to reflect test suite version.
- --
- --!
- 
- package TCTouch is
-   Foundation_ID   : constant String := "TCTouch ACATS 2.6";
-   Max_Touch_Count : constant        := 80;
- 
-   procedure Assert    ( SB_True  : Boolean; Message : String );
-   procedure Assert_Not( SB_False : Boolean; Message : String );
- 
-   procedure Touch   ( A_Tag   : Character );
-   procedure Validate( Expected: String;
-                       Message : String;
-                       Order_Meaningful : Boolean := True );
- 
-   procedure Flush;
- 
-   type Special_Needs_Annexes is ( Annex_C, Annex_D, Annex_E,
-                                   Annex_F, Annex_G, Annex_H );
- 
-   procedure Implementation_Check( Message : in String;
-                                   Annex   : in Special_Needs_Annexes
-                                           := Annex_C );
-     -- If Impdef.Validating_Annex_<Annex> is true, will call Report.Failed
-     -- otherwise will call Report.Not_Applicable.  This is to allow tests
-     -- which are driven by wording in the core of the language, yet have
-     -- their functionality dictated by the Special Needs Annexes to perform
-     -- dual purpose.
-     -- The default of Annex_C for the Annex parameter is to support early
-     -- tests written with the assumption that Implementation_Check was
-     -- expressly for use with the Systems Programming Annex.
- 
- end TCTouch;
- 
- with Report;
- with Impdef;
- package body TCTouch is
- 
-   procedure Assert( SB_True : Boolean; Message : String ) is
-   begin
-     if not SB_True then
-       Report.Failed( "Assertion failed: " & Message );
-     end if;
-   end Assert;
- 
-   procedure Assert_Not( SB_False : Boolean; Message : String ) is
-   begin
-     if SB_False then
-       Report.Failed( "Assertion failed: " & Message );
-     end if;
-   end Assert_Not;
- 
-   Collection : String(1..Max_Touch_Count);
-   Finger     : Natural := 0;
- 
-   procedure Touch ( A_Tag : Character ) is
-   begin
-     Finger := Finger+1;
-     Collection(Finger) := A_Tag;
-   exception
-     when Constraint_Error =>
-       Report.Failed("Trace Overflow: " & Collection);
-       Finger := 0;
-   end Touch;
- 
-   procedure Sort_String( S: in out String ) is
-   -- algorithm from Booch Components Page 472
-     No_Swaps : Boolean;
-     procedure Swap(C1, C2: in out Character) is
-       T: Character := C1;
-     begin  C1 := C2; C2 := T; end Swap;
-   begin
-     for OI in S'First+1..S'Last loop
-       No_Swaps := True;
-       for II in reverse OI..S'Last loop
-         if S(II) < S(II-1) then
-           Swap(S(II),S(II-1));
-           No_Swaps := False;
-         end if;
-       end loop;
-       exit when No_Swaps;
-     end loop;
-   end Sort_String;
- 
-   procedure Validate( Expected: String;
-                       Message : String;
-                       Order_Meaningful : Boolean := True) is
-     Want : String(1..Expected'Length) := Expected;
-   begin
-     if not Order_Meaningful then
-       Sort_String( Want );
-       Sort_String( Collection(1..Finger) );
-     end if;
-     if Collection(1..Finger) /= Want then
-       Report.Failed( Message & " Expecting: " & Want
- 			     & " Got: " & Collection(1..Finger) );
-     end if;
-     Finger := 0;
-   end Validate;
- 
-   procedure Flush is
-   begin
-     Finger := 0;
-   end Flush;
- 
-   procedure Implementation_Check( Message : in String;
-                                   Annex   : in Special_Needs_Annexes
-                                           := Annex_C ) is
-                                           -- default to cover some legacy
-   -- USAGE DISCIPLINE:
-   --   Implementation_Check is designed to be used in tests that have
-   --   interdependency on one of the Special Needs Annexes, yet are _really_
-   --   tests based in the core language.  There will be instances where the
-   --   execution of a test would be failing in the light of the requirements
-   --   of the annex, yet from the point of view of the core language without
-   --   the additional requirements of the annex, the test does not apply.
-   --   In these cases, rather than issuing a call to Report.Failed, calling
-   --   TCTouch.Implementation_Check will check that sensitivity, and if
-   --   the implementation is attempting to validate against the specific
-   --   annex, Report.Failed will be called, otherwise, Report.Not_Applicable
-   --   will be called.
-   begin
- 
-     case Annex is
-       when Annex_C =>
-         if ImpDef.Validating_Annex_C then
-           Report.Failed( Message );
-         else
-           Report.Not_Applicable( Message & " Annex C not supported" );
-        end if;
- 
-       when Annex_D =>
-         if ImpDef.Validating_Annex_D then
-           Report.Failed( Message );
-         else
-           Report.Not_Applicable( Message & " Annex D not supported" );
-        end if;
- 
-       when Annex_E =>
-         if ImpDef.Validating_Annex_E then
-           Report.Failed( Message );
-         else
-           Report.Not_Applicable( Message & " Annex E not supported" );
-        end if;
- 
-       when Annex_F =>
-         if ImpDef.Validating_Annex_F then
-           Report.Failed( Message );
-         else
-           Report.Not_Applicable( Message & " Annex F not supported" );
-        end if;
- 
-       when Annex_G =>
-         if ImpDef.Validating_Annex_G then
-           Report.Failed( Message );
-         else
-           Report.Not_Applicable( Message & " Annex G not supported" );
-        end if;
- 
-       when Annex_H =>
-         if ImpDef.Validating_Annex_H then
-           Report.Failed( Message );
-         else
-           Report.Not_Applicable( Message & " Annex H not supported" );
-        end if;
-     end case;
-  end Implementation_Check;
- 
- end TCTouch;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/tsttests.dat gcc-16-20250525/gcc/testsuite/ada/acats/support/tsttests.dat
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/tsttests.dat	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/tsttests.dat	Thu Jan  1 00:00:00 1970
***************
*** 1,38 ****
- ACATS4GNATDIR/tests/a/a26007a.tst
- ACATS4GNATDIR/tests/a/ad8011a.tst
- ACATS4GNATDIR/tests/c2/c23003a.tst
- ACATS4GNATDIR/tests/c2/c23003b.tst
- ACATS4GNATDIR/tests/c2/c23003g.tst
- ACATS4GNATDIR/tests/c2/c23003i.tst
- ACATS4GNATDIR/tests/c3/c35502d.tst
- ACATS4GNATDIR/tests/c3/c35502f.tst
- ACATS4GNATDIR/tests/c3/c35503d.tst
- ACATS4GNATDIR/tests/c3/c35503f.tst
- ACATS4GNATDIR/tests/c4/c45231d.tst
- ACATS4GNATDIR/tests/c4/c4a007a.tst
- ACATS4GNATDIR/tests/c8/c87b62d.tst
- ACATS4GNATDIR/tests/c9/c96005b.tst
- ACATS4GNATDIR/tests/cc/cc1225a.tst
- ACATS4GNATDIR/tests/cd/cd1009k.tst
- ACATS4GNATDIR/tests/cd/cd1009t.tst
- ACATS4GNATDIR/tests/cd/cd1009u.tst
- ACATS4GNATDIR/tests/cd/cd1c03e.tst
- ACATS4GNATDIR/tests/cd/cd1c06a.tst
- ACATS4GNATDIR/tests/cd/cd2a83c.tst
- ACATS4GNATDIR/tests/cd/cd2a91c.tst
- ACATS4GNATDIR/tests/cd/cd2c11a.tst
- ACATS4GNATDIR/tests/cd/cd2c11d.tst
- ACATS4GNATDIR/tests/cd/cd4041a.tst
- ACATS4GNATDIR/tests/cd/cd7101g.tst
- ACATS4GNATDIR/tests/ce/ce2102c.tst
- ACATS4GNATDIR/tests/ce/ce2102h.tst
- ACATS4GNATDIR/tests/ce/ce2103a.tst
- ACATS4GNATDIR/tests/ce/ce2103b.tst
- ACATS4GNATDIR/tests/ce/ce2203a.tst
- ACATS4GNATDIR/tests/ce/ce2403a.tst
- ACATS4GNATDIR/tests/ce/ce3002b.tst
- ACATS4GNATDIR/tests/ce/ce3002c.tst
- ACATS4GNATDIR/tests/ce/ce3102b.tst
- ACATS4GNATDIR/tests/ce/ce3107a.tst
- ACATS4GNATDIR/tests/ce/ce3304a.tst
- ACATS4GNATDIR/support/spprt13s.tst
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/support/widechr.a gcc-16-20250525/gcc/testsuite/ada/acats/support/widechr.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/support/widechr.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/support/widechr.a	Thu Jan  1 00:00:00 1970
***************
*** 1,294 ****
- -- WIDECHR.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- DESCRIPTION:
- --
- --      This program reads C250001.AW and C250002.AW; translates a special
- --      character sequence into characters and wide characters with positions
- --      above ASCII.DEL.  The resulting tests are written as C250001.A and
- --      C250002.A respectively.   This program may need to
- --      be modified if the Wide_Character representation recognized by
- --      your compiler differs from the Wide_Character
- --      representation generated by the package Ada.Wide_Text_IO.
- --      Modify this program as needed to translate that file.
- --
- --      A wide character is represented by an 8 character sequence:
- --
- --          ["abcd"]
- --
- --      where the character code represented is specified by four hexadecimal
- --      digits, abcd, with letters in upper case. For example the wide
- --      character with the code 16#AB13# is represented by the eight
- --      character sequence:
- --
- --          ["AB13"]
- --
- -- ASSUMPTIONS:
- --
- --      The path for these files is specified in ImpDef.
- --
- -- SPECIAL REQUIREMENTS:
- --
- --     Compile, bind and execute this program.  It will process the ".AW"
- --     tests, "translating" them to ".A" tests.
- --
- -- CHANGE HISTORY:
- --      11 DEC 96   SAIC   ACVC 2.1 Release
- --
- --      11 DEC 96   Keith  Constructed initial release version
- --!
- 
- with Ada.Text_IO;
- with Ada.Wide_Text_IO;
- with Ada.Strings.Fixed;
- with Impdef;
- 
- procedure WideChr is
- 
-   -- Debug
-   --
-   -- To have the program generate trace/debugging information, de-comment
-   -- the call to Put_Line
- 
-   procedure Debug( S: String ) is
-   begin
-     null; -- Ada.Text_IO.Put_Line(S);
-   end Debug;
- 
-   package TIO renames Ada.Text_IO;
-   package WIO renames Ada.Wide_Text_IO;
-   package SF renames Ada.Strings.Fixed;
- 
-   In_File : TIO.File_Type;
- 
-   -- This program is actually dual-purpose.  It translates the ["xxxx"]
-   -- notation to Wide_Character, as well as a similar notation ["xx"] into
-   -- Character.  The intent of the latter being the ability to represent
-   -- literals in the Latin-1 character set that have position numbers
-   -- greater than ASCII.DEL.  The variable Output_Mode drives the algorithms
-   -- to generate Wide_Character output (Wide) or Character output (Narrow).
- 
-   type Output_Modes is ( Wide, Narrow );
-   Output_Mode : Output_Modes := Wide;
- 
-   Wide_Out   : WIO.File_Type;
-   Narrow_Out : TIO.File_Type;
- 
-   In_Line   : String(1..132); -- SB: $MAX_LINE_LENGTH
- 
-   -- Index variables
-   -- 
-   -- the following index variables: In_Length, Front, Open_Bracket and
-   -- Close_Bracket are used by the scanning software to keep track of
-   -- what's where.
-   --
-   -- In_Length stores the value returned by Ada.Text_IO.Get_Line indicating
-   -- the position of the last "useful" character in the string In_Line.
-   --
-   -- Front retains the index of the first non-translating character in
-   -- In_Line, it is used to indicate the starting index of the portion of
-   -- the string to save without special interpretation.  In the example
-   -- below, where there are two consecutive characters to translate, we see
-   -- that Front will assume three different values processing the string,
-   -- these are indicated by the digits '1', '2' & '3' in the comment
-   -- attached to the declaration.  The processing software will dump
-   -- In_Line(Front..Open_Bracket-1) to the output stream.  Note that in
-   -- the second case, this results in a null string, and in the third case,
-   -- where Open_Bracket does not obtain a third value, the slice
-   -- In_Line(Front..In_Length) is used instead.
-   --
-   -- Open_Bracket and Close_Bracket are used to retain the starting index
-   -- of the character pairs [" and "] respectively.  For the purposes of
-   -- this software the character pairs are what are considered to be the
-   -- "brackets" enclosing the hexadecimal values to be translated.
-   --  Looking at the example below you will see where these index variables
-   -- will "point" in the first and second case.
- 
-   In_Length     : Natural := 0;  --->  Some_["0A12"]["0B13"]_Thing
-   Front         : Natural := 0;  --  1              2       3
-   Open_Bracket  : Natural := 0;  --         1       2
-   Close_Bracket : Natural := 0;  --               1       2
- 
-   -- Xlation
-   --
-   -- This translation table gives an easy way to translate the "decimal"
-   -- value of a hex digit (as represented by a Latin-1 character)
- 
-   type Xlate is array(Character range '0'..'F') of Natural;
-   Xlation : constant Xlate :=
-             ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
-              '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
-              'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
-              'F' => 15,
-              others => 0);
- 
-   -- To_Ch
-   --
-   -- This function takes a string which is assumed to be trimmed to just a
-   -- hexadecimal representation of a Latin-1 character.  The result of the
-   -- function is the Latin-1 character at the position designated by the
-   -- incoming hexadecimal value.  (hexadecimal in human readable form)
- 
-   function To_Ch( S:String ) return Character is
-     Numerical : Natural := 0;
-   begin
-     Debug("To Wide: " & S);
-     for I in S'Range loop
-       Numerical := Numerical * 16 + Xlation(S(I));
-     end loop;
-     return Character'Val(Numerical);
-   exception
-     when Constraint_Error => return '_';
-   end To_Ch;
- 
-   -- To_Wide
-   --
-   -- This function takes a string which is assumed to be trimmed to just a
-   -- hexadecimal representation of a Wide_character.  The result of the
-   -- function is the Wide_character at the position designated by the
-   -- incoming hexadecimal value.  (hexadecimal in human readable form)
- 
-   function To_Wide( S:String ) return Wide_character is
-     Numerical : Natural := 0;
-   begin
-     Debug("To Wide: " & S);
-     for I in S'Range loop
-       Numerical := Numerical * 16 + Xlation(S(I));
-     end loop;
-     return Wide_Character'Val(Numerical);
-   exception
-     when Constraint_Error => return '_';
-   end To_Wide;
- 
-   -- Make_Wide
-   --
-   -- this function converts a String to a Wide_String
- 
-   function Make_Wide( S: String ) return Wide_String is
-     W: Wide_String(S'Range);
-   begin
-     for I in S'Range loop
-       W(I) := Wide_Character'Val( Character'Pos(S(I)) );
-     end loop;
-     return W;
-   end Make_Wide;
- 
-   -- Close_Files
-   --
-   -- Depending on which input we've processed, close the output file
- 
-   procedure Close_Files is
-   begin
-     TIO.Close(In_File);
-     if Output_Mode = Wide then
-       WIO.Close(Wide_Out);
-     else
-       TIO.Close(Narrow_Out);
-     end if;
-   end Close_Files;
- 
-   -- Process
-   --
-   -- for all lines in the input file
-   --   scan the file for occurrences of [" and "]
-   --     for found occurrence, attempt translation of the characters found
-   --     between the brackets.  As a safeguard, unrecognizable character
-   --     sequences will be replaced with the underscore character.  This
-   --     handles the cases in the tests where the test documentation includes
-   --     examples that are non-conformant: i.e. ["abcd"] or ["XXXX"]
- 
-   procedure Process( Input_File_Name: String ) is
-   begin
-     TIO.Open(In_File,TIO.In_File,Input_File_Name & ".aw" );
- 
-     if Output_Mode = Wide then
-       WIO.Create(Wide_Out,WIO.Out_File, Input_File_Name & ".a" );
-     else
-       TIO.Create(Narrow_Out,TIO.Out_File, Input_File_Name & ".a" );
-     end if;
- 
-     File: while not TIO.End_Of_File( In_File ) loop
-       In_Line := (others => ' ');
-       TIO.Get_Line(In_File,In_Line,In_Length);
-       Debug(In_Line(1..In_Length));
- 
-       Front := 1;
- 
-       Line: loop
- 	     -- scan for next occurrence of ["abcd"]
- 	     Open_Bracket := SF.Index( In_Line(Front..In_Length), "[""" );
- 	     Close_Bracket := SF.Index( In_Line(Front..In_Length), """]" );
- 	     Debug( "[=" & Natural'Image(Open_Bracket) );
- 	     Debug( "]=" & Natural'Image(Close_Bracket) );
- 
- 	     if Open_Bracket = 0 or Close_Bracket = 0 then
-         -- done with the line, output remaining characters and exit
- 	       Debug("Done with line");
- 	       if Output_Mode = Wide then
- 	         WIO.Put_Line(Wide_Out, Make_Wide(In_Line(Front..In_Length)) );
- 	       else
- 	         TIO.Put_Line(Narrow_Out, In_Line(Front..In_Length) );
- 	       end if;
- 	       exit Line;
- 	     else
- 	       -- output the "normal" stuff up to the bracket
- 	       if Output_Mode = Wide then
- 	         WIO.Put(Wide_Out, Make_Wide(In_Line(Front..Open_Bracket-1)) );
- 	       else
- 	         TIO.Put(Narrow_Out, In_Line(Front..Open_Bracket-1) );
- 	       end if;
- 
- 	       -- point beyond the closing bracket
- 	       Front := Close_Bracket +2;
- 
- 	       -- output the translated hexadecimal character
- 	       if Output_Mode = Wide then
- 	         WIO.Put(Wide_Out,
- 	              	    To_Wide( In_Line(Open_Bracket+2..Close_Bracket-1) ));
- 	       else
- 	         TIO.Put(Narrow_Out,
- 		                    To_Ch( In_Line(Open_Bracket+2..Close_Bracket-1)) );
- 	       end if;
-      	end if;
-       end loop Line;
- 
-     end loop File;
-     
-     Close_Files;
-   exception
-     when others =>
-       Ada.Text_IO.Put_Line("Error in processing " & Input_File_Name);
-       raise;
-   end Process;
- 
- begin
- 
-   Output_Mode := Wide;
-   Process( Impdef.Wide_Character_Test );
- 
-   Output_Mode := Narrow;
-   Process( Impdef.Upper_Latin_Test );
- 
- end WideChr;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a22006b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a22006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a22006b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a22006b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,38 ****
- -- A22006B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT HORIZONTAL TABULATION CAN BE USED WITHIN AND OUTSIDE OF
- -- COMMENTS.
- 
- -- JBG 5/26/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A22006B IS
- BEGIN
- 	TEST ("A22006B", "CHECK USE OF HT IN AND OUT OF COMMENTS");
-      -- PRECEDING LINE CONTAINED A LEADING HT
-      -- NEXT LINE CONTAINS A TAB INSIDE A COMMENT
-      -- HERE IS HT =>	<= CHARACTER IN A COMMENT
-      RESULT;	-- TAB PRECEDES THIS COMMENT
- END A22006B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a22006c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a22006c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a22006c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a22006c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- 
- 
- 
- -- A22006C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A COMPILATION MAY BE PRECEDED BY EXTRA LINES
- -- (INCLUDING LINES TERMINATED BY FORMAT EFFECTORS OTHER
- --  THAN HORIZONTAL TABULATION).
- 
- -- NOTE: THIS FILE BEGINS WITH:
- --       1) AN EMPTY LINE
- --       2) A CARRIAGE RETURN CHARACTER       (ASCII 13. = 0D HEX)
- --       3) A CARRIAGE RETURN CHARACTER       (ASCII 13. = 0D HEX)
- --       4) A VERTICAL TABULATION CHARACTER   (ASCII 11. = 0B HEX)
- --       5) A LINE FEED CHARACTER             (ASCII 10. = 0A HEX)
- --       6) A LINE FEED CHARACTER             (ASCII 10. = 0A HEX)
- --       7) A FORM FEED CHARACTER             (ASCII 12. = 0C HEX)
- 
- -- PWB  2/13/86
- 
- WITH REPORT;
- USE  REPORT;
- 
- PROCEDURE A22006C IS
- BEGIN
-      TEST ("A22006C", "CHECK THAT A COMPILATION CAN BE PRECEDED " &
-                       "BY EXTRA LINES");
-      RESULT;
- END A22006C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a22006d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a22006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a22006d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a22006d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,41 ****
-     	-- A22006D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A COMPILATION CAN BE PRECEDED BY SPACES AND
- -- HORIZONTAL TABULATION CHARACTERS.
- 
- -- NOTE: THE FIRST LINE OF THIS FILE BEGINS WITH FOUR SPACE
- --       CHARACTERS AND A HORIZONTAL TABULATION CHARACTER
- 
- -- PWB  2/13/86
- 
- WITH REPORT;
- USE  REPORT;
- 
- PROCEDURE A22006D IS
- BEGIN
-      TEST ("A22006D", "CHECK THAT A COMPILATION CAN BE PRECEDED " &
-                       "BY SPACE AND HORIZONTAL TABULATION CHARACTERS");
-      RESULT;
- END A22006D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a26007a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a26007a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a26007a.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a26007a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,48 ****
- -- A26007A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A STRING LITERAL HAVING THE MAXIMUM PERMITTED LINE LENGTH
- -- CAN BE GENERATED.
- 
- -- TBN 3/5/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A26007A IS
- 
-      MAX_LEN_STRING_LIT : STRING (1 .. $MAX_IN_LEN - 2);
- 
-      -- MAX_IN_LEN IS THE MAXIMUM LINE LENGTH PERMITTED.
- 
- BEGIN
-      TEST ("A26007A", "CHECK THAT A STRING LITERAL HAVING THE " &
-                       "MAXIMUM PERMITTED LINE LENGTH CAN BE GENERATED");
- 
-      MAX_LEN_STRING_LIT :=
- $MAX_STRING_LITERAL
- ;
-      -- MAX_STRING_LITERAL IS A STRING LITERAL THAT IS MAXIMUM LENGTH.
-      -- QUOTES ARE COUNTED AS PART OF THE STRING LITERAL.
- 
-      RESULT;
- END A26007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a27003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a27003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a27003a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a27003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- A27003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN A STRING LITERAL, CONSECUTIVE HYPHENS
- -- ARE PERMITTED WITHOUT INDICATING A COMMENT,
- -- AND THAT IN A COMMENT, A SINGLE DOUBLE-QUOTE IS
- -- PERMITTED WITHOUT INDICATING A STRING LITERAL.
- 
- -- PWB  03/04/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A27003A IS
- 
-      -- COMMENT :  "  IS PERMITTED HERE.
- 
-      STR1 : CONSTANT STRING := "AB--C";
-      STR2 : STRING (1..10);
- 
- BEGIN
- 
-      TEST ("A27003A", "CONSECUTIVE HYPHENS PERMITTED IN " &
-                       "STRING LITERAL, AND QUOTE PERMITTED " &
-                       "IN COMMENT");
- 
-      STR2 := STR1 & "--ABC";
-      -- COMMENT : " IS PERMITTED HERE.
- 
-      RESULT;
- 
- END A27003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a29003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a29003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a29003a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a29003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- A29003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL PREDEFINED ATTRIBUTES EXCEPT DIGITS, DELTA, AND RANGE,
- -- AND ALL PREDEFINED TYPE AND PACKAGE NAMES ARE NOT RESERVED WORDS.
- 
- -- AH  8/11/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A29003A IS
-      SUBTYPE INT IS INTEGER;
- 
- -- PREDEFINED ATTRIBUTES
- 
-      ADDRESS           : INT := IDENT_INT(0);        -- ATTRIBUTE
-      AFT               : INT := IDENT_INT(0);        -- ATTRIBUTE
-      BASE              : INT := IDENT_INT(0);        -- ATTRIBUTE
-      CALLABLE          : INT := IDENT_INT(0);        -- ATTRIBUTE
-      CONSTRAINED       : INT := IDENT_INT(0);        -- ATTRIBUTE
-      COUNT             : INT := IDENT_INT(0);        -- ATTRIBUTE
-      EMAX              : INT := IDENT_INT(0);        -- ATTRIBUTE
-      EPSILON           : INT := IDENT_INT(0);        -- ATTRIBUTE
-      FIRST             : INT := IDENT_INT(0);        -- ATTRIBUTE
-      FIRST_BIT         : INT := IDENT_INT(0);        -- ATTRIBUTE
-      FORE              : INT := IDENT_INT(0);        -- ATTRIBUTE
-      IMAGE             : INT := IDENT_INT(0);        -- ATTRIBUTE
-      LARGE             : INT := IDENT_INT(0);        -- ATTRIBUTE
-      LAST              : INT := IDENT_INT(0);        -- ATTRIBUTE
-      LAST_BIT          : INT := IDENT_INT(0);        -- ATTRIBUTE
-      LENGTH            : INT := IDENT_INT(0);        -- ATTRIBUTE
-      MACHINE_EMAX      : INT := IDENT_INT(0);        -- ATTRIBUTE
-      MACHINE_EMIN      : INT := IDENT_INT(0);        -- ATTRIBUTE
-      MACHINE_MANTISSA  : INT := IDENT_INT(0);        -- ATTRIBUTE
-      MACHINE_OVERFLOWS : INT := IDENT_INT(0);        -- ATTRIBUTE
-      MACHINE_RADIX     : INT := IDENT_INT(0);        -- ATTRIBUTE
-      MACHINE_ROUNDS    : INT := IDENT_INT(0);        -- ATTRIBUTE
-      MANTISSA          : INT := IDENT_INT(0);        -- ATTRIBUTE
-      POS               : INT := IDENT_INT(0);        -- ATTRIBUTE
-      POSITION          : INT := IDENT_INT(0);        -- ATTRIBUTE
-      PRED              : INT := IDENT_INT(0);        -- ATTRIBUTE
-      SAFE_EMAX         : INT := IDENT_INT(0);        -- ATTRIBUTE
-      SAFE_LARGE        : INT := IDENT_INT(0);        -- ATTRIBUTE
-      SAFE_SMALL        : INT := IDENT_INT(0);        -- ATTRIBUTE
-      SIZE              : INT := IDENT_INT(0);        -- ATTRIBUTE
-      SMALL             : INT := IDENT_INT(0);        -- ATTRIBUTE
-      STORAGE_SIZE      : INT := IDENT_INT(0);        -- ATTRIBUTE
-      SUCC              : INT := IDENT_INT(0);        -- ATTRIBUTE
-      TERMINATED        : INT := IDENT_INT(0);        -- ATTRIBUTE
-      VAL               : INT := IDENT_INT(0);        -- ATTRIBUTE
-      VALUE             : INT := IDENT_INT(0);        -- ATTRIBUTE
-      WIDTH             : INT := IDENT_INT(0);        -- ATTRIBUTE
- 
- -- PREDEFINED TYPES
- 
-      BOOLEAN   : INT := IDENT_INT(0);                -- TYPE
-      CHARACTER : INT := IDENT_INT(0);                -- TYPE
-      DURATION  : INT := IDENT_INT(0);                -- TYPE
-      FLOAT     : INT := IDENT_INT(0);                -- TYPE
-      INTEGER   : INT := IDENT_INT(0);                -- TYPE
-      NATURAL   : INT := IDENT_INT(0);                -- TYPE
-      POSITIVE  : INT := IDENT_INT(0);                -- TYPE
-      STRING    : INT := IDENT_INT(0);                -- TYPE
- 
- -- PREDEFINED PACKAGE NAMES
- 
-      ASCII                  : INT := IDENT_INT(0);     -- PACKAGE
-      CALENDAR               : INT := IDENT_INT(0);     -- PACKAGE
-      DIRECT_IO              : INT := IDENT_INT(0);     -- PACKAGE
-      IO_EXCEPTIONS          : INT := IDENT_INT(0);     -- PACKAGE
-      LOW_LEVEL_IO           : INT := IDENT_INT(0);     -- PACKAGE
-      MACHINE_CODE           : INT := IDENT_INT(0);     -- PACKAGE
-      SEQUENTIAL_IO          : INT := IDENT_INT(0);     -- PACKAGE
-      SYSTEM                 : INT := IDENT_INT(0);     -- PACKAGE
-      TEXT_IO                : INT := IDENT_INT(0);     -- PACKAGE
-      UNCHECKED_CONVERSION   : INT := IDENT_INT(0);     -- PACKAGE
-      UNCHECKED_DEALLOCATION : INT := IDENT_INT(0);     -- PACKAGE
- 
- BEGIN
-      TEST("A29003A", "NO ADDITIONAL RESERVED WORDS");
-      RESULT;
- END A29003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a2a031a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a2a031a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a2a031a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a2a031a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- A2A031A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXCLAMATION MARK CAN REPLACE A VERTICAL BAR WHEN THE
- -- VERTICAL BAR IS USED AS A SEPARATOR.
- 
- -- CONTEXTS ARE:
- --   AS A CHOICE IN A VARIANT PART
- --   IN A DISCRIMINANT CONSTRAINT
- --   IN A CASE STATEMENT CHOICE
- --   IN AN AGGREGATE
- --   IN AN EXCEPTION HANDLER.
- 
- -- JBG 5/25/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A2A031A IS
- 
-      TYPE ENUM IS (E1, E2, E3);
-      TYPE REC (A, B : ENUM) IS
-           RECORD
-                C : INTEGER;
-                CASE A IS
-                     WHEN E1 ! E2 =>     -- CHOICE OF VARIANT.
-                          D : INTEGER;
-                     WHEN E3 =>
-                          E : FLOAT;
-                END CASE;
-           END RECORD;
- 
-      EX1, EX2, EX3 : EXCEPTION;
- 
-      VAR  : REC (A!B => E2);            -- DISCRIMINANT CONSTRAINT.
- 
-      EVAR : ENUM := E2;
- 
- BEGIN
- 
-      TEST ("A2A031A", "CHECK USE OF ! AS SEPARATOR IN PLACE OF |");
- 
-      CASE EVAR IS
-           WHEN E3 => NULL;
-           WHEN E2!E1 => NULL;           -- CASE STATEMENT CHOICE.
-      END CASE;
- 
-      VAR := (A!B => E2, C ! D => 0);    -- AGGREGATE.
- 
-      RESULT;
- EXCEPTION
-      WHEN EX1!EX2 ! EX3 => NULL;        -- EXCEPTION HANDLER.
- END A2A031A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a33003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a33003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a33003a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a33003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,49 ****
- -- A33003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FOLLOWING FORMS OF ALMOST RECURSIVE TYPES CAN BE
- -- DECLARED:
- --     A) A RECORD HAVING A COMPONENT OF AN ACCESS TYPE WHOSE DESIGNATED
- --        TYPE IS THE RECORD TYPE;
- 
- -- TBN  10/6/86
- -- DTN 11/12/91     DELETED SUBPARTS (B and C).
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A33003A IS
- 
-      TYPE REC;
-      TYPE ACC_REC IS ACCESS REC;
-      TYPE REC IS
-           RECORD
-                A : INTEGER;
-                B : ACC_REC;
-           END RECORD;
- 
- BEGIN
-      TEST ("A33003A", "CHECK THAT ALMOST RECURSIVE TYPES CAN BE " &
-                       "DECLARED");
- 
-      RESULT;
- END A33003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a34017c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a34017c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a34017c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a34017c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- A34017C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A DERIVED TYPE DEFINITION IS GIVEN IN THE VISIBLE PART
- -- OF A PACKAGE, THE TYPE MAY BE USED AS THE PARENT TYPE IN A DERIVED
- -- TYPE DEFINITION IN THE PRIVATE PART OF THE PACKAGE AND IN THE BODY.
- 
- -- CHECK THAT IF A TYPE IS DECLARED IN THE VISIBLE PART OF A PACKAGE,
- -- AND IS NOT A DERIVED TYPE OR A PRIVATE TYPE, IT MAY BE USED AS THE
- -- PARENT TYPE IN A DERIVED TYPE DEFINITION IN THE VISIBLE PART, PRIVATE
- -- PART, AND BODY.
- 
- 
- -- DSJ 4/27/83
- 
- 
- WITH REPORT;
- PROCEDURE A34017C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "A34017C", "CHECK THAT A DERIVED TYPE MAY BE USED AS A " &
-                       "PARENT TYPE IN THE PRIVATE PART AND BODY.  " &
-                       "CHECK THAT OTHER TYPES MAY BE USED AS PARENT " &
-                       "TYPES IN VISIBLE PART ALSO");
- 
-      DECLARE
- 
-           TYPE REC IS
-                RECORD
-                     C : INTEGER;
-                END RECORD;
- 
-           PACKAGE PACK1 IS
- 
-                TYPE T1 IS RANGE 1 .. 10;
-                TYPE T2 IS NEW REC;
- 
-                TYPE T3 IS (A,B,C);
-                TYPE T4 IS ARRAY ( 1 .. 2 ) OF INTEGER;
-                TYPE T5 IS
-                     RECORD
-                          X : CHARACTER;
-                     END RECORD;
-                TYPE T6 IS ACCESS INTEGER;
- 
-                TYPE N1 IS NEW T3;
-                TYPE N2 IS NEW T4;
-                TYPE N3 IS NEW T5;
-                TYPE N4 IS NEW T6;
- 
-           PRIVATE
- 
-                TYPE P1 IS NEW T1;
-                TYPE P2 IS NEW T2;
-                TYPE P3 IS NEW T3;
-                TYPE P4 IS NEW T4;
-                TYPE P5 IS NEW T5;
-                TYPE P6 IS NEW T6;
- 
-           END PACK1;
- 
-           PACKAGE BODY PACK1 IS
-      
-                TYPE Q1 IS NEW T1;
-                TYPE Q2 IS NEW T2;
-                TYPE Q3 IS NEW T3;
-                TYPE Q4 IS NEW T4;
-                TYPE Q5 IS NEW T5;
-                TYPE Q6 IS NEW T6;
- 
-           END PACK1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END A34017C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35101b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35101b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35101b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35101b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- A35101B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ONE ENUMERATION LITERAL IS PERMITTED IN AN ENUMERATION
- -- TYPE DEFINITION.
- 
- -- RJW 2/14/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE A35101B IS
- 
- BEGIN
- 
-      TEST ("A35101B", "CHECK THAT ONE ENUMERATION LITERAL IS " &
-                       "PERMITTED IN AN ENUMERATION TYPE " &
-                       "DEFINITION" );
-      DECLARE
- 
-           TYPE E1 IS (A);                         -- OK.
-           TYPE E2 IS ('1');                       -- OK.
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END A35101B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35402a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35402a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35402a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- A35402A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF AN INTEGER TYPE DEFINITION NEED NOT 
- -- HAVE THE SAME INTEGER TYPE.
- 
- -- RJW 2/20/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE A35402A IS
- 
- BEGIN
- 
-      TEST ( "A35402A", "CHECK THAT THE BOUNDS OF AN INTEGER " &
-                        "TYPE DEFINITION NEED NOT HAVE THE SAME " &
-                        "INTEGER TYPE" );
- 
-      DECLARE     
-           TYPE INT1 IS RANGE 1 .. 10;
-           TYPE INT2 IS RANGE 2 .. 8;
-           TYPE INT3 IS NEW INTEGER;
-      
-           I  : CONSTANT INTEGER   := 5;
-           I1 : CONSTANT INT1      := 5;
-           I2 : CONSTANT INT2      := 5;
-           I3 : CONSTANT INT3      := 5;
-      
-           TYPE INTRANGE1 IS RANGE I  .. I1;          -- OK.
- 
-           TYPE INTRANGE2 IS RANGE I1 .. I2;          -- OK.
- 
-           TYPE INTRANGE3 IS RANGE I2 .. I3;          -- OK.
-           
-           TYPE INTRANGE4 IS RANGE I3 .. I;           -- OK.
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END A35402A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35801f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35801f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35801f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35801f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- A35801F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES FIRST AND LAST RETURN VALUES HAVING THE
- -- SAME BASE TYPE AS THE PREFIX WHEN THE PREFIX IS A FLOATING POINT
- -- TYPE.
- 
- -- THIS CHECK IS PROVIDED THROUGH THE USE OF THIS TEST IN CONJUNCTION
- -- WITH TEST B35801C.
- 
- -- R.WILLIAMS 8/21/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A35801F IS
- 
-      TYPE REAL IS DIGITS 3 RANGE -100.0 .. 100.0;
-      SUBTYPE SURREAL IS REAL RANGE -50.0 .. 50.0;
- 
-      TYPE NFLT IS NEW FLOAT;
-      SUBTYPE UNIT IS NFLT RANGE -1.0 .. 1.0;     
- 
-      SUBTYPE EMPTY IS FLOAT RANGE 1.0 .. -1.0;
- 
-      R1 : REAL := SURREAL'FIRST;       -- OK.
-      R2 : REAL := SURREAL'LAST;        -- OK.
- 
-      N1 : NFLT := UNIT'FIRST;          -- OK.
-      N2 : NFLT := UNIT'LAST;           -- OK.
- 
-      F1 : FLOAT := FLOAT'FIRST;        -- OK.
-      F2 : FLOAT := FLOAT'LAST;         -- OK.
- 
-      E1 : FLOAT := EMPTY'FIRST;        -- OK.
-      E2 : FLOAT := EMPTY'LAST;         -- OK.
- 
- BEGIN
-      TEST ( "A35801F", "CHECK THAT THE ATTRIBUTES FIRST AND LAST " &
-                        "RETURN VALUES HAVING THE SAME BASE TYPE AS " &
-                        "THE PREFIX WHEN THE PREFIX IS A FLOATING " &
-                        "POINT TYPE" );
- 
-      RESULT;
- END A35801F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35902c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35902c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a35902c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a35902c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- A35902C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FIXED POINT TYPE WITH ONLY ONE MODEL NUMBER IS
- --     ALLOWED.
- 
- -- HISTORY:
- --     RJW 02/26/86 CREATED ORIGINAL TEST.
- --     DHH 10/15/87 CORRECTED RANGE ERRORS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE A35902C IS
- 
- BEGIN
- 
-      TEST ("A35902C", "CHECK THAT A FIXED POINT TYPE WITH ONLY ONE " &
-                       "MODEL NUMBER IS ALLOWED" );
-      DECLARE
-           TYPE F IS DELTA 1.0 RANGE -0.5 .. 0.5;   -- OK.
-           F1 : F := 0.0;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END A35902C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a38106d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a38106d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a38106d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a38106d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- A38106D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE
- -- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON
- -- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE
- -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
- -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE
- -- INCOMPLETE TYPE.
- 
- -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES
- -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES
- -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY
- --     TYPES
- 
- -- PART 1: FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE SPECIFICATION.
- 
- -- DSJ  5/05/83
- -- SPS 10/18/83
- -- EG  12/19/83
- 
- WITH REPORT ;
- PROCEDURE A38106D IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("A38106D", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS "    &
-                     "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " &
-                     "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE "   &
-                     "ACCESS TYPE AND AFTER THE FULL DECLARATION "     &
-                     "(WHICH IS IN THE PACKAGE SPECIFICATION)") ;
- 
-      DECLARE
- 
-           PACKAGE PACK1 IS
-                TYPE T1 ;
-                TYPE T2 ;
- 
-                PACKAGE PACK2 IS
-                     TYPE ACC1 IS ACCESS T1 ;
-                     TYPE ACC2 IS ACCESS T2 ;
-                END PACK2 ;
- 
-                TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
-                TYPE T2 IS
-                     RECORD
-                          C1, C2 : INTEGER ;
-                     END RECORD ;
-           END PACK1 ;
- 
-           PACKAGE BODY PACK1 IS
-                A1 : PACK2.ACC1 := NEW T1'(2,4) ;  -- LEGAL
-                A2 : PACK2.ACC1 := NEW T1'(6,8) ;  -- LEGAL
-                R1 : PACK2.ACC2 := NEW T2'(3,5) ;  -- LEGAL
-                R2 : PACK2.ACC2 := NEW T2'(7,9) ;  -- LEGAL
- 
-                PACKAGE BODY PACK2 IS
-                     X1 : INTEGER := A1(1) ;            -- LEGAL
-                     X2 : INTEGER := A1'FIRST ;         -- LEGAL
-                     X3 : INTEGER := A1'LAST ;          -- LEGAL
-                     X4 : INTEGER := A1'LENGTH ;        -- LEGAL
-                     B1 : BOOLEAN := 3 IN A1'RANGE ;    -- LEGAL
-                     X5 : INTEGER := R1.C1 ;            -- LEGAL
-                END PACK2 ;
- 
-           END PACK1 ;
- 
-      BEGIN
- 
-           NULL ;
- 
-      END ;
- 
-      RESULT ;
- 
- END A38106D ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a38106e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a38106e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a38106e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a38106e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- A38106E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE
- -- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON
- -- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE
- -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
- -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE
- -- INCOMPLETE TYPE.
- 
- -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES
- -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES
- -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY
- --     TYPES
- 
- -- PART 2 : FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE BODY
- 
- -- DSJ  5/05/83
- -- SPS 10/18/83
- -- EG  12/19/83
- 
- WITH REPORT ;
- PROCEDURE A38106E IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("A38106E", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS " &
-                     "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " &
-                     "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE "   &
-                     "ACCESS TYPE AND AFTER THE FULL DECLARATION "     &
-                     "(WHICH IS IN THE PACKAGE BODY)");
- 
-      DECLARE
- 
-           PACKAGE PACK1 IS
-           PRIVATE
-                TYPE T1 ;
-                TYPE T2 ;
-                PACKAGE PACK2 IS
-                     TYPE ACC1 IS ACCESS T1 ;
-                     TYPE ACC2 IS ACCESS T2 ;
-                END PACK2 ;
-           END PACK1 ;
- 
-           PACKAGE BODY PACK1 IS
-                TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
-                TYPE T2 IS
-                     RECORD
-                          C1, C2 : INTEGER ;
-                     END RECORD ;
- 
-                A1 : PACK2.ACC1 := NEW T1'(2,4) ;  -- LEGAL
-                A2 : PACK2.ACC1 := NEW T1'(6,8) ;  -- LEGAL
-                R1 : PACK2.ACC2 := NEW T2'(3,5) ;  -- LEGAL
-                R2 : PACK2.ACC2 := NEW T2'(7,9) ;  -- LEGAL
- 
-                PACKAGE BODY PACK2 IS
-                     X1 : INTEGER := A1(1) ;            -- LEGAL
-                     X2 : INTEGER := A1'FIRST ;         -- LEGAL
-                     X3 : INTEGER := A1'LAST ;          -- LEGAL
-                     X4 : INTEGER := A1'LENGTH ;        -- LEGAL
-                     B1 : BOOLEAN := 3 IN A1'RANGE ;    -- LEGAL
-                     X5 : INTEGER := R1.C1 ;            -- LEGAL
-                END PACK2 ;
- 
-           END PACK1 ;
- 
-      BEGIN
- 
-           NULL ;
- 
-      END ;
- 
-      RESULT ;
- 
- END A38106E ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a49027a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a49027a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a49027a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a49027a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- A49027A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --   CHECK THAT A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE AND 
- --   STATIC IN THE CORRESPONDING INSTANCE.
- --   CHECK THAT FOR A GENERIC INSTANTIATION, IF THE ACTUAL PARAMETER
- --   IS A STATIC SUBTYPE, THEN EVERY USE OF THE CORRESPONDING FORMAL
- --   PARAMETER WITHIN THE INSTANCE IS CONSIDERED TO DENOTE A STATIC
- --   SUBTYPE
- --
- -- THIS IS A TEST BASED ON AI-00409/05-BI-WJ.
- 
- -- HISTORY:
- --         EDWARD V. BERARD, 27 AUGUST 1990
- --         CJJ   10 OCT 1990  TEST OBJECTIVE CHANGED TO REFLECT AIG 
- --                            OBJECTIVE.
- 
- WITH REPORT ;
- 
- PROCEDURE A49027A IS
- 
- BEGIN  -- A49027A
- 
-     REPORT.TEST ("A49027A", "CHECK THAT A SUBTYPE CAN BE NONSTATIC " &
-                  "IN A GENERIC TEMPLATE AND STATIC IN THE " &
-                  "CORRESPONDING INSTANCE.") ;
-                  
-     LOCAL_BLOCK:
-     
-     DECLARE
-     
-         TYPE NUMBER IS RANGE 1 .. 10 ;
-         
-         GENERIC
-         
-             TYPE NUMBER_TYPE IS RANGE <> ;
-             
-         PACKAGE STATIC_TEST IS
-         
-             TYPE NEW_NUMBER_TYPE IS NEW NUMBER_TYPE ;
-             SUBTYPE SUB_NUMBER_TYPE IS NUMBER_TYPE ;
- 
-         END STATIC_TEST ;
-         
-         PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST
-                                     (NUMBER_TYPE => NUMBER) ;
-                                     
-         TYPE ANOTHER_NUMBER IS RANGE 
-                 NEW_STATIC_TEST.NEW_NUMBER_TYPE'FIRST ..
-                 NEW_STATIC_TEST.NEW_NUMBER_TYPE'LAST ;
-         
-         TYPE YET_ANOTHER_NUMBER IS RANGE 
-                 NEW_STATIC_TEST.SUB_NUMBER_TYPE'FIRST ..
-                 NEW_STATIC_TEST.SUB_NUMBER_TYPE'LAST ;
-         
-     BEGIN  -- LOCAL_BLOCK
-     
-         NULL ;
-         
-     END LOCAL_BLOCK ;
-     
-     REPORT.RESULT ;
-     
- END A49027A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a49027b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a49027b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a49027b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a49027b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- A49027B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --   CHECK THAT A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE
- --   AND STATIC IN THE CORRESPONDING INSTANCE.
- 
- --   CHECK THAT IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE
- --   CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE,
- --   THEN EACH USE OF THE FORMAL PARAMETERS IN THE INSTANCE IS SAID TO
- --   BE STATIC.
- --
- --   A NAME DENOTING A CONSTANT DECLARED IN A GENERIC INSTANCE IS
- --   ALLOWED AS A PRIMARY IN A STATIC EXPRESSION IF THE CONSTANT
- --   IS DECLARED BY A CONSTANT DECLARATION WITH A STATIC SUBTYPE
- --   AND INITIALIZED WITH A STATIC EXPRESSION.
- --
- --   THIS IS A TEST BASED ON AI-00505/03-BI-WA.
- 
- -- HISTORY:
- --         EDWARD V. BERARD, 27 AUGUST 1990
- --         DAS   8 OCT 90   ADDED CODE TO MATCH EXAMPLE 1 IN
- --                          AI-00505.
- --         JRL 05/29/92  CORRECTED MINOR PROBLEM IN REPORT.TEST STRING.
- --         JRL 02/18/93  EXPANDED TEXT OF REPORT.TEST STRING.
- --         PWN 04/14/95  CORRECTED MINOR COPYRIGHT COMMENT PROBLEM.
- 
- 
- WITH REPORT ;
- 
- PROCEDURE A49027B IS
- 
- BEGIN  -- A49027B
- 
-      REPORT.TEST ("A49027B", "CHECK THAT IF A GENERIC ACTUAL " &
-                   "PARAMETER IS A STATIC EXPRESSION AND THE " &
-                   "CORRESPONDING FORMAL PARAMETER HAS A STATIC " &
-                   "SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " &
-                   "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE " &
-                   "STATIC. CHECK THAT A NAME DENOTING A CONSTANT " &
-                   "DECLARED IN A GENERIC INSTANCE IS ALLOWED AS " &
-                   "A PRIMARY IN A STATIC EXPRESSION IF THE " &
-                   "CONSTANT IS DECLARED BY A CONSTANT DECLARATION " &
-                   "WITH A STATIC SUBTYPE AND INITIALIZED WITH A " &
-                   "STATIC EXPRESSION. (AI-00505)");
- 
-      LOCAL_BLOCK:
- 
-      DECLARE
- 
-           TYPE NUMBER IS RANGE 1 .. 10 ;
-           TYPE COLOR IS (RED, ORANGE, YELLOW, GREEN, BLUE) ;
-           MIDDLE_COLOR : CONSTANT COLOR := GREEN ;
- 
-           ENUMERATED_VALUE : COLOR := COLOR'LAST ;
- 
-           GENERIC
- 
-                TYPE NUMBER_TYPE IS RANGE <> ;
-                X : INTEGER ;
-                TYPE ENUMERATED IS (<>) ;
- 
-                FIRST_NUMBER            : IN NUMBER_TYPE ;
-                SECOND_NUMBER           : IN NUMBER_TYPE ;
-                THIRD_NUMBER            : IN NUMBER_TYPE ;
-                FIRST_ENUMERATED        : IN ENUMERATED ;
-                SECOND_ENUMERATED       : IN ENUMERATED ;
-                THIRD_ENUMERATED        : IN ENUMERATED ;
- 
-                FIRST_INTEGER_VALUE     : IN INTEGER ;
-                SECOND_INTEGER_VALUE    : IN INTEGER ;
- 
-           PACKAGE STATIC_TEST IS
- 
-                Y : CONSTANT INTEGER := X;
-                Z : CONSTANT NUMBER_TYPE := 5;
- 
-                SUBTYPE FIRST_NUMBER_SUBTYPE IS NUMBER_TYPE
-                    RANGE FIRST_NUMBER .. SECOND_NUMBER ;
-                SUBTYPE SECOND_NUMBER_SUBTYPE IS NUMBER_TYPE
-                    RANGE FIRST_NUMBER .. THIRD_NUMBER ;
- 
-                SUBTYPE FIRST_ENUMERATED_SUBTYPE IS ENUMERATED
-                    RANGE FIRST_ENUMERATED .. SECOND_ENUMERATED ;
-                SUBTYPE SECOND_ENUMERATED_SUBTYPE IS ENUMERATED
-                    RANGE FIRST_ENUMERATED .. THIRD_ENUMERATED ;
- 
-                SUBTYPE THIRD_NUMBER_TYPE IS INTEGER
-                    RANGE FIRST_INTEGER_VALUE .. SECOND_INTEGER_VALUE ;
- 
-           END STATIC_TEST ;
- 
-           PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST
-                    (NUMBER_TYPE            => NUMBER,
-                     X                      => 3,
-                     ENUMERATED             => COLOR,
-                     FIRST_NUMBER           => NUMBER'FIRST,
-                     SECOND_NUMBER          => NUMBER'LAST,
-                     THIRD_NUMBER           => NUMBER'SUCC(NUMBER'FIRST),
-                     FIRST_ENUMERATED       => RED,
-                     SECOND_ENUMERATED      => MIDDLE_COLOR,
-                     THIRD_ENUMERATED       => COLOR'VAL (1),
-                     FIRST_INTEGER_VALUE    => COLOR'POS (YELLOW),
-                     SECOND_INTEGER_VALUE   => NUMBER'POS (5)) ;
- 
-           TYPE T1 IS RANGE 1 .. NEW_STATIC_TEST.Y;
-           TYPE T2 IS RANGE 1 .. NEW_STATIC_TEST.Z;
- 
-           TYPE ANOTHER_NUMBER IS RANGE
-                    NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'FIRST ..
-                    NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'LAST ;
- 
-           TYPE YET_ANOTHER_NUMBER IS RANGE
-                    NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'FIRST ..
-                    NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'LAST ;
- 
-           TYPE STILL_ANOTHER_NUMBER IS RANGE
-                    NEW_STATIC_TEST.THIRD_NUMBER_TYPE'FIRST ..
-                    NEW_STATIC_TEST.THIRD_NUMBER_TYPE'LAST ;
- 
-      BEGIN  -- LOCAL_BLOCK
- 
-           CASE ENUMERATED_VALUE IS
-                 WHEN YELLOW      => NULL ;
-                 WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'FIRST
-                                  => NULL ;
-                 WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'LAST
-                                  => NULL ;
-                 WHEN NEW_STATIC_TEST.SECOND_ENUMERATED_SUBTYPE'LAST
-                                  => NULL ;
-                 WHEN COLOR'LAST  => NULL ;
-           END CASE ;
- 
-      END LOCAL_BLOCK ;
- 
-      REPORT.RESULT ;
- 
- END A49027B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a49027c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a49027c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a49027c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a49027c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- A49027C.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --   CHECK THAT IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE
- --   CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE,
- --   THEN EACH USE OF THE FORMAL PARAMETER IN THE INSTANCE IS SAID TO
- --   BE STATIC.
- --
- --   SEE AI-00505.  THIS TEST IS TAKEN FROM THE SECOND EXAMPLE.
- --
- -- HISTORY:
- --   DAS  8 OCT 90   INITIAL VERSION.
- --   PWN  12/01/95   CORRECTED FORMAT OF CALL TO REPORT.TEST
- --   KAS  25NOV96    CHANGED LITERAL 7 TO (IMPDEF.CHAR_BITS-1)
- --!
- 
- WITH REPORT; USE REPORT;
- WITH IMPDEF;
- 
- PROCEDURE A49027C IS
- 
-      GENERIC
-           X : INTEGER;
-      PACKAGE GP IS
-           TYPE REC IS
-                RECORD
-                     C : STRING (1..X);
-                END RECORD;
-      END GP;
- 
-      PACKAGE NP IS NEW GP (1);
- 
-      TYPE NR IS NEW NP.REC;
-      FOR NR USE
-           RECORD
-                C AT 0 RANGE 0..IMPDEF.CHAR_BITS-1; -- SUBTYPE INDICATION
-           END RECORD;             -- FOR C IN NP IS CONSIDERED STATIC.
- 
- BEGIN
-      TEST("A49027C", "CHECK THAT IF A GENERIC PARAMETER IS A STATIC " &
-           "EXPRESSION AND THE CORRESPONDING (IN) PARAMETER HAS A " &
-           "STATIC SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " &
-           "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE STATIC.");
- 
-      RESULT;
- 
- END A49027C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a54b01a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a54b01a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a54b01a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a54b01a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- A54B01A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A CASE EXPRESSION IS A CONSTANT, VARIABLE,
- --    TYPE CONVERSION, OR QUALIFIED EXPRESSION,
- --    AND THE SUBTYPE OF THE
- --    EXPRESSION IS STATIC, AN  'OTHERS'  CAN BE OMITTED IF ALL
- --    VALUES IN THE SUBTYPE'S RANGE ARE COVERED.
- 
- 
- -- RM 01/23/80
- -- SPS 10/26/82
- -- SPS 2/1/83
- 
- WITH REPORT ;
- PROCEDURE  A54B01A  IS
- 
-      USE REPORT ;
- 
- BEGIN                                                       
- 
-      TEST("A54B01A" , "CHECK THAT IF" &
-                       " THE SUBTYPE OF A CASE EXPRESSION IS STATIC," &
-                       " AN  'OTHERS'  CAN BE OMITTED IF ALL" &
-                       " VALUES IN THE SUBTYPE'S RANGE ARE COVERED" );
- 
-      -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER:
-      --
-      --    I.   CONSTANTS
-      --
-      --    II.  STATIC SUBRANGES
-      --
-      --         (A)    VARIABLES (INTEGER , BOOLEAN)
-      --         (B)    QUALIFIED EXPRESSIONS
-      --         (C)    TYPE CONVERSIONS
- 
-      DECLARE  -- CONSTANTS
-           T : CONSTANT BOOLEAN := TRUE;
-           FIVE : CONSTANT INTEGER := IDENT_INT(5);
-      BEGIN
- 
-           CASE  FIVE  IS
-                WHEN  INTEGER'FIRST..4  =>  NULL ;
-                WHEN  5                 =>  NULL ; 
-                WHEN  6 .. INTEGER'LAST =>  NULL ; 
-           END CASE;                                         
-                                                             
-           CASE  T  IS
-                WHEN  TRUE              =>  NULL ;
-                WHEN  FALSE             =>  NULL ;
-           END CASE;
- 
-      END ;
- 
- 
-      DECLARE   --  STATIC SUBRANGES
-           
-           SUBTYPE  STAT  IS  INTEGER RANGE 1..5 ;
-           I   : INTEGER RANGE 1..5 ;
-           J   : STAT ;
-           BOOL: BOOLEAN := FALSE ;
-           CHAR: CHARACTER := 'U' ;
-           TYPE  ENUMERATION  IS  ( FIRST,SECOND,THIRD,FOURTH,FIFTH );
-           ENUM: ENUMERATION := THIRD ;
- 
- 
-      BEGIN
- 
-           I  :=  IDENT_INT( 2 );
-           J  :=  IDENT_INT( 2 );
- 
-           CASE  I  IS
-                WHEN  1 | 3 | 5  =>  NULL ;
-                WHEN  2 | 4      =>  NULL ;
-           END CASE;
- 
-           CASE  BOOL  IS
-                WHEN  TRUE   =>  NULL ;
-                WHEN  FALSE  =>  NULL ;
-           END CASE;
- 
-           CASE  STAT'( 2 )  IS
-                WHEN  5 | 2..4  =>  NULL ;
-                WHEN  1         =>  NULL ;
-           END CASE;
- 
-           CASE  STAT( J )  IS
-                WHEN  5 | 2..4  =>  NULL ;
-                WHEN  1         =>  NULL ;
-           END CASE;
- 
- 
-      END ;     --  STATIC SUBRANGES
- 
-      RESULT ;
- 
- 
- END A54B01A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a54b02a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a54b02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a54b02a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a54b02a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- A54B02A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A CASE EXPRESSION IS A VARIABLE, CONSTANT, TYPE 
- --    CONVERSION, ATTRIBUTE (IN PARTICULAR 'FIRST AND 'LAST),
- --    FUNCTION INVOCATION, QUALIFIED EXPRESSION, OR A PARENTHESIZED
- --    EXPRESSION HAVING ONE OF THESE FORMS, AND THE SUBTYPE OF THE
- --    EXPRESSION IS NON-STATIC, AN  'OTHERS'  CAN BE OMITTED IF ALL
- --    VALUES IN THE BASE TYPE'S RANGE ARE COVERED.
- 
- -- RM 01/27/80
- -- SPS 10/26/82
- -- SPS 2/2/83
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT ;
- PROCEDURE  A54B02A  IS
- 
-      USE REPORT ;
- 
- BEGIN                                                       
- 
-      TEST("A54B02A" , "CHECK THAT IF THE" &
-                       " SUBTYPE OF A CASE EXPRESSION IS NON-STATIC," &
-                       " AN  'OTHERS'  CAN BE OMITTED IF ALL" &
-                       " VALUES IN THE BASE TYPE'S RANGE ARE COVERED" );
- 
-      -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER:
-      --
-      --         (A)    VARIABLES (INTEGER , BOOLEAN)
-      --         (B)    CONSTANTS (INTEGER, BOOLEAN)
-      --         (C)    ATTRIBUTES ('FIRST, 'LAST)    
-      --         (D)    FUNCTION CALLS
-      --         (E)    QUALIFIED EXPRESSIONS
-      --         (F)    TYPE CONVERSIONS
-      --         (G)    PARENTHESIZED EXPRESSIONS OF THE ABOVE KINDS
- 
- 
-      DECLARE   --  NON-STATIC RANGES
-           
-           SUBTYPE  STAT   IS  INTEGER RANGE 1..50 ;
-           SUBTYPE  DYN    IS  STAT    RANGE 1..IDENT_INT( 5 ) ;
-           I   : STAT RANGE 1..IDENT_INT( 5 );
-           J   : DYN ;
-           SUBTYPE  DYNCHAR  IS
-                 CHARACTER RANGE ASCII.NUL .. IDENT_CHAR('Q');
-           SUBTYPE  STATCHAR  IS
-                 DYNCHAR RANGE 'A' .. 'C' ;
-           CHAR: DYNCHAR := 'F' ;
-           TYPE  ENUMERATION  IS  ( A,B,C,D,E,F,G,H,K,L,M,N );
-           SUBTYPE  STATENUM  IS
-                 ENUMERATION RANGE  A .. L ;
-           SUBTYPE  DYNENUM  IS
-                 STATENUM  RANGE  A .. ENUMERATION'VAL(IDENT_INT(5));
-           ENUM: DYNENUM := B ;
-           CONS : CONSTANT DYN := 3;
- 
-           FUNCTION  FF  RETURN DYN  IS
-           BEGIN
-                RETURN  2 ;
-           END  FF ;
- 
-      BEGIN
- 
-           I  :=  IDENT_INT( 2 );
-           J  :=  IDENT_INT( 2 );
- 
-           CASE  I  IS
-                WHEN  1 | 3 | 5  =>  NULL ;
-                WHEN  2 | 4      =>  NULL ;
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-           END CASE;
- 
-           CASE  J  IS
-                WHEN  1 | 3 | 5  =>  NULL ;
-                WHEN  2 | 4      =>  NULL ;
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-           END CASE;
- 
-           CASE CONS IS
-                WHEN  INTEGER'FIRST..INTEGER'LAST  =>  NULL;
-           END CASE;
- 
-           CASE DYN'FIRST IS
-                WHEN INTEGER'FIRST..0  =>  NULL;
-                WHEN 1..INTEGER'LAST  =>  NULL;
-           END CASE;
- 
-           CASE STATCHAR'LAST IS
-                WHEN CHARACTER'FIRST..'A'  =>  NULL;
-                WHEN 'B'..CHARACTER'LAST  =>  NULL;
-           END CASE;
- 
-           CASE  FF  IS
-                WHEN  4..5  =>  NULL ;
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-                WHEN  1..3  =>  NULL ;
-           END CASE;
- 
-           CASE  DYN'( 2 )  IS
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-                WHEN  5 | 2..4  =>  NULL ;
-                WHEN  1         =>  NULL ;
-           END CASE;
- 
-           CASE  DYN( J )  IS
-                WHEN  5 | 2..4  =>  NULL ;
-                WHEN  1         =>  NULL ;
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-           END CASE;
- 
- 
-           CASE  ( CHAR )  IS
-                WHEN  ASCII.NUL .. 'P'  =>  NULL ;
-                WHEN  'Q'               =>  NULL ; 
-                WHEN  'R' .. 'Y'        =>  NULL ; 
-                WHEN  'Z' .. CHARACTER'LAST  =>  NULL ;
-           END CASE;
- 
-           CASE  ( ENUM )  IS
-                WHEN  A | C | E  =>  NULL ;
-                WHEN  B | D      =>  NULL ;
-                WHEN  F .. L     =>  NULL ;
-                WHEN  M .. N     =>  NULL ;
-           END CASE;
- 
-           CASE  ( FF )  IS
-                WHEN  1 | 3 | 5  =>  NULL ;
-                WHEN  2 | 4      =>  NULL ;
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-           END CASE;
- 
-           CASE  ( DYN'( I ) )  IS
-                WHEN  4..5  =>  NULL ;
-                WHEN  1..3  =>  NULL ;
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-           END CASE;
- 
-           CASE  ( DYN( 2 ) )  IS
-                WHEN  5 | 2..4  =>  NULL ;
-                WHEN  1         =>  NULL ;
-                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
-           END CASE;
- 
-           CASE (CONS) IS
-                WHEN 1..100  =>  NULL;
-                WHEN INTEGER'FIRST..0  =>  NULL;
-                WHEN 101..INTEGER'LAST  =>  NULL;
-           END CASE;
- 
-           CASE (DYNCHAR'LAST) IS
-                WHEN 'B'..'Y'  =>  NULL;
-                WHEN CHARACTER'FIRST..'A'  =>  NULL;
-                WHEN 'Z'..CHARACTER'LAST  =>  NULL;
-           END CASE;
- 
-      END;
- 
- 
-      RESULT ;
- 
- 
- END A54B02A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a55b12a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a55b12a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a55b12a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a55b12a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- A55B12A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE SUBTYPE OF A LOOP PARAMETER IN A LOOP OF THE FORM
- --
- --                    FOR  I  IN  ST RANGE L..R  LOOP
- --
- --    IS CORRECTLY DETERMINED SO THAT WHEN THE LOOP PARAMETER IS USED
- --    IN A CASE STATEMENT  AN 'OTHERS' ALTERNATIVE IS NOT REQUIRED IF
- --    THE CHOICES COVER THE APPROPRIATE RANGE OF SUBTYPE VALUES.
- 
- -- CASE  A :
- --    L  AND  R  ARE BOTH STATIC EXPRESSIONS, AND  ST  IS A STATIC
- --    SUBTYPE COVERING A RANGE GREATER THAN  L..R .
- 
- 
- -- RM 02/02/80
- -- JRK 03/02/83
- 
- WITH REPORT ;
- PROCEDURE  A55B12A  IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("A55B12A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" &
-                       " IN A LOOP OF THE FORM  'FOR  I  IN  ST RANGE" &
-                       " L..R  LOOP'  IS CORRECTLY DETERMINED  (A)" );
- 
-      DECLARE
- 
-           SUBTYPE   STAT  IS       INTEGER RANGE 1..10 ;
-           TYPE  NEW_STAT  IS  NEW  INTEGER RANGE 1..10 ;
- 
-           TYPE  ENUMERATION  IS  ( A,B,C,D,E,F,G,H,K,L,M,N );
-           SUBTYPE   STAT_E  IS     ENUMERATION RANGE A..L ;
-           SUBTYPE   STAT_B  IS     BOOLEAN RANGE FALSE..TRUE ;
-           SUBTYPE   STAT_C  IS     CHARACTER RANGE 'A'..'L' ;
- 
-      BEGIN
- 
-           FOR  I  IN  STAT  RANGE  1..5  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL ;
-                     WHEN  2 | 4      =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
-           FOR  I  IN  NEW_STAT  RANGE  1..5  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL ;
-                     WHEN  2 | 4      =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
-           FOR  I  IN  INTEGER  RANGE  1..5  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL ;
-                     WHEN  2 | 4      =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  REVERSE  STAT RANGE 1..5  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL ;
-                     WHEN  2 | 4      =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  STAT_E  RANGE  A..E  LOOP
- 
-                CASE  I  IS
-                     WHEN  C..E  =>  NULL ;
-                     WHEN  A..B  =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  STAT_B  RANGE TRUE..TRUE  LOOP
- 
-                CASE  I  IS
-                     WHEN  TRUE  =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  STAT_C  RANGE 'A'..'E'  LOOP
- 
-                CASE  I  IS
-                     WHEN  'A'..'C'  =>  NULL ;
-                     WHEN  'D'..'E'  =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  STAT_C  RANGE 'E'..'B'  LOOP
- 
-                CASE  I  IS
-                     WHEN  'D'..'C'  =>  NULL ;
-                     WHEN  'E'..'B'  =>  NULL ;
-                     WHEN  'F'..'A'  =>  NULL ;
-                     WHEN  'M'..'A'  =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-      END ;
- 
-      RESULT ;
- 
- END A55B12A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a55b13a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a55b13a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a55b13a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a55b13a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- A55B13A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- USING A  CASE_STATEMENT , CHECK THAT IF  L , R  ARE LITERALS
- --    OF TYPE  T  (INTEGER, BOOLEAN, CHARACTER, USER-DEFINED
- --    ENUMERATION TYPE)  THE SUBTYPE BOUNDS ASSOCIATED WITH A
- --    LOOP OF THE FORM
- --               FOR  I  IN  L..R  LOOP
- --    ARE THE SAME AS THOSE FOR THE CORRESPONDING LOOP OF THE FORM
- --               FOR  I  IN  T RANGE L..R  LOOP   .
- 
- 
- -- RM 04/07/81
- -- SPS 3/2/83
- -- JBG 8/21/83
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT ;
- PROCEDURE  A55B13A  IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("A55B13A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER"   &
-                       " IN A LOOP OF THE FORM  'FOR  I  IN "         &
-                       " LITERAL_L .. LITERAL_R  LOOP'  IS CORRECTLY" &
-                       " DETERMINED" );
- 
-      DECLARE
- 
-           TYPE  ENUMERATION  IS  ( A,B,C,D,MIDPOINT,E,F,G,H );
-           ONE   :  CONSTANT  :=  1 ;
-           FIVE  :  CONSTANT  :=  5 ;
- 
- 
-      BEGIN
- 
- 
-           FOR  I  IN  1..5  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL ;
-                     WHEN  2 | 4      =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  REVERSE  ONE .. FIVE  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL ;
-                     WHEN  2 | 4      =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  REVERSE FALSE..TRUE  LOOP
- 
-                CASE  I  IS
-                     WHEN  FALSE  =>  NULL ;
-                     WHEN  TRUE   =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  CHARACTER'('A') .. ASCII.DEL  LOOP
- 
-                CASE  I  IS
-                     WHEN  CHARACTER'('A')..CHARACTER'('U')  =>  NULL ;
-                     WHEN  CHARACTER'('V')..ASCII.DEL  =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  CHARACTER'('A')..CHARACTER'('H')  LOOP
- 
-                CASE  I  IS
-                     WHEN  CHARACTER'('A')..CHARACTER'('D')  =>  NULL ;
-                     WHEN  CHARACTER'('E')..CHARACTER'('H')  =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  REVERSE B..H  LOOP
- 
-                CASE  I  IS
-                     WHEN  B..D      =>  NULL ;
-                     WHEN  E..H      =>  NULL ;
-                     WHEN  MIDPOINT  =>  NULL ;
-                END CASE;
- 
-           END LOOP;
- 
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END A55B13A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a55b14a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a55b14a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a55b14a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a55b14a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- A55B14A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- USING A  CASE_STATEMENT , CHECK THAT THE SUBTYPE BOUNDS ASSOCIATED
- --    WITH A LOOP OF THE FORM
- --               FOR  I  IN  ST  LOOP
- --    ARE, RESPECTIVELY,  ST'FIRST..ST'LAST WHEN ST IS STATIC.
- 
- -- RM 04/07/81
- -- SPS 3/2/83
- -- JBG 3/14/83
- 
- WITH REPORT;
- PROCEDURE  A55B14A  IS
- 
-      USE REPORT;
-      USE ASCII ;
- 
-      TYPE  ENUMERATION  IS  ( A,B,C,D,MIDPOINT,E,F,G,H );
-      SUBTYPE   ST_I  IS       INTEGER RANGE 1..5       ;
-      TYPE  NEW_ST_I  IS   NEW INTEGER RANGE 1..5       ;
-      SUBTYPE   ST_E  IS       ENUMERATION RANGE B..G   ;
-      SUBTYPE   ST_B  IS       BOOLEAN RANGE FALSE..FALSE;
-      SUBTYPE   ST_C  IS       CHARACTER RANGE 'A'..DEL ;
- 
- BEGIN
- 
-      TEST("A55B14A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER"     &
-                       " IN A LOOP OF THE FORM  'FOR  I  IN  ST  LOOP'" &
-                       " ARE CORRECTLY DETERMINED WHEN ST IS STATIC" );
- 
-      BEGIN
- 
- 
-           FOR  I  IN  ST_I  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL;
-                     WHEN  2 | 4      =>  NULL;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  NEW_ST_I  LOOP
- 
-                CASE  I  IS
-                     WHEN  1 | 3 | 5  =>  NULL;
-                     WHEN  2 | 4      =>  NULL;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  ST_B  LOOP
- 
-                CASE  I  IS
-                     WHEN  FALSE  =>  NULL;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  ST_C  LOOP
- 
-                CASE  I  IS
-                     WHEN  'A'..'U'  =>  NULL;
-                     WHEN  'V'..DEL  =>  NULL;
-                END CASE;
- 
-           END LOOP;
- 
- 
-           FOR  I  IN  ST_E  LOOP
- 
-                CASE  I  IS
-                     WHEN  B..D      =>  NULL;
-                     WHEN  E..G      =>  NULL;
-                     WHEN  MIDPOINT  =>  NULL;
-                END CASE;
- 
-           END LOOP;
- 
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END A55B14A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a71004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a71004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a71004a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a71004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- A71004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL FORMS OF DECLARATION PERMITTED IN THE PRIVATE PART OF
- -- A PACKAGE ARE INDEED ACCEPTED BY THE COMPILER. 
- -- TASKS, GENERICS, FIXED AND FLOAT DECLARATIONS ARE NOT TESTED.
- 
- -- DAT 5/6/81
- -- VKG 2/16/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE A71004A IS
- BEGIN
- 
-      TEST ("A71004A", "ALL FORMS OF DECLARATIONS IN PRIVATE PART");
- 
-      DD:
-      DECLARE
- 
-           PACKAGE P1 IS
- 
-                TYPE P IS PRIVATE;
-                TYPE L IS LIMITED PRIVATE;
-                CP : CONSTANT P;
-                CL : CONSTANT L;
- 
-           PRIVATE
- 
-                ONE : CONSTANT := 1;
-                TWO : CONSTANT := ONE * 1.0 + 1.0;
-                N1, N2, N3 : CONSTANT := TWO;
-                TYPE I IS RANGE -10 .. 10;
-                X4, X5 : CONSTANT I := I(IDENT_INT(3));
-                X6, X7 : I := X4 + X5;
-                TYPE AR IS ARRAY (I) OF L;
- 
-                X10 : ARRAY (IDENT_INT(1) .. IDENT_INT (10)) OF I;
-                X11 : CONSTANT ARRAY (1..10) OF I := (1..10=>3);
-                TYPE T3 IS (E12);
-                TYPE T4 IS NEW T3;
- 
-                TYPE REC1 (D:BOOLEAN:=TRUE) IS RECORD NULL; END RECORD;
-                SUBTYPE  REC1TRUE  IS  REC1( D => TRUE ) ;
-                TYPE L IS NEW REC1TRUE ;
-                X8 , X9 : AR;
-                TYPE  A6  IS  ACCESS REC1 ;
-                SUBTYPE  L1  IS  L ;
-                SUBTYPE  A7  IS  A6(D=>TRUE);
-                SUBTYPE I14 IS I RANGE 1 .. 1;
-                TYPE UA1 IS ARRAY (I14 RANGE <> ) OF I14;
-                TYPE UA2 IS NEW UA1;
-                USE STANDARD.ASCII;
- 
-                PROCEDURE P1 ;
- 
-                FUNCTION F1 (X : UA1) RETURN UA1;
- 
-                FUNCTION "+" (X : UA1) RETURN UA1;
- 
-                PACKAGE  PK IS
-                PRIVATE
-                END;
- 
-                PACKAGE PK1 IS
-                     PACKAGE PK2 IS END;
-                PRIVATE
-                     PACKAGE PK3 IS PRIVATE END;
-                END PK1;
- 
-                EX : EXCEPTION;
-                EX1, EX2 : EXCEPTION;
-                X99 : I RENAMES X7;
-                EX3 : EXCEPTION RENAMES EX1;
-                PACKAGE PQ1 RENAMES DD.P1;
-                PACKAGE PQ2 RENAMES PK1;
-                PACKAGE PQ3 RENAMES PQ2 . PK2;
-                FUNCTION "-" (X : UA1) RETURN UA1 RENAMES "+";
-                PROCEDURE P98 RENAMES P1;
-                TYPE P IS NEW L;
-                CP : CONSTANT P := (D=> TRUE);
-                CL : CONSTANT L := L(CP);
- 
-           END P1;
- 
-           PACKAGE BODY P1 IS
- 
-                PROCEDURE P1 IS BEGIN NULL; END P1;
- 
-                FUNCTION F1 (X : UA1) RETURN UA1 IS
-                BEGIN RETURN X; END F1;
- 
-                FUNCTION "+" (X : UA1) RETURN UA1 IS
-                BEGIN RETURN F1(X); END "+";
- 
-                PACKAGE BODY PK1 IS
-                     PACKAGE BODY PK3 IS END;
-                END PK1;
- 
-           BEGIN
-                NULL ;
-           END P1;
- 
-      BEGIN
-           NULL;
-      END DD;
-      RESULT;
- 
- END A71004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a73001i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a73001i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a73001i.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a73001i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- A73001I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR
- -- GENERIC INSTANTIATION IN A PACKAGE SPECIFICATION NO PACKAGE BODY IS
- -- REQUIRED.
- 
- -- BHS 6/26/84
- 
- WITH REPORT;
- PROCEDURE A73001I IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("A73001I", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " &
-                       "SUBPROGRAM DECLARED BY RENAMING DECLARATION " &
-                       "OR GENERIC INSTANTIATION IN A PACKAGE " &
-                       "SPECIFICATION");
- 
-      DECLARE
-           PACKAGE PACK1 IS
-                FUNCTION ADDI (X,Y : INTEGER) RETURN INTEGER RENAMES "+";
-           END PACK1;
- 
-      BEGIN
-           NULL;
-      END;
- 
- 
-      DECLARE
-           GENERIC
-                TYPE ITEM IS RANGE <>;
-           PROCEDURE P (X : IN OUT ITEM);
- 
-           PROCEDURE P (X : IN OUT ITEM) IS
-           BEGIN
-                NULL;
-           END P;
- 
-           PACKAGE PACK2 IS
-                PROCEDURE NADA IS NEW P (INTEGER);
-           END PACK2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END A73001I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a73001j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a73001j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a73001j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a73001j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- A73001J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR
- -- GENERIC INSTANTIATION IN A GENERIC PACKAGE SPECIFICATION, NO PACKAGE
- -- BODY IS REQUIRED.
- 
- 
- -- BHS 6/27/84
- 
- WITH REPORT;
- PROCEDURE A73001J IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("A73001J", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " &
-                       "SUBPROGRAM DECLARED BY RENAMING DECLARATION " &
-                       "OR GENERIC INSTANTIATION IN A GENERIC " &
-                       "PACKAGE SPECIFICATION");
- 
-      DECLARE
-           GENERIC
-                TYPE ITEM IS RANGE <>;
-           PACKAGE PACK1 IS
-                FUNCTION ADDI (X,Y : ITEM) RETURN ITEM RENAMES "+";
-           END PACK1;
- 
-      BEGIN
-           NULL;
-      END;
- 
- 
-      DECLARE
-           GENERIC
-                TYPE ITEM IS RANGE <>;
-           PROCEDURE P (X : IN OUT ITEM);
- 
-           PROCEDURE P (X : IN OUT ITEM) IS
-           BEGIN
-                NULL;
-           END P;
- 
-           GENERIC
-                TYPE OBJ IS RANGE <>;
-           PACKAGE PACK2 IS
-                PROCEDURE NADA IS NEW P (OBJ);
-           END PACK2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END A73001J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74105b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74105b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74105b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74105b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- A74105B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FULL TYPE DECLARATION OF A PRIVATE TYPE WITHOUT
- -- DISCRIMINANTS MAY BE A CONSTRAINED TYPE WITH DISCRIMINANTS.
- 
- -- DSJ 4/29/83
- -- SPS 10/22/83
- 
- WITH REPORT;
- PROCEDURE A74105B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("A74105B", "CHECK THAT THE FULL TYPE DECLARATION OF A " &
-                       "PRIVATE TYPE WITHOUT DISCRIMINANTS MAY BE " &
-                       "A CONSTRAINED TYPE WITH DISCRIMINANTS");
- 
-      DECLARE
- 
-           TYPE REC1 (D : INTEGER) IS
-                RECORD
-                     C1, C2 : INTEGER;
-                END RECORD;
- 
-           TYPE REC2 (F : INTEGER := 0) IS
-                RECORD
-                     E1, E2 : INTEGER;
-                END RECORD;
- 
-           TYPE REC3 IS NEW REC1 (D => 1);
- 
-           TYPE REC4 IS NEW REC2 (F => 2);
- 
-           PACKAGE PACK1 IS
-                TYPE P1 IS PRIVATE;
-                TYPE P2 IS PRIVATE;
-                TYPE P3 IS PRIVATE;
-                TYPE P4 IS PRIVATE;
-           PRIVATE
-                TYPE P1 IS ACCESS REC1;
-                TYPE P2 IS NEW REC4;
-                TYPE P3 IS NEW REC1 (D => 5);
-                TYPE P4 IS NEW REC2 (F => 7);
-           END PACK1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END A74105B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74106a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,168 ****
- -- A74106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED
- --    PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE,
- --    RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH
- --    OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE
- --    ABOVE.
- 
- -- PART A: TYPES NOT INVOLVING FLOATING-POINT DATA OR FIXED-POINT DATA.
- 
- 
- -- RM 05/13/81
- 
- 
- WITH REPORT;
- PROCEDURE  A74106A  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "A74106A" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " &
-                        "TYPES CAN BE DEFINED IN TERMS OF " &
-                        "VARIOUS OTHER TYPES" );
- 
-      DECLARE
- 
-           TYPE  ENUM  IS  ( A , B , C , D );
- 
-           PACKAGE  P0  IS
-                TYPE  T0  IS  PRIVATE;
-           PRIVATE
-                TYPE  T0  IS  NEW INTEGER;
-           END  P0;
- 
-           PACKAGE  P1  IS
-                USE   P0;
-                TYPE  T1  IS  PRIVATE;
-                TYPE  T2  IS  PRIVATE;
-                TYPE  T3  IS  PRIVATE;
-                TYPE  T4  IS  PRIVATE;
-                TYPE  T5  IS  PRIVATE;
-                TYPE  T6  IS  PRIVATE;
-                TYPE  T7  IS  PRIVATE;
-                TYPE  T8  IS  PRIVATE;
-                TYPE  T9  IS  PRIVATE;
-                TYPE  TA  IS  PRIVATE;
-                TYPE  TB  IS  PRIVATE;
-                TYPE  TC  IS  PRIVATE;
-                TYPE  TD(I : INTEGER)  IS  PRIVATE;
-                TYPE  NT  IS  NEW  ENUM;
-                TYPE  ARR_T            IS  ARRAY(1..2) OF BOOLEAN;
-                TYPE  ACC_T            IS  ACCESS CHARACTER;
-                TYPE  REC_T            IS RECORD T : BOOLEAN; END RECORD;
-                TYPE  D_REC_T(I : INTEGER := 1)  IS 
-                     RECORD T : ENUM; END RECORD;
-           PRIVATE
-                TYPE  TY(B : BOOLEAN)  IS  
-                     RECORD G : BOOLEAN; END RECORD;
-                TYPE  TC  IS  NEW  T0;
-                TYPE  T1  IS  RANGE 1..100;
-                TYPE  T2  IS  NEW CHARACTER RANGE 'A'..'Z';
-                TYPE  T3  IS  NEW  NT;
-                TYPE  T4  IS  ARRAY(1..2) OF INTEGER;
-                TYPE  T5  IS  NEW ARR_T;
-                TYPE  T6  IS  ACCESS ENUM;
-                TYPE  T7  IS  NEW ACC_T;
-                TYPE  T8  IS  
-                     RECORD T : CHARACTER; END RECORD;
-                TYPE  T9  IS  NEW REC_T;
-                TYPE  TA  IS  ACCESS TD;
-                TYPE  TB  IS  ACCESS D_REC_T;
-                TYPE  TD(I : INTEGER)  IS  
-                     RECORD G : BOOLEAN; END RECORD;
- 
-           END  P1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
- 
-      DECLARE
- 
-           TYPE  ENUM  IS  ( A , B , C , D );
- 
-           PACKAGE  P0  IS
-                TYPE  T0  IS  LIMITED PRIVATE;
-           PRIVATE
-                TYPE  T0  IS  NEW ENUM;
-           END  P0;
- 
-           PACKAGE  P1  IS
-                USE   P0;
-                TYPE  T1  IS  LIMITED PRIVATE;
-                TYPE  T2  IS  LIMITED PRIVATE;
-                TYPE  T3  IS  LIMITED PRIVATE;
-                TYPE  T4  IS  LIMITED PRIVATE;
-                TYPE  T5  IS  LIMITED PRIVATE;
-                TYPE  T6  IS  LIMITED PRIVATE;
-                TYPE  T7  IS  LIMITED PRIVATE;
-                TYPE  T8  IS  LIMITED PRIVATE;
-                TYPE  T9  IS  LIMITED PRIVATE;
-                TYPE  TA  IS  LIMITED PRIVATE;
-                TYPE  TB  IS  LIMITED PRIVATE;
-                TYPE  TC  IS  LIMITED PRIVATE;
-                TYPE  TD(I : INTEGER)  IS  LIMITED PRIVATE;
-                TYPE  NT  IS  NEW  ENUM;
-                TYPE  ARR_T           IS  ARRAY(1..2) OF BOOLEAN;
-                TYPE  ACC_T           IS  ACCESS CHARACTER;
-                TYPE  REC_T           IS  RECORD T : BOOLEAN; END RECORD;
-                TYPE  D_REC_T(I : INTEGER := 1)  IS 
-                     RECORD T : ENUM; END RECORD;
-           PRIVATE
-                TYPE  TY(B : BOOLEAN)  IS  
-                     RECORD G : BOOLEAN; END RECORD;
-                TYPE  TC  IS  NEW  T0;
-                TYPE  T1  IS  RANGE 1..100;
-                TYPE  T2  IS  NEW CHARACTER RANGE 'A'..'Z';
-                TYPE  T3  IS  NEW  NT;
-                TYPE  T4  IS  ARRAY(1..2) OF INTEGER;
-                TYPE  T5  IS  NEW ARR_T;
-                TYPE  T6  IS  ACCESS ENUM;
-                TYPE  T7  IS  NEW ACC_T;
-                TYPE  T8  IS  RECORD T : CHARACTER; END RECORD;
-                TYPE  T9  IS  NEW REC_T;
-                TYPE  TA  IS  ACCESS TD;
-                TYPE  TB  IS  ACCESS D_REC_T;
-                TYPE  TD(I : INTEGER)  IS  
-                     RECORD G : BOOLEAN; END RECORD;
- 
-           END  P1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END A74106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74106b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74106b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74106b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- A74106B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED
- --    PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE,
- --    RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH
- --    OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE
- --    ABOVE.
- 
- -- PART B: TYPES INVOLVING FLOATING-POINT DATA.
- 
- 
- -- RM 05/08/81
- 
- 
- WITH REPORT;
- PROCEDURE  A74106B  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "A74106B" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " &
-                        "TYPES CAN BE DEFINED IN TERMS OF " &
-                        "FLOATING-POINT TYPES" );
- 
-      DECLARE
- 
-           PACKAGE  P0  IS
-                TYPE  F0  IS  PRIVATE;
-           PRIVATE
-                TYPE  F0  IS  NEW FLOAT;
-           END  P0;
- 
-           PACKAGE  P1  IS
-                USE   P0;
-                TYPE  F1  IS  PRIVATE;
-                TYPE  F2  IS  PRIVATE;
-                TYPE  F3  IS  PRIVATE;
-                TYPE  F4  IS  PRIVATE;
-                TYPE  F5  IS  PRIVATE;
-                TYPE  F6  IS  PRIVATE;
-                TYPE  F7  IS  PRIVATE;
-                TYPE  F8  IS  PRIVATE;
-                TYPE  F9  IS  PRIVATE;
-                TYPE  FA  IS  PRIVATE;
-                TYPE  FB  IS  PRIVATE;
-                TYPE  FC  IS  PRIVATE;
-                TYPE  FD(I : INTEGER)  IS  PRIVATE;
-                TYPE  NF  IS  NEW  FLOAT;
-                TYPE  ARR_F             IS  ARRAY(1..2) OF FLOAT;
-                TYPE  ACC_F             IS  ACCESS FLOAT;
-                TYPE  REC_F             IS RECORD F : FLOAT; END RECORD;
-                TYPE  D_REC_F(I : INTEGER := 1) IS 
-                     RECORD F : FLOAT; END RECORD;
-           PRIVATE
-                TYPE  FY(B : BOOLEAN)  IS  RECORD G : FLOAT; END RECORD;
-                TYPE  FC  IS  NEW  F0;
-                TYPE  F1  IS  DIGITS 3;
-                TYPE  F2  IS  NEW FLOAT DIGITS 4;
-                TYPE  F3  IS  NEW  NF;
-                TYPE  F4  IS  ARRAY(1..2) OF FLOAT;
-                TYPE  F5  IS  NEW ARR_F;
-                TYPE  F6  IS  ACCESS FLOAT;
-                TYPE  F7  IS  NEW ACC_F;
-                TYPE  F8  IS  RECORD F : FLOAT; END RECORD;
-                TYPE  F9  IS  NEW REC_F;
-                TYPE  FA  IS  ACCESS FD;
-                TYPE  FB  IS  ACCESS D_REC_F;
-                TYPE  FD(I : INTEGER)  IS  RECORD G : FLOAT; END RECORD;
- 
-           END  P1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
- 
-      DECLARE
- 
-           PACKAGE  P0  IS
-                TYPE  F0  IS  LIMITED PRIVATE;
-           PRIVATE
-                TYPE  F0  IS  NEW FLOAT;
-           END  P0;
- 
-           PACKAGE  P1  IS
-                USE   P0;
-                TYPE  F1  IS  LIMITED PRIVATE;
-                TYPE  F2  IS  LIMITED PRIVATE;
-                TYPE  F3  IS  LIMITED PRIVATE;
-                TYPE  F4  IS  LIMITED PRIVATE;
-                TYPE  F5  IS  LIMITED PRIVATE;
-                TYPE  F6  IS  LIMITED PRIVATE;
-                TYPE  F7  IS  LIMITED PRIVATE;
-                TYPE  F8  IS  LIMITED PRIVATE;
-                TYPE  F9  IS  LIMITED PRIVATE;
-                TYPE  FA  IS  LIMITED PRIVATE;
-                TYPE  FB  IS  LIMITED PRIVATE;
-                TYPE  FC  IS  LIMITED PRIVATE;
-                TYPE  FD(I : INTEGER)  IS  LIMITED PRIVATE;
-                TYPE  NF  IS  NEW  FLOAT;
-                TYPE  ARR_F             IS  ARRAY(1..2) OF FLOAT;
-                TYPE  ACC_F             IS  ACCESS FLOAT;
-                TYPE  REC_F             IS RECORD F : FLOAT; END RECORD;
-                TYPE  D_REC_F(I : INTEGER := 1) IS 
-                     RECORD F : FLOAT; END RECORD;
-           PRIVATE
-                TYPE  FY(B : BOOLEAN)  IS  RECORD G : FLOAT; END RECORD;
-                TYPE  FC  IS  NEW  F0;
-                TYPE  F1  IS  DIGITS 3;
-                TYPE  F2  IS  NEW FLOAT DIGITS 4;
-                TYPE  F3  IS  NEW  NF;
-                TYPE  F4  IS  ARRAY(1..2) OF FLOAT;
-                TYPE  F5  IS  NEW ARR_F;
-                TYPE  F6  IS  ACCESS FLOAT;
-                TYPE  F7  IS  NEW ACC_F;
-                TYPE  F8  IS  RECORD F : FLOAT; END RECORD;
-                TYPE  F9  IS  NEW REC_F;
-                TYPE  FA  IS  ACCESS FD;
-                TYPE  FB  IS  ACCESS D_REC_F;
-                TYPE  FD(I : INTEGER)  IS  RECORD G : FLOAT; END RECORD;
- 
-           END  P1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END A74106B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74106c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74106c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74106c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74106c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- A74106C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED
- --     PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY
- --     TYPE, RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE
- --     (WITH OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY
- --     OF THE ABOVE.
- 
- --     PART C: TYPES INVOLVING FIXED-POINT DATA.
- 
- -- HISTORY:
- --     RM  05/11/81 CREATED ORIGINAL TEST.
- --     DHH 10/15/87 CORRECTED RANGE ERRORS.
- 
- 
- WITH REPORT;
- PROCEDURE  A74106C  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "A74106C" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE" &
-                        " TYPES CAN BE DEFINED IN TERMS OF" &
-                        " FIXED-POINT TYPES" );
- 
-      DECLARE
- 
-           PACKAGE  P0  IS
-                TYPE  F0  IS  PRIVATE;
-           PRIVATE
-                TYPE  F0  IS  DELTA 1.0  RANGE 0.0 .. 10.0;
-           END  P0;
- 
-           PACKAGE  P1  IS
-                USE   P0;
-                TYPE  FX  IS  DELTA 0.1  RANGE 0.0 .. 1.0;
-                TYPE  F1  IS  PRIVATE;
-                TYPE  F2  IS  PRIVATE;
-                TYPE  F3  IS  PRIVATE;
-                TYPE  F4  IS  PRIVATE;
-                TYPE  F5  IS  PRIVATE;
-                TYPE  F6  IS  PRIVATE;
-                TYPE  F7  IS  PRIVATE;
-                TYPE  F8  IS  PRIVATE;
-                TYPE  F9  IS  PRIVATE;
-                TYPE  FA  IS  PRIVATE;
-                TYPE  FB  IS  PRIVATE;
-                TYPE  FC  IS  PRIVATE;
-                TYPE  NF  IS  DELTA 0.1 RANGE 1.0 .. 2.0;
-                TYPE  ARR_F             IS  ARRAY(1..2) OF FX;
-                TYPE  ACC_F             IS  ACCESS FX;
-                TYPE  REC_F             IS  RECORD F : FX; END RECORD;
-                TYPE  D_REC_F(I : INTEGER := 1) IS
-                     RECORD F : FX; END RECORD;
-           PRIVATE
-                TYPE  FC  IS  NEW  F0;
-                TYPE  F1  IS  DELTA 100.0  RANGE -100.0 .. 900.0;
-                TYPE  F2  IS  NEW  FX  RANGE 0.0 .. 0.5;
-                TYPE  F3  IS  NEW  NF;
-                TYPE  F4  IS  ARRAY(1..2) OF FX;
-                TYPE  F5  IS  NEW ARR_F;
-                TYPE  F6  IS  ACCESS FX;
-                TYPE  F7  IS  NEW ACC_F;
-                TYPE  F8  IS  RECORD F : FX; END RECORD;
-                TYPE  F9  IS  NEW REC_F;
-                TYPE  FA  IS  ACCESS D_REC_F;
-                TYPE  FB  IS  ACCESS D_REC_F;
-           END  P1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
- 
-      DECLARE
- 
-           PACKAGE  P0  IS
-                TYPE  F0  IS  LIMITED PRIVATE;
-           PRIVATE
-                TYPE  F0  IS  DELTA 1.0  RANGE 0.0 .. 10.0;
-           END  P0;
- 
-           PACKAGE  P1  IS
-                USE   P0;
-                TYPE  FX  IS  DELTA 0.1  RANGE 0.0 .. 1.0;
-                TYPE  F1  IS  LIMITED PRIVATE;
-                TYPE  F2  IS  LIMITED PRIVATE;
-                TYPE  F3  IS  LIMITED PRIVATE;
-                TYPE  F4  IS  LIMITED PRIVATE;
-                TYPE  F5  IS  LIMITED PRIVATE;
-                TYPE  F6  IS  LIMITED PRIVATE;
-                TYPE  F7  IS  LIMITED PRIVATE;
-                TYPE  F8  IS  LIMITED PRIVATE;
-                TYPE  F9  IS  LIMITED PRIVATE;
-                TYPE  FA  IS  LIMITED PRIVATE;
-                TYPE  FB  IS  LIMITED PRIVATE;
-                TYPE  FC  IS  LIMITED PRIVATE;
-                TYPE  NF  IS  DELTA 0.1 RANGE 1.0 .. 2.0;
-                TYPE  ARR_F                 IS  ARRAY(1..2) OF FX;
-                TYPE  ACC_F                 IS  ACCESS FX;
-                TYPE  REC_F                 IS RECORD F : FX; END RECORD;
-                TYPE  D_REC_F(I : INTEGER := 1) IS
-                     RECORD F : FX; END RECORD;
-           PRIVATE
-                TYPE  FC  IS  NEW  F0;
-                TYPE  F1  IS  DELTA 100.0  RANGE -100.0 .. 900.0;
-                TYPE  F2  IS  NEW  FX  RANGE 0.0 .. 0.5;
-                TYPE  F3  IS  NEW  NF;
-                TYPE  F4  IS  ARRAY(1..2) OF FX;
-                TYPE  F5  IS  NEW ARR_F;
-                TYPE  F6  IS  ACCESS FX;
-                TYPE  F7  IS  NEW ACC_F;
-                TYPE  F8  IS  RECORD F : FX; END RECORD;
-                TYPE  F9  IS  NEW REC_F;
-                TYPE  FA  IS  ACCESS D_REC_F;
-                TYPE  FB  IS  ACCESS D_REC_F;
-           END  P1;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END A74106C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74205e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74205e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74205e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74205e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- A74205E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ADDITIONAL OPERATIONS FOR A COMPOSITE TYPE WITH A
- -- COMPONENT OF A PRIVATE TYPE ARE AVAILABLE AT THE EARLIEST
- -- PLACE WITHIN THE IMMEDIATE SCOPE OF THE DECLARATION OF THE COMPOSITE
- -- TYPE AND AFTER THE FULL DECLARATION OF THE PRIVATE TYPE.
- 
- -- IN PARTICULAR, CHECH FOR THE FOLLOWING :
- 
- -- (1)  RELATIONAL OPERATORS WITH ARRAYS OF SCALAR TYPES
- -- (2)  EQUALITY WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES 
- -- (3)  LOGICAL OPERATORS WITH ARRAYS OF BOOLEAN TYPES
- -- (4)  CATENATION WITH ARRAYS OF LIMITED PRIVATE TYPES
- -- (5)  INITIALIZATION WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES
- -- (6)  ASSIGNMENT WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES
- -- (7)  SELECTED COMPONENTS WITH COMPOSITES OF PRIVATE RECORD TYPES
- -- (8)  INDEXED COMPONENTS WITH COMPOSITES OF PRIVATE ARRAY TYPES
- -- (9)  SLICES WITH COMPOSITES OF PRIVATE ARRAY TYPES
- -- (10) QUALIFICATION FOR COMPOSITES OF PRIVATE TYPES
- -- (11) AGGREGATES FOR ARRAYS AND RECORDS OF PRIVATES TYPES
- -- (12) USE OF 'SIZE FOR ARRAYS AND RECORDS OF PRIVATE TYPES
- 
- -- DSJ 5/2/83
- 
- WITH REPORT ;
- PROCEDURE A74205E IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("A74205E", "CHECK THAT ADDITIONAL OPERATIONS FOR "
-                    & "COMPOSITE TYPES OF PRIVATE TYPES ARE "
-                    & "AVAILABLE AT THE EARLIEST PLACE AFTER THE "
-                    & "FULL DECLARATION AND IN THE IMMEDIATE "
-                    & "SCOPE OF THE COMPOSITE TYPE") ;
- 
-      DECLARE
- 
-           PACKAGE PACK1 IS
-                TYPE LP1 IS LIMITED PRIVATE ;
-                PACKAGE PACK_LP IS
-                     TYPE LP_ARR IS ARRAY (INTEGER RANGE <>) OF LP1 ;
-                     SUBTYPE LP_ARR2 IS LP_ARR ( 1 .. 2 ) ;
-                     SUBTYPE LP_ARR4 IS LP_ARR ( 1 .. 4 ) ;
-                END PACK_LP ;
- 
-                TYPE T1 IS PRIVATE ;
-                PACKAGE PACK2 IS
-                     TYPE ARR IS ARRAY (INTEGER RANGE <>) OF T1 ;
-                     SUBTYPE ARR2 IS ARR ( 1 .. 2 ) ;
-                     SUBTYPE ARR4 IS ARR ( 1 .. 4 ) ;
-                END PACK2 ;
- 
-                TYPE T2 IS PRIVATE ;
-                TYPE T3 IS PRIVATE ;
-                PACKAGE PACK3 IS
-                     TYPE ARR_T2 IS ARRAY ( 1 .. 2 ) OF T2 ;
-                     TYPE ARR_T3 IS ARRAY ( 1 .. 2 ) OF T3 ;
-                END PACK3 ;
-           PRIVATE
-                TYPE LP1 IS NEW BOOLEAN ;
-                TYPE T1 IS NEW BOOLEAN ;
-                TYPE T2 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
-                TYPE T3 IS
-                     RECORD
-                          C1 : INTEGER ;
-                     END RECORD ;
-           END PACK1 ;
- 
-           PACKAGE BODY PACK1 IS
- 
-                PACKAGE BODY PACK_LP IS
-                     L1, L2 : LP_ARR2 := (TRUE,FALSE) ; -- LEGAL
-                     A3 : LP_ARR2 := L1 ;               -- LEGAL
-                     B3 : BOOLEAN := L1 =  L2 ;         -- LEGAL
-                     B4 : BOOLEAN := L1 /= L2 ;         -- LEGAL
-                END PACK_LP ;
- 
-                PACKAGE BODY PACK2 IS
-                     A1, A2 : ARR2 := (FALSE,TRUE) ;    -- LEGAL
-                     A4 : ARR2    := ARR2'(A1) ;        -- LEGAL
-                     B1 : BOOLEAN := A1 <  A2 ;         -- LEGAL
-                     B2 : BOOLEAN := A1 >= A2 ;         -- LEGAL
-                     N3 : INTEGER := A1'SIZE ;          -- LEGAL
-                     PROCEDURE G1 (X : ARR2 := NOT A1) IS    -- LEGAL
-                     BEGIN
-                          NULL ; 
-                     END G1 ;
- 
-                     PROCEDURE G2 (X : ARR2 := A1 AND A2) IS -- LEGAL
-                     BEGIN
-                          NULL ;
-                     END G2 ;
- 
-                     PROCEDURE G3 (X : ARR4 := A1 & A2) IS   -- LEGAL
-                     BEGIN
-                          NULL ;
-                     END G3 ;
- 
-                     PROCEDURE G4 (X : ARR2 := (FALSE,TRUE) ) IS -- LEGAL
-                     BEGIN
-                          NULL ;
-                     END G4 ;
-                END PACK2 ;
- 
-                PACKAGE BODY PACK3 IS
-                     X2 : ARR_T2 :=
-                          (1=>(1,2), 2=>(3,4)) ;        -- LEGAL
-                     X3 : ARR_T3 :=
-                          (1=>(C1=>5), 2=>(C1=>6)) ;    -- LEGAL
-                     N1 : INTEGER := X3(1).C1 ;         -- LEGAL
-                     N2 : INTEGER := X2(1)(2) ;         -- LEGAL
-                     N4 : T2      := X2(1)(1..2) ;      -- LEGAL
-                END PACK3 ;
- 
-           END PACK1 ;
- 
-      BEGIN
- 
-           NULL ;
- 
-      END ;
- 
-      RESULT ;
- 
- END A74205E ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74205f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74205f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a74205f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a74205f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- A74205F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS A PRIVATE TYPE
- -- ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON
- -- CHARACTERISTICS OF THE FULL DECLARATION OF THE PRIVATE TYPE ARE MADE
- -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
- -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE PRIVATE
- -- TYPE.
- 
- -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES
- -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES
- -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY
- --     TYPES
- 
- -- DSJ 5/5/83
- 
- WITH REPORT ;
- PROCEDURE A74205F IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("A74205F", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS TYPES "
-                    & "OF PRIVATE TYPES ARE AVAILABLE AT THE EARLIEST "
-                    & "PLACE IN THE IMMEDIATE SCOPE OF THE ACCESS TYPE "
-                    & "AND AFTER THE FULL DECLARATION") ;
- 
-      DECLARE
- 
-           PACKAGE PACK1 IS
-                TYPE T1 IS PRIVATE ;
-                TYPE T2 IS PRIVATE ;
-                PACKAGE PACK2 IS
-                     TYPE ACC1 IS ACCESS T1 ;
-                     TYPE ACC2 IS ACCESS T2 ;
-                END PACK2 ;
-           PRIVATE
-                TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
-                TYPE T2 IS
-                     RECORD
-                          C1, C2 : INTEGER ;
-                     END RECORD ;
-           END PACK1 ;
- 
-           PACKAGE BODY PACK1 IS
-                A1 : PACK2.ACC1 := NEW T1'(2,4) ;  -- LEGAL
-                A2 : PACK2.ACC1 := NEW T1'(6,8) ;  -- LEGAL
-                R1 : PACK2.ACC2 := NEW T2'(3,5) ;  -- LEGAL
-                R2 : PACK2.ACC2 := NEW T2'(7,9) ;  -- LEGAL
- 
-                PACKAGE BODY PACK2 IS
-                     X1 : INTEGER := A1(1) ;            -- LEGAL
-                     X2 : INTEGER := A1'FIRST ;         -- LEGAL
-                     X3 : INTEGER := A1'LAST ;          -- LEGAL
-                     X4 : INTEGER := A1'LENGTH ;        -- LEGAL
-                     B1 : BOOLEAN := 3 IN A1'RANGE ;    -- LEGAL
-                     X5 : INTEGER := R1.C1 ;            -- LEGAL
-                END PACK2 ;
- 
-           END PACK1 ;
- 
-      BEGIN
- 
-           NULL ;
- 
-      END ;
- 
-      RESULT ;
- 
- END A74205F ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83009a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- A83009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED TYPE DECLARATION AND A GENERIC
- --     INSTANTIATION MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS.
- --     CHECK THE CASES WHERE:
- --          1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE
- --             SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN
- --             THE IMPLICIT SUBPROGRAM SPECIFICATIONS.
- --          2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND
- --             THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS
- --             THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN
- --             FOR THE GENERIC FORMAL-TYPE PARAMETERS.
- --     TEST CASES WHERE THE DERIVED TYPE DECLARATIONS AND GENERIC
- --     INSTANTIATIONS ARE GIVEN IN:
- --          . THE VISIBLE PART OF A PACKAGE SPECIFICATION,
- --          . THE PRIVATE PART OF A PACKAGE SPECIFICATION,
- --          . A PACKAGE BODY,
- --          . A SUBPROGRAM BODY,
- --          . A BLOCK STATEMENT.
- --
- -- HISTORY:
- --     VCL  03-08-88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A83009A IS
-      TYPE ENUM IS (E1, E2, E3);
- 
-      GENERIC
-           TYPE T1 IS (<>);
-           TYPE T2 IS (<>);
-      PACKAGE G_PACK IS
-           TYPE PARENT IS (E1, E2, E3);
- 
-           PROCEDURE HP (P1 : PARENT; P2 : T1);
-           PROCEDURE HP (P3 : PARENT; P4 : T2);
- 
-           FUNCTION HF (P1 : T1) RETURN PARENT;
-           FUNCTION HF (P2 : T2) RETURN PARENT;
-      END G_PACK;
- 
-      PACKAGE BODY G_PACK IS
-           PROCEDURE HP (P1 : PARENT; P2 : T1) IS
-           BEGIN
-                NULL;
-           END HP;
- 
-           PROCEDURE HP (P3 : PARENT; P4 : T2) IS
-           BEGIN
-                NULL;
-           END HP;
- 
-           FUNCTION HF (P1 : T1) RETURN PARENT IS
-           BEGIN
-                RETURN E1;
-           END HF;
- 
-           FUNCTION HF (P2 : T2) RETURN PARENT IS
-           BEGIN
-                RETURN E2;
-           END HF;
-      END G_PACK;
- BEGIN
-      TEST ("A83009A", "A DERIVED TYPE DECLARATION AND A GENERIC " &
-                       "INSTANTIATION MAY DERIVE TWO OR " &
-                       "MORE SUBPROGRAM HOMOGRAPHS");
- 
-      DECLARE
-      -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION.
- 
-           PACKAGE PACK2 IS
-                TYPE CHILD1 IS PRIVATE;
- 
-                PACKAGE IN_PACK2 IS
-                     TYPE PARENT IS (E1, E2, E3);
-                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1);
-                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT);
- 
-                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
-                                 RETURN PARENT;
-                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
-                                 RETURN PARENT;
-                END IN_PACK2;
-           PRIVATE
-                TYPE CHILD1 IS NEW IN_PACK2.PARENT;
-           END PACK2;
- 
-           PACKAGE BODY PACK2 IS
-                TYPE CHILD2 IS NEW CHILD1;
- 
-                PACKAGE IN_BODY IS
-                     TYPE CHILD3 IS NEW CHILD1;
-                END IN_BODY;
- 
-                PROCEDURE P IS
-                     TYPE CHILD4 IS NEW CHILD1;
-                BEGIN
-                     NULL;
-                END;
- 
-                PACKAGE BODY IN_PACK2 IS
-                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS
-                     BEGIN
-                          NULL;
-                     END HP;
- 
-                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS
-                     BEGIN
-                          NULL;
-                     END HP;
- 
-                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
-                                 RETURN PARENT IS
-                     BEGIN
-                          RETURN E1;
-                     END HF;
- 
-                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
-                                 RETURN PARENT IS
-                     BEGIN
-                          RETURN E2;
-                     END HF;
-                END IN_PACK2;
-           BEGIN
-                DECLARE
-                     TYPE CHILD5 IS NEW CHILD1;
-                BEGIN
-                     NULL;
-                END;
-           END PACK2;
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE
-      -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS.
- 
-           PACKAGE INSTANCE1 IS
-                NEW G_PACK (BOOLEAN, BOOLEAN);
- 
-           TYPE CHILD1 IS NEW INSTANCE1.PARENT;
- 
-           PACKAGE PACK1 IS
-                PACKAGE INSTANCE2 IS
-                     NEW G_PACK (CHARACTER, CHARACTER);
- 
-                TYPE CHILD2 IS NEW INSTANCE2.PARENT;
-                TYPE CHILD3 IS PRIVATE;
-           PRIVATE
-                PACKAGE INSTANCE3 IS
-                     NEW G_PACK (ENUM, ENUM);
- 
-                TYPE CHILD3 IS NEW INSTANCE3.PARENT;
-           END PACK1;
- 
-           PROCEDURE P1 IS
-                PACKAGE INSTANCE4 IS
-                     NEW G_PACK (BOOLEAN, BOOLEAN);
- 
-                TYPE CHILD4 IS NEW INSTANCE4.PARENT;
-           BEGIN
-                NULL;
-           END P1;
- 
-           PACKAGE BODY PACK1 IS
-                PACKAGE INSTANCE5 IS
-                     NEW G_PACK (ENUM, ENUM);
- 
-                TYPE CHILD5 IS NEW INSTANCE5.PARENT;
-           END PACK1;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END A83009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83009b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83009b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83009b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- A83009B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED TYPE DECLARATION IN A GENERIC
- --     UNIT MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS.
- --     CHECK THE CASES WHERE:
- --          1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE
- --             SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN
- --             THE IMPLICIT SUBPROGRAM SPECIFICATIONS.
- --          2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND
- --             THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS
- --             THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN
- --             FOR THE GENERIC FORMAL-TYPE PARAMETERS.
- --     TEST CASES WHERE THE DERIVED TYPE DECLARATIONS ARE GIVEN IN:
- --          . THE VISIBLE PART OF A GENERIC PACKAGE SPECIFICATION,
- --          . THE PRIVATE PART OF A GENERIC PACKAGE SPECIFICATION,
- --          . A GENERIC PACKAGE BODY,
- --          . A GENERIC SUBPROGRAM BODY.
- --
- -- HISTORY:
- --     DHH 09/20/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A83009B IS
-      TYPE ENUM IS (E1, E2, E3);
- 
-      GENERIC
-           TYPE T1 IS (<>);
-           TYPE T2 IS (<>);
-      PACKAGE G_PACK IS
-           TYPE PARENT IS (E1, E2, E3);
- 
-           PROCEDURE HP (P1 : PARENT; P2 : T1);
-           PROCEDURE HP (P3 : PARENT; P4 : T2);
- 
-           FUNCTION HF (P1 : T1) RETURN PARENT;
-           FUNCTION HF (P2 : T2) RETURN PARENT;
-      END G_PACK;
- 
-      PACKAGE BODY G_PACK IS
-           PROCEDURE HP (P1 : PARENT; P2 : T1) IS
-           BEGIN
-                NULL;
-           END HP;
- 
-           PROCEDURE HP (P3 : PARENT; P4 : T2) IS
-           BEGIN
-                NULL;
-           END HP;
- 
-           FUNCTION HF (P1 : T1) RETURN PARENT IS
-           BEGIN
-                RETURN E1;
-           END HF;
- 
-           FUNCTION HF (P2 : T2) RETURN PARENT IS
-           BEGIN
-                RETURN E2;
-           END HF;
-      END G_PACK;
- BEGIN
-      TEST ("A83009B", "A DERIVED TYPE DECLARATION IN A GENERIC " &
-                       "UNIT MAY DERIVE TWO OR MORE SUBPROGRAM " &
-                       "HOMOGRAPHS");
- 
-      DECLARE
-      -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION.
- 
-           GENERIC
-           PACKAGE PACK2 IS
-                TYPE CHILD1 IS PRIVATE;
- 
-                PACKAGE IN_PACK2 IS
-                     TYPE PARENT IS (E1, E2, E3);
-                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1);
-                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT);
- 
-                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
-                                 RETURN PARENT;
-                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
-                                 RETURN PARENT;
-                END IN_PACK2;
- 
-                USE IN_PACK2;
-           PRIVATE
-                TYPE CHILD1 IS NEW IN_PACK2.PARENT;  -- PRIVATE PART
-           END PACK2;                                -- OF SPEC.
- 
-           PACKAGE BODY PACK2 IS
-                TYPE CHILD2 IS NEW CHILD1;  -- VISIBLE PART OF BODY.
- 
-                GENERIC
-                PACKAGE IN_BODY IS
-                     TYPE CHILD3 IS NEW CHILD1; -- VISIBLE PART OF SPEC.
-                END IN_BODY;
- 
-                GENERIC
-                PROCEDURE P;
-                PROCEDURE P IS
-                     TYPE CHILD4 IS NEW CHILD1;  -- SUBPROGRAM BODY.
-                BEGIN
-                     NULL;
-                END;
- 
-                PACKAGE BODY IN_PACK2 IS
-                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS
-                     BEGIN
-                          NULL;
-                     END HP;
- 
-                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS
-                     BEGIN
-                          NULL;
-                     END HP;
- 
-                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
-                                 RETURN PARENT IS
-                     BEGIN
-                          RETURN E1;
-                     END HF;
- 
-                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
-                                 RETURN PARENT IS
-                     BEGIN
-                          RETURN E2;
-                     END HF;
-                END IN_PACK2;
-           BEGIN
-                NULL;
-           END PACK2;
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE
-      -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS.
- 
-           GENERIC
-           PACKAGE PACK1 IS
-                PACKAGE INSTANCE2 IS
-                   NEW G_PACK (CHARACTER, CHARACTER);
- 
-                TYPE CHILD2 IS NEW INSTANCE2.PARENT;
-                TYPE CHILD3 IS PRIVATE;
-           PRIVATE
-                PACKAGE INSTANCE3 IS
-                     NEW G_PACK (ENUM, ENUM);
- 
-                TYPE CHILD3 IS NEW INSTANCE3.PARENT;
-           END PACK1;
- 
-           GENERIC
-           PROCEDURE P1;
-           PROCEDURE P1 IS
-                PACKAGE INSTANCE4 IS
-                     NEW G_PACK (BOOLEAN, BOOLEAN);
- 
-                TYPE CHILD4 IS NEW INSTANCE4.PARENT;
-           BEGIN
-                NULL;
-           END P1;
- 
-           PACKAGE BODY PACK1 IS
-                PACKAGE INSTANCE5 IS
-                     NEW G_PACK (ENUM, ENUM);
- 
-                TYPE CHILD5 IS NEW INSTANCE5.PARENT;
-           END PACK1;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END A83009B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a02a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a02a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a02a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- A83A02A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A LABEL IN A NESTED SUBPROGRAM OR PACKAGE CAN BE IDENTICAL
- --    TO A LABEL OUTSIDE SUCH CONSTRUCT.  
- 
- 
- -- "INSIDE LABEL":  INSIDE   * PACKAGE                    _PACK        A
- --                           * FUNCTION INSIDE PACKAGE    _PACKFUN     B
- --                           * PROCEDURE                  _PROC        C
- --                           * PROCEDURE INSIDE BLOCK     _BLOCKPROC   D
- 
- -- "OUTSIDE LABEL": INSIDE   * MAIN                       _MAIN        1
- --                           * BLOCK IN MAIN              _BLOCK       2
- --                           * LOOP IN BLOCK IN MAIN      _BLOCKLOOP   3
- --                           * LOOP IN MAIN               _LOOP        4
- 
- -- CASES TESTED:  A1  B2  A3  B4                           1 2 3 4
- --                D1  C2  C3  D4
- --                    D2          AB                  A    X . X .
- --                                                    B    . X . X
- --                                                    C    . X X .
- --                                                    D    X . . X
-   
- 
- -- RM 02/09/80
- 
- 
- WITH REPORT ;
- PROCEDURE  A83A02A  IS
- 
-      USE REPORT ;
- 
-      PROCEDURE  PROC1  IS
-      BEGIN
-           << LAB_PROC_BLOCK >>                NULL ;    -- C2   C       
-           << LAB_PROC_BLOCKLOOP >>            NULL ;    -- C3
-      END  PROC1 ;
- 
-      PACKAGE  PACK1  IS
-           FUNCTION  F  RETURN INTEGER ;
-      END  PACK1 ;
- 
-      PACKAGE BODY  PACK1  IS
-           FUNCTION  F  RETURN INTEGER  IS
-           BEGIN
-                << LAB_PACKFUN_BLOCK >>        NULL ;    -- B2    B
-                << LAB_PACKFUN_LOOP >>         NULL ;    -- B4
-                << LAB_PACKFUN_PACK >>         NULL ;    -- BA (AB)
-                RETURN 7 ;
-           END  F ;
-      BEGIN
-           << LAB_PACK_MAIN >>                 NULL ;    -- A1    A
-           << LAB_PACK_BLOCKLOOP >>            NULL ;    -- A3
-           << LAB_PACKFUN_PACK >>              NULL ;    -- BA (AB)
-      END  PACK1 ;
- 
- BEGIN                                                       
- 
-      TEST( "A83A02A" , "CHECK THAT A LABEL IN A NESTED SUBPROGRAM" &
-                        " OR PACKAGE CAN BE IDENTICAL TO A LABEL"   &
-                        " OUTSIDE SUCH CONSTRUCT" );
- 
-      << LAB_PACK_MAIN >>                      NULL ;    -- A1          1
-      << LAB_BLOCKPROC_MAIN >>                 NULL ;    -- D1
- 
- 
-      DECLARE  -- 
- 
-           PROCEDURE  PROC2  IS
-           BEGIN
-                << LAB_BLOCKPROC_MAIN >>       NULL ;    -- D1    D
-                << LAB_BLOCKPROC_LOOP >>       NULL ;    -- D4
-                << LAB_BLOCKPROC_BLOCK >>      NULL ;    -- D2
-           END  PROC2 ;
- 
-      BEGIN
- 
-           << LAB_PACKFUN_BLOCK >>             NULL ;    -- B2          2
-           << LAB_PROC_BLOCK >>                NULL ;    -- C2
-           << LAB_BLOCKPROC_BLOCK >>           NULL ;    -- D2
- 
-           FOR  I  IN  1..2  LOOP
-                << LAB_PACK_BLOCKLOOP >>       NULL ;    -- A3          3
-                << LAB_PROC_BLOCKLOOP >>       NULL ;    -- C3
-           END LOOP;
- 
-      END ;
- 
-      FOR  I  IN  1..2  LOOP
-           << LAB_PACKFUN_LOOP >>              NULL ;    -- B4          4
-           << LAB_BLOCKPROC_LOOP >>            NULL ;    -- D4
-      END LOOP;
- 
- 
-      RESULT ;
- 
- 
- END A83A02A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a02b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a02b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a02b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- A83A02B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A LABEL IN A NESTED TASK CAN BE IDENTICAL TO A LABEL
- --    OUTSIDE THE TASK.  
- 
- 
- -- "INSIDE LABEL":  INSIDE   * TASK BODY                  _TASK        A
- --                           * BLOCK IN TASK BODY         _TASKBLOCK   B
- --                           * LOOP IN BLOCK IN TASK BODY _TASKBLOCKLOOP
- --                           * ACCEPT ST. WITHIN TASK BDY _TASKACCEPT  D
- 
- -- "OUTSIDE LABEL": INSIDE   * MAIN                       _MAIN        1
- --                           * BLOCK IN MAIN              _BLOCK       2
- --                           * LOOP IN BLOCK IN MAIN      _BLOCKLOOP   3
- --                           * LOOP IN MAIN               _LOOP        4
- 
- -- CASES TESTED:  A1  B2  A3  B4                        |  1 2 3 4
- --                D1  C2  C3  D4                     ---+----------
- --                                                    A |  X . X .
- --                                                    B |  . X . X
- --                                                    C |  . X X .
- --                                                    D |  X . . X
-   
- 
- -- RM 02/10/80
- 
- 
- WITH REPORT ;
- PROCEDURE  A83A02B  IS
- 
-      USE REPORT ;
- 
-      TASK TYPE  TASK1  IS
-           ENTRY  E1 ;
-      END  TASK1 ;
- 
-      TASK BODY  TASK1  IS
-      BEGIN
- 
-           << LAB_TASK_MAIN >>                    NULL ;  -- A1    A
-           << LAB_TASK_BLOCKLOOP >>               NULL ;  -- A3
- 
-           BEGIN
- 
-                << LAB_TASKBLOCK_BLOCK >>         NULL ;  -- B2    B
-                << LAB_TASKBLOCK_LOOP >>          NULL ;  -- B4
- 
-                FOR  I  IN  1..2  LOOP
-                     << LAB_TASKBLOCKLOOP_BLOCK >>NULL ;  -- C2    C
-                     << LAB_TASKBLOCKLOOP_BLOCKLOOP >>
-                                                  NULL ;  -- C3        
-                END LOOP;
- 
-           END ;
- 
-           ACCEPT  E1  DO
-                << LAB_TASKACCEPT_MAIN >>         NULL ;  -- D1    D
-                << LAB_TASKACCEPT_LOOP >>         NULL ;  -- D4
-           END  E1 ;
- 
-      END  TASK1 ;
- 
- BEGIN                                                       
- 
-      TEST( "A83A02B" , "CHECK THAT A LABEL IN A NESTED TASK" &
-                        " CAN BE IDENTICAL TO A LABEL"   &
-                        " OUTSIDE THE TASK" );
- 
-      << LAB_TASK_MAIN >>                         NULL ;  -- A1         1
-      << LAB_TASKACCEPT_MAIN >>                   NULL ;  -- D1
- 
- 
-      BEGIN
- 
-           << LAB_TASKBLOCK_BLOCK >>              NULL ;  -- B2         2
-           << LAB_TASKBLOCKLOOP_BLOCK >>          NULL ;  -- C2
- 
-           FOR  I  IN  1..2  LOOP
-                << LAB_TASK_BLOCKLOOP >>          NULL ;  -- A3         3
-                << LAB_TASKBLOCKLOOP_BLOCKLOOP >> NULL ;  -- C3
-           END LOOP;
- 
-      END ;
- 
-      FOR  I  IN  1..2  LOOP
-           << LAB_TASKBLOCK_LOOP >>               NULL ;  -- B4         4
-           << LAB_TASKACCEPT_LOOP >>              NULL ;  -- D4
-      END LOOP;
- 
- 
-      RESULT ;
- 
- 
- END A83A02B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a06a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a06a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a06a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a06a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- A83A06A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A STATEMENT LABEL INSIDE A BLOCK BODY CAN BE THE
- --    SAME AS A VARIABLE, CONSTANT, NAMED LITERAL, SUBPROGRAM,
- --    ENUMERATION LITERAL, TYPE, OR PACKAGE DECLARED IN THE
- --    ENCLOSING BODY.
- 
- 
- -- RM 02/12/80
- -- JBG 5/16/83
- -- JBG 8/21/83
- -- JRK 12/19/83
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  A83A06A  IS
- 
-      LAB_VAR            :  INTEGER;
-      LAB_CONST          :  CONSTANT INTEGER := 12;
-      LAB_NAMEDLITERAL   :  CONSTANT := 13;
-      TYPE  ENUM  IS        ( AA , BB , LAB_ENUMERAL );
-      TYPE  LAB_TYPE  IS    NEW INTEGER;
- 
-      PROCEDURE  LAB_PROCEDURE  IS
-      BEGIN
-           NULL;
-      END LAB_PROCEDURE;
- 
-      FUNCTION  LAB_FUNCTION  RETURN INTEGER  IS
-      BEGIN
-           RETURN 7;
-      END LAB_FUNCTION;
- 
-      PACKAGE  LAB_PACKAGE  IS
-           INT : INTEGER;
-      END LAB_PACKAGE;
- 
- BEGIN
- 
-      TEST ("A83A06A", "CHECK THAT STATEMENT LABELS INSIDE A BLOCK " &
-                       "BODY CAN BE THE SAME AS IDENTIFIERS DECLARED "&
-                       "OUTSIDE THE BODY");
- 
-      LAB_BLOCK_1 :   BEGIN  NULL;  END     LAB_BLOCK_1;
- 
-      LAB_LOOP_1  :   LOOP   EXIT;  END LOOP LAB_LOOP_1;
- 
-      BEGIN
- 
-           << LAB_VAR >>                    -- OK.
-                BEGIN NULL; END;
-           << LAB_ENUMERAL >>        NULL;  -- OK.
- 
-      << LAB_PROCEDURE >>                   -- OK.
-           FOR  I  IN  INTEGER  LOOP
-                << LAB_CONST >>      NULL;  -- OK.
-                << LAB_TYPE >>       NULL;  -- OK.
-                << LAB_FUNCTION >>   EXIT;  -- OK.
-           END LOOP;
- 
-           << LAB_NAMEDLITERAL >>    NULL;  
-           << LAB_PACKAGE >>         NULL;  
-      END;
- 
-      LAB_BLOCK_2 :                          -- OK.
-           BEGIN  NULL;  END LAB_BLOCK_2;
- 
-      LAB_LOOP_2  :                          -- OK.
-           LOOP   EXIT;  END LOOP LAB_LOOP_2;
- 
-      RESULT;
- 
- END A83A06A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a08a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a08a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83a08a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83a08a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- A83A08A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     A STATEMENT LABEL DECLARED OUTSIDE A BLOCK CAN HAVE THE SAME
- --     IDENTIFIER AS AN ENTITY DECLARED IN THE BLOCK, AND A GOTO
- --     STATEMENT USING THE LABEL IS LEGAL OUTSIDE THE BLOCK.
- 
- -- HISTORY:
- --     PMW 09/20/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT;  USE REPORT;
- WITH SYSTEM;
- 
- PROCEDURE A83A08A IS
- 
-      PASSES : INTEGER := 0;
- 
- BEGIN
-      TEST ("A83A08A", "A STATEMENT LABEL DECLARED OUTSIDE A BLOCK " &
-                       "CAN HAVE THE SAME IDENTIFIER AS AN ENTITY " &
-                       "DECLARED IN THE BLOCK, AND A GOTO STATEMENT " &
-                       "USING THE LABEL IS LEGAL OUTSIDE THE BLOCK");
- 
-      GOTO LBLS;
- 
-      <<LBL>>
- 
-      DECLARE
-           LBL : INTEGER := 1;
-      BEGIN
-           LBL := IDENT_INT (LBL);
-           PASSES := PASSES + 1;
-      END;
- 
-      <<LBLS>>
- 
-      BEGIN
-           DECLARE
-                TYPE STUFF IS (LBL, LBL_ONE, LBL_TWO);
-                ITEM : STUFF := LBL;
- 
-                FUNCTION LBLS (ITEM : STUFF) RETURN BOOLEAN IS
-                BEGIN
-                     <<LBL_2>>
-                     CASE ITEM IS
-                          WHEN LBL => RETURN TRUE;
-                          WHEN LBL_ONE => PASSES := PASSES + 1;
-                          WHEN LBL_TWO => RETURN FALSE;
-                     END CASE;
-                     IF PASSES < 2 THEN
-                          PASSES := PASSES + 1;
-                          GOTO LBL_2;
-                     ELSE
-                          RETURN TRUE;
-                     END IF;
-                END LBLS;
- 
-           BEGIN
-                CASE PASSES IS
-                     WHEN 0 => ITEM := LBL;
-                     WHEN 1 => ITEM := LBL_ONE;
-                     WHEN OTHERS => ITEM := LBL_TWO;
-                END CASE;
-                IF NOT LBLS (ITEM) THEN
-                     COMMENT ("IRRELEVANT");
-                END IF;
-           END;
-      END;
- 
- 
-      IF PASSES > 1 THEN
-           GOTO ENOUGH;
-      END IF;
-      GOTO LBL;
- 
-      <<ENOUGH>>
- 
-      RESULT;
- 
- END A83A08A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83c01c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83c01c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83c01c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83c01c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- A83C01C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF
- --    FORMAL PARAMETERS, LABELS, LOOP PARAMETERS,
- --    VARIABLES, CONSTANTS, SUBPROGRAMS, PACKAGES, TYPES.
- -- (NAMES OF COMPONENTS IN LOGICALLY NESTED RECORDS ARE TESTED IN
- --    C83C01B.ADA .)
- -- (NAMES OF TASKS ARE TESTED IN  A83C01T.ADA .)
- 
- --    RM    24 JUNE 1980
- --    JRK   10 NOV  1980
- --    RM    01 JAN  1982
- 
- WITH REPORT;
- PROCEDURE  A83C01C  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "A83C01C" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" &
-                        " NAMES OF VARIABLES AND CONSTANTS " ) ;
- 
- 
- 
-      DECLARE
- 
-           VAR1 , VAR2 : INTEGER := 27 ;
-           CONST1      : CONSTANT INTEGER := 13 ;
-           CONST2      : CONSTANT BOOLEAN := FALSE ;
- 
-           TYPE  R1A  IS
-                RECORD
-                     VAR1,VAR2,CONST1:INTEGER ;
-                END RECORD ;
- 
-           TYPE  R1  IS
-                RECORD
-                     VAR1   : INTEGER ;
-                     VAR2   : BOOLEAN ;
-                     CONST1 : BOOLEAN ;
-                     A      : R1A ;
-                END RECORD ;
- 
-           A : R1 := ( VAR1 => VAR1 , A => ( VAR1 => VAR2 ,
-                                             VAR2 => VAR2 ,
-                                             CONST1 => VAR1 ) ,
-                       VAR2 => CONST2 , CONST1 => CONST2 ) ;
- 
-      BEGIN
- 
-           VAR1 := A.A.VAR2 ;
-           A.CONST1 := CONST2 ;
-           A.A.CONST1 := A.VAR1 + VAR2 ;
- 
-      END ;
- 
- 
-      RESULT;
- 
- END A83C01C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83c01h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83c01h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83c01h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83c01h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- A83C01H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF
- --    LABELS.
- 
- --    RM    24 JUNE 1980
- --    JRK   10 NOV  1980
- --    RM    01 JAN  1982
- 
- 
- WITH REPORT;
- PROCEDURE  A83C01H  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "A83C01H" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" &
-                        " NAMES OF LABELS" ) ;
- 
- 
-      -- TEST FOR LABELS
- 
-      DECLARE
- 
-           TYPE  R1A  IS
-                RECORD
-                     LAB3 : INTEGER ;
-                END RECORD ;
- 
-           TYPE  R1  IS
-                RECORD
-                     LAB1 : INTEGER ;
-                     LAB2 : R1A ;
-                END RECORD ;
- 
-           A1 : R1 := ( 1 , ( LAB3 => 5 ) );
- 
-      BEGIN
- 
-           << LAB1 >>
-           << LAB2 >>
-           << LAB3 >>
- 
-           A1.LAB1 := A1.LAB2.LAB3 ;
- 
-           DECLARE
- 
-                TYPE  R1A  IS
-                     RECORD
-                          LAB3 : INTEGER ;
-                          LAB4 : INTEGER ;
-                     END RECORD ;
- 
-                TYPE  R1  IS
-                     RECORD
-                          LAB1 : INTEGER ;
-                          LAB2 : R1A ;
-                     END RECORD ;
- 
-                A1 : R1 := ( 3 , ( 6 , 7 ) );
- 
-           BEGIN
- 
-                << LAB4 >>
- 
-                A1.LAB1 := A1.LAB2.LAB3 + A1.LAB2.LAB4 ;
- 
-           END ;
- 
-      END ;
- 
- 
- 
-      RESULT;
- 
- END A83C01H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83c01i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83c01i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a83c01i.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a83c01i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- A83C01I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF
- --    LOOP PARAMETERS.
- 
- --    RM    24 JUNE 1980
- --    JRK   10 NOV  1980
- --    RM    01 JAN  1982
- 
- 
- WITH REPORT;
- PROCEDURE  A83C01I  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "A83C01I" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" &
-                        " NAMES OF LOOP PARAMETERS" ) ;
- 
- 
- 
-      -- TEST FOR LOOP PARAMETERS
- 
- 
-      DECLARE
- 
-           TYPE  R1A  IS
-                RECORD
-                     LOOP3 : INTEGER ;
-                END RECORD ;
- 
-           TYPE  R1  IS
-                RECORD
-                     LOOP1 : INTEGER ;
-                     LOOP2 : R1A ;
-                END RECORD ;
- 
-           A1 : R1 := ( 3 , ( LOOP3 => 7 ) );
- 
-      BEGIN
- 
-           FOR  LOOP1  IN  0..1  LOOP
- 
-                FOR  LOOP2  IN  0..2  LOOP
- 
-                     FOR  LOOP3  IN  0..3  LOOP
- 
-                          A1.LOOP1 := A1.LOOP2.LOOP3 ;
- 
-                          DECLARE
- 
-                               TYPE  R1A  IS
-                                    RECORD
-                                         LOOP3 : INTEGER ;
-                                         LOOP4 : INTEGER ;
-                                    END RECORD ;
- 
-                               TYPE  R1  IS
-                                    RECORD
-                                         LOOP1 : INTEGER ;
-                                         LOOP2 : R1A ;
-                                    END RECORD ;
- 
-                               A1 : R1 := ( 3 , ( 6 , 7 ) );
- 
-                          BEGIN
- 
-                               FOR  LOOP4  IN  0..4  LOOP
- 
-                                    A1.LOOP1 := A1.LOOP2.LOOP3 +
-                                                A1.LOOP2.LOOP4 ;
- 
-                               END LOOP ;
- 
-                          END ;
- 
-                     END LOOP ;
- 
-                END LOOP ;
- 
-           END LOOP ;
- 
-      END ;
- 
- 
- 
-      RESULT;
- 
- END A83C01I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a85007d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a85007d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a85007d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a85007d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- A85007D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'FIRST, 'LAST, 'LENGTH, 'RANGE, 'ADDRESS, 'CONSTRAINED, 
- -- AND 'SIZE CAN BE APPLIED TO RENAMED NON-ACCESS OUT FORMAL PARAMETERS
- -- AND RENAMED COMPONENTS OF NON-ACCESS OUT PARAMETERS. 
- 
- -- SPS 02/21/84 (SEE A62006D-B.ADA)
- -- EG  02/22/84
- -- EG  05/30/84
- -- JBG 12/2/84
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- 
- PROCEDURE A85007D IS
-      
-      PROCEDURE Q (X : SYSTEM.ADDRESS) IS
-      BEGIN
-           NULL;
-      END Q;
- 
- BEGIN
- 
-      TEST ("A85007D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " &
-            "RENAMED NON-ACCESS FORMAL OUT PARAMETERS");
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN;
-           TYPE REC (D : INTEGER) IS RECORD
-                Y : BOOLEAN;
-                X : ARR;
-           END RECORD;
- 
-           PROCEDURE PROC (C2 : OUT ARR;
-                           C3 : OUT REC) IS
- 
-                X : SYSTEM.ADDRESS;
-                I : INTEGER;
- 
-                C21 : ARR RENAMES C2;
-                C22 : ARR RENAMES C21;
-                C31 : REC RENAMES C3;
-                C32 : REC RENAMES C31;
-                C33 : ARR RENAMES C3.X;
-                C34 : ARR RENAMES C33;
-                C35 : ARR RENAMES C32.X;
-                C36 : BOOLEAN RENAMES C3.Y;
-                C37 : BOOLEAN RENAMES C36;
-                C38 : BOOLEAN RENAMES C32.Y;
- 
-           BEGIN
- 
-                I := C21'LENGTH;
-                Q(C21'ADDRESS);
-                I := C21'SIZE;
-                I := C22'LENGTH;
-                Q(C22'ADDRESS);
-                I := C22'SIZE;
- 
-                FOR I IN C21'RANGE LOOP
-                     NULL;
-                END LOOP;
-                FOR I IN C22'RANGE LOOP
-                     NULL;
-                END LOOP;
- 
-                FOR I IN C21'FIRST..C21'LAST LOOP
-                     NULL;
-                END LOOP;
-                FOR I IN C22'FIRST..C22'LAST LOOP
-                     NULL;
-                END LOOP;
- 
-                I := C31.X'LENGTH;
-                C3.Y := C31'CONSTRAINED;        
-                FOR J IN C31.X'RANGE LOOP
-                     NULL;
-                END LOOP;
-                FOR J IN C31.X'FIRST..C31.X'LAST LOOP
-                     NULL;
-                END LOOP;
-                I := C32.X'LENGTH;
-                C31.Y := C32'CONSTRAINED;
-                FOR J IN C32.X'RANGE LOOP
-                     NULL;
-                END LOOP;
-                FOR J IN C32.X'FIRST..C32.X'LAST LOOP
-                     NULL;
-                END LOOP;
-                I := C33'LENGTH;
-                FOR J IN C33'RANGE LOOP
-                     NULL;
-                END LOOP;
-                FOR J IN C33'FIRST..C33'LAST LOOP
-                     NULL;
-                END LOOP;
-                I := C34'LENGTH;
-                FOR J IN C34'RANGE LOOP
-                     NULL;
-                END LOOP;
-                FOR J IN C34'FIRST..C34'LAST LOOP
-                     NULL;
-                END LOOP;
-                I := C35'LENGTH;
-                FOR J IN C35'RANGE LOOP
-                     NULL;
-                END LOOP;
-                FOR J IN C35'FIRST..C35'LAST LOOP
-                     NULL;
-                END LOOP;
- 
-                Q(C31.Y'ADDRESS);
-                I := C31.Y'SIZE;
-                Q(C32.Y'ADDRESS);
-                I := C32.Y'SIZE;
-                Q(C36'ADDRESS);
-                I := C36'SIZE;
-                Q(C37'ADDRESS);
-                I := C37'SIZE;
-                Q(C38'ADDRESS);
-                I := C38'SIZE;
- 
-           END PROC;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END A85007D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a85013b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a85013b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a85013b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a85013b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- A85013B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT:
- 
- --   A) A SUBPROGRAM OR ENTRY CAN BE RENAMED WITHIN ITS OWN BODY.
- 
- --   B) THE NEW NAME OF A SUBPROGRAM CAN BE USED IN A RENAMING
- --      DECLARATION.
- 
- -- EG  02/22/84
- 
- WITH REPORT;
- 
- PROCEDURE A85013B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("A85013B","CHECK THAT A SUBPROGRAM CAN BE RENAMED WITHIN " &
-                     "ITS OWN BODY AND THAT THE NEW NAME CAN BE USED" &
-                     " IN A RENAMING DECLARATION");
- 
-      DECLARE
- 
-           PROCEDURE PROC1 (A : BOOLEAN) IS
-                PROCEDURE PROC2 (B : BOOLEAN := FALSE) RENAMES PROC1;
-                PROCEDURE PROC3 (C : BOOLEAN := FALSE) RENAMES PROC2;
-           BEGIN
-                IF A THEN
-                     PROC3;
-                END IF;
-           END PROC1;
- 
-      BEGIN
- 
-           PROC1 (TRUE);
- 
-      END;
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-                PROCEDURE E1 RENAMES E;
-                PROCEDURE E2 RENAMES E1;
-           BEGIN
-                ACCEPT E DO
-                     DECLARE
-                          PROCEDURE E3 RENAMES E;
-                          PROCEDURE E4 RENAMES E3;
-                     BEGIN
-                          NULL;
-                     END;
-                END E;
-           END T;
- 
-      BEGIN
-           T.E;
-      END;
- 
-      RESULT;
- 
- END A85013B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a87b59a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a87b59a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a87b59a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a87b59a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,250 ****
- -- A87B59A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM PARAMETER MUST BE A 
- -- SUBPROGRAM, AN ENUMERATION LITERAL, OR AN ENTRY WITH THE SAME 
- -- PARAMETER AND RESULT TYPE PROFILE AS THE FORMAL PARAMETER, AN 
- -- OVERLOADED NAME APPEARING AS AN ACTUAL PARAMETER CAN BE RESOLVED.
- 
- -- R.WILLIAMS 9/24/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE A87B59A IS
- 
- BEGIN
-      TEST ( "A87B59A", "CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM " &
-                        "PARAMETER MUST BE A SUBPROGRAM, AN " &
-                        "ENUMERATION LITERAL, OR AN ENTRY WITH THE " &
-                        "SAME PARAMETER AND RESULT TYPE PROFILE AS " &
-                        "THE FORMAL PARAMETER, AN OVERLOADED NAME " &
-                        "APPEARING AS AN ACTUAL PARAMETER CAN BE " &
-                        "RESOLVED" );
- 
-      DECLARE -- A.
-           FUNCTION F1 RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (0);
-           END F1;
- 
-           FUNCTION F1 RETURN BOOLEAN IS
-           BEGIN
-                RETURN IDENT_BOOL (TRUE);
-           END F1;
- 
-           GENERIC
-                TYPE T IS (<>);
-                WITH FUNCTION F RETURN T;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-           BEGIN
-                NULL;
-           END P;
- 
-           PROCEDURE P1 IS NEW P (INTEGER, F1);
-           PROCEDURE P2 IS NEW P (BOOLEAN, F1);
- 
-      BEGIN         
-           P1;
-           P2;
-      END; -- A.
-           
-      DECLARE -- B.
-           FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (X);
-           END F1;
- 
-           FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN IDENT_BOOL (B);
-           END F1;
- 
-           FUNCTION F1 (B : BOOLEAN; X : INTEGER) RETURN BOOLEAN IS
-           BEGIN
-                RETURN IDENT_BOOL (B);
-           END F1;
-           
-           GENERIC
-                TYPE T1 IS (<>);
-                TYPE T2 IS (<>);
-                WITH FUNCTION F (A : T1; B : T2) RETURN T1;
-           PROCEDURE P1;
- 
-           PROCEDURE P1 IS
-           BEGIN
-                NULL;
-           END P1;
- 
-           GENERIC
-                TYPE T1 IS (<>);
-                TYPE T2 IS (<>);
-                WITH FUNCTION F (A : T1; B : T2) RETURN T2;
-           PROCEDURE P2;
- 
-           PROCEDURE P2 IS
-           BEGIN
-                NULL;
-           END P2;
- 
-           PROCEDURE PROC1 IS NEW P1 (INTEGER, BOOLEAN, F1);
-           PROCEDURE PROC2 IS NEW P1 (BOOLEAN, INTEGER, F1);
-           PROCEDURE PROC3 IS NEW P2 (INTEGER, BOOLEAN, F1);
- 
-      BEGIN         
-           PROC1;
-           PROC2;
-      END; -- B.
- 
-      DECLARE -- C.
-           TYPE COLOR IS (RED, YELLOW, BLUE);
-           C : COLOR;
- 
-           TYPE LIGHT IS (RED, YELLOW, GREEN);          
-           L : LIGHT;
- 
-           GENERIC
-                TYPE T IS (<>);
-                WITH FUNCTION F RETURN T;
-           FUNCTION GF RETURN T;
- 
-           FUNCTION GF RETURN T IS
-           BEGIN
-                RETURN T'VAL (IDENT_INT (T'POS (F)));
-           END GF;
- 
-           FUNCTION F1 IS NEW GF (COLOR, RED);
-           FUNCTION F2 IS NEW GF (LIGHT, YELLOW);
-      BEGIN
-           C := F1;
-           L := F2;
-      END; -- C.
- 
-      DECLARE -- D.
-           TASK TK IS
-                ENTRY E (X : INTEGER);
-                ENTRY E (X : BOOLEAN);
-                ENTRY E (X : INTEGER; Y : BOOLEAN);
-                ENTRY E (X : BOOLEAN; Y : INTEGER);
-           END TK;
- 
-           TASK BODY TK IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT E (X : INTEGER);
-                     OR
-                          ACCEPT E (X : BOOLEAN);
-                     OR 
-                          ACCEPT E (X : INTEGER; Y : BOOLEAN);
-                     OR 
-                          ACCEPT E (X : BOOLEAN; Y : INTEGER);
-                     OR 
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END TK;
- 
-           GENERIC
-                TYPE T1 IS (<>);
-                TYPE T2 IS (<>);
-                WITH PROCEDURE P1 (X : T1);
-                WITH PROCEDURE P2 (X : T1; Y : T2);
-           PACKAGE PKG IS 
-                PROCEDURE P;
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-                PROCEDURE P IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          P1 (T1'VAL (1));
-                          P2 (T1'VAL (0), T2'VAL (1));
-                     END IF;
-                END P;
-           END PKG;
- 
-           PACKAGE PK1 IS NEW PKG (INTEGER, BOOLEAN, TK.E, TK.E);
-           PACKAGE PK2 IS NEW PKG (BOOLEAN, INTEGER, TK.E, TK.E);
- 
-      BEGIN
-           PK1.P;
-           PK2.P;               
-      END; -- D.
- 
-      DECLARE -- E.
-           FUNCTION "+" (X, Y : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN IDENT_BOOL (X OR Y);
-           END "+";
- 
-           GENERIC
-                TYPE T IS (<>);
-                WITH FUNCTION "+" (X, Y : T) RETURN T;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                S : T;
-           BEGIN
-                S := "+" (T'VAL (0), T'VAL (1));
-           END P;
- 
-           PROCEDURE P1 IS NEW P (BOOLEAN, "+");
-           PROCEDURE P2 IS NEW P (INTEGER, "+");
-      
-      BEGIN
-           P1;
-           P2;
-      END; -- E.
-           
-      DECLARE -- F.
-           TYPE ADD_OPS IS ('+', '-', '&');
- 
-           GENERIC
-                TYPE T1 IS (<>);
-                TYPE T2 IS (<>);
-                TYPE T3 IS ARRAY (POSITIVE RANGE <> ) OF T2;
-                X2 : T2;
-                X3 : T3;
-                WITH FUNCTION F1 RETURN T1;
-                WITH FUNCTION F2 (X : T2; Y : T3) RETURN T3;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                A : T1;
-                S : T3 (IDENT_INT (1) .. IDENT_INT (2));               
-           BEGIN
-                A := F1;
-                S := F2 (X2, X3);               
-           END P;
-           
-           PROCEDURE P1 IS NEW P (ADD_OPS, CHARACTER, STRING,
-                                  '&', "&", '&', "&");
-      
-      BEGIN
-           P1;
-      END; -- F.
-           
-      RESULT;
- END A87B59A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a95001c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a95001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a95001c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a95001c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- A95001C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE BOUNDS OF THE DISCRETE RANGE OF AN ENTRY FAMILY
- -- ARE INTEGER LITERALS, NAMED NUMBERS, OR ATTRIBUTES HAVING TYPE 
- -- UNIVERSAL_INTEGER, BUT NOT EXPRESSIONS OF TYPE UNIVERSAL_INTEGER,
- -- THE INDEX (IN AN ENTRY NAME OR ACCEPT STATEMENT) IS OF THE
- -- PREDEFINED TYPE INTEGER.
- 
- -- WEI  3/4/82
- -- RJK  2/1/84     ADDED TO ACVC
- -- TBN  1/7/86     RENAMED FROM B950DHA-B.ADA.  ADDED NAMED CONSTANTS 
- --                 AND ATTRIBUTES AS KINDS OF BOUNDS, AND MADE TEST
- --                 EXECUTABLE.
- -- RJW 4/11/86     RENAMED FROM C95001C-B.ADA.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE A95001C IS
- 
-      SUBTYPE T IS INTEGER RANGE 1 .. 10;
-      I : INTEGER := 1;
-      NAMED_INT1 : CONSTANT := 1;
-      NAMED_INT2 : CONSTANT := 2;
- 
-      TASK T1 IS
-           ENTRY E1 (1 .. 2);
-           ENTRY E2 (NAMED_INT1 .. NAMED_INT2);
-           ENTRY E3 (T'POS(1) .. T'POS(2));
-      END T1;
- 
-      TASK BODY T1 IS
-           I_INT : INTEGER := 1;
-           I_POS : INTEGER := 2;
-      BEGIN
-           ACCEPT E1 (I_INT);
-           ACCEPT E2 (I_POS);
-           ACCEPT E3 (T'SUCC(1));
-      END T1;
- 
- BEGIN
-      TEST ("A95001C", "CHECK THAT IF THE BOUNDS OF THE DISCRETE " &
-                       "RANGE OF AN ENTRY FAMILY ARE INTEGER " &
-                       "LITERALS, NAMED NUMBERS, OR " &
-                       "(UNIVERSAL_INTEGER) ATTRIBUTES, THE INDEX " &
-                       "IS OF THE PREDEFINED TYPE INTEGER");
- 
-      T1.E1 (I);
-      T1.E2 (NAMED_INT2);
-      T1.E3 (T'SUCC(I));
- 
-      RESULT;
- END A95001C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a95074d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a95074d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a95074d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a95074d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- A95074D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'ADDRESS, 'CONSTRAINED, 'SIZE, 'POSITION, 'FIRST_BIT,
- -- AND 'LAST_BIT CAN BE APPLIED TO AN OUT PARAMETER OR OUT PARAMETER
- -- SUBCOMPONENT THAT DOES NOT HAVE AN ACCESS TYPE.
- 
- -- JWC 6/25/85
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE A95074D IS
- BEGIN
- 
-      TEST ("A95074D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " &
-            "NON-ACCESS FORMAL OUT PARAMETERS");
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN;
- 
-           TYPE REC (D : INTEGER := 1) IS RECORD
-                Y : BOOLEAN;
-                X : ARR;
-           END RECORD;
- 
-           TASK T IS
-                ENTRY E (C1 : OUT ARR; C2 : OUT REC);
-           END T;
- 
-           TASK BODY T IS
-                X : SYSTEM.ADDRESS;
-                I : INTEGER;
-           BEGIN
-                IF IDENT_BOOL (FALSE) THEN
-                     ACCEPT E (C1 : OUT ARR; C2 : OUT REC) DO
- 
-                          C2.Y := C2'CONSTRAINED;
- 
-                          X := C1'ADDRESS;
-                          X := C1(1)'ADDRESS;
-                          X := C2'ADDRESS;
-                          X := C2.Y'ADDRESS;
- 
-                          I := C1'SIZE;
-                          I := C2.Y'SIZE;
- 
-                          I := C2.X'POSITION;
-                          I := C2.Y'FIRST_BIT;
-                          I := C2.Y'LAST_BIT;
-                     END E;
-                END IF;
-           END T;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END A95074D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a97106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a97106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a97106a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a97106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- A97106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SELECTIVE_WAIT MAY HAVE MORE THAN ONE  'DELAY'  ALTER-
- --    NATIVE.
- 
- 
- -- RM 4/27/1982
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE  A97106A  IS
- 
- 
- BEGIN
- 
- 
-      TEST ( "A97106A" , "CHECK THAT A SELECTIVE_WAIT MAY HAVE" &
-                         " MORE THAN ONE  'DELAY'  ALTERNATIVE" );
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK TYPE  TT  IS
-                ENTRY  A ;
-           END  TT ;
- 
- 
-           TASK BODY  TT  IS
-                DUMMY : BOOLEAN := FALSE ;
-           BEGIN
- 
-                SELECT
-                          ACCEPT  A ;
-                OR
-                          DELAY 2.5 ;
-                OR
-                          ACCEPT  A ;
-                OR
-                          ACCEPT  A ;
-                OR
-                          DELAY 2.5 ;  -- MULTIPLE 'DELAY'S PERMITTED (IF
-                OR                     --     AND ONLY IF SINGLE 'DELAY'S
-                          DELAY 2.5 ;  --     ARE PERMITTED).
-                OR
-                          ACCEPT  A ;
-                END SELECT ;
- 
-           END  TT ;
- 
-      BEGIN
-           NULL ;
-      END ;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT;
- 
- 
- END  A97106A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a99006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a99006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/a99006a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/a99006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- A99006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'COUNT RETURNS A UNIVERSAL INTEGER VALUE.
- 
- -- HISTORY:
- --     DHH 03/28/88 CREATED ORIGINAL TEST.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE A99006A IS
- 
-      TASK CHOICE IS
-           ENTRY START;
-           ENTRY E1;
-           ENTRY STOP;
-      END CHOICE;
- 
-      TASK BODY CHOICE IS
-           X : INTEGER;
-      BEGIN
-           ACCEPT START;
-           ACCEPT E1 DO
-                DECLARE
-                     TYPE Y IS NEW INTEGER RANGE -5 .. 5;
-                     T : Y := E1'COUNT;
-                BEGIN
-                     X := E1'COUNT;
-                END;
-           END E1;
-           ACCEPT STOP;
-      END CHOICE;
- 
- BEGIN
- 
-      TEST("A99006A", "CHECK THAT 'COUNT RETURNS A UNIVERSAL INTEGER " &
-                      "VALUE");
- 
-      CHOICE.START;
-      CHOICE.E1;
-      CHOICE.STOP;
- 
-      RESULT;
- END A99006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/aa2010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/aa2010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/aa2010a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/aa2010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,199 ****
- -- AA2010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL TO IDENTIFIERS DECLARED IN
- -- STANDARD, NAMELY, BOOLEAN, INTEGER, FLOAT, CHARACTER, ASCII, 
- -- NATURAL, POSITIVE, STRING, DURATION, CONSTRAINT_ERROR, 
- -- NUMERIC_ERROR, PROGRAM_ERROR, STORAGE_ERROR, AND TASKING_ERROR.
- 
- -- R.WILLIAMS 9/18/86
- 
- PACKAGE AA2010A_TYPEDEF IS
-      TYPE ENUM IS (E1, E2, E3);
- END AA2010A_TYPEDEF;
- 
- WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF;
- PACKAGE AA2010A_PARENT IS
- 
-      PROCEDURE BOOLEAN;
-      FUNCTION INTEGER RETURN ENUM;
-      PACKAGE FLOAT IS END FLOAT;
- 
-      PROCEDURE CHARACTER;
-      FUNCTION ASCII RETURN ENUM;
- 
-      TASK NATURAL IS
-           ENTRY E;
-      END NATURAL;
- 
-      PROCEDURE POSITIVE;
-      FUNCTION STRING RETURN ENUM;
-      PACKAGE DURATION IS END DURATION;
- 
-      PROCEDURE CONSTRAINT_ERROR;
-      FUNCTION NUMERIC_ERROR RETURN ENUM;
- 
-      TASK PROGRAM_ERROR IS
-           ENTRY E;
-      END PROGRAM_ERROR;
- 
-      PROCEDURE STORAGE_ERROR;
-      FUNCTION TASKING_ERROR RETURN ENUM;
- 
- END AA2010A_PARENT;
- 
- PACKAGE BODY AA2010A_PARENT IS
- 
-      PROCEDURE BOOLEAN IS SEPARATE;
-      FUNCTION INTEGER RETURN ENUM IS SEPARATE;
-      PACKAGE BODY FLOAT IS SEPARATE;
- 
-      PROCEDURE CHARACTER IS SEPARATE;
-      FUNCTION ASCII RETURN ENUM IS SEPARATE;
-      TASK BODY NATURAL IS SEPARATE;
- 
-      PROCEDURE POSITIVE IS SEPARATE;
-      FUNCTION STRING RETURN ENUM IS SEPARATE;
-      PACKAGE BODY DURATION IS SEPARATE;
- 
-      PROCEDURE CONSTRAINT_ERROR IS SEPARATE;
-      FUNCTION NUMERIC_ERROR RETURN ENUM IS SEPARATE;
-      TASK BODY PROGRAM_ERROR IS SEPARATE;
- 
-      PROCEDURE STORAGE_ERROR IS SEPARATE;
-      FUNCTION TASKING_ERROR RETURN ENUM IS SEPARATE;
- 
- END AA2010A_PARENT;
- 
- SEPARATE (AA2010A_PARENT)
- PROCEDURE BOOLEAN IS 
- BEGIN
-      NULL;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- FUNCTION INTEGER RETURN ENUM IS 
- BEGIN
-      RETURN E1;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- PACKAGE BODY FLOAT IS END;
- 
- SEPARATE (AA2010A_PARENT)
- PROCEDURE CHARACTER IS 
- BEGIN
-      NULL;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- FUNCTION ASCII RETURN ENUM IS 
- BEGIN
-      RETURN E1;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- TASK BODY NATURAL IS 
- BEGIN
-      ACCEPT E;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- PROCEDURE POSITIVE IS 
- BEGIN
-      NULL;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- FUNCTION STRING RETURN ENUM IS 
- BEGIN
-      RETURN E1;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- PACKAGE BODY DURATION IS END;
- 
- SEPARATE (AA2010A_PARENT)
- PROCEDURE CONSTRAINT_ERROR IS 
- BEGIN
-      NULL;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- FUNCTION NUMERIC_ERROR RETURN ENUM IS 
- BEGIN
-      RETURN E1;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- TASK BODY PROGRAM_ERROR IS 
- BEGIN
-      ACCEPT E;     
- END;
- 
- SEPARATE (AA2010A_PARENT)
- PROCEDURE STORAGE_ERROR IS 
- BEGIN
-      NULL;
- END;
- 
- SEPARATE (AA2010A_PARENT)
- FUNCTION TASKING_ERROR RETURN ENUM IS 
- BEGIN
-      RETURN E1;
- END;
- 
- WITH REPORT; USE REPORT;
- WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF;
- WITH AA2010A_PARENT; USE AA2010A_PARENT; 
- PROCEDURE AA2010A IS
-      E : ENUM;
- BEGIN
-      TEST ( "AA2010A", "CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL " &
-                        "TO IDENTIFIERS DECLARED IN STANDARD, " &
-                        "NAMELY, BOOLEAN, INTEGER, FLOAT, " &
-                        "CHARACTER, ASCII, NATURAL, POSITIVE, " &
-                        "STRING, DURATION, CONSTRAINT_ERROR, " &
-                        "NUMERIC_ERROR, PROGRAM_ERROR, " &
-                        "STORAGE_ERROR, AND TASKING_ERROR" );
-      
-      AA2010A_PARENT.BOOLEAN;
-      E := AA2010A_PARENT.INTEGER;
- 
-      AA2010A_PARENT.CHARACTER;
-      E := AA2010A_PARENT.ASCII;
-      AA2010A_PARENT.NATURAL.E;
- 
-      AA2010A_PARENT.POSITIVE;
-      E := AA2010A_PARENT.STRING;
- 
-      AA2010A_PARENT.CONSTRAINT_ERROR;
-      E := AA2010A_PARENT.NUMERIC_ERROR;
-      AA2010A_PARENT.PROGRAM_ERROR.E;
- 
-      AA2010A_PARENT.STORAGE_ERROR;
-      E := AA2010A_PARENT.TASKING_ERROR;
- 
-      RESULT;
- END AA2010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/aa2012a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/aa2012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/aa2012a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/aa2012a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- AA2012A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A BODY STUB CAN SERVE AS AN IMPLICIT DECLARATION OF A 
- -- SUBPROGRAM, I.E., A PRECEDING SUBPROGRAM DECLARATION IS NOT 
- -- REQUIRED.
- 
- -- R.WILLIAMS 9/18/86
- 
- PROCEDURE AA2012A1 IS
- 
-      I : INTEGER;
- 
-      PROCEDURE AA2012A2 IS SEPARATE;
- 
-      FUNCTION AA2012A3 RETURN INTEGER IS SEPARATE;
- 
- BEGIN
-      AA2012A2;
-      I := AA2012A3;
- 
- END AA2012A1;
- 
- SEPARATE (AA2012A1)
- PROCEDURE AA2012A2 IS
- BEGIN
-      NULL;
- END;
- 
- SEPARATE (AA2012A1)
- FUNCTION AA2012A3 RETURN INTEGER IS
- BEGIN
-      RETURN 5;
- END;
-      
- WITH AA2012A1;
- WITH REPORT; USE REPORT;
- PROCEDURE AA2012A IS
- 
- BEGIN
-      TEST ( "AA2012A", "CHECK THAT A BODY STUB CAN SERVE AS AN " &
-                        "IMPLICIT DECLARATION OF A SUBPROGRAM, " &
-                        "I.E., A PRECEDING SUBPROGRAM DECLARATION " &
-                        "IS NOT REQUIRED" );
- 
-      AA2012A1;
- 
-      RESULT;
- END AA2012A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac1015b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac1015b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac1015b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac1015b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- AC1015B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WITHIN A GENERIC SUBPROGRAM THE NAME OF THE GENERIC
- --     SUBPROGRAM CAN BE USED AS AN ACTUAL PARAMETER IN AN
- --     INSTANTIATION.
- 
- -- HISTORY:
- --     BCB 03/28/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE AC1015B IS
- 
-      GENERIC
-      PROCEDURE P;
- 
-      PROCEDURE P IS
-           GENERIC
-                WITH PROCEDURE F;
-           PROCEDURE T;
- 
-           PROCEDURE T IS
-           BEGIN
-                NULL;
-           END T;
- 
-           PROCEDURE S IS NEW T(F => P);
- 
-      BEGIN
-           NULL;
-      END P;
- 
-      GENERIC
-      FUNCTION D RETURN BOOLEAN;
- 
-      FUNCTION D RETURN BOOLEAN IS
-           GENERIC
-                WITH FUNCTION L RETURN BOOLEAN;
-           FUNCTION A RETURN BOOLEAN;
- 
-           FUNCTION A RETURN BOOLEAN IS
-           BEGIN
-                RETURN TRUE;
-           END A;
- 
-           FUNCTION B IS NEW A(L => D);
- 
-      BEGIN
-           RETURN TRUE;
-      END D;
- 
- BEGIN
-      TEST ("AC1015B", "CHECK THAT WITHIN A GENERIC SUBPROGRAM THE " &
-                       "NAME OF THE GENERIC SUBPROGRAM CAN BE USED AS " &
-                       "AN ACTUAL PARAMETER IN AN INSTANTIATION");
- 
-      RESULT;
- END AC1015B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac3106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac3106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac3106a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac3106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- AC3106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ACTUAL GENERIC IN OUT PARAMETER CAN BE:
- --          A) ANY SUBCOMPONENT THAT DOES NOT DEPEND ON A DISCRIMINANT,
- --             EVEN IF THE ENCLOSING VARIABLE IS UNCONSTRAINED;
- --          B) ANY SUBCOMPONENT OF AN UNCONSTAINED VARIABLE OF A
- --             RECORD TYPE IF THE DISCRIMINANTS OF THE
- --             VARIABLE DO NOT HAVE DEFAULTS AND THE VARIABLE IS NOT
- --             A GENERIC FORMAL IN OUT PARAMETER;
- --          C) ANY COMPONENT OF AN OBJECT DESIGNATED BY AN ACCESS
- --             VALUE.
- 
- -- HISTORY:
- --     RJW 11/07/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE AC3106A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
- 
-      TYPE REC (D : INT := 0) IS RECORD
-           A : INTEGER := 5;
-           CASE D IS
-                WHEN OTHERS =>
-                     V : INTEGER := 5;
-           END CASE;
-      END RECORD;
- 
-      TYPE AR_REC IS ARRAY (1 .. 10) OF REC;
- 
-      TYPE R_REC IS RECORD
-           E : REC;
-      END RECORD;
- 
-      TYPE A_STRING IS ACCESS STRING;
-      TYPE A_REC IS ACCESS REC;
-      TYPE A_AR_REC IS ACCESS AR_REC;
-      TYPE A_R_REC IS ACCESS R_REC;
- 
-      TYPE DIS (L : INT := 1) IS RECORD
-           S : STRING (1 .. L) := "A";
-           R : REC (L);
-           AS : A_STRING (1 .. L) := NEW STRING (1 .. L);
-           AR : A_REC (L) := NEW REC (1);
-           RC : REC (3);
-           ARU : A_REC := NEW REC;
-           V_AR : AR_REC;
-           V_R : R_REC;
-           AC_AR : A_AR_REC := NEW AR_REC;
-           AC_R : A_R_REC := NEW R_REC;
-      END RECORD;
- 
-      TYPE A_DIS IS ACCESS DIS;
-      AD : A_DIS := NEW DIS;
- 
-      TYPE DIS2 (L : INT) IS RECORD
-           S : STRING (1 .. L);
-           R : REC (L);
-           AS : A_STRING (1 .. L);
-           AR : A_REC (L);
-      END RECORD;
- 
-      X : DIS;
- 
-      SUBTYPE REC3 IS REC (3);
- 
-      GENERIC
-           GREC3 : IN OUT REC3;
-      PACKAGE PREC3 IS END PREC3;
- 
-      SUBTYPE REC0 IS REC (0);
- 
-      GENERIC
-           GREC0 : IN OUT REC0;
-      PACKAGE PREC0 IS END PREC0;
- 
-      GENERIC
-           GINT : IN OUT INTEGER;
-      PACKAGE PINT IS END PINT;
- 
-      GENERIC
-           GA_REC : IN OUT A_REC;
-      PACKAGE PA_REC IS END PA_REC;
- 
-      GENERIC
-           GAR_REC : IN OUT AR_REC;
-      PACKAGE PAR_REC IS END PAR_REC;
- 
-      GENERIC
-           GR_REC : IN OUT R_REC;
-      PACKAGE PR_REC IS END PR_REC;
- 
-      GENERIC
-           GA_AR_REC : IN OUT A_AR_REC;
-      PACKAGE PA_AR_REC IS END PA_AR_REC;
- 
-      GENERIC
-           GA_R_REC : IN OUT A_R_REC;
-      PACKAGE PA_R_REC IS END PA_R_REC;
- 
-      TYPE BUFFER (SIZE : INT) IS RECORD
-           POS : NATURAL := 0;
-           VAL : STRING (1 .. SIZE);
-      END RECORD;
- 
-      SUBTYPE BUFF_5 IS BUFFER (5);
- 
-      GENERIC
-           Y : IN OUT CHARACTER;
-      PACKAGE P_CHAR IS END P_CHAR;
- 
-      SUBTYPE STRING5 IS STRING (1 .. 5);
-      GENERIC
-           GSTRING : STRING5;
-      PACKAGE P_STRING IS END P_STRING;
- 
-      GENERIC
-           GA_STRING : A_STRING;
-      PACKAGE P_A_STRING IS END P_A_STRING;
- 
-      GENERIC
-           X : IN OUT BUFF_5;
-      PACKAGE P_BUFF IS
-           RX : BUFF_5 RENAMES X;
-      END P_BUFF;
- 
-      Z : BUFFER (1) := (SIZE => 1, POS =>82, VAL =>"R");
- BEGIN
-      TEST ("AC3106A", "CHECK THE PERMITTED FORMS OF AN ACTUAL " &
-                       "GENERIC IN OUT PARAMETER");
- 
-      DECLARE -- A)
-           PACKAGE NPINT3 IS NEW PINT (X.RC.A);
-           PACKAGE NPINT4 IS NEW PINT (X.RC.V);
-           PACKAGE NPREC3 IS NEW PREC3 (X.RC);
-           PACKAGE NPA_REC IS NEW PA_REC (X.ARU);
-           PACKAGE NPINT5 IS NEW PINT (X.ARU.A);
-           PACKAGE NPINT6 IS NEW PINT (X.ARU.V);
-           PACKAGE NPAR_REC IS NEW PAR_REC (X.V_AR);
-           PACKAGE NPREC01 IS NEW PREC0 (X.V_AR (1));
-           PACKAGE NPR_REC IS NEW PR_REC (X.V_R);
-           PACKAGE NPREC02 IS NEW PREC0 (X.V_R.E);
-           PACKAGE NPINT7 IS NEW PINT (X.V_R.E.A);
- 
-           PACKAGE NP_BUFF IS NEW P_BUFF (Z);
-           USE NP_BUFF;
- 
-           PACKAGE NP_CHAR3 IS NEW P_CHAR (RX.VAL (1));
- 
-           PROCEDURE PROC (X : IN OUT BUFFER) IS
-                PACKAGE NP_CHAR4 IS NEW P_CHAR (X.VAL (1));
-           BEGIN
-                NULL;
-           END;
-      BEGIN
-           NULL;
-      END; -- A)
- 
-      DECLARE -- B)
-           PROCEDURE PROC (Y : IN OUT DIS2) IS
-                PACKAGE NP_STRING IS NEW P_STRING (Y.S);
-                PACKAGE NP_CHAR IS NEW P_CHAR (Y.S (1));
-                PACKAGE NP_A_STRING IS NEW P_A_STRING (Y.AS);
-                PACKAGE NP_CHAR2 IS NEW P_CHAR (Y.AS (1));
-                PACKAGE NPINT3 IS NEW PINT (Y.R.A);
-                PACKAGE NPINT4 IS NEW PINT (Y.R.V);
-                PACKAGE NPREC3 IS NEW PREC3 (Y.R);
-                PACKAGE NPA_REC IS NEW PA_REC (Y.AR);
-                PACKAGE NPINT5 IS NEW PINT (Y.AR.A);
-                PACKAGE NPINT6 IS NEW PINT (Y.AR.V);
-           BEGIN
-                NULL;
-           END;
-      BEGIN
-           NULL;
-      END; -- B)
- 
-      DECLARE -- C)
-           PACKAGE NP_CHAR IS NEW P_CHAR (AD.S (1));
-           PACKAGE NP_A_STRING IS NEW P_A_STRING (AD.AS);
-           PACKAGE NP_CHAR2 IS NEW P_CHAR (AD.AS (1));
-           PACKAGE NPINT3 IS NEW PINT (AD.R.A);
-           PACKAGE NPINT4 IS NEW PINT (AD.R.V);
-           PACKAGE NPREC3 IS NEW PREC3 (AD.R);
-           PACKAGE NPA_REC IS NEW PA_REC (AD.AR);
-           PACKAGE NPINT5 IS NEW PINT (AD.AR.A);
-           PACKAGE NPINT6 IS NEW PINT (AD.AR.V);
-      BEGIN
-           NULL;
-      END; -- C)
- 
-      RESULT;
- END AC3106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac3206a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac3206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac3206a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac3206a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- AC3206A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN INSTANTIATION IS LEGAL IF A FORMAL PRIVATE TYPE IS
- --     USED IN  A CONSTANT DECLARATION AND THE ACTUAL PARAMETER IS A
- --     TYPE WITH DISCRIMINANTS THAT DO AND DO NOT HAVE DEFAULTS. (CHECK
- --     CASES THAT USED TO BE FORBIDDEN).
- 
- -- HISTORY:
- --     DHH 09/16/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE AC3206A IS
- 
- BEGIN
-      TEST ("AC3206A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " &
-                       "FORMAL PRIVATE TYPE IS USED IN  A CONSTANT " &
-                       "DECLARATION AND THE ACTUAL PARAMETER IS A " &
-                       "TYPE WITH DISCRIMINANTS THAT DO AND DO NOT " &
-                       "HAVE DEFAULTS");
- 
-      DECLARE             -- CHECK DEFAULTS LEGAL UNDER AI-37.
- 
-           GENERIC
-                TYPE GEN IS PRIVATE;
-                INIT : GEN;
-           PACKAGE GEN_PACK IS
-                CONST : CONSTANT GEN := INIT;
-                SUBTYPE NEW_GEN IS GEN;
-           END GEN_PACK;
- 
-           TYPE REC(A : INTEGER := 4) IS
-                RECORD
-                     X : INTEGER;
-                     Y : BOOLEAN;
-                END RECORD;
- 
-           PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE));
-           USE P;
- 
-           CON : CONSTANT P.NEW_GEN := (4, 5, FALSE);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE
- 
-           GENERIC
-                TYPE GEN(DIS : INTEGER) IS PRIVATE;
-                INIT : GEN;
-           PACKAGE GEN_PACK IS
-                CONST : CONSTANT GEN := INIT;
-                SUBTYPE NEW_GEN IS GEN(4);
-           END GEN_PACK;
- 
-           TYPE REC(A : INTEGER := 4) IS
-                RECORD
-                     X : INTEGER;
-                     Y : BOOLEAN;
-                END RECORD;
- 
-           PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE));
-           USE P;
- 
-           CON : CONSTANT P.NEW_GEN := (4, 5, FALSE);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE
- 
-           GENERIC
-                TYPE GEN(DIS : INTEGER) IS PRIVATE;
-                INIT : GEN;
-           PACKAGE GEN_PACK IS
-                CONST : CONSTANT GEN := INIT;
-                SUBTYPE NEW_GEN IS GEN(4);
-           END GEN_PACK;
- 
-           TYPE REC(A : INTEGER) IS
-                RECORD
-                     X : INTEGER;
-                     Y : BOOLEAN;
-                END RECORD;
- 
-           PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE));
-           USE P;
- 
-           CON : CONSTANT P.NEW_GEN := (4, 5, FALSE);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END AC3206A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac3207a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac3207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ac3207a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ac3207a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- AC3207A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN INSTANTIATION IS LEGAL IF A FORMAL PARAMETER
- --     HAVING A LIMITED PRIVATE TYPE WITHOUT DISCRIMINANTS IS USED TO
- --     DECLARE AN OBJECT IN A BLOCK THAT CONTAINS A SELECTIVE WAIT
- --     WITH A TERMINATE ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE
- --     TYPE IS A TASK TYPE OR A TYPE WITH A SUBCOMPONENT OF A TASK TYPE.
- 
- -- HISTORY:
- --     DHH 09/16/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE AC3207A IS
- 
-      GENERIC
-           TYPE PRIV IS LIMITED PRIVATE;
-      PACKAGE GEN_P IS
-           TASK T1 IS
-                ENTRY E;
-           END T1;
-      END GEN_P;
- 
-      TASK TYPE TASK_T IS
-      END TASK_T;
- 
-      TYPE REC IS
-           RECORD
-                OBJ : TASK_T;
-           END RECORD;
- 
-      PACKAGE BODY GEN_P IS
-           TASK BODY T1 IS
-           BEGIN
-                DECLARE
-                     OBJ : PRIV;
-                BEGIN
-                     SELECT
-                          ACCEPT E;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END;
-           END T1;
-      END GEN_P;
- 
-      TASK BODY TASK_T IS
-      BEGIN
-           NULL;
-      END;
- 
-      PACKAGE P IS NEW GEN_P(TASK_T);
-      PACKAGE NEW_P IS NEW GEN_P(REC);
- 
- BEGIN
-      TEST ("AC3207A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " &
-                       "FORMAL PARAMETER HAVING A LIMITED PRIVATE " &
-                       "TYPE WITHOUT DISCRIMINANTS IS USED TO " &
-                       "DECLARE AN OBJECT IN A BLOCK THAT CONTAINS " &
-                       "A SELECTIVE WAIT WITH A TERMINATE " &
-                       "ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE " &
-                       "TYPE IS A TASK TYPE OR A TYPE WITH A " &
-                       "SUBCOMPONENT OF A TASK TYPE");
- 
-      P.T1.E;
- 
-      NEW_P.T1.E;
- 
-      RESULT;
- END AC3207A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- AD7001B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
- --     IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE UNIT
- --     CONTAINING THE REFERENCES.
- 
- -- HISTORY:
- --     JET 09/08/87  CREATED ORIGINAL TEST.
- --     VCL 03/30/88  CREATED NAMED NUMBERS WITH VALUES OF
- --                   SYSTEM.MIN_INT AND SYSTEM.MAX_INT. DELETED
- --                   ASSIGNMENTS OF MIN_INT AND MAX_INT TO INTEGER
- --                   VARIABLES.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7001B IS
- 
-      CHECK_ADDRESS  : SYSTEM.ADDRESS;
-      CHECK_NAME     : SYSTEM.NAME := SYSTEM.SYSTEM_NAME;
-      CHECK_PRIORITY : SYSTEM.PRIORITY;
-      I              : INTEGER;
-      F              : FLOAT;
-      SMALL          : CONSTANT := SYSTEM.MIN_INT;
-      LARGE          : CONSTANT := SYSTEM.MAX_INT;
-      MEM            : CONSTANT := SYSTEM.MEMORY_SIZE;
- 
- BEGIN
- 
-      TEST ("AD7001B", "CHECK THAT A DECLARATION IN PACKAGE " &
-                       "SYSTEM IS ACCESSIBLE IF A WITH CLAUSE " &
-                       "NAMING SYSTEM IS PROVIDED FOR THE UNIT " &
-                       "CONTAINING THE REFERENCES");
- 
-      I := SYSTEM.STORAGE_UNIT;
-      I := SYSTEM.MAX_DIGITS;
-      I := SYSTEM.MAX_MANTISSA;
-      F := SYSTEM.FINE_DELTA;
-      F := SYSTEM.TICK;
- 
-      RESULT;
- 
- END AD7001B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- AD7001C0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
- --     IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM
- --     IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN A
- --     SEPARATE FILE.
- 
- -- HISTORY:
- --     JET 09/09/87  CREATED ORIGINAL TEST.
- --     RJW 05/03/88  REVISED AND ENTERED TEST INTO ACVC.
- --     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- -- THIS FILE CONTAINS PACKAGE SPEC AD7001C_PACKAGE AND THE MAIN
- --     PROCEDURE FOR TEST AD7001C.  FILE AD7001C1.ADA CONTAINS
- --     THE PACKAGE BODY FOR THE PACKAGE SPEC AND IS ALSO REQUIRED
- --     FOR TEST EXECUTION.
- 
- WITH SYSTEM;
- 
- PACKAGE AD7001C_PACKAGE IS
- 
-      I : INTEGER;
-      F : FLOAT;
- 
-   PROCEDURE REQUIRE_BODY;
- 
- END AD7001C_PACKAGE;
- 
- 
- WITH AD7001C_PACKAGE; USE AD7001C_PACKAGE;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7001C0M IS
- 
- BEGIN
-      TEST ("AD7001C", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " &
-                       "IS ACCESSIBLE IN A LIBRARY PACKAGE BODY IF " &
-                       "A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR " &
-                       "THE PACKAGE SPECIFICATION, ALTHOUGH IN A " &
-                       "SEPARATE FILE");
-      RESULT;
- END AD7001C0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- AD7001C1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
- --     IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM
- --     IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN ANOTHER
- --     FILE.
- 
- -- HISTORY:
- --     JET 09/09/87  CREATED ORIGINAL TEST.
- --     RJW 05/03/88  REVISED AND ENTERED IN ACVC.
- --     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- -- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001C_PACKAGE.
- --     FILE AD7001C0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE
- --     FOR TEST AD7001C AND IS ALSO REQUIRED FOR TEST EXECUTION.
- 
- PACKAGE BODY AD7001C_PACKAGE IS
- 
-      CHECK_ADDRESS  : SYSTEM.ADDRESS;
-      CHECK_NAME     : SYSTEM.NAME := SYSTEM.SYSTEM_NAME;
-      CHECK_PRIORITY : SYSTEM.PRIORITY;
-      MEM_SIZE       : CONSTANT := SYSTEM.MEMORY_SIZE;
- 
-      TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- 
- BEGIN
-      I := SYSTEM.STORAGE_UNIT;
-      I := SYSTEM.MAX_DIGITS;
-      I := SYSTEM.MAX_MANTISSA;
-      F := SYSTEM.FINE_DELTA;
-      F := SYSTEM.TICK;
- END AD7001C_PACKAGE;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- AD7001D0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
- --     IN A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED
- --     FOR THE MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A
- --     SEPARATE FILE.
- 
- -- HISTORY:
- --     JET 09/09/87  CREATED ORIGINAL TEST.
- --     RJW 05/03/88  REVISED AND ENTERED TEST INTO ACVC.
- 
- -- THIS FILE CONTAINS THE MAIN PROCEDURE FOR TEST AD7001D.  FILE
- --     AD7001D1.ADA CONTAINS THE PACKAGE BODY FOR THE SUBUNIT PACKAGE
- --     SPEC AND IS ALSO REQUIRED FOR TEST EXECUTION.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7001D0M IS
- 
-      PACKAGE AD7001D_PACKAGE IS
- 
-           I : INTEGER;
-           F : FLOAT;
- 
-      END AD7001D_PACKAGE;
- 
-      PACKAGE BODY AD7001D_PACKAGE IS SEPARATE;
- 
- BEGIN
-      TEST ("AD7001D", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " &
-                       "IS ACCESSIBLE IN A SUBUNIT IF A WITH CLAUSE " &
-                       "NAMING SYSTEM IS PROVIDED FOR THE MAIN UNIT " &
-                       "CONTAINING THE SUBUNIT, ALTHOUGH IN A " &
-                       "SEPARATE FILE");
-      RESULT;
- END AD7001D0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- AD7001D1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE IN
- --     A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE
- --     MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A SEPARATE
- --     FILE.
- 
- -- HISTORY:
- --     JET 09/09/87  CREATED ORIGINAL TEST.
- 
- -- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001D_PACKAGE.
- --     FILE AD7001D0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE
- --     FOR TEST AD7001D AND IS ALSO REQUIRED FOR TEST EXECUTION.
- 
- SEPARATE (AD7001D0M)
- 
- PACKAGE BODY AD7001D_PACKAGE IS
- 
-      CHECK_ADDRESS  : SYSTEM.ADDRESS;
-      CHECK_NAME     : SYSTEM.NAME := SYSTEM.SYSTEM_NAME;
-      CHECK_PRIORITY : SYSTEM.PRIORITY;
-      MEM_SIZE       : CONSTANT := SYSTEM.MEMORY_SIZE;
- 
-      TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
- 
- BEGIN
-      I := SYSTEM.STORAGE_UNIT;
-      I := SYSTEM.MAX_DIGITS;
-      I := SYSTEM.MAX_MANTISSA;
-      F := SYSTEM.FINE_DELTA;
-      F := SYSTEM.TICK;
- END AD7001D_PACKAGE;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7006a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,47 ****
- -- AD7006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS DECLARED AND
- --     THAT IT IS A STATIC UNIVERSAL INTEGER.
- 
- -- HISTORY:
- --     VCL  09/14/87  CREATED ORIGINAL TEST.
- --     RJW  06/13/89  MODIFIED TEST AND REMOVED INTEGER VARIABLE.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE AD7006A IS
- BEGIN
-      TEST ("AD7006A", "THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS " &
-                       "DECLARED AND IT IS A STATIC UNIVERSAL " &
-                       "INTEGER");
- 
-      DECLARE
-           MY_MSIZE : CONSTANT := SYSTEM.MEMORY_SIZE - 1;
-      BEGIN
-           RESULT;
-      END;
- 
- END AD7006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7101a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7101a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7101a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- AD7101A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT MIN_INT AND MAX_INT ARE DECLARED IN PACKAGE SYSTEM
- --     AND THAT BOTH ARE STATIC AND HAVE TYPE <UNIVERSAL INTEGER>.
- 
- -- HISTORY:
- --     JET 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7101A IS
- 
- U_MIN : CONSTANT := SYSTEM.MIN_INT;
- U_MAX : CONSTANT := SYSTEM.MAX_INT;
- 
- TYPE S_MIN IS RANGE SYSTEM.MIN_INT .. 7;
- TYPE S_MAX IS RANGE 7 .. SYSTEM.MAX_INT;
- 
- BEGIN
- 
-      TEST ("AD7101A", "CHECK THAT MIN_INT AND MAX_INT ARE DECLARED " &
-                       "IN PACKAGE SYSTEM AND THAT BOTH ARE STATIC " &
-                       "AND HAVE TYPE <UNIVERSAL INTEGER>");
- 
-      RESULT;
- 
- END AD7101A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7101c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7101c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7101c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7101c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- AD7101C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT TYPE DEFINITIONS WITH RANGES -MAX_INT .. MAX_INT
- --     AND MIN_INT .. MAX_INT ARE ACCEPTED.
- 
- -- HISTORY:
- --     JET 09/10/87  CREATED ORIGINAL TEST.
- --     VCL 03/30/88  CHANGED INTEGER SUBTYPE DECLARATIONS TO TYPE
- --                   DEFINITIONS.
- 
- WITH SYSTEM;  USE SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7101C IS
- 
-      TYPE CHECK1 IS RANGE -MAX_INT .. MAX_INT;
-      TYPE CHECK2 IS RANGE  MIN_INT .. MAX_INT;
- 
- BEGIN
- 
-      TEST ("AD7101C", "CHECK THAT TYPE DEFINITIONS WITH RANGES " &
-                       "-MAX_INT .. MAX_INT AND MIN_INT .. MAX_INT " &
-                       "ARE ACCEPTED");
- 
-      RESULT;
- 
- END AD7101C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7102a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7102a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7102a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- AD7102A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE CONSTANT MAX_DIGITS IS DECLARED WITHIN THE
- --     PACKAGE SYSTEM, THAT ITS TYPE IS <UNIVERSAL_INTEGER>, AND THAT
- --     ITS VALUE IS STATIC.
- 
- -- HISTORY:
- --     BCB 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7102A IS
- 
-      U_DIGITS : CONSTANT := SYSTEM.MAX_DIGITS;
- 
-      TYPE S_DIGITS IS RANGE 7 .. SYSTEM.MAX_DIGITS;
- 
- BEGIN
- 
-      TEST ("AD7102A", "CHECK THAT THE CONSTANT MAX_DIGITS IS " &
-                       "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " &
-                       "TYPE IS <UNIVERSAL_INTEGER>, AND THAT ITS " &
-                       "VALUE IS STATIC");
-      RESULT;
- 
- END AD7102A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7103a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7103a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7103a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- AD7103A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE CONSTANT MAX_MANTISSA IS DECLARED WITHIN THE
- --     PACKAGE SYSTEM, THAT ITS TYPE IS <UNIVERSAL_INTEGER>, AND THAT
- --     ITS VALUE IS STATIC.
- 
- -- HISTORY:
- --     BCB 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7103A IS
- 
-      U_MANTISSA : CONSTANT := SYSTEM.MAX_MANTISSA;
- 
-      TYPE S_MANTISSA IS RANGE 7 .. SYSTEM.MAX_MANTISSA;
- 
- BEGIN
- 
-      TEST ("AD7103A", "CHECK THAT THE CONSTANT MAX_MANTISSA IS " &
-                       "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " &
-                       "TYPE IS <UNIVERSAL_INTEGER>, AND THAT ITS " &
-                       "VALUE IS STATIC");
-      RESULT;
- 
- END AD7103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7103c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7103c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7103c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7103c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- AD7103C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE CONSTANT FINE_DELTA IS DECLARED WITHIN THE
- --     PACKAGE SYSTEM, THAT ITS TYPE IS <UNIVERSAL_REAL>, AND THAT
- --     ITS VALUE IS STATIC.
- 
- -- HISTORY:
- --     BCB 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7103C IS
- 
-      U_DELTA : CONSTANT := SYSTEM.FINE_DELTA;
- 
-      TYPE S_DELTA IS DELTA SYSTEM.FINE_DELTA RANGE -1.0 .. 1.0;
- 
- BEGIN
- 
-      TEST ("AD7103C", "CHECK THAT THE CONSTANT FINE_DELTA IS " &
-                       "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " &
-                       "TYPE IS <UNIVERSAL_REAL>, AND THAT ITS " &
-                       "VALUE IS STATIC");
-      RESULT;
- 
- END AD7103C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7104a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- AD7104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE CONSTANT TICK IS DECLARED WITHIN THE PACKAGE
- --     SYSTEM, THAT ITS TYPE IS <UNIVERSAL_REAL>, AND THAT ITS VALUE
- --     IS STATIC.
- 
- -- HISTORY:
- --     BCB 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE AD7104A IS
- 
-      U_TICK: CONSTANT := SYSTEM.TICK;
- 
-      F : FLOAT := SYSTEM.TICK;
- 
- BEGIN
- 
-      TEST ("AD7104A", "CHECK THAT THE CONSTANT TICK IS DECLARED " &
-                       "WITHIN THE PACKAGE SYSTEM, THAT ITS TYPE IS " &
-                       "<UNIVERSAL_REAL>, AND THAT ITS VALUE IS STATIC");
- 
-      RESULT;
- 
- END AD7104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7201a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7201a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7201a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- AD7201A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PREFIX OF THE 'ADDRESS ATTRIBUTE CAN DENOTE A
- --     PACKAGE, SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL.
- 
- -- HISTORY:
- --     DHH 09/01/88  CREATED ORIGINAL TEST.
- --     RJW 02/23/90  REMOVED TESTS FOR THE 'ADDRESS ATTRIBUTE APPLIED TO
- --                   A GENERIC UNIT.  REMOVED DECLARATION OF TYPE
- --                   "COLOR".
- --     DTN 11/22/91  DELETED SUBPART (A).
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE AD7201A IS
- 
-      SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS;
- 
- BEGIN
-      TEST ("AD7201A", "CHECK THAT THE PREFIX OF THE 'ADDRESS " &
-                       "ATTRIBUTE CAN DENOTE A PACKAGE, " &
-                       "SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL");
- 
-      DECLARE
-           PACKAGE B IS
-           END B;
-           B1 : BOOLEAN := (B'ADDRESS IN MY_ADDRESS);
- 
-           PROCEDURE C;
-           C1 : BOOLEAN := (C'ADDRESS IN MY_ADDRESS);
- 
-           FUNCTION D RETURN BOOLEAN;
-           D1 : BOOLEAN := (D'ADDRESS IN MY_ADDRESS);
- 
-           TASK E IS
-           END E;
-           E1 : BOOLEAN := (E'ADDRESS IN MY_ADDRESS);
- 
-           TASK TYPE F IS
-           END F;
-           F1 : BOOLEAN := (F'ADDRESS IN MY_ADDRESS);
- 
-           G1 : BOOLEAN;
- 
-           PACKAGE BODY B IS
-           BEGIN
-                NULL;
-           END B;
- 
-           PROCEDURE C IS
-           BEGIN
-                NULL;
-           END C;
- 
-           FUNCTION D RETURN BOOLEAN IS
-           BEGIN
-                RETURN TRUE;
-           END D;
- 
-           TASK BODY E IS
-           BEGIN
-                NULL;
-           END E;
- 
-           TASK BODY F IS
-           BEGIN
-                NULL;
-           END F;
- 
-      BEGIN
- <<G>>     G1 := (G'ADDRESS IN MY_ADDRESS);
-      END;
- 
-      RESULT;
- END AD7201A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7203b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7203b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7203b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- AD7203B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PREFIX OF THE 'SIZE' ATTRIBUTE CAN BE AN OBJECT,
- --     A TYPE, OR A SUBTYPE.
- 
- -- HISTORY:
- --     BCB  09/27/88  CREATED ORIGINAL TEST BY MODIFYING AND RENAMING
- --                    CD7203B.ADA.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE AD7203B IS
- 
-      TYPE I_REC IS
-           RECORD
-                I1, I2 : INTEGER;
-           END RECORD;
- 
-      I   : INTEGER;
-      I_A : ARRAY (1 ..5) OF INTEGER;
-      I_R : I_REC;
- 
-      I_SIZE : INTEGER := I'SIZE;
-      I_A_SIZE : INTEGER := I_A'SIZE;
-      I_R_SIZE : INTEGER := I_R'SIZE;
-      I_A_1_SIZE : INTEGER := I_A(1)'SIZE;
-      I_R_I1_SIZE : INTEGER := I_R.I1'SIZE;
- 
-      TYPE FIXED IS DELTA 0.01 RANGE -1.0 .. 1.0;
-      TYPE FXD_REC IS
-           RECORD
-                FXD1, FXD2 : FIXED;
-           END RECORD;
- 
-      FXD   : FIXED;
-      FXD_A : ARRAY (1 .. 5) OF FIXED;
-      FXD_R : FXD_REC;
- 
-      FXD_SIZE : INTEGER := FXD'SIZE;
-      FXD_A_SIZE : INTEGER := FXD_A'SIZE;
-      FXD_R_SIZE : INTEGER := FXD_R'SIZE;
-      FXD_A_1_SIZE : INTEGER := FXD_A(1)'SIZE;
-      FXD_R_FXD1_SIZE : INTEGER := FXD_R.FXD1'SIZE;
- 
-      TYPE FLT_REC IS
-           RECORD
-                FLT1, FLT2 : FLOAT;
-           END RECORD;
- 
-      FLT   : FLOAT;
-      FLT_A : ARRAY (1 .. 5) OF FLOAT;
-      FLT_R : FLT_REC;
- 
-      FLT_SIZE : INTEGER := FLT'SIZE;
-      FLT_A_SIZE : INTEGER := FLT_A'SIZE;
-      FLT_R_SIZE : INTEGER := FLT_R'SIZE;
-      FLT_A_1_SIZE : INTEGER := FLT_A(1)'SIZE;
-      FLT_R_FLT1_SIZE : INTEGER := FLT_R.FLT1'SIZE;
- 
-      SUBTYPE TINY_INT IS INTEGER RANGE 0 .. 255;
-      TYPE TI_REC IS
-           RECORD
-                TI1, TI2 : TINY_INT;
-           END RECORD;
- 
-      TI   : TINY_INT;
-      TI_A : ARRAY (1 .. 5) OF TINY_INT;
-      TI_R : TI_REC;
- 
-      TINY_INT_SIZE : INTEGER := TINY_INT'SIZE;
-      TI_SIZE : INTEGER := TI'SIZE;
-      TI_A_SIZE : INTEGER := TI_A'SIZE;
-      TI_R_SIZE : INTEGER := TI_R'SIZE;
-      TI_A_1_SIZE : INTEGER := TI_A(1)'SIZE;
-      TI_R_TI1_SIZE : INTEGER := TI_R.TI1'SIZE;
- 
-      TYPE STR IS ARRAY (TINY_INT RANGE <>) OF CHARACTER;
-      TYPE STR_2 IS ARRAY (1 .. 127) OF CHARACTER;
-      TYPE STR_REC IS
-           RECORD
-                S1, S2 : STR (TINY_INT'FIRST .. TINY_INT'LAST);
-           END RECORD;
- 
-      S   : STR (TINY_INT'FIRST .. TINY_INT'LAST);
-      S_A : ARRAY (1 .. 5) OF STR (TINY_INT'FIRST .. TINY_INT'LAST);
-      S_R : STR_REC;
- 
-      STR_2_SIZE : INTEGER := STR_2'SIZE;
-      S_SIZE : INTEGER := S'SIZE;
-      S_A_SIZE : INTEGER := S_A'SIZE;
-      S_R_SIZE : INTEGER := S_R'SIZE;
-      S_A_1_SIZE : INTEGER := S_A(1)'SIZE;
-      S_R_S1_SIZE : INTEGER := S_R.S1'SIZE;
- 
-      TYPE C_REC IS
-           RECORD
-                C1, C2 : CHARACTER;
-           END RECORD;
- 
-      C   : CHARACTER;
-      C_A : ARRAY (1 .. 5) OF CHARACTER;
-      C_R : C_REC;
- 
-      C_SIZE : INTEGER := C'SIZE;
-      C_A_SIZE : INTEGER := C_A'SIZE;
-      C_R_SIZE : INTEGER := C_R'SIZE;
-      C_A_1_SIZE : INTEGER := C_A(1)'SIZE;
-      C_R_C1_SIZE : INTEGER := C_R.C1'SIZE;
- 
-      TYPE B_REC IS
-           RECORD
-                B1, B2 : BOOLEAN;
-           END RECORD;
- 
-      B   : BOOLEAN;
-      B_A : ARRAY (1 .. 5) OF BOOLEAN;
-      B_R : B_REC;
- 
-      B_SIZE : INTEGER := B'SIZE;
-      B_A_SIZE : INTEGER := B_A'SIZE;
-      B_R_SIZE : INTEGER := B_R'SIZE;
-      B_A_1_SIZE : INTEGER := B_A(1)'SIZE;
-      B_R_B1_SIZE : INTEGER := B_R.B1'SIZE;
- 
-      TYPE DISCR IS RANGE 1 .. 2;
-      TYPE DISCR_REC (D : DISCR := 1) IS
-           RECORD
-                CASE D IS
-                     WHEN 1 =>
-                          C1_I : INTEGER;
-                     WHEN 2 =>
-                          C2_I1 : INTEGER;
-                          C2_I2 : INTEGER;
-                END CASE;
-           END RECORD;
- 
-      DR_UC : DISCR_REC;
-      DR_C  : DISCR_REC (2);
-      DR_A  : ARRAY (1 .. 5) OF DISCR_REC;
- 
-      DR_UC_SIZE : INTEGER := DR_UC'SIZE;
-      DR_C_SIZE : INTEGER := DR_C'SIZE;
-      DR_A_SIZE : INTEGER := DR_A'SIZE;
-      DR_UC_C1_I_SIZE : INTEGER := DR_UC.C1_I'SIZE;
-      DR_A_1_SIZE : INTEGER := DR_A(1)'SIZE;
- 
-      TYPE ENUM IS (E1, E2, E3, E4);
-      TYPE ENUM_REC IS
-           RECORD
-                E1, E2 : ENUM;
-           END RECORD;
- 
-      E   : ENUM;
-      E_A : ARRAY (1 .. 5) OF ENUM;
-      E_R : ENUM_REC;
- 
-      E_SIZE : INTEGER := E'SIZE;
-      E_A_SIZE : INTEGER := E_A'SIZE;
-      E_R_SIZE : INTEGER := E_R'SIZE;
-      E_A_1_SIZE : INTEGER := E_A(1)'SIZE;
-      E_R_E1_SIZE : INTEGER := E_R.E1'SIZE;
- 
-      TASK TYPE TSK IS END TSK;
-      TYPE TSK_REC IS
-           RECORD
-                TSK1, TSK2 : TSK;
-           END RECORD;
- 
-      T   : TSK;
-      T_A : ARRAY (1 .. 5) OF TSK;
-      T_R : TSK_REC;
- 
-      T_SIZE : INTEGER := T'SIZE;
-      T_A_SIZE : INTEGER := T_A'SIZE;
-      T_R_SIZE : INTEGER := T_R'SIZE;
-      T_A_1_SIZE : INTEGER := T_A(1)'SIZE;
-      T_R_TSK1_SIZE : INTEGER := T_R.TSK1'SIZE;
- 
-      TYPE ACC IS ACCESS INTEGER;
-      TYPE ACC_REC IS
-           RECORD
-                A1, A2 : ACC;
-           END RECORD;
- 
-      A   : ACC;
-      A_A : ARRAY (1 .. 5) OF ACC;
-      A_R : ACC_REC;
- 
-      A_SIZE : INTEGER := A'SIZE;
-      A_A_SIZE : INTEGER := A_A'SIZE;
-      A_R_SIZE : INTEGER := A_R'SIZE;
-      A_A_1_SIZE : INTEGER := A_A(1)'SIZE;
-      A_R_A1_SIZE : INTEGER := A_R.A1'SIZE;
- 
-      PACKAGE PK IS
-           TYPE PRV IS PRIVATE;
-           TYPE PRV_REC IS
-                RECORD
-                     P1, P2 : PRV;
-                END  RECORD;
- 
-           TYPE LPRV IS LIMITED PRIVATE;
-           TYPE LPRV_REC IS
-                RECORD
-                     LP1, LP2 : LPRV;
-                END RECORD;
-      PRIVATE
-           TYPE PRV IS NEW INTEGER;
- 
-           TYPE LPRV IS NEW INTEGER;
-      END PK;
-      USE PK;
- 
-      P   : PRV;
-      P_A : ARRAY (1 .. 5) OF PRV;
-      P_R : PRV_REC;
- 
-      P_SIZE : INTEGER := P'SIZE;
-      P_A_SIZE : INTEGER := P_A'SIZE;
-      P_R_SIZE : INTEGER := P_R'SIZE;
-      P_A_1_SIZE : INTEGER := P_A(1)'SIZE;
-      P_R_P1_SIZE : INTEGER := P_R.P1'SIZE;
- 
-      LP   : LPRV;
-      LP_A : ARRAY (1 .. 5) OF LPRV;
-      LP_R : LPRV_REC;
- 
-      LP_SIZE : INTEGER := LP'SIZE;
-      LP_A_SIZE : INTEGER := LP_A'SIZE;
-      LP_R_SIZE : INTEGER := LP_R'SIZE;
-      LP_A_1_SIZE : INTEGER := LP_A(1)'SIZE;
-      LP_R_LP1_SIZE : INTEGER := LP_R.LP1'SIZE;
- 
-      TASK BODY TSK IS
-      BEGIN
-           NULL;
-      END TSK;
- 
- BEGIN
-      TEST ("AD7203B", "CHECK THAT THE PREFIX OF THE 'SIZE' ATTRIBUTE " &
-                       "CAN BE AN OBJECT, A TYPE, OR A SUBTYPE");
- 
-      RESULT;
- END AD7203B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7205b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad7205b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad7205b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- AD7205B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PREFIX OF THE 'STORAGE_SIZE ATTRIBUTE CAN BE AN
- --     ACCESS TYPE, A TASK TYPE, A TASK OBJECT, OR A SINGLE TASK.
- 
- -- HISTORY:
- --     JET 09/22/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE AD7205B IS
- 
-      B : BOOLEAN;
- 
-      TYPE A IS ACCESS INTEGER;
-      TASK TYPE T;
-      T1 : T;
-      TASK T2;
- 
-      TASK BODY T IS
-      BEGIN
-           NULL;
-      END T;
- 
-      TASK BODY T2 IS
-      BEGIN
-           NULL;
-      END T2;
- 
- BEGIN
- 
-      TEST ("AD7205B", "CHECK THAT THE PREFIX OF THE 'STORAGE_SIZE " &
-                       "ATTRIBUTE CAN BE AN ACCESS TYPE, A TASK TYPE, " &
-                       "A TASK OBJECT, OR A SINGLE TASK");
- 
-      B := A'STORAGE_SIZE = T'STORAGE_SIZE;   -- ACCESS AND TASK TYPES.
-      B := T1'STORAGE_SIZE = T2'STORAGE_SIZE; -- TASK OBJECT & SINGLE
-                                              --   TASK.
- 
-      RESULT;
- 
- END AD7205B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad8011a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad8011a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ad8011a.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ad8011a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- AD8011A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CODE STATEMENTS ARE ALLOWED IN A PROCEDURE BODY.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --     MACHINE CODE INSERTIONS.
- 
- --     IF SUCH INSERTIONS ARE NOT SUPPORTED, THE "WITH MACHINE_CODE"
- --     CLAUSE MUST BE REJECTED.
- 
- 
- -- MACRO SUBSTITUTION:
- --     IF MACHINE CODE INSERTIONS ARE SUPPORTED THEN THE MACRO
- --     $MACHINE_CODE_STATEMENT MUST BE REPLACED BY A VALID CODE
- --     STATEMENT.
- 
- --     IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED, THEN SUBSTITUTE
- --     THE ADA NULL STATEMENT (IE: NULL;) FOR $MACHINE_CODE_STATEMENT.
- 
- -- HISTORY:
- --     DHH 08/30/88  CREATED ORIGINAL TEST.
- 
- WITH MACHINE_CODE;                            -- N/A => ERROR.
- USE MACHINE_CODE;
- WITH REPORT; USE REPORT;
- PROCEDURE AD8011A IS
- 
-      PROCEDURE CODE IS
-      BEGIN
-           $MACHINE_CODE_STATEMENT
-      END;
- 
- BEGIN
-      TEST("AD8011A", "CHECK THAT CODE STATEMENTS ARE ALLOWED IN " &
-                      "A PROCEDURE BODY");
- 
-      CODE;
- 
-      RESULT;
- END AD8011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ada101a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ada101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ada101a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ada101a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- ADA101A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNCHECKED_DEALLOCATION CAN BE INSTANTIATED WITH ANY
- --     TYPE AS THE OBJECT PARAMETER.
- 
- -- HISTORY:
- --     JET 09/23/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH UNCHECKED_DEALLOCATION;
- PROCEDURE ADA101A IS
- 
-      TYPE ENUM IS (CURLY, MOE, LARRY);
-      TYPE DER IS NEW INTEGER;
-      SUBTYPE SUB IS CHARACTER RANGE 'A'..'Z';
-      TASK TYPE TSK;
-      TYPE ACC IS ACCESS INTEGER;
- 
-      PACKAGE P IS
-           TYPE PRIV IS PRIVATE;
-      PRIVATE
-           TYPE PRIV IS RANGE -100..100;
-      END P;
-      USE P;
- 
-      TYPE ARR1 IS ARRAY (INTEGER RANGE 1..10) OF INTEGER;
-      TYPE ARR2 IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
- 
-      TYPE REC1 IS RECORD
-           D, I : INTEGER;
-      END RECORD;
- 
-      TYPE REC2 (D : INTEGER) IS RECORD
-           C : CHARACTER;
-      END RECORD;
- 
-      TYPE INTEGERA IS ACCESS INTEGER;
-      TYPE FLOATA IS ACCESS FLOAT;
-      TYPE ENUMA IS ACCESS ENUM;
-      TYPE BOOLEANA IS ACCESS BOOLEAN;
-      TYPE CHARACTERA IS ACCESS CHARACTER;
-      TYPE DERA IS ACCESS DER;
-      TYPE SUBA IS ACCESS SUB;
-      TYPE TSKA IS ACCESS TSK;
-      TYPE ACCA IS ACCESS ACC;
-      TYPE PRIVA IS ACCESS PRIV;
-      TYPE ARR1A IS ACCESS ARR1;
-      TYPE ARR2A IS ACCESS ARR2;
-      TYPE REC1A IS ACCESS REC1;
-      TYPE REC2A IS ACCESS REC2;
- 
-      TASK BODY TSK IS
-      BEGIN
-           NULL;
-      END TSK;
- 
-      PROCEDURE RLSI IS NEW UNCHECKED_DEALLOCATION(INTEGER, INTEGERA);
-      PROCEDURE RLSF IS NEW UNCHECKED_DEALLOCATION(FLOAT, FLOATA);
-      PROCEDURE RLSE IS NEW UNCHECKED_DEALLOCATION(ENUM, ENUMA);
-      PROCEDURE RLSB IS NEW UNCHECKED_DEALLOCATION(BOOLEAN, BOOLEANA);
-      PROCEDURE RLSC IS NEW UNCHECKED_DEALLOCATION(CHARACTER,CHARACTERA);
-      PROCEDURE RLSD IS NEW UNCHECKED_DEALLOCATION(DER, DERA);
-      PROCEDURE RLSS IS NEW UNCHECKED_DEALLOCATION(SUB, SUBA);
-      PROCEDURE RLST IS NEW UNCHECKED_DEALLOCATION(TSK, TSKA);
-      PROCEDURE RLSA IS NEW UNCHECKED_DEALLOCATION(ACC, ACCA);
-      PROCEDURE RLSP IS NEW UNCHECKED_DEALLOCATION(PRIV, PRIVA);
-      PROCEDURE RLSA1 IS NEW UNCHECKED_DEALLOCATION(ARR1, ARR1A);
-      PROCEDURE RLSA2 IS NEW UNCHECKED_DEALLOCATION(ARR2, ARR2A);
-      PROCEDURE RLSR1 IS NEW UNCHECKED_DEALLOCATION(REC1, REC1A);
-      PROCEDURE RLSR2 IS NEW UNCHECKED_DEALLOCATION(REC2, REC2A);
- 
- BEGIN
-      TEST ("ADA101A", "CHECK THAT UNCHECKED_DEALLOCATION CAN BE " &
-                       "INSTANTIATED WITH ANY TYPE AS THE OBJECT " &
-                       "PARAMETER");
- 
-      RESULT;
- END ADA101A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae2113a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae2113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae2113a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae2113a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- AE2113A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE,
- -- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT
- -- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES.
- 
- -- TBN  9/30/86
- 
- WITH DIRECT_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE AE2113A IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-      USE DIR_IO;
- 
-      TEMP : FILE_TYPE;
- 
- BEGIN
-      TEST ("AE2113A", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " &
-                       "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " &
-                       "IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT " &
-                       "SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER " &
-                       "NAMES");
-      BEGIN
-           CREATE (FILE=> TEMP, MODE=> OUT_FILE,
-                   NAME=> "AE2113A.DAT", FORM=> "");
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           RESET (FILE=> TEMP, MODE=> OUT_FILE);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           CLOSE (FILE=> TEMP);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           OPEN (FILE=> TEMP, MODE=> OUT_FILE,
-                   NAME=> "AE2113A.DAT", FORM=> "");
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF IS_OPEN (FILE=> TEMP) THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF MODE (FILE=> TEMP) /= OUT_FILE THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF NAME (FILE=> TEMP) /= "AE2113A.DAT" THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF FORM (FILE=> TEMP) /= "" THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           DELETE (FILE=> TEMP);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      RESULT;
- END AE2113A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae2113b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae2113b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae2113b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae2113b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- AE2113B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE,
- -- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND THAT
- -- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES.
- 
- -- TBN  9/30/86
- 
- WITH SEQUENTIAL_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE AE2113B IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-      USE SEQ_IO;
- 
-      TEMP : FILE_TYPE;
- 
- BEGIN
-      TEST ("AE2113B", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " &
-                       "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " &
-                       "IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND " &
-                       "THAT SUBPROGRAMS HAVE THE CORRECT FORMAL " &
-                       "PARAMETER NAMES");
-      BEGIN
-           CREATE (FILE=> TEMP, MODE=> OUT_FILE,
-                   NAME=> "AE2113B.DAT", FORM=> "");
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           RESET (FILE=> TEMP, MODE=> OUT_FILE);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           CLOSE (FILE=> TEMP);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           OPEN (FILE=> TEMP, MODE=> OUT_FILE,
-                   NAME=> "AE2113B.DAT", FORM=> "");
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF IS_OPEN (FILE=> TEMP) THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF MODE (FILE=> TEMP) /= OUT_FILE THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF NAME (FILE=> TEMP) /= "AE2113B.DAT" THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF FORM (FILE=> TEMP) /= "" THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           DELETE (FILE=> TEMP);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      RESULT;
- END AE2113B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3002g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3002g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3002g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3002g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,47 ****
- -- AE3002G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FILE_MODE IS VISIBLE AND HAS LITERALS IN_FILE AND
- -- OUT_FILE.  ASLO CHECK THAT TYPE_SET IS VISIBLE AND HAS LITERALS
- -- LOWER_CASE AND UPPER_CASE.
- 
- -- TBN  10/3/86
- 
- WITH TEXT_IO; USE TEXT_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE AE3002G IS
- 
-      TEMP_FILE : FILE_TYPE;
-      MODE : FILE_MODE := IN_FILE;
-      LETTERS : TYPE_SET := LOWER_CASE;
- 
- BEGIN
-      TEST ("AE3002G", "CHECK THAT FILE_MODE AND TYPE_SET ARE VISIBLE " &
-                       "AND CHECK THEIR LITERALS");
- 
-      MODE := OUT_FILE;
-      LETTERS := UPPER_CASE;
- 
-      RESULT;
- END AE3002G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3101a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3101a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3101a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- AE3101A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CREATE, OPEN, CLOSE, DELETE, RESET, MODE, NAME,
- --     FORM, IS_OPEN, AND END_OF_FILE ARE AVAILABLE FOR TEXT FILES.
- --     ALSO CHECK THAT FORMAL PARAMETER NAMES ARE CORRECT.
- 
- -- HISTORY:
- --     ABW 08/24/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     DWC 09/24/87  REMOVED DEPENDENCE ON FILE SUPPORT.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE AE3101A IS
- 
-      FILE1 : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("AE3101A" , "CHECK THAT CREATE, OPEN, DELETE, " &
-                        "RESET, MODE, NAME, FORM, IS_OPEN, " &
-                        "AND END_OF_FILE ARE AVAILABLE " &
-                        "FOR TEXT FILE");
- 
-      BEGIN
-           CREATE (FILE => FILE1,
-                   MODE => OUT_FILE,
-                   NAME => LEGAL_FILE_NAME,
-                   FORM => "");
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           RESET (FILE => FILE1, MODE => IN_FILE);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           CLOSE (FILE => FILE1);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           OPEN (FILE => FILE1,
-                 MODE => IN_FILE,
-                 NAME => LEGAL_FILE_NAME,
-                 FORM => "");
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (FILE => FILE1) THEN
-           NULL;
-      END IF;
- 
-      BEGIN
-           IF MODE (FILE => FILE1) /= IN_FILE THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF NAME (FILE => FILE1) /= LEGAL_FILE_NAME THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF FORM (FILE => FILE1) /= "" THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           IF END_OF_FILE (FILE => FILE1) THEN
-                NULL;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      BEGIN
-           DELETE (FILE => FILE1);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END AE3101A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3702a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3702a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3702a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3702a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- AE3702A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR USER DEFINED INTEGER
- -- TYPES.
- 
- -- SPS 10/1/82
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE AE3702A IS
- BEGIN
- 
-      TEST ("AE3702A", "CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR " &
-                       "USER DEFINED TYPES");
- 
-      DECLARE
-           TYPE I1 IS RANGE 6 .. 14;
-           TYPE I2 IS NEW INTEGER;
-           TYPE I3 IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-           SUBTYPE S1 IS INTEGER RANGE 6 .. 14;
-           SUBTYPE S2 IS INTEGER;
-           SUBTYPE S3 IS INTEGER RANGE 0 .. INTEGER'LAST;
- 
-           PACKAGE NIO1 IS NEW INTEGER_IO (I1);
-           PACKAGE NIO2 IS NEW INTEGER_IO (I2);
-           PACKAGE NIO3 IS NEW INTEGER_IO (I3);
-           PACKAGE NIO4 IS NEW INTEGER_IO (S1);
-           PACKAGE NIO5 IS NEW INTEGER_IO (S2);
-           PACKAGE NIO6 IS NEW INTEGER_IO (S3);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END AE3702A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3709a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3709a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/a/ae3709a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/a/ae3709a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- AE3709A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THE NAMES OF THE FORMAL PARAMETERS.
- 
- -- JBG 3/30/83
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE AE3709A IS
- 
-      PACKAGE INT IS NEW INTEGER_IO(INTEGER);
-      USE INT;
-      FILE : FILE_TYPE;
-      STR  : STRING(1..3);
-      LAST : POSITIVE;
-      ITEM : INTEGER;
- 
- BEGIN
- 
-      TEST ("AE3709A", "CHECK NAMES OF FORMAL PARAMETERS");
- 
-      IF EQUAL(2, 3) THEN
-           GET (FILE => FILE, ITEM => ITEM, WIDTH => 0);
-           GET (ITEM => ITEM, WIDTH => 0);
-           PUT (FILE => FILE, ITEM => ITEM, WIDTH => 4, BASE => 4);
-           PUT (ITEM => ITEM, WIDTH => 4, BASE => 4);
-           GET (FROM => STR, ITEM => ITEM, LAST => LAST);
-           PUT (TO   => STR, ITEM => ITEM, BASE => 4);
-      END IF;
- 
-      RESULT;
- 
- END AE3709A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23001a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C23001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UPPER AND LOWER CASE LETTERS ARE EQUIVALENT IN IDENTIFIERS
- -- (INCLUDING RESERVED WORDS).
- 
- -- JRK 12/12/79
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C23001A IS
- 
-         USE REPORT;
- 
-         AN_IDENTIFIER : INTEGER := 1;
- 
- BEGIN
-         TEST ("C23001A", "UPPER/LOWER CASE EQUIVALENCE IN IDENTIFIERS");
- 
-         DECLARE
-                 an_identifier : INTEGER := 3;
-         BEGIN
-                 IF an_identifier /= AN_IDENTIFIER THEN
-                         FAILED ("LOWER CASE NOT EQUIVALENT TO UPPER " &
-                                 "IN DECLARABLE IDENTIFIERS");
-                 END IF;
-         END;
- 
-         IF An_IdEnTIfieR /= AN_IDENTIFIER THEN
-                 FAILED ("MIXED CASE NOT EQUIVALENT TO UPPER IN " &
-                         "DECLARABLE IDENTIFIERS");
-         END IF;
- 
-         if AN_IDENTIFIER = 1 ThEn
-                 AN_IDENTIFIER := 2;
-         END IF;
-         IF AN_IDENTIFIER /= 2 THEN
-                 FAILED ("LOWER AND/OR MIXED CASE NOT EQUIVALENT TO " &
-                         "UPPER IN RESERVED WORDS");
-         END IF;
- 
-         RESULT;
- END C23001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003a.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C23003A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT VARIABLE IDENTIFIERS CAN BE AS LONG AS THE MAXIMUM LENGTH
- -- IDENTIFIER PERMITTED AND THAT ALL CHARACTERS ARE SIGNIFICANT.
- 
- -- JRK 12/12/79
- -- JRK 1/11/80
- -- JWC 6/28/85   RENAMED TO -AB
- -- KAS 12/04/95 CHANGED "INPUT LINE LENGTH" TO "LENGTH IDENTIFIER"
- 
- WITH REPORT;
- PROCEDURE C23003A IS
- 
-         USE REPORT;
- 
- BEGIN
-         TEST ("C23003A", "MAXIMUM LENGTH VARIABLE IDENTIFIERS");
- 
-         -- BIG_ID1 AND BIG_ID2 ARE TWO MAXIMUM LENGTH IDENTIFIERS THAT
-         -- DIFFER ONLY IN THEIR LAST CHARACTER.
- 
-         DECLARE
- $BIG_ID1
-                                         -- BIG_ID1
-                         : INTEGER := 1;
-         BEGIN
-                 DECLARE
- $BIG_ID2
-                                                 -- BIG_ID2
-                                 : INTEGER := 2;
-                 BEGIN
- 
-                         IF
- $BIG_ID1
-                                                 -- BIG_ID1
-                                 +
- $BIG_ID2
-                                                 -- BIG_ID2
-                                         /= 3 THEN
-                                 FAILED ("IDENTIFIERS AS LONG AS " &
-                                         "MAXIMUM INPUT LINE LENGTH " &
-                                         "NOT PERMITTED OR NOT " &
-                                         "DISTINGUISHED BY DISTINCT " &
-                                         "SUFFIXES");
-                         END IF;
- 
-                 END;
-         END;
- 
-         -- BIG_ID3 AND BIG_ID4 ARE TWO MAXIMUM LENGTH IDENTIFIERS THAT
-         -- DIFFER ONLY IN THEIR MIDDLE CHARACTER.
- 
-         DECLARE
- $BIG_ID3
-                                         -- BIG_ID3
-                         : INTEGER := 3;
-         BEGIN
-                 DECLARE
- $BIG_ID4
-                                                 -- BIG_ID4
-                                 : INTEGER := 4;
-                 BEGIN
- 
-                         IF
- $BIG_ID3
-                                                 -- BIG_ID3
-                                 +
- $BIG_ID4
-                                                 -- BIG_ID4
-                                         /= 7 THEN
-                                 FAILED ("IDENTIFIERS AS LONG AS " &
-                                         "MAXIMUM INPUT LINE LENGTH " &
-                                         "NOT PERMITTED OR NOT " &
-                                         "DISTINGUISHED BY DISTINCT " &
-                                         "MIDDLES");
-                         END IF;
- 
-                 END;
-         END;
- 
-         RESULT;
- END C23003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003b.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003b.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003b.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003b.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C23003B.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- CHECK THAT THE NAME OF A LIBRARY UNIT PACKAGE AND THE NAME OF A LIBRARY
- -- SUBPROGRAM CAN BE AS LONG AS THE LONGEST IDENTIFIER ALLOWED BY
- -- AN IMPLEMENTATION.
- 
- -- JBG 5/26/85
- -- DTN 3/25/92  CONSOLIDATION OF C23003B.TST AND C23003C.TST.
- -- KAS 11/04/95 CHANGE "LINE" TO "IDENTIFIER"
- 
- PACKAGE
- $BIG_ID1
- IS
-   A : INTEGER := 1;
- END
- $BIG_ID1
- ;
- PACKAGE
- $BIG_ID2
- IS
-   B : INTEGER := 2;
- END
- $BIG_ID2
- ;
- 
- PROCEDURE
- $BIG_ID3
-      (X : OUT INTEGER) IS
- BEGIN
-      X := 1;
- END
- $BIG_ID3
- ;
- PROCEDURE
- $BIG_ID4
-      (X : OUT INTEGER) IS
- BEGIN
-      X := 2;
- END
- $BIG_ID4
- ;
- 
- WITH
- $BIG_ID1
- ,
- $BIG_ID2
- ,
- $BIG_ID3
- ,
- $BIG_ID4
- ;
- USE
- $BIG_ID1
- ,
- $BIG_ID2
- ;
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C23003B IS
-      X1, X2 : INTEGER := 0;
- BEGIN
-      TEST ("C23003B", "CHECK LONGEST POSSIBLE IDENTIFIER CAN BE USED " &
-                       "FOR LIBRARY PACKAGE AND SUBPROGRAM");
- 
-      IF A + IDENT_INT(1) /= B THEN
-           FAILED ("INCORRECT PACKAGE IDENTIFICATION");
-      END IF;
- 
- 
- $BIG_ID3
-           (X1);
- $BIG_ID4
-           (X2);
- 
-      IF X1 + IDENT_INT(1) /= X2 THEN
-           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
-      END IF;
- 
-      RESULT;
- END C23003B; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003g.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003g.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003g.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003g.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- C23003G.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NAME OF A GENERIC LIBRARY UNIT PACKAGE AND THE NAME
- -- OF A GENERIC LIBRARY UNIT SUBPROGRAM CAN BE AS LONG 
- 
- -- JBG 5/26/85
- -- DTN 3/25/92  CONSOLIDATION OF C23003G.TST AND C23003H.TST.
- -- KAS 12/4/95  CHANGE "LINE" TO "IDENTIFIER"
- 
- GENERIC
- PACKAGE
- $BIG_ID1
- IS
-   A : INTEGER := 1;
- END
- $BIG_ID1
- ;
- GENERIC
- PACKAGE
- $BIG_ID2
- IS
-   B : INTEGER := 2;
- END
- $BIG_ID2
- ;
- 
- GENERIC
- FUNCTION
- $BIG_ID3
- RETURN INTEGER;
- 
- FUNCTION
- $BIG_ID3
- RETURN INTEGER IS
- BEGIN
-      RETURN 3;
- END
- $BIG_ID3
- ;
- 
- GENERIC
- FUNCTION
- $BIG_ID4
- RETURN INTEGER;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION
- $BIG_ID4
- RETURN INTEGER IS
- BEGIN
-      RETURN IDENT_INT(4);
- END
- $BIG_ID4
- ;
- 
- WITH
- $BIG_ID3
- ;
- PRAGMA ELABORATE (
- $BIG_ID3
- );
- FUNCTION F1 IS NEW
- $BIG_ID3
- ;
- 
- WITH
- $BIG_ID1
- ;
- PRAGMA ELABORATE (
- $BIG_ID1
- );
- PACKAGE C23003G_PKG IS NEW
- $BIG_ID1
- ;
- WITH C23003G_PKG, F1,
- $BIG_ID2
- ,
- $BIG_ID4
- ;
- USE C23003G_PKG;
- WITH REPORT; USE REPORT;
- PROCEDURE C23003G IS
- 
-      PACKAGE P2 IS NEW
- $BIG_ID2
- ;
-      USE P2;
-      FUNCTION F2 IS NEW
- $BIG_ID4
- ;
- 
- BEGIN
-      TEST ("C23003G", "CHECK LONGEST POSSIBLE IDENTIFIER CAN BE USED " &
-                       "FOR GENERIC LIBRARY PACKAGE AND SUBPROGRAM");
- 
-      IF A + IDENT_INT(1) /= B THEN
-           FAILED ("INCORRECT PACKAGE IDENTIFICATION");
-      END IF;
- 
- 
-      IF F1 + IDENT_INT(1) /= F2 THEN
-           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
-      END IF;
- 
-      RESULT;
- END C23003G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003i.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003i.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23003i.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23003i.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C23003I.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE LONGEST POSSIBLE IDENTIFIER CAN BE THE NAME OF A
- -- LIBRARY PACKAGE CREATED BY A GENERIC INSTANTIATION.
- 
- -- JBG 5/26/85
- -- DTN 3/25/92  DELETED TEST OF TWO MAXIMUM LENGTH PACKAGE NAMES THAT
- --              DIFFER ONLY IN THEIR MIDDLE CHARACTER.
- 
- GENERIC
-      C : INTEGER;
- PACKAGE C23003I_PKG IS
-      A : INTEGER := C;
- END C23003I_PKG;
- 
- WITH C23003I_PKG;
- PRAGMA ELABORATE (C23003I_PKG);
- PACKAGE
- $BIG_ID1
-      IS NEW C23003I_PKG (1);
- 
- WITH REPORT; USE REPORT;
- WITH C23003I_PKG;
- PRAGMA ELABORATE (REPORT, C23003I_PKG);
- PACKAGE
- $BIG_ID2
-      IS NEW C23003I_PKG (IDENT_INT(2));
- 
- WITH
- $BIG_ID1
- ,
- $BIG_ID2
- ;
- WITH REPORT; USE REPORT;
- PROCEDURE C23003I IS
- BEGIN
-      TEST ("C23003I", "CHECK THAT LONGEST POSSIBLE IDENTIFIER CAN BE " &
-                       "USED FOR A LIBRARY PACKAGE INSTANTIATION");
- 
-      IF 
- $BIG_ID1
-           .A + IDENT_INT(1) /=
- $BIG_ID2
-           .A THEN
-               FAILED ("INCORRECT PACKAGE IDENTIFICATION");
-      END IF;
- 
-      RESULT;
- END C23003I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,48 ****
- -- C23006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN IDENTIFIERS.
- 
- -- JRK 12/12/79
- -- JBG 5/25/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C23006A IS
- 
-         AN_IDENTIFIER : INTEGER := 1;
- 
- BEGIN
-         TEST ("C23006A", "UNDERSCORES ARE SIGNFICANT IN IDENTIFERS");
- 
-         DECLARE
-                 ANIDENTIFIER : INTEGER := 3;
-         BEGIN
-                 IF ANIDENTIFIER = AN_IDENTIFIER THEN
-                         FAILED ("UNDERSCORE IGNORED " &
-                                 "IN DECLARABLE IDENTIFIERS");
-                 END IF;
-         END;
- 
-         RESULT;
- END C23006A; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- C23006B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY PACKAGE IDENTIFIERS
- 
- -- JBG 5/26/85
- -- PWN 5/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- PACKAGE C23006B_PKG IS
-      A : INTEGER := 1;
- END C23006B_PKG;
- 
- PACKAGE C23006BPKG IS
-      D : INTEGER := 4;
-      PROCEDURE REQUIRE_BODY;
- END C23006BPKG;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY C23006BPKG IS
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- BEGIN
-      D := IDENT_INT (5);
- END C23006BPKG;
- 
- WITH C23006BPKG, C23006B_PKG;
- USE C23006BPKG, C23006B_PKG;
- WITH REPORT; USE REPORT;
- PROCEDURE C23006B IS
- BEGIN
-      TEST ("C23006B", "CHECK UNDERSCORES ARE SIGNIFICANT " &
-                       "FOR LIBRARY PACKAGE IDENTIFIERS");
- 
-      IF A + IDENT_INT(4) /= D THEN
-           FAILED ("INCORRECT PACKAGE IDENTIFICATION");
-      END IF;
- 
-      RESULT;
- END C23006B; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C23006C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNDERSCORES ARE SIGNFICANT IN NAMES OF LIBRARY
- -- SUBPROGRAMS. 
- 
- -- JBG 5/26/85
- 
- PROCEDURE C23006C_PROC (X : OUT INTEGER) IS
- BEGIN
-      X := 1;
- END C23006C_PROC;
- 
- PROCEDURE C23006CPROC (X : OUT INTEGER);
- 
- PROCEDURE C23006CPROC (X : OUT INTEGER) IS
- BEGIN
-      X := 2;
- END C23006CPROC;
- 
- FUNCTION C23006C_FUNC RETURN INTEGER IS
- BEGIN
-      RETURN 3;
- END C23006C_FUNC;
- 
- FUNCTION C23006CFUNC RETURN INTEGER;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION C23006CFUNC RETURN INTEGER IS
- BEGIN
-      RETURN IDENT_INT(4);
- END C23006CFUNC;
- 
- WITH C23006C_PROC, C23006CPROC, C23006C_FUNC, C23006CFUNC;
- WITH REPORT; USE REPORT;
- PROCEDURE C23006C IS
-      X1, X2 : INTEGER;
- BEGIN
-      TEST ("C23006C", "CHECK UNDERSCORES ARE SIGNIFICANT " &
-                       "FOR LIBRARY SUBPROGRAM");
- 
-      C23006C_PROC (X1);
-      C23006CPROC (X2);
-      IF X1 + IDENT_INT(1) /= X2 THEN
-           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
-      END IF;
- 
-      IF C23006C_FUNC + IDENT_INT(1) /= C23006CFUNC THEN
-           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
-      END IF;
- 
-      RESULT;
- END C23006C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C23006D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN THE NAMES OF GENERIC
- -- LIBRARY PACKAGES
- 
- -- JBG 5/26/85
- -- PWN 5/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- GENERIC
- PACKAGE C23006D_PKG IS
-      A : INTEGER := 1;
- END C23006D_PKG;
- 
- GENERIC
- PACKAGE C23006DPKG IS
-      D : INTEGER := 2;
-      PROCEDURE REQUIRE_BODY;
- END C23006DPKG;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY C23006DPKG IS
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- BEGIN
-      D := IDENT_INT (5);
- END C23006DPKG;
- 
- WITH C23006D_PKG;
- PRAGMA ELABORATE (C23006D_PKG);
- PACKAGE C23006D_INST IS NEW C23006D_PKG;
- 
- WITH C23006DPKG, C23006D_INST;
- USE C23006D_INST;
- WITH REPORT; USE REPORT;
- PROCEDURE C23006D IS
- 
-      PACKAGE P2 IS NEW C23006DPKG;
-      USE P2;
- 
- BEGIN
-      TEST ("C23006D", "CHECK UNDERSCORES ARE SIGNIFICANT " &
-                       "FOR GENERIC LIBRARY PACKAGE IDENTIFIERS");
- 
-      IF A + IDENT_INT(4) /= D THEN
-           FAILED ("INCORRECT PACKAGE IDENTIFICATION - 1");
-      END IF;
- 
-      RESULT;
- END C23006D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C23006E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN THE NAMES OF GENERIC
- -- LIBRARY UNIT SUBPROGRAMS.
- 
- -- JBG 5/26/85
- 
- GENERIC
- PROCEDURE C23006E_PROC (X : OUT INTEGER);
- 
- PROCEDURE C23006E_PROC (X : OUT INTEGER) IS
- BEGIN
-      X := 1;
- END C23006E_PROC;
- 
- GENERIC
- PROCEDURE C230063PROC (X : OUT INTEGER);
- 
- PROCEDURE C230063PROC (X : OUT INTEGER) IS
- BEGIN
-      X := 2;
- END C230063PROC;
- 
- GENERIC
- FUNCTION C23006E_GFUNC RETURN INTEGER;
- 
- FUNCTION C23006E_GFUNC RETURN INTEGER IS
- BEGIN
-      RETURN 3;
- END C23006E_GFUNC;
- 
- GENERIC
- FUNCTION C23006EGFUNC RETURN INTEGER;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION C23006EGFUNC RETURN INTEGER IS
- BEGIN
-      RETURN IDENT_INT(4);
- END C23006EGFUNC;
- 
- WITH C23006E_PROC;
- PRAGMA ELABORATE (C23006E_PROC);
- PROCEDURE P1 IS NEW C23006E_PROC;
- 
- WITH C23006E_GFUNC;
- PRAGMA ELABORATE (C23006E_GFUNC);
- FUNCTION F1 IS NEW C23006E_GFUNC;
- 
- WITH P1, F1, C230063PROC, C23006EGFUNC;
- WITH REPORT; USE REPORT;
- PROCEDURE C23006E IS
- 
-      X1, X2 : INTEGER;
-      PROCEDURE P2 IS NEW C230063PROC;
-      FUNCTION F2 IS NEW C23006EGFUNC;
- 
- BEGIN
-      TEST ("C23006E", "CHECK UNDERSCORES ARE SIGNIFICANT " &
-                       "FOR GENERIC LIBRARY SUBPROGRAM IDENTIFIERS");
- 
-      P1 (X1);
-      P2 (X2);
-      IF X1 + IDENT_INT(1) /= X2 THEN
-           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
-      END IF;
- 
-      IF F1 + IDENT_INT(1) /= F2 THEN
-           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
-      END IF;
- 
-      RESULT;
- END C23006E; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- C23006F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY PACKAGE NAMES
- -- CREATED BY A GENERIC INSTANTIATION.
- 
- -- JBG 5/26/85
- 
- GENERIC
-      C : INTEGER;
- PACKAGE C23006F_PKG IS
-      A : INTEGER := C;
- END C23006F_PKG;
- 
- WITH C23006F_PKG;
- PRAGMA ELABORATE (C23006F_PKG);
- PACKAGE C23006F_INST IS NEW C23006F_PKG (1);
- 
- WITH REPORT; USE REPORT;
- WITH C23006F_PKG;
- PRAGMA ELABORATE (REPORT, C23006F_PKG);
- PACKAGE C23006FINST IS NEW C23006F_PKG (IDENT_INT(2));
- 
- WITH C23006F_INST, C23006FINST;
- WITH REPORT; USE REPORT;
- PROCEDURE C23006F IS
- BEGIN
-      TEST ("C23006F", "CHECK THAT UNDERSCORES ARE SIGNIFICANT IN " &
-                       "NAMES USED FOR A LIBRARY PACKAGE INSTANTIATION");
- 
-      IF C23006F_INST.A + IDENT_INT(1) /= C23006FINST.A THEN
-           FAILED ("INCORRECT PACKAGE IDENTIFICATION - 1");
-      END IF;
- 
-      RESULT;
- END C23006F; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c23006g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c23006g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C23006G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY SUBPROGRAM NAMES
- -- CREATED BY A GENERIC INSTANTIATION.
- 
- -- JBG 5/26/85
- 
- GENERIC
-      C : INTEGER;
- PROCEDURE C23006G_PROC (X : OUT INTEGER);
- 
- PROCEDURE C23006G_PROC (X : OUT INTEGER) IS
- BEGIN
-      X := C;
- END C23006G_PROC;
- 
- GENERIC
-      C : INTEGER;
- FUNCTION C23006G_FUNC RETURN INTEGER;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION C23006G_FUNC RETURN INTEGER IS
- BEGIN
-      RETURN IDENT_INT(C);
- END C23006G_FUNC;
- 
- WITH C23006G_PROC;
- PRAGMA ELABORATE (C23006G_PROC);
- PROCEDURE C23006G_INSTP IS NEW C23006G_PROC (1);
- 
- WITH REPORT; USE REPORT;
- WITH C23006G_PROC;
- PRAGMA ELABORATE (REPORT, C23006G_PROC);
- PROCEDURE C23006GINSTP IS NEW C23006G_PROC (IDENT_INT(2));
- 
- WITH C23006G_FUNC;
- PRAGMA ELABORATE (C23006G_FUNC);
- FUNCTION C23006G_INSTF IS NEW C23006G_FUNC (3);
- 
- WITH C23006G_FUNC;
- PRAGMA ELABORATE (C23006G_FUNC);
- FUNCTION C23006GINSTF IS NEW C23006G_FUNC (4);
- 
- WITH C23006G_INSTP, C23006GINSTP, C23006G_INSTF, C23006GINSTF;
- WITH REPORT; USE REPORT;
- PROCEDURE C23006G IS
-      X1, X2 : INTEGER;
- BEGIN
-      TEST ("C23006G", "CHECK THAT UNDERSCORES ARE SIGNFICANT IN NAMES "&
-                       "USED FOR A LIBRARY SUBPROGRAM INSTANTIATION");
-      C23006G_INSTP (X1);
-      C23006GINSTP (X2);
- 
-      IF X1 + IDENT_INT(1) /= X2 THEN
-           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
-      END IF;
- 
-      IF C23006G_INSTF + IDENT_INT(1) /= C23006GINSTF THEN
-           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
-      END IF;
- 
-      RESULT;
- END C23006G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24002d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24002d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24002d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C24002D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LOWER CASE E MAY BE USED IN INTEGER LITERALS, FLOATING POINT 
- -- LITERALS, AND FIXED POINT LITERALS.
- -- CHECK THAT THESE NUMERIC LITERALS YIELD THE CORRECT VALUES.
- 
- -- WMC 03/16/92  CONSOLIDATION OF C24002A.ADA, C24002B.ADA, C24002C.ADA
- 
- WITH REPORT;
- 
- PROCEDURE C24002D IS
- 
-         USE REPORT;
- 
- BEGIN
-         TEST("C24002D", "CHECK THAT LOWER CASE E WORKS IN INTEGER, " &
-                         "FLOATING POINT, AND FIXED POINT LITERALS, " &
-                         "AND THAT THESE NUMERIC LITERALS YIELD THE " &
-                         "CORRECT VALUES");
- 
-         -- Integer Literals
-         DECLARE
-            X,Y : INTEGER;
-         BEGIN
-            X := 12e1;
-            Y := 16#E#e1;
- 
-            IF (X /= 120) OR (Y /= 224) THEN
-                 FAILED("INCORRECT HANDLING OF LOWER CASE E " &
-                        "IN INTEGER LITERALS");
-            END IF;
-         END;
- 
- 
-         -- Floating Point Literal
-         DECLARE
-            X : FLOAT;
-         BEGIN
-            X := 16#F.FF#e+2;
- 
-            IF (X /= 4095.0) THEN
-                 FAILED("INCORRECT HANDLING OF LOWER CASE E " &
-                        "IN BASED FLOATING POINT LITERALS");
-            END IF;
-         END;
- 
- 
-         -- Fixed Point Literal
-         DECLARE 
-            TYPE FIXED IS DELTA 0.1 RANGE 0.0 .. 300.0;
-            X : FIXED;
-         BEGIN
-            X := 16#F.F#e1;
- 
-            IF (X /= 255.0) THEN
-                 FAILED("INCORRECT HANDLING OF LOWER CASE E " &
-                        "IN BASED FIXED POINT LITERALS");
-            END IF;
-         END;
- 
-         RESULT;
- 
- END C24002D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24003a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- C24003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS OF INTEGER LITERALS
- -- ARE IGNORED.
- 
- -- JRK 12/12/79
- -- JRK 12/16/80
- -- TBN 10/16/85     RENAMED FROM C24003A.TST AND FIXED LINE LENGTH.
- -- DTN 11/12/91     DELETED SUBPART (B).  CHANGED EXTENSION FROM '.TST' 
- --                  TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C24003A IS
- 
-         USE REPORT;
- 
- BEGIN
-         TEST ("C24003A", "LEADING ZEROES IN INTEGER LITERALS");
-         
-         IF 0000000000000000000000000000000000000000247 /= 247 THEN
-                 FAILED ("LEADING ZEROES IN INTEGER LITERALS NOT " &
-                         "IGNORED");
-         END IF;
- 
-         IF 35E00000000000000000000000000000000000000001 /= 350 THEN
-                 FAILED ("LEADING ZEROES IN EXPONENTS NOT IGNORED");
-         END IF;
- 
-         IF 000000000000000000000000000000000000000016#FF# /= 255 THEN
-                 FAILED ("LEADING ZEROES IN BASES NOT IGNORED");
-         END IF;
- 
-         IF 16#0000000000000000000000000000000000000000FF# /= 255 THEN
-                 FAILED ("LEADING ZEROES IN BASED INTEGER LITERALS " &
-                         "NOT IGNORED");
-         END IF;
- 
-         RESULT;
- END C24003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24003b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24003b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24003b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C24003B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS AND TRAILING ZEROES IN
- -- FRACTIONAL PARTS OF FLOATING POINT LITERALS ARE IGNORED.
- 
- -- JRK 12/12/79
- -- JRK 12/16/80
- -- TBN 10/21/85     RENAMED FROM C24003B.TST AND FIXED LINE LENGTH.
- -- DTN 11/12/91     DELETED SUBPART (B).  CHANGED EXTENSION FROM '.TST' 
- --                  TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C24003B IS
- 
-         USE REPORT;
- 
-         FL : FLOAT := 69.0E1;
- 
- BEGIN
-         TEST ("C24003B", "LEADING/TRAILING ZEROES IN " &
-               "FLOATING POINT LITERALS");
- 
-         IF 000000000000000000000000000000000000000069.0E1 /= FL THEN
-                 FAILED ("LEADING ZEROES IN INTEGRAL PART OF FLOATING " &
-                         "POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 69.0000000000000000000000000000000000000000E1 /= FL THEN
-                            -- MIGHT RAISE NUMERIC_ERROR AT COMPILE-TIME.
-                 FAILED ("TRAILING ZEROES IN FRACTIONAL PART OF " &
-                         "FLOATING POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 0000000000000000000000000000000000000000690.00000 /= FL THEN
-                 FAILED ("LEADING/TRAILING ZEROES IN MANTISSA OF " &
-                         "FLOATING POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 69.0E00000000000000000000000000000000000000001 /= FL THEN
-                 FAILED ("LEADING ZEROES IN EXPONENT OF FLOATING " &
-                         "POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 16#00000000000000000000000000000000000000002B.2#E1 /= FL THEN
-                 FAILED ("LEADING ZEROES IN BASED FLOATING POINT " &
-                         "LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 16#2B.20000000000000000000000000000000000000000#E1 /= FL THEN
-                 FAILED ("TRAILING ZEROES IN BASED FLOATING POINT " &
-                         "LITERAL NOT IGNORED");
-         END IF;
- 
-         RESULT;
- END C24003B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24003c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24003c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24003c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24003c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C24003C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS AND TRAILING ZEROES IN
- -- FRACTIONAL PARTS OF FIXED POINT LITERALS ARE IGNORED.
- 
- -- JRK 12/12/79
- -- JRK 12/16/80
- -- TBN 10/21/85     RENAMED FROM C24003C.TST AND FIXED LINE LENGTH.
- -- DTN 11/12/91     DELETED SUBPART (B).  CHANGED EXTENSION FROM '.TST' 
- --                  TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C24003C IS
- 
-         USE REPORT;
- 
-         TYPE FIXED IS DELTA 1.0 RANGE 0.0 .. 1000.0;
-         FX : FIXED := 69.0E1;
- 
- BEGIN
- 
-         TEST ("C24003C", "LEADING/TRAILING ZEROES IN " &
-               "FIXED POINT LITERALS");
- 
-         IF 000000000000000000000000000000000000000069.0E1 /= FX THEN
-                 FAILED ("LEADING ZEROES IN INTEGRAL PART OF FIXED " &
-                         "POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 69.0000000000000000000000000000000000000000E1 /= FX THEN
-                            -- MIGHT RAISE NUMERIC_ERROR AT COMPILE-TIME.
-                 FAILED ("TRAILING ZEROES IN FRACTIONAL PART OF " &
-                         "FIXED POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 0000000000000000000000000000000000000000690.00000 /= FX THEN
-                 FAILED ("LEADING/TRAILING ZEROES IN MANTISSA OF " &
-                         "FIXED POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 69.0E00000000000000000000000000000000000000001 /= FX THEN
-                 FAILED ("LEADING ZEROES IN EXPONENT OF FIXED " &
-                         "POINT LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 16#00000000000000000000000000000000000000002B.2#E1 /= FX THEN
-                 FAILED ("LEADING ZEROES IN BASED FIXED POINT " &
-                         "LITERAL NOT IGNORED");
-         END IF;
- 
-         IF 16#2B.20000000000000000000000000000000000000000#E1 /= FX THEN
-                 FAILED ("TRAILING ZEROES IN BASED FIXED POINT " &
-                         "LITERAL NOT IGNORED");
-         END IF;
- 
-         RESULT;
- END C24003C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24106a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- C24106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNDERSCORE CHARACTERS ARE PERMITTED IN ANY PART OF
- --     A NON-BASED DECIMAL LITERAL.
- 
- -- HISTORY:
- --     DHH 01/19/88 CREATED ORIGINAL TEST
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C24106A IS
- 
- BEGIN
-      TEST("C24106A", "CHECK THAT UNDERSCORE CHARACTERS " &
-                      "ARE PERMITTED IN ANY PART OF " &
-                      "A NON-BASED DECIMAL LITERAL");
- 
-      IF 1.2_3_4_5_6 /= 1.23456 THEN
-              FAILED("UNDERSCORES NOT PERMITTED IN FRACTIONAL PART " &
-                     "OF A NON_BASED LITERAL");
-      END IF;
-      IF 1_2_3_4_5.6 /= 12345.6 THEN
-              FAILED("UNDERSCORES NOT PERMITTED IN INTEGRAL PART " &
-                     "OF A NON_BASED LITERAL");
-      END IF;
-      IF 0.12E1_2 /= 0.12E12 THEN
-              FAILED("UNDERSCORES NOT PERMITTED IN EXPONENT PART " &
-                     "OF A NON_BASED LITERAL");
-      END IF;
-      IF 1_2_3_4_5 /= 12345 THEN
-              FAILED("UNDERSCORES NOT PERMITTED IN INTEGRAL PART " &
-                     "OF A NON_BASED LITERAL INTEGER");
-      END IF;
-      IF 0E1_0 /= 0 THEN
-              FAILED("UNDERSCORES NOT PERMITTED IN EXPONENT PART " &
-                     "OF A NON_BASED LITERAL INTEGER");
-      END IF;
- 
-      RESULT;
- END C24106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24202d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24202d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24202d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24202d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C24202D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
- -- IN EVERY PART OF BASED INTEGER, FLOATING POINT, AND FIXED POINT LITERALS.
- 
- -- WMC 03/16/92  CONSOLIDATION OF C24202A.ADA, C24202B.ADA, C24202C.ADA
- 
- WITH REPORT;
- 
- PROCEDURE C24202D IS
- 
-      USE REPORT;
- 
-      TYPE FIXED1 IS DELTA 2.0**(-6) RANGE 0.0 .. 10.0;
- 
-      I1, I2     : INTEGER;
-      F1, F2, F3 : FLOAT;
-      F4, F5     : FIXED1;
- 
- BEGIN
-      TEST("C24202D", "UNDERSCORES ALLOWED IN NUMERIC LITERALS");
- 
-      I1 := 12_3;
-      I2 := 16#D#E0_1;
- 
-      IF (I1 /= 123) OR (I2 /= 16#D#E01) THEN
-           FAILED("UNDERSCORES IN INTEGER LITERALS NOT HANDLED CORRECTLY");
-      END IF;
- 
- 
-      F1 := 1.2_5E1;
-      F2 := 8#1_3.5#;
-      F3 := 8#3.4#E1_1;
- 
-      IF (F1 /= 1.25E1) OR (F2 /= 8#13.5#) OR (F3 /= 8#3.4#E11) THEN
-           FAILED("UNDERSCORES IN FLOATING POINT LITERALS NOT " &
-                  "HANDLED CORRECTLY");
-      END IF;
- 
- 
-      F4 := 1_6#1.A#;
-      F5 := 8#2.3_7#;
- 
-      IF (F4 /= 16#1.A#) OR (F5 /= 8#2.37#) THEN
-           FAILED("UNDERSCORES IN FIXED POINT LITERALS NOT " &
-                  "HANDLED CORRECTLY");
-      END IF;
- 
-      RESULT;
- 
- END C24202D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24203a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24203a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24203a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C24203A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT BASED INTEGER LITERALS WITH BASES 2 THROUGH 16 ALL
- -- YIELD CORRECT VALUES.
- 
- -- JRK 12/12/79
- -- JRK 10/27/80
- -- JWC 6/28/85   RENAMED FROM C24103A.ADA
- 
- WITH REPORT;
- PROCEDURE C24203A IS
- 
-         USE REPORT;
- 
-         I : INTEGER := 200;
- 
- BEGIN
-         TEST ("C24203A", "VALUES OF BASED INTEGER LITERALS");
- 
-         IF 2#11# /= 3 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 2 INTEGER");
-         END IF;
- 
-         IF 3#22# /= 8 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 3 INTEGER");
-         END IF;
- 
-         IF 4#33# /= 15 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 4 INTEGER");
-         END IF;
- 
-         IF 5#44# /= 24 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 5 INTEGER");
-         END IF;
- 
-         IF 6#55# /= 35 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 6 INTEGER");
-         END IF;
- 
-         IF 7#66# /= 48 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER");
-         END IF;
- 
-         IF 8#77# /= 63 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 8 INTEGER");
-         END IF;
- 
-         IF 9#88# /= 80 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 9 INTEGER");
-         END IF;
- 
-         IF 10#99# /= 99 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 10 INTEGER");
-         END IF;
- 
-         IF 11#AA# /= 120 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 11 INTEGER");
-         END IF;
- 
-         IF 12#BB# /= 143 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 12 INTEGER");
-         END IF;
- 
-         IF 13#CC# /= 168 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 13 INTEGER");
-         END IF;
- 
-         IF 14#DD# /= 195 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 14 INTEGER");
-         END IF;
- 
-         IF 15#EE# /= 224 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 15 INTEGER");
-         END IF;
- 
-         IF 16#FF# /= 255 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 16 INTEGER");
-         END IF;
- 
-         ----------------------------------------
- 
-         IF 7#66#E1 /= 336 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER " &
-                         "WITH EXPONENT");
-         END IF;
- 
-         RESULT;
- END C24203A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24203b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24203b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24203b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C24203B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT BASED REAL LITERALS WITH BASES 2 THROUGH 16 ALL
- --     YIELD CORRECT VALUES.
- 
- --     THIS TEST USES MODEL NUMBERS OF DIGITS 6.
- 
- -- HISTORY:
- --     DHH 06/15/88 CREATED ORIGINAL TEST.
- --     DTN 11/30/95 REMOVED CONFORMANCE CHECKS WHERE RULES RELAXED.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C24203B IS
- 
-      TYPE CHECK IS DIGITS 6;
- 
- BEGIN
-      TEST("C24203B", "CHECK THAT BASED REAL LITERALS WITH BASES " &
-                      "2 THROUGH 16 ALL YIELD CORRECT VALUES");
- 
-      IF
-       2#0.0000000000000000000000000000000000000000000000000000000000001#
-       /= 2.0 ** (-61) THEN
-           FAILED ("INCORRECT VALUE FOR BASE 2 REAL LITERAL");
-      END IF;
- 
-      IF 3#0.00000000001# <
-         ((2.0 ** (-18)) + (251558.0 * (2.0 ** (-37)))) OR
-         3#0.00000000001# >
-         ((2.0 ** (-18)) + (251559.0 * (2.0 ** (-37)))) THEN
-           FAILED ("INCORRECT VALUE FOR BASE 3 REAL LITERAL");
-      END IF;
- 
-      IF 4#13333333.213# /= 32767.609375 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 4 REAL LITERAL");
-      END IF;
- 
-      IF 5#2021444.4241121# < 32749.90625 OR
-         5#2021444.4241121# > 32749.921875 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 5 REAL LITERAL");
-      END IF;
- 
-      IF 6#411355.531043# /= 32759.921875 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 6 REAL LITERAL");
-      END IF;
- 
-      IF 7#164366.625344# < 32780.90625 OR
-         7#164366.625344# > 32780.9375 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 7 REAL LITERAL");
-      END IF;
- 
-      IF 8#77777.07# /= 32767.109375 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 8 REAL LITERAL");
-      END IF;
- 
-      IF 9#48888.820314# < 32804.90625 OR
-         9#48888.820314# > 32804.9375 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 9 REAL LITERAL");
-      END IF;
- 
-      IF 10#32767.921875# /= 32767.921875 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 10 REAL LITERAL");
-      END IF;
- 
-      IF 11#2267A.A06682# < 32757.90625 OR
-         11#2267A.A06682# > 32757.921875 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 11 REAL LITERAL");
-      END IF;
- 
-      IF 12#16B5B.B09# /= 32759.921875  THEN
-           FAILED ("INCORRECT VALUE FOR BASE 12 REAL LITERAL");
-      END IF;
- 
-      IF 13#11B9C.BB616# < 32746.90625 OR
-         13#11B9C.BB616# > 32746.921875 THEN
-           FAILED ("INCORRECT VALUE FOR BASE 13 REAL LITERAL");
-      END IF;
- 
-      IF 14#BD1D.CC98A7# /= 32759.921875  THEN
-           FAILED ("INCORRECT VALUE FOR BASE 14 REAL LITERAL");
-      END IF;
- 
-      IF 15#3D28188D45881111111111.0# <
-                                   (((2.0 ** 21) -2.0) * (2.0 ** 63)) THEN
-           FAILED ("INCORRECT VALUE FOR BASE 15 REAL LITERAL");
-      END IF;
- 
- 
-      RESULT;
- END C24203B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24207a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24207a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24207a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- C24207A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LETTERS IN A BASED LITERAL MAY APPEAR IN UPPER OR LOWER 
- -- CASE.
- 
- -- TBN 2/28/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C24207A IS
- 
-      TYPE FLOAT IS DIGITS 5;
-      INT_1 : INTEGER := 15#AbC# ;
-      INT_2 : INTEGER := 15#aBc# ;
-      FLO_1 : FLOAT := 16#FeD.C#e1;
-      FLO_2 : FLOAT := 16#fEd.c#E1;
- 
- BEGIN
-      TEST("C24207A", "CHECK THAT LETTERS IN A BASED LITERAL MAY " &
-                      "APPEAR IN UPPER OR LOWER CASE");
- 
-      IF INT_1 /= INT_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 1");
-      END IF;
- 
-      IF FLO_1 /= FLO_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 2");
-      END IF;
- 
-      INT_1 := 14#aBc#E1;
-      INT_2 := 14#AbC#e1;
-      FLO_1 := 16#CdEf.aB#E0;
-      FLO_2 := 16#cDeF.Ab#e0;
- 
-      IF INT_1 /= INT_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 3");
-      END IF;
- 
-      IF FLO_1 /= FLO_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 4");
-      END IF;
-      
-      RESULT;
- END C24207A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24211a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c24211a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c24211a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C24211A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT LEGAL FORMS INVOLVING A DIGIT FOLLOWED BY A COLON ARE
- --     CORRECTLY ANALYZED USING A TWO CHARACTER LOOK-AHEAD.
- 
- -- HISTORY:
- --     DHH 01/19/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C24211A IS
- 
-      TYPE FIXED IS DELTA 0.0125 RANGE -1.0 .. 100.0;
- 
-      A : INTEGER RANGE 0 .. 2:10::= 1;
-      B : INTEGER RANGE 0 .. 2#10#:= 1;
-      X : FIXED RANGE 0.0 .. 16:3.0::= 1.0;
-      Y : FIXED RANGE 0.0 .. 16#3.0#:= 1.0;
-      IN2 : INTEGER;
-      BOOL : BOOLEAN:=3:10:=3:10:;
- 
- BEGIN
- 
-      TEST("C24211A", "CHECK THAT LEGAL FORMS INVOLVING A DIGIT " &
-                      "FOLLOWED BY A COLON ARE CORRECTLY ANALYZED " &
-                      "USING A TWO CHARACTER LOOK-AHEAD");
- 
-      IF IDENT_INT(A) /= B THEN
-           FAILED("CALCULATIONS OF BASED INTEGER LITERALS WHEN " &
-                  "REPRESENTED BY SHARPS DO NOT MATCH CALCULATIONS " &
-                  "OF BASED INTEGER LITERALS REPRESENTED BY COLONS");
-      END IF;
-      A := A + 1;
- 
- 
-      IF EQUAL(3,3) THEN
-           Y := X + Y;
-      ELSE
-           Y := X - Y;
-      END IF;
- 
-      IF (2 * X) = Y THEN
-           NULL;
-      ELSE
-           FAILED("CALCULATIONS OF BASED REAL LITERALS WHEN " &
-                  "REPRESENTED BY SHARPS DO NOT MATCH CALCULATIONS " &
-                  "OF BASED REAL LITERALS REPRESENTED BY COLONS");
-      END IF;
-      IF NOT BOOL THEN
-           FAILED("BOOLEAN VALUE BASED ON REAL LITERAL WAS CALCULATED " &
-                  "INCORRECTLY");
-           IN2:=2:10:;
-      ELSE
-           BOOL := FALSE;
-           IN2:=3:10:;
-      END IF;
-      IF BOOL THEN
-           A := A + 1;
-      ELSE
-           A := A - 1;
-      END IF;
- 
-      RESULT;
- END C24211A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c250001.aw gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c250001.aw
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c250001.aw	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c250001.aw	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- C250001.AW
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that wide character literals are supported.
- --      Check that wide character string literals are supported.
- --
- -- TEST DESCRIPTION:
- --      This test utilizes the brackets scheme for representing wide character
- --      values in transportable 7 bit ASCII as proposed by Robert Dewar;
- --      this test defines Wide_Character and Wide_String objects, and assigns
- --      and tests several sample values.
- --
- -- SPECIAL REQUIREMENTS:
- --
- --      This file must be preprocessed before it can be executed as a test.
- --
- --      This test requires that all occurrences of the bracket escape
- --      representation for wide characters be replaced, as appropriate, with
- --      the corresponding wide character as represented by the implementation.
- --
- --      Characters above ASCII.Del are represented by an 8 character sequence:
- --
- --          ["xxxx"]
- --
- --      where the character code represented is specified by four hexadecimal
- --      digits, (<xxxx>) upper case. For example the wide character with the
- --      code 16#ABCD# is represented by the eight character sequence:
- --
- --          ["ABCD"]
- --
- --      The following function documents the translation algorithm:
- --
- --     function To_Wide( S:String ) return Wide_character is
- --       Numerical : Natural := 0;
- --       type Xlate is array(Character range '0'..'F') of Natural;
- --       Xlation : Xlate
- --               := ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
- --                   '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
- --                   'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
- --                   'F' => 15,  others => 0 );
- --     begin
- --       for I in S'Range loop
- --         Numerical := Numerical * 16 + Xlation(S(I));
- --       end loop;
- --       return Wide_Character'Val(Numerical);  -- the returned value is
- --                                   implementation dependent
- --     exception
- --       when Constraint_Error => raise;
- --     end To_Wide;
- --
- --
- -- CHANGE HISTORY:
- --      26 OCT 95   SAIC   Initial .Aversion
- --      11 APR 96   SAIC   Minor robustness changes for 2.1
- --      12 NOV 96   SAIC   Changed file extension to .AW
- --
- --!
- 
- ----------------------------------------------------------------- C250001_0
- 
- package C250001_0 is
- 
-   -- The wide characters used in this test are sequential starting with
-   -- the character '["4F42"]' 16#0F42#
- 
-   Four_Eff_Four_Two : constant Wide_Character := '["4F42"]';
- 
-   Four_Eff_4_3_Through_9 : constant Wide_String := 
-                "["4F43"]["4F44"]["4F45"]["4F46"]["4F47"]["4F48"]["4F49"]";
- 
-   Four_Eff_A_B : constant Wide_String := "["4F4A"]["4F4B"]";
- 
- end C250001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- -- no package body C250001_0 is required or allowed
- 
- ------------------------------------------------------------------- C250001
- 
- with Report;
- with C250001_0;
- with Ada.Tags;
- 
- procedure C250001 is
-   use C250001_0; 
- 
-   function Hex( N: Natural ) return String is
-     S : String := "xxxx";
-     T : String := "0123456789ABCDEF";
-     V : Natural := N;
-   begin
-     for I in reverse 1..4 loop
-       S(I) := T(V rem 16 +1);
-       V := V / 16;
-     end loop;
-     return S;
-   end Hex;
- 
-   procedure Match( Check : Wide_Character; Matching : Natural ) is
-   begin
-     if Wide_Character'Pos( Check ) /= Matching then
-       Report.Failed( "Didn't match for " & Hex(Matching) );
-     end if;
-   end Match;
- 
-   type Value_List is array(Positive range <>) of Natural;
- 
-   procedure Match( Check : Wide_String; Matching : Value_List ) is
-   begin
-     if Check'Length /= Matching'Length then
-       Report.Failed( "Check'Length /= Matching'Length" );
-     else
-       for I in Check'Range loop
-         Match( Check(I), Matching(I) );
-       end loop;
-     end if;
-   end Match;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C250001", "Check that wide character literals " &
-                           "are supported.  Check that wide character " &
-                           "string literals are supported." );
- 
-   Match( Four_Eff_Four_Two, 16#4F42# );
- 
-   Match(Four_Eff_4_3_Through_9,
-          (16#4F43#,16#4F44#,16#4F45#,16#4F46#,16#4F47#,16#4F48#,16#4F49#) );
- 
-  -- check catenations
- 
-   Match( Four_Eff_Four_Two & Four_Eff_Four_Two, (16#4F42#,16#4F42#) );
- 
-   Match( Four_Eff_Four_Two & Four_Eff_A_B, (16#4F42#,16#4F4A#,16#4F4B#) );
- 
-   Match( Four_Eff_A_B & Four_Eff_Four_Two, (16#4F4A#,16#4F4B#,16#4F42#) );
- 
-   Match( Four_Eff_A_B & Four_Eff_A_B,
-          (16#4F4A#,16#4F4B#,16#4F4A#,16#4F4B#) );
- 
-   Report.Result;
- 
- end C250001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c250002.aw gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c250002.aw
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c250002.aw	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c250002.aw	Thu Jan  1 00:00:00 1970
***************
*** 1,213 ****
- -- C250002.AW
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that characters in Latin-1 above ASCII.Del can be used in
- --      identifiers, character literals and strings.
- -- 
- -- TEST DESCRIPTION:
- --      This test utilizes the brackets scheme for representing Latin-1
- --      character values in transportable 7 bit ASCII as proposed by
- --      Robert Dewar; this test defines Character and String objects,
- --      assigns and tests several sample values.  Several Identifiers
- --      used in this test also include Characters via the bracket escape
- --      sequence scheme.
- --
- --      Note that C250001 checks Wide_Characters and Wide_Strings.
- --
- -- SPECIAL REQUIREMENTS:
- --
- --      This file must be preprocessed before it can be executed as a test.
- --
- --      This test requires that all occurrences of the bracket escaped
- --      characters be replaced with the corresponding 8 bit character.
- --
- --      Characters above ASCII.Del are represented by a 6 character sequence:
- --
- --          ["xx"]
- --
- --      where the character code represented is specified by two hexadecimal
- --      digits (<xx>) upper case. For example the Latin-1 character with the
- --      code 16#AB# is represented by the six character sequence:
- --
- --          ["AB"]
- --
- --      None of the values used in this test should be interpreted as
- --      a control character.
- --
- --      The following function documents the translation algorithm:
- --
- --     function To_Char( S:String ) return Character is
- --       Numerical : Natural := 0;
- --       type Xlate is array(Character range '0'..'F') of Natural;
- --       Xlation : Xlate
- --               := ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
- --                   '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
- --                   'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
- --                   'F' => 15,  others => 0 );
- --     begin
- --       for I in S'Range loop
- --         Numerical := Numerical * 16 + Xlation(S(I));
- --       end loop;
- --       return Character'Val(Numerical);
- --     end To_Char;
- --
- --
- -- CHANGE HISTORY:
- --      10 JAN 96   SAIC   Initial version
- --      12 NOV 96   SAIC   Changed file extension to .AW
- --
- --!
- 
- ----------------------------------------------------------------- C250002_0
- 
- package C250002_0 is
- 
-   -- The extended characters used in this test start with
-   -- the character '["A1"]' 16#A1# and increase from there
- 
-   type Tagged_["C0"]_Id is tagged record
-     Length, Width: Natural;
-   end record;
- 
-   X_Char_A2 : constant Character := '["A2"]';
- 
-   X_Char_A3_Through_A9 : constant String := 
-                "["A3"]["A4"]["A5"]["A6"]["A7"]["A8"]["A9"]";
- 
-   X_Char_AA_AB : constant String := "["AA"]["AB"]";
- 
- end C250002_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- -- no package body C250002_0 is required or allowed
- 
- ----------------------------------------------------------------- C250002_X
- 
- with Ada.Characters.Latin_1;
- package C250002_["C1"] is
- 
-   type Enum is ( Item, 'A', '["AD"]', AE_["C6"]["E6"]_ae,
-                  '["2D"]', '["FF"]' );
- 
-   task type C2_["C2"] is
-     entry C2_["C3"];
-   end C2_["C2"];
- 
- end C250002_["C1"];
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C250002_["C1"] is
- 
-   task body C2_["C2"] is
-   begin
-     accept C2_["C3"];
-   end C2_["C2"];
- 
- end C250002_["C1"];
- 
- ------------------------------------------------------------------- C250002
- 
- with Report;
- with C250002_0;
- with C250002_["C1"];
- 
- with Ada.Tags;
- 
- procedure C250002 is
-   use C250002_0; 
- 
-   My_Task: C250002_["C1"].C2_["C2"];
- 
-   function Hex( N: Natural ) return String is
-     S : String := "xx";
-     T : String := "0123456789ABCDEF";
-   begin
-     S(1) := T(N  /  16 +1);
-     S(2) := T(N mod 16 +1);
-     return S;
-   end Hex;
- 
-   procedure Match( Check : Character; Matching : Natural ) is
-   begin
-     if Check /= Character'Val( Matching ) then
-       Report.Failed( "Didn't match for " & Hex(Matching) );
-     end if;
-   end Match;
- 
-   type Value_List is array(Positive range <>) of Natural;
- 
-   procedure Match( Check : String; Matching : Value_List ) is
-   begin
-     if Check'Length /= Matching'Length then
-       Report.Failed( "Check'Length /= Matching'Length" );
-     else
-       for I in Check'Range loop
-         Match( Check(I), Matching(I - Check'First + Matching'First) );
-       end loop;
-     end if;
-   end Match;
- 
-   TC_Count : Natural := 0;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C250002", "Check that characters above ASCII.Del can be " &
-                           "used in identifiers, character literals and " &
-                           "strings" );
- 
-   Report.Comment( Ada.Tags.Expanded_Name(Tagged_["C0"]_Id'Tag) );
- 
-   for Specials in C250002_["C1"].Enum loop
-     TC_Count := TC_Count +1;
-   end loop;
- 
-   if TC_Count /= 6 then
-     Report.Failed("Expected 6 literals in Enum");
-   end if;
- 
-   Match( X_Char_A2, 16#A2# );
- 
-   Match(X_Char_A3_Through_A9,
-          (16#A3#,16#A4#,16#A5#,16#A6#,16#A7#,16#A8#,16#A9#) );
- 
-   -- check catenations
- 
-   Match( X_Char_A2 & X_Char_A2, (16#A2#,16#A2#) );
- 
-   Match( X_Char_A2 & X_Char_AA_AB, (16#A2#,16#AA#,16#AB#) );
- 
-   Match( X_Char_AA_AB & X_Char_A2, (16#AA#,16#AB#,16#A2#) );
- 
-   Match( X_Char_AA_AB & X_Char_AA_AB,
-          (16#AA#,16#AB#,16#AA#,16#AB#) );
- 
-   My_Task.C2_["C3"];
- 
-   Report.Result;
- 
- end C250002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c25001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c25001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c25001a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c25001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,211 ****
- -- C25001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL CHARACTER LITERALS CAN BE WRITTEN.
- 
- --      CASE A: THE BASIC CHARACTER SET.
- 
- -- TBN  3/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C25001A IS
- 
- BEGIN
-      TEST ("C25001A", "CHECK THAT EACH CHARACTER IN THE BASIC " &
-                       "CHARACTER SET CAN BE WRITTEN");
- 
-      IF CHARACTER'POS('A') /= 65 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'A'");
-      END IF;
-      IF CHARACTER'POS('B') /= 66 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'B'");
-      END IF;
-      IF CHARACTER'POS('C') /= 67 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'C'");
-      END IF;
-      IF CHARACTER'POS('D') /= 68 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'D'");
-      END IF;
-      IF CHARACTER'POS('E') /= 69 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'E'");
-      END IF;
-      IF CHARACTER'POS('F') /= 70 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'F'");
-      END IF;
-      IF CHARACTER'POS('G') /= 71 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'G'");
-      END IF;
-      IF CHARACTER'POS('H') /= 72 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'H'");
-      END IF;
-      IF CHARACTER'POS('I') /= 73 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'I'");
-      END IF;
-      IF CHARACTER'POS('J') /= 74 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'J'");
-      END IF;
-      IF CHARACTER'POS('K') /= 75 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'K'");
-      END IF;
-      IF CHARACTER'POS('L') /= 76 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'L'");
-      END IF;
-      IF CHARACTER'POS('M') /= 77 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'M'");
-      END IF;
-      IF CHARACTER'POS('N') /= 78 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'N'");
-      END IF;
-      IF CHARACTER'POS('O') /= 79 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'O'");
-      END IF;
-      IF CHARACTER'POS('P') /= 80 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'P'");
-      END IF;
-      IF CHARACTER'POS('Q') /= 81 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'Q'");
-      END IF;
-      IF CHARACTER'POS('R') /= 82 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'R'");
-      END IF;
-      IF CHARACTER'POS('S') /= 83 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'S'");
-      END IF;
-      IF CHARACTER'POS('T') /= 84 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'T'");
-      END IF;
-      IF CHARACTER'POS('U') /= 85 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'U'");
-      END IF;
-      IF CHARACTER'POS('V') /= 86 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'V'");
-      END IF;
-      IF CHARACTER'POS('W') /= 87 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'W'");
-      END IF;
-      IF CHARACTER'POS('X') /= 88 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'X'");
-      END IF;
-      IF CHARACTER'POS('Y') /= 89 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'Y'");
-      END IF;
-      IF CHARACTER'POS('Z') /= 90 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'Z'");
-      END IF;
- 
-      IF CHARACTER'POS('0') /= 48 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '0'");
-      END IF;
-      IF CHARACTER'POS('1') /= 49 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '1'");
-      END IF;
-      IF CHARACTER'POS('2') /= 50 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '2'");
-      END IF;
-      IF CHARACTER'POS('3') /= 51 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '3'");
-      END IF;
-      IF CHARACTER'POS('4') /= 52 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '4'");
-      END IF;
-      IF CHARACTER'POS('5') /= 53 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '5'");
-      END IF;
-      IF CHARACTER'POS('6') /= 54 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '6'");
-      END IF;
-      IF CHARACTER'POS('7') /= 55 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '7'");
-      END IF;
-      IF CHARACTER'POS('8') /= 56 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '8'");
-      END IF;
-      IF CHARACTER'POS('9') /= 57 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '9'");
-      END IF;
- 
-      IF CHARACTER'POS('"') /= 34 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '""'");
-      END IF;
-      IF CHARACTER'POS('#') /= 35 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '#'");
-      END IF;
-      IF CHARACTER'POS('&') /= 38 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '&'");
-      END IF;
-      IF CHARACTER'POS(''') /= 39 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '''");
-      END IF;
-      IF CHARACTER'POS('(') /= 40 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '('");
-      END IF;
-      IF CHARACTER'POS(')') /= 41 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR ')'");
-      END IF;
-      IF CHARACTER'POS('*') /= 42 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '*'");
-      END IF;
-      IF CHARACTER'POS('+') /= 43 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '+'");
-      END IF;
-      IF CHARACTER'POS(',') /= 44 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR ','");
-      END IF;
-      IF CHARACTER'POS('-') /= 45 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '-'");
-      END IF;
-      IF CHARACTER'POS('.') /= 46 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '.'");
-      END IF;
-      IF CHARACTER'POS('/') /= 47 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '/'");
-      END IF;
-      IF CHARACTER'POS(':') /= 58 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR ':'");
-      END IF;
-      IF CHARACTER'POS(';') /= 59 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR ';'");
-      END IF;
-      IF CHARACTER'POS('<') /= 60 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '<'");
-      END IF;
-      IF CHARACTER'POS('=') /= 61 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '='");
-      END IF;
-      IF CHARACTER'POS('>') /= 62 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '>'");
-      END IF;
-      IF CHARACTER'POS('_') /= 95 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '_'");
-      END IF;
-      IF CHARACTER'POS('|') /= 124 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '|'");
-      END IF;
- 
-      IF CHARACTER'POS(' ') /= 32 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR ' '");
-      END IF;
- 
-      RESULT;
- END C25001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c25001b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c25001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c25001b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c25001b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- C25001B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL CHARACTER LITERALS CAN BE WRITTEN.
- 
- --      CASE B: THE LOWER CASE LETTERS AND THE OTHER
- --              SPECIAL CHARACTERS.
- 
- -- TBN  8/1/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C25001B IS
- 
- BEGIN
-      TEST ("C25001B", "CHECK THAT EACH CHARACTER IN THE LOWER CASE " &
-                       "LETTERS AND THE OTHER SPECIAL CHARACTERS CAN " &
-                       "BE WRITTEN");
- 
-      IF CHARACTER'POS('a') /= 97 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'a'");
-      END IF;
-      IF CHARACTER'POS('b') /= 98 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'b'");
-      END IF;
-      IF CHARACTER'POS('c') /= 99 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'c'");
-      END IF;
-      IF CHARACTER'POS('d') /= 100 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'd'");
-      END IF;
-      IF CHARACTER'POS('e') /= 101 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'e'");
-      END IF;
-      IF CHARACTER'POS('f') /= 102 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'f'");
-      END IF;
-      IF CHARACTER'POS('g') /= 103 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'g'");
-      END IF;
-      IF CHARACTER'POS('h') /= 104 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'h'");
-      END IF;
-      IF CHARACTER'POS('i') /= 105 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'i'");
-      END IF;
-      IF CHARACTER'POS('j') /= 106 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'j'");
-      END IF;
-      IF CHARACTER'POS('k') /= 107 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'k'");
-      END IF;
-      IF CHARACTER'POS('l') /= 108 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'l'");
-      END IF;
-      IF CHARACTER'POS('m') /= 109 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'm'");
-      END IF;
-      IF CHARACTER'POS('n') /= 110 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'n'");
-      END IF;
-      IF CHARACTER'POS('o') /= 111 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'o'");
-      END IF;
-      IF CHARACTER'POS('p') /= 112 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'p'");
-      END IF;
-      IF CHARACTER'POS('q') /= 113 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'q'");
-      END IF;
-      IF CHARACTER'POS('r') /= 114 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'r'");
-      END IF;
-      IF CHARACTER'POS('s') /= 115 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 's'");
-      END IF;
-      IF CHARACTER'POS('t') /= 116 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 't'");
-      END IF;
-      IF CHARACTER'POS('u') /= 117 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'u'");
-      END IF;
-      IF CHARACTER'POS('v') /= 118 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'v'");
-      END IF;
-      IF CHARACTER'POS('w') /= 119 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'w'");
-      END IF;
-      IF CHARACTER'POS('x') /= 120 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'x'");
-      END IF;
-      IF CHARACTER'POS('y') /= 121 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'y'");
-      END IF;
-      IF CHARACTER'POS('z') /= 122 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR 'z'");
-      END IF;
- 
-      IF CHARACTER'POS('!') /= 33 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '!'");
-      END IF;
-      IF CHARACTER'POS('$') /= 36 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '$'");
-      END IF;
-      IF CHARACTER'POS('%') /= 37 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '%'");
-      END IF;
-      IF CHARACTER'POS('?') /= 63 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '?'");
-      END IF;
-      IF CHARACTER'POS('@') /= 64 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '@'");
-      END IF;
-      IF CHARACTER'POS('[') /= 91 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '['");
-      END IF;
-      IF CHARACTER'POS('\') /= 92 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '\'");
-      END IF;
-      IF CHARACTER'POS(']') /= 93 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR ']'");
-      END IF;
-      IF CHARACTER'POS('^') /= 94 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '^'");
-      END IF;
-      IF CHARACTER'POS('`') /= 96 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '`'");
-      END IF;
-      IF CHARACTER'POS('{') /= 123 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '{'");
-      END IF;
-      IF CHARACTER'POS('}') /= 125 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '}'");
-      END IF;
-      IF CHARACTER'POS('~') /= 126 THEN
-           FAILED ("INCORRECT POSITION NUMBER FOR '~'");
-      END IF;
-  
-      RESULT;
- END C25001B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c26006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c26006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c26006a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c26006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- C26006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL ASCII CHARACTERS CAN APPEAR IN THE MIDDLE OF A STRING
- -- (I.E., NONE ARE USED IN THE INTERNAL REPRESENTATION TO TERMINATE THE
- -- STRING).
- 
- -- JRK 12/12/79
- 
- WITH REPORT;
- PROCEDURE C26006A IS
- 
-         USE REPORT;
- 
-         S1 : STRING (1..3) := "A 1";
-         S2 : STRING (1..3) := "A 2";
- 
- BEGIN
-         TEST ("C26006A", "ALL ASCII CHARACTERS CAN APPEAR IN MIDDLE " &
-               "OF STRINGS");
- 
-         FOR C IN CHARACTER'FIRST .. CHARACTER'LAST LOOP
-                 S1 (2) := C;
-                 S2 (2) := C;
-                 IF S1 = S2 THEN
-                         FAILED (CHARACTER'IMAGE(C) & " TERMINATED A " &
-                                 "STRING = COMPARISON");
-                 END IF;
-         END LOOP;
- 
-         RESULT;
- END C26006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c26008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c26008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c26008a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c26008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- C26008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UPPER AND LOWER CASE LETTERS ARE DISTINCT WITHIN STRING
- -- LITERALS.
- 
- -- JRK 12/12/79
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT;
- PROCEDURE C26008A IS
- 
-         USE REPORT;
- 
- BEGIN
-         TEST ("C26008A", "UPPER/LOWER CASE ARE DISTINCT IN STRING " &
-               "LITERALS");
- 
-         IF CHARACTER'('a') = 'A'  THEN
-                 FAILED ("LOWER CASE NOT DISTINCT FROM UPPER IN " &
-                         "CHARACTER LITERALS");
-         END IF;
- 
-         IF STRING'("abcde") = "ABCDE" THEN
-                 FAILED ("LOWER CASE NOT DISTINCT FROM UPPER IN " &
-                         "STRING LITERALS");
-         END IF;
- 
-         RESULT;
- END C26008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- C2A001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
- -- IN EVERY PART OF A BASED INTEGER LITERAL WHEN SHARPS
- -- ARE USED INSTEAD OF COLONS.
- 
- -- INTEGER LITERALS.
- 
- -- DCB 1/24/80
- -- JRK 10/27/80
- -- JBG 5/28/85
- 
- WITH REPORT;
- PROCEDURE C2A001A IS
- 
-      USE REPORT;
- 
-      I1, I2, I3, I4 : INTEGER;
- 
- BEGIN
-      TEST("C2A001A", "UNDERSCORES ALLOWED IN BASED INTEGER LITERALS " &
-                      "THAT HAVE COLONS");
- 
-      I1 := 12_3;
-      I2 := 1_6:D:;
-      I3 := 2:1011_0101:;
-      I4 := 16:D:E0_1;
- 
-      IF I1 = 123 AND I2 = 16:D: AND I3 = 2:10110101: AND
-         I4 = 16:D:E01 THEN
-           NULL;
-      ELSE 
-           FAILED("UNDERSCORES IN INTEGER LITERALS NOT HANDLED " &
-                  "CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C2A001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- C2A001B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
- -- IN EVERY PART OF A BASED FLOATING POINT LITERAL THAT
- -- USES COLONS INSTEAD OF SHARPS.
- 
- -- DCB 04/22/80
- -- JRK 10/27/80
- -- JBG 5/28/85
- 
- WITH REPORT;
- PROCEDURE C2A001B IS
- 
-      USE REPORT;
- 
-      F1, F2, F3, F4, F5 : FLOAT;
- 
- BEGIN
-      TEST("C2A001B", "UNDERSCORES ALLOWED IN BASED FLOATING POINT " &
-                      "LITERALS THAT HAVE COLONS");
- 
-      F1 := 1.2_5E1;
-      F2 := 1_6:1.A:;
-      F3 := 8:1_3.5:;
-      F4 := 8:2.3_7:;
-      F5 := 8:3.4:E1_1;
- 
-      IF F1 = 1.25E1 AND F2 = 16:1.A: AND F3 = 8:13.5: AND
-         F4 = 8:2.37: AND F5 = 8:3.4:E11 THEN
-           NULL;
-      ELSE 
-           FAILED("UNDERSCORES IN FLOATING POINT LITERALS NOT " &
-                  "HANDLED CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C2A001B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- C2A001C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
- -- IN EVERY PART OF A BASED FIXED POINT LITERAL THAT USES
- -- COLONS INSTEAD OF SHARPS.
- 
- -- DCB 04/22/80
- -- JRK 10/27/80
- -- JBG 5/28/85
- 
- WITH REPORT;
- PROCEDURE C2A001C IS
- 
-      USE REPORT;
- 
-      TYPE FIXED1 IS DELTA 2.0**(-6) RANGE 0.0 .. 10.0;
-      TYPE FIXED2 IS DELTA 2.0**(-4) RANGE 0.0 .. 100.0;
- 
-      F2, F4 : FIXED1;
-      F1, F3, F5 : FIXED2;
- 
- BEGIN
-      TEST("C2A001C", "UNDERSCORES ALLOWED IN BASED FIXED POINT " &
-                      "LITERALS THAT USE COLONS");
- 
-      F1 := 1.2_5E1;
-      F2 := 1_6:1.A:;
-      F3 := 8:1_3.5:;
-      F4 := 8:2.3_7:;
-      F5 := 8:3.4:E0_1;
- 
-      IF F1 = 1.25E1 AND F2 = 16:1.A: AND F3 = 8:13.5: AND
-         F4 = 8:2.37: AND F5 = 8:3.4:E01 THEN
-           NULL;
-      ELSE 
-           FAILED("UNDERSCORES IN FIXED POINT LITERALS NOT " &
-                  "HANDLED CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C2A001C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C2A002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT BASED INTEGER LITERALS WITH BASES 2 THROUGH 16 ALL
- -- YIELD CORRECT VALUES WHEN COLONS ARE USED INSTEAD OF SHARPS.
- 
- -- JRK 12/12/79
- -- JRK 10/27/80
- -- JBG 5/28/85
- 
- WITH REPORT;
- PROCEDURE C2A002A IS
- 
-         USE REPORT;
- 
-         I : INTEGER := 200;
- 
- BEGIN
-         TEST ("C2A002A", "VALUES OF BASED INTEGER LITERALS WITH " &
-                          "COLONS");
- 
-         IF 2:11: /= 3 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 2 INTEGER");
-         END IF;
- 
-         IF 3:22: /= 8 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 3 INTEGER");
-         END IF;
- 
-         IF 4:33: /= 15 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 4 INTEGER");
-         END IF;
- 
-         IF 5:44: /= 24 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 5 INTEGER");
-         END IF;
- 
-         IF 6:55: /= 35 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 6 INTEGER");
-         END IF;
- 
-         IF 7:66: /= 48 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER");
-         END IF;
- 
-         IF 8:77: /= 63 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 8 INTEGER");
-         END IF;
- 
-         IF 9:88: /= 80 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 9 INTEGER");
-         END IF;
- 
-         IF 10:99: /= 99 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 10 INTEGER");
-         END IF;
- 
-         IF 11:AA: /= 120 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 11 INTEGER");
-         END IF;
- 
-         IF 12:BB: /= 143 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 12 INTEGER");
-         END IF;
- 
-         IF 13:CC: /= 168 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 13 INTEGER");
-         END IF;
- 
-         IF 14:DD: /= 195 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 14 INTEGER");
-         END IF;
- 
-         IF 15:EE: /= 224 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 15 INTEGER");
-         END IF;
- 
-         IF 16:FF: /= 255 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 16 INTEGER");
-         END IF;
- 
-         ----------------------------------------
- 
-         IF 7:66:E1 /= 336 THEN
-                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER " &
-                         "WITH EXPONENT");
-         END IF;
- 
-         RESULT;
- END C2A002A; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- C2A008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UPPER AND LOWER CASE "E" MAY APPEAR IN BASED LITERALS,
- -- WHEN USING COLONS IN PLACE OF THE SHARP SIGN.
- 
- -- TBN 2/28/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C2A008A IS
- 
-      TYPE FLOAT IS DIGITS 5;
-      INT_1 : INTEGER := 15:A:E1;
-      INT_2 : INTEGER := 15:A:e1;
-      FLO_1 : FLOAT := 16:FD.C:E1;
-      FLO_2 : FLOAT := 16:FD.C:e1;
- 
- BEGIN
-      TEST("C2A008A", "CHECK THAT UPPER AND LOWER CASE ""E"" MAY " &
-                      "APPEAR IN BASED LITERALS, WHEN USING COLONS " &
-                      "IN PLACE OF THE SHARP SIGN");
- 
-      IF INT_1 /= INT_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 1");
-      END IF;
- 
-      IF FLO_1 /= FLO_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 2");
-      END IF;
- 
-      INT_1 := 14:BC:E1;
-      INT_2 := 14:BC:e1;
-      FLO_1 := 16:DEF.AB:E0;
-      FLO_2 := 16:DEF.AB:e0;
- 
-      IF INT_1 /= INT_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 3");
-      END IF;
- 
-      IF FLO_1 /= FLO_2 THEN
-           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 4");
-      END IF;
-      
-      RESULT;
- END C2A008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,44 ****
- -- C2A021B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A STRING LITERAL DELIMITED BY PERCENT SIGNS MUST CONTAIN A
- -- DOUBLED PERCENT CHARACTER IF THE STRING VALUE IS TO CONTAIN A PERCENT
- -- CHARACTER.
- 
- -- JBG 5/25/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C2A021B IS
-      X : STRING (1..5) := %%%%%345%;
-      Y : STRING (1..5) := IDENT_STR ("%%345");
- BEGIN
-      TEST ("C2A021B", "CHECK USE OF PERCENT SIGN INSIDE STRINGS " &
-                       "DELIMITED WITH PERCENT SIGNS");
- 
-      IF X /= Y THEN
-           FAILED ("STRING LITERALS NOT EQUAL");
-      END IF;
- 
-      RESULT;
- END C2A021B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C32001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR SCALAR TYPES, THE 
- -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
- -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
- -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
- -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
- 
- -- RJW 7/16/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32001A IS
- 
-      BUMP : ARRAY (1 .. 8) OF INTEGER := (OTHERS => 0);
- 
-      FUNCTION F (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP (I) + 1;
-           RETURN BUMP (I);
-      END F;
-           
- BEGIN
-      TEST ("C32001A", "CHECK THAT IN MULTIPLE OBJECT DECLARATION " & 
-                       "FOR SCALAR TYPES, THE SUBTYPE INDICATION " & 
-                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
-                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
-                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
-                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
-                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
-                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
-      
-      DECLARE
- 
-           TYPE DAY IS (MON, TUES, WED, THURS, FRI);
-           D1, D2   : DAY 
-                      RANGE MON .. DAY'VAL (F (1)) :=
-                      DAY'VAL (F (1) - 1);
-           CD1, CD2 : CONSTANT DAY 
-                      RANGE MON .. DAY'VAL (F (2)) :=
-                      DAY'VAL (F (2) - 1);
- 
-           I1, I2   : INTEGER RANGE 0 .. F (3) :=
-                      F (3) - 1;
-           CI1, CI2 : CONSTANT INTEGER RANGE 0 .. F (4) 
-                      := F (4) - 1;
- 
-           TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
-           FL1, FL2   : FLT RANGE 0.0 .. FLT (F (5)) :=
-                        FLT (F (5) - 1);
-           CFL1, CFL2 : CONSTANT FLT 
-                        RANGE 0.0 .. FLT (F (6)) := 
-                        FLT (F (6) - 1);
- 
-           TYPE FIX IS DELTA 1.0 RANGE -5.0 .. 5.0;
-           FI1, FI2   : FIX RANGE 0.0 .. FIX (F (7)) :=
-                        FIX (F (7) - 1);
-           CFI1, CFI2 : CONSTANT FIX 
-                        RANGE 0.0 .. FIX (F (8)) := 
-                        FIX (F (8) - 1);
- 
-      BEGIN
-           IF D1 /= TUES THEN 
-                FAILED ( "D1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF D2 /= THURS THEN 
-                FAILED ( "D2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CD1 /= TUES THEN 
-                FAILED ( "CD1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CD2 /= THURS THEN 
-                FAILED ( "CD2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF I1 /= 1 THEN 
-                FAILED ( "I1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF I2 /= 3 THEN 
-                FAILED ( "I2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CI1 /= 1 THEN 
-                FAILED ( "CI1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CI2 /= 3 THEN 
-                FAILED ( "CI2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF FL1 /= 1.0 THEN 
-                FAILED ( "FL1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF FL2 /= 3.0 THEN 
-                FAILED ( "FL2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CFL1 /= 1.0 THEN 
-                FAILED ( "CFL1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CFL2 /= 3.0 THEN 
-                FAILED ( "CFL2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF FI1 /= 1.0 THEN 
-                FAILED ( "FI1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF FI2 /= 3.0 THEN 
-                FAILED ( "FI2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CFI1 /= 1.0 THEN 
-                FAILED ( "CFI1 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-           IF CFI2 /= 3.0 THEN 
-                FAILED ( "CFI2 NOT INITIALIZED TO CORRECT VALUE" );
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C32001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,249 ****
- -- C32001B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ARRAY TYPES, THE
- --     SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE
- --     EVALUATED ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE
- --     SUBTYPE INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE
- --     EVALUATIONS YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT
- --     DECLARATIONS.
- 
- -- HISTORY:
- --     RJW 07/16/86  CREATED ORIGINAL TEST.
- --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
- --                   COMMENTS FOR S4 AND CS4 TO READ THAT THE BOUNDS ARE
- --                   1 .. 6 AND THE COMPONENT TYPE ARR IS 1 .. 5.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32001B IS
- 
-      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
- 
-      BUMP : ARRAY (1 .. 4) OF INTEGER := (0, 0, 0, 0);
- 
-      FUNCTION F (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP (I) + 1;
-           RETURN BUMP (I);
-      END F;
- 
- BEGIN
-      TEST ("C32001B", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " &
-                       "FOR ARRAY TYPES, THE SUBTYPE INDICATION " &
-                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
-                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
-                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
-                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
-                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
-                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
- 
-      DECLARE
- 
-           S1, S2   : ARR (1 .. F (1)) := (OTHERS => F (1));
-           CS1, CS2 : CONSTANT ARR (1 .. F (2)) := (OTHERS => F (2));
- 
-           PROCEDURE CHECK (A, B : ARR; STR1, STR2 : STRING) IS
-           BEGIN
-                IF A'LAST /= 1 THEN
-                     FAILED ( "INCORRECT UPPER BOUND FOR " & STR1 );
-                END IF;
- 
-                IF A (1) /= 2 THEN
-                     FAILED ( "INCORRECT INITIAL VALUE FOR " & STR1 );
-                END IF;
- 
-                IF B'LAST /= 3 THEN
-                     FAILED ( "INCORRECT UPPER BOUND FOR " & STR2 );
-                END IF;
- 
-                BEGIN
-                     IF B (1 .. 3) = (4, 5, 6) THEN
-                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
-                                    "(4, 5, 6)" );
-                     ELSIF B (1 .. 3) = (5, 4, 6) THEN
-                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
-                                    "(5, 4, 6)" );
-                     ELSIF B (1 .. 3) = (4, 6, 5) THEN
-                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
-                                    "(4, 6, 5)" );
-                     ELSIF B (1 .. 3) = (6, 4, 5) THEN
-                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
-                                    "(6, 4, 5)" );
-                     ELSIF B (1 .. 3) = (6, 5, 4) THEN
-                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
-                                    "(6, 5, 4)" );
-                     ELSIF B (1 .. 3) = (5, 6, 4) THEN
-                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
-                                    "(5, 6, 4)" );
-                     ELSE
-                          FAILED ( STR2 & " HAS INCORRECT INITIAL " &
-                                   "VALUE" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          FAILED ( "CONSTRAINT_ERROR RAISED - " &
-                                    STR2 );
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED - " &
-                                    STR2 );
-                END;
-           END;
- 
-      BEGIN
-           CHECK (S1, S2, "S1", "S2");
-           CHECK (CS1, CS2, "CS1", "CS2");
-      END;
- 
-      DECLARE
- 
-           S3, S4 : ARRAY (1 .. F (3)) OF ARR (1 .. F (3)) :=
-                    (OTHERS => (OTHERS => F (3)));
- 
-           CS3, CS4 : CONSTANT ARRAY (1.. F (4)) OF
-                      ARR (1 .. F (4)) :=
-                      (OTHERS => (OTHERS => F (4)));
-      BEGIN
-           IF S3'LAST = 1 THEN
-                IF S3 (1)'LAST = 2 THEN
-                     COMMENT ( "S3 HAS BOUNDS 1 .. 1 AND " &
-                               "COMPONENT TYPE ARR (1 .. 2)" );
-                     IF S3 (1)(1 .. 2) = (3, 4) THEN
-                          COMMENT ( "S3 HAS INITIAL VALUES " &
-                                    "3 AND 4 - 1" );
-                     ELSIF S3 (1)(1 .. 2) = (4, 3) THEN
-                          COMMENT ( "S3 HAS INITIAL VALUES " &
-                                    "4 AND 3 - 1" );
-                     ELSE
-                          FAILED ( "S3 HAS WRONG INITIAL VALUES - 1" );
-                     END IF;
-                ELSE
-                     FAILED ( "S3 HAS WRONG COMPONENT TYPE - 1" );
-                END IF;
-           ELSIF S3'LAST = 2 THEN
-                IF S3 (1)'LAST = 1 THEN
-                     COMMENT ( "S3 HAS BOUNDS 1 .. 2 AND " &
-                               "COMPONENT TYPE ARR (1 .. 1)" );
-                     IF S3 (1) (1) = 3 AND S3 (2) (1) = 4 THEN
-                          COMMENT ( "S3 HAS INITIAL VALUES " &
-                                    "3 AND 4 - 2" );
-                     ELSIF S3 (1) (1) = 4 AND S3 (2) (1) = 3 THEN
-                          COMMENT ( "S3 HAS INITIAL VALUES " &
-                                    "4 AND 3 - 2" );
-                     ELSE
-                          FAILED ( "S3 HAS WRONG INITIAL VALUES - 2" );
-                     END IF;
-                ELSE
-                     FAILED ( "S3 HAS WRONG COMPONENT TYPE - 2" );
-                END IF;
-           ELSE
-                FAILED ( "S3 HAS INCORRECT BOUNDS" );
-           END IF;
- 
-           IF S4'LAST = 5 THEN
-                IF S4 (1)'LAST = 6 THEN
-                     COMMENT ( "S4 HAS BOUNDS 1 .. 5 AND " &
-                               "COMPONENT TYPE ARR (1 .. 6)" );
-                ELSE
-                     FAILED ( "S4 HAS WRONG COMPONENT TYPE - 1" );
-                END IF;
-           ELSIF S4'LAST = 6 THEN
-                IF S4 (1)'FIRST = 1 AND S4 (1)'LAST = 5 THEN
-                     COMMENT ( "S4 HAS BOUNDS 1 .. 6 AND " &
-                               "COMPONENT TYPE ARR (1 .. 5)" );
-                ELSE
-                     FAILED ( "S4 HAS WRONG COMPONENT TYPE - 2" );
-                END IF;
-           ELSE
-                FAILED ( "S4 HAS INCORRECT BOUNDS" );
-           END IF;
- 
-           IF BUMP (3) /= 36 THEN
-                FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " &
-                         "TIMES TO INITIALIZE S4" );
-           END IF;
- 
-           IF CS3'FIRST = 1 AND CS3'LAST = 1 THEN
-                IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 2 THEN
-                     COMMENT ( "CS3 HAS BOUNDS 1 .. 1 AND " &
-                               "COMPONENT TYPE ARR (1 .. 2)" );
-                     IF CS3 (1)(1 .. 2) = (3, 4) THEN
-                          COMMENT ( "CS3 HAS INITIAL VALUES " &
-                                    "3 AND 4 - 1" );
-                     ELSIF CS3 (1)(1 .. 2) = (4, 3) THEN
-                          COMMENT ( "CS3 HAS INITIAL VALUES " &
-                                    "4 AND 3 - 1" );
-                     ELSE
-                          FAILED ( "CS3 HAS WRONG INITIAL VALUES - 1" );
-                     END IF;
-                ELSE
-                     FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 1" );
-                END IF;
-           ELSIF CS3'FIRST = 1 AND CS3'LAST = 2 THEN
-                IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 1 THEN
-                     COMMENT ( "CS3 HAS BOUNDS 1 .. 2 AND " &
-                               "COMPONENT TYPE ARR (1 .. 1)" );
-                     IF CS3 (1) (1) = 3 AND CS3 (2) (1) = 4 THEN
-                          COMMENT ( "CS3 HAS INITIAL VALUES " &
-                                    "3 AND 4 - 2" );
-                     ELSIF CS3 (1) (1) = 4 AND CS3 (2) (1) = 3 THEN
-                          COMMENT ( "CS3 HAS INITIAL VALUES " &
-                                    "4 AND 3 - 2" );
-                     ELSE
-                          FAILED ( "CS3 HAS WRONG INITIAL VALUES - 2" );
-                     END IF;
-                ELSE
-                     FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 2" );
-                END IF;
-           ELSE
-                FAILED ( "CS3 HAS INCORRECT BOUNDS" );
-           END IF;
- 
-           IF CS4'FIRST = 1 AND CS4'LAST = 5 THEN
-                IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 6 THEN
-                     COMMENT ( "CS4 HAS BOUNDS 1 .. 5 AND " &
-                               "COMPONENT TYPE ARR (1 .. 6)" );
-                ELSE
-                     FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 1" );
-                END IF;
-           ELSIF CS4'FIRST = 1 AND CS4'LAST = 6 THEN
-                IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 5 THEN
-                     COMMENT ( "CS4 HAS BOUNDS 1 .. 6 AND " &
-                               "COMPONENT TYPE ARR (1 .. 5)" );
-                ELSE
-                     FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 2" );
-                END IF;
-           ELSE
-                FAILED ( "CS4 HAS INCORRECT BOUNDS" );
-           END IF;
- 
-           IF BUMP (4) /= 36 THEN
-                FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " &
-                         "TIMES TO INITIALIZE CS4" );
-           END IF;
-      END;
- 
-      RESULT;
- END C32001B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C32001C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR RECORD TYPES, THE 
- -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
- -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
- -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
- -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
- 
- -- RJW 7/16/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32001C IS
- 
-      TYPE ARR IS ARRAY (1 .. 2) OF INTEGER;
-      F1, G1 : ARR;
-      BUMP : ARR := (0, 0);
- 
-      FUNCTION F (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP(I) + 1;
-           F1 (I) := BUMP (I);
-           RETURN BUMP (I);
-      END F;
- 
-      FUNCTION G (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP(I) + 1;
-           G1 (I) := BUMP (I);
-           RETURN BUMP (I);
-      END G;
- 
-      FUNCTION H (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP(I) + 1;
-           RETURN BUMP (I);
-      END H;
- 
- BEGIN
-      TEST ("C32001C", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 
-                       "FOR RECORD TYPES, THE SUBTYPE INDICATION " & 
-                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
-                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
-                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
-                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
-                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
-                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
-      
-      DECLARE
- 
-           TYPE REC (D1, D2 : INTEGER) IS
-                RECORD 
-                     VALUE : INTEGER;
-                END RECORD;
-      
-           R1, R2   : REC (F (1), G (1)) := 
-                      (F1 (1), G1 (1), VALUE => H (1));
-           CR1, CR2 : CONSTANT REC (F (2), G (2)) := 
-                      (F1 (2), G1 (2), VALUE => H (2));
-           
-           PROCEDURE CHECK 
-             (R : REC; V1, V2, VAL : INTEGER; S : STRING) IS
-           BEGIN          
-                IF R.D1 = V1 THEN
-                     IF R.D2 = V2 THEN
-                          COMMENT ( S & ".D1 INITIALIZED TO " & 
-                                    INTEGER'IMAGE (V1) & " AND " &
-                                    S & ".D2 INITIALIZED TO " &
-                                    INTEGER'IMAGE (V2));
-                     ELSE
-                          FAILED ( S & 
-                                   ".D2 INITIALIZED INCORRECTLY - 1" );
-                     END IF;
-                ELSIF R.D1 = V2 THEN
-                     IF R.D2 =V1 THEN
-                          COMMENT ( S & ".D1 INITIALIZED TO " & 
-                                    INTEGER'IMAGE (V2) & " AND " &
-                                    S & ".D2 INITIALIZED TO " &
-                                    INTEGER'IMAGE (V1));
-                     ELSE
-                          FAILED ( S & 
-                                   ".D2 INITIALIZED INCORRECTLY - 2" );
-                     END IF;
-                ELSE
-                     FAILED ( S & ".D1 INITIALIZED INCORRECTLY TO " &
-                               INTEGER'IMAGE (R.D1) );
-                END IF;
-                
-                IF R.VALUE /= VAL THEN
-                     FAILED ( S & ".VALUE INITIALIZED INCORRECTLY" );
-                END IF;
-           END CHECK;
-      
-      BEGIN     
-           CHECK (R1, 1, 2, 3, "R1");
-           CHECK (R2, 4, 5, 6, "R2");
- 
-           CHECK (CR1, 1, 2, 3, "CR1");
-           CHECK (CR2, 4, 5, 6, "CR2");
-      END;     
- 
-      RESULT;
- END C32001C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C32001D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ACCESS TYPES, THE 
- -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
- -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
- -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
- -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
- 
- -- RJW 7/16/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32001D IS
- 
-      TYPE ARR IS ARRAY (1 .. 2) OF INTEGER;
-      BUMP : ARR := (0, 0);
-      F1 : ARR;
- 
-      FUNCTION F (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP (I) + 1;
-           F1 (I) := BUMP (I);
-           RETURN BUMP (I);
-      END F;
- 
-      FUNCTION G (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP (I) + 1;
-           RETURN BUMP (I);
-      END G;
- 
- BEGIN
-      TEST ("C32001D", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 
-                       "FOR ACCESS TYPES, THE SUBTYPE INDICATION " & 
-                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
-                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
-                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
-                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
-                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
-                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
-      
-      DECLARE
-      
-           TYPE CELL (SIZE : INTEGER) IS
-                RECORD
-                     VALUE : INTEGER;
-                END RECORD;
- 
-           TYPE LINK IS ACCESS CELL;
- 
-           L1, L2   : LINK (F (1)) := NEW CELL'(F1 (1), G (1));
- 
-           CL1, CL2 : CONSTANT LINK (F (2)) := NEW CELL'(F1 (2), G (2));
-           
-           PROCEDURE CHECK (L : LINK; V1, V2 : INTEGER; S : STRING) IS
-           BEGIN
-                IF L.SIZE /= V1 THEN
-                     FAILED ( S & ".SIZE INITIALIZED INCORRECTLY TO " &
-                              INTEGER'IMAGE (L.SIZE));
-                END IF;
- 
-                IF L.VALUE /= V2 THEN
-                     FAILED ( S & ".VALUE INITIALIZED INCORRECTLY TO " &
-                              INTEGER'IMAGE (L.VALUE));
-                END IF;
-           END CHECK;
- 
-      BEGIN
-           CHECK (L1, 1, 2, "L1");
-           CHECK (L2, 3, 4, "L2");
- 
-           CHECK (CL1, 1, 2, "CL1");
-           CHECK (CL2, 3, 4, "CL2");
-      END;
- 
-      RESULT;
- END C32001D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32001e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32001e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,253 ****
- -- C32001E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR PRIVATE TYPES, THE 
- -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
- -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
- -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
- -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
- 
- -- RJW 7/18/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32001E IS
- 
-      BUMP : ARRAY (1 .. 10) OF INTEGER := (OTHERS => 0);
-      G1 : ARRAY (5 .. 6) OF INTEGER;
- 
-      FUNCTION F (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP (I) + 1;
-           RETURN BUMP (I);
-      END F;
- 
-      FUNCTION G (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BUMP (I) := BUMP (I) + 1;
-           G1 (I) := BUMP (I);
-           RETURN BUMP (I);
-      END G;
- 
- BEGIN
-      TEST ("C32001E", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 
-                       "FOR PRIVATE TYPES, THE SUBTYPE INDICATION " & 
-                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
-                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
-                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
-                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
-                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
-                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
-      
-      DECLARE
-           PACKAGE PKG1 IS
-                TYPE PBOOL IS PRIVATE;
-                TYPE PINT IS PRIVATE;
-                TYPE PREC (D : INTEGER) IS PRIVATE;
-                TYPE PARR IS PRIVATE;
-                TYPE PACC IS PRIVATE;
-                
-                FUNCTION INIT1 (I : INTEGER) RETURN PBOOL;
-                FUNCTION INIT2 (I : INTEGER) RETURN PINT;
-                FUNCTION INIT3 (I : INTEGER) RETURN PREC;
-                FUNCTION INIT4 (I : INTEGER) RETURN PARR;
-                FUNCTION INIT5 (I : INTEGER) RETURN PACC;
- 
-                PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING);
-                PROCEDURE CHECK2 (I : PINT;  J : INTEGER; S : STRING);
-                PROCEDURE CHECK3 (R : PREC;  I, J : INTEGER; 
-                                  S : STRING);
-                PROCEDURE CHECK4 (A : PARR;  I, J : INTEGER; 
-                                  S : STRING);
-                PROCEDURE CHECK5 (V : PACC; S : STRING);
-                PROCEDURE CHECK6 (V : PACC; S : STRING);
- 
-           PRIVATE
-                TYPE PBOOL IS NEW BOOLEAN;
-                TYPE PINT IS NEW INTEGER;
- 
-                TYPE PREC (D : INTEGER) IS 
-                     RECORD 
-                          VALUE : INTEGER;
-                     END RECORD;
- 
-                TYPE PARR IS ARRAY (1 .. 2) OF INTEGER;
- 
-                TYPE VECTOR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
-                TYPE PACC IS ACCESS VECTOR;
-           END PKG1;
- 
-           PACKAGE BODY PKG1 IS
-                FUNCTION INIT1 (I : INTEGER) RETURN PBOOL IS
-                BEGIN
-                     RETURN PBOOL'VAL (F (I) - 1);
-                END INIT1;
- 
-                FUNCTION INIT2 (I : INTEGER) RETURN PINT IS
-                BEGIN
-                     RETURN PINT'VAL (F (I));
-                END INIT2;
- 
-                FUNCTION INIT3 (I : INTEGER) RETURN PREC IS
-                     PR : PREC (G1 (I)) := (G1 (I), F (I));
-                BEGIN
-                     RETURN PR;
-                END INIT3;
- 
-                FUNCTION INIT4 (I : INTEGER) RETURN PARR IS
-                     PA : PARR := (1 .. 2 => F (I));
-                BEGIN
-                     RETURN PA;
-                END INIT4;
- 
-                FUNCTION INIT5 (I : INTEGER) RETURN PACC IS
-                     ACCV : PACC := NEW VECTOR'(1 .. F (I) => F (I));
-                BEGIN
-                     RETURN ACCV;
-                END INIT5;
- 
-                PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING) IS
-                BEGIN
-                     IF B /= PBOOL'VAL (I) THEN 
-                          FAILED ( S & " HAS AN INCORRECT VALUE OF " &
-                                   PBOOL'IMAGE (B));
-                     END IF;
-                END CHECK1;
- 
-                PROCEDURE CHECK2 (I : PINT; J : INTEGER; S : STRING) IS 
-                BEGIN
-                     IF I /= PINT'VAL (J) THEN 
-                          FAILED ( S & " HAS AN INCORRECT VALUE OF " &
-                                   PINT'IMAGE (I));
-                     END IF;
-                END CHECK2;
- 
-                PROCEDURE CHECK3 (R : PREC; I, J : INTEGER; 
-                                  S : STRING) IS
-                BEGIN
-                     IF R.D /= I THEN 
-                          FAILED ( S & ".D HAS AN INCORRECT VALUE OF " 
-                                   & INTEGER'IMAGE (R.D));
-                     END IF;
- 
-                     IF R.VALUE /= J THEN
-                          FAILED ( S & ".VALUE HAS AN INCORRECT " &
-                                   "VALUE OF " & 
-                                   INTEGER'IMAGE (R.VALUE));
-                     END IF;
-                END CHECK3;
- 
-                PROCEDURE CHECK4 (A : PARR; I, J : INTEGER; 
-                                  S : STRING) IS
-                BEGIN
-                     IF A /= (I, J) AND A /= (J, I) THEN
-                          FAILED ( S & " HAS AN INCORRECT VALUE" );
-                     END IF;
-                END CHECK4;
- 
-                PROCEDURE CHECK5 (V : PACC; S : STRING) IS
-                BEGIN
-                     IF V'LAST /= 1 THEN
-                          FAILED ( S & " HAS AN INCORRECT UPPER BOUND " 
-                                   & "OF " & INTEGER'IMAGE (V'LAST));
-                     END IF;
- 
-                     IF V (1) /= 2 THEN 
-                          FAILED ( S & " HAS AN INCORRECT COMPONENT " &
-                                   "VALUE" );
-                     END IF;
-                END CHECK5;
-                
-                PROCEDURE CHECK6 (V : PACC; S : STRING) IS
-                BEGIN
-                     IF V'LAST /= 3 THEN
-                          FAILED ( S & " HAS AN INCORRECT UPPER BOUND " 
-                                   & "OF " & INTEGER'IMAGE (V'LAST));
-                     END IF;
- 
-                     IF V.ALL = (4, 5, 6) OR V.ALL = (5, 4, 6) OR 
-                        V.ALL = (4, 6, 5) OR V.ALL = (6, 4, 5) OR
-                        V.ALL = (5, 6, 4) OR V.ALL = (6, 5, 4) THEN
-                          NULL;
-                     ELSE
-                          FAILED ( S & " HAS AN INCORRECT COMPONENT " &
-                                   "VALUE" );
-                     END IF;
-                END CHECK6;
- 
-           END PKG1;
-           
-           PACKAGE PKG2 IS END PKG2;
-      
-           PACKAGE BODY PKG2 IS
-                USE PKG1;
- 
-                B1, B2   : PBOOL := INIT1 (1);
-                CB1, CB2 : CONSTANT PBOOL := INIT1 (2);
-             
-                I1, I2   : PINT := INIT2 (3);
-                CI1, CI2 : CONSTANT PINT := INIT2 (4);
- 
-                R1, R2   : PREC (G (5)) := INIT3 (5);
-                CR1, CR2 : CONSTANT PREC (G (6)) := INIT3 (6);
- 
-                A1, A2   : PARR := INIT4 (7);
-                CA1, CA2 : CONSTANT PARR := INIT4 (8);
- 
-                V1, V2   : PACC  := INIT5 (9);
-                CV1, CV2 : CONSTANT PACC  := INIT5 (10);
- 
-           BEGIN
-                CHECK1 (B1, 0, "B1");
-                CHECK1 (B2, 1, "B2");
-                CHECK1 (CB1, 0, "CB1");
-                CHECK1 (CB2, 1, "CB2");
- 
-                CHECK2 (I1, 1, "I1");
-                CHECK2 (I2, 2, "I2");
-                CHECK2 (CI1, 1, "CI1");
-                CHECK2 (CI2, 2, "CI2");
- 
-                CHECK3 (R1, 1, 2, "R1");
-                CHECK3 (R2, 3, 4, "R2");
-                CHECK3 (CR1, 1, 2, "CR1");
-                CHECK3 (CR2, 3, 4, "CR2");
- 
-                CHECK4 (A1, 1, 2, "A1");
-                CHECK4 (A2, 3, 4, "A2");
-                CHECK4 (CA1, 1, 2, "CA1");
-                CHECK4 (CA2, 3, 4, "CA2");
- 
-                CHECK5 (V1, "V1");
-                CHECK6 (V2, "V2");
-                CHECK5 (CV1, "CV1");
-                CHECK6 (CV2, "CV2");
-       END PKG2;
- 
-      BEGIN
-           NULL;          
-      END;
- 
-      RESULT;
- END C32001E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32107a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32107a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32107a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,363 ****
- -- C32107A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OBJECT DECLARATIONS ARE ELABORATED IN THE ORDER OF THEIR 
- -- OCCURRENCE, I.E., THAT EXPRESSIONS ASSOCIATED WITH ONE DECLARATION
- -- (INCLUDING DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE EVALUATED BEFORE
- -- ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. ALSO, CHECK THAT
- -- EXPRESSIONS IN THE SUBTYPE INDICATION OR THE CONSTRAINED ARRAY 
- -- DEFINITION ARE EVALUATED BEFORE ANY INITIALIZATION EXPRESSIONS ARE
- -- EVALUATED.
- 
- -- R.WILLIAMS 9/24/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C32107A IS
- 
-      BUMP : INTEGER := 0;
- 
-      ORDER_CHECK : INTEGER;
- 
-      G1, H1, I1 : INTEGER;
- 
-      FIRST_CALL : BOOLEAN := TRUE;
- 
-      TYPE ARR1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
- 
-      TYPE ARR1_NAME IS ACCESS ARR1;
- 
-      TYPE ARR2 IS ARRAY (POSITIVE RANGE <>, POSITIVE RANGE <>) OF 
-           INTEGER;
- 
-      TYPE REC (D : INTEGER) IS
-           RECORD
-                COMP : INTEGER;
-           END RECORD;          
- 
-      TYPE REC_NAME IS ACCESS REC;
- 
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN BUMP;
-      END F;
- 
-      FUNCTION G RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           G1 := BUMP;
-           RETURN BUMP;
-      END G;
-      
-      FUNCTION H RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           H1 := BUMP;
-           RETURN BUMP;
-      END H;
-      
-      FUNCTION I RETURN INTEGER IS
-      BEGIN
-           IF FIRST_CALL THEN
-                BUMP := BUMP + 1;
-                I1 := BUMP;
-                FIRST_CALL := FALSE;
-           END IF;
-           RETURN I1;
-      END I;
- 
- BEGIN
-      TEST ( "C32107A", "CHECK THAT OBJECT DECLARATIONS ARE " &
-                        "ELABORATED IN THE ORDER OF THEIR " &
-                        "OCCURRENCE, I.E., THAT EXPRESSIONS " &
-                        "ASSOCIATED WITH ONE DECLARATION (INCLUDING " &
-                        "DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE " &
-                        "EVALUATED BEFORE ANY EXPRESSION BELONGING " &
-                        "TO THE NEXT DECLARATION.  ALSO, CHECK THAT " &
-                        "EXPRESSIONS IN THE SUBTYPE INDICATION OR " &
-                        "THE CONSTRAINED ARRAY DEFINITION ARE " &
-                        "EVALUATED BEFORE ANY INITIALIZATION " &
-                        "EXPRESSIONS ARE EVALUATED" );
-      
-      DECLARE -- (A).
-           I1 : INTEGER := 10000 * F;
-           A1 : CONSTANT ARRAY (1 .. H) OF REC (G * 100) :=
-                (1 .. H1 => (G1 * 100, I * 10));
-           I2 : CONSTANT INTEGER := F * 1000;
-      BEGIN
-           ORDER_CHECK := I1 + I2 + A1'LAST + A1 (1).D + A1 (1).COMP;
-           IF ORDER_CHECK = 15243 OR ORDER_CHECK = 15342 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 15343 OR " &
-                         "15242 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
-           END IF;
-      END; -- (A).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (B).
-           A : ARR2 (1 .. F, 1 .. F * 10);
-           R : REC (G * 100) := (G1 * 100, F * 1000);
-           I : INTEGER RANGE 1 .. H;
-           S : REC (F * 10);               
-      BEGIN
-           ORDER_CHECK := 
-                A'LAST (1) + A'LAST (2) + R.D + R.COMP; 
-           IF (H1 + S.D = 65) AND 
-              (ORDER_CHECK = 4321 OR ORDER_CHECK = 4312) THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE 65 " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 65 4321 OR " &
-                         "65 4312 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (H1 + S.D) &
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
-           END IF;
-      END; -- (B).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (C).
-           I1 : CONSTANT INTEGER RANGE 1 .. G * 10 := F;
-           A1 : ARRAY (1 .. F * 100) OF INTEGER RANGE 1 .. H * 1000;
-      BEGIN
-           ORDER_CHECK := I1 + (G1 * 10) + A1'LAST + (H1 * 1000);
-           IF ORDER_CHECK = 4312 OR ORDER_CHECK = 3412 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 4312 OR " &
-                         "3412 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
-           END IF;
-      END; -- (C).         
- 
-      BUMP := 0;
-      FIRST_CALL := TRUE;
- 
-      DECLARE -- (D).
-           A1 : ARRAY (1 .. G) OF REC (H * 10000) := 
-                (1 .. G1 => (H1 * 10000, I * 100));
-           R1 : CONSTANT REC := (F * 1000, F * 10);
- 
-      BEGIN
-           ORDER_CHECK := 
-                A1'LAST + A1 (1).D + A1 (1).COMP + R1.D + R1.COMP;
-           IF ORDER_CHECK = 25341 OR ORDER_CHECK = 24351 OR
-              ORDER_CHECK = 15342 OR ORDER_CHECK = 14352 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 25341, " &
-                         "24351, 15342 OR 14352  -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
-           END IF;
-      END; -- (D).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (E).
-           A1 : CONSTANT ARR1_NAME := NEW ARR1' (1 .. F => F * 10);
-           R1 : REC_NAME (H * 100) := NEW REC'(H1 * 100, F * 1000);
- 
-      BEGIN
-           ORDER_CHECK := A1.ALL'LAST + A1.ALL (1) + R1.D + R1.COMP;
-           IF ORDER_CHECK /= 4321 THEN
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 4321 " &
-                         "-- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (E)" );
-           END IF;
-      END; -- (E).         
- 
-      BUMP := 0;
-      FIRST_CALL := TRUE;
- 
-      DECLARE -- (F).
-           A1 : CONSTANT ARRAY (1 .. G) OF INTEGER RANGE 1 .. H * 100 :=
-                (1 .. G1 => I * 10);
-           A2 : ARR1 (1 .. F * 1000);
-      BEGIN
-           ORDER_CHECK := 
-                A1'LAST + (H1 * 100) + A1 (1) + A2'LAST;
-           IF ORDER_CHECK = 4231 OR ORDER_CHECK = 4132 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 4231 OR " &
-                         "4132 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
-           END IF;
-      END; -- (F).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (G).
-           A1 : ARR1_NAME (1 .. G) := NEW ARR1 (1 .. G1);
-           R1 : CONSTANT REC_NAME (H * 10) := 
-                NEW REC'(H1 * 10, F * 100);
-      BEGIN
-           ORDER_CHECK := A1.ALL'LAST + R1.D + R1.COMP;
-           IF ORDER_CHECK /= 321 THEN
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 321 OR " &
-                         "-- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (G)" );
-           END IF;
-      END; -- (G).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (H). 
-           TYPE REC (D : INTEGER := F) IS
-                RECORD
-                     COMP : INTEGER := F * 10;
-                END RECORD;
- 
-           R1 : REC;
-           R2 : REC (G * 100) := (G1 * 100, F * 1000);
-      BEGIN
-           ORDER_CHECK := R1.D + R1.COMP + R2.D + R2.COMP;
-           IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
-              ORDER_CHECK = 3421 OR ORDER_CHECK = 3412 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
-                         "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
-           END IF;
-      END; -- (H).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (I).
-           TYPE REC2 (D1, D2 : INTEGER) IS
-                RECORD
-                     COMP : INTEGER;
-                END RECORD;
- 
-           R1 : REC2 (G  * 1000, H  * 10000) := 
-                     (G1 * 1000, H1 * 10000, F * 100);
-           R2 : REC2 (F, F * 10);
-      BEGIN
-           ORDER_CHECK := R1.D1 + R1.D2 + R1.COMP + R2.D1 + R2.D2;
-           IF ORDER_CHECK = 21354 OR ORDER_CHECK = 21345 OR
-              ORDER_CHECK = 12345 OR ORDER_CHECK = 12354 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 21354, " &
-                         "21345, 12354, OR 12345 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
-           END IF;
- 
-      END; -- (I).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (J).
-           PACKAGE P IS 
-                TYPE PRIV (D : INTEGER) IS PRIVATE;
- 
-                P1 : CONSTANT PRIV;
-                P2 : CONSTANT PRIV;          
- 
-                FUNCTION GET_A (P : PRIV) RETURN INTEGER;
-           PRIVATE
-                TYPE PRIV (D : INTEGER) IS
-                     RECORD
-                          COMP : INTEGER;
-                     END RECORD;
-                P1 : CONSTANT PRIV := (F , F * 10);
-                P2 : CONSTANT PRIV := (F * 100, F * 1000);
-           END P;
-                     
-           PACKAGE BODY P IS
-                FUNCTION GET_A (P : PRIV) RETURN INTEGER IS
-                BEGIN
-                     RETURN P.COMP;
-                END GET_A;
-           END P;
-           
-           USE P;
-      BEGIN
-           ORDER_CHECK := P1.D + GET_A (P1) + P2.D + GET_A (P2);
-           IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
-              ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
-                         "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
-           END IF;
-      END; -- (J).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (K).
-           PACKAGE P IS 
-                TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE;
- 
-           PRIVATE
-                TYPE PRIV (D1, D2 : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END P;
-           
-           USE P;
- 
-           P1 : PRIV (F, F * 10);
-           P2 : PRIV (F * 100, F * 1000);
- 
-      BEGIN
-           ORDER_CHECK := P1.D1 + P1.D2 + P2.D1 + P2.D2;
-           IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
-              ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
-                COMMENT ( "ORDER_CHECK HAS VALUE " &
-                           INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
-           ELSE
-                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
-                         "VALUE OF ORDER_CHECK SHOULD BE 4321, 4312, " &
-                         "3421, OR 3412 -- ACTUAL VALUE IS " & 
-                          INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
-           END IF;
- 
-      END; -- (K).         
- 
-      RESULT;
- END C32107A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32107c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32107c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32107c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32107c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C32107C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR OBJECTS OF A GENERIC FORMAL TYPE WHOSE ACTUAL PARAMETER IS A 
- -- TYPE WITH DEFAULT VALUES, CHECK THAT OBJECT DECLARATIONS ARE 
- -- ELABORATED IN THE ORDER OF THEIR OCCURRENCE, I.E., THAT EXPRESSIONS 
- -- ASSOCIATED WITH ONE DECLARATION (INCLUDING DEFAULT EXPRESSIONS) ARE 
- -- EVALUATED BEFORE ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. 
- 
- -- R.WILLIAMS 9/24/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C32107C IS
- 
-      BUMP : INTEGER := 0;
- 
-      G1, H1 : INTEGER;
- 
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN BUMP;
-      END F;
- 
-      FUNCTION G RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           G1 := BUMP;
-           RETURN BUMP;
-      END G;
-      
-      FUNCTION H RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           H1 := BUMP;
-           RETURN BUMP;
-      END H;
-      
- BEGIN
-      TEST ( "C32107C", "FOR OBJECTS OF A GENERIC FORMAL TYPE WHOSE " &
-                        "ACTUAL PARAMETER IS A TYPE WITH DEFAULT " &
-                        "VALUES, CHECK THAT OBJECT DECLARATIONS ARE " &
-                        "ELABORATED IN THE ORDER OF THEIR " &
-                        "OCCURRENCE, I.E., THAT EXPRESSIONS " &
-                        "ASSOCIATED WITH ONE DECLARATION (INCLUDING " &
-                        "DEFAULT EXPRESSIONS) ARE EVALUATED BEFORE " &
-                        "ANY EXPRESSION BELONGING TO THE NEXT " &
-                        "DECLARATION" );
- 
-      DECLARE -- (A).
-           TYPE REC (D : INTEGER := F) IS
-                RECORD
-                     A : INTEGER := F;
-                END RECORD;
- 
-           FUNCTION GET_A (R : REC) RETURN INTEGER IS
-           BEGIN
-                RETURN R.A;
-           END GET_A;
- 
-           GENERIC
-                TYPE T IS (<>);
-                TYPE PRIV (D : T) IS PRIVATE;
-                WITH FUNCTION GET_A (P : PRIV) RETURN INTEGER IS <>;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                P1 : PRIV (T'VAL (F));
-                P2 : PRIV (T'VAL (F * 100));
-                ORDER_CHECK : INTEGER;
-                
-           BEGIN
-                ORDER_CHECK := 
-                     T'POS (P1.D) + T'POS (P2.D) + 
-                     (GET_A (P1) * 10) + (GET_A (P2) * 1000);
-                IF ORDER_CHECK /= 4321 THEN
-                     FAILED ( "OBJECTS NOT ELABORATED IN PROPER " &
-                              "ORDER VALUE OF ORDER_CHECK SHOULD BE " &
-                              "4321 -- ACTUAL VALUE IS " & 
-                               INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
-                END IF;
-           END P;
-           
-           PROCEDURE PROC IS NEW P (INTEGER, REC);
- 
-      BEGIN
-           PROC;
-      END; -- (A).         
- 
-      BUMP := 0;
- 
-      DECLARE -- (B).
-           TYPE REC (D1 : INTEGER := F; D2 : INTEGER := F) IS
-                RECORD
-                     A : INTEGER := F;
-                END RECORD;
- 
-           FUNCTION GET_A (R : REC) RETURN INTEGER IS
-           BEGIN
-                RETURN R.A;
-           END GET_A;
- 
-           GENERIC
-                TYPE T IS (<>);
-                TYPE PRIV (D1 : T; D2 : T) IS PRIVATE;
-                WITH FUNCTION GET_A (P : PRIV) RETURN INTEGER IS <>;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                P1 : PRIV (T'VAL (F * 1000), T'VAL (F * 10000));
-                P2 : PRIV (T'VAL (F), T'VAL (F * 10));
-                ORDER_CHECK : INTEGER;
-                
-           BEGIN
-                ORDER_CHECK := 
-                T'POS (P1.D1) + T'POS (P1.D2) + 
-                T'POS (P2.D1) + T'POS (P2.D2) + 
-                (GET_A (P1) * 100);
-                IF (GET_A (P2) = 6) AND 
-                   (ORDER_CHECK = 12345 OR ORDER_CHECK = 21345 OR
-                    ORDER_CHECK = 21354 OR ORDER_CHECK = 12354) THEN
-                     COMMENT ( "ORDER_CHECK HAS VALUE " &
-                                INTEGER'IMAGE (ORDER_CHECK) & 
-                               " - (B)" );
-                ELSE
-                     FAILED ( "OBJECTS NOT ELABORATED IN PROPER " &
-                              "ORDER VALUE OF ORDER_CHECK SHOULD BE " &
-                              "6 12345, 6 21345, 6 21354, OR " &
-                              "6 12354 -- ACTUAL VALUE IS " &
-                               INTEGER'IMAGE (GET_A (P2)) &
-                               INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
-                END IF;
- 
-           END P;
-           
-           PROCEDURE PROC IS NEW P (INTEGER, REC);
- 
-      BEGIN
-           PROC;
-      END; -- (B).         
- 
-      RESULT;
- END C32107C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32108a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32108a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32108a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- C32108A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DEFAULT EXPRESSIONS ARE NOT EVALUATED, IF INITIALIZATION
- -- EXPRESSIONS ARE GIVEN FOR THE OBJECT DECLARATIONS.
- 
- -- TBN 3/20/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C32108A IS
- 
-      FUNCTION DEFAULT_CHECK (NUMBER : INTEGER) RETURN INTEGER IS
-      BEGIN
-           IF NUMBER /= 0 THEN
-                FAILED ("DEFAULT EXPRESSIONS ARE EVALUATED -" &
-                        INTEGER'IMAGE (NUMBER));
-           END IF;
-           RETURN (1);
-      END DEFAULT_CHECK;
- 
- BEGIN
-      TEST ("C32108A", "CHECK THAT DEFAULT EXPRESSIONS ARE NOT " &
-                       "EVALUATED, IF INITIALIZATION EXPRESSIONS ARE " &
-                       "GIVEN FOR THE OBJECT DECLARATIONS");
- 
-      DECLARE     -- (A)
- 
-           TYPE REC_TYP1 IS
-                RECORD
-                     AGE : INTEGER := DEFAULT_CHECK (1);
-                END RECORD;
- 
-           REC1 : REC_TYP1 := (AGE => DEFAULT_CHECK (0));
- 
- 
-           TYPE REC_TYP2 (D : INTEGER := DEFAULT_CHECK (2)) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           REC2 : REC_TYP2 (DEFAULT_CHECK (0));
- 
- 
-           TYPE REC_TYP3 (D : INTEGER := DEFAULT_CHECK (3)) IS
-                RECORD
-                     A : INTEGER := DEFAULT_CHECK (4);
-                END RECORD;
- 
-           REC3 : REC_TYP3 := (D => DEFAULT_CHECK (0),
-                               A => DEFAULT_CHECK (0));
- 
-      BEGIN     -- (A)
-           NULL;
-      END;      -- (A)
- 
-      RESULT;
- END C32108A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32108b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32108b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32108b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C32108B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A DEFAULT EXPRESSION IS EVALUATED FOR A COMPONENT, NO
- -- DEFAULT EXPRESSIONS ARE EVALUATED FOR ANY SUBCOMPONENTS.
- 
- -- TBN 3/21/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C32108B IS
- 
-      FUNCTION DEFAULT_CHECK (NUMBER : INTEGER) RETURN INTEGER IS
-      BEGIN
-           IF NUMBER /= 0 THEN
-                FAILED ("SUBCOMPONENT DEFAULT EXPRESSIONS ARE " &
-                        "EVALUATED -" & INTEGER'IMAGE (NUMBER));
-           END IF;
-           RETURN (1);
-      END DEFAULT_CHECK;
- 
- BEGIN
-      TEST ("C32108B", "CHECK THAT IF A DEFAULT EXPRESSION IS " &
-                       "EVALUATED FOR A COMPONENT, NO DEFAULT " &
-                       "EXPRESSIONS ARE EVALUATED FOR ANY " &
-                       "SUBCOMPONENTS");
- 
-      DECLARE     -- (A)
- 
-           TYPE REC_TYP1 IS
-                RECORD
-                     AGE : INTEGER := DEFAULT_CHECK (1);
-                END RECORD;
- 
-           TYPE REC_TYP2 (D : INTEGER := DEFAULT_CHECK(2)) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE REC_TYP3 (D : INTEGER := DEFAULT_CHECK(3)) IS
-                RECORD
-                     A : INTEGER := DEFAULT_CHECK(4);
-                END RECORD;
- 
-           TYPE REC_TYP4 IS
-                RECORD
-                     ONE : REC_TYP1 := (AGE => DEFAULT_CHECK (0));
-                     TWO : REC_TYP2 (DEFAULT_CHECK(0));
-                     THREE : REC_TYP3 := (D => DEFAULT_CHECK (0),
-                                          A => DEFAULT_CHECK (0));
-                END RECORD;
- 
-           REC4 : REC_TYP4;
- 
-      BEGIN     -- (A)
-           NULL;
-      END;      -- (A)
- 
-      RESULT;
- END C32108B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32111a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32111a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32111a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32111a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,282 ****
- -- C32111A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- -- CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION,
- --    INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL VALUE,
- --    CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES OUTSIDE THE
- --    RANGE OF THE SUBTYPE.
- 
- -- HISTORY:
- --    RJW 07/20/86  CREATED ORIGINAL TEST.
- --    JET 08/04/87  IMPROVED DEFEAT OF COMPILER OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32111A IS
- 
-      TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI);
-      SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED;
- 
-      SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9';
- 
-      SUBTYPE SHORT IS INTEGER RANGE -100 .. 100;
- 
-      TYPE INT IS RANGE -10 .. 10;
-      SUBTYPE PINT IS INT RANGE 1 .. 10;
- 
-      TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
-      SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0;
- 
-      TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
-      SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0;
- 
- BEGIN
-      TEST ("C32111A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
-                       "HAVING AN ENUMERATION, INTEGER, FLOAT OR " &
-                       "FIXED TYPE IS DECLARED WITH AN INITIAL " &
-                       "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " &
-                       "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " &
-                       "SUBTYPE" );
- 
-      BEGIN
-           DECLARE
-                D : MIDWEEK := WEEKDAY'VAL (IDENT_INT (1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'D'" );
-                IF D = TUES THEN
-                     COMMENT ("VARIABLE 'D' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'D'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                D : CONSTANT WEEKDAY RANGE WED .. WED :=
-                    WEEKDAY'VAL (IDENT_INT (3));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'D'" );
-                IF D = TUES THEN
-                     COMMENT ("INITIALIZE VARIABLE 'D'");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'D'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                P : CONSTANT DIGIT := IDENT_CHAR ('/');
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'P'" );
-                IF P = '0' THEN
-                     COMMENT ("VARIABLE 'P' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'P'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                Q : CHARACTER RANGE 'A' .. 'E' := IDENT_CHAR ('F');
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'Q'" );
-                IF Q = 'A' THEN
-                     COMMENT ("VARIABLE 'Q' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'Q'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                I  :  SHORT := IDENT_INT (-101);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'I'" );
-                IF I = 1 THEN
-                     COMMENT ("VARIABLE 'I' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'I'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                J  : CONSTANT INTEGER RANGE 0 .. 100 := IDENT_INT (101);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'J'" );
-                IF J = -1 THEN
-                     COMMENT ("VARIABLE 'J' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'J'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                K  : INT RANGE 0 .. 1 := INT (IDENT_INT (2));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'K'" );
-                IF K = 2 THEN
-                     COMMENT ("VARIABLE 'K' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'K'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                L  : CONSTANT PINT := INT (IDENT_INT (0));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'L'" );
-                IF L = 1 THEN
-                     COMMENT ("VARIABLE 'L' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'L'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FL : SFLT := FLT (IDENT_INT (1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FL'" );
-                IF FL = 3.14 THEN
-                     COMMENT ("VARIABLE 'FL' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FL'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 :=
-                      FLT (IDENT_INT (-1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FL1'" );
-                IF FL1 = 0.0 THEN
-                     COMMENT ("VARIABLE 'FL1' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FL1'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FI : FIXED RANGE 0.0 .. 0.0 := IDENT_INT (1) * 0.5;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FI'" );
-                IF FI = 0.5 THEN
-                     COMMENT ("VARIABLE 'FI' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FI'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FI1 : CONSTANT SFIXED := IDENT_INT (-1) * 0.5;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FI1'" );
-                IF FI1 = 0.5 THEN
-                     COMMENT ("VARIABLE 'FI1' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FI1'" );
-      END;
- 
-      RESULT;
- END C32111A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32111b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32111b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32111b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32111b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,282 ****
- -- C32111B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- -- CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION,
- --    INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL STATIC
- --    VALUE, CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES
- --    OUTSIDE THE RANGE OF THE SUBTYPE.
- 
- -- HISTORY:
- --    JET 08/04/87  CREATED ORIGINAL TEST BASED ON C32111A BY RJW
- --                  BUT WITH STATIC VALUES INSTEAD OF DYNAMIC
- --                  IDENTITY FUNCTION.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32111B IS
- 
-      TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI);
-      SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED;
- 
-      SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9';
- 
-      SUBTYPE SHORT IS INTEGER RANGE -100 .. 100;
- 
-      TYPE INT IS RANGE -10 .. 10;
-      SUBTYPE PINT IS INT RANGE 1 .. 10;
- 
-      TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
-      SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0;
- 
-      TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
-      SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0;
- 
- BEGIN
-      TEST ("C32111B", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
-                       "HAVING AN ENUMERATION, INTEGER, FLOAT OR " &
-                       "FIXED TYPE IS DECLARED WITH AN INITIAL STATIC " &
-                       "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " &
-                       "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " &
-                       "SUBTYPE" );
- 
-      BEGIN
-           DECLARE
-                D : MIDWEEK := WEEKDAY'VAL (1);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'D'" );
-                IF D = TUES THEN
-                     COMMENT ("VARIABLE 'D' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'D'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                D : CONSTANT WEEKDAY RANGE WED .. WED :=
-                    WEEKDAY'VAL (3);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'D'" );
-                IF D = TUES THEN
-                     COMMENT ("INITIALIZE VARIABLE 'D'");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'D'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                P : CONSTANT DIGIT := '/';
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'P'" );
-                IF P = '0' THEN
-                     COMMENT ("VARIABLE 'P' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'P'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                Q : CHARACTER RANGE 'A' .. 'E' := 'F';
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'Q'" );
-                IF Q = 'A' THEN
-                     COMMENT ("VARIABLE 'Q' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'Q'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                I  :  SHORT := -101;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'I'" );
-                IF I = 1 THEN
-                     COMMENT ("VARIABLE 'I' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'I'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                J  : CONSTANT INTEGER RANGE 0 .. 100 := 101;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'J'" );
-                IF J = -1 THEN
-                     COMMENT ("VARIABLE 'J' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'J'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                K  : INT RANGE 0 .. 1 := 2;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'K'" );
-                IF K = 2 THEN
-                     COMMENT ("VARIABLE 'K' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'K'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                L  : CONSTANT PINT := 0;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'L'" );
-                IF L = 1 THEN
-                     COMMENT ("VARIABLE 'L' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'L'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FL : SFLT := 1.0;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FL'" );
-                IF FL = 3.14 THEN
-                     COMMENT ("VARIABLE 'FL' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FL'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 := -1.0;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FL1'" );
-                IF FL1 = 0.0 THEN
-                     COMMENT ("VARIABLE 'FL1' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FL1'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FI : FIXED RANGE 0.0 .. 0.0 := 0.5;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FI'" );
-                IF FI = 0.5 THEN
-                     COMMENT ("VARIABLE 'FI' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'FI'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                FI1 : CONSTANT SFIXED := -0.5;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FI1'" );
-                IF FI1 = 0.5 THEN
-                     COMMENT ("VARIABLE 'FI1' INITIALIZED");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'FI1'" );
-      END;
- 
-      RESULT;
- END C32111B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32112b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32112b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32112b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32112b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- C32112B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR THE DECLARATION OF A NULL
- -- ARRAY OBJECT IF THE INITIAL VALUE IS NOT A NULL ARRAY.
- 
- -- RJW 7/20/86
- -- GMT 7/01/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
- --              CHANGED THE RANGE VALUES OF A FEW DIMENSIONS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32112B IS
- 
-      TYPE ARR1 IS ARRAY (NATURAL RANGE <>) OF INTEGER;
-      SUBTYPE NARR1 IS ARR1 (IDENT_INT (2) .. IDENT_INT (1));
- 
- 
-      TYPE ARR2 IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
-           OF INTEGER;
-      SUBTYPE NARR2 IS ARR2 (IDENT_INT (1) .. IDENT_INT (2),
-                             IDENT_INT (1) .. IDENT_INT (0));
- 
- BEGIN
-      TEST ("C32112B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
-                       "THE DECLARATION OF A NULL ARRAY OBJECT IF " &
-                       "THE INITIAL VALUE IS NOT A NULL ARRAY");
- 
-      BEGIN
-           DECLARE
-                A   : ARR1 (IDENT_INT(1) .. IDENT_INT(2));
-                N1A : NARR1 := (A'RANGE => 0);
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N1A'");
-                A(1) := IDENT_INT(N1A(1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N1A'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A   : ARR1 (IDENT_INT (1) .. IDENT_INT (2));
-                N1B : CONSTANT NARR1 := (A'RANGE => 0);
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N1B'");
-                A(1) := IDENT_INT(N1B(1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N1B'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A   : ARR1 (IDENT_INT (1) .. IDENT_INT (1));
-                N1C : CONSTANT NARR1 := (A'RANGE => 0);
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N1C'");
-                A(1) := IDENT_INT(N1C(1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N1C'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A   : ARR1 (IDENT_INT (1) .. IDENT_INT (1));
-                N1D : NARR1 := (A'RANGE => 0);
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N1D'");
-                A(1) := IDENT_INT(N1D(1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N1D'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A   : ARR1 (IDENT_INT (0) .. IDENT_INT (1));
-                N1E : ARR1 (IDENT_INT (1) .. IDENT_INT (0)) :=
-                           (A'RANGE  => 0);
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N1E'");
-                A(1) := IDENT_INT(N1E(1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N1E'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A   : ARR1 (IDENT_INT (0) .. IDENT_INT (1));
-                N1F : CONSTANT ARR1 (IDENT_INT (1) .. IDENT_INT (0)) :=
-                      (A'RANGE => 0);
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N1F'");
-                A(1) := IDENT_INT(N1F(1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N1F'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A   : ARR2 (IDENT_INT (1) .. IDENT_INT (2),
-                            IDENT_INT (0) .. IDENT_INT (1));
-                N2A : CONSTANT NARR2 := (A'RANGE => (A'RANGE (2) =>0));
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N2'");
-                A(1,1) := IDENT_INT(N2A(1,1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N2A'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A : ARR2 (IDENT_INT (1) .. IDENT_INT (2),
-                          IDENT_INT (0) .. IDENT_INT (1));
-                N2B : NARR2 := (A'RANGE => (A'RANGE (2) =>0));
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N2B'");
-                A(1,1) := IDENT_INT(N2B(1,1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N2B'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A : ARR2 (IDENT_INT (1) .. IDENT_INT (3),
-                          IDENT_INT (1) .. IDENT_INT (1));
-                N2C : CONSTANT NARR2 := (A'RANGE => (A'RANGE (2) =>0));
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N2C'");
-                A(1,1) := IDENT_INT(N2C(1,1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N2C'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A : ARR2 (IDENT_INT (1) .. IDENT_INT (3),
-                          IDENT_INT (1) .. IDENT_INT (1));
-                N2D : NARR2 := (A'RANGE => (A'RANGE (2) =>0));
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N2D'");
-                A(1,1) := IDENT_INT(N2D(1,1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N2D'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A : ARR2 (IDENT_INT (1) .. IDENT_INT (1),
-                          IDENT_INT (1) .. IDENT_INT (1));
-                N2E : CONSTANT ARR2 (IDENT_INT (2) .. IDENT_INT (1),
-                                     IDENT_INT (1) .. IDENT_INT (1)) :=
-                                    (A'RANGE => (A'RANGE (2) =>0));
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N2E'");
-                A(1,1) := IDENT_INT(N2E(1,1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF CONSTANT 'N2E'");
-      END;
- 
-      BEGIN
-           DECLARE
-                A   : ARR2 (IDENT_INT (1) .. IDENT_INT (1),
-                            IDENT_INT (1) .. IDENT_INT (1));
-                N2F : ARR2 (IDENT_INT (2) .. IDENT_INT (1),
-                            IDENT_INT (1) .. IDENT_INT (1)) :=
-                            (A'RANGE => (A'RANGE (2) =>0));
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N2F'");
-                A(1,1) := IDENT_INT(N2F(1,1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                        "OF VARIABLE 'N2F'");
-      END;
- 
-      RESULT;
- END C32112B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32113a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32113a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32113a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,534 ****
- -- C32113A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED TYPE
- --     WITH DISCRIMINANTS IS DECLARED WITH AN INITIAL VALUE,
- --     CONSTRAINT_ERROR IS RAISED IF THE CORRESPONDING DISCRIMINANTS OF
- --     THE INITIAL VALUE AND THE SUBTYPE DO NOT HAVE THE SAME VALUE.
- 
- -- HISTORY:
- --     RJW 07/20/86
- --     DWC 06/22/87  ADDED SUBTYPE PRIVAS.  ADDED CODE TO PREVENT DEAD
- --                   VARIABLE OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32113A IS
- 
-      PACKAGE PKG IS
-           TYPE PRIVA (D : INTEGER := 0) IS PRIVATE;
-           SUBTYPE PRIVAS IS PRIVA (IDENT_INT (1));
-           PRA1 : CONSTANT PRIVAS;
- 
-           TYPE PRIVB (D1, D2 : INTEGER) IS PRIVATE;
-           PRB12 : CONSTANT PRIVB;
- 
-      PRIVATE
-           TYPE PRIVA (D : INTEGER := 0) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE PRIVB (D1, D2 : INTEGER) IS
-                RECORD
-                      NULL;
-                END RECORD;
- 
-           PRA1  : CONSTANT PRIVAS := (D => (IDENT_INT (1)));
-           PRB12 : CONSTANT PRIVB := (IDENT_INT (1), IDENT_INT (2));
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE RECA (D : INTEGER := 0) IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      TYPE RECB (D1, D2 : INTEGER) IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      RA1 : CONSTANT RECA (IDENT_INT (1)) := (D => (IDENT_INT (1)));
- 
-      RB12 : CONSTANT RECB := (IDENT_INT (1), IDENT_INT (2));
- 
- BEGIN
-      TEST ("C32113A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
-                       "HAVING A CONSTRAINED TYPE IS DECLARED WITH " &
-                       "AN INITIAL VALUE, CONSTRAINT_ERROR IS " &
-                       "RAISED IF THE CORRESPONDING DISCRIMINANTS " &
-                       "OF THE INITIAL VALUE AND THE SUBTYPE DO " &
-                       "NOT HAVE THE SAME VALUE" );
- 
-      BEGIN
-           DECLARE
-                PR1 : CONSTANT PRIVA (IDENT_INT (0)) := PRA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR1'" );
-                IF PR1 = PRA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR1'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PR2 : CONSTANT PRIVA (IDENT_INT (2)) := PRA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR2'" );
-                IF PR2 = PRA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR2'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PR3 : PRIVA (IDENT_INT (0)) := PRA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR3'" );
-                IF PR3 = PRA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR3'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PR4 : PRIVA (IDENT_INT (2)) := PRA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR4'" );
-                IF PR4 = PRA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR4'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SPRIVA IS PRIVA (IDENT_INT (-1));
-                PR5 : CONSTANT SPRIVA := PRA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR5'" );
-                IF PR5 = PRA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR5'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SPRIVA IS PRIVA (IDENT_INT (3));
-                PR6 : SPRIVA := PRA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR6'" );
-                IF PR6 = PRA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR6'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PR7 : CONSTANT PRIVB (IDENT_INT (1), IDENT_INT (1)) :=
-                      PRB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR7'" );
-                IF PR7 = PRB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR7'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PR8 : CONSTANT PRIVB (IDENT_INT (2), IDENT_INT (2)) :=
-                      PRB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR8'" );
-                IF PR8 = PRB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR8'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PR9 : PRIVB (IDENT_INT (1), IDENT_INT (1)) := PRB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR9'" );
-                IF PR9 = PRB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR9'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PR10 : PRIVB (IDENT_INT (2), IDENT_INT (2)) := PRB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR10'" );
-                IF PR10 = PRB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR10'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SPRIVB IS
-                        PRIVB (IDENT_INT (-1), IDENT_INT (-2));
-                PR11 : CONSTANT SPRIVB := PRB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR11'" );
-                IF PR11 = PRB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'PR11'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SPRIVB IS PRIVB (IDENT_INT (2), IDENT_INT (1));
-                PR12 : SPRIVB := PRB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR12'" );
-                IF PR12 = PRB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'PR12'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R1 : CONSTANT RECA (IDENT_INT (0)) := RA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R1'" );
-                IF R1 = RA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R1'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R2 : CONSTANT RECA (IDENT_INT (2)) := RA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R2'" );
-                IF R2 = RA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R2'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R3 : RECA (IDENT_INT (0)) := RA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R3'" );
-                IF R3 = RA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R3'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R4 : RECA (IDENT_INT (2)) := RA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R4'" );
-                IF R4 = RA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R4'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SRECA IS RECA (IDENT_INT (-1));
-                R5 : CONSTANT SRECA := RA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R5'" );
-                IF R5 = RA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R5'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SRECA IS RECA (IDENT_INT (3));
-                R6 : SRECA := RA1;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R6'" );
-                IF R6 = RA1 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R6'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R7 : CONSTANT RECB (IDENT_INT (1), IDENT_INT (1)) :=
-                      RB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R7'" );
-                IF R7 = RB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R7'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R8 : CONSTANT RECB (IDENT_INT (2), IDENT_INT (2)) :=
-                      RB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R8'" );
-                IF R8 = RB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R8'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R9 : RECB (IDENT_INT (1), IDENT_INT (1)) := RB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R9'" );
-                IF R9 = RB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R9'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R10 : RECB (IDENT_INT (2), IDENT_INT (2)) := RB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R10'" );
-                IF R10 = RB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R10'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SRECB IS
-                        RECB (IDENT_INT (-1), IDENT_INT (-2));
-                R11 : CONSTANT SRECB := RB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R11'" );
-                IF R11 = RB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'R11'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SRECB IS RECB (IDENT_INT (2), IDENT_INT (1));
-                R12 : SRECB := RB12;
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R12'" );
-                IF R12 = RB12 THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'R12'" );
-      END;
- 
-      RESULT;
- END C32113A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32115a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32115a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32115a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32115a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,338 ****
- -- C32115A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED
- --    ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE,
- --    CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT
- --    VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING
- --    VALUE SPECIFIED FOR THE ACCESS SUBTYPE.
- 
- -- HISTORY:
- --    RJW 07/20/86  CREATED ORIGINAL TEST.
- --    JET 08/05/87  ADDED DEFEAT OF DEAD VARIABLE OPTIMIZATION.
- --    PWN 11/30/94  REMOVED TEST ILLEGAL IN ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32115A IS
- 
-      PACKAGE PKG IS
-           TYPE PRIV (D : INTEGER) IS PRIVATE;
- 
-      PRIVATE
-           TYPE PRIV (D : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE ACCP IS ACCESS PRIV (IDENT_INT (1));
- 
-      TYPE REC (D : INTEGER) IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      TYPE ACCR IS ACCESS REC (IDENT_INT (2));
- 
-      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
- 
-      TYPE ACCA IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (2));
- 
-      TYPE ACCN IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (0));
- 
- BEGIN
-      TEST ("C32115A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
-                       "HAVING A CONSTRAINED ACCESS TYPE IS " &
-                       "DECLARED WITH AN INITIAL NON-NULL ACCESS " &
-                       "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " &
-                       "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " &
-                       "DESIGNATED OBJECT DOES NOT EQUAL THE " &
-                       "CORRESPONDING VALUE SPECIFIED FOR THE " &
-                       "ACCESS SUBTYPE" );
- 
-      BEGIN
-           DECLARE
-                AC1 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (2)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC1'" );
-                IF AC1 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC1' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC1'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC2 : ACCP := NEW PRIV (D => (IDENT_INT (2)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC2'" );
-                IF AC2 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC2' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC2'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC3 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (0)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC3'" );
-                IF AC3 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC3' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC3'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC4 : ACCP := NEW PRIV (D => (IDENT_INT (0)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC4'" );
-                IF AC4 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC4' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC4'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC5 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (1)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC5'" );
-                IF AC5 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC5' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC5'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC6 : ACCR := NEW REC' (D => (IDENT_INT (1)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC6'" );
-                IF AC6 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC6' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC6'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC7 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (3)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC7'" );
-                IF AC7 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC7' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC7'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC8 : ACCR := NEW REC' (D => (IDENT_INT (3)));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC8'" );
-                IF AC8 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC8' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC8'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC9 : CONSTANT ACCA :=
-                     NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC9'" );
-                IF AC9 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC9' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC9'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC10 : ACCA :=
-                     NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC10'" );
-                IF AC10 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC10' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC10'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC11 : CONSTANT ACCA :=
-                     NEW ARR' (IDENT_INT (0) .. IDENT_INT (2) => 0);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC11'" );
-                IF AC11 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC11' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC11'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC12 : ACCA :=
-                     NEW ARR'(IDENT_INT (0) .. IDENT_INT (2) => 0);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC12'" );
-                IF AC12 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC12' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC12'" );
-      END;
- 
- 
-      BEGIN
-           DECLARE
-                AC15 : CONSTANT ACCN :=
-                     NEW ARR' (IDENT_INT (0) .. IDENT_INT (0) => 0);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC15'" );
-                IF AC15 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC15' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC15'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC16 : ACCN :=
-                     NEW ARR'(IDENT_INT (0) .. IDENT_INT (0) => 0);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC16'" );
-                IF AC16 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC16' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC16'" );
-      END;
- 
-      RESULT;
- END C32115A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32115b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32115b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c32115b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c32115b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,376 ****
- -- C32115B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING AN UNCONSTRAINED
- --    ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE,
- --    CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT
- --    VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING
- --    VALUE SPECIFIED FOR THE ACCESS SUBTYPE OF THE OBJECT.
- 
- -- HISTORY:
- --    JET 08/05/87  CREATED ORIGINAL TEST BASED ON C32115A BY RJW
- --                  BUT WITH UNCONSTRAINED ACCESS TYPES AND
- --                  CONSTRAINED VARIABLE/CONSTANT DECLARATIONS.
- -- KAS 12/4/95 FIXED TYPO IN CALL TO REPORT.TEST
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C32115B IS
- 
-      PACKAGE PKG IS
-           TYPE PRIV (D : INTEGER) IS PRIVATE;
- 
-      PRIVATE
-           TYPE PRIV (D : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE ACCP IS ACCESS PRIV;
- 
-      TYPE REC (D : INTEGER) IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      TYPE ACCR IS ACCESS REC;
- 
-      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
- 
-      TYPE ACCA IS ACCESS ARR;
- 
-      TYPE ACCN IS ACCESS ARR;
- 
- BEGIN
-      TEST ("C32115B", "CHECK THAT WHEN CONSTRAINED VARIABLE OR " &
-                       "CONSTANT HAVING AN UNCONSTRAINED ACCESS TYPE " &
-                       "IS DECLARED WITH AN INITIAL NON-NULL ACCESS " &
-                       "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " &
-                       "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " &
-                       "DESIGNATED OBJECT DOES NOT EQUAL THE " &
-                       "CORRESPONDING VALUE SPECIFIED FOR THE " &
-                       "ACCESS SUBTYPE OF THE OBJECT" );
- 
-      BEGIN
-           DECLARE
-                AC1 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (2));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC1'" );
-                IF AC1 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC1' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC1'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC2 : ACCP(1) := NEW PRIV (IDENT_INT (2));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC2'" );
-                IF AC2 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC2' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC2'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC3 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (0));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC3'" );
-                IF AC3 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC3' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC3'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC4 : ACCP(1) := NEW PRIV (IDENT_INT (0));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC4'" );
-                IF AC4 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC4' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC4'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC5 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC5'" );
-                IF AC5 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC5' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC5'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC6 : ACCR(2) := NEW REC (IDENT_INT (1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC6'" );
-                IF AC6 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC6' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC6'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC7 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (3));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC7'" );
-                IF AC7 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC7' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC7'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC8 : ACCR(2) := NEW REC (IDENT_INT (3));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC8'" );
-                IF AC8 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC8' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC8'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC9 : CONSTANT ACCA(1 .. 2) :=
-                      NEW ARR(IDENT_INT(1) .. IDENT_INT (1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC9'" );
-                IF AC9 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC9' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC9'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC10 : ACCA (1..2) :=
-                     NEW ARR(IDENT_INT (1) .. IDENT_INT (1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC10'" );
-                IF AC10 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC10' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC10'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC11 : CONSTANT ACCA(1..2) :=
-                     NEW ARR(IDENT_INT (0) .. IDENT_INT (2));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC11'" );
-                IF AC11 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC11' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC11'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC12 : ACCA(1..2) :=
-                     NEW ARR(IDENT_INT (0) .. IDENT_INT (2));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC12'" );
-                IF AC12 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC12' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC12'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC13 : CONSTANT ACCA (1..2) :=
-                     NEW ARR(IDENT_INT (2) .. IDENT_INT (3));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC13'" );
-                IF AC13 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC13' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC13'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC14 : ACCA(1..2) :=
-                     NEW ARR(IDENT_INT (2) .. IDENT_INT (3));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC14'" );
-                IF AC14 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC14' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC14'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC15 : CONSTANT ACCN(1..0) :=
-                     NEW ARR(IDENT_INT (0) .. IDENT_INT (0));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC15'" );
-                IF AC15 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC15' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF CONSTANT 'AC15'" );
-      END;
- 
-      BEGIN
-           DECLARE
-                AC16 : ACCN(1..0) :=
-                     NEW ARR(IDENT_INT (0) .. IDENT_INT (0));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC16'" );
-                IF AC16 /= NULL THEN
-                     COMMENT ("DEFEAT 'AC16' OPTIMIZATION");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
-                         "OF VARIABLE 'AC16'" );
-      END;
- 
-      RESULT;
- END C32115B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c330001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c330001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c330001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c330001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,354 ****
- -- C330001.A 
- -- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- 
- -- OBJECTIVE: 
- --      Check that a variable object of an indefinite type is properly 
- --      initialized/constrained by an initial value assignment that is 
- --      a) an aggregate, b) a function, or c) an object.  Check that objects 
- --      of the above types do not need explicit constraints if they have 
- --      initial values.  
- --                    
- -- TEST DESCRIPTION: 
- --      An indefinite subtype is either: 
- --         a) An unconstrained array subtype. 
- --         b) A subtype with unknown discriminants.
- --         c) A subtype with unconstrained discriminants without defaults. 
- -- 
- --      Declare several indefinite types in a parent package specification.  
- --      In the private part, complete one type with a discriminant without 
- --      default (indefinite) and the other with a default discriminant 
- --      (definite).  Declare objects of both indefinite and definite subtypes 
- --      in children (private and public) with initialization expressions.  The 
- --      test verifies all values of the objects.  It also verifies that
- --      Constraint_Error is raised if an attempt is made to change the 
- --      discriminants of the objects of the indefinite subtypes.        
- -- 
- -- 
- -- CHANGE HISTORY: 
- --      15 Jan 95   SAIC    Initial version for ACVC 2.1
- --      25 Jul 96   SAIC    Modified test description. Deleted use C330001_0.
- --      20 Nov 98   RLB     Added Elaborate pragmas to avoid problems
- --                          with an unconventional, but legal, elaboration
- --                          order.
- --!
- 
- package C330001_0 is  
- 
-    subtype Sub_Type is Integer range 1 .. 20;
- 
-    type Tag_W_Disc (D : Sub_Type) is tagged record
-        C1 :  String (1 .. D);
-    end record;
- 
-    -- Indefinite type declarations.
- 
-    type FullViewDefinite_Unknown_Disc (<>) is private;           
- 
-    type Indefinite_No_Disc is array (Positive range <>) of Integer;
- 
-    type Indefinite_Tag_W_Disc (D : Sub_Type) is tagged
-      record
-         C1 : Boolean := False;
-      end record;
- 
-    type Indefinite_New_W_Disc (ND : Sub_Type) is new 
-      Indefinite_Tag_W_Disc (ND) with record
-         C2 : Integer := 9;
-      end record;
- 
-    type Indefinite_W_Inherit_Disc_1 is new Tag_W_Disc with 
-      record     
-         S : Sub_Type := 18;
-      end record;
-                                                     
-    type Indefinite_W_Inherit_Disc_2 is     
-      new Tag_W_Disc with private;                                       
-                                                                            
-    function Indef_Func_1 return FullViewDefinite_Unknown_Disc;
- 
-    function Indef_Func_2 (P : Sub_Type) return Indefinite_W_Inherit_Disc_2;
- 
- private
- 
-    type FullViewDefinite_Unknown_Disc (D : Sub_Type := 2) is
-       record     
-         S : String (1 .. D) := "Hi";
-       end record;
- 
-    type Indefinite_W_Inherit_Disc_2 is new Tag_W_Disc with 
-       record     
-         S : Sub_Type;
-       end record;
- 
- end C330001_0;
- 
-      --==================================================================--
- 
- package body C330001_0 is  
- 
-    function Indef_Func_1 return FullViewDefinite_Unknown_Disc is
-       Var_1 : FullViewDefinite_Unknown_Disc;      -- No need for explicit 
-                                                   -- constraints, use initial
-    begin                                          -- values.
-       return Var_1;
-    end Indef_Func_1;
- 
-    ------------------------------------------------------------------
-    function Indef_Func_2 (P : Sub_Type) return Indefinite_W_Inherit_Disc_2 is
-       Var_2 : Indefinite_W_Inherit_Disc_2 := (D => 5, C1 => "Hello", S => P);
-    begin
-       return Var_2;
-    end Indef_Func_2;
- 
- end C330001_0;
- 
-      --==================================================================--
- 
- with C330001_0;
- pragma Elaborate(C330001_0); -- Insure that the functions can be called.
- private
- package C330001_0.C330001_1 is  
- 
-    PrivateChild_Obj    : Tag_W_Disc := (D => 4, C1 => "ACVC");
- 
-    PrivateChild_Obj_01 : Indefinite_W_Inherit_Disc_1 
-      := Indefinite_W_Inherit_Disc_1'(PrivateChild_Obj with S => 15);
- 
-    -- Since full view of Indefinite_W_Inherit_Disc_2 is indefinite in 
-    -- the parent package, Indefinite_W_Inherit_Disc_2 needs an initialization
-    -- expression.
- 
-    PrivateChild_Obj_02 : Indefinite_W_Inherit_Disc_2 := Indef_Func_2 (19);
- 
-    -- Since full view of FullViewDefinite_Unknown_Disc is definite in the 
-    -- parent package, no initialization expression needed for 
-    -- PrivateChild_Obj_03.
- 
-    PrivateChild_Obj_03 : FullViewDefinite_Unknown_Disc;
- 
-    PrivateChild_Obj_04 : Indefinite_No_Disc          := (12, 15);
- 
- end C330001_0.C330001_1;
- 
-      --==================================================================--
- 
- with C330001_0;
- pragma Elaborate(C330001_0); -- Insure that the functions can be called.
- package C330001_0.C330001_2 is  
- 
-    PublicChild_Obj_01 : FullViewDefinite_Unknown_Disc := Indef_Func_1;
- 
-    PublicChild_Obj_02 : Indefinite_W_Inherit_Disc_2   := Indef_Func_2 (4);
- 
-    PublicChild_Obj_03 : Indefinite_No_Disc            := (38, 72, 21, 59);
- 
-    PublicChild_Obj_04 : Indefinite_Tag_W_Disc         := (D => 7, C1 => True);
- 
-    PublicChild_Obj_05 : Indefinite_Tag_W_Disc         := PublicChild_Obj_04;
- 
-    PublicChild_Obj_06 : Indefinite_New_W_Disc (6);
- 
-    procedure Assign_Private_Obj_3;
- 
-    function Raised_CE_PublicChild_Obj return Boolean;
- 
-    function Raised_CE_PrivateChild_Obj return Boolean;
- 
-    -- The following functions check the private types defined in the parent
-    -- and the private child package from within the client program.
- 
-    function Verify_Public_Obj_1 return Boolean;
- 
-    function Verify_Public_Obj_2 return Boolean;
- 
-    function Verify_Private_Obj_1 return Boolean;
- 
-    function Verify_Private_Obj_2 return Boolean;
- 
-    function Verify_Private_Obj_3 return Boolean;
- 
- end C330001_0.C330001_2;
- 
-      --==================================================================--
- 
- with Report;
- with C330001_0.C330001_1;
- package body C330001_0.C330001_2 is  
- 
-    procedure Assign_Private_Obj_3 is
-    begin
-       C330001_0.C330001_1.PrivateChild_Obj_03 := (5, "Aloha");
-    end Assign_Private_Obj_3;
- 
-    ------------------------------------------------------------------
-    function Raised_CE_PublicChild_Obj return Boolean is
-    begin
-       PublicChild_Obj_03 := (16, 13);       -- C_E, can't change constraints 
-                                             -- of PublicChild_Obj_03.
- 
-       Report.Failed ("Constraint_Error not raised - Public child");
- 
-       -- Next line prevents dead assignment.
- 
-       Report.Comment ("PublicChild_Obj_03'First is" & Integer'Image 
-                       (PublicChild_Obj_03'First) );
-       return False;
- 
-    exception                             
-       when Constraint_Error => 
-          return True;                       -- Exception is expected.
-       when others           => 
-          return False;
-    end Raised_CE_PublicChild_Obj;
- 
-    ------------------------------------------------------------------
-    function Raised_CE_PrivateChild_Obj return Boolean is
-    begin
-       C330001_0.C330001_1.PrivateChild_Obj_04 := (21, 87, 18);      
-                                             -- C_E, can't change constraints
-                                             -- of PrivateChild_Obj_04.
- 
-       Report.Failed ("Constraint_Error not raised - Private child");
- 
-       -- Next line prevents dead assignment.
- 
-       Report.Comment ("PrivateChild_Obj_04'Last is" & Integer'Image 
-                       (C330001_0.C330001_1.PrivateChild_Obj_04'Last) );
-       return False;
- 
-    exception                             
-       when Constraint_Error => 
-          return True;                       -- Exception is expected.
-       when others           => 
-          return False;
-    end Raised_CE_PrivateChild_Obj;
- 
-    ------------------------------------------------------------------
-    function Verify_Public_Obj_1 return Boolean is
-    begin
-       return (PublicChild_Obj_01.D = 2 and PublicChild_Obj_01.S = "Hi");
- 
-    end Verify_Public_Obj_1;
- 
-    ------------------------------------------------------------------
-    function Verify_Public_Obj_2 return Boolean is
-    begin
-       return (PublicChild_Obj_02.D  = 5       and
-               PublicChild_Obj_02.C1 = "Hello" and 
-               PublicChild_Obj_02.S  = 4);
- 
-    end Verify_Public_Obj_2;
- 
-    ------------------------------------------------------------------
-    function Verify_Private_Obj_1 return Boolean is
-    begin
-       return (C330001_0.C330001_1.PrivateChild_Obj_01.D  = 4      and
-               C330001_0.C330001_1.PrivateChild_Obj_01.C1 = "ACVC" and
-               C330001_0.C330001_1.PrivateChild_Obj_01.S  = 15);
- 
-    end Verify_Private_Obj_1;
- 
-    ------------------------------------------------------------------
-    function Verify_Private_Obj_2 return Boolean is
-    begin
-       return (C330001_0.C330001_1.PrivateChild_Obj_02.D  = 5       and
-               C330001_0.C330001_1.PrivateChild_Obj_02.C1 = "Hello" and
-               C330001_0.C330001_1.PrivateChild_Obj_02.S  = 19);
- 
-    end Verify_Private_Obj_2;
- 
-    ------------------------------------------------------------------
-    function Verify_Private_Obj_3 return Boolean is
-    begin
-       return (C330001_0.C330001_1.PrivateChild_Obj_03.D = 5 and
-               C330001_0.C330001_1.PrivateChild_Obj_03.S = "Aloha");
- 
-    end Verify_Private_Obj_3;
- 
- end C330001_0.C330001_2;
- 
-      --==================================================================--
- 
- with C330001_0.C330001_2;
- with Report;
- 
- use  C330001_0.C330001_2;
- 
- procedure C330001 is  
- begin
-    Report.Test ("C330001", "Check that a variable object of an indefinite " &
-                 "type is properly initialized/constrained by an initial "   &
-                 "value assignment that is a) an aggregate, b) a function, " &
-                 "or c) an object.  Check that objects of the above types "  &
-                 "do not need explicit constraints if they have initial "    &
-                 "values");
- 
-    -- Verify values of public child objects.
- 
-    if not (Verify_Public_Obj_1 and Verify_Public_Obj_2) then 
-       Report.Failed ("Wrong values for PublicChild_Obj_01 or " &
-                      "PublicChild_Obj_02");
-    end if;
-    
-    if PublicChild_Obj_03'First /= 1 or
-       PublicChild_Obj_03'Last  /= 4 then
-       Report.Failed ("Wrong values for PublicChild_Obj_03");
-    end if;
- 
-    if PublicChild_Obj_05.D  /= 7 or 
-       not PublicChild_Obj_05.C1  then
-       Report.Failed ("Wrong values for PublicChild_Obj_05");
-    end if;
- 
-    if PublicChild_Obj_06.ND /= 6 or 
-       PublicChild_Obj_06.C2 /= 9 or
-       PublicChild_Obj_06.C1      then
-       Report.Failed ("Wrong values for PublicChild_Obj_06");
-    end if;
- 
-    -- Definite object can have its discriminant changed by assignment to
-    -- the entire object.
- 
-    Assign_Private_Obj_3;
- 
-    -- Verify values of private child objects.
- 
-    if not Verify_Private_Obj_1 or not 
-           Verify_Private_Obj_2 or not 
-           Verify_Private_Obj_3 then
-       Report.Failed ("Wrong values for PrivateChild_Obj_01 or " &
-                      "PrivateChild_Obj_02 or PrivateChild_Obj_03");
-    end if;
- 
-    -- Attempt to change the discriminants of the objects of the indefinite
-    -- subtypes:  Constraint_Error.
- 
-    if not Raised_CE_PublicChild_Obj or not Raised_CE_PrivateChild_Obj then
-       Report.Failed ("Constraint_Error not raised");
-    end if;
- 
-    Report.Result;
- 
- end C330001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c330002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c330002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c330002.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c330002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,326 ****
- -- C330002.A 
- -- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- 
- -- OBJECTIVE: 
- --      Check that if a subtype indication of a variable object defines an  
- --      indefinite subtype, then there is an initialization expression. 
- --      Check that the object remains so constrained throughout its lifetime. 
- --      Check for cases of tagged record, arrays and generic formal type. 
- --                    
- -- TEST DESCRIPTION: 
- --      An indefinite subtype is either: 
- --         a) An unconstrained array subtype. 
- --         b) A subtype with unknown discriminants (this includes class-wide 
- --            types). 
- --         c) A subtype with unconstrained discriminants without defaults. 
- -- 
- --      Declare tagged types with unconstrained discriminants without 
- --      defaults.  Declare an unconstrained array.  Declare a generic formal
- --      type with an unknown discriminant and a formal object of this type.  
- --      In the generic package, declare an object of the formal type using 
- --      the formal object as its initial value.  In the main program, 
- --      declare objects of tagged types.  Instantiate the generic package.  
- --      The test checks that Constraint_Error is raised if an attempt is 
- --      made to change bounds as well as discriminants of the objects of the 
- --      indefinite subtypes.  
- -- 
- -- 
- -- CHANGE HISTORY: 
- --      01 Nov 95   SAIC    Initial prerelease version. 
- --      27 Jul 96   SAIC    Modified test description & Report.Test.  Added
- --                          code to prevent dead variable optimization.
- -- 
- --!
- 
- package C330002_0 is  
- 
-    subtype Small_Num is Integer range 1 .. 20;
- 
-    -- Types with unconstrained discriminants without defaults.      
- 
-    type Tag_Type (Disc : Small_Num) is tagged         
-      record                                          
-        S : String (1 .. Disc);                       
-      end record;
- 
-    function  Tag_Value return Tag_Type;
- 
-    procedure Assign_Tag (A : out Tag_Type);
- 
-    procedure Avoid_Optimization_and_Fail (P : Tag_Type; Msg : String);
- 
-    ---------------------------------------------------------------------
-    -- An unconstrained array type.
- 
-    type Array_Type is array (Positive range <>) of Integer;
- 
-    function  Array_Value return Array_Type;
- 
-    procedure Assign_Array (A : out Array_Type);
- 
-    ---------------------------------------------------------------------
-    generic
-       -- Type with an unknown discriminant.
-       type Formal_Type (<>) is private;
-       FT_Obj  : Formal_Type;
-    package Gen is
-       Gen_Obj : Formal_Type := FT_Obj;
-    end Gen;
- 
- end C330002_0;
- 
-      --==================================================================--
- 
- with Report;
- package body C330002_0 is  
- 
-    procedure Assign_Tag (A : out Tag_Type) is
-    begin
-       A := (3, "Bye");
-    end Assign_Tag;
- 
-    ----------------------------------------------------------------------
-    procedure Avoid_Optimization_and_Fail (P : Tag_Type; Msg : String) is
-       Default : Tag_Type := (1, "!"); -- Unique value.
-    begin                       
-       if P = Default then       -- Both If branches can't do the same thing.
-          Report.Failed  (Msg & ": Constraint_Error not raised");
-       else                      -- Subtests should always select this path.
-          Report.Failed ("Constraint_Error not raised " & Msg);
-       end if;
-    end Avoid_Optimization_and_Fail;
- 
-    ----------------------------------------------------------------------
-    function  Tag_Value return Tag_Type is
-       TO : Tag_Type := (4 , "ACVC");
-    begin
-       return TO;
-    end Tag_Value;
- 
-    ----------------------------------------------------------------------
-    function  Array_Value return Array_Type is
-       IA : Array_Type := (20, 31);
-    begin
-       return IA;
-    end Array_Value;
- 
-    ----------------------------------------------------------------------
-    procedure Assign_Array (A : out Array_Type) is
-    begin
-       A := (84, 36);
-    end Assign_Array;
- 
- end C330002_0;
- 
-      --==================================================================--
- 
- with Report;
- with C330002_0;
- use  C330002_0;
- 
- procedure C330002 is  
- 
- begin
-    Report.Test ("C330002", "Check that if a subtype indication of a "      &
-                 "variable object defines an indefinite subtype, then "     & 
-                 "there is an initialization expression.  Check that "      &
-                 "the object remains so constrained throughout its "        &
-                 "lifetime.  Check that Constraint_Error is raised "        &
-                 "if an attempt is made to change bounds as well as "       &
-                 "discriminants of the objects of the indefinite "          &
-                 "subtypes.  Check for cases of tagged record and generic " &
-                 "formal types");
- 
-    TagObj_Block:
-    declare
-       TObj_ByAgg  : Tag_Type := (5, "Hello");    -- Initial assignment is
-                                                  -- aggregate.   
-       TObj_ByObj  : Tag_Type := TObj_ByAgg;      -- Initial assignment is
-                                                  -- an object.   
-       TObj_ByFunc : Tag_Type := Tag_Value;       -- Initial assignment is
-                                                  -- function return value.
-       Ren_Obj     : Tag_Type renames TObj_ByAgg;        
- 
-    begin
- 
-       begin
-          if (TObj_ByAgg.Disc /= 5) or (TObj_ByAgg.S /= "Hello") then
-             Report.Failed ("Wrong initial values for TObj_ByAgg");
-          end if;
-            
-          TObj_ByAgg := (2, "Hi");                -- C_E, can't change the 
-                                                  -- value of the discriminant.
- 
-          Avoid_Optimization_and_Fail (TObj_ByAgg, "Subtest 1");
- 
-       exception
-          when Constraint_Error => null;          -- Exception is expected.
-          when others           => 
-             Report.Failed ("Unexpected exception - Subtest 1");
-       end;
- 
- 
-       begin
-          Assign_Tag (Ren_Obj);                   -- C_E, can't change the 
-                                                  -- value of the discriminant.
- 
-          Avoid_Optimization_and_Fail (Ren_Obj, "Subtest 2");
- 
-       exception
-          when Constraint_Error => null;          -- Exception is expected.
-          when others           => 
-             Report.Failed ("Unexpected exception - Subtest 2");
-       end;
- 
- 
-       begin
-          if (TObj_ByObj.Disc /= 5) or (TObj_ByObj.S /= "Hello") then
-             Report.Failed ("Wrong initial values for TObj_ByObj");
-          end if;
- 
-          TObj_ByObj := (3, "Bye");               -- C_E, can't change the 
-                                                  -- value of the discriminant.
- 
-          Avoid_Optimization_and_Fail (TObj_ByObj, "Subtest 3");
- 
-       exception
-          when Constraint_Error => null;          -- Exception is expected.
-          when others           => 
-             Report.Failed ("Unexpected exception - Subtest 3");
-       end;
- 
- 
-       begin
-          if (TObj_ByFunc.Disc /= 4) or (TObj_ByFunc.S /= "ACVC") then
-             Report.Failed ("Wrong initial values for TObj_ByFunc");
-          end if;
- 
-          TObj_ByFunc := (5, "Aloha");            -- C_E, can't change the 
-                                                  -- value of the discriminant.
- 
-          Avoid_Optimization_and_Fail (TObj_ByFunc, "Subtest 4");
- 
-       exception
-          when Constraint_Error => null;          -- Exception is expected.
-          when others           => 
-             Report.Failed ("Unexpected exception - Subtest 4");
-       end;
- 
-    end TagObj_Block;
- 
- 
-    ArrObj_Block:
-    declare
-       Arr_Const   :  constant Array_Type               
-                   := (9, 7, 6, 8); 
-       Arr_ByAgg   :  Array_Type                  -- Initial assignment is
-                   := (10, 11, 12);               -- aggregate.            
-       Arr_ByFunc  :  Array_Type                  -- Initial assignment is
-                   := Array_Value;                -- function return value.
-       Arr_ByObj   :  Array_Type                  -- Initial assignment is
-                   := Arr_ByAgg;                  -- object.
- 
-       Arr_Obj     :  array (Positive range <>) of Integer 
-                   := (1, 2, 3, 4, 5);
-     begin
- 
-       begin
-          if (Arr_Const'First /= 1) or (Arr_Const'Last /= 4) then
-             Report.Failed ("Wrong bounds for Arr_Const");
-          end if;
- 
-          if (Arr_ByAgg'First /= 1) or (Arr_ByAgg'Last /= 3) then
-             Report.Failed ("Wrong bounds for Arr_ByAgg");
-          end if;
- 
-          if (Arr_ByFunc'First /= 1) or (Arr_ByFunc'Last /= 2) then
-             Report.Failed ("Wrong bounds for Arr_ByFunc");
-          end if;
- 
-          if (Arr_ByObj'First /= 1) or (Arr_ByObj'Last /= 3) then
-             Report.Failed ("Wrong bounds for Arr_ByObj");
-          end if;
- 
-          Assign_Array (Arr_ByObj);               -- C_E, Arr_ByObj bounds are
-                                                  -- 1..3.
- 
-          Report.Failed ("Constraint_Error not raised - Subtest 5");
- 
-       exception
-             when Constraint_Error => null;        -- Exception is expected.
-             when others           => 
-                Report.Failed ("Unexpected exception - Subtest 5");
-       end;
- 
- 
-       begin
-          if (Arr_Obj'First /= 1) or (Arr_Obj'Last /= 5) then
-             Report.Failed ("Wrong bounds for Arr_Obj");
-          end if;
- 
-          for I in 0 .. 5 loop
-             Arr_Obj (I + 1) := I + 5;             -- C_E, Arr_Obj bounds are
-          end loop;                                -- 1..5.
- 
-          Report.Failed ("Constraint_Error not raised - Subtest 6");
- 
-       exception
-             when Constraint_Error => null;        -- Exception is expected.
-             when others           => 
-                Report.Failed ("Unexpected exception - Subtest 6");
-       end;
- 
-    end ArrObj_Block;
- 
- 
-    GenericObj_Block:
-    declare
-       type Rec (Disc : Small_Num) is 
-         record     
-            S : Small_Num := Disc;
-         end record;
- 
-       Rec_Obj : Rec := (2, 2);
-       package IGen is new Gen (Rec, Rec_Obj);
- 
-    begin
-       IGen.Gen_Obj := (3, 3);                    -- C_E, can't change the 
-                                                  -- value of the discriminant.
- 
-       Report.Failed ("Constraint_Error not raised - Subtest 7");
- 
-       -- Next line prevents dead assignment.
-       Report.Comment ("Disc is" & Integer'Image (IGen.Gen_Obj.Disc));
- 
-    exception
-       when Constraint_Error => null;             -- Exception is expected.
-       when others           => 
-          Report.Failed ("Unexpected exception - Subtest 7");
- 
-    end GenericObj_Block;
- 
-    Report.Result;
- 
- end C330002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c332001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c332001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c332001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c332001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,226 ****
- -- C332001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the static expression given for a number declaration may be
- --      of any numeric type.  Check that the type of a named number is
- --      universal_integer or universal_real regardless of the type of the
- --      static expression that provides its value.
- --
- -- TEST DESCRIPTION:
- --      This test defines a large cross section of mixed type named numbers.
- --      Well, obviously the named numbers don't have types (other than
- --      universal_integer and universal_real) associated with them.
- --      This test uses typed static values in the definition of several named
- --      numbers, and then mixes the named numbers to ensure that their typed
- --      origins do not interfere with the use of their values.
- --
- --
- -- CHANGE HISTORY:
- --      10 OCT 95   SAIC   Initial version
- --      11 APR 96   SAIC   Fixed a few arithmetic errors for 2.1
- --      24 NOV 98   RLB    Removed decimal types to insure that this
- --                         test is applicable to all implementations.
- --
- --!
- 
- ----------------------------------------------------------------- C332001_0
- 
- package C332001_0 is
- 
-   type Enumeration_Type is ( Ah, Gnome, Er, Ay, Shun );
- 
-   type Integer_Type is range 0..1023;
- 
-   type Modular_Type is mod 256;
- 
-   type Floating_Type is digits 4;
- 
-   type Fixed_Type is delta 0.125 range -10.0 .. 10.0;
- 
-   type Mod_Array is array(Modular_Type) of Floating_Type;
- 
-   type Int_Array is array(Integer_Type) of Fixed_Type;
- 
-   type Record_Type is record
-     Pinkie : Integer_Type;
-     Ring   : Modular_Type;
-     Middle : Floating_Type;
-     Index  : Fixed_Type;
-   end record;
- 
-   Mod_Array_Object : Mod_Array;
-   Int_Array_Object : Int_Array;
- 
-   Record_Object : Record_Type;
- 
-   -- numeric_literals 
- 
-   Nothing_New_Integer : constant := 1;
-   Nothing_New_Real    : constant := 1.0;
- 
-   -- static constants
- 
-   Integ : constant Integer_Type  := 2;
-   Modul : constant Modular_Type  := 2;
-   Float : constant Floating_Type := 2.0;   -- bad practice, good test
-   Fixed : constant Fixed_Type    := 2.0;
- 
-   Named_Integer : constant := Integ; -- 2
-   Named_Modular : constant := Modul; -- 2
-   Named_Float   : constant := Float; -- 2.0
-   Named_Fixed   : constant := Fixed; -- 2.0
- 
-   -- function calls
-   -- parenthetical expressions
- 
-   Fn_Integer : constant := Integer_Type'Min(Integ * 2, 8);    -- 4
-   Fn_Modular : constant := Modular_Type'Max(Modul + 2, Modular_Type'First);--4
-   Fn_Float   : constant := (Float ** 2);                      -- 4.0
-   Fn_Fixed   : constant := - Fixed;                           -- -2.0
-   -- attributes
- 
-   ITF : constant := Integer_Type'First;         --   0
-   MTL : constant := Modular_Type'Last;          -- 255
-   MTM : constant := Modular_Type'Modulus;       -- 256
-   ENP : constant := Enumeration_Type'Pos(Ay);   --   3
-   MTP : constant := Modular_Type'Pred(Modul);   --   1
-   FTS : constant := Fixed_Type'Size;            --   # impdef
-   ITS : constant := Integer_Type'Succ(Integ);   --   3
- 
-   -- array attributes 'First, 'Last, 'Length
- 
-   MAFirst : constant := Mod_Array_Object'First;  --    0
-   IALast  : constant := Int_Array_Object'Last;   -- 1023
-   MAL     : constant := Mod_Array_Object'Length; --  255
-   IAL     : constant := Int_Array_Object'Length; -- 1024
- 
-   -- type conversions
-   --
-   -- F\T Int Mod Flt Fix
-   -- Int  .   X   O   X 
-   -- Mod  O   .   X   O 
-   -- Flt  X   O   .   X 
-   -- Fix  O   X   O   . 
- 
-   Int2Mod : constant := Modular_Type (Integ);  -- 2
-   Int2Fix : constant := Fixed_Type (Integ);    -- 2.0
-   Mod2Flt : constant := Floating_Type (Modul); -- 2.0
-   Flt2Int : constant := Integer_Type(Float);   -- 2
-   Flt2Fix : constant := Fixed_Type (Float);    -- 2.0
-   Fix2Mod : constant := Modular_Type (Fixed);  -- 2
- 
-   procedure Check_Values;
- 
-   -- TRANSITION CHECKS
-   --
-   -- The following were illegal in Ada83; they are now legal in Ada95
-   --
- 
-   Int_Base_First : constant := Integer'Base'First;  -- # impdef
-   Int_First      : constant := Integer'First;       -- # impdef
-   Int_Last       : constant := Integer'Last;        -- # impdef
-   Int_Val        : constant := Integer'Val(17);     -- 17
-   
-   -- END OF TRANSITION CHECKS
- 
- end C332001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C332001_0 is
- 
-   procedure Assert( Truth : Boolean; Message: String ) is
-   begin
-     if not Truth then
-       Report.Failed("Assertion " & Message & " not true" );
-     end if;
-   end Assert;
- 
-   procedure Check_Values is
-   begin
- 
-     Assert( Nothing_New_Integer * Named_Integer = Named_Modular,
-            "Nothing_New_Integer * Named_Integer = Named_Modular" ); -- 1*2 = 2
-     Assert( Nothing_New_Real * Named_Float = Named_Fixed,
-            "Nothing_New_Real * Named_Float = Named_Fixed" );-- 1.0*2.0 = 2.0
- 
-     Assert( Fn_Integer = Int2Mod + Flt2Int,
-            "Fn_Integer = Int2Mod + Flt2Int" );              -- 4 = 2+2
-     Assert( Fn_Modular = Flt2Int * 2,
-            "Fn_Modular = Flt2Int * 2" );                    -- 4 = 2*2
-     Assert( Fn_Float   = Mod2Flt ** Fix2Mod,
-            "Fn_Float   = Mod2Flt ** Fix2Mod" );             -- 4.0 = 2.0**2
-     Assert( Fn_Fixed   = (- Mod2Flt),
-            "Fn_Fixed   = (- Mod2Flt)" );                    -- -2.0 = (-2.0)
- 
-     Assert( ITF = Modular_Type'First,
-            "ITF = Modular_Type'First" );                    -- 0 = 0
-     Assert( MTL < Integer_Type'Last,
-            "MTL < Integer_Type'Last" );                     -- 255 < 1023
-     Assert( MTM < Integer_Type'Last,
-            "MTM < Integer_Type'Last" );                     -- 256 < 1023
-     Assert( ENP > MTP,
-            "ENP > MTP" );                                   -- 3 > 1
-     Assert( (FTS < MTL) or (FTS >= MTL),  -- given FTS is impdef...
-            "(FTS < MTL) or (FTS >= MTL)" );                 -- True
-     Assert( FTS > ITS,
-            "FTS > ITS" );                                   -- impdef > 3
- 
-     Assert( MAFirst = Int_Array_Object'First,
-            "MAFirst = Int_Array_Object'First" );            -- 0 = 0
-     Assert( IALast  > MAFirst,
-            "IALast  > MAFirst" );                           -- 1023 > 0
-     Assert( MAL     < IAL,
-            "MAL     < IAL" );                               -- 255 < 1024
- 
-     Assert( Mod2Flt = Flt2Fix,
-            "Mod2Flt = Flt2Fix" );                           -- 2.0 = 2.0
- 
-   end Check_Values;
- 
- end C332001_0;
- 
- ------------------------------------------------------------------- C332001
- 
- with Report;
- with C332001_0;
- procedure C332001 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C332001", "Check that the static expression given for a " &
-                           "number declaration may be of any numeric type. " &
-                           "Check that the type of the named number is " &
-                           "universal_integer of universal_real regardless " &
-                           "of the type of the static expression that " &
-                           "provides its value" );
-    
-   C332001_0.Check_Values;
- 
-   Report.Result;
- 
- end C332001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c340001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c340001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c340001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c340001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,470 ****
- -- C340001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that user-defined equality operators are inherited by a
- --      derived type except when the derived type is a nonlimited record
- --      extension. In the latter case, ensure that the primitive
- --      equality operation of the record extension compares any extended
- --      components according to the predefined equality operators of the
- --      component types.  Also check that the parent portion of the extended
- --      type is compared using the user-defined equality operation of the
- --      parent type.
- --
- -- TEST DESCRIPTION:
- --      Declares a nonlimited tagged record and a limited tagged record
- --      type, each in a separate package. A user-defined "=" operation is
- --      defined for each type. Each type is extended with one new record
- --      component added.
- --
- --      Objects are declared for each parent and extended types and are
- --      assigned values. For the limited type, modifier operations defined
- --      in the package are used to assign values.
- --
- --      To verify the use of the user-defined "=", values are assigned so
- --      that predefined equality will return the opposite result if called.
- --      Similarly, values are assigned to the extended type objects so that
- --      one comparison will verify that the inherited components from the
- --      parent are compared using the user-defined equality operation.
- --
- --      A second comparison sets the values of the inherited components to
- --      be the same so that equality based on the extended component may be
- --      verified. For the nonlimited type, the test for equality should
- --      fail, as the "=" defined for this type should include testing
- --      equality of the extended component. For the limited type, "=" of the
- --      parent should be inherited as-is, so the test for equality should
- --      succeed even though the records differ in the extended component.
- --
- --      A third package declares a discriminated tagged record. Equality
- --      is user-defined and ignores the discriminant value. A type
- --      extension is declared which also contains a discriminant. Since
- --      an inherited discriminant may not be referenced other than in a
- --      "new" discriminant, the type extension is also discriminated. The
- --      discriminant is used as the constraint for the parent type.
- --
- --      A variant part is declared in the type extension based on the new
- --      discriminant. Comparisons are made to confirm that the user-defined
- --      equality operator is used to compare values of the type extension.
- --      Two record objects are given values so that user-defined equality
- --      for the parent portion of the record succeeds, but the variant
- --      parts in the type extended object differ. These objects are checked
- --      to ensure that they are not equal.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --
- --! 
- 
- with Ada.Calendar;
- package C340001_0 is
- 
-    type DB_Record is tagged record
-       Key : Natural range 1 .. 9999;
-       Data : String (1..10);
-    end record;
- 
-    function "=" (L, R : in DB_Record) return Boolean;
- 
-    type Dated_Record is new DB_Record with record
-       Retrieval_Time : Ada.Calendar.Time;
-    end record;
- 
- end C340001_0;
- 
- package body C340001_0 is
- 
-    function "=" (L, R : in DB_Record) return Boolean is
-    -- Key is ignored in determining equality of records
-    begin
-       return L.Data = R.Data;
-    end "=";
-    
- end C340001_0;
- 
- package C340001_1 is
- 
-    type List_Contents is array (1..10) of Integer;
-    type List is tagged limited record
-       Length   : Natural range 0..10 := 0;
-       Contents : List_Contents := (others => 0);
-    end record;
- 
-    procedure Add_To (L : in out List; New_Value : in Integer);
-    procedure Remove_From (L : in out List);
- 
-    function "=" (L, R : in List) return Boolean;
- 
-    subtype Revision_Mark is Character range 'A' .. 'Z';
-    type Revisable_List is new List with record
-       Revision : Revision_Mark := 'A';
-    end record;
- 
-    procedure Revise (L : in out Revisable_List);
- 
- end C340001_1;
- 
- package body C340001_1 is
- 
-    -- Note: This is not a complete abstraction of a list. Exceptions
-    -- are not defined and boundary checks are not made.
- 
-    procedure Add_To (L : in out List; New_Value : in Integer) is
-    begin
-       L.Length := L.Length + 1;
-       L.Contents (L.Length) := New_Value;
-    end Add_To;
- 
-    procedure Remove_From (L : in out List) is
-    -- The list length is decremented. "Old" values are left in the
-    -- array. They are overwritten when a new value is added.
-    begin
-       L.Length := L.Length - 1;
-    end Remove_From;
- 
-    function "=" (L, R : in List) return Boolean is
-    -- Two lists are equal if they are the same length and
-    -- the component values within that length are the same.
-    -- Values stored past the end of the list are ignored.
-    begin
-       return L.Length = R.Length
- 	 and then L.Contents (1..L.Length) = R.Contents (1..R.Length);
-    end "=";
- 
-    procedure Revise (L : in out Revisable_List) is
-    begin
-       L.Revision := Character'Succ (L.Revision);
-    end Revise;
-    
- end C340001_1;
- 
- package C340001_2 is
- 
-    type Media is (Paper, Electronic);
- 
-    type Transaction (Medium : Media) is tagged record
-       ID : Natural range 1000 .. 9999;
-    end record;
- 
-    function "=" (L, R : in Transaction) return Boolean;
- 
-    type Authorization (Kind : Media) is new Transaction (Medium => Kind)
-    with record
-       case Kind is
-       when Paper =>
- 	 Signature_On_File : Boolean;
-       when Electronic =>
-         Paper_Backup   : Boolean; -- to retain opposing value
-       end case;
-    end record;
- 
- end C340001_2;
- 
- package body C340001_2 is
- 
-    function "=" (L, R : in Transaction) return Boolean is
-    -- There may be electronic and paper copies of the same transaction.
-    -- The ID uniquely identifies a transaction. The medium (stored in
-    -- the discriminant) is ignored.
-    begin
-       return L.ID = R.ID;
-    end "=";
- 
- end C340001_2;
- 
- 
- with C340001_0; -- nonlimited tagged record declarations
- with C340001_1; -- limited tagged record declarations
- with C340001_2; -- tagged variant declarations
- with Ada.Calendar;
- with Report;
- procedure C340001 is
- 
-    DB_Rec1 : C340001_0.DB_Record := (Key  => 1,
- 				     Data => "aaaaaaaaaa");
-    DB_Rec2 : C340001_0.DB_Record := (Key  => 55,
- 				     Data => "aaaaaaaaaa");
-    -- DB_Rec1  = DB_Rec2 using user-defined equality
-    -- DB_Rec1 /= DB_Rec2 using predefined equality
- 
-    Some_Time : Ada.Calendar.Time :=
-       Ada.Calendar.Time_Of (Month => 9, Day => 16, Year => 1993);
- 
-    Another_Time : Ada.Calendar.Time :=
-       Ada.Calendar.Time_Of (Month => 9, Day => 19, Year => 1993);
- 
-    Dated_Rec1 : C340001_0.Dated_Record := (Key  => 2,
- 					   Data => "aaaaaaaaaa",
- 					   Retrieval_Time => Some_Time);
-    Dated_Rec2 : C340001_0.Dated_Record := (Key  => 77,
- 					   Data => "aaaaaaaaaa",
- 					   Retrieval_Time => Some_Time);
-    Dated_Rec3 : C340001_0.Dated_Record := (Key  => 77,
- 					   Data => "aaaaaaaaaa",
- 					   Retrieval_Time => Another_Time);
-    -- Dated_Rec1  = Dated_Rec2 if DB_Record."=" used for parent portion
-    -- Dated_Rec2 /= Dated_Rec3 if extended component is compared
-    --    using Ada.Calendar.Time."="
- 
-    List1 : C340001_1.List;
-    List2 : C340001_1.List;
- 
-    RList1 : C340001_1.Revisable_List;
-    RList2 : C340001_1.Revisable_List;
-    RList3 : C340001_1.Revisable_List;
- 
-    Current : C340001_2.Transaction (C340001_2.Paper) :=
-       (C340001_2.Paper, 2001);
-    Last    : C340001_2.Transaction (C340001_2.Electronic) :=
-       (C340001_2.Electronic, 2001);
-    -- Current  = Last using user-defined equality
-    -- Current /= Last using predefined equality
- 
-    Approval1 : C340001_2.Authorization (C340001_2.Paper)
-     := (Kind => C340001_2.Paper,
-         ID => 1040,
-         Signature_On_File => True);
-    Approval2 : C340001_2.Authorization (C340001_2.Paper)
-     := (Kind => C340001_2.Paper,
-         ID => 2167,
-         Signature_On_File => False);
-    Approval3 : C340001_2.Authorization (C340001_2.Electronic)
-     := (Kind => C340001_2.Electronic,
-         ID => 2167,
-         Paper_Backup => False);
-    -- Approval1 /= Approval2 if user-defined equality extended with
-    --    component equality.
-    -- Approval2 /= Approval3 if differing variant parts checked
- 
-    -- Direct visibility to operator symbols
-    use type C340001_0.DB_Record;
-    use type C340001_0.Dated_Record;
- 
-    use type C340001_1.List;
-    use type C340001_1.Revisable_List;
- 
-    use type C340001_2.Transaction;
-    use type C340001_2.Authorization;
- 
- begin
- 
-    Report.Test ("C340001", "Inheritance of user-defined ""=""");
- 
-    -- Approval1 /= Approval2 if user-defined equality extended with
-    --    component equality.
-    -- Approval2 /= Approval3 if differing variant parts checked
- 
-    ---------------------------------------------------------------------
-    -- Check that "=" and "/=" for the parent type call the user-defined
-    -- operation
-    ---------------------------------------------------------------------
- 
-    if not (DB_Rec1 = DB_Rec2) then
-       Report.Failed ("Nonlimited tagged record: " &
- 		     "User-defined equality did not override predefined " &
- 		     "equality");
-    end if;
- 
-    if DB_Rec1 /= DB_Rec2 then
-       Report.Failed ("Nonlimited tagged record: " &
- 		     "User-defined equality did not override predefined " &
- 		     "inequality as well");
-    end if;
- 
-    ---------------------------------------------------------------------
-    -- Check that "=" and "/=" for the type extension use the user-defined 
-    -- equality operations from the parent to compare the inherited
-    -- components
-    ---------------------------------------------------------------------
-    
-    if not (Dated_Rec1 = Dated_Rec2) then
-       Report.Failed ("Nonlimited tagged record: " &
- 		     "User-defined equality was not used to compare " &
- 		     "components inherited from parent");
-    end if;
- 
-    if Dated_Rec1 /= Dated_Rec2 then
-       Report.Failed ("Nonlimited tagged record: " &
- 		     "User-defined inequality was not used to compare " &
- 		     "components inherited from parent");
-    end if;
- 
-    ---------------------------------------------------------------------
-    -- Check that equality and inequality for the type extension incorporate
-    -- the predefined equality operators for the extended component type
-    ---------------------------------------------------------------------
-    if Dated_Rec2 = Dated_Rec3 then
-       Report.Failed ("Nonlimited tagged record: " &
- 		     "Record equality was not extended with component " &
- 		     "equality");
-    end if;
- 
-    if not (Dated_Rec2 /= Dated_Rec3) then
-       Report.Failed ("Nonlimited tagged record: " &
- 		     "Record inequality was not extended with component " &
- 		     "equality");
-    end if;
- 
-    ---------------------------------------------------------------------
-    C340001_1.Add_To (List1, 1);
-    C340001_1.Add_To (List1, 2);
-    C340001_1.Add_To (List1, 3);
-    C340001_1.Remove_From (List1);
- 
-    C340001_1.Add_To (List2, 1);
-    C340001_1.Add_To (List2, 2);
-    
-    -- List1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0))
-    -- List2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0))
-    
-    -- List1 = List2 using user-defined equality
-    -- List1 /= List2 using predefined equality
- 
-    ---------------------------------------------------------------------
-    -- Check that "=" and "/=" for the parent type call the user-defined
-    -- operation
-    ---------------------------------------------------------------------
-    if not (List1 = List2) then
-       Report.Failed ("Limited tagged record   : " &
- 		     "User-defined equality incorrectly implemented " );
-    end if;
-    
-    if List1 /= List2 then
-       Report.Failed ("Limited tagged record   : " &
- 		     "User-defined equality incorrectly implemented " );
-    end if;
- 
-    ---------------------------------------------------------------------
-    -- RList1 and RList2 are made equal but "different" by adding
-    -- a nonzero value to RList1 then removing it. Removal updates
-    -- the list Length only, not its contents. The two lists will be
-    -- equal according to the defined list abstraction, but the records
-    -- will contain differing component values.
- 
-    C340001_1.Add_To (RList1, 1);
-    C340001_1.Add_To (RList1, 2);
-    C340001_1.Add_To (RList1, 3);
-    C340001_1.Remove_From (RList1);
- 
-    C340001_1.Add_To (RList2, 1);
-    C340001_1.Add_To (RList2, 2);
- 
-    C340001_1.Add_To (RList3, 1);
-    C340001_1.Add_To (RList3, 2);
- 
-    C340001_1.Revise (RList3);
- 
-    -- RList1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0), 'A')
-    -- RList2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'A')
-    -- RList3 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'B')
-    
-    -- RList1 = RList2 if List."=" inherited
-    -- RList2 /= RList3 if List."=" inherited and extended with Character "="
- 
-    ---------------------------------------------------------------------
-    -- Check that "=" and "/=" are the user-defined operations inherited
-    -- from the parent type.
-    ---------------------------------------------------------------------
-    if not (RList1 = RList2) then
-       Report.Failed ("Limited tagged record   : " &
- 		     "User-defined equality was not inherited");
-    end if;
- 
-    if RList1 /= RList2 then
-       Report.Failed ("Limited tagged record   : " &
- 		     "User-defined inequality was not inherited");
-    end if;
-    ---------------------------------------------------------------------
-    -- Check that "=" and "/=" for the type extension are NOT extended
-    -- with the predefined equality operators for the extended component.
-    -- A limited type extension should inherit the parent equality operation
-    -- as is.
-    ---------------------------------------------------------------------
-    if not (RList2 = RList3) then
-       Report.Failed ("Limited tagged record   : " &
- 		     "Inherited equality operation was extended with " &
- 		     "component equality");
-    end if;
- 
-    if RList2 /= RList3 then
-       Report.Failed ("Limited tagged record   : " &
- 		     "Inherited inequality operation was extended with " &
- 		     "component equality");
-    end if;
- 
-    ---------------------------------------------------------------------
-    -- Check that "=" and "/=" for the parent type call the user-defined
-    -- operation
-    ---------------------------------------------------------------------
-    if not (Current = Last) then
-       Report.Failed ("Variant record          : " &
- 		     "User-defined equality did not override predefined " &
- 		     "equality");
-    end if;
-    
-    if Current /= Last then
-       Report.Failed ("Variant record          : " &
- 		     "User-defined inequality did not override predefined " &
- 		     "inequality");
-    end if;
- 
-    ---------------------------------------------------------------------
-    -- Check that user-defined equality was incorporated and extended
-    -- with equality of extended components.
-    ---------------------------------------------------------------------
-    if not (Approval1 /= Approval2) then
-       Report.Failed ("Variant record          : " &
- 		     "Inequality was not extended with component " &
- 		     "inequality");
-    end if;
- 
-    if Approval1 = Approval2 then
-       Report.Failed ("Variant record          : " &
- 		     "Equality was not extended with component " &
- 		     "equality");
-    end if;
-    
-    ---------------------------------------------------------------------
-    -- Check that equality and inequality for the type extension
-    -- succeed despite the presence of differing variant parts.
-    ---------------------------------------------------------------------
-    if Approval2 = Approval3 then
-       Report.Failed ("Variant record          : " &
- 		     "Equality succeeded even though variant parts " &
- 		     "in type extension differ");
-    end if;
- 
-    if not (Approval2 /= Approval3) then
-       Report.Failed ("Variant record          : " &
- 		     "Inequality failed even though variant parts " &
- 		     "in type extension differ");
-    end if;
-    
-    ---------------------------------------------------------------------
-    Report.Result;
-    ---------------------------------------------------------------------
- 
- end C340001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- C34001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- -- (IMPLICITLY) FOR DERIVED ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES.
- 
- -- JRK 8/20/86
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34001A IS
- 
-      TYPE PARENT IS (E1, E2, E3, 'A', E4, E5, E6);
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE
-                PARENT'VAL (IDENT_INT (PARENT'POS (E2))) ..
-                PARENT'VAL (IDENT_INT (PARENT'POS (E5)));
- 
-      TYPE T IS NEW SUBPARENT RANGE
-                PARENT'VAL (IDENT_INT (PARENT'POS (E3))) ..
-                PARENT'VAL (IDENT_INT (PARENT'POS (E4)));
- 
-      X : T       := E3;
-      W : PARENT  := E1;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (T'POS (X), T'POS (X)) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN T'FIRST;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34001A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES");
- 
-      X := IDENT (E4);
-      IF X /= E4 THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= E4 THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= E4 THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := E3;
-      END IF;
-      IF T (W) /= E3 THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF PARENT (X) /= E4 OR PARENT (T'VAL (0)) /= E1 THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF IDENT ('A') /= 'A' THEN
-           FAILED ("INCORRECT 'A'");
-      END IF;
- 
-      IF IDENT (E3) /= E3 OR IDENT (E4) = E1 THEN
-           FAILED ("INCORRECT ENUMERATION LITERAL");
-      END IF;
- 
-      IF X = IDENT ('A') OR X = E1 THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT (E4) OR NOT (X /= E1) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF X < IDENT (E4) OR X < E1 THEN
-           FAILED ("INCORRECT <");
-      END IF;
- 
-      IF X > IDENT (E4) OR X > E6 THEN
-           FAILED ("INCORRECT >");
-      END IF;
- 
-      IF X <= IDENT ('A') OR X <= E1 THEN
-           FAILED ("INCORRECT <=");
-      END IF;
- 
-      IF IDENT ('A') >= X OR X >= E6 THEN
-           FAILED ("INCORRECT >=");
-      END IF;
- 
-      IF NOT (X IN T) OR E1 IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (E1 NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'BASE'SIZE < 3 THEN
-           FAILED ("INCORRECT 'BASE'SIZE");
-      END IF;
- 
-      IF T'FIRST /= E3 OR T'BASE'FIRST /= E1 THEN
-           FAILED ("INCORRECT 'FIRST");
-      END IF;
- 
-      IF T'IMAGE (X) /= "E4" OR T'IMAGE (E1) /= "E1" THEN
-           FAILED ("INCORRECT 'IMAGE");
-      END IF;
- 
-      IF T'LAST /= E4 OR T'BASE'LAST /= E6 THEN
-           FAILED ("INCORRECT 'LAST");
-      END IF;
- 
-      IF T'POS (X) /= 4 OR T'POS (E1) /= 0 THEN
-           FAILED ("INCORRECT 'POS");
-      END IF;
- 
-      IF T'PRED (X) /= 'A' OR T'PRED (E2) /= E1 THEN
-           FAILED ("INCORRECT 'PRED");
-      END IF;
- 
-      IF T'SIZE < 2 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < 2 THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      IF T'SUCC (IDENT ('A')) /= X OR T'SUCC (E1) /= E2 THEN
-           FAILED ("INCORRECT 'SUCC");
-      END IF;
- 
-      IF T'VAL (IDENT_INT (4)) /= X OR T'VAL (0) /= E1 THEN
-           FAILED ("INCORRECT 'VAL");
-      END IF;
- 
-      IF T'VALUE (IDENT_STR ("E4")) /= X OR T'VALUE ("E1") /= E1 THEN
-           FAILED ("INCORRECT 'VALUE");
-      END IF;
- 
-      IF T'WIDTH /= 3 OR T'BASE'WIDTH /= 3 THEN
-           FAILED ("INCORRECT 'WIDTH");
-      END IF;
- 
-      RESULT;
- END C34001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- C34001C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 8/20/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34001C IS
- 
-      TYPE PARENT IS (E1, E2, E3, 'A', E4, E5, E6);
- 
-      TYPE T IS NEW PARENT RANGE
-                PARENT'VAL (IDENT_INT (PARENT'POS (E3))) ..
-                PARENT'VAL (IDENT_INT (PARENT'POS (E4)));
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE E3 .. E4;
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
- BEGIN
-      TEST ("C34001C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF T'BASE'FIRST /= E1 OR T'BASE'LAST /= E6 OR
-         S'BASE'FIRST /= E1 OR S'BASE'LAST /= E6 THEN
-           FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
-      END IF;
- 
-      IF T'PRED (E2) /= E1 OR T'SUCC (E1) /= E2 OR
-         S'PRED (E2) /= E1 OR S'SUCC (E1) /= E2 THEN
-           FAILED ("INCORRECT 'PRED OR 'SUCC");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= E3 OR T'LAST /= E4 OR
-         S'FIRST /= E3 OR S'LAST /= E4 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := E3;
-           Y := E3;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-           END IF;
-           X := E4;
-           Y := E4;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := E2;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := E2");
-           IF X = E2 THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := E2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := E2");
-      END;
- 
-      BEGIN
-           X := E5;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := E5");
-           IF X = E5 THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := E5");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := E5");
-      END;
- 
-      BEGIN
-           Y := E2;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := E2");
-           IF Y = E2 THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := E2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := E2");
-      END;
- 
-      BEGIN
-           Y := E5;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := E5");
-           IF Y = E5 THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := E5");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := E5");
-      END;
- 
-      RESULT;
- END C34001C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,209 ****
- -- C34001D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- -- (IMPLICITLY) FOR DERIVED BOOLEAN TYPES.
- 
- -- JRK 8/20/86
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34001D IS
- 
-      SUBTYPE PARENT IS BOOLEAN;
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE
-                PARENT'VAL (IDENT_INT (PARENT'POS (FALSE))) ..
-                PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
- 
-      TYPE T IS NEW SUBPARENT RANGE
-                PARENT'VAL (IDENT_INT (PARENT'POS (TRUE))) ..
-                PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
- 
-      X : T       := TRUE;
-      W : PARENT  := FALSE;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (T'POS (X), T'POS (X)) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN T'FIRST;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34001D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "BOOLEAN TYPES");
- 
-      X := IDENT (TRUE);
-      IF X /= TRUE THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= TRUE THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= TRUE THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := TRUE;
-      END IF;
-      IF T (W) /= TRUE THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF PARENT (X) /= TRUE OR PARENT (T'VAL (0)) /= FALSE THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF IDENT (TRUE) /= TRUE OR IDENT (TRUE) = FALSE THEN
-           FAILED ("INCORRECT ENUMERATION LITERAL");
-      END IF;
- 
-      IF NOT X /= FALSE OR NOT FALSE /= X THEN
-           FAILED ("INCORRECT ""NOT""");
-      END IF;
- 
-      IF (X AND IDENT (TRUE)) /= TRUE OR (X AND FALSE) /= FALSE THEN
-           FAILED ("INCORRECT ""AND""");
-      END IF;
- 
-      IF (X OR IDENT (TRUE)) /= TRUE OR (FALSE OR X) /= TRUE THEN
-           FAILED ("INCORRECT ""OR""");
-      END IF;
- 
-      IF (X XOR IDENT (TRUE)) /= FALSE OR (X XOR FALSE) /= TRUE THEN
-           FAILED ("INCORRECT ""XOR""");
-      END IF;
- 
-      IF (X AND THEN IDENT (TRUE)) /= TRUE OR
-         (X AND THEN FALSE) /= FALSE THEN
-           FAILED ("INCORRECT ""AND THEN""");
-      END IF;
- 
-      IF (X OR ELSE IDENT (TRUE)) /= TRUE OR
-         (FALSE OR ELSE X) /= TRUE THEN
-           FAILED ("INCORRECT ""OR ELSE""");
-      END IF;
- 
-      IF NOT (X = IDENT (TRUE)) OR X = FALSE THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT (TRUE) OR NOT (X /= FALSE) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF X < IDENT (TRUE) OR X < FALSE THEN
-           FAILED ("INCORRECT <");
-      END IF;
- 
-      IF X > IDENT (TRUE) OR FALSE > X THEN
-           FAILED ("INCORRECT >");
-      END IF;
- 
-      IF NOT (X <= IDENT (TRUE)) OR X <= FALSE THEN
-           FAILED ("INCORRECT <=");
-      END IF;
- 
-      IF NOT (X >= IDENT (TRUE)) OR FALSE >= X THEN
-           FAILED ("INCORRECT >=");
-      END IF;
- 
-      IF NOT (X IN T) OR FALSE IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (FALSE NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'BASE'SIZE < 1 THEN
-           FAILED ("INCORRECT 'BASE'SIZE");
-      END IF;
- 
-      IF T'FIRST /= TRUE OR T'BASE'FIRST /= FALSE THEN
-           FAILED ("INCORRECT 'FIRST");
-      END IF;
- 
-      IF T'IMAGE (X) /= "TRUE" OR T'IMAGE (FALSE) /= "FALSE" THEN
-           FAILED ("INCORRECT 'IMAGE");
-      END IF;
- 
-      IF T'LAST /= TRUE OR T'BASE'LAST /= TRUE THEN
-           FAILED ("INCORRECT 'LAST");
-      END IF;
- 
-      IF T'POS (X) /= 1 OR T'POS (FALSE) /= 0 THEN
-           FAILED ("INCORRECT 'POS");
-      END IF;
- 
-      IF T'PRED (X) /= FALSE THEN
-           FAILED ("INCORRECT 'PRED");
-      END IF;
- 
-      IF T'SIZE < 1 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < 1 THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      IF T'SUCC (T'VAL (IDENT_INT (0))) /= X THEN
-           FAILED ("INCORRECT 'SUCC");
-      END IF;
- 
-      IF T'VAL (IDENT_INT (1)) /= X OR T'VAL (0) /= FALSE THEN
-           FAILED ("INCORRECT 'VAL");
-      END IF;
- 
-      IF T'VALUE (IDENT_STR ("TRUE")) /= X OR
-         T'VALUE ("FALSE") /= FALSE THEN
-           FAILED ("INCORRECT 'VALUE");
-      END IF;
- 
-      IF T'WIDTH /= 4 OR T'BASE'WIDTH /= 5 THEN
-           FAILED ("INCORRECT 'WIDTH");
-      END IF;
- 
-      RESULT;
- END C34001D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34001f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34001f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- C34001F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED BOOLEAN TYPES:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 8/20/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34001F IS
- 
-      SUBTYPE PARENT IS BOOLEAN;
- 
-      TYPE T IS NEW PARENT RANGE
-                PARENT'VAL (IDENT_INT (PARENT'POS (FALSE))) ..
-                PARENT'VAL (IDENT_INT (PARENT'POS (FALSE)));
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE TRUE .. TRUE;
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
- BEGIN
-      TEST ("C34001F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "BOOLEAN TYPES");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF T'BASE'FIRST /= FALSE OR T'BASE'LAST /= TRUE OR
-         S'BASE'FIRST /= FALSE OR S'BASE'LAST /= TRUE THEN
-           FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
-      END IF;
- 
-      IF T'PRED (TRUE) /= FALSE OR T'SUCC (FALSE) /= TRUE OR
-         S'PRED (TRUE) /= FALSE OR S'SUCC (FALSE) /= TRUE THEN
-           FAILED ("INCORRECT 'PRED OR 'SUCC");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= FALSE OR T'LAST /= FALSE OR
-         S'FIRST /= TRUE  OR S'LAST /= TRUE  THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := FALSE;
-           Y := TRUE;
-           IF NOT PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := TRUE;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := TRUE");
-           IF X = TRUE THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := TRUE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := TRUE");
-      END;
- 
-      BEGIN
-           Y := FALSE;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := FALSE");
-           IF Y = FALSE THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := FALSE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := FALSE");
-      END;
- 
-      RESULT;
- END C34001F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34002a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,265 ****
- -- C34002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- -- (IMPLICITLY) FOR DERIVED INTEGER TYPES.
- 
- -- JRK 8/21/86
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34002A IS
- 
-      TYPE PARENT IS RANGE -100 .. 100;
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE
-                PARENT'VAL (IDENT_INT (-50)) ..
-                PARENT'VAL (IDENT_INT ( 50));
- 
-      TYPE T IS NEW SUBPARENT RANGE
-                PARENT'VAL (IDENT_INT (-30)) ..
-                PARENT'VAL (IDENT_INT ( 30));
- 
-      TYPE FIXED IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
- 
-      X : T        := -30;
-      W : PARENT   := -100;
-      N : CONSTANT := 1;
-      M : CONSTANT := 100;
-      B : BOOLEAN  := FALSE;
-      F : FLOAT    := 0.0;
-      G : FIXED    := 0.0;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (T'POS (X), T'POS (X)) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN T'FIRST;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34002A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "INTEGER TYPES");
- 
-      X := IDENT (30);
-      IF X /= 30 THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= 30 THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= 30 THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := -30;
-      END IF;
-      IF T (W) /= -30 THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF PARENT (X) /= 30 OR PARENT (T'VAL (-100)) /= -100 THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF T (IDENT_INT (-30)) /= -30 THEN
-           FAILED ("INCORRECT CONVERSION FROM INTEGER");
-      END IF;
- 
-      IF INTEGER (X) /= 30 OR INTEGER (T'VAL (-100)) /= -100 THEN
-           FAILED ("INCORRECT CONVERSION TO INTEGER");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           F := -30.0;
-      END IF;
-      IF T (F) /= -30 THEN
-           FAILED ("INCORRECT CONVERSION FROM FLOAT");
-      END IF;
- 
-      IF FLOAT (X) /= 30.0 OR FLOAT (T'VAL (-100)) /= -100.0 THEN
-           FAILED ("INCORRECT CONVERSION TO FLOAT");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           G := -30.0;
-      END IF;
-      IF T (G) /= -30 THEN
-           FAILED ("INCORRECT CONVERSION FROM FIXED");
-      END IF;
- 
-      IF FIXED (X) /= 30.0 OR FIXED (T'VAL (-100)) /= -100.0 THEN
-           FAILED ("INCORRECT CONVERSION TO FIXED");
-      END IF;
- 
-      IF IDENT (N) /= 1 OR X = M THEN
-           FAILED ("INCORRECT IMPLICIT CONVERSION");
-      END IF;
- 
-      IF IDENT (30) /= 30 OR X = 100 THEN
-           FAILED ("INCORRECT INTEGER LITERAL");
-      END IF;
- 
-      IF X = IDENT (0) OR X = 100 THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT (30) OR NOT (X /= 100) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF X < IDENT (30) OR 100 < X THEN
-           FAILED ("INCORRECT <");
-      END IF;
- 
-      IF X > IDENT (30) OR X > 100 THEN
-           FAILED ("INCORRECT >");
-      END IF;
- 
-      IF X <= IDENT (0) OR 100 <= X THEN
-           FAILED ("INCORRECT <=");
-      END IF;
- 
-      IF IDENT (0) >= X OR X >= 100 THEN
-           FAILED ("INCORRECT >=");
-      END IF;
- 
-      IF NOT (X IN T) OR 100 IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (100 NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      IF +X /= 30 OR +T'VAL(-100) /= -100 THEN
-           FAILED ("INCORRECT UNARY +");
-      END IF;
- 
-      IF -X /= 0 - 30 OR -T'VAL(-100) /= 100 THEN
-           FAILED ("INCORRECT UNARY -");
-      END IF;
- 
-      IF ABS X /= 30 OR ABS T'VAL (-100) /= 100 THEN
-           FAILED ("INCORRECT ABS");
-      END IF;
- 
-      IF X + IDENT (-1) /= 29 OR X + 70 /= 100 THEN
-           FAILED ("INCORRECT BINARY +");
-      END IF;
- 
-      IF X - IDENT (30) /= 0 OR X - 100 /= -70 THEN
-           FAILED ("INCORRECT BINARY -");
-      END IF;
- 
-      IF X * IDENT (-1) /= -30 OR IDENT (2) * 50 /= 100 THEN
-           FAILED ("INCORRECT *");
-      END IF;
- 
-      IF X / IDENT (3) /= 10 OR 90 / X /= 3 THEN
-           FAILED ("INCORRECT /");
-      END IF;
- 
-      IF X MOD IDENT (7) /= 2 OR 100 MOD X /= 10 THEN
-           FAILED ("INCORRECT MOD");
-      END IF;
- 
-      IF X REM IDENT (7) /= 2 OR 100 REM X /= 10 THEN
-           FAILED ("INCORRECT REM");
-      END IF;
- 
-      IF X ** IDENT_INT (1) /= 30 OR
-         T'VAL (100) ** IDENT_INT (1) /= 100 THEN
-           FAILED ("INCORRECT **");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'BASE'SIZE < 8 THEN
-           FAILED ("INCORRECT 'BASE'SIZE");
-      END IF;
- 
-      IF T'FIRST /= -30 OR
-         T'POS (T'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) THEN
-           FAILED ("INCORRECT 'FIRST");
-      END IF;
- 
-      IF T'IMAGE (X) /= " 30" OR T'IMAGE (-100) /= "-100" THEN
-           FAILED ("INCORRECT 'IMAGE");
-      END IF;
- 
-      IF T'LAST /= 30 OR
-         T'POS (T'BASE'LAST) /= PARENT'POS (PARENT'BASE'LAST) THEN
-           FAILED ("INCORRECT 'LAST");
-      END IF;
- 
-      IF T'POS (X) /= 30 OR T'POS (-100) /= -100 THEN
-           FAILED ("INCORRECT 'POS");
-      END IF;
- 
-      IF T'PRED (X) /= 29 OR T'PRED (100) /= 99 THEN
-           FAILED ("INCORRECT 'PRED");
-      END IF;
- 
-      IF T'SIZE < 6 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < 6 THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      IF T'SUCC (IDENT (29)) /= X OR T'SUCC (99) /= 100 THEN
-           FAILED ("INCORRECT 'SUCC");
-      END IF;
- 
-      IF T'VAL (IDENT_INT (30)) /= X OR T'VAL (100) /= 100 THEN
-           FAILED ("INCORRECT 'VAL");
-      END IF;
- 
-      IF T'VALUE (IDENT_STR ("30")) /= X OR T'VALUE ("100") /= 100 THEN
-           FAILED ("INCORRECT 'VALUE");
-      END IF;
- 
-      IF T'WIDTH /= 3 OR T'BASE'WIDTH < 4 THEN
-           FAILED ("INCORRECT 'WIDTH");
-      END IF;
- 
-      RESULT;
- END C34002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34002c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34002c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34002c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C34002C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED INTEGER TYPES:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 8/21/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34002C IS
- 
-      TYPE PARENT IS RANGE -100 .. 100;
- 
-      TYPE T IS NEW PARENT RANGE
-                PARENT'VAL (IDENT_INT (-30)) ..
-                PARENT'VAL (IDENT_INT ( 30));
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE -30 .. 30;
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
- BEGIN
-      TEST ("C34002C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "INTEGER TYPES");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF T'POS (T'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) OR
-         S'POS (S'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) OR
-         T'POS (T'BASE'LAST)  /= PARENT'POS (PARENT'BASE'LAST)  OR
-         S'POS (S'BASE'LAST)  /= PARENT'POS (PARENT'BASE'LAST)  THEN
-           FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
-      END IF;
- 
-      IF T'PRED (100) /= 99 OR T'SUCC (99) /= 100 OR
-         S'PRED (100) /= 99 OR S'SUCC (99) /= 100 THEN
-           FAILED ("INCORRECT 'PRED OR 'SUCC");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= -30 OR T'LAST /= 30 OR
-         S'FIRST /= -30 OR S'LAST /= 30 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := -30;
-           Y := -30;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-           END IF;
-           X := 30;
-           Y := 30;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := -31;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := -31");
-           IF X = -31 THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := -31");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := -31");
-      END;
- 
-      BEGIN
-           X := 31;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := 31");
-           IF X = 31 THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := 31");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := 31");
-      END;
- 
-      BEGIN
-           Y := -31;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := -31");
-           IF Y = -31 THEN -- USE Y.
-                COMMENT ("Y ALTERED -- Y := -31");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := -31");
-      END;
- 
-      BEGIN
-           Y := 31;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := 31");
-           IF Y = 31 THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := 31");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := 31");
-      END;
- 
-      RESULT;
- END C34002C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34003a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,260 ****
- -- C34003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- -- (IMPLICITLY) FOR DERIVED FLOATING POINT TYPES.
- 
- -- JRK 9/4/86
- -- GJD 11/14/95  REMOVED USES OF OBSOLETE ADA 83 ATTRIBUTES.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34003A IS
- 
-      TYPE PARENT IS DIGITS 5;
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE
-                PARENT (IDENT_INT (-50)) ..
-                PARENT (IDENT_INT ( 50));
- 
-      TYPE T IS NEW SUBPARENT DIGITS 4 RANGE
-                PARENT (IDENT_INT (-30)) ..
-                PARENT (IDENT_INT ( 30));
- 
-      TYPE FIXED IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
- 
-      X : T        := -30.0;
-      W : PARENT   := -100.0;
-      R : CONSTANT := 1.0;
-      M : CONSTANT := 100.0;
-      B : BOOLEAN  := FALSE;
-      F : FLOAT    := 0.0;
-      G : FIXED    := 0.0;
- 
-      Z : CONSTANT T := 0.0;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN T'FIRST;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34003A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "FLOATING POINT TYPES");
- 
-      X := IDENT (30.0);
-      IF X /= 30.0 THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= 30.0 THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= 30.0 THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := -30.0;
-      END IF;
-      IF T (W) /= -30.0 THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF T (IDENT_INT (-30)) /= -30.0 THEN
-           FAILED ("INCORRECT CONVERSION FROM INTEGER");
-      END IF;
- 
-      IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
-           FAILED ("INCORRECT CONVERSION TO INTEGER");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           F := -30.0;
-      END IF;
-      IF T (F) /= -30.0 THEN
-           FAILED ("INCORRECT CONVERSION FROM FLOAT");
-      END IF;
- 
-      IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
-           FAILED ("INCORRECT CONVERSION TO FLOAT");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           G := -30.0;
-      END IF;
-      IF T (G) /= -30.0 THEN
-           FAILED ("INCORRECT CONVERSION FROM FIXED");
-      END IF;
- 
-      IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
-           FAILED ("INCORRECT CONVERSION TO FIXED");
-      END IF;
- 
-      IF IDENT (R) /= 1.0 OR X = M THEN
-           FAILED ("INCORRECT IMPLICIT CONVERSION");
-      END IF;
- 
-      IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
-           FAILED ("INCORRECT REAL LITERAL");
-      END IF;
- 
-      IF X = IDENT (0.0) OR X = 100.0 THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF X < IDENT (30.0) OR 100.0 < X THEN
-           FAILED ("INCORRECT <");
-      END IF;
- 
-      IF X > IDENT (30.0) OR X > 100.0 THEN
-           FAILED ("INCORRECT >");
-      END IF;
- 
-      IF X <= IDENT (0.0) OR 100.0 <= X THEN
-           FAILED ("INCORRECT <=");
-      END IF;
- 
-      IF IDENT (0.0) >= X OR X >= 100.0 THEN
-           FAILED ("INCORRECT >=");
-      END IF;
- 
-      IF NOT (X IN T) OR 100.0 IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
-           FAILED ("INCORRECT UNARY +");
-      END IF;
- 
-      IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
-           FAILED ("INCORRECT UNARY -");
-      END IF;
- 
-      IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
-           FAILED ("INCORRECT ABS");
-      END IF;
- 
-      IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
-           FAILED ("INCORRECT BINARY +");
-      END IF;
- 
-      IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
-           FAILED ("INCORRECT BINARY -");
-      END IF;
- 
-      IF X * IDENT (-1.0) /= -30.0 OR IDENT (2.0) * 50.0 /= 100.0 THEN
-           FAILED ("INCORRECT *");
-      END IF;
- 
-      IF X / IDENT (3.0) /= 10.0 OR 90.0 / X /= 3.0 THEN
-           FAILED ("INCORRECT /");
-      END IF;
- 
-      IF X ** IDENT_INT (1) /= 30.0 OR
-         (Z + 100.0) ** IDENT_INT (1) /= 100.0 THEN
-           FAILED ("INCORRECT **");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'BASE'SIZE < 27 THEN
-           FAILED ("INCORRECT 'BASE'SIZE");
-      END IF;
- 
-      IF T'DIGITS /= 4 OR T'BASE'DIGITS < 5 THEN
-           FAILED ("INCORRECT 'DIGITS");
-      END IF;
- 
-      IF T'FIRST /= -30.0 THEN
-           FAILED ("INCORRECT 'FIRST");
-      END IF;
- 
-      IF T'LAST /= 30.0 THEN
-           FAILED ("INCORRECT 'LAST");
-      END IF;
- 
-      IF T'MACHINE_EMAX < 1 OR T'BASE'MACHINE_EMAX /= T'MACHINE_EMAX THEN
-           FAILED ("INCORRECT 'MACHINE_EMAX");
-      END IF;
- 
-      IF T'MACHINE_EMIN > -1 OR T'BASE'MACHINE_EMIN /= T'MACHINE_EMIN THEN
-           FAILED ("INCORRECT 'MACHINE_EMIN");
-      END IF;
- 
-      IF T'MACHINE_MANTISSA < 1 OR
-         T'BASE'MACHINE_MANTISSA /= T'MACHINE_MANTISSA THEN
-           FAILED ("INCORRECT 'MACHINE_MANTISSA");
-      END IF;
- 
-      IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN
-           FAILED ("INCORRECT 'MACHINE_OVERFLOWS");
-      END IF;
- 
-      IF T'MACHINE_RADIX < 2 OR
-         T'BASE'MACHINE_RADIX /= T'MACHINE_RADIX THEN
-           FAILED ("INCORRECT 'MACHINE_RADIX");
-      END IF;
- 
-      IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN
-           FAILED ("INCORRECT 'MACHINE_ROUNDS");
-      END IF;
- 
-      IF T'SIZE < 23 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < 23 THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34003c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34003c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34003c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34003c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- C34003C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED FLOATING POINT TYPES:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 9/4/86
- -- GJD 11/15/95  REMOVED USES OF OBSOLETE ADA 83 ATTRIBUTE (SAFE_LARGE).
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34003C IS
- 
-      TYPE PARENT IS DIGITS 5;
- 
-      TYPE T IS NEW PARENT DIGITS 4 RANGE
-                PARENT (IDENT_INT (-30)) ..
-                PARENT (IDENT_INT ( 30));
- 
-      SUBTYPE SUBPARENT IS PARENT DIGITS 4 RANGE -30.0 .. 30.0;
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
- BEGIN
-      TEST ("C34003C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "FLOATING POINT TYPES");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF T'BASE'DIGITS < 5 OR S'BASE'DIGITS < 5 THEN
-           FAILED ("INCORRECT 'BASE'DIGITS");
-      END IF;
- 
-      IF  12344.0 + T'(1.0) + 1.0 /=  12346.0 OR
-          12344.0 + S'(1.0) + 1.0 /=  12346.0 OR
-         -12344.0 - T'(1.0) - 1.0 /= -12346.0 OR
-         -12344.0 - S'(1.0) - 1.0 /= -12346.0 THEN
-           FAILED ("INCORRECT + OR -");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'DIGITS /= 4 OR S'DIGITS /= 4 THEN
-           FAILED ("INCORRECT 'DIGITS");
-      END IF;
- 
-      IF T'FIRST /= -30.0 OR T'LAST /= 30.0 OR
-         S'FIRST /= -30.0 OR S'LAST /= 30.0 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := -30.0;
-           Y := -30.0;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-           END IF;
-           X := 30.0;
-           Y := 30.0;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := -31.0;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := -31.0");
-           IF X = -31.0 THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := -31.0");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := -31.0");
-      END;
- 
-      BEGIN
-           X := 31.0;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := 31.0");
-           IF X = 31.0 THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := 31.0");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := 31.0");
-      END;
- 
-      BEGIN
-           Y := -31.0;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := -31.0");
-           IF Y = -31.0 THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := -31.0");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := -31.0");
-      END;
- 
-      BEGIN
-           Y := 31.0;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := 31.0");
-           IF Y = 31.0 THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := 31.0");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := 31.0");
-      END;
- 
-      RESULT;
- END C34003C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34004a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- C34004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --      (IMPLICITLY) FOR DERIVED FIXED POINT TYPES.
- 
- -- HISTORY:
- --      JRK 09/08/86  CREATED ORIGINAL TEST.
- --      JET 08/06/87  FIXED BUGS IN DELTAS AND RANGE ERROR.
- --      JET 09/22/88  CHANGED USAGE OF X'SIZE.
- --      RDH 04/16/90  ADDED TEST FOR REAL VARIABLE VALUES.
- --      THS 09/25/90  REMOVED ALL REFERENCES TO B, MODIFIED CHECK OF
- --                    '=', INITIALIZED Z NON-STATICALLY, MOVED BINARY
- --                    CHECKS.
- --      DTN 11/30/95  REMOVED NON ADA95 ATTRIBUTES.               
- --      KAS 03/04/96  REMOVED COMPARISON OF T'SMALL TO T'BASE'SMALL
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34004A IS
- 
-      TYPE PARENT IS DELTA 2.0 ** (-7) RANGE -100.0 .. 100.0;
- 
-      SUBTYPE SUBPARENT IS PARENT RANGE
-                IDENT_INT (1) * (-50.0) ..
-                IDENT_INT (1) * ( 50.0);
- 
-      TYPE T IS NEW SUBPARENT DELTA 2.0 ** (-4) RANGE
-                IDENT_INT (1) * (-30.0) ..
-                IDENT_INT (1) * ( 30.0);
- 
-      TYPE FIXED IS DELTA 2.0 ** (-4) RANGE -1000.0 .. 1000.0;
- 
-      X : T        := -30.0;
-      I : INTEGER  := X'SIZE;  --CHECK FOR THE AVAILABILITY OF 'SIZE.
-      W : PARENT   := -100.0;
-      R : CONSTANT := 1.0;
-      M : CONSTANT := 100.0;
-      F : FLOAT    := 0.0;
-      G : FIXED    := 0.0;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN T'FIRST;
-      END IDENT;
- 
- BEGIN
- 
-      DECLARE
-           Z : CONSTANT T := IDENT(0.0);
-      BEGIN
-           TEST ("C34004A", "CHECK THAT THE REQUIRED PREDEFINED " &
-                            "OPERATIONS ARE DECLARED (IMPLICITLY) " &
-                            "FOR DERIVED FIXED POINT TYPES");
- 
-           X := IDENT (30.0);
-           IF X /= 30.0 THEN
-                FAILED ("INCORRECT :=");
-           END IF;
- 
-           IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
-                FAILED ("INCORRECT BINARY +");
-           END IF;
- 
-           IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
-                FAILED ("INCORRECT BINARY -");
-           END IF;
- 
-           IF T'(X) /= 30.0 THEN
-                FAILED ("INCORRECT QUALIFICATION");
-           END IF;
- 
-           IF T (X) /= 30.0 THEN
-                FAILED ("INCORRECT SELF CONVERSION");
-           END IF;
- 
-           IF EQUAL (3, 3) THEN
-                W := -30.0;
-           END IF;
-           IF T (W) /= -30.0 THEN
-                FAILED ("INCORRECT CONVERSION FROM PARENT");
-           END IF;
- 
-           IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
- 
-           IF T (IDENT_INT (-30)) /= -30.0 THEN
-                FAILED ("INCORRECT CONVERSION FROM INTEGER");
-           END IF;
- 
-           IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
-                FAILED ("INCORRECT CONVERSION TO INTEGER");
-           END IF;
- 
-           IF EQUAL (3, 3) THEN
-                F := -30.0;
-           END IF;
-           IF T (F) /= -30.0 THEN
-                FAILED ("INCORRECT CONVERSION FROM FLOAT");
-           END IF;
- 
-           IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
-                FAILED ("INCORRECT CONVERSION TO FLOAT");
-           END IF;
- 
-           IF EQUAL (3, 3) THEN
-                G := -30.0;
-           END IF;
-           IF T (G) /= -30.0 THEN
-                FAILED ("INCORRECT CONVERSION FROM FIXED");
-           END IF;
- 
-           IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
-                FAILED ("INCORRECT CONVERSION TO FIXED");
-           END IF;
- 
-           IF IDENT (R) /= 1.0 OR X = M THEN
-                FAILED ("INCORRECT IMPLICIT CONVERSION");
-           END IF;
- 
-           IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
-                FAILED ("INCORRECT REAL LITERAL");
-           END IF;
- 
-           IF NOT (X = IDENT (30.0)) THEN
-                FAILED ("INCORRECT =");
-           END IF;
- 
-           IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
-                FAILED ("INCORRECT /=");
-           END IF;
- 
-           IF X < IDENT (30.0) OR 100.0 < X THEN
-                FAILED ("INCORRECT <");
-           END IF;
- 
-           IF X > IDENT (30.0) OR X > 100.0 THEN
-                FAILED ("INCORRECT >");
-           END IF;
- 
-           IF X <= IDENT (0.0) OR 100.0 <= X THEN
-                FAILED ("INCORRECT <=");
-           END IF;
- 
-           IF IDENT (0.0) >= X OR X >= 100.0 THEN
-                FAILED ("INCORRECT >=");
-           END IF;
- 
-           IF NOT (X IN T) OR 100.0 IN T THEN
-                FAILED ("INCORRECT ""IN""");
-           END IF;
- 
-           IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
-                FAILED ("INCORRECT ""NOT IN""");
-           END IF;
- 
-           IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
-                FAILED ("INCORRECT UNARY +");
-           END IF;
- 
-           IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
-                FAILED ("INCORRECT UNARY -");
-           END IF;
- 
-           IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
-                FAILED ("INCORRECT ABS");
-           END IF;
- 
-           IF T (X * IDENT (-1.0)) /= -30.0 OR
-              T (IDENT (2.0) * (Z + 15.0)) /= 30.0 THEN
-                FAILED ("INCORRECT * (FIXED, FIXED)");
-           END IF;
- 
-           IF X * IDENT_INT (-1) /= -30.0 OR
-              (Z + 50.0) * 2 /= 100.0 THEN
-                FAILED ("INCORRECT * (FIXED, INTEGER)");
-           END IF;
- 
-           IF IDENT_INT (-1) * X /= -30.0 OR
-              2 * (Z + 50.0) /= 100.0 THEN
-                FAILED ("INCORRECT * (INTEGER, FIXED)");
-           END IF;
- 
-           IF T (X / IDENT (3.0)) /= 10.0 OR
-              T ((Z + 90.0) / X) /= 3.0 THEN
-                FAILED ("INCORRECT / (FIXED, FIXED)");
-           END IF;
- 
-           IF X / IDENT_INT (3) /= 10.0 OR (Z + 90.0) / 30 /= 3.0 THEN
-                FAILED ("INCORRECT / (FIXED, INTEGER)");
-           END IF;
- 
-           A (X'ADDRESS);
- 
-           IF T'AFT /= 2 OR T'BASE'AFT < 3 THEN
-                FAILED ("INCORRECT 'AFT");
-           END IF;
- 
-           IF T'BASE'SIZE < 15 THEN
-                FAILED ("INCORRECT 'BASE'SIZE");
-           END IF;
- 
-           IF T'DELTA /= 2.0 ** (-4) OR T'BASE'DELTA > 2.0 ** (-7) THEN
-                FAILED ("INCORRECT 'DELTA");
-           END IF;
- 
- 
-           IF T'FORE /= 3 OR T'BASE'FORE < 4 THEN
-                FAILED ("INCORRECT 'FORE");
-           END IF;
- 
- 
- 
-           IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN
-                FAILED ("INCORRECT 'MACHINE_OVERFLOWS");
-           END IF;
- 
-           IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN
-                FAILED ("INCORRECT 'MACHINE_ROUNDS");
-           END IF;
- 
- 
- 
- 
-           IF T'SIZE < 10 THEN
-                FAILED ("INCORRECT TYPE'SIZE");
-           END IF;
- 
-           IF T'SMALL > 2.0 ** (-4) OR T'BASE'SMALL > 2.0 ** (-7) THEN
-                FAILED ("INCORRECT 'SMALL");
-           END IF;
-      END;
- 
-      RESULT;
- END C34004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34004c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34004c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34004c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C34004C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED FIXED POINT TYPES:
- 
- --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
- --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --     CONSTRAINED.
- 
- --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --     IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 09/08/86
- --     JLH 09/25/87  REFORMATTED HEADER.
- --     JRL 03/13/92  MODIFIED TO DEFEAT OPTIMIZATION WHEN ATTEMPTING TO
- --                   RAISE CONSTRAINT_ERROR.
- --     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
- --     DTN 11/30/95  REMOVED NON ADA95 ATTRIBUTES.               
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34004C IS
- 
-      TYPE PARENT IS DELTA 0.01 RANGE -100.0 .. 100.0;
- 
-      TYPE T IS NEW PARENT DELTA 0.1 RANGE
-                IDENT_INT (1) * (-30.0) ..
-                IDENT_INT (1) * ( 30.0);
- 
-      SUBTYPE SUBPARENT IS PARENT DELTA 0.1 RANGE -30.0 .. 30.0;
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X,XA : T;
-      Y,YA : S;
- 
- 
-      FUNCTION OUT_OF_BOUNDS ( VAR1 , VAR2 : T ) RETURN BOOLEAN IS
-      BEGIN
-         IF ( VAR1 + VAR2 ) IN T THEN
-            RETURN FALSE ;
-         ELSE
-            RETURN TRUE ;
-         END IF ;
-      EXCEPTION
-         WHEN CONSTRAINT_ERROR =>
-            RETURN TRUE ;
-      END OUT_OF_BOUNDS ;
- 
- 
-      FUNCTION OUT_OF_BOUNDS ( VAR1 , VAR2 : S ) RETURN BOOLEAN IS
-      BEGIN
-         IF ( VAR1 + VAR2 ) IN S THEN
-            RETURN FALSE ;
-         ELSE
-            RETURN TRUE ;
-         END IF ;
-      EXCEPTION
-         WHEN CONSTRAINT_ERROR =>
-            RETURN TRUE ;
-      END OUT_OF_BOUNDS ;
- 
- 
- BEGIN
-      TEST ("C34004C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "FIXED POINT TYPES");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      DECLARE
-           TBD : CONSTANT := BOOLEAN'POS (T'BASE'DELTA <= 0.01);
-           SBD : CONSTANT := BOOLEAN'POS (S'BASE'DELTA <= 0.01);
-      BEGIN
-           IF TBD = 0 OR SBD = 0 THEN
-                FAILED ("INCORRECT 'BASE'DELTA");
-           END IF;
-      END;
- 
- 
-      DECLARE
-           N : INTEGER := IDENT_INT (8);
-      BEGIN
-           IF  98.0 + T'(1.0) + N * 0.0078125 /=  99.0625 OR
-               98.0 + S'(1.0) + 8 * 0.0078125 /=  99.0625 OR
-              -98.0 - T'(1.0) - N * 0.0078125 /= -99.0625 OR
-              -98.0 - S'(1.0) - 8 * 0.0078125 /= -99.0625 THEN
-                FAILED ("INCORRECT + OR -");
-           END IF;
-      END;
- 
- 
-      IF T'FIRST /= -30.0 OR T'LAST /= 30.0 OR
-         S'FIRST /= -30.0 OR S'LAST /= 30.0 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := -30.0;
-           Y := -30.0;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-           END IF;
-           X := 30.0;
-           Y := 30.0;
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
- 
-      BEGIN
-           X  := -30.0 ;
-           XA := -0.0625 ;
-           IF NOT OUT_OF_BOUNDS ( X , XA ) THEN
-              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- X := -30.0625" ) ;
-           END IF ;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := -30.0625");
-      END;
- 
- 
-      BEGIN
-           X  := 30.0 ;
-           XA := 0.0625 ;
-           IF NOT OUT_OF_BOUNDS ( X , XA ) THEN
-              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- X := 30.0625" ) ;
-           END IF ;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := 30.0625");
-      END;
- 
- 
-      BEGIN
-           Y  := -30.0 ;
-           YA := -0.0625 ;
-           IF NOT OUT_OF_BOUNDS ( Y , YA ) THEN
-              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- Y := -30.0625" ) ;
-           END IF ;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := -30.0625");
-      END;
- 
- 
-      BEGIN
-           Y  := 30.0 ;
-           YA := 0.0625 ;
-           IF NOT OUT_OF_BOUNDS ( Y , YA ) THEN
-              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- Y := 30.0625" ) ;
-           END IF ;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := 30.0625");
-      END;
- 
-      RESULT;
- END C34004C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,410 ****
- -- C34005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
- --     WHOSE COMPONENT TYPE IS A NON-LIMITED, NON-DISCRETE TYPE.
- 
- -- HISTORY:
- --     JRK 9/10/86  CREATED ORIGINAL TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005A IS
- 
-      SUBTYPE COMPONENT IS FLOAT;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
-      SUBTYPE ARR IS ARRT (2 .. 4);
- 
-      X : T               := (OTHERS => 2.0);
-      W : PARENT (5 .. 7) := (OTHERS => 2.0);
-      C : COMPONENT       := 1.0;
-      B : BOOLEAN         := FALSE;
-      U : ARR             := (OTHERS => C);
-      N : CONSTANT        := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN (OTHERS => C);
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := B + 1.0;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN (OTHERS => -1.0);
-      END IDENT;
- 
- BEGIN
-      TEST ("C34005A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A NON-LIMITED, NON-DISCRETE TYPE");
- 
-      X := IDENT ((1.0, 2.0, 3.0));
-      IF X /= (1.0, 2.0, 3.0) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= (1.0, 2.0, 3.0) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= (1.0, 2.0, 3.0) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := (1.0, 2.0, 3.0);
-      END IF;
-      IF T (W) /= (1.0, 2.0, 3.0) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      BEGIN
-           IF PARENT (X) /= (1.0, 2.0, 3.0) OR
-              PARENT (CREATE (2, 3, 4.0, X)) /= (4.0, 5.0) THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           U := (1.0, 2.0, 3.0);
-      END IF;
-      IF T (U) /= (1.0, 2.0, 3.0) THEN
-           FAILED ("INCORRECT CONVERSION FROM ARRAY");
-      END IF;
- 
-      BEGIN
-           IF ARR (X) /= (1.0, 2.0, 3.0) OR
-              ARRT (CREATE (1, 2, 3.0, X)) /= (3.0, 4.0) THEN
-                FAILED ("INCORRECT CONVERSION TO ARRAY");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
-      END;
- 
-      IF IDENT ((1.0, 2.0, 3.0)) /= (1.0, 2.0, 3.0) OR
-         X = (1.0, 2.0) THEN
-           FAILED ("INCORRECT AGGREGATE");
-      END IF;
- 
-      BEGIN
-           IF X (IDENT_INT (5)) /= 1.0 OR
-              CREATE (2, 3, 4.0, X) (3) /= 5.0 THEN
-                FAILED ("INCORRECT INDEX (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
-      END;
- 
-      X (IDENT_INT (7)) := 4.0;
-      IF X /= (1.0, 2.0, 4.0) THEN
-           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
-      END IF;
- 
-      BEGIN
-           X := IDENT ((1.0, 2.0, 3.0));
-           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2.0, 3.0) OR
-              CREATE (1, 4, 4.0, X) (1 .. 3) /= (4.0, 5.0, 6.0) THEN
-                FAILED ("INCORRECT SLICE (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
-      END;
- 
-      X (IDENT_INT (5) .. IDENT_INT (6)) := (4.0, 5.0);
-      IF X /= (4.0, 5.0, 3.0) THEN
-           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
-      END IF;
- 
-      X := IDENT ((1.0, 2.0, 3.0));
-      IF X = IDENT ((1.0, 2.0, 4.0)) OR X = (1.0, 2.0) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT ((1.0, 2.0, 3.0)) OR NOT (X /= (2.0, 3.0)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR (1.0, 2.0) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT ((1.0, 2.0) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      BEGIN
-           IF X & (4.0, 5.0, 6.0) /= (1.0, 2.0, 3.0, 4.0, 5.0, 6.0) OR
-              CREATE (2, 3, 2.0, X) & (4.0, 5.0) /=
-              (2.0, 3.0, 4.0, 5.0) THEN
-                FAILED ("INCORRECT & (ARRAY, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
-      END;
- 
-      BEGIN
-           IF X & 4.0 /= (1.0, 2.0, 3.0, 4.0) OR
-              CREATE (2, 3, 2.0, X) & 4.0 /= (2.0, 3.0, 4.0) THEN
-                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
-      END;
- 
-      BEGIN
-           IF 4.0 & X /= (4.0, 1.0, 2.0, 3.0) OR
-              2.0 & CREATE (2, 3, 3.0, X) /= (2.0, 3.0, 4.0) THEN
-                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           C := 2.0;
-      END IF;
- 
-      BEGIN
-           IF C & 3.0 /= CREATE (2, 3, 2.0, X) THEN
-                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
-      END;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'FIRST /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST");
-      END IF;
- 
-      IF X'FIRST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF T'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST (N)");
-      END IF;
- 
-      IF X'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF T'LAST /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST");
-      END IF;
- 
-      IF X'LAST /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF T'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST (N)");
-      END IF;
- 
-      IF X'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF T'LENGTH /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF T'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH (N)");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : PARENT (T'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (T'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      IF T'SIZE < T'LENGTH * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < X'LENGTH * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C34005C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
- --     NON-LIMITED, NON-DISCRETE TYPE:
- --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
- --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --     CONSTRAINED.
- --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --     IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 9/10/86  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005C IS
- 
-      SUBTYPE COMPONENT IS FLOAT;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := (OTHERS => 2.0);
-      Y : S := (OTHERS => 2.0);
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := B + 1.0;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34005C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A NON-LIMITED, NON-DISCRETE TYPE");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      BEGIN
-           IF CREATE (2, 3, 4.0, X) /= (4.0, 5.0) OR
-              CREATE (2, 3, 4.0, Y) /= (4.0, 5.0) THEN
-                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
-                        "SUBTYPE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION");
-      END;
- 
-      IF X & (3.0, 4.0) /= (2.0, 2.0, 2.0, 3.0, 4.0) OR
-         Y & (3.0, 4.0) /= (2.0, 2.0, 2.0, 3.0, 4.0) THEN
-           FAILED ("INCORRECT &");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= 5 OR T'LAST /= 7 OR
-         S'FIRST /= 5 OR S'LAST /= 7 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := (1.0, 2.0, 3.0);
-           Y := (1.0, 2.0, 3.0);
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := (1.0, 2.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (1.0, 2.0)");
-           IF X = (1.0, 2.0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (1.0, 2.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := (1.0, 2.0)");
-      END;
- 
-      BEGIN
-           X := (1.0, 2.0, 3.0, 4.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (1.0, 2.0, 3.0, 4.0)");
-           IF X = (1.0, 2.0, 3.0, 4.0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (1.0, 2.0, 3.0, 4.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (1.0, 2.0, 3.0, 4.0)");
-      END;
- 
-      BEGIN
-           Y := (1.0, 2.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (1.0, 2.0)");
-           IF Y = (1.0, 2.0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (1.0, 2.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := (1.0, 2.0)");
-      END;
- 
-      BEGIN
-           Y := (1.0, 2.0, 3.0, 4.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (1.0, 2.0, 3.0, 4.0)");
-           IF Y = (1.0, 2.0, 3.0, 4.0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (1.0, 2.0, 3.0, 4.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (1.0, 2.0, 3.0, 4.0)");
-      END;
- 
-      RESULT;
- END C34005C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,425 ****
- -- C34005D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
- --     WHOSE COMPONENT TYPE IS A DISCRETE TYPE.
- 
- -- HISTORY:
- --     JRK 9/12/86  CREATED ORIGINAL TEST.
- --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005D IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
-      SUBTYPE ARR IS ARRT (2 .. 4);
- 
-      X : T               := (OTHERS => 2);
-      W : PARENT (5 .. 7) := (OTHERS => 2);
-      C : COMPONENT       := 1;
-      B : BOOLEAN         := FALSE;
-      U : ARR             := (OTHERS => C);
-      N : CONSTANT        := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN (OTHERS => C);
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := B + 1;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN (OTHERS => -1);
-      END IDENT;
- 
- BEGIN
-      TEST ("C34005D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A DISCRETE TYPE");
- 
-      X := IDENT ((1, 2, 3));
-      IF X /= (1, 2, 3) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= (1, 2, 3) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= (1, 2, 3) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := (1, 2, 3);
-      END IF;
-      IF T (W) /= (1, 2, 3) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      BEGIN
-           IF PARENT (X) /= (1, 2, 3) OR
-              PARENT (CREATE (2, 3, 4, X)) /= (4, 5) THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           U := (1, 2, 3);
-      END IF;
-      IF T (U) /= (1, 2, 3) THEN
-           FAILED ("INCORRECT CONVERSION FROM ARRAY");
-      END IF;
- 
-      BEGIN
-           IF ARR (X) /= (1, 2, 3) OR
-              ARRT (CREATE (1, 2, 3, X)) /= (3, 4) THEN
-                FAILED ("INCORRECT CONVERSION TO ARRAY");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
-      END;
- 
-      IF IDENT ((1, 2, 3)) /= (1, 2, 3) OR
-         X = (1, 2) THEN
-           FAILED ("INCORRECT AGGREGATE");
-      END IF;
- 
-      BEGIN
-           IF X (IDENT_INT (5)) /= 1 OR
-              CREATE (2, 3, 4, X) (3) /= 5 THEN
-                FAILED ("INCORRECT INDEX (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
-      END;
- 
-      X (IDENT_INT (7)) := 4;
-      IF X /= (1, 2, 4) THEN
-           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
-      END IF;
- 
-      BEGIN
-           X := IDENT ((1, 2, 3));
-           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR
-              CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN
-                FAILED ("INCORRECT SLICE (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
-      END;
- 
-      X (IDENT_INT (5) .. IDENT_INT (6)) := (4, 5);
-      IF X /= (4, 5, 3) THEN
-           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
-      END IF;
- 
-      X := IDENT ((1, 2, 3));
-      IF X = IDENT ((1, 2, 4)) OR X = (1, 2) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT ((1, 2, 3)) OR NOT (X /= (2, 3)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF X < IDENT ((1, 2, 3)) OR X < (1, 2) THEN
-           FAILED ("INCORRECT <");
-      END IF;
- 
-      IF X > IDENT ((1, 2, 3)) OR X > (1, 3) THEN
-           FAILED ("INCORRECT >");
-      END IF;
- 
-      IF X <= IDENT ((1, 2, 2)) OR X <= (1, 2, 2, 4) THEN
-           FAILED ("INCORRECT <=");
-      END IF;
- 
-      IF X >= IDENT ((1, 2, 4)) OR X >= (1, 2, 3, 1) THEN
-           FAILED ("INCORRECT >=");
-      END IF;
- 
-      IF NOT (X IN T) OR (1, 2) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT ((1, 2) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      BEGIN
-           IF X & (4, 5, 6) /= (1, 2, 3, 4, 5, 6) OR
-              CREATE (2, 3, 2, X) & (4, 5) /= (2, 3, 4, 5) THEN
-                FAILED ("INCORRECT & (ARRAY, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
-      END;
- 
-      BEGIN
-           IF X & 4 /= (1, 2, 3, 4) OR
-              CREATE (2, 3, 2, X) & 4 /= (2, 3, 4) THEN
-                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
-      END;
- 
-      BEGIN
-           IF 4 & X /= (4, 1, 2, 3) OR
-              2 & CREATE (2, 3, 3, X) /= (2, 3, 4) THEN
-                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           C := 2;
-      END IF;
- 
-      BEGIN
-           IF C & 3 /= CREATE (2, 3, 2, X) THEN
-                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
-      END;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'FIRST /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST");
-      END IF;
- 
-      IF X'FIRST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF T'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST (N)");
-      END IF;
- 
-      IF X'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF T'LAST /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST");
-      END IF;
- 
-      IF X'LAST /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF T'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST (N)");
-      END IF;
- 
-      IF X'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF T'LENGTH /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF T'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH (N)");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : PARENT (T'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (T'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      IF T'SIZE < T'LENGTH * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < X'LENGTH * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34005D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C34005F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
- --     DISCRETE TYPE:
- --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
- --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --     CONSTRAINED.
- --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --     IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 9/12/86  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005F IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := (OTHERS => 2);
-      Y : S := (OTHERS => 2);
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := B + 1;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34005F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A DISCRETE TYPE");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      BEGIN
-           IF CREATE (2, 3, 4, X) /= (4, 5) OR
-              CREATE (2, 3, 4, Y) /= (4, 5) THEN
-                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
-                        "SUBTYPE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION");
-      END;
- 
-      IF X & (3, 4) /= (2, 2, 2, 3, 4) OR
-         Y & (3, 4) /= (2, 2, 2, 3, 4) THEN
-           FAILED ("INCORRECT &");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= 5 OR T'LAST /= 7 OR
-         S'FIRST /= 5 OR S'LAST /= 7 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := (1, 2, 3);
-           Y := (1, 2, 3);
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := (1, 2);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (1, 2)");
-           IF X = (1, 2) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (1, 2)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := (1, 2)");
-      END;
- 
-      BEGIN
-           X := (1, 2, 3, 4);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (1, 2, 3, 4)");
-           IF X = (1, 2, 3, 4) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (1, 2, 3, 4)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (1, 2, 3, 4)");
-      END;
- 
-      BEGIN
-           Y := (1, 2);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (1, 2)");
-           IF Y = (1, 2) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (1, 2)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := (1, 2)");
-      END;
- 
-      BEGIN
-           Y := (1, 2, 3, 4);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (1, 2, 3, 4)");
-           IF Y = (1, 2, 3, 4) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (1, 2, 3, 4)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (1, 2, 3, 4)");
-      END;
- 
-      RESULT;
- END C34005F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,423 ****
- -- C34005G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --    (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
- --    WHOSE COMPONENT TYPE IS A CHARACTER TYPE.
- 
- -- HISTORY:
- --    JRK 9/15/86  CREATED ORIGINAL TEST.
- --    RJW 8/21/89  MODIFIED CHECKS FOR OBJECT AND TYPE SIZES.
- --    PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005G IS
- 
-      TYPE COMPONENT IS NEW CHARACTER;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
-      SUBTYPE ARR IS ARRT (2 .. 4);
- 
-      X : T               := (OTHERS => 'B');
-      W : PARENT (5 .. 7) := (OTHERS => 'B');
-      C : COMPONENT       := 'A';
-      B : BOOLEAN         := FALSE;
-      U : ARR             := (OTHERS => C);
-      N : CONSTANT        := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN (OTHERS => C);
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := COMPONENT'SUCC (B);
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN (OTHERS => '-');
-      END IDENT;
- 
- BEGIN
-      TEST ("C34005G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A CHARACTER TYPE");
- 
-      X := IDENT ("ABC");
-      IF X /= "ABC" THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= "ABC" THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= "ABC" THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := "ABC";
-      END IF;
-      IF T (W) /= "ABC" THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      BEGIN
-           IF PARENT (X) /= "ABC" OR
-              PARENT (CREATE (2, 3, 'D', X)) /= "DE" THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           U := "ABC";
-      END IF;
-      IF T (U) /= "ABC" THEN
-           FAILED ("INCORRECT CONVERSION FROM ARRAY");
-      END IF;
- 
-      BEGIN
-           IF ARR (X) /= "ABC" OR
-              ARRT (CREATE (1, 2, 'C', X)) /= "CD" THEN
-                FAILED ("INCORRECT CONVERSION TO ARRAY");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
-      END;
- 
-      IF IDENT ("ABC") /= ('A', 'B', 'C') OR
-         X = "AB" THEN
-           FAILED ("INCORRECT STRING LITERAL");
-      END IF;
- 
-      IF IDENT (('A', 'B', 'C')) /= "ABC" OR
-         X = ('A', 'B') THEN
-           FAILED ("INCORRECT AGGREGATE");
-      END IF;
- 
-      BEGIN
-           IF X (IDENT_INT (5)) /= 'A' OR
-              CREATE (2, 3, 'D', X) (3) /= 'E' THEN
-                FAILED ("INCORRECT INDEX (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
-      END;
- 
-      X (IDENT_INT (7)) := 'D';
-      IF X /= "ABD" THEN
-           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
-      END IF;
- 
-      BEGIN
-           X := IDENT ("ABC");
-           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= "BC" OR
-              CREATE (1, 4, 'D', X) (1 .. 3) /= "DEF" THEN
-                FAILED ("INCORRECT SLICE (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
-      END;
- 
-      X (IDENT_INT (5) .. IDENT_INT (6)) := "DE";
-      IF X /= "DEC" THEN
-           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
-      END IF;
- 
-      X := IDENT ("ABC");
-      IF X = IDENT ("ABD") OR X = "AB" THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT ("ABC") OR NOT (X /= "BC") THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF X < IDENT ("ABC") OR X < "AB" THEN
-           FAILED ("INCORRECT <");
-      END IF;
- 
-      IF X > IDENT ("ABC") OR X > "AC" THEN
-           FAILED ("INCORRECT >");
-      END IF;
- 
-      IF X <= IDENT ("ABB") OR X <= "ABBD" THEN
-           FAILED ("INCORRECT <=");
-      END IF;
- 
-      IF X >= IDENT ("ABD") OR X >= "ABCA" THEN
-           FAILED ("INCORRECT >=");
-      END IF;
- 
-      IF NOT (X IN T) OR "AB" IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT ("AB" NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      BEGIN
-           IF X & "DEF" /= "ABCDEF" OR
-              CREATE (2, 3, 'B', X) & "DE" /= "BCDE" THEN
-                FAILED ("INCORRECT & (ARRAY, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
-      END;
- 
-      BEGIN
-           IF X & 'D' /= "ABCD" OR
-              CREATE (2, 3, 'B', X) & 'D' /= "BCD" THEN
-                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
-      END;
- 
-      BEGIN
-           IF 'D' & X /= "DABC" OR
-              'B' & CREATE (2, 3, 'C', X) /= "BCD" THEN
-                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           C := 'B';
-      END IF;
- 
-      BEGIN
-           IF C & 'C' /= CREATE (2, 3, 'B', X) THEN
-                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
-      END;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'FIRST /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST");
-      END IF;
- 
-      IF X'FIRST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF T'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST (N)");
-      END IF;
- 
-      IF X'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF T'LAST /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST");
-      END IF;
- 
-      IF X'LAST /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF T'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST (N)");
-      END IF;
- 
-      IF X'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF T'LENGTH /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF T'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH (N)");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : PARENT (T'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (T'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      RESULT;
- END C34005G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005i.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C34005I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
- --     CHARACTER TYPE:
- --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
- --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --     CONSTRAINED.
- --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --     IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 9/15/86  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005I IS
- 
-      TYPE COMPONENT IS NEW CHARACTER;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := (OTHERS => 'B');
-      Y : S := (OTHERS => 'B');
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := COMPONENT'SUCC (B);
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34005I", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A CHARACTER TYPE");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      BEGIN
-           IF CREATE (2, 3, 'D', X) /= "DE" OR
-              CREATE (2, 3, 'D', Y) /= "DE" THEN
-                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
-                        "SUBTYPE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION");
-      END;
- 
-      IF X & "CD" /= "BBBCD" OR
-         Y & "CD" /= "BBBCD" THEN
-           FAILED ("INCORRECT &");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= 5 OR T'LAST /= 7 OR
-         S'FIRST /= 5 OR S'LAST /= 7 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := "ABC";
-           Y := "ABC";
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := "AB";
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := ""AB""");
-           IF X = "AB" THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := ""AB""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := ""AB""");
-      END;
- 
-      BEGIN
-           X := "ABCD";
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := ""ABCD""");
-           IF X = "ABCD" THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := ""ABCD""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := ""ABCD""");
-      END;
- 
-      BEGIN
-           Y := "AB";
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := ""AB""");
-           IF Y = "AB" THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := ""AB""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := ""AB""");
-      END;
- 
-      BEGIN
-           Y := "ABCD";
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := ""ABCD""");
-           IF Y = "ABCD" THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := ""ABCD""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := ""ABCD""");
-      END;
- 
-      RESULT;
- END C34005I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,482 ****
- -- C34005J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
- --     WHOSE COMPONENT TYPE IS A BOOLEAN TYPE.
- 
- -- HISTORY:
- --     JRK 9/16/86  CREATED ORIGINAL TEST.
- --     RJW 8/21/89  MODIFIED CHECKS FOR TYPE AND OBJECT SIZES.
- --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005J IS
- 
-      SUBTYPE COMPONENT IS BOOLEAN;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
-      SUBTYPE ARR IS ARRT (2 .. 4);
- 
-      X : T               := (OTHERS => TRUE);
-      W : PARENT (5 .. 7) := (OTHERS => TRUE);
-      C : COMPONENT       := FALSE;
-      B : BOOLEAN         := FALSE;
-      U : ARR             := (OTHERS => C);
-      N : CONSTANT        := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN (OTHERS => C);
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := NOT B;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN (OTHERS => FALSE);
-      END IDENT;
- 
- BEGIN
-      TEST ("C34005J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A BOOLEAN TYPE");
- 
-      X := IDENT ((TRUE, FALSE, TRUE));
-      IF X /= (TRUE, FALSE, TRUE) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= (TRUE, FALSE, TRUE) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= (TRUE, FALSE, TRUE) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := (TRUE, FALSE, TRUE);
-      END IF;
-      IF T (W) /= (TRUE, FALSE, TRUE) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      BEGIN
-           IF PARENT (X) /= (TRUE, FALSE, TRUE) OR
-              PARENT (CREATE (2, 3, FALSE, X)) /= (FALSE, TRUE) THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           U := (TRUE, FALSE, TRUE);
-      END IF;
-      IF T (U) /= (TRUE, FALSE, TRUE) THEN
-           FAILED ("INCORRECT CONVERSION FROM ARRAY");
-      END IF;
- 
-      BEGIN
-           IF ARR (X) /= (TRUE, FALSE, TRUE) OR
-              ARRT (CREATE (1, 2, TRUE, X)) /= (TRUE, FALSE) THEN
-                FAILED ("INCORRECT CONVERSION TO ARRAY");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
-      END;
- 
-      IF IDENT ((TRUE, FALSE, TRUE)) /= (TRUE, FALSE, TRUE) OR
-         X = (TRUE, FALSE) THEN
-           FAILED ("INCORRECT AGGREGATE");
-      END IF;
- 
-      BEGIN
-           IF X (IDENT_INT (5)) /= TRUE OR
-              CREATE (2, 3, FALSE, X) (3) /= TRUE THEN
-                FAILED ("INCORRECT INDEX (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
-      END;
- 
-      X (IDENT_INT (7)) := FALSE;
-      IF X /= (TRUE, FALSE, FALSE) THEN
-           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
-      END IF;
- 
-      BEGIN
-           X := IDENT ((TRUE, FALSE, TRUE));
-           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (FALSE, TRUE) OR
-              CREATE (1, 4, FALSE, X) (1 .. 3) /=
-              (FALSE, TRUE, FALSE) THEN
-                FAILED ("INCORRECT SLICE (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
-      END;
- 
-      X (IDENT_INT (5) .. IDENT_INT (6)) := (FALSE, TRUE);
-      IF X /= (FALSE, TRUE, TRUE) THEN
-           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
-      END IF;
- 
-      BEGIN
-           X := IDENT ((TRUE, FALSE, TRUE));
-           IF NOT X /= (FALSE, TRUE, FALSE) OR
-              NOT CREATE (2, 3, FALSE, X) /= (TRUE, FALSE) THEN
-                FAILED ("INCORRECT ""NOT""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
-      END;
- 
-      BEGIN
-           IF (X AND IDENT ((TRUE, TRUE, FALSE))) /=
-              (TRUE, FALSE, FALSE) OR
-              (CREATE (1, 4, FALSE, X) AND
-              (FALSE, FALSE, TRUE, TRUE)) /=
-              (FALSE, FALSE, FALSE, TRUE) THEN
-                FAILED ("INCORRECT ""AND""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
-      END;
- 
-      BEGIN
-           IF (X OR IDENT ((TRUE, FALSE, FALSE))) /=
-              (TRUE, FALSE, TRUE) OR
-              (CREATE (1, 4, FALSE, X) OR (FALSE, FALSE, TRUE, TRUE)) /=
-              (FALSE, TRUE, TRUE, TRUE) THEN
-                FAILED ("INCORRECT ""OR""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
-      END;
- 
-      BEGIN
-           IF (X XOR IDENT ((TRUE, TRUE, FALSE))) /=
-              (FALSE, TRUE, TRUE) OR
-              (CREATE (1, 4, FALSE, X) XOR
-              (FALSE, FALSE, TRUE, TRUE)) /=
-              (FALSE, TRUE, TRUE, FALSE) THEN
-                FAILED ("INCORRECT ""XOR""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
-      END;
- 
-      IF X = IDENT ((TRUE, FALSE, FALSE)) OR X = (TRUE, FALSE) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT ((TRUE, FALSE, TRUE)) OR
-         NOT (X /= (FALSE, TRUE)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF X < IDENT ((TRUE, FALSE, TRUE)) OR X < (TRUE, FALSE) THEN
-           FAILED ("INCORRECT <");
-      END IF;
- 
-      IF X > IDENT ((TRUE, FALSE, TRUE)) OR X > (TRUE, TRUE) THEN
-           FAILED ("INCORRECT >");
-      END IF;
- 
-      IF X <= IDENT ((TRUE, FALSE, FALSE)) OR
-         X <= (TRUE, FALSE, FALSE, TRUE) THEN
-           FAILED ("INCORRECT <=");
-      END IF;
- 
-      IF X >= IDENT ((TRUE, TRUE, FALSE)) OR
-         X >= (TRUE, FALSE, TRUE, FALSE) THEN
-           FAILED ("INCORRECT >=");
-      END IF;
- 
-      IF NOT (X IN T) OR (TRUE, FALSE) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT ((TRUE, FALSE) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      BEGIN
-           IF X & (FALSE, TRUE, FALSE) /=
-              (TRUE, FALSE, TRUE, FALSE, TRUE, FALSE) OR
-              CREATE (2, 3, FALSE, X) & (FALSE, TRUE) /=
-              (FALSE, TRUE, FALSE, TRUE) THEN
-                FAILED ("INCORRECT & (ARRAY, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 9");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 9");
-      END;
- 
-      BEGIN
-           IF X & FALSE /= (TRUE, FALSE, TRUE, FALSE) OR
-              CREATE (2, 3, FALSE, X) & FALSE /=
-              (FALSE, TRUE, FALSE) THEN
-                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 10");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 10");
-      END;
- 
-      BEGIN
-           IF FALSE & X /= (FALSE, TRUE, FALSE, TRUE) OR
-              FALSE & CREATE (2, 3, TRUE, X) /=
-              (FALSE, TRUE, FALSE) THEN
-                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 11");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 11");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           C := FALSE;
-      END IF;
- 
-      BEGIN
-           IF C & TRUE /= CREATE (2, 3, FALSE, X) THEN
-                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 12");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 12");
-      END;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'FIRST /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST");
-      END IF;
- 
-      IF X'FIRST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF T'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST (N)");
-      END IF;
- 
-      IF X'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF T'LAST /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST");
-      END IF;
- 
-      IF X'LAST /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF T'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST (N)");
-      END IF;
- 
-      IF X'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF T'LENGTH /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF T'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH (N)");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : PARENT (T'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (T'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      RESULT;
- END C34005J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C34005L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
- --     BOOLEAN TYPE:
- --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
- --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --     CONSTRAINED.
- --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --     IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 9/16/86  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005L IS
- 
-      SUBTYPE COMPONENT IS BOOLEAN;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := (OTHERS => TRUE);
-      Y : S := (OTHERS => TRUE);
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := NOT B;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34005L", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A BOOLEAN TYPE");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      BEGIN
-           IF CREATE (2, 3, FALSE, X) /= (FALSE, TRUE) OR
-              CREATE (2, 3, FALSE, Y) /= (FALSE, TRUE) THEN
-                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
-                        "SUBTYPE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION");
-      END;
- 
-      IF X & (FALSE, TRUE) /= (TRUE, TRUE, TRUE, FALSE, TRUE) OR
-         Y & (FALSE, TRUE) /= (TRUE, TRUE, TRUE, FALSE, TRUE) THEN
-           FAILED ("INCORRECT &");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= 5 OR T'LAST /= 7 OR
-         S'FIRST /= 5 OR S'LAST /= 7 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := (TRUE, FALSE, TRUE);
-           Y := (TRUE, FALSE, TRUE);
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := (TRUE, FALSE);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (TRUE, FALSE)");
-           IF X = (TRUE, FALSE) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (TRUE, FALSE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- X := (TRUE, FALSE)");
-      END;
- 
-      BEGIN
-           X := (TRUE, FALSE, TRUE, FALSE);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (TRUE, FALSE, TRUE, FALSE)");
-           IF X = (TRUE, FALSE, TRUE, FALSE) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (TRUE, FALSE, TRUE, FALSE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (TRUE, FALSE, TRUE, FALSE)");
-      END;
- 
-      BEGIN
-           Y := (TRUE, FALSE);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (TRUE, FALSE)");
-           IF Y = (TRUE, FALSE) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (TRUE, FALSE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- Y := (TRUE, FALSE)");
-      END;
- 
-      BEGIN
-           Y := (TRUE, FALSE, TRUE, FALSE);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (TRUE, FALSE, TRUE, FALSE)");
-           IF Y = (TRUE, FALSE, TRUE, FALSE) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (TRUE, FALSE, TRUE, FALSE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (TRUE, FALSE, TRUE, FALSE)");
-      END;
- 
-      RESULT;
- END C34005L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005m.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,353 ****
- -- C34005M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
- --     COMPONENT TYPE IS A NON-LIMITED TYPE.
- 
- -- HISTORY:
- --     JRK 9/17/86  CREATED ORIGINAL TEST.
- --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005M IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 10;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
-                                COMPONENT;
- 
-           FUNCTION CREATE ( F1, L1 : INDEX;
-                             F2, L2 : INDEX;
-                             C      : COMPONENT;
-                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
-                            IDENT_INT (6) .. IDENT_INT (8));
- 
-      TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
-                         COMPONENT;
- 
-      SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
- 
-      X : T                       := (OTHERS => (OTHERS => 2));
-      W : PARENT (4 .. 5, 6 .. 8) := (OTHERS => (OTHERS => 2));
-      C : COMPONENT               := 1;
-      B : BOOLEAN                 := FALSE;
-      U : ARR                     := (OTHERS => (OTHERS => C));
-      N : CONSTANT                := 2;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN (OTHERS => (OTHERS => C));
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F1, L1 : INDEX;
-                F2, L2 : INDEX;
-                C      : COMPONENT;
-                DUMMY  : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F1 .. L1, F2 .. L2);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F1 .. L1 LOOP
-                     FOR J IN F2 .. L2 LOOP
-                          A (I, J) := B;
-                          B := B + 1;
-                     END LOOP;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN (OTHERS => (OTHERS => -1));
-      END IDENT;
- 
- BEGIN
-      TEST ("C34005M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A NON-LIMITED TYPE");
- 
-      X := IDENT (((1, 2, 3), (4, 5, 6)));
-      IF X /= ((1, 2, 3), (4, 5, 6)) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= ((1, 2, 3), (4, 5, 6)) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= ((1, 2, 3), (4, 5, 6)) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := ((1, 2, 3), (4, 5, 6));
-      END IF;
-      IF T (W) /= ((1, 2, 3), (4, 5, 6)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      BEGIN
-           IF PARENT (X) /= ((1, 2, 3), (4, 5, 6)) OR
-              PARENT (CREATE (6, 9, 2, 3, 4, X)) /=
-              ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
-      END;
- 
-      IF EQUAL (3, 3) THEN
-           U := ((1, 2, 3), (4, 5, 6));
-      END IF;
-      IF T (U) /= ((1, 2, 3), (4, 5, 6)) THEN
-           FAILED ("INCORRECT CONVERSION FROM ARRAY");
-      END IF;
- 
-      BEGIN
-           IF ARR (X) /= ((1, 2, 3), (4, 5, 6)) OR
-              ARRT (CREATE (7, 9, 2, 5, 3, X)) /=
-              ((3, 4, 5, 6), (7, 8, 9, 10), (11, 12, 13, 14)) THEN
-                FAILED ("INCORRECT CONVERSION TO ARRAY");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
-      END;
- 
-      IF IDENT (((1, 2, 3), (4, 5, 6))) /= ((1, 2, 3), (4, 5, 6)) OR
-         X = ((1, 2), (3, 4), (5, 6)) THEN
-           FAILED ("INCORRECT AGGREGATE");
-      END IF;
- 
-      BEGIN
-           IF X (IDENT_INT (4), IDENT_INT (6)) /= 1 OR
-              CREATE (6, 9, 2, 3, 4, X) (9, 3) /= 11 THEN
-                FAILED ("INCORRECT INDEX (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
-      END;
- 
-      X (IDENT_INT (5), IDENT_INT (8)) := 7;
-      IF X /= ((1, 2, 3), (4, 5, 7)) THEN
-           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
-      END IF;
- 
-      X := IDENT (((1, 2, 3), (4, 5, 6)));
-      IF X = IDENT (((1, 2, 3), (4, 5, 7))) OR
-         X = ((1, 2), (4, 5)) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT (((1, 2, 3), (4, 5, 6))) OR
-         NOT (X /= ((1, 2, 3), (4, 5, 6), (7, 8, 9))) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR ((1, 2), (3, 4)) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR
-         NOT (((1, 2, 3), (4, 5, 6), (7, 8, 9)) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'FIRST /= 4 THEN
-           FAILED ("INCORRECT TYPE'FIRST");
-      END IF;
- 
-      IF X'FIRST /= 4 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 4 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF T'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT TYPE'FIRST (N)");
-      END IF;
- 
-      IF X'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF T'LAST /= 5 THEN
-           FAILED ("INCORRECT TYPE'LAST");
-      END IF;
- 
-      IF X'LAST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 5 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF T'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT TYPE'LAST (N)");
-      END IF;
- 
-      IF X'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF T'LENGTH /= 2 THEN
-           FAILED ("INCORRECT TYPE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH /= 2 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 2 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF T'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH (N)");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : PARENT (T'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT TYPE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (1 .. 2, T'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT TYPE'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (1 .. 2, X'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (1 .. 2, V'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34005M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005o.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,277 ****
- -- C34005O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE
- --     IS A NON-LIMITED TYPE:
- --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
- --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --     CONSTRAINED.
- --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --     IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 9/17/86  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005O IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 10;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
-                                COMPONENT;
- 
-           FUNCTION CREATE ( F1, L1 : INDEX;
-                             F2, L2 : INDEX;
-                             C      : COMPONENT;
-                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
-                            IDENT_INT (6) .. IDENT_INT (8));
- 
-      SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := (OTHERS => (OTHERS => 2));
-      Y : S := (OTHERS => (OTHERS => 2));
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F1, L1 : INDEX;
-                F2, L2 : INDEX;
-                C      : COMPONENT;
-                DUMMY  : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F1 .. L1, F2 .. L2);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F1 .. L1 LOOP
-                     FOR J IN F2 .. L2 LOOP
-                          A (I, J) := B;
-                          B := B + 1;
-                     END LOOP;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34005O", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A NON-LIMITED TYPE");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      BEGIN
-           IF CREATE (6, 9, 2, 3, 1, X) /=
-              ((1, 2), (3, 4), (5, 6), (7, 8)) OR
-              CREATE (6, 9, 2, 3, 1, Y) /=
-              ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
-                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
-                        "SUBTYPE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION");
-      END;
- 
-      IF ((1, 2), (3, 4), (5, 6), (7, 8)) IN T OR
-         ((1, 2), (3, 4), (5, 6), (7, 8)) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= 4 OR T'LAST /= 5 OR
-         S'FIRST /= 4 OR S'LAST /= 5 OR
-         T'FIRST (2) /= 6 OR T'LAST (2) /= 8 OR
-         S'FIRST (2) /= 6 OR S'LAST (2) /= 8 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := ((1, 2, 3), (4, 5, 6));
-           Y := ((1, 2, 3), (4, 5, 6));
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := (4 => (6 .. 8 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (4 => (6 .. 8 => 0))");
-           IF X = (4 => (6 .. 8 => 0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := (4 => (6 .. 8 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (4 => (6 .. 8 => 0))");
-      END;
- 
-      BEGIN
-           X := (4 .. 6 => (6 .. 8 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (4 .. 6 => (6 .. 8 => 0))");
-           IF X = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := (4 .. 6 => (6 .. 8 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (4 .. 6 => (6 .. 8 => 0))");
-      END;
- 
-      BEGIN
-           X := (4 .. 5 => (6 .. 7 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (4 .. 5 => (6 .. 7 => 0))");
-           IF X = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := (4 .. 5 => (6 .. 7 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (4 .. 5 => (6 .. 7 => 0))");
-      END;
- 
-      BEGIN
-           X := (4 .. 5 => (6 .. 9 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (4 .. 5 => (6 .. 9 => 0))");
-           IF X = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := (4 .. 5 => (6 .. 9 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (4 .. 5 => (6 .. 9 => 0))");
-      END;
- 
-      BEGIN
-           Y := (4 => (6 .. 8 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (4 => (6 .. 8 => 0))");
-           IF Y = (4 => (6 .. 8 => 0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := (4 => (6 .. 8 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (4 => (6 .. 8 => 0))");
-      END;
- 
-      BEGIN
-           Y := (4 .. 6 => (6 .. 8 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (4 .. 6 => (6 .. 8 => 0))");
-           IF Y = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := (4 .. 6 => (6 .. 8 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (4 .. 6 => (6 .. 8 => 0))");
-      END;
- 
-      BEGIN
-           Y := (4 .. 5 => (6 .. 7 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (4 .. 5 => (6 .. 7 => 0))");
-           IF Y = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := (4 .. 5 => (6 .. 7 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (4 .. 5 => (6 .. 7 => 0))");
-      END;
- 
-      BEGIN
-           Y := (4 .. 5 => (6 .. 9 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (4 .. 5 => (6 .. 9 => 0))");
-           IF Y = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := (4 .. 5 => (6 .. 9 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (4 .. 5 => (6 .. 9 => 0))");
-      END;
- 
-      RESULT;
- END C34005O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005p.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,405 ****
- -- C34005P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE
- --     COMPONENT TYPE IS A LIMITED TYPE.
- 
- -- HISTORY:
- --     JRK 08/17/87  CREATED ORIGINAL TEST.
- --     VCL 07/01/88  MODIFIED THE STATEMENTS INVOLVING THE 'SIZE
- --                   ATTRIBUTE TO REMOVE ANY ASSUMPTIONS ABOUT THE
- --                   SIZES.  ADDED EXCEPTION HANDLERS TO CATCH INCORRECT
- --                   TYPE CONVERSIONS TO DERIVED SUBTYPES.
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- --     RLB 10/03/02  REMOVED ILLEGAL (BY AI-246) TYPE CONVERSIONS AND
- --                   SUPPORTING CODE.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005P IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C1 : CONSTANT LP;
-           C2 : CONSTANT LP;
-           C3 : CONSTANT LP;
-           C4 : CONSTANT LP;
-           C5 : CONSTANT LP;
-           C6 : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C1 : CONSTANT LP := 1;
-           C2 : CONSTANT LP := 2;
-           C3 : CONSTANT LP := 3;
-           C4 : CONSTANT LP := 4;
-           C5 : CONSTANT LP := 5;
-           C6 : CONSTANT LP := 6;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT;
- 
-           FUNCTION AGGR (X, Y, Z : COMPONENT) RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      X : T;
-      W : PARENT (5 .. 7);
-      C : COMPONENT;
-      B : BOOLEAN := FALSE;
-      N : CONSTANT := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-           RESULT : T;
-      BEGIN
-           FOR I IN RESULT'RANGE LOOP
-                ASSIGN (RESULT (I), C);
-           END LOOP;
-           RETURN RESULT;
-      END V;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER IS
-           BEGIN
-                RETURN INTEGER (X);
-           END VALUE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT;
-           BEGIN
-                ASSIGN (B, C);
-                FOR I IN F .. L LOOP
-                     ASSIGN (A (I), B);
-                     ASSIGN (B, CREATE (VALUE (B) + 1));
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                IF X'LENGTH /= Y'LENGTH THEN
-                     RETURN FALSE;
-                ELSE FOR I IN X'RANGE LOOP
-                          IF NOT EQUAL (X (I),
-                                        Y (I - X'FIRST + Y'FIRST)) THEN
-                               RETURN FALSE;
-                          END IF;
-                     END LOOP;
-                END IF;
-                RETURN TRUE;
-           END EQUAL;
- 
-           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT IS
-                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 1);
-           BEGIN
-                ASSIGN (RESULT (INDEX'FIRST    ), X);
-                ASSIGN (RESULT (INDEX'FIRST + 1), Y);
-                RETURN RESULT;
-           END AGGR;
- 
-           FUNCTION AGGR (X, Y, Z : COMPONENT) RETURN PARENT IS
-                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 2);
-           BEGIN
-                ASSIGN (RESULT (INDEX'FIRST    ), X);
-                ASSIGN (RESULT (INDEX'FIRST + 1), Y);
-                ASSIGN (RESULT (INDEX'FIRST + 2), Z);
-                RETURN RESULT;
-           END AGGR;
- 
-      END PKG_P;
- 
- BEGIN
-      TEST ("C34005P", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A LIMITED TYPE");
- 
-      ASSIGN (X (IDENT_INT (5)), CREATE (1));
-      ASSIGN (X (IDENT_INT (6)), CREATE (2));
-      ASSIGN (X (IDENT_INT (7)), CREATE (3));
- 
-      ASSIGN (W (5), CREATE (1));
-      ASSIGN (W (6), CREATE (2));
-      ASSIGN (W (7), CREATE (3));
- 
-      ASSIGN (C, CREATE (2));
- 
-      IF NOT EQUAL (T'(X), AGGR (C1, C2, C3)) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF NOT EQUAL (T(X), AGGR (C1, C2, C3)) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF NOT EQUAL (T(W), AGGR (C1, C2, C3)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF NOT EQUAL (PARENT(X), AGGR (C1, C2, C3)) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-      END IF;
- 
-      BEGIN
-           IF NOT EQUAL (PARENT(CREATE (2, 3, C4, X)),
-                         AGGR (C4, C5))                 THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
-                        "VALUES OUTSIDE OF THE SUBTYPE T - 1");
-      END;
- 
-      IF NOT EQUAL (X(IDENT_INT (5)), C1) THEN
-           FAILED ("INCORRECT INDEX (VALUE)");
-      END IF;
- 
-      BEGIN
-           IF NOT EQUAL (X(IDENT_INT (6)..IDENT_INT (7)),
-                         AGGR (C2, C3))     OR
-              NOT EQUAL (CREATE (1, 4, C4, X)(1..3),
-                         AGGR (C4, C5, C6))           THEN
-                FAILED ("INCORRECT SLICE (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED WHILE CHECKING SLICES");
-      END;
- 
-      IF NOT (X IN T) OR AGGR (C1, C2) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (AGGR (C1, C2) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'FIRST /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST");
-      END IF;
- 
-      IF X'FIRST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF T'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT TYPE'FIRST (N)");
-      END IF;
- 
-      IF X'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF T'LAST /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST");
-      END IF;
- 
-      IF X'LAST /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF T'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT TYPE'LAST (N)");
-      END IF;
- 
-      IF X'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF T'LENGTH /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF T'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH (N)");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : PARENT (T'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (T'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT TYPE'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      IF X'SIZE < T'SIZE THEN
-           COMMENT ("X'SIZE < T'SIZE");
-      ELSIF X'SIZE = T'SIZE THEN
-           COMMENT ("X'SIZE = T'SIZE");
-      ELSE
-           COMMENT ("X'SIZE > T'SIZE");
-      END IF;
- 
-      RESULT;
- END C34005P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005r.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,346 ****
- -- C34005R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
- --     LIMITED TYPE:
- 
- --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
- --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
- --        IS CONSTRAINED.
- 
- --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
- --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 08/19/87  CREATED ORIGINAL TEST.
- --     VCL 07/01/88  ADDED EXCEPTION HANDLERS TO CATCH INCORRECT TYPE
- --                   CONVERSIONS TO DERIVED SUBTYPES.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005R IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C1 : CONSTANT LP;
-           C2 : CONSTANT LP;
-           C3 : CONSTANT LP;
-           C4 : CONSTANT LP;
-           C5 : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C1 : CONSTANT LP := 1;
-           C2 : CONSTANT LP := 2;
-           C3 : CONSTANT LP := 3;
-           C4 : CONSTANT LP := 4;
-           C5 : CONSTANT LP := 5;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 100;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
- 
-           FUNCTION CREATE ( F, L  : INDEX;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT;
- 
-           FUNCTION AGGR (W, X, Y, Z : COMPONENT) RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER IS
-           BEGIN
-                RETURN INTEGER (X);
-           END VALUE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( F, L  : INDEX;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F .. L);
-                B : COMPONENT;
-           BEGIN
-                ASSIGN (B, C);
-                FOR I IN F .. L LOOP
-                     ASSIGN (A (I), B);
-                     ASSIGN (B, CREATE (VALUE (B) + 1));
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                IF X'LENGTH /= Y'LENGTH THEN
-                     RETURN FALSE;
-                ELSE FOR I IN X'RANGE LOOP
-                          IF NOT EQUAL (X (I),
-                                        Y (I - X'FIRST + Y'FIRST)) THEN
-                               RETURN FALSE;
-                          END IF;
-                     END LOOP;
-                END IF;
-                RETURN TRUE;
-           END EQUAL;
- 
-           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT IS
-                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 1);
-           BEGIN
-                ASSIGN (RESULT (INDEX'FIRST    ), X);
-                ASSIGN (RESULT (INDEX'FIRST + 1), Y);
-                RETURN RESULT;
-           END AGGR;
- 
-           FUNCTION AGGR (W, X, Y, Z : COMPONENT) RETURN PARENT IS
-                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 3);
-           BEGIN
-                ASSIGN (RESULT (INDEX'FIRST    ), W);
-                ASSIGN (RESULT (INDEX'FIRST + 1), X);
-                ASSIGN (RESULT (INDEX'FIRST + 2), Y);
-                ASSIGN (RESULT (INDEX'FIRST + 3), Z);
-                RETURN RESULT;
-           END AGGR;
- 
-      END PKG_P;
- 
-      PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
-      BEGIN
-           FOR I IN X'RANGE LOOP
-                ASSIGN (X (I), Y (I));
-           END LOOP;
-      END ASSIGN;
- 
-      PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
-      BEGIN
-           FOR I IN X'RANGE LOOP
-                ASSIGN (X (I), Y (I));
-           END LOOP;
-      END ASSIGN;
- 
- BEGIN
-      TEST ("C34005R", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A LIMITED TYPE");
- 
-      ASSIGN (X (IDENT_INT (5)), CREATE (2));
-      ASSIGN (X (IDENT_INT (6)), CREATE (3));
-      ASSIGN (X (IDENT_INT (7)), CREATE (4));
- 
-      ASSIGN (Y (5), C2);
-      ASSIGN (Y (6), C3);
-      ASSIGN (Y (7), C4);
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      BEGIN
-           IF NOT EQUAL (CREATE (2, 3, C4, X), AGGR (C4, C5)) THEN
-                FAILED ("CANNOT CREATE BASE TYPE VALUES OUTSIDE " &
-                        "OF THE SUBTYPE T");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
-                        "VALUES OUTSIDE OF THE SUBTYPE T");
-      END;
- 
-      BEGIN
-           IF NOT EQUAL (CREATE (2, 3, C4, Y), AGGR (C4, C5)) THEN
-                FAILED ("CANNOT CREATE BASE TYPE VALUES OUTSIDE " &
-                        "OF THE SUBTYPE S");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
-                        "VALUES OUTSIDE OF THE SUBTYPE S");
-      END;
- 
-      BEGIN
-           IF NOT EQUAL (X(IDENT_INT (6)..IDENT_INT (7)),
-                         AGGR (C3, C4))                     THEN
-                FAILED ("INCORRECT SLICE OF X (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED WHILE CHECKING SLICE OF X");
-      END;
- 
-      BEGIN
-           IF NOT EQUAL (AGGR (C3, C4),
-                         Y(IDENT_INT (6)..IDENT_INT (7)))  THEN
-                FAILED ("INCORRECT SLICE OF Y (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED WHILE CHECKING SLICE OF Y");
-      END;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= 5 OR T'LAST /= 7 OR
-         S'FIRST /= 5 OR S'LAST /= 7 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           ASSIGN (X, CREATE (5, 7, C1, X));
-           ASSIGN (Y, CREATE (5, 7, C1, Y));
-           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
-      END;
- 
-      BEGIN
-           ASSIGN (X, AGGR (C1, C2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, AGGR (C1, C2))");
-           IF EQUAL (X, AGGR (C1, C2)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- ASSIGN (X, AGGR (C1, C2))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, AGGR (C1, C2))");
-      END;
- 
-      BEGIN
-           ASSIGN (X, AGGR (C1, C2, C3, C4));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, AGGR (C1, C2, C3, C4))");
-           IF EQUAL (X, AGGR (C1, C2, C3, C4)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, AGGR (C1, C2, C3, C4))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, AGGR (C1, C2, C3, C4))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, AGGR (C1, C2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, AGGR (C1, C2))");
-           IF EQUAL (Y, AGGR (C1, C2)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- ASSIGN (Y, AGGR (C1, C2))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, AGGR (C1, C2))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, AGGR (C1, C2, C3, C4));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
-           IF EQUAL (Y, AGGR (C1, C2, C3, C4)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
-      END;
- 
-      RESULT;
- END C34005R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005s.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005s.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005s.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,404 ****
- -- C34005S.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
- --     COMPONENT TYPE IS A LIMITED TYPE.  THIS TEST IS PART 1 OF 2
- --     TESTS WHICH COVER THE OBJECTIVE.  THE SECOND PART IS IN TEST
- --     C34005V.
- 
- -- HISTORY:
- --     JRK 08/20/87  CREATED ORIGINAL TEST.
- --     BCB 04/12/90  SPLIT ORIGINAL TEST INTO C34005S.ADA AND
- --                   C34005V.ADA
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005S IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C1  : CONSTANT LP;
-           C2  : CONSTANT LP;
-           C3  : CONSTANT LP;
-           C4  : CONSTANT LP;
-           C5  : CONSTANT LP;
-           C6  : CONSTANT LP;
-           C7  : CONSTANT LP;
-           C8  : CONSTANT LP;
-           C9  : CONSTANT LP;
-           C10 : CONSTANT LP;
-           C11 : CONSTANT LP;
-           C12 : CONSTANT LP;
-           C13 : CONSTANT LP;
-           C14 : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C1  : CONSTANT LP :=  1;
-           C2  : CONSTANT LP :=  2;
-           C3  : CONSTANT LP :=  3;
-           C4  : CONSTANT LP :=  4;
-           C5  : CONSTANT LP :=  5;
-           C6  : CONSTANT LP :=  6;
-           C7  : CONSTANT LP :=  7;
-           C8  : CONSTANT LP :=  8;
-           C9  : CONSTANT LP :=  9;
-           C10 : CONSTANT LP := 10;
-           C11 : CONSTANT LP := 11;
-           C12 : CONSTANT LP := 12;
-           C13 : CONSTANT LP := 13;
-           C14 : CONSTANT LP := 14;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 10;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
-                                COMPONENT;
- 
-           FUNCTION CREATE ( F1, L1 : INDEX;
-                             F2, L2 : INDEX;
-                             C      : COMPONENT;
-                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
-                            IDENT_INT (6) .. IDENT_INT (8));
- 
-      TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
-                         COMPONENT;
- 
-      SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
- 
-      X : T;
-      W : PARENT (4 .. 5, 6 .. 8);
-      C : COMPONENT;
-      B : BOOLEAN := FALSE;
-      U : ARR;
-      N : CONSTANT := 2;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-           RESULT : T;
-      BEGIN
-           FOR I IN RESULT'RANGE LOOP
-                FOR J IN RESULT'RANGE(2) LOOP
-                     ASSIGN (RESULT (I, J), C);
-                END LOOP;
-           END LOOP;
-           RETURN RESULT;
-      END V;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER IS
-           BEGIN
-                RETURN INTEGER (X);
-           END VALUE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( F1, L1 : INDEX;
-                F2, L2 : INDEX;
-                C      : COMPONENT;
-                DUMMY  : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F1 .. L1, F2 .. L2);
-                B : COMPONENT;
-           BEGIN
-                ASSIGN (B, C);
-                FOR I IN F1 .. L1 LOOP
-                     FOR J IN F2 .. L2 LOOP
-                          ASSIGN (A (I, J), B);
-                          ASSIGN (B, CREATE (VALUE (B) + 1));
-                     END LOOP;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                IF X'LENGTH /= Y'LENGTH OR
-                   X'LENGTH(2) /= Y'LENGTH(2) THEN
-                     RETURN FALSE;
-                ELSE FOR I IN X'RANGE LOOP
-                          FOR J IN X'RANGE(2) LOOP
-                               IF NOT EQUAL (X (I, J),
-                                             Y (I - X'FIRST + Y'FIRST,
-                                                J - X'FIRST(2) +
-                                                    Y'FIRST(2))) THEN
-                                    RETURN FALSE;
-                               END IF;
-                          END LOOP;
-                     END LOOP;
-                END IF;
-                RETURN TRUE;
-           END EQUAL;
- 
-      END PKG_P;
- 
-      FUNCTION EQUAL (X, Y : ARRT) RETURN BOOLEAN IS
-      BEGIN
-           IF X'LENGTH /= Y'LENGTH OR X'LENGTH(2) /= Y'LENGTH(2) THEN
-                RETURN FALSE;
-           ELSE FOR I IN X'RANGE LOOP
-                     FOR J IN X'RANGE(2) LOOP
-                          IF NOT EQUAL (X (I, J),
-                                        Y (I - X'FIRST + Y'FIRST,
-                                           J - X'FIRST(2) +
-                                               Y'FIRST(2))) THEN
-                               RETURN FALSE;
-                          END IF;
-                     END LOOP;
-                END LOOP;
-           END IF;
-           RETURN TRUE;
-      END EQUAL;
- 
- BEGIN
-      TEST ("C34005S", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A LIMITED TYPE.    THIS TEST IS PART " &
-                       "1 OF 2 TESTS WHICH COVER THE OBJECTIVE.  THE " &
-                       "SECOND PART IS IN TEST C34005V");
- 
-      ASSIGN (X (IDENT_INT (4), IDENT_INT (6)), CREATE (1));
-      ASSIGN (X (IDENT_INT (4), IDENT_INT (7)), CREATE (2));
-      ASSIGN (X (IDENT_INT (4), IDENT_INT (8)), CREATE (3));
-      ASSIGN (X (IDENT_INT (5), IDENT_INT (6)), CREATE (4));
-      ASSIGN (X (IDENT_INT (5), IDENT_INT (7)), CREATE (5));
-      ASSIGN (X (IDENT_INT (5), IDENT_INT (8)), CREATE (6));
- 
-      ASSIGN (W (4, 6), CREATE (1));
-      ASSIGN (W (4, 7), CREATE (2));
-      ASSIGN (W (4, 8), CREATE (3));
-      ASSIGN (W (5, 6), CREATE (4));
-      ASSIGN (W (5, 7), CREATE (5));
-      ASSIGN (W (5, 8), CREATE (6));
- 
-      ASSIGN (C, CREATE (2));
- 
-      ASSIGN (U (8, 2), CREATE (1));
-      ASSIGN (U (8, 3), CREATE (2));
-      ASSIGN (U (8, 4), CREATE (3));
-      ASSIGN (U (9, 2), CREATE (4));
-      ASSIGN (U (9, 3), CREATE (5));
-      ASSIGN (U (9, 4), CREATE (6));
- 
-      IF NOT EQUAL (X (IDENT_INT (4), IDENT_INT (6)), C1) OR
-         NOT EQUAL (CREATE (6, 9, 2, 3, C4, X) (9, 3), C11) THEN
-           FAILED ("INCORRECT INDEX (VALUE)");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF T'FIRST /= 4 THEN
-           FAILED ("INCORRECT TYPE'FIRST");
-      END IF;
- 
-      IF X'FIRST /= 4 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 4 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF T'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT TYPE'FIRST (N)");
-      END IF;
- 
-      IF X'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF T'LAST /= 5 THEN
-           FAILED ("INCORRECT TYPE'LAST");
-      END IF;
- 
-      IF X'LAST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 5 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF T'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT TYPE'LAST (N)");
-      END IF;
- 
-      IF X'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF T'LENGTH /= 2 THEN
-           FAILED ("INCORRECT TYPE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH /= 2 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 2 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF T'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT TYPE'LENGTH (N)");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : PARENT (T'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT TYPE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (X'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (V'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (1 .. 2, T'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT TYPE'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (1 .. 2, X'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : PARENT (1 .. 2, V'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34005S;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005u.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005u.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005u.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,408 ****
- -- C34005U.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS
- --     A LIMITED TYPE:
- 
- --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
- --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
- --        IS CONSTRAINED.
- 
- --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
- --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 08/21/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005U IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C1  : CONSTANT LP;
-           C2  : CONSTANT LP;
-           C3  : CONSTANT LP;
-           C4  : CONSTANT LP;
-           C5  : CONSTANT LP;
-           C6  : CONSTANT LP;
-           C7  : CONSTANT LP;
-           C8  : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C1  : CONSTANT LP :=  1;
-           C2  : CONSTANT LP :=  2;
-           C3  : CONSTANT LP :=  3;
-           C4  : CONSTANT LP :=  4;
-           C5  : CONSTANT LP :=  5;
-           C6  : CONSTANT LP :=  6;
-           C7  : CONSTANT LP :=  7;
-           C8  : CONSTANT LP :=  8;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 10;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
-                                COMPONENT;
- 
-           FUNCTION CREATE ( F1, L1 : INDEX;
-                             F2, L2 : INDEX;
-                             C      : COMPONENT;
-                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
-                         RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
-                            IDENT_INT (6) .. IDENT_INT (8));
- 
-      SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER IS
-           BEGIN
-                RETURN INTEGER (X);
-           END VALUE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( F1, L1 : INDEX;
-                F2, L2 : INDEX;
-                C      : COMPONENT;
-                DUMMY  : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F1 .. L1, F2 .. L2);
-                B : COMPONENT;
-           BEGIN
-                ASSIGN (B, C);
-                FOR I IN F1 .. L1 LOOP
-                     FOR J IN F2 .. L2 LOOP
-                          ASSIGN (A (I, J), B);
-                          ASSIGN (B, CREATE (VALUE (B) + 1));
-                     END LOOP;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                IF X'LENGTH /= Y'LENGTH OR
-                   X'LENGTH(2) /= Y'LENGTH(2) THEN
-                     RETURN FALSE;
-                ELSE FOR I IN X'RANGE LOOP
-                          FOR J IN X'RANGE(2) LOOP
-                               IF NOT EQUAL (X (I, J),
-                                             Y (I - X'FIRST + Y'FIRST,
-                                                J - X'FIRST(2) +
-                                                    Y'FIRST(2))) THEN
-                                    RETURN FALSE;
-                               END IF;
-                          END LOOP;
-                     END LOOP;
-                END IF;
-                RETURN TRUE;
-           END EQUAL;
- 
-           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
-                         RETURN PARENT IS
-                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 3,
-                            INDEX'FIRST .. INDEX'FIRST + 1);
-           BEGIN
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
-                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), E);
-                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), F);
-                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST    ), G);
-                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST + 1), H);
-                RETURN X;
-           END AGGR;
- 
-      END PKG_P;
- 
-      PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
-      BEGIN
-           FOR I IN X'RANGE LOOP
-                FOR J IN X'RANGE(2) LOOP
-                     ASSIGN (X (I, J), Y (I, J));
-                END LOOP;
-           END LOOP;
-      END ASSIGN;
- 
-      PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
-      BEGIN
-           FOR I IN X'RANGE LOOP
-                FOR J IN X'RANGE(2) LOOP
-                     ASSIGN (X (I, J), Y (I, J));
-                END LOOP;
-           END LOOP;
-      END ASSIGN;
- 
- BEGIN
-      TEST ("C34005U", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A LIMITED TYPE");
- 
-      FOR I IN X'RANGE LOOP
-           FOR J IN X'RANGE(2) LOOP
-                ASSIGN (X (I, J), C2);
-                ASSIGN (Y (I, J), C2);
-           END LOOP;
-      END LOOP;
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
-      BEGIN
-           IF NOT EQUAL (CREATE (6, 9, 2, 3, C1, X),
-                         AGGR (C1, C2, C3, C4, C5, C6, C7, C8)) OR
-              NOT EQUAL (CREATE (6, 9, 2, 3, C1, Y),
-                         AGGR (C1, C2, C3, C4, C5, C6, C7, C8)) THEN
-                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
-                        "SUBTYPE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR WHEN TRYING TO CREATE BASE " &
-                        "TYPE VALUES OUTSIDE THE SUBTYPE");
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION WHEN TRYING TO CREATE BASE TYPE " &
-                        "VALUES OUTSIDE THE SUBTYPE");
-      END;
- 
-      IF AGGR (C1, C2, C3, C4, C5, C6, C7, C8) IN T OR
-         AGGR (C1, C2, C3, C4, C5, C6, C7, C8) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF T'FIRST /= 4 OR T'LAST /= 5 OR
-         S'FIRST /= 4 OR S'LAST /= 5 OR
-         T'FIRST (2) /= 6 OR T'LAST (2) /= 8 OR
-         S'FIRST (2) /= 6 OR S'LAST (2) /= 8 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           ASSIGN (X, CREATE (4, 5, 6, 8, C1, X));
-           ASSIGN (Y, CREATE (4, 5, 6, 8, C1, Y));
-           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
-      END;
- 
-      BEGIN
-           ASSIGN (X, CREATE (4, 4, 6, 8, C1, X));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
-           IF EQUAL (X, CREATE (4, 4, 6, 8, C1, X)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
-      END;
- 
-      BEGIN
-           ASSIGN (X, CREATE (4, 6, 6, 8, C1, X));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
-           IF EQUAL (X, CREATE (4, 6, 6, 8, C1, X)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
-      END;
- 
-      BEGIN
-           ASSIGN (X, CREATE (4, 5, 6, 7, C1, X));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
-           IF EQUAL (X, CREATE (4, 5, 6, 7, C1, X)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
-      END;
- 
-      BEGIN
-           ASSIGN (X, CREATE (4, 5, 6, 9, C1, X));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
-           IF EQUAL (X, CREATE (4, 5, 6, 9, C1, X)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
-           IF EQUAL (Y, CREATE (4, 4, 6, 8, C1, Y)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
-           IF EQUAL (Y, CREATE (4, 6, 6, 8, C1, Y)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
-           IF EQUAL (Y, CREATE (4, 5, 6, 7, C1, Y)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
-           IF EQUAL (Y, CREATE (4, 5, 6, 9, C1, Y)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
-      END;
- 
-      RESULT;
- END C34005U;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005v.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34005v.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34005v.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,336 ****
- -- C34005V.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
- --     COMPONENT TYPE IS A LIMITED TYPE.  THIS TEST IS PART 2 OF 2
- --     TESTS WHICH COVER THE OBJECTIVE.  THE FIRST PART IS IN TEST
- --     C34005S.
- 
- -- HISTORY:
- --     BCB 04/12/90  CREATED ORIGINAL TEST FROM SPLIT OF C34005S.ADA.
- --     RLB 10/03/02  REMOVED ILLEGAL (BY AI-246) TYPE CONVERSIONS AND
- --                   SUPPORTING CODE.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34005V IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C1  : CONSTANT LP;
-           C2  : CONSTANT LP;
-           C3  : CONSTANT LP;
-           C4  : CONSTANT LP;
-           C5  : CONSTANT LP;
-           C6  : CONSTANT LP;
-           C7  : CONSTANT LP;
-           C8  : CONSTANT LP;
-           C9  : CONSTANT LP;
-           C10 : CONSTANT LP;
-           C11 : CONSTANT LP;
-           C12 : CONSTANT LP;
-           C13 : CONSTANT LP;
-           C14 : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C1  : CONSTANT LP :=  1;
-           C2  : CONSTANT LP :=  2;
-           C3  : CONSTANT LP :=  3;
-           C4  : CONSTANT LP :=  4;
-           C5  : CONSTANT LP :=  5;
-           C6  : CONSTANT LP :=  6;
-           C7  : CONSTANT LP :=  7;
-           C8  : CONSTANT LP :=  8;
-           C9  : CONSTANT LP :=  9;
-           C10 : CONSTANT LP := 10;
-           C11 : CONSTANT LP := 11;
-           C12 : CONSTANT LP := 12;
-           C13 : CONSTANT LP := 13;
-           C14 : CONSTANT LP := 14;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           FIRST : CONSTANT := 0;
-           LAST  : CONSTANT := 10;
- 
-           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
- 
-           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
-                                COMPONENT;
- 
-           FUNCTION CREATE ( F1, L1 : INDEX;
-                             F2, L2 : INDEX;
-                             C      : COMPONENT;
-                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           FUNCTION AGGR (A, B, C, D : COMPONENT) RETURN PARENT;
- 
-           FUNCTION AGGR (A, B, C, D, E, F : COMPONENT) RETURN PARENT;
- 
-           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
-                         RETURN PARENT;
- 
-           FUNCTION AGGR (A, B, C, D, E, F, G, H, I : COMPONENT)
-                         RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
-                            IDENT_INT (6) .. IDENT_INT (8));
- 
-      X : T;
-      W : PARENT (4 .. 5, 6 .. 8);
-      C : COMPONENT;
-      B : BOOLEAN := FALSE;
-      N : CONSTANT := 2;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-           RESULT : T;
-      BEGIN
-           FOR I IN RESULT'RANGE LOOP
-                FOR J IN RESULT'RANGE(2) LOOP
-                     ASSIGN (RESULT (I, J), C);
-                END LOOP;
-           END LOOP;
-           RETURN RESULT;
-      END V;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION VALUE (X : LP) RETURN INTEGER IS
-           BEGIN
-                RETURN INTEGER (X);
-           END VALUE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( F1, L1 : INDEX;
-                F2, L2 : INDEX;
-                C      : COMPONENT;
-                DUMMY  : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (F1 .. L1, F2 .. L2);
-                B : COMPONENT;
-           BEGIN
-                ASSIGN (B, C);
-                FOR I IN F1 .. L1 LOOP
-                     FOR J IN F2 .. L2 LOOP
-                          ASSIGN (A (I, J), B);
-                          ASSIGN (B, CREATE (VALUE (B) + 1));
-                     END LOOP;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                IF X'LENGTH /= Y'LENGTH OR
-                   X'LENGTH(2) /= Y'LENGTH(2) THEN
-                     RETURN FALSE;
-                ELSE FOR I IN X'RANGE LOOP
-                          FOR J IN X'RANGE(2) LOOP
-                               IF NOT EQUAL (X (I, J),
-                                             Y (I - X'FIRST + Y'FIRST,
-                                                J - X'FIRST(2) +
-                                                    Y'FIRST(2))) THEN
-                                    RETURN FALSE;
-                               END IF;
-                          END LOOP;
-                     END LOOP;
-                END IF;
-                RETURN TRUE;
-           END EQUAL;
- 
-           FUNCTION AGGR (A, B, C, D : COMPONENT) RETURN PARENT IS
-                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 1,
-                            INDEX'FIRST .. INDEX'FIRST + 1);
-           BEGIN
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
-                RETURN X;
-           END AGGR;
- 
-           FUNCTION AGGR (A, B, C, D, E, F : COMPONENT) RETURN PARENT IS
-                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 1,
-                            INDEX'FIRST .. INDEX'FIRST + 2);
-           BEGIN
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 2), C);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), D);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), E);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 2), F);
-                RETURN X;
-           END AGGR;
- 
-           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
-                         RETURN PARENT IS
-                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 3,
-                            INDEX'FIRST .. INDEX'FIRST + 1);
-           BEGIN
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
-                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), E);
-                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), F);
-                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST    ), G);
-                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST + 1), H);
-                RETURN X;
-           END AGGR;
- 
-           FUNCTION AGGR (A, B, C, D, E, F, G, H, I : COMPONENT)
-                         RETURN PARENT IS
-                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 2,
-                            INDEX'FIRST .. INDEX'FIRST + 2);
-           BEGIN
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
-                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 2), C);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), D);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), E);
-                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 2), F);
-                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), G);
-                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), H);
-                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 2), I);
-                RETURN X;
-           END AGGR;
- 
-      END PKG_P;
- 
- BEGIN
-      TEST ("C34005V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
-                       "TYPE IS A LIMITED TYPE.  THIS TEST IS PART 2 " &
-                       "OF 2 TESTS WHICH COVER THE OBJECTIVE.  THE " &
-                       "FIRST PART IS IN TEST C34005S");
- 
-      ASSIGN (X (IDENT_INT (4), IDENT_INT (6)), CREATE (1));
-      ASSIGN (X (IDENT_INT (4), IDENT_INT (7)), CREATE (2));
-      ASSIGN (X (IDENT_INT (4), IDENT_INT (8)), CREATE (3));
-      ASSIGN (X (IDENT_INT (5), IDENT_INT (6)), CREATE (4));
-      ASSIGN (X (IDENT_INT (5), IDENT_INT (7)), CREATE (5));
-      ASSIGN (X (IDENT_INT (5), IDENT_INT (8)), CREATE (6));
- 
-      ASSIGN (W (4, 6), CREATE (1));
-      ASSIGN (W (4, 7), CREATE (2));
-      ASSIGN (W (4, 8), CREATE (3));
-      ASSIGN (W (5, 6), CREATE (4));
-      ASSIGN (W (5, 7), CREATE (5));
-      ASSIGN (W (5, 8), CREATE (6));
- 
-      ASSIGN (C, CREATE (2));
- 
-      IF NOT EQUAL (T'(X), AGGR (C1, C2, C3, C4, C5, C6)) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF NOT EQUAL (T (X), AGGR (C1, C2, C3, C4, C5, C6)) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF NOT EQUAL (T (W), AGGR (C1, C2, C3, C4, C5, C6)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      BEGIN
-           IF NOT EQUAL (PARENT (X), AGGR (C1, C2, C3, C4, C5, C6)) OR
-              NOT EQUAL (PARENT (CREATE (6, 9, 2, 3, C4, X)),
-                         AGGR (C4, C5, C6, C7, C8, C9, C10, C11)) THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR WHEN PREPARING TO CONVERT " &
-                        "TO PARENT");
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION WHEN PREPARING TO CONVERT " &
-                        "TO PARENT");
-      END;
- 
-      IF NOT (X IN T) OR AGGR (C1, C2, C3, C4) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR
-         NOT (AGGR (C1, C2, C3, C4, C5, C6, C7, C8, C9) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      RESULT;
- END C34005V;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- C34006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITHOUT DISCRIMINANTS
- --     AND WITH NON-LIMITED COMPONENT TYPES.
- 
- -- HISTORY:
- --     JRK 09/22/86  CREATED ORIGINAL TEST.
- --     BCB 09/26/88  REMOVED COMPARISONS INVOLVING SIZE.
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34006A IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      TYPE PARENT IS
-           RECORD
-                C : COMPONENT;
-                B : BOOLEAN := TRUE;
-           END RECORD;
- 
-      TYPE T IS NEW PARENT;
- 
-      X : T         := (2, FALSE);
-      K : INTEGER   := X'SIZE;
-      W : PARENT    := (2, FALSE);
-      C : COMPONENT := 1;
-      B : BOOLEAN   := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (X.C, X.C) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN (-1, FALSE);
-      END IDENT;
- 
- BEGIN
-      TEST ("C34006A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "RECORD TYPES WITHOUT DISCRIMINANTS AND WITH " &
-                       "NON-LIMITED COMPONENT TYPES");
- 
-      X := IDENT ((1, TRUE));
-      IF X /= (1, TRUE) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= (1, TRUE) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= (1, TRUE) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := (1, TRUE);
-      END IF;
-      IF T (W) /= (1, TRUE) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF PARENT (X) /= (1, TRUE) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF IDENT ((1, TRUE)) /= (1, TRUE) THEN
-           FAILED ("INCORRECT AGGREGATE");
-      END IF;
- 
-      IF X.C /= 1 OR X.B /= TRUE THEN
-           FAILED ("INCORRECT SELECTION (VALUE)");
-      END IF;
- 
-      X.C := IDENT_INT (3);
-      X.B := IDENT_BOOL (FALSE);
-      IF X /= (3, FALSE) THEN
-           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
-      END IF;
- 
-      X := IDENT ((1, TRUE));
-      IF X = IDENT ((1, FALSE)) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT ((1, TRUE)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF X.C'FIRST_BIT < 0 THEN
-           FAILED ("INCORRECT 'FIRST_BIT");
-      END IF;
- 
-      IF X.C'LAST_BIT < 0 OR
-         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
-           FAILED ("INCORRECT 'LAST_BIT");
-      END IF;
- 
-      IF X.C'POSITION < 0 THEN
-           FAILED ("INCORRECT 'POSITION");
-      END IF;
- 
- 
-      RESULT;
- END C34006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,238 ****
- -- C34006D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH
- --     NON-LIMITED COMPONENT TYPES.
- 
- -- HISTORY:
- --     JRK 09/22/86  CREATED ORIGINAL TEST.
- --     BCB 11/13/87  CHANGED TEST SO AN OBJECT'S SIZE MAY BE LESS THAN
- --                   THAT OF ITS TYPE.
- --     RJW 08/21/89  MODIFIED CHECKS FOR SIZE.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34006D IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L);
-                               C : COMPONENT;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      X : T         := (TRUE, 3, 2, "AAA", 2);
-      W : PARENT    := (TRUE, 3, 2, "AAA", 2);
-      C : COMPONENT := 1;
-      B : BOOLEAN   := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, C);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF EQUAL (X.I, X.I) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN (TRUE, 3, -1, "---", -1);
-      END IDENT;
- 
- BEGIN
-      TEST ("C34006D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "RECORD TYPES WITH DISCRIMINANTS AND WITH " &
-                       "NON-LIMITED COMPONENT TYPES");
- 
-      X := IDENT ((TRUE, 3, 1, "ABC", 4));
-      IF X /= (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := (TRUE, 3, 1, "ABC", 4);
-      END IF;
-      IF T (W) /= (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      BEGIN
-           IF PARENT (X) /= (TRUE, 3, 1, "ABC", 4) OR
-              PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
-              (FALSE, 2, 3, 6.0) THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
-      END;
- 
-      IF IDENT ((TRUE, 3, 1, "ABC", 4)) /= (TRUE, 3, 1, "ABC", 4) OR
-         X = (FALSE, 3, 1, 4.0) THEN
-           FAILED ("INCORRECT AGGREGATE");
-      END IF;
- 
-      BEGIN
-           IF X.B /= TRUE OR X.L /= 3 OR
-              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
-              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
-                FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
-      END;
- 
-      BEGIN
-           IF X.I /= 1 OR X.S /= "ABC" OR X.C /= 4 OR
-              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I /= 3 OR
-              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F /= 6.0 THEN
-                FAILED ("INCORRECT SELECTION (VALUE)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
-      END;
- 
-      X.I := IDENT_INT (7);
-      X.S := IDENT_STR ("XYZ");
-      X.C := IDENT_INT (9);
-      IF X /= (TRUE, 3, 7, "XYZ", 9) THEN
-           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
-      END IF;
- 
-      X := IDENT ((TRUE, 3, 1, "ABC", 4));
-      IF X = IDENT ((TRUE, 3, 1, "ABC", 5)) OR
-         X = (FALSE, 2, 3, 6.0) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= IDENT ((TRUE, 3, 1, "ABC", 4)) OR
-         NOT (X /= (FALSE, 2, 3, 6.0)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR (FALSE, 2, 3, 6.0) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT ((FALSE, 2, 3, 6.0) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF NOT X'CONSTRAINED THEN
-           FAILED ("INCORRECT 'CONSTRAINED");
-      END IF;
- 
-      IF X.C'FIRST_BIT < 0 THEN
-           FAILED ("INCORRECT 'FIRST_BIT");
-      END IF;
- 
-      IF X.C'LAST_BIT < 0 OR
-         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
-           FAILED ("INCORRECT 'LAST_BIT");
-      END IF;
- 
-      IF X.C'POSITION < 0 THEN
-           FAILED ("INCORRECT 'POSITION");
-      END IF;
- 
-      RESULT;
- END C34006D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,228 ****
- -- C34006F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH NON-LIMITED
- --     COMPONENT TYPES:
- --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
- --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --     CONSTRAINED.
- --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --     IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 9/22/86  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34006F IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L);
-                               C : COMPONENT;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := (TRUE, 3, 2, "AAA", 2);
-      Y : S := (TRUE, 3, 2, "AAA", 2);
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, C);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34006F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "RECORD TYPES WITH DISCRIMINANTS AND WITH " &
-                       "NON-LIMITED COMPONENT TYPES");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      BEGIN
-           IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) /=
-              (FALSE, 2, 3, 6.0) OR
-              CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) /=
-              (FALSE, 2, 3, 6.0) THEN
-                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
-                        "SUBTYPE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
-      END;
- 
-      BEGIN
-           IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
-              CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
-                FAILED ("INCORRECT ""IN""");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
-      END;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         Y.B /= TRUE OR Y.L /= 3 THEN
-           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
-      END IF;
- 
-      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
-           FAILED ("INCORRECT 'CONSTRAINED");
-      END IF;
- 
-      BEGIN
-           X := (TRUE, 3, 1, "ABC", 4);
-           Y := (TRUE, 3, 1, "ABC", 4);
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := (FALSE, 3, 2, 6.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (FALSE, 3, 2, 6.0)");
-           IF X = (FALSE, 3, 2, 6.0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (FALSE, 3, 2, 6.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (FALSE, 3, 2, 6.0)");
-      END;
- 
-      BEGIN
-           X := (TRUE, 4, 2, "ZZZZ", 6);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := (TRUE, 4, 2, ""ZZZZ"", 6)");
-           IF X = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := (TRUE, 4, 2, ""ZZZZ"", 6)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := (TRUE, 4, 2, ""ZZZZ"", 6)");
-      END;
- 
-      BEGIN
-           Y := (FALSE, 3, 2, 6.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (FALSE, 3, 2, 6.0)");
-           IF Y = (FALSE, 3, 2, 6.0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (FALSE, 3, 2, 6.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (FALSE, 3, 2, 6.0)");
-      END;
- 
-      BEGIN
-           Y := (TRUE, 4, 2, "ZZZZ", 6);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
-           IF Y = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
-      END;
- 
-      RESULT;
- END C34006F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,199 ****
- -- C34006G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITHOUT DISCRIMINANTS AND
- --     WITH A LIMITED COMPONENT TYPE.
- 
- -- HISTORY:
- --     JRK 08/24/87  CREATED ORIGINAL TEST.
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34006G IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C1 : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C1 : CONSTANT LP := 1;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           TYPE PARENT IS
-                RECORD
-                     C : COMPONENT;
-                     B : BOOLEAN := TRUE;
-                END RECORD;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           FUNCTION AGGR (C : COMPONENT; B : BOOLEAN) RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT;
- 
-      X : T;
-      W : PARENT;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                RETURN EQUAL (X.C, Y.C) AND X.B = Y.B;
-           END EQUAL;
- 
-           FUNCTION AGGR (C : COMPONENT; B : BOOLEAN) RETURN PARENT IS
-                RESULT : PARENT;
-           BEGIN
-                ASSIGN (RESULT.C, C);
-                RESULT.B := B;
-                RETURN RESULT;
-           END AGGR;
- 
-      END PKG_P;
- 
- BEGIN
-      TEST ("C34006G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "RECORD TYPES WITHOUT DISCRIMINANTS AND WITH A " &
-                       "LIMITED COMPONENT TYPE");
- 
-      ASSIGN (X.C, CREATE (1));
-      X.B := IDENT_BOOL (TRUE);
- 
-      ASSIGN (W.C, CREATE (1));
-      W.B := IDENT_BOOL (TRUE);
- 
-      IF NOT EQUAL (T'(X), AGGR (C1, TRUE)) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF NOT EQUAL (T (X), AGGR (C1, TRUE)) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF NOT EQUAL (T (W), AGGR (C1, TRUE)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF NOT EQUAL (PARENT (X), AGGR (C1, TRUE)) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF NOT EQUAL (X.C, C1) OR X.B /= TRUE THEN
-           FAILED ("INCORRECT SELECTION (VALUE)");
-      END IF;
- 
-      X.B := IDENT_BOOL (FALSE);
-      IF NOT EQUAL (X, AGGR (C1, FALSE)) THEN
-           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
-      END IF;
- 
-      X.B := IDENT_BOOL (TRUE);
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF X.C'FIRST_BIT < 0 THEN
-           FAILED ("INCORRECT 'FIRST_BIT");
-      END IF;
- 
-      IF X.C'LAST_BIT < 0 OR
-         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
-           FAILED ("INCORRECT 'LAST_BIT");
-      END IF;
- 
-      IF X.C'POSITION < 0 THEN
-           FAILED ("INCORRECT 'POSITION");
-      END IF;
- 
-      IF X'SIZE   < T'SIZE OR
-         X.C'SIZE < COMPONENT'SIZE OR
-         X.B'SIZE < BOOLEAN'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34006G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,311 ****
- -- C34006J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH
- --     A LIMITED COMPONENT TYPE.
- 
- -- HISTORY:
- --     JRK 08/25/87  CREATED ORIGINAL TEST.
- --     VCL 06/28/88  MODIFIED THE STATEMENTS INVOLVING THE 'SIZE
- --                   ATTRIBUTE TO REMOVE ANY ASSUMPTIONS ABOUT THE
- --                   SIZES.
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34006J IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C4 : CONSTANT LP;
-           C5 : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C4 : CONSTANT LP := 4;
-           C5 : CONSTANT LP := 5;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
-                RECORD
-                     I : INTEGER := 2;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L) := (1 .. L => 'A');
-                               C : COMPONENT;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           FUNCTION AGGR ( B : BOOLEAN;
-                           L : LENGTH;
-                           I : INTEGER;
-                           S : STRING;
-                           C : COMPONENT
-                         ) RETURN PARENT;
- 
-           FUNCTION AGGR ( B : BOOLEAN;
-                           L : LENGTH;
-                           I : INTEGER;
-                           F : FLOAT
-                         ) RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      X : T;
-      W : PARENT;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (B, L);
-           BEGIN
-                A.I := I;
-                CASE B IS
-                     WHEN TRUE =>
-                          A.S := S;
-                          ASSIGN (A.C, C);
-                     WHEN FALSE =>
-                          A.F := F;
-                END CASE;
-                RETURN A;
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                IF X.B /= Y.B OR X.L /= Y.L OR X.I /= Y.I THEN
-                     RETURN FALSE;
-                END IF;
-                CASE X.B IS
-                     WHEN TRUE =>
-                          RETURN X.S = Y.S AND EQUAL (X.C, Y.C);
-                     WHEN FALSE =>
-                          RETURN X.F = Y.F;
-                END CASE;
-           END EQUAL;
- 
-           FUNCTION AGGR
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT
-              ) RETURN PARENT
-           IS
-                RESULT : PARENT (B, L);
-           BEGIN
-                RESULT.I := I;
-                RESULT.S := S;
-                ASSIGN (RESULT.C, C);
-                RETURN RESULT;
-           END AGGR;
- 
-           FUNCTION AGGR
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                F : FLOAT
-              ) RETURN PARENT
-           IS
-                RESULT : PARENT (B, L);
-           BEGIN
-                RESULT.I := I;
-                RESULT.F := F;
-                RETURN RESULT;
-           END AGGR;
- 
-      END PKG_P;
- 
- BEGIN
-      TEST ("C34006J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "RECORD TYPES WITH DISCRIMINANTS AND WITH A " &
-                       "LIMITED COMPONENT TYPE");
- 
-      X.I := IDENT_INT (1);
-      X.S := IDENT_STR ("ABC");
-      ASSIGN (X.C, CREATE (4));
- 
-      W.I := IDENT_INT (1);
-      W.S := IDENT_STR ("ABC");
-      ASSIGN (W.C, CREATE (4));
- 
-      IF NOT EQUAL (T'(X), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF NOT EQUAL (T(X), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF NOT EQUAL (T(W), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF NOT EQUAL (PARENT(X), AGGR (TRUE, 3, 1, "ABC", C4))   OR
-         NOT EQUAL (PARENT(CREATE (FALSE, 2, 3, "XX", C5, 6.0, X)),
-                    AGGR (FALSE, 2, 3, 6.0))   THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).B /= FALSE OR
-         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).L /= 2 THEN
-           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
-      END IF;
- 
-      IF X.I /= 1 OR X.S /= "ABC" OR NOT EQUAL (X.C, C4) OR
-         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).I /= 3 OR
-         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).F /= 6.0 THEN
-           FAILED ("INCORRECT SELECTION (VALUE)");
-      END IF;
- 
-      X.I := IDENT_INT (7);
-      X.S := IDENT_STR ("XYZ");
-      IF NOT EQUAL (X, AGGR (TRUE, 3, 7, "XYZ", C4)) THEN
-           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
-      END IF;
- 
-      X.I := IDENT_INT (1);
-      X.S := IDENT_STR ("ABC");
-      IF NOT (X IN T) OR AGGR (FALSE, 2, 3, 6.0) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (AGGR (FALSE, 2, 3, 6.0) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF NOT X'CONSTRAINED THEN
-           FAILED ("INCORRECT 'CONSTRAINED");
-      END IF;
- 
-      IF X.C'FIRST_BIT < 0 THEN
-           FAILED ("INCORRECT 'FIRST_BIT");
-      END IF;
- 
-      IF X.C'LAST_BIT < 0 OR
-         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
-           FAILED ("INCORRECT 'LAST_BIT");
-      END IF;
- 
-      IF X.C'POSITION < 0 THEN
-           FAILED ("INCORRECT 'POSITION");
-      END IF;
- 
-      IF X'SIZE < T'SIZE THEN
-           COMMENT ("X'SIZE < T'SIZE");
-      ELSIF X'SIZE = T'SIZE THEN
-           COMMENT ("X'SIZE = T'SIZE");
-      ELSE
-           COMMENT ("X'SIZE > T'SIZE");
-      END IF;
- 
-      RESULT;
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("UNEXPECTED EXCEPTION RAISED WHILE CHECKING BASIC " &
-                   "OPERATIONS");
-           RESULT;
- END C34006J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34006l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34006l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,345 ****
- -- C34006L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH A LIMITED
- --     COMPONENT TYPE:
- 
- --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
- --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
- --        IS CONSTRAINED.
- 
- --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
- --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 08/26/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34006L IS
- 
-      PACKAGE PKG_L IS
- 
-           TYPE LP IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
- 
-           C2 : CONSTANT LP;
-           C4 : CONSTANT LP;
-           C5 : CONSTANT LP;
-           C6 : CONSTANT LP;
- 
-      PRIVATE
- 
-           TYPE LP IS NEW INTEGER;
- 
-           C2 : CONSTANT LP := 2;
-           C4 : CONSTANT LP := 4;
-           C5 : CONSTANT LP := 5;
-           C6 : CONSTANT LP := 6;
- 
-      END PKG_L;
- 
-      USE PKG_L;
- 
-      SUBTYPE COMPONENT IS LP;
- 
-      PACKAGE PKG_P IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
-                RECORD
-                     I : INTEGER := 2;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L) := (1 .. L => 'A');
-                               C : COMPONENT;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           FUNCTION AGGR ( B : BOOLEAN;
-                           L : LENGTH;
-                           I : INTEGER;
-                           S : STRING;
-                           C : COMPONENT
-                         ) RETURN PARENT;
- 
-           FUNCTION AGGR ( B : BOOLEAN;
-                           L : LENGTH;
-                           I : INTEGER;
-                           F : FLOAT
-                         ) RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
-      PACKAGE BODY PKG_L IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN LP IS
-           BEGIN
-                RETURN LP (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG_L;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT (B, L);
-           BEGIN
-                A.I := I;
-                CASE B IS
-                     WHEN TRUE =>
-                          A.S := S;
-                          ASSIGN (A.C, C);
-                     WHEN FALSE =>
-                          A.F := F;
-                END CASE;
-                RETURN A;
-           END CREATE;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                IF X.B /= Y.B OR X.L /= Y.L OR X.I /= Y.I THEN
-                     RETURN FALSE;
-                END IF;
-                CASE X.B IS
-                     WHEN TRUE =>
-                          RETURN X.S = Y.S AND EQUAL (X.C, Y.C);
-                     WHEN FALSE =>
-                          RETURN X.F = Y.F;
-                END CASE;
-           END EQUAL;
- 
-           FUNCTION AGGR
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT
-              ) RETURN PARENT
-           IS
-                RESULT : PARENT (B, L);
-           BEGIN
-                RESULT.I := I;
-                RESULT.S := S;
-                ASSIGN (RESULT.C, C);
-                RETURN RESULT;
-           END AGGR;
- 
-           FUNCTION AGGR
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                F : FLOAT
-              ) RETURN PARENT
-           IS
-                RESULT : PARENT (B, L);
-           BEGIN
-                RESULT.I := I;
-                RESULT.F := F;
-                RETURN RESULT;
-           END AGGR;
- 
-      END PKG_P;
- 
-      PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
-      BEGIN
-           X.I := Y.I;
-           X.S := Y.S;
-           ASSIGN (X.C, Y.C);
-      END ASSIGN;
- 
-      PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
-      BEGIN
-           X.I := Y.I;
-           X.S := Y.S;
-           ASSIGN (X.C, Y.C);
-      END ASSIGN;
- 
- BEGIN
-      TEST ("C34006L", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "RECORD TYPES WITH DISCRIMINANTS AND WITH A " &
-                       "LIMITED COMPONENT TYPE");
- 
-      ASSIGN (X.C, CREATE (2));
-      ASSIGN (Y.C, C2);
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, X),
-                    AGGR (FALSE, 2, 3, 6.0)) OR
-         NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, Y),
-                    AGGR (FALSE, 2, 3, 6.0)) THEN
-           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
-      END IF;
- 
-      IF CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, X) IN T OR
-         CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, Y) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         Y.B /= TRUE OR Y.L /= 3 THEN
-           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
-      END IF;
- 
-      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
-           FAILED ("INCORRECT 'CONSTRAINED");
-      END IF;
- 
-      BEGIN
-           ASSIGN (X, AGGR (TRUE, 3, 1, "ABC", C4));
-           ASSIGN (Y, AGGR (TRUE, 3, 1, "ABC", C4));
-           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
-      END;
- 
-      BEGIN
-           ASSIGN (X, AGGR (FALSE, 3, 2, 6.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
-           IF EQUAL (X, AGGR (FALSE, 3, 2, 6.0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
-      END;
- 
-      BEGIN
-           ASSIGN (X, AGGR (TRUE, 4, 2, "ZZZZ", C6));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
-           IF EQUAL (X, AGGR (TRUE, 4, 2, "ZZZZ", C6)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
-           IF EQUAL (Y, AGGR (FALSE, 3, 2, 6.0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, AGGR (TRUE, 4, 2, "ZZZZ", C6));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
-           IF EQUAL (Y, AGGR (TRUE, 4, 2, "ZZZZ", C6)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
-      END;
- 
-      RESULT;
- END C34006L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,181 ****
- -- C34007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS
- --     NOT AN ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A TYPE WITH
- --     DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 09/24/86  CREATED ORIGINAL TEST.
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
- --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
- --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
- --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
- --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
- --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007A IS
- 
-      TYPE DESIGNATED IS RANGE -100 .. 100;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED RANGE
-                DESIGNATED'VAL (IDENT_INT (-50)) ..
-                DESIGNATED'VAL (IDENT_INT ( 50));
- 
-      TYPE PARENT IS ACCESS SUBDESIGNATED RANGE
-                DESIGNATED'VAL (IDENT_INT (-30)) ..
-                DESIGNATED'VAL (IDENT_INT ( 30));
- 
-      TYPE T IS NEW PARENT;
- 
-      X : T       := NEW DESIGNATED'(-30);
-      K : INTEGER := X'SIZE;
-      Y : T       := NEW DESIGNATED'( 30);
-      W : PARENT  := NEW DESIGNATED'( 30);
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF X = NULL OR ELSE
-              EQUAL (DESIGNATED'POS (X.ALL), DESIGNATED'POS (X.ALL)) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW DESIGNATED;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34007A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS NOT AN " &
-                       "ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A " &
-                       "TYPE WITH DISCRIMINANTS");
- 
-      IF Y = NULL OR ELSE Y.ALL /= 30 THEN
-           FAILED ("INCORRECT INITIALIZATION");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X /= Y THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= Y THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= Y THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := NEW DESIGNATED'(-30);
-      END IF;
-      X := T (W);
-      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= -30 THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      X := IDENT (Y);
-      W := PARENT (X);
-      IF W = NULL OR ELSE W.ALL /= 30 OR ELSE T (W) /= Y THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF IDENT (NULL) /= NULL OR X = NULL THEN
-           FAILED ("INCORRECT NULL");
-      END IF;
- 
-      X := IDENT (NEW DESIGNATED'(30));
-      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= 30 THEN
-           FAILED ("INCORRECT ALLOCATOR");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X.ALL /= 30 THEN
-           FAILED ("INCORRECT .ALL (VALUE)");
-      END IF;
- 
-      X.ALL := DESIGNATED'VAL (IDENT_INT (10));
-      IF X /= Y OR Y.ALL /= 10 THEN
-           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := 30;
-      X := IDENT (NULL);
-      BEGIN
-           IF X.ALL = 0 THEN
-                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
-           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
-      END;
- 
-      X := IDENT (Y);
-      IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= Y OR NOT (X /= NULL) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      A (X'ADDRESS);
- 
-      BEGIN
-           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
-                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
-                        "EQUAL OF COLLECTION SIZE OF PARENT TYPE");
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED FOR " &
-                         "UNDEFINED STORAGE_SIZE (AI-00608)");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C34007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- C34007D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
- --     ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS PART 1 OF 2 TESTS
- --     WHICH COVER THE OBJECTIVE.  THE SECOND PART IS IN TEST C34007V.
- 
- -- HISTORY:
- --     JRK 09/25/86  CREATED ORIGINAL TEST.
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
- --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
- --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
- --     BCB 04/12/90  SPLIT ORIGINAL TEST INTO C34007D.ADA AND
- --                   C34007V.ADA.  PUT CHECK FOR 'STORAGE_SIZE IN
- --                   EXCEPTION HANDLER.
- --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
- --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007D IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) ..
-                                           IDENT_INT (7));
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      X : T         := NEW SUBDESIGNATED'(OTHERS => 2);
-      K : INTEGER   := X'SIZE;
-      Y : T         := NEW SUBDESIGNATED'(1, 2, 3);
-      W : PARENT    := NEW SUBDESIGNATED'(OTHERS => 2);
-      C : COMPONENT := 1;
-      N : CONSTANT  := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN NEW SUBDESIGNATED'(OTHERS => C);
-      END V;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF X = NULL OR ELSE
-              EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW SUBDESIGNATED;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34007D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS " &
-                       "PART 1 OF 2 TESTS WHICH COVER THE OBJECTIVE.  " &
-                       "THE SECOND PART IS IN TEST C34007V");
- 
-      IF Y = NULL OR ELSE Y.ALL /= (1, 2, 3) THEN
-           FAILED ("INCORRECT INITIALIZATION");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X /= Y THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= Y THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= Y THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := NEW SUBDESIGNATED'(1, 2, 3);
-      END IF;
-      X := T (W);
-      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, 2, 3) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      X := IDENT (Y);
-      W := PARENT (X);
-      IF W = NULL OR ELSE W.ALL /= (1, 2, 3) OR ELSE T (W) /= Y THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-      END IF;
- 
-      IF IDENT (NULL) /= NULL OR X = NULL THEN
-           FAILED ("INCORRECT NULL");
-      END IF;
- 
-      X := IDENT (NEW SUBDESIGNATED'(1, 2, 3));
-      IF (X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, 2, 3)) OR
-         X = NEW DESIGNATED'(1, 2) THEN
-           FAILED ("INCORRECT ALLOCATOR");
-      END IF;
- 
-      X := IDENT (NULL);
-      BEGIN
-           IF X.ALL = (0, 0, 0) THEN
-                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
-           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
-      END;
- 
-      X := IDENT (Y);
-      X (IDENT_INT (7)) := 4;
-      IF X /= Y OR Y.ALL /= (1, 2, 4) THEN
-           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := (1, 2, 3);
-      X := IDENT (Y);
-      X (IDENT_INT (5) .. IDENT_INT (6)) := (4, 5);
-      IF X /= Y OR Y.ALL /= (4, 5, 3) THEN
-           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
-      END IF;
- 
-      A (X'ADDRESS);
- 
-      IF X'FIRST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF X'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 5 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF X'LAST /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF X'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 7 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF X'LENGTH /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : DESIGNATED (X'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : DESIGNATED (V'RANGE);
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : DESIGNATED (X'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : DESIGNATED (V'RANGE (N));
-      BEGIN
-           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      IF T'SIZE < 1 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      BEGIN
-           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
-                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
-                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED FOR " &
-                         "UNDEFINED STORAGE_SIZE (AI-00608)");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C34007D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- C34007F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A ONE-DIMENSIONAL
- -- ARRAY TYPE:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 9/25/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007F IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED (5 .. 7);
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( F, L  : NATURAL;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := NEW SUBDESIGNATED'(OTHERS => 2);
-      Y : S := NEW SUBDESIGNATED'(OTHERS => 2);
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : NATURAL;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT    := NEW DESIGNATED (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := B + 1;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34007F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "ONE-DIMENSIONAL ARRAY TYPE");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF CREATE (2, 3, 4, X) . ALL /= (4, 5) OR
-         CREATE (2, 3, 4, Y) . ALL /= (4, 5) THEN
-           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
-      END IF;
- 
-      IF CREATE (2, 3, 4, X) IN T OR
-         CREATE (2, 3, 4, Y) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X'FIRST /= 5 OR X'LAST /= 7 OR
-         Y'FIRST /= 5 OR Y'LAST /= 7 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := NEW SUBDESIGNATED'(1, 2, 3);
-           Y := NEW SUBDESIGNATED'(1, 2, 3);
-           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
-              X.ALL /= Y.ALL THEN
-                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := NEW DESIGNATED'(6 .. 8 => 0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := NEW DESIGNATED'(6 .. 8 => 0)");
-           IF X = NULL OR ELSE X.ALL = (0, 0, 0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := NEW DESIGNATED'(6 .. 8 => 0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := NEW DESIGNATED'(6 .. 8 => 0)");
-      END;
- 
-      BEGIN
-           Y := NEW DESIGNATED'(6 .. 8 => 0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := NEW DESIGNATED'(6 .. 8 => 0)");
-           IF Y = NULL OR ELSE Y.ALL = (0, 0, 0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := NEW DESIGNATED'(6 .. 8 => 0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := NEW DESIGNATED'(6 .. 8 => 0)");
-      END;
- 
-      RESULT;
- END C34007F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,350 ****
- -- C34007G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
- --     MULTI-DIMENSIONAL ARRAY TYPE.
- 
- -- HISTORY:
- --     JRK 09/25/86  CREATED ORIGINAL TEST.
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
- --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
- --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
- --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
- --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007G IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) OF
-                               COMPONENT;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED
-                                    (IDENT_INT (4) .. IDENT_INT (5),
-                                     IDENT_INT (6) .. IDENT_INT (8));
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( F1, L1 : NATURAL;
-                             F2, L2 : NATURAL;
-                             C      : COMPONENT;
-                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
-                            IDENT_INT (6) .. IDENT_INT (8));
- 
-      X : T         := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
-      Y : T         := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
-      W : PARENT    := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
-      C : COMPONENT := 1;
-      N : CONSTANT  := 2;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN NEW SUBDESIGNATED'(OTHERS => (OTHERS => C));
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F1, L1 : NATURAL;
-                F2, L2 : NATURAL;
-                C      : COMPONENT;
-                DUMMY  : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT    := NEW DESIGNATED (F1 .. L1, F2 .. L2);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F1 .. L1 LOOP
-                     FOR J IN F2 .. L2 LOOP
-                          A (I, J) := B;
-                          B := B + 1;
-                     END LOOP;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF X = NULL OR ELSE
-              EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW SUBDESIGNATED;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34007G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "MULTI-DIMENSIONAL ARRAY TYPE");
- 
-      IF Y = NULL OR ELSE Y.ALL /= ((1, 2, 3), (4, 5, 6)) THEN
-           FAILED ("INCORRECT INITIALIZATION");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X /= Y THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= Y THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= Y THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
-      END IF;
-      X := T (W);
-      IF X = NULL OR ELSE X = Y OR ELSE
-         X.ALL /= ((1, 2, 3), (4, 5, 6)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      X := IDENT (Y);
-      W := PARENT (X);
-      IF W = NULL OR ELSE W.ALL /= ((1, 2, 3), (4, 5, 6)) OR ELSE
-         T (W) /= Y THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-      END IF;
- 
-      W := PARENT (CREATE (6, 9, 2, 3, 4, X));
-      IF W = NULL OR ELSE
-         W.ALL /= ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-      END IF;
- 
-      IF IDENT (NULL) /= NULL OR X = NULL THEN
-           FAILED ("INCORRECT NULL");
-      END IF;
- 
-      X := IDENT (NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6)));
-      IF (X = NULL OR ELSE X = Y OR ELSE
-          X.ALL /= ((1, 2, 3), (4, 5, 6))) OR
-         X = NEW DESIGNATED'((1, 2), (3, 4), (5, 6)) THEN
-           FAILED ("INCORRECT ALLOCATOR");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X.ALL /= ((1, 2, 3), (4, 5, 6)) OR
-         CREATE (6, 9, 2, 3, 4, X) . ALL /=
-         ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
-           FAILED ("INCORRECT .ALL (VALUE)");
-      END IF;
- 
-      X.ALL := ((10, 11, 12), (13, 14, 15));
-      IF X /= Y OR Y.ALL /= ((10, 11, 12), (13, 14, 15)) THEN
-           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := ((1, 2, 3), (4, 5, 6));
-      BEGIN
-           CREATE (6, 9, 2, 3, 4, X) . ALL :=
-                ((20, 21), (22, 23), (24, 25), (26, 27));
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
-      END;
- 
-      X := IDENT (NULL);
-      BEGIN
-           IF X.ALL = ((0, 0, 0), (0, 0, 0)) THEN
-                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
-           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
-      END;
- 
-      X := IDENT (Y);
-      IF X (IDENT_INT (4), IDENT_INT (6)) /= 1 OR
-         CREATE (6, 9, 2, 3, 4, X) (9, 3) /= 11 THEN
-           FAILED ("INCORRECT INDEX (VALUE)");
-      END IF;
- 
-      X (IDENT_INT (5), IDENT_INT (8)) := 7;
-      IF X /= Y OR Y.ALL /= ((1, 2, 3), (4, 5, 7)) THEN
-           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := ((1, 2, 3), (4, 5, 6));
-      X := IDENT (Y);
-      BEGIN
-           CREATE (6, 9, 2, 3, 4, X) (6, 2) := 15;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)");
-      END;
- 
-      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
-         X = CREATE (6, 9, 2, 3, 4, X) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= Y OR NOT (X /= NULL) OR
-         NOT (X /= CREATE (7, 9, 2, 4, 1, X)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR CREATE (2, 3, 4, 5, 1, X) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (CREATE (7, 9, 2, 4, 1, X) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      A (X'ADDRESS);
- 
-      IF X'FIRST /= 4 THEN
-           FAILED ("INCORRECT OBJECT'FIRST");
-      END IF;
- 
-      IF V'FIRST /= 4 THEN
-           FAILED ("INCORRECT VALUE'FIRST");
-      END IF;
- 
-      IF X'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT OBJECT'FIRST (N)");
-      END IF;
- 
-      IF V'FIRST (N) /= 6 THEN
-           FAILED ("INCORRECT VALUE'FIRST (N)");
-      END IF;
- 
-      IF X'LAST /= 5 THEN
-           FAILED ("INCORRECT OBJECT'LAST");
-      END IF;
- 
-      IF V'LAST /= 5 THEN
-           FAILED ("INCORRECT VALUE'LAST");
-      END IF;
- 
-      IF X'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT OBJECT'LAST (N)");
-      END IF;
- 
-      IF V'LAST (N) /= 8 THEN
-           FAILED ("INCORRECT VALUE'LAST (N)");
-      END IF;
- 
-      IF X'LENGTH /= 2 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH");
-      END IF;
- 
-      IF V'LENGTH /= 2 THEN
-           FAILED ("INCORRECT VALUE'LENGTH");
-      END IF;
- 
-      IF X'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT OBJECT'LENGTH (N)");
-      END IF;
- 
-      IF V'LENGTH (N) /= 3 THEN
-           FAILED ("INCORRECT VALUE'LENGTH (N)");
-      END IF;
- 
-      DECLARE
-           Y : DESIGNATED (X'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT OBJECT'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : DESIGNATED (V'RANGE, 1 .. 3);
-      BEGIN
-           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
-                FAILED ("INCORRECT VALUE'RANGE");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : DESIGNATED (1 .. 2, X'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT OBJECT'RANGE (N)");
-           END IF;
-      END;
- 
-      DECLARE
-           Y : DESIGNATED (1 .. 2, V'RANGE (N));
-      BEGIN
-           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
-                FAILED ("INCORRECT VALUE'RANGE (N)");
-           END IF;
-      END;
- 
-      IF T'SIZE < 1 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE < T'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      BEGIN
-           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
-                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
-                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED FOR " &
-                         "UNDEFINED STORAGE_SIZE (AI-00608)");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C34007G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007i.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,213 ****
- -- C34007I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A MULTI-DIMENSIONAL
- -- ARRAY TYPE:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 9/25/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007I IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) OF
-                               COMPONENT;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED (4 .. 5, 6 .. 8);
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( F1, L1 : NATURAL;
-                             F2, L2 : NATURAL;
-                             C      : COMPONENT;
-                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
-                            IDENT_INT (6) .. IDENT_INT (8));
- 
-      SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
-      Y : S := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F1, L1 : NATURAL;
-                F2, L2 : NATURAL;
-                C      : COMPONENT;
-                DUMMY  : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT    := NEW DESIGNATED (F1 .. L1, F2 .. L2);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F1 .. L1 LOOP
-                     FOR J IN F2 .. L2 LOOP
-                          A (I, J) := B;
-                          B := B + 1;
-                     END LOOP;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34007I", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "MULTI-DIMENSIONAL ARRAY TYPE");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF CREATE (6, 9, 2, 3, 1, X) . ALL /=
-         ((1, 2), (3, 4), (5, 6), (7, 8)) OR
-         CREATE (6, 9, 2, 3, 1, Y) . ALL /=
-         ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
-           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
-      END IF;
- 
-      IF CREATE (6, 9, 2, 3, 1, X) IN T OR
-         CREATE (6, 9, 2, 3, 1, Y) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X'FIRST /= 4 OR X'LAST /= 5 OR
-         Y'FIRST /= 4 OR Y'LAST /= 5 OR
-         X'FIRST (2) /= 6 OR X'LAST (2) /= 8 OR
-         Y'FIRST (2) /= 6 OR Y'LAST (2) /= 8 THEN
-           FAILED ("INCORRECT 'FIRST OR 'LAST");
-      END IF;
- 
-      BEGIN
-           X := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
-           Y := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
-           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
-              X.ALL /= Y.ALL THEN
-                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
-           IF X = NULL OR ELSE
-              X.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := NEW DESIGNATED'(5 .. 6 => " &
-                         "(6 .. 8 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
-      END;
- 
-      BEGIN
-           X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
-           IF X = NULL OR ELSE
-              X.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := NEW DESIGNATED'(4 .. 5 => " &
-                         "(5 .. 7 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
-      END;
- 
-      BEGIN
-           Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
-           IF Y = NULL OR ELSE
-              Y.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := NEW DESIGNATED'(5 .. 6 => " &
-                         "(6 .. 8 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
-      END;
- 
-      BEGIN
-           Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
-           IF Y = NULL OR ELSE
-              Y.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := NEW DESIGNATED'(4 .. 5 => " &
-                         "(5 .. 7 => 0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
-      END;
- 
-      RESULT;
- END C34007I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,258 ****
- -- C34007J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE
- --     IS A TASK TYPE.
- 
- -- HISTORY:
- --     JRK 09/26/86  CREATED ORIGINAL TEST.
- --     JLH 09/25/87  REFORMATTED HEADER.
- --     BCB 09/26/88  REMOVED COMPARISION INVOLVING OBJECT SIZE.
- --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
- --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
- --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007J IS
- 
-      TASK TYPE DESIGNATED IS
-           ENTRY E (I : IN OUT INTEGER);
-           ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER);
-           ENTRY R (I : OUT INTEGER);
-           ENTRY W (I : INTEGER);
-      END DESIGNATED;
- 
-      TYPE PARENT IS ACCESS DESIGNATED;
- 
-      TYPE T IS NEW PARENT;
- 
-      X : T;
-      K : INTEGER := X'SIZE;
-      Y : T;
-      W : PARENT;
-      I : INTEGER := 0;
-      J : INTEGER := 0;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN NEW DESIGNATED;
-      END V;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF (X = NULL OR ELSE X'CALLABLE) OR IDENT_BOOL (TRUE) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW DESIGNATED;
-      END IDENT;
- 
-      TASK BODY DESIGNATED IS
-           N : INTEGER := 1;
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E (I : IN OUT INTEGER) DO
-                          I := I + N;
-                     END E;
-                OR
-                     ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO
-                          J := I + N;
-                     END F;
-                OR
-                     ACCEPT R (I : OUT INTEGER) DO
-                          I := N;
-                     END R;
-                OR
-                     ACCEPT W (I : INTEGER) DO
-                          N := I;
-                     END W;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END LOOP;
-      END DESIGNATED;
- 
- BEGIN
-      TEST ("C34007J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "TASK TYPE");
- 
-      X := NEW DESIGNATED;
-      Y := NEW DESIGNATED;
-      W := NEW DESIGNATED;
- 
-      IF Y = NULL THEN
-           FAILED ("INCORRECT INITIALIZATION - 1");
-      ELSE Y.W (2);
-           Y.R (I);
-           IF I /= 2 THEN
-                FAILED ("INCORRECT INITIALIZATION - 2");
-           END IF;
-      END IF;
- 
-      X := IDENT (Y);
-      IF X /= Y THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= Y THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= Y THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := NEW DESIGNATED;
-           W.W (3);
-      END IF;
-      X := T (W);
-      IF X = NULL OR X = Y THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT - 1");
-      ELSE I := 5;
-           X.E (I);
-           IF I /= 8 THEN
-                FAILED ("INCORRECT CONVERSION FROM PARENT - 2");
-           END IF;
-      END IF;
- 
-      X := IDENT (Y);
-      W := PARENT (X);
-      IF W = NULL OR T (W) /= Y THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-      ELSE I := 5;
-           W.E (I);
-           IF I /= 7 THEN
-                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-           END IF;
-      END IF;
- 
-      IF IDENT (NULL) /= NULL OR X = NULL THEN
-           FAILED ("INCORRECT NULL");
-      END IF;
- 
-      X := IDENT (NEW DESIGNATED);
-      IF X = NULL OR X = Y THEN
-           FAILED ("INCORRECT ALLOCATOR - 1");
-      ELSE I := 5;
-           X.E (I);
-           IF I /= 6 THEN
-                FAILED ("INCORRECT ALLOCATOR - 2");
-           END IF;
-      END IF;
- 
-      X := IDENT (Y);
-      I := 5;
-      X.E (I);
-      IF I /= 7 THEN
-           FAILED ("INCORRECT SELECTION (ENTRY)");
-      END IF;
- 
-      I := 5;
-      X.F (IDENT_INT (2)) (I, J);
-      IF J /= 7 THEN
-           FAILED ("INCORRECT SELECTION (FAMILY)");
-      END IF;
- 
-      I := 5;
-      X.ALL.E (I);
-      IF I /= 7 THEN
-           FAILED ("INCORRECT .ALL");
-      END IF;
- 
-      X := IDENT (NULL);
-      BEGIN
-           IF X.ALL'CALLABLE THEN
-                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
-           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
-      END;
- 
-      X := IDENT (Y);
-      IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= Y OR NOT (X /= NULL) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      A (X'ADDRESS);
- 
-      IF NOT X'CALLABLE THEN
-           FAILED ("INCORRECT OBJECT'CALLABLE");
-      END IF;
- 
-      IF NOT V'CALLABLE THEN
-           FAILED ("INCORRECT VALUE'CALLABLE");
-      END IF;
- 
-      BEGIN
-           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
-                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
-                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED FOR " &
-                         "UNDEFINED STORAGE_SIZE (AI-00608)");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      IF X'TERMINATED THEN
-           FAILED ("INCORRECT OBJECT'TERMINATED");
-      END IF;
- 
-      IF V'TERMINATED THEN
-           FAILED ("INCORRECT VALUE'TERMINATED");
-      END IF;
- 
-      RESULT;
- END C34007J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007m.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C34007M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
- --     RECORD TYPE WITHOUT DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 09/29/86  CREATED ORIGINAL TEST.
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
- --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
- --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
- --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
- --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
- --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007M IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      TYPE DESIGNATED IS
-           RECORD
-                C : COMPONENT;
-                B : BOOLEAN := TRUE;
-           END RECORD;
- 
-      TYPE PARENT IS ACCESS DESIGNATED;
- 
-      TYPE T IS NEW PARENT;
- 
-      X : T       := NEW DESIGNATED'(2, FALSE);
-      K : INTEGER := X'SIZE;
-      Y : T       := NEW DESIGNATED'(1, TRUE);
-      W : PARENT  := NEW DESIGNATED'(2, FALSE);
-      C : COMPONENT := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF X = NULL OR ELSE EQUAL (X.C, X.C) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW DESIGNATED'(-1, FALSE);
-      END IDENT;
- 
- BEGIN
-      TEST ("C34007M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "RECORD TYPE WITHOUT DISCRIMINANTS");
- 
-      IF Y = NULL OR ELSE Y.ALL /= (1, TRUE) THEN
-           FAILED ("INCORRECT INITIALIZATION");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X /= Y THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= Y THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= Y THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := NEW DESIGNATED'(1, TRUE);
-      END IF;
-      X := T (W);
-      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      X := IDENT (Y);
-      W := PARENT (X);
-      IF W = NULL OR ELSE W.ALL /= (1, TRUE) OR ELSE T (W) /= Y THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF IDENT (NULL) /= NULL OR X = NULL THEN
-           FAILED ("INCORRECT NULL");
-      END IF;
- 
-      X := IDENT (NEW DESIGNATED'(1, TRUE));
-      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
-           FAILED ("INCORRECT ALLOCATOR");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X.C /= 1 OR X.B /= TRUE THEN
-           FAILED ("INCORRECT SELECTION (VALUE)");
-      END IF;
- 
-      X.C := IDENT_INT (3);
-      X.B := IDENT_BOOL (FALSE);
-      IF X /= Y OR Y.ALL /= (3, FALSE) THEN
-           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := (1, TRUE);
-      X := IDENT (Y);
-      IF X.ALL /= (1, TRUE) THEN
-           FAILED ("INCORRECT .ALL (VALUE)");
-      END IF;
- 
-      X.ALL := (10, FALSE);
-      IF X /= Y OR Y.ALL /= (10, FALSE) THEN
-           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := (1, TRUE);
-      X := IDENT (NULL);
-      BEGIN
-           IF X.ALL = (0, FALSE) THEN
-                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
-           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
-      END;
- 
-      X := IDENT (Y);
-      IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= Y OR NOT (X /= NULL) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      A (X'ADDRESS);
- 
-      BEGIN
-           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
-                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
-                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED FOR " &
-                         "UNDEFINED STORAGE_SIZE (AI-00608)");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C34007M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007p.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,283 ****
- -- C34007P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
- --     RECORD TYPE WITH DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 09/29/86  CREATED ORIGINAL TEST.
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
- --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
- --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
- --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
- --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
- --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007P IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
- 
-      TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-           RECORD
-                I : INTEGER;
-                CASE B IS
-                     WHEN TRUE =>
-                          S : STRING (1 .. L);
-                          C : COMPONENT;
-                     WHEN FALSE =>
-                          F : FLOAT := 5.0;
-                END CASE;
-           END RECORD;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_BOOL (TRUE),
-                                           IDENT_INT (3));
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      X : T       := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
-      K : INTEGER := X'SIZE;
-      Y : T       := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
-      W : PARENT  := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
-      C : COMPONENT := 1;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN NEW DESIGNATED'(TRUE, L, I, S, C);
-                     WHEN FALSE =>
-                          RETURN NEW DESIGNATED'(FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF X = NULL OR ELSE EQUAL (X.I, X.I) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW DESIGNATED'(TRUE, 3, -1, "---", -1);
-      END IDENT;
- 
- BEGIN
-      TEST ("C34007P", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "RECORD TYPE WITH DISCRIMINANTS");
- 
-      IF Y = NULL OR ELSE Y.ALL /= (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT INITIALIZATION");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X /= Y THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= Y THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= Y THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
-      END IF;
-      X := T (W);
-      IF X = NULL OR ELSE X = Y OR ELSE
-         X.ALL /= (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      X := IDENT (Y);
-      W := PARENT (X);
-      IF W = NULL OR ELSE W.ALL /= (TRUE, 3, 1, "ABC", 4) OR ELSE
-         T (W) /= Y THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-      END IF;
- 
-      W := PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X));
-      IF W = NULL OR ELSE W.ALL /= (FALSE, 2, 3, 6.0) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-      END IF;
- 
-      IF IDENT (NULL) /= NULL OR X = NULL THEN
-           FAILED ("INCORRECT NULL");
-      END IF;
- 
-      X := IDENT (NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4));
-      IF (X = NULL OR ELSE X = Y OR ELSE
-          X.ALL /= (TRUE, 3, 1, "ABC", 4)) OR
-         X = NEW DESIGNATED'(FALSE, 3, 1, 4.0) THEN
-           FAILED ("INCORRECT ALLOCATOR");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X.B /= TRUE OR X.L /= 3 OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
-           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
-      END IF;
- 
-      IF X.I /= 1 OR X.S /= "ABC" OR X.C /= 4 OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I /= 3 OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F /= 6.0 THEN
-           FAILED ("INCORRECT SELECTION (VALUE)");
-      END IF;
- 
-      X.I := IDENT_INT (7);
-      X.S := IDENT_STR ("XYZ");
-      X.C := IDENT_INT (9);
-      IF X /= Y OR Y.ALL /= (TRUE, 3, 7, "XYZ", 9) THEN
-           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := (TRUE, 3, 1, "ABC", 4);
-      X := IDENT (Y);
-      BEGIN
-           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I := 10;
-           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F := 10.0;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR SELECTION (ASSIGNMENT)");
-      END;
- 
-      IF X.ALL /= (TRUE, 3, 1, "ABC", 4) OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL /=
-         (FALSE, 2, 3, 6.0) THEN
-           FAILED ("INCORRECT .ALL (VALUE)");
-      END IF;
- 
-      X.ALL := (TRUE, 3, 10, "ZZZ", 15);
-      IF X /= Y OR Y.ALL /= (TRUE, 3, 10, "ZZZ", 15) THEN
-           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := (TRUE, 3, 1, "ABC", 4);
-      BEGIN
-           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL :=
-                (FALSE, 2, 10, 15.0);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
-      END;
- 
-      X := IDENT (NULL);
-      BEGIN
-           IF X.ALL = (FALSE, 0, 0, 0.0) THEN
-                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
-           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
-      END;
- 
-      X := IDENT (Y);
-      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
-         X = CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= Y OR NOT (X /= NULL) OR
-         NOT (X /= CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR
-         NOT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      A (X'ADDRESS);
- 
-      IF T'SIZE < 1 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      BEGIN
-           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
-                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
-                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED FOR " &
-                         "UNDEFINED STORAGE_SIZE (AI-00608)");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C34007P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007r.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,218 ****
- -- C34007R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A RECORD TYPE
- -- WITH DISCRIMINANTS:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 9/29/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007R IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
- 
-      TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-           RECORD
-                I : INTEGER;
-                CASE B IS
-                     WHEN TRUE =>
-                          S : STRING (1 .. L);
-                          C : COMPONENT;
-                     WHEN FALSE =>
-                          F : FLOAT := 5.0;
-                END CASE;
-           END RECORD;
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
-      Y : S := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN NEW DESIGNATED'(TRUE, L, I, S, C);
-                     WHEN FALSE =>
-                          RETURN NEW DESIGNATED'(FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34007R", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "RECORD TYPE WITH DISCRIMINANTS");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) . ALL /=
-         (FALSE, 2, 3, 6.0) OR
-         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) . ALL /=
-         (FALSE, 2, 3, 6.0) THEN
-           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
-      END IF;
- 
-      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
-         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         Y.B /= TRUE OR Y.L /= 3 THEN
-           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
-      END IF;
- 
-      BEGIN
-           X := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
-           Y := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
-           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
-              X.ALL /= Y.ALL THEN
-                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := NEW DESIGNATED'(FALSE, 3, 2, 6.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
-           IF X = NULL OR ELSE X.ALL = (FALSE, 3, 2, 6.0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
-      END;
- 
-      BEGIN
-           X := NEW DESIGNATED'(TRUE, 4, 2, "ZZZZ", 6);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
-           IF X = NULL OR ELSE
-              X.ALL = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := NEW DESIGNATED'" &
-                         "(TRUE, 4, 2, ""ZZZZ"", 6)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
-      END;
- 
-      BEGIN
-           Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
-           IF Y = NULL OR ELSE Y.ALL = (FALSE, 3, 2, 6.0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
-      END;
- 
-      BEGIN
-           Y := NEW DESIGNATED'(TRUE, 4, 2, "ZZZZ", 6);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
-           IF Y = NULL OR ELSE
-              Y.ALL = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := NEW DESIGNATED'" &
-                         "(TRUE, 4, 2, ""ZZZZ"", 6)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
-      END;
- 
-      RESULT;
- END C34007R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007s.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007s.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007s.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,299 ****
- -- C34007S.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
- --     PRIVATE TYPE WITH DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 09/30/86  CREATED ORIGINAL TEST.
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
- --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
- --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
- --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
- --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
- --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007S IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG_D IS
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
- 
-           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                           PRIVATE;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT
-                           ) RETURN DESIGNATED;
- 
-      PRIVATE
- 
-           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                RECORD
-                     I : INTEGER := 2;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L) := (1 .. L => 'A');
-                               C : COMPONENT := 2;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-      END PKG_D;
- 
-      USE PKG_D;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_BOOL (TRUE),
-                                           IDENT_INT (3));
- 
-      PACKAGE PKG_P IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      X : T       := NEW DESIGNATED (TRUE, 3);
-      K : INTEGER := X'SIZE;
-      Y : T       := NEW DESIGNATED (TRUE, 3);
-      W : PARENT  := NEW DESIGNATED (TRUE, 3);
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           NULL;
-      END A;
- 
-      PACKAGE BODY PKG_D IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT
-              ) RETURN DESIGNATED
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, C);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-      END PKG_D;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN NEW DESIGNATED'(CREATE (B, L, I, S, C, F));
-           END CREATE;
- 
-      END PKG_P;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF X = NULL OR ELSE EQUAL (X.L, X.L) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW DESIGNATED'(CREATE (TRUE, 3, -1, "---", -1, -1.0));
-      END IDENT;
- 
- BEGIN
-      TEST ("C34007S", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "PRIVATE TYPE WITH DISCRIMINANTS");
- 
-      Y.ALL := CREATE (TRUE, 3, 1, "ABC", 4, 1.0);
-      IF Y = NULL OR ELSE
-         Y.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) THEN
-           FAILED ("INCORRECT INITIALIZATION");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X /= Y THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= Y THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= Y THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
-      END IF;
-      X := T (W);
-      IF X = NULL OR ELSE X = Y OR ELSE
-         X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      X := IDENT (Y);
-      W := PARENT (X);
-      IF W = NULL OR ELSE
-         W.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) OR ELSE
-         T (W) /= Y THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
-      END IF;
- 
-      W := PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X));
-      IF W = NULL OR ELSE
-         W.ALL /= CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-      END IF;
- 
-      IF IDENT (NULL) /= NULL OR X = NULL THEN
-           FAILED ("INCORRECT NULL");
-      END IF;
- 
-      X := IDENT (NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0)));
-      IF (X = NULL OR ELSE X = Y OR ELSE
-          X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0)) OR
-         X = NEW DESIGNATED'(CREATE (FALSE, 3, 1, "XXX", 5, 4.0)) THEN
-           FAILED ("INCORRECT ALLOCATOR");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X.B /= TRUE OR X.L /= 3 OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
-           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
-      END IF;
- 
-      IF X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL /=
-         CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
-           FAILED ("INCORRECT .ALL (VALUE)");
-      END IF;
- 
-      X.ALL := CREATE (TRUE, 3, 10, "ZZZ", 15, 1.0);
-      IF X /= Y OR Y.ALL /= CREATE (TRUE, 3, 10, "ZZZ", 15, 2.0) THEN
-           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := CREATE (TRUE, 3, 1, "ABC", 4, 1.0);
-      BEGIN
-           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL :=
-                CREATE (FALSE, 2, 10, "ZZ", 7, 15.0);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
-      END;
- 
-      X := IDENT (NULL);
-      BEGIN
-           IF X.ALL = CREATE (FALSE, 0, 0, "", 0, 0.0) THEN
-                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
-           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
-      END;
- 
-      X := IDENT (Y);
-      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
-         X = CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= Y OR NOT (X /= NULL) OR
-         NOT (X /= CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR
-         NOT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      A (X'ADDRESS);
- 
-      IF T'SIZE < 1 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      BEGIN
-           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
-                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
-                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED FOR " &
-                         "UNDEFINED STORAGE_SIZE (AI-00608)");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C34007S;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007u.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007u.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007u.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- C34007U.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A PRIVATE TYPE
- -- WITH DISCRIMINANTS:
- 
- --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
- --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
- --   CONSTRAINED.
- 
- --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
- --   IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- JRK 9/30/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007U IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      PACKAGE PKG_D IS
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
- 
-           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                           PRIVATE;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT
-                           ) RETURN DESIGNATED;
- 
-      PRIVATE
- 
-           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                RECORD
-                     I : INTEGER := 2;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L) := (1 .. L => 'A');
-                               C : COMPONENT := 2;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-      END PKG_D;
- 
-      USE PKG_D;
- 
-      PACKAGE PKG_P IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             C : COMPONENT;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG_P;
- 
-      USE PKG_P;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T := NEW DESIGNATED (TRUE, 3);
-      Y : S := NEW DESIGNATED (TRUE, 3);
- 
-      PACKAGE BODY PKG_D IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT
-              ) RETURN DESIGNATED
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, C);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-      END PKG_D;
- 
-      PACKAGE BODY PKG_P IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                C : COMPONENT;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN NEW DESIGNATED'(CREATE (B, L, I, S, C, F));
-           END CREATE;
- 
-      END PKG_P;
- 
- BEGIN
-      TEST ("C34007U", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "PRIVATE TYPE WITH DISCRIMINANTS");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF CREATE (FALSE, 2, 3, "WW", 5, 6.0, X) . ALL /=
-         CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) OR
-         CREATE (FALSE, 2, 3, "WW", 5, 6.0, Y) . ALL /=
-         CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
-           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
-      END IF;
- 
-      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
-         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         Y.B /= TRUE OR Y.L /= 3 THEN
-           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
-      END IF;
- 
-      BEGIN
-           X := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
-           Y := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
-           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
-              X.ALL /= Y.ALL THEN
-                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := NEW DESIGNATED'(CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := NEW DESIGNATED'" &
-                   "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
-           IF X = NULL OR ELSE
-              X.ALL = CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := NEW DESIGNATED'" &
-                         "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := NEW DESIGNATED'" &
-                        "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
-      END;
- 
-      BEGIN
-           X := NEW DESIGNATED'(CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := NEW DESIGNATED'" &
-                   "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
-           IF X = NULL OR ELSE
-              X.ALL = CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := NEW DESIGNATED'" &
-                         "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := NEW DESIGNATED'" &
-                        "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
-      END;
- 
-      BEGIN
-           Y := NEW DESIGNATED'(CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := NEW DESIGNATED'" &
-                   "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
-           IF Y = NULL OR ELSE
-              Y.ALL = CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := NEW DESIGNATED'" &
-                         "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := NEW DESIGNATED'" &
-                        "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
-      END;
- 
-      BEGIN
-           Y := NEW DESIGNATED'(CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := NEW DESIGNATED'" &
-                   "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
-           IF Y = NULL OR ELSE
-              Y.ALL = CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := NEW DESIGNATED'" &
-                         "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := NEW DESIGNATED'" &
-                        "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
-      END;
- 
-      RESULT;
- END C34007U;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007v.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34007v.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34007v.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- C34007V.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
- --     ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS PART 2 OF 2 TESTS
- --     WHICH COVER THE OBJECTIVE.  THE FIRST PART IS IN TEST C34007D.
- 
- -- HISTORY:
- --     BCB 04/12/90  CREATED ORIGINAL TEST FROM SPLIT OF C34007D.ADA.
- --     THS 09/18/90  REMOVED DECLARATION OF B, DELETED PROCEDURE A,
- --                   AND REMOVED ALL REFERENCES TO B.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34007V IS
- 
-      SUBTYPE COMPONENT IS INTEGER;
- 
-      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
- 
-      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) ..
-                                           IDENT_INT (7));
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS ACCESS DESIGNATED;
- 
-           FUNCTION CREATE ( F, L  : NATURAL;
-                             C     : COMPONENT;
-                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
- 
-      X : T         := NEW SUBDESIGNATED'(OTHERS => 2);
-      K : INTEGER   := X'SIZE;
-      Y : T         := NEW SUBDESIGNATED'(1, 2, 3);
-      W : PARENT    := NEW SUBDESIGNATED'(OTHERS => 2);
-      C : COMPONENT := 1;
-      N : CONSTANT  := 1;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN NEW SUBDESIGNATED'(OTHERS => C);
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( F, L  : NATURAL;
-                C     : COMPONENT;
-                DUMMY : PARENT
-              ) RETURN PARENT
-           IS
-                A : PARENT    := NEW DESIGNATED (F .. L);
-                B : COMPONENT := C;
-           BEGIN
-                FOR I IN F .. L LOOP
-                     A (I) := B;
-                     B := B + 1;
-                END LOOP;
-                RETURN A;
-           END CREATE;
- 
-      END PKG;
- 
-      FUNCTION IDENT (X : T) RETURN T IS
-      BEGIN
-           IF X = NULL OR ELSE
-              EQUAL (X'LENGTH, X'LENGTH) THEN
-                RETURN X;                          -- ALWAYS EXECUTED.
-           END IF;
-           RETURN NEW SUBDESIGNATED;
-      END IDENT;
- 
- BEGIN
-      TEST ("C34007V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
-                       "ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS " &
-                       "PART 2 OF 2 TESTS WHICH COVER THE OBJECTIVE.  " &
-                       "THE FIRST PART IS IN TEST C34007V");
- 
-      W := PARENT (CREATE (2, 3, 4, X));
-      IF W = NULL OR ELSE W.ALL /= (4, 5) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
-      END IF;
- 
-      X := IDENT (Y);
-      IF X.ALL /= (1, 2, 3) OR CREATE (2, 3, 4, X) . ALL /= (4, 5) THEN
-           FAILED ("INCORRECT .ALL (VALUE)");
-      END IF;
- 
-      X.ALL := (10, 11, 12);
-      IF X /= Y OR Y.ALL /= (10, 11, 12) THEN
-           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
-      END IF;
- 
-      Y.ALL := (1, 2, 3);
-      BEGIN
-           CREATE (2, 3, 4, X) . ALL := (10, 11);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
-      END;
- 
- 
-      X := IDENT (Y);
-      IF X (IDENT_INT (5)) /= 1 OR
-         CREATE (2, 3, 4, X) (3) /= 5 THEN
-           FAILED ("INCORRECT INDEX (VALUE)");
-      END IF;
- 
-      Y.ALL := (1, 2, 3);
-      X := IDENT (Y);
-      BEGIN
-           CREATE (2, 3, 4, X) (2) := 10;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)");
-      END;
- 
-      IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR
-         CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN
-           FAILED ("INCORRECT SLICE (VALUE)");
-      END IF;
- 
-      Y.ALL := (1, 2, 3);
-      X := IDENT (Y);
-      BEGIN
-           CREATE (1, 4, 4, X) (2 .. 4) := (10, 11, 12);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION FOR SLICE (ASSIGNMENT)");
-      END;
- 
-      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
-         X = CREATE (2, 3, 4, X) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= Y OR NOT (X /= NULL) OR NOT (X /= CREATE (2, 3, 4, X)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR CREATE (2, 3, 4, X) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (CREATE (2, 3, 4, X) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      RESULT;
- END C34007V;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34008a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,226 ****
- -- C34008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED TASK TYPES.
- 
- -- HISTORY:
- --     JRK 08/27/87  CREATED ORIGINAL TEST.
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- --     DTN 11/30/95  REMOVED ATTIBUTES OF NON-OBJECTS.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34008A IS
- 
-      PACKAGE PKG IS
- 
-           TASK TYPE PARENT IS
-                ENTRY E (I : IN OUT INTEGER);
-                ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER);
-                ENTRY G;
-                ENTRY H (1 .. 3);
-                ENTRY R (I : OUT INTEGER);
-                ENTRY W (I : INTEGER);
-           END PARENT;
- 
-           FUNCTION ID (X : PARENT) RETURN INTEGER;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT;
- 
-      TASK TYPE AUX;
- 
-      X : T;
-      W : PARENT;
-      B : BOOLEAN := FALSE;
-      I : INTEGER := 0;
-      J : INTEGER := 0;
-      A1, A2 : AUX;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      FUNCTION V RETURN T IS
-      BEGIN
-           RETURN X;
-      END V;
- 
-      PACKAGE BODY PKG IS
- 
-           TASK BODY PARENT IS
-                N : INTEGER := 1;
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT E (I : IN OUT INTEGER) DO
-                               I := I + N;
-                          END E;
-                     OR
-                          ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO
-                               J := I + N;
-                          END F;
-                     OR
-                          ACCEPT G DO
-                               WHILE H(2)'COUNT < 2 LOOP
-                                    DELAY 5.0;
-                               END LOOP;
-                               ACCEPT H (2) DO
-                                    IF E'COUNT    /= 0 OR
-                                       F(1)'COUNT /= 0 OR
-                                       F(2)'COUNT /= 0 OR
-                                       F(3)'COUNT /= 0 OR
-                                       G'COUNT    /= 0 OR
-                                       H(1)'COUNT /= 0 OR
-                                       H(2)'COUNT /= 1 OR
-                                       H(3)'COUNT /= 0 OR
-                                       R'COUNT    /= 0 OR
-                                       W'COUNT    /= 0 THEN
-                                         FAILED ("INCORRECT 'COUNT");
-                                    END IF;
-                               END H;
-                               ACCEPT H (2);
-                          END G;
-                     OR
-                          ACCEPT R (I : OUT INTEGER) DO
-                               I := N;
-                          END R;
-                     OR
-                          ACCEPT W (I : INTEGER) DO
-                               N := I;
-                          END W;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END PARENT;
- 
-           FUNCTION ID (X : PARENT) RETURN INTEGER IS
-                I : INTEGER;
-           BEGIN
-                X.R (I);
-                RETURN I;
-           END ID;
- 
-      END PKG;
- 
-      TASK BODY AUX IS
-      BEGIN
-           X.H (2);
-      END AUX;
- 
- BEGIN
-      TEST ("C34008A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED TASK " &
-                       "TYPES");
- 
-      X.W (IDENT_INT (2));
-      IF ID (X) /= 2 THEN
-           FAILED ("INCORRECT INITIALIZATION");
-      END IF;
- 
-      IF ID (T'(X)) /= 2 THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF ID (T (X)) /= 2 THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      W.W (IDENT_INT (3));
-      IF ID (T (W)) /= 3 THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF ID (PARENT (X)) /= 2 THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      I := 5;
-      X.E (I);
-      IF I /= 7 THEN
-           FAILED ("INCORRECT SELECTION (ENTRY)");
-      END IF;
- 
-      I := 5;
-      X.F (IDENT_INT (2)) (I, J);
-      IF J /= 7 THEN
-           FAILED ("INCORRECT SELECTION (FAMILY)");
-      END IF;
- 
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT OBJECT'ADDRESS");
-      END IF;
- 
-      IF NOT X'CALLABLE THEN
-           FAILED ("INCORRECT OBJECT'CALLABLE");
-      END IF;
- 
-      IF NOT V'CALLABLE THEN
-           FAILED ("INCORRECT VALUE'CALLABLE");
-      END IF;
- 
-      X.G;
- 
-      IF X'SIZE < T'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      IF T'STORAGE_SIZE < 0 THEN
-           FAILED ("INCORRECT TYPE'STORAGE_SIZE");
-      END IF;
- 
-      IF X'STORAGE_SIZE < 0 THEN
-           FAILED ("INCORRECT OBJECT'STORAGE_SIZE");
-      END IF;
- 
-      IF X'TERMINATED THEN
-           FAILED ("INCORRECT OBJECT'TERMINATED");
-      END IF;
- 
-      IF V'TERMINATED THEN
-           FAILED ("INCORRECT VALUE'TERMINATED");
-      END IF;
- 
-      RESULT;
- END C34008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- C34009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITHOUT
- --     DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 08/28/87  CREATED ORIGINAL TEST.
- --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34009A IS
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN PARENT;
- 
-           FUNCTION CON (X : INTEGER) RETURN PARENT;
- 
-      PRIVATE
- 
-           TYPE PARENT IS NEW INTEGER;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT;
- 
-      X : T;
-      K : INTEGER := X'SIZE;
-      W : PARENT;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN PARENT IS
-           BEGIN
-                RETURN PARENT (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION CON (X : INTEGER) RETURN PARENT IS
-           BEGIN
-                RETURN PARENT (X);
-           END CON;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34009A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "NON-LIMITED PRIVATE TYPES WITHOUT " &
-                       "DISCRIMINANTS");
- 
-      X := CREATE (30);
-      IF X /= CON (30) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= CON (30) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= CON (30) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      W := CREATE (-30);
-      IF T (W) /= CON (-30) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF PARENT (X) /= CON (30) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF X = CON (0) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= CON (30) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      RESULT;
- END C34009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,226 ****
- -- C34009D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITH
- --     DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 08/31/87  CREATED ORIGINAL TEST.
- --     WMC 03/13/92  REVISED TYPE'SIZE CHECKS.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34009D IS
- 
-      PACKAGE PKG IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS PRIVATE;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             J : INTEGER;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          S : STRING;
-                          J : INTEGER
-                        ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          F : FLOAT
-                        ) RETURN PARENT;
- 
-      PRIVATE
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L);
-                               J : INTEGER;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      X : T;
-      W : PARENT;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, J);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (TRUE, L, I, S, J);
-           END CON;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                F : FLOAT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (FALSE, L, I, F);
-           END CON;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34009D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
- 
-      X := CON (TRUE, 3, 2, "AAA", 2);
-      W := CON (TRUE, 3, 2, "AAA", 2);
- 
-      IF EQUAL (3, 3) THEN
-           X := CON (TRUE, 3, 1, "ABC", 4);
-      END IF;
-      IF X /= CON (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT :=");
-      END IF;
- 
-      IF T'(X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF T (X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           W := CON (TRUE, 3, 1, "ABC", 4);
-      END IF;
-      IF T (W) /= CON (TRUE, 3, 1, "ABC", 4) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF PARENT (X) /= CON (TRUE, 3, 1, "ABC", 4) OR
-         PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
-         CON (FALSE, 2, 3, 6.0) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
-           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
-      END IF;
- 
-      IF X = CON (TRUE, 3, 1, "ABC", 5) OR
-         X = CON (FALSE, 2, 3, 6.0) THEN
-           FAILED ("INCORRECT =");
-      END IF;
- 
-      IF X /= CON (TRUE, 3, 1, "ABC", 4) OR
-         NOT (X /= CON (FALSE, 2, 3, 6.0)) THEN
-           FAILED ("INCORRECT /=");
-      END IF;
- 
-      IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF NOT X'CONSTRAINED THEN
-           FAILED ("INCORRECT OBJECT'CONSTRAINED");
-      END IF;
- 
-      IF T'SIZE <= 0 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE   < T'SIZE OR
-         X.B'SIZE < BOOLEAN'SIZE OR
-         X.L'SIZE < LENGTH'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34009D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,256 ****
- -- C34009F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS:
- 
- --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
- --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
- --        IS CONSTRAINED.
- 
- --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
- --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 08/31/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34009F IS
- 
-      PACKAGE PKG IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS PRIVATE;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             J : INTEGER;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          S : STRING;
-                          J : INTEGER
-                        ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          F : FLOAT
-                        ) RETURN PARENT;
- 
-      PRIVATE
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L);
-                               J : INTEGER;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, J);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (TRUE, L, I, S, J);
-           END CON;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                F : FLOAT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (FALSE, L, I, F);
-           END CON;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34009F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
- 
-      X := CON (TRUE, 3, 2, "AAA", 2);
-      Y := CON (TRUE, 3, 2, "AAA", 2);
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) /=
-         CON (FALSE, 2, 3, 6.0) OR
-         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) /=
-         CON (FALSE, 2, 3, 6.0) THEN
-           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
-      END IF;
- 
-      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
-         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         Y.B /= TRUE OR Y.L /= 3 THEN
-           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
-      END IF;
- 
-      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
-           FAILED ("INCORRECT 'CONSTRAINED");
-      END IF;
- 
-      BEGIN
-           X := CON (TRUE, 3, 1, "ABC", 4);
-           Y := CON (TRUE, 3, 1, "ABC", 4);
-           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
-      END;
- 
-      BEGIN
-           X := CON (FALSE, 3, 2, 6.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := CON (FALSE, 3, 2, 6.0)");
-           IF X = CON (FALSE, 3, 2, 6.0) THEN  -- USE X.
-                COMMENT ("X ALTERED -- X := CON (FALSE, 3, 2, 6.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := CON (FALSE, 3, 2, 6.0)");
-      END;
- 
-      BEGIN
-           X := CON (TRUE, 4, 2, "ZZZZ", 6);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
-           IF X = CON (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
-      END;
- 
-      BEGIN
-           Y := CON (FALSE, 3, 2, 6.0);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := CON (FALSE, 3, 2, 6.0)");
-           IF Y = CON (FALSE, 3, 2, 6.0) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- Y := CON (FALSE, 3, 2, 6.0)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := CON (FALSE, 3, 2, 6.0)");
-      END;
- 
-      BEGIN
-           Y := CON (TRUE, 4, 2, "ZZZZ", 6);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
-           IF Y = CON (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
-      END;
- 
-      RESULT;
- END C34009F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- C34009G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED LIMITED PRIVATE TYPES WITHOUT
- --     DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 09/01/87  CREATED ORIGINAL TEST.
- --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34009G IS
- 
-      PACKAGE PKG IS
- 
-           TYPE PARENT IS LIMITED PRIVATE;
- 
-           FUNCTION CREATE (X : INTEGER) RETURN PARENT;
- 
-           FUNCTION CON (X : INTEGER) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
- 
-      PRIVATE
- 
-           TYPE PARENT IS NEW INTEGER;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT;
- 
-      X : T;
-      W : PARENT;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE (X : INTEGER) RETURN PARENT IS
-           BEGIN
-                RETURN PARENT (IDENT_INT (X));
-           END CREATE;
- 
-           FUNCTION CON (X : INTEGER) RETURN PARENT IS
-           BEGIN
-                RETURN PARENT (X);
-           END CON;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34009G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
- 
-      ASSIGN (X, CREATE (30));
-      IF NOT EQUAL (T'(X), CON (30)) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF NOT EQUAL (T (X), CON (30)) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      ASSIGN (W, CREATE (-30));
-      IF NOT EQUAL (T (W), CON (-30)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF NOT EQUAL (PARENT (X), CON (30)) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF NOT (X IN T) THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
-      IF X'SIZE < T'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34009G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,225 ****
- -- C34009J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
- --     (IMPLICITLY) FOR DERIVED LIMITED PRIVATE TYPES WITH
- --     DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 09/01/87  CREATED ORIGINAL TEST.
- --     WMC 03/13/92  REVISED TYPE'SIZE CHECKS.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34009J IS
- 
-      PACKAGE PKG IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
-                       LIMITED PRIVATE;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             J : INTEGER;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          S : STRING;
-                          J : INTEGER
-                        ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          F : FLOAT
-                        ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
- 
-      PRIVATE
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
-                RECORD
-                     I : INTEGER := 2;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L) := (1 .. L => 'A');
-                               J : INTEGER := 2;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      X : T;
-      W : PARENT;
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE A (X : ADDRESS) IS
-      BEGIN
-           B := IDENT_BOOL (TRUE);
-      END A;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, J);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (TRUE, L, I, S, J);
-           END CON;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                F : FLOAT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (FALSE, L, I, F);
-           END CON;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34009J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
-                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
-                       "LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
- 
-      IF EQUAL (3, 3) THEN
-           ASSIGN (X, CON (TRUE, 3, 1, "ABC", 4));
-      END IF;
-      IF NOT EQUAL (T'(X), CON (TRUE, 3, 1, "ABC", 4)) THEN
-           FAILED ("INCORRECT QUALIFICATION");
-      END IF;
- 
-      IF NOT EQUAL (T (X), CON (TRUE, 3, 1, "ABC", 4)) THEN
-           FAILED ("INCORRECT SELF CONVERSION");
-      END IF;
- 
-      IF EQUAL (3, 3) THEN
-           ASSIGN (W, CON (TRUE, 3, 1, "ABC", 4));
-      END IF;
-      IF NOT EQUAL (T (W), CON (TRUE, 3, 1, "ABC", 4)) THEN
-           FAILED ("INCORRECT CONVERSION FROM PARENT");
-      END IF;
- 
-      IF NOT EQUAL (PARENT (X), CON (TRUE, 3, 1, "ABC", 4)) OR
-         NOT EQUAL (PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)),
-                    CON (FALSE, 2, 3, 6.0)) THEN
-           FAILED ("INCORRECT CONVERSION TO PARENT");
-      END IF;
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
-         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
-           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
-      END IF;
- 
-      IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) NOT IN T) THEN
-           FAILED ("INCORRECT ""NOT IN""");
-      END IF;
- 
-      B := FALSE;
-      A (X'ADDRESS);
-      IF NOT B THEN
-           FAILED ("INCORRECT 'ADDRESS");
-      END IF;
- 
- 
-      IF NOT X'CONSTRAINED THEN
-           FAILED ("INCORRECT OBJECT'CONSTRAINED");
-      END IF;
- 
-      IF T'SIZE <= 0 THEN
-           FAILED ("INCORRECT TYPE'SIZE");
-      END IF;
- 
-      IF X'SIZE   < T'SIZE OR
-         X.B'SIZE < BOOLEAN'SIZE OR
-         X.L'SIZE < LENGTH'SIZE THEN
-           FAILED ("INCORRECT OBJECT'SIZE");
-      END IF;
- 
-      RESULT;
- END C34009J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34009l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34009l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,270 ****
- -- C34009L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DERIVED LIMITED PRIVATE TYPES WITH DISCRIMINANTS:
- 
- --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
- --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
- --        IS CONSTRAINED.
- 
- --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
- --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     JRK 09/01/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34009L IS
- 
-      PACKAGE PKG IS
- 
-           MAX_LEN : CONSTANT := 10;
- 
-           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
-                       LIMITED PRIVATE;
- 
-           FUNCTION CREATE ( B : BOOLEAN;
-                             L : LENGTH;
-                             I : INTEGER;
-                             S : STRING;
-                             J : INTEGER;
-                             F : FLOAT;
-                             X : PARENT  -- TO RESOLVE OVERLOADING.
-                           ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          S : STRING;
-                          J : INTEGER
-                        ) RETURN PARENT;
- 
-           FUNCTION CON ( B : BOOLEAN;
-                          L : LENGTH;
-                          I : INTEGER;
-                          F : FLOAT
-                        ) RETURN PARENT;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
- 
-           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
- 
-      PRIVATE
- 
-           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
-                RECORD
-                     I : INTEGER := 2;
-                     CASE B IS
-                          WHEN TRUE =>
-                               S : STRING (1 .. L) := (1 .. L => 'A');
-                               J : INTEGER := 2;
-                          WHEN FALSE =>
-                               F : FLOAT := 5.0;
-                     END CASE;
-                END RECORD;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
- 
-      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
- 
-      TYPE S IS NEW SUBPARENT;
- 
-      X : T;
-      Y : S;
- 
-      PACKAGE BODY PKG IS
- 
-           FUNCTION CREATE
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER;
-                F : FLOAT;
-                X : PARENT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                CASE B IS
-                     WHEN TRUE =>
-                          RETURN (TRUE, L, I, S, J);
-                     WHEN FALSE =>
-                          RETURN (FALSE, L, I, F);
-                END CASE;
-           END CREATE;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                S : STRING;
-                J : INTEGER
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (TRUE, L, I, S, J);
-           END CON;
- 
-           FUNCTION CON
-              ( B : BOOLEAN;
-                L : LENGTH;
-                I : INTEGER;
-                F : FLOAT
-              ) RETURN PARENT
-           IS
-           BEGIN
-                RETURN (FALSE, L, I, F);
-           END CON;
- 
-           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END EQUAL;
- 
-           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
-           BEGIN
-                X := Y;
-           END ASSIGN;
- 
-      END PKG;
- 
- BEGIN
-      TEST ("C34009L", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
-                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
-                       "WHEN THE DERIVED TYPE DEFINITION IS " &
-                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
-                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
-                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
-                       "LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
- 
-      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
- 
-      IF NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X),
-                    CON (FALSE, 2, 3, 6.0)) OR
-         NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y),
-                    CON (FALSE, 2, 3, 6.0)) THEN
-           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
-      END IF;
- 
-      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
-         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
-           FAILED ("INCORRECT ""IN""");
-      END IF;
- 
-      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
- 
-      IF X.B /= TRUE OR X.L /= 3 OR
-         Y.B /= TRUE OR Y.L /= 3 THEN
-           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
-      END IF;
- 
-      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
-           FAILED ("INCORRECT 'CONSTRAINED");
-      END IF;
- 
-      BEGIN
-           ASSIGN (X, CON (TRUE, 3, 1, "ABC", 4));
-           ASSIGN (Y, CON (TRUE, 3, 1, "ABC", 4));
-           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
-                FAILED ("INCORRECT CONVERSION TO PARENT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
-      END;
- 
-      BEGIN
-           ASSIGN (X, CON (FALSE, 3, 2, 6.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
-           IF EQUAL (X, CON (FALSE, 3, 2, 6.0)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
-      END;
- 
-      BEGIN
-           ASSIGN (X, CON (TRUE, 4, 2, "ZZZZ", 6));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
-           IF EQUAL (X, CON (TRUE, 4, 2, "ZZZZ", 6)) THEN  -- USE X.
-                COMMENT ("X ALTERED -- " &
-                         "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, CON (FALSE, 3, 2, 6.0));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
-           IF EQUAL (Y, CON (FALSE, 3, 2, 6.0)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
-      END;
- 
-      BEGIN
-           ASSIGN (Y, CON (TRUE, 4, 2, "ZZZZ", 6));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
-                   "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
-           IF EQUAL (Y, CON (TRUE, 4, 2, "ZZZZ", 6)) THEN  -- USE Y.
-                COMMENT ("Y ALTERED -- " &
-                         "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED -- " &
-                        "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
-      END;
- 
-      RESULT;
- END C34009L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34011b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34011b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34011b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,343 ****
- -- C34011B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED TYPE DECLARATION IS NOT CONSIDERED EXACTLY
- --     EQUIVALENT TO AN ANONYMOUS DECLARATION OF THE DERIVED TYPE
- --     FOLLOWED BY A SUBTYPE DECLARATION OF THE DERIVED SUBTYPE.  IN
- --     PARTICULAR, CHECK THAT CONSTRAINT_ERROR CAN BE RAISED WHEN THE
- --     SUBTYPE INDICATION OF THE DERIVED TYPE DECLARATION IS ELABORATED
- --     (EVEN THOUGH THE CONSTRAINT WOULD SATISFY THE DERIVED (BASE)
- --     TYPE).
- 
- -- HISTORY:
- --     JRK 09/04/87  CREATED ORIGINAL TEST.
- --     EDS 07/29/98  AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34011B IS
- 
-      SUBTYPE BOOL IS BOOLEAN RANGE FALSE .. FALSE;
- 
-      SUBTYPE FLT IS FLOAT RANGE -10.0 .. 10.0;
- 
-      SUBTYPE DUR IS DURATION RANGE 0.0 .. 10.0;
- 
-      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
- 
-      TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
- 
-      TYPE REC (D : INT := 0) IS
-           RECORD
-                I : INTEGER;
-           END RECORD;
- 
-      PACKAGE PT IS
-           TYPE PRIV (D : POSITIVE := 1) IS PRIVATE;
-      PRIVATE
-           TYPE PRIV (D : POSITIVE := 1) IS
-                RECORD
-                     I : INTEGER;
-                END RECORD;
-      END PT;
- 
-      USE PT;
- 
-      TYPE ACC_ARR IS ACCESS ARR;
- 
-      TYPE ACC_REC IS ACCESS REC;
- 
- BEGIN
-      TEST ("C34011B", "CHECK THAT CONSTRAINT_ERROR CAN BE RAISED " &
-                       "WHEN THE SUBTYPE INDICATION OF A DERIVED TYPE " &
-                       "DECLARATION IS ELABORATED");
- 
-      BEGIN
-           DECLARE
-             TYPE T IS NEW BOOL RANGE FALSE .. BOOL(IDENT_BOOL(TRUE));
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T := T(IDENT_BOOL(TRUE));
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
-                              " AT PROPER PLACE - BOOL " & 
-                              T'IMAGE(T1) );   --USE T1);
-             END;
- 
-             FAILED ("EXCEPTION NOT RAISED - BOOL");
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - BOOL");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - BOOL");
-      END;
- 
-      BEGIN
-           DECLARE
-             TYPE T IS NEW POSITIVE RANGE IDENT_INT (0) .. 10;
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T := T(IDENT_INT(1));
-             BEGIN
-                  FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR - POSITIVE " &
-                              T'IMAGE(T1)); --USE T1
-             END;
-             FAILED ("EXCEPTION NOT RAISED - POSITIVE" );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - POSITIVE");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - POSITIVE");
-      END;
- 
-      BEGIN
-           DECLARE
-             TYPE T IS NEW FLT RANGE 0.0 .. FLT(IDENT_INT(20));
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T := T(IDENT_INT(0));
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
-                        " AT PROPER PLACE " &
-                        T'IMAGE(T1) ); --USE T1
- 
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
-                              " AT PROPER PLACE "); 
-             END;
-             FAILED ("EXCEPTION NOT RAISED - FLT" );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - FLT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - FLT");
-      END;
- 
-      BEGIN
-           DECLARE
-             TYPE T IS NEW DUR RANGE DUR(IDENT_INT(-1)) .. 5.0;
- 
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T := T(IDENT_INT(2));
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
-                        " AT PROPER PLACE " &
-                        T'IMAGE(T1) );  -- USE T1
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             END;
-             FAILED ("EXCEPTION NOT RAISED - DUR " );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - DUR");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - DUR");
-      END;
- 
-      BEGIN
-           DECLARE
-             TYPE T IS NEW ARR (IDENT_INT (-1) .. 10);
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T := (OTHERS => IDENT_INT(3));
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
-                        "AT PROPER PLACE " &
-                        INTEGER'IMAGE(T1(1)) ); --USE T1
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             END;
-             FAILED ("EXCEPTION NOT RAISED - ARR " );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - ARR");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - ARR");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE T IS NEW REC (IDENT_INT (11));
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T;
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
-                              "AT PROPER PLACE " &
-                              INTEGER'IMAGE(T1.D) ); --USE T1
-             END;
-             FAILED ("EXCEPTION NOT RAISED - REC " );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - REC");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - REC");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE T IS NEW PRIV (IDENT_INT (0));  --RAISES C_E
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T;
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 
-                              "AT PROPER PLACE " &
-                              INTEGER'IMAGE(T1.D) ); --USE T1
-             END;
-             FAILED ("EXCEPTION NOT RAISED - PRIV " ); 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - PRIV");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - PRIV");
-      END;
- 
-      BEGIN
-           DECLARE
-             TYPE T IS NEW ACC_ARR (0 .. IDENT_INT (11));  --RAISES C_E
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T;
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
-                              "AT PROPER PLACE " &
-                              INTEGER'IMAGE(T1(1)) ); --USE T1
-             END;
-             FAILED ("EXCEPTION NOT RAISED - ACC_ARR " );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - ACC_ARR");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - ACC_ARR");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE T IS NEW ACC_REC (IDENT_INT (-1));  --RAISES C_E
- 
-           BEGIN
-             DECLARE
-                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
-                T1 : T;
-             BEGIN
-                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-             EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 
-                              "AT PROPER PLACE " &
-                              INTEGER'IMAGE(T1.D) ); --USE T1
-             END;
-                 FAILED ("EXCEPTION NOT RAISED - ACC_REC " );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER ENTERED - ACC_REC");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - ACC_REC");
-      END;
- 
-      RESULT;
- END C34011B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34012a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34012a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34012a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C34012A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DEFAULT EXPRESSIONS IN DERIVED RECORD TYPES AND
- --     DERIVED SUBPROGRAMS ARE EVALUATED USING THE ENTITIES DENOTED BY
- --     THE EXPRESSIONS IN THE PARENT TYPE.
- 
- -- HISTORY:
- --     RJW 06/19/86  CREATED ORIGINAL TEST.
- --     BCB 08/19/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
- --                   PACKAGE B SO WOULD HAVE ONE CASE WHERE DEFAULT IS
- --                   DECLARED BEFORE THE DERIVED TYPE DECLARATION.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34012A IS
- 
- BEGIN
-      TEST ("C34012A", "CHECK THAT DEFAULT EXPRESSIONS IN DERIVED " &
-                       "RECORD TYPES AND DERIVED SUBPROGRAMS ARE " &
-                       "EVALUATED USING THE ENTITIES DENOTED BY THE " &
-                       "EXPRESSIONS IN THE PARENT TYPE" );
- 
-      DECLARE
-           PACKAGE P IS
-                X : INTEGER := 5;
-                TYPE REC IS
-                     RECORD
-                          C : INTEGER := X;
-                     END RECORD;
-           END P;
- 
-           PACKAGE Q IS
-                X : INTEGER := 6;
-                TYPE NEW_REC IS NEW P.REC;
-                QVAR : NEW_REC;
-           END Q;
- 
-           PACKAGE R IS
-                X : INTEGER := 7;
-                TYPE BRAND_NEW_REC IS NEW Q.NEW_REC;
-                RVAR : BRAND_NEW_REC;
-           END R;
- 
-           USE Q;
-           USE R;
-      BEGIN
-           IF QVAR.C = 5 THEN
-                NULL;
-           ELSE
-                FAILED ( "INCORRECT VALUE FOR QVAR" );
-           END IF;
- 
-           IF RVAR.C = 5 THEN
-                NULL;
-           ELSE
-                FAILED ( "INCORRECT VALUE FOR RVAR" );
-           END IF;
-      END;
- 
-      DECLARE
-           PACKAGE A IS
-                TYPE T IS RANGE 1 .. 10;
-                DEFAULT : T := 5;
-                FUNCTION F (X : T := DEFAULT) RETURN T;
-           END A;
- 
-           PACKAGE BODY A IS
-                FUNCTION F (X : T := DEFAULT) RETURN T IS
-                BEGIN
-                     RETURN X;
-                END F;
-           END A;
- 
-           PACKAGE B IS
-                DEFAULT : A.T:= 6;
-                TYPE NEW_T IS NEW A.T;
-                BVAR : NEW_T := F;
-           END B;
- 
-           PACKAGE C IS
-                TYPE BRAND_NEW_T IS NEW B.NEW_T;
-                DEFAULT : BRAND_NEW_T := 7;
-                CVAR : BRAND_NEW_T :=F;
-           END C;
- 
-           USE B;
-           USE C;
-      BEGIN
-           IF BVAR = 5 THEN
-                NULL;
-           ELSE
-                FAILED ( "INCORRECT VALUE FOR BVAR" );
-           END IF;
- 
-           IF CVAR = 5 THEN
-                NULL;
-           ELSE
-                FAILED ( "INCORRECT VALUE FOR CVAR" );
-           END IF;
- 
-           DECLARE
-                VAR : BRAND_NEW_T := F;
-           BEGIN
-                IF VAR = 5 THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT VALUE FOR VAR" );
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END C34012A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,256 ****
- -- C34014A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
- --     DECLARED EXPLICITLY IN THE SAME VISIBLE PART.
- 
- -- HISTORY:
- --     JRK 09/08/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014A IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION F RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION F RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (1));
-           END F;
-      END P;
- 
- BEGIN
-      TEST ("C34014A", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
-                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
-                       "THE SAME VISIBLE PART");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-                FUNCTION F RETURN QT;
-                TYPE QR IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-           PRIVATE
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION F RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END F;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 2 THEN
-                FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
-           END IF;
- 
-           IF Z /= 2 THEN
-                FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-                FUNCTION G RETURN QT;
-                FUNCTION F RETURN QT RENAMES G;
-                TYPE QR IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-           PRIVATE
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
-                             "1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 2 THEN
-                FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 2");
-           END IF;
- 
-           IF Z /= 2 THEN
-                FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           FUNCTION G RETURN T;
- 
-           FUNCTION G RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (2));
-           END G;
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-                FUNCTION F IS NEW G (QT);
-                W : QT := F;
-           PRIVATE
-                TYPE QS IS NEW QT;
-                Z : QS := F;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
-                             "INSTANTIATION");
-                END IF;
- 
-                IF W /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
-                             "INSTANTIATION - 1");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT DERIVED - " &
-                             "INSTANTIATION - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 2 THEN
-                FAILED ("NEW SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
-                        "2");
-           END IF;
- 
-           IF Z /= 2 THEN
-                FAILED ("NEW SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
-                        "2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,259 ****
- -- C34014C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
- --     DECLARED EXPLICITLY IN THE PRIVATE PART.
- 
- -- HISTORY:
- --     JRK 09/11/87  CREATED ORIGINAL TEST.
- --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
- --     PWN 10/24/96  RESTORED CHECK WITH NEW ADA 95 RESULTS EXPECTED.
- --     PWB.CTA 02/20/97  Made failure messages unique.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014C IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION F RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION F RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (1));
-           END F;
-      END P;
- 
- BEGIN
-      TEST ("C34014C", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
-                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
-                       "THE PRIVATE PART");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-           PRIVATE
-                FUNCTION F RETURN QT;
-                TYPE QR IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION F RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END F;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL");
-                END IF;
- 
-             IF Z /= 2 THEN
-                  FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-             END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-           PRIVATE
-                FUNCTION G RETURN QT;
-                FUNCTION F RETURN QT RENAMES G;
-                TYPE QR IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING");
-                END IF;
- 
-          IF Z /= 2 THEN
-               FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - " &
-                             "1");
-          END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           FUNCTION G RETURN T;
- 
-           FUNCTION G RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (2));
-           END G;
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-           PRIVATE
-                FUNCTION F IS NEW G (QT);
-                W : QT := F;
-                TYPE QS IS NEW QT;
-                Z : QS := F;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
-                             "INSTANTIATION - 1");
-                END IF;
- 
-                IF W /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
-                             "INSTANTIATION");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("OLD SUBPROGRAM NOT DERIVED - " &
-                             "INSTANTIATION - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
-                        "2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
-                        "2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,257 ****
- -- C34014E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
- --     DECLARED EXPLICITLY IN THE PACKAGE BODY.
- 
- -- HISTORY:
- --     JRK 09/15/87  CREATED ORIGINAL TEST.
- --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
- --     PWN 04/11/96  Restored subtests in Ada95 legal format.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014E IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION F RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION F RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (1));
-           END F;
-      END P;
- 
- BEGIN
-      TEST ("C34014E", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
-                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
-                       "THE PACKAGE BODY");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION F RETURN QT;
-                TYPE QR IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-                TYPE QS IS NEW QT;
- 
-                FUNCTION F RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END F;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL");
-                END IF;
- 
-             IF Z /= 2 THEN
-                  FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-             END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G RETURN QT;
-                FUNCTION F RETURN QT RENAMES G;
-                TYPE QR IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-                TYPE QS IS NEW QT;
- 
-                FUNCTION G RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - " &
-                             "1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           FUNCTION G RETURN T;
- 
-           FUNCTION G RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (2));
-           END G;
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION F IS NEW G (QT);
-                W : QT := F;
-                TYPE QS IS NEW QT;
-                Z : QS := F;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
-                             "INSTANTIATION - 1");
-                END IF;
- 
-                IF W /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
-                             "INSTANTIATION");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("OLD SUBPROGRAM NOT DERIVED - " &
-                             "INSTANTIATION - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
-                        "2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
-                        "2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- C34014G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC SUBPROGRAM IS LATER
- --     DECLARED EXPLICITLY.
- 
- -- HISTORY:
- --     JRK 09/16/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014G IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION F RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION F RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (1));
-           END F;
-      END P;
- 
- BEGIN
-      TEST ("C34014G", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC " &
-                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NO NEW SUBPROGRAM DECLARED EXPLICITLY");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := F;
-           PRIVATE
-                TYPE QS IS NEW QT;
-                Z : QS := F;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - 1");
-                END IF;
- 
-                IF Z /= 1 THEN
-                     FAILED ("OLD SUBPROGRAM NOT DERIVED - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT VISIBLE - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD SUBPROGRAM NOT DERIVED - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,208 ****
- -- C34014H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
- --     PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A
- --     HOMOGRAPHIC SUBPROGRAM IN THE VISIBLE PART.
- 
- -- HISTORY:
- --     JRK 09/16/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014H IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION F RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION F RETURN T IS
-           BEGIN
-                RETURN T (IDENT_INT (1));
-           END F;
-      END P;
- 
- BEGIN
-      TEST ("C34014H", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
-                       "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " &
-                       "DECLARATION OF A HOMOGRAPHIC SUBPROGRAM IN " &
-                       "THE VISIBLE PART");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS PRIVATE;
-                C2 : CONSTANT QT;
-                FUNCTION F RETURN QT;
-                TYPE QR1 IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-           PRIVATE
-                TYPE QT IS NEW T;
-                C2 : CONSTANT QT := 2;
-                TYPE QR2 IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION F RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END F;
- 
-                PACKAGE R IS
-                     X : QR1;
-                     Y : QR2;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
-                             "DECL - 2");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= C2 THEN
-                FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 3");
-           END IF;
- 
-           IF Z /= RT (C2) THEN
-                FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS PRIVATE;
-                C2 : CONSTANT QT;
-                FUNCTION G RETURN QT;
-                FUNCTION F RETURN QT RENAMES G;
-                TYPE QR1 IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-           PRIVATE
-                TYPE QT IS NEW T;
-                C2 : CONSTANT QT := 2;
-                TYPE QR2 IS
-                     RECORD
-                          C : QT := F;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G RETURN QT IS
-                BEGIN
-                     RETURN QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     X : QR1;
-                     Y : QR2;
-                     Z : QS := F;
-                END R;
-                USE R;
-           BEGIN
-                IF X.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
-                             "2");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
-                             "1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := F;
-                TYPE RT IS NEW QT;
-                Z : RT := F;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= C2 THEN
-                FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 3");
-           END IF;
- 
-           IF Z /= RT (C2) THEN
-                FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014n.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,256 ****
- -- C34014N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
- --     DECLARED EXPLICITLY IN THE SAME VISIBLE PART.
- 
- -- HISTORY:
- --     JRK 09/21/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014N IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION "+" (X : T) RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION "+" (X : T) RETURN T IS
-           BEGIN
-                RETURN X + T (IDENT_INT (1));
-           END "+";
-      END P;
- 
- BEGIN
-      TEST ("C34014N", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
-                       "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
-                       "THE SAME VISIBLE PART");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-                FUNCTION "+" (Y : QT) RETURN QT;
-                TYPE QR IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-           PRIVATE
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION "+" (Y : QT) RETURN QT IS
-                BEGIN
-                     RETURN Y + QT (IDENT_INT (2));
-                END "+";
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 2 THEN
-                FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
-           END IF;
- 
-           IF Z /= 2 THEN
-                FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-                FUNCTION G (X : QT) RETURN QT;
-                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
-                TYPE QR IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-           PRIVATE
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G (X : QT) RETURN QT IS
-                BEGIN
-                     RETURN X + QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - " &
-                             "1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 2 THEN
-                FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - 2");
-           END IF;
- 
-           IF Z /= 2 THEN
-                FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           FUNCTION G (Y : T) RETURN T;
- 
-           FUNCTION G (Y : T) RETURN T IS
-           BEGIN
-                RETURN Y + T (IDENT_INT (2));
-           END G;
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-                FUNCTION "+" IS NEW G (QT);
-                W : QT := +0;
-           PRIVATE
-                TYPE QS IS NEW QT;
-                Z : QS := +0;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - " &
-                             "INSTANTIATION");
-                END IF;
- 
-                IF W /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - " &
-                             "INSTANTIATION - 1");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT DERIVED - " &
-                             "INSTANTIATION - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 2 THEN
-                FAILED ("NEW OPERATOR NOT VISIBLE - INSTANTIATION - " &
-                        "2");
-           END IF;
- 
-           IF Z /= 2 THEN
-                FAILED ("NEW OPERATOR NOT DERIVED - INSTANTIATION - " &
-                        "2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014p.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,258 ****
- -- C34014P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
- --     DECLARED EXPLICITLY IN THE PRIVATE PART.
- 
- -- HISTORY:
- --     JRK 09/22/87  CREATED ORIGINAL TEST.
- --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
- --     PWN 04/11/96  Restored subtests in Ada95 legal format.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014P IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION "+" (X : T) RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION "+" (X : T) RETURN T IS
-           BEGIN
-                RETURN X + T (IDENT_INT (1));
-           END "+";
-      END P;
- 
- BEGIN
-      TEST ("C34014P", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
-                       "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
-                       "THE PRIVATE PART");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-           PRIVATE
-                FUNCTION "+" (Y : QT) RETURN QT;
-                TYPE QR IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION "+" (Y : QT) RETURN QT IS
-                BEGIN
-                     RETURN Y + QT (IDENT_INT (2));
-                END "+";
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL");
-                END IF;
- 
-                IF Z /= 2 THEN
-                    FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-           PRIVATE
-                FUNCTION G (X : QT) RETURN QT;
-                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
-                TYPE QR IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G (X : QT) RETURN QT IS
-                BEGIN
-                     RETURN X + QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING");
-                END IF;
- 
-            IF Z /= 2 THEN
-                 FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - " &
-                             "1");
-            END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           FUNCTION G (Y : T) RETURN T;
- 
-           FUNCTION G (Y : T) RETURN T IS
-           BEGIN
-                RETURN Y + T (IDENT_INT (2));
-           END G;
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-           PRIVATE
-                FUNCTION "+" IS NEW G (QT);
-                W : QT := +0;
-                TYPE QS IS NEW QT;
-                Z : QS := +0;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - " &
-                             "INSTANTIATION - 1");
-                END IF;
- 
-                IF W /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - " &
-                             "INSTANTIATION");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("OLD OPERATOR NOT DERIVED - " &
-                             "INSTANTIATION - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD OPERATOR NOT VISIBLE - INSTANTIATION - " &
-                        "2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD OPERATOR NOT DERIVED - INSTANTIATION - " &
-                        "2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014r.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,257 ****
- -- C34014R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
- --     DECLARED EXPLICITLY IN THE PACKAGE BODY.
- 
- -- HISTORY:
- --     JRK 09/22/87  CREATED ORIGINAL TEST.
- --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
- --     PWN 04/11/96  Restored subtests in Ada95 legal format.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014R IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION "+" (X : T) RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION "+" (X : T) RETURN T IS
-           BEGIN
-                RETURN X + T (IDENT_INT (1));
-           END "+";
-      END P;
- 
- BEGIN
-      TEST ("C34014R", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
-                       "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
-                       "THE PACKAGE BODY");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION "+" (Y : QT) RETURN QT;
-                TYPE QR IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-                TYPE QS IS NEW QT;
- 
-                FUNCTION "+" (Y : QT) RETURN QT IS
-                BEGIN
-                     RETURN Y + QT (IDENT_INT (2));
-                END "+";
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL");
-                END IF;
- 
-                IF Z /= 2 THEN
-                    FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G (X : QT) RETURN QT;
-                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
-                TYPE QR IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-                TYPE QS IS NEW QT;
- 
-                FUNCTION G (X : QT) RETURN QT IS
-                BEGIN
-                     RETURN X + QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     Y : QR;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING");
-                END IF;
- 
-             IF Z /= 2 THEN
-                 FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - " &
-                             "1");
-             END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           FUNCTION G (Y : T) RETURN T;
- 
-           FUNCTION G (Y : T) RETURN T IS
-           BEGIN
-                RETURN Y + T (IDENT_INT (2));
-           END G;
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION "+" IS NEW G (QT);
-                W : QT := +0;
-                TYPE QS IS NEW QT;
-                Z : QS := +0;
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - " &
-                             "INSTANTIATION - 1");
-                END IF;
- 
-                IF W /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - " &
-                             "INSTANTIATION");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("OLD OPERATOR NOT DERIVED - " &
-                             "INSTANTIATION - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD OPERATOR NOT VISIBLE - INSTANTIATION - " &
-                        "2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD OPERATOR NOT DERIVED - INSTANTIATION - " &
-                        "2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014t.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014t.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014t.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014t.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- C34014T.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC OPERATOR IS LATER
- --     DECLARED EXPLICITLY.
- 
- -- HISTORY:
- --     JRK 09/22/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014T IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION "+" (X : T) RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION "+" (X : T) RETURN T IS
-           BEGIN
-                RETURN X + T (IDENT_INT (1));
-           END "+";
-      END P;
- 
- BEGIN
-      TEST ("C34014T", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
-                       "VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC " &
-                       "OPERATOR IS LATER DECLARED EXPLICITLY");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NO NEW OPERATOR DECLARED EXPLICITLY");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS NEW T;
-                X : QT := +0;
-           PRIVATE
-                TYPE QS IS NEW QT;
-                Z : QS := +0;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT VISIBLE - 1");
-                END IF;
- 
-                IF Z /= 1 THEN
-                     FAILED ("OLD OPERATOR NOT DERIVED - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +0;
-                TYPE RT IS NEW QT;
-                Z : RT := +0;
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= 1 THEN
-                FAILED ("OLD OPERATOR NOT VISIBLE - 2");
-           END IF;
- 
-           IF Z /= 1 THEN
-                FAILED ("OLD OPERATOR NOT DERIVED - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014T;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014u.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34014u.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34014u.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,212 ****
- -- C34014U.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
- --     UNDER APPROPRIATE CIRCUMSTANCES.
- 
- --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
- --     PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A
- --     HOMOGRAPHIC OPERATOR IN THE VISIBLE PART.
- 
- -- HISTORY:
- --     JRK 09/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C34014U IS
- 
-      PACKAGE P IS
-           TYPE T IS RANGE -100 .. 100;
-           FUNCTION "+" (X : T) RETURN T;
-      END P;
-      USE P;
- 
-      PACKAGE BODY P IS
-           FUNCTION "+" (X : T) RETURN T IS
-           BEGIN
-                RETURN X + T (IDENT_INT (1));
-           END "+";
-      END P;
- 
- BEGIN
-      TEST ("C34014U", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
-                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
-                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
-                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
-                       "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " &
-                       "DECLARATION OF A HOMOGRAPHIC OPERATOR IN " &
-                       "THE VISIBLE PART");
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS PRIVATE;
-                C0 : CONSTANT QT;
-                C2 : CONSTANT QT;
-                FUNCTION "+" (Y : QT) RETURN QT;
-                TYPE QR1 IS
-                     RECORD
-                          C : QT := +C0;
-                     END RECORD;
-           PRIVATE
-                TYPE QT IS NEW T;
-                C0 : CONSTANT QT := 0;
-                C2 : CONSTANT QT := 2;
-                TYPE QR2 IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION "+" (Y : QT) RETURN QT IS
-                BEGIN
-                     RETURN Y + QT (IDENT_INT (2));
-                END "+";
- 
-                PACKAGE R IS
-                     X : QR1;
-                     Y : QR2;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL - 1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
-                             "DECL - 2");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG " &
-                             "DECL - 1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +C0;
-                TYPE RT IS NEW QT;
-                Z : RT := +RT(C0);
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= C2 THEN
-                FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG DECL - 3");
-           END IF;
- 
-           IF Z /= RT (C2) THEN
-                FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG DECL - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
- 
-      DECLARE
- 
-           PACKAGE Q IS
-                TYPE QT IS PRIVATE;
-                C0 : CONSTANT QT;
-                C2 : CONSTANT QT;
-                FUNCTION G (X : QT) RETURN QT;
-                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
-                TYPE QR1 IS
-                     RECORD
-                          C : QT := +C0;
-                     END RECORD;
-           PRIVATE
-                TYPE QT IS NEW T;
-                C0 : CONSTANT QT := 0;
-                C2 : CONSTANT QT := 2;
-                TYPE QR2 IS
-                     RECORD
-                          C : QT := +0;
-                     END RECORD;
-                TYPE QS IS NEW QT;
-           END Q;
-           USE Q;
- 
-           PACKAGE BODY Q IS
-                FUNCTION G (X : QT) RETURN QT IS
-                BEGIN
-                     RETURN X + QT (IDENT_INT (2));
-                END G;
- 
-                PACKAGE R IS
-                     X : QR1;
-                     Y : QR2;
-                     Z : QS := +0;
-                END R;
-                USE R;
-           BEGIN
-                IF X.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
-                             "1");
-                END IF;
- 
-                IF Y.C /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
-                             "2");
-                END IF;
- 
-                IF Z /= 2 THEN
-                     FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - " &
-                             "1");
-                END IF;
-           END Q;
- 
-           PACKAGE R IS
-                Y : QT := +C0;
-                TYPE RT IS NEW QT;
-                Z : RT := +RT(C0);
-           END R;
-           USE R;
- 
-      BEGIN
-           IF Y /= C2 THEN
-                FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - 3");
-           END IF;
- 
-           IF Z /= RT (C2) THEN
-                FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - 2");
-           END IF;
-      END;
- 
-      -----------------------------------------------------------------
- 
-      RESULT;
- END C34014U;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34018a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34018a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c34018a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c34018a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,154 ****
- -- C34018A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CALLS OF DERIVED SUBPROGRAMS CHECK CONSTRAINTS OF THE
- -- PARENT SUBPROGRAM, NOT THE CONSTRAINTS OF THE DERIVED SUBTYPE.
- 
- -- JBG 11/15/85
- -- JRK 2/12/86   CORRECTED ERROR: RESOLVED AMBIGUOUS CALL G(41) TO
- --               TYPE NEW_INT.
- -- EDS 7/16/98   AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C34018A IS
- 
-      PACKAGE P IS
-           TYPE INT IS RANGE 1..100;
-           SUBTYPE INT_50 IS INT RANGE 1..50;
-           SUBTYPE INT_51 IS INT RANGE 51..100;
- 
-           FUNCTION "+" (L, R : INT) RETURN INT;
-           FUNCTION G (X : INT_50) RETURN INT_51;
- 
-           TYPE STR IS ARRAY (1..10) OF CHARACTER;
-           FUNCTION F (X : STR) RETURN STR;
-      END P;
- 
-      USE P;
- 
-      TYPE NEW_STR IS NEW P.STR;
-      TYPE NEW_INT IS NEW P.INT RANGE 51..90;
- 
-      PACKAGE BODY P IS
- 
-           FUNCTION "+" (L, R : INT) RETURN INT IS
-           BEGIN
-                RETURN INT(INTEGER(L) + INTEGER(R));
-           END "+";
- 
-           FUNCTION G (X : INT_50) RETURN INT_51 IS
-           BEGIN
-                RETURN X + 10;
-           END G;
- 
-           FUNCTION F (X : STR) RETURN STR IS
-           BEGIN
-                RETURN X;
-           END F;
- 
-      END P;
- 
- BEGIN
- 
-      TEST ("C34018A", "CHECK CONSTRAINTS PROCESSED CORRECTLY FOR " &
-                       "CALLS OF DERIVED SUBPROGRAMS");
- 
-      DECLARE
- 
-           Y : NEW_STR := F("1234567890");    -- UNAMBIGUOUS.
- 
-      BEGIN
-           IF Y /= "1234567890" THEN
-                FAILED ("DERIVED F");
-           END IF;
-      END;
- 
-      DECLARE
- 
-           A : INT := 51;
-           B : NEW_INT := NEW_INT(IDENT_INT(90));
- 
-      BEGIN
- 
-           BEGIN
-                A := A + 0;
-                FAILED ("NO EXCEPTION - A + 0 = " & INT'IMAGE(A) ); --Use A
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                IF B + 2 /= 92 THEN      -- 92 IN INT.
-                     FAILED ("WRONG RESULT - B + 2");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("WRONG CONSTRAINT FOR DERIVED ""+""");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 2");
-           END;
- 
-           BEGIN
-                IF B + 14 > 90 THEN      -- 104 NOT IN INT.
-                     FAILED ("NO EXCEPTION RAISED FOR DERIVED ""+""");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 3");
-           END;
- 
- 
-           BEGIN
-                IF G(B) > 90 THEN        -- 90 NOT IN INT_50.
-                     FAILED ("NO EXCEPTION RAISED FOR DERIVED G");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 4");
-           END;
- 
-           BEGIN
-                IF C34018A.G(41) /= 51 THEN  -- 41 CONVERTED TO
-                                             --    NEW_INT'BASE.
-                                             -- 41 IN INT_50.
-                                             -- 51 IN INT_51.
-                     FAILED ("WRONG RESULT - G(41)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("C_E RAISED FOR LITERAL ARGUMENT");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 5");
-           END;
-      END;
- 
-      RESULT;
- END C34018A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c340a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c340a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c340a01.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c340a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C340A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a tagged type declared in a package specification
- --      may be passed as a generic formal (tagged) private type to a generic
- --      package declaration. Check that the formal type may be extended with
- --      a record extension in the generic package.
- --
- --      Check that, in the instance, the record extension inherits the
- --      user-defined primitive subprograms of the tagged actual.
- --
- -- TEST DESCRIPTION:
- --      Declare a tagged type and an associated primitive subprogram in a
- --      package specification (foundation code). Declare a generic package
- --      which takes a tagged type as a formal parameter, and then extends
- --      it with a record extension (foundation code).
- --      
- --      Instantiate the generic package with the tagged type from the first
- --      package (the "generic" extension should now have inherited
- --      the primitive subprogram of the tagged type from the first
- --      package).
- -- 
- --      In the main program, call the primitive subprogram inherited by the
- --      "generic" extension, and verify the correctness of the components.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F340A000.A
- --         F340A001.A
- --      => C340A01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Removed extraneous
- --                          comments.
- --
- --!
- 
- with F340A001;        -- Book definitions.  
- package C340A01_0 is  -- Raw data to be used in creating book elements.
- 
- 
-    Book_Count : constant := 3;
- 
-    subtype Number_Of_Books is Integer range 1 .. Book_Count;
- 
-    type Data_List is array (Number_Of_Books) of F340A001.Text_Ptr;
- 
-    Title_List  : Data_List := (new String'("Wuthering Heights"),
-                                new String'("Heart of Darkness"),
-                                new String'("Ulysses"));
- 
-    Author_List : Data_List := (new String'("Bronte, Emily"),
-                                new String'("Conrad, Joseph"),
-                                new String'("Joyce, James"));
- 
- end C340A01_0;
- 
- 
-      --==================================================================--
- 
- 
- -- Library-level instantiation. Actual parameter is tagged record.
- 
- with F340A001;  -- Book definitions.
- with F340A000;  -- Singly-linked list abstraction.
- package C340A01_1 is new F340A000 (Parent_Type => F340A001.Book_Type);
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with F340A001;   -- Book definitions.
- with C340A01_0;  -- Raw book data.
- with C340A01_1;  -- Instance.
- 
- use  F340A001;   -- Primitive operations of Book_Type directly visible.
- use  C340A01_1;  -- Operations inherited by Node_Type directly visible.
- 
- procedure C340A01 is
- 
- 
-    List_Of_Books : Node_Ptr := null;  -- Head of linked list of books.
- 
- 
-           --========================================================--
- 
- 
-    procedure Create_List (Title, Author : in     C340A01_0.Data_List;
-                           Head          : in out Node_Ptr) is
- 
-       Book     : Node_Type;  -- Object of extended type.
-       Book_Ptr : Node_Ptr;
- 
-    begin
-       for I in C340A01_0.Number_Of_Books loop
-          Create_Book (Title (I), Author (I), Book);    -- Call inherited
-                                                        -- operation.
-          Book_Ptr := new Node_Type'(Book);
-          Add (Book_Ptr, Head);
-       end loop;
-    end Create_List;
- 
- 
-           --========================================================--
- 
- 
-    function Bad_List_Contents return Boolean is
-    begin
-       return (List_Of_Books.Title.all            /= "Ulysses"           or
-               List_Of_Books.Author.all           /= "Joyce, James"      or
-               List_Of_Books.Next.Title.all       /= "Heart of Darkness" or
-               List_Of_Books.Next.Author.all      /= "Conrad, Joseph"    or
-               List_Of_Books.Next.Next.Title.all  /= "Wuthering Heights" or
-               List_Of_Books.Next.Next.Author.all /= "Bronte, Emily");
-    end Bad_List_Contents;
- 
- 
-           --========================================================--
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("C340A01", "Inheritance of primitive operations: record " &
-                 "extension of formal tagged private type; actual is " &
-                 "an ultimate ancestor type");
- 
-    -- Create linked list using inherited operation:
-    Create_List (C340A01_0.Title_List, C340A01_0.Author_List, List_Of_Books);
- 
-    -- Verify results:
-    if Bad_List_Contents then
-       Report.Failed ("Wrong values after call to inherited operation");
-    end if;
- 
-    Report.Result;
- 
- end C340A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c340a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c340a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c340a02.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c340a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,221 ****
- -- C340A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a record extension (declared in a package specification) of
- --      a tagged type (declared in a different package specification) may be
- --      passed as a generic formal (tagged) private type to a generic package
- --      declaration. Check that the formal type may be further extended with a
- --      record extension in the generic package.
- --
- --      Check that, in the instance, the record extension inherits the
- --      user-defined primitive subprograms of the tagged actual, including
- --      those inherited by the actual from its parent.
- --
- -- TEST DESCRIPTION:
- --      Declare a tagged type and an associated primitive subprogram in a
- --      package specification (foundation code). Declare a record extension
- --      of the tagged type and an associated primitive subprogram in a second
- --      package specification. Declare a generic package which takes a tagged
- --      type as a formal parameter, and then extends it with a record
- --      extension (foundation code).
- --      
- --      Instantiate the generic package with the record extension from the
- --      second package (the "generic" extension should now have inherited
- --      the primitive subprograms of the record extension from the second
- --      package).
- -- 
- --      In the main program, call the primitive subprograms inherited by the
- --      "generic" extension. There are two: (1) Create_Book, declared for
- --      the root tagged type in the first package (inherited by the record
- --      extension of the second package, and then in turn by the "generic"
- --      extension), and (2) Update_Pages, declared for the record extension
- --      in the second package. Verify the correctness of the components.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F340A000.A
- --         F340A001.A
- --      => C340A02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Removed extraneous
- --                          comments.
- --
- --!
- 
- with F340A001;        -- Book definitions.
- package C340A02_0 is  -- Extended book abstraction.
- 
- 
-    type Detailed_Book_Type is new F340A001.Book_Type with record
-       Pages : Natural;                                        -- Record ext.
-    end record;                                                -- of root tagged
-                                                               -- type.
- 
-    -- Inherits Create_Book from Book_Type.
- 
-    procedure Update_Pages (Book  : in out Detailed_Book_Type; -- Primitive op.
-                            Pages : in     Natural);           -- of extension.
- 
- 
- end C340A02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C340A02_0 is
- 
- 
-    procedure Update_Pages (Book  : in out Detailed_Book_Type;
-                            Pages : in     Natural) is
-    begin
-       Book.Pages := Pages;
-    end Update_Pages;
- 
- 
- end C340A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with F340A001;        -- Book definitions.
- package C340A02_1 is  -- Raw data to be used in creating book elements.
- 
- 
-    Book_Count : constant := 3;
- 
-    subtype Number_Of_Books is Integer range 1 .. Book_Count;
- 
-    type Data_List   is array (Number_Of_Books) of F340A001.Text_Ptr;
-    type Page_Counts is array (Number_Of_Books) of Natural;
- 
-    Title_List  : Data_List   := (new String'("Wuthering Heights"),
-                                  new String'("Heart of Darkness"),
-                                  new String'("Ulysses"));
- 
-    Author_List : Data_List   := (new String'("Bronte, Emily"),
-                                  new String'("Conrad, Joseph"),
-                                  new String'("Joyce, James"));
- 
-    Page_List   : Page_Counts := (237, 215, 456);
- 
- end C340A02_1;
- 
- 
-      --==================================================================--
- 
- 
- -- Library-level instantiation. Actual parameter is record extension.
- 
- with C340A02_0;  -- Extended book abstraction.
- with F340A000;   -- Singly-linked list abstraction.
- package C340A02_2 is new F340A000
-   (Parent_Type => C340A02_0.Detailed_Book_Type);
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with C340A02_0; -- Extended book abstraction.
- with C340A02_1; -- Raw book data.
- with C340A02_2; -- Instance.
- 
- use  C340A02_0; -- Primitive operations of Detailed_Book_Type directly visible.
- use  C340A02_2; -- Operations inherited by Node_Type directly visible.
- 
- procedure C340A02 is
- 
- 
-    List_Of_Books : Node_Ptr := null;  -- Head of linked list of books.
- 
- 
-           --========================================================--
- 
- 
-    procedure Create_List (Title, Author : in     C340A02_1.Data_List;
-                           Pages         : in     C340A02_1.Page_Counts;
-                           Head          : in out Node_Ptr) is
- 
-       Book     : Node_Type;  -- Object of extended type.
-       Book_Ptr : Node_Ptr;
- 
-    begin
-       for I in C340A02_1.Number_Of_Books loop
-          Create_Book (Title (I), Author (I), Book);    -- Call twice-inherited
-                                                        -- operation.
-          Update_Pages (Book, Pages (I));               -- Call inherited op.
-          Book_Ptr := new Node_Type'(Book);
-          Add (Book_Ptr, Head);
-       end loop;
-    end Create_List;
- 
- 
-           --========================================================--
- 
- 
-    function Bad_List_Contents return Boolean is
-    begin
-       return (List_Of_Books.Title.all            /= "Ulysses"           or
-               List_Of_Books.Author.all           /= "Joyce, James"      or
-               List_Of_Books.Pages                /= 456                 or
-               List_Of_Books.Next.Title.all       /= "Heart of Darkness" or
-               List_Of_Books.Next.Author.all      /= "Conrad, Joseph"    or
-               List_Of_Books.Next.Pages           /= 215                 or
-               List_Of_Books.Next.Next.Title.all  /= "Wuthering Heights" or
-               List_Of_Books.Next.Next.Author.all /= "Bronte, Emily"     or
-               List_Of_Books.Next.Next.Pages      /= 237);
- 
-    end Bad_List_Contents;
- 
- 
-           --========================================================--
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("C340A02", "Inheritance of primitive operations: record " &
-                 "extension of formal tagged private type; actual is " &
-                 "a record extension");
- 
-    -- Create linked list using inherited operation:
-    Create_List (C340A02_1.Title_List, C340A02_1.Author_List,
-                 C340A02_1.Page_List,  List_Of_Books);
- 
-    -- Verify results:
-    if Bad_List_Contents then
-       Report.Failed ("Wrong values after call to inherited operations");
-    end if;
- 
-    Report.Result;
- 
- end C340A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a01.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C341A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that formal parameters of a class-wide type can be passed 
- --      values of any specific type within the class.
- --
- -- TEST DESCRIPTION:
- --      Define an object of a root tagged type and of various types derived
- --      from the root.  Define objects of the root class, and initialize them
- --      by parameter association of objects of the specific types (root and 
- --      extended types) within the class.
- --
- --      The particular root and extended types used in this abstraction are
- --      defined in foundation code (F341A00.A), and are graphically displayed
- --      as follows:
- --
- --           package Bank
- --              type Account
- --                  |
- --                  |
- --                  |
- --               package Checking
- --                  type Account
- --                      |
- --                      |
- --                      | 
- --                   package Interest_Checking
- --                          type Account
- --
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         F341A00.A
- --
- --      The following files comprise this test:
- --
- --      => C341A01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with F341A00_0;            -- package Bank
- with F341A00_1;            -- package Checking
- with F341A00_2;            -- package Interest_Checking
- with Report;
- 
- procedure C341A01 is
- 
-    package Bank              renames F341A00_0;
-    use type Bank.Dollar_Amount;
-    package Checking          renames F341A00_1;
-    package Interest_Checking renames F341A00_2;
- 
-    Max_Accts    : constant := 3;
-    Bank_Balance : Bank.Dollar_Amount := 0.00;
- 
-    -- Initialize objects of specific tagged types.
-    B_Acct  : Bank.Account              := (Current_Balance => 10.00); 
-    C_Acct  : Checking.Account          := (100.00, 10.00); 
-    IC_Acct : Interest_Checking.Account := (1000.00, 10.00, 0.030);
- 
-    -- Define and initialize (by parameter association) objects of class-wide 
-    -- type originating from the root type (Bank.Account).
- 
-    -- Define an account auditing procedure with a class-wide
-    -- variable that can hold a value of any object within the class.
-    procedure Audit (Next_Account : Bank.Account'Class) is
-    begin
-       Bank_Balance := Bank_Balance + Next_Account.Current_Balance;
-    end Audit;
- 
- 
- begin  -- C341A01
- 
-    Report.Test ("C341A01", "Check that objects of a class-wide type can " &
-                            "be initialized, by direct assignment, to a "  &
-                            "value of any specific type within the class" ); 
- 
-    -- Perform nightly audit of total funds on deposit in bank.
-    Audit (B_Acct);
-    Audit (C_Acct);
-    Audit (IC_Acct);
- 
-    if Bank_Balance /= 1110.00 then
-       Report.Failed ("Class-wide object processing failed");
-    end if;
- 
-    Report.Result;
- 
- end C341A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a02.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C341A02.A
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- OBJECTIVE:
-  --      Check that class-wide objects can be reassigned with objects from 
-  --      the same specific type used to initialize them.
-  --
-  -- TEST DESCRIPTION:
-  --      Define new objects of specific types from within a class. Reassign
-  --      previously declared class-wide objects with the new specific type 
-  --      objects. Check that new assignments were performed.
-  --
-  --      The particular root and extended types used in this abstraction are
-  --      defined in foundation code (F341A00.A), and are graphically displayed
-  --      as follows:
-  --
-  --           package Bank
-  --              type Account
-  --                  |
-  --                  |
-  --                  |
-  --               package Checking
-  --                  type Account
-  --                      |
-  --                      |
-  --                      | 
-  --                   package Interest_Checking
-  --                          type Account
-  --
-  -- TEST FILES:
-  --      This test depends on the following foundation code:
-  --
-  --         F341A00.A
-  --
-  --      The following files comprise this test:
-  --
-  --      => C341A02.A
-  --
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  with F341A00_0;            -- package Bank
-  with F341A00_1;            -- package Checking
-  with F341A00_2;            -- package Interest_Checking
-  with Report;
-  
-  procedure C341A02 is
-  
-     package Bank              renames F341A00_0;
-     package Checking          renames F341A00_1;
-     package Interest_Checking renames F341A00_2;
-  
-     Max_Accts    : constant := 3;
-     Bank_Balance : Bank.Dollar_Amount := 0.00;
-  
-     -- Define and initialize objects of specific types.
-     B_Acct      : aliased Bank.Account := (Current_Balance => 10.00); 
-     C_Acct      : aliased Checking.Account          := (100.00, 10.00); 
-     IC_Acct     : aliased Interest_Checking.Account := (1000.00, 10.00, 0.030);
-     New_B_Acct  : aliased Bank.Account := (Current_Balance => 20.00);
-     New_C_Acct  : aliased Checking.Account          := (200.00,  20.00);
-     New_IC_Acct : aliased Interest_Checking.Account := (2000.00, 20.00, 0.060);
-  
-  
-     -- Define and initialize (by direct assignment) objects of a class-wide 
-     -- type originating from the root type (Bank.Account).
-     
-     type ATM_Card is access all Bank.Account'Class;
-  
-     Accounts : array (1 .. Max_Accts) of ATM_Card := 
-       (1 => B_Acct'Access, 2 => C_Acct'Access, 3 => IC_Acct'Access);
-  
-     New_Accounts : array (1 .. Max_Accts) of ATM_Card := 
-       (1 => New_B_Acct'Access,
-        2 => New_C_Acct'Access,
-        3 => New_IC_Acct'Access);
-  
-     -- Define an account auditing procedure with a class-wide
-     -- variable that can hold a value of any object within the class,
-     -- and once initialized, can hold other values of the same specific type.
-  
-     procedure Audit (Num : in     integer;
-                      Amt :    out Bank.Dollar_Amount) is
-        Account_Being_Audited : Bank.Account'Class := Accounts(Num).all;
-        use type Bank.Dollar_Amount;
-     begin
-        Amt := Account_Being_Audited.Current_Balance;
-        -- Reassign class-wide variable to another object of the type used to
-        -- initialize it.
-        Account_Being_Audited := New_Accounts(Num).all;
-        Amt := Amt + Account_Being_Audited.Current_Balance;  -- Reading OUT
-     end Audit;                                              -- parameter.
-  
-  
-  begin 
-  
-     Report.Test ("C341A02", "Check that class-wide objects can be "  &
-                             "reassigned with objects from the same " &
-                             "specific type used to initialize them" );
-     Night_Audit:
-     declare
-        use type Bank.Dollar_Amount;
-        Acct_Value : Bank.Dollar_Amount := 0.00;
-     begin
-        -- Perform nightly audit of total funds on deposit in bank.
-        for i in 1 .. Max_Accts loop
-           Audit (i, Acct_Value);
-           Bank_Balance := Bank_Balance + Acct_Value;
-        end loop;
-  
-        if Bank_Balance /= 3330.00 then
-           Report.Failed ("Class-wide object processing failed");
-        end if;
-  
-     end Night_Audit;
-  
-     Report.Result;
-  
-  end C341A02;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a03.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- C341A03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an object of one class-wide type can initialize a 
- --      class-wide object of a different type when the operation is embedded
- --      in a generic unit.
- --
- -- TEST DESCRIPTION:
- --      Declare specific-type objects of an extended type.  Declare an array
- --      of access values designating class-wide objects, initialized to point
- --      to the objects of the specific type.  Define a generic subprogram
- --      having a generic formal derived type parameter.  Within the generic,
- --      declare a class-wide variable of the formal parameter type.  Verify
- --      that the variable can be initialized with the value of an object
- --      of another class-wide type within the class.
- --
- --      The particular root and extended types used in this abstraction are
- --      defined in foundation code (F341A00.A), and are graphically displayed
- --      as follows:
- --
- --           package Bank
- --              type Account
- --                  |
- --                  |
- --                  |
- --               package Checking
- --                  type Account
- --                      |
- --                      |
- --                      | 
- --                   package Interest_Checking
- --                          type Account
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         F341A00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Dec 94   SAIC    Changed level of 'Class for ATM_Card
- --
- --!
- 
- with F341A00_0;            -- package Bank
- generic
-    type Account_Type is new F341A00_0.Account with private; -- new Bank.Account
- function C341A03_0 (The_Account : Account_Type'Class)       -- function Audit
-   return F341A00_0.Dollar_Amount;
- 
- function C341A03_0 (The_Account : Account_Type'Class)
-   return F341A00_0.Dollar_Amount is
-    Acct : Account_Type'Class := The_Account;  -- Init. of class-wide with
- begin                                         -- another class-wide object.
-    return Acct.Current_Balance;
- end C341A03_0;
- 
- 
-      --=================================================================--
- 
- 
- with F341A00_0;            -- package Bank
- with F341A00_1;            -- package Checking
- with C341A03_0;            -- generic function Audit
- with Report;
- 
- procedure C341A03 is
- 
-    package Bank     renames F341A00_0;
-    package Checking renames F341A00_1;
- 
-    Current_Checking_Accounts : constant := 3;
- 
-    Checking_Acct1 : aliased Checking.Account := (Current_Balance => 10.00,
-                                                  Overdraft_Fee   =>  5.00);
-    Checking_Acct2 : aliased Checking.Account := (Current_Balance => 20.00,
-                                                  Overdraft_Fee   =>  5.00);
-    Checking_Acct3 : aliased Checking.Account := (Current_Balance => 30.00,
-                                                  Overdraft_Fee   =>  5.00);
- 
-    type ATM_Card is access all Checking.Account'Class;
- 
-    -- Declare array of accesses to class-wide objects.
-    Account_Array : array (1 .. Current_Checking_Accounts) of 
-      ATM_Card := (Checking_Acct1'Access, 
-                   Checking_Acct2'Access, 
-                   Checking_Acct3'Access);
- begin  -- C341A03
- 
-    Report.Test ("C341A03",  "Check that an object of one class-wide type " &
-                             "can initialize a class-wide object of a "   &
-                             "different type when the operation is embedded " &
-                             "in a generic unit" );
- 
-    Audit_Checking_Accounts:
-    declare
-       Balance_In_Checking_Accounts : Bank.Dollar_Amount := 0.00;
-       -- Instantiate with a specific extended type.
-       function Checking_Audit is new C341A03_0 (Checking.Account);
-       use type Bank.Dollar_Amount;
-    begin
- 
-       for I in 1 .. Current_Checking_Accounts loop
-          Balance_In_Checking_Accounts := Balance_In_Checking_Accounts + 
-            Checking_Audit (Account_Array (I).all);
-       end loop;
- 
-       if Balance_In_Checking_Accounts /= 60.00 then
-          Report.Failed ("Incorrect initialization of class-wide object");
-       end if;
- 
-    end Audit_Checking_Accounts;
- 
-    Report.Result;
- 
- end C341A03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a04.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a04.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c341a04.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c341a04.a	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- C341A04.A
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- OBJECTIVE:
-  --      Check that class-wide objects can be initialized using allocation. 
-  --
-  -- TEST DESCRIPTION:
-  --      Declare access types that refer to class-wide types, one with basis
-  --      of the root type, another with basis of a type extended from the root.
-  --      Declare objects of these access types, and allocate class-wide
-  --      objects, initialized to values of specific types within the particular
-  --      classes.
-  --
-  --      The particular root and extended types used in this abstraction are
-  --      defined in foundation code (F341A00.A), and are graphically displayed
-  --      as follows:
-  --
-  --           package Bank
-  --              type Account
-  --                  |
-  --                  |
-  --                  |
-  --               package Checking
-  --                  type Account
-  --                      |
-  --                      |
-  --                      | 
-  --                   package Interest_Checking
-  --                          type Account
-  --
-  -- TEST FILES:
-  --      This test depends on the following foundation code:
-  --
-  --         F341A00.A
-  --
-  --      The following files comprise this test:
-  --
-  --      => C341A04.A
-  --
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  with F341A00_0;            -- package Bank
-  with F341A00_1;            -- package Checking
-  with F341A00_2;            -- package Interest_Checking
-  with Report;
-  
-  procedure C341A04 is
-  
-     package Bank              renames F341A00_0;
-     package Checking          renames F341A00_1;
-     package Interest_Checking renames F341A00_2;
-  
-     use type Bank.Dollar_Amount;
-  
-     Max_Accts    : constant := 3;
-     Bank_Balance : Bank.Dollar_Amount := 0.00;
-  
-     -- Define access types referring to class of types rooted at 
-     -- Bank.Account (root). 
-  
-     type Bank_Account_Pointer is access Bank.Account'Class;
-  
-     --
-     -- Define class-wide objects, initializing them through allocation.
-     --
-  
-     -- Initialized to specific type that is basis of class.
-     Bank_Acct : Bank_Account_Pointer :=
-       new Bank.Account'(Current_Balance => 10.00);
-  
-     -- Initialized to specific type that has been extended from the basis
-     -- of the class.
-     Checking_Acct : Bank_Account_Pointer :=
-       new Checking.Account'(Current_Balance => 100.00,
-                             Overdraft_Fee   =>  10.00);
-  
-     -- Initialized to specific type that has been twice extended from the
-     -- basis of the class.
-     IC_Acct : Bank_Account_Pointer := 
-       new Interest_Checking.Account'(Current_Balance => 1000.00,
-                                      Overdraft_Fee   =>   10.00,
-                                      Rate            =>    0.030);
-  
-     -- Declare and initialize array of pointers to objects of
-     -- Bank.Account'Class.
-  
-     Accounts : array (1 .. Max_Accts) of Bank_Account_Pointer :=
-       (Bank_Acct, Checking_Acct, IC_Acct);
-  
-  
-     -- Audit will process any account object within Bank.Account'Class.
-  
-     function Audit (Ptr : Bank_Account_Pointer) return Bank.Dollar_Amount is
-     begin
-        return (Ptr.Current_Balance);
-     end Audit;
-  
-  
-  begin  -- C341A04
-  
-     Report.Test ("C341A04", "Check that class-wide objects were " &
-                             "successfully initialized using allocation" );
-  
-     for i in 1 .. Max_Accts loop
-        Bank_Balance := Bank_Balance + Audit (Accounts(i));
-     end loop;
-  
-     if Bank_Balance /= 1110.00 then
-        Report.Failed ("Failed class-wide object allocation");
-     end if;
-  
-     Report.Result;
-  
-  end C341A04;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35003a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- C35003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR AN INTEGER OR
- --     ENUMERATION SUBTYPE INDICATION WHEN THE LOWER OR UPPER BOUND
- --     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
- 
- -- HISTORY:
- --     JET 01/25/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35003A IS
- 
-      TYPE ENUM IS (ZERO, ONE, TWO, THREE);
-      SUBTYPE SUBENUM IS ENUM RANGE ONE..TWO;
-      TYPE INT IS RANGE 1..10;
-      SUBTYPE SUBINT IS INTEGER RANGE -10..10;
-      TYPE A1 IS ARRAY (0..11) OF INTEGER;
-      TYPE A2 IS ARRAY (INTEGER RANGE -11..10) OF INTEGER;
- 
- BEGIN
-      TEST ("C35003A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR AN " &
-                       "INTEGER OR ENUMERATION SUBTYPE INDICATION " &
-                       "WHEN THE LOWER OR UPPER BOUND OF A NON-NULL " &
-                       "RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK");
-      BEGIN
-           DECLARE
-                SUBTYPE SUBSUBENUM IS SUBENUM RANGE ZERO..TWO;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (E1)");
-                DECLARE
-                     Z : SUBSUBENUM := ONE;
-                BEGIN
-                     IF NOT EQUAL(SUBSUBENUM'POS(Z),SUBSUBENUM'POS(Z))
-                     THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (E1)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (E1)");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (SUBENUM RANGE ONE..THREE) OF INTEGER;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (E2)");
-                DECLARE
-                     Z : A := (OTHERS => 0);
-                BEGIN
-                     IF NOT EQUAL(Z(ONE),Z(ONE)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (E2)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (E2)");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE I IS ACCESS INT RANGE INT(IDENT_INT(0))..10;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (I1)");
-                DECLARE
-                     Z : I := NEW INT'(1);
-                BEGIN
-                     IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (I1)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (I1)");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE I IS NEW INT RANGE 1..INT'SUCC(10);
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (I2)");
-                DECLARE
-                     Z : I := 1;
-                BEGIN
-                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (I2)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (I2)");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE R IS RECORD
-                     A : SUBINT RANGE IDENT_INT(-11)..0;
-                END RECORD;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (S1)");
-                DECLARE
-                     Z : R := (A => 1);
-                BEGIN
-                     IF NOT EQUAL(INTEGER(Z.A),INTEGER(Z.A)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (S1)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (S1)");
-      END;
- 
-      BEGIN
-           DECLARE
-                Z : SUBINT RANGE 0..IDENT_INT(11) := 0;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (S2)");
-                IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                     COMMENT ("DON'T OPTIMIZE Z");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (S2)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (S2)");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE I IS SUBINT RANGE A1'RANGE;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (R1)");
-                DECLARE
-                     Z : I := 1;
-                BEGIN
-                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (R1)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (R1)");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE I IS SUBINT RANGE A2'RANGE;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (R2)");
-                DECLARE
-                     Z : I := 1;
-                BEGIN
-                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (R2)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (R2)");
-      END;
- 
-      RESULT;
- 
- END C35003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35003b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35003b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35003b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,217 ****
- -- C35003B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A SUBTYPE INDICATION
- --     OF A DISCRETE GENERIC FORMAL TYPE WHEN THE LOWER OR UPPER BOUND
- --     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
- 
- -- HISTORY:
- --     JET 07/08/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35003B IS
- 
-      TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
-      TYPE INT IS RANGE -10..10;
- 
-      GENERIC
-           TYPE GEN_ENUM IS (<>);
-           TYPE GEN_INT IS RANGE <>;
-      PACKAGE GEN_PACK IS
-           SUBTYPE SUBENUM IS GEN_ENUM RANGE
-                GEN_ENUM'SUCC(GEN_ENUM'FIRST) ..
-                GEN_ENUM'PRED(GEN_ENUM'LAST);
-           SUBTYPE SUBINT IS GEN_INT RANGE
-                GEN_INT'SUCC(GEN_INT'FIRST) ..
-                GEN_INT'PRED(GEN_INT'LAST);
-           TYPE A1 IS ARRAY (0..GEN_INT'LAST) OF INTEGER;
-           TYPE A2 IS ARRAY (GEN_INT RANGE GEN_INT'FIRST..0) OF INTEGER;
-      END GEN_PACK;
- 
-      PACKAGE BODY GEN_PACK IS
-      BEGIN
-           TEST ("C35003B", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                            "FOR A SUBTYPE INDICATION OF A DISCRETE " &
-                            "GENERIC FORMAL TYPE WHEN THE LOWER OR " &
-                            "UPPER BOUND OF A NON-NULL RANGE LIES " &
-                            "OUTSIDE THE RANGE OF THE TYPE MARK");
-           BEGIN
-                DECLARE
-                     SUBTYPE SUBSUBENUM IS SUBENUM RANGE
-                          GEN_ENUM'FIRST..SUBENUM'LAST;
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED (E1)");
-                     DECLARE
-                          Z : SUBSUBENUM := SUBENUM'FIRST;
-                     BEGIN
-                          IF NOT EQUAL(SUBSUBENUM'POS(Z),
-                                       SUBSUBENUM'POS(Z)) THEN
-                               COMMENT ("DON'T OPTIMIZE Z");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG " &
-                                  "PLACE (E1)");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED (E1)");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE A IS ARRAY (SUBENUM RANGE SUBENUM'FIRST ..
-                          GEN_ENUM'LAST) OF INTEGER;
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED (E2)");
-                     DECLARE
-                          Z : A := (OTHERS => 0);
-                     BEGIN
-                          IF NOT EQUAL(Z(SUBENUM'FIRST),
-                                       Z(SUBENUM'FIRST)) THEN
-                               COMMENT ("DON'T OPTIMIZE Z");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
-                                  "(E2)");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED (E2)");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE I IS ACCESS SUBINT RANGE
-                          GEN_INT'FIRST..SUBINT'LAST;
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED (I1)");
-                     DECLARE
-                          Z : I := NEW SUBINT'(SUBINT'FIRST);
-                     BEGIN
-                          IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL))
-                          THEN
-                               COMMENT ("DON'T OPTIMIZE Z");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
-                                  "(I1)");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED (I1)");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE I IS NEW
-                          SUBINT RANGE SUBINT'FIRST..GEN_INT'LAST;
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED (I2)");
-                     DECLARE
-                          Z : I := I'FIRST;
-                     BEGIN
-                          IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                               COMMENT ("DON'T OPTIMIZE Z");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
-                                  "(I2)");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED (I2)");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE I IS SUBINT RANGE A1'RANGE;
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED (R1)");
-                     DECLARE
-                          Z : I := SUBINT'FIRST;
-                     BEGIN
-                          IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                               COMMENT ("DON'T OPTIMIZE Z");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
-                                  "(R1)");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED (R1)");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE I IS SUBINT RANGE A2'RANGE;
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED (R2)");
-                     DECLARE
-                          Z : I := 1;
-                     BEGIN
-                          IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                               COMMENT ("DON'T OPTIMIZE Z");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
-                                  "(R2)");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED (R2)");
-           END;
-      END GEN_PACK;
- 
-      PACKAGE ENUM_PACK IS NEW GEN_PACK(ENUM, INT);
- 
- BEGIN
-      RESULT;
- END C35003B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35003d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35003d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35003d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35003d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C35003D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A FLOATING-POINT
- --     SUBTYPE INDICATION WHEN THE LOWER OR UPPER BOUND OF A NON-NULL
- --     RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
- 
- -- HISTORY:
- --     JET 07/11/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35003D IS
- 
-      SUBTYPE FLT1 IS FLOAT RANGE -100.0 .. 100.0;
- 
- BEGIN
-      TEST ("C35003D", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
-                       "FLOATING-POINT SUBTYPE INDICATION WHEN THE " &
-                       "LOWER OR UPPER BOUND OF A NON-NULL RANGE LIES " &
-                       "OUTSIDE THE RANGE OF THE TYPE MARK");
-      BEGIN
-           DECLARE
-                SUBTYPE F IS FLT1 RANGE 0.0..101.0+FLT1(IDENT_INT(0));
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (F1)");
-                DECLARE
-                     Z : F := 1.0;
-                BEGIN
-                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (F1)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (F1)");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE F IS FLT1 RANGE -101.0..0.0;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED (F2)");
-                DECLARE
-                     Z : F := -1.0;
-                BEGIN
-                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
-                          COMMENT ("DON'T OPTIMIZE Z");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (F2)");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED (F2)");
-      END;
- 
-      RESULT;
- 
- END C35003D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35102a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35102a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35102a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,364 ****
- -- C35102A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ENUMERATION LITERAL BELONGING TO ONE ENUMERATION TYPE
- -- MAY BE DECLARED IN ANOTHER ENUMERATION TYPE DEFINITION IN THE SAME
- -- DECLARATIVE REGION.
- 
- -- R.WILLIAMS 8/20/86
- -- GMT 6/30/87           MOVED THE CALL TO  REPORT.TEST INTO A NEWLY
- --                       CREATED PACKAGE NAMED SHOW_TEST_HEADER.
- --                       ADDED CODE FOR MY_PACK AND MY_FTN.
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35102A IS
- 
-      TYPE E1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-      TYPE E2 IS ('A', 'C', RED, BLUE);
- 
-      PACKAGE  SHOW_TEST_HEADER  IS
-               -- PURPOSE OF THIS PACKAGE:
-               -- WE WANT THE TEST HEADER INFORMATION TO BE
-               -- PRINTED  BEFORE  ANY OF THE  PASS/FAIL  MESSAGES.
-      END SHOW_TEST_HEADER;
- 
-      PACKAGE  BODY  SHOW_TEST_HEADER  IS
-      BEGIN
-           TEST ( "C35102A",
-                  "CHECK THAT AN ENUMERATION LITERAL BELONGING "   &
-                  "TO ONE ENUMERATION TYPE MAY BE DECLARED IN "    &
-                  "ANOTHER ENUMERATION TYPE DEFINITION IN THE "    &
-                  "SAME DECLARATIVE REGION" );
-      END SHOW_TEST_HEADER;
- 
-      FUNCTION  MY_FTN (  E : E1  ) RETURN  E2  IS
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN MY_FTN - 1" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN MY_FTN - 1" );
-           END IF;
- 
-           RETURN E2'VAL (  IDENT_INT ( E1'POS(E) )  );
-      END MY_FTN;
- 
- 
-      PACKAGE MY_PACK IS
-      END MY_PACK;
- 
-      PACKAGE BODY MY_PACK IS
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
-      BEGIN  -- MY_PACK
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN MY_PACK - 1" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN MY_PACK - 1" );
-           END IF;
-      END MY_PACK;
- 
-      PACKAGE PKG IS
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
- 
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN PKG - 1" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN PKG - 1" );
-           END IF;
-      END PKG;
- 
-      PACKAGE PRIV IS
-           TYPE ENUM1 IS PRIVATE;
-           TYPE ENUM2 IS PRIVATE;
- 
-           FUNCTION FE1 (E : E1) RETURN ENUM1;
- 
-           FUNCTION FE2 (E : E2) RETURN ENUM2;
- 
-      PRIVATE
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
- 
-      END PRIV;
- 
-      PACKAGE BODY PRIV IS
-           FUNCTION FE1 (E : E1) RETURN ENUM1 IS
-           BEGIN
-                RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
-           END FE1;
- 
-           FUNCTION FE2 (E : E2) RETURN ENUM2 IS
-           BEGIN
-                RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
-           END FE2;
- 
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN PRIV - 1" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN PRIV - 1" );
-           END IF;
-      END PRIV;
- 
-      PACKAGE LPRIV IS
-           TYPE ENUM1 IS LIMITED PRIVATE;
-           TYPE ENUM2 IS LIMITED PRIVATE;
- 
-           FUNCTION FE1 (E : E1) RETURN ENUM1;
- 
-           FUNCTION FE2 (E : E2) RETURN ENUM2;
- 
-           FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN;
- 
-           FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN;
- 
-      PRIVATE
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
- 
-      END LPRIV;
- 
-      PACKAGE BODY LPRIV IS
-           FUNCTION FE1 (E : E1) RETURN ENUM1 IS
-           BEGIN
-                RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
-           END FE1;
- 
-           FUNCTION FE2 (E : E2) RETURN ENUM2 IS
-           BEGIN
-                RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
-           END FE2;
- 
-           FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN IS
-           BEGIN
-                IF A = B THEN
-                     RETURN TRUE;
-                ELSE
-                     RETURN FALSE;
-                END IF;
-           END EQUALS;
- 
-           FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN IS
-           BEGIN
-                IF A = B THEN
-                     RETURN TRUE;
-                ELSE
-                     RETURN FALSE;
-                END IF;
-           END EQUALS;
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN LPRIV - 1" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN LPRIV - 2" );
-           END IF;
-      END LPRIV;
- 
-      TASK T1;
- 
-      TASK BODY T1 IS
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
- 
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN T1" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN T1" );
-           END IF;
-      END T1;
- 
-      TASK T2 IS
-           ENTRY E;
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           ACCEPT E DO
-                DECLARE
-                     TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-                     TYPE ENUM2 IS ('A', 'C', RED, BLUE);
- 
-                BEGIN
-                     IF ENUM2'SUCC ('A') /= 'C' THEN
-                     FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                              "IN T2.E" );
-                     END IF;
- 
-                     IF ENUM1'POS (RED) /= 3 THEN
-                          FAILED ( "RED NOT DECLARED CORRECTLY IN " &
-                                   "ENUM1 IN T2.E" );
-                     END IF;
-                END;
-           END E;
-      END T2;
- 
-      GENERIC
-      PROCEDURE GP1;
- 
-      PROCEDURE GP1 IS
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
- 
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN GP1" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN GP1" );
-           END IF;
-      END GP1;
- 
-      GENERIC
-           TYPE E1 IS (<>);
-           TYPE E2 IS (<>);
-      PROCEDURE GP2;
- 
-      PROCEDURE GP2 IS
-      BEGIN
-           IF E2'SUCC (E2'VALUE ("'A'")) /= E2'VALUE ("'C'") THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN E2 " &
-                         "IN GP2" );
-           END IF;
- 
-           IF E1'POS (E1'VALUE ("RED")) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN E1 " &
-                         "IN GP2" );
-           END IF;
-      END GP2;
- 
-      PROCEDURE NEWGP1 IS NEW GP1;
-      PROCEDURE NEWGP2 IS NEW GP2 (E1, E2);
- 
- BEGIN
- 
-      DECLARE
-           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
-           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
- 
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN BLOCK" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN BLOCK" );
-           END IF;
-      END;
- 
-      DECLARE
-           USE PKG;
-      BEGIN
-           IF ENUM2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN PKG - 2" );
-           END IF;
- 
-           IF ENUM1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN PKG - 2" );
-           END IF;
-      END;
- 
-      DECLARE
-           USE PRIV;
-      BEGIN
-           IF FE2 (E2'SUCC('A')) /= FE2 ('C') THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN PRIV - 2" );
-           END IF;
- 
-           IF FE1 (RED) /= FE1 (E1'VAL (3)) THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN PRIV - 2" );
-           END IF;
-      END;
- 
-      DECLARE
-           USE LPRIV;
-      BEGIN
-           IF NOT EQUALS (FE2 (E2'SUCC('A')), FE2 ('C')) THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
-                         "IN LPRIV - 2" );
-           END IF;
- 
-           IF NOT EQUALS (FE1 (RED), FE1 (E1'VAL (3))) THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
-                         "IN LPRIV - 2" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF E2'SUCC ('A') /= 'C' THEN
-                FAILED ( "'A' NOT DECLARED CORRECTLY IN E2" );
-           END IF;
- 
-           IF E1'POS (RED) /= 3 THEN
-                FAILED ( "RED NOT DECLARED CORRECTLY IN E1" );
-           END IF;
-      END;
- 
-      NEWGP1;
-      NEWGP2;
-      T2.E;
- 
-      RESULT;
- END C35102A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c352001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c352001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c352001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c352001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,270 ****
- --
- -- C352001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the predefined Character type comprises 256 positions.  
- --      Check that the names of the non-graphic characters are usable with 
- --      the attributes (Wide_)Image and (Wide_)Value, and that these
- --      attributes produce the correct result.
- --                 
- -- TEST DESCRIPTION:
- --      Build two tables of nongraphic characters from positions of Row 00 
- --      (0000-001F and 007F-009F) of the ISO 10646 Basic Multilingual Plane.
- --      Fill the first table with compiler created strings. Fill the second 
- --      table with strings defined by the language.  Compare the two tables.  
- --      Check 256 positions of the predefined character type.  Use attributes 
- --      (Wide_)Image and (Wide_)Value to check the values of the non-graphic 
- --      characters and the last 2 characters.
- --
- --
- -- CHANGE HISTORY:
- --      20 Jun 95   SAIC    Initial prerelease version.
- --      27 Jan 96   SAIC    Revised for 2.1.  Hid values, added "del" case.
- --
- --!
- 
- with Ada.Characters.Handling;
- with Report;
- procedure C352001 is
- 
-    Lower_Bound  : Integer  :=  0;
-    Middle_Bound : Integer  := 31;
-    Upper_Bound  : Integer  := 159;
-    Half_Bound   : Integer  := 127;
-    Max_Bound    : Integer  := 255;
- 
-    type Dyn_String is access String;
-    type Value_Result is array (Character) of Dyn_String;
- 
-    Table_Of_Character : Value_Result;
-    TC_Table           : Value_Result;
- 
-    function CVII(K : Natural) return Character is
-    begin
-      return Character'Val( Report.Ident_Int(K) );
-    end CVII;
- 
-    function "=" (L, R : String) return Boolean is
-       UCL : String (L'First .. L'Last);
-       UCR : String (R'First .. R'last);
-    begin
-       UCL := Ada.Characters.Handling.To_Upper (L);
-       UCR := Ada.Characters.Handling.To_Upper (R);
-       if UCL'Last /= UCR'Last then 
-          return False;
-       else
-          for I in UCL'First .. UCR'Last loop
-             if UCL (I) /= UCR (I) then 
-                return False;
-             end if;
-          end loop;
-          return True;
-        end if;
-    end "=";
- 
- begin
- 
-    Report.Test ("C352001", "Check that, the predefined Character type "     &
-                 "comprises 256 positions.  Check that the names of the "    &
-                 "non-graphic characters are usable with the attributes "    &
-                 "(Wide_)Image and (Wide_)Value, and that these attributes " &
-                 "produce the correct result");
- 
-    -- Fill table with strings (positions of Row 00 (0000-001F) of the ISO 
-    -- 10646 Basic Multilingual Plane created by the compiler.
- 
-    for I in CVII(Lower_Bound) .. CVII(Middle_Bound) loop
-       Table_Of_Character (I) := new String'(Character'Image(I));
-    end loop;
- 
-    -- Fill table with strings (positions of Row 00 (007F-009F) of the ISO 
-    -- 10646 Basic Multilingual Plane created by the compiler.
- 
-    for I in CVII(Half_Bound) .. CVII(Upper_Bound) loop
-       Table_Of_Character (I) := new String'(Character'Image(I));
-    end loop;
- 
-    -- Fill table with strings (positions of Row 00 (0000-001F) of the ISO 
-    -- 10646 Basic Multilingual Plane defined by the language.
- 
-    TC_Table (CVII(0))   := new String'("nul");
-    TC_Table (CVII(1))   := new String'("soh");
-    TC_Table (CVII(2))   := new String'("stx");
-    TC_Table (CVII(3))   := new String'("etx");
-    TC_Table (CVII(4))   := new String'("eot");
-    TC_Table (CVII(5))   := new String'("enq");
-    TC_Table (CVII(6))   := new String'("ack");
-    TC_Table (CVII(7))   := new String'("bel"); 
-    TC_Table (CVII(8))   := new String'("bs");
-    TC_Table (CVII(9))   := new String'("ht");
-    TC_Table (CVII(10))  := new String'("lf");
-    TC_Table (CVII(11))  := new String'("vt");
-    TC_Table (CVII(12))  := new String'("ff");
-    TC_Table (CVII(13))  := new String'("cr");
-    TC_Table (CVII(14))  := new String'("so");
-    TC_Table (CVII(15))  := new String'("si");
-    TC_Table (CVII(16))  := new String'("dle");
-    TC_Table (CVII(17))  := new String'("dc1");
-    TC_Table (CVII(18))  := new String'("dc2");
-    TC_Table (CVII(19))  := new String'("dc3");
-    TC_Table (CVII(20))  := new String'("dc4");
-    TC_Table (CVII(21))  := new String'("nak");
-    TC_Table (CVII(22))  := new String'("syn");
-    TC_Table (CVII(23))  := new String'("etb");
-    TC_Table (CVII(24))  := new String'("can");
-    TC_Table (CVII(25))  := new String'("em");
-    TC_Table (CVII(26))  := new String'("sub");
-    TC_Table (CVII(27))  := new String'("esc");
-    TC_Table (CVII(28))  := new String'("fs");
-    TC_Table (CVII(29))  := new String'("gs");
-    TC_Table (CVII(30))  := new String'("rs");
-    TC_Table (CVII(31))  := new String'("us");
-    TC_Table (CVII(127)) := new String'("del");
- 
-    -- Fill table with strings (positions of Row 00 (007F-009F) of the ISO 
-    -- 10646 Basic Multilingual Plane defined by the language.
- 
-    TC_Table (CVII(128)) := new String'("reserved_128");
-    TC_Table (CVII(129)) := new String'("reserved_129");
-    TC_Table (CVII(130)) := new String'("bph");
-    TC_Table (CVII(131)) := new String'("nbh");
-    TC_Table (CVII(132)) := new String'("reserved_132");
-    TC_Table (CVII(133)) := new String'("nel");
-    TC_Table (CVII(134)) := new String'("ssa");
-    TC_Table (CVII(135)) := new String'("esa");
-    TC_Table (CVII(136)) := new String'("hts");
-    TC_Table (CVII(137)) := new String'("htj");
-    TC_Table (CVII(138)) := new String'("vts");
-    TC_Table (CVII(139)) := new String'("pld");
-    TC_Table (CVII(140)) := new String'("plu");
-    TC_Table (CVII(141)) := new String'("ri");
-    TC_Table (CVII(142)) := new String'("ss2");
-    TC_Table (CVII(143)) := new String'("ss3");
-    TC_Table (CVII(144)) := new String'("dcs");
-    TC_Table (CVII(145)) := new String'("pu1");
-    TC_Table (CVII(146)) := new String'("pu2");
-    TC_Table (CVII(147)) := new String'("sts");
-    TC_Table (CVII(148)) := new String'("cch");
-    TC_Table (CVII(149)) := new String'("mw");
-    TC_Table (CVII(150)) := new String'("spa");
-    TC_Table (CVII(151)) := new String'("epa");
-    TC_Table (CVII(152)) := new String'("sos");
-    TC_Table (CVII(153)) := new String'("reserved_153");
-    TC_Table (CVII(154)) := new String'("sci");
-    TC_Table (CVII(155)) := new String'("csi");
-    TC_Table (CVII(156)) := new String'("st");
-    TC_Table (CVII(157)) := new String'("osc");
-    TC_Table (CVII(158)) := new String'("pm");
-    TC_Table (CVII(159)) := new String'("apc");
- 
- 
-    -- Compare the first half of two tables.
-    for I in CVII(Lower_Bound) .. CVII(Middle_Bound) loop
-      if TC_Table(I).all /= Table_Of_Character(I).all then
-        Report.Failed("Value of character#" & Integer'Image(Character'Pos(I)) &
-                      " is not the same in the first half of the table");
-      end if;
-    end loop;
- 
- 
-    -- Compare the second half of two tables.
-    for I in CVII(Half_Bound) .. CVII(Upper_Bound) loop
-      if TC_Table(I).all /= Table_Of_Character(I).all then
-        Report.Failed("Value of character#" & Integer'Image(Character'Pos(I)) &
-                      " is not the same in the second half of the table");
-      end if;
-    end loop;
- 
- 
-    -- Check the first character.
-    if Character'Image( Character'First ) /= "NUL" then
-       Report.Failed("Value of character#"                           &
-                      Integer'Image(Character'Pos (Character'First)) &
-                     " is not NUL");
-    end if;
- 
- 
-    -- Check that the names of the non-graphic characters are usable with
-    -- Image and Value attributes.
-    if Character'Value( Character'Image( CVII(153) )) /= 
-      CVII( 153 ) then
-         Report.Failed ("Value of character#"                       &
-                         Integer'Image( Character'Pos(CVII(153)) )  &
-                        " is not reserved_153");
-    end if;
- 
- 
-    for I in CVII(Lower_Bound) .. CVII(Max_Bound) loop
-      if Character'Value( 
-           Report.Ident_Str(
-             Character'Image(CVII(Character'Pos(I)))))
-         /= CVII( Character'Pos(I)) then
-           Report.Failed ("Value of character#"                             &
-                           Integer'Image( Character'Pos(I) )                &
-                          " is not the same as the predefined character type");
-      end if;
-    end loop;
- 
- 
-    -- Check Wide_Character attributes.
-    for I in Wide_Character'Val(Lower_Bound) .. Wide_Character'Val(Max_Bound) 
-    loop
-      if Wide_Character'Wide_Value(
-           Report.Ident_Wide_Str(
-             Wide_Character'Wide_Image(
-               Wide_Character'Val(Wide_Character'Pos(I)))))
-         /= Wide_Character'Val(Wide_Character'Pos(I)) 
-      then
-         Report.Failed ("Value of the predefined Wide_Character type " &
-                        "is not correct");
-      end if;
-    end loop;
- 
- 
-    if Wide_Character'Value( Wide_Character'Image(Wide_Character'Val(132)) ) 
-      /= Wide_Character'Val( Report.Ident_Int(132) ) then
-         Report.Failed ("Wide_Character at 132 is not reserved_132");
-    end if;
- 
- 
-    if Wide_Character'Image( Wide_Character'First ) /= "NUL" then
-       Report.Failed ("Wide_Character'First is not NUL");
-    end if;
- 
- 
-    if Wide_Character'Image 
-      (Wide_Character'Pred (Wide_Character'Last) ) /= "FFFE" then
-       Report.Failed ("Wide_Character at 65534 is not FFFE");
-    end if;
-   
-     
-    if Wide_Character'Image(Wide_Character'Last) /= "FFFF" then
-       Report.Failed ("Wide_Character'Last is not FFFF");
-    end if;
- 
-    Report.Result;
- 
- end C352001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c354002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c354002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c354002.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c354002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,335 ****
- --
- -- C354002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the attributes of modular types yield
- --      correct values/results.  The attributes checked are:
- --
- --      First, Last, Range, Base, Min, Max, Succ, Pred, 
- --      Image, Width, Value, Pos, and Val
- --
- -- TEST DESCRIPTION:
- --      This test defines several modular types.  One type defined at
- --      each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus,
- --      a power of two half that of System.Max_Binary_Modulus, one less
- --      than that power of two; one more than that power of two, two
- --      less than a (large) power of two.  For each of these types,
- --      determine the correct operation of the following attributes:
- --
- --      First, Last, Range, Base, Min, Max, Succ, Pred, Image, Width,
- --      Value, Pos, Val, and Modulus
- --
- --      The attributes Wide_Image and Wide_Value are deferred to C354003.
- --
- --
- --
- -- CHANGE HISTORY:
- --      08 SEP 94   SAIC    Initial version
- --      17 NOV 94   SAIC    Revised version
- --      13 DEC 94   SAIC    split off Wide_String attributes into C354003
- --      06 JAN 95   SAIC    Promoted to next release
- --      19 APR 95   SAIC    Revised in accord with reviewer comments
- --      27 JAN 96   SAIC    Eliminated 32/64 bit potential conflict for 2.1
- --
- --!
- 
- with Report;
- with System;
- with TCTouch;
- procedure C354002 is
- 
-   function ID(Local_Value: Integer) return Integer renames Report.Ident_Int;
-   function ID(Local_Value: String)  return String renames  Report.Ident_Str;
- 
-   Power_2_Bits          : constant := System.Storage_Unit;
-   Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2;
- 
-   type Max_Binary      is mod System.Max_Binary_Modulus;
-   type Max_NonBinary   is mod System.Max_Nonbinary_Modulus;
-   type Half_Max_Binary is mod Half_Max_Binary_Value;
- 
-   type Medium          is mod 2048;
-   type Medium_Plus     is mod 2042;
-   type Medium_Minus    is mod 2111;
- 
-   type Small  is mod 2;
-   type Finger is mod 5;
- 
-   MBL  : constant := Max_NonBinary'Last;
-   MNBM : constant := Max_NonBinary'Modulus;
- 
-   Ones_Complement_Permission : constant Boolean := MBL = MNBM;
- 
-   type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie);
- 
-   subtype Midrange is Medium_Minus range 222 .. 1111;
- 
- -- a few numbers for testing purposes
-   Max_Binary_Mod_Over_3      : constant := Max_Binary'Modulus / 3;
-   Max_NonBinary_Mod_Over_4   : constant := Max_NonBinary'Modulus / 4;
-   System_Max_Bin_Mod_Pred    : constant := System.Max_Binary_Modulus - 1;
-   System_Max_NonBin_Mod_Pred : constant := System.Max_Nonbinary_Modulus - 1;
-   Half_Max_Bin_Value_Pred    : constant := Half_Max_Binary_Value - 1;
- 
-   AMB,   BMB   : Max_Binary;
-   AHMB,  BHMB  : Half_Max_Binary;
-   AM,    BM    : Medium;
-   AMP,   BMP   : Medium_Plus;
-   AMM,   BMM   : Medium_Minus;
-   AS,    BS    : Small;
-   AF,    BF    : Finger;
- 
-   TC_Pass_Case : Boolean := True;
- 
-   procedure Value_Fault( S: String ) is
-   -- check 'Value for failure modes
-   begin
-     -- the evaluation of the 'Value expression should raise C_E
-     TCTouch.Assert_Not( Midrange'Value(S) = 0, "Value_Fault" );
-     if Midrange'Value(S) not in Midrange'Base then
-       Report.Failed("'Value(" & S & ") raised no exception");
-     end if;
-   exception
-     when Constraint_Error => null; -- expected case
-     when others =>
-          Report.Failed("'Value(" & S & ") raised wrong exception");
-   end Value_Fault;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C354002", "Check attributes of modular types" );
- 
- -- Base
-   TCTouch.Assert( Midrange'Base'First = 0, "Midrange'Base'First" );
-   TCTouch.Assert( Midrange'Base'Last  = Medium_Minus'Last,
-                   "Midrange'Base'Last" );
- 
- -- First
-   TCTouch.Assert( Max_Binary'First = 0,         "Max_Binary'First" );
-   TCTouch.Assert( Max_NonBinary'First = 0,      "Max_NonBinary'First" );
-   TCTouch.Assert( Half_Max_Binary'First = 0,    "Half_Max_Binary'First" );
- 
-   TCTouch.Assert( Medium'First = Medium(ID(0)), "Medium'First" );
-   TCTouch.Assert( Medium_Plus'First = Medium_Plus(ID(0)),
-                                                 "Medium_Plus'First" );
-   TCTouch.Assert( Medium_Minus'First = Medium_Minus(ID(0)),
-                                                 "Medium_Minus'First" );
- 
-   TCTouch.Assert( Small'First = Small(ID(0)),   "Small'First" );
-   TCTouch.Assert( Finger'First = Finger(ID(0)), "Finger'First" );
-   TCTouch.Assert( Midrange'First = Midrange(ID(222)),
-                                                 "Midrange'First" );
- 
- -- Image
-   TCTouch.Assert( Half_Max_Binary'Image(255) = " 255",
-                  "Half_Max_Binary'Image" );
-   TCTouch.Assert( Medium'Image(0) = ID(" 0"),  "Medium'Image" );
-   TCTouch.Assert( Medium_Plus'Image(Medium_Plus'Last) = " 2041",
-                  "Medium_Plus'Image" );
-   TCTouch.Assert( Medium_Minus'Image(Medium_Minus(ID(1024))) = " 1024",
-                  "Medium_Minus'Image" );
-   TCTouch.Assert( Small'Image(Small(ID(1))) = " 1", "Small'Image" );
-   TCTouch.Assert( Midrange'Image(Midrange(ID(333))) = " 333",
-                   "Midrange'Image" );
- 
- -- Last
-   TCTouch.Assert( Max_Binary'Last      = System_Max_Bin_Mod_Pred,
-                  "Max_Binary'Last");
-   if Ones_Complement_Permission then
-     TCTouch.Assert( Max_NonBinary'Last >= System_Max_NonBin_Mod_Pred,
-                    "Max_NonBinary'Last (ones comp)");
-   else
-     TCTouch.Assert( Max_NonBinary'Last   = System_Max_NonBin_Mod_Pred,
-                    "Max_NonBinary'Last");
-   end if;
-   TCTouch.Assert( Half_Max_Binary'Last = Half_Max_Bin_Value_Pred,
-                  "Half_Max_Binary'Last");
- 
-   TCTouch.Assert( Medium'Last          = Medium(ID(2047)), "Medium'Last");
-   TCTouch.Assert( Medium_Plus'Last     = Medium_Plus(ID(2041)),
-                   "Medium_Plus'Last");
-   TCTouch.Assert( Medium_Minus'Last    = Medium_Minus(ID(2110)),
-                   "Medium_Minus'Last");
-   TCTouch.Assert( Small'Last    = Small(ID(1)), "Small'Last");
-   TCTouch.Assert( Finger'Last   = Finger(ID(4)), "Finger'Last");
-   TCTouch.Assert( Midrange'Last = Midrange(ID(1111)), "Midrange'Last");
- 
- -- Max
-   TCTouch.Assert( Max_Binary'Max(Power_2_Bits, Max_Binary'Last)
-                   = Max_Binary'Last,                     "Max_Binary'Max");
-   TCTouch.Assert( Max_NonBinary'Max(100,2000) = 2000, "Max_NonBinary'Max");
-   TCTouch.Assert( Half_Max_Binary'Max(123,456) = 456,
-                                                     "Half_Max_Binary'Max");
- 
-   TCTouch.Assert( Medium'Max(0,2040) = 2040,                 "Medium'Max");
-   TCTouch.Assert( Medium_Plus'Max(0,1) = 1,             "Medium_Plus'Max");
-   TCTouch.Assert( Medium_Minus'Max(2001,1995) = 2001,  "Medium_Minus'Max");
-   TCTouch.Assert( Small'Max(1,0) = 1,                         "Small'Max");
-   TCTouch.Assert( Finger'Max(Finger'Last+1,4) = 4,           "Finger'Max");
-   TCTouch.Assert( Midrange'Max(Midrange'First+1,222) = Midrange'First+1,
-                                                           "Midrange'Max");
- 
- -- Min
-   TCTouch.Assert( Max_Binary'Min(Power_2_Bits, Max_Binary'Last)
-                   = Power_2_Bits,                        "Max_Binary'Min");
-   TCTouch.Assert( Max_NonBinary'Min(100,2000) = 100,  "Max_NonBinary'Min");
-   TCTouch.Assert( Half_Max_Binary'Min(123,456) = 123,
-                                                     "Half_Max_Binary'Min");
- 
-   TCTouch.Assert( Medium'Min(0,Medium(ID(2040))) = 0,        "Medium'Min");
-   TCTouch.Assert( Medium_Plus'Min(0,1) = 0,             "Medium_Plus'Min");
-   TCTouch.Assert( Medium_Minus'Min(2001,1995) = 1995,  "Medium_Minus'Min");
-   TCTouch.Assert( Small'Min(1,0) = 0,                         "Small'Min");
-   TCTouch.Assert( Finger'Min(Finger'Last+1,4) /= 4,          "Finger'Min");
-   TCTouch.Assert( Midrange'Min(Midrange'First+1,222) = 222,
-                                                           "Midrange'Min");
- -- Modulus
-   TCTouch.Assert( Max_Binary'Modulus = System.Max_Binary_Modulus,
-                  "Max_Binary'Modulus");
-   TCTouch.Assert( Max_NonBinary'Modulus = System.Max_Nonbinary_Modulus,
-                  "Max_NonBinary'Modulus");
-   TCTouch.Assert( Half_Max_Binary'Modulus = Half_Max_Binary_Value,
-                  "Half_Max_Binary'Modulus");
- 
-   TCTouch.Assert( Medium'Modulus       = 2048, "Medium'Modulus");
-   TCTouch.Assert( Medium_Plus'Modulus  = 2042, "Medium_Plus'Modulus");
-   TCTouch.Assert( Medium_Minus'Modulus = 2111, "Medium_Minus'Modulus");
-   TCTouch.Assert( Small'Modulus        =    2, "Small'Modulus");
-   TCTouch.Assert( Finger'Modulus       =    5, "Finger'Modulus");
-   TCTouch.Assert( Midrange'Modulus = ID(2111), "Midrange'Modulus");
- 
- -- Pos
-   declare
-     Int : Natural := 222;
-   begin
-     for I in Midrange loop
-       TC_Pass_Case := TC_Pass_Case and Midrange'Pos(I) = Int;
-                     
-       Int := Int +1;
-     end loop;
-   end;
- 
-   TCTouch.Assert( TC_Pass_Case, "Midrange'Pos");
- 
- -- Pred
-   TCTouch.Assert( Max_Binary'Pred(0)      = System_Max_Bin_Mod_Pred,
-                  "Max_Binary'Pred(0)");
-   if Ones_Complement_Permission then
-     TCTouch.Assert( Max_NonBinary'Pred(0) >= System_Max_NonBin_Mod_Pred,
-                    "Max_NonBinary'Pred(0) (ones comp)");
-   else
-     TCTouch.Assert( Max_NonBinary'Pred(0)   = System_Max_NonBin_Mod_Pred,
-                    "Max_NonBinary'Pred(0)");
-   end if;
-   TCTouch.Assert( Half_Max_Binary'Pred(0) = Half_Max_Bin_Value_Pred,
-                  "Half_Max_Binary'Pred(0)");
- 
-   TCTouch.Assert( Medium'Pred(Medium(ID(0))) = 2047, "Medium'Pred(0)");
-   TCTouch.Assert( Medium_Plus'Pred(0)     = 2041, "Medium_Plus'Pred(0)");
-   TCTouch.Assert( Medium_Minus'Pred(0)    = 2110, "Medium_Minus'Pred(0)");
-   TCTouch.Assert( Small'Pred(0)  = 1, "Small'Pred(0)");
-   TCTouch.Assert( Finger'Pred(Finger(ID(0))) = 4, "Finger'Pred(0)");
-   TCTouch.Assert( Midrange'Pred(222) = 221, "Midrange'Pred('First)");
- 
- -- Range
-   for I in Midrange'Range loop
-     if I not in Midrange then
-       Report.Failed("Midrange loop test");
-     end if;
-   end loop;
-   for I in Medium'Range loop
-     if I not in Medium then
-       Report.Failed("Medium loop test");
-     end if;
-   end loop;
-   for I in Medium_Minus'Range loop
-     if I not in 0..2110 then
-       Report.Failed("Medium loop test");
-     end if;
-   end loop;
- 
- -- Succ
-   TCTouch.Assert( Max_Binary'Succ(System_Max_Bin_Mod_Pred)         = 0,
-                  "Max_Binary'Succ('Last)");
-   if Ones_Complement_Permission then
-     TCTouch.Assert( (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred) = 0)
-                 or (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred)
-                     = Max_NonBinary'Last),
-                    "Max_NonBinary'Succ('Last) (ones comp)");
-   else
-     TCTouch.Assert( Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred)   = 0,
-                    "Max_NonBinary'Succ('Last)");
-   end if;
-  TCTouch.Assert( Half_Max_Binary'Succ(Half_Max_Bin_Value_Pred)    = 0,
-                  "Half_Max_Binary'Succ('Last)");
- 
-   TCTouch.Assert( Medium'Succ(2047)       = 0, "Medium'Succ('Last)");
-   TCTouch.Assert( Medium_Plus'Succ(2041)  = 0, "Medium_Plus'Succ('Last)");
-   TCTouch.Assert( Medium_Minus'Succ(2110) = 0, "Medium_Minus'Succ('Last)");
-   TCTouch.Assert( Small'Succ(1)           = 0, "Small'Succ('Last)");
-   TCTouch.Assert( Finger'Succ(4)          = 0, "Finger'Succ('Last)");
-   TCTouch.Assert( Midrange'Succ(Midrange(ID(1111))) = 1112,
-                   "Midrange'Succ('Last)");
- 
- -- Val
-   for I in Natural range ID(222)..ID(1111) loop
-     TCTouch.Assert( Midrange'Val(I) = Medium_Minus(I), "Midrange'Val");
-   end loop;
- 
- -- Value
- 
-   TCTouch.Assert( Half_Max_Binary'Value("255") = 255,
-                  "Half_Max_Binary'Value" );
- 
-   TCTouch.Assert( Medium'Value(" 1e2") = 100,   "Medium'Value(""1e2"")" );
-   TCTouch.Assert( Medium'Value(" 0 ")  =   0,   "Medium'Value" );
-   TCTouch.Assert( Medium_Plus'Value(ID("2041")) = 2041,
-                  "Medium_Plus'Value" );
-   TCTouch.Assert( Medium_Minus'Value(ID("+10_24")) = 1024,
-                  "Medium_Minus'Value" );
- 
-   TCTouch.Assert( Small'Value("+1") = 1,            "Small'Value" );
-   TCTouch.Assert( Midrange'Value(ID("333")) = 333,  "Midrange'Value" );
-   TCTouch.Assert( Midrange'Value("1E3") = 1000,
-                  "Midrange'Value(""1E3"")" );
- 
-   Value_Fault( "bad input" );
-   Value_Fault( "-333" );
-   Value_Fault( "9999" );
-   Value_Fault( ".1" );
-   Value_Fault( "1e-1" );
- 
- -- Width
-   TCTouch.Assert( Medium'Width       = 5, "Medium'Width");
-   TCTouch.Assert( Medium_Plus'Width  = 5, "Medium_Plus'Width");
-   TCTouch.Assert( Medium_Minus'Width = 5, "Medium_Minus'Width");
-   TCTouch.Assert( Small'Width        = 2, "Small'Width");
-   TCTouch.Assert( Finger'Width       = 2, "Finger'Width");
-   TCTouch.Assert( Midrange'Width     = 5, "Midrange'Width");
- 
-   Report.Result;
- 
- end C354002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c354003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c354003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c354003.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c354003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,211 ****
- -- C354003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the Wide_String attributes of modular types yield
- --      correct values/results.  The attributes checked are:
- --
- --      Wide_Image
- --      Wide_Value
- --
- -- TEST DESCRIPTION:
- --      This test is split from C354002.  It tests only the attributes:
- --
- --      Wide_Image, Wide_Value
- --
- --      This test defines several modular types.  One type defined at
- --      each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus,
- --      a power of two half that of System.Max_Binary_Modulus, one less
- --      than that power of two; one more than that power of two, two
- --      less than a (large) power of two.  For each of these types,
- --      determine the correct operation of the Wide_String attributes.
- --
- --
- -- CHANGE HISTORY:
- --      13 DEC 94   SAIC    Initial version
- --      06 JAN 94   SAIC    Promoted to future release
- --      19 APR 95   SAIC    Revised in accord with reviewer comments
- --      01 DEC 95   SAIC    Corrected for 2.0.1
- --      27 JAN 96   SAIC    Eliminated potential 32/64 bit conflict for 2.1
- --      24 FEB 97   PWB.CTA Corrected out-of-range value
- --!
- 
- with Report;
- with System;
- with TCTouch;
- with Ada.Characters.Handling;
- procedure C354003 is
- 
-   function ID(Local_Value: Integer) return Integer renames Report.Ident_Int;
-   function ID(Local_Value: String)  return String renames  Report.Ident_Str;
- 
-   function ID(Local_Value: String) return Wide_String is
-   begin
-     return Ada.Characters.Handling.To_Wide_String( ID( Local_Value ) );
-   end ID;
- 
-   Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2;
- 
-   type Max_Binary      is mod System.Max_Binary_Modulus;
-   type Max_NonBinary   is mod System.Max_Nonbinary_Modulus;
-   type Half_Max_Binary is mod Half_Max_Binary_Value;
- 
-   type Medium          is mod 2048;
-   type Medium_Plus     is mod 2042;
-   type Medium_Minus    is mod 2111;
- 
-   type Small  is mod 2;
-   type Finger is mod 5;
- 
-   type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie);
- 
-   subtype Midrange is Medium_Minus range 222 .. 1111;
- 
-   AMB,   BMB   : Max_Binary;
-   AHMB,  BHMB  : Half_Max_Binary;
-   AM,    BM    : Medium;
-   AMP,   BMP   : Medium_Plus;
-   AMM,   BMM   : Medium_Minus;
-   AS,    BS    : Small;
-   AF,    BF    : Finger;
- 
-   procedure Wide_Value_Fault( S: Wide_String ) is
-   -- check 'Wide_Value for failure modes
-   begin
-     -- the evaluation of the 'Wide_Value expression should raise C_E
-     TCTouch.Assert_Not( Midrange'Wide_Value(S) = 0, "Wide_Value_Fault" );
-     if Midrange'Wide_Value(S) not in Midrange'Base then
-       Report.Failed("'Wide_Value  raised no exception");
-     end if;
-   exception
-     when Constraint_Error => null; -- expected case
-     when others =>
-          Report.Failed("'Wide_Value raised wrong exception");
-   end Wide_Value_Fault;
- 
- 
-   The_Cap, The_Toe : Natural;
- 
-   procedure Check_Non_Static_Cases( Lower_Bound,Upper_Bound : Medium ) is
-     subtype Non_Static is Medium range Lower_Bound..Upper_Bound;
-   begin
-   -- First, Last, Range, Min, Max, Succ, Pred, Pos, and Val
- 
-     TCTouch.Assert( Non_Static'First = Medium(The_Toe), "Non_Static'First" );
-     TCTouch.Assert( Non_Static'Last = Non_Static(The_Cap),
-                     "Non_Static'Last" );
-     TCTouch.Assert( Non_Static(The_Cap/2) in Non_Static'Range,
-                     "Non_Static'Range" );
-     TCTouch.Assert( Non_Static'Min(Medium(Report.Ident_Int(100)),
-                                    Medium(Report.Ident_Int(200))) = 100,
-                     "Non_Static'Min" );
-     TCTouch.Assert( Non_Static'Max(Medium(Report.Ident_Int(100)),
-                                    Medium(Report.Ident_Int(200))) = 200,
-                     "Non_Static'Max" );
-     TCTouch.Assert( Non_Static'Succ(Non_Static(The_Cap))
-                     = Medium'Succ(Upper_Bound),
-                     "Non_Static'Succ" );
-     TCTouch.Assert( Non_Static'Pred(Medium(Report.Ident_Int(The_Cap)))
-                     = Non_Static(Report.Ident_Int(The_Cap-1)),
-                     "Non_Static'Pred" );
-     TCTouch.Assert( Non_Static'Pos(Upper_Bound) = Non_Static(The_Cap),
-                     "Non_Static'Pos" );
-     TCTouch.Assert( Non_Static'Val(Non_Static(The_Cap)) = Upper_Bound,
-                     "Non_Static'Val" );
- 
-   end Check_Non_Static_Cases;
- 
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C354003", "Check Wide_String attributes of modular types" );
- 
-   Wide_Strings_Needed: declare
- 
-     Max_Bin_Mod_Div_3 : constant := Max_Binary'Modulus/3;
-     Max_Non_Mod_Div_4 : constant := Max_NonBinary'Modulus/4;
- 
-   begin
- 
- -- Wide_Image
- 
-     TCTouch.Assert( Half_Max_Binary'Wide_Image(255) = " 255",
-                    "Half_Max_Binary'Wide_Image" );
- 
-     TCTouch.Assert( Medium'Wide_Image(0) = " 0",  "Medium'Wide_Image" );
- 
-     TCTouch.Assert( Medium_Plus'Wide_Image(Medium_Plus'Last) = " 2041",
-                    "Medium_Plus'Wide_Image" );
- 
-     TCTouch.Assert( Medium_Minus'Wide_Image(Medium_Minus(ID(1024))) = " 1024",
-                    "Medium_Minus'Wide_Image" );
- 
-     TCTouch.Assert( Small'Wide_Image(1) = " 1",   "Small'Wide_Image" );
- 
-     TCTouch.Assert( Midrange'Wide_Image(Midrange(ID(333))) = " 333",
-                    "Midrange'Wide_Image" );
- 
- -- Wide_Value
- 
-     TCTouch.Assert( Half_Max_Binary'Wide_Value("255") = 255,
-                    "Half_Max_Binary'Wide_Value" );
- 
-     TCTouch.Assert( Medium'Wide_Value(" 0 ")  = 0,   "Medium'Wide_Value" );
- 
-     TCTouch.Assert( Medium_Plus'Wide_Value(ID("2041")) = Medium_Plus'Last,
-                    "Medium_Plus'Wide_Value" );
- 
-     TCTouch.Assert( Medium_Minus'Wide_Value("+1_4 ") = 14,
-                    "Medium_Minus'Wide_Value" );
- 
-     TCTouch.Assert( Small'Wide_Value("+1") = 1,      "Small'Wide_Value" );
- 
-     TCTouch.Assert( Midrange'Wide_Value(ID("333")) = 333,
-                    "Midrange'Wide_Value" );
- 
-     TCTouch.Assert( Midrange'Wide_Value(ID("1E3")) = 1000,
-                    "Midrange'Wide_Value(""1E3"")" );
- 
-     Wide_Value_Fault( "bad input" );
-     Wide_Value_Fault( "-333" );
-     Wide_Value_Fault( "9999" );
-     Wide_Value_Fault( ".1" );
-     Wide_Value_Fault( "1e-1" );
- 
-   end Wide_Strings_Needed;
- 
-   The_Toe := Report.Ident_Int(25);
-   The_Cap := Report.Ident_Int(256);
-   Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
-                           Medium(Report.Ident_Int(The_Cap)) );
- 
-   The_Toe := Report.Ident_Int(40);
-   The_Cap := Report.Ident_Int(2047);
-   Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
-                           Medium(Report.Ident_Int(The_Cap)) );
- 
-   Report.Result;
- 
- end C354003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C35502A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
- -- WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR 
- -- A CHARACTER TYPE.   
- 
- -- RJW 5/05/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35502A  IS
- 
- BEGIN
- 
-      TEST( "C35502A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
-                        "THE CORRECT RESULTS WHEN THE PREFIX " &
-                        "IS AN ENUMERATION TYPE OTHER THAN " &
-                        "A BOOLEAN OR A CHARACTER TYPE" );
- 
-      DECLARE
-           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
- 
-           SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
-           SUBTYPE NOENUM IS ENUM RANGE ABC .. A;
-           
-           TYPE NEWENUM IS NEW ENUM;
-          
-      BEGIN
- 
-           IF ENUM'WIDTH /= IDENT_INT(5) THEN
-                FAILED( "INCORRECT WIDTH FOR ENUM" );
-           END IF;
- 
-           IF NEWENUM'WIDTH /= IDENT_INT(5) THEN
-                FAILED( "INCORRECT WIDTH FOR NEWENUM" );
-           END IF;
- 
-           IF SUBENUM'WIDTH /= IDENT_INT(3) THEN
-                FAILED( "INCORRECT WIDTH FOR SUBENUM" );
-           END IF;
- 
-           IF NOENUM'WIDTH /= IDENT_INT(0) THEN
-                FAILED( "INCORRECT WIDTH FOR NOENUM" );
-           END IF;
- 
-      END;                    
- 
-      RESULT;
- END C35502A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C35502B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
- -- WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL 
- -- PARAMETER IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR CHARACTER 
- -- TYPE.   
- 
- -- RJW 5/05/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35502B  IS
- 
- BEGIN
- 
-      TEST( "C35502B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
-                        "THE CORRECT RESULTS WHEN THE PREFIX " &
-                        "IS A GENERIC FORMAL DISCRETE TYPE " &
-                        "WHOSE ACTUAL PARAMETER IS AN ENUMERATION " &
-                        "TYPE" );
- 
-      DECLARE
-           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-           SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
-           SUBTYPE NOENUM IS ENUM RANGE ABC .. A;
-           
-           TYPE NEWENUM IS NEW ENUM;
- 
-           GENERIC
-                TYPE E IS (<>);
-                W : INTEGER;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                SUBTYPE NOENUM IS E RANGE 
-                     E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
-           BEGIN
-                IF E'WIDTH /= IDENT_INT(W) THEN 
-                     FAILED ( "INCORRECT E'WIDTH FOR " & STR );
-                END IF;
-                IF NOENUM'WIDTH /= IDENT_INT(0) THEN
-                     FAILED ( "INCORRECT NOENUM'WIDTH FOR " & STR );
-                END IF;
-           END P;
- 
-           PROCEDURE PROC1 IS NEW P (ENUM, 5);
-           PROCEDURE PROC2 IS NEW P (SUBENUM, 3);
-           PROCEDURE PROC3 IS NEW P (NEWENUM, 5);
-           PROCEDURE PROC4 IS NEW P (NOENUM, 0);
- 
-      BEGIN
-           PROC1 ( "ENUM" );
-           PROC2 ( "SUBENUM" );
-           PROC3 ( "NEWENUM" );
-           PROC4 ( "NOENUM" );
-      END;                    
- 
-      RESULT;
- END C35502B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,318 ****
- -- C35502C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
- -- RESULTS WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN
- -- OR A CHARACTER TYPE.   
- -- SUBTESTS ARE:
- --     PART (A). TESTS FOR IMAGE.
- --     PART (B). TESTS FOR VALUE.
- 
- -- RJW 5/07/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35502C  IS
- 
-           TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
-           SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-           TYPE NEWENUM IS NEW ENUM;
- 
-           FUNCTION IDENT (X : ENUM) RETURN ENUM IS
-                BEGIN
-                     IF EQUAL (ENUM'POS (X), ENUM'POS(X)) THEN
-                          RETURN X;
-                     END IF;
-                     RETURN ENUM'FIRST;
-                END IDENT;       
- 
- BEGIN
- 
-      TEST( "C35502C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
-                        "'VALUE' YIELD THE CORRECT RESULTS " &
-                        "WHEN THE PREFIX IS AN ENUMERATION TYPE " &
-                        "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
- 
- -- PART (A).
- 
-      BEGIN  
- 
-           IF ENUM'IMAGE ( IDENT(ABC) ) /= "ABC" THEN
-                FAILED ( "INCORRECT ENUM'IMAGE FOR ABC" );
-           END IF;
-           IF ENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR ABC IN ENUM" );
-           END IF;
- 
-           IF ENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
-                FAILED ( "INCORRECT ENUM'IMAGE FOR A_B_C" );
-           END IF;
-           IF ENUM'IMAGE ( IDENT(A_B_C) )'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR A_B_C IN ENUM" );
-           END IF;
- 
-           IF SUBENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
-                FAILED ( "INCORRECT SUBENUM'IMAGE FOR A_B_C" );
-           END IF;          
-           IF SUBENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR ABC " &
-                         "IN SUBENUM" );
-           END IF;          
- 
-           IF NEWENUM'IMAGE ( ABC ) /= IDENT_STR("ABC") THEN
-                FAILED ( "INCORRECT NEWENUM'IMAGE FOR ABC" );
-           END IF;          
-           IF NEWENUM'IMAGE ( ABC )'FIRST /= IDENT_INT(1) THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR ABC" &
-                         "IN NEWENUM" );
-           END IF;          
- 
-           IF ENUM'IMAGE ( IDENT(abcd) ) /= "ABCD" THEN
-                FAILED ( "INCORRECT ENUM'IMAGE FOR abcd" );
-           END IF;          
-           IF ENUM'IMAGE ( IDENT(abcd) )'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR abcd IN ENUM" );
-           END IF;          
- 
-      END;
- 
- -----------------------------------------------------------------------
- 
- -- PART (B).
- 
-      BEGIN  
-           IF ENUM'VALUE (IDENT_STR("ABC")) /= ABC THEN     
-                FAILED ( "INCORRECT VALUE FOR ""ABC""" );  
-           END IF;
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABC""" );  
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE (IDENT_STR("abc")) /= abc THEN     
-                FAILED ( "INCORRECT VALUE FOR ""abc""" );  
-           END IF;
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""abc""" );  
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE ("ABC") /= ABC THEN     
-                FAILED ( "INCORRECT VALUE FOR ABC" );  
-           END IF;
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ABC" );  
-      END;
- 
-      BEGIN
-           IF NEWENUM'VALUE (IDENT_STR("abcd")) /= abcd THEN
-                FAILED ( "INCORRECT VALUE FOR ""abcd""" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""abcd""" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VALUE (IDENT_STR("ABCD")) /= abcd THEN
-                FAILED ( "INCORRECT VALUE FOR ""ABCD""" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABCD""" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VALUE ("abcd") /= abcd THEN
-                FAILED ( "INCORRECT VALUE FOR abcd" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR abcd" );
-      END;
- 
-      BEGIN
-           IF SUBENUM'VALUE (IDENT_STR("A_B_C")) /= A_B_C THEN
-                FAILED ( "INCORRECT VALUE FOR ""A_B_C""" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""A_B_C""" );
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE (IDENT_STR("ABC     ")) /= ABC THEN
-                FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE WITH " &
-                         "TRAILING BLANKS" );
-      END;
- 
-      BEGIN          
-           IF NEWENUM'VALUE (IDENT_STR("  A_B_C")) /= A_B_C THEN
-                FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE WITH LEADING " &
-                         "BLANKS" );
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE (IDENT_STR("A_BC")) /= ABC THEN
-                FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - ""A_BC""" );
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE (IDENT_STR("A BC")) /= ABC THEN
-                FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - ""A BC""" );
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE (IDENT_STR("A&BC")) /= ABC THEN
-                FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - ""A&BC""" );
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE (IDENT_CHAR(ASCII.HT) & "BC") /= BC THEN
-                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VALUE ("A" & (IDENT_CHAR(ASCII.HT))) /= A THEN
-                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
-      END;
- 
-      BEGIN
-           IF ENUM'VALUE (IDENT_STR("B__C")) /= BC THEN
-                FAILED ( "NO EXCEPTION RAISED - " &
-                         "CONSECUTIVE UNDERSCORES - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - " &
-                         "CONSECUTIVE UNDERSCORES - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - " &
-                         "CONSECUTIVE UNDERSCORES" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VALUE (IDENT_STR("BC_")) /= BC THEN
-                FAILED ( "NO EXCEPTION RAISED - " & 
-                         "TRAILING UNDERSCORE - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - " & 
-                         "TRAILING UNDERSCORE - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - " & 
-                         "TRAILING UNDERSCORE" );
-      END;
- 
-      BEGIN
-           IF SUBENUM'VALUE (IDENT_STR("_BC")) /= BC THEN
-                FAILED ( "NO EXCEPTION RAISED - " & 
-                         "LEADING UNDERSCORE - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - " & 
-                         "LEADING UNDERSCORE - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - " & 
-                         "LEADING UNDERSCORE" );
-      END;
- 
-      BEGIN
-           IF SUBENUM'VALUE (IDENT_STR("0BC")) /= BC THEN
-                FAILED ( "NO EXCEPTION RAISED - " & 
-                         "FIRST CHARACTER IS A DIGIT - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - " & 
-                         "FIRST CHARACTER IS A DIGIT - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - " & 
-                         "FIRST CHARACTER IS A DIGIT" );
-      END;
- 
-      RESULT;
- END C35502C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502d.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502d.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502d.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C35502D.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
- -- LONGEST POSSIBLE ENUMERATION LITERAL.
- 
- -- RJW 2/21/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502D IS
- 
- BEGIN
-      TEST ("C35502D", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
-                       "CORRECT RESULTS FOR THE LONGEST POSSIBLE " &
-                       "ENUMERATION LITERAL");
- 
-      -- BIG_ID1 IS A MAXIMUM LENGTH IDENTIFIER. BIG_STRING1 AND 
-      -- BIG_STRING2 ARE TWO STRING LITERALS WHICH WHEN CONCATENATED 
-      -- FORM THE IMAGE OF BIG_ID1;
- 
- 
-      DECLARE
-           TYPE ENUM IS (
- $BIG_ID1
-                         );                             
- 
-      BEGIN
-           BEGIN
-                IF ENUM'VALUE (
- $BIG_STRING1  
- &
- $BIG_STRING2
- ) /= 
- $BIG_ID1
-                     THEN
-                     FAILED ( "INCORRECT RESULTS FOR 'VALUE'" );
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED FOR 'VALUE'" );
-           END;
-           BEGIN           
-                IF ENUM'IMAGE( 
- $BIG_ID1
- ) /=
- (
- $BIG_STRING1
- &
- $BIG_STRING2
- )                   THEN
-                     FAILED ( "INCORRECT RESULTS FOR 'IMAGE'" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED FOR 'IMAGE'" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED FOR 'IMAGE'" );
-           END;
-      END;
- 
-      RESULT;
- END C35502D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- C35502E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
- -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL 
- -- PARAMETER IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A 
- -- CHARACTER TYPE.   
- -- SUBTESTS ARE:
- --     PART (A). TESTS FOR IMAGE.
- --     PART (B). TESTS FOR VALUE.
- 
- -- RJW 5/13/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35502E  IS
- 
-           TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
-           SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-           TYPE NEWENUM IS NEW ENUM;
- 
- BEGIN
- 
-      TEST( "C35502E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
-                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ACTUAL PARAMETER IS AN ENUMERATION TYPE " &
-                        "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
- 
- -- PART (A).
-      DECLARE
-           GENERIC
-                TYPE E IS (<>);
-                STR1 : STRING;
-           PROCEDURE P ( E1 : E; STR2 : STRING );
-           
-           PROCEDURE P ( E1 : E; STR2 : STRING ) IS
-                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
-           BEGIN
-                IF SE'IMAGE ( E1 ) /= STR2 THEN
-                     FAILED ( "INCORRECT SE'IMAGE FOR " & STR2 & " IN "
-                               & STR1 );
-                END IF;
-                IF SE'IMAGE ( E1 )'FIRST /= 1 THEN
-                     FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 
-                               & " IN " & STR1 );
-                END IF;
-           END P;
-           
-           PROCEDURE PE IS NEW P ( ENUM , "ENUM" );
-           PROCEDURE PS IS NEW P ( SUBENUM, "SUBENUM" );
-           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
- 
-      BEGIN
-           PE ( ABC, "ABC" );
-           PE ( A_B_C, "A_B_C" );
-           PS ( BC, "BC" );
-           PN ( ABC, "ABC" );
-           PE ( abcd, "ABCD" );
-      END;
- 
- -----------------------------------------------------------------------
- 
- -- PART (B).
- 
-      DECLARE
-           GENERIC
-                TYPE E IS (<>);
-                STR1 : STRING;
-           PROCEDURE P ( STR2 : STRING ; E1 : E );
-           
-           PROCEDURE P ( STR2 : STRING ; E1 : E ) IS
-                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
-           BEGIN
-                IF E'VALUE ( STR2 ) /= E1 THEN     
-                     FAILED ( "INCORRECT " & STR1 & "'VALUE FOR """ & 
-                               STR2 & """" ); 
-                END IF;
-           EXCEPTION     
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED - " & STR1 & "'VALUE " &
-                              "FOR """ & STR2 & """" );  
-           END P;
- 
-           PROCEDURE PE IS NEW P ( ENUM , "ENUM" );
-           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
- 
-      BEGIN
-           PN ("abcd", abcd);
-           PN ("A_B_C", A_B_C);
-           PE ("ABC     ", ABC);
-           PE ("  A_B_C", A_B_C);
-      END;
- 
- 
-      DECLARE
-           GENERIC
-                TYPE E IS (<>);
-           PROCEDURE P ( STR : STRING );
-           
-           PROCEDURE P ( STR : STRING ) IS
-                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
-           BEGIN
-                IF SE'VALUE (STR) = SE'VAL (0) THEN
-                     FAILED ( "NO EXCEPTION RAISED - " & STR & " - 1" );
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED - " & STR & " - 2" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED - " & STR );
-           END P;
- 
-           PROCEDURE PE IS NEW P ( ENUM );
-           PROCEDURE PS IS NEW P ( SUBENUM );
-           PROCEDURE PN IS NEW P ( NEWENUM );
-           
-      BEGIN
-           PS ("A BC");
-           PN ("A&BC");
-           PE (ASCII.HT & "BC");
-           PE ("A" & ASCII.HT);
-           PS ("_BC");
-           PN ("BC_");
-           PE ("B__C");
-           PE ("0BC");
- 
-      END;
- 
-      RESULT;
- END C35502E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502f.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502f.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502f.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502f.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- C35502F.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMAGE AND VALUE ATTRIBUTES ARE CORRECT FOR A FORMAL
- -- DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN ENUMERATED TYPE
- -- WITH THE LONGEST POSSIBLE IDENTIFIER AS ONE CONSTANT.
- 
- -- PWB  03/05/86
- -- DWC  07/22/87     -- ADDED THE CONSTANT STRING 'STR'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502F IS
- 
-      -- BIG_ID1 IS AN IDENTIFIER OF MAXIMUM LENGTH.
-      TYPE ENUM IS ( EVAL1,
- $BIG_ID1
-                   );
- 
-      -- BIG_STRING1 & BIG_STRING2 YIELDS BIG_ID.
-      STR1 : CONSTANT STRING :=
- $BIG_STRING1;
-      STR2 : CONSTANT STRING :=
- $BIG_STRING2;
-      STR : CONSTANT STRING := STR1 & STR2;
- 
-      GENERIC
-           TYPE FORMAL IS (<>);
-      PROCEDURE GEN_PROC;
- 
-      PROCEDURE GEN_PROC IS
-      BEGIN
-           VALUE_CHECK:
-           BEGIN
-                IF FORMAL'VALUE (STR) /= FORMAL'LAST THEN
-                     FAILED ("VALUE OF LONG STRING NOT LONG IDENTIFIER");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN CHECKING " &
-                             "VALUE ATTRIBUTE");
-           END VALUE_CHECK;
- 
-           IMAGE_CHECK:
-           BEGIN
-                IF FORMAL'IMAGE (FORMAL'LAST) /= STR
-                THEN
-                     FAILED ("IMAGE OF LONG IDENTIFIER NOT LONG STRING");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN CHECKING " &
-                             "IMAGE ATTRIBUTE");
-           END IMAGE_CHECK;
- 
-      END GEN_PROC;
- 
-      PROCEDURE TEST_PROC IS NEW GEN_PROC (ENUM);
- 
- BEGIN   -- C35502F
- 
-      TEST ("C35502F", "IMAGE AND VALUE ATTRIBUTES FOR A FORMAL " &
-                       "DISCRETE TYPE WITH ONE ACTUAL VALUE HAVING " &
-                       "LONGEST POSSIBLE IDENTIFIER");
-      TEST_PROC;
-      RESULT;
- 
- END C35502F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C35502G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN 
- -- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A 
- -- CHARACTER TYPE.
- 
- -- RJW 5/27/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502G IS
- 
-           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-           SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-           TYPE NEWENUM IS NEW ENUM;
-           SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
- 
- BEGIN
-      TEST ("C35502G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
-                       "ENUMERATION TYPE OTHER THAN A CHARACTER " &
-                       "OR A BOOLEAN TYPE" );
- 
-      BEGIN
-           FOR I IN ENUM'VAL (1) .. ENUM'VAL (4) LOOP
-                IF SUBENUM'PRED (I) /= 
-                   ENUM'VAL (ENUM'POS (I) - 1) THEN
-                     FAILED ("INCORRECT SUBENUM'PRED(" &
-                              ENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
- 
-           FOR I IN ENUM'VAL (0) .. ENUM'VAL (3) LOOP
-                IF SUBENUM'SUCC (I) /= 
-                   ENUM'VAL (ENUM'POS (I) + 1) THEN
-                     FAILED ("INCORRECT SUBENUM'SUCC(" &
-                              ENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
-      END;
- 
-      BEGIN
-           FOR I IN NEWENUM'VAL (1) .. NEWENUM'VAL (4) LOOP
-                IF SUBNEW'PRED (I) /= 
-                   NEWENUM'VAL (NEWENUM'POS (I) - 1) THEN
-                     FAILED ("INCORRECT SUBNEW'PRED(" &
-                              NEWENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
- 
-           FOR I IN NEWENUM'VAL (0) .. NEWENUM'VAL (3) LOOP
-                IF SUBNEW'SUCC (I) /= 
-                   NEWENUM'VAL (NEWENUM'POS (I) + 1) THEN
-                     FAILED ("INCORRECT SUBNEW'SUCC(" &
-                              NEWENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
-      END;
- 
-      RESULT;
- END C35502G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C35502H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN 
- -- THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
- -- AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A CHARACTER TYPE.
- 
- -- RJW 5/27/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502H IS
- 
-           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
- 
-           TYPE NEWENUM IS NEW ENUM;
- 
- BEGIN
-      TEST ("C35502H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "FORMAL DISCRETE TYPE WHOSE ACTUAL " &
-                       "ARGUMENT IS AN ENUMERATION TYPE OTHER THAN " &
-                       "A CHARACTER OR A BOOLEAN TYPE" );
- 
-      DECLARE
-           GENERIC
-                TYPE E IS (<>);
-                STR : STRING;
-           PROCEDURE P;
-           
-           PROCEDURE P IS
-                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
-           BEGIN
-                FOR I IN E'VAL (1) .. E'VAL (4) LOOP
-                     IF SE'PRED (I) /= 
-                        E'VAL (E'POS (I) - 1) THEN
-                          FAILED ("INCORRECT " & STR & "'PRED(" &
-                                   E'IMAGE (I) & ")" );
-                     END IF;
-                END LOOP;
- 
-                FOR I IN E'VAL (0) .. E'VAL (3) LOOP
-                     IF SE'SUCC (I) /= 
-                        E'VAL (E'POS (I) + 1) THEN
-                          FAILED ("INCORRECT " & STR & "'SUCC(" &
-                                   E'IMAGE (I) & ")" );
-                     END IF;
-                END LOOP;
- 
-           END P;
- 
-           PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
-           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
- 
-      BEGIN
-           PE;
-           PN;
-      END;
-           
-      RESULT;
- END C35502H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502i.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C35502I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN
- --     THE PREFIX IS AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A
- --     CHARACTER TYPE, WITH A REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 05/27/86  CREATED ORIGINAL TEST.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502I IS
- 
-      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-      FOR ENUM USE (A => 2, BC => 4, ABC => 6,
-                    A_B_C => 8, ABCD => 10);
-      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-      TYPE NEWENUM IS NEW ENUM;
-      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
- 
- BEGIN
-      TEST ("C35502I", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
-                       "ENUMERATION TYPE, OTHER THAN A CHARACTER " &
-                       "OR A BOOLEAN TYPE, WITH A REPRESENTATION " &
-                       "CLAUSE" );
- 
-      BEGIN
-           FOR I IN ENUM'VAL (1) .. ENUM'VAL (4) LOOP
-                IF SUBENUM'PRED (I) /=
-                   ENUM'VAL (ENUM'POS (I) - 1) THEN
-                     FAILED ("INCORRECT SUBENUM'PRED(" &
-                              ENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
- 
-           FOR I IN ENUM'VAL (0) .. ENUM'VAL (3) LOOP
-                IF SUBENUM'SUCC (I) /=
-                   ENUM'VAL (ENUM'POS (I) + 1) THEN
-                     FAILED ("INCORRECT SUBENUM'SUCC(" &
-                              ENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
-      END;
- 
-      BEGIN
-           FOR I IN NEWENUM'VAL (1) .. NEWENUM'VAL (4) LOOP
-                IF SUBNEW'PRED (I) /=
-                   NEWENUM'VAL (NEWENUM'POS (I) - 1) THEN
-                     FAILED ("INCORRECT SUBNEW'PRED(" &
-                              NEWENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
- 
-           FOR I IN NEWENUM'VAL (0) .. NEWENUM'VAL (3) LOOP
-                IF SUBNEW'SUCC (I) /=
-                   NEWENUM'VAL (NEWENUM'POS (I) + 1) THEN
-                     FAILED ("INCORRECT SUBNEW'SUCC(" &
-                              NEWENUM'IMAGE (I) & ")" );
-                END IF;
-           END LOOP;
-      END;
- 
-      RESULT;
- END C35502I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C35502J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN
- --     THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
- --     AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A CHARACTER TYPE,
- --     WITH AN ENUMERATION REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 05/27/86  CREATED ORIGINAL TEST.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502J IS
-           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-           FOR ENUM USE (A => 2, BC => 4, ABC => 6,
-                         A_B_C => 8, ABCD => 10);
- 
-           TYPE NEWENUM IS NEW ENUM;
- 
- BEGIN
-      TEST ("C35502J", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS " &
-                       "A FORMAL DISCRETE TYPE WHOSE ACTUAL " &
-                       "ARGUMENT IS AN ENUMERATION TYPE, OTHER THAN " &
-                       "A CHARACTER OR A BOOLEAN TYPE, WITH AN " &
-                       "ENUMERATION REPRESENTATION CLAUSE" );
- 
-      DECLARE
-           GENERIC
-                TYPE E IS (<>);
-                STR : STRING;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
- 
-           BEGIN
-                FOR I IN E'VAL (1) .. E'VAL (4)
-                     LOOP
-                          IF SE'PRED (I) /=
-                             E'VAL (E'POS (I) - 1) THEN
-                               FAILED ("INCORRECT " & STR & "'PRED(" &
-                                        E'IMAGE (I) & ")" );
-                          END IF;
-                     END LOOP;
- 
-                FOR I IN E'VAL (0) .. E'VAL (3)
-                     LOOP
-                          IF SE'SUCC (I) /=
-                             E'VAL (E'POS (I) + 1) THEN
-                               FAILED ("INCORRECT " & STR & "'SUCC(" &
-                                        E'IMAGE (I) & ")" );
-                          END IF;
-                     END LOOP;
- 
-      END P;
- 
-      PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
-      PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
- 
-      BEGIN
-           PE;
-           PN;
-      END;
- 
-      RESULT;
- END C35502J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502k.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- -- C35502K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
- -- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A
- -- CHARACTER TYPE.
- 
- -- RJW 5/27/86
- -- GMT 7/02/87  ADDED ENUM'VAL(3) CHECK NEAR END OF 2ND BLOCK STATEMENT.
- 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502K IS
- 
-      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-      TYPE NEWENUM IS NEW ENUM;
-      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
- 
- BEGIN
-      TEST ("C35502K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
-                       "ENUMERATION TYPE OTHER THAN A CHARACTER " &
-                       "OR A BOOLEAN TYPE" );
- 
-      DECLARE
-           POSITION : INTEGER;
-      BEGIN
-           POSITION := 0;
- 
-           FOR E IN ENUM LOOP
-                IF SUBENUM'POS (E) /= POSITION THEN
-                     FAILED ( "INCORRECT SUBENUM'POS (" &
-                               ENUM'IMAGE (E) & ")" );
-                END IF;
- 
-                IF SUBENUM'VAL (POSITION) /= E THEN
-                     FAILED ( "INCORRECT SUBENUM'VAL (" &
-                               INTEGER'IMAGE (POSITION) &
-                              ")" );
-                END IF;
- 
-                POSITION := POSITION + 1;
-           END LOOP;
- 
-           POSITION := 0;
-           FOR E IN NEWENUM LOOP
-                IF SUBNEW'POS (E) /= POSITION THEN
-                     FAILED ( "INCORRECT SUBNEW'POS (" &
-                               NEWENUM'IMAGE (E) & ")" );
-                END IF;
- 
-                IF SUBNEW'VAL (POSITION) /= E THEN
-                     FAILED ( "INCORRECT SUBNEW'VAL (" &
-                               INTEGER'IMAGE (POSITION) &
-                              ")" );
-                END IF;
- 
-                POSITION := POSITION + 1;
-           END LOOP;
-      END;
- 
-      DECLARE
-           FUNCTION A_B_C RETURN ENUM IS
-           BEGIN
-                RETURN ENUM'VAL (IDENT_INT (0));
-           END A_B_C;
- 
-      BEGIN
-           IF ENUM'VAL (0) /= A_B_C THEN
-                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
-                         "BY FUNCTION - 1" );
-           END IF;
- 
-           IF ENUM'VAL (0) = C35502K.A_B_C THEN
-                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
-                         "BY FUNCTION - 2" );
-           END IF;
- 
-           IF ENUM'VAL (3) /= C35502K.A_B_C THEN
-                FAILED ( "WRONG ENUM'VAL (3) WHEN HIDDEN " &
-                         "BY FUNCTION - 3" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF ENUM'VAL (IDENT_INT (-1)) = A THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR ENUM'VAL (IDENT_INT (-1)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR ENUM'VAL (IDENT_INT (-1)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR ENUM'VAL (IDENT_INT (-1))" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VAL (IDENT_INT (-1)) = A THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (-1))" );
-      END;
- 
-      BEGIN
-           IF ENUM'VAL (IDENT_INT (5)) = A THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR ENUM'VAL (IDENT_INT (5)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR ENUM'VAL (IDENT_INT (5)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR ENUM'VAL (IDENT_INT (5))" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VAL (IDENT_INT (5)) = A THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (5)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (5)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (5))" );
-      END;
- 
-      RESULT;
- END C35502K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C35502L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN 
- -- THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
- -- AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A CHARACTER TYPE.
- 
- -- RJW 5/27/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502L IS
-      
-      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-      TYPE NEWENUM IS NEW ENUM;
-      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
- 
- BEGIN
-      TEST ("C35502L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT " &
-                       "IS AN ENUMERATION TYPE OTHER THAN A " &
-                       "CHARACTER OR A BOOLEAN TYPE" );
- 
-      DECLARE
- 
-           GENERIC
-                TYPE E IS (<>);
-                STR : STRING;
-           PROCEDURE P;
-           
-           PROCEDURE P IS
-                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
-                POSITION : INTEGER;
-           BEGIN
-      
-                POSITION := 0;
- 
-                FOR E1 IN E
-                     LOOP
-                          IF SE'POS (E1) /= POSITION THEN
-                               FAILED ( "INCORRECT SE'POS (" &
-                                         E'IMAGE (E1) & ")" );
-                          END IF;
-                     
-                          IF SE'VAL (POSITION) /= E1 THEN 
-                               FAILED ( "INCORRECT " & STR & "'VAL (" &
-                                         INTEGER'IMAGE (POSITION) & 
-                                        ")" );
-                          END IF;
-      
-                          POSITION := POSITION + 1;
-                     END LOOP;
-           
-                BEGIN
-                     IF E'VAL (-1) = E'VAL (1) THEN
-                          FAILED ( "NO EXCEPTION RAISED FOR " & 
-                                    STR & "'VAL (-1) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED FOR " & 
-                                    STR & "'VAL (-1) - 2" );
-                     END IF;
-                EXCEPTION
-                      WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " & 
-                                    STR & "'VAL (-1)" );
-                END;
- 
-                BEGIN
-                     IF E'VAL (5) = E'VAL (4) THEN
-                          FAILED ( "NO EXCEPTION RAISED FOR " & 
-                                    STR & "'VAL (5) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED FOR " & 
-                                    STR & "'VAL (5) - 2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " & 
-                                    STR & "'VAL (5)" );
-                END;
-           END P;
-      
-           PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
-           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
-      BEGIN          
-           PE;          
-           PN;
-      END;
-      
-      DECLARE
-           GENERIC
-                TYPE E IS (<>);
-           FUNCTION F (E1 : E) RETURN BOOLEAN;
- 
-           FUNCTION F (E1 : E) RETURN BOOLEAN IS
-           BEGIN
-                RETURN E'VAL (0) = E1;
-           END F;               
-      
-           FUNCTION FE IS NEW F (ENUM);
- 
-      BEGIN
- 
-           DECLARE
-                FUNCTION A_B_C RETURN ENUM IS
-                BEGIN
-                     RETURN ENUM'VAL (IDENT_INT (0));
-                END A_B_C;
-           BEGIN
-                IF FE (A_B_C) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT VAL FOR A_B_C WHEN HIDDEN " &
-                              "BY A FUNCTION" );
-                END IF;
- 
-                IF FE (C35502L.A_B_C) THEN
-                     FAILED ( "INCORRECT VAL FOR C35502L.A_B_C" );
-                END IF;
-          END;
-      END;
- 
-      RESULT;
- END C35502L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502m.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,177 ****
- -- C35502M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
- --     THE PREFIX IS AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A
- --     CHARACTER TYPE, WITH AN ENUMERATION REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 05/27/86  CREATED ORIGINAL TEST.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502M IS
- 
-      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-      FOR ENUM USE (A => 2, BC => 4, ABC => 6,
-                    A_B_C => 8, ABCD => 10);
- 
-      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-      TYPE NEWENUM IS NEW ENUM;
-      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
- 
- BEGIN
-      TEST ("C35502M", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
-                       "ENUMERATION TYPE, OTHER THAN A CHARACTER " &
-                       "OR A BOOLEAN TYPE, WITH AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE" );
- 
-      DECLARE
-           POSITION : INTEGER;
-      BEGIN
-           POSITION := 0;
- 
-           FOR E IN ENUM
-                LOOP
-                     IF SUBENUM'POS (E) /= POSITION THEN
-                          FAILED ( "INCORRECT SUBENUM'POS (" &
-                                    ENUM'IMAGE (E) & ")" );
-                     END IF;
- 
-                     IF SUBENUM'VAL (POSITION) /= E THEN
-                          FAILED ( "INCORRECT SUBENUM'VAL (" &
-                                    INTEGER'IMAGE (POSITION) &
-                                   ")" );
-                     END IF;
- 
-                     POSITION := POSITION + 1;
-                END LOOP;
- 
-           POSITION := 0;
-           FOR E IN NEWENUM
-                LOOP
-                     IF SUBNEW'POS (E) /= POSITION THEN
-                          FAILED ( "INCORRECT SUBNEW'POS (" &
-                                    NEWENUM'IMAGE (E) & ")" );
-                     END IF;
- 
-                     IF SUBNEW'VAL (POSITION) /= E THEN
-                          FAILED ( "INCORRECT SUBNEW'VAL (" &
-                                    INTEGER'IMAGE (POSITION) &
-                                   ")" );
-                     END IF;
- 
-                     POSITION := POSITION + 1;
-                END LOOP;
-      END;
- 
-      DECLARE
-           FUNCTION A_B_C RETURN ENUM IS
-           BEGIN
-                RETURN A;
-           END A_B_C;
- 
-      BEGIN
-           IF ENUM'VAL (0) /= A_B_C THEN
-                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
-                         "BY FUNCTION - 1" );
-           END IF;
- 
-           IF ENUM'VAL (0) = C35502M.A_B_C THEN
-                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
-                         "BY FUNCTION - 2" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF ENUM'VAL (IDENT_INT (-1)) = ENUM'FIRST THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "ENUM'VAL (IDENT_INT (-1)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "ENUM'VAL (IDENT_INT (-1)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "ENUM'VAL (IDENT_INT (-1))" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VAL (IDENT_INT (-1)) = NEWENUM'LAST THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (-1))" );
-      END;
- 
-      BEGIN
-           IF ENUM'VAL (IDENT_INT (5)) = ENUM'LAST THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "ENUM'VAL (IDENT_INT (5)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "ENUM'VAL (IDENT_INT (5)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "ENUM'VAL (IDENT_INT (5))" );
-      END;
- 
-      BEGIN
-           IF NEWENUM'VAL (IDENT_INT (5)) = NEWENUM'LAST THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (5)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (5)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NEWENUM'VAL (IDENT_INT (5))" );
-      END;
- 
-      RESULT;
- END C35502M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502n.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C35502N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
- --     THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
- --     AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A CHARACTER TYPE,
- --     WITH AN ENUMERATION REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 05/27/86
- --     DWC 07/22/87  ADDED THE PARAMETER 'N' TO FUNCTION F.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35502N IS
- 
-      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-      FOR ENUM USE (A => 1, BC => 4, ABC => 5, A_B_C => 6,
-                    ABCD => 8);
- 
-      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
- 
-      TYPE NEWENUM IS NEW ENUM;
-      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
- 
- BEGIN
-      TEST ("C35502N", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT " &
-                       "IS AN ENUMERATION TYPE, OTHER THAN A " &
-                       "CHARACTER OR A BOOLEAN TYPE, WITH AN " &
-                       "ENUMERATION REPRESENTATION CLAUSE" );
- 
-      DECLARE
- 
-           GENERIC
-                TYPE E IS (<>);
-                STR : STRING;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
-                POSITION : INTEGER;
-           BEGIN
- 
-                POSITION := 0;
- 
-                FOR E1 IN E LOOP
-                     IF SE'POS (E1) /= POSITION THEN
-                          FAILED ( "INCORRECT " & STR & "'POS (" &
-                                    E'IMAGE (E1) & ")" );
-                     END IF;
- 
-                     IF SE'VAL (POSITION) /= E1 THEN
-                          FAILED ( "INCORRECT " & STR & "'VAL (" &
-                                    INTEGER'IMAGE (POSITION) &
-                                    ")" );
-                     END IF;
- 
-                     POSITION := POSITION + 1;
-                END LOOP;
- 
-                BEGIN
-                     IF E'VAL (-1) = E'VAL (1) THEN
-                          FAILED ( "NO EXCEPTION RAISED FOR " &
-                                    STR & "'VAL (-1) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED FOR " &
-                                    STR & "'VAL (-1) - 2" );
-                     END IF;
-                EXCEPTION
-                      WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'VAL (-1)" );
-                END;
- 
-                BEGIN
-                     IF E'VAL (5) = E'VAL (4) THEN
-                          FAILED ( "NO EXCEPTION RAISED FOR " &
-                                    STR & "'VAL (5) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED FOR " &
-                                    STR & "'VAL (5) - 2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'VAL (5)" );
-                END;
-           END P;
- 
-           PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
-           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
-      BEGIN
-           PE;
-           PN;
-      END;
- 
-      DECLARE
-           FUNCTION A_B_C RETURN ENUM IS
-           BEGIN
-                RETURN ENUM'VAL (IDENT_INT (0));
-           END A_B_C;
- 
-           GENERIC
-                TYPE E IS (<>);
-           FUNCTION F (N : INTEGER;
-                       E1 : E) RETURN BOOLEAN;
- 
-           FUNCTION F (N : INTEGER;
-                       E1 : E) RETURN BOOLEAN IS
-           BEGIN
-                RETURN E'VAL (N) = E1;
-           END F;
- 
-           FUNCTION FE IS NEW F (ENUM);
- 
-      BEGIN
- 
-      IF NOT FE (0, A_B_C) THEN
-           FAILED ( "INCORRECT VAL FOR A_B_C WHEN HIDDEN " &
-                    "BY A FUNCTION" );
-      END IF;
- 
-      IF NOT FE (3, C35502N.A_B_C) THEN
-                     FAILED ( "INCORRECT VAL FOR C35502N.A_B_C" );
-      END IF;
-      END;
- 
-      RESULT;
- END C35502N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502o.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- C35502O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'FIRST AND 'LAST GIVE CORRECT RESULTS FOR TYPES
- -- AND SUBTYPES.
- 
- -- DAT 3/17/81
- -- R. WILLIAMS 11/11/86      RENAMED FROM C35104A.ADA.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35502O IS
- 
-      TYPE E IS (E1, E2, E3, E4, E5);
- 
-      SUBTYPE S IS E RANGE E2 .. E4;
- 
- BEGIN
-      TEST ("C35502O", "CHECK THAT 'FIRST AND 'LAST WORK FOR"
-           & " ENUMERATION TYPES AND SUBTYPES");
- 
-      IF E'FIRST /= E1 OR E'LAST /= E5
-      OR E'BASE'FIRST /= E1 OR E'BASE'LAST /= E5
-      OR S'BASE'FIRST /= E1 OR S'BASE'LAST /= E5
-      OR S'FIRST /= E2 OR S'LAST /= E4
-      OR BOOLEAN'FIRST /= FALSE OR BOOLEAN'LAST /= TRUE
-      THEN
-           FAILED ("'FIRST OR 'LAST GIVES WRONG RESULTS");
-      END IF;
- 
-      RESULT;
- END C35502O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35502p.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35502p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- C35502P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR AN ENUMERATION TYPE OTHER THAN BOOLEAN OR CHARACTER TYPE,
- --     CHECK THAT THE RESULTS AND TYPE PRODUCED BY THE ATTRIBUTES
- --     ARE CORRECT.
- 
- --     CHECK THAT 'FIRST AND 'LAST YIELD CORRECT RESULTS WHEN THE
- --     PREFIX DENOTES A NULL SUBTYPE.
- 
- -- HISTORY:
- --     RJW 05/05/86  CREATED ORIGINAL TEST.
- --     CJJ 06/09/87  CHANGED "=" COMPARISONS IN GENERIC
- --                   PROCEDURE Q TO "/=".
- 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35502P  IS
- 
- BEGIN
- 
-      TEST( "C35502P" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
-                        "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
-                        "WHOSE ACTUAL PARAMETER IS AN ENUMERATION " &
-                        "TYPE OTHER THAN A CHARACTER OR A BOOLEAN " &
-                        "TYPE" );
- 
-      DECLARE
-        -- FOR THESE DECLARATIONS, 'FIRST AND 'LAST REFER TO THE
-        -- SUBTYPE VALUES, BUT 'VAL AND 'POS ARE INHERITED FROM THE
-        -- BASE TYPE.
- 
-           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
-           SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
- 
-           TYPE NEWENUM IS NEW ENUM RANGE BC .. A_B_C;
-           TYPE NONEWENUM IS NEW ENUM RANGE ABCD .. A;
-           GENERIC
-                TYPE E IS (<>);
-                F, L : E;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                SUBTYPE NOENUM IS E RANGE
-                    E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
-           BEGIN
-                IF E'FIRST /= F THEN
-                     FAILED ( "INCORRECT E'FIRST FOR " & STR );
-                END IF;
-                IF NOENUM'FIRST /= E'VAL (2) THEN
-                     FAILED ( "INCORRECT NOENUM'FIRST FOR " & STR );
-                END IF;
- 
-                IF E'LAST /= L THEN
-                     FAILED ( "INCORRECT E'LAST FOR " & STR );
-                END IF;
-                IF NOENUM'LAST /= E'VAL (1) THEN
-                     FAILED ( "INCORRECT NOENUM'LAST FOR " & STR );
-                END IF;
-           END P;
- 
-           GENERIC
-                TYPE E IS (<>);
-           PROCEDURE Q;
- 
-           PROCEDURE Q IS
-                SUBTYPE NOENUM IS E RANGE
-                        E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
-           BEGIN
-                IF E'FIRST /= E'VAL (IDENT_INT(4)) THEN
-                     FAILED ( "INCORRECT E'FIRST FOR NONEWENUM" );
-                END IF;
-                IF NOENUM'FIRST /= E'VAL (2) THEN
-                     FAILED ( "INCORRECT NOENUM'FIRST FOR NONEWENUM");
-                END IF;
- 
-                IF E'LAST /= E'VAL (IDENT_INT(0)) THEN
-                     FAILED ( "INCORRECT E'LAST FOR NONEWENUM");
-                END IF;
-                IF NOENUM'LAST /= E'VAL (1) THEN
-                     FAILED ( "INCORRECT NOENUM'LAST FOR NONEWENUM");
-                END IF;
-           END Q;
- 
-           PROCEDURE PROC1 IS NEW P (ENUM, A, ABCD);
-           PROCEDURE PROC2 IS NEW P (SUBENUM, A, ABC);
-           PROCEDURE PROC3 IS NEW P (NEWENUM, BC, A_B_C);
-           PROCEDURE PROC4 IS NEW Q (NONEWENUM);
- 
-      BEGIN
-           PROC1 ( "ENUM" );
-           PROC2 ( "SUBENUM" );
-           PROC3 ( "NEWENUM" );
-           PROC4;
-      END;
- 
-      RESULT;
- END C35502P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C35503A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'WIDTH' YIELDS THE CORRECT RESULT WHEN THE PREFIX IS AN 
- -- INTEGER TYPE.
- 
- -- RJW 3/12/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503A IS
- 
- BEGIN
-      TEST ("C35503A", "CHECK THAT 'WIDTH' YIELDS THE CORRECT " &
-                       "RESULT WHEN THE PREFIX IS AN INTEGER TYPE" );
- 
-      DECLARE
-           SUBTYPE SINTEGER IS INTEGER;
-           
-           TYPE INT IS RANGE -1000 .. 1000;
-           TYPE INT2 IS NEW INT RANGE 1E2 .. 1E2;
- 
-           SUBTYPE SINT1 IS INT RANGE 00000 .. 100;
-           SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
-           SUBTYPE SINT3 IS INT RANGE -100 .. 9;
-           SUBTYPE NOINT IS INT RANGE 1 .. -1;
- 
-      BEGIN
-           IF IDENT_INT(SINTEGER'WIDTH) /= INTEGER'WIDTH THEN
-                FAILED ( "WRONG WIDTH FOR 'SINTEGER'" );
-           END IF;
- 
-           IF IDENT_INT(INT'WIDTH) /= 5 THEN
-                FAILED ( "WRONG WIDTH FOR 'INT'" );
-           END IF;
- 
-           IF IDENT_INT(INT2'WIDTH) /= 4 THEN
-                FAILED ( "WRONG WIDTH FOR 'INT2'");
-           END IF;
- 
-           IF IDENT_INT(SINT1'WIDTH) /= 4 THEN 
-                FAILED ( "WRONG WIDTH FOR 'SINT1'" );
-           END IF;
- 
-           IF IDENT_INT(SINT2'WIDTH) /= 4 THEN 
-                FAILED ( "WRONG WIDTH FOR 'SINT2'" );
-           END IF;
- 
-           IF IDENT_INT(SINT3'WIDTH) /= 4 THEN
-                FAILED ( "WRONG WIDTH FOR 'SINT3'" );
-           END IF;
- 
-           IF IDENT_INT(NOINT'WIDTH) /= 0 THEN
-                FAILED ( "WRONG WIDTH FOR 'NOINT'" );
-           END IF;
-      END;
- 
-      RESULT;
- END C35503A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C35503B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'WIDTH' YIELDS THE CORRECT RESULT WHEN THE PREFIX IS A
- -- GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN INTEGER 
- -- TYPE.
- 
- -- RJW 3/17/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503B IS
- 
- BEGIN
-      TEST ("C35503B", "CHECK THAT 'WIDTH' YIELDS THE CORRECT " &
-                       "RESULT WHEN THE PREFIX IS A GENERIC FORMAL "  &
-                       "DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN " &
-                       "INTEGER TYPE" );
- 
-      DECLARE
- 
-           TYPE INT IS RANGE -1000 .. 1000;
-           TYPE INT2 IS NEW INT RANGE 0E8 .. 1E3;
-           SUBTYPE SINT1 IS INT RANGE 00000 .. 300;
-           SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
- 
-           GENERIC
-                TYPE I IS (<>);
-                W : INTEGER;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                SUBTYPE SUBI IS I 
-                     RANGE I'VAL (IDENT_INT(224)) .. I'VAL (255);
-                SUBTYPE NORANGE IS I 
-                     RANGE I'VAL (255) .. I'VAL (IDENT_INT(224));
-           BEGIN
-                IF IDENT_INT(I'WIDTH) /= W THEN 
-                     FAILED ( "INCORRECT I'WIDTH FOR " & STR );
-                END IF;
- 
-                IF IDENT_INT(SUBI'WIDTH) /= 4 THEN
-                     FAILED ( "INCORRECT SUBI'WIDTH FOR " & STR );
-                END IF;
- 
-                IF IDENT_INT(NORANGE'WIDTH) /= 0 THEN
-                     FAILED ( "INCORRECT NORANGE'WIDTH FOR " & STR );
-                END IF;
-           END P;
- 
-           PROCEDURE P_INTEGER IS NEW P (INTEGER, INTEGER'WIDTH);
-           PROCEDURE P_INT     IS NEW P (INT, 5);
-           PROCEDURE P_INT2    IS NEW P (INT2, 5);
-           PROCEDURE P_SINT1   IS NEW P (SINT1, 4);
-           PROCEDURE P_SINT2   IS NEW P (SINT2, 4);
- 
-      BEGIN
-           P_INTEGER ("'INTEGER'");
-           P_INT     ("'INT'");
-           P_INT2    ("'INT2'");
-           P_SINT1   ("'SINT1'");
-           P_SINT2   ("'SINT2'");
-      END;
- 
-      RESULT;
- END C35503B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,543 ****
- -- C35503C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
- --     THE PREFIX IS AN INTEGER TYPE.
- --     SUBTESTS ARE :
- --         PART (A). TESTS FOR 'IMAGE'.
- --         PART (B). TESTS FOR 'VALUE'.
- 
- -- HISTORY:
- --     RJW  03/17/86  CREATED ORIGINAL TEST.
- --     VCL  10/23/87  MODIFIED THIS HEADER, ADDED A CHECK THAT
- --                    CONSTRAINT_ERROR IS RAISED FOR THE ATTRIBUTE
- --                    'VALUE' IF THE FINAL SHARP OR COLON IS MISSING
- --                    FROM A BASED LITERAL.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35503C IS
-      TYPE NEWINT IS NEW INTEGER;
-      TYPE INT IS RANGE -1000 .. 1000;
- 
-      FUNCTION IDENT (X : INT) RETURN INT IS
-      BEGIN
-           IF EQUAL (INT'POS (X), INT'POS(X)) THEN
-                RETURN X;
-           END IF;
-           RETURN INT'FIRST;
-      END IDENT;
- 
- BEGIN
-      TEST ("C35503C", "THE ATTIBUTES 'IMAGE' AND 'VALUE' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
-                       "INTEGER TYPE" );
- -- PART (A).
- 
-      BEGIN
-           IF INTEGER'IMAGE (-500) /= "-500" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-500'" );
-           END IF;
-           IF INTEGER'IMAGE (-500)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-500'" );
-           END IF;
- 
-           IF NEWINT'IMAGE (2 ** 6) /= " 64" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '2 ** 6'" );
-           END IF;
-           IF NEWINT'IMAGE (2 ** 6)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '2 ** 6'" );
-           END IF;
- 
-           IF NATURAL'IMAGE (-1E2) /= "-100" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-1E2'" );
-           END IF;
-           IF NATURAL'IMAGE (-1E2)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-1E2'" );
-           END IF;
- 
-           IF NEWINT'IMAGE (3_45) /= " 345" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '3_45'" );
-           END IF;
-           IF NEWINT'IMAGE (3_45)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '3_45'" );
-           END IF;
- 
-           IF INTEGER'IMAGE (-2#1111_1111#) /= "-255" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-2#1111_1111#'" );
-           END IF;
-           IF INTEGER'IMAGE (-2#1111_1111#)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-2#1111_1111#'" );
-           END IF;
- 
-           IF NEWINT'IMAGE (16#FF#) /= " 255" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '16#FF#'" );
-           END IF;
-           IF NEWINT'IMAGE (16#FF#)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '16#FF#'" );
-           END IF;
- 
-           IF INTEGER'IMAGE (-016#0FF#) /= "-255" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-016#0FF#'" );
-           END IF;
-           IF INTEGER'IMAGE (-016#0FF#)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-016#0FF#'" );
-           END IF;
- 
-           IF NEWINT'IMAGE (2#1110_0000#) /= " 224" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '2#1110_0000#'" );
-           END IF;
-           IF NEWINT'IMAGE (2#1110_0000#)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '2#1110_0000#'" );
-           END IF;
- 
-           IF POSITIVE'IMAGE (-16#E#E1) /= "-224" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-16#E#E1'" );
-           END IF;
-           IF POSITIVE'IMAGE (-16#E#E1)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-16#E#E1'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(-1000)) /= "-1000" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-1000'" );
-           END IF;
-           IF INT'IMAGE (IDENT(-1000))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-1000'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(-999)) /= "-999" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-999'" );
-           END IF;
-           IF INT'IMAGE (IDENT(-999))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-999'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(-10)) /= "-10" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-1000'" );
-           END IF;
-           IF INT'IMAGE (IDENT(-10))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-10'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(-9)) /= "-9" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-9'" );
-           END IF;
-           IF INT'IMAGE (IDENT(-9))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-9'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(-1)) /= "-1" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '-1'" );
-           END IF;
-           IF INT'IMAGE (IDENT(-1))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '-1'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(0)) /= " 0" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '0'" );
-           END IF;
-           IF INT'IMAGE (IDENT(0))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '0'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(1)) /= " 1" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '1'" );
-           END IF;
-           IF INT'IMAGE (IDENT(1))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '1'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(9)) /= " 9" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '9'" );
-           END IF;
-           IF INT'IMAGE (IDENT(9))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '9'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(10)) /= " 10" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '10'" );
-           END IF;
-           IF INT'IMAGE (IDENT(10))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '10'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(999)) /= " 999" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '999'" );
-           END IF;
-           IF INT'IMAGE (IDENT(999))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '999'" );
-           END IF;
- 
-           IF INT'IMAGE (IDENT(1000)) /= " 1000" THEN
-                FAILED ( "INCORRECT 'IMAGE' OF '1000'" );
-           END IF;
-           IF INT'IMAGE (IDENT(1000))'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR '1000'" );
-           END IF;
- 
-      END;
- 
- -----------------------------------------------------------------------
- 
- -- PART (B).
- 
-      BEGIN
-           IF POSITIVE'VALUE (IDENT_STR("-500")) /= -500 THEN
-                FAILED ( "INCORRECT 'VALUE' OF ""-500""" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""-500""" );
-      END;
- 
-      BEGIN
-           IF NEWINT'VALUE (" -001E2") /= -100 THEN
-                FAILED ( "INCORRECT 'VALUE' OF "" -001E2""" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF "" -001E2""" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE ("03_45") /= 345 THEN
-                FAILED ( "INCORRECT 'VALUE' OF ""03_45""" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""03_45""" );
-      END;
- 
-      BEGIN
-           IF NEWINT'VALUE ("-2#1111_1111#") /= -255 THEN
-                FAILED ( "INCORRECT 'VALUE' OF ""-2#1111_1111#""" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF "&
-                         """-2#1111_1111#""" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("16#FF#")) /= 255 THEN
-                FAILED ( "INCORRECT 'VALUE' OF ""16#FF#""" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""16#FF#""" );
-      END;
- 
-      BEGIN
-           IF NATURAL'VALUE (IDENT_STR("-016#0FF#")) /= -255 THEN
-                FAILED ( "INCORRECT 'VALUE' OF ""-016#0FF#""" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
-                         """-016#0FF#""" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE ("2#1110_0000#     ") /= 224 THEN
-                FAILED ( "INCORRECT 'VALUE' OF " &
-                         """2#1110_0000#     """ );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
-                         """2#1110_0000#     """ );
-      END;
- 
-      BEGIN
-           IF NEWINT'VALUE ("  -16#E#E1") /= -224 THEN
-                FAILED ( "INCORRECT 'VALUE' OF ""  -16#E#E1""" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
-                         """  -16#E#E1""" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE ("5/0") = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED - ""5/0"" - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - ""5/0"" - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - ""5/0""" );
-      END;
- 
-      DECLARE
-           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 10;
-      BEGIN
-           IF SUBINT'VALUE (IDENT_STR("-500")) /= -500 THEN
-                FAILED ( "INCORRECT VALUE WITH ""-500"" AND SUBINT" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - SUBINT" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("1.0")) = 1 THEN
-                FAILED ( "NO EXCEPTION RAISED - "" 1.0"" - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - ""1.0"" - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - ""1.0"" " );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_CHAR(ASCII.HT) & "244") /= 244 THEN
-                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE ("244" & (IDENT_CHAR(ASCII.HT))) /= 244 THEN
-                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("2__44")) /= 244 THEN
-                FAILED ( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "WITH CONSECUTIVE '_'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("_244")) /= 244 THEN
-                FAILED ( "NO EXCEPTION RAISED - LEADING '_' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - LEADING '_' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - LEADING '_'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("244_")) /= 244 THEN
-                FAILED ( "NO EXCEPTION RAISED - TRAILING '_' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - TRAILING '_' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - TRAILING '_'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("244_E1")) /= 2440 THEN
-                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - '_' BEFORE 'E'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("244E_1")) /= 2440 THEN
-                FAILED ( "NO EXCEPTION RAISED - '_' " &
-                         "FOLLOWING 'E' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - '_' FOLLOWING 'E' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "- '_' FOLLOWING 'E'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("244_e1")) /= 2440 THEN
-                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - '_' BEFORE 'e'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("16#_FF#")) /= 255 THEN
-                FAILED ( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
-                         "LITERAL - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
-                         "LITERAL - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "- LEADING '_' IN BASED LITERAL" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("1E-0")) /= 1 THEN
-                FAILED ( "NO EXCEPTION RAISED - NEGATIVE " &
-                         "EXPONENT - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - NEGATIVE EXPONENT - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "- NEGATIVE EXPONENT" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("244.")) /= 244 THEN
-                FAILED ( "NO EXCEPTION RAISED - TRAILING '.' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - TRAILING '.' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - TRAILING '.'" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("8#811#")) /= 0 THEN
-                FAILED ( "NO EXCEPTION RAISED - " &
-                         "DIGITS NOT IN CORRECT RANGE - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - " &
-                         "DIGITS NOT IN CORRECT RANGE - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - " &
-                         "DIGITS NOT IN CORRECT RANGE" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("1#000#")) /= 0 THEN
-                FAILED ( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "- BASE LESS THAN 2" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("17#0#")) /= 0 THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "- BASE GREATER THAN 16 - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "- BASE GREATER THAN 16 - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "- BASE GREATER THAN 16" );
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("8#666")) /= 438 THEN
-                FAILED ("NO EXCEPTION RAISED - MISSING FINAL SHARP - 1");
-           ELSE
-                FAILED ("NO EXCEPTION RAISED - MISSING FINAL SHARP - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - MISSING FINAL SHARP");
-      END;
- 
-      BEGIN
-           IF INTEGER'VALUE (IDENT_STR("16:FF")) /= 255 THEN
-                FAILED ("NO EXCEPTION RAISED - MISSING FINAL COLON - 1");
-           ELSE
-                FAILED ("NO EXCEPTION RAISED - MISSING FINAL COLON - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - MISSING FINAL COLON");
-      END;
- 
-      RESULT;
- END C35503C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503d.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503d.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503d.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C35503D.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
- --     LARGEST/SMALLEST INTEGER LITERAL FOR THE LONGEST INTEGER TYPE.
- 
- -- HISTORY:
- --     RJW 02/26/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503D IS
- 
-      TYPE INT IS RANGE MIN_INT .. MAX_INT;
- 
-      FUNCTION IDENT (X:INT) RETURN INT IS
-           BEGIN
-                IF EQUAL (3,3) THEN
-                     RETURN X;
-                END IF;
-                RETURN 0;
-           END IDENT;
- 
- BEGIN
-      TEST ("C35503D", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
-                       "CORRECT RESULTS FOR THE LARGEST/SMALLEST "&
-                       "INTEGER LITERAL FOR THE LARGEST INTEGER TYPE");
- 
-      -- MIN_INT IS THE DECIMAL LITERAL FOR SYSTEM.MIN_INT.
-      -- MAX_INT IS THE DECIMAL LITERAL FOR SYSTEM.MAX_INT.
- 
-      BEGIN
-           IF INT'VALUE (IDENT_STR("$MIN_INT")) /= MIN_INT THEN
-                FAILED("INCORRECT RESULTS FOR 'VALUE' - MIN_INT");
-           END IF;
-      EXCEPTION
-            WHEN CONSTRAINT_ERROR =>
-                FAILED("CONSTRAINT_ERROR RAISED FOR 'VALUE' - MIN_INT");
-            WHEN OTHERS =>
-                FAILED("OTHER EXCEPTION RAISED FOR 'VALUE' - MIN_INT");
-      END;
- 
-      BEGIN
-            IF INT'IMAGE (IDENT(MIN_INT)) /= "$MIN_INT" THEN
-                 FAILED("INCORRECT RESULTS FOR 'IMAGE' - MIN_INT");
-            END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("EXCEPTION RAISED FOR 'IMAGE' - MIN_INT");
-      END;
- 
-      BEGIN
-            IF INT'VALUE (IDENT_STR("$MAX_INT")) /= MAX_INT THEN
-                FAILED("INCORRECT RESULTS FOR 'VALUE' - MAX_INT");
-            END IF;
-      EXCEPTION
-            WHEN CONSTRAINT_ERROR =>
-                FAILED("CONSTRAINT_ERROR RAISED FOR 'VALUE' - MAX_INT");
-            WHEN OTHERS =>
-                FAILED("OTHER EXCEPTION RAISED FOR 'VALUE' - MAX_INT");
-      END;
- 
-      BEGIN
-            IF INT'IMAGE (IDENT(MAX_INT)) /= ' ' & "$MAX_INT" THEN
-                FAILED("INCORRECT RESULTS FOR 'IMAGE' - MAXINT");
-            END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("EXCEPTION RAISED FOR 'IMAGE' - MAXINT");
-      END;
- 
-      RESULT;
- END C35503D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,212 ****
- -- C35503E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
- --     THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL
- --     PARAMETER IS AN INTEGER TYPE.
- --     SUBTESTS ARE :
- --         PART (A). TESTS FOR 'IMAGE'.
- --         PART (B). TESTS FOR 'VALUE'.
- 
- -- HISTORY:
- --     RJW 03/17/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503E IS
- 
- BEGIN
-      TEST ("C35503E", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE " &
-                       "CORRECT RESULTS  WHEN THE PREFIX IS A " &
-                       "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
-                       "PARAMETER IS AN INTEGER TYPE" );
- -- PART (A).
- 
-      DECLARE
-           TYPE NEWINT IS NEW INTEGER RANGE -2000 .. 2000;
- 
-           GENERIC
-                TYPE INT IS (<>);
-           PROCEDURE P (I1 : INT; STR : STRING );
- 
-           PROCEDURE P (I1 : INT; STR : STRING) IS
-                SUBTYPE SUBINT IS INT
-                RANGE INT'VAL (IDENT_INT(-1000)) ..
-                                               INT'VAL (IDENT_INT(1000));
-           BEGIN
- 
-                IF INT'IMAGE (I1) /= STR THEN
-                     FAILED ( "INCORRECT INT'IMAGE OF " & STR );
-                END IF;
-                IF INT'IMAGE (I1)'FIRST /= 1 THEN
-                     FAILED ( "INCORRECT LOWER BOUND FOR INT'IMAGE OF " &
-                              STR );
-                END IF;
- 
-                IF SUBINT'IMAGE (I1) /= STR THEN
-                     FAILED ( "INCORRECT SUBINT'IMAGE OF " & STR );
-                END IF;
-                IF SUBINT'IMAGE (I1)'FIRST /= 1 THEN
-                     FAILED ( "INCORRECT LOWER BOUND FOR SUBINT'IMAGE " &
-                              "OF " & STR );
-                END IF;
- 
-           END P;
- 
-           PROCEDURE PROC1 IS NEW P (INTEGER);
-           PROCEDURE PROC2 IS NEW P (NEWINT);
- 
-      BEGIN
-           PROC1 (-500, "-500");
-           PROC2 (0, " 0");
-           PROC2 (99," 99");
-      END;
- 
- -----------------------------------------------------------------------
- 
- -- PART (B).
- 
-      DECLARE
-           TYPE NEWINT IS NEW INTEGER;
- 
-           GENERIC
-                TYPE INT IS (<>);
-           PROCEDURE P (STR : STRING; I1 : INT );
- 
-           PROCEDURE P (STR : STRING; I1 : INT) IS
-                SUBTYPE SUBINT IS INT
-                     RANGE INT'VAL (IDENT_INT(0)) ..
-                                                 INT'VAL (IDENT_INT(10));
- 
-           BEGIN
-                BEGIN
-                     IF INT'VALUE (STR) /= I1 THEN
-                          FAILED ( "INCORRECT INT'VALUE OF """ &
-                                   STR & """");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED INT'VALUE OF """ &
-                                   STR & """");
-                END;
-                BEGIN
-                     IF SUBINT'VALUE (STR) /= I1 THEN
-                          FAILED ( "INCORRECT SUBINT'VALUE OF """ &
-                                   STR & """");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED SUBINT'VALUE " &
-                                   "OF """ & STR & """");
-                END;
-           END P;
- 
-           PROCEDURE PROC1 IS NEW P (INTEGER);
-           PROCEDURE PROC2 IS NEW P (NEWINT);
- 
-      BEGIN
-                PROC1 ("-500" , -500);
-                PROC2 (" -001E2 " , -100);
-                PROC1 ("3_45" , 345);
-                PROC2 ("-2#1111_1111#" , -255);
-                PROC1 ("16#FF#" , 255);
-                PROC2 ("-016#0FF#" , -255);
-                PROC1 ("2#1110_0000#     " , 224);
-                PROC2 ("-16#E#E1" , -224);
- 
-      END;
- 
-      DECLARE
-           TYPE NEWINT IS NEW INTEGER;
- 
-           GENERIC
-                TYPE INT IS (<>);
-           PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING);
- 
-           PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING) IS
-                SUBTYPE SUBINT IS INT
-                     RANGE INT'VAL (IDENT_INT(0)) ..
-                                                 INT'VAL (IDENT_INT(10));
- 
-           BEGIN
-                BEGIN
-                     IF INT'VALUE (STR1) = I1 THEN
-                          FAILED ( "NO EXCEPTION RAISED - INT'VALUE " &
-                                   "WITH " & STR2 & " - EQUAL");
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED " &
-                                   "- INT'VALUE WITH " &
-                                   STR2 & " - NOT EQUAL" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED - " &
-                                   "INT'VALUE WITH " & STR2 );
-                END;
-                BEGIN
-                     IF SUBINT'VALUE (STR1) = I1 THEN
-                          FAILED ( "NO EXCEPTION RAISED - " &
-                                   "SUBINT'VALUE WITH " & STR2
-                                    & " - EQUAL" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED - " &
-                                   "SUBINT'VALUE WITH " &
-                                    STR2 & " - NOT EQUAL" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED  - " &
-                                   "SUBINT'VALUE WITH " & STR2 );
-                END;
-           END P;
- 
-           PROCEDURE PROC1 IS NEW P (INTEGER);
-           PROCEDURE PROC2 IS NEW P (NEWINT);
- 
-      BEGIN
-           PROC1 ("1.0"           , 1,      "DECIMAL POINT");
-           PROC1 (ASCII.HT & "244", 244,    "LEADING 'HT'" );
-           PROC2 ("244" & ASCII.HT, 244,    "TRAILING 'HT'" );
-           PROC1 ("2__44"         , 244,    "CONSECUTIVE '_'" );
-           PROC2 ("_244"          , 244,    "LEADING '_'" );
-           PROC1 ("244_"          , 244,    "TRAILING '_'" );
-           PROC2 ("244_E1"        , 2440,   "'_' BEFORE 'E'" );
-           PROC1 ("244E_1"        , 2440,   "'_' FOLLOWING 'E'" );
-           PROC2 ("244_e1"        , 2440,   "'_' BEFORE 'e'" );
-           PROC1 ("16#_FF#"       , 255,    "'_' IN BASED LITERAL" );
-           PROC2 ("1E-0"          ,   0,    "NEGATIVE EXPONENT" );
-           PROC1 ("244."          , 244,    "TRAILING '.'" );
-           PROC2 ("8#811#"        , 0,      "DIGITS OUTSIDE OF RANGE" );
-           PROC1 ("1#000#"        , 0,      "BASE LESS THAN 2" );
-           PROC2 ("17#0#"         , 0,      "BASE GREATER THAN 16" );
-      END;
- 
-      RESULT;
- END C35503E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503f.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503f.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503f.tst	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503f.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- C35503F.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
- --     LARGEST/SMALLEST INTEGER LITERAL AND A FORMAL DISCRETE TYPE WHOSE
- --     ACTUAL PARAMETER IS AN INTEGER TYPE.
- 
- -- HISTORY
- --     RJW 05/12/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503F IS
- 
- TYPE LONGEST_INT IS RANGE MIN_INT .. MAX_INT;
- 
- BEGIN
-      TEST ("C35503F", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
-                       "CORRECT RESULTS FOR THE LARGEST/SMALLEST "&
-                       "INTEGER LITERAL AND A FORMAL DISCRETE TYPE " &
-                       "WHOSE ACTUAL PARAMETER IS AN INTEGER TYPE");
- 
-      -- INTEGER_FIRST IS THE DECIMAL LITERAL IMAGE OF INTEGER'FIRST.
-      -- INTEGER_LAST IS THE DECIMAL LITERAL IMAGE OF INTEGER'LAST.
-      -- MIN_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MIN_INT.
-      -- MAX_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MAX_INT.
- 
-      DECLARE
-           GENERIC
-                TYPE INT IS (<>);
-           PROCEDURE P ( FS, LS : STRING; FI, LI : INT );
- 
-           PROCEDURE P ( FS, LS : STRING; FI, LI : INT ) IS
-           BEGIN
-                BEGIN
-                     IF INT'VALUE (FS) /= FI THEN
-                          FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
-                                   FS );
-                     END IF;
-                EXCEPTION
-                      WHEN CONSTRAINT_ERROR =>
-                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
-                                   "'VALUE' OF " & FS );
-                      WHEN OTHERS =>
-                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
-                                   "'VALUE' OF " & FS );
-                END;
- 
-                BEGIN
-                     IF INT'VALUE (LS) /= LI THEN
-                          FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
-                                   LS );
-                     END IF;
-                EXCEPTION
-                      WHEN CONSTRAINT_ERROR =>
-                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
-                                   "'VALUE' OF " & LS );
-                      WHEN OTHERS =>
-                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
-                                   "'VALUE' OF " & LS );
-                END;
-           END P;
- 
-           GENERIC
-                TYPE INT IS  (<>);
-           PROCEDURE Q ( FS, LS : STRING; FI, LI : INT );
- 
-           PROCEDURE Q ( FS, LS : STRING; FI, LI : INT ) IS
-           BEGIN
-                BEGIN
-                      IF INT'IMAGE(FI) /= FS THEN
-                           FAILED ( "INCORRECT RESULTS FOR " &
-                                    "'IMAGE' WITH " & FS );
-                      END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
-                                    "WITH " & FS );
-                END;
- 
-                BEGIN
-                      IF INT'IMAGE(LI) /= LS THEN
-                          FAILED ( "INCORRECT RESULTS FOR " &
-                                   "'IMAGE' WITH " & LS );
-                      END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
-                                   "WITH " & LS );
-                END;
-           END Q;
- 
-           PROCEDURE P1 IS NEW P ( INTEGER );
-           PROCEDURE Q1 IS NEW Q ( INTEGER );
-           PROCEDURE P2 IS NEW P ( LONGEST_INT );
-           PROCEDURE Q2 IS NEW Q ( LONGEST_INT );
-      BEGIN
-           P1 ("$INTEGER_FIRST", "$INTEGER_LAST", INTEGER'FIRST,
-                                                          INTEGER'LAST);
-           P2 ("$MIN_INT", "$MAX_INT", MIN_INT, MAX_INT);
-           Q1 ("$INTEGER_FIRST"," $INTEGER_LAST", INTEGER'FIRST,
-                                                          INTEGER'LAST);
-           Q2 ("$MIN_INT", " $MAX_INT", MIN_INT, MAX_INT);
- 
-      END;
- 
-      RESULT;
- END C35503F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C35503G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULT WHEN THE
- --     PREFIX IS AN INTEGER TYPE.
- 
- -- HISTORY:
- --     RJW 03/17/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503G IS
- 
- BEGIN
-      TEST ("C35503G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULT WHEN THE PREFIX IS AN " &
-                       "INTEGER TYPE" );
- 
-      DECLARE
-           TYPE INT IS RANGE -6 .. 6;
-           SUBTYPE SINT IS INT RANGE -4 .. 4;
- 
-      BEGIN
- 
-           FOR I IN INT'FIRST + 1 .. INT'LAST LOOP
-                BEGIN
-                     IF SINT'PRED (I) /= I - 1 THEN
-                          FAILED ( "WRONG SINT'PRED FOR " &
-                                   INT'IMAGE (I));
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR " &
-                                   "SINT'PRED OF " &
-                                   INT'IMAGE (I));
-                END;
-           END LOOP;
- 
-           FOR I IN INT'FIRST .. INT'LAST - 1 LOOP
-                BEGIN
-                     IF SINT'SUCC (I) /= I + 1 THEN
-                          FAILED ( "WRONG SINT'SUCC FOR " &
-                                   INT'IMAGE (I));
-                          END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR " &
-                                   "SINT'SUCC OF " &
-                                   INT'IMAGE (I));
-                END;
-           END LOOP;
- 
-      END;
- 
-      DECLARE
-           SUBTYPE INTRANGE IS INTEGER RANGE IDENT_INT(-6) ..
-                                                           IDENT_INT(6);
-           SUBTYPE SINTEGER IS INTEGER RANGE IDENT_INT(-4) ..
-                                                           IDENT_INT(4);
- 
-      BEGIN
-           FOR I IN INTRANGE LOOP
-                BEGIN
-                     IF SINTEGER'PRED (I) /= I - IDENT_INT(1) THEN
-                          FAILED ( "WRONG SINTEGER'PRED FOR " &
-                                   INTEGER'IMAGE (I));
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR " &
-                                   "SINTEGER'PRED OF " &
-                                   INTEGER'IMAGE (I));
-                END;
-                BEGIN
-                     IF SINTEGER'SUCC (I) /= I + IDENT_INT(1) THEN
-                          FAILED ( "WRONG SINTEGER'SUCC FOR " &
-                                   INTEGER'IMAGE (I));
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR " &
-                                   "SINTEGER'SUCC OF " &
-                                   INTEGER'IMAGE (I));
-                END;
-           END LOOP;
- 
-      END;
- 
-      RESULT;
- END C35503G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C35503H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULT WHEN THE
- --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
- --     IS AN INTEGER TYPE.
- 
- -- HISTORY:
- --     RJW 03/17/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503H IS
- 
- BEGIN
-      TEST ("C35503H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULT WHEN THE PREFIX IS A GENERIC " &
-                       "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
-                       "IS AN INTEGER TYPE" );
- 
-      DECLARE
-           TYPE INTRANGE IS RANGE -6 .. 6;
- 
-           GENERIC
-                TYPE INT IS (<>);
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                SUBTYPE SINT IS INT
-                     RANGE INT'VAL (IDENT_INT(-4)) ..
-                                                 INT'VAL (IDENT_INT(4));
-           BEGIN
-                FOR I IN INT'VAL (IDENT_INT(-6))  ..
-                                                 INT'VAL (IDENT_INT(6))
-                LOOP
-                     BEGIN
-                          IF SINT'PRED (I) /=
-                             SINT'VAL (SINT'POS (I) - 1) THEN
-                               FAILED ( "WRONG " & STR & "'PRED " &
-                                        "FOR " & INT'IMAGE (I) );
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ( "EXCEPTION RAISED FOR " &
-                                         STR & "'PRED OF " &
-                                         INT'IMAGE (I));
-                     END;
-                     BEGIN
-                          IF SINT'SUCC (I) /=
-                             SINT'VAL (SINT'POS (I) + 1) THEN
-                               FAILED ( "WRONG " & STR & "'SUCC " &
-                                        "FOR " &  INT'IMAGE (I));
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ( "EXCEPTION RAISED FOR " &
-                                         STR & "'SUCC OF " &
-                                         INT'IMAGE (I));
-                     END;
-                END LOOP;
-           END P;
- 
-           PROCEDURE PROC1 IS NEW P (INTRANGE);
-           PROCEDURE PROC2 IS NEW P (INTEGER);
-      BEGIN
-           PROC1 ("INTRANGE");
-           PROC2 ("INTEGER");
-      END;
- 
-      RESULT;
- END C35503H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503k.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C35503K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS AN INTEGER TYPE.
- 
- -- HISTORY:
- --     RJW 03/17/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     PWN 11/30/94 REMOVED ATTRIBUTE TESTS ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503K IS
- 
- BEGIN
-      TEST ("C35503K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
-                       "INTEGER TYPE" );
- 
-      DECLARE
-           TYPE INT IS RANGE -6 .. 6;
-           SUBTYPE SINT IS INT RANGE -4 .. 4;
- 
-           PROCEDURE P (I : INTEGER; STR : STRING) IS
-           BEGIN
-                BEGIN
-                     IF INTEGER'POS (I) /= I THEN
-                          FAILED ( "WRONG POS FOR " & STR);
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR POS OF " &
-                                    STR);
-                END;
-                BEGIN
-                     IF INTEGER'VAL (I) /= I THEN
-                          FAILED ( "WRONG VAL FOR " & STR);
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR VAL OF " &
-                                    STR);
-                END;
-           END P;
- 
-      BEGIN
-           P ( INTEGER'FIRST, "INTEGER'FIRST");
-           P ( INTEGER'LAST,  "INTEGER'LAST");
-           P ( 0, "'0'");
- 
-           FOR I IN INT'FIRST .. INT'LAST LOOP
-                BEGIN
-                     IF SINT'POS (I) /= I THEN
-                          FAILED ( "WRONG POS FOR "
-                                    & INT'IMAGE (I));
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR POS OF "
-                                   & INT'IMAGE (I));
-                END;
-                BEGIN
-                     IF SINT'VAL (I) /= I THEN
-                          FAILED ( "WRONG VAL FOR "
-                                   & INT'IMAGE (I));
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED FOR VAL OF "
-                                   & INT'IMAGE (I));
-                END;
-           END LOOP;
- 
-           BEGIN
-                IF INT'VAL (INTEGER'(0)) /= 0 THEN
-                     FAILED ( "WRONG VAL FOR INT WITH INTEGER" );
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED FOR VAL OF " &
-                              "INT WITH INTEGER" );
-           END;
- 
-           BEGIN
-                IF INTEGER'VAL (INT'(0)) /= 0 THEN
-                     FAILED ( "WRONG VAL FOR INTEGER WITH INT" );
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED FOR VAL OF " &
-                              "INTEGER WITH INT" );
-           END;
-      END;
- 
-      RESULT;
- END C35503K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C35503L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
- --     IS AN INTEGER TYPE.
- 
- -- HISTORY:
- --     RJW 03/17/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503L IS
- 
- BEGIN
-      TEST ("C35503L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "GENERIC FORMAL DISCRETE TYPE WHOSE " &
-                       "ACTUAL PARAMETER IS AN INTEGER TYPE" );
- 
-      DECLARE
-           TYPE INTRANGE IS RANGE -6 .. 6;
- 
-           GENERIC
-                TYPE INT IS (<>);
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                SUBTYPE SINT IS INT RANGE
-                    INT'VAL (IDENT_INT(-4)) .. INT'VAL (IDENT_INT(4));
-                I :INTEGER;
-           BEGIN
-                I := IDENT_INT(-6);
-                FOR S IN INT'VAL (IDENT_INT(-6)) ..
-                                                  INT'VAL (IDENT_INT(6))
-                LOOP
-                     BEGIN
-                          IF SINT'POS (S) /= I THEN
-                               FAILED ( "WRONG VALUE FOR " &
-                                         STR & "'POS OF "
-                                        & INT'IMAGE (S) );
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ( "EXCEPTION RAISED FOR " &
-                                         STR & "'POS "
-                                        & "OF " & INT'IMAGE (S) );
-                     END;
-                     BEGIN
-                          IF SINT'VAL (I) /= S THEN
-                               FAILED ( "WRONG VALUE FOR " &
-                                         STR & "'VAL "
-                                        & "OF " & INT'IMAGE (S) );
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ( "EXCEPTION RAISED FOR " &
-                                         STR & "'VAL "
-                                        & "OF " & INT'IMAGE (S) );
-                     END;
-                     I := I + 1;
-                END LOOP;
-           END P;
- 
-           PROCEDURE P1 IS NEW P (INTRANGE);
-           PROCEDURE P2 IS NEW P (INTEGER);
- 
-      BEGIN
-           P1 ("INTRANGE");
-           P2 ("INTEGER");
-      END;
- 
-      RESULT;
- 
- END C35503L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503o.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C35503O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS AN INTEGER TYPE.
- 
- -- HISTORY:
- --     RJW 03/17/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503O IS
- 
- BEGIN
-      TEST ("C35503O", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
-                       "INTEGER TYPE" );
- 
-      DECLARE
-           SUBTYPE SINTEGER IS INTEGER;
-           SUBTYPE SMALL IS INTEGER RANGE IDENT_INT(-10) ..
-                                                          IDENT_INT(10);
-           SUBTYPE NOINTEGER IS INTEGER
-             RANGE IDENT_INT(5) .. IDENT_INT(-7);
- 
-           TYPE INT IS RANGE -6 .. 6;
-           SUBTYPE SINT IS INT
-             RANGE INT(IDENT_INT(-4)) .. INT(IDENT_INT(4));
-           SUBTYPE NOINT IS INT
-             RANGE INT(IDENT_INT(1)) .. INT(IDENT_INT(-1));
-           TYPE NEWINT IS NEW INTEGER RANGE IDENT_INT(-9) ..
-                                                           IDENT_INT(-2);
-           SUBTYPE SNEWINT IS NEWINT RANGE -7 .. -5;
-           SUBTYPE NONEWINT IS NEWINT RANGE 3 .. -15;
- 
-      BEGIN
-           IF SINTEGER'FIRST /= INTEGER'FIRST THEN
-                FAILED ( "WRONG VALUE FOR SINTEGER'FIRST" );
-           END IF;
-           IF SINTEGER'LAST /= INTEGER'LAST THEN
-                FAILED ( "WRONG VALUE FOR SINTEGER'LAST" );
-           END IF;
- 
-           IF SMALL'FIRST /= -10 THEN
-                FAILED ( "WRONG VALUE FOR SMALL'FIRST" );
-           END IF;
-           IF SMALL'LAST /= 10 THEN
-                FAILED ( "WRONG VALUE FOR SMALL'LAST" );
-           END IF;
- 
-           IF NOINTEGER'FIRST /= 5 THEN
-                FAILED ( "WRONG VALUE FOR NOINTEGER'FIRST" );
-           END IF;
-           IF NOINTEGER'LAST /= -7 THEN
-                FAILED ( "WRONG VALUE FOR NOINTEGER'LAST" );
-           END IF;
- 
-           IF INT'FIRST /= -6 THEN
-                FAILED ( "WRONG VALUE FOR INT'FIRST" );
-           END IF;
-           IF INT'LAST /= 6 THEN
-                FAILED ( "WRONG VALUE FOR INT'LAST" );
-           END IF;
- 
-           IF SINT'FIRST /= -4 THEN
-                FAILED ( "WRONG VALUE FOR SINT'FIRST" );
-           END IF;
-           IF SINT'LAST /= 4 THEN
-                FAILED ( "WRONG VALUE FOR SINT'LAST" );
-           END IF;
- 
-           IF NOINT'FIRST /= 1 THEN
-                FAILED ( "WRONG VALUE FOR NOINT'FIRST" );
-           END IF;
-           IF NOINT'LAST /= -1 THEN
-                FAILED ( "WRONG VALUE FOR NOINT'LAST" );
-           END IF;
- 
-           IF NEWINT'FIRST /= -9 THEN
-                FAILED ( "WRONG VALUE FOR NEWINT'FIRST" );
-           END IF;
-           IF NEWINT'LAST /= -2 THEN
-                FAILED ( "WRONG VALUE FOR NEWINT'LAST" );
-           END IF;
- 
-           IF SNEWINT'FIRST /= -7 THEN
-                FAILED ( "WRONG VALUE FOR SNEWINT'FIRST" );
-           END IF;
-           IF SNEWINT'LAST /= -5 THEN
-                FAILED ( "WRONG VALUE FOR SNEWINT'LAST" );
-           END IF;
- 
-           IF NONEWINT'FIRST /= 3 THEN
-                FAILED ( "WRONG VALUE FOR NONEWINT'FIRST" );
-           END IF;
-           IF NONEWINT'LAST /= -15 THEN
-                FAILED ( "WRONG VALUE FOR NONEWINT'LAST" );
-           END IF;
-      END;
- 
-      RESULT;
- END C35503O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35503p.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35503p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C35503P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ARGUMENT IS AN
- --     INTEGER TYPE.
- 
- -- HISTORY:
- --     RJW 03/24/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35503P IS
- 
- BEGIN
-      TEST ("C35503P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "GENERIC FORMAL DISCRETE TYPE WHOSE ARGUMENT " &
-                       "IS AN INTEGER TYPE" );
- 
- 
-      DECLARE
- 
-           TYPE INT IS RANGE -6 .. 6;
-           SUBTYPE SINT IS INT RANGE INT(IDENT_INT(-4)) ..
-                                                      INT(IDENT_INT(4));
-           SUBTYPE NOINT IS INT RANGE INT(IDENT_INT(1)) ..
-                                                     INT(IDENT_INT(-1));
- 
-           GENERIC
-                TYPE I IS (<>);
-                F, L : I;
-           PROCEDURE P ( STR : STRING );
- 
-           PROCEDURE P ( STR : STRING ) IS
-           BEGIN
-                IF I'FIRST /= F THEN
-                     FAILED ( "INCORRECT 'FIRST' FOR " & STR );
-                END IF;
-                IF I'LAST /= L THEN
-                     FAILED ( "INCORRECT 'LAST' FOR " & STR );
-                END IF;
-           END P;
- 
-           GENERIC
-                TYPE I IS (<>);
-                F, L : I;
-           PROCEDURE Q;
- 
-           PROCEDURE Q IS
-                SUBTYPE SI IS I;
-           BEGIN
-                IF SI'FIRST /= F THEN
-                     FAILED ( "INCORRECT VALUE FOR INTEGER'FIRST" );
-                END IF;
-                IF SI'LAST /= L THEN
-                     FAILED ( "INCORRECT VALUE FOR INTEGER'LAST" );
-                END IF;
-           END Q;
- 
-           GENERIC
-                TYPE I IS (<>);
-           PROCEDURE R;
- 
-           PROCEDURE R IS
-                SUBTYPE SI IS I;
-           BEGIN
-                IF SI'FIRST /= SI'VAL (IDENT_INT(1)) THEN
-                     FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
-                END IF;
-                IF SI'LAST /= SI'VAL (IDENT_INT(-1)) THEN
-                     FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
-                END IF;
-           END R;
- 
-           PROCEDURE P1 IS NEW P ( I => INT, F => -6, L => 6 );
-           PROCEDURE P2 IS NEW P ( I => SINT, F => -4, L => 4 );
-           PROCEDURE Q1 IS NEW Q
-                ( I => INTEGER, F => INTEGER'FIRST, L => INTEGER'LAST );
-           PROCEDURE R1 IS NEW R ( I => NOINT);
- 
-      BEGIN
-           P1 ( "INT" );
-           P2 ( "SINT" );
-           Q1;
-           R1;
-      END;
- 
-      RESULT;
- END C35503P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35504a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35504a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35504a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35504a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- C35504A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE USER-DEFINED 
- -- ENUMERATION ARGUMENT TO 'SUCC, 'PRED, 'POS, 'VAL, 'IMAGE, AND 'VALUE
- -- IS NOT IN THE ATTRIBUTED SUBTYPE'S RANGE CONSTRAINT.
- 
- -- DAT 3/18/81
- -- SPS 01/13/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35504A IS
- 
-      TYPE E IS (A, 'A', B, 'B', C, 'C', D, 'D', XYZ);
- 
-      SUBTYPE S IS E RANGE B .. C;
- 
- BEGIN
-      TEST ("C35504A", "CONSTRAINT_ERROR IS NOT RAISED IN T'SUCC(X),"
-           & " T'PRED(X), T'POS(X), T'VAL(X), T'IMAGE(X), AND"
-           & " T'VALUE(X) WHEN THE VALUES ARE NOT WITHIN T'S"
-           & " RANGE CONSTRAINT, FOR USER-DEFINED ENUMERATION TYPES");
- 
-      BEGIN
-           FOR X IN E LOOP
-                IF (X /= A AND THEN S'SUCC(S'PRED(X)) /= X)
-                OR (X /= XYZ AND THEN S'PRED(S'SUCC(X)) /= X)
-                OR S'VAL(S'POS(X)) /= X
-                OR S'VALUE(S'IMAGE(X)) /= X
-                THEN
-                     FAILED ("WRONG ATTRIBUTE VALUE");
-                END IF;
-           END LOOP;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR RAISED"
-                     & " WHEN IT SHOULDN'T HAVE BEEN");
-           WHEN OTHERS => FAILED ("INCORRECT EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C35504A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35504b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35504b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35504b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35504b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C35504B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR I'SUCC, I'PRED,
- -- I'POS, I'VAL, I'IMAGE, AND I'VALUE FOR INTEGER ARGUMENTS
- -- OUTSIDE THE RANGE OF I.
- 
- -- DAT 3/30/81
- -- SPS 01/13/83
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE C35504B IS
- 
-      SUBTYPE I IS INTEGER RANGE 0 .. 0;
- 
- BEGIN
-      TEST ("C35504B", "CONSTRAINT_ERROR IS NOT RAISED FOR"
-           & " INTEGER SUBTYPE ATTRIBUTES 'SUCC, 'PRED, 'POS, 'VAL,"
-           & " 'IMAGE, AND 'VALUE WHOSE ARGUMENTS ARE OUTSIDE THE"
-           & " SUBTYPE");
- 
-      BEGIN
-           IF I'SUCC(-1) /= I'PRED(1)
-           THEN
-                FAILED ("WRONG ATTRIBUTE VALUE - 1");
-           END IF;
- 
-           IF I'SUCC (100) /= 101
-           THEN
-                FAILED ("WRONG ATTRIBUTE VALUE - 2");
-           END IF;
- 
-           IF I'PRED (100) /= 99
-           THEN
-                FAILED ("WRONG ATTRIBUTE VALUE - 3");
-           END IF;
- 
-           IF I'POS (-100) /= -100
-           THEN
-                FAILED ("WRONG ATTRIBUTE VALUE - 4");
-           END IF;
- 
-           IF I'VAL(-100) /= -100
-           THEN
-                FAILED ("WRONG ATTRIBUTE VALUE - 5");
-           END IF;
- 
-           IF I'IMAGE(1234) /= " 1234"
-           THEN
-                FAILED ("WRONG ATTRIBUTE VALUE - 6");
-           END IF;
- 
-           IF I'VALUE("999") /= 999
-           THEN
-                FAILED ("WRONG ATTRIBUTE VALUE - 7");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C35504B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35505c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35505c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35505c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35505c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C35505C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR 'SUCC' AND 'PRED',
- --     IF THE RETURNED VALUES WOULD BE OUTSIDE OF THE BASE TYPE,
- --     WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT
- --     IS A USER-DEFINED ENUMERATION TYPE.
- 
- -- HISTORY:
- --     RJW 06/05/86  CREATED ORIGINAL TEST.
- --     VCL 08/19/87  REMOVED THE FUNCTION 'IDENT' IN THE GENERIC
- --                   PROCEDURE 'P' AND REPLACED ALL CALLS TO 'IDENT'
- --                   WITH "T'VAL(IDENT_INT(T'POS(...)))".
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35505C IS
- 
-      TYPE B IS ('Z', 'X', Z, X);
- 
-      SUBTYPE C IS B RANGE 'X' .. Z;
- 
- BEGIN
-      TEST ( "C35505C", "CHECK THAT 'SUCC' AND 'PRED' RAISE " &
-                        "CONSTRAINT_ERROR APPROPRIATELY WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ARGUMENT IS A USER-DEFINED ENUMERATION TYPE" );
- 
-      DECLARE
-           GENERIC
-                TYPE T IS (<>);
-                STR : STRING;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
- 
-           BEGIN
-                BEGIN
-                     IF T'PRED (T'VAL (IDENT_INT (T'POS
-                               (T'BASE'FIRST)))) = T'FIRST THEN
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'PRED -  1" );
-                     ELSE
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'PRED -  2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'PRED - 1" );
-                END;
- 
-                BEGIN
-                     IF T'SUCC (T'VAL (IDENT_INT (T'POS
-                               (T'BASE'LAST)))) = T'LAST THEN
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'SUCC -  1" );
-                     ELSE
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'SUCC -  2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'SUCC - 1" );
-                END;
-           END P;
- 
-           PROCEDURE PB IS NEW P (B, "B");
-           PROCEDURE PC IS NEW P (C, "C");
-      BEGIN
-           PB;
-           PC;
-      END;
- RESULT;
- END C35505C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35505e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35505e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35505e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35505e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- C35505E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR 'SUCC' AND 'PRED',
- --     IF THE RESULT WOULD BE OUTSIDE THE RANGE OF THE BASE TYPE,
- --     WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT
- --     IS TYPE CHARACTER OR A SUBTYPE OF TYPE CHARACTER.
- 
- -- HISTORY:
- --     DWC 07/01/87
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35505E IS
- 
-      TYPE CHAR IS ('A', B, C);
-      SUBTYPE NEWCHAR IS CHAR;
- 
- BEGIN
-      TEST ( "C35505E", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
-                        "'SUCC' AND 'PRED', IF THE RESULT WOULD BE " &
-                        "OUTSIDE THE RANGE OF THE BASE TYPE, WHEN " &
-                        "THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ACTUAL ARGUMENT IS A CHARACTER TYPE ");
- 
-      DECLARE
-           GENERIC
-                TYPE SUBCH IS (<>);
-                STR : STRING;
-                I1, I2 : INTEGER;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
- 
-                FUNCTION IDENT (C : SUBCH) RETURN SUBCH IS
-                BEGIN
-                     RETURN SUBCH'VAL (IDENT_INT (SUBCH'POS (C)));
-                END IDENT;
- 
-           BEGIN
-                BEGIN
-                     IF SUBCH'PRED (SUBCH'BASE'FIRST) = SUBCH'VAL (0)
-                          THEN
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'PRED -  1" );
-                     ELSE
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'PRED -  2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'PRED - 1" );
-                END;
- 
-                BEGIN
-                     IF SUBCH'SUCC (SUBCH'BASE'LAST) = SUBCH'VAL (0) THEN
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'SUCC -  1" );
-                     ELSE
-                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
-                                    STR & "'SUCC -  2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'SUCC - 1" );
-                END;
- 
-                BEGIN
-                     IF SUBCH'PRED (IDENT (SUBCH'BASE'FIRST)) =
-                        SUBCH'VAL (I1) THEN
-                          FAILED ( "NO EXCEPTION RAISED " &
-                                   "FOR " & STR & "'PRED " &
-                                   "(IDENT (SUBCH'BASE'FIRST)) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED " &
-                                   "FOR " & STR & "'PRED " &
-                                   "(IDENT (SUBCH'BASE'FIRST)) - 2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED " &
-                                   "FOR " & STR & "'PRED " &
-                                   "(IDENT (SUBCH'BASE'FIRST))" );
-                END;
- 
-                BEGIN
-                     IF SUBCH'SUCC (IDENT(SUBCH'BASE'LAST)) =
-                        SUBCH'VAL (I2) THEN
-                          FAILED ( "NO EXCEPTION RAISED " &
-                                   "FOR " & STR & "'SUCC " &
-                                   "(IDENT (SUBCH'BASE'LAST)) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED " &
-                                   "FOR " & STR & "'SUCC " &
-                                   "(IDENT (SUBCH'BASE'LAST)) - 2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED " &
-                                   "FOR " & STR & "'SUCC " &
-                                   "(IDENT (SUBCH'BASE'LAST))" );
-                END;
-           END P;
- 
-           PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR", 0, 1);
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
-      BEGIN
-           PCHAR;
-           PNCHAR;
-      END;
- RESULT;
- END C35505E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35505f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35505f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35505f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35505f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C35505F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT ERROR IS RAISED BY THE ATTRIBUTES
- --     'PRED' AND 'SUCC' WHEN THE PREFIX IS A CHARACTER TYPE
- --     AND THE RESULT IS OUTSIDE OF THE BASE TYPE.
- 
- -- HISTORY:
- --     JET 08/18/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35505F  IS
- 
-      TYPE CHAR IS ('A', B);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
-      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
-      BEGIN
-           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
-      END;
- 
-      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
-      BEGIN
-           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
-      END;
- 
- BEGIN
- 
-      TEST( "C35505F" , "CHECK THAT CONSTRAINT ERROR IS RAISED BY " &
-                        "THE ATTRIBUTES 'PRED' AND 'SUCC' WHEN THE " &
-                        "PREFIX IS A CHARACTER TYPE AND THE RESULT " &
-                        "IS OUTSIDE OF THE BASE TYPE" );
- 
-      BEGIN
-           IF CHAR'PRED (IDENT ('A')) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'PRED (IDENT ('A')) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'PRED (IDENT ('A')) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHAR'PRED (IDENT ('A'))" );
-      END;
- 
-      BEGIN
-           IF CHAR'SUCC (IDENT (B)) = B THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'SUCC (IDENT (B)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'SUCC (IDENT (B)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHAR'SUCC (IDENT (B))" );
-      END;
- 
-      BEGIN
-           IF NEWCHAR'PRED (IDENT ('A')) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'PRED (IDENT ('A')) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'PRED (IDENT ('A')) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR NEWCHAR'PRED (IDENT ('A'))" );
-      END;
- 
-      BEGIN
-           IF NEWCHAR'SUCC (IDENT (B)) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'SUCC (IDENT (B)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'SUCC (IDENT (B)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR NEWCHAR'SUCC (IDENT (B))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'PRED (IDENT_CHAR (CHARACTER'BASE'FIRST)) = 'A'
-              THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHARACTER'PRED " &
-                         "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHARACTER'PRED " &
-                         "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'PRED " &
-                         "(IDENT_CHAR (CHARACTER'BASE'FIRST))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'SUCC (IDENT_CHAR (CHARACTER'BASE'LAST)) = 'Z'
-              THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHARACTER'SUCC " &
-                         "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHARACTER'SUCC " &
-                         "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'SUCC " &
-                         "(IDENT_CHAR (CHARACTER'BASE'LAST))" );
-      END;
- 
-      RESULT;
- 
- END C35505F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- C35507A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
- -- WHEN THE PREFIX IS A CHARACTER TYPE.   
- 
- -- RJW 5/29/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507A  IS
- 
- BEGIN
- 
-      TEST( "C35507A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
-                        "THE CORRECT RESULTS WHEN THE PREFIX " &
-                        "IS A CHARACTER TYPE" );
- 
-      DECLARE
-           TYPE CHAR1 IS (A, 'A');
- 
-           SUBTYPE CHAR2 IS CHARACTER RANGE 'A' .. 'Z';
- 
-           SUBTYPE NOCHAR IS CHARACTER RANGE 'Z' .. 'A';
-           
-           TYPE NEWCHAR IS NEW CHARACTER 
-                     RANGE 'A' .. 'Z';
- 
-      BEGIN
-           IF CHAR1'WIDTH /= 3 THEN
-                FAILED( "INCORRECT WIDTH FOR CHAR1" );
-           END IF;
- 
-           IF CHAR2'WIDTH /= 3 THEN
-                FAILED( "INCORRECT WIDTH FOR CHAR2" );
-           END IF;
- 
-           IF NEWCHAR'WIDTH /= 3 THEN
-                FAILED( "INCORRECT WIDTH FOR NEWCHAR" );
-           END IF;
- 
-           IF NOCHAR'WIDTH /= 0 THEN
-                FAILED( "INCORRECT WIDTH FOR NOCHAR" );
-           END IF;
-      END;
- 
-      DECLARE
-           SUBTYPE NONGRAPH IS CHARACTER 
-                     RANGE CHARACTER'VAL (0) .. CHARACTER'VAL (31);
- 
-           MAX : INTEGER := 0;
- 
-      BEGIN
-           FOR CH IN NONGRAPH
-                LOOP
-                     IF CHARACTER'IMAGE (CH)'LENGTH > MAX THEN
-                          MAX := CHARACTER'IMAGE (CH)'LENGTH;
-                     END IF;
-           END LOOP;
-           
-           IF NONGRAPH'WIDTH /= MAX THEN
-                FAILED ( "INCORRECT WIDTH FOR NONGRAPH" );
-           END IF;
-      END;                    
- 
-      RESULT;
- END C35507A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- C35507B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
- -- WHEN THE PREFIX IS FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS
- -- A CHARACTER TYPE.   
- 
- -- RJW 5/29/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507B  IS
- 
-      GENERIC
-           TYPE CH IS (<>);
-      PROCEDURE P ( STR : STRING; W : INTEGER );
- 
-      PROCEDURE P ( STR : STRING; W : INTEGER ) IS
- 
-           SUBTYPE NOCHAR IS CH RANGE CH'VAL (1) .. CH'VAL(0);
-      BEGIN
-           IF CH'WIDTH /= W THEN
-                FAILED( "INCORRECT WIDTH FOR " & STR );
-           END IF;
-      
-           IF NOCHAR'WIDTH /= 0 THEN
-                FAILED( "INCORRECT WIDTH FOR NOCHAR WITH " & STR );
-           END IF;
-      END P;
- 
- 
- BEGIN
- 
-      TEST( "C35507B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
-                        "THE CORRECT RESULTS WHEN THE PREFIX " &
-                        "IS A FORMAL DISCRETE TYPE WHOSE ACTUAL " &
-                        "PARAMETER IS A CHARACTER TYPE" );
- 
-      DECLARE
-           TYPE CHAR1 IS (A, 'A');
- 
-           SUBTYPE CHAR2 IS CHARACTER RANGE 'A' .. 'Z';
-           
-           TYPE NEWCHAR IS NEW CHARACTER 
-                     RANGE 'A' .. 'Z';
- 
-           PROCEDURE P1 IS NEW P (CHAR1);
-           PROCEDURE P2 IS NEW P (CHAR2);
-           PROCEDURE P3 IS NEW P (NEWCHAR);
-      BEGIN
-           P1 ("CHAR1", 3);
-           P2 ("CHAR2", 3);
-           P3 ("NEWCHAR", 3);
-      END;
- 
-      DECLARE
-           SUBTYPE NONGRAPH IS CHARACTER 
-                     RANGE CHARACTER'VAL (0) .. CHARACTER'VAL (31);
- 
-           MAX : INTEGER := 0;
- 
-           PROCEDURE PN IS NEW P (NONGRAPH);
-      BEGIN
-           FOR CH IN NONGRAPH
-                LOOP
-                     IF CHARACTER'IMAGE (CH)'LENGTH > MAX THEN
-                          MAX := CHARACTER'IMAGE (CH)'LENGTH;
-                     END IF;
-           END LOOP;
-           
-           PN ("NONGRAPH", MAX);
-      END;                    
- 
-      RESULT;
- END C35507B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,360 ****
- -- C35507C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
- --     SUBTESTS ARE:
- --         (A). TESTS FOR IMAGE.
- --         (B). TESTS FOR VALUE.
- 
- -- HISTORY:
- --     RJW 05/29/86  CREATED ORIGINAL TEST.
- --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
- --                   CORRECTED ERROR MESSAGES AND ADDED CALLS TO
- --                   IDENT_STR.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507C  IS
- 
-      TYPE CHAR IS ('A', 'a');
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
-      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
-      BEGIN
-           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
-      END IDENT;
- 
-      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
-      BEGIN
-           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
-      END IDENT;
- 
-      PROCEDURE CHECK_BOUND (STR1, STR2 : STRING) IS
-      BEGIN
-           IF STR1'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 &
-                         "'IMAGE ('" & STR1 & "')" );
-           END IF;
-      END CHECK_BOUND;
- 
- BEGIN
- 
-      TEST( "C35507C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
-                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A CHARACTER TYPE" );
- 
-      BEGIN  -- (A).
-           IF CHAR'IMAGE ('A') /= "'A'" THEN
-                FAILED ( "INCORRECT IMAGE FOR CHAR'('A')" );
-           END IF;
- 
-           CHECK_BOUND (CHAR'IMAGE ('A'), "CHAR");
- 
-           IF CHAR'IMAGE ('a') /= "'a'" THEN
-                FAILED ( "INCORRECT IMAGE FOR CHAR'('a')" );
-           END IF;
- 
-           CHECK_BOUND (CHAR'IMAGE ('a'), "CHAR");
- 
-           IF NEWCHAR'IMAGE ('A') /= "'A'" THEN
-                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('A')" );
-           END IF;
- 
-           CHECK_BOUND (NEWCHAR'IMAGE ('A'), "NEWCHAR");
- 
-           IF NEWCHAR'IMAGE ('a') /= "'a'" THEN
-                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('a')" );
-           END IF;
- 
-           CHECK_BOUND (NEWCHAR'IMAGE ('a'), "NEWCHAR");
- 
-           IF CHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
-                FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('A'))" );
-           END IF;
- 
-           CHECK_BOUND (CHAR'IMAGE (IDENT ('A')), "IDENT OF CHAR");
- 
-           IF CHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
-                FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('a'))" );
-           END IF;
- 
-           CHECK_BOUND (CHAR'IMAGE (IDENT ('a')), "IDENT OF CHAR");
- 
-           IF NEWCHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
-                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('A'))" );
-           END IF;
- 
-           CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('A')), "IDENT OF NEWCHAR");
- 
-           IF NEWCHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
-                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('a'))" );
-           END IF;
- 
-           CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('a')), "IDENT OF NEWCHAR");
- 
-           FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
-                IF CHARACTER'IMAGE (CH) /= ("'" & CH) & "'" THEN
-                     FAILED ( "INCORRECT IMAGE FOR CHARACTER'(" &
-                               CH & ")" );
-                END IF;
- 
-                CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
- 
-           END LOOP;
- 
-           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
-                CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
-           END LOOP;
- 
-           CHECK_BOUND (CHARACTER'IMAGE (CHARACTER'VAL (127)),
-                        "CHARACTER");
- 
-      END;
- 
-      ---------------------------------------------------------------
- 
-      DECLARE -- (B).
- 
-           SUBTYPE SUBCHAR IS CHARACTER
-                RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
-      BEGIN
-           FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
-                IF SUBCHAR'VALUE (("'" & CH) & "'") /= CH THEN
-                     FAILED ( "INCORRECT SUBCHAR'VALUE FOR " & CH );
-                END IF;
-           END LOOP;
- 
-           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
-                IF SUBCHAR'VALUE (CHARACTER'IMAGE (CH)) /= CH THEN
-                     FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
-                               CHARACTER'IMAGE (CH) );
-                END IF;
-           END LOOP;
- 
-           IF SUBCHAR'VALUE (CHARACTER'IMAGE (CHARACTER'VAL (127))) /=
-              CHARACTER'VAL (127) THEN
-                FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
-                         "CHARACTER'VAL (127)" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF CHAR'VALUE ("'A'") /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'(""'A'"")" );
-           END IF;
- 
-           IF CHAR'VALUE ("'a'") /= 'a' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'(""'a'"")" );
-           END IF;
- 
-           IF NEWCHAR'VALUE ("'A'") /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'A'"")" );
-           END IF;
- 
-           IF NEWCHAR'VALUE ("'a'") /= 'a' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'a'"")" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF CHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
-                         "(""'A'""))" );
-           END IF;
- 
-           IF CHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
-                         "(""'a'""))" );
-           END IF;
- 
-           IF NEWCHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
-                         "(""'A'""))" );
-           END IF;
- 
-           IF NEWCHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
-                         "(""'a'""))" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF CHAR'VALUE (IDENT_STR ("'B'")) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHAR'VALUE (IDENT_STR (""'B'""))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE (IDENT_CHAR (ASCII.HT) & "'A'") = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE " &
-                         "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE " &
-                         "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE " &
-                         "(IDENT_CHAR (ASCII.HT) & ""'A'"")" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE ("'B'" & IDENT_CHAR (ASCII.HT)) = 'B' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (""'B'"" & " &
-                         "IDENT_CHAR (ASCII.HT)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (""'B'"" & " &
-                         "IDENT_CHAR (ASCII.HT)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE (""'B'"" & " &
-                         "IDENT_CHAR (ASCII.HT)) " );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE ("'C'" & IDENT_CHAR (ASCII.BEL)) = 'C'
-              THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (""'C'"" & " &
-                         "IDENT_CHAR (ASCII.BEL)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (""'C'"" & " &
-                         "IDENT_CHAR (ASCII.BEL)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE (""'C'"" & " &
-                         "IDENT_CHAR (ASCII.BEL))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE (IDENT_STR ("'")) = ''' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""'"")) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""'"")) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE (IDENT_STR (""'""))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE (IDENT_STR ("''")) = ''' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""''"")) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""''"")) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE (IDENT_STR (""''""))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE (IDENT_STR ("'A")) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""'A"")) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""'A"")) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE IDENT_STR (""'A""))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE (IDENT_STR ("A'")) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""A'"")) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""A'"")) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE (IDENT_STR (""A'""))" );
-      END;
- 
-      BEGIN
-           IF CHARACTER'VALUE (IDENT_STR ("'AB'")) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VALUE IDENT_STR (""'AB'""))" );
-      END;
- 
-      RESULT;
- END C35507C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,194 ****
- -- C35507E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
- --     PARAMETER IS A CHARACTER TYPE.
- --     SUBTESTS ARE:
- --         (A). TESTS FOR IMAGE.
- --         (B). TESTS FOR VALUE.
- 
- -- HISTORY:
- --     RJW  05/29/86  CREATED ORIGINAL TEST.
- --     VCL  10/23/87  MODIFIED THIS HEADER, CHANGED THE CALLS TO
- --                    PROCEDURE 'PCH', IN THE SECOND PART OF SUBTEST B,
- --                    TO INCLUDE ANOTHER CALL TO PROCEDURE 'PCHAR' AND
- --                    CALLS TO PROCEDURE 'PNCHAR'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  C35507E  IS
- 
-      TYPE CHAR IS ('A', 'a');
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
-      PROCEDURE CHECK_LOWER_BOUND (STR1, STR2 : STRING) IS
-      BEGIN
-           IF STR1'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 & "'(" &
-                         STR1 & ")" );
-           END IF;
-      END CHECK_LOWER_BOUND;
- 
- BEGIN
- 
-      TEST( "C35507E" , "THE ATTRIBUTES 'IMAGE' AND " &
-                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
- 
-      DECLARE -- (A).
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR1 : STRING;
-           PROCEDURE P (CH : CHTYPE; STR2 : STRING);
- 
-           PROCEDURE P (CH : CHTYPE; STR2 : STRING) IS
-                SUBTYPE SUBCH IS CHTYPE;
-           BEGIN
-                IF SUBCH'IMAGE (CH) /= STR2 THEN
-                     FAILED ( "INCORRECT IMAGE FOR " & STR1 & "'(" &
-                               STR2 & ")" );
-                END IF;
- 
-                CHECK_LOWER_BOUND (SUBCH'IMAGE (CH), STR1);
-           END P;
- 
-           PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR");
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
-           PROCEDURE PCH    IS NEW P (CHARACTER, "CHARACTER");
- 
-      BEGIN
-           PCHAR ('A', "'A'");
-           PCHAR ('a', "'a'");
-           PNCHAR ('A', "'A'");
-           PNCHAR ('a', "'a'");
- 
-           FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
-                PCH (CH, ("'" & CH) & "'" );
-           END LOOP;
-      END;
- 
-      DECLARE
- 
-           GENERIC
-                TYPE CHTYPE IS (<>);
-           PROCEDURE P (CH : CHTYPE; STR : STRING);
- 
-           PROCEDURE P (CH : CHTYPE; STR : STRING) IS
-                SUBTYPE SUBCH IS CHTYPE;
-           BEGIN
-                CHECK_LOWER_BOUND (CHTYPE'IMAGE (CH), "CHARACTER");
-           END P;
- 
-           PROCEDURE PN IS NEW P (CHARACTER);
- 
-      BEGIN
- 
-           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
-                PN (CH, CHARACTER'IMAGE (CH));
-           END LOOP;
- 
-           PN (ASCII.DEL, CHARACTER'IMAGE (ASCII.DEL));
-      END;
- 
-      ---------------------------------------------------------------
- 
-      DECLARE -- (B).
- 
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR1 : STRING;
-           PROCEDURE P (STR2 : STRING; CH : CHTYPE);
- 
-           PROCEDURE P (STR2 : STRING; CH : CHTYPE) IS
-                SUBTYPE SUBCH IS CHTYPE;
-           BEGIN
-                IF SUBCH'VALUE (STR2) /= CH THEN
-                     FAILED ( "INCORRECT " & STR1 & "'VALUE FOR " &
-                               STR2 );
-                END IF;
-           END P;
- 
-           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
-           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
- 
-      BEGIN
-           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
-                 PCH (CHARACTER'IMAGE (CH), CH );
-           END LOOP;
- 
-           PCH (CHARACTER'IMAGE (CHARACTER'VAL (127)),
-                CHARACTER'VAL (127));
- 
-           PCHAR ("'A'", 'A');
-           PCHAR ("'a'", 'a' );
-           PNCHAR ("'A'", 'A');
-           PNCHAR ("'a'", 'a');
-      END;
- 
-      DECLARE
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR1 : STRING;
-           PROCEDURE P (STR2 : STRING);
- 
-           PROCEDURE P (STR2 : STRING) IS
-                SUBTYPE SUBCH IS CHTYPE;
-           BEGIN
-                IF SUBCH'VALUE (STR2) = SUBCH'VAL (0) THEN
-                     FAILED ( "NO EXCEPTION RAISED FOR " &
-                               STR1 & "'VALUE (" & STR2 & ") - 1" );
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED FOR " &
-                               STR1 & "'VALUE (" & STR2 & ") - 2" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED " &
-                              "FOR " & STR1 & "'VALUE (" & STR2 & ")" );
-           END P;
- 
-           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
-           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
- 
-      BEGIN
-           PCHAR ("'B'");
-           PCH (ASCII.HT & "'A'");
-           PCH ("'B'" & ASCII.HT);
-           PCH ("'C'" & ASCII.BEL);
-           PCH ("'");
-           PNCHAR ("''");
-           PCHAR ("'A");
-           PNCHAR ("A'");
-           PCH ("'AB'");
-      END;
- 
-      RESULT;
- END C35507E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- C35507G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
- 
- -- HISTORY:
- --     RJW 06/03/86  CREATED ORIGINAL TEST.
- --     JET 08/13/87  REMOVED TESTS INTENDED FOR C35505F.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507G  IS
- 
-      TYPE CHAR IS ('A', B);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
-      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
-      BEGIN
-           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
-      END;
- 
-      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
-      BEGIN
-           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
-      END;
- 
- BEGIN
- 
-      TEST( "C35507G" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
-                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A CHARACTER TYPE" );
- 
-      BEGIN
-           IF CHAR'SUCC ('A') /= B THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'SUCC('A')" );
-           END IF;
- 
-           IF CHAR'PRED (IDENT (B)) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'PRED (IDENT (B))" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF NEWCHAR'SUCC (IDENT ('A')) /= B THEN
-                FAILED ( "INCORRECT VALUE FOR " &
-                         "IDENT (NEWCHAR'SUCC('A'))" );
-           END IF;
- 
-           IF NEWCHAR'PRED (B) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'PRED(B)" );
-           END IF;
-      END;
- 
-      FOR CH IN CHARACTER'VAL (1) .. CHARACTER'VAL (127) LOOP
-           IF CHARACTER'PRED (CH) /=
-              CHARACTER'VAL (CHARACTER'POS (CH) - 1) THEN
-                FAILED ( "INCORRECT VALUE FOR CHARACTER'PRED OF " &
-                          CHARACTER'IMAGE (CH) );
-           END IF;
-      END LOOP;
- 
-      FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (126) LOOP
-           IF CHARACTER'SUCC (CH) /=
-              CHARACTER'VAL (CHARACTER'POS (CH) + 1) THEN
-                FAILED ( "INCORRECT VALUE FOR CHARACTER'SUCC OF " &
-                          CHARACTER'IMAGE (CH) );
-           END IF;
-      END LOOP;
- 
-      RESULT;
- 
- END C35507G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- C35507H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
- -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
- -- PARAMETER IS A CHARACTER TYPE.
- 
- -- RJW 6/03/86
- -- DWC 7/01/87     -- ADDED THIRD VALUE TO CHAR TYPE.
-                    -- REMOVED SECTION OF CODE AND PLACED INTO
-                    -- C35505E.ADA.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507H  IS
- 
-      TYPE CHAR IS ('A', B, C);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
- BEGIN
- 
-      TEST( "C35507H" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
-                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
- 
-      DECLARE
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR : STRING;
-                I1, I2 : INTEGER;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                SUBTYPE SUBCH IS CHTYPE
-                     RANGE CHTYPE'VAL (I1) .. CHTYPE'VAL (I2);
- 
-           BEGIN
-                FOR CH IN SUBCH'VAL (I1 + 1) .. SUBCH'VAL (I2) LOOP
-                     IF SUBCH'PRED (CH) /=
-                        SUBCH'VAL (SUBCH'POS (CH) - 1) THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR &
-                                   "'PRED OF " & SUBCH'IMAGE (CH) );
-                     END IF;
-                END LOOP;
- 
-                FOR CH IN SUBCH'VAL (I1) .. SUBCH'VAL (I2 - 1) LOOP
-                     IF SUBCH'SUCC (CH) /=
-                        SUBCH'VAL (SUBCH'POS (CH) + 1) THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR &
-                                   "'SUCC OF " & SUBCH'IMAGE (CH) );
-                     END IF;
-                END LOOP;
- 
-           END P;
- 
-           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 0, 1);
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
-           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 0, 127);
-      BEGIN
-           PCHAR;
-           PNCHAR;
-           PCH;
-      END;
- 
-      RESULT;
- END C35507H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507i.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C35507I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE WITH AN ENUMERATION
- --     REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 06/03/86  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     DTN 11/26/91  DELETED CONSTRAINT_ERROR FOR ATTRIBUTES PRED AND
- --                   SUCC SUBTESTS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507I  IS
- 
-      TYPE CHAR IS ('A', B);
-      FOR CHAR USE ('A' => 2, B => 5);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
-      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
-      BEGIN
-           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
-      END;
- 
-      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
-      BEGIN
-           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
-      END;
- 
- BEGIN
- 
-      TEST( "C35507I" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
-                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A CHARACTER TYPE WITH AN " &
-                        "ENUMERATION REPRESENTATION CLAUSE" );
- 
-      BEGIN
-           IF CHAR'SUCC ('A') /= B THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'SUCC('A')" );
-           END IF;
- 
-           IF CHAR'PRED (IDENT (B)) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'PRED (IDENT (B))" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF IDENT (NEWCHAR'SUCC ('A')) /= B THEN
-                FAILED ( "INCORRECT VALUE FOR " &
-                         "IDENT (NEWCHAR'SUCC('A'))" );
-           END IF;
- 
-           IF NEWCHAR'PRED (B) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'PRED(B)" );
-           END IF;
-      END;
- 
-      RESULT;
- END C35507I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C35507J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
- --     PARAMETER IS A CHARACTER TYPE WITH AN ENUMERATION REPRESENTATION
- --     CLAUSE.
- 
- -- HISTORY:
- --     RJW 06/03/86  CREATED ORIGINAL TEST.
- --     JET 09/22/87  MADE REPRESENTATION VALUES CONSECUTIVE.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507J  IS
- 
-      TYPE CHAR IS ('A', B);
-      FOR CHAR USE ('A' => 4, B => 5);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
- BEGIN
- 
-      TEST( "C35507J" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
-                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ACTUAL PARAMETER IS A CHARACTER TYPE WITH " &
-                        "WITH AN ENUMERATION REPRESENTATION CLAUSE" );
- 
- 
-      DECLARE
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR : STRING;
-                I1, I2 : INTEGER;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                SUBTYPE SUBCH IS CHTYPE
-                          RANGE CHTYPE'VAL (I1) .. CHTYPE'VAL (I2);
-           BEGIN
-                FOR CH IN SUBCH'VAL (I1 + 1) .. SUBCH'VAL (I2) LOOP
-                     IF SUBCH'PRED (CH) /=
-                        SUBCH'VAL (SUBCH'POS (CH) - 1) THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR &
-                                   "'PRED OF " & SUBCH'IMAGE (CH) );
-                     END IF;
-                END LOOP;
- 
-                FOR CH IN SUBCH'VAL (I1) .. SUBCH'VAL (I2 - 1) LOOP
-                     IF SUBCH'SUCC (CH) /=
-                        SUBCH'VAL (SUBCH'POS (CH) + 1) THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR &
-                                   "'SUCC OF " & SUBCH'IMAGE (CH) );
-                     END IF;
-                END LOOP;
- 
-           END P;
- 
-           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 0, 1);
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
- 
-      BEGIN
-           PCHAR;
-           PNCHAR;
- 
-      END;
- 
-      RESULT;
- END C35507J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507k.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,224 ****
- -- C35507K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
- 
- -- HISTORY:
- --     RJW 06/03/86
- --     JLH 07/28/87  MODIFIED FUNCTION IDENT.
- -- PWN 11/30/94 REMOVED PART OF TEST INVALID FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507K  IS
- 
-      TYPE CHAR IS ('A', B);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
-      SUBTYPE SCHAR IS CHARACTER
-              RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
- 
-      BLANK : CONSTANT CHARACTER := ' ';
- 
-      POSITION : INTEGER;
- 
-      NONGRAPH : ARRAY (0 .. 31) OF CHARACTER :=
-           (ASCII.NUL, ASCII.SOH, ASCII.STX, ASCII.ETX,
-            ASCII.EOT, ASCII.ENQ, ASCII.ACK, ASCII.BEL,
-            ASCII.BS,  ASCII.HT,  ASCII.LF,  ASCII.VT,
-            ASCII.FF,  ASCII.CR,  ASCII.SO,  ASCII.SI,
-            ASCII.DLE, ASCII.DC1, ASCII.DC2, ASCII.DC3,
-            ASCII.DC4, ASCII.NAK, ASCII.SYN, ASCII.ETB,
-            ASCII.CAN, ASCII.EM,  ASCII.SUB, ASCII.ESC,
-            ASCII.FS,  ASCII.GS,  ASCII.RS,  ASCII.US);
- 
-      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
-      BEGIN
-           IF EQUAL (CHAR'POS (CH), CHAR'POS (CH)) THEN
-                RETURN CH;
-           END IF;
-           RETURN CHAR'FIRST;
-      END IDENT;
- 
-      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
-      BEGIN
-           IF EQUAL (NEWCHAR'POS (CH), NEWCHAR'POS (CH)) THEN
-                RETURN CH;
-           END IF;
-           RETURN NEWCHAR'FIRST;
-      END IDENT;
- 
- BEGIN
- 
-      TEST( "C35507K" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
-                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A CHARACTER TYPE" );
- 
-      BEGIN
-           IF CHAR'POS ('A') /= 0 THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') - 1" );
-           END IF;
- 
-           IF CHAR'POS (B) /= 1 THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'POS(B) - 1" );
-           END IF;
- 
-           IF CHAR'VAL (0) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
-           END IF;
- 
-           IF CHAR'VAL (1) /= B THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
-           END IF;
- 
-           IF CHAR'POS (IDENT ('A')) /= 0 THEN
-                FAILED ( "INCORRECT VALUE " &
-                         "FOR CHAR'POS (IDENT ('A')) - 2" );
-           END IF;
- 
-           IF CHAR'POS (IDENT (B)) /= 1 THEN
-                FAILED ( "INCORRECT VALUE " &
-                         "FOR CHAR'POS (IDENT (B)) - 2" );
-           END IF;
- 
-      END;
- 
-      BEGIN
-           IF NEWCHAR'POS ('A') /= 0 THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
-           END IF;
- 
-           IF NEWCHAR'POS (B) /= 1 THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) - 1" );
-           END IF;
- 
-           IF NEWCHAR'VAL (0) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) - 1" );
-           END IF;
- 
-           IF NEWCHAR'VAL (1) /= B THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
-           END IF;
- 
-           IF NEWCHAR'VAL (IDENT_INT (1)) /= B THEN
-                FAILED ( "INCORRECT VALUE " &
-                         "FOR NEWCHAR'POS (IDENT (B)) - 2" );
-           END IF;
- 
-           IF (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE " &
-                         "FOR IDENT (NEWCHAR'VAL (0)) - 2" );
-           END IF;
- 
-      END;
- 
-      BEGIN
-           IF CHAR'VAL (IDENT_INT (2)) = B THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'VAL (IDENT_INT (2)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHAR'VAL (IDENT_INT (2)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                          "FOR CHAR'VAL (IDENT_INT (2))" );
-      END;
- 
-      BEGIN
-           IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
-      END;
- 
-      POSITION := 0;
- 
-      FOR CH IN CHARACTER LOOP
-           IF SCHAR'POS (CH) /= POSITION THEN
-                FAILED ( "INCORRECT VALUE FOR SCHAR'POS OF " &
-                          CHARACTER'IMAGE (CH) );
-           END IF;
- 
-           POSITION := POSITION + 1;
-      END LOOP;
- 
-      FOR POSITION IN 0 .. 31 LOOP
-           IF CHARACTER'VAL (POSITION) /= NONGRAPH (POSITION) THEN
-                FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
-                         "NONGRAPHIC CHARACTER IN POSITION - " &
-                          INTEGER'IMAGE (POSITION) );
-           END IF;
-      END LOOP;
- 
-      POSITION := 32;
- 
-      FOR CH IN BLANK .. ASCII.TILDE LOOP
-           IF SCHAR'VAL (POSITION) /= CH THEN
-                FAILED ( "INCORRECT VALUE FOR SCHAR'VAL OF " &
-                         "GRAPHIC CHARACTER IN POSITION - " &
-                          INTEGER'IMAGE (POSITION) );
-           END IF;
- 
-           POSITION := POSITION + 1;
-      END LOOP;
- 
-      IF CHARACTER'VAL (127) /= ASCII.DEL THEN
-           FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
-                     "NONGRAPHIC CHARACTER IN POSITION - 127" );
-      END IF;
- 
-      BEGIN
-           IF CHARACTER'VAL (IDENT_INT (-1)) = ASCII.NUL THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHARACTER'VAL (IDENT_INT (-1)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR CHARACTER'VAL (IDENT_INT (-1)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR CHARACTER'VAL (IDENT_INT (-1))" );
-      END;
- 
-      RESULT;
- END C35507K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C35507L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT 
- -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
- -- PARAMETER IS A CHARACTER TYPE.   
- 
- -- RJW 6/03/86
- -- PWN 11/30/94 REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507L  IS
- 
-      TYPE CHAR IS ('A', B);
- 
-      TYPE NEWCHAR IS NEW CHAR;     
- 
- BEGIN
- 
-      TEST( "C35507L" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
-                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " & 
-                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
- 
-      DECLARE
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR : STRING;
-                I1 : INTEGER;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                SUBTYPE SUBCH IS CHTYPE;               
-                CH : CHTYPE;
-                POSITION : INTEGER;
-           BEGIN
-                POSITION := 0;
-                FOR CH IN CHTYPE LOOP
-                     IF SUBCH'POS (CH) /= POSITION THEN 
-                          FAILED ( "INCORRECT VALUE FOR " & STR & 
-                                   "'POS OF " & CHTYPE'IMAGE (CH) );
-                     END IF;
-      
-                     IF SUBCH'VAL (POSITION) /= CH THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR & 
-                                   "'VAL OF CHARACTER IN POSITION - " &
-                                     INTEGER'IMAGE (POSITION) );
-                     END IF;
-                     POSITION := POSITION + 1;
-                END LOOP;
-      
-                BEGIN
-                     IF SUBCH'VAL (-1) = SUBCH'VAL (0) THEN
-                          FAILED ( "NO EXCEPTION RAISED " & 
-                                   "FOR " & STR & "'VAL (-1) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED " & 
-                                   "FOR " & STR & "'VAL (-1) - 2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED " & 
-                                   "FOR " & STR & "'VAL (-1)" );
-                END;     
-           END P;
-           
-           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 1);
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 1);
-           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 127);
-      BEGIN
-           PCHAR;
-           PNCHAR;
-           PCH;
-      END;
- 
-      RESULT;
- END C35507L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507m.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- C35507M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE WITH AN ENUMERATION
- --     REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 06/03/86  CREATED ORIGINAL TEST
- --     JLH 07/28/87  MODIFIED FUNCTION IDENT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35507M  IS
- 
-      TYPE CHAR IS ('A', B);
-      FOR CHAR USE ('A' => 4, B => 5);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
-      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN CH;
-           ELSE
-                RETURN 'A';
-           END IF;
-      END IDENT;
- 
-      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN CH;
-           ELSE
-                RETURN 'A';
-           END IF;
-      END IDENT;
- 
- BEGIN
- 
-      TEST( "C35507M" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
-                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A CHARACTER TYPE WITH AN " &
-                        "ENUMERATION REPESENTATION CLAUSE" );
- 
-      BEGIN
-           IF CHAR'POS ('A') /= 0 THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'POS('A')" );
-           END IF;
- 
-           IF CHAR'POS (B) /= 1 THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'POS(B)" );
-           END IF;
- 
-           IF CHAR'VAL (0) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
-           END IF;
- 
-           IF CHAR'VAL (1) /= B THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF NEWCHAR'POS ('A') /= 0 THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
-           END IF;
- 
-           IF NEWCHAR'POS (B) /= 1 THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B)" );
-           END IF;
- 
-           IF NEWCHAR'VAL (0) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0)" );
-           END IF;
- 
-           IF NEWCHAR'VAL (1) /= B THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF CHAR'POS (IDENT ('A')) /= 0 THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') WITH " &
-                         "IDENT" );
-           END IF;
- 
-           IF NEWCHAR'POS (IDENT (B)) /= 1 THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) WITH " &
-                         "IDENT" );
-           END IF;
- 
-           IF IDENT (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) WITH " &
-                         "IDENT" );
-           END IF;
- 
-           IF IDENT (CHAR'VAL (IDENT_INT(1))) /= B THEN
-                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1) WITH IDENT" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF CHAR'VAL (IDENT_INT(2)) = B THEN
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHAR'VAL (IDENT_INT(2)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "CHAR'VAL (IDENT_INT(2)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "CHAR'VAL (IDENT_INT(2))" );
-      END;
- 
-      BEGIN
-           IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED " &
-                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " &
-                         "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
-      END;
- 
-      RESULT;
- END C35507M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507n.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C35507N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
- --     PARAMETER IS A CHARACTER TYPE WITH AN ENUMERATION REPRESENTATION
- --     CLAUSE.
- 
- -- HISTORY:
- --     RJW 06/03/86  CREATED ORIGINAL TEST.
- --     JET 09/22/87  MADE REPRESENTATION VALUES CONSECUTIVE.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     PWN 11/30/94  REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507N  IS
- 
-      TYPE CHAR IS ('A', B);
-      FOR CHAR USE ('A' => 4, B => 5);
- 
-      TYPE NEWCHAR IS NEW CHAR;
- 
- BEGIN
- 
-      TEST( "C35507N" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
-                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ACTUAL PARAMETER IS A CHARACTER TYPE " &
-                        "WITH AN ENUMERATION REPRESENTATION CLAUSE" );
- 
-      DECLARE
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR : STRING;
-                I1 : INTEGER;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                SUBTYPE SUBCH IS CHTYPE;
-                CH : CHTYPE;
-                POSITION : INTEGER;
-           BEGIN
-                POSITION := 0;
-                FOR CH IN CHTYPE LOOP
-                     IF SUBCH'POS (CH) /= POSITION THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR &
-                                   "'POS OF " & CHTYPE'IMAGE (CH) );
-                     END IF;
- 
-                     IF SUBCH'VAL (POSITION) /= CH THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR &
-                                   "'VAL OF CHARACTER IN POSITION - " &
-                                     INTEGER'IMAGE (POSITION) );
-                     END IF;
-                     POSITION := POSITION + 1;
-                END LOOP;
- 
-                BEGIN
-                     IF SUBCH'VAL (-1) = SUBCH'VAL (0) THEN
-                          FAILED ( "NO EXCEPTION RAISED " &
-                                   "FOR " & STR & "'VAL (-1) - 1" );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED " &
-                                   "FOR " & STR & "'VAL (-1) - 2" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED " &
-                                   "FOR " & STR & "'VAL (-1)" );
-                END;
-           END P;
- 
-           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 1);
-           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 1);
-           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 127);
-      BEGIN
-           PCHAR;
-           PNCHAR;
-           PCH;
-      END;
- 
-      RESULT;
- END C35507N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507o.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C35507O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES 'FIRST' AND 'LAST' YIELD THE CORRECT 
- -- RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.   
- 
- -- RJW 6/03/86
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- --              REMOVED PART OF TEST INVALID FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507O  IS
- 
-      TYPE CHAR IS ('A', B);
- 
-      TYPE NEWCHAR IS NEW CHAR;     
- 
-      SPACE : CONSTANT CHARACTER := CHARACTER'(' ');
- 
-      SUBTYPE NOCHAR IS CHARACTER RANGE CHARACTER'('Z') .. CHARACTER'('A');
-      SUBTYPE GRAPHIC IS CHARACTER RANGE SPACE .. ASCII.TILDE;
-      SUBTYPE NONGRAPHIC IS CHARACTER RANGE ASCII.NUL .. ASCII.US;
- 
-      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
-      BEGIN
-           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
-      END IDENT;
- 
-      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
-      BEGIN
-           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST( "C35507O" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
-                        "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A CHARACTER TYPE" );
- 
-      BEGIN 
-           IF IDENT (CHAR'FIRST) /= 'A' THEN 
-                FAILED ( "INCORRECT VALUE FOR CHAR'FIRST" );
-           END IF;
- 
-           IF CHAR'LAST /= B THEN 
-                 FAILED ( "INCORRECT VALUE FOR CHAR'LAST" );
-           END IF;
-      END;
- 
-      BEGIN 
-           IF NEWCHAR'FIRST /= 'A' THEN 
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'FIRST" );
-           END IF;
- 
-           IF NEWCHAR'LAST /= IDENT (B) THEN 
-                FAILED ( "INCORRECT VALUE FOR NEWCHAR'LAST" );
-           END IF;
-      END;
- 
-      BEGIN 
-           IF NOCHAR'FIRST /= CHARACTER'('Z') THEN 
-                FAILED ( "INCORRECT VALUE FOR NOCHAR'FIRST" );
-           END IF;
- 
-           IF NOCHAR'LAST /= CHARACTER'('A') THEN 
-                FAILED ( "INCORRECT VALUE FOR NOCHAR'LAST" );
-           END IF;
-      END;
- 
-      BEGIN 
-           IF CHARACTER'FIRST /= ASCII.NUL THEN 
-                FAILED ( "INCORRECT VALUE FOR CHARACTER'FIRST" );
-           END IF;
- 
-      END;
- 
-      BEGIN 
-           IF NONGRAPHIC'FIRST /= IDENT_CHAR (ASCII.NUL) THEN 
-                FAILED ( "INCORRECT VALUE FOR NONGRAPHIC'FIRST" );
-           END IF;
- 
-           IF NONGRAPHIC'LAST /= ASCII.US THEN 
-                FAILED ( "INCORRECT VALUE FOR NONGRAPHIC'LAST" );
-           END IF;
-      END;
- 
-      BEGIN 
-           IF GRAPHIC'FIRST /= SPACE THEN 
-                FAILED ( "INCORRECT VALUE FOR GRAPHIC'FIRST" );
-           END IF;
- 
-           IF GRAPHIC'LAST /= ASCII.TILDE THEN 
-                FAILED ( "INCORRECT VALUE FOR GRAPHIC'LAST" );
-           END IF;
-      END;
- 
-      RESULT;
- END C35507O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35507p.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35507p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C35507P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES 'FIRST' AND 'LAST' YIELD THE CORRECT 
- -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
- -- PARAMETER IS A CHARACTER TYPE.   
- 
- -- RJW 6/03/86
- -- PWN 11/30/94 REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35507P  IS
- 
-      TYPE CHAR IS ('A', B);
- 
-      TYPE NEWCHAR IS NEW CHAR;     
- 
-      SPACE : CONSTANT CHARACTER := ' ';
- 
-      SUBTYPE GRAPHIC IS CHARACTER RANGE SPACE .. ASCII.TILDE;
-      SUBTYPE NONGRAPHIC IS CHARACTER RANGE ASCII.NUL .. ASCII.US;
- BEGIN
- 
-      TEST( "C35507P" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
-                        "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
-                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
- 
-      DECLARE
-           GENERIC
-                TYPE CHTYPE IS (<>);
-                STR : STRING;
-                F, L : CHTYPE;
-           PROCEDURE P;
- 
-           PROCEDURE P IS 
-                SUBTYPE NOCHAR IS CHTYPE RANGE L .. F;
-           BEGIN 
-                IF CHTYPE'FIRST /= F THEN 
-                     FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
-                END IF;
- 
-                IF CHTYPE'LAST /= L THEN 
-                     FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
-                END IF;
- 
-                IF NOCHAR'FIRST /= L THEN 
-                     FAILED ( "INCORRECT VALUE FOR NOCHAR'FIRST AS A " &
-                              "SUBTYPE OF " & STR );
-                END IF;
- 
-                IF NOCHAR'LAST /= F THEN 
-                     FAILED ( "INCORRECT VALUE FOR NOCHAR'LAST AS A " &
-                              "SUBTYPE OF " & STR  );
-                END IF;
-           END P;
-           
-           PROCEDURE P1 IS NEW P (CHAR, "CHAR", 'A', B);          
-           PROCEDURE P2 IS NEW P (NEWCHAR, "NEWCHAR", 'A', B);          
-           PROCEDURE P3 IS NEW P 
-                (GRAPHIC, "GRAPHIC", SPACE, ASCII.TILDE);
-           PROCEDURE P4 IS NEW P 
-                (NONGRAPHIC, "NONGRAPHIC", ASCII.NUL, ASCII.US);
-      BEGIN
-           P1;
-           P2;
-           P3;
-           P4;
-      END;
- 
-      RESULT;
- END C35507P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C35508A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS WHEN 
- -- THE PREFIX IS A BOOLEAN TYPE.   
- 
- -- RJW 3/14/86  COMPLETELY REVISED.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35508A  IS
- 
- BEGIN
- 
-      TEST( "C35508A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
-                        "THE CORRECT RESULTS WHEN THE PREFIX IS A " &
-                        "BOOLEAN TYPE" );
- 
-      DECLARE
-           TYPE NEWBOOL IS NEW BOOLEAN;
-           SUBTYPE FRANGE IS BOOLEAN 
-                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
-           SUBTYPE TRANGE IS BOOLEAN 
-                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
-           SUBTYPE NOBOOL IS BOOLEAN 
-                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
- 
-      BEGIN
- 
-           IF BOOLEAN'WIDTH /= 5 THEN
-                FAILED( "INCORRECT WIDTH FOR BOOLEAN" );
-           END IF;
- 
-           IF NEWBOOL'WIDTH /= 5 THEN
-                FAILED( "INCORRECT WIDTH FOR NEWBOOL" );
-           END IF;
- 
-           IF FRANGE'WIDTH /= 5 THEN
-                FAILED( "INCORRECT WIDTH FOR FRANGE" );
-           END IF;
- 
-           IF TRANGE'WIDTH /= 4 THEN
-                FAILED( "INCORRECT WIDTH FOR TRANGE" );
-           END IF;
- 
-           IF NOBOOL'WIDTH /= 0 THEN
-                FAILED( "INCORRECT WIDTH FOR NOBOOL" );
-           END IF;
-      
-      END;                    
- 
-      RESULT;
- END C35508A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C35508B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS WHEN 
- -- THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL 
- -- PARAMETER IS A BOOLEAN TYPE.   
- 
- -- RJW 3/19/86  COMPLETELY REVISED.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35508B  IS
- 
- BEGIN
- 
-      TEST( "C35508B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
-                        "THE CORRECT RESULTS WHEN THE PREFIX IS A " &
-                        "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
-                        "PARAMETER IS A BOOLEAN TYPE" );
- 
-      DECLARE
-           SUBTYPE FRANGE IS BOOLEAN 
-                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
-           SUBTYPE TRANGE IS BOOLEAN 
-                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
-           TYPE NEWBOOL IS NEW BOOLEAN;
- 
-           GENERIC
-                TYPE B IS (<>);
-                W : INTEGER;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                SUBTYPE NOBOOL IS B RANGE 
-                     B'VAL (IDENT_INT(1)) .. B'VAL (IDENT_INT(0));
-           BEGIN
-                IF B'WIDTH /= W THEN 
-                     FAILED ( "INCORRECT B'WIDTH FOR " & STR );
-                END IF;
-                IF NOBOOL'WIDTH /= 0 THEN
-                     FAILED ( "INCORRECT NOBOOL'WIDTH FOR " & STR );
-                END IF;
-           END P;
- 
-           PROCEDURE PROC1 IS NEW P (BOOLEAN, 5);
-           PROCEDURE PROC2 IS NEW P (FRANGE, 5);
-           PROCEDURE PROC3 IS NEW P (TRANGE, 4);
-           PROCEDURE PROC4 IS NEW P (NEWBOOL, 5);
- 
-      BEGIN
-           PROC1 ( "BOOLEAN" );
-           PROC2 ( "FRANGE" );
-           PROC3 ( "TRANGE");
-           PROC4 ( "NEWBOOL" );
-      END;                    
- 
-      RESULT;
- END C35508B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C35508C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
- -- RESULTS WHEN THE PREFIX IS A BOOLEAN TYPE.   
- 
- -- SUBTESTS ARE:
- --     (A). TESTS FOR IMAGE.
- --     (B). TESTS FOR VALUE.
- 
- -- RJW 3/19/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35508C  IS     
- 
-      TYPE NEWBOOL IS NEW BOOLEAN;
- 
- BEGIN
- 
-      TEST( "C35508C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
-                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
-                        "PREFIX IS A BOOLEAN TYPE" );
- -- PART (A).
- 
-      DECLARE
- 
-           A5, B5 : INTEGER := IDENT_INT(5);
-           C6     : INTEGER := IDENT_INT(6);
-      BEGIN  
- 
-           IF BOOLEAN'IMAGE ( A5 = B5 ) /= "TRUE" THEN
-                FAILED ( "INCORRECT IMAGE FOR 'A5 = B5'" );
-           END IF;
-           IF BOOLEAN'IMAGE ( A5 = B5 )'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR 'A5 = B5'" );
-           END IF;
- 
-           IF BOOLEAN'IMAGE ( C6 = A5 ) /= "FALSE" THEN
-                FAILED ( "INCORRECT IMAGE FOR 'C6 = A5'" );
-           END IF;          
-           IF BOOLEAN'IMAGE ( C6 = A5 )'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR 'C6 = A5'" );
-           END IF;          
- 
-           IF BOOLEAN'IMAGE (TRUE) /= "TRUE" THEN
-                FAILED ( "INCORRECT IMAGE FOR 'TRUE'" );
-           END IF;          
-           IF BOOLEAN'IMAGE (TRUE)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR 'TRUE'" );
-           END IF;          
- 
-           IF NEWBOOL'IMAGE (FALSE) /= "FALSE" THEN
-                FAILED ( "INCORRECT IMAGE FOR NEWBOOL'FALSE'" );
-           END IF;          
-           IF NEWBOOL'IMAGE (FALSE)'FIRST /= 1 THEN
-                FAILED ( "INCORRECT LOWER BOUND FOR NEWBOOL'FALSE'" );
-           END IF;          
-      END;
- 
- -----------------------------------------------------------------------
- 
- -- PART (B).
- 
-      BEGIN  
-           IF BOOLEAN'VALUE (IDENT_STR("TRUE")) /= TRUE THEN     
-                FAILED ( "INCORRECT VALUE FOR ""TRUE""" );  
-           END IF;
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""TRUE""" );  
-      END;
- 
-      BEGIN
-           IF NEWBOOL'VALUE (IDENT_STR("FALSE")) /= FALSE THEN
-                FAILED ( "INCORRECT VALUE FOR ""FALSE""" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""FALSE""" );
-      END;
- 
-      BEGIN
-           IF BOOLEAN'VALUE ("true") /= TRUE THEN
-                FAILED ( "INCORRECT VALUE FOR ""true""" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR ""true""" );
-      END;
- 
-      BEGIN
-           IF NEWBOOL'VALUE ("false") /= FALSE THEN
-                FAILED ( "INCORRECT VALUE FOR ""false""" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE FOR " &
-                         """false""" );
-      END;
- 
-      BEGIN
-           IF BOOLEAN'VALUE (IDENT_STR("TRUE     ")) /= TRUE THEN
-                FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE - " &
-                         "TRAILING BLANKS" );
-      END;
- 
-      BEGIN          
-           IF NEWBOOL'VALUE ("  FALSE") /= FALSE THEN
-                FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
-           END IF;          
-      EXCEPTION     
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - VALUE - LEADING " &
-                         "BLANKS" );
-      END;
- 
-      DECLARE 
-           SUBTYPE SUBBOOL IS BOOLEAN RANGE FALSE .. FALSE;
-      BEGIN
-           IF SUBBOOL'VALUE (IDENT_STR("TRUE")) /= TRUE THEN     
-                FAILED ( "INCORRECT VALUE - ""TRUE"" AND " & 
-                         "SUBBOOL" );  
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - SUBBOOL" );
-      END;
-      
-      BEGIN
-           IF BOOLEAN'VALUE (IDENT_STR("MAYBE")) = TRUE THEN
-                FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - ""MAYBE"" " );
-      END;
- 
-      BEGIN
-           IF BOOLEAN'VALUE (IDENT_CHAR(ASCII.HT) & "TRUE") = TRUE THEN
-                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
-      END;
- 
-      BEGIN
-           IF NEWBOOL'VALUE ("FALSE" & ASCII.HT) = FALSE THEN
-                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
-      END;
- 
-      RESULT;
- END C35508C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- C35508E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
- --     RESULTS WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE
- --     ACTUAL ARGUMENT IS A BOOLEAN TYPE.
- 
- --     SUBTESTS ARE:
- --         (A). TESTS FOR IMAGE.
- --         (B). TESTS FOR VALUE.
- 
- -- HISTORY:
- --     RJW 03/19/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C35508E  IS
- 
- BEGIN
- 
-      TEST( "C35508E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
-                        "'VALUE' YIELD THE CORRECT RESULTS  WHEN THE " &
-                        "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
-                        "WHOSE ACTUAL ARGUMENT IS A BOOLEAN TYPE" );
- -- PART (A).
- 
-      DECLARE
-           TYPE NEWBOOL IS NEW BOOLEAN;
- 
-           GENERIC
-                TYPE BOOL IS (<>);
-           PROCEDURE P (B : BOOL; STR : STRING );
- 
-           PROCEDURE P (B : BOOL; STR : STRING) IS
-                SUBTYPE SUBBOOL IS BOOL
-                     RANGE BOOL'VAL (IDENT_INT(0)) ..
-                                                BOOL'VAL (IDENT_INT(0));
-           BEGIN
- 
-                IF BOOL'IMAGE (B) /= STR THEN
-                     FAILED ( "INCORRECT BOOL'IMAGE OF " & STR );
-                END IF;
-                IF BOOL'IMAGE (B)'FIRST /= 1 THEN
-                     FAILED ( "INCORRECT BOOL'FIRST FOR " & STR );
-                END IF;
- 
-                IF SUBBOOL'IMAGE (B) /= STR THEN
-                     FAILED ( "INCORRECT SUBBOOL'IMAGE OF " & STR );
-                END IF;
-                IF SUBBOOL'IMAGE (B)'FIRST /= 1 THEN
-                     FAILED ( "INCORRECT SUBBOOL'FIRST FOR " & STR );
-                END IF;
-           END P;
- 
-           PROCEDURE NP1 IS NEW P ( BOOLEAN );
-           PROCEDURE NP2 IS NEW P ( NEWBOOL );
-      BEGIN
-           NP1 ( TRUE, "TRUE" );
-           NP2 ( FALSE, "FALSE" );
- 
-      END;
- 
- -----------------------------------------------------------------------
- 
- -- PART (B).
- 
-      DECLARE
-           TYPE NEWBOOL IS NEW BOOLEAN;
- 
-           GENERIC
-                TYPE BOOL IS (<>);
-           PROCEDURE P (STR : STRING; B : BOOL );
- 
-           PROCEDURE P (STR : STRING; B : BOOL) IS
-                SUBTYPE SUBBOOL IS BOOL
-                     RANGE BOOL'VAL (IDENT_INT(0)) ..
-                                                BOOL'VAL (IDENT_INT(0));
- 
-           BEGIN
-                BEGIN
-                     IF BOOL'VALUE (STR) /= B THEN
-                          FAILED ( "INCORRECT BOOL'VALUE OF """ &
-                                   STR & """" );
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED BOOL'VALUE OF """ &
-                                   STR & """" );
-                END;
-                BEGIN
-                     IF SUBBOOL'VALUE (STR) /= B THEN
-                          FAILED ( "INCORRECT SUBBOOL'VALUE OF """ &
-                                   STR & """" );
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED SUBBOOL'VALUE " &
-                                   "OF """ & STR & """" );
-                END;
-           END P;
- 
-           PROCEDURE NP1 IS NEW P ( BOOLEAN );
-           PROCEDURE NP2 IS NEW P ( NEWBOOL );
- 
-      BEGIN
-           NP1 ( "TRUE", TRUE );
-           NP2 ( "FALSE", FALSE );
-           NP2 ( "true", TRUE );
-           NP1 ( "false", FALSE );
-           NP1 ( "         TRUE", TRUE );
-           NP2 ( "FALSE        ", FALSE );
-      END;
- 
-      DECLARE
-           GENERIC
-                TYPE BOOL IS (<>);
-           PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING);
- 
-           PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING) IS
-                SUBTYPE SUBBOOL IS BOOL
-                     RANGE BOOL'VAL (IDENT_INT(0)) ..
-                                                 BOOL'VAL (IDENT_INT(0));
- 
-           BEGIN
-                BEGIN
-                     IF BOOL'VALUE (STR1) = B THEN
-                          FAILED ( "NO EXCEPTION RAISED - " &
-                                   "BOOL'VALUE WITH " & STR2 &
-                                   "- EQUAL " );
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED - " &
-                                   "BOOL'VALUE WITH " & STR2 &
-                                   " - NOT EQUAL" );
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED - " &
-                                   "BOOL'VALUE WITH " & STR2 );
-                END;
-                BEGIN
-                     IF SUBBOOL'VALUE (STR1) /= B THEN
-                          FAILED ( "NO EXCEPTION RAISED - " &
-                                   "SUBBOOL'VALUE WITH " &
-                                   STR2 & " - EQUAL");
-                     ELSE
-                          FAILED ( "NO EXCEPTION RAISED - " &
-                                   "SUBBOOL'VALUE WITH " &
-                                   STR2 & " - NOT EQUAL");
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED - " &
-                                   "SUBBOOL'VALUE WITH " & STR2 );
-                END;
-           END P;
- 
-           PROCEDURE NP IS NEW P ( BOOLEAN );
-      BEGIN
-           NP ( "MAYBE", TRUE, "NON-BOOLEAN VALUE");
-           NP ( ASCII.HT & "TRUE", TRUE, "LEADING 'HT'" );
-           NP ( "FALSE" & ASCII.HT , FALSE, "TRAILING 'HT'" );
-      END;
- 
-      RESULT;
- END C35508E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C35508G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS A BOOLEAN TYPE.
- 
- -- HISTORY:
- --     RJW 03/19/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35508G IS
- 
- BEGIN
-      TEST ("C35508G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "BOOLEAN TYPE" );
- 
-      BEGIN
-           IF BOOLEAN'PRED (IDENT_BOOL(TRUE)) /= FALSE THEN
-                FAILED ( "INCORRECT VALUE FOR PRED OF TRUE" );
-           END IF;
-           IF BOOLEAN'SUCC (IDENT_BOOL(FALSE)) /= TRUE THEN
-                FAILED ( "INCORRECT VALUE FOR SUCC OF FALSE" );
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE NEWBOOL IS NEW BOOLEAN;
-      BEGIN
-           IF NEWBOOL'PRED (TRUE) /= FALSE THEN
-                FAILED ( "INCORRECT VALUE FOR NEWBOOL'PRED OF TRUE" );
-           END IF;
-           IF NEWBOOL'SUCC (FALSE) /= TRUE THEN
-                FAILED ( "INCORRECT VALUE FOR NEWBOOL'SUCC OF FALSE" );
-           END IF;
-      END;
- 
-      DECLARE
- 
-           SUBTYPE SBOOL IS BOOLEAN RANGE IDENT_BOOL(TRUE) ..
-                                                       IDENT_BOOL(TRUE);
- 
-      BEGIN
-           BEGIN
-                IF SBOOL'PRED (IDENT_BOOL(TRUE)) /= FALSE THEN
-                     FAILED ( "INCORRECT VALUE FOR SBOOL'PRED " &
-                              "OF TRUE" );
-                END IF;
-           END;
- 
-           BEGIN
-                IF SBOOL'PRED (IDENT_BOOL(SBOOL'BASE'FIRST)) = TRUE THEN
-                     FAILED("'PRED('FIRST) WRAPPED AROUNT TO TRUE");
-                END IF;
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "'PRED (SBOOL'BASE'FIRST)" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                              "'PRED (SBOOL'BASE'FIRST)" );
-           END;
- 
-           BEGIN
-                IF SBOOL'SUCC (IDENT_BOOL(SBOOL'BASE'LAST)) = FALSE THEN
-                     FAILED("'SUCC('LAST) WRAPPED AROUNT TO FALSE");
-                END IF;
-                FAILED ( "NO EXCEPTION RAISED FOR " &
-                         "'SUCC (SBOOL'BASE'LAST)" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                              "'SUCC (SBOOL'BASE'LAST)" );
-           END;
-      END;
- 
-      RESULT;
- END C35508G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C35508H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS A
- --     BOOLEAN TYPE.
- 
- -- HISTORY:
- --     RJW 03/24/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35508H IS
- 
- BEGIN
-      TEST ("C35508H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
-                       "IS A BOOLEAN TYPE" );
- 
-      DECLARE
- 
-           TYPE NEWBOOL IS NEW BOOLEAN;
- 
-           GENERIC
-                TYPE BOOL IS (<>);
-                F, T : BOOL;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                SUBTYPE SBOOL IS BOOL RANGE T .. T;
-           BEGIN
-                BEGIN
-                     IF BOOL'PRED (T) /= F THEN
-                          FAILED ( "INCORRECT VALUE FOR " &
-                                    STR & "'PRED OF T" );
-                     END IF;
-                     IF BOOL'SUCC (F) /= T THEN
-                          FAILED ( "INCORRECT VALUE FOR " &
-                                    STR & "'SUCC OF F" );
-                     END IF;
-                END;
- 
-                BEGIN
-                     IF SBOOL'PRED (T) /= F THEN
-                          FAILED ( "INCORRECT VALUE FOR SBOOL'PRED " &
-                                   "OF T FOR " & STR);
-                     END IF;
-                END;
- 
-                BEGIN
-                     IF SBOOL'PRED (SBOOL'BASE'FIRST) = T THEN
-                          FAILED("'PRED('FIRST) WRAPPED AROUND " &
-                                 "TO TRUE FOR " & STR);
-                     END IF;
-                     FAILED ( "NO EXCEPTION RAISED FOR " &
-                               STR & "'PRED (SBOOL'BASE'FIRST)" );
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'PRED (SBOOL'BASE'FIRST)" );
-                END;
- 
-                BEGIN
-                     IF SBOOL'SUCC (SBOOL'BASE'LAST) = F THEN
-                          FAILED("'SUCC('LAST) WRAPPED AROUND TO " &
-                                 "FALSE FOR " & STR);
-                     END IF;
-                     FAILED ( "NO EXCEPTION RAISED FOR " & STR &
-                              "'SUCC (SBOOL'BASE'LAST)" );
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                   STR & "'SUCC (SBOOL'BASE'LAST)" );
-                END;
-           END P;
- 
-           PROCEDURE NP1 IS NEW P
-                          ( BOOL => BOOLEAN, F => FALSE, T => TRUE );
- 
-           PROCEDURE NP2 IS NEW P
-                          ( BOOL => NEWBOOL, F => FALSE, T => TRUE );
-      BEGIN
-           NP1 ("BOOLEAN");
-           NP2 ("NEWBOOL");
-      END;
- 
-      RESULT;
- END C35508H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508k.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C35508K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE 
- -- PREFIX IS A BOOLEAN TYPE.
- 
- -- RJW 3/19/86
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35508K IS
- 
-      TYPE NEWBOOL IS NEW BOOLEAN;
- 
- BEGIN
-      TEST ("C35508K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS  WHEN THE PREFIX IS A " &
-                       "BOOLEAN TYPE" );
- 
-      BEGIN
-           IF BOOLEAN'POS (IDENT_BOOL(FALSE)) /= 0 THEN
-                FAILED ( "WRONG POS FOR 'FALSE'" );
-           END IF;
-           IF BOOLEAN'POS (IDENT_BOOL(TRUE)) /= 1 THEN
-                FAILED ( "WRONG POS FOR 'TRUE'" );
-           END IF;
- 
-           IF BOOLEAN'VAL (IDENT_INT(0)) /= FALSE THEN
-                FAILED ( "WRONG VAL FOR '0'" );
-           END IF;
-           IF BOOLEAN'VAL (IDENT_INT(1)) /= TRUE THEN
-                FAILED ( "WRONG VAL FOR '1'" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF BOOLEAN'VAL (IDENT_INT(-1)) = TRUE THEN
-                FAILED("'VAL(-1) WRAPPED AROUND TO TRUE");
-           END IF;
-           FAILED ( "NO EXCEPTION RAISED FOR VAL OF '-1'" );
-      EXCEPTION     
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VAL OF '-1'" );
-      END;
- 
-      BEGIN
-           IF BOOLEAN'VAL (IDENT_INT(2)) = FALSE THEN
-                FAILED("BOOLEAN'VAL(2) WRAPPED AROUND TO FALSE");
-           END IF;
-           FAILED ( "NO EXCEPTION RAISED FOR VAL OF '2'" );
-      EXCEPTION     
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VAL OF '2'" );
-      END;
- 
-      BEGIN
-           IF NEWBOOL'POS (FALSE) /= 0 THEN
-                FAILED ( "WRONG POS FOR NEWBOOL'(FALSE)" );
-           END IF;
-           IF NEWBOOL'POS (TRUE) /= 1 THEN
-                FAILED ( "WRONG POS FOR NEWBOOL'(TRUE)" );
-           END IF;
- 
-           IF NEWBOOL'VAL (0) /= FALSE THEN
-                FAILED ( "WRONG NEWBOOL'VAL FOR '0'" );
-           END IF;
-           IF NEWBOOL'VAL (1) /= TRUE THEN
-                FAILED ( "WRONG NEWBOOL'VAL FOR '1'" );
-           END IF;
-      END;
- 
-      BEGIN
-           IF NEWBOOL'VAL (IDENT_INT(-1)) = TRUE THEN
-                FAILED("NEWBOOL'VAL(-1) WRAPPED AROUND TO TRUE"); 
-           END IF;
-           FAILED ( "NO EXCEPTION RAISED FOR NEWBOOL'VAL OF '-1'" );
-      EXCEPTION     
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NEWBOOL'VAL OF '-1'" );
-      END;
- 
-      BEGIN
-           IF NEWBOOL'VAL (IDENT_INT(2)) = FALSE THEN
-                FAILED("NEWBOOL'VAL(2) WRAPPED AROUND TO FALSE");
-           END IF;
-           FAILED ( "NO EXCEPTION RAISED FOR NEWBOOL'VAL OF '2'" );
-      EXCEPTION     
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NEWBOOL'VAL OF '2'" );
-      END;
- 
-      RESULT;
- END C35508K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- C35508L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE 
- -- PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS A 
- -- BOOLEAN TYPE.
- 
- -- RJW 3/24/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35508L IS
- 
- BEGIN
-      TEST ("C35508L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
-                       "IS A BOOLEAN TYPE" );
- 
-      DECLARE
-           TYPE NEWBOOL IS NEW BOOLEAN;
- 
-           GENERIC 
-                TYPE BOOL IS (<>);
-           PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER);
- 
-           PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER) IS
-                SUBTYPE SBOOL IS BOOL 
-                RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0));
-           BEGIN
-                IF BOOL'POS (B) /= I THEN
-                     FAILED ( "WRONG " & STR & "'POS FOR " &
-                               BOOL'IMAGE (B) & " - 1" );
-                END IF;
-                IF BOOL'VAL (I) /= B THEN
-                     FAILED ( "WRONG " & STR & "'VAL FOR " &
-                               INTEGER'IMAGE (I) & " - 1" );
-                END IF;
- 
-                IF SBOOL'POS (B) /= I THEN
-                     FAILED ( "WRONG " & STR & "'POS FOR " &
-                               BOOL'IMAGE (B) & " - 2" );
-                END IF;
- 
-                IF SBOOL'VAL (I) /= B THEN
-                     FAILED ( "WRONG " & STR & "'VAL FOR " &
-                               INTEGER'IMAGE (I) & " - 2" );
-                END IF;
-           END P;
- 
-           GENERIC 
-                TYPE BOOL IS (<>);
-           PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER);
- 
-           PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER) IS
-                SUBTYPE SBOOL IS BOOL 
-                RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0));
-           BEGIN
-                BEGIN
-                     IF BOOL'VAL (I) = B THEN
-                          FAILED (STR & "'VAL OF " & INTEGER'IMAGE (I) &
-                                        " = " & BOOL'IMAGE (B));
-                     END IF;
-                     FAILED ( "NO EXCEPTION RAISED FOR " & STR & 
-                              "'VAL OF " & INTEGER'IMAGE (I) );
-                EXCEPTION     
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " & STR &
-                                   "'VAL " & "OF " &
-                                    INTEGER'IMAGE (I) );
-                END;
-           
-                BEGIN
-                     IF SBOOL'VAL (I) = B THEN
-                          FAILED (STR & " SBOOL'VAL OF " & 
-                                  INTEGER'IMAGE(I) & " = " &
-                                  BOOL'IMAGE (B) );
-                          END IF;
-                          FAILED( "NO EXCEPTION RAISED FOR VAL OF " &
-                                   INTEGER'IMAGE (I)  &
-                                  "WITH SBOOL OF " & STR);
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " & STR &
-                                   "'VAL " & "OF " &
-                                    INTEGER'IMAGE (I) &
-                                   "WITH SBOOL " );  
-                END;
-           END Q;
- 
-           PROCEDURE NP1 IS NEW P ( BOOL => BOOLEAN );
-           PROCEDURE NP2 IS NEW P ( BOOL => NEWBOOL );
-           PROCEDURE NQ1 IS NEW Q ( BOOL => BOOLEAN );
-           PROCEDURE NQ2 IS NEW Q ( BOOL => NEWBOOL );
-      BEGIN
-           NP1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(0) );
-           NP1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(1) );
-           NP2 ( "NEWBOOL", FALSE , 0 );
-           NP2 ( "NEWBOOL", TRUE , 1 );
-           NQ1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(-1) );
-           NQ1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(2) );
-           NQ2 ( "NEWBOOL", FALSE , -1 );
-           NQ2 ( "NEWBOOL", TRUE , 2 );
-      END;
- 
-      RESULT;
- END C35508L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508o.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C35508O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS A BOOLEAN TYPE.
- 
- -- HISTORY:
- --     RJW 03/19/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35508O IS
- 
- BEGIN
-      TEST ("C35508O", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "BOOLEAN TYPE" );
- 
-      DECLARE
-           SUBTYPE TBOOL IS BOOLEAN RANGE IDENT_BOOL(TRUE) ..
-                                                      IDENT_BOOL(TRUE);
-           SUBTYPE FBOOL IS BOOLEAN
-                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
-           SUBTYPE NOBOOL IS BOOLEAN
-                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
-           TYPE NEWBOOL IS NEW BOOLEAN;
-           TYPE NIL IS NEW BOOLEAN RANGE IDENT_BOOL(TRUE) ..
-                                                     IDENT_BOOL(FALSE);
- 
-      BEGIN
-           IF IDENT_BOOL(BOOLEAN'FIRST) /= FALSE THEN
-                FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST" );
-           END IF;
-           IF IDENT_BOOL(BOOLEAN'LAST) /= TRUE THEN
-                FAILED ( "WRONG VALUE FOR BOOLEAN'LAST" );
-           END IF;
- 
-           IF TBOOL'FIRST /= TRUE THEN
-                FAILED ( "WRONG VALUE FOR TBOOL'FIRST" );
-           END IF;
-           IF TBOOL'LAST /= TRUE THEN
-                FAILED ( "WRONG VALUE FOR TBOOL'LAST" );
-           END IF;
- 
-           IF FBOOL'FIRST /= FALSE THEN
-                FAILED ( "WRONG VALUE FOR FBOOL'FIRST" );
-           END IF;
-           IF FBOOL'LAST /= FALSE THEN
-                FAILED ( "WRONG VALUE FOR FBOOL'LAST" );
-           END IF;
- 
-           IF NOBOOL'FIRST /= TRUE THEN
-                FAILED ( "WRONG VALUE FOR NOBOOL'FIRST" );
-           END IF;
-           IF NOBOOL'LAST /= FALSE THEN
-                FAILED ( "WRONG VALUE FOR NOBOOL'LAST" );
-           END IF;
- 
-           IF NEWBOOL'FIRST /= FALSE THEN
-                FAILED ( "WRONG VALUE FOR NEWBOOL'FIRST" );
-           END IF;
-           IF NEWBOOL'LAST /= TRUE THEN
-                FAILED ( "WRONG VALUE FOR NEWBOOL'LAST" );
-           END IF;
-           IF NIL'FIRST /= TRUE THEN
-                FAILED ( "WRONG VALUE FOR NIL'FIRST" );
-           END IF;
-           IF NIL'LAST /= FALSE THEN
-                FAILED ( "WRONG VALUE FOR NIL'LAST" );
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C35508O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35508p.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35508p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,131 ****
- -- C35508P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
- --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
- --     IS A BOOLEAN TYPE.
- 
- -- HISTORY:
- --     RJW 03/19/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35508P IS
- 
- BEGIN
-      TEST ("C35508P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
-                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
-                       "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
-                       "PARAMETER IS A BOOLEAN TYPE" );
-      DECLARE
-           SUBTYPE TBOOL IS BOOLEAN
-                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
-           SUBTYPE FBOOL IS BOOLEAN
-                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
-           SUBTYPE NOBOOL IS BOOLEAN
-                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
-           TYPE NEWBOOL IS NEW BOOLEAN;
- 
-           GENERIC
-                TYPE BOOL IS (<>);
-                F, L : BOOL;
-           PROCEDURE P ( STR : STRING );
- 
-           PROCEDURE P ( STR : STRING ) IS
-           BEGIN
-                IF BOOL'FIRST /= F THEN
-                     FAILED ( "WRONG VALUE FOR " & STR & "'FIRST" );
-                END IF;
-                IF BOOL'LAST /= L THEN
-                     FAILED ( "WRONG VALUE FOR " & STR & "'LAST" );
-                END IF;
-           END P;
- 
-           GENERIC
-                TYPE BOOL IS (<>);
-           PROCEDURE Q;
- 
-           PROCEDURE Q IS
-           BEGIN
-                IF BOOL'FIRST /= BOOL'VAL (IDENT_INT(1)) THEN
-                     FAILED ( "WRONG 'FIRST FOR NOBOOL" );
-                END IF;
-                IF BOOL'LAST /= BOOL'VAL (IDENT_INT(0)) THEN
-                     FAILED ( "WRONG 'LAST FOR NOBOOL" );
-                END IF;
-           END Q;
- 
-           GENERIC
-                TYPE BOOL IS (<>);
-                F, L : BOOL;
-           PROCEDURE R;
- 
-           PROCEDURE R IS
-                SUBTYPE SBOOL IS BOOL
-                               RANGE BOOL'VAL (0) .. BOOL'VAL (1);
-           BEGIN
-                IF SBOOL'FIRST /= F THEN
-                     FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST AS " &
-                              "SUBTYPE " );
-                END IF;
-                IF SBOOL'LAST /= L THEN
-                     FAILED ( "WRONG VALUE FOR BOOLEAN'LAST AS " &
-                              "SUBTYPE" );
-                END IF;
-           END R;
- 
-           PROCEDURE P1 IS NEW P
-           ( BOOL => BOOLEAN, F => IDENT_BOOL(FALSE),
-                                               L => IDENT_BOOL(TRUE) );
- 
-           PROCEDURE P2 IS NEW P
-           ( BOOL => TBOOL, F => IDENT_BOOL(TRUE),
-                                               L => IDENT_BOOL(TRUE) );
- 
-           PROCEDURE P3 IS NEW P
-           ( BOOL => FBOOL, F => IDENT_BOOL(FALSE),
-                                              L => IDENT_BOOL(FALSE) );
- 
-           PROCEDURE P4 IS NEW P
-                          (BOOL => NEWBOOL, F => FALSE, L => TRUE );
- 
-           PROCEDURE Q1 IS NEW Q
-                          ( BOOL => NOBOOL );
- 
-           PROCEDURE R1 IS NEW R
-                          ( BOOL => BOOLEAN, F => FALSE, L => TRUE );
- 
-      BEGIN
-           P1 ( "BOOLEAN" );
-           P2 ( "TBOOL" );
-           P3 ( "FBOOL" );
-           P4 ( "NEWBOOL" );
-           Q1;
-           R1;
-      END;
- 
-      RESULT;
- END C35508P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35703a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35703a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35703a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35703a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C35703A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'FIRST AND 'LAST EXIST AND CAN BE ASSIGNED.  CHECK THAT
- -- 'FIRST IS LESS THAN OR EQUAL TO 'LAST.
- 
- -- BAW 5 SEPT 80
- -- R.WILLIAMS 8/21/86    ADDED A TYPE DECLARED WITHOUT A RANGE
- --                       CONSTRAINT.  RENAMED TO -B.  ADDED EXCEPTION
- --                       HANDLERS.
- -- GMT 6/29/87           MOVED THE CALL TO  REPORT.TEST INTO A NEWLY
- --                       CREATED PACKAGE NAMED SHOW_TEST_HEADER.
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35703A IS
- 
-      TYPE REAL1 IS DIGITS 2 RANGE 0.25..0.5;
-      TYPE REAL2 IS DIGITS 3;
- 
-      PACKAGE  SHOW_TEST_HEADER  IS
-               -- PURPOSE OF THIS PACKAGE:
-               -- WE WANT THE TEST HEADER INFORMATION TO BE
-               -- PRINTED  BEFORE  ANY OF THE  PASS/FAIL  MESSAGES.
-      END SHOW_TEST_HEADER;
- 
-      PACKAGE  BODY  SHOW_TEST_HEADER  IS
-      BEGIN
-           TEST( "C35703A",
-                 "CHECK THAT FIRST AND LAST CAN BE ASSIGNED " &
-                 "AND THAT FIRST <= LAST" );
-      END SHOW_TEST_HEADER;
- 
-      PACKAGE XPKG IS
-           X : REAL1;
-      END XPKG;
- 
-      PACKAGE BODY XPKG IS
-      BEGIN
-           X := REAL1'FIRST;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
-                         "REAL1'FIRST" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
-                         "REAL1'FIRST" );
-      END XPKG;
- 
-      PACKAGE YPKG IS
-           Y : REAL1;
-      END YPKG;
- 
-      PACKAGE BODY YPKG IS
-      BEGIN
-           Y := REAL1'LAST;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
-                         "REAL1'LAST" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
-                         "REAL1'LAST" );
-      END YPKG;
- 
-      PACKAGE APKG IS
-           A : REAL2;
-      END APKG;
- 
-      PACKAGE BODY APKG IS
-      BEGIN
-           A := REAL2'FIRST;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
-                         "REAL2'FIRST" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
-                         "REAL2'FIRST" );
-      END APKG;
- 
-      PACKAGE BPKG IS
-           B : REAL2;
-      END BPKG;
- 
-      PACKAGE BODY BPKG IS
-      BEGIN
-           B := REAL2'LAST;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
-                         "REAL2'LAST" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
-                         "REAL2'LAST" );
-      END BPKG;
- 
- 
- BEGIN
- 
-      DECLARE
-           USE XPKG;
-           USE YPKG;
-      BEGIN
-           IF X > Y THEN
-                FAILED ( "REAL1'FIRST IS GREATER THAN REAL1'LAST" );
-           END IF;
-      END;
- 
-      DECLARE
-           USE APKG;
-           USE BPKG;
-      BEGIN
-           IF A > B THEN
-                FAILED ( "REAL2'FIRST IS GREATER THEN REAL2'LAST" );
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C35703A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- C35704A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FIXED POINT VALUES CAN BE USED IN FLOATING POINT RANGE
- -- CONSTRAINT IN TYPE DEFINITION.
- 
- -- BAW 9/5/80
- -- JCR 4/7/82
- 
- WITH REPORT;
- PROCEDURE C35704A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C35704A","CHECK THAT L AND R CAN BE FIXED POINT" &
-            " IN A FLOATING POINT TYPE DEFINITION");
- 
-      DECLARE
- 
- 
-           TYPE F IS DELTA 0.5 RANGE -5.0..5.0;
- 
-           F1 : CONSTANT F := -4.0;
-           F2 : CONSTANT F := 4.0;
- 
-           TYPE G1 IS DIGITS 5 RANGE F1..F2;
-      BEGIN
- 
-           IF (ABS(G1'FIRST)-4.0) /= 0.0 OR
-              (ABS(G1'LAST)-4.0)  /= 0.0
-           THEN FAILED ("ERROR IN USING FIXED-POINT IN RANGE " &
-                        "CONSTRAINT");
-           END IF;
- 
-      END;
-      RESULT;
- 
- END C35704A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- C35704B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DIFFERENT FLOATING POINT TYPES FROM SAME PARENT CAN BE
- -- USED IN A FLOATING POINT RANGE CONSTRAINT IN A TYPE DEFINITION.
- 
- -- JCR 4/7/82
- 
- WITH REPORT;
- PROCEDURE C35704B IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C35704B", "DIFFERENT FLOATING POINT TYPES " &
-            "FROM THE SAME PARENT IN FLOATING POINT" &
-            "TYPE DEFINITION'S RANGE CONSTRAINT");
- 
-      DECLARE
-           TYPE F IS  DIGITS 5 RANGE -5.0 .. 5.0;
- 
-           TYPE F1 IS NEW F;
- 
-           TYPE G1 IS DIGITS 5 RANGE F1'FIRST..F'LAST;
-           TYPE G2 IS DIGITS 5 RANGE F'FIRST..F1'LAST;
- 
-      BEGIN
- 
-           IF G1'FIRST /= G1(G2'FIRST) OR G1'LAST /= G1(G2'LAST) OR
-              G2'FIRST /= G2(F'FIRST) OR G2'LAST /= G2(F'LAST)
-           THEN 
-                FAILED ("USING DIFF FLOATING POINT TYPES " &
-                        "FROM SAME PARENT");
- 
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C35704B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- C35704C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DIFFERENT FLOATING POINT TYPES FROM DIFFERENT PARENTS
- -- CAN BE USE IN FLOATING POINT RANGE CONSTRAINTS IN TYPE DEFINITIONS.
- 
- -- JCR 4/7/82
- 
- WITH REPORT;
- PROCEDURE C35704C IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C35704C", "DIFFERENT FLOATING POINT TYPES " &
-            "FROM DIFFERENT PARENTS IN FLOATING POINT RANGE " &
-            "CONSTRAINT IN TYPE DEFINITION");
- 
-      DECLARE
- 
-           TYPE F IS DIGITS 5 RANGE -5.0 .. 5.0;
-           TYPE F1 IS DIGITS 5 RANGE -5.0 .. 5.0;
-      
-           TYPE G1 IS DIGITS 5 RANGE  F'FIRST..F1'LAST;
-           TYPE G2 IS DIGITS 5 RANGE F1'FIRST..F'LAST;
-      
-      BEGIN
- 
- 
-           IF G1'FIRST /= G1(F'FIRST) OR G1'FIRST /= G1(G2'FIRST) OR
-           G1'FIRST /= G1(F1'FIRST) OR G1'LAST /= G1(F'LAST) OR
-           G1'LAST /= G1(G2'LAST) OR G1'LAST /= G1(F1'LAST)
- 
-           THEN FAILED ("USING FLOAT FROM DIFF PARENTS");
- 
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C35704C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35704d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35704d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- C35704D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A COMBINATION OF FIXED AND FLOAT CAN BE USED IN A
- -- FLOATING POINT RANGE CONSTRAINT IN A TYPE DEFINITION.
- 
- -- JCR 4/7/82
- 
- WITH REPORT;
- PROCEDURE C35704D IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C35704D","MIXED FIXED AND FLOAT IN FLOATING " &
-            "POINT RANGE CONSTRAINT IN A TYPE DEFINITION");
- 
-      DECLARE
- 
-           TYPE F IS DIGITS 5;
-           TYPE R IS DELTA 0.5 RANGE -5.0 .. 5.0;
- 
-           T1 : CONSTANT F := -4.0;
-           T2 : CONSTANT F := 4.0;
- 
-           R1 : CONSTANT R := -4.0;
-           R2 : CONSTANT R := 4.0;
- 
-           TYPE G1 IS DIGITS 5 RANGE T1..R2;
-           TYPE G2 IS DIGITS 5 RANGE R1..T2;
- 
-      BEGIN
- 
-           IF (ABS(G1'FIRST)- 4.0) /= 0.0  OR
-              (ABS(G1'LAST) - 4.0) /= 0.0  OR
-              (ABS(G2'FIRST)- 4.0) /= 0.0  OR
-              (ABS(G2'LAST) - 4.0) /= 0.0
-      
-           THEN FAILED ("MIXED FIXED AND FLOAT IN FLOAT RANGE " &
-                        "CONSTRAINT");
-      
-           END IF;
- 
-      END;
- 
-      RESULT;
-  
- 
- END C35704D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35801d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35801d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35801d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35801d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C35801D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ATTRIBUTES FIRST AND LAST RETURN VALUES HAVING THE
- -- SAME BASE TYPE AS THE PREFIX WHEN THE PREFIX IS A GENERIC FORMAL 
- -- SUBTYPE WHOSE ACTUAL ARGUMENT IS A FLOATING POINT TYPE.
- 
- -- R.WILLIAMS 8/21/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35801D IS
-      TYPE REAL IS DIGITS 3 RANGE -100.0 .. 100.0;
- 
-      TYPE NFLT IS NEW FLOAT;
- 
-      GENERIC
-           TYPE F IS DIGITS <>;
-      PROCEDURE P (STR : STRING);
- 
-      PROCEDURE P (STR : STRING) IS
- 
-           SUBTYPE SF IS F RANGE -1.0 .. 1.0;
-           F1 : SF := 0.0;
-           F2 : SF := 0.0;
-           
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                F1 := SF'FIRST;
-                F2 := SF'LAST;
-           END IF;
- 
-           IF F1 /= -1.0 OR F2 /= 1.0 THEN
-                FAILED ( "WRONG RESULTS FROM " & STR & "'FIRST OR " &
-                         STR & "'LAST" );
-           END IF;
-      END P;
-      
-      PROCEDURE NP1 IS NEW P (FLOAT);
- 
-      PROCEDURE NP2 IS NEW P (NFLT);
- 
-      PROCEDURE NP3 IS NEW P (REAL);
- 
- BEGIN
-      TEST ( "C35801D", "CHECK THAT THE ATTRIBUTES FIRST AND " &
-                        "LAST RETURN VALUES HAVING THE SAME " &
-                        "BASE TYPE AS THE PREFIX WHEN THE " &
-                        "PREFIX IS A GENERIC FORMAL SUBTYPE " &
-                        "WHOSE ACTUAL ARGUMENT IS A FLOATING " &
-                        "POINT TYPE" );
- 
- 
-      NP1 ("FLOAT");
-      NP2 ("NFLT");
-      NP3 ("REAL");
- 
-      RESULT;     
- END C35801D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35902d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35902d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35902d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35902d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- C35902D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BINARY POINT IN THE MANTISSA OF A FIXED POINT NUMBER
- -- CAN LIE OUTSIDE THE MANTISSA (EITHER TO THE LEFT OR TO THE RIGHT).
- 
- -- WRG 7/18/86
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C35902D IS
- 
- BEGIN
- 
-      TEST ("C35902D", "CHECK THAT THE BINARY POINT IN THE MANTISSA " &
-                       "OF A FIXED POINT NUMBER CAN LIE OUTSIDE THE " &
-                       "MANTISSA (EITHER TO THE LEFT OR TO THE RIGHT)");
- 
-      COMMENT ("VALUE OF SYSTEM.MAX_MANTISSA IS" &
-               POSITIVE'IMAGE(MAX_MANTISSA) );
- 
-   A: DECLARE
- 
-           RS : CONSTANT := 2.0;
- 
-           TYPE ONE_TO_THE_RIGHT IS
-                DELTA RS
-                RANGE -(2.0 ** (MAX_MANTISSA+1) ) ..
-                        2.0 ** (MAX_MANTISSA+1);
-                -- THE BINARY POINT IS ONE PLACE TO THE RIGHT OF THE
-                -- LARGEST POSSIBLE MANTISSA.
- 
-           R1, R2 : ONE_TO_THE_RIGHT;
- 
-      BEGIN
- 
-           R1 := RS;
-           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
-                R1 := R1 * IDENT_INT (2);
-           END LOOP;
-           R2 := R1 - RS;
-           R2 := R2 + R1;
-           -- AT THIS POINT, R2 SHOULD EQUAL ONE_TO_THE_RIGHT'LARGE.
-           R2 := -R2;
-           R2 := R2 + (R1 - RS);
-           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
-                R2 := R2 / IDENT_INT (2);
-           END LOOP;
-           IF R2 /= -RS THEN
-                FAILED ("IDENTITY-PRESERVING OPERATIONS ARE FLAKY - A");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - A");
- 
-      END A;
- 
-   B: DECLARE
- 
-           LS : CONSTANT := 2.0 ** (-(MAX_MANTISSA+1) );
- 
-           TYPE ONE_TO_THE_LEFT IS
-                DELTA LS
-                RANGE -(2.0 ** (-1) ) ..
-                        2.0 ** (-1);
-                -- THE BINARY POINT IS ONE PLACE TO THE LEFT OF THE
-                -- LARGEST POSSIBLE MANTISSA.
- 
-           L1, L2 : ONE_TO_THE_LEFT;
- 
-      BEGIN
- 
-           L1 := LS;
-           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
-                L1 := L1 * IDENT_INT (2);
-           END LOOP;
-           L2 := L1 - LS;
-           L2 := L2 + L1;
-           -- AT THIS POINT, L2 SHOULD EQUAL ONE_TO_THE_LEFT'LARGE.
-           L2 := -L2;
-           L2 := L2 + (L1 - LS);
-           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
-                L2 := L2 / IDENT_INT (2);
-           END LOOP;
-           IF L2 /= -LS THEN
-                FAILED ("IDENTITY-PRESERVING OPERATIONS ARE FLAKY - B");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - B");
- 
-      END B;
- 
-      RESULT;
- 
- END C35902D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35904a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35904a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35904a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35904a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C35904A.ADA
-  
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INCOMPATIBLE FIXED POINT CONSTRAINTS RAISE
- --     APPROPRIATE EXCEPTIONS.
-  
-  
- -- HISTORY:
- --     RJK 05/17/83  CREATED ORIGINAL TEST.
- --     PWB 02/03/86  CORRECTED TEST ERROR:
- --                   ADDED POSSIBLITY OF NUMERIC_ERROR
- --                   IN DECLARATIONS OF SFX3 AND SFX4.
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  CHANGED RANGE
- --                   CONSTRAINTS OF SUBTYPE SFX1.  CHANGED UPPER BOUND
- --                   OF THE CONSTRAINT OF SFX4.  CHANGED RANGE
- --                   CONSTRAINTS OF FIX.
- --     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
- --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
- --     EDS 07/16/98  AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35904A IS
- 
-      TYPE FIX IS DELTA 0.5 RANGE -3.0 .. 3.0;
- 
- BEGIN
- 
-      TEST ("C35904A", "CHECK THAT INCOMPATIBLE FIXED POINT " &
-                       "CONSTRAINTS RAISE APPROPRIATE EXCEPTION");
-  
- -- TEST FOR CORRECT SUBTYPE DEFINITION FOR COMPATIBILITY BETWEEN TYPE
- -- AND SUBTYPE CONSTRAINTS.
-  
-      BEGIN
-  
-           DECLARE
-  
-                SUBTYPE SFX1 IS FIX DELTA 1.0 RANGE 0.0 .. 2.0;   -- OK.
-                SFX1_VAR : SFX1;
-  
-           BEGIN
-                SFX1_VAR := 1.0;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                 FAILED ("FIXED POINT CONSTRAINTS ARE NOT IN ERROR");
-           WHEN OTHERS =>
-                 FAILED ("EXCEPTION SHOULD NOT BE RAISED WHILE " &
-                         "CHECKING DELTA CONSTRAINT");
-      END;
- 
- -- TEST FOR INCORRECT SUBTYPE DEFINITION ON ACCURACY BETWEEN TYPE AND
- -- SUBTYPE DEFINITIONS.
- 
-      BEGIN
- 
-           DECLARE
- 
-                SUBTYPE SFX IS FIX DELTA 0.1;  -- DELTA IS SMALLER FOR
-                                               -- SUBTYPE THAN FOR TYPE.
-                -- DEFINE AN OBJECT OF SUBTYPE SFX AND USE IT TO AVOID 
-                -- OPTIMIZATION OF SUBTYPE
-                SFX_VAR : SFX := FIX(IDENT_INT(1));
- 
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED FOR INCOMPATABLE DELTA " & 
-                        FIX'IMAGE(SFX_VAR) );  --USE SFX_VAR
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
-                        "DELTA CONSTRAINT");
-      END;
- 
-      RESULT;
- 
- END C35904A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35904b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35904b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35904b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35904b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C35904B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INCOMPATIBLE FIXED POINT CONSTRAINTS RAISE
- -- CONSTRAINT_ERROR FOR GENERIC FORMAL TYPES.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- RJW 6/20/86
- -- DWC 07/24/87     -- ADDED NUMERIC_ERROR HANDLERS.
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- -- EDS 07/16/98 AVOID OPTIMIZATION 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35904B IS
- 
-      GENERIC
-           TYPE FIX IS DELTA <>;
-      PROCEDURE PROC (STR : STRING);
- 
-      PROCEDURE PROC (STR : STRING) IS
-           SUBTYPE SFIX IS FIX DELTA 0.1 RANGE -1.0 .. 1.0;
-           -- DEFINE AN OBJECT OF SUBTYPE SFIX AND USE IT TO AVOID 
-           -- OPTIMIZATION OF SUBTYPE
-           SFIX_VAR : SFIX := SFIX(IDENT_INT(0));
-      BEGIN
-           FAILED ("NO EXCEPTION RAISED FOR " & STR & " " &
-                   SFIX'IMAGE(SFIX_VAR) );  --USE SFIX_VAR
-      END PROC;
- 
- BEGIN
- 
-      TEST ( "C35904B", "CHECK THAT INCOMPATIBLE FIXED POINT " &
-                        "CONSTRAINTS RAISE CONSTRAINT_ERROR " &
-                        "FOR GENERIC FORMAL TYPES" );
- 
- -- TEST FOR INCORRECT SUBTYPE DEFINITION ON ACCURACY BETWEEN TYPE AND
- -- SUBTYPE DEFINITIONS.
- 
-      BEGIN
- 
-           DECLARE
- 
-                TYPE FIX1 IS DELTA 0.5          -- DELTA IS SMALLER FOR
-                          RANGE -2.0 .. 2.0;    -- SUBTYPE THEN FOR
-                                                -- TYPE.
- 
-                PROCEDURE NPROC IS NEW PROC (FIX1);
- 
-           BEGIN
-                NPROC ( "INCOMPATIBLE DELTA" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
-                        "DELTA CONSTRAINT");
-      END;
- 
- -- TEST THAT CONSTRAINT_ERROR IS RAISED
- -- FOR A RANGE VIOLATION.
- 
-      BEGIN
- 
-           DECLARE
- 
-                TYPE FIX2 IS DELTA 0.1 RANGE 0.0 .. 2.0; -- LOWER
-                                                         -- BOUND.
- 
-                PROCEDURE NPROC IS NEW PROC (FIX2);
- 
-           BEGIN
-                NPROC ("FIXED POINT LOWER BOUND CONSTRAINT VIOLATION");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
-                         "LOWER BOUND VIOLATION");
-           WHEN OTHERS =>
-                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
-                        "FIXED POINT LOWER BOUND CONSTRAINT");
-      END;
- 
- -- TEST THAT CONSTRAINT_ERROR IS RAISED
- -- FOR A RANGE VIOLATION.
- 
-      BEGIN
- 
-           DECLARE
- 
-                TYPE FIX3 IS DELTA 0.1 RANGE -2.0 .. 0.0;  -- UPPER
-                                                           -- BOUND.
- 
-                PROCEDURE NPROC IS NEW PROC (FIX3);
-           BEGIN
-                NPROC ("FIXED POINT UPPER BOUND CONSTRAINT VIOLATION");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
-                         "UPPER BOUND VIOLATION");
-           WHEN OTHERS =>
-                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
-                        "FIXED POINT UPPER BOUND CONSTRAINT");
-      END;
- 
-      RESULT;
- 
- END C35904B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a02a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a02a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a02a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C35A02A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT T'DELTA YIELDS CORRECT VALUES FOR SUBTYPE T.
- 
- -- RJW 2/27/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35A02A IS
- 
- BEGIN
- 
-      TEST ( "C35A02A", "CHECK THAT T'DELTA YIELDS CORRECT VALUES " &
-                        "FOR SUBTYPE T" );
-                               
-      DECLARE
-           D  : CONSTANT := 0.125;
-           SD : CONSTANT := 1.0;
-      
-           TYPE VOLT IS DELTA D RANGE 0.0 .. 255.0;
-           SUBTYPE ROUGH_VOLTAGE IS VOLT DELTA SD;
- 
-           GENERIC
-                TYPE FIXED IS DELTA <> ;
-           FUNCTION F RETURN FIXED;
- 
-           FUNCTION F RETURN FIXED IS
-           BEGIN
-                RETURN FIXED'DELTA;
-           END F;
- 
-           FUNCTION VF IS NEW F (VOLT);
-           FUNCTION RF IS NEW F (ROUGH_VOLTAGE);
- 
-      BEGIN 
-           IF VOLT'DELTA /= D THEN
-                FAILED ( "INCORRECT VALUE FOR VOLT'DELTA" );
-           END IF;
-           IF ROUGH_VOLTAGE'DELTA /= SD THEN 
-                FAILED ( "INCORRECT VALUE FOR ROUGH_VOLTAGE'DELTA" );
-           END IF;
- 
-           IF VF /= D THEN
-                FAILED ( "INCORRECT VALUE FOR VF" );
-           END IF;
-           IF RF /= SD THEN
-                FAILED ( "INCORRECT VALUE FOR RF" );
-           END IF;
-      END;               
- 
-      RESULT;
- 
- END C35A02A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C35A05A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
- -- THE CORRECT VALUES.
- 
- -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
- 
- -- WRG 8/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35A05A IS
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE LEFT_OUT_M1       IS DELTA 0.25  RANGE -0.5 .. 0.5;
-      TYPE LEFT_EDGE_M1      IS DELTA 0.5   RANGE -1.0 .. 1.0;
-      TYPE RIGHT_EDGE_M1     IS DELTA 1.0   RANGE -2.0 .. 2.0;
-      TYPE RIGHT_OUT_M1      IS DELTA 2.0   RANGE -4.0 .. 4.0;
-      TYPE MIDDLE_M2         IS DELTA 0.5   RANGE -2.0 .. 2.0;
-      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
-      TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
-      TYPE MIDDLE_M16        IS DELTA 2.0 **(-6) RANGE -1024.0 .. 1024.0;
-      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
-      TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
-      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
-      TYPE DECIMAL_M11       IS DELTA 0.09999 RANGE  -100.0 ..    100.0;
-      TYPE DECIMAL2_M18      IS DELTA 0.1   RANGE   -9999.0 ..   9999.0;
- 
-      -------------------------------------------------------------------
- 
-      SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
-           DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
-      SUBTYPE ST_MIDDLE_M14   IS MIDDLE_M16
-           DELTA 2.0 ** (-5) RANGE -512.0 .. IDENT_INT (1) * 512.0;
-      SUBTYPE ST_MIDDLE_M2    IS LIKE_DURATION_M23
-           DELTA 0.5 RANGE -2.0 .. 2.0;
-      SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
-           DELTA 0.5 RANGE  0.0 .. 2.5;
-      SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
-           DELTA  10.0 RANGE -1000.0 .. 1000.0;
-      SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
-           DELTA 100.0 RANGE  -500.0 ..  500.0;
- 
-      -------------------------------------------------------------------
- 
-      PROCEDURE CHECK_FORE_AND_AFT
-          (NAME        : STRING;
-           ACTUAL_FORE : INTEGER; CORRECT_FORE : POSITIVE;
-           ACTUAL_AFT  : INTEGER; CORRECT_AFT  : POSITIVE) IS
-      BEGIN
-           IF ACTUAL_FORE /= IDENT_INT (CORRECT_FORE) THEN
-                FAILED (NAME & "'FORE =" & INTEGER'IMAGE(ACTUAL_FORE) );
-           END IF;
-           IF ACTUAL_AFT /= IDENT_INT (CORRECT_AFT) THEN
-                FAILED (NAME & "'AFT  =" & INTEGER'IMAGE(ACTUAL_AFT) );
-           END IF;
-      END CHECK_FORE_AND_AFT;
- 
- BEGIN
- 
-      TEST ("C35A05A", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
-                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
-                       "BASIC TYPES");
- 
-      CHECK_FORE_AND_AFT ("LEFT_OUT_M1",       LEFT_OUT_M1'FORE, 2,
-                                               LEFT_OUT_M1'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("LEFT_EDGE_M1",      LEFT_EDGE_M1'FORE, 2,
-                                               LEFT_EDGE_M1'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("RIGHT_EDGE_M1",     RIGHT_EDGE_M1'FORE, 2,
-                                               RIGHT_EDGE_M1'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("RIGHT_OUT_M1",      RIGHT_OUT_M1'FORE, 2,
-                                               RIGHT_OUT_M1'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("MIDDLE_M2",         MIDDLE_M2'FORE, 2,
-                                               MIDDLE_M2'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("MIDDLE_M3",         MIDDLE_M3'FORE, 2,
-                                               MIDDLE_M3'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("MIDDLE_M15",        MIDDLE_M15'FORE, 4,
-                                               MIDDLE_M15'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("MIDDLE_M16",        MIDDLE_M16'FORE, 5,
-                                               MIDDLE_M16'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("LIKE_DURATION_M23", LIKE_DURATION_M23'FORE, 6,
-                                               LIKE_DURATION_M23'AFT, 2);
- 
-      CHECK_FORE_AND_AFT ("DECIMAL_M18",       DECIMAL_M18'FORE, 6,
-                                               DECIMAL_M18'AFT,  1);
- 
-      IF DECIMAL_M4'FORE /= 5 AND DECIMAL_M4'FORE /= 4 THEN
-           FAILED ("DECIMAL_M4'FORE =" &
-                   INTEGER'IMAGE(DECIMAL_M4'FORE) );
-      END IF;
-      IF DECIMAL_M4'AFT /= 1 THEN
-           FAILED ("DECIMAL_M4'AFT  =" &
-                   INTEGER'IMAGE(DECIMAL_M4'AFT) );
-      END IF;
- 
-      CHECK_FORE_AND_AFT ("DECIMAL_M11",       DECIMAL_M11'FORE, 4,
-                                               DECIMAL_M11'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("DECIMAL2_M18",      DECIMAL2_M18'FORE, 5,
-                                               DECIMAL2_M18'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("ST_LEFT_EDGE_M6",   ST_LEFT_EDGE_M6'FORE, 2,
-                                               ST_LEFT_EDGE_M6'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("ST_MIDDLE_M14",     ST_MIDDLE_M14'FORE, 4,
-                                               ST_MIDDLE_M14'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("ST_MIDDLE_M2",      ST_MIDDLE_M2'FORE, 2,
-                                               ST_MIDDLE_M2'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("ST_MIDDLE_M3",      ST_MIDDLE_M3'FORE, 2,
-                                               ST_MIDDLE_M3'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("ST_DECIMAL_M7",     ST_DECIMAL_M7'FORE, 5,
-                                               ST_DECIMAL_M7'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("ST_DECIMAL_M3",     ST_DECIMAL_M3'FORE, 4,
-                                               ST_DECIMAL_M3'AFT,  1);
- 
-      RESULT;
- 
- END C35A05A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C35A05D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
- -- THE CORRECT VALUES.
- 
- -- CASE D: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC.
- 
- -- WRG 8/14/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35A05D IS
- 
-      PI      : CONSTANT := 3.14159_26535_89793_23846;
-      TWO_PI  : CONSTANT := 2 * PI;
-      HALF_PI : CONSTANT := PI / 2;
- 
-      MM : CONSTANT := 23;
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE MICRO_ANGLE_ERROR_M15  IS
-           DELTA 16.0  RANGE -(2.0 ** 19) .. 2.0 ** 19;
-      TYPE TRACK_RANGE_M15        IS
-           DELTA 0.125 RANGE -(2.0 ** 12) .. 2.0 ** 12;
-      TYPE SECONDS_MM             IS
-           DELTA 2.0 ** (8 - MM) RANGE -(2.0 ** 8) .. 2.0 ** 8;
-      TYPE RANGE_CELL_MM          IS
-           DELTA 2.0 ** (-5)
-           RANGE -(2.0 ** (MM - 5) ) .. 2.0 ** (MM - 5);
- 
-      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
-      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
- 
-      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
-      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
- 
-      TYPE SYMMETRIC_DEGREES_M7  IS
-           DELTA 2.0         RANGE -180.0 .. 180.0;
-      TYPE NATURAL_DEGREES_M15   IS
-           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
-      TYPE SYMMETRIC_RADIANS_M16 IS
-           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
-      TYPE NATURAL_RADIANS_M8    IS
-           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
- 
-      -------------------------------------------------------------------
- 
-      SUBTYPE ST_MILES_M8             IS MILES_M16
-           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
-      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
-           DELTA 0.25 RANGE 0.0 .. 360.0;
-      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
-           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
- 
-      -------------------------------------------------------------------
- 
-      PROCEDURE CHECK_FORE_AND_AFT
-          (NAME        : STRING;
-           ACTUAL_FORE : INTEGER; CORRECT_FORE : POSITIVE;
-           ACTUAL_AFT  : INTEGER; CORRECT_AFT  : POSITIVE) IS
-      BEGIN
-           IF ACTUAL_FORE /= IDENT_INT (CORRECT_FORE) THEN
-                FAILED (NAME & "'FORE =" & INTEGER'IMAGE(ACTUAL_FORE) );
-           END IF;
-           IF ACTUAL_AFT /= IDENT_INT (CORRECT_AFT) THEN
-                FAILED (NAME & "'AFT  =" & INTEGER'IMAGE(ACTUAL_AFT) );
-           END IF;
-      END CHECK_FORE_AND_AFT;
- 
- BEGIN
- 
-      TEST ("C35A05D", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
-                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
-                       "TYPICAL TYPES");
- 
-      CHECK_FORE_AND_AFT ("MICRO_ANGLE_ERROR_M15",
-                                          MICRO_ANGLE_ERROR_M15'FORE, 7,
-                                          MICRO_ANGLE_ERROR_M15'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("TRACK_RANGE_M15", TRACK_RANGE_M15'FORE, 5,
-                                             TRACK_RANGE_M15'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("SECONDS_MM",      SECONDS_MM'FORE, 4,
-                                             SECONDS_MM'AFT,  5);
- 
-      CHECK_FORE_AND_AFT ("RANGE_CELL_MM",   RANGE_CELL_MM'FORE, 7,
-                                             RANGE_CELL_MM'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("PIXEL_M10",       PIXEL_M10'FORE, 2,
-                                             PIXEL_M10'AFT,  4);
- 
-      CHECK_FORE_AND_AFT ("RULER_M8",        RULER_M8'FORE, 3,
-                                             RULER_M8'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("HOURS_M16",       HOURS_M16'FORE, 3,
-                                             HOURS_M16'AFT,  4);
- 
-      CHECK_FORE_AND_AFT ("MILES_M16",       MILES_M16'FORE, 5,
-                                             MILES_M16'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("SYMMETRIC_DEGREES_M7",
-                                          SYMMETRIC_DEGREES_M7'FORE, 4,
-                                          SYMMETRIC_DEGREES_M7'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("NATURAL_DEGREES_M15",
-                                          NATURAL_DEGREES_M15'FORE, 4,
-                                          NATURAL_DEGREES_M15'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("SYMMETRIC_RADIANS_M16",
-                                          SYMMETRIC_RADIANS_M16'FORE, 2,
-                                          SYMMETRIC_RADIANS_M16'AFT,  5);
- 
-      CHECK_FORE_AND_AFT ("NATURAL_RADIANS_M8",
-                                          NATURAL_RADIANS_M8'FORE, 2,
-                                          NATURAL_RADIANS_M8'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("ST_MILES_M8",  ST_MILES_M8'FORE, 3,
-                                          ST_MILES_M8'AFT,  2);
- 
-      CHECK_FORE_AND_AFT ("ST_NATURAL_DEGREES_M11",
-                                        ST_NATURAL_DEGREES_M11'FORE, 4,
-                                        ST_NATURAL_DEGREES_M11'AFT,  1);
- 
-      CHECK_FORE_AND_AFT ("ST_SYMMETRIC_RADIANS_M8",
-                                        ST_SYMMETRIC_RADIANS_M8'FORE, 2,
-                                        ST_SYMMETRIC_RADIANS_M8'AFT,  2);
- 
-      RESULT;
- 
- END C35A05D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- C35A05N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
- -- THE CORRECT VALUES.
- 
- -- CASE N: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE,
- --         FOR GENERICS.
- 
- -- WRG 8/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35A05N IS
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE LEFT_OUT_M1       IS DELTA 0.25  RANGE -0.5 .. 0.5;
-      TYPE LEFT_EDGE_M1      IS DELTA 0.5   RANGE -1.0 .. 1.0;
-      TYPE RIGHT_EDGE_M1     IS DELTA 1.0   RANGE -2.0 .. 2.0;
-      TYPE RIGHT_OUT_M1      IS DELTA 2.0   RANGE -4.0 .. 4.0;
-      TYPE MIDDLE_M2         IS DELTA 0.5   RANGE -2.0 .. 2.0;
-      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
-      TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
-      TYPE MIDDLE_M16        IS DELTA 2.0 **(-6) RANGE -1024.0 .. 1024.0;
-      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
-      TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
-      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
-      TYPE DECIMAL_M11       IS DELTA 0.09999 RANGE  -100.0 ..    100.0;
-      TYPE DECIMAL2_M18      IS DELTA 0.1   RANGE   -9999.0 ..   9999.0;
- 
-      -------------------------------------------------------------------
- 
-      SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
-           DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
-      SUBTYPE ST_MIDDLE_M14   IS MIDDLE_M16
-           DELTA 2.0 ** (-5) RANGE -512.0 .. IDENT_INT (1) * 512.0;
-      SUBTYPE ST_MIDDLE_M2    IS LIKE_DURATION_M23
-           DELTA 0.5 RANGE -2.0 .. 2.0;
-      SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
-           DELTA 0.5 RANGE  0.0 .. 2.5;
-      SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
-           DELTA  10.0 RANGE -1000.0 .. 1000.0;
-      SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
-           DELTA 100.0 RANGE  -500.0 ..  500.0;
- 
-      -------------------------------------------------------------------
- 
-      TYPE FORE_AND_AFT IS
-           RECORD
-                FORE, AFT : INTEGER;
-           END RECORD;
- 
-      GENERIC
-           TYPE T IS DELTA <>;
-      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
- 
-      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
-      BEGIN
-           RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
-      END ATTRIBUTES;
- 
-      -------------------------------------------------------------------
- 
-      PROCEDURE CHECK_ATTRIBUTES
-          (NAME : STRING;
-           ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
-      BEGIN
-           IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
-                FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
-                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
-           END IF;
-           IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
-                FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
-                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
-           END IF;
-      END CHECK_ATTRIBUTES;
- 
-      -------------------------------------------------------------------
- 
-      FUNCTION FA_LEFT_OUT_M1       IS NEW ATTRIBUTES(LEFT_OUT_M1      );
-      FUNCTION FA_LEFT_EDGE_M1      IS NEW ATTRIBUTES(LEFT_EDGE_M1     );
-      FUNCTION FA_RIGHT_EDGE_M1     IS NEW ATTRIBUTES(RIGHT_EDGE_M1    );
-      FUNCTION FA_RIGHT_OUT_M1      IS NEW ATTRIBUTES(RIGHT_OUT_M1     );
-      FUNCTION FA_MIDDLE_M2         IS NEW ATTRIBUTES(MIDDLE_M2        );
-      FUNCTION FA_MIDDLE_M3         IS NEW ATTRIBUTES(MIDDLE_M3        );
-      FUNCTION FA_MIDDLE_M15        IS NEW ATTRIBUTES(MIDDLE_M15       );
-      FUNCTION FA_MIDDLE_M16        IS NEW ATTRIBUTES(MIDDLE_M16       );
-      FUNCTION FA_LIKE_DURATION_M23 IS NEW ATTRIBUTES(LIKE_DURATION_M23);
-      FUNCTION FA_DECIMAL_M18       IS NEW ATTRIBUTES(DECIMAL_M18      );
-      FUNCTION FA_DECIMAL_M4        IS NEW ATTRIBUTES(DECIMAL_M4       );
-      FUNCTION FA_DECIMAL_M11       IS NEW ATTRIBUTES(DECIMAL_M11      );
-      FUNCTION FA_DECIMAL2_M18      IS NEW ATTRIBUTES(DECIMAL2_M18     );
-      FUNCTION FA_ST_LEFT_EDGE_M6   IS NEW ATTRIBUTES(ST_LEFT_EDGE_M6  );
-      FUNCTION FA_ST_MIDDLE_M14     IS NEW ATTRIBUTES(ST_MIDDLE_M14    );
-      FUNCTION FA_ST_MIDDLE_M2      IS NEW ATTRIBUTES(ST_MIDDLE_M2     );
-      FUNCTION FA_ST_MIDDLE_M3      IS NEW ATTRIBUTES(ST_MIDDLE_M3     );
-      FUNCTION FA_ST_DECIMAL_M7     IS NEW ATTRIBUTES(ST_DECIMAL_M7    );
-      FUNCTION FA_ST_DECIMAL_M3     IS NEW ATTRIBUTES(ST_DECIMAL_M3    );
- 
- BEGIN
- 
-      TEST ("C35A05N", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
-                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
-                       "BASIC TYPES, GENERICS");
- 
-      CHECK_ATTRIBUTES ("LEFT_OUT_M1",     FA_LEFT_OUT_M1,     (2, 1) );
-      CHECK_ATTRIBUTES ("LEFT_EDGE_M1",    FA_LEFT_EDGE_M1,    (2, 1) );
-      CHECK_ATTRIBUTES ("RIGHT_EDGE_M1",   FA_RIGHT_EDGE_M1,   (2, 1) );
-      CHECK_ATTRIBUTES ("RIGHT_OUT_M1",    FA_RIGHT_OUT_M1,    (2, 1) );
-      CHECK_ATTRIBUTES ("MIDDLE_M2",       FA_MIDDLE_M2,       (2, 1) );
-      CHECK_ATTRIBUTES ("MIDDLE_M3",       FA_MIDDLE_M3,       (2, 1) );
-      CHECK_ATTRIBUTES ("MIDDLE_M15",      FA_MIDDLE_M15,      (4, 2) );
-      CHECK_ATTRIBUTES ("MIDDLE_M16",      FA_MIDDLE_M16,      (5, 2) );
-      CHECK_ATTRIBUTES ("LIKE_DURATION_M23",
-                                         FA_LIKE_DURATION_M23, (6, 2) );
-      CHECK_ATTRIBUTES ("DECIMAL_M18",     FA_DECIMAL_M18,     (6, 1) );
- 
-      IF FA_DECIMAL_M4.FORE /= 5 AND FA_DECIMAL_M4.FORE /= 4 THEN
-           FAILED ("GENERIC 'FORE FOR DECIMAL_M4 =" &
-                   INTEGER'IMAGE(FA_DECIMAL_M4.FORE) );
-      END IF;
-      IF FA_DECIMAL_M4.AFT /= 1 THEN
-           FAILED ("GENERIC 'AFT  FOR DECIMAL_M4 =" &
-                   INTEGER'IMAGE(FA_DECIMAL_M4.AFT) );
-      END IF;
- 
-      CHECK_ATTRIBUTES ("DECIMAL_M11",     FA_DECIMAL_M11,     (4, 2) );
-      CHECK_ATTRIBUTES ("DECIMAL2_M18",    FA_DECIMAL2_M18,    (5, 1) );
-      CHECK_ATTRIBUTES ("ST_LEFT_EDGE_M6", FA_ST_LEFT_EDGE_M6, (2, 2) );
-      CHECK_ATTRIBUTES ("ST_MIDDLE_M14",   FA_ST_MIDDLE_M14,   (4, 2) );
-      CHECK_ATTRIBUTES ("ST_MIDDLE_M2",    FA_ST_MIDDLE_M2,    (2, 1) );
-      CHECK_ATTRIBUTES ("ST_MIDDLE_M3",    FA_ST_MIDDLE_M3,    (2, 1) );
-      CHECK_ATTRIBUTES ("ST_DECIMAL_M7",   FA_ST_DECIMAL_M7,   (5, 1) );
-      CHECK_ATTRIBUTES ("ST_DECIMAL_M3",   FA_ST_DECIMAL_M3,   (4, 1) );
- 
-      RESULT;
- 
- END C35A05N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a05q.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a05q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- C35A05Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
- -- THE CORRECT VALUES.
- 
- -- CASE Q: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC,
- --         FOR GENERICS.
- 
- -- WRG 8/20/86
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C35A05Q IS
- 
-      PI      : CONSTANT := 3.14159_26535_89793_23846;
-      TWO_PI  : CONSTANT := 2 * PI;
-      HALF_PI : CONSTANT := PI / 2;
- 
-      MM : CONSTANT := 23;
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE MICRO_ANGLE_ERROR_M15  IS
-           DELTA 16.0  RANGE -(2.0 ** 19) .. 2.0 ** 19;
-      TYPE TRACK_RANGE_M15        IS
-           DELTA 0.125 RANGE -(2.0 ** 12) .. 2.0 ** 12;
-      TYPE SECONDS_MM             IS
-           DELTA 2.0 ** (8 - MM) RANGE -(2.0 ** 8) .. 2.0 ** 8;
-      TYPE RANGE_CELL_MM          IS
-           DELTA 2.0 ** (-5)
-           RANGE -(2.0 ** (MM - 5) ) .. 2.0 ** (MM - 5);
- 
-      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
-      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
- 
-      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
-      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
- 
-      TYPE SYMMETRIC_DEGREES_M7  IS
-           DELTA 2.0         RANGE -180.0 .. 180.0;
-      TYPE NATURAL_DEGREES_M15   IS
-           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
-      TYPE SYMMETRIC_RADIANS_M16 IS
-           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
-      TYPE NATURAL_RADIANS_M8    IS
-           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
- 
-      -------------------------------------------------------------------
- 
-      SUBTYPE ST_MILES_M8             IS MILES_M16
-           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
-      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
-           DELTA 0.25 RANGE 0.0 .. 360.0;
-      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
-           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
- 
-      -------------------------------------------------------------------
- 
-      TYPE FORE_AND_AFT IS
-           RECORD
-                FORE, AFT : INTEGER;
-           END RECORD;
- 
-      GENERIC
-           TYPE T IS DELTA <>;
-      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
- 
-      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
-      BEGIN
-           RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
-      END ATTRIBUTES;
- 
-      -------------------------------------------------------------------
- 
-      PROCEDURE CHECK_ATTRIBUTES
-          (NAME : STRING;
-           ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
-      BEGIN
-           IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
-                FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
-                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
-           END IF;
-           IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
-                FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
-                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
-           END IF;
-      END CHECK_ATTRIBUTES;
- 
-      -------------------------------------------------------------------
- 
-      FUNCTION FA_MICRO_ANGLE_ERROR_M15
-                              IS NEW ATTRIBUTES(MICRO_ANGLE_ERROR_M15  );
-      FUNCTION FA_TRACK_RANGE_M15
-                              IS NEW ATTRIBUTES(TRACK_RANGE_M15        );
-      FUNCTION FA_SECONDS_MM  IS NEW ATTRIBUTES(SECONDS_MM             );
-      FUNCTION FA_RANGE_CELL_MM
-                              IS NEW ATTRIBUTES(RANGE_CELL_MM          );
-      FUNCTION FA_PIXEL_M10   IS NEW ATTRIBUTES(PIXEL_M10              );
-      FUNCTION FA_RULER_M8    IS NEW ATTRIBUTES(RULER_M8               );
-      FUNCTION FA_HOURS_M16   IS NEW ATTRIBUTES(HOURS_M16              );
-      FUNCTION FA_MILES_M16   IS NEW ATTRIBUTES(MILES_M16              );
-      FUNCTION FA_SYMMETRIC_DEGREES_M7
-                              IS NEW ATTRIBUTES(SYMMETRIC_DEGREES_M7   );
-      FUNCTION FA_NATURAL_DEGREES_M15
-                              IS NEW ATTRIBUTES(NATURAL_DEGREES_M15    );
-      FUNCTION FA_SYMMETRIC_RADIANS_M16
-                              IS NEW ATTRIBUTES(SYMMETRIC_RADIANS_M16  );
-      FUNCTION FA_NATURAL_RADIANS_M8
-                              IS NEW ATTRIBUTES(NATURAL_RADIANS_M8     );
-      FUNCTION FA_ST_MILES_M8 IS NEW ATTRIBUTES(ST_MILES_M8            );
-      FUNCTION FA_ST_NATURAL_DEGREES_M11
-                              IS NEW ATTRIBUTES(ST_NATURAL_DEGREES_M11 );
-      FUNCTION FA_ST_SYMMETRIC_RADIANS_M8
-                              IS NEW ATTRIBUTES(ST_SYMMETRIC_RADIANS_M8);
- 
- BEGIN
- 
-      TEST ("C35A05Q", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
-                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
-                       "TYPICAL TYPES, GENERICS");
- 
-      CHECK_ATTRIBUTES ("MICRO_ANGLE_ERROR_M15",
-                                     FA_MICRO_ANGLE_ERROR_M15, (7, 1) );
- 
-      CHECK_ATTRIBUTES ("TRACK_RANGE_M15", FA_TRACK_RANGE_M15, (5, 1) );
- 
-      CHECK_ATTRIBUTES ("SECONDS_MM", FA_SECONDS_MM, (4, 5) );
- 
-      CHECK_ATTRIBUTES ("RANGE_CELL_MM", FA_RANGE_CELL_MM, (7, 2) );
- 
-      CHECK_ATTRIBUTES ("PIXEL_M10", FA_PIXEL_M10, (2, 4) );
- 
-      CHECK_ATTRIBUTES ("RULER_M8",  FA_RULER_M8, (3, 2) );
- 
-      CHECK_ATTRIBUTES ("HOURS_M16", FA_HOURS_M16, (3, 4) );
- 
-      CHECK_ATTRIBUTES ("MILES_M16", FA_MILES_M16, (5, 2) );
- 
-      CHECK_ATTRIBUTES ("SYMMETRIC_DEGREES_M7",
-                                     FA_SYMMETRIC_DEGREES_M7, (4, 1) );
- 
-      CHECK_ATTRIBUTES ("NATURAL_DEGREES_M15",
-                                     FA_NATURAL_DEGREES_M15, (4, 2) );
- 
-      CHECK_ATTRIBUTES ("SYMMETRIC_RADIANS_M16",
-                                     FA_SYMMETRIC_RADIANS_M16, (2, 5) );
- 
-      CHECK_ATTRIBUTES ("NATURAL_RADIANS_M8",
-                                     FA_NATURAL_RADIANS_M8, (2, 2) );
- 
-      CHECK_ATTRIBUTES ("ST_MILES_M8", FA_ST_MILES_M8, (3, 2) );
- 
-      CHECK_ATTRIBUTES ("ST_NATURAL_DEGREES_M11",
-                                     FA_ST_NATURAL_DEGREES_M11, (4, 1) );
- 
-      CHECK_ATTRIBUTES ("ST_SYMMETRIC_RADIANS_M8",
-                                    FA_ST_SYMMETRIC_RADIANS_M8, (2, 2) );
- 
-      RESULT;
- 
- END C35A05Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a07a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a07a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a07a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a07a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- C35A07A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES THE FIRST AND LAST ATTRIBUTES YIELD
- -- CORRECT VALUES.
- 
- -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
- 
- -- WRG 8/25/86
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C35A07A IS
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
-      TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
-      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
-      TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
-      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
-           -- LARGEST MODEL NUMBER IS 960.0.
- 
-      -------------------------------------------------------------------
- 
-      SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
-           DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
-      SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
-           DELTA 0.5 RANGE  0.0 .. 2.5;
-      SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
-           DELTA  10.0 RANGE -1000.0 .. 1000.0;
-           -- LARGEST MODEL NUMBER IS 1016.0.
-      SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
-           DELTA 100.0 RANGE  -500.0 ..  500.0;
-           -- LARGEST MODEL NUMBER IS 448.0.
-      SUBTYPE ST_MIDDLE_M15   IS MIDDLE_M15
-           RANGE 6.0 .. 3.0;
- 
- BEGIN
- 
-      TEST ("C35A07A", "CHECK THAT FOR FIXED POINT TYPES THE FIRST " &
-                       "AND LAST ATTRIBUTES YIELD CORRECT VALUES - " &
-                       "BASIC TYPES");
- 
-      -------------------------------------------------------------------
- 
- 
-      IF MIDDLE_M3'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("MIDDLE_M3'FIRST /= 0.0");
-      END IF;
-      IF MIDDLE_M3'LAST /= IDENT_INT (1) * 2.5 THEN
-           FAILED ("MIDDLE_M3'LAST /= 2.5");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
- 
-      IF LIKE_DURATION_M23'FIRST /= IDENT_INT (1) * (-86_400.0) THEN
-           FAILED ("LIKE_DURATION_M23'FIRST /= -86_400.0");
-      END IF;
-      IF LIKE_DURATION_M23'LAST  /= IDENT_INT (1) * 86_400.0 THEN
-           FAILED ("LIKE_DURATION_M23'LAST  /=  86_400.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF DECIMAL_M18'FIRST /= IDENT_INT (1) * (-10_000.0) THEN
-           FAILED ("DECIMAL_M18'FIRST /= -10_000.0");
-      END IF;
-      IF DECIMAL_M18'LAST /= IDENT_INT (1) * 10_000.0 THEN
-           FAILED ("DECIMAL_M18'LAST /= 10_000.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
- 
-      IF ST_MIDDLE_M3'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("ST_MIDDLE_M3'FIRST /= 0.0");
-      END IF;
-      IF ST_MIDDLE_M3'LAST /= IDENT_INT (1) * 2.5 THEN
-           FAILED ("ST_MIDDLE_M3'LAST /= 2.5");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF ST_DECIMAL_M7'FIRST /= IDENT_INT (1) * (-1000.0) THEN
-           FAILED ("ST_DECIMAL_M7'FIRST /= -1000.0");
-      END IF;
-      IF ST_DECIMAL_M7'LAST /= IDENT_INT (1) * 1000.0 THEN
-           FAILED ("ST_DECIMAL_M7'LAST /= 1000.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
- 
-      IF ST_MIDDLE_M15'FIRST /= IDENT_INT (1) * 6.0 THEN
-           FAILED ("ST_MIDDLE_M15'FIRST /= 6.0");
-      END IF;
-      IF ST_MIDDLE_M15'LAST /= IDENT_INT (1) * 3.0 THEN
-           FAILED ("ST_MIDDLE_M15'LAST /= 3.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- END C35A07A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a07d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a07d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a07d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a07d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C35A07D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES THE FIRST AND LAST ATTRIBUTES YIELD
- -- CORRECT VALUES.
- 
- -- CASE D: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC.
- 
- -- WRG 8/25/86
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C35A07D IS
- 
-      PI      : CONSTANT := 3.14159_26535_89793_23846;
-      TWO_PI  : CONSTANT := 2 * PI;
-      HALF_PI : CONSTANT := PI / 2;
- 
-      MM : CONSTANT := MAX_MANTISSA;
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
-      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
- 
-      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
-      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
- 
-      TYPE SYMMETRIC_DEGREES_M7  IS
-           DELTA 2.0         RANGE -180.0 .. 180.0;
-      TYPE NATURAL_DEGREES_M15   IS
-           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
-      TYPE SYMMETRIC_RADIANS_M16 IS
-           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
-                -- 'SMALL = 2.0 ** (-14) = 0.00006_10351_5625.
-      TYPE NATURAL_RADIANS_M8    IS
-           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
-                -- 'SMALL = 2.0 ** ( -5) = 0.03125.
- 
-      -------------------------------------------------------------------
- 
-      SUBTYPE ST_MILES_M8             IS MILES_M16
-           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
-      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
-           DELTA 0.25 RANGE 0.0 .. 360.0;
-      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
-           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
-                -- 'SMALL = 2.0 ** ( -7) = 0.00781_25.
- 
- BEGIN
- 
-      TEST ("C35A07D", "CHECK THAT FOR FIXED POINT TYPES THE FIRST " &
-                       "AND LAST ATTRIBUTES YIELD CORRECT VALUES - " &
-                       "TYPICAL TYPES");
- 
-      -------------------------------------------------------------------
- 
- 
-      IF PIXEL_M10'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("PIXEL_M10'FIRST /= 0.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF RULER_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("RULER_M8'FIRST /= 0.0");
-      END IF;
-      IF RULER_M8'LAST /= IDENT_INT (1) * 12.0 THEN
-           FAILED ("RULER_M8'LAST /= 12.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF HOURS_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("HOURS_M16'FIRST /= 0.0");
-      END IF;
-      IF HOURS_M16'LAST /= IDENT_INT (1) * 24.0 THEN
-           FAILED ("HOURS_M16'LAST /= 24.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF MILES_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("MILES_M16'FIRST /= 0.0");
-      END IF;
-      IF MILES_M16'LAST /= IDENT_INT (1) * 3000.0 THEN
-           FAILED ("MILES_M16'LAST /= 3000.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF SYMMETRIC_DEGREES_M7'FIRST /= IDENT_INT (1) * (-180.0) THEN
-           FAILED ("SYMMETRIC_DEGREES_M7'FIRST /= -180.0");
-      END IF;
-      IF SYMMETRIC_DEGREES_M7'LAST /= IDENT_INT (1) * 180.0 THEN
-           FAILED ("SYMMETRIC_DEGREES_M7'LAST /= 180.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF NATURAL_DEGREES_M15'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("NATURAL_DEGREES_M15'FIRST /= 0.0");
-      END IF;
-      IF NATURAL_DEGREES_M15'LAST /= IDENT_INT (1) * 360.0 THEN
-           FAILED ("NATURAL_DEGREES_M15'LAST /= 360.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      -- PI IS IN 3.0 + 2319 * 'SMALL .. 3.0 + 2320 * 'SMALL.
-      IF SYMMETRIC_RADIANS_M16'FIRST NOT IN
-         -3.14160_15625 .. -3.14154_05273_4375 THEN
-           FAILED ("SYMMETRIC_RADIANS_M16'FIRST NOT IN " &
-                   "-3.14160_15625 .. -3.14154_05273_4375");
-      END IF;
-      IF SYMMETRIC_RADIANS_M16'LAST  NOT IN
-         3.14154_05273_4375 .. 3.14160_15625 THEN
-           FAILED ("SYMMETRIC_RADIANS_M16'LAST NOT IN " &
-                   "3.14154_05273_4375 .. 3.14160_15625");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF NATURAL_RADIANS_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("NATURAL_RADIANS_M8'FIRST /= 0.0");
-      END IF;
-      -- TWO_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
-      IF NATURAL_RADIANS_M8'LAST  NOT IN 6.28125 .. 6.3125 THEN
-           FAILED ("NATURAL_RADIANS_M8'LAST NOT IN 6.28125 .. 6.3125");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF ST_MILES_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("ST_MILES_M8'FIRST /= 0.0");
-      END IF;
-      IF ST_MILES_M8'LAST /= IDENT_INT (1) * 10.0 THEN
-           FAILED ("ST_MILES_M8'LAST /= 10.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      IF ST_NATURAL_DEGREES_M11'FIRST /= IDENT_INT (1) * 0.0 THEN
-           FAILED ("ST_NATURAL_DEGREES_M11'FIRST /= 0.0");
-      END IF;
-      IF ST_NATURAL_DEGREES_M11'LAST /= IDENT_INT (1) * 360.0 THEN
-           FAILED ("ST_NATURAL_DEGREES_M11'LAST /= 360.0");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      -- HALF_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
-      IF ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN
-         -1.57812_5 .. -1.57031_25 THEN
-           FAILED ("ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN " &
-                   "-1.57812_5 .. -1.57031_25");
-      END IF;
-      IF ST_SYMMETRIC_RADIANS_M8'LAST  NOT IN
-         1.57031_25 .. 1.57812_5 THEN
-           FAILED ("ST_SYMMETRIC_RADIANS_M8'LAST NOT IN " &
-                   "1.57031_25 .. 1.57812_5");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- END C35A07D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a08b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a08b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c35a08b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c35a08b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C35A08B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE MULTIPLICATION AND DIVISION OPERATORS FOR TWO
- --     FIXED POINT OPERANDS ARE DECLARED IN STANDARD AND ARE DIRECTLY
- --     VISIBLE.
- 
- -- HISTORY:
- --     BCB 01/21/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C35A08B IS
- 
-      PACKAGE P IS
-           TYPE T1 IS DELTA 2.0**(-4) RANGE -100.0 .. 100.0;
-           TYPE T2 IS DELTA 2.0**(-4) RANGE -100.0 .. 100.0;
-      END P;
-      USE P;
- 
-      X1 : P.T1 := 6.0;
-      X2 : P.T1 := 2.0;
-      X3 : P.T1;
-      X4 : P.T1;
-      X5 : P.T1;
-      X6 : P.T1;
- 
-      X7 : P.T2 := 2.0;
- 
-      FUNCTION IDENT_FIXED(X : P.T1) RETURN P.T1 IS
-      BEGIN
-           RETURN X * IDENT_INT(1);
-      END IDENT_FIXED;
- 
- BEGIN
-      TEST ("C35A08B", "CHECK THAT THE MULTIPLICATION AND DIVISION " &
-                       "OPERATORS FOR TWO FIXED POINT OPERANDS ARE " &
-                       "DECLARED IN STANDARD AND ARE DIRECTLY VISIBLE");
- 
-      X3 := P.T1 (X1 * X2);
-      X4 := P.T1 (X1 / X2);
- 
-      X5 := P.T1 (STANDARD."*" (X1,X2));
-      X6 := P.T1 (STANDARD."/" (X1,X2));
- 
-      IF X3 /= IDENT_FIXED (12.0) THEN
-           FAILED ("IMPROPER VALUE FOR FIXED POINT MULTIPLICATION - 1");
-      END IF;
- 
-      IF X4 /= IDENT_FIXED (3.0) THEN
-           FAILED ("IMPROPER VALUE FOR FIXED POINT DIVISION - 1");
-      END IF;
- 
-      X3 := P.T1 (X1 * X7);
-      X4 := P.T1 (X1 / X7);
- 
-      X5 := P.T1 (STANDARD."*" (X1,X7));
-      X6 := P.T1 (STANDARD."/" (X1,X7));
- 
-      IF X3 /= IDENT_FIXED (12.0) THEN
-           FAILED ("IMPROPER VALUE FOR FIXED POINT MULTIPLICATION - 2");
-      END IF;
- 
-      IF X4 /= IDENT_FIXED (3.0) THEN
-           FAILED ("IMPROPER VALUE FOR FIXED POINT DIVISION - 2");
-      END IF;
- 
-      RESULT;
- END C35A08B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c360002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c360002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c360002.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c360002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,268 ****
- -- C360002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that modular types may be used as array indices.
- --
- --      Check that if aliased appears in the component_definition of an
- --      array_type that each component of the array is aliased.
- --
- --      Check that references to aliased array objects produce correct
- --      results, and that out-of-bounds indexing correctly produces
- --      Constraint_Error.
- --
- -- TEST DESCRIPTION:
- --      This test defines several array types and subtypes indexed by modular
- --      types; some aliased some not, some with aliased components, some not.
- --
- --      It then checks that assignments move the correct data.
- --
- --
- -- CHANGE HISTORY:
- --      28 SEP 95   SAIC   Initial version
- --      23 APR 96   SAIC   Doc fixes, fixed constrained/unconstrained conflict
- --      13 FEB 97   PWB.CTA Removed illegal declarations and affected code
- --!
- 
- ------------------------------------------------------------------- C360002
- 
- with Report;
- 
- procedure C360002 is
- 
-   Verbose : Boolean := Report.Ident_Bool( False );
- 
-   type Mod_128 is mod 128;
- 
-   function Ident_128( I: Integer ) return Mod_128 is
-   begin
-     return Mod_128( Report.Ident_Int( I ) );
-   end Ident_128;
- 
-   type Unconstrained_Array
-        is array( Mod_128 range <> ) of Integer;
- 
-   type Unconstrained_Array_Aliased
-        is array( Mod_128 range <> ) of aliased Integer;
- 
-   type Access_All_Unconstrained_Array
-        is access all Unconstrained_Array;
- 
-   type Access_All_Unconstrained_Array_Aliased
-        is access all Unconstrained_Array_Aliased;
- 
-   subtype Array_01_10
-           is Unconstrained_Array(01..10);
- 
-   subtype Array_11_20
-           is Unconstrained_Array(11..20);
- 
-   subtype Array_Aliased_01_10
-           is Unconstrained_Array_Aliased(01..10);
- 
-   subtype Array_Aliased_11_20
-           is Unconstrained_Array_Aliased(11..20);
- 
-   subtype Access_All_01_10_Array
-           is Access_All_Unconstrained_Array(01..10);
- 
-   subtype Access_All_01_10_Array_Aliased
-           is Access_All_Unconstrained_Array_Aliased(01..10);
- 
-   subtype Access_All_11_20_Array
-           is Access_All_Unconstrained_Array(11..20);
- 
-   subtype Access_All_11_20_Array_Aliased
-           is Access_All_Unconstrained_Array_Aliased(11..20);
- 
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   -- these 'filler' functions create unique values for every element that
-   -- is used and/or tested in this test.
- 
-   Well_Bottom : Integer := 0;
- 
-   function Filler( Size : Mod_128 ) return Unconstrained_Array is
-     It : Unconstrained_Array( 0..Size-1 );
-   begin
-     for Eyes in It'Range loop
-       It(Eyes) := Integer( Eyes ) + Well_Bottom;
-     end loop;
-     Well_Bottom := Well_Bottom + It'Length;
-     return It;
-   end Filler;
- 
-   function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
-     It : Unconstrained_Array_Aliased( 0..Size-1 );
-   begin
-     for Ayes in It'Range loop
-       It(Ayes) := Integer( Ayes ) + Well_Bottom;
-     end loop;
-     Well_Bottom := Well_Bottom + It'Length;
-     return It;
-   end Filler;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   An_Integer : Integer;
- 
-   type AAI is access all Integer;
- 
-   An_Integer_Access : AAI;
- 
-   Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
- 
-   Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
- 
-   Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
- 
-   Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
- 
-   Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
- 
-   Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
- 
-   Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
-                                    := Filler(10);               -- 60..69
- 
-   Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
-                                    := Filler(10);               -- 70..79
- 
-   Check_Item            : Access_All_Unconstrained_Array;
- 
-   Check_Aliased_Item    : Access_All_Unconstrained_Array_Aliased;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   procedure Fail( Message : String; CI, SB : Integer ) is
-   begin
-     Report.Failed("Wrong value passed " & Message);
-     if Verbose then
-       Report.Comment("got" & Integer'Image(CI) &
-                      " should be" & Integer'Image(SB) );
-     end if;
-   end Fail;
- 
-   procedure Check_Array_01_10( Checked_Item : Array_01_10;
-                                Low_SB       : Integer ) is
-   begin
-     for Index in Checked_Item'Range loop
-       if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
-         Fail("unaliased 1..10", Checked_Item(Index),
-                                 (Low_SB +Integer(Index)-1));
-       end if;
-     end loop;
-   end Check_Array_01_10;
- 
-   procedure Check_Array_11_20( Checked_Item : Array_11_20;
-                                Low_SB       : Integer ) is
-   begin
-     for Index in Checked_Item'Range loop
-       if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
-         Fail("unaliased 11..20", Checked_Item(Index),
-                                  (Low_SB +Integer(Index)-11));
-       end if;
-     end loop;
-  end Check_Array_11_20;
- 
-   procedure Check_Single_Integer( The_Integer, SB : Integer;
-                                   Message         : String ) is
-   begin
-     if The_Integer /= SB then
-       Report.Failed("Wrong integer value for " & Message );
-     end if;
-   end Check_Single_Integer;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C360002", "Check that modular types may be used as array " &
-                           "indices.  Check that if aliased appears in " &
-                           "the component_definition of an array_type that " &
-                           "each component of the array is aliased.  Check " &
-                           "that references to aliased array objects " &
-                           "produce correct results, and that out of bound " &
-                           "references to aliased objects correctly " &
-                           "produce Constraint_Error" );
-   -- start with checks that the Filler assignments produced the expected
-   -- result.  This is a "case 0" test to check that nothing REALLY surprising
-   -- is happening
- 
-   Check_Array_01_10( Array_Item_01_10, 0 );
-   Check_Array_11_20( Array_Item_11_20, 10 );
- 
-   -- check that having the variable aliased makes no difference
-   Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
-   Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
- 
-   -- now check that conversion between array types where the only
-   -- difference in the definitions is that the components are aliased works
- 
-   Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
-   Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
- 
-   -- check that conversion of an aliased object with aliased components
-   -- also works
- 
-   Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
-                      60 );
-   Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
-                      70 );
- 
-   -- check that the bounds will slide
- 
-   Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
-   Check_Array_11_20( Array_11_20( Array_Item_01_10 ),  0 );
- 
-   -- point at some of the components and check them
- 
-   An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
- 
-   Check_Single_Integer( An_Integer_Access.all, 24,
-                        "Aliased component 'Access");
- 
-   An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
- 
-   Check_Single_Integer( An_Integer_Access.all, 66,
-                        "Aliased Aliased component 'Access");
- 
-   -- check some assignments
- 
-   Array_Item_01_10 := Aliased_Array_Item_01_10;
-   Check_Array_01_10( Array_Item_01_10, 40 );
- 
-   Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
-   Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
- 
-   Aliased_Array_Aliased_Item_11_20(11..20)
-                                        := Aliased_Array_Aliased_Item_01_10;
-   Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
-                      60 );
- 
-   Report.Result;
- 
- end C360002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36104a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,359 ****
- -- C36104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED OR NOT, AS APPROPRIATE,
- -- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
- -- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
- -- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS,
- -- WHERE AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
- -- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
- -- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
- -- ONLY STATIC CASES ARE CHECKED HERE.
- 
- -- DAT 2/3/81
- -- JRK 2/25/81
- -- VKG 1/21/83
- -- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
- --                   2) DELETED "NULL INDEX RANGES, CONSTRAINT_ERROR 
- --                      RAISED" SECTION.
- --                   3) DELETED ANY MENTION OF CASE STATEMENT CHOICES
- --                      AND VARIANT CHOICES IN THE ABOVE COMMENT.
- -- EDS      7/16/98  AVOID OPTIMIZATION
- 
- WITH REPORT;
- PROCEDURE C36104A IS
- 
-      USE REPORT;
- 
-      TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
-      TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
-      SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
-      SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
- 
-      TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
-      TYPE I_10 IS NEW INT_10;
-      SUBTYPE I_5 IS I_10 RANGE -5 .. 5;
-      TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
- 
- BEGIN
-      TEST ("C36104A", "CONSTRAINT_ERROR IS RAISED OR NOT IN STATIC "
-           & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
- 
-      -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
-                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
-           BEGIN
-                DECLARE
-                   -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 
-                   -- OPTIMIZATION OF SUBTYPE
-                   A1 : A := (OTHERS => I_5(IDENT_INT(1)));
-                BEGIN
-                   FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " & 
-                           I_5'IMAGE(A1(1)) );  --USE A1
-                END;
-           EXCEPTION
-              --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
-              --REPORT FAILED.
-              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                 FAILED ("WRONG EXCEPTION RAISED 1");
-      END;
-        
-      BEGIN
-           FOR I IN MID_WEEK RANGE MON .. MON LOOP
-                FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
-           END LOOP;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 3");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE P IS ACCESS I_5_ARRAY (I_5 RANGE 0 .. 6);
-                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
-           BEGIN
-              DECLARE
-                 TYPE PA IS NEW P;
-                 -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 
-                 -- OPTIMIZATION OF TYPE
-                 PA1 : PA := NEW I_5_ARRAY'(0 .. I_5(IDENT_INT(6)) =>
-                                            I_5(IDENT_INT(1)));
-              BEGIN
-                 FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " & 
-                         I_5'IMAGE(PA1(1))); --USE PA1
-              END;
-           EXCEPTION
-              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 4");
-      END;
- 
-      DECLARE
-           W : WEEK_ARRAY (MID_WEEK);
-      BEGIN
-           W := (MID_WEEK RANGE MON .. WED => WED);
-           -- CONSTRAINT_ERROR RAISED.
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " & 
-                   MID_WEEK'IMAGE(W(WED))); --USE W
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 7");
-      END;
- 
-      DECLARE
-           W : WEEK_ARRAY (WORK_WEEK);
-      BEGIN
-           W := (W'RANGE => WED); -- OK.
-           W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
-                   MID_WEEK'IMAGE(W(WED))); --USE W
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 8");
-      END;
- 
-      BEGIN
-           DECLARE
-                W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
-                -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
-           BEGIN
-                W := (W'RANGE => WED); -- OK.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " & 
-                        MID_WEEK'IMAGE(W(WED))); --USE W
-           EXCEPTION
-                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 9");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 9");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. TUE);
-                -- RAISES CONSTRAINT_ERROR.
-           BEGIN
-              DECLARE
-                 W1 : W := (OTHERS => WED);
-              BEGIN
-                 FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " & 
-                         MID_WEEK'IMAGE(W1(WED))); --USE W1
-              END;
-           EXCEPTION
-              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 10");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. WED);
-                -- RAISES CONSTRAINT_ERROR.
-           BEGIN
-                DECLARE
-                     W1 : W := (OTHERS => (WED));
-                BEGIN
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
-                             MID_WEEK'IMAGE(W1(WED))); --USE W1
-                END;
-           EXCEPTION
-                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 11");
-      END;
- 
-      -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (I_5 RANGE -5 .. -6) OF I_5;
-                A1 : A;
-           BEGIN
-                IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
-                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
-      END;
- 
-      BEGIN
-           FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-           FOR I IN MID_WEEK RANGE FRI .. WED LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-           FOR I IN MID_WEEK RANGE MON .. SUN LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-           FOR I IN I_5 RANGE 10 .. -10 LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-           FOR I IN I_5 RANGE 10 .. 9 LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-           FOR I IN I_5 RANGE -10 .. -11 LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-           FOR I IN I_5 RANGE -10 .. -20 LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-           FOR I IN I_5 RANGE 6 .. 5 LOOP
-                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
-           END LOOP;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE P IS ACCESS I_5_ARRAY (-5 .. -6);
-                PA1 : P := NEW I_5_ARRAY (-5 .. -6);
-           BEGIN
-                IF PA1'LENGTH /= IDENT_INT(0) THEN
-                     FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED 5");
-      END;
- 
-      DECLARE
-           TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-           SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
-           W : NARR(SNARR) := (1,2);
-      BEGIN
-           IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
-                FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
-      END;
- 
-      DECLARE
-           W : WEEK_ARRAY (MID_WEEK);
-      BEGIN
-           W := (W'RANGE => WED); -- OK.
-           W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
-      END;
- 
-      BEGIN
-           DECLARE
-                W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
-           BEGIN
-                IF (W'FIRST /= MON) THEN
-                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
-                W1 : W;
-           BEGIN
-                IF (W1'FIRST /= TUE) THEN
-                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
-                W1 : W;
-           BEGIN
-                IF (W1'FIRST /= TUE) THEN
-                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
-      END;
- 
-      -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
- 
-      BEGIN
-           IF SUN IN  SAT .. SUN
-           OR SAT IN  FRI .. WED
-           OR WED IN  THU .. TUE
-           OR THU IN  MON .. SUN
-           OR FRI IN  SAT .. FRI
-           OR WED IN  FRI .. MON
-           THEN
-                FAILED ("INCORRECT 'IN' EVALUATION 1");
-           END IF;
- 
-           IF INTEGER'(0) IN  10 .. -10
-           OR INTEGER'(0) IN  10 .. 9
-           OR INTEGER'(0) IN  -10 .. -11
-           OR INTEGER'(0) IN  -10 .. -20 
-           OR INTEGER'(0) IN  6 .. 5
-           OR INTEGER'(0) IN  5 .. 3
-           OR INTEGER'(0) IN  7 .. 3
-           THEN
-                FAILED ("INCORRECT 'IN' EVALUATION 2");
-           END IF;
- 
-           IF WED NOT IN  THU .. TUE
-           AND INTEGER'(0) NOT IN  4 .. -4
-           THEN NULL;
-           ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
-      END;
- 
- 
-      RESULT;
- END C36104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36104b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36104b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36104b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,421 ****
- -- C36104B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED OR NOT, AS APPROPRIATE,
- -- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
- -- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
- -- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS, WHERE
- -- AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
- -- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
- -- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
- -- ONLY DYNAMIC CASES ARE CHECKED HERE.
- 
- -- DAT 2/3/81
- -- JRK 2/25/81
- -- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
- --                   2) DELETED "NULL INDEX RANGE, CONSTRAINT_ERROR
- --                      RAISED" SECTION.
- --                   3) MADE USE OF DYNAMIC-RESULT FUNCTIONS.
- --                   4) DELETED ALL REFERENCES TO CASE STATEMENT CHOICES
- --                      AND VARIANT PART CHOICES IN THE ABOVE COMMENT.
- -- EDS      7/16/98  AVOID OPTIMIZATION
- 
- WITH REPORT;
- PROCEDURE C36104B IS
- 
-      USE REPORT;
- 
-      TYPE WEEK IS (SSUN, SMON, STUE, SWED, STHU, SFRI, SSAT);
-      SUN : WEEK := WEEK'VAL(IDENT_INT(0));
-      MON : WEEK := WEEK'VAL(IDENT_INT(1));
-      TUE : WEEK := WEEK'VAL(IDENT_INT(2));
-      WED : WEEK := WEEK'VAL(IDENT_INT(3));
-      THU : WEEK := WEEK'VAL(IDENT_INT(4));
-      FRI : WEEK := WEEK'VAL(IDENT_INT(5));
-      SAT : WEEK := WEEK'VAL(IDENT_INT(6));
-      TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
-      SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
-      SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
- 
-      TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
-      TYPE I_10 IS NEW INT_10;
-      SUBTYPE I_5 IS I_10 RANGE I_10(IDENT_INT(-5)) ..
-                                I_10(IDENT_INT(5));
-      TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
- 
-      FUNCTION F(DAY : WEEK) RETURN WEEK IS
-         BEGIN
-           RETURN DAY;
-         END;
- 
- BEGIN
-      TEST ("C36104B", "CONSTRAINT_ERROR IS RAISED OR NOT IN DYNAMIC "
-           & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
- 
-      -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
-                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
-           BEGIN
-                DECLARE
-                   -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 
-                   -- OPTIMIZATION OF SUBTYPE
-                   A1 : A := (A'RANGE => I_5(IDENT_INT(1)));
-                BEGIN
-                   FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " & 
-                           I_5'IMAGE(A1(1)) );  --USE A1
-                END;
-           EXCEPTION
-              --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
-              --REPORT FAILED.
-              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 1");
-      END;
- 
-      BEGIN
-           FOR I IN MID_WEEK RANGE MON .. MON LOOP
- 
-                IF EQUAL(2,2)  THEN
-                     SAT := SSAT;
-                END IF;
- 
-           END LOOP;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 3");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE P IS ACCESS I_5_ARRAY (0 .. 6);
-                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
-           BEGIN
-                DECLARE
-                   TYPE PA IS NEW P;
-                   -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 
-                   -- OPTIMIZATION OF TYPE
-                   PA1 : PA :=NEW I_5_ARRAY'(0.. I_5(IDENT_INT(6)) => 
-                                             I_5(IDENT_INT(1)));
-                BEGIN
-                   FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " & 
-                           I_5'IMAGE(PA1(1))); --USE PA1
-                END;
-           EXCEPTION
-              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 4");
-      END;
- 
-      DECLARE
-           W : WEEK_ARRAY (MID_WEEK);
-      BEGIN
-           W := (MID_WEEK RANGE MON .. WED => WED);
-           -- CONSTRAINT_ERROR RAISED.
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " & 
-                        MID_WEEK'IMAGE(W(WED))); --USE W
-           EXCEPTION
-                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 7");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 7");
-      END;
- 
-      DECLARE
-           W : WEEK_ARRAY (WORK_WEEK);
-      BEGIN
-           W := (W'RANGE => WED); -- OK.
-           W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
-                        MID_WEEK'IMAGE(W(WED))); --USE W
-           EXCEPTION
-                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 8");
-      END;
- 
-      BEGIN
-           DECLARE
-                W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
-                -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
-           BEGIN
-                W(WED) := THU;        -- OK.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " &
-                        WEEK'IMAGE(W(WED)));   -- USE W
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 9");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. WED);
-                -- RAISES CONSTRAINT_ERROR.
-           BEGIN
-                DECLARE
-                     X : W;              -- OK.
-                BEGIN
-                     X(TUE) := THU;   -- OK.
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " &
-                             WEEK'IMAGE(X(TUE)));   -- USE X
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. THU);
-                -- RAISES CONSTRAINT_ERROR.
-           BEGIN
-                DECLARE
-                     T : W;               -- OK.
-                BEGIN
-                     T(TUE) := THU;    -- OK.
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED 11 " &
-                             WEEK'IMAGE(T(TUE)));
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED 11");
-      END;
- 
-      -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (I_5 RANGE I_5(IDENT_INT(-5)) .. -6) OF I_5;
-                A1 : A;
-           BEGIN
-                IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
-                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
-      END;
- 
-      BEGIN
-           FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
-                
-                IF EQUAL(2,2)  THEN
-                     TUE := STUE;
-                END IF;
- 
-           END LOOP;
-           FOR I IN MID_WEEK RANGE FRI .. WED LOOP
-                
-                IF EQUAL(2,2)  THEN
-                     MON := SMON;
-                END IF;
- 
-           END LOOP;
-           FOR I IN MID_WEEK RANGE MON .. SUN LOOP
-                
-                IF EQUAL(3,3)  THEN
-                     WED := SWED;
-                END IF;
- 
-           END LOOP;
-           FOR I IN I_5 RANGE 10 .. -10 LOOP
- 
-                IF EQUAL(2,2)  THEN
-                     TUE := STUE;
-                END IF;
- 
-           END LOOP;
-           FOR I IN I_5 RANGE 10 .. 9 LOOP
- 
-                IF EQUAL(2,2)  THEN
-                     THU := STHU;
-                END IF;
- 
-           END LOOP;
-           FOR I IN I_5 RANGE -10 .. -11 LOOP
- 
-                IF EQUAL(2,2)  THEN
-                     SAT := SSAT;
-                END IF;
- 
-           END LOOP;
-           FOR I IN I_5 RANGE -10 .. -20 LOOP
- 
-                IF EQUAL(2,2)  THEN
-                     SUN := SSUN;
-                END IF;
- 
-           END LOOP;
-           FOR I IN I_5 RANGE 6 .. 5 LOOP
- 
-                IF EQUAL(2,2)  THEN
-                     MON := SMON;
-                END IF;
- 
-           END LOOP;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE P IS ACCESS I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
-                PA1 : P := NEW I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
-           BEGIN
-                IF PA1'LENGTH /= IDENT_INT(0) THEN
-                     FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED 5");
-      END;
- 
-      DECLARE
-           TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-           SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
-           W : NARR(SNARR) := (1,2);
-      BEGIN
-           IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
-                FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
-      END;
- 
-      DECLARE
-           W : WEEK_ARRAY (MID_WEEK);
-      BEGIN
-           W := (W'RANGE => WED); -- OK.
-           W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
-      END;
- 
-      BEGIN
-           DECLARE
-                W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
-           BEGIN
- 
-                IF EQUAL(W'LENGTH,0)  THEN
-                     TUE := STUE;
-                END IF;
- 
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
-           BEGIN
- 
-                IF EQUAL(W'LENGTH,0)  THEN
-                     MON := SMON;
-                END IF;
- 
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
-           BEGIN
- 
-                IF EQUAL(W'LENGTH,0)  THEN
-                     WED := SWED;
-                END IF;
- 
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
-      END;
- 
-      -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
- 
-      BEGIN
-           IF F(SUN) IN  SAT .. SUN
-           OR SAT IN  FRI .. WED
-           OR F(WED) IN  THU .. TUE
-           OR THU IN  MON .. SUN
-           OR F(FRI) IN  SAT .. FRI
-           OR WED IN  FRI .. MON
-           THEN
-                FAILED ("INCORRECT 'IN' EVALUATION 1");
-           END IF;
- 
-           IF IDENT_INT(0) IN  10 .. IDENT_INT(-10)
-           OR 0 IN  IDENT_INT(10) .. 9
-           OR IDENT_INT(0) IN  IDENT_INT(-10) .. -11
-           OR 0 IN  -10 .. IDENT_INT(-20) 
-           OR IDENT_INT(0) IN  6 .. IDENT_INT(5)
-           OR 0 IN  5 .. IDENT_INT(3)
-           OR IDENT_INT(0) IN  7 .. IDENT_INT(3)
-           THEN
-                FAILED ("INCORRECT 'IN' EVALUATION 2");
-           END IF;
- 
-           IF F(WED) NOT IN  THU .. TUE
-           AND IDENT_INT(0) NOT IN  IDENT_INT(4) .. -4
-           THEN NULL;
-           ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
-      END;
- 
-      RESULT;
- END C36104B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36172a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36172a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36172a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36172a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,250 ****
- -- C36172A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED APPROPRIATELY
- -- ON DISCRETE_RANGES USED AS INDEX_CONSTRAINTS.
- 
- -- DAT 2/9/81
- -- SPS 4/7/82
- -- JBG 6/5/85
- 
- WITH REPORT;
- PROCEDURE C36172A IS
- 
-      USE REPORT;
- 
-      SUBTYPE INT_10 IS INTEGER RANGE 1 .. 10;
-      TYPE A IS ARRAY (INT_10 RANGE <> ) OF INTEGER;
- 
-      SUBTYPE INT_11 IS INTEGER RANGE 0 .. 11;
-      SUBTYPE NULL_6_4 IS INTEGER RANGE 6 .. 4;
-      SUBTYPE NULL_11_10 IS INTEGER RANGE 11 .. 10;
-      SUBTYPE INT_9_11 IS INTEGER RANGE 9 .. 11;
- 
-      TYPE A_9_11 IS ARRAY (9..11) OF BOOLEAN;
-      TYPE A_11_10 IS ARRAY (11 .. 10) OF INTEGER;
-      SUBTYPE A_1_10 IS A(INT_10);
- 
- BEGIN
-      TEST ("C36172A", "CONSTRAINT_ERROR IS RAISED APPROPRIATELY" &
-            " FOR INDEX_RANGES");
- 
-      BEGIN
-           DECLARE
-                V : A (9 .. 11);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     FAILED ("OUT-OF-BOUNDS INDEX_RANGE 1");
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (11 .. 10);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 2");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 2");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (6 .. 4);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 3");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 3");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (INT_9_11);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     FAILED ("OUT-OF-BOUNDS INDEX RANGE 4");
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION 4");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (NULL_11_10);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 5");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 5");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (NULL_6_4);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 6");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 6");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (INT_9_11 RANGE 10 .. 11);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     FAILED ("BAD NON-NULL INDEX RANGE 7");
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION 7");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (NULL_11_10 RANGE 11 .. 10);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 8");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 8");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (NULL_6_4 RANGE 6 .. 4);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 9");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 9");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (A_9_11'RANGE);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     FAILED ("BAD INDEX RANGE 10");
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (A_11_10'RANGE);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 11");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 11");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : A (6 .. 4);
-           BEGIN
-                IF EQUAL (V'FIRST, V'FIRST) THEN
-                     NULL;
-                ELSE
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
-                "RAISED INAPPROPRIATELY 12");
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
-                "SHOULD BE 12");
-      END;
- 
-      RESULT;
- END C36172A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36172b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36172b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36172b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36172b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,161 ****
- -- C36172B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A MULTIDIMENSIONAL INDEX
- -- CONSTRAINT IF ONE OF THE RANGES IS A NULL RANGE AND THE OTHER IS A
- -- NON-NULL RANGE WITH A BOUND THAT LIES OUTSIDE THE INDEX SUBTYPE.
- 
- -- CHECK THAT NO EXCEPTION IS RAISED IF ALL DISCRETE RANGES ARE NULL.
- 
- -- JBG 6/5/85
- -- EDS 7/16/98     AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C36172B IS
-      SUBTYPE INT_10 IS INTEGER RANGE 1..10;
-      TYPE ARR2 IS ARRAY (INT_10 RANGE <>, INT_10 RANGE <>) OF INTEGER;
- BEGIN
-      TEST ("C36172B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
-                       "NON-NULL DIMENSION OF A NULL MULTIDIMENSIONAL " &
-                       "INDEX CONSTRAINT IF A BOUND LIES OUTSIDE THE " &
-                       "INDEX SUBTYPE");
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (6..4, 9..11);
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
-                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
-                        "THE INDEX SUBTYPE (13) " & INTEGER'IMAGE(V'FIRST));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 13");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (0..3, 8..7);
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
-                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
-                        "THE INDEX SUBTYPE (14) " & INTEGER'IMAGE(V'FIRST));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 14");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (6..4, IDENT_INT(0)..2);
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
-                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
-                        "THE INDEX SUBTYPE (15) " & INTEGER'IMAGE(V'FIRST));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 15");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (9..IDENT_INT(11), 6..4);
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
-                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
-                        "THE INDEX SUBTYPE (16) " & INTEGER'IMAGE(V'FIRST));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 16");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (6..IDENT_INT(4), 9..IDENT_INT(11));
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
-                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
-                        "THE INDEX SUBTYPE (17) " & INTEGER'IMAGE(V'FIRST));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 17");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (IDENT_INT(-1)..2, IDENT_INT(6)..4);
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
-                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
-                        "THE INDEX SUBTYPE (18) " & INTEGER'IMAGE(V'FIRST));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 18");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (6..-1, 11..9);
-           BEGIN
-                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 19");
-      END;
- 
-      BEGIN
-           DECLARE
-                V : ARR2 (IDENT_INT(11)..9, 6..IDENT_INT(0));
-           BEGIN
-                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 20");
-      END;
- 
-      RESULT;
- END C36172B; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36172c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36172c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36172c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36172c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- C36172C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NO EXCEPTION IS RAISED FOR A NULL ARRAY WHOSE DIFFERENCE
- -- IN BOUNDS LIES OUTSIDE THE INDEX BASE TYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- JBG 6/5/85
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C36172C IS
- BEGIN
-      TEST ("C36172C", "CHECK THAT NO EXCEPTION IS RAISED FOR A NULL " &
-                       "ARRAY WHOSE DIFFERENCE IN BOUNDS LIES OUTSIDE " &
-                       "THE INDEX BASE TYPE");
- 
-      BEGIN
-           DECLARE
-                V : STRING (INTEGER'LAST .. -2);
-           BEGIN
-                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
-                     FAILED ("IMPOSSIBLE");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C36172C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36174a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36174a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36174a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36174a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- C36174A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INDEX_CONSTRAINTS MAY BE OMITTED FOR CONSTANTS.
- 
- -- DAT 2/9/81
- -- JBG 12/8/83
- 
- 
- WITH REPORT;
- PROCEDURE C36174A IS
- 
-      USE REPORT;
- 
-      S0 : CONSTANT STRING := "";
-      S1 : CONSTANT STRING := S0;
-      S2 : CONSTANT STRING := (1 .. 0 => 'Z');
-      S3 : CONSTANT STRING := ('A', 'B', 'C');
-      S4 : CONSTANT STRING := S3 & "ABC" & S3 & S2 & "Z";
-      S9 : CONSTANT STRING := S0 & S1 & S2 & S3(3..1);
- 
-      TYPE A4 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>,
-           INTEGER RANGE <>, INTEGER RANGE <>) OF STRING (1 .. 0);
-      C4 : CONSTANT A4 :=
-           (-6 .. -4 =>
-                (4 .. 5 =>
-                     (-4 .. -5 =>
-                          (1000 .. 2000 =>
-                               S9))));
-      S10 : CONSTANT STRING := (10 .. 9 => 'Q');
- 
-      TYPE I_12 IS NEW INTEGER RANGE 10 .. 12;
-      TYPE A_12 IS ARRAY (I_12 RANGE <>, I_12 RANGE <>) OF I_12;
-      A12 : CONSTANT A_12 :=
-           (11 .. 12 => (10 .. 10 => 10));
-      B12 : CONSTANT A_12 :=
-           (11 => (10 | 12 => 10, 11 => 11),
-            10 => (10 | 12 | 11 => 12));
- 
-      N6 : CONSTANT INTEGER := IDENT_INT (6);
-      S6 : CONSTANT STRING := (N6 .. N6 + 6 => 'Z');
-      S7 : CONSTANT STRING := S6 (N6 .. N6 + IDENT_INT (-1));
- 
- BEGIN
-      TEST ("C36174A", "INDEX_CONSTRAINTS MAY BE OMITTED FOR CONSTANTS");
- 
-      IF S0'FIRST /= 1 OR S0'LAST /= 0
-      OR S1'FIRST /= 1 OR S1'LAST /= 0
-      OR S2'FIRST /= 1 OR S2'LAST /= 0
-      OR S3'FIRST /= 1 OR S3'LAST /= 3
-      THEN
-           FAILED ("INVALID STRING CONSTANT BOUNDS 1");
-      END IF;
- 
-      IF S4'FIRST /= 1 OR S4'LAST /= 10 THEN
-           FAILED ("INVALID STRING CONSTANT BOUNDS 2");
-      END IF;
- 
-      IF S9'FIRST /= 3 OR S9'LAST /= 1 THEN
-           FAILED ("INVALID STRING CONSTANT BOUNDS 3");
-      END IF;
- 
-      IF C4'FIRST(1) /= -6 OR C4'LAST(1) /= -4
-      OR C4'FIRST(2) /= 4 OR C4'LAST(2) /= 5
-      OR C4'FIRST(3) /= -4 OR C4'LAST(3) /= -5
-      OR C4'FIRST(4) /= 1000 OR C4'LAST(4) /= 2000
-      THEN
-           FAILED ("INVALID ARRAY CONSTANT BOUNDS");
-      END IF;
- 
-      IF S10'FIRST /= 10 OR S10'LAST /= 9
-      THEN
-           FAILED ("INVALID STRING CONSTANT BOUNDS 10");
-      END IF;
- 
-      IF A12'FIRST /= 11 OR A12'LAST /= 12
-      OR A12'FIRST(2) /= 10 OR A12'LAST(2) /= 10
-      THEN FAILED ("INVALID ARRAY CONSTANT BOUNDS 2");
-      END IF;
- 
-      IF B12'FIRST /= 10 OR B12'LAST /= 11
-      OR B12'FIRST(2) /= 10 OR B12'LAST(2) /= 12
-      THEN
-           FAILED ("INVALID ARRAY CONSTANT BOUNDS 3");
-      END IF;
- 
-      IF S6'FIRST /= 6 OR S6'LAST /= 12 OR S6'LENGTH /= 7
-      THEN
-           FAILED ("INVALID STRING CONSTANT  BOUNDS 12");
-      END IF;
- 
-      IF S7'FIRST /= 6 OR S7'LAST /= 5 THEN
-           FAILED ("INVALID STRING CONSTANT BOUNDS 13");
-      END IF;
- 
-      RESULT;
- END C36174A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36180a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36180a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36180a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36180a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C36180A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN INDEX CONSTRAINT CAN HAVE THE FORM A'RANGE,
- --     WHERE A IS A PREVIOUSLY DECLARED ARRAY OBJECT OR CONSTRAINED
- --     ARRAY SUBTYPE.
- 
- -- HISTORY:
- --     BCB 01/21/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C36180A IS
- 
-      TYPE J IS ARRAY (INTEGER RANGE <>) OF INTEGER;
- 
-      TYPE K IS ARRAY (1..10) OF INTEGER;
- 
-      SUBTYPE A IS J (0 .. 50);
- 
-      SUBTYPE W IS J (A'RANGE);
- 
-      SUBTYPE X IS J (K'RANGE);
- 
-      TYPE Y IS ACCESS J;
- 
-      TYPE Z IS ACCESS J;
- 
-      TYPE F IS NEW J (A'RANGE);
- 
-      TYPE G IS NEW J (K'RANGE);
- 
-      B : ARRAY (A'RANGE) OF INTEGER;
- 
-      C : ARRAY (K'RANGE) OF INTEGER;
- 
-      D : ARRAY (1 .. 10) OF INTEGER;
- 
-      E : ARRAY (D'RANGE) OF INTEGER;
- 
-      H : J (A'RANGE);
- 
-      I : J (K'RANGE);
- 
-      L : J (D'RANGE);
- 
-      V1 : W;
- 
-      V2 : X;
- 
-      V3 : Y := NEW J (A'RANGE);
- 
-      V4 : Z := NEW J (K'RANGE);
- 
-      V5 : F;
- 
-      V6 : G;
- 
- BEGIN
-      TEST ("C36180A", "CHECK THAT AN INDEX CONSTRAINT CAN HAVE THE " &
-                       "FORM A'RANGE, WHERE A IS A PREVIOUSLY " &
-                       "DECLARED ARRAY OBJECT OR CONSTRAINED ARRAY " &
-                       "SUBTYPE");
- 
-      IF B'FIRST /= IDENT_INT (0) OR B'LAST /= IDENT_INT (50)
-           THEN FAILED ("IMPROPER VALUE FOR B'FIRST OR B'LAST");
-      END IF;
- 
-      IF C'FIRST /= IDENT_INT (1) OR C'LAST /= IDENT_INT (10)
-           THEN FAILED ("IMPROPER VALUE FOR C'FIRST OR C'LAST");
-      END IF;
- 
-      IF E'FIRST /= IDENT_INT (1) OR E'LAST /= IDENT_INT (10)
-           THEN FAILED ("IMPROPER VALUE FOR E'FIRST OR E'LAST");
-      END IF;
- 
-      IF H'FIRST /= IDENT_INT (0) OR H'LAST /= IDENT_INT (50)
-           THEN FAILED ("IMPROPER VALUE FOR H'FIRST OR H'LAST");
-      END IF;
- 
-      IF I'FIRST /= IDENT_INT (1) OR I'LAST /= IDENT_INT (10)
-           THEN FAILED ("IMPROPER VALUE FOR I'FIRST OR I'LAST");
-      END IF;
- 
-      IF L'FIRST /= IDENT_INT (1) OR L'LAST /= IDENT_INT (10)
-           THEN FAILED ("IMPROPER VALUE FOR L'FIRST OR L'LAST");
-      END IF;
- 
-      IF V1'FIRST /= IDENT_INT (0) OR V1'LAST /= IDENT_INT (50)
-           THEN FAILED ("IMPROPER VALUE FOR V1'FIRST OR V1'LAST");
-      END IF;
- 
-      IF V2'FIRST /= IDENT_INT (1) OR V2'LAST /= IDENT_INT (10)
-           THEN FAILED ("IMPROPER VALUE FOR V2'FIRST OR V2'LAST");
-      END IF;
- 
-      IF V3.ALL'FIRST /= IDENT_INT (0) OR V3.ALL'LAST /= IDENT_INT (50)
-           THEN FAILED ("IMPROPER VALUE FOR V3'FIRST OR V3'LAST");
-      END IF;
- 
-      IF V4.ALL'FIRST /= IDENT_INT (1) OR V4.ALL'LAST /= IDENT_INT (10)
-           THEN FAILED ("IMPROPER VALUE FOR V4'FIRST OR V4'LAST");
-      END IF;
- 
-      IF V5'FIRST /= IDENT_INT (0) OR V5'LAST /= IDENT_INT (50)
-           THEN FAILED ("IMPROPER VALUE FOR V5'FIRST OR V5'LAST");
-      END IF;
- 
-      IF V6'FIRST /= IDENT_INT (1) OR V6'LAST /= IDENT_INT (10)
-           THEN FAILED ("IMPROPER VALUE FOR V6'FIRST OR V6'LAST");
-      END IF;
- 
-      RESULT;
- END C36180A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36202c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36202c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36202c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36202c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C36202C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'LENGTH DOES NOT RAISE AN EXCEPTION
- -- WHEN APPLIED TO A NULL ARRAY A, EVEN IF A'LAST - A'FIRST 
- -- WOULD RAISE CONSTRAINT_ERROR.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- L.BROWN  07/29/86
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE C36202C IS
- 
-      TYPE LRG_INT IS RANGE MIN_INT .. MAX_INT;
- 
-      BEGIN
-           TEST("C36202C", "NO EXCEPTION IS RAISED FOR 'LENGTH "&
-                           "WHEN APPLIED TO A NULL ARRAY");
-               
-           DECLARE
-                TYPE LRG_ARR IS ARRAY
-                               (LRG_INT RANGE MAX_INT .. MIN_INT)
-                                      OF INTEGER;
-                LRG_OBJ : LRG_ARR;
- 
-           BEGIN
-                IF LRG_OBJ'LENGTH /= 0  THEN
-                     FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                            "FOR ONE-DIM NULL ARRAY");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR WAS RAISED " &
-                            "FOR ONE-DIM NULL ARRAY");
-                WHEN OTHERS =>
-                     FAILED("EXCEPTION RAISED FOR ONE-DIM " &
-                            "NULL ARRAY");
-           END;
- 
-           DECLARE
-                TYPE LRG2_ARR IS ARRAY (LRG_INT RANGE 1 .. 3 ,
-                                 LRG_INT RANGE MAX_INT .. MIN_INT)
-                                 OF INTEGER;
-           BEGIN
-                IF LRG2_ARR'LENGTH(2) /= 0  THEN
-                     FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                            "FOR TWO-DIM NULL ARRAY");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR WAS RAISED " &
-                            "FOR TWO-DIM NULL ARRAY");
-                WHEN OTHERS =>
-                     FAILED("EXCEPTION RAISED FOR TWO-DIM " &
-                            "NULL ARRAY");
-           END;
- 
-      RESULT;
- 
-      END C36202C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36203a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36203a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36203a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- C36203A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'LENGTH YIELDS A RESULT OF TYPE UNIVERSAL INTEGER.
- 
- -- L.BROWN  07/31/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C36203A IS
- 
-      TYPE NINT IS NEW INTEGER RANGE 1 .. 5;
- 
-      TYPE INT_ARR IS ARRAY(INTEGER RANGE 1 .. 3) OF INTEGER;
-      TYPE INT2_ARR IS ARRAY(INTEGER RANGE 1 .. 3,
-                             INTEGER RANGE 1 .. 2) OF INTEGER;
- 
-      OBJA : INTEGER := 3;
-      OBJB : NINT := 3;
- 
- BEGIN
-      TEST("C36203A", "'LENGTH YIELDS A RESULT OF TYPE " &
-                      "UNIVERSAL INTEGER");
-      IF (OBJA + INT_ARR'LENGTH) /= IDENT_INT(6)  THEN
-           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                  "FOR ONE-DIM ARRAY TYPE 1");
-      END IF;
- 
-      IF (OBJB + INT_ARR'LENGTH) /= 6  THEN
-           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                  "FOR ONE-DIM ARRAY TYPE 2");
-      END IF;
- 
-      IF (OBJA + INT2_ARR'LENGTH(1)) /= IDENT_INT(6)  THEN
-           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                  "FOR FIRST DIMENSION OF TWO-DIM ARRAY TYPE 1");
-      END IF;
- 
-      IF (OBJB + INT2_ARR'LENGTH(1)) /= 6  THEN
-           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                  "FOR FIRST DIMENSION OF TWO-DIM ARRAY TYPE 2");
-      END IF;
- 
-      IF (OBJA + INT2_ARR'LENGTH(2)) /= IDENT_INT(5)  THEN
-           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                  "FOR SECOND DIMENSION OF TWO-DIM ARRAY TYPE 1");
-      END IF;
- 
-      IF (OBJB + INT2_ARR'LENGTH(2)) /= 5  THEN
-           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
-                  "FOR SECOND DIMENSION OF TWO-DIM ARRAY TYPE 2");
-      END IF;
- 
-      RESULT;
- 
- END C36203A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C36204A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES.
- -- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED.
- 
- -- DAT 2/12/81
- -- SPS 11/1/82
- -- WMC 03/16/92  CREATED TYPE RANGE CHECK FOR AE_TYPE.
- 
- WITH REPORT;
- PROCEDURE C36204A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C36204A", "ARRAY ATTRIBUTES RETURN CORRECT VALUES");
- 
-      DECLARE
-           A1 : ARRAY (BOOLEAN,
-                       INTEGER RANGE IDENT_INT(1)..IDENT_INT(10))
-                OF STRING(IDENT_INT(5)..IDENT_INT(7));
-           TYPE NI IS  RANGE -3 .. 3;
-           N : NI := NI(IDENT_INT(2));
-           SUBTYPE SNI IS NI RANGE -N .. N;
-           TYPE AA IS ARRAY (NI, SNI, BOOLEAN)
-                OF NI;
-           A1_1_1 : BOOLEAN := A1'FIRST;
-           A1_1_2 : BOOLEAN := A1'LAST(1);
-           A1_2_1 : INTEGER RANGE A1'RANGE(2) := A1'FIRST(2);  -- 1
-           A1_2_2 : INTEGER RANGE A1'RANGE(2) := A1'LAST(2);   -- 10
-           SUBTYPE AE_TYPE IS INTEGER RANGE A1(TRUE,5)'RANGE;    -- RANGE 5..7
-           A2 : AA;
-           A4 : ARRAY (A1_1_1 .. A1_1_2, A1_2_1 .. A1_2_2) OF
-                STRING (IDENT_INT(1)..IDENT_INT(3));
- 
-           I : INTEGER;
-           B : BOOLEAN;
-      BEGIN
-           IF A4'FIRST /= IDENT_BOOL(FALSE)
-              OR A4'LAST /= IDENT_BOOL(TRUE)
-              OR A4'FIRST(2) /= INTEGER'(1)
-              OR A4'LAST(2) /= INTEGER'(10)
-           THEN
-                FAILED ("INCORRECT 'FIRST OR 'LAST  - 1");
-           END IF;
-       
-           IF A4'LENGTH /= INTEGER'(2)
-              OR A4'LENGTH /= NI'(2)
-              OR A4'LENGTH(1) /= N
-              OR A4'LENGTH(2) /= A4'LAST(2)
-           THEN
-                FAILED ("INCORRECT 'LENGTH - 1");
-           END IF;
- 
-           A4 := (BOOLEAN => (1 .. 10 => "XYZ"));
-           FOR L1 IN A1'RANGE(1) LOOP
-                FOR L2 IN A4'RANGE(2) LOOP
-                     A1(L1,L2) := A4(L1,L2);
-                END LOOP;
-           END LOOP;
- 
-           IF AA'FIRST(1) /= NI'(-3)
-              OR AA'LAST(1) /= N + 1
-              OR AA'FIRST(2) /= -N
-              OR AA'LAST(2) /= N
-              OR AA'FIRST(3) /= IDENT_BOOL(FALSE)
-              OR AA'LAST(3) /= IDENT_BOOL(TRUE)
-           THEN
-                FAILED ("INCORRECT 'FIRST OR 'LAST - 2");
-           END IF;
- 
-           IF N NOT IN AA'RANGE(2)
-              OR IDENT_BOOL(FALSE) NOT IN AA'RANGE(3)
-              OR N + 1 NOT IN AA'RANGE
-              OR N + 1 IN AA'RANGE(2)
-           THEN
-                FAILED ("INCORRECT 'RANGE - 1");
-           END IF;
- 
-           IF AA'LENGTH /= INTEGER'(7)
-              OR AA'LENGTH(2) - 3 /= N
-              OR AA'LENGTH(3) /= 2
-           THEN
-                FAILED ("INCORRECT 'LENGTH - 2");
-           END IF;
- 
-           IF A2'FIRST(1) /= NI'(-3)
-              OR A2'LAST(1) /= N + 1
-              OR A2'FIRST(2) /= -N
-              OR A2'LAST(2) /= N
-              OR A2'FIRST(3) /= IDENT_BOOL(FALSE)
-              OR A2'LAST(3) /= IDENT_BOOL(TRUE)
-           THEN 
-                FAILED ("INCORRECT 'FIRST OR 'LAST - 3");
-           END IF;
- 
-           IF N NOT IN A2'RANGE(2)
-              OR IDENT_BOOL(FALSE) NOT IN A2'RANGE(3)
-              OR N + 1 NOT IN A2'RANGE
-              OR N + 1 IN A2'RANGE(2)
-           THEN
-                FAILED ("INCORRECT 'RANGE - 2");
-           END IF;
- 
-           IF A2'LENGTH /= INTEGER'(7)
-              OR A2'LENGTH(2) - 3 /= INTEGER(N)
-              OR A2'LENGTH(3) /= 2
-           THEN
-                FAILED ("INCORRECT 'LENGTH - 3");
-           END IF;
- 
-           IF (AE_TYPE'FIRST /= 5) OR (AE_TYPE'LAST /= 7) THEN
-              FAILED ("INCORRECT TYPE RANGE DEFINED FOR AE_TYPE");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED  ("EXCEPTION RAISED ?");
-      END;
- 
-      RESULT;
- END C36204A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,229 ****
- -- C36204B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES WITH
- --     ACCESS VALUES AND FUNCTION CALLS AS THE PREFIXES.
- 
- -- HISTORY:
- --     L.BROWN   08/05/86
- --     DWC  07/24/87  DELETED BLANK AT END OF TEST DESCRIPTION.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C36204B IS
- 
-      BEGIN
-           TEST("C36204B", "ARRAY ATTRIBUTES RETURN CORRECT VALUES " &
-                           "FOR ACCESS VALUES AND FUNCTION CALLS AS " &
-                           "PREFIXES");
-           DECLARE
-                TYPE ARR1 IS ARRAY (INTEGER RANGE IDENT_INT(1) ..
-                                    IDENT_INT(10)) OF INTEGER ;
-                TYPE ARR2 IS ARRAY (BOOLEAN,
-                                    INTEGER RANGE IDENT_INT(1) ..
-                                    IDENT_INT(3)) OF INTEGER ;
- 
-                TYPE PTR1 IS ACCESS ARR1;
-                TYPE PTR2 IS ACCESS ARR2;
- 
-                PT1 : PTR1 := NEW ARR1'(ARR1'RANGE => 0);
-                PT2 : PTR2 := NEW ARR2'(ARR2'RANGE(1) =>
-                                       (ARR2'RANGE(2) => 0));
-                SUBTYPE ARR1_RANGE IS INTEGER RANGE PT1'RANGE;
-           BEGIN
-                IF PT1'FIRST /= IDENT_INT(1) THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 1");
-                END IF;
- 
-                IF PT2'FIRST(2) /= IDENT_INT(1)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 1");
-                END IF;
- 
-                IF ARR1_RANGE'FIRST /= IDENT_INT(1) THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 2");
-                END IF;
- 
-                IF PT1'LAST /= IDENT_INT(10) THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 3");
-                END IF;
- 
-                IF PT2'LAST(2) /= IDENT_INT(3)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 2");
-                END IF;
- 
-                IF ARR1_RANGE'LAST /= IDENT_INT(10) THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 4");
-                END IF;
- 
-                IF PT1'LENGTH /= IDENT_INT(10) THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 5");
-                END IF;
- 
-                IF PT2'LENGTH(2) /= IDENT_INT(3)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
-                            "ARRAY USING ACCESS TYPES AS PREFIXES 3");
-                END IF;
- 
-           END;
- 
-           DECLARE
- 
-                TYPE UNCON IS ARRAY (INTEGER RANGE <>) OF INTEGER ;
-                TYPE UNCON2 IS ARRAY (INTEGER RANGE <>,
-                                      INTEGER RANGE <>) OF INTEGER ;
- 
-                ARY1 : STRING(IDENT_INT(5) .. IDENT_INT(8));
-                F : INTEGER := IDENT_INT(1);
-                L : INTEGER := IDENT_INT(3);
- 
-                FUNCTION FUN( LO,HI : INTEGER ) RETURN UNCON IS
-                     ARR : UNCON(IDENT_INT(LO) .. IDENT_INT(HI));
-                     BEGIN
-                          ARR := (ARR'RANGE => 0);
-                          RETURN ARR;
-                     END FUN;
- 
-                FUNCTION FUN2( LO,HI : INTEGER ) RETURN UNCON2 IS
-                     AR2 : UNCON2(IDENT_INT(LO) .. IDENT_INT(HI),
-                                  IDENT_INT(LO) .. IDENT_INT(HI));
-                     BEGIN
-                          AR2 := (AR2'RANGE(1) =>(AR2'RANGE(2) => 0));
-                          RETURN AR2;
-                     END FUN2;
-           BEGIN
- 
-                ARY1 := (ARY1'RANGE => 'A');
- 
-                IF FUN(F,L)'FIRST /= IDENT_INT(1)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 1");
-                END IF;
- 
-                IF FUN2(F,L)'FIRST(2) /= IDENT_INT(1)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 1");
-                END IF;
- 
-                IF "&"(ARY1,"XX")'FIRST /= IDENT_INT(5)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 2");
-                END IF;
- 
-                IF FUN(F,L)'LAST /= IDENT_INT(3)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 3");
-                END IF;
- 
-                IF FUN2(F,L)'LAST(2) /= IDENT_INT(3)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 2");
-                END IF;
- 
-                IF "&"(ARY1,"YY")'LAST /= IDENT_INT(10)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 4");
-                END IF;
- 
-                IF FUN(F,L)'LENGTH /= IDENT_INT(3) THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 5");
-                END IF;
- 
-                IF FUN2(F,L)'LENGTH(2) /= IDENT_INT(3)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 3");
-                END IF;
- 
-                IF "&"(ARY1,"XX")'LENGTH /= IDENT_INT(6)  THEN
-                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
-                            "ARRAY USING FUNCTION RESULTS AS " &
-                            "PREFIXES 6");
-                END IF;
- 
-                DECLARE
- 
-                     SUBTYPE SMIN IS INTEGER RANGE FUN(F,L)'RANGE;
-                     SUBTYPE SMIN2 IS INTEGER RANGE FUN2(F,L)'RANGE(2);
-                     SUBTYPE SMIN3 IS INTEGER RANGE "&"(ARY1,"YY")'RANGE;
- 
-                BEGIN
-                     IF SMIN'FIRST /= IDENT_INT(1)  THEN
-                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
-                                 "ONE-DIM ARRAY USING FUNCTION " &
-                                 "RESULTS AS PREFIXES 7");
-                     END IF;
- 
-                     IF SMIN2'FIRST /= IDENT_INT(1)  THEN
-                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
-                                 "TWO-DIM ARRAY USING FUNCTION " &
-                                 "RESULTS AS PREFIXES 4");
-                     END IF;
- 
-                     IF SMIN3'FIRST /= IDENT_INT(5)  THEN
-                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
-                                 "ONE-DIM ARRAY USING FUNCTION " &
-                                 "RESULTS AS PREFIXES 8");
-                     END IF;
- 
-                     IF SMIN'LAST /= IDENT_INT(3)  THEN
-                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
-                                 "ONE-DIM ARRAY USING FUNCTION " &
-                                 "RESULTS AS PREFIXES 9");
-                     END IF;
- 
-                     IF SMIN2'LAST /= IDENT_INT(3)  THEN
-                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
-                                 "TWO-DIM ARRAY USING FUNCTION " &
-                                 "RESULTS AS PREFIXES 5");
-                     END IF;
- 
-                     IF SMIN3'LAST /= IDENT_INT(10)  THEN
-                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
-                                 "ONE-DIM ARRAY USING FUNCTION " &
-                                 "RESULTS AS PREFIXES 10");
-                     END IF;
- 
-                END;
- 
-           END;
- 
-      RESULT;
- 
-      END C36204B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,221 ****
- -- C36204C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE 'RANGE ATTRIBUTE CAN BE USED TO DECLARE OBJECTS
- --     AND IN A SUBTYPE AND TYPE DECLARATION.
- 
- -- HISTORY:
- --     LB  08/13/86  CREATED ORIGINAL TEST.
- --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
- --                   REARRANGED STATEMENTS SO TEST IS CALLED FIRST.
- --                   ELIMINATED DEAD VARIABLE OPTIMIZATION.  CHECKED
- --                   RANGE VALUES FOR A SMALL INTEGER.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  C36204C  IS
- 
- BEGIN
-      TEST("C36204C","USING 'RANGE TO DECLARE OBJECTS AND " &
-                     "IN A SUBTYPE AND TYPE DECLARATION " &
-                     "RETURNS THE CORRECT VALUES.");
- 
-      DECLARE
- 
-           ARR : ARRAY(IDENT_INT(4) .. IDENT_INT(10)) OF INTEGER;
-           OBJ1 : ARRAY(ARR'RANGE) OF BOOLEAN;
- 
-           SUBTYPE SMALL_INT IS INTEGER RANGE ARR'RANGE ;
-           SML : SMALL_INT;
- 
-           TYPE OTHER_ARR IS ARRAY(ARR'RANGE) OF CHARACTER;
-           OBJ2 : OTHER_ARR;
- 
-           TYPE ARR_TYPE IS ARRAY(INTEGER RANGE IDENT_INT(1) ..
-                                  IDENT_INT(10)) OF INTEGER;
-           TYPE ARR_PTR IS ACCESS ARR_TYPE;
-           PTR : ARR_PTR := NEW ARR_TYPE'(ARR_TYPE'RANGE => 0);
- 
-           FUNCTION F RETURN ARR_TYPE IS
-                AR : ARR_TYPE := (ARR_TYPE'RANGE => 0);
-                BEGIN
-                     RETURN AR;
-                END F;
- 
-           BEGIN
-                BEGIN
-                     IF OBJ1'FIRST /= IDENT_INT(4)  THEN
-                          FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
-                                 "DECLARATION 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING " &
-                                 "OBJECT DECLARATION 1");
-                END;
- 
-                BEGIN
-                     IF OBJ1'LAST /= IDENT_INT(10)  THEN
-                          FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
-                                 "DECLARATION 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING " &
-                                 "OBJECT DECLARATION 2");
-                END;
- 
-                BEGIN
-                     IF SMALL_INT'FIRST /= 4 THEN
-                          FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
-                                 "INTEGER DECLARATION 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
-                                 " INTEGER DECLARATION 1");
-                END;
- 
-                BEGIN
-                     IF SMALL_INT'LAST /= 10 THEN
-                          FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
-                                 "INTEGER DECLARATION 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
-                                 " INTEGER DECLARATION 2");
-                END;
- 
-                BEGIN
-                     SML := IDENT_INT(3) ;
-                     IF SML = 3 THEN
-                          COMMENT("VARIABLE SML OPTIMIZED VALUE 1");
-                     END IF;
-                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
-                            "VALUE 1");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
-                                 "RANGE VALUE 1");
-                END;
- 
-                BEGIN
-                     SML := IDENT_INT(11) ;
-                     IF SML = 11 THEN
-                          COMMENT("VARIABLE SML OPTIMIZED VALUE 2");
-                     END IF;
-                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
-                            "VALUE 2");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
-                                 "RANGE VALUE 2");
-                END;
- 
-                BEGIN
-                     IF OBJ2'FIRST /= IDENT_INT(4)  THEN
-                          FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
-                                 "DECLARATION 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING A " &
-                                 "TYPE DECLARATION 1");
-                END;
- 
-                BEGIN
-                     IF OBJ2'LAST /= IDENT_INT(10)  THEN
-                          FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
-                                 "DECLARATION 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING A " &
-                                 "TYPE DECLARATION 2");
-                END;
- 
-                BEGIN
-                     IF PTR'FIRST /= IDENT_INT(1)  THEN
-                          FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
-                                 "TYPE DECLARATION 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
-                                 "ACCESS TYPE DECLARATION 1");
-                END;
- 
-                BEGIN
-                     IF PTR'LAST /= IDENT_INT(10)  THEN
-                          FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
-                                 "TYPE DECLARATION 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
-                                 "ACCESS TYPE DECLARATION 2");
-                END;
- 
-                DECLARE
-                     OBJ_F1 : INTEGER RANGE F'RANGE ;
-                BEGIN
-                     OBJ_F1 := IDENT_INT(0) ;
-                     IF OBJ_F1 = 0 THEN
-                          COMMENT("VARIABLE OBJ_F1 OPTIMIZED VALUE 1");
-                     END IF;
-                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
-                            "VALUE 3");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
-                                 "RANGE VALUE 3");
-                END;
- 
-                DECLARE
-                     OBJ_F2 : INTEGER RANGE F'RANGE ;
-                BEGIN
-                     OBJ_F2 := IDENT_INT(11) ;
-                     IF OBJ_F2 = 11 THEN
-                          COMMENT("VARIABLE OBJ_F2 OPTIMIZED VALUE 1");
-                     END IF;
-                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
-                            "VALUE 4");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
-                                 "RANGE VALUE 4");
-                END;
-           END;
-      RESULT;
- 
- END C36204C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36204d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36204d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,598 ****
- -- C36204D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES.
- -- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED. THIS TEST CHECKS 
- -- THE ABOVE FOR ARRAYS WITHIN GENERIC PROGRAM UNITS.
- 
- -- HISTROY
- --  EDWARD V. BERARD, 9 AUGUST 1990
- 
- WITH REPORT ;
- WITH SYSTEM ;
- 
- PROCEDURE C36204D IS
- 
-     SHORT_START : CONSTANT := -10 ;
-     SHORT_END    : CONSTANT := 10 ;
-     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
-     SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
-     
-     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                         SEP, OCT, NOV, DEC) ;
-     SUBTYPE MID_YEAR IS MONTH_TYPE RANGE MAY .. AUG ;
-     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-     TYPE DATE IS RECORD
-       MONTH : MONTH_TYPE ;
-       DAY   : DAY_TYPE ;
-       YEAR  : YEAR_TYPE ;
-     END RECORD ;
-     
-     TODAY         : DATE := (MONTH => AUG,
-                              DAY   => 10,
-                              YEAR  => 1990) ;
-                             
-     FIRST_DATE     : DATE := (DAY   => 6,
-                               MONTH => JUN,
-                               YEAR  => 1967) ;
-                             
-     FUNCTION "=" (LEFT  : IN SYSTEM.ADDRESS ;
-                   RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN
-             RENAMES SYSTEM."=" ;
- 
-     GENERIC
-     
-         TYPE FIRST_INDEX IS (<>) ;
-         FIRST_INDEX_LENGTH : IN NATURAL ;
-         FIRST_TEST_VALUE : IN FIRST_INDEX ;
-         TYPE SECOND_INDEX IS (<>) ;
-         SECOND_INDEX_LENGTH : IN NATURAL ;
-         SECOND_TEST_VALUE : IN SECOND_INDEX ;
-         TYPE THIRD_INDEX IS (<>) ;
-         THIRD_INDEX_LENGTH : IN NATURAL ;
-         THIRD_TEST_VALUE : IN THIRD_INDEX ;
-         TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
-         FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
-         SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
-         TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
-         THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
-         FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
-     
-     PACKAGE ARRAY_ATTRIBUTE_TEST IS
-     
-         TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
-             OF FIRST_COMPONENT_TYPE ;
-             
-         TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
-             OF SECOND_COMPONENT_TYPE ;
-             
-     END ARRAY_ATTRIBUTE_TEST ;
-     
-     PACKAGE BODY ARRAY_ATTRIBUTE_TEST IS
-     
-         FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                     FIRST_DEFAULT_VALUE)) ;
-         
-         SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
-                                        THIRD_DEFAULT_VALUE))) ;
-                                     
-         THIRD_ARRAY : CONSTANT MATRIX 
-                              := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                     SECOND_DEFAULT_VALUE)) ;
-                                         
-         FOURTH_ARRAY : CONSTANT CUBE 
-                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
-                                        FOURTH_DEFAULT_VALUE))) ;
-                                     
-         FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
-         FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
-         FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
-         FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
-         
-         SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
-         SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
-         SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
-         SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
-         SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
-         SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
-         
-         FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
-         FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
-         
-         SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
-         SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
-         SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
-         
-         MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
-         CUBE_SIZE    : NATURAL := CUBE'SIZE ;
-         
-         FAA  : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
-         SAA  : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
-         TAA  : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
-         FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
-              
-      BEGIN  -- ARRAY_ATTRIBUTE_TEST
-      
-         IF (FA1 /= FIRST_INDEX'FIRST) OR
-            (FA3 /= SECOND_INDEX'FIRST) OR
-            (SA1 /= FIRST_INDEX'FIRST) OR
-            (SA3 /= SECOND_INDEX'FIRST) OR
-            (SA5 /= THIRD_INDEX'FIRST) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST - PACKAGE") ;
-         END IF ;
-         
-         IF (FA2 /= FIRST_INDEX'LAST) OR
-            (FA4 /= SECOND_INDEX'LAST) OR
-            (SA2 /= FIRST_INDEX'LAST) OR
-            (SA4 /= SECOND_INDEX'LAST) OR
-            (SA6 /= THIRD_INDEX'LAST) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST - PACKAGE") ;
-         END IF ;
-         
-         IF (FAL1 /= FIRST_INDEX_LENGTH) OR
-            (FAL2 /= SECOND_INDEX_LENGTH) OR
-            (SAL1 /= FIRST_INDEX_LENGTH) OR
-            (SAL2 /= SECOND_INDEX_LENGTH) OR
-            (SAL3 /= THIRD_INDEX_LENGTH) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH - PACKAGE") ;
-         END IF ;
-         
-         FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
-             FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
-                 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
-                     SECOND_DEFAULT_VALUE ;
-             END LOOP ;
-         END LOOP ;
-         
-         IF FIRST_ARRAY /= THIRD_ARRAY THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "FOR 2-DIMENSIONAL ARRAY. - PACKAGE") ;
-         END IF ;
-         
-         FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
-             FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
-                 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
-                     SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
-                         := FOURTH_DEFAULT_VALUE ;
-                 END LOOP ;
-             END LOOP ;
-         END LOOP ;
-         
-         IF SECOND_ARRAY /= FOURTH_ARRAY THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "FOR 3-DIMENSIONAL ARRAY. - PACKAGE") ;
-         END IF ;
-         
-         IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
-            (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
-            (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
-            (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
-            (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "- PACKAGE") ;
-         END IF ;
-         
-         IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
-                            "- PACKAGE") ;
-         END IF ;
-         
-         IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
-            OR (SAA = TAA) OR (TAA = FRAA) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
-                            "- PACKAGE") ;
-         END IF ;
-         
-     END ARRAY_ATTRIBUTE_TEST ;
- 
-     GENERIC
-     
-         TYPE FIRST_INDEX IS (<>) ;
-         FIRST_INDEX_LENGTH : IN NATURAL ;
-         FIRST_TEST_VALUE : IN FIRST_INDEX ;
-         TYPE SECOND_INDEX IS (<>) ;
-         SECOND_INDEX_LENGTH : IN NATURAL ;
-         SECOND_TEST_VALUE : IN SECOND_INDEX ;
-         TYPE THIRD_INDEX IS (<>) ;
-         THIRD_INDEX_LENGTH : IN NATURAL ;
-         THIRD_TEST_VALUE : IN THIRD_INDEX ;
-         TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
-         FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
-         SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
-         TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
-         THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
-         FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
-         
-     PROCEDURE PROC_ARRAY_ATT_TEST ;
-     
-     PROCEDURE PROC_ARRAY_ATT_TEST IS
-     
-         TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
-             OF FIRST_COMPONENT_TYPE ;
-             
-         TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
-             OF SECOND_COMPONENT_TYPE ;
-             
-         FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                     FIRST_DEFAULT_VALUE)) ;
-         
-         SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
-                                        THIRD_DEFAULT_VALUE))) ;
-                                     
-         THIRD_ARRAY : CONSTANT MATRIX 
-                              := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                     SECOND_DEFAULT_VALUE)) ;
-                                         
-         FOURTH_ARRAY : CONSTANT CUBE 
-                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
-                                        FOURTH_DEFAULT_VALUE))) ;
-                                     
-         FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
-         FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
-         FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
-         FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
-         
-         SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
-         SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
-         SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
-         SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
-         SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
-         SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
-         
-         FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
-         FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
-         
-         SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
-         SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
-         SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
-         
-         MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
-         CUBE_SIZE    : NATURAL := CUBE'SIZE ;
-         
-         FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
-         SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
-         TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
-         FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
-              
-      BEGIN  -- PROC_ARRAY_ATT_TEST
- 
-         IF (FA1 /= FIRST_INDEX'FIRST) OR
-            (FA3 /= SECOND_INDEX'FIRST) OR
-            (SA1 /= FIRST_INDEX'FIRST) OR
-            (SA3 /= SECOND_INDEX'FIRST) OR
-            (SA5 /= THIRD_INDEX'FIRST) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
-                            "- PROCEDURE") ;
-         END IF ;
-         
-         IF (FA2 /= FIRST_INDEX'LAST) OR
-            (FA4 /= SECOND_INDEX'LAST) OR
-            (SA2 /= FIRST_INDEX'LAST) OR
-            (SA4 /= SECOND_INDEX'LAST) OR
-            (SA6 /= THIRD_INDEX'LAST) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
-                            "- PROCEDURE") ;
-         END IF ;
-         
-         IF (FAL1 /= FIRST_INDEX_LENGTH) OR
-            (FAL2 /= SECOND_INDEX_LENGTH) OR
-            (SAL1 /= FIRST_INDEX_LENGTH) OR
-            (SAL2 /= SECOND_INDEX_LENGTH) OR
-            (SAL3 /= THIRD_INDEX_LENGTH) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
-                            "- PROCEDURE") ;
-         END IF ;
-         
-         FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
-             FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
-                 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
-                     SECOND_DEFAULT_VALUE ;
-             END LOOP ;
-         END LOOP ;
-         
-         IF FIRST_ARRAY /= THIRD_ARRAY THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "FOR 2-DIMENSIONAL ARRAY. - PROCEDURE") ;
-         END IF ;
-         
-         FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
-             FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
-                 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
-                     SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
-                         := FOURTH_DEFAULT_VALUE ;
-                 END LOOP ;
-             END LOOP ;
-         END LOOP ;
-         
-         IF SECOND_ARRAY /= FOURTH_ARRAY THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "FOR 3-DIMENSIONAL ARRAY. - PROCEDURE") ;
-         END IF ;
-         
-         IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
-            (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
-            (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
-            (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
-            (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "- PROCEDURE") ;
-         END IF ;
-         
-         IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
-                            "- PROCEDURE") ;
-         END IF ;
-         
-         IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
-            OR (SAA = TAA) OR (TAA = FRAA) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
-                            "- PROCEDURE") ;
-         END IF ;
-         
-     END PROC_ARRAY_ATT_TEST ;
- 
-     GENERIC
-     
-         TYPE FIRST_INDEX IS (<>) ;
-         FIRST_INDEX_LENGTH : IN NATURAL ;
-         FIRST_TEST_VALUE : IN FIRST_INDEX ;
-         TYPE SECOND_INDEX IS (<>) ;
-         SECOND_INDEX_LENGTH : IN NATURAL ;
-         SECOND_TEST_VALUE : IN SECOND_INDEX ;
-         TYPE THIRD_INDEX IS (<>) ;
-         THIRD_INDEX_LENGTH : IN NATURAL ;
-         THIRD_TEST_VALUE : IN THIRD_INDEX ;
-         TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
-         FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
-         SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
-         TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
-         THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
-         FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
-         
-     FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN ;
-     
-     FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN IS
-     
-         TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
-             OF FIRST_COMPONENT_TYPE ;
-             
-         TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
-             OF SECOND_COMPONENT_TYPE ;
-             
-         FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                     FIRST_DEFAULT_VALUE)) ;
-         
-         SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
-                                        THIRD_DEFAULT_VALUE))) ;
-                                     
-         THIRD_ARRAY : CONSTANT MATRIX 
-                              := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                     SECOND_DEFAULT_VALUE)) ;
-                                         
-         FOURTH_ARRAY : CONSTANT CUBE 
-                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
-                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
-                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
-                                        FOURTH_DEFAULT_VALUE))) ;
-                                     
-         FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
-         FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
-         FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
-         FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
-         
-         SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
-         SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
-         SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
-         SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
-         SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
-         SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
-         
-         FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
-         FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
-         
-         SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
-         SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
-         SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
-         
-         MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
-         CUBE_SIZE    : NATURAL := CUBE'SIZE ;
-         
-         FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
-         SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
-         TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
-         FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
-              
-      BEGIN  -- FUNC_ARRAY_ATT_TEST
- 
-         IF (FA1 /= FIRST_INDEX'FIRST) OR
-            (FA3 /= SECOND_INDEX'FIRST) OR
-            (SA1 /= FIRST_INDEX'FIRST) OR
-            (SA3 /= SECOND_INDEX'FIRST) OR
-            (SA5 /= THIRD_INDEX'FIRST) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
-                            "- FUNCTION") ;
-         END IF ;
-         
-         IF (FA2 /= FIRST_INDEX'LAST) OR
-            (FA4 /= SECOND_INDEX'LAST) OR
-            (SA2 /= FIRST_INDEX'LAST) OR
-            (SA4 /= SECOND_INDEX'LAST) OR
-            (SA6 /= THIRD_INDEX'LAST) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
-                            "- FUNCTION") ;
-         END IF ;
-         
-         IF (FAL1 /= FIRST_INDEX_LENGTH) OR
-            (FAL2 /= SECOND_INDEX_LENGTH) OR
-            (SAL1 /= FIRST_INDEX_LENGTH) OR
-            (SAL2 /= SECOND_INDEX_LENGTH) OR
-            (SAL3 /= THIRD_INDEX_LENGTH) THEN
-             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
-                            "- FUNCTION") ;
-         END IF ;
-         
-         FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
-             FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
-                 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
-                     SECOND_DEFAULT_VALUE ;
-             END LOOP ;
-         END LOOP ;
-         
-         IF FIRST_ARRAY /= THIRD_ARRAY THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "FOR 2-DIMENSIONAL ARRAY. - FUNCTION") ;
-         END IF ;
-         
-         FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
-             FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
-                 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
-                     SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
-                         := FOURTH_DEFAULT_VALUE ;
-                 END LOOP ;
-             END LOOP ;
-         END LOOP ;
-         
-         IF SECOND_ARRAY /= FOURTH_ARRAY THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "FOR 3-DIMENSIONAL ARRAY. - FUNCTION") ;
-         END IF ;
-         
-         IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
-            (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
-            (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
-            (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
-            (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
-                            "- FUNCTION") ;
-         END IF ;
-         
-         IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
-                            "- FUNCTION") ;
-         END IF ;
-         
-         IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
-            OR (SAA = TAA) OR (TAA = FRAA) THEN
-             REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
-                            "- FUNCTION") ;
-         END IF ;
-         
-         RETURN TRUE ;
-         
-     END FUNC_ARRAY_ATT_TEST ;
- 
- 
- BEGIN -- C36204D
- 
-     REPORT.TEST ("C36204D", "ARRAY ATTRIBUTES RETURN CORRECT " &
-                   "VALUES WITHIN GENERIC PROGRAM UNITS.") ;
-      
-     LOCAL_BLOCK:
-     
-     DECLARE
-     
-         DUMMY : BOOLEAN := FALSE ;
-     
-         PACKAGE NEW_ARRAY_ATTRIBUTE_TEST IS NEW ARRAY_ATTRIBUTE_TEST (
-             FIRST_INDEX             => SHORT_RANGE,
-             FIRST_INDEX_LENGTH      => SHORT_LENGTH,
-             FIRST_TEST_VALUE        => -7,
-             SECOND_INDEX            => MONTH_TYPE,
-             SECOND_INDEX_LENGTH     => 12,
-             SECOND_TEST_VALUE       => AUG,
-             THIRD_INDEX             => BOOLEAN,
-             THIRD_INDEX_LENGTH      => 2,
-             THIRD_TEST_VALUE        => FALSE,
-             FIRST_COMPONENT_TYPE    => MONTH_TYPE,
-             FIRST_DEFAULT_VALUE     => JAN,
-             SECOND_DEFAULT_VALUE    => DEC,
-             SECOND_COMPONENT_TYPE   => DATE,
-             THIRD_DEFAULT_VALUE     => TODAY,
-             FOURTH_DEFAULT_VALUE    => FIRST_DATE) ;
-         
-         PROCEDURE NEW_PROC_ARRAY_ATT_TEST IS NEW PROC_ARRAY_ATT_TEST (
-             FIRST_INDEX             => MONTH_TYPE,
-             FIRST_INDEX_LENGTH      => 12,
-             FIRST_TEST_VALUE        => AUG,
-             SECOND_INDEX            => SHORT_RANGE,
-             SECOND_INDEX_LENGTH     => SHORT_LENGTH,
-             SECOND_TEST_VALUE       => -7,
-             THIRD_INDEX             => BOOLEAN,
-             THIRD_INDEX_LENGTH      => 2,
-             THIRD_TEST_VALUE        => FALSE,
-             FIRST_COMPONENT_TYPE    => DATE,
-             FIRST_DEFAULT_VALUE     => TODAY,
-             SECOND_DEFAULT_VALUE    => FIRST_DATE,
-             SECOND_COMPONENT_TYPE   => MONTH_TYPE,
-             THIRD_DEFAULT_VALUE     => JAN,
-             FOURTH_DEFAULT_VALUE    => DEC) ;
- 
-         FUNCTION NEW_FUNC_ARRAY_ATT_TEST IS NEW FUNC_ARRAY_ATT_TEST (
-             FIRST_INDEX             => DAY_TYPE,
-             FIRST_INDEX_LENGTH      => 31,
-             FIRST_TEST_VALUE        => 25,
-             SECOND_INDEX            => SHORT_RANGE,
-             SECOND_INDEX_LENGTH     => SHORT_LENGTH,
-             SECOND_TEST_VALUE       => -7,
-             THIRD_INDEX             => MID_YEAR,
-             THIRD_INDEX_LENGTH      => 4,
-             THIRD_TEST_VALUE        => JUL,
-             FIRST_COMPONENT_TYPE    => DATE,
-             FIRST_DEFAULT_VALUE     => TODAY,
-             SECOND_DEFAULT_VALUE    => FIRST_DATE,
-             SECOND_COMPONENT_TYPE   => MONTH_TYPE,
-             THIRD_DEFAULT_VALUE     => JAN,
-             FOURTH_DEFAULT_VALUE    => DEC) ;
- 
-     BEGIN  -- LOCAL_BLOCK
-     
-         NEW_PROC_ARRAY_ATT_TEST ;
-         
-         DUMMY := NEW_FUNC_ARRAY_ATT_TEST ;
-         IF NOT DUMMY THEN
-             REPORT.FAILED ("WRONG VALUE RETURNED BY FUNCTION.") ;
-         END IF ;
-         
-     END LOCAL_BLOCK ;
-      
-     REPORT.RESULT ;
-      
- END C36204D ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,212 ****
- -- C36205A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
- --   PARAMETERS
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205A IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205A", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - BASIC CHECKS");
- 
-      IF A10'FIRST /= 1
-         OR A2_10'FIRST(1) /= 1
-         OR A2_10'FIRST(2) /= IDENT_INT(13)
-         OR A2_20'FIRST /= 11
-         OR A2_20'FIRST(2) /= 21
-      THEN
-           FAILED ("'FIRST FOR OBJECTS IS WRONG");
-      END IF;
- 
- 
-      IF A10'LAST(1) /= 10
-         OR A2_10'LAST /= 10
-         OR A2_10'LAST(2) /= 20
-         OR A2_20'LAST(1) /= 30
-         OR A2_20'LAST(2) /= IDENT_INT(20)
-      THEN
-           FAILED ("'LAST FOR OBJECTS IS WRONG");
-      END IF;
-        IF A10'LENGTH /= IDENT_INT(10)
-         OR A2_10'LENGTH(1) /= 10
-         OR A2_10'LENGTH(2) /= IDENT_INT(8)
-         OR A2_20'LENGTH /= 20
-         OR A2_20'LENGTH(2) /= IDENT_INT(0)
-      THEN
-           FAILED ("'LENGTH FOR OBJECTS IS WRONG");
-      END IF;
- 
-      IF 0 IN A10'RANGE
-         OR IDENT_INT(11) IN A10'RANGE(1)
-         OR IDENT_INT(0) IN A2_10'RANGE(1)
-         OR 11 IN A2_10'RANGE
-         OR 12 IN A2_10'RANGE(2)
-         OR IDENT_INT(21) IN A2_10'RANGE(2)
-         OR 10 IN A2_20'RANGE
-         OR IDENT_INT(31) IN A2_20'RANGE(1)
-         OR IDENT_INT(20) IN A2_20'RANGE(2)
-         OR 0 IN A2_20'RANGE(2)
-      THEN
-           FAILED ("'RANGE FOR OBJECTS IS WRONG");
-      END IF;
- 
-      P1 (A10, 1, 10, "P1 1");
-      P1 (A20, 18, 20, "P1 A20");
-      P2(A2_10, 1, 10, 13, 20, "P2 1");
-      P2 (A2_20, 11, 30, 21, 20, "P2 2");
-      S1 (ALF, 1, 5, "X0");
-      S1 (ARF, 5, 9, "ARF1");
- 
-      RESULT;
- 
- END C36205A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,169 ****
- -- C36205B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF NON-NULL STATIC SLICES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205B IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205B", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - NON-NULL STATIC SLICES");
- 
-      P1 (A10(1 .. 10), 1, 10, "P1 2");
-      P1 (A10(1..9), 1, 9, "P1 3");
-      P1 (A10(2..10), 2, 10, "P1 4");
-      P1 (A10 (2..9), 2, 9, "P1 5");
-      P1 (A10 (4 .. 5), 4, 5, "P1 6");
-      P1 (A10 (5 .. 5), 5, 5, "P1 7");
- 
-      RESULT;
- END C36205B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C36205C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF NON-NULL DYNAMIC SLICES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205C IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205C", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - NON-NULL DYNAMIC SLICES");
- 
-      P1 (A10 (I10..I10), 10, 10, "P1 8");
-      P1 (A10 (I10 - 9 .. I10), 1, 10, "P1 9");
- 
-      RESULT;
- END C36205C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,180 ****
- -- C36205D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF NULL STATIC SLICES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205D IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205D", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - NULL STATIC SLICES");
- 
-      P1 (A10 (1 .. 0), 1, 0, "P1 11");
-      P1 (A10 (2 .. 1), 2, 1, "P1 12");
- 
-      P1 (A10, 1, 10, "P1 1");
-      P1 (A10(1 .. 10), 1, 10, "P1 2");
-      P1 (A10(1..9), 1, 9, "P1 3");
-      P1 (A10(2..10), 2, 10, "P1 4");
-      P1 (A10 (2..9), 2, 9, "P1 5");
-      P1 (A10 (4 .. 5), 4, 5, "P1 6");
-      P1 (A10 (5 .. 5), 5, 5, "P1 7");
-      P1 (A10 (I10..I10), 10, 10, "P1 8");
-      P1 (A10 (I10 - 9 .. I10), 1, 10, "P1 9");
-      P1 (A10 (I10 .. I10 - 1), 10, 9, "P1 10");
-      P1 (A10 (9 .. 10), 9, 10, "P1 13");
-      P1 (A10 (10 .. 9), 10, 9, "P1 14");
-      P1 (A10 (9 .. I10 - 1), 9, 9, "P1 15");
-      P1 (A10 (9 .. 8), 9, 8, "P1 16");
- 
-      RESULT;
- END C36205D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C36205E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF DYNAMIC NULL SLICES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205E IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205E", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - DYNAMIC NULL SLICES");
- 
-      P1 (A10 (I10 .. I10 - 1), 10, 9, "P1 10");
- 
-      RESULT;
- END C36205E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C36205F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF STATIC NON-NULL AGGREGATES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205F IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205F", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - STATIC NON-NULL AGGREGATES");
- 
-      P1 ((3 .. 5 => 2), 3, 5, "P1 16");
-      P1 ((5 .. 5 => 5), 5, 5, "P1 17");
- 
-      RESULT;
- END C36205F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205g.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C36205G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF DYNAMIC NON-NULL AGGREGATES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205G IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205G", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - DYNAMIC NON-NULL AGGREGATES");
- 
-      P1 ((IDENT_INT(3) .. IDENT_INT(5) => 2), 3, 5, "P1 16");
-      P1 ((IDENT_INT(5) .. 5 => 5), 5, 5, "P1 17");
- 
-      RESULT;
- END C36205G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,166 ****
- -- C36205H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF STATIC NULL AGGREGATES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205H IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205H", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - STATIC NULL AGGREGATES");
- 
-      P1 ((5 .. 4 => 4), 5, 4, "P1 18");
-      P1 ((1 .. 0 => 0), 1, 0, "P1 19");
-      P1 ((-12 .. -13 => 3), -12, -13, "P1 21");
- 
-      RESULT;
- END C36205H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205i.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- C36205I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF DYNAMIC NULL AGGREGATES
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205I IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      SUBTYPE STR IS STRING;
-      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205I", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - DYNAMIC NULL AGGREGATES");
- 
- 
-      P1 ((IDENT_INT(5) .. IDENT_INT(4) => 4), 5, 4, "P1 18");
-      P1 ((IDENT_INT(1) .. IDENT_INT(0) => 0), 1, 0, "P1 19");
-      P1 ((IDENT_INT(-12) .. -13 => 3), -12, -13, "P1 21");
- 
-      RESULT;
- END C36205I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,180 ****
- -- C36205J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF SLICES AND AGGREGATES OF MORE COMPLEX FORMS
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205J IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      TYPE STR IS NEW STRING;
-      ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205J", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - COMPLEX MIXTURE OF SLICES/AGGREGATES");
- 
-      FOR J IN IDENT_INT (-3) .. IDENT_INT (3) LOOP
-           FOR K IN J - 1 .. 2 LOOP
-                P1 ((J .. K => 0), J, K, "X");
-                P1 (A10 (J + 4 .. K + 4), J+4, K+4, "Y");
-           END LOOP;
-      END LOOP;
-      FOR I IN 18 .. 20 LOOP
-           FOR J IN I-1 .. 20 LOOP
-                P1 (A20 (I .. J), I, J, "A20 88");
-           END LOOP;
-      END LOOP;
-      FOR I IN 1 .. 5 LOOP
-           FOR J IN I - 1 .. 5 LOOP
-                S1( ALF (I .. J), I, J, "ALF 1");
-                S1 (ARF (I+4..J+4), I+4, J+4, "ARF 4");
-           END LOOP;
-      END LOOP;
- 
-      RESULT;
- END C36205J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205k.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,173 ****
- -- C36205K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
- -- UNCONSTRAINED FORMAL PARAMETERS.
- 
- -- ATTRIBUTES OF SLICE OF SLICE
- 
- -- DAT 2/17/81
- -- JBG 9/11/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36205K IS
- 
-      USE REPORT;
- 
-      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
-           INTEGER RANGE <> ) OF INTEGER;
-      A10 : I_A (1 .. 10);
-      A20 : I_A (18 .. 20);
-      I10 : INTEGER := IDENT_INT (10);
-      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
-      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
-      TYPE STR IS NEW STRING;
-      ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
-      ARF : STR(5 .. 9) := ALF;
- 
-      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= FIR
-              OR A'FIRST(1) /= FIR
-           THEN
-                FAILED ("'FIRST IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST /= LAS
-              OR A'LAST(1) /= LAS
-           THEN
-                FAILED ("'LAST IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH /= LAS - FIR + 1
-              OR A'LENGTH /= A'LENGTH(1)
-           THEN
-                FAILED ("'LENGTH IS WRONG " & S);
-           END IF;
- 
-           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
-              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
-              OR FIR - 1 IN A'RANGE
-              OR LAS + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE IS WRONG " & S);
-           END IF;
- 
-      END P1;
- 
-      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
-      BEGIN
-           IF A'FIRST /= A'FIRST(1)
-              OR A'FIRST /= F1
-           THEN
-                FAILED ("'FIRST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(1) /= L1 THEN
-                FAILED ("'LAST(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'LENGTH(1) /= A'LENGTH
-              OR A'LENGTH /= L1 - F1 + 1
-           THEN
-                FAILED ("'LENGTH(1) IS WRONG " & S);
-           END IF;
- 
-           IF F1 - 1 IN A'RANGE
-              OR (F1 NOT IN A'RANGE AND F1 <= L1)
-              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
-              OR L1 + 1 IN A'RANGE(1)
-           THEN
-                FAILED ("'RANGE(1) IS WRONG " & S);
-           END IF;
- 
-           IF A'FIRST(2) /= F2 THEN
-                FAILED ("'FIRST(2) IS WRONG " & S);
-           END IF;
- 
-           IF A'LAST(2) /= L2 THEN
-                FAILED ("'LAST(2) IS WRONG " & S);
-           END IF;
- 
-           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
-                FAILED ("'LENGTH(2) IS WRONG " & S);
-           END IF;
- 
-           IF F2 - 1 IN A'RANGE(2)
-              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
-              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
-              OR L2 + 1 IN A'RANGE(2)
-           THEN
-                FAILED ("'RANGE(2) IS WRONG " & S);
-           END IF;
-      END P2;
- 
-      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
-      BEGIN
-           IF S'FIRST /= F THEN
-                FAILED ("STRING 'FIRST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LAST(1) /= L THEN
-                FAILED ("STRING 'LAST IS WRONG " & MESS);
-           END IF;
- 
-           IF S'LENGTH /= L - F + 1
-              OR S'LENGTH(1) /= S'LENGTH
-           THEN
-                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
-           END IF;
- 
-           IF (F <= L AND
-                 (F NOT IN S'RANGE
-                 OR L NOT IN S'RANGE
-                 OR F NOT IN S'RANGE(1)
-                 OR L NOT IN S'RANGE(1)))
-              OR F - 1 IN S'RANGE
-              OR L + 1 IN S'RANGE(1)
-           THEN
-                FAILED ("STRING 'RANGE IS WRONG " & MESS);
-           END IF;
-      END S1;
- 
- BEGIN
-      TEST ( "C36205K", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
-                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
-                        "ARRAYS - SLICES OF SLICES");
- 
-      FOR I IN 18 .. 20 LOOP
-           FOR J IN I-1 .. 20 LOOP
-                P1 (A20 (A20'RANGE)(I..J), I, J, "A20 99");
-           END LOOP;
-      END LOOP;
-      FOR I IN 1 .. 5 LOOP
-           FOR J IN I - 1 .. 5 LOOP
-                S1 (ALF (1..5)(I..J),I,J,"ALF 3");
-           END LOOP;
-      END LOOP;
- 
-      RESULT;
- END C36205K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36205l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36205l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,288 ****
- -- C36205L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE
- --      FOR GENERIC PROCEDURES, CHECK THAT ATTRIBUTES GIVE THE
- --      CORRECT VALUES FOR UNCONSTRAINED FORMAL PARAMETERS.
- --      BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
- --      PARAMETERS TO GENERIC PROCEDURES
- 
- -- HISTORY
- --      EDWARD V. BERARD, 9 AUGUST 1990
- --      DAS   8 OCT 1990   ADDED OUT MODE PARAMETER TO GENERIC
- --                         PROCEDURE TEST_PROCEDURE AND FORMAL
- --                         GENERIC PARAMETER COMPONENT_VALUE.
- 
- WITH REPORT ;
- 
- PROCEDURE C36205L IS
- 
-      SHORT_START : CONSTANT := -100 ;
-      SHORT_END   : CONSTANT := 100 ;
-      TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
-      SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
- 
-      MEDIUM_START    : CONSTANT := 1 ;
-      MEDIUM_END      : CONSTANT := 100 ;
-      TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
-      MEDIUM_LENGTH : CONSTANT NATURAL := (MEDIUM_END - MEDIUM_START
-                                           + 1) ;
- 
-      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                          SEP, OCT, NOV, DEC) ;
-      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-      TYPE DATE IS RECORD
-           MONTH : MONTH_TYPE ;
-           DAY   : DAY_TYPE ;
-           YEAR  : YEAR_TYPE ;
-      END RECORD ;
- 
-      TODAY : DATE := (MONTH => AUG,
-                       DAY   => 9,
-                       YEAR  => 1990) ;
- 
-      SUBTYPE SHORT_STRING IS STRING (1 ..5) ;
- 
-      DEFAULT_STRING : SHORT_STRING := "ABCDE" ;
- 
-      TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
-                                    MEDIUM_RANGE RANGE <>) OF DATE ;
- 
-      TYPE SECOND_TEMPLATE IS ARRAY (MONTH_TYPE RANGE <>,
-                                     DAY_TYPE RANGE <>) OF SHORT_STRING ;
- 
-      TYPE THIRD_TEMPLATE IS ARRAY (CHARACTER RANGE <>,
-                                    BOOLEAN RANGE <>) OF DAY_TYPE ;
- 
-      FIRST_ARRAY      : FIRST_TEMPLATE (-10 .. 10, 27 .. 35)
-                             := (-10 .. 10 =>
-                                (27 .. 35 => TODAY)) ;
-      SECOND_ARRAY     : SECOND_TEMPLATE (JAN .. JUN, 1 .. 25)
-                             := (JAN .. JUN =>
-                                (1 .. 25 => DEFAULT_STRING)) ;
-      THIRD_ARRAY      : THIRD_TEMPLATE ('A' .. 'Z', FALSE .. TRUE)
-                             := ('A' .. 'Z' =>
-                                (FALSE .. TRUE => DAY_TYPE (9))) ;
- 
-      FOURTH_ARRAY    : FIRST_TEMPLATE (0 .. 27, 75 .. 100)
-                             := (0 .. 27 =>
-                                (75 .. 100 => TODAY)) ;
-      FIFTH_ARRAY     : SECOND_TEMPLATE (JUL .. OCT, 6 .. 10)
-                             := (JUL .. OCT =>
-                                (6 .. 10 => DEFAULT_STRING)) ;
-      SIXTH_ARRAY      : THIRD_TEMPLATE ('X' .. 'Z', TRUE .. TRUE)
-                             := ('X' .. 'Z' =>
-                                (TRUE .. TRUE => DAY_TYPE (31))) ;
- 
-      GENERIC
- 
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           TYPE UNCONSTRAINED_ARRAY IS ARRAY (FIRST_INDEX RANGE <>,
-                     SECOND_INDEX RANGE <>) OF COMPONENT_TYPE ;
-           COMPONENT_VALUE: IN  COMPONENT_TYPE;
- 
-      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
-                                FFIFS        : IN FIRST_INDEX ;
-                                FFILS        : IN FIRST_INDEX ;
-                                FSIFS        : IN SECOND_INDEX ;
-                                FSILS        : IN SECOND_INDEX ;
-                                FFLEN        : IN NATURAL ;
-                                FSLEN        : IN NATURAL ;
-                                FFIRT        : IN FIRST_INDEX ;
-                                FSIRT        : IN SECOND_INDEX ;
-                                SECOND       : OUT UNCONSTRAINED_ARRAY ;
-                                SFIFS        : IN FIRST_INDEX ;
-                                SFILS        : IN FIRST_INDEX ;
-                                SSIFS        : IN SECOND_INDEX ;
-                                SSILS        : IN SECOND_INDEX ;
-                                SFLEN        : IN NATURAL ;
-                                SSLEN        : IN NATURAL ;
-                                SFIRT        : IN FIRST_INDEX ;
-                                SSIRT        : IN SECOND_INDEX ;
-                                REMARKS      : IN STRING) ;
- 
-      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
-                                FFIFS        : IN FIRST_INDEX ;
-                                FFILS        : IN FIRST_INDEX ;
-                                FSIFS        : IN SECOND_INDEX ;
-                                FSILS        : IN SECOND_INDEX ;
-                                FFLEN        : IN NATURAL ;
-                                FSLEN        : IN NATURAL ;
-                                FFIRT        : IN FIRST_INDEX ;
-                                FSIRT        : IN SECOND_INDEX ;
-                                SECOND       : OUT UNCONSTRAINED_ARRAY ;
-                                SFIFS        : IN FIRST_INDEX ;
-                                SFILS        : IN FIRST_INDEX ;
-                                SSIFS        : IN SECOND_INDEX ;
-                                SSILS        : IN SECOND_INDEX ;
-                                SFLEN        : IN NATURAL ;
-                                SSLEN        : IN NATURAL ;
-                                SFIRT        : IN FIRST_INDEX ;
-                                SSIRT        : IN SECOND_INDEX ;
-                                REMARKS      : IN STRING) IS
- 
-      BEGIN -- TEST_PROCEDURE
- 
-           IF (FIRST'FIRST /= FFIFS) OR
-              (FIRST'FIRST (1) /= FFIFS) OR
-              (FIRST'FIRST (2) /= FSIFS) OR
-              (SECOND'FIRST /= SFIFS) OR
-              (SECOND'FIRST (1) /= SFIFS) OR
-              (SECOND'FIRST (2) /= SSIFS) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
-           END IF ;
- 
-           IF (FIRST'LAST /= FFILS) OR
-              (FIRST'LAST (1) /= FFILS) OR
-              (FIRST'LAST (2) /= FSILS) OR
-              (SECOND'LAST /= SFILS) OR
-              (SECOND'LAST (1) /= SFILS) OR
-              (SECOND'LAST (2) /= SSILS) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
-           END IF ;
- 
-           IF (FIRST'LENGTH /= FFLEN) OR
-              (FIRST'LENGTH (1) /= FFLEN) OR
-              (FIRST'LENGTH (2) /= FSLEN) OR
-              (SECOND'LENGTH /= SFLEN) OR
-              (SECOND'LENGTH (1) /= SFLEN) OR
-              (SECOND'LENGTH (2) /= SSLEN) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
-           END IF ;
- 
-           IF (FFIRT NOT IN FIRST'RANGE (1)) OR
-              (FFIRT NOT IN FIRST'RANGE) OR
-              (SFIRT NOT IN SECOND'RANGE (1)) OR
-              (SFIRT NOT IN SECOND'RANGE) OR
-              (FSIRT NOT IN FIRST'RANGE (2)) OR
-              (SSIRT NOT IN SECOND'RANGE (2)) THEN
-                REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE " &
-                               "ATTRIBUTE.  " & REMARKS) ;
-           END IF ;
- 
-           -- ASSIGN VALUES TO THE ARRAY PARAMETER OF MODE OUT
-           FOR I IN SECOND'RANGE(1) LOOP
-                FOR J IN SECOND'RANGE(2) LOOP
-                     SECOND(I, J) := COMPONENT_VALUE;
-                END LOOP;
-           END LOOP;
- 
-      END TEST_PROCEDURE ;
- 
-      PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
-           FIRST_INDEX           => SHORT_RANGE,
-           SECOND_INDEX          => MEDIUM_RANGE,
-           COMPONENT_TYPE        => DATE,
-           UNCONSTRAINED_ARRAY   => FIRST_TEMPLATE,
-           COMPONENT_VALUE       => TODAY) ;
- 
-      PROCEDURE SECOND_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
-           FIRST_INDEX           => MONTH_TYPE,
-           SECOND_INDEX          => DAY_TYPE,
-           COMPONENT_TYPE        => SHORT_STRING,
-           UNCONSTRAINED_ARRAY   => SECOND_TEMPLATE,
-           COMPONENT_VALUE       => DEFAULT_STRING) ;
- 
-      PROCEDURE THIRD_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
-           FIRST_INDEX           => CHARACTER,
-           SECOND_INDEX          => BOOLEAN,
-           COMPONENT_TYPE        => DAY_TYPE,
-           UNCONSTRAINED_ARRAY   => THIRD_TEMPLATE,
-           COMPONENT_VALUE       => DAY_TYPE'FIRST) ;
- 
- 
- BEGIN  -- C36205L
- 
-       REPORT.TEST ( "C36205L","FOR GENERIC PROCEDURES, CHECK THAT " &
-                     "ATTRIBUTES GIVE THE CORRECT VALUES FOR " &
-                     "UNCONSTRAINED FORMAL PARAMETERS.  BASIC " &
-                     "CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS " &
-                     "PASSED AS PARAMETERS TO GENERIC PROCEDURES");
- 
-      FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
-                            FFIFS        => -10,
-                            FFILS        => 10,
-                            FSIFS        => 27,
-                            FSILS        => 35,
-                            FFLEN        => 21,
-                            FSLEN        => 9,
-                            FFIRT        => 0,
-                            FSIRT        => 29,
-                            SECOND       => FOURTH_ARRAY,
-                            SFIFS        => 0,
-                            SFILS        => 27,
-                            SSIFS        => 75,
-                            SSILS        => 100,
-                            SFLEN        => 28,
-                            SSLEN        => 26,
-                            SFIRT        => 5,
-                            SSIRT        => 100,
-                            REMARKS      => "FIRST_TEST_PROCEDURE") ;
- 
-      SECOND_TEST_PROCEDURE (FIRST        => SECOND_ARRAY,
-                             FFIFS        => JAN,
-                             FFILS        => JUN,
-                             FSIFS        => 1,
-                             FSILS        => 25,
-                             FFLEN        => 6,
-                             FSLEN        => 25,
-                             FFIRT        => MAR,
-                             FSIRT        => 17,
-                             SECOND       => FIFTH_ARRAY,
-                             SFIFS        => JUL,
-                             SFILS        => OCT,
-                             SSIFS        => 6,
-                             SSILS        => 10,
-                             SFLEN        => 4,
-                             SSLEN        => 5,
-                             SFIRT        => JUL,
-                             SSIRT        => 6,
-                             REMARKS      => "SECOND_TEST_PROCEDURE") ;
- 
-      THIRD_TEST_PROCEDURE (FIRST        => THIRD_ARRAY,
-                            FFIFS        => 'A',
-                            FFILS        => 'Z',
-                            FSIFS        => FALSE,
-                            FSILS        => TRUE,
-                            FFLEN        => 26,
-                            FSLEN        => 2,
-                            FFIRT        => 'T',
-                            FSIRT        => TRUE,
-                            SECOND       => SIXTH_ARRAY,
-                            SFIFS        => 'X',
-                            SFILS        => 'Z',
-                            SSIFS        => TRUE,
-                            SSILS        => TRUE,
-                            SFLEN        => 3,
-                            SSLEN        => 1,
-                            SFIRT        => 'Z',
-                            SSIRT        => TRUE,
-                            REMARKS      => "THIRD_TEST_PROCEDURE") ;
- 
-       REPORT.RESULT ;
- 
- END C36205L ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36301a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36301a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36301a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- C36301A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PREDEFINED POSITIVE AND STRING TYPES
- -- ARE CORRECTLY DEFINED.
- 
- -- DAT 2/17/81
- -- JBG 12/27/82
- -- RJW 1/20/86 - CHANGED 'NATURAL' TO 'POSITIVE'.  ADDED ADDITIONAL 
- --               CASES, INCLUDING A CHECK FOR STRINGS WITH BOUNDS
- --               OF INTEGER'FIRST AND INTEGER'LAST.
- -- EDS 7/16/98   AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C36301A IS
-      
- BEGIN
-      TEST ( "C36301A", "CHECK ATTRIBUTES OF PREDEFINED POSITIVE " &
-                        "AND STRING" );
- 
-      BEGIN
-           IF POSITIVE'FIRST /= 1 THEN
-                FAILED ( "POSITIVE'FIRST IS WRONG" );
-           END IF;
- 
-           IF POSITIVE'LAST /= INTEGER'LAST THEN
-                FAILED ( "POSITIVE'LAST IS WRONG" );
-           END IF;
-      END;
- 
-      DECLARE
- 
-           C : STRING (1..2) := ( 'A', 'B' );
- 
-      BEGIN
-           IF C'LENGTH /= 2  THEN
-                FAILED ( "LENGTH OF C IS WRONG" );
-           END IF;
- 
-           IF C'FIRST /= 1 THEN
-                FAILED ( "C'FIRST IS WRONG" );
-           END IF;
- 
-           IF C'LAST /= 2 THEN
-                FAILED ( "C'LAST IS WRONG" );
-           END IF;
-      END;
- 
-      DECLARE
- 
-           SUBTYPE LARGE IS STRING ( INTEGER'LAST - 3 .. INTEGER'LAST );
- 
-      BEGIN
-           IF LARGE'LENGTH /= 4  THEN
-                FAILED ( "LENGTH OF LARGE IS WRONG" );
-           END IF;
- 
-           IF LARGE'FIRST /= INTEGER'LAST - 3  THEN
-                FAILED ( "LARGE'FIRST IS WRONG" );
-           END IF;
- 
-           IF LARGE'LAST /= INTEGER'LAST THEN
-                FAILED ( "LARGE'LAST IS WRONG" );
-           END IF;
-      END;
- 
-      DECLARE
- 
-           SUBTYPE LARGER IS STRING ( 1 .. INTEGER'LAST );
- 
-      BEGIN
-           IF LARGER'LENGTH /= INTEGER'LAST THEN
-                FAILED ( "LENGTH OF LARGER IS WRONG" );
-           END IF;
- 
-           IF LARGER'FIRST /= 1 THEN
-                FAILED ( "LARGER'FIRST IS WRONG" );
-           END IF;
- 
-           IF LARGER'LAST /= INTEGER'LAST THEN
-                FAILED ( "LARGER'LAST IS WRONG" );
-           END IF;
-      END;
- 
-      BEGIN
-           DECLARE
- 
-                D : STRING ( INTEGER'FIRST .. INTEGER'FIRST + 3 );
- 
-           BEGIN
-                IF D'FIRST /= INTEGER'FIRST THEN   -- USE D
-                     FAILED ("D'FIRST IS INCORRECT " & INTEGER'IMAGE(D'FIRST));
-                END IF;
-                FAILED ( "NO EXCEPTION RAISED" );
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED" );
-      END;
- 
-      BEGIN
-           DECLARE
- 
-                E : STRING ( -1 .. INTEGER'FIRST );
-           
-           BEGIN
-                IF E'LENGTH /= 0 THEN
-                     FAILED ( "LENGTH OF E IS WRONG" );
-                END IF;
- 
-                IF E'FIRST /= -1 THEN
-                     FAILED ( "E'FIRST IS WRONG" );
-                END IF;
- 
-                IF E'LAST /= INTEGER'FIRST THEN
-                     FAILED ( "E'LAST IS WRONG" );
-                END IF;
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED FOR NULL STRING" );
-      END;
- 
-      RESULT;
- END C36301A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36301b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36301b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36301b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36301b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- C36301B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PREDEFINED STRING ATTRIBUTES ARE CORRECTLY IMPLEMENTED.
- 
- -- CASE B: STRING OF LENGTH INTEGER'LAST
- 
- -- DAT 2/17/81
- -- JBG 12/28/82
- 
- WITH REPORT;
- PROCEDURE C36301B IS
- 
-      USE REPORT;
- 
-      SUBTYPE STR2 IS STRING (1..INTEGER'LAST);
- 
- BEGIN
-      TEST("C36301B", "CHECK ATTRIBUTES OF LONGEST STRING");
- 
-      IF STR2'FIRST /= 1 THEN
-           FAILED ("STR'FIRST NOT 1");
-      END IF;
- 
-      IF STR2'LAST /= INTEGER'LAST THEN
-           FAILED ("STR'LAST NOT INTEGER'LAST");
-      END IF;
- 
-      IF STR2'LENGTH /= INTEGER'LAST THEN
-           FAILED ("'LENGTH NOT INTEGER'LAST");
-      END IF;
- 
-      RESULT;
- END C36301B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36302a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36302a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36302a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- C36302A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A STRING VARIABLE MAY BE DECLARED WITH AN INDEX
- -- STARTING WITH AN INTEGER GREATER THAN 1.
- 
- -- DAT 2/17/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C36302A IS
- 
-      USE REPORT;
- 
-      S5 : STRING (5 .. 10);
-      SX : STRING (INTEGER'LAST - 5 .. INTEGER'LAST);
- 
- BEGIN
-      TEST ("C36302A", "STRING VARIABLE INDICES NEEDN'T START AT 1");
- 
-      IF S5'FIRST /= 5
-      OR S5'LAST /= 10
-      OR S5'LENGTH /= 6
-      OR SX'FIRST /= INTEGER'LAST - 5
-      OR SX'LAST /= INTEGER'LAST
-      OR SX'LENGTH /= 6
-      THEN
-           FAILED ("WRONG STRING ATTRIBUTES");
-      END IF;
- 
-      RESULT;
- END C36302A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36304a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36304a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36304a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C36304A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT BOUNDS OF CONSTANT STRING OBJECTS IF NOT GIVEN IN
- -- THE DECLARATIONS ARE DETERMINED BY THE STRINGS' INITIAL VALUES.
- 
- -- DAT 2/17/81
- -- JBG 8/21/83
- 
- WITH REPORT;
- PROCEDURE C36304A IS
- 
-      USE REPORT;
- 
-      I3 : INTEGER := IDENT_INT (3);
- 
-      S3 : CONSTANT STRING := "ABC";
-      S0 : CONSTANT STRING := "";
-      S1 : CONSTANT STRING := "A";
-      S2 : CONSTANT STRING := "AB";
-      S5 : CONSTANT STRING := "ABCDE";
-      S3A : CONSTANT STRING (I3 .. I3 + 2) := S3(I3 - 2 .. I3);
-      S3C : CONSTANT STRING := S3A;
-      S3D : CONSTANT STRING := S3C & "";
-      S3E : CONSTANT STRING := S3D;
-      X3 : CONSTANT STRING := (I3 .. 5 => 'X');
-      Y3 : CONSTANT STRING := X3;
-      Z0 : CONSTANT STRING := (-3..-5 => 'A');
- 
-      PROCEDURE C (S : STRING; 
-                   FIRST, LAST, LENGTH : INTEGER; 
-                   ID : STRING) IS
-      BEGIN
-           IF S'FIRST /= FIRST THEN
-                FAILED ("'FIRST IS " & INTEGER'IMAGE(S'FIRST) &
-                        " INSTEAD OF " & INTEGER'IMAGE(FIRST) &
-                        " FOR " & ID);
-           END IF;
- 
-           IF S'LAST /= LAST THEN
-                FAILED ("'LAST IS " & INTEGER'IMAGE(S'LAST) &
-                        " INSTEAD OF " & INTEGER'IMAGE(LAST) &
-                        " FOR " & ID);
-           END IF;
- 
-           IF S'LENGTH /= LENGTH THEN
-                FAILED ("'LENGTH IS " & INTEGER'IMAGE(S'LENGTH) &
-                        " INSTEAD OF " & INTEGER'IMAGE(LENGTH) &
-                        " FOR " & ID);
-           END IF;
-      END C;
- 
- BEGIN
-      TEST ("C36304A", "CHECK UNUSUAL CONSTANT STRING BOUNDS");
- 
- 
-      C(S0, 1, 0, 0, "S0");
-      C(S1, 1, 1, 1, "S1");
-      C(S2, 1, 2, 2, "S2");
-      C(S5, 1, 5, 5, "S5");
-      C(S3, 1, 3, 3, "S3");
-      C(S3C, 3, 5, 3, "S3C");
-      C(S3D, 3, 5, 3, "S3D");
-      C(S3E, 3, 5, 3, "S3E");
-      C(X3, 3, 5, 3, "X3");
-      C(Y3, 3, 5, 3, "Y3");
-      C(Z0, IDENT_INT(-3), IDENT_INT(-5), IDENT_INT(0), "Z0");
- 
-      RESULT;
- END C36304A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36305a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c36305a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c36305a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C36305A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A STRING VARIABLE IS CONSIDERED AN ARRAY.
- 
- -- DAT 2/17/81
- -- SPS 10/25/82
- -- EDS 07/16/98    AVOID OPTIMIZATION
- 
- WITH REPORT;
- PROCEDURE C36305A IS
- 
-      USE REPORT;
- 
-      S : STRING (IDENT_INT(5) .. IDENT_INT (10));
-      T : STRING (S'RANGE);
-      U : STRING (T'FIRST .. T'LAST);
-      SUBTYPE I_5 IS INTEGER RANGE U'RANGE(1);
-      I5 : I_5;
-      C : CONSTANT STRING := "ABCDEF";
- 
- BEGIN
-      TEST ("C36305A", "CHECK THAT STRINGS ARE REALLY ARRAYS");
- 
-      IF S'FIRST /= 5
-      OR S'LAST /= 10
-      OR S'LENGTH /= 6
-      OR U'FIRST(1) /= 5
-      OR U'LAST(1) /= 10
-      OR U'LENGTH(1) /= 6
-      THEN
-           FAILED ("INCORRECT STRING ATTRIBUTE VALUES");
-      END IF;
- 
-      IF 4 IN U'RANGE
-      OR 3 IN U'RANGE(1)
-      OR 0 IN U'RANGE
-      OR 1 IN U'RANGE
-      OR 5 NOT IN U'RANGE
-      OR 7 NOT IN U'RANGE
-      OR 10 NOT IN U'RANGE
-      OR NOT (11 NOT IN U'RANGE)
-      THEN
-           FAILED ("INCORRECT STRING RANGE ATTRIBUTE");
-      END IF;
- 
-      BEGIN
-           BEGIN
-                BEGIN
-                     I5 := 4;
-                     FAILED ("BAD I5 SUBRANGE 1 " & INTEGER'IMAGE(I5)); --use I5
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR => NULL;
-                END;
-                I5 := INTEGER'(11);
-                FAILED ("BAD I5 SUBRANGE 2 " & INTEGER'IMAGE(I5)); --use I5
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
-           END;
-           I5 := INTEGER'(5);
-           I5 := I5 + I5;
-           I5 := NATURAL'(8);
-      EXCEPTION
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
-      END;
- 
-      FOR I IN S'RANGE LOOP
-           S(I) :=  C(11 - I);
-      END LOOP;
-      T := S;
-      FOR I IN REVERSE U'RANGE LOOP
-           U(I) := T(15 - I);
-      END LOOP;
- 
-      FOR I IN 1 .. C'LENGTH LOOP
-           IF C(1 .. I) /= U(5 .. I + 4)
-           OR U(I + 4 .. U'LAST) /= C(I .. C'LAST)
-           OR C(I) /= U (I + 4)
-           OR C(I .. I)(I .. I)(I) /= U(U'RANGE)(I + 4) THEN
-                FAILED ("INCORRECT CHARACTER MISMATCH IN STRING");
-                EXIT;
-           END IF;
-      END LOOP;
- 
-      IF U /= C
-      OR U /= "ABCDEF"
-      OR U(U'RANGE) /= C(C'RANGE)
-      OR U(5 .. 10) /= C(1 .. 6)
-      OR U(5 .. 6) /= C(1 .. 2)
-      THEN
-           FAILED ("STRINGS AS ARRAYS BEHAVE INCORRECTLY");
-      END IF;
- 
-      RESULT;
- END C36305A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37002a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C37002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INDEX CONSTRAINTS WITH NON-STATIC EXPRESSIONS CAN BE
- -- USED TO CONSTRAIN RECORD COMPONENTS HAVING AN ARRAY TYPE.
- 
- -- RJW 2/28/86 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C37002A IS
- 
- BEGIN
-      TEST ( "C37002A", "CHECK THAT INDEX CONSTRAINTS WITH " &
-                        "NON-STATIC EXPRESSIONS CAN BE USED TO " &
-                        "CONSTRAIN RECORD COMPONENTS HAVING AN " &
-                        "ARRAY TYPE" );
- 
-      DECLARE
-           X : INTEGER := IDENT_INT(5);
-           SUBTYPE S IS INTEGER RANGE 1 .. X;
-           TYPE AR1 IS ARRAY (S) OF INTEGER;
- 
-           SUBTYPE T IS INTEGER RANGE X .. 10;
-           TYPE AR2 IS ARRAY (T) OF INTEGER;
-           TYPE U IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           SUBTYPE V IS INTEGER RANGE 1 .. 10;     
- 
-           TYPE R IS 
-                RECORD
-                     A : STRING (1 .. X);              
-                     B : STRING (X .. 10);             
-                     C : AR1;                          
-                     D : AR2;                          
-                     E : STRING (S);
-                     F : U(T);
-                     G : U(V RANGE 1 ..X);
-                     H : STRING (POSITIVE RANGE X .. 10);
-                     I : U(AR1'RANGE);
-                     J : STRING (AR2'RANGE);
-                END RECORD;
-           RR : R;
-  
-      BEGIN
-           IF RR.A'LAST /= 5 OR RR.B'FIRST /= 5 OR
-              RR.C'LAST /= 5 OR RR.D'FIRST /= 5 OR
-              RR.E'LAST /= 5 OR RR.F'FIRST /= 5 OR
-              RR.G'LAST /= 5 OR RR.H'FIRST /= 5 OR
-              RR.I'LAST /= 5 OR RR.J'FIRST /= 5 THEN 
-           
-                   FAILED("WRONG VALUE FOR NON-STATIC BOUND");
- 
-            END IF;
-           
-      END;
- 
-      RESULT;
- END C37002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37003a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- C37003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT MULTIPLE COMPONENT DECLARATIONS ARE TREATED AS A SERIES
- -- OF SINGLE COMNENT DECLARATIONS, I.E., THE COMPONENTS ALL HAVE THE
- -- SAME TYPE AND ANY EXPRESSION USED IN CONSTRAINTS OR INITIALIZATIONS
- -- IS EVALUATED ONCE FOR EACH COMPONENT.
- 
- -- DAT 3/30/81
- -- SPS 10/26/82
- -- JWC 10/23/85  RENAMED FROM C37013A-AB.ADA.
- --               ADDED TEST TO ENSURE THAT ANY EXPRESSION USED
- --               IN A CONSTRAINT IS EVALUATED ONCE FOR EACH
- --               COMPONENT.
- -- JRK 11/15/85  ADDED INITIALIZATION EVALUATION CHECKS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C37003A IS
- 
-      X : INTEGER := 0;
- 
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           X := X + 1;
-           RETURN X;
-      END F;
- 
-      PROCEDURE RESET IS
-      BEGIN
-           X := 0;
-      END RESET;
- 
- BEGIN
-      TEST ("C37003A", "CHECK THAT MULTIPLE COMPONENT DECLARATIONS " &
-                       "ARE TREATED AS A SERIES OF SINGLE COMPONENT " &
-                       "DECLARATIONS");
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
- 
-           TYPE REC1 IS RECORD
-                A1, A2 : ARR (1 .. F) := (OTHERS => F);
-           END RECORD;
- 
-           R1 : REC1 := (OTHERS => (OTHERS => 1));
-           Y : INTEGER := X;
-           R1A : REC1;
- 
-      BEGIN
- 
-           IF R1.A1 = R1.A2 THEN        -- TEST TO SEE IF THE COMPONENTS
-                NULL;                   -- ARE OF THE SAME TYPE.
-           END IF;
- 
-           IF Y /= 2 THEN
-                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
-                        "FOR ARRAYS");
-           END IF;
- 
-           IF X /= 5 THEN
-                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
-                        "EACH ARRAY COMPONENT");
-           END IF;
- 
-           RESET;
- 
-      END;
- 
-      DECLARE
- 
-           TYPE REC2 IS RECORD
-                I1, I2 : INTEGER RANGE 1 .. F := F * IDENT_INT(0) + 1;
-           END RECORD;
- 
-           R2 : REC2 := (OTHERS => 1);
-           Y : INTEGER := X;
-           R2A : REC2;
- 
-      BEGIN
- 
-           IF R2.I1 = R2.I2 THEN        -- TEST TO SEE IF THE COMPONENTS
-                NULL;                   -- ARE OF THE SAME TYPE.
-           END IF;
- 
-           IF Y /= 2 THEN
-                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
-                        "FOR SCALARS");
-           END IF;
- 
-           IF X /= 4 THEN
-                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
-                        "EACH SCALAR COMPONENT");
-           END IF;
- 
-           RESET;
- 
-      END;
- 
-      DECLARE
- 
-           TYPE REC3X (DSC : INTEGER) IS RECORD
-                NULL;
-           END RECORD;
- 
-           TYPE REC3Y IS RECORD
-                I : INTEGER;
-           END RECORD;
- 
-           TYPE REC3 IS RECORD
-                RX1, RX2 : REC3X (F);
-                RY1, RY2 : REC3Y := (I => F);
-           END RECORD;
- 
-           R3 : REC3 := ((DSC => 1), (DSC => 2), (I => 0), (I => 0));
-           Y : INTEGER := X;
-           R3A : REC3;
- 
-      BEGIN
- 
-           IF R3.RX1 = R3.RX2 THEN       -- TEST TO SEE IF THE COMPONENTS
-                NULL;                    -- ARE OF THE SAME TYPE.
-           END IF;
- 
-           IF Y /= 2 THEN
-                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
-                        "FOR RECORDS");
-           END IF;
- 
-           IF X /= 4 THEN
-                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
-                        "FOR EACH RECORD COMPONENT");
-           END IF;
- 
-           RESET;
- 
-      END;
- 
-      DECLARE
- 
-           TYPE REC4X (DSC : INTEGER) IS RECORD
-                NULL;
-           END RECORD;
- 
-           TYPE ACR IS ACCESS REC4X;
-           TYPE ACI IS ACCESS INTEGER;
- 
-           TYPE REC4 IS RECORD
-                AC1, AC2 : ACR (F);
-                AC3, AC4 : ACI := NEW INTEGER'(F);
-           END RECORD;
- 
-           R4 : REC4 := (NULL, NULL, NULL, NULL);
-           Y : INTEGER := X;
-           R4A : REC4;
- 
-      BEGIN
- 
-           IF R4.AC1 = R4.AC2 THEN       -- TEST TO SEE IF THE COMPONENTS
-                NULL;                    -- ARE OF THE SAME TYPE.
-           END IF;
- 
-           IF Y /= 2 THEN
-                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
-                        "FOR ACCESS");
-           END IF;
- 
-           IF X /= 4 THEN
-                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
-                        "FOR EACH ACCESS COMPONENT");
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C37003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37003b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37003b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37003b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- C37003B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR A RECORD WITH MULTIPLE DISCRIMINANTS WHICH HAVE
- --     DEFAULT EXPRESSIONS, THE EXPRESSIONS ARE EVALUATED ONCE FOR
- --     EACH DISCRIMINANT IN THE ASSOCIATION.
- 
- -- HISTORY:
- --     DHH 08/04/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37003B IS
- 
-      X : INTEGER := 0;
- 
-      FUNCTION F1 RETURN INTEGER IS
-      BEGIN
-           X := X + 1;
-           RETURN X;
-      END F1;
- 
- BEGIN
-      TEST("C37003B", "CHECK THAT FOR A RECORD WITH MULTIPLE " &
-                      "DISCRIMINANTS WHICH HAVE DEFAULT EXPRESSIONS, " &
-                      "THE  EXPRESSIONS ARE EVALUATED ONCE FOR EACH " &
-                      "DISCRIMINANT IN THE ASSOCIATION");
- 
-      DECLARE
-           TYPE REC(D1, D2, D3, D4, D5 : INTEGER := F1) IS
-                RECORD
-                     Y : INTEGER := (D1 + D2 + D3 + D4 + D5);
-                END RECORD;
- 
-           REC_F1 : REC;
- 
-      BEGIN
-           IF REC_F1.Y /= IDENT_INT(15) THEN
-                FAILED("MULTIPLE DISCRIMINANTS NOT EVALUATED " &
-                       "SEPARATELY");
-           END IF;
-      END;
- 
-      RESULT;
- END C37003B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37005a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C37005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SCALAR RECORD COMPONENTS MAY HAVE NON-STATIC
- -- RANGE CONSTRAINTS OR DEFAULT INITIAL VALUES.
- 
- -- DAT 3/6/81
- -- JWC 6/28/85   RENAMED TO -AB
- -- EDS 7/16/98   AVOID OPTIMIZATION
- 
- WITH REPORT;
- PROCEDURE C37005A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C37005A", "SCALAR RECORD COMPONENTS MAY HAVE NON-STATIC"
-                     & " RANGE CONSTRAINTS OR DEFAULT INITIAL VALUES");
- 
-      DECLARE
-           SUBTYPE DT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (5);
-           L : INTEGER := IDENT_INT (DT'FIRST);
-           R : INTEGER := IDENT_INT (DT'LAST);
-           SUBTYPE DT2 IS INTEGER RANGE L .. R;
-           M : INTEGER := (L + R) / 2;
- 
-           TYPE REC IS
-                RECORD
-                     C1 : INTEGER := M;
-                     C2 : DT2 := (L + R) / 2;
-                     C3 : BOOLEAN RANGE (L < M) .. (R > M)
-                          := IDENT_BOOL (TRUE);
-                     C4 : INTEGER RANGE L .. R := DT'FIRST;
-                END RECORD;
- 
-           R1, R2 : REC := ((L+R)/2, M, M IN DT, L);
-           R3 : REC;
-      BEGIN
-           IF R3 /= R1
-           THEN
-                FAILED ("INCORRECT RECORD VALUES");
-           END IF;
- 
-           R3 := (R2.C2, R2.C1, R3.C3, R);  -- CONSTRAINTS CHECKED BY :=
-           IF EQUAL(IDENT_INT(1), 2) THEN
-                FAILED("IMPOSSIBLE " & INTEGER'IMAGE(R3.C1));  --USE R3
-           END IF;
- 
-           BEGIN
-                R3 := (M, M, IDENT_BOOL (FALSE), M); -- RAISES CON_ERR.
-                FAILED ("CONSTRAINT ERROR NOT RAISED " & INTEGER'IMAGE(R3.C1));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION");
-           END;
- 
-           FOR I IN DT LOOP
-                R3 := (I, I, I /= 100, I);
-                R1.C2 := I;
-                IF EQUAL(IDENT_INT(1), 2) THEN
-                     FAILED("IMPOSSIBLE " & 
-                            INTEGER'IMAGE(R3.C1 + R1.C2));  --USE R3, R1
-                END IF;
-           END LOOP;
- 
-      EXCEPTION
-           WHEN OTHERS => FAILED ("INVALID EXCEPTION");
-      END;
- 
-      RESULT;
- END C37005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37006a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,272 ****
- -- C37006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A COMPONENT OF A RECORD, ACCESS, OR PRIVATE TYPE, OR FOR A 
- -- LIMITED PRIVATE COMPONENT, CHECK THAT A NON-STATIC EXPRESSION CAN 
- -- BE USED IN A DISCRIMINANT CONSTRAINT OR (EXCEPTING LIMITED PRIVATE 
- -- COMPONENTS) IN SPECIFYING A DEFAULT INITIAL VALUE.
-  
- -- R.WILLIAMS 8/28/86
-  
- WITH REPORT; USE REPORT;
- PROCEDURE C37006A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0 .. 100;
- 
-      TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
- 
-      TYPE REC1 (D1, D2 : INT) IS
-           RECORD
-                A : ARR (D1 .. D2);
-           END RECORD;
- 
-      TYPE REC1_NAME IS ACCESS REC1;
-  
-      PROCEDURE CHECK (AR : ARR; STR : STRING) IS
-      BEGIN
-           IF AR'FIRST /= 1 OR AR'LAST /= 2 THEN
-                FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN COMPONENT " &
-                         "OF " & STR & " TYPE");
-           ELSIF AR /= (3, 4) THEN
-                FAILED ( "INITIALIZATION OF R.COMP.A IN COMPONENT OF " &
-                          STR & " TYPE FAILED" );
-           END IF;
-      END CHECK;
-           
-      PACKAGE PACK IS
-           TYPE PRIV (D1, D2 : INT) IS PRIVATE;
-           TYPE LIM (D1, D2 : INT) IS LIMITED PRIVATE;
-           FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV;
-           PROCEDURE PRIV_CHECK (R : PRIV);
-           PROCEDURE LIM_CHECK (R : LIM);
- 
-      PRIVATE
-           TYPE PRIV (D1, D2 : INT) IS
-                RECORD
-                     A : ARR (D1 .. D2);
-                END RECORD;
- 
-           TYPE LIM (D1, D2 : INT) IS
-                RECORD
-                     A : ARR (D1 .. D2);
-                END RECORD;
-      END PACK;
- 
-      PACKAGE BODY PACK IS
- 
-           FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV IS
-           BEGIN
-                RETURN (IDENT_INT (1), IDENT_INT (2),
-                        ARR'(1 => 3, 2 => 4));
-           END PRIV_FUN;
-           
-           PROCEDURE PRIV_CHECK (R : PRIV) IS
-           BEGIN
-                CHECK (R.A, "PRIVATE TYPE" );
-           END PRIV_CHECK;
- 
-           PROCEDURE LIM_CHECK (R : LIM) IS
-           BEGIN
-                IF R.A'FIRST /= 1 OR R.A'LAST /= 2 THEN
-                     FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN " &
-                              "COMPONENT OF LIMITED PRIVATE TYPE");
-                END IF;
-           END LIM_CHECK;
-      END PACK;
-  
-      USE PACK;
- 
- BEGIN
-      
-      TEST ( "C37006A", "FOR A COMPONENT OF A RECORD, ACCESS, " &
-                        "OR PRIVATE TYPE, OR FOR A LIMITED PRIVATE " &
-                        "COMPONENT, CHECK THAT A NON-STATIC " &
-                        "EXPRESSION CAN BE USED IN A DISCRIMINANT " &
-                        "CONSTRAINT OR (EXCEPTING LIMITED PRIVATE " &
-                        "COMPONENTS) IN SPECIFYING A DEFAULT " &
-                        "INITIAL VALUE" );
-  
-      BEGIN
-           DECLARE
-           
-                TYPE REC2 IS
-                     RECORD
-                          COMP : REC1 (IDENT_INT (1), IDENT_INT (2)) := 
-                                 (IDENT_INT (1), IDENT_INT (2), 
-                                  ARR'(1 => 3, 2 => 4));
-                     END RECORD;
-  
-           R : REC2;
- 
-           BEGIN
-                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
-                     CHECK (R.COMP.A, "RECORD");
-                ELSE 
-                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
-                              "OF RECORD TYPE COMPONENT" );
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              "RECORD TYPE COMPONENT" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              "RECORD TYPE COMPONENT" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
-                         "OF RECORD TYPE COMPONENT" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
-                         "OF RECORD TYPE COMPONENT" );
-      END;
-  
-      BEGIN
-           DECLARE
-           
-                TYPE REC2 IS
-                     RECORD
-                          COMP : REC1_NAME (IDENT_INT (1), 
-                                            IDENT_INT (2)) := 
-                                 NEW REC1'(IDENT_INT (1), 
-                                           IDENT_INT (2), 
-                                           ARR'(1 => 3, 2 => 4));
-                     END RECORD;
-  
-           R : REC2;
- 
-           BEGIN
-                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
-                     CHECK (R.COMP.A, "ACCESS");
-                ELSE 
-                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
-                              "OF ACCESS TYPE COMPONENT" );
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              "ACCESS TYPE COMPONENT" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              "ACCESS TYPE COMPONENT" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
-                         "OF ACCESS TYPE COMPONENT" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
-                         "OF ACCESS TYPE COMPONENT" );
-      END;
-  
-      BEGIN
-           DECLARE
-           
-                TYPE REC2 IS
-                     RECORD
-                          COMP : PRIV (IDENT_INT (1), IDENT_INT (2)) := 
-                                 PRIV_FUN (IDENT_INT (1), 
-                                           IDENT_INT (2));
-                     END RECORD;
-  
-           R : REC2;
- 
-           BEGIN
-                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
-                     PRIV_CHECK (R.COMP);
-                ELSE 
-                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
-                              "OF PRIVATE TYPE COMPONENT" );
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              "PRIVATE TYPE COMPONENT" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              "PRIVATE TYPE COMPONENT" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
-                         "OF PRIVATE TYPE COMPONENT" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
-                         "OF PRIVATE TYPE COMPONENT" );
-      END;
-  
-      BEGIN
-           DECLARE
-           
-                TYPE REC2 IS
-                     RECORD
-                          COMP : LIM (IDENT_INT (1), IDENT_INT (2));
-                     END RECORD;
- 
-           R : REC2;
- 
-           BEGIN
-                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
-                     LIM_CHECK (R.COMP);
-                ELSE
-                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
-                              "OF LIM PRIV TYPE COMPONENT" );
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              " LIM PRIV TYPE COMPONENT" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
-                              "SEQUENCE FOLLOWING DECLARATION OF " &
-                              " LIM PRIV TYPE COMPONENT" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
-                         "OF  LIM PRIV TYPE COMPONENT" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
-                         "OF  LIM PRIV TYPE COMPONENT" );
-      END;
-  
-      RESULT;
-  
- END C37006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37008a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,270 ****
- -- C37008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SPECIFYING AN INVALID DEFAULT INITIALIZATION
- -- RAISES CONSTRAINT_ERROR WHEN AN OBJECT IS DECLARED.
- 
- -- DAT 3/6/81
- -- SPS 10/26/82
- -- RJW 1/9/86 -  REVISED COMMENTS. ADDED 'IDENT_INT'.
- -- EDS 7/22/98   AVOID OPTIMIZATION
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C37008A IS
- BEGIN
-      TEST ("C37008A", "CHECK THAT INVALID DEFAULT RECORD"
-                     & " COMPONENT INITIALIZATIONS RAISE"
-                     & " CONSTRAINT_ERROR");
- 
-      BEGIN
-           DECLARE
-                TYPE R1 IS RECORD
-                     C1 : INTEGER RANGE 1 .. 5 := IDENT_INT (0);
-                END RECORD;
-                REC1 : R1;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 1 " & INTEGER'IMAGE(REC1.C1));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE R IS RECORD
-                     C : CHARACTER RANGE 'A' .. 'Y' := 'Z';
-                END RECORD;
-                REC2 : R;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 1A " & (REC2.C));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1A");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE R2 IS RECORD
-                     C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE;
-                END RECORD;
-                REC3 : R2;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 2 " & BOOLEAN'IMAGE(REC3.C2));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE E IS (E1, E2, E3);
-                TYPE R IS RECORD
-                     C : E RANGE E2 .. E3 := E1;
-                END RECORD;
-                REC4 : R;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 2A " & E'IMAGE(REC4.C));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2A");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE R3 IS RECORD
-                     C3 : INTEGER RANGE 1 .. 5;
-                END RECORD;
-                REC5 : R3;
-                TYPE R3A IS RECORD
-                     C3A : R3 := (OTHERS => IDENT_INT (6));
-                END RECORD;
-                REC6 : R3A;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 3 " & 
-                        INTEGER'IMAGE(REC6.C3A.C3));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 3");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9;
-                TYPE R4 IS RECORD
-                     C4 : ARR
-                          := (1 => 8, 2 => 9, 3 => 10);
-                END RECORD;
-                REC7 : R4;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 4 " & 
-                        INTEGER'IMAGE(REC7.C4(1)));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 4");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. 5;
- 
-                TYPE AA IS ACCESS A;
- 
-                TYPE R5 IS RECORD
-                     C5 : AA := NEW A' (4, 5, 6);
-                END RECORD;
-                REC8 : R5;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 5 " & 
-                        INTEGER'IMAGE(REC8.C5(1)));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 5");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. 5;
- 
-                TYPE AA IS ACCESS A (1 .. 3);
- 
-                TYPE R6 IS RECORD
-                     C6 : AA := NEW A' (4, 4, 4, 4);
-                END RECORD;
-                REC9 : R6;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 6 " & 
-                        INTEGER'IMAGE(REC9.C6(1)));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 6");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE AI IS ACCESS INTEGER RANGE 6 .. 8;
- 
-                TYPE R7 IS RECORD
-                     C7 : AI := NEW INTEGER' (5);
-                END RECORD;
-                REC10 : R7;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 7 " & 
-                        INTEGER'IMAGE(REC10.C7.ALL));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 7");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE UA IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 3 .. 5;
- 
-                SUBTYPE CA IS UA (7 .. 8);
- 
-                TYPE R8 IS RECORD
-                     C8 : CA := (6 .. 8 => 4);
-                END RECORD;
-                REC11 : R8;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 8 " & 
-                        INTEGER'IMAGE(REC11.C8(7)));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 8");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE UA IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 3 .. IDENT_INT(5);
- 
-                TYPE R9 IS RECORD
-                     C9 : UA (11 .. 11) := (11 => 6);
-                END RECORD;
-                REC12 : R9;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 9 " & 
-                        INTEGER'IMAGE(REC12.C9(11)));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 9");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. IDENT_INT (5);
- 
-                TYPE AA IS ACCESS A;
- 
-                TYPE R10 IS RECORD
-                     C10 : AA := NEW A '(4, 5, 6);
-                END RECORD;
-                REC13 : R10;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 10 " & 
-                        INTEGER'IMAGE(REC13.C10(1)));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. 5;
- 
-                TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3));
- 
-                TYPE R11 IS RECORD
-                     C11 : AA := NEW A '(4, 4, 4, 4);
-                END RECORD;
-                REC14 : R11;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED 11 " & 
-                        INTEGER'IMAGE(REC14.C11(1)));
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 11");
-      END;
- 
-      RESULT;
- END C37008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37008b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37008b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37008b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,232 ****
- -- C37008B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NO CONSTRAINT ERROR IS RAISED FOR AN UNUSED TYPE
- -- DECLARATION WITH AN INVALID DEFAULT VALUE
- 
- -- JBG 9/11/81
- -- SPS 10/25/82
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C37008B IS
- BEGIN
-      TEST ("C37008B", "CHECK THAT INVALID DEFAULT RECORD"
-                     & " COMPONENT INITIALIZATIONS DO NOT RAISE"
-                     & " CONSTRAINT_ERROR");
- 
-      BEGIN
-           DECLARE
-                TYPE R1 IS RECORD
-                     C1 : INTEGER RANGE 1 .. 5 := 0;
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE R IS RECORD
-                     C : CHARACTER RANGE 'A' .. 'Y' := 'Z';
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1A");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE R2 IS RECORD
-                     C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE;
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 2");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE E IS (E1, E2, E3);
-                TYPE R IS RECORD
-                     C : E RANGE E2 .. E3 := E1;
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 2A");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE R3 IS RECORD
-                     C3 : INTEGER RANGE 1 .. 5;
-                END RECORD;
-                TYPE R3A IS RECORD
-                     C3A : R3 := (OTHERS => 6);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9;
-                TYPE R4 IS RECORD
-                     C4 : ARR
-                          := (1 => 8, 2 => 9, 3 => 10);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 4");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. 5;
- 
-                TYPE AA IS ACCESS A;
- 
-                TYPE R5 IS RECORD
-                     C5 : AA := NEW A'(4, 5, 6);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 5");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. 5;
- 
-                TYPE AA IS ACCESS A (1 .. 3);
- 
-                TYPE R6 IS RECORD
-                     C6 : AA := NEW A'(4, 4, 4, 4);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 6");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE AI IS ACCESS INTEGER RANGE 6 .. 8;
- 
-                TYPE R7 IS RECORD
-                     C7 : AI := NEW INTEGER'(5);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE UA IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 3 .. 5;
- 
-                SUBTYPE CA IS UA (7 .. 8);
- 
-                TYPE R8 IS RECORD
-                     C8 : CA := (6 .. 8 => 4);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE UA IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 3 .. IDENT_INT(5);
- 
-                TYPE R9 IS RECORD
-                     C9 : UA (11 .. 11) := (11 => 6);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. IDENT_INT (5);
- 
-                TYPE AA IS ACCESS A;
- 
-                TYPE R10 IS RECORD
-                     C10 : AA := NEW A'(4, 5, 6);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE A IS ARRAY (NATURAL RANGE <> )
-                     OF INTEGER RANGE 1 .. 5;
- 
-                TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3));
- 
-                TYPE R11 IS RECORD
-                     C11 : AA := NEW A'(4, 4, 4, 4);
-                END RECORD;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED 11");
-      END;
- 
-      RESULT;
- END C37008B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37009a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C37009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN UNCONSTRAINED RECORD TYPE CAN BE USED TO DECLARE A
- --     RECORD COMPONENT THAT CAN BE INITIALIZED WITH AN APPROPRIATE
- --     EXPLICIT OR DEFAULT VALUE.
- 
- -- HISTORY:
- --     DHH 02/01/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C37009A IS
- 
-      TYPE FLOAT IS DIGITS 5;
-      TYPE COLOR IS (RED, YELLOW, BLUE);
- 
-      TYPE COMPONENT IS
-           RECORD
-                I : INTEGER := 1;
-                X : FLOAT := 3.5;
-                BOL : BOOLEAN := FALSE;
-                FIRST : COLOR := RED;
-           END RECORD;
-      TYPE COMP_DIS(A : INTEGER := 1) IS
-           RECORD
-                I : INTEGER := 1;
-                X : FLOAT := 3.5;
-                BOL : BOOLEAN := FALSE;
-                FIRST : COLOR := RED;
-           END RECORD;
-      SUBTYPE SMAL_INTEGER IS INTEGER RANGE 1 .. 10;
-      TYPE LIST IS ARRAY(INTEGER RANGE <>) OF FLOAT;
- 
-      TYPE DISCRIM(P : SMAL_INTEGER := 2) IS
-           RECORD
-                A : LIST(1 .. P) := (1 .. P => 1.25);
-           END RECORD;
- 
-      TYPE REC_T IS                                     -- EXPLICIT INIT.
-           RECORD
-                T : COMPONENT := (5, 6.0, TRUE, YELLOW);
-                U : DISCRIM(3) := (3, (1 .. 3 => 2.25));
-                L : COMP_DIS(5) := (A => 5, I => 5, X => 6.0,
-                                       BOL =>TRUE, FIRST => YELLOW);
-           END RECORD;
- 
-      TYPE REC_DEF_T IS                                 -- DEFAULT INIT.
-           RECORD
-                T : COMPONENT;
-                U : DISCRIM;
-                L : COMP_DIS;
-           END RECORD;
- 
-      REC : REC_T;
-      REC_DEF : REC_DEF_T;
- 
-      FUNCTION IDENT_FLT(X : FLOAT) RETURN FLOAT IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN X;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT_FLT;
- 
-      FUNCTION IDENT_ENUM(X : COLOR) RETURN COLOR IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN X;
-           ELSE
-                RETURN BLUE;
-           END IF;
-      END IDENT_ENUM;
- 
- BEGIN
-      TEST("C37009A", "CHECK THAT AN UNCONSTRAINED RECORD TYPE CAN " &
-                      "BE USED TO DECLARE A RECORD COMPONENT THAT " &
-                      "CAN BE INITIALIZED WITH AN APPROPRIATE " &
-                      "EXPLICIT OR DEFAULT VALUE");
- 
-      IF REC_DEF.T.I /= IDENT_INT(1) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF INTEGER");
-      END IF;
- 
-      IF IDENT_BOOL(REC_DEF.T.BOL) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF BOOLEAN");
-      END IF;
- 
-      IF REC_DEF.T.X /= IDENT_FLT(3.5) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF REAL");
-      END IF;
- 
-      IF REC_DEF.T.FIRST /= IDENT_ENUM(RED) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF ENUMERATION");
-      END IF;
- 
-      FOR I IN 1 .. 2 LOOP
-           IF REC_DEF.U.A(I) /= IDENT_FLT(1.25) THEN
-                FAILED("INCORRECT DEFAULT INITIALIZATION OF ARRAY " &
-                       "POSITION " & INTEGER'IMAGE(I));
-           END IF;
-      END LOOP;
- 
-      IF REC_DEF.L.A /= IDENT_INT(1) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF DISCRIMINANT " &
-                  "- L");
-      END IF;
- 
-      IF REC_DEF.L.I /= IDENT_INT(1) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF INTEGER - L");
-      END IF;
- 
-      IF IDENT_BOOL(REC_DEF.L.BOL) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF BOOLEAN - L");
-      END IF;
- 
-      IF REC_DEF.L.X /= IDENT_FLT(3.5) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF REAL - L");
-      END IF;
- 
-      IF REC_DEF.L.FIRST /= IDENT_ENUM(RED) THEN
-           FAILED("INCORRECT DEFAULT INITIALIZATION OF ENUMERATION - L");
-      END IF;
- --------------------------------------------------------------------
-      IF REC.T.I /= IDENT_INT(5) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF INTEGER");
-      END IF;
- 
-      IF NOT IDENT_BOOL(REC.T.BOL) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF BOOLEAN");
-      END IF;
- 
-      IF REC.T.X /= IDENT_FLT(6.0) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF REAL");
-      END IF;
- 
-      IF REC.T.FIRST /= YELLOW THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF ENUMERATION");
-      END IF;
- 
-      FOR I IN 1 .. 3 LOOP
-           IF REC.U.A(I) /= IDENT_FLT(2.25) THEN
-                FAILED("INCORRECT EXPLICIT INITIALIZATION OF ARRAY " &
-                       "POSITION " & INTEGER'IMAGE(I));
-           END IF;
-      END LOOP;
- 
-      IF REC.L.A /= IDENT_INT(5) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF DISCRIMINANT " &
-                  "- L");
-      END IF;
- 
-      IF REC.L.I /= IDENT_INT(5) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF INTEGER - L");
-      END IF;
- 
-      IF NOT IDENT_BOOL(REC.L.BOL) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF BOOLEAN - L");
-      END IF;
- 
-      IF REC.L.X /= IDENT_FLT(6.0) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF REAL - L");
-      END IF;
- 
-      IF REC.L.FIRST /= IDENT_ENUM(YELLOW) THEN
-           FAILED("INCORRECT EXPLICIT INITIALIZATION OF ENUMERATION " &
-                  "- L");
-      END IF;
- 
-      RESULT;
- 
- END C37009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37010a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- C37010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EXPRESSIONS IN CONSTRAINTS OF COMPONENT DECLARATIONS ARE
- -- EVALUATED IN THE ORDER THE COMPONENTS APPEAR.
- 
- -- R.WILLIAMS 8/22/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37010A IS
-      
-      TYPE R (D : INTEGER) IS
-              RECORD
-                   NULL;
-              END RECORD;
- 
-      TYPE ACCR IS ACCESS R;
- 
-      TYPE ARR IS ARRAY (POSITIVE RANGE <> ) OF INTEGER;
- 
-      TYPE ACCA IS ACCESS ARR;
- 
-      BUMP : INTEGER := 0;
- 
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN BUMP;
-      END;          
- 
- BEGIN
-      TEST ( "C37010A", "CHECK THAT EXPRESSIONS IN CONSTRAINTS OF " &
-                        "COMPONENT DECLARATIONS ARE EVALUATED IN " &
-                        "THE ORDER THE COMPONENTS APPEAR" );
- 
-      DECLARE
-           
-           TYPE REC1 IS 
-                RECORD
-                     A1 : R (D => F);
-                     B1 : STRING (1 .. F);
-                     C1 : ACCR (F);
-                     D1 : ACCA (1 .. F);
-                END RECORD;
-                
-           R1 : REC1;
- 
-      BEGIN
-           IF R1.A1.D /= 1 THEN 
-                FAILED ( "INCORRECT VALUE FOR R1.A1.D" );
-           END IF;
-      
-           IF R1.B1'LAST /= 2 THEN
-                FAILED ( "INCORRECT VALUE FOR R1.B1'LAST" );
-           END IF;
-      
-           BEGIN
-                R1.C1 := NEW R'(D => 3);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R1.C1" );
-           END;
- 
-           BEGIN
-                R1.D1 := NEW ARR (1 .. 4);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R1.D1" );
-           END;
- 
-      END;
- 
-      BUMP := 0;
-           
-      DECLARE
-           
-           TYPE REC2 (I : INTEGER) IS
-                RECORD
-                     CASE I IS
-                          WHEN 1 =>
-                               NULL;
-                          WHEN OTHERS =>
-                               A2 : R (D => F);
-                               B2 : ARR (1 .. F);
-                               C2 : ACCR (F);
-                               D2 : ACCA (1 .. F);
-                     END CASE;                     
-                END RECORD;
- 
-           R2 : REC2 (IDENT_INT (2));
- 
-      BEGIN
-           
-           IF R2.A2.D /= 1 THEN 
-                FAILED ( "INCORRECT VALUE FOR R2.A2.D" );
-           END IF;
- 
-           IF R2.B2'LAST /= 2 THEN
-                FAILED ( "INCORRECT VALUE FOR R2.B2'LAST" );
-           END IF;
- 
-           BEGIN
-                R2.C2 := NEW R (D => 3);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R2.C2" );
-           END;
-  
-           BEGIN
-                R2.D2 := NEW ARR (1 .. 4);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R2.D2" );
-           END;                         
-           
-      END;
-           
-      RESULT;
- END C37010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37010b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37010b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37010b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37010b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C37010B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EXPRESSIONS IN AN INDEX CONSTRAINT OR DISCRIMINANT 
- -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT DECLARATION IS 
- -- ELABORATED EVEN IF SOME BOUNDS OR DISCRIMINANTS ARE GIVEN BY
- -- A DISCRIMINANT OF AN ENCLOSING RECORD TYPE.
- 
- -- R.WILLIAMS 8/22/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37010B IS
-      
-      INIT :INTEGER := IDENT_INT (5);
- 
-      TYPE R (D1, D2 : INTEGER) IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      TYPE ACCR IS ACCESS R;
- 
-      TYPE ARR IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
- 
-      TYPE ACCA IS ACCESS ARR;
- 
-      FUNCTION RESET (N : INTEGER) RETURN INTEGER IS
-      BEGIN
-           INIT := IDENT_INT (N);
-           RETURN N;
-      END RESET;
- 
- BEGIN
-      TEST ( "C37010B", "CHECK THAT EXPRESSIONS IN AN INDEX " &
-                        "CONSTRAINT OR DISCRIMINANT CONSTRAINT " &
-                        "ARE EVALUATED WHEN THE COMPONENT " &
-                        "DECLARATION IS ELABORATED EVEN IF SOME " &
-                        "BOUNDS OR DISCRIMINANTS ARE GIVEN BY " &
-                        "A DISCRIMINANT OF AN ENCLOSING RECORD TYPE" );
- 
-      DECLARE
-           
-           TYPE REC1 (D : INTEGER) IS 
-                RECORD
-                     W1 : R (D1 => INIT, D2 => D);
-                     X1 : ARR (INIT .. D);
-                     Y1 : ACCR (D, INIT);
-                     Z1 : ACCA (D .. INIT);
-                END RECORD;
-           
-           INT1 : INTEGER := RESET (10);
- 
-           R1 : REC1 (D => 4);
- 
-      BEGIN
-           IF R1.W1.D1 /= 5 THEN 
-                FAILED ( "INCORRECT VALUE FOR R1.W1.D1" );
-           END IF;
-      
-           IF R1.W1.D2 /= 4 THEN 
-                FAILED ( "INCORRECT VALUE FOR R1.W1.D2" );
-           END IF;
- 
-           IF R1.X1'FIRST /= 5 THEN
-                FAILED ( "INCORRECT VALUE FOR R1.X1'FIRST" );
-           END IF;
- 
-           IF R1.X1'LAST /= 4 THEN
-                FAILED ( "INCORRECT VALUE FOR R1.X1'LAST" );
-           END IF;
- 
-           BEGIN
-                R1.Y1 := NEW R (4, 5);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R1.Y1" );
-           END;
- 
-           BEGIN
-                R1.Z1 := NEW ARR (4 .. 5);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R1.Z1" );
-           END;
-                     
-      END;
- 
-      DECLARE
-           
-           TYPE REC2 (D : INTEGER) IS
-                RECORD
-                     CASE D IS
-                          WHEN 1 =>
-                               NULL;
-                          WHEN 2 =>
-                               NULL;
-                          WHEN OTHERS =>
-                               W2 : R (D1 => D, D2 => INIT);
-                               X2 : ARR (D .. INIT);
-                               Y2 : ACCR (INIT, D);
-                               Z2 : ACCA (D .. INIT);
-                     END CASE;                     
-                END RECORD;
- 
-           INT2 : INTEGER := RESET (20);
- 
-           R2 : REC2 (D => 6);
- 
-      BEGIN
-           IF R2.W2.D1 /= 6 THEN 
-                FAILED ( "INCORRECT VALUE FOR R2.W2.D1" );
-           END IF;
- 
-           IF R2.W2.D2 /= 10 THEN 
-                FAILED ( "INCORRECT VALUE FOR R2.W2.D2" );
-           END IF;
- 
-           IF R2.X2'FIRST /= 6 THEN
-                FAILED ( "INCORRECT VALUE FOR R2.X2'FIRST" );
-           END IF;
- 
-           IF R2.X2'LAST /= 10 THEN
-                FAILED ( "INCORRECT VALUE FOR R2.X2'LAST" );
-           END IF;
- 
-           BEGIN
-                R2.Y2 := NEW R (10, 6);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R2.Y2" );
-           END;
- 
-           BEGIN
-                R2.Z2 := NEW ARR (6 .. 10);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "INCORRECT VALUE FOR R2.Z2" );
-           END;
-                     
-      END;
- 
-      RESULT;
- END C37010B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c371001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c371001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c371001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c371001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,388 ****
- -- C371001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a discriminant constraint depends on a discriminant,
- --      the evaluation of the expressions in the constraint is deferred 
- --      until an object of the subtype is created.  Check for cases of 
- --      records with private type component.
- --
- -- TEST DESCRIPTION:
- --      This transition test defines record type and incomplete types with 
- --      discriminant components which depend on the discriminants.  The 
- --      discriminants are calculated by function calls.  The test verifies
- --      that Constraint_Error is raised during the object creations when 
- --      values of discriminants are incompatible with the subtypes.
- --
- --      Inspired by C37214A.ADA and C37216A.ADA.
- --
- --
- -- CHANGE HISTORY:
- --      11 Apr 96   SAIC    Initial version for ACVC 2.1.
- --      06 Oct 96   SAIC    Added LM references. Replaced "others exception"
- --                          with "unexpected exception"                     
- --
- --!
- 
- with Report; 
- 
- procedure C371001 is
- 
-    subtype Small_Int is Integer range 1..10;
- 
-    Func1_Cons : Integer := 0;
- 
-    ---------------------------------------------------------
-    function Func1 return Integer is
-    begin
-       Func1_Cons := Func1_Cons + Report.Ident_Int(1);
-       return Func1_Cons;
-    end Func1;
- 
- 
- begin
-    Report.Test ("C371001", "Check that if a discriminant constraint " &
-                 "depends on a discriminant, the evaluation of the "   &
-                 "expressions in the constraint is deferred until "    &
-                 "object declarations");
- 
-    ---------------------------------------------------------
-    -- Constraint checks on an object declaration of a record.
- 
-    begin
- 
-       declare
- 
-          package C371001_0 is
- 
-             type PT_W_Disc (D : Small_Int) is private;
-             type Rec_W_Private (D1 : Integer) is
-               record
-                  C : PT_W_Disc (D1);
-               end record;
-    
-             type Rec (D3 : Integer) is
-               record
-                  C1 : Rec_W_Private (D3);
-               end record;
- 
-          private
-             type PT_W_Disc (D : Small_Int) is 
-               record
-                  Str : String (1 .. D) := (others => '*');
-               end record;
- 
-          end C371001_0;                         
- 
-          --=====================================================--
- 
-          Obj : C371001_0.Rec(Report.Ident_Int(0));  -- Constraint_Error raised.
- 
-       begin
-          Report.Failed ("Obj - Constraint_Error should be raised");
-          if Obj.C1.D1 /= 0 then
-             Report.Failed ("Obj - Shouldn't get here");
-          end if;
- 
-       exception
-          when others           => 
-               Report.Failed ("Obj - exception raised too late");
-       end;
- 
-    exception                      
-       when Constraint_Error =>                      -- Exception expected.
-            null;
-       when others           => 
-            Report.Failed ("Obj - unexpected exception raised");
-    end;
- 
-    -------------------------------------------------------------------
-    -- Constraint checks on an object declaration of an array.
- 
-    begin
-       declare
- 
-          package C371001_1 is
- 
-             type PT_W_Disc (D : Small_Int) is private;
-             type Rec_W_Private (D1 : Integer) is
-               record
-                  C : PT_W_Disc (D1);
-               end record;
- 
-             type Rec_01 (D3 : Integer) is
-               record
-                  C1 : Rec_W_Private (D3);
-               end record;
- 
-             type Arr is array (1 .. 5) of 
-               Rec_01(Report.Ident_Int(0));          -- No Constraint_Error 
-                                                     -- raised. 
-          private
-             type PT_W_Disc (D : Small_Int) is 
-               record
-                  Str : String (1 .. D) := (others => '*');
-               end record;
- 
-          end C371001_1;                         
- 
-          --=====================================================--
- 
-       begin
-          declare
-             Obj1 : C371001_1.Arr;                   -- Constraint_Error raised.
-          begin
-             Report.Failed ("Obj1 - Constraint_Error should be raised");
-             if Obj1(1).D3 /= 0 then
-                Report.Failed ("Obj1 - Shouldn't get here");
-             end if;
- 
-          exception
-             when others           => 
-                  Report.Failed ("Obj1 - exception raised too late");
-          end;
- 
-       exception
-          when Constraint_Error =>                   -- Exception expected.
-               null;
-          when others =>
-               Report.Failed ("Obj1 - unexpected exception raised");
-       end;
- 
-    exception
-       when Constraint_Error =>
-            Report.Failed ("Arr - Constraint_Error raised");
-       when others =>
-            Report.Failed ("Arr - unexpected exception raised");
-    end;
- 
- 
-    -------------------------------------------------------------------
-    -- Constraint checks on an object declaration of an access type.
- 
-    begin
-       declare
- 
-          package C371001_2 is
- 
-             type PT_W_Disc (D : Small_Int) is private;
-             type Rec_W_Private (D1 : Integer) is
-               record
-                  C : PT_W_Disc (D1);
-               end record;
-    
-             type Rec_02 (D3 : Integer) is
-               record
-                  C1 : Rec_W_Private (D3);
-               end record;
- 
-             type Acc_Rec2 is access Rec_02          -- No Constraint_Error 
-               (Report.Ident_Int(11));               -- raised. 
- 
-          private
-             type PT_W_Disc (D : Small_Int) is 
-               record
-                  Str : String (1 .. D) := (others => '*');
-               end record;
- 
-          end C371001_2;                         
- 
-          --=====================================================--
- 
-       begin
-          declare
-             Obj2 : C371001_2.Acc_Rec2;              -- No Constraint_Error 
-                                                     -- raised.
-          begin
-             Obj2 := new C371001_2.Rec_02 (Report.Ident_Int(11));       
-                                                     -- Constraint_Error raised.
- 
-             Report.Failed ("Obj2 - Constraint_Error should be raised");
-             if Obj2.D3 /= 1 then
-                Report.Failed ("Obj2 - Shouldn't get here");
-             end if;
- 
-          exception
-             when Constraint_Error =>                -- Exception expected.
-                null;
-             when others           => 
-                Report.Failed ("Obj2 - unexpected exception raised in " &
-                               "assignment");
-          end;
- 
-       exception
-          when Constraint_Error =>  
-               Report.Failed ("Obj2 - Constraint_Error raised in declaration");
-          when others =>
-               Report.Failed ("Obj2 - unexpected exception raised in " &
-                              "declaration");
-       end;
- 
-    exception
-       when Constraint_Error =>  
-            Report.Failed ("Acc_Rec2 - Constraint_Error raised");
-       when others =>
-            Report.Failed ("Acc_Rec2 - unexpected exception raised");
-    end;
- 
-    -------------------------------------------------------------------
-    -- Constraint checks on an object declaration of a subtype.
- 
-    Func1_Cons := -1;
- 
-    begin
-       declare
- 
-          package C371001_3 is
- 
-             type PT_W_Disc (D1, D2 : Small_Int) is private;
-             type Rec_W_Private (D3, D4 : Integer) is
-               record
-                  C : PT_W_Disc (D3, D4);
-               end record;
-    
-             type Rec_03 (D5 : Integer) is
-               record
-                  C1 : Rec_W_Private (D5, Func1);     -- Func1 evaluated,
-               end record;                            -- value 0.
- 
-             subtype Subtype_Rec is Rec_03(1);        -- No Constraint_Error 
-                                                      -- raised. 
-          private
-             type PT_W_Disc (D1, D2 : Small_Int) is 
-               record
-                  Str1 : String (1 .. D1) := (others => '*');
-                  Str2 : String (1 .. D2) := (others => '*');
-               end record;
- 
-          end C371001_3;                         
- 
-          --=====================================================--
- 
-       begin
-          declare
-             Obj3 : C371001_3.Subtype_Rec;            -- Constraint_Error raised.
-          begin
-             Report.Failed ("Obj3 - Constraint_Error should be raised");
-             if Obj3.D5 /= 1 then
-                Report.Failed ("Obj3 - Shouldn't get here");
-             end if;
- 
-          exception
-             when others           => 
-                  Report.Failed ("Obj3 - exception raised too late");
-          end;
- 
-       exception
-          when Constraint_Error =>                    -- Exception expected.
-               null;
-          when others =>
-               Report.Failed ("Obj3 - unexpected exception raised");
-       end;
- 
-    exception
-       when Constraint_Error =>
-            Report.Failed ("Subtype_Rec - Constraint_Error raised");
-       when others =>
-            Report.Failed ("Subtype_Rec - unexpected exception raised");
-    end;
- 
-    -------------------------------------------------------------------
-    -- Constraint checks on an object declaration of an incomplete type.
- 
-    Func1_Cons := 10;
- 
-    begin
-       declare
- 
-          package C371001_4 is
- 
-             type Rec_04 (D3 : Integer);
-             type PT_W_Disc (D : Small_Int) is private;
-             type Rec_W_Private (D1, D2 : Small_Int) is
-               record
-                  C : PT_W_Disc (D2);
-               end record;
- 
-             type Rec_04 (D3 : Integer) is
-               record
-                  C1 : Rec_W_Private (D3, Func1);     -- Func1 evaluated
-               end record;                            -- value 11.
- 
-             type Acc_Rec4 is access Rec_04 (1);      -- No Constraint_Error 
-                                                      -- raised. 
-          private
-             type PT_W_Disc (D : Small_Int) is 
-               record
-                  Str : String (1 .. D) := (others => '*');
-               end record;
- 
-          end C371001_4;                         
- 
-          --=====================================================--
- 
-       begin
-          declare
-             Obj4 : C371001_4.Acc_Rec4;               -- No Constraint_Error 
-                                                      -- raised.
-          begin
-             Obj4 := new C371001_4.Rec_04 (1);        -- Constraint_Error raised.
- 
-             Report.Failed ("Obj4 - Constraint_Error should be raised");
-             if Obj4.D3 /= 1 then
-                Report.Failed ("Obj4 - Shouldn't get here");
-             end if;
- 
-          exception
-             when Constraint_Error =>                 -- Exception expected.
-                null;
-             when others           => 
-                Report.Failed ("Obj4 - unexpected exception raised in " &
-                               "assignment");
-          end;
- 
-       exception
-          when Constraint_Error =>  
-               Report.Failed ("Obj4 - Constraint_Error raised in declaration");
-          when others =>
-               Report.Failed ("Obj4 - unexpected exception raised in " &
-                              "declaration");
-       end;
- 
-    exception
-       when Constraint_Error =>  
-            Report.Failed ("Acc_Rec4 - Constraint_Error raised");
-       when others =>
-            Report.Failed ("Acc_Rec4 - unexpected exception raised");
-    end;
- 
-    Report.Result;
- 
- exception
-    when others =>
-         Report.Failed ("Discriminant value checked too soon");
-         Report.Result;
- 
- end C371001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c371002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c371002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c371002.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c371002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,364 ****
- -- C371002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a discriminant constraint depends on a discriminant,
- --      the evaluation of the expressions in the constraint is deferred until
- --      an object of the subtype is created.  Check for cases of records.
- --
- -- TEST DESCRIPTION:
- --      This transition test defines record types with discriminant components
- --      which depend on the discriminants.  The discriminants are calculated 
- --      by function calls.  The test verifies that Constraint_Error is raised 
- --      during the object creations when values of discriminants are 
- --      incompatible with the subtypes.
- --
- --      Inspired by C37213A.ADA, C37213C.ADA, C37215A.ADA and C37215C.ADA.
- --
- --
- -- CHANGE HISTORY:
- --      05 Apr 96   SAIC    Initial version for ACVC 2.1.
- --
- --!
- 
- with Report; 
- 
- procedure C371002 is
- 
-    subtype Small_Int is Integer range 1..10;
- 
-    type Rec_W_Disc (Disc1, Disc2 : Small_Int) is 
-      record 
-         Str1 : String (1 .. Disc1) := (others => '*');
-         Str2 : String (1 .. Disc2) := (others => '*');
-      end record;
- 
-    type My_Array is array (Small_Int range <>) of Integer;
- 
-    Func1_Cons : Integer := 0;
- 
-    ---------------------------------------------------------
-    function Chk (Cons    : Integer;
-                  Value   : Integer;
-                  Message : String) return Boolean is
-    begin
-       if Cons /= Value then
-          Report.Failed (Message & ": Func1_Cons is " &
-                         Integer'Image(Func1_Cons));
-       end if;
-       return True;
-    end Chk;
- 
-    ---------------------------------------------------------
-    function Func1 return Integer is
-    begin
-       Func1_Cons := Func1_Cons + Report.Ident_Int(1);
-       return Func1_Cons;
-    end Func1;
- 
- begin
-    Report.Test ("C371002", "Check that if a discriminant constraint " &
-                 "depends on a discriminant, the evaluation of the "   &
-                 "expressions in the constraint is deferred until "    &
-                 "object declarations");
- 
-    ---------------------------------------------------------
-    declare
-       type Rec1 (D3 : Integer) is
-         record
-            C1 : Rec_W_Disc (D3, Func1);      -- Func1 evaluated, value 1.
-         end record;
-       
-       Chk1 : Boolean := Chk (Func1_Cons, 1,
-                              "Func1 not evaluated for Rec1");
- 
-       Obj1 : Rec1 (1);                       -- Func1 not evaluated again.
-       Obj2 : Rec1 (2);                       -- Func1 not evaluated again. 
- 
-       Chk2 : Boolean := Chk (Func1_Cons, 1,
-                              "Func1 evaluated too many times");
-    begin
-       if Obj1 /= (D3 => 1, 
-                   C1 => (Disc1   => 1,  
-                          Disc2   => 1, 
-                          Str1    => (others => '*'),
-                          Str2    => (others => '*'))) or
-          Obj2 /= (D3 => 2, 
-                   C1 => (Disc1   => 2,  
-                          Disc2   => 1, 
-                          Str1    => (others => '*'),
-                          Str2    => (others => '*'))) then
-            Report.Failed ("Obj1 & Obj2 - Discriminant values not correct");
-       end if;
-    end;
- 
-    ---------------------------------------------------------
-    Func1_Cons := -11;
- 
-    declare
-       type Rec_Of_Rec_01 (D3 : Integer) is
-         record
-            C1 : Rec_W_Disc (D3, Func1);      -- Func1 evaluated, value -10.
-         end record;                          -- Constraint_Error not raised. 
- 
-       type Rec_Of_MyArr_01 (D3 : Integer) is
-         record
-            C1 : My_Array (Func1 .. D3);      -- Func1 evaluated, value -9.
-         end record;                          -- Constraint_Error not raised. 
- 
-       type Rec_Of_Rec_02 (D3 : Integer) is
-         record
-            C1 : Rec_W_Disc (D3, 1);
-         end record;
- 
-       type Rec_Of_MyArr_02 (D3 : Integer) is
-         record
-            C1 : My_Array (D3 .. 1);       
-         end record;
- 
-    begin
- 
-       ---------------------------------------------------------
-       begin
-          declare
-             Obj3 : Rec_Of_Rec_01(1);         -- Constraint_Error raised.
-          begin
-             Report.Failed ("Obj3 - Constraint_Error should be raised");
-             if Obj3 /= (1, (1, 1, others => (others => '*'))) then
-                Report.Comment ("Obj3 - Shouldn't get here");
-             end if;
-          end;
- 
-       exception
-          when Constraint_Error =>            -- Exception expected.
-               null;
-          when others           => 
-               Report.Failed ("Obj3 - others exception raised");
-       end;
-         
-       ---------------------------------------------------------
-       begin
-          declare
-             subtype Subtype_Rec is Rec_Of_Rec_01(1);  
-                                              -- No Constraint_Error raised.
-          begin
-             declare
-                Obj4 : Subtype_Rec;           -- Constraint_Error raised.
-             begin
-                Report.Failed ("Obj4 - Constraint_Error should be raised");
-                if Obj4 /= (D3 => 1, 
-                            C1 => (Disc1   => 1,  
-                                   Disc2   => 1, 
-                                   Str1    => (others => '*'),
-                                   Str2    => (others => '*'))) then
-                   Report.Comment ("Obj4 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>         -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("Obj4 - others exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Subtype_Rec - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Subtype_Rec - others exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       begin
-          declare
-             type Arr is array (1..5)         -- No Constraint_Error raised.
-               of Rec_Of_Rec_01(1);                         
-                                                        
-          begin
-             declare
-                Obj5 : Arr;                   -- Constraint_Error raised.
-             begin
-                Report.Failed ("Obj5 - Constraint_Error should be raised");
-                if Obj5 /= (1..5 => (1, (1, 1, others => (others => '*')))) then
-                   Report.Comment ("Obj5 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>         -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("Obj5 - others exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Arr - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Arr - others exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       begin
-          declare
-             type Rec_Of_Rec_Of_MyArr is
-               record
-                  C1 : Rec_Of_MyArr_01(1);    -- No Constraint_Error raised.
-               end record;                    
-          begin
-             declare
-                Obj6 : Rec_Of_Rec_Of_MyArr;   -- Constraint_Error raised.
-             begin
-                Report.Failed ("Obj6 - Constraint_Error should be raised");
-                if Obj6 /= (C1 => (1, (1, 1))) then
-                   Report.Comment ("Obj6 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>         -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("Obj6 - others exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Rec_Of_Rec_Of_MyArr - others exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       begin
-          declare
-             type New_Rec is 
-               new Rec_Of_MyArr_01(1);        -- No Constraint_Error raised.
- 
-          begin
-             declare
-                Obj7 : New_Rec;               -- Constraint_Error raised.
-             begin
-                Report.Failed ("Obj7 - Constraint_Error should be raised");
-                if Obj7 /= (1, (1, 1)) then
-                   Report.Comment ("Obj7 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>         -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("Obj7 - others exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("New_Rec - Constraint_Error raised");
-          when others =>
-               Report.Failed ("New_Rec - others exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       begin
-          declare
-             type Acc_Rec is 
-               access Rec_Of_Rec_02 (Report.Ident_Int(0));
-                                              -- No Constraint_Error raised.
-          begin
-             declare
-                Obj8 : Acc_Rec;               -- No Constraint_Error raised.
- 
-             begin                                   
-                Obj8 := new Rec_Of_Rec_02 (Report.Ident_Int(0));
-                                              -- Constraint_Error raised.
- 
-                Report.Failed ("Obj8 - Constraint_Error should be raised");
-                if Obj8.all /= (D3 => 1, 
-                                C1 => (Disc1   => 1,  
-                                       Disc2   => 1, 
-                                       Str1    => (others => '*'),
-                                       Str2    => (others => '*'))) then
-                   Report.Comment ("Obj8 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>         -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("Obj8 - others exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Acc_Rec - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Acc_Rec - others exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       begin
-          declare
-             type Acc_Rec_MyArr is access 
-               Rec_Of_MyArr_02;               -- No Constraint_Error 
-                                              -- raised for either
-             Obj9 : Acc_Rec_MyArr;            -- declaration.
- 
-          begin
-             Obj9 := new Rec_Of_MyArr_02 (Report.Ident_Int(0));
-                                              -- Constraint_Error raised.
- 
-             Report.Failed ("Obj9 - Constraint_Error should be raised");
- 
-             if Obj9.all /= (1, (1, 1)) then
-                Report.Comment ("Obj9 - Shouldn't get here");
-             end if;
-        
-          exception
-             when Constraint_Error =>         -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("Obj9 - others exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Acc_Rec_MyArr - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Acc_Rec_MyArr - others exception raised");
-       end;
- 
-    end;      
- 
-    Report.Result;
- 
- exception
-      when others =>
-           Report.Failed ("Discriminant value checked too soon");
-           Report.Result;
- 
- end C371002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c371003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c371003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c371003.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c371003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,474 ****
- -- C371003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a discriminant constraint depends on a discriminant,
- --      the evaluation of the expressions in the constraint is deferred 
- --      until an object of the subtype is created.  Check for cases of 
- --      records where the component containing the constraint is present
- --      in the subtype.                                                    
- --
- -- TEST DESCRIPTION:
- --      This transition test defines record types with discriminant components
- --      which depend on the discriminants.  The discriminants are calculated 
- --      by function calls.  The test verifies that Constraint_Error is raised 
- --      during the object creations when values of discriminants are 
- --      incompatible with the subtypes.  Also check for cases, where the
- --      component is absent.
- --
- --      Inspired by C37213E.ADA, C37213G.ADA, C37215E.ADA, and C37215G.ADA.
- --
- --
- -- CHANGE HISTORY:
- --      10 Apr 96   SAIC    Initial version for ACVC 2.1.
- --      14 Jul 96   SAIC    Modified test description.  Added exception handler
- --                          for VObj_10 assignment.
- --      26 Oct 96   SAIC    Added LM references.        
- --
- --!
- 
- with Report; 
- 
- procedure C371003 is
- 
-    subtype Small_Int is Integer range 1..10;
- 
-    type Rec_W_Disc (Disc1, Disc2 : Small_Int) is 
-      record 
-         Str1 : String (1 .. Disc1) := (others => '*');
-         Str2 : String (1 .. Disc2) := (others => '*');
-      end record;
- 
-    type My_Array is array (Small_Int range <>) of Integer;
- 
-    Func1_Cons : Integer := 0;
- 
-    ---------------------------------------------------------
-    function Chk (Cons    : Integer;
-                  Value   : Integer;
-                  Message : String) return Boolean is
-    begin
-       if Cons /= Value then
-          Report.Failed (Message & ": Func1_Cons is " &
-                         Integer'Image(Func1_Cons));
-       end if;
-       return True;
-    end Chk;
- 
-    ---------------------------------------------------------
-    function Func1 return Integer is
-    begin
-       Func1_Cons := Func1_Cons + Report.Ident_Int(1);
-       return Func1_Cons;
-    end Func1;
- 
- 
- begin
-    Report.Test ("C371003", "Check that if a discriminant constraint " &
-                 "depends on a discriminant, the evaluation of the "   &
-                 "expressions in the constraint is deferred until "    &
-                 "object declarations");
- 
-    ---------------------------------------------------------
-    declare
-       type VRec_01 (D3 : Integer) is
-         record
-            case D3 is
-               when -5..10 => 
-                  C1 : Rec_W_Disc (D3, Func1);    -- Func1 evaluated, value 1.
-               when others =>
-                  C2 : Integer := Report.Ident_Int(0); 
-            end case;
-         end record;
- 
-         Chk1 : Boolean := Chk (Func1_Cons, 1, 
-                                "Func1 not evaluated for VRec_01");
- 
-         VObj_1 : VRec_01(1);                     -- Func1 not evaluated again
-         VObj_2 : VRec_01(2);                     -- Func1 not evaluated again
- 
-         Chk2 : Boolean := Chk (Func1_Cons, 1, 
-                                "Func1 evaluated too many times");
-     
-    begin
-       if VObj_1 /= (D3 => 1, 
-                     C1 => (Disc1   => 1,  
-                            Disc2   => 1, 
-                            Str1    => (others => '*'),
-                            Str2    => (others => '*'))) or
-          VObj_2 /= (D3 => 2, 
-                     C1 => (Disc1   => 2,  
-                            Disc2   => 1, 
-                            Str1    => (others => '*'),
-                            Str2    => (others => '*'))) then
-          Report.Failed ("VObj_1 & VObj_2 - Discriminant values not correct");
-       end if;
-    end;
- 
-    ---------------------------------------------------------
-    Func1_Cons := -11;
- 
-    declare
-       type VRec_Of_VRec_01 (D3 : Integer) is
-         record
-            case D3 is
-               when -5..10 => 
-                  C1 : Rec_W_Disc (Func1, D3);   -- Func1 evaluated, value -10.
-               when others =>                    -- Constraint_Error not raised. 
-                  C2 : Integer := Report.Ident_Int(0); 
-            end case;
-         end record;
- 
-       type VRec_Of_VRec_02 (D3 : Integer) is
-         record
-            case D3 is
-               when -5..10 => 
-                  C1 : Rec_W_Disc (1, D3); 
-               when others =>
-                  C2 : Integer := Report.Ident_Int(0); 
-            end case;
-         end record;
- 
-       type VRec_Of_MyArr_01 (D3 : Integer) is
-         record
-            case D3 is
-               when -5..10 => 
-                  C1 : My_Array  (Func1..D3);    -- Func1 evaluated, value -9.
-               when others =>                    -- Constraint_Error not raised. 
-                  C2 : Integer := Report.Ident_Int(0); 
-            end case;
-         end record;
- 
-       type VRec_Of_MyArr_02 (D3 : Integer) is
-         record
-            case D3 is
-               when -5..10 => 
-                  C1 : My_Array  (D3..1);
-               when others =>          
-                  C2 : Integer := Report.Ident_Int(0); 
-            end case;
-         end record;
- 
-    begin
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is present.
-       begin
-          declare
-             VObj_3 : VRec_Of_VRec_01(1);        -- Constraint_Error raised.
-          begin
-             Report.Failed ("VObj_3 - Constraint_Error should be raised");
-             if VObj_3 /= (1, (1, 1, others => (others => '*'))) then
-                 Report.Comment ("VObj_3 - Shouldn't get here");
-             end if;
-          end;
- 
-       exception
-          when Constraint_Error =>               -- Exception expected.
-               null;
-          when others           => 
-               Report.Failed ("VObj_3 - unexpected exception raised");
-       end;
-         
-       ---------------------------------------------------------
-       -- Component containing the constraint is present.
-       begin
-          declare
-             subtype Subtype_VRec is             -- No Constraint_Error raised.
-               VRec_Of_VRec_01(Report.Ident_Int(1));      
-          begin
-             declare
-                VObj_4 : Subtype_VRec;           -- Constraint_Error raised.
-             begin
-                Report.Failed ("VObj_4 - Constraint_Error should be raised");
-                if VObj_4 /= (D3 => 1, 
-                              C1 => (Disc1   => 1,  
-                                     Disc2   => 1, 
-                                     Str1    => (others => '*'),
-                                     Str2    => (others => '*'))) then
-                   Report.Comment ("VObj_4 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>            -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("VObj_4 - unexpected exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Subtype_VRec - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Subtype_VRec - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is absent.
-       begin
-          declare
-             type Arr is array (1..5) of         
-               VRec_Of_VRec_01(Report.Ident_Int(-6)); -- No Constraint_Error 
-             VObj_5 : Arr;                            -- for either declaration.
- 
-          begin
-             if VObj_5 /= (1 .. 5 => (-6, 0)) then
-                Report.Comment ("VObj_5 - wrong values");
-             end if;
-          end;
- 
-       exception
-          when others =>
-               Report.Failed ("Arr - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is present.
-       begin
-          declare
-             type Rec_Of_Rec_Of_MyArr is
-               record
-                  C1 : VRec_Of_MyArr_01(1);    -- No Constraint_Error raised.
-               end record;                    
-          begin
-             declare
-                Obj_6 : Rec_Of_Rec_Of_MyArr;   -- Constraint_Error raised.
-             begin
-                Report.Failed ("Obj_6 - Constraint_Error should be raised");
-                if Obj_6 /= (C1 => (1, (1, 1))) then
-                   Report.Comment ("Obj_6 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>         -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("Obj_6 - unexpected exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Rec_Of_Rec_Of_MyArr - unexpected exception " &
-                              "raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is absent.
-       begin
-          declare
-             type New_VRec_Arr is 
-               new VRec_Of_MyArr_01(11);       -- No Constraint_Error raised
-             Obj_7 : New_VRec_Arr;             -- for either declaration.
- 
-          begin
-             if Obj_7 /= (11, 0) then
-                Report.Failed ("Obj_7 - value incorrect");
-             end if;
-          end;
- 
-       exception
-          when others =>
-               Report.Failed ("New_VRec_Arr - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is present.
-       begin
-          declare
-             type New_VRec is new
-               VRec_Of_VRec_02(Report.Ident_Int(0)); -- No Constraint_Error 
-                                                     -- raised.
-          begin
-             declare
-                 VObj_8 : New_VRec;                  -- Constraint_Error raised.
-             begin
-                Report.Failed ("VObj_8 - Constraint_Error should be raised");
-                if VObj_8 /= (1, (1, 1, others => (others => '*'))) then
-                   Report.Comment ("VObj_8 - Shouldn't get here");
-                end if;
-             end;
- 
-          exception
-             when Constraint_Error =>               -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("VObj_8 - unexpected exception raised");
-          end;
- 
-       exception                                    
-          when Constraint_Error =>
-               Report.Failed ("New_VRec - Constraint_Error raised");
-          when others =>
-               Report.Failed ("New_VRec - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is absent.
-       begin
-          declare
-             subtype Sub_VRec is
-               VRec_Of_VRec_02(Report.Ident_Int(11)); -- No Constraint_Error 
-             VObj_9 : Sub_VRec;                       -- raised for either
-                                                      -- declaration.
-          begin
-             if VObj_9 /= (11, 0) then
-                Report.Comment ("VObj_9 - wrong values");
-             end if;
-          end;
- 
-       exception                                    
-          when others =>
-               Report.Failed ("Sub_VRec - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is present.
-       begin
-          declare
-             type Acc_VRec_01 is access 
-               VRec_Of_VRec_02(Report.Ident_Int(0));  -- No Constraint_Error 
-                                                      -- raised.
-          begin
-             declare
-                VObj_10 : Acc_VRec_01;                -- No Constraint_Error 
-                                                      -- raised.
-             begin
-                VObj_10 := new VRec_Of_VRec_02
-                             (Report.Ident_Int(0));   -- Constraint_Error
-                                                      -- raised.
-                Report.Failed ("VObj_10 - Constraint_Error should be raised");
-                if VObj_10.all /= (1, (1, 1, others => (others => '*'))) then
-                   Report.Comment ("VObj_10 - Shouldn't get here");
-                end if;
-      
-             exception
-                when Constraint_Error =>              -- Exception expected.
-                    null;
-                when others =>
-                    Report.Failed ("VObj_10 - unexpected exception raised");
-             end;
- 
-          exception
-             when Constraint_Error =>
-                 Report.Failed ("VObj_10 - Constraint_Error exception raised");
-             when others =>
-                 Report.Failed ("VObj_10 - unexpected exception raised at " &
-                                "declaration");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Acc_VRec_01 - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Acc_VRec_01 - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is absent.
-       begin
-          declare
-             type Acc_VRec_02 is access 
-               VRec_Of_VRec_02(11);                  -- No Constraint_Error 
-                                                     -- raised for either
-             VObj_11 :  Acc_VRec_02;                 -- declaration.
- 
-          begin
-             VObj_11 := new VRec_Of_VRec_02(11);
-             if VObj_11.all /= (11, 0) then
-                Report.Comment ("VObj_11 - wrong values");
-             end if;
-          end;
- 
-       exception
-          when others =>
-               Report.Failed ("Acc_VRec_02 - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is present.
-       begin
-          declare
-             type Acc_VRec_03 is access 
-               VRec_Of_MyArr_02;                    -- No Constraint_Error 
-                                                    -- raised for either
-             VObj_12 : Acc_VRec_03;                 -- declaration.
-          begin
-             VObj_12 := new VRec_Of_MyArr_02
-                            (Report.Ident_Int(0)); -- Constraint_Error raised.
- 
-             Report.Failed ("VObj_12 - Constraint_Error should be raised");
-             if VObj_12.all /= (1, (1, 1)) then
-                Report.Comment ("VObj_12 - Shouldn't get here");
-             end if;
-        
-          exception
-             when Constraint_Error =>              -- Exception expected.
-                 null;
-             when others =>
-                 Report.Failed ("VObj_12 - unexpected exception raised");
-          end;
- 
-       exception
-          when Constraint_Error =>
-               Report.Failed ("Acc_VRec_03 - Constraint_Error raised");
-          when others =>
-               Report.Failed ("Acc_VRec_03 - unexpected exception raised");
-       end;
- 
-       ---------------------------------------------------------
-       -- Component containing the constraint is absent.
-       begin
-          declare
-             type Acc_VRec_04 is access 
-               VRec_Of_MyArr_02(11);                 -- No Constraint_Error 
-                                                     -- raised for either
-             VObj_13 :  Acc_VRec_04;                 -- declaration.
-                     
-          begin
-             VObj_13 := new VRec_Of_MyArr_02(11);
-             if VObj_13.all /= (11, 0) then
-                Report.Comment ("VObj_13 - wrong values");
-             end if;
-          end;
- 
-       exception
-          when others =>
-               Report.Failed ("Acc_VRec_04 - unexpected exception raised");
-       end;
- 
-    end;
- 
-    Report.Result;
- 
- exception
-      when others =>
-           Report.Failed ("Discriminant value checked too soon");
-           Report.Result;
- 
- end C371003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37102b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37102b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37102b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37102b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C37102B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT, FOR A RECORD TYPE, THE IDENTIFIER FOR A DISCRIMINANT 
- -- CAN BE USED AS A SELECTED COMPONENT IN AN INDEX OR DISCRIMINANT 
- -- CONSTRAINT, AS THE NAME OF A DISCRIMINANT IN A DISCRIMINANT 
- -- SPECIFICATION, AND AS THE PARAMETER NAME IN A FUNCTION CALL IN A 
- -- DISCRIMINANT OR INDEX CONSTRAINT.
- 
- -- R.WILLIAMS 8/25/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37102B IS
-      
- BEGIN
-      TEST ( "C37102B", "CHECK THAT, FOR A RECORD TYPE, THE " &
-                        "IDENTIFIER FOR A DISCRIMINANT CAN BE USED " &
-                        "AS A SELECTED COMPONENT IN AN INDEX OR " &
-                        "DISCRIMINANT CONSTRAINT, AS THE NAME OF A " &
-                        "DISCRIMINANT IN A DISCRIMINANT " &
-                        "SPECIFICATION, AND AS THE PARAMETER NAME " &
-                        "IN A FUNCTION CALL IN A DISCRIMINANT OR " &
-                        "INDEX CONSTRAINT" );
- 
-      DECLARE
- 
-           FUNCTION F (D : INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (D);
-           END F;
- 
-           PACKAGE P IS
- 
-                TYPE D IS NEW INTEGER;
-           
-                TYPE REC1 IS
-                     RECORD
-                          D : INTEGER := IDENT_INT (1);
-                     END RECORD;
- 
-                G : REC1;
- 
-                TYPE REC2 (D : INTEGER := 3) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                H : REC2 (IDENT_INT (5));
- 
-                TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
- 
-                TYPE Q (D : INTEGER := 0) IS
-                     RECORD
-                          J : REC2 (D => H.D);
-                          K : ARR (G.D .. F (D => 5));
-                          L : REC2 (F (D => 4));
-                     END RECORD;
-                
-           END P;
- 
-           USE P;
- 
-      BEGIN
-           DECLARE
-                R : Q;
-           
-           BEGIN
-                IF R.J.D /= 5 THEN
-                     FAILED ( "INCORRECT VALUE FOR R.J" );
-                END IF;
-                
-                IF R.K'FIRST /= 1 THEN
-                     FAILED ( "INCORRECT VALUE FOR R.K'FIRST" );
-                END IF;
- 
-                IF R.K'LAST /= 5 THEN
-                     FAILED ( "INCORRECT VALUE FOR R.K'LAST" );
-                END IF;
- 
-                IF R.L.D /= 4 THEN
-                     FAILED ( "INCORRECT VALUE FOR R.L" );
-                END IF;
-           END;
-         
-      END;
- 
-      RESULT;
- END C37102B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37103a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37103a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37103a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C37103A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DISCRIMINANTS MAY BE BOOLEAN, CHARACTER, USER_ENUM,
- -- INTEGER, DERIVED CHARACTER, DERIVED USER_ENUM, DERIVED INTEGER,
- -- AND DERIVED DERIVED USER_ENUM.
- 
- -- DAT 5/18/81
- -- SPS 10/25/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C37103A IS
- BEGIN
-      TEST ("C37103A", "MANY DIFFERENT DISCRIMINANT TYPES");
-      DECLARE
-           PACKAGE P1 IS
-                TYPE ENUM IS (A, Z, Q, 'W', 'A');
-           END P1;
- 
-           PACKAGE P2 IS
-                TYPE E2 IS NEW P1.ENUM;
-           END P2;
- 
-           PACKAGE P3 IS
-                TYPE E3 IS NEW P2.E2;
-           END P3;
- 
-           USE P1, P2, P3;
-           TYPE INT IS NEW INTEGER RANGE -3 .. 7;
-           TYPE CHAR IS NEW CHARACTER;
-           TYPE R1 (D : ENUM) IS RECORD NULL; END RECORD;
-           TYPE R2 (D : INTEGER) IS RECORD NULL; END RECORD;
-           TYPE R3 (D : BOOLEAN) IS RECORD NULL; END RECORD;
-           TYPE R4 (D : CHARACTER) IS RECORD NULL; END RECORD;
-           TYPE R5 (D : CHAR) IS RECORD NULL; END RECORD;
-           TYPE R6 (D : E2) IS RECORD NULL; END RECORD;
-           TYPE R7 (D : E3) IS RECORD NULL; END RECORD;
-           TYPE R8 (D : INT) IS RECORD NULL; END RECORD;
-           O1 : R1(A) := (D => A);
-           O2 : R2(3) := (D => 3);
-           O3 : R3(TRUE) := (D => TRUE);
-           O4 : R4(ASCII.NUL) := (D => ASCII.NUL);
-           O5 : R5('A') := (D => 'A');
-           O6 : R6('A') := (D => 'A');
-           O7 : R7(A) := (D => A);
-           O8 : R8(2) := (D => 2);
-      BEGIN
-           IF O1.D /= A
-           OR O2.D /= 3
-           OR NOT O3.D
-           OR O4.D IN 'A' .. 'Z'
-           OR O5.D /= 'A'
-           OR O6.D /= 'A'
-           OR O7.D /= A
-           OR O8.D /= 2
-           THEN FAILED ("WRONG DISCRIMINANT VALUE");
-           END IF;
-      END;
- 
-      RESULT;
- END C37103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37105a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37105a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37105a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- C37105A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT RECORDS WITH ONLY DISCRIMINANTS ARE OK.
- 
- -- DAT 5/18/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C37105A IS
- BEGIN
-      TEST ("C37105A", "RECORDS WITH ONLY DISCRIMINANTS");
- 
-      DECLARE
-           TYPE R1 (D : BOOLEAN) IS RECORD
-                NULL; END RECORD;
-           TYPE R2 (D, E : BOOLEAN) IS RECORD
-                NULL; END RECORD;
-           TYPE R3 (A,B,C,D : INTEGER; W,X,Y,Z : CHARACTER) IS
-                RECORD NULL; END RECORD;
-           OBJ1 : R1 (IDENT_BOOL(TRUE));
-           OBJ2 : R2 (IDENT_BOOL(FALSE), IDENT_BOOL(TRUE));
-           OBJ3 : R3 (1,2,3,4,'A','B','C',IDENT_CHAR('D'));
-      BEGIN
-           IF OBJ1 = (D => (FALSE))
-           OR OBJ2 /= (FALSE, (TRUE))
-           OR OBJ3 /= (1,2,3,4,'A','B','C',('D'))
-           THEN FAILED ("DISCRIMINANT-ONLY RECORDS DON'T WORK");
-           END IF;
-      END;
- 
-      RESULT;
- END C37105A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37107a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37107a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37107a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,154 ****
- -- C37107A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A DEFAULT DISCRIMINANT EXPRESSION NEED NOT BE STATIC AND
- -- IS EVALUATED ONLY WHEN NEEDED.
- 
- -- R.WILLIAMS 8/25/86
- -- GMT        6/29/87  ADDED INTEGER ARGUMENT TO THE FUNCTION F.
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37107A IS
- 
-      FUNCTION  F (  B : BOOLEAN;
-                     I : INTEGER  ) RETURN INTEGER IS
-      BEGIN
-           IF NOT B THEN
-                FAILED ( "DEFAULT DISCRIMINANT EVALUATED " &
-                         "UNNECESSARILY - "                &
-                         INTEGER'IMAGE(I)  );
-           END IF;
- 
-           RETURN IDENT_INT (1);
-      END F;
- 
- BEGIN
-      TEST ( "C37107A", "CHECK THAT A DEFAULT DISCRIMINANT " &
-                        "EXPRESSION NEED NOT BE STATIC AND IS " &
-                        "EVALUATED ONLY WHEN NEEDED" );
- 
-      DECLARE
-           TYPE REC1 (  D : INTEGER := F (TRUE,1)  ) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           R1 : REC1;
- 
-           TYPE REC2 (  D : INTEGER := F (FALSE,2)  ) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           R2 : REC2 (D => 0);
- 
-      BEGIN
-           IF R1.D /= 1 THEN
-                FAILED ( "INCORRECT VALUE FOR R1.D" );
-           END IF;
- 
-           IF R2.D /= 0 THEN
-                FAILED ( "INCORRECT VALUE FOR R2.D" );
-           END IF;
-      END;
- 
-      DECLARE
- 
-           PACKAGE PRIV IS
-                TYPE REC3 (  D : INTEGER := F (TRUE,3)  ) IS PRIVATE;
-                TYPE REC4 (  D : INTEGER := F (FALSE,4) ) IS PRIVATE;
- 
-           PRIVATE
-                TYPE REC3 (  D : INTEGER := F (TRUE,3)  ) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TYPE REC4 (  D : INTEGER := F (FALSE,4)  ) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PRIV;
- 
-           USE PRIV;
- 
-      BEGIN
-           DECLARE
-                R3 : REC3;
-                R4 : REC4 (D => 0);
- 
-           BEGIN
-                IF R3.D /= 1 THEN
-                     FAILED ( "INCORRECT VALUE FOR R3.D" );
-                END IF;
- 
-                IF R4.D /= 0 THEN
-                     FAILED ( "INCORRECT VALUE FOR R4.D" );
-                END IF;
-           END;
- 
-      END;
- 
-      DECLARE
- 
-           PACKAGE LPRIV IS
-                TYPE  REC5
-                      (  D : INTEGER := F (TRUE,5)  ) IS LIMITED PRIVATE;
-                TYPE  REC6
-                      (  D : INTEGER := F (FALSE,6) ) IS LIMITED PRIVATE;
- 
-           PRIVATE
-                TYPE REC5 (  D : INTEGER := F (TRUE,5)  ) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TYPE REC6 (  D : INTEGER := F (FALSE,6) ) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END LPRIV;
- 
-           USE LPRIV;
- 
-      BEGIN
-           DECLARE
-                R5 : REC5;
-                R6 : REC6 (D => 0);
- 
-           BEGIN
-                IF R5.D /= 1 THEN
-                     FAILED ( "INCORRECT VALUE FOR R5.D" );
-                END IF;
- 
-                IF R6.D /= 0 THEN
-                     FAILED ( "INCORRECT VALUE FOR R6.D" );
-                END IF;
-           END;
- 
-      END;
- 
-      RESULT;
- END C37107A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37108b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37108b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37108b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,247 ****
- -- C37108B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IN AN OBJECT DECLARATION IF
- -- A DEFAULT INITIAL VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE 
- -- CONSTRAINTS OF A RECORD OR AN ARRAY TYPE WHOSE CONSTRAINT
- -- DEPENDS ON A DISCRIMINANT, AND NO EXPLICIT INITIALIZATION IS
- -- PROVIDED FOR THE OBJECT.
- 
- -- R.WILLIAMS 8/25/86
- -- EDS        7/16/98    AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37108B IS
-      
-      TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
- 
-      TYPE R (P : POSITIVE) IS
-           RECORD
-                NULL;
-           END RECORD;
-      
- BEGIN
-      TEST ( "C37108B", "CHECK THAT CONSTRAINT_ERROR IS RAISED IN " &
-                        "AN OBJECT DECLARATION IF A DEFAULT INITIAL " &
-                        "VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE " &
-                        "CONSTRAINTS OF A RECORD OR AN ARRAY TYPE " &
-                        "WHOSE CONSTRAINT DEPENDS ON A DISCRIMINANT, " &
-                        "AND NO EXPLICIT INITIALIZATION IS PROVIDED " &
-                        "FOR THE OBJECT" );
- 
- 
-      BEGIN
-           DECLARE     
-                TYPE REC1 (D : NATURAL := IDENT_INT (0)) IS
-                     RECORD
-                          A : ARR (D .. 5);
-                     END RECORD;
-                
-           BEGIN
-                DECLARE 
-                     R1 : REC1;
-                     
-                BEGIN
-                     R1.A (1) := IDENT_INT (2);
-                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
-                              "R1" & INTEGER'IMAGE(R1.A(5)));  --USE R2
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION FOR R1 RAISED INSIDE " &
-                                   "BLOCK" );
-                END;
-      
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF R1" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
-                         "DECLARATION OF REC1" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
-                         "DECLARATION OF REC1" );
-      END;
-      
-      BEGIN
-           DECLARE     
-                TYPE REC2 (D : INTEGER := IDENT_INT (-1)) IS
-                     RECORD
-                          A : R (P => D);
-                     END RECORD;
-                
-           BEGIN
-                DECLARE 
-                     R2 : REC2;
-                     
-                BEGIN
-                     R2.A := R'(P => IDENT_INT (1));
-                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
-                              "R2" & INTEGER'IMAGE(R2.A.P));  --USE R2
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION FOR R2 RAISED INSIDE " &
-                                   "BLOCK" );
-                END;
-      
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF R2" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
-                         "DECLARATION OF REC2" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
-                         "DECLARATION OF REC2" );
-      END;
- 
-      BEGIN
-           DECLARE     
-                PACKAGE PRIV IS
-                     TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS 
-                          PRIVATE;
-                     PROCEDURE PROC (R :REC3);
-                          
-                PRIVATE
-                     TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS
-                          RECORD
-                               A : R (P => D);
-                          END RECORD;
-                END PRIV;
-                
-                PACKAGE BODY PRIV IS
-                     PROCEDURE PROC (R : REC3) IS
-                          I : INTEGER;
-                     BEGIN
-                          I := IDENT_INT (R.A.P);
-                          IF EQUAL(2, IDENT_INT(1)) THEN
-                               FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
-                          END IF;
-                     END PROC;
-                END PRIV;
- 
-                USE PRIV;
-                
-           BEGIN
-                DECLARE 
-                     R3 : REC3;
-                     
-                BEGIN
-                     PROC (R3);
-                     FAILED ( "NO EXCEPTION RAISED AT " &
-                               "DECLARATION OF R3" );
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION FOR R3 RAISED INSIDE " &
-                                   "BLOCK" );
-                END;
-      
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF R3" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
-                         "DECLARATION OF REC3" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
-                         "DECLARATION OF REC3" );
-      END;
- 
-      BEGIN
-           DECLARE     
-                PACKAGE LPRIV IS
-                     TYPE REC4 (D : NATURAL := IDENT_INT (0))
-                          IS LIMITED PRIVATE;
-                     PROCEDURE PROC (R :REC4);
-                          
-                PRIVATE
-                     TYPE REC4 (D : NATURAL := IDENT_INT (0)) IS
-                          RECORD
-                               A : ARR (D .. 5);
-                          END RECORD;
-                END LPRIV;
-                
-                PACKAGE BODY LPRIV IS
-                     PROCEDURE PROC (R : REC4) IS
-                          I : INTEGER;
-                     BEGIN
-                          I := IDENT_INT (R.A'FIRST);
-                          IF EQUAL(2, IDENT_INT(1)) THEN
-                               FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
-                          END IF;
-                     END PROC;
-                END LPRIV;
- 
-                USE LPRIV;
-                
-           BEGIN
-                DECLARE 
-                     R4 : REC4;
-                     
-                BEGIN
-                     PROC (R4);
-                     FAILED ( "NO EXCEPTION RAISED AT " &
-                              "DECLARATION OF R4" );
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION FOR R4 RAISED INSIDE " &
-                                   "BLOCK" );
-                END;
-      
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF R4" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
-                         "DECLARATION OF REC4" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
-                         "DECLARATION OF REC4" );
-      END;
- 
-      RESULT;
- END C37108B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37206a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37206a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37206a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- C37206A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A TYPE WITHOUT DEFAULT DISCRIMINANT VALUES (BUT WITH
- --     DISCRIMINANTS) CHECK THAT A TYPEMARK WHICH DENOTES SUCH AN
- --     UNCONSTRAINED TYPE CAN BE USED IN:
- 
- --      1) A SUBTYPE DECLARATION, AND THE SUBTYPE NAME ACTS SIMPLY AS A
- --         NEW NAME FOR THE UNCONSTRAINED TYPE;
- --      2) IN A CONSTANT DECLARATION.
- 
- -- HISTORY:
- --     AH  08/21/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     DTN 11/13/91 DELETED SUBPARTS (2 and 3).
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37206A IS
- BEGIN
- 
-      TEST ("C37206A", "FOR TYPE WITH DEFAULT-LESS DISCRIMINANTS, " &
-            "UNCONSTRAINED TYPE_MARK CAN BE USED IN A SUBTYPE " &
-            "DECLARATION OR IN A CONSTANT DECLARATION");
- 
-      DECLARE
-           TYPE REC(DISC : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           SUBTYPE ST IS REC;                               -- 1.
- 
-           C1 : CONSTANT REC := (DISC => 5);                -- 2.
-           C2 : CONSTANT REC := (DISC => IDENT_INT(5));     -- 2.
-      BEGIN
- 
-           IF C1 /= C2 OR C1 /= (DISC => 5) THEN
-                FAILED ("CONSTANT DECLARATIONS INCORRECT");
-           END IF;
-      END;
- 
-      RESULT;
- END C37206A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37207a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37207a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37207a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,230 ****
- -- C37207A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- 
- --     FOR A TYPE WITH OR WITHOUT DEFAULT DISCRIMINANT VALUES, CHECK
- --     THAT A DISCRIMINANT CONSTRAINT CAN BE SUPPLIED IN THE FOLLOWING
- --     CONTEXTS AND HAS THE PROPER EFFECT:
- 
- --     IN A 1) OBJECT_DECLARATION, 2) COMPONENT_DECLARATION OR
- --     3) SUBTYPE INDICATION OF AN ARRAY_TYPE_DEFINITION, AND HENCE,
- --     ASSIGNMENTS CANNOT ATTEMPT TO CHANGE THE SPECIFIED DISCRIMINANT
- --     VALUES WITHOUT RAISING CONSTRAINT_ERROR
- 
- --     4) IN AN ACCESS_TYPE_DEFINITION, AND HENCE, ACCESS VALUES
- --     OF THIS ACCESS TYPE CANNOT BE ASSIGNED NON-NULL VALUES
- --     DESIGNATING OBJECTS WITH DIFFERENT DISCRIMINANT VALUES.
- 
- --     5) IN AN ALLOCATOR, AND THE ALLOCATED OBJECT HAS THE SPECIFIED
- --     DISCRIMINANT VALUES.
- 
- --     6) IN A FORMAL PARAMETER DECLARATION OF A SUBPROGRAM, AND
- --     HENCE, ASSIGNMENTS TO THE FORMAL PARAMETER CANNOT ATTEMPT TO
- --     CHANGE THE DISCRIMINANT VALUES WITHOUT RAISING CONSTRAINT_ERROR,
- --     CONSTRAINED IS TRUE, AND IF ACTUAL PARAMETERS HAVE DISCRIMINANT
- --     VALUES DIFFERENT FROM THE SPECIFIED ONES, CONSTRAINT_ERROR IS
- --     RAISED.
- 
- -- HISTORY:
- 
- --     ASL 07/24/81
- --     RJW 08/28/86  CORRECTED SYNTAX ERRORS.
- --     JLH 08/07/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
- --     EDS 07/16/98  AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37207A IS
- 
- BEGIN
-      TEST ("C37207A","DISCRIMINANT CONSTRAINT CAN BE SUPPLIED TO " &
-           "DECLARATIONS AND DEFINITIONS USING TYPES WITH OR WITHOUT " &
-           "DEFAULT DISCRIMINANT VALUES");
- 
-      DECLARE
-           TYPE REC1 (DISC : INTEGER := 5) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE REC2 (DISC : INTEGER) IS
-                RECORD
-                     NULL;
-                 END RECORD;
- 
-           OBJ1 : REC1(6);                     -- 1.
-           OBJ2 : REC2(6);                     -- 1.
-           BADOBJ1 : REC1(7);                  -- 1.
-           BADOBJ2 : REC2(7);                  -- 1.
- 
-           TYPE REC3 IS
-                RECORD
-                     COMP1 : REC1(6);          -- 2.
-                     COMP2 : REC2(6);          -- 2.
-                END RECORD;
- 
-           OBJ3 : REC3;
- 
-           TYPE ARR1 IS ARRAY (1..10) OF REC1(6);  -- 3.
-           TYPE ARR2 IS ARRAY (1..10) OF REC2(6);  -- 3.
- 
-           A1 : ARR1;
-           A2 : ARR2;
- 
-           TYPE REC1_NAME IS ACCESS REC1(6);   -- 4.
-           TYPE REC2_NAME IS ACCESS REC2(6);   -- 4.
- 
-           ACC1 : REC1_NAME;
-           ACC2 : REC2_NAME;
- 
-           SUBTYPE REC16 IS REC1(6);
-           SUBTYPE REC26 IS REC2(6);
- 
-           PROCEDURE PROC (P1 : IN OUT REC16;     -- 6.
-                          P2 : IN OUT REC26) IS  -- 6.
-           BEGIN
-                IF NOT (P1'CONSTRAINED AND P2'CONSTRAINED) THEN  -- 6.
-                     FAILED ("'CONSTRAINED ATTRIBUTE INCORRECT FOR " &
-                             "CONSTRAINED FORMAL PARAMETERS");
-                END IF;
-                BEGIN
-                     P1 := (DISC => 7);         -- 6.
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                             "ATTEMPT TO CHANGE DISCRIMINANT OF " &
-                             "CONSTRAINED FORMAL PARAMETER " &                                                                                  
-                             INTEGER'IMAGE(P1.DISC));
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR => NULL;
-                     WHEN OTHERS => FAILED ("WRONG EXCEPTION     (1)");
-                END;
-                BEGIN
-                     P2 := (DISC => 7);         -- 6.
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                             "ATTEMPT TO CHANGE DISCRIMINANT OF " &
-                             "CONSTRAINED FORMAL PARAMETER " & 
-                             INTEGER'IMAGE(P2.DISC));
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR => NULL;
-                     WHEN OTHERS => FAILED ("WRONG EXCEPTION     (2)");
-                END;
-           END PROC;
-      BEGIN
- ---------------------------------------------------------------
- 
-           BEGIN
-                OBJ1 := (DISC => IDENT_INT(7));           -- 1.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                        "ATTEMPT TO CHANGE DISCRIMINANT OF " &
-                        "CONSTRAINED OBJECT");
-                IF OBJ1 = (DISC => 7) THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (3)");
-           END;
- 
- ---------------------------------------------------------------
- 
-           BEGIN
-                OBJ3 := ((DISC => IDENT_INT(7)),      -- 2.
-                         (DISC => IDENT_INT(7)));     -- 2.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                        "ATTEMPT TO CHANGE DISCRIMINANT OF " &
-                        "CONSTRAINED RECORD COMPONENT");
-                IF OBJ3 = ((DISC => 7), (DISC => 7)) THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (4)");
-           END;
- 
- --------------------------------------------------------------
- 
-           BEGIN
-                A2(2) := (DISC => IDENT_INT(7));          -- 3.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                        "ATTEMPT TO CHANGE DISCRIMINANT OF " &
-                        "CONSTRAINED ARRAY COMPONENT");
-                IF A2(2) = (DISC => 7) THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (5)");
-           END;
- 
- --------------------------------------------------------------
- 
-           BEGIN
-                ACC1 := NEW REC1(DISC => IDENT_INT(7));   -- 4.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                        "ATTEMPT TO ASSIGN INCOMPATIBLE OBJECT " &
-                        "TO ACCESS VARIABLE");
-                IF ACC1 =  NEW REC1(DISC => 7) THEN
-                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
-                END IF;
-          EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (6)");
-           END;
- 
- ----------------------------------------------------------------
- 
-                ACC1 := NEW REC1(DISC => IDENT_INT(6));  -- OK.
- 
-           BEGIN
-                ACC1.ALL := BADOBJ1;           -- 5.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                        "ATTEMPT TO ASSIGN INCOMPATIBLE OBJECT " &
-                        "TO ACCESSED OBJECT");
-                IF ACC1.ALL = BADOBJ1 THEN
-                     COMMENT ("PREVENT DEAD VARIABLE OPTIMIZATION");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (7)");
-           END;
- 
- -----------------------------------------------------------------
- 
-                PROC (OBJ1,OBJ2);              -- OK.
- 
-           BEGIN
-                PROC (BADOBJ1,BADOBJ2);        -- 6.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
-                        "PASSING OF CONSTRAINED ACTUAL " &
-                        "PARAMETERS TO DIFFERENTLY CONSTRAINED " &
-                        "FORMAL PARAMETERS");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (8)");
-           END;
- 
- ---------------------------------------------------------------
-      END;
- 
-      RESULT;
- END C37207A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37208a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37208a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37208a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37208a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,172 ****
- -- C37208A.ADA     (RA #534/1)
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A TYPE WITH DEFAULT DISCRIMINANT VALUES, CHECK THAT A
- -- DISCRIMINANT CONSTRAINT CAN BE OMITTED IN:
-  
-      -- AN OBJECT DECLARATION, AND HENCE ASSIGNMENTS TO THE OBJECT CAN 
-      -- CHANGE ITS DISCRIMINANTS;
-  
-      -- A COMPONENT_DECLARATION IN A RECORD TYPE DEFINITION, AND HENCE
-      -- ASSIGNMENTS TO THE COMPONENT CAN CHANGE THE VALUE OF ITS
-      -- DISCRIMINANTS;
-  
-      -- A SUBTYPE INDICATION IN AN ARRAY TYPE DEFINITION, AND HENCE
-      -- ASSIGNMENTS TO ONE OF THE COMPONENTS CAN CHANGE ITS 
-      -- DISCRIMINANT VALUES;
-  
-      -- A FORMAL PARAMETER OF A SUBPROGRAM; EXCEPT FOR PARAMETERS OF
-      -- MODE IN, THE 'CONSTRAINED ATTRIBUTE OF THE ACTUAL PARAMETER
-      -- BECOMES THE 'CONSTRAINED ATTRIBUTE OF THE FORMAL PARAMETER;
-      -- FOR IN OUT AND OUT PARAMETERS, IF THE 'CONSTRAINED ATTRIBUTE IS 
-      -- FALSE, ASSIGNMENTS TO THE FORMAL PARAMETER CAN CHANGE THE 
-      -- DISCRIMINANTS OF THE ACTUAL PARAMETER; IF THE 'CONSTRAINED 
-      -- ATTRIBUTE IS TRUE, ASSIGNNMENTS THAT ATTEMPT TO CHANGE THE 
-      -- DISCRIMINANTS OF THE ACTUAL PARAMETER RAISE CONSTRAINT_ERROR.
-  
- -- ASL 7/23/81
- -- EDS 7/16/98    AVOID OPTIMIZATION
-  
- WITH REPORT;
- PROCEDURE C37208A IS
-  
-      USE REPORT;
-  
- BEGIN
-      TEST ("C37208A","DISCRIMINANT CONSTRAINT CAN BE OMITTED " &
-            "FROM OBJECT DECLARATION, COMPONENT DECLARATION, SUBTYPE " &
-            "INDICATION OR FORMAL SUBPROGRAM PARAMETER, IF THE TYPE " &
-            "HAS DEFAULT DISCRIMINANTS");
-  
-      DECLARE
-           TYPE REC1(DISC : INTEGER := 7) IS
-                RECORD
-                     NULL;
-                END RECORD;
-  
-           TYPE REC2 IS
-                RECORD
-                     COMP : REC1;
-                END RECORD;
-  
-           R : REC2;
-           U1,U2,U3 : REC1 := (DISC => 3);
-           C1,C2,C3 : REC1(3) := (DISC => 3);
-           ARR : ARRAY(INTEGER RANGE 1..10) OF REC1;
-           ARR2 : ARRAY (1..10) OF REC1(4);
-  
-           PROCEDURE PROC(P_IN : IN REC1;
-                          P_OUT : OUT REC1;
-                          P_IN_OUT : IN OUT REC1;
-                          CONSTR : IN BOOLEAN) IS
-           BEGIN
-                IF P_OUT'CONSTRAINED /= CONSTR
-                     OR P_IN_OUT'CONSTRAINED /= CONSTR THEN
-                     FAILED ("CONSTRAINED ATTRIBUTES DO NOT MATCH " &
-                               "FOR ACTUAL AND FORMAL PARAMETERS");
-                END IF;
- 
-                IF P_IN'CONSTRAINED /= IDENT_BOOL(TRUE) THEN
-                     FAILED ("'CONSTRAINED IS FALSE FOR IN " &
-                             "PARAMETER");
-                END IF;
-  
-                IF NOT CONSTR THEN     -- UNCONSTRAINED ACTUAL PARAM
-                     P_OUT := (DISC => IDENT_INT(0));
-                     P_IN_OUT := (DISC => IDENT_INT(0));
-                ELSE
-                     BEGIN
-                          P_OUT := (DISC => IDENT_INT(0));
-                          FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
-                                  "PARAMETER ILLEGALLY CHANGED - 1");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION - 1");
-                     END;
- 
-                     BEGIN
-                          P_IN_OUT := (DISC => IDENT_INT(0));
-                          FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
-                                  "PARAMETER ILLEGALLY CHANGED - 2");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR => NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION - 2");
-                     END;
-                END IF;
-           END PROC;
-      BEGIN
-           IF U1.DISC /= IDENT_INT(3) THEN
-                FAILED ("INITIAL DISCRIMINANT VALUE WRONG - U1");
-           END IF;
- 
-           U1 := (DISC => IDENT_INT(5));
-           IF U1.DISC /= 5 THEN
-                FAILED ("ASSIGNMENT FAILED FOR OBJECT");
-           END IF;
-  
-           IF R.COMP.DISC /= IDENT_INT(7) THEN
-                FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - R");
-           END IF;
- 
-           R.COMP := (DISC => IDENT_INT(5));
-           IF R.COMP.DISC /= 5 THEN
-                FAILED ("ASSIGNMENT FAILED FOR RECORD COMPONENT");
-           END IF;
-  
-           FOR I IN 1..10 LOOP
-                IF ARR(I).DISC /= IDENT_INT(7) THEN
-                     FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - ARR");
-                END IF;
-           END LOOP;
- 
-           ARR(3) := (DISC => IDENT_INT(5));
-           IF ARR(3).DISC /= 5 THEN
-                FAILED ("ASSIGNMENT FAILED FOR ARRAY COMPONENT");
-           END IF;
-  
-           IF ARR /= (1..2|4..10 => (DISC => 7), 3 => (DISC => 5)) THEN
-                FAILED ("MODIFIED WRONG COMPONENTS");
-           END IF;
- 
-           PROC(C1,C2,C3,IDENT_BOOL(TRUE));
-           PROC(U1,U2,U3,IDENT_BOOL(FALSE));
-           IF U2.DISC /= 0 OR U3.DISC /= 0 THEN
-                FAILED ("ASSIGNMENT TO UNCONSTRAINED ACTUAL PARAMETER " &
-                        "FAILED TO CHANGE DISCRIMINANT");
-           END IF;
- 
-           PROC(ARR(1), ARR(3), ARR(4), FALSE);
-           IF ARR(3).DISC /= 0 OR ARR(4).DISC /= 0 THEN
-                FAILED ("ARRAY COMPONENT ASSIGNMENTS DIDN'T CHANGE " &
-                        "DISCRIMINANT OF COMPONENT");
-           END IF;
- 
-           PROC (ARR2(2), ARR2(5), ARR2(10), TRUE);
-      END;
-  
-      RESULT;
- END C37208A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37208b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37208b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37208b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37208b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C37208B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A TYPE WITH DEFAULT DISCRIMINANT VALUES, CHECK THAT A
- -- DISCRIMINANT CONSTRAINT CAN BE OMITTED IN A GENERIC FORMAL
- -- PARAMETER, AND HENCE, FOR BOTH IN AND IN OUT PARAMETERS, THE
- -- 'CONSTRAINED ATTRIBUTE OF THE ACTUAL PARAMETER BECOMES THE
- -- 'CONSTRAINED ATTRIBUTE OF THE FORMAL PARAMETER, AND, FOR IN
- -- OUT PARAMETERS, IF THE 'CONSTRAINED ATTRIBUTE IS FALSE,
- -- ASSIGNMENTS TO THE FORMAL PARAMETERS CAN CHANGE THE
- -- DISCRIMINANTS OF THE ACTUAL PARAMETER; IF THE 'CONSTRAINED
- -- ATTRIBUTE IS  TRUE, ASSIGNMENTS THAT ATTEMPT TO CHANGE THE
- -- DISCRIMINANTS OF THE ACTUAL PARAMETER RAISE CONSTRAINT_ERROR.
-  
- -- ASL 7/29/81
- -- VKG 1/20/83
- -- EDS 7/16/98    AVOID OPTIMIZATION
- 
- WITH REPORT;
- PROCEDURE C37208B IS
-  
-      USE REPORT;
-  
- BEGIN
-      TEST ("C37208B","FOR TYPES WITH DEFAULT DISCRIMINANT " &
-             "VALUES, DISCRIMINANT CONSTRAINTS CAN BE OMITTED " &
-             "IN GENERIC FORMAL PARAMETERS, AND THE " &
-             "'CONSTRAINED ATTRIBUTE HAS CORRECT VALUES " &
-             "DEPENDING ON THE ACTUAL PARAMETERS");
-  
-      DECLARE
-           TYPE REC(DISC : INTEGER := 7) IS
-                RECORD
-                     NULL;
-                END RECORD;
-  
-           KC : CONSTANT REC(3) := (DISC => 3);
-           KU : CONSTANT REC := (DISC => 3);
-           OBJC1,OBJC2 : REC(3) := (DISC => 3);
-           OBJU1,OBJU2 : REC := (DISC => 3);
-  
-           GENERIC
-                P_IN1 : REC;
-                P_IN2 : REC;
-                P_IN_OUT : IN OUT REC;
-                STATUS : BOOLEAN;
-           PROCEDURE PROC;
- 
-           PROCEDURE PROC IS
-           BEGIN
- 
-                IF P_IN1'CONSTRAINED /= TRUE  OR
-                   P_IN2'CONSTRAINED /= TRUE  OR
-                   P_IN_OUT'CONSTRAINED /= STATUS
-                THEN
- 
-                     FAILED ("'CONSTRAINED ATTRIBUTES DO NOT MATCH " &
-                             "FOR ACTUAL AND FORMAL PARAMETERS");
-                END IF;
-                IF NOT STATUS THEN
-                     BEGIN
-                          P_IN_OUT := (DISC => IDENT_INT(7));
-                     EXCEPTION 
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED " &
-                                       "WHEN TRYING TO " &
-                                       "CHANGE UNCONSTRAINED " &
-                                       "DISCRIMINANT VALUE");
-                     END;
-                ELSE
-                     BEGIN
-                          P_IN_OUT := (DISC => IDENT_INT(7));
-                          FAILED ("DISCRIMINANT OF CONSTRAINED " &
-                                  "ACTUAL PARAMETER ILLEGALLY " &
-                                  "CHANGED BY ASSIGNMENT");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR => NULL;     
-                          WHEN OTHERS => FAILED ("WRONG EXCEPTION");
-                     END;
-                END IF;
-           END PROC;
- 
-      BEGIN
- 
-           DECLARE
-                PROCEDURE PROC_C IS NEW PROC(KC,OBJC1,OBJC2,IDENT_BOOL(TRUE));
-                PROCEDURE PROC_U IS NEW PROC(KU,OBJU1,OBJU2,IDENT_BOOL(FALSE));
-           BEGIN
-                PROC_C;
-                PROC_U;
-                IF OBJU2.DISC /= 7 THEN
-                FAILED ("ASSIGNMENT TO UNCONSTRAINED ACTUAL " &
-                        "PARAMETER FAILED TO CHANGE DISCRIMINANT ");
-                END IF;
-           END;
- 
-      END;
-      RESULT;
- END C37208B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37209a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37209a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37209a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37209a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C37209A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR A CONSTANT OBJECT 
- -- DECLARATION WHOSE SUBTYPE INDICATION SPECIFIES AN UNCONSTRAINED
- -- TYPE WITH DEFAULT DISCRIMINANT VALUES AND WHOSE INITIALIZATION
- -- EXPRESSION SPECIFIES A VALUE WHOSE DISCRIMINANTS ARE NOT EQUAL TO
- -- THE DEFAULT VALUE.
- 
- -- R.WILLIAMS 8/25/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37209A IS
-      
- BEGIN
-      TEST ( "C37209A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-                        "FOR A CONSTANT OBJECT DECLARATION WHOSE " &
-                        "SUBTYPE INDICATION SPECIFIES AN " &
-                        "UNCONSTRAINED TYPE WITH DEFAULT " &
-                        "DISCRIMINANT VALUES AND WHOSE " &
-                        "INITIALIZATION EXPRESSION SPECIFIES A VALUE " &
-                        "WHOSE DISCRIMINANTS ARE NOT EQUAL TO THE " &
-                        "DEFAULT VALUE" );
-      DECLARE
- 
-           TYPE REC1 (D : INTEGER := IDENT_INT (5)) IS
-                RECORD
-                     NULL;
-                END RECORD;
-                
-      BEGIN
-           DECLARE 
-                R1 : CONSTANT REC1 := (D => IDENT_INT (10));     
-           BEGIN
-                COMMENT ( "NO EXCEPTION RAISED AT DECLARATION OF R1" );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
-                         "R1" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
-                         "R1" );
-      END;          
-      
- 
-      BEGIN
-           DECLARE     
-                PACKAGE PRIV IS
-                     TYPE REC2 (D : INTEGER:= IDENT_INT (5)) IS PRIVATE;
-                     R2 : CONSTANT REC2;
- 
-                PRIVATE
-                     TYPE REC2 (D : INTEGER := IDENT_INT (5)) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
- 
-                     R2 : CONSTANT REC2 := (D => IDENT_INT (10));
-                END PRIV;
-           
-                USE PRIV;
-                
-           BEGIN
-                DECLARE 
-                     I : INTEGER := R2.D;                    
-                BEGIN
-                     COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
-                               "OF R2" );
-               END;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
-                          "R2" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
-                         "OF R2" );
-      END;
- 
-      BEGIN
-           DECLARE     
-                PACKAGE LPRIV IS
-                     TYPE REC3 (D : INTEGER:= IDENT_INT (5)) IS 
-                          LIMITED PRIVATE;
- 
-                     R3 : CONSTANT REC3;
- 
-                PRIVATE
-                     TYPE REC3 (D : INTEGER := IDENT_INT (5)) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
- 
-                     R3 : CONSTANT REC3 := (D => IDENT_INT (10));
-                END LPRIV;
-           
-                USE LPRIV;
- 
-           BEGIN
-                DECLARE
-                     I : INTEGER;
-                BEGIN
-                     I := R3.D;
-                     COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
-                               "OF R3" );
-               END;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
-                          "R3" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
-                         "OF R3" );
-      END;
- 
-      RESULT;
- END C37209A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37209b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37209b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37209b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37209b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,194 ****
- -- C37209B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE SUBTYPE
- --     INDICATION IN A CONSTANT OBJECT DECLARATION SPECIFIES A
- --     CONSTRAINED SUBTYPE WITH DISCRIMINANTS AND THE INITIALIZATION
- --     VALUE DOES NOT BELONG TO THE SUBTYPE (I. E., THE DISCRIMINANT
- --     VALUE DOES NOT MATCH THOSE SPECIFIED BY THE CONSTRAINT).
- 
- -- HISTORY:
- --     RJW 08/25/86  CREATED ORIGINAL TEST
- --     VCL 08/19/87  CHANGED THE RETURN TYPE OF FUNTION 'INIT' IN
- --                   PACKAGE 'PRIV2' SO THAT 'INIT' IS UNCONSTRAINED,
- --                   THUS NOT RAISING A CONSTRAINT ERROR ON RETURN FROM
- --                   'INIT'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37209B IS
- 
- BEGIN
-      TEST ( "C37209B", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                        "THE SUBTYPE INDICATION IN A CONSTANT " &
-                        "OBJECT DECLARATION SPECIFIES A CONSTRAINED " &
-                        "SUBTYPE WITH DISCRIMINANTS AND THE " &
-                        "INITIALIZATION VALUE DOES NOT BELONG TO " &
-                        "THE SUBTYPE (I. E., THE DISCRIMINANT VALUE " &
-                        "DOES NOT MATCH THOSE SPECIFIED BY THE " &
-                        "CONSTRAINT)" );
-      DECLARE
- 
-           TYPE REC (D : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           SUBTYPE REC1 IS REC (IDENT_INT (5));
-      BEGIN
-           DECLARE
-                R1 : CONSTANT REC1 := (D => IDENT_INT (10));
-                I  : INTEGER := IDENT_INT (R1.D);
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED FOR DECLARATION OF " &
-                         "R1" );
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
-                         "R1" );
-      END;
- 
- 
-      BEGIN
-           DECLARE
-                PACKAGE PRIV1 IS
-                     TYPE REC (D : INTEGER) IS PRIVATE;
-                     SUBTYPE REC2 IS REC (IDENT_INT (5));
-                     R2 : CONSTANT REC2;
- 
-                PRIVATE
-                     TYPE REC (D : INTEGER) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
- 
-                     R2 : CONSTANT REC2 := (D => IDENT_INT (10));
-                END PRIV1;
- 
-                USE PRIV1;
- 
-           BEGIN
-                DECLARE
-                     I : INTEGER := IDENT_INT (R2.D);
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
-                              "OF R2" );
-               END;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
-                         "OF R2" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PACKAGE PRIV2 IS
-                     TYPE REC (D : INTEGER) IS PRIVATE;
-                     SUBTYPE REC3 IS REC (IDENT_INT (5));
- 
-                     FUNCTION INIT (D : INTEGER) RETURN REC;
-                PRIVATE
-                     TYPE REC (D : INTEGER) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
- 
-                END PRIV2;
- 
-                PACKAGE BODY PRIV2 IS
-                     FUNCTION INIT (D : INTEGER) RETURN REC IS
-                     BEGIN
-                          RETURN (D => IDENT_INT (D));
-                     END INIT;
-                END PRIV2;
- 
-                USE PRIV2;
- 
-           BEGIN
-                DECLARE
-                     R3 : CONSTANT REC3 := INIT (10);
-                     I  : INTEGER := IDENT_INT (R3.D);
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
-                              "OF R3" );
-               END;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
-                         "OF R3" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PACKAGE LPRIV IS
-                     TYPE REC  (D : INTEGER) IS
-                          LIMITED PRIVATE;
-                     SUBTYPE REC4 IS REC (IDENT_INT (5));
- 
-                     R4 : CONSTANT REC4;
- 
-                PRIVATE
-                     TYPE REC (D : INTEGER) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
- 
-                     R4 : CONSTANT REC4 := (D => IDENT_INT (10));
-                END LPRIV;
- 
-                USE LPRIV;
- 
-           BEGIN
-                DECLARE
-                     I : INTEGER := IDENT_INT (R4.D);
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
-                              "OF R4" );
-               END;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
-                         "OF R4" );
-      END;
- 
-      RESULT;
- END C37209B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37210a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37210a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37210a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C37210A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE EXPRESSION IN A DISCRIMINANT ASSOCIATION WITH MORE 
- -- THAN ONE NAME IS EVALUATED ONCE FOR EACH NAME.
- 
- -- R.WILLIAMS 8/28/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37210A IS
- 
-      BUMP : INTEGER := IDENT_INT (0);
- 
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN BUMP;
-      END F;
- 
-      FUNCTION CHECK (STR : STRING) RETURN INTEGER IS
-      BEGIN
-           IF BUMP /= 2 THEN
-                FAILED ( "INCORRECT DISCRIMINANT VALUES FOR " & STR);
-           END IF;
-           BUMP := IDENT_INT (0);
-           RETURN 5;
-      END CHECK;
-           
- BEGIN
-      TEST ( "C37210A", "CHECK THAT THE EXPRESSION IN A " &
-                        "DISCRIMINANT ASSOCIATION WITH MORE THAN " &
-                        "ONE NAME IS EVALUATED ONCE FOR EACH NAME" );
- 
-      DECLARE
-           TYPE REC (D1, D2 : INTEGER) IS
-                RECORD 
-                     NULL;
-                END RECORD;
- 
-           R : REC (D1 | D2 => F);
- 
-           I1 : INTEGER := CHECK ( "R" );
- 
-           TYPE ACC IS ACCESS REC;
- 
-           AC : ACC (D1 | D2 => F);
-      
-           I2 : INTEGER := CHECK ( "AC" );
-           
-           PACKAGE PKG IS
-                TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE; 
-                TYPE PACC IS ACCESS PRIV;
- 
-                TYPE LIM (D1, D2 : INTEGER) IS LIMITED PRIVATE;
-                TYPE LACC IS ACCESS LIM;
- 
-           PRIVATE
-                TYPE PRIV (D1, D2 : INTEGER) IS 
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TYPE LIM (D1, D2 : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PKG;                                  
-           
-           USE PKG;
- 
-      BEGIN
- 
-           DECLARE
-                P  : PRIV (D1 | D2 => F);
-                
-                I1 : INTEGER := CHECK ( "P" );
- 
-                PA : PACC (D1 | D2 => F);
- 
-                I2 : INTEGER := CHECK ( "PA" );
- 
-                L  : LIM (D1 | D2 => F);
-           
-                I3 : INTEGER := CHECK ( "L" );
- 
-                LA : LACC (D1 | D2 => F);
- 
-                I : INTEGER;
-           BEGIN
-                I := CHECK ( "LA" );
-           END;
-      END;
- 
-      RESULT;
- END C37210A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,242 ****
- -- C37211A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
- -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
- -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
- -- INDICATIONS WHERE THE TYPE MARK DENOTES A RECORD TYPE.
- 
- -- R.WILLIAMS 8/28/86
- -- EDS        7/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37211A IS
- 
-      TYPE REC (D : POSITIVE) IS
-           RECORD
-                NULL;
-           END RECORD;
-      
- BEGIN
-      TEST ( "C37211A", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
-                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
-                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
-                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
-                        "TYPE MARK DENOTES A RECORD TYPE" );
-                          
-      BEGIN
-           DECLARE
-                SUBTYPE SUBREC IS REC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     SR : SUBREC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF SUBTYPE SUBREC " & INTEGER'IMAGE(SR.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT SR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "SUBTYPE SUBREC" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE ARR IS ARRAY (1 .. 10) OF REC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     AR : ARR;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ARR " & INTEGER'IMAGE(AR(1).D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT AR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ARR" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE REC1 IS 
-                     RECORD
-                          X : REC (IDENT_INT (-1));
-                     END RECORD;
- 
-           BEGIN
-                DECLARE
-                     R1 : REC1;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1.X.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT R1" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE REC1" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE ACCREC IS ACCESS REC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     ACR : ACCREC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ACCREC " & INTEGER'IMAGE(ACR.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT ACR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ACCREC" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE NEWREC IS NEW REC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     NR : NEWREC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE NEWREC " & INTEGER'IMAGE(NR.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT NR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE NEWREC" );
-      END;
- 
-      BEGIN
-           DECLARE
-                R : REC (IDENT_INT (-1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
-                         "R " & INTEGER'IMAGE(R.D));
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
-                              "CONTAINING R" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
-                         "R" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE REC_NAME IS ACCESS REC;
-           BEGIN
-                DECLARE
-                     RN : REC_NAME := NEW REC (IDENT_INT (-1));
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "DECLARATION OF OBJECT RN " & INTEGER'IMAGE(RN.D));
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;               
-                WHEN OTHERS => 
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF OBJECT RN" );
-           END;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
-                         "REC_NAME" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE BAD_REC (D : POSITIVE := IDENT_INT (-1)) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           BEGIN
-                DECLARE
-                     BR : BAD_REC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "DECLARATION OF OBJECT BR " & INTEGER'IMAGE(BR.D));
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;               
-                WHEN OTHERS => 
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF OBJECT BR" );
-           END;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
-                         "BAD_REC" );
-      END;
- 
-      RESULT;
- END C37211A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,495 ****
- -- C37211B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
- -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
- -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
- -- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 
- -- PRIVATE TYPE, AND THE DISCRIMINANT CONSTRAINT OCCURS AFTER THE FULL 
- -- DECLARATION OF THE TYPE.
- 
- -- R.WILLIAMS 8/28/86
- -- EDS        7/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37211B IS
- 
-      SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
-      
-      PACKAGE PKG IS
-           TYPE PRIV (L : LIES) IS PRIVATE;
-           TYPE LIM  (L : LIES) IS LIMITED PRIVATE;
- 
-      PRIVATE
-           TYPE PRIV (L : LIES) IS 
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE LIM (L : LIES) IS
-                RECORD
-                     NULL;
-                END RECORD;
-      END PKG;     
-      
-      USE PKG;
- 
- BEGIN
-      TEST ( "C37211B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
-                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
-                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
-                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
-                        "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
-                        "PRIVATE TYPE, AND THE DISCRIMINANT " &
-                        "CONSTRAINT OCCURS AFTER THE FULL " & 
-                        "DECLARATION OF THE TYPE" );
-                          
-      BEGIN
-           DECLARE
-                SUBTYPE SUBPRIV IS PRIV (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     SP : SUBPRIV;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF SUBTYPE SUBPRIV " & 
-                              BOOLEAN'IMAGE(SP.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT SP" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "SUBTYPE SUBPRIV" );
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE SUBLIM IS LIM (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     SL : SUBLIM;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF SUBTYPE SUBLIM" & 
-                              BOOLEAN'IMAGE(SL.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT SL " );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "SUBTYPE SUBLIM" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE PARR IS ARRAY (1 .. 5) OF PRIV (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     PAR : PARR;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE PARR " & 
-                              BOOLEAN'IMAGE(PAR(1).L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT PAR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE PARR" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE LARR IS ARRAY (1 .. 10) OF LIM (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     LAR : LARR;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE LARR " & 
-                              BOOLEAN'IMAGE(LAR(1).L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT LAR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE LARR" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE PRIV1 IS 
-                     RECORD
-                          X : PRIV (IDENT_BOOL (TRUE));
-                     END RECORD;
- 
-           BEGIN
-                DECLARE
-                     P1 : PRIV1;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE PRIV1 " & 
-                              BOOLEAN'IMAGE(P1.X.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT P1" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE PRIV1" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE LIM1 IS 
-                     RECORD
-                          X : LIM (IDENT_BOOL (TRUE));
-                     END RECORD;
- 
-           BEGIN
-                DECLARE
-                     L1 : LIM1;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE LIM1 " & 
-                              BOOLEAN'IMAGE(L1.X.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT L1" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE LIM1" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE ACCPRIV IS ACCESS PRIV (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     ACP : ACCPRIV;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ACCPRIV " & 
-                              BOOLEAN'IMAGE(ACP.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT ACP" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ACCPRIV" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE ACCLIM IS ACCESS LIM (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     ACL : ACCLIM;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ACCLIM " & 
-                              BOOLEAN'IMAGE(ACL.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT ACL" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ACCLIM" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE NEWPRIV IS NEW PRIV (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     NP : NEWPRIV;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE NEWPRIV " & 
-                              BOOLEAN'IMAGE(NP.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT NP" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE NEWPRIV" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE NEWLIM IS NEW LIM (IDENT_BOOL (TRUE));
-           BEGIN
-                DECLARE
-                     NL : NEWLIM;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE NEWLIM " & 
-                              BOOLEAN'IMAGE(NL.L));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT NL" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE NEWLIM" );
-      END;
- 
-      BEGIN
-           DECLARE
-                P : PRIV (IDENT_BOOL (TRUE));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
-                         "P " & BOOLEAN'IMAGE(P.L));
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
-                              "CONTAINING P" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
-                         "P" );
-      END;
- 
-      BEGIN
-           DECLARE
-                L : LIM (IDENT_BOOL (TRUE));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
-                         "L " & BOOLEAN'IMAGE(L.L));
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
-                              "CONTAINING L" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
-                         "L" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE PRIV_NAME IS ACCESS PRIV;
-           BEGIN
-                DECLARE
-                     PN : PRIV_NAME := NEW PRIV (IDENT_BOOL (TRUE));
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "DECLARATION OF OBJECT PN " & 
-                              BOOLEAN'IMAGE(PN.L));
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;               
-                WHEN OTHERS => 
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF OBJECT PN" );
-           END;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
-                         "PRIV_NAME" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE LIM_NAME IS ACCESS LIM;
-           BEGIN
-                DECLARE
-                     LN : LIM_NAME := NEW LIM (IDENT_BOOL (TRUE));
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "DECLARATION OF OBJECT LN " & 
-                              BOOLEAN'IMAGE(LN.L));
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;               
-                WHEN OTHERS => 
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF OBJECT LN" );
-           END;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
-                         "LIM_NAME" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PACKAGE PP IS
-                     TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
-                          PRIVATE;
-                PRIVATE
-                     TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PP;
- 
-                USE PP;
-           BEGIN
-                DECLARE
-                     BP : BAD_PRIV;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "DECLARATION OF OBJECT BP " & 
-                              BOOLEAN'IMAGE(BP.D));
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;               
-                WHEN OTHERS => 
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF OBJECT BP" );
-           END;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
-                         "BAD_PRIV" );
-      END;
- 
-      BEGIN
-           DECLARE
-                PACKAGE PL IS
-                     TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
-                          LIMITED PRIVATE;
-                PRIVATE
-                     TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PL;
- 
-                USE PL;
-           BEGIN
-                DECLARE
-                     BL : BAD_LIM;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "DECLARATION OF OBJECT BL " & 
-                              BOOLEAN'IMAGE(BL.D));
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;               
-                WHEN OTHERS => 
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF OBJECT BL" );
-           END;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
-                         "BAD_LIM" );
-      END;
- 
-      RESULT;
- END C37211B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,426 ****
- -- C37211C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
- -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
- -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
- -- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 
- -- PRIVATE TYPE, THE DISCRIMINANT CONSTRAINT OCCURS BEFORE THE FULL 
- -- DECLARATION OF THE TYPE, AND THERE ARE NO COMPONENTS OF THE TYPE 
- -- DEPENDENT ON THE DISCRIMINANT.
- 
- -- R.WILLIAMS 8/28/86
- -- EDS        7/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37211C IS
- 
-      GLOBAL : BOOLEAN;
- 
-      SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
- 
-      FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
-      BEGIN
-           GLOBAL := B;
-           RETURN B;
-      END SWITCH;
-      
- BEGIN
-      TEST ( "C37211C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
-                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
-                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
-                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
-                        "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
-                        "PRIVATE TYPE, AND THE DISCRIMINANT " &
-                        "CONSTRAINT OCCURS BEFORE THE FULL " &
-                        "DECLARATION OF THE TYPE" );
-                          
-      BEGIN
-           DECLARE
-                                    
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PP IS
-                     TYPE PRIV1 (D : LIES) IS PRIVATE;
-                     SUBTYPE SUBPRIV IS PRIV1 (IDENT_BOOL (TRUE));
- 
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE PRIV1 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PP;
-                     
-                USE PP;
-           BEGIN
-                DECLARE
-                     SP : SUBPRIV;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF SUBTYPE SUBPRIV " & BOOLEAN'IMAGE(SP.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT SP" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE PRIV1 NOT SUBTYPE SUBPRIV" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "SUBTYPE SUBPRIV" );
-      END;
- 
-      BEGIN
-           DECLARE
-                                    
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PL IS
-                     TYPE LIM1 (D : LIES) IS LIMITED PRIVATE;
-                     SUBTYPE SUBLIM IS LIM1 (IDENT_BOOL (TRUE));
- 
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE LIM1 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PL;
-                     
-                USE PL;
-           BEGIN
-                DECLARE
-                     SL : SUBLIM;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF SUBTYPE SUBLIM " & BOOLEAN'IMAGE(SL.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT SL" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE LIM1 NOT SUBTYPE SUBLIM" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "SUBTYPE SUBLIM" );
-      END;
- 
-      BEGIN
-           DECLARE
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PP IS
-                     TYPE PRIV2 (D : LIES) IS PRIVATE;
-                     TYPE PARR IS ARRAY (1 .. 5) OF 
-                          PRIV2 (IDENT_BOOL (TRUE));
-      
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE PRIV2 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PP;
-                     
-                USE PP;
-           BEGIN
-                DECLARE
-                     PAR : PARR;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE PARR " & BOOLEAN'IMAGE(PAR(1).D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT PAR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE PRIV2 NOT TYPE PARR" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE PARR" );
-      END;
-           
-      BEGIN
-           DECLARE
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PL IS
-                     TYPE LIM2 (D : LIES) IS LIMITED PRIVATE;
-                     TYPE LARR IS ARRAY (1 .. 5) OF 
-                          LIM2 (IDENT_BOOL (TRUE));
-      
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE LIM2 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PL;
-                     
-                USE PL;
-           BEGIN
-                DECLARE
-                     LAR : LARR;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE LARR " & BOOLEAN'IMAGE(LAR(1).D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT LAR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE LIM2 NOT TYPE LARR" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE LARR" );
-      END;
-           
-      BEGIN
-           DECLARE
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PP IS
-                     TYPE PRIV3 (D : LIES) IS PRIVATE;
- 
-                     TYPE PRIV4 IS 
-                          RECORD
-                               X : PRIV3 (IDENT_BOOL (TRUE));
-                          END RECORD;
- 
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE PRIV3 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PP;
-                     
-                USE PP;
-           BEGIN
-                DECLARE
-                     P4 : PRIV4;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE PRIV4 " & BOOLEAN'IMAGE(P4.X.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT P4" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE PRIV3 NOT TYPE PRIV4" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE PRIV4" );
-      END;
-           
-      BEGIN
-           DECLARE
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PL IS
-                     TYPE LIM3 (D : LIES) IS LIMITED PRIVATE;
- 
-                     TYPE LIM4 IS 
-                          RECORD
-                               X : LIM3 (IDENT_BOOL (TRUE));
-                          END RECORD;
- 
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE LIM3 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PL;
-                     
-                USE PL;
-           BEGIN
-                DECLARE
-                     L4 : LIM4;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE LIM4 " & BOOLEAN'IMAGE(L4.X.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT L4" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE LIM3 NOT TYPE LIM4" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE LIM4" );
-      END;
-           
-      BEGIN
-           DECLARE
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PP IS
-                     TYPE PRIV5 (D : LIES) IS PRIVATE;
-                     TYPE ACCPRIV IS ACCESS PRIV5 (IDENT_BOOL (TRUE));
- 
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE PRIV5 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PP;
-                     
-                USE PP;
- 
-           BEGIN
-                DECLARE
-                     ACP : ACCPRIV;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ACCPRIV " & BOOLEAN'IMAGE(ACP.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT ACP" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE PRIV5 NOT TYPE ACCPRIV" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ACCPRIV" );
-      END;
-           
-      BEGIN
-           DECLARE
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                PACKAGE PL IS
-                     TYPE LIM5 (D : LIES) IS LIMITED PRIVATE;
-                     TYPE ACCLIM IS ACCESS LIM5 (IDENT_BOOL (TRUE));
- 
-                     B2 : BOOLEAN := SWITCH (FALSE);
- 
-                PRIVATE
-                     TYPE LIM5 (D : LIES) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END PL;
-                     
-                USE PL;
- 
-           BEGIN
-                DECLARE
-                     ACL : ACCLIM;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ACCLIM " & BOOLEAN'IMAGE(ACL.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT ACL" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE LIM5 NOT TYPE ACCLIM" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ACCLIM" );
-      END;
-           
-      RESULT;
- END C37211C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C37211D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
- -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
- -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
- -- INDICATIONS WHERE THE TYPE MARK DENOTES AN INCOMPLETE TYPE.
- 
- -- R.WILLIAMS 8/28/86
- -- EDS        7/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37211D IS
- 
-      GLOBAL : BOOLEAN;
- 
-      TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
- 
-      SUBTYPE WEEKDAY IS DAY RANGE MON .. FRI;
- 
-      FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
-      BEGIN
-           GLOBAL := B;
-           RETURN B;
-      END SWITCH;
-      
-      FUNCTION IDENT (D : DAY) RETURN DAY IS
-      BEGIN
-           RETURN DAY'VAL (IDENT_INT (DAY'POS (D)));
-      END IDENT;
- 
- BEGIN
-      TEST ( "C37211D", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
-                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
-                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
-                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
-                        "TYPE MARK DENOTES AN INCOMPLETE TYPE" );
-                          
-      BEGIN
-           DECLARE
-                                    
-                B1 : BOOLEAN := SWITCH (TRUE);
- 
-                TYPE REC (D : WEEKDAY);
- 
-                TYPE ACCREC IS ACCESS REC (IDENT (SUN));
- 
-                B2 : BOOLEAN := SWITCH (FALSE);
- 
-                TYPE REC (D : WEEKDAY) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           BEGIN
-                DECLARE
-                     AC : ACCREC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ACCREC " & DAY'IMAGE(AC.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT AC" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL THEN 
-                     NULL;
-                ELSE
-                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
-                              "FULL TYPE REC NOT TYPE ACCREC" );
-                END IF;                    
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ACCREC" );
-      END;
- 
-      RESULT;
- END C37211D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37211e.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37211e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,233 ****
- -- C37211E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
- -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
- -- OF THE DISCRIMINANT. 
- 
- -- R.WILLIAMS 8/28/86
- -- PWN 10/27/95  REMOVED CHECK WHERE CONSTRAINT RULES HAVE CHANGED.
- -- PWN 12/03/95  CORRECTED FORMATING PROBLEM.
- -- TMB 11/20/96  REINTRODUCED CHECK REMOVED ON 10/27 WITH ADA95 CHANGES
- -- TMB 12/2/96   DELETED CHECK OF CONSTRAINED ACCESS TYPE
- -- EDS 07/14/98  AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37211E IS
- 
-      TYPE REC (D : POSITIVE) IS
-           RECORD
-                NULL;
-           END RECORD;
-      
-      TYPE ACC IS ACCESS REC;
- BEGIN
-      TEST ( "C37211E", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
-                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
-                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
-                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
-                        "TYPE MARK DENOTES AN ACCESS TYPE" );
-                          
-      BEGIN
-           DECLARE
-                SUBTYPE SUBACC IS ACC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     SA : SUBACC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF SUBTYPE SUBACC " & 
-                              INTEGER'IMAGE(SA.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT SA" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "SUBTYPE SUBACC" );
-      END;
- 
-      BEGIN
-           DECLARE
-                TYPE ARR IS ARRAY (1 .. 10) OF ACC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     AR : ARR;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ARR " & 
-                              INTEGER'IMAGE(AR(1).D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT AR" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ARR" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE REC1 IS 
-                     RECORD
-                          X : ACC (IDENT_INT (-1));
-                     END RECORD;
- 
-           BEGIN
-                DECLARE
-                     R1 : REC1;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1.X.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT R1" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE REC1" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE ACCA IS ACCESS ACC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     ACA : ACCA;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE ACCA " & 
-                              INTEGER'IMAGE(ACA.ALL.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT ACA" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE ACCA" );
-      END;
-           
-      BEGIN
-           DECLARE
-                TYPE NEWACC IS NEW ACC (IDENT_INT (-1));
-           BEGIN
-                DECLARE
-                     NA : NEWACC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "ELABORATION OF TYPE NEWACC " & 
-                              INTEGER'IMAGE(NA.D));
-                END;
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
-                              "OBJECT NA" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
-                         "TYPE NEWACC" );
-      END;
- 
-      BEGIN
-           DECLARE
-                A : ACC (IDENT_INT (-1));
-           BEGIN
-                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
-                         "A " & INTEGER'IMAGE(A.D));
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
-                              "CONTAINING A" );
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
-                         "A" );
-      END;
- 
- 
-      BEGIN
-           DECLARE
-                TYPE BAD_ACC (D : POSITIVE := IDENT_INT (-1)) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           BEGIN
-                DECLARE
-                     BAC : BAD_ACC;
-                BEGIN
-                     FAILED ( "NO EXCEPTION RAISED AT THE " &
-                              "DECLARATION OF OBJECT BAC " & 
-                              INTEGER'IMAGE(BAC.D));
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
-                                   "DECLARING BAC" );
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;               
-                WHEN OTHERS => 
-                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
-                              "OF OBJECT BAC" );
-           END;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
-                         "BAD_ACC" );
-      END;
- 
-      RESULT;
- END C37211E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,241 ****
- -- C37213B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF
- --        A DISCRIMINANT CONSTRAINT
- -- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
- -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
- -- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
- --
- --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
- --      DECLARATION.
- 
- -- JBG 10/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37213B IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
-      TYPE REC (D1, D2 : SM) IS
-           RECORD NULL; END RECORD;
- 
-      F1_CONS : INTEGER := 2;
- 
-      FUNCTION CHK (
-           CONS    : INTEGER;
-           VALUE   : INTEGER;
-           MESSAGE : STRING) RETURN BOOLEAN IS
-      BEGIN
-           IF CONS /= VALUE THEN
-                FAILED (MESSAGE & ": CONS IS " &
-                        INTEGER'IMAGE(CONS));
-           END IF;
-           RETURN TRUE;
-      END CHK;
- 
-      FUNCTION F1 RETURN INTEGER IS
-      BEGIN
-           F1_CONS := F1_CONS - IDENT_INT(1);
-           RETURN F1_CONS;
-      END F1;
- 
- BEGIN
-      TEST ("C37213B", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
-                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
-                       "AND DISCRIMINANTS HAVE DEFAULTS");
- 
- -- CASE B
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := 1) IS
-                RECORD
-                     C1 : REC (D3, F1);       -- F1 EVALUATED
-                END RECORD;
-           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
-           X : CONS;             -- F1 NOT EVALUATED AGAIN
-           Y : CONS;             -- F1 NOT EVALUATED AGAIN
-           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
-      BEGIN
-           IF X /= (1, (1, 1)) OR Y /= (1, (1, 1)) THEN
-                FAILED ("DISCRIMINANT VALUES NOT CORRECT");
-           END IF;
-      END;
- 
-      F1_CONS := 12;
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := 1) IS
-                RECORD
-                     C1 : REC(D3, F1);
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
-                     IF X /= (1, (1, 1)) THEN
-                          COMMENT ("SHOULDN'T GET HERE");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS;
-                BEGIN
-                     X := NEW CONS;
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
-                     BEGIN
-                          IF X.ALL /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 3");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 4");
-                          IF X /= (1..5 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 5");
-                          IF X /= (C1 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE DREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : DREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 6");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
-           RESULT;
- 
- END C37213B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,240 ****
- -- C37213D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF
- --        AN INDEX CONSTRAINT
- -- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
- -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
- -- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
- --
- --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
- --      DECLARATION.
- 
- -- JBG 10/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37213D IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
-      TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
- 
-      F1_CONS : INTEGER := 2;
- 
-      FUNCTION CHK (
-           CONS    : INTEGER;
-           VALUE   : INTEGER;
-           MESSAGE : STRING) RETURN BOOLEAN IS
-      BEGIN
-           IF CONS /= VALUE THEN
-                FAILED (MESSAGE & ": CONS IS " &
-                        INTEGER'IMAGE(CONS));
-           END IF;
-           RETURN TRUE;
-      END CHK;
- 
-      FUNCTION F1 RETURN INTEGER IS
-      BEGIN
-           F1_CONS := F1_CONS - IDENT_INT(1);
-           RETURN F1_CONS;
-      END F1;
- 
- BEGIN
-      TEST ("C37213D", "CHECK EVALUATION OF INDEX BOUNDS " &
-                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
-                       "AND DISCRIMINANTS HAVE DEFAULTS");
- 
- -- CASE B
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := 1) IS
-                RECORD
-                     C1 : MY_ARR (F1..D3);    -- F1 EVALUATED.
-                END RECORD;
-           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
-           X : CONS;             -- F1 NOT EVALUATED AGAIN
-           Y : CONS;             -- F1 NOT EVALUATED AGAIN
-           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
-      BEGIN
-           IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
-                FAILED ("INDEX BOUNDS NOT CORRECT");
-           END IF;
-      END;
- 
-      F1_CONS := 12;
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := 1) IS
-                RECORD
-                     C1 : MY_ARR(D3..F1);
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     FAILED ("INDEX CHECK NOT PERFORMED - 1");
-                     IF X /= (1, (1, 1)) THEN
-                          COMMENT ("SHOULDN'T GET HERE");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS;
-                BEGIN
-                     X := NEW CONS;
-                     FAILED ("INDEX CHECK NOT PERFORMED - 2");
-                     BEGIN
-                          IF X.ALL /= (1, (1 => 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 3");
-                          IF X /= (1, (1 => 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 4");
-                          IF X /= (1..5 => (1, (1 => 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 5");
-                          IF X /= (C1 => (1, (1 => 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE DREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : DREC;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 6");
-                          IF X /= (1, (1 => 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
-           RESULT;
- 
- END C37213D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,379 ****
- -- C37213F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF
- --        A DISCRIMINANT CONSTRAINT
- -- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
- -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
- -- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
- --
- --   CASE D: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
- --      DECLARATION AND THE COMPONENT IS PRESENT IN THE DEFAULT SUBTYPE.
- 
- -- JBG 10/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37213F IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
-      TYPE REC (D1, D2 : SM) IS
-           RECORD NULL; END RECORD;
- 
-      F1_CONS : INTEGER := 2;
- 
-      FUNCTION CHK (
-           CONS    : INTEGER;
-           VALUE   : INTEGER;
-           MESSAGE : STRING) RETURN BOOLEAN IS
-      BEGIN
-           IF CONS /= VALUE THEN
-                FAILED (MESSAGE & ": CONS IS " &
-                        INTEGER'IMAGE(CONS));
-           END IF;
-           RETURN TRUE;
-      END CHK;
- 
-      FUNCTION F1 RETURN INTEGER IS
-      BEGIN
-           F1_CONS := F1_CONS - IDENT_INT(1);
-           RETURN F1_CONS;
-      END F1;
- 
- BEGIN
-      TEST ("C37213F", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
-                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
-                       "DISCRIMINANTS HAVE DEFAULTS, AND COMPONENT" &
-                       "SUBTYPE DETERMINES WHETHER CONSTRAINT SHOULD " &
-                       "BE CHECKED");
- 
- -- CASE D1: COMPONENT IS PRESENT
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(1)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : REC (D3, F1);       -- F1 EVALUATED
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(0);
-                     END CASE;
-                END RECORD;
-           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
-           X : CONS;             -- F1 NOT EVALUATED AGAIN
-           Y : CONS;             -- F1 NOT EVALUATED AGAIN
-           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
-      BEGIN
-           IF X /= (1, (1, 1)) OR Y /= (1, (1, 1)) THEN
-                FAILED ("DISCRIMINANT VALUES NOT CORRECT");
-           END IF;
-      END;
- 
-      F1_CONS := 12;
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(1)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : REC(D3, F1);
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(0);
-                     END CASE;
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
-                     IF X /= (1, (1, 1)) THEN
-                          COMMENT ("SHOULDN'T GET HERE");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS;
-                BEGIN
-                     X := NEW CONS;
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
-                     IF X.ALL /= (1, (1, 1)) THEN
-                          COMMENT ("IRRELEVANT");
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 3");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 4");
-                          IF X /= (1..5 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 5");
-                          IF X /= (C1 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE DREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : DREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 6");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
-           END;
- 
-      END;
- 
- -- CASE C2 : COMPONENT IS ABSENT
- 
-      F1_CONS := 2;
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(-6)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : REC (D3, F1);       -- F1 EVALUATED
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(0);
-                     END CASE;
-                END RECORD;
-           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED - 2");
-           X : CONS;             -- F1 NOT EVALUATED AGAIN
-           Y : CONS;             -- F1 NOT EVALUATED AGAIN
-           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED - 2");
-      BEGIN
-           IF X /= (-6, 0) OR Y /= (-6, 0) THEN
-                FAILED ("DISCRIMINANT VALUES NOT CORRECT");
-           END IF;
-      END;
- 
-      F1_CONS := 12;
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : REC(D3, F1);
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(0);
-                     END CASE;
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     IF X /= (11, 0) THEN
-                          FAILED ("WRONG VALUE FOR X - 11");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 11");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          IF X /= (11, 0) THEN
-                               FAILED ("X VALUE WRONG - 12");
-                          END IF;
-                     END;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 12");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                     X : ARR;
-                BEGIN
-                     IF X /= (1..5 => (11, 0)) THEN
-                          FAILED ("X VALUE INCORRECT - 13");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 13");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                     X : NREC;
-                BEGIN
-                     IF X /= (C1 => (11, 0)) THEN
-                          FAILED ("X VALUE IS INCORRECT - 14");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 14");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS NEW CONS;
-                     X : NREC;
-                BEGIN
-                     IF X /= (11, 0) THEN
-                          FAILED ("X VALUE INCORRECT - 15");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 15");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS := NEW CONS;
-                BEGIN
-                     IF X.ALL /= (11, 0) THEN
-                          FAILED ("X VALUE INCORRECT - 17");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 17");
-           END;
-      END;
- 
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
-           RESULT;
- 
- END C37213F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,457 ****
- -- C37213H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, WHERE AN INDEX CONSTRAINT DEPENDS ON A RECORD
- --     DISCRIMINANT WITH A DEFAULT VALUE AND THE RECORD TYPE IS NOT
- --     EXPLICITLY CONSTRAINED, THAT THE NON-DISCRIMINANT EXPRESSIONS
- --     IN THE INDEX CONSTRAINT ARE:
- --          1) EVALUATED WHEN THE RECORD COMPONENT SUBTYPE DEFINITION
- --             IS ELABORATED,
- --          2) PROPERLY CHECKED FOR COMPATIBILITY ONLY IN AN ALLOCATION
- --             OR OBJECT DECLARATION AND ONLY IF THE DISCRIMINANT-
- --             DEPENDENT COMPONENT IS PRESENT IN THE SUBTYPE.
- 
- -- HISTORY:
- --     JBG  10/17/86  CREATED ORIGINAL TEST.
- --     VCL  10/23/87  MODIFIED THIS HEADER; MODIFIED THE CHECK OF
- --                    SUBTYPE 'SCONS', IN BOTH SUBPARTS OF THE TEST,
- --                    TO INDICATE FAILURE IF CONSTRAINT_ERROR IS RAISED
- --                    FOR THE SUBTYPE DECLARATION AND FAILURE IF
- --                    CONSTRAINT_ERROR IS NOT RAISED FOR AN OBJECT
- --                    DECLARATION OF THIS SUBTYPE; RELOCATED THE CALL TO
- --                    REPORT.TEST SO THAT IT COMES BEFORE ANY
- --                    DECLARATIONS;  ADDED 'SEQUENCE_NUMBER' TO IDENTIFY
- --                    THE CURRENT SUBTEST (FOR EXCEPTIONS); CHANGE THE
- --                    TYPE OF THE DISCRIMINANT IN THE RECORD 'CONS'
- --                    TO AN INTEGER SUBTYPE.
- --     VCL  03/30/88  MODIFIED HEADER AND MESSAGES OUTPUT BY REPORT
- --                    PACKAGE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37213H IS
- BEGIN
-      TEST ("C37213H", "THE NON-DISCRIMINANT EXPRESSIONS OF AN " &
-                       "INDEX CONSTRAINT THAT DEPEND ON A " &
-                       "DISCRIMINANT WITH A DEFAULT VALUE ARE " &
-                       "PROPERLY EVALUATED AND CHECKED WHEN THE " &
-                       "RECORD TYPE IS NOT EXPLICITLY CONSTRAINED AND " &
-                       "THE COMPONENT IS AND IS NOT PRESENT IN THE " &
-                       "SUBTYPE");
- 
-      DECLARE
-           SEQUENCE_NUMBER : INTEGER;
- 
-           SUBTYPE DISCR IS INTEGER RANGE -50..50;
-           SUBTYPE SM IS INTEGER RANGE 1..10;
-           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
- 
-           F1_CONS : INTEGER := 2;
- 
-           FUNCTION CHK (
-                CONS    : INTEGER;
-                VALUE   : INTEGER;
-                MESSAGE : STRING) RETURN BOOLEAN IS
-           BEGIN
-                IF CONS /= VALUE THEN
-                     FAILED (MESSAGE & ": F1_CONS IS " &
-                             INTEGER'IMAGE(F1_CONS));
-                END IF;
-                RETURN TRUE;
-           END CHK;
- 
-           FUNCTION F1 RETURN INTEGER IS
-           BEGIN
-                F1_CONS := F1_CONS - IDENT_INT(1);
-                RETURN F1_CONS;
-           END F1;
-      BEGIN
- 
- 
- -- CASE 1: DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT.
- 
-           SEQUENCE_NUMBER :=1;
-           DECLARE
-                TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(F1..D3); -- F1 EVALUATED.
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(0);
-                          END CASE;
-                     END RECORD;
- 
-                CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
- 
-                X : CONS;                     -- F1 NOT EVALUATED AGAIN.
-                Y : CONS;                     -- F1 NOT EVALUATED AGAIN.
- 
-                CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
-           BEGIN
-                IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
-                     FAILED ("VALUES NOT CORRECT");
-                END IF;
-           END;
- 
- 
-           F1_CONS := 12;
- 
-           SEQUENCE_NUMBER := 2;
-           DECLARE
-                TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..F1);
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(0);
-                          END CASE;
-                     END RECORD;
-           BEGIN
-                BEGIN
-                     DECLARE
-                          X : CONS;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT PERFORMED - 1");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("INCORRECT VALUES FOR X - 1");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          SUBTYPE SCONS IS CONS;
-                     BEGIN
-                          DECLARE
-                               X : SCONS;
-                          BEGIN
-                               FAILED ("INDEX CHECK NOT PERFORMED - 2");
-                               IF X /= (1, (1, 1)) THEN
-                                    COMMENT ("INCORRECT VALUES FOR X " &
-                                             "- 2");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                                       "- 2A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE ARR IS ARRAY (1..5) OF CONS;
-                     BEGIN
-                          DECLARE
-                               X : ARR;
-                          BEGIN
-                               FAILED ("INDEX CHECK NOT PERFORMED - 3");
-                               IF X /= (1..5 => (1, (1, 1))) THEN
-                                    COMMENT ("INCORRECT VALUES FOR X " &
-                                             "- 3");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                                       "- 3A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE NREC IS
-                               RECORD
-                                    C1 : CONS;
-                               END RECORD;
-                     BEGIN
-                          DECLARE
-                               X : NREC;
-                          BEGIN
-                               FAILED ("INDEX CHECK NOT PERFORMED - 4");
-                               IF X /= (C1 => (1, (1, 1))) THEN
-                                    COMMENT ("INCORRECT VALUES FOR X " &
-                                             "- 4");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                                       "- 4A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE NREC IS NEW CONS;
-                     BEGIN
-                          DECLARE
-                               X : NREC;
-                          BEGIN
-                               FAILED ("INDEX CHECK NOT PERFORMED - 5");
-                               IF X /= (1, (1, 1)) THEN
-                                    COMMENT ("INCORRECT VALUES FOR X " &
-                                             "- 5");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                                        "- 5A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE ACC_CONS IS ACCESS CONS;
-                     BEGIN
-                          DECLARE
-                               X : ACC_CONS;
-                          BEGIN
-                               X := NEW CONS;
-                               FAILED ("INDEX CHECK NOT PERFORMED - 6");
-                               IF X.ALL /= (1, (1, 1)) THEN
-                                    COMMENT ("INCORRECT VALUES FOR X " &
-                                             "- 6");
-                               END IF;
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    COMMENT ("UNEXPECTED EXCEPTION " &
-                                             "RAISED - 6A");
-                          END;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               COMMENT ("UNEXPECTED EXCEPTION RAISED " &
-                                        "- 6B");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
-                END;
-           END;
- 
- 
- -- CASE D2: DISCRIMINANT-DEPENDENT COMPONENT IS ABSENT.
- 
-           F1_CONS := 2;
- 
-           SEQUENCE_NUMBER := 3;
-           DECLARE
-                TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..F1); -- F1 EVALUATED.
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(0);
-                          END CASE;
-                     END RECORD;
-                CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
- 
-                X : CONS;                      -- F1 NOT EVALUATED AGAIN.
-                Y : CONS;                      -- F1 NOT EVALUATED AGAIN.
- 
-                CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
-           BEGIN
-                IF X /= (-6, 0) OR Y /= (-6, 0) THEN
-                     FAILED ("VALUES NOT CORRECT");
-                END IF;
-           END;
- 
-           F1_CONS := 12;
- 
-           SEQUENCE_NUMBER := 4;
-           DECLARE
-                TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..F1);
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(0);
-                          END CASE;
-                     END RECORD;
-           BEGIN
-                BEGIN
-                     DECLARE
-                          X : CONS;
-                     BEGIN
-                          IF X /= (11, 0) THEN
-                               FAILED ("X VALUE IS INCORRECT - 11");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          SUBTYPE SCONS IS CONS;
-                     BEGIN
-                          DECLARE
-                               X : SCONS;
-                          BEGIN
-                               IF X /= (11, 0) THEN
-                                    FAILED ("X VALUE INCORRECT - 12");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
-                                       "12A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE ARR IS ARRAY (1..5) OF CONS;
-                     BEGIN
-                          DECLARE
-                               X : ARR;
-                          BEGIN
-                               IF X /= (1..5 => (11, 0)) THEN
-                                    FAILED ("X VALUE INCORRECT - 13");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
-                                       "13A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE NREC IS
-                               RECORD
-                                    C1 : CONS;
-                               END RECORD;
-                     BEGIN
-                          DECLARE
-                               X : NREC;
-                          BEGIN
-                               IF X /= (C1 => (11, 0)) THEN
-                                    FAILED ("X VALUE INCORRECT - 14");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
-                                       "14A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE NREC IS NEW CONS;
-                     BEGIN
-                          DECLARE
-                               X : NREC;
-                          BEGIN
-                               IF X /= (11, 0) THEN
-                                    FAILED ("X VALUE INCORRECT - 15");
-                               END IF;
-                          END;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
-                                       "15A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          TYPE ACC_CONS IS ACCESS CONS;
-                          X : ACC_CONS;
-                     BEGIN
-                          X := NEW CONS;
-                          IF X.ALL /= (11, 0) THEN
-                               FAILED ("X VALUE INCORRECT - 17");
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
-                                       "17A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                           FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &
-                        INTEGER'IMAGE (SEQUENCE_NUMBER));
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                        INTEGER'IMAGE (SEQUENCE_NUMBER));
-      END;
- 
-      RESULT;
- END C37213H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213j.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,320 ****
- -- C37213J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
- --     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
- --     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN
- --     OBJECT OR A SUBTYPE, THAT THE NON-DISCRIMINANT EXPRESSIONS
- --     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
- --          1) ONLY IN AN OBJECT DECLARATION, AND
- --          2) ONLY IF THE DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT
- --             IN THE SUBTYPE.
- 
- -- HISTORY:
- --     JBG  10/17/86  CREATED ORIGINAL TEST.
- --     VCL  10/23/87  MODIFIED THIS HEADER; SEPARATED THIS TEST INTO
- --                    3 NEW TESTS (J,K,L); CHANGED THE AGGREGATE FOR
- --                    THE PARAMETER 'VALUE' IN THE CALL OF PROCEDURE
- --                    'SUBTYPE_CHK1';  MOVED THE CALL TO REPORT.TEST
- --                    SO THAT IT COMES BEFORE ANY DECLARATIONS; ADDED
- --                    A SEQUENCE COUNTER TO IDENTIFY WHICH SUBTEST
- --                    DECLARATION PART RAISES CONSTRAINT_ERROR.
- --     VCL  03/28/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
- --                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
- --                    PARAMETERS TO THE GENERIC UNITS AND THE
- --                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
- --                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
- --                    ARE TOGETHER.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37213J IS
- BEGIN
-      TEST ("C37213J", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
-                       "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
-                       "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
-                       "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
-                       "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
-                       "FORMAL TYPE USED TO DECLARE AN OBJECT OR A " &
-                       "SUBTYPE");
- 
-      DECLARE
-           SUBTYPE SM IS INTEGER RANGE 1..10;
-           TYPE REC (D1, D2 : SM) IS
-                RECORD NULL; END RECORD;
-           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
- 
-           SEQUENCE_NUMBER : INTEGER;
- 
-           GENERIC
-                TYPE CONS IS PRIVATE;
-                OBJ_XCP : BOOLEAN;
-                TAG     : STRING;
-           PACKAGE OBJ_CHK IS END OBJ_CHK;
- 
-           GENERIC
-                TYPE CONS IS PRIVATE;
-           PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
-                                 TAG     : STRING);
- 
-           PACKAGE BODY OBJ_CHK IS
-           BEGIN          -- DECLARE AN OBJECT OF THE FORMAL TYPE.
-                DECLARE
-                     X : CONS;
- 
-                     FUNCTION VALUE RETURN CONS IS
-                     BEGIN
-                          IF EQUAL (3,3) THEN
-                               RETURN X;
-                          ELSE
-                               RETURN X;
-                          END IF;
-                     END VALUE;
-                BEGIN
-                     IF OBJ_XCP THEN
-                          FAILED ("NO CHECK DURING DECLARATION " &
-                                  "OF OBJECT OF TYPE CONS - " & TAG);
-                     ELSIF X /= VALUE THEN
-                          FAILED ("INCORRECT VALUE FOR OBJECT OF " &
-                                  "TYPE CONS - " & TAG);
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT OBJ_XCP THEN
-                          FAILED ("IMPROPER CONSTRAINT CHECKED " &
-                                  "DURING DECLARATION OF OBJECT " &
-                                  "OF TYPE CONS - " & TAG);
-                     END IF;
-           END OBJ_CHK;
- 
-           PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
-                                 TAG     : STRING)    IS
-           BEGIN          -- DECLARE A SUBTYPE OF THE FORMAL TYPE.
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
- 
-                          FUNCTION VALUE RETURN SCONS IS
-                          BEGIN
-                               IF EQUAL (5, 5) THEN
-                                    RETURN X;
-                               ELSE
-                                    RETURN X;
-                               END IF;
-                          END VALUE;
-                     BEGIN
-                          IF OBJ_XCP THEN
-                               FAILED ("NO CHECK DURING DECLARATION " &
-                                       "OF OBJECT OF SUBTYPE SCONS - " &
-                                       TAG);
-                          ELSIF X /= VALUE THEN
-                               FAILED ("INCORRECT VALUE FOR OBJECT " &
-                                       "OF SUBTYPE SCONS - " & TAG);
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          IF NOT OBJ_XCP THEN
-                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
-                                       "DURING DECLARATION OF OBJECT " &
-                                       "OF SUBTYPE SCONS - " & TAG);
-                          END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
-                             "DURING SUBTYPE DECLARATION - " & TAG);
-           END SUBTYP_CHK;
-      BEGIN
-           SEQUENCE_NUMBER := 1;
-           DECLARE
-                TYPE REC_DEF (D3 : INTEGER := 1) IS
-                     RECORD
-                          C1 : REC (D3, 0);
-                     END RECORD;
- 
-                PACKAGE PACK1 IS NEW OBJ_CHK (REC_DEF,
-                          OBJ_XCP => TRUE,
-                          TAG     => "PACK1");
- 
-                PROCEDURE PROC1 IS NEW SUBTYP_CHK (REC_DEF);
-           BEGIN
-                PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
-           END;
- 
-           SEQUENCE_NUMBER := 2;
-           DECLARE
-                TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
-                     RECORD
-                          C1 : MY_ARR (0..D3);
-                     END RECORD;
- 
-                PACKAGE PACK2 IS NEW OBJ_CHK (ARR_DEF,
-                          OBJ_XCP => TRUE,
-                          TAG     => "PACK2");
- 
-                PROCEDURE PROC2 IS NEW SUBTYP_CHK (ARR_DEF);
-           BEGIN
-                PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
-           END;
- 
- 
-           SEQUENCE_NUMBER := 3;
-           DECLARE
-                TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK3 IS NEW OBJ_CHK (VAR_REC_DEF1,
-                               OBJ_XCP => TRUE,
-                               TAG     => "PACK3");
- 
-                PROCEDURE PROC3 IS NEW SUBTYP_CHK (VAR_REC_DEF1);
-           BEGIN
-                PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
-           END;
- 
-           SEQUENCE_NUMBER := 4;
-           DECLARE
-                TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK4 IS NEW OBJ_CHK (VAR_REC_DEF6,
-                               OBJ_XCP => FALSE,
-                               TAG     => "PACK4");
- 
-                PROCEDURE PROC4 IS NEW SUBTYP_CHK (VAR_REC_DEF6);
-           BEGIN
-                PROC4 (OBJ_XCP => FALSE,TAG => "PROC4");
-           END;
- 
-           SEQUENCE_NUMBER := 5;
-           DECLARE
-                TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK5 IS NEW OBJ_CHK (VAR_REC_DEF11,
-                               OBJ_XCP => FALSE,
-                               TAG     => "PACK5");
- 
-                PROCEDURE PROC5 IS NEW SUBTYP_CHK (VAR_REC_DEF11);
-           BEGIN
-                PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
-           END;
- 
-           SEQUENCE_NUMBER := 6;
-           DECLARE
-                TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK6 IS NEW OBJ_CHK (VAR_ARR_DEF1,
-                               OBJ_XCP => TRUE,
-                               TAG     => "PACK6");
- 
-                PROCEDURE PROC6 IS NEW SUBTYP_CHK (VAR_ARR_DEF1);
-           BEGIN
-                PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
-           END;
- 
-           SEQUENCE_NUMBER := 7;
-           DECLARE
-                TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK7 IS NEW OBJ_CHK (VAR_ARR_DEF6,
-                               OBJ_XCP => FALSE,
-                               TAG     => "PACK7");
- 
-                PROCEDURE PROC7 IS NEW SUBTYP_CHK (VAR_ARR_DEF6);
-           BEGIN
-                PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
-           END;
- 
-           SEQUENCE_NUMBER := 8;
-           DECLARE
-                TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK8 IS NEW OBJ_CHK (VAR_ARR_DEF11,
-                               OBJ_XCP => FALSE,
-                               TAG     => "PACK8");
- 
-                PROCEDURE PROC8 IS NEW SUBTYP_CHK (VAR_ARR_DEF11);
-           BEGIN
-                PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
-           END;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED DURING DECLARATION / " &
-                        "INSTANTIATION ELABORATION - " &
-                        INTEGER'IMAGE(SEQUENCE_NUMBER));
-      END;
- 
-      RESULT;
- END C37213J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213k.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,324 ****
- -- C37213K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
- --     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
- --     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN
- --     ARRAY OR RECORD COMPONENT, THAT THE NON-DISCRIMINANT EXPRESSIONS
- --     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
- --          1) ONLY IN AN OBJECT DECLARATION, AND
- --          2) ONLY IF THE DESCRIMINANT-DEPENDENT COMPONENT IS PRESENT
- --             IN THE SUBTYPE.
- 
- -- HISTORY:
- --     VCL  10/23/88  CREATED ORIGINAL TEST BY SPLITTING FROM C37213J.
- --     VCL  03/30/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
- --                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
- --                    PARAMETERS TO THE GENERIC UNITS AND THE
- --                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
- --                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
- --                    ARE TOGETHER;  REWROTE ONE OF THE GENERIC
- --                    PACKAGES AS A GENERIC PROCEDURE TO BROADEN
- --                    COVERAGE OF TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37213K IS
- BEGIN
-      TEST ("C37213K", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
-                       "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
-                       "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
-                       "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
-                       "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
-                       "FORMAL TYPE USED TO DECLARE AN ARRAY OR A " &
-                       "RECORD COMPONENT");
- 
-      DECLARE
-           SUBTYPE SM IS INTEGER RANGE 1..10;
-           TYPE REC (D1, D2 : SM) IS
-                RECORD NULL; END RECORD;
-           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
- 
-           SEQUENCE_NUMBER : INTEGER;
- 
-           GENERIC
-                TYPE CONS IS PRIVATE;
-                OBJ_XCP : BOOLEAN;
-                TAG     : STRING;
-           PACKAGE ARRAY_COMP_CHK IS END ARRAY_COMP_CHK;
- 
-           PACKAGE BODY ARRAY_COMP_CHK IS
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
- 
-                          FUNCTION VALUE RETURN ARR IS
-                          BEGIN
-                               IF EQUAL (3,3) THEN
-                                    RETURN X;
-                               ELSE
-                                    RETURN X;
-                               END IF;
-                          END VALUE;
-                     BEGIN
-                          IF OBJ_XCP THEN
-                               FAILED ("NO CHECK DURING DECLARATION " &
-                                       "OF OBJECT OF TYPE ARR - " & TAG);
-                          ELSIF X /= VALUE THEN
-                               FAILED ("INCORRECT VALUE FOR OBJECT OF " &
-                                       "TYPE ARR - " & TAG);
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          IF NOT OBJ_XCP THEN
-                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
-                                       "DURING DECLARATION OF OBJECT " &
-                                       "OF TYPE ARR - " & TAG);
-                          END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
-                             "DURING DECLARATION OF ARR - " & TAG);
-           END ARRAY_COMP_CHK;
- 
-           GENERIC
-                TYPE CONS IS PRIVATE;
-           PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN;
-                                   TAG     : STRING);
- 
-           PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN;
-                                   TAG     : STRING)   IS
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
- 
-                          FUNCTION VALUE RETURN NREC IS
-                          BEGIN
-                               IF EQUAL (5, 5) THEN
-                                    RETURN X;
-                               ELSE
-                                    RETURN X;
-                               END IF;
-                          END VALUE;
-                     BEGIN
-                          IF OBJ_XCP THEN
-                               FAILED ("NO CHECK DURING DECLARATION " &
-                                       "OF OBJECT OF TYPE NREC - " &
-                                       TAG);
-                          ELSIF X /= VALUE THEN
-                               FAILED ("INCORRECT VALUE FOR OBJECT " &
-                                       "OF TYPE NREC - " & TAG);
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          IF NOT OBJ_XCP THEN
-                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
-                                       "DURING DECLARATION OF OBJECT " &
-                                       "OF TYPE NREC - " & TAG);
-                          END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
-                             "DURING DECLARATION OF NREC - " & TAG);
-           END;
-      BEGIN
-           SEQUENCE_NUMBER := 1;
-           DECLARE
-                TYPE REC_DEF (D3 : INTEGER := 1) IS
-                     RECORD
-                          C1 : REC (D3, 0);
-                     END RECORD;
- 
-                PACKAGE PACK1 IS NEW ARRAY_COMP_CHK (REC_DEF,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK1");
- 
-                PROCEDURE PROC1 IS NEW REC_COMP_CHK (REC_DEF);
-           BEGIN
-                PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
-           END;
- 
-           SEQUENCE_NUMBER := 2;
-           DECLARE
-                TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
-                     RECORD
-                          C1 : MY_ARR (0..D3);
-                     END RECORD;
- 
-                PACKAGE PACK2 IS NEW ARRAY_COMP_CHK (ARR_DEF,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK2");
- 
-                PROCEDURE PROC2 IS NEW REC_COMP_CHK (ARR_DEF);
-           BEGIN
-                PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
-           END;
- 
-           SEQUENCE_NUMBER := 3;
-           DECLARE
-                TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK3 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF1,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK3");
- 
-                PROCEDURE PROC3 IS NEW REC_COMP_CHK (VAR_REC_DEF1);
-           BEGIN
-                PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
-           END;
- 
-           SEQUENCE_NUMBER := 4;
-           DECLARE
-                TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK4 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF6,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK4");
- 
-                PROCEDURE PROC4 IS NEW REC_COMP_CHK (VAR_REC_DEF6);
-           BEGIN
-                PROC4 (OBJ_XCP => FALSE, TAG => "PROC4");
-           END;
- 
-           SEQUENCE_NUMBER := 5;
-           DECLARE
-                TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK5 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF11,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK5");
- 
-                PROCEDURE PROC5 IS NEW REC_COMP_CHK (VAR_REC_DEF11);
-           BEGIN
-                PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
-           END;
- 
-           SEQUENCE_NUMBER := 6;
-           DECLARE
-                TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK6 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF1,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK6");
- 
-                PROCEDURE PROC6 IS NEW REC_COMP_CHK (VAR_ARR_DEF1);
-           BEGIN
-                PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
-           END;
- 
-           SEQUENCE_NUMBER := 7;
-           DECLARE
-                TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK7 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF6,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK7");
- 
-                PROCEDURE PROC7 IS NEW REC_COMP_CHK (VAR_ARR_DEF6);
-           BEGIN
-                PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
-           END;
- 
-           SEQUENCE_NUMBER := 8;
-           DECLARE
-                TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK8 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF11,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK8");
- 
-                PROCEDURE PROC8 IS NEW REC_COMP_CHK (VAR_ARR_DEF11);
-           BEGIN
-                PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
-                        "DECLARATION / INSTANTIATION ELABORATION - " &
-                        INTEGER'IMAGE (SEQUENCE_NUMBER));
-      END;
- 
-      RESULT;
- END C37213K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37213l.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37213l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,329 ****
- -- C37213L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
- --     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
- --     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE A
- --     DERIVED OR AN ACCESS TYPE, THAT THE NON-DISCRIMINANT EXPRESSIONS
- --     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
- --          1) ONLY IN AN OBJECT DECLARATION OR ALLOCATOR, AND
- --          2) ONLY IF THE DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT
- --             IN THE SUBTYPE.
- 
- -- HISTORY:
- --     VCL  10/23/88  CREATED ORIGINAL TEST BY SPLITTING FROM C37213J.
- --     VCL  03/30/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
- --                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
- --                    PARAMETERS TO THE GENERIC UNITS AND THE
- --                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
- --                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
- --                    ARE TOGETHER;  REWROTE ONE OF THE GENERIC
- --                    PACKAGES AS A GENERIC PROCEDURE TO BROADEN
- --                    COVERAGE OF TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37213L IS
- BEGIN
-      TEST ("C37213L", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
-                       "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
-                       "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
-                       "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
-                       "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
-                       "FORMAL TYPE USED TO DECLARE A DERIVED OR AN " &
-                       "ACCESS TYPE");
- 
-      DECLARE
-           SUBTYPE SM IS INTEGER RANGE 1..10;
-           TYPE REC (D1, D2 : SM) IS
-                RECORD NULL; END RECORD;
-           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
- 
-           SEQUENCE_NUMBER : INTEGER;
- 
-           GENERIC
-                TYPE CONS IS PRIVATE;
-                OBJ_XCP : BOOLEAN;
-                TAG     : STRING;
-           PACKAGE DER_CHK IS  END DER_CHK;
- 
-           PACKAGE BODY DER_CHK IS
-           BEGIN
-                DECLARE
-                     TYPE DREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : DREC;
- 
-                          FUNCTION VALUE RETURN DREC IS
-                          BEGIN
-                               IF EQUAL (3,3) THEN
-                                    RETURN X;
-                               ELSE
-                                    RETURN X;
-                               END IF;
-                          END VALUE;
-                     BEGIN
-                          IF OBJ_XCP THEN
-                               FAILED ("NO CHECK DURING DECLARATION " &
-                                       "OF OBJECT OF TYPE DREC - " &
-                                       TAG);
-                          ELSIF X /= VALUE THEN
-                               FAILED ("INCORRECT VALUE FOR OBJECT OF " &
-                                       "TYPE DREC - " & TAG);
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          IF NOT OBJ_XCP THEN
-                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
-                                       "DURING DECLARATION OF OBJECT " &
-                                       "OF TYPE DREC - " & TAG);
-                          END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
-                             "DURING DECLARATION OF DREC - " & TAG);
-           END;
- 
-           GENERIC
-                TYPE CONS IS PRIVATE;
-           PROCEDURE ACC_CHK (OBJ_XCP : BOOLEAN;
-                              TAG     : STRING);
- 
-           PROCEDURE ACC_CHK (OBJ_XCP : BOOLEAN;
-                              TAG     : STRING)  IS
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                BEGIN
-                     DECLARE
-                          X : ACC_CONS;
- 
-                          FUNCTION VALUE RETURN CONS IS
-                          BEGIN
-                               IF EQUAL (5, 5) THEN
-                                    RETURN X.ALL;
-                               ELSE
-                                    RETURN X.ALL;
-                               END IF;
-                          END VALUE;
-                     BEGIN
-                          X := NEW CONS;
- 
-                          IF OBJ_XCP THEN
-                               FAILED ("NO CHECK DURING ALLOCATION " &
-                                       "OF OBJECT OF TYPE CONS - " &
-                                       TAG);
-                          ELSIF X.ALL /= VALUE THEN
-                               FAILED ("INCORRECT VALUE FOR OBJECT " &
-                                       "OF TYPE CONS - " & TAG);
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               IF NOT OBJ_XCP THEN
-                                    FAILED ("IMPROPER CONSTRAINT " &
-                                            "CHECKED DURING " &
-                                            "ALLOCATION OF OBJECT " &
-                                            "OF TYPE CONS - " & TAG);
-                               END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
-                                  "DURING DECLARATION OF X - " & TAG);
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
-                             "DURING DECLARATION OF ACC_CONS - " & TAG);
-           END ACC_CHK;
-      BEGIN
-           SEQUENCE_NUMBER := 1;
-           DECLARE
-                TYPE REC_DEF (D3 : INTEGER := 1) IS
-                     RECORD
-                          C1 : REC (D3, 0);
-                     END RECORD;
- 
-                PACKAGE PACK1 IS NEW DER_CHK (REC_DEF,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK1");
- 
-                PROCEDURE PROC1 IS NEW ACC_CHK (REC_DEF);
-           BEGIN
-                PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
-           END;
- 
-           SEQUENCE_NUMBER := 2;
-           DECLARE
-                TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
-                     RECORD
-                          C1 : MY_ARR (0..D3);
-                     END RECORD;
- 
-                PACKAGE PACK2 IS NEW DER_CHK (ARR_DEF,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK2");
- 
-                PROCEDURE PROC2 IS NEW ACC_CHK (ARR_DEF);
-           BEGIN
-                PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
-           END;
- 
-           SEQUENCE_NUMBER := 3;
-           DECLARE
-                TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK3 IS NEW DER_CHK (VAR_REC_DEF1,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK3");
- 
-                PROCEDURE PROC3 IS NEW ACC_CHK (VAR_REC_DEF1);
-           BEGIN
-                PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
-           END;
- 
-           SEQUENCE_NUMBER := 4;
-           DECLARE
-                TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK4 IS NEW DER_CHK (VAR_REC_DEF6,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK4");
- 
-                PROCEDURE PROC4 IS NEW ACC_CHK (VAR_REC_DEF6);
-           BEGIN
-                PROC4 (OBJ_XCP => FALSE, TAG => "PROC4");
-           END;
- 
-           SEQUENCE_NUMBER := 5;
-           DECLARE
-                TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : REC (D3, IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK5 IS NEW DER_CHK (VAR_REC_DEF11,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK5");
- 
-                PROCEDURE PROC5 IS NEW ACC_CHK (VAR_REC_DEF11);
-           BEGIN
-                PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
-           END;
- 
-           SEQUENCE_NUMBER := 6;
-           DECLARE
-                TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK6 IS NEW DER_CHK (VAR_ARR_DEF1,
-                                   OBJ_XCP => TRUE,
-                                   TAG     => "PACK6");
- 
-                PROCEDURE PROC6 IS NEW ACC_CHK (VAR_ARR_DEF1);
-           BEGIN
-                PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
-           END;
- 
-           SEQUENCE_NUMBER := 7;
-           DECLARE
-                TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK7 IS NEW DER_CHK (VAR_ARR_DEF6,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK7");
- 
-                PROCEDURE PROC7 IS NEW ACC_CHK (VAR_ARR_DEF6);
-           BEGIN
-                PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
-           END;
- 
-           SEQUENCE_NUMBER := 8;
-           DECLARE
-                TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
-                     RECORD
-                          CASE D3 IS
-                               WHEN -5..10 =>
-                                    C1 : MY_ARR(D3..IDENT_INT(11));
-                               WHEN OTHERS =>
-                                    C2 : INTEGER := IDENT_INT(5);
-                          END CASE;
-                     END RECORD;
- 
-                PACKAGE PACK8 IS NEW DER_CHK (VAR_ARR_DEF11,
-                                   OBJ_XCP => FALSE,
-                                   TAG     => "PACK8");
- 
-                PROCEDURE PROC8 IS NEW ACC_CHK (VAR_ARR_DEF11);
-           BEGIN
-                PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
-                        "DECLARATION / INSTANTIATION ELABORATION - " &
-                        INTEGER'IMAGE (SEQUENCE_NUMBER));
-      END;
- 
-      RESULT;
- END C37213L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,203 ****
- -- C37215B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF
- --        A DISCRIMINANT CONSTRAINT
- -- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
- -- COMPATIBILITY WHEN THE RECORD TYPE IS:
- --
- --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
- --      DECLARATION.
- 
- -- JBG 10/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37215B IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
-      TYPE REC (D1, D2 : SM) IS
-           RECORD NULL; END RECORD;
- 
- BEGIN
-      TEST ("C37215B", "CHECK COMPATIBILITY OF DISCRIMINANT EXPRESSIONS"&
-                       " WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
-                       "AND DISCRIMINANTS HAVE DEFAULTS");
- 
- -- CASE B
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
-                RECORD
-                     C1 : REC(D3, 1);
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
-                     IF X /= (1, (1, 1)) THEN
-                          COMMENT ("SHOULDN'T GET HERE");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS;
-                BEGIN
-                     X := NEW CONS;
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
-                     BEGIN
-                          IF X.ALL /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 3");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 4");
-                          IF X /= (1..5 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 5");
-                          IF X /= (C1 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE DREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : DREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 6");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
-           RESULT;
- 
- END C37215B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215d.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,202 ****
- -- C37215D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF
- --        AN INDEX CONSTRAINT
- -- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
- -- COMPATIBILITY WHEN THE RECORD TYPE IS:
- --
- --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
- --      DECLARATION.
- 
- -- JBG 10/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37215D IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
-      TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
- 
- BEGIN
-      TEST ("C37215D", "CHECK COMPATIBILITY OF INDEX BOUNDS " &
-                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
-                       "AND DISCRIMINANTS HAVE DEFAULTS");
- 
- -- CASE B
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
-                RECORD
-                     C1 : MY_ARR(2..D3);
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     FAILED ("INDEX CHECK NOT PERFORMED - 1");
-                     IF X /= (1, (1, 1)) THEN
-                          COMMENT ("SHOULDN'T GET HERE");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS;
-                BEGIN
-                     X := NEW CONS;
-                     FAILED ("INDEX CHECK NOT PERFORMED - 2");
-                     BEGIN
-                          IF X.ALL /= (1, (1 => 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 3");
-                          IF X /= (1, (1 => 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 4");
-                          IF X /= (1..5 => (1, (1 => 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 5");
-                          IF X /= (C1 => (1, (1 => 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE DREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : DREC;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT " &
-                                  "PERFORMED - 6");
-                          IF X /= (1, (1 => 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
-           RESULT;
- 
- END C37215D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215f.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,313 ****
- -- C37215F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF
- --        A DISCRIMINANT CONSTRAINT
- -- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
- -- COMPATIBILITY WHEN THE RECORD TYPE IS:
- --
- --   CASE D: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
- --      DECLARATION AND THE COMPONENT IS PRESENT IN THE DEFAULT SUBTYPE.
- 
- -- JBG 10/17/86
- -- PWN 05/31/96  Corrected format of call to "TEST" 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37215F IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
-      TYPE REC (D1, D2 : SM) IS
-           RECORD NULL; END RECORD;
- 
- BEGIN
-      TEST ("C37215F", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
-                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
-                       "DISCRIMINANTS HAVE DEFAULTS, AND COMPONENT " &
-                       "SUBTYPE DETERMINES WHETHER CONSTRAINT SHOULD " &
-                       "BE CHECKED");
- 
- -- CASE D1: COMPONENT IS PRESENT
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : REC(D3, 1);
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(0);
-                     END CASE;
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
-                     IF X /= (1, (1, 1)) THEN
-                          COMMENT ("SHOULDN'T GET HERE");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS;
-                BEGIN
-                     X := NEW CONS;
-                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
-                     IF X.ALL /= (1, (1, 1)) THEN
-                          COMMENT ("IRRELEVANT");
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 3");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 4");
-                          IF X /= (1..5 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 5");
-                          IF X /= (C1 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE DREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : DREC;
-                     BEGIN
-                          FAILED ("DISCRIMINANT CHECK NOT " &
-                                  "PERFORMED - 6");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
-           END;
- 
-      END;
- 
- -- CASE C2 : COMPONENT IS ABSENT
- 
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : REC(D3, IDENT_INT(1));
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(5);
-                     END CASE;
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     IF X /= (11, 5) THEN
-                          FAILED ("WRONG VALUE FOR X - 11");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 11");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          IF X /= (11, 5) THEN
-                               FAILED ("X VALUE WRONG - 12");
-                          END IF;
-                     END;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 12");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                     X : ARR;
-                BEGIN
-                     IF X /= (1..5 => (11, 5)) THEN
-                          FAILED ("X VALUE INCORRECT - 13");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 13");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                     X : NREC;
-                BEGIN
-                     IF X /= (C1 => (11, 5)) THEN
-                          FAILED ("X VALUE IS INCORRECT - 14");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 14");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS NEW CONS;
-                     X : NREC;
-                BEGIN
-                     IF X /= (11, 5) THEN
-                          FAILED ("X VALUE INCORRECT - 15");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 15");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS := NEW CONS;
-                BEGIN
-                     IF X.ALL /= (11, 5) THEN
-                          FAILED ("X VALUE INCORRECT - 17");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 17");
-           END;
-      END;
- 
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
-           RESULT;
- 
- END C37215F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37215h.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37215h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,345 ****
- -- C37215H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT IF AN INDEX CONSTRAINT DEPENDS ON A DISCRIMINANT,
- --      THE DISCRIMINANT VALUE IS CHECKED FOR COMPATIBILITY WHEN THE
- --      RECORD TYPE IS:
- --
- --           CASE D: CONSTRAINED BY DEFAULT AND THE COMPONENT IS
- --                   PRESENT IN THE SUBTYPE.
- 
- -- HISTORY:
- --      JBG 10/17/86  CREATED ORIGINAL TEST.
- --      RJW 10/13/87  CORRECTED VARIOUS CONSTRAINT ERRORS IN 'CASE D1'.
- --      VCL 03/30/88  CORRECTED VARIOUS CONSTRAINT ERRORS WITH TYPE
- --                    DECLARATIONS THROUGHOUT THE TEST.  ADDED SEQUENCE
- --                    NUMBERS.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37215H IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
-      TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
- 
-      SEQUENCE_NUMBER : INTEGER;
- BEGIN
-      TEST ("C37215H", "THE DISCRIMINANT VALUES OF AN INDEX " &
-                       "CONSTRAINT ARE PROPERLY CHECK FOR " &
-                       "COMPATIBILITY WHEN THE DISCRIMINANT IS " &
-                       "DEFINED BY DEFAULT AND THE COMPONENT IS AND " &
-                       "IS NOT PRESENT IN THE SUBTYPE");
- 
- -- CASE D1: COMPONENT IS PRESENT
- 
-      SEQUENCE_NUMBER := 1;
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : MY_ARR(D3..1);
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(0);
-                     END CASE;
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     FAILED ("INDEX CHECK NOT PERFORMED - 1");
-                     IF X /= (1, (1, 1)) THEN
-                          COMMENT ("SHOULDN'T GET HERE");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT PERFORMED - 2");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT PERFORMED - 3");
-                          IF X /= (1..5 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT PERFORMED - 4");
-                          IF X /= (C1 => (1, (1, 1))) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          FAILED ("INDEX CHECK NOT PERFORMED - 5");
-                          IF X /= (1, (1, 1)) THEN
-                               COMMENT ("IRRELEVANT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                BEGIN
-                     DECLARE
-                          X : ACC_CONS;
-                     BEGIN
-                          X := NEW CONS;
-                          FAILED ("INDEX CHECK NOT PERFORMED - 6");
-                          IF X.ALL /= (1, (1, 1)) THEN
-                               COMMENT ("WRONG VALUE FOR X - 6");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                                       "- 6A");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6B");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
-           END;
-      END;
- 
- -- CASE D2: COMPONENT IS ABSENT
- 
-      SEQUENCE_NUMBER := 2;
-      DECLARE
-           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
-                RECORD
-                     CASE D3 IS
-                          WHEN -5..10 =>
-                               C1 : MY_ARR(IDENT_INT(2)..D3);
-                          WHEN OTHERS =>
-                               C2 : INTEGER := IDENT_INT(5);
-                     END CASE;
-                END RECORD;
-      BEGIN
-           BEGIN
-                DECLARE
-                     X : CONS;
-                BEGIN
-                     IF X /= (11, 5) THEN
-                          COMMENT ("X VALUE IS INCORRECT - 11");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
-           END;
- 
-           BEGIN
-                DECLARE
-                     SUBTYPE SCONS IS CONS;
-                BEGIN
-                     DECLARE
-                          X : SCONS;
-                     BEGIN
-                          IF X /= (11, 5) THEN
-                               FAILED ("X VALUE INCORRECT - 12");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 12A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ARR IS ARRAY (1..5) OF CONS;
-                BEGIN
-                     DECLARE
-                          X : ARR;
-                     BEGIN
-                          IF X /= (1..5 => (11, 5)) THEN
-                               FAILED ("X VALUE INCORRECT - 13");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 13A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS
-                          RECORD
-                               C1 : CONS;
-                          END RECORD;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          IF X /= (C1 => (11, 5)) THEN
-                               FAILED ("X VALUE INCORRECT - 14");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 14A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE NREC IS NEW CONS;
-                BEGIN
-                     DECLARE
-                          X : NREC;
-                     BEGIN
-                          IF X /= (11, 5) THEN
-                               FAILED ("X VALUE INCORRECT - 15");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 15A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
-           END;
- 
-           BEGIN
-                DECLARE
-                     TYPE ACC_CONS IS ACCESS CONS;
-                     X : ACC_CONS;
-                BEGIN
-                     X := NEW CONS;
-                     IF X.ALL /= (11, 5) THEN
-                          FAILED ("X VALUE INCORRECT - 17");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 17A");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
-           END;
-      END;
- 
-      RESULT;
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("INDEX VALUES CHECKED TOO SOON - " &
-                   INTEGER'IMAGE(SEQUENCE_NUMBER));
-           RESULT;
- END C37215H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37217a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37217a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37217a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37217a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C37217A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
- --     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
- --     TYPE - AFTER THE TYPE'S FULL DECLARATION.
- 
- -- HISTORY:
- --     DHH 02/05/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37217A IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
- BEGIN  --C37217A BODY
-      TEST ("C37217A", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
-                       "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
-                       "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " &
-                       "- AFTER THE TYPE'S FULL DECLARATION");
- 
-                                          -- CHECK FULL DECLARATION
-                                          -- LOWER LIMIT
-      BEGIN
-           DECLARE
- 
-                TYPE SM_REC(D : SM) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TYPE REC(D1 : INTEGER) IS
-                     RECORD
-                          INT : SM_REC(D1);
-                     END RECORD;
- 
-                TYPE PTR IS ACCESS REC;
- 
-                Y : PTR(IDENT_INT(0));           -- OPTIONAL EXCEPTION.
-           BEGIN
-                COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
-                        "- LOWER");
-                Y := NEW REC(IDENT_INT(0));      -- MANDATORY EXCEPTION.
-                FAILED("CONSTRAINT ERROR NOT RAISED");
- 
-                IF IDENT_INT(Y.INT.D) /= IDENT_INT(-1) THEN
-                     COMMENT ("IRRELEVANT");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                            "VARIABLE ALLOCATION - LOWER");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT("OPTIONAL CONSTRAINT ERROR RAISED - LOWER");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                       "VARIABLE DECLARATION - LOWER");
-      END;
- ---------------------------------------------------------------------
-                                          -- CHECK FULL DECLARATION
-                                          -- UPPER LIMIT
-      BEGIN
-           DECLARE
-                TYPE SM_ARR IS ARRAY(SM RANGE <>) OF INTEGER;
- 
-                TYPE REC(D1 : INTEGER) IS
-                     RECORD
-                          INT : SM_ARR(1 .. D1);
-                     END RECORD;
- 
-                TYPE PTR IS ACCESS REC;
- 
-                Y : PTR(IDENT_INT(11));           -- OPTIONAL EXCEPTION.
-           BEGIN
-                COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
-                        "- UPPER");
-                Y := NEW REC'(IDENT_INT(11),     -- MANDATORY EXCEPTION.
-                                       INT => (OTHERS => IDENT_INT(0)));
-                FAILED("CONSTRAINT ERROR NOT RAISED");
- 
-                IF IDENT_INT(Y.INT(IDENT_INT(1))) /= 11 THEN
-                     COMMENT ("IRRELEVANT");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                            "VARIABLE ALLOCATION - UPPER");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
-                        "- UPPER");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                       "VARIABLE DECLARATION - UPPER");
-      END;
- 
-      RESULT;
- 
- END C37217A;  -- BODY
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37217b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37217b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37217b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37217b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- C37217B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
- --     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
- --     TYPE - BEFORE THE DESIGNATED TYPE'S FULL DECLARATION.
- 
- -- HISTORY:
- --     DHH 08/04/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37217B IS
- 
-      SUBTYPE SM IS INTEGER RANGE 1..10;
- 
- BEGIN  --C37217B BODY
-      TEST ("C37217B", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
-                       "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
-                       "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE - " &
-                       "BEFORE THE DESIGNATED TYPE'S FULL DECLARATION");
- 
- ---------------------------------------------------------------------
-                                              -- INCOMPLETE DECLARATION
-                                              -- UPPER LIMIT
-      BEGIN  -- F
-           DECLARE  -- F
-                TYPE REC(D1 : INTEGER);
- 
-                TYPE PTR IS ACCESS REC;
-                X : PTR(IDENT_INT(11));
- 
-                TYPE SM_REC(D : SM) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TYPE REC(D1 : INTEGER) IS
-                     RECORD
-                          INT : SM_REC(D1);
-                     END RECORD;
-           BEGIN
-                COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED " &
-                        "- UPPER");
-                X := NEW REC(IDENT_INT(11));
-                FAILED("CONSTRAINT ERROR NOT RAISED - UPPER");
- 
-                IF IDENT_INT(X.INT.D) /= IDENT_INT(1) THEN
-                     COMMENT("IRREVELANT");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                            "VARIABLE USE - INCOMPLETE UPPER");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
-                        "- INCOMPLETE UPPER");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                       "VARIABLE DECLARATION - INCOMPLETE UPPER");
-      END;  -- F
- 
- -----------------------------------------------------------------------
-                                               -- INCOMPLETE DECLARATION
-                                               -- LOWER LIMIT
-      BEGIN  -- A
-           DECLARE  -- A
-                TYPE REC(D1 : INTEGER);
- 
-                TYPE PTR IS ACCESS REC;
-                X : PTR(IDENT_INT(0));
- 
-                TYPE SM_ARR IS ARRAY(SM RANGE <>) OF INTEGER;
- 
-                TYPE REC(D1 : INTEGER) IS
-                     RECORD
-                          INT : SM_ARR(D1 .. 2);
-                     END RECORD;
-           BEGIN
-                COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED " &
-                        "- LOWER");
-                X := NEW REC'(IDENT_INT(0), INT =>
-                                              (OTHERS => IDENT_INT(1)));
-                FAILED("CONSTRAINT ERROR NOT RAISED - LOWER");
- 
-                IF X.INT(IDENT_INT(1)) /= IDENT_INT(1) THEN
-                     COMMENT("IRREVELANT");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                            "VARIABLE USE - INCOMPLETE LOWER");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
-                        "- INCOMPLETE LOWER");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                       "VARIABLE DECLARATION - INCOMPLETE LOWER");
-      END;
- -----------------------------------------------------------------------
-      RESULT;
- 
- END C37217B;  -- BODY
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37217c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37217c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37217c.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37217c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C37217C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
- --     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
- --     TYPE - WHEN THERE IS A "LOOP" IN THE DESIGNATED TYPE'S FULL
- --     DECLARATION.
- 
- -- HISTORY:
- --     DHH 08/04/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37217C IS
- 
- BEGIN  --C37217C BODY
-      TEST ("C37217C", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
-                       "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
-                       "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " &
-                       "- WHEN THERE IS A ""LOOP"" IN THE DESIGNATED " &
-                       "TYPE'S FULL DECLARATION");
- 
-      BEGIN
-           DECLARE
-                TYPE R1(D1 : INTEGER);
-                TYPE R2(D2 : INTEGER);
-                TYPE R3(D3 : POSITIVE);
- 
-                TYPE ACC_R1 IS ACCESS R1;
-                TYPE ACC_R2 IS ACCESS R2;
-                TYPE ACC_R3 IS ACCESS R3;
- 
-                TYPE R1(D1 : INTEGER) IS
-                     RECORD
-                          C1 : ACC_R2(D1);
-                     END RECORD;
- 
-                TYPE R2(D2 : INTEGER) IS
-                     RECORD
-                          C2 : ACC_R3(D2);
-                     END RECORD;
- 
-                TYPE R3(D3 : POSITIVE) IS
-                     RECORD
-                          C3 : ACC_R1(D3);
-                     END RECORD;
- 
-                 X1 : ACC_R1(IDENT_INT(0));
- 
-           BEGIN
-                COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED");
- 
-                X1 := NEW R1'(D1 =>IDENT_INT(0),
-                              C1 => NEW R2'(D2 => IDENT_INT(0),
-                                            C2 => NEW R3(IDENT_INT(0))));
- 
-                FAILED("CONSTRAINT_ERROR NOT RAISED");
- 
-                IF IDENT_INT(X1.C1.C2.D3) /= IDENT_INT(0) THEN
-                     COMMENT("THIS LINE SHOULD NOT PRINT OUT");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                            "VARIABLE USE - LOOPED");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                       "VARIABLE DECLARATION - LOOPED");
-      END;
- 
-      RESULT;
- 
- END C37217C;  -- BODY
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37304a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37304a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37304a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C37304A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL FORMS OF CHOICE ARE PERMITTED IN A VARIANT_PART,
- -- AND, IN PARTICULAR, THAT FORMS LIKE ST RANGE L..R, AND ST ARE 
- -- PERMITTED.
-  
- -- ASL 7/31/81
- --  RM 8/26/82
- -- SPS 1/21/83
- 
- WITH REPORT;
- PROCEDURE C37304A IS
-  
-      USE REPORT;
-      
- BEGIN
- 
-      TEST("C37304A","ALL FORMS OF CHOICE ALLOWED IN A VARIANT_PART");
- 
-      DECLARE
- 
-           TYPE T IS RANGE 1 .. 10;
-           C5 : CONSTANT T := 5;
-           SUBTYPE S1 IS T RANGE 1 .. 5;
-           SUBTYPE S2 IS T RANGE C5 + 1 .. 7;
-           SUBTYPE SN IS T RANGE C5 + 4 .. C5 - 4 + 7;  -- NULL RANGE.
-           SUBTYPE S10 IS T RANGE C5 + 5 .. T'LAST;
- 
-           TYPE VREC( DISC : T := 8 ) IS
-                RECORD
-                     CASE DISC IS
-                          WHEN SN                       -- 9..8
-                          | S1 RANGE 1 .. 0             -- 1..0
-                          | S2 RANGE C5 + 2 .. C5 + 1   -- 7..6
-                          | 3 .. 2                      -- 3..2
-                               => NULL;
- 
-                          WHEN  S1 RANGE 4 .. C5        -- 4..5
-                          | S1 RANGE C5 - 4 .. C5 / 2   -- 1..2
-                          | 3 .. 1 + C5 MOD 3           -- 3..3
-                          | SN                          -- 9..8
-                          | S1 RANGE 5 .. C5 - 1        -- 5..4
-                          | 6 .. 7                      -- 6..7
-                          | S10                         -- 10..10
-                          | 9                           -- 9
-                          | S10 RANGE 10 .. 9           -- 10..9
-                               => NULL;
- 
-                          WHEN C5 + C5 - 2 .. 8         -- 8
-                               => NULL;
- 
-                     END CASE;
-                END RECORD;
-  
-           V : VREC;
- 
-      BEGIN
- 
-           IF EQUAL(3,3) THEN
-                V := (DISC => 5);
-           END IF;
-           IF V.DISC /= 5 THEN
-                FAILED ("ASSIGNMENT FAILED");
-           END IF;
- 
-      END;
-  
-      RESULT;
- 
- END C37304A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37305a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37305a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37305a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C37305A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CHOICES DENOTING A NULL RANGE OF VALUES ARE PERMITTED,
- -- AND THAT FOR CHOICES CONSISTING OF A SUBTYPE NAME FOLLOWED BY A
- -- RANGE CONSTRAINT WHERE THE LOWER BOUND IS GREATER THAN THE UPPER
- -- BOUND, THE BOUNDS NEED NOT BE IN THE RANGE OF THE SUBTYPE VALUES.
- 
- -- CHECK THAT AN OTHERS ALTERNATIVE CAN BE PROVIDED EVEN IF ALL VALUES
- -- OF THE CASE EXPRESSION HAVE BEEN COVERED BY PRECEDING ALTERNATIVES.
- 
- -- ASL 7/14/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C37305A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C37305A","NULL RANGES ALLOWED IN CHOICES FOR VARIANT " &
-            "PARTS.  OTHERS ALTERNATIVE ALLOWED AFTER ALL VALUES " &
-            "PREVIOUSLY COVERED");
- 
-      DECLARE
-           SUBTYPE ST IS INTEGER RANGE 1..10;
- 
-           TYPE REC(DISC : ST := 1) IS
-                RECORD
-                     CASE DISC IS
-                          WHEN 0..-1 => NULL;
-                          WHEN 1..-3 => NULL;
-                          WHEN 6..5 =>
-                               COMP : INTEGER;
-                          WHEN 11..10 => NULL;
-                          WHEN 15..12 => NULL;
-                          WHEN 11..0 => NULL;
-                          WHEN 1..10 => NULL;
-                          WHEN OTHERS => NULL;
-                     END CASE;
-                END RECORD;
- 
-           R : REC;
-      BEGIN
-           R := (DISC => 4);
- 
-           IF EQUAL(3,4) THEN
-                R := (DISC => 7);
-           END IF;
- 
-           IF R.DISC /= 4 THEN
-                FAILED ("ASSIGNMENT FAILED");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C37305A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37306a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37306a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37306a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37306a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- C37306A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN A VARIANT PART OF A RECORD THE CHOICES WITHIN AND
- -- BETWEEN ALTERNATIVES CAN APPEAR IN NON-MONOTONIC ORDER.
- 
- -- ASL 7/13/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE C37306A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C37306A","NON-MONOTONIC ORDER OF CHOICES IN VARIANT PARTS");
- 
-      DECLARE
-           TYPE COLOR IS (WHITE,RED,ORANGE,YELLOW,GREEN,AQUA,BLUE,BLACK);
- 
-           TYPE REC(DISC : COLOR := BLUE) IS
-                RECORD
-                     CASE DISC IS
-                          WHEN ORANGE => NULL;
-                          WHEN GREEN | WHITE | BLACK => NULL;
-                          WHEN YELLOW => NULL;
-                          WHEN BLUE | RED => NULL;
-                          WHEN OTHERS => NULL;
-                     END CASE;
-                END RECORD;
- 
-           R : REC;
-      BEGIN
-           R := (DISC => WHITE);
- 
-           IF EQUAL(3,4) THEN
-                R := (DISC => RED);
-           END IF;
- 
-           IF R.DISC /= WHITE THEN
-                FAILED ("ASSIGNMENT FAILED");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C37306A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37309a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37309a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37309a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37309a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C37309A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A DISCRIMINANT HAS A STATIC SUBTYPE, AN OTHERS
- -- CHOICE CAN BE OMITTED IF ALL VALUES IN THE 
- -- SUBTYPE'S RANGE ARE COVERED IN A VARIANT PART.
-  
- -- ASL 7/10/81
- -- SPS 10/25/82
- -- SPS 7/17/83
- 
- WITH REPORT;
- PROCEDURE C37309A IS
- 
-      USE REPORT;
-  
- BEGIN
-      TEST ("C37309A","OTHERS CHOICE CAN BE OMITTED IN VARIANT PART " &
-            "IF ALL VALUES IN STATIC SUBTYPE RANGE OF DISCRIMINANT " &
-            "ARE COVERED");
-  
-      DECLARE
-           SUBTYPE STATCHAR IS CHARACTER RANGE 'I'..'N';
-           TYPE REC1(DISC : STATCHAR := 'J') IS
-                RECORD
-                     CASE DISC IS
-                          WHEN 'I' => NULL;
-                          WHEN 'J' => NULL;
-                          WHEN 'K' => NULL;
-                          WHEN 'L' => NULL;
-                          WHEN 'M' => NULL;
-                          WHEN 'N' => NULL;
-                     END CASE;          
-                END RECORD;
-       
-           R1 : REC1;
-      BEGIN
-           R1 := (DISC => 'N');
-           IF EQUAL(3,3) THEN
-                R1 := (DISC => 'K');
-           END IF;
-           IF R1.DISC /= 'K' THEN
-                FAILED ("ASSIGNMENT FAILED - 1");
-           END IF;
-  
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED");
-      END;
-  
-      RESULT;
-  
- END C37309A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37310a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37310a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37310a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37310a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C37310A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A DISCRIMINANT HAS A DYNAMIC SUBTYPE, AN OTHERS
- -- CHOICE CAN BE OMITTED IF ALL VALUES IN THE BASE
- -- TYPE'S RANGE ARE COVERED.
-  
- -- ASL 7/10/81
- -- SPS 10/25/82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT;
- PROCEDURE C37310A IS
-  
-      USE REPORT;
-  
- BEGIN
-      TEST ("C37310A", "CHECK DYNAMIC DISCRIMINANT SUBTYPES " &
-                       "IN VARIANT RECORD DECLARATIONS");
- 
-      DECLARE
-  
-           ACHAR : CHARACTER := IDENT_CHAR('A');
-           ECHAR : CHARACTER := IDENT_CHAR('E');
-           JCHAR : CHARACTER := IDENT_CHAR('J');
-           MCHAR : CHARACTER := IDENT_CHAR('M');
-           SUBTYPE STATCHAR IS CHARACTER RANGE 'I'..'N';
-           SUBTYPE DYNCHAR IS CHARACTER RANGE ACHAR..ECHAR; 
-           SUBTYPE SSTAT IS STATCHAR RANGE JCHAR..MCHAR;
- 
-           TYPE LETTER IS NEW CHARACTER RANGE 'A'..'Z';
-           SUBTYPE DYNLETTER IS 
-                LETTER RANGE LETTER(ECHAR)..LETTER(JCHAR);     
-  
-           TYPE REC1(DISC : SSTAT := 'K') IS
-                RECORD
-                     CASE DISC IS
-                          WHEN ASCII.NUL..CHARACTER'LAST => NULL;
-                     END CASE;
-                END RECORD;
-       
-           TYPE REC2(DISC : DYNCHAR := 'C') IS
-                RECORD
-                     CASE DISC IS
-                          WHEN ASCII.NUL..CHARACTER'LAST => NULL;
-                     END CASE;       
-                END RECORD;
-       
-           TYPE REC3(DISC: DYNCHAR := 'D') IS
-                RECORD
-                     CASE DISC IS
-                          WHEN CHARACTER'FIRST..CHARACTER'LAST => NULL;
-                     END CASE; 
-                END RECORD;
-       
-           TYPE REC4(DISC : DYNLETTER := 'F') IS
-                RECORD
-                     CASE DISC IS
-                          WHEN LETTER'BASE'FIRST..
-                               LETTER'BASE'LAST => NULL;
-                     END CASE; 
-                END RECORD;
-  
-           R1 : REC1;
-           R2 : REC2;
-           R3 : REC3;
-           R4 : REC4;
-      BEGIN
-           IF EQUAL(3,3) THEN
-                R1 := (DISC => 'L');
-           END IF;
-           IF R1.DISC /= 'L' THEN
-                FAILED ("ASSIGNMENT FAILED - 1");
-           END IF;
-  
-           IF EQUAL(3,3) THEN
-               R2 := (DISC => 'B');
-           END IF;
-           IF R2.DISC /= 'B' THEN
-                FAILED ("ASSIGNMENT FAILED - 2");
-           END IF;
-  
-           IF EQUAL(3,3) THEN
-                R3 := (DISC => 'B');
-           END IF;
-           IF R3.DISC /= 'B' THEN
-                FAILED ("ASSIGNMENT FAILED - 3");
-           END IF;
-  
-           IF EQUAL(3,3) THEN
-                R4 := (DISC => 'H');
-           END IF;
-           IF R4.DISC /= 'H' THEN
-                FAILED ("ASSIGNMENT FAILED - 4");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-               FAILED ("EXCEPTION RAISED");
-      END;
-  
-      RESULT;
-  
- END C37310A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37312a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37312a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37312a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37312a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C37312A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DISCRIMINANT CAN HAVE A GENERIC FORMAL DISCRETE
- --     TYPE WHEN IT DOES NOT GOVERN A VARIANT PART AND THAT AN
- --     OBJECT OF A GENERIC FORMAL TYPE CAN CONSTRAIN A COMPONENT
- --     IN A VARIANT PART.
- 
- -- HISTORY:
- --     AH  08/22/86  CREATED ORIGINAL TEST.
- --     JET 08/13/87  REVISED FROM CLASS 'A' TO CLASS 'C' TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C37312A IS
- 
- BEGIN
-      TEST ("C37312A", "DISCRIMINANT TYPE IS GENERIC FORMAL TYPE");
- 
-      DECLARE
-           TYPE T IS RANGE 1 ..5;
- 
-           GENERIC
-                TYPE G1 IS RANGE <>;
-           PACKAGE P IS
-                TYPE G2 (D1 : G1) IS
-                     RECORD
-                          R1 : G1;
-                          R2 : BOOLEAN;
-                     END RECORD;
- 
-                TYPE STR IS ARRAY(G1 RANGE <>) OF INTEGER;
-                TYPE G3 (D : G1; E : INTEGER) IS
-                     RECORD
-                          CASE E IS
-                               WHEN 1 =>
-                                    S1 : STR(G1'FIRST..D);
-                               WHEN OTHERS =>
-                                    S2 : INTEGER;
-                          END CASE;
-                     END RECORD;
- 
-           END P;
- 
-           PACKAGE PKG IS NEW P (G1 => T);
-           USE PKG;
- 
-           A2: G2(1) := (1, 5, FALSE);
-           A3: G3(5, 1) := (5, 1, (1, 2, 3, 4, 5));
- 
-      BEGIN
-           A2.R2 := IDENT_BOOL (TRUE);
-           A3.S1(1) := IDENT_INT (6);
- 
-           IF A2 /= (1, 5, TRUE) THEN
-                FAILED ("INVALID CONTENTS OF RECORD A2");
-           END IF;
-           IF A3 /= (5, 1, (6, 2, 3, 4, 5)) THEN
-                FAILED ("INVALID CONTENTS OF RECORD A3");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C37312A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37402a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37402a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37402a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,253 ****
- -- C37402A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 
- -- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT 
- -- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL 
- -- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER 
- -- FOR THE OTHER MODES.
- 
- -- R.WILLIAMS 9/1/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37402A IS
- 
- BEGIN
-      TEST ( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
-                        "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
-                        "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
-                        "HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " &
-                        "APPLIED TO FORMAL PARAMETERS OF MODE IN " &
-                        "AND HAS THE VALUE OF THE ACTUAL PARAMETER " &
-                        "FOR THE OTHER MODES" );
- 
-      
-      DECLARE
- 
-           SUBTYPE INT IS INTEGER RANGE 1 .. 5;
- 
-           TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>) 
-                OF INTEGER;
- 
-           TYPE SQUARE (SIDE : INT := 1) IS
-                RECORD
-                     MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
-                END RECORD;
- 
-           SC : CONSTANT SQUARE := (2, ((0, 0), (0, 0)));
- 
-           AC : SQUARE (2) := (2, ((1, 2), (3, 4)));
-           AU : SQUARE     := (SIDE => 1, MAT => (1 => (1 => 1)));
- 
-           BC : SQUARE (2) := AC;
-           BU : SQUARE     := AU;
- 
-           CC : SQUARE (2);
-           CU : SQUARE;
-  
-           PROCEDURE P (CON, IN_CON : IN     SQUARE; 
-                        INOUT_CON   : IN OUT SQUARE;
-                        OUT_CON     : OUT    SQUARE; 
-                        IN_UNC      : IN     SQUARE; 
-                        INOUT_UNC   : IN OUT SQUARE; 
-                        OUT_UNC     : OUT    SQUARE) IS
- 
-           BEGIN
-                IF CON'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 1" );
-                END IF;
- 
-                IF IN_CON'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 2" );
-                END IF;
- 
-                IF IN_UNC'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 3" );
-                END IF;
- 
-                IF INOUT_CON'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                              "CONSTRAINED OBJECT OF IN OUT MODE - 1" );
-                END IF;
- 
-                IF OUT_CON'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                              "CONSTRAINED OBJECT OF OUT MODE - 1" );
-                END IF;
- 
-                IF INOUT_UNC'CONSTRAINED THEN
-                     FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
-                              "UNCONSTRAINED OBJECT OF IN OUT MODE " &
-                              "- 1" );
-                END IF;
- 
-                IF OUT_UNC'CONSTRAINED THEN
-                     FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
-                              "UNCONSTRAINED OBJECT OF OUT MODE - 1" );
-                END IF;
-           
-                OUT_CON := (2, ((1, 2), (3, 4)));
-                OUT_UNC := (2, ((1, 2), (3, 4)));
-           END P;
- 
-           TASK T IS 
-                ENTRY Q (CON, IN_CON : IN     SQUARE; 
-                         INOUT_CON   : IN OUT SQUARE;
-                         OUT_CON     : OUT    SQUARE; 
-                         IN_UNC      : IN     SQUARE; 
-                         INOUT_UNC   : IN OUT SQUARE; 
-                         OUT_UNC     : OUT    SQUARE);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT Q (CON, IN_CON : IN     SQUARE; 
-                          INOUT_CON   : IN OUT SQUARE;
-                          OUT_CON     : OUT    SQUARE; 
-                          IN_UNC      : IN     SQUARE; 
-                          INOUT_UNC   : IN OUT SQUARE; 
-                          OUT_UNC     : OUT    SQUARE) DO
-                     BEGIN
-                          IF CON'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "OBJECT OF IN MODE - 4" );
-                          END IF;
- 
-                          IF IN_CON'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "OBJECT OF IN MODE - 5" );
-                          END IF;
- 
-                          IF IN_UNC'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "OBJECT OF IN MODE - 6" );
-                          END IF;
-      
-                          IF INOUT_CON'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "CONSTRAINED OBJECT OF " &
-                                        "IN OUT MODE - 2" );
-                          END IF;
-           
-                          IF OUT_CON'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "CONSTRAINED OBJECT OF " &
-                                        "OUT MODE - 2" );
-                          END IF;
- 
-                          IF INOUT_UNC'CONSTRAINED THEN
-                               FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
-                                        "UNCONSTRAINED OBJECT OF " &
-                                        "IN OUT MODE - 2" );
-                          END IF;
-           
-                          IF OUT_UNC'CONSTRAINED THEN
-                               FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
-                                        "UNCONSTRAINED OBJECT OF " &
-                                        "OUT MODE - 2" );
-                          END IF;
-           
-                          OUT_CON := (2, ((1, 2), (3, 4)));
-                          OUT_UNC := (2, ((1, 2), (3, 4)));
-                     END;
-                END Q;
-           END T;
- 
-           GENERIC
-                CON, IN_CON : IN     SQUARE; 
-                INOUT_CON   : IN OUT SQUARE;
-                IN_UNC      : IN     SQUARE; 
-                INOUT_UNC   : IN OUT SQUARE; 
-           PACKAGE R IS END R;
- 
-           PACKAGE BODY R IS
-           BEGIN
-                IF CON'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 7" );
-                END IF;
- 
-                IF IN_CON'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 8" );
-                END IF;
- 
-                IF IN_UNC'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 9" );
-                END IF;
- 
-                IF INOUT_CON'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                              "CONSTRAINED OBJECT OF IN OUT MODE - 3" );
-                END IF;
- 
-                IF INOUT_UNC'CONSTRAINED THEN
-                     FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
-                              "UNCONSTRAINED OBJECT OF IN OUT MODE " &
-                              "- 3" );
-                END IF;
- 
-           END R;
- 
-           PACKAGE S IS NEW R (SC, AC, BC, AU, BU);
- 
-      BEGIN
-           P (SC, AC, BC, CC, AU, BU, CU);
-           T.Q (SC, AC, BC, CC, AU, BU, CU);
-      END;
-           
-      RESULT;
- END C37402A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37403a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37403a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37403a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37403a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- C37403A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 
- -- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT DO 
- -- NOT HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' REGARDLESS OF THE MODE 
- -- OF THE PARAMETER.
- 
- -- R.WILLIAMS 9/1/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37403A IS
- 
- BEGIN
-      TEST ( "C37403A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
-                        "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
-                        "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
-                        "DO NOT HAVE DEFAULTS, 'CONSTRAINED IS " &
-                        "'TRUE' REGARDLESS OF THE MODE OF THE " &
-                        "PARAMETER" );
- 
-      
-      DECLARE
- 
-           SUBTYPE INT IS INTEGER RANGE 1.. 10;
- 
-           TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>) 
-                OF INTEGER;
- 
-           TYPE SQUARE (SIDE : INT) IS
-                RECORD
-                     MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
-                END RECORD;
- 
-           S1 : SQUARE (2) := (2, ((1, 2), (3, 4)));
- 
-           S2 : SQUARE (2) := S1;
- 
-           S3 : SQUARE (2);
-  
-           SC : CONSTANT SQUARE := (SIDE => 1, MAT => (1 => (1 => 1)));
- 
-           PROCEDURE P (PIN1, PIN2 : IN     SQUARE; 
-                        PINOUT     : IN OUT SQUARE;
-                        POUT       : OUT    SQUARE) IS
- 
-           BEGIN
-                IF PIN1'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 1" );
-                END IF;
- 
-                IF PIN2'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 2" );
-                END IF;
- 
-                IF PINOUT'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                              "OBJECT OF IN OUT MODE - 1" );
-                END IF;
- 
-                IF POUT'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                              "OBJECT OF OUT MODE - 1" );
-                END IF;
- 
-                POUT := (2, ((1, 2), (3, 4)));
-           END P;
- 
-           TASK T IS 
-                ENTRY Q (PIN1, PIN2  : IN     SQUARE; 
-                         PINOUT      : IN OUT SQUARE;
-                         POUT        : OUT    SQUARE);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT Q (PIN1, PIN2  : IN     SQUARE; 
-                          PINOUT      : IN OUT SQUARE;
-                          POUT        : OUT    SQUARE) DO
- 
-                     BEGIN
-                          IF PIN1'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "OBJECT OF IN MODE - 3" );
-                          END IF;
- 
-                          IF PIN2'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "OBJECT OF IN MODE - 4" );
-                          END IF;
-      
-                          IF PINOUT'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "OBJECT OF " &
-                                        "IN OUT MODE - 2" );
-                          END IF;
-           
-                          IF POUT'CONSTRAINED THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                                        "OBJECT OF " &
-                                        "OUT MODE - 2" );
-                          END IF;
- 
-                          POUT := (2, ((1, 2), (3, 4)));
-                     END;
-                END Q;
-           END T;
- 
-           GENERIC
-                PIN1, PIN2 : IN     SQUARE; 
-                PINOUT     : IN OUT SQUARE;
-           PACKAGE R IS END R;
- 
-           PACKAGE BODY R IS
-           BEGIN
-                IF PIN1'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 5" );
-                END IF;
- 
-                IF PIN2'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
-                              "OF IN MODE - 6" );
-                END IF;
- 
-                IF PINOUT'CONSTRAINED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
-                              "OBJECT OF IN OUT MODE - 3" );
-                END IF;
- 
-           END R;
- 
-           PACKAGE S IS NEW R (S1, SC, S2);
- 
-      BEGIN
-           P (S1, SC, S2, S3);
-           T.Q (S1, SC, S2, S3);
-      END;
-           
-      RESULT;
- END C37403A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37404a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37404a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37404a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37404a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,168 ****
- --C37404A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES DECLARED WITH A
- --     CONSTRAINED TYPE, FOR CONSTANT OBJECTS (EVEN IF NOT DECLARED
- --     WITH A CONSTRAINED TYPE), AND DESIGNATED OBJECTS.
- 
- -- HISTORY:
- --     DHH 02/25/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37404A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
-      TYPE REC(A : INT) IS
-           RECORD
-                I : INT;
-      END RECORD;
- 
-      TYPE ACC_REC IS ACCESS REC(4);
-      TYPE ACC_REC1 IS ACCESS REC;
-      SUBTYPE REC4 IS REC(4);
-      SUBTYPE REC5 IS REC;
- 
-      TYPE REC_DEF(A : INT := 5) IS
-           RECORD
-                I : INT := 1;
-      END RECORD;
- 
-      TYPE ACC_DEF IS ACCESS REC_DEF(4);
-      TYPE ACC_DEF1 IS ACCESS REC_DEF;
-      SUBTYPE REC6 IS REC_DEF(6);
-      SUBTYPE REC7 IS REC_DEF;
- 
-      A : REC4 := (A => 4, I => 1);                    -- CONSTRAINED.
-      B : REC5(4) := (A => 4, I => 1);                 -- CONSTRAINED.
-      C : REC6;                                        -- CONSTRAINED.
-      D : REC7(6);                                     -- CONSTRAINED.
-      E : ACC_REC1(4);                                 -- CONSTRAINED.
-      F : ACC_DEF1(4);                                 -- CONSTRAINED.
-      G : ACC_REC1;                                    -- UNCONSTRAINED.
-      H : ACC_DEF1;                                    -- UNCONSTRAINED.
- 
-      R : REC(5) := (A => 5, I => 1);                  -- CONSTRAINED.
-      T : REC_DEF(5);                                  -- CONSTRAINED.
-      U : ACC_REC;                                     -- CONSTRAINED.
-      V : ACC_DEF;                                     -- CONSTRAINED.
-      W : CONSTANT REC(5) := (A => 5, I => 1);         -- CONSTANT.
-      X : CONSTANT REC := (A => 5, I => 1);            -- CONSTANT.
-      Y : CONSTANT REC_DEF(5) := (A => 5, I => 1);     -- CONSTANT.
-      Z : CONSTANT REC_DEF := (A => 5, I => 1);        -- CONSTANT.
- 
- BEGIN
-      TEST("C37404A", "CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES " &
-                      "DECLARED WITH A  CONSTRAINED TYPE, FOR " &
-                      "CONSTANT OBJECTS (EVEN IF NOT DECLARED WITH A " &
-                      "CONSTRAINED TYPE), AND DESIGNATED OBJECTS");
- 
-      U := NEW REC(4);
-      V := NEW REC_DEF(4);
-      E := NEW REC(4);
-      F := NEW REC_DEF(4);
-      G := NEW REC(4);                                 -- CONSTRAINED.
-      H := NEW REC_DEF(4);                             -- CONSTRAINED.
- 
-      IF NOT A'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE1");
-      END IF;
- 
-      IF NOT B'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE2");
-      END IF;
- 
-      IF NOT C'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE1");
-      END IF;
- 
-      IF NOT D'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE2");
-      END IF;
- 
-      IF NOT R'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR RECORD COMPONENT");
-      END IF;
- 
-      IF NOT T'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT VARIABLE");
-      END IF;
- 
-      IF NOT E.ALL'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 1");
-      END IF;
- 
-      IF NOT F.ALL'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 1");
-      END IF;
- 
-      IF NOT G.ALL'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 2");
-      END IF;
- 
-      IF NOT H.ALL'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 2");
-      END IF;
- 
-      IF NOT U.ALL'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 3");
-      END IF;
- 
-      IF NOT V.ALL'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 3");
-      END IF;
- 
-      IF NOT W'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, CONSTRAINED");
-      END IF;
- 
-      IF NOT X'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, UNCONSTRAINED");
-      END IF;
- 
-      IF NOT Y'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
-                  "CONSTRAINED");
-      END IF;
- 
-      IF NOT Z'CONSTRAINED THEN
-           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
-                  "UNCONSTRAINED");
-      END IF;
- 
-      IF IDENT_INT(T.I) /= 1 OR
-         IDENT_INT(C.I) /= 1 OR
-         IDENT_INT(D.I) /= 1 OR
-         IDENT_INT(W.A) /= 5 OR
-         IDENT_INT(X.A) /= 5 OR
-         IDENT_INT(Y.A) /= 5 OR
-         IDENT_INT(Z.I) /= 1 OR
-         IDENT_INT(A.I) /= 1 OR
-         IDENT_INT(B.I) /= 1 OR
-         IDENT_BOOL(R.I /= 1) THEN
-              FAILED("INCORRECT INITIALIZATION VALUES");
-      END IF;
- 
-      RESULT;
- END C37404A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37404b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37404b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37404b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37404b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- --C37404B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'CONSTRAINED IS FALSE FOR VARIABLES THAT HAVE
- --     DISCRIMINANTS WITH DEFAULT VALUES.
- 
- -- HISTORY:
- --     LDC 06/08/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37404B IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
- 
-      TYPE REC_DEF(A : INT := 5) IS
-           RECORD
-                I : INT := 1;
-      END RECORD;
- 
-      SUBTYPE REC_DEF_SUB IS REC_DEF;
- 
-      TYPE REC_DEF_ARR     IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF;
-      TYPE REC_DEF_SARR IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF_SUB;
- 
-      PACKAGE PRI_PACK IS
-           TYPE REC_DEF_PRI(A : INTEGER := 5) IS PRIVATE;
-           TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS LIMITED PRIVATE;
- 
-      PRIVATE
- 
-           TYPE REC_DEF_PRI(A : INTEGER := 5) IS
-                RECORD
-                     I : INTEGER := 1;
-           END RECORD;
- 
-           TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS
-                RECORD
-                     I : INTEGER := 1;
-           END RECORD;
- 
-      END PRI_PACK;
-      USE PRI_PACK;
- 
-      A : REC_DEF;
-      B : REC_DEF_SUB;
-      C : ARRAY (0..15) OF REC_DEF;
-      D : ARRAY (0..15) OF REC_DEF_SUB;
-      E : REC_DEF_ARR;
-      F : REC_DEF_SARR;
-      G : REC_DEF_PRI;
-      H : REC_DEF_LIM_PRI;
- 
-      Z : REC_DEF;
- 
-      PROCEDURE SUBPROG(REC : OUT REC_DEF) IS
- 
-      BEGIN
-           IF REC'CONSTRAINED THEN
-                FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT " &
-                       "PARAMETER INSIDE THE SUBPROGRAM");
-           END IF;
-      END SUBPROG;
- 
- BEGIN
-      TEST("C37404B", "CHECK THAT 'CONSTRAINED IS FALSE FOR VARIABLES" &
-                      " THAT HAVE DISCRIMINANTS WITH DEFAULT VALUES.");
- 
-      IF A'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR RECORD COMPONENT");
-      END IF;
- 
-      IF B'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR SUBTYPE");
-      END IF;
- 
-      IF C(1)'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE");
-      END IF;
- 
-      IF D(1)'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE");
-      END IF;
- 
-      IF E(1)'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE");
-      END IF;
- 
-      IF F(1)'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE");
-      END IF;
- 
-      IF G'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR PRIVATE TYPE");
-      END IF;
- 
-      IF H'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR LIMITED PRIVATE TYPE");
-      END IF;
- 
-      SUBPROG(Z);
-      IF Z'CONSTRAINED THEN
-           FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT PARAMETER " &
-                  "AFTER THE CALL");
-      END IF;
- 
-      IF IDENT_INT(A.I)    /= 1 OR
-         IDENT_INT(B.I)    /= 1 OR
-         IDENT_INT(C(1).I) /= 1 OR
-         IDENT_INT(D(1).I) /= 1 OR
-         IDENT_INT(E(1).I) /= 1 OR
-         IDENT_INT(F(1).I) /= 1 OR
-         IDENT_INT(Z.I)    /= 1 OR
-         IDENT_INT(A.A)    /= 5 OR
-         IDENT_INT(B.A)    /= 5 OR
-         IDENT_INT(C(1).A) /= 5 OR
-         IDENT_INT(D(1).A) /= 5 OR
-         IDENT_INT(E(1).A) /= 5 OR
-         IDENT_INT(F(1).A) /= 5 OR
-         IDENT_INT(G.A)    /= 5 OR
-         IDENT_INT(H.A)    /= 5 OR
-         IDENT_INT(Z.A)    /= 5 THEN
-              FAILED("INCORRECT INITIALIZATION VALUES");
-      END IF;
- 
-      RESULT;
- END C37404B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37405a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37405a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37405a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37405a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,161 ****
- -- C37405A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED
- -- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT
- -- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED
- -- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER.
-  
- -- ASL 7/21/81
- -- TBN 1/20/86     RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS 
- --                 OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND
- --                 RECORD COMPONENTS.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C37405A IS
-  
-      TYPE REC(DISC : INTEGER := 25) IS
-           RECORD
-                COMP : INTEGER;
-           END RECORD;
-  
-      SUBTYPE CONSTR IS REC(10);
-      SUBTYPE UNCONSTR IS REC;
- 
-      TYPE REC_C IS 
-           RECORD
-                COMP: CONSTR;
-           END RECORD;
- 
-      TYPE REC_U IS
-           RECORD
-                COMP: UNCONSTR;
-           END RECORD;
-  
-      C1,C2 : CONSTR;
-      U1,U2 : UNCONSTR;
- -- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2.
- 
-      ARR_C : ARRAY (1..5) OF CONSTR;
-      ARR_U : ARRAY (1..5) OF UNCONSTR;
- 
-      REC_COMP_C : REC_C;
-      REC_COMP_U : REC_U;
-  
-      PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
-      BEGIN
-           PARM := C2;
-           IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN
-                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
-                        "ASSIGNMENT - 1");
-           END IF;
-      END PROC11;
- 
-      PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
-      BEGIN
-           PARM := U2;
-           IF B /= PARM'CONSTRAINED THEN
-                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
-                        "ASSIGNMENT - 2");
-           END IF;
-      END PROC12;
- 
-      PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
-      BEGIN
-           IF B /= PARM'CONSTRAINED THEN
-                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
-                        "PASSING PARAMETER");
-           END IF;
-  
-           PROC11(PARM, B);
-  
-           PROC12(PARM, B);
- 
-      END PROC1;
-  
-      PROCEDURE PROC2(PARM : IN OUT CONSTR) IS
-      BEGIN
-           COMMENT ("CALLING PROC1 FROM PROC2");   -- IN CASE TEST FAILS.
-           PROC1(PARM,TRUE);
-           PARM := U2;
-           IF NOT PARM'CONSTRAINED THEN
-                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
-                        "ASSIGNMENT - 3");
-           END IF;
-      END PROC2;
- BEGIN
-      TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " &
-                      "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT");
-  
-      C2 := (DISC => IDENT_INT(10), COMP => 3);
-      U2 := (DISC => IDENT_INT(10), COMP => 4);
- 
-      ARR_C := (1..5 => U2);
-      ARR_U := (1..5 => C2);
- 
-      REC_COMP_C := (COMP => U2);
-      REC_COMP_U := (COMP => C2);
-  
-      C1 := U2;
-      U1 := C2;
-  
-      IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN
-           FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4");
-      END IF;
- 
-      IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN
-           FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5");
-      END IF;
- 
-      IF REC_COMP_U.COMP'CONSTRAINED
-          OR NOT REC_COMP_C.COMP'CONSTRAINED THEN
-           FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6");
-      END IF;
-  
-      COMMENT("CALLING PROC1 DIRECTLY");
-      PROC1(C1,TRUE);
-      PROC2(C1);
- 
-      COMMENT("CALLING PROC1 DIRECTLY");
-      PROC1(U1,FALSE);
-      PROC2(U1);
- 
-      COMMENT("CALLING PROC1 DIRECTLY");
-      PROC1(ARR_C(4), TRUE);
-      PROC2(ARR_C(5));
- 
-      COMMENT("CALLING PROC1 DIRECTLY");
-      PROC1(ARR_U(2), FALSE);
-      PROC2(ARR_U(3));
- 
-      COMMENT("CALLING PROC1 DIRECTLY");
-      PROC1(REC_COMP_C.COMP, TRUE);
-      PROC2(REC_COMP_C.COMP);
- 
-      COMMENT("CALLING PROC1 DIRECTLY");
-      PROC1(REC_COMP_U.COMP, FALSE);
-      PROC2(REC_COMP_U.COMP);
-  
-      RESULT;
- END C37405A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37411a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37411a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c37411a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c37411a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C37411A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATIONS OF ASSIGNMENT, COMPARISON, MEMBERSHIP
- --     TESTS, QUALIFICATION, TYPE CONVERSION, 'BASE, 'SIZE AND 'ADDRESS,
- --     ARE DEFINED FOR NULL RECORDS.
- 
- -- HISTORY:
- --     DHH 03/04/88 CREATED ORIGINAL TEST.
- --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C37411A IS
-      TYPE S IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      SUBTYPE SS IS S;
- 
-      U,V,W : S;
-      X : SS;
- 
- BEGIN
- 
-      TEST("C37411A", "CHECK THAT THE OPERATIONS OF ASSIGNMENT, " &
-                      "COMPARISON, MEMBERSHIP TESTS, QUALIFICATION, " &
-                      "TYPE CONVERSION, 'BASE, 'SIZE AND 'ADDRESS, " &
-                      "ARE DEFINED FOR NULL RECORDS");
-      U := W;
-      IF U /= W THEN
-           FAILED("EQUALITY/ASSIGNMENT DOES NOT PERFORM CORRECTLY");
-      END IF;
- 
-      IF V NOT IN S THEN
-           FAILED("MEMBERSHIP DOES NOT PERFORM CORRECTLY");
-      END IF;
- 
-      IF X /= SS(V) THEN
-           FAILED("TYPE CONVERSION DOES NOT PERFORM CORRECTLY");
-      END IF;
- 
-      IF S'(U) /= S'(W) THEN
-           FAILED("QUALIFIED EXPRESSION DOES NOT PERFORM CORRECTLY");
-      END IF;
- 
-      IF X'SIZE /= V'SIZE THEN
-           FAILED("'BASE'SIZE DOES NOT PERFORM CORRECTLY WHEN PREFIX " &
-                  "IS AN OBJECT");
-      END IF;
- 
-      IF X'ADDRESS = V'ADDRESS THEN
-           COMMENT("NULL RECORDS HAVE THE SAME ADDRESS");
-      ELSE
-           COMMENT("NULL RECORDS DO NOT HAVE THE SAME ADDRESS");
-      END IF;
- 
-      RESULT;
- END C37411A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380001.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C380001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that checks are made properly when a per-object expression contains
- --    an attribute whose prefix denotes the current instance of the type.
- --    (Defect Report 8652/0002, as reflected in Technical Corrigendum 1,
- --    RM95 3.8(18/1)).
- --
- -- CHANGE HISTORY:
- --     9 FEB 2001   PHL   Initial version.
- --    29 JUN 2002   RLB   Readied for release.
- --
- --!
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Report;
- use Report;
- procedure C380001 is
- 
-     type Negative is range Integer'First .. -1;
- 
-     type R1 is
-         record
-             C : Negative := Negative (Ident_Int (R1'Size));
-         end record;
- 
- 
-     type R2;
- 
-     type R3 (D1 : access R2; D2 : Natural) is limited null record;
- 
-     type R2 is limited
-         record
-             C : R3 (R2'Access, Ident_Int (-1));
-         end record;
- 
- begin
-     Test ("C380001", "Check that checks are made properly when a " &
-                         "per-object expression contains an attribute whose " &
-                         "prefix denotes the current instance of the type");
-     begin
-         declare
-             X : R1;
-         begin
-             Failed
-                ("No exception raised when evaluating a per-object expression " &
-                 "containing an attribute - 1");
-         end;
-     exception
-         when Constraint_Error =>
-             null;
-         when E: others =>
-             Failed ("Exception " & Exception_Name (E) &
-                     " raised - " & Exception_Information (E) & " - 1");
-     end;
- 
-     declare
-         type A is access R1;
-         X : A;
-     begin
-         X := new R1;
-         Failed ("No exception raised when evaluating a per-object expression " &
-                 "containing an attribute - 2");
-     exception
-         when Constraint_Error =>
-             null;
-         when E: others =>
-             Failed ("Exception " & Exception_Name (E) &
-                     " raised - " & Exception_Information (E) & " - 2");
-     end;
- 
-     begin
-         declare
-             X : R2;
-         begin
-             Failed
-                ("No exception raised when elaborating a per-object constraint " &
-                 "containing an attribute - 3");
-         end;
-     exception
-         when Constraint_Error =>
-             null;
-         when E: others =>
-             Failed ("Exception " & Exception_Name (E) &
-                     " raised - " & Exception_Information (E) & " - 3");
-     end;
- 
-     declare
-         type A is access R2;
-         X : A;
-     begin
-         X := new R2;
-         Failed
-            ("No exception raised when evaluating a per-object constraint " &
-             "containing an attribute - 4");
-     exception
-         when Constraint_Error =>
-             null;
-         when E: others =>
-             Failed ("Exception " & Exception_Name (E) &
-                     " raised - " & Exception_Information (E) & " - 4");
-     end;
- 
-     Result;
- end C380001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380002.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C380002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that an expression in a per-object discriminant constraint which is
- --    part of a named association is evaluated once for each association.
- --    (Defect Report 8652/0002, as reflected in Technical Corrigendum 1,
- --    RM95 3.8(18.1/1)).
- --
- -- CHANGE HISTORY:
- --     9 FEB 2001   PHL   Initial version.
- --    29 JUN 2002   RLB   Readied for release.
- --
- --!
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Report;
- use Report;
- procedure C380002 is
- 
-     F_Val : Integer := Ident_Int (0);
- 
-     function F return Integer is
-     begin
-         F_Val := F_Val + Ident_Int (1);
-         return F_Val;
-     end F;
- 
-     type R1;
- 
-     type R2 (D0 : Integer; D1 : access R1; D2 : Integer; D3 : Integer) is
-        limited null record;
- 
-     type R1 is limited
-         record
-             C : R2 (D1 => R1'Access, D0 | D2 | D3 => F);
-         end record;
- 
- begin
-     Test ("C380002", "Check that an expression in a per-object discriminant " &
-                         "constraint which is part of a named association is " &
-                         "evaluated once for each association");
- 
-     if not Equal (F_Val, 3) then
-         Failed ("Expression not evaluated the proper number of times");
-     end if;
- 
-     Result;
- end C380002;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380003.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,223 ****
- -- C380003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that per-object expressions are evaluated as specified for
- --    protected components.  (Defect Report 8652/0002, as reflected in
- --    Technical Corrigendum 1, RM95 3.6(22/1) and 3.8(18/1)).
- --
- -- CHANGE HISTORY:
- --     9 FEB 2001   PHL   Initial version.
- --    29 JUN 2002   RLB   Readied for release.
- --
- --!
- with Report;
- use Report;
- procedure C380003 is
- 
-     subtype Sm is Integer range 1 .. 10;
- 
-     type Rec (D1, D2 : Sm) is
-         record
-             null;
-         end record;
- 
- begin
-     Test ("C380003",
-           "Check compatibility of discriminant expressions" &
-              " when the constraint depends on discriminants, " &
-              "and the discriminants have defaults - protected components");
- 
-     declare
-         protected type Cons (D3 : Integer := Ident_Int (11)) is
-             function C1_D1 return Integer;
-             function C1_D2 return Integer;
-         private
-             C1 : Rec (D3, 1);
-         end Cons;
-         protected body Cons is
-             function C1_D1 return Integer is
-             begin
-                 return C1.D1;
-             end C1_D1;
-             function C1_D2 return Integer is
-             begin
-                 return C1.D2;
-             end C1_D2;
-         end Cons;
- 
-         function Is_Ok
-                     (C : Cons; D3 : Integer; C1_D1 : Integer; C1_D2 : Integer)
-                     return Boolean is
-         begin
-             return C.D3 = D3 and C.C1_D1 = C1_D1 and C.C1_D2 = C1_D2;
-         end Is_Ok;
- 
-     begin
-         begin
-             declare
-                 X : Cons;
-             begin
-                 Failed ("Discriminant check not performed - 1");
-                 if not Is_Ok (X, 1, 1, 1) then
-                     Comment ("Shouldn't get here");
-                 end if;
-             end;
-         exception
-             when Constraint_Error =>
-                 null;
-             when others =>
-                 Failed ("Unexpected exception - 1");
-         end;
- 
-         begin
-             declare
-                 type Acc_Cons is access Cons;
-                 X : Acc_Cons;
-             begin
-                 X := new Cons;
-                 Failed ("Discriminant check not performed - 2");
-                 begin
-                     if not Is_Ok (X.all, 1, 1, 1) then
-                         Comment ("Irrelevant");
-                     end if;
-                 end;
-             exception
-                 when Constraint_Error =>
-                     null;
-                 when others =>
-                     Failed ("Unexpected exception raised - 2");
-             end;
-         exception
-             when others =>
-                 Failed ("Constraint checked too soon - 2");
-         end;
- 
-         begin
-             declare
-                 subtype Scons is Cons;
-             begin
-                 declare
-                     X : Scons;
-                 begin
-                     Failed ("Discriminant check not performed - 3");
-                     if not Is_Ok (X, 1, 1, 1) then
-                         Comment ("Irrelevant");
-                     end if;
-                 end;
-             exception
-                 when Constraint_Error =>
-                     null;
-                 when others =>
-                     Failed ("Unexpected exception raised - 3");
-             end;
-         exception
-             when others =>
-                 Failed ("Constraint checked too soon - 3");
-         end;
- 
-         begin
-             declare
-                 type Arr is array (1 .. 5) of Cons;
-             begin
-                 declare
-                     X : Arr;
-                 begin
-                     Failed ("Discriminant check not performed - 4");
-                     for I in Arr'Range loop
-                         if not Is_Ok (X (I), 1, 1, 1) then
-                             Comment ("Irrelevant");
-                         end if;
-                     end loop;
-                 end;
-             exception
-                 when Constraint_Error =>
-                     null;
-                 when others =>
-                     Failed ("Unexpected exception raised - 4");
-             end;
-         exception
-             when others =>
-                 Failed ("Constraint checked too soon - 4");
-         end;
- 
-         begin
-             declare
-                 type Nrec is
-                     record
-                         C1 : Cons;
-                     end record;
-             begin
-                 declare
-                     X : Nrec;
-                 begin
-                     Failed ("Discriminant check not performed - 5");
-                     if not Is_Ok (X.C1, 1, 1, 1) then
-                         Comment ("Irrelevant");
-                     end if;
-                 end;
-             exception
-                 when Constraint_Error =>
-                     null;
-                 when others =>
-                     Failed ("Unexpected exception raised - 5");
-             end;
-         exception
-             when others =>
-                 Failed ("Constraint checked too soon - 5");
-         end;
- 
-         begin
-             declare
-                 type Drec is new Cons;
-             begin
-                 declare
-                     X : Drec;
-                 begin
-                     Failed ("Discriminant check not performed - 6");
-                     if not Is_Ok (Cons (X), 1, 1, 1) then
-                         Comment ("Irrelevant");
-                     end if;
-                 end;
-             exception
-                 when Constraint_Error =>
-                     null;
-                 when others =>
-                     Failed ("Unexpected exception raised - 6");
-             end;
-         exception
-             when others =>
-                 Failed ("Constraint checked too soon - 6");
-         end;
- 
-     end;
- 
-     Result;
- 
- exception
-     when others =>
-         Failed ("Constraint check done too early");
-         Result;
- end C380003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c380004.a	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c380004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,385 ****
- -- C380004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that per-object expressions are evaluated as specified for entry
- --    families and protected components.  (Defect Report 8652/0002,
- --    as reflected in Technical Corrigendum 1, RM95 3.6(22/1), 3.8(18/1), and
- --    9.5.2(22/1)).
- --
- -- CHANGE HISTORY:
- --     9 FEB 2001   PHL   Initial version.
- --    29 JUN 2002   RLB   Readied for release.
- --
- --!
- with Report;
- use Report;
- procedure C380004 is
- 
-     type Rec (D1, D2 : Positive) is
-         record
-             null;
-         end record;
- 
-     F1_Poe : Integer;
- 
-     function Chk (Poe : Integer; Value : Integer; Message : String)
-                  return Boolean is
-     begin
-         if Poe /= Value then
-             Failed (Message & ": Poe is " & Integer'Image (Poe));
-         end if;
-         return True;
-     end Chk;
- 
-     function F1 return Integer is
-     begin
-         F1_Poe := F1_Poe - Ident_Int (1);
-         return F1_Poe;
-     end F1;
- 
-     generic
-         type T is limited private;
-         with function Is_Ok (X : T;
-                              Param1 : Integer;
-                              Param2 : Integer;
-                              Param3 : Integer) return Boolean;
-     procedure Check;
- 
-     procedure Check is
-     begin
- 
-         declare
-             type Poe is new T;
-             Chk1 : Boolean := Chk (F1_Poe, 17, "F1 evaluated");
-             X : Poe;             -- F1 evaluated
-             Y : Poe;             -- F1 evaluated
-             Chk2 : Boolean := Chk (F1_Poe, 15, "F1 not evaluated");
-         begin
-             if not Is_Ok (T (X), 16, 16, 17) or
-                not Is_Ok (T (Y), 15, 15, 17) then
-                 Failed ("Discriminant values not correct - 0");
-             end if;
-         end;
- 
-         declare
-             type Poe is new T;
-         begin
-             begin
-                 declare
-                     X : Poe;
-                 begin
-                     if not Is_Ok (T (X), 14, 14, 17) then
-                         Failed ("Discriminant values not correct - 1");
-                     end if;
-                 end;
-             exception
-                 when others =>
-                     Failed ("Unexpected exception - 1");
-             end;
- 
-             declare
-                 type Acc_Poe is access Poe;
-                 X : Acc_Poe;
-             begin
-                 X := new Poe;
-                 begin
-                     if not Is_Ok (T (X.all), 13, 13, 17) then
-                         Failed ("Discriminant values not correct - 2");
-                     end if;
-                 end;
-             exception
-                 when others =>
-                     Failed ("Unexpected exception raised - 2");
-             end;
- 
-             declare
-                 subtype Spoe is Poe;
-                 X : Spoe;
-             begin
-                 if not Is_Ok (T (X), 12, 12, 17) then
-                     Failed ("Discriminant values not correct - 3");
-                 end if;
-             exception
-                 when others =>
-                     Failed ("Unexpected exception raised - 3");
-             end;
- 
-             declare
-                 type Arr is array (1 .. 2) of Poe;
-                 X : Arr;
-             begin
-                 if Is_Ok (T (X (1)), 11, 11, 17) and then
-                    Is_Ok (T (X (2)), 10, 10, 17) then
-                     null;
-                 elsif Is_Ok (T (X (2)), 11, 11, 17) and then
-                       Is_Ok (T (X (1)), 10, 10, 17) then
-                     null;
-                 else
-                     Failed ("Discriminant values not correct - 4");
-                 end if;
-             exception
-                 when others =>
-                     Failed ("Unexpected exception raised - 4");
-             end;
- 
-             declare
-                 type Nrec is
-                     record
-                         C1, C2 : Poe;
-                     end record;
-                 X : Nrec;
-             begin
-                 if Is_Ok (T (X.C1), 8, 8, 17) and then
-                    Is_Ok (T (X.C2), 9, 9, 17) then
-                     null;
-                 elsif Is_Ok (T (X.C2), 8, 8, 17) and then
-                       Is_Ok (T (X.C1), 9, 9, 17) then
-                     null;
-                 else
-                     Failed ("Discriminant values not correct - 5");
-                 end if;
-             exception
-                 when others =>
-                     Failed ("Unexpected exception raised - 5");
-             end;
- 
-             declare
-                 type Drec is new Poe;
-                 X : Drec;
-             begin
-                 if not Is_Ok (T (X), 7, 7, 17) then
-                     Failed ("Discriminant values not correct - 6");
-                 end if;
-             exception
-                 when others =>
-                     Failed ("Unexpected exception raised - 6");
-             end;
-         end;
-     end Check;
- 
- 
- begin
-     Test ("C380004",
-           "Check evaluation of discriminant expressions " &
-              "when the constraint depends on a discriminant, " &
-              "and the discriminants have defaults - discriminant-dependent" &
-              "entry families and protected components");
- 
- 
-     Comment ("Discriminant-dependent entry families for task types");
- 
-     F1_Poe := 18;
- 
-     declare
-         task type Poe (D3 : Positive := F1) is
-             entry E (D3 .. F1);    -- F1 evaluated
-             entry Is_Ok (D3 : Integer;
-                          E_First : Integer;
-                          E_Last : Integer;
-                          Ok : out Boolean);
-         end Poe;
-         task body Poe is
-         begin
-             loop
-                 select
-                     accept Is_Ok (D3 : Integer;
-                                   E_First : Integer;
-                                   E_Last : Integer;
-                                   Ok : out Boolean) do
-                         declare
-                             Cnt : Natural;
-                         begin
-                             if Poe.D3 = D3 then
-                                 -- Can't think of a better way to check the
-                                 -- bounds of the entry family.
-                                 begin
-                                     Cnt := E (E_First)'Count;
-                                     Cnt := E (E_Last)'Count;
-                                 exception
-                                     when Constraint_Error =>
-                                         Ok := False;
-                                         return;
-                                 end;
-                                 begin
-                                     Cnt := E (E_First - 1)'Count;
-                                     Ok := False;
-                                     return;
-                                 exception
-                                     when Constraint_Error =>
-                                         null;
-                                     when others =>
-                                         Ok := False;
-                                         return;
-                                 end;
-                                 begin
-                                     Cnt := E (E_Last + 1)'Count;
-                                     Ok := False;
-                                     return;
-                                 exception
-                                     when Constraint_Error =>
-                                         null;
-                                     when others =>
-                                         Ok := False;
-                                         return;
-                                 end;
-                                 Ok := True;
-                             else
-                                 Ok := False;
-                                 return;
-                             end if;
-                         end;
-                     end Is_Ok;
-                 or
-                     terminate;
-                 end select;
-             end loop;
-         end Poe;
- 
-         function Is_Ok
-                     (C : Poe; D3 : Integer; E_First : Integer; E_Last : Integer)
-                     return Boolean is
-             Ok : Boolean;
-         begin
-             C.Is_Ok (D3, E_First, E_Last, Ok);
-             return Ok;
-         end Is_Ok;
- 
-         procedure Chk is new Check (Poe, Is_Ok);
- 
-     begin
-         Chk;
-     end;
- 
- 
-     Comment ("Discriminant-dependent entry families for protected types");
- 
-     F1_Poe := 18;
- 
-     declare
-         protected type Poe (D3 : Integer := F1) is
-             entry E (D3 .. F1);    -- F1 evaluated
-             function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer)
-                            return Boolean;
-         end Poe;
-         protected body Poe is
-             entry E (for I in D3 .. F1) when True is
-             begin
-                 null;
-             end E;
-             function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer)
-                            return Boolean is
-                 Cnt : Natural;
-             begin
-                 if Poe.D3 = D3 then
-                     -- Can't think of a better way to check the
-                     -- bounds of the entry family.
-                     begin
-                         Cnt := E (E_First)'Count;
-                         Cnt := E (E_Last)'Count;
-                     exception
-                         when Constraint_Error =>
-                             return False;
-                     end;
-                     begin
-                         Cnt := E (E_First - 1)'Count;
-                         return False;
-                     exception
-                         when Constraint_Error =>
-                             null;
-                         when others =>
-                             return False;
-                     end;
-                     begin
-                         Cnt := E (E_Last + 1)'Count;
-                         return False;
-                     exception
-                         when Constraint_Error =>
-                             null;
-                         when others =>
-                             return False;
-                     end;
-                     return True;
-                 else
-                     return False;
-                 end if;
-             end Is_Ok;
-         end Poe;
- 
-         function Is_Ok
-                     (C : Poe; D3 : Integer; E_First : Integer; E_Last : Integer)
-                     return Boolean is
-         begin
-             return C.Is_Ok (D3, E_First, E_Last);
-         end Is_Ok;
- 
-         procedure Chk is new Check (Poe, Is_Ok);
- 
-     begin
-         Chk;
-     end;
- 
-     Comment ("Protected components");
- 
-     F1_Poe := 18;
- 
-     declare
-         protected type Poe (D3 : Integer := F1) is
-             function C1_D1 return Integer;
-             function C1_D2 return Integer;
-         private
-             C1 : Rec (D3, F1);    -- F1 evaluated
-         end Poe;
-         protected body Poe is
-             function C1_D1 return Integer is
-             begin
-                 return C1.D1;
-             end C1_D1;
-             function C1_D2 return Integer is
-             begin
-                 return C1.D2;
-             end C1_D2;
-         end Poe;
- 
-         function Is_Ok (C : Poe; D3 : Integer; C1_D1 : Integer; C1_D2 : Integer)
-                        return Boolean is
-         begin
-             return C.D3 = D3 and C.C1_D1 = C1_D1 and C.C1_D2 = C1_D2;
-         end Is_Ok;
- 
-         procedure Chk is new Check (Poe, Is_Ok);
- 
-     begin
-         Chk;
-     end;
- 
-     Result;
- 
- exception
-     when others =>
-         Failed ("Unexpected exception");
-         Result;
- 
- end C380004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38002a.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,420 ****
- -- C38002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN UNCONSTRAINED ARRAY TYPE OR A RECORD WITHOUT
- --     DEFAULT DISCRIMINANTS CAN BE USED IN AN ACCESS_TYPE_DEFINITION
- --     WITHOUT AN INDEX OR DISCRIMINANT CONSTRAINT.
- --
- --     CHECK THAT (NON-STATIC) INDEX OR DISCRIMINANT CONSTRAINTS CAN
- --     SUBSEQUENTLY BE IMPOSED WHEN THE TYPE IS USED IN AN OBJECT
- --     DECLARATION, ARRAY COMPONENT DECLARATION, RECORD COMPONENT
- --     DECLARATION, ACCESS TYPE DECLARATION, PARAMETER DECLARATION,
- --     DERIVED TYPE DEFINITION, PRIVATE TYPE.
- --
- --     CHECK FOR UNCONSTRAINED GENERIC FORMAL TYPE.
- 
- -- HISTORY:
- --     AH  09/02/86 CREATED ORIGINAL TEST.
- --     DHH 08/16/88 REVISED HEADER AND ENTERED COMMENTS FOR PRIVATE TYPE
- --                  AND CORRECTED INDENTATION.
- --     BCB 04/12/90 ADDED CHECKS FOR AN ARRAY AS A SUBPROGRAM RETURN
- --                  TYPE AND AN ARRAY AS A FORMAL PARAMETER.
- --     LDC 10/01/90 ADDED CODE SO F, FPROC, G, GPROC AREN'T OPTIMIZED 
- --                  AWAY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38002A IS
- 
- BEGIN
-      TEST ("C38002A", "NON-STATIC CONSTRAINTS CAN BE IMPOSED " &
-            "ON ACCESS TYPES ACCESSING PREVIOUSLY UNCONSTRAINED " &
-            "ARRAY OR RECORD TYPES");
- 
-      DECLARE
-           C3 : CONSTANT INTEGER := IDENT_INT(3);
- 
-           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           TYPE ARR_NAME IS ACCESS ARR;
-           SUBTYPE ARR_NAME_3 IS ARR_NAME(1..3);
- 
-           TYPE REC(DISC : INTEGER) IS
-                RECORD
-                     COMP : ARR_NAME(1..DISC);
-                END RECORD;
-           TYPE REC_NAME IS ACCESS REC;
- 
-           OBJ : REC_NAME(C3);
- 
-           TYPE ARR2 IS ARRAY (1..10) OF REC_NAME(C3);
- 
-           TYPE REC2 IS
-                RECORD
-                     COMP2 : REC_NAME(C3);
-                END RECORD;
- 
-           TYPE NAME_REC_NAME IS ACCESS REC_NAME(C3);
- 
-           TYPE DERIV IS NEW REC_NAME(C3);
-           SUBTYPE REC_NAME_3 IS REC_NAME(C3);
- 
-           FUNCTION F (PARM : REC_NAME_3) RETURN REC_NAME_3 IS
-           BEGIN
-                IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
-                     COMMENT("DON'T OPTIMIZE F AWAY");
-                END IF;
-                RETURN PARM;
-           END;
- 
-           PROCEDURE FPROC (PARM : REC_NAME_3) IS
-           BEGIN
-                IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
-                     COMMENT("DON'T OPTIMIZE FPROC AWAY");
-                END IF;
-           END FPROC;
- 
-           FUNCTION G (PA : ARR_NAME_3) RETURN ARR_NAME_3 IS
-           BEGIN
-                IF NOT EQUAL(IDENT_INT(5), 3 + IDENT_INT(2)) THEN
-                     COMMENT("DON'T OPTIMIZE G AWAY");
-                END IF;
-                RETURN PA;
-           END G;
- 
-           PROCEDURE GPROC (PA : ARR_NAME_3) IS
-           BEGIN
-                IF NOT EQUAL(IDENT_INT(6), 4 + IDENT_INT(2)) THEN
-                     COMMENT("DON'T OPTIMIZE GPROC AWAY");
-                END IF;
-           END GPROC;
- 
-      BEGIN
-           DECLARE
-                R : REC_NAME;
-           BEGIN
-                R := NEW REC'(DISC => 3, COMP => NEW ARR'(1..3 => 5));
-                R := F(R);
-                R := NEW REC'(DISC => 4, COMP => NEW ARR'(1..4 => 5));
-                R := F(R);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY FUNCTION FOR RECORD");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF R = NULL OR ELSE R.DISC /= 4 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
-                                  "ACCESS VALUE - RECORD,FUNCTION");
-                     END IF;
-           END;
- 
-           DECLARE
-                R : REC_NAME;
-           BEGIN
-                R := NEW REC'(DISC => 3, COMP => NEW ARR'(1..3 => 5));
-                FPROC(R);
-                R := NEW REC'(DISC => 4, COMP => NEW ARR'(1..4 => 5));
-                FPROC(R);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY PROCEDURE FOR RECORD");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF R = NULL OR ELSE R.DISC /= 4 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
-                                  "ACCESS VALUE - RECORD,PROCEDURE");
-                     END IF;
-           END;
- 
-           DECLARE
-                A : ARR_NAME;
-           BEGIN
-                A := NEW ARR'(1..3 => 5);
-                A := G(A);
-                A := NEW ARR'(1..4 => 6);
-                A := G(A);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY FUNCTION FOR ARRAY");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF A = NULL OR ELSE A(4) /= 6 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
-                                  "ACCESS VALUE - ARRAY,FUNCTION");
-                     END IF;
-           END;
- 
-           DECLARE
-                A : ARR_NAME;
-           BEGIN
-                A := NEW ARR'(1..3 => 5);
-                GPROC(A);
-                A := NEW ARR'(1..4 => 6);
-                GPROC(A);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY PROCEDURE FOR ARRAY");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF A = NULL OR ELSE A(4) /= 6 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
-                                  "ACCESS VALUE - ARRAY,PROCEDURE");
-                     END IF;
-           END;
-      END;
- 
-      DECLARE
-           C3 : CONSTANT INTEGER := IDENT_INT(3);
- 
-           TYPE REC (DISC : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE P_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           TYPE P_ARR_NAME IS ACCESS P_ARR;
- 
-           TYPE P_REC_NAME IS ACCESS REC;
- 
-           GENERIC
-                TYPE UNCON_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           PACKAGE P IS
-                TYPE ACC_REC IS ACCESS REC;
-                TYPE ACC_ARR IS ACCESS UNCON_ARR;
-                TYPE ACC_P_ARR IS ACCESS P_ARR;
-                SUBTYPE ACC_P_ARR_3 IS ACC_P_ARR(1..3);
-                OBJ : ACC_REC(C3);
- 
-                TYPE ARR2 IS ARRAY (1..10) OF ACC_REC(C3);
- 
-                TYPE REC1 IS
-                     RECORD
-                          COMP1 : ACC_REC(C3);
-                     END RECORD;
- 
-                TYPE REC2 IS
-                     RECORD
-                          COMP2 : ACC_ARR(1..C3);
-                     END RECORD;
- 
-                SUBTYPE ACC_REC_3 IS ACC_REC(C3);
- 
-                FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3;
- 
-                PROCEDURE FPROC (PARM : ACC_REC_3);
- 
-                FUNCTION G (PA : ACC_P_ARR_3) RETURN ACC_P_ARR_3;
- 
-                PROCEDURE GPROC (PA : ACC_P_ARR_3);
- 
-                TYPE ACC1 IS PRIVATE;
-                TYPE ACC2 IS PRIVATE;
-                TYPE DER1 IS PRIVATE;
-                TYPE DER2 IS PRIVATE;
- 
-           PRIVATE
- 
-                TYPE ACC1 IS ACCESS ACC_REC(C3);
-                TYPE ACC2 IS ACCESS ACC_ARR(1..C3);
-                TYPE DER1 IS NEW ACC_REC(C3);
-                TYPE DER2 IS NEW ACC_ARR(1..C3);
-           END P;
- 
-           PACKAGE BODY P IS
-                FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3 IS
-                BEGIN
-                     IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
-                          COMMENT("DON'T OPTIMIZE F AWAY");
-                     END IF;
-                     RETURN PARM;
-                END;
- 
-                PROCEDURE FPROC (PARM : ACC_REC_3) IS
-                BEGIN
-                     IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
-                          COMMENT("DON'T OPTIMIZE FPROC AWAY");
-                     END IF;
-                END FPROC;
- 
-                FUNCTION G (PA : ACC_P_ARR_3) RETURN ACC_P_ARR_3 IS
-                BEGIN
-                     IF NOT EQUAL(IDENT_INT(5), 3 + IDENT_INT(2)) THEN
-                          COMMENT("DON'T OPTIMIZE G AWAY");
-                     END IF;
-                     RETURN PA;
-                END;
- 
-                PROCEDURE GPROC (PA : ACC_P_ARR_3) IS
-                BEGIN
-                     IF NOT EQUAL(IDENT_INT(6), 4 + IDENT_INT(2)) THEN
-                          COMMENT("DON'T OPTIMIZE GPROC AWAY");
-                     END IF;
-                END GPROC;
-           END P;
- 
-           PACKAGE NP IS NEW P (UNCON_ARR => P_ARR);
- 
-           USE NP;
- 
-      BEGIN
-           DECLARE
-                R : ACC_REC;
-           BEGIN
-                R := NEW REC(DISC => 3);
-                R := F(R);
-                R := NEW REC(DISC => 4);
-                R := F(R);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY FUNCTION FOR A RECORD -GENERIC");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF R = NULL OR ELSE R.DISC /= 4 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
-                                  "OF ACCESS VALUE - RECORD," &
-                                  "FUNCTION -GENERIC");
-                     END IF;
-           END;
- 
-           DECLARE
-                R : ACC_REC;
-           BEGIN
-                R := NEW REC(DISC => 3);
-                FPROC(R);
-                R := NEW REC(DISC => 4);
-                FPROC(R);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY PROCEDURE FOR A RECORD -GENERIC");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF R = NULL OR ELSE R.DISC /= 4 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
-                                  "OF ACCESS VALUE - RECORD," &
-                                  "PROCEDURE -GENERIC");
-                     END IF;
-           END;
- 
-           DECLARE
-                A : ACC_P_ARR;
-           BEGIN
-                A := NEW P_ARR'(1..3 => 5);
-                A := G(A);
-                A := NEW P_ARR'(1..4 => 6);
-                A := G(A);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY FUNCTION FOR AN ARRAY -GENERIC");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF A = NULL OR ELSE A(4) /= 6 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
-                                  "OF ACCESS VALUE - ARRAY," &
-                                  "FUNCTION -GENERIC");
-                     END IF;
-           END;
- 
-           DECLARE
-                A : ACC_P_ARR;
-           BEGIN
-                A := NEW P_ARR'(1..3 => 5);
-                GPROC(A);
-                A := NEW P_ARR'(1..4 => 6);
-                GPROC(A);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY PROCEDURE FOR AN ARRAY -GENERIC");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF A = NULL OR ELSE A(4) /= 6 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
-                                  "OF ACCESS VALUE - ARRAY," &
-                                  "PROCEDURE -GENERIC");
-                     END IF;
-           END;
-      END;
- 
-      DECLARE
-           TYPE CON_INT IS RANGE 1..10;
- 
-           GENERIC
-                TYPE UNCON_INT IS RANGE <>;
-           PACKAGE P2 IS
-                SUBTYPE NEW_INT IS UNCON_INT RANGE 1..5;
-                FUNCTION FUNC_INT (PARM : NEW_INT) RETURN NEW_INT;
- 
-                PROCEDURE PROC_INT (PARM : NEW_INT);
-           END P2;
- 
-           PACKAGE BODY P2 IS
-                FUNCTION FUNC_INT (PARM : NEW_INT) RETURN NEW_INT IS
-                BEGIN
-                     IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
-                          COMMENT("DON'T OPTIMIZE F AWAY");
-                     END IF;
-                     RETURN PARM;
-                END FUNC_INT;
- 
-                PROCEDURE PROC_INT (PARM : NEW_INT) IS
-                BEGIN
-                     IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
-                          COMMENT("DON'T OPTIMIZE FPROC AWAY");
-                     END IF;
-                END PROC_INT;
-           END P2;
- 
-           PACKAGE NP2 IS NEW P2 (UNCON_INT => CON_INT);
- 
-           USE NP2;
- 
-      BEGIN
-           DECLARE
-                R : CON_INT;
-           BEGIN
-                R := 2;
-                R := FUNC_INT(R);
-                R := 8;
-                R := FUNC_INT(R);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON VALUE " &
-                        "ACCEPTED BY FUNCTION -GENERIC");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF R /= 8 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
-                                  "OF VALUE -FUNCTION, GENERIC");
-                     END IF;
-           END;
- 
-           DECLARE
-                R : CON_INT;
-           BEGIN
-                R := 2;
-                PROC_INT(R);
-                R := 9;
-                PROC_INT(R);
-                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
-                        "ACCEPTED BY PROCEDURE -GENERIC");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF R /= 9 THEN
-                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
-                                  "OF ACCESS VALUE - PROCEDURE, " &
-                                  "GENERIC");
-                     END IF;
-           END;
-      END;
- 
-      RESULT;
- END C38002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38002b.ada	Sun May 18 22:32:09 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- -- C38002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN UNCONSTRAINED ARRAY TYPE OR A RECORD WITHOUT
- --     DEFAULT DISCRIMINANTS CAN BE USED IN AN ACCESS_TYPE_DEFINITION
- --     WITHOUT AN INDEX OR DISCRIMINANT CONSTRAINT.
- --
- --     CHECK THAT (NON-STATIC) INDEX OR DISCRIMINANT CONSTRAINTS CAN
- --     SUBSEQUENTLY BE IMPOSED WHEN THE TYPE IS USED IN AN OBJECT
- --     DECLARATION, ARRAY COMPONENT DECLARATION, RECORD COMPONENT
- --     DECLARATION, ACCESS TYPE DECLARATION, PARAMETER DECLARATION,
- --     ALLOCATOR, DERIVED TYPE DEFINITION, PRIVATE TYPE, OR AS THE
- --     RETURN TYPE IN A FUNCTION DECLARATION.
- --
- --     CHECK FOR GENERIC FORMAL ACCESS TYPES.
- 
- -- HISTORY:
- --     AH  09/02/86 CREATED ORIGINAL TEST.
- --     DHH 08/22/88 REVISED HEADER, ADDED 'PRIVATE TYPE' TO COMMENTS
- --                  AND CORRECTED INDENTATION.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38002B IS
- 
-      C3 : CONSTANT INTEGER := IDENT_INT(3);
- 
-      TYPE UNCON_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-      TYPE REC (DISC : INTEGER) IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      TYPE P_ARR_NAME IS ACCESS UNCON_ARR;
-      TYPE P_REC_NAME IS ACCESS REC;
- 
-      GENERIC
-           TYPE ACC_REC IS ACCESS REC;
-           TYPE ACC_ARR IS ACCESS UNCON_ARR;
-      PACKAGE P IS
-           OBJ : ACC_REC(C3);
- 
-           TYPE ARR2 IS ARRAY (1..10) OF ACC_REC(C3);
- 
-           TYPE REC1 IS
-                RECORD
-                     COMP1 : ACC_REC(C3);
-                END RECORD;
- 
-           TYPE REC2 IS
-                RECORD
-                     COMP2 : ACC_ARR(1..C3);
-                END RECORD;
- 
-           SUBTYPE ACC_REC_3 IS ACC_REC(C3);
-           R : ACC_REC;
- 
-           FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3;
- 
-           TYPE ACC1 IS PRIVATE;
-           TYPE ACC2 IS PRIVATE;
-           TYPE DER1 IS PRIVATE;
-           TYPE DER2 IS PRIVATE;
- 
-      PRIVATE
- 
-           TYPE ACC1 IS ACCESS ACC_REC(C3);
-           TYPE ACC2 IS ACCESS ACC_ARR(1..C3);
-           TYPE DER1 IS NEW ACC_REC(C3);
-           TYPE DER2 IS NEW ACC_ARR(1..C3);
-      END P;
- 
-      PACKAGE BODY P IS
-           FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3 IS
-           BEGIN
-                RETURN PARM;
-           END;
-      END P;
- 
-      PACKAGE NP IS NEW P (ACC_REC => P_REC_NAME, ACC_ARR => P_ARR_NAME);
- 
-      USE NP;
- BEGIN
-      TEST ("C38002B", "NON-STATIC CONSTRAINTS CAN BE IMPOSED " &
-            "ON ACCESS TYPES ACCESSING PREVIOUSLY UNCONSTRAINED " &
-            "ARRAY OR RECORD TYPES");
- 
-      R := NEW REC(DISC => 3);
-      R := F(R);
-      R := NEW REC(DISC => 4);
-      R := F(R);
-      FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE ACCEPTED " &
-              "BY GENERIC FUNCTION");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF R = NULL OR ELSE R.DISC /= 4 THEN
-                     FAILED (" ERROR IN EVALUATION/ASSIGNMENT OF " &
-                             "GENERIC ACCESS VALUE");
-                END IF;
- 
-      RESULT;
- END C38002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C38005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL (UNINITIALIZED) ACCESS OBJECTS ARE INITIALIZED
- -- TO NULL BY DEFAULT. VARIABLES, ARRAYS, RECORDS, ARRAYS OF RECORDS,
- -- ARRAYS OF ARRAYS, RECORDS WITH ARRAYS AND RECORD COMPONENTS
- -- ARE ALL CHECKED.
- -- FUNCTION RESULTS (I.E. RETURNED FROM IMPLICIT FUNCTION RETURN)
- -- ARE NOT CHECKED.
- 
- -- DAT 3/6/81
- -- VKG 1/5/83
- -- SPS 2/17/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C38005A IS
- 
-      TYPE REC;
-      TYPE ACC_REC IS ACCESS REC;
-      TYPE VECTOR IS ARRAY ( NATURAL RANGE <> ) OF ACC_REC;
-      TYPE REC IS RECORD
-           VECT : VECTOR (3 .. 5);
-      END RECORD;
- 
-      TYPE ACC_VECT IS ACCESS VECTOR;
-      TYPE ARR_REC IS ARRAY (1 .. 2) OF REC;
-      TYPE REC2;
-      TYPE ACC_REC2 IS ACCESS REC2;
-      TYPE REC2 IS RECORD
-           C1 : ACC_REC;
-           C2 : ACC_VECT;
-           C3 : ARR_REC;
-           C4 : REC;
-           C5 : ACC_REC2;
-      END RECORD;
- 
-      N_REC      : REC;
-      N_ACC_REC  : ACC_REC;
-      N_VEC      : VECTOR (3 .. IDENT_INT (5));
-      N_ACC_VECT : ACC_VECT;
-      N_ARR_REC  : ARR_REC;
-      N_REC2     : REC2;
-      N_ACC_REC2 : ACC_REC2;
-      N_ARR      : ARRAY (1..2) OF VECTOR (1..2);
-      Q : REC2 :=
-                 (C1 => NEW REC,
-                  C2 => NEW VECTOR'(NEW REC, NEW REC'(N_REC)),
-                  C3 => (1 | 2 => (VECT=>(3|4=> NEW REC, 
-                                          5=>N_ACC_REC)
-                                  )),
-                  C4 => N_REC2.C4,
-                  C5 => NEW REC2'(N_REC2));
- 
- BEGIN
-      TEST ("C38005A", "DEFAULT VALUE FOR ACCESS OBJECTS IS NULL");
- 
-      IF N_REC /= REC'(VECT => (3..5 => NULL))
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 1");
-      END IF;
- 
-      IF N_ACC_REC /= NULL
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 2");
-      END IF;
- 
-      IF N_VEC /= N_REC.VECT
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 3");
-      END IF;
- 
-      IF N_ARR /= ((NULL, NULL), (NULL, NULL))
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 4");
-      END IF;
- 
-      IF N_ACC_VECT /= NULL
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 5");
-      END IF;
- 
-      IF N_ARR_REC /= (N_REC, N_REC)
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 6");
-      END IF;
- 
-      IF N_REC2 /= (NULL, NULL, N_ARR_REC, N_REC, NULL)
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 7");
-      END IF;
- 
-      IF N_ACC_REC2 /= NULL
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 8");
-      END IF;
- 
-      IF Q /= (Q.C1, Q.C2, (Q.C3(1), Q.C3(2)), N_REC, Q.C5)
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 9");
-      END IF;
- 
-      IF Q.C1.ALL /= N_REC
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 10");
-      END IF;
- 
-      IF Q.C2.ALL(0).ALL /= N_REC
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 11");
-      END IF;
- 
-      IF Q.C2(1).VECT /= N_VEC
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 12");
-      END IF;
- 
-      IF Q.C3(2).VECT /= (3 => Q.C3(2).VECT(3),
-                          4 => Q.C3(2).VECT(4),
-                          5=>NULL)
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 13");
-      END IF;
- 
-      IF Q.C3(2).VECT(3).ALL /= N_REC
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 14");
-      END IF;
- 
-      IF Q.C5.ALL /= N_REC2
-      THEN
-           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 15");
-      END IF;
- 
-      DECLARE
-           PROCEDURE T (R : OUT REC2) IS
-           BEGIN
-                NULL;
-           END T;
-      BEGIN
-           N_REC2 := Q;
-           T(Q);
-           IF Q /= N_REC2 THEN
-                FAILED ("INCORRECT OUT PARM INIT 2");
-           END IF;
-      END;
- 
-      RESULT;
- END C38005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C38005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ANY OBJECT WITH A FORMAL PRIVATE TYPE, WHOSE ACTUAL
- --     TYPE IN AN INSTANTIATION IS AN ACCESS TYPE, IS INITIALIZED BY
- --     DEFAULT TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH ARE ARRAY
- --     AND RECORD COMPONENTS.
- 
- -- HISTORY:
- --     DHH 07/12/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38005B IS
- 
- BEGIN
-      TEST("C38005B", "CHECK THAT ANY OBJECT WITH A FORMAL PRIVATE " &
-                      "TYPE, WHOSE ACTUAL TYPE IN AN INSTANTIATION " &
-                      "IS AN ACCESS TYPE, IS INITIALIZED BY DEFAULT " &
-                      "TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH " &
-                      "ARE ARRAY AND RECORD COMPONENTS");
-      DECLARE
-           TYPE ARRY IS ARRAY(1 .. 10) OF BOOLEAN;
-           TYPE REC1 IS
-                RECORD
-                     A : INTEGER;
-                     B : ARRY;
-                END RECORD;
- 
-           TYPE POINTER IS ACCESS REC1;
- 
-           GENERIC
-                TYPE NEW_PTR IS PRIVATE;
-           PACKAGE GEN_PACK IS
-                TYPE PTR_ARY IS ARRAY(1 .. 5) OF NEW_PTR;
-                TYPE RECORD1 IS
-                     RECORD
-                          A : NEW_PTR;
-                          B : PTR_ARY;
-                     END RECORD;
- 
-                OBJ : NEW_PTR;
-                ARY : PTR_ARY;
-                REC : RECORD1;
-           END GEN_PACK;
- 
-           PACKAGE TEST_P IS NEW GEN_PACK(POINTER);
-           USE TEST_P;
- 
-      BEGIN
-           IF OBJ /= NULL THEN
-                FAILED("OBJECT NOT INITIALIZED TO NULL");
-           END IF;
- 
-           FOR I IN 1 .. 5 LOOP
-                IF ARY(I) /= NULL THEN
-                     FAILED("ARRAY COMPONENT " &
-                             INTEGER'IMAGE(I) &
-                            " NOT INITIALIZED TO NULL");
-                END IF;
-           END LOOP;
- 
-           IF REC.A /= NULL THEN
-                FAILED("RECORD OBJECT NOT INITIALIZED TO NULL");
-           END IF;
- 
-           FOR I IN 1 .. 5 LOOP
-                IF REC.B(I) /= NULL THEN
-                     FAILED("RECORD SUBCOMPONENT " &
-                            INTEGER'IMAGE(I) &
-                            " NOT INITIALIZED TO NULL");
-                END IF;
-           END LOOP;
-      END;
- 
-      RESULT;
- END C38005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38005c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38005c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38005c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- C38005C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ALL OBJECTS OF FORMAL ACCESS TYPE, INCLUDING ARRAY AND
- --     RECORD COMPONENTS, ARE INITIALIZED BY DEFAULT WITH THE VALUE
- --     NULL.
- 
- -- HISTORY:
- --     DHH 08/04/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38005C IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
- 
-      TYPE ACC_I IS ACCESS INT;
- 
-      SUBTYPE NEW_NODE IS CHARACTER;
- 
-      TYPE ACC_CHAR IS ACCESS NEW_NODE;
- 
-      X : ACC_I := NEW INT'(IDENT_INT(5));
-      Y : NEW_NODE := 'A';
-      Z : ACC_CHAR := NEW NEW_NODE'(Y);
- 
-      GENERIC
-           TYPE ACC_INT IS ACCESS INT;
-           TYPE NODE IS PRIVATE;
-           TYPE LINK IS ACCESS NODE;
-      PROCEDURE P(U : ACC_INT; V : NODE; W : LINK);
- 
-      GENERIC
-           TYPE ACC_INT IS ACCESS INT;
-           TYPE NODE IS PRIVATE;
-           TYPE LINK IS ACCESS NODE;
-      PACKAGE PACK IS
- 
-           SUBTYPE NEW_ACC IS ACC_INT;
- 
-           SUBTYPE NEW_L IS LINK;
- 
-           TYPE ARR IS ARRAY(1 .. 4) OF ACC_INT;
- 
-           TYPE REC IS
-                RECORD
-                     I : ACC_INT;
-                     L : LINK;
-                END RECORD;
- 
-      END PACK;
- 
-      PACKAGE NEW_PACK IS NEW PACK(ACC_I, NEW_NODE, ACC_CHAR);
-      USE NEW_PACK;
- 
-      A : NEW_PACK.NEW_ACC;
-      B : NEW_PACK.NEW_L;
-      C : NEW_PACK.ARR;
-      D : NEW_PACK.REC;
- 
-      PROCEDURE P(U : ACC_INT; V : NODE; W : LINK) IS
- 
-           TYPE ARR IS ARRAY(1 .. 4) OF ACC_INT;
- 
-           TYPE REC IS
-                RECORD
-                     I : ACC_INT;
-                     L : LINK;
-                END RECORD;
- 
-           A : ACC_INT;
-           B : LINK;
-           C : ARR;
-           D : REC;
- 
-      BEGIN
-           IF A /= NULL THEN
-                FAILED("OBJECT A NOT INITIALIZED - PROC");
-           END IF;
- 
-           IF B /= NULL THEN
-                FAILED("OBJECT B NOT INITIALIZED - PROC");
-           END IF;
- 
-           FOR I IN 1 .. 4 LOOP
-                IF C(I) /= NULL THEN
-                     FAILED("ARRAY " & INTEGER'IMAGE(I) &
-                            "NOT INITIALIZED - PROC");
-                END IF;
-           END LOOP;
- 
-           IF D.I /= NULL THEN
-                FAILED("RECORD.I NOT INITIALIZED - PROC");
-           END IF;
- 
-           IF D.L /= NULL THEN
-                FAILED("RECORD.L NOT INITIALIZED - PROC");
-           END IF;
- 
-      END P;
- 
-      PROCEDURE PROC IS NEW P(ACC_I, NEW_NODE, ACC_CHAR);
- 
- BEGIN
-      TEST("C38005C", "CHECK THAT ALL OBJECTS OF FORMAL ACCESS TYPE, " &
-                      "INCLUDING ARRAY AND RECORD COMPONENTS, ARE " &
-                      "INITIALIZED BY DEFAULT WITH THE VALUE NULL");
- 
-      PROC(X, Y, Z);
- 
-      IF A /= NULL THEN
-           FAILED("OBJECT A NOT INITIALIZED - PACK");
-      END IF;
- 
-      IF B /= NULL THEN
-           FAILED("OBJECT B NOT INITIALIZED - PACK");
-      END IF;
- 
-      FOR I IN 1 .. 4 LOOP
-           IF C(I) /= NULL THEN
-                FAILED("ARRAY " & INTEGER'IMAGE(I) &
-                       "NOT INITIALIZED - PACK");
-           END IF;
-      END LOOP;
- 
-      IF D.I /= NULL THEN
-           FAILED("RECORD.I NOT INITIALIZED - PACK");
-      END IF;
- 
-      IF D.L /= NULL THEN
-           FAILED("RECORD.L NOT INITIALIZED - PACK");
-      END IF;
- 
-      RESULT;
- END C38005C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- C38006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OBJECTS ACCESSED BY CONSTANTS CAN BE MODIFIED.
- 
- -- DAT 3/6/81
- -- SPS 10/25/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C38006A IS
- 
-      TYPE AI IS ACCESS INTEGER;
- 
-      C : CONSTANT AI := NEW INTEGER'(1);
- 
- BEGIN
-      TEST ("C38006A", "OBJECTS ACCESSED BY CONSTANTS MAY BE ASSIGNED");
- 
-      FOR I IN 1 .. 10 LOOP
-           IF C.ALL /= I AND I > 1 THEN
-                FAILED ("OBJECT ACCESSED THRU CONSTANT NOT CHANGED");
-                EXIT;
-           END IF;
-           C.ALL := C.ALL + 1;
-      END LOOP;
- 
-      RESULT;
- END C38006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C38102A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INCOMPLETE TYPE DECLARATION CAN BE GIVEN FOR ANY TYPE.
- -- FULL DECLARATIONS FOR INTEGER, ENUMERATION, CONSTRAINED AND
- -- UNCONSTRAINED ARRAYS, RECORDS WITHOUT DISCRIMINANTS,
- -- AN ACCESS TYPE, OR TYPES DERIVED FROM ANY OF THE ABOVE.
- 
- -- (FLOAT, FIXED, TASKS AND RECORDS WITH DISCRIMINANTS ARE CHECKED
- -- IN OTHER TESTS).
- 
- -- DAT 3/24/81
- -- SPS 10/25/82
- -- SPS 2/17/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C38102A IS
- BEGIN
-      TEST ("C38102A", "ANY TYPE MAY BE INCOMPLETE");
- 
-      DECLARE
- 
-           TYPE X1;
-           TYPE X2;
-           TYPE X3;
-           TYPE X4;
-           TYPE X5;
-           TYPE X6;
-           TYPE X7;
-           TYPE X8;
-      
-           TYPE D1;
-           TYPE D2;
-           TYPE D3;
-           TYPE D4;
-           TYPE D5;
-           TYPE D6;
-      
-           TYPE X1 IS RANGE 1 .. 10;
-           TYPE X2 IS (TRUE, FALSE, MAYBE, GREEN);
-           TYPE X3 IS ARRAY (1 .. 3) OF STRING (1..10);
-           TYPE X4 IS ARRAY (NATURAL RANGE <> ) OF X3;
-           TYPE AR1 IS ARRAY (X2) OF X3;
-           TYPE X5 IS RECORD
-                C1 : X4 (1..3);
-                C2 : AR1;
-           END RECORD;
-           TYPE X6 IS ACCESS X8;
-           TYPE X7 IS ACCESS X6;
-           TYPE X8 IS ACCESS X6;
-      
-           TYPE D1 IS NEW X1;
-           TYPE D2 IS NEW X2;
-           TYPE D3 IS NEW X3;
-           TYPE D4 IS NEW X4;
-           TYPE D5 IS NEW X5;
-           SUBTYPE D7 IS X7;
-           SUBTYPE D8 IS X8;
-           TYPE D6 IS ACCESS D8;
-      
-           PACKAGE P IS
-      
-                TYPE X1;
-                TYPE X2;
-                TYPE X3;
-                TYPE X4;
-                TYPE X5;
-                TYPE X6;
-                TYPE X7 IS PRIVATE;
-                TYPE X8 IS LIMITED PRIVATE;
-      
-                TYPE D1;
-                TYPE D2;
-                TYPE D3;
-                TYPE D4;
-                TYPE D5;
-                TYPE D6;
-      
-                TYPE X1 IS RANGE 1 .. 10;
-                TYPE X2 IS (TRUE, FALSE, MAYBE, GREEN);
-                TYPE X3 IS ARRAY (1 .. 3) OF STRING (1..10);
-                TYPE X4 IS ARRAY (NATURAL RANGE <> ) OF X3;
-                TYPE AR1 IS ARRAY (X2) OF X3;
-                TYPE X5 IS RECORD
-                     C1 : X4 (1..3);
-                     C2 : AR1;
-                END RECORD;
-                TYPE X6 IS ACCESS X8;
-      
-                TYPE D1 IS RANGE 1 .. 10;
-                TYPE D2 IS NEW X2;
-                TYPE D3 IS NEW X3;
-                TYPE D4 IS NEW X4;
-                TYPE D5 IS NEW X5;
-                TYPE D6 IS NEW X6;
-                SUBTYPE D7 IS X7;
-                SUBTYPE D8 IS X8;
-                TYPE D9 IS ACCESS D8;
- 
-                VX7 : CONSTANT X7;
-      
-           PRIVATE
-      
-                TYPE X7 IS RECORD
-                     C1 : X1;
-                     C3 : X3;
-                     C5 : X5;
-                     C6 : X6;
-                     C8 : D9;
-                END RECORD;
- 
-                V3 : X3 := (X3'RANGE => "ABCDEFGHIJ");
-                TYPE A7 IS ACCESS X7;
-                TYPE X8 IS ARRAY (V3'RANGE) OF A7;
-      
-                VX7 : CONSTANT X7 := (3, V3, ((1..3=>V3),
-                     (TRUE..GREEN=>V3)), NULL,
-                     NEW D8);
-           END P;
-           USE P;
- 
-           VD7: P.D7;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                VD7 := D7(VX7);
-           END P;
- 
-      BEGIN
-           IF VX7 /= P.X7(VD7) THEN
-                FAILED ("WRONG VALUE SOMEWHERE");
-           END IF;
-      END;
- 
-      RESULT;
- END C38102A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- C38102B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INCOMPLETE TYPES CAN BE FLOAT.
- 
- -- DAT 3/24/81
- -- SPS 10/25/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C38102B IS
- 
- BEGIN
-      TEST ("C38102B", "INCOMPLETE TYPE CAN BE FLOAT");
-      
-      DECLARE
- 
-           TYPE F;
-           TYPE G;
-           TYPE AF IS ACCESS F;
-           TYPE F IS DIGITS 2;
-           TYPE G IS NEW F RANGE 1.0 .. 1.5;
-           TYPE AG IS ACCESS G RANGE 1.0 .. 1.3;
-      
-           XF : AF := NEW F' (2.0);
-           XG : AG := NEW G' (G (XF.ALL/2.0));
- 
-      BEGIN
-           IF XG.ALL NOT IN G THEN
-                FAILED ("ACCESS TO FLOAT");
-           END IF;
-      END;
-      
-      RESULT;
- END C38102B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- C38102C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INCOMPLETE TYPES CAN BE FIXED.
- 
- -- HISTORY:
- --     DAT 03/24/81  CREATED ORIGINAL TEST.
- --     SPS 10/25/82
- --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  CHANGED VARIOUS
- --                   VALUES TO CORRECT CONSTRAINT PROBLEMS.  CHANGED
- --                   THE VALUE OF F'DELTA, USING A POWER OF TWO.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C38102C IS
- BEGIN
-      TEST ("C38102C", "INCOMPLETE TYPE CAN BE FIXED");
- 
-      DECLARE
- 
-           TYPE F;
-           TYPE G;
-           TYPE AF IS ACCESS F;
-           TYPE F IS DELTA 0.25 RANGE -2.0 .. 2.0;
-           TYPE G IS NEW F RANGE -1.0 .. 1.5;
-           TYPE AG IS ACCESS G RANGE -0.75 .. 1.25;
- 
-           XF : AF := NEW F '(1.0);
-           XG : AG := NEW G '(G (XF.ALL/2));
- 
-      BEGIN
-           IF XG.ALL NOT IN G THEN
-                FAILED ("ACCESS TO FIXED");
-           END IF;
-      END;
- 
-      RESULT;
- END C38102C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- C38102D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A TASK TYPE.
- 
- -- AH    8/14/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38102D IS
-      GLOBAL : INTEGER := 0;
- BEGIN
-      TEST("C38102D", "INCOMPLETE TYPES CAN BE TASKS");
-      DECLARE
-           TYPE T1;
-           TASK TYPE T1 IS
-                ENTRY E(LOCAL : IN OUT INTEGER);
-           END T1;
-           T1_OBJ : T1;
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E(LOCAL : IN OUT INTEGER) DO
-                     LOCAL := IDENT_INT(2);
-                END E;
-           END T1;
-      BEGIN
-           T1_OBJ.E(GLOBAL);
-      END;
- 
-      IF GLOBAL /= IDENT_INT(2) THEN
-           FAILED ("TASK NOT EXECUTED");
-      END IF;
-      RESULT;
- END C38102D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38102e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38102e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C38102E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC 
- -- FORMAL TYPE.
- 
- -- AH     8/15/86
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- -- DNT 11/28/95  CHANGED TO FLAG1 := F4.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38102E IS
-      TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET);
-      TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0;
-      TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5;
-      SUBTYPE P1 IS INTEGER;
-      TYPE P2 IS RANGE 0 .. 10;
-      TYPE P3 IS ARRAY (P2) OF INTEGER;
-      TYPE P4 IS ARRAY (P2, P2) OF INTEGER;
- 
-      F1, F2 : BOOLEAN;
- 
-      GENERIC
-           TYPE G1 IS (<>);
-           TYPE G2 IS RANGE <>;
-      FUNCTION G_DISCRETE RETURN BOOLEAN;
- 
-      FUNCTION G_DISCRETE RETURN BOOLEAN IS
-           TYPE INC1;
-           TYPE INC2;
-           TYPE F1 IS NEW G1;
-           TYPE INC1 IS NEW G1;
-           TYPE INC2 IS NEW G2;
- 
-           OBJ1_0 : INC1;
-           OBJ1_1 : INC1;
-           OBJ2_0 : INC2;
-           OBJ2_1 : INC2;
-           OBJ3 : F1;
- 
-           RESULT_VALUE1 : BOOLEAN := FALSE;
-           RESULT_VALUE2 : BOOLEAN := FALSE;
-      BEGIN
-           OBJ3 := F1'LAST;
-           OBJ3 := F1'PRED(OBJ3);
-           IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN
-                RESULT_VALUE1 := TRUE;
-           END IF;
-           OBJ2_0 := INC2'FIRST;
-           OBJ2_1 := INC2'LAST;
-           IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) +
-                                   INC2'PRED(OBJ2_1)) THEN
-                RESULT_VALUE2 := TRUE;
-           END IF;
- 
-           RETURN (RESULT_VALUE1 AND RESULT_VALUE2);
-      END G_DISCRETE;
- 
-      GENERIC
-           TYPE G3 IS DIGITS <>;
-           TYPE G4 IS DELTA <>;
-      PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN);
- 
-      PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS
-           F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN;
-           TYPE INC3;
-           TYPE INC4;
-           TYPE P1 IS NEW G3;
-           TYPE P2 IS NEW G4;
-           TYPE INC3 IS NEW G3;
-           TYPE INC4 IS NEW G4;
-      BEGIN
-           F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST);
- 
-           F5 := P2'FORE = INC4'FORE;
-           F6 := P2'AFT = INC4'AFT;
-           F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST -
-                                                  INC4'FIRST));
-           F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST);
- 
-           FLAG1 := F4;
-           FLAG2 := F5 AND F6 AND F7 AND F8;
-      END REALS;
- 
-      GENERIC
-           TYPE ITEM IS PRIVATE;
-           TYPE INDEX IS RANGE <>;
-           TYPE G5 IS ARRAY (INDEX) OF ITEM;
-           TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM;
-      PACKAGE DIMENSIONS IS
-           TYPE INC5;
-           TYPE INC6;
-           TYPE D1 IS NEW G5;
-           TYPE D2 IS NEW G6;
-           TYPE INC5 IS NEW G5;
-           TYPE INC6 IS NEW G6;
-           FUNCTION CHECK RETURN BOOLEAN;
-      END DIMENSIONS;
- 
-      PACKAGE BODY DIMENSIONS IS
-           FUNCTION CHECK RETURN BOOLEAN IS
-                A1 : INC5;
-                A2 : INC6;
-                DIM1 : D1;
-                DIM2 : D2;
-                F1, F2 : BOOLEAN;
-           BEGIN
-                F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE;
-                F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE = 
-                      DIM2(INDEX'FIRST, INDEX'LAST)'SIZE;
- 
-                RETURN (F1 AND F2);
-           END CHECK;
-      END DIMENSIONS;
-      
-      PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED);
-      FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2);
-      PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3,
-                                     G6 => P4);
- 
-      USE PKG;
- BEGIN
-      TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " &
-                       "FORMAL TYPES");
- 
-      IF NOT DISCRETE THEN
-           FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED");
-      END IF;
- 
-      PROC (F1, F2);
-      IF (NOT F1) THEN
-           FAILED ("FLOAT TYPES NOT DERIVED");
-      END IF;
-      IF (NOT F2) THEN
-           FAILED ("FIXED TYPES NOT DERIVED");
-      END IF;
- 
-      IF NOT CHECK THEN
-           FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED");
-      END IF;
- 
-      RESULT;
- END C38102E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38104a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C38104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN INCOMPLETE TYPE WITH DISCRIMINANTS CAN BE
- --     USED IN AN ACCESS TYPE DEFINITION WITH A COMPATIBLE DISCRIMINANT
- --     CONSTRAINT.
- 
- -- HISTORY:
- --     PMW 09/01/88  CREATED ORIGINAL TEST BY RENAMING E38104A.ADA.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C38104A IS
- 
- BEGIN
- 
-      TEST ("C38104A","INCOMPLETELY DECLARED TYPE CAN BE USED AS TYPE " &
-            "MARK IN ACCESS TYPE DEFINITION, AND CAN BE CONSTRAINED " &
-            "THERE OR LATER IF INCOMPLETE TYPE HAD DISCRIMINANT(S)");
- 
-      DECLARE
-           TYPE T1;
-           TYPE T1_NAME IS ACCESS T1;
- 
-           TYPE T1 IS
-                RECORD
-                     COMP : INTEGER;
-                END RECORD;
- 
-           TYPE T2(DISC : INTEGER := 5);
-           TYPE T2_NAME1 IS ACCESS T2(5);
-           TYPE T2_NAME2 IS ACCESS T2;
- 
-           SUBTYPE SUB_T2_NAME2 IS T2_NAME2(5);
-           TYPE T2_NAME2_NAME IS ACCESS T2_NAME2(5);
-           X : T2_NAME2(5);
- 
-           TYPE T2(DISC : INTEGER := 5) IS
-                RECORD
-                     COMP : T2_NAME2(DISC);
-                END RECORD;
- 
-           X1N : T1_NAME;
-           X2A,X2B : T2;
-           X2N2 : T2_NAME2;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                X1N := NEW T1 '(COMP => 5);
-           END IF;
- 
-           IF X1N.COMP /= 5 THEN
-                FAILED ("ASSIGNMENT FAILED - 1");
-           END IF;
- 
-           X2A := (DISC => IDENT_INT(7), COMP => NULL);
-           X2N2 := NEW T2(IDENT_INT(7));
-           X2N2.ALL := X2A;
- 
-           IF EQUAL(3,3) THEN
-                X2B := (DISC => IDENT_INT(7), COMP => X2N2);
-           END IF;
- 
-           IF X2B.COMP.COMP /= NULL
-                OR X2B.COMP.DISC /= 7 THEN
-                FAILED ("ASSIGNMENT FAILED - 2");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C38104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38107a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38107a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38107a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C38107A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR AN INCOMPLETE TYPE WITH DISCRIMINANTS DECLARED IN THE
- --     VISIBLE PART OF A PACKAGE OR IN A DECLARATIVE PART, CHECK THAT
- --     CONSTRAINT_ERROR IS RAISED IF A DISCRIMINANT CONSTRAINT IS
- --     SPECIFIED FOR THE TYPE AND ONE OF THE DISCRIMINANT VALUES DOES
- --     NOT BELONG TO THE CORRESPONDING DISCRIMINANT'S SUBTYPE.
- 
- -- HISTORY:
- --     BCB 01/21/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C38107A IS
- 
- BEGIN
-      TEST ("C38107A", "FOR AN INCOMPLETE TYPE WITH DISCRIMINANTS " &
-                       "DECLARED IN THE VISIBLE PART OF A PACKAGE OR " &
-                       "IN A DECLARATIVE PART, CHECK THAT CONSTRAINT_" &
-                       "ERROR IS RAISED IF A DISCRIMINANT CONSTRAINT " &
-                       "IS SPECIFIED FOR THE TYPE AND ONE OF THE " &
-                       "DISCRIMINANT VALUES DOES NOT BELONG TO THE " &
-                       "CORRESPONDING DISCRIMINANT'S SUBTYPE");
- 
-      BEGIN
-           DECLARE
-                PACKAGE P IS
-                     SUBTYPE INT6 IS INTEGER RANGE 1 .. 6;
-                     TYPE T_INT6 (D6 : INT6);
-                     TYPE TEST IS ACCESS T_INT6(7);  -- CONSTRAINT_ERROR.
-                     TYPE T_INT6 (D6 : INT6) IS
-                          RECORD
-                               NULL;
-                          END RECORD;
-                END P;
-                USE P;
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
-                DECLARE
-                     T : P.TEST := NEW T_INT6(7);
-                BEGIN
-                     IF EQUAL(T.D6, T.D6) THEN
-                          COMMENT ("DON'T OPTIMIZE T.D6");
-                     END IF;
-                END;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 1");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE INT7 IS INTEGER RANGE 1 .. 7;
-                TYPE T_INT7 (D7 : INT7);
-                TYPE TEST IS ACCESS T_INT7(8);       -- CONSTRAINT_ERROR.
-                TYPE T_INT7 (D7 : INT7) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
-                DECLARE
-                     T : TEST := NEW T_INT7(6);
-                BEGIN
-                     IF EQUAL(T.D7, T.D7) THEN
-                          COMMENT ("DON'T OPTIMIZE T.D7");
-                     END IF;
-                END;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 2");
-      END;
-      RESULT;
- END C38107A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38107b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38107b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38107b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38107b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,194 ****
- -- C38107B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN ACCESS TYPE WHICH
- --     DESIGNATES AN INCOMPLETE TYPE WHICH WAS DECLARED IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN A DECLARATIVE
- --     PART, CONSTRAINT_ERROR IS RAISED IF ONE OF THE
- --     DISCRIMINANT'S VALUES DOES NOT BELONG TO THE CORRESPONDING
- --     DISCRIMINANT'S SUBTYPE.
- 
- -- HISTORY:
- --     DHH 08/05/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38107B IS
- 
- BEGIN
-      TEST("C38107B", "IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN " &
-                      "ACCESS TYPE WHICH DESIGNATES AN INCOMPLETE " &
-                      "TYPE WHICH WAS DECLARED IN THE VISIBLE OR " &
-                      "PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN " &
-                      "A DECLARATIVE PART, CONSTRAINT_ERROR IS " &
-                      "RAISED IF ONE OF THE DISCRIMINANT'S VALUES " &
-                      "DOES NOT BELONG TO THE CORRESPONDING " &
-                      "DISCRIMINANT'S SUBTYPE");
- 
- ------------------------------ VISIBLE ------------------------------
-      BEGIN
-           DECLARE
-                PACKAGE PACK IS
-                     SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
- 
-                     TYPE INCOMPLETE(A : SMALLER);
- 
-                     TYPE ACC_INC IS ACCESS INCOMPLETE;
-                     SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
- 
-                     TYPE INCOMPLETE(A : SMALLER) IS
-                          RECORD
-                               T : INTEGER := A;
-                          END RECORD;
- 
-                END PACK;
- 
-                PACKAGE BODY PACK IS
-                BEGIN
-                     FAILED("CONSTRAINT_ERROR NOT RAISED - VISIBLE");
-                     DECLARE
-                          Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
-                     BEGIN
-                          IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
-                               COMMENT("THIS LINE SHOULD NOT PRINT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          FAILED("CONSTRAINT_ERROR RAISED LATE " &
-                                 "- VISIBLE");
-                     WHEN OTHERS =>
-                          FAILED("UNEXPECTED EXCEPTION RAISED " &
-                                 "LATE - VISIBLE");
-                END PACK;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED " &
-                       "- VISIBLE");
-      END;
- 
- ------------------------------ PRIVATE ------------------------------
-      BEGIN
-           DECLARE
-                PACKAGE PACK2 IS
-                     SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
- 
-                     TYPE PRIV IS PRIVATE;
- 
-                PRIVATE
-                     TYPE PRIV IS
-                          RECORD
-                               V : INTEGER;
-                          END RECORD;
- 
-                     TYPE INCOMPLETE(A : SMALLER);
- 
-                     TYPE ACC_INC IS ACCESS INCOMPLETE;
-                     SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(0));
- 
-                     TYPE INCOMPLETE(A : SMALLER) IS
-                          RECORD
-                               T : INTEGER := A;
-                               U : PRIV := (V => A ** IDENT_INT(2));
-                          END RECORD;
- 
-                END PACK2;
- 
-                PACKAGE BODY PACK2 IS
-                BEGIN
-                     FAILED("CONSTRAINT_ERROR NOT RAISED - PRIVATE");
-                     DECLARE
-                          Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(0));
-                     BEGIN
-                          IF IDENT_INT(Z.T) = IDENT_INT(0) THEN
-                               COMMENT("THIS LINE SHOULD NOT PRINT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
-                                 "- PRIVATE");
-                     WHEN OTHERS =>
-                          FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
-                                 "- PRIVATE");
-                END PACK2;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                          FAILED("UNEXPECTED EXCEPTION RAISED " &
-                                 "- PRIVATE");
-      END;
- 
- -------------------------- DECLARATIVE PART --------------------------
-      BEGIN
-           DECLARE
-                SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
- 
-                TYPE INCOMPLETE(A : SMALLER);
- 
-                TYPE ACC_INC IS ACCESS INCOMPLETE;
-                SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
- 
-                TYPE INCOMPLETE(A : SMALLER) IS
-                     RECORD
-                          T : INTEGER := INTEGER'(A);
-                     END RECORD;
- 
-           BEGIN
-                FAILED("CONSTRAINT_ERROR NOT RAISED - BLOCK " &
-                       "STATEMENT");
-                DECLARE
-                     Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
-                BEGIN
-                     IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
-                          COMMENT("THIS LINE SHOULD NOT PRINT");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
-                            "- BLOCK STATEMENT");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
-                            "- BLOCK STATEMENT");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                          FAILED("UNEXPECTED EXCEPTION RAISED " &
-                                 "- BLOCK STATEMENT");
-      END;
- 
-      RESULT;
- END C38107B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C38108A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
- -- A PACKAGE, WITH THE FULL DECLARATION OCCURRING IN THE PACKAGE BODY.
- 
- -- AH  8/20/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C38108A IS
- 
-      PACKAGE P IS 
-           TYPE L IS LIMITED PRIVATE;
-           PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
-           FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
-      PRIVATE
-           TYPE INC (D : INTEGER);
-           TYPE L IS ACCESS INC;
-      END P;
- 
-      PACKAGE BODY P IS
-           TYPE INC (D : INTEGER) IS
-                RECORD
-                     C : INTEGER;
-                END RECORD;
-           
-           PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
-           BEGIN
-                Y := NEW INC(1);
-                Y.C := X;
-           END ASSIGN;
- 
-           FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
-           BEGIN
-                RETURN (X.C = Y.C);          
-           END "=";
- 
-      END P;
- 
- USE P;
- BEGIN
- 
-      TEST ("C38108A", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
-                       "PRIVATE PART WITHOUT FULL DECLARATION");
-      DECLARE
-           VAL_1, VAL_2 : L;
-      BEGIN
-           ASSIGN (2, VAL_1);
-           ASSIGN (2, VAL_2);
-           IF NOT "=" (VAL_1, VAL_2) THEN
-                FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
-           END IF;
-      END;
- 
-      RESULT;
- END C38108A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- C38108B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
- -- A LIBRARY PACKAGE, WITH THE FULL DECLARATION OCCURRING LATER IN A 
- -- PACKAGE BODY.
- 
- -- AH  8/20/86
- 
- PACKAGE C38108B_P IS 
-      TYPE L IS LIMITED PRIVATE;
-      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
-      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
- PRIVATE
-      TYPE INC (D : INTEGER);
-      TYPE L IS ACCESS INC;
- END C38108B_P;
- 
- PACKAGE BODY C38108B_P IS
-      TYPE INC (D : INTEGER) IS
-           RECORD
-                C : INTEGER;
-           END RECORD;
-      
-      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
-      BEGIN
-           Y := NEW INC(1);
-           Y.C := X;
-      END ASSIGN;
- 
-      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
-      BEGIN
-           RETURN (X.C = Y.C);          
-      END "=";
- 
- END C38108B_P;
- 
- WITH REPORT; USE REPORT;
- WITH C38108B_P; USE C38108B_P;
- PROCEDURE C38108B IS
-      VAL_1, VAL_2 : L;
- BEGIN
- 
-      TEST ("C38108B", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
-                       "PRIVATE PART WITHOUT FULL DECLARATION - " &
-                       "LIBRARY PACKAGE");
- 
-      ASSIGN (2, VAL_1);
-      ASSIGN (2, VAL_2);
-      IF NOT "=" (VAL_1, VAL_2) THEN
-           FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
-      END IF;
- 
-      RESULT;
- END C38108B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108c0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- C38108C0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SPECIFICATION OF LIBRARY PACKAGE USED WITH C38108C1M.
- 
- -- AH  8/20/86
- 
- PACKAGE C38108C0 IS
-      TYPE L IS LIMITED PRIVATE;
-      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
-      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
- PRIVATE
-      TYPE INC (D : INTEGER);
-      TYPE L IS ACCESS INC;
- END C38108C0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108c1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- C38108C1M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INCOMPLETE TYPE CAN BE DELCARED IN A SEPARATELY
- -- COMPILED PACKAGE SPECIFICATION AND ITS FULL DECLARATION CAN LATER BE 
- -- GIVEN IN A SEPARATELY COMPILED BODY.
- 
- -- AH  8/20/86
- 
- -- C38108C0    THE PACKAGE SPECIFICATION.
- -- C38108C1M   THE MAIN PROGRAM.
- -- C38108C2    THE PACKAGE BODY.
- 
- WITH REPORT; USE REPORT;
- WITH C38108C0; USE C38108C0;
- PROCEDURE C38108C1M IS
-      VAL_1, VAL_2 : L;
- BEGIN
- 
-      TEST ("C38108C", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
-                       "PRIVATE PART WITHOUT FULL DECLARATION - " &
-                       "LIBRARY PACKAGE");
- 
-      ASSIGN (2, VAL_1);
-      ASSIGN (2, VAL_2);
-      IF NOT "=" (VAL_1, VAL_2) THEN
-           FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
-      END IF;
- 
-      RESULT;
- END C38108C1M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108c2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108c2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108c2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,47 ****
- -- C38108C2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- PACKAGE BODY FOR USE WITH C38108C1M.
- -- SPECIFICATION IS IN C38108C0.
- 
- -- AH  8/20/86
- 
- PACKAGE BODY C38108C0 IS
-      TYPE INC (D : INTEGER) IS
-           RECORD
-                C : INTEGER;
-           END RECORD;
-      
-      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
-      BEGIN
-           Y := NEW INC(1);
-           Y.C := X;
-      END ASSIGN;
- 
-      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
-      BEGIN
-           RETURN (X.C = Y.C);          
-      END "=";
- 
- END C38108C0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108d0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108d0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108d0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- C38108D0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
- -- A PACKAGE, WITH THE FULL DECLARATION OCCURRING LATER IN A 
- -- PACKAGE BODY SUBUNIT.
- 
- -- OTHER FILES: C38108D1.ADA (PACKAGE BODY SUBUNIT.)
- 
- -- AH  8/20/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C38108D0M IS
-      PACKAGE C38108D1 IS
-           TYPE L IS LIMITED PRIVATE;
-           PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
-           FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
-      PRIVATE
-           TYPE INC (D : INTEGER);
-           TYPE L IS ACCESS INC;
-      END C38108D1;
- 
-      PACKAGE BODY C38108D1 IS SEPARATE;
- 
- USE C38108D1;
- BEGIN
- 
-      TEST ("C38108D", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
-                       "PRIVATE PART WITH FULL DECLARATION IN " &
-                       "A PACKAGE BODY SUBUNIT");
- 
- DECLARE
-      VAL_1, VAL_2 : L;
- BEGIN
-      ASSIGN (2, VAL_1);
-      ASSIGN (2, VAL_2);
-      IF NOT "=" (VAL_1, VAL_2) THEN
-           FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
-      END IF;
- END;
- 
-      RESULT;
- END C38108D0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108d1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38108d1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38108d1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,47 ****
- -- C38108D1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- PACKAGE BODY SUBUNIT USED WITH C38108D0M.
- 
- -- AH  8/20/86
- 
- SEPARATE (C38108D0M)
- PACKAGE BODY C38108D1 IS
-      TYPE INC (D : INTEGER) IS
-           RECORD
-                C : INTEGER;
-           END RECORD;
-      
-      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
-      BEGIN
-           Y := NEW INC(1);
-           Y.C := X;
-      END ASSIGN;
- 
-      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
-      BEGIN
-           RETURN (X.C = Y.C);          
-      END "=";
- 
- END C38108D1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38202a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c38202a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c38202a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,197 ****
- -- C38202A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT TASKING ATTRIBUTES ARE DECLARED AND RETURN CORRECT 
- -- VALUES FOR OBJECTS HAVING AN ACCESS TYPE WHOSE DESIGNATED 
- -- TYPE IS A TASK TYPE.
- -- CHECK THE ACCESS TYPE RESULTS OF FUNCTION CALLS.
- 
- -- AH  9/12/86
- -- EDS 7/14/98  AVOID OPTIMIZATION
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C38202A IS
- BEGIN 
-      TEST ("C38202A", "OBJECTS HAVING ACCESS TYPES WITH DESIGNATED " &
-            "TASK TYPE CAN BE PREFIX OF TASKING ATTRIBUTES");
- 
- -- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
- --                   (2)  TASK IS NOT CALLABLE, TERMINATED.
- 
-      DECLARE 
-           TASK TYPE TSK IS 
-                ENTRY GO_ON;
-           END TSK;
- 
-           TASK DRIVER IS 
-                ENTRY TSK_DONE;
-           END DRIVER;
- 
-           TYPE P_TYPE IS ACCESS TSK;
-           P : P_TYPE;
- 
-           TASK BODY TSK IS
-                I : INTEGER RANGE 0 .. 2;
-           BEGIN 
-                ACCEPT GO_ON;
-                I := IDENT_INT(5);         -- CONSTRAINT_ERROR RAISED.
-                FAILED ("CONSTAINT_ERROR NOT RAISED IN TASK " &
-                        " TSK - 1A " & INTEGER'IMAGE(I));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     DRIVER.TSK_DONE;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN TASK " &
-                             "TSK - 1A ");
-                     DRIVER.TSK_DONE;
-           END TSK;
- 
-           TASK BODY DRIVER IS
-                COUNTER : INTEGER := 1;
-           BEGIN
-                P := NEW TSK;
-                IF NOT P'CALLABLE THEN
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE - 1B");
-                END IF;
- 
-                IF P'TERMINATED THEN 
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE - 1C");
-                END IF;
- 
-                P.GO_ON;
-                ACCEPT TSK_DONE;
-                WHILE (NOT P'TERMINATED AND COUNTER <= 3) LOOP
-                     DELAY 10.0 * Impdef.One_Second;
-                     COUNTER := COUNTER + 1;
-                END LOOP;
- 
-                IF COUNTER > 3 THEN
-                     FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
-                             "TIME - 1D");
-                END IF;
- 
-                IF P'CALLABLE THEN
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE - 1E");
-                END IF;
- 
-                IF NOT P'TERMINATED THEN
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE - 1F");
-                END IF;
-           END DRIVER;
- 
-      BEGIN
-           NULL;
-      END;     -- BLOCK
- 
- -- CHECK ACCESS TYPE RESULT RETURNED FROM FUNCTION.
- -- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
- --                   (2)  TASK IS NOT CALLABLE, TERMINATED.
- 
-      DECLARE 
-           TASK TYPE TSK IS 
-                ENTRY GO_ON;
-           END TSK;
- 
-           TASK DRIVER IS 
-                ENTRY TSK_DONE;
-           END DRIVER;
- 
-           TYPE P_TYPE IS ACCESS TSK;
-           P : P_TYPE;
- 
-           TSK_CREATED : BOOLEAN := FALSE;
- 
-           FUNCTION F1 RETURN P_TYPE IS
-           BEGIN
-                RETURN P;
-           END F1;
- 
-           TASK BODY TSK IS
-                I : INTEGER RANGE 0 .. 2;
-           BEGIN 
-                ACCEPT GO_ON;
-                I := IDENT_INT(5);          -- CONSTRAINT_ERROR RAISED.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED IN TASK " &
-                        "TSK - 2A " & INTEGER'IMAGE(I));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     DRIVER.TSK_DONE;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN TASK " &
-                             "TSK - 2A ");
-                     DRIVER.TSK_DONE;
-           END TSK;
- 
-           TASK BODY DRIVER IS
-                COUNTER : INTEGER := 1;
-           BEGIN
-                P := NEW TSK;               -- ACTIVATE P.ALL (F1.ALL).
-                IF NOT F1'CALLABLE THEN
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE WHEN PREFIX IS VALUE FROM " &
-                             "FUNCTION CALL - 2B");
-                END IF;
- 
-                IF F1'TERMINATED THEN 
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE WHEN PREFIX IS VALUE FROM " &
-                             "FUNCTION CALL - 2C");
-                END IF;
- 
-                F1.ALL.GO_ON;
-                ACCEPT TSK_DONE;
-                WHILE (NOT F1'TERMINATED AND COUNTER <= 3) LOOP
-                     DELAY 10.0 * Impdef.One_Second;
-                     COUNTER := COUNTER + 1;
-                END LOOP;
- 
-                IF COUNTER > 3 THEN
-                     FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
-                             "TIME - 2D");
-                END IF;
- 
-                IF F1'CALLABLE THEN
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE WHEN PREFIX IS VALUE FROM " &
-                             "FUNCTION CALL - 2E");
-                END IF;
- 
-                IF NOT F1'TERMINATED THEN
-                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
-                             "VALUE WHEN PREFIX IS VALUE FROM " &
-                             "FUNCTION CALL - 2F");
-                END IF;
-           END DRIVER;
- 
-      BEGIN
-           NULL;
-      END;     -- BLOCK
- 
-      RESULT;
- END C38202A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- C3900010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C3900011.AM.
- --
- -- TEST DESCRIPTION:
- --      See C3900011.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --      => C3900010.A
- --         C3900011.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
- --                          for Ada.Calendar.
- --
- --!
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package C3900010 is
- 
- 
-    -- Declarations used by component Display_On and procedure Display.
- 
-    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
-    type Display_Counters is array (Device_Enum) of Natural;
- 
-    Display_Count_For : Display_Counters := (others => 0);
- 
- 
-    -- Declarations required for component Arrival_Time.
- 
-    Default_Time : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1901, 1, 1);
-    Alert_Time   : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1991, 6, 15);
- 
- 
-    type Alert_Type is tagged record                    -- Root tagged type.
-       Arrival_Time : Ada.Calendar.Time := Default_Time;
-       Display_On   : Device_Enum       := Null_Device;
-    end record;
- 
- 
-    procedure Display (A : in Alert_Type);             -- To be inherited by
-                                                       -- all derivatives.
- 
-    procedure Handle (A : in out Alert_Type);          -- To be inherited by
-                                                       -- all derivatives.
- 
- 
- 
-    type Low_Alert_Type is new Alert_Type with record  -- Record extension of
-       Level : Integer := 0;                           -- root tagged type.
-    end record;
- 
-    -- Inherits procedure Display from Alert.
-    -- Inherits procedure Handle  from Alert.
- 
-    function Level_Of (LA : in Low_Alert_Type)         -- To be inherited by
-      return Integer;                                  -- all derivatives.
- 
- 
- 
-    -- Declarations required for component Action_Officer;
- 
-    type Person_Enum is (Nobody,          Duty_Officer,
-                         Watch_Commander, Commanding_Officer);
- 
- 
- 
-    type Medium_Alert_Type is new Low_Alert_Type with record
-       Action_Officer : Person_Enum := Nobody;         -- Record extension of
-    end record;                                        -- record extension.
- 
-    -- Inherits (inherited) procedure Display from Low_Alert_Type.
-    -- Inherits (inherited) procedure Handle  from Low_Alert_Type.
- 
-    -- Inherits function Level_Of from Low_Alert_Type.
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum);
- 
- 
- end C3900010;
- 
- 
-      --==================================================================--
- 
- 
- package body C3900010 is
- 
- 
-    procedure Display (A : in Alert_Type) is
-    begin
-       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
-    end Display;
- 
- 
-    procedure Handle (A : in out Alert_Type) is
-    begin
-       A.Arrival_Time := Alert_Time;
-    end Handle;
- 
- 
-    function Level_Of (LA : in Low_Alert_Type) return Integer is
-    begin
-       return (LA.Level + 1);
-    end Level_Of;
- 
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum) is
-    begin
-       MA.Action_Officer := To;
-    end Assign_Officer;
- 
- 
- end C3900010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900011.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900011.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900011.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900011.am	Thu Jan  1 00:00:00 1970
***************
*** 1,253 ****
- -- C3900011.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a record extension can be declared in the same package
- --      as its parent, and that this parent may be a tagged record or a
- --      record extension. Check that each derivative inherits all user-
- --      defined primitive subprograms of its parent (including those that
- --      its parent inherited), and that it may declare its own primitive
- --      subprograms.
- --
- --      Check that predefined equality operators are defined for the root
- --      tagged type.
- --
- --      Check that type conversion is defined from a type extension to its
- --      parent, and that this parent itself may be a type extension.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type in a package specification. Declare two
- --      primitive subprograms for the type.
- -- 
- --      Extend the root type with a record extension in the same package
- --      specification. Declare a new primitive subprogram for the extension
- --      (in addition to its two inherited subprograms).
- -- 
- --      Extend the extension with a record extension in the same package
- --      specification. Declare a new primitive subprogram for this second
- --      extension (in addition to its three inherited subprograms).
- -- 
- --      In the main program, declare operations for the root tagged type which
- --      utilize aggregates and equality operators to verify the correctness
- --      of the components. Overload these operations for the two type
- --      extensions. Within each of these overloading operations, utilize type
- --      conversion to call the parent's implementation of the same operation.
- -- 
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         C3900010.A
- --      => C3900011.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with C3900010;
- with Report;
- procedure C3900011 is
- 
- 
-    package Check_Alert_Values is
- 
-       -- Declare functions to verify correctness of tagged record components
-       -- before and after calls to their primitive subprograms.
- 
- 
-       -- Alert_Type:
- 
-       function Initial_Values_Okay (A : in C3900010.Alert_Type)
-         return Boolean;
- 
-       function Bad_Final_Values (A : in C3900010.Alert_Type)
-         return Boolean;
- 
- 
-       -- Low_Alert_Type:
- 
-       function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type)
-         return Boolean;
- 
-       function Bad_Final_Values (LA : in C3900010.Low_Alert_Type)
-         return Boolean;
- 
- 
-       -- Medium_Alert_Type:
- 
-       function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type)
-         return Boolean;
- 
-       function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type)
-         return Boolean;
- 
- 
-    end Check_Alert_Values;
- 
- 
-         --==========================================================--
- 
- 
-    package body Check_Alert_Values is
- 
- 
-       function Initial_Values_Okay (A : in C3900010.Alert_Type)
-         return Boolean is
-          use type C3900010.Alert_Type;
-       begin                                      -- "=" operator availability.
-          return (A = (Arrival_Time => C3900010.Default_Time,
-                       Display_On   => C3900010.Null_Device));
-       end Initial_Values_Okay;
- 
- 
-       function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type)
-         return Boolean is
-       begin                                      -- Type conversion.
-          return (Initial_Values_Okay (C3900010.Alert_Type (LA)) and
-                  LA.Level = 0);                               
-       end Initial_Values_Okay;
- 
- 
-       function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type)
-         return Boolean is
-          use type C3900010.Person_Enum;
-       begin                                      -- Type conversion.
-          return (Initial_Values_Okay (C3900010.Low_Alert_Type (MA)) and
-                  MA.Action_Officer = C3900010.Nobody);
-       end Initial_Values_Okay;
- 
- 
-       function Bad_Final_Values (A : in C3900010.Alert_Type)
-         return Boolean is
-          use type C3900010.Alert_Type;
-       begin                                      -- "/=" operator availability.
-          return (A /= (Arrival_Time => C3900010.Alert_Time,
-                        Display_On   => C3900010.Null_Device));
-       end Bad_Final_Values;
- 
- 
-       function Bad_Final_Values (LA : in C3900010.Low_Alert_Type)
-         return Boolean is
-          use type C3900010.Low_Alert_Type;
-       begin                                      -- "=" operator availability.
-          return not ( LA = (Arrival_Time => C3900010.Alert_Time,
-                             Display_On   => C3900010.Teletype,
-                             Level        => 1) );
-       end Bad_Final_Values;
- 
- 
-       function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type)
-         return Boolean is
-          use type C3900010.Medium_Alert_Type;
-       begin                                      -- "/=" operator availability.
-          return ( MA /= (C3900010.Alert_Time,
-                          C3900010.Console,
-                          1,
-                          C3900010.Duty_Officer) );
-       end Bad_Final_Values;
- 
- 
-    end Check_Alert_Values;
- 
- 
-         --==========================================================--
- 
- 
-    use Check_Alert_Values;
-    use C3900010;
- 
-    Root_Alarm   : C3900010.Alert_Type;
-    Low_Alarm    : C3900010.Low_Alert_Type;
-    Medium_Alarm : C3900010.Medium_Alert_Type;
- 
- begin
- 
-    Report.Test ("C390001", "Primitive operation inheritance by type " &
-                 "extensions: all extensions declared in same package " &
-                 "as parent");
- 
- 
- -- Check root tagged type:
- 
-    if Initial_Values_Okay (Root_Alarm) then
-       Handle  (Root_Alarm);                          -- Explicitly declared.
-       Display (Root_Alarm);                          -- Explicitly declared.
- 
-       if Bad_Final_Values (Root_Alarm) then
-          Report.Failed ("Wrong results after Alert_Type calls");
-       end if;
-    else
-       Report.Failed ("Wrong initial values for Alert_Type");
-    end if;
- 
- 
- -- Check record extension of root tagged type:
- 
-    if Initial_Values_Okay (Low_Alarm) then
-       Handle (Low_Alarm);                            -- Inherited.
-       Low_Alarm.Display_On := Teletype;
-       Display (Low_Alarm);                           -- Inherited.
-       Low_Alarm.Level := Level_Of (Low_Alarm);       -- Explicitly declared.
- 
-       if Bad_Final_Values (Low_Alarm) then
-          Report.Failed ("Wrong results after Low_Alert_Type calls");
-       end if;
-    else
-       Report.Failed ("Wrong initial values for Low_Alert_Type");
-    end if;
- 
- 
- -- Check record extension of record extension:
- 
-    if Initial_Values_Okay (Medium_Alarm) then
-       Handle (Medium_Alarm);                         -- Inherited twice.
-       Medium_Alarm.Display_On := Console;
-       Display (Medium_Alarm);                        -- Inherited twice.
-       Medium_Alarm.Level := Level_Of (Medium_Alarm); -- Inherited.
-       Assign_Officer (Medium_Alarm, Duty_Officer);   -- Explicitly declared.
- 
-       if Bad_Final_Values (Medium_Alarm) then
-          Report.Failed ("Wrong results after Medium_Alert_Type calls");
-       end if;
-    else
-       Report.Failed ("Wrong initial values for Medium_Alert_Type");
-    end if;
- 
- 
- -- Check final display counts:
- 
-    if C3900010.Display_Count_For /= (Null_Device => 1,
-                                      Teletype    => 1,
-                                      Console     => 1,
-                                      Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong final values for display counts");
-    end if;
- 
- 
-    Report.Result;
- 
- end C3900011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C390002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a tagged base type may be declared, and derived
- --      from in simple, private and extended forms.  (Overlaps with C390B04)
- --      Check that the package Ada.Tags is present and correctly implemented.
- --      Check for the correct operation of Expanded_Name, External_Tag and
- --      Internal_Tag within that package.  Check that the exception Tag_Error
- --      is correctly raised on calling Internal_Tag with bad input.
- --
- -- TEST DESCRIPTION:
- --      This test declares a tagged type, and derives three types from it.
- --      These types are then used to test the presence and function of the
- --      package Ada.Tags.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --      27 Jan 96   SAIC    Update RM references for 2.1
- --
- --!
- 
- with Report;
- with Ada.Tags;  
- 
- procedure C390002 is
- 
-   package Vehicle is
- 
-     type Object is tagged limited private;  -- ancestor type
-     procedure Create( The_Vehicle : in out Object; Wheels : in Natural );
-     function  Wheels( The_Vehicle : Object ) return Natural;
- 
-   private
- 
-     type Object is tagged limited record
-       Wheel_Count : Natural := 0;
-     end record;
- 
-   end Vehicle;
- 
-   package Motivators is
- 
-     type Bicycle is new Vehicle.Object with null record; -- simple 
- 
-     type Car is new Vehicle.Object with record           -- extended
-       Convertible : Boolean;
-     end record;
- 
-     type Truck is new Vehicle.Object with private;       -- private
- 
-   private
- 
-     type Truck is new Vehicle.Object with record
-       Air_Horn : Boolean;
-     end record;
- 
-   end Motivators;
- 
-   package body Vehicle is
- 
-     procedure Create( The_Vehicle : in out Object; Wheels : in Natural ) is
-     begin
-       The_Vehicle.Wheel_Count := Wheels;
-     end Create;
- 
-     function  Wheels( The_Vehicle : Object ) return Natural is
-     begin
-       return The_Vehicle.Wheel_Count;
-     end Wheels;
- 
-   end Vehicle;
- 
-   function TC_ID_Tag( Tag : in Ada.Tags.Tag ) return Ada.Tags.Tag is
-   begin
-     return Ada.Tags.Internal_Tag( Ada.Tags.External_Tag( Tag ) );
-     Report.Comment("This message intentionally blank.");
-   end TC_ID_Tag;
- 
-   procedure Check_Tags( Machine       : in Vehicle.Object'Class;
-                         Expected_Name : in String;
-                         External_Tag  : in String ) is
-     The_Tag : constant Ada.Tags.Tag := Machine'Tag;
-     use type Ada.Tags.Tag;
-   begin
-       if Ada.Tags.Expanded_Name(The_Tag) /= Expected_Name then  
-          Report.Failed ("Failed in Check_Tags, Expanded_Name "
-                         & Expected_Name);
-       end if;
-       if Ada.Tags.External_Tag(The_Tag) /= External_Tag then  
-          Report.Failed ("Failed in Check_Tags, External_Tag "
-                         & Expected_Name);
-       end if;
-       if Ada.Tags.Internal_Tag(External_Tag) /= The_Tag then
-          Report.Failed ("Failed in Check_Tags, Internal_Tag "
-                         & Expected_Name);
-       end if;
-   end Check_Tags;
- 
-   procedure Check_Exception is
-     Boeing_777_Id : Ada.Tags.Tag;
-   begin
-     Boeing_777_Id := Ada.Tags.Internal_Tag("!@#$%^:*\/?"" not a tag!");
-     Report.Failed ("Failed in Check_Exception, no exception");
-     Boeing_777_Id := TC_ID_Tag( Boeing_777_Id ); 
-   exception
-     when Ada.Tags.Tag_Error => null;  
-     when others =>
-       Report.Failed ("Failed in Check_Exception, wrong exception");
-   end Check_Exception;
- 
-   use Motivators;
-   Two_Wheeler      : Bicycle;
-   Four_Wheeler     : Car;
-   Eighteen_Wheeler : Truck;
- 
- begin  -- Main test procedure.
- 
-     Report.Test ("C390002", "Check that a tagged type may be declared and " &
-                  "derived from in simple, private and extended forms.  " &
-                  "Check package Ada.Tags" );
- 
-     Create( Two_Wheeler,       2 );
-     Create( Four_Wheeler,      4 );
-     Create( Eighteen_Wheeler, 18 );
-    
-     Check_Tags( Machine       => Two_Wheeler, 
-                 Expected_Name => "C390002.MOTIVATORS.BICYCLE",
-                 External_Tag  => Bicycle'External_Tag );
-     Check_Tags( Machine       => Four_Wheeler, 
-                 Expected_Name => "C390002.MOTIVATORS.CAR",
-                 External_Tag  => Car'External_Tag );
-     Check_Tags( Machine       => Eighteen_Wheeler, 
-                 Expected_Name => "C390002.MOTIVATORS.TRUCK",
-                 External_Tag  => Truck'External_Tag );
- 
-     Check_Exception;
-  
-   Report.Result;
- 
- end C390002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,419 ****
- -- C390003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that for a subtype S of a tagged type T, S'Class denotes a
- --     class-wide subtype.  Check that T'Tag denotes the tag of the type T,
- --     and that, for a class-wide tagged type X, X'Tag denotes the tag of X.
- --     Check that the tags of stand alone objects, record and array
- --     components, aggregates, and formal parameters identify their type.
- --     Check that the tag of a value of a formal parameter is that of the
- --     actual parameter, even if the actual is passed by a view conversion.
- --
- -- TEST DESCRIPTION:
- --     This test defines a class hierarchy (based on C390002) and
- --     uses it to determine the correctness of the resulting tag
- --     information generated by the compiler.  A type is defined in the
- --     class which contains components of the class as part of its
- --     definition.  This is to reduce the overall number of types
- --     required, and to achieve the required nesting to accomplish
- --     this test.  The model is that of a car carrier truck; both car
- --     and truck being in the class of Vehicle.
- --
- --      Class Hierarchy:
- --                         Vehicle - - - - - - - (Bicycle)
- --                        /   |   \               /      \
- --                   Truck   Car   Q_Machine   Tandem  Motorcycle
- --                     |
- --                Auto_Carrier
- --      Contains:
- --                Auto_Carrier( Car )
- --                Q_Machine( Car, Motorcycle )
- --
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed ARM references from objective text.
- --      20 Dec 94   SAIC    Replaced three unnecessary extension
- --                          aggregates with simple aggregates.
- --      16 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
- --
- --!
- 
- ----------------------------------------------------------------- C390003_1
- 
- with Ada.Tags;
- package C390003_1 is -- Vehicle
- 
-   type TC_Keys is (Veh, MC, Tand, Car, Q, Truk, Heavy);
-   type States  is (Good, Flat, Worn);
- 
-   type Wheel_List is array(Positive range <>) of States;
- 
-   type Object(Wheels: Positive) is tagged record
-     Wheel_State : Wheel_List(1..Wheels);
-   end record;
- 
-   procedure TC_Validate( It: Object; Key: TC_Keys );
-   procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag );
- 
-   procedure Create( The_Vehicle : in out Object; Tyres : in States );
-   procedure Rotate( The_Vehicle : in out Object );
-   function  Wheels( The_Vehicle : Object ) return Positive;
- 
- end C390003_1; -- Vehicle;
- 
- ----------------------------------------------------------------- C390003_2
- 
- with C390003_1;
- package C390003_2 is -- Motivators
- 
-   package Vehicle renames C390003_1;
-   subtype Bicycle is Vehicle.Object(2);  -- constrained subtype
- 
-   type Motorcycle is new Bicycle with record
-     Displacement : Natural;
-   end record;
-   procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys );
- 
-   type Tandem is new Bicycle with null record;
-   procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys );
- 
-   type Car is new Vehicle.Object(4) with  -- extended, constrained
-     record
-       Displacement : Natural;
-     end record;
-   procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys );
- 
-   type Truck is new Vehicle.Object with  -- extended, unconstrained
-     record
-       Tare : Natural;
-     end record;
-   procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys );
- 
- end C390003_2; -- Motivators;
- 
- ----------------------------------------------------------------- C390003_3
- 
- with C390003_1;
- with C390003_2;
- package C390003_3 is -- Special_Trucks
-   package Vehicle    renames C390003_1;
-   package Motivators renames C390003_2;
-   Max_Cars_On_Vehicle : constant := 6;
-   type Cargo_Index is range 0..Max_Cars_On_Vehicle;
-   type Cargo is array(Cargo_Index range 1..Max_Cars_On_Vehicle)
-                 of Motivators.Car;
-   type Auto_Carrier is new Motivators.Truck(18) with
-     record
-       Load_Count : Cargo_Index := 0;
-       Payload    : Cargo;
-     end record;
-   procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys );
-   procedure Load  ( The_Car : in     Motivators.Car;
-                     Onto    : in out Auto_Carrier);
-   procedure Unload( The_Car :    out Motivators.Car;
-                     Off_of   : in out Auto_Carrier);
- end C390003_3;
- 
- ----------------------------------------------------------------- C390003_4
- 
- with C390003_1;
- with C390003_2;
- package C390003_4 is -- James_Bond
- 
-   package Vehicle   renames C390003_1;
-   package Motivators renames C390003_2;
- 
-   type Q_Machine is new Vehicle.Object(4) with record
-     Car_Part  : Motivators.Car;
-     Bike_Part : Motivators.Motorcycle;
-   end record;
-   procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys );
- 
- end C390003_4;
- 
- ----------------------------------------------------------------- C390003_1
- 
- with Report;
- with Ada.Tags;
- package body C390003_1 is -- Vehicle
- 
-   function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
- 
-   procedure TC_Validate( It: Object; Key: TC_Keys ) is
-   begin
-     if Key /= Veh then
-       Report.Failed("Expected Veh Key");
-     end if;
-   end TC_Validate;
- 
-   procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag ) is
-   begin
-     if It'Tag /= The_Tag then
-       Report.Failed("Unexpected Tag for classwide formal");
-     end if;
-   end TC_Validate;
- 
-   procedure Create( The_Vehicle : in out Object; Tyres : in States ) is
-   begin
-     The_Vehicle.Wheel_State := ( others => Tyres );
-   end Create;
- 
-   function  Wheels( The_Vehicle : Object ) return Positive is
-   begin
-     return The_Vehicle.Wheels;
-   end Wheels;
- 
-   procedure Rotate( The_Vehicle : in out Object ) is
-     Push : States;
-     Pulled : States
-          := The_Vehicle.Wheel_State(The_Vehicle.Wheel_State'Last);
-   begin
-     for Finger in
-         The_Vehicle.Wheel_State'First..The_Vehicle.Wheel_State'Last loop
-       Push := The_Vehicle.Wheel_State(Finger);
-       The_Vehicle.Wheel_State(Finger) := Pulled;
-       Pulled := Push;
-     end loop;
-   end Rotate;
- 
- end C390003_1; -- Vehicle;
- 
- ----------------------------------------------------------------- C390003_2
- 
- with Ada.Tags;
- with Report;
- package body C390003_2 is -- Motivators
- 
-   function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
-   function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
- 
-   procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys ) is
-   begin
-     if Key /= Vehicle.MC then
-       Report.Failed("Expected MC Key");
-     end if;
-   end TC_Validate;
- 
-   procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys ) is
-   begin
-     if Key /= Vehicle.Tand then
-       Report.Failed("Expected Tand Key");
-     end if;
-   end TC_Validate;
- 
-   procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys ) is
-   begin
-     if Key /= Vehicle.Car then
-       Report.Failed("Expected Car Key");
-     end if;
-   end TC_Validate;
- 
-   procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys ) is
-   begin
-     if Key /= Vehicle.Truk then
-       Report.Failed("Expected Truk Key");
-     end if;
-   end TC_Validate;
- end C390003_2; -- Motivators;
- 
- ----------------------------------------------------------------- C390003_3
- 
- with Ada.Tags;
- with Report;
- package body C390003_3 is -- Special_Trucks
- 
-   function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
-   function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
- 
-   procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys ) is
-   begin
-     if Key /= Vehicle.Heavy then
-       Report.Failed("Expected Heavy Key");
-     end if;
-   end TC_Validate;
- 
-   procedure Load  ( The_Car : in     Motivators.Car;
-                     Onto    : in out Auto_Carrier) is
-   begin
-     Onto.Load_Count := Onto.Load_Count +1;
-     Onto.Payload(Onto.Load_Count) := The_Car;
-   end Load;
-   procedure Unload( The_Car :    out Motivators.Car;
-                     Off_of   : in out Auto_Carrier) is
-   begin
-     The_Car := Off_of.Payload(Off_of.Load_Count);
-     Off_of.Load_Count := Off_of.Load_Count -1;
-   end Unload;
- 
- end C390003_3;
- 
- ----------------------------------------------------------------- C390003_4
- 
- with Report, Ada.Tags;
- package body C390003_4 is -- James_Bond
- 
-   function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
-   function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
- 
-   procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys ) is
-   begin
-     if Key /= Vehicle.Q then
-       Report.Failed("Expected Q Key");
-     end if;
-   end TC_Validate;
- 
- end C390003_4;
- 
- ------------------------------------------------------------------- C390003
- 
- with Report;
- with C390003_1;
- with C390003_2;
- with C390003_3;
- with C390003_4;
- procedure C390003 is
- 
-   package Vehicle        renames C390003_1;  use Vehicle;
-   package Motivators     renames C390003_2;
-   package Special_Trucks renames C390003_3;
-   package James_Bond     renames C390003_4;
- 
-   -- The cast, in order of complexity:
- 
-   Pennys_Bike : Motivators.Bicycle;
-   Weekender   : Motivators.Tandem;
-   Qs_Moped    : Motivators.Motorcycle;
-   Ms_Limo     : Motivators.Car;
-   Yard_Van    : Motivators.Truck(8);
-   Specter_X   : Special_Trucks.Auto_Carrier;
-   Gen_II      : James_Bond.Q_Machine;
- 
- 
-   -- Check compatibility with the corresponding class wide type.
- 
-   procedure Vehicle_Shop( It  : in out Vehicle.Object'Class;
-                           Key : in     Vehicle.TC_Keys ) is
- 
-     -- Check that Subtype'Class is defined for tagged subtypes.
-     procedure Bike_Shop( Bike: in out Motivators.Bicycle'Class ) is
-     begin
-         -- Dispatch to appropriate TC_Validate
-       Vehicle.TC_Validate( Bike, Key );
-     end Bike_Shop;
- 
-   begin
-     Vehicle.TC_Validate( It, Key );
-     if Vehicle.Wheels( It ) = 2 then
-       Bike_Shop( It );  -- only call Bike_Shop when It has 2 wheels
-     end if;
-   end Vehicle_Shop;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C390003", "Check that for a subtype S of a tagged type " &
-                "T, S'Class denotes a class-wide subtype.  Check that " &
-                "T'Tag denotes the tag of the type T, and that, for a " &
-                "class-wide tagged type X, X'Tag denotes the tag of X.  " &
-                "Check that the tags of stand alone objects, record and " &
-                "array components, aggregates, and formal parameters " &
-                "identify their type. Check that the tag of a value of a " &
-                "formal parameter is that of the actual parameter, even " &
-                "if the actual is passed by a view conversion" );
- 
- --     Check that the tags of stand alone objects, record and array
- --     components, aggregates, and formal parameters identify their type.
- --     Check that the tag of a value of a formal parameter is that of the
- --     actual parameter, even if the actual is passed by a view conversion.
- 
-   Vehicle_Shop( Pennys_Bike,          Veh );
-   Vehicle_Shop( Weekender,            Tand );
-   Vehicle_Shop( Qs_Moped,             MC );
-   Vehicle_Shop( Ms_Limo,              Car );
-   Vehicle_Shop( Yard_Van,             Truk );
-   Vehicle_Shop( Specter_X,            Heavy );
-   Vehicle_Shop( Specter_X.Payload(1), Car );
-   Vehicle_Shop( Gen_II,               Q );
-   Vehicle_Shop( Gen_II.Car_Part,      Car );
-   Vehicle_Shop( Gen_II.Bike_Part,     MC );
- 
-   Vehicle.TC_Validate( Pennys_Bike, Vehicle.Object'Tag );
-   Vehicle.TC_Validate( Weekender,   Motivators.Tandem'Tag );
-   Vehicle.TC_Validate( Qs_Moped,    Motivators.Motorcycle'Tag );
-   Vehicle.TC_Validate( Ms_Limo,     Motivators.Car'Tag );
-   Vehicle.TC_Validate( Yard_Van,    Motivators.Truck'Tag );
-   Vehicle.TC_Validate( Specter_X,   Special_Trucks.Auto_Carrier'Tag );
-   Vehicle.TC_Validate( Specter_X.Payload(1), Motivators.Car'Tag );
-   Vehicle.TC_Validate( Gen_II,              James_Bond.Q_Machine'Tag );
-   Vehicle.TC_Validate( Gen_II.Car_Part,     Motivators.Car'Tag );
-   Vehicle.TC_Validate( Gen_II.Bike_Part,    Motivators.Motorcycle'Tag );
- 
- -- Check the tag generated for an aggregate.
- 
-   Rentals: declare
-     Mikes_Rental : Vehicle.Object'Class :=
-                      Vehicle.Object'( 3, (Good, Flat, Worn));
-     Diannes_Car  : Vehicle.Object'Class :=
-                       Motivators.Tandem'( Wheels      => 2, 
-                                           Wheel_State => (Good, Good) );
-     Jims_Bike    : Vehicle.Object'Class :=
-                       Motivators.Motorcycle'( Pennys_Bike
-                                               with Displacement => 350 );
-     Bills_Limo   : Vehicle.Object'Class :=
-                       Motivators.Car'( Wheels       => 4,
-                                        Wheel_State  => (others => Good),
-                                        Displacement => 282 );
-     Alans_Car    : Vehicle.Object'Class :=
-                       Motivators.Truck'( 18, (others => Worn),
-                                          Tare => 5_500 );
-     Pats_Truck   : Vehicle.Object'Class := Specter_X;
-     Keiths_Car   : Vehicle.Object'Class := Gen_II;
-     Isaacs_Bus   : Vehicle.Object'Class := Keiths_Car;
- 
-   begin
-     Vehicle.TC_Validate( Mikes_Rental, Vehicle.Object'Tag );
-     Vehicle.TC_Validate( Diannes_Car,  Motivators.Tandem'Tag );
-     Vehicle.TC_Validate( Jims_Bike,    Motivators.Motorcycle'Tag );
-     Vehicle.TC_Validate( Bills_Limo,   Motivators.Car'Tag );
-     Vehicle.TC_Validate( Alans_Car,    Motivators.Truck'Tag );
-     Vehicle.TC_Validate( Pats_Truck,   Special_Trucks.Auto_Carrier'Tag );
-     Vehicle.TC_Validate( Keiths_Car,   James_Bond.Q_Machine'Tag );
-   end Rentals;
- 
- -- Check the tag of parameters.
- -- Check that the tag is not affected by view conversion.
- 
-   Vehicle.TC_Validate( Vehicle.Object( Gen_II  ), James_Bond.Q_Machine'Tag );
-   Vehicle.TC_Validate( Vehicle.Object( Ms_Limo ), Motivators.Car'Tag );
-   Vehicle.TC_Validate( Motivators.Bicycle( Weekender ),
-                        Motivators.Tandem'Tag );
-   Vehicle.TC_Validate( Motivators.Bicycle( Gen_II.Bike_Part ),
-                        Motivators.Motorcycle'Tag );
- 
-   Report.Result;
- 
- end C390003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,404 ****
- -- C390004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that the tags of allocated objects correctly identify the
- --     type of the allocated object.  Check that the tag corresponds
- --     correctly to the value resulting from both normal and view
- --     conversion.  Check that the tags of accessed values designating
- --     aliased objects correctly identify the type of the object.  Check
- --     that the tag of a function result correctly evaluates.  Check this
- --     for class-wide functions.  The tag of a class-wide function result
- --     should be the tag appropriate to the actual value returned, not the
- --     tag of the ancestor type.
- --
- -- TEST DESCRIPTION:
- --     This test defines a class hierarchy of types, with reference
- --     semantics (an access type to the class-wide type).  Similar in
- --     structure to C392005, this test checks that dynamic allocation does
- --     not adversely impact the tagging of types.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C390004_1 is -- DMV
-   type Equipment is ( T_Veh, T_Car, T_Con, T_Jep );
- 
-   type Vehicle is tagged record
-     Wheels : Natural := 4;
-     Parked : Boolean := False;
-   end record;
- 
-   function  Wheels    ( It: Vehicle ) return Natural;
-   procedure Park      ( It: in out Vehicle );
-   procedure UnPark    ( It: in out Vehicle );
-   procedure Set_Wheels( It: in out Vehicle; To_Count: in Natural );
-   procedure TC_Check  ( It: in Vehicle; To_Equip: in Equipment );
- 
-   type Car is new Vehicle with record
-     Passengers : Natural := 0;
-   end record;
- 
-   function  Passengers     ( It: Car ) return Natural;
-   procedure Load_Passengers( It: in out Car; To_Count: in Natural );
-   procedure Park           ( It: in out Car );
-   procedure TC_Check       ( It: in Car; To_Equip: in Equipment );
- 
-   type Convertible is new Car with record
-     Top_Up : Boolean := True;
-   end record;
- 
-   function  Top_Up   ( It: Convertible ) return Boolean;
-   procedure Lower_Top( It: in out Convertible );
-   procedure Park     ( It: in out Convertible );
-   procedure Raise_Top( It: in out Convertible );
-   procedure TC_Check ( It: in Convertible; To_Equip: in Equipment );
- 
-   type Jeep is new Convertible with record
-     Windshield_Up : Boolean := True;
-   end record;
- 
-   function  Windshield_Up   ( It: Jeep ) return Boolean;
-   procedure Lower_Windshield( It: in out Jeep );
-   procedure Park            ( It: in out Jeep );
-   procedure Raise_Windshield( It: in out Jeep );
-   procedure TC_Check        ( It: in Jeep; To_Equip: in Equipment );
- 
- end C390004_1;
- 
- with Report;
- package body C390004_1 is
- 
-   procedure Set_Wheels( It: in out Vehicle; To_Count: in Natural ) is
-   begin
-     It.Wheels := To_Count;
-   end Set_Wheels;
- 
-   function  Wheels( It: Vehicle ) return Natural is
-   begin
-     return It.Wheels;
-   end Wheels;
- 
-   procedure Park      ( It: in out Vehicle ) is
-   begin
-     It.Parked := True;
-   end Park;
- 
-   procedure UnPark    ( It: in out Vehicle ) is
-   begin
-     It.Parked := False;
-   end UnPark;
- 
-   procedure TC_Check  ( It: in Vehicle; To_Equip: in Equipment ) is
-   begin
-     if To_Equip /= T_Veh then
-       Report.Failed ("Failed, called Vehicle for "
-                      & Equipment'Image(To_Equip));      
-     end if;
-   end TC_Check;
- 
-   procedure TC_Check  ( It: in Car; To_Equip: in Equipment ) is
-   begin
-     if To_Equip /= T_Car then
-       Report.Failed ("Failed, called Car for "
-                      & Equipment'Image(To_Equip));      
-     end if;
-   end TC_Check;
- 
-   procedure TC_Check  ( It: in Convertible; To_Equip: in Equipment ) is
-   begin
-     if To_Equip /= T_Con then
-       Report.Failed ("Failed, called Convertible for "
-                      & Equipment'Image(To_Equip));      
-     end if;
-   end TC_Check;
- 
-   procedure TC_Check  ( It: in Jeep; To_Equip: in Equipment ) is
-   begin
-     if To_Equip /= T_Jep then
-       Report.Failed ("Failed, called Jeep for "
-                      & Equipment'Image(To_Equip));      
-     end if;
-   end TC_Check;
- 
-   procedure Load_Passengers( It: in out Car; To_Count: in Natural ) is
-   begin
-     It.Passengers := To_Count;
-     UnPark( It );
-   end Load_Passengers;
- 
-   procedure Park( It: in out Car ) is
-   begin
-     It.Passengers := 0;
-     Park( Vehicle( It ) );
-   end Park;
- 
-   function  Passengers( It: Car ) return Natural is
-   begin
-     return It.Passengers;
-   end Passengers;
- 
-   procedure Raise_Top( It: in out Convertible ) is
-   begin
-     It.Top_Up := True;
-   end Raise_Top;
- 
-   procedure Lower_Top( It: in out Convertible ) is
-   begin
-     It.Top_Up := False;
-   end Lower_Top;
- 
-   function  Top_Up   ( It: Convertible ) return Boolean is
-   begin
-     return It.Top_Up;
-   end Top_Up;
- 
-   procedure Park     ( It: in out Convertible ) is
-   begin
-     It.Top_Up := True;
-     Park( Car( It ) );
-   end Park;
- 
-   procedure Raise_Windshield( It: in out Jeep ) is
-   begin
-     It.Windshield_Up := True;
-   end Raise_Windshield;
- 
-   procedure Lower_Windshield( It: in out Jeep ) is
-   begin
-     It.Windshield_Up := False;
-   end Lower_Windshield;
- 
-   function  Windshield_Up( It: Jeep ) return Boolean is
-   begin
-     return It.Windshield_Up;
-   end Windshield_Up;
- 
-   procedure Park( It: in out Jeep ) is
-   begin
-     It.Windshield_Up := True;
-     Park( Convertible( It ) );
-   end Park;
- end C390004_1;
- 
- with Report;
- with Ada.Tags;
- with C390004_1;
- procedure C390004 is
-   package DMV renames C390004_1;
- 
-   The_Vehicle     : aliased DMV.Vehicle;
-   The_Car         : aliased DMV.Car;
-   The_Convertible : aliased DMV.Convertible;
-   The_Jeep        : aliased DMV.Jeep;
- 
-   type C_Reference is access all DMV.Car'Class;
-   type V_Reference is access all DMV.Vehicle'Class;
- 
-   Designator : V_Reference;
-   Storage    : Natural;
- 
-   procedure Valet( It: in out DMV.Vehicle'Class ) is
-   begin
-     DMV.Park( It );
-   end Valet;
- 
-   procedure TC_Match( Object: DMV.Vehicle'Class;
-                       Taglet: Ada.Tags.Tag;
-                       Where : String ) is
-     use Ada.Tags;
-   begin
-     if Object'Tag /= Taglet then
-       Report.Failed("Tag mismatch: " & Where);
-     end if;
-   end TC_Match;
- 
-   procedure Parking_Validation( It: DMV.Vehicle; TC_Message: String ) is
-   begin
-     if DMV.Wheels( It ) /= 1  or not It.Parked then
-       Report.Failed ("Failed Vehicle " & TC_Message);
-     end if;
-   end Parking_Validation;
- 
-   procedure Parking_Validation( It: DMV.Car; TC_Message: String ) is
-   begin
-     if DMV.Wheels( It ) /= 2 or DMV.Passengers( It ) /= 0
-        or not It.Parked then
-       Report.Failed ("Failed Car " & TC_Message);
-     end if;
-   end Parking_Validation;
- 
-   procedure Parking_Validation( It: DMV.Convertible;
-                                 TC_Message: String ) is
-   begin
-     if DMV.Wheels( It ) /= 3 or DMV.Passengers( It ) /= 0
-        or not DMV.Top_Up( It ) or not It.Parked then
-       Report.Failed ("Failed Convertible " & TC_Message);
-     end if;
-   end Parking_Validation;
- 
-   procedure Parking_Validation( It: DMV.Jeep; TC_Message: String ) is
-   begin
-     if DMV.Wheels( It ) /= 4 or DMV.Passengers( It ) /= 0
-        or not DMV.Top_Up( It ) or not DMV.Windshield_Up( It )
-        or not It.Parked then
-       Report.Failed ("Failed Jeep " & TC_Message);
-     end if;
-   end Parking_Validation;
- 
-   function Wash( It: V_Reference; TC_Expect : Ada.Tags.Tag )
-                                     return DMV.Vehicle'Class is
-     This_Machine : DMV.Vehicle'Class := It.all;
-   begin
-     TC_Match( It.all, TC_Expect, "Class-wide object in Wash" );
-     Storage := DMV.Wheels( This_Machine );
-     return This_Machine;
-   end Wash;
- 
-   function Wash( It: C_Reference; TC_Expect : Ada.Tags.Tag )
-                                     return DMV.Car'Class is
-     This_Machine : DMV.Car'Class := It.all;
-   begin
-     TC_Match( It.all, TC_Expect, "Class-wide object in Wash" );
-     Storage := DMV.Wheels( This_Machine );
-     return This_Machine;
-   end Wash;
- 
- begin
- 
-   Report.Test( "C390004", "Check that the tags of allocated objects "
-                         & "correctly identify the type of the allocated "
-                         & "object.  Check that tags resulting from "
-                         & "normal and view conversions.  Check tags of "
-                         & "accessed values designating aliased objects. "
-                         & "Check function result tags" );
- 
-   DMV.Set_Wheels( The_Vehicle, 1 );
-   DMV.Set_Wheels( The_Car, 2 );
-   DMV.Set_Wheels( The_Convertible, 3 );
-   DMV.Set_Wheels( The_Jeep, 4 );
- 
-   Valet( The_Vehicle );
-   Valet( The_Car );
-   Valet( The_Convertible );
-   Valet( The_Jeep );
- 
-   Parking_Validation( The_Vehicle,     "setup" );
-   Parking_Validation( The_Car,         "setup" );
-   Parking_Validation( The_Convertible, "setup" );
-   Parking_Validation( The_Jeep,        "setup" );
- 
- -- Check that the tags of allocated objects correctly identify the type
- -- of the allocated object.
- 
-   Designator := new DMV.Vehicle;
-   DMV.TC_Check( Designator.all, DMV.T_Veh );
-   TC_Match( Designator.all, DMV.Vehicle'Tag, "allocated Vehicle" );
- 
-   Designator := new DMV.Car;
-   DMV.TC_Check( Designator.all, DMV.T_Car );
-   TC_Match( Designator.all, DMV.Car'Tag, "allocated Car");
- 
-   Designator := new DMV.Convertible;
-   DMV.TC_Check( Designator.all, DMV.T_Con );
-   TC_Match( Designator.all, DMV.Convertible'Tag, "allocated Convertible" );
- 
-   Designator := new DMV.Jeep;
-   DMV.TC_Check( Designator.all, DMV.T_Jep );
-   TC_Match( Designator.all, DMV.Jeep'Tag, "allocated Jeep" );
- 
- -- Check that view conversion causes the correct dispatch
-   DMV.TC_Check( DMV.Vehicle( The_Jeep ),     DMV.T_Veh );
-   DMV.TC_Check( DMV.Car( The_Jeep ),         DMV.T_Car );
-   DMV.TC_Check( DMV.Convertible( The_Jeep ), DMV.T_Con );
- 
- -- And that view conversion does not change the tag
-   TC_Match( DMV.Vehicle( The_Jeep ),     DMV.Jeep'Tag, "View Conv Veh" );
-   TC_Match( DMV.Car( The_Jeep ),         DMV.Jeep'Tag, "View Conv Car" );
-   TC_Match( DMV.Convertible( The_Jeep ), DMV.Jeep'Tag, "View Conv Jep" );
- 
- -- Check that the tags of accessed values designating aliased objects
- -- correctly identify the type of the object.
-   Designator := The_Vehicle'Access;
-   DMV.TC_Check( Designator.all, DMV.T_Veh );
-   TC_Match( Designator.all, DMV.Vehicle'Tag, "aliased Vehicle" );
- 
-   Designator := The_Car'Access;
-   DMV.TC_Check( Designator.all, DMV.T_Car );
-   TC_Match( Designator.all, DMV.Car'Tag, "aliased Car" );
- 
-   Designator := The_Convertible'Access;
-   DMV.TC_Check( Designator.all, DMV.T_Con );
-   TC_Match( Designator.all, DMV.Convertible'Tag, "aliased Convertible" );
- 
-   Designator := The_Jeep'Access;
-   DMV.TC_Check( Designator.all, DMV.T_Jep );
-   TC_Match( Designator.all, DMV.Jeep'Tag, "aliased Jeep" );
- 
- -- Check that the tag of a function result correctly evaluates.
- -- Check this for class-wide functions.  The tag of a class-wide
- -- function result should be the tag appropriate to the actual value
- -- returned, not the tag of the ancestor type.
-   Function_Check: declare
-     A_Vehicle     : V_Reference := new DMV.Vehicle'( The_Vehicle );
-     A_Car         : C_Reference := new DMV.Car'( The_Car );
-     A_Convertible : C_Reference := new DMV.Convertible'( The_Convertible );
-     A_Jeep        : C_Reference := new DMV.Jeep'( The_Jeep );
-   begin
-     DMV.Unpark( A_Vehicle.all );
-     DMV.Load_Passengers( A_Car.all, 5 );
-     DMV.Load_Passengers( A_Convertible.all, 6 );
-     DMV.Load_Passengers( A_Jeep.all, 7 );
-     DMV.Lower_Top( DMV.Convertible(A_Convertible.all) );
-     DMV.Lower_Top( DMV.Jeep(A_Jeep.all) );
-     DMV.Lower_Windshield( DMV.Jeep(A_Jeep.all) );
- 
-     if DMV.Wheels( Wash( A_Jeep, DMV.Jeep'Tag ) ) /= 4
-        or Storage /= 4 then
-       Report.Failed("Did not correctly wash Jeep");
-     end if;
- 
-     if DMV.Wheels( Wash( A_Convertible, DMV.Convertible'Tag ) ) /= 3
-        or Storage /= 3 then
-       Report.Failed("Did not correctly wash Convertible");
-     end if;
- 
-     if DMV.Wheels( Wash( A_Car, DMV.Car'Tag ) ) /= 2
-        or Storage /= 2 then
-       Report.Failed("Did not correctly wash Car");
-     end if;
- 
-     if DMV.Wheels( Wash( A_Vehicle, DMV.Vehicle'Tag ) ) /= 1
-        or Storage /= 1 then
-       Report.Failed("Did not correctly wash Vehicle");
-     end if; 
- 
-   end Function_Check;
- 
-   Report.Result;
- end C390004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900050.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900050.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900050.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900050.a	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- C3900050.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C3900053.AM.
- --
- -- TEST DESCRIPTION:
- --      See C3900053.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --      => C3900050.A
- --         C3900051.A
- --         C3900052.A
- --         C3900053.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
- --                          for Ada.Calendar.
- --
- --!
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package C3900050 is  -- Alert system abstraction.
- 
-    -- Declarations used by component Arrival_Time.
- 
-    Default_Time : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1901, 1, 1);
-    Alert_Time   : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1991, 6, 15);
- 
- 
-    -- Declarations used by component Display_On and procedure Display.
- 
-    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
-    type Display_Counters is array (Device_Enum) of Natural;
- 
-    Display_Count_For : Display_Counters := (others => 0);
- 
- 
- 
-    type Alert_Type is tagged private;                 -- Root tagged type.
- 
-    procedure Set_Display (A : in out Alert_Type;      -- To be inherited by
-                           D : in     Device_Enum);    -- all derivatives.
- 
-    procedure Display (A : in Alert_Type);             -- To be inherited by
-                                                       -- all derivatives.
- 
-    procedure Handle (A : in out Alert_Type);          -- To be overridden by
-                                                       -- all derivatives.
- 
- 
-    -- The following functions are needed to verify the values of the
-    -- root tagged type's private components.
- 
-    function Get_Time (A: Alert_Type) return Ada.Calendar.Time;
- 
-    function Get_Display (A: Alert_Type) return Device_Enum;
- 
-    function Initial_Values_Okay (A : in Alert_Type)
-      return Boolean;
- 
-    function Bad_Final_Values (A : in Alert_Type)
-      return Boolean;
- 
- private
- 
-    type Alert_Type is tagged record                    -- Root tagged type.
-       Arrival_Time : Ada.Calendar.Time := Default_Time;
-       Display_On   : Device_Enum   := Null_Device;
-    end record;
- 
- 
- end C3900050;
- 
- 
-      --==================================================================--
- 
- 
- package body C3900050 is  -- Alert system abstraction.
- 
- 
-    procedure Set_Display (A : in out Alert_Type;
-                           D : in     Device_Enum) is
-    begin
-       A.Display_On := D;
-    end Set_Display;
- 
- 
-    procedure Display (A : in Alert_Type) is
-    begin
-       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
-    end Display;
- 
- 
-    procedure Handle (A : in out Alert_Type) is
-    begin
-       A.Arrival_Time := Alert_Time;
-       Display (A);
-    end Handle;
- 
- 
-    function Get_Time (A: Alert_Type) return Ada.Calendar.Time is
-    begin
-       return A.Arrival_Time;
-    end Get_Time;
- 
- 
-    function Get_Display (A: Alert_Type) return Device_Enum is
-    begin
-       return A.Display_On;
-    end Get_Display;
- 
- 
-    function Initial_Values_Okay (A : in Alert_Type) return Boolean is
-    begin
-       return (A = (Arrival_Time => Default_Time,         -- Check "=" operator
-                    Display_On   => Null_Device));        -- availability.
-    end Initial_Values_Okay;                              -- Aggregate with
-                                                          -- named associations.
- 
-    function Bad_Final_Values (A : in Alert_Type) return Boolean is
-    begin
-       return (A /= (Alert_Time, Null_Device));           -- Check "/=" operator
-                                                          -- availability.
-    end Bad_Final_Values;                                 -- Aggregate with
-                                                          -- positional assoc.
- 
- end C3900050;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900051.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900051.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900051.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900051.a	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- C3900051.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C3900053.AM.
- --
- -- TEST DESCRIPTION:
- --      See C3900053.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         C3900050.A
- --      => C3900051.A
- --         C3900052.A
- --         C3900053.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
- --                          for Ada.Calendar.
- --
- --!
- 
- with C3900050;       -- Alert system abstraction.
- package C3900051 is  -- Extended alert system abstraction.
- 
- 
-    type Low_Alert_Type is new C3900050.Alert_Type
-      with private;                                      -- Private extension of
-                                                         -- root tagged type.
- 
-    -- Inherits procedure Display from Alert_Type.
- 
-    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
-                                                         -- primitive subprog.
- 
-    procedure Set_Level (LA : in out Low_Alert_Type;     -- To be inherited by
-                         L  : in     Integer);           -- all derivatives.
- 
- 
-    -- The following functions are needed to verify the values of the
-    -- extension's private components.
- 
-    function Get_Level (LA: Low_Alert_Type) return Integer;
- 
-    function Initial_Values_Okay (LA : in Low_Alert_Type)
-      return Boolean;                                    -- Override parent's
-                                                         -- primitive subprog.
- 
-    function Bad_Final_Values (LA : in Low_Alert_Type)   -- Override parent's
-      return Boolean;                                    -- primitive subprog.
- 
- 
- private
- 
-    type Low_Alert_Type is new C3900050.Alert_Type with record
-       Level : Integer := 0;
-    end record;
- 
- end C3900051;
- 
- 
-      --==================================================================--
- 
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package body C3900051 is  -- Extended alert system abstraction.
- 
-    use C3900050;  -- Alert system abstraction.
- 
- 
-    procedure Set_Level (LA : in out Low_Alert_Type;
-                         L  : in     Integer) is
-    begin
-       LA.Level := L;
-    end Set_Level;
- 
- 
-    procedure Handle (LA : in out Low_Alert_Type) is
-    begin
-       Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
-       Set_Level (LA, 1);          -- Call newly declared operation.
-       Set_Display (Alert_Type(LA),
-                    Teletype);     -- Call parent's operation (type conversion).
-       Display (LA);              
-    end Handle;
- 
- 
-    function Get_Level (LA: Low_Alert_Type) return Integer is
-    begin
-       return LA.Level;
-    end Get_Level;
- 
- 
-    function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
-    begin
-       -- Call parent's operation (type conversion).
-       return (Initial_Values_Okay (Alert_Type (LA)) and
-               LA.Level = 0);
-    end Initial_Values_Okay;
- 
- 
-    function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
-       use type Ada.Calendar.Time;
-    begin
-       return (Get_Time(LA)    /= Alert_Time or
-               Get_Display(LA) /= Teletype or
-               LA.Level        /= 1);
-    end Bad_Final_Values;
- 
- 
- end C3900051;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900052.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900052.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900052.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900052.a	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- C3900052.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C3900053.AM.
- --
- -- TEST DESCRIPTION:
- --      See C3900053.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         C3900050.A
- --         C3900051.A
- --      => C3900052.A
- --         C3900053.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
- --                          for Ada.Calendar.
- --
- --!
- 
- with C3900051;       -- Extended alert system abstraction.
- package C3900052 is  -- Further extended alert system abstraction.
- 
- 
-    -- Declarations used by component Action_Officer;
- 
-    type Person_Enum is (Nobody,          Duty_Officer,
-                         Watch_Commander, Commanding_Officer);
- 
- 
-    type Medium_Alert_Type is new C3900051.Low_Alert_Type
-      with private;                                      -- Private extension of
-                                                         -- private extension.
- 
-    -- Inherits (inherited) procedure Display from Low_Alert_Type.
-    -- Inherits function Level_Of from Low_Alert_Type.
- 
-    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
-                                                         -- primitive subprog.
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum);
- 
- 
-    -- The following functions are needed to verify the values of the
-    -- extension's private components.
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type)
-      return Boolean;                                    -- Override parent's
-                                                         -- primitive subprog.
- 
-    function Bad_Final_Values (MA: in Medium_Alert_Type) -- Override parent's
-      return Boolean;                                    -- primitive subprog.
- 
- private
- 
-    type Medium_Alert_Type is new C3900051.Low_Alert_Type with record
-       Action_Officer : Person_Enum := Nobody;
-    end record;
- 
- end C3900052;
- 
- 
-      --==================================================================--
- 
- 
- with C3900050;            -- Basic alert abstraction.
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package body C3900052 is  -- Further extended alert system abstraction.
- 
-    use C3900050;  -- Enumeration values directly visible.
-    use C3900051;  -- Extended alert system abstraction.
- 
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum) is
-    begin
-       MA.Action_Officer := To;
-    end Assign_Officer;
- 
- 
-    procedure Handle (MA : in out Medium_Alert_Type) is
-    begin
-       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
-       Set_Level (MA, 2);                 -- Call inherited operation.
-       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
-       Set_Display (MA, Console);         -- Call inherited operation.
-       Display (MA);                      -- Call doubly inherited operation.
-    end Handle;
- 
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
-    begin
-       -- Call parent's operation (type conversion).
-       return (Initial_Values_Okay (Low_Alert_Type (MA)) and
-               MA.Action_Officer = Nobody);
-    end Initial_Values_Okay;
- 
- 
-    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
-       use type Ada.Calendar.Time;
-    begin
-       return (Get_Time(MA)      /= Alert_Time or
-               Get_Display(MA)   /= Console    or
-               Get_Level(MA)     /= 2          or
-               MA.Action_Officer /= Duty_Officer);
-    end Bad_Final_Values;
- 
- 
- end C3900052;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900053.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900053.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900053.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900053.am	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C3900053.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a private tagged type declared in a package specification
- --      may be extended with a private extension in a different package
- --      specification, and that this private extension may in turn be extended
- --      by a private extension in a third package.
- --
- --      Check that each derivative inherits the user-defined primitive
- --      subprograms of its parent (including those that its parent inherited),
- --      that it may override these inherited primitive subprograms, and that it
- --      may also declare its own primitive subprograms.
- --
- --      Check that type conversion is defined from a type extension to its
- --      parent, and that this parent itself may be a type extension.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged private type and two associated primitive
- --      subprograms in a package specification. Declare operations to verify
- --      the correctness of the components. Declare operations which return
- --      values of the type's private components, and which will be
- --      inherited by later derivatives.
- -- 
- --      Extend the root type with a private extension in a second package
- --      specification. Declare a new primitive subprogram for the extension,
- --      and override one of the two inherited subprograms. Within the
- --      overriding subprogram, utilize type conversion to call the parent's
- --      implementation of the same subprogram. Also within the overriding
- --      subprogram, call the new primitive subprogram and each inherited
- --      subprogram. Declare operations of the private extension which
- --      override the verification operations of its parent. Declare operations
- --      of the private extension which return values of the extension's
- --      private components, and which will be inherited by later derivatives.
- --      
- --      Extend the extension with a private extension in a third package
- --      specification. Declare a new primitive subprogram for this private
- --      extension, and override one of the three inherited subprograms.
- --      Within the overriding subprogram, utilize type conversion to call the
- --      parent's implementation of the same subprogram. Also within the
- --      overriding subprogram, call the new primitive subprogram and each
- --      inherited subprogram. Declare operations of the private extension
- --      which override the verification operations of its parent.
- -- 
- --      In the main program, declare objects of the root tagged type and
- --      the two type extensions. For each object, call the overriding
- --      subprogram, and verify the correctness of the components by calling
- --      the verification operations.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         C3900050.A
- --         C3900051.A
- --         C3900052.A
- --      => C3900053.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 May 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- 
- with C3900050; -- Basic alert abstraction.
- with C3900051; -- Extended alert abstraction.
- with C3900052; -- Further extended alert abstraction.
- 
- use  C3900050; -- Primitive operations of Alert_Type directly visible.
- 
- procedure C3900053 is
- begin
- 
-    Report.Test ("C390005", "Primitive operation inheritance by type " &
-                 "extensions: root type is private; all extensions are " &
-                 "private and declared in different packages");
- 
- 
-    ALERT_SUBTEST: -------------------------------------------------------------
- 
-       declare
-          Alarm : C3900050.Alert_Type;     -- Root tagged private type.
-       begin
-          if not Initial_Values_Okay (Alarm) then
-             Report.Failed ("Wrong initial values for Alert_Type");
-          end if;
- 
-          Handle (Alarm);
- 
-          if Bad_Final_Values (Alarm) then
-             Report.Failed ("Wrong values for Alert_Type after Handle");
-          end if;
-       end Alert_Subtest;
- 
- 
-    -- Check intermediate display counts:
- 
-    if C3900050.Display_Count_For (Null_Device) /= 1 or
-       C3900050.Display_Count_For (Teletype)    /= 0 or
-       C3900050.Display_Count_For (Console)     /= 0 or
-       C3900050.Display_Count_For (Big_Screen)  /= 0
-    then
-       Report.Failed ("Wrong display counts after Alert_Type");
-    end if;
- 
- 
-    LOW_ALERT_SUBTEST: ---------------------------------------------------------
- 
-       declare
-          Low_Alarm : C3900051.Low_Alert_Type; -- Priv. ext. of tagged type.
-          use C3900051; -- Primitive operations of extension directly visible.
-       begin
-          if not Initial_Values_Okay (Low_Alarm) then
-             Report.Failed ("Wrong initial values for Low_Alert_Type");
-          end if;
- 
-          Handle (Low_Alarm);
- 
-          if Bad_Final_Values (Low_Alarm) then
-             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
-          end if;
-       end Low_Alert_Subtest;
- 
- 
-    -- Check intermediate display counts:
- 
-    if C3900050.Display_Count_For /= (Null_Device => 2,
-                                      Teletype    => 1,
-                                      Console     => 0,
-                                      Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Low_Alert_Type");
-    end if;
- 
- 
-    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
- 
-       declare
-          Medium_Alarm : C3900052.Medium_Alert_Type; -- Priv. ext. of extension.
-          use C3900052; -- Primitive operations of extension directly visible.
-       begin
-          if not Initial_Values_Okay (Medium_Alarm) then
-             Report.Failed ("Wrong initial values for Medium_Alert_Type");
-          end if;
- 
-          Handle (Medium_Alarm);
- 
-          if Bad_Final_Values (Medium_Alarm) then
-             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
-          end if;
-       end Medium_Alert_Subtest;
- 
- 
-    -- Check final display counts:
- 
-    if C3900050.Display_Count_For /= (Null_Device => 3,
-                                      Teletype    => 2,
-                                      Console     => 1,
-                                      Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Medium_Alert_Type");
-    end if;
- 
- 
-    Report.Result;
- 
- end C3900053;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900060.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900060.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900060.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900060.a	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- C3900060.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C3900063.AM.
- --
- -- TEST DESCRIPTION:
- --      See C3900063.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --      => C3900060.A
- --         C3900061.A
- --         C3900062.A
- --         C3900063.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
- --                          for Ada.Calendar.
- --
- --!
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package C3900060 is  -- Alert system abstraction.
- 
- 
-    -- Declarations used by component Arrival_Time.
- 
-    Default_Time : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1901, 1, 1);
-    Alert_Time   : constant Ada.Calendar.Time :=
-                     Ada.Calendar.Time_Of (1991, 6, 15);
- 
- 
-    -- Declarations used by component Display_On and procedure Display.
- 
-    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
-    type Display_Counters is array (Device_Enum) of Natural;
- 
-    Display_Count_For : Display_Counters := (others => 0);
- 
- 
- 
-    type Alert_Type is tagged private;                 -- Root tagged type.
- 
-    procedure Set_Display (A : in out Alert_Type;      -- To be inherited by
-                           D : in     Device_Enum);    -- all derivatives.
- 
-    procedure Display (A : in Alert_Type);             -- To be inherited by
-                                                       -- all derivatives.
- 
-    procedure Handle (A : in out Alert_Type);          -- To be overridden by
-                                                       -- all derivatives.
- 
- 
-    -- The following functions are needed to verify the values of the
-    -- root tagged type's private components.
- 
-    function Get_Time (A: Alert_Type) return Ada.Calendar.Time;
- 
-    function Get_Display (A: Alert_Type) return Device_Enum;
- 
-    function Initial_Values_Okay (A : in Alert_Type)
-      return Boolean;
- 
-    function Bad_Final_Values (A : in Alert_Type)
-      return Boolean;
- 
- private
- 
-    type Alert_Type is tagged record                    -- Root tagged type.
-       Arrival_Time : Ada.Calendar.Time := Default_Time;
-       Display_On   : Device_Enum   := Null_Device;
-    end record;
- 
- 
- end C3900060;
- 
- 
-      --==================================================================--
- 
- 
- package body C3900060 is
- 
- 
-    procedure Set_Display (A : in out Alert_Type;
-                           D : in     Device_Enum) is
-    begin
-       A.Display_On := D;
-    end Set_Display;
- 
- 
-    procedure Display (A : in Alert_Type) is
-    begin
-       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
-    end Display;
- 
- 
-    procedure Handle (A : in out Alert_Type) is
-    begin
-       A.Arrival_Time := Alert_Time;
-       Display (A);
-    end Handle;
- 
- 
-    function Get_Time (A: Alert_Type) return Ada.Calendar.Time is
-    begin
-       return A.Arrival_Time;
-    end Get_Time;
- 
- 
-    function Get_Display (A: Alert_Type) return Device_Enum is
-    begin
-       return A.Display_On;
-    end Get_Display;
- 
- 
-    function Initial_Values_Okay (A : in Alert_Type) return Boolean is
-    begin
-       return (A = (Arrival_Time => Default_Time,         -- Check "=" operator
-                    Display_On   => Null_Device));        -- availability.
-    end Initial_Values_Okay;                              -- Aggregate with
-                                                          -- named associations.
- 
-    function Bad_Final_Values (A : in Alert_Type) return Boolean is
-    begin
-       return (A /= (Alert_Time, Null_Device));           -- Check "/=" operator
-                                                          -- availability.
-    end Bad_Final_Values;                                 -- Aggregate with
-                                                          -- positional assoc.
- 
- end C3900060;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900061.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900061.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900061.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900061.a	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- C3900061.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C3900063.AM.
- --
- -- TEST DESCRIPTION:
- --      See C3900063.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         C3900060.A
- --      => C3900061.A
- --         C3900062.A
- --         C3900063.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
- --                          for Ada.Calendar.
- --
- --!
- 
- with C3900060;       -- Alert system abstraction.
- package C3900061 is  -- Extended alert abstraction.
- 
- 
-    type Low_Alert_Type is new C3900060.Alert_Type
-      with private;                                      -- Private extension of
-                                                         -- root tagged type.
- 
-    -- Inherits procedure Display from Alert_Type.
- 
-    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
-                                                         -- primitive subprog.
- 
-    procedure Set_Level (LA : in out Low_Alert_Type;     -- To be inherited by
-                         L  : in     Integer);           -- all derivatives.
- 
- 
-    -- The following functions are needed to verify the values of the
-    -- extension's private components.
- 
-    function Get_Level (LA: Low_Alert_Type) return Integer;
- 
-    function Initial_Values_Okay (LA : in Low_Alert_Type)
-      return Boolean;                                    -- Override parent's
-                                                         -- primitive subprog.
- 
-    function Bad_Final_Values (LA : in Low_Alert_Type)   -- Override parent's
-      return Boolean;                                    -- primitive subprog.
- 
- 
- private
- 
-    type Low_Alert_Type is new C3900060.Alert_Type with record
-       Level : Integer := 0;
-    end record;
- 
- end C3900061;
- 
- 
-      --==================================================================--
- 
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package body C3900061 is
- 
-    use C3900060;  -- Alert system abstraction.
- 
- 
-    procedure Set_Level (LA : in out Low_Alert_Type;
-                         L  : in     Integer) is
-    begin
-       LA.Level := L;
-    end Set_Level;
- 
- 
-    procedure Handle (LA : in out Low_Alert_Type) is
-    begin
-       Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
-       Set_Level (LA, 1);          -- Call newly declared operation.
-       Set_Display (Alert_Type(LA),
-                    Teletype);     -- Call parent's operation (type conversion).
-       Display (LA);               -- Call inherited operation.
-    end Handle;
- 
- 
-    function Get_Level (LA: Low_Alert_Type) return Integer is
-    begin
-       return LA.Level;
-    end Get_Level;
- 
- 
-    function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
-    begin
-       -- Call parent's operation (type conversion).
-       return (Initial_Values_Okay (Alert_Type (LA)) and
-               LA.Level = 0);
-    end Initial_Values_Okay;
- 
- 
-    function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
-       use type Ada.Calendar.Time;
-    begin
-       return (Get_Time(LA)    /= Alert_Time or
-               Get_Display(LA) /= Teletype or
-               LA.Level        /= 1);
-    end Bad_Final_Values;
- 
- 
- end C3900061;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900062.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900062.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900062.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900062.a	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- C3900062.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C3900063.AM.
- --
- -- TEST DESCRIPTION:
- --      See C3900063.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         C3900060.A
- --         C3900061.A
- --      => C3900062.A
- --         C3900063.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
- --                          for Ada.Calendar.
- --
- --!
- 
- with C3900061;       -- Extended alert system abstraction.
- package C3900062 is  -- Further extended alert system abstraction.
- 
- 
-    -- Declarations used by component Action_Officer;
- 
-    type Person_Enum is (Nobody,          Duty_Officer,
-                         Watch_Commander, Commanding_Officer);
- 
- 
-    type Medium_Alert_Type is new C3900061.Low_Alert_Type
-      with record                                        -- Record extension of
-       Action_Officer : Person_Enum := Nobody;           -- private extension.
-    end record;
- 
- 
-    -- Inherits (inherited) procedure Display from Low_Alert_Type.
-    -- Inherits function Level_Of from Low_Alert_Type.
- 
-    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
-                                                         -- primitive subprog.
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum);
- 
- 
-    -- The following functions are needed to verify the values of the
-    -- extension's private components.
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type)
-      return Boolean;                                    -- Override parent's
-                                                         -- primitive subprog.
- 
-    function Bad_Final_Values (MA: in Medium_Alert_Type) -- Override parent's
-      return Boolean;                                    -- primitive subprog.
- 
- 
- end C3900062;
- 
- 
-      --==================================================================--
- 
- 
- with C3900060;            -- Basic alert abstraction.
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package body C3900062 is
- 
-    use C3900060;  -- Enumeration values directly visible.
-    use C3900061;  -- Extended alert system abstraction.
- 
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum) is
-    begin
-       MA.Action_Officer := To;
-    end Assign_Officer;
- 
- 
-    procedure Handle (MA : in out Medium_Alert_Type) is
-    begin
-       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
-       Set_Level (MA, 2);                 -- Call inherited operation.
-       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
-       Set_Display (MA, Console);         -- Call inherited operation.
-       Display (MA);                      -- Call doubly inherited operation.
-    end Handle;
- 
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
-    begin
-       -- Call parent's operation (type conversion).
-       return (Initial_Values_Okay (Low_Alert_Type (MA)) and
-               MA.Action_Officer = Nobody);
-    end Initial_Values_Okay;
- 
- 
-    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
-       use type Ada.Calendar.Time;
-    begin
-       return (Get_Time(MA)      /= Alert_Time or
-               Get_Display(MA)   /= Console    or
-               Get_Level(MA)     /= 2          or
-               MA.Action_Officer /= Duty_Officer);
-    end Bad_Final_Values;
- 
- 
- end C3900062;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900063.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900063.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3900063.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3900063.am	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- C3900063.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a private tagged type declared in a package specification
- --      may be extended with a private extension in a different package
- --      specification, and that this private extension may in turn be extended
- --      by a record extension in a third package.
- --
- --      Check that each derivative inherits the user-defined primitive
- --      subprograms of its parent (including those that its parent inherited),
- --      that it may override these inherited primitive subprograms, and that it
- --      may also declare its own primitive subprograms.
- --
- --      Check that type conversion is defined from a type extension to its
- --      parent, and that this parent itself may be a type extension.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged private type and two associated primitive
- --      subprograms in a package specification. Declare operations to verify
- --      the correctness of the components. Declare operations which return
- --      values of the type's private components, and which will be inherited
- --      by later derivatives.
- -- 
- --      Extend the root type with a private extension in a second package
- --      specification. Declare a new primitive subprogram for the extension,
- --      and override one of the two inherited subprograms. Within the
- --      overriding subprogram, utilize type conversion to call the parent's
- --      implementation of the same subprogram. Also within the overriding
- --      subprogram, call the new primitive subprogram and each inherited
- --      subprogram. Declare operations of the private extension which
- --      override the verification operations of its parent. Declare
- --      operations which return values of the extension's private components,
- --      and which will be inherited by later derivatives.
- --      
- --      Extend the extension with a record extension in a third package
- --      specification. Declare a new primitive subprogram for this record
- --      extension, and override one of the three inherited subprograms.
- --      Within the overriding subprogram, utilize type conversion to call the
- --      parent's implementation of the same subprogram. Also within the
- --      overriding subprogram, call the new primitive subprogram and each
- --      inherited subprogram. Declare operations of the record extension
- --      which override the verification operations of its parent.
- -- 
- --      In the main program, declare objects of the root tagged type and
- --      the two type extensions. For each object, call the overriding
- --      subprogram, and verify the correctness of the components by calling
- --      the verification operations.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         C3900060.A
- --         C3900061.A
- --         C3900062.A
- --      => C3900063.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- 
- with C3900060; -- Basic alert abstraction.
- with C3900062; -- Further extended alert abstraction.
- 
- use  C3900060; -- Primitive operations of Alert_Type directly visible.
- 
- procedure C3900063 is
- begin
- 
-    Report.Test ("C390006", "Primitive operation inheritance by type " &
-                 "extensions: all extensions declared in different " &
-                 "packages; root type and 1st extension are private, " &
-                 "2nd extension is record extension");
- 
- 
-    -- The cases for type C3900060.Alert_Type and C3900061.Low_Alert_Type
-    -- are tested in C390005. Those subtests are not repeated here.
- 
- 
-    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
- 
-       declare
-          Medium_Alarm : C3900062.Medium_Alert_Type; -- Rec. ext. of extension.
-          use C3900062; -- Primitive operations of extension directly visible.
-       begin
-          if not Initial_Values_Okay (Medium_Alarm) then
-             Report.Failed ("Wrong initial values for Medium_Alert_Type");
-          end if;
- 
-          Handle (Medium_Alarm);
- 
-          if Bad_Final_Values (Medium_Alarm) then
-             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
-          end if;
-       end Medium_Alert_Subtest;
- 
- 
-    -- Check final display counts:
- 
-    if C3900060.Display_Count_For /= (Null_Device => 1,
-                                      Teletype    => 1,
-                                      Console     => 1,
-                                      Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Medium_Alert_Type");
-    end if;
- 
- 
-    Report.Result;
- 
- end C3900063;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,374 ****
- -- C390007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the tag of an object of a tagged type is preserved by
- --      type conversion and parameter passing.
- --
- -- TEST DESCRIPTION:
- --      The fact that the tag of an object is not changed is verified by
- --      making dispatching calls to primitive operations, and confirming that
- --      the proper body is executed. Objects of both specific and class-wide
- --      types are checked. 
- --
- --      The dispatching calls are made in two contexts. The first is a
- --      straightforward dispatching call made from within a class-wide
- --      operation. The second is a redispatch from within a primitive
- --      operation.
- --
- --      For the parameter passing case, the initial class-wide and specific
- --      objects are passed directly in calls to the class-wide and primitive
- --      operations. The redispatch is accomplished by initializing a local
- --      class-wide object in the primitive operation to the value of the
- --      formal parameter, and using the local object as the actual in the
- --      (re)dispatching call.
- --
- --      For the type conversion case, the initial class-wide object is assigned
- --      a view conversion of an object of a specific type:
- --
- --         type T is tagged ...
- --         type DT is new T with ...
- --
- --         A : DT;
- --         B : T'Class := T(A); -- Despite conversion, tag of B is that of DT.
- --
- --      The class-wide object is then passed directly in calls to the
- --      class-wide and primitive operations. For the initial object of a
- --      specific type, however, a view conversion of the object is passed,
- --      forcing a non-dispatching call in the primitive operation case. Within
- --      the primitive operation, a view conversion of the formal parameter to
- --      a class-wide type is then used to force a (re)dispatching call.
- --
- --      For the type conversion and parameter passing case, a combining of
- --      view conversion and parameter passing of initial specific objects are 
- --      called directly to the class-wide and primitive operations. 
- --
- --
- -- CHANGE HISTORY:
- --      28 Jun 95   SAIC    Initial prerelease version.
- --      23 Apr 96   SAIC    Added use C390007_0 in the main.
- --
- --!
- 
- package C390007_0 is
- 
-    type Call_ID_Kind is (None, Parent_Outer,  Parent_Inner,
-                                Derived_Outer, Derived_Inner);
- 
-    type Root_Type is abstract tagged null record;
- 
-    procedure Outer_Proc (X : in out Root_Type) is abstract;
-    procedure Inner_Proc (X : in out Root_Type) is abstract;
- 
-    procedure ClassWide_Proc (X : in out Root_Type'Class);
- 
- end C390007_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C390007_0 is
- 
-    procedure ClassWide_Proc (X : in out Root_Type'Class) is
-    begin
-       Inner_Proc (X);
-    end ClassWide_Proc;
- 
- end C390007_0;
- 
- 
-      --==================================================================--
- 
- 
- package C390007_0.C390007_1 is
- 
-    type Param_Parent_Type is new Root_Type with record
-       Last_Call : Call_ID_Kind := None;
-    end record;
- 
-    procedure Outer_Proc (X : in out Param_Parent_Type);
-    procedure Inner_Proc (X : in out Param_Parent_Type);
- 
- end C390007_0.C390007_1;
- 
- 
-      --==================================================================--
- 
- 
- package body C390007_0.C390007_1 is
- 
-    procedure Outer_Proc (X : in out Param_Parent_Type) is
-    begin
-       X.Last_Call := Parent_Outer;
-    end Outer_Proc;
- 
-    procedure Inner_Proc (X : in out Param_Parent_Type) is
-    begin
-       X.Last_Call := Parent_Inner;
-    end Inner_Proc;
- 
- end C390007_0.C390007_1;
- 
- 
-      --==================================================================--
- 
- 
- package C390007_0.C390007_1.C390007_2 is
- 
-    type Param_Derived_Type is new Param_Parent_Type with null record;
- 
-    procedure Outer_Proc (X : in out Param_Derived_Type);
-    procedure Inner_Proc (X : in out Param_Derived_Type);
- 
- end C390007_0.C390007_1.C390007_2;
- 
- 
-      --==================================================================--
- 
- 
- package body C390007_0.C390007_1.C390007_2 is
- 
-    procedure Outer_Proc (X : in out Param_Derived_Type) is
-       Y : Root_Type'Class := X;
-    begin
-       Inner_Proc (Y);  -- Redispatch.
-       Root_Type'Class (X) := Y;
-    end Outer_Proc;
- 
-    procedure Inner_Proc (X : in out Param_Derived_Type) is
-    begin
-       X.Last_Call := Derived_Inner;
-    end Inner_Proc;
- 
- end C390007_0.C390007_1.C390007_2;
- 
- 
-      --==================================================================--
- 
- 
- package C390007_0.C390007_3 is
- 
-    type Convert_Parent_Type is new Root_Type with record
-       First_Call  : Call_ID_Kind := None;
-       Second_Call : Call_ID_Kind := None;
-    end record;
- 
-    procedure Outer_Proc (X : in out Convert_Parent_Type);
-    procedure Inner_Proc (X : in out Convert_Parent_Type);
- 
- end C390007_0.C390007_3;
- 
- 
-      --==================================================================--
- 
- 
- package body C390007_0.C390007_3 is
- 
-    procedure Outer_Proc (X : in out Convert_Parent_Type) is
-    begin
-       X.First_Call := Parent_Outer;
-       Inner_Proc (Root_Type'Class(X));  -- Redispatch.
-    end Outer_Proc;
- 
-    procedure Inner_Proc (X : in out Convert_Parent_Type) is
-    begin
-       X.Second_Call := Parent_Inner;
-    end Inner_Proc;
- 
- end C390007_0.C390007_3;
- 
- 
-      --==================================================================--
- 
- 
- package C390007_0.C390007_3.C390007_4 is
- 
-    type Convert_Derived_Type is new Convert_Parent_Type with null record;
- 
-    procedure Outer_Proc (X : in out Convert_Derived_Type);
-    procedure Inner_Proc (X : in out Convert_Derived_Type);
- 
- end C390007_0.C390007_3.C390007_4;
- 
- 
-      --==================================================================--
- 
- 
- package body C390007_0.C390007_3.C390007_4 is
- 
-    procedure Outer_Proc (X : in out Convert_Derived_Type) is
-    begin
-       X.First_Call := Derived_Outer;
-       Inner_Proc (Root_Type'Class(X));  -- Redispatch.
-    end Outer_Proc;
- 
-    procedure Inner_Proc (X : in out Convert_Derived_Type) is
-    begin
-       X.Second_Call := Derived_Inner;
-    end Inner_Proc;
- 
- end C390007_0.C390007_3.C390007_4;
- 
- 
-      --==================================================================--
- 
- 
- with C390007_0.C390007_1.C390007_2;
- with C390007_0.C390007_3.C390007_4;
- use  C390007_0;
- 
- with Report;
- procedure C390007 is
- begin
-    Report.Test ("C390007", "Check that the tag of an object of a tagged " &
-                 "type is preserved by type conversion and parameter passing");
- 
- 
-    --
-    -- Check that tags are preserved by parameter passing:
-    --
- 
-    Parameter_Passing_Subtest:
-    declare
-       Specific_A  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
-       Specific_B  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
- 
-       ClassWide_A : C390007_0.C390007_1.Param_Parent_Type'Class := Specific_A;
-       ClassWide_B : C390007_0.C390007_1.Param_Parent_Type'Class := Specific_B;
- 
-       use C390007_0.C390007_1;
-       use C390007_0.C390007_1.C390007_2;
-    begin
- 
-       Outer_Proc (Specific_A);         
-       if Specific_A.Last_Call /= Derived_Inner then
-          Report.Failed ("Parameter passing: tag not preserved in call to " &
-                         "primitive operation with specific operand");
-       end if;
- 
-       C390007_0.ClassWide_Proc (Specific_B);
-       if Specific_B.Last_Call /= Derived_Inner then
-          Report.Failed ("Parameter passing: tag not preserved in call to " &
-                         "class-wide operation with specific operand");
-       end if;
- 
-       Outer_Proc (ClassWide_A);        
-       if ClassWide_A.Last_Call /= Derived_Inner then
-          Report.Failed ("Parameter passing: tag not preserved in call to " &
-                         "primitive operation with class-wide operand");
-       end if;
- 
-       C390007_0.ClassWide_Proc (ClassWide_B);
-       if ClassWide_B.Last_Call /= Derived_Inner then
-          Report.Failed ("Parameter passing: tag not preserved in call to " &
-                         "class-wide operation with class-wide operand");
-       end if;
- 
-    end Parameter_Passing_Subtest;
- 
- 
-    --
-    -- Check that tags are preserved by type conversion:
-    --
- 
-    Type_Conversion_Subtest:
-    declare
-       Specific_A  : C390007_0.C390007_3.C390007_4.Convert_Derived_Type;
-       Specific_B  : C390007_0.C390007_3.C390007_4.Convert_Derived_Type;
- 
-       ClassWide_A : C390007_0.C390007_3.Convert_Parent_Type'Class :=
-                     C390007_0.C390007_3.Convert_Parent_Type(Specific_A);
-       ClassWide_B : C390007_0.C390007_3.Convert_Parent_Type'Class :=
-                     C390007_0.C390007_3.Convert_Parent_Type(Specific_B);
- 
-       use C390007_0.C390007_3;
-       use C390007_0.C390007_3.C390007_4;
-    begin
- 
-       Outer_Proc (Convert_Parent_Type(Specific_A));
-       if (Specific_A.First_Call  /= Parent_Outer)  or
-          (Specific_A.Second_Call /= Derived_Inner)
-       then
-          Report.Failed ("Type conversion: tag not preserved in call to " &
-                         "primitive operation with specific operand");
-       end if;
- 
-       Outer_Proc (ClassWide_A);   
-       if (ClassWide_A.First_Call  /= Derived_Outer) or
-          (ClassWide_A.Second_Call /= Derived_Inner)
-       then
-          Report.Failed ("Type conversion: tag not preserved in call to " &
-                         "primitive operation with class-wide operand");
-       end if;
- 
-       C390007_0.ClassWide_Proc (Convert_Parent_Type(Specific_B));
-       if (Specific_B.Second_Call /= Derived_Inner) then
-          Report.Failed ("Type conversion: tag not preserved in call to " &
-                         "class-wide operation with specific operand");
-       end if;
- 
-       C390007_0.ClassWide_Proc (ClassWide_B);
-       if (ClassWide_A.Second_Call /= Derived_Inner) then
-          Report.Failed ("Type conversion: tag not preserved in call to " &
-                         "class-wide operation with class-wide operand");
-       end if;
- 
-    end Type_Conversion_Subtest;
- 
- 
-    --
-    -- Check that tags are preserved by type conversion and parameter passing:
-    --
- 
-    Type_Conversion_And_Parameter_Passing_Subtest:
-    declare
-       Specific_A  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
-       Specific_B  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
- 
-       use C390007_0.C390007_1;
-       use C390007_0.C390007_1.C390007_2;
-    begin
- 
-       Outer_Proc (Param_Parent_Type (Specific_A));   
-       if Specific_A.Last_Call /= Parent_Outer then
-          Report.Failed ("Type conversion and parameter passing: tag not " &
-                         "preserved in call to primitive operation with "  &
-                         "specific operand");
-       end if;
- 
-       C390007_0.ClassWide_Proc (Param_Parent_Type (Specific_B));
-       if Specific_B.Last_Call /= Derived_Inner then
-          Report.Failed ("Type conversion and parameter passing: tag not " &
-                         "preserved in call to class-wide operation with "  &
-                         "specific operand");
-       end if;
- 
-    end Type_Conversion_And_Parameter_Passing_Subtest;
- 
- 
-    Report.Result;
- 
- end C390007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- C390010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that if S is a subtype of a tagged type T, and if S is
- --     constrained, then the allowable values of S'Class are only those
- --     that, when converted to T, belong to S.
- --
- -- TEST DESCRIPTION:
- --      This test defines a small tagged hierarchy of discriminated tagged
- --      records, and constrained subtypes of those tagged record types.
- --      It then uses access to the classwide of the constrained subtype
- --      to check the objective.
- --
- --
- -- CHANGE HISTORY:
- --      09 APR 96   SAIC   Initial version
- --      03 NOV 96   SAIC   Revised for 2.1 release
- --      31 DEC 97   EDS    Restored use of intermediate access variable
- --                         to eliminate raising of Program_Error
- --      13 SEP 99   RLB    Repaired previous change to avoid premature
- --                         subtype check.
- --      28 JUN 02   RLB    Added pragma Elaborate_All (Report);.
- --!
- 
- ----------------------------------------------------------------- C390010_0
- 
- with Report; pragma Elaborate_All (Report);
- package C390010_0 is
- 
-   -- the defined subprograms will allow checking the placement of
-   -- constraint_checks
- 
-   -- define a discriminated tagged type, and a constrained subtype of
-   -- that type:
- 
-   type Discr_Tag_Record( Disc: Boolean ) is tagged record
-     FieldA : Character := 'A';
-     case Disc is
-       when True  => FieldB : Character := 'B';
-       when False => FieldC : Character := 'C';
-     end case;
-   end record;
- 
-   procedure Dispatching_Op( DTO : in out Discr_Tag_Record );
- 
-   Authentic : Boolean := Report.Ident_Bool( True );
- 
-   subtype True_Record is Discr_Tag_Record( Authentic );
- 
- 
-   -- derive a type, "passing through" one discriminant, adding one
-   -- discriminant, and a constrained subtype of THAT type:
- 
-   type Derived_Record( Disc1, Disc2: Boolean ) is
-     new Discr_Tag_Record( Disc1 ) with record
-       FieldD : Character := 'D';
-       case Disc2 is
-         when True  => FieldE : Character := 'E';
-         when False => FieldF : Character := 'F';
-       end case;
-     end record;
- 
-   procedure Dispatching_Op( DR : in out Derived_Record );
- 
-   subtype True_True_Derived is Derived_Record( Authentic, Authentic );
- 
- 
-   -- now, define an access to classwide type, using the classwide from the
-   -- constrained subtype of the root (or parent) type:
- 
-   type Subtype_Parent_Class_Access is access all True_Record'Class;
-   type Parent_Class_Access is access all Discr_Tag_Record'Class;
- 
-   procedure PCW_Op( SPCA : in Subtype_Parent_Class_Access );
- 
- end C390010_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- C390010_0
- 
- with Report;
- with TCTouch;
- package body C390010_0 is
- 
-   procedure Dispatching_Op( DTO : in out Discr_Tag_Record ) is
-   begin
-     TCTouch.Touch('1');  --------------------------------------------------- 1
-     if DTO.Disc then
-       TCTouch.Touch(DTO.FieldB);  ------------------------------------------ B
-     else
-       TCTouch.Touch(DTO.FieldC);  ------------------------------------------ C
-     end if;
-   end Dispatching_Op;
- 
- 
-   procedure Dispatching_Op( DR : in out Derived_Record ) is
-   begin
-     TCTouch.Touch('2');  --------------------------------------------------- 2
-     if DR.Disc1 then
-       TCTouch.Touch(DR.FieldB);   ------------------------------------------ B
-     else
-       TCTouch.Touch(DR.FieldC);   ------------------------------------------ C
-     end if;
-     if DR.Disc2 then
-       TCTouch.Touch(DR.FieldE);   ------------------------------------------ E
-     else
-       TCTouch.Touch(DR.FieldF);   ------------------------------------------ F
-     end if;
-   end Dispatching_Op;
- 
-   procedure PCW_Op( SPCA : in Subtype_Parent_Class_Access ) is
-   begin
- 
-     -- the following line is the "heart" of this test, objects of all types
-     -- covered by the classwide type will be passed to this subprogram in
-     -- the execution of the test.
-     if SPCA.Disc then
-       TCTouch.Touch(SPCA.FieldB); ------------------------------------------ B
-     else
-       TCTouch.Touch(SPCA.FieldC); ------------------------------------------ C
-     end if;
- 
-     Dispatching_Op( SPCA.all );  -- check that this dispatches correctly,
-                                  -- with discriminants correctly represented
- 
-   end PCW_Op;
- 
- end C390010_0;
- 
- ------------------------------------------------------------------- C390010
- 
- with Report;
- with TCTouch;
- with C390010_0;
- procedure C390010 is
- 
-   package CP renames C390010_0;
- 
-   procedure Check_Element( Item : access CP.Discr_Tag_Record'Class ) is
-   begin
- 
-     -- the implicit conversion from the general access parameter to the more
-     -- constrained subtype access type in the following call should cause
-     -- Constraint_Error in the cases where the object is not correctly
-     -- constrained
- 
-     CP.PCW_Op( Item.all'Access );
- 
-   exception
-     when Constraint_Error => TCTouch.Touch('X');  -------------------------- X
-     when others => Report.Failed("Unanticipated exception in Check_Element");
- 
-   end Check_Element;
- 
-   An_Item : CP.Parent_Class_Access;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C390010", "Check that if S is a subtype of a tagged type " &
-                           "T, and if S is constrained, then the allowable " &
-                           "values of S'Class are only those that, when " &
-                           "converted to T, belong to S" );
- 
-   An_Item := new CP.Discr_Tag_Record(True);
-   Check_Element( An_Item );
-   TCTouch.Validate("B1B","Case 1");
- 
-   An_Item := new CP.Discr_Tag_Record(False);
-   Check_Element( An_Item );
-   TCTouch.Validate("X","Case 2");
- 
-   An_Item := new CP.True_Record;
-   Check_Element( An_Item );
-   TCTouch.Validate("B1B","Case 3");
- 
-   An_Item := new CP.Derived_Record(False, False);
-   Check_Element( An_Item );
-   TCTouch.Validate("X","Case 4");
- 
-   An_Item := new CP.Derived_Record(False, True);
-   Check_Element( An_Item );
-   TCTouch.Validate("X","Case 5");
- 
-   An_Item := new CP.Derived_Record(True, False);
-   Check_Element( An_Item );
-   TCTouch.Validate("B2BF","Case 6");
- 
-   An_Item := new CP.True_True_Derived;
-   Check_Element( An_Item );
-   TCTouch.Validate("B2BE","Case 7");
- 
-   Report.Result;
- 
- end C390010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,250 ****
- -- C390011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that tagged types declared within generic package declarations
- --     generate distinct tags for each instance of the generic.
- --
- -- TEST DESCRIPTION:
- --     This test defines a very simple generic package (with the expectation
- --     that it should be easily be shared), and a few instances of that
- --     package.  In true user-like fashion, two of the instances are identical
- --     (to wit: IIO is new Integer_IO(Integer)).  The tags generated for each
- --     of them are placed into a list.  The last action of the test is to
- --     check that everything in the list is unique.
- --
- --     Almost as an aside, this test defines functions that return T'Base and
- --     T'Class, and then exercises these functions.
- --
- --     (JPR) persistent objects really need a function like:
- --        function Get_Object return T'class;
- --
- --
- -- CHANGE HISTORY:
- --      20 OCT 95   SAIC   Initial version
- --      23 APR 96   SAIC   Commentary Corrections 2.1
- --
- --!
- 
- ----------------------------------------------------------------- C390011_0
- 
- with Ada.Tags;
- package C390011_0 is
- 
-   procedure Add_Tag_To_List( T : Ada.Tags.Tag; X_Name, X_Tag: String );
- 
-   procedure Check_List_For_Duplicates;
- 
- end C390011_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C390011_0 is
- 
-   use type Ada.Tags.Tag;
-   type SP is access String;
- 
-   type List_Item;
-   type List_P is access List_Item;
-   type List_Item is record
-     The_Tag  : Ada.Tags.Tag;
-     Exp_Name : SP;
-     Ext_Tag  : SP;
-     Next : List_P;
-   end record;
- 
-   The_List : List_P;
- 
-   procedure Add_Tag_To_List ( T : Ada.Tags.Tag; X_Name, X_Tag: String ) is
-   begin  -- prepend the tag information to the list
-     The_List := new List_Item'( The_Tag  => T, 
-                                 Exp_Name => new String'(X_Name), 
-                                 Ext_Tag  => new String'(X_Tag),
-                                 Next     => The_List );
-   end Add_Tag_To_List;
- 
-   procedure Check_List_For_Duplicates is
-     Finger : List_P;
-     Thumb  : List_P := The_List;
-   begin  -- 
-     while Thumb /= null loop
-       Finger := Thumb.Next;
-       while Finger /= null loop
-         -- Check that the tag is unique
-         if Finger.The_Tag = Thumb.The_Tag then
-           Report.Failed("Duplicate Tag");
-         end if;
- 
-         -- Check that the Expanded name is unique
-         if Finger.Exp_Name.all = Thumb.Exp_Name.all then
-           Report.Failed("Tag name " & Finger.Exp_Name.all & " repeats");
-         end if;
- 
-         -- Check that the External Tag is unique
- 
-         if Finger.Ext_Tag.all = Thumb.Ext_Tag.all then
-           Report.Failed("External Tag " & Finger.Ext_Tag.all & " repeats");
-         end if;
-         Finger := Finger.Next;
-       end loop;
-       Thumb  := Thumb.Next;
-    end loop;
-   end Check_List_For_Duplicates;
- 
- begin
-   -- some things I just don't trust...
-   if The_List /= null then
-     Report.Failed("Implicit default for The_List not null");
-   end if;
- end C390011_0;
- 
- ----------------------------------------------------------------- C390011_1
- 
- generic
-   type Index is (<>);
-   type Item is private;
- package C390011_1 is
- 
-   type List is array(Index range <>) of Item;
-   type ListP is access all List;
- 
-   type Table is tagged record
-     Data: ListP;
-   end record;
- 
-   function Sort( T: in Table'Class ) return Table'Class;
- 
-   function Stable_Table return Table'Class;
- 
-   function Table_End( T: Table ) return Index'Base;
- 
- end C390011_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C390011_1 is
- 
-     -- In a user program this package would DO something
- 
-   function Sort( T: in Table'Class ) return Table'Class is
-   begin
-    return T;
-   end Sort;
- 
-   Empty : Table'Class := Table'( Data => null );
- 
-   function Stable_Table return Table'Class is
-   begin
-     return Empty;
-   end Stable_Table;
- 
-   function Table_End( T: Table ) return Index'Base is
-   begin
-     return Index'Base( T.Data.all'Last );
-   end Table_End;
- 
- end C390011_1;
- 
- ----------------------------------------------------------------- C390011_2
- 
- with C390011_1;
- package C390011_2 is new C390011_1( Index => Character, Item => Float );
- 
- ----------------------------------------------------------------- C390011_3
- 
- with C390011_1;
- package C390011_3 is new C390011_1( Index => Character, Item => Float );
- 
- ----------------------------------------------------------------- C390011_4
- 
- with C390011_1;
- package C390011_4 is new C390011_1( Index => Integer, Item => Character );
- 
- ----------------------------------------------------------------- C390011_5
- 
- with C390011_3;
- with C390011_4;
- package C390011_5 is
- 
-   type Table_3 is new C390011_3.Table with record
-     Serial_Number : Integer;
-   end record;
- 
-   type Table_4 is new C390011_4.Table with record
-     Serial_Number : Integer;
-   end record;
- 
- end C390011_5;
- 
- -- no package body C390011_5 required
- 
- ------------------------------------------------------------------- C390011
- 
- with Report;
- with C390011_0;
- with C390011_2;
- with C390011_3;
- with C390011_4;
- with C390011_5;
- with Ada.Tags;
- procedure C390011 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C390011", "Check that tagged types declared within " &
-                           "generic package declarations generate distinct " &
-                           "tags for each instance of the generic. " &
-                           "Check that 'Base may be used as a subtype mark. " &
-                           "Check that T'Base and T'Class are allowed as " &
-                           "the subtype mark in a function result" );
- 
-   -- build the tag information table
-   C390011_0.Add_Tag_To_List(T => C390011_2.Table'Tag,
-                        X_Name => Ada.Tags.Expanded_Name(C390011_2.Table'Tag),
-                        X_Tag  => Ada.Tags.External_Tag(C390011_2.Table'Tag) );
- 
-   C390011_0.Add_Tag_To_List(T => C390011_3.Table'Tag,
-                        X_Name => Ada.Tags.Expanded_Name(C390011_3.Table'Tag),
-                        X_Tag  => Ada.Tags.External_Tag(C390011_3.Table'Tag) );
- 
-   C390011_0.Add_Tag_To_List(T => C390011_4.Table'Tag,
-                        X_Name => Ada.Tags.Expanded_Name(C390011_4.Table'Tag),
-                        X_Tag  => Ada.Tags.External_Tag(C390011_4.Table'Tag) );
- 
-   C390011_0.Add_Tag_To_List(T => C390011_5.Table_3'Tag,
-                      X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_3'Tag),
-                      X_Tag  => Ada.Tags.External_Tag(C390011_5.Table_3'Tag) );
- 
-   C390011_0.Add_Tag_To_List(T => C390011_5.Table_4'Tag,
-                      X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_4'Tag),
-                      X_Tag  => Ada.Tags.External_Tag(C390011_5.Table_4'Tag) );
- 
-   -- preform the check for distinct tags
-   C390011_0.Check_List_For_Duplicates;
- 
-   Report.Result;
- 
- end C390011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,207 ****
- -- C39006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
- -- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
- -- FOLLOWING:
- --     A) A FUNCTION IS CALLED IN THE INITIALIZATION EXPRESSION OF A
- --        SCALAR VARIABLE OR A RECORD COMPONENT, AND THE SCALAR OR
- --        RECORD VARIABLE'S DECLARATION IS ELABORATED BEFORE THE
- --        SUBPROGRAM BODY IS ELABORATED.
- 
- -- TBN  8/14/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C39006A IS
- 
- BEGIN
-      TEST ("C39006A", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
-                       "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " &
-                       "BODY HAS NOT YET BEEN ELABORATED");
-      BEGIN
-           DECLARE
- 
-                FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER;
- 
-                VAR1 : INTEGER := INIT_1 (1);
- 
-                FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER IS
-                BEGIN
-                     RETURN (A + IDENT_INT(1));
-                END INIT_1;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 1");
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-      END;
- 
-      BEGIN
-           DECLARE
- 
-                FUNCTION INIT_2 (A : INTEGER) RETURN INTEGER;
- 
-                TYPE REC1 IS
-                     RECORD
-                          NUMBER : INTEGER := INIT_2 (2);
-                     END RECORD;
- 
-                VAR2 : REC1;
- 
-                FUNCTION INIT_2 (A : INTEGER) RETURN INTEGER IS
-                BEGIN
-                     RETURN (A + IDENT_INT(1));
-                END INIT_2;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 2");
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      BEGIN
-           DECLARE
- 
-                FUNCTION F1 RETURN INTEGER;
- 
-                PACKAGE PACK IS
-                     VAR1 : INTEGER := F1;
-                END PACK;
- 
-                FUNCTION F1 RETURN INTEGER IS
-                BEGIN
-                     RETURN (IDENT_INT(1));
-                END F1;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 3");
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-      END;
- 
-      BEGIN
-           DECLARE
- 
-                PACKAGE PACK IS
-                     FUNCTION F2 RETURN INTEGER;
-                     VAR2 : INTEGER := F2;
-                END PACK;
- 
-                PACKAGE BODY PACK IS
-                     FUNCTION F2 RETURN INTEGER IS
-                     BEGIN
-                          RETURN (IDENT_INT(3));
-                     END F2;
-                END PACK;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 4");
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-      END;
- 
-      BEGIN
-           DECLARE
- 
-                FUNCTION INIT_3 (A : INTEGER) RETURN INTEGER;
- 
-                GENERIC
-                     PACKAGE Q IS
-                          VAR1 : INTEGER := INIT_3 (1);
-                     END Q;
- 
-                PACKAGE NEW_Q IS NEW Q;
- 
-                FUNCTION INIT_3 (A : INTEGER) RETURN INTEGER IS
-                BEGIN
-                     RETURN (A + IDENT_INT(3));
-                END INIT_3;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 5");
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-      END;
- 
-      BEGIN
-           DECLARE
- 
-                FUNCTION FUN RETURN INTEGER;
- 
-                TYPE PARAM IS
-                     RECORD
-                          COMP : INTEGER := FUN;
-                     END RECORD;
- 
-                GENERIC
-                     TYPE T IS PRIVATE;
-                PACKAGE GP IS
-                     OBJ : T;
-                END GP;
- 
-                PACKAGE INST IS NEW GP(PARAM);
- 
-                FUNCTION FUN RETURN INTEGER IS
-                BEGIN
-                     RETURN (IDENT_INT(3));
-                END FUN;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 6");
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-      END;
- 
-      RESULT;
- END C39006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- C39006B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
- -- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
- -- FOLLOWING:
- --     B) THE SUBPROGRAM IS CALLED IN A PACKAGE BODY.
- --     C) THE SUBPROGRAM IS AN ACTUAL GENERIC PARAMETER CALLED DURING
- --        ELABORATION OF THE GENERIC INSTANTIATION.
- --     D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL
- --        PACKAGE BODY.
- 
- -- TBN  8/19/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C39006B IS
- 
- BEGIN
-      TEST ("C39006B", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
-                       "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " &
-                       "BODY HAS NOT YET BEEN ELABORATED");
-      BEGIN
-           DECLARE
-                PACKAGE PACK IS
-                     FUNCTION FUN RETURN INTEGER;
-                     PROCEDURE PROC (A : IN OUT INTEGER);
-                END PACK;
- 
-                PACKAGE BODY PACK IS
- 
-                     VAR1 : INTEGER := 0;
- 
-                     PROCEDURE PROC (A : IN OUT INTEGER) IS
-                     BEGIN
-                          IF A = IDENT_INT(1) THEN
-                               A := A + FUN;
-                               FAILED ("PROGRAM_ERROR NOT RAISED - 1");
-                          ELSE
-                               A := IDENT_INT(1);
-                          END IF;
-                     EXCEPTION
-                          WHEN PROGRAM_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                                       "1");
-                     END PROC;
- 
-                     PACKAGE INSIDE IS
-                     END INSIDE;
- 
-                     PACKAGE BODY INSIDE IS
-                     BEGIN
-                          PROC (VAR1);
-                          PROC (VAR1);
-                     END INSIDE;
- 
-                     FUNCTION FUN RETURN INTEGER IS
-                     BEGIN
-                          RETURN (IDENT_INT(1));
-                     END FUN;
- 
-                BEGIN
-                     NULL;
-                END PACK;
- 
-           BEGIN
-                NULL;
-           END;
-      END;
- 
-      BEGIN
-           DECLARE
-                FUNCTION INIT_2 RETURN INTEGER;
- 
-                GENERIC
-                     WITH FUNCTION FF RETURN INTEGER;
-                PACKAGE P IS
-                     Y : INTEGER;
-                END P;
- 
-                GLOBAL_INT : INTEGER := IDENT_INT(1);
- 
-                PACKAGE BODY P IS
-                BEGIN
-                     IF GLOBAL_INT = 1 THEN
-                          Y := FF;
-                     END IF;
-                END P;
- 
-                PACKAGE N IS
-                     PACKAGE NEW_P IS NEW P(INIT_2);
-                END N;
- 
-                FUNCTION INIT_2 RETURN INTEGER IS
-                BEGIN
-                     RETURN (IDENT_INT (1));
-                END INIT_2;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 2");
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      DECLARE
- 
-           PROCEDURE ADD1 (A : IN OUT INTEGER);
- 
-           PACKAGE P IS
-                VAR : INTEGER := IDENT_INT(1);
-           END P;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                IF VAR = 1 THEN
-                     ADD1 (VAR);
-                     FAILED ("PROGRAM_ERROR NOT RAISED - 3");
-                END IF;
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-           END P;
- 
-           PROCEDURE ADD1 (A : IN OUT INTEGER) IS
-           BEGIN
-                A := A + IDENT_INT(1);
-           END ADD1;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C39006B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006c0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- C39006C0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
- -- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
- -- FOLLOWING:
- --     D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL
- --        PACKAGE BODY SUBUNIT THAT IS IN C39006C1.ADA.
- 
- -- SEPARATE FILES ARE:
- --     C39006C0M     THE MAIN PROCEDURE.
- --     C39006C1      A SUBUNIT PACKAGE BODY.
- 
- -- TBN  8/19/86
- -- LDC  5/26/88   CHANGED TEST NAME PARAMETER FROM C39006C0M TO
- --                C39006C IN THE TEST CALL.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C39006C0M IS
- 
-      PACKAGE CALL_TEST_FIRST IS
-      END CALL_TEST_FIRST;
- 
-      PACKAGE BODY CALL_TEST_FIRST IS
-      BEGIN
-           TEST ("C39006C", "CHECK THAT PROGRAM_ERROR IS RAISED IF " &
-                              "THE SUBPROGRAM WHOSE BODY HAS NOT BEEN " &
-                              "ELABORATED IS CALLED DURING " &
-                              "ELABORATION OF AN OPTIONAL PACKAGE " &
-                              "BODY SUBUNIT");
-      END CALL_TEST_FIRST;
- 
-      PROCEDURE ADD1 (A : IN OUT INTEGER);
- 
-      PACKAGE C39006C1 IS
-           VAR : INTEGER := IDENT_INT(1);
-      END C39006C1;
- 
-      PACKAGE BODY C39006C1 IS SEPARATE;
- 
-      PROCEDURE ADD1 (A : IN OUT INTEGER) IS
-      BEGIN
-           A := A + IDENT_INT(1);
-      END ADD1;
- 
- BEGIN
-      RESULT;
- END C39006C0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006c1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,41 ****
- -- C39006C1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- PACKAGE BODY SUBUNIT FOR C39006C0M.ADA.
- 
- -- TBN  8/19/86
- 
- SEPARATE (C39006C0M)
- PACKAGE BODY C39006C1 IS
- BEGIN
-      IF VAR = IDENT_INT(1) THEN
-           ADD1 (VAR);
-           FAILED ("PROGRAM_ERROR NOT RAISED");
-      END IF;
- EXCEPTION
-      WHEN PROGRAM_ERROR =>
-           NULL;
-      WHEN OTHERS =>
-           FAILED ("UNEXPECTED EXCEPTION RAISED");
- END C39006C1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- C39006D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A FUNCTION IS USED IN A DEFAULT EXPRESSION FOR A
- -- SUBPROGRAM OR FORMAL GENERIC PARAMETER, PROGRAM_ERROR IS RAISED
- -- WHEN AN ATTEMPT IS MADE TO EVALUATE THE DEFAULT EXPRESSION,
- -- BECAUSE THE FUNCTION'S BODY HAS NOT BEEN ELABORATED YET.
- 
- -- TBN  8/20/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C39006D IS
- 
- BEGIN
-      TEST ("C39006D", "CHECK THAT IF A FUNCTION IS USED IN A DEFAULT " &
-                       "EXPRESSION FOR A SUBPROGRAM OR FORMAL GENERIC " &
-                       "PARAMETER, PROGRAM_ERROR IS RAISED WHEN AN " &
-                       "ATTEMPT IS MADE TO EVALUATE THE DEFAULT " &
-                       "EXPRESSION");
-      DECLARE
-           FUNCTION FUN RETURN INTEGER;
- 
-           PACKAGE P IS
-                PROCEDURE DEFAULT (A : INTEGER := FUN);
-           END P;
- 
-           PACKAGE BODY P IS
-                PROCEDURE DEFAULT (A : INTEGER := FUN) IS
-                     B : INTEGER := 1;
-                BEGIN
-                     B := B + IDENT_INT(A);
-                END DEFAULT;
-           BEGIN
-                DEFAULT (2);
-                DEFAULT;
-                FAILED ("PROGRAM_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-           END P;
- 
-           FUNCTION FUN RETURN INTEGER IS
-           BEGIN
-                RETURN (IDENT_INT(1));
-           END FUN;
-      BEGIN
-           NULL;
-      END;
- 
-      BEGIN
-           DECLARE
-                FUNCTION INIT_1 RETURN INTEGER;
- 
-                GENERIC
-                     LENGTH : INTEGER := INIT_1;
-                PACKAGE P IS
-                     TYPE ARRAY1 IS ARRAY (1 .. LENGTH) OF INTEGER;
-                END P;
- 
-                PACKAGE NEW_P1 IS NEW P (4);
-                PACKAGE NEW_P2 IS NEW P;
- 
-                FUNCTION INIT_1 RETURN INTEGER IS
-                BEGIN
-                     RETURN (IDENT_INT(2));
-                END INIT_1;
- 
-           BEGIN
-                FAILED ("PROGRAM_ERROR NOT RAISED - 2");
-           END;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      DECLARE
-           FUNCTION INIT_2 RETURN INTEGER;
- 
-           GLOBAL_INT : INTEGER := IDENT_INT(1);
- 
-           GENERIC
-           PACKAGE Q IS
-                PROCEDURE ADD1 (A : INTEGER := INIT_2);
-           END Q;
- 
-           PACKAGE BODY Q IS
-                PROCEDURE ADD1 (A : INTEGER := INIT_2) IS
-                     B : INTEGER;
-                BEGIN
-                     B := A;
-                END ADD1;
-           BEGIN
-                IF GLOBAL_INT = IDENT_INT(1) THEN
-                     ADD1;
-                     FAILED ("PROGRAM_ERROR NOT RAISED - 3");
-                ELSE
-                     ADD1 (2);
-                END IF;
- 
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-           END Q;
- 
-           PACKAGE NEW_Q IS NEW Q;
- 
-           FUNCTION INIT_2 RETURN INTEGER IS
-           BEGIN
-                RETURN (IDENT_INT(1));
-           END INIT_2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C39006D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,213 ****
- -- C39006E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PROGRAM_ERROR IS NOT RAISED IF A SUBPROGRAM'S BODY HAS
- -- BEEN ELABORATED BEFORE IT IS CALLED. CHECK THE FOLLOWING:
- --     A) A SUBPROGRAM CAN APPEAR IN A NON-ELABORATED DECLARATIVE PART
- --        OR PACKAGE SPECIFICATION BEFORE ITS BODY.
- 
- -- TBN  8/21/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C39006E IS
- 
- BEGIN
-      TEST ("C39006E", "CHECK THAT PROGRAM_ERROR IS NOT RAISED IF A " &
-                       "SUBPROGRAM IS CALLED IN A NON-ELABORATED " &
-                       "DECLARATIVE PART OR PACKAGE SPECIFICATION " &
-                       "BEFORE ITS BODY IS ELABORATED");
-      DECLARE -- (A)
- 
-           FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER;
- 
-           PACKAGE P IS
-                PROCEDURE USE_INIT1;
-           END P;
- 
-           PACKAGE BODY P IS
-                PROCEDURE USE_INIT1 IS
-                BEGIN
-                     IF NOT EQUAL (3, 3) THEN
-                          DECLARE
-                               X : INTEGER := INIT_1 (1);
-                          BEGIN
-                               NULL;
-                          END;
-                     ELSE
-                          NULL;
-                     END IF;
- 
-                EXCEPTION
-                     WHEN PROGRAM_ERROR =>
-                          FAILED ("PROGRAM_ERROR RAISED - 1");
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-                END USE_INIT1;
- 
-           BEGIN
-                USE_INIT1;
-           END P;
- 
-           FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN (A + IDENT_INT(1));
-           END INIT_1;
- 
-      BEGIN -- (A)
-           NULL;
-      END; -- (A)
- 
-      DECLARE -- (B)
- 
-           PROCEDURE INIT_2 (A : IN OUT INTEGER);
- 
-           PACKAGE P IS
-                FUNCTION USE_INIT2 RETURN BOOLEAN;
-           END P;
- 
-           PACKAGE BODY P IS
-                FUNCTION USE_INIT2 RETURN BOOLEAN IS
-                BEGIN
-                     IF NOT EQUAL (3, 3) THEN
-                          DECLARE
-                               X : INTEGER;
-                          BEGIN
-                               INIT_2 (X);
-                          END;
-                     END IF;
-                     RETURN IDENT_BOOL (FALSE);
- 
-                EXCEPTION
-                     WHEN PROGRAM_ERROR =>
-                          FAILED ("PROGRAM_ERROR RAISED - 2");
-                          RETURN FALSE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-                          RETURN FALSE;
-                END USE_INIT2;
-           BEGIN
-                IF USE_INIT2 THEN
-                     FAILED ("INCORRECT RESULTS FROM FUNCTION CALL - 2");
-                END IF;
-           END P;
- 
-           PROCEDURE INIT_2 (A : IN OUT INTEGER) IS
-           BEGIN
-                A := A + IDENT_INT(1);
-           END INIT_2;
- 
-      BEGIN -- (B)
-           NULL;
-      END; -- (B)
- 
-      DECLARE -- (C)
-           FUNCTION INIT_3 RETURN INTEGER;
- 
-           PACKAGE Q IS
-                VAR : INTEGER;
-           END Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF NOT EQUAL (3, 3) THEN
-                     VAR := INIT_3;
-                END IF;
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     FAILED ("PROGRAM_ERROR RAISED - 3");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-           END Q;
- 
-           FUNCTION INIT_3 RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (1);
-           END INIT_3;
- 
-      BEGIN -- (C)
-           NULL;
-      END; -- (C)
- 
-      DECLARE -- (D)
-           PROCEDURE INIT_4 (A : IN OUT INTEGER);
- 
-           PACKAGE Q IS
-                VAR : INTEGER := 1;
-           END Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF NOT EQUAL (3, 3) THEN
-                     INIT_4 (VAR);
-                END IF;
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     FAILED ("PROGRAM_ERROR RAISED - 4");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-           END Q;
- 
-           PROCEDURE INIT_4 (A : IN OUT INTEGER) IS
-           BEGIN
-                A := IDENT_INT (4);
-           END INIT_4;
- 
-      BEGIN -- (D)
-           NULL;
-      END; -- (D)
- 
-      BEGIN -- (E)
- 
-           DECLARE
-                FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER;
- 
-                PROCEDURE USE_INIT5 IS
-                     PACKAGE Q IS
-                          X : INTEGER := INIT_5 (1);
-                     END Q;
-                     USE Q;
-                BEGIN
-                     X := IDENT_INT (5);
- 
-                END USE_INIT5;
- 
-                FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER IS
-                BEGIN
-                     RETURN (A + IDENT_INT(1));
-                END INIT_5;
- 
-           BEGIN
-                USE_INIT5;
-           END;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                FAILED ("PROGRAM_ERROR RAISED - 5");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
- 
-      END; -- (E)
- 
-      RESULT;
- END C39006E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,44 ****
- -- C39006F0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
- --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
- --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
- --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
- --           SUBPROGRAM.
- 
- --     THIS SUBPROGRAM LIBRARY UNIT IS USED BY C39006F2.ADA.
- 
- -- HISTORY:
- --     TBN  08/22/86  CREATED ORIGINAL TEST.
- --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
- --                    TO 'TEST'.
- 
- WITH REPORT; USE REPORT;
- 
- FUNCTION C39006F0 (A : INTEGER) RETURN INTEGER IS
- BEGIN
-      RETURN (IDENT_INT(A));
- END C39006F0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,42 ****
- -- C39006F1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
- --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
- --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
- --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
- --           SUBPROGRAM.
- 
- --     THIS LIBRARY PACKAGE SPECIFICATION IS USED BY C39006F3M.ADA.
- 
- -- HISTORY:
- --     TBN  08/22/86  CREATED ORIGINAL TEST.
- --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
- --                    TO 'TEST'.
- --     PWN  05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- PACKAGE C39006F1 IS
-      PROCEDURE REQUIRE_BODY;
- END C39006F1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- C39006F2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
- --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
- --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
- --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
- --           SUBPROGRAM.
- 
- --     THIS LIBRARY PACKAGE BODY IS USED BY C39006F3M.ADA.
- 
- -- HISTORY:
- --     TBN  08/22/86  CREATED ORIGINAL TEST.
- --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
- --                    TO 'TEST'.
- --     PWN  05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- WITH C39006F0;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (C39006F0, REPORT);
- 
- PACKAGE BODY C39006F1 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- 
- BEGIN
-      TEST ("C39006F", "CHECK THAT NO PROGRAM_ERROR IS RAISED IF A " &
-                       "SUBPROGRAM'S BODY HAS BEEN ELABORATED " &
-                       "BEFORE IT IS CALLED, WHEN A SUBPROGRAM " &
-                       "LIBRARY UNIT IS USED IN ANOTHER UNIT AND " &
-                       "PRAGMA ELABORATE IS USED");
-      BEGIN
-           DECLARE
-                VAR1 : INTEGER := C39006F0 (IDENT_INT(1));
-           BEGIN
-                IF VAR1 /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT RESULTS - 1");
-                END IF;
-           END;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                FAILED ("PROGRAM_ERROR RAISED - 1");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-      END;
- 
-      DECLARE
-           VAR2 : INTEGER := 1;
- 
-           PROCEDURE CHECK (B : IN OUT INTEGER) IS
-           BEGIN
-                B := C39006F0 (IDENT_INT(2));
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     FAILED ("PROGRAM_ERROR RAISED - 2");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-           END CHECK;
-      BEGIN
-           CHECK (VAR2);
-           IF VAR2 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-      END;
- 
-      DECLARE
-           PACKAGE P IS
-                VAR3 : INTEGER;
-           END P;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                VAR3 := C39006F0 (IDENT_INT(3));
-                IF VAR3 /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RESULTS - 3");
-                END IF;
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     FAILED ("PROGRAM_ERROR RAISED - 3");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION - 3");
-           END P;
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE
-           GENERIC
-                VAR4 : INTEGER := 1;
-           PACKAGE Q IS
-                TYPE ARRAY_TYP1 IS ARRAY (1 .. VAR4) OF INTEGER;
-                ARRAY_1 : ARRAY_TYP1;
-           END Q;
- 
-           PACKAGE NEW_Q IS NEW Q (C39006F0 (IDENT_INT(4)));
- 
-           USE NEW_Q;
- 
-      BEGIN
-           IF ARRAY_1'LAST /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-      END;
- 
- END C39006F1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006f3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006f3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,49 ****
- -- C39006F3M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
- --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
- --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
- --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
- --           SUBPROGRAM.
- 
- -- SEPARATE FILES ARE:
- --      C39006F0     A LIBRARY FUNCTION.
- --      C39006F1     A LIBRARY PACKAGE SPECIFICATION.
- --      C39006F2     A LIBRARY PACKAGE BODY.
- --      C39006F3M    (THIS FILE) THE MAIN PROCEDURE.
- 
- -- HISTORY:
- --     TBN  08/22/86  CREATED ORIGINAL TEST.
- --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
- --                    TO 'TEST'.
- 
- WITH C39006F1;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C39006F3M IS
- BEGIN
-      RESULT;
- END C39006F3M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39006g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39006g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C39006G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO CALL A
- --     SUBPROGRAM WHOSE BODY IS NOT YET ELABORATED.  USE A PACKAGE
- --     WITH OPTIONAL BODY, WHERE THE SUBPROGRAM IS CALLED IN THE BODY.
- 
- -- HISTORY:
- --     BCB 08/01/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C39006G IS
- 
-      PROCEDURE INIT (X : IN OUT INTEGER);
- 
-      PACKAGE P IS
-      END P;
- 
-      PACKAGE BODY P IS
-           X : INTEGER := IDENT_INT(5);
-      BEGIN
-           TEST ("C39006G", "CHECK THAT PROGRAM_ERROR IS RAISED BY " &
-                            "AN ATTEMPT TO CALL A SUBPROGRAM WHOSE " &
-                            "BODY IS NOT YET ELABORATED.  USE A " &
-                            "PACKAGE WITH OPTIONAL BODY, WHERE THE " &
-                            "SUBPROGRAM IS CALLED IN THE BODY");
-           INIT(X);
-           FAILED ("NO EXCEPTION RAISED");
-           IF X /= IDENT_INT(10) THEN
-                COMMENT ("TOTALLY IRRELEVANT");
-           END IF;
-           RESULT;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                RESULT;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION WAS RAISED");
-                RESULT;
-      END P;
- 
-      PROCEDURE INIT (X : IN OUT INTEGER) IS
-      BEGIN
-           X := IDENT_INT(10);
-      END INIT;
- 
- BEGIN
-      NULL;
- END C39006G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- C39007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO
- -- INSTANTIATE A GENERIC UNIT WHOSE BODY HAS NOT BEEN ELABORATED.
- -- CHECK THE FOLLOWING CASE:
- --     A) A SIMPLE CASE WHERE THE GENERIC UNIT BODY OCCURS LATER IN
- --        THE SAME DECLARATIVE PART.
- 
- -- TBN  9/12/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C39007A IS
- 
- BEGIN
-      TEST ("C39007A", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
-                       "ATTEMPT IS MADE TO INSTANTIATE A GENERIC " &
-                       "UNIT WHOSE BODY HAS NOT BEEN ELABORATED, " &
-                       "BUT OCCURS IN THE SAME DECLARATIVE PART");
- 
-      BEGIN
-           IF EQUAL (1, 1) THEN
-                DECLARE
-                     GENERIC
-                     PACKAGE P IS
-                          A : INTEGER;
-                          PROCEDURE ASSIGN (X : OUT INTEGER);
-                     END P;
- 
-                     PACKAGE NEW_P IS NEW P;
- 
-                     PACKAGE BODY P IS
-                          PROCEDURE ASSIGN (X : OUT INTEGER) IS
-                          BEGIN
-                               X := IDENT_INT (1);
-                          END ASSIGN;
-                     BEGIN
-                          ASSIGN (A);
-                     END P;
- 
-                BEGIN
-                     NULL;
-                END;
-                FAILED ("PROGRAM_ERROR WAS NOT RAISED - 1");
-           END IF;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-      END;
- 
- ------------------------------------------------------------------------
- 
-      BEGIN
-           IF EQUAL (2, 2) THEN
-                DECLARE
-                     GENERIC
-                     PROCEDURE ADD1 (X : IN OUT INTEGER);
- 
-                     PROCEDURE NEW_ADD1 IS NEW ADD1;
- 
-                     PROCEDURE ADD1 (X : IN OUT INTEGER) IS
-                     BEGIN
-                          X := X + IDENT_INT (1);
-                     END ADD1;
-                BEGIN
-                     NULL;
-                END;
-                FAILED ("PROGRAM_ERROR WAS NOT RAISED - 2");
-           END IF;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
- ------------------------------------------------------------------------
- 
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                DECLARE
-                     GENERIC
-                     FUNCTION INIT RETURN INTEGER;
- 
-                     FUNCTION NEW_INIT IS NEW INIT;
- 
-                     FUNCTION INIT RETURN INTEGER IS
-                     BEGIN
-                          RETURN (IDENT_INT (1));
-                     END INIT;
-                BEGIN
-                     NULL;
-                END;
-                FAILED ("PROGRAM_ERROR WAS NOT RAISED - 3");
-           END IF;
- 
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-      END;
- 
- ------------------------------------------------------------------------
- 
-      RESULT;
- END C39007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39007b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39007b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39007b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C39007B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO INSTANTIATE
- --     A GENERIC UNIT WHOSE BODY IS NOT YET ELABORATED.  USE A GENERIC
- --     UNIT THAT IS DECLARED AND INSTANTIATED IN A PACKAGE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 08/01/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C39007B IS
- 
- BEGIN
-      TEST ("C39007B", "CHECK THAT PROGRAM_ERROR IS RAISED BY AN " &
-                       "ATTEMPT TO INSTANTIATE A GENERIC UNIT WHOSE " &
-                       "BODY IS NOT YET ELABORATED.  USE A GENERIC " &
-                       "UNIT THAT IS DECLARED AND INSTANTIATED IN A " &
-                       "PACKAGE SPECIFICATION");
- 
-      DECLARE
-      BEGIN
-           DECLARE
-                PACKAGE P IS
-                     GENERIC
-                     FUNCTION F RETURN BOOLEAN;
- 
-                     FUNCTION NEW_F IS NEW F;
-                END P;
- 
-                PACKAGE BODY P IS
-                     FUNCTION F RETURN BOOLEAN IS
-                     BEGIN
-                          RETURN TRUE;
-                     END F;
-                END P;
-           BEGIN
-                FAILED ("NO EXCEPTION RAISED");
-                DECLARE
-                     X : BOOLEAN := IDENT_BOOL(FALSE);
-                BEGIN
-                     X := P.NEW_F;
-                     IF X /= IDENT_BOOL(TRUE) THEN
-                          COMMENT ("NOT RELEVANT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED TOO LATE");
-                END;
-           END;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C39007B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C39008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO ACTIVATE
- --     A TASK BEFORE ITS BODY HAS BEEN ELABORATED.  CHECK THE CASE IN
- --     WHICH A TASK VARIABLE IS DECLARED IN A PACKAGE SPECIFICATION AND
- --     THE PACKAGE BODY OCCURS BEFORE THE TASK BODY.
- 
- -- HISTORY:
- --     BCB 01/21/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C39008A IS
- 
- BEGIN
-      TEST ("C39008A", "CHECK THAT PROGRAM_ERROR IS RAISED BY AN " &
-                       "ATTEMPT TO ACTIVATE A TASK BEFORE ITS BODY " &
-                       "HAS BEEN ELABORATED.  CHECK THE CASE IN WHICH " &
-                       "A TASK VARIABLE IS DECLARED IN A PACKAGE " &
-                       "SPECIFICATION AND THE PACKAGE BODY OCCURS " &
-                       "BEFORE THE TASK BODY");
- 
-      BEGIN
-           DECLARE
-                TASK TYPE T;
- 
-                PACKAGE P IS
-                     X : T;
-                END P;
- 
-                PACKAGE BODY P IS
-                END P;                                  -- PROGRAM_ERROR.
- 
-                TASK BODY T IS
-                BEGIN
-                     COMMENT ("TASK MESSAGE");
-                END T;
-           BEGIN
-                FAILED ("PROGRAM_ERROR WAS NOT RAISED");
-           END;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR WAS RAISED");
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN PROGRAM_ERROR WAS " &
-                        "RAISED");
-      END;
- 
-      RESULT;
- END C39008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39008b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39008b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39008b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C39008B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE ACTIVATION OF A TASK IS ATTEMPTED BEFORE THE
- -- ELABORATION OF THE CORRESPONDING BODY IS FINISHED, THE EXCEPTION
- -- PROGRAM_ERROR IS RAISED, NOT TASKING_ERROR (SEE AI-00149).
- 
- -- WEI  3/04/82
- -- JBG  2/17/84
- -- EG  11/02/84
- -- JBG 5/23/85
- -- JWC 6/28/85   RENAMED FROM C93007B-B.ADA
- 
- WITH REPORT;
-  USE REPORT;
- 
- PROCEDURE C39008B IS
- 
- BEGIN
- 
-      TEST ("C39008B", "PROGRAM_ERROR AFTER ATTEMPT OF ACTIVATION " &
-                       "BEFORE ELABORATION");
- BLOCK1:
-      BEGIN
- BLOCK2:
-           DECLARE
-                TASK TYPE TT1;
- 
-                TYPE ATT1 IS ACCESS TT1;
- 
-                POINTER_TT1 : ATT1 := NEW TT1;  -- ACCESSING TASK BODY
-                                                -- BEFORE ITS ELABORATION
- 
-                TASK BODY TT1 IS
-                BEGIN
-                     FAILED ("TT1 ACTIVATED");
-                END TT1;
- 
-           BEGIN
- 
-                FAILED ("TT1 ACTIVATED - 2");
- 
-           END BLOCK2;
- 
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-      END BLOCK1;
- 
-      RESULT;
- 
- END C39008B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39008c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39008c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c39008c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c39008c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C39008C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PROGRAM_ERROR IS RAISED WHEN AN ATTEMPT IS MADE TO
- --     ACTIVATE A TASK BEFORE ITS BODY HAS BEEN ELABORATED.  CHECK THE
- --     CASE IN WHICH SEVERAL TASKS ARE TO BE ACTIVATED, AND ONLY SOME
- --     HAVE UNELABORATED BODIES; NO TASKS SHOULD BE ACTIVATED.
- 
- -- HISTORY:
- --     BCB 07/08/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C39008C IS
- 
- BEGIN
-      TEST ("C39008C", "CHECK THAT PROGRAM_ERROR IS RAISED WHEN AN " &
-                       "ATTEMPT IS MADE TO ACTIVATE A TASK BEFORE ITS " &
-                       "BODY HAS BEEN ELABORATED.  CHECK THE CASE IN " &
-                       "WHICH SEVERAL TASKS ARE TO BE ACTIVATED, AND " &
-                       "ONLY SOME HAVE UNELABORATED BODIES; NO TASKS " &
-                       "SHOULD BE ACTIVATED");
- 
-      BEGIN
-           DECLARE
-                TASK TYPE A;
- 
-                TASK TYPE B;
- 
-                TASK TYPE C;
- 
-                TASK TYPE D;
- 
-                PACKAGE P IS
-                     W : A;
-                     X : B;
-                     Y : C;
-                     Z : D;
-                END P;
- 
-                TASK BODY A IS
-                BEGIN
-                     FAILED ("TASK A ACTIVATED");
-                END A;
- 
-                TASK BODY D IS
-                BEGIN
-                     FAILED ("TASK D ACTIVATED");
-                END D;
- 
-                PACKAGE BODY P IS
-                END P;
- 
-                TASK BODY B IS
-                BEGIN
-                     FAILED ("TASK B ACTIVATED");
-                END B;
- 
-                TASK BODY C IS
-                BEGIN
-                     FAILED ("TASK C ACTIVATED");
-                END C;
-           BEGIN
-                FAILED ("PROGRAM_ERROR WAS NOT RAISED");
-           END;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN PROGRAM_ERROR WAS " &
-                        "RAISED");
-      END;
- 
-      RESULT;
- END C39008C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- C390A010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C390A011.AM.
- --
- -- TEST DESCRIPTION:
- --      See C390A011.AM.
- -- 
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F390A00.A
- --      => C390A010.A
- --         C390A011.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with F390A00;  -- Alert system abstraction.
- package C390A010 is
- 
- 
-    type Low_Alert_Type is new F390A00.Alert_Type with record
-       Level : Integer := 0;                             -- Record extension of
-    end record;                                          -- root tagged type.
- 
-    -- Inherits procedure Display from Alert_Type.
- 
-    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
-                                                         -- primitive subprog.
- 
-    function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
-      return Integer;                                    -- all derivatives.
- 
- 
- 
-    -- Declarations required for component Action_Officer;
- 
-    type Person_Enum is (Nobody,          Duty_Officer,
-                         Watch_Commander, Commanding_Officer);
- 
- 
-    type Medium_Alert_Type is new Low_Alert_Type with record
-       Action_Officer : Person_Enum := Nobody;           -- Record extension of
-    end record;                                          -- record extension.
- 
-    -- Inherits (inherited) procedure Display from Low_Alert_Type.
-    -- Inherits function Level_Of from Low_Alert_Type.
- 
-    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
-                                                         -- primitive subprog.
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum);
- 
- 
- end C390A010;
- 
- 
-      --==================================================================--
- 
- 
- package body C390A010 is
- 
-    use F390A00;  -- Alert system abstraction.
- 
- 
-    function Level_Of (LA : in Low_Alert_Type) return Integer is
-    begin
-       return (LA.Level + 1);
-    end Level_Of;
- 
- 
-    procedure Handle (LA : in out Low_Alert_Type) is
-    begin
-       Handle (Alert_Type (LA));          -- Call parent's op (type conversion).
-       LA.Level := Level_Of (LA);         -- Call newly declared operation.
-       LA.Display_On := Teletype;
-       Display (LA);                      -- Call inherited operation.
-    end Handle;
- 
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum) is
-    begin
-       MA.Action_Officer := To;
-    end Assign_Officer;
- 
- 
-    procedure Handle (MA : in out Medium_Alert_Type) is
-    begin
-       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
-       MA.Level := Level_Of (MA);         -- Call inherited operation.
-       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
-       MA.Display_On := Console;
-       Display (MA);                      -- Call twice-inherited operation.
-    end Handle;
- 
- 
- end C390A010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a011.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a011.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a011.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a011.am	Thu Jan  1 00:00:00 1970
***************
*** 1,218 ****
- -- C390A011.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a nonprivate tagged type declared in a package specification
- --      may be extended with a record extension in a different package
- --      specification, and that this record extension may in turn be extended
- --      by a record extension.
- --
- --      Check that each derivative inherits the user-defined primitive
- --      subprograms of its parent (including those that its parent inherited),
- --      that it may override these inherited primitive subprograms, and that it
- --      may also declare its own primitive subprograms.
- --
- --      Check that predefined equality operators are defined for the tagged
- --      type and its derivatives.
- --
- --      Check that type conversion is defined from a type extension to its
- --      parent, and that this parent itself may be a type extension.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type and two associated primitive subprograms
- --      in a package specification (foundation code).
- -- 
- --      Extend the root type with a record extension in a different package
- --      specification. Declare a new primitive subprogram for the extension,
- --      and override one of the two inherited subprograms. Within the
- --      overriding subprogram, utilize type conversion to call the parent's
- --      implementation of the same subprogram. Also within the overriding
- --      subprogram, call the new primitive subprogram and each inherited
- --      subprogram.
- --      
- --      Extend the extension with a record extension in the same package
- --      specification. Declare a new primitive subprogram for this second
- --      extension, and override one of the three inherited subprograms.
- --      Within the overriding subprogram, utilize type conversion to call the
- --      parent's implementation of the same subprogram. Also within the
- --      overriding subprogram, call the new primitive subprogram and each
- --      inherited subprogram.
- -- 
- --      In the main program, declare objects of the root tagged type
- --      and the two type extensions. For each object, call the overriding
- --      subprogram, and verify the correctness of the components by using
- --      aggregates and equality operators, or by checking the components
- --      directly.
- -- 
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F390A00.A
- --         C390A010.A
- --      => C390A011.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- 
- with F390A00;   -- Basic alert abstraction.
- with C390A010;  -- Extended alert abstraction.
- 
- use  F390A00;   -- Primitive operations of Alert_Type directly visible.
- 
- with Ada.Calendar;
- 
- procedure C390A011 is
-    use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
- begin
- 
-    Report.Test ("C390A01", "Primitive operation inheritance by type " &
-                 "extensions: all extensions declared in same package, " &
-                 "but a different package from that of root type");
- 
- 
-    ALERT_SUBTEST: -------------------------------------------------------------
- 
-       declare
-          Alarm : F390A00.Alert_Type;  -- Root tagged type.
-       begin
- 
-          -- Check "/=" operator availability. Aggregate with positional
-          -- associations:
-          if Alarm /= (Default_Time, Null_Device) then
-             Report.Failed ("Wrong initial values for Alert_Type");
-          end if;
- 
-          Handle (Alarm);
- 
-          -- Check "=" operator availability. Aggregate with named
-          -- associations:
-          if not (Alarm = (Arrival_Time => Alert_Time,
-                           Display_On   => Null_Device))
-          then
-             Report.Failed ("Wrong values for Alert_Type after Handle");
-          end if;
- 
-       end Alert_Subtest;
- 
- 
-    -- Check intermediate display counts:
- 
-    if F390A00.Display_Count_For (Null_Device) /= 1 or
-       F390A00.Display_Count_For (Teletype)    /= 0 or
-       F390A00.Display_Count_For (Console)     /= 0 or
-       F390A00.Display_Count_For (Big_Screen)  /= 0
-    then
-       Report.Failed ("Wrong display counts after Alert_Type");
-    end if;
- 
- 
-    LOW_ALERT_SUBTEST: ---------------------------------------------------------
- 
-       declare
-          Low_Alarm : C390A010.Low_Alert_Type;  -- Extension of tagged type.
-          use C390A010; -- Primitive operations of extension directly visible.
-       begin
- 
-          -- Check "=" operator availability. Aggregate with positional
-          -- associations:
-          if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
-             Report.Failed ("Wrong initial values for Low_Alert_Type");
-          end if;
- 
-          Handle (Low_Alarm);
- 
-          -- Check component availability:
-          if Low_Alarm.Arrival_Time /= Alert_Time or
-             Low_Alarm.Display_On   /= Teletype   or
-             Low_Alarm.Level        /= 1
-          then
-             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
-          end if;
- 
-       end Low_Alert_Subtest;
- 
- 
-    -- Check intermediate display counts:
- 
-    if F390A00.Display_Count_For /= (Null_Device => 2,
-                                     Teletype    => 1,
-                                     Console     => 0,
-                                     Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Low_Alert_Type");
-    end if;
- 
- 
-    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
- 
-       declare
-          Medium_Alarm : C390A010.Medium_Alert_Type; -- Extension of extension.
-          use C390A010; -- Primitive operations of extension directly visible.
-       begin
- 
-          -- Check component availability:
-          if Medium_Alarm.Level          /= 0            or
-             Medium_Alarm.Arrival_Time   /= Default_Time or
-             Medium_Alarm.Action_Officer /= Nobody       or
-             Medium_Alarm.Display_On     /= Null_Device
-          then
-             Report.Failed ("Wrong initial values for Medium_Alert_Type");
-          end if;
- 
-          Handle (Medium_Alarm);
- 
-          -- Check "/=" operator availability. Aggregate with named
-          -- associations:
-          if Medium_Alarm /= (Arrival_Time   => Alert_Time,
-                              Display_On     => Console,
-                              Level          => 2,
-                              Action_Officer => Duty_Officer)
-          then
-             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
-          end if;
- 
-       end Medium_Alert_Subtest;
- 
- 
-    -- Check final display counts:
- 
-    if F390A00.Display_Count_For /= (Null_Device => 3,
-                                     Teletype    => 2,
-                                     Console     => 1,
-                                     Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Medium_Alert_Type");
-    end if;
- 
- 
-    Report.Result;
- 
- end C390A011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C390A020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C390A022.AM.
- --
- -- TEST DESCRIPTION:
- --      See C390A022.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F390A00.A
- --      => C390A020.A
- --         C390A021.A
- --         C390A022.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with F390A00;  -- Alert system abstraction.
- package C390A020 is
- 
- 
-    type Low_Alert_Type is new F390A00.Alert_Type with record
-       Level : Integer := 0;                             -- Record extension of
-    end record;                                          -- root tagged type.
- 
-    -- Inherits procedure Display from Alert_Type.
- 
-    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
-                                                         -- primitive subprog.
- 
-    function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
-      return Integer;                                    -- all derivatives.
- 
- 
- end C390A020;
- 
- 
-      --==================================================================--
- 
- 
- package body C390A020 is
- 
-    use F390A00;  -- Alert system abstraction.
- 
- 
-    function Level_Of (LA : in Low_Alert_Type) return Integer is
-    begin
-       return (LA.Level + 1);
-    end Level_Of;
- 
- 
-    procedure Handle (LA : in out Low_Alert_Type) is
-    begin
-       Handle (Alert_Type (LA));   -- Call parent's oper. (type conversion).
-       LA.Level := Level_Of (LA);  -- Call newly declared operation.
-       LA.Display_On := Teletype;
-       Display (LA);               -- Call inherited operation.
-    end Handle;
- 
- 
- end C390A020;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a021.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a021.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a021.a	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- C390A021.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C390A022.AM.
- --
- -- TEST DESCRIPTION:
- --      See C390A022.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F390A00.A
- --         C390A020.A
- --      => C390A021.A
- --         C390A022.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with C390A020;  -- Extended alert abstraction.
- package C390A021 is
- 
- 
-    -- Declarations used by component Action_Officer;
- 
-    type Person_Enum is (Nobody,          Duty_Officer,
-                         Watch_Commander, Commanding_Officer);
- 
- 
-    type Medium_Alert_Type is new C390A020.Low_Alert_Type
-      with private;                                      -- Private extension of
-                                                         -- record extension.
- 
-    -- Inherits (inherited) procedure Display from Low_Alert_Type.
-    -- Inherits function Level_Of from Low_Alert_Type.
- 
-    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
-                                                         -- primitive subprog.
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum);
- 
- 
-    -- The following two functions are needed to verify the values of the
-    -- extension's private components.
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type)
-      return Boolean;
- 
-    function Bad_Final_Values (MA : in Medium_Alert_Type)
-      return Boolean;
- 
- 
- private
- 
-    type Medium_Alert_Type is new C390A020.Low_Alert_Type with record
-       Action_Officer : Person_Enum := Nobody;
-    end record;
- 
- end C390A021;
- 
- 
-      --==================================================================--
- 
- 
- with F390A00;  -- Basic alert abstraction.
- use  F390A00;
- package body C390A021 is
- 
-    use C390A020;  -- Extended alert abstraction.
- 
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum) is
-    begin
-       MA.Action_Officer := To;
-    end Assign_Officer;
- 
- 
-    procedure Handle (MA : in out Medium_Alert_Type) is
-    begin
-       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
-       MA.Level := Level_Of (MA);         -- Call inherited operation.
-       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
-       MA.Display_On := Console;
-       Display (MA);                      -- Call twice-inherited operation.
-    end Handle;
- 
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
-    begin
-       return (MA = (Arrival_Time   => Default_Time,      -- Check "=" operator
-                     Display_On     => Null_Device,       -- availability.
-                     Level          => 0,                 -- Aggregate with
-                     Action_Officer => Nobody));          -- named associations.
-    end Initial_Values_Okay;
- 
- 
-    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
-    begin
-       return (MA /= (Alert_Time, Console,                -- Check "/=" operator
-                      2         , Duty_Officer));         -- availability.
-    end Bad_Final_Values;                                 -- Aggregate with
-                                                          -- positional assoc.
- 
- end C390A021;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a022.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a022.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a022.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a022.am	Thu Jan  1 00:00:00 1970
***************
*** 1,179 ****
- -- C390A022.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a nonprivate tagged type declared in a package specification
- --      may be extended with a record extension in a different package
- --      specification, and that this record extension may in turn be extended
- --      by a private extension in a third package.
- --  
- --      Check that each derivative inherits the user-defined primitive
- --      subprograms of its parent (including those that its parent inherited),
- --      that it may override these inherited primitive subprograms, and that it
- --      may also declare its own primitive subprograms.
- --
- --      Check that predefined equality operators are defined for the tagged
- --      type and its derivatives.
- --
- --      Check that type conversion is defined from a type extension to its
- --      parent, and that this parent itself may be a type extension.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type and two associated primitive subprograms
- --      in a package specification (foundation code).
- -- 
- --      Extend the root type with a record extension in a different package
- --      specification. Declare a new primitive subprogram for the extension,
- --      and override one of the two inherited subprograms. Within the
- --      overriding subprogram, utilize type conversion to call the parent's
- --      implementation of the same subprogram. Also within the overriding
- --      subprogram, call the new primitive subprogram and each inherited
- --      subprogram.
- --      
- --      Extend the extension with a private extension in a third package
- --      specification. Declare a new primitive subprogram for this private
- --      extension, and override one of the three inherited subprograms.
- --      Within the overriding subprogram, utilize type conversion to call the
- --      parent's implementation of the same subprogram. Also within the
- --      overriding subprogram, call the new primitive subprogram and each
- --      inherited subprogram.
- -- 
- --      Also in the third package, declare two operations of the private
- --      extension which utilize aggregates and equality operators to verify
- --      the correctness of the components.
- --
- --      In the main program, declare objects of the two extended types.
- --      For each object, call the overriding subprogram, and verify the
- --      correctness of the components by using aggregates and equality
- --      operators, or by checking the components directly, or, for the private
- --      extension, by calling the verification operations declared in the
- --      third package.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F390A00.A
- --         C390A020.A
- --         C390A021.A
- --      => C390A022.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- 
- with F390A00;   -- Basic alert abstraction.
- with C390A020;  -- Extended alert abstraction.
- with C390A021;  -- Further extended alert abstraction.
- 
- use  F390A00;   -- Primitive operations of Alert_Type directly visible.
- 
- with Ada.Calendar;
- 
- procedure C390A022 is
-    use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
- begin
- 
-    Report.Test ("C390A02", "Primitive operation inheritance by type " &
-                 "extensions: all extensions declared in different " &
-                 "packages; second extension is private");
- 
- 
-    -- The case for type F390A00.Alert_Type is tested in C390A01.
-    -- That subtest is not repeated here.
- 
- 
-    LOW_ALERT_SUBTEST: ---------------------------------------------------------
- 
-       declare
-          Low_Alarm : C390A020.Low_Alert_Type;  -- Extension of tagged type.
-          use C390A020; -- Primitive operations of extension directly visible.
-       begin
- 
-          -- Check "=" operator availability. Aggregate with positional
-          -- associations:
-          if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
-             Report.Failed ("Wrong initial values for Low_Alert_Type");
-          end if;
- 
-          Handle (Low_Alarm);
- 
-          -- Check component availability:
-          if Low_Alarm.Arrival_Time /= Alert_Time or
-             Low_Alarm.Display_On   /= Teletype   or
-             Low_Alarm.Level        /= 1
-          then
-             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
-          end if;
-       end Low_Alert_Subtest;
- 
- 
-    -- Check intermediate display counts:
- 
-    if F390A00.Display_Count_For /= (Null_Device => 1,
-                                     Teletype    => 1,
-                                     Console     => 0,
-                                     Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Low_Alert_Type");
-    end if;
- 
- 
-    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
- 
-       declare
-          Medium_Alarm : C390A021.Medium_Alert_Type; -- Priv. ext. of extension.
-          use C390A021; -- Primitive operations of extension directly visible.
-       begin
-          if not C390A021.Initial_Values_Okay (Medium_Alarm) then
-             Report.Failed ("Wrong initial values for Medium_Alert_Type");
-          end if;
- 
-          Handle (Medium_Alarm);
- 
-          if C390A021.Bad_Final_Values (Medium_Alarm) then
-             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
-          end if;
-       end Medium_Alert_Subtest;
- 
- 
-    -- Check final display counts:
- 
-    if F390A00.Display_Count_For /= (Null_Device => 2,
-                                     Teletype    => 2,
-                                     Console     => 1,
-                                     Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Medium_Alert_Type");
-    end if;
- 
- 
-    Report.Result;
- 
- end C390A022;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a030.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a030.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a030.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a030.a	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- C390A030.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See C390A031.AM.
- --
- -- TEST DESCRIPTION:
- --      See C390A031.AM.
- -- 
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F390A00.A
- --      => C390A030.A
- --         C390A031.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with F390A00;  -- Alert system abstraction.
- package C390A030 is
- 
- 
-    type Low_Alert_Type is new F390A00.Alert_Type        -- Private extension of
-      with private;                                      -- root tagged type.
- 
-    -- Inherits procedure Display from Alert_Type.
- 
-    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
-                                                         -- primitive subprog.
- 
-    function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
-      return Integer;                                    -- all derivatives.
- 
- 
-    -- The following two functions are needed to verify the values of the
-    -- extension's private components.
- 
-    function Initial_Values_Okay (LA : in Low_Alert_Type)
-      return Boolean;
- 
-    function Bad_Final_Values (LA : in Low_Alert_Type)
-      return Boolean;
- 
- 
-    -- Declarations used by private extension component.
- 
-    type Person_Enum is (Nobody,          Duty_Officer,
-                         Watch_Commander, Commanding_Officer);
- 
- 
-    type Medium_Alert_Type is new Low_Alert_Type         -- Private extension of
-      with private;                                      -- private extension.
- 
-    -- Inherits (inherited) procedure Display from Low_Alert_Type.
-    -- Inherits function Level_Of from Low_Alert_Type.
- 
-    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
-                                                         -- primitive subprog.
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum);
- 
- 
-    -- The following two functions are needed to verify the values of the
-    -- extension's private components.
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type)
-      return Boolean;                                    -- Override parent's
-                                                         -- operation.
- 
-    function Bad_Final_Values (MA : in Medium_Alert_Type)
-      return Boolean;                                    -- Override parent's
-                                                         -- operation.
- 
- private
- 
-    type Low_Alert_Type is new F390A00.Alert_Type with record
-       Level : Integer := 0;
-    end record;
- 
- 
-    type Medium_Alert_Type is new Low_Alert_Type with record
-       Action_Officer : Person_Enum := Nobody;
-    end record;
- 
- end C390A030;
- 
- 
-      --==================================================================--
- 
- 
- package body C390A030 is
- 
-    use F390A00;  -- Alert system abstraction.
- 
- 
-    function Level_Of (LA : in Low_Alert_Type) return Integer is
-    begin
-       return (LA.Level + 1);
-    end Level_Of;
- 
- 
-    procedure Handle (LA : in out Low_Alert_Type) is
-    begin
-       Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
-       LA.Level := Level_Of (LA);  -- Call newly declared operation.
-       LA.Display_On := Teletype;
-       Display (LA);               -- Call inherited operation.
-    end Handle;
- 
- 
-    function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
-    begin
-       return (LA = (Arrival_Time   => Default_Time,      -- Check "=" operator
-                     Display_On     => Null_Device,       -- availability.
-                     Level          => 0));               -- Aggregate with
-    end Initial_Values_Okay;                              -- named associations.
- 
- 
-    function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
-    begin
-       return (LA /= (Alert_Time, Teletype, 1));          -- Check "/=" operator
-                                                          -- availability.
-    end Bad_Final_Values;                                 -- Aggregate with
-                                                          -- positional assoc.
- 
-    procedure Assign_Officer (MA : in out Medium_Alert_Type;
-                              To : in     Person_Enum) is
-    begin
-       MA.Action_Officer := To;
-    end Assign_Officer;
- 
- 
-    procedure Handle (MA : in out Medium_Alert_Type) is
-    begin
-       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
-       MA.Level := Level_Of (MA);         -- Call inherited operation.
-       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
-       MA.Display_On := Console;
-       Display (MA);                      -- Call twice-inherited operation.
-    end Handle;
- 
- 
-    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
-    begin
-       -- Call parent's operation (type conversion).
-       return (Initial_Values_Okay (Low_Alert_Type (MA)) and
-               MA.Action_Officer = Nobody);
-    end Initial_Values_Okay;
- 
- 
-    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
-    begin
-       return not (MA = (Arrival_Time   => Alert_Time,    -- Check "=" operator
-                         Display_On     => Console,       -- availability.
-                         Level          => 2,             -- Aggregate with
-                         Action_Officer => Duty_Officer));-- named associations.
-    end Bad_Final_Values;
- 
- 
- end C390A030;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a031.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a031.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c390a031.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c390a031.am	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- C390A031.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a nonprivate tagged type declared in a package specification
- --      may be extended with a private extension in a different package
- --      specification, and that this private extension may in turn be extended
- --      by a private extension.
- --
- --      Check that each derivative inherits the user-defined primitive
- --      subprograms of its parent (including those that its parent inherited),
- --      that it may override these inherited primitive subprograms, and that it
- --      may also declare its own primitive subprograms.
- --
- --      Check that predefined equality operators are defined for the tagged
- --      type and its derivatives.
- --
- --      Check that type conversion is defined from a type extension to its
- --      parent, and that this parent itself may be a type extension.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type and two associated primitive subprograms
- --      in a package specification (foundation code).
- -- 
- --      Extend the root type with a private extension in a different package
- --      specification. Declare a new primitive subprogram for the extension,
- --      and override one of the two inherited subprograms. Within the
- --      overriding subprogram, utilize type conversion to call the parent's
- --      implementation of the same subprogram. Also within the overriding
- --      subprogram, call the new primitive subprogram and each inherited
- --      subprogram. Declare operations of the private extension which utilize
- --      aggregates and equality operators to verify the correctness of the
- --      components.
- --      
- --      Extend the extension with a private extension in the same package
- --      specification. Declare a new primitive subprogram for this second
- --      extension, and override one of the three inherited subprograms.
- --      Within the overriding subprogram, utilize type conversion to call the
- --      parent's implementation of the same subprogram. Also within the
- --      overriding subprogram, call the new primitive subprogram and each
- --      inherited subprogram. Declare operations of the private extension
- --      which override the verification operations of its parent. Within
- --      these overriding operations, utilize type conversion to call the
- --      parent's implementations of the same operations.
- -- 
- --      In the main program, declare objects of the two extended types.
- --      For each object, call the overriding subprogram, and verify the
- --      correctness of the components by calling the verification operations
- --      declared in the second package.
- -- 
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         F390A00.A
- --         C390A030.A
- --      => C390A031.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- 
- with F390A00;  -- Basic alert abstraction.
- with C390A030; -- Extended alert abstraction.
- 
- use  F390A00;  -- Primitive operations of Alert_Type directly visible.
- 
- procedure C390A031 is
- begin
- 
-    Report.Test ("C390A03", "Primitive operation inheritance by type " &
-                 "extensions: all extensions are private and declared " &
-                 "in same package, but a different package from that " &
-                 "of root type");
- 
- 
-    -- The case for type F390A00.Alert_Type is tested in C390A01.
-    -- That subtest is not repeated here.
- 
- 
-    LOW_ALERT_SUBTEST: ---------------------------------------------------------
- 
-       declare
-          Low_Alarm : C390A030.Low_Alert_Type;  -- Priv. ext. of tagged type.
-          use C390A030; -- Primitive operations of extension directly visible.
-       begin
-          if not C390A030.Initial_Values_Okay (Low_Alarm) then
-             Report.Failed ("Wrong initial values for Low_Alert_Type");
-          end if;
- 
-          Handle (Low_Alarm);
- 
-          if C390A030.Bad_Final_Values (Low_Alarm) then
-             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
-          end if;
-       end Low_Alert_Subtest;
- 
- 
-    -- Check intermediate display counts:
- 
-    if F390A00.Display_Count_For /= (Null_Device => 1,
-                                     Teletype    => 1,
-                                     Console     => 0,
-                                     Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Low_Alert");
-    end if;
- 
- 
-    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
- 
-       declare
-          Medium_Alarm : C390A030.Medium_Alert_Type; -- Priv. ext. of extension.
-          use C390A030; -- Primitive operations of extension directly visible.
-       begin
-          if not C390A030.Initial_Values_Okay (Medium_Alarm) then
-             Report.Failed ("Wrong initial values for Medium_Alert_Type");
-          end if;
- 
-          Handle (Medium_Alarm);
- 
-          if C390A030.Bad_Final_Values (Medium_Alarm) then
-             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
-          end if;
-       end Medium_Alert_Subtest;
- 
- 
-    -- Check final display counts:
- 
-    if F390A00.Display_Count_For /= (Null_Device => 2,
-                                     Teletype    => 2,
-                                     Console     => 1,
-                                     Big_Screen  => 0)
-    then
-       Report.Failed ("Wrong display counts after Medium_Alert_Type");
-    end if;
- 
- 
-    Report.Result;
- 
- end C390A031;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c391001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c391001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c391001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c391001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,329 ****
- -- C391001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that structures nesting discriminated records as
- --      components in record extension are correctly supported.  Check
- --      for this using limited private structures.
- --      Check that record extensions inherit all the visible components
- --      of their ancestor types. 
- --      Check that discriminants are correctly inherited.
- --
- -- TEST DESCRIPTION:
- --      This test defines a textbook object, a serial number plaque.
- --      This object is used in each of several other structures modeled
- --      after those used in an existing antenna modeling software system.
- --      Record types discriminated and undiscriminated are nested to
- --      produce a layered design.  Some parametrization is programmatic;
- --      some parametrization is data-driven.
- --
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --      19 Apr 95   SAIC    Added "limited" to full type def of "Object"
- --
- --!
-  
-  package C391001_1 is 
-    type Object is tagged limited private;
-    -- Constructor operation
-    procedure Create( The_Plaque : in out Object );
-    -- Selector operations
-    function "="( Left_Plaque,Right_Plaque : Object ) return Boolean;
-    function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
-      return Boolean;
-    function Serial_Number( A_Plaque : Object ) return Natural;
-    Unserialized : exception;  -- Serial_Number called before Create
-    Reserialized : exception;  -- Create called twice
-  private
-    type Object is tagged limited record
-      Serial_Number : Natural := 0;
-    end record;
-  end C391001_1;
-  
-  package body C391001_1 is
-    Counter : Natural := 0;
-    procedure Create( The_Plaque : in out Object ) is
-    begin
-      if The_Plaque.Serial_Number = 0 then
-        Counter := Counter +1;
-        The_Plaque.Serial_Number := Counter;
-      else
-        raise Reserialized;
-      end if;
-    end Create;
-  
-    function "="( Left_Plaque,Right_Plaque : Object ) return Boolean is
-    begin
-      return (Left_Plaque.Serial_Number = Right_Plaque.Serial_Number)
-             and then -- two uninitialized plates are unequal
-               (Left_Plaque.Serial_Number /= 0);
-    end "=";
-  
-    function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
-      return Boolean is
-    begin
-      return (Left_Plaque.Serial_Number = Right_Natural);
-    end TC_Match;
-  
-    function Serial_Number( A_Plaque : Object ) return Natural is
-    begin
-      if A_Plaque.Serial_Number = 0 then
-        raise Unserialized;
-      end if;
-      return A_Plaque.Serial_Number;
-    end Serial_Number;
-  end C391001_1;
-  
-  with C391001_1;
-  package C391001_2 is -- package Boards is
-  
-    package Plaque renames C391001_1;
-  
-    type Modes is (Receiving, Transmitting, Standby);
-    type Link(Mode: Modes := Standby) is record
-      case Mode is
-        when Receiving    => TC_R : Integer := 100; 
-        when Transmitting => TC_T : Integer := 200;
-        when Standby      => TC_S : Integer := 300; -- TGA, TSA, SSA
-      end case;
-    end record;
-  
-    type Data_Formats is (S_Band, KU_Band, UHF);
-  
-  
-    type Transceiver(Band: Data_Formats) is tagged limited record
-      ID : Plaque.Object;
-      The_Link: Link;
-      case Band is
-        when S_Band  => TC_S_Band_Data  : Integer := 1; -- TGA, SSA
-        when KU_Band => TC_KU_Band_Data : Integer := 2; -- TSA
-        when UHF     => TC_UHF_Data     : Integer := 3;
-      end case;
-    end record;
-  end C391001_2;
-  
-  with C391001_1;
-  with C391001_2;
-  package C391001_3 is -- package Modules
-    package Plaque renames C391001_1;
-    package Boards renames C391001_2;
-    use type Boards.Modes;
-    use type Boards.Data_Formats;
-  
-    type Command_Formats is ( Set_Compression_Code,
-                              Set_Data_Rate,
-                              Set_Power_State );
-  
-    type Electronics_Module(EBand             : Boards.Data_Formats;
-                            The_Command_Format: Command_Formats)
-      is new Boards.Transceiver(EBand) with record
-        case The_Command_Format is
-          when Set_Compression_Code => TC_SCC : Integer := 10; -- SSA
-          when Set_Data_Rate        => TC_SDR : Integer := 20; -- TGA
-          when Set_Power_State      => TC_SPS : Integer := 30; -- TSA
-        end case;
-      end record;
-  end C391001_3;
-  
-  with Report;
-  with C391001_1;
-  with C391001_2;
-  with C391001_3;
-  procedure C391001 is
-    package Plaque  renames C391001_1;
-    package Boards  renames C391001_2;
-    package Modules renames C391001_3;
-    use type Boards.Modes;
-    use type Boards.Data_Formats;
-    use type Modules.Command_Formats;
-  
-    type Azimuth is range 0..359;
-  
-    type Ground_Antenna(The_Band          : Boards.Data_Formats;
-                        The_Command_Format: Modules.Command_Formats) is
-      record
-        ID          : Plaque.Object;
-        Electronics : Modules.Electronics_Module(The_Band,The_Command_Format);
-        Pointing    : Azimuth;
-      end record;
-  
-    type Space_Antenna(The_Band    : Boards.Data_Formats := Boards.KU_Band;
-                       The_Command : Modules.Command_Formats
-                                     := Modules.Set_Power_State)
-    is
-      record
-        ID          : Plaque.Object;
-        Electronics : Modules.Electronics_Module(The_Band,The_Command);
-      end record;
-  
-    The_Ground_Antenna     : Ground_Antenna (Boards.S_Band,
-                                             Modules.Set_Data_Rate);
-    The_Space_Antenna      : Space_Antenna;
-    Space_Station_Antenna  : Space_Antenna  (Boards.S_Band,
-                                             Modules.Set_Compression_Code);
-  
-  
-    procedure Validate( Condition : Boolean; Message: String ) is
-    begin
-      if not Condition then
-        Report.Failed("Failed " & Message );
-      end if;
-    end Validate;
-  
-  begin
-    Report.Test("C391001", "Check nested tagged discriminated "
-                         & "record structures");
-  
-    Plaque.Create( The_Ground_Antenna.ID );               -- 1
-    Plaque.Create( The_Ground_Antenna.Electronics.ID );   -- 2
-    Plaque.Create( The_Space_Antenna.ID );                -- 3
-    Plaque.Create( The_Space_Antenna.Electronics.ID );    -- 4
-    Plaque.Create( Space_Station_Antenna.ID );            -- 5
-    Plaque.Create( Space_Station_Antenna.Electronics.ID );-- 6
-  
-    The_Ground_Antenna.Pointing := 180;
-    Validate( The_Ground_Antenna.The_Band = Boards.S_Band, "TGA discr 1" );
-    Validate( The_Ground_Antenna.The_Command_Format = Modules.Set_Data_Rate,
-              "TGA discr 2" );
-    Validate( Plaque.TC_Match(The_Ground_Antenna.ID,1), "TGA comp 1" );
-    Validate( The_Ground_Antenna.Electronics.EBand = Boards.S_Band,
-              "TGA comp 2.discr 1" );
-    Validate( The_Ground_Antenna.Electronics.The_Command_Format
-              = Modules.Set_Data_Rate, "TGA comp 2.discr 2" );
-    Validate( The_Ground_Antenna.Electronics.TC_SDR = 20,
-              "TGA comp 2.1" );
-    Validate( Plaque.TC_Match( The_Ground_Antenna.Electronics.ID, 2 ),
-              "TGA comp 2.inher.1" );
-    Validate( The_Ground_Antenna.Electronics.The_Link.Mode = Boards.Standby,
-              "TGA comp 2.inher.2.discr" );
-    Validate( The_Ground_Antenna.Electronics.The_Link.TC_S = 300,
-              "TGA comp 2.inher.2.1" );
-    Validate( The_Ground_Antenna.Electronics.TC_S_Band_Data = 1,
-              "TGA comp 2.inher.3" );
-    Validate( The_Ground_Antenna.Pointing = 180, "TGA comp 3" );
-  
-    Validate( The_Space_Antenna.The_Band = Boards.KU_Band, "TSA discr 1");
-    Validate( The_Space_Antenna.The_Command = Modules.Set_Power_State,
-              "TSA discr 2");
-    Validate( Plaque.TC_Match(The_Space_Antenna.ID,3),
-              "TSA comp 1");
-    Validate( The_Space_Antenna.Electronics.EBand = Boards.KU_Band,
-              "TSA comp 2.discr 1");
-    Validate( The_Space_Antenna.Electronics.The_Command_Format
-              = Modules.Set_Power_State,  "TSA comp 2.discr 2");
-    Validate( Plaque.TC_Match(The_Space_Antenna.Electronics.ID,4),
-              "TSA comp 2.inher.1");
-    Validate( The_Space_Antenna.Electronics.The_Link.Mode = Boards.Standby,
-              "TSA comp 2.inher.2.discr");
-    Validate( The_Space_Antenna.Electronics.The_Link.TC_S = 300,
-              "TSA comp 2.inher.2.1");
-    Validate( The_Space_Antenna.Electronics.TC_KU_Band_Data = 2,
-              "TSA comp 2.inher.3");
-    Validate( The_Space_Antenna.Electronics.TC_SPS = 30,
-              "TSA comp 2.1");
-  
-    Validate( Space_Station_Antenna.The_Band = Boards.S_Band, "SSA discr 1");
-    Validate( Space_Station_Antenna.The_Command = Modules.Set_Compression_Code,
-              "SSA discr 2");
-    Validate( Plaque.TC_Match(Space_Station_Antenna.ID,5),
-              "SSA comp 1");
-    Validate( Space_Station_Antenna.Electronics.EBand = Boards.S_Band,
-              "SSA comp 2.discr 1");
-    Validate( Space_Station_Antenna.Electronics.The_Command_Format
-              = Modules.Set_Compression_Code,  "SSA comp 2.discr 2");
-    Validate( Plaque.TC_Match(Space_Station_Antenna.Electronics.ID,6),
-              "SSA comp 2.inher.1");
-    Validate( Space_Station_Antenna.Electronics.The_Link.Mode = Boards.Standby,
-              "SSA comp 2.inher.2.discr");
-    Validate( Space_Station_Antenna.Electronics.The_Link.TC_S = 300,
-              "SSA comp 2.inher.2.1");
-    Validate( Space_Station_Antenna.Electronics.TC_S_Band_Data = 1,
-              "SSA comp 2.inher.3");
-    Validate( Space_Station_Antenna.Electronics.TC_SCC = 10,
-              "SSA comp 2.1");
-  
-    The_Ground_Antenna.Electronics.TC_SDR         := 1001;
-    The_Ground_Antenna.Electronics.The_Link       :=
- (Boards.Transmitting,2001);
-    The_Ground_Antenna.Electronics.TC_S_Band_Data := 3001;
-    The_Ground_Antenna.Pointing                   :=   41;
-  
-    The_Space_Antenna.Electronics.The_Link        := (Boards.Receiving,1010);
-    The_Space_Antenna.Electronics.TC_KU_Band_Data := 2020;
-    The_Space_Antenna.Electronics.TC_SPS          := 3030;
-  
-    Space_Station_Antenna.Electronics.The_Link
-      := The_Space_Antenna.Electronics.The_Link;
-    Space_Station_Antenna.Electronics.The_Link.TC_R  := 111;
-    Space_Station_Antenna.Electronics.TC_S_Band_Data := 222;
-    Space_Station_Antenna.Electronics.TC_SCC         := 333;
-  
-  ----------------------------------------------------------------------
-    begin -- should fail discriminant check
-      The_Ground_Antenna.Electronics.TC_SCC := 909;
-      Report.Failed("Discriminant check, no exception");
-    exception
-      when Constraint_Error => null;
-      when others =>
-           Report.Failed("Discriminant check, wrong exception");
-    end;
-  
-    Validate( The_Ground_Antenna.Electronics.TC_SDR         = 1001,
-              "assigned value 1");
-    Validate( The_Ground_Antenna.Electronics.The_Link.Mode
-                                             = Boards.Transmitting,
-              "assigned value 2.1");
-    Validate( The_Ground_Antenna.Electronics.The_Link.TC_T  = 2001,
-              "assigned value 2.2");
-    Validate( The_Ground_Antenna.Electronics.TC_S_Band_Data = 3001,
-              "assigned value 3");
-    Validate( The_Ground_Antenna.Pointing                   =   41,
-              "assigned value 4");
-  
-    Validate( The_Space_Antenna.Electronics.The_Link.Mode   = Boards.Receiving,
-              "assigned value 5.1");
-    Validate( The_Space_Antenna.Electronics.The_Link.TC_R   = 1010,
-              "assigned value 5.2");
-    Validate( The_Space_Antenna.Electronics.TC_KU_Band_Data = 2020,
-              "assigned value 6");
-    Validate( The_Space_Antenna.Electronics.TC_SPS          = 3030,
-              "assigned value 7");
-  
-    Validate( Space_Station_Antenna.Electronics.The_Link.Mode
-                                                  = Boards.Receiving,
-              "assigned value 8.1");
-    Validate( Space_Station_Antenna.Electronics.The_Link.TC_R  = 111,
-              "assigned value 8.2");
-    Validate( Space_Station_Antenna.Electronics.TC_S_Band_Data = 222,
-              "assigned value 9");
-    Validate( Space_Station_Antenna.Electronics.TC_SCC         = 333,
-              "assigned value 10");
-  
-    Report.Result;
-  
- end C391001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c391002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c391002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c391002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c391002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,493 ****
- -- C391002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that structures nesting discriminated records as
- --      components in record extension are correctly supported.
- --      Check that record extensions inherit all the visible components
- --      of their ancestor types.
- --      Check that discriminants are correctly inherited.
- --
- -- TEST DESCRIPTION:
- --      This test defines a simple class hierarchy, where the final
- --      derivations exercise the different possible "permissions" available
- --      to a designer.  Extension aggregates for discriminated types are used
- --      to set values of these final types.  The key difference between
- --      this test and C391001 is that the types are visible, and allow the
- --      creation of complex discriminated extension aggregates.  Another
- --      layer of derivation is present to more robustly check that the
- --      inheritance is correctly supported.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Dec 94   SAIC    Removed offending parenthesis in aggregate
- --                          extensions, corrected typo: TC_MC SB TC_PC,
- --                          corrected visibility errors for literals,
- --                          added qualification for aggregate expressions
- --                          used in extension aggregates, corrected parameter
- --                          order in call to Communications.Creator
- --     01 MAY 95    SAIC    Removed "limited" from the definition of Mil_Comm
- --     14 OCT 95    SAIC    Fixed some value bugs for ACVC 2.0.1
- --     04 MAR 96    SAIC    Altered 3 overambitious extension aggregates
- --     11 APR 96    SAIC    Updated documentation for 2.1
- --     27 FEB 97    PWB.CTA Deleted extra (illegal) component association
- --!
- 
- ----------------------------------------------------------------- C391002_1
- 
- package C391002_1 is 
- 
-   type Object is tagged private;  
- 
-   -- Constructor operation
-   procedure Create( The_Plaque : in out Object );
- 
-   -- Selector operations
-   function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
-     return Boolean;
- 
-   function Serial_Number( A_Plaque : Object ) return Natural;
- 
-   Unserialized : exception;  -- Serial_Number called before Create
-   Reserialized : exception;  -- Create called twice
- 
- private
-   type Object is tagged record
-     Serial_Number : Natural := 0;
-   end record;
- end C391002_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C391002_1 is
- 
-   Counter : Natural := 0;
- 
-   procedure Create( The_Plaque : in out Object ) is
-   begin
-     if The_Plaque.Serial_Number = 0 then
-       Counter := Counter +1;
-       The_Plaque.Serial_Number := Counter;
-     else
-       raise Reserialized;
-     end if;
-   end Create;
- 
-   function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
-     return Boolean is
-   begin
-     return (Left_Plaque.Serial_Number = Right_Natural);
-   end TC_Match;
- 
-   function Serial_Number( A_Plaque : Object ) return Natural is
-   begin
-     if A_Plaque.Serial_Number = 0 then
-       raise Unserialized;
-     end if;
-     return A_Plaque.Serial_Number;
-   end Serial_Number;
- end C391002_1;
- 
- ----------------------------------------------------------------- C391002_2
- 
- with C391002_1;
- package C391002_2 is -- package Boards is
- 
-   package Plaque renames C391002_1;
- 
-   type Modes is (Receiving, Transmitting, Standby);
-   type Link(Mode: Modes := Standby) is record
-     case Mode is
-       when Receiving    => TC_R : Integer := 100; 
-       when Transmitting => TC_T : Integer := 200;
-       when Standby      => TC_S : Integer := 300; -- TGA, TSA, SSA
-     end case;
-   end record;
- 
-   type Data_Formats is (S_Band, KU_Band, UHF);
- 
-   type Transceiver(Band: Data_Formats) is tagged record
-     ID : Plaque.Object;
-     The_Link: Link;
-     case Band is
-       when S_Band  => TC_S_Band_Data  : Integer := 1; -- TGA, SSA, Milnet
-       when KU_Band => TC_KU_Band_Data : Integer := 2; -- TSA, Usenet
-       when UHF     => TC_UHF_Data     : Integer := 3; -- Gossip
-     end case;
-   end record;
- end C391002_2;
- 
- ----------------------------------------------------------------- C391002_3
- 
- with C391002_1;
- with C391002_2;
- package C391002_3 is -- package Modules
- 
-   package Plaque renames C391002_1;
-   package Boards renames C391002_2;
-   use type Boards.Modes;
-   use type Boards.Data_Formats;
- 
-   type Command_Formats is ( Set_Compression_Code,
-                             Set_Data_Rate,
-                             Set_Power_State );
- 
-   type Electronics_Module(EBand       : Boards.Data_Formats;
-                           The_Command : Command_Formats)
-     is new Boards.Transceiver(EBand) with record
-       case The_Command is
-         when Set_Compression_Code => TC_SCC : Integer := 10; -- SSA, Gossip
-         when Set_Data_Rate        => TC_SDR : Integer := 20; -- TGA, Usenet
-         when Set_Power_State      => TC_SPS : Integer := 30; -- TSA, Milnet
-       end case;
-     end record;
- end C391002_3;
- 
- ----------------------------------------------------------------- C391002_4
- 
- with C391002_3;
- package C391002_4 is -- Communications
-   package Modules renames C391002_3;
- 
-   type Public_Comm is new Modules.Electronics_Module with
-     record
-       TC_VC : Integer;
-     end record;
- 
-   type Private_Comm is new Modules.Electronics_Module with private;
- 
-   type Mil_Comm is new Modules.Electronics_Module with private;
- 
-   procedure Creator( Plugs : in Modules.Electronics_Module;
-                      Gives : out Mil_Comm);
- 
-   function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
-             return Private_Comm;
- 
-   procedure Setup( It : in out Public_Comm;  Value : in Integer );
-   procedure Setup( It : in out Private_Comm; Value : in Integer );
-   procedure Setup( It : in out Mil_Comm;     Value : in Integer );
- 
-   function  Selector( It : Public_Comm )  return Integer;
-   function  Selector( It : Private_Comm ) return Integer;
-   function  Selector( It : Mil_Comm )     return Integer;
- 
- private
-   type Private_Comm is new Modules.Electronics_Module with
-     record
-       TC_PC : Integer;
-     end record;
- 
-   type Mil_Comm is new Modules.Electronics_Module with 
-     record
-       TC_MC : Integer;
-     end record;
- end C391002_4; -- Communications
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body C391002_4 is -- Communications
- 
-   procedure Creator( Plugs : in Modules.Electronics_Module;
-                      Gives : out Mil_Comm) is
-   begin
-     Gives := ( Plugs with TC_MC => -1 );
-   end Creator;
- 
-   function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
-             return Private_Comm is
-   begin
-     return ( Plugs with TC_PC => Key );
-   end Creator;
- 
-   procedure Setup( It : in out Public_Comm; Value : in Integer ) is
-   begin
-     It.TC_VC := Value;
-     TCTouch.Assert( Value = 1, "Public_Comm");
-   end Setup;
- 
-   procedure Setup( It : in out Private_Comm; Value : in Integer ) is
-   begin
-     It.TC_PC := Value;
-     TCTouch.Assert( Value = 2, "Private_Comm");
-   end Setup;
- 
-   procedure Setup( It : in out Mil_Comm; Value : in Integer ) is
-   begin
-     It.TC_MC := Value;
-     TCTouch.Assert( Value = 3, "Private_Comm");
-   end Setup;
- 
-   function  Selector( It : Public_Comm )  return Integer is
-   begin
-     return It.TC_VC;
-   end Selector;
- 
-   function  Selector( It : Private_Comm ) return Integer is
-   begin
-     return It.TC_PC;
-   end Selector;
- 
-   function  Selector( It : Mil_Comm )     return Integer is
-   begin
-     return It.TC_MC;
-   end Selector;
- 
- end C391002_4; -- Communications
- 
- ------------------------------------------------------------------- C391002
- 
- with Report;
- with TCTouch;
- with C391002_1;
- with C391002_2;
- with C391002_3;
- with C391002_4;
- procedure C391002 is
- 
-   package Plaque  renames C391002_1;
-   package Boards  renames C391002_2;
-   package Modules renames C391002_3;
-   package Communications renames C391002_4;
- 
-   procedure Assert( Condition: Boolean; Message: String )
-     renames TCTouch.Assert;
- 
-   use type Boards.Modes;
-   use type Boards.Data_Formats;
-   use type Modules.Command_Formats;
- 
-   type Azimuth is range 0..359;
- 
-   type Ground_Antenna(The_Band    : Boards.Data_Formats;
-                       The_Command : Modules.Command_Formats) is
-     record
-       ID          : Plaque.Object;
-       Electronics : Modules.Electronics_Module(The_Band,The_Command);
-       Pointing    : Azimuth;
-     end record;
- 
-   type Space_Antenna(The_Band    : Boards.Data_Formats    := Boards.KU_Band;
-                      The_Command : Modules.Command_Formats
-                                    := Modules.Set_Power_State)
-   is
-     record
-       ID          : Plaque.Object;
-       Electronics : Modules.Electronics_Module(The_Band,The_Command);
-     end record;
- 
-   The_Ground_Antenna     : Ground_Antenna (Boards.S_Band,
-                                            Modules.Set_Data_Rate);
-   The_Space_Antenna      : Space_Antenna;
-   Space_Station_Antenna  : Space_Antenna  (Boards.UHF,
-                                            Modules.Set_Compression_Code);
- 
-   Gossip : Communications.Public_Comm  (Boards.UHF,
-                                         Modules.Set_Compression_Code);
-   Usenet : Communications.Private_Comm (Boards.KU_Band,
-                                         Modules.Set_Data_Rate);
-   Milnet : Communications.Mil_Comm     (Boards.S_Band,
-                                         Modules.Set_Power_State);
- 
- 
- begin
- 
-   Report.Test("C391002", "Check nested tagged discriminated"
-                        & " record structures");
- 
-   Plaque.Create( The_Ground_Antenna.ID );               -- 1
-   Plaque.Create( The_Ground_Antenna.Electronics.ID );   -- 2
-   Plaque.Create( The_Space_Antenna.ID );                -- 3
-   Plaque.Create( The_Space_Antenna.Electronics.ID );    -- 4
-   Plaque.Create( Space_Station_Antenna.ID );            -- 5
-   Plaque.Create( Space_Station_Antenna.Electronics.ID );-- 6
- 
-   The_Ground_Antenna := ( The_Band    => Boards.S_Band,
-                           The_Command => Modules.Set_Data_Rate,
-                           ID          => The_Ground_Antenna.ID,
-                           Electronics =>
-                           ( Boards.Transceiver'(
-                               Band     => Boards.S_Band,
-                               ID       => The_Ground_Antenna.Electronics.ID,
-                               The_Link => ( Mode => Boards.Transmitting,
-                                             TC_T => 222 ),
-                               TC_S_Band_Data => 8 )
-                             with   EBand       => Boards.S_Band,
-                                    The_Command => Modules.Set_Data_Rate,
-                                    TC_SDR      => 11 ),
-                           Pointing    => 270 );
- 
-   The_Space_Antenna := ( The_Band    => Boards.S_Band,
-                          The_Command => Modules.Set_Data_Rate,
-                          ID          => The_Space_Antenna.ID,
-                          Electronics =>
-                          ( Boards.Transceiver'(
-                              Band     => Boards.S_Band,
-                              ID       => The_Space_Antenna.Electronics.ID,
-                              The_Link => ( Mode => Boards.Transmitting,
-                                            TC_T => 456 ),
-                              TC_S_Band_Data => 88 )
-                            with
-                                EBand       => Boards.S_Band,
-                                The_Command => Modules.Set_Data_Rate,
-                                TC_SDR      => 42
-                         ) );
- 
-   Space_Station_Antenna := ( Boards.UHF, Modules.Set_Compression_Code,
-                              Space_Station_Antenna.ID,
-                              ( Boards.Transceiver'(
-                                  Boards.UHF,
-                                  Space_Station_Antenna.Electronics.ID,
-                                  ( Boards.Transmitting, 202 ),
-                                  42 )
-                                  with Boards.UHF, 
-                                       Modules.Set_Compression_Code,
-                                       TC_SCC => 101
-                            ) );
- 
-   Assert( The_Ground_Antenna.The_Band = Boards.S_Band, "TGA disc 1" );
-   Assert( The_Ground_Antenna.The_Command = Modules.Set_Data_Rate,
-             "TGA disc 2" );
-   Assert( Plaque.TC_Match(The_Ground_Antenna.ID,1), "TGA comp 3" );
-   Assert( The_Ground_Antenna.Electronics.EBand = Boards.S_Band,
-             "TGA comp 2.disc 1" );
-   Assert( The_Ground_Antenna.Electronics.The_Command
-              = Modules.Set_Data_Rate,
-             "TGA comp 2.disc 2" );
-   Assert( The_Ground_Antenna.Electronics.TC_SDR = 11,
-             "TGA comp 2.1" );
-   Assert( Plaque.TC_Match( The_Ground_Antenna.Electronics.ID, 2 ),
-             "TGA comp 2.inher.1" );
-   Assert( The_Ground_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
-             "TGA comp 2.inher.2.disc" );
-   Assert( The_Ground_Antenna.Electronics.The_Link.TC_T = 222,
-             "TGA comp 2.inher.2.1" );
-   Assert( The_Ground_Antenna.Electronics.TC_S_Band_Data = 8,
-             "TGA comp 2.inher.3" );
-   Assert( The_Ground_Antenna.Pointing = 270, "TGA comp 3" );
- 
-   Assert( The_Space_Antenna.The_Band = Boards.S_Band, "TSA disc 1");
-   Assert( The_Space_Antenna.The_Command = Modules.Set_Data_Rate,
-             "TSA disc 2");
-   Assert( Plaque.TC_Match(The_Space_Antenna.ID,3),
-             "TSA comp 1");
-   Assert( The_Space_Antenna.Electronics.EBand = Boards.S_Band,
-             "TSA comp 2.disc 1");
-   Assert( The_Space_Antenna.Electronics.The_Command = Modules.Set_Data_Rate,
-             "TSA comp 2.disc 2");
-   Assert( The_Space_Antenna.Electronics.TC_SDR = 42,
-             "TSA comp 2.1");
-   Assert( Plaque.TC_Match(The_Space_Antenna.Electronics.ID,4),
-             "TSA comp 2.inher.1");
-   Assert( The_Space_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
-             "TSA comp 2.inher.2.disc");
-   Assert( The_Space_Antenna.Electronics.The_Link.TC_T = 456,
-             "TSA comp 2.inher.2.1");
-   Assert( The_Space_Antenna.Electronics.TC_S_Band_Data = 88,
-             "TSA comp 2.inher.3");
- 
-   Assert( Space_Station_Antenna.The_Band = Boards.UHF, "SSA disc 1");
-   Assert( Space_Station_Antenna.The_Command = Modules.Set_Compression_Code,
-             "SSA disc 2");
-   Assert( Plaque.TC_Match(Space_Station_Antenna.ID,5),
-             "SSA comp 1");
-   Assert( Space_Station_Antenna.Electronics.EBand = Boards.UHF,
-             "SSA comp 2.disc 1");
-   Assert( Space_Station_Antenna.Electronics.The_Command
-              = Modules.Set_Compression_Code,
-             "SSA comp 2.disc 2");
-   Assert( Space_Station_Antenna.Electronics.TC_SCC = 101,
-             "SSA comp 2.1");
-   Assert( Plaque.TC_Match(Space_Station_Antenna.Electronics.ID,6),
-             "SSA comp 2.inher.1");
-   Assert( Space_Station_Antenna.Electronics.The_Link.Mode
-             = Boards.Transmitting,
-             "SSA comp 2.inher.2.disc");
-   Assert( Space_Station_Antenna.Electronics.The_Link.TC_T = 202,
-             "SSA comp 2.inher.2.1");
-   Assert( Space_Station_Antenna.Electronics.TC_UHF_Data = 42,
-             "SSA comp 2.inher.3");
- 
- 
-   The_Space_Antenna := ( The_Band    => Boards.S_Band,
-                          The_Command => Modules.Set_Power_State,
-                          ID          => The_Space_Antenna.ID,
-                          Electronics =>
-                          ( Boards.Transceiver'(
-                              Band     => Boards.S_Band,
-                              ID       => The_Space_Antenna.Electronics.ID,
-                              The_Link => ( Mode => Boards.Transmitting,
-                                            TC_T => 1 ),
-                              TC_S_Band_Data => 5 )
-                            with
-                                EBand       => Boards.S_Band,
-                                The_Command => Modules.Set_Power_State,
-                                TC_SPS      => 101
-                         ) );
- 
-   Communications.Creator( The_Space_Antenna.Electronics, Milnet );
-   Assert( Communications.Selector( Milnet ) = -1, "Milnet creator" );
- 
-   Usenet := Communications.Creator( -2, 
-                      ( Boards.Transceiver'(
-                          Band        => Boards.KU_Band,
-                          ID          => The_Space_Antenna.Electronics.ID,
-                          The_Link    => ( Boards.Transmitting, TC_T => 101 ),
-                          TC_KU_Band_Data => 395 )
-                     with Boards.KU_Band, Modules.Set_Data_Rate, 66 ) );
- 
-   Assert( Communications.Selector( Usenet ) = -2, "Usenet creator" );
- 
-   Gossip := ( 
-     Modules.Electronics_Module'(
-       Boards.Transceiver'(
-          Band        => Boards.UHF,
-          ID          => The_Space_Antenna.Electronics.ID,
-          The_Link    => ( Boards.Transmitting, TC_T => 101 ),
-          TC_UHF_Data => 395 )
-        with 
-          Boards.UHF, Modules.Set_Compression_Code, 66 )
-      with
-        TC_VC => -3 ); 
- 
-   Assert( Gossip.TC_VC = -3, "Gossip Aggregate" );
- 
-   Communications.Setup( Gossip, 1 ); -- (Boards.UHF,
-                                      -- Modules.Set_Compression_Code)
-   Communications.Setup( Usenet, 2 ); -- (Boards.KU_Band,
-                                      -- Modules.Set_Data_Rate)
-   Communications.Setup( Milnet, 3 ); -- (Boards.S_Band,
-                                      -- Modules.Set_Power_State)
- 
-   Assert( Communications.Selector( Gossip ) = 1, "Gossip Setup" );
-   Assert( Communications.Selector( Usenet ) = 2, "Usenet Setup" );
-   Assert( Communications.Selector( Milnet ) = 3, "Milnet Setup" );
- 
-   Report.Result;
- 
- end C391002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,349 ****
- -- C392002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the use of a class-wide formal parameter allows for the 
- --      proper dispatching of objects to the appropriate implementation of 
- --      a primitive operation.  Check this in the case where the root tagged
- --      type is defined in a generic package, and the type derived from it is
- --      defined in that same generic package.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type, and some associated primitive operations.
- --      Extend the root type, and override one or more primitive operations, 
- --      inheriting the other primitive operations from the root type.
- --      Derive from the extended type, again overriding some primitive
- --      operations and inheriting others (including some that the parent 
- --      inherited).
- --      Define a subprogram with a class-wide parameter, inside of which is a 
- --      call on a dispatching primitive operation.  These primitive operations
- --      modify global variables (the class-wide parameter has mode IN).
- --     
- --  The following hierarchy of tagged types and primitive operations is 
- --  utilized in this test:
- --
- --
- --    type Vehicle (root)
- --            |
- --    type Motorcycle
- --            |
- --            | Operations
- --            |   Engine_Size
- --            |   Catalytic_Converter
- --            |   Emissions_Produced
- --            |
- --    type Automobile (extended from Motorcycle)
- --            |
- --            | Operations
- --            |   (Engine_Size)       (inherited)
- --            |   Catalytic_Converter (overridden)
- --            |   Emissions_Produced  (overridden)
- --            |
- --    type Truck (extended from Automobile)
- --            |
- --            | Operations
- --            |   (Engine_Size)         (inherited twice - Motorcycle)
- --            |   (Catalytic_Converter) (inherited - Automobile)
- --            |   Emissions_Produced    (overridden)
- -- 
- --
- -- In this test, we are concerned with the following selection of dispatching
- -- calls, accomplished with the use of a Vehicle'Class IN procedure 
- -- parameter :
- --
- --                       \ Type
- --               Prim. Op \   Motorcycle      Automobile        Truck
- --                         \------------------------------------------------ 
- --             Engine_Size |      X               X               X
- --     Catalytic_Converter |      X               X               X
- --     Emissions_Produced  |      X               X               X
- --
- --
- --
- -- The location of the declaration and derivation of the root and extended
- -- types will be varied over a series of tests.  Locations of declaration
- -- and derivation for a particular test are marked with an asterisk (*).
- --
- -- Root type:
- --       
- --       Declared in package.                                          
- --    *  Declared in generic package.
- --
- -- Extended types:
- --
- --    *  Derived in parent location.
- --       Derived in a nested package.
- --       Derived in a nested subprogram.
- --       Derived in a nested generic package.
- --       Derived in a separate package.
- --       Derived in a separate visible child package.
- --       Derived in a separate private child package.
- --
- -- Primitive Operations:
- --
- --    *  Procedures with same parameter profile.
- --       Procedures with different parameter profile.
- --    *  Functions with same parameter profile.
- --       Functions with different parameter profile.
- --    *  Mixture of Procedures and Functions.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      09 May 96   SAIC    Made single-file for 2.1
- --
- --!
- 
- ------------------------------------------------------------------- C392002_0
- 
- -- Declare the root and extended types, along with their primitive
- -- operations in a generic package.
- 
- generic
- 
-    type Cubic_Inches     is range <>;
-    type Emission_Measure is digits <>;
-    Emissions_per_Engine_Cubic_Inch : Emission_Measure;
- 
- package C392002_0 is       -- package Vehicle_Simulation
- 
-    --
-    -- Equipment types and their primitive operations.
-    --
- 
-    -- Root type.
- 
-    type Vehicle is abstract tagged 
-       record 
-          Weight : Integer;
-          Wheels : Positive;
-       end record;
- 
-    -- Abstract operations of type Vehicle.
-    function Engine_Size         (V : in Vehicle) return Cubic_Inches
-             is abstract;
-    function Catalytic_Converter (V : in Vehicle) return Boolean
-             is abstract;
-    function Emissions_Produced  (V : in Vehicle) return Emission_Measure
-             is abstract;
- 
-    --
- 
-    type Motorcycle is new Vehicle with
-       record
-          Size_Of_Engine : Cubic_Inches;
-       end record;
- 
-    -- Primitive operations of type Motorcycle.
-    function Engine_Size         (V : in Motorcycle) return Cubic_Inches;
-    function Catalytic_Converter (V : in Motorcycle) return Boolean;
-    function Emissions_Produced  (V : in Motorcycle) return Emission_Measure;
- 
-    --
-                           
-    type Automobile is new Motorcycle with
-       record
-          Passenger_Capacity : Integer;
-       end record;
- 
-    -- Function Engine_Size inherited from parent (Motorcycle).
-    -- Primitive operations (Overridden).
-    function Catalytic_Converter (V : in Automobile) return Boolean;
-    function Emissions_Produced  (V : in Automobile) return Emission_Measure;
-                           
-    --
- 
-    type Truck is new Automobile with
-       record
-          Hauling_Capacity : Natural;
-       end record;
- 
-    -- Function Engine_Size inherited twice.
-    -- Function Catalytic_Converter inherited from parent (Automobile).
-    -- Primitive operation (Overridden).
-    function Emissions_Produced  (V : in Truck) return Emission_Measure;
- 
- end C392002_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body c392002_0 is
- 
-    --
-    -- Primitive operations for Motorcycle.
-    --
- 
-    function Engine_Size         (V : in Motorcycle) return Cubic_Inches is
-    begin
-       return (V.Size_Of_Engine);
-    end Engine_Size;
- 
- 
-    function Catalytic_Converter (V : in Motorcycle) return Boolean is
-    begin
-       return (False);
-    end Catalytic_Converter;
- 
- 
-    function Emissions_Produced  (V : in Motorcycle) return Emission_Measure is
-    begin
-       return 100.00;
-    end Emissions_Produced;
- 
-    --
-    -- Overridden operations for Automobile type.
-    --
- 
-    function Catalytic_Converter (V : in Automobile) return Boolean is
-    begin
-       return (True);
-    end Catalytic_Converter;
- 
- 
-    function Emissions_Produced  (V : in Automobile) return Emission_Measure is
-    begin
-       return 200.00;
-    end Emissions_Produced;
- 
-    --
-    -- Overridden operation for Truck type.
-    --
- 
-    function Emissions_Produced  (V : in Truck) return Emission_Measure is
-    begin
-       return 300.00;
-    end Emissions_Produced;
-                      
- end C392002_0;
- 
- --------------------------------------------------------------------- C392002
- 
- with C392002_0;        -- with Vehicle_Simulation;
- with Report;
- 
- procedure C392002 is  
- 
-    type Decade                     is (c1970, c1980, c1990);
-    type Vehicle_Emissions          is digits 6;
-    type Engine_Emissions_by_Decade is array (Decade) of Vehicle_Emissions;
-    subtype Engine_Size             is Integer range 100 .. 1000;
- 
-    Five_Tons                  : constant Natural := 10000;
-    Catalytic_Converter_Offset : constant Vehicle_Emissions := 0.8;
-    Truck_Adjustment_Factor    : constant Vehicle_Emissions := 1.2;
- 
- 
-    Engine_Emission_Factor : Engine_Emissions_by_Decade := (c1970 => 10.00,
-                                                            c1980 =>  8.00,
-                                                            c1990 =>  5.00);
- 
-    -- Instantiate generic package for 1970 simulation.
- 
-    package Sim_1970 is new C392002_0
-      (Cubic_Inches                    => Engine_Size,
-       Emission_Measure                => Vehicle_Emissions,
-       Emissions_Per_Engine_Cubic_Inch => Engine_Emission_Factor (c1970));
- 
- 
-    -- Declare and initialize vehicle objects.
- 
-    Cycle_1970 : Sim_1970.Motorcycle := (Weight         => 400, 
-                                         Wheels         =>   2,
-                                         Size_Of_Engine => 100);
- 
-    Auto_1970  : Sim_1970.Automobile := (2000, 4, 500, 5);
- 
-    Truck_1970 : Sim_1970.Truck      := (Weight             => 5000, 
-                                         Wheels             => 18, 
-                                         Size_Of_Engine     => 1000, 
-                                         Passenger_Capacity => 2, 
-                                         Hauling_Capacity   => Five_Tons);
- 
-    -- Function Get_Engine_Size performs a dispatching call on a
-    -- primitive operation that has been defined for an ancestor type and 
-    -- inherited by each type derived from the ancestor.
- 
-    function Get_Engine_Size (V : in Sim_1970.Vehicle'Class) 
-      return Engine_Size is
-    begin
-      return (Sim_1970.Engine_Size (V)); -- Dispatch according to tag.
-    end Get_Engine_Size;
-  
- 
-    -- Function Catalytic_Converter_Present performs a dispatching call on 
-    -- a primitive operation that has been defined for an ancestor type, 
-    -- overridden in the parent extended type, and inherited by the subsequent 
-    -- extended type.
- 
-    function Catalytic_Converter_Present (V : in Sim_1970.Vehicle'Class)
-      return Boolean is
-    begin
-       return (Sim_1970.Catalytic_Converter (V)); -- Dispatch according to tag.
-    end Catalytic_Converter_Present;
- 
- 
-    -- Function Air_Quality_Measure performs a dispatching call on 
-    -- a primitive operation that has been defined for an ancestor type, and
-    -- overridden in each subsequent extended type.
- 
-    function Air_Quality_Measure (V : in Sim_1970.Vehicle'Class)
-      return Vehicle_Emissions is
-    begin
-       return (Sim_1970.Emissions_Produced (V));  -- Dispatch according to tag.
-    end Air_Quality_Measure;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("C392002",  "Check that the use of a class-wide parameter "
-                           & "allows for proper dispatching where root type "
-                           & "and extended types are declared in the same "
-                           & "generic package" );
- 
-    if (Get_Engine_Size (Cycle_1970) /=  100) or
-       (Get_Engine_Size (Auto_1970)  /=  500) or
-       (Get_Engine_Size (Truck_1970) /= 1000) 
-    then
-       Report.Failed ("Failed dispatch to Get_Engine_Size");
-    end if;
- 
-    if Catalytic_Converter_Present (Cycle_1970)    or
-       not Catalytic_Converter_Present (Auto_1970) or
-       not Catalytic_Converter_Present (Truck_1970)
-    then
-       Report.Failed ("Failed dispatch to Catalytic_Converter_Present");
-    end if;
- 
-    if ((Air_Quality_Measure (Cycle_1970) /= 100.00) or
-        (Air_Quality_Measure (Auto_1970)  /= 200.00) or
-        (Air_Quality_Measure (Truck_1970) /= 300.00)) 
-    then
-       Report.Failed ("Failed dispatch to Air_Quality_Measure");
-    end if;
- 
-    Report.Result;
- 
- end C392002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,453 ****
- -- C392003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the use of a class-wide formal parameter allows for the 
- --      proper dispatching of objects to the appropriate implementation of 
- --      a primitive operation.  Check this where the root tagged type is
- --      defined in a package, and the extended type is defined in a nested
- --      package.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type, and some associated primitive operations.
- --      Extend the root type, and override one or more primitive operations, 
- --      inheriting the other primitive operations from the root type.
- --      Derive from the extended type, again overriding some primitive
- --      operations and inheriting others (including some that the parent 
- --      inherited).
- --      Define a subprogram with a class-wide parameter, inside of which is a 
- --      call on a dispatching primitive operation.  These primitive operations
- --      modify global variables (the class-wide parameter has mode IN).
- --     
- --     
- --     
- -- The following hierarchy of tagged types and primitive operations is 
- -- utilized in this test:
- --
- --    type Bank_Account (root)
- --            |
- --            | Operations
- --            |   Increment_Bank_Reserve
- --            |   Assign_Representative
- --            |   Increment_Counters
- --            |   Open
- --            |
- --    type Savings_Account (extended from Bank_Account)
- --            |
- --            | Operations
- --            |   (Increment_Bank_Reserve) (inherited)
- --            |   Assign_Representative    (overridden)
- --            |   Increment_Counters       (overridden)
- --            |   Open                     (overridden)
- --            |
- --    type Preferred_Account (extended from Savings_Account)
- --            |
- --            | Operations
- --            |   (Increment_Bank_Reserve) (inherited twice - Bank_Acct.)
- --            |   (Assign_Representative)  (inherited - Savings_Acct.)
- --            |   Increment_Counters       (overridden)
- --            |   Open                     (overridden)
- -- 
- --
- -- In this test, we are concerned with the following selection of dispatching
- -- calls, accomplished with the use of a Bank_Account'Class IN procedure 
- -- parameter :
- --
- --                       \ Type
- --               Prim. Op \  Bank_Account  Savings_Account Preferred_Account
- --                         \------------------------------------------------ 
- --   Increment_Bank_Reserve|      X                               X
- --   Assign_Representative |                      X
- --   Increment_Counters    |      X               X               X
- --
- --
- --
- -- The location of the declaration and derivation of the root and extended
- -- types will be varied over a series of tests.  Locations of declaration
- -- and derivation for a particular test are marked with an asterisk (*).
- --
- -- Root type:
- --       
- --    *  Declared in package.
- --       Declared in generic package.
- --
- -- Extended types:
- --
- --       Derived in parent location.
- --    *  Derived in a nested package.
- --       Derived in a nested subprogram.
- --       Derived in a nested generic package.
- --       Derived in a separate package.
- --       Derived in a separate visible child package.
- --       Derived in a separate private child package.
- --
- -- Primitive Operations:
- --
- --    *  Procedures with same parameter profile.
- --       Procedures with different parameter profile.
- --    *  Functions with same parameter profile.
- --       Functions with different parameter profile.
- --    *  Mixture of Procedures and Functions.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-  
-  
-  with Report;
-  
-  procedure C392003 is
-  
-        --
-        -- Types and subtypes.
-        --
-  
-        type Dollar_Amount  is new float;
-        type Interest_Rate  is delta 0.001 range 0.000 .. 1.000;
-        type Account_Types  is (Bank, Savings, Preferred, Total);
-        type Account_Counter is array (Account_Types) of integer;
-        type Account_Rep is (President, Manager, New_Account_Manager, Teller);
-  
-        --
-        -- Constants.
-        --
-  
-        Opening_Balance           : constant Dollar_Amount := 100.00;
-        Current_Rate              : constant Interest_Rate := 0.030;
-        Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00;
-  
-        --
-        -- Global Variables
-        --
-  
-        Bank_Reserve         : Dollar_Amount   := 0.00;
-        Daily_Representative : Account_Rep     := New_Account_Manager;
-        Number_Of_Accounts   : Account_Counter := (Bank      => 0,
-                                                   Savings   => 0,
-                                                   Preferred => 0,
-                                                   Total     => 0);
-  
-     -- Root tagged type and primitive operations declared in internal 
-     -- package (Accounts).
-     -- Extended types (and primitive operations) derived in nested packages.
-  
-       --=================================================================--
-  
-     package Accounts is
-  
-        --
-        -- Root account type and primitive operations.
-        --
-  
-        -- Root type.
-  
-        type Bank_Account is tagged
-           record
-              Balance : Dollar_Amount;
-           end record;
-  
-        -- Primitive operations of Bank_Account.
-  
-        function  Increment_Bank_Reserve (Acct : in     Bank_Account) 
-          return Dollar_Amount;
-        function Assign_Representative   (Acct : in     Bank_Account)
-          return Account_Rep;
-        procedure Increment_Counters     (Acct : in     Bank_Account);
-        procedure Open                   (Acct : in out Bank_Account);
-  
-       --=================================================================--
-                            
-        package S_And_L is 
-  
-           -- Declare extended type in a nested package.
-  
-           type Savings_Account is new Bank_Account with
-           record
-              Rate : Interest_Rate;
-           end record;
-  
-           -- Function Increment_Bank_Reserve inherited from 
-           -- parent (Bank_Account).
-  
-           -- Primitive operations (Overridden).
-           function Assign_Representative (Acct : in     Savings_Account)
-             return Account_Rep;
-           procedure Increment_Counters   (Acct : in     Savings_Account);
-           procedure Open                 (Acct : in out Savings_Account);
-                            
-  
-       --=================================================================--
-                            
-           package Premium is 
-  
-              -- Declare further extended type in a nested package.
-  
-              type Preferred_Account is new Savings_Account with
-              record
-                 Minimum_Balance : Dollar_Amount;
-              end record;
-  
-              -- Function Increment_Bank_Reserve inherited twice.
-              -- Function Assign_Representative inherited from parent 
-              --   (Savings_Account).
-  
-              -- Primitive operation (Overridden).
-              procedure Increment_Counters (Acct : in     Preferred_Account);
-              procedure Open               (Acct : in out Preferred_Account);
-  
-              -- Function used to verify Open operation for Preferred_Account 
-              -- objects.
-              function Verify_Open (Acct : in Preferred_Account) return Boolean;
-  
-           end Premium;
-  
-        end S_And_L;
-  
-     end Accounts;
-  
-       --=================================================================--
-  
-     package body Accounts is
-  
-        --
-        -- Primitive operations for Bank_Account.
-        --
-  
-        function Increment_Bank_Reserve (Acct : in Bank_Account) 
-          return Dollar_Amount is
-        begin
-           return (Bank_Reserve + Acct.Balance);
-        end Increment_Bank_Reserve;
-  
-        function Assign_Representative (Acct : in Bank_Account) 
-          return Account_Rep is
-        begin
-           return Account_Rep'(Teller);
-        end Assign_Representative;
-  
-        procedure Increment_Counters (Acct : in Bank_Account) is
-        begin
-           Number_Of_Accounts (Bank)  := Number_Of_Accounts (Bank) + 1;
-           Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
-        end Increment_Counters;
-  
-        procedure Open (Acct : in out Bank_Account) is
-        begin
-           Acct.Balance := Opening_Balance;
-        end Open;
-  
-       --=================================================================--
-  
-        package body S_And_L is
-  
-           --
-           -- Overridden operations for Savings_Account type.
-           --
-  
-           function Assign_Representative (Acct : in Savings_Account) 
-             return Account_Rep is
-           begin
-              return (Manager);
-           end Assign_Representative;
-  
-           procedure Increment_Counters (Acct : in Savings_Account) is
-           begin
-              Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1;
-              Number_Of_Accounts (Total)   := Number_Of_Accounts (Total) + 1;
-           end Increment_Counters;
-  
-           procedure Open (Acct : in out Savings_Account) is
-           begin
-              Open (Bank_Account(Acct));
-              Acct.Rate := Current_Rate;
-              Acct.Balance := 2.0 * Opening_Balance;
-           end Open;
-       
-       --=================================================================--
-  
-           package body Premium is
-  
-              --
-              -- Overridden operations for Preferred_Account type.
-              --
-                       
-              procedure Increment_Counters (Acct : in Preferred_Account) is
-              begin
-                 Number_Of_Accounts (Preferred) := 
-                   Number_Of_Accounts (Preferred) + 1;
-                 Number_Of_Accounts (Total)     := 
-                   Number_Of_Accounts (Total) + 1;
-              end Increment_Counters;
-  
-              procedure Open (Acct : in out Preferred_Account) is
-              begin
-                 Open (Savings_Account(Acct));
-                 Acct.Minimum_Balance := Preferred_Minimum_Balance;
-                 Acct.Balance := Acct.Minimum_Balance;
-              end Open;
-  
-              --
-              -- Function used to verify Open operation for Preferred_Account 
-              -- objects.
-              --
-  
-              function Verify_Open (Acct : in Preferred_Account) 
-                return Boolean is
-              begin                                                    
-                 return (Acct.Balance         = Preferred_Minimum_Balance and
-                         Acct.Rate            = Current_Rate              and
-                         Acct.Minimum_Balance = Preferred_Minimum_Balance);
-              end Verify_Open;
-  
-           end Premium;
-   
-        end S_And_L;
-  
-     end Accounts;
-  
-       --=================================================================--
-  
-     -- Declare account objects.
-  
-     B_Account : Accounts.Bank_Account;
-     S_Account : Accounts.S_And_L.Savings_Account;
-     P_Account : Accounts.S_And_L.Premium.Preferred_Account;
-  
-     -- Procedures to operate on accounts.
-     -- Each uses a class-wide IN parameter, as well as a call to a
-     -- dispatching operation.
-  
-     -- Function Tabulate_Account performs a dispatching call on a primitive
-     -- operation that has been overridden for each of the extended types.
-  
-     procedure Tabulate_Account (Acct : in Accounts.Bank_Account'Class) is
-     begin
-        Accounts.Increment_Counters (Acct);   -- Dispatch according to tag.
-     end Tabulate_Account;
-  
-     -- Function Accumulate_Reserve performs a dispatching call on a
-     -- primitive operation that has been defined for the root type and 
-     -- inherited by each derived type.
-  
-     function Accumulate_Reserve (Acct : in Accounts.Bank_Account'Class) 
-       return Dollar_Amount is
-     begin
-        -- Dispatch according to tag.
-        return (Accounts.Increment_Bank_Reserve (Acct));   
-     end Accumulate_Reserve;
-  
-     -- Procedure Resolve_Dispute performs a dispatching call on a primitive
-     -- operation that has been defined in the root type, overridden in the
-     -- first derived extended type, and inherited by the subsequent extended
-     -- type.
-  
-     procedure Resolve_Dispute (Acct : in Accounts.Bank_Account'Class) is
-     begin
-        -- Dispatch according to tag.
-        Daily_Representative := Accounts.Assign_Representative (Acct);   
-     end Resolve_Dispute;
-  
-       --=================================================================--
-  
-  begin  -- Main test procedure.
-  
-     Report.Test ("C392003", "Check that the use of a class-wide parameter "   &
-                              "allows for proper dispatching where root type " &
-                              "is declared in a nested package, and "          &
-                              "subsequent extended types are derived in "      &
-                              "further nested packages" );
-     
-     Bank_Account_Subtest:
-     begin
-        Accounts.Open (B_Account);
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been defined for this specific type.
-        Bank_Reserve := Accumulate_Reserve (Acct => B_Account);
-        Tabulate_Account (B_Account);
-  
-        if (Bank_Reserve /= Opening_Balance) or
-           (Number_Of_Accounts (Bank) /= 1)  or
-           (Number_Of_Accounts (Total) /= 1) 
-        then
-           Report.Failed ("Failed in Bank_Account_Subtest");
-        end if;
-  
-     end Bank_Account_Subtest;
-  
-  
-     Savings_Account_Subtest:
-     begin
-        Accounts.S_And_L.Open (Acct => S_Account);
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been overridden for this extended type.
-        Resolve_Dispute  (Acct => S_Account);
-        Tabulate_Account (S_Account);
-  
-        if (Daily_Representative /= Manager)   or 
-           (Number_Of_Accounts (Savings) /= 1) or
-           (Number_Of_Accounts (Total) /= 2)
-        then
-           Report.Failed ("Failed in Savings_Account_Subtest");
-        end if;
-  
-     end Savings_Account_Subtest;
-  
-  
-  
-     Preferred_Account_Subtest:
-     begin
-        Accounts.S_And_L.Premium.Open (P_Account);
-  
-        -- Verify that the correct implementation of Open (overridden) was 
-        -- used for the Preferred_Account object.
-        if not Accounts.S_And_L.Premium.Verify_Open (P_Account) then
-           Report.Failed ("Incorrect values for init. Preferred Acct object");
-        end if;
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been twice inherited by this extended type.
-        Bank_Reserve := Accumulate_Reserve (Acct => P_Account);
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been overridden for this extended type (the
-        -- operation was overridden by its parent type as well).
-        Tabulate_Account (P_Account);
-        
-        if Bank_Reserve /= 1100.00             or 
-           Number_Of_Accounts (Preferred) /= 1 or
-           Number_Of_Accounts (Total) /= 3
-        then
-           Report.Failed ("Failed in Preferred_Account_Subtest");
-        end if;
-  
-     end Preferred_Account_Subtest;
-  
-     Report.Result;
-  
-  end C392003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,189 ****
- -- C392004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that subprograms inherited from tagged derivations, which are
- --      subsequently redefined for the derived type, are available to the
- --      package defining the new class via view conversion.  Check
- --      that operations performed on objects using view conversion do not 
- --      affect the extended fields.  Check that visible operations not masked 
- --      by the deriving package remain available to the client, and do not 
- --      affect the extended fields.
- --
- -- TEST DESCRIPTION:
- --      This test declares a tagged type, with a constructor operation,
- --      derives a type from that tagged type, and declares a constructor
- --      operation which masks the inherited operation.  It then tests
- --      that the correct constructor is called, and that the extended
- --      part of the derived type remains untouched as appropriate.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --      04 Jan 94   SAIC    Fixed objective typo, removed dead code.
- --
- --!
- 
- with Report;
- 
- package C392004_1 is
- 
-   type Vehicle is tagged private;
- 
-   procedure Create ( The_Vehicle :    out Vehicle; TC_Flag : Natural );
-   procedure Start  ( The_Vehicle : in out Vehicle );
- 
- private
- 
-   type Vehicle is tagged record
-     Engine_On : Boolean;
-   end record;
- 
- end C392004_1;
- 
- package body C392004_1 is
-   procedure Create ( The_Vehicle : out Vehicle; TC_Flag : Natural ) is
-   begin
-     case TC_Flag is
-       when 1 => null; -- expected flag for this subprogram
-       when others =>
-          Report.Failed ("Called Vehicle Create");
-     end case;
-     The_Vehicle := (Engine_On => False);
-   end Create;
- 
-   procedure Start ( The_Vehicle : in out Vehicle ) is
-   begin
-     The_Vehicle.Engine_On := True;
-   end Start;
- 
- end C392004_1;
- 
- ----------------------------------------------------------------------------
- 
- with C392004_1;
- package C392004_2 is
- 
-   type Car is new C392004_1.Vehicle with record
-     Convertible : Boolean;
-   end record;
- 
-   -- masking definition
-   procedure Create( The_Car : out Car; TC_Flag : Natural );
- 
-   type Limo is new Car with null record;
- 
-   procedure Create( The_Limo : out Limo; TC_Flag : Natural );
- 
- end C392004_2;
- 
- ----------------------------------------------------------------------------
- 
- with Report;
- package body C392004_2 is
- 
-   procedure Create( The_Car : out Car; TC_Flag : Natural ) is
-   begin
-     case TC_Flag is
-       when 2      => null; -- expected flag for this subprogram
-       when others => Report.Failed ("Called Car Create");
-     end case;
-     C392004_1.Create( C392004_1.Vehicle(The_Car), 1);
-     The_Car.Convertible := False;
-   end Create;
- 
-   procedure Create( The_Limo : out Limo; TC_Flag : Natural ) is
-   begin
-     case TC_Flag is
-       when 3      => null; -- expected flag for this subprogram
-       when others => Report.Failed ("Called Limo Create");
-     end case;
-     C392004_1.Create( C392004_1.Vehicle(The_Limo), 1);
-     The_Limo.Convertible := True;
-  end Create;
- 
- end C392004_2;
- 
- ----------------------------------------------------------------------------
- 
- with Report;
- with C392004_1; use C392004_1;
- with C392004_2; use C392004_2;
- procedure C392004 is
- 
-   My_Car : Car;
-   Your_Car : Limo;
- 
-   procedure TC_Assert( Is_True : Boolean; Message : String ) is
-   begin
-     if not Is_True then
-       Report.Failed (Message);
-     end if;
-   end TC_Assert;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C392004", "Check subprogram inheritance & visibility " &
-                           "for derived tagged types" );
- 
-   My_Car.Convertible := False;
-   Create( Vehicle( My_Car ), 1 );
-   TC_Assert( not My_Car.Convertible, "Altered descendent component 1");
- 
-   Create( Your_Car, 3 );
-   TC_Assert( Your_Car.Convertible, "Did not set inherited component 2");
- 
-   My_Car.Convertible := True;
-   Create( Vehicle( My_Car ), 1 );
-   TC_Assert( My_Car.Convertible, "Altered descendent component 3");
- 
-   Create( My_Car, 2 );
-   TC_Assert( not My_Car.Convertible, "Did not set extending component 4");
- 
-   My_Car.Convertible := False;
-   Start( Vehicle( My_Car ) );
-   TC_Assert( not My_Car.Convertible , "Altered descendent component 5");
- 
-   Start( My_Car );
-   TC_Assert( not My_Car.Convertible, "Altered unreferenced component 6");
- 
-   Your_Car.Convertible := False;
-   Start( Vehicle( Your_Car ) );
-   TC_Assert( not Your_Car.Convertible , "Altered descendent component 7");
- 
-   Start( Your_Car );
-   TC_Assert( not Your_Car.Convertible, "Altered unreferenced component 8");
- 
-   My_Car.Convertible := True;
-   Start( Vehicle( My_Car ) );
-   TC_Assert( My_Car.Convertible, "Altered descendent component 9");
- 
-   Start( My_Car );
-   TC_Assert( My_Car.Convertible, "Altered unreferenced component 10");
- 
-   Report.Result;
- 
- end C392004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,367 ****
- -- C392005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for an implicitly declared dispatching operation that is
- --      overridden, the body executed is the body for the overriding
- --      subprogram, even if the overriding occurs in a private part.
- --
- --      Check for the case where the overriding operations are declared in a
- --      public child unit of the package declaring the parent type, and the
- --      descendant type is a private extension.
- --
- --      Check for both dispatching and nondispatching calls.
- --
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      package Parent is
- --         type Root is tagged ...
- --         procedure Vis_Op (P: Root);
- --      private
- --         procedure Pri_Op (P: Root);
- --      end Parent;
- --
- --      package Parent.Child is
- --         type Derived is new Root with private;
- --         -- Implicit Vis_Op (P: Derived) declared here.
- --
- --         procedure Pri_Op (P: Derived);                  -- (A)
- --         ...
- --      private
- --         type Derived is new Root with record...
- --         -- Implicit Pri_Op (P: Derived) declared here.
- 
- --         procedure Vis_Op (P: Derived);                  -- (B)
- --         ...
- --      end Parent.Child;
- --
- --      Type Derived inherits both Vis_Op and Pri_Op from the ancestor type
- --      Root. Note, however, that Vis_Op is implicitly declared in the visible
- --      part, whereas Pri_Op is implicitly declared in the private part
- --      (inherited subprograms for a private extension are implicitly declared
- --      after the private_extension_declaration if the corresponding
- --      declaration from the ancestor is visible at that place; otherwise the
- --      inherited subprogram is not declared for the private extension,
- --      although it might be for the full type).
- --
- --      Even though Root's version of Pri_Op hasn't been implicitly declared
- --      for Derived at the time Derived's version of Pri_Op has been
- --      explicitly declared, the explicit Pri_Op still overrides the implicit
- --      version. 
- --      Also, even though the explicit Vis_Op for Derived is declared in the
- --      private part it still overrides the implicit version declared in the
- --      visible part. Calls with tag Derived will execute (A) and (B).
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Nov 96   SAIC    Improved for ACVC 2.1
- --
- --!
- 
- package C392005_0 is
- 
-    type Remote_Camera is tagged private;
- 
-    type Depth_Of_Field is range 5 .. 100;  
-    type Shutter_Speed  is (One, Two_Fifty, Four_Hundred, Thousand);
-    type Aperture       is (Eight, Sixteen, Thirty_Two);     
- 
-    -- ...Other declarations.
- 
-    procedure Focus (Cam   : in out Remote_Camera;
-                     Depth : in     Depth_Of_Field);
- 
-    procedure Self_Test (C: in out Remote_Camera'Class);
- 
-    -- ...Other operations.
- 
-    function TC_Get_Depth (C: Remote_Camera) return Depth_Of_Field;
-    function TC_Get_Speed (C: Remote_Camera) return Shutter_Speed;
- 
- private
- 
-    type Remote_Camera is tagged record
-       DOF    : Depth_Of_Field := 10;
-       Shutter: Shutter_Speed  := One;
-       FStop  : Aperture       := Eight;
-    end record;
- 
-    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
-                                 Speed : in     Shutter_Speed);
- 
-    -- For the basic remote camera, shutter speed might be set as a function of
-    -- focus perhaps, thus it is declared as a private operation (usable
-    -- only internally within the abstraction).
- 
-    function Set_Aperture (C : Remote_Camera) return Aperture;
-                                
- end C392005_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C392005_0 is
- 
-    procedure Focus (Cam   : in out Remote_Camera;
-                     Depth : in     Depth_Of_Field) is
-    begin
-       -- Artificial for testing purposes.
-       Cam.DOF := 46;
-    end Focus;
- 
-    -----------------------------------------------------------
-    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
-                                 Speed : in     Shutter_Speed) is
-    begin
-       -- Artificial for testing purposes.
-       C.Shutter := Thousand;
-    end Set_Shutter_Speed;
- 
-    -----------------------------------------------------------
-    function Set_Aperture (C : Remote_Camera) return Aperture is
-    begin
-       -- Artificial for testing purposes.
-       return Thirty_Two;
-    end Set_Aperture;
- 
-    -----------------------------------------------------------
-    procedure Self_Test (C: in out Remote_Camera'Class) is
-       TC_Dummy_Depth : constant Depth_Of_Field := 23;
-       TC_Dummy_Speed : constant Shutter_Speed  := Four_Hundred;
-    begin
- 
-       -- Test focus at various depths:
-       Focus(C, TC_Dummy_Depth);
-       -- ...Additional calls to Focus.
- 
-       -- Test various shutter speeds:
-       Set_Shutter_Speed(C, TC_Dummy_Speed);
-       -- ...Additional calls to Set_Shutter_Speed.
- 
-    end Self_Test;
- 
-    -----------------------------------------------------------
-    function TC_Get_Depth (C: Remote_Camera) return Depth_Of_Field is
-    begin
-       return C.DOF;
-    end TC_Get_Depth;
- 
-    -----------------------------------------------------------
-    function TC_Get_Speed (C: Remote_Camera) return Shutter_Speed is
-    begin
-       return C.Shutter;
-    end TC_Get_Speed;
- 
- end C392005_0;
- 
-      --==================================================================--
- 
- 
- package C392005_0.C392005_1 is
- 
-    type Auto_Speed is new Remote_Camera with private;
- 
- 
-    -- procedure Focus (C     : in out Auto_Speed;      -- Implicitly declared
-    --                  Depth : in     Depth_Of_Field)  -- here.
- 
-    -- For the improved remote camera, shutter speed can be set manually,
-    -- so it is declared as a public operation.
- 
-    -- The order of declarations for Set_Aperture and Set_Shutter_Speed are
-    -- reversed from the original declarations to trap potential compiler
-    -- problems related to subprogram ordering.
- 
-    function Set_Aperture (C : Auto_Speed) return Aperture;    -- Overrides
-                                                               -- inherited op.
- 
-    procedure Set_Shutter_Speed (C     : in out Auto_Speed;    -- Overrides
-                                 Speed : in     Shutter_Speed);-- inherited op.
- 
-    -- Set_Shutter_Speed and Set_Aperture override the operations inherited
-    -- from the parent, even though the inherited operations are not implicitly
-    -- declared until the private part below.
- 
-    type New_Camera is private;
- 
-    function TC_Get_Aper (C: New_Camera) return Aperture;
- 
-    -- ...Other operations.
- 
- private
-    type Film_Speed is (One_Hundred, Two_Hundred, Four_Hundred);
- 
-    type Auto_Speed is new Remote_Camera with record
-       ASA : Film_Speed;
-    end record;
- 
-    -- procedure Set_Shutter_Speed (C     : in out Auto_Speed;    -- Implicitly
-    --                              Speed : in     Shutter_Speed) -- declared
-                                                                  -- here.
- 
-    -- function Set_Aperture (C : Auto_Speed) return Aperture;    -- Implicitly
-                                                                  -- declared.
- 
-    procedure Focus (C     : in out Auto_Speed;                -- Overrides
-                     Depth : in     Depth_Of_Field);           -- inherited op.
- 
-    -- For the improved remote camera, perhaps the focusing algorithm is
-    -- different, so the original Focus operation is overridden here.
- 
-    Auto_Camera : Auto_Speed;
- 
-    type New_Camera is record
-       Aper : Aperture := Set_Aperture (Auto_Camera);  -- Calls the overridden,
-    end record;                                        -- not the inherited op.
- 
- end C392005_0.C392005_1;
- 
- 
-      --==================================================================--
- 
- 
- package body C392005_0.C392005_1 is
- 
-    procedure Focus (C     : in out Auto_Speed;
-                     Depth : in     Depth_Of_Field) is
-    begin
-       -- Artificial for testing purposes.
-       C.DOF := 57;
-    end Focus;
- 
-    ---------------------------------------------------------------
-    procedure Set_Shutter_Speed (C     : in out Auto_Speed;
-                                 Speed : in     Shutter_Speed) is
-    begin
-       -- Artificial for testing purposes.
-       C.Shutter := Two_Fifty;
-    end Set_Shutter_Speed;
- 
-    -----------------------------------------------------------
-    function Set_Aperture (C : Auto_Speed) return Aperture is
-    begin
-       -- Artificial for testing purposes.
-       return Sixteen;
-    end Set_Aperture;
- 
-    -----------------------------------------------------------
-    function TC_Get_Aper (C: New_Camera) return Aperture is
-    begin
-       return C.Aper;
-    end TC_Get_Aper;
- 
- end C392005_0.C392005_1;
- 
- 
-      --==================================================================--
- 
- 
- with C392005_0.C392005_1;
- 
- with Report;
- 
- procedure C392005 is
-    Basic_Camera : C392005_0.Remote_Camera;
-    Auto_Camera1 : C392005_0.C392005_1.Auto_Speed;
-    Auto_Camera2 : C392005_0.C392005_1.Auto_Speed;
-    Auto_Depth   : C392005_0.Depth_Of_Field := 67;
-    New_Camera1  : C392005_0.C392005_1.New_Camera;
-    TC_Expected_Basic_Depth : constant C392005_0.Depth_Of_Field := 46;
-    TC_Expected_Auto_Depth  : constant C392005_0.Depth_Of_Field := 57;
-    TC_Expected_Basic_Speed : constant C392005_0.Shutter_Speed  
-                            := C392005_0.Thousand;
-    TC_Expected_Auto_Speed  : constant C392005_0.Shutter_Speed  
-                            := C392005_0.Two_Fifty;
-    TC_Expected_New_Aper    : constant C392005_0.Aperture 
-                            := C392005_0.Sixteen;
- 
-    use type C392005_0.Depth_Of_Field;
-    use type C392005_0.Shutter_Speed;
-    use type C392005_0.Aperture;
- 
- begin
-    Report.Test ("C392005", "Dispatching for overridden primitive "        &
-                 "subprograms: private extension declared in child unit, " &
-                 "parent is tagged private whose full view is tagged record");
- 
- -- Call the class-wide operation for Remote_Camera'Class, which itself makes
- -- dispatching calls to Focus and Set_Shutter_Speed:
- 
- 
-    -- For an object of type Remote_Camera, the dispatching calls should
-    -- dispatch to the bodies declared for the root type:
-      
-    C392005_0.Self_Test(Basic_Camera);
- 
-    if C392005_0.TC_Get_Depth (Basic_Camera) /= TC_Expected_Basic_Depth 
-      or else C392005_0.TC_Get_Speed (Basic_Camera) /= TC_Expected_Basic_Speed
-    then
-       Report.Failed ("Calls dispatched incorrectly for root type");
-    end if;
- 
- 
-    -- For an object of type Auto_Speed, the dispatching calls should
-    -- dispatch to the bodies declared for the derived type:
-      
-    C392005_0.Self_Test(Auto_Camera1);
- 
-    if C392005_0.C392005_1.TC_Get_Depth(Auto_Camera1) /= TC_Expected_Auto_Depth
- 
-       or
-       C392005_0.C392005_1.TC_Get_Speed(Auto_Camera1) /= TC_Expected_Auto_Speed
-    then
-       Report.Failed ("Calls dispatched incorrectly for derived type");
-    end if;
- 
-    -- For an object of type Auto_Speed, a non-dispatching call to Focus should
- 
-    -- execute the body declared for the derived type (even through it is 
-    -- declared in the private part).
- 
-    C392005_0.C392005_1.Focus (Auto_Camera2, Auto_Depth);
- 
-    if C392005_0.C392005_1.TC_Get_Depth(Auto_Camera2) /= TC_Expected_Auto_Depth
- 
-    then
-       Report.Failed ("Non-dispatching call to privately overriding " &
-                      "subprogram executed the wrong body");
-    end if;
- 
-    -- For an object of type New_Camera, the initialization using Set_Ap 
-    -- should execute the overridden body, not the inherited one.
- 
-    if C392005_0.C392005_1.TC_Get_Aper (New_Camera1) /= TC_Expected_New_Aper  
-    then
-       Report.Failed ("Non-dispatching call to visible overriding " &
-                      "subprogram executed the wrong body");
-    end if;
- 
-    Report.Result;
- 
- end C392005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,401 ****
- -- C392008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the use of a class-wide formal parameter allows for the 
- --      proper dispatching of objects to the appropriate implementation of 
- --      a primitive operation.  Check this for the case where the root tagged
- --      type is defined in a package and the extended type is defined in a
- --      dependent package.
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type, and some associated primitive operations,
- --      in a visible library package.
- --      Extend the root type in another visible library package, and override 
- --      one or more primitive operations, inheriting the other primitive 
- --      operations from the root type.
- --      Derive from the extended type in yet another visible library package, 
- --      again overriding some primitive operations and inheriting others 
- --      (including some that the parent inherited).
- --      Define subprograms with class-wide parameters, inside of which is a 
- --      call on a dispatching primitive operation.  These primitive
- --      operations modify the objects of the specific class passed as actuals
- --      to the class-wide formal parameter (class-wide formal parameter has 
- --      mode IN OUT).
- --     
- -- The following hierarchy of tagged types and primitive operations is 
- -- utilized in this test:
- --
- --   package Bank
- --      type Account (root)
- --            |
- --            | Operations
- --            |     proc Deposit
- --            |     proc Withdrawal
- --            |     func Balance        
- --            |     proc Service_Charge 
- --            |     proc Add_Interest   
- --            |     proc Open
- --            |
- --   package Checking
- --      type Account (extended from Bank.Account)
- --            |
- --            | Operations
- --            |     proc Deposit         (inherited)
- --            |     proc Withdrawal      (inherited)
- --            |     func Balance         (inherited)
- --            |     proc Service_Charge  (inherited)
- --            |     proc Add_Interest    (inherited)
- --            |     proc Open            (overridden)
- --            |
- --   package Interest_Checking
- --      type Account (extended from Checking.Account)
- --            |
- --            | Operations
- --            |     proc Deposit         (inherited twice - Bank.Acct.)
- --            |     proc Withdrawal      (inherited twice - Bank.Acct.)
- --            |     func Balance         (inherited twice - Bank.Acct.)
- --            |     proc Service_Charge  (inherited twice - Bank.Acct.)
- --            |     proc Add_Interest    (overridden)
- --            |     proc Open            (overridden)
- --            |   
- --
- -- In this test, we are concerned with the following selection of dispatching
- -- calls, accomplished with the use of a Bank.Account'Class IN OUT formal
- -- parameter :
- --
- --                \ Type
- --        Prim. Op \  Bank.Account  Checking.Account Interest_Checking.Account
- --                  \---------------------------------------------------------
- 
- --   Service_Charge |      X                X                 X
- --   Add_Interest   |      X                X                 X
- --   Open           |      X                X                 X
- --
- --
- --
- -- The location of the declaration of the root and derivation of extended
- -- types will be varied over a series of tests.  Locations of declaration
- -- and derivation for a particular test are marked with an asterisk (*).
- --
- -- Root type:
- --       
- --    *  Declared in package.
- --       Declared in generic package.
- --
- -- Extended types:
- --
- --       Derived in parent location.
- --       Derived in a nested package.
- --       Derived in a nested subprogram.
- --       Derived in a nested generic package.
- --    *  Derived in a separate package.
- --       Derived in a separate visible child package.
- --       Derived in a separate private child package.
- --
- -- Primitive Operations:
- --
- --    *  Procedures with same parameter profile.
- --       Procedures with different parameter profile.
- --       Functions with same parameter profile.
- --       Functions with different parameter profile.
- --       Mixture of Procedures and Functions.
- --
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         C392008_0.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      20 Nov 95   SAIC    C392B04 became C392008 for ACVC 2.0.1
- --
- --!
- 
- ----------------------------------------------------------------- C392008_0
- 
- package C392008_0 is           -- package Bank
- 
-   type Dollar_Amount is range -30_000..30_000; 
-  
-    type Account is tagged
-       record
-         Current_Balance: Dollar_Amount;
-       end record;
- 
-    -- Primitive operations.
- 
-    procedure Deposit        (A : in out Account; 
-                              X : in     Dollar_Amount);
-    procedure Withdrawal     (A : in out Account; 
-                              X : in     Dollar_Amount);
-    function  Balance        (A : in     Account) return Dollar_Amount;
-    procedure Service_Charge (A : in out Account);
-    procedure Add_Interest   (A : in out Account);
-    procedure Open           (A : in out Account);
- 
- end C392008_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C392008_0 is
- 
-    -- Primitive operations for type Account.
- 
-    procedure Deposit (A : in out Account; 
-                       X : in     Dollar_Amount) is
-    begin
-       A.Current_Balance := A.Current_Balance + X;
-    end Deposit;
- 
-    procedure Withdrawal(A : in out Account; 
-                         X : in     Dollar_Amount) is
-    begin
-       A.Current_Balance := A.Current_Balance - X;
-    end Withdrawal;
- 
-    function  Balance (A : in     Account) return Dollar_Amount is
-    begin
-       return (A.Current_Balance);
-    end Balance;
- 
-    procedure Service_Charge (A : in out Account) is
-    begin
-       A.Current_Balance := A.Current_Balance - 5_00;
-    end Service_Charge;
- 
-    procedure Add_Interest (A : in out Account) is
-       Interest_On_Account : Dollar_Amount := 0_00;
-    begin
-       A.Current_Balance := A.Current_Balance + Interest_On_Account;
-    end Add_Interest;
- 
-    procedure Open (A : in out Account) is
-       Initial_Deposit : Dollar_Amount := 10_00;
-    begin
-       A.Current_Balance := Initial_Deposit;
-    end Open;
- 
- end C392008_0;
- 
- ----------------------------------------------------------------- C392008_1
- 
- with C392008_0;              -- package Bank
- 
- package C392008_1 is      -- package Checking
- 
-    package Bank renames C392008_0;
- 
-    type Account is new Bank.Account with 
-       record
-          Overdraft_Fee : Bank.Dollar_Amount;
-       end record;
- 
-    -- Overridden primitive operation.
- 
-    procedure Open (A : in out Account);
- 
-    -- Inherited primitive operations.
-    -- procedure Deposit        (A : in out Account;
-    --                           X : in     Bank.Dollar_Amount);
-    -- procedure Withdrawal     (A : in out Account;
-    --                           X : in     Bank.Dollar_Amount);
-    -- function  Balance        (A : in     Account) return Bank.Dollar_Amount;
-    -- procedure Service_Charge (A : in out Account);
-    -- procedure Add_Interest   (A : in out Account);
- 
- end C392008_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C392008_1 is
- 
-    -- Overridden primitive operation.
- 
-    procedure Open (A : in out Account) is
-       Check_Guarantee : Bank.Dollar_Amount := 10_00;
-       Initial_Deposit : Bank.Dollar_Amount := 20_00;
-    begin
-       A.Current_Balance := Initial_Deposit;
-       A.Overdraft_Fee   := Check_Guarantee;
-    end Open;
- 
- end C392008_1;
- 
- ----------------------------------------------------------------- C392008_2
- 
- with C392008_0;             -- with Bank;
- with C392008_1;          -- with Checking;
- 
- package C392008_2 is     -- package Interest_Checking
- 
-    package Bank     renames C392008_0;
-    package Checking renames C392008_1;
- 
-    subtype Interest_Rate is Bank.Dollar_Amount range 0..100; -- was digits 4;
- 
-    Current_Rate : Interest_Rate := 0_02;
- 
-    type Account is new Checking.Account with
-       record
-          Rate : Interest_Rate;
-       end record;
- 
-    -- Overridden primitive operations.
- 
-    procedure Add_Interest (A : in out Account);
-    procedure Open         (A : in out Account);
- 
-    -- "Twice" inherited primitive operations (from Bank.Account)
-    -- procedure Deposit        (A : in out Account;
-    --                           X : in     Bank.Dollar_Amount);
-    -- procedure Withdrawal     (A : in out Account;
-    --                           X : in     Bank.Dollar_Amount);
-    -- function  Balance        (A : in     Account) return Bank.Dollar_Amount;
-    -- procedure Service_Charge (A : in out Account);
- 
- end C392008_2;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C392008_2 is
- 
-    -- Overridden primitive operations.
- 
-    procedure Add_Interest (A : in out Account) is
-       Interest_On_Account : Bank.Dollar_Amount
-         := Bank.Dollar_Amount( Bank."*"( A.Current_Balance, A.Rate ));
-    begin
-       A.Current_Balance := Bank."+"( A.Current_Balance, Interest_On_Account);
-    end Add_Interest;
- 
-    procedure Open (A : in out Account) is
-       Initial_Deposit : Bank.Dollar_Amount := 30_00;
-    begin
-       Checking.Open (Checking.Account (A));
-       A.Current_Balance := Initial_Deposit;
-       A.Rate            := Current_Rate;
-    end Open;
- 
- end C392008_2;
- 
- ------------------------------------------------------------------- C392008
- 
- with C392008_0;    use C392008_0;          -- package Bank
- with C392008_1;    use C392008_1;        -- package Checking;
- with C392008_2;    use C392008_2;        -- package Interest_Checking;
- with Report;
- 
- procedure C392008 is
- 
-    package Bank              renames C392008_0;
-    package Checking          renames C392008_1;
-    package Interest_Checking renames C392008_2;
- 
-    B_Acct  : Bank.Account;
-    C_Acct  : Checking.Account;
-    IC_Acct : Interest_Checking.Account;
- 
-    --
-    -- Define procedures with class-wide formal parameters of mode IN OUT.
-    --
- 
-    -- This procedure will perform a dispatching call on the
-    -- overridden primitive operation Open.
- 
-    procedure New_Account (Acct : in out Bank.Account'Class) is
-    begin
-       Open (Acct);  -- Dispatch according to tag of class-wide parameter.
-    end New_Account;
- 
-    -- This procedure will perform a dispatching call on the inherited
-    -- primitive operation (for all types derived from the root Bank.Account)
-    -- Service_Charge.
- 
-    procedure Apply_Service_Charge (Acct: in out Bank.Account'Class) is
-    begin
-       Service_Charge (Acct);  -- Dispatch according to tag of class-wide parm.
-    end Apply_Service_Charge;
- 
-    -- This procedure will perform a dispatching call on the 
-    -- inherited/overridden primitive operation Add_Interest.
- 
-    procedure Annual_Interest (Acct: in out Bank.Account'Class) is
-    begin
-       Add_Interest (Acct);  -- Dispatch according to tag of class-wide parm.
-    end Annual_Interest;
- 
- begin
- 
-    Report.Test ("C392008",  "Check that the use of a class-wide formal "    &
-                             "parameter allows for the proper dispatching "  &
-                             "of objects to the appropriate implementation " &
-                             "of a primitive operation");
- 
-    -- Check the dispatch to primitive operations overridden for each 
-    -- extended type.
-    New_Account (B_Acct);
-    New_Account (C_Acct);
-    New_Account (IC_Acct);
-    
-    if (B_Acct.Current_Balance  /= 10_00) or
-       (C_Acct.Current_Balance  /= 20_00) or
-       (IC_Acct.Current_Balance /= 30_00) 
-    then
-       Report.Failed ("Failed dispatch to multiply overridden prim. oper.");
-    end if;
- 
- 
-    Annual_Interest (B_Acct);
-    Annual_Interest (C_Acct);
-    Annual_Interest (IC_Acct); -- Check the dispatch to primitive operation 
-                               -- overridden from a parent type which inherited
-                               -- the operation from the root type.  
-    if (B_Acct.Current_Balance  /= 10_00) or
-       (C_Acct.Current_Balance  /= 20_00) or
-       (IC_Acct.Current_Balance /= 90_00)
-    then
-       Report.Failed ("Failed dispatch to overridden primitive operation");
-    end if;
- 
- 
-    Apply_Service_Charge (Acct => B_Acct);
-    Apply_Service_Charge (Acct => C_Acct);
-    Apply_Service_Charge (Acct => IC_Acct); -- Check the dispatch to a  
-                                            -- primitive operation twice 
-                                            -- inherited from the root
-                                            -- tagged type.
-    if (B_Acct.Current_Balance  /=  5_00) or
-       (C_Acct.Current_Balance  /= 15_00) or
-       (IC_Acct.Current_Balance /= 85_00) 
-    then
-       Report.Failed ("Failed dispatch to Apply_Service_Charge");
-    end if;
- 
-    Report.Result;
- 
- end C392008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,512 ****
- -- C392010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that a subprogram dispatches correctly with a controlling
- --     access parameter. Check that a subprogram dispatches correctly
- --     when it has access parameters that are not controlling.
- --     Check with and without default expressions.
- --
- -- TEST DESCRIPTION:
- --      The three packages define layers of tagged types.  The root tagged
- --      type contains a character value used to check that the right object
- --      got passed to the right routine.  Each subprogram has a unique
- --      TCTouch tag, upper case values are used for subprograms, lower case
- --      values are used for object values.
- --
- --      Notes on style: the "tagged" comment lines --I and --A represent
- --      commentary about what gets inherited and what becomes abstract,
- --      respectively.  The author felt these to be necessary with this test
- --      to reduce some of the additional complexities.
- --
- --3.9.2(16,17,18,20);6.0
- --
- -- CHANGE HISTORY:
- --      22 SEP 95   SAIC   Initial version
- --      22 APR 96   SAIC   Revised for 2.1
- --      05 JAN 98   EDS    Change return type of C392010_2.Func_W_Non to make
- --                         it override.
- --      21 JUN 00   RLB    Changed expected result to reflect the appropriate
- --                         value of the default expression.
- --      20 JUL 00   RLB    Removed entire call pending resolution by the ARG.
- 
- --!
- 
- ----------------------------------------------------------------- C392010_0
- 
- package C392010_0 is
- 
-   -- define a root tagged type
-   type Tagtype_Level_0 is tagged record
-     Ch_Item : Character;
-   end record;
- 
-   type Access_Procedure is access procedure( P: Tagtype_Level_0 );
- 
-   procedure Proc_1( P: Tagtype_Level_0 );
- 
-   procedure Proc_2( P: Tagtype_Level_0 );
- 
-   function A_Default_Value return Tagtype_Level_0;
- 
-   procedure Proc_w_Ap_and_Cp( AP : Access_Procedure;
-                               Cp : Tagtype_Level_0 );
-     -- has both access procedure and controlling parameter
- 
-   procedure Proc_w_Ap_and_Cp_w_Def( AP : Access_Procedure := Proc_2'Access;
-                                     Cp : Tagtype_Level_0
-                                        := A_Default_Value );   ------------ z
-     -- has both access procedure and controlling parameter with defaults
- 
-   -- for the objective:
- --     Check that access parameters may be controlling.
- 
-   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_0 );
-     -- has access parameter that is controlling
- 
-   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_0 )
-            return Tagtype_Level_0;
-     -- has access parameter that is controlling, and controlling result
- 
-   Level_0_Global_Object : aliased Tagtype_Level_0
-                         := ( Ch_Item => 'a' );  ---------------------------- a
- 
- end C392010_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body C392010_0 is
- 
-   procedure Proc_1( P: Tagtype_Level_0 ) is
-   begin
-     TCTouch.Touch('A');  --------------------------------------------------- A
-     TCTouch.Touch(P.Ch_Item);  -- depends on the value passed -------------- ?
-   end Proc_1;
- 
-   procedure Proc_2( P: Tagtype_Level_0 ) is
-   begin
-     TCTouch.Touch('B');  --------------------------------------------------- B
-     TCTouch.Touch(P.Ch_Item);  -- depends on the value passed -------------- ?
-   end Proc_2;
- 
-   function A_Default_Value return Tagtype_Level_0 is
-   begin
-     return (Ch_Item => 'z');  ---------------------------------------------- z
-   end A_Default_Value;
- 
-   procedure Proc_w_Ap_and_Cp( Ap : Access_Procedure;
-                               Cp : Tagtype_Level_0 ) is
-   begin
-     TCTouch.Touch('C');  --------------------------------------------------- C
-     Ap.all( Cp );
-   end Proc_w_Ap_and_Cp;
- 
-   procedure Proc_w_Ap_and_Cp_w_Def( AP : Access_Procedure := Proc_2'Access;
-                                     Cp : Tagtype_Level_0
-                                        := A_Default_Value ) is
-   begin
-     TCTouch.Touch('D');  --------------------------------------------------- D
-     Ap.all( Cp );
-   end Proc_w_Ap_and_Cp_w_Def;
- 
-   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_0 ) is
-   begin
-     TCTouch.Touch('E');  --------------------------------------------------- E
-     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
-   end Proc_w_Cp_Ap;
- 
-   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_0 )
-            return Tagtype_Level_0 is
-   begin
-     TCTouch.Touch('F');  --------------------------------------------------- F
-     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
-     return ( Ch_Item => 'b' );  -------------------------------------------- b
-   end Func_w_Cp_Ap_and_Cr;
- 
- end C392010_0;
- 
- ----------------------------------------------------------------- C392010_1
- 
- with C392010_0;
- package C392010_1 is
- 
-   type Tagtype_Level_1 is new C392010_0.Tagtype_Level_0 with record
-     Int_Item : Integer;
-   end record;
- 
-   type Access_Tagtype_Level_1 is access all Tagtype_Level_1'Class;
- 
-   -- the following procedures are inherited by the above declaration:
-   --I   procedure Proc_1( P: Tagtype_Level_1 );
-   --I
-   --I   procedure Proc_2( P: Tagtype_Level_1 );
-   --I
-   --I   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
-   --I                               Cp : Tagtype_Level_1 );
-   --I
-   --I   procedure Proc_w_Ap_and_Cp_w_Def
-   --I             ( AP : C392010_0.Access_Procedure := Proc_2'Access;
-   --I               Cp : Tagtype_Level_1 := A_Default_Value );
-   --I
-   --I   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 );
-   --I
- 
-   -- the following functions become abstract due to the above declaration:
-   --A   function A_Default_Value return Tagtype_Level_1;
-   --A
-   --A   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
-   --A            return Tagtype_Level_1;
- 
-   -- so, in the interest of testing dispatching, we override them all:
-      -- except Proc_1 and Proc_2
- 
-   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
-                               Cp : Tagtype_Level_1 );
- 
-   function A_Default_Value return Tagtype_Level_1;
- 
-   procedure Proc_w_Ap_and_Cp_w_Def(
-               AP : C392010_0.Access_Procedure := C392010_0.Proc_2'Access;
-               Cp : Tagtype_Level_1 := A_Default_Value );
- 
-  procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 );
- 
-   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
-            return Tagtype_Level_1;
- 
-   -- to test the objective:
- --     Check that a subprogram dispatches correctly when it has
- --     access parameters that are not controlling.
- 
-   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_1;
-                         NonCp_Ap : access C392010_0.Tagtype_Level_0
-                              := C392010_0.Level_0_Global_Object'Access );
- 
-   function Func_w_Non( Cp_Ap : access Tagtype_Level_1;
-                     NonCp_Ap : access C392010_0.Tagtype_Level_0
-                              := C392010_0.Level_0_Global_Object'Access )
-            return Access_Tagtype_Level_1;
- 
-   Level_1_Global_Object : aliased Tagtype_Level_1
-                         := ( Int_Item => 0,
-                              Ch_Item  => 'c' );  --------------------------- c
- 
- end C392010_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body C392010_1 is
- 
-   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
-                               Cp : Tagtype_Level_1 ) is
-   begin
-     TCTouch.Touch('G');  --------------------------------------------------- G
-     Ap.All( C392010_0.Tagtype_Level_0( Cp ) );
-   end Proc_w_Ap_and_Cp;
- 
-   procedure Proc_w_Ap_and_Cp_w_Def(
-               AP : C392010_0.Access_Procedure := C392010_0.Proc_2'Access;
-               Cp : Tagtype_Level_1 := A_Default_Value )
-   is
-   begin
-     TCTouch.Touch('H');  --------------------------------------------------- H
-     Ap.All( C392010_0.Tagtype_Level_0( Cp ) );
-   end Proc_w_Ap_and_Cp_w_Def;
- 
-   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 ) is
-   begin
-     TCTouch.Touch('I');  --------------------------------------------------- I
-     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
-   end Proc_w_Cp_Ap;
- 
-   function A_Default_Value return Tagtype_Level_1 is
-   begin
-     return ( Int_Item => 0, Ch_Item  => 'y' );  ---------------------------- y
-   end A_Default_Value;
- 
-   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
-            return Tagtype_Level_1 is
-   begin
-     TCTouch.Touch('J');  --------------------------------------------------- J
-     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
-     return ( Int_Item => 2, Ch_Item => 'd' );  ----------------------------- d
-   end Func_w_Cp_Ap_and_Cr;
- 
-   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_1;
-                         NonCp_Ap : access C392010_0.Tagtype_Level_0
-                           := C392010_0.Level_0_Global_Object'Access ) is
-   begin
-     TCTouch.Touch('K');  --------------------------------------------------- K
-     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
-     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
-   end Proc_w_Non;
- 
-   Own_Item : aliased Tagtype_Level_1 := ( Int_Item => 3, Ch_Item => 'e' );
- 
-   function Func_w_Non( Cp_Ap : access Tagtype_Level_1;
-                     NonCp_Ap : access C392010_0.Tagtype_Level_0
-                              := C392010_0.Level_0_Global_Object'Access )
-            return Access_Tagtype_Level_1 is
-   begin
-     TCTouch.Touch('L');  --------------------------------------------------- L
-     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
-     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
-     return Own_Item'Access;  ----------------------------------------------- e
-   end Func_w_Non;
- 
- end C392010_1;
- 
- 
- 
- ----------------------------------------------------------------- C392010_2
- 
- with C392010_0;
- with C392010_1;
- package C392010_2 is
- 
-   Lev2_Level_0_Global_Object : aliased C392010_0.Tagtype_Level_0
-                         := ( Ch_Item => 'f' );  ---------------------------- f
- 
-   type Tagtype_Level_2 is new C392010_1.Tagtype_Level_1 with record
-     Another_Int_Item : Integer;
-   end record;
- 
-   type Access_Tagtype_Level_2 is access all Tagtype_Level_2;
- 
-   -- the following procedures are inherited by the above declaration:
-   --I   procedure Proc_1( P: Tagtype_Level_2 );
-   --I
-   --I   procedure Proc_2( P: Tagtype_Level_2 );
-   --I
-   --I   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
-   --I                               Cp : Tagtype_Level_2 );
-   --I
-   --I   procedure Proc_w_Ap_and_Cp_w_Def
-   --I             (AP: C392010_0.Access_Procedure := C392010_0. Proc_2'Access;
-   --I              CP: Tagtype_Level_2 := A_Default_Value );
-   --I
-   --I   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_2 );
-   --I
-   --I   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
-   --I                         NonCp_Ap : access C392010_0.Tagtype_Level_0
-   --I                           := C392010_0.Level_0_Global_Object'Access );
- 
-   -- the following functions become abstract due to the above declaration:
-   --A   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
-   --A            return Tagtype_Level_2;
-   --A
-   --A   function A_Default_Value
-   --A            return Access_Tagtype_Level_2;
- 
-   -- so we override the interesting ones to check the objective:
- --     Check that a subprogram with parameters of distinct tagged types may
- --     be primitive for only one type (i.e. the other tagged types must be
- --     declared in other packages).  Check that the subprogram does not
- --     dispatch for the other type(s).
- 
-   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
-                         NonCp_Ap : access C392010_0.Tagtype_Level_0
-                                    := Lev2_Level_0_Global_Object'Access );
- 
-   function Func_w_Non( Cp_Ap : access Tagtype_Level_2;
-                     NonCp_Ap : access C392010_0.Tagtype_Level_0
-                                       := Lev2_Level_0_Global_Object'Access )
-            return C392010_1.Access_Tagtype_Level_1;
- 
-   -- and override the other abstract functions
-   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
-            return Tagtype_Level_2;
- 
-   function A_Default_Value return Tagtype_Level_2;
- 
- end C392010_2;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- with Report;
- package body C392010_2 is
- 
-   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
-                           NonCp_Ap : access C392010_0.Tagtype_Level_0
-                                    := Lev2_Level_0_Global_Object'Access ) is
-   begin
-     TCTouch.Touch('M');  --------------------------------------------------- M
-     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
-     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
-   end Proc_w_Non;
- 
-   function A_Default_Value return Tagtype_Level_2 is
-   begin
-      return ( Another_Int_Item | Int_Item => 0, Ch_Item  => 'x' );  -------- x
-   end A_Default_Value;
- 
-   Own : aliased Tagtype_Level_2
-                  := ( Another_Int_Item | Int_Item => 4, Ch_Item => 'g' );
- 
-   function Func_w_Non( Cp_Ap : access Tagtype_Level_2;
-                              NonCp_Ap : access C392010_0.Tagtype_Level_0
-                                       := Lev2_Level_0_Global_Object'Access )
-            return C392010_1.Access_Tagtype_Level_1 is
-   begin
-     TCTouch.Touch('N');  --------------------------------------------------- N
-     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
-     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
-     return Own'Access;  ---------------------------------------------------- g
-   end Func_w_Non;
- 
-   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
-            return Tagtype_Level_2 is
-   begin
-     TCTouch.Touch('P');  --------------------------------------------------- P
-     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
-     return ( Another_Int_Item | Int_Item => 5, Ch_Item => 'h' );  ---------- h
-  end Func_w_Cp_Ap_and_Cr;
- 
- end C392010_2;
- 
- 
- 
- ------------------------------------------------------------------- C392010
- 
- with Report;
- with TCTouch;
- with C392010_0, C392010_1, C392010_2;
- 
- procedure C392010 is
- 
-   type Access_Class_0 is access all C392010_0.Tagtype_Level_0'Class;
- 
-   -- define an array of class-wide pointers:
-   type Zero_Dispatch_List is array(Natural range <>) of Access_Class_0;
- 
-   Item_0 : aliased C392010_0.Tagtype_Level_0 := ( Ch_Item  => 'k' );  ------ k
-   Item_1 : aliased C392010_1.Tagtype_Level_1 := ( Ch_Item  => 'm',    ------ m
-                                                   Int_Item => 1 );
-   Item_2 : aliased C392010_2.Tagtype_Level_2 := ( Ch_Item  => 'n',    ------ n
-                                                   Int_Item => 1,
-                                                   Another_Int_Item => 1 );
- 
-   Z: Zero_Dispatch_List(1..3) := (Item_0'Access,Item_1'Access,Item_2'Access);
- 
-   procedure Subtest_1( Items: Zero_Dispatch_List ) is
-     -- there is little difference between the actions for _1 and _2 in
-     -- this subtest due to the nature of _2 inheriting most operations
-     --
-     -- this subtest checks operations available to Level_0'Class
-   begin
-     for I in Items'Range loop
- 
-       C392010_0.Proc_w_Ap_and_Cp( C392010_0.Proc_1'Access, Items(I).all );
-       -- CAk, GAm, GAn
-       -- actual is class-wide, operation should dispatch
- 
-       case I is  -- use defaults
-         when 1 => C392010_0.Proc_w_Ap_and_Cp_w_Def;
-                   -- DBz
-         when 2 => C392010_1.Proc_w_Ap_and_Cp_w_Def;
-                   -- HBy
-         when 3 => null; -- Removed following pending resolution by ARG
-                   -- (see AI-00239):
-                   -- C392010_2.Proc_w_Ap_and_Cp_w_Def;
-                   -- HBx
-         when others => Report.Failed("Unexpected loop value");
-       end case;
- 
-       C392010_0.Proc_w_Ap_and_Cp_w_Def   -- override defaults
-                 ( C392010_0.Proc_1'Access, Items(I).all );
-       -- DAk, HAm, HAn
- 
-       C392010_0.Proc_w_Cp_Ap( Items(I) );
-       -- Ek, Im, In
- 
-       -- function return value is controlling for procedure call
-       C392010_0.Proc_w_Ap_and_Cp_w_Def( C392010_0.Proc_1'Access,
-                                   C392010_0.Func_w_Cp_Ap_and_Cr( Items(I) ) );
-       -- FkDAb, JmHAd, PnHAh
-       -- note that the function evaluates first
- 
-     end loop;
-   end Subtest_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   type Access_Class_1 is access all C392010_1.Tagtype_Level_1'Class;
- 
-   type One_Dispatch_List is array(Natural range <>) of Access_Class_1;
- 
-   Object_1 : aliased C392010_1.Tagtype_Level_1 := ( Ch_Item  => 'p',   ----- p
-                                                     Int_Item => 1 );
-   Object_2 : aliased C392010_2.Tagtype_Level_2 := ( Ch_Item  => 'q',   ----- q
-                                                     Int_Item => 1,
-                                             Another_Int_Item => 1 );
- 
-   D: One_Dispatch_List(1..2) := (Object_1'Access, Object_2'Access);
- 
-   procedure Subtest_2( Items: One_Dispatch_List ) is
-     -- this subtest checks operations available to Level_1'Class,
-     -- specifically those operations that are not testable in subtest_1,
-     -- the operations with parameters of the two tagged type objects.
-   begin
-     for I in Items'Range loop
- 
-        C392010_1.Proc_w_Non(                               -- t_1,   t_2
-          C392010_1.Func_w_Non( Items(I),
-            C392010_0.Tagtype_Level_0(Z(I).all)'Access ),   -- Lpk    Nqm
-            C392010_0.Tagtype_Level_0(Z(I+1).all)'Access ); -- Kem    Mgn
- 
-     end loop;
-   end Subtest_2;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C392010", "Check that a subprogram dispatches correctly " &
-                           "with a controlling access parameter. " &
-                           "Check that a subprogram dispatches correctly " &
-                           "when it has access parameters that are not " &
-                           "controlling. Check with and without default " &
-                           "expressions" );
- 
-   Subtest_1( Z );
- 
-   -- Original result:
-   --TCTouch.Validate( "CAkDBzDAkEkFkDAb"
-   --                & "GAmHByHAmImJmHAd"
-   --                & "GAnHBxHAnInPnHAh", "Subtest 1" );
- 
-   -- Result pending resultion of AI-239:
-   TCTouch.Validate( "CAkDBzDAkEkFkDAb"
-                   & "GAmHByHAmImJmHAd"
-                   & "GAnHAnInPnHAh", "Subtest 1" );
- 
-   Subtest_2( D );
- 
-   TCTouch.Validate( "LpkKem" & "NqmMgn", "Subtest 2" );
- 
-   Report.Result;
- 
- end C392010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,299 ****
- -- C392011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that if a function call with a controlling result is itself
- --     a controlling operand of an enclosing call on a dispatching operation,
- --     then its controlling tag value is determined by the controlling tag
- --     value of the enclosing call.
- --
- -- TEST DESCRIPTION:
- --      The test builds and traverses a "ragged" list; a linked list which
- --      contains data elements of three different types (all rooted at
- --      Level_0'Class).  The traversal of this list checks the objective
- --      by calling the dispatching operation "Check" using an item from the
- --      list, and calling the function create; thus causing the controlling
- --      result of the function to be determined by evaluating the value of
- --      the other controlling parameter to the two-parameter Check.
- --
- --
- -- CHANGE HISTORY:
- --      22 SEP 95   SAIC   Initial version
- --      23 APR 96   SAIC   Corrected commentary, differentiated integer.
- --
- --!
- 
- ----------------------------------------------------------------- C392011_0
- 
- package C392011_0 is
- 
-   type Level_0 is tagged record
-     Ch_Item : Character;
-   end record;
- 
-   function Create return Level_0;
-     -- primitive dispatching function
- 
-   procedure Check( Left, Right: in Level_0 );
-     -- has controlling parameters
- 
- end C392011_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body C392011_0 is
- 
-   The_Character : Character := 'A';
- 
-   function Create return Level_0 is
-     Created_Item_0 : constant Level_0 := ( Ch_Item => The_Character );
-   begin
-     The_Character := Character'Succ(The_Character);
-     TCTouch.Touch('A'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- A
-     return Created_Item_0;
-   end Create;
- 
-   procedure Check( Left, Right: in Level_0 ) is
-   begin
-     TCTouch.Touch('B'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- B
-   end Check;
- 
- end C392011_0;
- 
- ----------------------------------------------------------------- C392011_1
- 
- with C392011_0;
- package C392011_1 is
- 
-   type Level_1 is new C392011_0.Level_0 with record
-     Int_Item : Integer;
-   end record;
-   
-   -- note that Create becomes abstract upon this derivation hence:
- 
-   function Create return Level_1;
- 
-   procedure Check( Left, Right: in Level_1 );
- 
- end C392011_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body C392011_1 is
- 
-   Integer_1 : Integer := 0;
- 
-   function Create return Level_1 is
-     Created_Item_1 : constant Level_1
-                    := ( C392011_0.Create with Int_Item => Integer_1 );
-     -- note call to     ^--------------^   -- A
-   begin
-     Integer_1 := Integer'Succ(Integer_1);
-     TCTouch.Touch('C'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- C
-     return Created_Item_1;
-   end Create;
- 
-   procedure Check( Left, Right: in Level_1 ) is
-   begin
-     TCTouch.Touch('D'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- D
-   end Check;
- 
- end C392011_1;
- 
- ----------------------------------------------------------------- C392011_2
- 
- with C392011_1;
- package C392011_2 is
- 
-   type Level_2 is new C392011_1.Level_1 with record
-     Another_Int_Item : Integer;
-   end record;
-   
-   -- note that Create becomes abstract upon this derivation hence:
- 
-   function Create return Level_2;
- 
-   procedure Check( Left, Right: in Level_2 );
- 
- end C392011_2;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body C392011_2 is
- 
-   Integer_2 : Integer := 100;
- 
-   function Create return Level_2 is
-     Created_Item_2 : constant Level_2
-                  := ( C392011_1.Create with Another_Int_Item => Integer_2 );
-     -- note call to   ^--------------^   -- AC
-   begin
-     Integer_2 := Integer'Succ(Integer_2);
-     TCTouch.Touch('E'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- E
-     return Created_Item_2;
-   end Create;
- 
-   procedure Check( Left, Right: in Level_2 ) is
-   begin
-     TCTouch.Touch('F'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- F
-   end Check;
- 
- end C392011_2;
- 
- ------------------------------------------------------- C392011_2.C392011_3
- 
- with C392011_0;
- package C392011_2.C392011_3 is
- 
-   type Wide_Reference is access all C392011_0.Level_0'Class;
- 
-   type Ragged_Element;
- 
-   type List_Pointer is access Ragged_Element;
- 
-   type Ragged_Element is record
-     Data : Wide_Reference;
-     Next : List_Pointer;
-   end record;
- 
-   procedure Build_List;
- 
-   procedure Traverse_List;
- 
- end C392011_2.C392011_3;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C392011_2.C392011_3 is
- 
-   The_List : List_Pointer;
- 
-   procedure Build_List is
-   begin
- 
-     -- build a list that looks like:
-     -- Level_2, Level_1, Level_2, Level_1, Level_0
-     --
-     -- the mechanism is to create each object, "pushing" the existing list
-     -- onto the end: cons( new_item, car, cdr )
- 
-     The_List := 
-         new Ragged_Element'( new C392011_0.Level_0'(C392011_0.Create), null );
-     -- Level_0                                                            >> A
- 
-     The_List := 
-     new Ragged_Element'( new C392011_1.Level_1'(C392011_1.Create), The_List );
-     -- Level_1 -> Level_0                                                >> AC
- 
-     The_List := 
-     new Ragged_Element'( new C392011_2.Level_2'(C392011_2.Create), The_List );
-     -- Level_2 -> Level_1 -> Level_0                                    >> ACE
- 
-     The_List := 
-     new Ragged_Element'( new C392011_1.Level_1'(C392011_1.Create), The_List );
-     -- Level_1 -> Level_2 -> Level_1 -> Level_0                          >> AC
- 
-     The_List := 
-     new Ragged_Element'( new C392011_2.Level_2'(C392011_2.Create), The_List );
-     -- Level_2 -> Level_1 -> Level_2 -> Level_1 -> Level_0              >> ACE
- 
-   end Build_List;
- 
-   procedure Traverse_List is
- 
-     Next_Item : List_Pointer := The_List;
- 
-   -- Check that if a function call with a controlling result is itself
-   -- a controlling operand of an enclosing call on a dispatching operation,
-   -- then its controlling tag value is determined by the controlling tag
-   -- value of the enclosing call.
- 
-   -- Level_2 -> Level_1 -> Level_2 -> Level_1 -> Level_0
- 
-   begin
- 
-     while Next_Item /= null loop  -- here we go!
-       -- these calls better dispatch according to the value in the particular
-       -- list item; causing the call to create to dispatch accordingly.
-       -- why do it twice?  To make sure order makes no difference
- 
-       C392011_0.Check(Next_Item.Data.all, C392011_0.Create);
-       -- Create will touch first, then Check touches
- 
-       C392011_0.Check(C392011_0.Create, Next_Item.Data.all); 
- 
-       -- Here's what's s'pos'd to 'appen:
-       -- Check( Lev_2, Create ) >> ACEF
-       -- Check( Create, Lev_2 ) >> ACEF
-       -- Check( Lev_1, Create ) >> ACD
-       -- Check( Create, Lev_1 ) >> ACD
-       -- Check( Lev_2, Create ) >> ACEF
-       -- Check( Create, Lev_2 ) >> ACEF
-       -- Check( Lev_1, Create ) >> ACD
-       -- Check( Create, Lev_1 ) >> ACD
-       -- Check( Lev_0, Create ) >> AB
-       -- Check( Create, Lev_0 ) >> AB
- 
-       Next_Item := Next_Item.Next;   
-     end loop;
-   end Traverse_List;
- 
- end C392011_2.C392011_3;
- 
- ------------------------------------------------------------------- C392011
- 
- with Report;
- with TCTouch;
- with C392011_2.C392011_3;
- 
- procedure C392011 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C392011", "Check that if a function call with a " &
-                           "controlling result is itself a controlling " &
-                           "operand of an enclosing call on a dispatching " &
-                           "operation, then its controlling tag value is " &
-                           "determined by the controlling tag value of " &
-                           "the enclosing call" );
- 
-   C392011_2.C392011_3.Build_List;
-   TCTouch.Validate( "A" & "AC" & "ACE" & "AC" & "ACE", "Build List" );
- 
-   C392011_2.C392011_3.Traverse_List;
-   TCTouch.Validate( "ACEFACEF" & 
-                     "ACDACD" &  
-                     "ACEFACEF" &  
-                     "ACDACD" &  
-                     "ABAB",
-                     "Traverse List" );
- 
-   Report.Result;
- 
- end C392011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,179 ****
- -- C392013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that the "/=" implicitly declared with the declaration of "=" for
- --    a tagged type is legal and can be used in a dispatching call.
- --    (Defect Report 8652/0010, as reflected in Technical Corrigendum 1).
- --
- -- CHANGE HISTORY:
- --    23 JAN 2001   PHL   Initial version.
- --    16 MAR 2001   RLB   Readied for release; added identity and negative
- --                        result cases.
- --    24 MAY 2001   RLB   Corrected the result for the 9 vs. 9 case.
- --!
- with Report;
- use Report;
- procedure C392013 is
- 
-     package P1 is
-         type T is tagged
-             record
-                 C1 : Integer;
-             end record;
-         function "=" (L, R : T) return Boolean;
-     end P1;
- 
-     package P2 is
-         type T is new P1.T with private;
-         function Make (Ancestor : P1.T; X : Float) return T;
-     private
-         type T is new P1.T with
-             record
-                 C2 : Float;
-             end record;
-         function "=" (L, R : T) return Boolean;
-     end P2;
- 
-     package P3 is
-         type T is new P2.T with
-             record
-                 C3 : Character;
-             end record;
-     private
-         function "=" (L, R : T) return Boolean;
-         function Make (Ancestor : P1.T; X : Float) return T;
-     end P3;
- 
- 
-     package body P1 is separate;
-     package body P2 is separate;
-     package body P3 is separate;
- 
- 
-     type Cwat is access P1.T'Class;
-     type Cwat_Array is array (Positive range <>) of Cwat;
- 
-     A : constant Cwat_Array :=
-        (1 => new P1.T'(C1 => Ident_Int (3)),
-         2 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 4.0)),
-         3 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (-5)), X => 4.2)),
-         4 => new P1.T'(C1 => Ident_Int (-3)),
-         5 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 3.6)),
-         6 => new P1.T'(C1 => Ident_Int (4)),
-         7 => new P3.T'(P2.Make
-                           (Ancestor => (C1 => Ident_Int (4)), X => 1.2) with
-                        Ident_Char ('a')),
-         8 => new P3.T'(P2.Make
-                           (Ancestor => (C1 => Ident_Int (-4)), X => 1.3) with
-                        Ident_Char ('A')),
-         9 => new P3.T'(P2.Make
-                           (Ancestor => (C1 => Ident_Int (4)), X => 1.0) with
-                        Ident_Char ('B')));
- 
-     type Truth is ('F', 'T');
-     type Truth_Table is array (Positive range <>, Positive range <>) of Truth;
- 
-     Equality : constant Truth_Table (A'Range, A'Range) := ("TFFTFFFFF",
-                                                            "FTTFTFFFF",
-                                                            "FTTFFFFFF",
-                                                            "TFFTFFFFF",
-                                                            "FTFFTFFFF",
-                                                            "FFFFFTFFF",
-                                                            "FFFFFFTTF",
-                                                            "FFFFFFTTF",
-                                                            "FFFFFFFFT");
- 
- begin
-     Test ("C392013", "Check that the ""/="" implicitly declared " &
-                         "with the declaration of ""="" for a tagged " &
-                         "type is legal and can be used in a dispatching call");
- 
-     for I in A'Range loop
-         for J in A'Range loop
- 	    -- Test identity:
-             if P1."=" (A (I).all, A (J).all) /=
-                   (not P1."/=" (A (I).all, A (J).all)) then
-                 Failed ("Incorrect identity comparing objects" &
-                         Positive'Image (I) & " and" & Positive'Image (J));
-             end if;
-             -- Test the result of "/=":
-             if Equality (I, J) = 'T' then
-                 if P1."/=" (A (I).all, A (J).all) then
-                     Failed ("Incorrect result comparing objects" &
-                            Positive'Image (I) & " and" & Positive'Image (J) & " - T");
-                 end if;
-             else
-                 if not P1."/=" (A (I).all, A (J).all) then
-                     Failed ("Incorrect result comparing objects" &
-                            Positive'Image (I) & " and" & Positive'Image (J) & " - F");
-                 end if;
-             end if;
-         end loop;
-     end loop;
- 
-     Result;
- end C392013;
- separate (C392013)
- package body P1 is
- 
-     function "=" (L, R : T) return Boolean is
-     begin
-         return abs L.C1 = abs R.C1;
-     end "=";
- 
- end P1;
- separate (C392013)
- package body P2 is
- 
-     function "=" (L, R : T) return Boolean is
-     begin
-         return P1."=" (P1.T (L), P1.T (R)) and then abs (L.C2 - R.C2) <= 0.5;
-     end "=";
- 
- 
-     function Make (Ancestor : P1.T; X : Float) return T is
-     begin
-         return (Ancestor with X);
-     end Make;
- 
- end P2;
- with Ada.Characters.Handling;
- separate (C392013)
- package body P3 is
- 
-     function "=" (L, R : T) return Boolean is
-     begin
-         return P2."=" (P2.T (L), P2.T (R)) and then
-                   Ada.Characters.Handling.To_Upper (L.C3) =
-                      Ada.Characters.Handling.To_Upper (R.C3);
-     end "=";
- 
-     function Make (Ancestor : P1.T; X : Float) return T is
-     begin
-         return (P2.Make (Ancestor, X) with ' ');
-     end Make;
- 
- end P3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,227 ****
- -- C392014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that objects designated by X'Access (where X is of a class-wide
- --    type) and new T'Class'(...) are dynamically tagged and can be used in
- --    dispatching calls.  (Defect Report 8652/0010).
- --
- -- CHANGE HISTORY:
- --    18 JAN 2001   PHL   Initial version
- --    15 MAR 2001   RLB   Readied for release.
- --    03 JUN 2004   RLB   Removed constraint for S0, as the subtype has
- --                        unknown discriminants.
- 
- --!
- package C392014_0 is
- 
-     type T (D : Integer) is abstract tagged private;
- 
-     procedure P (X : access T) is abstract;
-     function Create (X : Integer) return T'Class;
- 
-     Result : Natural := 0;
- 
- private
-     type T (D : Integer) is abstract tagged null record;
- end C392014_0;
- 
- with C392014_0;
- package C392014_1 is
-     type T is new C392014_0.T with private;
-     function Create (X : Integer) return T'Class;
- private
-     type T is new C392014_0.T with
- 	record
- 	    C1 : Integer;
- 	end record;
-     procedure P (X : access T);
- end C392014_1;
- 
- package C392014_1.Child is
-     type T is new C392014_1.T with private;
-     procedure P (X : access T);
-     function Create (X : Integer) return T'Class;
- private
-     type T is new C392014_1.T with
- 	record
- 	    C1C : Integer;
- 	end record;
- end C392014_1.Child;
- 
- with Report;
- use Report;
- with C392014_1.Child;
- package body C392014_1 is
- 
-     procedure P (X : access T) is
-     begin
- 	C392014_0.Result := C392014_0.Result + X.D + X.C1;
-     end P;
- 
-     function Create (X : Integer) return T'Class is
-     begin
- 	case X mod Ident_Int (2) is
- 	    when 0 =>
- 		return C392014_1.Child.Create (X / Ident_Int (2));
- 	    when 1 =>
- 		declare
- 		    Y : T (D => (X / Ident_Int (2)) mod Ident_Int (20));
- 		begin
- 		    Y.C1 := X / Ident_Int (40);
- 		    return T'Class (Y);
- 		end;
- 	    when others =>
- 		null;
- 	end case;
-     end Create;
- 
- end C392014_1;
- 
- with C392014_0;
- with C392014_1;
- package C392014_2 is
-     type T is new C392014_0.T with private;
-     function Create (X : Integer) return T'Class;
- private
-     type T is new C392014_1.T with
- 	record
- 	    C2 : Integer;
- 	end record;
-     procedure P (X : access T);
- end C392014_2;
- 
- with Report;
- use Report;
- with C392014_1.Child;
- with C392014_2;
- package body C392014_0 is
- 
-     function Create (X : Integer) return T'Class is
-     begin
- 	case X mod 3 is
- 	    when 0 =>
- 		return C392014_1.Create (X / Ident_Int (3));
- 	    when 1 =>
- 		return C392014_1.Child.Create (X / Ident_Int (3));
- 	    when 2 =>
- 		return C392014_2.Create (X / Ident_Int (3));
- 	    when others =>
- 		null;
- 	end case;
-     end Create;
- 
- end C392014_0;
- 
- with Report;
- use Report;
- with C392014_0;
- package body C392014_1.Child is
- 
-     procedure P (X : access T) is
-     begin
- 	C392014_0.Result := C392014_0.Result + X.D + X.C1 + X.C1C;
-     end P;
- 
-     function Create (X : Integer) return T'Class is
- 	Y : T (D => X mod Ident_Int (20));
-     begin
- 	Y.C1 := (X / Ident_Int (20)) mod Ident_Int (20);
- 	Y.C1C := X / Ident_Int (400);
- 	return T'Class (Y);
-     end Create;
- 
- end C392014_1.Child;
- 
- with Report;
- use Report;
- package body C392014_2 is
- 
-     procedure P (X : access T) is
-     begin
- 	C392014_0.Result := C392014_0.Result + X.D + X.C2;
-     end P;
- 
-     function Create (X : Integer) return T'Class is
- 	Y : T (D => X mod Ident_Int (20));
-     begin
- 	Y.C2 := X / Ident_Int (600);
- 	return T'Class (Y);
-     end Create;
- 
- end C392014_2;
- 
- with Report;
- use Report;
- with C392014_0;
- with C392014_1.Child;
- with C392014_2;
- procedure C392014 is
- 
-     subtype S0 is C392014_0.T'Class;
-     subtype S1 is C392014_1.T'Class;
- 
-     X0 : aliased C392014_0.T'Class := C392014_0.Create (Ident_Int (5218));
-     X1 : aliased C392014_1.T'Class := C392014_1.Create (Ident_Int (8253));
- 
-     Y0 : aliased S0 := C392014_0.Create (Ident_Int (2693));
-     Y1 : aliased S1 := C392014_1.Create (Ident_Int (5622));
- 
-     procedure TC_Check (Subtest : String; Expected : Integer) is
-     begin
- 	if C392014_0.Result = Expected then
- 	    Comment ("Subtest " & Subtest & " Passed");
- 	else
- 	    Failed ("Subtest " & Subtest & " Failed");
- 	end if;
- 	C392014_0.Result := Ident_Int (0);
-     end TC_Check;
- 
- begin
-     Test ("C392014",
- 	  "Check that objects designated by X'Access " &
- 	     "(where X is of a class-wide type) and New T'Class'(...) " &
- 	     "are dynamically tagged and can be used in dispatching " &
- 	     "calls");
- 
-     C392014_0.P (X0'Access);
-     TC_Check ("X0'Access", Ident_Int (29));
-     C392014_0.P (new C392014_0.T'Class'(C392014_0.Create (Ident_Int (12850))));
-     TC_Check ("New C392014_0.T'Class", Ident_Int (27));
-     C392014_1.P (X1'Access);
-     TC_Check ("X1'Access", Ident_Int (212));
-     C392014_1.P (new C392014_1.T'Class'(C392014_1.Create (Ident_Int (2031))));
-     TC_Check ("New C392014_1.T'Class", Ident_Int (65));
-     C392014_0.P (Y0'Access);
-     TC_Check ("Y0'Access", Ident_Int (18));
-     C392014_0.P (new S0'(C392014_0.Create (Ident_Int (6893))));
-     TC_Check ("New S0", Ident_Int (20));
-     C392014_1.P (Y1'Access);
-     TC_Check ("Y1'Access", Ident_Int (18));
-     C392014_1.P (new S1'(C392014_1.Create (Ident_Int (1861))));
-     TC_Check ("New S1", Ident_Int (56));
- 
-     Result;
- end C392014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,265 ****
- -- C392A01.A
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- OBJECTIVE:
-  --      Check that the use of a class-wide formal parameter allows for the 
-  --      proper dispatching of objects to the appropriate implementation of 
-  --      a primitive operation.  Check this for the root tagged type defined
-  --      in a package, and the extended type is defined in that same package.
-  --
-  -- TEST DESCRIPTION:
-  --      Declare a root tagged type, and some associated primitive operations.
-  --      Extend the root type, and override one or more primitive operations, 
-  --      inheriting the other primitive operations from the root type.
-  --      Derive from the extended type, again overriding some primitive
-  --      operations and inheriting others (including some that the parent 
-  --      inherited).
-  --      Define a subprogram with a class-wide parameter, inside of which is a 
-  --      call on a dispatching primitive operation.  These primitive operations
-  --      modify global variables (the class-wide parameter has mode IN).
-  --     
-  --     
-  --     
-  -- The following hierarchy of tagged types and primitive operations is 
-  -- utilized in this test:
-  --
-  --    type Bank_Account (root)
-  --            |
-  --            | Operations
-  --            |   Increment_Bank_Reserve
-  --            |   Assign_Representative
-  --            |   Increment_Counters
-  --            |   Open
-  --            |
-  --    type Savings_Account (extended from Bank_Account)
-  --            |
-  --            | Operations
-  --            |   (Increment_Bank_Reserve) (inherited)
-  --            |   Assign_Representative    (overridden)
-  --            |   Increment_Counters       (overridden)
-  --            |   Open                     (overridden)
-  --            |
-  --    type Preferred_Account (extended from Savings_Account)
-  --            |
-  --            | Operations
-  --            |   (Increment_Bank_Reserve) (inherited twice - Bank_Acct.)
-  --            |   (Assign_Representative)  (inherited - Savings_Acct.)
-  --            |   Increment_Counters       (overridden)
-  --            |   Open                     (overridden)
-  -- 
-  --
-  -- In this test, we are concerned with the following selection of dispatching
-  -- calls, accomplished with the use of a Bank_Account'Class IN procedure 
-  -- parameter :
-  --
-  --                       \ Type
-  --               Prim. Op \  Bank_Account  Savings_Account Preferred_Account
-  --                         \------------------------------------------------ 
-  --   Increment_Bank_Reserve|      X               X               X
-  --   Assign_Representative |                      X
-  --   Increment_Counters    |      X               X               X
-  --
-  --
-  --
-  -- The location of the declaration and derivation of the root and extended
-  -- types will be varied over a series of tests.  Locations of declaration
-  -- and derivation for a particular test are marked with an asterisk (*).
-  --
-  -- Root type:
-  --       
-  --    *  Declared in package.
-  --       Declared in generic package.
-  --
-  -- Extended types:
-  --
-  --    *  Derived in parent location.
-  --       Derived in a nested package.
-  --       Derived in a nested subprogram.
-  --       Derived in a nested generic package.
-  --       Derived in a separate package.
-  --       Derived in a separate visible child package.
-  --       Derived in a separate private child package.
-  --
-  -- Primitive Operations:
-  --
-  --    *  Procedures with same parameter profile.
-  --       Procedures with different parameter profile.
-  --       Functions with same parameter profile.
-  --       Functions with different parameter profile.
-  --       Mixture of Procedures and Functions.
-  --
-  --
-  -- TEST FILES:
-  --      This test depends on the following foundation code:
-  --
-  --         F392A00.A
-  --
-  --      The following files comprise this test:
-  --
-  --      => C392A01.A
-  --
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  with F392A00;         -- package Accounts
-  with Report;
-  
-  procedure C392A01 is
-  
-     package Accounts renames F392A00;
-  
-     -- Declare account objects.
-  
-     B_Account : Accounts.Bank_Account;
-     S_Account : Accounts.Savings_Account;
-     P_Account : Accounts.Preferred_Account;
-  
-     -- Procedures to operate on accounts.
-     -- Each uses a class-wide IN parameter, as well as a call to a
-     -- dispatching operation.
-  
-     -- Procedure Tabulate_Account performs a dispatching call on a primitive
-     -- operation that has been overridden for each of the extended types.
-  
-     procedure Tabulate_Account (Acct : in Accounts.Bank_Account'Class) is
-     begin
-        Accounts.Increment_Counters (Acct);   -- Dispatch according to tag.
-     end Tabulate_Account;
-  
-  
-     -- Procedure Accumulate_Reserve performs a dispatching call on a
-     -- primitive operation that has been defined for the root type and 
-     -- inherited by each derived type.
-  
-     procedure Accumulate_Reserve (Acct : in Accounts.Bank_Account'Class) is
-     begin
-        Accounts.Increment_Bank_Reserve (Acct);   -- Dispatch according to tag.
-     end Accumulate_Reserve;
-  
-  
-     -- Procedure Resolve_Dispute performs a dispatching call on a primitive
-     -- operation that has been defined in the root type, overridden in the
-     -- first derived extended type, and inherited by the subsequent extended
-     -- type.
-  
-     procedure Resolve_Dispute (Acct : in Accounts.Bank_Account'Class) is
-     begin
-        Accounts.Assign_Representative (Acct);   -- Dispatch according to tag.
-     end Resolve_Dispute;
-  
-  
-  
-  begin  -- Main test procedure.
-  
-     Report.Test ("C392A01", "Check that the use of a class-wide parameter "   &
-                              "allows for proper dispatching where root type " &
-                              "and extended types are declared in the same "   &
-                              "package" );
-     
-     Bank_Account_Subtest:
-     declare
-       use Accounts;
-     begin
-        Accounts.Open (B_Account);
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been defined for this specific type.
-        Accumulate_Reserve (Acct => B_Account);
-        Tabulate_Account (B_Account);
-  
-        if (Accounts.Bank_Reserve /= Accounts.Opening_Balance) or
-           (Accounts.Number_Of_Accounts (Bank) /= 1)           or
-           (Accounts.Number_Of_Accounts (Total) /= 1)
-        then
-           Report.Failed ("Failed in Bank_Account_Subtest");
-        end if;
-  
-     end Bank_Account_Subtest;
-  
-  
-     Savings_Account_Subtest:
-     declare
-       use Accounts;
-     begin
-        Accounts.Open (Acct => S_Account);
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been inherited by this extended type.
-        Accumulate_Reserve (Acct => S_Account);
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been overridden for this extended type.
-        Resolve_Dispute  (Acct => S_Account);
-        Tabulate_Account (S_Account);
-  
-        if Accounts.Bank_Reserve /= (3.0 * Accounts.Opening_Balance) or
-           Accounts.Daily_Representative /= Accounts.Manager         or
-           Accounts.Number_Of_Accounts (Savings) /= 1                or
-           Accounts.Number_Of_Accounts (Total) /= 2
-        then
-           Report.Failed ("Failed in Savings_Account_Subtest");
-        end if;
-  
-     end Savings_Account_Subtest;
-  
-  
-     Preferred_Account_Subtest:
-     declare
-       use Accounts;
-     begin
-        Accounts.Open (P_Account);
-  
-        -- Verify that the correct implementation of Open (overridden) was 
-        -- used for the Preferred_Account object.
-        if not Accounts.Verify_Open (P_Account) then
-           Report.Failed ("Incorrect values for init. Preferred Acct object");
-        end if;
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been twice inherited by this extended type.
-        Accumulate_Reserve (Acct => P_Account);
-  
-        -- Demonstrate class-wide parameter allowing dispatch by a primitive
-        -- operation that has been overridden for this extended type (the
-        -- operation was overridden by its parent type as well).
-        Tabulate_Account (P_Account);
-        
-        if Accounts.Bank_Reserve /= 1300.00             or
-           Accounts.Number_Of_Accounts (Preferred) /= 1 or
-           Accounts.Number_Of_Accounts (Total) /= 3
-        then
-           Report.Failed ("Failed in Preferred_Account_Subtest");
-        end if;
-  
-     end Preferred_Account_Subtest;
-  
-  
-     Report.Result;
-  
-  end C392A01;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392c05.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392c05.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392c05.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392c05.a	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C392C05.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that for a call to a dispatching subprogram the subprogram
- --     body which is executed is determined by the controlling tag for
- --     the case where the call has statically tagged controlling operands
- --     of the type T.  Check this for various operands of tagged types:
- --     objects (declared or allocated), formal parameters, view conversions,
- --     function calls (both primitive and non-primitive).
- --
- -- TEST DESCRIPTION:
- --      This test uses foundation F392C00 to test the usages of statically
- --      tagged objects and values.  The calls to Validate indicate the
- --      expected sequence of procedure calls since the previous call to
- --      Validate.  Static tags can be determined at compile time, and
- --      hence this is a test of correct overload resolution for tagged types.
- --      A clever compiler which unrolls loops and does path analysis on
- --      access values will be able to perform the same kind of determination
- --      for all of the code in this test.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F392C00.A   (foundation code)
- --         C392C05.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --      24 Oct 95   SAIC    Updated for ACVC 2.0.1
- --      13 Feb 97   PWB.CTA Corrected assumption that "or" operands are
- --                          evaluated in textual order.
- --!
- 
- with Report;
- with TCTouch;
- with F392C00_1;
- procedure C392C05 is -- Hardware_Store
- 
-   package Switch renames F392C00_1;
- 
-   subtype Switch_Class is Switch.Toggle'Class;
- 
-   type Reference is access all Switch_Class;
- 
-   A_Switch   : aliased Switch.Toggle;
-   A_Dimmer   : aliased Switch.Dimmer;
-   An_Autodim : aliased Switch.Auto_Dimmer;
- 
-   type Light_Bank is array(Positive range <>) of Reference;
- 
-   Lamps : Light_Bank(1..3);
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C392C05", "Check that a dispatching subprogram call is "
-                         & "determined by the controlling tag for statically "
-                         & "tagged controlling operands" );
- 
- -- Check use of static tagged declared objects,
- --   and static tagged formal parameters
- -- Must call correct version of flip based on type of controlling op.
- 
- -- Turn on the lights!
- 
-   Switch.Flip( A_Switch );
-   TCTouch.Validate( "A", "Declared Toggle" );
- 
-   Switch.Flip( A_Dimmer );
-   TCTouch.Validate( "GBA", "Declared Dimmer" );
- 
-   Switch.Flip( An_Autodim );
-   TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" );
- 
-   Lamps(1) := new Switch.Toggle;
-   Lamps(2) := new Switch.Dimmer;
-   Lamps(3) := new Switch.Auto_Dimmer;
- 
- -- Check use of static tagged allocated objects,
- --   and static tagged formal parameters in a loop which may dynamically
- --   dispatch.  If an optimizer unrolls the loop, it may then be statically
- --   determined, and no dispatching will occur.  Either interpretation is
- --   correct.
-   for Knob in Lamps'Range loop
-     Switch.Flip( Lamps(Knob).all );
-   end loop;
-   TCTouch.Validate( "AGBAKGBA", "Allocated Objects" );
- 
- -- Check use of static tagged declared objects,
- --   calling non-primitive functions.
-   if not Switch.TC_Non_Disp( A_Switch ) then
-     Report.Failed( "Bad Value 1" );
-   end if;
-   TCTouch.Validate( "X", "Nonprimitive Function" );
- 
-   if not Switch.TC_Non_Disp( A_Dimmer ) then
-     Report.Failed( "Bad Value 2" );
-   end if;
-   TCTouch.Validate( "Y", "Nonprimitive Function" );
- 
-   if not Switch.TC_Non_Disp( An_Autodim ) then
-     Report.Failed( "Bad Value 3" );
-   end if;
-   TCTouch.Validate( "Z", "Nonprimitive Function" );
- 
-   A_Switch   := Switch.Create;
-   A_Dimmer   := Switch.Create;
-   An_Autodim := Switch.Create;
-   TCTouch.Validate( "123", "Primitive Function" );
- 
- -- View conversions
-   Switch.Brighten( An_Autodim, 50 ); 
- 
-   Switch.Flip( Switch.Toggle( A_Switch ) );
-   Switch.Flip( Switch.Toggle( A_Dimmer ) );
-   Switch.Flip( Switch.Dimmer( An_Autodim ) );
-   TCTouch.Validate( "DAAGBA", "View Conversions" );
- 
- -- statically tagged controlling operands (specific types) provided to
- -- class-wide functions
-   if Switch.On( A_Switch )
-      or Switch.On( A_Dimmer )
-      or Switch.On( An_Autodim ) then
-     Report.Failed( "Bad Value 4" );
-   end if;
-   TCTouch.Validate( "BBB", "Class-wide" );
- 
- -- statically tagged controlling operands qualified expressions provided to
- -- primitive functions, also using context to determine call to a
- -- class-wide function.
-   if Switch.Off( Switch.Toggle'( Switch.Create ) )
-      or else Switch.Off( Switch.Dimmer'( Switch.Create ) )
-      or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then
-     Report.Failed( "Bad Value 5" );
-   end if;
-   TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" );
- 
-   Report.Result;
- 
- end C392C05;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392c07.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392c07.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392c07.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392c07.a	Thu Jan  1 00:00:00 1970
***************
*** 1,190 ****
- -- C392C07.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that for a call to a dispatching subprogram the subprogram
- --     body which is executed is determined by the controlling tag for
- --     the case where the call has dynamic tagged controlling operands
- --     of the type T.  Check for calls to these same subprograms where
- --     the operands are of specific statically tagged types:
- --     objects (declared or allocated), formal parameters, view
- --     conversions, and function calls (both primitive and non-primitive).
- --
- -- TEST DESCRIPTION:
- --      This test uses foundation F392C00 to test the usages of statically
- --      tagged objects and values.  This test is derived in part from
- --      C392C05.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      24 Oct 95   SAIC    Updated for ACVC 2.0.1
- --
- --!
- 
- with Report;
- with TCTouch;
- with F392C00_1;
- procedure C392C07 is -- Hardware_Store
-   package Switch renames F392C00_1;
- 
-   subtype Switch_Class is Switch.Toggle'Class;
- 
-   type Reference is access all Switch_Class;
- 
-   A_Switch   : aliased Switch.Toggle;
-   A_Dimmer   : aliased Switch.Dimmer;
-   An_Autodim : aliased Switch.Auto_Dimmer;
- 
-   type Light_Bank is array(Positive range <>) of Reference;
- 
-   Lamps : Light_Bank(1..3);
- 
- -- dynamically tagged controlling operands : class wide formal parameters
-   procedure Clamp( Device : in out Switch_Class; On : Boolean := False ) is
-   begin
-     if Switch.On( Device ) /= On then                  
-       Switch.Flip( Device );                           
-     end if;
-   end Clamp;
-   function Class_Item(Bank_Pos: Positive) return Switch_Class is
-   begin
-     return Lamps(Bank_Pos).all;
-   end Class_Item;
- 
- begin  -- Main test procedure.
-   Report.Test ("C392C07", "Check that a dispatching subprogram call is "
-                         & "determined by the controlling tag for "
-                         & "dynamically tagged controlling operands" );
- 
-   Lamps := ( A_Switch'Access, A_Dimmer'Access, An_Autodim'Access );
- 
- -- dynamically tagged operands referring to
- -- statically tagged declared objects
-   for Knob in Lamps'Range loop
-     Clamp( Lamps(Knob).all, On => True );
-   end loop;
-   TCTouch.Validate( "BABGBABKGBA", "Clamping On Lamps" );
- 
-   Lamps(1) := new Switch.Toggle;
-   Lamps(2) := new Switch.Dimmer;
-   Lamps(3) := new Switch.Auto_Dimmer;
- 
- -- turn the full bank of switches ON
- -- dynamically tagged allocated objects
-   for Knob in Lamps'Range loop
-     Clamp( Lamps(Knob).all, On => True );
-   end loop;
-   TCTouch.Validate( "BABGBABKGBA", "Dynamic Allocated");
- 
- -- Double check execution correctness
-   if Switch.Off( Lamps(1).all )
-      or Switch.Off( Lamps(2).all )
-      or Switch.Off( Lamps(3).all ) then
-     Report.Failed( "Bad Value" );
-   end if;
-   TCTouch.Validate( "CCC", "Class-wide");
- 
- -- turn the full bank of switches OFF
-   for Knob in Lamps'Range loop
-     Switch.Flip( Lamps(Knob).all );
-   end loop;
-   TCTouch.Validate( "AGBAKGBA", "Dynamic Allocated, Primitive Ops");
- 
- -- check switches for OFF
- -- a few function calls as operands
-   for Knob in Lamps'Range loop
-     if not Switch.Off( Class_Item(Knob) ) then
-       Report.Failed("At function tests, Switch not OFF");
-     end if;
-   end loop;
-   TCTouch.Validate( "CCC",
-                          "Using function returning class-wide type");
- 
- -- Switches are all OFF now.
- -- dynamically tagged view conversion
-   Clamp( Switch_Class( A_Switch ) );         
-   Clamp( Switch_Class( A_Dimmer ) );         
-   Clamp( Switch_Class( An_Autodim ) );       
-   TCTouch.Validate( "BABGBABKGBA", "View Conversions" );
- 
- -- dynamically tagged controlling operands : declared class wide objects
- --  calling primitive functions
-   declare
-     Dine_O_Might : Switch_Class := Switch.TC_CW_TI( 't' );  
-   begin
-     Switch.Flip( Dine_O_Might );                            
-     if Switch.On( Dine_O_Might ) then                       
-       Report.Failed( "Exploded at Dine_O_Might" );
-     end if;
-     TCTouch.Validate( "WAB", "Dispatching function 1" );
-   end;
- 
-   declare
-     Dyne_A_Mite : Switch_Class := Switch.TC_CW_TI( 'd' );   
-   begin
-     Switch.Flip( Dyne_A_Mite );                             
-     if Switch.On( Dyne_A_Mite ) then                        
-       Report.Failed( "Exploded at Dyne_A_Mite" );
-     end if;
-     TCTouch.Validate( "WGBAB", "Dispatching function 2" );
-   end;
- 
-   declare
-     Din_Um_Out : Switch_Class := Switch.TC_CW_TI( 'a' );    
-   begin
-     Switch.Flip( Din_Um_Out );                              
-     if Switch.Off( Din_Um_Out ) then                        
-       Report.Failed( "Exploded at Din_Um_Out" );
-     end if;
-     TCTouch.Validate( "WKCC", "Dispatching function 3" );
- 
- -- Non-dispatching function calls.
-     if not Switch.TC_Non_Disp( Switch.Toggle( Din_Um_Out ) ) then
-       Report.Failed( "Non primitive, via view conversion" );
-     end if;
-     TCTouch.Validate( "X", "View Conversion 1" );
- 
-     if not Switch.TC_Non_Disp( Switch.Dimmer( Din_Um_Out ) ) then
-       Report.Failed( "Non primitive, via view conversion" );
-     end if;
-     TCTouch.Validate( "Y", "View Conversion 2" );
-   end;
- 
-   -- a few more function calls as operands (oops)
-   if not Switch.On( Switch.Toggle'( Switch.Create ) ) then 
-     Report.Failed("Toggle did not create ""On""");
-   end if;
- 
-   if Switch.Off( Switch.Dimmer'( Switch.Create ) ) then 
-     Report.Failed("Dimmer created ""Off""");
-   end if;
- 
-   if Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then 
-     Report.Failed("Auto_Dimmer created ""Off""");
-   end if;
- 
-   Report.Result;
- end C392C07;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392d01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392d01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392d01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392d01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,324 ****
- -- C392D01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for an implicitly declared dispatching operation that is
- --      overridden, the body executed is the body for the overriding
- --      subprogram, even if the overriding occurs in a private part.
- --      Check that, for an implicitly declared dispatching operation that is
- --      NOT overridden, the body executed is the body of the corresponding
- --      subprogram of the parent type.
- --
- --      Check for the case where the overriding (and non-overriding) operations
- --      are declared for a private extension (and its full type) in a public
- --      child unit of the package declaring the ancestor type, and the ancestor
- --      type is a tagged private type whose full view is itself a derived type.
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      package Parent is
- --         type Root is tagged ...
- --         procedure Vis_Op (P: Root);
- --      private
- --         procedure Pri_Op (P: Root);                     -- (A)
- --      end Parent;
- --
- --      package Intermediate is
- --         type Mid is tagged private;
- --      private
- --         type Mid is new Parent.Root with record ...
- --         -- Implicit Vis_Op (P: Mid) declared here.
- --
- --         procedure Vis_Op (P: Mid);                      -- (B)
- --      end Intermediate;
- --
- --      package Intermediate.Child is
- --         type Derived is new Mid with private; 
- --
- --         procedure Pri_Op (P: Derived);                  -- (C)
- --         ...
- --
- --      private
- --         type Derived is new Mid with record...
- --         -- Implicit Vis_Op (P: Derived) declared here.
- --         ...
- --      end Intermediate.Child;
- --
- --      Type Derived inherits Vis_Op from the parent type Mid. Note, however,
- --      that it is implicitly declared in the private part (inherited
- --      subprograms for a derived_type_definition -- in this case, the full
- --      type -- are implicitly declared at the  earliest place within the
- --      immediate scope of the type_declaration where the corresponding
- --      declaration from the parent is visible).
- --
- --      Because Parent.Pri_Op is never visible within the immediate scope
- --      of Mid, it is not implicitly declared for Mid. Thus, it is also not
- --      implicitly declared for Derived. As a result, the version of Pri_Op
- --      declared at (C) above does not override an inherited version of
- --      Parent.Pri_Op and is totally unrelated to it.
- --
- --      Dispatching calls with tag Mid will execute (A) and (B). Dispatching 
- --      calls with tag Derived from Parent will execute the bodies of (B) 
- --      and (A).  Dispatching calls with tag Derived from Parent.Child
- --      will execute the bodies of (B) and (C).  
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F392D00.A
- --         C392D01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with F392D00;
- package C392D01_0 is
- 
-    type Zoom_Camera is tagged private;
- 
-    procedure Self_Test (C : in out Zoom_Camera'Class);
- 
-    -- ...Additional operations.
- 
- 
-    function TC_Correct_Result (C : Zoom_Camera;
-                                D : F392D00.Depth_Of_Field;
-                                S : F392D00.Shutter_Speed) return Boolean;
- 
- private
- 
-    type Magnification is (Low, Medium, High);
- 
-    type Zoom_Camera is new F392D00.Remote_Camera with record
-       Mag : Magnification;
-    end record;
- 
-    -- procedure Focus (C     : in out Zoom_Camera;               -- Implicitly
-    --                  Depth : in     Depth_Of_Field)            -- declared
-                                                                  -- here.
- 
-    procedure Focus (C     : in out Zoom_Camera;                -- Overrides
-                     Depth : in     F392D00.Depth_Of_Field);    -- inherited op.
- 
-    -- For the remote zoom camera, perhaps the focusing algorithm is different
-    -- in some way, so the original Focus operation is overridden here.
- 
-    -- Since the partial view is not an extension, the overriding operation
-    -- must be declared after the full type. This version of Focus, although
-    -- not visible for type Zoom_Camera from outside the package, can still be
-    -- dispatched to.  
- 
- 
-    -- Note: F392D00.Set_Shutter_Speed is inherited by Zoom_Camera from
-    -- F392D00.Remote_Camera, but since the operation never becomes visible
-    -- within the immediate scope of Zoom_Camera, it is never implicitly
-    -- declared. 
- 
- end C392D01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C392D01_0 is
- 
-    procedure Focus (C     : in out Zoom_Camera;
-                     Depth : in     F392D00.Depth_Of_Field) is
-    begin
-       -- Artificial for testing purposes.
-       C.DOF := 83;
-    end Focus;
- 
-    -----------------------------------------------------------
-    -- Indirect call to F392D00.Self_Test since the main does not know 
-    -- that Zoom_Camera is a private extension of F392D00.Basic_Camera.
-    procedure Self_Test (C : in out Zoom_Camera'Class) is
-    begin
-       F392D00.Self_Test (C);
-       -- ...Additional self-testing.
-    end Self_Test;
- 
-    -----------------------------------------------------------
-    function TC_Correct_Result (C : Zoom_Camera;
-                                D : F392D00.Depth_Of_Field;
-                                S : F392D00.Shutter_Speed) return Boolean is
-       use type F392D00.Depth_Of_Field;
-       use type F392D00.Shutter_Speed;
-    begin
-       return (C.DOF = D and C.Shutter = S);
-    end TC_Correct_Result;
- 
- end C392D01_0;
- 
- 
-      --==================================================================--
- 
- 
- with F392D00;
- package C392D01_0.C392D01_1 is
- 
-    type Film_Speed is private;
- 
-    type Auto_Speed is new Zoom_Camera with private;
- 
-    -- Implicit function TC_Correct_Result (Auto_Speed) declared here.
- 
-    procedure Set_Shutter_Speed (C     : in out Auto_Speed;     
-                                 Speed : in     F392D00.Shutter_Speed); 
- 
-    -- This version of Set_Shutter_Speed does NOT override the operation
-    -- inherited from Zoom_Camera, because the inherited operation is never
-    -- visible (and thus, is never implicitly declared) within the immediate
-    -- scope of type Auto_Speed.
- 
-    procedure Self_Test (C : in out Auto_Speed'Class);
- 
-    -- ...Other operations.
- 
- private
-    type Film_Speed is (One_Hundred, Two_Hundred, Four_Hundred);
- 
-    type Auto_Speed is new Zoom_Camera with record
-       ASA : Film_Speed;
-    end record;
- 
-    -- procedure Focus (C     : in out Auto_Speed;                -- Implicitly
-    --                  Depth : in     F392D00.Depth_Of_Field);   -- declared
-                                                                  -- here.
- 
- end C392D01_0.C392D01_1;
- 
- 
-      --==================================================================--
- 
- 
- package body C392D01_0.C392D01_1 is
- 
-    procedure Set_Shutter_Speed (C     : in out Auto_Speed;
-                                 Speed : in     F392D00.Shutter_Speed) is
-    begin
-       -- Artificial for testing purposes.
-       C.Shutter := F392D00.Two_Fifty;
-    end Set_Shutter_Speed;
- 
-    -------------------------------------------------------
-    procedure Self_Test (C : in out Auto_Speed'Class) is
-    begin
-       -- Artificial for testing purposes.
-       Set_Shutter_Speed (C, F392D00.Thousand);
-       Focus (C, 27);
-    end Self_Test;
- 
- end C392D01_0.C392D01_1;
- 
- 
-      --==================================================================--
- 
- 
- with F392D00;
- with C392D01_0.C392D01_1;
- 
- with Report;
- 
- procedure C392D01 is
-    Zooming_Camera : C392D01_0.Zoom_Camera;
-    Auto_Camera1   : C392D01_0.C392D01_1.Auto_Speed;
-    Auto_Camera2   : C392D01_0.C392D01_1.Auto_Speed;
- 
-    TC_Expected_Zoom_Depth : constant F392D00.Depth_Of_Field := 83;
-    TC_Expected_Auto_Depth : constant F392D00.Depth_Of_Field := 83;
-    TC_Expected_Depth      : constant F392D00.Depth_Of_Field := 83;
-    TC_Expected_Zoom_Speed : constant F392D00.Shutter_Speed 
-                           := F392D00.Thousand;
-    TC_Expected_Auto_Speed : constant F392D00.Shutter_Speed 
-                           := F392D00.Thousand;
-    TC_Expected_Speed      : constant F392D00.Shutter_Speed 
-                           := F392D00.Two_Fifty;
- 
-    use type F392D00.Depth_Of_Field;
-    use type F392D00.Shutter_Speed;
- 
- begin
-    Report.Test ("C392D01", "Dispatching for overridden and non-overridden "   &
-                 "primitive subprograms: private extension declared in child " &
-                 "unit, parent is tagged private whose full view is derived  " &
-                 "type");
- 
- 
- 
- -- Call the class-wide operation (Self_Test) for Zoom_Camera'Class, which 
- -- itself calls the class-wide operation for Remote_Camera'Class, which
- -- in turn makes dispatching calls to Focus and Set_Shutter_Speed:
- 
- 
-    -- For an object of type Zoom_Camera, the dispatching call to Focus should
-    -- dispatch to the body explicitly declared for Zoom_Camera. The dispatching
-    -- to Set_Shutter_Speed should dispatch to the body declared for
-    -- Remote_Camera:
-      
-    C392D01_0.Self_Test(Zooming_Camera);
- 
-    if not C392D01_0.TC_Correct_Result (Zooming_Camera,
-                                        TC_Expected_Zoom_Depth,
-                                        TC_Expected_Zoom_Speed)
-    then
-       Report.Failed ("Calls dispatched incorrectly for tagged private type");
-    end if;
- 
-    -- For an object of type Auto_Speed, the dispatching call to Focus should
-    -- dispatch to the body explicitly declared for Zoom_Camera. The dispatching
-    -- call to Set_Shutter_Speed should dispatch to the body explicitly declared 
-    -- for Remote_Camera:
-      
-    C392D01_0.Self_Test(Auto_Camera1);
- 
-    if not C392D01_0.C392D01_1.TC_Correct_Result (Auto_Camera1,
-                                                  TC_Expected_Auto_Depth,
-                                                  TC_Expected_Auto_Speed)
-    then
-       Report.Failed ("Calls dispatched incorrectly for private extension");
-    end if;
- 
-    -- Call to Self_Test from C392D01_0.C392D01_1 invokes the dispatching call
-    -- to Focus which should dispatch to the body explicitly declared for 
-    -- Zoom_Camera. The dispatching call to Set_Shutter_Speed should dispatch 
-    -- to the body explicitly declared for Auto_Speed:
- 
-    C392D01_0.C392D01_1.Self_Test(Auto_Camera2);
- 
-    if not C392D01_0.C392D01_1.TC_Correct_Result (Auto_Camera2,
-                                                  TC_Expected_Depth,
-                                                  TC_Expected_Speed)
-    then
-       Report.Failed ("Call to explicit subprogram executed the wrong body");
-    end if;
- 
-    Report.Result;
- 
- end C392D01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392d02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392d02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392d02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392d02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,185 ****
- -- C392D02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a primitive procedure declared in a private part is not
- --      overridden by a procedure explicitly declared at a place where the
- --      primitive procedure in question is not visible.
- --
- --      Check for the case where the non-overriding operation is declared in a
- --      separate (non-child) package from that declaring the parent type, and
- --      the descendant type is a record extension.
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      package P is
- --         type Root is tagged ...
- --      private
- --         procedure Pri_Op (A: Root);
- --      end P;
- --
- --      with P;
- --      package Q is
- --         type Derived is new P.Root with record...
- --         procedure Pri_Op (A: Derived);  -- Does NOT override parent's Op.
- --         ...
- --      end Q;
- --
- --      Type Derived inherits Pri_Op from the parent type Root. However,
- --      because P.Pri_Op is never visible within the immediate scope of
- --      Derived, it is not implicitly declared for Derived. As a result,
- --      the explicit Q.Pri_Op does not override P.Pri_Op and is totally
- --      unrelated to it.
- --
- --      Dispatching calls to P.Pri_Op with operands of tag Derived will
- --      not dispatch to Q.Pri_Op; the body executed will be that of P.Pri_Op.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F392D00.A
- --         C392D02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with F392D00;
- package C392D02_0 is
- 
-    type Aperture is (Eight, Sixteen);     
- 
-    type Auto_Speed is new F392D00.Remote_Camera with record
-       -- ...
-       FStop : Aperture;
-    end record;
- 
- 
-    procedure Set_Shutter_Speed (C     : in out Auto_Speed;     
-                                 Speed : in     F392D00.Shutter_Speed); 
-                                                    -- Does NOT override.
- 
-    -- This version of Set_Shutter_Speed does NOT override the operation
-    -- inherited from the parent, because the inherited operation is never
-    -- visible (and thus, is never implicitly declared) within the immediate
-    -- scope of type Auto_Speed.
- 
-    procedure Self_Test (C : in out Auto_Speed'Class);
- 
-    -- ...Other operations.
- 
- end C392D02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C392D02_0 is
- 
-    procedure Set_Shutter_Speed (C     : in out Auto_Speed;
-                                 Speed : in     F392D00.Shutter_Speed) is
-    begin
-       -- Artificial for testing purposes.
-       C.Shutter := F392D00.Four_Hundred;
-    end Set_Shutter_Speed;
- 
-    ----------------------------------------------------
-    procedure Self_Test (C : in out Auto_Speed'Class) is
-    begin
-       -- Should dispatch to the Set_Shutter_Speed explicitly declared
-       -- for Auto_Speed.
-       Set_Shutter_Speed (C, F392D00.Two_Fifty);
-    end Self_Test;
- 
- end C392D02_0;
- 
- 
-      --==================================================================--
- 
- 
- with F392D00;
- with C392D02_0;
- 
- with Report;
- 
- procedure C392D02 is
-    Basic_Camera : F392D00.Remote_Camera;
-    Auto_Camera1 : C392D02_0.Auto_Speed;
-    Auto_Camera2 : C392D02_0.Auto_Speed;
- 
-    TC_Expected_Basic_Speed : constant F392D00.Shutter_Speed 
-                            := F392D00.Thousand;
-    TC_Expected_Speed       : constant F392D00.Shutter_Speed 
-                            := F392D00.Four_Hundred;
- 
-    use type F392D00.Shutter_Speed;
- 
- begin
-    Report.Test ("C392D02", "Dispatching for non-overridden primitive " &
-                 "subprograms: record extension declared in non-child " &
-                 "package, parent is tagged record");
- 
- -- Call the class-wide operation for Remote_Camera'Class, which dispatches
- -- to Set_Shutter_Speed:
- 
-    -- For an object of type Remote_Camera, the dispatching call should
-    -- dispatch to the body declared for the root type:
-      
-    F392D00.Self_Test(Basic_Camera);
- 
-    if Basic_Camera.Shutter /= TC_Expected_Basic_Speed then
-       Report.Failed ("Call dispatched incorrectly for root type");
-    end if;
- 
- 
-    -- C392D02_0.Set_Shutter_Speed should never be called by F392D00.Self_Test,
-    -- since C392D02_0.Set_Shutter_Speed does not override
-    -- F392D00.Set_Shutter_Speed.
- 
-    -- For an object of type Auto_Speed, the dispatching call should
-    -- also dispatch to the body declared for the root type:
-      
-    F392D00.Self_Test(Auto_Camera1);
- 
-    if Auto_Camera1.Shutter /= TC_Expected_Basic_Speed then
-       Report.Failed ("Call dispatched incorrectly for derived type");
-    end if;
- 
-    -- Call to Self_Test from C392D02_0 invokes the dispatching call to
-    -- Set_Shutter_Speed which should dispatch to the body explicitly declared 
-    -- for Auto_Speed:
- 
-    C392D02_0.Self_Test(Auto_Camera2);
- 
-    if Auto_Camera2.Shutter /= TC_Expected_Speed then
-       Report.Failed ("Call to explicit subprogram executed the wrong body");
-    end if;
- 
-    Report.Result;
- 
- end C392D02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392d03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392d03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c392d03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c392d03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,248 ****
- -- C392D03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for an inherited dispatching operation that is overridden,
- --      the body executed is the body of the overriding subprogram, even if
- --      the overriding occurs in a private part.
- --
- --      Check for the case where the overriding operation is declared in a
- --      separate (non-child) package from that declaring the parent type, and
- --      the descendant type is a record extension.
- --
- --      Check for both dispatching and nondispatching calls.
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      package P is
- --         type Root is tagged ...
- --         procedure Op (A: Root);
- --      end P;
- --
- --      with P;
- --      package Q is
- --         type Derived1 is new P.Root with record...
- --         -- Implicit procedure Op (A: Derived1) declared here.
- --         type Derived2 is new P.Root with private...
- --         -- Implicit procedure Op (A: Derived2) declared here.
- --         type New_Derived is new Derived1 with private...
- --         -- Implicit procedure Op (A: New_Derived) declared here.
- --      private
- --         procedure Op (A: Derived1);  -- Overrides parent's Op.
- --         type Derived2 is new P.Root with record...
- --         procedure Op (A: Derived2);  -- Overrides parent's Op.
- --         type New_Derived is new Derived1 with record...
- --         ...
- --      end Q;
- --
- --      Both type Derived1 and Derived2 inherit Op from the parent type Root. 
- --      Type New_Derived inherits (inherited) Op from Derived1.  The inherited 
- --      operation is implicitly declared immediately after the type extension.  
- --      The inherited operation is overridden by an explicit declaration in 
- --      the private part. Even though the overriding operation is private, 
- --      calls to Op with an operand of tag Derived1, Derived2, or New_Derived
- --      will execute the body of the overriding operation.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F392D00.A
- --         C392D03.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with F392D00;
- package C392D03_0 is
- 
-    type Aperture is (Eight, Sixteen);     
- 
-    type Auto_Focus is new F392D00.Remote_Camera with record
-       -- ...
-       FStop : Aperture;
-    end record;
- 
-    -- Implicit procedure Focus (C     : in out Auto_Focus;
-    --                           Depth : in     Depth_Of_Field) declared here.
- 
-    type Auto_Flashing is new F392D00.Remote_Camera with private;
- 
-    -- Implicit procedure Focus (C     : in out Auto_Flashing;
-    --                           Depth : in     Depth_Of_Field) declared here.
- 
-    type Special_Focus is new Auto_Focus with private;
- 
-    -- Implicit procedure Focus (C     : in out Special_Focus;
-    --                           Depth : in     Depth_Of_Field) declared here.
- 
-    -- ...Other operations.
- 
- private
- 
-    procedure Focus (C     : in out Auto_Focus;              -- Overrides
-                     Depth : in     F392D00.Depth_Of_Field); -- parent's op.
- 
-    -- For the improved remote camera, focus is set automatically, so it is
-    -- declared as a private operation.
- 
-    type Auto_Flashing is new F392D00.Remote_Camera with null record;
- 
-    procedure Focus (C     : in out Auto_Flashing;           -- Overrides
-                     Depth : in     F392D00.Depth_Of_Field); -- parent's op.
- 
-    type Special_Focus is new Auto_Focus with null record;
- 
- end C392D03_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C392D03_0 is
- 
-    procedure Focus (C     : in out Auto_Focus;
-                     Depth : in     F392D00.Depth_Of_Field) is
-    begin
-       -- Artificial for testing purposes.
-       C.DOF := 52;
-    end Focus;
- 
-    -----------------------------------------------------------
-    procedure Focus (C     : in out Auto_Flashing;
-                     Depth : in     F392D00.Depth_Of_Field) is
-    begin
-       -- Artificial for testing purposes.
-       C.DOF := 91;
-    end Focus;
- 
- end C392D03_0;
- 
- 
-      --==================================================================--
- 
- 
- with F392D00;
- with C392D03_0;
- 
- with Report;
- 
- procedure C392D03 is
- 
-    type Focus_Ptr is access procedure 
-      (P1 : in out C392D03_0.Auto_Focus;
-       P2 : in F392D00.Depth_Of_Field);
- 
-    Basic_Camera   : F392D00.Remote_Camera;
-    Auto_Camera1   : C392D03_0.Auto_Focus;
-    Auto_Camera2   : C392D03_0.Auto_Focus;
-    Flash_Camera1  : C392D03_0.Auto_Flashing;
-    Flash_Camera2  : C392D03_0.Auto_Flashing;
-    Special_Camera : C392D03_0.Special_Focus;
-    Auto_Depth     : F392D00.Depth_Of_Field := 78;
- 
-    TC_Expected_Basic_Depth : constant F392D00.Depth_Of_Field := 46;
-    TC_Expected_Auto_Depth  : constant F392D00.Depth_Of_Field := 52;
-    TC_Expected_Depth       : constant F392D00.Depth_Of_Field := 91;
- 
-    FP : Focus_Ptr := C392D03_0.Focus'Access;
- 
-    use type F392D00.Depth_Of_Field;
- 
- begin
-    Report.Test ("C392D03", "Dispatching for overridden primitive " &
-                 "subprograms: record extension declared in non-child " &
-                 "package, parent is tagged record");
- 
- 
- -- Call the class-wide operation for Remote_Camera'Class, which itself makes
- -- a dispatching call to Focus:
- 
-    -- For an object of type Remote_Camera, the dispatching call should
-    -- dispatch to the body declared for the root type:
-      
-    F392D00.Self_Test(Basic_Camera);
- 
-    if Basic_Camera.DOF /= TC_Expected_Basic_Depth then
-       Report.Failed ("Call dispatched incorrectly for root type");
-    end if;
- 
- 
-    -- For an object of type Auto_Focus, the dispatching call should
-    -- dispatch to the body declared for the derived type:
-      
-    F392D00.Self_Test(Auto_Camera1);
- 
-    if Auto_Camera1.DOF /= TC_Expected_Auto_Depth then
-       Report.Failed ("Call dispatched incorrectly for Auto_Focus type");
-    end if;
- 
- 
-    -- For an object of type Auto_Flash, the dispatching call should
-    -- also dispatch to the body declared for the derived type:
- 
-    F392D00.Self_Test(Flash_Camera1);
- 
-    if Flash_Camera1.DOF /= TC_Expected_Depth then
-       Report.Failed ("Call dispatched incorrectly for Auto_Flash type");
-    end if;
- 
-    -- For an object of Auto_Flash type, a non-dispatching call to Focus should 
-    -- execute the body declared for the derived type (even through it is 
-    -- declared in the private part).
- 
-    C392D03_0.Focus (Flash_Camera2, Auto_Depth);
- 
-    if Flash_Camera2.DOF /= TC_Expected_Depth then
-       Report.Failed ("Non-dispatching call to privately overriding " &
-                      "subprogram executed the wrong body");
-    end if;
- 
-    -- For an object of Auto_Focus type, a non-dispatching call to Focus should 
-    -- execute the body declared for the derived type (even through it is 
-    -- declared in the private part).
- 
-    FP.all (Auto_Camera2, Auto_Depth);
- 
-    if Auto_Camera2.DOF /= TC_Expected_Auto_Depth then
-       Report.Failed ("Non-dispatching call by using access to overriding " &
-                      "subprogram executed the wrong body");
-    end if;
- 
-    -- For an object of type Special_Camera, the dispatching call should
-    -- also dispatch to the body declared for the derived type:
- 
-    F392D00.Self_Test(Special_Camera);
- 
-    if Special_Camera.DOF /= TC_Expected_Auto_Depth then
-       Report.Failed ("Call dispatched incorrectly for Special_Camera type");
-    end if;
- 
-    Report.Result;
- 
- end C392D03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,407 ****
- -- C393001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an abstract type can be declared, and in turn concrete
- --      types can be derived from it.  Check that the definition of 
- --      actual subprograms associated with the derived types dispatch
- --      correctly.
- --
- -- TEST DESCRIPTION:
- --      This test declares an abstract type Breaker in a package, and
- --      then derives from it.  The type Basic_Breaker defines the least
- --      possible in order to not be abstract.  The type Ground_Fault is
- --      defined to inherit as much as possible, whereas type Special_Breaker
- --      overrides everything it can.  The type Special_Breaker also includes
- --      an embedded Basic_Breaker object.  The main program then utilizes
- --      each of the three types of breaker, and to ascertain that the
- --      overloading and tagging resolution are correct, each "Create"
- --      procedure is called with a unique value.  The diagram below
- --      illustrates the relationships.  This test is derived from C3A2001.
- --
- --              Abstract type:           Breaker
- --                                           |
- --                                    Basic_Breaker (Short)
- --                                    /           \
- --                     (Sharp) Ground_Fault    Special_Breaker (Shock)
- --
- --      Test structure is an array of class-wide objects, modeling a circuit
- --      as a list of components.  The test then creates some values, and
- --      traverses the list to determine correct operation.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      13 Nov 95   SAIC    Revised for 2.0.1
- --
- --!
- 
- ----------------------------------------------------------------- C393001_1
- 
- with Report;
- package C393001_1 is
- 
-   type Breaker is abstract tagged private;
-   type Status  is ( Power_Off, Power_On, Tripped, Failed );
- 
-   procedure Flip ( The_Breaker : in out Breaker ) is abstract;
-   procedure Trip ( The_Breaker : in out Breaker ) is abstract;
-   procedure Reset( The_Breaker : in out Breaker ) is abstract;
-   procedure Fail ( The_Breaker : in out Breaker );
- 
-   procedure Set ( The_Breaker : in out Breaker'Class; To_State : Status );
- 
-   function  Status_Of( The_Breaker : Breaker ) return Status;
- 
- private
-   type Breaker is abstract tagged record
-     State : Status := Power_Off;
-   end record;
- end C393001_1;
- 
- with TCTouch;
- package body C393001_1 is
-   procedure Fail( The_Breaker : in out Breaker ) is ------------------- a
-   begin
-     TCTouch.Touch( 'a' );
-     The_Breaker.State := Failed;
-   end Fail;
- 
-   procedure Set( The_Breaker : in out Breaker'Class; To_State : Status ) is
-   begin
-     The_Breaker.State := To_State;
-   end Set;
- 
-   function  Status_Of( The_Breaker : Breaker ) return Status is ------- b
-   begin
-     TCTouch.Touch( 'b' );
-     return The_Breaker.State;
-   end Status_Of;
- end C393001_1;
- 
- ----------------------------------------------------------------- C393001_2
- 
- with C393001_1;
- package C393001_2 is
- 
-   type Basic_Breaker is new C393001_1.Breaker with private;
- 
-   type Voltages is ( V12, V110, V220, V440 );
-   type Amps     is ( A1, A5, A10, A25, A100 );
- 
-   function Construct( Voltage : Voltages; Amperage : Amps )
-     return Basic_Breaker;
- 
-   procedure Flip ( The_Breaker : in out Basic_Breaker );
-   procedure Trip ( The_Breaker : in out Basic_Breaker );
-   procedure Reset( The_Breaker : in out Basic_Breaker );
- private
-   type Basic_Breaker is new C393001_1.Breaker with record
-     Voltage_Level : Voltages := V110;
-     Amperage      : Amps;
-   end record;
- end C393001_2;
- 
- with TCTouch;
- package body C393001_2 is
-   function Construct( Voltage : Voltages; Amperage : Amps ) ----------- c
-     return Basic_Breaker is
-     It : Basic_Breaker;
-   begin
-     TCTouch.Touch( 'c' );
-     It.Amperage := Amperage;
-     It.Voltage_Level := Voltage;
-     C393001_1.Set( It, C393001_1.Power_Off );
-     return It;
-   end Construct;
- 
-   procedure Flip ( The_Breaker : in out Basic_Breaker ) is ------------ d
-   begin
-     TCTouch.Touch( 'd' );
-     case Status_Of( The_Breaker ) is
-       when C393001_1.Power_Off =>
-         C393001_1.Set( The_Breaker, C393001_1.Power_On );
-       when C393001_1.Power_On =>
-         C393001_1.Set( The_Breaker, C393001_1.Power_Off );
-       when C393001_1.Tripped | C393001_1.Failed  => null;
-     end case;
-   end Flip;
- 
-   procedure Trip ( The_Breaker : in out Basic_Breaker ) is ------------ e
-   begin
-     TCTouch.Touch( 'e' );
-     C393001_1.Set( The_Breaker, C393001_1.Tripped );
-   end Trip;
- 
-   procedure Reset( The_Breaker : in out Basic_Breaker ) is ------------ f
-   begin
-     TCTouch.Touch( 'f' );
-     case Status_Of( The_Breaker ) is
-       when C393001_1.Power_Off | C393001_1.Tripped =>
-         C393001_1.Set( The_Breaker, C393001_1.Power_On );
-       when C393001_1.Power_On  | C393001_1.Failed  => null;
-     end case;
-   end Reset;
- 
- end C393001_2;
- 
- with C393001_1,C393001_2;
- package C393001_3 is
-   
-   type Ground_Fault is new C393001_2.Basic_Breaker with private;
- 
-   function Construct( Voltage : C393001_2.Voltages; Amperage : C393001_2.Amps
- )
-     return Ground_Fault;
- 
-   procedure Set_Trip( The_Breaker : in out Ground_Fault;
-                       Capacitance : in     Integer );
- 
- private
-   type Ground_Fault is new C393001_2.Basic_Breaker with record
-     Capacitance : Integer;
-   end record;
- end C393001_3;
- 
- ----------------------------------------------------------------- C393001_3
- 
- with TCTouch;
- package body C393001_3 is
- 
-   function Construct( Voltage  : C393001_2.Voltages; ------------------ g
-                       Amperage : C393001_2.Amps )
-     return Ground_Fault is
- 
-     It : Ground_Fault;
- 
-     procedure Set_Root( It: in out C393001_2.Basic_Breaker ) is
-     begin
-       It := C393001_2.Construct( Voltage, Amperage );
-     end Set_Root;
- 
-   begin
-     TCTouch.Touch( 'g' );
-     Set_Root( C393001_2.Basic_Breaker( It ) );
-     It.Capacitance := 0;
-     return It;
-   end Construct;
- 
-   procedure Set_Trip( The_Breaker : in out Ground_Fault; -------------- h
-                       Capacitance : in     Integer ) is
-   begin
-     TCTouch.Touch( 'h' );
-     The_Breaker.Capacitance := Capacitance;
-   end Set_Trip;
- 
- end C393001_3;
- 
- ----------------------------------------------------------------- C393001_4
- 
- with C393001_1, C393001_2;
- package C393001_4 is
- 
-   type Special_Breaker is new C393001_2.Basic_Breaker with private;
- 
-   function Construct( Voltage     : C393001_2.Voltages;
-                       Amperage    : C393001_2.Amps )
-     return Special_Breaker;
- 
-   procedure Flip ( The_Breaker : in out Special_Breaker );
-   procedure Trip ( The_Breaker : in out Special_Breaker );
-   procedure Reset( The_Breaker : in out Special_Breaker );
-   procedure Fail ( The_Breaker : in out Special_Breaker );
- 
-   function Status_Of( The_Breaker : Special_Breaker ) return C393001_1.Status;
-   function On_Backup( The_Breaker : Special_Breaker ) return Boolean;
- 
- private
-   type Special_Breaker is new C393001_2.Basic_Breaker with record
-     Backup : C393001_2.Basic_Breaker;
-   end record;
- end C393001_4;
- 
- with TCTouch;
- package body C393001_4 is
- 
-   function Construct( Voltage     : C393001_2.Voltages; --------------- i
-                       Amperage    : C393001_2.Amps )
-     return Special_Breaker is
-     It: Special_Breaker;
-     procedure Set_Root( It: in out C393001_2.Basic_Breaker ) is
-     begin
-       It := C393001_2.Construct( Voltage, Amperage );
-     end Set_Root;
-   begin
-     TCTouch.Touch( 'i' );
-     Set_Root( C393001_2.Basic_Breaker( It ) );
-     Set_Root( It.Backup );
-     return It;
-   end Construct;
- 
-   function Status_Of( It: C393001_1.Breaker ) return C393001_1.Status
-     renames C393001_1.Status_Of;
- 
-   procedure Flip ( The_Breaker : in out Special_Breaker ) is ---------- j
-   begin
-     TCTouch.Touch( 'j' );
-     case Status_Of( C393001_1.Breaker( The_Breaker )) is
-       when C393001_1.Power_Off | C393001_1.Power_On =>
-         C393001_2.Flip( C393001_2.Basic_Breaker( The_Breaker ) );
-       when others =>
-         C393001_2.Flip( The_Breaker.Backup );
-     end case;
-   end Flip;
- 
-   procedure Trip ( The_Breaker : in out Special_Breaker ) is ---------- k
-   begin
-     TCTouch.Touch( 'k' );
-     case Status_Of( C393001_1.Breaker( The_Breaker )) is
-       when C393001_1.Power_Off => null;
-       when C393001_1.Power_On  =>
-         C393001_2.Reset( The_Breaker.Backup );
-         C393001_2.Trip( C393001_2.Basic_Breaker( The_Breaker ) );
-       when others =>
-         C393001_2.Trip( The_Breaker.Backup );
-     end case;
-   end Trip;
- 
-   procedure Reset( The_Breaker : in out Special_Breaker ) is ---------- l
-   begin
-     TCTouch.Touch( 'l' );
-     case Status_Of( C393001_1.Breaker( The_Breaker )) is
-       when C393001_1.Tripped  =>
-         C393001_2.Reset( C393001_2.Basic_Breaker( The_Breaker ));
-       when C393001_1.Failed  =>
-         C393001_2.Reset( The_Breaker.Backup );
-       when C393001_1.Power_On | C393001_1.Power_Off =>
-         null;
-     end case;
-   end Reset;
- 
-   procedure Fail ( The_Breaker : in out Special_Breaker ) is ---------- m
-   begin
-     TCTouch.Touch( 'm' );
-     case Status_Of( C393001_1.Breaker( The_Breaker )) is
-       when C393001_1.Failed  =>
-         C393001_2.Fail( The_Breaker.Backup );
-       when others => 
-         C393001_2.Fail( C393001_2.Basic_Breaker( The_Breaker ));
-         C393001_2.Reset( The_Breaker.Backup );
-     end case;
-   end Fail;
- 
-   function Status_Of( The_Breaker : Special_Breaker ) ----------------- n
-     return C393001_1.Status is
-   begin
-     TCTouch.Touch( 'n' );
-     case Status_Of( C393001_1.Breaker( The_Breaker )) is
-       when C393001_1.Power_On  => return C393001_1.Power_On;
-       when C393001_1.Power_Off => return C393001_1.Power_Off;
-       when others =>
-         return C393001_2.Status_Of( The_Breaker.Backup );
-     end case;
-   end Status_Of;
- 
-   function On_Backup( The_Breaker : Special_Breaker ) return Boolean is
-     use C393001_2;
-     use type C393001_1.Status;
-   begin
-     return Status_Of(Basic_Breaker(The_Breaker)) = C393001_1.Tripped
-         or Status_Of(Basic_Breaker(The_Breaker)) = C393001_1.Failed;
-   end On_Backup;
- 
- end C393001_4;
- 
- ------------------------------------------------------------------- C393001
- 
- with Report, TCTouch;
- with C393001_1, C393001_2, C393001_3, C393001_4;
- procedure C393001 is
-  
-   procedure Flipper( The_Circuit : in out C393001_1.Breaker'Class ) is
-   begin
-       C393001_1.Flip( The_Circuit );
-   end Flipper;
- 
-   procedure Tripper( The_Circuit : in out C393001_1.Breaker'Class ) is
-   begin
-       C393001_1.Trip( The_Circuit );
-   end Tripper;
- 
-   procedure Restore( The_Circuit : in out C393001_1.Breaker'Class ) is
-   begin
-       C393001_1.Reset( The_Circuit );
-   end Restore;
- 
-   procedure Failure( The_Circuit : in out C393001_1.Breaker'Class ) is
-   begin
-       C393001_1.Fail( The_Circuit );
-   end Failure;
- 
-   Short : C393001_1.Breaker'Class -- Basic_Breaker
-           := C393001_2.Construct( C393001_2.V440, C393001_2.A5 );
-   Sharp : C393001_1.Breaker'Class -- Ground_Fault
-           := C393001_3.Construct( C393001_2.V110, C393001_2.A1 );
-   Shock : C393001_1.Breaker'Class -- Special_Breaker
-           := C393001_4.Construct( C393001_2.V12,  C393001_2.A100 );
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C393001", "Check that an abstract type can be declared " &
-                "and used.  Check actual subprograms dispatch correctly" );
- 
-   TCTouch.Validate( "cgcicc", "Declaration" );
- 
-   Flipper( Short );
-   TCTouch.Validate( "db", "Flipping Short" );
-   Flipper( Sharp );
-   TCTouch.Validate( "db", "Flipping Sharp" );
-   Flipper( Shock );
-   TCTouch.Validate( "jbdb", "Flipping Shock" );
- 
-   Tripper( Short );
-   TCTouch.Validate( "e", "Tripping Short" );
-   Tripper( Sharp );
-   TCTouch.Validate( "e", "Tripping Sharp" );
-   Tripper( Shock );
-   TCTouch.Validate( "kbfbe", "Tripping Shock" );
- 
-   Restore( Short );
-   TCTouch.Validate( "fb", "Restoring Short" );
-   Restore( Sharp );
-   TCTouch.Validate( "fb", "Restoring Sharp" );
-   Restore( Shock );
-   TCTouch.Validate( "lbfb", "Restoring Shock" );
- 
-   Failure( Short );
-   TCTouch.Validate( "a", "Shock Failing" );
-   Failure( Sharp );
-   TCTouch.Validate( "a", "Shock Failing" );
-   Failure( Shock );
-   TCTouch.Validate( "mbafb", "Shock Failing" );
- 
-   Report.Result;
- 
- end C393001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- C393007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an extended type can be derived from an abstract type,
- --      where the abstract type is defined in a package, and the type derived
- --      from it is defined in a distinct library package.
- --
- -- TEST DESCRIPTION:
- --      Declare an private (abstract) type; declare two primitive operations 
- --      of the type that are explicitly abstract.
- --      Derive an extended type from the (private) abstract type, overriding 
- --      both of the primitive operations.
- --      This test also checks to see that name overloading between abstract
- --      and non-abstract functions is resolved correctly.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
-    package C393007_0 is
-         -- Alert_System
-  
-      type DT_Type is new Integer;
-  
-      type Alert_Type is abstract tagged record
-         Time_Of_Arrival : DT_Type;
-      end record;
-  
-      type Log_File_Type is range 0 .. 100;
-  
-      Procedure Handle (A : in out Alert_type) is abstract;
-        
-      procedure Log    (A : Alert_Type;                   
-                        L : in out Log_File_Type) is abstract;  
-    
-      procedure Set_Time (A : in out Alert_Type);
-  
-      function Correct_Time_Stamp (A : Alert_Type) return Boolean;
-        
-      Day_Time : DT_Type := 100;
-  
-    end C393007_0;
-     -- Alert_System;
-  
-  --=======================================================================--
-  
-    package body C393007_0 is
-              -- Alert_System
-  
-      function Time_Stamp return DT_Type is
-        begin
-          Day_Time := Day_Time + 1;
-          return Day_Time;
-        end Time_Stamp;
-  
-      procedure Set_Time (A : in out Alert_Type) is
-        begin
-          A.Time_Of_Arrival := Time_Stamp;
-        end Set_time;
-        
-      function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
-        begin
-          return (A.Time_Of_Arrival = Day_Time);
-        end Correct_Time_Stamp;
-  
-    end C393007_0;
-     -- Alert_System;
-  
-  --=======================================================================--
-  
-  with Report;
-  with C393007_0;
-    -- Alert_system;
-  
-  package C393007_1 is
-  
-    type Normal_Alert_Type is   
-      new C393007_0.Alert_Type
-      with null record;
-  
-    Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First;
-  
-    procedure Handle (A : in out Normal_Alert_Type);  -- Override is required
-  
-    procedure Log    (A : Normal_Alert_Type;          -- Override is required
-                      L : in out C393007_0.Log_File_Type);
-  end C393007_1;
-  
-  package body C393007_1 is
-    use type C393007_0.Log_File_Type;
-  
-    procedure Handle (A : in out Normal_Alert_Type) is   
-      begin
-        Set_Time (A);
-        Log (A, Log_File);
-      end Handle;
-  
-    procedure Log    (A : Normal_Alert_Type;      
-                      L : in out C393007_0.Log_File_Type) is
-       begin
-         L := C393007_0."+"(L, 1);
-       end Log;
-    
-  end C393007_1;
-  
-  with Report;
-  with C393007_0;
-  with C393007_1;
-    -- Alert_system;
-  
-  procedure C393007 is
-    use C393007_0;
-    use C393007_1;
-  
-    Alert_One : C393007_1.Normal_Alert_Type;
-  
-  begin
-    Report.Test ("C393007", "Check that an extended type can be derived " &
-                            "from an abstract type");
-  
-    Handle (Alert_One);
-    if not Correct_Time_Stamp (Alert_One) then
-      Report.Failed ("Wrong results from procedure Handle");
-    end if;
-  
-    if Log_File /=1 then 
-      Report.Failed ("Wrong results");
-    end if;
-  
-    Report.Result;
-  
-  end C393007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,204 ****
- -- C393008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an extended type can be derived from an abstract type.
- --
- -- TEST DESCRIPTION:
- --      Declare a tagged record; declare an abstract 
- --      primitive operation and a non-abstract primitive operation of the 
- --      type.  Derive an extended type from it, including a new component.
- --      Use the derived type, the overriding operation and the inherited 
- --      operation to instantiate a generic package.  The overriding operation
- --      calls a new primitive operation and an inherited operation [so the 
- --      instantiation must get this sorted out correctly].
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with TCTouch;
- procedure C393008 is
- 
- package C393008_0 is
- 
-   type Status_Enum is (No_Status, Handled, Unhandled, Pending);
- 
-   type Alert_Type is abstract tagged record
-       Status : Status_Enum;
-       Reply  : Boolean;
-       Urgent : Boolean;
-   end record;
- 
-   subtype Serial_Number is Integer range 0..Integer'last;
-   Serial_Num : Serial_Number := 0;
- 
-   procedure Handle   (A : in out Alert_Type) is abstract; 
-                                         -- abstract primitive operation
- 
-   -- the procedure Init would be _nice_ have this procedure be non_abstract
-   -- and create a "base" object with a "null" constraint.  The language
-   -- will not allow this due to the restriction that an object of an
-   -- abstract type cannot be created.  Hence Init must be abstract,
-   -- requiring any type derived directly from Alert_Type to declare
-   -- an Init.
-   --
-   -- In light of this, I have changed init to a function to more closely
-   -- model the typical usage of OO features...
- 
-   function  Init return Alert_Type is abstract;
- 
-   procedure No_Reply (A : in out Alert_Type);
- 
- end C393008_0;
- 
- --=======================================================================--
- 
- package body C393008_0 is
- 
-   procedure No_Reply (A : in out Alert_Type) is
-     begin                              -- primitive operation, not abstract
-       TCTouch.Touch('A');  ------------------------------------------------- A
-       if A.Status = Handled then
-         A.Reply  := False;
-       end if;
-     end No_Reply;
- 
- end C393008_0;
- 
- --=======================================================================--
- 
-   generic
-                         -- pass in the Alert_Type object, including its 
-                         -- operations
-     type Data_Type is new C393008_0.Alert_Type with private; 
-                         -- note that Alert_Type is abstract, so it may not be
-                         -- used as an actual parameter
-     with procedure Update     (P : in out Data_Type) is <>;  -- generic formal
-     with function  Initialize return Data_Type is <>;        -- generic formal
- 
-   package C393008_1 is
-        -- Utilities
- 
-     procedure Modify (Item : in out Data_Type);
- 
-   end C393008_1;
-    -- Utilities
- 
- --=======================================================================--
- 
-   package body C393008_1 is
-             -- Utilities
- 
-       procedure Modify (Item : in out Data_Type) is
-         begin
-           TCTouch.Touch('B');  --------------------------------------------- B
-           Item := Initialize;
-           Update (Item);
-         end Modify;
- 
-   end C393008_1;
- 
- --=======================================================================--
- 
-   package C393008_2 is
- 
-     type Low_Alert_Type is new C393008_0.Alert_Type with record
-       Serial : C393008_0.Serial_Number;
-     end record;
-   
-     procedure Serialize (LA : in out Low_Alert_Type);
-   
-     -- inherit No_Reply
- 
-     procedure Handle (LA : in out Low_Alert_Type);
- 
-     function Init return Low_Alert_Type;
-   end C393008_2;
- 
-   package body C393008_2 is
-     procedure Serialize (LA : in out Low_Alert_Type) is
-     begin                          -- new primitive operation
-       TCTouch.Touch('C');  ------------------------------------------------- C
-       C393008_0.Serial_Num := C393008_0.Serial_Num + 1;
-       LA.Serial := C393008_0.Serial_Num;
-     end Serialize;
-   
-   -- inherit No_Reply
- 
-     function Init return Low_Alert_Type is
-       TA: Low_Alert_Type;
-     begin
-       TCTouch.Touch('D');  ------------------------------------------------- D
-       Serialize( TA );
-       TA.Status := C393008_0.No_Status;
-       return TA;
-     end Init;
- 
-     procedure Handle (LA : in out Low_Alert_Type) is    
-     begin                          -- overrides abstract inherited Handle
-       TCTouch.Touch('E');  ------------------------------------------------- E
-       Serialize (LA);
-       LA.Reply := False;
-       LA.Status := C393008_0.Handled;
-       No_Reply (LA);
-     end Handle;
- 
-   end C393008_2;
- 
-   use C393008_2;
-   
-   package Alert_Utilities is new
-     C393008_1 (Data_Type   => Low_Alert_Type,
-                Update      => Handle,   -- Low_Alert's Handle
-                Initialize  => Init);    -- inherited from Alert
- 
-   Item : Low_Alert_Type;
- 
-   use type C393008_0.Status_Enum;
- 
- begin
- 
-   Report.Test ("C393008", "Check that an extended type can be derived "&
-                           "from an abstract type");
- 
-   Item := Init;
-   if (Item.Status /= C393008_0.No_Status) or (Item.Serial /=1)  then
-     Report.Failed ("Wrong initialization");
-   end if;
-   TCTouch.Validate("DC", "Initialization Call");
- 
-   Alert_Utilities.Modify (Item);
-   if (Item.Status /= C393008_0.Handled) or (Item.Serial /= 3) then 
-     Report.Failed ("Wrong results from Modify");
-   end if;
-   TCTouch.Validate("BDCECA", "Generic Instance Call");
- 
-   Report.Result;
- 
- end C393008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C393009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an extended type can be derived from an abstract type.
- --
- -- TEST DESCRIPTION:
- --      Declare an abstract type in the specification of a generic package.
- --      Instantiate the package and derive an extended type from the abstract
- --      (instantiated) type; override all abstract operations; use all
- --      inherited operations;
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      14 Oct 95   SAIC    Fixed for ACVC 2.0.1
- --
- --!
-   
- with Report;
- procedure C393009 is
-   
-   package Display_Devices is
-   
-     type Display_Device_Enum is (None, TTY, Console, Big_Screen);
-     Display : Display_Device_Enum := None;
-   
-   end Display_Devices;
-   
- --=======================================================================--
-   
-   generic
-   
-     type Generic_Status is (<>);
-     
-     type Serial_Type is (<>);
-   
-   package Alert_System is
-   
-     type Alert_Type (Serial : Serial_Type) is abstract tagged record
-       Status : Generic_Status;
-     end record;
-     
-     Next_Serial_Number : Serial_Type := Serial_Type'First;
-   
-     procedure Handle (A : in out Alert_Type) is abstract;
-       -- abstract operation - must be overridden after instantiation
-   
-     procedure Display ( A : Alert_Type; 
-                        On : Display_Devices.Display_Device_Enum);
-               -- primitive operation of Alert_Type
-               -- not required to be overridden
-   
-     function Get_Serial_Number (A : Alert_Type) return Serial_Type;
-               -- primitive operation of Alert_Type
-               -- not required to be overridden
-   
-   end Alert_System;
-   
- --=======================================================================--
-   
-   package body Alert_System is
-   
-     procedure Display ( A : in Alert_Type;
-                        On : Display_Devices.Display_Device_Enum) is
-       begin
-         Display_Devices.Display := On;
-       end Display;
-   
-     function Get_Serial_Number (A : Alert_Type) 
-       return Serial_Type is
-       begin
-         return A.Serial;
-       end Get_Serial_Number;
-   
-   end Alert_System;
-   
- --=======================================================================--
- 
-   package NCC_1701 is
-   
-     type Status_Kind is (Green, Yellow, Red);
-     type Serial_Number_Type is new Integer range 1..Integer'Last;
-     
-     subtype Msg_Str is String (1..16);
-     Alert_Msg : Msg_Str := "C393009  passed.";
-                         --  123456789A123456
-   
-     package Alert_Pkg is new Alert_System (Status_Kind, Serial_Number_Type);
-   
-     type New_Alert_Type(Serial : Serial_Number_Type) is
-       new Alert_Pkg.Alert_Type(Serial) with record
-       Message : Msg_Str;
-       end record;
-    
-     -- procedure Display is inherited by New_Alert_Type
-   
-     -- function Get_Serial_Number is inherited by New_Alert_Type
-     procedure Handle (NA : in out New_Alert_Type);  -- must be overridden
-     procedure Init   (NA : in out New_Alert_Type);  -- new primitive
-   
-     NA : New_Alert_Type(Alert_Pkg.Next_Serial_Number);
-          -- New_Alert_Type is not abstract, so an object of that
-          -- type may be declared
-   
-   end NCC_1701;
-   
-   package body NCC_1701 is
-   
-     procedure Handle (NA : in out New_Alert_Type) is
-     begin
-       NA.Message := Alert_Msg;
-       Display (NA, On => Display_Devices.TTY);
-       end Handle;
-   
-     procedure Init (NA : in out New_Alert_Type) is  -- new primitive operation
-     begin                                           -- for New_Alert_Type
-       NA := (Serial=> NA.Serial, Status => Green, Message => (others => ' '));
-     end Init;
-     
-    end NCC_1701;
-   
-    use NCC_1701;
-    use type Display_Devices.Display_Device_Enum;
-   
- begin
- 
-   Report.Test ("C393009", "Check that an extended type can be derived " &
-                           "from an abstract type");
- 
-   Init (NA);
-   if (Get_Serial_Number (NA) /= 1)
-     or (NA.Status /= Green)
-     or (Display_Devices.Display /= Display_Devices.None) then
-       Report.Failed ("Wrong Initialization");
-   end if;
-   
-   Handle (NA);
-   if (Get_Serial_Number (NA) /= 1)
-     or (NA.Status /= Green)
-     or (NA.Message /= Alert_Msg) 
-     or (Display_Devices.Display /= Display_Devices.TTY) then
-       Report.Failed ("Wrong results from Handle");
-   end if;
-   
-   Report.Result;
- 
- end C393009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,306 ****
- -- C393010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an extended type can be derived from an abstract type and
- --      that a call on an abstract operation is a dispatching operation.
- --      Check that such a call can dispatch to an overriding operation
- --      declared in the private part of a package.
- --
- -- TEST DESCRIPTION:
- --      Taking from a classroom example of a typical usage: declare a basic
- --      abstract type containing data germane to the entire class structure,
- --      derive from that a type with specific data, and derive from that
- --      another type merely providing a "secret" override.  The abstract type
- --      provides a concrete procedure that itself "redispatches" to an
- --      abstract procedure; the abstract procedure must be provided by one or
- --      more of the concrete types derived from the abstract type, and hence
- --      upon re-evaluating the actual type of the operand should dispatch
- --      accordingly.
- --
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Mar 96   SAIC    ACVC 2.1
- --
- --!
- 
- ----------------------------------------------------------------- C393010_0
- 
- package C393010_0 is
- 
-   type Ticket is abstract tagged record
-     Flight        : Natural;
-     Serial_Number : Natural;
-   end record;
- 
-   function Issue return Ticket is abstract;
-   procedure Label( T: Ticket ) is abstract;
- 
-   procedure Print( T: Ticket );
- 
- end C393010_0;
- 
- with TCTouch;
- package body C393010_0 is
- 
-   procedure Print( T: Ticket ) is
-   begin
-     -- Check that a call on an abstract operation is a dispatching operation
-     Label( Ticket'Class( T ) );
-     -- Appropriate_IO.Put( T.Flight & T.Serial_Number );
-     TCTouch.Touch('P'); -------------------------------------------------- P
-   end Print;
- 
- end C393010_0;
- 
- ----------------------------------------------------------------- C393010_1
- 
- with C393010_0;
- package C393010_1 is
- 
-   type Service_Classes is (First, Business, Coach);
- 
-   type Menu is (Steak, Lobster, Fowl, Vegan);
- 
-   -- Check that an extended type can be derived from an abstract type.
-   type Passenger_Ticket(Service : Service_Classes) is
-     new C393010_0.Ticket with record
-       Row_Seat : String(1..3);
-       case Service is
-         when First | Business => Meal : Menu;
-         when Coach => null;
-       end case;
-   end record;
- 
-   function Issue return Passenger_Ticket;
-   function Issue( Service : Service_Classes;
-                    Flight : Natural;
-                      Seat : String;
-                      Meal : Menu := Fowl ) return Passenger_Ticket;
- 
-   procedure Label( T: Passenger_Ticket );
- 
-   procedure Print( T: Passenger_Ticket );
- 
- end C393010_1;
- 
- with TCTouch;
- package body C393010_1 is
- 
-   procedure Label( T: Passenger_Ticket ) is
-   begin
-     -- Appropriate_IO.Put( T.Service );
-     TCTouch.Touch('L'); -------------------------------------------------- L
-   end Label;
- 
-   procedure Print( T: Passenger_Ticket ) is
-   begin
-     -- call parent print:
-     C393010_0.Print( C393010_0.Ticket( T ) );
-     case T.Service is
-       when First    => -- Appropriate_IO.Put( Meal );
-         TCTouch.Touch('F'); ---------------------------------------------- F
-       when Business => -- Appropriate_IO.Put( Meal );
-         TCTouch.Touch('B'); ---------------------------------------------- B
-       when Coach    => -- Appropriate_IO.Put( "BYO" & " peanuts" );
-         TCTouch.Touch('C'); ---------------------------------------------- C
-     end case;   
-   end Print;
- 
-   Num : Natural := 1000;
- 
-   function Issue( Service : Service_Classes;
-                    Flight : Natural;
-                      Seat : String;
-                      Meal : Menu := Fowl ) return Passenger_Ticket is
-   begin
-     Num := Num +1;
-     case Service is
-       when First =>
-         return Passenger_Ticket'(Service => First, Flight => Flight,
-                        Row_Seat => Seat, Meal => Meal, Serial_Number => Num );
-       when Business =>
-         return Passenger_Ticket'(Service => Business, Flight => Flight,
-                        Row_Seat => Seat, Meal => Meal, Serial_Number => Num );
-       when Coach =>
-         return Passenger_Ticket'(Service => Coach, Flight => Flight,
-                        Row_Seat => Seat, Serial_Number => Num );
-     end case;
-   end Issue;
- 
-   function Issue return Passenger_Ticket is
-   begin
-     return Issue( Coach, 0, "non" );
-   end Issue;
- 
- end C393010_1;
- 
- ----------------------------------------------------------------- C393010_1
- 
- with C393010_1;
- package C393010_2 is
- 
-   type Charter is new C393010_1.Passenger_Ticket( C393010_1.Coach )
-     with private;
- 
-   function Issue return Charter;
- 
-   -- procedure Print( T: Passenger_Ticket );
- 
- private
-   type Charter is new C393010_1.Passenger_Ticket( C393010_1.Coach )
-     with null record;
- 
-   -- Check that the dispatching call to the abstract operation will dispatch
-   -- to a procedure defined in the private part of a package.
-   procedure Label( T: Charter );
- 
-   -- an example of a required function the users shouldn't see:
-   function Issue( Service : C393010_1.Service_Classes;
-                    Flight : Natural;
-                      Seat : String;
-                      Meal : C393010_1.Menu ) return Charter;
- 
- end C393010_2;
- 
- with TCTouch;
- package body C393010_2 is
- 
-   procedure Label( T: Charter ) is
-   begin
-     -- Appropriate_IO.Put( "Excursion Fare" );
-     TCTouch.Touch('X'); -------------------------------------------------- X
-   end Label;
- 
-   Num : Natural := 4000;
- 
-   function Issue return Charter is
-   begin
-     Num := Num +1;
-     return Charter'(Service => C393010_1.Coach, Flight => 1001,
-                        Row_Seat => "OPN", Serial_Number => Num );
-   end Issue;
- 
-   function Issue( Service : C393010_1.Service_Classes;
-                    Flight : Natural;
-                      Seat : String;
-                      Meal : C393010_1.Menu ) return Charter is
-   begin
-     return Issue;
-   end Issue;
- 
- end C393010_2;
- 
- ----------------------------------------------------------------- C393010_1
- 
- with Report;
- with TCTouch;
- with C393010_0;
- with C393010_1;
- with C393010_2; -- Charter Tours
- 
- procedure C393010 is
- 
-   type Agents_Handle is access all C393010_0.Ticket'Class;
- 
-   type Itinerary;
- 
-   type Next_Leg is access Itinerary;
- 
-   type Itinerary is record
-     Leg  : Agents_Handle;
-     Next : Next_Leg;
-   end record;
- 
-   function Travel_Agent_1 return Next_Leg is
-   begin
-     -- ORL -> JFK -> LAX -> SAN -> DFW -> ORL
-     return new Itinerary'(
-        -- ORL -> JFK 01   12  2A First, Lobster
-        new C393010_1.Passenger_Ticket'(
-          C393010_1.Issue(C393010_1.First, 12, " 2A", C393010_1.Lobster )),
-          new Itinerary'(
-        -- JFK -> LAX 02   18  2B First, Steak
-        new C393010_1.Passenger_Ticket'(
-          C393010_1.Issue(C393010_1.First, 18, " 2B", C393010_1.Steak )),
-          new Itinerary'(
-        -- LAX -> SAN 03 5225 34H Coach
-        new C393010_1.Passenger_Ticket'(
-          C393010_1.Issue(C393010_1.Coach, 5225, "34H")),
-          new Itinerary'(
-        -- SAN -> DFW 04   25 13A Business, Fowl
-        new C393010_1.Passenger_Ticket'(
-          C393010_1.Issue(C393010_1.Business, 25, "13A")),
-          new Itinerary'(
-        -- DFW -> ORL 05   15  1D First, Lobster
-        new C393010_1.Passenger_Ticket'(
-          C393010_1.Issue(C393010_1.First, 15, " 1D", C393010_1.Lobster )),
-          null          )))));
-   end Travel_Agent_1;
- 
-   function Travel_Agent_2 return Next_Leg is
-   begin
-     -- LAX -> NRT -> SYD -> LAX
-     return new Itinerary'(
-        new C393010_2.Charter'( C393010_2.Issue ),
-          new Itinerary'(
-        new C393010_2.Charter'( C393010_2.Issue ),
-          new Itinerary'(
-        new C393010_2.Charter'( C393010_2.Issue ),
-          new Itinerary'(
-        new C393010_2.Charter'( C393010_2.Issue ),
-          null ))));
-   end Travel_Agent_2;
- 
-   procedure Traveler( Pax_Tix : in Next_Leg ) is
-     Fly_Me : Next_Leg := Pax_Tix;
-   begin
-     -- a particularly consumptive process...
-     while Fly_Me /= null loop
-       C393010_0.Print( Fly_Me.Leg.all );  -- herein lies the test.
-       Fly_Me := Fly_Me.Next;
-     end loop;
-   end Traveler;
- 
- begin
- 
-   Report.Test ("C393010", "Check that an extended type can be derived from "
-                         & "an abstract type and that a call on an abstract "
-                         & "operation is a dispatching operation.  Check "
-                         & "that such a call can dispatch to an overriding "
-                         & "operation declared in the private part of a "
-                         & "package" );
- 
-   Traveler( Travel_Agent_1 );
-   TCTouch.Validate("LPFLPFLPCLPBLPF","First Trip");
- 
-   Traveler( Travel_Agent_2 );
-   TCTouch.Validate("XPCXPCXPCXPC","Second Trip");
- 
-   Report.Result;
- 
- end C393010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,220 ****
- -- C393011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an abstract extended type can be derived from an abstract
- --      type, and that a a non-abstract type may then be derived from the
- --      second abstract type.
- --
- -- TEST DESCRIPTION:
- --      Define an abstract type with three primitive operations, two of them
- --      abstract.  Derive an extended type from it, inheriting the non-
- --      abstract operation, overriding one of the abstract operations with
- --      a non-abstract operation, and overriding the other abstract operation
- --      with an abstract operation.  The extended type is therefore abstract;
- --      derive an extended type from it.  Override the abstract operation with
- --      a non-abstract operation; inherit one operation from the original
- --      abstract type, and inherit one operation from the intermediate 
- --      abstract type.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-  
-  Package C393011_0 is
-      -- Definitions
-  
-    type Status_Enum is (None, Unhandled, Pending, Handled);
-    type Serial_Type is new Integer range 0 .. Integer'Last;
-    subtype Priority_Type is Integer range 0..10;
-  
-    type Display_Enum is (Bit_Bucket, TTY, Console, Big_Screen);
-  
-    Next : Serial_Type := 1;
-    Display_Device : Display_Enum := Bit_Bucket;
-  
-  end C393011_0;
-  -- Definitions;
-  
-  --=======================================================================--
-  
-  with C393011_0;
-    -- Definitions
-  
-  Package C393011_1 is
-       -- Alert
-  
-    package Definitions renames C393011_0;
-  
-    type Alert_Type is abstract tagged record         
-      Status     : Definitions.Status_Enum := Definitions.None;  
-      Serial_Num : Definitions.Serial_Type := 0;
-      Priority   : Definitions.Priority_Type;
-    end record;
-                              -- Alert_Type is an abstract type with
-                              -- two operations to be overridden
-  
-    procedure Set_Status ( A : in out Alert_Type;          -- not abstract
-                          To : Definitions.Status_Enum);
-  
-    procedure Set_Serial ( A : in out Alert_Type) is abstract;
-    procedure Display    ( A : Alert_Type)        is abstract;
-   
-  end C393011_1;
-   -- Alert
-  
-  --=======================================================================--
-  
-  with C393011_0;
-  package body C393011_1 is
-            -- Alert
-    procedure Set_Status ( A : in out Alert_Type;
-                          To : Definitions.Status_Enum) is
-      begin
-        A.Status := To;
-      end Set_Status;
-  
-  end C393011_1;
-   -- Alert;
-  
-  --=======================================================================--
-  
-  with C393011_0,
-    -- Definitions, 
-       C393011_1,
-    -- Alert, 
-       Calendar;
-  
-  Package C393011_3 is
-       -- New_Alert
-  
-    type New_Alert_Type is abstract new C393011_1.Alert_Type with record
-      Display_Dev : C393011_0.Display_Enum := C393011_0.TTY;
-    end record;
-  
-    -- procedure Set_Status is inherited
-  
-    procedure Set_Serial ( A : in out New_Alert_Type);   -- override/see body
-  
-    procedure Display    ( A : New_Alert_Type) is abstract;
-                           -- override is abstract 
-                           -- still can't declare objects of New_Alert_Type
-  
-  end C393011_3;
-   -- New_Alert
-  
-  --=======================================================================--
-  
-  with C393011_0;
-  Package Body C393011_3 is 
-            -- New_Alert
-  
-    package Definitions renames C393011_0;
-  
-    procedure Set_Serial (A : in out New_Alert_Type) is
-      use type Definitions.Serial_Type;
-      begin
-        A.Serial_Num := Definitions.Next;
-        Definitions.Next := Definitions."+"( Definitions.Next, 1);
-      end Set_Serial;
-  
-  End C393011_3;
-   -- New_Alert;
-  
-  --=======================================================================--
-  
-  with C393011_0,
-    -- Definitions 
-       C393011_3;
-    -- New_Alert  -- package Alert is not visible
-  package C393011_4 is
-  
-    package New_Alert renames C393011_3;
-    package Definitions renames C393011_0;
-  
-    type Final_Alert_Type is new New_Alert.New_Alert_Type with null record;
-    -- inherits Set_Status including body
-    -- inherits Set_Serial including body
-    -- must override Display since inherited Display is abstract
-    procedure Display(FA : in     Final_Alert_Type);
-    procedure Handle (FA : in out Final_Alert_Type);
-  
-  end C393011_4;
-  
-  package body C393011_4 is
-  
-    procedure Display    (FA : in Final_Alert_Type) is 
-      begin
-        Definitions.Display_Device := FA.Display_Dev;
-      end Display;
-  
-    procedure Handle (FA : in out Final_Alert_Type) is
-      begin
-        Set_Status (FA, Definitions.Handled);
-        Set_Serial (FA);
-        Display (FA);
-      end Handle;
-  end C393011_4;
-  
-  with C393011_0,
-    -- Definitions 
-       C393011_3;
-    -- New_Alert  -- package Alert is not visible
-  with C393011_4;
-  with Report;
-  procedure C393011 is
-    use C393011_4;
-    use Definitions;
-  
-    FA : Final_Alert_Type;
-  
-  begin
-  
-    Report.Test ("C393011", "Check that an extended type can be derived " &
-                            "from an abstract type");
-  
-    if (Definitions.Display_Device /= Definitions.Bit_Bucket)
-        or (Definitions.Next /= 1)
-        or (FA.Status /= Definitions.None)
-        or (FA.Serial_Num /= 0)
-        or (FA.Display_Dev /= TTY) then
-      Report.Failed ("Incorrect initial conditions");
-    end if;
-  
-    Handle (FA);
-    if (Definitions.Display_Device /= Definitions.TTY)
-        or (Definitions.Next /= 2)
-        or (FA.Status /= Definitions.Handled)
-        or (FA.Serial_Num /= 1)
-        or (FA.Display_Dev /= TTY) then
-      Report.Failed ("Incorrect results from Handle");
-    end if;
-  
-    Report.Result;
-  
-  end C393011;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,221 ****
- -- C393012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that a non-abstract subprogram of an abstract type can be
- --     called with a controlling operand that is a type conversion to
- --     the abstract type.
- --
- --     Check that converting to the class-wide type of an abstract type
- --     inside an operation of that type causes a "redispatch" of the
- --     called operation.
- --
- -- TEST DESCRIPTION:
- --     This test defines an abstract type, and further derives types from it.
- --     The key feature of this test is in the "Display" procedures where
- --     the bodies of these procedures convert an object to the class-wide
- --     type of the root abstract type, causing a "redispatch".
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Dec 94   SAIC    Add allocation to the object initializations
- --
- --!
- 
- package C393012_0 is
- 
-   subtype Row_Number  is Positive  range 1..120;
-   subtype Seat_Letter is Character range 'A'..'M';
- 
-   type Ticket is abstract tagged
-     record
-       Flight : Natural;
-       Row    : Row_Number;
-       Seat   : Seat_Letter;
-     end record;
- 
-    function Display( T: Ticket ) return String;
-    function Service( T: Ticket ) return String is abstract;
- 
- end C393012_0;
- 
- with TCTouch;
- package body C393012_0 is
-    function Display( T: Ticket ) return String is
-   begin
-     TCTouch.Touch('T');  --------------------------------------------------- T
-     return "Fl:" & Natural'Image(T.Flight)
-          & Service( Ticket'Class( T ) )   
-          & " Seat:" & Row_Number'Image(T.Row) & T.Seat;
-   end Display;
- end C393012_0;
- 
- with C393012_0;
- package C393012_1 is
-   type Economy is new C393012_0.Ticket with null record;
-   function Display( T: Economy ) return String;
-   function Service( T: Economy ) return String;
- 
-   type Meal_Designator is ( B, L, D, V, SN );
- 
-   type First is new C393012_0.Ticket with
-     record
-       Meal : Meal_Designator;
-     end record;
-   function Display( T: First ) return String;
-   function Service( T: First ) return String;
-   procedure Set_Meal( T: in out First; To_Meal : Meal_Designator );
- 
- end C393012_1;
- 
- with TCTouch;
- package body C393012_1 is
-   function Display( T: Economy ) return String is
-   begin
-     TCTouch.Touch('E');  --------------------------------------------------- E
-     return C393012_0.Display( C393012_0.Ticket( T ) );  
-   end Display;                -- conversion to abstract type
- 
-   function Service( T: Economy ) return String is
-   begin
-     TCTouch.Touch('e');  --------------------------------------------------- e
-     return " K";
-   end Service;
- 
-   function Display( T: First ) return String is
-   begin
-     TCTouch.Touch('F');  --------------------------------------------------- F
-     return C393012_0.Display( C393012_0.Ticket( T ) );  
-   end Display;                -- conversion to abstract type
- 
-   function Service( T: First ) return String is
-   begin
-     TCTouch.Touch('f');  --------------------------------------------------- f
-     return " F" & Meal_Designator'Image(T.Meal);
-   end Service;
- 
-   procedure Set_Meal( T: in out First; To_Meal : Meal_Designator ) is
-   begin
-     T.Meal := To_Meal;
-   end Set_Meal;
- 
- end C393012_1;
- 
- with Report;
- with TCTouch;
- with C393012_0;
- with C393012_1;
- procedure C393012 is
- 
-   package Rt renames C393012_0;
-   package Tx renames C393012_1;
- 
-   type Tix is access Rt.Ticket'Class;
-   type Itinerary is array(Positive range 1..3) of Tix;
- 
- -- Outbound and Inbound itineraries provide different orderings of mixtures
- -- of Economy and First_Class.  Not that that should make any difference...
- 
-   Outbound : Itinerary := ( 1 => new Tx.Economy'( 5335,  5, 'B' ),
-                             2 => new Tx.First'  (   67,  1, 'J', Tx.L ),
-                             3 => new Tx.Economy'(  345, 37, 'C' ) );
- 
-   Inbound  : Itinerary := ( 1 => new Tx.First'  (  456,  4, 'F', Tx.SN ),
-                             2 => new Tx.Economy'(   68, 12, 'D' ),
-                             3 => new Tx.Economy'( 5336,  6, 'A' ) );
- 
- -- Each call to Display uses a parameter that is a type conversion
- -- to the abstract type Ticket.
- 
-   procedure TC_Convert( I: Itinerary; Leg1,Leg2,Leg3: String ) is
-   begin
-     if Rt.Display( Rt.Ticket( I(1).all ) ) /= Leg1 then
-       Report.Failed( Rt.Display( Rt.Ticket( I(1).all ) ) & " /= " & Leg1 );
-     end if;
-     if Rt.Display( Rt.Ticket( I(2).all ) ) /= Leg2 then
-       Report.Failed( Rt.Display( Rt.Ticket( I(2).all ) ) & " /= " & Leg2 );
-     end if;
-     if Rt.Display( Rt.Ticket( I(3).all ) ) /= Leg3 then
-       Report.Failed( Rt.Display( Rt.Ticket( I(3).all ) ) & " /= " & Leg3 );
-     end if;
-   end TC_Convert;
- 
- -- Each call to Display uses a parameter that is not a type conversion
- 
-   procedure TC_Match( I: Itinerary; Leg1,Leg2,Leg3: String ) is
-   begin
-     if Rt.Display( I(1).all ) /= Leg1 then
-       Report.Failed( Rt.Display( I(1).all ) & " /= " & Leg1 );
-     end if;
-     if Rt.Display( I(2).all ) /= Leg2 then
-       Report.Failed( Rt.Display( I(2).all ) & " /= " & Leg2 );
-     end if;
-     if Rt.Display( I(3).all ) /= Leg3 then
-       Report.Failed( Rt.Display( I(3).all ) & " /= " & Leg3 );
-     end if;
-   end TC_Match;
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("C393012", "Check that a non-abstract subprogram of an "
-                          & "abstract type can be called with a "
-                          & "controlling operand that is a type "
-                          & "conversion to the abstract type.  "
-                          & "Check that converting to the class-wide type "
-                          & "of an abstract type inside an operation of "
-                          & "that type causes a redispatch" );
- 
-   -- Test conversions to abstract type
- 
-    TC_Convert( Outbound, "Fl: 5335 K Seat: 5B",
-                          "Fl: 67 FL Seat: 1J",
-                          "Fl: 345 K Seat: 37C" );
- 
-    TCTouch.Validate( "TeTfTe", "Outbound flight (converted)" );
- 
-    TC_Convert( Inbound, "Fl: 456 FSN Seat: 4F",
-                         "Fl: 68 K Seat: 12D",
-                         "Fl: 5336 K Seat: 6A" );
- 
-    TCTouch.Validate( "TfTeTe", "Inbound flight (converted)" );
- 
-   -- Test without conversions to abstract type
- 
-    TC_Match( Outbound, "Fl: 5335 K Seat: 5B",
-                        "Fl: 67 FL Seat: 1J",
-                        "Fl: 345 K Seat: 37C" );
- 
-    TCTouch.Validate( "ETeFTfETe", "Outbound flight" );
- 
-    TC_Match( Inbound, "Fl: 456 FSN Seat: 4F",
-                        "Fl: 68 K Seat: 12D",
-                        "Fl: 5336 K Seat: 6A" );
- 
-    TCTouch.Validate( "FTfETeETe", "Inbound flight" );
- 
-    Report.Result;
- 
- end C393012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,213 ****
- -- C393A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that a dispatching call to an abstract subprogram invokes
- --     the correct subprogram body of a descendant type according to
- --     the controlling tag.
- --     Check that a subprogram can be declared with formal parameters
- --     and result that are of an abstract type's associated class-wide
- --     type and that such subprograms can be called. 3.4.1(4)
- --
- -- TEST DESCRIPTION:
- --     This test declares several objects of types derived from the
- --     abstract type as defined in the foundation F393A00.  It then calls
- --     various dispatching and class-wide subprograms using those objects.
- --     The packages in F393A00 are instrumented to trace the flow of
- --     execution.
- --     The test checks for the correct order of execution, as expected
- --     by the various calls.
- --
- -- TEST FILES:
- --     The following files comprise this test:
- --
- --        F393A00.A   (foundation code)
- --        C393A02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --      05 APR 96   SAIC    Update RM references for 2.1
- --
- --!
- 
- with Report;
- with F393A00_0;
- with F393A00_1;
- with F393A00_2;
- with F393A00_3;
- with F393A00_4;
- procedure C393A02 is
- 
-   A_Windmill : F393A00_2.Windmill;
-   A_Pump     : F393A00_3.Pump;
-   A_Mill     : F393A00_4.Mill;
- 
-   A_Windmill_2 : F393A00_2.Windmill;
-   A_Pump_2     : F393A00_3.Pump;
-   A_Mill_2     : F393A00_4.Mill;
- 
-   B_Windmill : F393A00_2.Windmill;
-   B_Pump     : F393A00_3.Pump;
-   B_Mill     : F393A00_4.Mill;
- 
-   procedure Swapem( A,B: in out F393A00_2.Windmill'Class ) is
-   begin
-    F393A00_0.TC_Touch('x');
-    F393A00_2.Swap( A,B );
-   end Swapem;
- 
-   function Zephyr( A: F393A00_2.Windmill'Class )
-            return F393A00_2.Windmill'Class is
-     Item : F393A00_2.Windmill'Class := A;
-   begin
-     F393A00_0.TC_Touch('y');
-     if not F393A00_1.Initialized( Item ) then  -- b
-       F393A00_2.Initialize( Item );            -- a
-     end if;
-     F393A00_2.Stop( Item );                    -- f / mff
-     F393A00_2.Add_Spin( Item, 10 );            -- e
-     return Item;
-   end Zephyr;
- 
-   function Gale( It: F393A00_2.Windmill ) return F393A00_2.Windmill'Class is
-     Item : F393A00_2.Windmill'Class := It;
-   begin
-     F393A00_2.Stop( Item );                   -- f
-     F393A00_2.Add_Spin( Item, 40 );           -- e
-     return Item;
-   end Gale;
- 
-   function Gale( It: F393A00_3.Pump ) return F393A00_2.Windmill'Class is
-     Item : F393A00_2.Windmill'Class := It;
-   begin 
-     F393A00_2.Stop( Item );                   -- f
-     F393A00_2.Add_Spin( Item, 50 );           -- e
-     return Item;
-   end Gale;
- 
-   function Gale( It: F393A00_4.Mill ) return F393A00_2.Windmill'Class is
-     Item : F393A00_2.Windmill'Class := It;
-   begin 
-     F393A00_2.Stop( Item );                   -- mff
-     F393A00_2.Add_Spin( Item, 60 );           -- e
-     return Item;
-   end Gale;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C393A02", "Check that a dispatching call to an abstract "
-                          & "subprogram invokes the correct subprogram body. "
-                          & "Check that a subprogram declared with formal "
-                          & "parameters/result of an abstract type's "
-                          & "associated class-wide can be called" );
- 
-   F393A00_0.TC_Validate( "hhh", "Mill declarations" );
-   A_Windmill := F393A00_2.Create;
-   F393A00_0.TC_Validate( "d", "Create A_Windmill" );
- 
-   A_Pump     := F393A00_3.Create;
-   F393A00_0.TC_Validate( "h", "Create A_Pump" );
- 
-   A_Mill     := F393A00_4.Create;
-   F393A00_0.TC_Validate( "hl", "Create A_Mill" );
- 
-   --------------
- 
-   Swapem( A_Windmill, A_Windmill_2 );
-   F393A00_0.TC_Validate( "xc", "Windmill Swap" );
-   
-   Swapem( A_Pump, A_Pump_2 );
-   F393A00_0.TC_Validate( "xc", "Pump Swap" );
-   
-   Swapem( A_Mill, A_Mill_2 );
-   F393A00_0.TC_Validate( "xk", "Pump Swap" );
- 
-   F393A00_2.Initialize( A_Windmill_2 );  
-   F393A00_3.Initialize( A_Pump_2 );      
-   F393A00_4.Initialize( A_Mill_2 );      
-   B_Windmill := A_Windmill_2;
-   B_Pump     := A_Pump_2;
-   B_Mill     := A_Mill_2;                
-   F393A00_2.Add_Spin( B_Windmill, 123 ); 
-   F393A00_3.Set_Rate( B_Pump, 12.34 );   
-   F393A00_4.Add_Spin( B_Mill, 321 );     
-   F393A00_0.TC_Validate( "aaaeie", "Setting Values" );
- 
-   declare
-     It : F393A00_2.Windmill'Class := Zephyr( B_Windmill ); -- ybfe
-     XX : F393A00_2.Windmill'Class := Gale( B_Windmill );   -- fe
-     use type F393A00_2.Rotational_Measurement;
-   begin
-     if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
- then
-       Report.Failed( "Copy to class-wide variable" );
-     end if;                                                -- bb
-     if F393A00_2.Spin( It ) /= 10                          -- g
-        or F393A00_2.Spin( XX ) /= 40 then                  -- g
-       Report.Failed( "Call to class-wide operation" );
-     end if;
- 
-     F393A00_0.TC_Validate( "ybfefebbgg", "Windmill Zephyr" );
-   end;
- 
-   declare
-     It : F393A00_2.Windmill'Class := Zephyr( B_Pump );     -- ybfe
-     XX : F393A00_2.Windmill'Class := Gale( B_Pump );       -- fe
-     use type F393A00_2.Rotational_Measurement;
-   begin
-     if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
- then
-       Report.Failed( "Bad copy to class-wide variable" );
-     end if;                                                -- bb
-     if F393A00_2.Spin( It ) /= 10                          -- g
-        or F393A00_2.Spin( XX ) /= 50 then                  -- g
-       Report.Failed( "Call to class-wide operation" );
-     end if;
- 
-     F393A00_0.TC_Validate( "ybfefebbgg", "Pump Zephyr" );
-   end;
- 
-   declare
-     It : F393A00_2.Windmill'Class := Zephyr( B_Mill );     -- ybmffe
-     XX : F393A00_2.Windmill'Class := Gale( B_Mill );       -- mffe
-     use type F393A00_2.Rotational_Measurement;
-   begin
-     if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
- then
-       Report.Failed( "Bad copy to class-wide variable" );
-     end if;                                                -- bb
-     if F393A00_2.Spin( It ) /= 10                          -- g
-        or F393A00_2.Spin( XX ) /= 60 then                  -- g
-       Report.Failed( "Call to class-wide operation" );
-     end if;
- 
-     F393A00_0.TC_Validate( "ybmffemffebbgg", "Mill Zephyr" );
-   end;
- 
-   Report.Result;
- 
- end C393A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,242 ****
- -- C393A03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a non-abstract primitive subprogram of an abstract
- --      type can be called as a dispatching operation and that the body
- --      of this subprogram can make a dispatching call to an abstract
- --      operation of the corresponding abstract type. 
- --
- -- TEST DESCRIPTION:
- --      This test expands on the class family defined in foundation F393A00
- --      by deriving a new abstract type from the root abstract type "Object".
- --      The subprograms defined for the new abstract type are then
- --      appropriately overridden, and the test ultimately calls various
- --      mixtures of these subprograms to check that the dispatching occurs
- --      correctly.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F393A00.A   (foundation code)
- --         C393A03.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed ARM references from objective text.
- --      23 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
- --
- --!
- 
- ------------------------------------------------------------------- C393A03_0
- 
- with F393A00_1;
- package C393A03_0 is
- 
-   type Counting_Object is abstract new F393A00_1.Object with private;
-   -- inherits Initialize, Swap (abstract) and Create (abstract)
- 
-   procedure Bump ( A_Counter: in out Counting_Object );
-   procedure Clear( A_Counter: in out Counting_Object ) is abstract;
-   procedure Zero ( A_Counter: in out Counting_Object );
-   function  Value( A_Counter: Counting_Object'Class ) return Natural;
- 
- private
- 
-   type Counting_Object is abstract new F393A00_1.Object with
-     record
-       Tally : Natural :=0;
-     end record;
- 
- end C393A03_0;
- 
- -----------------------------------------------------------------------------
- 
- with F393A00_0;
- package body C393A03_0 is
- 
-   procedure Bump ( A_Counter: in out Counting_Object ) is
-   begin
-     F393A00_0.TC_Touch('A');
-     A_Counter.Tally := A_Counter.Tally +1;
-   end Bump;
- 
-   procedure Zero ( A_Counter: in out Counting_Object ) is
-   begin
-     F393A00_0.TC_Touch('B');
- 
-  -- dispatching call to abstract operation of Counting_Object
-     Clear( Counting_Object'Class(A_Counter) );
- 
-     A_Counter.Tally := 0;
- 
-   end Zero;
- 
-   function  Value( A_Counter: Counting_Object'Class ) return Natural is
-   begin
-     F393A00_0.TC_Touch('C');
-     return A_Counter.Tally;
-   end Value;
- 
- end C393A03_0;
- 
- ------------------------------------------------------------------- C393A03_1
- 
- with C393A03_0;
- package C393A03_1 is
- 
-   type Modular_Object is new C393A03_0.Counting_Object with private;
-   -- inherits Initialize, Bump, Zero and Value,
-   -- inherits abstract Swap, Create and Clear
- 
-   procedure Swap( A,B: in out Modular_Object );
-   procedure Clear( It: in out Modular_Object );
-   procedure Set_Max( It : in out Modular_Object; Value : Natural );
-   function  Create return Modular_Object;
- 
- private
- 
-   type Modular_Object is new C393A03_0.Counting_Object with
-     record
-       Max_Value : Natural;
-     end record;
- 
- end C393A03_1;
- 
- -----------------------------------------------------------------------------
- 
- with F393A00_0;
- package body C393A03_1 is
- 
-   procedure Swap( A,B: in out Modular_Object ) is
-     T : constant Modular_Object := B;
-   begin
-     F393A00_0.TC_Touch('1');
-     B := A;
-     A := T;
-   end Swap;
- 
-   procedure Clear( It: in out Modular_Object ) is
-   begin
-     F393A00_0.TC_Touch('2');
-     null;
-   end Clear;
- 
-   procedure Set_Max( It : in out Modular_Object; Value : Natural ) is
-   begin
-     F393A00_0.TC_Touch('3');
-     It.Max_Value := Value;
-   end Set_Max;
- 
-   function  Create return Modular_Object is
-     AMO : Modular_Object;
-   begin
-     F393A00_0.TC_Touch('4');
-     AMO.Max_Value := Natural'Last;
-     return AMO;
-   end Create;
- 
- end C393A03_1;
- 
- --------------------------------------------------------------------- C393A03
- 
- with Report;
- with F393A00_0;
- with F393A00_1;
- with C393A03_0;
- with C393A03_1;
- procedure C393A03 is
- 
-   A_Thing       : C393A03_1.Modular_Object;
-   Another_Thing : C393A03_1.Modular_Object;
- 
-   procedure Initialize( It: in out C393A03_0.Counting_Object'Class ) is
-   begin
-     C393A03_0.Initialize( It );  -- dispatch to inherited procedure
-   end Initialize;
- 
-   procedure Bump( It: in out C393A03_0.Counting_Object'Class ) is
-   begin
-     C393A03_0.Bump( It ); -- dispatch to non-abstract procedure
-   end Bump;
- 
-   procedure Set_Max( It  : in out C393A03_1.Modular_Object'Class;
-                      Val : Natural) is
-   begin
-     C393A03_1.Set_Max( It, Val ); -- dispatch to non-abstract procedure
-   end Set_Max;
- 
-   procedure Swap( A, B  : in out C393A03_0.Counting_Object'Class ) is
-   begin
-     C393A03_0.Swap( A, B ); -- dispatch to inherited abstract procedure
-   end Swap;
- 
-   procedure Zero( It: in out C393A03_0.Counting_Object'Class ) is
-   begin
-     C393A03_0.Zero( It ); -- dispatch to non-abstract procedure
-   end Zero;
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("C393A03", "Check that a non-abstract primitive subprogram "
- 			 & "of an abstract type can be called as a "
- 			 & "dispatching operation and that the body of this "
- 			 & "subprogram can make a dispatching call to an "
- 			 & "abstract operation of the corresponding "
- 			 & "abstract type" );
- 
-    A_Thing := C393A03_1.Create; -- Max_Value = Natural'Last
-    F393A00_0.TC_Validate( "4", "Overridden primitive layer 2");
- 
-    Initialize( A_Thing );
-    Initialize( Another_Thing );
-    F393A00_0.TC_Validate( "aa", "Non-abstract primitive layer 0");
-    
-    Bump( A_Thing ); -- Tally = 1
-    F393A00_0.TC_Validate( "A", "Non-abstract primitive layer 1");
- 
-    Set_Max( A_Thing, 42 ); -- Max_Value = 42
-    F393A00_0.TC_Validate( "3", "Non-abstract normal layer 2");
- 
-    if not F393A00_1.Initialized( A_Thing ) then
-      Report.Failed("Initialize didn't");
-    end if;
-    F393A00_0.TC_Validate( "b", "Class-wide layer 0");
- 
-    Swap( A_Thing, Another_Thing );
-    F393A00_0.TC_Validate( "1", "Overridden abstract layer 2");
- 
-    Zero( A_Thing );
-    F393A00_0.TC_Validate( "B2", "Non-abstract layer 0, calls dispatch");
- 
-    if C393A03_0.Value( A_Thing ) /= 0 then
-      Report.Failed("Zero didn't");
-    end if;
-    F393A00_0.TC_Validate( "C", "Class-wide normal layer 2");
- 
-    Report.Result;
- 
- end C393A03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a05.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a05.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a05.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a05.a	Thu Jan  1 00:00:00 1970
***************
*** 1,166 ****
- -- C393A05.A
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- OBJECTIVE:
-  --      Check that for a nonabstract private extension, any inherited
-  --      abstract subprograms can be overridden in the private part of
-  --      the immediately enclosing package and that calls can be made to
-  --      private dispatching operations.
-  --
-  -- TEST DESCRIPTION:
-  --      This test builds an additional layer upon the foundation code to
-  --      provide the required "hidden" dispatching operation.  The procedure
-  --      Swap, a private subprogram, should be called by dispatch.
-  --
-  -- TEST FILES:
-  --      The following files comprise this test:
-  --
-  --         F393A00.A   (foundation code)
-  --         C393A05.A
-  --
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  with F393A00_4;
-  package C393A05_0 is
-    type Grinder is new F393A00_4.Mill with private;
-    type Coarseness is (Whole_Bean, Coarse, Medium, Fine, Espresso);
-  
-    procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness );
-    function  Grind( It: Grinder ) return Coarseness;
-  
-    function  Create return Grinder;
-  private
-    procedure Swap( A,B: in out Grinder );
-    type Grinder is new F393A00_4.Mill with
-      record
-        Grind : Coarseness := Whole_Bean;
-      end record;
-  end C393A05_0;
-  
-  with F393A00_0;
-  package body C393A05_0 is
-    procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness ) is
-    begin
-      F393A00_0.TC_Touch( 'A' );
-      It.Grind := The_Grind;
-    end Set_Grind;
-  
-    function  Grind( It: Grinder ) return Coarseness is
-    begin
-      F393A00_0.TC_Touch( 'B' );
-      return It.Grind;
-    end Grind;
-  
-    procedure Swap( A,B: in out Grinder ) is
-      T : constant Grinder := A;
-    begin
-      F393A00_0.TC_Touch( 'C' );
-      A := B;
-      B := T;
-    end Swap;
-  
-    function  Create return Grinder is
-      One: Grinder;  
-    begin
-      F393A00_0.TC_Touch( 'D' );
-      F393A00_4.Initialize( F393A00_4.Mill( One ) );
-      One.Grind := Fine;
-      return One;
-    end Create;
-  end C393A05_0;
-  
-  with Report;
-  with F393A00_0;
-  with C393A05_0;
-  procedure C393A05 is
-  
-    package Tracer renames F393A00_0;
-    package Coffee renames C393A05_0;
-    use type Coffee.Coarseness;
-  
-    Morning   : Coffee.Grinder;
-    Afternoon : Coffee.Grinder;
-  
-    Gritty    : Coffee.Coarseness;
-  
-    procedure Class_Swap( A, B: in out Coffee.Grinder'Class ) is
-    begin
-      Coffee.Swap( A, B ); -- dispatch
-    end Class_Swap;
-  
-  begin  -- Main test procedure.
-  
-    Report.Test ("C393A05",  "Check that nonabstract private extensions, "
-                           & "inherited abstract subprograms overridden "
-                           & "in the private part can be dispatched from "
-                           & "outside the package" );
-  
-    Tracer.TC_Validate( "hh", "Declarations" );
-  
-    Morning := Coffee.Create;
-    Tracer.TC_Validate( "hDa", "Creating Morning Coffee" );
-    Gritty  := Coffee.Grind( Morning );
-    Tracer.TC_Validate( "B", "Finding Morning Grind" );
-  
-    Afternoon := Coffee.Create;
-    Tracer.TC_Validate( "hDa", "Creating Afternoon Coffee" );
-    Coffee.Set_Grind( Afternoon, Coffee.Medium );
-    Tracer.TC_Validate( "A", "Setting Afternoon Grind" );
-  
-    Coffee.Swap( Morning, Afternoon );
-    Tracer.TC_Validate( "C", "Dispatching Swapping Coffees" );
-  
-    if Gritty /= Coffee.Grind( Afternoon )
-       or Coffee.Grind ( Afternoon ) /= Coffee.Fine then
-      Report.Failed ("Result of Swap");
-    end if;
-    Tracer.TC_Validate( "BB", "Finding Afternoon Grind" );
-  
-    Sunset: declare
-      Evening   : Coffee.Grinder'Class := Coffee.Create;
-    begin
-      Tracer.TC_Validate( "hDa", "Creating Evening Coffee" );
-  
-      Coffee.Set_Grind( Evening, Coffee.Espresso );
-      Tracer.TC_Validate( "A", "Setting Evening Grind" );
-  
-      Morning := Coffee.Grinder( Evening );
-      Class_Swap( Morning, Evening );
-      Tracer.TC_Validate( "C", "Swapping Coffees" );
-      if Coffee.Grind( Morning ) /= Coffee.Espresso then
-        Report.Failed ("Result of Assignment");
-      end if;
-    end Sunset;
-  
-    Report.Result;
-  
-  end C393A05;
-  
-  
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a06.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a06.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393a06.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393a06.a	Thu Jan  1 00:00:00 1970
***************
*** 1,201 ****
- -- C393A06.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a type that inherits abstract operations but
- --      overrides each of these operations is not required to be
- --      abstract, and that objects of the type and its class-wide type
- --      may be declared and passed in calls to the overriding
- --      subprograms.
- --
- -- TEST DESCRIPTION:
- --      This test derives a type from the root abstract type available
- --      in foundation F393A00.  It declares subprograms as required by
- --      the language to override the abstract subprograms, allowing the
- --      derived type itself to be not abstract.  It also declares
- --      operations on the new type, as well as on the associated class-
- --      wide type.  The main program then uses two objects of the type
- --      and two objects of the class-wide type as parameters for each of
- --      the subprograms.  Correct execution is determined by path
- --      analysis and value checking.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F393A00.A   (foundation code)
- --         C393A06.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --
- --!
-  
-  with F393A00_1;
-  package C393A06_0 is
-    type Organism is new F393A00_1.Object with private;
-    type Kingdoms is ( Animal, Vegetable, Unspecified );
-  
-    procedure Swap( A,B: in out Organism );
-    function  Create return Organism;
-  
-    procedure Initialize( The_Entity     : in out Organism;
-                          In_The_Kingdom : Kingdoms );
-    function  Kingdom( Of_The_Entity : Organism ) return Kingdoms;
-  
-    procedure TC_Check( An_Entity   : Organism'Class;
-                        In_Kingdom  : Kingdoms;
-                        Initialized : Boolean );
-  
-    Incompatible : exception;
-  
-  private
-    type Organism is new F393A00_1.Object with
-      record
-        In_Kingdom : Kingdoms;
-      end record;
-  end C393A06_0;
-  
-  with F393A00_0;
-  package body C393A06_0 is
-  
-    procedure Swap( A,B: in out Organism ) is
-    begin
-      F393A00_0.TC_Touch( 'A' );  ------------------------------------------- A
-      if A.In_Kingdom /= B.In_Kingdom then
-        F393A00_0.TC_Touch( 'X' );
-        raise Incompatible;
-      else
-        declare
-          T: constant Organism := A;
-        begin
-          A := B;
-          B := T;
-        end;
-      end if;
-    end Swap;
-  
-    function  Create return Organism is
-      Widget : Organism;
-    begin
-      F393A00_0.TC_Touch( 'B' ); ------------------------------------------- B
-      Initialize( Widget );
-      Widget.In_Kingdom := Unspecified;
-      return Widget;
-    end Create;
-  
-    procedure Initialize( The_Entity     : in out Organism;
-                          In_The_Kingdom : Kingdoms ) is
-    begin
-      F393A00_0.TC_Touch( 'C' ); ------------------------------------------- C
-      F393A00_1.Initialize( F393A00_1.Object( The_Entity ) );
-      The_Entity.In_Kingdom := In_The_Kingdom;
-    end Initialize;
-  
-    function  Kingdom( Of_The_Entity : Organism ) return Kingdoms is
-    begin
-      F393A00_0.TC_Touch( 'D' ); ------------------------------------------- D
-      return Of_The_Entity.In_Kingdom;
-    end Kingdom;
-  
-    procedure TC_Check( An_Entity   : Organism'Class;
-                        In_Kingdom  : Kingdoms;
-                        Initialized : Boolean ) is
-    begin
-      if F393A00_1.Initialized( An_Entity ) /= Initialized then
-        F393A00_0.TC_Touch( '-' ); ------------------------------------------- -
-      elsif An_Entity.In_Kingdom /= In_Kingdom then
-        F393A00_0.TC_Touch( '!' ); ------------------------------------------- !
-      else
-        F393A00_0.TC_Touch( '+' ); ------------------------------------------- +
-      end if;
-    end TC_Check;
-  
-  end C393A06_0;
-  
-  with Report;
-  
-  with C393A06_0;
-  with F393A00_0;
-  with F393A00_1;
-  procedure C393A06 is
-  
-    package Darwin  renames C393A06_0;
-    package Tagger  renames F393A00_0;
-    package Objects renames F393A00_1;
-  
-    Lion      : Darwin.Organism;
-    Tigerlily : Darwin.Organism;
-    Bear      : Darwin.Organism'Class := Darwin.Create;
-    Sunflower : Darwin.Organism'Class := Darwin.Create;
-  
-    use type Darwin.Kingdoms;
-  
-  begin  -- Main test procedure.
-  
-     Report.Test ("C393A06", "Check that a type that inherits abstract "
-                           & "operations but overrides each of these "
-                           & "operations is not required to be abstract. "
-                           & "Check that objects of the type and its "
-                           & "class-wide type may be declared and passed "
-                           & "in calls to the overriding subprograms" );
-  
-    Tagger.TC_Validate( "BaBa", "Declaration Initializations" );
-  
-    Darwin.Initialize( Lion,      Darwin.Animal );
-    Darwin.Initialize( Tigerlily, Darwin.Vegetable );
-    Darwin.Initialize( Bear,      Darwin.Animal );
-    Darwin.Initialize( Sunflower, Darwin.Vegetable );
-  
-    Tagger.TC_Validate( "CaCaCaCa", "Initialization sequence" );
-  
-    Oh_My: begin
-      Darwin.Swap( Lion, Darwin.Organism( Bear ) );
-      Darwin.Swap( Lion, Tigerlily );
-      Report.Failed("Exception not raised");
-    exception
-      when Darwin.Incompatible => null;
-    end Oh_My;
-  
-    Tagger.TC_Validate( "AAX", "Swap sequence" );
-  
-    if Darwin.Kingdom( Darwin.Create ) = Darwin.Unspecified then
-      Darwin.Swap( Sunflower, Darwin.Organism'Class( Tigerlily ) );
-    end if;
-  
-    Tagger.TC_Validate( "BaDA", "Vegetable swap sequence" );
-  
-    Darwin.TC_Check( Lion,      Darwin.Animal,    True );
-    Darwin.TC_Check( Tigerlily, Darwin.Vegetable, True );
-    Darwin.TC_Check( Bear,      Darwin.Animal,    True );
-    Darwin.TC_Check( Sunflower, Darwin.Vegetable, True );
-  
-    Tagger.TC_Validate( "b+b+b+b+", "Final sequence" );
-  
-    Report.Result;
-  
-  end C393A06;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393b12.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393b12.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393b12.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393b12.a	Thu Jan  1 00:00:00 1970
***************
*** 1,131 ****
- -- C393B12.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an extended type can be derived in the specification of a
- --      generic package when the parent is an abstract type in a library
- --      package.
- --
- -- TEST DESCRIPTION:
- --      Extend an abstract type in the visible part of a generic package.
- --      Make all of the procedures which override abstract procedures
- --      available as part of the generic interface.  Instantiate the generic.
- --
- -- TEST FILES: 
- --      This test depends on the following foundation code:
- --
- --         F393B00.A  Package Alert_Foundation
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      14 Oct 95   SAIC    Update and repair for ACVC 2.0.1
- --      27 Feb 97   PWB.CTA Add pragma Elaborate for C393B12_0.
- --!
- 
- ----------------------------------------------------------------- C393B12_0
- 
- with F393B00;
-   -- Alert_Foundation
- generic 
-   type Generic_Status_Enum is (<>);
- 
- package C393B12_0 is
-      -- Alert_Functions
- 
-   type Generic_Alert_Type is new F393B00.Alert with record
-     Status : Generic_Status_Enum := Generic_Status_Enum'First;
-   end record;
-                                      -- extension of an abstract type
- 
-   procedure Handle (GA : in out Generic_Alert_Type);
-                                      -- override of abstract procedure
- 
-   function Query_Status (GA : Generic_Alert_Type)
-     return Generic_Status_Enum;      -- new primitive operation for
-                                      -- Generic_Alert_Type
- end C393B12_0;
-  -- Alert_Functions
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C393B12_0 is
-           -- Alert_Functions
- 
-   procedure Handle (GA : in out Generic_Alert_Type) is
-     begin
-       GA.Status := Generic_Status_Enum'Last;
-     end Handle;
- 
-   function Query_Status (GA : Generic_Alert_Type) 
-     return Generic_Status_Enum is
-     begin
-       return GA.Status;
-     end Query_Status;
- 
- end C393B12_0;
- 
- ----------------------------------------------------------------- C393B12_1
- 
- package C393B12_1 is
-   type Status is (Low, Medium, High);
- end C393B12_1;
- 
- ------------------------------------------------------- C393B12_1.C393B12_2
- 
- with C393B12_0;
- pragma Elaborate (C393B12_0);
- package C393B12_1.C393B12_2 is new C393B12_0 
-                         -- Alert_Functions
-                  (Generic_Status_Enum => Status);
- 
- ------------------------------------------------------------------- C393B12
- 
- with C393B12_1.C393B12_2;
- with Report;
- procedure C393B12 is
- 
-   use type C393B12_1.Status;
- 
-   package Alt_Alert renames C393B12_1.C393B12_2;
- 
-   GA : Alt_Alert.Generic_Alert_Type;
- 
- begin
-   Report.Test ("C393B12",  "Check that an extended type can be derived " &
-                            "from an abstract type");
- 
-   if Alt_Alert.Query_Status (GA) /= C393B12_1.Low then
-     Report.Failed ("Wrong initialization");
-   end if;
- 
-   Alt_Alert.Handle (GA);
-   if Alt_Alert.Query_Status (GA) /= C393B12_1.High then
-     Report.Failed ("Wrong results from Handle");
-   end if;
- 
-   Report.Result;
- 
- end C393B12;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393b13.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393b13.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393b13.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393b13.a	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C393B13.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an extended type can be derived from an abstract type
- --      when that derivation is declared in a child package.
- --
- -- TEST DESCRIPTION:
- --      Add a visible child to Alert_Foundation.  Using the abstract type
- --      Alert as parent, declare an extended type with discriminant and new
- --      record components.  Override the Handle procedure.
- --  
- -- TEST FILES: 
- --      This test depends on the following foundation code:
- --
- --         F393B00.A  Package Alert_Foundation
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
- --
- --!
- 
- package F393B00.C393B13_0 is
-      -- Alert_Foundation.Public_Child
- 
-   subtype Msg_Length_Range is integer range 0 .. 240;
-   Max_Msg_Length : constant Msg_Length_Range := 80;
-   Message : String := "Test Passed";
- 
-   type Child_Alert (Length : Msg_Length_Range) 
-     is new Alert with record        -- abstract type is in parent package
-       Times_Handled : Natural := 0;
-       Msg           : String (1..Length);
-     end record;
- 
-   procedure Handle (CA : in out Child_Alert);  -- required override
-   
- end F393B00.C393B13_0;
-  -- Alert_Foundation.Public_Child;
- 
- --=======================================================================--
- 
- package body F393B00.C393B13_0 is
-           -- Alert_Foundation.Public_Child
-   
-   procedure Handle (CA : in out Child_Alert) is
-     begin
-       CA.Msg(1..Message'Length) := Message;
-       CA.Times_Handled := CA.Times_Handled + 1;
-     end;
-   
- end F393B00.C393B13_0;
-  -- Alert_Foundation.Public_Child
- 
- --=======================================================================--
-   
- with Report;
- with F393B00.C393B13_0;
-   -- Alert_foundation.Public_Child;
- procedure C393B13 is
-   package Child renames F393B00.C393B13_0;
-   CA : Child.Child_Alert(Child.Message'Length);
-  
- begin
- 
-   Report.Test ("C393B13", "Check that an extended type can be derived " &
-                           "from an abstract type");
- 
-   if CA.Times_Handled /= 0 then
-     Report.Failed ("Wrong initialization");
-   end if;
- 
-   Child.Handle (CA);
-   if (CA.Times_Handled /= 1)
-   or (CA.Msg /= Child.Message) then
-     Report.Failed ("Wrong results from Handle");
-   end if;
-   
-   Report.Result;
- 
- end C393B13;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393b14.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393b14.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c393b14.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c393b14.a	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- C393B14.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an extended type can be derived in a private child package
- --      from an abstract type defined in a library package.
- --
- -- TEST DESCRIPTION:
- --      Add a private child package to Alert_Foundation.  Using Private_Alert
- --      as parent type, declare an extended type adding a new record component.
- --      Override procedure Handle.  Declare an object of the new type in the
- --      child specification. Use type definitions from the private part of the
- --      parent in the body of the child.
- --
- -- TEST FILES: 
- --      This test depends on the following foundation code:
- --
- --         F393B00.A  Package Alert_Foundation
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- private package F393B00.C393B14_0 is
-              -- Alert_Foundation.Private_Child
- 
-   type Implementation_Specific_Alert_Type is new Private_Alert with record
-     New_Private_Field : Implementation_Detail 
-                         := Implementation_Detail'Last;
-   end record;
- 
-   procedure Handle (PA : in out Implementation_Specific_Alert_Type);
-                              -- overrides abstract Handle, as required
-   PA : Implementation_Specific_Alert_Type;
- 
- end F393B00.C393B14_0;
-  -- Alert_Foundation.Private_Child
- 
- --=======================================================================--
- 
- package body F393B00.C393B14_0 is
-                   -- Alert_Foundation.Private_Child
- 
-   procedure Handle (PA : in out Implementation_Specific_Alert_Type) is
-     begin
-       PA.Private_Field := 1;
-       PA.New_Private_Field := PA.Private_Field + 1;
-     end;
- 
- end F393B00.C393B14_0;
-  -- Alert_Foundation.Private_Child
- 
- --=======================================================================--
- 
- package F393B00.C393B14_1 is
-      -- Alert_Foundation.Public_Child
- 
-   type Timing is (Before, After);
-   procedure Init;
-   procedure Modify;
-   function Check_Before return Boolean;
-   function Check_After  return Boolean;
- 
- end F393B00.C393B14_1;
-  -- Alert_Foundation.Public_Child
- 
- --=======================================================================--
- 
- with F393B00.C393B14_0;               -- private sibling is visible in the
-   -- Alert_Foundation.Private_Child   -- body of a public sibling
- package body F393B00.C393B14_1 is
-      -- Alert_Foundation.Public_Child
-   package Priv renames F393B00.C393B14_0;
- 
-   procedure Init is
-     begin
-       Priv.PA.Private_Field     := 5;
-       Priv.PA.New_Private_Field := 10;
-     end Init;
- 
-   procedure Modify is
-     begin 
-       Priv.Handle (Priv.PA);
-     end Modify;
- 
-   function Check_Before return Boolean is
-     begin
-       return ((Priv.PA.Private_Field = 5) 
-                and (Priv.PA.New_Private_Field =10));
-     end Check_Before;
- 
-   function Check_After return Boolean is
-     begin
-       return ((Priv.PA.Private_Field = 1)
-                and (Priv.PA.New_Private_Field = 2));
-     end Check_After;
- 
- end F393B00.C393B14_1;
-  -- Alert_Foundation.Public_Child
- 
- --=======================================================================--
- 
- with Report;
- with F393B00.C393B14_1;
- procedure C393B14 is
-  -- Alert_Foundation.Public_Child;
- 
- begin
-   Report.Test ("C393B14", "Check that an extended type can be derived " &
-                           "from an abstract type");
- 
-   F393B00.C393B14_1.Init;
-   if not F393B00.C393B14_1.Check_Before then 
-     Report.Failed ("Wrong initialization");
-   end if;
- 
-   F393B00.C393B14_1.Modify;
-   if not F393B00.C393B14_1.Check_After then
-     Report.Failed ("Wrong results from Handle");
-   end if;
- 
-   Report.Result;
- end C393B14;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- C3A0001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that access to subprogram type can be used to select and
- --      invoke functions with appropriate arguments dynamically.
- --
- -- TEST DESCRIPTION:
- --      Declare an access to function type in a package specification.  
- --      Declare three different sine functions that can be referred to by 
- --      the access to function type.  
- --      
- --      In the main program, call each function indirectly by dereferencing 
- --      the access value.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C3A0001_0 is
-    
-    TC_Call_Tag : Natural := 0;
- 
-    -- Type accesses to any sine function
-    type Sine_Function_Ptr is access function   
-       (Angle : in Float) return Float;
- 
- -- Three 'Sine' functions that model an application situation in which
- -- one function might be chosen when speed is important, another (using
- -- a different algorithm) might be chosen when accuracy is important,
- -- and so on.
- 
-    function Sine_Calc_Fast  (Angle : in Float) return Float;         
- 
-    function Sine_Calc_Acc   (Angle : in Float) return Float;        
- 
-    function Sine_Calc_Table (Angle : in Float) return Float;        
- 
- end C3A0001_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body C3A0001_0 is
- 
-    function Sine_Calc_Fast (Angle : in Float) return Float is
-    begin
-       TC_Call_Tag := 1;
-       return 1.0;
-    end Sine_Calc_Fast;
- 
- 
-    function Sine_Calc_Acc (Angle : in Float) return Float is
-    begin
-       TC_Call_Tag := 2;
-       return 0.0;
-    end Sine_Calc_Acc;
- 
- 
-    function Sine_Calc_Table (Angle : in Float) return Float is
-    begin
-       TC_Call_Tag := 3;
-       return -1.0;         
-    end Sine_Calc_Table;
- 
- end C3A0001_0;
- 
- -----------------------------------------------------------------------------
- 
- with Report;
- with C3A0001_0;
- 
- procedure C3A0001 is
- 
-    Sine_Access : C3A0001_0.Sine_Function_Ptr;
-    X, Theta    : Float := 0.0;
- 
- begin
- 
-    Report.Test ("C3A0001", "Check that access to subprogram can be " &
-                 "used to select and invoke an operation with " &
-                 "appropriate arguments dynamically");
- 
-    Sine_Access := C3A0001_0.Sine_Calc_Fast'Access;
- 
-    -- Invoking Sine function designated by access value
-    X := Sine_Access(Theta);
- 
-    If C3A0001_0.TC_Call_Tag /= 1 then
-       Report.Failed ("Incorrect Sine_Calc_Fast result");
-    end if;
- 
-    Sine_Access := C3A0001_0.Sine_Calc_Acc'Access;
- 
-    -- Invoking Sine function designated by access value
-    X := Sine_Access(Theta);
- 
-    If C3A0001_0.TC_Call_Tag /= 2 then
-       Report.Failed ("Incorrect Sine_Calc_Acc result");
-    end if;
- 
-    Sine_Access := C3A0001_0.Sine_Calc_Table'Access;
- 
-    -- Invoking Sine function designated by access value
-    X := Sine_Access(Theta);
- 
-    If C3A0001_0.TC_Call_Tag /= 3 then
-       Report.Failed ("Incorrect Sine_Calc_Table result");
-    end if;
- 
-    Report.Result;
- 
- end C3A0001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C3A0002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that access to subprogram type can be used to select and 
- --      invoke procedures with appropriate arguments dynamically.
- --
- -- TEST DESCRIPTION:
- --      Declare an access to procedure type in a package specification.  
- --      Declare three different log procedures that can be referred to by 
- --      the access to procedure type.  
- -- 
- --      In the main program, call each procedure indirectly by dereferencing 
- --      the access value.
- -- 
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      05 APR 96   SAIC    RM reference change for 2.1
- --
- --
- --!
- 
- 
- package C3A0002_0 is
- 
-    TC_Call_Tag : Natural := 0;
- 
-    Return_Num          : Float   := 0.0;
- 
-    -- Type accesses to any log procedure
-    type Log_Procedure_Ptr is access procedure   
-       (Angle : in Float);
- 
-    procedure Log_Calc_Fast  (Angle : in Float);         
- 
-    procedure Log_Calc_Acc   (Angle : in Float);        
- 
-    procedure Log_Calc_Table (Angle : in Float);
- 
- end C3A0002_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body C3A0002_0 is
- 
-    procedure Log_Calc_Fast (Angle : in Float) is
-    begin
-       TC_Call_Tag := 1;
-       Return_Num := Angle;
-    end Log_Calc_Fast;
- 
- 
-    procedure Log_Calc_Acc (Angle : in Float) is
-    begin
-       TC_Call_Tag  := 2;
-       Return_Num := Angle;
-    end Log_Calc_Acc;
- 
- 
-    procedure Log_Calc_Table (Angle : in Float) is
-    begin
-       TC_Call_Tag := 3;
-       Return_Num := Angle;
-    end Log_Calc_Table;
- 
- end C3A0002_0;
- 
- -----------------------------------------------------------------------------
- 
- with Report;
- with C3A0002_0; 
- 
- procedure C3A0002 is
- 
-    Log_Access : C3A0002_0.Log_Procedure_Ptr;
-    Theta      : Float := 0.0;
- 
- begin
- 
-    Report.Test ("C3A0002", "Check that access to subprogram type can be "
-                          & "used to select and invoke procedures with "
-                          & "appropriate arguments dynamically" );
- 
-    Log_Access := C3A0002_0.Log_Calc_Fast'Access;
- 
-    -- Invoking Log procedure designated by access value
-    Log_Access (Theta);
- 
-    If C3A0002_0.TC_Call_Tag /= 1 or C3A0002_0.Return_Num /= 0.0 then
-       Report.Failed ("Incorrect Log_Calc_Fast result");
-    end if;
- 
-    Theta := 1.0;
- 
-    Log_Access := C3A0002_0.Log_Calc_Acc'Access;
- 
-    -- Invoking Log procedure designated by access value
-    Log_Access (Theta);
- 
-    If C3A0002_0.TC_Call_Tag /= 2 or C3A0002_0.Return_Num /= 1.0 then
-       Report.Failed ("Incorrect Log_Calc_Acc result");
-    end if;
- 
-    Theta := -1.0;
- 
-    Log_Access := C3A0002_0.Log_Calc_Table'Access;
- 
-    -- Invoking Log procedure designated by access value
-    Log_Access (Theta);
- 
-    If C3A0002_0.TC_Call_Tag /= 3 or C3A0002_0.Return_Num /= -1.0 then
-       Report.Failed ("Incorrect Log_Calc_Table result");
-    end if;
- 
-    Report.Result;
- 
- end C3A0002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- C3A0003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a function in a generic instance can be called using
- --      an access-to-subprogram value.
- --
- -- TEST DESCRIPTION:
- --      Declare a numeric type in the visible part of a generic package.
- --      Declare an access to function type.  Declare three different sine 
- --      functions that can be referred to by the access to function type.  
- --
- --      In the main program, instantiate the generic.  Call each function 
- --      indirectly by dereferencing the access value.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic
-    type Real_Num is digits <>;
- 
- package C3A0003_0 is
-    
-    TC_Call_Tag : Natural := 0;
- 
-    -- Type accesses to any sine function
-    type Sine_Function_Ptr is access function   
-       (Angle : in Real_Num) return Real_Num;
- 
-    function Sine_Calc_Fast  (Angle : in Real_Num) return Real_Num;         
- 
-    function Sine_Calc_Acc   (Angle : in Real_Num) return Real_Num;        
- 
-    function Sine_Calc_Table (Angle : in Real_Num) return Real_Num;        
- 
- end C3A0003_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body C3A0003_0 is
- 
-    function Sine_Calc_Fast (Angle : in Real_Num) return Real_Num is
-       Sine_Num : Real_Num := 1.0;
-    begin
-       TC_Call_Tag := 1;
-       return Sine_Num;
-    end Sine_Calc_Fast;
- 
- 
-    function Sine_Calc_Acc (Angle : in Real_Num) return Real_Num is
-       Sine_Num : Real_Num := 0.0;
-    begin
-       TC_Call_Tag := 2;
-       return Sine_Num;
-    end Sine_Calc_Acc;
- 
- 
-    function Sine_Calc_Table (Angle : in Real_Num) return Real_Num is
-       Sine_Num : Real_Num := -1.0;
-    begin
-       TC_Call_Tag := 3;
-       return Sine_Num;
-    end Sine_Calc_Table;
- 
- end C3A0003_0;
- 
- -----------------------------------------------------------------------------
- 
- with Report;
- with C3A0003_0;
- 
- procedure C3A0003 is
- 
-    type Real is digits 5;
- 
-    Subtype Trig_Float is Real range -1.0 .. 1.0;
- 
-    package Trig is new C3A0003_0 (Real_Num => Trig_Float);
- 
-    Sine_Access : Trig.Sine_Function_Ptr;
-    X, Theta    : Trig_Float := 0.0;
- 
- begin
- 
-    Report.Test ("C3A0003", "Check that a function in a generic instance can "
-                          & "be called using an access-to-subprogram value");
- 
-    Sine_Access := Trig.Sine_Calc_Fast'Access;
- 
-    -- Invoking Sine function designated by access value
-    X := Sine_Access.all(Theta);
- 
-    If Trig.TC_Call_Tag /= 1 then
-       Report.Failed ("Incorrect Sine_Calc_Fast result");
-    end if;
- 
-    Sine_Access := Trig.Sine_Calc_Acc'Access;
- 
-    -- Invoking Sine function designated by access value
-    X := Sine_Access.all(Theta);
- 
-    If Trig.TC_Call_Tag /= 2 then
-       Report.Failed ("Incorrect Sine_Calc_Acc result");
-    end if;
- 
-    Sine_Access := Trig.Sine_Calc_Table'Access;
- 
-    -- Invoking Sine function designated by access value
-    X := Sine_Access.all(Theta);
- 
-    If Trig.TC_Call_Tag /= 3 then
-       Report.Failed ("Incorrect Sine_Calc_Table result");
-    end if;
- 
-    Report.Result;
- 
- end C3A0003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- C3A0004.A
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- OBJECTIVE: 
-  --      Check that access to subprogram may be stored within array 
-  --      objects, and that the access to subprogram can subsequently 
-  --      be called. 
-  -- 
-  -- TEST DESCRIPTION:
-  --      Declare an access to procedure type in a package specification.  
-  --      Declare an array of the access type.  Declare three different 
-  --      procedures that can be referred to by the access to procedure type.  
-  --
-  --      In the main program, build the array by dereferencing the access 
-  --      value.
-  --
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  with Report;
-  
-  procedure C3A0004 is
-  
-     Left_Turn   : Integer  := 1;
-  
-     Right_Turn  : Integer  := 1;
-  
-     Center_Turn : Integer  := 1;
-  
-     -- Type accesses to any procedure
-     type Action_Ptr is access procedure;
-     
-     -- Array of access to procedure
-     type Action_Array is array (Integer range <>) of Action_Ptr;
-  
-  
-     procedure Rotate_Left is
-     begin
-        Left_Turn := 2;
-     end Rotate_Left;
-  
-  
-     procedure Rotate_Right is
-     begin
-        Right_Turn := 3;
-     end Rotate_Right;
-  
-  
-     procedure Center is
-     begin
-        Center_Turn := 0;
-     end Center;
-  
-  
-  begin
-  
-     Report.Test ("C3A0004", "Check that access to subprogram may be "
-                           & "stored within data structures, and that the "
-                           & "access to subprogram can subsequently be called");
-  
-     ------------------------------------------------------------------------
-  
-     declare
-        Total_Actions   : constant := 3;
-        Action_Sequence : Action_Array (1 .. Total_Actions);
-  
-     begin
-  
-        -- Build the action sequence
-        Action_Sequence := (Rotate_Left'Access, Center'Access,
-                            Rotate_Right'Access);
-  
-        -- Assign actions by invoking subprogram designated by access value
-        for I in Action_Sequence'Range loop
-           Action_Sequence(I).all;
-        end loop;
-  
-        If Left_Turn /= 2 or Right_Turn /= 3
-           or Center_Turn /= 0 then
-              Report.Failed ("Incorrect Action sequence result");
-        end if;
-  
-      end;
-  
-     ------------------------------------------------------------------------
-  
-     Report.Result;
-  
-  end C3A0004;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- C3A0005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that access to subprogram may be stored within record 
- --      objects, and that the access to subprogram can subsequently 
- --      be called. 
- -- 
- -- TEST DESCRIPTION:
- --      Declare an access to procedure type in a package specification.  
- --      Declare two different procedures that can be referred to by the 
- --      access to procedure type.  Declare a record with the access to 
- --      procedure type as a component.  Use the access to procedure type to 
- --      initialize the component of a record.  
- --
- --      In the main program, declare an operation.  An access value 
- --      designating this operation is passed as a parameter to be 
- --      stored in the record.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C3A0005_0 is
- 
-    Default_Call   : Boolean := False;
- 
-    type Button;
- 
- 
-    -- Type accesses to procedures Push and Default_Response
-    type Button_Response_Ptr is access procedure
-       (B : access Button);
- 
-    procedure Push (B : access Button);
- 
-    procedure Set_Response (B : access Button;
-                            R : in Button_Response_Ptr);
- 
-    procedure Default_Response  (B : access Button);
- 
-    Emergency_Call : Boolean := False;
- 
-    procedure Emergency (B : access C3A0005_0.Button);
- 
-    type Button is
-       record
-          Response :  Button_Response_Ptr
-                   := Default_Response'Access;   
-       end record;
- 
- end C3A0005_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- with TCTouch;
- package body C3A0005_0 is
- 
-    procedure Push (B : access Button) is
-    begin
-       TCTouch.Touch( 'P' ); --------------------------------------------- P
-       -- Invoking subprogram designated by access value
-       B.Response (B);
-    end Push;
- 
- 
-    procedure Set_Response (B : access Button;
-                            R : in     Button_Response_Ptr) is
-    begin
-       TCTouch.Touch( 'S' ); --------------------------------------------- S
-       -- Set procedure value in record
-       B.Response := R;
-    end Set_Response;
- 
- 
-    procedure Default_Response (B : access Button) is
-    begin
-       TCTouch.Touch( 'D' ); --------------------------------------------- D
-       Default_Call := True;
-    end Default_Response;
- 
- 
-    procedure Emergency (B : access C3A0005_0.Button) is
-    begin
-       TCTouch.Touch( 'E' ); --------------------------------------------- E
-       Emergency_Call := True;
-    end Emergency;
- 
- end C3A0005_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- with TCTouch;
- with Report;
- 
- with C3A0005_0;
- 
- procedure C3A0005 is
- 
-    Big_Red_Button : aliased C3A0005_0.Button;
- 
- begin
- 
-    Report.Test ("C3A0005", "Check that access to subprogram may be "
-                          & "stored within data structures, and that the "
-                          & "access to subprogram can subsequently be called");
- 
-    C3A0005_0.Push (Big_Red_Button'Access);
-    TCTouch.Validate("PD", "Using default value");
-    TCTouch.Assert( C3A0005_0.Default_Call, "Default Call" );
- 
-    -- set Emergency value in Button.Response
-    C3A0005_0.Set_Response(Big_Red_Button'Access, C3A0005_0.Emergency'Access);
- 
-    C3A0005_0.Push (Big_Red_Button'Access);
-    TCTouch.Validate("SPE", "After set to Emergency value");
-    TCTouch.Assert( C3A0005_0.Emergency_Call, "Emergency Call");
- 
-    Report.Result;
- 
- end C3A0005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- C3A0006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that access to subprogram may be stored within data 
- --      structures, and that the access to subprogram can subsequently 
- --      be called. 
- -- 
- -- TEST DESCRIPTION:
- --      Declare an access to function type in a package specification.  
- --      Declare an array of the access type.  Declare three different 
- --      functions that can be referred to by the access to function type.  
- --      
- --      In the main program, declare a key function that builds the array 
- --      by calling each function indirectly through the access value.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package C3A0006_0 is
- 
-    TC_Sine_Call  : Integer := 0;
-    TC_Cos_Call   : Integer := 0;
-    TC_Tan_Call   : Integer := 0;
- 
-    Sine_Value    : Float :=  4.0;
-    Cos_Value     : Float :=  8.0;
-    Tan_Value     : Float := 10.0;
- 
-    -- Type accesses to any function
-    type Trig_Function_Ptr is access function        
-       (Angle : in Float) return Float;
- 
-    function Sine (Angle : in Float) return Float;         
- 
-    function Cos  (Angle : in Float) return Float;        
- 
-    function Tan  (Angle : in Float) return Float;         
- 
- end C3A0006_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body C3A0006_0 is
- 
-    function Sine (Angle : in Float) return Float is
-    begin
-      TC_Sine_Call := TC_Sine_Call + 1;
-      Sine_Value := Sine_Value + Angle;
-      return Sine_Value;
-    end Sine;
- 
- 
-    function Cos  (Angle: in Float) return Float is
-    begin
-      TC_Cos_Call := TC_Cos_Call + 1;
-      Cos_Value := Cos_Value - Angle;
-      return Cos_Value;
-    end Cos;
- 
- 
-    function Tan (Angle : in Float) return Float is
-    begin
-      TC_Tan_Call := TC_Tan_Call + 1;
-      Tan_Value := (Tan_Value + (Tan_Value * Angle));
-      return Tan_Value;
-    end Tan;
- 
- 
- end C3A0006_0;
- 
- -----------------------------------------------------------------------------
- 
- 
- with Report;
- 
- with C3A0006_0; 
- 
- procedure C3A0006 is
- 
-    Trig_Value, Theta  : Float := 0.0;
- 
-    Total_Routines     : constant := 3;
- 
-    Sine_Total         : constant := 7.0;
-    Cos_Total          : constant := 5.0;
-    Tan_Total          : constant := 75.0;
- 
-    Trig_Table : array (1 .. Total_Routines) of C3A0006_0.Trig_Function_Ptr;
- 
- 
-    -- Key function to build the table
-    function Call_Trig_Func (Func : C3A0006_0.Trig_Function_Ptr;
-                             Operand : Float) return Float is 
-    begin
-       return (Func(Operand));
-    end Call_Trig_Func;
- 
- 
- begin
- 
-    Report.Test ("C3A0006", "Check that access to subprogram may be " &
-                 "stored within data structures, and that the access " &
-                 "to subprogram can subsequently be called");
- 
-    Trig_Table := (C3A0006_0.Sine'Access, C3A0006_0.Cos'Access, 
-                   C3A0006_0.Tan'Access);
- 
-    -- increase the value of Theta to build the table
-    for I in 1 .. Total_Routines loop
-       Theta := Theta + 0.5;
-       for J in 1 .. Total_Routines loop
-          Trig_Value     := Call_Trig_Func (Trig_Table(J), Theta);
-       end loop;
-    end loop;
- 
-    if C3A0006_0.TC_Sine_Call /= Total_Routines 
-      or C3A0006_0.TC_Cos_Call /= Total_Routines
-      or C3A0006_0.TC_Tan_Call /= Total_Routines then
-         Report.Failed ("Incorrect subprograms result");
-    end if;
- 
-    if C3A0006_0.Sine_Value /= Sine_Total
-      or C3A0006_0.Cos_Value /= Cos_Total
-      or C3A0006_0.Tan_Value /= Tan_Total then
-         Report.Failed ("Incorrect values returned from subprograms");
-    end if;
- 
-    if Trig_Value /= Tan_Total then
-         Report.Failed ("Incorrect call order.");
-    end if;
- 
-    Report.Result;
- 
- end C3A0006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- C3A0007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a call to a subprogram via an access-to-subprogram value
- --      stored in a data structure will correctly dispatch according to the
- --      tag of the class-wide parameter passed via that call.
- -- 
- -- TEST DESCRIPTION:
- --      Declare an access to procedure type in a package specification. 
- --      Declare a root tagged type with the access to procedure type as a 
- --      component.  Declare three primitive procedures for the type that 
- --      can be referred to by the access to procedure type.  Use the access 
- --      to procedure type to initialize the component of a record.
- --
- --      Extend the root type with a record extension in another package
- --      specification. Declare a new primitive procedure for the extension
- --      (in addition to its three inherited subprograms).
- --
- --      In the main program, declare an operation for the root tagged type 
- --      which can be passed as an access value to change the initial value
- --      of the component.  Call the inherited operation indirectly by 
- --      dereferencing the access value to check on the initial value of the 
- --      extension.  Call inherited operations indirectly by dereferencing 
- --      the access value to replace the initial value.  Call the primitive 
- --      procedure indirectly by dereferencing the access value to modify the 
- --      extension.
- --
- --          type Button
- --            procedure Push(Button)
- --            procedure Set_Response(Button,Button_Response_Ptr)
- --            procedure Default_Response(Button)
- --
- --          type Priority_Button (new Button)
- --            procedures Push, Set_Response inherited
- --            procedure Default_Response
- --            procedure Set_Priority
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C3A0007_0 is
- 
-    Default_Call   : Boolean := False;
- 
-    type Button is tagged private;
- 
-    type Button_Response_Ptr is access procedure
-       (B : in out Button'Class);
- 
-    procedure Push (B : in out Button);               -- to be inherited
- 
-    procedure Set_Response (B : in out Button;        -- to be inherited
-                            R : in Button_Response_Ptr);
- 
-    procedure Response  (B : in out Button);          -- to be inherited
- 
- private
-    procedure Default_Response(B: in out Button'Class);
-    type Button is tagged                             -- root tagged type
-       record
-          Action :  Button_Response_Ptr 
-                   := Default_Response'Access;   
-       end record;
- end C3A0007_0;
- 
- with C3A0007_0;
- package C3A0007_1 is
- 
-    type Priority_Button is new C3A0007_0.Button
-      with record
-         Priority : Integer := 0;
-       end record;
- 
-    -- Inherits procedure Push from Button
-    -- Inherits procedure Set_Response from Button
- 
-    -- Override procedure Response from Button
-    procedure Response (B : in out Priority_Button);
- 
-    -- Primitive operation of the extension
-    procedure Set_Priority (B : in out Priority_Button);
- 
- end C3A0007_1;
- 
- with C3A0007_0;
- package C3A0007_2 is
- 
-    Emergency_Call : Boolean := False;
- 
-    procedure Emergency (B : in out C3A0007_0.Button'Class);
- end C3A0007_2;
- 
- -----------------------------------------------------------------------------
- 
- with TCTouch;
- package body C3A0007_0 is
- 
-    procedure Push (B : in out Button) is
-    begin
-       TCTouch.Touch( 'P' ); --------------------------------------------- P
-       -- Invoking subprogram designated by access value
-       B.Action (B);
-    end Push;
- 
- 
-    procedure Set_Response (B : in out Button;
-                            R : in     Button_Response_Ptr) is
-    begin
-       TCTouch.Touch( 'S' ); --------------------------------------------- S
-       -- Set procedure value in record
-       B.Action := R;
-    end Set_Response;
- 
- 
-    procedure Response (B : in out Button) is
-    begin
-       TCTouch.Touch( 'D' ); --------------------------------------------- D
-       Default_Call := True;
-    end Response;
- 
-    procedure Default_Response (B : in out Button'Class) is
-    begin
-       TCTouch.Touch( 'C' ); --------------------------------------------- C
-       Response(B);
-    end Default_Response;
- 
- end C3A0007_0;
- 
- with TCTouch;
- package body C3A0007_1 is
- 
-    procedure Set_Priority (B : in out Priority_Button) is
-    begin
-       TCTouch.Touch( 's' ); --------------------------------------------- s
-       B.Priority := 1;
-    end Set_Priority;
- 
-    procedure Response (B : in out Priority_Button) is
-    begin
-       TCTouch.Touch( 'd' ); --------------------------------------------- d
-    end Response;
- 
- end C3A0007_1;
- 
- with TCTouch;
- package body C3A0007_2 is
-    procedure Emergency (B : in out C3A0007_0.Button'Class) is
-       begin
-         TCTouch.Touch( 'E' ); ------------------------------------------- E
-         Emergency_Call := True;
-       end Emergency;
- end C3A0007_2;
- 
- -----------------------------------------------------------------------------
- 
- with Report;
- with TCTouch;
- 
- with C3A0007_0; 
- with C3A0007_1; 
- with C3A0007_2;
- procedure C3A0007 is
- 
-    Pink_Button  : C3A0007_0.Button;
-    Green_Button : C3A0007_1.Priority_Button;
- 
- begin
- 
-    Report.Test ("C3A0007", "Check that a call to a subprogram via an "
-                          & "access-to-subprogram value stored in a data "
-                          & "structure will correctly dispatch according to "
-                          & "the tag of the class-wide parameter passed "
-                          & "via that call" );
- 
-    -- Call inherited operation Push to set Default_Response value 
-    -- in the extension.
- 
-    C3A0007_1.Push (Green_Button);
-    TCTouch.Validate("PCd", "First Green Button Push");
- 
-    TCTouch.Assert_Not(C3A0007_0.Default_Call,
-                          "Incorrect Green Default_Response");
- 
-    C3A0007_0.Push (Pink_Button);
-    TCTouch.Validate("PCD", "First Pink Button Push");
- 
-    -- Call inherited operations Set_Response and Push to set 
-    -- Emergency value in the extension.
-    C3A0007_1.Set_Response (Green_Button, C3A0007_2.Emergency'Access);  
-    C3A0007_1.Push (Green_Button);
-    TCTouch.Validate("SPE", "Second Green Button Push");
- 
-    TCTouch.Assert(C3A0007_2.Emergency_Call, "Incorrect Green Emergency");
- 
-    C3A0007_0.Set_Response (Pink_Button, C3A0007_2.Emergency'Access);  
-    C3A0007_0.Push (Pink_Button);
-    TCTouch.Validate("SPE", "Second Pink Button Push");
- 
-    -- Call primitive operation to set priority value 
-    -- in the extension.
-    C3A0007_1.Set_Priority (Green_Button);
-    TCTouch.Validate("s", "Green Button Priority");
- 
-    TCTouch.Assert(Green_Button.Priority = 1, "Incorrect Set_Priority");
- 
-    Report.Result;
- 
- end C3A0007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- C3A0008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that subprogram references may be passed as parameters using 
- --      access-to-subprogram types. Check that the passed subprograms may 
- --      be invoked from within the called subprogram.
- --
- -- TEST DESCRIPTION:
- --      Declare an access to function type in a package specification.  
- --      Declare three different trig functions that can be referred to by 
- --      the access to function type.  
- --
- --      In the main program, call each function indirectly by passing the 
- --      access to subprogram value as parameter.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package Integrate_Lookup is
- 
-   TC_Log_Call  : Boolean := False;
- 
-   TC_Cos_Call  : Boolean := False;
- 
-   TC_Sine_Call : Boolean := False;
- 
-   -- Type accesses to functions Log, Sine, or Cos
-   type Integrand_Ptr is access function        
-      (Angle : Float) return Float;
- 
-   function Log  (Angle : in Float) return Float;        
- 
-   function Sine (Angle : in Float) return Float;         
- 
-   function Cos  (Angle : in Float) return Float;        
- 
-   function Integrate  (Func : Integrand_Ptr; From, To: Float) 
-     return Float;
- 
- end Integrate_Lookup;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body Integrate_Lookup is
- 
- 
-   function Log (Angle : in Float) return Float is
-   begin
-      TC_Log_Call := True;
-      return 0.1;
-   end Log;
- 
- 
-   function Sine (Angle : in Float) return Float is
-   begin
-      TC_Sine_Call := True;
-      return 0.0;
-   end Sine;
- 
- 
-   function Cos  (Angle : in Float) return Float is
-   begin
-      TC_Cos_Call := True;
-      return 1.0;
-   end Cos;
- 
- 
-   function Integrate (Func : Integrand_Ptr; From, To: Float) 
-     return Float is
-      Theta : Float;
-   begin
-      -- calls the actual subprogram passed as parameter
-      Theta := Func (From) + Func (To);
-      return Theta;
-   end Integrate;
- 
- end Integrate_Lookup;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- with Report;
- 
- with Integrate_Lookup; 
- 
- procedure C3A0008 is
- 
-   Area : Float := 0.0;
- 
- begin
- 
-   Report.Test ("C3A0008", "Check that subprogram references may be passed "
-                         & "as parameters using access-to-subprogram types. " 
-                        & "Check that the passed subprograms may be invoked "
-                         & "from within the called subprogram");
- 
-   Area := Integrate_Lookup.Integrate
-             (Integrate_Lookup.Log'Access, 1.0, 2.0);
- 
-   If not Integrate_Lookup.TC_Log_Call or Area /= 0.2 then
-      Report.Failed ("Incorrect Log result");
-   end if;
- 
-   Area := Integrate_Lookup.Integrate
-             (Integrate_Lookup.Sine'Access, 1.0, 2.0);
- 
-   If not Integrate_Lookup.TC_Sine_Call or Area /= 0.0 then
-      Report.Failed ("Incorrect Sine result");
-   end if;
- 
-   Area := Integrate_Lookup.Integrate
-             (Integrate_Lookup.Cos'Access, 1.0, 2.0);
- 
-   If not Integrate_Lookup.TC_Cos_Call or Area /= 2.0 then
-      Report.Failed ("Incorrect Cos result");
-   end if;
- 
-   Report.Result;
- 
- end C3A0008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,219 ****
- -- C3A0009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that subprogram references may be passed as parameters using 
- --      access-to-subprogram types. Check that the passed subprograms may 
- --      be invoked from within the called subprogram.
- --
- -- TEST DESCRIPTION:
- --      Declare an access to procedure type in a package specification. 
- --      Declare a root tagged type with the access to procedure type as a 
- --      component.  Declare three primitive procedures for the type that 
- --      can be referred to by the access to procedure type.  Use the access 
- --      to procedure type to initialize the component of a record.
- --
- --      Extend the root type with a private extension in the same package
- --      specification. Declare two new primitive subprograms for the extension
- --      (in addition to its three inherited subprograms).
- --
- --      In the main program, declare an operation for the root tagged type 
- --      which can be passed as an access value to change the initial value
- --      of the component.  Call the inherited operations indirectly by 
- --      de-referencing the access value to set value in the extension.
- --      Call the primitive function to modify the extension by passing 
- --      the access value designating the primitive procedure as a parameter.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C3A0009_0 is -- Push_Buttons
- 
-    type Button is tagged private;
- 
-    -- Type accesses to procedures Push and Default_Response
-    type Button_Response_Ptr is access procedure
-       (B : in out Button);
- 
-    procedure Push (B : in out Button);               -- to be inherited
- 
-    procedure Set_Response (B : in out Button;        -- to be inherited
-                            R : in Button_Response_Ptr);
- 
-    procedure Default_Response  (B : in out Button);  -- to be inherited
- 
-    type Alert_Button is new Button with private;  -- private extension of
-                                                   -- root tagged type
-    -- Inherits procedure Push from Button
-    -- Inherits procedure Set_Response from Button
-    -- Inherits procedure Default_Response from Button
- 
-    procedure Replace_Action( B: in out Alert_Button );
- 
-    -- type accesses to procedure Default_Action
-    type Button_Action_Ptr is access procedure;
- 
-    -- The following function is needed to set value in the
-    -- extension's private component.
-    function Alert (B : in Alert_Button) return Button_Action_Ptr;
- 
- private
- 
-    type Button is tagged                             -- root tagged type
-       record
-          Response :  Button_Response_Ptr 
-                   := Default_Response'Access;   
-       end record;
- 
-    procedure Default_Action;
- 
-    type Alert_Button is new Button with record
-         Action :  Button_Action_Ptr 
-                := Default_Action'Access;
-       end record;
- 
- end C3A0009_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- with TCTouch;
- package body C3A0009_0 is
- 
-    procedure Push (B : in out Button) is
-    begin
-       TCTouch.Touch( 'P' ); --------------------------------------------- P
-       -- Invoking subprogram designated by access value
-       B.Response (B);
-    end Push;
- 
- 
-    procedure Set_Response (B : in out Button;
-                            R : in     Button_Response_Ptr) is
-    begin
-       TCTouch.Touch( 'S' ); --------------------------------------------- S
-       -- Set procedure value in record
-       B.Response := R;
-    end Set_Response;
- 
- 
-    procedure Default_Response (B : in out Button) is
-    begin
-       TCTouch.Touch( 'D' ); --------------------------------------------- D
-    end Default_Response;
- 
- 
-    procedure Default_Action is
-    begin
-       TCTouch.Touch( 'd' ); --------------------------------------------- d
-    end Default_Action;
- 
-    procedure Replacement_Action is
-    begin
-       TCTouch.Touch( 'r' ); --------------------------------------------- r
-    end Replacement_Action;
- 
-    procedure Replace_Action( B: in out Alert_Button ) is
-    begin
-       TCTouch.Touch( 'R' ); --------------------------------------------- R
-       B.Action := Replacement_Action'Access;
-    end Replace_Action;
- 
-    function Alert (B : in Alert_Button) return Button_Action_Ptr is
-    begin
-       TCTouch.Touch( 'A' ); --------------------------------------------- A
-       return (B.Action);
-    end Alert;
- 
- end C3A0009_0;
- 
- -----------------------------------------------------------------------------
- 
- with C3A0009_0;
- package C3A0009_1 is -- Emergency_Items
-    package Push_Buttons renames C3A0009_0;
- 
-    procedure Emergency (B : in out Push_Buttons.Button);
- end C3A0009_1;
- 
- with TCTouch;
- package body C3A0009_1 is -- Emergency_Items
-    procedure Emergency (B : in out Push_Buttons.Button) is
-       begin
-         TCTouch.Touch( 'E' ); ------------------------------------------- E
-       end Emergency;
- end C3A0009_1;
- -----------------------------------------------------------------------------
- 
- with Report;
- 
- with C3A0009_0, C3A0009_1; 
- with TCTouch;
- procedure C3A0009 is
- 
-    package Push_Buttons    renames C3A0009_0;
-    package Emergency_Items renames C3A0009_1;
-       
-    Black_Button : Push_Buttons.Alert_Button;
-    Alert_Ptr    : Push_Buttons.Button_Action_Ptr;
- 
- begin
- 
-    Report.Test ("C3A0009", "Check that subprogram references may be passed "
-                          & "as parameters using access-to-subprogram types. "
-                          & "Check that the passed subprograms may be "
-                          & "invoked from within the called subprogram");
- 
- 
-    Push_Buttons.Push( Black_Button );
-    Push_Buttons.Alert( Black_Button ).all;
- 
-    TCTouch.Validate( "PDAd", "Default operation set" );
- 
-    -- Call inherited operations Set_Response and Push to set 
-    -- Emergency value in the extension.
-    Push_Buttons.Set_Response (Black_Button, Emergency_Items.Emergency'Access);
-  
- 
-    Push_Buttons.Push( Black_Button );
-    Push_Buttons.Alert( Black_Button ).all;
- 
-    TCTouch.Validate( "SPEAd", "Altered Response set" );
- 
-    -- Call primitive operation to set action value in the extension.
-    Push_Buttons.Replace_Action( Black_Button );
- 
- 
-    Push_Buttons.Push( Black_Button );
-    Push_Buttons.Alert( Black_Button ).all;
- 
-    TCTouch.Validate( "RPEAr", "Altered Action set" );
- 
-    Report.Result;
- end C3A0009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C3A0010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an access-to-subprogram type in a generic instance may be
- --      used to declare access-to-subprogram objects which invoke subprograms
- --      in the instance.
- --
- -- TEST DESCRIPTION:
- --      Declare a numeric type in the visible part of a generic package.
- --      Declare two different math procedures that can be referred to by 
- --      the access to procedure type.  
- --
- --      In the main program, instantiate the generic.  Declare an access 
- --      to procedure type.  Call each procedure indirectly by dereferencing 
- --      the access value.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      05 APR 96   SAIC    Header correction for 2.1
- --
- --!
- 
- generic
-    type Real_Num is digits <>;
- 
- package C3A0010_0 is
- 
-    -- Type accesses to any math procedure
-    type Math_Procedure_Ptr is access procedure   
-        (First_Num, Second_Num : in  Real_Num;
-         Result_Num            : out Real_Num);
- 
-    procedure Add      (First_Num, Second_Num : in  Real_Num;
-                        Result_Num            : out Real_Num);
- 
-    procedure Subtract (First_Num, Second_Num : in  Real_Num;
-                        Result_Num            : out Real_Num);
- 
- end C3A0010_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body C3A0010_0 is
- 
-    procedure Add (First_Num, Second_Num : in  Real_Num;
-                   Result_Num            : out Real_Num) is
-    begin
-       Result_Num := First_Num + Second_Num;
-    end Add;
- 
- 
-    procedure Subtract (First_Num, Second_Num : in  Real_Num;
-                        Result_Num            : out Real_Num) is
-    begin
-       Result_Num := First_Num - Second_Num;
-    end Subtract;
- 
- end C3A0010_0;
- 
- -----------------------------------------------------------------------------
- 
- with Report;
- with C3A0010_0; 
- 
- procedure C3A0010 is
- 
-    type Real is digits 2;
- 
-    subtype Math_Float is Real range -10.0 .. 10.0;
- 
-    package Math_Pk is new C3A0010_0 (Real_Num => Math_Float);
- 
-    Math_Access : Math_Pk.Math_Procedure_Ptr;
- 
-    Total_Num   : Math_Float := 0.0;
-    First_Num   : Math_Float := 1.0;
-    Second_Num  : Math_Float := 2.0;
- 
-    procedure Max( A_Num, B_Num: in Math_Float; Result : out Math_Float ) is
-    begin
-       if A_Num > B_Num then
-         Result := A_Num;
-       else
-         Result := B_Num;
-       end if;
-    end Max;
- 
-    procedure Due_Process( Process: Math_Pk.Math_Procedure_Ptr ) is
-    begin
-      Process(First_Num, Second_Num, Total_Num);
-    end Due_Process;
- 
- begin
- 
-    Report.Test ("C3A0010", "Check that an access-to-subprogram type in a "
-                          & "generic instance may be used to declare "
-                          & "access-to-subprogram objects which invoke "
-                          & "subprograms in the instance");
- 
- -- Check for correct defaulting
-    if Math_Pk."/="( Math_Access, null) then
-      Report.Failed("subprogram access type object not initialized to null");
-    end if;
- 
-    Math_Access := Math_Pk.Add'Access;
- 
-    -- Invoking Add procedure designated by access value
-    Due_Process( Math_Access );
- 
-    If Total_Num /= 3.0 then
-       Report.Failed ("Incorrect Add result");
-    end if;
- 
-    Math_Access := Math_Pk.Subtract'Access;
- 
-    Due_Process( Math_Access );
- 
-    If Total_Num /= -1.0 then
-       Report.Failed ("Incorrect Subtract result");
-    end if;
- 
-    Math_Access := Max'Access;
- 
-    Due_Process( Math_Access );
- 
-    If Total_Num /= 2.0 then
-       Report.Failed ("Incorrect Max result");
-    end if;
- 
-    Report.Result;
- 
- end C3A0010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- C3A0011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that an access-to-subprogram object whose type is declared in a
- --      parent package, may be used to invoke subprograms in a child package.
- --      Check that such access objects may be stored in a data structure and
- --      that subprograms may be called by walking the data structure.
- -- 
- -- TEST DESCRIPTION:
- --      In the package, declare an access to procedure type.  Declare an 
- --      array of the access type.  Declare three different procedures that 
- --      can be referred to by the access to procedure type.           
- --
- --      In the visible child package, declare two procedures that can be 
- --      referred to by the access to procedure type of the parent.  Build 
- --      the array by calling each procedure indirectly through the access 
- --      value.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Dec 94   SAIC    Improved visibility of "/=" in main body
- --
- --!
- 
- package C3A0011_0 is -- Interpreter
-    
-    type Compass_Point is mod 360;
- 
-    function Heading return Compass_Point;
- 
-    -- Type accesses to any procedure
-    type Action_Ptr is access procedure;
-    
-    -- Array of access to procedure
-    type Action_Array is array (Natural range <>) of Action_Ptr;
- 
-    procedure Rotate_Left;
- 
-    procedure Rotate_Right;
- 
-    procedure Center;
- 
- private
-    The_Heading : Compass_Point := Compass_Point'First;
- 
- end C3A0011_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body C3A0011_0 is
- 
-    function Heading return Compass_Point is
-    begin
-      return The_Heading;
-    end Heading;
- 
-    procedure Rotate_Left is
-    begin
-       The_Heading := The_Heading - 90;
-    end Rotate_Left;
- 
- 
-    procedure Rotate_Right is
-    begin
-       The_Heading := The_Heading + 90;
-    end Rotate_Right;
- 
- 
-    procedure Center is
-    begin
-       The_Heading := 0;
-    end Center;
- 
- end C3A0011_0;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package C3A0011_0.Action is
- 
-    procedure Rotate_Front;
- 
-    procedure Rotate_Back;
- 
- end C3A0011_0.Action;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- package body C3A0011_0.Action is
- 
-    procedure Rotate_Front is
-    begin
-       The_Heading := The_Heading + 5;
-    end Rotate_Front;
- 
- 
-    procedure Rotate_Back is
-    begin
-       The_Heading := The_Heading - 5;
-    end Rotate_Back;
- 
- end C3A0011_0.Action;
- 
- 
- -----------------------------------------------------------------------------
- 
- 
- with C3A0011_0.Action;
- 
- with Report;
- 
- procedure C3A0011 is
- 
-    Total_Actions   : constant := 6;
- 
-    Action_Sequence : C3A0011_0.Action_Array (1 .. Total_Actions);
- 
-    type Result_Array is array (Natural range <>) of C3A0011_0.Compass_Point;
- 
-    Action_Results  : Result_Array(1 .. Total_Actions);
- 
-    package IA renames C3A0011_0.Action;
-    
- begin
- 
-    Report.Test ("C3A0011", "Check that an access-to-subprogram object whose "
-                          & "type is declared in a parent package, may be "
-                          & "used to invoke subprograms in a child package. "
-                          & "Check that such access objects may be stored in "
-                          & "a data structure and that subprograms may be "
-                          & "called by walking the data structure");
- 
-    -- Build the action sequence
-    Action_Sequence := (C3A0011_0.Rotate_Left'Access, 
-                        C3A0011_0.Center'Access,
-                        C3A0011_0.Rotate_Right'Access, 
-                        IA.Rotate_Front'Access,
-                        C3A0011_0.Center'Access,
-                        IA.Rotate_Back'Access);
- 
-    -- Build the expected result
-    Action_Results := ( 270, 0, 90, 95, 0, 355 );
- 
-    -- Assign actions by invoking subprogram designated by access value
-    for I in Action_Sequence'Range loop
-       Action_Sequence(I).all;
-       if C3A0011_0."/="( C3A0011_0.Heading, Action_Results(I) ) then
-         Report.Failed ("Expecting "
-                        & C3A0011_0.Compass_Point'Image(Action_Results(I))
-                        & " Got"
-                        & C3A0011_0.Compass_Point'Image(C3A0011_0.Heading));
-       end if;
-    end loop;
- 
-    Report.Result;
- 
- end C3A0011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a00120.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a00120.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a00120.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a00120.a	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C3A00120.A
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- OBJECTIVE:
-  --      See file C3A00122.AM
-  --
-  -- TEST DESCRIPTION:
-  --      See file C3A00122.AM
-  -- 
-  -- TEST FILES:
-  --      The following files comprise this test:
-  --
-  --      => C3A00120.A
-  --         C3A00121.A
-  --         C3A00122.AM
-  --
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  package C3A0012_0 is
-  
-        type Call_Kind is (No_Call_Made, Fast_Call, Accurate_Call, 
-                           Table_Lookup_Call);
-  
-        Log_Result : Float := 0.0;
-  
-        -- Type accesses to any log procedure
-        type Log_Procedure_Ptr is access procedure   
-           (Angle : in Float; Log_Call : out Call_Kind);
-  
-        procedure Log_Calc_Fast  (Angle      : in  Float; 
-                                  Method     : out Call_Kind);
-  
-        procedure Log_Calc_Acc   (Angle      : in  Float;
-                                  Method     : out Call_Kind);
-  
-        procedure Log_Calc_Table (Angle      : in  Float; 
-                                  Method     : out Call_Kind);
-  
-  end C3A0012_0;
-  
-  
-  --=======================================================================--
-  
-  
-  package body C3A0012_0 is
-  
-     procedure Log_Calc_Fast  (Angle      : in  Float; 
-                               Method     : out Call_Kind) is separate;
-  
-     procedure Log_Calc_Acc   (Angle      : in  Float; 
-                               Method     : out Call_Kind) is separate;
-  
-     procedure Log_Calc_Table (Angle      : in  Float; 
-                               Method     : out Call_Kind) is separate;
-  
-  end C3A0012_0;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a00121.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a00121.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a00121.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a00121.a	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- C3A00121.A
-  --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
-  --
-  -- OBJECTIVE:
-  --      See file C3A00122.AM
-  --
-  -- TEST DESCRIPTION:
-  --      See file C3A00122.AM
-  -- 
-  -- TEST FILES:
-  --      The following files comprise this test:
-  --
-  --         C3A00120.A
-  --      => C3A00121.A
-  --         C3A00122.AM
-  --
-  --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-  --!
-  
-  Separate (C3A0012_0)
-  procedure Log_Calc_Fast (Angle     : in  Float;
-                           Method    : out Call_Kind) is
-  begin
-     C3A0012_0.Log_Result := Angle;
-     Method := Fast_Call;
-  end Log_Calc_Fast;
-  
-  
-  --=======================================================================--
-  
-  
-  Separate (C3A0012_0)
-  procedure Log_Calc_Acc (Angle    : in  Float;
-                          Method   : out Call_Kind) is
-  begin
-     C3A0012_0.Log_Result := Angle;
-     Method := Accurate_Call;
-  end Log_Calc_Acc;
-  
-  
-  --=======================================================================--
-  
-  
-  Separate (C3A0012_0)
-  procedure Log_Calc_Table (Angle      : in  Float;
-                            Method     : out Call_Kind) is
-  begin
-     C3A0012_0.Log_Result := Angle;
-     Method := Table_Lookup_Call;
-  end Log_Calc_Table;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a00122.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a00122.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a00122.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a00122.am	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C3A00122.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an access-to-subprogram object can be used to invoke a
- --      subprogram when the subprogram body had been declared and implemented
- --      as a subunit.
- --
- -- TEST DESCRIPTION:
- --      Declare an access to procedure type in a main program.  Declare 
- --      three different log subprogram body stubs that can be referred to by 
- --      the access to procedure type.
- --
- --      Complete bodies of the log procedures.
- --
- --      In the main program, each procedure will be called indirectly by 
- --      dereferencing the access value.
- -- 
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         C3A00120.A
- --         C3A00121.A
- --      => C3A00122.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-  
-  with Report;
-  
-  with C3A0012_0; 
-  
-  procedure C3A00122 is
-  
-     function "="( A,B: C3A0012_0.Call_Kind ) return Boolean
-              renames C3A0012_0."=";
-  
-     Log_Access  : C3A0012_0.Log_Procedure_Ptr;
-     Theta       : Float := 0.0;
-     Method      : C3A0012_0.Call_Kind := C3A0012_0.No_Call_Made;
-  
-  
-  
-    function Due_Process( LA: C3A0012_0.Log_Procedure_Ptr )
-             return C3A0012_0.Call_Kind is
-      Result : C3A0012_0.Call_Kind := C3A0012_0.No_Call_Made;
-    begin
-      LA( Theta, Result );
-      return Result;
-    end Due_Process;
-  
-  begin
-  
-     Report.Test ("C3A0012", "Check that an access to a subprogram object " &
-                  "can be used to select and invoke an operation with " &
-                  "appropriate arguments");
-  
-     Log_Access := C3A0012_0.Log_Calc_Fast'Access;
-  
-     -- Invoking Log procedure designated by access value
-     Method := Due_Process( Log_Access );
-  
-     If Method /= C3A0012_0.Fast_Call then
-        Report.Failed ("Incorrect Log_Calc_Fast result");
-     end if;
-  
-     Log_Access := C3A0012_0.Log_Calc_Acc'Access;
-  
-     -- Invoking Log procedure designated by access value
-     Method := Due_Process( Log_Access );
-  
-     If Method /= C3A0012_0.Accurate_Call then
-        Report.Failed ("Incorrect Log_Calc_Acc result");
-     end if;
-  
-     Log_Access := C3A0012_0.Log_Calc_Table'Access;
-  
-     -- Invoking Log procedure designated by access value
-     Method := Due_Process( Log_Access );
-  
-     If Method /= C3A0012_0.Table_Lookup_Call then
-        Report.Failed ("Incorrect Log_Calc_Table result");
-     end if;
-  
-     Report.Result;
-  
-  end C3A00122;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,347 ****
- -- C3A0013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a general access type object may reference allocated
- --      pool objects as well as aliased objects. (3,4)
- --      Check that formal parameters of tagged types are implicitly
- --      defined as aliased; check that the 'Access of these formal
- --      parameters designates the correct object with the correct
- --      tag. (5)
- --      Check that the current instance of a limited type is defined as
- --      aliased. (5)
- --
- -- TEST DESCRIPTION:
- --      This test takes from the hierarchy defined in C390003; making
- --      the root type Vehicle limited private.  It also shifts the
- --      abstraction to include the notion of a transmission, an object
- --      which is contained within any vehicle.  Using an access
- --      discriminant, any subprogram which operates on a transmission
- --      may also reference the vehicle in which it is installed.
- --
- --      Class Hierarchy:
- --              Vehicle         Transmission
- --               /   \
- --           Truck    Car
- --
- --      Contains:
- --                Vehicle( Transmission )
- --
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Dec 94   SAIC    Fixed accessibility problems
- --
- --!
- 
- package C3A0013_1 is
-   type Vehicle is tagged limited private;
-   type Vehicle_ID is access all Vehicle'Class;
- 
-   -- Constructors
-   procedure Create     ( It : in out Vehicle; 
-                          Wheels : Natural := 4 );
-   -- Modifiers
-   procedure Accelerate ( It : in out Vehicle );
-   procedure Decelerate ( It : in out Vehicle );
-   procedure Up_Shift   ( It : in out Vehicle );
-   procedure Stop       ( It : in out Vehicle );
- 
-   -- Selectors
-   function  Speed      ( It : Vehicle ) return Natural;
-   function  Wheels     ( It : Vehicle ) return Natural;
-   function  Gear_Factor( It : Vehicle ) return Natural;
- 
-   -- TC_Ops
-   procedure TC_Validate( It : in out Vehicle; Speed_Trap : Natural );
- 
-   -- dispatching procedure used to check tag correctness
-   procedure TC_Validate( It     : Vehicle;
-                          TC_ID  : Character);
- 
- private
- 
-   type Transmission(Within: access Vehicle'Class) is limited record
-     Engaged : Boolean := False;
-     Gear    : Integer range -1..5 := 0;
-   end record;
- 
-   -- Current instance of a limited type is defined as aliased
- 
-   type Vehicle is tagged limited record
-     Wheels: Natural;
-     Speed : Natural;
-     Power_Train: Transmission( Vehicle'Access );
-   end record;
- end C3A0013_1;
- 
- with C3A0013_1;
- package C3A0013_2 is
-   type Car is new C3A0013_1.Vehicle with private;
-   procedure TC_Validate( It     : Car;
-                          TC_ID  : Character);
-   function  Gear_Factor( It : Car ) return Natural;
- private
-   type Car is new C3A0013_1.Vehicle with record
-     Displacement : Natural;
-   end record;
- end C3A0013_2;
- 
- with C3A0013_1;
- package C3A0013_3 is
-   type Truck is new C3A0013_1.Vehicle with private;
-   procedure TC_Validate( It     : Truck;
-                          TC_ID  : Character);
-   function  Gear_Factor( It : Truck ) return Natural;
- private
-   type Truck is new C3A0013_1.Vehicle with record
-     Displacement : Natural;
-   end record;
- end C3A0013_3;
- 
- with Report;
- package body C3A0013_1 is
- 
-   procedure Create    ( It : in out Vehicle; 
-                         Wheels : Natural := 4 ) is
-   begin
-     It.Wheels   := Wheels;
-     It.Speed    := 0;
-   end Create;
- 
-   procedure Accelerate( It : in out Vehicle ) is
-   begin
-     It.Speed := It.Speed + Gear_Factor( It.Power_Train.Within.all );
-   end Accelerate;
- 
-   procedure Decelerate( It : in out Vehicle ) is
-   begin
-     It.Speed := It.Speed - Gear_Factor( It.Power_Train.Within.all );
-   end Decelerate;
- 
-   procedure Stop      ( It : in out Vehicle ) is
-   begin
-     It.Speed := 0;
-     It.Power_Train.Engaged := False;
-   end Stop;
- 
-   function  Gear_Factor( It : Vehicle ) return Natural is
-   begin
-     return It.Power_Train.Gear;
-   end Gear_Factor;
- 
-   function  Speed     ( It : Vehicle ) return Natural is
-   begin
-     return It.Speed;
-   end Speed;
- 
-   function  Wheels     ( It : Vehicle ) return Natural is
-   begin
-     return It.Wheels;
-   end Wheels;
- 
-   -- formal tagged parameters are implicitly aliased
- 
-   procedure TC_Validate( It : in out Vehicle; Speed_Trap : Natural ) is
-     License: Vehicle_ID := It'Unchecked_Access;
-   begin
-     if Speed( License.all ) /= Speed_Trap then
-       Report.Failed("Speed Trap: expected: " & Natural'Image(Speed_Trap));
-     end if;
-   end TC_Validate;
- 
-   procedure TC_Validate( It     : Vehicle;
-                          TC_ID  : Character) is
-   begin
-     if TC_ID /= 'V' then
-       Report.Failed("Dispatched to Vehicle");
-     end if;
-     if Wheels( It ) /= 1 then
-       Report.Failed("Not a Vehicle");
-     end if;
-   end TC_Validate;
- 
-   procedure Up_Shift( It: in out Vehicle ) is
-   begin
-     It.Power_Train.Gear    := It.Power_Train.Gear +1;
-     It.Power_Train.Engaged := True;
-     Accelerate( It );
-   end Up_Shift;
- end C3A0013_1;
- 
- with Report;
- package body C3A0013_2 is
- 
-   procedure TC_Validate( It     : Car;
-                          TC_ID  : Character ) is
-   begin
-     if TC_ID /= 'C' then
-       Report.Failed("Dispatched to Car");
-     end if;
-     if Wheels( It ) /= 4 then
-       Report.Failed("Not a Car");
-     end if;
-   end TC_Validate;
- 
-   function  Gear_Factor( It : Car ) return Natural is
-   begin
-     return C3A0013_1.Gear_Factor( C3A0013_1.Vehicle( It ) )*2;
-   end Gear_Factor;
- 
- end C3A0013_2;
- 
- with Report;
- package body C3A0013_3 is
- 
-   procedure TC_Validate( It     : Truck;
-                          TC_ID  : Character) is
-   begin
-     if TC_ID /= 'T' then
-       Report.Failed("Dispatched to Truck");
-     end if;
-     if Wheels( It ) /= 3 then
-       Report.Failed("Not a Truck");
-     end if;
-   end TC_Validate;
- 
-   function  Gear_Factor( It : Truck ) return Natural is
-   begin
-     return C3A0013_1.Gear_Factor( C3A0013_1.Vehicle( It ) )*3;
-   end Gear_Factor;
- 
- end C3A0013_3;
- 
- package C3A0013_4 is
-   procedure Perform_Tests;
- end C3A0013_4;
- 
- with Report;
- with C3A0013_1;
- with C3A0013_2;
- with C3A0013_3;
- package body C3A0013_4 is
-   package Root   renames C3A0013_1;
-   package Cars   renames C3A0013_2;
-   package Trucks renames C3A0013_3;
- 
-   type Car_Pool is array(1..4) of aliased Cars.Car;
-   Commuters : Car_Pool;
- 
-   My_Car      : aliased Cars.Car;
-   Company_Car : Root.Vehicle_ID;
-   Repair_Shop : Root.Vehicle_ID;
- 
-   The_Vehicle : Root.Vehicle;
-   The_Car     : Cars.Car;
-   The_Truck   : Trucks.Truck;
- 
-   procedure TC_Dispatch( Ptr   : Root.Vehicle_ID;
-                          Char  : Character ) is
-   begin
-     Root.TC_Validate( Ptr.all, Char );
-   end TC_Dispatch;
- 
-   procedure TC_Check_Formal_Access( Item: in out Root.Vehicle'Class;
-                                     Char: Character) is
-   begin
-     TC_Dispatch( Item'Unchecked_Access, Char );
-   end TC_Check_Formal_Access;
- 
-   procedure Perform_Tests is
-   begin  -- Main test procedure.
- 
-   for Lane in Commuters'Range loop
-     Cars.Create( Commuters(Lane) );
-     for Excitement in 1..Lane loop
-       Cars.Up_Shift( Commuters(Lane) );
-     end loop;
-   end loop;
- 
-   Cars.Create( My_Car );
-   Cars.Up_Shift( My_Car );
-   Cars.TC_Validate( My_Car, 2 );
- 
-   Root.Create( The_Vehicle, 1 );
-   Cars.Create( The_Car    , 4 );
-   Trucks.Create( The_Truck, 3 );
- 
-   TC_Check_Formal_Access( The_Vehicle, 'V' );
-   TC_Check_Formal_Access( The_Car,     'C' );
-   TC_Check_Formal_Access( The_Truck,   'T' );
- 
-   Root.Up_Shift( The_Vehicle );
-   Cars.Up_Shift( The_Car );
-   Trucks.Up_Shift( The_Truck );
- 
-   Root.TC_Validate( The_Vehicle, 1 ); 
-   Cars.TC_Validate( The_Car, 2 ); 
-   Trucks.TC_Validate( The_Truck, 3 ); 
- 
-   --  general access type may reference allocated objects
- 
-   Company_Car := new Cars.Car;
-   Root.Create( Company_Car.all );
-   Root.Up_Shift( Company_Car.all );
-   Root.Up_Shift( Company_Car.all );
-   Root.TC_Validate( Company_Car.all, 6 );
- 
-   --  general access type may reference aliased objects
- 
-   Repair_Shop := My_Car'Access;
-   Root.TC_Validate( Repair_Shop.all, 2 );
- 
-   --  general access type may reference aliased objects
- 
-   Construction: declare
-     type Speed_List is array(Commuters'Range) of Natural;
-     Accelerations : constant Speed_List := (2, 6, 12, 20);
-   begin
-     for Rotation in Commuters'Range loop
-       Repair_Shop := Commuters(Rotation)'Access;
-       Root.TC_Validate( Repair_Shop.all, Accelerations(Rotation) );
-     end loop;
-   end Construction;
- 
- end Perform_Tests;
- 
- end C3A0013_4;
- 
- with C3A0013_4;
- with Report;
- procedure C3A0013 is
- begin
- 
-   Report.Test ("C3A0013", "Check general access types.  Check aliased "
-                         & "nature of formal tagged type parameters.  "
-                         & "Check aliased nature of the current "
-                         & "instance of a limited type.  Check the "
-                         & "constraining of actual subtypes for "
-                         & "discriminated objects" );
- 
-   C3A0013_4.Perform_Tests;
- 
-   Report.Result;
- end C3A0013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,453 ****
- -- C3A0014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the view defined by an object declaration is aliased,
- --      and the type of the object has discriminants, then the object is
- --      constrained by its initial value even if its nominal subtype is
- --      unconstrained.
- --
- --      Check that the attribute A'Constrained returns True if A is a formal
- --      out or in out parameter, or dereference thereof, and A denotes an
- --      aliased view of an object.
- --
- -- TEST DESCRIPTION:
- --      These rules apply to objects of a record type with defaulted
- --      discriminants, which may be unconstrained variables. If such a
- --      variable is declared to be aliased, then it is constrained by its
- --      initial value, and the value of the discriminant cannot be changed
- --      for the life of the variable.
- --
- --      The rules do not apply to aliased component types because if such
- --      types are discriminated they must be constrained.
- --
- --      A'Constrained returns True if A denotes a constant, value, or
- --      constrained variable. Since aliased objects are constrained, it must
- --      return True if the actual parameter corresponding to a formal
- --      parameter A is an aliased object. The objective only mentions formal
- --      parameters of mode out and in out, since parameters of mode in are
- --      by definition constant, and would result in True anyway.
- --
- --      This test declares aliased objects of a nominally unconstrained
- --      record subtype, both with and without initialization expressions.
- --      It also declares access values which point to such objects. It then
- --      checks that Constraint_Error is raised if an attempt is made to
- --      change the discriminant value of an aliased object, either directly
- --      or via a dereference of an access value. For aliased objects, this
- --      check is also performed for subprogram parameters of mode out.
- --
- --      The test also passes aliased objects and access values which point
- --      to such objects as actuals to subprograms and verifies, for parameter
- --      modes out and in out, that P'Constrained returns true if P is the
- --      corresponding formal parameter or a dereference thereof.
- --
- --      Additionally, the test declares a generic package which declares a
- --      an aliased object of a formal derived unconstrained type, which is
- --      is initialized with the value of a formal object of that type.
- --      procedure declared within the generic assigns a value to the object
- --      which has the same discriminant value as the formal derived type's
- --      ancestor type. The generic is instantiated with various actuals
- --      for the formal object, and the procedure is called. The test verifies
- --      that Constraint_Error is raised if the discriminant values of the
- --      actual corresponding to the formal object and the value assigned
- --      by the procedure are not equal.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected numerous errors.
- --
- --!
- 
- package C3A0014_0 is
- 
-    subtype Reasonable is Integer range 1..10;
-                                           -- Unconstrained (sub)type.
-    type UC (D: Reasonable := 2) is record -- Discriminant default.
-       S: String (1 .. D) := "Hi";         -- Default value.
-    end record;
- 
-    type AUC is access all UC;
- 
-    -- Nominal subtype is unconstrained for the following:
- 
-    Obj0 :         UC;                  -- An unconstrained object.
- 
-    Obj1 :         UC := (5, "Hello");  -- Non-aliased with initialization,
-                                        -- an unconstrained object.
- 
-    Obj2 : aliased UC := (5, "Hello");  -- Aliased with initialization,
-                                        -- a constrained object.
- 
-    Obj3 :         UC renames Obj2;     -- Aliased (renaming of aliased view),
-                                        -- a constrained object.
-    Obj4 : aliased UC;                  -- Aliased without initialization, Obj4
-                                        -- constrained here to initial value
-                                        -- taken from default for type.
- 
-    Ptr1 : AUC := new UC'(Obj1);
-    Ptr2 : AUC := new UC;
-    Ptr3 : AUC := Obj3'Access;
-    Ptr4 : AUC := Obj4'Access;
- 
- 
-    procedure NP_Proc (A:    out UC);
-    procedure NP_Cons (A: in out UC;  B: out Boolean);
-    procedure P_Cons  (A:    out AUC; B: out Boolean);
- 
- 
-    generic
-       type FT is new UC;
-       FObj : in out FT;
-    package Gen is
-       F  : aliased FT := FObj;     -- Constrained if FT has discriminants.
-       procedure Proc;
-    end Gen;
- 
- 
-    procedure Avoid_Optimization_and_Fail ( P : UC; Msg : String );
- 
- 
- end C3A0014_0;
- 
- 
-   --=======================================================================--
- 
- with Report;
- 
- package body C3A0014_0 is
- 
-    procedure NP_Proc (A: out UC) is
-    begin
-       A := (3, "Bye");
-    end NP_Proc;
- 
-    procedure NP_Cons (A: in out UC; B: out Boolean) is
-    begin
-       B := A'Constrained; 
-    end NP_Cons;
- 
-    procedure P_Cons (A: out AUC; B: out Boolean) is
-    begin
-       B := A.all'Constrained; 
-    end P_Cons;
- 
- 
-    package body Gen is
-      
-       procedure Proc is
-       begin
-          F := (2, "Fi");
-       end Proc;
- 
-    end Gen;
- 
- 
-    procedure Avoid_Optimization_and_Fail ( P : UC; Msg : String ) is
-       Default : UC := (1, "!"); -- Unique value.
-    begin                       
-       if P = Default then       -- Both If branches can't do the same thing.
-          Report.Failed  (Msg & ": Constraint_Error not raised");
-       else                      -- Subtests should always select this path.
-          Report.Failed ("Constraint_Error not raised " & Msg);
-       end if;
-    end Avoid_Optimization_and_Fail;
- 
- 
- end C3A0014_0;
- 
- 
-   --=======================================================================--
- 
- 
- with C3A0014_0;  use C3A0014_0;
- with Report;
- 
- procedure C3A0014 is
- begin
- 
-    Report.Test("C3A0014", "Check that if the view defined by an object "   &
-                           "declaration is aliased, and the type of the "   &
-                           "object has discriminants, then the object is "  &
-                           "constrained by its initial value even if its "  &
-                           "nominal subtype is unconstrained.  Check that " &
-                           "the attribute A'Constrained returns True if A " &
-                           "is a formal out or in out parameter, or "       &
-                           "dereference thereof, and A denotes an aliased " &
-                           "view of an object");
- 
-    Non_Pointer_Block:
-    begin
- 
-       begin
-          Obj0 := (3, "Bye");              -- OK: Obj0 not constrained.
-          if Obj0 /= (3, "Bye") then
-             Report.Failed 
-               ("Wrong value after aggregate assignment - Subtest 1");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 1");
-       end;
- 
- 
-       begin
-          Obj1 := (3, "Bye");              -- OK: Obj1 not constrained.
-          if Obj1 /= (3, "Bye") then
-             Report.Failed
-               ("Wrong value after aggregate assignment - Subtest 2");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 2");
-       end;
- 
- 
-       begin
-          Obj2 := (3, "Bye");              -- C_E: Obj2 is constrained (D=>5).
-          Avoid_Optimization_and_Fail (Obj2, "Subtest 3");
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
- 
-       begin
-          Obj3 := (3, "Bye");              -- C_E: Obj3 is constrained (D=>5).
-          Avoid_Optimization_and_Fail (Obj3, "Subtest 4");
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
- 
-       begin
-          Obj4 := (3, "Bye");              -- C_E: Obj4 is constrained (D=>2).
-          Avoid_Optimization_and_Fail (Obj4, "Subtest 5");
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
-    exception
-       when others => Report.Failed("Unexpected exception: Non_Pointer_Block");
-    end Non_Pointer_Block;
- 
- 
-    Pointer_Block:
-    begin
-    
-       begin
-          Ptr1.all := (3, "Bye");        -- C_E: Ptr1.all is constrained (D=>5).
-          Avoid_Optimization_and_Fail (Ptr1.all, "Subtest 6");
-       exception
-          when Constraint_Error => null; -- Exception is expected.
-       end;
- 
- 
-       begin
-          Ptr2.all := (3, "Bye");        -- C_E: Ptr2.all is constrained (D=>2).
-          Avoid_Optimization_and_Fail (Ptr2.all, "Subtest 7");
-       exception
-          when Constraint_Error => null; -- Exception is expected. 
-       end;
- 
- 
-       begin
-          Ptr3.all := (3, "Bye");        -- C_E: Ptr3.all is constrained (D=>5).
-          Avoid_Optimization_and_Fail (Ptr3.all, "Subtest 8");
-       exception
-          when Constraint_Error => null; -- Exception is expected. 
-       end;
- 
- 
-       begin
-          Ptr4.all := (3, "Bye");        -- C_E: Ptr4.all is constrained (D=>2).
-          Avoid_Optimization_and_Fail (Ptr4.all, "Subtest 9");
-       exception
-          when Constraint_Error => null; -- Exception is expected. 
-       end;
- 
-    exception
-       when others => Report.Failed("Unexpected exception: Pointer_Block");
-    end Pointer_Block;
- 
- 
-    Subprogram_Block:
-    declare
-       Is_Constrained : Boolean;
-    begin
- 
-       begin
-          NP_Proc (Obj0);                 -- OK: Obj0 not constrained, can
-          if Obj0 /= (3, "Bye") then      -- change discriminant value.
-             Report.Failed 
-               ("Wrong value after aggregate assignment - Subtest 10");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 10");
-       end;
- 
- 
-       begin
-          NP_Proc (Obj2);                 -- C_E: Obj2 is constrained (D=>5).
-          Avoid_Optimization_and_Fail (Obj2, "Subtest 11");      
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
- 
-       begin
-          NP_Proc (Obj3);                 -- C_E: Obj3 is constrained (D=>5).
-          Avoid_Optimization_and_Fail (Obj3, "Subtest 12");
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
- 
-       begin
-          NP_Proc (Obj4);                 -- C_E: Obj4 is constrained (D=>2).
-          Avoid_Optimization_and_Fail (Obj4, "Subtest 13");
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
- 
- 
-       begin
-          Is_Constrained := True;
-          NP_Cons (Obj1, Is_Constrained);  -- Should return False, since Obj1
-          if Is_Constrained then           -- is not constrained.
-             Report.Failed ("Wrong result from 'Constrained - Subtest 14");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 14");
-       end;
- 
- 
-       begin
-          Is_Constrained := False;
-          NP_Cons (Obj2, Is_Constrained);  -- Should return True, Obj2 is
-          if not Is_Constrained then       -- constrained.
-             Report.Failed ("Wrong result from 'Constrained - Subtest 15");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 15");
-       end;
- 
- 
- 
- 
-       begin
-          Is_Constrained := False;
-          P_Cons (Ptr2, Is_Constrained);   -- Should return True, Ptr2.all
-          if not Is_Constrained then       -- is constrained.
-             Report.Failed ("Wrong result from 'Constrained - Subtest 16");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 16");
-       end;
- 
- 
-       begin
-          Is_Constrained := False;
-          P_Cons (Ptr3, Is_Constrained);   -- Should return True, Ptr3.all
-          if not Is_Constrained then       -- is constrained.
-             Report.Failed ("Wrong result from 'Constrained - Subtest 17");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 17");
-       end;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in Subprogram_Block");
-    end Subprogram_Block;
- 
- 
-    Generic_Block:
-    declare
- 
-       type NUC is new UC;
- 
-       Obj : NUC;
- 
- 
-       package Instance_A is new Gen (NUC, Obj);
-       package Instance_B is new Gen (UC, Obj2);
-       package Instance_C is new Gen (UC, Obj3);
-       package Instance_D is new Gen (UC, Obj4);
- 
-    begin
- 
-       begin
-          Instance_A.Proc;                -- OK: Obj.D = 2.
-          if Instance_A.F /= (2, "Fi") then
-             Report.Failed 
-               ("Wrong value after aggregate assignment - Subtest 18");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 18");
-       end;
- 
- 
-       begin
-          Instance_B.Proc;                -- C_E: Obj2.D = 5.
-          Avoid_Optimization_and_Fail (Obj2, "Subtest 19");
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
- 
-       begin
-          Instance_C.Proc;                -- C_E: Obj3.D = 5.
-          Avoid_Optimization_and_Fail (Obj3, "Subtest 20");
-       exception
-          when Constraint_Error => null;  -- Exception is expected.
-       end;
- 
- 
-       begin
-          Instance_D.Proc;                -- OK: Obj4.D = 2.
-          if Instance_D.F /= (2, "Fi") then
-             Report.Failed 
-               ("Wrong value after aggregate assignment - Subtest 21");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised - Subtest 21");
-       end;
- 
-    exception
-       when others => Report.Failed("Exception raised in Generic_Block");
-    end Generic_Block;
- 
- 
-    Report.Result;
- 
- end C3A0014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a0015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a0015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- C3A0015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that a derived access type has the same storage pool as its
- --    parent.  (Defect Report 8652/0012, Technical Corrigendum 3.10(7/1)).
- --
- -- CHANGE HISTORY:
- --    24 JAN 2001   PHL   Initial version.
- --    29 JUN 2001   RLB   Reformatted for ACATS.
- --
- --!
- with System.Storage_Elements;
- use System.Storage_Elements;
- with System.Storage_Pools;
- use System.Storage_Pools;
- package C3A0015_0 is
- 
-     type Pool (Storage_Size : Storage_Count) is new Root_Storage_Pool with
- 	record
- 	    First_Free : Storage_Count := 1;
- 	    Contents : Storage_Array (1 .. Storage_Size);
- 	end record;
- 
-     procedure Allocate (Pool : in out C3A0015_0.Pool;
- 			Storage_Address : out System.Address;
- 			Size_In_Storage_Elements : in Storage_Count;
- 			Alignment : in Storage_Count);
- 
-     procedure Deallocate (Pool : in out C3A0015_0.Pool;
- 			  Storage_Address : in System.Address;
- 			  Size_In_Storage_Elements : in Storage_Count;
- 			  Alignment : in Storage_Count);
- 
-     function Storage_Size (Pool : in C3A0015_0.Pool) return Storage_Count;
- 
- end C3A0015_0;
- 
- package body C3A0015_0 is
- 
-     use System;
- 
-     procedure Allocate (Pool : in out C3A0015_0.Pool;
- 			Storage_Address : out System.Address;
- 			Size_In_Storage_Elements : in Storage_Count;
- 			Alignment : in Storage_Count) is
- 	Unaligned_Address : constant System.Address :=
- 	   Pool.Contents (Pool.First_Free)'Address;
- 	Unalignment : Storage_Count;
-     begin
- 	Unalignment := Unaligned_Address mod Alignment;
- 	if Unalignment = 0 then
- 	    Storage_Address := Unaligned_Address;
- 	    Pool.First_Free := Pool.First_Free + Size_In_Storage_Elements;
- 	else
- 	    Storage_Address :=
- 	       Pool.Contents (Pool.First_Free + Alignment - Unalignment)'
- 		  Address;
- 	    Pool.First_Free := Pool.First_Free + Size_In_Storage_Elements +
- 				  Alignment - Unalignment;
- 	end if;
-     end Allocate;
- 
-     procedure Deallocate (Pool : in out C3A0015_0.Pool;
- 			  Storage_Address : in System.Address;
- 			  Size_In_Storage_Elements : in Storage_Count;
- 			  Alignment : in Storage_Count) is
-     begin
- 	if Storage_Address + Size_In_Storage_Elements =
- 	   Pool.Contents (Pool.First_Free)'Address then
- 	    -- Only deallocate if the block is at the end.
- 	    Pool.First_Free := Pool.First_Free - Size_In_Storage_Elements;
- 	end if;
-     end Deallocate;
- 
-     function Storage_Size (Pool : in C3A0015_0.Pool) return Storage_Count is
-     begin
- 	return Pool.Storage_Size;
-     end Storage_Size;
- 
- end C3A0015_0;
- 
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Ada.Unchecked_Deallocation;
- with Report;
- use Report;
- with System.Storage_Elements;
- use System.Storage_Elements;
- with C3A0015_0;
- procedure C3A0015 is
- 
-     type Standard_Pool is access Float;
-     type Derived_Standard_Pool is new Standard_Pool;
-     type Derived_Derived_Standard_Pool is new Derived_Standard_Pool;
- 
-     type User_Defined_Pool is access Integer;
-     type Derived_User_Defined_Pool is new User_Defined_Pool;
-     type Derived_Derived_User_Defined_Pool is new Derived_User_Defined_Pool;
- 
-     My_Pool : C3A0015_0.Pool (1024);
-     for User_Defined_Pool'Storage_Pool use My_Pool;
- 
-     generic
- 	type Designated is private;
- 	Value : Designated;
- 	type Acc is access Designated;
- 	type Derived_Acc is new Acc;
-     procedure Check (Subtest : String; User_Defined_Pool : Boolean);
- 
-     procedure Check (Subtest : String; User_Defined_Pool : Boolean) is
- 
- 	procedure Deallocate is
- 	   new Ada.Unchecked_Deallocation (Object => Designated,
- 					   Name => Acc);
- 	procedure Deallocate is
- 	   new Ada.Unchecked_Deallocation (Object => Designated,
- 					   Name => Derived_Acc);
- 
- 	First_Free : Storage_Count;
- 	X : Acc;
- 	Y : Derived_Acc;
-     begin
- 	if User_Defined_Pool then
- 	    First_Free := My_Pool.First_Free;
- 	end if;
- 	X := new Designated'(Value);
- 	if User_Defined_Pool and then First_Free >= My_Pool.First_Free then
- 	    Failed (Subtest &
- 		    " - Allocation didn't consume storage in the pool - 1");
- 	else
- 	    First_Free := My_Pool.First_Free;
- 	end if;
- 
- 	Y := Derived_Acc (X);
- 	if User_Defined_Pool and then First_Free /= My_Pool.First_Free then
- 	    Failed (Subtest &
- 		    " - Conversion did consume storage in the pool - 1");
- 	end if;
- 	if Y.all /= Value then
- 	    Failed (Subtest &
- 		    " - Incorrect allocation/conversion of access values - 1");
- 	end if;
- 
- 	Deallocate (Y);
- 	if User_Defined_Pool and then First_Free <= My_Pool.First_Free then
- 	    Failed (Subtest &
- 		    " - Deallocation didn't release storage from the pool - 1");
- 	else
- 	    First_Free := My_Pool.First_Free;
- 	end if;
- 
- 	Y := new Designated'(Value);
- 	if User_Defined_Pool and then First_Free >= My_Pool.First_Free then
- 	    Failed (Subtest &
- 		    " - Allocation didn't consume storage in the pool - 2");
- 	else
- 	    First_Free := My_Pool.First_Free;
- 	end if;
- 
- 	X := Acc (Y);
- 	if User_Defined_Pool and then First_Free /= My_Pool.First_Free then
- 	    Failed (Subtest &
- 		    " - Conversion did consume storage in the pool - 2");
- 	end if;
- 	if X.all /= Value then
- 	    Failed (Subtest &
- 		    " - Incorrect allocation/conversion of access values - 2");
- 	end if;
- 
- 	Deallocate (X);
- 	if User_Defined_Pool and then First_Free <= My_Pool.First_Free then
- 	    Failed (Subtest &
- 		    " - Deallocation didn't release storage from the pool - 2");
- 	end if;
-     exception
- 	when E: others =>
- 	    Failed (Subtest & " - Exception " & Exception_Name (E) &
- 		    " raised - " & Exception_Message (E));
-     end Check;
- 
- 
- begin
-     Test ("C3A0015", "Check that a dervied access type has the same " &
- 			"storage pool as its parent");
- 
-     Comment ("Access types using the standard storage pool");
- 
-     Std:
- 	declare
- 	    procedure Check1 is
- 	       new Check (Designated => Float,
- 			  Value => 3.0,
- 			  Acc => Standard_Pool,
- 			  Derived_Acc => Derived_Standard_Pool);
- 	    procedure Check2 is
- 	       new Check (Designated => Float,
- 			  Value => 4.0,
- 			  Acc => Standard_Pool,
- 			  Derived_Acc => Derived_Derived_Standard_Pool);
- 	    procedure Check3 is
- 	       new Check (Designated => Float,
- 			  Value => 5.0,
- 			  Acc => Derived_Standard_Pool,
- 			  Derived_Acc => Derived_Derived_Standard_Pool);
- 	begin
- 	    Check1 ("Standard_Pool/Derived_Standard_Pool",
- 		    User_Defined_Pool => False);
- 	    Check2 ("Standard_Pool/Derived_Derived_Standard_Pool",
- 		    User_Defined_Pool => False);
- 	    Check3 ("Derived_Standard_Pool/Derived_Derived_Standard_Pool",
- 		    User_Defined_Pool => False);
- 	end Std;
- 
-     Comment ("Access types using a user-defined storage pool");
- 
-     User:
- 	declare
- 	    procedure Check1 is
- 	       new Check (Designated => Integer,
- 			  Value => 17,
- 			  Acc => User_Defined_Pool,
- 			  Derived_Acc => Derived_User_Defined_Pool);
- 	    procedure Check2 is
- 	       new Check (Designated => Integer,
- 			  Value => 18,
- 			  Acc => User_Defined_Pool,
- 			  Derived_Acc => Derived_Derived_User_Defined_Pool);
- 	    procedure Check3 is
- 	       new Check (Designated => Integer,
- 			  Value => 19,
- 			  Acc => Derived_User_Defined_Pool,
- 			  Derived_Acc => Derived_Derived_User_Defined_Pool);
- 	begin
- 	    Check1 ("User_Defined_Pool/Derived_User_Defined_Pool",
- 		    User_Defined_Pool => True);
- 	    Check2 ("User_Defined_Pool/Derived_Derived_User_Defined_Pool",
- 		    User_Defined_Pool => True);
- 	    Check3
- 	       ("Derived_User_Defined_Pool/Derived_Derived_User_Defined_Pool",
- 		User_Defined_Pool => True);
- 	end User;
- 
-     Result;
- end C3A0015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a1001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a1001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a1001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a1001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,315 ****
- -- C3A1001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the full type completing a type with no discriminant part
- --      or an unknown discriminant part may have explicitly declared or
- --      inherited discriminants.
- --      Check for cases where the types are records and protected types.
- --
- -- TEST DESCRIPTION:
- --      Declare two groups of incomplete types: one group with no discriminant 
- --      part and one group with unknown discriminant part.  Both groups of 
- --      incomplete types are completed with both explicit and inherited 
- --      discriminants.  Discriminants for record and protected types are 
- --      declared with default and non default values.
- --      In the main program, verify that objects of both groups of incomplete 
- --      types can be created by default values or by assignments.
- --
- --
- -- CHANGE HISTORY:
- --      11 Oct 95   SAIC    Initial prerelease version.
- --      11 Nov 96   SAIC    Revised for version 2.1.
- --
- --!
- 
- package C3A1001_0 is
- 
-    type Incomplete1 (<>);                          -- unknown discriminant
- 
-    type Incomplete2;                               -- no discriminant
- 
-    type Incomplete3 (<>);                          -- unknown discriminant
- 
-    type Incomplete4;                               -- no discriminant
- 
-    type Incomplete5 (<>);                          -- unknown discriminant
- 
-    type Incomplete6;                               -- no discriminant
- 
-    type Incomplete8;                               -- no discriminant
- 
-    subtype Small_Int is Integer range 1 .. 10;
- 
-    type Enu_Type is (M, F);
- 
-    type Incomplete1 (Disc : Enu_Type) is           -- unknown discriminant/
-      record                                        -- explicit discriminant 
-         case Disc is
-            when M => MInteger : Small_Int := 3;
-            when F => FInteger : Small_Int := 8;
-         end case;
-      end record;
- 
-    type Incomplete2 (Disc : Small_Int := 8) is     -- no discriminant/  
-      record                                        -- explicit discriminant 
-         ID : String (1 .. Disc) := "Plymouth";
-      end record;
- 
-    type Incomplete3 is new Incomplete2;            -- unknown discriminant/
-                                                    -- inherited discriminant
- 
-    type Incomplete4 is new Incomplete2;            -- no discriminant/  
-                                                    -- inherited discriminant   
-                                                    
-    protected type Incomplete5                      -- unknown discriminant/
-      (Disc : Enu_Type) is                          -- explicit discriminant
-         function Get_Priv_Val return Enu_Type;     
-    private
-       Enu_Obj : Enu_Type := Disc;
-    end Incomplete5;    
- 
-    protected type Incomplete6                      -- no discriminant/  
-      (Disc : Small_Int := 1) is                    -- explicit discriminant
-         function Get_Priv_Val return Small_Int;    -- with default
-    private
-       Num : Small_Int := Disc;
-    end Incomplete6;
- 
-    type Incomplete8 (Disc : Small_Int) is          -- no discriminant/  
-      record                                        -- explicit discriminant
-        Str : String (1 .. Disc);                   -- no default
-      end record;
- 
-    type Incomplete9 is new Incomplete8;
- 
-    function Return_String (S : String) return String;
- 
- end C3A1001_0;
- 
-      --==================================================================--
- 
- with Report;
- 
- package body C3A1001_0 is
- 
-    protected body Incomplete5 is    
- 
-       function Get_Priv_Val return Enu_Type is
-       begin
-          return Enu_Obj;
-       end Get_Priv_Val; 
- 
-     end Incomplete5; 
- 
-    ----------------------------------------------------------------------
-    protected body Incomplete6 is                                             
-             
-       function Get_Priv_Val return Small_Int is
-       begin
-          return Num;
-       end Get_Priv_Val; 
- 
-     end Incomplete6; 
- 
-    ----------------------------------------------------------------------
-    function Return_String (S : String) return String is
-    begin
-       if Report.Ident_Bool(True) = True then
-          return S;
-       end if;
- 
-       return S;
-    end Return_String;
-    
- end C3A1001_0;
- 
-      --==================================================================--
- 
- with Report;
- 
- with C3A1001_0;
- use  C3A1001_0;
- 
- procedure C3A1001 is
- 
-    -- Discriminant value comes from default.
- 
-    Incomplete2_Obj_1 :  Incomplete2;                
- 
-    Incomplete4_Obj_1 :  Incomplete4;
- 
-    Incomplete6_Obj_1 :  Incomplete6;                
- 
-    -- Discriminant value comes from explicit constraint.
- 
-    Incomplete1_Obj_1 :  Incomplete1 (F);              
- 
-    Incomplete5_Obj_1 :  Incomplete5 (M);               
- 
-    Incomplete6_Obj_2 :  Incomplete6 (2);           
- 
-    -- Discriminant value comes from assignment.        
- 
-    Incomplete3_Obj_1 :  Incomplete3 := (Disc => 6, ID => "Sentra");       
- 
-    Incomplete1_Obj_2 :  Incomplete1 := (Disc => M, MInteger => 9);    
-                                   
-    Incomplete2_Obj_2 :  Incomplete2 := (Disc => 5, ID => "Buick");    
-                                   
- begin
- 
-    Report.Test ("C3A1001", "Check that the full type completing a type " &
-                 "with no discriminant part or an unknown discriminant "  &
-                 "part may have explicitly declared or inherited "        &
-                 "discriminants.  Check for cases where the types are "   &
-                 "records and protected types");
- 
-    -- Check the initial values.
- 
-    if (Incomplete2_Obj_1.Disc /= 8) or
-       (Incomplete2_Obj_1.ID   /= "Plymouth") then
-          Report.Failed ("Wrong initial values for Incomplete2_Obj_1");
-    end if;
- 
-    if (Incomplete4_Obj_1.Disc /= 8) or
-       (Incomplete4_Obj_1.ID   /= "Plymouth") then
-          Report.Failed ("Wrong initial values for Incomplete4_Obj_1");
-    end if;
- 
-    if (Incomplete6_Obj_1.Disc         /= 1) or
-       (Incomplete6_Obj_1.Get_Priv_Val /= 1) then
-          Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
-    end if;
- 
-    -- Check the explicit values.
- 
-    if (Incomplete1_Obj_1.Disc     /= F) or 
-       (Incomplete1_Obj_1.FInteger /= 8) then
-          Report.Failed ("Wrong values for Incomplete1_Obj_1");
-    end if;
- 
-    if (Incomplete5_Obj_1.Disc         /= M) or  
-       (Incomplete5_Obj_1.Get_Priv_Val /= M) then
-          Report.Failed ("Wrong value for Incomplete5_Obj_1");
-    end if;
- 
-    if (Incomplete6_Obj_2.Disc         /= 2) or
-       (Incomplete6_Obj_2.Get_Priv_Val /= 2) then
-          Report.Failed ("Wrong value for Incomplete6_Obj_2");
-    end if;
- 
-    -- Check the assigned values.
- 
-    if (Incomplete3_Obj_1.Disc /= 6) or 
-       (Incomplete3_Obj_1.ID   /= "Sentra") then
-          Report.Failed ("Wrong values for Incomplete3_Obj_1");
-    end if;
- 
-    if (Incomplete1_Obj_2.Disc     /= M) or
-       (Incomplete1_Obj_2.MInteger /= 9) then
-          Report.Failed ("Wrong values for Incomplete1_Obj_2");
-    end if;
- 
-    if (Incomplete2_Obj_2.Disc /= 5) or 
-       (Incomplete2_Obj_2.ID   /= "Buick") then
-          Report.Failed ("Wrong values for Incomplete2_Obj_2");
-    end if;
- 
-    -- Make sure that assignments work without problems.
- 
-    Incomplete1_Obj_1.FInteger := 1;
- 
-    -- Avoid optimization (dead variable removal of FInteger):
- 
-    if Incomplete1_Obj_1.FInteger /= Report.Ident_Int(1) 
-       then  
-          Report.Failed ("Wrong value stored in Incomplete1_Obj_1.FInteger");
-    end if;
- 
-    Incomplete2_Obj_1.ID       := Return_String ("12345678");
- 
-    -- Avoid optimization (dead variable removal of ID)
- 
-    if Incomplete2_Obj_1.ID /= Return_String ("12345678")
-      then   
-         Report.Failed ("Wrong values for Incomplete8_Obj_1.ID");
-    end if;
- 
-    Incomplete4_Obj_1.ID       := Return_String ("87654321");
- 
-    -- Avoid optimization (dead variable removal of ID)
- 
-    if Incomplete4_Obj_1.ID /= Return_String ("87654321")
-      then   
-         Report.Failed ("Wrong values for Incomplete4_Obj_1.ID");
-    end if;
- 
- 
-    Test1:
-    declare
-    
-       Incomplete8_Obj_1 :  Incomplete8 (10);
- 
-    begin
-       Incomplete8_Obj_1.Str := "Merry Xmas";
- 
-       -- Avoid optimization (dead variable removal of Str):
- 
-       if Return_String (Incomplete8_Obj_1.Str) /= "Merry Xmas"
-         then   
-            Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
-       end if;
- 
-    exception
-       when Constraint_Error =>
-           Report.Failed ("Constraint_Error raised in Incomplete8_Obj_1");
- 
-    end Test1;
- 
-    Test2:
-    declare
- 
-       Incomplete8_Obj_2 :  Incomplete8 (5);
- 
-    begin
-       Incomplete8_Obj_2.Str := "Happy";       
- 
-       -- Avoid optimization (dead variable removal of Str):
- 
-       if Return_String (Incomplete8_Obj_2.Str) /= "Happy"               
-         then   
-            Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
-       end if;
- 
-    exception
-       when Constraint_Error =>
-           Report.Failed ("Constraint_Error raised in Incomplete8_Obj_2");
- 
-    end Test2;
- 
-    Report.Result;
- 
- end C3A1001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a1002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a1002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a1002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a1002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,251 ****
- -- C3A1002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the full type completing a type with no discriminant part
- --      or an unknown discriminant part may have explicitly declared or
- --      inherited discriminants.
- --      Check for cases where the types are tagged records and task types.
- --
- -- TEST DESCRIPTION:
- --      Declare two groups of incomplete types: one group with no discriminant 
- --      part and one group with unknown discriminant part.  Both groups of 
- --      incomplete types are completed with both explicit and inherited 
- --      discriminants.  Discriminants for task types are declared with both 
- --      default and non default values.  Discriminants for tagged types are 
- --      only declared without default values.  
- --      In the main program, verify that objects of both groups of incomplete 
- --      types can be created by default values or by assignments.
- --
- --
- -- CHANGE HISTORY:
- --      23 Oct 95   SAIC    Initial prerelease version.
- --      19 Oct 96   SAIC    ACVC 2.1: modified test description.  Initialized
- --                          Int_Val.
- --
- --!
- 
- package C3A1002_0 is
- 
-    subtype Small_Int is Integer range 1 .. 15;
- 
-    type Enu_Type is (M, F);
- 
-    type Tag_Type is tagged         
-      record                                          
-         I : Small_Int := 1;
-      end record;
- 
-    type NTag_Type (D : Small_Int) is new Tag_Type with
-      record                                          
-         S : String (1 .. D) := "Aloha";  
-      end record;
- 
-    type Incomplete1;                               -- no discriminant
- 
-    type Incomplete2 (<>);                          -- unknown discriminant
- 
-    type Incomplete3;                               -- no discriminant
- 
-    type Incomplete4 (<>);                          -- unknown discriminant
- 
-    type Incomplete5;                               -- no discriminant
- 
-    type Incomplete6 (<>);                          -- unknown discriminant
- 
-    type Incomplete1 (D1 : Enu_Type) is tagged      -- no discriminant/  
-      record                                        -- explicit discriminant
-         case D1 is
-            when M => MInteger : Small_Int := 9;
-            when F => FInteger : Small_Int := 8;
-         end case;
-      end record;
- 
-    type Incomplete2 (D2 : Small_Int) is new       -- unknown discriminant/
-      Incomplete1 (D1 => F) with record            -- explicit discriminant
-         ID : String (1 .. D2) := "ACVC95";
-      end record;
- 
-    type Incomplete3 is new                         -- no discriminant/
-      NTag_Type with record                         -- inherited discriminant
-         E : Enu_Type := M;
-      end record;
- 
-    type Incomplete4 is new                         -- unknown discriminant/
-      NTag_Type (D => 3) with record                -- inherited discriminant
-         E : Enu_Type := F;
-      end record;
- 
-    task type Incomplete5 (D5 : Enu_Type) is      -- no discriminant/
-       entry Read_Disc (P : out Enu_Type);        -- explicit discriminant
-    end Incomplete5;
- 
-    task type Incomplete6 
-      (D6 : Small_Int := 4) is                    -- unknown discriminant/
-       entry Read_Int (P : out Small_Int);        -- explicit discriminant
-    end Incomplete6;
- 
- end C3A1002_0;
- 
-      --==================================================================--
- 
- package body C3A1002_0 is
- 
-    task body Incomplete5 is  
-    begin
-       select 
-          accept Read_Disc (P : out Enu_Type) do  
-             P := D5;
-          end Read_Disc;
-       or
-          terminate;
-       end select;
- 
-    end Incomplete5;
- 
-    ----------------------------------------------------------------------
-    task body Incomplete6 is 
-    begin
-       select 
-          accept Read_Int (P : out Small_Int) do  
-             P := D6;
-          end Read_Int;
-       or
-          terminate;
-       end select;
- 
-    end Incomplete6;
- 
- end C3A1002_0;
- 
-      --==================================================================--
- 
- with Report;
- 
- with C3A1002_0;
- use  C3A1002_0;
- 
- procedure C3A1002 is
- 
-    Enum_Val : Enu_Type := M;
- 
-    Int_Val  : Small_Int := 15;
- 
-    -- Discriminant value comes from default.
- 
-    Incomplete6_Obj_1  :  Incomplete6;
- 
-    -- Discriminant value comes from explicit constraint.
- 
-    Incomplete1_Obj_1  :  Incomplete1 (M);
- 
-    Incomplete2_Obj_1  :  Incomplete2 (6);
- 
-    Incomplete5_Obj_1  :  Incomplete5 (F);
- 
-    Incomplete6_Obj_2  :  Incomplete6 (7);
- 
-    -- Discriminant value comes from assignment.        
- 
-    Incomplete1_Obj_2  :  Incomplete1
-                       := (F, 12);
- 
-    Incomplete3_Obj_1  :  Incomplete3
-                       := (D => 2, S => "Hi", I => 10, E => F);
- 
-    Incomplete4_Obj_1  :  Incomplete4
-                       := (E => M, D => 3, S => "Bye", I => 14);
- 
- begin
- 
-    Report.Test ("C3A1002", "Check that the full type completing a type " &
-                 "with no discriminant part or an unknown discriminant "  &
-                 "part may have explicitly declared or inherited "        &
-                 "discriminants.  Check for cases where the types are "   &
-                 "tagged records and task types");
- 
-    -- Check the initial values.
- 
-    if (Incomplete6_Obj_1.D6 /= 4) then 
-       Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
-    end if;
- 
-    -- Check the explicit values.
- 
-    if (Incomplete1_Obj_1.D1       /= M) or 
-       (Incomplete1_Obj_1.MInteger /= 9) then
-         Report.Failed ("Wrong values for Incomplete1_Obj_1");
-    end if;
- 
-    if (Incomplete2_Obj_1.D2       /= 6) or 
-       (Incomplete2_Obj_1.FInteger /= 8) or
-       (Incomplete2_Obj_1.ID       /= "ACVC95") then
-          Report.Failed ("Wrong values for Incomplete2_Obj_1");
-    end if;
- 
-    if (Incomplete5_Obj_1.D5 /= F) then 
-       Report.Failed ("Wrong value for Incomplete5_Obj_1");
-    end if;
- 
-    Incomplete5_Obj_1.Read_Disc (Enum_Val);
- 
-    if (Enum_Val /= F) then 
-       Report.Failed ("Wrong value for Enum_Val");
-    end if;
- 
-    if (Incomplete6_Obj_2.D6 /= 7) then 
-       Report.Failed ("Wrong value for Incomplete6_Obj_2");
-    end if;
- 
-    Incomplete6_Obj_1.Read_Int (Int_Val);
- 
-    if (Int_Val /= 4) then 
-       Report.Failed ("Wrong value for Int_Val");
-    end if;
- 
-    -- Check the assigned values.
- 
-    if (Incomplete1_Obj_2.D1       /= F)  or 
-       (Incomplete1_Obj_2.FInteger /= 12) then
-          Report.Failed ("Wrong values for Incomplete1_Obj_2");
-    end if;
- 
-    if (Incomplete3_Obj_1.D /= 2 ) or 
-       (Incomplete3_Obj_1.I /= 10) or
-       (Incomplete3_Obj_1.E /= F ) or
-       (Incomplete3_Obj_1.S /= "Hi") then
-          Report.Failed ("Wrong values for Incomplete3_Obj_1");
-    end if;
- 
-    if (Incomplete4_Obj_1.E /= M )      or 
-       (Incomplete4_Obj_1.D /= 3)       or
-       (Incomplete4_Obj_1.S /= "Bye")   or
-       (Incomplete4_Obj_1.I /= 14)      then
-          Report.Failed ("Wrong values for Incomplete4_Obj_1");
-    end if;
- 
-    Report.Result;
- 
- end C3A1002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,460 ****
- -- C3A2001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an access type may be defined to designate the
- --      class-wide type of an abstract type.  Check that the access type
- --      may then be used subsequently with types derived from the abstract
- --      type.  Check that dispatching operations dispatch correctly, when
- --      called using values designated by objects of the access type.
- --
- -- TEST DESCRIPTION:
- --      This test declares an abstract type Breaker in a package, and
- --      then derives from it.  The type Basic_Breaker defines the least
- --      possible in order to not be abstract.  The type Ground_Fault is
- --      defined to inherit as much as possible, whereas type Special_Breaker
- --      overrides everything it can.  The type Special_Breaker also includes
- --      an embedded Basic_Breaker object.  The main program then utilizes
- --      each of the three types of breaker, and to ascertain that the
- --      overloading and tagging resolution are correct, each "Create"
- --      procedure is called with a unique value.  The diagram below
- --      illustrates the relationships.
- --
- --              Abstract type:           Breaker(1)
- --                                           |
- --                                    Basic_Breaker(2)
- --                                    /           \
- --                           Ground_Fault(3)    Special_Breaker(4)
- --
- --      Test structure is a polymorphic linked list, modeling a circuit
- --      as a list of components.  The type component is the access type
- --      defined to designate Breaker'Class values.  The test then creates
- --      some values, and traverses the list to determine correct operation.
- --      This test is instrumented with a the trace facility found in
- --      foundation F392C00 to simplify the verification process.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Nov 95   SAIC    Checked compilation for ACVC 2.0.1
- --      23 APR 96   SAIC    Added pragma Elaborate_All
- --      26 NOV 96   SAIC    Elaborate_Body changed to Elaborate_All
- --
- --!
- 
- with Report;
- with TCTouch;
- package C3A2001_1 is
- 
-   type Breaker is abstract tagged private;
-   type Status  is ( Power_Off, Power_On, Tripped, Failed );
- 
-   procedure Flip ( The_Breaker : in out Breaker ) is abstract;
-   procedure Trip ( The_Breaker : in out Breaker ) is abstract;
-   procedure Reset( The_Breaker : in out Breaker ) is abstract;
-   procedure Fail ( The_Breaker : in out Breaker );
- 
-   procedure Set ( The_Breaker : in out Breaker'Class; To_State : Status );
- 
-   function  Status_Of( The_Breaker : Breaker ) return Status;
- 
- private
-   type Breaker is abstract tagged record
-     State : Status := Power_Off;
-   end record;
- end C3A2001_1;
- 
- ----------------------------------------------------------------------------
- 
- with TCTouch;
- package body C3A2001_1 is
-   procedure Fail( The_Breaker : in out Breaker ) is
-   begin
-     TCTouch.Touch( 'a' ); --------------------------------------------- a
-     The_Breaker.State := Failed;
-   end Fail;
- 
-   procedure Set( The_Breaker : in out Breaker'Class; To_State : Status ) is
-   begin
-     The_Breaker.State := To_State;
-   end Set;
- 
-   function  Status_Of( The_Breaker : Breaker ) return Status is
-   begin
-     TCTouch.Touch( 'b' ); --------------------------------------------- b
-     return The_Breaker.State;
-   end Status_Of;
- end C3A2001_1;
- 
- ----------------------------------------------------------------------------
- 
- with C3A2001_1;
- package C3A2001_2 is
- 
-   type Basic_Breaker is new C3A2001_1.Breaker with private;
- 
-   type Voltages is ( V12, V110, V220, V440 );
-   type Amps     is ( A1, A5, A10, A25, A100 );
- 
-   function Construct( Voltage : Voltages; Amperage : Amps )
-     return Basic_Breaker;
- 
-   procedure Flip ( The_Breaker : in out Basic_Breaker );
-   procedure Trip ( The_Breaker : in out Basic_Breaker );
-   procedure Reset( The_Breaker : in out Basic_Breaker );
- private
-   type Basic_Breaker is new C3A2001_1.Breaker with record
-     Voltage_Level : Voltages := V110;
-     Amperage      : Amps;
-   end record;
- end C3A2001_2;
- 
- ----------------------------------------------------------------------------
- 
- with TCTouch;
- package body C3A2001_2 is
-   function Construct( Voltage : Voltages; Amperage : Amps )
-     return Basic_Breaker is
-     It : Basic_Breaker;
-   begin
-     TCTouch.Touch( 'c' ); --------------------------------------------- c
-     It.Amperage := Amperage;
-     It.Voltage_Level := Voltage;
-     C3A2001_1.Set( It, C3A2001_1.Power_Off );
-     return It;
-   end Construct;
- 
-   procedure Flip ( The_Breaker : in out Basic_Breaker ) is
-   begin
-     TCTouch.Touch( 'd' ); --------------------------------------------- d
-     case Status_Of( The_Breaker ) is
-       when C3A2001_1.Power_Off =>
-         C3A2001_1.Set( The_Breaker, C3A2001_1.Power_On );
-       when C3A2001_1.Power_On =>
-         C3A2001_1.Set( The_Breaker, C3A2001_1.Power_Off );
-       when C3A2001_1.Tripped | C3A2001_1.Failed  => null;
-     end case;
-   end Flip;
- 
-   procedure Trip ( The_Breaker : in out Basic_Breaker ) is
-   begin
-     TCTouch.Touch( 'e' ); --------------------------------------------- e
-     C3A2001_1.Set( The_Breaker, C3A2001_1.Tripped );
-   end Trip;
- 
-   procedure Reset( The_Breaker : in out Basic_Breaker ) is
-   begin
-     TCTouch.Touch( 'f' ); --------------------------------------------- f
-     case Status_Of( The_Breaker ) is
-       when C3A2001_1.Power_Off | C3A2001_1.Tripped =>
-         C3A2001_1.Set( The_Breaker, C3A2001_1.Power_On );
-       when C3A2001_1.Power_On  | C3A2001_1.Failed  => null;
-     end case;
-   end Reset;
- 
- end C3A2001_2;
- 
- ----------------------------------------------------------------------------
- 
- with C3A2001_1,C3A2001_2;
- package C3A2001_3 is
-   use type C3A2001_1.Status;
- 
-   type Ground_Fault is new C3A2001_2.Basic_Breaker with private;
- 
-   function Construct( Voltage  : C3A2001_2.Voltages;
-                       Amperage : C3A2001_2.Amps )
-     return Ground_Fault;
- 
-   procedure Set_Trip( The_Breaker : in out Ground_Fault;
-                       Capacitance : in     Integer );
- 
- private
-   type Ground_Fault is new C3A2001_2.Basic_Breaker with record
-     Capacitance : Integer;
-   end record;
- end C3A2001_3;
- 
- ----------------------------------------------------------------------------
- 
- with TCTouch;
- package body C3A2001_3 is
- 
-   function Construct( Voltage  : C3A2001_2.Voltages;
-                       Amperage : C3A2001_2.Amps )
-     return Ground_Fault is
-   begin
-     TCTouch.Touch( 'g' ); --------------------------------------------- g
-     return ( C3A2001_2.Construct( Voltage, Amperage )
-              with Capacitance => 0 );
-   end Construct;
- 
- 
-   procedure Set_Trip( The_Breaker : in out Ground_Fault;
-                       Capacitance : in     Integer ) is
-   begin
-     TCTouch.Touch( 'h' ); --------------------------------------------- h
-     The_Breaker.Capacitance := Capacitance;
-   end Set_Trip;
- 
- end C3A2001_3;
- 
- ----------------------------------------------------------------------------
- 
- with C3A2001_1, C3A2001_2;
- package C3A2001_4 is
- 
-   type Special_Breaker is new C3A2001_2.Basic_Breaker with private;
- 
-   function Construct( Voltage     : C3A2001_2.Voltages;
-                       Amperage    : C3A2001_2.Amps )
-     return Special_Breaker;
- 
-   procedure Flip ( The_Breaker : in out Special_Breaker );
-   procedure Trip ( The_Breaker : in out Special_Breaker );
-   procedure Reset( The_Breaker : in out Special_Breaker );
-   procedure Fail ( The_Breaker : in out Special_Breaker );
- 
-   function Status_Of( The_Breaker : Special_Breaker ) return C3A2001_1.Status;
-   function On_Backup( The_Breaker : Special_Breaker ) return Boolean;
- 
- private
-   type Special_Breaker is new C3A2001_2.Basic_Breaker with record
-     Backup : C3A2001_2.Basic_Breaker;
-   end record;
- end C3A2001_4;
- 
- ----------------------------------------------------------------------------
- 
- with TCTouch;
- package body C3A2001_4 is
- 
-   function Construct( Voltage     : C3A2001_2.Voltages;
-                       Amperage    : C3A2001_2.Amps )
-     return Special_Breaker is
-     It: Special_Breaker;
-     procedure Set_Root( It: in out C3A2001_2.Basic_Breaker ) is
-     begin
-       It := C3A2001_2.Construct( Voltage, Amperage );
-     end Set_Root;
-   begin
-     TCTouch.Touch( 'i' ); --------------------------------------------- i
-     Set_Root( C3A2001_2.Basic_Breaker( It ) );
-     Set_Root( It.Backup );
-     return It;
-   end Construct;
- 
-   function Status_Of( It: C3A2001_1.Breaker ) return C3A2001_1.Status
-     renames C3A2001_1.Status_Of;
- 
-   procedure Flip ( The_Breaker : in out Special_Breaker ) is
-   begin
-     TCTouch.Touch( 'j' ); --------------------------------------------- j
-     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
-       when C3A2001_1.Power_Off | C3A2001_1.Power_On =>
-         C3A2001_2.Flip( C3A2001_2.Basic_Breaker( The_Breaker ) );
-       when others =>
-         C3A2001_2.Flip( The_Breaker.Backup );
-     end case;
-   end Flip;
- 
-   procedure Trip ( The_Breaker : in out Special_Breaker ) is
-   begin
-     TCTouch.Touch( 'k' ); --------------------------------------------- k
-     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
-       when C3A2001_1.Power_Off => null;
-       when C3A2001_1.Power_On  =>
-         C3A2001_2.Reset( The_Breaker.Backup );
-         C3A2001_2.Trip( C3A2001_2.Basic_Breaker( The_Breaker ) );
-       when others =>
-         C3A2001_2.Trip( The_Breaker.Backup );
-     end case;
-   end Trip;
- 
-   procedure Reset( The_Breaker : in out Special_Breaker ) is
-   begin
-     TCTouch.Touch( 'l' ); --------------------------------------------- l
-     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
-       when C3A2001_1.Tripped  =>
-         C3A2001_2.Reset( C3A2001_2.Basic_Breaker( The_Breaker ));
-       when C3A2001_1.Failed  =>
-         C3A2001_2.Reset( The_Breaker.Backup );
-       when C3A2001_1.Power_On | C3A2001_1.Power_Off =>
-         null;
-     end case;
-   end Reset;
- 
-   procedure Fail ( The_Breaker : in out Special_Breaker ) is
-   begin
-     TCTouch.Touch( 'm' ); --------------------------------------------- m
-     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
-       when C3A2001_1.Failed  =>
-         C3A2001_2.Fail( The_Breaker.Backup );
-       when others => 
-         C3A2001_2.Fail( C3A2001_2.Basic_Breaker( The_Breaker ));
-         C3A2001_2.Reset( The_Breaker.Backup );
-     end case;
-   end Fail;
- 
-   function Status_Of( The_Breaker : Special_Breaker )
-     return C3A2001_1.Status is
-   begin
-     TCTouch.Touch( 'n' ); --------------------------------------------- n
-     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
-       when C3A2001_1.Power_On  => return C3A2001_1.Power_On;
-       when C3A2001_1.Power_Off => return C3A2001_1.Power_Off;
-       when others =>
-         return C3A2001_2.Status_Of( The_Breaker.Backup );
-     end case;
-   end Status_Of;
- 
-   function On_Backup( The_Breaker : Special_Breaker ) return Boolean is
-     use C3A2001_2;
-     use type C3A2001_1.Status;
-   begin
-     return Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Tripped
-         or Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Failed;
-   end On_Backup;
- 
- end C3A2001_4;
- 
- ----------------------------------------------------------------------------
- 
- with C3A2001_1;
- package C3A2001_5 is
- 
-   type Component is access C3A2001_1.Breaker'Class;
- 
-   type Circuit;
-   type Connection is access Circuit;
- 
-   type Circuit is record
-     The_Gadget : Component;
-     Next : Connection;
-   end record;
- 
-   procedure Flipper( The_Circuit : Connection );
-   procedure Tripper( The_Circuit : Connection );
-   procedure Restore( The_Circuit : Connection );
-   procedure Failure( The_Circuit : Connection );
- 
-   Short : Connection := null;
- 
- end C3A2001_5;
- 
- ----------------------------------------------------------------------------
- with Report;
- with TCTouch;
- with C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4;
- 
- pragma Elaborate_All( Report, TCTouch,
-                       C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4 );
- 
- package body C3A2001_5 is
- 
-   function Neww( Breaker: in C3A2001_1.Breaker'Class )
-     return Component is
-   begin
-     return new C3A2001_1.Breaker'Class'( Breaker );
-   end Neww;
- 
-   procedure Add( Gadget     : in     Component;
-                  To_Circuit : in out Connection) is
-   begin
-     To_Circuit := new Circuit'(Gadget,To_Circuit);
-   end Add;
- 
-   procedure Flipper( The_Circuit : Connection ) is
-     Probe : Connection := The_Circuit;
-   begin
-     while Probe /= null loop
-       C3A2001_1.Flip( Probe.The_Gadget.all );
-       Probe := Probe.Next;
-     end loop;
-   end Flipper;
- 
-   procedure Tripper( The_Circuit : Connection ) is
-     Probe : Connection := The_Circuit;
-   begin
-     while Probe /= null loop
-       C3A2001_1.Trip( Probe.The_Gadget.all );
-       Probe := Probe.Next;
-     end loop;
-   end Tripper;
- 
-   procedure Restore( The_Circuit : Connection ) is
-     Probe : Connection := The_Circuit;
-   begin
-     while Probe /= null loop
-       C3A2001_1.Reset( Probe.The_Gadget.all );
-       Probe := Probe.Next;
-     end loop;
-   end Restore;
- 
-   procedure Failure( The_Circuit : Connection ) is
-     Probe : Connection := The_Circuit;
-   begin
-     while Probe /= null loop
-       C3A2001_1.Fail( Probe.The_Gadget.all );
-       Probe := Probe.Next;
-     end loop;
-   end Failure;
- 
- begin
-   Add( Neww( C3A2001_2.Construct( C3A2001_2.V440, C3A2001_2.A5   )), Short );
-   Add( Neww( C3A2001_3.Construct( C3A2001_2.V110, C3A2001_2.A1   )), Short );
-   Add( Neww( C3A2001_4.Construct( C3A2001_2.V12,  C3A2001_2.A100 )), Short );
- end C3A2001_5;
- 
- ----------------------------------------------------------------------------
- 
- with Report;
- with TCTouch;
- with C3A2001_5;
- procedure C3A2001 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C3A2001", "Check that an abstract type can be declared " &
-                "and used.  Check actual subprograms dispatch correctly" );
- 
-   -- This Validate call must be _after_ the call to Report.Test
-   TCTouch.Validate( "cgcicc", "Adding" );
- 
-   C3A2001_5.Flipper( C3A2001_5.Short );
-   TCTouch.Validate( "jbdbdbdb", "Flipping" );
- 
-   C3A2001_5.Tripper( C3A2001_5.Short );
-   TCTouch.Validate( "kbfbeee", "Tripping" );
- 
-   C3A2001_5.Restore( C3A2001_5.Short );
-   TCTouch.Validate( "lbfbfbfb", "Restoring" );
- 
-   C3A2001_5.Failure( C3A2001_5.Short );
-   TCTouch.Validate( "mbafbaa", "Circuits Failing" );
- 
-   Report.Result;
- 
- end C3A2001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,295 ****
- -- C3A2002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for X'Access of a general access type A, Program_Error is
- --      raised if the accessibility level of X is deeper than that of A.
- --      Check for the case where X denotes a view that is a dereference of an
- --      access parameter, or a rename thereof.
- --      
- --      Check for cases where the actual corresponding to X is:
- --         (a) An allocator.
- --         (b) An expression of a named access type.
- --         (c) Obj'Access.
- --      
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the designated
- --      object X must be at the same or a less deep nesting level than the
- --      general access type A -- X must "live" as long as A. Nesting
- --      levels are the run-time nestings of masters: block statements;
- --      subprogram, task, and entry bodies; and accept statements. Packages
- --      are invisible to accessibility rules.
- --
- --      This test declares subprograms with access parameters, within which
- --      'Access is attempted on a dereference of the access parameter, and
- --      assigned to an access object whose type A is declared at some nesting
- --      level. The test verifies that Program_Error is raised if the actual
- --      corresponding to the access parameter is:
- --
- --         (1) an allocator, and the accessibility level of the execution
- --             of the called subprogram is deeper than that of the access
- --             type A. 
- --
- --         (2) an expression of a named access type, and the accessibility
- --             level of the named access type is deeper than that of the
- --             access type A. 
- --
- --         (3) a reference to the Access attribute (e.g., X'Access), and
- --             the accessibility level of X is deeper than that of the
- --             access type A. 
- --
- --      Note that the static nesting level of the actual corresponding to the
- --      access parameter can be deeper than that of the type A -- it is
- --      the run-time nesting that matters for accessibility rules. Consider
- --      the case where the access type A is declared within the called
- --      subprogram. The accessibility check will never fail, even if the
- --      actual happens to have a deeper static nesting level:
- --
- --         procedure P (X: access T) is
- --            type A is access all T;   -- Static level = 2, e.g.
- --            Acc : A := X.all'Access;  -- Check should never fail.
- --         begin null; end;
- --         . . .
- --         declare
- --            Actual : aliased T;       -- Static level = 3, e.g.
- --         begin
- --            P (Actual'Access);
- --         end;
- --
- --         For the execution of P, the accessibility level of type A will
- --         always be deeper than that of Actual, so there is no danger of a
- --         dangling reference arising from the assignment to Acc. Thus,
- --         X.all'Access is safe, even though the static nesting level of
- --         Actual is deeper than that of A.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C3A2002_0 is
- 
-    type Desig is array (1 .. 10) of Integer;
- 
-    X0 : aliased Desig;                                            -- Level = 0.
- 
-    type Acc_L0 is access all Desig;                               -- Level = 0.
-    A0 : Acc_L0;
- 
-    type Result_Kind is (OK, P_E, O_E);
- 
-    procedure A_Is_Level_0 (X: access Desig; R : out Result_Kind);
-    procedure Never_Fails  (X: access Desig; R : out Result_Kind);
- 
- end C3A2002_0;
- 
- 
-      --==================================================================--
- 
- package body C3A2002_0 is
- 
-    procedure A_Is_Level_0 (X : access Desig;
-                            R : out Result_Kind) is
-    begin
-       -- The accessibility level of the type of A0 is 0.
-       A0 := X.all'Access;
-       R  := OK;
-    exception
-       when Program_Error =>    
-          R := P_E;
-       when others        =>    
-          R := O_E;
-    end A_Is_Level_0;
- 
-    -----------------------------------------------
-    procedure Never_Fails (X: access Desig;
-                           R : out Result_Kind) is
-       type Acc_Local is access all Desig;
-       AL : Acc_Local;
-    begin
-       -- X.all'Access below will always be safe, since the accessibility
-       -- level (although not necessarily the static nesting depth) of the
-       -- type of AL will always be deeper than or the same as that of the 
-       -- actual corresponding to Y. 
-       AL := X.all'Access;
-       R  := OK;
-    exception
-       when Program_Error =>    
-          R := P_E;
-       when others        =>    
-          R := O_E;
-    end Never_Fails;
- 
- end C3A2002_0;
- 
- 
-      --==================================================================--
- 
- 
- with C3A2002_0;
- with Report;
- 
- procedure C3A2002 is
- 
-    X1 : aliased C3A2002_0.Desig;                                  -- Level = 1.
- 
-    type Acc_L1 is access all C3A2002_0.Desig;                     -- Level = 1.
-    A1 : Acc_L1;
- 
-    Expr_L0 : C3A2002_0.Acc_L0 := C3A2002_0.X0'Access;
-    Expr_L1 : Acc_L1           := X1'Access;
- 
-    Res : C3A2002_0.Result_Kind;
- 
-    use type C3A2002_0.Result_Kind;
- 
-    -----------------------------------------------
-    procedure A_Is_Level_1 (X : access C3A2002_0.Desig;
-                            R : out C3A2002_0.Result_Kind) is
-       -- Dereference of an access_to_object value is aliased.
-       Ren : C3A2002_0.Desig renames X.all;      -- Renaming of a dereference
-    begin                                        -- of an access parameter.
-       -- The accessibility level of the type of A1 is 1.
-       A1 := Ren'Access;
-       R  := C3A2002_0.OK;
-    exception
-       when Program_Error =>    
-          R := C3A2002_0.P_E;
-       when others        =>    
-          R := C3A2002_0.O_E;
-    end A_Is_Level_1;
- 
-    -----------------------------------------------
-    procedure Display_Results (Result  : in C3A2002_0.Result_Kind;
-                               Expected: in C3A2002_0.Result_Kind;
-                               Message : in String) is
-    begin
-       if Result /= Expected then
-          case Result is
-             when C3A2002_0.OK  => Report.Failed ("No exception raised: "  & 
-                                                  Message);
-             when C3A2002_0.P_E => Report.Failed ("Program_Error raised: " & 
-                                                  Message);
-             when C3A2002_0.O_E => Report.Failed ("Unexpected exception "  &
-                                                  "raised: " & Message);
-          end case;
-       end if;
-    end Display_Results;
- 
- begin -- C3A2002 
- 
-    Report.Test ("C3A2002", "Check that, for X'Access of general access "   &
-                 "type A, Program_Error is raised if the accessibility "    &
-                 "level of X is deeper than that of A: X is an access "     &
-                 "parameter; corresponding actual is an allocator, "        &
-                 "expression of a named access type, Obj'Access, or a "     &
-                 "rename thereof");
- 
- 
-    -- Actual is X'Access:
- 
-    C3A2002_0.Never_Fails (C3A2002_0.X0'Access, Res);
-    Display_Results (Res, C3A2002_0.OK, "X0'Access, local access type");
- 
-    C3A2002_0.A_Is_Level_0 (C3A2002_0.X0'Access, Res);
-    Display_Results (Res, C3A2002_0.OK, "X0'Access, level 0 access type");
- 
-    C3A2002_0.A_Is_Level_0 (X1'Access, Res);
-    Display_Results (Res, C3A2002_0.P_E, "X1'Access, level 0 access type");
- 
-    A_Is_Level_1 (X1'Access, Res);
-    Display_Results (Res, C3A2002_0.OK, "X1'Access, level 1 access type");
- 
- 
-    -- Actual is expression of a named access type:
- 
-    C3A2002_0.Never_Fails (Expr_L1, Res);
-    Display_Results (Res, C3A2002_0.OK, "Expr_L1, local access type");
- 
-    C3A2002_0.A_Is_Level_0 (Expr_L1, Res);
-    Display_Results (Res, C3A2002_0.P_E, "Expr_L1, level 0 access type");
- 
-    A_Is_Level_1 (Expr_L0, Res);
-    Display_Results (Res, C3A2002_0.OK, "Expr_L0, level 1 access type");
- 
-    A_Is_Level_1 (Expr_L1, Res);
-    Display_Results (Res, C3A2002_0.OK, "Expr_L1, level 1 access type");
- 
-    -- Actual is allocator (level of execution = 2):
- 
-    C3A2002_0.Never_Fails (new C3A2002_0.Desig, Res);
-    Display_Results (Res, C3A2002_0.OK, "Allocator level 2, " &
-                                        "local access type");
- 
-    -- Since actual is an allocator, its accessibility level is that of
-    -- the execution of the called subprogram, i.e., level 2.
- 
-    C3A2002_0.A_Is_Level_0 (new C3A2002_0.Desig, Res);
-    Display_Results (Res, C3A2002_0.P_E, "Allocator level 2, " &
-                                         "level 0 access type");
- 
-    A_Is_Level_1 (new C3A2002_0.Desig, Res);
-    Display_Results (Res, C3A2002_0.P_E, "Allocator level 2, " &
-                                         "level 1 access type");
- 
- 
-    Block_L2:
-    declare
-       X2 : aliased C3A2002_0.Desig;                               -- Level = 2.
-       type Acc_L2 is access all C3A2002_0.Desig;                  -- Level = 2.
-       Expr_L2 : Acc_L2 := X1'Access;
-    begin
- 
-       -- Actual is X'Access:
- 
-       C3A2002_0.Never_Fails (X2'Access, Res);
-       Display_Results (Res, C3A2002_0.OK, "X2'Access, local access type");
- 
-       C3A2002_0.A_Is_Level_0 (X2'Access, Res);
-       Display_Results (Res, C3A2002_0.P_E, "X2'Access, level 0 access type");
- 
- 
-       -- Actual is expression of a named access type:
- 
-       A_Is_Level_1 (Expr_L2, Res);
-       Display_Results (Res, C3A2002_0.P_E, "Expr_L2, level 1 access type");
- 
- 
-       -- Actual is allocator (level of execution = 3):
- 
-       C3A2002_0.Never_Fails (new C3A2002_0.Desig, Res);
-       Display_Results (Res, C3A2002_0.OK, "Allocator level 3, " &
-                                           "local access type");
- 
-       A_Is_Level_1 (new C3A2002_0.Desig, Res);
-       Display_Results (Res, C3A2002_0.P_E, "Allocator level 3, " &
-                                            "level 1 access type");
- 
-    end Block_L2;
- 
-    Report.Result;
- 
- end C3A2002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,329 ****
- -- C3A2003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for X'Access of a general access type A, Program_Error is
- --      raised if the accessibility level of X is deeper than that of A.
- --      Check for the case where X denotes a view that is a dereference of an
- --      access parameter, or a rename thereof. Check for the case where X is
- --      an access parameter and the corresponding actual is another access
- --      parameter.
- --
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the designated
- --      object X must be at the same or a less deep nesting level than the
- --      general access type A -- X must "live" as long as A. Nesting
- --      levels are the run-time nestings of masters: block statements;
- --      subprogram, task, and entry bodies; and accept statements. Packages
- --      are invisible to accessibility rules.
- --
- --      This test declares subprograms with access parameters, within which
- --      'Access is attempted on a dereference of an access parameter, and
- --      assigned to an access object whose type A is declared at some nesting
- --      level. The test verifies that Program_Error is raised if the actual
- --      corresponding to the access parameter is another access parameter,
- --      and the actual corresponding to this second access parameter is:
- --
- --         (1) an expression of a named access type, and the accessibility
- --             level of the named access type is deeper than that of the
- --             access type A.
- --
- --         (2) a reference to the Access attribute (e.g., X'Access), and
- --             the accessibility level of X is deeper than that of the
- --             access type A.
- --
- --      Note that the static nesting level of the actual corresponding to the
- --      access parameter can be deeper than that of the type A -- it is
- --      the run-time nesting that matters for accessibility rules. Consider
- --      the case where the access type A is declared within the called
- --      subprogram. The accessibility check will never fail, even if the
- --      actual happens to have a deeper static nesting level:
- --
- --         procedure P (X: access T) is
- --            type A is access all T;   -- Static level = 2, e.g.
- --            Acc : A := X.all'Access;  -- Check should never fail.
- --         begin null; end;
- --         . . .
- --         procedure Q (Y: access T) is
- --         begin
- --            P(Y);
- --         end;
- --         . . .
- --         declare
- --            Actual : aliased T;       -- Static level = 3, e.g.
- --         begin
- --            Q (Actual'Access);
- --         end;
- --
- --         For the execution of Q (and hence P), the accessibility level of
- --         type A will always be deeper than that of Actual, so there is no
- --         danger of a dangling reference arising from the assignment to
- --         Acc. Thus, X.all'Access is safe, even though the static nesting
- --         level of Actual is deeper than that of A.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC   ACVC 2.0
- --      15 Jul 98   EDS    Avoid optimization.
- --      28 Jun 02   RLB    Added pragma Elaborate_All (Report);.
- --!
- 
- with report; use report; pragma Elaborate_All (report);
- package C3A2003_0 is
- 
-    type Desig is array (1 .. 10) of Integer;
- 
-    X0 : aliased Desig := (Desig'Range => Ident_Int(3));           -- Level = 0.
- 
-    type Acc_L0 is access all Desig;                               -- Level = 0.
-    A0 : Acc_L0;
- 
-    type Result_Kind is (OK, P_E, O_E);
- 
-    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind);
-    procedure Never_Fails_Nest       (Y: access Desig; S: out Result_Kind);
-    procedure Never_Fails_Same       (Y: access Desig; S: out Result_Kind);
- 
- end C3A2003_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C3A2003_0 is
- 
-    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind) is
- 
- 
-       -- This procedure utilizes 'Access on a dereference of an access
-       -- parameter, and assigned to an access object whose type A is
-       -- declared at some nesting level.  Program_Error is raised if
-       -- the accessibility level of the operand type is deeper than that
-       -- of the target type.
- 
-       procedure Nested (X: access Desig; R: out Result_Kind) is
-          -- Dereference of an access_to_object value is aliased.
-          Ren : Desig renames X.all;                -- Renaming of a dereference
-       begin                                        -- of an access parameter.
-          -- The accessibility level of type A0 is 0.
-          A0 := Ren'Access;
-          R  := OK;
-       exception
-          when Program_Error =>
-             R := P_E;
-          when others        =>
-             R := O_E;
-       end Nested;
- 
-    begin   -- Target_Is_Level_0_Nest
-       Nested (Y, S);
-    end Target_Is_Level_0_Nest;
- 
-    ------------------------------------------------------------------
- 
-    procedure Never_Fails_Nest (Y: access Desig; S: out Result_Kind) is
- 
-       type Acc_Deeper is access all Desig;
-       AD : Acc_Deeper;
- 
-       function Nested (X: access Desig) return Result_Kind is
-       begin
-          -- X.all'Access below will always be safe, since the accessibility
-          -- level (although not necessarily the static nesting depth) of the
-          -- type of AD will always be deeper than or the same as that of the
-          -- actual corresponding to Y.
-          AD := X.all'Access;
-          if Ident_Int (AD(4)) /= 3 then            --Avoid Optimization of AD
-            FAILED ("Initial Values not correct.");
-          end if;
-          return OK;
-       exception
-          when Program_Error =>
-             return P_E;
-          when others        =>
-             return O_E;
-       end Nested;
- 
-    begin  -- Never_Fails_Nest
-       S := Nested (Y);
-    end Never_Fails_Nest;
- 
-    ------------------------------------------------------------------
- 
-    procedure Called_By_Never_Fails_Same
-      (X: access Desig; R: out Result_Kind) is
-       type Acc_Local is access all Desig;
-       AL : Acc_Local;
- 
-       -- Dereference of an access_to_object value is aliased.
-       Ren : Desig renames X.all;                   -- Renaming of a dereference
-    begin                                           -- of an access parameter.
-       -- Ren'Access below will always be safe, since the accessibility
-       -- level (although not necessarily the static nesting depth) of
-       -- type of AL will always be deeper than or the same as that of the
-       -- actual corresponding to Y.
-       AL := Ren'Access;
-       if Ident_Int (AL(4)) /= 3 then       --Avoid Optimization of AL
-         FAILED ("Initial Values not correct.");
-       end if;
-       R  := OK;
-    exception
-       when Program_Error =>
-          R := P_E;
-       when others        =>
-          R := O_E;
-    end Called_By_Never_Fails_Same;
- 
-    ------------------------------------------------------------------
- 
-    procedure Never_Fails_Same (Y: access Desig; S: out Result_Kind) is
-    begin
-       Called_By_Never_Fails_Same (Y, S);
-    end Never_Fails_Same;
- 
- end C3A2003_0;
- 
- 
-      --==================================================================--
- 
- 
- with C3A2003_0;
- use  C3A2003_0;
- 
- with Report; use report;
- 
- procedure C3A2003 is
- 
-    type Acc_L1 is access all Desig;                               -- Level = 1.
-    A1  : Acc_L1;
-    X1 : aliased Desig := (Desig'Range => Ident_Int(3));
-    Res : Result_Kind;
- 
- 
-    procedure Called_By_Target_L1 (X: access Desig; R: out Result_Kind) is
-    begin
-       -- The accessibility level of the type of A1 is 1.
-       A1 := X.all'Access;
-       if IDENT_INT (A1(4)) /= 3 then       --Avoid optimization of A1
-         FAILED ("Initial values not correct.");
-       end if;
-       R  := OK;
-    exception
-       when Program_Error =>
-          R := P_E;
-       when others        =>
-          R := O_E;
-    end Called_By_Target_L1;
- 
-    ------------------------------------------------------------------
- 
-    function Target_Is_Level_1_Same (Y: access Desig) return Result_Kind is
-       S : Result_Kind;
-    begin
-       Called_By_Target_L1 (Y, S);
-       return S;
-    end Target_Is_Level_1_Same;
- 
-    ------------------------------------------------------------------
- 
-    procedure Display_Results (Result  : in Result_Kind;
-                               Expected: in Result_Kind;
-                               Msg     : in String) is
-    begin
-       if Result /= Expected then
-          case Result is
-             when OK  => Report.Failed ("No exception raised: "         & Msg);
-             when P_E => Report.Failed ("Program_Error raised: "        & Msg);
-             when O_E => Report.Failed ("Unexpected exception raised: " & Msg);
-          end case;
-       end if;
-    end Display_Results;
- 
- begin -- C3A2003
- 
-    Report.Test ("C3A2003", "Check that, for X'Access of general access "   &
-                 "type A, Program_Error is raised if the accessibility "    &
-                 "level of X is deeper than that of A: X is an access "     &
-                 "parameter; corresponding actual is another access "       &
-                 "parameter");
- 
- 
-    -- Accessibility level of actual is 0 (actual is X'Access):
- 
-    Never_Fails_Same (X0'Access, Res);
-    Display_Results (Res, OK, "Never_Fails_Same, level 0 actual");
- 
-    Never_Fails_Nest (X0'Access, Res);
-    Display_Results (Res, OK, "Target_L1_Nest, level 0 actual");
- 
-    Target_Is_Level_0_Nest (X0'Access, Res);
-    Display_Results (Res, OK, "Target_L0_Nest, level 0 actual");
- 
-    Res := Target_Is_Level_1_Same (X0'Access);
-    Display_Results (Res, OK, "Target_L1_Same, level 0 actual");
- 
- 
-    -- Accessibility level of actual is 1 (actual is X'Access):
- 
-    Never_Fails_Same (X1'Access, Res);
-    Display_Results (Res, OK, "Never_Fails_Same, level 1 actual");
- 
-    Never_Fails_Nest (X1'Access, Res);
-    Display_Results (Res, OK, "Target_L1_Nest, level 1 actual");
- 
-    Target_Is_Level_0_Nest (X1'Access, Res);
-    Display_Results (Res, P_E, "Target_L0_Nest, level 1 actual");
- 
-    Res := Target_Is_Level_1_Same (X1'Access);
-    Display_Results (Res, OK, "Target_L1_Same, level 1 actual");
- 
- 
-    Block_L2:
-    declare
-       X2 : aliased Desig := (Desig'Range => Ident_Int(3));
-       type Acc_L2 is access all Desig;                            -- Level = 2.
-       Expr_L2 : Acc_L2 := X2'Access;
-    begin
- 
-       -- Accessibility level of actual is 2 (actual is expression of named
-       -- access type):
- 
-       Never_Fails_Same (Expr_L2, Res);
-       Display_Results (Res, OK, "Never_Fails_Same, level 2 actual");
- 
-       Never_Fails_Nest (Expr_L2, Res);
-       Display_Results (Res, OK, "Target_L1_Nest, level 2 actual");
- 
-       Target_Is_Level_0_Nest (Expr_L2, Res);
-       Display_Results (Res, P_E, "Target_L0_Nest, level 2 actual");
- 
-       Res := Target_Is_Level_1_Same (Expr_L2);
-       Display_Results (Res, P_E, "Target_L1_Same, level 2 actual");
- 
-    end Block_L2;
- 
-    Report.Result;
- 
- end C3A2003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,367 ****
- -- C3A2A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for X'Access of a general access type A, Program_Error is
- --      raised if the accessibility level of X is deeper than that of A.
- --      Check for cases where X'Access occurs in an instance body, and A
- --      is passed as an actual during instantiation.
- --
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the designated
- --      object X must be at the same or a less deep nesting level than the
- --      general access type A -- X must "live" as long as A. Nesting
- --      levels are the run-time nestings of masters: block statements;
- --      subprogram, task, and entry bodies; and accept statements. Packages
- --      are invisible to accessibility rules.
- --
- --      This test declares three generic units, each of which has a formal
- --      general access type:
- --
- --         (1) A generic package, in which X is declared in the specification,
- --             and X'Access occurs within the declarative part of the body.
- --
- --         (2) A generic package, in which X is a formal in out object of a
- --             tagged formal derived type, and X'Access occurs in the sequence
- --             of statements of a nested subprogram.
- --
- --         (3) A generic procedure, in which X is a dereference of an access
- --             parameter, and X'Access occurs in the sequence of statements.
- --
- --      The test verifies the following:
- --
- --         For (1), Program_Error is raised upon instantiation if the generic
- --         package is instantiated at a deeper level than that of the general
- --         access type passed as an actual. The exception is propagated to the
- --         innermost enclosing master.
- --
- --         For (2), Program_Error is raised when the nested subprogram is
- --         called if the object passed as an actual during instantiation of
- --         the generic package has an accessibility level deeper than that of
- --         the general access type passed as an actual. The exception is
- --         handled within the nested subprogram. Also, check that
- --         Program_Error is not raised if the level of the actual access type
- --         is deeper than that of the actual object.
- --
- --         For (3), Program_Error is raised when the instance subprogram is
- --         called if the object pointed to by the actual corresponding to
- --         the access parameter has an accessibility level deeper than that of
- --         the general access type passed as an actual during instantiation.
- --         The exception is handled within the instance subprogram. Also,
- --         check that Program_Error is not raised if the level of the actual
- --         access type is deeper than that of the actual corresponding to the
- --         access parameter.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F3A2A00.A
- --      -> C3A2A01.A
- --
- --
- -- CHANGE HISTORY:
- --      12 May 95   SAIC    Initial prerelease version.
- --      10 Jul 95   SAIC    Modified code to avoid dead variable optimization.
- --
- --!
- 
- with F3A2A00;
- generic
-    type FD  is new F3A2A00.Array_Type;
-    type FAF is access all FD;
- package C3A2A01_0 is
-    X : aliased FD;
- 
-    procedure Dummy;  -- Needed to allow package body.
- end C3A2A01_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C3A2A01_0 is
-    Ptr   : FAF     := X'Access;
-    Index : Integer := F3A2A00.Array_Type'First;
- 
-    procedure Dummy is
-    begin
-       null;
-    end Dummy;
- begin
-    -- Avoid optimization (dead variable removal of Ptr):
- 
-    if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
-       Report.Failed ("Unexpected error in C3A2A01_0 instance");
-    end if;
- end C3A2A01_0;
- 
- 
-      --==================================================================--
- 
- 
- with F3A2A00;
- generic
-    type FD  is new F3A2A00.Tagged_Type with private;
-    type FAF is access all FD;
-    FObj : in out FD;
- package C3A2A01_1 is
-    procedure Handle (R: out F3A2A00.TC_Result_Kind);
- end C3A2A01_1;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C3A2A01_1 is
- 
-    procedure Handle (R: out F3A2A00.TC_Result_Kind) is
-       Ptr : FAF;
-    begin
-       Ptr := FObj'Access;
-       R   := F3A2A00.OK;
- 
-       -- Avoid optimization (dead variable removal of Ptr):
- 
-       if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
-          Report.Failed ("Unexpected error in Handle");
-       end if;
-    exception
-       when Program_Error => R := F3A2A00.P_E;
-       when others        => R := F3A2A00.O_E;
-    end Handle;
- 
- end C3A2A01_1;
- 
- 
-      --==================================================================--
- 
- 
- with F3A2A00;
- generic
-    type FD  is new F3A2A00.Array_Type;
-    type FAF is access all FD;
- procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind);
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind) is
-    Ptr   : FAF;
-    Index : Integer := F3A2A00.Array_Type'First;
- begin
-    Ptr := P.all'Access;
-    R   := F3A2A00.OK;
- 
-    -- Avoid optimization (dead variable removal of Ptr):
- 
-    if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
-       Report.Failed ("Unexpected error in C3A2A01_2 instance");
-    end if;
- exception
-    when Program_Error => R := F3A2A00.P_E;
-    when others        => R := F3A2A00.O_E;
- end C3A2A01_2;
- 
- 
-      --==================================================================--
- 
- 
- with F3A2A00;
- with C3A2A01_0;
- with C3A2A01_1;
- with C3A2A01_2;
- 
- with Report;
- procedure C3A2A01 is
- begin -- C3A2A01.                                              -- [ Level = 1 ]
- 
-    Report.Test ("C3A2A01", "Run-time accessibility checks: instance " &
-                 "bodies. Type of X'Access is passed as actual to instance");
- 
- 
-    SUBTEST1:
-    declare                                                     -- [ Level = 2 ]
-       Result : F3A2A00.TC_Result_Kind;
-    begin -- SUBTEST1.
- 
-       declare                                                  -- [ Level = 3 ]
-          type AccArr_L3 is access all F3A2A00.Array_Type;
-       begin
-          declare                                               -- [ Level = 4 ]
-             -- The accessibility level of Pack.X is that of the instantiation
-             -- (4). The accessibility level of the actual access type used to
-             -- instantiate Pack is 3. Therefore, the X'Access in Pack
-             -- propagates Program_Error when the instance body is elaborated:
- 
-             package Pack is new C3A2A01_0 (F3A2A00.Array_Type, AccArr_L3);
-          begin
-             Result := F3A2A00.OK;
-          end;
-       exception
-          when Program_Error => Result := F3A2A00.P_E;       -- Expected result.
-          when others        => Result := F3A2A00.O_E;
-       end;
- 
-       F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #1");
- 
-    end SUBTEST1;
- 
- 
- 
-    SUBTEST2:
-    declare                                                     -- [ Level = 2 ]
-       Result : F3A2A00.TC_Result_Kind;
-    begin -- SUBTEST2.
- 
-       declare                                                  -- [ Level = 3 ]
-          -- The instantiation of C3A2A01_1 should NOT result in any
-          -- exceptions.
- 
-          type AccTag_L3 is access all F3A2A00.Tagged_Type;
- 
-          package Pack_OK is new C3A2A01_1 (F3A2A00.Tagged_Type,
-                                            AccTag_L3,
-                                            F3A2A00.X_L0);
-       begin
-          -- The accessibility level of the actual object used to instantiate
-          -- Pack_OK is 0. The accessibility level of the actual access type
-          -- used to instantiate Pack_OK is 3. Therefore, the FObj'Access in
-          -- Pack_OK.Handle does not raise an exception when the subprogram is
-          -- called. If an exception is (incorrectly) raised, however, it is
-          -- handled within the subprogram:
- 
-          Pack_OK.Handle (Result);
-       end;
- 
-       F3A2A00.TC_Display_Results (Result, F3A2A00.OK, "SUBTEST #2");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #2: Program_Error incorrectly raised " &
-                         "during instantiation of generic");
-       when others        =>
-          Report.Failed ("SUBTEST #2: Unexpected exception raised " &
-                         "during instantiation of generic");
-    end SUBTEST2;
- 
- 
- 
-    SUBTEST3:
-    declare                                                     -- [ Level = 2 ]
-       Result : F3A2A00.TC_Result_Kind;
-    begin -- SUBTEST3.
- 
-       declare                                                  -- [ Level = 3 ]
-          -- The instantiation of C3A2A01_1 should NOT result in any
-          -- exceptions.
- 
-          X_L3: F3A2A00.Tagged_Type;
- 
-          package Pack_PE is new C3A2A01_1 (F3A2A00.Tagged_Type,
-                                            F3A2A00.AccTag_L0,
-                                            X_L3);
-       begin
-          -- The accessibility level of the actual object used to instantiate
-          -- Pack_PE is 3. The accessibility level of the actual access type
-          -- used to instantiate Pack_PE is 0. Therefore, the FObj'Access in
-          -- Pack_OK.Handle raises Program_Error when the subprogram is
-          -- called. The exception is handled within the subprogram:
- 
-          Pack_PE.Handle (Result);
-       end;
- 
-       F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #3");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #3: Program_Error incorrectly raised " &
-                         "during instantiation of generic");
-       when others        =>
-          Report.Failed ("SUBTEST #3: Unexpected exception raised " &
-                         "during instantiation of generic");
-    end SUBTEST3;
- 
- 
- 
-    SUBTEST4:
-    declare                                                     -- [ Level = 2 ]
-       Result1 : F3A2A00.TC_Result_Kind;
-       Result2 : F3A2A00.TC_Result_Kind;
-    begin -- SUBTEST4.
- 
-       declare                                                  -- [ Level = 3 ]
-          -- The instantiation of C3A2A01_2 should NOT result in any
-          -- exceptions.
- 
-          X_L3: aliased F3A2A00.Array_Type;
-          type AccArr_L3 is access all F3A2A00.Array_Type;
- 
-          procedure Proc is new C3A2A01_2 (F3A2A00.Array_Type, AccArr_L3);
-       begin
-          -- The accessibility level of Proc.P.all is that of the corresponding
-          -- actual during the call (in this case 3). The accessibility level of
-          -- the access type used to instantiate Proc is also 3. Therefore, the
-          -- P.all'Access in Proc does not raise an exception when the
-          -- subprogram is called. If an exception is (incorrectly) raised,
-          -- however, it is handled within the subprogram:
- 
-          Proc (X_L3'Access, Result1);
- 
-          F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
-                                      "SUBTEST #4: same levels");
- 
-          declare                                               -- [ Level = 4 ]
-             X_L4: aliased F3A2A00.Array_Type;
-          begin
-             -- Within this block, the accessibility level of the actual
-             -- corresponding to Proc.P.all is 4. Therefore, the P.all'Access
-             -- in Proc raises Program_Error when the subprogram is called. The
-             -- exception is handled within the subprogram:
- 
-             Proc (X_L4'Access, Result2);
- 
-             F3A2A00.TC_Display_Results (Result2, F3A2A00.P_E,
-                                         "SUBTEST #4: object at deeper level");
-          end;
- 
-       end;
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #4: Program_Error incorrectly raised " &
-                         "during instantiation of generic");
-       when others        =>
-          Report.Failed ("SUBTEST #4: Unexpected exception raised " &
-                         "during instantiation of generic");
-    end SUBTEST4;
- 
- 
-    Report.Result;
- 
- end C3A2A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c3/c3a2a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c3/c3a2a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,396 ****
- -- C3A2A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for X'Access of a general access type A, Program_Error is
- --      raised if the accessibility level of X is deeper than that of A.
- --      Check for cases where X'Access occurs in an instance body, and A
- --      is a type either declared inside the instance, or declared outside
- --      the instance but not passed as an actual during instantiation.
- --
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the designated
- --      object X must be at the same or a less deep nesting level than the
- --      general access type A -- X must "live" as long as A. Nesting
- --      levels are the run-time nestings of masters: block statements;
- --      subprogram, task, and entry bodies; and accept statements. Packages
- --      are invisible to accessibility rules.
- --
- --      This test declares three generic packages:
- --
- --         (1) One in which X is of a formal tagged derived type and declared
- --             in the body, A is a type declared outside the instance, and
- --             X'Access occurs in the declarative part of a nested subprogram.
- --
- --         (2) One in which X is a formal object of a tagged type, A is a
- --             type declared outside the instance, and X'Access occurs in the
- --             declarative part of the body.
- --
- --         (3) One in which there are two X's and two A's. In the first pair,
- --             X is a formal in object of a tagged type, A is declared in the
- --             specification, and X'Access occurs in the declarative part of
- --             the body. In the second pair, X is of a formal derived type,
- --             X and A are declared in the specification, and X'Access occurs
- --             in the sequence of statements of the body.
- --
- --      The test verifies the following:
- --
- --         For (1), Program_Error is raised when the nested subprogram is
- --         called, if the generic package is instantiated at a deeper level
- --         than that of A. The exception is propagated to the innermost
- --         enclosing master. Also, check that Program_Error is not raised
- --         if the instantiation is at the same level as that of A.
- --
- --         For (2), Program_Error is raised upon instantiation if the object
- --         passed as an actual during instantiation has an accessibility level
- --         deeper than that of A. The exception is propagated to the innermost
- --         enclosing master. Also, check that Program_Error is not raised if
- --         the level of the actual object is not deeper than that of A.
- --
- --         For (3), Program_Error is not raised, for actual objects at
- --         various accessibility levels (since A will have at least the same
- --         accessibility level as X in all cases, no exception should ever
- --         be raised).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F3A2A00.A
- --      -> C3A2A02.A
- --
- --
- -- CHANGE HISTORY:
- --      12 May 95   SAIC    Initial prerelease version.
- --      10 Jul 95   SAIC    Modified code to avoid dead variable optimization.
- --      26 Jun 98   EDS     Added pragma Elaborate (C3A2A02_0) to package
- --                          package C3A2A02_3, in order to avoid possible
- --                          instantiation error.
- --!
- 
- with F3A2A00;
- generic
-    type FD is new F3A2A00.Tagged_Type with private;
- package C3A2A02_0 is
-    procedure Proc;
- end C3A2A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C3A2A02_0 is
-    X : aliased FD;
- 
-    procedure Proc is
-       Ptr : F3A2A00.AccTagClass_L0 := X'Access;
-    begin
-       -- Avoid optimization (dead variable removal of Ptr):
- 
-       if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
-          Report.Failed ("Unexpected error in Proc");
-       end if;
-    end Proc;
- end C3A2A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with F3A2A00;
- generic
-    FObj : in out F3A2A00.Tagged_Type;
- package C3A2A02_1 is
-    procedure Dummy; -- Needed to allow package body.
- end C3A2A02_1;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C3A2A02_1 is
-    Ptr : F3A2A00.AccTag_L0 := FObj'Access;
- 
-    procedure Dummy is
-    begin
-       null;
-    end Dummy;
- begin
-    -- Avoid optimization (dead variable removal of Ptr):
- 
-    if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
-       Report.Failed ("Unexpected error in C3A2A02_1 instance");
-    end if;
- end C3A2A02_1;
- 
- 
-      --==================================================================--
- 
- 
- with F3A2A00;
- generic
-    type FD is new F3A2A00.Array_Type;
-    FObj : in F3A2A00.Tagged_Type;
- package C3A2A02_2 is
-    type GAF is access all FD;
-    type GAO is access constant F3A2A00.Tagged_Type;
-    XG    : aliased FD;
-    PtrF  : GAF;
-    Index : Integer := FD'First;
- 
-    procedure Dummy; -- Needed to allow package body.
- end C3A2A02_2;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C3A2A02_2 is
-    PtrO : GAO := FObj'Access;
- 
-    procedure Dummy is
-    begin
-       null;
-    end Dummy;
- begin
-    PtrF := XG'Access;
- 
-    -- Avoid optimization (dead variable removal of PtrO and/or PtrF):
- 
-    if not Report.Equal (PtrO.C, PtrO.C) then                -- Always false.
-       Report.Failed ("Unexpected error in C3A2A02_2 instance: PtrO");
-    end if;
- 
-    if not Report.Equal (PtrF(Index).C, PtrF(Index).C) then  -- Always false.
-       Report.Failed ("Unexpected error in C3A2A02_2 instance: PtrF");
-    end if;
- end C3A2A02_2;
- 
- 
-      --==================================================================--
- 
- 
- -- The instantiation of C3A2A02_0 should NOT result in any exceptions.
- 
- with F3A2A00;
- with C3A2A02_0;
- pragma Elaborate (C3A2A02_0);
- package C3A2A02_3 is new C3A2A02_0 (F3A2A00.Tagged_Type);
- 
- 
-      --==================================================================--
- 
- 
- with F3A2A00;
- with C3A2A02_0;
- with C3A2A02_1;
- with C3A2A02_2;
- with C3A2A02_3;
- 
- with Report;
- procedure C3A2A02 is
- begin -- C3A2A02.                                              -- [ Level = 1 ]
- 
-    Report.Test ("C3A2A02", "Run-time accessibility checks: instance " &
-                 "bodies. Type of X'Access is local or global to instance");
- 
- 
-    SUBTEST1:
-    declare                                                     -- [ Level = 2 ]
-       Result1 : F3A2A00.TC_Result_Kind;
-       Result2 : F3A2A00.TC_Result_Kind;
-    begin -- SUBTEST1.
- 
-       declare                                                  -- [ Level = 3 ]
-          package Pack_Same_Level renames C3A2A02_3;
-       begin
-          -- The accessibility level of Pack_Same_Level.X is that of the
-          -- instance (0), not that of the renaming declaration. The level of
-          -- the type of Pack_Same_Level.X'Access (F3A2A00.AccTagClass_L0) is
-          -- 0. Therefore, the X'Access in Pack_Same_Level.Proc does not raise
-          -- an exception when the subprogram is called. The level of execution
-          -- of the subprogram is irrelevant:
- 
-          Pack_Same_Level.Proc;
-          Result1 := F3A2A00.OK;                             -- Expected result.
-       exception
-          when Program_Error => Result1 := F3A2A00.P_E;
-          when others        => Result1 := F3A2A00.O_E;
-       end;
- 
-       F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
-                                   "SUBTEST #1 (same level)");
- 
- 
-       declare                                                  -- [ Level = 3 ]
-          -- The instantiation of C3A2A02_0 should NOT result in any
-          -- exceptions.
- 
-          package Pack_Deeper_Level is new C3A2A02_0 (F3A2A00.Tagged_Type);
-       begin
-          -- The accessibility level of Pack_Deeper_Level.X is that of the
-          -- instance (3). The level of the type of Pack_Deeper_Level.X'Access
-          -- (F3A2A00.AccTagClass_L0) is 0. Therefore, the X'Access in
-          -- Pack_Deeper_Level.Proc propagates Program_Error when the
-          -- subprogram is called:
- 
-          Pack_Deeper_Level.Proc;
-          Result2 := F3A2A00.OK;
-       exception
-          when Program_Error => Result2 := F3A2A00.P_E;      -- Expected result.
-          when others        => Result2 := F3A2A00.O_E;
-       end;
- 
-       F3A2A00.TC_Display_Results (Result2, F3A2A00.P_E,
-                                   "SUBTEST #1: deeper level");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #1: Program_Error incorrectly raised " &
-                         "during instantiation of generic");
-       when others        =>
-          Report.Failed ("SUBTEST #1: Unexpected exception raised " &
-                         "during instantiation of generic");
-    end SUBTEST1;
- 
- 
- 
-    SUBTEST2:
-    declare                                                     -- [ Level = 2 ]
-       Result1 : F3A2A00.TC_Result_Kind;
-       Result2 : F3A2A00.TC_Result_Kind;
-    begin -- SUBTEST2.
- 
-       declare                                                  -- [ Level = 3 ]
-          X_L3 : F3A2A00.Tagged_Type;
-       begin
-          declare                                               -- [ Level = 4 ]
-             -- The accessibility level of the actual object corresponding to
-             -- FObj in Pack_PE is 3. The level of the type of FObj'Access
-             -- (F3A2A00.AccTag_L0) is 0. Therefore, the FObj'Access in Pack_PE
-             -- propagates Program_Error when the instance body is elaborated:
- 
-             package Pack_PE is new C3A2A02_1 (X_L3);
-          begin
-             Result1 := F3A2A00.OK;
-          end;
-       exception
-          when Program_Error => Result1 := F3A2A00.P_E;      -- Expected result.
-          when others        => Result1 := F3A2A00.O_E;
-       end;
- 
-       F3A2A00.TC_Display_Results (Result1, F3A2A00.P_E,
-                                   "SUBTEST #2: deeper level");
- 
- 
-       begin                                                    -- [ Level = 3 ]
-          declare                                               -- [ Level = 4 ]
-             -- The accessibility level of the actual object corresponding to
-             -- FObj in Pack_OK is 0. The level of the type of FObj'Access
-             -- (F3A2A00.AccTag_L0) is also 0. Therefore, the FObj'Access in
-             -- Pack_OK does not raise an exception when the instance body is
-             -- elaborated:
- 
-             package Pack_OK is new C3A2A02_1 (F3A2A00.X_L0);
-          begin
-             Result2 := F3A2A00.OK;                          -- Expected result.
-          end;
-       exception
-          when Program_Error => Result2 := F3A2A00.P_E;
-          when others        => Result2 := F3A2A00.O_E;
-       end;
- 
-       F3A2A00.TC_Display_Results (Result2, F3A2A00.OK,
-                                   "SUBTEST #2: same level");
- 
-    end SUBTEST2;
- 
- 
- 
-    SUBTEST3:
-    declare                                                     -- [ Level = 2 ]
-       Result1 : F3A2A00.TC_Result_Kind;
-       Result2 : F3A2A00.TC_Result_Kind;
-    begin -- SUBTEST3.
- 
-       declare                                                  -- [ Level = 3 ]
-          X_L3 : F3A2A00.Tagged_Type;
-       begin
-          declare                                               -- [ Level = 4 ]
-             -- Since the accessibility level of the type of X'Access in
-             -- both cases within Pack_OK1 is that of the instance, and since
-             -- X is either passed as an actual (in which case its level will
-             -- not be deeper than that of the instance) or is declared within
-             -- the instance (in which case its level is the same as that of
-             -- the instance), no exception should be raised when the instance
-             -- body is elaborated:
- 
-             package Pack_OK1 is new C3A2A02_2 (F3A2A00.Array_Type, X_L3);
-          begin
-             Result1 := F3A2A00.OK;                          -- Expected result.
-          end;
-       exception
-          when Program_Error => Result1 := F3A2A00.P_E;
-          when others        => Result1 := F3A2A00.O_E;
-       end;
- 
-       F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
-                                   "SUBTEST #3: 1st okay case");
- 
- 
-       declare                                                  -- [ Level = 3 ]
-          type My_Array is new F3A2A00.Array_Type;
-       begin
-          declare                                               -- [ Level = 4 ]
-             -- Since the accessibility level of the type of X'Access in
-             -- both cases within Pack_OK2 is that of the instance, and since
-             -- X is either passed as an actual (in which case its level will
-             -- not be deeper than that of the instance) or is declared within
-             -- the instance (in which case its level is the same as that of
-             -- the instance), no exception should be raised when the instance
-             -- body is elaborated:
- 
-             package Pack_OK2 is new C3A2A02_2 (My_Array, F3A2A00.X_L0);
-          begin
-             Result2 := F3A2A00.OK;                          -- Expected result.
-          end;
-       exception
-          when Program_Error => Result2 := F3A2A00.P_E;
-          when others        => Result2 := F3A2A00.O_E;
-       end;
- 
-       F3A2A00.TC_Display_Results (Result2, F3A2A00.OK,
-                                   "SUBTEST #3: 2nd okay case");
- 
- 
-    end SUBTEST3;
- 
- 
- 
-    Report.Result;
- 
- end C3A2A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c410001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c410001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c410001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c410001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,303 ****
- -- C410001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that evaluating an access to subprogram variable containing
- --      the value null causes the exception Constraint_Error.
- --      Check that the default value for objects of access to subprogram
- --      types is null.
- --
- -- TEST DESCRIPTION:
- --      This test defines a few simple access_to_subprogram types, and
- --      objects of those types.  It checks that the default values for
- --      these objects is null, and that an attempt to make a subprogram
- --      call via one of this objects containing a null value causes the
- --      predefined exception Constraint_Error.  The check is performed
- ---     both with the default null value, and with an explicitly assigned
- --      null value, after the object has been used to successfully designate
- --      and call a subprogram.
- --
- --
- -- CHANGE HISTORY:
- --      05 APR 96   SAIC   Initial version
- --      04 NOV 96   SAIC   Revised for 2.1 release
- --      26 FEB 97   PWB.CTA Initialized variable before passing to function
- --!
- 
- ----------------------------------------------------------------- C410001_0
- 
- package C410001_0 is
- 
-   -- used to "switch state" in the software
-   Expect_Exception : Boolean;
- 
-   -- define a minimal mixture of access_to_subprogram types
- 
-   type Proc_Ref is access procedure;
- 
-   type Func_Ref is access function(I:Integer) return Integer;
- 
-   type Proc_Para_Ref is access procedure(P:Proc_Ref);
- 
-   type Func_Para_Ref is access function(F:Func_Ref) return Integer;
- 
-   type Prot_Proc_Ref is access protected procedure;
- 
-   type Prot_Func_Ref is access protected function return Boolean;
- 
-   -- define some subprograms for them to reference
- 
-   procedure Proc;
- 
-   function Func(I:Integer) return Integer;
- 
-   procedure Proc_Para( Param : Proc_Ref );
- 
-   function Func_Para( Param : Func_Ref ) return Integer;
- 
-   protected Prot_Obj is
-     procedure Prot_Proc;
-     function Prot_Func return Boolean;
-   end Prot_Obj;
- 
- end C410001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C410001_0 is
- 
-   -- Note that some failing cases will cause duplicate failure messages;
-   -- rather than have the procedure/function bodies be null, the error
-   -- checking code makes for a reasonable anti-optimization feature.
- 
-   procedure Proc is
-   begin
-     if Expect_Exception then
-       Report.Failed("Expected exception did not occur: Proc");
-     end if;
-   end Proc;
- 
-   function Func(I:Integer) return Integer is
-   begin
-     if Expect_Exception then
-       Report.Failed("Expected exception did not occur: Func");
-     end if;
-     return Report.Ident_Int(I);
-   end Func;
- 
-   procedure Proc_Para( Param : Proc_Ref ) is
-   begin
- 
-     Param.all;        -- call by explicit dereference
- 
-     if Expect_Exception then
-       Report.Failed("Expected exception did not occur: Proc_Para");
-     end if;
- 
-   exception
-     when Constraint_Error =>
-       if not Expect_Exception then
-         Report.Failed("Unexpected Constraint_Error: Proc_Para");
-       end if;  -- else null; expected the exception
-     when others => Report.Failed("Unexpected exception: Proc_Para");
-   end Proc_Para;
- 
-   function Func_Para( Param : Func_Ref ) return Integer is
-   begin
- 
-     return Param(1);  -- call by implicit dereference
- 
-     if Expect_Exception then
-       Report.Failed("Expected exception did not occur: Func_Para");
-     end if;
-     return 1;  -- really just to avoid warnings
- 
-   exception
-     when Constraint_Error =>
-       if not Expect_Exception then
-         Report.Failed("Unexpected Constraint_Error: Func_Para");
-         return 0;
-       else
-         return 1995;  -- any value other than this is unexpected
-       end if;
-     when others => Report.Failed("Unexpected exception: Func_Para");
-                    return -42;
-   end Func_Para;
- 
-   protected body Prot_Obj is
- 
-     procedure Prot_Proc is
-     begin
-       if Expect_Exception then
-         Report.Failed("Expected exception did not occur: Prot_Proc");
-       end if;
-     end Prot_Proc;
- 
-     function Prot_Func return Boolean is
-     begin
-       if Expect_Exception then
-         Report.Failed("Expected exception did not occur: Prot_Func");
-       end if;
-       return Report.Ident_Bool( True );
-     end Prot_Func;
- 
-   end Prot_Obj;
- 
- end C410001_0;
- 
- ------------------------------------------------------------------- C410001
- 
- with Report;
- with TCTouch;
- with C410001_0;
- procedure C410001 is
- 
-   Proc_Ref_Var : C410001_0.Proc_Ref;
- 
-   Func_Ref_Var : C410001_0.Func_Ref;
- 
-   Proc_Para_Ref_Var : C410001_0.Proc_Para_Ref;
- 
-   Func_Para_Ref_Var : C410001_0.Func_Para_Ref;
- 
-   type Enclosure is record
-     Prot_Proc_Ref_Var : C410001_0.Prot_Proc_Ref;
-     Prot_Func_Ref_Var : C410001_0.Prot_Func_Ref;
-   end record;
- 
-   Enclosed : Enclosure;
- 
-   Valid_Proc : C410001_0.Proc_Ref := C410001_0.Proc'Access;
- 
-   Valid_Func : C410001_0.Func_Ref := C410001_0.Func'Access;
- 
-   procedure Make_Calls( Expecting_Exceptions : Boolean ) is
-     type Case_Numbers is range 1..6;
-     Some_Integer : Integer := 0;
-   begin
-     for Cases in Case_Numbers loop
-       Catch_Exception : begin
-         case Cases is
-           when 1 => Proc_Ref_Var.all;
-           when 2 => Some_Integer := Func_Ref_Var.all( Some_Integer );
-           when 3 => Proc_Para_Ref_Var( Valid_Proc );
-           when 4 => Some_Integer := Func_Para_Ref_Var( Valid_Func );
-           when 5 => Enclosed.Prot_Proc_Ref_Var.all;
-           when 6 => TCTouch.Assert( Enclosed.Prot_Func_Ref_Var.all
-                                     /= Expecting_Exceptions,
-                                     "Case 6");
-         end case;
-         if Expecting_Exceptions then
-           Report.Failed("Exception expected: Case"
-                         & Case_Numbers'Image(Cases) );
-         end if;
-       exception
-         when Constraint_Error =>
-           if not Expecting_Exceptions then
-             Report.Failed("Constraint_Error not expected: Case"
-                           & Case_Numbers'Image(Cases) );
-           end if;
-         when others =>
-           Report.Failed("Wrong/Bad Exception: Case"
-                         & Case_Numbers'Image(Cases) );
-       end Catch_Exception;
-     end loop;
-   end Make_Calls;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C410001", "Check that evaluating an access to subprogram " &
-                           "variable containing the value null causes the " &
-                           "exception Constraint_Error. Check that the " &
-                           "default value for objects of access to " &
-                           "subprogram types is null" );
-    
-   -- check that the default values are null
-   declare
-     use C410001_0; -- make all "="'s visible for all types
-   begin
-     TCTouch.Assert( Proc_Ref_Var = null, "Proc_Ref_Var = null" );
- 
-     TCTouch.Assert( Func_Ref_Var = null, "Func_Ref_Var = null" );
- 
-     TCTouch.Assert( Proc_Para_Ref_Var = null, "Proc_Para_Ref_Var = null" );
- 
-     TCTouch.Assert( Func_Para_Ref_Var = null, "Func_Para_Ref_Var = null" );
- 
-     TCTouch.Assert( Enclosed.Prot_Proc_Ref_Var = null,
-                    "Enclosed.Prot_Proc_Ref_Var = null" );
- 
-     TCTouch.Assert( Enclosed.Prot_Func_Ref_Var = null,
-                    "Enclosed.Prot_Func_Ref_Var = null" );
-   end;
- 
-   -- check that calls via the default values cause Constraint_Error
- 
-   C410001_0.Expect_Exception := True;
- 
-   Make_Calls( Expecting_Exceptions => True );
- 
-   -- assign non-null values to the objects
- 
-   Proc_Ref_Var      := C410001_0.Proc'Access;
-   Func_Ref_Var      := C410001_0.Func'Access;
-   Proc_Para_Ref_Var := C410001_0.Proc_Para'Access;
-   Func_Para_Ref_Var := C410001_0.Func_Para'Access;
-   Enclosed          := (C410001_0.Prot_Obj.Prot_Proc'Access,
-                         C410001_0.Prot_Obj.Prot_Func'Access);
- 
-   -- check that the calls perform normally
- 
-   C410001_0.Expect_Exception := False;
- 
-   Make_Calls( Expecting_Exceptions => False );
- 
-   -- check that a passed null value causes Constraint_Error
- 
-   C410001_0.Expect_Exception := True;
- 
-   Proc_Para_Ref_Var( null );
- 
-   TCTouch.Assert( Func_Para_Ref_Var( null ) = 1995,
-                  "Func_Para_Ref_Var( null )");
- 
-   -- assign the null value to the objects
- 
-   Proc_Ref_Var      := null;
-   Func_Ref_Var      := null;
-   Proc_Para_Ref_Var := null;
-   Func_Para_Ref_Var := null;
-   Enclosed          := (null,null);
- 
-   -- check that calls now again cause Constraint_Error
- 
-   C410001_0.Expect_Exception := True;
- 
-   Make_Calls( Expecting_Exceptions => True );
- 
-   Report.Result;
- 
- end C410001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41101d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41101d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41101d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41101d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C41101D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR INDEXED COMPONENTS OF THE FORM F(...), CHECK THAT 
- --   THE NUMBER OF INDEX VALUES, THE TYPE OF THE INDEX
- --   VALUES, AND THE REQUIRED TYPE OF THE INDEXED COMPONENT
- --   ARE USED TO RESOLVE AN OVERLOADING OF F.
- 
- -- WKB 8/12/81
- -- JBG 10/12/81
- -- SPS 11/1/82
- 
- WITH REPORT;
- PROCEDURE C41101D IS
- 
-      USE REPORT;
- 
-      TYPE T1 IS ARRAY (1..10) OF INTEGER;
-      TYPE T2 IS ARRAY (1..10, 1..10) OF INTEGER;
-      I : INTEGER;
- 
-      TYPE U1 IS (MON,TUE,WED,THU,FRI);
-      TYPE U2 IS ARRAY (U1 RANGE MON..THU) OF INTEGER;
- 
-      TYPE V1 IS ARRAY (1..10) OF BOOLEAN;
-      B : BOOLEAN;
- 
-      FUNCTION F RETURN T1 IS
-      BEGIN
-           RETURN (1..10 => 1);
-      END F;
- 
-      FUNCTION F RETURN T2 IS
-      BEGIN
-           RETURN (1..10 => (1..10 => 2));
-      END F;
- 
-      FUNCTION G RETURN U2 IS
-      BEGIN
-           RETURN (MON..THU => 3);
-      END G;
- 
-      FUNCTION G RETURN T1 IS
-      BEGIN
-           RETURN (1..10 => 4);
-      END G;
- 
-      FUNCTION H RETURN T1 IS
-      BEGIN
-           RETURN (1..10 => 5);
-      END H;
- 
-      FUNCTION H RETURN V1 IS
-      BEGIN
-           RETURN (1..10 => FALSE);
-      END H;
- 
- BEGIN
- 
-      TEST ("C41101D", "WHEN INDEXING FUNCTION RESULTS, INDEX TYPE, " &
-                       "NUMBER OF INDICES, AND COMPONENT TYPE ARE " &
-                       "USED FOR OVERLOADING RESOLUTION");
- 
-      I := F(7);              -- NUMBER OF INDEX VALUES.
-      IF I /= IDENT_INT(1) THEN
-           FAILED ("WRONG VALUE - 1");
-      END IF;
- 
-      I := G(3);              -- INDEX TYPE.
-      IF I /= IDENT_INT(4) THEN
-           FAILED ("WRONG VALUE - 2");
-      END IF;
- 
-      B := H(5);              -- COMPONENT TYPE.
-      IF B /= IDENT_BOOL(FALSE) THEN
-           FAILED ("WRONG VALUE - 3");
-      END IF;
- 
-      RESULT;
- 
- END C41101D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41103a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41103a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41103a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,239 ****
- -- C41103A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NAME IN AN INDEXED_COMPONENT MAY BE:
- --   AN IDENTIFIER DENOTING AN ARRAY OBJECT - N1;
- --   AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
- --        DESIGNATES AN ARRAY OBJECT - N2;
- --   A FUNCTION CALL DELIVERING AN ARRAY OBJECT USING
- --        A PREDEFINED FUNCTION - &,
- --        A USER-DEFINED FUNCTION - F1;
- --   A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
- --        DESIGNATES AN ARRAY - F2;
- --   A SLICE (CHECKING UPPER AND LOWER BOUND COMPONENTS) - N3;
- --   AN INDEXED COMPONENT DENOTING AN ARRAY OBJECT
- --        (ARRAY OF ARRAYS) - N4;
- --   AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
- --        ENCLOSING ITS DECLARATION - C41103A.N1;
- --   A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
- --        ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
- -- CHECK THAT THE APPROPRIATE COMPONENT IS ACCESSED (FOR
- --   STATIC INDICES).
- 
- -- WKB 7/27/81
- -- JRK 7/28/81
- -- SPS 10/26/82
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41103A IS
- 
-      TYPE A1 IS ARRAY (INTEGER RANGE 1..4) OF INTEGER;
-      N1 : A1 := (1,2,3,4);
- 
- BEGIN
-      TEST ("C41103A", "CHECK THAT AN INDEXED_COMPONENT MAY BE OF " &
-                       "CERTAIN FORMS AND THAT THE APPROPRIATE " &
-                       "COMPONENT IS ACCESSED (FOR STATIC INDICES)");
- 
-      DECLARE
- 
-           TYPE A2 IS ARRAY (INTEGER RANGE 1..4) OF BOOLEAN;
-           TYPE A3 IS ACCESS A1;
-           TYPE A4 IS ARRAY (INTEGER RANGE 1..4) OF A1;
-           TYPE R (LENGTH : INTEGER) IS 
-                RECORD
-                     S : STRING (1..LENGTH);
-                END RECORD;
- 
-           N2 : A3 := NEW A1' (1,2,3,4);
-           N3 : ARRAY (1..7) OF INTEGER := (1,2,3,4,5,6,7);
-           N4 : A4 := (1 => (1,2,3,4), 2 => (5,6,7,8),
-                       3 => (9,10,11,12), 4 => (13,14,15,16));
-           N5 : R(4) := (LENGTH => 4, S => "ABCD");
- 
-           FUNCTION F1 RETURN A2 IS
-           BEGIN
-                RETURN (FALSE,FALSE,TRUE,FALSE);
-           END F1;
- 
-           FUNCTION F2 RETURN A3 IS
-           BEGIN
-                RETURN N2;
-           END F2;
- 
-           PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
-                         Z : OUT INTEGER; W : IN STRING) IS
-           BEGIN
-                IF X /= 2 THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
-                END IF;
-                IF Y /= 3 THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
-                END IF;
-                Y := 8;
-                Z := 9;
-           END P1;
- 
-           PROCEDURE P2 (X : CHARACTER) IS
-           BEGIN
-                IF X /= 'C' THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
-                END IF;
-           END P2;
- 
-           PROCEDURE P3 (X : BOOLEAN) IS
-           BEGIN
-                IF X /= TRUE THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
-                END IF;
-           END P3;
- 
-           PROCEDURE P5 (X : IN CHARACTER; Y : IN OUT CHARACTER;
-                         Z : OUT CHARACTER) IS
-           BEGIN 
-                IF X /= 'A' THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
-                END IF;
-                IF Y /= 'D' THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
-                END IF;
-                Y := 'Y';
-                Z := 'Z';
-           END P5;
- 
-      BEGIN
- 
-           IF N1(2) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
-           END IF;
-           N1(2) := 7;
-           IF N1 /= (1,7,3,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
-           END IF;
-           N1 := (1,2,3,4);
-           P1 (N1(2), N1(3), N1(1), "N1");
-           IF N1 /= (9,2,8,4) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
-           END IF;
- 
-           IF N2(3) /= 3 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
-           END IF;
-           N2(3) := 7;
-           IF N2.ALL /= (1,2,7,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
-           END IF;
-           N2.ALL := (2,1,4,3);
-           P1 (N2(1), N2(4), N2(2), "N2");
-           IF N2.ALL /= (2,9,4,8) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
-           END IF;
- 
-           IF "&" (STRING'("AB"), STRING'("CDEF"))(5) /= CHARACTER'('E') THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
-           END IF;
-           P2 ("&" ("AB", "CD")(3));
- 
-           IF F1(3) /= TRUE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
-           END IF;
-           P3 (F1(3));
- 
-           N2 := NEW A1' (1,2,3,4);
-           IF F2(2) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
-           END IF;
-           F2(3) := 7;
-           IF N2.ALL /= (1,2,7,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
-           END IF;
-           N2.ALL := (1,2,3,4);
-           P1 (F2(2), F2(3), F2(1), "F2");
-           IF N2.ALL /= (9,2,8,4) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
-           END IF;
- 
-           IF N3(2..5)(5) /= 5 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N3");
-           END IF;
-           N3(2..5)(2) := 8;
-           IF N3 /= (1,8,3,4,5,6,7) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
-           END IF;
-           N3 := (5,3,4,2,1,6,7);
-           P1 (N3(2..5)(4), N3(2..5)(2), N3(2..5)(5), "N3");
-           IF N3 /= (5,8,4,2,9,6,7) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
-           END IF;
- 
-           IF N4(1)(2) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
-           END IF;
-           N4(3)(1) := 20;
-           IF N4 /= ((1,2,3,4),(5,6,7,8),(20,10,11,12),
-                     (13,14,15,16)) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
-           END IF;
-           N4 := (1 => (0,6,4,2), 2 => (10,11,12,13),
-                  3 => (14,15,16,17), 4 => (7,5,3,1));
-           P1 (N4(1)(4), N4(4)(3), N4(2)(1), "N4");
-           IF N4 /= ((0,6,4,2),(9,11,12,13),(14,15,16,17),
-                     (7,5,8,1)) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
-           END IF;
- 
-           N1 := (1,2,3,4);
-           IF C41103A.N1(2) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - C41103A.N1");
-           END IF;
-           C41103A.N1(2) := 7;
-           IF N1 /= (1,7,3,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41103A.N1");
-           END IF;
-           N1 := (1,2,3,4);
-           P1 (C41103A.N1(2), C41103A.N1(3), C41103A.N1(1),
-               "C41103A.N1");
-           IF N1 /= (9,2,8,4) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
-                       "- C41103A.N1");
-           END IF;
- 
-           IF N5.S(3) /= 'C' THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
-           END IF;
-           N5.S(4) := 'X';
-           IF N5.S /= "ABCX" THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
-           END IF;
-           N5.S := "ABCD";
-           P5 (N5.S(1), N5.S(4), N5.S(2));
-           IF N5.S /= "AZCY" THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
-           END IF;
-      END;
- 
-      RESULT;
- END C41103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41103b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41103b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41103b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,366 ****
- -- C41103B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NAME IN AN INDEXED_COMPONENT MAY BE:
- --        AN IDENTIFIER DENOTING AN ARRAY OBJECT - N1;
- --        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
- --           DESIGNATES AN ARRAY OBJECT - N2;
- --        A FUNCTION CALL DELIVERING AN ARRAY OBJECT USING
- --           PREDEFINED FUNCTIONS - &, AND THE LOGICAL OPERATORS
- --        A USER-DEFINED FUNCTION - F1;
- --        A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
- --           DESIGNATES AN ARRAY - F2;
- --        A SLICE (CHECKING UPPER AND LOWER BOUND COMPONENTS) - N3;
- --        AN INDEXED COMPONENT DENOTING AN ARRAY OBJECT
- --           (ARRAY OF ARRAYS) - N4;
- --        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
- --           ENCLOSING ITS DECLARATION - C41103B.N1;
- --        A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
- --           ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
- --     CHECK THAT THE APPROPRIATE COMPONENT IS ACCESSED (FOR
- --     DYNAMIC INDICES).
- 
- -- HISTORY:
- --     WKB 08/05/81  CREATED ORIGINAL TEST.
- --     SPS 10/26/82
- --     BCB 08/02/88  MODIFIED HEADER FORMAT AND ADDED CALLS TO THE
- --                   LOGICAL OPERATORS.
- --     BCB 04/16/90  MODIFIED SLICE TEST TO INCLUDE A READING OF THE
- --                   COMPONENT DESIGNATED BY THE LOWER BOUND OF THE
- --                   SLICE.  ADDED TEST FOR PREFIX OF INDEXED COMPONENT
- --                   HAVING A LIMITED TYPE.
- --     PWN 11/30/94  SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41103B IS
- 
-      TYPE A1 IS ARRAY (INTEGER RANGE 1..4) OF INTEGER;
-      N1 : A1 := (1,2,3,4);
- 
- BEGIN
-      TEST ("C41103B", "CHECK THAT AN INDEXED_COMPONENT MAY BE OF " &
-                       "CERTAIN FORMS AND THAT THE APPROPRIATE " &
-                       "COMPONENT IS ACCESSED (FOR DYNAMIC INDICES)");
- 
-      DECLARE
- 
-           TYPE A2 IS ARRAY (INTEGER RANGE 1..4) OF BOOLEAN;
-           TYPE A3 IS ACCESS A1;
-           TYPE A4 IS ARRAY (INTEGER RANGE 1..4) OF A1;
-           TYPE R (LENGTH : INTEGER) IS
-                RECORD
-                     S : STRING (1..LENGTH);
-                END RECORD;
- 
-           N2 : A3 := NEW A1' (1,2,3,4);
-           N3 : ARRAY (1..7) OF INTEGER := (1,2,3,4,5,6,7);
-           N4 : A4 := (1 => (1,2,3,4), 2 => (5,6,7,8),
-                       3 => (9,10,11,12), 4 => (13,14,15,16));
-           N5 : R(4) := (LENGTH => 4, S => "ABCD");
- 
-           M2A : A2 := (TRUE,FALSE,TRUE,FALSE);
-           M2B : A2 := (TRUE,TRUE,FALSE,FALSE);
- 
-           FUNCTION F1 RETURN A2 IS
-           BEGIN
-                RETURN (FALSE,FALSE,TRUE,FALSE);
-           END F1;
- 
-           FUNCTION F2 RETURN A3 IS
-           BEGIN
-                RETURN N2;
-           END F2;
- 
-           PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
-                         Z : OUT INTEGER; W : IN STRING) IS
-           BEGIN
-                IF X /= 2 THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
-                END IF;
-                IF Y /= 3 THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
-                END IF;
-                Y := 8;
-                Z := 9;
-           END P1;
- 
-           PROCEDURE P2 (X : CHARACTER) IS
-           BEGIN
-                IF X /= 'C' THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
-                END IF;
-           END P2;
- 
-           PROCEDURE P3 (X : BOOLEAN) IS
-           BEGIN
-                IF X /= TRUE THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
-                END IF;
-           END P3;
- 
-           PROCEDURE P5 (X : IN CHARACTER; Y : IN OUT CHARACTER;
-                         Z : OUT CHARACTER) IS
-           BEGIN
-                IF X /= 'A' THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
-                END IF;
-                IF Y /= 'D' THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
-                END IF;
-                Y := 'Y';
-                Z := 'Z';
-           END P5;
- 
-           PROCEDURE P6 (X : BOOLEAN) IS
-           BEGIN
-                IF X /= TRUE THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - NOT");
-                END IF;
-           END P6;
- 
-           PROCEDURE P7 (X : BOOLEAN) IS
-           BEGIN
-                IF X /= TRUE THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - AND");
-                END IF;
-           END P7;
- 
-           PROCEDURE P8 (X : BOOLEAN) IS
-           BEGIN
-                IF X /= TRUE THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - OR");
-                END IF;
-           END P8;
- 
-           PROCEDURE P9 (X : BOOLEAN) IS
-           BEGIN
-                IF X /= TRUE THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - XOR");
-                END IF;
-           END P9;
- 
-      BEGIN
- 
-           IF N1(IDENT_INT(2)) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
-           END IF;
-           N1(IDENT_INT(2)) := 7;
-           IF N1 /= (1,7,3,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
-           END IF;
-           N1 := (1,2,3,4);
-           P1 (N1(IDENT_INT(2)), N1(IDENT_INT(3)),
-               N1(IDENT_INT(1)), "N1");
-           IF N1 /= (9,2,8,4) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
-           END IF;
- 
-           IF N2(IDENT_INT(3)) /= 3 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
-           END IF;
-           N2(IDENT_INT(3)) := 7;
-           IF N2.ALL /= (1,2,7,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
-           END IF;
-           N2.ALL := (2,1,4,3);
-           P1 (N2(IDENT_INT(1)), N2(IDENT_INT(4)),
-               N2(IDENT_INT(2)), "N2");
-           IF N2.ALL /= (2,9,4,8) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
-           END IF;
- 
-           IF "&" (STRING'("AB"), STRING'("CDEF"))(IDENT_INT(5)) 
-              /= CHARACTER'('E') THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
-           END IF;
-           P2 ("&" ("AB", "CD")(IDENT_INT(3)));
- 
-           IF "NOT" (M2A)(IDENT_INT(4)) /= TRUE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'NOT'");
-           END IF;
-           P6 ("NOT" (M2A)(IDENT_INT(4)));
- 
-           IF "AND" (M2A,M2B)(IDENT_INT(3)) /= FALSE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'AND'");
-           END IF;
-           P7 ("AND" (M2A,M2B)(IDENT_INT(1)));
- 
-           IF "OR" (M2A,M2B)(IDENT_INT(3)) /= TRUE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'OR'");
-           END IF;
-           P8 ("OR" (M2A,M2B)(IDENT_INT(3)));
- 
-           IF "XOR" (M2A,M2B)(IDENT_INT(1)) /= FALSE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'XOR'");
-           END IF;
-           P9 ("XOR" (M2A,M2B)(IDENT_INT(3)));
- 
-           IF F1(IDENT_INT(3)) /= TRUE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
-           END IF;
-           P3 (F1(IDENT_INT(3)));
- 
-           N2 := NEW A1'(1,2,3,4);
-           IF F2(IDENT_INT(2)) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
-           END IF;
-           F2(IDENT_INT(3)) := 7;
-           IF N2.ALL /= (1,2,7,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
-           END IF;
-           N2.ALL := (1,2,3,4);
-           P1 (F2(IDENT_INT(2)), F2(IDENT_INT(3)),
-               F2(IDENT_INT(1)), "F2");
-           IF N2.ALL /= (9,2,8,4) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
-           END IF;
- 
-           IF N3(2..5)(IDENT_INT(2)) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION (LOWER BOUND) - N3");
-           END IF;
-           IF N3(2..5)(IDENT_INT(5)) /= 5 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION (UPPER BOUND) - N3");
-           END IF;
-           N3(2..5)(IDENT_INT(2)) := 8;
-           IF N3 /= (1,8,3,4,5,6,7) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
-           END IF;
-           N3 := (5,3,4,2,1,6,7);
-           P1 (N3(2..5)(IDENT_INT(4)), N3(2..5)(IDENT_INT(2)),
-               N3(2..5)(IDENT_INT(5)), "N3");
-           IF N3 /= (5,8,4,2,9,6,7) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
-           END IF;
- 
-           IF N4(1)(IDENT_INT(2)) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
-           END IF;
-           N4(3)(IDENT_INT(1)) := 20;
-           IF N4 /= ((1,2,3,4),(5,6,7,8),(20,10,11,12),
-                     (13,14,15,16)) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
-           END IF;
-           N4 := (1 => (0,6,4,2), 2 => (10,11,12,13),
-                  3 => (14,15,16,17), 4 => (7,5,3,1));
-           P1 (N4(1)(IDENT_INT(4)), N4(4)(IDENT_INT(3)),
-               N4(2)(IDENT_INT(1)), "N4");
-           IF N4 /= ((0,6,4,2),(9,11,12,13),(14,15,16,17),
-                     (7,5,8,1)) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
-           END IF;
- 
-           N1 := (1,2,3,4);
-           IF C41103B.N1(IDENT_INT(2)) /= 2 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - C41103B.N1");
-           END IF;
-           C41103B.N1(IDENT_INT(2)) := 7;
-           IF N1 /= (1,7,3,4) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41103B.N1");
-           END IF;
-           N1 := (1,2,3,4);
-           P1 (C41103B.N1(IDENT_INT(2)), C41103B.N1(IDENT_INT(3)),
-               C41103B.N1(IDENT_INT(1)), "C41103B.N1");
-           IF N1 /= (9,2,8,4) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
-                        "- C41103B.N1");
-           END IF;
- 
-           IF N5.S(IDENT_INT(3)) /= 'C' THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
-           END IF;
-           N5.S(IDENT_INT(4)) := 'X';
-           IF N5.S /= "ABCX" THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
-           END IF;
-           N5.S := "ABCD";
-           P5 (N5.S(IDENT_INT(1)), N5.S(IDENT_INT(4)),
-               N5.S(IDENT_INT(2)));
-           IF N5.S /= "AZCY" THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
-           END IF;
- 
-           DECLARE
-                PACKAGE P IS
-                     TYPE LIM IS LIMITED PRIVATE;
-                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER);
-                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM);
-                     FUNCTION "=" (ONE,TWO : LIM) RETURN BOOLEAN;
-                PRIVATE
-                     TYPE LIM IS ARRAY(1..3) OF INTEGER;
-                END P;
- 
-                USE P;
- 
-                TYPE A IS ARRAY(1..3) OF LIM;
- 
-                H : A;
- 
-                N6 : LIM;
- 
-                PACKAGE BODY P IS
-                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER) IS
-                     BEGIN
-                          V := (X,Y,Z);
-                     END INIT;
- 
-                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM) IS
-                     BEGIN
-                          ONE := TWO;
-                     END ASSIGN;
- 
-                     FUNCTION "=" (ONE,TWO : LIM) RETURN BOOLEAN IS
-                     BEGIN
-                          IF ONE(1) = TWO(1) AND ONE(2) = TWO(2) AND
-                            ONE(3) = TWO(3) THEN
-                               RETURN TRUE;
-                          ELSE
-                               RETURN FALSE;
-                          END IF;
-                     END "=";
-                END P;
- 
-                FUNCTION FR RETURN A IS
-                BEGIN
-                     RETURN H;
-                END FR;
- 
-           BEGIN
-                INIT (H(1),1,2,3);
-                INIT (H(2),4,5,6);
-                INIT (H(3),7,8,9);
-                INIT (N6,0,0,0);
- 
-                ASSIGN (N6,FR(2));
- 
-                IF N6 /= FR(2) THEN
-                     FAILED ("WRONG VALUE FROM LIMITED COMPONENT TYPE");
-                END IF;
- 
-           END;
-      END;
- 
-      RESULT;
- END C41103B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41104a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,240 ****
- -- C41104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN EXPRESSION GIVES AN INDEX
- -- VALUE OUTSIDE THE RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND ACCESS
- -- TYPES.
- 
- -- TBN  9/12/86
- -- EDS  8/03/98  AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41104A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 5;
-      SUBTYPE BOOL IS BOOLEAN RANGE TRUE .. TRUE;
-      SUBTYPE CHAR IS CHARACTER RANGE 'W' .. 'Z';
-      TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
-      TYPE ARRAY2 IS ARRAY (3 .. 1) OF INTEGER;
-      TYPE ARRAY3 IS ARRAY (BOOL RANGE <>) OF INTEGER;
-      TYPE ARRAY4 IS ARRAY (CHAR RANGE <>) OF INTEGER;
- 
-      TYPE REC (D : INT) IS
-           RECORD
-                A : ARRAY1 (1 .. D);
-           END RECORD;
- 
-      TYPE B_REC (D : BOOL) IS
-           RECORD
-                A : ARRAY3 (TRUE .. D);
-           END RECORD;
- 
-      TYPE NULL_REC (D : INT) IS
-           RECORD
-                A : ARRAY1 (D .. 1);
-           END RECORD;
- 
-      TYPE NULL_CREC (D : CHAR) IS
-           RECORD
-                A : ARRAY4 (D .. 'W');
-           END RECORD;
- 
- BEGIN
-      TEST ("C41104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN " &
-                       "EXPRESSION GIVES AN INDEX VALUE OUTSIDE THE " &
-                       "RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND " &
-                       "ACCESS TYPES");
- 
-      DECLARE
-           ARA1 : ARRAY1 (1 .. 5) := (1, 2, 3, 4, 5);
-      BEGIN
-           ARA1 (IDENT_INT(0)) := 1;
- 
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
-                         INTEGER'IMAGE(ARA1 (1)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 1");
-      END;
- ------------------------------------------------------------------------
-      DECLARE
-           TYPE ACC_ARRAY IS ACCESS ARRAY3 (TRUE .. TRUE);
-           ACC_ARA : ACC_ARRAY := NEW ARRAY3'(TRUE => 2);
-      BEGIN
-           ACC_ARA (IDENT_BOOL(FALSE)) := 2;
- 
-           BEGIN
- 
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
-                         INTEGER'IMAGE(ACC_ARA (TRUE)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 2");
-      END;
- ------------------------------------------------------------------------
-      DECLARE
-           ARA2 : ARRAY4 ('Z' .. 'Y');
-      BEGIN
-           ARA2 (IDENT_CHAR('Y')) := 3;
- 
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
- 
-           BEGIN
-                COMMENT ("ARA2 (Y) IS " & INTEGER'IMAGE(ARA2 ('Y')));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 3");
-      END;
- ------------------------------------------------------------------------
-      DECLARE
-           TYPE ACC_ARRAY IS ACCESS ARRAY2;
-           ACC_ARA : ACC_ARRAY := NEW ARRAY2;
-      BEGIN
-           ACC_ARA (IDENT_INT(4)) := 4;
- 
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
- 
-           BEGIN
-                COMMENT ("ACC_ARA (4) IS " & INTEGER'IMAGE(ACC_ARA (4)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 4");
-      END;
- ------------------------------------------------------------------------
-      DECLARE
-           REC1 : B_REC (TRUE) := (TRUE, A => (TRUE => 5));
-      BEGIN
-           REC1.A (IDENT_BOOL (FALSE)) := 1;
- 
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
-                        INTEGER'IMAGE(REC1.A (TRUE)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 5");
-      END;
- ------------------------------------------------------------------------
-      DECLARE
-           TYPE ACC_REC IS ACCESS REC (3);
-           ACC_REC1 : ACC_REC := NEW REC'(3, (4, 5, 6));
-      BEGIN
-           ACC_REC1.A (IDENT_INT(4)) := 4;
- 
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
-                         INTEGER'IMAGE(ACC_REC1.A (3)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 6");
-      END;
- ------------------------------------------------------------------------
-      DECLARE
-           REC1 : NULL_REC (2);
-      BEGIN
-           REC1.A (IDENT_INT(2)) := 1;
- 
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
- 
-           BEGIN
-                COMMENT ("REC1.A (2) IS " & INTEGER'IMAGE(REC1.A (2)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 7");
-      END;
- ------------------------------------------------------------------------
-      DECLARE
-           TYPE ACC_REC IS ACCESS NULL_CREC ('Z');
-           ACC_REC1 : ACC_REC := NEW NULL_CREC ('Z');
-      BEGIN
-           ACC_REC1.A (IDENT_CHAR('A')) := 4;
- 
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
-           BEGIN
-                COMMENT ("ACC_REC1.A (A) IS " &
-                          INTEGER'IMAGE(ACC_REC1.A ('A')));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 8");
-      END;
- ------------------------------------------------------------------------
- 
-      RESULT;
- END C41104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41105a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41105a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41105a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C41105A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE NAME PART OF AN
- --     INDEXED COMPONENT DENOTES AN ACCESS OBJECT WHOSE VALUE IS NULL,
- --     AND ALSO IF THE NAME IS A FUNCTION CALL DELIVERING NULL.
- 
- -- HISTORY:
- --     WKB 07/29/81  CREATED ORIGINAL TEST.
- --     SPS 10/26/82
- --     JET 01/05/88  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
- --                   OPTIMIZATION.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41105A IS
- 
- BEGIN
-      TEST ("C41105A", "CONSTRAINT_ERROR FROM NAMES DENOTING A NULL " &
-                       "ACCESS OBJECT AND A FUNCTION CALL DELIVERING " &
-                       "NULL");
- 
-      DECLARE
- 
-           TYPE T1 IS ARRAY (1..2) OF INTEGER;
-           TYPE A1 IS ACCESS T1;
-           B : A1 := NEW T1' (1,2);
-           I : INTEGER;
- 
-      BEGIN
- 
-           IF EQUAL (3,3) THEN
-                B := NULL;
-           END IF;
- 
-           I := B(1);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
- 
-           IF EQUAL (I,I) THEN
-                COMMENT ("NO EXCEPTION RAISED");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
- 
-      END;
- 
- 
-      DECLARE
- 
-           TYPE T2 IS ARRAY (1..2) OF INTEGER;
-           TYPE A2 IS ACCESS T2;
-           I : INTEGER;
- 
-           FUNCTION F RETURN A2 IS
-           BEGIN
-                IF EQUAL (3,3) THEN
-                     RETURN NULL;
-                END IF;
-                RETURN NEW T2' (1,2);
-           END F;
- 
-      BEGIN
- 
-           I := F(1);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
- 
-           IF EQUAL (I,I) THEN
-                COMMENT ("NO EXCEPTION RAISED");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
- 
-      END;
- 
-      RESULT;
- END C41105A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41107a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41107a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41107a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C41107A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR AN ARRAY HAVING BOTH POSITIVE AND NEGATIVE
- --   INDEX VALUES, THE PROPER COMPONENT IS SELECTED - A.
- -- CHECK THAT FOR AN ARRAY INDEXED WITH AN ENUMERATION TYPE,
- --   APPROPRIATE COMPONENTS CAN BE SELECTED - B.
- -- CHECK THAT SUBSCRIPT EXPRESSIONS CAN BE OF COMPLEXITY GREATER
- --   THAN VARIABLE + - CONSTANT - C.
- -- CHECK THAT MULTIPLY DIMENSIONED ARRAYS ARE PROPERLY INDEXED - D.
- 
- -- WKB 7/29/81
- -- JBG 8/21/83
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41107A IS
- 
-      TYPE T1 IS ARRAY (INTEGER RANGE -2..2) OF INTEGER;
-      A : T1 := (1,2,3,4,5);
- 
-      TYPE COLOR IS (RED,ORANGE,YELLOW,GREEN,BLUE);
-      TYPE T2 IS ARRAY (COLOR RANGE RED..BLUE) OF INTEGER;
-      B : T2 := (5,4,3,2,1);
- 
-      C : STRING (1..7) := "ABCDEFG";
- 
-      TYPE T4 IS ARRAY (1..4,1..3) OF INTEGER;
-      D : T4 := (1 => (1,2,3), 2 => (4,5,6), 3 => (7,8,9),
-                 4 => (0,-1,-2));
- 
-      V1 : INTEGER := IDENT_INT (1);
-      V2 : INTEGER := IDENT_INT (2);
-      V3 : INTEGER := IDENT_INT (3);
- 
-      PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
-                    Z : OUT INTEGER; W : STRING) IS
-      BEGIN
-           IF X /= 1 THEN
-                FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
-           END IF;
-           IF Y /= 4 THEN
-                FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
-           END IF;
-           Y := 11;
-           Z := 12;
-      END P1;
- 
-      PROCEDURE P2 (X : IN CHARACTER; Y : IN OUT CHARACTER;
-                    Z : OUT CHARACTER) IS
-      BEGIN
-           IF X /= 'D' THEN
-                FAILED ("WRONG VALUE FOR IN PARAMETER - C");
-           END IF;
-           IF Y /= 'F' THEN
-                FAILED ("WRONG VALUE FOR IN OUT PARAMETER - C");
-           END IF;
-           Y := 'Y';
-           Z := 'Z';
-      END P2;
- 
- BEGIN
-      TEST ("C41107A", "CHECK THAT THE PROPER COMPONENT IS SELECTED " &
-                       "FOR ARRAYS WITH POS AND NEG INDICES, " &  
-                       "ENUMERATION INDICES, COMPLEX SUBSCRIPT " &
-                       "EXPRESSIONS, AND MULTIPLE DIMENSIONS");
- 
-      IF A(IDENT_INT(1)) /= 4 THEN 
-           FAILED ("WRONG VALUE FOR EXPRESSION - A");
-      END IF;
-      A(IDENT_INT(-2)) := 10;
-      IF A /= (10,2,3,4,5) THEN
-           FAILED ("WRONG TARGET FOR ASSIGNMENT - A");
-      END IF;
-      A := (2,1,0,3,4);
-      P1 (A(-1), A(2), A(-2), "A");
-      IF A /= (12,1,0,3,11) THEN
-           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - A");
-      END IF;
- 
-      IF B(GREEN) /= 2 THEN
-           FAILED ("WRONG VALUE FOR EXPRESSION - B");
-      END IF;
-      B(YELLOW) := 10;
-      IF B /= (5,4,10,2,1) THEN
-           FAILED ("WRONG TARGET FOR ASSIGNMENT - B");
-      END IF;
-      B := (1,4,2,3,5);
-      P1 (B(RED), B(ORANGE), B(BLUE), "B");
-      IF B /= (1,11,2,3,12) THEN
-           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - B");
-      END IF;
- 
-      IF C(3..6)(3**2 / 3 * (2-1) - 6 / 3 + 2) /= 'C' THEN
-           FAILED ("WRONG VALUE FOR EXPRESSION - C");
-      END IF;
-      C(3..6)(V3**2 / V1 * (V3-V2) + IDENT_INT(4) - V3 * V2 - V1) := 'W';
-      IF C /= "ABCDEWG" THEN
-           FAILED ("WRONG TARGET FOR ASSIGNMENT - C");
-      END IF;
-      C := "ABCDEFG";
-      P2 (C(3..6)(V3+V1), C(3..6)(V3*V2), C(3..6)((V1+V2)*V1));
-      IF C /= "ABZDEYG" THEN
-           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - C");
-      END IF;
- 
-      IF D(IDENT_INT(1),IDENT_INT(3)) /= 3 THEN
-           FAILED ("WRONG VALUE FOR EXPRESSION - D");
-      END IF;
-      D(IDENT_INT(4),IDENT_INT(2)) := 10;
-      IF D /= ((1,2,3),(4,5,6),(7,8,9),(0,10,-2)) THEN
-           FAILED ("WRONG TARGET FOR ASSIGNMENT - D");
-      END IF;
-      D := (1 => (0,2,3), 2 => (4,5,6), 3 => (7,8,9), 4 => (1,-1,-2));
-      P1 (D(4,1), D(2,1), D(3,2), "D");
-      IF D /= ((0,2,3),(11,5,6),(7,12,9),(1,-1,-2)) THEN
-           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - D");
-      END IF;
- 
-      RESULT;
- END C41107A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41201d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41201d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41201d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41201d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C41201D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR SLICED COMPONENTS OF THE FORM F(...), CHECK THAT 
- --   THE REQUIREMENT FOR A ONE-DIMENSIONAL ARRAY AND THE
- --   TYPE OF THE INDEX ARE USED TO RESOLVE AN OVERLOADING OF F.
- 
- -- WKB 8/11/81
- -- JBG 10/12/81
- -- SPS 11/1/82
- 
- WITH REPORT;
- PROCEDURE C41201D IS
- 
-      USE REPORT;
- 
-      TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      SUBTYPE T1 IS T(1..10);
-      TYPE T2 IS ARRAY (1..10, 1..10) OF INTEGER;
-      TT : T(1..3);
- 
-      SUBTYPE U1 IS T(1..10);
-      TYPE U2 IS (MON,TUE,WED,THU,FRI);
-      SUBTYPE SU2 IS U2 RANGE MON .. THU;
-      TYPE U3 IS ARRAY (SU2) OF INTEGER;
-      UU : T(1..3);
- 
-      TYPE V IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
-      SUBTYPE V1 IS V(1..10);
-      SUBTYPE V2 IS T(1..10);
-      VV : V(2..5);
- 
-      FUNCTION F RETURN T1 IS
-      BEGIN
-           RETURN (1,1,1,1,5,6,7,8,9,10);
-      END F;
- 
-      FUNCTION F RETURN T2 IS
-      BEGIN
-           RETURN (1..10 => (1,2,3,4,5,6,7,8,9,10));
-      END F;
- 
-      FUNCTION G RETURN U1 IS
-      BEGIN
-           RETURN (3,3,3,3,5,6,7,8,9,10);
-      END G;
- 
-      FUNCTION G RETURN U3 IS
-      BEGIN
-           RETURN (0,1,2,3);
-      END G;
- 
-      FUNCTION H RETURN V1 IS
-      BEGIN
-           RETURN (1|3..10 => FALSE, 2 => IDENT_BOOL(TRUE));
-      END H;
- 
-      FUNCTION H RETURN V2 IS
-      BEGIN
-           RETURN (1..10 => 5);
-      END H;
- 
- BEGIN
- 
-      TEST ("C41201D", "WHEN SLICING FUNCTION RESULTS, TYPE OF " &
-                       "RESULT IS USED FOR OVERLOADING RESOLUTION");
- 
-      IF F(1..3) /=
-         F(IDENT_INT(2)..IDENT_INT(4)) THEN -- NUMBER OF DIMENSIONS.
-           FAILED ("WRONG VALUE - 1");
-      END IF;
- 
-      IF G(1..3) /=
-         G(IDENT_INT(2)..IDENT_INT(4)) THEN -- INDEX TYPE.
-           FAILED ("WRONG VALUE - 2");
-      END IF;
- 
-      IF NOT IDENT_BOOL(H(2..3)(2)) THEN    -- COMPONENT TYPE.
-           FAILED ("WRONG VALUE - 3");
-      END IF;
- 
-      RESULT;
- 
- END C41201D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41203a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41203a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41203a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,241 ****
- -- C41203A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NAME PART OF A SLICE MAY BE:
- --   AN IDENTIFIER DENOTING A ONE DIMENSIONAL ARRAY OBJECT - N1;
- --   AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
- --        DESIGNATES A ONE DIMENSIONAL ARRAY OBJECT - N2;
- --   A FUNCTION CALL DELIVERING A ONE DIMENSIONAL ARRAY OBJECT USING
- --        A PREDEFINED FUNCTION - &,
- --        A USER-DEFINED FUNCTION - F1;
- --   A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
- --        DESIGNATES A ONE DIMENSIONAL ARRAY - F2;
- --   A SLICE - N3;
- --   AN INDEXED COMPONENT DENOTING A ONE DIMENSIONAL ARRAY OBJECT
- --        (ARRAY OF ARRAYS) - N4;
- --   AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
- --        ENCLOSING ITS DECLARATION - C41203A.N1;
- --   A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
- --        ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
- -- CHECK THAT THE APPROPRIATE SLICE IS ACCESSED (FOR
- --   STATIC INDICES).
- 
- -- WKB 8/5/81
- -- SPS 11/1/82
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41203A IS		
- 
-      TYPE T1 IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      SUBTYPE A1 IS T1 (1..6);
-      N1 : A1 := (1,2,3,4,5,6);
- 
- BEGIN
-      TEST ("C41203A", "CHECK THAT THE NAME PART OF A SLICE MAY BE " &
-                       "OF CERTAIN FORMS AND THAT THE APPROPRIATE " &
-                       "SLICE IS ACCESSED (FOR STATIC INDICES)");
- 
-      DECLARE
- 
-           TYPE T2 IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
-           SUBTYPE A2 IS T2 (1..6);
-           TYPE A3 IS ACCESS A1;
-           SUBTYPE SI IS INTEGER RANGE 1 .. 3;
-           TYPE A4 IS ARRAY (SI) OF A1;
-           TYPE R (LENGTH : INTEGER) IS
-                RECORD
-                     S : STRING (1..LENGTH);
-                END RECORD;
- 
-           N2 : A3 := NEW A1' (1,2,3,4,5,6);
-           N3 : T1 (1..7) := (1,2,3,4,5,6,7);
-           N4 : A4 := (1 => (1,2,3,4,5,6), 2 => (7,8,9,10,11,12),
-                       3 => (13,14,15,16,17,18));
-           N5 : R(6) := (LENGTH => 6, S => "ABCDEF");
- 
-           FUNCTION F1 RETURN A2 IS
-           BEGIN
-                RETURN (FALSE,FALSE,TRUE,FALSE,TRUE,TRUE);
-           END F1;
- 
-           FUNCTION F2 RETURN A3 IS
-           BEGIN
-                RETURN N2;
-           END F2;
- 
-           PROCEDURE P1 (X : IN T1; Y : IN OUT T1;
-                         Z : OUT T1; W : IN STRING) IS
-           BEGIN
-                IF X /= (1,2) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
-                END IF;
-                IF Y /= (3,4) THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
-                END IF;
-                Y := (10,11);
-                Z := (12,13);
-           END P1;
- 
-           PROCEDURE P2 (X : STRING) IS
-           BEGIN
-                IF X /= "BC" THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
-                END IF;
-           END P2;
- 
-           PROCEDURE P3 (X : T2) IS
-           BEGIN
-                IF X /= (FALSE,TRUE,FALSE) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
-                END IF;
-           END P3;
- 
-           PROCEDURE P5 (X : IN STRING; Y : IN OUT STRING;
-                         Z : OUT STRING) IS
-           BEGIN 
-                IF X /= "EF" THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
-                END IF;
-                IF Y /= "CD" THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
-                END IF;
-                Y := "XY";
-                Z := "WZ";
-           END P5;
- 
-      BEGIN
- 
-           IF N1(1..2) /= (1,2) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
-           END IF;
-           N1(1..2) := (7,8);
-           IF N1 /= (7,8,3,4,5,6) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
-           END IF;
-           N1 := (1,2,3,4,5,6);
-           P1 (N1(1..2), N1(3..4), N1(5..6), "N1");
-           IF N1 /= (1,2,10,11,12,13) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
-           END IF;
- 
-           IF N2(4..6) /= (4,5,6) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
-           END IF;
-           N2(4..6) := (7,8,9);
-           IF N2.ALL /= (1,2,3,7,8,9) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
-           END IF;
-           N2.ALL := (1,2,5,6,3,4);
-           P1 (N2(1..2), N2(5..6), N2(3..4), "N2");
-           IF N2.ALL /= (1,2,12,13,10,11) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
-           END IF;
- 
-           IF "&" (STRING'("AB"), STRING'("CDEF"))(4..6) /= STRING'("DEF") THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
-           END IF;
-           P2 ("&" ("AB", "CD")(2..3));
- 
-           IF F1(1..2) /= (FALSE,FALSE) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
-           END IF;
-           P3 (F1(2..4));
- 
-           N2 := NEW A1' (1,2,3,4,5,6);
-           IF F2(2..6) /= (2,3,4,5,6) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
-           END IF;
-           F2(3..3) := (5 => 7);
-           IF N2.ALL /= (1,2,7,4,5,6) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
-           END IF;
-           N2.ALL := (5,6,1,2,3,4);
-           P1 (F2(3..4), F2(5..6), F2(1..2), "F2");
-           IF N2.ALL /= (12,13,1,2,10,11) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
-           END IF;
- 
-           IF N3(2..7)(2..4) /= (2,3,4) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N3");
-           END IF;
-           N3(2..7)(4..5) := (8,9);
-           IF N3 /= (1,2,3,8,9,6,7) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
-           END IF;
-           N3 := (5,3,4,1,2,6,7);
-           P1 (N3(2..7)(4..5), N3(2..7)(2..3), N3(2..7)(6..7), "N3");
-           IF N3 /= (5,10,11,1,2,12,13) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
-           END IF;
- 
-           IF N4(1)(3..5) /= (3,4,5) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
-           END IF;
-           N4(2)(1..3) := (21,22,23);
-           IF N4 /= ((1,2,3,4,5,6),(21,22,23,10,11,12),
-                     (13,14,15,16,17,18)) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
-           END IF;
-           N4 := (1 => (18,19,20,21,22,23), 2 => (17,16,15,1,2,14),
-                  3 => (7,3,4,5,6,8));
-           P1 (N4(2)(4..5), N4(3)(2..3), N4(1)(5..6), "N4");
-           IF N4 /= ((18,19,20,21,12,13),(17,16,15,1,2,14),
-                     (7,10,11,5,6,8)) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
-           END IF;
- 
-           N1 := (1,2,3,4,5,6);
-           IF C41203A.N1(1..2) /= (1,2) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - C41203A.N1");
-           END IF;
-           C41203A.N1(1..2) := (7,8);
-           IF N1 /= (7,8,3,4,5,6) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41203A.N1");
-           END IF;
-           N1 := (1,2,3,4,5,6);
-           P1 (C41203A.N1(1..2), C41203A.N1(3..4), C41203A.N1(5..6),
-               "C41203A.N1");
-           IF N1 /= (1,2,10,11,12,13) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
-                        "- C41203A.N1");
-           END IF;
- 
-           IF N5.S(1..5) /= "ABCDE" THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
-           END IF;
-           N5.S(4..6) := "PQR";
-           IF N5.S /= "ABCPQR" THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
-           END IF;
-           N5.S := "ABCDEF";
-           P5 (N5.S(5..6), N5.S(3..4), N5.S(1..2));
-           IF N5.S /= "WZXYEF" THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
-           END IF;
-      END;
- 
-      RESULT;
- END C41203A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41203b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41203b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41203b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,378 ****
- -- C41203B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NAME PART OF A SLICE MAY BE:
- --        AN IDENTIFIER DENOTING A ONE DIMENSIONAL ARRAY OBJECT - N1;
- --        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
- --           DESIGNATES A ONE DIMENSIONAL ARRAY OBJECT - N2;
- --        A FUNCTION CALL DELIVERING A ONE DIMENSIONAL ARRAY OBJECT
- --           USING PREDEFINED FUNCTIONS - &, AND THE LOGICAL OPERATORS
- --        A USER-DEFINED FUNCTION - F1;
- --        A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
- --           DESIGNATES A ONE DIMENSIONAL ARRAY - F2;
- --        A SLICE - N3;
- --        AN INDEXED COMPONENT DENOTING A ONE DIMENSIONAL ARRAY OBJECT
- --           (ARRAY OF ARRAYS) - N4;
- --        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
- --           ENCLOSING ITS DECLARATION - C41203B.N1;
- --        A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
- --           ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
- --     CHECK THAT THE APPROPRIATE SLICE IS ACCESSED (FOR
- --     DYNAMIC INDICES).
- 
- -- HISTORY:
- --     WKB 08/05/81  CREATED ORIGINAL TEST.
- --     SPS 02/04/83
- --     BCB 08/02/88  MODIFIED HEADER FORMAT AND ADDED CALLS TO THE
- --                   LOGICAL OPERATORS.
- --     BCB 04/16/90  ADDED TEST FOR PREFIX OF INDEXED COMPONENT HAVING
- --                   A LIMITED TYPE.
- --     PWN 11/30/94  SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41203B IS
- 
-      TYPE T1 IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-      SUBTYPE A1 IS T1 (1..6);
-      N1 : A1 := (1,2,3,4,5,6);
- 
- BEGIN
-      TEST ("C41203B", "CHECK THAT THE NAME PART OF A SLICE MAY BE " &
-                       "OF CERTAIN FORMS AND THAT THE APPROPRIATE " &
-                       "SLICE IS ACCESSED (FOR DYNAMIC INDICES)");
- 
-      DECLARE
- 
-           TYPE T2 IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
-           SUBTYPE A2 IS T2 (1..6);
-           TYPE A3 IS ACCESS A1;
-           TYPE A4 IS ARRAY (INTEGER RANGE 1..3 ) OF A1;
-           TYPE R (LENGTH : INTEGER) IS
-                RECORD
-                     S : STRING (1..LENGTH);
-                END RECORD;
- 
-           N2 : A3 := NEW A1'(1,2,3,4,5,6);
-           N3 : T1(1..7) := (1,2,3,4,5,6,7);
-           N4 : A4 := (1 => (1,2,3,4,5,6), 2 => (7,8,9,10,11,12),
-                       3 => (13,14,15,16,17,18));
-           N5 : R(6) := (LENGTH => 6, S => "ABCDEF");
- 
-           M2A : A2 := (TRUE,TRUE,TRUE,FALSE,FALSE,FALSE);
-           M2B : A2 := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
- 
-           FUNCTION F1 RETURN A2 IS
-           BEGIN
-                RETURN (FALSE,FALSE,TRUE,FALSE,TRUE,TRUE);
-           END F1;
- 
-           FUNCTION F2 RETURN A3 IS
-           BEGIN
-                RETURN N2;
-           END F2;
- 
-           PROCEDURE P1 (X : IN T1; Y : IN OUT T1;
-                         Z : OUT T1; W : IN STRING) IS
-           BEGIN
-                IF X /= (1,2) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
-                END IF;
-                IF Y /= (3,4) THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
-                END IF;
-                Y := (10,11);
-                Z := (12,13);
-           END P1;
- 
-           PROCEDURE P2 (X : STRING) IS
-           BEGIN
-                IF X /= "BC" THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
-                END IF;
-           END P2;
- 
-           PROCEDURE P3 (X : T2) IS
-           BEGIN
-                IF X /= (FALSE,TRUE,FALSE) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
-                END IF;
-           END P3;
- 
-           PROCEDURE P5 (X : IN STRING; Y : IN OUT STRING;
-                         Z : OUT STRING) IS
-           BEGIN
-                IF X /= "EF" THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
-                END IF;
-                IF Y /= "CD" THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
-                END IF;
-                Y := "XY";
-                Z := "WZ";
-           END P5;
- 
-           PROCEDURE P6 (X : T2) IS
-           BEGIN
-                IF X /= (FALSE,FALSE,TRUE) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - NOT");
-                END IF;
-           END P6;
- 
-           PROCEDURE P7 (X : T2) IS
-           BEGIN
-                IF X /= (FALSE,TRUE,FALSE) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - AND");
-                END IF;
-           END P7;
- 
-           PROCEDURE P8 (X : T2) IS
-           BEGIN
-                IF X /= (FALSE,TRUE,FALSE) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - OR");
-                END IF;
-           END P8;
- 
-           PROCEDURE P9 (X : T2) IS
-           BEGIN
-                IF X /= (FALSE,TRUE,FALSE) THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - XOR");
-                END IF;
-           END P9;
- 
-      BEGIN
- 
-           IF N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
-           END IF;
-           N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8);
-           IF N1 /= (7,8,3,4,5,6) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
-           END IF;
-           N1 := (1,2,3,4,5,6);
-           P1 (N1(IDENT_INT(1)..IDENT_INT(2)),
-               N1(IDENT_INT(3)..IDENT_INT(4)),
-               N1(IDENT_INT(5)..IDENT_INT(6)), "N1");
-           IF N1 /= (1,2,10,11,12,13) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
-           END IF;
- 
-           IF N2(IDENT_INT(4)..IDENT_INT(6)) /= (4,5,6) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
-           END IF;
-           N2(IDENT_INT(4)..IDENT_INT(6)) := (7,8,9);
-           IF N2.ALL /= (1,2,3,7,8,9) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
-           END IF;
-           N2.ALL := (1,2,5,6,3,4);
-           P1 (N2(IDENT_INT(1)..IDENT_INT(2)),
-               N2(IDENT_INT(5)..IDENT_INT(6)),
-               N2(IDENT_INT(3)..IDENT_INT(4)), "N2");
-           IF N2.ALL /= (1,2,12,13,10,11) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
-           END IF;
- 
-           IF "&" (STRING'("AB"),STRING'("CDEF"))(IDENT_INT(4)..IDENT_INT(6)) 
-             /= STRING'("DEF") THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
-           END IF;
-           P2 ("&" ("AB","CD")(IDENT_INT(2)..IDENT_INT(3)));
- 
-           IF "NOT" (M2A)(IDENT_INT(3)..IDENT_INT(5)) /=
-              (FALSE,TRUE,TRUE) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'NOT'");
-           END IF;
-           P6 ("NOT" (M2A)(IDENT_INT(2)..IDENT_INT(4)));
- 
-           IF "AND" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
-              (TRUE,FALSE,FALSE) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'AND'");
-           END IF;
-           P7 ("AND" (M2A,M2B)(IDENT_INT(2)..IDENT_INT(4)));
- 
-           IF "OR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
-              (TRUE,FALSE,TRUE) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'OR'");
-           END IF;
-           P8 ("OR" (M2A,M2B)(IDENT_INT(4)..IDENT_INT(6)));
- 
-           IF "XOR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
-              (FALSE,FALSE,TRUE) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - 'XOR'");
-           END IF;
-           P9 ("XOR" (M2A,M2B)(IDENT_INT(1)..IDENT_INT(3)));
- 
-           IF F1(IDENT_INT(1)..IDENT_INT(2)) /= (FALSE,FALSE) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
-           END IF;
-           P3 (F1(IDENT_INT(2)..IDENT_INT(4)));
- 
-           N2 := NEW A1'(1,2,3,4,5,6);
-           IF F2(IDENT_INT(2)..IDENT_INT(6)) /= (2,3,4,5,6) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
-           END IF;
-           F2(IDENT_INT(3)..IDENT_INT(3)) := (5 => 7);
-           IF N2.ALL /= (1,2,7,4,5,6) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
-           END IF;
-           N2.ALL := (5,6,1,2,3,4);
-           P1 (F2(IDENT_INT(3)..IDENT_INT(4)),
-               F2(IDENT_INT(5)..IDENT_INT(6)),
-               F2(IDENT_INT(1)..IDENT_INT(2)), "F2");
-           IF N2.ALL /= (12,13,1,2,10,11) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
-           END IF;
- 
-           IF N3(2..7)(IDENT_INT(2)..IDENT_INT(4)) /= (2,3,4) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N3");
-           END IF;
-           N3(2..7)(IDENT_INT(4)..IDENT_INT(5)) := (8,9);
-           IF N3 /= (1,2,3,8,9,6,7) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
-           END IF;
-           N3 := (5,3,4,1,2,6,7);
-           P1 (N3(2..7)(IDENT_INT(4)..IDENT_INT(5)),
-               N3(2..7)(IDENT_INT(2)..IDENT_INT(3)),
-               N3(2..7)(IDENT_INT(6)..IDENT_INT(7)), "N3");
-           IF N3 /= (5,10,11,1,2,12,13) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
-           END IF;
- 
-           IF N4(1)(IDENT_INT(3)..IDENT_INT(5)) /= (3,4,5) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
-           END IF;
-           N4(2)(IDENT_INT(1)..IDENT_INT(3)) := (21,22,23);
-           IF N4 /= ((1,2,3,4,5,6),(21,22,23,10,11,12),
-                     (13,14,15,16,17,18)) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
-           END IF;
-           N4 := (1 => (18,19,20,21,22,23), 2 => (17,16,15,1,2,14),
-                  3 => (7,3,4,5,6,8));
-           P1 (N4(2)(IDENT_INT(4)..IDENT_INT(5)),
-               N4(3)(IDENT_INT(2)..IDENT_INT(3)),
-               N4(1)(IDENT_INT(5)..IDENT_INT(6)), "N4");
-           IF N4 /= ((18,19,20,21,12,13),(17,16,15,1,2,14),
-                     (7,10,11,5,6,8)) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
-           END IF;
- 
-           N1 := (1,2,3,4,5,6);
-           IF C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - C41203B.N1");
-           END IF;
-           C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8);
-           IF N1 /= (7,8,3,4,5,6) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41203B.N1");
-           END IF;
-           N1 := (1,2,3,4,5,6);
-           P1 (C41203B.N1(IDENT_INT(1)..IDENT_INT(2)),
-               C41203B.N1(IDENT_INT(3)..IDENT_INT(4)),
-               C41203B.N1(IDENT_INT(5)..IDENT_INT(6)), "C41203B.N1");
-           IF N1 /= (1,2,10,11,12,13) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
-                        "- C41203B.N1");
-           END IF;
- 
-           IF N5.S(IDENT_INT(1)..IDENT_INT(5)) /= "ABCDE" THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
-           END IF;
-           N5.S(IDENT_INT(4)..IDENT_INT(6)) := "PQR";
-           IF N5.S /= "ABCPQR" THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
-           END IF;
-           N5.S := "ABCDEF";
-           P5 (N5.S(IDENT_INT(5)..IDENT_INT(6)),
-               N5.S(IDENT_INT(3)..IDENT_INT(4)),
-               N5.S(IDENT_INT(1)..IDENT_INT(2)));
-           IF N5.S /= "WZXYEF" THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
-           END IF;
- 
-           DECLARE
-                PACKAGE P IS
-                     TYPE LIM IS LIMITED PRIVATE;
-                     TYPE A IS ARRAY(INTEGER RANGE <>) OF LIM;
-                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER);
-                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM);
-                     FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN;
-                PRIVATE
-                     TYPE LIM IS ARRAY(1..3) OF INTEGER;
-                END P;
- 
-                USE P;
- 
-                H : A(1..5);
- 
-                N6 : A(1..3);
- 
-                PACKAGE BODY P IS
-                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER) IS
-                     BEGIN
-                          V := (X,Y,Z);
-                     END INIT;
- 
-                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM) IS
-                     BEGIN
-                          ONE := TWO;
-                     END ASSIGN;
- 
-                     FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN IS
-                     BEGIN
-                          IF ONE(1) = TWO(2) AND ONE(2) = TWO(3) AND
-                            ONE(3) = TWO(4) THEN
-                               RETURN TRUE;
-                          ELSE
-                               RETURN FALSE;
-                          END IF;
-                     END "=";
-                END P;
- 
-                FUNCTION FR RETURN A IS
-                BEGIN
-                     RETURN H;
-                END FR;
- 
-           BEGIN
-                INIT (H(1),1,2,3);
-                INIT (H(2),4,5,6);
-                INIT (H(3),7,8,9);
-                INIT (H(4),10,11,12);
-                INIT (H(5),13,14,15);
-                INIT (N6(1),0,0,0);
-                INIT (N6(2),0,0,0);
-                INIT (N6(3),0,0,0);
- 
-                ASSIGN (N6(1),H(2));
-                ASSIGN (N6(2),H(3));
-                ASSIGN (N6(3),H(4));
- 
-                IF N6 /= FR(2..4) THEN
-                     FAILED ("WRONG VALUE FROM LIMITED COMPONENT TYPE");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END C41203B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41204a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41204a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41204a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C41204A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF A SLICE'S DISCRETE
- --   RANGE IS NOT NULL, AND ITS LOWER OR UPPER BOUND IS NOT A
- --   POSSIBLE INDEX FOR THE NAMED ARRAY.
- 
- -- WKB 8/4/81
- -- EDS 7/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41204A IS
- 
- BEGIN
-      TEST ("C41204A", "ILLEGAL UPPER OR LOWER BOUNDS FOR A " &
-                       "SLICE RAISES CONSTRAINT_ERROR");
- 
-      DECLARE
- 
-           TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-           A : T (10..15) := (10,11,12,13,14,15);
-           B : T (-20..30);
- 
-      BEGIN
- 
-           BEGIN
-                B (IDENT_INT(9)..12) := A (IDENT_INT(9)..12);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1" &
-                        INTEGER'IMAGE(B(10)));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
-           END;
- 
-           BEGIN
-                B (IDENT_INT(-12)..14) := A (IDENT_INT(-12)..14);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2" &
-                        INTEGER'IMAGE(B(10)));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
-           END;
- 
-           BEGIN
-                B (11..IDENT_INT(16)) := A (11..IDENT_INT(16));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3" &
-                        INTEGER'IMAGE(B(15)));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 3");
-           END;
- 
-           BEGIN
-                B (17..20) := A (IDENT_INT(17)..IDENT_INT(20));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 4" &
-                        INTEGER'IMAGE(B(17)));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 4");
-           END;
-      END;
- 
-      RESULT;
- END C41204A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41205a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41205a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41205a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C41205A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE NAME PART OF A
- --   SLICE DENOTES AN ACCESS OBJECT WHOSE VALUE IS NULL, AND
- --   ALSO IF THE NAME IS A FUNCTION CALL DELIVERING NULL.
- 
- -- WKB 8/6/81
- -- SPS 10/26/82
- -- EDS 07/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41205A IS
- 
- BEGIN
-      TEST ("C41205A", "CONSTRAINT_ERROR WHEN THE NAME PART OF A " &
-                       "SLICE DENOTES A NULL ACCESS OBJECT OR A " &
-                       "FUNCTION CALL DELIVERING NULL");
- 
-      DECLARE
- 
-           TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-           SUBTYPE T1 IS T (1..5);
-           TYPE A1 IS ACCESS T1;
-           B : A1 := NEW T1' (1,2,3,4,5);
-           I : T (2..3);
- 
-      BEGIN
- 
-           IF EQUAL (3,3) THEN
-                B := NULL;
-           END IF;
- 
-           I := B(2..3);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & INTEGER'IMAGE(I(2)));
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
- 
-      END;
- 
-      DECLARE
- 
-           TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
-           SUBTYPE T2 IS T (1..5);
-           TYPE A2 IS ACCESS T2;
-           I : T (2..5);
- 
-           FUNCTION F RETURN A2 IS
-           BEGIN
-                IF EQUAL (3,3) THEN
-                     RETURN NULL;
-                END IF;
-                RETURN NEW T2' (1,2,3,4,5);
-           END F;
- 
-      BEGIN
- 
-           I := F(2..5);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 2 " & INTEGER'IMAGE(I(2)));
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
- 
-      END;
- 
-      RESULT;
- END C41205A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41206a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41206a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41206a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C41206A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RANGE L..R, WHERE L=SUCC(R) CAN BE USED TO FORM
- --   A NULL SLICE FROM AN ARRAY WHEN:
- --        BOTH L AND R SATISFY THE INDEX CONSTRAINT;
- --        L SATISFIES THE INDEX CONSTRAINT, R DOES NOT (BUT IT
- --             BELONGS TO THE BASE TYPE OF THE INDEX);
- --        L SATISFIES THE CONSTRAINT IMPOSED BY THE TYPE MARK OF
- --             THE INDEX, BUT NOT THE CONSTRAINT ASSOCIATED WITH
- --             THE INDEX;
- --        THE ARRAY IS NULL, AND L IS IN THE RANGE OF THE INDEX SUBTYPE.
- 
- -- WKB 8/10/81
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41206A IS
- 
-      TYPE SMALL IS RANGE 1..100;
-      TYPE T IS ARRAY (SMALL RANGE <> ) OF INTEGER;
-      SUBTYPE T1 IS T(5..10);
-      A : T1 := (5,6,7,8,9,10);
-      B : T(8..7) := (8..7 => 1);
- 
- BEGIN
-      TEST ("C41206A", "USING A RANGE L..R, WHERE L=SUCC(R), " &
-                       "TO FORM A NULL SLICE FROM AN ARRAY");
- 
-      BEGIN
-           IF A (7..6) /= B OR A (SMALL(IDENT_INT(7))..6) /= B THEN
-                FAILED ("SLICE NOT NULL - 1");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 1");
-      END;
- 
-      BEGIN
-           IF A (5..4) /= B OR A (SMALL(IDENT_INT(5))..4) /= B THEN
-                FAILED ("SLICE NOT NULL - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 2");
-      END;
- 
-      BEGIN
-           IF A (50..49) /= B OR A (SMALL(IDENT_INT(50))..49) /= B THEN
-                FAILED ("SLICE NOT NULL - 3");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 3");
-      END;
- 
-      BEGIN
-           IF B (50..49) /= B OR B (SMALL(IDENT_INT(50))..49) /= B THEN
-                FAILED ("SLICE NOT NULL - 4");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 4");
-      END;
- 
-      RESULT;
- END C41206A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41207a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41207a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41207a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- C41207A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE DISCRETE RANGE IN A SLICE CAN HAVE THE FORM
- --     A'RANGE, WHERE A IS A CONSTRAINED ARRAY SUBTYPE OR AN ARRAY
- --     OBJECT.
- 
- -- HISTORY:
- --     BCB 07/13/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C41207A IS
- 
-      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
- 
-      SUBTYPE A1 IS ARR(1..5);
- 
-      ARR_VAR : ARR(1..10) := (90,91,92,93,94,95,96,97,98,99);
- 
-      A2 : ARRAY(1..5) OF INTEGER := (80,81,82,83,84);
- 
- BEGIN
-      TEST ("C41207A", "CHECK THAT THE DISCRETE RANGE IN A SLICE CAN " &
-                       "HAVE THE FORM A'RANGE, WHERE A IS A " &
-                       "CONSTRAINED ARRAY SUBTYPE OR AN ARRAY OBJECT");
- 
-      ARR_VAR (A1'RANGE) := (1,2,3,4,5);
- 
-      IF NOT (EQUAL(ARR_VAR(1),1) AND EQUAL(ARR_VAR(2),2) AND
-          EQUAL(ARR_VAR(3),3) AND EQUAL(ARR_VAR(4),4) AND
-          EQUAL(ARR_VAR(5),5)) THEN
-           FAILED ("IMPROPER RESULT FROM SLICE ASSIGNMENT USING THE " &
-                   "RANGE OF A CONSTRAINED ARRAY SUBTYPE");
-      END IF;
- 
-      ARR_VAR (A2'RANGE) := (6,7,8,9,10);
- 
-      IF (NOT EQUAL(ARR_VAR(1),6) OR NOT EQUAL(ARR_VAR(2),7) OR
-          NOT EQUAL(ARR_VAR(3),8) OR NOT EQUAL(ARR_VAR(4),9) OR
-          NOT EQUAL(ARR_VAR(5),10)) THEN
-           FAILED ("IMPROPER RESULT FROM SLICE ASSIGNMENT USING THE " &
-                   "RANGE OF AN ARRAY OBJECT");
-      END IF;
- 
-      RESULT;
- END C41207A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41301a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41301a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41301a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- C41301A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION L.R MAY BE USED TO DENOTE A RECORD COMPONENT,
- --   WHERE R IS THE IDENTIFIER OF SUCH COMPONENT, AND L MAY BE ANY OF
- --   THE FOLLOWING:
- --        AN IDENTIFIER DENOTING A RECORD OBJECT - X2;
- --        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE DESIGNATES
- --           A RECORD OBJECT - X3;
- --        A FUNCTION CALL DELIVERING A RECORD VALUE - F1;
- --        A FUNCTION CALL DELIVERING AN ACCESS VALUE DESIGNATING A
- --           RECORD OBJECT - F2;
- --        AN INDEXED COMPONENT - X4;
- --        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
- --           ENCLOSING THE IDENTIFIER'S DECLARATION - C41301A.X1;
- --        A SELECTED COMPONENT DENOTING A RECORD (WHICH IS A COMPONENT
- --           OF ANOTHER RECORD) - X5.
- 
- -- WKB 8/13/81
- -- JRK 8/17/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41301A IS
- 
-      TYPE T1 IS
-           RECORD
-                A : INTEGER;
-                B : BOOLEAN;
-                C : BOOLEAN;
-           END RECORD;
-      X1 : T1 := (A=>1, B=>TRUE, C=>FALSE);
- 
- BEGIN
-      TEST ("C41301A", "CHECK THAT THE NOTATION L.R MAY BE USED TO " &
-                       "DENOTE A RECORD COMPONENT, WHERE R IS THE " &
-                       "IDENTIFIER AND L MAY BE OF CERTAIN FORMS");
- 
-      DECLARE
- 
-           TYPE T2 (DISC : INTEGER := 0) IS
-                RECORD
-                     D : BOOLEAN;
-                     E : INTEGER;
-                     F : BOOLEAN;
-                     CASE DISC IS
-                          WHEN 1 =>
-                               G : BOOLEAN;
-                          WHEN 2 =>
-                               H : INTEGER;
-                          WHEN OTHERS =>
-                               NULL;
-                     END CASE;
-                END RECORD;
-           X2 : T2(2) := (DISC=>2, D=>TRUE, E=>3, F=>FALSE, H=>1);
- 
-           TYPE T3 IS ACCESS T1;
-           X3 : T3 := NEW T1' (A=>1, B=>TRUE, C=>FALSE);
- 
-           TYPE T4 IS ARRAY (1..3) OF T1;
-           X4 : T4 := (1 => (1, TRUE, FALSE),
-                       2 => (2, FALSE, TRUE),
-                       3 => (3, TRUE, FALSE));
- 
-           TYPE T5 IS
-                RECORD
-                     I : INTEGER;
-                     J : T1;
-                END RECORD;
-           X5 : T5 := (I => 5, J => (6, FALSE, TRUE));
- 
-           FUNCTION F1 RETURN T2 IS
-           BEGIN
-                RETURN (DISC=>1, D=>FALSE, E=>3, F=>TRUE, G=>FALSE);
-           END F1;
- 
-           FUNCTION F2 RETURN T3 IS
-           BEGIN
-                RETURN X3;
-           END F2;
- 
-           PROCEDURE P1 (X : IN BOOLEAN; Y : IN OUT INTEGER;
-                         Z : OUT BOOLEAN; W : STRING) IS
-           BEGIN
-                IF X /= TRUE THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
-                END IF;
-                IF Y /= 1 THEN
-                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
-                END IF;
-                Y := 10;
-                Z := TRUE;
-           END P1;
- 
-           PROCEDURE P2 (X : IN INTEGER) IS
-           BEGIN
-                IF X /= 1 THEN
-                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
-                END IF;
-           END P2;
- 
-      BEGIN
- 
-           IF X2.E /= 3 THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - X2");
-           END IF;
-           X2.E := 5;
-           IF X2 /= (2, TRUE, 5, FALSE, 1) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - X2");
-           END IF;
-           X2 := (DISC=>2, D=>TRUE, E=>3, F=>FALSE, H=>1);
-           P1 (X2.D, X2.H, X2.F, "X2");
-           IF X2 /= (2, TRUE, 3, TRUE, 10) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X2");
-           END IF;
- 
-           IF X3.C /= FALSE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - X3");
-           END IF;
-           X3.A := 5;
-           IF X3.ALL /= (5, TRUE, FALSE) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - X3");
-           END IF;
-           X3 := NEW T1 '(A=>1, B=>TRUE, C=>FALSE);
-           P1 (X3.B, X3.A, X3.C, "X3");
-           IF X3.ALL /= (10, TRUE, TRUE) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X3");
-           END IF;
- 
-           IF F1.G /= FALSE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
-           END IF;
-           P2 (F1.DISC);
- 
-           X3 := NEW T1' (A=>3, B=>FALSE, C=>TRUE);
-           IF F2.B /= FALSE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
-           END IF;
-           F2.A := 4;
-           IF X3.ALL /= (4, FALSE, TRUE) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
-           END IF;
-           X3 := NEW T1' (A=>1, B=>FALSE, C=>TRUE);
-           P1 (F2.C, F2.A, F2.B, "F2");
-           IF X3.ALL /= (10, TRUE, TRUE) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
-           END IF;
- 
-           IF X4(2).C /= TRUE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - X4");
-           END IF;
-           X4(3).A := 4;
-           IF X4 /= ((1,TRUE,FALSE), (2,FALSE,TRUE), (4,TRUE,FALSE)) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - X4");
-           END IF;
-           X4 := (1 => (2,TRUE,FALSE), 2 => (1,FALSE,TRUE),
-                  3 => (3,TRUE,FALSE));
-           P1 (X4(3).B, X4(2).A, X4(1).C, "X4");
-           IF X4 /= ((2,TRUE,TRUE), (10,FALSE,TRUE), (3,TRUE,FALSE)) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X4");
-           END IF;
- 
-           X1 := (A=>1, B=>FALSE, C=>TRUE);
-           IF C41301A.X1.C /= TRUE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - C41301A.X1");
-           END IF;
-           C41301A.X1.B := TRUE;
-           IF X1 /= (1, TRUE, TRUE) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41301A.X1");
-           END IF;
-           X1 := (A=>1, B=>FALSE, C=>TRUE);
-           P1 (C41301A.X1.C, C41301A.X1.A, C41301A.X1.B, "C41301A.X1");
-           IF X1 /= (10, TRUE, TRUE) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - " &
-                        "C41301A.X1");
-           END IF;
- 
-           IF X5.J.C /= TRUE THEN
-                FAILED ("WRONG VALUE FOR EXPRESSION - X5");
-           END IF;
-           X5.J.C := FALSE;
-           IF X5 /= (5, (6, FALSE, FALSE)) THEN
-                FAILED ("WRONG TARGET FOR ASSIGNMENT - X5");
-           END IF;
-           X5 := (I => 5, J => (A=>1, B=>TRUE, C=>FALSE));
-           P1 (X5.J.B, X5.J.A, X5.J.C, "X5");
-           IF X5 /= (5, (10, TRUE, TRUE)) THEN
-                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X5");
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C41301A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C41303A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||  XXXXXXXXX  |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303A IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303A" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ACCESS TO RECORD  ---------------------------
- 
-      DECLARE
- 
-           TYPE  REC  IS
- 
-                RECORD
-                     A , B , C : INTEGER ;
-                END RECORD ;
- 
-           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
-           REC_VAR      :  REC  :=    REC_CONST  ;
- 
-           TYPE  ACC_REC  IS  ACCESS REC ;
- 
-           ACC_REC_VAR  :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
- 
-      BEGIN
- 
-           REC_VAR          :=  ACC_REC_VAR.ALL ;
- 
-           IF  REC_VAR /= ( 17 , 18 , 19 )
-           THEN
-                FAILED( "ACC. RECORD, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
-           END IF;
- 
- 
-           ACC_REC_VAR.ALL  :=  REC_CONST ;
- 
-           IF  ACC_REC_VAR.ALL /= ( 7 , 8 , 9 )
-           THEN
-                FAILED( "ACC. RECORD, LEFT SIDE OF ASSIGN.,WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C41303B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||  XXXXXXXXX  |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303B IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303B" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ACCESS TO ARRAY  ----------------------------
- 
-      DECLARE
- 
-           TYPE  ARR  IS  ARRAY(1..2) OF BOOLEAN ;
- 
-           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
-           ARR_VAR      :  ARR  :=    ARR_CONST  ;
- 
-           TYPE  ACC_ARR  IS  ACCESS ARR ;
- 
-           ACC_ARR_VAR  :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
- 
-      BEGIN
- 
-           ARR_VAR          :=  ACC_ARR_VAR.ALL ;
- 
-           IF  ARR_VAR /= ( FALSE , TRUE )
-           THEN
-                FAILED( "ACC. ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
-           END IF;
- 
- 
-           ACC_ARR_VAR.ALL  :=  ARR_CONST ;
- 
-           IF  ACC_ARR_VAR.ALL /= ( TRUE , FALSE )
-           THEN
-                FAILED( "ACC. ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C41303C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||  XXXXXXXXX  |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303C IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303C" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ACCESS TO SCALAR  ---------------------------
- 
-      DECLARE
- 
-           TYPE  NEWINT  IS  NEW INTEGER ;
- 
-           NEWINT_CONST    :  NEWINT  :=  813 ;
-           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
- 
-           TYPE  ACC_NEWINT  IS  ACCESS NEWINT ;
- 
-           ACC_NEWINT_VAR  :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
- 
-      BEGIN
- 
-           NEWINT_VAR          :=  ACC_NEWINT_VAR.ALL ;
- 
-           IF  NEWINT_VAR /= ( 707 )
-           THEN
-                FAILED( "ACC. NEWINT, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
-           END IF;
- 
- 
-           ACC_NEWINT_VAR.ALL  :=  NEWINT_CONST ;
- 
-           IF  ACC_NEWINT_VAR.ALL /= 813 
-           THEN
-                FAILED( "ACC. NEWINT, LEFT SIDE OF ASSIGN.,WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C41303E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||  XXXXXXXXX  |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303E IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303E" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
- 
-      DECLARE
- 
-           TYPE  REC  IS
- 
-                RECORD
-                     A , B , C : INTEGER ;
-                END RECORD ;
- 
- 
-           TYPE  ACCREC  IS  ACCESS REC ;
- 
-           ACCREC_CONST    :  ACCREC  :=  NEW REC'( 7 , 8 , 9 );
-           ACCREC_VAR      :  ACCREC  :=    ACCREC_CONST  ;
-           ACCREC_CONST2   :  ACCREC  :=  NEW REC'( 17 , 18 , 19 );
- 
-           TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
- 
-           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
- 
-      BEGIN
- 
-           ACCREC_VAR          :=  ACC_ACCREC_VAR.ALL ;
- 
-           IF  ACCREC_VAR /= ACCREC_CONST2
-           THEN
-                FAILED( "ACC2 RECORD, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
-           END IF;
- 
- 
-           ACC_ACCREC_VAR.ALL  :=  ACCREC_CONST ;
- 
-           IF  ACCREC_CONST /= ACC_ACCREC_VAR.ALL 
-           THEN
-                FAILED( "ACC2 RECORD, LEFT SIDE OF ASSIGN.,WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C41303F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||  XXXXXXXXX  |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303F IS
- 
- BEGIN
- 
-      TEST ( "C41303F" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
- 
-      DECLARE
- 
-           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
-           TYPE  ACCARR  IS  ACCESS ARR ;
- 
-           ACCARR_CONST    :  ACCARR  :=  NEW ARR'( TRUE , FALSE );
-           ACCARR_VAR      :  ACCARR  :=    ACCARR_CONST  ;
-           ACCARR_CONST2   :  ACCARR  :=  NEW ARR'( FALSE , TRUE );
- 
-           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
- 
-           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
- 
-      BEGIN
- 
-           ACCARR_VAR          :=  ACC_ACCARR_VAR.ALL ;
- 
-           IF  ACCARR_VAR /= ACCARR_CONST2
-           THEN
-                FAILED( "ACC2 ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
-           END IF;
- 
- 
-           ACC_ACCARR_VAR.ALL  :=  ACCARR_CONST ;
- 
-           IF  ACCARR_CONST /= ACC_ACCARR_VAR.ALL
-           THEN
-                FAILED( "ACC2 ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- C41303G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||  XXXXXXXXX  |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303G IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303G" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
- 
-      DECLARE
- 
-           TYPE  NEWINT  IS  NEW INTEGER ;
- 
-           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
- 
-           ACCNEWINT_CONST    :  ACCNEWINT  :=  NEW NEWINT'( 813 );
-           ACCNEWINT_VAR      :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
-           ACCNEWINT_CONST2   :  ACCNEWINT  :=  NEW NEWINT'( 707 );
- 
-           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
- 
-           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
-                                                        ACCNEWINT_CONST2
-                                                                 );
- 
-      BEGIN
- 
-           ACCNEWINT_VAR          :=  ACC_ACCNEWINT_VAR.ALL ;
- 
-           IF  ACCNEWINT_VAR /= ACCNEWINT_CONST2
-           THEN
-                FAILED( "ACC2 NEWINT, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
-           END IF;
- 
- 
-           ACC_ACCNEWINT_VAR.ALL  :=  ACCNEWINT_CONST ;
- 
-           IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL
-           THEN
-                FAILED( "ACC2 NEWINT, LEFT SIDE OF ASSIGN.,WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- C41303I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||  XXXXXXXXX  |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303I IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303I" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
-                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
-                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
-                         " ACCEPTED" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
- 
-      DECLARE
- 
-           TYPE  REC  IS
- 
-                RECORD
-                     A , B , C : INTEGER ;
-                END RECORD ;
- 
- 
-           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
-           REC_VAR      :  REC  :=    REC_CONST  ;
-           REC_CONST2   :  REC  :=  ( 17 , 18 , 19 );
- 
-           TYPE  ACCREC  IS  ACCESS REC ;
- 
-           TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
- 
-           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'( 
-                                             NEW REC'( REC_CONST2 )
-                                                       );
- 
-      BEGIN
- 
-           REC_VAR          :=  ACC_ACCREC_VAR.ALL.ALL ;
- 
-           IF  REC_VAR /= REC_CONST2
-           THEN
-                FAILED( "ACC2 RECORD,RIGHT SIDE OF ASSIGN., WRONG VAL.");
-           END IF;
- 
- 
-           ACC_ACCREC_VAR.ALL.ALL  :=  REC_CONST ;
- 
-           IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR.ALL.ALL 
-           THEN
-                FAILED( "ACC2 RECORD, LEFT SIDE OF ASSIGN., WRONG VAL.");
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- C41303J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||  XXXXXXXXX  |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303J IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303J" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
-                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
-                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
-                         " ACCEPTED" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
- 
-      DECLARE
- 
-           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
- 
-           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
-           ARR_VAR      :  ARR  :=    ARR_CONST  ;
-           ARR_CONST2   :  ARR  :=  ( FALSE , TRUE );
- 
-           TYPE  ACCARR  IS  ACCESS ARR ;
- 
-           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
- 
-           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(
-                                             NEW ARR'( ARR_CONST2 )
-                                                       );
- 
-      BEGIN
- 
-           ARR_VAR          :=  ACC_ACCARR_VAR.ALL.ALL ;
- 
-           IF  ARR_VAR /= ARR_CONST2
-           THEN
-                FAILED( "ACC2 ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
-           END IF;
- 
- 
-           ACC_ACCARR_VAR.ALL.ALL  :=  ARR_CONST ;
- 
-           IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR.ALL.ALL
-           THEN
-                FAILED( "ACC2 ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C41303K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||  XXXXXXXXX  |
- --      ============================================================
- 
- 
- -- RM  1/20/82
- -- RM  1/25/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303K IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303K" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
-                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
-                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
-                         " ACCEPTED" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
- 
-      DECLARE
- 
-           TYPE  NEWINT  IS  NEW INTEGER ;
- 
-           NEWINT_CONST    :  NEWINT  :=  ( 813 );
-           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
-           NEWINT_CONST2   :  NEWINT  :=  ( 707 );
- 
-           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
- 
-           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
- 
-           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
-                                                    NEW NEWINT' ( 
-                                                    NEWINT_CONST2
-                                                               )
-                                                                 );
- 
-      BEGIN
- 
-           NEWINT_VAR          :=  ACC_ACCNEWINT_VAR.ALL.ALL ;
- 
-           IF  NEWINT_VAR /= NEWINT_CONST2
-           THEN
-                FAILED( "ACC2 NEWINT,RIGHT SIDE OF ASSIGN., WRONG VAL.");
-           END IF;
- 
- 
-           ACC_ACCNEWINT_VAR.ALL.ALL  :=  NEWINT_CONST ;
- 
-           IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL.ALL
-           THEN
-                FAILED( "ACC2 NEWINT,LEFT SIDE OF ASSIGN., WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- C41303M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |     XXXXXXXXX
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/22/82
- -- RM  1/26/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303M IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303M" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
-                       & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
-                       & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
-                       & " ACTUAL PARAMETER OF ANY MODE" );
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ACCESS TO RECORD  ---------------------------
- 
-      DECLARE
- 
-           TYPE  REC  IS
- 
-                RECORD
-                     A , B , C : INTEGER ;
-                END RECORD ;
- 
-           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
-           REC_VAR      :  REC  :=    REC_CONST  ;
-           REC_VAR0     :  REC  :=    REC_CONST  ;
- 
-           TYPE  ACC_REC  IS  ACCESS REC ;
- 
-           ACC_REC_VAR  :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
-           ACC_REC_VAR0 :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
- 
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      REC ;
-                                R_INOUT : IN OUT  REC )  IS
-           BEGIN
-                REC_VAR   :=  R_IN    ;
-                REC_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  REC ;
-                                L_INOUT : IN OUT  REC )  IS
-           BEGIN
-                L_OUT   :=  REC_CONST ;
-                L_INOUT :=  REC_CONST ;
-           END ;
- 
-      BEGIN
- 
-           R_ASSIGN( ACC_REC_VAR.ALL , ACC_REC_VAR0.ALL );
- 
-           IF  REC_VAR /= ( 17 , 18 , 19 )
-           THEN
-                FAILED( "ACC. RECORD, RIGHT SIDE (1), WRONG VAL.");
-           END IF;
- 
-           IF  REC_VAR0 /= ( 17 , 18 , 19 )
-           THEN
-                FAILED( "ACC. RECORD, RIGHT SIDE (2), WRONG VAL.");
-           END IF;
- 
- 
-           L_ASSIGN( ACC_REC_VAR.ALL , ACC_REC_VAR0.ALL );
- 
-           IF  ACC_REC_VAR.ALL /= ( 7 , 8 , 9 )
-           THEN
-               FAILED( "ACC. RECORD, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
- 
-           IF  ACC_REC_VAR0.ALL /= ( 7 , 8 , 9 )
-           THEN
-                FAILED( "ACC. RECORD, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303n.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- C41303N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |     XXXXXXXXX
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/22/82
- -- RM  1/26/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303N IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303N" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
-                       & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
-                       & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
-                       & " ACTUAL PARAMETER OF ANY MODE" );
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ACCESS TO ARRAY  ----------------------------
- 
-      DECLARE
- 
-           TYPE  ARR  IS  ARRAY(1..2) OF BOOLEAN ;
- 
-           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
-           ARR_VAR      :  ARR  :=    ARR_CONST  ;
-           ARR_VAR0     :  ARR  :=    ARR_CONST  ;
- 
-           TYPE  ACC_ARR  IS  ACCESS ARR ;
- 
-           ACC_ARR_VAR  :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
-           ACC_ARR_VAR0 :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
- 
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      ARR ;
-                                R_INOUT : IN OUT  ARR )  IS
-           BEGIN
-                ARR_VAR   :=  R_IN    ;
-                ARR_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ARR ;
-                                L_INOUT : IN OUT  ARR )  IS
-           BEGIN
-                L_OUT   :=  ARR_CONST ;
-                L_INOUT :=  ARR_CONST ;
-           END ;
- 
-      BEGIN
- 
- 
-           R_ASSIGN( ACC_ARR_VAR.ALL , ACC_ARR_VAR0.ALL );
- 
-           IF  ARR_VAR /= ( FALSE , TRUE )                   
-           THEN
-                FAILED( "ACC. ARRAY, RIGHT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ARR_VAR0 /= ( FALSE , TRUE )
-           THEN
-                FAILED( "ACC. ARRAY, RIGHT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-           L_ASSIGN( ACC_ARR_VAR.ALL , ACC_ARR_VAR0.ALL );
- 
-           IF  ACC_ARR_VAR.ALL /= ( TRUE , FALSE )
-           THEN
-                FAILED( "ACC. ARRAY, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
- 
-           IF  ACC_ARR_VAR0.ALL /= ( TRUE , FALSE )
-           THEN
-                FAILED( "ACC. ARRAY, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C41303O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |     XXXXXXXXX
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/27/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303O IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303O" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
-                       & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
-                       & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
-                       & " ACTUAL PARAMETER OF ANY MODE" );
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ACCESS TO SCALAR  ---------------------------
- 
-      DECLARE
- 
-           TYPE  NEWINT  IS  NEW INTEGER ;
- 
-           NEWINT_CONST    :  NEWINT  :=  813 ;
-           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
-           NEWINT_VAR0     :  NEWINT  :=  NEWINT_CONST  ;
- 
-           TYPE  ACC_NEWINT  IS  ACCESS NEWINT ;
- 
-           ACC_NEWINT_VAR  :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
-           ACC_NEWINT_VAR0 :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
- 
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      NEWINT ;
-                                R_INOUT : IN OUT  NEWINT )  IS
-           BEGIN
-                NEWINT_VAR   :=  R_IN    ;
-                NEWINT_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  NEWINT ;
-                                L_INOUT : IN OUT  NEWINT )  IS
-           BEGIN
-                L_OUT   :=  NEWINT_CONST ;
-                L_INOUT :=  NEWINT_CONST ;
-           END ;
- 
- 
-      BEGIN
- 
-           R_ASSIGN( ACC_NEWINT_VAR.ALL , ACC_NEWINT_VAR0.ALL );
- 
-           IF  NEWINT_VAR /= ( 707 )
-           THEN
-                FAILED( "ACC. NEWINT, RIGHT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  NEWINT_VAR0 /= ( 707 )
-           THEN
-                FAILED( "ACC. NEWINT, RIGHT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-           L_ASSIGN( ACC_NEWINT_VAR.ALL , ACC_NEWINT_VAR0.ALL );
- 
-           IF  ACC_NEWINT_VAR.ALL /= 813 
-           THEN
-                FAILED( "ACC. NEWINT, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ACC_NEWINT_VAR0.ALL /= 813 
-           THEN
-                FAILED( "ACC. NEWINT, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303q.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C41303Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |     XXXXXXXXX
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/28/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303Q IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303Q" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
- 
-      DECLARE
- 
-           TYPE  REC  IS
- 
-                RECORD
-                     A , B , C : INTEGER ;
-                END RECORD ;
- 
- 
-           TYPE  ACCREC  IS  ACCESS REC ;
- 
-           ACCREC_CONST    :  ACCREC  :=  NEW REC'( 7 , 8 , 9 );
-           ACCREC_VAR      :  ACCREC  :=    ACCREC_CONST ;
-           ACCREC_VAR0     :  ACCREC  :=    ACCREC_CONST ;
-           ACCREC_CONST2   :  ACCREC  :=  NEW REC'( 17 , 18 , 19 );
- 
-           TYPE ACC_ACCREC  IS  ACCESS ACCREC ;
- 
-           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
-           ACC_ACCREC_VAR0 :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      ACCREC ;
-                                R_INOUT : IN OUT  ACCREC )  IS
-           BEGIN
-                ACCREC_VAR   :=  R_IN    ;
-                ACCREC_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCREC ;
-                                L_INOUT : IN OUT  ACCREC )  IS
-           BEGIN
-                L_OUT   :=  ACCREC_CONST ;
-                L_INOUT :=  ACCREC_CONST ;
-           END ;
- 
- 
-      BEGIN
- 
- 
-           R_ASSIGN( ACC_ACCREC_VAR.ALL , ACC_ACCREC_VAR0.ALL );
- 
-           IF  ACCREC_VAR /= ACCREC_CONST2
-           THEN
-                FAILED( "ACC. RECORD, RIGHT SIDE (1), WRONG VAL.");
-           END IF;
- 
-           IF  ACCREC_VAR0 /= ACCREC_CONST2
-           THEN
-                FAILED( "ACC. RECORD, RIGHT SIDE (2), WRONG VAL.");
-           END IF;
- 
- 
-           L_ASSIGN( ACC_ACCREC_VAR.ALL , ACC_ACCREC_VAR0.ALL );
- 
-           IF  ACCREC_CONST /= ACC_ACCREC_VAR.ALL 
-           THEN
-               FAILED( "ACC. RECORD, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ACCREC_CONST /= ACC_ACCREC_VAR0.ALL 
-           THEN
-                FAILED( "ACC. RECORD, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303r.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C41303R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |     XXXXXXXXX
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/28/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303R IS
- 
- BEGIN
- 
-      TEST ( "C41303R" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
- 
-      DECLARE
- 
-           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
-           TYPE  ACCARR  IS  ACCESS ARR ;
- 
-           ACCARR_CONST    :  ACCARR  :=  NEW ARR'( TRUE , FALSE );
-           ACCARR_VAR      :  ACCARR  :=    ACCARR_CONST  ;
-           ACCARR_VAR0     :  ACCARR  :=    ACCARR_CONST  ;
-           ACCARR_CONST2   :  ACCARR  :=  NEW ARR'( FALSE , TRUE );
- 
-           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
- 
-           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
-           ACC_ACCARR_VAR0 :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
- 
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      ACCARR ;
-                                R_INOUT : IN OUT  ACCARR )  IS
-           BEGIN
-                ACCARR_VAR   :=  R_IN    ;
-                ACCARR_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCARR ;
-                                L_INOUT : IN OUT  ACCARR )  IS
-           BEGIN
-                L_OUT   :=  ACCARR_CONST ;
-                L_INOUT :=  ACCARR_CONST ;
-           END ;
- 
- 
-      BEGIN
- 
-           R_ASSIGN( ACC_ACCARR_VAR.ALL, ACC_ACCARR_VAR0.ALL );
- 
-           IF  ACCARR_VAR /= ACCARR_CONST2
-           THEN
-                FAILED( "ACC2 ARRAY, RIGHT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ACCARR_VAR0 /= ACCARR_CONST2
-           THEN
-                FAILED( "ACC2 ARRAY, RIGHT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-           L_ASSIGN( ACC_ACCARR_VAR.ALL , ACC_ACCARR_VAR0.ALL );
- 
-           IF  ACCARR_CONST /= ACC_ACCARR_VAR.ALL
-           THEN
-                FAILED( "ACC2. ARRAY, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ACCARR_CONST /= ACC_ACCARR_VAR0.ALL
-           THEN
-                FAILED( "ACC2. ARRAY, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303s.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303s.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303s.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- C41303S.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |     XXXXXXXXX
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/28/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303S IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303S" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
-                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
-                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
- 
-      DECLARE
- 
-           TYPE  NEWINT  IS  NEW INTEGER ;
- 
-           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
- 
-           ACCNEWINT_CONST    :  ACCNEWINT  :=  NEW NEWINT'( 813 );
-           ACCNEWINT_VAR      :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
-           ACCNEWINT_VAR0     :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
-           ACCNEWINT_CONST2   :  ACCNEWINT  :=  NEW NEWINT'( 707 );
- 
-           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
- 
-           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
-                                                        ACCNEWINT_CONST2
-                                                                 );
- 
-           ACC_ACCNEWINT_VAR0 :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
-                                                        ACCNEWINT_CONST2
-                                                                 );
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      ACCNEWINT ;
-                                R_INOUT : IN OUT  ACCNEWINT )  IS
-           BEGIN
-                ACCNEWINT_VAR   :=  R_IN    ;
-                ACCNEWINT_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCNEWINT ;
-                                L_INOUT : IN OUT  ACCNEWINT )  IS
-           BEGIN
-                L_OUT   :=  ACCNEWINT_CONST ;
-                L_INOUT :=  ACCNEWINT_CONST ;
-           END ;
- 
- 
-      BEGIN
- 
-           R_ASSIGN( ACC_ACCNEWINT_VAR.ALL , ACC_ACCNEWINT_VAR0.ALL  );
- 
-           IF  ACCNEWINT_VAR /= ACCNEWINT_CONST2
-           THEN
-                FAILED( "ACC. NEWINT, RIGHT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ACCNEWINT_VAR0 /= ACCNEWINT_CONST2
-           THEN
-                FAILED( "ACC. NEWINT, RIGHT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-           L_ASSIGN( ACC_ACCNEWINT_VAR.ALL , ACC_ACCNEWINT_VAR0.ALL  );
- 
-           IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL
-           THEN
-                FAILED( "ACC. NEWINT, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR0.ALL
-           THEN
-                FAILED( "ACC. NEWINT, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303S;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303u.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303u.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303u.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C41303U.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |     XXXXXXXXX
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/29/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303U IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303U" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
-                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
-                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
-                         " ACCEPTED" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
- 
-      DECLARE
- 
-              TYPE  REC  IS
- 
-                RECORD
-                     A , B , C : INTEGER ;
-                END RECORD ;
- 
- 
-           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
-           REC_VAR      :  REC  :=    REC_CONST  ;
-           REC_VAR0     :  REC  :=    REC_CONST  ;
-           REC_CONST2   :  REC  :=  ( 17 , 18 , 19 );
- 
-           TYPE  ACCREC  IS  ACCESS REC ;
- 
-           TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
- 
-           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'( 
-                                             NEW REC'( REC_CONST2 )
-                                                       );
- 
-           ACC_ACCREC_VAR0 :  ACC_ACCREC :=  NEW ACCREC'( 
-                                             NEW REC'( REC_CONST2 )
-                                                       );
- 
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      REC ;
-                                R_INOUT : IN OUT  REC )  IS
-           BEGIN
-                REC_VAR   :=  R_IN    ;
-                REC_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  REC ;
-                                L_INOUT : IN OUT  REC )  IS
-           BEGIN
-                L_OUT   :=  REC_CONST ;
-                L_INOUT :=  REC_CONST ;
-           END ;
- 
- 
-      BEGIN
- 
-           R_ASSIGN( ACC_ACCREC_VAR.ALL.ALL , ACC_ACCREC_VAR0.ALL.ALL );
- 
-           IF  REC_VAR /= REC_CONST2
-           THEN
-                FAILED( "ACC2 RECORD, RIGHT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  REC_VAR0 /= REC_CONST2
-           THEN
-                FAILED( "ACC2 RECORD, RIGHT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-           L_ASSIGN( ACC_ACCREC_VAR.ALL.ALL , ACC_ACCREC_VAR0.ALL.ALL );
- 
-           IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR.ALL.ALL 
-           THEN
-                FAILED( "ACC2 RECORD, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR0.ALL.ALL 
-           THEN
-                FAILED( "ACC2 RECORD, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303U;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303v.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303v.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303v.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- C41303V.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |     XXXXXXXXX
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ============================================================
- 
- 
- -- RM  1/29/82
- -- SPS 12/2/82
- 
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303V IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303V" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
-                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
-                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
-                         " ACCEPTED" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
- 
-      DECLARE
- 
-           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
- 
-           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
-           ARR_VAR      :  ARR  :=    ARR_CONST  ;
-           ARR_VAR0     :  ARR  :=    ARR_CONST  ;
-           ARR_CONST2   :  ARR  :=  ( FALSE , TRUE );
- 
-           TYPE  ACCARR  IS  ACCESS ARR ;
- 
-           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
- 
-           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(
-                                             NEW ARR'( ARR_CONST2 )
-                                                       );
- 
-           ACC_ACCARR_VAR0 :  ACC_ACCARR :=  NEW ACCARR'(
-                                             NEW ARR'( ARR_CONST2 )
-                                                       );
- 
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      ARR ;
-                                R_INOUT : IN OUT  ARR )  IS
-           BEGIN
-                ARR_VAR   :=  R_IN    ;
-                ARR_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ARR ;
-                                L_INOUT : IN OUT  ARR )  IS
-           BEGIN
-                L_OUT   :=  ARR_CONST ;
-                L_INOUT :=  ARR_CONST ;
-           END ;
- 
- 
-      BEGIN
- 
- 
-           R_ASSIGN( ACC_ACCARR_VAR.ALL.ALL , ACC_ACCARR_VAR0.ALL.ALL );
- 
-           IF  ARR_VAR /= ARR_CONST2
-           THEN
-                FAILED( "ACC2 ARRAY, RIGHT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ARR_VAR0 /= ARR_CONST2
-           THEN
-                FAILED( "ACC2 ARRAY, RIGHT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-           L_ASSIGN( ACC_ACCARR_VAR.ALL.ALL , ACC_ACCARR_VAR0.ALL.ALL );
- 
-           IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR.ALL.ALL
-           THEN
-                FAILED( "ACC2 ARRAY, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR0.ALL.ALL
-           THEN
-                FAILED( "ACC2 ARRAY, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303V;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303w.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303w.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41303w.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41303w.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- C41303W.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
- --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
- --     ANOTHER ACCESS OBJECT.
- -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
- --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
- --     ACCEPTED.
- 
- 
- -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
- --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
- 
- 
- --                              ||   ASSIGNMT  |  PROC. PARAMETERS
- --                              ||  ():=  :=() | IN   OUT    IN OUT
- --      ========================||=============|====================
- --                 ACC REC      ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ARR      ||             |
- --                --------------||-------------|--------------------
- --                 ACC SCLR     ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       1 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |
- --      ========================||=============|====================
- --                 ACC ACC REC  ||             |
- --                --------------||-------------|--------------------
- --       2 '.ALL'  ACC ACC ARR  ||             |
- --                --------------||-------------|--------------------
- --                 ACC ACC SCLR ||             |     XXXXXXXXX
- --      ============================================================
- 
- 
- -- RM  1/29/82
- -- SPS 12/2/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41303W IS
- 
- 
- BEGIN
- 
-      TEST ( "C41303W" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
-                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
-                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
-                         " ACCEPTED" );
- 
- 
-      -------------------------------------------------------------------
-      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
- 
-      DECLARE
- 
-           TYPE  NEWINT  IS  NEW INTEGER ;
- 
-           NEWINT_CONST    :  NEWINT  :=  ( 813 );
-           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
-           NEWINT_VAR0     :  NEWINT  :=  NEWINT_CONST  ;
-           NEWINT_CONST2   :  NEWINT  :=  ( 707 );
- 
-           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
- 
-           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
- 
-           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
-                                                    NEW NEWINT' ( 
-                                                    NEWINT_CONST2
-                                                               )
-                                                                 );
- 
-           ACC_ACCNEWINT_VAR0 :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
-                                                    NEW NEWINT' ( 
-                                                    NEWINT_CONST2
-                                                               )
-                                                                 );
- 
-           PROCEDURE  R_ASSIGN( R_IN    : IN      NEWINT ;
-                                R_INOUT : IN OUT  NEWINT )  IS
-           BEGIN
-                NEWINT_VAR   :=  R_IN    ;
-                NEWINT_VAR0  :=  R_INOUT ;
-           END ;
- 
- 
-           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  NEWINT ;
-                                L_INOUT : IN OUT  NEWINT )  IS
-           BEGIN
-                L_OUT   :=  NEWINT_CONST ;
-                L_INOUT :=  NEWINT_CONST ;
-           END ;
- 
- 
-      BEGIN
- 
- 
-           R_ASSIGN( ACC_ACCNEWINT_VAR.ALL.ALL  ,
-                     ACC_ACCNEWINT_VAR0.ALL.ALL );
- 
-           IF  NEWINT_VAR /= NEWINT_CONST2
-           THEN
-                FAILED( "ACC2 NEWINT, RIGHT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  NEWINT_VAR0 /= NEWINT_CONST2
-           THEN
-                FAILED( "ACC2 NEWINT, RIGHT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-           L_ASSIGN( ACC_ACCNEWINT_VAR.ALL.ALL  ,
-                     ACC_ACCNEWINT_VAR0.ALL.ALL );
- 
-           IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL.ALL
-           THEN
-                FAILED( "ACC2 NEWINT, LEFT SIDE (1), WRONG VAL." );
-           END IF;
- 
-           IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR0.ALL.ALL
-           THEN
-                FAILED( "ACC2 NEWINT, LEFT SIDE (2), WRONG VAL." );
-           END IF;
- 
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41303W;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41304a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41304a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41304a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- C41304A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT L.R RAISES CONSTRAINT_ERROR WHEN:
- --       L DENOTES AN ACCESS OBJECT HAVING THE VALUE NULL.
- --       L IS A FUNCTION CALL DELIVERING THE ACCESS VALUE NULL.
- 
- -- HISTORY:
- --     WKB 08/14/81
- --     JRK 08/17/81
- --     SPS 10/26/82
- --     TBN 03/26/86  PUT THE NON-EXISTENT COMPONENT CASES INTO C41304B.
- --     JET 01/05/88  MODIFIED HEADER FORMAT AND ADDED CODE TO PREVENT
- --                   OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41304A IS
- 
-      TYPE R IS
-           RECORD
-                I : INTEGER;
-           END RECORD;
- 
-      TYPE T IS ACCESS R;
- 
- BEGIN
-      TEST ("C41304A", "CONSTRAINT_ERROR WHEN L IN L.R DENOTES A NULL " &
-                       "ACCESS OBJECT OR A FUNCTION CALL DELIVERING " &
-                       "NULL");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           A : T := NEW R' (I => 1);
-           J : INTEGER;
- 
-      BEGIN
- 
-           IF EQUAL (4, 4) THEN
-                A := NULL;
-           END IF;
- 
-           J := A.I;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A NULL ACCESS " &
-                   "OBJECT");
- 
-           IF EQUAL (J,J) THEN
-                COMMENT ("NO EXCEPTION RAISED");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR A NULL ACCESS " &
-                        "OBJECT");
- 
-      END;
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           J : INTEGER;
- 
-           FUNCTION F RETURN T IS
-           BEGIN
-                IF EQUAL (4, 4) THEN
-                     RETURN NULL;
-                END IF;
-                RETURN NEW R' (I => 2);
-           END F;
- 
-      BEGIN
- 
-           J := F.I;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
-                   "DELIVERING A NULL ACCESS VALUE");
- 
-           IF EQUAL (J,J) THEN
-                COMMENT ("NO EXCEPTION RAISED");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
-                        "DELIVERING A NULL ACCESS VALUE");
- 
-      END;
- 
-      RESULT;
- END C41304A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41304b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41304b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41304b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41304b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- C41304B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT L.R RAISES CONSTRAINT_ERROR WHEN:
- --        L DENOTES A RECORD OBJECT SUCH THAT, FOR THE EXISTING
- --           DISCRIMINANT VALUES, THE COMPONENT DENOTED BY R DOES
- --           NOT EXIST.
- --        L IS A FUNCTION CALL DELIVERING A RECORD VALUE SUCH THAT,
- --           FOR THE EXISTING DISCRIMINANT VALUES, THE COMPONENT
- --           DENOTED BY R DOES NOT EXIST.
- --        L IS AN ACCESS OBJECT AND THE OBJECT DESIGNATED BY THE ACCESS
- --           VALUE IS SUCH THAT COMPONENT R DOES NOT EXIST FOR THE
- --           OBJECT'S CURRENT DISCRIMINANT VALUES.
- --        L IS A FUNCTION CALL RETURNING AN ACCESS VALUE AND THE OBJECT
- --           DESIGNATED BY THE ACCESS VALUE IS SUCH THAT COMPONENT R
- --           DOES NOT EXIST FOR THE OBJECT'S CURRENT DISCRIMINANT
- --           VALUES.
- 
- -- HISTORY:
- --     TBN 05/23/86  CREATED ORIGINAL TEST.
- --     JET 01/08/88  MODIFIED HEADER FORMAT AND ADDED CODE TO
- --                   PREVENT OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41304B IS
- 
-      TYPE V (DISC : INTEGER := 0) IS
-           RECORD
-                CASE DISC IS
-                     WHEN 1 =>
-                          X : INTEGER;
-                     WHEN OTHERS =>
-                          Y : INTEGER;
-                END CASE;
-           END RECORD;
- 
-      TYPE T IS ACCESS V;
- 
- BEGIN
-      TEST ("C41304B", "CHECK THAT L.R RAISES CONSTRAINT_ERROR WHEN " &
-                       "THE COMPONENT DENOTED BY R DOES NOT EXIST");
- 
-      DECLARE
- 
-           VR : V := (DISC => 0, Y => 4);
-           J : INTEGER;
- 
-      BEGIN
- 
-           IF EQUAL (4, 4) THEN
-                VR := (DISC => 1, X => 3);
-           END IF;
- 
-           J := VR.Y;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A RECORD OBJECT");
- 
-           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
- 
-           IF EQUAL (J,3) THEN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR A RECORD OBJECT");
- 
-      END;
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           J : INTEGER;
- 
-           FUNCTION F RETURN V IS
-           BEGIN
-                IF EQUAL (4, 4) THEN
-                     RETURN (DISC => 2, Y => 3);
-                END IF;
-                RETURN (DISC => 1, X => 4);
-           END F;
- 
-      BEGIN
- 
-           J := F.X;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
-                   "DELIVERING A RECORD VALUE");
- 
-           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
- 
-           IF EQUAL (J,3) THEN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
-                        "DELIVERING A RECORD VALUE");
- 
-      END;
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           A : T := NEW V' (DISC => 0, Y => 4);
-           J : INTEGER;
- 
-      BEGIN
- 
-           IF EQUAL (4, 4) THEN
-                A := NEW V' (DISC => 1, X => 3);
-           END IF;
- 
-           J := A.Y;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR AN ACCESS OBJECT");
- 
-           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
- 
-           IF EQUAL (J,3) THEN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR AN ACCESS OBJECT");
- 
-      END;
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           J : INTEGER;
- 
-           FUNCTION F RETURN T IS
-           BEGIN
-                IF EQUAL (4, 4) THEN
-                     RETURN NEW V' (DISC => 2, Y => 3);
-                END IF;
-                RETURN NEW V' (DISC => 1, X => 4);
-           END F;
- 
-      BEGIN
- 
-           J := F.X;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
-                   "DELIVERING AN ACCESS VALUE");
- 
-           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
- 
-           IF EQUAL (J,3) THEN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
-                        "DELIVERING AN ACCESS VALUE");
- 
-      END;
- 
-      RESULT;
- END C41304B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41306a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41306a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41306a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41306a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C41306A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF  F  IS A FUNCTION RETURNING A TASK OF A TYPE HAVING
- --     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
- --
- --                           F.E
- --
- --     IS PERMITTED.
- 
- 
- -- RM  2/2/82
- -- ABW 7/16/82
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C41306A IS
- 
- 
- BEGIN
- 
-      TEST ( "C41306A" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
-                         " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
-                         " ENTRY CALL OF THE FORM  F.E  IS PERMITTED");
- 
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           X  : INTEGER  :=  0 ;
- 
-           TASK TYPE  T  IS
-                ENTRY  E ;
-           END  T ;
- 
-           T1 : T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  E  DO
-                     X := IDENT_INT(17) ;
-                END  E ;
-                ACCEPT  E  DO
-                     X := IDENT_INT(16) ;
-                END  E ;
-           END  T ;
- 
-           FUNCTION  F1  RETURN  T  IS
-           BEGIN
-                RETURN  T1 ;
-           END  F1 ;
- 
-           FUNCTION F2 (A,B : BOOLEAN) RETURN T IS
-           BEGIN
-                IF A AND B THEN NULL; END IF;
-                RETURN T1;
-           END F2;
- 
-      BEGIN
- 
-           F1.E ;                                  -- X SET TO 17.
- 
-           IF  X /= 17 THEN
-                FAILED("WRONG VALUE FOR GLOBAL VARIABLE - 1");
-           END IF;
- 
-           X := 0;
-           F2(TRUE,TRUE).E;                        -- X SET TO 16.
-                             -- X TO BE SET TO 16.
- 
-           IF X /= 16 THEN
-                FAILED("WRONG VALUE FOR GLOBAL VARIABLE - 2");
-           END IF;
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- 
- END C41306A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41306b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41306b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41306b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41306b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,217 ****
- -- C41306B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF  F  IS A FUNCTION RETURNING AN ACCESS VALUE DESIGNATING
- --     A TASK OF A TYPE HAVING
- --     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
- --
- --                           F.ALL.E
- --
- --     IS PERMITTED.
- 
- -- RM  02/02/82
- -- ABW 07/16/82
- -- EG  05/28/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C41306B IS
- 
- BEGIN
- 
-      TEST ( "C41306B" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
-                         " AN ACCESS VALUE DESIGNATING"              &
-                         " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
-                         " ENTRY CALL OF THE FORM  F.ALL.E  IS"       &
-                         " PERMITTED" );
- 
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           X  : INTEGER  :=  0 ;
- 
-           TASK TYPE  T  IS
-                ENTRY  E ;
-           END  T ;
- 
-           TYPE  A_T  IS  ACCESS T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  E  DO
-                     X := IDENT_INT(17) ;
-                END  E ;
-           END  T ;
- 
-           FUNCTION  F1  RETURN  A_T  IS
-                A_T_VAR1 : A_T := NEW T ;
-           BEGIN
-                RETURN  A_T_VAR1 ;
-           END  F1 ;
- 
-           FUNCTION F2 (A, B : BOOLEAN) RETURN A_T IS
-                A_T_VAR2 : A_T := NEW T;
-           BEGIN
-                IF A AND B THEN
-                     NULL;
-                END IF;
-                RETURN A_T_VAR2;
-           END F2;
- 
-      BEGIN
- 
-           F1.ALL.E ;  --  THE ELABOR. OF  F1 (BODY)  ACTIVATES THE TASK,
-                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
-                       --      BE CALLED.
- 
-                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
- 
-           IF  X /= 17
-           THEN
-                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (1)" );
-           END IF;
- 
-           X := 0;
-           F2(TRUE, TRUE).ALL.E;    -- THE ELABORATION OF F2 (BODY)
-                                    -- ACTIVATES THE TASK, WHICH 
-                                    -- PROCEEDS TO WAIT FOR THE
-                                    -- ENTRY E TO BE CALLED.
- 
-                                    -- THE CALLED ENTRY CAUSES X TO BE 
-                                    -- SET TO 17.
- 
-           IF X /= 17 THEN
-                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (2)");
-           END IF;
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           X  : INTEGER  :=  0 ;
- 
-           TASK TYPE  T  IS
-                ENTRY  E ;
-           END  T ;
- 
-           TYPE  A_T  IS  ACCESS T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  E  DO
-                     X := IDENT_INT(17) ;
-                END  E ;
-           END  T ;
- 
-           FUNCTION  F3  RETURN  A_T  IS
-           BEGIN
-                RETURN  NEW T ;
-           END  F3;
- 
-           FUNCTION F4 (C, D : BOOLEAN) RETURN A_T IS
-           BEGIN
-                IF C AND D THEN
-                     NULL;
-                END IF;
-                RETURN NEW T;
-           END F4;
- 
-      BEGIN
- 
-           F3.ALL.E ;  --  THE ELABOR. OF  F3 (BODY)  ACTIVATES THE TASK,
-                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
-                       --      BE CALLED.
- 
-                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
- 
-           IF  X /= 17
-           THEN
-                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (3)" );
-           END IF;
- 
-           X := 0;
-           F4(TRUE, TRUE).ALL.E;    -- THE ELABORATION OF F4 (BODY)
-                                    -- ACTIVATES THE TASK, WHICH
-                                    -- PROCEEDS TO WAIT FOR THE
-                                    -- ENTRY E TO BE CALLED.
- 
-                                    -- THE CALLED ENTRY CAUSES X TO BE
-                                    -- SET TO 17.
- 
-           IF X /= 17 THEN
-                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (4)");
-           END IF;
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           X  : INTEGER  :=  0 ;
- 
-           TASK TYPE  T  IS
-                ENTRY  E ;
-           END  T ;
- 
-           TYPE  A_T  IS  ACCESS T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  E  DO
-                     X := IDENT_INT(17) ;
-                END  E ;
-           END  T ;
- 
-      BEGIN
- 
-           DECLARE
- 
-                F3 : A_T := NEW T;
- 
-           BEGIN
- 
-                F3.ALL.E;
- 
-                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
- 
-                IF  X /= 17 THEN
-                     FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (5)" );
-                END IF;
- 
-           END;
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT;
- 
- 
- END C41306B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41306c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41306c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41306c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41306c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- C41306C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF  F  IS A FUNCTION RETURNING AN ACCESS VALUE DESIGNATING
- --     A TASK OF A TYPE HAVING
- --     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
- --
- --                           F.E
- --
- --     IS PERMITTED.
- 
- 
- -- RM  02/02/82
- -- ABW 07/16/82
- -- EG  05/28/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C41306C IS
- 
- BEGIN
- 
-      TEST ( "C41306C" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
-                         " AN ACCESS VALUE DESIGNATING"              &
-                         " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
-                         " ENTRY CALL OF THE FORM  F.E  IS PERMITTED" );
- 
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           X  : INTEGER  :=  0 ;
- 
-           TASK TYPE  T  IS
-                ENTRY  E ;
-           END  T ;
- 
-           TYPE  A_T  IS  ACCESS T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  E  DO
-                     X := IDENT_INT(17) ;
-                END  E ;
-           END  T ;
- 
-           FUNCTION  F1  RETURN  A_T  IS
-                A_T_VAR1 : A_T := NEW T ;
-           BEGIN
-                RETURN  A_T_VAR1 ;
-           END  F1 ;
- 
-           FUNCTION F2 (A, B : BOOLEAN) RETURN A_T IS
-                A_T_VAR2 : A_T := NEW T;
-           BEGIN
-                IF A AND B THEN
-                     NULL;
-                END IF;
-                RETURN A_T_VAR2;
-           END F2;
- 
-      BEGIN
- 
-           F1.E ;      --  THE ELABOR. OF  F1 (BODY)  ACTIVATES THE TASK,
-                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
-                       --      BE CALLED.
- 
-                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
- 
-           IF  X /= 17
-           THEN
-                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (1)" );
-           END IF;
- 
-           X := 0;
-           F2(TRUE, TRUE).E;   -- THE ELABORATION OF F2 (BODY) ACTIVATES
-                               -- THE TASK, WHICH PROCEEDS TO WAIT FOR
-                               -- ENTRY E TO BE CALLED.
- 
-                               -- THE CALLED ENTRY CAUSES X TO BE SET TO
-                               -- 17.
- 
-           IF X /= 17 THEN
-                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (2)");
-           END IF;
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           X  : INTEGER  :=  0 ;
- 
-           TASK TYPE  T  IS
-                ENTRY  E ;
-           END  T ;
- 
-           TYPE  A_T  IS  ACCESS T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  E  DO
-                     X := IDENT_INT(17) ;
-                END  E ;
-           END  T ;
- 
-           FUNCTION  F3  RETURN  A_T  IS
-           BEGIN
-                RETURN  NEW T ;
-           END  F3;
- 
-           FUNCTION F4 (C, D : BOOLEAN) RETURN A_T IS
-           BEGIN
-                IF C AND D THEN
-                     NULL;
-                END IF;
-                RETURN NEW T;
-           END F4;
- 
-      BEGIN
- 
-           F3.E ;      --  THE ELABOR. OF  F3 (BODY)  ACTIVATES THE TASK,
-                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
-                       --      BE CALLED.
- 
-                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
- 
-           IF  X /= 17
-           THEN
-                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (3)" );
-           END IF;
- 
-           X := 0;
-           F4(TRUE, TRUE).E;   -- THE ELABORATION OF F4 (BODY) ACTIVATES
-                               -- THE TASK WHICH PROCEEDS TO WAIT FOR
-                               -- ENTRY E TO BE CALLED.
- 
-                               -- THE CALLED ENTRY CAUSES X TO BE SET TO
-                               -- 17.
- 
-           IF X /= 17 THEN
-                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (4)");
-           END IF;
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           X  : INTEGER  :=  0 ;
- 
-           TASK TYPE  T  IS
-                ENTRY  E ;
-           END  T ;
- 
-           TYPE  A_T  IS  ACCESS T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  E  DO
-                     X := IDENT_INT(17) ;
-                END  E ;
-           END  T ;
- 
-      BEGIN
- 
-           DECLARE
- 
-                F3 : A_T := NEW T;
- 
-           BEGIN
- 
-                F3.E;
- 
-                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
- 
-                IF  X /= 17 THEN
-                     FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (5)" );
-                END IF;
- 
-           END;
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT;
- 
- 
- END C41306C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41307d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41307d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41307d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41307d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,255 ****
- -- C41307D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, GENERIC PACKAGE,
- -- SUBPROGRAM, GENERIC SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT
- -- STATEMENT NAMED L, IF R IS DECLARED INSIDE THE UNIT.
- 
- -- TBN 12/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41307D IS
- 
- BEGIN
-      TEST ("C41307D", "CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, " &
-                       "GENERIC PACKAGE, SUBPROGRAM, GENERIC " &
-                       "SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT " &
-                       "STATEMENT NAMED L, IF R IS DECLARED INSIDE " &
-                       "THE UNIT");
-      DECLARE
-           PACKAGE L IS
-                R : INTEGER := 5;
-                A : INTEGER := L.R;
-           END L;
- 
-           PACKAGE BODY L IS
-                B : INTEGER := L.R + 1;
-           BEGIN
-                IF IDENT_INT(A) /= 5 OR IDENT_INT(B) /= 6 THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-                END IF;
-           END L;
- 
-           GENERIC
-                S : INTEGER;
-           PACKAGE M IS
-                X : INTEGER := M.S;
-           END M;
- 
-           PACKAGE BODY M IS
-                Y : INTEGER := M.S + 1;
-           BEGIN
-                IF IDENT_INT(X) /= 2 OR
-                   IDENT_INT(Y) /= 3 OR
-                   IDENT_INT(M.X) /= 2 THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-                END IF;
-           END M;
- 
-           PACKAGE Q IS NEW M(2);
-      BEGIN
-           IF IDENT_INT(Q.X) /= 2 THEN
-                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-           END IF;
-      END;
-      -------------------------------------------------------------------
- 
-      DECLARE
-           CH : CHARACTER := '6';
- 
-           PROCEDURE L (R : IN OUT CHARACTER) IS
-                A : CHARACTER := L.R;
-           BEGIN
-                IF IDENT_CHAR(L.A) /= '6' THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-                END IF;
-                L.R := IDENT_CHAR('7');
-           END L;
- 
-           GENERIC
-                S : CHARACTER;
-           PROCEDURE M;
- 
-           PROCEDURE M IS
-                T : CHARACTER := M.S;
-           BEGIN
-                IF IDENT_CHAR(T) /= '3' OR IDENT_CHAR(M.S) /= '3' THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
-                END IF;
-           END M;
- 
-           PROCEDURE P1 IS NEW M('3');
- 
-      BEGIN
-           L (CH);
-           IF CH /= IDENT_CHAR('7') THEN
-                FAILED ("INCORRECT RESULTS RETURNED FROM PROCEDURE - 6");
-           END IF;
-           P1;
-      END;
-      -------------------------------------------------------------------
- 
-      DECLARE
-           INT : INTEGER := 3;
- 
-           FUNCTION L (R : INTEGER) RETURN INTEGER IS
-                A : INTEGER := L.R;
-           BEGIN
-                IF IDENT_INT(L.A) /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
-                END IF;
-                RETURN IDENT_INT(4);
-           END L;
- 
-           GENERIC
-                S : INTEGER;
-           FUNCTION M RETURN INTEGER;
- 
-           FUNCTION M RETURN INTEGER IS
-                T : INTEGER := M.S;
-           BEGIN
-                IF IDENT_INT(M.T) /= 4 OR M.S /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
-                END IF;
-                RETURN IDENT_INT(1);
-           END M;
- 
-           FUNCTION F1 IS NEW M(4);
- 
-      BEGIN
-           IF L(INT) /= 4 OR F1 /= 1 THEN
-                FAILED ("INCORRECT RESULTS RETURNED FROM FUNCTION - 9");
-           END IF;
-      END;
-      -------------------------------------------------------------------
- 
-      DECLARE
-           TASK L IS
-                ENTRY E (A : INTEGER);
-           END L;
- 
-           TASK TYPE M IS
-                ENTRY E1 (A : INTEGER);
-           END M;
- 
-           T1 : M;
- 
-           TASK BODY L IS
-                X : INTEGER := IDENT_INT(1);
-                R : INTEGER RENAMES X;
-                Y : INTEGER := L.R;
-           BEGIN
-                X := X + L.R;
-                IF X /= IDENT_INT(2) OR Y /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
-                             "10");
-                END IF;
-           END L;
- 
-           TASK BODY M IS
-                X : INTEGER := IDENT_INT(2);
-                R : INTEGER RENAMES X;
-                Y : INTEGER := M.R;
-           BEGIN
-                ACCEPT E1 (A : INTEGER) DO
-                     X := X + M.R;
-                     IF X /= IDENT_INT(4) OR Y /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
-                                  "NAME - 11");
-                     END IF;
-                     IF E1.A /= IDENT_INT(3) THEN
-                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
-                                  "NAME - 12");
-                     END IF;
-                END E1;
-           END M;
-      BEGIN
-           T1.E1 (3);
-      END;
-      -------------------------------------------------------------------
- 
-      DECLARE
-           TASK T IS
-                ENTRY G (1..2) (A : INTEGER);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT G (1) (A : INTEGER) DO
-                     IF G.A /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
-                                  "NAME - 13");
-                     END IF;
-                     BLK:
-                          DECLARE
-                               B : INTEGER := 7;
-                          BEGIN
-                               IF T.BLK.B /= IDENT_INT(7) THEN
-                                    FAILED ("INCORRECT RESULTS FROM " &
-                                            "EXPANDED NAME - 14");
-                               END IF;
-                          END BLK;
-                END G;
-                ACCEPT G (2) (A : INTEGER) DO
-                     IF G.A /= IDENT_INT(1) THEN
-                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
-                                  "NAME - 15");
-                     END IF;
-                END G;
-           END T;
-      BEGIN
-           T.G (1) (2);
-           T.G (2) (1);
-      END;
-      -------------------------------------------------------------------
- 
-      SWAP:
-           DECLARE
-                VAR : CHARACTER := '*';
-                RENAME_VAR : CHARACTER RENAMES VAR;
-                NEW_VAR : CHARACTER;
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     NEW_VAR := SWAP.RENAME_VAR;
-                END IF;
-                IF NEW_VAR /= IDENT_CHAR('*') THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
-                             "16");
-                END IF;
-                LP:  FOR I IN 1..2 LOOP
-                          IF SWAP.LP.I = IDENT_INT(2) OR
-                             LP.I = IDENT_INT(1) THEN
-                               GOTO SWAP.LAB1;
-                          END IF;
-                          NEW_VAR := IDENT_CHAR('+');
-                          <<LAB1>>
-                          NEW_VAR := IDENT_CHAR('-');
-                     END LOOP LP;
-                IF NEW_VAR /= IDENT_CHAR('-') THEN
-                     FAILED ("INCORRECT RESULTS FROM FOR LOOP - 17");
-                END IF;
-           END SWAP;
- 
-      RESULT;
- END C41307D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41309a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41309a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41309a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41309a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- C41309A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXPANDED NAME IS ALLOWED EVEN IF A USE CLAUSE MAKES THE
- -- EXPANDED NAME UNNECESSARY.
- 
- -- TBN  12/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41309A IS
- 
- BEGIN
-      TEST ("C41309A", "CHECK THAT AN EXPANDED NAME IS ALLOWED EVEN " &
-                       "IF A USE CLAUSE MAKES THE EXPANDED NAME " &
-                       "UNNECESSARY");
-      DECLARE
-           PACKAGE P IS
-                PACKAGE Q IS
-                     PACKAGE R IS
-                          TYPE REC IS
-                               RECORD
-                                    A : INTEGER := 5;
-                                    B : BOOLEAN := TRUE;
-                               END RECORD;
-                          REC1 : REC;
-                     END R;
- 
-                     USE R;
- 
-                     REC2 : R.REC := R.REC1;
-                END Q;
- 
-                USE Q; USE R;
- 
-                REC3 : Q.R.REC := Q.REC2;
-           END P;
- 
-           USE P; USE Q; USE R;
- 
-           REC4 : P.Q.R.REC := P.REC3;
-      BEGIN
-           IF REC4 /= (IDENT_INT(5), IDENT_BOOL(TRUE)) THEN
-                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME");
-           END IF;
-      END;
- 
-      RESULT;
- END C41309A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41320a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41320a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41320a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41320a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C41320A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT IMPLICITLY DECLARED ENUMERATION LITERALS, CHARACTER
- --    LITERALS, AND THE RELATIONAL OPERATORS CAN BE SELECTED FROM
- --    OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR ENUMERATION TYPES.
- 
- -- HISTORY:
- --    TBN 07/15/86  CREATED ORIGINAL TEST.
- --    JET 08/04/87  ADDED TEST FOR OVERLOADED VARIABLES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41320A IS
- 
-      PACKAGE P IS
-           TYPE FLAG IS (RED, WHITE, BLUE);
-           TYPE ROMAN_DIGITS IS ('I', 'V', 'X', 'C', 'M');
-           TYPE TRAFFIC_LIGHT IS (RED, YELLOW, GREEN);
-           TYPE HEX IS ('A', 'B', 'C', 'D', 'E', 'F');
-           FLAG_COLOR_1 : FLAG := RED;
-           FLAG_COLOR_2 : FLAG := WHITE;
-           TRAFFIC_LIGHT_COLOR_1 : FLAG := RED;
-           HEX_3 : HEX := 'C';
-           ROMAN_1 : ROMAN_DIGITS := 'I';
-      END P;
- 
-      USA_FLAG_1 : P.FLAG := P.RED;
-      USA_FLAG_3 : P.FLAG := P.BLUE;
-      HEX_CHAR_3 : P.HEX := P.'C';
-      ROMAN_DIGITS_4 : P.ROMAN_DIGITS := P.'C';
-      TRAFFIC_LIGHT_1 : P.TRAFFIC_LIGHT := P.RED;
- 
- BEGIN
-      TEST ("C41320A", "CHECK THAT IMPLICITLY DECLARED ENUMERATION " &
-                       "LITERALS, CHARACTER LITERALS, AND THE " &
-                       "RELATIONAL OPERATORS CAN BE SELECTED FROM " &
-                       "OUTSIDE THE PACKAGE USING AN EXPANDED NAME " &
-                       "FOR ENUMERATION TYPES");
- 
-      IF P."/=" (USA_FLAG_1, P.FLAG_COLOR_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."=" (USA_FLAG_3, P.FLAG_COLOR_2) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      IF P."<" (HEX_CHAR_3, P.HEX_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-      END IF;
- 
-      IF P.">" (P.ROMAN_1, ROMAN_DIGITS_4) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-      END IF;
- 
-      IF P.">=" (TRAFFIC_LIGHT_1, P.TRAFFIC_LIGHT'PRED (P.GREEN)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
-      END IF;
- 
-      FOR J IN P.FLAG'(P.WHITE) .. P.FLAG'(P.WHITE) LOOP
-           IF P."<=" (P.FLAG'SUCC (P.WHITE), J) THEN
-                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
-           END IF;
-      END LOOP;
- 
-      IF P.">=" (P.RED, P.GREEN) THEN
-           FAILED ("INCORRECT RESULT FROM OVERLOADED VARIABLE NAME - 1");
-      END IF;
- 
-      IF P."<=" (P.BLUE, P.RED) THEN
-           FAILED ("INCORRECT RESULT FROM OVERLOADED VARIABLE NAME - 2");
-      END IF;
- 
-      RESULT;
- END C41320A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41321a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41321a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41321a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41321a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- C41321A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS, LOGICAL 
- -- OPERATORS, AND THE "NOT" OPERATOR MAY BE SELECTED FROM OUTSIDE
- -- THE PACKAGE USING AN EXPANDED NAME, FOR A DERIVED BOOLEAN TYPE.
- 
- -- TBN  7/16/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41321A IS
- 
-      PACKAGE P IS
-           TYPE DERIVED_BOOLEAN IS NEW BOOLEAN RANGE FALSE .. TRUE;
-           DERIVED_FALSE : DERIVED_BOOLEAN := FALSE;
-           DERIVED_TRUE : DERIVED_BOOLEAN := TRUE;
-      END P;
- 
-      DBOOL_FALSE : P.DERIVED_BOOLEAN := P.FALSE;
-      DBOOL_TRUE : P.DERIVED_BOOLEAN := P.TRUE;
- 
- BEGIN
-      TEST ("C41321A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
-                       "OPERATORS, LOGICAL OPERATORS, AND THE 'NOT' " &
-                       "OPERATOR MAY BE SELECTED FROM OUTSIDE THE " &
-                       "PACKAGE USING AN EXPANDED NAME, FOR A DERIVED " &
-                       "BOOLEAN TYPE");
- 
-      IF P."=" (DBOOL_FALSE, P.DERIVED_TRUE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."/=" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      IF P."<" (P.DERIVED_TRUE, P.DERIVED_FALSE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-      END IF;
- 
-      IF P.">" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-      END IF;
- 
-      IF P."<=" (P.DERIVED_TRUE, DBOOL_FALSE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
-      END IF;
- 
-      IF P."<=" (P.DERIVED_TRUE, DBOOL_TRUE) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
-      END IF;
- 
-      IF P.">=" (P.DERIVED_TRUE, DBOOL_TRUE) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
-      END IF;
- 
-      FOR J IN P.DERIVED_BOOLEAN'(P.TRUE) .. P.DERIVED_BOOLEAN'(P.TRUE)
-           LOOP
-                IF P.">=" (DBOOL_FALSE, J) THEN
-                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
-                END IF;
-           END LOOP;
- 
-      IF P."AND" (DBOOL_FALSE, P.DERIVED_TRUE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
-      END IF;
- 
-      IF P."OR" (DBOOL_FALSE, P.DERIVED_FALSE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
-      END IF;
- 
-      IF P."XOR" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
-      END IF;
- 
-      IF P."NOT" (P.DERIVED_TRUE) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
-      END IF;
- 
-      RESULT;
- END C41321A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41322a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41322a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41322a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41322a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C41322A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
- -- OPERATORS (+, -, *, /, **, ABS, MOD, REM) MAY BE SELECTED FROM
- -- OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR AN INTEGER TYPE.
- 
- -- TBN  7/16/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41322A IS
- 
-      PACKAGE P IS
-           TYPE INT IS RANGE -10 .. 10;
-           OBJ_INT_1 : INT := -10;
-           OBJ_INT_2 : INT := 1;
-           OBJ_INT_3 : INT := 10;
-      END P;
- 
-      INT_VAR : P.INT;
-      INT_VAR_1 : P.INT := P."-"(P.INT'(10));
-      INT_VAR_2 : P.INT := P.INT'(1);
-      INT_VAR_3 : P.INT := P.INT'(10);
- 
- BEGIN
-      TEST ("C41322A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
-                       "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
-                       "/, **, ABS, MOD, REM) MAY BE SELECTED FROM " &
-                       "OUTSIDE THE PACKAGE USING AN EXPANDED NAME, " &
-                       "FOR AN INTEGER TYPE");
- 
-      IF P."=" (INT_VAR_1, P.INT'(2)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."/=" (INT_VAR_1, P.OBJ_INT_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      IF P."<" (INT_VAR_2, 0) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-      END IF;
- 
-      IF P.">" (INT_VAR_2, P.OBJ_INT_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-      END IF;
- 
-      IF P."<=" (INT_VAR_3, P.INT'(9)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
-      END IF;
- 
-      FOR J IN P.INT'(4) .. P.INT'(4) LOOP
-           IF P.">=" (J, INT_VAR_3) THEN
-                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
-           END IF;
-      END LOOP;
- 
-      INT_VAR := P."+" (INT_VAR_1, P.INT'(2));
-      IF P."/=" (INT_VAR, P."-"(P.INT'(8))) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
-      END IF;
- 
-      INT_VAR := P."+" (P.INT'(2));
-      IF P."/=" (INT_VAR, P.INT'(2)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
-      END IF;
- 
-      INT_VAR := P."-" (INT_VAR_2, P.INT'(0));
-      IF P."/=" (INT_VAR, P.OBJ_INT_2) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
-      END IF;
- 
-      INT_VAR := P."*" (INT_VAR_2, P.INT'(5));
-      IF P."/=" (INT_VAR, P.INT'(5)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
-      END IF;
- 
-      INT_VAR := P."/" (INT_VAR_3, P.INT'(2));
-      IF P."/=" (INT_VAR, P.INT'(5)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
-      END IF;
- 
-      INT_VAR := P."**" (P.INT'(2), 3);
-      IF P."/=" (INT_VAR, P.INT'(8)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
-      END IF;
- 
-      INT_VAR := P."ABS" (INT_VAR_1);
-      IF P."/=" (INT_VAR, P.OBJ_INT_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
-      END IF;
- 
-      INT_VAR := P."MOD" (INT_VAR_1, P.INT'(3));
-      IF P."/=" (INT_VAR, P.INT'(2)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
-      END IF;
- 
-      INT_VAR := P."REM" (INT_VAR_1, P.INT'(3));
-      IF P."/=" (INT_VAR, P."-" (INT_VAR_2)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
-      END IF;
- 
-      RESULT;
- END C41322A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41323a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41323a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41323a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41323a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C41323A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
- -- OPERATORS (+, -, *, /, **, ABS) MAY BE SELECTED FROM OUTSIDE THE
- -- PACKAGE USING AN EXPANDED NAME, FOR A FLOATING POINT TYPE.
- 
- -- TBN  7/16/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41323A IS
- 
-      PACKAGE P IS
-           TYPE FLOAT IS DIGITS 5 RANGE -1.0E1 .. 1.0E1;
-           OBJ_FLO_1 : FLOAT := -5.5;
-           OBJ_FLO_2 : FLOAT := 1.5;
-           OBJ_FLO_3 : FLOAT := 10.0;
-      END P;
- 
-      FLO_VAR : P.FLOAT;
-      FLO_VAR_1 : P.FLOAT := P."-"(P.FLOAT'(5.5));
-      FLO_VAR_2 : P.FLOAT := P.FLOAT'(1.5);
-      FLO_VAR_3 : P.FLOAT := P.FLOAT'(1.0E1);
- 
- BEGIN
-      TEST ("C41323A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
-                       "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
-                       "/, **, ABS) MAY BE SELECTED FROM OUTSIDE THE " &
-                       "PACKAGE USING AN EXPANDED NAME, FOR A " &
-                       "FLOATING POINT TYPE");
- 
-      IF P."=" (FLO_VAR_1, P."-"(P.FLOAT'(5.55))) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."/=" (FLO_VAR_1, P.OBJ_FLO_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      IF P."<" (FLO_VAR_2, P.OBJ_FLO_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-      END IF;
- 
-      IF P.">" (FLO_VAR_2, P.OBJ_FLO_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-      END IF;
- 
-      IF P."<=" (FLO_VAR_3, P.FLOAT'(9.9)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
-      END IF;
- 
-      IF P."<=" (FLO_VAR_3, P.FLOAT'(10.0)) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
-      END IF;
- 
-      IF P.">=" (P.OBJ_FLO_2, FLO_VAR_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
-      END IF;
- 
-      IF P.">=" (P.OBJ_FLO_3, FLO_VAR_3) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
-      END IF;
- 
-      FLO_VAR := P."+" (FLO_VAR_1, P.OBJ_FLO_2);
-      IF P."/=" (FLO_VAR, P."-"(P.FLOAT'(4.0))) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
-      END IF;
- 
-      FLO_VAR := P."+" (FLO_VAR_1);
-      IF P."/=" (FLO_VAR, P.OBJ_FLO_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
-      END IF;
- 
-      FLO_VAR := P."-" (FLO_VAR_2, P.OBJ_FLO_1);
-      IF P."/=" (FLO_VAR, P.FLOAT'(7.0)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
-      END IF;
- 
-      FLO_VAR := P."*" (FLO_VAR_2, P.FLOAT'(2.0));
-      IF P."/=" (FLO_VAR, P.FLOAT'(3.0)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
-      END IF;
- 
-      FLO_VAR := P."/" (FLO_VAR_3, P.FLOAT'(2.0));
-      IF P."/=" (FLO_VAR, P.FLOAT'(5.0)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
-      END IF;
- 
-      FLO_VAR := P."**" (P.FLOAT'(2.0), 3);
-      IF P."/=" (FLO_VAR, P.FLOAT'(8.0)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
-      END IF;
- 
-      FLO_VAR := P."ABS" (FLO_VAR_1);
-      IF P."/=" (FLO_VAR, P.FLOAT'(5.5)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
-      END IF;
- 
-      RESULT;
- END C41323A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41324a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41324a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41324a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41324a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C41324A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
- -- OPERATORS (+, -, *, /, ABS) MAY BE SELECTED FROM OUTSIDE THE
- -- PACKAGE USING AN EXPANDED NAME, FOR A FIXED POINT TYPE.
- 
- -- TBN  7/16/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41324A IS
- 
-      PACKAGE P IS
-           TYPE FIXED IS DELTA 0.125 RANGE -1.0E1 .. 1.0E1;
-           OBJ_FIX_1 : FIXED := -5.5;
-           OBJ_FIX_2 : FIXED := 1.5;
-           OBJ_FIX_3 : FIXED := 10.0;
-      END P;
- 
-      FIX_VAR : P.FIXED;
-      FIX_VAR_1 : P.FIXED := P."-"(P.FIXED'(5.5));
-      FIX_VAR_2 : P.FIXED := P.FIXED'(1.5);
-      FIX_VAR_3 : P.FIXED := P.FIXED'(1.0E1);
- 
- BEGIN
-      TEST ("C41324A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
-                       "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
-                       "/, ABS) MAY BE SELECTED FROM OUTSIDE THE " &
-                       "PACKAGE USING AN EXPANDED NAME, FOR A FIXED " &
-                       "POINT TYPE");
- 
-      IF P."=" (FIX_VAR_1, P."-"(P.FIXED'(6.0))) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."/=" (FIX_VAR_1, P.OBJ_FIX_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      IF P."<" (FIX_VAR_2, P.OBJ_FIX_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-      END IF;
- 
-      IF P.">" (FIX_VAR_2, P.OBJ_FIX_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-      END IF;
- 
-      IF P."<=" (FIX_VAR_3, P.FIXED'(9.9)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
-      END IF;
- 
-      IF P."<=" (FIX_VAR_3, P.FIXED'(10.0)) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
-      END IF;
- 
-      IF P.">=" (P.OBJ_FIX_2, FIX_VAR_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
-      END IF;
- 
-      IF P.">=" (P.OBJ_FIX_2, FIX_VAR_2) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
-      END IF;
- 
-      FIX_VAR := P."+" (FIX_VAR_1, P.OBJ_FIX_2);
-      IF P."/=" (FIX_VAR, P."-"(P.FIXED'(4.0))) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
-      END IF;
- 
-      FIX_VAR := P."-" (FIX_VAR_2, P.OBJ_FIX_1);
-      IF P."/=" (FIX_VAR, P.FIXED'(7.0)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
-      END IF;
- 
-      FIX_VAR := P."*" (FIX_VAR_2, 2);
-      IF P."/=" (FIX_VAR, P.FIXED'(3.0)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
-      END IF;
- 
-      FIX_VAR := P."*" (3, FIX_VAR_2);
-      IF P."/=" (FIX_VAR, P.FIXED'(4.5)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
-      END IF;
- 
-      FIX_VAR := P."/" (FIX_VAR_3, 2);
-      IF P."/=" (FIX_VAR, P.FIXED'(5.0)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
-      END IF;
- 
-      FIX_VAR := P."ABS" (FIX_VAR_1);
-      IF P."/=" (FIX_VAR, P.FIXED'(5.5)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
-      END IF;
- 
-      RESULT;
- END C41324A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41325a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41325a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41325a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41325a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,173 ****
- -- C41325A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FOLLOWING IMPLICITLY DECLARED ENTITIES CAN BE SELECTED
- -- FROM OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR AN ARRAY TYPE.
- --     CASE 1: CHECK EQUALITY AND INEQUALITY WHEN COMPONENT TYPE IS
- --               NON-LIMITED, FOR MULTIDIMENSIONAL ARRAYS.
- --     CASE 2: FOR ONE DIMENSIONAL ARRAYS:
- --               A) CHECK CATENATION, EQUALITY, AND INEQUALITY WHEN 
- --                    COMPONENT TYPE IS NON-LIMITED.
- --               B) CHECK RELATIONAL OPERATORS WHEN COMPONENT TYPE IS 
- --                    DISCRETE.
- --               C) CHECK THE "NOT" OPERATOR AND THE LOGICAL OPERATORS 
- --                    WHEN COMPONENT TYPE IS BOOLEAN.
- 
- -- TBN  7/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41325A IS
- 
-      PACKAGE P IS
-           TYPE CATARRAY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
- 
-           TYPE ARRAY_1 IS ARRAY (1..10) OF INTEGER;
-           TYPE ARRAY_2 IS ARRAY (1..4, 1..4) OF INTEGER;
-           TYPE ARRAY_3 IS ARRAY (1..2, 1..3, 1..4) OF INTEGER;
-           TYPE ARRAY_4 IS ARRAY (1..10) OF BOOLEAN;
-           TYPE ARRAY_5 IS ARRAY (1..4, 1..4) OF BOOLEAN;
-           TYPE ARRAY_6 IS ARRAY (1..2, 1..3, 1..4) OF BOOLEAN;
- 
-           OBJ_ARA_1 : ARRAY_1 := (1..10 => IDENT_INT(0));
-           OBJ_ARA_2 : ARRAY_2 := (1..4 => (1..4 => IDENT_INT(0)));
-           OBJ_ARA_3 : ARRAY_3 := (1..2 => (1..3 =>
-                                                (1..4 => IDENT_INT(0))));
-           OBJ_ARA_4 : ARRAY_4 := (1..10 => IDENT_BOOL(FALSE));
-           OBJ_ARA_5 : ARRAY_5 := (1..4 => (1..4 => IDENT_BOOL(FALSE)));
-           OBJ_ARA_6 : ARRAY_6 := (1..2 => (1..3 =>
-                                           (1..4 => IDENT_BOOL(FALSE))));
-           OBJ_ARA_7 : CATARRAY (1..10) := (1..10 => IDENT_INT(0));
-           OBJ_ARA_20 : CATARRAY (1..20) := (1..10 => 1,
-                                                 11..20 => IDENT_INT(0));
-      END P;
- 
-      VAR_ARA_1 : P.ARRAY_1 := (1..10 => IDENT_INT(1));
-      VAR_ARA_2 : P.ARRAY_2 := (1..4 => (1..4 => IDENT_INT(1)));
-      VAR_ARA_3 : P.ARRAY_3 := (1..2 => (1..3 =>
-                                                (1..4 => IDENT_INT(1))));
-      VAR_ARA_4 : P.ARRAY_4 := (1..10 => IDENT_BOOL(TRUE));
-      VAR_ARA_5 : P.ARRAY_5 := (1..4 => (1..4 => IDENT_BOOL(TRUE)));
-      VAR_ARA_6 : P.ARRAY_6 := (1..2 => (1..3 =>
-                                            (1..4 => IDENT_BOOL(TRUE))));
-      VAR_ARA_7 : P.CATARRAY (1..10) := (1..10 => IDENT_INT(1));
-      VAR_ARA_8 : P.ARRAY_4 := (1..10 => IDENT_BOOL(TRUE));
-      VAR_ARA_20 : P.CATARRAY (1..20) := (1..20 => IDENT_INT(0));
- 
- BEGIN
-      TEST ("C41325A", "CHECK THAT IMPLICITLY DECLARED ENTITIES CAN " &
-                       "BE SELECTED FROM OUTSIDE THE PACKAGE USING AN " &
-                       "EXPANDED NAME, FOR AN ARRAY TYPE");
- 
-      -- CASE 1: MULTIDIMENSIONAL ARRAYS.
- 
-      IF P."=" (VAR_ARA_2, P.OBJ_ARA_2) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."=" (VAR_ARA_5, P.OBJ_ARA_5) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      IF P."/=" (VAR_ARA_2, P.ARRAY_2'(1..4 => (1..4 => 1))) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-      END IF;
- 
-      IF P."/=" (VAR_ARA_5, P.ARRAY_5'(1..4 => (1..4 => TRUE))) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-      END IF;
- 
-      IF P."=" (VAR_ARA_3, P.OBJ_ARA_3) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
-      END IF;
- 
-      IF P."/=" (VAR_ARA_6, P.ARRAY_6'(1..2 =>(1..3 =>(1..4 => TRUE)))) 
-           THEN
-                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
-      END IF;
- 
-      -- CASE 2: ONE DIMENSIONAL ARRAYS.
- 
-      IF P."=" (VAR_ARA_1, P.OBJ_ARA_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
-      END IF;
- 
-      IF P."/=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
-      END IF;
- 
-      VAR_ARA_20 := P."&" (VAR_ARA_7, P.OBJ_ARA_7);
-      IF P."/=" (VAR_ARA_20, P.OBJ_ARA_20) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
-      END IF;
- 
-      IF P."<" (VAR_ARA_1, P.OBJ_ARA_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
-      END IF;
- 
-      IF P.">" (P.OBJ_ARA_1, VAR_ARA_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
-      END IF;
- 
-      IF P."<=" (VAR_ARA_1, P.OBJ_ARA_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
-      END IF;
- 
-      IF P."<=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
-      END IF;
- 
-      IF P.">=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 2)) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
-      END IF;
- 
-      IF P.">=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
-      END IF;
- 
-      VAR_ARA_8 := P."NOT" (VAR_ARA_4);
-      IF P."/=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 16");
-      END IF;
- 
-      VAR_ARA_8 := P."OR" (VAR_ARA_4, P.OBJ_ARA_4);
-      IF P."=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 17");
-      END IF;
- 
-      VAR_ARA_8 := P."AND" (VAR_ARA_4, P.OBJ_ARA_4);
-      IF P."/=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 18");
-      END IF;
- 
-      VAR_ARA_8 := P."XOR" (VAR_ARA_4, P.OBJ_ARA_4);
-      IF P."=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 19");
-      END IF;
- 
-      RESULT;
- END C41325A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41326a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41326a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41326a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41326a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C41326A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED EQUALITY AND INEQUALITY OPERATORS
- -- MAY BE SELECTED FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR
- -- AN ACCESS TYPE.
- 
- -- TBN  7/18/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41326A IS
- 
-      PACKAGE P IS
-           TYPE CELL IS
-                RECORD
-                     VALUE : INTEGER;
-                END RECORD;
-           TYPE LINK IS ACCESS CELL;
- 
-           OBJ_LINK_1 : LINK := NEW CELL'(VALUE => 1);
-           OBJ_LINK_2 : LINK := OBJ_LINK_1;
-      END P;
- 
-      VAR_LINK_1 : P.LINK := NEW P.CELL'(VALUE => 1);
-      VAR_LINK_2 : P.LINK := NEW P.CELL'(VALUE => 2);
- 
- BEGIN
-      TEST ("C41326A", "CHECK THAT IMPLICITLY DECLARED EQUALITY AND " &
-                       "INEQUALITY OPERATORS MAY BE SELECTED FROM " &
-                       "OUTSIDE A PACKAGE USING AN EXPANDED NAME, " &
-                       "FOR AN ACCESS TYPE");
- 
-      IF P."=" (VAR_LINK_1, P.OBJ_LINK_1) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."/=" (P.OBJ_LINK_1, P.OBJ_LINK_2) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      IF P."=" (VAR_LINK_2.ALL, P.OBJ_LINK_1.ALL) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
-      END IF;
- 
-      VAR_LINK_2.VALUE := 1;
-      IF P."/=" (VAR_LINK_2.ALL, P.OBJ_LINK_1.ALL) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
-      END IF;
- 
-      RESULT;
- END C41326A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41327a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41327a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41327a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41327a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C41327A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED EQUALITY AND INEQUALITY OPERATORS
- -- MAY BE SELECTED FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR
- -- A PRIVATE TYPE.
- 
- -- TBN  7/18/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41327A IS
- 
-      PACKAGE P IS
-           TYPE KEY IS PRIVATE;
-           TYPE CHAR IS PRIVATE;
-           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
-           FUNCTION INIT_CHAR (X : CHARACTER) RETURN CHAR;
-      PRIVATE
-           TYPE KEY IS NEW NATURAL;
-           TYPE CHAR IS NEW CHARACTER;
-      END P;
- 
-      VAR_KEY_1 : P.KEY;
-      VAR_KEY_2 : P.KEY;
-      VAR_CHAR_1 : P.CHAR;
-      VAR_CHAR_2 : P.CHAR;
- 
-      PACKAGE BODY P IS
- 
-           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
-           BEGIN
-                RETURN (KEY (X));
-           END INIT_KEY;
- 
-           FUNCTION INIT_CHAR (X : CHARACTER) RETURN CHAR IS
-           BEGIN
-                RETURN (CHAR (X));
-           END INIT_CHAR;
- 
-      BEGIN
-           NULL;
-      END P;
- 
- BEGIN
-      TEST ("C41327A", "CHECK THAT IMPLICITLY DECLARED EQUALITY AND " &
-                       "INEQUALITY OPERATORS MAY BE SELECTED FROM " &
-                       "OUTSIDE A PACKAGE USING AN EXPANDED NAME, " &
-                       "FOR A PRIVATE TYPE");
- 
-      VAR_KEY_1 := P.INIT_KEY (1);
-      VAR_KEY_2 := P.INIT_KEY (2);
-      VAR_CHAR_1 := P.INIT_CHAR ('A');
-      VAR_CHAR_2 := P.INIT_CHAR ('A');
-      IF P."=" (VAR_KEY_1, VAR_KEY_2) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
-      END IF;
- 
-      IF P."/=" (VAR_CHAR_1, VAR_CHAR_2) THEN
-           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
-      END IF;
- 
-      RESULT;
- END C41327A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41328a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41328a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41328a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41328a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C41328A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED DERIVED SUBPROGRAMS CAN BE SELECTED
- -- FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR A DERIVED TYPE.
- 
- -- TBN  7/21/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41328A IS
- 
-      PACKAGE P IS
-           PACKAGE Q IS
-                TYPE PAIR IS ARRAY (1..2) OF INTEGER;
-                FUNCTION INIT (INT : INTEGER) RETURN PAIR;
-                PROCEDURE SWAP (TWO : IN OUT PAIR);
-           END Q;
-           TYPE COUPLE IS NEW Q.PAIR;
-      END P;
- 
-      VAR_1 : P.COUPLE;
-      VAR_2 : P.COUPLE;
- 
-      PACKAGE BODY P IS
- 
-           PACKAGE BODY Q IS
- 
-                FUNCTION INIT (INT : INTEGER) RETURN PAIR IS
-                     A : PAIR;
-                BEGIN
-                     A (1) := INT;
-                     A (2) := INT + 1;
-                     RETURN (A);
-                END INIT;
- 
-                PROCEDURE SWAP (TWO : IN OUT PAIR) IS
-                     TEMP : INTEGER;
-                BEGIN
-                     TEMP := TWO (1);
-                     TWO (1) := TWO (2);
-                     TWO (2) := TEMP;
-                END SWAP;
- 
-           BEGIN
-                NULL;
-           END Q;
- 
-      BEGIN
-           NULL;
-      END P;
- 
- BEGIN
-      TEST ("C41328A", "CHECK THAT IMPLICITLY DECLARED DERIVED " &
-                       "SUBPROGRAMS CAN BE SELECTED FROM OUTSIDE A " &
-                       "PACKAGE USING AN EXPANDED NAME, FOR A DERIVED " &
-                       "TYPE");
- 
-      VAR_1 := P.INIT (IDENT_INT(1));
-      IF P."/=" (VAR_1, P.COUPLE'(1 => 1, 2 => 2)) THEN
-           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 1");
-      END IF;
- 
-      VAR_2 := P.INIT (IDENT_INT(2));
-      IF P."=" (VAR_2, P.COUPLE'(1 => 1, 2 => 2)) THEN
-           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 2");
-      END IF;
- 
-      P.SWAP (VAR_1);
-      IF P."=" (VAR_1, P.COUPLE'(1 => 1, 2 => 2)) THEN
-           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 3");
-      END IF;
- 
-      P.SWAP (VAR_2);
-      IF P."/=" (VAR_2, P.COUPLE'(1 => 3, 2 => 2)) THEN
-           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 4");
-      END IF;
- 
-      RESULT;
- END C41328A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41401a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41401a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41401a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41401a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- C41401A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE PREFIX OF THE FOLLOWING
- -- ATTRIBUTES HAS THE VALUE NULL:
- --     A) 'CALLABLE AND 'TERMINATED FOR A TASK TYPE.
- --     B) 'FIRST, 'FIRST(N), 'LAST, 'LAST(N), 'LENGTH, 'LENGTH(N),
- --        'RANGE, AND 'RANGE(N) FOR AN ARRAY TYPE.
- 
- -- TBN  10/2/86
- -- EDS  07/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41401A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TYPE ACC_TT IS ACCESS TT;
- 
-      TYPE NULL_ARR1 IS ARRAY (2 .. 1) OF INTEGER;
-      TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
-      TYPE NULL_ARR2 IS ARRAY (3 .. 1, 2 .. 1) OF INTEGER;
-      TYPE ARRAY2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
-      TYPE ACC_NULL1 IS ACCESS NULL_ARR1;
-      TYPE ACC_ARR1 IS ACCESS ARRAY1;
-      TYPE ACC_NULL2 IS ACCESS NULL_ARR2;
-      TYPE ACC_ARR2 IS ACCESS ARRAY2;
- 
-      PTR_TT : ACC_TT;
-      PTR_ARA1: ACC_NULL1;
-      PTR_ARA2 : ACC_ARR1 (1 .. 4);
-      PTR_ARA3 : ACC_NULL2;
-      PTR_ARA4 : ACC_ARR2 (1 .. 2, 2 .. 4);
-      BOOL_VAR : BOOLEAN := FALSE;
-      INT_VAR : INTEGER := 1;
- 
-      TASK BODY TT IS
-      BEGIN
-           ACCEPT E;
-      END TT;
- 
- BEGIN
-      TEST ("C41401A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE " &
-                       "PREFIX HAS A VALUE OF NULL FOR THE FOLLOWING " &
-                       "ATTRIBUTES: 'CALLABLE, 'TERMINATED, 'FIRST, " &
-                       "'LAST, 'LENGTH, AND 'RANGE");
- 
-      BEGIN
-           IF EQUAL (3, 2) THEN
-                PTR_TT := NEW TT;
-           END IF;
-           BOOL_VAR := IDENT_BOOL(PTR_TT'CALLABLE);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & BOOLEAN'IMAGE(BOOL_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      BEGIN
-           IF EQUAL (1, 3) THEN
-                PTR_TT := NEW TT;
-           END IF;
-           BOOL_VAR := IDENT_BOOL(PTR_TT'TERMINATED);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 3 " & BOOLEAN'IMAGE(BOOL_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA1'FIRST);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 5 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA2'LAST);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 7 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA1'LENGTH);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 9 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 10");
-      END;
- 
-      BEGIN
-           DECLARE
-                A : ARRAY1 (PTR_ARA2'RANGE);
-           BEGIN
-                A (1) := IDENT_INT(1);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 11 " & 
-                        INTEGER'IMAGE(A(1)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - 11 ");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 12");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA3'FIRST(2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 13 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 14");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA4'LAST(2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 15 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 16");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA3'LENGTH(2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 17 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 18");
-      END;
- 
-      BEGIN
-           DECLARE
-                A : ARRAY1 (PTR_ARA4'RANGE(2));
-           BEGIN
-                A (1) := IDENT_INT(1);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 19 " & 
-                        INTEGER'IMAGE(A(1)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - 19 ");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 20");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA4'LAST(1));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 21 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 22");
-      END;
- 
-      BEGIN
-           INT_VAR := IDENT_INT(PTR_ARA3'LENGTH(1));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 23 " & INTEGER'IMAGE(INT_VAR));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 24");
-      END;
- 
-      RESULT;
- END C41401A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41402a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41402a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41402a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- C41402A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF THE PREFIX OF
- --     'ADDRESS, 'SIZE, 'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE
- --     VALUE NULL.
- 
- -- HISTORY:
- --     TBN  10/02/86  CREATED ORIGINAL TEST.
- --     CJJ  07/01/87  REMOVED TEST FOR 'STORAGE_SIZE, WHICH IS NO LONGER
- --                    PART OF THE OBJECTIVE.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C41402A IS
- 
-      TYPE ARRAY1 IS ARRAY (1 .. 2) OF INTEGER;
-      TYPE ACC_ARA IS ACCESS ARRAY1;
- 
-      PTR_ARA : ACC_ARA;
-      VAR1 : INTEGER;
- 
-      TYPE REC1 IS
-           RECORD
-                A : INTEGER;
-           END RECORD;
- 
-      TYPE ACC_REC1 IS ACCESS REC1;
- 
-      TYPE REC2 IS
-           RECORD
-                P_AR : ACC_ARA;
-                P_REC : ACC_REC1;
-           END RECORD;
- 
-      OBJ_REC : REC2;
- 
- 
-      PROCEDURE PROC (A : ADDRESS) IS
-      BEGIN
-           NULL;
-      END;
- 
- BEGIN
-      TEST ("C41402A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "THE PREFIX OF 'ADDRESS, 'SIZE, " &
-                       "'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE " &
-                       "VALUE NULL");
- 
-      BEGIN
-           PROC (PTR_ARA'ADDRESS);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR 'ADDRESS");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED 'ADDRESS");
-      END;
- 
-      BEGIN
-           VAR1 := PTR_ARA'SIZE;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR 'SIZE");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED 'SIZE");
-      END;
- 
-      BEGIN
-           VAR1 := OBJ_REC.P_AR'FIRST_BIT;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR 'FIRST_BIT");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED 'FIRST_BIT");
-      END;
- 
-      BEGIN
-           VAR1 := OBJ_REC.P_AR'LAST_BIT;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR 'LAST_BIT");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED 'LAST_BIT");
-      END;
- 
-      BEGIN
-           VAR1 := OBJ_REC.P_REC'POSITION;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR 'POSITION");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED 'POSITION");
-      END;
- 
-      RESULT;
- END C41402A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41404a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41404a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c41404a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c41404a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C41404A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE PREFIX OF THE ARRAY ATTRIBUTES CAN BE THE VALUE OF AN
- -- IMAGE ATTRIBUTE.
- 
- -- JBG 6/1/85
- -- PWB 2/3/86  CORRECTED COMPARISON VALUES FOR 'LAST AND 'LENGTH.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C41404A IS
- 
-      TYPE ENUM IS (ONE, FOUR, 'C');
- 
- BEGIN
- 
-      TEST ("C41404A", "CHECK WHEN PREFIX OF AN ATTRIBUTE IS 'IMAGE");
- 
-      IF ENUM'IMAGE(FOUR)'LENGTH /= IDENT_INT(4) THEN
-           FAILED ("WRONG VALUE FOR LENGTH - ENUM");
-      END IF;
- 
-      IF ENUM'IMAGE('C')'LENGTH /= IDENT_INT(3) THEN
-           FAILED ("WRONG VALUE FOR LENGTH - ENUM: 'C'");
-      END IF;
- 
-      IF INTEGER'IMAGE(IDENT_INT(56))'LENGTH /= IDENT_INT(3) THEN
-           FAILED ("WRONG VALUE FOR LENGTH - INTEGER: 56");
-      END IF;
- 
-      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LENGTH /= IDENT_INT(3) THEN
-           FAILED ("WRONG VALUE FOR LENGTH - CHAR: 'B'");
-      END IF;
- 
-      IF ENUM'IMAGE(FOUR)'FIRST /= IDENT_INT(1) THEN
-           FAILED ("WRONG VALUE FOR FIRST - ENUM");
-      END IF;
- 
-      IF ENUM'IMAGE('C')'FIRST(1) /= IDENT_INT(1) THEN
-           FAILED ("WRONG VALUE FOR FIRST - ENUM: 'C'");
-      END IF;
- 
-      IF INTEGER'IMAGE(IDENT_INT(56))'FIRST /= IDENT_INT(1) THEN
-           FAILED ("WRONG VALUE FOR FIRST - INTEGER: 56");
-      END IF;
- 
-      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'FIRST /= IDENT_INT(1) THEN
-           FAILED ("WRONG VALUE FOR FIRST - CHAR: 'B'");
-      END IF;
- 
-      IF ENUM'IMAGE(FOUR)'LAST /= IDENT_INT(4) THEN
-           FAILED ("WRONG VALUE FOR LAST - ENUM");
-      END IF;
- 
-      IF ENUM'IMAGE('C')'LAST(1) /= IDENT_INT(3) THEN
-           FAILED ("WRONG VALUE FOR LAST - ENUM: 'C'");
-      END IF;
- 
-      IF INTEGER'IMAGE(IDENT_INT(-56))'LAST /= IDENT_INT(3) THEN
-           FAILED ("WRONG VALUE FOR LAST - INTEGER: -56");
-      END IF;
- 
-      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LAST /= IDENT_INT(3) THEN
-           FAILED ("WRONG VALUE FOR LAST - CHAR: 'B'");
-      END IF;
- 
-      DECLARE
- 
-           FOUR_VAR : STRING(ENUM'IMAGE(FOUR)'RANGE);
-           C_VAR    : STRING(ENUM'IMAGE('C')'RANGE);
-           VAR_101  : STRING(INTEGER'IMAGE(IDENT_INT(101))'RANGE);
-           CHAR_VAR : STRING(CHARACTER'IMAGE(IDENT_CHAR('B'))'RANGE);
- 
-      BEGIN
- 
-           IF FOUR_VAR'FIRST /= 1 OR
-              FOUR_VAR'LAST  /= 4 OR
-              FOUR_VAR'LENGTH /= 4 THEN
-                FAILED ("FOUR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
-                        INTEGER'IMAGE(FOUR_VAR'FIRST) & ".  LAST IS" &
-                        INTEGER'IMAGE(FOUR_VAR'LAST) & ".  LENGTH IS" &
-                        INTEGER'IMAGE(FOUR_VAR'LENGTH));
-           END IF;
- 
-           IF C_VAR'FIRST /= 1 OR
-              C_VAR'LAST  /= 3 OR
-              C_VAR'LENGTH /= 3 THEN
-                FAILED ("C_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
-                        INTEGER'IMAGE(C_VAR'FIRST) & ".  LAST IS" &
-                        INTEGER'IMAGE(C_VAR'LAST) & ".  LENGTH IS" &
-                        INTEGER'IMAGE(C_VAR'LENGTH));
-           END IF;
- 
-           IF VAR_101'FIRST /= 1 OR
-              VAR_101'LAST  /= 4 OR
-              VAR_101'LENGTH /= 4 THEN
-                FAILED ("VAR_101 ATTRIBUTES INCORRECT.  FIRST IS" &
-                        INTEGER'IMAGE(VAR_101'FIRST) & ".  LAST IS" &
-                        INTEGER'IMAGE(VAR_101'LAST) & ".  LENGTH IS" &
-                        INTEGER'IMAGE(VAR_101'LENGTH));
-           END IF;
- 
-           IF CHAR_VAR'FIRST /= 1 OR
-              CHAR_VAR'LAST  /= 3 OR
-              CHAR_VAR'LENGTH /= 3 THEN
-                FAILED ("CHAR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
-                        INTEGER'IMAGE(CHAR_VAR'FIRST) & ".  LAST IS" &
-                        INTEGER'IMAGE(CHAR_VAR'LAST) & ".  LENGTH IS" &
-                        INTEGER'IMAGE(CHAR_VAR'LENGTH));
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C41404A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c420001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c420001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c420001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c420001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C420001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check that if the index subtype of a string type is a modular subtype
- --     whose lower bound is zero, then the evaluation of a null string_literal
- --     raises Constraint_Error. This was confirmed by AI95-00138.
- --
- -- TEST DESCRIPTION
- --     In this test, we have a generic formal modular type, and we have
- --     several null string literals of that type.  Because the type is
- --     generic formal, the string literals are not static, and therefore
- --     the Constraint_Error should be detected at run time.
- --
- -- CHANGE HISTORY:
- --      29 JUN 1999   RAD   Initial Version
- --      23 SEP 1999   RLB   Improved comments and messages, renamed, issued.
- --
- --!
- with Report; use Report; pragma Elaborate_All(Report);
- with System;
- procedure C420001 is
-     generic
-         type Modular is mod <>;
-     package Mod_Test is
-         type Str is array(Modular range <>) of Character;
-         procedure Test_String_Literal;
-     end Mod_Test;
- 
-     package body Mod_Test is
-         procedure Test_String_Literal is
-         begin
-             begin
-                 declare
-                     Null_String: Str := ""; -- Should raise C_E.
-                 begin
-                     Comment(String(Null_String)); -- Avoid 11.6 issues.
-                 end;
-                 Failed("Null string didn't raise Constraint_Error");
-             exception
-                 when Exc: Constraint_Error =>
-                     null; -- Comment("Constraint_Error -- OK");
-                 when Exc2: others =>
-                     Failed("Null string raised wrong exception");
-             end;
-             begin
-                 Failed(String(Str'(""))); -- Should raise C_E, not do Failed.
-                 Failed("Null string didn't raise Constraint_Error");
-             exception
-                 when Exc: Constraint_Error =>
-                     null; -- Comment("Constraint_Error -- OK");
-                 when Exc2: others =>
-                     Failed("Null string raised wrong exception");
-             end;
-         end Test_String_Literal;
-     begin
-         Test_String_Literal;
-     end Mod_Test;
- begin
-     Test("C420001", "Check that if the index subtype of a string type is a " &
-                     "modular subtype whose lower bound is zero, then the " &
-                     "evaluation of a null string_literal raises " &
-                     "Constraint_Error. ");
-     declare
-         type M1 is mod 1;
-         package Test_M1 is new Mod_Test(M1);
-         type M2 is mod 2;
-         package Test_M2 is new Mod_Test(M2);
-         type M3 is mod 3;
-         package Test_M3 is new Mod_Test(M3);
-         type M4 is mod 4;
-         package Test_M4 is new Mod_Test(M4);
-         type M5 is mod 5;
-         package Test_M5 is new Mod_Test(M5);
-         type M6 is mod 6;
-         package Test_M6 is new Mod_Test(M6);
-         type M7 is mod 7;
-         package Test_M7 is new Mod_Test(M7);
-         type M8 is mod 8;
-         package Test_M8 is new Mod_Test(M8);
-         type M_Max_Binary_Modulus is mod System.Max_Binary_Modulus;
-         package Test_M_Max_Binary_Modulus is new Mod_Test(M_Max_Binary_Modulus);
-         type M_Max_Nonbinary_Modulus is mod System.Max_Nonbinary_Modulus;
-         package Test_M_Max_Nonbinary_Modulus is new Mod_Test(M_Max_Nonbinary_Modulus);
-     begin
-         null;
-     end;
-     Result;
- end C420001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c42006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c42006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c42006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c42006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C42006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A STRING LITERAL OF AN
- -- ARRAY TYPE CONTAINS A CHARACTER THAT DOES NOT BELONG TO THE COMPONENT
- -- SUBTYPE.
- 
- -- SPS 2/22/84
- -- EDS 12/02/97  MODIFIED THE COMPONENT SUBTYPES SO THAT THEY ARE NON-STATIC.
- -- EDS 7/14/98    AVOID OPTIMIZATION
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C42006A IS
- BEGIN
- 
-      TEST ("C42006A", "CHECK THAT THE VALUES OF STRING LITERALS MUST" &
-            " BELONG TO THE COMPONENT SUBTYPE.");
- 
-      DECLARE
- 
-           TYPE CHAR_COMP IS ('A', 'B', 'C', 'D', 'E', 'F');
- 
-           ASCIINUL : CHARACTER := ASCII.NUL;
-           SUBTYPE NON_GRAPHIC_CHAR IS CHARACTER 
-                RANGE ASCIINUL .. ASCII.BEL;
- 
-           BEE : CHAR_COMP := 'B';
-           TYPE CHAR_STRING IS ARRAY (POSITIVE RANGE <>) 
-                OF CHAR_COMP RANGE BEE..'C';
-           TYPE NON_GRAPHIC_CHAR_STRING IS ARRAY (POSITIVE RANGE <>)
-                OF NON_GRAPHIC_CHAR;
- 
-           C_STR : CHAR_STRING (1 .. 1);
-           C_STR_5 : CHAR_STRING (1 .. 5) := "BBBBB";
-           N_G_STR : NON_GRAPHIC_CHAR_STRING (1 .. 1) := 
-                     (OTHERS => NON_GRAPHIC_CHAR'FIRST);
- 
-      BEGIN
- 
-           BEGIN
-                C_STR_5 := "BABCC";      -- 'A' NOT IN COMPONENT SUBTYPE.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & 
-                        CHAR_COMP'IMAGE(C_STR_5(1)));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                C_STR_5 := "BCBCD";      -- 'D' NOT IN COMPONENT SUBTYPE.
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2 " & 
-                        CHAR_COMP'IMAGE(C_STR_5(1)));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                N_G_STR := "Z";
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3 " & 
-                        INTEGER'IMAGE(CHARACTER'POS(N_G_STR(1))));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED - 3");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C42006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c42007e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c42007e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c42007e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c42007e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C42007E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A STRING LITERAL ARE DETERMINED CORRECTLY.
- -- IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY 'FIRST OF THE
- -- INDEX SUBTYPE WHEN THE STRING LITERAL IS USED AS:
- 
- --   E) THE LEFT OR RIGHT OPERAND OF "&".
- 
- -- TBN  7/28/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C42007E IS
- 
- BEGIN
- 
-      TEST("C42007E", "CHECK THE BOUNDS OF A STRING LITERAL WHEN USED " &
-                      "AS THE LEFT OR RIGHT OPERAND OF THE CATENATION " &
-                      "OPERATOR");
- 
-      BEGIN
- 
- CASE_E :  DECLARE
- 
-                SUBTYPE STR_RANGE IS INTEGER RANGE 2 .. 10;
-                TYPE STR IS ARRAY (STR_RANGE RANGE <>) OF CHARACTER;
- 
-                FUNCTION CONCAT1 RETURN STR IS
-                BEGIN
-                     RETURN ("ABC" & (7 .. 8 => 'D'));
-                END CONCAT1;
- 
-                FUNCTION CONCAT2 RETURN STR IS
-                BEGIN
-                     RETURN ((IDENT_INT(4) .. 3 => 'A') & "BC");
-                END CONCAT2;
- 
-                FUNCTION CONCAT3 RETURN STRING IS
-                BEGIN
-                     RETURN ("TEST" & (7 .. 8 => 'X'));
-                END CONCAT3;
- 
-                FUNCTION CONCAT4 RETURN STRING IS
-                BEGIN
-                     RETURN ((8 .. 5 => 'A') & "DE");
-                END CONCAT4;
- 
-           BEGIN
- 
-                IF CONCAT1'FIRST /= IDENT_INT(2) THEN
-                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 1");
-                END IF;
-                IF CONCAT1'LAST /= 6 THEN
-                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 1");
-                END IF;
-                IF CONCAT1 /= "ABCDD" THEN
-                     FAILED ("STRING INCORRECTLY DETERMINED - 1");
-                END IF;
- 
-                IF CONCAT2'FIRST /= IDENT_INT(2) THEN
-                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 2");
-                END IF;
-                IF CONCAT2'LAST /= 3 THEN
-                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 2");
-                END IF;
-                IF CONCAT2 /= "BC" THEN
-                     FAILED ("STRING INCORRECTLY DETERMINED - 2");
-                END IF;
- 
-                IF CONCAT3'FIRST /= IDENT_INT(1) THEN
-                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 3");
-                END IF;
-                IF CONCAT3'LAST /= 6 THEN
-                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 3");
-                END IF;
-                IF CONCAT3 /= "TESTXX" THEN
-                     FAILED ("STRING INCORRECTLY DETERMINED - 3");
-                END IF;
- 
-                IF CONCAT4'FIRST /= IDENT_INT(1) THEN
-                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 4");
-                END IF;
-                IF CONCAT4'LAST /= 2 THEN
-                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 4");
-                END IF;
-                IF CONCAT4 /= "DE" THEN
-                     FAILED ("STRING INCORRECTLY DETERMINED - 4");
-                END IF;
- 
-           END CASE_E;
- 
-      END;
- 
-      RESULT;
- 
- END C42007E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C43003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN INITIALIZING AN ARRAY OF ACCESS OBJECTS, WITH
- -- AN AGGREGATE CONTAINING A SINGLE ALLOCATOR, ALL ELEMENTS
- -- ARE INITIALIZED TO THE SAME INITIAL VALUE.
- -- THAT IS, CHECK THAT ALL COMPONENTS OF THE ARRAY DESIGNATE
- -- DISTINCT OBJECTS.
- 
- -- DAT 3/18/81
- -- SPS 10/26/82
- -- JBG 12/27/82
- -- R. WILLIAMS 11/11/86     RENAMED FROM C38007A-B.ADA.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C43003A IS
- 
-      TYPE AI IS ACCESS INTEGER;
- 
-      TYPE AAI IS ARRAY (1..5) OF AI;
- 
-      A : AAI := AAI'(OTHERS => NEW INTEGER '(2));
- 
- BEGIN
-      TEST ("C43003A", "CHECK THAT ALLOCATORS IN INITIALIZATIONS"
-           & " FOR ARRAYS OF ACCESS VALUES ARE EVALUATED ONCE" &
-           " FOR EACH COMPONENT");
- 
-      FOR I IN 1..5
-      LOOP
-           FOR J IN I+1..5
-           LOOP
-                IF A(I) = A(J) THEN
-                     FAILED ("DID NOT EVALUATE ALLOCATOR FOR EACH " &
-                             "COMPONENT");
-                     EXIT;
-                END IF;
-           END LOOP;
-      END LOOP;
- 
-      RESULT;
- END C43003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,350 ****
- -- C43004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF A VALUE FOR A
- --     NON-DISCRIMINANT SCALAR COMPONENT OF AN AGGREGATE IS NOT
- --     WITHIN THE RANGE OF THE COMPONENT'S SUBTYPE.
- 
- -- HISTORY:
- --     BCB 01/22/88  CREATED ORIGINAL TEST.
- --     RJW 06/27/90  CORRECTED CONSTRAINTS OF TYPE DFIX.
- --     LDC 09/25/90  ADDED A BLOCK IN THE EXCEPTION HANDLER SO IT CAN
- --                   NOT OPTIMIZE IT AWAY,  ALSO INITIALIZED EACH
- --                   OBJECT TO VALID DATA BEFORE DOING THE INVALID,
- --                   MADE 'IDENT_XXX' FUNCTIONS SO THE COMPILER CAN
- --                   NOT JUST EVALUATE THE ASSIGNMENT AND PUT IN CODE
- --                   FOR A CONSTRAINT ERROR IN IS PLACE.
- --     JRL 06/07/96  Changed value in aggregate in subtest 4 to value
- --                   guaranteed to be in the base range of the type FIX.
- --                   Corrected typo.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C43004A IS
- 
-      TYPE INT IS RANGE 1 .. 8;
-      SUBTYPE SINT IS INT RANGE 2 .. 7;
- 
-      TYPE ENUM IS (VINCE, JOHN, TOM, PHIL, ROSA, JODIE, BRIAN, DAVE);
-      SUBTYPE SENUM IS ENUM RANGE JOHN .. BRIAN;
- 
-      TYPE FL IS DIGITS 5 RANGE 0.0 .. 10.0;
-      SUBTYPE SFL IS FL RANGE 1.0 .. 9.0;
- 
-      TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 8.0;
-      SUBTYPE SFIX IS FIX RANGE 1.0 .. 7.0;
- 
-      TYPE DINT IS NEW INTEGER RANGE 1 .. 8;
-      SUBTYPE SDINT IS DINT RANGE 2 .. 7;
- 
-      TYPE DENUM IS NEW ENUM RANGE VINCE .. DAVE;
-      SUBTYPE SDENUM IS DENUM RANGE JOHN .. BRIAN;
- 
-      TYPE DFL IS NEW FLOAT RANGE 0.0 .. 10.0;
-      SUBTYPE SDFL IS DFL RANGE 1.0 .. 9.0;
- 
-      TYPE DFIX IS NEW FIX RANGE 0.5 .. 7.5;
-      SUBTYPE SDFIX IS DFIX RANGE 1.0 .. 7.0;
- 
-      TYPE REC1 IS RECORD
-            E1, E2, E3, E4, E5 : SENUM;
-      END RECORD;
- 
-      TYPE REC2 IS RECORD
-            E1, E2, E3, E4, E5 : SFIX;
-      END RECORD;
- 
-      TYPE REC3 IS RECORD
-            E1, E2, E3, E4, E5 : SDENUM;
-      END RECORD;
- 
-      TYPE REC4 IS RECORD
-            E1, E2, E3, E4, E5 : SDFIX;
-      END RECORD;
- 
-      ARRAY_OBJ : ARRAY(1..2) OF INTEGER;
- 
-      A  : ARRAY(1..5) OF SINT;
-      B  : REC1;
-      C  : ARRAY(1..5) OF SFL;
-      D  : REC2;
-      E  : ARRAY(1..5) OF SDINT;
-      F  : REC3;
-      G  : ARRAY(1..5) OF SDFL;
-      H  : REC4;
- 
-      GENERIC
-           TYPE GENERAL_PURPOSE IS PRIVATE;
-      FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN;
- 
-      FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN ONE = TWO;
-           ELSE
-                RETURN ONE /= TWO;
-           END IF;
-      END GENEQUAL;
- 
-      FUNCTION EQUAL IS NEW GENEQUAL(SENUM);
-      FUNCTION EQUAL IS NEW GENEQUAL(SFL);
-      FUNCTION EQUAL IS NEW GENEQUAL(SFIX);
-      FUNCTION EQUAL IS NEW GENEQUAL(SDENUM);
-      FUNCTION EQUAL IS NEW GENEQUAL(SDFL);
-      FUNCTION EQUAL IS NEW GENEQUAL(SDFIX);
- 
-      GENERIC
-           TYPE GENERAL_PURPOSE IS PRIVATE;
-           WITH FUNCTION EQUAL_GENERAL(ONE, TWO : GENERAL_PURPOSE) 
-                    RETURN BOOLEAN;
-      FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
-      FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
-           BEGIN
-           IF EQUAL_GENERAL (X, X) THEN  -- ALWAYS EQUAL.
-                RETURN X;                -- ALWAYS EXECUTED.
-           END IF;
-                                         -- NEVER EXECUTED.
-           RETURN X;
-      END GEN_IDENT;
- 
-      FUNCTION IDENT_FL    IS NEW GEN_IDENT(FL, EQUAL);
-      FUNCTION IDENT_FIX   IS NEW GEN_IDENT(FIX, EQUAL);
-      FUNCTION IDENT_DFL   IS NEW GEN_IDENT(DFL, EQUAL);
-      FUNCTION IDENT_DFIX  IS NEW GEN_IDENT(DFIX, EQUAL);
- 
- BEGIN
-      TEST ("C43004A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
-                       "VALUE FOR A NON-DISCRIMINANT SCALAR COMPONENT " &
-                       "OF AN AGGREGATE IS NOT WITHIN THE RANGE OF " &
-                       "THE COMPONENT'S SUBTYPE");
- 
-      ARRAY_OBJ := (1, 2);
- 
-      BEGIN
-           A  := (2,3,4,5,6);            -- OK
- 
-           IF EQUAL (INTEGER (A(IDENT_INT(1))),
-                     INTEGER (A(IDENT_INT(2)))) THEN
-                COMMENT ("DON'T OPTIMIZE A");
-           END IF;
- 
-           A := (SINT(IDENT_INT(1)),2,3,4,7);
-                                        -- CONSTRAINT_ERROR BY AGGREGATE
-                                        -- WITH INTEGER COMPONENTS.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
-           IF EQUAL (INTEGER (A(IDENT_INT(1))),
-                     INTEGER (A(IDENT_INT(1)))) THEN
-                COMMENT ("DON'T OPTIMIZE A");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 1");
-      END;
- 
-      BEGIN
-           B := (JOHN,TOM,PHIL,ROSA,JOHN);  -- OK
- 
-           IF EQUAL (B.E1, B.E2) THEN
-                COMMENT ("DON'T OPTIMIZE B");
-           END IF;
- 
-           B := (ENUM'VAL(IDENT_INT(ENUM'POS(DAVE))), TOM, PHIL,
-                 ROSA, JODIE);
-                                        -- CONSTRAINT_ERROR BY AGGREGATE
-                                        -- WITH COMPONENTS OF AN
-                                        -- ENUMERATION TYPE.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
-           IF NOT EQUAL (B.E1, B.E1) THEN
-                COMMENT ("DON'T OPTIMIZE B");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 2");
-      END;
-      BEGIN
-           C := (2.0,3.0,4.0,5.0,6.0);  -- OK
-           IF EQUAL (C(IDENT_INT(1)), C(IDENT_INT(2))) THEN
-                COMMENT ("DON'T OPTIMIZE C");
-           END IF;
- 
-           C := (IDENT_FL(1.0),2.0,3.0,4.0,IDENT_FL(10.0));
-                                       -- CONSTRAINT_ERROR BY AGGREGATE
-                                       -- WITH FLOATING POINT COMPONENTS.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
-           IF NOT EQUAL (C(IDENT_INT(1)), C(IDENT_INT(1))) THEN
-                COMMENT ("DON'T OPTIMIZE C");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 3");
-      END;
- 
-      BEGIN
-           D := (2.2,3.3,4.4,5.5,6.6); -- OK
-           IF EQUAL (D.E1, D.E5) THEN
-                COMMENT ("DON'T OPTIMIZE D");
-           END IF;
- 
-           D := (IDENT_FIX(1.0),2.1,3.3,4.4,IDENT_FIX(7.75));
-                                        -- CONSTRAINT_ERROR BY AGGREGATE
-                                        -- WITH FIXED POINT COMPONENTS.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
-           IF NOT EQUAL (D.E5, D.E5) THEN
-                COMMENT ("DON'T OPTIMIZE D");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 4");
-      END;
- 
-      BEGIN
-           E := (2,3,4,5,6); -- OK
-           IF EQUAL (INTEGER (E(IDENT_INT(1))),
-                     INTEGER (E(IDENT_INT(2)))) THEN
-                COMMENT ("DON'T OPTIMIZE E");
-           END IF;
- 
-           E := (SDINT(IDENT_INT(1)),2,3,4,7);
-                                      -- CONSTRAINT_ERROR BY AGGREGATE
-                                      -- WITH DERIVED INTEGER COMPONENTS.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 5");
-           IF NOT EQUAL (INTEGER (E(IDENT_INT(1))),
-                         INTEGER (E(IDENT_INT(1)))) THEN
-                COMMENT ("DON'T OPTIMIZE E");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 5");
-      END;
- 
-      BEGIN
-           F := (JOHN,TOM,PHIL,ROSA,JOHN);  -- OK
-           IF EQUAL (F.E1, F.E2) THEN
-                COMMENT ("DON'T OPTIMIZE F");
-           END IF;
- 
-           F := (DENUM'VAL(IDENT_INT(DENUM'POS(VINCE))), TOM, PHIL,
-                 ROSA, JODIE);
-                                        -- CONSTRAINT_ERROR BY AGGREGATE
-                                        -- WITH COMPONENTS OF A DERIVED
-                                        -- ENUMERATION TYPE.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 6");
-           IF NOT EQUAL (F.E1, F.E1) THEN
-                COMMENT ("DON'T OPTIMIZE F");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 6");
-      END;
- 
-      BEGIN
-           G := (2.0,3.0,4.0,5.0,6.0); -- OK
-           IF EQUAL (G(IDENT_INT(1)), G(IDENT_INT(2))) THEN
-                COMMENT ("DON'T OPTIMIZE G");
-           END IF;
- 
-           G := (IDENT_DFL(1.0),2.0,3.0,4.0,IDENT_DFL(10.0));
-                                        -- CONSTRAINT_ERROR BY AGGREGATE
-                                        -- WITH DERIVED FLOATING POINT
-                                        -- COMPONENTS.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
-           IF NOT EQUAL (G(IDENT_INT(1)), G(IDENT_INT(1))) THEN
-                COMMENT ("DON'T OPTIMIZE G");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 7");
-      END;
- 
-      BEGIN
-           H := (2.2,3.3,4.4,5.5,6.6); -- OK
-           IF EQUAL (H.E1, H.E2) THEN
-                COMMENT ("DON'T OPTIMIZE H");
-           END IF;
- 
-           H := (IDENT_DFIX(2.0),2.5,3.5,4.3,IDENT_DFIX(7.4));
-                                        -- CONSTRAINT_ERROR BY AGGREGATE
-                                        -- WITH DERIVED FIXED POINT
-                                        -- COMPONENTS.
-           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
-           IF EQUAL (H.E1, H.E5) THEN
-                COMMENT ("DON'T OPTIMIZE H");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
-                          ARRAY_OBJ(IDENT_INT(2))) THEN
-                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                        "WAS RAISED - 8");
-      END;
- 
- 
-      RESULT;
- END C43004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43004c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43004c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43004c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,230 ****
- -- C43004C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE VALUE OF A
- --     DISCRIMINANT OF A CONSTRAINED COMPONENT OF AN AGGREGATE DOES
- --     NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE FOR THE
- --     COMPONENT'S SUBTYPE.
- 
- -- HISTORY:
- --     BCB 07/19/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C43004C IS
- 
-      ZERO : INTEGER := 0;
- 
-      TYPE REC (D : INTEGER := 0) IS RECORD
-           COMP1 : INTEGER;
-      END RECORD;
- 
-      TYPE DREC (DD : INTEGER := ZERO) IS RECORD
-           DCOMP1 : INTEGER;
-      END RECORD;
- 
-      TYPE REC1 IS RECORD
-           A : REC(0);
-      END RECORD;
- 
-      TYPE REC2 IS RECORD
-           B : DREC(ZERO);
-      END RECORD;
- 
-      TYPE REC3 (D3 : INTEGER := 0) IS RECORD
-           C : REC(D3);
-      END RECORD;
- 
-      V : REC1;
-      W : REC2;
-      X : REC3;
- 
-      PACKAGE P IS
-           TYPE PRIV1 (D : INTEGER := 0) IS PRIVATE;
-           TYPE PRIV2 (DD : INTEGER := ZERO) IS PRIVATE;
-           FUNCTION INIT (I : INTEGER) RETURN PRIV1;
-      PRIVATE
-           TYPE PRIV1 (D : INTEGER := 0) IS RECORD
-                NULL;
-           END RECORD;
- 
-           TYPE PRIV2 (DD : INTEGER := ZERO) IS RECORD
-                NULL;
-           END RECORD;
-      END P;
- 
-      TYPE REC7 IS RECORD
-           H : P.PRIV1 (0);
-      END RECORD;
- 
-      Y : REC7;
- 
-      GENERIC
-           TYPE GP IS PRIVATE;
-      FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN;
- 
-      FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN IS
-      BEGIN
-           RETURN X = Y;
-      END GEN_EQUAL;
- 
-      PACKAGE BODY P IS
-           TYPE REC4 IS RECORD
-                E : PRIV1(0);
-           END RECORD;
- 
-           TYPE REC5 IS RECORD
-                F : PRIV2(ZERO);
-           END RECORD;
- 
-           TYPE REC6 (D6 : INTEGER := 0) IS RECORD
-                G : PRIV1(D6);
-           END RECORD;
- 
-           VV : REC4;
-           WW : REC5;
-           XX : REC6;
- 
-           FUNCTION REC4_EQUAL IS NEW GEN_EQUAL (REC4);
-           FUNCTION REC5_EQUAL IS NEW GEN_EQUAL (REC5);
-           FUNCTION REC6_EQUAL IS NEW GEN_EQUAL (REC6);
- 
-           FUNCTION INIT (I : INTEGER) RETURN PRIV1 IS
-                VAR : PRIV1;
-           BEGIN
-                VAR := (D => I);
-                RETURN VAR;
-           END INIT;
-      BEGIN
-           TEST ("C43004C", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                            "IF THE VALUE OF A DISCRIMINANT OF A " &
-                            "CONSTRAINED COMPONENT OF AN AGGREGATE " &
-                            "DOES NOT EQUAL THE CORRESPONDING " &
-                             "DISCRIMINANT VALUE FOR THECOMPONENT'S " &
-                            "SUBTYPE");
- 
-           BEGIN
-                VV := (E => (D => 1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
-                IF REC4_EQUAL (VV,VV) THEN
-                     COMMENT ("DON'T OPTIMIZE VV");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                WW := (F => (DD => 1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
-                IF REC5_EQUAL (WW,WW) THEN
-                     COMMENT ("DON'T OPTIMIZE WW");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                XX := (D6 => 1, G => (D => 5));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
-                IF REC6_EQUAL (XX,XX) THEN
-                     COMMENT ("DON'T OPTIMIZE XX");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 3");
-           END;
-      END P;
- 
-      USE P;
- 
-      FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
-      FUNCTION REC2_EQUAL IS NEW GEN_EQUAL (REC2);
-      FUNCTION REC3_EQUAL IS NEW GEN_EQUAL (REC3);
-      FUNCTION REC7_EQUAL IS NEW GEN_EQUAL (REC7);
- 
- BEGIN
- 
-      BEGIN
-           V := (A => (D => 1, COMP1 => 2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
-           IF REC1_EQUAL (V,V) THEN
-                COMMENT ("DON'T OPTIMIZE V");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 4");
-      END;
- 
-      BEGIN
-           W := (B => (DD => 1, DCOMP1 => 2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 5");
-           IF REC2_EQUAL (W,W) THEN
-                COMMENT ("DON'T OPTIMIZE W");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 5");
-      END;
- 
-      BEGIN
-           X := (D3 => 1, C => (D => 5, COMP1 => 2));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 6");
-           IF REC3_EQUAL (X,X) THEN
-                COMMENT ("DON'T OPTIMIZE X");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 6");
-      END;
- 
-      BEGIN
-           Y := (H => INIT (1));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - 7");
-           IF REC7_EQUAL (Y,Y) THEN
-                COMMENT ("DON'T OPTIMIZE Y");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 7");
-      END;
- 
-      RESULT;
- END C43004C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c431001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c431001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c431001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c431001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,464 ****
- -- C431001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a record aggregate can be given for a nonprivate,
- --      nonlimited record extension and that the tag of the aggregate 
- --      values are initialized to the tag of the record extension.
- --
- -- TEST DESCRIPTION:
- --      From an initial parent tagged type, several type extensions
- --      are declared. Each type extension adds components onto
- --      the existing record structure.
- --
- --      In the main procedure, aggregates are declared in two ways.
- --      In the declarative part, aggregates are used to supply
- --      initial values for objects of specific types. In the executable
- --      part, aggregates are used directly as actual parameters to
- --      a class-wide formal parameter.
- --
- --      The abstraction is for a catalog of recordings. A recording
- --      can be a CD or a record (vinyl). Additionally, a CD may also
- --      be a CD-ROM, containing both music and data. This type is declared
- --      as an extension to a type extension, to test that the inclusion
- --      of record components is transitive across multiple extensions.
- --
- --      That the aggregate has the correct tag is verify by feeding
- --      it to a dispatching operation and confirming that the
- --      expected subprogram is called as a result. To accomplish this,
- --      an enumeration type is declared with an enumeration literal
- --      representing each of the declared types in the hierarchy. A value
- --      of this type is passed as a parameter to the dispatching
- --      operation which passes it along to the dispatched subprogram.
- --      Each dispatched subprogram verifies that it received the
- --      expected enumeration literal.
- --
- --      Not quite fitting the above abstraction are several test cases
- --      for null records. These tests verify that the new syntax for
- --      null record aggregates, (null record), is supported. A type is
- --      declared which extends a null tagged type and adds components.
- --      Aggregates of this type should include associations for the
- --      components of the type extension only. Finally, a type is
- --      declared that adds a null type extension onto a non-null tagged
- --      type. The aggregate associations should remain the same.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --
- --!
- --
- package C431001_0 is
- 
-    -- Values of TC_Type_ID are passed through to dispatched subprogram
-    -- calls so that it can be verified that the dispatching resulted in
-    -- the expected call.
-    type TC_Type_ID is (TC_Recording, TC_CD, TC_Vinyl, TC_CD_ROM);
- 
-    type Genre is (Classical, Country, Jazz, Rap, Rock, World);
- 
-    type Recording is tagged record
-       Artist     : String (1..20);
-       Category   : Genre;
-       Length     : Duration;
-       Selections : Positive;
-    end record;
- 
-    function Summary (R       : in Recording;
-                      TC_Type : in TC_Type_ID) return String;
- 
-    type Recording_Method is (Audio, Digital);
-    type CD is new Recording with record
-       Recorded : Recording_Method;
-       Mastered : Recording_Method;
-    end record;
- 
-    function Summary (Disc    : in CD;
-                      TC_Type : in TC_Type_ID) return String;
- 
-    type Playing_Speed is (LP_33, Single_45, Old_78);
-    type Vinyl is new Recording with record
-       Speed : Playing_Speed;
-    end record;
- 
-    function Summary (Album   : in Vinyl;
-                      TC_Type : in TC_Type_ID)  return String;
-                        
- 
-    type CD_ROM is new CD with record
-       Storage : Positive;
-    end record;
- 
-    function Summary (Disk    : in CD_ROM;
-                      TC_Type : in TC_Type_ID)  return String;
-                        
-    function Catalog_Entry (R       : in Recording'Class;
-                            TC_Type : in TC_Type_ID) return String;
- 
-    procedure Print (S : in String); -- provides somewhere for the
-                                     -- results of Catalog_Entry to
-                                     -- "go", so they don't get
-                                     -- optimized away.
- 
-    -- The types and procedures declared below are not a continuation
-    -- of the Recording abstraction. These types are intended to test
-    -- support for null tagged types and type extensions. TC_Check mirrors
-    -- the operation of function Summary, above. Similarly, TC_Dispatch
-    -- mirrors the operation of Catalog_Entry.
- 
-    type TC_N_Type_ID is
-       (TC_Null_Tagged, TC_Null_Extension,
-        TC_Extension_Of_Null, TC_Null_Extension_Of_Nonnull);
- 
-    type Null_Tagged is tagged null record;
-    procedure TC_Check (N       : in Null_Tagged;
-                        TC_Type : in TC_N_Type_ID);
- 
-    type Null_Extension is new Null_Tagged with null record;
-    procedure TC_Check (N       : in Null_Extension;
-                        TC_Type : in TC_N_Type_ID);
-    
-    type Extension_Of_Null is new Null_Tagged with record
-       New_Component1 : Boolean;
-       New_Component2 : Natural;
-    end record;
-    procedure TC_Check (N       : in Extension_Of_Null;
-                        TC_Type : in TC_N_Type_ID);
- 
-    type Null_Extension_Of_Nonnull is new Extension_Of_Null
-       with null record;
-    procedure TC_Check (N       : in Null_Extension_Of_Nonnull;
-                        TC_Type : in TC_N_Type_ID);
- 
-    procedure TC_Dispatch (N       : in Null_Tagged'Class;
-                           TC_Type : in TC_N_Type_ID);
- 
- end C431001_0;
- 
- with Report;
- package body C431001_0 is
- 
-    function Summary (R       : in Recording;
-                      TC_Type : in TC_Type_ID) return String is
-    begin
- 
-       if TC_Type /= TC_Recording then
-          Report.Failed ("Did not dispatch on tag for tagged parent " &
-                         "type Recording");
-       end if;
- 
-       return R.Artist (1..10)
-              & ' ' & Genre'Image (R.Category) (1..2)
-              & ' ' & Duration'Image (R.Length)
-              & ' ' & Integer'Image (R.Selections);
- 
-    end Summary;
- 
-    function Summary (Disc    : in CD;
-                      TC_Type : in TC_Type_ID) return String is
-    begin
- 
-       if TC_Type /= TC_CD then
-          Report.Failed ("Did not dispatch on tag for type extension " &
-                         "CD");
-       end if;
- 
-       return Summary (Recording (Disc), TC_Type => TC_Recording)
-          & ' ' & Recording_Method'Image(Disc.Recorded)(1)
-          & Recording_Method'Image(Disc.Mastered)(1);
- 
-    end Summary;
- 
-    function Summary (Album   : in Vinyl;
-                      TC_Type : in TC_Type_ID)  return String is
-    begin
-       if TC_Type /= TC_Vinyl then
-          Report.Failed ("Did not dispatch on tag for type extension " &
-                         "Vinyl");
-       end if;
- 
-       case Album.Speed is
-       when LP_33 =>
-          return Summary (Recording (Album), TC_Type => TC_Recording)
-             & " 33";
-       when Single_45 =>
-          return Summary (Recording (Album), TC_Type => TC_Recording)      
-             & " 45";
-       when Old_78 =>
-          return Summary (Recording (Album), TC_Type => TC_Recording)      
-             & " 78";
-       end case;
- 
-    end Summary;
- 
-    function Summary (Disk    : in CD_ROM;
-                      TC_Type : in TC_Type_ID)  return String is
-    begin
-       if TC_Type /= TC_CD_ROM then
-          Report.Failed ("Did not dispatch on tag for type extension " &
-                         "CD_ROM. This is an extension of the type " &
-                         "extension CD");
-       end if;
- 
-       return Summary (Recording(Disk), TC_Type => TC_Recording)
-          & ' ' & Integer'Image (Disk.Storage) & 'K';
- 
-    end Summary;
- 
-    function Catalog_Entry (R       : in Recording'Class;
-                            TC_Type : in TC_Type_ID) return String is
-    begin
-       return Summary (R, TC_Type); -- dispatched call
-    end Catalog_Entry;
- 
-    procedure Print (S : in String) is
-       T : String (1..S'Length) := Report.Ident_Str (S);
-    begin
-       -- Ada.Text_IO.Put_Line (S);
-       null;
-    end Print;
-    
-    -- Bodies for null type checks
-    procedure TC_Check (N       : in Null_Tagged;
-                        TC_Type : in TC_N_Type_ID) is
-    begin
-       if TC_Type /= TC_Null_Tagged then
-          Report.Failed ("Did not dispatch on tag for null tagged " &
-                         "type Null_Tagged");
-       end if;
-    end TC_Check;
- 
-    procedure TC_Check (N       : in Null_Extension;
-                        TC_Type : in TC_N_Type_ID) is
-    begin
-       if TC_Type /= TC_Null_Extension then
-          Report.Failed ("Did not dispatch on tag for null tagged " &
-                         "type extension Null_Extension");
-       end if;
-    end TC_Check;
-    
-    procedure TC_Check (N       : in Extension_Of_Null;
-                        TC_Type : in TC_N_Type_ID) is
-    begin
-       if TC_Type /= TC_Extension_Of_Null then
-          Report.Failed
-             ("Did not dispatch on tag for extension of null parent" &
-              "type");
-       end if;
-    end TC_Check;
- 
-    procedure TC_Check (N       : in Null_Extension_Of_Nonnull;
-                        TC_Type : in TC_N_Type_ID) is
-    begin
-       if TC_Type /= TC_Null_Extension_Of_Nonnull then
-          Report.Failed
-             ("Did not dispatch on tag for null extension of nonnull " &
-              "parent type");
-       end if;
-    end TC_Check;
- 
-    procedure TC_Dispatch (N       : in Null_Tagged'Class;
-                           TC_Type : in TC_N_Type_ID) is
-    begin
-       TC_Check (N, TC_Type); -- dispatched call
-    end TC_Dispatch;
- 
- end C431001_0;
- 
- 
- with C431001_0;
- with Report;
- procedure C431001 is
- 
-    -- Tagged type
-    -- Named component associations
-    DAT : C431001_0.Recording :=
-       (Artist     => "Aerosmith           ",
-        Category   => C431001_0.Rock,
-        Length     => 48.5,
-        Selections => 10);
- 
-    -- Type extensions
-    -- Named component associations
-    Disc1 : C431001_0.CD :=
-       (Artist     => "London Symphony     ",
-        Category   => C431001_0.Classical,
-        Length     => 55.0,
-        Selections => 4,
-        Recorded   => C431001_0.Digital,
-        Mastered   => C431001_0.Digital);
-    
-    -- Named component associations with others
-    Disc2 : C431001_0.CD :=
-       (Artist     => "Pink Floyd          ",
-        Category   => C431001_0.Rock,
-        Length     => 51.8,
-        Selections => 5,
-        others     => C431001_0.Audio); -- Recorded
-                                        -- Mastered
-    
-    -- Positional component associations
-    Album1 : C431001_0.Vinyl :=
-       ("Hammer              ", -- Artist
-        C431001_0.Rap,          -- Category
-        46.2,                   -- Length
-        9,                      -- Selections
-        C431001_0.LP_33);       -- Speed
-    
-    -- Mixed positional and named component associations
-    -- Named component associations out of order
-    Album2 : C431001_0.Vinyl :=
-       ("Balinese Gamelan    ", -- Artist 
-        C431001_0.World,        -- Category
-        42.6,                   -- Length
-        14,                     -- Selections
-        C431001_0.LP_33);       -- Speed
-    
-    -- Type extension, parent is also type extension
-    -- Named notation, components out of order
-    Data : C431001_0.CD_ROM :=
-       (Storage    => 140,
-        Mastered   => C431001_0.Digital,
-        Category   => C431001_0.Rock,
-        Selections => 10,
-        Recorded   => C431001_0.Digital,
-        Artist     => "Black, Clint        ",
-        Length     => 48.5);
- 
-    -- Null tagged type
-    Null_Rec : C431001_0.Null_Tagged := (null record);
- 
-    -- Null type extension
-    Null_Ext : C431001_0.Null_Extension := (null record);
- 
-    -- Nonnull extension of null parent
-    Ext_Of_Null : C431001_0.Extension_Of_Null := (True, 0);
- 
-    -- Null extension of nonnull parent
-    Null_Ext_Of_Nonnull : C431001_0.Null_Extension_Of_Nonnull
-       := (False, 1);
- 
- begin
- 
-    Report.Test ("C431001", "Aggregate values for type extensions");
- 
-    C431001_0.Print (C431001_0.Catalog_Entry (DAT, C431001_0.TC_Recording));
-    C431001_0.Print (C431001_0.Catalog_Entry (Disc1, C431001_0.TC_CD));
-    C431001_0.Print (C431001_0.Catalog_Entry (Disc2, C431001_0.TC_CD));
-    C431001_0.Print (C431001_0.Catalog_Entry (Album1, C431001_0.TC_Vinyl));
-    C431001_0.Print (C431001_0.Catalog_Entry (Album2, C431001_0.TC_Vinyl));
-    C431001_0.Print (C431001_0.Catalog_Entry (Data, C431001_0.TC_CD_ROM));
- 
-    C431001_0.TC_Dispatch (Null_Rec, C431001_0.TC_Null_Tagged);
-    C431001_0.TC_Dispatch (Null_Ext, C431001_0.TC_Null_Extension);
-    C431001_0.TC_Dispatch (Ext_Of_Null, C431001_0.TC_Extension_Of_Null);
-    C431001_0.TC_Dispatch
-       (Null_Ext_Of_Nonnull, C431001_0.TC_Null_Extension_Of_Nonnull);
- 
-    -- Tagged type
-    -- Named component associations
-    C431001_0.Print (C431001_0.Catalog_Entry
-       (TC_Type => C431001_0.TC_Recording,
-        R => C431001_0.Recording'(Artist     => "Zappa, Frank        ",
-                                  Category   => C431001_0.Rock,
-                                  Length     => 70.0,
-                                  Selections => 38)));
- 
-    -- Type extensions
-    -- Named component associations
-    C431001_0.Print (C431001_0.Catalog_Entry
-       (TC_Type => C431001_0.TC_CD,
-        R => C431001_0.CD'(Artist     => "Dog, Snoop Doggy    ",
-                           Category   => C431001_0.Rap,
-                           Length     => 37.3,
-                           Selections => 8,
-                           Recorded   => C431001_0.Audio,
-                           Mastered   => C431001_0.Digital)));
- 
-    -- Named component associations with others
-    C431001_0.Print (C431001_0.Catalog_Entry
-       (TC_Type => C431001_0.TC_CD,
-        R => C431001_0.CD'(Artist     => "Judd, Winona        ",
-                           Category   => C431001_0.Country,
-                           Length     => 51.2,
-                           Selections => 11,
-                           others     => C431001_0.Digital))); -- Recorded
-                                                               -- Mastered
- 
-    -- Positional component associations
-    C431001_0.Print (C431001_0.Catalog_Entry
-       (TC_Type => C431001_0.TC_Vinyl,
-        R => C431001_0.Vinyl'("Davis, Miles        ",  -- Artist
-                               C431001_0.Jazz,         -- Category
-                               50.4,                   -- Length
-                               10,                     -- Selections
-                               C431001_0.LP_33)));      -- Speed
- 
-    -- Mixed positional and named component associations
-    -- Named component associations out of order
-    C431001_0.Print (C431001_0.Catalog_Entry
-       (TC_Type => C431001_0.TC_Vinyl,
-        R => C431001_0.Vinyl'("Zamfir              ",    -- Artist
-                               C431001_0.World,          -- Category
-                               Speed => C431001_0.LP_33,
-                               Selections => 14,
-                               Length => 56.5)));
- 
-    -- Type extension, parent is also type extension
-    -- Named notation, components out of order
-    C431001_0.Print (C431001_0.Catalog_Entry
-       (TC_Type => C431001_0.TC_CD_ROM,
-        R => C431001_0.CD_ROM'(Storage         => 720,
-                               Category        => C431001_0.Classical,
-                               Recorded        => C431001_0.Digital,
-                               Artist          => "Baltimore Symphony  ",
-                               Length          => 68.9,
-                               Mastered        => C431001_0.Digital,
-                               Selections      => 5)));
-    
-    -- Null tagged type
-    C431001_0.TC_Dispatch
-       (TC_Type => C431001_0.TC_Null_Tagged,
-        N => C431001_0.Null_Tagged'(null record));
- 
-    -- Null type extension
-    C431001_0.TC_Dispatch
-       (TC_Type => C431001_0.TC_Null_Extension,
-        N => C431001_0.Null_Extension'(null record));
- 
-    -- Nonnull extension of null parent
-    C431001_0.TC_Dispatch
-       (TC_Type => C431001_0.TC_Extension_Of_Null,
-        N => C431001_0.Extension_Of_Null'(True, 3));
- 
-    -- Null extension of nonnull parent
-    C431001_0.TC_Dispatch
-       (TC_Type => C431001_0.TC_Extension_Of_Null,
-        N => C431001_0.Extension_Of_Null'(False, 4));
- 
-    Report.Result;
- 
- end C431001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43103a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43103a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43103a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- C43103A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN A VARIANT PART,
- -- ITS VALUE CAN BE GIVEN BY A NON-STATIC EXPRESSION.
- 
- -- EG  02/13/84
- 
- WITH REPORT;
- 
- PROCEDURE C43103A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43103A","CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN " &
-                     "A VARIANT PART, ITS VALUE CAN BE GIVEN BY A "  &
-                     "NON-STATIC EXPRESSION");
- 
-      BEGIN
- 
-           COMMENT ("CASE A : DISCRIMINANT THAT IS NOT USED INSIDE " &
-                    "THE RECORD");
- 
- CASE_A :  DECLARE
- 
-                TYPE R1 (A : INTEGER) IS
-                     RECORD
-                          B : STRING(1 .. 2);
-                          C : INTEGER;
-                     END RECORD;
- 
-                A1 : R1(IDENT_INT(5)) := (IDENT_INT(5), "AB", -2);
- 
-           BEGIN
- 
-                IF A1.A /= IDENT_INT(5) OR A1.B /= "AB" OR 
-                   A1.C /= -2 THEN
-                     FAILED ("CASE A : INCORRECT VALUES IN RECORD");
-                END IF;
- 
-           END CASE_A;
- 
-           COMMENT ("CASE B : DISCRIMINANT THAT IS USED AS AN ARRAY " &
-                    "INDEX BOUND");
- 
- CASE_B :  DECLARE
- 
-                SUBTYPE STB IS INTEGER RANGE 1 .. 10;
-                TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
-                TYPE R2 (A : STB) IS
-                     RECORD
-                          B : TB(1 .. A);
-                          C : BOOLEAN;
-                     END RECORD;
- 
-                B1 : R2(IDENT_INT(2)) := (IDENT_INT(2), (-1, -2), FALSE);
- 
-           BEGIN
- 
-                IF B1.B'LAST /= IDENT_INT(2) THEN
-                     FAILED ("CASE B : INCORRECT UPPER BOUND");
-                ELSIF B1.A /= IDENT_INT(2) OR B1.B /= (-1, -2) OR
-                      B1.C /= FALSE THEN
-                     FAILED ("CASE B : INCORRECT VALUES IN RECORD");
-                END IF;
- 
-           END CASE_B;
- 
-           COMMENT ("CASE C : DISCRIMINANT THAT IS USED IN A " &
-                    "DISCRIMINANT CONSTRAINT");
- 
- CASE_C :  DECLARE
- 
-                SUBTYPE STC IS INTEGER RANGE 1 .. 10;
-                TYPE TC IS ARRAY(STC RANGE <>) OF INTEGER;
-                TYPE R3 (A : STC) IS
-                     RECORD
-                          B : TC(1 .. A);
-                          C : INTEGER := -4;
-                     END RECORD;
-                TYPE R4 (A : INTEGER) IS
-                     RECORD
-                          B : R3(A);
-                          C : INTEGER;
-                     END RECORD;
- 
-                C1 : R4(IDENT_INT(3)) := (IDENT_INT(3), 
-                                          (IDENT_INT(3), (1, 2, 3), 4),
-                                          5);
- 
-           BEGIN
- 
-                IF C1.B.B /= (1, 2, 3) OR C1.B.C /= 4 OR
-                   C1.C   /= 5 THEN
-                     FAILED ("CASE C : INCORRECT VALUES IN RECORD");
-                END IF;
- 
-           END CASE_C;
- 
-      END;
- 
-      RESULT;
- 
- END C43103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43103b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43103b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43103b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- C43103B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN A VARIANT PART, ITS
- -- VALUE CAN BE GIVEN BY A NONSTATIC EXPRESSION.
- -- ADDITIONAL CASES OF USE OF A DISCRIMINANT THAT IS USED AS AN
- -- ARRAY INDEX BOUND.
- 
- -- PK  02/21/84
- -- EG  05/30/84
- -- EG  11/02/84
- -- DN  12/01/95  REMOVED CONFORMANCE CHECKS WHERE RULES RELAXED.
- -- PWN 10/25/96  RESTORED CHECK WITH ADA 95 EXPECTED RESULTS INCLUDED.
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE C43103B IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 3;
- 
-      TYPE A2 IS ARRAY(INT RANGE <>, INT RANGE <>) OF INTEGER;
- 
-      SUBTYPE DINT IS INTEGER RANGE 0 .. 10;
-           
-      TYPE REC(D, E : DINT := IDENT_INT(1)) IS RECORD
-           U : A2(1 .. D, E .. 3) := (1 .. D =>
-                                      (E .. 3 => IDENT_INT(1)));
-      END RECORD;
- 
- BEGIN
- 
-      TEST("C43103B","CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN " &
-                     "A VARIANT PART, ITS VALUE CAN BE GIVEN BY A "  &
-                     "NONSTATIC EXPRESSION");
- 
- -- SIMPLE DECLARATIONS
- 
-      BEGIN
- 
-           DECLARE
- 
-                L : REC(IDENT_INT(2), IDENT_INT(2));
-                K : REC(IDENT_INT(0), IDENT_INT(1));
-                M : REC(IDENT_INT(3), IDENT_INT(4));
- 
-           BEGIN
-                IF L.U'FIRST(1) /= IDENT_INT(1) OR
-                   L.U'LAST(1)  /= IDENT_INT(2) OR
-                   L.U'FIRST(2) /= IDENT_INT(2) OR
-                   L.U'LAST(2)  /= IDENT_INT(3) THEN
-                     FAILED("1.1 - INCORRECT BOUNDS");
-                END IF;
-                IF K.U'FIRST(1) /= IDENT_INT(1) OR
-                   K.U'LAST(1)  /= IDENT_INT(0) OR
-                   K.U'FIRST(2) /= IDENT_INT(1) OR
-                   K.U'LAST(2)  /= IDENT_INT(3) THEN
-                     FAILED("1.2 - INCORRECT BOUNDS");
-                END IF;
-                IF M.U'FIRST(1) /= IDENT_INT(1) OR
-                   M.U'LAST(1)  /= IDENT_INT(3) OR
-                   M.U'FIRST(2) /= IDENT_INT(4) OR
-                   M.U'LAST(2)  /= IDENT_INT(3) THEN
-                     FAILED("1.3 - INCORRECT BOUNDS");
-                END IF;
-                IF M.U'LENGTH(1) /= 3 OR M.U'LENGTH(2) /= 0 THEN
-                     FAILED("1.4 - INCORRECT ARRAY LENGTH");
-                END IF;
-           END;
- 
-      EXCEPTION
- 
-           WHEN OTHERS => 
-                FAILED ("1.5 - EXCEPTION RAISED");
- 
-      END;
- 
- -- EXPLICIT INITIAL VALUE - OK
- 
-      BEGIN
- 
-           DECLARE
-                O : CONSTANT REC := (IDENT_INT(2), IDENT_INT(2),
-                         ((1, IDENT_INT(2)), (IDENT_INT(2), 3)));
-           BEGIN
-                IF O.U'FIRST(1) /= IDENT_INT(1) OR
-                   O.U'LAST(1)  /= IDENT_INT(2) OR
-                   O.U'FIRST(2) /= IDENT_INT(2) OR
-                   O.U'LAST(2)  /= IDENT_INT(3) THEN
-                     FAILED("2.1 - INCORRECT BOUNDS");
-                END IF;
-           END;
- 
-      EXCEPTION
- 
-           WHEN OTHERS => 
-                FAILED ("2.2 - EXCEPTION RAISED");
-      END;
- 
- -- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS
- 
-      BEGIN
- 
-           DECLARE
-                P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
-                                     (IDENT_INT(3) .. IDENT_INT(0) =>
-                                      (IDENT_INT(2), 3)));
-           BEGIN
-                 NULL;
-           END;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("3.1 -  CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS => 
-                FAILED ("3.2 -  WRONG EXCEPTION RAISED");
-      END;
-  
- -- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS
- 
-      BEGIN
- 
-           DECLARE
-                P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
-                                     (IDENT_INT(3) .. IDENT_INT(0) =>
-                                      (OTHERS => IDENT_INT(2))));
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => 
-                FAILED ("4.1 - CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS => 
-                FAILED ("4.2 - WRONG EXCEPTION RAISED");
- 
-      END;
- 
- -- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS 2ND DIM.
- 
-      BEGIN
- 
-           DECLARE
-                P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
-                                     (IDENT_INT(1) .. IDENT_INT(0) =>
-                                      (IDENT_INT(1) .. IDENT_INT(2) =>
-                                       1)));
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => 
-                FAILED ("5.1 - CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS => 
-                FAILED ("5.2 - WRONG EXCEPTION RAISED");
- 
-      END;
-               
-      RESULT;
- 
- END C43103B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43104a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C43104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WITH THE TYPE OF THE AGGREGATE RESOLVED, THE
- --     DISCRIMINANT MAY BE USED TO DECIDE TO WHICH OF THE VARIANT'S
- --     SUBTYPES THE AGGREGATE BELONGS.
- 
- -- HISTORY:
- --     DHH 08/08/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43104A IS
- 
-      TYPE INT IS RANGE 0 .. 10;
- 
-      TYPE VAR_REC(BOOL : BOOLEAN := TRUE) IS
-           RECORD
-                CASE BOOL IS
-                     WHEN TRUE =>
-                          X : INTEGER;
-                     WHEN FALSE =>
-                          Y : INT;
-                END CASE;
-           END RECORD;
- 
-      SUBTYPE S_TRUE IS VAR_REC(TRUE);
-      SUBTYPE S_FALSE IS VAR_REC(FALSE);
- 
-      PROCEDURE CHECK(P : IN S_TRUE) IS
-      BEGIN
-           IF P.BOOL = FALSE THEN
-                FAILED("WRONG PROCEDURE ENTERED");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
- 
-      END CHECK;
- 
- BEGIN
-      TEST("C43104A", "CHECK THAT WITH THE TYPE OF THE AGGREGATE " &
-                      "RESOLVED, THE DISCRIMINANT MAY BE USED TO " &
-                      "DECIDE TO WHICH OF THE VARIANT'S SUBTYPES " &
-                      "THE AGGREGATE BELONGS");
- 
-      CHECK((TRUE, 1));
- 
-      BEGIN
- 
-           CHECK((FALSE, 2));
-           FAILED("PROCEDURE CALL USING '(FALSE, 2)' DID NOT RAISE " &
-                  "EXCEPTION");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED("INCORRECT EXCEPTION RAISED ON PROCEDURE CALL " &
-                       "USING '(FALSE,2)'");
-      END;
- 
-      RESULT;
- END C43104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43105a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43105a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43105a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C43105A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IN A RECORD AGGREGATE, (X => E, Y => E), WHERE E IS AN OVERLOADED
- --     ENUMERATION LITERAL, OVERLOADING RESOLUTION OCCURS SEPARATELY FOR
- --     THE DIFFERENT OCCURRENCES OF E.
- 
- -- HISTORY:
- --     DHH 08/10/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43105A IS
- 
- BEGIN
-      TEST("C43105A", "IN A RECORD AGGREGATE, (X => E, Y => E), WHERE " &
-                      "E IS AN OVERLOADED ENUMERATION LITERAL, " &
-                      "OVERLOADING RESOLUTION OCCURS SEPARATELY FOR " &
-                      "THE DIFFERENT OCCURRENCES OF E");
- 
-      DECLARE
-           TYPE COLOR IS (RED, YELLOW, GREEN);
-           TYPE PALETTE IS (GREEN, YELLOW, RED);
- 
-           TYPE REC IS
-                RECORD
-                     X : COLOR;
-                     Y : PALETTE;
-                END RECORD;
- 
-           TYPE RECD IS
-                RECORD
-                     X : PALETTE;
-                     Y : COLOR;
-                END RECORD;
- 
-           REC1 : REC;
-           REC2 : RECD;
- 
-           FUNCTION IDENT_C(C : COLOR) RETURN COLOR IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN C;
-                ELSE
-                     RETURN GREEN;
-                END IF;
-           END IDENT_C;
- 
-           FUNCTION IDENT_P(P : PALETTE) RETURN PALETTE IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN P;
-                ELSE
-                     RETURN RED;
-                END IF;
-           END IDENT_P;
- 
- 
-      BEGIN
-           REC1 := (X => YELLOW, Y => YELLOW);
-           REC2 := (X => YELLOW, Y => YELLOW);
- 
-           IF REC1.X /= IDENT_C(REC2.Y) THEN
-                FAILED("COLOR RESOLUTION FAILED");
-           END IF;
- 
-           IF REC1.Y /= IDENT_P(REC2.X) THEN
-                FAILED("PALETTE RESOLUTION FAILED");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C43105A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43105b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43105b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43105b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43105b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C43105B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IN A RECORD AGGREGATE (X => E, Y => E), WHERE E IS AN OVERLOADED
- --     FUNCTION CALL, OVERLOADING RESOLUTION OCCURS SEPARATELY FOR THE
- --     DIFFERENT OCCURRENCES OF E.
- 
- -- HISTORY:
- --     DHH 09/07/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43105B IS
- BEGIN
-      TEST ("C43105B", "IN A RECORD AGGREGATE (X => E, Y => E), WHERE " &
-                       "E IS AN OVERLOADED FUNCTION CALL, OVERLOADING " &
-                       "RESOLUTION OCCURS SEPARATELY FOR THE " &
-                       "DIFFERENT OCCURRENCES OF E");
- 
-      DECLARE
-           TYPE COLOR IS (RED, YELLOW, GREEN);
-           TYPE PALETTE IS (GREEN, YELLOW, RED);
- 
-           TYPE REC IS
-                RECORD
-                     X : COLOR;
-                     Y : PALETTE;
-                END RECORD;
- 
-           TYPE RECD IS
-                RECORD
-                     X : PALETTE;
-                     Y : COLOR;
-                END RECORD;
- 
-           REC1 : REC;
-           REC2 : RECD;
- 
-           FUNCTION IDENT_C(C : COLOR) RETURN COLOR IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN C;
-                ELSE
-                     RETURN GREEN;
-                END IF;
-           END IDENT_C;
- 
-           FUNCTION IDENT_C(P : PALETTE) RETURN PALETTE IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN P;
-                ELSE
-                     RETURN RED;
-                END IF;
-           END IDENT_C;
- 
-      BEGIN
-           REC1 := (X => IDENT_C(YELLOW), Y => IDENT_C(YELLOW));
-           REC2 := (X => IDENT_C(YELLOW), Y => IDENT_C(YELLOW));
- 
-           IF REC1.X /= REC2.Y THEN
-                FAILED("COLOR FUNCTION RESOLUTION FAILED");
-           END IF;
- 
-           IF REC1.Y /= REC2.X THEN
-                FAILED("PALETTE FUNCTION RESOLUTION FAILED");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("EXCEPTION RAISED");
-      END;
-      RESULT;
- END C43105B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43106a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C43106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT BOTH NAMED AND POSITIONAL NOTATIONS ARE PERMITTED
- --     WITHIN THE SAME RECORD AGGREGATE, (PROVIDED THAT ALL POSITIONAL
- --     ASSOCIATIONS APPEAR BEFORE ANY NAMED ASSOCIATION).
- 
- -- HISTORY:
- --     DHH 08/10/88 CREATED ORIGIANL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43106A IS
- 
-      TYPE REC IS
-           RECORD
-                A : INTEGER;
-                B : CHARACTER;
-                C : BOOLEAN;
-                D, E, F, G : INTEGER;
-                H, I, J, K : CHARACTER;
-                L, M, N, O : BOOLEAN;
-                P, Q, R, S : STRING(1 .. 3);
-                T, U, V, W, X, Y, Z : BOOLEAN;
-           END RECORD;
-      AGG : REC := (12, 'A', TRUE, 1, 2, 3, 4, 'B', 'C', 'D', 'E',
-                    P|R => "ABC", S|Q => "DEF", L|X|O|U => TRUE,
-                    OTHERS => FALSE);
- 
-      FUNCTION IDENT_CHAR(X : CHARACTER) RETURN CHARACTER IS
-      BEGIN
-           IF EQUAL(3, 3) THEN
-                RETURN X;
-           ELSE
-                RETURN 'Z';
-           END IF;
-      END IDENT_CHAR;
- 
- BEGIN
-      TEST("C43106A", "CHECK THAT BOTH NAMED AND POSITIONAL NOTATIONS " &
-                      "ARE PERMITTED WITHIN THE SAME RECORD " &
-                      "AGGREGATE, (PROVIDED THAT ALL POSITIONAL " &
-                      "ASSOCIATIONS APPEAR BEFORE ANY NAMED " &
-                      "ASSOCIATION)");
- 
-      IF NOT IDENT_BOOL(AGG.C) OR NOT IDENT_BOOL(AGG.L) OR
-         NOT IDENT_BOOL(AGG.X) OR NOT IDENT_BOOL(AGG.O) OR
-         NOT IDENT_BOOL(AGG.U) OR IDENT_BOOL(AGG.M) OR
-             IDENT_BOOL(AGG.N) OR IDENT_BOOL(AGG.T) OR
-             IDENT_BOOL(AGG.V) OR IDENT_BOOL(AGG.W) OR
-             IDENT_BOOL(AGG.Y) OR IDENT_BOOL(AGG.Z) THEN
-           FAILED("BOOLEANS NOT INITIALIZED TO AGGREGATE VALUES");
-      END IF;
- 
-      IF IDENT_STR(AGG.P) /= IDENT_STR(AGG.R) OR
-         IDENT_STR(AGG.Q) /= IDENT_STR(AGG.S) THEN
-           FAILED("STRINGS NOT INITIALIZED CORRECTLY");
-      END IF;
- 
-      IF IDENT_CHAR(AGG.B) /= IDENT_CHAR('A') OR
-         IDENT_CHAR(AGG.H) /= IDENT_CHAR('B') OR
-         IDENT_CHAR(AGG.I) /= IDENT_CHAR('C') OR
-         IDENT_CHAR(AGG.J) /= IDENT_CHAR('D') OR
-         IDENT_CHAR(AGG.K) /= IDENT_CHAR('E') THEN
-           FAILED("CHARACTERS NOT INITIALIZED CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C43106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43107a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43107a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43107a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C43107A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXPRESSION ASSOCIATED WITH MORE THAN ONE RECORD
- -- COMPONENT IS EVALUATED ONCE FOR EACH ASSOCIATED COMPONENT.
- 
- -- EG  02/14/84
- 
- WITH REPORT;
- 
- PROCEDURE C43107A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43107A","CHECK THAT AN EXPRESSION WITH MORE THAN ONE " &
-                     "RECORD COMPONENT IS EVALUATED ONCE FOR EACH " &
-                     "ASSOCIATED COMPONENT");
- 
-      BEGIN
- 
- CASE_A :  DECLARE
- 
-                TYPE T1 IS ARRAY(1 .. 2) OF INTEGER;
-                TYPE R1 IS
-                     RECORD
-                          A : T1;
-                          B : INTEGER;
-                          C : T1;
-                          D : INTEGER;
-                          E : INTEGER;
-                     END RECORD;
- 
-                A1   : R1;
-                CNTR : INTEGER := 0;
- 
-                FUNCTION FUN1 (A : T1) RETURN T1 IS
-                BEGIN
-                     CNTR := IDENT_INT(CNTR+1);
-                     RETURN A;
-                END FUN1;
- 
-                FUNCTION FUN2 (A : INTEGER) RETURN INTEGER IS
-                BEGIN
-                     CNTR := CNTR+1;
-                     RETURN IDENT_INT(A);
-                END FUN2;
- 
-           BEGIN
- 
-                A1 := (A | C => FUN1((-1, -2)), OTHERS => FUN2(-3)+1);
-                IF CNTR /= 5 THEN
-                     FAILED ("CASE A : INCORRECT NUMBER OF EVALUATIONS" &
-                             " OF RECORD ASSOCIATED COMPONENTS");
-                END IF;
-                IF A1.A /= (-1, -2) OR A1.C /= (-1, -2) OR
-                   A1.B /= -2 OR A1.D /= -2 OR A1.E /= -2 THEN
-                     FAILED ("CASE A : INCORRECT VALUES IN RECORD");
-                END IF;
- 
-           END CASE_A;
- 
- CASE_B :  DECLARE
- 
-                TYPE T2 IS ACCESS INTEGER;
-                TYPE R2 IS
-                     RECORD
-                          A : T2;
-                          B : INTEGER;
-                          C : T2;
-                          D : INTEGER;
-                          E : INTEGER;
-                     END RECORD;
- 
-                B1   : R2;
-                CNTR : INTEGER := 0;
- 
-                FUNCTION FUN3 RETURN INTEGER IS
-                BEGIN
-                     CNTR := CNTR+1;
-                     RETURN IDENT_INT(2);
-                END FUN3;
- 
-           BEGIN
- 
-                B1 := (A | C => NEW INTEGER'(-1),
-                       B | D | E => FUN3);
-                IF B1.A = B1.C OR CNTR /= 3 THEN
-                     FAILED ("CASE B : INCORRECT NUMBER OF EVALUATION" &
-                             " OF RECORD ASSOCIATED COMPONENTS");
-                END IF;
-                IF B1.B /= 2 OR B1.D /= 2 OR B1.E /= 2 OR
-                   B1.A = NULL OR B1.C = NULL OR B1.A = B1.C THEN
-                     FAILED ("CASE B : INCORRECT VALUES IN RECORD");
-                END IF;
- 
-           END CASE_B;
- 
-      END;
- 
-      RESULT;
- 
- END C43107A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43108a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43108a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43108a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C43108A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IN A RECORD AGGREGATE THE VALUE OF A DISCRIMINANT IS
- --     USED TO RESOLVE THE TYPE OF A COMPONENT THAT DEPENDS ON THE
- --     DISCRIMINANT.
- 
- -- HISTORY:
- --     DHH 09/08/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43108A IS
- 
- BEGIN
-      TEST ("C43108A", "CHECK THAT IN A RECORD AGGREGATE THE VALUE OF " &
-                       "A DISCRIMINANT IS USED TO RESOLVE THE TYPE OF " &
-                       "A COMPONENT THAT DEPENDS ON THE DISCRIMINANT");
- 
-      DECLARE
-           A : INTEGER;
- 
-           TYPE DIS(A : BOOLEAN) IS
-                RECORD
-                     CASE A IS
-                          WHEN TRUE =>
-                               B : BOOLEAN;
-                               C : INTEGER;
-                          WHEN FALSE =>
-                               D : INTEGER;
-                     END CASE;
-                END RECORD;
- 
-           FUNCTION DIFF(PARAM : DIS) RETURN INTEGER IS
-           BEGIN
-                IF PARAM.B THEN
-                     RETURN PARAM.C;
-                ELSE
-                     RETURN PARAM.D;
-                END IF;
-           END DIFF;
- 
-      BEGIN
-           A := DIFF((C => 3, OTHERS => TRUE));
- 
-           IF A /= IDENT_INT(3) THEN
-                FAILED("STATIC OTHERS NOT DECIDED CORRECTLY");
-           END IF;
-      END;
- 
-      DECLARE
-           GLOBAL : INTEGER := 0;
-           TYPE INT IS NEW INTEGER;
- 
-           TYPE DIS(A : BOOLEAN) IS
-                RECORD
-                     CASE A IS
-                          WHEN TRUE =>
-                               I1 : INT;
-                          WHEN FALSE =>
-                               I2 : INTEGER;
-                     END CASE;
-                END RECORD;
-           FUNCTION F RETURN INT;
-           FUNCTION F RETURN INTEGER;
- 
-           A : DIS(TRUE);
- 
-           FUNCTION F RETURN INT IS
-           BEGIN
-                GLOBAL := 1;
-                RETURN 5;
-           END F;
- 
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                GLOBAL := 2;
-                RETURN 5;
-           END F;
- 
-      BEGIN
-           A := (TRUE, OTHERS => F);
- 
-           IF GLOBAL /= 1 THEN
-                FAILED("NON_STATIC OTHERS NOT DECIDED CORRECTLY");
-           END IF;
-      END;
- 
-      RESULT;
- END C43108A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,512 ****
- -- C432001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --
- --      Check that extension aggregates may be used to specify values
- --      for types that are record extensions. Check that the
- --      type of the ancestor expression may be any nonlimited type that
- --      is a record extension, including private types and private
- --      extensions. Check that the type for the aggregate is
- --      derived from the type of the ancestor expression.
- --
- -- TEST DESCRIPTION:
- --
- --      Two progenitor nonlimited record types are declared, one
- --      nonprivate and one private. Using these as parent types,
- --      all possible combinations of record extensions are declared
- --      (Nonprivate record extension of nonprivate type, private
- --      extension of nonprivate type, nonprivate record extension of
- --      private type, and private extension of private type). Finally,
- --      each of these types is extended using nonprivate record
- --      extensions.
- --
- --      Extension of private types is done in packages other than
- --      the ones containing the parent declaration. This is done
- --      to eliminate errors with extension of the partial view of
- --      a type, which is not an objective of this test.
- --
- --      All components of private types and private extensions are given
- --      default values. This eliminates the need for separate subprograms
- --      whose sole purpose is to place a value into a private record type.
- --
- --      Types that have been extended are checked using an object of their
- --      parent type as the ancestor expression. For those types that
- --      have been extended twice, using only nonprivate record extensions,
- --      a check is made using an object of their grandparent type as
- --      the ancestor expression.
- --      
- --      For each type, a subprogram is defined which checks the contents
- --      of the parameter, which is a value of the record extension.
- --      Components of nonprivate record extensions are checked against
- --      passed-in parameters of the component type. Components of private
- --      extensions are checked to ensure that they maintain their initial
- --      values.
- --
- --      To check that the aggregate's type is derived from its ancestor,
- --      each Check subprogram in turn calls the Check subprogram for
- --      its parent type. Explicit conversion is used to convert the
- --      record extension to the parent type.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- package C432001_0 is
- 
-    type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);
- 
-    type N is tagged record
-       How_Long_Ago : Natural := Report.Ident_Int(1);
-       Era          : Eras := Cenozoic;
-    end record;
- 
-    function Check (Rec : in N;
-                    N   : in Natural;
-                    E   : in Eras) return Boolean;
- 
-    type P is tagged private;
- 
-    function Check (Rec : in P) return Boolean;
- 
- private
- 
-    type P is tagged record
-       How_Long_Ago : Natural := Report.Ident_Int(150);
-       Era          : Eras := Mesozoic;
-    end record;
- 
- end C432001_0;
- 
- package body C432001_0 is
- 
-    function Check (Rec : in P) return Boolean is
-    begin
-       return Rec.How_Long_Ago = 150 and Rec.Era = Mesozoic;
-    end Check;
- 
-    function Check (Rec : in N;
-                    N   : in Natural;
-                    E   : in Eras) return Boolean is
-    begin
-       return Rec.How_Long_Ago = N and Rec.Era = E;
-    end Check;
- 
- end C432001_0;
- 
- with C432001_0;
- package C432001_1 is
- 
-    type Periods is
-       (Aphebian, Helikian, Hadrynian,
-        Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,
-        Triassic, Jurassic, Cretaceous,
-        Tertiary, Quaternary);
- 
-    type N_N is new C432001_0.N with record
-       Period : Periods := C432001_1.Quaternary;
-    end record;
- 
-    function Check (Rec : in N_N;
-                    N   : in Natural;
-                    E   : in C432001_0.Eras;
-                    P   : in Periods) return Boolean;
- 
-    type N_P is new C432001_0.N with private;
- 
-    function Check (Rec : in N_P) return Boolean;
- 
-    type P_N is new C432001_0.P with record
-       Period : Periods := C432001_1.Jurassic;
-    end record;
- 
-    function Check (Rec : in P_N;
-                    P   : in Periods) return Boolean;
- 
-    type P_P is new C432001_0.P with private;
- 
-    function Check (Rec : in P_P) return Boolean;
- 
-    type P_P_Null is new C432001_0.P with null record;  
- 
- private
- 
-    type N_P is new C432001_0.N with record
-       Period : Periods := C432001_1.Quaternary;
-    end record;
- 
-    type P_P is new C432001_0.P with record
-       Period : Periods := C432001_1.Jurassic;
-    end record;
- 
- end C432001_1;
- 
- with Report;
- package body C432001_1 is
- 
-    function Check (Rec : in N_N;
-                    N   : in Natural;
-                    E   : in C432001_0.Eras;
-                    P   : in Periods) return Boolean is
-    begin
-       if not C432001_0.Check (C432001_0.N (Rec), N, E) then
-          Report.Failed ("Conversion to parent type of " &
-                         "nonprivate portion of " &
-                         "nonprivate extension failed");
-       end if;
-       return Rec.Period = P;
-    end Check;
-    
- 
-    function Check (Rec : in N_P) return Boolean is
-    begin
-       if not C432001_0.Check (C432001_0.N (Rec), 1, C432001_0.Cenozoic) then
-          Report.Failed ("Conversion to parent type of " &
-                         "nonprivate portion of " &
-                         "private extension failed");
-       end if;
-       return Rec.Period = C432001_1.Quaternary;
-    end Check;
- 
-    function Check (Rec : in P_N;
-                    P   : in Periods) return Boolean is
-    begin
-       if not C432001_0.Check (C432001_0.P (Rec)) then
-          Report.Failed ("Conversion to parent type of " &
-                         "private portion of " &
-                         "nonprivate extension failed");
-       end if;
-       return Rec.Period = P;
-    end Check;
- 
-    function Check (Rec : in P_P) return Boolean is
-    begin
-       if not C432001_0.Check (C432001_0.P (Rec)) then
-          Report.Failed ("Conversion to parent type of " &
-                         "private portion of " &
-                         "private extension failed");
-       end if;
-       return Rec.Period = C432001_1.Jurassic;
-    end Check;
- 
- end C432001_1;
- 
- with C432001_0;
- with C432001_1;
- package C432001_2 is
- 
-    -- All types herein are nonprivate extensions, since aggregates
-    -- cannot be given for private extensions
-    
-    type N_N_N is new C432001_1.N_N with record
-       Sample_On_Loan : Boolean;
-    end record;
- 
-    function Check (Rec : in N_N_N;
-                    N   : in Natural;
-                    E   : in C432001_0.Eras;
-                    P   : in C432001_1.Periods;
-                    B   : in Boolean) return Boolean;
- 
-    type N_P_N is new C432001_1.N_P with record
-       Sample_On_Loan : Boolean;
-    end record;
- 
-    function Check (Rec : in N_P_N;
-                    B   : Boolean) return Boolean;
- 
-    type P_N_N is new C432001_1.P_N with record
-       Sample_On_Loan : Boolean;
-    end record;
- 
-    function Check (Rec : in P_N_N;
-                    P   : in C432001_1.Periods;
-                    B   : Boolean) return Boolean;
- 
-    type P_P_N is new C432001_1.P_P with record
-       Sample_On_Loan : Boolean;
-    end record;
- 
-    function Check (Rec : in P_P_N;
-                    B   : Boolean) return Boolean;
- 
- end C432001_2;
- 
- with Report;
- package body C432001_2 is
- 
-    -- direct access to operator
-    use type C432001_1.Periods;
- 
- 
-    function Check (Rec : in N_N_N;
-                    N   : in Natural;
-                    E   : in C432001_0.Eras;
-                    P   : in C432001_1.Periods;
-                    B   : in Boolean) return Boolean is
-    begin
-       if not C432001_1.Check (C432001_1.N_N (Rec), N, E, P) then
-          Report.Failed ("Conversion to parent " &
-                         "nonprivate type extension " &
-                         "failed");
-       end if;
-       return Rec.Sample_On_Loan = B;
-    end Check;
-    
- 
-    function Check (Rec : in N_P_N;
-                    B   : Boolean) return Boolean is
-    begin
-       if not C432001_1.Check (C432001_1.N_P (Rec)) then
-          Report.Failed ("Conversion to parent " &
-                         "private type extension " &
-                         "failed");
-       end if;
-       return Rec.Sample_On_Loan = B;
-    end Check;
- 
-    function Check (Rec : in P_N_N;
-                    P   : in C432001_1.Periods;
-                    B   : Boolean) return Boolean is
-    begin
-       if not C432001_1.Check (C432001_1.P_N (Rec), P) then
-          Report.Failed ("Conversion to parent " &
-                         "nonprivate type extension " &
-                         "failed");
-       end if;
-       return Rec.Sample_On_Loan = B;
-    end Check;
- 
-    function Check (Rec : in P_P_N;
-                    B   : Boolean) return Boolean is
-    begin
-       if not C432001_1.Check (C432001_1.P_P (Rec)) then
-          Report.Failed ("Conversion to parent " &
-                         "private type extension " &
-                         "failed");
-       end if;
-       return Rec.Sample_On_Loan = B;
-    end Check;
- 
- end C432001_2;
- 
- 
- with C432001_0;
- with C432001_1;
- with C432001_2;
- with Report;
- procedure C432001 is
- 
-    N_Object : C432001_0.N := (How_Long_Ago => Report.Ident_Int(375),
-                               Era          => C432001_0.Paleozoic);
- 
-    P_Object : C432001_0.P; -- default value is (150,
-                            --                   C432001_0.Mesozoic)
- 
-    N_N_Object : C432001_1.N_N :=
-       (N_Object with Period => C432001_1.Devonian);
- 
-    P_N_Object : C432001_1.P_N :=
-       (P_Object with Period => C432001_1.Jurassic);
- 
-    N_P_Object : C432001_1.N_P; -- default is (1,
-                                --             C432001_0.Cenozoic,
-                                --             C432001_1.Quaternary)
- 
-    P_P_Object : C432001_1.P_P; -- default is (150,
-                                --             C432001_0.Mesozoic,
-                                --             C432001_1.Jurassic)
- 
-    P_P_Null_Ob:C432001_1.P_P_Null := (P_Object with null record);
- 
-    N_N_N_Object : C432001_2.N_N_N :=
-       (N_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
- 
-    N_P_N_Object : C432001_2.N_P_N :=
-       (N_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
- 
-    P_N_N_Object : C432001_2.P_N_N :=
-       (P_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
- 
-    P_P_N_Object : C432001_2.P_P_N :=
-       (P_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
- 
-    P_N_Object_2 : C432001_1.P_N := (C432001_0.P(P_N_N_Object)
-                                     with C432001_1.Carboniferous);
- 
-    N_N_Object_2 : C432001_1.N_N := (C432001_0.N'(42,C432001_0.Precambrian)
-                                     with C432001_1.Carboniferous);
- 
- begin
- 
-    Report.Test ("C432001", "Extension aggregates");
- 
-    -- check ultimate ancestor types
- 
-    if not C432001_0.Check (N_Object,
-                            375,
-                            C432001_0.Paleozoic) then
-       Report.Failed ("Object of " &
-                      "nonprivate type " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_0.Check (P_Object) then
-       Report.Failed ("Object of " &
-                      "private type " &
-                      "failed content check");
-    end if;
- 
-    -- check direct type extensions
- 
-    if not C432001_1.Check (N_N_Object,
-                            375,
-                            C432001_0.Paleozoic,
-                            C432001_1.Devonian) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension of nonprivate type " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_1.Check (N_P_Object) then
-       Report.Failed ("Object of " &
-                      "private extension of nonprivate type " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_1.Check (P_N_Object,
-                            C432001_1.Jurassic) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension of private type " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_1.Check (P_P_Object) then
-       Report.Failed ("Object of " &
-                      "private extension of private type " &
-                      "failed content check");
-    end if;
- 
-     if not C432001_1.Check (P_P_Null_Ob) then
-       Report.Failed ("Object of " &
-                      "private type " &
-                      "failed content check");
-    end if;
- 
- 
-    -- check direct extensions of extensions
- 
-    if not C432001_2.Check (N_N_N_Object,
-                            375,
-                            C432001_0.Paleozoic,
-                            C432001_1.Devonian,
-                            True) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension of nonprivate extension " &
-                      "(of nonprivate parent) " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_2.Check (N_P_N_Object, False) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension of private extension " &
-                      "(of nonprivate parent) " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_2.Check (P_N_N_Object,
-                            C432001_1.Jurassic,
-                            True) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension of nonprivate extension " &
-                      "(of private parent) " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_2.Check (P_P_N_Object, False) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension of private extension " &
-                      "(of private parent) " &
-                      "failed content check");
-    end if;
- 
-    -- check that the extension aggregate may specify an expression of
-    -- a "grandparent" ancestor type
- 
-    -- types tested are derived through nonprivate extensions only
-    -- (extension aggregates are not allowed if the path from the
-    -- ancestor type wanders through a private extension)
-    
-    N_N_N_Object :=
-       (N_Object with Period => C432001_1.Devonian,
-                      Sample_On_Loan => Report.Ident_Bool(True));
- 
-    if not C432001_2.Check (N_N_N_Object,
-                            375,
-                            C432001_0.Paleozoic,
-                            C432001_1.Devonian,
-                            True) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension " &
-                      "of nonprivate ancestor " &
-                      "failed content check");
-    end if;
- 
-    P_N_N_Object :=
-       (P_Object with Period => C432001_1.Jurassic,
-                      Sample_On_Loan => Report.Ident_Bool(True));
- 
-    if not C432001_2.Check (P_N_N_Object,
-                            C432001_1.Jurassic,
-                            True) then
-       Report.Failed ("Object of " &
-                      "nonprivate extension " &
-                      "of private ancestor " &
-                      "failed content check");
-    end if;
- 
-   -- Check additional cases
-    if not C432001_1.Check (P_N_Object_2,
-                            C432001_1.Carboniferous) then
-       Report.Failed ("Additional Object of " &
-                      "nonprivate extension of private type " &
-                      "failed content check");
-    end if;
- 
-    if not C432001_1.Check (N_N_Object_2,
-                            42,
-                            C432001_0.Precambrian,
-                            C432001_1.Carboniferous) then
-       Report.Failed ("Additional Object of " &
-                      "nonprivate extension of nonprivate type " &
-                      "failed content check");
-    end if;
- 
-    Report.Result;
- 
- end C432001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,764 ****
- -- C432002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if an extension aggregate specifies a value for a record 
- --      extension and the ancestor expression has discriminants that are
- --      inherited by the record extension, then a check is made that each
- --      discriminant has the value specified.
- --
- --      Check that if an extension aggregate specifies a value for a record 
- --      extension and the ancestor expression has discriminants that are not
- --      inherited by the record extension, then a check is made that each
- --      such discriminant has the value specified for the corresponding
- --      discriminant.
- --
- --      Check that the corresponding discriminant value may be specified
- --      in the record component association list or in the derived type
- --      definition for an ancestor.
- --
- --      Check the case of ancestors that are several generations removed.
- --      Check the case where the value of the discriminant(s) in question
- --      is supplied several generations removed.
- --
- --      Check the case of multiple discriminants.
- --
- --      Check that Constraint_Error is raised if the check fails.
- --
- -- TEST DESCRIPTION:
- --      A hierarchy of tagged types is declared from a discriminated
- --      root type. Each level declares two kinds of types: (1) a type
- --      extension which constrains the discriminant of its parent to
- --      the value of an expression and (2) a type extension that
- --      constrains the discriminant of its parent to equal a new discriminant
- --      of the type extension (These are the two categories of noninherited
- --      discriminants).
- --
- --      Values for each type are declared within nested blocks. This is
- --      done so that the instances that produce Constraint_Error may
- --      be dealt with cleanly without forcing the program to exit.
- --
- --      Success and failure cases (which should raise Constraint_Error)
- --      are set up for each kind of type. Additionally, for the first
- --      level of the hierarchy, separate tests are done for ancestor
- --      expressions specified by aggregates and those specified by
- --      variables. Later tests are performed using variables only.
- --
- --      Additionally, the cases tested consist of the following kinds of
- --      types:
- --
- --         Extensions of extensions, using both the parent and grandparent
- --         types for the ancestor expression,
- --
- --         Ancestor expressions which are several generations removed
- --         from the type of the aggregate,
- --
- --         Extensions of types with multiple discriminants, where the
- --         extension declares a new discriminant which corresponds to
- --         more than one discriminant of the ancestor types.
- --
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --      20 Dec 94   SAIC    Repair confusion WRT overridden discriminants
- --
- --!
- 
- package C432002_0 is
- 
-    subtype Length is Natural range 0..256;
-    type Discriminant (L : Length) is tagged
-       record
-          S1 : String (1..L);
-       end record;
- 
-    procedure Do_Something (Rec : in out Discriminant);
-    -- inherited by all type extensions
- 
-    -- Aggregates of Discriminant are of the form
-    --    (L, S1) where L= S1'Length
- 
-    -- Discriminant of parent constrained to value of an expression
-    type Constrained_Discriminant_Extension is
-       new Discriminant (L => 10)
-       with record
-          S2 : String (1..20);
-       end record;
- 
-    -- Aggregates of Constrained_Discriminant_Extension are of the form
-    --    (L, S1, S2), where L = S1'Length = 10, S2'Length = 20
- 
-    type Once_Removed is new Constrained_Discriminant_Extension
-       with record
-          S3 : String (1..3);
-       end record;
- 
-    type Twice_Removed is new Once_Removed
-       with record
-          S4 : String (1..8);
-       end record;
- 
-    -- Aggregates of Twice_Removed are of the form
-    --    (L, S1, S2, S3, S4), where L = S1'Length = 10,
-    --                               S2'Length = 20,
-    --                               S3'Length = 3,
-    --                               S4'Length = 8
- 
-    -- Discriminant of parent constrained to equal new discriminant
-    type New_Discriminant_Extension (N : Length) is
-       new Discriminant (L => N) with
-       record
-          S2 : String (1..N);
-       end record;
- 
-    -- Aggregates of New_Discriminant_Extension are of the form
-    --   (N, S1, S2), where N = S1'Length = S2'Length
- 
-    -- Discriminant of parent extension constrained to the value of
-    -- an expression
-    type Constrained_Extension_Extension is
-       new New_Discriminant_Extension (N => 20)
-       with record
-          S3 : String (1..5);
-       end record;
- 
-    -- Aggregates of Constrained_Extension_Extension are of the form
-    --   (N, S1, S2, S3), where N = S1'Length = S2'Length = 20,
-    --                             S3'Length = 5
- 
-    -- Discriminant of parent extension constrained to equal a new
-    -- discriminant
-    type New_Extension_Extension (I : Length) is
-       new New_Discriminant_Extension (N => I)
-       with record
-          S3 : String (1..I);
-       end record;
- 
-    -- Aggregates of New_Extension_Extension are of the form
-    --    (I, S1, 2, S3), where
-    --       I = S1'Length = S2'Length = S3'Length
- 
-    type Multiple_Discriminants (A, B : Length) is tagged
-       record
-          S1 : String (1..A);
-          S2 : String (1..B);
-       end record;
- 
-    procedure Do_Something (Rec : in out Multiple_Discriminants);
-    -- inherited by type extension
- 
-    -- Aggregates of Multiple_Discriminants are of the form
-    --    (A, B, S1, S2), where A = S1'Length, B = S2'Length
- 
-    type Multiple_Discriminant_Extension (C : Length) is
-       new Multiple_Discriminants (A => C, B => C)
-       with record
-          S3 : String (1..C);
-       end record;
- 
-    -- Aggregates of Multiple_Discriminant_Extension are of the form
-    --    (A, B, S1, S2, C, S3), where
-    --       A = B = C = S1'Length = S2'Length = S3'Length
- 
- end C432002_0;
- 
- with Report;
- package body C432002_0 is
- 
-    S : String (1..20) := "12345678901234567890";
- 
-    procedure Do_Something (Rec : in out Discriminant) is
-    begin
-       Rec.S1 := Report.Ident_Str (S (1..Rec.L));
-    end Do_Something;
- 
-    procedure Do_Something (Rec : in out Multiple_Discriminants) is
-    begin
-       Rec.S1 := Report.Ident_Str (S (1..Rec.A));
-    end Do_Something;
- 
- end C432002_0;
- 
- 
- with C432002_0;
- with Report;
- procedure C432002 is
- 
-    -- Various different-sized strings for variety
-    String_3  : String (1..3)  := Report.Ident_Str("123");
-    String_5  : String (1..5)  := Report.Ident_Str("12345");
-    String_8  : String (1..8)  := Report.Ident_Str("12345678");
-    String_10 : String (1..10) := Report.Ident_Str("1234567890");
-    String_11 : String (1..11) := Report.Ident_Str("12345678901");
-    String_20 : String (1..20) := Report.Ident_Str("12345678901234567890");
- 
- begin
- 
-    Report.Test ("C432002",
-                 "Extension aggregates for discriminated types");
- 
-    --------------------------------------------------------------------
-    -- Extension constrains parent's discriminant to value of expression
-    --------------------------------------------------------------------
- 
-    -- Successful cases - value matches corresponding discriminant value
- 
-    CD_Matched_Aggregate:
-    begin
-       declare
-          CD : C432002_0.Constrained_Discriminant_Extension :=
-             (C432002_0.Discriminant'(L  => 10,
-                                      S1 => String_10)
-                with S2 => String_20);
-       begin
-          C432002_0.Do_Something(CD); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is an aggregate");
-          Report.Failed ("Aggregate of extension " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end CD_Matched_Aggregate;
-    
-    CD_Matched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant(L => 10) :=
-             C432002_0.Discriminant'(L  => 10,
-                                     S1 => String_10);
- 
-          CD : C432002_0.Constrained_Discriminant_Extension :=
-             (D with S2 => String_20);
-       begin
-          C432002_0.Do_Something(CD); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is a variable");
-          Report.Failed ("Aggregate of extension " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end CD_Matched_Variable;
- 
-    
-    -- Unsuccessful cases - value does not match value of corresponding
-    --                      discriminant. Constraint_Error should be
-    --                      raised.
- 
-    CD_Unmatched_Aggregate:
-    begin
-       declare
-          CD : C432002_0.Constrained_Discriminant_Extension :=
-             (C432002_0.Discriminant'(L  => 5,
-                                      S1 => String_5)
-                with S2 => String_20);
-       begin
-          Report.Comment ("Ancestor expression is an aggregate");
-          Report.Failed ("Aggregate of extension " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(CD); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise of Constraint_Error is expected
-    end CD_Unmatched_Aggregate;
-    
-    CD_Unmatched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant(L => 5) :=
-             C432002_0.Discriminant'(L  => 5,
-                                     S1 => String_5);
- 
-          CD : C432002_0.Constrained_Discriminant_Extension :=
-             (D with S2 => String_20);
-       begin
-          Report.Comment ("Ancestor expression is an variable");
-          Report.Failed ("Aggregate of extension " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(CD); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise of Constraint_Error is expected
-    end CD_Unmatched_Variable;
- 
-    -----------------------------------------------------------------------
-    -- Extension constrains parent's discriminant to equal new discriminant
-    -----------------------------------------------------------------------
- 
-    -- Successful cases - value matches corresponding discriminant value
- 
-    ND_Matched_Aggregate:
-    begin
-       declare
-          ND : C432002_0.New_Discriminant_Extension (N => 8) :=
-             (C432002_0.Discriminant'(L  => 8,
-                                      S1 => String_8)
-                with N  => 8,
-                     S2 => String_8);
-       begin
-          C432002_0.Do_Something(ND); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is an aggregate");
-          Report.Failed ("Aggregate of extension " &
-                         "with new discriminant: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end ND_Matched_Aggregate;
-    
-    ND_Matched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant(L => 3) :=
-             C432002_0.Discriminant'(L  => 3,
-                                     S1 => String_3);
- 
-          ND : C432002_0.New_Discriminant_Extension (N => 3) :=
-             (D with N  => 3,
-                     S2 => String_3);
-       begin
-          C432002_0.Do_Something(ND); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is an variable");
-          Report.Failed ("Aggregate of extension " &
-                         "with new discriminant: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end ND_Matched_Variable;
- 
-    
-    -- Unsuccessful cases - value does not match value of corresponding
-    --                      discriminant. Constraint_Error should be
-    --                      raised.
-    
-    ND_Unmatched_Aggregate:
-    begin
-       declare
-          ND : C432002_0.New_Discriminant_Extension (N => 20) :=
-             (C432002_0.Discriminant'(L  => 11,
-                                      S1 => String_11)
-                with N  => 20,
-                     S2 => String_20);
-       begin
-          Report.Comment ("Ancestor expression is an aggregate");
-          Report.Failed ("Aggregate of extension " &
-                         "with new discriminant: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(ND); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise is expected
-    end ND_Unmatched_Aggregate;
-    
-    ND_Unmatched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant(L => 5) :=
-             C432002_0.Discriminant'(L  => 5,
-                                     S1 => String_5);
- 
-          ND : C432002_0.New_Discriminant_Extension (N => 20) :=
-             (D with N  => 20,
-                     S2 => String_20);
-       begin
-          Report.Comment ("Ancestor expression is an variable");
-          Report.Failed ("Aggregate of extension " &
-                         "with new discriminant: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(ND); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise is expected
-    end ND_Unmatched_Variable;
- 
-    --------------------------------------------------------------------
-    -- Extension constrains parent's discriminant to value of expression
-    -- Parent is a discriminant extension
-    --------------------------------------------------------------------
- 
-    -- Successful cases - value matches corresponding discriminant value
- 
-    CE_Matched_Aggregate:
-    begin
-       declare
-          CE : C432002_0.Constrained_Extension_Extension :=
-             (C432002_0.Discriminant'(L  => 20,
-                                      S1 => String_20)
-                with N => 20,
-                     S2 => String_20,
-                     S3 => String_5);
-       begin
-          C432002_0.Do_Something(CE); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is an aggregate");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end CE_Matched_Aggregate;
-    
-    CE_Matched_Variable:
-    begin
-       declare
-          ND : C432002_0.New_Discriminant_Extension (N => 20) :=
-             C432002_0.New_Discriminant_Extension'
-                (N  => 20,
-                 S1 => String_20,
-                 S2 => String_20);
- 
-          CE : C432002_0.Constrained_Extension_Extension :=
-             (ND with S3 => String_5);
-       begin
-          C432002_0.Do_Something(CE); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is a variable");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end CE_Matched_Variable;
- 
-    
-    -- Unsuccessful cases - value does not match value of corresponding
-    --                      discriminant. Constraint_Error should be
-    --                      raised.
- 
-    CE_Unmatched_Aggregate:
-    begin
-       declare
-          CE : C432002_0.Constrained_Extension_Extension :=
-             (C432002_0.New_Discriminant_Extension'
-                (N  => 11,
-                 S1 => String_11,
-                 S2 => String_11)
-             with S3 => String_5);
-       begin
-          Report.Comment ("Ancestor expression is an aggregate");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "Constraint_Error was not raised " &
-                         "with discriminant constrained: " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(CE); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise of Constraint_Error is expected
-    end CE_Unmatched_Aggregate;
-    
-    CE_Unmatched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant(L => 8) :=
-             C432002_0.Discriminant'(L  => 8,
-                                     S1 => String_8);
- 
-          CE : C432002_0.Constrained_Extension_Extension :=
-             (D with N  => 8,
-                     S2 => String_8,
-                     S3 => String_5);
-       begin
-          Report.Comment ("Ancestor expression is a variable");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(CE); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise of Constraint_Error is expected
-    end CE_Unmatched_Variable;
- 
-    -----------------------------------------------------------------------
-    -- Extension constrains parent's discriminant to equal new discriminant
-    -- Parent is a discriminant extension
-    -----------------------------------------------------------------------
- 
-    -- Successful cases - value matches corresponding discriminant value
- 
-    NE_Matched_Aggregate:
-    begin
-       declare
-          NE : C432002_0.New_Extension_Extension (I => 8) :=
-             (C432002_0.Discriminant'(L  => 8,
-                                      S1 => String_8)
-                with I  => 8,
-                     S2 => String_8,
-                     S3 => String_8);
-       begin
-          C432002_0.Do_Something(NE); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is an aggregate");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "with new discriminant: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end NE_Matched_Aggregate;
-    
-    NE_Matched_Variable:
-    begin
-       declare
-          ND : C432002_0.New_Discriminant_Extension (N => 3) :=
-             C432002_0.New_Discriminant_Extension'
-                (N  => 3,
-                 S1 => String_3,
-                 S2 => String_3);
- 
-          NE : C432002_0.New_Extension_Extension (I => 3) :=
-             (ND with I  => 3,
-                      S3 => String_3);
-       begin
-          C432002_0.Do_Something(NE); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Comment ("Ancestor expression is a variable");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "with new discriminant: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end NE_Matched_Variable;
- 
-    
-    -- Unsuccessful cases - value does not match value of corresponding
-    --                      discriminant. Constraint_Error should be
-    --                      raised.
- 
-    NE_Unmatched_Aggregate:
-    begin
-       declare
-          NE : C432002_0.New_Extension_Extension (I => 8) :=
-             (C432002_0.New_Discriminant_Extension'
-                (C432002_0.Discriminant'(L  => 11,
-                                         S1 => String_11)
-                 with N  => 11,
-                      S2 => String_11)
-             with I  => 8,
-                  S3 => String_8);
-       begin
-          Report.Comment ("Ancestor expression is an extension aggregate");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "with new discriminant: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(NE); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise is expected
-    end NE_Unmatched_Aggregate;
-    
-    NE_Unmatched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant(L => 5) :=
-             C432002_0.Discriminant'(L  => 5,
-                                     S1 => String_5);
- 
-          NE : C432002_0.New_Extension_Extension (I => 20) :=
-             (D with I  => 5,
-                     S2 => String_5,
-                     S3 => String_20);
-       begin
-          Report.Comment ("Ancestor expression is a variable");
-          Report.Failed ("Aggregate of extension (of extension) " &
-                         "with new discriminant: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(NE); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise is expected
-    end NE_Unmatched_Variable;
- 
-    -----------------------------------------------------------------------
-    -- Corresponding discriminant is two levels deeper than aggregate
-    -----------------------------------------------------------------------
- 
-    -- Successful case - value matches corresponding discriminant value
- 
-    TR_Matched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant (L => 10) :=
-             C432002_0.Discriminant'(L  => 10,
-                                     S1 => String_10);
- 
-          TR : C432002_0.Twice_Removed :=
-             C432002_0.Twice_Removed'(D with S2 => String_20,
-                                             S3 => String_3,
-                                             S4 => String_8);
-          -- N is constrained to a value in the derived_type_definition
-          -- of Constrained_Discriminant_Extension. Its omission from
-          -- the above record_component_association_list is allowed by
-          -- 4.3.2(6).
- 
-       begin
-          C432002_0.Do_Something(TR); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Failed ("Aggregate of far-removed extension " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end TR_Matched_Variable;
-    
-    
-    -- Unsuccessful case - value does not match value of corresponding
-    --                      discriminant. Constraint_Error should be
-    --                      raised.
- 
-    TR_Unmatched_Variable:
-    begin
-       declare
-          D : C432002_0.Discriminant (L => 5) :=
-             C432002_0.Discriminant'(L  => 5,
-                                     S1 => String_5);
- 
-          TR : C432002_0.Twice_Removed :=
-             C432002_0.Twice_Removed'(D with S2 => String_20,
-                                             S3 => String_3,
-                                             S4 => String_8);
- 
-       begin
-          Report.Failed ("Aggregate of far-removed extension " &
-                         "with discriminant constrained: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(TR); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise is expected
-    end TR_Unmatched_Variable;
-    
-    ------------------------------------------------------------------------
-    -- Parent has multiple discriminants.
-    -- Discriminant in extension corresponds to both parental discriminants.
-    ------------------------------------------------------------------------
- 
-    -- Successful case - value matches corresponding discriminant value
- 
-    MD_Matched_Variable:
-    begin
-       declare
-          MD : C432002_0.Multiple_Discriminants (A => 10, B => 10) :=
-             C432002_0.Multiple_Discriminants'(A  => 10,
-                                               B  => 10,
-                                               S1 => String_10,
-                                               S2 => String_10);
-          MDE : C432002_0.Multiple_Discriminant_Extension (C => 10) :=
-             (MD with C  => 10,
-                      S3 => String_10);
- 
-       begin
-          C432002_0.Do_Something(MDE); -- success
-       end;
-    exception
-       when Constraint_Error =>
-          Report.Failed ("Aggregate of extension " &
-                         "of multiply-discriminated parent: " &
-                         "Constraint_Error was incorrectly raised " &
-                         "for value that matches corresponding " &
-                         "discriminant");
-    end MD_Matched_Variable;
- 
-    
-    -- Unsuccessful case - value does not match value of corresponding
-    --                      discriminant. Constraint_Error should be
-    --                      raised.
- 
-    MD_Unmatched_Variable:
-    begin
-       declare
-          MD : C432002_0.Multiple_Discriminants (A => 10, B => 8) :=
-             C432002_0.Multiple_Discriminants'(A  => 10,
-                                               B  => 8,
-                                               S1 => String_10,
-                                               S2 => String_8);
-          MDE : C432002_0.Multiple_Discriminant_Extension (C => 10) :=
-             (MD with C  => 10,
-                      S3 => String_10);
- 
-       begin
-          Report.Failed ("Aggregate of extension " &
-                         "of multiply-discriminated parent: " &
-                         "Constraint_Error was not raised " &
-                         "for discriminant value that does not match " &
-                         "corresponding discriminant");
-          C432002_0.Do_Something(MDE); -- disallow unused var optimization
-       end;
-    exception
-       when Constraint_Error =>
-          null; -- raise is expected
-    end MD_Unmatched_Variable;
- 
-    Report.Result;
- 
- end C432002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,594 ****
- -- C432003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the type of the ancestor part of an extension aggregate
- --      has discriminants that are not inherited by the type of the aggregate,
- --      and the ancestor part is a subtype mark that denotes a constrained
- --      subtype, Constraint_Error is raised if: 1) any discriminant of the
- --      ancestor has a different value than that specified for a corresponding
- --      discriminant in the derived type definition for some ancestor of the
- --      type of the aggregate, or 2) the value for the discriminant in the
- --      record association list is not the value of the corresponding 
- --      discriminant.  Check that the components of the value of the
- --      aggregate not given by the record component association list are
- --      initialized by default as for an object of the ancestor type.
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      type T (D1: ...) is tagged ...
- --
- --      type    DT is new T with ...
- --      subtype ST is DT (D1 => 3);    -- Constrained subtype.
- --
- --      type NT1 (D2: ...) is new DT (D1 => D2) with null record;
- --      type NT2 (D2: ...) is new DT (D1 => 6)  with null record;
- --      type NT3           is new DT (D1 => 6)  with null record;
- --
- --      A: NT1 := (T  with D2 => 6); -- OK: T  is unconstrained.
- --      B: NT1 := (DT with D2 => 6); -- OK: DT is unconstrained.
- --      C: NT1 := (ST with D2 => 6); -- NO: ST.D1 /= D2.
- --
- --      D: NT2 := (T  with D2 => 4); -- OK: T  is unconstrained.
- --      E: NT2 := (DT with D2 => 4); -- OK: DT is unconstrained.
- --      F: NT2 := (ST with  . . . ); -- NO: ST.D1 /= DT.D1 as specified in NT2.
- --
- --      G: NT3 := (T  with D1 => 6); -- OK: T  is unconstrained.
- --      H: NT3 := (DT with D1 => 6); -- OK: DT is unconstrained.
- --      I: NT3 := (ST with D1 => 6); -- NO: ST.D1 /= DT.D1 as specified in NT3.
- --
- --      In A, B, D, E, G, and H the ancestor part is the name of an
- --      unconstrained subtype, so this rule does not apply. In C, F, and I
- --      the ancestor part (ST) is the name of a constrained subtype of DT,
- --      which is itself a derived type of a discriminated tagged type T. ST
- --      constrains the discriminant of DT (D1) to the value 3; thus, the
- --      type of any extension aggregate for which ST is the ancestor part
- --      must have an ancestor which also constrained D1 to 3. F and I raise
- --      Constraint_Error because NT2 and NT3, respectively, constrain D1 to
- --      6. C raises Constraint_Error because NT1 constrains D1 to the value
- --      of D2, which is set to 6 in the record component association list of
- --      the aggregate.
- --
- --      This test verifies each of the three scenarios above:
- --
- --         (1) Ancestor of type of aggregate constrains discriminant with
- --             new discriminant.
- --         (2) Ancestor of type of aggregate constrains discriminant with
- --             value, and has a new discriminant part.
- --         (3) Ancestor of type of aggregate constrains discriminant with
- --             value, and has no discriminant part.
- --
- --      Verification is made for cases where the type of the aggregate is
- --      once- and twice-removed from the type of the ancestor part.
- --      
- --      Additionally, a case is included where a new discriminant corresponds
- --      to multiple discriminants of the type of the ancestor part.
- --
- --      To test the portion of the objective concerning "initialization by 
- --      default," the test verifies that, after a successful aggregate
- --      assignment, components not assigned an explicit value by the aggregate
- --      contain the default values for the corresponding components of the
- --      ancestor type.
- --    
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Dec 94   SAIC    Removed discriminant defaults from tagged types.
- --      17 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected subtype constraint
- --                          for component NT_C3.Str2. Added missing component
- --                          checks. Removed record component update from
- --                          Avoid_Optimization. Fixed incorrect component
- --                          checks.
- --      02 Dec 95   SAIC    ACVC 2.0.1 fixes: Corrected Failed comment for
- --                          Q case.
- --
- --!
- 
- package C432003_0 is
- 
-    Default_String : constant String := "This is a default string"; -- len = 24
-    Another_String : constant String := "Another default string";   -- len = 22
- 
-    subtype Length is Natural range 0..255;
- 
-    type ROOT (D1 : Length) is tagged 
-       record
-          S1  : String (1..D1) := Default_String(1..D1);
-          Acc : Natural := 356;
-       end record;
- 
-    procedure Avoid_Optimization (Rec : in out ROOT); -- Inherited by all type
-                                                      -- extensions.
- 
-    type Unconstrained_Der is new ROOT with 
-       record
-          Str1 : String(1..5) := "abcde";
-       end record;
- 
-    subtype Constrained_Subtype is Unconstrained_Der (D1 => 10);
- 
-    type NT_A1 (D2 : Length) is new Unconstrained_Der (D1 => D2) with 
-       record
-          S2 : String(1..D2);         -- Inherited discrim. constrained by
-       end record;                    -- new discriminant.
- 
-    type NT_A2 (D3 : Length) is new NT_A1 (D2 => D3) with 
-       record
-          S3 : String(1..D3);         -- Inherited discrim. constrained by
-       end record;                    -- new discriminant.
- 
- 
-    type NT_B1 (D2 : Length) is new Unconstrained_Der (D1 => 5) with 
-       record
-          S2 : String(1..D2);         -- Inherited discrim. constrained by
-       end record;                    -- explicit value.
- 
-    type NT_B2 (D3 : Length) is new NT_B1 (D2 => 10) with 
-       record
-          S3 : String(1..D3);         -- Inherited discrim. constrained by
-       end record;                    -- explicit value.
- 
-    type NT_B3 (D2 : Length) is new Unconstrained_Der (D1 => 10) with
-       record
-          S2 : String(1..D2);
-       end record;
- 
- 
-    type NT_C1 is new Unconstrained_Der (D1 => 5) with 
-       record
-          Str2 : String(1..5);         -- Inherited discrim. constrained
-       end record;                     -- No new value.
- 
-    type NT_C2 (D2 : Length) is new NT_C1 with 
-       record
-          S2 : String(1..D2);          -- Inherited discrim. not further
-       end record;                     -- constrained, new discriminant.
- 
-    type NT_C3 is new Unconstrained_Der(D1 => 10) with
-       record
-          Str2 : String(1..5);
-       end record;
- 
- 
-    type MULTI_ROOT (D1 : Length; D2 : Length) is tagged
-       record
-          S1 : String (1..D1) := Default_String(1..D1);
-          S2 : String (1..D2) := Another_String(1..D2);
-       end record;
- 
-    procedure Avoid_Optimization (Rec : in out MULTI_ROOT); -- Inherited by all
-                                                            -- type extensions.
-                                                            
-    type Mult_Unconstr_Der is new MULTI_ROOT with
-       record
-          Str1 : String(1..8) := "AbCdEfGh";  -- Derived, no constraints.
-       end record;
- 
-    -- Subtypes with constrained discriminants.
-    subtype Mult_Constr_Sub1 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have
-                                                  D2 => 20); -- diff values
- 
-    subtype Mult_Constr_Sub2 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have
-                                                  D2 => 15); -- same value
- 
-    type Mult_NT_A1 (D3 : Length) is 
-      new Mult_Unconstr_Der (D1 => D3, D2 => D3) with
-       record
-          S3 : String(1..D3);      -- Both inherited discriminants constrained
-       end record;                 -- by new discriminant.
- 
- end C432003_0;
- 
- 
-    --=====================================================================--
- 
- 
- with Report;
- package body C432003_0 is
- 
-    procedure Avoid_Optimization (Rec : in out ROOT) is
-    begin
-       Rec.S1 := Report.Ident_Str(Rec.S1);
-    end Avoid_Optimization;
- 
-    procedure Avoid_Optimization (Rec : in out MULTI_ROOT) is
-    begin
-       Rec.S1 := Report.Ident_Str(Rec.S1);
-    end Avoid_Optimization;
- 
- end C432003_0;
- 
- 
-    --=====================================================================--
- 
- 
- with C432003_0;
- with Report;
- procedure C432003 is
- begin
- 
-    Report.Test("C432003", "Extension aggregates where ancestor part "      &
-                           "is a subtype mark that denotes a constrained "  &
-                           "subtype causing Constraint_Error if any "       &
-                           "discriminant of the ancestor has a different "  &
-                           "value than that specified for a corresponding " &
-                           "discriminant in the derived type definition "   &
-                           "for some ancestor of the type of the aggregate");
- 
-    Test_Block:
-       declare
- 
-          -- Variety of string object declarations.
-          String2  : String(1..2)  := Report.Ident_Str("12");
-          String5  : String(1..5)  := Report.Ident_Str("12345");
-          String8  : String(1..8)  := Report.Ident_Str("AbCdEfGh");
-          String10 : String(1..10) := Report.Ident_Str("1234567890");
-          String15 : String(1..15) := Report.Ident_Str("123456789012345");
-          String20 : String(1..20) := Report.Ident_Str("12345678901234567890");
- 
-       begin
- 
- 
-          begin
-             declare
-                A : C432003_0.NT_A1 :=                                  -- OK
-                      (C432003_0.ROOT with D2   => 5,
-                                           Str1 => "cdefg",
-                                           S2   => String5);
-             begin
-                C432003_0.Avoid_Optimization(A);
-                if A.Acc  /= 356       or
-                   A.Str1 /= "cdefg"   or
-                   A.S2   /= String5   or 
-                   A.D2   /= 5         or
-                   A.S1   /= C432003_0.Default_String(1..5)
-                then
-                   Report.Failed("Incorrect object values for Object A");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object A");
-          end;
- 
- 
-          begin
-             declare
-                C: C432003_0.NT_A1 :=                                   -- OK
-                     (C432003_0.Constrained_Subtype with D2 => 10,
-                                                         S2 => String10);
-             begin
-                C432003_0.Avoid_Optimization(C);
-                if C.D2   /= 10        or  C.Acc /= 356      or
-                   C.Str1 /= "abcde"   or  C.S2  /= String10 or
-                   C.S1   /= C432003_0.Default_String(1..10)
-                then
-                   Report.Failed("Incorrect object values for Object C");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object C");
-          end;
- 
- 
-          begin
-             declare 
-                D: C432003_0.NT_A1 :=                                  -- C_E
-                     (C432003_0.Constrained_Subtype with 
-                        D2 => Report.Ident_Int(5),
-                        S2 => String5);
-             begin
-                C432003_0.Avoid_Optimization(D);
-                Report.Failed("Constraint_Error not raised for Object D");
-             end;
-          exception
-             when Constraint_Error =>
-                null;  -- Raise of Constraint_Error is expected.
-          end;
- 
- 
-          begin
-             declare
-                E: C432003_0.NT_A2 :=                                   -- OK
-                     (C432003_0.Constrained_Subtype with D3 => 10,
-                                                         S2 => String10,
-                                                         S3 => String10);
-             begin
-                C432003_0.Avoid_Optimization(E);
-                if E.D3   /= 10        or  E.Acc /= 356        or
-                   E.Str1 /= "abcde"   or  E.S2  /= String10   or
-                   E.S3   /= String10  or
-                   E.S1   /= C432003_0.Default_String(1..10)
-                then
-                   Report.Failed("Incorrect object values for Object E");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object E");
-          end;
- 
- 
-          begin
-             declare
-                F: C432003_0.NT_A2 :=                                  -- C_E
-                     (C432003_0.Constrained_Subtype with 
-                        D3 => Report.Ident_Int(5),  
-                        S2 => String5,
-                        S3 => String5);
-             begin
-                C432003_0.Avoid_Optimization(F);
-                Report.Failed("Constraint_Error not raised for Object F");
-             end;
-          exception
-             when Constraint_Error =>
-                null;  -- Raise of Constraint_Error is expected.
-          end;
- 
- 
-          begin
-             declare
-                G: C432003_0.NT_B2 :=                                  -- OK
-                     (C432003_0.ROOT with D3   => 5,     
-                                          Str1 => "cdefg",
-                                          S2   => String10,
-                                          S3   => String5);
-             begin
-                C432003_0.Avoid_Optimization(G);
-                if G.D3   /= 5         or  G.Acc /= 356       or
-                   G.Str1 /= "cdefg"   or  G.S2  /= String10  or
-                   G.S3   /= String5   or
-                   G.S1   /= C432003_0.Default_String(1..5)
-                then
-                   Report.Failed("Incorrect object values for Object G");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object G");
-          end;
- 
- 
-          begin
-             declare
-                H: C432003_0.NT_B3 :=                                    -- OK
-                     (C432003_0.Unconstrained_Der with D2 => 5,
-                                                       S2 => String5);
-             begin
-                C432003_0.Avoid_Optimization(H);
-                if H.D2   /= 5          or  H.Acc /= 356      or
-                   H.Str1 /= "abcde"    or  H.S2  /= String5  or
-                   H.S1   /= C432003_0.Default_String(1..10)
-                then
-                   Report.Failed("Incorrect object values for Object H");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object H");
-          end;
- 
- 
-          begin
-             declare
-                I: C432003_0.NT_B1 :=                                  -- C_E
-                     (C432003_0.Constrained_Subtype with 
-                         D2 => Report.Ident_Int(10),
-                         S2 => String10);
-             begin
-                C432003_0.Avoid_Optimization(I);
-                Report.Failed("Constraint_Error not raised for Object I");
-             end;
-          exception
-             when Constraint_Error =>
-                null;  -- Raise of Constraint_Error is expected.
-          end;
- 
- 
-          begin
-             declare
-                J: C432003_0.NT_B2 :=                                  -- C_E
-                     (C432003_0.Constrained_Subtype with 
-                        D3 => Report.Ident_Int(10),
-                        S2 => String10,
-                        S3 => String10);
-             begin
-                C432003_0.Avoid_Optimization(J);
-                Report.Failed("Constraint_Error not raised by Object J");
-             end;
-          exception
-             when Constraint_Error =>
-                null;  -- Raise of Constraint_Error is expected.
-          end;
- 
- 
-          begin
-             declare
-                K: C432003_0.NT_B3 :=                                   -- OK
-                     (C432003_0.Constrained_Subtype with D2 => 5,
-                                                         S2 => String5);
-             begin
-                C432003_0.Avoid_Optimization(K);
-                if K.D2   /= 5          or  K.Acc /= 356       or
-                   K.Str1 /= "abcde"    or  K.S2  /= String5   or
-                   K.S1   /= C432003_0.Default_String(1..10)
-                then
-                   Report.Failed("Incorrect object values for Object K");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object K");
-          end;
- 
- 
-          begin
-             declare
-                M: C432003_0.NT_C2 :=                                   -- OK
-                     (C432003_0.ROOT with D2   => 10,
-                                          Str1 => "cdefg",
-                                          Str2 => String5,
-                                          S2   => String10);
-             begin
-                C432003_0.Avoid_Optimization(M);
-                if M.D2   /= 10         or  M.Acc /= 356       or
-                   M.Str1 /= "cdefg"    or  M.S2  /= String10  or
-                   M.Str2 /= String5    or
-                   M.S1   /= C432003_0.Default_String(1..5)
-                then
-                   Report.Failed("Incorrect object values for Object M");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object M");
-          end;
- 
- 
-          begin
-             declare
-                O: C432003_0.NT_C1 :=                                  -- C_E
-                     (C432003_0.Constrained_Subtype with 
-                        Str2 => Report.Ident_Str(String5));
-             begin
-                C432003_0.Avoid_Optimization(O);
-                Report.Failed("Constraint_Error not raised for Object O");
-             end;
-          exception
-             when Constraint_Error =>
-                null;  -- Raise of Constraint_Error is expected.
-          end;
- 
- 
-          begin
-             declare
-                P: C432003_0.NT_C2 :=                                  -- C_E
-                     (C432003_0.Constrained_Subtype with 
-                        D2   => Report.Ident_Int(10),
-                        Str2 => String5,
-                        S2   => String10);
-             begin
-                C432003_0.Avoid_Optimization(P);
-                Report.Failed("Constraint_Error not raised by Object P");
-             end;
-          exception
-             when Constraint_Error =>
-                null;  -- Raise of Constraint_Error is expected.
-          end;
- 
- 
-          begin
-             declare
-                Q: C432003_0.NT_C3 := 
-                   (C432003_0.Constrained_Subtype with Str2 => String5);  -- OK
-             begin
-                C432003_0.Avoid_Optimization(Q);
-                if Q.Str2 /= String5  or  
-                   Q.Acc  /= 356      or  
-                   Q.Str1 /= "abcde"  or
-                   Q.D1   /= 10       or
-                   Q.S1   /= C432003_0.Default_String(1..10)
-                then
-                   Report.Failed("Incorrect object values for Object Q");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object Q");
-          end;
- 
- 
-          -- The following cases test where a new discriminant corresponds
-          -- to multiple discriminants of the type of the ancestor part.
- 
-          begin
-             declare
-                S: C432003_0.Mult_NT_A1 :=                              -- OK
-                     (C432003_0.Mult_Unconstr_Der with D3 => 15,
-                                                       S3 => String15);
-             begin
-                C432003_0.Avoid_Optimization(S);
-                if S.S1   /= C432003_0.Default_String(1..15)  or  
-                   S.Str1 /= String8                          or
-                   S.S2   /= C432003_0.Another_String(1..15)  or  
-                   S.S3   /= String15                         or
-                   S.D3   /= 15
-                then
-                   Report.Failed("Incorrect object values for Object S");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object S");
-          end;
- 
- 
-          begin
-             declare
-                U: C432003_0.Mult_NT_A1 :=                             -- C_E
-                     (C432003_0.Mult_Constr_Sub1 with 
-                        D3 => Report.Ident_Int(15),
-                        S3 => String15);
-             begin
-                C432003_0.Avoid_Optimization(U);
-                Report.Failed("Constraint_Error not raised for Object U");
-             end;
-          exception
-             when Constraint_Error =>
-                null;  -- Raise of Constraint_Error is expected.
-          end;
- 
- 
-          begin
-             declare
-                V: C432003_0.Mult_NT_A1 :=                              -- OK
-                     (C432003_0.Mult_Constr_Sub2 with D3 => 15,
-                                                      S3 => String15);
-             begin
-                C432003_0.Avoid_Optimization(V);
-                if V.D3   /= 15        or  
-                   V.Str1 /= String8   or
-                   V.S3   /= String15  or
-                   V.S1   /= C432003_0.Default_String(1..15) or
-                   V.S2   /= C432003_0.Another_String(1..15)
-                then
-                   Report.Failed("Incorrect object values for Object V");
-                end if;
-             end;
-          exception
-             when Constraint_Error =>
-                Report.Failed("Constraint_Error raised for Object V");
-          end;
- 
- 
-       exception
-          when others => Report.Failed("Exception raised in Test_Block");
-       end Test_Block;
- 
-       Report.Result;
- 
- end C432003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c432004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c432004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,319 ****
- -- C432004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the type of an extension aggregate may be derived from the
- --      type of the ancestor part through multiple record extensions. Check
- --      for ancestor parts that are subtype marks. Check that the type of the
- --      ancestor part may be abstract.
- --
- -- TEST DESCRIPTION:
- --      This test defines the following type hierarchies:
- --
- --                (A)                           (F)
- --              Abstract                      Abstract
- --           Tagged record                 Tagged private
- --            /         \                   /          \
- --           /          (C)               (G)           \
- --         (B)        Abstract         Abstract         (H)
- --       Record       private          record         Private
- --      extension     extension        extension     extension
- --          |             |                |             |
- --         (D)           (E)              (I)           (J)
- --       Record        Record           Record        Record
- --      extension     extension        extension     extension
- --
- --      Extension aggregates for B, D, E, I, and J are constructed using each
- --      of its ancestor types as the ancestor part (except for E and J, for
- --      which only the immediate ancestor is used, since using A and F,
- --      respectively, as the ancestor part would be illegal).
- --
- --      X1 : B := (A with ...);
- --      X2 : D := (A with ...);         X5 : I := (F with ...);
- --      X3 : D := (B with ...);         X6 : I := (G with ...);
- --      X4 : E := (C with ...);         X7 : J := (H with ...);
- --
- --      For each assignment of an aggregate, the value of the target object is
- --      checked to ensure that the proper values for each component were
- --      assigned.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C432004_0 is
- 
-    type Drawers is record
-       Building : natural;
-    end record;
- 
-    type Location is access Drawers;
- 
-    type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);
- 
-    type SampleType_A is abstract tagged record
-       Era : Eras := Cenozoic;
-       Loc : Location;
-    end record;
- 
-    type SampleType_F is abstract tagged private;
- 
-    -- The following function is needed to verify the values of the
-    -- private components.
-    function TC_Correct_Result (Rec : SampleType_F'Class;
-                                E   : Eras) return Boolean;
- 
- private
-    type SampleType_F is abstract tagged record
-       Era : Eras := Mesozoic;
-    end record;
- 
- end C432004_0;
- 
-      --==================================================================--
- 
- package body C432004_0 is
- 
-    function TC_Correct_Result (Rec : SampleType_F'Class;
-                                E   : Eras) return Boolean is
-    begin
-       return (Rec.Era = E);
-    end TC_Correct_Result;
- 
- end C432004_0;
- 
-      --==================================================================--
- 
- with C432004_0;
- package C432004_1 is
- 
-    type Periods is
-       (Aphebian, Helikian, Hadrynian,
-        Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,
-        Triassic, Jurassic, Cretaceous,
-        Tertiary, Quaternary);
- 
-    type SampleType_B is new C432004_0.SampleType_A with record
-       Period : Periods := Quaternary;
-    end record;
- 
-    type SampleType_C is abstract new C432004_0.SampleType_A with private;
- 
-    -- The following function is needed to verify the values of the
-    -- extension's private components.
-    function TC_Correct_Result (Rec : SampleType_C'Class;
-                                P   : Periods) return Boolean;
- 
-    type SampleType_G is abstract new C432004_0.SampleType_F with record
-       Period : Periods := Jurassic;
-       Loc    : C432004_0.Location;
-    end record;
- 
-    type SampleType_H is new C432004_0.SampleType_F with private;
- 
-    -- The following function is needed to verify the values of the
-    -- extension's private components.
-    function TC_Correct_Result (Rec : SampleType_H'Class;
-                                P   : Periods;
-                                E   : C432004_0.Eras) return Boolean;
- 
- private
-    type SampleType_C is abstract new C432004_0.SampleType_A with record
-       Period : Periods := Quaternary;
-    end record;
- 
-    type SampleType_H is new C432004_0.SampleType_F with record
-       Period : Periods := Jurassic;
-    end record;
- 
- end C432004_1;
- 
-      --==================================================================--
- 
- package body C432004_1 is
- 
-    function TC_Correct_Result (Rec : SampleType_C'Class;
-                                P   : Periods) return Boolean is
-    begin
-       return (Rec.Period = P);
-    end TC_Correct_Result;
- 
-    -------------------------------------------------------------
-    function TC_Correct_Result (Rec : SampleType_H'Class;
-                                P   : Periods;
-                                E   : C432004_0.Eras) return Boolean is
-    begin
-       return (Rec.Period = P) and C432004_0.TC_Correct_Result (Rec, E);
-    end TC_Correct_Result;
- 
- end C432004_1;
- 
-      --==================================================================--
- 
- with C432004_0;
- with C432004_1;
- package C432004_2 is
- 
-    -- All types herein are record extensions, since aggregates
-    -- cannot be given for private extensions
-    
-    type SampleType_D is new C432004_1.SampleType_B with record
-       Sample_On_Loan : Boolean := False;
-    end record;
- 
-    type SampleType_E is new C432004_1.SampleType_C 
-      with null record;
- 
-    type SampleType_I is new C432004_1.SampleType_G with record
-       Sample_On_Loan : Boolean := True;
-    end record;
- 
-    type SampleType_J is new C432004_1.SampleType_H with record
-       Sample_On_Loan : Boolean := True;
-    end record;
- 
- end C432004_2;
- 
- 
-      --==================================================================--
- 
- with Report;
- with C432004_0;
- with C432004_1;
- with C432004_2;
- use  C432004_1;
- use  C432004_2;
- 
- procedure C432004 is
- 
-    -- Variety of extension aggregates.
- 
-    -- Default values for the components of SampleType_A 
-    -- (Era => Cenozoic, Loc => null).
-    Sample_B  :  SampleType_B 
-              := (C432004_0.SampleType_A with Period => Devonian);
- 
-    -- Default values from SampleType_A (Era => Cenozoic, Loc => null).
-    Sample_D1 :  SampleType_D
-              := (C432004_0.SampleType_A with Period => Cambrian,
-                                      Sample_On_Loan => True);
- 
-    -- Default values from SampleType_A and SampleType_B
-    -- (Era => Cenozoic, Loc => null, Period => Quaternary).
-    Sample_D2 :  SampleType_D
-              := (SampleType_B with Sample_On_Loan => True);
- 
-    -- Default values from SampleType_A and SampleType_C
-    -- (Era => Cenozoic, Loc => null, Period => Quaternary).
-    Sample_E  :  SampleType_E
-              := (SampleType_C with null record);
- 
-    -- Default value from SampleType_F (Era => Mesozoic).
-    Sample_I1 :  SampleType_I
-              := (C432004_0.SampleType_F with Period => Tertiary,
-                  Loc => new C432004_0.Drawers'(Building => 9),
-                  Sample_On_Loan => False);
- 
-    -- Default values from SampleType_F and SampleType_G
-    -- (Era => Mesozoic, Period => Jurassic, Loc => null).
-    Sample_I2 :  SampleType_I
-              := (SampleType_G with Sample_On_Loan => False);
- 
-    -- Default values from SampleType_H (Era => Mesozoic, Period => Jurassic).
-    Sample_J  :  SampleType_J
-              := (SampleType_H with Sample_On_Loan => False);
- 
-    use type C432004_0.Eras;
-    use type C432004_0.Location;
- 
- begin
- 
-    Report.Test ("C432004", "Check that the type of an extension aggregate "  &
-                 "may be derived from the type of the ancestor part through " &
-                 "multiple record extensions");
- 
-    if Sample_B /= (C432004_0.Cenozoic, null, Devonian) then
-       Report.Failed ("Object of record extension of abstract ancestor, " &
-                      "SampleType_B, failed content check");
-    end if;
- 
-    -------------------
-    if Sample_D1 /= (Era => C432004_0.Cenozoic, Loc => null, 
-                     Period => Cambrian, Sample_On_Loan => True) then
-       Report.Failed ("Object 1 of record extension of record extension, "  & 
-                      "of abstract ancestor, SampleType_D, failed content " &
-                      "check");
-    end if;
- 
-    -------------------
-    if Sample_D2 /= (C432004_0.Cenozoic, null, Quaternary, True) then
-       Report.Failed ("Object 2 of record extension of record extension, "  & 
-                      "of abstract ancestor, SampleType_D, failed content " &
-                      "check");
-    end if;
-    -------------------
-    if Sample_E.Era /= C432004_0.Cenozoic or 
-       Sample_E.Loc /= null               or
-       not TC_Correct_Result (Sample_E, Quaternary) then
-          Report.Failed ("Object of record extension of abstract private " & 
-                         "extension of abstract ancestor, SampleType_E, "  &
-                         "failed content check");
-    end if;
- 
-    -------------------
-    if not C432004_0.TC_Correct_Result (Sample_I1, C432004_0.Mesozoic) or
-      Sample_I1.Period         /= Tertiary                             or
-      Sample_I1.Loc.Building   /= 9                                    or
-      Sample_I1.Sample_On_Loan /= False                                then
-        Report.Failed ("Object 1 of record extension of abstract record " &
-                       "extension of abstract private ancestor, "         &
-                       "SampleType_I, failed content check");
-    end if;
- 
-    -------------------
-    if not C432004_0.TC_Correct_Result (Sample_I2, C432004_0.Mesozoic) or  
-      Sample_I2.Period         /= Jurassic                             or
-      Sample_I2.Loc            /= null                                 or
-      Sample_I2.Sample_On_Loan /= False                                then
-        Report.Failed ("Object 2 of record extension of abstract record " &
-                       "extension of abstract private ancestor, "         &
-                       "SampleType_I, failed content check");
-    end if;
- 
-    -------------------
-    if not TC_Correct_Result (Sample_J,
-                              Jurassic,
-                              C432004_0.Mesozoic) or
-      Sample_J.Sample_On_Loan /= False            then
-         Report.Failed ("Object of record extension of private extension " &
-                        "of abstract private ancestor, SampleType_J, "     &
-                        "failed content check");
-    end if;
- 
-    Report.Result;
- 
- end C432004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C43204A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
- --     (AND BOUNDS ARE DETERMINED CORRECTLY) AS AN ACTUAL PARAMETER OF
- --     A SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS CONSTRAINED.
- 
- -- HISTORY:
- --     JET 08/04/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43204A IS
- 
-      TYPE ARR10 IS ARRAY(IDENT_INT(1)..IDENT_INT(0)) OF INTEGER;
-      TYPE ARR11 IS ARRAY(INTEGER RANGE -3..3) OF INTEGER;
-      TYPE ARR12 IS ARRAY(IDENT_INT(-3)..IDENT_INT(3)) OF INTEGER;
- 
-      TYPE ARR20 IS ARRAY(IDENT_INT(1)..IDENT_INT(0),
-                          IDENT_INT(0)..IDENT_INT(-1)) OF INTEGER;
-      TYPE ARR21 IS ARRAY(INTEGER RANGE -1..1,
-                          INTEGER RANGE -1..1) OF INTEGER;
-      TYPE ARR22 IS ARRAY(IDENT_INT(-1)..IDENT_INT(1),
-                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
-      TYPE ARR23 IS ARRAY(INTEGER'(-1)..1,
-                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
- 
-      PROCEDURE PROC10 (A : ARR10) IS
-      BEGIN
-           IF A'LENGTH /= IDENT_INT(0) THEN
-                FAILED ("PROC10 ARRAY IS NOT NULL");
-           END IF;
-      END PROC10;
- 
-      PROCEDURE PROC11 (A : ARR11; C : INTEGER) IS
-      BEGIN
-           IF A'LENGTH /= IDENT_INT(7) OR
-              A'FIRST /= IDENT_INT(-3) OR
-              A'LAST /= IDENT_INT(3)   THEN
-                FAILED ("INCORRECT LENGTH IN PROC11 CALL NUMBER" &
-                        INTEGER'IMAGE(C));
-           END IF;
- 
-           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
-                IF IDENT_INT(A(I)) /= C THEN
-                     FAILED ("INCORRECT VALUE OF COMPONENT " &
-                             INTEGER'IMAGE(I) & ", PROC11 CALL NUMBER" &
-                             INTEGER'IMAGE(C));
-                END IF;
-           END LOOP;
-      END PROC11;
- 
-      PROCEDURE PROC12 (A : ARR12) IS
-      BEGIN
-           IF A'LENGTH /= IDENT_INT(7) THEN
-                FAILED ("INCORRECT LENGTH IN PROC12");
-           END IF;
- 
-           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
-                IF IDENT_INT(A(I)) /= 3 THEN
-                     FAILED ("INCORRECT VALUE OF COMPONENT " &
-                             INTEGER'IMAGE(I) & ", PROC12");
-                END IF;
-           END LOOP;
-      END PROC12;
- 
-      PROCEDURE PROC20 (A : ARR20) IS
-      BEGIN
-           IF A'LENGTH(1) /= IDENT_INT(0) OR
-              A'LENGTH(2) /= IDENT_INT(0) THEN
-                FAILED ("PROC20 ARRAY IS NOT NULL");
-           END IF;
-      END PROC20;
- 
-      PROCEDURE PROC21 (A : ARR21; C : INTEGER) IS
-      BEGIN
-           FOR I IN INTEGER'(-1)..1 LOOP
-                FOR J IN INTEGER'(-1)..1 LOOP
-                     IF IDENT_INT(A(I,J)) /= C THEN
-                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
-                                  INTEGER'IMAGE(I) & "," &
-                                  INTEGER'IMAGE(J) & "), PROC21 CALL " &
-                                  "NUMBER" & INTEGER'IMAGE(C));
-                     END IF;
-                END LOOP;
-           END LOOP;
-      END PROC21;
- 
-      PROCEDURE PROC22 (A : ARR22) IS
-      BEGIN
-           FOR I IN INTEGER'(-1)..1 LOOP
-                FOR J IN INTEGER'(-1)..1 LOOP
-                     IF IDENT_INT(A(I,J)) /= 5 THEN
-                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
-                                  INTEGER'IMAGE(I) & "," &
-                                  INTEGER'IMAGE(J) & "), PROC22");
-                     END IF;
-                END LOOP;
-           END LOOP;
-      END PROC22;
- 
-      PROCEDURE PROC23 (A : ARR23) IS
-      BEGIN
-           FOR I IN INTEGER'(-1)..1 LOOP
-                FOR J IN INTEGER'(-1)..1 LOOP
-                     IF IDENT_INT(A(I,J)) /= 7 THEN
-                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
-                                  INTEGER'IMAGE(I) & "," &
-                                  INTEGER'IMAGE(J) & "), PROC23");
-                     END IF;
-                END LOOP;
-           END LOOP;
-      END PROC23;
- 
- BEGIN
-      TEST ("C43204A", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
-                       "CHOICE CAN APPEAR (AND BOUNDS ARE DETERMINED " &
-                       "CORRECTLY) AS AN ACTUAL PARAMETER OF A " &
-                       "SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS " &
-                       "CONSTRAINED");
- 
-      PROC11 ((1,1,1, OTHERS => 1), 1);
-      PROC11 ((2 => 2, 3 => 2, OTHERS => 2), 2);
-      PROC12 ((OTHERS => 3));
-      PROC10 ((OTHERS => 4));
- 
-      PROC21 (((1,1,1), OTHERS => (1,1,1)), 1);
-      PROC21 ((1 => (2,2,2), OTHERS => (2,2,2)), 2);
-      PROC21 (((3,OTHERS => 3), (3,OTHERS => 3), (3,3,OTHERS => 3)), 3);
-      PROC21 (((-1 => 4, OTHERS => 4), (0 => 4, OTHERS => 4),
-               (1 => 4, OTHERS => 4)), 4);
-      PROC22 ((OTHERS => (OTHERS => 5)));
-      PROC20 ((OTHERS => (OTHERS => 6)));
-      PROC23 ((OTHERS => (7,7,7)));
- 
-      RESULT;
- END C43204A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- C43204C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
- --     (AND BOUNDS ARE DETERMINED CORRECTLY) AS AN ACTUAL PARAMETER OF
- --     A GENERIC INSTANTIATION WHEN THE GENERIC FORMAL PARAMETER IS
- --     CONSTRAINED.
- 
- -- HISTORY:
- --     JET 08/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43204C IS
- 
-      TYPE ARR10 IS ARRAY(IDENT_INT(1)..IDENT_INT(0)) OF INTEGER;
-      TYPE ARR11 IS ARRAY(INTEGER RANGE -3..3) OF INTEGER;
-      TYPE ARR12 IS ARRAY(IDENT_INT(-3)..IDENT_INT(3)) OF INTEGER;
- 
-      TYPE ARR20 IS ARRAY(IDENT_INT(1)..IDENT_INT(0),
-                          IDENT_INT(0)..IDENT_INT(-1)) OF INTEGER;
-      TYPE ARR21 IS ARRAY(INTEGER RANGE -1..1,
-                          INTEGER RANGE -1..1) OF INTEGER;
-      TYPE ARR22 IS ARRAY(IDENT_INT(-1)..IDENT_INT(1),
-                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
-      TYPE ARR23 IS ARRAY(INTEGER'(-1)..1,
-                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
- 
-      GENERIC
-           A : ARR10;
-      PROCEDURE GPROC10;
- 
-      GENERIC
-           A : ARR11;
-      PROCEDURE GPROC11;
- 
-      GENERIC
-           A : ARR12;
-      PROCEDURE GPROC12;
- 
-      GENERIC
-           A : ARR20;
-      PROCEDURE GPROC20;
- 
-      GENERIC
-           A : ARR21;
-      PROCEDURE GPROC21 (C : INTEGER);
- 
-      GENERIC
-           A : ARR22;
-      PROCEDURE GPROC22;
- 
-      GENERIC
-           A : ARR23;
-      PROCEDURE GPROC23;
- 
-      PROCEDURE GPROC10 IS
-      BEGIN
-           IF A'LENGTH /= IDENT_INT(0) THEN
-                FAILED ("PROC10 ARRAY IS NOT NULL");
-           END IF;
-      END GPROC10;
- 
-      PROCEDURE GPROC11 IS
-      BEGIN
-           IF A'LENGTH /= IDENT_INT(7) OR
-              A'FIRST /= IDENT_INT(-3) OR
-              A'LAST /= IDENT_INT(3)   THEN
-                FAILED ("INCORRECT LENGTH IN PROC11");
-           END IF;
- 
-           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
-                IF IDENT_INT(A(I)) /= 1 THEN
-                     FAILED ("INCORRECT VALUE OF COMPONENT " &
-                             INTEGER'IMAGE(I) & ", PROC11");
-                END IF;
-           END LOOP;
-      END GPROC11;
- 
-      PROCEDURE GPROC12 IS
-      BEGIN
-           IF A'LENGTH /= IDENT_INT(7) THEN
-                FAILED ("INCORRECT LENGTH IN PROC12");
-           END IF;
- 
-           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
-                IF IDENT_INT(A(I)) /= 2 THEN
-                     FAILED ("INCORRECT VALUE OF COMPONENT " &
-                             INTEGER'IMAGE(I) & ", PROC12");
-                END IF;
-           END LOOP;
-      END GPROC12;
- 
-      PROCEDURE GPROC20 IS
-      BEGIN
-           IF A'LENGTH(1) /= IDENT_INT(0) OR
-              A'LENGTH(2) /= IDENT_INT(0) THEN
-                FAILED ("GPROC20 ARRAY IS NOT NULL");
-           END IF;
-      END GPROC20;
- 
-      PROCEDURE GPROC21 (C : INTEGER) IS
-      BEGIN
-           FOR I IN INTEGER'(-1)..1 LOOP
-                FOR J IN INTEGER'(-1)..1 LOOP
-                     IF IDENT_INT(A(I,J)) /= C THEN
-                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
-                                  INTEGER'IMAGE(I) & "," &
-                                  INTEGER'IMAGE(J) & "), GPROC21 CALL " &
-                                  "NUMBER" & INTEGER'IMAGE(C));
-                     END IF;
-                END LOOP;
-           END LOOP;
-      END GPROC21;
- 
-      PROCEDURE GPROC22 IS
-      BEGIN
-           FOR I IN INTEGER'(-1)..1 LOOP
-                FOR J IN INTEGER'(-1)..1 LOOP
-                     IF IDENT_INT(A(I,J)) /= 3 THEN
-                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
-                                  INTEGER'IMAGE(I) & "," &
-                                  INTEGER'IMAGE(J) & "), GPROC22");
-                     END IF;
-                END LOOP;
-           END LOOP;
-      END GPROC22;
- 
-      PROCEDURE GPROC23 IS
-      BEGIN
-           FOR I IN INTEGER'(-1)..1 LOOP
-                FOR J IN INTEGER'(-1)..1 LOOP
-                     IF IDENT_INT(A(I,J)) /= 4 THEN
-                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
-                                  INTEGER'IMAGE(I) & "," &
-                                  INTEGER'IMAGE(J) & "), GPROC23");
-                     END IF;
-                END LOOP;
-           END LOOP;
-      END GPROC23;
- 
-      PROCEDURE PROC11 IS NEW GPROC11((1,1,1, OTHERS => 1));
-      PROCEDURE PROC12 IS NEW GPROC12((OTHERS => 2));
-      PROCEDURE PROC10 IS NEW GPROC10((OTHERS => 3));
- 
-      PROCEDURE PROC21 IS NEW GPROC21(((1,1,1), OTHERS => (1,1,1)));
-      PROCEDURE PROC22 IS NEW GPROC21(((2,OTHERS => 2), (2,OTHERS => 2),
-                                       (2,2,OTHERS => 2)));
-      PROCEDURE PROC23 IS NEW GPROC22((OTHERS => (OTHERS => 3)));
-      PROCEDURE PROC24 IS NEW GPROC23((OTHERS => (4,4,4)));
-      PROCEDURE PROC20 IS NEW GPROC20((OTHERS => (OTHERS => 5)));
- 
- BEGIN
-      TEST ("C43204C", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
-                       "CHOICE CAN APPEAR (AND BOUNDS ARE DETERMINED " &
-                       "CORRECTLY) AS AN ACTUAL PARAMETER OF A " &
-                       "SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS " &
-                       "CONSTRAINED");
- 
-      PROC11;
-      PROC12;
-      PROC10;
- 
-      PROC21(1);
-      PROC22(2);
-      PROC23;
-      PROC24;
-      PROC20;
- 
-      RESULT;
- END C43204C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,179 ****
- -- C43204E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
- --     AS THE INITIALIZATION EXPRESSION OF A CONSTRAINED CONSTANT,
- --     VARIABLE OBJECT DECLARATION, OR RECORD COMPONENT DECLARATION,
- --     AND THAT THE BOUNDS OF THE AGGREGATE ARE DETERMINED CORRECTLY.
- 
- -- HISTORY:
- --     JET 08/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43204E IS
- 
-      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
-      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
-      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
-      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           INTEGER RANGE -1 .. 1) OF INTEGER;
-      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
- 
-      CA11 : CONSTANT ARR11 := (1, OTHERS => IDENT_INT(2));
-      CA12 : CONSTANT ARR12 := (OTHERS => IDENT_INT(2));
-      CA13 : CONSTANT ARR13 := (OTHERS => IDENT_INT(2));
-      CA21 : CONSTANT ARR21 := (OTHERS => (-1..1 => IDENT_INT(2)));
-      CA22 : CONSTANT ARR22 := (OTHERS => (-1..1 => IDENT_INT(2)));
-      CA23 : CONSTANT ARR23 := (-1..1 => (OTHERS => IDENT_INT(2)));
-      CA24 : CONSTANT ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
- 
-      VA11 : ARR11 := (1,1, OTHERS => IDENT_INT(2));
-      VA12 : ARR12 := (OTHERS => IDENT_INT(2));
-      VA13 : ARR13 := (OTHERS => IDENT_INT(2));
-      VA21 : ARR21 := ((1,1,1), OTHERS => (-1..1 => IDENT_INT(2)));
-      VA22 : ARR22 := (-1 => (1,1,1), 0..1 => (OTHERS => IDENT_INT(2)));
-      VA23 : ARR23 := (OTHERS => (OTHERS => IDENT_INT(2)));
-      VA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
- 
-      TYPE REC IS RECORD
-           RA11 : ARR11 := (1,1,1, OTHERS => IDENT_INT(2));
-           RA12 : ARR12 := (OTHERS => IDENT_INT(2));
-           RA13 : ARR13 := (OTHERS => IDENT_INT(2));
-           RA21 : ARR21 := ((1,1,1), (1,1,1), OTHERS => (IDENT_INT(2),
-                            IDENT_INT(2), IDENT_INT(2)));
-           RA22 : ARR22 := (OTHERS => (OTHERS => IDENT_INT(2)));
-           RA23 : ARR23 := (-1 => (OTHERS => 1),
-                            0..1 => (OTHERS => IDENT_INT(2)));
-           RA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
-      END RECORD;
- 
-      R : REC;
- 
- BEGIN
-      TEST ("C43204E", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
-                       "CHOICE CAN APPEAR AS THE INITIALIZATION " &
-                       "EXPRESSION OF A CONSTRAINED CONSTANT, " &
-                       "VARIABLE OBJECT DECLARATION, OR RECORD " &
-                       "COMPONENT DECLARATION, AND THAT THE BOUNDS OF " &
-                       "THE AGGREGATE ARE DETERMINED CORRECTLY");
- 
-      IF CA11 /= (1, 2, 2, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF CA11");
-      END IF;
- 
-      IF CA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF CA12");
-      END IF;
- 
-      IF CA13'LENGTH /= 0 THEN
-           FAILED("INCORRECT VALUE OF CA13");
-      END IF;
- 
-      IF CA21 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF CA21");
-      END IF;
- 
-      IF CA22 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF CA22");
-      END IF;
- 
-      IF CA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF CA23");
-      END IF;
- 
-      IF CA24'LENGTH /= 0 OR CA24'LENGTH(2) /= 3 THEN
-           FAILED("INCORRECT VALUE OF CA24");
-      END IF;
- 
-      IF VA11 /= (1, 1, 2, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF VA11");
-      END IF;
- 
-      IF VA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF VA12");
-      END IF;
- 
-      IF VA13'LENGTH /= 0 THEN
-           FAILED("INCORRECT VALUE OF VA13");
-      END IF;
- 
-      IF VA21 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF VA21");
-      END IF;
- 
-      IF VA22 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF VA22");
-      END IF;
- 
-      IF VA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF VA23");
-      END IF;
- 
-      IF VA24'LENGTH /= 0 OR VA24'LENGTH(2) /= 3 THEN
-           FAILED("INCORRECT VALUE OF VA24");
-      END IF;
- 
-      IF R.RA11 /= (1, 1, 1, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF RA11");
-      END IF;
- 
-      IF R.RA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF RA12");
-      END IF;
- 
-      IF R.RA13'LENGTH /= 0 THEN
-           FAILED("INCORRECT VALUE OF RA13");
-      END IF;
- 
-      IF R.RA21 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF RA21");
-      END IF;
- 
-      IF R.RA22 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF RA22");
-      END IF;
- 
-      IF R.RA23 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF RA23");
-      END IF;
- 
-      IF R.RA24'LENGTH /= 0 OR R.RA24'LENGTH(2) /= 3 THEN
-           FAILED("INCORRECT VALUE OF RA24");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
-                   "RAISED");
- 
-           RESULT;
- END C43204E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- C43204F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
- --     CONSTRAINED FORMAL PARAMETER OF A SUBPROGRAM AND THAT THE BOUNDS
- --     OF THE AGGREGATE ARE DETERMINED CORRECTLY.
- 
- -- HISTORY:
- --     JET 08/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43204F IS
- 
-      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
-      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
-      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
-      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           INTEGER RANGE -1 .. 1) OF INTEGER;
-      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
- 
-      PROCEDURE PROC (PA11 : ARR11 := (1,1,1,1,1,1,
-                                       OTHERS => IDENT_INT(2));
-                      PA12 : ARR12 := (OTHERS => IDENT_INT(2));
-                      PA13 : ARR13 := (OTHERS => IDENT_INT(2));
-                      PA21 : ARR21 := ((1,1,1), (1,1,1),
-                                       (1, OTHERS => IDENT_INT(2)));
-                      PA22 : ARR22 := ((1,1,1), (1,1,1),
-                                       (OTHERS => IDENT_INT(2)));
-                      PA23 : ARR23 := ((1,1,1), (1,1,1), (1,1,1),
-                                       OTHERS => (OTHERS =>
-                                       IDENT_INT(2)));
-                      PA24 : ARR24 := (OTHERS => (OTHERS =>
-                                       IDENT_INT(2)))) IS
-      BEGIN
-           IF PA11 /= (1, 1, 1, 1, 1, 1, 2) THEN
-                FAILED("INCORRECT VALUE OF PA11");
-           END IF;
- 
-           IF PA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
-                FAILED("INCORRECT VALUE OF PA12");
-           END IF;
- 
-           IF PA13'LENGTH /= 0 THEN
-                FAILED("INCORRECT VALUE OF PA13");
-           END IF;
- 
-           IF PA21 /= ((1,1,1), (1,1,1), (1,2,2)) THEN
-                FAILED("INCORRECT VALUE OF PA21");
-           END IF;
- 
-           IF PA22 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
-                FAILED("INCORRECT VALUE OF PA22");
-           END IF;
- 
-           IF PA23 /= ((1,1,1), (1,1,1), (1,1,1)) THEN
-                FAILED("INCORRECT VALUE OF PA23");
-           END IF;
- 
-           IF PA24'LENGTH /= 0 OR PA24'LENGTH(2) /= 3 THEN
-                FAILED("INCORRECT VALUE OF PA24");
-           END IF;
-      END PROC;
- 
- BEGIN
-      TEST ("C43204F", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
-                       "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
-                       "OF A SUBPROGRAM AND THAT THE BOUNDS OF THE " &
-                       "AGGREGATE ARE DETERMINED CORRECTLY");
- 
-      PROC;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
-                   "RAISED");
- 
-           RESULT;
- END C43204F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C43204G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
- --     CONSTRAINED FORMAL PARAMETER OF AN ENTRY, AND THAT THE BOUNDS
- --     OF THE AGGREGATE ARE DETERMINED CORRECTLY.
- 
- -- HISTORY:
- --     JET 08/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43204G IS
- 
-      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
-      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
-      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
-      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           INTEGER RANGE -1 .. 1) OF INTEGER;
-      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
- 
-      TASK T IS
-           ENTRY E (EA11 : ARR11 := (1,1,1,1, OTHERS => IDENT_INT(2));
-                    EA12 : ARR12 := (OTHERS => IDENT_INT(2));
-                    EA13 : ARR13 := (OTHERS => IDENT_INT(2));
-                    EA21 : ARR21 := ((1,1,1), (1,1,1), (1,1,1),
-                                     OTHERS => (-1..1 => IDENT_INT(2)));
-                    EA22 : ARR22 := ((OTHERS => IDENT_INT(2)), (1,1,1),
-                                     (1,1,1));
-                    EA23 : ARR23 := (-1..0 => (OTHERS => 1),
-                                     1 => (OTHERS => IDENT_INT(2)));
-                    EA24: ARR24 := (OTHERS => (OTHERS => IDENT_INT(2))));
-      END T;
- 
-      TASK BODY T IS
-      BEGIN
-           ACCEPT E (EA11 : ARR11 := (1,1,1,1, OTHERS => IDENT_INT(2));
-                     EA12 : ARR12 := (OTHERS => IDENT_INT(2));
-                     EA13 : ARR13 := (OTHERS => IDENT_INT(2));
-                     EA21 : ARR21 := ((1,1,1), (1,1,1), (1,1,1),
-                                      OTHERS => (-1..1 => IDENT_INT(2)));
-                     EA22 : ARR22 := ((OTHERS => IDENT_INT(2)), (1,1,1),
-                                      (1,1,1));
-                     EA23 : ARR23 := (-1..0 => (OTHERS => 1),
-                                      1 => (OTHERS => IDENT_INT(2)));
-                     EA24 : ARR24 := (OTHERS => (OTHERS =>
-                                     IDENT_INT(2))))
-           DO
-                IF EA11 /= (1, 1, 1, 1, 2, 2, 2) THEN
-                     FAILED("INCORRECT VALUE OF EA11");
-                END IF;
- 
-                IF EA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
-                     FAILED("INCORRECT VALUE OF EA12");
-                END IF;
- 
-                IF EA13'LENGTH /= 0 THEN
-                     FAILED("INCORRECT VALUE OF EA13");
-                END IF;
- 
-                IF EA21 /= ((1,1,1), (1,1,1), (1,1,1)) THEN
-                     FAILED("INCORRECT VALUE OF EA21");
-                END IF;
- 
-                IF EA22 /= ((2,2,2), (1,1,1), (1,1,1)) THEN
-                     FAILED("INCORRECT VALUE OF EA22");
-                END IF;
- 
-                IF EA23 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
-                     FAILED("INCORRECT VALUE OF EA23");
-                END IF;
- 
-                IF EA24'LENGTH /= 0 OR EA24'LENGTH(2) /= 3 THEN
-                     FAILED("INCORRECT VALUE OF EA24");
-                END IF;
-           END E;
-      END T;
- 
- BEGIN
-      TEST ("C43204G", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
-                       "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
-                       "OF AN ENTRY, AND THAT THE BOUNDS OF THE " &
-                       "AGGREGATE ARE DETERMINED CORRECTLY");
- 
-      T.E;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
-                   "RAISED");
- 
-           IF T'CALLABLE THEN
-                T.E;
-           END IF;
- 
-           RESULT;
- END C43204G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- C43204H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
- --     CONSTRAINED FORMAL PARAMETER OF A GENERIC UNIT, AND THAT THE
- --     BOUNDS OF THE AGGREGATE ARE DETERMINED CORRECTLY.
- 
- -- HISTORY:
- --     JET 08/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43204H IS
- 
-      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
-      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
-      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
-      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           INTEGER RANGE -1 .. 1) OF INTEGER;
-      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
- 
-      GENERIC
-           GA11 : ARR11 := (1,1,1,1,1, OTHERS => IDENT_INT(2));
-           GA12 : ARR12 := (OTHERS => IDENT_INT(2));
-           GA13 : ARR13 := (OTHERS => IDENT_INT(2));
-           GA21 : ARR21 := ((1,1,1), (1,1,1), (OTHERS => IDENT_INT(2)));
-           GA22 : ARR22 := ((1,1,1), (OTHERS => IDENT_INT(2)), (1,1,1));
-           GA23 : ARR23 := ((1,1,1), (OTHERS => IDENT_INT(2)), (1,1,1));
-           GA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
-      PROCEDURE GEN;
- 
-      PROCEDURE GEN IS
-      BEGIN
-           IF GA11 /= (1, 1, 1, 1, 1, 2, 2) THEN
-                FAILED("INCORRECT VALUE OF GA11");
-           END IF;
- 
-           IF GA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
-                FAILED("INCORRECT VALUE OF GA12");
-           END IF;
- 
-           IF GA13'LENGTH /= 0 THEN
-                FAILED("INCORRECT VALUE OF GA13");
-           END IF;
- 
-           IF GA21 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
-                FAILED("INCORRECT VALUE OF GA21");
-           END IF;
- 
-           IF GA22 /= ((1,1,1), (2,2,2), (1,1,1)) THEN
-                FAILED("INCORRECT VALUE OF GA22");
-           END IF;
- 
-           IF GA23 /= ((1,1,1), (2,2,2), (1,1,1)) THEN
-                FAILED("INCORRECT VALUE OF GA23");
-           END IF;
- 
-           IF GA24'LENGTH /= 0 OR GA24'LENGTH(2) /= 3 THEN
-                FAILED("INCORRECT VALUE OF GA24");
-           END IF;
-      END GEN;
- 
-      PROCEDURE PROCG IS NEW GEN;
- 
- BEGIN
-      TEST ("C43204H", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
-                       "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
-                       "OF A GENERIC UNIT, AND THAT THE BOUNDS OF " &
-                       "THE AGGREGATE ARE DETERMINED CORRECTLY");
- 
-      PROCG;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
-                   "RAISED");
- 
-           RESULT;
- END C43204H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43204i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43204i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- C43204I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS THE
- --     EXPRESSION IN AN ASSIGNMENT STATEMENT, AND THAT THE BOUNDS OF
- --     THE AGGREGATE ARE DETERMINED CORRECTLY.
- 
- -- HISTORY:
- --     JET 08/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43204I IS
- 
-      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
-      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
-      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
-      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           INTEGER RANGE -1 .. 1) OF INTEGER;
-      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
-      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
-                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
- 
-      VA11 : ARR11;
-      VA12 : ARR12;
-      VA13 : ARR13;
-      VA21 : ARR21;
-      VA22 : ARR22;
-      VA23 : ARR23;
-      VA24 : ARR24;
- 
- BEGIN
-      TEST ("C43204I", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
-                       "CAN APPEAR AS THE EXPRESSION IN AN ASSIGNMENT " &
-                       "STATEMENT, AND THAT THE BOUNDS OF THE " &
-                       "AGGREGATE ARE DETERMINED CORRECTLY");
- 
-      VA11 := (1,1, OTHERS => IDENT_INT(2));
-      VA12 := (OTHERS => IDENT_INT(2));
-      VA13 := (OTHERS => IDENT_INT(2));
-      VA21 := ((1,1,1), OTHERS => (-1..1 => IDENT_INT(2)));
-      VA22 := (-1 => (1,1,1), 0..1 => (OTHERS => IDENT_INT(2)));
-      VA23 := (OTHERS => (OTHERS => IDENT_INT(2)));
-      VA24 := (OTHERS => (OTHERS => IDENT_INT(2)));
- 
-      IF VA11 /= (1, 1, 2, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF VA11");
-      END IF;
- 
-      IF VA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
-           FAILED("INCORRECT VALUE OF VA12");
-      END IF;
- 
-      IF VA13'LENGTH /= 0 THEN
-           FAILED("INCORRECT VALUE OF VA13");
-      END IF;
- 
-      IF VA21 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF VA21");
-      END IF;
- 
-      IF VA22 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF VA22");
-      END IF;
- 
-      IF VA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
-           FAILED("INCORRECT VALUE OF VA23");
-      END IF;
- 
-      IF VA24'LENGTH /= 0 OR VA24'LENGTH(2) /= 3 THEN
-           FAILED("INCORRECT VALUE OF VA24");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
-                   "RAISED");
- 
-           RESULT;
- END C43204I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C43205A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
- 
- --   A) AN ACTUAL PARAMETER IN A SUBPROGRAM OR ENTRY CALL, AND THE
- --      FORMAL PARAMETER IS UNCONSTRAINED.
- 
- -- EG  01/26/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205A", "CASE A1 : SUBPROGRAM WITH UNCONSTRAINED " &
-                      "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
-      CASE_A1 : DECLARE
- 
-                     SUBTYPE STA IS INTEGER RANGE 11 .. 15;
-                     TYPE TA IS ARRAY (STA RANGE <>) OF INTEGER;
- 
-                     PROCEDURE PROC1 (A : TA) IS
-                     BEGIN
-                          IF A'FIRST /= IDENT_INT(11) THEN
-                               FAILED ("CASE A1 : LOWER BOUND " &
-                                       "INCORRECTLY GIVEN BY 'FIRST");
-                          ELSIF A'LAST /= 15 THEN
-                               FAILED ("CASE A1 : UPPER BOUND " &
-                                       "INCORRECTLY GIVEN BY 'LAST");
-                          ELSIF A /= (6, 7, 8, 9, 10) THEN
-                               FAILED ("CASE A1 : ARRAY DOES NOT " &
-                                      "CONTAIN THE CORRECT VALUES");
-                          END IF;
-                     END;
- 
-                BEGIN
- 
-                     PROC1 ((6, 7, 8, 9, IDENT_INT(10)));
- 
-                END CASE_A1;
- 
-                COMMENT ("CASE A2 : SUBPROGRAM WITH UNCONSTRAINED " &
-                         "TWO-DIMENSIONAL ARRAY FORMAL PARAMETER");
- 
-      CASE_A2 : DECLARE
- 
-                     SUBTYPE STA1 IS INTEGER RANGE 11 .. IDENT_INT(12);
-                     SUBTYPE STA2 IS INTEGER RANGE 10 .. 11;
-                     TYPE TA IS ARRAY (STA1 RANGE <>, STA2 RANGE <>)
-                                     OF INTEGER;
- 
-                     PROCEDURE PROC1 (A : TA) IS
-                     BEGIN
-                          IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
-                               FAILED ("CASE A2 : LOWER BOUND " &
-                                       "INCORRECTLY GIVEN BY 'FIRST");
-                          ELSIF A'LAST(1) /= 12 OR 
-                                A'LAST(2) /= IDENT_INT(11) THEN
-                               FAILED ("CASE A2 : UPPER BOUND " &
-                                       "INCORRECTLY GIVEN BY 'LAST");
-                          ELSIF A /= ((1, 2), (3, 4)) THEN
-                               FAILED ("CASE A2 : ARRAY DOES NOT " &
-                                      "CONTAIN THE CORRECT VALUES");
-                          END IF;
-                     END;
- 
-                BEGIN
- 
-                     PROC1 (((1, 2), (IDENT_INT(3), 4)));
- 
-                END CASE_A2;
- 
-           END CASE_A;
- 
-      END;
- 
-      RESULT;
- 
- END C43205A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C43205B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
- 
- --   B) AN ACTUAL PARAMETER IN A GENERIC INSTANTIATION, AND THE FORMAL
- --      PARAMETER IS UNCONSTRAINED.
- 
- -- EG  01/26/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205B", "CASE B : UNCONSTRAINED ARRAY FORMAL GENERIC " &
-                       "PARAMETER");
- 
-      BEGIN
- 
- CASE_B :  DECLARE
- 
-                SUBTYPE STB IS INTEGER RANGE IDENT_INT(-8) .. -5;
-                TYPE TB IS ARRAY (STB RANGE <>) OF INTEGER;
- 
-                GENERIC
-                     B1 : TB;
-                PROCEDURE PROC1;
- 
-                PROCEDURE PROC1 IS
-                BEGIN
-                     IF B1'FIRST /= -8 THEN
-                          FAILED ("CASE B : LOWER BOUND INCORRECTLY " &
-                                  "GIVEN BY 'FIRST");
-                     ELSIF B1'LAST /= IDENT_INT(-5) THEN
-                          FAILED ("CASE B : UPPER BOUND INCORRECTLY " &
-                                  "GIVEN BY 'LAST");
-                     ELSIF B1 /= (7, 6, 5, 4) THEN
-                          FAILED ("CASE B : ARRAY DOES NOT " &
-                                  "CONTAIN THE CORRECT VALUES");
-                     END IF;
-                END;
- 
-                PROCEDURE PROC2 IS NEW PROC1 ((7, 6, IDENT_INT(5), 4));
- 
-           BEGIN
- 
-                PROC2;
- 
-           END CASE_B;
- 
-      END;
- 
-      RESULT;
- 
- END C43205B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C43205C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
- 
- --   C) THE RETURN EXPRESSION IN A FUNCTION WHOSE RETURN TYPE IS
- --      UNCONSTRAINED.
- 
- -- EG  01/26/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205C", "CASE C : UNCONSTRAINED FUNCTION RESULT TYPE");
- 
-      BEGIN
- 
- CASE_C :  DECLARE
- 
-                SUBTYPE STC1 IS INTEGER RANGE -2 .. 3;
-                SUBTYPE STC2 IS INTEGER RANGE 7 .. 20;
-                TYPE TC IS ARRAY (STC1 RANGE <>, STC2 RANGE <>)
-                                                         OF INTEGER;
- 
-                FUNCTION FUN1 (A : INTEGER) RETURN TC IS
-                BEGIN
-                     RETURN ((5, 4, 3), (2, IDENT_INT(1), 0));
-                END;
- 
-           BEGIN
- 
-                IF FUN1(5)'FIRST(1) /= -2 THEN
-                     FAILED ("CASE C : LOWER BOUND INCORRECTLY " &
-                             "GIVEN BY 'FIRST(1)");
-                ELSIF FUN1(5)'FIRST(2) /= 7 THEN
-                     FAILED ("CASE C : LOWER BOUND INCORRECTLY " &
-                             "GIVEN BY 'FIRST(2)");
-                ELSIF FUN1(5)'LAST(1) /= -1 THEN
-                     FAILED ("CASE C : UPPER BOUND INCORRECTLY " &
-                             "GIVEN BY 'LAST(1)");
-                ELSIF FUN1(5)'LAST(2) /= 9 THEN
-                     FAILED ("CASE C : UPPER BOUND INCORRECTLY " &
-                             "GIVEN BY 'LAST(2)");
-                ELSIF FUN1(5) /= ((5, 4, 3), (2, 1, 0)) THEN
-                     FAILED ("CASE C : FUNCTION DOES NOT " &
-                             "RETURN THE CORRECT VALUES");
-                END IF;
- 
-           END CASE_C;
- 
-      END;
- 
-      RESULT;
- 
- END C43205C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C43205D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
- 
- --   D) THE INITIALIZATION EXPRESSION OF A CONSTANT WHOSE TYPE MARK
- --      DENOTES AN UNCONSTRAINED ARRAY.
- 
- -- EG  01/26/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205D IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205D", "CASE D : INITIALIZATION OF UNCONSTRAINED " &
-                      "ARRAY CONSTANT");
- 
-      BEGIN
- 
- CASE_D :  DECLARE
- 
-                SUBTYPE STD IS INTEGER RANGE IDENT_INT(11) .. 13;
-                TYPE TD IS ARRAY (STD RANGE <>) OF INTEGER;
- 
-                D1 : CONSTANT TD := (-1, -2, -3);
- 
-           BEGIN
- 
-                IF D1'FIRST /= 11 THEN
-                     FAILED ("CASE D : LOWER BOUND INCORRECTLY " &
-                             "GIVEN BY 'FIRST");
-                ELSIF D1'LAST /= 13 THEN
-                     FAILED ("CASE D : UPPER BOUND INCORRECTLY " &
-                             "GIVEN BY 'LAST");
-                ELSIF D1 /= (-1, -2, -3) THEN
-                     FAILED ("CASE D : ARRAY DOES NOT CONTAIN " &
-                             "THE CORRECT VALUES");
-                END IF;
- 
-           END CASE_D;
- 
-      END;
- 
-      RESULT;
- 
- END C43205D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C43205E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
- 
- --   E) THE LEFT OR RIGHT OPERAND OF "&".
- 
- -- EG  01/26/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205E IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205E", "CASE E : OPERAND OF &");
- 
-      BEGIN
- 
- CASE_E :  DECLARE
- 
-                SUBTYPE STE IS INTEGER RANGE 2 .. 10;
- 
-                TYPE COLOR IS (RED, GREEN, BLUE);
-                TYPE TE IS ARRAY (STE RANGE <>) OF COLOR;
- 
-                FUNCTION CONCAT1 RETURN TE IS
-                BEGIN
-                     RETURN (RED, GREEN, BLUE) & (7 .. 8 => RED);
-                END;
- 
-                FUNCTION CONCAT2 RETURN TE IS
-                BEGIN
-                     RETURN (IDENT_INT(4) .. 3 => RED) & (GREEN, BLUE);
-                END;
- 
-                FUNCTION CONCAT3 RETURN STRING IS
-                BEGIN
-                     RETURN "TEST" & (7 .. 8 => 'X');
-                END;
- 
-                FUNCTION CONCAT4 RETURN STRING IS
-                BEGIN
-                     RETURN (8 .. 5 => 'A') & "BC";
-                END;
- 
-           BEGIN
- 
-                IF CONCAT1'FIRST /= IDENT_INT(2) THEN
-                     FAILED ("CASE E1 : LOWER BOUND INCORRECTLY " &
-                             "GIVEN BY 'FIRST");
-                ELSIF CONCAT1'LAST /= 6 THEN
-                     FAILED ("CASE E1 : UPPER BOUND INCORRECTLY " &
-                             "GIVEN BY 'LAST");
-                ELSIF CONCAT1 /= (RED, GREEN, BLUE, RED, RED) THEN
-                     FAILED ("CASE E1 : INCORRECT VALUES PRODUCED");
-                END IF;
-                IF CONCAT2'FIRST /= IDENT_INT(2) THEN
-                     FAILED ("CASE E2 : LOWER BOUND INCORRECTLY " &
-                             "GIVEN BY 'FIRST");
-                ELSIF CONCAT2'LAST /= 3 THEN
-                     FAILED ("CASE E2 : UPPER BOUND INCORRECTLY " &
-                             "GIVEN BY 'LAST");
-                ELSIF CONCAT2 /= (GREEN, BLUE) THEN
-                     FAILED ("CASE E2 : INCORRECT VALUES PRODUCED");
-                END IF;
-                IF CONCAT3'FIRST /= IDENT_INT(1) THEN
-                     FAILED ("CASE E3 : LOWER BOUND INCORRECTLY " &
-                             "GIVEN BY 'FIRST");
-                ELSIF CONCAT3'LAST /= 6 THEN
-                     FAILED ("CASE E3 : UPPER BOUND INCORRECTLY " &
-                             "GIVEN BY 'LAST");
-                ELSIF CONCAT3 /= "TESTXX" THEN
-                     FAILED ("CASE E3 : INCORRECT VALUES PRODUCED");
-                END IF;
-                IF CONCAT4'FIRST /= IDENT_INT(1) THEN
-                     FAILED ("CASE E4 : LOWER BOUND INCORRECTLY " &
-                             "GIVEN BY 'FIRST");
-                ELSIF CONCAT4'LAST /= 2 THEN
-                     FAILED ("CASE E4 : UPPER BOUND INCORRECTLY " &
-                             "GIVEN BY 'LAST");
-                ELSIF CONCAT4 /= "BC" THEN
-                     FAILED ("CASE E4 : INCORRECT VALUES PRODUCED");
-                END IF;
- 
-           END CASE_E;
- 
-      END;
- 
-      RESULT;
- 
- END C43205E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C43205G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
- -- POSITIONAL AGGREGATE IS USED AS:
- 
- -- AN ACTUAL PARAMETER IN A SUBPROGRAM, AND THE
- -- FORMAL PARAMETER IS CONSTRAINED.
- 
- -- EG  01/27/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205G IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205G", "SUBPROGRAM WITH CONSTRAINED " &
-                      "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
- 
-      BEGIN
- 
- CASE_G :  BEGIN
- 
-      CASE_G1 : DECLARE
- 
-                     TYPE TA IS ARRAY (IDENT_INT(11) .. 15) OF INTEGER;
- 
-                     PROCEDURE PROC1 (A : TA) IS
-                     BEGIN
-                          IF A'FIRST /= 11 THEN
-                               FAILED ("CASE A1 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A'LAST /= 15 THEN
-                               FAILED ("CASE A1 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A /= (6, 7, 8, 9, 10) THEN
-                               FAILED ("CASE A1 : ARRAY DOES NOT " &
-                                      "CONTAIN THE CORRECT VALUES");
-                          END IF;
-                     END;
- 
-                BEGIN
- 
-                     PROC1 ((6, 7, 8, IDENT_INT(9), 10));
- 
-                END CASE_G1;
- 
-      CASE_G2 : DECLARE
- 
-                     TYPE TA IS ARRAY (11 .. 12, 
-                                       IDENT_INT(10) .. 11) OF INTEGER;
- 
-                     PROCEDURE PROC1 (A : TA) IS
-                     BEGIN
-                          IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
-                               FAILED ("CASE A2 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A'LAST(1) /= 12 OR A'LAST(2) /= 11 THEN
-                               FAILED ("CASE A2 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A /= ((1, 2), (3, 4)) THEN
-                               FAILED ("CASE A2 : ARRAY DOES NOT " &
-                                       "CONTAIN THE CORRECT VALUES");
-                          END IF;
-                     END;
- 
-                BEGIN
- 
-                     PROC1 (((1, 2), (3, 4)));
- 
-                END CASE_G2;
- 
-           END CASE_G;
- 
-      END;
- 
-      RESULT;
- 
- END C43205G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C43205H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
- -- POSITIONAL AGGREGATE IS USED AS:
- 
- -- AN ACTUAL PARAMETER IN A GENERIC INSTANTIATION, AND THE FORMAL
- -- PARAMETER IS CONSTRAINED.
- 
- -- EG  01/27/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205H IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205H", "CONSTRAINED ARRAY FORMAL GENERIC " &
-                      "PARAMETER");
- 
-      BEGIN
- 
- CASE_H :  DECLARE
- 
-                SUBTYPE STH IS INTEGER RANGE -10 .. 0;
-                TYPE BASE IS ARRAY(STH RANGE <>) OF INTEGER;
-                SUBTYPE TB IS BASE(IDENT_INT(-8) .. -5);
- 
-                GENERIC
-                     B1 : TB;
-                PROCEDURE PROC1;
- 
-                PROCEDURE PROC1 IS
-                BEGIN
-                     IF B1'FIRST /= -8 THEN
-                          FAILED ("CASE B : LOWER BOUND INCORRECT");
-                     ELSIF B1'LAST /= -5 THEN
-                          FAILED ("CASE B : UPPER BOUND INCORRECT");
-                     ELSIF B1 /= (7, 6, 5, 4) THEN
-                          FAILED ("CASE B : ARRAY DOES NOT " &
-                                  "CONTAIN THE CORRECT VALUES");
-                     END IF;
-                END;
- 
-                PROCEDURE PROC2 IS NEW PROC1 ((7, 6, 5, 4));
- 
-           BEGIN
- 
-                PROC2;
- 
-           END CASE_H;
- 
-      END;
- 
-      RESULT;
- 
- END C43205H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C43205I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
- -- POSITIONAL AGGREGATE IS USED AS:
- 
- -- THE RETURN EXPRESSION IN A FUNCTION WHOSE RETURN TYPE IS
- -- CONSTRAINED.
- 
- -- EG  01/27/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205I IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205I", "CONSTRAINED FUNCTION RESULT TYPE");
- 
-      BEGIN
- 
- CASE_I :  DECLARE
- 
-                SUBTYPE STC IS INTEGER RANGE -2 .. 10;
-                TYPE BASE IS ARRAY(STC RANGE <>, STC RANGE <>)OF INTEGER;
-                SUBTYPE TC IS BASE(IDENT_INT(-1) .. 0, 7 .. 9);
- 
-                FUNCTION FUN1 (A : INTEGER) RETURN TC IS
-                BEGIN
-                     RETURN ((5, 4, 3), (2, 1, 0));
-                END;
- 
-           BEGIN
- 
-                IF FUN1(5)'FIRST(1) /= -1 THEN
-                     FAILED ("CASE I : LOWER BOUND INCORRECT " &
-                             "FOR 'FIRST(1)");
-                ELSIF FUN1(5)'FIRST(2) /= 7 THEN
-                     FAILED ("CASE I : LOWER BOUND INCORRECT " &
-                             "FOR 'FIRST(2)");
-                ELSIF FUN1(5)'LAST(1) /= 0 THEN
-                     FAILED ("CASE I : UPPER BOUND INCORRECT " &
-                             "FOR 'LAST(1)");
-                ELSIF FUN1(5)'LAST(2) /= 9 THEN
-                     FAILED ("CASE I : UPPER BOUND INCORRECT " &
-                             "FOR 'LAST(2)");
-                ELSIF FUN1(5) /= ((5, 4, 3), (2, 1, 0)) THEN
-                     FAILED ("CASE I : FUNCTION DOES NOT " &
-                             "RETURN THE CORRECT VALUES");
-                END IF;
- 
-           END CASE_I;
- 
-      END;
- 
-      RESULT;
- 
- END C43205I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- C43205J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
- -- POSITIONAL AGGREGATE IS USED AS:
- 
- --   J) THE INITIALIZATION EXPRESSION OF A CONSTANT, VARIABLE, OR FORMAL
- --      PARAMETER (OF A SUBPROGRAM, ENTRY, OR GENERIC UNIT) WHEN THE
- --      TYPE OF THE CONSTANT, VARIABLE, OR PARAMETER IS CONSTRAINED.
- 
- -- EG  01/27/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205J IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205J", "CASE J : INITIALIZATION OF CONSTRAINED " &
-                      "ARRAY");
- 
-      BEGIN
- 
- CASE_J :  BEGIN
- 
-      CASE_J1 : DECLARE
- 
-                     TYPE TD1 IS ARRAY (IDENT_INT(11) .. 13) OF INTEGER;
- 
-                     D1 : CONSTANT TD1 := (-1, -2, -3);
- 
-                BEGIN
- 
-                     IF D1'FIRST /= 11 THEN
-                          FAILED ("CASE J1 : LOWER BOUND INCORRECT");
-                     ELSIF D1'LAST /= 13 THEN
-                          FAILED ("CASE J1 : UPPER BOUND INCORRECT");
-                     ELSIF D1 /= (-1, -2, -3) THEN
-                               FAILED ("CASE J1 : ARRAY DOES NOT " &
-                                       "CONTAINING THE CORRECT VALUES");
-                     END IF;
- 
-                END CASE_J1;
- 
-      CASE_J2 : DECLARE
- 
-                     TYPE TD2 IS ARRAY(INTEGER RANGE -13 .. -11)
-                                                             OF INTEGER;
-                     D2 : TD2 := (3, 2, 1);
- 
-                BEGIN
- 
-                     IF D2'FIRST /= -13 THEN
-                          FAILED ("CASE J2 : LOWER BOUND INCORRECT");
-                     ELSIF D2'LAST /= -11 THEN
-                          FAILED ("CASE J2 : UPPER BOUND INCORRECT");
-                     ELSIF D2 /= (3, 2, 1) THEN
-                          FAILED ("CASE J2 : INCORRECT VALUES");
-                     END IF;
- 
-                END CASE_J2;
- 
-      CASE_J3 : DECLARE
- 
-                     TYPE TD3 IS ARRAY(IDENT_INT(5) .. 7) OF INTEGER;
- 
-                     PROCEDURE PROC1 (A : TD3 := (2, 3, 4)) IS
-                     BEGIN
-                          IF A'FIRST /= 5 THEN
-                               FAILED ("CASE J3 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A'LAST /= 7 THEN
-                               FAILED ("CASE J3 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A /= (2, 3, 4) THEN
-                               FAILED ("CASE J3 : INCORRECT VALUES");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                PROC1;
- 
-                END CASE_J3;
- 
-      CASE_J4 : DECLARE
- 
-                     TYPE TD4 IS ARRAY(5 .. 8) OF INTEGER;
- 
-                     GENERIC
-                          D4 : TD4 := (1, -2, 3, -4);
-                     PROCEDURE PROC1;
- 
-                     PROCEDURE PROC1 IS
-                     BEGIN
-                          IF D4'FIRST /= 5 THEN
-                               FAILED ("CASE J4 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF D4'LAST /= 8 THEN
-                               FAILED ("CASE J4 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF D4 /= (1, -2, 3, -4) THEN
-                               FAILED ("CASE J4 : INCORRECT VALUES");
-                          END IF;
-                     END PROC1;
- 
-                     PROCEDURE PROC2 IS NEW PROC1;
- 
-                BEGIN
- 
-                     PROC2;
- 
-                END CASE_J4;
- 
-           END CASE_J;
- 
-      END;
- 
-      RESULT;
- 
- END C43205J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43205k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43205k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C43205K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
- -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
- -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
- -- POSITIONAL AGGREGATE IS USED AS:
- 
- -- THE EXPRESSION OF AN ENCLOSING RECORD OR ARRAY AGGREGATE, AND
- -- THE EXPRESSION GIVES THE VALUE OF A RECORD OR ARRAY COMPONENT
- -- (WHICH IS NECESSARILY CONSTRAINED).
- 
- -- EG  01/27/84
- -- JBG 3/30/84
- 
- WITH REPORT;
- 
- PROCEDURE C43205K IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43205K", "THE EXPRESSION OF AN ENCLOSING RECORD " &
-                      "OR ARRAY AGGREGATE, AND THE EXPRESSION GIVES "   &
-                      "THE VALUE OF A RECORD OR ARRAY COMPONENT");
- 
-      BEGIN
- 
- CASE_K :  BEGIN
- 
-      CASE_K1 : DECLARE
- 
-                     SUBTYPE SK1 IS INTEGER RANGE 2 .. 6;
-                     TYPE BASE IS ARRAY(SK1 RANGE <>) OF INTEGER;
-                     SUBTYPE TE1 IS BASE(IDENT_INT(3) .. 5);
-                     TYPE TE2 IS ARRAY(1 .. 2) OF TE1;
- 
-                     E1 : TE2;
- 
-                BEGIN
- 
-                     E1 := (1 .. 2 => (3, 2, 1));
-                     IF (E1'FIRST /= 1 OR E1'LAST /= 2) OR ELSE
-                        (E1(1)'FIRST /= 3 OR E1(1)'LAST /= 5 OR
-                         E1(2)'FIRST /= 3 OR E1(2)'LAST /= 5) THEN
-                          FAILED ("CASE K1 : INCORRECT BOUNDS");
-                     ELSE
-                          IF E1 /= (1 .. 2 => (3, 2, 1)) THEN
-                               FAILED ("CASE K1 : ARRAY DOES NOT " &
-                                       "CONTAIN THE CORRECT VALUES");
-                          END IF;
-                     END IF;
- 
-                END CASE_K1;
- 
-      CASE_K2 : DECLARE
- 
-                     TYPE SK2 IS RANGE 2 .. 6;
-                     TYPE BASE IS ARRAY(SK2 RANGE <>) OF INTEGER;
-                     SUBTYPE TE1 IS BASE(3 .. 5);
-                     TYPE TER IS
-                          RECORD
-                               REC : TE1;
-                          END RECORD;
- 
-                     E2 : TER;
- 
-                BEGIN
- 
-                     E2 := (REC => (3, 2, 1));
-                     IF E2.REC'FIRST /= 3 OR E2.REC'LAST /= 5 THEN
-                          FAILED ("CASE K2 : INCORRECT BOUNDS");
-                     ELSE
-                          IF E2.REC /= (3, 2, 1) THEN
-                               FAILED ("CASE K2 : ARRAY DOES NOT " &
-                                       "CONTAIN CORRECT VALUES");
-                          END IF;
-                     END IF;
- 
-                END CASE_K2;
- 
-           END CASE_K;
- 
-      END;
- 
-      RESULT;
- 
- END C43205K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43206a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43206a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43206a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,242 ****
- -- C43206A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED
- -- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK
- -- THAT:
- 
- --   A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF
- --      THE LOWER BOUND.
- 
- --   B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE
- --      INDEX SUBTYPE FOR NULL RANGES.
- 
- --   C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL
- --      BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS 
- --      RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE
- --      INDEX SUBTYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- EG  02/02/84
- -- JBG 12/6/84
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT;
- 
- PROCEDURE C43206A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " &
-                      "DETERMINED BY THE BOUNDS SPECIFIED BY THE " &
-                      "CHOICES");
- 
-      DECLARE
- 
-           SUBTYPE ST1 IS INTEGER RANGE 10 .. 15;
-           SUBTYPE ST2 IS INTEGER RANGE 1 .. 5;
- 
-           TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER;
-           TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER;
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
-      CASE_A1 : DECLARE
- 
-                     PROCEDURE PROC1 (A : T1) IS
-                     BEGIN
-                          IF A'FIRST /= 12 OR A'LAST /= 10 THEN
-                               FAILED ("CASE A1 : INCORRECT BOUNDS");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                     PROC1((12 .. 10 => -2));
- 
-                EXCEPTION
- 
-                     WHEN OTHERS =>
-                          FAILED ("CASE A1 : EXCEPTION RAISED");
- 
-                END CASE_A1;
- 
-      CASE_A2 : DECLARE
- 
-                     PROCEDURE PROC1 (A : STRING) IS
-                     BEGIN
-                          IF A'FIRST /= 5 OR A'LAST /= 2 THEN
-                               FAILED ("CASE A2 : INCORRECT BOUNDS");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                     PROC1 ((5 .. 2 => 'E'));
- 
-                EXCEPTION
- 
-                     WHEN OTHERS =>
-                          FAILED ("CASE A2 : EXCEPTION RAISED");
- 
-                END CASE_A2;
- 
-           END CASE_A;
- 
- CASE_B :  BEGIN
- 
-      CASE_B1 : DECLARE
- 
-                     PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS
-                     BEGIN
-                          IF A'FIRST /= L OR A'LAST /= U THEN
-                               FAILED ("CASE B1 : INCORRECT BOUNDS");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                     BEGIN
- 
-                          PROC1 ((5 .. INTEGER'FIRST => -2),
-                                  5, INTEGER'FIRST);
- 
-                     EXCEPTION
- 
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED ("CASE B1A : CONSTRAINT_ERROR " &
-                                       "RAISED FOR NULL RANGE");
-                          WHEN OTHERS =>
-                               FAILED ("CASE B1A : EXCEPTION RAISED");
- 
-                     END;
- 
-                     BEGIN
- 
-                          PROC1 ((IDENT_INT(6) .. 3 => -2),6,3);
- 
-                     EXCEPTION
- 
-                          WHEN OTHERS =>
-                               FAILED ("CASE B1B : EXCEPTION RAISED");
- 
-                     END;
- 
-                END CASE_B1;
- 
-      CASE_B2 : DECLARE
- 
-                     PROCEDURE PROC1 (A : STRING) IS
-                     BEGIN
-                          IF A'FIRST /= 1 OR 
-                             A'LAST /= INTEGER'FIRST THEN
-                               FAILED ("CASE B2 : INCORRECT BOUNDS");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                     PROC1 ((1 .. INTEGER'FIRST => ' '));
- 
-                EXCEPTION
- 
-                     WHEN OTHERS =>
-                          FAILED ("CASE B2 : EXCEPTION RAISED");
- 
-                END CASE_B2;
- 
-           END CASE_B;
- 
- CASE_C :  BEGIN
- 
-      CASE_C1 : DECLARE
- 
-                     PROCEDURE PROC1 (A : T2) IS
-                     BEGIN
-                          IF A'FIRST(1) /=  5 OR A'LAST(1) /=  3 OR
-                             A'FIRST(2) /= INTEGER'LAST-1 OR
-                             A'LAST(2)  /= INTEGER'LAST THEN
-                               FAILED ("CASE C1 : INCORRECT BOUNDS");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                     PROC1 ((5 .. 3 => 
-                               (IDENT_INT(INTEGER'LAST-1) ..
-                                IDENT_INT(INTEGER'LAST) => -2)));
-                     FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED");
- 
-                EXCEPTION
- 
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
- 
-                     WHEN OTHERS =>
-                          FAILED ("CASE C1 : EXCEPTION RAISED");
- 
-                END CASE_C1;
- 
-      CASE_C2 : DECLARE
- 
-                     PROCEDURE PROC1 (A : T2) IS
-                     BEGIN
-                          IF A'FIRST(1) /=  INTEGER'FIRST OR
-                             A'LAST(1)  /=  INTEGER'FIRST+1 OR
-                             A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN
-                               FAILED ("CASE C2 : INCORRECT BOUNDS");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                     PROC1 ((IDENT_INT(INTEGER'FIRST) ..
-                             IDENT_INT(INTEGER'FIRST+1) =>
-                                     (14 .. IDENT_INT(11) => -2)));
-                     FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED");
- 
-                EXCEPTION
- 
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
- 
-                     WHEN OTHERS =>
-                          FAILED ("CASE C2 : EXCEPTION RAISED");
- 
-                END CASE_C2;
- 
-           END CASE_C;
- 
-      END;
- 
-      RESULT;
- 
- END C43206A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43207b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43207b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43207b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- C43207B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
- -- CHECK THAT:
- 
- --     B) IF H..I IS A NULL RANGE, CONSTRAINT_ERROR IS RAISED IF
- --        F..G IS NON-NULL AND F OR G DO NOT BELONG TO THE INDEX
- --        SUBTYPE;
- 
- -- EG  01/18/84
- -- BHS  7/13/84
- -- JBG 12/6/84
- 
- WITH REPORT;
- 
- PROCEDURE C43207B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43207B", "CHECK THAT THE EVALUATION OF A MULTI" &
-                      "DIMENSIONAL AGGREGATE OF THE FORM "   &
-                      "(F..G => (H..I = J)) IS PERFORMED "   &
-                      "CORRECTLY");
- 
-      DECLARE
- 
-           TYPE CHOICE_INDEX IS (F, G, H, I, J);
-           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
- 
-           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
- 
-           SUBTYPE SINT IS INTEGER RANGE 1 .. 8;
-           TYPE T0 IS ARRAY(SINT RANGE <>, SINT RANGE <>) OF INTEGER;
-    
-           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
-                          RETURN INTEGER IS
-           BEGIN
-                CNTR(A) := CNTR(A) + 1;
-                RETURN IDENT_INT(B);
-           END CALC;
- 
-      BEGIN
- 
- CASE_B :  DECLARE
-                PROCEDURE CHECK (A : T0; M : STRING) IS
-                BEGIN
-                     IF (A'FIRST(1) /= 1) OR (A'LAST(1) /= 9) OR
-                        (A'FIRST(2) /= 6) OR (A'LAST(2) /= 5) THEN
-                          FAILED("CASE B" & M & " : ARRAY NOT " &
-                                 "BOUNDED CORRECTLY");
-                     END IF;
-                END CHECK;
-           BEGIN
- 
-      CASE_B1 : BEGIN
-                     CHECK ((1 .. 9 => (6 .. 5 => 2)),"1");
-                     FAILED ("CASE B1 : CONSTRAINT_ERROR NOT RAISED");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("CASE B1 : EXCEPTION RAISED");
-                END CASE_B1;
- 
-      CASE_B2 : BEGIN
-                     CHECK ((CALC(F,1) .. CALC(G,9) => (6 .. 5 => 2)),
-                            "2");
-                     FAILED ("CASE B2 : CONSTRAINT_ERROR NOT RAISED");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("CASE B2 : EXCEPTION RAISED");
-                END CASE_B2;
- 
-      CASE_B3 : BEGIN
-                     CHECK ((1 .. 9 => (CALC(H,6) .. CALC(I,5) => 2)),
-                            "3");
-                     FAILED ("CASE B3 : CONSTRAINT_ERROR NOT RAISED");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("CASE B3 : EXCEPTION RAISED");
-                END CASE_B3;
- 
-           END CASE_B;
- 
-      IF CNTR(F) /= 1 THEN
-           FAILED ("CASE B2 : F WAS NOT EVALUATED " &
-                   "ONCE.  F WAS EVALUATED"         & 
-                   INTEGER'IMAGE(CNTR(F)) & " TIMES");
-      END IF;
-      IF CNTR(G) /= 1 THEN
-           FAILED ("CASE B2 : G WAS NOT EVALUATED " &
-                   "ONCE.  G WAS EVALUATED"         &
-                   INTEGER'IMAGE(CNTR(G)) & " TIMES");
-      END IF;
- 
-      IF CNTR(H) /= 0 AND CNTR(I) /= 0 THEN
-           COMMENT ("CASE B3 : ALL CHOICES " &
-                    "EVALUATED BEFORE CHECKING " &
-                    "INDEX SUBTYPE");
-      ELSIF CNTR(H) = 0 AND CNTR(I) = 0 THEN
-           COMMENT ("CASE B3 : SUBTYPE CHECKS "&
-                    "MADE AS CHOICES ARE EVALUATED");
-      END IF;
-                               
-      IF CNTR(H) > 1 THEN
-           FAILED("CASE B3 : H WAS NOT EVALUATED " &
-                  "AT MOST ONCE. H WAS EVALUATED" &
-                  INTEGER'IMAGE(CNTR(H)) & " TIMES");
-      END IF;
- 
-      IF CNTR(I) > 1 THEN
-           FAILED("CASE B3 : I WAS NOT EVALUATED " &
-                  "AT MOST ONCE. I WAS EVALUATED" &
-                  INTEGER'IMAGE(CNTR(I)) & " TIMES");
-      END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C43207B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43207d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43207d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43207d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43207d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- C43207D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
- -- CHECK THAT:
- 
- --     D) J IS EVALUATED ONCE FOR EACH COMPONENT (ZERO TIMES IF THE
- --        ARRAY IS NULL).
- 
- -- EG  01/18/84
- 
- WITH REPORT;
- 
- PROCEDURE C43207D IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43207D", "CHECK THAT THE EVALUATION OF A MULTI" &
-                      "DIMENSIONAL AGGREGATE OF THE FORM "   &
-                      "(F..G => (H..I = J)) IS PERFORMED "   &
-                      "CORRECTLY");
- 
-      DECLARE
- 
-           TYPE CHOICE_INDEX IS (F, G, H, I, J);
-           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
- 
-           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
- 
-           SUBTYPE SINT IS INTEGER RANGE 1 .. 8;
-           TYPE T0 IS ARRAY(SINT RANGE <>, SINT RANGE <>) OF INTEGER;
-    
-           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
-                          RETURN INTEGER IS
-           BEGIN
-                CNTR(A) := CNTR(A) + 1;
-                RETURN IDENT_INT(B);
-           END CALC;
- 
-      BEGIN
- 
- CASE_D :  BEGIN
- 
-      CASE_D1 : DECLARE
-                     D1 : T0(8 .. 4, 5 .. 1);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     D1 := (8 .. 4 => (5 .. 1 => CALC(J,2)));
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE D1 : INCORRECT NUMBER " &
-                                 "OF EVALUATIONS. J EVALUATED" &
-                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE D1 : EXCEPTION RAISED");
-                END CASE_D1;
- 
-      CASE_D2 : DECLARE
-                     D2 : T0(8 .. 4, 5 .. 1);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     D2 := (CALC(F,8) .. CALC(G,4) =>
-                               (CALC(H,5) .. CALC(I,1) => CALC(J,2)));
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE D2 : INCORRECT NUMBER " &
-                                 "OF EVALUATIONS. J EVALUATED" &
-                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE D2 : EXCEPTION RAISED");
-                END CASE_D2;
- 
-      CASE_D3 : DECLARE
-                     D3 : T0(3 .. 5, 1 .. 2);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     D3 := (3 .. 5 => (1 .. 2 => CALC(J,2)));
-                     IF CNTR(J) /= 6 THEN
-                          FAILED("CASE D3 : INCORRECT NUMBER " &
-                                 "OF EVALUATIONS. J EVALUATED" &
-                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE D3 : EXCEPTION RAISED");
-                END CASE_D3;
- 
-      CASE_D4 : DECLARE
-                     D4 : T0(1 .. 2, 5 .. 7);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     D4 := (CALC(F,1) .. CALC(G,2) =>
-                               (CALC(H,5) .. CALC(I,7) => CALC(J,2)));
-                     IF CNTR(J) /= 6 THEN
-                          FAILED("CASE D4 : INCORRECT NUMBER " &
-                                 "OF EVALUATIONS. J EVALUATED" &
-                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE D4 : EXCEPTION RAISED");
-                END CASE_D4;
- 
-           END CASE_D;
- 
-      END;
- 
-      RESULT;
- 
- END C43207D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43208a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43208a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43208a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43208a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,208 ****
- -- C43208A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A ONE-DIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
- -- CHECK THAT:
- 
- --     A) IF F..G IS A NULL RANGE, H, I, AND J ARE NOT EVALUATED.
- 
- --     B) IF F..G IS A NON-NULL RANGE, H AND I ARE EVALUATED G-F+1
- --        TIMES, AND J IS EVALUATED (I-H+1)*(G-F+1) TIMES IF H..I
- --        IS NON-NULL.
- 
- -- EG  01/19/84
- 
- WITH REPORT;
- 
- PROCEDURE C43208A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43208A", "CHECK THAT THE EVALUATION OF A ONE-" &
-                      "DIMENSIONAL AGGREGATE OF THE FORM "  &
-                      "(F..G => (H..I = J)) IS PERFORMED "  &
-                      "CORRECTLY");
- 
-      DECLARE
- 
-           TYPE CHOICE_INDEX IS (F, G, H, I, J);
-           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
- 
-           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
- 
-           TYPE T1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-    
-           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
-                          RETURN INTEGER IS
-           BEGIN
-                CNTR(A) := CNTR(A) + 1;
-                RETURN IDENT_INT(B);
-           END CALC;
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
-      CASE_A1 : DECLARE
-                     A1 : ARRAY(4 .. 2) OF T1(1 .. 2);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     A1 := (4 .. 2 => 
-                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
-                     IF CNTR(H) /= 0 THEN
-                          FAILED("CASE A1 : H WAS EVALUATED");
-                     END IF;
-                     IF CNTR(I) /= 0 THEN
-                          FAILED("CASE A1 : I WAS EVALUATED");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE A1 : J WAS EVALUATED");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE A1 : EXCEPTION RAISED");
-                END CASE_A1;
- 
-      CASE_A2 : DECLARE
-                     A2 : ARRAY(4 .. 2) OF T1(1 .. 2);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     A2 := (CALC(F,4) .. CALC(G,2) =>
-                                (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
-                     IF CNTR(H) /= 0 THEN
-                          FAILED("CASE A2 : H WAS EVALUATED");
-                     END IF;
-                     IF CNTR(I) /= 0 THEN
-                          FAILED("CASE A2 : I WAS EVALUATED");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE A2 : J WAS EVALUATED");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE A2 : EXCEPTION RAISED");
-                END CASE_A2;
- 
-           END CASE_A;
- 
- CASE_B :  BEGIN
- 
-      CASE_B1 : DECLARE
-                     B1 : ARRAY(2 .. 3) OF T1(1 .. 2);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B1 := (2 .. 3 =>
-                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
-                     IF CNTR(H) /= 2 THEN
-                          FAILED("CASE B1 : H NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(I) /= 2 THEN
-                          FAILED("CASE B1 : I NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(J) /= 4 THEN
-                          FAILED("CASE B1 : J NOT EVALUATED (I-H+1)*" &
-                                 "(G-F+1) TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B1 : EXECEPTION RAISED");
-                END CASE_B1;
- 
-      CASE_B2 : DECLARE
-                     B2 : ARRAY(2 .. 3) OF T1(9 .. 10);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B2 := (CALC(F,2) .. CALC(G,3) =>
-                               (CALC(H,9) .. CALC(I,10) => CALC(J,2)));
-                     IF CNTR(H) /= 2 THEN
-                          FAILED("CASE B2 : H NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(I) /= 2 THEN
-                          FAILED("CASE B2 : I NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(J) /= 4 THEN
-                          FAILED("CASE B2 : J NOT EVALUATED (I-H+1)*" &
-                                 "(G-F+1) TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B2 : EXECEPTION RAISED");
-                END CASE_B2;
- 
-      CASE_B3 : DECLARE
-                     B3 : ARRAY(2 .. 3) OF T1(2 .. 1);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B3 := (2 .. 3 =>
-                               (CALC(H,2) .. CALC(I,1) => CALC(J,2)));
-                     IF CNTR(H) /= 2 THEN
-                          FAILED("CASE B3 : H NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(I) /= 2 THEN
-                          FAILED("CASE B3 : I NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B3 : EXECEPTION RAISED");
-                END CASE_B3;
- 
-      CASE_B4 : DECLARE
-                     B4 : ARRAY(2 .. 3) OF T1(2 .. 1);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B4 := (CALC(F,2) .. CALC(G,3) =>
-                               (CALC(H,2) .. CALC(I,1) => CALC(J,2)));
-                     IF CNTR(H) /= 2 THEN
-                          FAILED("CASE B4 : H NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(I) /= 2 THEN
-                          FAILED("CASE B4 : I NOT EVALUATED G-F+1 " &
-                                 "TIMES");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B4 : EXECEPTION RAISED");
-                END CASE_B4;
- 
-           END CASE_B;
-       END;
- 
-      RESULT;
- 
- END C43208A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43208b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43208b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43208b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43208b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- C43208B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR AN AGGREGATE OF THE FORM:
- --        (B..C => (D..E => (F..G => (H..I => J))))
- -- WHOSE TYPE IS A TWO-DIMENSIONAL ARRAY TYPE THAT HAS A TWO-
- -- DIMENSIONAL ARRAY COMPONENT TYPE, CHECK THAT:
- 
- --     A) IF B..C OR D..E IS A NULL RANGE, THEN F, G, H, I, AND J
- --        ARE NOT EVALUATED.
- 
- --     B) IF B..C AND D..E ARE NON-NULL RANGES, THEN F, G, H AND I
- --        ARE EVALUATED (C-B+1)*(E-D+1) TIMES, AND J IS EVALUATED
- --        (C-B+1)*(E-D+1)*(G-F+1)*(I-H+1) TIMES IF F..G AND H..I
- --        ARE NON-NULL.
- 
- -- EG  01/19/84
- 
- WITH REPORT;
- 
- PROCEDURE C43208B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43208B", "CHECK THAT THE EVALUATION OF A MULTI" &
-                      "DIMENSIONAL ARRAY TYPE THAT HAS AN "  &
-                      "ARRAY COMPONENT TYPE IS PERFORMED "   &
-                      "CORRECTLY");
- 
-      DECLARE
- 
-           TYPE CHOICE_INDEX IS (B, C, D, E, F, G, H, I, J);
-           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
- 
-           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
- 
-           TYPE T1 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
-                           OF INTEGER;
-    
-           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
-                          RETURN INTEGER IS
-           BEGIN
-                CNTR(A) := CNTR(A) + 1;
-                RETURN IDENT_INT(B);
-           END CALC;
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
-      CASE_A1 : DECLARE
-                     A1 : ARRAY(4 .. 3, 3 .. 4) OF T1(2 .. 3, 1 .. 2);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     A1 := (4 .. 3 => (3 .. 4 => 
-                             (CALC(F,2) .. CALC(G,3) =>
-                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
-                     IF CNTR(F) /= 0 THEN
-                          FAILED("CASE A1 : F WAS EVALUATED");
-                     END IF;
-                     IF CNTR(G) /= 0 THEN
-                          FAILED("CASE A1 : G WAS EVALUATED");
-                     END IF;
-                     IF CNTR(H) /= 0 THEN
-                          FAILED("CASE A1 : H WAS EVALUATED");
-                     END IF;
-                     IF CNTR(I) /= 0 THEN
-                          FAILED("CASE A1 : I WAS EVALUATED");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE A1 : J WAS EVALUATED");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE A1 : EXCEPTION RAISED");
-                END CASE_A1;
- 
-      CASE_A2 : DECLARE
-                     A2 : ARRAY(3 .. 4, 4 .. 3) OF T1(2 .. 3, 1 .. 2);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     A2 := (CALC(B,3) .. CALC(C,4) =>
-                            (CALC(D,4) .. CALC(E,3) =>
-                             (CALC(F,2) .. CALC(G,3) =>
-                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
-                     IF CNTR(F) /= 0 THEN
-                          FAILED("CASE A2 : F WAS EVALUATED");
-                     END IF;
-                     IF CNTR(G) /= 0 THEN
-                          FAILED("CASE A2 : G WAS EVALUATED");
-                     END IF;
-                     IF CNTR(H) /= 0 THEN
-                          FAILED("CASE A2 : H WAS EVALUATED");
-                     END IF;
-                     IF CNTR(I) /= 0 THEN
-                          FAILED("CASE A2 : I WAS EVALUATED");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE A2 : J WAS EVALUATED");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE A2 : EXCEPTION RAISED");
-                END CASE_A2;
- 
-           END CASE_A;
- 
- CASE_B :  BEGIN
- 
-      CASE_B1 : DECLARE
-                     B1 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B1 := (2 .. 3 => (1 .. 2 =>
-                             (CALC(F,1) .. CALC(G,2) =>
-                               (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
-                     IF CNTR(F) /= 4 THEN
-                          FAILED("CASE B1 : F NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(G) /= 4 THEN
-                          FAILED("CASE B1 : G NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(H) /= 4 THEN
-                          FAILED("CASE B1 : H NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(I) /= 4 THEN
-                          FAILED("CASE B1 : I NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(J) /= 16 THEN
-                          FAILED("CASE B1 : J NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B1 : EXECEPTION RAISED");
-                END CASE_B1;
- 
-      CASE_B2 : DECLARE
-                     B2 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B2 := (CALC(B,2) .. CALC(C,3) =>
-                            (CALC(D,1) .. CALC(E,2) =>
-                             (CALC(F,1) .. CALC(G,2) =>
-                              (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
-                     IF CNTR(F) /= 4 THEN
-                          FAILED("CASE B2 : F NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(G) /= 4 THEN
-                          FAILED("CASE B2 : G NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(H) /= 4 THEN
-                          FAILED("CASE B2 : H NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(I) /= 4 THEN
-                          FAILED("CASE B2 : I NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(J) /= 16 THEN
-                          FAILED("CASE B2 : J NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B2 : EXECEPTION RAISED");
-                END CASE_B2;
- 
-      CASE_B3 : DECLARE
-                     B3 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 2 .. 1);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B3 := (2 .. 3 => (1 .. 2 =>
-                             (CALC(F,1) .. CALC(G,2) =>
-                               (CALC(H,2) .. CALC(I,1) => CALC(J,2)))));
-                     IF CNTR(F) /= 4 THEN
-                          FAILED("CASE B3 : F NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(G) /= 4 THEN
-                          FAILED("CASE B3 : G NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(H) /= 4 THEN
-                          FAILED("CASE B3 : H NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(I) /= 4 THEN
-                          FAILED("CASE B3 : I NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B3 : EXECEPTION RAISED");
-                END CASE_B3;
- 
-      CASE_B4 : DECLARE
-                     B4 : ARRAY(2 .. 3, 1 .. 2) OF T1(2 .. 1, 1 .. 2);
-                BEGIN
-                     CNTR := (CHOICE_INDEX => 0);
-                     B4 := (CALC(B,2) .. CALC(C,3) =>
-                            (CALC(D,1) .. CALC(E,2) =>
-                             (CALC(F,2) .. CALC(G,1) =>
-                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
-                     IF CNTR(F) /= 4 THEN
-                          FAILED("CASE B4 : F NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(G) /= 4 THEN
-                          FAILED("CASE B4 : G NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(H) /= 4 THEN
-                          FAILED("CASE B4 : H NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(I) /= 4 THEN
-                          FAILED("CASE B4 : I NOT EVALUATED (C-B+1)*" &
-                                 "(E-D+1) TIMES");
-                     END IF;
-                     IF CNTR(J) /= 0 THEN
-                          FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED("CASE B4 : EXECEPTION RAISED");
-                END CASE_B4;
- 
-           END CASE_B;
-       END;
- 
-      RESULT;
- 
- END C43208B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43209a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43209a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43209a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43209a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- C43209A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A STRING LITERAL IS ALLOWED IN A MULTIDIMENSIONAL
- --     ARRAY AGGREGATE AT THE PLACE OF A ONE DIMENSIONAL ARRAY OF
- --     CHARACTER TYPE.
- 
- -- HISTORY:
- --     DHH 08/12/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43209A IS
- 
-      TYPE MULTI_ARRAY IS ARRAY(1 .. 2, 1 .. 3, 1 .. 6) OF CHARACTER;
- 
- BEGIN
-      TEST("C43209A", "CHECK THAT A STRING LITERAL IS ALLOWED IN A " &
-                      "MULTIDIMENSIONAL ARRAY AGGREGATE AT THE PLACE " &
-                      "OF A ONE DIMENSIONAL ARRAY OF CHARACTER TYPE");
- 
-      DECLARE
-           X : MULTI_ARRAY := ((('A', 'B', 'C', 'D', 'E', 'F'),
-                               ('G', 'H', 'I', 'J', 'K', 'L'),
-                               ('M', 'N', 'O', 'P', 'Q', 'R')),
-                               (('S', 'T', 'U', 'V', 'W', 'X'),
-                               ('W', 'Z', 'A', 'B', 'C', 'D'),
-                               "WHOZAT"));
- 
-           Y : MULTI_ARRAY := (("WHOZAT",
-                               ('A', 'B', 'C', 'D', 'E', 'F'),
-                               ('G', 'H', 'I', 'J', 'K', 'L')),
-                               (('M', 'N', 'O', 'P', 'Q', 'R'),
-                               ('S', 'T', 'U', 'V', 'W', 'X'),
-                               ('W', 'Z', 'A', 'B', 'C', 'D')));
- 
-      BEGIN
-           IF X(IDENT_INT(2), IDENT_INT(3), IDENT_INT(6)) /=
-                   Y(IDENT_INT(1), IDENT_INT(1), IDENT_INT(6)) THEN
-                FAILED("INITIALIZATION FAILURE");
-           END IF;
-      END;
- 
-      DECLARE
-           PROCEDURE FIX_AGG(T : MULTI_ARRAY) IS
-           BEGIN
-                IF T(IDENT_INT(2), IDENT_INT(2), IDENT_INT(5)) /=
-                        T(IDENT_INT(1), IDENT_INT(1), IDENT_INT(1)) THEN
-                     FAILED("SUBPROGRAM FAILURE");
-                END IF;
-           END;
-      BEGIN
-           FIX_AGG((("WHOZAT", ('A', 'B', 'C', 'D', 'E', 'F'),
-                               ('G', 'H', 'I', 'J', 'K', 'L')),
-                               (('M', 'N', 'O', 'P', 'Q', 'R'),
-                               ('S', 'T', 'U', 'V', 'W', 'X'),
-                               ('W', 'Z', 'A', 'B', 'C', 'D'))));
- 
-      END;
- 
-      DECLARE
- 
-           Y : CONSTANT MULTI_ARRAY := (("WHOZAT",
-                               ('A', 'B', 'C', 'D', 'E', 'F'),
-                               ('G', 'H', 'I', 'J', 'K', 'L')),
-                               (('M', 'N', 'O', 'P', 'Q', 'R'),
-                               ('S', 'T', 'U', 'V', 'W', 'X'),
-                               ('W', 'Z', 'A', 'B', 'C', 'D')));
- 
-      BEGIN
-           IF Y(IDENT_INT(2), IDENT_INT(2), IDENT_INT(5)) /=
-              Y(IDENT_INT(1), IDENT_INT(1), IDENT_INT(1)) THEN
-                FAILED("CONSTANT FAILURE");
-           END IF;
-      END;
- 
-      DECLARE
-      BEGIN
-           IF MULTI_ARRAY'((1 =>(('A', 'B', 'C', 'D', 'E', 'F'),
-                ('G', 'H', 'I', 'J', 'K', 'L'),
-                ('M', 'N', 'O', 'P', 'Q', 'R')),
-               2 => (('S', 'T', 'U', 'V', 'W', 'X'),
-                ('W', 'Z', 'A', 'B', 'C', 'D'),
-                "WHOZAT"))) = MULTI_ARRAY'((1 =>(1 =>"WHOZAT",
-                              2 =>('A', 'B', 'C', 'D', 'E', 'F'),
-                              3 =>('G', 'H', 'I', 'J', 'K', 'L')),
-                             2 => (1 =>('M', 'N', 'O', 'P', 'Q', 'R'),
-                              2 =>('S', 'T', 'U', 'V', 'W', 'X'),
-                              3 => ('W', 'Z', 'A', 'B', 'C', 'D')))) THEN
-                FAILED("EQUALITY OPERATOR FAILURE");
-           END IF;
-      END;
- 
-      DECLARE
-           SUBTYPE SM IS INTEGER RANGE 1 .. 10;
-           TYPE UNCONSTR IS ARRAY(SM RANGE <>, SM RANGE<>) OF CHARACTER;
- 
-           FUNCTION FUNC(X : SM) RETURN UNCONSTR IS
-           BEGIN
-                IF EQUAL(X,X) THEN
-                     RETURN (1 => "WHEN", 2 => "WHAT");
-                ELSE
-                     RETURN ("    ", "    ");
-                END IF;
-           END FUNC;
- 
-      BEGIN
-           IF FUNC(1) /= FUNC(2) THEN
-                FAILED("UNCONSTRAINED FUNCTION RETURN FAILURE");
-           END IF;
-      END;
- 
-      RESULT;
- END C43209A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43210a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43210a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43210a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C43210A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A NON-AGGREGATE EXPRESSION IN A NAMED COMPONENT
- -- ASSOCIATION IS EVALUATED ONCE FOR EACH COMPONENT SPECIFIED
- -- BY THE ASSOCIATION.
- 
- -- EG  02/02/84
- 
- WITH REPORT;
- 
- PROCEDURE C43210A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43210A", "CHECK THAT A NON-AGGREGATE IN A NAMED "   &
-                      "COMPONENT ASSOCIATION IS EVALUATED ONCE " &
-                      "FOR EACH COMPONENT SPECIFIED BY THE "     &
-                      "ASSOCIATION");
- 
-      DECLARE
- 
-           TYPE T1 IS ARRAY(1 .. 10) OF INTEGER;
-           TYPE T2 IS ARRAY(1 .. 8, 1 .. 2) OF INTEGER;
-           TYPE T3 IS ARRAY(1 .. 2, 1 .. 8) OF INTEGER;
-           TYPE T4 IS ARRAY(1 .. 8, 1 .. 8) OF INTEGER;
- 
-           A1 : T1;
-           A2 : T2;
-           A3 : T3;
-           A4 : T4;
-           CC : INTEGER;
- 
-           FUNCTION CALC (A : INTEGER) RETURN INTEGER IS
-           BEGIN
-                CC := CC + 1;
-                RETURN IDENT_INT(A);
-           END CALC;
- 
-           PROCEDURE CHECK (A : STRING; B : INTEGER) IS
-           BEGIN
-                IF CC /= B THEN
-                     FAILED ("CASE " & A & " : INCORRECT NUMBER OF " &
-                             "EVALUATIONS. NUMBER OF EVALUATIONS "   &
-                             "SHOULD BE " & INTEGER'IMAGE(B) & 
-                             ", BUT IS " & INTEGER'IMAGE(CC));
-                END IF;
-           END CHECK;
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
-                CC := 0;
-                A1 := T1'(4 .. 5 => CALC(2), 6 .. 8 => CALC(4),
-                          OTHERS => 5);
-                CHECK ("A", 5);
- 
-           END CASE_A;
- 
- CASE_B :  BEGIN
- 
-                CC := 0;
-                A1 := T1'(1 | 4 .. 6 | 3 | 2 => CALC(-1), OTHERS => -2);
-                CHECK ("B", 6);
- 
-           END CASE_B;
- 
- CASE_C :  BEGIN
- 
-                CC := 0;
-                A1 := T1'(1 | 3 | 5 | 7 .. 9 => -1, OTHERS => CALC(-2));
-                CHECK ("C", 4);
- 
-           END CASE_C;
- 
- CASE_D :  BEGIN
- 
-                CC := 0;
-                A2 := T2'(4 .. 6 | 8 | 2 .. 3 => (1 .. 2 => CALC(1)),
-                          OTHERS => (1 .. 2 => -1));
-                CHECK ("D", 12);
- 
-           END CASE_D;
- 
- CASE_E : BEGIN
- 
-                CC := 0;
-                A3 := T3'(1 .. 2 => (2 | 4 | 6 .. 8 => CALC(-1),
-                                     OTHERS => -2));
-                CHECK ("E", 10);
- 
-           END CASE_E;
- 
- CASE_F :  BEGIN
- 
-                CC := 0;
-                A4 := T4'(7 .. 8 | 3 .. 5 => 
-                           (1 | 2 | 4 | 6 .. 8 => CALC(1), OTHERS => -2),
-                          OTHERS => (OTHERS => -2));
-                CHECK ("F", 30);
- 
-           END CASE_F;
- 
- CASE_G :  BEGIN
- 
-                CC := 0;
-                A4 := T4'(5 .. 8 | 3 | 1 => (7 | 1 .. 5 | 8 => -1,
-                                             OTHERS => CALC(-2)),
-                          OTHERS => (OTHERS => CALC(-2)));
-                CHECK ("G", 22);
- 
-           END CASE_G;
- 
-      END;
- 
-      RESULT;
- 
- END C43210A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43211a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43211a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43211a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C43211A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF A BOUND IN A NON-NULL
- -- RANGE OF A NON-NULL AGGREGATE DOES NOT BELONG TO THE INDEX SUBTYPE.
- 
- -- EG  02/06/84
- -- EG  05/08/85
- -- EDS 07/15/98    AVOID OPTIMIZATION
- 
- WITH REPORT;
- 
- PROCEDURE C43211A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43211A","CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
-                     "BOUND IN A NON-NULL RANGE OF A NON-NULL "    &
-                     "AGGREGATE DOES NOT BELONG TO THE INDEX "     &
-                     "SUBTYPE");
- 
-      DECLARE
- 
-           SUBTYPE ST IS INTEGER RANGE 4 .. 8;
-           TYPE BASE IS ARRAY(ST RANGE <>, ST RANGE <>) OF INTEGER;
-           SUBTYPE T IS BASE(5 .. 7, 5 .. 7);
- 
-           A    : T;
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
-                A := (6 .. 8 => (4 .. 6 => 0));
-                IF A /= (6 .. 8 => (4 .. 6 => 0)) THEN
-                     FAILED ("CASE A : INCORRECT VALUES");
-                END IF;
- 
-           EXCEPTION
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED: CASE A");
- 
-           END CASE_A;
- 
- CASE_B :  BEGIN
- 
-                A := (6 .. IDENT_INT(8) =>
-                      (IDENT_INT(4) .. 6 => 1));
-                IF A /= (6 .. IDENT_INT(8) =>
-                         (IDENT_INT(4) .. 6 => 1)) THEN
-                     FAILED ("CASE B : INCORRECT VALUES");
-                END IF;
- 
-           EXCEPTION
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED: CASE B");
- 
-           END CASE_B;
- 
- CASE_C :  BEGIN
- 
-                A := (7 .. 9 => (5 .. 7 => IDENT_INT(2)));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE C " & 
-                 INTEGER'IMAGE(A(IDENT_INT(7),7)));
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED: CASE C");
- 
-           END CASE_C;
- 
- CASE_D :  BEGIN
- 
-                A := (5 .. 7 => (3 .. 5 => IDENT_INT(3)));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE D " &
-                 INTEGER'IMAGE(A(7,IDENT_INT(5))));
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED: CASE D");
- 
-           END CASE_D;
- 
- CASE_E :  BEGIN
- 
-                A := (7 .. IDENT_INT(9) => (5 .. 7 => IDENT_INT(4)));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE E " &
-                 INTEGER'IMAGE(A(IDENT_INT(7),7)));
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE E : EXCEPTION RAISED");
- 
-           END CASE_E;
- 
- CASE_F :  BEGIN
- 
-                A := (5 .. 7 => (IDENT_INT(3) .. 5 => IDENT_INT(5)));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE F " &
-                 INTEGER'IMAGE(A(7,IDENT_INT(5))));
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED: CASE F");
- 
-           END CASE_F;
- 
- CASE_G :  BEGIN
- 
-                A := (7 .. 8 => (5 .. 7 => IDENT_INT(6)),
-               9 => (5 .. 7 => IDENT_INT(6)));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE G " &
-                 INTEGER'IMAGE(A(7,IDENT_INT(7))));
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED: CASE G");
- 
-           END CASE_G;
- 
-      END;
- 
-      RESULT;
- 
- END C43211A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43212a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43212a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43212a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43212a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,154 ****
- -- C43212A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL SUBAGGREGATES FOR A
- -- PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS.
- 
- -- EG  02/06/1984
- -- JBG 3/30/84
- -- JRK 4/18/86   CORRECTED ERROR TO ALLOW CONSTRAINT_ERROR TO BE
- --               RAISED EARLIER.
- -- EDS 7/15/98   AVOID OPTIMIZATION.
- 
- WITH REPORT;
- 
- PROCEDURE C43212A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C43212A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " &
-                       "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO "  &
-                       "NOT HAVE THE SAME BOUNDS");
- 
-      DECLARE
- 
-           TYPE CHOICE_INDEX IS (H, I);
-           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
- 
-           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
- 
-           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
-                                              RETURN INTEGER IS
-           BEGIN
-                CNTR(A) := CNTR(A) + 1;
-                RETURN IDENT_INT(B);
-           END CALC;
- 
-      BEGIN
- 
- CASE_1 :  DECLARE
- 
-                TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
-                                                    OF INTEGER;
- 
-                A1 : T(1 .. 3, 2 .. 5) := (OTHERS => (OTHERS => 0));
- 
-           BEGIN
- 
-                CNTR := (CHOICE_INDEX => 0);
-                A1 := (1 => (CALC(H,2) .. CALC(I,5) => -4),
-                       2 => (CALC(H,3) .. CALC(I,6) => -5),
-                       3 => (CALC(H,2) .. CALC(I,5) => -3));
-                FAILED ("CASE 1 : CONSTRAINT_ERROR NOT RAISED" &
-                        INTEGER'IMAGE(A1(1,5)) );
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     IF CNTR(H) < 2 AND CNTR(I) < 2 THEN
-                          FAILED ("CASE 1 : BOUNDS OF SUBAGGREGATES " &
-                                  "NOT DETERMINED INDEPENDENTLY");
-                     END IF;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE 1 : WRONG EXCEPTION RAISED");
- 
-           END CASE_1;
- 
- CASE_1A : DECLARE
- 
-                TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
-                                                   OF INTEGER;
- 
-                A1 : T(1 .. 3, 2 .. 3) := (1 .. 3 => (2 .. 3 => 1));
- 
-           BEGIN
- 
-                IF (1 .. 2 => (IDENT_INT(3) .. IDENT_INT(4) => 0),
-                         3 => (1, 2)) = A1 THEN
-                     BEGIN
-                          COMMENT(" IF SHOULD GENERATE CONSTRAINT_ERROR " & 
-                                  INTEGER'IMAGE(A1(1,2)) );
-                     EXCEPTION
-                          WHEN OTHERS =>
-                             FAILED ("CASE 1A : CONSTRAINT_ERROR NOT RAISED");
-                     END;
-                END IF;
-                     FAILED ("CASE 1A : CONSTRAINT_ERROR NOT RAISED");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE 1A : WRONG EXCEPTION RAISED");
- 
-           END CASE_1A;
- 
- CASE_2 :  DECLARE
- 
-                TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
-                                                    OF INTEGER;
- 
-                A2 : T(1 .. 3, IDENT_INT(4) .. 2);
- 
-           BEGIN
- 
-                CNTR := (CHOICE_INDEX => 0);
-                A2 := (1 => (CALC(H,5) .. CALC(I,3) => -4),
-                       3 => (CALC(H,4) .. CALC(I,2) => -5),
-                       2 => (CALC(H,4) .. CALC(I,2) => -3));
-                FAILED ("CASE 2 : CONSTRAINT_ERROR NOT RAISED " &
-                        INTEGER'IMAGE(IDENT_INT(A2'FIRST(1))));
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     IF CNTR(H) < 2 AND CNTR(I) < 2 THEN
-                          FAILED ("CASE 2 : BOUNDS OF SUBAGGREGATES " &
-                                  "NOT DETERMINED INDEPENDENTLY");
-                     END IF;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE 2 : WRONG EXCEPTION RAISED");
- 
-           END CASE_2;
- 
-      END;
- 
-      RESULT;
- 
- END C43212A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43212c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43212c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43212c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43212c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C43212C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL SUBAGGREGATES FOR
- -- A PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS.
- -- ADDITIONAL CASES FOR THE THIRD DIMENSION AND FOR THE NULL ARRAYS.
- 
- -- PK  02/21/84
- -- EG  05/30/84
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE C43212C IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 3;
- 
- BEGIN
- 
-      TEST("C43212C","CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " &
-                     "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO "  &
-                     "NOT HAVE THE SAME BOUNDS");
- 
-      DECLARE
-           TYPE A3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
-                          OF INTEGER;
-      BEGIN
-           IF A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
-                       (1 .. IDENT_INT(2) => IDENT_INT(1))),
-                      ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
-                       (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 
-             =
-              A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
-                       (1 .. IDENT_INT(2) => IDENT_INT(1))),
-                      ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
-                       (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 
-           THEN
-                 FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
-           END IF;
-           FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => 
-                FAILED ("A3 - WRONG EXCEPTION RAISED");
- 
-      END;
- 
-      DECLARE
- 
-           TYPE B3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
-                          OF INTEGER;
- 
-      BEGIN
- 
-           IF B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
-                       (2 .. IDENT_INT(1) => IDENT_INT(1))),
-                      ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
-                       (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 
-             =
-              B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
-                       (2 .. IDENT_INT(1) => IDENT_INT(1))),
-                      ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
-                       (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 
-           THEN
-                 FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
-           END IF;
-           FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS => 
-                 FAILED ("B3 - WRONG EXCEPTION RAISED");
- 
-      END;
- 
-      RESULT;
- 
- END C43212C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C43214A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => ""), CHECK
- -- THAT CONSTRAINT_ERROR IS RAISED IF F..G IS NON-NULL AND
- -- F OR G DO NOT BELONG TO THE INDEX SUBTYPE.
- 
- -- EG  02/10/1984
- -- JBG 12/6/84
- -- EDS 07/15/98     AVOID OPTIMIZATION
- 
- WITH REPORT;
- 
- PROCEDURE C43214A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43214A", "FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM " &
-                      "(F..G => """"), CHECK THAT CONSTRAINT ERROR "  &
-                      "IS RAISED IF F..G IS NON-NULL AND NOT IN THE " &
-                      "INDEX SUBTYPE");
- 
-      DECLARE
- 
-           SUBTYPE STA IS INTEGER RANGE 4 .. 7;
-           TYPE TA IS ARRAY(STA RANGE 5 .. 6, 
-                            STA RANGE 6 .. IDENT_INT(4)) OF CHARACTER;
- 
-           A : TA := (5 .. 6 => "");
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
-                IF (6 .. IDENT_INT(8) => "") = A THEN
-                     FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED");
-                END IF;
-                FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED - 2");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE A : WRONG EXCEPTION RAISED");
- 
-           END CASE_A;
- 
- CASE_B :  BEGIN
- 
-                A := (IDENT_INT(3) .. 4 => "");
-                FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED");
-                BEGIN
-                   FAILED("ATTEMPT TO USE A " &
-                          CHARACTER'VAL(IDENT_INT(CHARACTER'POS(
-                             A(A'FIRST(1), A'FIRST(2)) ))) );
-                EXCEPTION
-                   WHEN OTHERS =>
-                      FAILED("CONSTRAINT_ERROR NOT RAISED AT PROPER PLACE");
-                END;
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE B : WRONG EXCEPTION RAISED");
- 
-           END CASE_B;
- 
-      END;
- 
-      RESULT;
- 
- END C43214A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C43214B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
- -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
- 
- -- EG  02/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C43214B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43214B", "SUBPROGRAM WITH CONSTRAINED ARRAY FORMAL " &
-                      "PARAMETER");
- 
-      BEGIN
- 
- CASE_A :  BEGIN
- 
- --             COMMENT ("CASE A1 : SUBPROGRAM WITH CONSTRAINED " &
- --                      "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
- 
-      CASE_A1 : DECLARE
- 
-                     SUBTYPE STA1 IS STRING(IDENT_INT(11) .. 15);
- 
-                     PROCEDURE PROC1 (A : STA1) IS
-                     BEGIN
-                          IF A'FIRST /= 11 THEN
-                               FAILED ("CASE 1 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A'LAST /= 15 THEN
-                               FAILED ("CASE 1 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A /= "ABCDE" THEN
-                               FAILED ("CASE 1 : ARRAY DOES NOT " &
-                                      "CONTAIN THE CORRECT VALUES");
-                          END IF;
-                     END;
- 
-                BEGIN
- 
-                     PROC1 ("ABCDE");
- 
-                END CASE_A1;
- 
- --             COMMENT ("CASE A2 : SUBPROGRAM WITH CONSTRAINED " &
- --                      "TWO-DIMENSIONAL ARRAY FORMAL PARAMETER");
- 
-      CASE_A2 : DECLARE
- 
-                     TYPE TA IS ARRAY (11 .. 12, 10 .. 11) OF CHARACTER;
- 
-                     PROCEDURE PROC1 (A : TA) IS
-                     BEGIN
-                          IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
-                               FAILED ("CASE 2 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A'LAST(1) /= 12 OR A'LAST(2) /= 11 THEN
-                               FAILED ("CASE 2 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A /= ("AB", "CD") THEN
-                               FAILED ("CASE 2 : ARRAY DOES NOT " &
-                                       "CONTAIN THE CORRECT VALUES");
-                          END IF;
-                     END;
- 
-                BEGIN
- 
-                     PROC1 (("AB", "CD"));
- 
-                END CASE_A2;
- 
-           END CASE_A;
- 
-      END;
- 
-      RESULT;
- 
- END C43214B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C43214C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
- -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
- 
- -- EG  02/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C43214C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43214C", "CONSTRAINED ARRAY FORMAL GENERIC " &
-                      "PARAMETER");
- 
-      BEGIN
- 
- CASE_B :  DECLARE
- 
-                SUBTYPE STB IS STRING(5 .. 8);
- 
-                GENERIC
-                     B1 : STB;
-                PROCEDURE PROC1;
- 
-                PROCEDURE PROC1 IS
-                BEGIN
-                     IF B1'FIRST /= 5 THEN
-                          FAILED ("LOWER BOUND INCORRECT");
-                     ELSIF B1'LAST /= 8 THEN
-                          FAILED ("UPPER BOUND INCORRECT");
-                     ELSIF B1 /= "ABCD" THEN
-                          FAILED ("ARRAY DOES NOT " &
-                                  "CONTAIN THE CORRECT VALUES");
-                     END IF;
-                END;
- 
-                PROCEDURE PROC2 IS NEW PROC1 ("ABCD");
- 
-           BEGIN
- 
-                PROC2;
- 
-           END CASE_B;
- 
-      END;
- 
-      RESULT;
- 
- END C43214C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C43214D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
- -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
- 
- -- EG  02/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C43214D IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43214D", "CONSTRAINED FUNCTION RESULT TYPE");
- 
-      BEGIN
- 
- CASE_C :  DECLARE
- 
-                TYPE TC IS ARRAY (INTEGER RANGE -1 .. 0, 
-                                  IDENT_INT(7) .. 9) OF CHARACTER;
- 
-                FUNCTION FUN1 (A : INTEGER) RETURN TC IS
-                BEGIN
-                     RETURN ("ABC", "DEF");
-                END;
- 
-           BEGIN
- 
-                IF FUN1(5)'FIRST(1) /= -1 THEN
-                     FAILED ("LOWER BOUND INCORRECT " &
-                             "FOR 'FIRST(1)");
-                ELSIF FUN1(5)'FIRST(2) /= 7 THEN
-                     FAILED ("LOWER BOUND INCORRECT " &
-                             "FOR 'FIRST(2)");
-                ELSIF FUN1(5)'LAST(1) /= 0 THEN
-                     FAILED ("UPPER BOUND INCORRECT " &
-                             "FOR 'LAST(1)");
-                ELSIF FUN1(5)'LAST(2) /= 9 THEN
-                     FAILED ("UPPER BOUND INCORRECT " &
-                             "FOR 'LAST(2)");
-                ELSIF FUN1(5) /= ("ABC", "DEF") THEN
-                     FAILED ("FUNCTION DOES NOT " &
-                             "RETURN THE CORRECT VALUES");
-                END IF;
- 
-           END CASE_C;
- 
-      END;
- 
-      RESULT;
- 
- END C43214D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- C43214E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
- -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
- 
- -- EG  02/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C43214E IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43214E", "INITIALIZATION OF CONSTRAINED ARRAY");
- 
-      BEGIN
- 
- CASE_D :  BEGIN
- 
- --             COMMENT ("CASE D1 : INITIALIZATION OF CONSTRAINED " &
- --                      "ARRAY CONSTANT");
- 
-      CASE_D1 : DECLARE
- 
-                     D1 : CONSTANT STRING(11 .. 13) := "ABC";
- 
-                BEGIN
- 
-                     IF D1'FIRST /= 11 THEN
-                          FAILED ("CASE 1 : LOWER BOUND INCORRECT");
-                     ELSIF D1'LAST /= 13 THEN
-                          FAILED ("CASE 1 : UPPER BOUND INCORRECT");
-                     ELSIF D1 /= "ABC" THEN
-                               FAILED ("CASE 1 : ARRAY DOES NOT " &
-                                       "CONTAIN THE CORRECT VALUES");
-                     END IF;
- 
-                END CASE_D1;
- 
- --             COMMENT ("CASE D2 : INITIALIZATION OF CONSTRAINED " &
- --                      "ARRAY VARIABLE");
- 
-      CASE_D2 : DECLARE
- 
-                     D2 : STRING(11 .. 13) := "ABC";
- 
-                BEGIN
- 
-                     IF D2'FIRST /= 11 THEN
-                          FAILED ("CASE 2 : LOWER BOUND INCORRECT");
-                     ELSIF D2'LAST /= 13 THEN
-                          FAILED ("CASE 2 : UPPER BOUND INCORRECT");
-                     ELSIF D2 /= "ABC" THEN
-                          FAILED ("CASE 2 : INCORRECT VALUES");
-                     END IF;
- 
-                END CASE_D2;
- 
- --             COMMENT ("CASE D3 : INITIALIZATION OF CONSTRAINED " &
- --                      "ARRAY FORMAL PARAMETER OF A SUBPROGRAM");
- 
-      CASE_D3 : DECLARE
- 
-                     SUBTYPE STD3 IS STRING(IDENT_INT(5) .. 7);
- 
-                     PROCEDURE PROC1 (A : STD3 := "ABC") IS
-                     BEGIN
-                          IF A'FIRST /= 5 THEN
-                               FAILED ("CASE 3 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A'LAST /= 7 THEN
-                               FAILED ("CASE 3 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF A /= "ABC" THEN
-                               FAILED ("CASE 3 : INCORRECT VALUES");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                PROC1;
- 
-                END CASE_D3;
- 
- --             COMMENT ("CASE D4 : INITIALIZATION OF CONSTRAINED " &
- --                      "ARRAY FORMAL PARAMETER OF A GENERIC UNIT");
- 
-      CASE_D4 : DECLARE
- 
-                     SUBTYPE STD4 IS STRING(5 .. 8);
- 
-                     GENERIC
-                          D4 : STD4 := "ABCD";
-                     PROCEDURE PROC1;
- 
-                     PROCEDURE PROC1 IS
-                     BEGIN
-                          IF D4'FIRST /= 5 THEN
-                               FAILED ("CASE 4 : LOWER BOUND " &
-                                       "INCORRECT");
-                          ELSIF D4'LAST /= 8 THEN
-                               FAILED ("CASE 4 : UPPER BOUND " &
-                                       "INCORRECT");
-                          ELSIF D4 /= "ABCD" THEN
-                               FAILED ("CASE 4 : INCORRECT VALUES");
-                          END IF;
-                     END PROC1;
- 
-                     PROCEDURE PROC2 IS NEW PROC1;
- 
-                BEGIN
- 
-                     PROC2;
- 
-                END CASE_D4;
- 
-           END CASE_D;
- 
-      END;
- 
-      RESULT;
- 
- END C43214E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43214f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43214f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- C43214F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
- -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
- 
- -- EG  02/10/84
- -- JBG 3/30/84
- 
- WITH REPORT;
- 
- PROCEDURE C43214F IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C43214F", "ARRAY COMPONENT EXPRESSION OF AN ENCLOSING " &
-                      "AGGREGATE");
- 
-      BEGIN
- 
- CASE_E :  BEGIN
- 
- --             COMMENT ("CASE E1 : ARRAY COMPONENT EXPRESSION OF " &
- --                      "AN ENCLOSING ARRAY AGGREGATE");
- 
-      CASE_E1 : DECLARE
- 
-                     TYPE TE2 IS ARRAY(1 .. 2) OF 
-                                 STRING(IDENT_INT(3) .. 5);
- 
-                     E1 : TE2;
- 
-                BEGIN
- 
-                     E1 := (1 .. 2 => "ABC");
-                     IF (E1'FIRST /= 1 OR E1'LAST /= 2) OR ELSE
-                        (E1(1)'FIRST /= 3 OR E1(1)'LAST /= 5 OR
-                         E1(2)'FIRST /= 3 OR E1(2)'LAST /= 5) THEN
-                          FAILED ("CASE 1 : INCORRECT BOUNDS");
-                     ELSIF E1 /= (1 .. 2 => "ABC") THEN
-                          FAILED ("CASE 1 : ARRAY DOES NOT " &
-                                  "CONTAIN THE CORRECT VALUES");
-                     END IF;
- 
-                END CASE_E1;
- 
- --             COMMENT ("CASE E2 : ARRAY COMPONENT EXPRESSION OF " &
- --                      "AN ENCLOSING RECORD AGGREGATE");
- 
-      CASE_E2 : DECLARE
- 
-                     TYPE TER IS
-                          RECORD
-                               REC : STRING(3 .. 5);
-                          END RECORD;
- 
-                     E2 : TER;
- 
-                BEGIN
- 
-                     E2 := (REC => "ABC");
-                     IF E2.REC'FIRST /= 3 OR E2.REC'LAST /= 5 THEN
-                          FAILED ("CASE 2 : INCORRECT BOUNDS");
-                     ELSIF E2.REC /= "ABC" THEN
-                          FAILED ("CASE 2 : ARRAY DOES NOT " &
-                                  "CONTAIN CORRECT VALUES");
-                     END IF;
- 
-                END CASE_E2;
- 
- --             COMMENT ("CASE E3 : NULL LITERAL OF AN ENCLOSING " &
- --                      "ARRAY AGGREGATE");
- 
-      CASE_E3 : DECLARE
- 
-                     TYPE TE2 IS ARRAY(1 .. 2) OF
-                                 STRING(3 .. IDENT_INT(2));
- 
-                     E3 : TE2;
- 
-                BEGIN
- 
-                     E3 := (1 .. 2 => "");
-                     IF (E3'FIRST /= 1 OR E3'LAST /= 2) OR ELSE
-                        (E3(1)'FIRST /= 3 OR E3(1)'LAST /= 2 OR
-                         E3(2)'FIRST /= 3 OR E3(2)'LAST /= 2) THEN
-                          FAILED ("CASE 3 : INCORRECT BOUND");
-                     ELSIF E3 /= (1 .. 2 => "") THEN
-                          FAILED ("CASE 3 : ARRAY DOES NOT CONTAIN " &
-                                  "THE CORRECT VALUES");
-                     END IF;
- 
-                END CASE_E3;
- 
- --             COMMENT ("CASE E4 : ARRAY COMPONENT EXPRESSION OF "  &
- --                      "AN ENCLOSING RECORD AGGREGATE THAT HAS A " &
- --                      "DISCRIMINANT AND THE DISCRIMINANT DETER"   &
- --                      "MINES THE BOUNDS OF THE COMPONENT");
- 
-      CASE_E4 : DECLARE
- 
-                     SUBTYPE TEN IS INTEGER RANGE 1 .. 10;
-                     TYPE TER (A : TEN) IS
-                          RECORD
-                               REC : STRING(3 .. A);
-                          END RECORD;
- 
-                     E4 : TER(5);
- 
-                BEGIN
- 
-                     E4 := (REC => "ABC", A => 5);
-                     IF E4.REC'FIRST /= 3 OR E4.REC'LAST /= 5 THEN
-                          FAILED ("CASE 4 : INCORRECT BOUNDS");
-                     ELSIF E4.REC /= "ABC" THEN
-                          FAILED ("CASE 4 : ARRAY DOES NOT CONTAIN " &
-                                  "CORRECT VALUES");
-                     END IF;
- 
-                END CASE_E4;
- 
-           END CASE_E;
- 
-      END;
- 
-      RESULT;
- 
- END C43214F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43215a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43215a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43215a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43215a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- C43215A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A POSITIONAL
- -- ARRAY AGGREGATE WHOSE UPPER BOUND EXCEEDS THE UPPER BOUND
- -- OF THE INDEX SUBTYPE BUT BELONGS TO THE INDEX BASE TYPE.
- 
- -- EG  02/13/84
- 
- WITH REPORT;
- WITH SYSTEM;
- 
- PROCEDURE C43215A IS
- 
-      USE REPORT;
-      USE SYSTEM;
- 
- BEGIN
- 
-      TEST("C43215A","CHECK THAT CONSTRAINT_ERROR IS RAISED "      &
-                     "FOR A POSITIONAL ARRAY AGGREGATE WHOSE "     &
-                     "UPPER BOUND EXCEEDS THE UPPER BOUND OF THE " &
-                     "INDEX SUBTYPE BUT BELONGS TO THE INDEX "     &
-                     "BASE TYPE");
- 
-      BEGIN
- 
- CASE_A :  DECLARE
- 
-                LOWER_BOUND : CONSTANT  := MAX_INT-3;
-                UPPER_BOUND : CONSTANT  := MAX_INT-1;
- 
-                TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND;
- 
-                TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER;
- 
-                A1 : TA(STA);
-                OK : EXCEPTION;
- 
-                FUNCTION FUN1 RETURN TA IS
-                BEGIN
-                     RETURN (1, 2, 3, 4);
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                     BEGIN
-                          COMMENT ("CASE A : CONSTRAINT_ERROR RAISED");
-                          RAISE OK;
-                     END;
-                     WHEN OTHERS =>
-                     BEGIN
-                          FAILED ("CASE A : EXCEPTION RAISED IN FUN1");
-                          RAISE OK;
-                     END;
-                END FUN1;
- 
-           BEGIN
- 
-                A1 := FUN1;
-                FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED");
- 
-           EXCEPTION
- 
-                WHEN OK =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE A : EXCEPTION RAISED");
- 
-           END CASE_A;
- 
- CASE_B :  DECLARE
- 
-                TYPE ENUM IS (A, B, C, D);
- 
-                SUBTYPE STB IS ENUM RANGE A .. C;
- 
-                TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
- 
-                B1 : TB(STB);
-                OK : EXCEPTION;
- 
-                FUNCTION FUN1 RETURN TB IS
-                BEGIN
-                     RETURN (1, 2, 3, 4);
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                     BEGIN
-                          COMMENT ("CASE B : CONSTRAINT_ERROR RAISED");
-                          RAISE OK;
-                     END;
-                     WHEN OTHERS =>
-                     BEGIN
-                          FAILED ("CASE B : EXCEPTION RAISED IN FUN1");
-                          RAISE OK;
-                     END;
-                END FUN1;
- 
-           BEGIN
- 
-                B1 := FUN1;
-                FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED");
- 
-           EXCEPTION
- 
-                WHEN OK =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE B : EXCEPTION RAISED");
- 
-           END CASE_B;
- 
-      END;
- 
-      RESULT;
- 
- END C43215A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43215b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43215b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43215b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43215b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C43215B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE UPPER BOUND
- -- OF A POSITIONAL AGGREGATE DOES NOT BELONG TO THE INDEX BASE TYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- EG  02/13/84
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT;
- WITH SYSTEM;
- 
- PROCEDURE C43215B IS
- 
-      USE REPORT;
-      USE SYSTEM;
- 
- BEGIN
- 
-      TEST("C43215B","CHECK THAT CONSTRAINT_ERROR IS RAISED "   &
-                     "WHEN THE UPPER BOUND OF A POSITIONAL ARRAY " &
-                     "AGGREGATE DOES NOT BELONG TO THE INDEX "     &
-                     "BASE TYPE");
- 
-      BEGIN
- 
- CASE_A :  DECLARE
- 
-                LOWER_BOUND : CONSTANT := MAX_INT-3;
-                UPPER_BOUND : CONSTANT := MAX_INT-1;
- 
-                TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND;
- 
-                TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER;
- 
-                A1 : TA(STA);
-                OK : EXCEPTION;
- 
-                FUNCTION FUN1 RETURN TA IS
-                BEGIN
-                     RETURN (1, 2, 3, 4, 5);
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                     BEGIN
-                          COMMENT ("CASE A : CONSTRAINT_ERROR RAISED");
-                          RAISE OK;
-                     END;
-                     WHEN OTHERS =>
-                     BEGIN
-                          FAILED ("CASE A : EXCEPTION RAISED IN FUN1");
-                          RAISE OK;
-                     END;
-                END FUN1;
- 
-           BEGIN
- 
-                A1 := FUN1;
-                FAILED ("CASE A : CONSTRAINT OR NUMERIC ERROR WAS " &
-                        "NOT RAISED");
- 
-           EXCEPTION
- 
-                WHEN OK =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE A : WRONG EXCEPTION RAISED");
- 
-           END CASE_A;
- 
- CASE_B :  DECLARE
- 
-                TYPE ENUM IS (A, B, C, D);
- 
-                SUBTYPE STB IS ENUM RANGE A .. C;
- 
-                TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
- 
-                B1 : TB(STB);
-                OK : EXCEPTION;
- 
-                FUNCTION FUN1 RETURN TB IS
-                BEGIN
-                     RETURN (1, 2, 3, 4, 5);
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                     BEGIN
-                          COMMENT ("CASE B : CONSTRAINT_ERROR RAISED");
-                          RAISE OK;
-                     END;
-                     WHEN OTHERS =>
-                     BEGIN
-                          FAILED ("CASE B : EXCEPTION RAISED IN FUN1");
-                          RAISE OK;
-                     END;
-                END FUN1;
- 
-           BEGIN
- 
-                B1 := FUN1;
-                FAILED ("CASE B : CONSTRAINT ERROR WAS NOT RAISED");
- 
-           EXCEPTION
- 
-                WHEN OK =>
-                     NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("CASE B : WRONG EXCEPTION RAISED");
- 
-           END CASE_B;
- 
-      END;
- 
-      RESULT;
- 
- END C43215B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43222a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43222a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43222a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43222a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,49 ****
- -- C43222A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ARRAY AGGREGATE NEED NOT BE RESOLVABLE TO A
- --     CONSTRAINED SUBTYPE.
- 
- -- HISTORY:
- --     DHH 08/12/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43222A IS
- 
- BEGIN
-      TEST("C43222A", "CHECK THAT AN ARRAY AGGREGATE NEED NOT BE " &
-                      "RESOLVABLE TO A CONSTRAINED SUBTYPE");
- 
-      DECLARE
-           TYPE A IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-           B : BOOLEAN := (1, 2, 3) = A'(1, 2, 3);
-      BEGIN
-           IF IDENT_BOOL(B) /= IDENT_BOOL(TRUE) THEN
-                FAILED("INITIALIZATION FAILURE");
-           END IF;
-      END;
- 
-      RESULT;
- END C43222A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43224a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43224a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c43224a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c43224a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C43224A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A NON-STATIC CHOICE OF AN ARRAY AGGREGATE CAN BE A
- --     'RANGE ATTRIBUTE.
- 
- -- HISTORY:
- --     DHH 08/15/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C43224A IS
- 
-      M, O : INTEGER := IDENT_INT(2);
-      N : INTEGER := IDENT_INT(3);
- 
-      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-      TYPE D3_ARR IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>,
-                           INTEGER RANGE <>) OF INTEGER;
- 
-      SUBTYPE ARR1 IS ARR(IDENT_INT(2) .. IDENT_INT(3));
-      SUBTYPE ARR2 IS D3_ARR(1 .. M, 1 .. N, 1 ..O);
- 
-      SUB : ARR1;
-      SUB1 : ARR2;
- 
-      PROCEDURE PROC(ARRY : IN OUT ARR) IS
-      BEGIN
-           ARRY := (ARR1'RANGE => IDENT_INT(7));
-           IF ARRY(IDENT_INT(ARRY'FIRST)) /= IDENT_INT(7) THEN
-                FAILED("RANGE NOT INITIALIZED - 1");
-           END IF;
-      END PROC;
- 
-      PROCEDURE PROC1(ARRY : IN OUT D3_ARR) IS
-      BEGIN
-           ARRY := (ARR2'RANGE(1) => (ARRY'RANGE(2) =>
-                   (ARRY'RANGE(3) => IDENT_INT(7))));
- 
-           IF ARRY(IDENT_INT(1), IDENT_INT(2), IDENT_INT(1)) /=
-                   IDENT_INT(7) THEN
-                FAILED("RANGE NOT INITIALIZED - 2");
-           END IF;
-      END PROC1;
- 
- BEGIN
-      TEST("C43224A", "CHECK THAT A NON-STATIC CHOICE OF AN ARRAY " &
-                      "AGGREGATE CAN BE A 'RANGE ATTRIBUTE");
- 
-      PROC(SUB);
-      PROC1(SUB1);
- 
-      RESULT;
- END C43224A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c433001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c433001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c433001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c433001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,303 ****
- -- C433001.A
- 
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check that an others choice is allowed in an array aggregate whose
- --     applicable index constraint is dynamic. (This was an extension to
- --     Ada 83). Check that index choices are within the applicable index
- --     constraint for array aggregates with others choices.
- --
- -- TEST DESCRIPTION
- --     In this test, we declare several unconstrained array types, and
- --     several dynamic subtypes. We then test a variety of cases of using
- --     appropriate aggregates. Some cases expect to raise Constraint_Error.
- --
- -- HISTORY:
- --      16 DEC 1999   RLB   Initial Version.
- --      20 JAN 2009   RLB   Corrected error messages.
- 
- with Report;
- procedure C433001 is
- 
-     type Color_Type is (Red, Orange, Yellow, Green, Blue, Indigo, Violet);
- 
-     type Array_1 is array (Positive range <>) of Integer;
- 
-     subtype Sub_1_1 is Array_1 (Report.Ident_Int(1) .. Report.Ident_Int(3));
-     subtype Sub_1_2 is Array_1 (Report.Ident_Int(3) .. Report.Ident_Int(5));
-     subtype Sub_1_3 is Array_1 (Report.Ident_Int(5) .. Report.Ident_Int(9));
- 
-     type Array_2 is array (Color_Type range <>) of Integer;
- 
-     subtype Sub_2_1 is Array_2 (Color_Type'Val(Report.Ident_Int(0)) ..
-                                 Color_Type'Val(Report.Ident_Int(2)));
-                                                  -- Red .. Yellow
-     subtype Sub_2_2 is Array_2 (Color_Type'Val(Report.Ident_Int(3)) ..
-                                 Color_Type'Val(Report.Ident_Int(6)));
-                                                  -- Green .. Violet
-     type Array_3 is array (Color_Type range <>, Positive range <>) of Integer;
- 
-     subtype Sub_3_1 is Array_3 (Color_Type'Val(Report.Ident_Int(0)) ..
-                                 Color_Type'Val(Report.Ident_Int(2)),
-                                 Report.Ident_Int(3) .. Report.Ident_Int(5));
-                                                  -- Red .. Yellow, 3 .. 5
-     subtype Sub_3_2 is Array_3 (Color_Type'Val(Report.Ident_Int(1)) ..
-                                 Color_Type'Val(Report.Ident_Int(3)),
-                                 Report.Ident_Int(6) .. Report.Ident_Int(8));
-                                                  -- Orange .. Green, 6 .. 8
- 
-     procedure Check_1 (Obj : Array_1; Low, High : Integer;
-                        First_Component, Second_Component,
-                            Last_Component : Integer;
-                        Test_Case : Character) is
-     begin
-         if Obj'First /= Low then
-            Report.Failed ("Low bound incorrect (" & Test_Case & ")");
-         end if;
-         if Obj'Last /= High then
-            Report.Failed ("High bound incorrect (" & Test_Case & ")");
-         end if;
-         if Obj(Low) /= First_Component then
-            Report.Failed ("First Component incorrect (" & Test_Case & ")");
-         end if;
-         if Obj(Low+1) /= Second_Component then
-            Report.Failed ("Second Component incorrect (" & Test_Case & ")");
-         end if;
-         if Obj(High) /= Last_Component then
-            Report.Failed ("Last Component incorrect (" & Test_Case & ")");
-         end if;
-     end Check_1;
- 
-     procedure Check_2 (Obj : Array_2; Low, High : Color_Type;
-                        First_Component, Second_Component,
-                            Last_Component : Integer;
-                        Test_Case : Character) is
-     begin
-         if Obj'First /= Low then
-            Report.Failed ("Low bound incorrect (" & Test_Case & ")");
-         end if;
-         if Obj'Last /= High then
-            Report.Failed ("High bound incorrect (" & Test_Case & ")");
-         end if;
-         if Obj(Low) /= First_Component then
-            Report.Failed ("First Component incorrect (" & Test_Case & ")");
-         end if;
-         if Obj(Color_Type'Succ(Low)) /= Second_Component then
-            Report.Failed ("Second Component incorrect (" & Test_Case & ")");
-         end if;
-         if Obj(High) /= Last_Component then
-            Report.Failed ("Last Component incorrect (" & Test_Case & ")");
-         end if;
-     end Check_2;
- 
-     procedure Check_3 (Test_Obj, Check_Obj : Array_3;
-                        Low_1, High_1 : Color_Type;
-                        Low_2, High_2 : Integer;
-                        Test_Case : Character) is
-     begin
-         if Test_Obj'First(1) /= Low_1 then
-            Report.Failed ("Low bound for dimension 1 incorrect (" &
-                 Test_Case & ")");
-         end if;
-         if Test_Obj'Last(1) /= High_1 then
-            Report.Failed ("High bound for dimension 1 incorrect (" &
-                 Test_Case & ")");
-         end if;
-         if Test_Obj'First(2) /= Low_2 then
-            Report.Failed ("Low bound for dimension 2 incorrect (" &
-                 Test_Case & ")");
-         end if;
-         if Test_Obj'Last(2) /= High_2 then
-            Report.Failed ("High bound for dimension 2 incorrect (" &
-                 Test_Case & ")");
-         end if;
-         if Test_Obj /= Check_Obj then
-            Report.Failed ("Components incorrect (" & Test_Case & ")");
-         end if;
-     end Check_3;
- 
-     procedure Subtest_Check_1 (Obj : Sub_1_3;
-                                First_Component, Second_Component,
-                                         Last_Component : Integer;
-                                Test_Case : Character) is
-     begin
-         Check_1 (Obj, 5, 9, First_Component, Second_Component, Last_Component,
-                  Test_Case);
-     end Subtest_Check_1;
- 
-     procedure Subtest_Check_2 (Obj : Sub_2_2;
-                                First_Component, Second_Component,
-                                         Last_Component : Integer;
-                                Test_Case : Character) is
-     begin
-         Check_2 (Obj, Green, Violet, First_Component, Second_Component,
-                  Last_Component, Test_Case);
-     end Subtest_Check_2;
- 
-     procedure Subtest_Check_3 (Obj : Sub_3_2;
-                                Test_Case : Character) is
-     begin
-         Check_3 (Obj, Obj, Orange, Green, 6, 8, Test_Case);
-     end Subtest_Check_3;
- 
- begin
- 
-     Report.Test ("C433001",
-                  "Check that an others choice is allowed in an array " &
-                  "aggregate whose applicable index constraint is dynamic. " &
-                  "Also check index choices are within the applicable index " &
-                  "constraint for array aggregates with others choices");
- 
-     -- Check with a qualified expression:
-     Check_1 (Sub_1_1'(2, 3, others => 4), Low => 1, High => 3,
-              First_Component => 2, Second_Component => 3, Last_Component => 4,
-              Test_Case => 'A');
- 
-     Check_2 (Sub_2_1'(1, others => Report.Ident_Int(6)),
-              Low => Red, High => Yellow,
-              First_Component => 1, Second_Component => 6, Last_Component => 6,
-              Test_Case => 'B');
- 
-     Check_3 (Sub_3_1'((1, others => 3), others => (2, 4, others => 6)),
-              Check_Obj => ((1, 3, 3), (2, 4, 6), (2, 4, 6)),
-              Low_1 => Red, High_1 => Yellow, Low_2 => 3, High_2 => 5,
-              Test_Case => 'C');
- 
-     -- Check that the others clause does not need to represent any components:
-     Check_1 (Sub_1_2'(5, 6, 8, others => 10), Low => 3, High => 5,
-              First_Component => 5, Second_Component => 6, Last_Component => 8,
-              Test_Case => 'D');
- 
-     -- Check named choices are allowed:
-     Check_1 (Sub_1_1'(2 => Report.Ident_Int(-1), others => 8),
-              Low => 1, High => 3,
-              First_Component => 8, Second_Component => -1, Last_Component => 8,
-              Test_Case => 'E');
- 
-     -- Check named choices and formal parameters:
-     Subtest_Check_1 ((6 => 4, 8 => 86, others => 1),
-              First_Component => 1, Second_Component => 4, Last_Component => 1,
-              Test_Case => 'F');
- 
-     Subtest_Check_2 ((Green => Report.Ident_Int(88), Violet => 89,
-              Indigo => Report.Ident_Int(42), Blue => 0, others => -1),
-              First_Component => 88, Second_Component => 0, Last_Component => 89,
-              Test_Case => 'G');
- 
-     Subtest_Check_3 ((Yellow => (7 => 0, others => 10), others => (1, 2, 3)),
-              Test_Case => 'H');
- 
-     -- Check object declarations and assignment:
-     declare
-         Var : Sub_1_2 := (4, 36, others => 86);
-     begin
-         Check_1 (Var, Low => 3, High => 5,
-              First_Component => 4, Second_Component => 36,
-              Last_Component => 86,
-              Test_Case => 'I');
-         Var := (5 => 415, others => Report.Ident_Int(1522));
-         Check_1 (Var, Low => 3, High => 5,
-              First_Component => 1522, Second_Component => 1522,
-              Last_Component => 415,
-              Test_Case => 'J');
-     end;
- 
-     -- Check positional aggregates that are too long:
-     begin
-         Subtest_Check_2 ((Report.Ident_Int(88), 89, 90, 91, 92, others => 93),
-              First_Component => 88, Second_Component => 89,
-              Last_Component => 91,
-              Test_Case => 'K');
-         Report.Failed ("Constraint_Error not raised by positional " &
-                        "aggregate with too many choices (K)");
-     exception
-         when Constraint_Error => null; -- Expected exception.
-     end;
- 
-     begin
-         Subtest_Check_3 (((0, others => 10), (2, 3, others => 4),
-              (5, 6, 8, others => 10), (1, 4, 7),  others => (1, 2, 3)),
-              Test_Case => 'L');
-         Report.Failed ("Constraint_Error not raised by positional " &
-                        "aggregate with too many choices (L)");
-     exception
-         when Constraint_Error => null; -- Expected exception.
-     end;
- 
-     -- Check named aggregates with choices in the index subtype but not in the
-     -- applicable index constraint:
- 
-     begin
-         Subtest_Check_1 ((5 => Report.Ident_Int(88), 8 => 89,
-              10 => 66, -- 10 not in applicable index constraint
-              others => 93),
-              First_Component => 88, Second_Component => 93,
-              Last_Component => 93,
-              Test_Case => 'M');
-         Report.Failed ("Constraint_Error not raised by aggregate choice " &
-                        "index outside of applicable index constraint (M)");
-     exception
-         when Constraint_Error => null; -- Expected exception.
-     end;
- 
-     begin
-         Subtest_Check_2 (
-              (Yellow => 23, -- Yellow not in applicable index constraint.
-              Blue => 16, others => 77),
-              First_Component => 77, Second_Component => 16,
-              Last_Component => 77,
-              Test_Case => 'N');
-         Report.Failed ("Constraint_Error not raised by aggregate choice " &
-                        "index outside of applicable index constraint (N)");
-     exception
-         when Constraint_Error => null; -- Expected exception.
-     end;
- 
-     begin
-         Subtest_Check_3 ((Orange => (0, others => 10),
-              Blue => (2, 3, others => 4), -- Blue not in applicable index cons.
-              others => (1, 2, 3)),
-              Test_Case => 'P');
-         Report.Failed ("Constraint_Error not raised by aggregate choice " &
-                        "index outside of applicable index constraint (P)");
-     exception
-         when Constraint_Error => null; -- Expected exception.
-     end;
- 
-     begin
-         Subtest_Check_3 ((Orange => (6 => 0, others => Report.Ident_Int(10)),
-              Green => (8 => 2, 4 => 3, others => 7),
-                 -- 4 not in applicable index cons.
-              others => (1, 2, 3, others => Report.Ident_Int(10))),
-              Test_Case => 'Q');
-         Report.Failed ("Constraint_Error not raised by aggregate choice " &
-                        "index outside of applicable index constraint (Q)");
-     exception
-         when Constraint_Error => null; -- Expected exception.
-     end;
- 
-     Report.Result;
- 
- end C433001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c44003d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c44003d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c44003d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c44003d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- C44003D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK FOR CORRECT PRECEDENCE OF PREDEFINED AND OVERLOADED
- --     OPERATIONS ON PREDEFINED TYPE FLOAT, USER-DEFINED TYPES, AND
- --     ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF TYPE FLOAT.
- 
- -- HISTORY:
- --     RJW 10/13/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C44003D IS
- 
- BEGIN
-      TEST ("C44003D", "CHECK FOR CORRECT PRECEDENCE OF PREDEFINED " &
-                       "AND OVERLOADED OPERATIONS ON PREDEFINED TYPE " &
-                       "FLOAT, USER-DEFINED TYPES, AND ONE-DIMEN" &
-                       "SIONAL ARRAYS WITH COMPONENTS OF TYPE FLOAT");
- 
- ----- PREDEFINED FLOAT:
- 
-      DECLARE
-           F1 : FLOAT := 1.0;
-           F2 : FLOAT := 2.0;
-           F5 : FLOAT := 5.0;
- 
-           FUNCTION "OR" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
-           BEGIN
-                RETURN 4.5;
-           END "OR";
- 
-           FUNCTION "<" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
-           BEGIN
-                RETURN 5.5;
-           END "<";
- 
-           FUNCTION "-" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
-           BEGIN
-                RETURN 6.5;
-           END "-";
- 
-           FUNCTION "+" (RIGHT : FLOAT) RETURN FLOAT IS
-           BEGIN
-                RETURN 7.5;
-           END "+";
- 
-           FUNCTION "*" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
-           BEGIN
-                RETURN 8.5;
-           END "*";
- 
-           FUNCTION "NOT" (RIGHT : FLOAT) RETURN FLOAT IS
-           BEGIN
-                RETURN 9.5;
-           END "NOT";
- 
-      BEGIN
-           IF NOT (-ABS F1 + F2 / F1 + F5 ** 2 =  26.0 AND
-                   F1 > 0.0 AND
-                   - F2 * F2 ** 3 = -8.5) THEN
-                FAILED ("INCORRECT RESULT - 1");
-           END IF;
- 
-           IF (F1 OR NOT F2 < F1 - F5 * F5 ** 3) /= 4.5 THEN
-                FAILED ("INCORRECT RESULT - 2");
-           END IF;
-      END;
- 
- ----- USER-DEFINED TYPE:
- 
-      DECLARE
-           TYPE USR IS DIGITS 5;
- 
-           F1 : USR := 1.0;
-           F2 : USR := 2.0;
-           F5 : USR := 5.0;
- 
-           FUNCTION "AND" (LEFT, RIGHT : USR) RETURN USR IS
-           BEGIN
-                RETURN 4.5;
-           END "AND";
- 
-           FUNCTION ">=" (LEFT, RIGHT : USR) RETURN USR IS
-           BEGIN
-                RETURN 5.5;
-           END ">=";
- 
-           FUNCTION "+" (LEFT, RIGHT : USR) RETURN USR IS
-           BEGIN
-                RETURN 6.5;
-           END "+";
- 
-           FUNCTION "-" (RIGHT : USR) RETURN USR IS
-           BEGIN
-                RETURN 7.5;
-           END "-";
- 
-           FUNCTION "/" (LEFT, RIGHT : USR) RETURN USR IS
-           BEGIN
-                RETURN 8.5;
-           END "/";
- 
-           FUNCTION "**" (LEFT, RIGHT : USR) RETURN USR IS
-           BEGIN
-                RETURN 9.5;
-           END "**";
-      BEGIN
-           IF +F5 - F2 * F1 ** 2 /= 3.0 OR
-              ABS F1 <= 0.0 OR
-              - F2 * F2 ** 3.0 /= 7.5 THEN
-                FAILED ("INCORRECT RESULT - 3");
-           END IF;
- 
-           IF (F1 AND F2 >= F1 + F5 / F5 ** 3) /= 4.5 THEN
-                FAILED ("INCORRECT RESULT - 4");
-           END IF;
-      END;
- 
- ----- ARRAYS:
- 
-      DECLARE
-           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF FLOAT;
- 
-           SUBTYPE SARR IS ARR (1 .. 3);
- 
-           F1 : SARR := (OTHERS => 1.0);
-           F2 : SARR := (OTHERS => 2.0);
-           F5 : SARR := (OTHERS => 5.0);
- 
-           FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => 4.5);
-           END "XOR";
- 
-           FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => 5.5);
-           END "<=";
- 
-           FUNCTION "&" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => 6.5);
-           END "&";
- 
-           FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => 8.5);
-           END "MOD";
- 
-           FUNCTION "ABS" (RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => 9.5);
-           END "ABS";
-      BEGIN
-           IF (ABS F1 <= F2 & F5 MOD F1 XOR F1) /= (1 .. 3 => 4.5) THEN
-                FAILED ("INCORRECT RESULT - 5");
-           END IF;
- 
-           IF (ABS F1 & F2) /= (1 .. 3 => 6.5) OR
-              (F1 MOD F2 <= F5) /= (1 .. 3 => 5.5) THEN
-                FAILED ("INCORRECT RESULT - 6");
-           END IF;
-      END;
- 
-      RESULT;
- END C44003D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c44003f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c44003f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c44003f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c44003f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,143 ****
- -- C44003F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED AND OVERLOADED
- --     OPERATIONS ON ENUMERATION TYPES OTHER THAN BOOLEAN OR CHARACTER
- --     AND ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF SUCH TYPES.
- 
- -- HISTORY:
- --     RJW 10/13/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C44003F IS
- 
-      TYPE ENUM IS (ZERO, ONE, TWO, THREE, FOUR, FIVE);
- 
- BEGIN
-      TEST ("C44003F", "CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED " &
-                       "AND OVERLOADED OPERATIONS ON ENUMERATION " &
-                       "TYPES OTHER THAN BOOLEAN OR CHARACTER AND " &
-                       "ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF " &
-                       "SUCH TYPES");
- 
- 
- ----- ENUMERATION TYPE:
- 
-      DECLARE
-           E1 : ENUM := ONE;
-           E2 : ENUM := TWO;
-           E5 : ENUM := FIVE;
- 
-           FUNCTION "AND" (LEFT, RIGHT : ENUM) RETURN ENUM IS
-           BEGIN
-                RETURN ZERO;
-           END "AND";
- 
-           FUNCTION "<" (LEFT, RIGHT : ENUM) RETURN ENUM IS
-           BEGIN
-                RETURN THREE;
-           END "<";
- 
-           FUNCTION "-" (LEFT, RIGHT : ENUM) RETURN ENUM IS
-           BEGIN
-                RETURN ENUM'VAL (ENUM'POS (LEFT) - ENUM'POS (RIGHT));
-           END "-";
- 
-           FUNCTION "+" (RIGHT : ENUM) RETURN ENUM IS
-           BEGIN
-                RETURN RIGHT;
-           END "+";
- 
-           FUNCTION "*" (LEFT, RIGHT : ENUM) RETURN ENUM IS
-           BEGIN
-                RETURN ENUM'VAL (ENUM'POS (LEFT) * ENUM'POS (RIGHT));
-           END "*";
- 
-           FUNCTION "**" (LEFT, RIGHT : ENUM) RETURN ENUM IS
-           BEGIN
-                RETURN ENUM'VAL (ENUM'POS (LEFT) ** ENUM'POS (RIGHT));
-           END "**";
- 
-      BEGIN
-           IF NOT (+E1 < E2) OR NOT (E2 >= +E2) OR NOT (E5 = +FIVE) THEN
-                FAILED ("INCORRECT RESULT - 1");
-           END IF;
- 
-           IF (E5 ** E1 AND E2) /= (E5 - E1 * E5 ** E1) THEN
-                FAILED ("INCORRECT RESULT - 2");
-           END IF;
- 
-      END;
- 
- ----- ARRAYS:
- 
-      DECLARE
-           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF ENUM;
- 
-           SUBTYPE SARR IS ARR (1 .. 3);
- 
-           E1 : SARR := (OTHERS => ONE);
-           E2 : SARR := (OTHERS => TWO);
-           E5 : SARR := (OTHERS => FIVE);
- 
-           FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => ZERO);
-           END "XOR";
- 
-           FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => THREE);
-           END "<=";
- 
-           FUNCTION "+" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => ZERO);
-           END "+";
- 
-           FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => THREE);
-           END "MOD";
- 
-           FUNCTION "**" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => FOUR);
-           END "**";
-      BEGIN
-           IF (E5 ** E1 <= E2 + E5 MOD E1 XOR E1) /= (1 .. 3 => ZERO)
-              THEN
-                FAILED ("INCORRECT RESULT - 3");
-           END IF;
- 
-           IF (E5 ** E1 & E2) /= (FOUR, FOUR, FOUR, TWO, TWO, TWO) OR
-              (E1 MOD E2 <= E5) /= (1 .. 3 => THREE) THEN
-                FAILED ("INCORRECT RESULT - 4");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C44003F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c44003g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c44003g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c44003g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c44003g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- C44003G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED AND OVERLOADED
- --     OPERATIONS ON BOOLEAN TYPES AND ONE-DIMENSIONAL ARRAYS WITH
- --     COMPONENTS OF TYPE BOOLEAN.
- 
- -- HISTORY:
- --     RJW 10/13/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C44003G IS
- 
- BEGIN
-      TEST ("C44003G", "CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED " &
-                       "AND OVERLOADED OPERATIONS ON BOOLEAN TYPES " &
-                       "AND ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF " &
-                       "TYPE BOOLEAN");
- 
- ----- PREDEFINED BOOLEAN:
- 
-      DECLARE
-           T : BOOLEAN := TRUE;
-           F : BOOLEAN := FALSE;
- 
-           FUNCTION "AND" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN FALSE;
-           END "AND";
- 
-           FUNCTION "<" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN TRUE;
-           END "<";
- 
-           FUNCTION "-" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN TRUE;
-           END "-";
- 
-           FUNCTION "+" (RIGHT : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN NOT RIGHT;
-           END "+";
- 
-           FUNCTION "*" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN FALSE;
-           END "*";
- 
-           FUNCTION "**" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN TRUE;
-           END "**";
- 
-      BEGIN
-           IF NOT (+T = F) OR T /= +F OR (TRUE AND FALSE ** TRUE) OR
-              NOT (+T < F) OR NOT (T - F * T) OR (NOT T - F XOR + F - F)
-              THEN
-                FAILED ("INCORRECT RESULT - 1");
-           END IF;
- 
-      END;
- 
- ----- ARRAYS:
- 
-      DECLARE
-           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
- 
-           SUBTYPE SARR IS ARR (1 .. 3);
- 
-           T : SARR := (OTHERS => TRUE);
-           F : SARR := (OTHERS => FALSE);
- 
-           FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => FALSE);
-           END "XOR";
- 
-           FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => TRUE);
-           END "<=";
- 
-           FUNCTION "+" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => FALSE);
-           END "+";
- 
-           FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => TRUE);
-           END "MOD";
- 
-           FUNCTION "**" (LEFT, RIGHT : ARR) RETURN ARR IS
-           BEGIN
-                RETURN (1 .. 3 => FALSE);
-           END "**";
-      BEGIN
-           IF (F ** T <= F + T MOD T XOR T) /= (1 .. 3 => FALSE)
-              THEN
-                FAILED ("INCORRECT RESULT - 2");
-           END IF;
- 
-           IF F ** T & T /= NOT T & T OR
-              (T MOD F <= T) /= (1 .. 3 => TRUE) THEN
-                FAILED ("INCORRECT RESULT - 3");
-           END IF;
-      END;
- 
-      RESULT;
- END C44003G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c450001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c450001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c450001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c450001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,434 ****
- -- C450001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that operations on modular types perform correctly.
- --
- --     Check that loops over the range of a modular type do not over or
- --     under run the loop.
- --
- -- TEST DESCRIPTION:
- --     Check logical and arithmetic operations.
- --     (Attributes are tested elsewhere)
- --     Checks to make sure that:
- --        for X in Mod_Type loop
- --     doesn't do something silly like infinite loop.
- --
- --
- -- CHANGE HISTORY:
- --      20 SEP 95   SAIC   Initial version
- --      20 FEB 96   SAIC   Added underrun cases for 2.1
- --
- --!
- 
- ----------------------------------------------------------------- C450001_0
- 
- package C450001_0 is
- 
-   type Unsigned_8_Bit is mod 2**8;
- 
-   Shy_By_One : constant := 2**8-1;
- 
-   Heavy_By_Two : constant := 2**8+2;
- 
-   type Unsigned_Edge_8 is mod Shy_By_One;
- 
-   type Unsigned_Over_8 is mod Heavy_By_Two;
- 
-   procedure Loop_Check;
- 
-  -- embed some calls to Report.Ident_Int:
- 
-   function ID( U8B: Unsigned_8_Bit )  return Unsigned_8_Bit;
-   function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8;
-   function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8;
- 
- end C450001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C450001_0 is
- 
-   procedure Loop_Check is
-     Counter_Check : Natural := 0;
-   begin
-     for Ever in Unsigned_8_Bit loop
-       Counter_Check := Report.Ident_Int(Counter_Check) + 1;
-       if Counter_Check > 2**8 then
-         Report.Failed("Unsigned_8_Bit loop overrun");
-         exit;
-       end if;
-     end loop;
- 
-     if Counter_Check < 2**8 then
-       Report.Failed("Unsigned_8_Bit loop underrun");
-     end if;
- 
-     Counter_Check := 0;
- 
-     for Never in Unsigned_Edge_8 loop
-       Counter_Check := Report.Ident_Int(Counter_Check) + 1;
-       if Counter_Check > Shy_By_One then
-         Report.Failed("Unsigned_Edge_8 loop overrun");
-         exit;
-       end if;
-     end loop;
- 
-     if Counter_Check < Shy_By_One then
-       Report.Failed("Unsigned_Edge_8 loop underrun");
-     end if;
- 
-     Counter_Check := 0;
- 
-     for Getful in reverse Unsigned_Over_8 loop
-       Counter_Check := Report.Ident_Int(Counter_Check) + 1;
-       if Counter_Check > Heavy_By_Two then
-         Report.Failed("Unsigned_Over_8 loop overrun");
-         exit;
-       end if;
-     end loop;
- 
-     if Counter_Check < Heavy_By_Two then
-       Report.Failed("Unsigned_Over_8 loop underrun");
-     end if;
- 
-   end Loop_Check;
- 
-   function ID( U8B: Unsigned_8_Bit )  return Unsigned_8_Bit is
-   begin
-     return Unsigned_8_Bit(Report.Ident_Int(Integer(U8B)));
-   end ID;
- 
-   function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8 is
-   begin
-     return Unsigned_Edge_8(Report.Ident_Int(Integer(UEB)));
-   end ID;
- 
-   function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8 is
-   begin
-     return Unsigned_Over_8(Report.Ident_Int(Integer(UOB)));
-   end ID;
- 
- end C450001_0;
- 
- ------------------------------------------------------------------- C450001
- 
- with Report;
- with C450001_0;
- with TCTouch;
- procedure C450001 is
-   use C450001_0;
- 
-   BR : constant String := " produced the wrong result";
- 
-   procedure Is_T(B:Boolean;S:String) renames TCTouch.Assert;
-   procedure Is_F(B:Boolean;S:String) renames TCTouch.Assert_Not;
- 
-   Whole_8_A, Whole_8_B, Whole_8_C : C450001_0.Unsigned_8_Bit;
- 
-   Short_8_A, Short_8_B, Short_8_C : C450001_0.Unsigned_Edge_8;
- 
-   Over_8_A, Over_8_B, Over_8_C : C450001_0.Unsigned_Over_8;
- 
- begin  -- Main test procedure. C450001
- 
-   Report.Test ("C450001", "Check that operations on modular types " &
-                           "perform correctly." );
- 
- 
-   -- the cases for the whole 8 bit type are pretty simple
- 
-   Whole_8_A :=                             2#00000000#;
-   Whole_8_B :=                             2#11111111#;
- 
-   Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00000000#,"8 bit and" & BR);
-   Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111111#,"8 bit  or" & BR);
-   Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11111111#,"8 bit xor" & BR);
- 
-   Whole_8_A :=                             2#00001111#;
-   Whole_8_B :=                             2#11111111#;
- 
-   Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00001111#,"8 bit and" & BR);
-   Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111111#,"8 bit  or" & BR);
-   Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11110000#,"8 bit xor" & BR);
- 
-   Whole_8_A :=                             2#10101010#;
-   Whole_8_B :=                             2#11110000#;
- 
-   Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#10100000#,"8 bit and" & BR);
-   Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111010#,"8 bit  or" & BR);
-   Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#01011010#,"8 bit xor" & BR);
- 
-   -- the cases for the partial 8 bit type involve subtracting the modulus
-   -- from results that exceed the modulus.
-   -- hence, any of the following operations that exceed 2#11111110# must
-   -- have 2#11111111# subtracted from the result; i.e. where you would
-   -- expect to see 2#11111111# as in the above operations, the correct
-   -- result will be 2#00000000#.  Note that 2#11111111# is not a legal
-   -- value of type C450001_0.Unsigned_Edge_8.
- 
-   Short_8_A :=                             2#11100101#;
-   Short_8_B :=                             2#00011111#;
- 
-   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000101#,"8 short and 1" & BR);
-   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#00000000#,"8 short  or 1" & BR);
-   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#11111010#,"8 short xor 1" & BR);
- 
-   Short_8_A :=                             2#11110000#;
-   Short_8_B :=                             2#11111110#;
- 
-   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#11110000#,"8 short and 2" & BR);
-   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#11111110#,"8 short  or 2" & BR);
-   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00001110#,"8 short xor 2" & BR);
- 
-   Short_8_A :=                             2#10101010#;
-   Short_8_B :=                             2#01010101#;
- 
-   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000000#,"8 short and 3" & BR);
-   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#00000000#,"8 short  or 3" & BR);
-   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00000000#,"8 short xor 3" & BR);
- 
-   Short_8_A :=                             2#10101010#;
-   Short_8_B :=                             2#11111110#;
- 
-   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#10101010#,"8 short and 4" & BR);
-   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#11111110#,"8 short  or 4" & BR);
-   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#01010100#,"8 short xor 4" & BR);
- 
-   -- the cases for the over 8 bit type have similar issues to the short type
-   -- however the bit patterns are a little different.  The rule is to subtract
-   -- the modulus (258) from any resulting value equal or greater than the
-   -- modulus       -- note that 258 =    2#100000010#
- 
-   Over_8_A :=                            2#100000000#;
-   Over_8_B :=                            2#011111111#;
- 
-   Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000000#,"8 over and" & BR);
-   Is_T((ID(Over_8_A)  or ID(Over_8_B)) = 2#011111101#,"8 over  or" & BR);
-   Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111101#,"8 over xor" & BR);
- 
-   Over_8_A :=                            2#100000001#;
-   Over_8_B :=                            2#011111111#;
- 
-   Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000001#,"8 over and" & BR);
-   Is_T((ID(Over_8_A)  or ID(Over_8_B)) = 2#011111101#,"8 over  or" & BR);
-   Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111100#,"8 over xor" & BR);
- 
- 
- 
-   Whole_8_A := 128;
-   Whole_8_B := 255;
- 
-   Is_T(ID(Whole_8_A) /= ID(Whole_8_B), "8 /=" & BR);
-   Is_F(ID(Whole_8_A)  = ID(Whole_8_B), "8  =" & BR);
- 
-   Is_T(ID(Whole_8_A) <= ID(Whole_8_B), "8 <=" & BR);
-   Is_T(ID(Whole_8_A) <  ID(Whole_8_B), "8 < " & BR);
- 
-   Is_F(ID(Whole_8_A) >= ID(Whole_8_B), "8 >=" & BR);
-   Is_T(ID(Whole_8_A) >  ID(Whole_8_B + 7), "8 > " & BR);
- 
-   Is_T(ID(Whole_8_A)     in ID(100)..ID(200), "8 in" & BR);
-   Is_F(ID(Whole_8_A) not in ID(100)..ID(200), "8 not in" & BR);
- 
-   Is_F(ID(Whole_8_A)     in ID(200)..ID(250), "8 in" & BR);
-   Is_T(ID(Whole_8_A) not in ID(200)..ID(250), "8 not in" & BR);
- 
-   Short_8_A := 127;
-   Short_8_B := 254;
- 
-   Is_T(ID(Short_8_A) /= ID(Short_8_B), "short 8 /=" & BR);
-   Is_F(ID(Short_8_A)  = ID(Short_8_B), "short 8  =" & BR);
- 
-   Is_T(ID(Short_8_A) <= ID(Short_8_B), "short 8 <=" & BR);
-   Is_T(ID(Short_8_A) <  ID(Short_8_B), "short 8 < " & BR);
- 
-   Is_F(ID(Short_8_A) >= ID(Short_8_B), "short 8 >=" & BR);
-   Is_F(ID(Short_8_A) >  ID(Short_8_B), "short 8 > " & BR);
- 
-   Is_T(ID(Short_8_A)     in ID(100)..ID(200), "8 in" & BR);
-   Is_F(ID(Short_8_A) not in ID(100)..ID(200), "8 not in" & BR);
- 
-   Is_F(ID(Short_8_A)     in ID(200)..ID(250), "8 in" & BR);
-   Is_T(ID(Short_8_A) not in ID(200)..ID(250), "8 not in" & BR);
- 
- 
-   Whole_8_A := 1;
-   Whole_8_B := 254;
-   Short_8_A := 1;
-   Short_8_B := 2;
- 
-   Whole_8_C := ID(Whole_8_A) + ID(Whole_8_B);
-   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 1" & BR);
- 
-   Whole_8_C := Whole_8_C + ID(Whole_8_A);
-   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'First, "8 binary + 2" & BR);
- 
-   Whole_8_C := ID(Whole_8_A) - ID(Whole_8_A);
-   Is_T(Whole_8_C = 0, "8 binary -" & BR);
- 
-   Whole_8_C := Whole_8_C - ID(Whole_8_A);
-   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 3" & BR);
- 
-   Short_8_C := ID(Short_8_A) + ID(C450001_0.Unsigned_Edge_8'Last);
-   Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'First, "Short binary + 1" & BR);
- 
-   Short_8_C := Short_8_A + ID(Short_8_A);
-   Is_T(Short_8_C = ID(Short_8_B), "Short binary + 2" & BR);
- 
-   Short_8_C := ID(Short_8_A) - ID(Short_8_A);
-   Is_T(Short_8_C = 0, "Short 8 binary -" & BR);
- 
-   Short_8_C := Short_8_C - ID(Short_8_A);
-   Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short binary + 3" & BR);
- 
- 
-   Whole_8_C := ( + ID(Whole_8_B) );
-   Is_T(Whole_8_C = 254, "8 unary +" & BR);
- 
-   Whole_8_C := ( - ID(Whole_8_A) );
-   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 unary -" & BR);
- 
-   Whole_8_C := ( - ID(0) );
-   Is_T(Whole_8_C = 0, "8 unary -0" & BR);
- 
-   Short_8_C := ( + ID(C450001_0.Unsigned_Edge_8'Last) );
-   Is_T(Short_8_C = 254, "Short 8 unary +" & BR);
- 
-   Short_8_C := ( - ID(Short_8_A) );
-   Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short 8 unary -" & BR);
- 
- 
-   Whole_8_A := 20;
-   Whole_8_B := 255;
- 
-   Whole_8_C := ID(Whole_8_A) * ID(Whole_8_B); -- 5100 = 19*256 + 236 (256-20)
-   Is_T(Whole_8_C = 236, "8 *" & BR);
- 
-   Short_8_A := 9;
-   Short_8_B := 254;
- 
-   Short_8_C := ID(Short_8_A) * ID(Short_8_B); -- 2286 = 8*255 + 246 (255-9)
-   Is_T(Short_8_C = 246, "short 8 *" & BR);
- 
-   Over_8_A := 12;
-   Over_8_B := 86;
- 
-   Over_8_C := ID(Over_8_A) * ID(Over_8_B); -- 1032 = 4*258 + 0
-   Is_T(Over_8_C = 0, "over 8 *" & BR);
- 
- 
-   Whole_8_A := 255;
-   Whole_8_B := 4;
- 
-   Whole_8_C := ID(Whole_8_A) / ID(Whole_8_B);
-   Is_T(Whole_8_C = 63, "8 /" & BR);
- 
-   Short_8_A := 253;
-   Short_8_B := 127;
- 
-   Short_8_C := ID(Short_8_A) / ID(Short_8_B);
-   Is_T(Short_8_C = 1, "short 8 / 1" & BR);
- 
-   Short_8_C := ID(Short_8_A) / ID(126);
-   Is_T(Short_8_C = 2, "short 8 / 2" & BR);
- 
- 
-   Whole_8_A := 255;
-   Whole_8_B := 254;
- 
-   Whole_8_C := ID(Whole_8_A) rem ID(Whole_8_B);
-   Is_T(Whole_8_C = 1, "8 rem" & BR);
- 
-   Short_8_A := 222;
-   Short_8_B := 111;
- 
-   Short_8_C := ID(Short_8_A) rem ID(Short_8_B);
-   Is_T(Short_8_C = 0, "short 8 rem" & BR);
- 
- 
-   Whole_8_A := 99;
-   Whole_8_B := 9;
- 
-   Whole_8_C := ID(Whole_8_A) mod ID(Whole_8_B);
-   Is_T(Whole_8_C = 0, "8 mod" & BR);
- 
-   Short_8_A := 254;
-   Short_8_B := 250;
- 
-   Short_8_C := ID(Short_8_A) mod ID(Short_8_B);
-   Is_T(Short_8_C = 4, "short 8 mod" & BR);
- 
- 
-   Whole_8_A := 99;
- 
-   Whole_8_C := abs Whole_8_A;
-   Is_T(Whole_8_C = ID(99), "8 abs" & BR);
- 
-   Short_8_A := 254;
- 
-   Short_8_C := ID( abs Short_8_A );
-   Is_T(Short_8_C = 254, "short 8 abs" & BR);
- 
- 
-   Whole_8_B :=        2#00001111#;
- 
-   Whole_8_C := not Whole_8_B;
-   Is_T(Whole_8_C = ID(2#11110000#), "8 not" & BR);
- 
-   Short_8_B :=     2#00001111#;                      -- 15
- 
-   Short_8_C := ID( not Short_8_B );                  -- 254 - 15
-   Is_T(Short_8_C = 2#11101111#, "short 8 not" & BR); -- 239
- 
- 
-   Whole_8_A := 2;
- 
-   Whole_8_C := Whole_8_A ** 7;
-   Is_T(Whole_8_C = ID(128), "2 ** 7, whole 8" & BR);
- 
-   Whole_8_C := Whole_8_A ** 9;
-   Is_T(Whole_8_C = ID(0), "2 ** 9, whole 8" & BR);
- 
-   Short_8_A := 4;
- 
-   Short_8_C := ID( Short_8_A ) ** 4;
-   Is_T(Short_8_C = 1, "4 ** 4, short" & BR);
- 
-   Over_8_A := 4;
- 
-   Over_8_C := ID( Over_8_A ) ** 4;
-   Is_T(Over_8_C = 256, "4 ** 4, over" & BR);
- 
-   Over_8_C := ID( Over_8_A ) ** 5; -- 1024 = 3*258 + 250
-   Is_T(Over_8_C = 250, "4 ** 5, over" & BR);
- 
- 
-   C450001_0.Loop_Check;
- 
-   Report.Result;
- 
- end C450001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45112a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45112a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45112a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45112a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,233 ****
- -- C45112A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION 
- -- ARE THE BOUNDS OF THE LEFT OPERAND.
- 
- -- RJW 2/3/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45112A IS 
-      
-      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
-      A1 : ARR(IDENT_INT(3) .. IDENT_INT(4)) := (TRUE, FALSE);
-      A2 : ARR(IDENT_INT(1) .. IDENT_INT(2)) := (TRUE, FALSE);
-      SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
- 
-      PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
-      BEGIN
-           IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
-                FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
-           END IF;
-      END CHECK;
-      
- BEGIN
- 
-      TEST ( "C45112A", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
-                        "ARRAY OPERATIONS" );
- 
-      BEGIN
-           DECLARE
-                AAND : CONSTANT ARR := A1 AND A2;
-                AOR  : CONSTANT ARR := A1 OR A2;
-                AXOR : CONSTANT ARR := A1 XOR A2;          
-           BEGIN
-                CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ", 
-                             "'AND'" );
- 
-                CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ", 
-                             "'OR'" );
-      
-                CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ", 
-                             "'XOR'" );
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
-                         "INTIALIZATIONS" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED DURING " &
-                         "INITIALIZATIONS" );
-      END;
-                               
-      DECLARE
-           PROCEDURE PROC (A : ARR; STR : STRING) IS
-           BEGIN
-                CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY", 
-                       STR);
-           END PROC;
-      BEGIN
-           PROC ((A1 AND A2), "'AND'" );
-           PROC ((A1 OR A2), "'OR'" );
-           PROC ((A1 XOR A2), "'XOR'" );
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
-                         "PARAMETERS" );
-      END;
- 
-      DECLARE
-           FUNCTION FUNCAND RETURN ARR IS
-           BEGIN
-                RETURN A1 AND A2;
-           END FUNCAND;
- 
-           FUNCTION FUNCOR RETURN ARR IS
-           BEGIN
-                RETURN A1 OR A2;
-           END FUNCOR;
-      
-           FUNCTION FUNCXOR RETURN ARR IS
-           BEGIN
-                RETURN A1 XOR A2;
-           END FUNCXOR;
- 
-      BEGIN
-           CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
-           CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
-           CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
-      
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
-                         "FROM FUNCTION" );
-      END;
- 
-      BEGIN
-           DECLARE
-                GENERIC
-                    X : IN ARR;
-                PACKAGE PKG IS 
-                     FUNCTION G RETURN ARR;
-                END PKG;
-      
-                PACKAGE BODY PKG IS
-                     FUNCTION G RETURN ARR IS
-                     BEGIN
-                          RETURN X;
-                     END G;
-                END PKG;
-                          
-                PACKAGE PAND IS NEW PKG(X => A1 AND A2);
-                PACKAGE POR IS NEW PKG(X => A1 OR A2);
-                PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
-           BEGIN
-                CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
-                CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
-                CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING GENERIC " &
-                         "INSTANTIATION" );
-      END;
- 
-      DECLARE
-           TYPE ACC IS ACCESS ARR;
-           AC : ACC;
-                
-      BEGIN
-           AC :=  NEW ARR'(A1 AND A2);
-           CHECK (AC.ALL, "ALLOCATION", "'AND'");
-           AC :=  NEW ARR'(A1 OR A2);
-           CHECK (AC.ALL, "ALLOCATION", "'OR'");
-           AC :=  NEW ARR'(A1 XOR A2);
-           CHECK (AC.ALL, "ALLOCATION", "'XOR'");
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
-      END;
- 
-      BEGIN
-           CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
-           CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
-           CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
-      END;
-                
-      DECLARE
-           TYPE REC IS
-                RECORD
-                     RCA : CARR;
-                END RECORD;
-           R1 : REC;
- 
-      BEGIN
-           R1 := (RCA => (A1 AND A2));
-           CHECK (R1.RCA, "AGGREGATE", "'AND'");
-           R1 := (RCA => (A1 OR A2));
-           CHECK (R1.RCA, "AGGREGATE", "'OR'");
-           R1 := (RCA => (A1 XOR A2));
-           CHECK (R1.RCA, "AGGREGATE", "'XOR'");
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
-      END;
-                     
-      BEGIN
-           DECLARE
-                TYPE RECDEF IS
-                     RECORD
-                          RCDF1 : CARR := A1 AND A2;
-                          RCDF2 : CARR := A1 OR A2;
-                          RCDF3 : CARR := A1 XOR A2;
-                     END RECORD;
-                RD : RECDEF;
-           BEGIN
-                CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
-                CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
-                CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
-                         "DEFAULT RECORD" );
-      END;
-                
-      DECLARE 
-           PROCEDURE PDEF (X : CARR := A1 AND A2; 
-                           Y : CARR := A1 OR A2; 
-                           Z : CARR := A1 XOR A2 ) IS
-           BEGIN
-                CHECK (X, "DEFAULT PARAMETER", "'AND'");
-                CHECK (Y, "DEFAULT PARAMETER", "'OR'");
-                CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
-           END PDEF;
-      
-      BEGIN
-           PDEF;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
-      END;
- 
-      RESULT;
- 
- END C45112A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45112b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45112b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45112b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45112b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- C45112B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION 
- -- ARE THE BOUNDS OF THE LEFT OPERAND WHEN THE OPERANDS ARE NULL 
- -- ARRAYS.
- 
- -- RJW 2/3/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45112B IS 
-      
-      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
-      A1 : ARR(IDENT_INT(4) .. IDENT_INT(3));
-      A2 : ARR(IDENT_INT(2) .. IDENT_INT(1));
-      SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
- 
-      PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
-      BEGIN
-           IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
-                FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
-           END IF;
-      END CHECK;
-      
- BEGIN
- 
-      TEST ( "C45112B", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
-                        "ARRAY OPERATIONS ON NULL ARRAYS" );
- 
-      BEGIN
-           DECLARE
-                AAND : CONSTANT ARR := A1 AND A2;
-                AOR  : CONSTANT ARR := A1 OR A2;
-                AXOR : CONSTANT ARR := A1 XOR A2;          
-           BEGIN
-                CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ", 
-                             "'AND'" );
- 
-                CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ", 
-                             "'OR'" );
-      
-                CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ", 
-                             "'XOR'" );
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
-                         "INTIALIZATIONS" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED DURING " &
-                         "INITIALIZATIONS" );
-      END;
-                               
-      DECLARE
-           PROCEDURE PROC (A : ARR; STR : STRING) IS
-           BEGIN
-                CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY", 
-                       STR);
-           END PROC;
-      BEGIN
-           PROC ((A1 AND A2), "'AND'" );
-           PROC ((A1 OR A2), "'OR'" );
-           PROC ((A1 XOR A2), "'XOR'" );
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
-                         "PARAMETERS" );
-      END;
- 
-      DECLARE
-           FUNCTION FUNCAND RETURN ARR IS
-           BEGIN
-                RETURN A1 AND A2;
-           END FUNCAND;
- 
-           FUNCTION FUNCOR RETURN ARR IS
-           BEGIN
-                RETURN A1 OR A2;
-           END FUNCOR;
-      
-           FUNCTION FUNCXOR RETURN ARR IS
-           BEGIN
-                RETURN A1 XOR A2;
-           END FUNCXOR;
- 
-      BEGIN
-           CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
-           CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
-           CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
-      
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
-                         "FROM FUNCTION" );
-      END;
- 
-      BEGIN
-           DECLARE
-                GENERIC
-                    X : IN ARR;
-                PACKAGE PKG IS 
-                     FUNCTION G RETURN ARR;
-                END PKG;
-      
-                PACKAGE BODY PKG IS
-                     FUNCTION G RETURN ARR IS
-                     BEGIN
-                          RETURN X;
-                     END G;
-                END PKG;
-                          
-                PACKAGE PAND IS NEW PKG(X => A1 AND A2);
-                PACKAGE POR IS NEW PKG(X => A1 OR A2);
-                PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
-           BEGIN
-                CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
-                CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
-                CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING GENERIC " &
-                         "INSTANTIATION" );
-      END;
- 
-      DECLARE
-           TYPE ACC IS ACCESS ARR;
-           AC : ACC;
-                
-      BEGIN
-           AC :=  NEW ARR'(A1 AND A2);
-           CHECK (AC.ALL, "ALLOCATION", "'AND'");
-           AC :=  NEW ARR'(A1 OR A2);
-           CHECK (AC.ALL, "ALLOCATION", "'OR'");
-           AC :=  NEW ARR'(A1 XOR A2);
-           CHECK (AC.ALL, "ALLOCATION", "'XOR'");
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
-      END;
- 
-      BEGIN
-           CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
-           CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
-           CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
-      END;
-                
-      DECLARE
-           TYPE REC IS
-                RECORD
-                     RCA : CARR;
-                END RECORD;
-           R1 : REC;
- 
-      BEGIN
-           R1 := (RCA => (A1 AND A2));
-           CHECK (R1.RCA, "AGGREGATE", "'AND'");
-           R1 := (RCA => (A1 OR A2));
-           CHECK (R1.RCA, "AGGREGATE", "'OR'");
-           R1 := (RCA => (A1 XOR A2));
-           CHECK (R1.RCA, "AGGREGATE", "'XOR'");
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
-      END;
-                     
-      BEGIN
-           DECLARE
-                TYPE RECDEF IS
-                     RECORD
-                          RCDF1 : CARR := A1 AND A2;
-                          RCDF2 : CARR := A1 OR A2;
-                          RCDF3 : CARR := A1 XOR A2;
-                     END RECORD;
-                RD : RECDEF;
-           BEGIN
-                CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
-                CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
-                CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
-           EXCEPTION
-                WHEN OTHERS => 
-                     FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
-                         "DEFAULT RECORD" );
-      END;
-                
-      DECLARE 
-           PROCEDURE PDEF (X : CARR := A1 AND A2; 
-                           Y : CARR := A1 OR A2; 
-                           Z : CARR := A1 XOR A2 ) IS
-           BEGIN
-                CHECK (X, "DEFAULT PARAMETER", "'AND'");
-                CHECK (Y, "DEFAULT PARAMETER", "'OR'");
-                CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
-           END PDEF;
-      
-      BEGIN
-           PDEF;
-      EXCEPTION
-           WHEN OTHERS => 
-                FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
-      END;
- 
-      RESULT;
- 
- END C45112B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45113a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45113a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45113a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C45113A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE OPERANDS OF LOGICAL
- -- OPERATORS HAVE DIFFERENT LENGTHS.
- 
- -- RJW  1/15/86
- 
- WITH REPORT; USE REPORT; 
- 
- PROCEDURE C45113A IS
- 
- BEGIN
- 
-      TEST( "C45113A" , "CHECK ON LOGICAL OPERATORS WITH " &
-                        "OPERANDS OF DIFFERENT LENGTHS" );
-      
-      DECLARE
- 
-           TYPE ARR IS ARRAY ( INTEGER RANGE <> ) OF BOOLEAN;
-      
-           A : ARR( IDENT_INT(1) .. IDENT_INT(2) ) := ( TRUE, FALSE );
-           B : ARR( IDENT_INT(1) .. IDENT_INT(3) ) := ( TRUE, FALSE, 
-                                                        TRUE );
- 
-      BEGIN
- 
-           BEGIN -- TEST FOR 'AND'.
-                IF (A AND B) = B THEN
-                     FAILED ( "A AND B = B" );
-                END IF;
-                FAILED ( "NO EXCEPTION RAISED FOR 'AND'" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR 'AND'" );
-           END;           
- 
- 
-           BEGIN -- TEST FOR 'OR'.
-                IF (A OR B) = B THEN
-                     FAILED ( "A OR B = B" );
-                END IF;
-                FAILED ( "NO EXCEPTION RAISED FOR 'OR'" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR 'OR'" );
-           END;           
- 
- 
-           BEGIN -- TEST FOR 'XOR'.
-                IF (A XOR B) = B THEN
-                     FAILED ( "A XOR B = B" );
-                END IF;
-                FAILED ( "NO EXCEPTION RAISED FOR 'XOR'" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR 'XOR'" );
-           END;           
- 
-      END;
- 
-      RESULT;
- 
- END C45113A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45114b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45114b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45114b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45114b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C45114B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LOGICAL OPERATORS ARE DEFINED FOR PACKED BOOLEAN ARRAYS.
- 
- --  RJW  1/17/86
- 
- WITH  REPORT; USE REPORT;
- PROCEDURE  C45114B  IS
- 
- BEGIN
- 
-      TEST( "C45114B" , "CHECK THAT LOGICAL OPERATORS ARE DEFINED " &
-                        "FOR PACKED BOOLEAN ARRAYS" );
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (1 .. 32) OF BOOLEAN;
- 
-           PRAGMA PACK (ARR);
- 
-           A : ARR := ( TRUE, TRUE, FALSE, FALSE, OTHERS => TRUE );
-           B : ARR := ( TRUE, FALSE, TRUE, FALSE, OTHERS => FALSE );
- 
-           A_AND_B : ARR := ( TRUE, OTHERS => FALSE );
-           A_OR_B  : ARR := ARR'( 4 => FALSE, OTHERS => TRUE );
-           A_XOR_B : ARR := ARR'( 1|4 => FALSE, OTHERS => TRUE );
-           NOT_A   : ARR := ARR'( 3|4 => TRUE, OTHERS => FALSE );
- 
-      BEGIN
- 
-           IF ( A AND B ) /= A_AND_B THEN
-                FAILED ( "'AND' NOT CORRECTLY DEFINED" );
-           END IF;
- 
-           IF ( A OR B ) /= A_OR_B THEN
-                FAILED ( "'OR' NOT CORRECTLY DEFINED" );
-           END IF;
- 
-           IF ( A XOR B ) /= A_XOR_B THEN
-                FAILED ( "'XOR' NOT CORRECTLY DEFINED" );
-           END IF;
- 
-           IF NOT A /= NOT_A THEN
-                FAILED ( "'NOT' NOT CORRECTLY DEFINED" );
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45114B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c452001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c452001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c452001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c452001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,707 ****
- -- C452001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      For a type extension, check that predefined equality is defined in
- --      terms of the primitive equals operator of the parent type and any
- --      tagged components of the extension part.
- --
- --      For other composite types, check that the primitive equality operator
- --      of any matching tagged components is used to determine equality of the
- --      enclosing type.
- --
- --      For private types, check that predefined equality is defined in
- --      terms of the user-defined (primitive) operator of the full type if
- --      the full type is tagged. The partial view of the type may be
- --      tagged or untagged. Check that predefined equality for a private
- --      type whose full view is untagged is defined in terms of the
- --      predefined equality operator of its full type.
- --
- -- TEST DESCRIPTION:
- --      Tagged types are declared and used as components in several
- --      differing composite type declarations, both tagged and untagged.
- --      To differentiate between predefined and primitive equality
- --      operations, user-defined equality operators are declared for
- --      each component type that is to contribute to the equality
- --      operator of the composite type that houses it. All user-defined
- --      equality operations are designed to yield the opposite result
- --      from the predefined operator, given the same component values.
- --
- --      For cases where primitive equality is to be incorporated into
- --      equality for the enclosing composite type, values are assigned
- --      to the component type so that user-defined equality will return
- --      True. If predefined equality is to be used instead, then the
- --      same strategy results in the equality operator returning False.
- --
- --      When equality for a type incorporates the user-defined equality
- --      operator of one of its component types, the resulting operator
- --      is considered to be the predefined operator of the composite type.
- --      This case is confirmed by defining an tagged component of an
- --      untagged composite type, then using the resulting untagged type
- --      as a component of another composite type. The user-defined operator
- --      for the lowest level should still be called.
- --
- --      Three cases are set up to test private types:
- --
- --                        Case 1        Case 2      Case 3
- --         partial view:  tagged       untagged    untagged
- --         full view:     tagged        tagged     untagged
- --
- --      Types are declared for each of the above cases and user-defined
- --      (primitive) operators are declared following the full type
- --      declaration of each type (i.e., in the private part).
- --
- --      Values are assigned into objects of these types using the same
- --      strategy outlined above. Cases 1 and 2 should execute the
- --      user-defined operator. Case 3 should ignore the user-defined
- --      operator and user predefined equality for the type.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Removed RM references from objective text.
- --      15 Nov 95   SAIC    Fixed for 2.0.1
- --      04 NOV 96   SAIC    Typographical revision
- --
- --!
- 
- package c452001_0 is
- 
-    type Point is
-       record
-          X : Integer := 0;
-          Y : Integer := 0;
-       end record;
- 
-    type Circle is tagged
-       record
-          Center : Point;
-          Radius : Integer;
-       end record;
- 
-    function "=" (L, R : Circle) return Boolean;
- 
-    type Colors is (Red, Orange, Yellow, Green, Blue, Purple, Black, White);
- 
-    type Colored_Circle is new Circle
-       with record
-          Color : Colors := White;
-       end record;
- 
-    function "=" (L, R : Colored_Circle) return Boolean;
-    -- Override predefined equality for this tagged type. Predefined
-    -- equality should incorporate user-defined (primitive) equality
-    -- from type Circle. See C340001 for a test of that feature.
- 
-    -- Equality is overridden to ensure that predefined equality 
-    -- incorporates this user-defined function for
-    -- any composite type with Colored_Circle as a component type.
-    -- (i.e., the type extension is recognized as a tagged type for
-    -- the purpose of defining predefined equality for the composite type).
- 
- end C452001_0;
- 
- package body c452001_0 is
- 
-    function "=" (L, R : Circle) return Boolean is
-    begin
-       return L.Radius = R.Radius; -- circles are same size
-    end "=";
- 
-    function "=" (L, R : Colored_Circle) return Boolean is
-    begin
-       return Circle(L) = Circle(R);
-    end "=";
- 
- end C452001_0;
- 
- with C452001_0;
- package C452001_1 is
- 
-    type Planet is tagged record
-       Name : String (1..15);
-       Representation : C452001_0.Colored_Circle;
-    end record;
- 
-    -- Type Planet will be used to check that predefined equality
-    -- for a tagged type with a tagged component incorporates
-    -- user-defined equality for the component type.
- 
-    type TC_Planet is new Planet with null record;
- 
-    -- A "copy" of Planet. Used to create a type extension. An "="
-    -- operator will be defined for this type that should be
-    -- incorporated by the type extension.
- 
-    function "=" (Arg1, Arg2 : in TC_Planet) return Boolean;
- 
-    type Craters is array (1..3) of C452001_0.Colored_Circle;
- 
-    -- An array type (untagged) with tagged components
- 
-    type Moon is new TC_Planet
-      with record
-         Crater : Craters;
-      end record;
-      
-    -- A tagged record type. Extended component type is untagged,
-    -- but its predefined equality operator should incorporate
-    -- the user-defined operator of its tagged component type.
- 
- end C452001_1;
- 
- package body C452001_1 is
- 
-    function "=" (Arg1, Arg2 : in TC_Planet) return Boolean is
-    begin
-       return Arg1.Name = Arg2.Name;
-    end "=";
- 
- end C452001_1;
- 
- package C452001_2 is
- 
-    -- Untagged record types
-    -- Equality should not be incorporated
- 
-    type Spacecraft_Design is (Mariner, Pioneer, Viking, Voyager);
-    type Spacecraft is record
-      Design      : Spacecraft_Design;
-      Operational : Boolean;
-    end record;
- 
-    function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean;
- 
-    type Mission is record
-       Craft       : Spacecraft;
-       Launch_Date : Natural;
-    end record;
- 
-    type Inventory is array (Positive range <>) of Spacecraft;
- 
- end C452001_2;
- 
- package body C452001_2 is
- 
-    function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean is
-    begin
-       return L.Design = R.Design;
-    end "=";
- 
- end C452001_2;
- 
- package C452001_3 is
- 
-    type Tagged_Partial_Tagged_Full is tagged private;
-    procedure Change (Object : in out Tagged_Partial_Tagged_Full;
-                     Value  : in Boolean);
- 
-    type Untagged_Partial_Tagged_Full is private;
-    procedure Change (Object : in out Untagged_Partial_Tagged_Full;
-                     Value  : in Integer);
- 
-    type Untagged_Partial_Untagged_Full is private;
-    procedure Change (Object : in out Untagged_Partial_Untagged_Full;
-                     Value  : in Duration);
- 
- private
- 
-    type Tagged_Partial_Tagged_Full is
-       tagged record
-          B : Boolean := True;
-          C : Character := ' ';
-       end record;
-    -- predefined equality checks that all components are equal
- 
-    function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean;
-    -- primitive equality checks that records equate in component C only
- 
-    type Untagged_Partial_Tagged_Full is
-       tagged record
-          I : Integer := 0;
-          P : Positive := 1;
-       end record;
-    -- predefined equality checks that all components are equal
- 
-    function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean;
-    -- primitive equality checks that records equate in component P only
- 
-    type Untagged_Partial_Untagged_Full is
-       record
-          D : Duration := 0.0;
-          S : String (1..12) := "Ada 9X rules";
-       end record;
-    -- predefined equality checks that all components are equal
- 
-    function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean;
-    -- primitive equality checks that records equate in component S only
- 
- end C452001_3;
-    
- with Report;
- package body C452001_3 is
- 
-    procedure Change (Object : in out Tagged_Partial_Tagged_Full;
-                     Value  : in Boolean) is
-    begin
-       Object := (Report.Ident_Bool(Value), Object.C);
-    end Change;
- 
-    procedure Change (Object : in out Untagged_Partial_Tagged_Full;
-                     Value  : in Integer) is
-    begin
-       Object := (Report.Ident_Int(Value), Object.P);
-    end Change;
- 
-    procedure Change (Object : in out Untagged_Partial_Untagged_Full;
-                     Value  : in Duration) is
-    begin
-       Object := (Value, Report.Ident_Str(Object.S));
-    end Change;
- 
-    function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean is
-    begin
-       return L.C = R.C;
-    end "=";
- 
-    function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean is
-    begin
-       return L.P = R.P;
-    end "=";
- 
-    function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean is
-    begin
-       return R.S = L.S;
-    end "=";
- 
- end C452001_3;
- 
- 
- with C452001_0;
- with C452001_1;
- with C452001_2;
- with C452001_3;
- with Report;
- procedure C452001 is
- 
-    Mars_Aphelion : C452001_1.Planet :=
-       (Name           => "Mars           ",
-        Representation => (Center => (Report.Ident_Int(20),
-                                      Report.Ident_Int(0)),
-                           Radius => Report.Ident_Int(4),
-                           Color  => C452001_0.Red));
- 
-    Mars_Perihelion : C452001_1.Planet :=
-       (Name           => "Mars           ",
-        Representation => (Center => (Report.Ident_Int(-20),
-                                      Report.Ident_Int(0)),
-                           Radius => Report.Ident_Int(4),
-                           Color  => C452001_0.Red));
- 
-    -- Mars_Perihelion = Mars_Aphelion if user-defined equality from
-    -- the tagged type Colored_Circle was incorporated into
-    -- predefined equality for the tagged type Planet. User-defined
-    -- equality for Colored_Circle checks only that the Radii are equal.
- 
-    Blue_Mars : C452001_1.Planet :=
-       (Name           => "Mars           ",
-        Representation => (Center => (Report.Ident_Int(10),
-                                      Report.Ident_Int(10)),
-                           Radius => Report.Ident_Int(4),
-                           Color  => C452001_0.Blue));
- 
-    -- Blue_Mars should equal Mars_Perihelion, because Names and
-    -- Radii are equal (all other components are not).
- 
-    Green_Mars : C452001_1.Planet :=
-       (Name           => "Mars           ",
-        Representation => (Center => (Report.Ident_Int(10),
-                                      Report.Ident_Int(10)),
-                           Radius => Report.Ident_Int(4),
-                           Color  => C452001_0.Green));
- 
-    -- Blue_Mars should equal Green_Mars. They differ only in the
-    -- Color component. All user-defined equality operations return
-    -- True, but records are not equal by predefined equality.
- 
-    -- Blue_Mars should equal Mars_Perihelion, because Names and
-    -- Radii are equal (all other components are not).
- 
-    Moon_Craters : C452001_1.Craters :=
-       ((Center => (Report.Ident_Int(9), Report.Ident_Int(11)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Black),
-        (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Black),
-        (Center => (Report.Ident_Int(11), Report.Ident_Int(9)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Black));
- 
-    Alternate_Moon_Craters : C452001_1.Craters :=
-       ((Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Yellow),
-        (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Purple),
-        (Center => (Report.Ident_Int(11), Report.Ident_Int(11)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Purple));
- 
-    -- Moon_Craters = Alternate_Moon_Craters if user-defined equality from
-    -- the tagged type Colored_Circle was incorporated into
-    -- predefined equality for the untagged type Craters. User-defined
-    -- equality checks only that the Radii are equal.
- 
-    New_Moon : C452001_1.Moon := 
-       (Name           => "Moon           ",
-        Representation => (Center => (Report.Ident_Int(10),
-                                      Report.Ident_Int(8)),
-                           Radius => Report.Ident_Int(3),
-                           Color  => C452001_0.Black),
-        Crater         => Moon_Craters);
- 
-    Full_Moon : C452001_1.Moon := 
-       (Name           => "Moon           ",
-        Representation => (Center => (Report.Ident_Int(10),
-                                      Report.Ident_Int(8)),
-                           Radius => Report.Ident_Int(3),
-                           Color  => C452001_0.Black),
-        Crater         => Alternate_Moon_Craters);
- 
-    -- New_Moon = Full_Moon if user-defined equality from
-    -- the tagged type Colored_Circle was incorporated into
-    -- predefined equality for the untagged type Craters. This
-    -- equality test should call user-defined equality for type
-    -- TC_Planet (checks that Names are equal), then predefined
-    -- equality for Craters (ultimately calls user-defined equality
-    -- for type Circle, checking that Radii of craters are equal).
- 
-    Mars_Moon : C452001_1.Moon := 
-       (Name           => "Phobos         ",
-        Representation => (Center => (Report.Ident_Int(10),
-                                      Report.Ident_Int(8)),
-                           Radius => Report.Ident_Int(3),
-                           Color  => C452001_0.Black),
-        Crater         => Alternate_Moon_Craters);
- 
-    -- Mars_Moon /= Full_Moon since the Names differ.
- 
-    Alternate_Moon_Craters_2 : C452001_1.Craters :=
-       ((Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Red),
-        (Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Red),
-        (Center => (Report.Ident_Int(10), Report.Ident_Int(9)),
-         Radius => Report.Ident_Int(1),
-         Color  => C452001_0.Red));
- 
-    Harvest_Moon : C452001_1.Moon := 
-       (Name           => "Moon           ",
-        Representation => (Center => (Report.Ident_Int(11),
-                                      Report.Ident_Int(7)),
-                           Radius => Report.Ident_Int(4),
-                           Color  => C452001_0.Orange),
-        Crater         => Alternate_Moon_Craters_2);
- 
-    -- Only the fields that are employed by the user-defined equality
-    -- operators are the same. Everything else differs. Equality should
-    -- still return True.
- 
-    Viking_1_Orbiter : C452001_2.Mission :=
-       (Craft => (Design      => C452001_2.Viking,
-                  Operational => Report.Ident_Bool(False)),
-        Launch_Date => 1975);
- 
-    Viking_1_Lander : C452001_2.Mission :=
-       (Craft => (Design      => C452001_2.Viking,
-                  Operational => Report.Ident_Bool(True)),
-        Launch_Date => 1975);
- 
-    -- Viking_1_Orbiter /= Viking_1_Lander if predefined equality
-    -- from the untagged type Spacecraft is used for equality
-    -- of matching components in type Mission. If user-defined
-    -- equality for type Spacecraft is incorporated, which it
-    -- should not be by 4.5.2(21), then Viking_1_Orbiter = Viking_1_Lander.
-    
-    Voyagers : C452001_2.Inventory (1..2):=
-     ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
-      (C452001_2.Voyager, Operational => Report.Ident_Bool(False)));
- 
-    Jupiter_Craft : C452001_2.Inventory (1..2):=
-     ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
-      (C452001_2.Voyager, Operational => Report.Ident_Bool(True)));
-    
-    -- Voyagers /= Jupiter_Craft if predefined equality
-    -- from the untagged type Spacecraft is used for equality
-    -- of matching components in type Inventory. If user-defined
-    -- equality for type Spacecraft is incorporated, which it
-    -- should not be by 4.5.2(21), then Voyagers = Jupiter_Craft.
- 
-    TPTF_1 : C452001_3.Tagged_Partial_Tagged_Full;
-    TPTF_2 : C452001_3.Tagged_Partial_Tagged_Full;
-    
-    -- With differing values for Boolean component, user-defined
-    -- (primitive) equality returns True, predefined equality
-    -- returns False. Since full type is tagged, primitive equality
-    -- should be used.
- 
-    UPTF_1 : C452001_3.Untagged_Partial_Tagged_Full;
-    UPTF_2 : C452001_3.Untagged_Partial_Tagged_Full;
- 
-    -- With differing values for Boolean component, user-defined
-    -- (primitive) equality returns True, predefined equality
-    -- returns False. Since full type is tagged, primitive equality
-    -- should be used.
- 
-    UPUF_1 : C452001_3.Untagged_Partial_Untagged_Full;
-    UPUF_2 : C452001_3.Untagged_Partial_Untagged_Full;
- 
-    -- With differing values for Duration component, user-defined
-    -- (primitive) equality returns True, predefined equality
-    -- returns False. Since full type is untagged, predefined equality
-    -- should be used.
- 
-    -- Use type clauses make "=" and "/=" operators directly visible
-    use type C452001_1.Planet;
-    use type C452001_1.Craters;
-    use type C452001_1.Moon;
-    use type C452001_2.Mission;
-    use type C452001_2.Inventory;
-    use type C452001_3.Tagged_Partial_Tagged_Full;
-    use type C452001_3.Untagged_Partial_Tagged_Full;
-    use type C452001_3.Untagged_Partial_Untagged_Full;
- 
- begin
- 
-    Report.Test ("C452001", "Equality of private types and " &
-                            "composite types with tagged components");
- 
-    -------------------------------------------------------------------
-    -- Tagged type with tagged component.
-    -------------------------------------------------------------------
- 
-    if not (Mars_Aphelion = Mars_Perihelion) then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined equality " &
-                      "for enclosing tagged record type");
-    end if;
- 
-    if Mars_Aphelion /= Mars_Perihelion then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined inequality " &
-                      "for enclosing tagged record type");
-    end if;
- 
-    if not (Blue_Mars = Mars_Perihelion) then
-       Report.Failed ("Equality test for tagged record type " &
-                      "incorporates record components " &
-                      "other than those used by user-defined equality");
-    end if;
- 
-    if Blue_Mars /= Mars_Perihelion then
-       Report.Failed ("Inequality test for tagged record type " &
-                      "incorporates record components " &
-                      "other than those used by user-defined equality");
-    end if;
- 
-    if Blue_Mars /= Green_Mars then
-       Report.Failed ("Records are unequal even though they only differ " &
-                      "in a component not used by user-defined equality");
-    end if;
- 
-    if not (Blue_Mars = Green_Mars) then
-       Report.Failed ("Records are not equal even though they only differ " &
-                      "in a component not used by user-defined equality");
-    end if;
- 
-    -------------------------------------------------------------------
-    -- Untagged (array) type with tagged component.
-    -------------------------------------------------------------------
- 
-    if not (Moon_Craters = Alternate_Moon_Craters) then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined equality " &
-                      "for enclosing array type");
-    end if;
- 
-    if Moon_Craters /= Alternate_Moon_Craters then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined inequality " &
-                      "for enclosing array type");
-    end if;
- 
-    -------------------------------------------------------------------
-    -- Tagged type with untagged composite component. Untagged
-    -- component itself has tagged components.
-    -------------------------------------------------------------------
-    if not (New_Moon = Full_Moon) then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined equality " &
-                      "for array component of tagged record type");
-    end if;
- 
-    if New_Moon /= Full_Moon then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined inequality " &
-                      "for array component of tagged record type");
-    end if;
- 
-    if Mars_Moon = Full_Moon then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined equality " &
-                      "for array component of tagged record type");
-    end if;
- 
-    if not (Mars_Moon /= Full_Moon) then
-       Report.Failed ("User-defined equality for tagged component " &
-                      "was not incorporated into predefined inequality " &
-                      "for array component of tagged record type");
-    end if;
- 
-    if not (Harvest_Moon = Full_Moon) then
-       Report.Failed ("Equality test for record with array of tagged " &
-                      "components incorporates record components " &
-                      "other than those used by user-defined equality");
-    end if;
- 
-    if Harvest_Moon /= Full_Moon then
-       Report.Failed ("Inequality test for record with array of tagged " &
-                      "components incorporates record components " &
-                      "other than those used by user-defined equality");
-    end if;
- 
-    -------------------------------------------------------------------
-    -- Untagged types with no tagged components.
-    -------------------------------------------------------------------
- 
-    -- Record type
- 
-    if Viking_1_Orbiter = Viking_1_Lander then
-       Report.Failed ("User-defined equality for untagged composite " &
-                      "component was incorporated into predefined " &
-                      "equality for " &
-                      "untagged record type");
-    end if;
- 
-    if not (Viking_1_Orbiter /= Viking_1_Lander) then
-       Report.Failed ("User-defined equality for untagged composite " &
-                      "component was incorporated into predefined " &
-                      "inequality for " &
-                      "untagged record type");
-    end if;
- 
-    -- Array type
-    
-    if Voyagers = Jupiter_Craft then
-       Report.Failed ("User-defined equality for untagged composite " &
-                      "component was incorporated into predefined " &
-                      "equality for " &
-                      "array type");
-    end if;
- 
-    if not (Voyagers /= Jupiter_Craft) then
-       Report.Failed ("User-defined equality for untagged composite " &
-                      "component was incorporated into predefined " &
-                      "inequality for " &
-                      "array type");
-    end if;
- 
-    -------------------------------------------------------------------
-    -- Private types tests.
-    -------------------------------------------------------------------
- 
-    -- Make objects differ from one another
- 
-    C452001_3.Change (TPTF_1, False);
-    C452001_3.Change (UPTF_1, 999);
-    C452001_3.Change (UPUF_1, 40.0);
- 
-    -------------------------------------------------------------------
-    -- Partial type and full type are tagged. (Full type must be tagged
-    -- if partial type is tagged)
-    -------------------------------------------------------------------
- 
-    if not (TPTF_1 = TPTF_2) then
-       Report.Failed ("Predefined equality for full type " &
-                      "was used to determine equality of " &
-                      "tagged private type " &
-                      "instead of user-defined (primitive) equality");
-    end if;
- 
-    if TPTF_1 /= TPTF_2 then
-       Report.Failed ("Predefined equality for full type " &
-                      "was used to determine inequality of " &
-                      "tagged private type " &
-                      "instead of user-defined (primitive) equality");
-    end if;
- 
-    -------------------------------------------------------------------
-    -- Partial type untagged, full type tagged.
-    -------------------------------------------------------------------
- 
-    if not (UPTF_1 = UPTF_2) then
-       Report.Failed ("Predefined equality for full type " &
-                      "was used to determine equality of " &
-                      "private type (untagged partial view, " &
-                      "tagged full view) " &
-                      "instead of user-defined (primitive) equality");
-    end if;
- 
-    if UPTF_1 /= UPTF_2 then
-       Report.Failed ("Predefined equality for full type " &
-                      "was used to determine inequality of " &
-                      "private type (untagged partial view, " &
-                      "tagged full view) " &
-                      "instead of user-defined (primitive) equality");
-    end if;
- 
-    -------------------------------------------------------------------
-    -- Partial type and full type are both untagged.
-    -------------------------------------------------------------------
- 
-    if UPUF_1 = UPUF_2 then
-       Report.Failed ("User-defined (primitive) equality for full type " &
-                      "was used to determine equality of " &
-                      "private type (untagged partial view, " &
-                      "untagged full view) " &
-                      "instead of predefined equality");
-    end if;
- 
-    if not (UPUF_1 /= UPUF_2) then
-       Report.Failed ("User-defined (primitive) equality for full type " &
-                      "was used to determine inequality of " &
-                      "private type (untagged partial view, " &
-                      "untagged full view) " &
-                      "instead of predefined equality");
-    end if;
- 
-    -------------------------------------------------------------------
-    Report.Result;
- 
- end C452001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45201a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45201a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45201a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,242 ****
- -- C45201A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
- --    ENUMERATION-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
- --    DIFFERENT SUBTYPES).
- 
- -- THIS TEST'S FRAMEWORK IS FROM  C45201B.ADA , C45210A.ADA .
- 
- 
- -- RM    20 OCTOBER 1980
- -- JWC 7/8/85   RENAMED TO -AB
- 
- 
- WITH  REPORT ;
- PROCEDURE  C45201A  IS
- 
-      USE REPORT;
- 
-      TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
- 
-      --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
-      --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
- 
-      SUBTYPE  T1  IS  T RANGE A..B ;
-      SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
-      SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
-      SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
- 
-      MVAR  : T3 := T'(NUL ) ;
-      PVAR  : T2 := T'(PLIT) ;
-      RVAR  : T4 := T'('R' ) ;
-      SVAR  : T1 := T'(SLIT) ;
- 
-      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT + 1 ;
-      END BUMP ;
- 
-      FUNCTION  ITSELF( THE_ARGUMENT : T )  RETURN  T  IS
-      BEGIN
-           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
-           ELSE  RETURN  A ;
-           END IF;
-      END ;
- 
- 
- BEGIN
- 
-      TEST( "C45201A" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
-                        " RESULTS ON ENUMERATION-TYPE LITERALS" ) ;
- 
-      -- 128 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
-      --             2 (4)  OPERATORS (2, TWICE): '=' , '/=' , '=' , '/='
-      --                          (IN THE TABLE:   A  ,  B   ,  C  ,  D )
-      --                          (C45201B.ADA HAD  < <= > >= ; REVERSED)
-      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
-      --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
-      --                         (IN THE TABLE:  VV = ALPHA ,
-      --                                         VL = BETA  ,
-      --                                         LV = GAMMA ,
-      --                                         LL = DELTA  ) RANDOMIZED
-      --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
-      --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
- 
-      --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
-      --         LEFT
-      --       OPERAND:
- 
-      --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
-      --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
-      --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
-      --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
- 
-      --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
-      --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
- 
-      -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
-      --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
-      --    ( VV , ALPHA ) FOR BOTH OPERATORS.
- 
-     -----------------------------------------------------------------
- 
-      -- PART 1
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
- 
-      IF  T'(SVAR) =  T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(SVAR) /= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(SLIT) =  T'(MVAR)  THEN  BUMP ;               END IF;
-      IF  T'(SLIT) /= T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
- 
-      IF  T'(PLIT) =  T'(SLIT)  THEN  BUMP ;               END IF;
-      IF  T'(PLIT) /= T'(PVAR)  THEN  BUMP ;               END IF;
-      IF  T'(PVAR) =  T'(NUL )  THEN  BUMP ;               END IF;
-      IF  T'(PVAR) /= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
- 
-      IF  T'(MVAR) /= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(MVAR) =  T'(PVAR)  THEN  BUMP ;               END IF;
-      IF  T'(NUL ) /= T'(NUL )  THEN  BUMP ;               END IF;
-      IF  T'(NUL ) =  T'(RVAR)  THEN  BUMP ;               END IF;
- 
-      IF  T'('R' ) /= T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'('R' ) =  T'(PLIT)  THEN  BUMP ;               END IF;
-      IF  T'(RVAR) /= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(RVAR) =  T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
- 
- 
-      IF  ERROR_COUNT /= 0  THEN
-           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE1" );
-      END IF;
- 
-     -----------------------------------------------------------------
- 
-      -- PART 2
- 
-      --  'BUMP'  STILL MEANS  'BUMP THE ERROR COUNT'
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
-           FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
- 
-                IF  AVAR  = BVAR  THEN
-                     IF  AVAR /= BVAR  THEN  BUMP ;  END IF;
-                END IF;
- 
-                IF  AVAR /= BVAR  THEN
-                     IF  AVAR  = BVAR  THEN  BUMP ;  END IF;
-                END IF;
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 0  THEN
-           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE2" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
- 
-           FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
- 
-                IF ( AVAR /= BVAR ) /= ( T'POS(AVAR) /= T'POS(BVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-                IF ( AVAR  = BVAR ) /= ( T'POS(AVAR)  = T'POS(BVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-           END LOOP;
- 
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 0  THEN
-           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE3" );
-      END IF;
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  IVAR IN  0..8  LOOP                      -- 9 VALUES
- 
-           FOR  JVAR  IN  0..8   LOOP               -- 9 VALUES
- 
-                IF ( IVAR /= JVAR ) /= ( T'VAL(IVAR) /= T'VAL(JVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-                IF ( IVAR  = JVAR ) /= ( T'VAL(IVAR)  = T'VAL(JVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-           END LOOP;
- 
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 0  THEN
-           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE4" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP    -- 9 VALUES (THE DIAGONAL)
- 
-           IF  AVAR  = ITSELF(AVAR)  THEN NULL;  ELSE BUMP;  END IF;
-           IF  AVAR /= ITSELF(AVAR)  THEN BUMP;              END IF;
- 
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 0  THEN
-           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE5" );
-      END IF;
- 
- 
-      -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
-           FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
- 
-                IF  AVAR /= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 72
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 72  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE6" );
-      END IF;
- 
- 
-      RESULT;
- 
- END C45201A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45201b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45201b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45201b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,236 ****
- -- C45201B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ORDERING OF ENUMERATION LITERALS AS DEFINED BY THE
- --    ORDERING OPERATORS IS THE SAME AS THE ORDER OF OCCURRENCE OF THE
- --    LITERALS IN THE TYPE DEFINITION.
- 
- -- THIS TEST IS DERIVED FROM  C45210A.ADA .
- 
- 
- -- RM    17 OCTOBER 1980
- -- JWC 7/8/85   RENAMED TO -AB
- 
- 
- WITH  REPORT ;
- PROCEDURE  C45201B  IS
- 
-      USE REPORT;
- 
-      TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
- 
-      --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
-      --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
- 
-      SUBTYPE  T1  IS  T RANGE A..B ;
-      SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
-      SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
-      SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
- 
-      MVAR  : T3 := T'(NUL ) ;
-      PVAR  : T2 := T'(PLIT) ;
-      RVAR  : T4 := T'('R' ) ;
-      SVAR  : T1 := T'(SLIT) ;
- 
-      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT + 1 ;
-      END BUMP ;
- 
- 
- BEGIN
- 
-      TEST( "C45201B","CHECK THAT THE ORDERING OF ENUMERATION LITERALS "&
-                      " AS DEFINED BY THE ORDERING OPERATORS" &
-                      " IS THE SAME AS THE ORDER OF OCCURRENCE OF THE " &
-                      " LITERALS IN THE TYPE DEFINITION" ) ;
- 
-      -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
-      --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
-      --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
-      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
-      --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
-      --                         (IN THE TABLE:  VV = ALPHA ,
-      --                                         VL = BETA  ,
-      --                                         LV = GAMMA ,
-      --                                         LL = DELTA  ) RANDOMIZED
-      --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
-      --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
- 
-      --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
-      --         LEFT
-      --       OPERAND:
- 
-      --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
-      --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
-      --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
-      --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
- 
-      --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
-      --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
- 
-      -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
-      --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
-      --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
- 
-     -----------------------------------------------------------------
- 
-      -- PART 1
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
- 
-      IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
-      IF  T'(SVAR) <= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(SLIT) >  T'(MVAR)  THEN  BUMP ;               END IF;
-      IF  T'(SLIT) >= T'('R' )  THEN  BUMP ;               END IF;
- 
-      IF  T'(PLIT) >  T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(PLIT) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(PVAR) <  T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
- 
-      IF  T'(MVAR) >= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(NUL ) <= T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(NUL ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
- 
-      IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
-      IF  T'('R' ) <  T'(PLIT)  THEN  BUMP ;               END IF;
-      IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
- 
- 
-      IF  ERROR_COUNT /= 0  THEN
-           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE1" );
-      END IF;
- 
-     -----------------------------------------------------------------
- 
-      -- PART 2
- 
-      -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
-           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
- 
-                IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  6
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 6  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE2" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
-           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
- 
-                IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 10
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /=10  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE3" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
-           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
- 
-                IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 26
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /=26  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE4" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
-           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
- 
-                IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 30
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /=30  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE5" );
-      END IF;
- 
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT' (AGAIN)
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
- 
-           FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
- 
-                IF ( AVAR <  BVAR ) /= ( T'POS(AVAR) <  T'POS(BVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-                IF ( AVAR <= BVAR ) /= ( T'POS(AVAR) <= T'POS(BVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-                IF ( AVAR >  BVAR ) /= ( T'POS(AVAR) >  T'POS(BVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-                IF ( AVAR >= BVAR ) /= ( T'POS(AVAR) >= T'POS(BVAR) )THEN
-                     BUMP ;
-                END IF;
- 
-           END LOOP;
- 
-      END LOOP;
- 
- 
-      IF  ERROR_COUNT /= 0  THEN   -- REAL ERROR COUNT AGAIN
-           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE6" );
-      END IF;
- 
- 
-      RESULT;
- 
- END C45201B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45202b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45202b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45202b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45202b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C45202B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK MEMBERSHIP OPERATIONS IN THE CASE IN WHICH A USER HAS 
- -- REDEFINED THE ORDERING OPERATORS.
- 
- -- RJW 1/22/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45202B IS
- 
- 
- BEGIN
- 
-      TEST( "C45202B" , "CHECK MEMBERSHIP OPERATIONS IN WHICH A USER " &
-                        "HAS REDEFINED THE ORDERING OPERATORS" ) ;
- 
- 
-      DECLARE
- 
-           TYPE  T  IS  ( AA, BB, CC, LIT, XX, YY, ZZ );    
-           SUBTYPE ST IS T RANGE AA .. LIT;     
- 
-           VAR  :           T :=  LIT ;
-           CON  :  CONSTANT T :=  LIT ;
- 
-           FUNCTION ">" ( L, R : T ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN T'POS(L) <= T'POS(R);
-           END;
-                     
-           FUNCTION ">=" ( L, R : T ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN T'POS(L) < T'POS(R);
-           END;
- 
-           FUNCTION "<" ( L, R : T ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN T'POS(L) >= T'POS(R);
-           END;
-                     
-           FUNCTION "<=" ( L, R : T ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN T'POS(L) > T'POS(R);
-           END;
-                     
- 
-      BEGIN
- 
-           IF   LIT NOT IN ST      OR
-                VAR NOT IN ST      OR
-                CON NOT IN ST      OR
-                NOT (VAR IN ST)    OR
-                XX IN ST           OR
-                NOT (XX NOT IN ST) 
-           THEN
-                FAILED( "WRONG VALUES FOR 'IN ST'" );
-           END IF;
- 
-           IF   LIT     IN AA ..CC       OR
-                VAR NOT IN LIT..ZZ       OR
-                CON     IN ZZ ..AA       OR
-                NOT (CC IN CC .. YY)     OR
-                NOT (BB NOT IN CC .. YY) 
-           THEN
-                FAILED( "WRONG VALUES FOR 'IN AA..CC'" );
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45202B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45210a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45210a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45210a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C45210A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ENUMERATION IMPOSING AN "UNNATURAL" ORDER ON ALPHABETIC
- --    CHARACTERS CORRECTLY EVALUATES THE ORDERING OPERATORS.
- 
- 
- -- RM    15 OCTOBER 1980
- -- JWC 7/8/85   RENAMED TO -AB
- 
- 
- WITH  REPORT ;
- PROCEDURE  C45210A  IS
- 
-      USE REPORT;
- 
-      TYPE  T  IS  ( 'S' , 'P' , 'M' , 'R' );
- 
-      MVAR  : T := T'('M') ;
-      PVAR  : T := T'('P') ;
-      RVAR  : T := T'('R') ;
-      SVAR  : T := T'('S') ;
- 
-      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT +1 ;
-      END BUMP ;
- 
- 
- BEGIN
- 
-      TEST( "C45210A" , "CHECK THAT AN ENUMERATION IMPOSING" &
-                        " AN ""UNNATURAL"" ORDER ON ALPHABETIC" &
-                        " CHARACTERS  CORRECTLY EVALUATES THE " &
-                        " ORDERING OPERATORS" ) ;
- 
-      -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
-      --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
-      --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
-      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
-      --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
-      --                         (IN THE TABLE:  VV = ALPHA ,
-      --                                         VL = BETA  ,
-      --                                         LV = GAMMA ,
-      --                                         LL = DELTA  ) RANDOMIZED
-      --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
-      --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
- 
-      --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
-      --         LEFT
-      --       OPERAND:
- 
-      --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
-      --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
-      --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
-      --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
- 
-      --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
-      --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
- 
-      -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
-      --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
-      --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
- 
-     -----------------------------------------------------------------
- 
-      -- PART 1
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
- 
-      IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
-      IF  T'(SVAR) <= T'('P' )  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'('S' ) >  T'(MVAR)  THEN  BUMP ;               END IF;
-      IF  T'('S' ) >= T'('R' )  THEN  BUMP ;               END IF;
- 
-      IF  T'('P' ) >  T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'('P' ) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(PVAR) <  T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
- 
-      IF  T'(MVAR) >= T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'('M' ) <= T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'('M' ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
- 
-      IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
-      IF  T'('R' ) <  T'('P' )  THEN  BUMP ;               END IF;
-      IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
-      IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
- 
- 
-      IF  ERROR_COUNT /= 0  THEN
-           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE1" );
-      END IF;
- 
-     -----------------------------------------------------------------
- 
-      -- PART 2
- 
-      -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
-           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
- 
-                IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  1
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 1  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE2" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
-           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
- 
-                IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  3
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 3  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE3" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
-           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
- 
-                IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  5
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 5  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE4" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
-           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
- 
-                IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  7
- 
-           END LOOP;
-      END LOOP;
- 
-      IF  ERROR_COUNT /= 7  THEN   -- THIS IS A PLAIN COUNT, NOT AN
-                                    --    ERROR COUNT
-           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE5" );
-      END IF;
- 
- 
-      RESULT;
- 
- END C45210A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45211a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45211a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45211a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- C45211A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK MEMBERSHIP TESTS FOR AN 'UNNATURAL' ORDERING OF CHARACTER
- -- LITERALS.
- 
- -- RJW 1/22/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45211A IS
- 
-      TYPE  T  IS  ( 'S' , 'Q' , 'P' , 'M' , 'R' );
-      SUBTYPE ST IS T RANGE 'P' .. 'R';
- 
-      MVAR  : T := T'('M') ;
-      QVAR  : T := T'('Q') ;
-      MCON  : CONSTANT T := T'('M');
-      QCON  : CONSTANT T := T'('Q');
- 
- BEGIN
- 
-      TEST( "C45211A" , "CHECK MEMBERSHIP TESTS FOR AN 'UNNATURAL' " &
-                        "ORDERING OF CHARACTER LITERALS" ) ;
- 
-      IF QVAR IN T'('P') .. T'('R')  OR
-         'Q'  IN ST
-      THEN
-           FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 1" );
-      END IF;
- 
-      IF MVAR NOT IN T'('P') .. T'('R')  OR
-         'M'  NOT IN ST
-      THEN
-           FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 2" );
-      END IF;
- 
-      IF QCON IN T'('P') .. T'('R')  OR
-         MCON NOT IN ST
-      THEN
-           FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 3" );
-      END IF;
- 
-      RESULT;
- 
- END C45211A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- C45220A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
- --    BOOLEAN-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
- --    DIFFERENT SUBTYPES).
- 
- -- THIS TEST IS DERIVED FROM  C45201A.ADA .
- 
- 
- -- RM    27 OCTOBER 1980
- -- JWC 7/8/85   RENAMED TO -AB
- 
- 
- WITH  REPORT ;
- PROCEDURE  C45220A  IS
- 
- 
-      USE REPORT;
- 
-      SUBTYPE  T1  IS  BOOLEAN RANGE FALSE..FALSE ;
-      SUBTYPE  T2  IS  BOOLEAN RANGE TRUE..TRUE ;
-      SUBTYPE  T3  IS  BOOLEAN RANGE FALSE..TRUE ;
-      SUBTYPE  T4  IS  T3 RANGE TRUE..TRUE ;
- 
-      FVAR1  : T1 := FALSE ;
-      TVAR1  : T2 := TRUE ;
-      FVAR2  : T3 := FALSE ;
-      TVAR2  : T4 := TRUE ;
- 
-      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT + 1 ;
-      END BUMP ;
- 
- 
- BEGIN
- 
- 
-      TEST( "C45220A" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
-                        " RESULTS ON BOOLEAN-TYPE OPERANDS" ) ;
- 
-      -- 32  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
-      --               2    OPERATORS : '=' , '/=' ,
-      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
-      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
- 
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
- 
-      FVAR1  := IDENT_BOOL( FALSE ) ;
-      TVAR1  := IDENT_BOOL( TRUE ) ;
-      FVAR2  := IDENT_BOOL( FALSE ) ;
-      TVAR2  := IDENT_BOOL( TRUE ) ;
- 
-      IF  FALSE =  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR1 =  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FALSE =  FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR2 =  FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  FALSE =  TRUE   THEN  BUMP ;                END IF;
-      IF  FVAR1 =  TRUE   THEN  BUMP ;                END IF;
-      IF  FALSE =  TVAR2  THEN  BUMP ;                END IF;
-      IF  FVAR2 =  TVAR1  THEN  BUMP ;                END IF;
- 
-      IF  TRUE  =  FALSE  THEN  BUMP ;                END IF;
-      IF  TRUE  =  FVAR1  THEN  BUMP ;                END IF;
-      IF  TVAR2 =  FALSE  THEN  BUMP ;                END IF;
-      IF  TVAR1 =  FVAR2  THEN  BUMP ;                END IF;
- 
-      IF  TRUE  =  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR1 =  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TRUE  =  TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR2 =  TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
- 
-      IF  FALSE /= FALSE  THEN  BUMP ;                END IF;
-      IF  FVAR1 /= FALSE  THEN  BUMP ;                END IF;
-      IF  FALSE /= FVAR2  THEN  BUMP ;                END IF;
-      IF  FVAR2 /= FVAR1  THEN  BUMP ;                END IF;
- 
-      IF  FALSE /= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR1 /= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FALSE /= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR2 /= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  TRUE  /= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TRUE  /= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR2 /= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR1 /= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  TRUE  /= TRUE   THEN  BUMP ;                END IF;
-      IF  TVAR1 /= TRUE   THEN  BUMP ;                END IF;
-      IF  TRUE  /= TVAR2  THEN  BUMP ;                END IF;
-      IF  TVAR2 /= TVAR1  THEN  BUMP ;                END IF;
- 
- 
-      IF  ERROR_COUNT /=0  THEN
-           FAILED( "(IN)EQUALITY OF BOOLEAN VALUES - FAILURE1" );
-      END IF;
- 
- 
-      RESULT ;
- 
- 
- END C45220A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C45220B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE CORRECT RESULTS ON
- --    BOOLEAN-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
- --    DIFFERENT SUBTYPES).
- 
- -- THIS TEST IS DERIVED FROM  C45220A.ADA .
- 
- 
- -- RM    28 OCTOBER 1980
- -- JWC 7/8/85   RENAMED TO -AB
- 
- 
- WITH  REPORT ;
- PROCEDURE  C45220B  IS
- 
- 
-      USE REPORT;
- 
-      SUBTYPE  T1  IS  BOOLEAN RANGE FALSE..FALSE ;
-      SUBTYPE  T2  IS  BOOLEAN RANGE TRUE..TRUE ;
-      SUBTYPE  T3  IS  BOOLEAN RANGE FALSE..TRUE ;
-      SUBTYPE  T4  IS  T3 RANGE TRUE..TRUE ;
- 
-      FVAR1  : T1 := FALSE ;
-      TVAR1  : T2 := TRUE ;
-      FVAR2  : T3 := FALSE ;
-      TVAR2  : T4 := TRUE ;
- 
-      ERROR_COUNT : INTEGER := 0 ;
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT + 1 ;
-      END BUMP ;
- 
- 
- BEGIN
- 
- 
-      TEST( "C45220B" , "CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE" &
-                        " CORRECT RESULTS ON BOOLEAN-TYPE OPERANDS" ) ;
- 
-      -- 64  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
-      --               4    OPERATORS : '<' , <=' , '>' , '>='
-      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
-      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
- 
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
- 
-      FVAR1  := IDENT_BOOL( FALSE ) ;
-      TVAR1  := IDENT_BOOL( TRUE ) ;
-      FVAR2  := IDENT_BOOL( FALSE ) ;
-      TVAR2  := IDENT_BOOL( TRUE ) ;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  FALSE <  FALSE  THEN  BUMP ;                END IF;
-      IF  FVAR1 <  FALSE  THEN  BUMP ;                END IF;
-      IF  FALSE <  FVAR2  THEN  BUMP ;                END IF;
-      IF  FVAR2 <  FVAR1  THEN  BUMP ;                END IF;
- 
-      IF  FALSE <  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR1 <  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FALSE <  TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR2 <  TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  TRUE  <  FALSE  THEN  BUMP ;                END IF;
-      IF  TRUE  <  FVAR1  THEN  BUMP ;                END IF;
-      IF  TVAR2 <  FALSE  THEN  BUMP ;                END IF;
-      IF  TVAR1 <  FVAR2  THEN  BUMP ;                END IF;
- 
-      IF  TRUE  <  TRUE   THEN  BUMP ;                END IF;
-      IF  TVAR1 <  TRUE   THEN  BUMP ;                END IF;
-      IF  TRUE  <  TVAR2  THEN  BUMP ;                END IF;
-      IF  TVAR2 <  TVAR1  THEN  BUMP ;                END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '<'" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  FALSE <= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR1 <= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FALSE <= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR2 <= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  FALSE <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR1 <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FALSE <= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR2 <= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  TRUE  <= FALSE  THEN  BUMP ;                END IF;
-      IF  TRUE  <= FVAR1  THEN  BUMP ;                END IF;
-      IF  TVAR2 <= FALSE  THEN  BUMP ;                END IF;
-      IF  TVAR1 <= FVAR2  THEN  BUMP ;                END IF;
- 
-      IF  TRUE  <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR1 <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TRUE  <= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR2 <= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '<='" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  FALSE >  FALSE  THEN  BUMP ;                END IF;
-      IF  FVAR1 >  FALSE  THEN  BUMP ;                END IF;
-      IF  FALSE >  FVAR2  THEN  BUMP ;                END IF;
-      IF  FVAR2 >  FVAR1  THEN  BUMP ;                END IF;
- 
-      IF  FALSE >  TRUE   THEN  BUMP ;                END IF;
-      IF  FVAR1 >  TRUE   THEN  BUMP ;                END IF;
-      IF  FALSE >  TVAR2  THEN  BUMP ;                END IF;
-      IF  FVAR2 >  TVAR1  THEN  BUMP ;                END IF;
- 
-      IF  TRUE  >  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TRUE  >  FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR2 >  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR1 >  FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  TRUE  >  TRUE   THEN  BUMP ;                END IF;
-      IF  TVAR1 >  TRUE   THEN  BUMP ;                END IF;
-      IF  TRUE  >  TVAR2  THEN  BUMP ;                END IF;
-      IF  TVAR2 >  TVAR1  THEN  BUMP ;                END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '>'" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  FALSE >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR1 >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FALSE >= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  FVAR2 >= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  FALSE >= TRUE   THEN  BUMP ;                END IF;
-      IF  FVAR1 >= TRUE   THEN  BUMP ;                END IF;
-      IF  FALSE >= TVAR2  THEN  BUMP ;                END IF;
-      IF  FVAR2 >= TVAR1  THEN  BUMP ;                END IF;
- 
-      IF  TRUE  >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TRUE  >= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR2 >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR1 >= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  TRUE  >= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR1 >= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TRUE  >= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  TVAR2 >= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '>='" );
-      END IF;
- 
- 
-      RESULT ;
- 
- 
- END C45220B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- C45220C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
- --    OPERANDS OF A TYPE DERIVED FROM THE TYPE 'BOOLEAN'
- --    (IN PARTICULAR, FOR OPERANDS HAVING DIFFERENT SUBTYPES).
- 
- -- THIS TEST IS DERIVED FROM  C45220A.ADA .
- 
- 
- -- RM    27 OCTOBER 1980
- -- JWC 7/8/85   RENAMED TO -AB
- 
- 
- WITH  REPORT ;
- PROCEDURE  C45220C  IS
- 
- 
-      USE REPORT;
- 
-      TYPE  NB  IS  NEW BOOLEAN ;
- 
-      SUBTYPE  T1  IS  NB RANGE NB'(FALSE)..NB'(FALSE) ;
-      SUBTYPE  T2  IS  NB RANGE NB'(TRUE )..NB'(TRUE );
-      SUBTYPE  T3  IS  NB RANGE NB'(FALSE)..NB'(TRUE );
-      SUBTYPE  T4  IS  T3 RANGE NB'(TRUE )..NB'(TRUE );
- 
-      FVAR1   : T1 := NB'(FALSE) ;
-      TVAR1   : T2 := NB'(TRUE );
-      FVAR2   : T3 := NB'(FALSE) ;
-      TVAR2   : T4 := NB'(TRUE );
- 
-      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT + 1 ;
-      END BUMP ;
- 
-      FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
-      BEGIN
-           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
-           ELSE  RETURN  NB'(FALSE) ;
-           END IF;
-      END ;
- 
- 
- BEGIN
- 
- 
-      TEST( "C45220C" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
-                        " RESULTS ON DERIVED-BOOLEAN-TYPE OPERANDS" ) ;
- 
-      -- 32  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
-      --               2    OPERATORS : '=' , '/=' ,
-      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
-      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
- 
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
- 
-      FVAR1   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
-      TVAR1   := IDENT_NEW_BOOL( NB'(TRUE )) ;
-      FVAR2   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
-      TVAR2   := IDENT_NEW_BOOL( NB'(TRUE )) ;
- 
-      IF  NB'(FALSE) =  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR1  =  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(FALSE) =      FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR2  =      FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(FALSE) =  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF      FVAR1  =  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF  NB'(FALSE) =      TVAR2   THEN  BUMP ;                END IF;
-      IF      FVAR2  =      TVAR1   THEN  BUMP ;                END IF;
- 
-      IF  NB'(TRUE ) =  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF  NB'(TRUE ) =      FVAR1   THEN  BUMP ;                END IF;
-      IF      TVAR2  =  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF      TVAR1  =      FVAR2   THEN  BUMP ;                END IF;
- 
-      IF  NB'(TRUE ) =  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR1  =  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(TRUE ) =      TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR2  =      TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
- 
-      IF  NB'(FALSE) /= NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF      FVAR1  /= NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF  NB'(FALSE) /=     FVAR2   THEN  BUMP ;                END IF;
-      IF      FVAR2  /=     FVAR1   THEN  BUMP ;                END IF;
- 
-      IF  NB'(FALSE) /= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR1  /= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(FALSE) /=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR2  /=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(TRUE ) /= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(TRUE ) /=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR2  /= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR1  /=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(TRUE ) /= NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF      TVAR1  /= NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF  NB'(TRUE ) /=     TVAR2   THEN  BUMP ;                END IF;
-      IF      TVAR2  /=     TVAR1   THEN  BUMP ;                END IF;
- 
- 
-      IF  ERROR_COUNT /=0  THEN
-           FAILED( "(IN)EQUALITY OF N_BOOLEAN VALUES - FAILURE1" );
-      END IF;
- 
- 
-      RESULT ;
- 
- 
- END C45220C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,200 ****
- -- C45220D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE CORRECT RESULTS ON
- --    OPERANDS OF A TYPE DERIVED FROM THE TYPE 'BOOLEAN'
- --    (IN PARTICULAR, FOR OPERANDS HAVING DIFFERENT SUBTYPES).
- 
- -- THIS TEST IS DERIVED FROM  C45220B.ADA , C45220C.ADA .
- 
- 
- -- RM    28 OCTOBER 1980
- -- JWC 7/8/85   RENAMED TO -AB
- 
- WITH  REPORT ;
- PROCEDURE  C45220D  IS
- 
- 
-      USE REPORT;
- 
-      TYPE  NB  IS  NEW BOOLEAN ;
- 
-      SUBTYPE  T1  IS  NB RANGE NB'(FALSE)..NB'(FALSE) ;
-      SUBTYPE  T2  IS  NB RANGE NB'(TRUE )..NB'(TRUE );
-      SUBTYPE  T3  IS  NB RANGE NB'(FALSE)..NB'(TRUE );
-      SUBTYPE  T4  IS  T3 RANGE NB'(TRUE )..NB'(TRUE );
- 
-      FVAR1   : T1 := NB'(FALSE) ;
-      TVAR1   : T2 := NB'(TRUE );
-      FVAR2   : T3 := NB'(FALSE) ;
-      TVAR2   : T4 := NB'(TRUE );
- 
-      ERROR_COUNT : INTEGER := 0 ;
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT + 1 ;
-      END BUMP ;
- 
-      FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
-      BEGIN
-           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
-           ELSE  RETURN  NB'(FALSE) ;
-           END IF;
-      END ;
- 
- 
- BEGIN
- 
- 
-      TEST( "C45220D" , "CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE" &
-                        " CORRECT RESULTS ON DERIVED-BOOLEAN-TYPE" &
-                        " OPERANDS" ) ;
- 
-      -- 64  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
-      --               4    OPERATORS : '<' , <=' , '>' , '>='
-      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
-      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
- 
- 
-      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
- 
-      FVAR1   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
-      TVAR1   := IDENT_NEW_BOOL( NB'(TRUE )) ;
-      FVAR2   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
-      TVAR2   := IDENT_NEW_BOOL( NB'(TRUE )) ;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  NB'(FALSE) <  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF      FVAR1  <  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF  NB'(FALSE) <      FVAR2   THEN  BUMP ;                END IF;
-      IF      FVAR2  <      FVAR1   THEN  BUMP ;                END IF;
- 
-      IF  NB'(FALSE) <  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR1  <  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(FALSE) <      TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR2  <      TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(TRUE ) <  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF  NB'(TRUE ) <      FVAR1   THEN  BUMP ;                END IF;
-      IF      TVAR2  <  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF      TVAR1  <      FVAR2   THEN  BUMP ;                END IF;
- 
-      IF  NB'(TRUE ) <  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF      TVAR1  <  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF  NB'(TRUE ) <      TVAR2   THEN  BUMP ;                END IF;
-      IF      TVAR2  <      TVAR1   THEN  BUMP ;                END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '<'" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  NB'(FALSE) <= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR1  <= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(FALSE) <=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR2  <=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(FALSE) <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR1  <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(FALSE) <=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR2  <=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(TRUE ) <= NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF  NB'(TRUE ) <=     FVAR1   THEN  BUMP ;                END IF;
-      IF      TVAR2  <= NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF      TVAR1  <=     FVAR2   THEN  BUMP ;                END IF;
- 
-      IF  NB'(TRUE ) <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR1  <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(TRUE ) <=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR2  <=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '<='" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  NB'(FALSE) >  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF      FVAR1  >  NB'(FALSE)  THEN  BUMP ;                END IF;
-      IF  NB'(FALSE) >      FVAR2   THEN  BUMP ;                END IF;
-      IF      FVAR2  >      FVAR1   THEN  BUMP ;                END IF;
- 
-      IF  NB'(FALSE) >  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF      FVAR1  >  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF  NB'(FALSE) >      TVAR2   THEN  BUMP ;                END IF;
-      IF      FVAR2  >      TVAR1   THEN  BUMP ;                END IF;
- 
-      IF  NB'(TRUE ) >  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(TRUE ) >      FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR2  >  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR1  >      FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(TRUE ) >  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF      TVAR1  >  NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF  NB'(TRUE ) >      TVAR2   THEN  BUMP ;                END IF;
-      IF      TVAR2  >      TVAR1   THEN  BUMP ;                END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '>'" );
-      END IF;
- 
- 
-      ERROR_COUNT := 0 ;
- 
-      IF  NB'(FALSE) >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR1  >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(FALSE) >=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      FVAR2  >=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(FALSE) >= NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF      FVAR1  >= NB'(TRUE )  THEN  BUMP ;                END IF;
-      IF  NB'(FALSE) >=     TVAR2   THEN  BUMP ;                END IF;
-      IF      FVAR2  >=     TVAR1   THEN  BUMP ;                END IF;
- 
-      IF  NB'(TRUE ) >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(TRUE ) >=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR2  >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR1  >=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  NB'(TRUE ) >= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR1  >= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF  NB'(TRUE ) >=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
-      IF      TVAR2  >=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
- 
-      IF  ERROR_COUNT > 0  THEN
-           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '>='" );
-      END IF;
- 
- 
-      RESULT ;
- 
- 
- END C45220D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C45220E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THE PROPER OPERATION OF THE MEMBERSHIP OPERATORS  'IN'  AND
- --    'NOT IN'  FOR BOOLEAN TYPES.
- 
- 
- -- RM 03/20/81
- -- SPS 10/26/82
- 
- 
- WITH REPORT;
- PROCEDURE  C45220E  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C45220E" , "CHECK THE PROPER OPERATION OF THE MEMBERSHIP" &
-                        " OPERATORS  'IN'  AND  'NOT IN'  FOR" &
-                        " BOOLEAN TYPES" );
- 
-      DECLARE
- 
-           SUBTYPE  SUBBOOL   IS  BOOLEAN RANGE FALSE..TRUE ;
- 
-           VAR  :            BOOLEAN  :=  FALSE ;
-           CON  :   CONSTANT BOOLEAN  :=  FALSE ;
- 
-      BEGIN
- 
-           IF   TRUE NOT IN SUBBOOL  OR
-                VAR  NOT IN SUBBOOL  OR
-                CON  NOT IN SUBBOOL
-           THEN
-                FAILED( "WRONG VALUES FOR 'IN SUBBOOL'" );
-           END IF;
- 
-           IF   FALSE   IN TRUE..FALSE  OR
-                VAR NOT IN FALSE..TRUE  OR
-                CON     IN TRUE..TRUE
-           THEN
-                FAILED( "WRONG VALUES FOR 'IN AAA..BBB'" );
-           END IF;
- 
- 
-           RESULT ;
- 
- 
-      END ;
- 
- 
- END C45220E ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45220f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45220f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- C45220F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE MEMBERSHIP OPERATIONS WORK CORRECTLY FOR DERIVED
- -- BOOLEAN TYPES.
- 
- -- GLH 08/01/85
- 
- WITH REPORT;
- PROCEDURE  C45220F  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C45220F" , "CHECK MEMBERSHIP OPERATIONS FOR " &
-                        "DERIVED BOOLEAN");
- 
-      DECLARE
- 
-           TYPE NEWBOOL IS NEW BOOLEAN;
- 
-           VAR  :          NEWBOOL  :=  FALSE ;
-           CON  : CONSTANT NEWBOOL  :=  FALSE ;
- 
-      BEGIN
- 
-           IF   TRUE NOT IN NEWBOOL  OR
-                VAR  NOT IN NEWBOOL  OR
-                CON  NOT IN NEWBOOL
-           THEN
-                FAILED( "WRONG VALUES FOR 'IN NEWBOOL'" );
-           END IF;
- 
-           IF  NEWBOOL'(FALSE)   IN TRUE..FALSE  OR
-               VAR           NOT IN FALSE..TRUE  OR
-               CON               IN TRUE..TRUE
-           THEN
-                FAILED( "WRONG VALUES FOR 'IN AAA..BBB'" );
-           END IF;
- 
-           RESULT ;
- 
-      END ;
- 
- END C45220F ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,252 ****
- -- C45231A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD CORRECT 
- -- RESULTS FOR PREDEFINED TYPE INTEGER (INCLUDING THE CASE IN WHICH THE
- -- RELATIONAL OPERATORS ARE REDEFINED).
- 
- -- SUBTESTS ARE:
- --     (A). TESTS FOR RELATIONAL OPERATORS.
- --     (B). TESTS FOR MEMBERSHIP OPERATORS.
- --     (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE 
- --          RELATIONAL OPERATORS ARE REDEFINED.
- 
- 
- -- RJW 2/4/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45231A IS
-      
-      
- BEGIN
- 
-      TEST ( "C45231A", "CHECK THAT THE RELATIONAL AND " &
-                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
-                        "RESULTS FOR PREDEFINED TYPE INTEGER " &
-                        "(INCLUDING THE CASE IN WHICH THE " &
-                        "RELATIONAL OPERATORS ARE REDEFINED)" );
- 
-      DECLARE -- (A)
-      
-           I1A, I1B   : INTEGER          := IDENT_INT (1);
-           I2         : INTEGER          := IDENT_INT (2);
-           CI2        : CONSTANT INTEGER := 2;
- 
- 
-      BEGIN -- (A)
- 
-           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 1" );
-           END IF;
- 
-           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 2" );
-           END IF;
- 
-           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 3" );
-           END IF;
- 
-           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 4");
-           END IF;
- 
-           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 5" );
-           END IF;
- 
-           IF (I1A >= I1B) AND (I1A <= I1B) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 6" );
-           END IF;
- 
-           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 7" );
-           END IF;
- 
-           IF "<" (LEFT => I1A, RIGHT => I2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 8" );
-           END IF;
- 
-           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 9 ");
-           END IF;
- 
-           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 10 ");
-           END IF;
- 
-           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 11 ");
-           END IF;
- 
-           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 12 ");
-           END IF;
-          
-      END; -- (A) 
- 
-      ----------------------------------------------------------------
- 
-      DECLARE -- (B)
-           
-           SUBTYPE ST IS INTEGER RANGE -10 .. 10;
- 
-           I1 : INTEGER := IDENT_INT (1);
-           I5 : INTEGER := IDENT_INT (5);
- 
-           CI2  : CONSTANT INTEGER := 2;
-           CI10 : CONSTANT INTEGER := 10;
-           
-           
-      BEGIN -- (B)
-      
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.1" );
-           END IF;
- 
-           IF (IDENT_INT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT_INT (-11) IN ST) 
-              THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.3" );
-           END IF;
-      
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN 
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.5" );
-           END IF;
- 
-      END; -- (B)
- 
-      -------------------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE ST IS INTEGER RANGE -10 .. 10;
- 
-           I1 : INTEGER := IDENT_INT (1);
-           I5 : INTEGER := IDENT_INT (5);
- 
-           CI2  : CONSTANT INTEGER := 2;
-           CI10 : CONSTANT INTEGER := 10;
-           
-                     
-           FUNCTION ">" ( L, R : INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN INTEGER'POS (L) <= INTEGER'POS (R);
-           END;
-                     
-           FUNCTION ">=" ( L, R : INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN INTEGER'POS (L) < INTEGER'POS (R);
-           END;
- 
-           FUNCTION "<" ( L, R : INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN  INTEGER'POS (L) >= INTEGER'POS (R);
-           END;
-                     
-           FUNCTION "<=" ( L, R : INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN INTEGER'POS (L) > INTEGER'POS (R);
-           END;
-                     
-      BEGIN -- (C)
- 
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.1" );
-           END IF;
- 
-           IF (IDENT_INT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT_INT (-11) IN ST) 
-              THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.3" );
-           END IF;
-      
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN 
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.5" );
-           END IF;
- 
-      END; -- (C)
- 
-      RESULT;
- 
- END C45231A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,265 ****
- -- C45231B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD
- --     CORRECT RESULTS FOR PREDEFINED TYPE SHORT_INTEGER (INCLUDING
- --     THE CASE IN WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
- 
- --     SUBTESTS ARE:
- --       (A). TESTS FOR RELATIONAL OPERATORS.
- --       (B). TESTS FOR MEMBERSHIP OPERATORS.
- --       (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
- --            RELATIONAL OPERATORS ARE REDEFINED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH
- --     SUPPORT SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 02/04/86 CREATED ORIGINAL TEST.
- --     DHH 01/08/87 ENTERED APPLICABILITY CRITERIA AND FORMATTED HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45231B IS
- 
-      CHECK_SHORT : SHORT_INTEGER;                       -- N/A => ERROR.
- 
-      FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST ( "C45231B", "CHECK THAT THE RELATIONAL AND " &
-                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
-                        "RESULTS FOR PREDEFINED TYPE SHORT_INTEGER " &
-                        "(INCLUDING THE CASE IN WHICH THE " &
-                        "RELATIONAL OPERATORS ARE REDEFINED)" );
- 
-      DECLARE -- (A)
- 
-           I1A, I1B   : SHORT_INTEGER          := IDENT (1);
-           I2         : SHORT_INTEGER          := IDENT (2);
-           CI2        : CONSTANT SHORT_INTEGER := 2;
- 
- 
-      BEGIN -- (A)
- 
-           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 1" );
-           END IF;
- 
-           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 2" );
-           END IF;
- 
-           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 3" );
-           END IF;
- 
-           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 4");
-           END IF;
- 
-           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 5" );
-           END IF;
- 
-           IF (I1A >= I1B) AND (I1A <= I1B) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 6" );
-           END IF;
- 
-           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 7" );
-           END IF;
- 
-           IF "<" (LEFT => I1A, RIGHT => I2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 8" );
-           END IF;
- 
-           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 9 ");
-           END IF;
- 
-           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 10 ");
-           END IF;
- 
-           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 11 ");
-           END IF;
- 
-           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 12 ");
-           END IF;
- 
-      END; -- (A)
- 
-      ----------------------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
- 
-           I1 : SHORT_INTEGER := IDENT (1);
-           I5 : SHORT_INTEGER := IDENT (5);
- 
-           CI2  : CONSTANT SHORT_INTEGER := 2;
-           CI10 : CONSTANT SHORT_INTEGER := 10;
- 
- 
-      BEGIN -- (B)
- 
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.1" );
-           END IF;
- 
-           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.3" );
-           END IF;
- 
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.5" );
-           END IF;
- 
-      END; -- (B)
- 
-      -------------------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
- 
-           I1 : SHORT_INTEGER := IDENT (1);
-           I5 : SHORT_INTEGER := IDENT (5);
- 
-           CI2  : CONSTANT SHORT_INTEGER := 2;
-           CI10 : CONSTANT SHORT_INTEGER := 10;
- 
- 
-           FUNCTION ">" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN SHORT_INTEGER'POS (L) <= SHORT_INTEGER'POS (R);
-           END;
- 
-           FUNCTION ">=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN SHORT_INTEGER'POS (L) < SHORT_INTEGER'POS (R);
-           END;
- 
-           FUNCTION "<" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN  SHORT_INTEGER'POS (L) >= SHORT_INTEGER'POS (R);
-           END;
- 
-           FUNCTION "<=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN SHORT_INTEGER'POS (L) > SHORT_INTEGER'POS (R);
-           END;
- 
-      BEGIN -- (C)
- 
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.1" );
-           END IF;
- 
-           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.3" );
-           END IF;
- 
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.5" );
-           END IF;
- 
-      END; -- (C)
- 
-      RESULT;
- 
- END C45231B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,265 ****
- -- C45231C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD
- --     CORRECT RESULTS FOR PREDEFINED TYPE LONG_INTEGER (INCLUDING
- --     THE CASE IN WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
- 
- --     SUBTESTS ARE:
- --       (A). TESTS FOR RELATIONAL OPERATORS.
- --       (B). TESTS FOR MEMBERSHIP OPERATORS.
- --       (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
- --            RELATIONAL OPERATORS ARE REDEFINED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     LONG_INTEGER.
- 
- --     IF "LONG_INTEGER" IS NOT SUPPORTED THEN THE DECLARATION OF
- --     "CHECK_LONG" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 02/04/86 CREATED ORIGINAL TEST.
- --     DHH 01/08/87 ENTERED APPLICABILITY CRITERIA AND FORMATTED HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45231C IS
- 
-      CHECK_LONG : LONG_INTEGER;                        -- N/A => ERROR.
- 
-      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST ( "C45231C", "CHECK THAT THE RELATIONAL AND " &
-                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
-                        "RESULTS FOR PREDEFINED TYPE LONG_INTEGER " &
-                        "(INCLUDING THE CASE IN WHICH THE " &
-                        "RELATIONAL OPERATORS ARE REDEFINED)" );
- 
-      DECLARE -- (A)
- 
-           I1A, I1B   : LONG_INTEGER          := IDENT (1);
-           I2         : LONG_INTEGER          := IDENT (2);
-           CI2        : CONSTANT LONG_INTEGER := 2;
- 
- 
-      BEGIN -- (A)
- 
-           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 1" );
-           END IF;
- 
-           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 2" );
-           END IF;
- 
-           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 3" );
-           END IF;
- 
-           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 4");
-           END IF;
- 
-           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 5" );
-           END IF;
- 
-           IF (I1A >= I1B) AND (I1A <= I1B) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 6" );
-           END IF;
- 
-           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 7" );
-           END IF;
- 
-           IF "<" (LEFT => I1A, RIGHT => I2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 8" );
-           END IF;
- 
-           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 9 ");
-           END IF;
- 
-           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 10 ");
-           END IF;
- 
-           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 11 ");
-           END IF;
- 
-           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 12 ");
-           END IF;
- 
-      END; -- (A)
- 
-      ----------------------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           SUBTYPE ST IS LONG_INTEGER RANGE -10 .. 10;
- 
-           I1 : LONG_INTEGER := IDENT (1);
-           I5 : LONG_INTEGER := IDENT (5);
- 
-           CI2  : CONSTANT LONG_INTEGER := 2;
-           CI10 : CONSTANT LONG_INTEGER := 10;
- 
- 
-      BEGIN -- (B)
- 
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.1" );
-           END IF;
- 
-           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.3" );
-           END IF;
- 
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.5" );
-           END IF;
- 
-      END; -- (B)
- 
-      -------------------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE ST IS LONG_INTEGER RANGE -10 .. 10;
- 
-           I1 : LONG_INTEGER := IDENT (1);
-           I5 : LONG_INTEGER := IDENT (5);
- 
-           CI2  : CONSTANT LONG_INTEGER := 2;
-           CI10 : CONSTANT LONG_INTEGER := 10;
- 
- 
-           FUNCTION ">" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN LONG_INTEGER'POS (L) <= LONG_INTEGER'POS (R);
-           END;
- 
-           FUNCTION ">=" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN LONG_INTEGER'POS (L) < LONG_INTEGER'POS (R);
-           END;
- 
-           FUNCTION "<" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN  LONG_INTEGER'POS (L) >= LONG_INTEGER'POS (R);
-           END;
- 
-           FUNCTION "<=" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN LONG_INTEGER'POS (L) > LONG_INTEGER'POS (R);
-           END;
- 
-      BEGIN -- (C)
- 
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.1" );
-           END IF;
- 
-           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.3" );
-           END IF;
- 
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.5" );
-           END IF;
- 
-      END; -- (C)
- 
-      RESULT;
- 
- END C45231C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231d.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45231d.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45231d.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,274 ****
- -- C45231D.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD CORRECT
- --     RESULTS FOR PREDEFINED TYPE $NAME (INCLUDING THE CASE IN
- --     WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
- 
- --     SUBTESTS ARE:
- --         (A). TESTS FOR RELATIONAL OPERATORS.
- --         (B). TESTS FOR MEMBERSHIP OPERATORS.
- --         (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
- --              RELATIONAL OPERATORS ARE REDEFINED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT A
- --     PREDEFINED INTEGER TYPE OTHER THAN INTEGER, SHORT_INTEGER, OR
- --     LONG_INTEGER.
- 
- --     IF NO SUCH PREDEFINED INTEGER TYPE IS SUPPORTED, THEN THE
- --     SPECIFICATION OF THE FUNCTION IDENT MUST BE REJECTED.
- 
- -- MACRO SUBSTITUTION:
- --     $NAME IS A PREDEFINED INTEGER TYPE OTHER THAN INTEGER,
- --     SHORT_INTEGER, AND LONG_INTEGER.
- 
- -- HISTORY:
- --     RJW 02/04/86
- --     THS 04/16/90  ADDED OMITTED "-- N/A => ERROR." MESSAGE AND
- --                   MODIFIED HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45231D IS
- 
-      FUNCTION IDENT (X : $NAME)
-           RETURN $NAME IS   -- N/A => ERROR.
-      BEGIN
-           RETURN $NAME (IDENT_INT (INTEGER (X)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST ( "C45231D", "CHECK THAT THE RELATIONAL AND " &
-                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
-                        "RESULTS FOR PREDEFINED TYPE $NAME " &
-                        "(INCLUDING THE CASE IN WHICH THE " &
-                        "RELATIONAL OPERATORS ARE REDEFINED)" );
- 
-      DECLARE -- (A)
- 
-           I1A, I1B   : $NAME          := IDENT (1);
-           I2         : $NAME          := IDENT (2);
-           CI2        : CONSTANT $NAME := 2;
- 
- 
-      BEGIN -- (A)
- 
-           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 1" );
-           END IF;
- 
-           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 2" );
-           END IF;
- 
-           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 3" );
-           END IF;
- 
-           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 4");
-           END IF;
- 
-           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 5" );
-           END IF;
- 
-           IF (I1A >= I1B) AND (I1A <= I1B) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 6" );
-           END IF;
- 
-           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 7" );
-           END IF;
- 
-           IF "<" (LEFT => I1A, RIGHT => I2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 8" );
-           END IF;
- 
-           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 9 ");
-           END IF;
- 
-           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 10 ");
-           END IF;
- 
-           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 11 ");
-           END IF;
- 
-           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
-                NULL;
-           ELSE
-                FAILED ( "RELATIONAL TEST - 12 ");
-           END IF;
- 
-      END; -- (A)
- 
-      ----------------------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           SUBTYPE ST IS $NAME RANGE -10 .. 10;
- 
-           I1 : $NAME := IDENT (1);
-           I5 : $NAME := IDENT (5);
- 
-           CI2  : CONSTANT $NAME := 2;
-           CI10 : CONSTANT $NAME := 10;
- 
- 
-      BEGIN -- (B)
- 
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.1" );
-           END IF;
- 
-           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.3" );
-           END IF;
- 
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - B.5" );
-           END IF;
- 
-      END; -- (B)
- 
-      -------------------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE ST IS $NAME RANGE -10 .. 10;
- 
-           I1 : $NAME := IDENT (1);
-           I5 : $NAME := IDENT (5);
- 
-           CI2  : CONSTANT $NAME := 2;
-           CI10 : CONSTANT $NAME := 10;
- 
- 
-           FUNCTION ">" ( L, R : $NAME ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN $NAME'POS (L) <= 
- 	              $NAME'POS (R);
-           END;
- 
-           FUNCTION ">=" ( L, R : $NAME ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN $NAME'POS (L) < 
-                       $NAME'POS (R);
-           END;
- 
-           FUNCTION "<" ( L, R : $NAME ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN  $NAME'POS (L) >= 
-                        $NAME'POS (R);
-           END;
- 
-           FUNCTION "<=" ( L, R : $NAME ) RETURN BOOLEAN IS
-           BEGIN
-                RETURN $NAME'POS (L) > 
-                       $NAME'POS (R);
-           END;
- 
-      BEGIN -- (C)
- 
-           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.1" );
-           END IF;
- 
-           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.2" );
-           END IF;
- 
-           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.3" );
-           END IF;
- 
-           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.4" );
-           END IF;
- 
-           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
-                NULL;
-           ELSE
-                FAILED ( "MEMBERSHIP TEST - C.5" );
-           END IF;
- 
-      END; -- (C)
- 
-      RESULT;
- 
- END C45231D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45232b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45232b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45232b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45232b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- C45232B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NO EXCEPTION IS RAISED WHEN AN INTEGER LITERAL IN
- -- A COMPARISON  BELONGS TO THE BASE TYPE BUT IS OUTSIDE THE 
- -- SUBTYPE OF THE OTHER OPERAND.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- P. BRASHEAR  08/21/86
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT, SYSTEM; USE REPORT;
- PROCEDURE C45232B IS
- 
- BEGIN
- 
-      TEST ("C45232B", "NO EXCEPTION IS RAISED WHEN AN INTEGER " & 
-                       "LITERAL IN A COMPARISON BELONGS TO THE BASE " &
-                       "TYPE BUT IS OUTSIDE THE SUBTYPE OF THE " &
-                       "OTHER OPERAND");
- 
-      DECLARE
- 
-            TYPE INT10 IS RANGE -10 .. 5;
- 
-      BEGIN    
- 
-           IF 7 > INT10'(-10) THEN
-                COMMENT ("NO EXCEPTION RAISED FOR '7 > " &
-                         "INT10'(-10)'");
-           ELSE
-                FAILED ("WRONG RESULT FOR '7 > INT10'(-10)'");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR '7 " &
-                        "> INT10'(-10)'");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR '7 > " &
-                        "INT10'(-10)'");
-      END;  
- 
-      DECLARE
- 
-            TYPE INT10 IS RANGE -10 .. 5;
- 
-      BEGIN    
- 
-           IF 7 NOT IN INT10 THEN
-                COMMENT ("NO EXCEPTION RAISED FOR '7 NOT IN " &
-                         "INT'");
-           ELSE
-                FAILED ("WRONG RESULT FOR '7 NOT IN INT'");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR '7 " &
-                        "NOT IN INT'");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR '7 NOT IN " &
-                        "INT'");
-      END;  
- 
-      DECLARE
- 
-            TYPE INT700 IS RANGE -700 .. 500;
- 
-      BEGIN    
-           IF 600 > INT700'(5) THEN
-                COMMENT ("NO EXCEPTION RAISED FOR '600 > " &
-                         "INT700'(5)'");
-           ELSE
-                FAILED ("WRONG RESULT FOR '600 > INT700'(5)'");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR '600 " &
-                        "> INT700'(5)'");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR '600 > " &
-                        "INT700'(5)'");
-      END;  
- 
-      DECLARE
- 
-            TYPE INT700 IS RANGE -700 .. 500;
- 
-      BEGIN    
- 
-           IF 600 NOT IN INT700 THEN
-                COMMENT ("NO EXCEPTION RAISED FOR '600 NOT IN " &
-                         "INT700'");
-           ELSE
-                FAILED ("WRONG RESULT FOR '600 NOT IN INT700'");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR '600 " &
-                        "NOT IN INT700'");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR '600 NOT IN " &
-                        "INT700'");
-      END;  
- 
-      RESULT;
- 
- END C45232B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45242b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45242b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45242b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45242b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- C45242B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NO EXCEPTION IS RAISED WHEN A FLOATING POINT LITERAL
- --     OPERAND IN A COMPARISON OR A FLOATING POINT LITERAL LEFT OPERAND
- --     IN A MEMBERSHIP TEST BELONGS TO THE BASE TYPE BUT IS OUTSIDE
- --     THE RANGE OF THE SUBTYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     PWB 09/04/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT, SYSTEM; USE REPORT;
- PROCEDURE C45242B IS
- 
- BEGIN
- 
-      TEST ("C45242B", "NO EXCEPTION IS RAISED WHEN A FLOATING " &
-                       "LITERAL USED IN A COMPARISON OR AS THE " &
-                       "LEFT OPERAND IN A MEMBERSHIP TEST " &
-                       "BELONGS TO THE BASE TYPE BUT IS OUTSIDE " &
-                       "THE RANGE OF THE SUBTYPE");
- 
-      DECLARE
-           N : FLOAT := FLOAT (IDENT_INT (1));
-           SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
-           NUM : FLOAT_1 := N;
-      BEGIN    -- PRE-DEFINED FLOAT COMPARISON
- 
-           IF EQUAL(3,3) THEN
-                NUM := FLOAT_1'(0.5);
-           END IF;
- 
-           IF 2.0 > NUM THEN
-                COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
-                         "COMPARISON");
-           ELSE
-                FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
-                        "COMPARISON");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
-                        "FLOAT COMPARISON");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
-                        "FLOAT COMPARISON");
-      END;  -- PRE-DEFINED FLOAT COMPARISON
- 
-      DECLARE
-           N : FLOAT := FLOAT (IDENT_INT (1));
-           SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
-      BEGIN    -- PRE-DEFINED FLOAT MEMBERSHIP
- 
-           IF 2.0 IN FLOAT_1 THEN
-                FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
-                        "MEMBERSHIP");
-           ELSE
-                COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
-                         "MEMBERSHIP");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
-                        "FLOAT MEMBERSHIP");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
-                        "FLOAT MEMBERSHIP");
-      END;  -- PRE-DEFINED FLOAT MEMBERSHIP
- 
-      DECLARE -- PRECISE FLOAT COMPARISON
-           TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
-           N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
-           SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
-           NUM : SUB_FINE := N;
-      BEGIN
-           IF EQUAL(3,3) THEN
-                NUM := 0.25;
-           END IF;
- 
-           IF 0.75 > NUM THEN
-                COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
-                         "COMPARISON");
-           ELSE
-                FAILED ("WRONG RESULT FROM FINE_FLOAT COMPARISON");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
-                        "FINE_FLOAT COMPARISON");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR  " &
-                        "FINE_FLOAT COMPARISON");
-      END;  --  FINE_FLOAT COMPARISON
- 
-      DECLARE -- PRECISE FLOAT MEMBERSHIP
-           TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
-           N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
-           SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
-      BEGIN
- 
-           IF 0.75 IN SUB_FINE THEN
-                FAILED ("WRONG RESULT FROM FINE_FLOAT MEMBERSHIP");
-           ELSE
-                COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
-                         "MEMBERSHIP");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
-                        "FINE_FLOAT MEMBERSHIP");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR  " &
-                        "FINE_FLOAT MEMBERSHIP");
-      END;  --  FINE_FLOAT MEMBERSHIP
- 
-      RESULT;
- 
- END C45242B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45251a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45251a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45251a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45251a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,178 ****
- -- C45251A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR RELATIONAL OPERATIONS ON FIXED POINT TYPES THE
- -- FOLLOWING HOLD:
- --       (A) A /= B IS THE SAME AS NOT (A = B).
- --       (B) A < B IS THE SAME AS NOT (A >= B).
- --       (C) A > B IS THE SAME AS NOT (A <= B).
- --       (D) ADJACENT MODEL NUMBERS GIVE CORRECT RESULTS.
- --       (E) NON-MODEL NUMBERS WITH DISTINCT MODEL INTERVALS GIVE
- --           CORRECT RESULTS.
- --       (F) CASE WHERE MODEL INTERVALS INTERSECT IN A SINGLE MODEL
- --           NUMBER GIVES CORRECT RESULT.
- 
- -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
- 
- -- WRG 8/26/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45251A IS
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
-      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
- 
- BEGIN
- 
-      TEST ("C45251A", "CHECK RELATIONAL OPERATIONS FOR FIXED POINT " &
-                       "TYPES - BASIC TYPES");
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
-           A, B : LIKE_DURATION_M23 := 0.0;
-           C, D : DECIMAL_M4        := 0.0;
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 2#0.0000_0011#; -- JUST BELOW LIKE_DURATION'SMALL.
-                B := 2#0.0000_0101#; -- JUST ABOVE LIKE_DURATION'SMALL.
-           END IF;
- 
-           -- (A)
-           IF A /= B XOR NOT (A = B) THEN
-                FAILED ("A /= B IS NOT THE SAME AS NOT (A = B)");
-           END IF;
- 
-           -- (B)
-           IF A < B XOR NOT (A >= B) THEN
-                FAILED ("A < B IS NOT THE SAME AS NOT (A >= B)");
-           END IF;
- 
-           -- (C)
-           IF A > B XOR NOT (A <= B) THEN
-                FAILED ("A > B IS NOT THE SAME AS NOT (A <= B)");
-           END IF;
- 
-           -- (D)
-           IF EQUAL (3, 3) THEN
-                A := -(16#1_5180.00#); -- (-86_400.0)
-                B := -(16#1_517F.FC#); -- (-86_400.0 + 1.0/64)
- 
-                C :=  64.0; -- DECIMAL_M4'SMALL.
-                D := 128.0; -- 2 * DECIMAL_M4'SMALL.
-           END IF;
-           IF "=" (LEFT => A, RIGHT => B) THEN
-                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
-                        "- (A = B)");
-           END IF;
-           IF NOT "/=" (LEFT => C, RIGHT => D) THEN
-                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
-                        "- (C /= D)");
-           END IF;
-           IF "<" (LEFT => B, RIGHT => A) THEN
-                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
-                        "- (B < A)");
-           END IF;
-           IF ">" (LEFT => C, RIGHT => D) THEN
-                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
-                        "- (C > D)");
-           END IF;
-           IF ">=" (LEFT => A, RIGHT => B) THEN
-                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
-                        "- (A >= B)");
-           END IF;
-           IF "<=" (LEFT => D, RIGHT => C) THEN
-                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
-                        "- (D <= C)");
-           END IF;
- 
-           -- (E)
-           IF EQUAL (3, 3) THEN
-                A :=  0.02;  -- INTERVAL IS  1.0/64 ..  2.0/64.
-                B := -0.02;  -- INTERVAL IS -2.0/64 .. -1.0/64.
- 
-                C :=  800.0; -- INTERVAL IS 768.0 .. 832.0.
-                D :=  900.0; -- INTERVAL IS 896.0 .. 960.0.
-           END IF;
-           IF A = B THEN
-                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
-                        "INTERVALS GIVE INCORRECT RESULT - (A = B)");
-           END IF;
-           IF NOT (C /= D) THEN
-                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
-                        "INTERVALS GIVE INCORRECT RESULT - (C /= D)");
-           END IF;
-           IF A < B THEN
-                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
-                        "INTERVALS GIVE INCORRECT RESULT - (A < B)");
-           END IF;
-           IF C > D THEN
-                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
-                        "INTERVALS GIVE INCORRECT RESULT - (C > D)");
-           END IF;
-           IF B >= A THEN
-                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
-                        "INTERVALS GIVE INCORRECT RESULT - (B >= A)");
-           END IF;
-           IF D <= C THEN
-                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
-                        "INTERVALS GIVE INCORRECT RESULT - (D <= C)");
-           END IF;
- 
-           -- (F)
-           IF EQUAL (3, 3) THEN
-                B := 0.035;  -- INTERVAL IS 2.0/64 .. 3.0/64.
- 
-                C := 850.0;  -- INTERVAL IS 832.0 .. 896.0.
-           END IF;
-           IF NOT (A <= B) THEN
-                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
-                        "COMMON MODEL INTERVAL END-POINT GIVES " &
-                        "INCORRECT RESULT - (A <= B)");
-           END IF;
-           IF A > B THEN
-                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
-                        "COMMON MODEL INTERVAL END-POINT GIVES " &
-                        "INCORRECT RESULT - (A > B)");
-           END IF;
-           IF NOT (D >= C) THEN
-                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
-                        "COMMON MODEL INTERVAL END-POINT GIVES " &
-                        "INCORRECT RESULT - (D >= C)");
-           END IF;
-           IF D < C THEN
-                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
-                        "COMMON MODEL INTERVAL END-POINT GIVES " &
-                        "INCORRECT RESULT - (D < C)");
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- END C45251A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45252a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45252a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45252a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45252a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,200 ****
- -- C45252A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR FIXED POINT TYPES, CHECK THAT
- -- CONSTRAINT_ERROR IS RAISED WHEN A LITERAL USED IN A COMPARISON OR
- -- MEMBERSHIP OPERATION (AS THE FIRST OPERAND) DOES NOT BELONG TO THE
- -- BASE TYPE.
- --
- -- CHECK THAT NO EXCEPTION IS RAISED FOR A FIXED POINT RELATIONAL OR
- -- MEMBERSHIP OPERATION IF LITERAL VALUES BELONG TO THE BASE TYPE.
- 
- -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- WRG 9/10/86
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45252A IS
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
-      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
-      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
- 
- BEGIN
- 
-      TEST ("C45252A", "CHECK RAISING OF EXCEPTIONS BY RELATIONAL " &
-                       "OPERATIONS FOR FIXED POINT TYPES - BASIC TYPES");
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           -- 2.0 ** 31 < 2.9E9 < 2.0 ** 32.
-           IF 2.9E9 <= LIKE_DURATION_M23'LAST THEN
-                FAILED ("2.9E9 <= LIKE_DURATION_M23'LAST");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
-                         """2.9E9 <= LIKE_DURATION_M23'LAST""");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY COMPARISON " &
-                        """2.9E9 <= LIKE_DURATION_M23'LAST""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           -- 2.0 ** 63 < 1.0E19 < 2.0 ** 64.
-           IF 1.0E19 IN LIKE_DURATION_M23 THEN
-                FAILED ("1.0E19 IN LIKE_DURATION_M23");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
-                         """1.0E19 IN LIKE_DURATION_M23""");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY MEMBERSHIP TEST " &
-                        """1.0E19 IN LIKE_DURATION_M23""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           -- 2.0 ** 63 < 1.0E19 < 2.0 ** 64.
-           IF 1.0E19 <= MIDDLE_M3'LAST THEN
-                FAILED ("1.0E19 <= MIDDLE_M3'LAST");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
-                         """1.0E19 <= MIDDLE_M3'LAST""");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY COMPARISON " &
-                        """1.0E19 <= MIDDLE_M3'LAST""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           -- 2.0 ** 31 < 2.9E9 < 2.0 ** 32.
-           IF 2.9E9 IN MIDDLE_M3 THEN
-                FAILED ("2.9E9 IN MIDDLE_M3");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
-                         """2.9E9 IN MIDDLE_M3""");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY MEMBERSHIP TEST " &
-                        """2.9E9 IN MIDDLE_M3""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           -- 3.5 IS A MODEL NUMBER OF THE TYPE MIDDLE_M3.
-           IF 3.5 <= MIDDLE_M3'LAST THEN
-                FAILED ("3.5 <= MIDDLE_M3'LAST");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
-                        """3.5 <= MIDDLE_M3'LAST""");
-           WHEN OTHERS =>
-                FAILED ("SOME EXCEPTION RAISED BY COMPARISON " &
-                        """3.5 <= MIDDLE_M3'LAST""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           IF 3.0 IN MIDDLE_M3 THEN
-                FAILED ("3.0 IN MIDDLE_M3");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
-                        """3.0 IN MIDDLE_M3""");
-           WHEN OTHERS =>
-                FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
-                        """3.0 IN MIDDLE_M3""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           IF 86_450.0 <= LIKE_DURATION_M23'LAST THEN
-                FAILED ("86_450.0 <= LIKE_DURATION_M23'LAST");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
-                        """86_450.0 <= LIKE_DURATION_M23'LAST""");
-           WHEN OTHERS =>
-                FAILED ("SOME EXCEPTION RAISED BY COMPARISON " &
-                        """86_450.0 <= LIKE_DURATION_M23'LAST""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           IF 86_500.0 IN LIKE_DURATION_M23 THEN
-                FAILED ("86_500.0 IN LIKE_DURATION_M23");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
-                        """86_500.0 IN LIKE_DURATION_M23""");
-           WHEN OTHERS =>
-                FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
-                        """86_500.0 IN LIKE_DURATION_M23""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      BEGIN
-           IF -86_450.0 IN LIKE_DURATION_M23 THEN
-                FAILED ("-86_450.0 IN LIKE_DURATION_M23");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
-                        """-86_450.0 IN LIKE_DURATION_M23""");
-           WHEN OTHERS =>
-                FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
-                        """-86_450.0 IN LIKE_DURATION_M23""");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- END C45252A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45252b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45252b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45252b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45252b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- C45252B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NO EXCEPTION IS RAISED WHEN A FIXED POINT LITERAL
- --     OPERAND IN A COMPARISON OR A FIXED POINT LITERAL LEFT OPERAND
- --     IN A MEMBERSHIP TEST BELONGS TO THE BASE TYPE BUT IS OUTSIDE
- --     THE RANGE OF THE SUBTYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     PWB 09/04/86 CREATED ORIGINAL TEST.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT, SYSTEM; USE REPORT;
- PROCEDURE C45252B IS
- 
- BEGIN
- 
-      TEST ("C45252B", "NO EXCEPTION IS RAISED WHEN A FIXED " &
-                       "LITERAL USED IN A COMPARISON OR AS THE " &
-                       "LEFT OPERAND IN A MEMBERSHIP TEST " &
-                       "BELONGS TO THE BASE TYPE BUT IS OUTSIDE " &
-                       "THE RANGE OF THE SUBTYPE");
- 
-      DECLARE
-           TYPE FIXED IS DELTA 0.25 RANGE -10.0 .. 10.0;
-           SUBTYPE FIXED_1 IS FIXED RANGE -1.0 .. 1.0;
-           NUM : FIXED_1 := 0.0;
-      BEGIN    -- FIXED COMPARISON
- 
-           IF EQUAL(3,3) THEN
-                NUM := FIXED_1'(0.5);
-           END IF;
- 
-           IF 2.0 > NUM THEN
-                COMMENT ("NO EXCEPTION RAISED FOR FIXED " &
-                         "COMPARISON");
-           ELSE
-                FAILED ("WRONG RESULT FROM FIXED " &
-                        "COMPARISON");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
-                        "FIXED COMPARISON");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR " &
-                        "FIXED COMPARISON");
-      END;  -- FIXED COMPARISON
- 
-      DECLARE
-           TYPE FIXED IS DELTA 0.25 RANGE -10.0 .. 10.0;
-           SUBTYPE FIXED_1 IS FIXED RANGE -1.0 .. 1.0;
-      BEGIN    -- FIXED MEMBERSHIP
- 
-           IF 2.0 IN FIXED_1 THEN
-                FAILED ("WRONG RESULT FROM FIXED " &
-                        "MEMBERSHIP");
-           ELSE
-                COMMENT ("NO EXCEPTION RAISED FOR FIXED " &
-                         "MEMBERSHIP");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR  " &
-                        "FIXED MEMBERSHIP");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR  " &
-                        "FIXED MEMBERSHIP");
-      END;  -- FIXED MEMBERSHIP
- 
-      DECLARE -- PRECISE FIXED COMPARISON
-           TYPE FINE_FIXED IS DELTA SYSTEM.FINE_DELTA RANGE -1.0 .. 1.0;
-           SUBTYPE SUB_FINE IS FINE_FIXED RANGE -0.5 .. 0.5;
-           NUM : SUB_FINE := 0.0;
-      BEGIN
-           IF EQUAL(3,3) THEN
-                NUM := 0.25;
-           END IF;
- 
-           IF 0.75 > NUM THEN
-                COMMENT ("NO EXCEPTION RAISED FOR FINE_FIXED " &
-                         "COMPARISON");
-           ELSE
-                FAILED ("WRONG RESULT FROM FINE_FIXED COMPARISON");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
-                        "FINE_FIXED COMPARISON");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR  " &
-                        "FINE_FIXED COMPARISON");
-      END;  --  FINE_FIXED COMPARISON
- 
-      DECLARE -- PRECISE FIXED MEMBERSHIP
-           TYPE FINE_FIXED IS DIGITS SYSTEM.MAX_DIGITS;
-           SUBTYPE SUB_FINE IS FINE_FIXED RANGE -0.5 .. 0.5;
-      BEGIN
- 
-           IF 0.75 IN SUB_FINE THEN
-                FAILED ("WRONG RESULT FROM FINE_FIXED MEMBERSHIP");
-           ELSE
-                COMMENT ("NO EXCEPTION RAISED FOR FINE_FIXED " &
-                         "MEMBERSHIP");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
-                        "FINE_FIXED MEMBERSHIP");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR  " &
-                        "FINE_FIXED MEMBERSHIP");
-      END;  --  FINE_FIXED MEMBERSHIP
- 
-      RESULT;
- 
- END C45252B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45253a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45253a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45253a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45253a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C45253A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES "A IN T" AND "A NOT IN T" GIVE
- -- APPROPRIATE RESULTS, EVEN WHEN USER-DEFINED ORDERING OPERATORS EXIST
- -- FOR T.
- 
- -- WRG 8/27/86
- -- JRL 06/12/96  Added function The_Delta. Eliminated static expressions
- --               outside the base range of type T.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45253A IS
- 
-      TYPE FIXED IS DELTA 0.25 RANGE 0.0 .. 1000.0;
-      TYPE T IS NEW FIXED;
- 
-      FUNCTION "<" (LEFT, RIGHT : T) RETURN BOOLEAN IS
-      BEGIN
-           RETURN FIXED (LEFT) >= FIXED (RIGHT);
-      END "<";
- 
-      FUNCTION "<=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
-      BEGIN
-           RETURN FIXED (LEFT) > FIXED (RIGHT);
-      END "<=";
- 
-      FUNCTION ">" (LEFT, RIGHT : T) RETURN BOOLEAN IS
-      BEGIN
-           RETURN FIXED (LEFT) <= FIXED (RIGHT);
-      END ">";
- 
-      FUNCTION ">=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
-      BEGIN
-           RETURN FIXED (LEFT) < FIXED (RIGHT);
-      END ">=";
- 
-      function The_Delta return T is
-      begin
-         return T'Delta;
-      end The_Delta;
- 
- BEGIN
- 
-      TEST ("C45253A", "CHECK THAT FOR FIXED POINT TYPES ""A IN T"" " &
-                       "AND ""A NOT IN T"" GIVE APPROPRIATE RESULTS, " &
-                       "EVEN WHEN USER-DEFINED ORDERING OPERATORS " &
-                       "EXIST FOR T");
- 
-      IF IDENT_INT (1) * 0.0 NOT IN T THEN
-           FAILED ("0.0 NOT IN T");
-      END IF;
- 
- -- 06/12/96      IF IDENT_INT (1) * 1000.0 NOT IN T THEN
-      if Ident_Int (2) * 500.0 not in T then
-           FAILED ("1000.0 NOT IN T");
-      END IF;
- 
- -- 06/12/96      IF IDENT_INT (1) * (-0.25) IN T THEN
-      if Ident_Int (1) * (-The_Delta) in T then
-           FAILED ("-0.25 IN T");
-      END IF;
- 
- -- 06/12/96      IF IDENT_INT (1) * 1000.25 IN T THEN
-      if Ident_Int (2) * 500.0 + The_Delta in T then
-           FAILED ("1000.25 IN T");
-      END IF;
- 
- -- 06/12/96      IF IDENT_INT (1) * (-1000.0) IN T THEN
-      if Ident_Int (2) * (-500.0) in T then
-           FAILED ("-1000.0 IN T");
-      END IF;
- 
-      RESULT;
- 
- END C45253A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,214 ****
- -- C45262A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
- -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS ARRAYS OF
- -- INTEGERS.
- 
- -- JWC 8/19/85
- -- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45262A IS
- BEGIN
-      TEST ("C45262A", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
-                       "DISCRETE ARRAY TYPES - INTEGER COMPONENTS");
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY( INTEGER RANGE <> ) OF INTEGER;
-           ARR1 : ARR(1 .. IDENT_INT(0));
-           ARR2 : ARR(2 .. IDENT_INT(0));
-           ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 0);
-           ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 0);
-           ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 1);
-           ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => 0);
-           ARR7 : ARR(0 .. 4) := (0 .. 3 => 0, 4 => 1);
-           ARR8 : ARR(0 .. IDENT_INT(4)) := (0 .. IDENT_INT(4) => 0);
-           ARR9 : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => 0);
-           ARRA : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => 1);
- 
-      BEGIN
-           IF ARR1 < ARR2 THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR1 <= ARR2) THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <=");
-           END IF;
- 
-           IF ARR1 > ARR2 THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >");
-           END IF;
- 
-           IF NOT ( ">=" (ARR1, ARR2) ) THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >=");
-           END IF;
- 
-           IF ARR3 < ARR1 THEN
-                FAILED ("NON-NULL ARRAY ARR3 LESS THAN NULL ARR1");
-           END IF;
- 
-           IF ARR3 <= ARR1 THEN
-                FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL ARR1");
-           END IF;
- 
-           IF NOT ( ">" (ARR3, ARR1) ) THEN
-                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN NULL " &
-                        "ARR1");
-           END IF;
- 
-           IF NOT (ARR3 >= ARR1) THEN
-                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN EQUAL " &
-                        "NULL ARR1");
-           END IF;
- 
-           IF ARR3 < ARR4 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF NOT ( "<=" (ARR3, ARR4) ) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF ARR3 > ARR4 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (ARR3 >= ARR4) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF NOT ( "<" (ARR3, ARR5) ) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR3 <= ARR5) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <=");
-           END IF;
- 
-           IF ARR3 > ARR5 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF ARR3 >= ARR5 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >=");
-           END IF;
- 
-           IF NOT (ARR6 < ARR7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR6 <= ARR7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
-                        "<=");
-           END IF;
- 
-           IF ARR6 > ARR7 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF ">=" (LEFT => ARR6, RIGHT => ARR7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
-                        ">=");
-           END IF;
- 
-           IF ARR6 < ARR8 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR6 <= ARR8) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF ">" (RIGHT => ARR8, LEFT => ARR6) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (ARR6 >= ARR8) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF ARR8 < ARR9 THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF ARR8 <= ARR9 THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF NOT (ARR8 > ARR9) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (ARR8 >= ARR9) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF NOT (ARR8 < ARRA) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR8 <= ARRA) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <=");
-           END IF;
- 
-           IF ARR8 > ARRA THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF ARR8 >= ARRA THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >=");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45262A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,219 ****
- -- C45262B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
- -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS STRING TYPES.
- 
- -- JWC 9/9/85
- -- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45262B IS
- BEGIN
-      TEST ("C45262B", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
-                       "DISCRETE ARRAY TYPES - TYPE STRING");
- 
-      DECLARE
- 
-           STRING1 : STRING(2 .. IDENT_INT(1));
-           STRING2 : STRING(3 .. IDENT_INT(1));
-           STRING3 : STRING(2 .. IDENT_INT(2)) := (IDENT_INT(2) => 'A');
-           STRING4 : STRING(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 'A');
-           STRING5 : STRING(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 'B');
-           STRING6 : STRING(2 .. IDENT_INT(6)) :=
-                                              (2 .. IDENT_INT(6) => 'A');
-           STRING7 : STRING(1 .. 5) := (1 .. 4 => 'A', 5 => 'B');
-           STRING8 : STRING(1 .. IDENT_INT(5)) :=
-                                              (1 .. IDENT_INT(5) => 'A');
-           STRING9 : STRING(1 .. IDENT_INT(4)) :=
-                                              (1 .. IDENT_INT(4) => 'A');
-           STRINGA : STRING(1 .. IDENT_INT(4)) :=
-                                              (1 .. IDENT_INT(4) => 'B');
- 
-      BEGIN
-           IF STRING1 < STRING2 THEN
-                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (STRING1 <= STRING2) THEN
-                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - " &
-                        "<=");
-           END IF;
- 
-           IF STRING1 > STRING2 THEN
-                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - >");
-           END IF;
- 
-           IF NOT ( ">=" (STRING1, STRING2) ) THEN
-                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - " &
-                        ">=");
-           END IF;
- 
-           IF STRING3 < STRING1 THEN
-                FAILED ("NON-NULL ARRAY STRING3 LESS THAN NULL STRING1");
-           END IF;
- 
-           IF STRING3 <= STRING1 THEN
-                FAILED ("NON-NULL ARRAY STRING3 LESS THAN EQUAL NULL " &
-                         "STRING1");
-           END IF;
- 
-           IF NOT ( ">" (STRING3, STRING1) ) THEN
-                FAILED ("NON-NULL ARRAY STRING3 NOT GREATER THAN NULL " &
-                        "STRING1");
-           END IF;
- 
-           IF NOT (STRING3 >= STRING1) THEN
-                FAILED ("NON-NULL ARRAY STRING3 NOT GREATER THAN " &
-                        "EQUAL NULL STRING1");
-           END IF;
- 
-           IF STRING3 < STRING4 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF NOT ( "<=" (STRING3, STRING4) ) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF STRING3 > STRING4 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (STRING3 >= STRING4) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF NOT ( "<" (STRING3, STRING5) ) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (STRING3 <= STRING5) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <=");
-           END IF;
- 
-           IF STRING3 > STRING5 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF STRING3 >= STRING5 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >=");
-           END IF;
- 
-           IF NOT (STRING6 < STRING7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (STRING6 <= STRING7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
-                        "<=");
-           END IF;
- 
-           IF STRING6 > STRING7 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF ">=" (LEFT => STRING6, RIGHT => STRING7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
-                        ">=");
-           END IF;
- 
-           IF STRING6 < STRING8 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF NOT (STRING6 <= STRING8) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF ">" (RIGHT => STRING8, LEFT => STRING6) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (STRING6 >= STRING8) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF STRING8 < STRING9 THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF STRING8 <= STRING9 THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF NOT (STRING8 > STRING9) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (STRING8 >= STRING9) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF NOT (STRING8 < STRINGA) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (STRING8 <= STRINGA) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <=");
-           END IF;
- 
-           IF STRING8 > STRINGA THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF STRING8 >= STRINGA THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >=");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45262B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- C45262C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
- -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS ARRAYS OF
- -- AN ENUMERATION TYPE.
- 
- -- JWC 8/19/85
- -- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45262C IS
- BEGIN
-      TEST ("C45262C", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
-                       "DISCRETE ARRAY TYPES - ENUMERATED COMPONENTS");
- 
-      DECLARE
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 5;
-           TYPE ENUM IS (E0, E1);
-           TYPE ARR IS ARRAY( SUBINT RANGE <> ) OF ENUM;
-           ARR1 : ARR(1 .. IDENT_INT(0));
-           ARR2 : ARR(2 .. IDENT_INT(0));
-           ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => E0);
-           ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => E0);
-           ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => E1);
-           ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => E0);
-           ARR7 : ARR(0 .. 4) := (0 .. 3 => E0, 4 => E1);
-           ARR8 : ARR(0 .. IDENT_INT(4)) := (0 .. IDENT_INT(4) => E0);
-           ARR9 : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => E0);
-           ARRA : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => E1);
- 
-      BEGIN
-           IF ARR1 < ARR2 THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR1 <= ARR2) THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <=");
-           END IF;
- 
-           IF ARR1 > ARR2 THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >");
-           END IF;
- 
-           IF NOT ( ">=" (ARR1, ARR2) ) THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >=");
-           END IF;
- 
-           IF ARR3 < ARR1 THEN
-                FAILED ("NON-NULL ARRAY ARR3 LESS THAN NULL ARR1");
-           END IF;
- 
-           IF ARR3 <= ARR1 THEN
-                FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL ARR1");
-           END IF;
- 
-           IF NOT ( ">" (ARR3, ARR1) ) THEN
-                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN NULL " &
-                        "ARR1");
-           END IF;
- 
-           IF NOT (ARR3 >= ARR1) THEN
-                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN EQUAL " &
-                        "NULL ARR1");
-           END IF;
- 
-           IF ARR3 < ARR4 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF NOT ( "<=" (ARR3, ARR4) ) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF ARR3 > ARR4 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (ARR3 >= ARR4) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF NOT ( "<" (ARR3, ARR5) ) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR3 <= ARR5) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <=");
-           END IF;
- 
-           IF ARR3 > ARR5 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF ARR3 >= ARR5 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >=");
-           END IF;
- 
-           IF NOT (ARR6 < ARR7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR6 <= ARR7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
-                        "<=");
-           END IF;
- 
-           IF ARR6 > ARR7 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF ">=" (LEFT => ARR6, RIGHT => ARR7) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
-                        ">=");
-           END IF;
- 
-           IF ARR6 < ARR8 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR6 <= ARR8) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF ">" (RIGHT => ARR8, LEFT => ARR6) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (ARR6 >= ARR8) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF ARR8 < ARR9 THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <");
-           END IF;
- 
-           IF ARR8 <= ARR9 THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - <=");
-           END IF;
- 
-           IF NOT (ARR8 > ARR9) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (ARR8 >= ARR9) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >=");
-           END IF;
- 
-           IF NOT (ARR8 < ARRA) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-           IF NOT (ARR8 <= ARRA) THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - <=");
-           END IF;
- 
-           IF ARR8 > ARRA THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >");
-           END IF;
- 
-           IF ARR8 >= ARRA THEN
-                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >=");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45262C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45262d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45262d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C45262D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
- -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST USES
- -- USER-DEFINED ORDERING OPERATORS FOR THE DISCRETE COMPONENT TYPE.
- 
- -- JWC 8/19/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45262D IS
- 
-      FUNCTION "<"(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN STANDARD.">="(LEFT, RIGHT);
-      END "<";
- 
-      FUNCTION "<="(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN STANDARD.">"(LEFT, RIGHT);
-      END "<=";
- 
-      FUNCTION ">"(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN STANDARD."<="(LEFT, RIGHT);
-      END ">";
- 
-      FUNCTION ">="(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN STANDARD."<"(LEFT, RIGHT);
-      END ">=";
- 
- BEGIN
-      TEST ("C45262D", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
-                       "DISCRETE ARRAY TYPES");
- 
-      DECLARE
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 5;
-           TYPE ARR IS ARRAY( SUBINT RANGE <> ) OF INTEGER;
-           ARR1 : ARR(1 .. IDENT_INT(0));
-           ARR2 : ARR(2 .. IDENT_INT(0));
-           ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 0);
-           ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 0);
-           ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 1);
-           ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => 0);
-           ARR7 : ARR(0 .. 4) := (0 .. 3 => 0, 4 => 1);
- 
-      BEGIN
- 
-           IF ARR1 < ARR2 THEN
-                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
-           END IF;
- 
-           IF ARR3 <= ARR1 THEN
-                FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL " &
-                        "ARR1");
-           END IF;
- 
-           IF ARR3 > ARR4 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS EQUAL - >");
-           END IF;
- 
-           IF NOT (ARR3(1) > ARR4(0)) THEN
-                FAILED ("REDEFINED COMPONENT COMPARISON - >");
-           END IF;
- 
-           IF ARR3 >= ARR5 THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "COMPONENTS NOT EQUAL - >=");
-           END IF;
- 
-           IF NOT ( "<" (ARR6, ARR7) ) THEN
-                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
-                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45262D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45264a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45264a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45264a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45264a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C45264A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EQUALITY COMPARISONS YIELD CORRECT RESULTS FOR ONE
- -- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES.
- -- CASE THAT CHECKS THAT TWO NULL ARRAYS OF THE SAME TYPE ARE
- -- ALWAYS EQUAL.
- 
- -- PK  02/21/84
- -- EG  05/30/84
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE C45264A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 3;
- 
- BEGIN
- 
-      TEST("C45264A","CHECK THAT EQUALITY COMPARISONS YIELD CORRECT " &
-                     "RESULTS FOR ONE DIMENSIONAL AND MULTI-"         &
-                     "DIMENSIONAL ARRAY TYPES");
- 
-      DECLARE
- 
-           TYPE A1 IS ARRAY(INT RANGE <>) OF INTEGER;
- 
-      BEGIN
- 
-           IF A1'(1 .. IDENT_INT(2) => IDENT_INT(1)) /=
-              A1'(IDENT_INT(2) .. 3 => IDENT_INT(1)) THEN
-                FAILED ("A1 - ARRAYS NOT EQUAL");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN OTHERS => 
-                FAILED ("A1 - EXCEPTION RAISED");
- 
-      END;
- 
-      DECLARE
- 
-           TYPE A2 IS ARRAY(INT RANGE <>, INT RANGE <>) OF INTEGER;
- 
-      BEGIN
-           IF A2'(1 .. IDENT_INT(2) => 
-                  (IDENT_INT(3) .. IDENT_INT(2) => IDENT_INT(1))) /=
-              A2'(IDENT_INT(2) .. 3 => 
-                  (IDENT_INT(2) .. IDENT_INT(1) =>  IDENT_INT(1))) THEN
-                 FAILED ("A2 - ARRAYS NOT EQUAL");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN OTHERS => 
-                 FAILED ("A2 - EXCEPTION RAISED");
- 
-      END;
- 
-      DECLARE
- 
-           TYPE A3 IS 
-                ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>) OF
-                     INTEGER;
- 
-      BEGIN
- 
-           IF A3'(1 .. IDENT_INT(2) => 
-                  (IDENT_INT(1) .. IDENT_INT(3) => 
-                   (IDENT_INT(3) .. IDENT_INT(2) => IDENT_INT(1)))) /=
-              A3'(IDENT_INT(1) .. 3 => 
-                  (IDENT_INT(2) .. IDENT_INT(1) =>  
-                   (IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)))) THEN
-                 FAILED ("A3 - ARRAYS NOT EQUAL");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN OTHERS => 
-                 FAILED ("A3 - EXCEPTION RAISED");
- 
-      END;
- 
-      RESULT;
- 
- END C45264A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45264b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45264b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45264b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45264b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- C45264B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EQUALITY COMPARISONS YIELD CORRECT RESULTS FOR ONE
- -- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES.
- -- THIS TEST CHECKS THE CASE WHERE THE ARRAY HAS A BOUND THAT DEPENDS ON
- -- A DISCRIMINANT WITH DEFAULTS.
- 
- -- JWC 11/18/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45264B IS
- 
- BEGIN
- 
-      TEST("C45264B","CHECK THAT EQUALITY COMPARISONS YIELD CORRECT " &
-                     "RESULTS FOR ONE DIMENSIONAL AND MULTI-"         &
-                     "DIMENSIONAL ARRAY TYPES");
- 
-      DECLARE
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 1 .. 5;
-           TYPE REC (DISC : SUBINT := 1) IS
-                RECORD
-                     COMP : STRING(IDENT_INT(3) .. DISC);
-                END RECORD;
-           TYPE ARR IS ARRAY (1 .. 3) OF REC;
- 
-           A1, A2 : ARR;
- 
-      BEGIN
- 
-           IF A1 /= A2 THEN
-                FAILED ("NULL ARRAYS, RESULT NOT EQUAL");
-           END IF;
- 
-           A1(2) := (5, "ABC");
- 
-           IF A1 = A2 THEN
-                FAILED ("NON-NULL ARRAY AND NULL ARRAY, RESULT EQUAL");
-           END IF;
- 
-           A2(2) := (5, "ABD");
- 
-           IF A1 = A2 THEN
-                FAILED ("ARRAYS DIFFER BY LAST ELEMENT, RESULT EQUAL");
-           END IF;
- 
-           A2(2) := (4, "AB");
- 
-           IF A1 = A2 THEN
-                FAILED ("ARRAYS OF DIFFERENT LENGTH, RESULT EQUAL");
-           END IF;
- 
-           A1(2) := (4, "AB");
- 
-           IF A1 /= A2 THEN
-                FAILED ("DISCRIMINANTS AND COMPONENTS ARE THE SAME, " &
-                        "RESULT NOT EQUAL");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45264B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45264c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45264c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45264c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45264c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C45264C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT COMPARING ARRAYS OF DIFFERENT LENGTHS DOES NOT RAISE AN
- -- EXCEPTION.
- 
- -- TBN  7/21/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45264C IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
-      TYPE ARRAY_TYPE_1 IS ARRAY (INT RANGE <>) OF INTEGER;
-      TYPE ARRAY_TYPE_2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
-      TYPE ARRAY_TYPE_3 IS ARRAY (INT RANGE <>, INT RANGE <>,
-                                                INT RANGE <>) OF INTEGER;
- 
-      ARRAY_1 : ARRAY_TYPE_1 (1..5) := (1..5 => 1);
-      ARRAY_2 : ARRAY_TYPE_1 (1..7) := (1..7 => 1);
-      ARRAY_3 : ARRAY_TYPE_2 (1..5, 1..4) := (1..5 => (1..4 => 1));
-      ARRAY_4 : ARRAY_TYPE_2 (1..2, 1..3) := (1..2 => (1..3 => 1));
-      ARRAY_5 : ARRAY_TYPE_3 (1..2, 1..3, 1..2) := (1..2 => (1..3 =>
-                                                   (1..2 => 2)));
-      ARRAY_6 : ARRAY_TYPE_3 (1..1, 1..2, 1..3) := (1..1 => (1..2 =>
-                                                   (1..3 => 2)));
-      ARRAY_7 : ARRAY_TYPE_2 (1..5, 1..4) := (1..5 => (1..4 => 3));
-      ARRAY_8 : ARRAY_TYPE_2 (1..5, 1..3) := (1..5 => (1..3 => 3));
-      ARRAY_9 : ARRAY_TYPE_2 (1..3, 1..2) := (1..3 => (1..2 => 4));
-      ARRAY_10 : ARRAY_TYPE_2 (1..2, 1..2) := (1..2 => (1..2 => 4));
- 
- BEGIN
-      TEST ("C45264C", "CHECK THAT COMPARING ARRAYS OF DIFFERENT " &
-                       "LENGTHS DOES NOT RAISE AN EXCEPTION");
- 
-      BEGIN     -- (A)
-           IF "=" (ARRAY_1 (1..INTEGER'FIRST), ARRAY_2) THEN
-                FAILED ("INCORRECT RESULTS FROM COMPARING ONE " &
-                        "DIMENSIONAL ARRAYS - 1");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED EVALUATING - 1");
-      END;     -- (A)
- 
-      BEGIN     -- (B)
-           IF ARRAY_1 /= ARRAY_2 THEN
-                NULL;
-           ELSE
-                FAILED ("INCORRECT RESULTS FROM COMPARING ONE " &
-                        "DIMENSIONAL ARRAYS - 2");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED EVALUATING - 2");
-      END;     -- (B)
- 
-      BEGIN     -- (C)
-           IF ARRAY_3 = ARRAY_4 THEN
-                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
-                        "DIMENSIONAL ARRAYS - 3");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED EVALUATING - 3");
-      END;     -- (C)
- 
-      BEGIN     -- (D)
-           IF "/=" (ARRAY_3, ARRAY_4) THEN
-                NULL;
-           ELSE
-                FAILED ("INCORRECT RESULTS FROM COMPARING MULT-" &
-                        "DIMENSIONAL ARRAYS - 4");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - 4");
-      END;     -- (D)
- 
-      BEGIN     -- (E)
-           IF "=" (ARRAY_5, ARRAY_6) THEN
-                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
-                        "DIMENSIONAL ARRAYS - 5");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED EVALUATING - 5");
-      END;     -- (E)
- 
-      BEGIN     -- (F)
-           IF ARRAY_6 /= ARRAY_5 THEN
-                NULL;
-           ELSE
-                FAILED ("INCORRECT RESULTS FROM COMPARING MULT-" &
-                        "DIMENSIONAL ARRAYS - 6");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - 6");
-      END;     -- (F)
- 
-      BEGIN     -- (G)
-           IF ARRAY_7 = ARRAY_8 THEN
-                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
-                        "DIMENSIONAL ARRAYS - 7");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED EVALUATING - 7");
-      END;     -- (G)
- 
-      BEGIN     -- (H)
-           IF ARRAY_9 /= ARRAY_10 THEN
-                NULL;
-           ELSE
-                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
-                        "DIMENSIONAL ARRAYS - 8");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED EVALUATING - 8");
-      END;     -- (H)
- 
-      RESULT;
- END C45264C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45265a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45265a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45265a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45265a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- C45265A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT MEMBERSHIP TESTS YIELD THE CORRECT RESULTS FOR ONE
- -- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES WHEN:
- --     A) THE SUBTYPE INDICATION DENOTES AN UNCONSTRAINED ARRAY.
- --     B) THE SUBTYPE INDICATION DENOTES A CONSTRAINED ARRAY.
- 
- -- TBN  7/22/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45265A IS
- 
-      PACKAGE P IS
-           TYPE KEY IS LIMITED PRIVATE;
-      PRIVATE
-           TYPE KEY IS NEW NATURAL;
-      END P;
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 20;
-      TYPE ARRAY_TYPE_1 IS ARRAY (INT RANGE <>) OF INTEGER;
-      TYPE ARRAY_TYPE_2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
-      TYPE ARRAY_TYPE_3 IS ARRAY (INT RANGE <>, INT RANGE <>,
-                                                INT RANGE <>) OF INTEGER;
-      TYPE ARRAY_TYPE_4 IS ARRAY (INT RANGE <>) OF P.KEY;
-      TYPE ARRAY_TYPE_5 IS ARRAY (INT RANGE <>, INT RANGE <>) OF P.KEY;
- 
-      SUBTYPE ARRAY_SUB1 IS ARRAY_TYPE_1;
-      SUBTYPE ARRAY_SUB2 IS ARRAY_TYPE_2;
-      SUBTYPE ARRAY_SUB3 IS ARRAY_TYPE_3;
-      SUBTYPE ARRAY_SUB4 IS ARRAY_TYPE_4;
-      SUBTYPE ARRAY_SUB5 IS ARRAY_TYPE_5;
-      SUBTYPE CON_ARRAY1 IS ARRAY_TYPE_1 (1..5);
-      SUBTYPE CON_ARRAY2 IS ARRAY_TYPE_2 (1..2, 1..2);
-      SUBTYPE CON_ARRAY3 IS ARRAY_TYPE_3 (1..2, 1..3, 1..4);
-      SUBTYPE CON_ARRAY4 IS ARRAY_TYPE_4 (1..4);
-      SUBTYPE CON_ARRAY5 IS ARRAY_TYPE_5 (1..2, 1..3);
-      SUBTYPE NULL_ARRAY1 IS ARRAY_TYPE_1 (2 .. 1);
- 
-      ARRAY1 : ARRAY_TYPE_1 (1..10);
-      ARRAY2 : ARRAY_SUB1 (11..20);
-      ARRAY3 : ARRAY_TYPE_2 (1..4, 1..3);
-      ARRAY4 : ARRAY_SUB2 (5..7, 5..8);
-      ARRAY5 : ARRAY_TYPE_3 (1..2, 1..3, 1..4);
-      ARRAY6 : ARRAY_SUB3 (1..3, 1..2, 1..4);
-      NULL_ARRAY_1 : ARRAY_TYPE_1 (3..2);
-      NULL_ARRAY_2 : ARRAY_SUB1 (2..1);
-      ARRAY7 : ARRAY_TYPE_1 (1..10) := (1..10 => 7);
-      ARRAY8 : CON_ARRAY1 := (1..5 => 8);
-      ARRAY9 : ARRAY_TYPE_2 (1..10, 1..10) := (1..10 => (1..10 => 9));
-      ARRAY10 : CON_ARRAY2 := (1..2 => (1..2 => 10));
-      ARRAY11 : ARRAY_TYPE_3 (1..10, 1..10, 1..10) := (1..10 =>
-                                               (1..10 => (1..10 => 11)));
-      ARRAY12 : CON_ARRAY3 := (1..2 => (1..3 => (1..4 => 12)));
-      ARRAY13 : ARRAY_TYPE_4 (1..2);
-      ARRAY14 : ARRAY_SUB4 (1..5);
-      ARRAY15 : ARRAY_TYPE_4 (1..6);
-      ARRAY16 : CON_ARRAY4;
-      ARRAY17 : ARRAY_TYPE_5 (1..3, 1..2);
-      ARRAY18 : ARRAY_SUB5 (1..2, 1..3);
-      ARRAY19 : ARRAY_TYPE_5 (1..4, 1..3);
-      ARRAY20 : CON_ARRAY5;
- 
- BEGIN
-      TEST ("C45265A", "CHECK THAT MEMBERSHIP TESTS YIELD THE CORRECT " &
-                       "RESULTS FOR ONE DIMENSIONAL AND MULTI-" &
-                       "DIMENSIONAL ARRAY TYPES");
- 
-      ARRAY1 := (ARRAY1'RANGE => 1);
-      ARRAY2 := (ARRAY2'RANGE => 2);
-      ARRAY3 := (ARRAY3'RANGE(1) => (ARRAY3'RANGE(2) => 3));
-      ARRAY4 := (ARRAY4'RANGE(1) => (ARRAY4'RANGE(2) => 4));
-      ARRAY5 := (ARRAY5'RANGE(1) => (ARRAY5'RANGE(2) =>
-                                    (ARRAY5'RANGE(3) => 5)));
-      ARRAY6 := (ARRAY6'RANGE(1) => (ARRAY6'RANGE(2) =>
-                                    (ARRAY6'RANGE(3) => 6)));
- 
-      IF ARRAY1 IN ARRAY_SUB1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 1");
-      END IF;
-      IF ARRAY2 NOT IN ARRAY_SUB1 THEN
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 2");
-      END IF;
- 
-      IF ARRAY3 IN ARRAY_SUB2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 3");
-      END IF;
-      IF ARRAY4 NOT IN ARRAY_SUB2 THEN
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 4");
-      END IF;
- 
-      IF ARRAY5 IN ARRAY_SUB3 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 5");
-      END IF;
-      IF ARRAY6 NOT IN ARRAY_SUB3 THEN
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 6");
-      END IF;
- 
-      IF NULL_ARRAY_1 IN ARRAY_SUB1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 7");
-      END IF;
-      IF NULL_ARRAY_2 NOT IN ARRAY_SUB1 THEN
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 8");
-      END IF;
- 
-      IF ARRAY7 IN CON_ARRAY1 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 9");
-      END IF;
-      IF ARRAY8 NOT IN CON_ARRAY1 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 10");
-      END IF;
- 
-      IF ARRAY9 IN CON_ARRAY2 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 11");
-      END IF;
-      IF ARRAY10 NOT IN CON_ARRAY2 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 12");
-      END IF;
- 
-      IF ARRAY11 IN CON_ARRAY3 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 13");
-      END IF;
-      IF ARRAY12 NOT IN CON_ARRAY3 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 14");
-      END IF;
- 
-      IF ARRAY13 IN ARRAY_SUB4 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 15");
-      END IF;
-      IF ARRAY14 NOT IN ARRAY_SUB4 THEN
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 16");
-      END IF;
- 
-      IF ARRAY15 IN CON_ARRAY4 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 17");
-      END IF;
-      IF ARRAY16 NOT IN CON_ARRAY4 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 18");
-      END IF;
- 
-      IF ARRAY17 IN ARRAY_SUB5 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 19");
-      END IF;
-      IF ARRAY18 NOT IN ARRAY_SUB5 THEN
-           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 20");
-      END IF;
- 
-      IF ARRAY19 IN CON_ARRAY5 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 21");
-      END IF;
-      IF ARRAY20 NOT IN CON_ARRAY5 THEN
-           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 22");
-      END IF;
- 
-      IF NULL_ARRAY_1 IN NULL_ARRAY1 THEN
-           FAILED ("INCORRECT RESULTS FOR NULL ARRAYS - 23");
-      END IF;
-      IF NULL_ARRAY_2 NOT IN NULL_ARRAY1 THEN
-           FAILED ("INCORRECT RESULTS FOR NULL ARRAYS - 24");
-      END IF;
- 
-      RESULT;
- END C45265A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45271a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45271a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45271a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45271a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C45271A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR
- -- RECORDS WHOSE COMPONENTS DO NOT HAVE CHANGEABLE DISCRIMINANTS.
- 
- -- TBN  8/6/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45271A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 20;
-      TYPE ARRAY_BOOL IS ARRAY (1 .. 5) OF BOOLEAN;
- 
-      TYPE REC_TYPE1 IS
-           RECORD
-                BOOL : ARRAY_BOOL;
-                A : INTEGER;
-           END RECORD;
- 
-      TYPE REC_TYPE2 (LEN : INT := 3) IS
-           RECORD
-                A : STRING (1 .. LEN);
-           END RECORD;
- 
-      TYPE REC_TYPE3 (NUM : INT := 1) IS
-           RECORD
-                A : REC_TYPE1;
-           END RECORD;
- 
-      REC1, REC2 : REC_TYPE1 := (A => 2, OTHERS => (OTHERS => TRUE));
-      REC3, REC4 : REC_TYPE2 (5) := (5, "WHERE");
-      REC5, REC6 : REC_TYPE2;
-      REC7, REC8 : REC_TYPE3;
-      REC9, REC10 : REC_TYPE3 (3) := (NUM => 3, A =>
-                                    (A => 5, BOOL => (OTHERS => FALSE)));
- 
- BEGIN
-      TEST ("C45271A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
-                       "EVALUATED CORRECTLY FOR RECORDS WHOSE " &
-                       "COMPONENTS DO NOT HAVE CHANGEABLE " &
-                       "DISCRIMINANTS");
- 
-      IF "/=" (LEFT => REC1, RIGHT => REC2) THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
-      END IF;
-      REC1.A := IDENT_INT(1);
-      IF "=" (LEFT => REC2, RIGHT => REC1) THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
-      END IF;
- 
-      IF REC3 /= REC4 THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
-      END IF;
-      REC4.A := IDENT_STR("12345");
-      IF REC3 = REC4 THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
-      END IF;
- 
-      REC5.A := IDENT_STR("WHO");
-      REC6.A := IDENT_STR("WHY");
-      IF REC5 = REC6 THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
-      END IF;
-      REC5.A := "WHY";
-      IF REC6 /= REC5 THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
-      END IF;
- 
-      REC7.A.A := IDENT_INT(1);
-      REC7.A.BOOL := (OTHERS => IDENT_BOOL(TRUE));
-      REC8.A.A := 1;
-      REC8.A.BOOL := (OTHERS => TRUE);
-      IF REC7 /= REC8 THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
-      END IF;
-      REC8.A.BOOL := (OTHERS => IDENT_BOOL(FALSE));
-      IF REC8 = REC7 THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 8");
-      END IF;
- 
-      IF "/=" (LEFT => REC9, RIGHT => REC10) THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 9");
-      END IF;
-      REC9.A.A := IDENT_INT(1);
-      IF "=" (LEFT => REC9, RIGHT => REC10) THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 10");
-      END IF;
- 
-      RESULT;
- END C45271A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45272a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45272a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45272a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45272a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C45272A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR 
- -- RECORDS WHOSE COMPONENTS HAVE CHANGEABLE DISCRIMINANTS, INCLUDING
- -- RECORDS DESIGNATED BY ACCESS VALUES.
- 
- -- TBN  8/7/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45272A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0 .. 20;
-      TYPE VARSTR (LEN : INT := 0) IS
-           RECORD
-                VAL : STRING (1..LEN);
-           END RECORD;
-      TYPE VARREC IS
-           RECORD
-                A, B : VARSTR;
-           END RECORD;
- 
-      TYPE CELL2;
-      TYPE LINK IS ACCESS CELL2;
-      TYPE CELL1 (NAM_LEN : INT := 0) IS
-           RECORD
-                NAME : STRING (1..NAM_LEN);
-           END RECORD;
-      TYPE CELL2 IS
-           RECORD
-                ONE : CELL1;
-                TWO : CELL1;
-                NEW_LINK : LINK;
-           END RECORD;
- 
-      X, Y : VARREC;
-      FRONT : LINK := NEW CELL2'((5, "XXYZZ"), (5, "YYYZZ"), NULL);
-      BACK : LINK := NEW CELL2'((5, "XXYZZ"), (5, "YYYZZ"), NULL);
- 
- BEGIN
-      TEST ("C45272A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
-                       "EVALUATED CORRECTLY FOR RECORDS WHOSE " &
-                       "COMPONENTS HAVE CHANGEABLE DISCRIMINANTS");
- 
-      X := ((5, "AAAXX"), (5, "BBBYY"));
-      Y := ((5, "AAAZZ"), (5, "BBBYY"));
-      IF X = Y THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
-      END IF;
- 
-      X.A := (3, "HHH");
-      Y.A := (IDENT_INT(3), IDENT_STR("HHH"));
-      IF X /= Y THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
-      END IF;
- 
-      IF FRONT.ALL /= BACK.ALL THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
-      END IF;
- 
-      BACK.NEW_LINK := FRONT;
-      IF FRONT.ALL = BACK.ALL THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
-      END IF;
- 
-      FRONT.NEW_LINK := FRONT;
-      IF FRONT.ALL /= BACK.ALL THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
-      END IF;
- 
-      FRONT.ONE := (5, "XXXXX");
-      BACK.ONE := (5, "ZZZZZ");
-      IF FRONT.ALL = BACK.ALL THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
-      END IF;
- 
-      FRONT.ONE := (3, "XXX");
-      BACK.ONE := (3, "XXX");
-      IF FRONT.ALL /= BACK.ALL THEN
-           FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
-      END IF;
- 
-      RESULT;
- END C45272A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45273a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45273a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45273a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45273a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- C45273A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR
- --     RECORD OBJECTS HAVING DIFFERENT VALUES OF THE 'CONSTRAINED
- --     ATTRIBUTE.
- 
- -- HISTORY:
- --     TBN  08/07/86  CREATED ORIGINAL TEST.
- --     VCL  10/27/87  MODIFIED THIS HEADER; RELOCATED THE CALL TO
- --                    REPORT.TEST SO THAT IT COMES BEFORE ANY
- --                    DECLARATIONS; CHANGED THE 'ELSEIF' CONDITION IN
- --                    THE PROCEDURE 'PROC' SO THAT IT REFERS TO THE
- --                    FORMAL PARAMETERS.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45273A IS
- BEGIN
-      TEST ("C45273A", "EQUALITY AND INEQUALITY ARE " &
-                       "EVALUATED CORRECTLY FOR RECORD OBJECTS HAVING " &
-                       "DIFFERENT VALUES OF THE 'CONSTRAINED' " &
-                       " ATTRIBUTE");
- 
-      DECLARE
-           SUBTYPE INT IS INTEGER RANGE 1 .. 20;
-           TYPE REC_TYPE1 IS
-                RECORD
-                     A : INTEGER;
-                END RECORD;
- 
-           TYPE REC_TYPE2 (LEN : INT := 3) IS
-                RECORD
-                     A : STRING (1 .. LEN);
-                END RECORD;
- 
-           TYPE REC_TYPE3 (NUM : INT := 1) IS
-                RECORD
-                     A : REC_TYPE1;
-                END RECORD;
- 
-           REC1 : REC_TYPE2 (3) := (3, "WHO");
-           REC2 : REC_TYPE2;
-           REC3 : REC_TYPE2 (5) := (5, "WHERE");
-           REC4 : REC_TYPE3;
-           REC5 : REC_TYPE3 (1) := (1, A => (A => 5));
- 
-           PROCEDURE PROC (PREC1 : REC_TYPE2;
-                           PREC2 : IN OUT REC_TYPE2) IS
-           BEGIN
-                IF NOT (PREC1'CONSTRAINED) OR PREC2'CONSTRAINED THEN
-                     FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
-                             "ATTRIBUTE - 6");
-                ELSIF PREC1 /= PREC2 THEN
-                     FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
-                END IF;
-                PREC2.A := "WHO";
-           END PROC;
- 
-      BEGIN
-           REC2.A := "WHO";
-           IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
-                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
-                        "ATTRIBUTE - 1");
-           ELSIF REC1 /= REC2 THEN
-                FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
-           END IF;
- 
-           IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
-                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
-                        "ATTRIBUTE - 2");
-           ELSIF REC2 = REC3 THEN
-                FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
-           END IF;
- 
-           REC2 := (5, "WHERE");
-           IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
-                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
-                        "ATTRIBUTE - 3");
-           ELSIF REC2 /= REC3 THEN
-                FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
-           END IF;
- 
-           REC4.A.A := 5;
-           IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
-                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
-                        "ATTRIBUTE - 4");
-           ELSIF REC4 /= REC5 THEN
-                FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
-           END IF;
- 
-           REC5.A := (A => 6);
-           IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
-                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
-                        "ATTRIBUTE - 5");
-           ELSIF REC4 = REC5 THEN
-                FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
-           END IF;
- 
-           REC1.A := "WHY";
-           REC2 := (3, "WHY");
-           PROC (REC1, REC2);
-           IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
-                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
-                        "ATTRIBUTE - 7");
-           ELSIF REC1 = REC2 THEN
-                FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
-           END IF;
-      END;
- 
-      RESULT;
- END C45273A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45274a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45274a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45274a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45274a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,222 ****
- -- C45274A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
- --     YIELDS  TRUE   (RESP.  FALSE )  FOR
- --
- -->> * RECORD TYPES WITHOUT DISCRIMINANTS;
- -->> * PRIVATE TYPES WITHOUT DISCRIMINANTS;
- -->> * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
- --   * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS; 
- --   * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
- --   * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
- 
- 
- -- RM  3/01/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C45274A IS
- 
- 
- BEGIN
- 
-      TEST ( "C45274A" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
-                         "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
-                         " FOR RECORD TYPES WITHOUT DISCRIMINANTS," &
-                         " PRIVATE TYPES WITHOUT DISCRIMINANTS, AND" &
-                         " LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
- 
- 
-      -------------------------------------------------------------------
-      -----------------  RECORD TYPES WITHOUT DISCRIMINANTS  ------------
- 
-      DECLARE
- 
-           TYPE  REC  IS
-                RECORD
-                     A , B : INTEGER ;
-                END RECORD ;
- 
-           X : REC := ( 19 , 91 );
- 
-      BEGIN
- 
-           IF  X  IN  REC  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 1" );
-           END IF;
- 
-           IF  X  NOT IN  REC  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 1" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
-      -----------------  PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  PRIV  IS PRIVATE;
-           PRIVATE
-                TYPE  PRIV  IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           X : PRIV ;
- 
-           PACKAGE BODY  P  IS
-           BEGIN
-                X := ( 19 , 91 );
-           END  P ;
- 
-      BEGIN
- 
-           IF  X  IN  PRIV  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 2" );
-           END IF;
- 
-           IF  X  NOT IN  PRIV  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 2" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
-      -------------------------------------------------------------------
-      ---------  LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  LP  IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE  LP  IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           X : LP ;
- 
-           PACKAGE BODY  P  IS
-           BEGIN
-                X := ( 19 , 91 );
-           END  P ;
- 
-      BEGIN
- 
-           IF  X  IN  LP  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 3" );
-           END IF;
- 
-           IF  X  NOT IN  LP  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 3" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  LP  IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE  LP  IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           Y : LP ;
- 
-      -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
-      BEGIN
- 
-           IF  Y  IN  LP  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 3BIS" );
-           END IF;
- 
-           IF  Y  NOT IN  LP  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
-                        "( 'NOT IN' )  RAISED AN EXCEPTION" );
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT;
- 
- 
- END  C45274A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45274b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45274b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45274b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45274b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,229 ****
- -- C45274B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
- --     YIELDS  TRUE   (RESP.  FALSE )  FOR
- --
- --   * RECORD TYPES WITHOUT DISCRIMINANTS;
- --   * PRIVATE TYPES WITHOUT DISCRIMINANTS;
- --   * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
- -->> * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS; 
- -->> * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
- -->> * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
- 
- 
- -- RM  3/03/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C45274B IS
- 
- 
- BEGIN
- 
-      TEST ( "C45274B" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
-                         "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
-                         " FOR UNCONSTRAINED TYPES WITH DISCRIMINANTS" );
- 
- 
-      -------------------------------------------------------------------
-      --------  UNCONSTRAINED RECORD TYPES WITH DISCRIMINANTS  ----------
- 
-      DECLARE
- 
-           TYPE  REC ( DISCR : BOOLEAN ) IS
-                RECORD
-                     A , B : INTEGER ;
-                END RECORD ;
- 
-           X : REC(FALSE) := ( FALSE , 19 , 81 );
- 
-           TYPE  REC0 ( DISCR : BOOLEAN := FALSE ) IS
-                RECORD
-                     A , B : INTEGER ;
-                END RECORD ;
- 
-           Y : REC0 := ( TRUE , 19 , 81 );
- 
-      BEGIN
- 
-           IF  X  IN  REC  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 1A" );
-           END IF;
- 
-           IF  Y  NOT IN  REC0  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 1B" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
-      -------  UNCONSTRAINED PRIVATE TYPES WITH DISCRIMINANTS  ----------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
-           PRIVATE
-                TYPE  PRIV ( DISCR : BOOLEAN ) IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           X : PRIV(FALSE) ;
- 
-           PACKAGE BODY  P  IS
-           BEGIN
-                X := ( FALSE , 19 , 91 );
-           END  P ;
- 
-      BEGIN
- 
-           IF  X  IN  PRIV  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 2" );
-           END IF;
- 
-           IF  X  NOT IN  PRIV  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 2" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
-      ---------  UNCONSTRAINED LIM. PRIV. TYPES WITH DISCRIM.  ----------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           X : LP(TRUE) ;
- 
-           PACKAGE BODY  P  IS
-           BEGIN
-                X := ( TRUE , 19 , 91 );
-           END  P ;
- 
-      BEGIN
- 
-           IF  X  IN  LP  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 3" );
-           END IF;
- 
-           IF  X  NOT IN  LP  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 3" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           Y : LP(TRUE) ;
- 
-      -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
-      BEGIN
- 
-           IF  Y  IN  LP  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 3BIS" );
-           END IF;
- 
-           IF  Y  NOT IN  LP  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
-                        "( 'NOT IN' )  RAISED AN EXCEPTION" );
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT;
- 
- 
- END  C45274B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45274c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45274c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45274c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45274c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,187 ****
- -- C45274C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE MEMBERSHIP OPERATOR  IN   ( NOT IN )
- --     YIELDS  TRUE  (RESP.  FALSE ) IF THE DISCRIMINANTS OF THE LEFT
- --     VALUE EQUAL THE DISCRIMINANTS OF THE SUBTYPE INDICATION.
- --
- --
- --   * RECORD TYPES WITH DISCRIMINANTS;
- --   * PRIVATE TYPES WITH DISCRIMINANTS;
- --   * LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
- 
- 
- -- RM  3/01/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C45274C IS
- 
- 
- BEGIN
- 
-      TEST ( "C45274C" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
-                         "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
-                         " IF THE DISCRIMINANTS OF THE LEFT VALUE" &
-                         " EQUAL THE DISCRIMINANTS OF THE SUBTYPE" &
-                         " INDICATION" );
- 
- 
-      -------------------------------------------------------------------
-      -----------------  RECORD TYPES WITH DISCRIMINANTS  ---------------
- 
-      DECLARE
- 
-           TYPE  REC ( DISCR : BOOLEAN := FALSE ) IS
-                RECORD
-                     A , B : INTEGER ;
-                END RECORD ;
- 
-           SUBTYPE  RECTRUE  IS REC(TRUE) ;
- 
-           X : REC  :=  ( TRUE , 19 , 91 );
- 
-      BEGIN
- 
-           IF  X  IN  RECTRUE  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 1" );
-           END IF;
- 
-           IF  X  NOT IN  RECTRUE  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 1" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
-      -----------------  PRIVATE TYPES WITH DISCRIMINANTS  --------------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
-           PRIVATE
-                TYPE  PRIV ( DISCR : BOOLEAN ) IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           SUBTYPE  PRIVTRUE  IS  PRIV( IDENT_BOOL(TRUE) );
- 
-           X : PRIV(TRUE) ;
- 
-           PACKAGE BODY  P  IS
-           BEGIN
-                X := ( TRUE , 19 , 91 );
-           END  P ;
- 
-      BEGIN
- 
-           IF  X  IN  PRIVTRUE  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'IN', 2" );
-           END IF;
- 
-           IF  X  NOT IN  PRIVTRUE  THEN
-                FAILED( "WRONG VALUE: 'NOT IN', 2" );
-           ELSE 
-                NULL;
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
-      -------------------------------------------------------------------
-      ---------  LIMITED PRIVATE TYPES WITH DISCRIMINANTS  --------------
- 
-      DECLARE
- 
-           PACKAGE  P  IS
-                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
-                     RECORD
-                          A , B : INTEGER ;
-                     END RECORD ;
-           END  P ;
- 
-           USE  P ;
- 
-           SUBTYPE  LPFALSE  IS  LP(FALSE) ;
- 
-           X : LP(TRUE) ;
- 
-           PACKAGE BODY  P  IS
-           BEGIN
-                X := ( IDENT_BOOL(TRUE) , 19 , 91 );
-           END  P ;
- 
-      BEGIN
- 
-           IF  X  IN  LPFALSE  THEN
-                FAILED( "WRONG VALUE: 'IN', 3" );
-           ELSE 
-                NULL;
-           END IF;
- 
-           IF  X  NOT IN  LPFALSE  THEN
-                NULL;
-           ELSE 
-                FAILED( "WRONG VALUE: 'NOT IN', 3" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS =>
-                FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT;
- 
- 
- END  C45274C ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45281a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45281a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45281a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45281a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C45281A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR ACCESS
- -- TYPES.
- 
- -- TBN  8/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45281A IS
- 
-      TYPE STR_NAME IS ACCESS STRING;
- 
-      TYPE GENDER IS (F, M);
-      TYPE PERSON (SEX : GENDER) IS
-           RECORD
-                NAME : STRING (1..6) := "NONAME";
-           END RECORD;
- 
-      TYPE PERSON_NAME IS ACCESS PERSON;
-      SUBTYPE MALE IS PERSON_NAME (M);
-      SUBTYPE FEMALE IS PERSON_NAME (F);
- 
-      S : STR_NAME (1..10) := NEW STRING'("0123456789");
-      T : STR_NAME (1..10) := S;
-      A : MALE;
-      B : FEMALE;
-      C : PERSON_NAME;
- 
- BEGIN
-      TEST ("C45281A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
-                       "EVALUATED CORRECTLY FOR ACCESS TYPES");
- 
-      IF "/=" (LEFT => S, RIGHT => T) THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 1");
-      END IF;
-      T := NEW STRING'("0123456789");
-      IF "=" (S, T) THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 2");
-      END IF;
- 
-      IF A /= B THEN
-           FAILED ("INCORRECT RESULTS FOR NULL ACCESS VALUES - 3");
-      END IF;
-      IF A /= C THEN
-           FAILED ("INCORRECT RESULTS FOR NULL ACCESS VALUES - 4");
-      END IF;
- 
-      A := NEW PERSON'(M, "THOMAS");
-      IF "=" (LEFT => A, RIGHT => B) THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 5");
-      END IF;
-      C := A;
-      IF C /= A THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 6");
-      END IF;
-      C := NEW PERSON'(M, "THOMAS");
-      IF A = C THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 7");
-      END IF;
- 
-      RESULT;
- END C45281A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45282a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45282a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45282a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45282a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C45282A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
- --     A) ACCESS TO SCALAR TYPES;
- --     B) ACCESS TO ARRAY TYPES (CONSTRAINED AND UNCONSTRAINED);
- --     C) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT
- --        DISCRIMINANTS;
- 
- -- TBN  8/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45282A IS
- 
-      PACKAGE P IS
-           TYPE KEY IS PRIVATE;
-           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
-           TYPE NEWKEY IS LIMITED PRIVATE;
-           TYPE ACC_NKEY IS ACCESS NEWKEY;
-           PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY);
-      PRIVATE
-           TYPE KEY IS NEW NATURAL;
-           TYPE NEWKEY IS NEW KEY;
-      END P;
- 
-      USE P;
-      SUBTYPE I IS INTEGER;
-      TYPE ACC_INT IS ACCESS I;
-      P_INT : ACC_INT;
-      SUBTYPE INT IS INTEGER RANGE 1 .. 5;
-      TYPE ARRAY_TYPE1 IS ARRAY (INT RANGE <>) OF INTEGER;
-      TYPE ACC_ARA_1 IS ACCESS ARRAY_TYPE1;
-      SUBTYPE ACC_ARA_2 IS ACC_ARA_1 (1 .. 2);
-      SUBTYPE ACC_ARA_3 IS ACC_ARA_1 (1 .. 3);
-      ARA1 : ACC_ARA_1;
-      ARA2 : ACC_ARA_2;
-      ARA3 : ACC_ARA_3;
-      TYPE GREET IS
-           RECORD
-                NAME : STRING (1 .. 2);
-           END RECORD;
-      TYPE ACC_GREET IS ACCESS GREET;
-      INTRO : ACC_GREET;
-      TYPE ACC_KEY IS ACCESS KEY;
-      KEY1 : ACC_KEY;
-      KEY2 : ACC_NKEY;
- 
-      PACKAGE BODY P IS
-           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
-           BEGIN
-                RETURN (KEY(X));
-           END INIT_KEY;
- 
-           PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY) IS
-           BEGIN
-                Y.ALL := NEWKEY (1);
-           END ASSIGN_NEWKEY;
-      END P;
- 
- BEGIN
- 
-      TEST ("C45282A", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
-                       "ACCESS TYPES TO SCALAR TYPES, ARRAY TYPES, " &
-                       "RECORD TYPES, PRIVATE TYPES, AND LIMITED " &
-                       "PRIVATE TYPES WITHOUT DISCRIMINANTS");
- 
- -- CASE A
-      IF P_INT NOT IN ACC_INT THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
-      END IF;
-      P_INT := NEW INT'(5);
-      IF P_INT IN ACC_INT THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
-      END IF;
- 
- -- CASE B
-      IF ARA1 NOT IN ACC_ARA_1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
-      END IF;
-      IF ARA1 NOT IN ACC_ARA_2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
-      END IF;
-      IF ARA1 IN ACC_ARA_3 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
-      END IF;
-      IF ARA2 IN ACC_ARA_1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
-      END IF;
-      IF ARA3 NOT IN ACC_ARA_1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
-      END IF;
-      ARA1 := NEW ARRAY_TYPE1'(1, 2, 3);
-      IF ARA1 IN ACC_ARA_1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
-      END IF;
-      IF ARA1 IN ACC_ARA_2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
-      END IF;
-      IF ARA1 NOT IN ACC_ARA_3 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
-      END IF;
-      ARA2 := NEW ARRAY_TYPE1'(1, 2);
-      IF ARA2 NOT IN ACC_ARA_1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
-      END IF;
-      IF ARA2 NOT IN ACC_ARA_2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
-      END IF;
- 
- -- CASE C
-      IF INTRO NOT IN ACC_GREET THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
-      END IF;
-      INTRO := NEW GREET'(NAME => "HI");
-      IF INTRO IN ACC_GREET THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
-      END IF;
-      IF KEY1 NOT IN ACC_KEY THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
-      END IF;
-      KEY1 := NEW KEY'(INIT_KEY (1));
-      IF KEY1 IN ACC_KEY THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
-      END IF;
-      IF KEY2 NOT IN ACC_NKEY THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
-      END IF;
-      KEY2 := NEW NEWKEY;
-      ASSIGN_NEWKEY (KEY2);
-      IF KEY2 IN ACC_NKEY THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
-      END IF;
- 
-      RESULT;
- END C45282A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45282b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45282b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45282b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45282b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,347 ****
- -- C45282B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
- --     D) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH
- --        DISCRIMINANTS (WITH AND WITHOUT DEFAULT VALUES), WHERE THE 
- --        TYPE MARK DENOTES A CONSTRAINED AND UNCONSTRAINED TYPE;
- --     E) ACCESS TO TASK TYPES.
- 
- -- TBN  8/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45282B IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 5;
- 
-      PACKAGE P IS
-           TYPE PRI_REC1 (D : INT) IS PRIVATE;
-           TYPE PRI_REC2 (D : INT := 2) IS PRIVATE;
-           FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1;
-           FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2;
-           TYPE LIM_REC1 (D : INT) IS LIMITED PRIVATE;
-           TYPE ACC_LIM1 IS ACCESS LIM_REC1;
-           SUBTYPE ACC_SUB_LIM1 IS ACC_LIM1 (2);
-           PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING);
-           TYPE LIM_REC2 (D : INT := 2) IS LIMITED PRIVATE;
-           TYPE ACC_LIM2 IS ACCESS LIM_REC2;
-           SUBTYPE ACC_SUB_LIM2 IS ACC_LIM2 (2);
-           PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING);
-      PRIVATE
-           TYPE PRI_REC1 (D : INT) IS
-                RECORD
-                     STR : STRING (1 .. D);
-                END RECORD;
-           TYPE PRI_REC2 (D : INT := 2) IS
-                RECORD
-                     STR : STRING (1 .. D);
-                END RECORD;
-           TYPE LIM_REC1 (D : INT) IS
-                RECORD
-                     STR : STRING (1 .. D);
-                END RECORD;
-           TYPE LIM_REC2 (D : INT := 2) IS
-                RECORD
-                     STR : STRING (1 .. D);
-                END RECORD;
-      END P;
- 
-      USE P;
- 
-      TYPE DIS_REC1 (D : INT) IS
-           RECORD
-                STR : STRING (1 .. D);
-           END RECORD;
-      TYPE DIS_REC2 (D : INT := 5) IS
-           RECORD
-                STR : STRING (D .. 8);
-           END RECORD;
- 
-      TYPE ACC1_REC1 IS ACCESS DIS_REC1;
-      SUBTYPE ACC2_REC1 IS ACC1_REC1 (2);
-      TYPE ACC1_REC2 IS ACCESS DIS_REC2;
-      SUBTYPE ACC2_REC2 IS ACC1_REC2 (2);
-      REC1 : ACC1_REC1;
-      REC2 : ACC2_REC1;
-      REC3 : ACC1_REC2;
-      REC4 : ACC2_REC2;
-      TYPE ACC_PREC1 IS ACCESS PRI_REC1;
-      SUBTYPE ACC_SREC1 IS ACC_PREC1 (2);
-      REC5 : ACC_PREC1;
-      REC6 : ACC_SREC1;
-      TYPE ACC_PREC2 IS ACCESS PRI_REC2;
-      SUBTYPE ACC_SREC2 IS ACC_PREC2 (2);
-      REC7 : ACC_PREC2;
-      REC8 : ACC_SREC2;
-      REC9 : ACC_LIM1;
-      REC10 : ACC_SUB_LIM1;
-      REC11 : ACC_LIM2;
-      REC12 : ACC_SUB_LIM2;
- 
-      TASK TYPE T IS
-           ENTRY E (X : INTEGER);
-      END T;
- 
-      TASK BODY T IS
-      BEGIN
-           ACCEPT E (X : INTEGER) DO
-                IF X /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE PASSED TO TASK");
-                END IF;
-           END E;
-      END T;
- 
-      PACKAGE BODY P IS
-           FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1 IS
-                REC : PRI_REC1 (A);
-           BEGIN
-                REC := (A, B);
-                RETURN (REC);
-           END INIT_PREC1;
- 
-           FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2 IS
-                REC : PRI_REC2;
-           BEGIN
-                REC := (A, B);
-                RETURN (REC);
-           END INIT_PREC2;
- 
-           PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING) IS
-           BEGIN
-                A.ALL := (B, C);
-           END ASSIGN_LIM1;
- 
-           PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING) IS
-           BEGIN
-                A.ALL := (B, C);
-           END ASSIGN_LIM2;
-      END P;
- 
- BEGIN
- 
-      TEST ("C45282B", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
-                       "ACCESS TYPES TO RECORD TYPES, PRIVATE TYPES, " &
-                       "LIMITED PRIVATE TYPES WITH DISCRIMINANTS, AND " &
-                       "TASK TYPES");
- 
- -- CASE D
- ------------------------------------------------------------------------
-      IF REC1 NOT IN ACC1_REC1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
-      END IF;
-      IF REC1 IN ACC2_REC1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
-      END IF;
-      IF REC2 NOT IN ACC1_REC1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
-      END IF;
-      REC1 := NEW DIS_REC1'(5, "12345");
-      IF REC1 IN ACC1_REC1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
-      END IF;
-      IF REC1 IN ACC2_REC1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
-      END IF;
-      REC2 := NEW DIS_REC1'(2, "HI");
-      IF REC2 IN ACC1_REC1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
-      END IF;
- 
- ------------------------------------------------------------------------
- 
-      IF REC3 IN ACC1_REC2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
-      END IF;
-      IF REC3 NOT IN ACC2_REC2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
-      END IF;
-      IF REC4 IN ACC1_REC2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
-      END IF;
-      REC3 := NEW DIS_REC2'(5, "5678");
-      IF REC3 IN ACC1_REC2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
-      END IF;
-      IF REC3 IN ACC2_REC2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
-      END IF;
-      REC4 := NEW DIS_REC2'(2, "2345678");
-      IF REC4 IN ACC1_REC2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
-      END IF;
-      IF REC4 NOT IN ACC2_REC2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
-      END IF;
- 
- ------------------------------------------------------------------------
- 
-      IF REC5 NOT IN ACC_PREC1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
-      END IF;
-      IF REC5 NOT IN ACC_SREC1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
-      END IF;
-      IF REC6 NOT IN ACC_PREC1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
-      END IF;
-      REC5 := NEW PRI_REC1'(INIT_PREC1 (5, "12345"));
-      IF REC5 IN ACC_PREC1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
-      END IF;
-      IF REC5 IN ACC_SREC1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
-      END IF;
-      REC6 := NEW PRI_REC1'(INIT_PREC1 (2, "HI"));
-      IF REC6 IN ACC_PREC1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 19");
-      END IF;
- 
- ------------------------------------------------------------------------
- 
-      IF REC7 NOT IN ACC_PREC2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 20");
-      END IF;
-      IF REC7 NOT IN ACC_SREC2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 21");
-      END IF;
-      IF REC8 NOT IN ACC_PREC2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 22");
-      END IF;
-      REC7 := NEW PRI_REC2'(INIT_PREC2 (5, "12345"));
-      IF REC7 IN ACC_PREC2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 23");
-      END IF;
-      IF REC7 IN ACC_SREC2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 24");
-      END IF;
-      REC8 := NEW PRI_REC2'(INIT_PREC2 (2, "HI"));
-      IF REC8 IN ACC_PREC2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 25");
-      END IF;
- 
- ------------------------------------------------------------------------
- 
-      IF REC9 NOT IN ACC_LIM1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 26");
-      END IF;
-      IF REC9 NOT IN ACC_SUB_LIM1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 27");
-      END IF;
-      IF REC10 NOT IN ACC_LIM1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 28");
-      END IF;
-      REC9 := NEW LIM_REC1 (5);
-      ASSIGN_LIM1 (REC9, 5, "12345");
-      IF REC9 IN ACC_LIM1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 29");
-      END IF;
-      IF REC9 IN ACC_SUB_LIM1 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 30");
-      END IF;
-      REC10 := NEW LIM_REC1 (2);
-      ASSIGN_LIM1 (REC10, 2, "12");
-      IF REC10 IN ACC_LIM1 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 31");
-      END IF;
- 
- ------------------------------------------------------------------------
- 
-      IF REC11 NOT IN ACC_LIM2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 32");
-      END IF;
-      IF REC11 NOT IN ACC_SUB_LIM2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 33");
-      END IF;
-      IF REC12 NOT IN ACC_LIM2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 34");
-      END IF;
-      REC11 := NEW LIM_REC2;
-      IF REC11 NOT IN ACC_SUB_LIM2 THEN
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 35");
-      END IF;
-      ASSIGN_LIM2 (REC11, 2, "12");
-      IF REC11 IN ACC_LIM2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 36");
-      END IF;
-      IF REC11 IN ACC_SUB_LIM2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 37");
-      END IF;
-      REC12 := NEW LIM_REC2;
-      ASSIGN_LIM2 (REC12, 2, "12");
-      IF REC12 IN ACC_LIM2 THEN
-           NULL;
-      ELSE
-           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
-      END IF;
- 
- -- CASE E
- ------------------------------------------------------------------------
-      DECLARE
-           TYPE ACC_TASK IS ACCESS T;
-           T1 : ACC_TASK;
-      BEGIN
-           IF T1 NOT IN ACC_TASK THEN
-                FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 39");
-           END IF;
-           T1 := NEW T;
-           IF T1 IN ACC_TASK THEN
-                NULL;
-           ELSE
-                FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
-           END IF;
-           T1.E (1);
-      END;
- 
-      RESULT;
- END C45282B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45291a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45291a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45291a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45291a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C45291A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE MEMBERSHIP TESTS YIELD CORRECT RESULTS FOR TASK
- --     TYPES, LIMITED PRIVATE TYPES, COMPOSITE LIMITED TYPES, AND
- --     PRIVATE TYPES WITHOUT DISCRIMINANTS.
- 
- -- HISTORY:
- --     JET 08/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45291A IS
- 
-      TASK TYPE TASK1 IS
-           ENTRY E;
-      END TASK1;
- 
-      PACKAGE PACK IS
-           TYPE LIM_PRIV IS LIMITED PRIVATE;
-           TYPE LIM_COMP IS ARRAY (1..10) OF LIM_PRIV;
-           TYPE PRIV IS PRIVATE;
-           PROCEDURE INIT(LP : OUT LIM_PRIV;
-                          LC : IN OUT LIM_COMP;
-                          P  : OUT PRIV);
-      PRIVATE
-           TYPE LIM_PRIV IS RANGE -100..100;
-           TYPE PRIV IS RECORD
-                I : INTEGER;
-           END RECORD;
-      END PACK;
- 
-      SUBTYPE SUB_TASK1 IS TASK1;
-      SUBTYPE SUB_LIM_PRIV IS PACK.LIM_PRIV;
-      SUBTYPE SUB_LIM_COMP IS PACK.LIM_COMP;
-      SUBTYPE SUB_PRIV IS PACK.PRIV;
- 
-      T1 : TASK1;
-      LP : PACK.LIM_PRIV;
-      LC : PACK.LIM_COMP;
-      P  : PACK.PRIV;
- 
-      TASK BODY TASK1 IS
-      BEGIN
-           ACCEPT E DO
-                NULL;
-           END E;
-      END TASK1;
- 
-      PACKAGE BODY PACK IS
-           PROCEDURE INIT (LP : OUT LIM_PRIV;
-                           LC : IN OUT LIM_COMP;
-                           P  : OUT PRIV) IS
-           BEGIN
-                LP := 0;
-                LC := (OTHERS => 0);
-                P  := (I => 0);
-           END INIT;
-      END PACK;
- 
- BEGIN
-      TEST ("C45291A", "CHECK THAT THE MEMBERSHIP TESTS YIELD CORRECT " &
-                       "RESULTS FOR TASK TYPES, LIMITED PRIVATE TYPES," &
-                       " COMPOSITE LIMITED TYPES, AND PRIVATE TYPES " &
-                       "WITHOUT DISCRIMINANTS");
- 
-      PACK.INIT(LP, LC, P);
- 
-      IF NOT IDENT_BOOL(T1 IN TASK1) THEN
-           FAILED ("INCORRECT VALUE OF 'T1 IN TASK1'");
-      END IF;
- 
-      IF IDENT_BOOL(T1 NOT IN TASK1) THEN
-           FAILED ("INCORRECT VALUE OF 'T1 NOT IN TASK1'");
-      END IF;
- 
-      IF NOT IDENT_BOOL(LP IN PACK.LIM_PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'LP IN LIM_PRIV'");
-      END IF;
- 
-      IF IDENT_BOOL(LP NOT IN PACK.LIM_PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'LP NOT IN LIM_PRIV'");
-      END IF;
- 
-      IF NOT IDENT_BOOL(LC IN PACK.LIM_COMP) THEN
-           FAILED ("INCORRECT VALUE OF 'LC IN LIM_COMP'");
-      END IF;
- 
-      IF IDENT_BOOL(LC NOT IN PACK.LIM_COMP) THEN
-           FAILED ("INCORRECT VALUE OF 'LC NOT IN LIM_COMP'");
-      END IF;
- 
-      IF NOT IDENT_BOOL(P IN PACK.PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'P IN PRIV'");
-      END IF;
- 
-      IF IDENT_BOOL(P NOT IN PACK.PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'P NOT IN PRIV'");
-      END IF;
- 
-      IF NOT IDENT_BOOL(T1 IN SUB_TASK1) THEN
-           FAILED ("INCORRECT VALUE OF 'T1 IN SUB_TASK1'");
-      END IF;
- 
-      IF IDENT_BOOL(T1 NOT IN SUB_TASK1) THEN
-           FAILED ("INCORRECT VALUE OF 'T1 NOT IN SUB_TASK1'");
-      END IF;
- 
-      IF NOT IDENT_BOOL(LP IN SUB_LIM_PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'LP IN SUB_LIM_PRIV'");
-      END IF;
- 
-      IF IDENT_BOOL(LP NOT IN SUB_LIM_PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'LP NOT IN SUB_LIM_PRIV'");
-      END IF;
- 
-      IF NOT IDENT_BOOL(LC IN SUB_LIM_COMP) THEN
-           FAILED ("INCORRECT VALUE OF 'LC IN SUB_LIM_COMP'");
-      END IF;
- 
-      IF IDENT_BOOL(LC NOT IN SUB_LIM_COMP) THEN
-           FAILED ("INCORRECT VALUE OF 'LC NOT IN SUB_LIM_COMP'");
-      END IF;
- 
-      IF NOT IDENT_BOOL(P IN SUB_PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'P IN SUB_PRIV'");
-      END IF;
- 
-      IF IDENT_BOOL(P NOT IN SUB_PRIV) THEN
-           FAILED ("INCORRECT VALUE OF 'P NOT IN SUB_PRIV'");
-      END IF;
- 
-      T1.E;
- 
-      RESULT;
- 
- END C45291A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c453001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c453001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c453001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c453001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,236 ****
- -- C453001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --
- --                                     Notice
- --
- --     The ACAA has created and maintains the Ada Conformity Assessment Test
- --     Suite for the purpose of conformity assessments conducted in accordance
- --     with the International Standard ISO/IEC 18009 - Ada: Conformity
- --     assessment of a language processor. This test suite should not be used
- --     to make claims of conformance unless used in accordance with
- --     ISO/IEC 18009 and any applicable ACAA procedures.
- --*
- -- OBJECTIVES:
- --     Check that overflow checking is not performed for adding operators of
- --     modular types.
- --
- -- TEST DESCRIPTION:
- --     Check that Constraint_Error is not raised by + or - when the result
- --     is out of the range of the base type.
- --     Also check that assignment to values in the upper half of the range
- --     does not raise Constraint_Error.
- --
- --     We define modular types of various common sizes. We cannot
- --     assume a binary modulus greater than 2**16 is supported by 3.5.4(23),
- --     so the DWord type might be smaller on some targets. We also try
- --     a small prime number as a modulus (these are often used for hashing).
- --     We also the language-defined types
- --     System.Storage_Elements.Storage_Element, Ada.Streams.Stream_Element,
- --     and Ada.Containers.Hash_Type.
- --
- -- CHANGE HISTORY:
- --      11 Feb 17   JAC   Initial pre-release version.
- --      30 Mar 17   RLB   Renamed, removed non-modular test cases, removed
- --                        types that aren't required to be supported, added
- --                        other language-defined types, added key to locate
- --                        failures, added additional test cases.
- --      03 Apr 17   RLB   Removed Ada.Containers from the Ada 95 version of
- --                        this test.
- --
- --!
- with Report;
- with System.Storage_Elements;
- with Ada.Streams;
- 
- procedure C453001 is
-    type Unsigned_Byte_Type    is mod 16#100#; -- 256;
- 
-    type Unsigned_Word_Type    is mod 16#1_0000#; -- 65536;
- 
-    type Unsigned_DWord_Type   is mod
-                                 Natural'Min (2**32, System.Max_Binary_Modulus);
- 
-    type Unsigned_NBM_Type     is mod System.Max_Nonbinary_Modulus;
- 
-    type Biggest_Unsigned_Type is mod System.Max_Binary_Modulus;
- 
-    type Prime_Type            is mod 23; -- Prime number for hashing.
- 
-    generic
-       type Mod_Type is mod <>; -- Assume this is a base type.
-       Key : in String;
-    procedure Test_Operators;
- 
-    procedure Test_Operators is
- 
-       function Ident_Mod (Val : in Mod_Type) return Mod_Type is
-          -- Optimization breaker.
-       begin
-          if Report.Equal (4, 12) then -- Always False (but complex).
-             return 1;
-          else
-             return Val;
-          end if;
-       end Ident_Mod;
- 
-    begin
-       if Mod_Type'First /= 0 then -- The First of a base type is always 0.
-          Report.Failed ("Not base type first - " & Key);
-       end if;
-       if Mod_Type'Last /= Mod_Type'Base'Last then
-          Report.Failed ("Not base type last - " & Key);
-       end if;
- 
-       -- Note: Mod_Type'First always is 0.
- 
-       -- Check addition
-       declare
-          M : constant Mod_Type := Mod_Type'Last;
-          V : Mod_Type;
-       begin
-          V := M + 1; -- Should wrap around
-          if Ident_Mod (V) /= 0 then
-             Report.Failed ("Addition didn't wrap round - " & Key);
-          end if;
-          V := Ident_Mod (M - 2) + 5; -- Should wrap around
-          if Ident_Mod (V) /= 2 then
-             Report.Failed ("Addition didn't wrap round again - " & Key);
-          end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised for addition - " & Key);
-          when others           =>
-             Report.Failed
-              ("Some even more unexpected exception raised for addition - " &
-                Key);
-       end;
- 
-       -- Check subtraction
-       declare
-          M : constant Mod_Type := 0;
-          V : Mod_Type;
-       begin
-          V := M - 1; -- Should wrap around
-          if Ident_Mod (V) /= Mod_Type'Last then
-             Report.Failed ("Subtraction didn't wrap round - " & Key);
-          end if;
-          V := Ident_Mod (3) - 7; -- Should wrap around
-          if Ident_Mod (V) /= Mod_Type'Last-3 then
-             Report.Failed ("Subtraction didn't wrap round again - " & Key);
-          end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised for subtraction - " & Key);
-          when others           =>
-             Report.Failed
-              ("Some even more unexpected exception raised for subtraction - " &
-                 Key);
-       end;
- 
-    end Test_Operators;
- 
-    procedure Test_Unsigned_Byte_Operators    is new Test_Operators
-                                               (Unsigned_Byte_Type, "Byte");
- 
-    procedure Test_Unsigned_Word_Operators    is new Test_Operators
-                                               (Unsigned_Word_Type, "Word");
- 
-    procedure Test_Unsigned_DWord_Operators   is new Test_Operators
-                                               (Unsigned_DWord_Type, "DWord");
- 
-    procedure Test_Unsigned_NBM_Operators     is new Test_Operators
-                                                  (Unsigned_NBM_Type, "NBM");
- 
-    procedure Test_Biggest_Unsigned_Operators is new Test_Operators
-                                               (Biggest_Unsigned_Type, "Big");
- 
-    procedure Test_Prime_Operators is new Test_Operators (Prime_Type, "Prime");
- 
-    procedure Test_Storage_Element_Operators  is new Test_Operators
-                         (System.Storage_Elements.Storage_Element, "Storage");
- 
-    procedure Test_Stream_Element_Operators   is new Test_Operators
-                                      (Ada.Streams.Stream_Element, "Stream");
- 
- begin
- 
-    Report.Test
-      ("C453001",
-       "Check that overflow checking is not performed for adding operators " &
-       "of modular types");
- 
-    -- Check assignment
-    declare
-       -- Define subtypes
-       subtype My_Unsigned_Byte_Type  is Unsigned_Byte_Type;
-       subtype My_Unsigned_Word_Type  is Unsigned_Word_Type;
-       subtype My_Unsigned_DWord_Type is Unsigned_DWord_Type;
- 
-       -- Define constants in upper half of range
-       C1 : constant Unsigned_Byte_Type     := Unsigned_Byte_Type'Last;
-       C2 : constant My_Unsigned_Byte_Type  := 16#FE#;
-       C3 : constant Unsigned_Word_Type     := 16#FACE#;
-       C4 : constant My_Unsigned_Word_Type  := My_Unsigned_Word_Type'Last;
-       C5 : constant Unsigned_DWord_Type    := My_Unsigned_DWord_Type'Last;
- 
-       -- Define variables
-       V1 : Unsigned_Byte_Type;
-       V2 : My_Unsigned_Byte_Type;
-       V3 : Unsigned_Word_Type;
-       V4 : My_Unsigned_Word_Type;
-       V5 : Unsigned_DWord_Type;
-    begin
-       V1 := C1;
-       V1 := C2;
-       V2 := C1;
-       V2 := C2;
-       V3 := C3;
-       V3 := C4;
-       V4 := C3;
-       V4 := C4;
-       V5 := C5;
-       if V1 /= C2 or V2 /= C2 or V3 /= C4 or V4 /= C4 or V5 /= C5 then
-          Report.Comment ("Don't optimize assignment!"); -- Optimization breaker
-       end if;
-    exception
-       when Constraint_Error =>
-          Report.Failed ("Constraint_Error raised for assignment");
-       when others           =>
-          Report.Failed ("Some even more unexpected exception raised " &
-                         "for assignment");
-    end;
- 
-    Test_Unsigned_Byte_Operators;
-    Test_Unsigned_Word_Operators;
-    Test_Unsigned_DWord_Operators;
-    Test_Unsigned_NBM_Operators;
-    Test_Biggest_Unsigned_Operators;
-    Test_Prime_Operators;
-    Test_Storage_Element_Operators;
-    Test_Stream_Element_Operators;
- 
-    Report.Result;
- 
- end C453001;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45303a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45303a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45303a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45303a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C45303A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ADDITION AND SUBTRACTION YIELD RESULTS BELONGING TO THE
- -- BASE TYPE.
- 
- -- JBG 2/24/84
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- -- JRL 10/13/96 Fixed static expressions which contained values outside
- --              the base range.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45303A IS
- 
-      TYPE INT IS RANGE 1..10;
- 
-      X, Y : INT := INT(IDENT_INT(9));
- 
- BEGIN
- 
-      TEST ("C45303A", "CHECK SUBTYPE OF INTEGER ADDITION/SUBTRACTION");
- 
-      BEGIN
- 
-           IF X + Y - 10 /= INT(IDENT_INT(8)) THEN
-                FAILED ("INCORRECT RESULT - ADDITION");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                IF INT'POS(INT'BASE'LAST) >= 18 THEN
-                     FAILED ("ADDITION DOES NOT YIELD RESULT " &
-                             "BELONGING TO THE BASE TYPE");
-                ELSE
-                     COMMENT ("BASE TYPE HAS RANGE LESS THAN 18 - ADD");
-                END IF;
-      END;
- 
-      BEGIN
- 
-           IF 2 - X - INT(IDENT_INT(1)) /= INT'VAL(IDENT_INT(-8)) THEN
-                FAILED ("INCORRECT RESULT - SUBTRACTION");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                IF INT'POS(INT'BASE'FIRST) <= -8 THEN
-                     FAILED ("SUBTRACTION DOES NOT YIELD RESULT " &
-                             "BELONGING TO THE BASE TYPE");
-                ELSE
-                     COMMENT ("BASE TYPE HAS RANGE GREATER THAN -8 - SUB");
-                END IF;
-      END;
- 
-      RESULT;
- 
- END C45303A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45304a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45304a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45304a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C45304A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY
- --     "+" AND "-" FOR PREDEFINED INTEGER WHEN THE RESULT IS OUTSIDE
- --     THE RANGE OF THE BASE TYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     TBN 10/06/86  CREATED ORIGINAL TEST.
- --     JET 12/29/87  FURTHER DEFEATED OPTIMIZATION.
- --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45304A IS
- 
- BEGIN
-      TEST ("C45304A", "CHECK THAT CONSTRAINT_ERROR " &
-                       "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
-                       "INTEGER WHEN THE RESULT IS OUTSIDE THE RANGE " &
-                       "OF THE BASE TYPE");
- 
-      DECLARE
-           B : INTEGER := INTEGER'LAST;
-      BEGIN
-           IF EQUAL (IDENT_INT(B)+1, 0) THEN
-                FAILED ("NO EXCEPTION FOR ADDITION -- ZERO RESULT");
-           ELSE
-                FAILED ("NO EXCEPTION FOR ADDITION -- NONZERO RESULT");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR ADDITION");
-      END;
- 
-      DECLARE
-           B : INTEGER := INTEGER'FIRST;
-      BEGIN
-           IF EQUAL (IDENT_INT(B)-1, 0) THEN
-                FAILED ("NO EXCEPTION FOR SUBTRACTION -- ZERO RESULT");
-           ELSE
-                FAILED ("NO EXCEPTION FOR SUBTRACTION -- " &
-                        "NONZERO RESULT");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR SUBTRACTION");
-      END;
- 
-      RESULT;
- END C45304A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45304b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45304b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45304b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45304b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C45304B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY
- --     "+" AND "-" FOR PREDEFINED SHORT_INTEGER WHEN THE RESULT IS
- --     OUTSIDE THE RANGE OF THE BASE TYPE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE IF THE IMPLEMENTATION HAS A
- --     PREDEFINED TYPE SHORT_INTEGER.
- 
- --     IF SHORT_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "TEST_VAR" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     TBN 10/07/86  CREATED ORIGINAL TEST.
- --     JET 12/30/87  ADDED CODE TO PREVENT OPTIMIZATION.
- --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45304B IS
- 
-      TEST_VAR : SHORT_INTEGER;                 -- N/A => ERROR.
- 
-      -- THESE FUNCTIONS ARE TO PREVENT OPTIMIZATION.
- 
-      FUNCTION IDENT_SHORT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           ELSE
-                RETURN (0);
-           END IF;
-      END IDENT_SHORT;
- 
-      FUNCTION SHORT_OK (X : SHORT_INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN EQUAL (INTEGER(X),INTEGER(X));
-      END SHORT_OK;
- 
- BEGIN
-      TEST ("C45304B", "CHECK THAT CONSTRAINT_ERROR " &
-                       "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
-                       "SHORT_INTEGER WHEN THE RESULT IS OUTSIDE THE " &
-                       "RANGE OF THE BASE TYPE");
- 
-      DECLARE
-           B : SHORT_INTEGER := SHORT_INTEGER'LAST;
-      BEGIN
-           IF SHORT_OK (B + IDENT_SHORT(1)) THEN
-                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
-                        "SHORT_OK RETURNS TRUE");
-           ELSE
-                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
-                        "SHORT_OK RETURNS FALSE");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-      END;
- 
-      DECLARE
-           B : SHORT_INTEGER := SHORT_INTEGER'FIRST;
-      BEGIN
- 
-           IF SHORT_OK (B - IDENT_SHORT(1)) THEN
-                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION- " &
-                        "SHORT_OK RETURNS TRUE");
-           ELSE
-                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
-                        "SHORT_OK RETURNS FALSE");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      RESULT;
- END C45304B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45304c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45304c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45304c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45304c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C45304C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY
- --     "+" AND "-" FOR PREDEFINED LONG_INTEGER WHEN THE RESULT IS
- --     OUTSIDE THE RANGE OF THE BASE TYPE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE IF THE IMPLEMENTATION HAS A
- --     PREDEFINED TYPE LONG_INTEGER.
- 
- --     IF LONG_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "TEST_VAR" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     TBN 10/07/86  CREATED ORIGINAL TEST.
- --     JET 12/30/87  ADDED CODE TO PREVENT OPTIMIZATION.
- --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45304C IS
- 
-      TEST_VAR : LONG_INTEGER;               -- N/A => ERROR.
- 
-      -- THESE FUNCTIONS ARE TO PREVENT OPTIMIZATION.
- 
-      FUNCTION IDENT_LONG (X : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT_LONG;
- 
-      FUNCTION LONG_OK (X : LONG_INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN X = IDENT_LONG(X);
-      END LONG_OK;
- 
- BEGIN
-      TEST ("C45304C", "CHECK THAT CONSTRAINT_ERROR " &
-                       "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
-                       "LONG_INTEGER WHEN THE RESULT IS OUTSIDE THE " &
-                       "RANGE OF THE BASE TYPE");
- 
-      DECLARE
-           B : LONG_INTEGER := LONG_INTEGER'LAST;
-      BEGIN
-           IF LONG_OK (B + IDENT_LONG(1)) THEN
-                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
-                        "LONG_OK RETURNS TRUE");
-           ELSE
-                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
-                        "LONG_OK RETURNS FALSE");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-      END;
- 
-      DECLARE
-           B : LONG_INTEGER := LONG_INTEGER'FIRST;
-      BEGIN
-           IF LONG_OK (B - IDENT_LONG(1)) THEN
-                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
-                        "LONG_OK RETURNS TRUE");
-           ELSE
-                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
-                        "LONG_OK RETURNS FALSE");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      RESULT;
- END C45304C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45322a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45322a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45322a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45322a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- C45322A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF 
- --     MACHINE_OVERFLOWS IS TRUE AND THE RESULT OF THE ADDITION OR 
- --     SUBTRACTION LIES OUTSIDE OF THE RANGE OF THE BASE TYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     NPL 09/01/90  CREATED ORIGINAL TEST.
- --     LDC 10/09/90  CHANGED THE STYLE OF THE TEST TO THE STANDARD
- --                   ACVC FORMAT AND WRAPPED LINES WHICH WHERE LONGER
- --                   THAN 71 CHARACTERS.
- --     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45322A IS
- 
-   TYPE FLOAT5 IS DIGITS 5;
-   F5 : FLOAT5;
- 
-   FUNCTION IDENT (F : FLOAT5) RETURN FLOAT5 IS
-   BEGIN
-     RETURN F * FLOAT5(IDENT_INT(1));
-   END IDENT;
- 
-   FUNCTION EQUAL (F,G : FLOAT5) RETURN BOOLEAN IS
-   BEGIN
-     RETURN F = G + FLOAT5(IDENT_INT(0));
-   END EQUAL;
- 
- BEGIN
-      TEST ("C45322A", "CHECK THAT CONSTRAINT_ERROR " &
-                       "IS RAISED IF MACHINE_OVERFLOWS IS TRUE AND " &
-                       "THE RESULT OF THE ADDITION OR SUBTRACTION " &
-                       "LIES OUTSIDE OF THE RANGE OF THE BASE TYPE");
- 
-      IF NOT FLOAT5'MACHINE_OVERFLOWS THEN
-           NOT_APPLICABLE("MACHINE_OVERFLOWS IS FALSE");
-      ELSE
- 
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'LAST;
- 
-                FAILED("NO EXCEPTION RAISED BY LARGE '+'");
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '+'");
-           END;
- 
-           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'LAST;
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR " &
-                            "RAISED BY INTERCHANGING LARGE '+'");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
-                            "INTERCHANGING LARGE '+'");
-           END;
- 
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'FIRST;
- 
-                FAILED("NO EXCEPTION RAISED BY SMALL '+'");
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '+'");
-           END;
- 
-           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'FIRST;
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR " &
-                            "RAISED BY INTERCHANGING SMALL '+'");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
-                            "INTERCHANGING SMALL '+'");
-           END;
- 
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'FIRST;
- 
-                FAILED("NO EXCEPTION RAISED BY LARGE '-'");
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '-'");
-           END;
- 
-           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'FIRST;
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR " &
-                            "RAISED BY INTERCHANGING LARGE '-'");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
-                            "INTERCHANGING LARGE '-'");
-           END;
- 
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'LAST;
- 
-                FAILED("NO EXCEPTION RAISED BY SMALL '-'");
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '-'");
-           END;
- 
-           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
-           BEGIN
-                F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'LAST;
- 
-                IF NOT EQUAL(F5, F5) THEN
-                     COMMENT("DON'T OPTIMIZE F5");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR " &
-                            "RAISED BY INTERCHANGING SMALL '-'");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
-                            "INTERCHANGING SMALL '-'");
-           END;
- 
-      END IF;
- 
-      RESULT;
- 
- END C45322A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45323a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45323a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45323a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45323a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- C45323A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NONASSOCIATIVITY OF REAL ARITHMETIC IS PRESERVED
- --     FOR FLOATING POINT PRECISION 5, EVEN WHEN OPTIMIZATION WOULD
- --     BENEFIT IF FLOATING POINT ADDITION WERE ASSOCIATIVE.
- 
- -- HISTORY:
- --     JET 08/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45323A IS
- 
-      TYPE FLOAT5 IS DIGITS 5;
- 
-      A, B, C, D, E : FLOAT5;
- 
-      FUNCTION IDENT(F : FLOAT5) RETURN FLOAT5 IS
-      BEGIN
-           RETURN F * FLOAT5(IDENT_INT(1));
-      END IDENT;
- 
- BEGIN
-      TEST ("C45323A", "CHECK THAT THE NONASSOCIATIVITY OF REAL " &
-                       "ARITHMETIC IS PRESERVED FOR FLOATING POINT " &
-                       "PRECISION 5, EVEN WHEN OPTIMIZATION WOULD " &
-                       "BENEFIT IF FLOATING POINT ADDITION WERE " &
-                       "ASSOCIATIVE");
- 
-      B := 2#0.1010_1010_1010_1010_10#E3;
-      A := -B;
-      C := 2#0.1000_0000_0000_0000_00#E-18;
-      D := B + C;
-      E := A + B + C;
- 
-      IF IDENT(A) + IDENT(B) /= 0.0 THEN
-           FAILED("INCORRECT VALUE OF A + B");
-      END IF;
- 
-      IF IDENT(E) /= IDENT(C) THEN
-           FAILED("C DOES NOT EQUAL E");
-      END IF;
- 
-      RESULT;
- END C45323A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45331a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45331a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45331a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45331a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,357 ****
- -- C45331A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES THE OPERATORS "+" AND "-" PRODUCE
- -- CORRECT RESULTS WHEN:
- --      (A) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS.
- --      (B) A IS A MODEL NUMBER BUT B, A+B, AND A-B ARE NOT.
- --      (C) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS WITH DIFFERENT
- --          SUBTYPES.
- 
- -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
- 
- -- WRG 8/27/86
- -- KAS 11/14/95 REDUCE EXPECTATION FOR T'SMALL
- -- KAS 11/30/95 ONE MORE CHANGE...
- -- PWN 02/28/96 CLEANED COMMENTS FOR RELEASE
- -- KAS 03/18/96 ELIDED TWO 'SMALL CASES FOR 2.1
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45331A IS
- 
-      TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
-           -- 'MANTISSA = 23.
-      SUBTYPE F     IS LIKE_DURATION DELTA 0.25 RANGE -1000.0 .. 1000.0;
-      SUBTYPE ST_F1 IS LIKE_DURATION DELTA 0.5  RANGE    -4.0 ..    3.0;
-      SUBTYPE ST_F2 IS LIKE_DURATION DELTA 1.0 / 16
-              RANGE -13.0 / 16 .. 5.0 + 1.0 / 16;
- 
- BEGIN
- 
-      TEST ("C45331A", "CHECK THAT FOR FIXED POINT TYPES THE " &
-                       "OPERATORS ""+"" AND ""-"" PRODUCE CORRECT " &
-                       "RESULTS - BASIC TYPES");
- 
-      -------------------------------------------------------------------
- 
- A:   DECLARE
-           SMALL, MAX, MIN, ZERO : F := 0.5;
-           X                     : F := 0.0;
-      BEGIN
-           -- INITIALIZE "CONSTANTS":
-           IF EQUAL (3, 3) THEN
-                SMALL := F'SMALL;
-                MAX   := F'LAST;  -- BECAUSE F'LAST < F'LARGE AND F'LAST
-                                  -- IS A MODEL NUMBER.
-                MIN   := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
-                ZERO  := 0.0;
-           END IF;
- 
-           -- CHECK SMALL + OR - ZERO = SMALL:
-           IF "+"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
-              0.0 + SMALL /= SMALL THEN
-                FAILED ("F'SMALL + 0.0 /= F'SMALL");
-           END IF;
-           IF "-"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
-              SMALL - 0.0 /= SMALL THEN
-                FAILED ("F'SMALL - 0.0 /= F'SMALL");
-           END IF;
- 
-           -- CHECK MAX + OR - ZERO = MAX:
-           IF MAX + ZERO /= MAX OR 0.0 + MAX /= MAX THEN
-                FAILED ("F'LAST + 0.0 /= F'LAST");
-           END IF;
-           IF MAX - ZERO /= MAX OR MAX - 0.0 /= MAX THEN
-                FAILED ("F'LAST - 0.0 /= F'LAST");
-           END IF;
- 
-           -- CHECK SMALL - SMALL = 0.0:
-           IF EQUAL (3, 3) THEN
-                X := SMALL;
-           END IF;
-           IF SMALL - X /= 0.0 OR SMALL - SMALL /= 0.0 OR
-              F'SMALL - F'SMALL /= 0.0 THEN
-                FAILED ("F'SMALL - F'SMALL /= 0.0");
-           END IF;
- 
-           -- CHECK MAX - MAX = 0.0:
-           IF EQUAL (3, 3) THEN
-                X := MAX;
-           END IF;
-           IF MAX - X /= 0.0 OR MAX - MAX /= 0.0 OR
-              F'LAST - F'LAST /= 0.0 THEN
-                FAILED ("F'LAST - F'LAST /= 0.0");
-           END IF;
- 
-           -- CHECK ZERO - MAX = MIN, MIN - MIN = 0.0,
-           -- AND MIN + MAX = 0.0:
-           IF EQUAL (3, 3) THEN
-                X := ZERO - MAX;
-           END IF;
-           IF X /= MIN THEN
-                FAILED ("0.0 - 1000.0 /= -1000.0");
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := MIN;
-           END IF;
-           IF MIN - X /= 0.0 OR MIN - MIN /= 0.0 OR
-              F'FIRST - F'FIRST /= 0.0 THEN
-                FAILED ("F'FIRST - F'FIRST /= 0.0");
-           END IF;
-           IF MIN + MAX /= 0.0 OR MAX + MIN /= 0.0 OR
-              F'FIRST + F'LAST /= 0.0 THEN
-                FAILED ("-1000.0 + 1000.0 /= 0.0");
-           END IF;
- 
-           -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
-           -- NUMBERS:
-           IF EQUAL (3, 3) THEN
-                X := 100.75;
-           END IF;
-           IF (X + SMALL) /= (SMALL + X) OR
-              (X + SMALL) > (X + 0.25) THEN -- X + SMALL SB <= X + DELTA
-                FAILED("X + SMALL DELIVERED BAD RESULT");
-           END IF;
- 
-           -- CHECK (MAX - SMALL) + SMALL = MAX:
-           IF EQUAL (3, 3) THEN
-                X := MAX - SMALL;
-           END IF;
-           IF X + SMALL /= MAX THEN
-               FAILED("(MAX - SMALL) + SMALL /= MAX");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - A");
-      END A;
- 
-      -------------------------------------------------------------------
- 
- B:   DECLARE
-           NON_MODEL_CONST : CONSTANT := 2.0 / 3;
-           NON_MODEL_VAR   : F        := 0.0;
- 
-           SMALL, MAX, MIN, ZERO : F := 0.5;
-           X                     : F := 0.0;
-      BEGIN
-           -- INITIALIZE "CONSTANTS":
-           IF EQUAL (3, 3) THEN
-                SMALL         := F'SMALL;
-                MAX           := F'LAST;  -- BECAUSE F'LAST < F'LARGE AND
-                                          -- F'LAST  IS A MODEL NUMBER.
-                MIN           := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
-                ZERO          := 0.0;
-                NON_MODEL_VAR := NON_MODEL_CONST;
-           END IF;
- 
-           -- CHECK VALUE OF NON_MODEL_VAR:
-           IF NON_MODEL_VAR NOT IN 0.5 .. 0.75 THEN
-                FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE");
-           END IF;
- 
-           -- CHECK NON-MODEL VALUE + OR - ZERO:
-           IF NON_MODEL_VAR + ZERO NOT IN 0.5 .. 0.75 OR
-              F'(0.0) + NON_MODEL_CONST NOT IN 0.5 .. 0.75 THEN
-                FAILED ("(2.0 / 3) + 0.0 NOT IN 0.5 .. 0.75");
-           END IF;
-           IF NON_MODEL_VAR  - ZERO NOT IN 0.5 .. 0.75 OR
-              NON_MODEL_CONST - F'(0.0) NOT IN 0.5 .. 0.75 THEN
-                FAILED ("(2.0 / 3) - 0.0 NOT IN 0.5 .. 0.75");
-           END IF;
- 
-           -- CHECK ZERO - NON-MODEL:
-           IF F'(0.0) - NON_MODEL_CONST NOT IN -0.75 .. -0.5 THEN
-                FAILED ("0.0 - (2.0 / 3) NOT IN -0.75 .. -0.5");
-           END IF;
- 
-           IF F'(1.0) - NON_MODEL_CONST NOT IN 0.25 .. 0.5 THEN
-                FAILED ("1.0 - (2.0 / 3) NOT IN 0.25 .. 0.5");
-           END IF;
- 
-           -- CHECK ADDITION AND SUBTRACTION OF NON-MODEL NEAR MIN AND
-           -- MAX:
-           IF MIN + NON_MODEL_VAR NOT IN -999.5 .. -999.25 OR
-              NON_MODEL_CONST + F'FIRST NOT IN -999.5 .. -999.25 THEN
-                FAILED ("-1000.0 + (2.0 / 3) NOT IN -999.5 .. -999.25");
-           END IF;
-           IF MAX - NON_MODEL_VAR NOT IN 999.25 .. 999.5 OR
-              F'LAST - NON_MODEL_CONST NOT IN 999.25 .. 999.5 THEN
-                FAILED ("1000.0 - (2.0 / 3) NOT IN 999.25 .. 999.5");
-           END IF;
- 
-           -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
-           -- MODEL NUMBER WITH NON-MODEL:
-           IF EQUAL (3, 3) THEN
-                X := -213.25;
-           END IF;
-           IF X + NON_MODEL_CONST NOT IN -212.75 .. -212.5 THEN
-                FAILED ("-213.25 + (2.0 / 3) NOT IN -212.75 .. -212.5");
-           END IF;
-           IF NON_MODEL_VAR - X NOT IN 213.75 .. 214.0 THEN
-                FAILED ("(2.0 / 3) - (-213.25) NOT IN 213.75 .. 214.0");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - B");
-      END B;
- 
-      -------------------------------------------------------------------
- 
- C:   DECLARE
-           A_SMALL, A_MAX, A_MIN : ST_F1 := 0.0;
-           B_SMALL, B_MAX, B_MIN : ST_F2 := 0.0;
-           X                     : F;
-      BEGIN
-           -- INITIALIZE "CONSTANTS":
-           IF EQUAL (3, 3) THEN
-                A_SMALL := ST_F1'SMALL;
-                A_MAX   := ST_F1'LAST;  -- BECAUSE 'LAST < 'LARGE AND
-                                        -- 'LAST  IS A MODEL NUMBER.
-                A_MIN   := ST_F1'FIRST; -- 'FIRST IS A MODEL NUMBER.
- 
-                B_SMALL := ST_F2'SMALL;
-                B_MAX   := ST_F2'LAST;  -- BECAUSE 'LAST <= 'LARGE AND
-                                        -- 'LAST  IS A MODEL NUMBER.
-                B_MIN   := ST_F2'FIRST; -- 'FIRST IS A MODEL NUMBER.
-           END IF;
- 
-           IF A_MIN + B_MIN /= -4.8125 THEN
-                FAILED ("-4.0 + (-0.8125) /= -4.8125");
-           END IF;
- 
-           IF A_MIN - B_MIN /= -3.1875 THEN
-                FAILED ("-4.0 - (-0.8125) /= -3.1875");
-           END IF;
- 
-           IF (A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375 THEN
-                FAILED ("(A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375");
-           END IF;
- 
-           IF (A_MIN - B_SMALL) NOT IN -4.0625 .. -4.0 THEN
-               FAILED ("(A_MIN - B_SMALL) NOT IN -4.0 .. -4.0625");
-           END IF;
- 
-           IF A_MIN + B_MAX /= 1.0625 THEN
-                FAILED ("-4.0 + 5.0625 /= 1.0625");
-           END IF;
- 
-           IF A_MIN - B_MAX /= -9.0625 THEN
-                FAILED ("-4.0 - 5.0625 /= -9.0625");
-           END IF;
- 
-           IF (A_SMALL + B_MIN) NOT IN  B_MIN..-0.3125 THEN
-                FAILED ("(A_SMALL + B_MIN) NOT IN  B_MIN..-0.3125");
-           END IF;
- 
-           IF (A_SMALL - B_MIN) NOT IN +0.8125 .. 1.3125 THEN
-                FAILED ("(A_SMALL - B_MIN) NOT IN -0.8125 .. 1.3125");
-           END IF;
- 
- 
- 
-           IF (A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625 THEN
-                FAILED ("(A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625");
-           END IF;
- 
-           IF (A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625 THEN
-                FAILED ("(A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625");
-           END IF;
- 
-           IF A_MAX + B_MIN /= 2.1875 THEN
-                FAILED ("3.0 + (-0.8125) /= 2.1875");
-           END IF;
- 
-           IF A_MAX - B_MIN /= 3.8125 THEN
-                FAILED ("3.0 - (-0.8125) /= 3.8125");
-           END IF;
- 
-           IF (A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625 THEN
-                FAILED ("(A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625");
-           END IF;
- 
-           IF (A_MAX - B_SMALL) NOT IN 2.9375..3.0 THEN
-                FAILED ("(A_MAX - B_SMALL) NOT IN 2.9375..3.0");
-           END IF;
- 
-           IF A_MAX + B_MAX /= 8.0625 THEN
-                FAILED ("3.0 + 5.0625 /= 8.0625");
-           END IF;
- 
-           IF A_MAX - B_MAX /= -2.0625 THEN
-                FAILED ("3.0 - 5.0625 /= -2.0625");
-           END IF;
- 
-           X := B_MIN - A_MIN;
-           IF X NOT IN 3.0 .. 3.25 THEN
-                FAILED ("-0.8125 - (-4.0) NOT IN RANGE");
-           END IF;
- 
-           X := B_MIN - A_SMALL;
-           IF X NOT IN -1.3125 .. -0.8125 THEN
-                FAILED ("B_MIN - A_SMALL NOT IN RANGE");
-           END IF;
- 
-           X := B_MIN - A_MAX;
-           IF X NOT IN -4.0 .. -3.75 THEN
-                FAILED ("-0.8125 - 3.0 NOT IN RANGE");
-           END IF;
- 
-           X := B_SMALL - A_MIN;
-           IF X NOT IN 4.0 .. 4.0625 THEN
-                FAILED ("B_SMALL - A_MIN NOT IN RANGE");
-           END IF;
- 
- 
-           X := B_SMALL - A_MAX;
-           IF X NOT IN -3.0 .. -2.75 THEN
-                FAILED ("B_SMALL - A_MAX NOT IN RANGE");
-           END IF;
- 
-           X := B_MAX - A_MIN;
-           IF X NOT IN 9.0 .. 9.25 THEN
-                FAILED ("5.0625 - (-4.0) NOT IN RANGE");
-           END IF;
- 
-           X := B_MAX - A_SMALL;
-          IF X NOT IN 4.56 .. 5.0625 THEN
-                FAILED ("5.0625 - 0.5 NOT IN RANGE");
-           END IF;
- 
-           X := B_MAX - A_MAX;
-           IF X NOT IN 2.0 .. 2.25 THEN
-                FAILED ("5.0625 - 3.0 NOT IN RANGE");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - C");
-      END C;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- END C45331A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45342a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45342a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45342a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45342a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C45342A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CATENATION OF TWO OR MORE NON-NULL OPERANDS YIELDS THE
- -- CORRECT RESULT, WITH THE CORRECT BOUNDS, WHETHER BOUNDS ARE STATIC OR
- -- DYNAMIC.
- 
- -- BHS 6/27/84
- 
- WITH REPORT;
- PROCEDURE C45342A IS
- 
-      USE REPORT;
- 
-      SUBTYPE S IS INTEGER RANGE 1..100;
-      TYPE ARR IS ARRAY (S RANGE <>) OF INTEGER;
-      
-      A,B : ARR (2..9);
- 
-      FUNCTION F (AR_VAR1, AR_VAR2, AR_VAR3 : ARR) RETURN ARR IS
-      BEGIN
-           RETURN AR_VAR1 & AR_VAR2 & AR_VAR3;
-      END F;
- 
-      PROCEDURE CAT (A : ARR; I1,I2 : INTEGER; NUM : CHARACTER) IS
-      BEGIN
-           IF A'FIRST /= I1 OR A'LAST /= I2 THEN
-                FAILED ("INCORRECT CATENATION BOUNDS - " & NUM);
-           END IF;
-      END CAT;
- 
- 
- BEGIN
- 
-      TEST ("C45342A", "CHECK THAT CATENATION OF NON-NULL OPERANDS " &
-                       "YIELDS CORRECT RESULT WITH CORRECT BOUNDS"); 
- 
-      BEGIN
-           A := (1,2,3,4,5,6,7,8);
-           B := A(2..4) & A(2..5) & A(2..2);
-           IF B /= (1,2,3,1,2,3,4,1) THEN
-                FAILED ("INCORRECT CATENATION RESULT - 1");
-           END IF;
- 
-           A := (8,7,6,5,4,3,2,1);
-           IF F(A(2..3), A(2..4), A(2..4)) /= (8,7,8,7,6,8,7,6) THEN 
-                FAILED ("INCORRECT CATENATION RESULT - 2");
-           END IF;
- 
-           CAT ( A(3..5) & A(2..3), 3, 7, '3' );
-      END;
- 
- 
-      DECLARE
-           DYN2 : INTEGER := IDENT_INT(2);
-           DYN3 : INTEGER := IDENT_INT(3);
-           DYN4 : INTEGER := IDENT_INT(4);
-           DYN6 : INTEGER := IDENT_INT(6);
-           
-      BEGIN
-           A := (1,2,3,4,5,6,7,8);
-           B := A(DYN2..DYN3) & A(DYN2..DYN4) & A(DYN2..DYN4);
-           IF B /= (1,2,1,2,3,1,2,3) THEN
-                FAILED ("INCORRECT CATENATION RESULT - 4");
-           END IF;
- 
-           A := (8,7,6,5,4,3,2,1);
-           IF F ( A(DYN2..DYN6), A(DYN2..DYN3), A(DYN2..DYN2) )
-                 /= (8,7,6,5,4,8,7,8) THEN
-                FAILED ("INCORRECT CATENATION RESULT - 5");
-           END IF;
- 
-           CAT ( A(DYN3..5) & A(2..3), 3, 7, '6');
-      END;  
- 
-      RESULT;
- 
- END C45342A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45343a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45343a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45343a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45343a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C45343A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CATENATION OF NULL OPERANDS YIELDS THE CORRECT RESULT,
- -- WITH THE CORRECT BOUNDS.
- 
- -- BHS 6/29/84
- 
- WITH REPORT;
- PROCEDURE C45343A IS
- 
-      USE REPORT;
- 
-      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-      SUBTYPE ARR_8 IS ARR (1..8);
-      A1, A2 : ARR_8;
- 
-      PROCEDURE CAT (A : ARR; I1,I2 : INTEGER; NUM : CHARACTER) IS
-      BEGIN
-           IF A'FIRST /= I1 OR A'LAST /= I2 THEN
-                FAILED ("INCORRECT CATENATION - " & NUM);
-           END IF;
-      END CAT;
- 
- BEGIN
- 
-      TEST ("C45343A", "CATENATION OF NULL OPERANDS"); 
- 
- 
-      A1 := (1,2,3,4,5,6,7,8);
-      A2 := A1(1..0) & A1(6..5) & A1(1..8);
-      IF A2 /= (1,2,3,4,5,6,7,8) THEN
-           FAILED ("INCORRECT CATENATION RESULT - 1");
-      END IF;
- 
-      A1 := (1,2,3,4,5,6,7,8);
-      A2 := A1(2..8) & A1(1..0) & 9;
-      IF A2 /= (2,3,4,5,6,7,8,9) THEN
-           FAILED ("INCORRECT CATENATION RESULT - 2");
-      END IF;
- 
- 
-      CAT ( A1(1..0) & A1(IDENT_INT(2)..0), 2, 0, '3' );
-      CAT ( A1(IDENT_INT(1)..0) & A2(2..0), 2, 0, '4' );
- 
-      CAT ( A1(1..0) & A1(6..5) & A1(2..8), 2, 8, '5' );
-      CAT ( A1(2..8) & A1(1..0), 2, 8, '6' );
- 
-      CAT ( A2(1..0) & A2(6..5) & A2(IDENT_INT(2)..8), 2, 8, '7' );
-      CAT ( A2(IDENT_INT(2)..8) & A2(1..0), 2, 8, '8' );
- 
-      RESULT;
- 
- END C45343A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45344a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45344a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45344a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45344a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C45344A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CORRECT RESULT IS PRODUCED WHEN A FUNCTION RETURNS 
- -- THE RESULT OF A CATENATION WHOSE BOUNDS ARE NOT DEFINED STATICALLY.
- 
- -- R.WILLIAMS 9/1/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45344A IS
- 
- BEGIN
-      TEST ( "C45344A", "CHECK THAT THE CORRECT RESULT IS PRODUCED " &
-                        "WHEN A FUNCTION RETURNS THE RESULT OF A " &
-                        "CATENATION WHOSE BOUNDS ARE NOT DEFINED " &
-                        "STATICALLY" );
- 
-      DECLARE
-           SUBTYPE INT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (30);
- 
-           TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
-           SUBTYPE CARR IS ARR (1 .. 9);
-           C : CARR;
-           
-           AR1 : ARR (IDENT_INT (2) .. IDENT_INT (4)) :=
-                     (IDENT_INT (2) .. IDENT_INT (4) => 1);
- 
-           AR2 : ARR (IDENT_INT (6) .. IDENT_INT (6)) :=
-                     (IDENT_INT (6) .. IDENT_INT (6) => 2);
- 
-           AR3 : ARR (IDENT_INT (4) .. IDENT_INT (2));
-      
-           FUNCTION F (A, B : ARR; N : NATURAL) RETURN ARR IS
-           BEGIN
-                IF N = 0 THEN
-                     RETURN A & B;
-                ELSE
-                     RETURN F (A & B, B, N - 1);
-                END IF;
-           END F;
-      
-           FUNCTION G (A : INTEGER; B : ARR; N : NATURAL) RETURN ARR IS
-           BEGIN
-                IF N = 0 THEN
-                     RETURN A & B;
-                ELSE
-                     RETURN G (A, A & B, N - 1);
-                END IF;
-           END G;
- 
-           FUNCTION H (A : ARR; B : INTEGER; N : NATURAL) RETURN ARR IS
-           BEGIN
-                IF N = 0 THEN
-                     RETURN A & B;
-                ELSE
-                     RETURN H (A & B, B, N - 1);
-                END IF;
-           END H;
-      
-           PROCEDURE CHECK (X, Y : ARR; F, L : INTEGER; STR : STRING) IS
-                OK : BOOLEAN := TRUE;
-           BEGIN
-                IF X'FIRST /= F AND X'LAST /= L THEN
-                     FAILED ( "INCORRECT RANGE FOR " & STR);
-                ELSE
-                     FOR I IN F .. L LOOP
-                          IF X (I) /= Y (I) THEN
-                               OK := FALSE;
-                          END IF;
-                     END LOOP;
-      
-                     IF NOT OK THEN
-                          FAILED ( "INCORRECT VALUE FOR " & STR);
-                     END IF;
-                END IF;
-           END CHECK;
- 
-      BEGIN
-           C := (1 .. 4 => 1, 5 .. 9 => 2);
-           CHECK (F (AR1, AR2, IDENT_INT (3)), C, 2, 8, "F - 1" );
-           CHECK (F (AR3, AR2, IDENT_INT (3)), C, 6, 9, "F - 2" );
-           CHECK (F (AR2, AR3, IDENT_INT (3)), C, 6, 6, "F - 3" );
- 
-           C := (1 ..4 => 5, 5 .. 9 => 1);
-           CHECK (G (5, AR1, IDENT_INT (3)), C, 1, 7, "G - 1" );
-           CHECK (G (5, AR3, IDENT_INT (3)), C, 1, 4, "G - 2" );
- 
-           CHECK (H (AR3, 5, IDENT_INT (3)), C, 1, 4, "H - 1" );
- 
-           C := (1 ..4 => 1, 5 .. 9 => 5);
-           CHECK (H (AR1, 5, IDENT_INT (3)), C, 2, 8, "H - 2" );
-      END;
- 
-      RESULT;
- END C45344A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45345b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45345b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45345b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45345b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- C45345B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT  CONSTRAINT_ERROR  IS NOT RAISED IF THE RESULT OF
- --     CATENATION HAS PRECISELY THE MAXIMUM LENGTH PERMITTED BY THE
- --     INDEX SUBTYPE.
- 
- 
- -- RM  2/26/82
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C45345B IS
- 
- 
- BEGIN
- 
-      TEST ( "C45345B" , "CHECK THAT  CONSTRAINT_ERROR  IS NOT RAISED" &
-                         " IF THE RESULT OF CATENATION HAS PRECISELY" &
-                         " THE MAXIMUM LENGTH PERMITTED BY THE" &
-                         " INDEX SUBTYPE" );
- 
- 
-      -------------------------------------------------------------------
-      -----------------  STRG_VAR := STRG_LIT & STRG_LIT  ---------------
- 
-      DECLARE
- 
-           X : STRING(1..5) ;
- 
-      BEGIN
- 
-           X := "ABCD" & "E" ;
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
-                FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
- 
-           WHEN  OTHERS =>
-                FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
- 
-      END;
- 
- 
-      -------------------------------------------------------------------
-      -----------------  STRG_VAR := STRG_LIT & CHARACTER  --------------
- 
-      DECLARE
- 
-           X : STRING(1..5) ;
- 
-      BEGIN
- 
-           X := "ABCD" & 'E' ;
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
-                FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
- 
-           WHEN  OTHERS =>
-                FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
- 
-      END;
- 
-      -------------------------------------------------------------------
-      -----------------  STRG_VAR := STRG_VAR & STRG_VAR  ---------------
- 
-      DECLARE
- 
-           X :          STRING(1..5) ;
-           A : CONSTANT STRING       := "A" ;
-           B :          STRING(1..4) := IDENT_STR("BCDE") ;
- 
-      BEGIN
- 
-           X :=  A & B ;
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
-                FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
- 
-           WHEN  OTHERS =>
-                FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
- 
-      END;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT;
- 
- 
- END C45345B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- C45347A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CATENATION IS DEFINED FOR RECORD TYPES AS COMPONENT TYPES.
- 
- -- JWC 11/15/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45347A IS
- 
- BEGIN
- 
-      TEST ("C45347A", "CHECK THAT CATENATION IS DEFINED " &
-                       "FOR RECORD TYPES AS COMPONENT TYPES");
- 
-      DECLARE
- 
-           TYPE REC IS
-                RECORD
-                     X : INTEGER;
-                END RECORD;
- 
-           SUBTYPE INT IS INTEGER RANGE 1 .. 4;
-           TYPE A IS ARRAY ( INT RANGE <>) OF REC;
- 
-           R1 : REC := (X => 4);
-           R2 : REC := (X => 1);
- 
-           A1 : A(1 .. 2) := ((X => 1), (X => 2));
-           A2 : A(1 .. 2) := ((X => 3), (X => 4));
-           A3 : A(1 .. 4) := ((X => 1), (X => 2), (X => 3), (X => 4));
-           A4 : A(1 .. 4);
-           A5 : A(1 .. 4) := ((X => 4), (X => 3), (X => 2), (X => 1));
- 
-      BEGIN
- 
-           A4 := A1 & A2;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF " &
-                        "RECORDS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := A1 & A2(1) & R1;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ARRAY OF RECORD, " &
-                        "AND RECORDS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := R2 & (A1(2) & A2);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR RECORDS, " &
-                        "AND ARRAY OF RECORDS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := R2 & A1(2) & (A2(1) & R1);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR RECORDS");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45347A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C45347B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CATENATION IS DEFINED FOR ARRAY TYPES AS COMPONENT TYPES.
- 
- -- JWC 11/15/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45347B IS
- 
- BEGIN
- 
-      TEST ("C45347B", "CHECK THAT CATENATION IS DEFINED " &
-                       "FOR ARRAY TYPES AS COMPONENT TYPES");
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (1 .. 2) OF INTEGER;
-           TYPE A IS ARRAY ( INTEGER RANGE <>) OF ARR;
- 
-           AR1 : ARR := (4,1);
-           AR2 : ARR := (1,1);
- 
-           A1 : A(1 .. 2) := ((1,1), (2,1));
-           A2 : A(1 .. 2) := ((3,1), (4,1));
-           A3 : A(1 .. 4) := ((1,1), (2,1), (3,1), (4,1));
-           A4 : A(1 .. 4);
-           A5 : A(1 .. 4) := ((4,1), (3,1), (2,1), (1,1));
- 
-      BEGIN
- 
-           A4 := A1 & A2;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ARRAYS OF ARRAYS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := A1 & A2(1) & AR1;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ARRAY OF ARRAYS " &
-                        "WITH ARRAYS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := AR2 & (A1(2) & A2);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ARRAYS WITH ARRAYS " &
-                        "OF ARRAYS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := A'(AR2 & A1(2)) & A'(A2(1) & AR1);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ARRAYS");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45347B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C45347C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CATENATION IS DEFINED FOR PRIVATE TYPES AS COMPONENT
- -- TYPES.
- 
- -- JWC 11/15/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45347C IS
- 
- BEGIN
- 
-      TEST ("C45347C", "CHECK THAT CATENATION IS DEFINED " &
-                       "FOR PRIVATE TYPES AS COMPONENT TYPES");
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE PRIV IS PRIVATE;
-                ONE : CONSTANT PRIV;
-                TWO : CONSTANT PRIV;
-                THREE : CONSTANT PRIV;
-                FOUR : CONSTANT PRIV;
-           PRIVATE
-                TYPE PRIV IS NEW INTEGER;
-                ONE : CONSTANT PRIV := 1;
-                TWO : CONSTANT PRIV := 2;
-                THREE : CONSTANT PRIV := 3;
-                FOUR : CONSTANT PRIV := 4;
-           END PKG;
- 
-           USE PKG;
- 
-           SUBTYPE INT IS INTEGER RANGE 1 .. 4;
-           TYPE A IS ARRAY ( INT RANGE <>) OF PRIV;
- 
-           P1 : PRIV := FOUR;
-           P2 : PRIV := ONE;
- 
-           A1 : A(1 .. 2) := (ONE, TWO);
-           A2 : A(1 .. 2) := (THREE, FOUR);
-           A3 : A(1 .. 4) := (ONE, TWO, THREE, FOUR);
-           A4 : A(1 .. 4);
-           A5 : A(1 .. 4) := (FOUR, THREE, TWO, ONE);
- 
-      BEGIN
- 
-           A4 := A1 & A2;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF " &
-                        "PRIVATE");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := A1 & A2(1) & P1;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ARRAY OF PRIVATE, " &
-                        "AND PRIVATE");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := P2 & (A1(2) & A2);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR PRIVATE, AND ARRAY " &
-                        "OF PRIVATE");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := P2 & A1(2) & (A2(1) & P1);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR PRIVATE");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45347C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45347d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45347d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C45347D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CATENATION IS DEFINED FOR ACCESS TYPES AS COMPONENT TYPES.
- 
- -- JWC 11/15/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45347D IS
- 
- BEGIN
- 
-      TEST ("C45347D", "CHECK THAT CATENATION IS DEFINED " &
-                       "FOR ACCESS TYPES AS COMPONENT TYPES");
- 
-      DECLARE
- 
-           SUBTYPE INT IS INTEGER RANGE 1 .. 4;
-           TYPE ACC IS ACCESS INT;
-           TYPE A IS ARRAY ( INT RANGE <>) OF ACC;
- 
-           AC1 : ACC := NEW INT'(1);
-           AC2 : ACC := NEW INT'(2);
-           AC3 : ACC := NEW INT'(3);
-           AC4 : ACC := NEW INT'(4);
- 
-           A1 : A(1 .. 2) := (AC1, AC2);
-           A2 : A(1 .. 2) := (AC3, AC4);
-           A3 : A(1 .. 4) := (AC1, AC2, AC3, AC4);
-           A4 : A(1 .. 4);
-           A5 : A(1 .. 4) := (AC4, AC3, AC2, AC1);
- 
-      BEGIN
- 
-           A4 := A1 & A2;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF ACCESS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := A1 & A2(1) & AC4;
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ARRAY OF ACCESS, " &
-                        "AND ACCESS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := AC1 & (A1(2) & A2);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ACCESS, AND ARRAY " &
-                        "OF ACCESS");
-           END IF;
- 
-           A4 := A5;
- 
-           A4 := AC1 & A1(2) & (A2(1) & AC4);
- 
-           IF A3 /= A4 THEN
-                FAILED ("INCORRECT CATENATION FOR ACCESS");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45347D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C45411A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
- --     PREDEFINED INTEGER OPERANDS.
- 
- -- HISTORY:
- --     JET 01/25/88  CREATED ORIGINAL TEST.
- --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45411A IS
- 
-      TYPE DT IS NEW INTEGER RANGE -3..3;
-      I1 : INTEGER := 1;
-      D1 : DT := 1;
- 
- BEGIN
-      TEST ("C45411A", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
-                       "CORRECT RESULTS FOR PREDEFINED INTEGER " &
-                       "OPERANDS");
- 
-      FOR I IN (1-2)..INTEGER(1) LOOP
-           IF "-"(RIGHT => I1) /= IDENT_INT(I) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        INTEGER'IMAGE(I+2));
-           END IF;
- 
-           IF +I1 /= IDENT_INT(I1) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        INTEGER'IMAGE(I+2));
-           END IF;
-           I1 := I1 - 1;
-      END LOOP;
- 
-      FOR I IN (1-2)..INTEGER(1) LOOP
-           IF -I /= IDENT_INT(0)-I THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        INTEGER'IMAGE(I+5));
-           END IF;
- 
-           IF "+"(RIGHT => IDENT_INT(I)) /= I THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        INTEGER'IMAGE(I+5));
-           END IF;
-      END LOOP;
- 
-      IF -1 /= IDENT_INT(1)-2 THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 7");
-      END IF;
- 
-      IF "-"(RIGHT => 0) /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 8");
-      END IF;
- 
-      IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 9");
-      END IF;
- 
-      IF "+"(RIGHT => 1) /= IDENT_INT(2)-1 THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 7");
-      END IF;
- 
-      IF +0 /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 8");
-      END IF;
- 
-      IF +(-1) /= IDENT_INT(1)-2 THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 9");
-      END IF;
- 
-      FOR I IN (1-2)..INTEGER(1) LOOP
-           IF "-"(RIGHT => D1) /= DT(IDENT_INT(I)) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        INTEGER'IMAGE(I+11));
-           END IF;
- 
-           IF +D1 /= DT(IDENT_INT(INTEGER(D1))) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        INTEGER'IMAGE(I+11));
-           END IF;
-           D1 := D1 - 1;
-      END LOOP;
- 
-      IF INTEGER'LAST + INTEGER'FIRST = 0 THEN
-           IF IDENT_INT(-INTEGER'LAST) /= INTEGER'FIRST THEN
-                FAILED ("-INTEGER'LAST IS NOT EQUAL TO INTEGER'FIRST");
-           END IF;
-      ELSE
-           IF IDENT_INT(-INTEGER'LAST) /= INTEGER'FIRST+1 THEN
-                FAILED ("-INTEGER'LAST IS NOT EQUAL TO INTEGER'FIRST+1");
-           END IF;
-      END IF;
- 
-      RESULT;
- 
- END C45411A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- -- C45411B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
- --     PREDEFINED SHORT_INTEGER OPERANDS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --     THE PREDEFINED SHORT_INTEGER TYPE.
- 
- --     IF THE TYPE SHORT_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION
- --     OF TYPE "DT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     JET 07/11/88  CREATED ORIGINAL TEST.
- --     KAS 01/12/95  DELETED INCOMPATIBLE SUBTEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45411B IS
- 
-      TYPE DT IS NEW SHORT_INTEGER RANGE -3..3;          -- N/A => ERROR.
-      I1 : SHORT_INTEGER := 1;
-      D1 : DT := 1;
- 
-      FUNCTION IDENT (A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           RETURN A * SHORT_INTEGER(IDENT_INT(1));
-      END;
- 
- BEGIN
-      TEST ("C45411B", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
-                       "CORRECT RESULTS FOR PREDEFINED SHORT_INTEGER " &
-                       "OPERANDS");
- 
-      FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
-           IF "-"(RIGHT => I1) /= IDENT(I) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        SHORT_INTEGER'IMAGE(I+2));
-           END IF;
- 
-           IF +I1 /= IDENT(I1) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        SHORT_INTEGER'IMAGE(I+2));
-           END IF;
-           I1 := I1 - 1;
-      END LOOP;
- 
-      FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
-           IF -I /= IDENT(0)-I THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        SHORT_INTEGER'IMAGE(I+5));
-           END IF;
- 
-           IF "+"(RIGHT => IDENT(I)) /= I THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        SHORT_INTEGER'IMAGE(I+5));
-           END IF;
-      END LOOP;
- 
-      IF -1 /= IDENT(1)-2 THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 7");
-      END IF;
- 
-      IF "-"(RIGHT => 0) /= IDENT(0) THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 8");
-      END IF;
- 
-      IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT(1) THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 9");
-      END IF;
- 
-      IF "+"(RIGHT => 1) /= IDENT(2)-1 THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 7");
-      END IF;
- 
-      IF +0 /= IDENT(0) THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 8");
-      END IF;
- 
-      IF +(-1) /= IDENT(1)-2 THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 9");
-      END IF;
- 
-      FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
-           IF "-"(RIGHT => D1) /= DT(IDENT(I)) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        SHORT_INTEGER'IMAGE(I+11));
-           END IF;
- 
-           IF +D1 /= DT(IDENT(SHORT_INTEGER(D1))) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        SHORT_INTEGER'IMAGE(I+11));
-           END IF;
-           D1 := D1 - 1;
-      END LOOP;
- 
- 
-      RESULT;
- 
- END C45411B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- -- C45411C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
- --     PREDEFINED LONG_INTEGER OPERANDS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --     THE PREDEFINED LONG_INTEGER TYPE.
- 
- --     IF THE TYPE LONG_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION
- --     OF TYPE "DT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     JET 07/11/88  CREATED ORIGINAL TEST.
- --     KAS 01/12/95  REMOVED INCOMPATIBLE SUBTEST
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45411C IS
- 
-      TYPE DT IS NEW LONG_INTEGER RANGE -3..3;          -- N/A => ERROR.
-      I1 : LONG_INTEGER := 1;
-      D1 : DT := 1;
- 
-      FUNCTION IDENT (A : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           RETURN A * LONG_INTEGER(IDENT_INT(1));
-      END;
- 
- BEGIN
-      TEST ("C45411C", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
-                       "CORRECT RESULTS FOR PREDEFINED LONG_INTEGER " &
-                       "OPERANDS");
- 
-      FOR I IN (1-2)..LONG_INTEGER(1) LOOP
-           IF "-"(RIGHT => I1) /= IDENT(I) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        LONG_INTEGER'IMAGE(I+2));
-           END IF;
- 
-           IF +I1 /= IDENT(I1) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        LONG_INTEGER'IMAGE(I+2));
-           END IF;
-           I1 := I1 - 1;
-      END LOOP;
- 
-      FOR I IN (1-2)..LONG_INTEGER(1) LOOP
-           IF -I /= IDENT(0)-I THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        LONG_INTEGER'IMAGE(I+5));
-           END IF;
- 
-           IF "+"(RIGHT => IDENT(I)) /= I THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        LONG_INTEGER'IMAGE(I+5));
-           END IF;
-      END LOOP;
- 
-      IF -1 /= IDENT(1)-2 THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 7");
-      END IF;
- 
-      IF "-"(RIGHT => 0) /= IDENT(0) THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 8");
-      END IF;
- 
-      IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT(1) THEN
-           FAILED ("INCORRECT RESULT FOR ""-"" - 9");
-      END IF;
- 
-      IF "+"(RIGHT => 1) /= IDENT(2)-1 THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 7");
-      END IF;
- 
-      IF +0 /= IDENT(0) THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 8");
-      END IF;
- 
-      IF +(-1) /= IDENT(1)-2 THEN
-           FAILED ("INCORRECT RESULT FOR ""+"" - 9");
-      END IF;
- 
-      FOR I IN (1-2)..LONG_INTEGER(1) LOOP
-           IF "-"(RIGHT => D1) /= DT(IDENT(I)) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" -" &
-                        LONG_INTEGER'IMAGE(I+11));
-           END IF;
- 
-           IF +D1 /= DT(IDENT(LONG_INTEGER(D1))) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" -" &
-                        LONG_INTEGER'IMAGE(I+11));
-           END IF;
-           D1 := D1 - 1;
-      END LOOP;
- 
- 
-      RESULT;
- 
- END C45411C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45411d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45411d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C45411D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
- --     OPERANDS OF DERIVED INTEGER TYPES.
- 
- -- HISTORY:
- --     JET 07/11/88  CREATED ORIGINAL TEST.
- --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45411D IS
- 
-      TYPE INT IS RANGE -100..100;
- 
-      TYPE DT1 IS NEW INTEGER;
-      TYPE DT2 IS NEW INT;
- 
-      D1 : DT1 := 1;
-      D2 : DT2 := 1;
- 
-      FUNCTION IDENT (A : DT1) RETURN DT1 IS
-      BEGIN
-           RETURN A * DT1(IDENT_INT(1));
-      END IDENT;
- 
-      FUNCTION IDENT (A : DT2) RETURN DT2 IS
-      BEGIN
-           RETURN A * DT2(IDENT_INT(1));
-      END IDENT;
- 
- BEGIN
-      TEST ("C45411D", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
-                       "CORRECT RESULTS FOR OPERANDS OF DERIVED " &
-                       "INTEGER TYPES");
- 
-      FOR I IN DT1'(1-2)..DT1'(1) LOOP
-           IF "-"(RIGHT => D1) /= IDENT(I) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" DT1 -" &
-                        DT1'IMAGE(I+2));
-           END IF;
- 
-           IF +D1 /= IDENT(D1) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" DT1 -" &
-                        DT1'IMAGE(I+2));
-           END IF;
-           D1 := D1 - 1;
-      END LOOP;
- 
-      IF DT1'LAST + DT1'FIRST = 0 THEN
-           IF IDENT(-DT1'LAST) /= DT1'FIRST THEN
-                FAILED ("-DT1'LAST IS NOT EQUAL TO DT1'FIRST");
-           END IF;
-      ELSE
-           IF IDENT(-DT1'LAST) /= DT1'FIRST+1 THEN
-                FAILED ("-DT1'LAST IS NOT EQUAL TO DT1'FIRST+1");
-           END IF;
-      END IF;
- 
-      FOR I IN DT2'(1-2)..DT2'(1) LOOP
-           IF -D2 /= IDENT(I) THEN
-                FAILED ("INCORRECT RESULT FOR ""-"" DT2 -" &
-                        DT2'IMAGE(I+2));
-           END IF;
- 
-           IF "+"(RIGHT => D2) /= IDENT(D2) THEN
-                FAILED ("INCORRECT RESULT FOR ""+"" DT2 -" &
-                        DT2'IMAGE(I+2));
-           END IF;
-           D2 := D2 - 1;
-      END LOOP;
- 
-      RESULT;
- 
- END C45411D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45413a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45413a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45413a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45413a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C45413A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNARY MINUS YIELDS AND ACCEPTS RESULTS BELONGING TO
- -- THE BASE TYPE.
- 
- -- JBG 2/24/84
- -- JRL 10/13/96 Removed static expressions which contained values outside
- --              the base range.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45413A IS
- 
-      TYPE INT IS RANGE 1..10;
- 
-      X : INT := INT(IDENT_INT(9));
- 
- BEGIN
- 
-      TEST ("C45413A", "CHECK SUBTYPE OF UNARY PLUS/MINUS");
- 
-      BEGIN
- 
-           IF -X /= INT'VAL(-9) THEN
-                FAILED ("INCORRECT RESULT - UNARY MINUS");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("UNARY MINUS DOES NOT YIELD RESULT " &
-                        "BELONGING TO THE BASE TYPE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 1");
-      END;
- 
-      BEGIN
- 
-           IF -(INT'VAL(-9)) /= 9 THEN
-                FAILED ("WRONG RESULT - UNARY MINUS");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("UNARY MINUS ARGUMENT NOT IN BASE TYPE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 2");
-      END;
- 
-      RESULT;
- 
- END C45413A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45431a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45431a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45431a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45431a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,212 ****
- -- C45431A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR FIXED POINT TYPES +A = A AND THAT, FOR MODEL NUMBERS,
- -- -(-A) = A.
- 
- -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
- 
- -- WRG 8/28/86
- -- PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45431A IS
- 
- BEGIN
- 
-      TEST ("C45431A", "CHECK THAT FOR FIXED POINT TYPES +A = A AND " &
-                       "THAT, FOR MODEL NUMBERS, -(-A) = A " &
-                       "-- BASIC TYPES");
- 
-      -------------------------------------------------------------------
- 
- A:   DECLARE
-           TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
- 
-           NON_MODEL_CONST : CONSTANT      := 2.0 / 3;
-           NON_MODEL_VAR   : LIKE_DURATION := 0.0;
- 
-           SMALL, MAX, MIN, ZERO : LIKE_DURATION := 0.5;
-           X                     : LIKE_DURATION := 0.0;
-      BEGIN
-           -- INITIALIZE "CONSTANTS":
-           IF EQUAL (3, 3) THEN
-                NON_MODEL_VAR := NON_MODEL_CONST;
-                SMALL         := LIKE_DURATION'SMALL;
-                MAX           := LIKE_DURATION'LAST;
-                MIN           := LIKE_DURATION'FIRST;
-                ZERO          := 0.0;
-           END IF;
- 
-           -- CHECK + OR - ZERO = ZERO:
-           IF "+"(RIGHT => ZERO) /= 0.0 OR
-              +LIKE_DURATION'(0.0) /= ZERO THEN
-                FAILED ("+0.0 /= 0.0");
-           END IF;
-           IF "-"(RIGHT => ZERO) /= 0.0 OR
-              -LIKE_DURATION'(0.0) /= ZERO THEN
-                FAILED ("-0.0 /= 0.0");
-           END IF;
-           IF -(-ZERO) /= 0.0 THEN
-                FAILED ("-(-0.0) /= 0.0");
-           END IF;
- 
-           -- CHECK + AND - MAX:
-           IF EQUAL (3, 3) THEN
-                X := MAX;
-           END IF;
-           IF +X /= MAX OR +LIKE_DURATION'LAST /= MAX THEN
-                FAILED ("+LIKE_DURATION'LAST /= LIKE_DURATION'LAST");
-           END IF;
-           IF -(-X) /= MAX OR -(-LIKE_DURATION'LAST) /= MAX THEN
-                FAILED ("-(-LIKE_DURATION'LAST) /= LIKE_DURATION'LAST");
-           END IF;
- 
-           -- CHECK + AND - MIN:
-           IF EQUAL (3, 3) THEN
-                X := MIN;
-           END IF;
-           IF +X /= MIN OR +LIKE_DURATION'FIRST /= MIN THEN
-                FAILED ("+LIKE_DURATION'FIRST /= LIKE_DURATION'FIRST");
-           END IF;
-           IF -(-X) /= MIN OR -(-LIKE_DURATION'FIRST) /= MIN THEN
-                FAILED("-(-LIKE_DURATION'FIRST) /= LIKE_DURATION'FIRST");
-           END IF;
- 
-           -- CHECK + AND - SMALL:
-           IF EQUAL (3, 3) THEN
-                X := SMALL;
-           END IF;
-           IF +X /= SMALL OR +LIKE_DURATION'SMALL /= SMALL THEN
-                FAILED ("+LIKE_DURATION'SMALL /= LIKE_DURATION'SMALL");
-           END IF;
-           IF -(-X) /= SMALL OR -(-LIKE_DURATION'SMALL) /= SMALL THEN
-                FAILED("-(-LIKE_DURATION'SMALL) /= LIKE_DURATION'SMALL");
-           END IF;
- 
-           -- CHECK ARBITRARY MID-RANGE NUMBERS:
-           IF EQUAL (3, 3) THEN
-                X := 1000.984_375;
-           END IF;
-           IF +X /= 1000.984_375 OR +1000.984_375 /= X THEN
-                FAILED ("+1000.984_375 /= 1000.984_375");
-           END IF;
-           IF -(-X) /= 1000.984_375 OR -(-1000.984_375) /= X THEN
-                FAILED ("-(-1000.984_375) /= 1000.984_375");
-           END IF;
- 
-           -- CHECK "+" AND "-" FOR NON-MODEL NUMBER:
-           IF +LIKE_DURATION'(NON_MODEL_CONST) NOT IN 0.656_25 ..
-                                                      0.671_875 OR
-              +NON_MODEL_VAR NOT IN 0.656_25 .. 0.671_875 THEN
-                FAILED ("+LIKE_DURATION'(2.0 / 3) NOT IN 0.656_25 .. " &
-                        "0.671_875");
-           END IF;
-           IF -LIKE_DURATION'(NON_MODEL_CONST) NOT IN -0.671_875 ..
-                                                      -0.656_25 OR
-              -NON_MODEL_VAR NOT IN -0.671_875 .. -0.656_25 THEN
-                FAILED ("-LIKE_DURATION'(2.0 / 3) NOT IN -0.671_875 " &
-                        ".. -0.656_25");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED -- A");
-      END A;
- 
-      -------------------------------------------------------------------
- 
- B:   DECLARE
-           TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
- 
-           NON_MODEL_CONST : CONSTANT   := 2.0 / 3;
-           NON_MODEL_VAR   : DECIMAL_M4 := 0.0;
- 
-           SMALL, MAX, MIN, ZERO : DECIMAL_M4 := -128.0;
-           X                     : DECIMAL_M4 :=    0.0;
-      BEGIN
-           -- INITIALIZE "CONSTANTS":
-           IF EQUAL (3, 3) THEN
-                NON_MODEL_VAR :=  NON_MODEL_CONST;
-                SMALL         :=  DECIMAL_M4'SMALL;
-                ZERO          :=  0.0;
-           END IF;
- 
-           -- CHECK + OR - ZERO = ZERO:
-           IF +ZERO /= 0.0 OR +DECIMAL_M4'(0.0) /= ZERO THEN
-                FAILED ("+0.0 /= 0.0");
-           END IF;
-           IF -ZERO /= 0.0 OR -DECIMAL_M4'(0.0) /= ZERO THEN
-                FAILED ("-0.0 /= 0.0");
-           END IF;
-           IF -(-ZERO) /= 0.0 THEN
-                FAILED ("-(-0.0) /= 0.0");
-           END IF;
- 
-           -- CHECK + AND - MAX:
-           IF EQUAL (3, 3) THEN
-                X := MAX;
-           END IF;
-           -- CHECK + AND - SMALL:
-           IF EQUAL (3, 3) THEN
-                X := SMALL;
-           END IF;
-           IF +X /= SMALL OR +DECIMAL_M4'SMALL /= SMALL THEN
-                FAILED ("+DECIMAL_M4'SMALL /= DECIMAL_M4'SMALL");
-           END IF;
-           IF -(-X) /= SMALL OR -(-DECIMAL_M4'SMALL) /= SMALL THEN
-                FAILED ("-(-DECIMAL_M4'SMALL) /= DECIMAL_M4'SMALL");
-           END IF;
- 
-           -- CHECK ARBITRARY MID-RANGE NUMBERS:
-           IF EQUAL (3, 3) THEN
-                X := 256.0;
-           END IF;
-           IF +X /= 256.0 OR +256.0 /= X THEN
-                FAILED ("+256.0 /= 256.0");
-           END IF;
-           IF -(-X) /= 256.0 OR -(-256.0) /= X THEN
-                FAILED ("-(-256.0) /= 256.0");
-           END IF;
- 
-           -- CHECK "+" AND "-" FOR NON-MODEL NUMBER:
-           IF +DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 OR
-              +NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN
-                FAILED ("+DECIMAL_M4'(2.0 / 3) NOT IN 0.0 .. 64.0");
-           END IF;
-           IF -DECIMAL_M4'(NON_MODEL_CONST) NOT IN -64.0 .. 0.0 OR
-              -NON_MODEL_VAR NOT IN -64.0 .. 0.0 THEN
-                FAILED ("-DECIMAL_M4'(2.0 / 3) NOT IN -64.0 .. 0.0");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED -- B");
-      END B;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- END C45431A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c455001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c455001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c455001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c455001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C455001.A
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that universal fixed multiplying operators can be used without
- --     a conversion in contexts where the result type is determined.
- --
- --     Note: This is intended to check the changes made to these operators
- --     in Ada 95; legacy tests should cover cases from Ada 83.
- --
- -- CHANGE HISTORY:
- --      18 MAR 99   RLB    Initial version
- --
- --!
- 
- with Report; use Report;
- 
- procedure C455001 is
- 
-      type F1 is delta 2.0**(-1) range 0.0 .. 8.0;
- 
-      type F2 is delta 2.0**(-2) range 0.0 .. 4.0;
- 
-      type F3 is delta 2.0**(-3) range 0.0 .. 2.0;
- 
-      A : F1;
-      B : F2;
-      C : F3;
- 
-      type Fixed_Record is record
- 	D : F1;
-         E : F2;
-      end record;
- 
-      R : Fixed_Record;
- 
-      function Ident_Fix (X : F3) return F3 is
-      begin
-           if Equal(3,3) then
-                return X;
-           else
-                return 0.0;
-           end if;
-      end Ident_Fix;
- 
- begin
-      Test ("C455001", "Check that universal fixed multiplying operators " &
-                       "can be used without a conversion in contexts where " &
-                       "the result type is determined.");
- 
-      A := 1.0; B := 1.0;
-      C := A * B; -- Assignment context.
- 
-      if C /= Ident_Fix(1.0) then
-           Failed ("Incorrect results for multiplication (1) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      C := A / B;
- 
-      if C /= Ident_Fix(1.0) then
-           Failed ("Incorrect results for division (1) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      A := 2.5;
-      C := A * 0.25;
- 
-      if C /= Ident_Fix(0.625) then
-           Failed ("Incorrect results for multiplication (2) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      C := A / 4.0;
- 
-      if C /= Ident_Fix(0.625) then
-           Failed ("Incorrect results for division (2) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      C := Ident_Fix(0.75);
-      C := C * 0.5;
- 
-      if C /= Ident_Fix(0.375) then
-           Failed ("Incorrect results for multiplication (3) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      C := Ident_Fix(0.75);
-      C := C / 0.5;
- 
-      if C /= Ident_Fix(1.5) then
-           Failed ("Incorrect results for division (3) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      A := 0.5; B := 0.3; -- Function parameter context.
-      if Ident_Fix(A * B) not in Ident_Fix(0.125) .. Ident_Fix(0.25) then
-           Failed ("Incorrect results for multiplication (4) - result is " &
- 		  F3'Image(A * B)); -- Exact = 0.15
-      end if;
- 
-      B := 0.8;
-      if Ident_Fix(A / B) not in Ident_Fix(0.5) .. Ident_Fix(0.75) then
-           Failed ("Incorrect results for division (4) - result is " &
- 		  F3'Image(A / B));
- 		-- Exact = 0.625..., but B is only restricted to the range
- 		-- 0.75 .. 1.0, so the result can be anywhere in the range
- 		-- 0.5 .. 0.75.
-      end if;
- 
-      C := 0.875; B := 1.5;
-      R := (D => C * 4.0, E => B / 0.5); -- Aggregate context.
- 
-      if R.D /= 3.5 then
-           Failed ("Incorrect results for multiplication (5) - result is " &
- 		  F1'Image(R.D));
-      end if;
- 
-      if R.E /= 3.0 then
-           Failed ("Incorrect results for division (5) - result is " &
- 		  F2'Image(R.E));
-      end if;
- 
-      A := 0.5;
-      C := A * F1'(B * 2.0); -- Qualified expression context.
- 
-      if C /= Ident_Fix(1.5) then
-           Failed ("Incorrect results for multiplication (6) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      A := 4.0;
-      C := F1'(B / 0.5) / A;
- 
-      if C /= Ident_Fix(0.75) then
-           Failed ("Incorrect results for division (6) - result is " &
- 		  F3'Image(C));
-      end if;
- 
-      Result;
- 
- end C455001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45502b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45502b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45502b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45502b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,291 ****
- -- C45502B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT MULTIPLICATION AND DIVISION YIELD CORRECT RESULTS WHEN
- --     THE OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 09/01/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45502B IS
- 
-      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
- 
-      FUNCTION IDENT (S : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (S)));
-      END IDENT;
- 
- BEGIN
-      TEST ( "C45502B", "CHECK THAT MULTIPLICATION AND DIVISION " &
-                        "YIELD CORRECT RESULTS WHEN THE OPERANDS " &
-                        "ARE OF PREDEFINED TYPE SHORT_INTEGER" );
- 
-      DECLARE
-           I0  : SHORT_INTEGER := 0;
-           I1  : SHORT_INTEGER := 1;
-           I2  : SHORT_INTEGER := 2;
-           I3  : SHORT_INTEGER := 3;
-           I5  : SHORT_INTEGER := 5;
-           I10 : SHORT_INTEGER := 10;
-           I11 : SHORT_INTEGER := 11;
-           I12 : SHORT_INTEGER := 12;
-           I13 : SHORT_INTEGER := 13;
-           I14 : SHORT_INTEGER := 14;
-           N1  : SHORT_INTEGER := -1;
-           N2  : SHORT_INTEGER := -2;
-           N5  : SHORT_INTEGER := -5;
-           N10 : SHORT_INTEGER := -10;
-           N11 : SHORT_INTEGER := -11;
-           N12 : SHORT_INTEGER := -12;
-           N13 : SHORT_INTEGER := -13;
-           N14 : SHORT_INTEGER := -14;
-           N50 : SHORT_INTEGER := -50;
- 
-      BEGIN
-           IF I0 * SHORT_INTEGER'FIRST /= 0 THEN
-                FAILED ( "INCORRECT RESULT FOR I0 * " &
-                         "SHORT_INTEGER'FIRST" );
-           END IF;
- 
-           IF I0 * SHORT_INTEGER'LAST /= 0 THEN
-                FAILED ( "INCORRECT RESULT FOR I0 * " &
-                         "SHORT_INTEGER'LAST" );
-           END IF;
- 
-           IF N1 * SHORT_INTEGER'LAST + SHORT_INTEGER'LAST /= 0 THEN
-                FAILED ( "INCORRECT RESULT FOR N1 * " &
-                         "SHORT_INTEGER'LAST" );
-           END IF;
- 
-           IF I3 * I1 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR I3 * I1" );
-           END IF;
- 
-           IF IDENT (I3) * IDENT (I1) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I3) * " &
-                         "IDENT (I1)" );
-           END IF;
- 
-           IF I2 * N1 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I2 * N1" );
-           END IF;
- 
-           IF "*" (LEFT => I2, RIGHT => N1) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I2, " &
-                         "RIGHT => N1)" );
-           END IF;
- 
-           IF IDENT (I2) * IDENT (N1) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I2) * " &
-                         "IDENT (N1)" );
-           END IF;
- 
-           IF I5 * I2 * N5 /= N50 THEN
-                FAILED ( "INCORRECT RESULT FOR I5 * I2 * N5" );
-           END IF;
- 
-           IF IDENT (N1) * IDENT (N5) /= I5 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "*" (LEFT => IDENT (N1), RIGHT => IDENT (N5)) /=
-                  I5 THEN
-                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => " &
-                         "IDENT (N1), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF IDENT (N1) * IDENT (I2) * IDENT (N5) /= I10
-              THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
-                         "IDENT (I2) * IDENT (N5)" );
-           END IF;
- 
-           IF (-IDENT (I0)) * IDENT (I10) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) * " &
-                         "IDENT (I10)" );
-           END IF;
- 
-           IF I0 * I10 /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR I0 * I10" );
-           END IF;
- 
-           IF "*" (LEFT => I0, RIGHT => I10) /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I0, " &
-                         "RIGHT => I10)" );
-           END IF;
- 
-           IF IDENT (I10) / IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I10) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF I11 / I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 / I5" );
-           END IF;
- 
-           IF IDENT (I12) / IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I12) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF "/" (LEFT => IDENT (I12), RIGHT => IDENT (I5)) /=
-                  I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
-                         "IDENT (I12), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF I13 / I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 / I5" );
-           END IF;
- 
-           IF IDENT (I14) / IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I14) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF I10 / N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 / N5" );
-           END IF;
- 
-           IF "/" (LEFT => I10, RIGHT => N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I10, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT (I11) / IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I11) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF I12 / N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 / N5" );
-           END IF;
- 
-           IF IDENT (I13) / IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I13) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF I14 / N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 / N5" );
-           END IF;
- 
-           IF IDENT (N10) / IDENT (I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N10) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF "/" (LEFT => IDENT (N10), RIGHT => IDENT (I5)) /=
-                  N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
-                         "IDENT (N10), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF N11 / I5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 / I5" );
-           END IF;
- 
-           IF IDENT (N12) / IDENT (I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N12) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF N13 / I5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 / I5" );
-           END IF;
- 
-           IF "/" (LEFT => N13, RIGHT => I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N13, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (N14) / IDENT (I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N14) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF N10 / N5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 / N5" );
-           END IF;
- 
-           IF IDENT (N11) / IDENT (N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N11) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF "/" (LEFT => IDENT (N11), RIGHT => IDENT (N5)) /=
-                  I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
-                         "IDENT (N11), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF N12 / N5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 / N5" );
-           END IF;
- 
- 
-           IF IDENT (N13) / IDENT (N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N13) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF N14 / N5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 / N5" );
-           END IF;
- 
-           IF "/" (LEFT => N14, RIGHT => N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N14, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF I0 / I5 /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR I0 / I5" );
-           END IF;
- 
-           IF "/" (LEFT => I0, RIGHT => I5) /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I0, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF (-IDENT (I0)) / IDENT (I5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) / " &
-                         "IDENT (I5)" );
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C45502B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45502c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45502c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45502c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45502c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,295 ****
- -- C45502C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT MULTIPLICATION AND DIVISION YIELD CORRECT RESULTS WHEN
- --     THE OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     LONG_INTEGER.
- 
- --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_LONG" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 09/01/86
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45502C IS
- 
-      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
- 
-      FUNCTION IDENT (S : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN S;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT;
- 
- BEGIN
-      TEST ( "C45502C", "CHECK THAT MULTIPLICATION AND DIVISION " &
-                        "YIELD CORRECT RESULTS WHEN THE OPERANDS " &
-                        "ARE OF PREDEFINED TYPE LONG_INTEGER" );
- 
-      DECLARE
-           I0  : LONG_INTEGER := 0;
-           I1  : LONG_INTEGER := 1;
-           I2  : LONG_INTEGER := 2;
-           I3  : LONG_INTEGER := 3;
-           I5  : LONG_INTEGER := 5;
-           I10 : LONG_INTEGER := 10;
-           I11 : LONG_INTEGER := 11;
-           I12 : LONG_INTEGER := 12;
-           I13 : LONG_INTEGER := 13;
-           I14 : LONG_INTEGER := 14;
-           N1  : LONG_INTEGER := -1;
-           N2  : LONG_INTEGER := -2;
-           N5  : LONG_INTEGER := -5;
-           N10 : LONG_INTEGER := -10;
-           N11 : LONG_INTEGER := -11;
-           N12 : LONG_INTEGER := -12;
-           N13 : LONG_INTEGER := -13;
-           N14 : LONG_INTEGER := -14;
-           N50 : LONG_INTEGER := -50;
- 
-      BEGIN
-           IF I0 * LONG_INTEGER'FIRST /= 0 THEN
-                FAILED ( "INCORRECT RESULT FOR I0 * " &
-                         "LONG_INTEGER'FIRST" );
-           END IF;
- 
-           IF I0 * LONG_INTEGER'LAST /= 0 THEN
-                FAILED ( "INCORRECT RESULT FOR I0 * " &
-                         "LONG_INTEGER'LAST" );
-           END IF;
- 
-           IF N1 * LONG_INTEGER'LAST + LONG_INTEGER'LAST /= 0 THEN
-                FAILED ( "INCORRECT RESULT FOR N1 * " &
-                         "LONG_INTEGER'LAST" );
-           END IF;
- 
-           IF I3 * I1 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR I3 * I1" );
-           END IF;
- 
-           IF IDENT (I3) * IDENT (I1) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I3) * " &
-                         "IDENT (I1)" );
-           END IF;
- 
-           IF I2 * N1 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I2 * N1" );
-           END IF;
- 
-           IF "*" (LEFT => I2, RIGHT => N1) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I2, " &
-                         "RIGHT => N1)" );
-           END IF;
- 
-           IF IDENT (I2) * IDENT (N1) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I2) * " &
-                         "IDENT (N1)" );
-           END IF;
- 
-           IF I5 * I2 * N5 /= N50 THEN
-                FAILED ( "INCORRECT RESULT FOR I5 * I2 * N5" );
-           END IF;
- 
-           IF IDENT (N1) * IDENT (N5) /= I5 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "*" (LEFT => IDENT (N1), RIGHT => IDENT (N5)) /=
-                  I5 THEN
-                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => " &
-                         "IDENT (N1), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF IDENT (N1) * IDENT (I2) * IDENT (N5) /= I10
-              THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
-                         "IDENT (I2) * IDENT (N5)" );
-           END IF;
- 
-           IF (-IDENT (I0)) * IDENT (I10) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) * " &
-                         "IDENT (I10)" );
-           END IF;
- 
-           IF I0 * I10 /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR I0 * I10" );
-           END IF;
- 
-           IF "*" (LEFT => I0, RIGHT => I10) /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I0, " &
-                         "RIGHT => I10)" );
-           END IF;
- 
-           IF IDENT (I10) / IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I10) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF I11 / I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 / I5" );
-           END IF;
- 
-           IF IDENT (I12) / IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I12) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF "/" (LEFT => IDENT (I12), RIGHT => IDENT (I5)) /=
-                  I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
-                         "IDENT (I12), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF I13 / I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 / I5" );
-           END IF;
- 
-           IF IDENT (I14) / IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I14) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF I10 / N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 / N5" );
-           END IF;
- 
-           IF "/" (LEFT => I10, RIGHT => N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I10, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT (I11) / IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I11) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF I12 / N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 / N5" );
-           END IF;
- 
-           IF IDENT (I13) / IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I13) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF I14 / N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 / N5" );
-           END IF;
- 
-           IF IDENT (N10) / IDENT (I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N10) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF "/" (LEFT => IDENT (N10), RIGHT => IDENT (I5)) /=
-                  N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
-                         "IDENT (N10), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF N11 / I5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 / I5" );
-           END IF;
- 
-           IF IDENT (N12) / IDENT (I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N12) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF N13 / I5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 / I5" );
-           END IF;
- 
-           IF "/" (LEFT => N13, RIGHT => I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N13, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (N14) / IDENT (I5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N14) " &
-                         "/ IDENT (I5)" );
-           END IF;
- 
-           IF N10 / N5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 / N5" );
-           END IF;
- 
-           IF IDENT (N11) / IDENT (N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N11) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF "/" (LEFT => IDENT (N11), RIGHT => IDENT (N5)) /=
-                  I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
-                         "IDENT (N11), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF N12 / N5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 / N5" );
-           END IF;
- 
- 
-           IF IDENT (N13) / IDENT (N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N13) " &
-                         "/ IDENT (N5)" );
-           END IF;
- 
-           IF N14 / N5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 / N5" );
-           END IF;
- 
-           IF "/" (LEFT => N14, RIGHT => N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N14, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF I0 / I5 /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR I0 / I5" );
-           END IF;
- 
-           IF "/" (LEFT => I0, RIGHT => I5) /= (-I0) THEN
-                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I0, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF (-IDENT (I0)) / IDENT (I5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) / " &
-                         "IDENT (I5)" );
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C45502C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45503a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45503a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45503a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45503a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,310 ****
- -- C45503A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE OPERANDS 
- -- ARE OF PREDEFINED TYPE INTEGER.
- 
- -- R.WILLIAMS 9/1/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45503A IS
- 
- BEGIN
-      TEST ( "C45503A", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
-                        "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
-                        "TYPE INTEGER" );
- 
-      DECLARE
-           I0  : INTEGER := 0;
-           I1  : INTEGER := 1;
-           I2  : INTEGER := 2;
-           I3  : INTEGER := 3;
-           I4  : INTEGER := 4;
-           I5  : INTEGER := 5;    
-           I10 : INTEGER := 10;
-           I11 : INTEGER := 11;
-           I12 : INTEGER := 12;
-           I13 : INTEGER := 13;
-           I14 : INTEGER := 14;
-           N1  : INTEGER := -1;
-           N2  : INTEGER := -2;
-           N3  : INTEGER := -3;
-           N4  : INTEGER := -4;
-           N5  : INTEGER := -5;
-           N10 : INTEGER := -10;
-           N11 : INTEGER := -11;
-           N12 : INTEGER := -12;
-           N13 : INTEGER := -13;
-           N14 : INTEGER := -14;
- 
-      BEGIN
-           IF I10 REM I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
-           END IF;
- 
-           IF IDENT_INT (I11) REM IDENT_INT (I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I11) REM " &
-                         "IDENT_INT (I5)" );
-           END IF;
-  
-           IF I12 REM I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
-           END IF;
- 
-           IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT_INT (I13) REM IDENT_INT (I5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I13) REM " &
-                         "IDENT_INT (I5)" );
-           END IF;
- 
-           IF I14 REM I5 /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
-           END IF;
- 
-           IF IDENT_INT (I10) REM IDENT_INT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I10) REM " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT_INT (I10), RIGHT => IDENT_INT (N5)) 
-                    /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT_INT (I10), RIGHT => IDENT_INT (N5))" );
-           END IF;
- 
-           IF I11 REM N5 /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
-           END IF;
- 
-           IF IDENT_INT (I12) REM IDENT_INT (N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I12) REM " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF I13 REM N5 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
-           END IF;
- 
-           IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT_INT (I14) REM IDENT_INT (N5) /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I14) REM " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF N10 REM I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
-           END IF;
- 
-           IF IDENT_INT (N11) REM IDENT_INT (I5) /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N11) REM " &
-                         "IDENT_INT (I5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT_INT (N11), RIGHT => IDENT_INT (I5)) 
-                    /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT_INT (N11), RIGHT => IDENT_INT (I5))" );
-           END IF;
- 
-           IF N12 REM I5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
-           END IF;
- 
-           IF IDENT_INT (N13) REM IDENT_INT (I5) /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N13) REM " &
-                         "IDENT_INT (I5)" );
-           END IF;
- 
-           IF N14 REM I5 /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
-           END IF;
- 
-           IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT_INT (N10) REM IDENT_INT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N10) REM " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF N11 REM N5 /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
-           END IF;
- 
-           IF IDENT_INT (N12) REM IDENT_INT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N12) REM " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT_INT (N12), RIGHT => IDENT_INT (N5)) 
-                    /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT_INT (N12), RIGHT => IDENT_INT (N5))" );
-           END IF;
- 
-           IF N13 REM N5 /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
-           END IF;
- 
-           IF IDENT_INT (N14) REM IDENT_INT (N5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N14) REM " &
-                         "IDENT_INT (N5)" );
-           END IF;
-           
-           IF I10 MOD I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
-           END IF;
- 
-           IF IDENT_INT (I11) MOD IDENT_INT (I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I11) MOD " &
-                         "IDENT_INT (I5)" );
-           END IF;
-  
-           IF I12 MOD I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
-           END IF;
- 
-           IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT_INT (I13) MOD IDENT_INT (I5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I13) MOD " &
-                         "IDENT_INT (I5)" );
-           END IF;
- 
-           IF I14 MOD I5 /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
-           END IF;
- 
-           IF IDENT_INT (I10) MOD IDENT_INT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I10) MOD " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT_INT (I10), RIGHT => IDENT_INT (N5)) 
-                    /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT_INT (I10), RIGHT => IDENT_INT (N5))" );
-           END IF;
- 
-           IF I11 MOD N5 /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
-           END IF;
- 
-           IF IDENT_INT (I12) MOD IDENT_INT (N5) /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I12) MOD " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF I13 MOD N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
-           END IF;
- 
-           IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT_INT (I14) MOD IDENT_INT (N5) /=  N1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I14) MOD " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF N10 MOD I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
-           END IF;
- 
-           IF IDENT_INT (N11) MOD IDENT_INT (I5) /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N11) MOD " &
-                         "IDENT_INT (I5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT_INT (N11), RIGHT => IDENT_INT (I5)) 
-                    /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT_INT (N11), RIGHT => IDENT_INT (I5))" );
-           END IF;
- 
-           IF N12 MOD I5 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
-           END IF;
- 
-           IF IDENT_INT (N13) MOD IDENT_INT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N13) MOD " &
-                         "IDENT_INT (I5)" );
-           END IF;
- 
-           IF N14 MOD I5 /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
-           END IF;
- 
-           IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT_INT (N10) MOD IDENT_INT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N10) MOD " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF N11 MOD N5 /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
-           END IF;
- 
-           IF IDENT_INT (N12) MOD IDENT_INT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N12) MOD " &
-                         "IDENT_INT (N5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT_INT (N12), RIGHT => IDENT_INT (N5)) 
-                    /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT_INT (N12), RIGHT => IDENT_INT (N5))" );
-           END IF;
- 
-           IF N13 MOD N5 /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
-           END IF;
- 
-           IF IDENT_INT (N14) MOD IDENT_INT (N5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N14) MOD " &
-                         "IDENT_INT (N5)" );
-           END IF;
-      END;
-           
-      RESULT;
- END C45503A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45503b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45503b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45503b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45503b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,327 ****
- -- C45503B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE
- --     OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 09/01/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45503B IS
- 
-      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
- 
-      FUNCTION IDENT (S : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (S)));
-      END IDENT;
- 
- BEGIN
-      TEST ( "C45503B", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
-                        "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
-                        "TYPE SHORT_INTEGER" );
- 
-      DECLARE
-           I0  : SHORT_INTEGER := 0;
-           I1  : SHORT_INTEGER := 1;
-           I2  : SHORT_INTEGER := 2;
-           I3  : SHORT_INTEGER := 3;
-           I4  : SHORT_INTEGER := 4;
-           I5  : SHORT_INTEGER := 5;
-           I10 : SHORT_INTEGER := 10;
-           I11 : SHORT_INTEGER := 11;
-           I12 : SHORT_INTEGER := 12;
-           I13 : SHORT_INTEGER := 13;
-           I14 : SHORT_INTEGER := 14;
-           N1  : SHORT_INTEGER := -1;
-           N2  : SHORT_INTEGER := -2;
-           N3  : SHORT_INTEGER := -3;
-           N4  : SHORT_INTEGER := -4;
-           N5  : SHORT_INTEGER := -5;
-           N10 : SHORT_INTEGER := -10;
-           N11 : SHORT_INTEGER := -11;
-           N12 : SHORT_INTEGER := -12;
-           N13 : SHORT_INTEGER := -13;
-           N14 : SHORT_INTEGER := -14;
- 
-      BEGIN
-           IF I10 REM I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
-           END IF;
- 
-           IF IDENT (I11) REM IDENT (I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I11) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I12 REM I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
-           END IF;
- 
-           IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (I13) REM IDENT (I5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I13) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I14 REM I5 /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
-           END IF;
- 
-           IF IDENT (I10) REM IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I10) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
-                    /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT (I10), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF I11 REM N5 /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
-           END IF;
- 
-           IF IDENT (I12) REM IDENT (N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I12) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF I13 REM N5 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
-           END IF;
- 
-           IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT (I14) REM IDENT (N5) /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I14) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N10 REM I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
-           END IF;
- 
-           IF IDENT (N11) REM IDENT (I5) /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N11) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
-                    /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT (N11), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF N12 REM I5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
-           END IF;
- 
-           IF IDENT (N13) REM IDENT (I5) /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N13) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF N14 REM I5 /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
-           END IF;
- 
-           IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (N10) REM IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N10) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N11 REM N5 /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
-           END IF;
- 
-           IF IDENT (N12) REM IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N12) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
-                    /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT (N12), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF N13 REM N5 /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
-           END IF;
- 
-           IF IDENT (N14) REM IDENT (N5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N14) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF I10 MOD I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
-           END IF;
- 
-           IF IDENT (I11) MOD IDENT (I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I11) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I12 MOD I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
-           END IF;
- 
-           IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (I13) MOD IDENT (I5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I13) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I14 MOD I5 /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
-           END IF;
- 
-           IF IDENT (I10) MOD IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I10) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
-                    /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT (I10), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF I11 MOD N5 /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
-           END IF;
- 
-           IF IDENT (I12) MOD IDENT (N5) /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I12) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF I13 MOD N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
-           END IF;
- 
-           IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT (I14) MOD IDENT (N5) /=  N1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I14) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N10 MOD I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
-           END IF;
- 
-           IF IDENT (N11) MOD IDENT (I5) /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N11) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
-                    /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT (N11), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF N12 MOD I5 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
-           END IF;
- 
-           IF IDENT (N13) MOD IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N13) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF N14 MOD I5 /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
-           END IF;
- 
-           IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (N10) MOD IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N10) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N11 MOD N5 /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
-           END IF;
- 
-           IF IDENT (N12) MOD IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N12) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
-                    /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT (N12), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF N13 MOD N5 /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
-           END IF;
- 
-           IF IDENT (N14) MOD IDENT (N5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N14) MOD " &
-                         "IDENT (N5)" );
-           END IF;
-      END;
- 
-      RESULT;
- END C45503B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45503c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45503c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45503c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45503c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,331 ****
- -- C45503C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE
- --     OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     LONG_INTEGER.
- 
- --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_LONG" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 09/01/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45503C IS
- 
-      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
- 
-      FUNCTION IDENT (L : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN L;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT;
- 
- BEGIN
-      TEST ( "C45503C", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
-                        "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
-                        "TYPE LONG_INTEGER" );
- 
-      DECLARE
-           I0  : LONG_INTEGER := 0;
-           I1  : LONG_INTEGER := 1;
-           I2  : LONG_INTEGER := 2;
-           I3  : LONG_INTEGER := 3;
-           I4  : LONG_INTEGER := 4;
-           I5  : LONG_INTEGER := 5;
-           I10 : LONG_INTEGER := 10;
-           I11 : LONG_INTEGER := 11;
-           I12 : LONG_INTEGER := 12;
-           I13 : LONG_INTEGER := 13;
-           I14 : LONG_INTEGER := 14;
-           N1  : LONG_INTEGER := -1;
-           N2  : LONG_INTEGER := -2;
-           N3  : LONG_INTEGER := -3;
-           N4  : LONG_INTEGER := -4;
-           N5  : LONG_INTEGER := -5;
-           N10 : LONG_INTEGER := -10;
-           N11 : LONG_INTEGER := -11;
-           N12 : LONG_INTEGER := -12;
-           N13 : LONG_INTEGER := -13;
-           N14 : LONG_INTEGER := -14;
- 
-      BEGIN
-           IF I10 REM I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
-           END IF;
- 
-           IF IDENT (I11) REM IDENT (I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I11) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I12 REM I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
-           END IF;
- 
-           IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (I13) REM IDENT (I5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I13) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I14 REM I5 /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
-           END IF;
- 
-           IF IDENT (I10) REM IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I10) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
-                    /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT (I10), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF I11 REM N5 /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
-           END IF;
- 
-           IF IDENT (I12) REM IDENT (N5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I12) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF I13 REM N5 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
-           END IF;
- 
-           IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT (I14) REM IDENT (N5) /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I14) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N10 REM I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
-           END IF;
- 
-           IF IDENT (N11) REM IDENT (I5) /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N11) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
-                    /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT (N11), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF N12 REM I5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
-           END IF;
- 
-           IF IDENT (N13) REM IDENT (I5) /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N13) REM " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF N14 REM I5 /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
-           END IF;
- 
-           IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (N10) REM IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N10) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N11 REM N5 /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
-           END IF;
- 
-           IF IDENT (N12) REM IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N12) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "REM" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
-                    /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
-                         "IDENT (N12), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF N13 REM N5 /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
-           END IF;
- 
-           IF IDENT (N14) REM IDENT (N5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N14) REM " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF I10 MOD I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
-           END IF;
- 
-           IF IDENT (I11) MOD IDENT (I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I11) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I12 MOD I5 /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
-           END IF;
- 
-           IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (I13) MOD IDENT (I5) /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I13) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF I14 MOD I5 /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
-           END IF;
- 
-           IF IDENT (I10) MOD IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I10) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
-                    /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT (I10), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF I11 MOD N5 /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
-           END IF;
- 
-           IF IDENT (I12) MOD IDENT (N5) /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I12) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF I13 MOD N5 /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
-           END IF;
- 
-           IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
-                         "RIGHT => N5)" );
-           END IF;
- 
-           IF IDENT (I14) MOD IDENT (N5) /=  N1 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (I14) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N10 MOD I5 /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
-           END IF;
- 
-           IF IDENT (N11) MOD IDENT (I5) /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N11) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
-                    /= I4 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT (N11), RIGHT => IDENT (I5))" );
-           END IF;
- 
-           IF N12 MOD I5 /= I3 THEN
-                FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
-           END IF;
- 
-           IF IDENT (N13) MOD IDENT (I5) /= I2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N13) MOD " &
-                         "IDENT (I5)" );
-           END IF;
- 
-           IF N14 MOD I5 /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
-           END IF;
- 
-           IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
-                         "RIGHT => I5)" );
-           END IF;
- 
-           IF IDENT (N10) MOD IDENT (N5) /= I0 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N10) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF N11 MOD N5 /= N1 THEN
-                FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
-           END IF;
- 
-           IF IDENT (N12) MOD IDENT (N5) /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N12) MOD " &
-                         "IDENT (N5)" );
-           END IF;
- 
-           IF "MOD" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
-                    /= N2 THEN
-                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
-                         "IDENT (N12), RIGHT => IDENT (N5))" );
-           END IF;
- 
-           IF N13 MOD N5 /= N3 THEN
-                FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
-           END IF;
- 
-           IF IDENT (N14) MOD IDENT (N5) /= N4 THEN
-                FAILED ( "INCORRECT RESULT FOR IDENT (N14) MOD " &
-                         "IDENT (N5)" );
-           END IF;
-      END;
- 
-      RESULT;
- END C45503C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C45504A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A
- --      PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF THE
- --      OPERANDS ARE OF PREDEFINED TYPE INTEGER.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --      RJW 09/01/86  CREATED ORIGINAL TEST.
- --      JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
- --                    PREVENT OPTIMIZATION.
- --      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45504A IS
- 
-      F : INTEGER := IDENT_INT (INTEGER'FIRST);
-      L : INTEGER := IDENT_INT (INTEGER'LAST);
- 
- BEGIN
-      TEST ( "C45504A", "CHECK THAT CONSTRAINT_ERROR " &
-                        "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
-                        "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
-                        "OF PREDEFINED TYPE INTEGER" );
- 
-      BEGIN
-           IF EQUAL (F*L,-100) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
-      END;
- 
-      BEGIN
-           IF EQUAL (F*F,100) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
-      END;
- 
-      BEGIN
-           IF EQUAL (L*L,100) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
-      END;
- 
-      RESULT;
- END C45504A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C45504B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN
- --      A PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF
- --      THE OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --      THE PREDEFINED TYPE "SHORT_INTEGER".
- 
- --      IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF
- --      THE VARIABLE "F" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --      RJW 09/01/86  CREATED ORIGINAL TEST.
- --      JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
- --                    DEFEAT OPTIMIZATION.
- --      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45504B IS
- 
-      F : SHORT_INTEGER;                -- N/A => ERROR.
-      L : SHORT_INTEGER;
- 
-      FUNCTION IDENT_SHORT(A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN A;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT_SHORT;
- 
-      FUNCTION SHORT_OK(X : SHORT_INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN X = IDENT_SHORT(X);
-      END SHORT_OK;
- 
- BEGIN
-      TEST ( "C45504B", "CHECK THAT CONSTRAINT_ERROR " &
-                        "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
-                        "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
-                        "OF PREDEFINED TYPE SHORT_INTEGER" );
- 
-      F := IDENT_SHORT(SHORT_INTEGER'FIRST);
-      L := IDENT_SHORT(SHORT_INTEGER'LAST);
- 
-      BEGIN
-           IF SHORT_OK (F*L) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
-      END;
- 
-      BEGIN
-           IF SHORT_OK (F * F) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
-      END;
- 
-      BEGIN
-           IF SHORT_OK (L * L) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
-      END;
- 
-      RESULT;
- 
- END C45504B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- C45504C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A
- --      PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF THE
- --      OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --      THE PREDEFINED TYPE "LONG_INTEGER".
- 
- --      IF SUCH A TYPE IS NOT SUPPORTED THEN THE DECLARATION OF THE
- --      VARIABLE "F" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --      RJW 09/01/86  CREATED ORIGINAL TEST.
- --      JET 12/30/87  UPDATED HEADER FORMAT AND DEFEATED OPTIMIZATION.
- --      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45504C IS
- 
-      F : LONG_INTEGER;                --  N/A => ERROR.
-      L : LONG_INTEGER;
- 
-      FUNCTION IDENT_LONG(A : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN A;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT_LONG;
- 
-      FUNCTION LONG_OK (X : LONG_INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN X = IDENT_LONG(X);
-      END;
- 
- BEGIN
-      TEST ( "C45504C", "CHECK THAT CONSTRAINT_ERROR " &
-                        "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
-                        "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
-                        "OF PREDEFINED TYPE LONG_INTEGER" );
- 
-      F := IDENT_LONG(LONG_INTEGER'FIRST);
-      L := IDENT_LONG(LONG_INTEGER'LAST);
- 
-      BEGIN
-           IF LONG_OK (F * L) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
-      END;
- 
-      BEGIN
-           IF LONG_OK (F * F) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
-      END;
- 
-      BEGIN
-           IF LONG_OK (L * L) THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
-      END;
- 
-      RESULT;
- 
- END C45504C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,214 ****
- -- C45504D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE SECOND
- -- OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE OPERANDS ARE OF 
- -- PREDEFINED TYPE INTEGER.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- R.WILLIAMS 9/1/86
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45504D IS
- 
-      I0 : INTEGER := IDENT_INT (0);
-      I5 : INTEGER := IDENT_INT (5);
-      N5 : INTEGER := IDENT_INT (-5);
- 
- BEGIN
-      TEST ( "C45504D", "CHECK THAT CONSTRAINT_ERROR " &
-                        "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
-                        "'MOD', OR 'REM' EQUALS ZERO, IF THE " & 
-                        "OPERANDS ARE OF PREDEFINED TYPE INTEGER" );
- 
-      BEGIN
-           IF I5 / I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
-      END;
- 
-      BEGIN
-           IF N5 / I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
-      END;
- 
-      BEGIN
-           IF I0 / I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
-      END;
- 
-      BEGIN
-           IF I5 / I0 * I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
-      END;
- 
-      BEGIN
-           IF I5 MOD I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF N5 MOD I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I0 MOD I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                         "(I5 + I0) MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                         "(I5 + I0) MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
-                          "(I5 + I0) MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                          "(I5 + I0) MOD I0'" );
-      END;
-           
-      BEGIN
-           IF I5 REM I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
-      END;
- 
-      BEGIN
-           IF N5 REM I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
-      END;
- 
-      BEGIN
-           IF I0 REM I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
-      END;
- 
-      BEGIN
-           IF I5 REM (-I0) = I5 REM I0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                         "I5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                         "I5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
-                          "= I5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                          "I5 REM I0'" );
-      END;
-           
-      RESULT;
- END C45504D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504e.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504e.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504e.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504e.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- C45504E.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE
- --     SECOND OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE
- --     OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     RJW 09/01/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     JRL 03/11/93 INITIALIZED VARIABLES TO DEFEAT OPTIMIZATION.
- --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45504E IS
- 
-      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
- 
-      I0 : SHORT_INTEGER := 1;
-      I5 : SHORT_INTEGER := 2;
-      N5 : SHORT_INTEGER := 3;
- 
- BEGIN
-      TEST ( "C45504E", "CHECK THAT CONSTRAINT_ERROR " &
-                        "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
-                        "'MOD', OR 'REM' EQUALS ZERO, IF THE " &
-                        "OPERANDS ARE OF PREDEFINED TYPE " &
-                        "SHORT_INTEGER" );
- 
-      IF EQUAL (3, 3) THEN
-           I0 := 0;
-           I5 := 5;
-           N5 := -5;
-      END IF;
- 
-      BEGIN
-           IF I5 / I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
-      END;
- 
-      BEGIN
-           IF N5 / I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
-      END;
- 
-      BEGIN
-           IF I0 / I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
-      END;
- 
-      BEGIN
-           IF I5 / I0 * I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
-      END;
- 
-      BEGIN
-           IF I5 MOD I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF N5 MOD I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I0 MOD I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                         "(I5 + I0) MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                         "(I5 + I0) MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
-                          "(I5 + I0) MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                          "(I5 + I0) MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I5 REM I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
-      END;
- 
-      BEGIN
-           IF N5 REM I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
-      END;
- 
-      BEGIN
-           IF I0 REM I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
-      END;
- 
-      BEGIN
-           IF I5 REM (-I0) = I5 REM I0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                         "I5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                         "I5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
-                          "= I5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                          "I5 REM I0'" );
-      END;
- 
-      RESULT;
- END C45504E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504f.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504f.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45504f.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45504f.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- C45504F.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE
- --     SECOND OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE
- --     OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     LONG_INTEGER.
- 
- --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_LONG" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- HISTORY:
- --     RJW 09/01/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     JRL 03/11/93 INITIALIZED VARIABLES TO DEFEAT OPTIMIZATION.
- --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45504F IS
- 
-      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
- 
-      I0 : LONG_INTEGER := 1;
-      I5 : LONG_INTEGER := 2;
-      N5 : LONG_INTEGER := 3;
- 
- BEGIN
-      TEST ( "C45504F", "CHECK THAT CONSTRAINT_ERROR " &
-                        "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
-                        "'MOD', OR 'REM' EQUALS ZERO, IF THE " &
-                        "OPERANDS ARE OF PREDEFINED TYPE " &
-                        "LONG_INTEGER" );
- 
-      IF EQUAL (3, 3) THEN
-           I0 := 0;
-           I5 := 5;
-           N5 := -5;
-      END IF;
- 
-      BEGIN
-           IF I5 / I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
-      END;
- 
-      BEGIN
-           IF N5 / I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
-      END;
- 
-      BEGIN
-           IF I0 / I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
-      END;
- 
-      BEGIN
-           IF I5 / I0 * I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
-      END;
- 
-      BEGIN
-           IF I5 MOD I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF N5 MOD I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I0 MOD I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                         "(I5 + I0) MOD I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                         "(I5 + I0) MOD I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
-                          "(I5 + I0) MOD I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
-                          "(I5 + I0) MOD I0'" );
-      END;
- 
-      BEGIN
-           IF I5 REM I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
-      END;
- 
-      BEGIN
-           IF N5 REM I0 = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
-      END;
- 
-      BEGIN
-           IF I0 REM I0  = 0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
-      END;
- 
-      BEGIN
-           IF I5 REM (-I0) = I5 REM I0 THEN
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                         "I5 REM I0' - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                         "I5 REM I0' - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
-                          "= I5 REM I0'" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
-                          "I5 REM I0'" );
-      END;
- 
-      RESULT;
- END C45504F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45505a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45505a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45505a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45505a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- C45505A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT MULTIPLICATION FOR INTEGER SUBTYPES YIELDS A RESULT
- -- BELONGING TO THE BASE TYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- 
- -- JBG 2/24/84
- -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45505A IS
- 
-      TYPE INT IS RANGE 1..10;
- 
-      X, Y : INT := INT(IDENT_INT(5));
- 
- BEGIN
- 
-      TEST ("C45505A", "CHECK SUBTYPE OF INTEGER MULTIPLICATION");
- 
-      BEGIN
- 
-           IF X * Y / 5 /= INT(IDENT_INT(5)) THEN
-                FAILED ("INCORRECT RESULT");
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                IF INT'BASE'LAST >= INT'VAL(25) THEN
-                     FAILED ("MULTIPLICATION DOES NOT YIELD RESULT " &
-                             "BELONGING TO THE BASE TYPE");
-                ELSE
-                     COMMENT ("BASE TYPE HAS RANGE LESS THAN 25");
-                END IF;
-      END;
- 
-      RESULT;
- 
- END C45505A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45523a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45523a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45523a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45523a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C45523A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR FLOATING POINT TYPES, IF MACHINE_OVERFLOWS IS TRUE AND
- --     EITHER THE RESULT OF MULTIPLICATION LIES OUTSIDE THE RANGE OF THE
- --     BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY ZERO, THEN
- --     CONSTRAINT_ERROR IS RAISED.  THIS TESTS
- --     DIGITS 5.
- 
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     BCB 02/09/88  CREATED ORIGINAL TEST.
- --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- --     KAS 11/14/95  DELETED USAGE OF 'SAFE_LARGE
- --     KAS 11/30/95  GOT IT RIGHT THIS TIME
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45523A IS
- 
-      TYPE FLT IS DIGITS 5;
- 
-      F : FLT;
- 
-      FUNCTION IDENT_FLT(X : FLT) RETURN FLT IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN X;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT_FLT;
- 
-      FUNCTION EQUAL_FLT(ONE, TWO : FLT) RETURN BOOLEAN IS
-      BEGIN
-           RETURN ONE = TWO * FLT (IDENT_INT(1));
-      END EQUAL_FLT;
- 
- BEGIN
-      TEST ("C45523A", "FOR FLOATING POINT TYPES, IF MACHINE_" &
-                       "OVERFLOWS IS TRUE AND EITHER THE RESULT OF " &
-                       "MULTIPLICATION LIES OUTSIDE THE RANGE OF THE " &
-                       "BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY " &
-                       "ZERO, THEN CONSTRAINT_ERROR IS RAISED." &
-                       "THIS TESTS DIGITS 5");
- 
- 
-      IF FLT'MACHINE_OVERFLOWS THEN
-           BEGIN
-                F := (FLT'BASE'LAST) * IDENT_FLT (2.0);
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR MULTIPLICATION");
-                IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
-                     COMMENT ("DON'T OPTIMIZE F");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
-                              "MULTIPLICATION");
-                WHEN OTHERS =>
-                     FAILED ("AN EXCEPTION OTHER THAN " &
-                             "CONSTRAINT_ERROR WAS RAISED FOR " &
-                             "MULTIPLICATION");
-           END;
-           BEGIN
-                F := (FLT'LAST) / IDENT_FLT (0.0);
-                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR DIVISION BY ZERO");
-                IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
-                     COMMENT ("DON'T OPTIMIZE F");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
-                              "DIVISION BY ZERO");
-                WHEN OTHERS =>
-                     FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
-                             "WAS RAISED FOR DIVISION BY ZERO");
-           END;
-      ELSE
-           NOT_APPLICABLE ("THIS TEST IS NOT APPLICABLE DUE TO " &
-                           "MACHINE_OVERFLOWS BEING FALSE");
-      END IF;
- 
-      RESULT;
- END C45523A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- C45531A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531A IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531A", "MIXED FIXED POINT AND INTEGER ""*"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (0.125);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.125);                 -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A               : INTEGER   := 0;
-           B               : FX_2      := 0.0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_2 (DEL4 * FORTH + DEL1 );
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A               : FX_2      := 0.0;
-           B               : INTEGER   := 0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_2 (DEL4 * FORTH + DEL1 );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C45531B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531B IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL2            : CONSTANT := 2.0 * DEL1;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531B", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (DEL2 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (DEL2 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
-                A := FX_1 (DEL2 * (3 * FORTH + 1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_2    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (DEL4 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (DEL4 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- C45531C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531C IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531C", "MIXED FIXED POINT AND INTEGER ""*"" "
-                     &  "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (2.5);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_RNG1 := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_RNG1 (RNG1 * FORTH + 0.5);
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_RNG1 (RNG1 * FORTH + 0.5);
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C45531D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531D IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531D", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (FORTH + 1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- C45531E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531E IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531E", "MIXED FIXED POINT AND INTEGER ""*"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (0.125);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.125);                 -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A               : INTEGER   := 0;
-           B               : FX_2      := 0.0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_2 (DEL4 * FORTH + DEL1 );
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A               : FX_2      := 0.0;
-           B               : INTEGER   := 0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_2 (DEL4 * FORTH + DEL1 );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C45531F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531F IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL2            : CONSTANT := 2.0 * DEL1;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531F", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (DEL2 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (DEL2 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
-                A := FX_1 (DEL2 * (3 * FORTH + 1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_2    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (DEL4 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (DEL4 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- C45531G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531G IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531G", "MIXED FIXED POINT AND INTEGER ""*"" "
-                     &  "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (2.5);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_RNG1 := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_RNG1 (RNG1 * FORTH + 0.5);
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_RNG1 (RNG1 * FORTH + 0.5);
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C45531H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531H IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531H", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (FORTH + 1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- C45531I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531I IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531I", "MIXED FIXED POINT AND INTEGER ""*"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (0.125);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.125);                 -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A               : INTEGER   := 0;
-           B               : FX_2      := 0.0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_2 (DEL4 * FORTH + DEL1 );
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A               : FX_2      := 0.0;
-           B               : INTEGER   := 0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_2 (DEL4 * FORTH + DEL1 );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C45531J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45531J IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL2            : CONSTANT := 2.0 * DEL1;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531J", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (DEL2 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (DEL2 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
-                A := FX_1 (DEL2 * (3 * FORTH + 1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_2    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (DEL4 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (DEL4 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- C45531K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- 
- WITH REPORT;
- PROCEDURE C45531K IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531K", "MIXED FIXED POINT AND INTEGER ""*"" "
-                     &  "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (2.5);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_RNG1 := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_RNG1 (RNG1 * FORTH + 0.5);
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_RNG1 (RNG1 * FORTH + 0.5);
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,154 ****
- -- C45531L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- 
- WITH REPORT;
- PROCEDURE C45531L IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531L", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (FORTH + 1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531m.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531m.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531m.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531m.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,189 ****
- -- C45531M.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --     'TYPE FX_OP5' MUST BE REJECTED.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- 
- WITH REPORT;
- PROCEDURE C45531M IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-                                                         -- N/A => ERROR.
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531M", "MIXED FIXED POINT AND INTEGER ""*"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (0.125);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.125);                 -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A               : INTEGER   := 0;
-           B               : FX_2      := 0.0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_2 (DEL4 * FORTH + DEL1 );
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A               : FX_2      := 0.0;
-           B               : INTEGER   := 0;
-           RESULT_VALUE    : FX_2      := 0.0;
-           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
-           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE     :  FX_2
-                                       := FX_2 (DEL4 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
-                                       := FX_2 (DEL4 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_2 (DEL4 * FORTH + DEL1 );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531n.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531n.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531n.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531n.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- C45531N.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --     'TYPE FX_OP5' MUST BE REJECTED.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- 
- WITH REPORT;
- PROCEDURE C45531N IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      DEL2            : CONSTANT := 2.0 * DEL1;
-      DEL4            : CONSTANT := 4.0 * DEL1;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-                                                         -- N/A => ERROR.
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45531N", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR RANGE <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (DEL2 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (DEL2 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
-                A := FX_1 (DEL2 * (3 * FORTH + 1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_2    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (DEL4 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (DEL4 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531o.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531o.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531o.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531o.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,189 ****
- -- C45531O.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --     'TYPE FX_OP5' MUST BE REJECTED.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- WITH REPORT;
- PROCEDURE C45531O IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-                                                         -- N/A => ERROR.
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531O", "MIXED FIXED POINT AND INTEGER ""*"" "
-                     &  "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := 3;
-                B := FX_0P5 (2.5);               -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
-                B := 6;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
- 
- C:   DECLARE
-           A              : INTEGER := 0;
-           B              : FX_RNG1 := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
-                A := 3;
-                B := FX_RNG1 (RNG1 * FORTH + 0.5);
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
- 
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
-      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
- 
- D:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
-           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
-                A := FX_RNG1 (RNG1 * FORTH + 0.5);
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A * B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END D;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531p.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531p.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45531p.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45531p.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- C45531P.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
- --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --     'TYPE FX_OP5' MUST BE REJECTED.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- WITH REPORT;
- PROCEDURE C45531P IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-                                                         -- N/A => ERROR.
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45531P", "MIXED FIXED POINT AND INTEGER ""/"" "
-                      & "FOR DELTA <, =, > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
-                B := 5;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER "
-                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
- 
- B:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (FORTH + 1);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
-                     &  "NUMBER, RESULT NOT");
- 
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : INTEGER := 0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * FORTH );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
-                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
-                B := 3;
-           END IF;
- 
-           RESULT_VALUE := A / B;
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45531P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C45532A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532A IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45532A", "FIXED POINT OPERATOR ""*"" "
-                      & "FOR RANGE <, =, AND > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_2    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.25);                -- A MODEL NUMBER
-                B := FX_2   (0.50);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
-                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
-                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- C45532B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532B IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;            -- MUST BE EVEN & >= 6
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
-                                        0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
-                                        1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
-                                        2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45532B", "FIXED POINT OPERATOR ""/"" "
-                      & "FOR RANGE <, =, AND > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.125);               -- A MODEL NUMBER
-                B := FX_1   (0.25);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (2 * DEL1 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
-                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
-                             --                      / (6 * FORTH + 2);
-           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
-                             --                      / (6 * FORTH + 0);
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (DEL1 * HIGH_COUNT );
-      BEGIN
-           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
-                A := FX_1 (DEL1 * (2 * FORTH + 1));
-                B := FX_1 (DEL1 * (6 * FORTH + 1));
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- C45532C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532C IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532C", "FIXED POINT OPERATOR ""*"" "
-                      & "FOR DELTA <, =, AND > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-           HIGHEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
-                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
-                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
-                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- C45532D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532D IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 12;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532D", "FIXED POINT OPERATOR ""/"" "
-                      & "FOR DELTA <, =, AND > 1.0");
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
-                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (0.5 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
-                B := FX_1    (3.0);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 ( RNG1 - 3.0);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 ( RNG1 + 4.0);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
-                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- C45532E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532E IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45532E", "FIXED POINT OPERATOR ""*""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_2    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.25);                -- A MODEL NUMBER
-                B := FX_2   (0.50);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
-                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
-                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C45532F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532F IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;            -- MUST BE EVEN & >= 6
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
-                                       0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
-                                       1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
-                                       2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45532F", "FIXED POINT OPERATOR ""/""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.125);               -- A MODEL NUMBER
-                B := FX_1   (0.25);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (2 * DEL1 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
-                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
-                             --                      / (6 * FORTH + 2);
-           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
-                             --                      / (6 * FORTH + 0);
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (DEL1 * HIGH_COUNT );
-      BEGIN
-           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
-                A := FX_1 (DEL1 * (2 * FORTH + 1));
-                B := FX_1 (DEL1 * (6 * FORTH + 1));
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- C45532G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532G IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532G", "FIXED POINT OPERATOR ""*""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-           HIGHEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
-                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
-                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
-                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- C45532H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532H IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 16;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532H", "FIXED POINT OPERATOR ""/""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
-                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (0.5 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
-                B := FX_1    (3.0);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 ( RNG1 - 3.0);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 ( RNG1 + 4.0);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
-                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C45532I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- 
- WITH REPORT;
- PROCEDURE C45532I IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45532I", "FIXED POINT OPERATOR ""*""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_2    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.25);                -- A MODEL NUMBER
-                B := FX_2   (0.50);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
-                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
-                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C45532J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;
- PROCEDURE C45532J IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;            -- MUST BE EVEN & >= 6
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
-                                       0.5 - DEL1 * 1;
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
-                                       1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
-                                       2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45532J", "FIXED POINT OPERATOR ""/""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.125);               -- A MODEL NUMBER
-                B := FX_1   (0.25);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (2 * DEL1 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
-                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
-                             --                      / (6 * FORTH + 2);
-           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
-                             --                      / (6 * FORTH + 0);
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (DEL1 * HIGH_COUNT );
-      BEGIN
-           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
-                A := FX_1 (DEL1 * (2 * FORTH + 1));
-                B := FX_1 (DEL1 * (6 * FORTH + 1));
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- C45532K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- 
- WITH REPORT;
- PROCEDURE C45532K IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532K", "FIXED POINT OPERATOR ""*""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-           HIGHEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
-                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
-                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
-                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- C45532L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
- --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- 
- WITH REPORT;
- PROCEDURE C45532L IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 32;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532L", "FIXED POINT OPERATOR ""/""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
-                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (0.5 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
-                B := FX_1    (3.0);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 ( RNG1 - 3.0);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 ( RNG1 + 4.0);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
-                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532m.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532m.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532m.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532m.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- C45532M.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --     'TYPE FX_OP5' MUST BE REJECTED.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- WITH REPORT;
- PROCEDURE C45532M IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
-                                                         -- N/A => ERROR.
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
- 
- BEGIN TEST ("C45532M", "FIXED POINT OPERATOR ""*""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_2    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
-           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.25);                -- A MODEL NUMBER
-                B := FX_2   (0.50);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
-                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_2
-                                    := FX_2 (4 * DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_2
-                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
-                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532n.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532n.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532n.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532n.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- C45532N.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- -- IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --    'TYPE FX_OP5' MUST BE REJECTED.
- 
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- WITH REPORT;
- PROCEDURE C45532N IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;            -- MUST BE EVEN & >= 6
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
-      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
-                                       0.5 - DEL1 * 1; -- N/A => ERROR.
-      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
-                                       1.0 - DEL1 * 2; -- N/A => ERROR.
-      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
-                                       2.0 - DEL1 * 4; -- N/A => ERROR.
- 
- BEGIN TEST ("C45532N", "FIXED POINT OPERATOR ""/""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_2    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
-           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.125);               -- A MODEL NUMBER
-                B := FX_1   (0.25);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_2 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 (2 * DEL1 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
-                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
-                             --                      / (6 * FORTH + 2);
-           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
-                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
-                             --                      / (6 * FORTH + 0);
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (DEL1 * LOW_COUNT );
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (DEL1 * HIGH_COUNT );
-      BEGIN
-           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
-                A := FX_1 (DEL1 * (2 * FORTH + 1));
-                B := FX_1 (DEL1 * (6 * FORTH + 1));
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532o.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532o.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532o.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532o.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,161 ****
- -- C45532O.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --     'TYPE FX_OP5' MUST BE REJECTED.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- WITH REPORT;
- PROCEDURE C45532O IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      FORTH           : CONSTANT := FULL_SCALE / 4;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-                                                         -- N/A => ERROR.
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532O", "FIXED POINT OPERATOR ""*""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOWEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-           HIGHEST_ACCEPTABLE_VALUE
-                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
-                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
- 
- B:   DECLARE
-           A              : FX_0P5  := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_RNG1 := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
-           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
-                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_1    := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_RNG1    := 0.0;
-           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
-           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * LOW_COUNT);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
-                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
-                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_RNG1 (A * B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532p.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532p.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45532p.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45532p.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- C45532P.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --OBJECTIVE:
- --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
- --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
- --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
- --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
- --       EQUAL TO 0.5.
- --
- --     TEST CASES ARE:
- --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
- --
- --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
- --     WITH RANGE <, =, AND > THAN 1.0 AND
- --     WITH DELTA <, =, AND > THAN 1.0.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
- --     'MAX_MANTISSA OF 47 OR GREATER.
- 
- --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
- --     'TYPE FX_OP5' MUST BE REJECTED.
- 
- -- HISTORY:
- --     NTW 09/08/86 CREATED ORIGINAL TEST.
- --     RJW 11/05/86 REVISED COMMENTS.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
- 
- WITH REPORT;
- PROCEDURE C45532P IS
- 
-      USE REPORT;
- 
-      MIN_WORD_LENGTH : CONSTANT := 48;
-      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
-      A_THIRD         : CONSTANT := FULL_SCALE / 3;
-      RNG1            : CONSTANT := FULL_SCALE * 0.5;
-      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
-                                                         -- N/A => ERROR.
-      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
-      TYPE FX_RNG1 IS DELTA RNG1
-                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
- 
- BEGIN TEST ("C45532P", "FIXED POINT OPERATOR ""/""" );
- 
-      --------------------------------------------------
- 
-      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
- 
- A:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_0P5  := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
-           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
-                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
-           END IF;
-      END A;
- 
-      --------------------------------------------------
- 
-      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
- 
- B:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_0P5  := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
-                                    := FX_0P5 (0.5 * A_THIRD);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
-                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
-                B := FX_1    (3.0);                -- A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_0P5 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
-           END IF;
-      END B;
- 
-      --------------------------------------------------
- 
-      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
- 
- C:   DECLARE
-           A              : FX_RNG1 := 0.0;
-           B              : FX_1    := 0.0;
-           RESULT_VALUE   : FX_1    := 0.0;
-           LOWEST_ACCEPTABLE_VALUE  :  FX_1
-                                    := FX_1 ( RNG1 - 3.0);
-           HIGHEST_ACCEPTABLE_VALUE :  FX_1
-                                    := FX_1 ( RNG1 + 4.0);
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
-                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
-           END IF;
- 
-           RESULT_VALUE := FX_1 (A / B);
- 
-           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
-              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
-                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
-                     &  "WHEN USING NO MODEL NUMBERS");
-           END IF;
-      END C;
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- 
- END C45532P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45534b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45534b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45534b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45534b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C45534B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A
- --     FIXED POINT VALUE IS DIVIDED BY ZERO (EITHER AN INTEGER ZERO OR
- --     A FIXED POINT ZERO).
- 
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     BCB 07/14/88  CREATED ORIGINAL TEST.
- --     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X CONSISTENCY
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45534B IS
- 
-      TYPE FIX IS DELTA 2.0**(-1) RANGE -2.0 .. 2.0;
-      TYPE FIX2 IS DELTA 2.0**(-1) RANGE -3.0 .. 3.0;
- 
-      A : FIX := 1.0;
-      B : FIX;
-      ZERO : FIX := 0.0;
-      ZERO2 : FIX2 := 0.0;
- 
-      FUNCTION IDENT_FLT (ONE, TWO : FIX) RETURN BOOLEAN IS
-      BEGIN
-           RETURN ONE = FIX (TWO * FIX (IDENT_INT(1)));
-      END IDENT_FLT;
- 
- BEGIN
-      TEST ("C45534B", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                       "A FIXED POINT VALUE IS " &
-                       "DIVIDED BY ZERO (EITHER AN INTEGER ZERO OR A " &
-                       "FIXED POINT ZERO)");
- 
-      BEGIN
-           B := A / IDENT_INT (0);
-           FAILED ("NO EXCEPTION RAISED FOR DIVISION BY INTEGER ZERO");
-           IF IDENT_FLT (B,B) THEN
-                COMMENT ("DON'T OPTIMIZE B");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-      END;
- 
-      BEGIN
-           B := FIX (A / ZERO);
-           FAILED ("NO EXCEPTION RAISED FOR DIVISION BY FIXED POINT " &
-                   "ZERO - 1");
-           IF IDENT_FLT (B,B) THEN
-                COMMENT ("DON'T OPTIMIZE B");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-       END;
- 
-      BEGIN
-           B := FIX (A / ZERO2);
-           FAILED ("NO EXCEPTION RAISED FOR DIVISION BY FIXED POINT " &
-                   "ZERO - 2");
-           IF IDENT_FLT (B,B) THEN
-                COMMENT ("DON'T OPTIMIZE B");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-       END;
- 
-      RESULT;
- END C45534B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45536a.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45536a.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45536a.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45536a.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C45536A.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK FIXED POINT MULTIPLICATION AND DIVISION WHEN 'SMALL OF
- --     THE OPERANDS ARE NOT BOTH POWERS OF THE SAME BASE VALUE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     REPRESENTATION CLAUSES FOR 'SMALL WHICH ARE NOT POWERS OF TWO.
- 
- --     IF SUCH REPRESENTATION CLAUSES ARE NOT SUPPORTED, THEN THE
- --     REPRESENTATION CLAUSE FOR CHECK_TYPE MUST BE REJECTED.
- 
- -- HISTORY:
- --     BCB 02/02/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45536A IS
- 
-      TYPE CHECK_TYPE IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
-      FOR CHECK_TYPE'SMALL USE 0.2;                     -- N/A => ERROR.
- 
-      TYPE F1 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
-      FOR F1'SMALL USE 0.5;
- 
-      TYPE F2 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
-      FOR F2'SMALL USE 0.2;
- 
-      TYPE F3 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
-      FOR F3'SMALL USE 0.1;
- 
-      A : F1;
-      B : F2;
-      C : F3;
- 
-      FUNCTION IDENT_FIX(X : F3) RETURN F3 IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN X;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT_FIX;
- 
- BEGIN
-      TEST ("C45536A", "CHECK FIXED POINT MULTIPLICATION AND DIVISION " &
-                       "WHEN 'SMALL OF THE OPERANDS ARE NOT BOTH " &
-                       "POWERS OF THE SAME BASE VALUE");
- 
-      A := 1.0; B := 1.0; C := F3(A * B);
- 
-      IF C /= IDENT_FIX(1.0) THEN
-           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 1");
-      END IF;
- 
-      C := F3(A / B);
- 
-      IF C /= IDENT_FIX(1.0) THEN
-           FAILED ("IMPROPER RESULTS FOR DIVISION - 1");
-      END IF;
- 
-      A := 1.0; B := 0.3; C := F3(A * B);
- 
-      IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
-           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 2");
-      END IF;
- 
-      B := 0.25; C := F3(A / B);
- 
-      IF C NOT IN IDENT_FIX(2.5) .. IDENT_FIX(5.0) THEN
-           FAILED ("IMPROPER RESULTS FOR DIVISION - 2");
-      END IF;
- 
-      A := 0.5; B := 0.3; C := F3(A * B);
- 
-      IF C NOT IN IDENT_FIX(0.1) .. IDENT_FIX(0.2) THEN
-           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 3");
-      END IF;
- 
-      C := F3(A / B);
- 
-      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
-           FAILED ("IMPROPER RESULTS FOR DIVISION - 3");
-      END IF;
- 
-      B := 0.3; C := 0.2; A := F1(B * C);
- 
-      IF A NOT IN F1(IDENT_FIX(0.0)) .. F1(IDENT_FIX(0.5)) THEN
-           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 4");
-      END IF;
- 
-      A := 1.0; B := 1.6; C := F3(A / B);
- 
-      IF C NOT IN IDENT_FIX(0.6) .. IDENT_FIX(0.7) THEN
-           FAILED ("IMPROPER RESULTS FOR DIVISION - 4");
-      END IF;
- 
-      A := 0.75; B := 0.4; C := F3(A * B);
- 
-      IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
-           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 5");
-      END IF;
- 
-      A := 0.8; C := F3(A / B);
- 
-      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
-           FAILED ("IMPROPER RESULTS FOR DIVISION - 5");
-      END IF;
- 
-      A := 0.8; B := 0.4; C := F3(A * B);
- 
-      IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
-           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 6");
-      END IF;
- 
-      A := 0.75; C := F3(A / B);
- 
-      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
-           FAILED ("IMPROPER RESULTS FOR DIVISION - 6");
-      END IF;
- 
-      A := 0.7; B := 0.3; C := F3(A * B);
- 
-      IF C NOT IN IDENT_FIX(0.1) .. IDENT_FIX(0.4) THEN
-           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 7");
-      END IF;
- 
-      C := F3(A / B);
- 
-      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(5.0) THEN
-           FAILED ("IMPROPER RESULTS FOR DIVISION - 7");
-      END IF;
- 
-      RESULT;
- END C45536A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c456001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c456001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c456001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c456001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C456001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --
- --                                     Notice
- --
- --    The ACAA has created and maintains the Ada Conformity Assessment Test
- --    Suite for the purpose of conformity assessments conducted in accordance
- --    with the International Standard ISO/IEC 18009 - Ada: Conformity
- --    assessment of a language processor. This test suite should not be used
- --    to make claims of conformance unless used in accordance with
- --    ISO/IEC 18009 and any applicable ACAA procedures.
- --
- --*
- -- OBJECTIVE:
- --     For exponentiation of floating point types, check that
- --       Constraint_Error is raised (or, if no exception is raised and
- --       Machine_Overflows is False, that a result is produced) if the
- --       result is outside of the range of the base type.
- --     This tests digits 5.
- 
- -- HISTORY:
- --     04/30/03  RLB  Created test from old C45622A and C45624A.
- 
- with Report;
- 
- procedure C456001 is
- 
-      type Flt is digits 5;
- 
-      F : Flt;
- 
-      function Equal_Flt (One, Two : Flt) return Boolean is
-          -- Break optimization.
-      begin
-           return One = Two * Flt (Report.Ident_Int(1));
-      end Equal_Flt;
- 
- begin
-      Report.Test ("C456001", "For exponentiation of floating point types, " &
-                       "check that Constraint_Error is raised (or, if " &
-                       "if no exception is raised and Machine_Overflows is " &
-                       "False, that a result is produced) if the result is " &
-                       "outside of the range of the base type.");
- 
-      begin
-          F := (Flt'Base'Last)**Report.Ident_Int (2);
-          if Flt'Machine_Overflows Then
-              Report.Failed ("Constraint_Error was not raised for " &
-                        "exponentiation");
-          else
-              -- RM95 3.5.6(7) allows disobeying RM95 4.5(10) if
-              -- Machine_Overflows is False.
-              Report.Comment ("Constraint_Error was not raised for " &
-                        "exponentiation and Machine_Overflows is False");
-          end if;
-          if not Equal_Flt (F, F) then
-              -- Optimization breaker, F must be evaluated.
-              Report.Comment ("Don't optimize F");
-          end if;
-      exception
-          when Constraint_Error =>
-              Report.Comment ("Constraint_Error was raised for " &
-                              "exponentiation");
-          when others =>
-              Report.Failed ("An exception other than Constraint_Error " &
-                             "was raised for exponentiation");
-      end;
- 
-      Report.Result;
- end C456001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45611a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45611a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45611a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45611a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- --  C45611A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  CHECK THAT EXPONENTIATION OF AN INTEGER TO AN INTEGER VALUE IS 
- --  CORRECTLY EVALUATED.
- 
- --  H. TILTON 9/23/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45611A IS
- 
-     I1,INT : INTEGER;
-    
-     BEGIN
- 
-  
-          TEST ("C45611A", "CHECK THAT EXPONENTIATION OF AN INTEGER " &
-                           "VALUE IS CORRECTLY EVALUATED");
- 
-          I1 := IDENT_INT(0) ** IDENT_INT(0);
- 
-          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '0**0'" ); 
-          END IF;
- 
-          INT := "**" (IDENT_INT(0),IDENT_INT(1));
- 
-          IF IDENT_INT(INT) /= IDENT_INT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**1'" ); 
-          END IF;
- 
-          I1 := IDENT_INT(6) ** IDENT_INT(0);
- 
-          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '6**0'" ); 
-          END IF;
- 
-          INT := IDENT_INT(156) ** IDENT_INT(1);
- 
-          IF IDENT_INT(INT) /= IDENT_INT(156) THEN
-               FAILED( "INCORRECT RESULT FOR '156**1'" ); 
-          END IF;
- 
-          I1 := IDENT_INT(-3) ** IDENT_INT(0);
- 
-          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-3)**0'" ); 
-          END IF;
- 
-          INT := "**" (IDENT_INT(-7),IDENT_INT(1));
- 
-          IF IDENT_INT(INT) /= IDENT_INT(-7) THEN
-               FAILED( "INCORRECT RESULT FOR '(-7)**1'" ); 
-          END IF;
- 
-          I1 := "**" (IDENT_INT(-1),IDENT_INT(2));
- 
-          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
-          END IF;
-   
-   
-          INT := IDENT_INT(-1) ** 3;         
- 
-          IF IDENT_INT(INT) /= IDENT_INT(-1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
-          END IF;
-   
-          INT := "**" (IDENT_INT(0),IDENT_INT(2));
- 
-          IF IDENT_INT(INT) /= IDENT_INT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**2'" );
-          END IF;
- 
-          INT := IDENT_INT(0) ** IDENT_INT(10);
- 
-          IF IDENT_INT(INT) /= IDENT_INT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**10'" );
-          END IF;
-   
-          INT := "**" (IDENT_INT(6),IDENT_INT(2));
- 
-          IF IDENT_INT(INT) /= IDENT_INT(36) THEN
-               FAILED( "INCORRECT RESULT FOR '6**2'" );
-          END IF;
-   
-          INT := "**" (IDENT_INT(2),IDENT_INT(2));
- 
-          IF IDENT_INT(INT) /= IDENT_INT(4) THEN
-               FAILED( "INCORRECT RESULT FOR '2**2'" );
-          END IF;
- 
-          I1 := "**" (IDENT_INT(1),IDENT_INT(10));
- 
-          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '1**10'" );
-          END IF;
-         
-          RESULT;
- 
-     END C45611A;      
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45611b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45611b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45611b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45611b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- --  C45611B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EXPONENTIATION OF A SHORT_INTEGER TO AN INTEGER VALUE
- --     IS CORRECTLY EVALUATED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     HTG 09/23/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45611B IS
- 
-     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
- 
-     I1,INT : SHORT_INTEGER;
- 
-     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-     BEGIN
-          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
-     END IDENT;
- 
-     BEGIN
- 
- 
-          TEST ("C45611B", "CHECK THAT EXPONENTIATION OF A " &
-                           "SHORT_INTEGER VALUE IS CORRECTLY " &
-                           "EVALUATED");
- 
-          I1 := IDENT(0) ** IDENT_INT(0);
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '0**0'" );
-          END IF;
- 
-          INT := "**" (IDENT(0),IDENT_INT(1));
- 
-          IF IDENT(INT) /= IDENT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**1'" );
-          END IF;
- 
-          I1 := IDENT(6) ** IDENT_INT(0);
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '6**0'" );
-          END IF;
- 
-          INT := IDENT(15) ** IDENT_INT(1);
- 
-          IF IDENT(INT) /= IDENT(15) THEN
-               FAILED( "INCORRECT RESULT FOR '15**1'" );
-          END IF;
- 
-          I1 := IDENT(-3) ** IDENT_INT(0);
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-3)**0'" );
-          END IF;
- 
-          INT := "**" (IDENT(-7),IDENT_INT(1));
- 
-          IF IDENT(INT) /= IDENT(-7) THEN
-               FAILED( "INCORRECT RESULT FOR '(-7)**1'" );
-          END IF;
- 
-          I1 := "**" (IDENT(-1),IDENT_INT(2));
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
-          END IF;
- 
- 
-          INT := IDENT(-1) ** IDENT_INT(3);
- 
-          IF IDENT(INT) /= IDENT(-1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
-          END IF;
- 
-          INT := "**" (IDENT(0),IDENT_INT(2));
- 
-          IF IDENT(INT) /= IDENT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**2'" );
-          END IF;
- 
-          INT := IDENT(0) ** IDENT_INT(10);
- 
-          IF IDENT(INT) /= IDENT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**10'" );
-          END IF;
- 
-          INT := "**" (IDENT(6),IDENT_INT(2));
- 
-          IF IDENT(INT) /= IDENT(36) THEN
-               FAILED( "INCORRECT RESULT FOR '6**2'" );
-          END IF;
- 
-          INT := "**" (IDENT(2),IDENT_INT(2));
- 
-          IF IDENT(INT) /= IDENT(4) THEN
-               FAILED( "INCORRECT RESULT FOR '2**2'" );
-          END IF;
- 
-          I1 := "**" (IDENT(1),IDENT_INT(10));
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '1**10'" );
-          END IF;
- 
-          RESULT;
- 
-     END C45611B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45611c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45611c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45611c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45611c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- --  C45611C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EXPONENTIATION OF A LONG_INTEGER TO AN INTEGER VALUE
- --     IS CORRECTLY EVALUATED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     LONG_INTEGER.
- 
- --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_LONG" MUST BE REJECTED.
- 
- -- HISTORY:
- --     HTG 09/23/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45611C IS
- 
-     CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
- 
-     I1,INT : LONG_INTEGER;
- 
-     FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
-     BEGIN
-          RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
-     END IDENT;
- 
-     BEGIN
- 
- 
-          TEST ("C45611C", "CHECK THAT EXPONENTIATION OF A " &
-                           "LONG_INTEGER VALUE IS CORRECTLY " &
-                           "EVALUATED");
- 
-          I1 := IDENT(0) ** IDENT_INT(0);
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '0**0'" );
-          END IF;
- 
-          INT := "**" (IDENT(0),IDENT_INT(1));
- 
-          IF IDENT(INT) /= IDENT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**1'" );
-          END IF;
- 
-          I1 := IDENT(6) ** IDENT_INT(0);
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '6**0'" );
-          END IF;
- 
-          INT := IDENT(156) ** IDENT_INT(1);
- 
-          IF IDENT(INT) /= IDENT(156) THEN
-               FAILED( "INCORRECT RESULT FOR '156**1'" );
-          END IF;
- 
-          I1 := IDENT(-3) ** IDENT_INT(0);
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-3)**0'" );
-          END IF;
- 
-          INT := "**" (IDENT(-7),IDENT_INT(1));
- 
-          IF IDENT(INT) /= IDENT(-7) THEN
-               FAILED( "INCORRECT RESULT FOR '(-7)**1'" );
-          END IF;
- 
-          I1 := "**" (IDENT(-1),IDENT_INT(2));
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
-          END IF;
- 
- 
-          INT := IDENT(-1) ** IDENT_INT(3);
- 
-          IF IDENT(INT) /= IDENT(-1) THEN
-               FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
-          END IF;
- 
-          INT := "**" (IDENT(0),IDENT_INT(2));
- 
-          IF IDENT(INT) /= IDENT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**2'" );
-          END IF;
- 
-          INT := IDENT(0) ** IDENT_INT(10);
- 
-          IF IDENT(INT) /= IDENT(0) THEN
-               FAILED( "INCORRECT RESULT FOR '0**10'" );
-          END IF;
- 
-          INT := "**" (IDENT(6),IDENT_INT(2));
- 
-          IF IDENT(INT) /= IDENT(36) THEN
-               FAILED( "INCORRECT RESULT FOR '6**2'" );
-          END IF;
- 
-          INT := "**" (IDENT(2),IDENT_INT(2));
- 
-          IF IDENT(INT) /= IDENT(4) THEN
-               FAILED( "INCORRECT RESULT FOR '2**2'" );
-          END IF;
- 
-          I1 := "**" (IDENT(1),IDENT_INT(10));
- 
-          IF IDENT(I1) /= IDENT(1) THEN
-               FAILED( "INCORRECT RESULT FOR '1**10'" );
-          END IF;
- 
-          RESULT;
- 
-     END C45611C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45613a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45613a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45613a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45613a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C45613A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED
- -- BY "**" FOR INTEGERS WHEN THE RESULT EXCEEDS THE RANGE 
- -- OF THE BASE TYPE.
- 
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- H. TILTON 10/06/86
- --      MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45613A IS
-  
- BEGIN
-      TEST ("C45613A","CHECK THAT CONSTRAINT_ERROR " &
-                      "IS RAISED BY ""**"" FOR INTEGERS WHEN THE " &
-                      "RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
- 
-      DECLARE
-           INT : INTEGER;
-      BEGIN
-           INT := IDENT_INT(INTEGER'LAST ** IDENT_INT(2));
-           FAILED ("NO EXCEPTION FOR SECOND POWER OF INTEGER'LAST");
-              
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS => 
-                     FAILED ("WRONG EXCEPTION RAISED FOR " &
-                             "SECOND POWER OF " &
-                             "INTEGER'LAST");
-      END;
- 
-      DECLARE
-           INT : INTEGER;
-      BEGIN
-           INT := IDENT_INT(INTEGER'FIRST ** IDENT_INT(3));
-           FAILED ("NO EXCEPTION FOR THIRD POWER OF INTEGER'FIRST");
-                
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR " &
-                             "THIRD POWER OF " &
-                             "INTEGER'FIRST");
-             
-      END;
- 
-      RESULT;
-    
- END C45613A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45613b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45613b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45613b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45613b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C45613B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED
- --     BY "**" FOR SHORT_INTEGER WHEN THE RESULT EXCEEDS THE RANGE
- --     OF THE BASE TYPE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     HTG 10/06/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45613B IS
- 
-     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
- 
-     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-     BEGIN
-          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
-     END IDENT;
- 
- BEGIN
-      TEST ("C45613B","CHECK THAT CONSTRAINT_ERROR " &
-                      "IS RAISED BY ""**"" FOR SHORT_INTEGER WHEN " &
-                      "THE RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
- 
-      DECLARE
-           INT : SHORT_INTEGER;
-      BEGIN
-           INT := IDENT(SHORT_INTEGER'LAST ** IDENT_INT(2));
-                  FAILED ("NO EXCEPTION FOR SECOND POWER OF " &
-                          "SHORT_INTEGER'LAST");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR " &
-                             "SECOND POWER OF " &
-                             "SHORT_INTEGER'LAST");
-      END;
- 
-      DECLARE
-           INT : SHORT_INTEGER;
-      BEGIN
-           INT := IDENT(SHORT_INTEGER'FIRST ** IDENT_INT(3));
-           FAILED ("NO EXCEPTION FOR THIRD POWER OF " &
-                   "SHORT_INTEGER'FIRST");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR " &
-                             "THIRD POWER OF " &
-                             "SHORT_INTEGER'FIRST");
- 
-      END;
- 
-      RESULT;
- 
- END C45613B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45613c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45613c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45613c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45613c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C45613C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED
- --     BY "**" FOR LONG_INTEGER WHEN THE RESULT EXCEEDS THE RANGE
- --     OF THE BASE TYPE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     LONG_INTEGER.
- 
- --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_LONG" MUST BE REJECTED.
- 
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     HTG 10/06/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- --     MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45613C IS
- 
-      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
- 
-      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
-      END IDENT;
- 
- BEGIN
-      TEST ("C45613C","CHECK THAT CONSTRAINT_ERROR " &
-                      "IS RAISED BY ""**"" FOR LONG_INTEGER WHEN " &
-                      "THE RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
- 
-      DECLARE
-           INT : LONG_INTEGER;
-      BEGIN
-           INT := IDENT(LONG_INTEGER'LAST ** IDENT_INT(2));
-           FAILED ("NO EXCEPTION FOR SECOND POWER OF " &
-                   "LONG_INTEGER'LAST");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR " &
-                             "SECOND POWER OF " &
-                             "LONG_INTEGER'LAST");
-      END;
- 
-      DECLARE
-           INT : LONG_INTEGER;
-      BEGIN
-           INT := IDENT(LONG_INTEGER'FIRST ** IDENT_INT(3));
-                  FAILED ("NO EXCEPTION FOR THIRD POWER OF " &
-                          "LONG_INTEGER'FIRST");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR " &
-                             "THIRD POWER OF " &
-                             "LONG_INTEGER'FIRST");
- 
-      END;
- 
-      RESULT;
- 
- END C45613C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45614a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45614a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45614a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45614a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C45614A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE EXPONENT VALUE IN 
- -- AN INTEGER EXPONENTIATION IS NEGATIVE.
- -- CHECK BOTH STATIC AND NONSTATIC EXPONENT VALUES.
- 
- -- AH  9/29/86
- -- EDS 7/15/98    AVOID OPTIMIZATION
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45614A IS
-      INT : INTEGER :=1;
-      RES : INTEGER :=0;
- BEGIN
-      TEST ("C45614A", "CONSTRAINT_ERROR IS RAISED FOR INTEGERS " & 
-                       "HAVING A NEGATIVE EXPONENT");
- 
-      DECLARE
-           E1 : CONSTANT INTEGER := -5;
-      BEGIN
-           RES := INT ** E1;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - E1A " &
-                    INTEGER'IMAGE(RES));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - E1B");
-      END;
- 
-      DECLARE
-           E2 : INTEGER := 5;
-      BEGIN
-           RES := INT ** (-E2);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - E2A " &
-                   INTEGER'IMAGE(RES));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - E2B");
-      END;
- 
-      DECLARE
-           E3 : INTEGER;
-      BEGIN
-           E3 := IDENT_INT(-5);
-           RES := INT ** E3;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - E3A " &
-                   INTEGER'IMAGE(RES));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - E3B");
-      END;
- 
-      DECLARE
-      BEGIN
-           RES := INT ** IDENT_INT(-5);
-           FAILED ("CONSTRAINT_ERROR NOT RAISED - E4A " &
-                   INTEGER'IMAGE(RES));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - E4B");
-      END;
- 
-      RES := IDENT_INT(2);
-      RES := IDENT_INT(RES);
-      RESULT;
- END C45614A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45614b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45614b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45614b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45614b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- --  C45614B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY PREDEFINED SHORT_INTEGER
- --     "**" IF THE SECOND OPERAND HAS A NEGATIVE VALUE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     HTG 10/07/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45614B IS
- 
-      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
- 
-      FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST ("C45614B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
-                       "PREDEFINED SHORT_INTEGER ""**"" IF THE " &
-                       "SECOND OPERAND HAS A NEGATIVE VALUE");
- 
-      DECLARE
-           A : INTEGER := -2;
-           B : SHORT_INTEGER := 3;
-           INT : SHORT_INTEGER := 0;
-      BEGIN
-           INT := IDENT(B ** IDENT_INT(A));
-           FAILED ("NO EXCEPTION FOR '3**(-2)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '3**(-2)'");
-      END;
- 
-      DECLARE
-           A : INTEGER := -3;
-           B : SHORT_INTEGER := -5;
-           INT : SHORT_INTEGER := 0;
-      BEGIN
-           INT := IDENT(B ** IDENT_INT(A));
-           FAILED ("NO EXCEPTION FOR '(-5)**(-3)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '(-5)**(-3)'");
-      END;
- 
-      DECLARE
-           B : SHORT_INTEGER := 0;
-           INT : SHORT_INTEGER := 0;
-      BEGIN
-           INT := IDENT(B ** IDENT_INT(-3));
-           FAILED ("NO EXCEPTION FOR '0**(-3)");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '0**(-3)'");
-      END;
- 
-      DECLARE
-           INT : SHORT_INTEGER := 0;
-      BEGIN
-           INT := IDENT(-10 ** IDENT_INT(-2));
-           FAILED ("NO EXCEPTION FOR '(-10)**(-2)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '(-10)**(-2)'");
-      END;
- 
-      DECLARE
-           INT : SHORT_INTEGER := 0;
-      BEGIN
-           INT := IDENT(6 ** IDENT_INT(-4));
-           FAILED ("NO EXCEPTION FOR '6**(-4)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '6**(-4)'");
-      END;
- 
-      RESULT;
- 
- END C45614B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45614c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45614c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45614c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45614c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C45614C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY PREDEFINED
- --     LONG_INTEGER "**" IF THE SECOND OPERAND HAS A NEGATIVE
- --     VALUE.
- 
- -- APPLICABILITY CRITERIA:
- --     IN ORDER FOR THIS TEST TO BE NOT-APPLICABLE THE COMPILER
- --     MUST REJECT THE USE OF "LONG_INTEGER" AS AN UNDECLARED
- --     IDENTIFIER.
- 
- -- HISTORY:
- --     HT  10/07/86  CREATED ORIGINAL TEST.
- --     JET 08/06/87  REMOVED BUG FROM FUNCTION IDENT (X).
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45614C IS
- 
-      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST ("C45614C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
-                       "PREDEFINED LONG_INTEGER ""**"" IF THE SECOND " &
-                       "OPERAND HAS A NEGATIVE VALUE");
- 
-      DECLARE
-           A : INTEGER := -2;
-           B : LONG_INTEGER := 3;
-           INT : LONG_INTEGER := 0;
-      BEGIN
-           INT := IDENT(B ** IDENT_INT(A));
-           FAILED ("NO EXCEPTION FOR '3**(-2)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '3**(-2)'");
-      END;
- 
-      DECLARE
-           A : INTEGER := -3;
-           B : LONG_INTEGER := -5;
-           INT : LONG_INTEGER := 0;
-      BEGIN
-           INT := IDENT(B ** IDENT_INT(A));
-           FAILED ("NO EXCEPTION FOR '(-5)**(-3)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '(-5)**(-3)'");
-      END;
- 
-      DECLARE
-           B : LONG_INTEGER := 0;
-           INT : LONG_INTEGER := 0;
-      BEGIN
-           INT := IDENT(B ** IDENT_INT(-3));
-           FAILED ("NO EXCEPTION FOR '0**(-3)");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '0**(-3)'");
-      END;
- 
-      DECLARE
-           INT : LONG_INTEGER := 0;
-      BEGIN
-           INT := IDENT(-10 ** IDENT_INT(-2));
-           FAILED ("NO EXCEPTION FOR '(-10)**(-2)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '(-10)**(-2)'");
-      END;
- 
-      DECLARE
-           INT : LONG_INTEGER := 0;
-      BEGIN
-           INT := IDENT(6 ** IDENT_INT(-4));
-           FAILED ("NO EXCEPTION FOR '6**(-4)'");
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR '6**(-4)'");
-      END;
- 
-      RESULT;
- 
- END C45614C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45631a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45631a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45631a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45631a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C45631A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR TYPE INTEGER 'ABS A' EQUALS A IF A IS POSITIVE AND 
- -- EQUALS -A IF A IS NEGATIVE.
- 
- -- RJW 2/10/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45631A IS
-      
- BEGIN
- 
-      TEST ( "C45631A", "CHECK THAT FOR TYPE INTEGER 'ABS A' " &
-                        "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " & 
-                        "A IS NEGATIVE" );
- 
-      DECLARE 
-      
-           P : INTEGER := IDENT_INT (1);
-           N : INTEGER := IDENT_INT (-1);
-           Z : INTEGER := IDENT_INT (0);
-      BEGIN 
- 
-           IF ABS P = P THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR P - 1" );
-           END IF;
- 
-           IF ABS N = -N THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR N - 1" );
-           END IF;
- 
-           IF ABS Z = Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS TEST FOR Z - 1" );
-           END IF;
- 
-           IF ABS (Z) = -Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS TEST FOR Z - 2");
-           END IF;
- 
-           IF "ABS" (RIGHT => P) = P THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR P - 2" );
-           END IF;
- 
-           IF "ABS" (N) = -N THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR N - 2 " );
-           END IF;
- 
-           IF "ABS" (Z) = Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR Z - 3" );
-           END IF;
-          
-           IF ABS (IDENT_INT (-INTEGER'LAST)) = INTEGER'LAST THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR -INTEGER'LAST" );
-           END IF;
-      END; 
- 
-      RESULT;
- 
- END C45631A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45631b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45631b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45631b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45631b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C45631B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR TYPE SHORT_INTEGER 'ABS A' EQUALS A IF A IS
- --     POSITIVE AND EQUALS -A IF A IS NEGATIVE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     SHORT_INTEGER.
- 
- --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_SHORT" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 02/26/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45631B IS
- 
-      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
- 
-      FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST ( "C45631B", "CHECK THAT FOR TYPE SHORT_INTEGER 'ABS A' " &
-                        "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " &
-                        "A IS NEGATIVE" );
- 
-      DECLARE
- 
-           P : SHORT_INTEGER := IDENT (1);
-           N : SHORT_INTEGER := IDENT (-1);
-           Z : SHORT_INTEGER := IDENT (0);
-      BEGIN
- 
-           IF ABS P = P THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR P - 1" );
-           END IF;
- 
-           IF ABS N = -N THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR N - 1" );
-           END IF;
- 
-           IF ABS Z = Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS TEST FOR Z - 1" );
-           END IF;
- 
-           IF ABS (Z) = -Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS TEST FOR Z - 2");
-           END IF;
- 
-           IF "ABS" (RIGHT => P) = P THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR P - 2" );
-           END IF;
- 
-           IF "ABS" (N) = -N THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR N - 2 " );
-           END IF;
- 
-           IF "ABS" (Z) = Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR Z - 3" );
-           END IF;
- 
-           IF ABS (IDENT (-SHORT_INTEGER'LAST)) = SHORT_INTEGER'LAST
-              THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR -SHORT_INTEGER'LAST" );
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C45631B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45631c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45631c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45631c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45631c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- C45631C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR TYPE LONG_INTEGER 'ABS A' EQUALS A IF A IS
- --     POSITIVE AND EQUALS -A IF A IS NEGATIVE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
- --     LONG_INTEGER.
- 
- --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
- --     "CHECK_LONG" MUST BE REJECTED.
- 
- -- HISTORY:
- --     RJW 02/26/86 CREATED ORIGINAL TEST.
- --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45631C IS
- 
-      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
- 
-      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           IF X >= LONG_INTEGER (INTEGER'FIRST) AND
-              X <= LONG_INTEGER (INTEGER'LAST) THEN
-                RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
-           ELSIF EQUAL (3, 3) THEN
-                RETURN X;
-           END IF;
-           RETURN 0;
-      END IDENT;
- 
- BEGIN
- 
-      TEST ( "C45631C", "CHECK THAT FOR TYPE LONG_INTEGER 'ABS A' " &
-                        "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " &
-                        "A IS NEGATIVE" );
- 
-      DECLARE
- 
-           P : LONG_INTEGER := IDENT (1);
-           N : LONG_INTEGER := IDENT (-1);
-           Z : LONG_INTEGER := IDENT (0);
-      BEGIN
- 
-           IF ABS P = P THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR P - 1" );
-           END IF;
- 
-           IF ABS N = -N THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR N - 1" );
-           END IF;
- 
-           IF ABS Z = Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS TEST FOR Z - 1" );
-           END IF;
- 
-           IF ABS (Z) = -Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS TEST FOR Z - 2");
-           END IF;
- 
-           IF "ABS" (RIGHT => P) = P THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR P - 2" );
-           END IF;
- 
-           IF "ABS" (N) = -N THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR N - 2 " );
-           END IF;
- 
-           IF "ABS" (Z) = Z THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR Z - 3" );
-           END IF;
- 
-           IF ABS (IDENT (-LONG_INTEGER'LAST)) = LONG_INTEGER'LAST
-              THEN
-                NULL;
-           ELSE
-                FAILED ( "'ABS' TEST FOR -LONG_INTEGER'LAST" );
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C45631C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45632a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45632a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45632a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45632a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- C45632A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR PREDEFINED TYPE INTEGER, CONSTRAINT_ERROR
- --     IS RAISED FOR ABS (INTEGER'FIRST) IF
- --     -INTEGER'LAST > INTEGER'FIRST.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     RJW 02/10/86  CREATED ORIGINAL TEST.
- --     JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
- --                   PREVENT OPTIMIZATION.
- --     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45632A IS
- 
-      I : INTEGER := IDENT_INT (INTEGER'FIRST);
- 
- BEGIN
- 
-      TEST ( "C45632A", "CHECK THAT FOR PREDEFINED TYPE INTEGER " &
-                        "CONSTRAINT_ERROR IS RAISED " &
-                        "FOR ABS (INTEGER'FIRST) IF -INTEGER'LAST > " &
-                        "INTEGER'FIRST" );
- 
-      BEGIN
-           IF - INTEGER'LAST > INTEGER'FIRST THEN
-                BEGIN
-                     IF EQUAL (ABS I, I) THEN
-                          NULL;
-                     ELSE
-                          FAILED ( "WRONG RESULT FOR ABS" );
-                     END IF;
-                     FAILED ( "EXCEPTION NOT RAISED" );
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          COMMENT ( "CONSTRAINT_ERROR RAISED" );
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED" );
-                END;
-           ELSE
-                COMMENT ( "-INTEGER'LAST <= INTEGER'FIRST" );
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C45632A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45632b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45632b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45632b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45632b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C45632B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR PREDEFINED TYPE SHORT_INTEGER,
- --     CONSTRAINT_ERROR IS RAISED FOR ABS (SHORT_INTEGER'FIRST)
- --     IF -SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --     THE PREDEFINED TYPE "SHORT_INTEGER".
- 
- --     IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF THE
- --     VARIABLE "TEST_VAR" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     RJW 02/20/86  CREATED ORIGINAL TEST.
- --     JET 12/30/87  UPDATED HEADER FORMAT, ADDED CODE TO DEFEAT
- --                   OPTIMIZATION.
- --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45632B IS
- 
-      TEST_VAR : SHORT_INTEGER;               -- N/A => ERROR.
-      I : SHORT_INTEGER;
- 
-      FUNCTION IDENT_SHORT (A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN A;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT_SHORT;
- 
- BEGIN
- 
-      TEST ( "C45632B", "CHECK THAT FOR PREDEFINED TYPE " &
-                        "SHORT_INTEGER CONSTRAINT_ERROR IS RAISED FOR " &
-                        "ABS (SHORT_INTEGER'FIRST) IF " &
-                        "-SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST");
- 
-      BEGIN
-           I := IDENT_SHORT (SHORT_INTEGER'FIRST);
- 
-           IF -SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST THEN
-                BEGIN
-                     IF IDENT_SHORT (ABS I) = IDENT_SHORT (I) THEN
-                          FAILED ("NO EXCEPTION -- EQUALITY TRUE");
-                     ELSE
-                          FAILED ("NO EXCEPTION -- EQUALITY FALSE");
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          COMMENT ( "CONSTRAINT_ERROR RAISED" );
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED" );
-                END;
-           ELSE
-                COMMENT ( "-SHORT_INTEGER'LAST <= SHORT_INTEGER'FIRST");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C45632B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45632c.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45632c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45632c.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45632c.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C45632C.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR PREDEFINED TYPE LONG_INTEGER,
- --     CONSTRAINT_ERROR IS RAISED FOR ABS (LONG_INTEGER'FIRST)
- --     IF -LONG_INTEGER'LAST > LONG_INTEGER'FIRST.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --     THE USE OF "LONG_INTEGER" AS A PREDEFINED DATA TYPE.
- 
- --     IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF THE
- --     VARIABLE "TEST_VAR" MUST BE REJECTED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     RJW 02/20/86  CREATED ORIGINAL TEST.
- --     JET 12/30/87  UPDATED HEADER FORMAT, ADDED CODE TO DEFEAT
- --                   OPTIMIZATION.
- --     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C45632C IS
- 
-      TEST_VAR : LONG_INTEGER;                  -- N/A => ERROR.
- 
-      FUNCTION IDENT_LONG (A : LONG_INTEGER) RETURN LONG_INTEGER IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN A;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT_LONG;
- 
- BEGIN
- 
-      TEST ( "C45632C", "CHECK THAT FOR PREDEFINED TYPE " &
-                        "LONG_INTEGER CONSTRAINT_ERROR IS RAISED FOR " &
-                        "ABS (LONG_INTEGER'FIRST) IF " &
-                        "-LONG_INTEGER'LAST > LONG_INTEGER'FIRST" );
- 
-      BEGIN
-           IF - LONG_INTEGER'LAST > LONG_INTEGER'FIRST THEN
-                DECLARE
-                     I : LONG_INTEGER := IDENT_LONG(LONG_INTEGER'FIRST);
-                BEGIN
-                     IF IDENT_LONG(ABS I) = IDENT_LONG(I) THEN
-                          FAILED ("NO EXCEPTION -- EQUALITY TRUE");
-                     ELSE
-                          FAILED ("NO EXCEPTION -- EQUALITY FALSE");
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          COMMENT ( "CONSTRAINT_ERROR RAISED" );
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED" );
-                END;
-           ELSE
-                COMMENT ( "-LONG_INTEGER'LAST <= " &
-                          "LONG_INTEGER'FIRST" );
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C45632C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45651a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45651a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45651a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45651a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,246 ****
- -- C45651A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR FIXED POINT TYPES, CHECK:
- --          (A) FOR MODEL NUMBERS A >= 0.0, THAT ABS A = A.
- --          (B) FOR MODEL NUMBERS A <= 0.0. THAT ABS A = -A.
- --          (C) FOR NON-MODEL NUMBERS A > 0.0, THAT ABS A VALUES ARE
- --              WITHIN THE APPROPRIATE MODEL INTERVAL.
- --          (D) FOR NON-MODEL NUMBERS A < 0.0, THAT ABS A VALUES ARE
- --              WITHIN THE APPROPRIATE MODEL INTERVAL.
- 
- --     CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF
- --     DURATION'BASE.
- 
- -- HISTORY:
- --     WRG 9/11/86
- --     PWB 3/31/88  CHANGED RANGE FOR MEMBERSHIP TEST INVOLVING
- --                  ABS (DECIMAL_M4'FIRST + DECIMAL_M4'SMALL / 2).
- --     RJW 8/21/89  REMOVED CHECKS INVOLVING HARD-CODED FIXED-POINT
- --                  UPPER BOUNDS WHICH WERE INCORRECT FOR SOME
- --                  IMPLEMENTATIONS.  REVISED HEADER.
- --     PWN 02/02/95 REMOVED INCONSISTENCIES WITH ADA 9X.
- --     KAS 11/14/95 REMOVED CASES THAT DEPEND ON SPECIFIC VALUE FOR 'SMALL
- --     TMB 11/19/94 REMOVED CASES RELATING TO 3.5.9(8) RULES - SMALL
- --                  MAY BE LESS THAN OR EQUAL TO DELTA FOR FIXED POINT.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C45651A IS
- 
-      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
-      -- 'MANTISSA VALUE.
- 
- BEGIN
- 
-      TEST ("C45651A", "CHECK THAT, FOR FIXED POINT TYPES, THE ABS " &
-                       "OPERATOR PRODUCES CORRECT RESULTS - BASIC " &
-                       "TYPES");
- 
-      -------------------------------------------------------------------
- 
- A:   DECLARE
-           TYPE LIKE_DURATION_M23 IS DELTA 0.020
-                RANGE -86_400.0 .. 86_400.0;
- 
-           NON_MODEL_CONST : CONSTANT          := 2.0 / 3;
-           NON_MODEL_VAR   : LIKE_DURATION_M23 := 0.0;
- 
-           SMALL, MAX, MIN, ZERO : LIKE_DURATION_M23 := 0.5;
-           X                     : LIKE_DURATION_M23 := 1.0;
-      BEGIN
-           -- INITIALIZE "CONSTANTS":
-           IF EQUAL (3, 3) THEN
-                SMALL         := LIKE_DURATION_M23'SMALL;
-                MAX           := LIKE_DURATION_M23'LAST;
-                MIN           := LIKE_DURATION_M23'FIRST;
-                ZERO          := 0.0;
-                NON_MODEL_VAR := NON_MODEL_CONST;
-           END IF;
- 
-           -- (A)
-           IF EQUAL (3, 3) THEN
-                X := SMALL;
-           END IF;
-           IF ABS X /= SMALL OR X /= ABS LIKE_DURATION_M23'SMALL THEN
-                FAILED ("ABS (1.0 / 64) /= (1.0 / 64)");
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := MAX;
-           END IF;
-           IF ABS X /= MAX OR X /= ABS LIKE_DURATION_M23'LAST THEN
-                FAILED ("ABS 86_400.0 /= 86_400.0");
-           END IF;
- 
-           -- (B)
-           IF EQUAL (3, 3) THEN
-                X := -SMALL;
-           END IF;
-           IF ABS X /= SMALL OR
-              ABS (-LIKE_DURATION_M23'SMALL) /= SMALL THEN
-                FAILED ("ABS -(1.0 / 64) /= (1.0 / 64)");
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := MIN;
-           END IF;
-           IF ABS X /= MAX OR ABS LIKE_DURATION_M23'FIRST /= MAX THEN
-                FAILED ("ABS -86_400.0 /= 86_400.0");
-           END IF;
- 
-           -- (A) AND (B)
-           IF EQUAL (3, 3) THEN
-                X := 0.0;
-           END IF;
-           IF "ABS" (RIGHT => X) /= ZERO OR X /= ABS 0.0 THEN
-                FAILED ("ABS 0.0 /= 0.0 -- (LIKE_DURATION_M23)");
-           END IF;
- 
-           -- CHECK THAT VALUE OF NON_MODEL_VAR IS IN THE RANGE
-           -- 42 * 'SMALL .. 43 * 'SMALL:
-           IF NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 THEN
-                FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
-                        "- A");
-           END IF;
- 
-           -- (C)
-           IF ABS NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 OR
-              ABS LIKE_DURATION_M23'(NON_MODEL_CONST) NOT IN
-                  0.65625 .. 0.671875 THEN
-                FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - A");
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := 86_399.992_187_5;  -- LIKE_DURATION_M23'LAST -
-                                        -- 1.0 / 128.
-           END IF;
-           IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
-              ABS (LIKE_DURATION_M23'LAST - LIKE_DURATION_M23'SMALL / 2)
-                  NOT IN 86_399.984_375 .. 86_400.0 THEN
-                FAILED ("ABS (LIKE_DURATION_M23'LAST - " &
-                        "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
-                        "RANGE");
-           END IF;
- 
-           -- (D)
-           IF EQUAL (3, 3) THEN
-                X := -NON_MODEL_CONST;
-           END IF;
-           IF ABS X NOT IN 0.65625 .. 0.671875 OR
-              ABS (-LIKE_DURATION_M23'(NON_MODEL_CONST)) NOT IN
-                  0.65625 .. 0.671875 THEN
-                FAILED ("ABS (-2.0 / 3) NOT IN CORRECT RANGE - A");
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := -86_399.992_187_5;  -- LIKE_DURATION_M23'FIRST +
-                                         -- 1.0 / 128.
-           END IF;
-           IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
-              ABS (LIKE_DURATION_M23'FIRST + LIKE_DURATION_M23'SMALL / 2)
-                  NOT IN 86_399.984_375 .. 86_400.0 THEN
-                FAILED ("ABS (LIKE_DURATION_M23'FIRST +" &
-                        "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
-                        "RANGE");
-           END IF;
-      END A;
- 
-      -------------------------------------------------------------------
- 
- B:   DECLARE
-           TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
- 
-           NON_MODEL_CONST : CONSTANT   := 2.0 / 3;
-           NON_MODEL_VAR   : DECIMAL_M4 := 0.0;
- 
-           SMALL, MAX, MIN, ZERO : DECIMAL_M4 := 128.0;
-           X                     : DECIMAL_M4 :=   0.0;
-      BEGIN
-           -- INITIALIZE "CONSTANTS":
-           IF EQUAL (3, 3) THEN
-                SMALL         :=  DECIMAL_M4'SMALL;
-                ZERO          :=  0.0;
-                NON_MODEL_VAR := NON_MODEL_CONST;
-           END IF;
- 
-           -- (A)
-           IF EQUAL (3, 3) THEN
-                X := SMALL;
-           END IF;
-           IF ABS X /= SMALL OR X /= ABS DECIMAL_M4'SMALL THEN
-                FAILED ("ABS 64.0 /= 64.0");
-           END IF;
- 
-           -- (B)
-           IF EQUAL (3, 3) THEN
-                X := -SMALL;
-           END IF;
-           IF ABS X /= SMALL OR ABS (-DECIMAL_M4'SMALL) /= SMALL THEN
-                FAILED ("ABS -64.0 /= 64.0");
-           END IF;
- 
-           -- (A) AND (B)
-           IF EQUAL (3, 3) THEN
-                X := 0.0;
-           END IF;
-           IF ABS X /= ZERO OR X /= ABS 0.0 THEN
-                FAILED ("ABS 0.0 /= 0.0 -- (DECIMAL_M4)");
-           END IF;
- 
-           -- CHECK THE VALUE OF NON_MODEL_VAR:
-           IF NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN
-                FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
-                        "- B");
-           END IF;
- 
-           -- (C)
-           IF ABS NON_MODEL_VAR NOT IN 0.0 .. 64.0 OR
-              ABS DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 THEN
-                FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - B");
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := 37.0;  -- INTERVAL IS 0.0 .. 64.0.
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := 928.0;
-           END IF;
- 
-           -- (D)
-           IF EQUAL (3, 3) THEN
-                X := -NON_MODEL_CONST;
-           END IF;
-           IF ABS X NOT IN 0.0 .. 64.0 OR
-              ABS (-DECIMAL_M4'(NON_MODEL_CONST)) NOT IN 0.0 .. 64.0 THEN
-                FAILED ("ABS -(2.0 / 3) NOT IN CORRECT RANGE - B");
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := -37.0;  -- INTERVAL IS -SMALL .. 0.0.
-           END IF;
-           IF EQUAL (3, 3) THEN
-                X := -928.0;
-           END IF;
-      END B;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- 
- END C45651A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45662a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45662a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45662a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45662a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C45662A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THE TRUTH TABLE FOR  'NOT' .
- 
- -- THE COMBINATIONS OF  'NOT'  WITH  'AND' , 'OR' , 'XOR'  ARE TESTED
- --    IN C45101(A,G).
- 
- 
- -- RM    28 OCTOBER 1980
- -- TBN 10/21/85     RENAMED FROM C45401A.ADA.
- 
- 
- WITH  REPORT ;
- PROCEDURE  C45662A  IS
- 
-      USE REPORT;
- 
-      TVAR , FVAR , CVAR : BOOLEAN := FALSE ; -- INITIAL VALUE IRRELEVANT
-      ERROR_COUNT : INTEGER := 0 ;            -- INITIAL VALUE ESSENTIAL
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT  :=  ERROR_COUNT + 1 ;
-      END BUMP ;
- 
- BEGIN
- 
-      TEST( "C45662A" , "CHECK THE TRUTH TABLE FOR  'NOT'" ) ;
- 
-      FOR  A  IN  BOOLEAN  LOOP
- 
-           CVAR  :=  NOT A ;
- 
-           IF  NOT A  THEN
-                IF  A  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-           IF  CVAR  THEN
-                IF  A  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-           IF  NOT( NOT( NOT( NOT(   CVAR   ))))
-           THEN
-                IF  A  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-      END LOOP ;
- 
-      FOR  I  IN  1..2  LOOP
- 
-           CVAR  :=  NOT ( I > 1 ) ;
- 
-           IF  NOT ( I > 1 )  THEN
-                IF  I>1  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-           IF  CVAR  THEN
-                IF  I>1  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-      END LOOP ;
- 
-      IF  NOT TRUE   THEN  BUMP ;                END IF ;
-      IF  NOT FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF ;
- 
-      TVAR := IDENT_BOOL( TRUE );
-      FVAR := IDENT_BOOL( FALSE );
- 
-      IF  NOT TVAR  THEN  BUMP ;                END IF ;
-      IF  NOT FVAR  THEN  NULL ;  ELSE  BUMP ;  END IF ;
- 
- 
-      IF  ERROR_COUNT  /= 0  THEN  FAILED( "'NOT' TRUTH TABLE" );
-      END IF ;
- 
-      RESULT;
- 
- END C45662A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45662b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45662b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45662b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45662b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C45662B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THE TRUTH TABLE FOR  'NOT'  ON DERIVED-BOOLEAN-TYPE OPERANDS.
- 
- -- THE COMBINATIONS OF  'NOT'  WITH  'AND' , 'OR' , 'XOR'  ARE TESTED
- --    IN C45101K.
- 
- 
- -- RM    28 OCTOBER 1980
- -- TBN 10/21/85     RENAMED FROM C45401B-AB.ADA.  REMOVED DUPLICATED
- --                  CODE NEAR END.
- 
- WITH  REPORT; USE REPORT;
- PROCEDURE  C45662B  IS
- 
-      TYPE  NB  IS  NEW BOOLEAN ;
- 
-      TVAR , FVAR , CVAR : NB := NB'(FALSE) ; -- INITIAL VALUE IRRELEVANT
-      ERROR_COUNT : INTEGER := 0 ;            -- INITIAL VALUE ESSENTIAL
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           ERROR_COUNT := ERROR_COUNT + 1 ;
-      END BUMP ;
- 
-      FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
-      BEGIN
-           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
-           ELSE  RETURN  NB'(FALSE) ;
-           END IF;
-      END ;
- 
- 
- BEGIN
- 
-      TEST( "C45662B" , "CHECK THE TRUTH TABLE FOR  'NOT'" &
-                        " ON DERIVED-BOOLEAN-TYPE OPERANDS" ) ;
- 
-      FOR  A  IN  NB  LOOP
- 
-           CVAR  :=  NOT A ;
- 
-           IF  BOOLEAN( NOT A )  THEN
-                IF  BOOLEAN( A )  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-           IF  BOOLEAN( CVAR )  THEN
-                IF  BOOLEAN( A )  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-           IF  BOOLEAN(
- 
-               NOT( NOT( NOT( NOT( NOT(
-               NOT( NOT( NOT( NOT( NOT(
-               NOT( NOT( NOT( NOT( NOT(
-               NOT( NOT( NOT( NOT( NOT(   CVAR  ))))) ))))) ))))) )))))
-                       )
-           THEN
-                IF  BOOLEAN( A )  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-      END LOOP ;
- 
-      FOR  I  IN  1..2  LOOP
- 
-           CVAR  :=  NOT( NB( I > 1 ) ) ;
- 
-           IF  BOOLEAN(  NOT(  NB( I > 1 )))  THEN
-                IF  I>1  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-           IF  BOOLEAN( CVAR )  THEN
-                IF  I>1  THEN  BUMP ;
-                END IF ;
-           END IF;
- 
-      END LOOP ;
- 
-      IF  BOOLEAN( NOT( NB'(TRUE ))) THEN  BUMP ;                END IF ;
-      IF  BOOLEAN( NOT( NB'(FALSE))) THEN  NULL ;  ELSE  BUMP ;  END IF ;
- 
- 
-      TVAR := IDENT_NEW_BOOL( NB'(TRUE ) );
-      FVAR := IDENT_NEW_BOOL( NB'(FALSE) );
- 
-      IF  BOOLEAN( NOT TVAR )  THEN  BUMP ;                END IF ;
-      IF  BOOLEAN( NOT FVAR )  THEN  NULL ;  ELSE  BUMP ;  END IF ;
- 
-      IF  ERROR_COUNT  /= 0  THEN  FAILED( "'NOT' TRUTH TABLE" );
-      END IF ;
- 
-      RESULT;
- 
- END C45662B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45672a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45672a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c45672a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c45672a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C45672A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT "NOT" YIELDS THE CORRECT RESULTS WHEN APPLIED TO
- -- ONE-DIMENSIONAL BOOLEAN ARRAYS.
- 
- -- JWC 11/15/85
- 
- WITH REPORT;USE REPORT;
- 
- PROCEDURE C45672A IS
- BEGIN
- 
-      TEST ("C45672A", "CHECK THE UNARY OPERATOR 'NOT' APPLIED TO " &
-                       "ONE-DIMENSIONAL BOOLEAN ARRAYS");
- 
-      DECLARE
- 
-           TYPE ARR1 IS ARRAY (INTEGER RANGE 1 .. 4) OF BOOLEAN;
-           TYPE ARR2 IS ARRAY (INTEGER RANGE 1 .. 40) OF BOOLEAN;
-           TYPE ARR3 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-           TYPE ARR4 IS ARRAY (INTEGER RANGE 1 .. 4) OF BOOLEAN;
-           TYPE ARR5 IS ARRAY (INTEGER RANGE 1 .. 40) OF BOOLEAN;
- 
-           PRAGMA PACK (ARR4);
-           PRAGMA PACK (ARR5);
- 
-           A1 : ARR1 := ARR1'(1 | 3 => TRUE, OTHERS => FALSE);
-           A2 : ARR2 := ARR2'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37 => TRUE,
-                              OTHERS => FALSE);
-           A3 : ARR3(IDENT_INT(3) .. IDENT_INT(4)) := ARR3'(TRUE, FALSE);
-           A4 : ARR4 := ARR4'(1 | 3 => TRUE, OTHERS => FALSE);
-           A5 : ARR5 := ARR5'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37 => TRUE,
-                              OTHERS => FALSE);
-           A6 : ARR3 (IDENT_INT(9) .. IDENT_INT(7));
- 
-           PROCEDURE P (A : ARR3; F : INTEGER; L : INTEGER) IS
-           BEGIN
-                IF A'FIRST /= F OR A'LAST /= L THEN
-                     FAILED ("'NOT' YIELDED THE WRONG BOUNDS");
-                END IF;
-           END P;
- 
-      BEGIN
- 
-           P (NOT A3, 3, 4);
-           P (NOT A6, 9, 7);
- 
-           IF NOT A1 /= ARR1'(1 | 3 => FALSE, OTHERS => TRUE) THEN
-                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
-                        "TO SMALL ARRAY");
-           END IF;
- 
-           IF NOT A2 /= ARR2'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37
-                              => FALSE, OTHERS => TRUE) THEN
-                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
-                        "TO LARGE ARRAY");
-           END IF;
- 
-           IF NOT A4 /= ARR4'(1 | 3 => FALSE, OTHERS => TRUE) THEN
-                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
-                        "TO SMALL PACKED ARRAY");
-           END IF;
- 
-           IF NOT A5 /= ARR5'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37
-                              => FALSE, OTHERS => TRUE) THEN
-                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
-                        "TO LARGE PACKED ARRAY");
-           END IF;
- 
-           IF "NOT" (RIGHT => A1) /= ARR1'(1 | 3 => FALSE,
-                                           OTHERS => TRUE) THEN
-                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
-                        "TO SMALL ARRAY USING NAMED NOTATION");
-           END IF;
- 
-           IF "NOT" (RIGHT => A5) /= ARR5'(1 | 14 .. 18 | 30 .. 33 |
-                                           35 .. 37 => FALSE,
-                                           OTHERS => TRUE) THEN
-                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED TO LARGE " &
-                        "PACKED ARRAY USING NAMED NOTATION");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C45672A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,300 ****
- -- C460001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the target type of a type conversion is a general
- --      access type, Program_Error is raised if the accessibility level
- --      of the operand type is deeper than that of the target type.
- --      Check for the case where the operand is an access parameter.
- --      
- --      Check for cases where the actual corresponding to the access
- --      parameter is:
- --         (a) An allocator.
- --         (b) An expression of a named access type.
- --         (c) Obj'Access.
- --      
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the operand type
- --      must be at the same or a less deep nesting level than the target
- --      type -- the operand type must "live" as long as the target type.
- --      Nesting levels are the run-time nestings of masters: block statements;
- --      subprogram, task, and entry bodies; and accept statements. Packages
- --      are invisible to accessibility rules.
- --
- --      This test declares subprograms with access parameters, within which
- --      a type conversion is attempted on the access parameter to an access
- --      type A declared at some nesting level. The test verifies that
- --      Program_Error is raised if the actual corresponding to the access
- --      parameter is:
- --
- --         (1) an allocator, and the accessibility level of the execution
- --             of the called subprogram is deeper than that of the access
- --             type A. 
- --
- --         (2) an expression of a named access type, and the accessibility
- --             level of the named access type is deeper than that of the
- --             access type A. 
- --
- --         (3) a reference to the Access attribute (e.g., X'Access), and
- --             the accessibility level of X is deeper than that of the
- --             access type A. 
- --
- --      Note that the static nesting level of the actual corresponding to the
- --      access parameter can be deeper than that of the target type -- it is
- --      the run-time nesting that matters for accessibility rules. Consider
- --      the case where the access type A is declared within the called
- --      subprogram. The accessibility check will never fail, even if the
- --      actual happens to have a deeper static nesting level:
- --
- --         procedure P (X: access T) is
- --            type A is access all T;   -- Static level = 2, e.g.
- --            Acc : A := A(X);          -- Check should never fail.
- --         begin null; end;
- --         . . .
- --         declare
- --            Actual : aliased T;       -- Static level = 3, e.g.
- --         begin
- --            P (Actual'Access);
- --         end;
- --
- --         For the execution of P, the accessibility level of type A will
- --         always be deeper than that of Actual, so there is no danger of a
- --         dangling reference arising from the assignment to Acc. Thus, the
- --         type conversion is safe, even though the static nesting level of
- --         Actual is deeper than that of A.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C460001_0 is
- 
-    type Desig is array (1 .. 10) of Integer;
- 
-    X0 : aliased Desig;                                            -- Level = 0.
- 
-    type Acc_L0 is access all Desig;                               -- Level = 0.
-    A0 : Acc_L0;
- 
-    type Result_Kind is (OK, P_E, O_E);
- 
-    procedure Target_Is_Level_0 (X: access Desig; R : out Result_Kind);
-    procedure Never_Fails       (X: access Desig; R : out Result_Kind);
- 
- end C460001_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C460001_0 is
- 
-    procedure Target_Is_Level_0 (X : access Desig;
-                                 R : out Result_Kind) is
-    begin
-       -- The accessibility level of type Acc_L0 is 0.
-       A0 := Acc_L0(X);
-       R  := OK;
-    exception
-       when Program_Error =>    
-          R := P_E;
-       when others        =>    
-          R := O_E;
-    end Target_Is_Level_0;
- 
-    -----------------------------------------------
-    procedure Never_Fails (X: access Desig;
-                           R : out Result_Kind) is
-       type Acc_Local is access all Desig;
-       AL : Acc_Local;
-    begin
-       -- The type conversion below will always be safe, since the
-       -- accessibility level (although not necessarily the static nesting
-       -- depth) of Acc_Local will always be deeper than or the same as that 
-       -- of the actual corresponding to X. 
-       AL := Acc_Local(X);
-       R  := OK;
-    exception
-       when Program_Error =>    
-          R := P_E;
-       when others        =>    
-          R := O_E;
-    end Never_Fails;
- 
- end C460001_0;
- 
- 
-      --==================================================================--
- 
- 
- with C460001_0;
- with Report;
- 
- procedure C460001 is
- 
-    X1 : aliased C460001_0.Desig;                                  -- Level = 1.
- 
-    type Acc_L1 is access all C460001_0.Desig;                     -- Level = 1.
-    A1 : Acc_L1;
- 
-    Expr_L0 : C460001_0.Acc_L0 := C460001_0.X0'Access;
-    Expr_L1 : Acc_L1           := X1'Access;
- 
-    Res : C460001_0.Result_Kind;
- 
-    use type C460001_0.Result_Kind;
- 
-    -----------------------------------------------
-    procedure Target_Is_Level_1 (X : access C460001_0.Desig;
-                                 R : out C460001_0.Result_Kind) is
-    begin
-       -- The accessibility level of type Acc_L1 is 1.
-       A1 := Acc_L1(X);
-       R  := C460001_0.OK;
-    exception
-       when Program_Error =>    
-          R := C460001_0.P_E;
-       when others        =>    
-          R := C460001_0.O_E;
-    end Target_Is_Level_1;
- 
-    -----------------------------------------------
-    procedure Display_Results (Result  : in C460001_0.Result_Kind;
-                               Expected: in C460001_0.Result_Kind;
-                               Message : in String) is
-    begin
-       if Result /= Expected then
-          case Result is
-             when C460001_0.OK  => Report.Failed ("No exception raised: "  & 
-                                                  Message);
-             when C460001_0.P_E => Report.Failed ("Program_Error raised: " & 
-                                                  Message);
-             when C460001_0.O_E => Report.Failed ("Unexpected exception "  &
-                                                  "raised: " & Message);
-          end case;
-       end if;
-    end Display_Results;
- 
- begin -- C460001
- 
-    Report.Test ("C460001", "Check that if the target type of a type "      &
-                 "conversion is a general access type, Program_Error is "   &
-                 "raised if the accessibility level of the operand type "   &
-                 "is deeper than that of the target type: operand is an "   &
-                 "access parameter; corresponding actual is an allocator, " &
-                 "expression of a named access type, Obj'Access");
- 
- 
-    -- Actual is X'Access:
- 
-    C460001_0.Never_Fails (X1'Access, Res);
-    Display_Results (Res, C460001_0.OK, "X1'Access, local access type");
- 
-    C460001_0.Target_Is_Level_0 (X1'Access, Res);
-    Display_Results (Res, C460001_0.P_E, "X1'Access, level 0 access type");
- 
-    Target_Is_Level_1 (C460001_0.X0'Access, Res);
-    Display_Results (Res, C460001_0.OK, "X0'Access, level 1 access type");
- 
-    Target_Is_Level_1 (X1'Access, Res);
-    Display_Results (Res, C460001_0.OK, "X1'Access, level 1 access type");
- 
-    C460001_0.Target_Is_Level_0 (C460001_0.X0'Access, Res);
-    Display_Results (Res, C460001_0.OK, "X0'Access, level 0 access type");
- 
- 
-    -- Actual is expression of a named access type:
- 
-    C460001_0.Never_Fails (Expr_L0, Res);
-    Display_Results (Res, C460001_0.OK, "Expr_L0, local access type");
- 
-    C460001_0.Target_Is_Level_0 (Expr_L0, Res);
-    Display_Results (Res, C460001_0.OK, "Expr_L0, level 0 access type");
- 
-    C460001_0.Target_Is_Level_0 (Expr_L1, Res);
-    Display_Results (Res, C460001_0.P_E, "Expr_L1, level 0 access type");
- 
-    Target_Is_Level_1 (Expr_L1, Res);
-    Display_Results (Res, C460001_0.OK, "Expr_L1, level 1 access type");
- 
-    Target_Is_Level_1 (Expr_L0, Res);
-    Display_Results (Res, C460001_0.OK, "Expr_L0, level 1 access type");
- 
-    -- Actual is allocator (level of execution = 2):
- 
-    C460001_0.Never_Fails (new C460001_0.Desig, Res);
-    Display_Results (Res, C460001_0.OK, "Allocator level 2, " &
-                                        "local access type");
- 
-    C460001_0.Target_Is_Level_0 (new C460001_0.Desig, Res);
-    Display_Results (Res, C460001_0.P_E, "Allocator level 2, " &
-                                         "level 0 access type");
- 
-    Target_Is_Level_1 (new C460001_0.Desig, Res);
-    Display_Results (Res, C460001_0.P_E, "Allocator level 2, " &
-                                         "level 1 access type");
- 
- 
-    Block_L2:
-    declare
-       X2 : aliased C460001_0.Desig;                               -- Level = 2.
-       type Acc_L2 is access all C460001_0.Desig;                  -- Level = 2.
-       Expr_L2 : Acc_L2 := X1'Access;
-    begin
- 
-       -- Actual is X'Access:
- 
-       C460001_0.Never_Fails (X2'Access, Res);
-       Display_Results (Res, C460001_0.OK, "X2'Access, local access type");
- 
-       Target_Is_Level_1 (X2'Access, Res);
-       Display_Results (Res, C460001_0.P_E, "X2'Access, level 1 access type");
- 
-       -- Actual is expression of a named access type:
- 
-       C460001_0.Never_Fails (Expr_L2, Res);
-       Display_Results (Res, C460001_0.OK, "Expr_L2, local access type");
- 
-       C460001_0.Target_Is_Level_0 (Expr_L2, Res);
-       Display_Results (Res, C460001_0.P_E, "Expr_L2, level 0 access type");
- 
- 
-       -- Actual is allocator (level of execution = 3):
- 
-       C460001_0.Never_Fails (new C460001_0.Desig, Res);
-       Display_Results (Res, C460001_0.OK, "Allocator level 3, " &
-                                           "local access type");
- 
-       Target_Is_Level_1 (new C460001_0.Desig, Res);
-       Display_Results (Res, C460001_0.P_E, "Allocator level 3, " &
-                                            "level 1 access type");
- 
-    end Block_L2;
- 
-    Report.Result;
- 
- end C460001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,330 ****
- -- C460002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the target type of a type conversion is a general
- --      access type, Program_Error is raised if the accessibility level
- --      of the operand type is deeper than that of the target type.
- --      Check for the case where the operand is an access parameter,
- --      and the actual corresponding to the access parameter is another
- --      access parameter.
- --
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the operand type
- --      must be at the same or a less deep nesting level than the target
- --      type -- the operand type must "live" as long as the target type.
- --      Nesting levels are the run-time nestings of masters: block statements;
- --      subprogram, task, and entry bodies; and accept statements. Packages
- --      are invisible to accessibility rules.
- --
- --      This test declares subprograms with access parameters, within which
- --      a type conversion is attempted on the access parameter to an access
- --      type A declared at some nesting level. The test verifies that
- --      Program_Error is raised if the actual corresponding to the access
- --      parameter is another access parameter, and the actual corresponding
- --      to this second access parameter is:
- --
- --         (1) an expression of a named access type, and the accessibility
- --             level of the named access type is deeper than that of the
- --             access type A.
- --
- --         (2) a reference to the Access attribute (e.g., X'Access), and
- --             the accessibility level of X is deeper than that of the
- --             access type A.
- --
- --      Note that the static nesting level of the actual corresponding to the
- --      access parameter can be deeper than that of the target type -- it is
- --      the run-time nesting that matters for accessibility rules. Consider
- --      the case where the access type A is declared within the called
- --      subprogram. The accessibility check will never fail, even if the
- --      actual happens to have a deeper static nesting level:
- --
- --         procedure P (X: access T) is
- --            type A is access all T;   -- Static level = 2, e.g.
- --            Acc : A := A(X);          -- Check should never fail.
- --         begin null; end;
- --         . . .
- --         procedure Q (Y: access T) is
- --         begin
- --            P(Y);
- --         end;
- --         . . .
- --         declare
- --            Actual : aliased T;       -- Static level = 3, e.g.
- --         begin
- --            Q (Actual'Access);
- --         end;
- --
- --         For the execution of Q (and hence P), the accessibility level of
- --         type A will always be deeper than that of Actual, so there is no
- --         danger of a dangling reference arising from the assignment to
- --         Acc. Thus, the type conversion is safe, even though the static
- --         nesting level of Actual is deeper than that of A.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Changed maintenance documentation.
- --      15 Jul 98   EDS     Avoid Optimization
- --      28 Jun 02   RLB     Added pragma Elaborate_All.
- --!
- 
- with Report; use Report; pragma Elaborate_All (Report);
- package C460002_0 is
- 
-    type Component is array (1 .. 10) of Natural;
- 
-    type Desig is record
-       C: Component;
-    end record;
- 
-    X0 : aliased Desig := (C=>(others => Ident_Int(3)));    -- Level = 0.
- 
-    type Acc_L0 is access all Desig;                               -- Level = 0.
-    A0 : Acc_L0;
- 
-    type Result_Kind is (OK, P_E, O_E);
- 
-    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind);
-    procedure Never_Fails_Nest       (Y: access Desig; S: out Result_Kind);
-    procedure Never_Fails_Same       (Y: access Desig; S: out Result_Kind);
- 
- end C460002_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C460002_0 is
- 
-    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind) is
- 
-       procedure Nested (X: access Desig; R: out Result_Kind) is
-       -- This procedure attempts a type conversion on the access parameter to
-       -- an access type declared at some nesting level.  Program_Error is
-       -- raised if the accessibility level of the operand type is deeper than
-       -- that of the target type.
- 
-       begin
-          -- The accessibility level of type Acc_L0 is 0.
-          A0 := Acc_L0(X);
-          R  := OK;
-       exception
-          when Program_Error =>
-             R := P_E;
-          when others        =>
-             R := O_E;
-       end Nested;
- 
-    begin
-       Nested (Y, S);
-    end Target_Is_Level_0_Nest;
- 
-    -------------------------------------------------------------
- 
-    procedure Never_Fails_Nest (Y: access Desig; S: out Result_Kind) is
- 
-       type Acc_Deeper is access all Desig;
-       AD : Acc_Deeper;
- 
-       function Nested (X: access Desig) return Result_Kind is
-       begin
-          -- The type conversion below will always be safe, since the
-          -- accessibility level (although not necessarily the static nesting
-          -- depth) of Acc_Deeper will always be deeper than or the same as that
-          -- of the actual corresponding to Y.
-          AD := Acc_Deeper(X);
-          if Natural(Ident_Int(AD.C(1))) /= 3 then            --Avoid Optimization of AD
-            Report.Failed ("Initial Values not correct.");
-          end if;
-          return OK;
-       exception
-          when Program_Error =>
-             return P_E;
-          when others        =>
-             return O_E;
-       end Nested;
- 
-    begin
-       S := Nested (Y);
-    end Never_Fails_Nest;
- 
-    -------------------------------------------------------------
- 
-    procedure Called_By_Never_Fails_Same
-      (X: access Desig; R: out Result_Kind) is
-       type Acc_Local is access all Desig;
-       AL : Acc_Local;
-    begin
-       -- The type conversion below will always be safe, since the
-       -- accessibility level (although not necessarily the static nesting
-       -- depth) of Acc_Local will always be deeper than or the same as that
-       -- of the actual corresponding to X.
-       AL := Acc_Local(X);
-       if Natural(Ident_Int(AL.C(1))) /= 3 then       --Avoid Optimization of AL
-         Report.Failed ("Initial Values not correct.");
-       end if;
-       R  := OK;
-    exception
-       when Program_Error =>
-          R := P_E;
-       when others        =>
-          R := O_E;
-    end Called_By_Never_Fails_Same;
- 
-    -------------------------------------------------------------
- 
-    procedure Never_Fails_Same (Y: access Desig; S: out Result_Kind) is
-    begin
-       Called_By_Never_Fails_Same (Y, S);
-    end Never_Fails_Same;
- 
- end C460002_0;
- 
- 
-      --==================================================================--
- 
- 
- with C460002_0;
- use  C460002_0;
- 
- with Report; use Report;
- 
- procedure C460002 is
- 
-    type Acc_L1 is access all Desig;                               -- Level = 1.
-    A1 : Acc_L1;
-    X1 : aliased Desig := (C=>(others => Ident_Int(3)));
-    Res : Result_Kind;
- 
- 
- 
-    procedure Called_By_Target_L1 (X: access Desig; R: out Result_Kind) is
-    begin
-       -- The accessibility level of type Acc_L1 is 1.
-       A1 := Acc_L1(X);
-       if Natural(Ident_Int(A1.C(1))) /= 3 then       --Avoid Optimization of A1
-         Report.Failed ("Initial Values not correct.");
-       end if;
-       R  := OK;
-    exception
-       when Program_Error =>
-          R := P_E;
-       when others        =>
-          R := O_E;
-    end Called_By_Target_L1;
- 
-    -------------------------------------------------------------
- 
-    function Target_Is_Level_1_Same (Y: access Desig) return Result_Kind is
-       S : Result_Kind;
-    begin
-       Called_By_Target_L1 (Y, S);
-       return S;
-    end Target_Is_Level_1_Same;
- 
-    -------------------------------------------------------------
- 
-    procedure Display_Results (Result  : in Result_Kind;
-                               Expected: in Result_Kind;
-                               Msg     : in String) is
-    begin
-       if Result /= Expected then
-          case Result is
-             when OK  => Report.Failed ("No exception raised: "         & Msg);
-             when P_E => Report.Failed ("Program_Error raised: "        & Msg);
-             when O_E => Report.Failed ("Unexpected exception raised: " & Msg);
-          end case;
-       end if;
-    end Display_Results;
- 
- begin -- C460002.
- 
-    Report.Test ("C460002", "Check that if the target type of a type "      &
-                 "conversion is a general access type, Program_Error is "   &
-                 "raised if the accessibility level of the operand type "   &
-                 "is deeper than that of the target type: operand is an "   &
-                 "access parameter; corresponding actual is another "       &
-                 "access parameter");
- 
- 
-    -- Accessibility level of actual is 0 (actual is X'Access):
- 
-    Never_Fails_Same (X0'Access, Res);
-    Display_Results (Res, OK, "Never_Fails_Same, level 0 actual");
- 
-    Never_Fails_Nest (X0'Access, Res);
-    Display_Results (Res, OK, "Target_L1_Nest, level 0 actual");
- 
-    Target_Is_Level_0_Nest (X0'Access, Res);
-    Display_Results (Res, OK, "Target_L0_Nest, level 0 actual");
- 
-    Res := Target_Is_Level_1_Same (X0'Access);
-    Display_Results (Res, OK, "Target_L1_Same, level 0 actual");
- 
- 
-    -- Accessibility level of actual is 1 (actual is X'Access):
- 
-    Never_Fails_Same (X1'Access, Res);
-    Display_Results (Res, OK, "Never_Fails_Same, level 1 actual");
- 
-    Never_Fails_Nest (X1'Access, Res);
-    Display_Results (Res, OK, "Target_L1_Nest, level 1 actual");
- 
-    Target_Is_Level_0_Nest (X1'Access, Res);
-    Display_Results (Res, P_E, "Target_L0_Nest, level 1 actual");
- 
-    Res := Target_Is_Level_1_Same (X1'Access);
-    Display_Results (Res, OK, "Target_L1_Same, level 1 actual");
- 
- 
-    Block_L2:
-    declare
-       X2 : aliased Desig := (C=>(others => Ident_Int(3)));
-       type Acc_L2 is access all Desig;                            -- Level = 2.
-       Expr_L2 : Acc_L2 := X2'Access;
-    begin
- 
-       -- Accessibility level of actual is 2 (actual is expression of named
-       -- access type):
- 
-       Never_Fails_Same (Expr_L2, Res);
-       Display_Results (Res, OK, "Never_Fails_Same, level 2 actual");
- 
-       Never_Fails_Nest (Expr_L2, Res);
-       Display_Results (Res, OK, "Target_L1_Nest, level 2 actual");
- 
-       Target_Is_Level_0_Nest (Expr_L2, Res);
-       Display_Results (Res, P_E, "Target_L0_Nest, level 2 actual");
- 
-       Res := Target_Is_Level_1_Same (Expr_L2);
-       Display_Results (Res, P_E, "Target_L1_Same, level 2 actual");
- 
-    end Block_L2;
- 
- 
-    Report.Result;
- 
- end C460002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,335 ****
- -- C460004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the operand type of a type conversion is class-wide,
- --      Constraint_Error is raised if the tag of the operand does not
- --      identify a specific type that is covered by or descended from the
- --      target type.
- --
- -- TEST DESCRIPTION:
- --      View conversions of class-wide operands to specific types are
- --      placed on the right and left sides of assignment statements, and
- --      conversions of class-wide operands to class-wide types are used
- --      as actual parameters to dispatching operations. In all cases, a
- --      check is made that Constraint_Error is raised if the tag of the
- --      operand does not identify a specific type covered by or descended
- --      from the target type, and not raised otherwise.
- --      
- --      A specific type is descended from itself and from those types it is
- --      directly or indirectly derived from. A specific type is covered by
- --      itself and each class-wide type to whose class it belongs.
- --      
- --      A class-wide type T'Class is descended from T and those types which
- --      T is descended from. A class-wide type is covered by each class-wide
- --      type to whose class it belongs.
- --      
- --
- -- CHANGE HISTORY:
- --      19 Jul 95   SAIC    Initial prerelease version.
- --      18 Apr 96   SAIC    ACVC 2.1: Added a check for correct tag.
- --
- --!
- package C460004_0 is
- 
-    type Tag_Type is tagged record
-       C1 : Natural;
-    end record;
- 
-    procedure Proc (X : in out Tag_Type);
- 
- 
-    type DTag_Type is new Tag_Type with record
-       C2 : String (1 .. 5);
-    end record;
- 
-    procedure Proc (X : in out DTag_Type);
- 
- 
-    type DDTag_Type is new DTag_Type with record
-       C3 : String (1 .. 5);
-    end record;
- 
-    procedure Proc (X : in out DDTag_Type);
- 
-    procedure NewProc (X : in DDTag_Type);
- 
-    function CWFunc (X : Tag_Type'Class) return Tag_Type'Class;
- 
- end C460004_0;
- 
- 
-      --==================================================================--
- 
- with Report;
- package body C460004_0 is
- 
-    procedure Proc (X : in out Tag_Type) is
-    begin
-       X.C1 := 25;
-    end Proc;
- 
-    -----------------------------------------
-    procedure Proc (X : in out DTag_Type) is
-    begin
-       Proc ( Tag_Type(X) );
-       X.C2 := "Earth";
-    end Proc;
- 
-    -----------------------------------------
-    procedure Proc (X : in out DDTag_Type) is
-    begin
-       Proc ( DTag_Type(X) );
-       X.C3 := "Orbit";
-    end Proc;
- 
-    -----------------------------------------
-    procedure NewProc (X : in DDTag_Type) is
-       Y : DDTag_Type := X;
-    begin
-       Proc (Y);
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in NewProc");
-    end NewProc;
- 
-    -----------------------------------------
-    function CWFunc (X : Tag_Type'Class) return Tag_Type'Class is
-       Y : Tag_Type'Class := X;
-    begin
-       Proc (Y);
-       return Y;
-    end CWFunc;
- 
- end C460004_0;
- 
- 
-      --==================================================================--
- 
- 
- with C460004_0;
- use  C460004_0;
- 
- with Report;
- procedure C460004 is
- 
-    Tag_Type_Init    :  constant Tag_Type   := (C1 => 0);
-    DTag_Type_Init   :  constant DTag_Type  := (Tag_Type_Init with "Hello");
-    DDTag_Type_Init  :  constant DDTag_Type := (DTag_Type_Init with "World");
- 
-    Tag_Type_Value   :  constant Tag_Type   := (C1 => 25);
-    DTag_Type_Value  :  constant DTag_Type  := (Tag_Type_Value  with "Earth");
-    DDTag_Type_Value :  constant DDTag_Type := (DTag_Type_Value with "Orbit");
- 
- begin
- 
-    Report.Test ("C460004", "Check that for a view conversion of a "      &
-                 "class-wide operand, Constraint_Error is raised if the " &
-                 "tag of the operand does not identify a specific type "  &
-                 "covered by or descended from the target type");
- 
- --
- -- View conversion to specific type:
- --
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Target : Tag_Type := Tag_Type_Init;     
-       begin
-          Target := Tag_Type(P);                      
-          if (Target /= Tag_Type_Value) then
-             Report.Failed ("Target has wrong value: #01");
-          end if;
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised: #01");
-          when others           => 
-             Report.Failed ("Unexpected exception: #01");
-       end CW_Proc;
- 
-    begin
-       CW_Proc (DDTag_Type_Value);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       Target : DTag_Type := DTag_Type_Init;           
-    begin
-       Target := DTag_Type(CWFunc(DDTag_Type_Value));  
-       if (Target /= DTag_Type_Value) then
-          Report.Failed ("Target has wrong value: #02");
-       end if;
-    exception
-       when Constraint_Error => Report.Failed ("Constraint_Error raised: #02");
-       when others           => Report.Failed ("Unexpected exception: #02");
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       Target : DDTag_Type;
-    begin
-       Target := DDTag_Type(CWFunc(Tag_Type_Value));
-                 -- CWFunc returns a Tag_Type; its tag is preserved through 
-                 -- the view conversion.  Constraint_Error should be raised.
- 
-       Report.Failed ("Constraint_Error not raised: #03"); 
- 
-    exception
-       when Constraint_Error => null;                 -- expected exception
-       when others           => Report.Failed ("Unexpected exception: #03");
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-       begin
-          NewProc (DDTag_Type(P));
-          Report.Failed ("Constraint_Error not raised: #04"); 
-                                                          
-       exception
-          when Constraint_Error => null;              -- expected exception
-          when others           => Report.Failed ("Unexpected exception: #04");
-       end CW_Proc;
-  
-    begin
-       CW_Proc (DTag_Type_Value);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Target : DDTag_Type := DDTag_Type_Init; 
-       begin
-          Target := DDTag_Type(P);
-          if (Target /= DDTag_Type_Value) then
-             Report.Failed ("Target has wrong value: #05");
-          end if;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised: #05");
-          when others           
-             => Report.Failed ("Unexpected exception: #05");
-       end CW_Proc;
-  
-    begin
-       CW_Proc (DDTag_Type_Value);
-    end;
- 
- 
- --
- -- View conversion to class-wide type:
- --
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;
-       begin
-          Proc( DTag_Type'Class(Operand) );
-          Report.Failed ("Constraint_Error not raised: #06");
- 
-       exception
-          when Constraint_Error => null;              -- expected exception
-          when others           => Report.Failed ("Unexpected exception: #06");
-       end CW_Proc;
-  
-    begin
-       CW_Proc (Tag_Type_Init);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;
-       begin
-          Proc( DDTag_Type'Class(Operand) );
-          Report.Failed ("Constraint_Error not raised: #07");
- 
-       exception
-          when Constraint_Error => null;              -- expected exception
-          when others           => Report.Failed ("Unexpected exception: #07");
-       end CW_Proc;
-  
-    begin
-       CW_Proc (Tag_Type_Init);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;
-       begin
-          Proc( DTag_Type'Class(Operand) );  
-          if Operand not in DTag_Type then
-             Report.Failed ("Operand has wrong tag: #08");
-          elsif (Operand /= Tag_Type'Class (DTag_Type_Value)) then
-             Report.Failed ("Operand has wrong value: #08");
-          end if;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised: #08");
-          when others           => 
-             Report.Failed ("Unexpected exception: #08");
-       end CW_Proc;
-  
-    begin
-       CW_Proc (DTag_Type_Init);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;
-       begin
-          Proc( Tag_Type'Class(Operand) );
-          if Operand not in DDTag_Type then
-             Report.Failed ("Operand has wrong tag: #09");
-          elsif (Operand /= Tag_Type'Class (DDTag_Type_Value)) then
-             Report.Failed ("Operand has wrong value: #09");
-          end if;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised: #09");
-          when others           => 
-             Report.Failed ("Unexpected exception: #09");
-       end CW_Proc;
-  
-    begin
-       CW_Proc (DDTag_Type_Init);
-    end;
- 
- 
-    Report.Result;
- 
- end C460004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,260 ****
- -- C460005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for a view conversion of a tagged type that is the left 
- --      side of an assignment statement, the assignment assigns to the 
- --      corresponding part of the object denoted by the operand.
- --
- -- TEST DESCRIPTION:
- --      View conversions of class-wide operands to specific types are
- --      placed on the right and left sides of assignment statements, and
- --      conversions of class-wide operands to class-wide types are used
- --      as actual parameters to dispatching operations. In all cases, a
- --      check is made that Constraint_Error is raised if the tag of the
- --      operand does not identify a specific type covered by or descended
- --      from the target type, and not raised otherwise.
- --
- --      For the cases where the view conversion is the left side of an
- --      assignment statement, and Constraint_Error should not be raised,
- --      an additional check is made that only the corresponding portion
- --      of the operand is updated by the assignment. For example:
- --
- --         type T is tagged record
- --            C1 : Integer := 0;
- --         end record;
- --
- --         type DT is new T with record
- --            C2 : Integer := 0;
- --         end record;
- --
- --         A    : T       := (C1 => 5);
- --         B    : DT      := (C1 => 0, C2 => 10);
- --         CWDT : T'Class := B;
- --
- --         T(CWDT) := A;  -- Updates component C1; C2 remains unchanged.
- --                        -- Value of CWDT is (C1 => 5, C2 => 10).
- --
- --
- -- CHANGE HISTORY:
- --      31 Jul 95   SAIC    Initial prerelease version.
- --      22 Apr 96   SAIC    ACVC 2.1: Added a check for correct tag.
- --      08 Sep 96   SAIC    ACVC 2.1: Modified Report.Test. 
- --
- --!
- 
- package C460005_0 is
- 
-    type Tag_Type is tagged record
-       C1 : Natural;
-    end record;
- 
-    procedure Proc (X : in out Tag_Type);
- 
- 
-    type DTag_Type is new Tag_Type with record
-       C2 : String (1 .. 5);
-    end record;
- 
-    procedure Proc (X : in out DTag_Type);
- 
- 
-    type DDTag_Type is new DTag_Type with record
-       C3 : String (1 .. 5);
-    end record;
- 
-    procedure Proc (X : in out DDTag_Type);
- 
- end C460005_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C460005_0 is
- 
-    procedure Proc (X : in out Tag_Type) is
-    begin
-       X.C1 := 25;
-    end Proc;
- 
-    -----------------------------------------
-    procedure Proc (X : in out DTag_Type) is
-    begin
-       Proc ( Tag_Type(X) );
-       X.C2 := "Earth";
-    end Proc;
- 
-    -----------------------------------------
-    procedure Proc (X : in out DDTag_Type) is
-    begin
-       Proc ( DTag_Type(X) );
-       X.C3 := "Orbit";
-    end Proc;
- 
- end C460005_0;
- 
- 
-      --==================================================================--
- 
- 
- with C460005_0;
- use  C460005_0;
- 
- with Report;
- procedure C460005 is
- 
-    Tag_Type_Init    :  constant Tag_Type   := (C1 => 0);
-    DTag_Type_Init   :  constant DTag_Type  := (Tag_Type_Init with "Hello");
-    DDTag_Type_Init  :  constant DDTag_Type := (DTag_Type_Init with "World");
- 
-    Tag_Type_Value   :  constant Tag_Type   := (C1 => 25);
-    DTag_Type_Value  :  constant DTag_Type  := (Tag_Type_Value  with "Earth");
-    DDTag_Type_Value :  constant DDTag_Type := (DTag_Type_Value with "Orbit");
- 
-    Tag_Type_Res     :  constant Tag_Type   := (C1 => 25);
-    DTag_Type_Res    :  constant DTag_Type  := (Tag_Type_Res  with "Hello");
-    DDTag_Type_Res   :  constant DDTag_Type := (DTag_Type_Res with "World");
- 
- begin
- 
-    Report.Test ("C460005", "Check that, for a view conversion of a tagged " &
-                 "type that is the left side of an assignment statement, "   &
-                 "the assignment assigns to the corresponding part of the "  &
-                 "object denoted by the operand");
- 
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;               
-       begin
-          Tag_Type(Operand) := Tag_Type_Value;         
- 
-          if (Operand /= Tag_Type'Class (Tag_Type_Value)) then
-             Report.Failed ("Operand has wrong value: #01");
-          end if;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised: #01");
-          when others           => 
-             Report.Failed ("Unexpected exception: #01");
-       end CW_Proc;
- 
-    begin
-       CW_Proc (Tag_Type_Init);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;               
-       begin
-          DTag_Type(Operand) := DTag_Type_Value;
-          Report.Failed ("Constraint_Error not raised: #02"); 
- 
-       exception
-          when Constraint_Error => null;              -- expected exception
-          when others           => Report.Failed ("Unexpected exception: #02");
-       end CW_Proc;
- 
-    begin
-       CW_Proc (Tag_Type_Init);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;               
-       begin
-          DDTag_Type(Operand) := DDTag_Type_Value;
-          Report.Failed ("Constraint_Error not raised: #03"); 
- 
-       exception
-          when Constraint_Error => null;              -- expected exception
-          when others           => Report.Failed ("Unexpected exception: #03");
-       end CW_Proc;
- 
-    begin
-       CW_Proc (Tag_Type_Init);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;
-       begin
-          Tag_Type(Operand) := Tag_Type_Value;  
- 
-          if Operand not in DTag_Type then
-             Report.Failed ("Operand has wrong tag: #04");
-          elsif (Operand /= Tag_Type'Class (DTag_Type_Res)) 
-          then                                              -- Check to make 
-            Report.Failed ("Operand has wrong value: #04"); -- sure that C2 was
-          end if;                                           -- not modified.
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised: #04");
-          when others           => 
-             Report.Failed ("Unexpected exception: #04");
-       end CW_Proc;
- 
-    begin
-       CW_Proc (DTag_Type_Init);
-    end;
- 
-    ----------------------------------------------------------------------
- 
-    declare
-       procedure CW_Proc (P : Tag_Type'Class) is
-          Operand : Tag_Type'Class := P;
-       begin
-          Tag_Type(Operand) := Tag_Type_Value;         
- 
-          if Operand not in DDTag_Type then
-             Report.Failed ("Operand has wrong tag: #05");
-          elsif (Operand /= Tag_Type'Class (DDTag_Type_Res)) 
-          then                                              -- Check to make 
-            Report.Failed ("Operand has wrong value: #05"); -- sure that C2, C3
-          end if;                                           -- were not changed.
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised: #05");
-          when others           => 
-             Report.Failed ("Unexpected exception: #05");
-       end CW_Proc;
- 
-    begin
-       CW_Proc (DDTag_Type_Init);
-    end;
- 
-    Report.Result;
- 
- end C460005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,378 ****
- -- C460006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a view conversion to a tagged type is permitted in the 
- --      prefix of a selected component, an object renaming declaration, and 
- --      (if the operand is a variable) on the left side of an assignment 
- --      statement. Check that such a renaming or assignment does not change 
- --      the tag of the operand.
- --
- --      Check that, for a view conversion of a tagged type, each
- --      nondiscriminant component of the new view denotes the matching
- --      component of the operand object. Check that reading the value of the
- --      view yields the result of converting the value of the operand object
- --      to the target subtype.
- --
- -- TEST DESCRIPTION:
- --      The fact that the tag of an object is not changed is verified by
- --      making calls to primitive operations which in turn make (re)dispatching
- --      calls, and confirming that the proper bodies are executed.
- --
- --      Selected components are checked in three contexts: as the object name
- --      in an object renaming declaration, as the left operand of an inequality
- --      operation, and as the left side of an assignment statement.
- --
- --      View conversions of an object of a 2nd level type extension are
- --      renamed as objects of an ancestor type and of a class-wide type. In
- --      one case the operand of the conversion is itself a renaming of an
- --      object.
- --
- --      View conversions of an object of a 2nd level type extension are
- --      checked for equality with record aggregates of various ancestor types.
- --      In one case, the view conversion is to a class-wide type, and it is
- --      checked for equality with the result of a class-wide function with
- --      the following structure:
- --
- --         function F return T'Class is
- --            A : DDT     := Expected_Value;
- --            X : T'Class := T(A);
- --         begin
- --            return X;
- --
- --         end F;
- --
- --         ...
- --
- --         Var : DDT := Expected_Value;
- --
- --         if (T'Class(Var) /= F) then    -- Condition should yield FALSE.
- --            FAIL;
- --         end if;
- --
- --      The view conversion to which X is initialized does not affect the
- --      value or tag of the operand; the tag of X is that of type DDT (not T),
- --      and the components are those of A. The result of this function
- --      should equal the value of an object of type DDT initialized to the
- --      same value as F.A.
- --
- --      To check that assignment to a view conversion does not change the tag
- --      of the operand, an assignment is made to a conversion of an object,
- --      and the object is then passed as an actual to a dispatching operation.
- --      Conversions to both specific and class-wide types are checked.
- --
- --
- -- CHANGE HISTORY:
- --      20 Jul 95   SAIC    Initial prerelease version.
- --      24 Apr 96   SAIC    Added type conversions.
- --
- --!
- 
- package C460006_0 is
- 
-    type Call_ID_Kind is (None, Parent_Outer,     Parent_Inner,
-                                Child_Outer,      Child_Inner,
-                                Grandchild_Outer, Grandchild_Inner);
- 
-    type Root_Type is abstract tagged record
-       First_Call  : Call_ID_Kind := None;
-       Second_Call : Call_ID_Kind := None;
-    end record;
- 
-    procedure Inner_Proc (X : in out Root_Type) is abstract;
-    procedure Outer_Proc (X : in out Root_Type) is abstract;
- 
- end C460006_0;
- 
- 
-      --==================================================================--
- 
- 
- package C460006_0.C460006_1 is
- 
-    type Parent_Type is new Root_Type with record
-       C1 : Integer := 0;
-    end record;
- 
-    procedure Inner_Proc (X : in out Parent_Type);
-    procedure Outer_Proc (X : in out Parent_Type);
- 
- end C460006_0.C460006_1;
- 
- 
-      --==================================================================--
- 
- 
- package body C460006_0.C460006_1 is
- 
-    procedure Inner_Proc (X : in out Parent_Type) is
-    begin
-       X.Second_Call := Parent_Inner;
-    end Inner_Proc;
- 
-    -------------------------------------------------
-    procedure Outer_Proc (X : in out Parent_Type) is
-    begin
-       X.First_Call := Parent_Outer;
-       Inner_Proc ( Parent_Type'Class(X) );
-    end Outer_Proc;
- 
- end C460006_0.C460006_1;
- 
- 
-      --==================================================================--
- 
- 
- package C460006_0.C460006_1.C460006_2 is
- 
-    type Child_Type is new Parent_Type with record
-       C2 : String(1 .. 5) := "-----";
-    end record;
- 
-    procedure Inner_Proc (X : in out Child_Type);
-    procedure Outer_Proc (X : in out Child_Type);
- 
- end C460006_0.C460006_1.C460006_2;
- 
- 
-      --==================================================================--
- 
- 
- package body C460006_0.C460006_1.C460006_2 is
- 
-    procedure Inner_Proc (X : in out Child_Type) is
-    begin
-       X.Second_Call := Child_Inner;
-    end Inner_Proc;
- 
-    -------------------------------------------------
-    procedure Outer_Proc (X : in out Child_Type) is
-    begin
-       X.First_Call := Child_Outer;
-       Inner_Proc ( Parent_Type'Class(X) );
-    end Outer_Proc;
- 
- end C460006_0.C460006_1.C460006_2;
- 
- 
-      --==================================================================--
- 
- 
- package C460006_0.C460006_1.C460006_2.C460006_3 is
- 
-    type Grandchild_Type is new Child_Type with record
-       C3: String(1 .. 5) := "-----";
-    end record;
- 
-    procedure Inner_Proc (X : in out Grandchild_Type);
-    procedure Outer_Proc (X : in out Grandchild_Type);
- 
- 
-    function ClassWide_Func return Parent_Type'Class;
- 
- 
-    Grandchild_Value : constant Grandchild_Type := (First_Call  => None,
-                                                    Second_Call => None,
-                                                    C1          => 15,
-                                                    C2          => "Hello",
-                                                    C3          => "World");
- 
- end C460006_0.C460006_1.C460006_2.C460006_3;
- 
- 
-      --==================================================================--
- 
- 
- package body C460006_0.C460006_1.C460006_2.C460006_3 is
- 
-    procedure Inner_Proc (X : in out Grandchild_Type) is
-    begin
-       X.Second_Call := Grandchild_Inner;
-    end Inner_Proc;
- 
-    -------------------------------------------------
-    procedure Outer_Proc (X : in out Grandchild_Type) is
-    begin
-       X.First_Call := Grandchild_Outer;
-       Inner_Proc ( Parent_Type'Class(X) );
-    end Outer_Proc;
- 
-    -------------------------------------------------
-    function ClassWide_Func return Parent_Type'Class is
-       A : Grandchild_Type   := Grandchild_Value;
-       X : Parent_Type'Class := Parent_Type(A); -- Value of X is still that of A.
-    begin
-       return X;
-    end ClassWide_Func;
- 
- end C460006_0.C460006_1.C460006_2.C460006_3;
- 
- 
-      --==================================================================--
- 
- 
- with C460006_0.C460006_1.C460006_2.C460006_3;
- 
- with Report;
- procedure C460006 is
- 
-    package Root_Package       renames C460006_0;
-    package Parent_Package     renames C460006_0.C460006_1;
-    package Child_Package      renames C460006_0.C460006_1.C460006_2;
-    package Grandchild_Package renames C460006_0.C460006_1.C460006_2.C460006_3;
- 
- begin
-    Report.Test ("C460006", "Check that a view conversion to a tagged type " &
-                 "is permitted in the prefix of a selected component, an "   &
-                 "object renaming declaration, and (if the operand is a "    &
-                 "variable) on the left side of an assignment statement.  "  &
-                 "Check that such a renaming or assignment does not change " &
-                 " the tag of the operand");
- 
- 
-    --
-    -- Check conversion as prefix of selected component:
-    --
- 
-    Selected_Component_Subtest:
-    declare
-       use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
- 
-       Var    : Grandchild_Type   := Grandchild_Value;
-       CW_Var : Parent_Type'Class := Var;
- 
-       Ren    : Integer renames Parent_Type(Var).C1;
- 
-    begin
-       if Ren /= 15 then
-          Report.Failed ("Wrong value: selected component in renaming");
-       end if;
- 
-       if Child_Type(Var).C2 /= "Hello" then
-          Report.Failed ("Wrong value: selected component in IF");
-       end if;
- 
-       Grandchild_Type(CW_Var).C3(2..4) := "eir";
-       if CW_Var /= Parent_Type'Class
-                    (Grandchild_Type'(None, None, 15, "Hello", "Weird"))
-       then
-          Report.Failed ("Wrong value: selected component in assignment");
-       end if;
-    end Selected_Component_Subtest;
- 
- 
-    --
-    -- Check conversion in object renaming:
-    --
- 
-    Object_Renaming_Subtest:
-    declare
-       use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
- 
-       Var : Grandchild_Type := Grandchild_Value;
-       Ren1 : Parent_Type       renames Parent_Type(Var);
-       Ren2 : Child_Type        renames Child_Type(Var);
-       Ren3 : Parent_Type'Class renames Parent_Type'Class(Var);
-       Ren4 : Parent_Type       renames Parent_Type(Ren2); -- Rename of rename.
-    begin
-       Outer_Proc (Ren1);
-       if Ren1 /= (Parent_Outer, Grandchild_Inner, 15) then
-          Report.Failed ("Value or tag not preserved by object renaming: Ren1");
-       end if;
- 
-       Outer_Proc (Ren2);
-       if Ren2 /= (Child_Outer, Grandchild_Inner, 15, "Hello") then
-          Report.Failed ("Value or tag not preserved by object renaming: Ren2");
-       end if;
- 
-       Outer_Proc (Ren3);
-       if Ren3 /= Parent_Type'Class
-                  (Grandchild_Type'(Grandchild_Outer,
-                                    Grandchild_Inner,
-                                    15,
-                                    "Hello",
-                                    "World"))
-       then
-          Report.Failed ("Value or tag not preserved by object renaming: Ren3");
-       end if;
- 
-       Outer_Proc (Ren4);
-       if Ren4 /= (Parent_Outer, Grandchild_Inner, 15) then
-          Report.Failed ("Value or tag not preserved by object renaming: Ren4");
-       end if;
-    end Object_Renaming_Subtest;
- 
- 
-    --
-    -- Check reading view conversion, and conversion as left side of assignment:
-    --
- 
-    View_Conversion_Subtest:
-    declare
-       use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
- 
-       Var : Grandchild_Type := Grandchild_Value;
-       Specific  : Child_Type;
-       ClassWide : Parent_Type'Class := Var;   -- Grandchild_Type tag.
-    begin
-       if Parent_Type(Var) /= (None, None, 15) then
-          Report.Failed ("View has wrong value: #1");
-       end if;
- 
-       if Child_Type(Var) /= (None, None, 15, "Hello") then
-          Report.Failed ("View has wrong value: #2");
-       end if;
- 
-       if Parent_Type'Class(Var) /= ClassWide_Func then
-          Report.Failed ("Upward view conversion did not preserve " &
-                         "extension's components");
-       end if;
- 
- 
-       Parent_Type(Specific) := (None, None, 26); -- Assign to view.
-       Outer_Proc (Specific);                     -- Call dispatching op.
- 
-       if Specific /= (Child_Outer, Child_Inner, 26, "-----") then
-          Report.Failed ("Value or tag not preserved by assignment: Specific");
-       end if;
- 
- 
-       Parent_Type(ClassWide) := (None, None, 44); -- Assign to view.
-       Outer_Proc (ClassWide);                     -- Call dispatching op.
- 
-       if ClassWide /= Parent_Type'Class
-                       (Grandchild_Type'(Grandchild_Outer,
-                                         Grandchild_Inner,
-                                         44,
-                                         "Hello",
-                                         "World"))
-       then
-          Report.Failed ("Value or tag not preserved by assignment: ClassWide");
-       end if;
-    end View_Conversion_Subtest;
- 
-    Report.Result;
- 
- end C460006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,239 ****
- -- C460007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, in a numeric type conversion, if the target type is an
- --      integer type and the operand type is real, the result is rounded
- --      to the nearest integer, and away from zero if the result is exactly
- --      halfway between two integers. Check for static and non-static type
- --      conversions.
- --
- -- TEST DESCRIPTION:
- --      The following cases are considered:
- --
- --          X.5    X.5 + delta   -X.5 + delta
- --         -X.5    X.5 - delta   -X.5 - delta
- --
- --      Both zero and non-zero values are used for X. The value of delta is
- --      chosen to be a very small increment (on the order of 1.0E-10). For
- --      fixed and floating point cases, the value of delta is chosen such that
- --      "(-)X.5 +(-) delta" is a multiple of the small, or a machine number,
- --      respectively.
- --
- --      The following type conversions are performed:
- --
- --      ID   Real operand            Cases          Target integer subtype
- --      ------------------------------------------------------------------
- --       1   Real named number        X.5           Nonstatic
- --       2                            X.5 - delta   Nonstatic
- --       3                           -X.5 - delta   Static
- --       4   Real literal            -X.5           Static
- --       5                            X.5 + delta   Static
- --       6                           -X.5 + delta   Nonstatic
- --       7   Floating point object   -X.5 - delta   Nonstatic
- --       8                            X.5 - delta   Static
- --       9   Fixed point object       X.5           Static
- --      10                            X.5 + delta   Static
- --      11                           -X.5 + delta   Nonstatic
- --      The conversion is either assigned to a variable of the target subtype
- --      or passed as a parameter to a subprogram (both nonstatic contexts).
- --
- --      The subprogram Equal is used to circumvent potential optimizations.
- --
- --
- -- CHANGE HISTORY:
- --      03 Oct 95   SAIC    Initial prerelease version.
- --
- --!
- 
- with System;
- package C460007_0 is
- 
- --
- -- Target integer subtype (static):
- --
- 
-    type Static_Integer_Subtype is range -32_000 .. 32_000;
- 
-    Static_Target : Static_Integer_Subtype;
- 
-    function Equal (L, R: Static_Integer_Subtype) return Boolean;
- 
- 
- --
- -- Named numbers:
- --
- 
-    NN_Half      : constant := 0.5000000000;
-    NN_Less_Half : constant := 126.4999999999;
-    NN_More_Half : constant := -NN_Half - 0.0000000001;
- 
- 
- --
- -- Floating point:
- --
- 
-    type My_Float is digits System.Max_Digits;
- 
-    Flt_Rnd_Toward_Zero :          My_Float := My_Float'Pred(NN_Half);
-    Flt_Rnd_Away_Zero   : constant My_Float := My_Float'Pred(-113.5);
- 
- 
- --
- -- Fixed point:
- --
- 
-    type My_Fixed is delta 0.1 range -5.0 .. 5.0;
- 
-    Fix_Half            :          My_Fixed := 0.5;
-    Fix_Rnd_Away_Zero   :          My_Fixed := Fix_Half + My_Fixed'Small;
-    Fix_Rnd_Toward_Zero : constant My_Fixed := -3.5 + My_Fixed'Small;
- 
- end C460007_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C460007_0 is
- 
-    function Equal (L, R: Static_Integer_Subtype) return Boolean is
-    begin
-       return (L = R);
-    end Equal;
- 
- end C460007_0;
- 
- 
-      --==================================================================--
- 
- 
- with C460007_0;
- use  C460007_0;
- 
- with Report;
- procedure C460007 is
- 
- --
- -- Target integer subtype (nonstatic):
- --
- 
-    Limit : Static_Integer_Subtype :=
-            Static_Integer_Subtype(Report.Ident_Int(128));
- 
-    subtype Nonstatic_Integer_Subtype is Static_Integer_Subtype
-      range -Limit .. Limit;
- 
-    Nonstatic_Target : Static_Integer_Subtype;
- 
- begin
- 
-    Report.Test ("C460007", "Rounding for type conversions of real operand " &
-                 "to integer target");
- 
- 
-    -- --------------------------
-    -- Named number/literal cases:
-    -- --------------------------
- 
-    Nonstatic_Target := Nonstatic_Integer_Subtype(NN_Half);
-    
-    if not Equal(Nonstatic_Target, 1) then                           -- Case 1.
-       Report.Failed ("Wrong result for named number operand" &
-                      "(case 1), nonstatic target subtype");
-    end if;
- 
-    if not Equal(Nonstatic_Integer_Subtype(NN_Less_Half), 126) then  -- Case 2. 
-       Report.Failed ("Wrong result for named number operand" &
-                      "(case 2), nonstatic target subtype");
-    end if;
- 
-    Static_Target := Static_Integer_Subtype(NN_More_Half);
-    
-    if not Equal(Static_Target, -1) then                             -- Case 3.
-       Report.Failed ("Wrong result for named number operand" &
-                      "(case 3), static target subtype");
-    end if;
- 
-    if not Equal(Static_Integer_Subtype(-0.50), -1) then             -- Case 4.
-       Report.Failed ("Wrong result for literal operand" &
-                      "(case 4), static target subtype");
-    end if;
- 
-    if not Equal(Static_Integer_Subtype(29_546.5001), 29_547) then   -- Case 5.
-       Report.Failed ("Wrong result for literal operand" &
-                      "(case 5), static target subtype");
-    end if;
- 
-    if not Equal(Nonstatic_Integer_Subtype(-66.499), -66) then       -- Case 6.
-       Report.Failed ("Wrong result for literal operand" &
-                      "(case 6), nonstatic target subtype");
-    end if;
- 
- 
-    -- --------------------
-    -- Floating point cases:
-    -- --------------------
- 
-    Nonstatic_Target := Nonstatic_Integer_Subtype(Flt_Rnd_Away_Zero);
- 
-    if not Equal(Nonstatic_Target, -114) then                        -- Case 7.
-       Report.Failed ("Wrong result for floating point operand" &
-                      "(case 7), nonstatic target subtype");
-    end if;
-                                                                     -- Case 8.
-    if not Equal(Static_Integer_Subtype(Flt_Rnd_Toward_Zero), 0) then
-       Report.Failed ("Wrong result for floating point operand" &
-                      "(case 8), static target subtype");
-    end if;
- 
- 
-    -- -----------------
-    -- Fixed point cases:
-    -- -----------------
- 
-    Static_Target := Static_Integer_Subtype(Fix_Half);
- 
-    if not Equal(Static_Target, 1) then                              -- Case 9.
-       Report.Failed ("Wrong result for fixed point operand" &
-                      "(case 9), static target subtype");
-    end if;
- 
-    if not Equal(Static_Integer_Subtype(Fix_Rnd_Away_Zero), 1) then  -- Case 10.
-       Report.Failed ("Wrong result for fixed point operand" &
-                      "(case 10), static target subtype");
-    end if;
- 
-    Nonstatic_Target := Nonstatic_Integer_Subtype(Fix_Rnd_Toward_Zero);
- 
-    if not Equal(Nonstatic_Target, -3) then                          -- Case 11.
-       Report.Failed ("Wrong result for fixed point operand" &
-                      "(case 11), nonstatic target subtype");
-    end if;
- 
- 
-    Report.Result;
- 
- end C460007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,286 ****
- -- C460008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that conversion to a modular type raises Constraint_Error
- --     when the operand value is outside the base range of the modular type.
- --
- -- TEST DESCRIPTION:
- --      Test conversion from integer, float, fixed and decimal types to
- --      modular types.  Test conversion to mod 255, mod 256 and mod 258
- --      to test the boundaries of 8 bit (+/-) unsigned numbers.
- --      Test operand values that are negative, the value of the mod,
- --      and greater than the value of the mod.
- --      Declare a generic test procedure and instantiate it for each of the
- --      unsigned types for each operand type.
- --
- --
- -- CHANGE HISTORY:
- --      04 OCT 95   SAIC   Initial version
- --      15 MAY 96   SAIC   Revised for 2.1
- --      24 NOV 98   RLB    Moved decimal cases into new test, C460011, to
- --                         prevent this test from being inapplicable to
- --                         implementations not supporting decimal types.
- --
- --!
- 
- ------------------------------------------------------------------- C460008
- 
- with Report;
- 
- procedure C460008 is
- 
-   Shy_By_One   : constant := 2**8-1;
-   Heavy_By_Two : constant := 2**8+2;
- 
-   type Unsigned_Edge_8 is mod Shy_By_One;
-   type Unsigned_8_Bit  is mod 2**8;
-   type Unsigned_Over_8 is mod Heavy_By_Two;
- 
-   NPC : constant String := " not properly converted";
- 
-   procedure Assert( Truth: Boolean; Message: String ) is
-   begin
-     if not Truth then
-       Report.Failed(Message);
-     end if;
-   end Assert;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   generic
-     type Source is range <>;
-     type Target is mod <>;
-   procedure Integer_Conversion_Check( For_The_Value : Source;
-                                       Message       : String );
- 
-   procedure Integer_Conversion_Check( For_The_Value : Source;
-                                       Message       : String ) is
- 
-     Item : Target;
- 
-   begin
-     Item := Target( For_The_Value );
-     Report.Failed("Int expected Constraint_Error " & Message);
-     -- the call to Comment is to make the otherwise dead assignment to
-     -- Item live.
-     -- To avoid invoking C_E on a call to 'Image in Report.Failed that
-     -- could cause a false pass
-    Report.Comment("Value of" & Target'Image(Item) & NPC);
-   exception
-     when Constraint_Error => null; -- expected case
-     when others => Report.Failed("Int Raised wrong exception " & Message);
-   end Integer_Conversion_Check;
- 
-   procedure Int_To_Short is
-     new Integer_Conversion_Check( Integer, Unsigned_Edge_8 );
- 
-   procedure Int_To_Eight is
-     new Integer_Conversion_Check( Integer, Unsigned_8_Bit );
- 
-   procedure Int_To_Wide is
-     new Integer_Conversion_Check( Integer, Unsigned_Over_8 );
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   generic
-     type Source is digits <>;
-     type Target is mod <>;
-   procedure Float_Conversion_Check( For_The_Value : Source;
-                                     Message       : String );
- 
-   procedure Float_Conversion_Check( For_The_Value : Source;
-                                     Message       : String ) is
- 
-     Item : Target;
- 
-   begin
-     Item := Target( For_The_Value );
-     Report.Failed("Flt expected Constraint_Error " & Message);
-     Report.Comment("Value of" & Target'Image(Item) & NPC);
-   exception
-     when Constraint_Error => null; -- expected case
-     when others => Report.Failed("Flt raised wrong exception " & Message);
-   end Float_Conversion_Check;
- 
-   procedure Float_To_Short is
-     new Float_Conversion_Check( Float, Unsigned_Edge_8 );
- 
-   procedure Float_To_Eight is
-     new Float_Conversion_Check( Float, Unsigned_8_Bit );
- 
-   procedure Float_To_Wide is
-     new Float_Conversion_Check( Float, Unsigned_Over_8 );
- 
-   function Identity( Root_Beer: Float ) return Float is
-     -- a knockoff of Report.Ident_Int for type Float
-     Nothing : constant Float := 0.0;
-   begin
-     if Report.Ident_Bool( Root_Beer = Nothing ) then
-       return Nothing;
-     else
-       return Root_Beer;
-     end if;
-   end Identity;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   generic
-     type Source is delta <>;
-     type Target is mod <>;
-   procedure Fixed_Conversion_Check( For_The_Value : Source;
-                                     Message       : String );
- 
-   procedure Fixed_Conversion_Check( For_The_Value : Source;
-                                     Message       : String ) is
- 
-     Item : Target;
- 
-   begin
-     Item := Target( For_The_Value );
-     Report.Failed("Fix expected Constraint_Error " & Message);
-     Report.Comment("Value of" & Target'Image(Item) & NPC);
-   exception
-     when Constraint_Error => null; -- expected case
-     when others => Report.Failed("Fix raised wrong exception " & Message);
-   end Fixed_Conversion_Check;
- 
-   procedure Fixed_To_Short is
-     new Fixed_Conversion_Check( Duration, Unsigned_Edge_8 );
- 
-   procedure Fixed_To_Eight is
-     new Fixed_Conversion_Check( Duration, Unsigned_8_Bit );
- 
-   procedure Fixed_To_Wide is
-     new Fixed_Conversion_Check( Duration, Unsigned_Over_8 );
- 
-   function Identity( A_Stitch: Duration ) return Duration is
-     Threadbare : constant Duration := 0.0;
-   begin
-     if Report.Ident_Bool( A_Stitch = Threadbare ) then
-       return Threadbare;
-     else
-       return A_Stitch;
-     end if;
-   end Identity;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C460008", "Check that conversion to " &
-                           "a modular type raises Constraint_Error when " &
-                           "the operand value is outside the base range " &
-                           "of the modular type" );
- 
- 
-   -- Integer Error cases
- 
-   Int_To_Short( Report.Ident_Int( -1 ), "I2S Dynamic, Negative" );
-   Int_To_Short( Report.Ident_Int( Shy_By_One ), "I2S Dynamic, At_Mod" );
-   Int_To_Short( Report.Ident_Int( Heavy_By_Two+1 ), "I2S Dynamic, Over_Mod" );
- 
-   Int_To_Eight( -Shy_By_One, "I28 Static,  Negative" );
-   Int_To_Eight( 2**8, "I28 Static,  At_Mod" );
-   Int_To_Eight( Heavy_By_Two+1, "I28 Static,  Over_Mod" );
- 
-   Int_To_Wide ( Report.Ident_Int( -(Heavy_By_Two*2) ),
-                 "I2W Dynamic, Negative" );
-   Int_To_Wide ( Heavy_By_Two, "I2W Static,  At_Mod" );
-   Int_To_Wide ( Report.Ident_Int( Heavy_By_Two*2 ), "I2W Dynamic, Over_Mod" );
- 
-   -- Float Error cases
- 
-   Float_To_Short( -13.31, "F2S Static,  Negative" );
-   Float_To_Short( Identity ( Float(Shy_By_One)), "F2S Dynamic, At_Mod" );
-   Float_To_Short( 6378.388, "F2S Static,  Over_Mod" );
- 
-   Float_To_Eight( Identity( -99.3574 ), "F28 Dynamic, Negative" );
-   Float_To_Eight( 2.0**8, "F28 Static,  At_Mod" );
-   Float_To_Eight( 2.0**9, "F28 Static,  Over_Mod" );
- 
-   Float_To_Wide ( -0.54953_93129_81644, "FTW Static,  Negative" );
-   Float_To_Wide ( Identity( 2.0**8 +2.0 ), "FTW Dynamic, At_Mod" );
-   Float_To_Wide ( Identity( 2.0**8 +2.5001 ), "FTW Dynamic, Over_Mod" );
-   Float_To_Wide ( Identity( Float'Last ), "FTW Dynamic, Over_Mod" );
- 
-   -- Fixed Error cases
- 
-   Fixed_To_Short( Identity( -5.00 ), "D2S Dynamic, Negative" );
-   Fixed_To_Short( Shy_By_One * 1.0, "D2S Static,  At_Mod" );
-   Fixed_To_Short( 1995.9, "D2S Static,  Over_Mod" );
- 
-   Fixed_To_Eight( -0.5, "D28 Static, Negative" );
-   Fixed_To_Eight( 2.0*128, "D28 Static,  At_Mod" );
-   Fixed_To_Eight( Identity( 2001.2 ), "D28 Dynamic, Over_Mod" );
- 
-   Fixed_To_Wide ( Duration'First, "D2W Static,  Negative" );
-   Fixed_To_Wide ( Identity( 2*128.0 +2.0 ), "D2W Dynamic, At_Mod" );
-   Fixed_To_Wide ( Duration'Last, "D2W Static,  Over_Mod" );
- 
-   -- having made it this far, the rest is downhill...
-   -- check a few, correct, edge cases, and we're done
- 
-   Eye_Dew: declare
-     A_Float   : Float    := 0.0;
-     Your_Time : Duration := 0.0;
-     Number    : Integer  := 0;
- 
-     Little   : Unsigned_Edge_8;
-     Moderate : Unsigned_8_Bit;
-     Big      : Unsigned_Over_8;
- 
-   begin
-     Little := Unsigned_Edge_8(A_Float);
-     Assert( Little = 0, "Float => Little, 0");
- 
- 
-     Moderate := Unsigned_8_Bit (Your_Time);
-     Assert( Moderate = 0, "Your_Time => Moderate, 0");
- 
-     Big := Unsigned_Over_8 (Number);
-     Assert( Big = 0, "Number => Big, 0");
- 
-     A_Float   := 2.0**8-2.0;
-     Your_Time := 2.0*128-2.0;
-     Number    := 2**8;
- 
-     Little := Unsigned_Edge_8(A_Float);
-     Assert( Little = 254, "Float => Little, 254");
- 
-     Little := Unsigned_Edge_8(Your_Time);
-     Assert( Little = 254, "Your_Time => Little, 254");
- 
-     Big := Unsigned_Over_8 (A_Float + 2.0);
-     Assert( Big = 256, "Sense => Big, 256");
- 
-     Big := Unsigned_Over_8 (Number);
-     Assert( Big = 256, "Number => Big, 256");
- 
-   end Eye_Dew;
- 
-   Report.Result;
- 
- end C460008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,467 ****
- -- C460009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that Constraint_Error is raised in cases of null arrays when:
- --     1.  an assignment is made to a null array if the length of each
- --         dimension of the operand does not match the length of 
- --         the corresponding dimension of the target subtype.
- --     2.  an array actual parameter does not match the length of
- --         corresponding dimensions of the formal in out parameter where
- --         the actual parameter has the form of a type conversion.     
- --     3.  an array actual parameter does not match the length of
- --         corresponding dimensions of the formal out parameter where
- --         the actual parameter has the form of a type conversion.     
- --
- -- TEST DESCRIPTION:
- --      This transition test creates examples where array of null ranges 
- --      raises Constraint_Error if any of the lengths mismatch.
- --
- --      Inspired by C52103S.ADA, C64105E.ADA, and C64105F.ADA.
- --
- --
- -- CHANGE HISTORY:
- --      21 Mar 96   SAIC    Initial version for ACVC 2.1.
- --      21 Sep 96   SAIC    ACVC 2.1: Added new case.
- --
- --!
- 
- with Report;
- 
- procedure C460009 is
- 
-    subtype Int is Integer range 1 .. 3;
- 
- begin
- 
-    Report.Test("C460009","Check that Constraint_Error is raised in "  &
-                "cases of null arrays if any of the lengths mismatch " & 
-                "in assignments and parameter passing");
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Arr_Int1 is array (Int range <>) of Integer;
-       Arr_Obj1 : Arr_Int1 (2 .. Report.Ident_Int(1));     -- null array object
- 
-    begin
- 
-       -- Same lengths, no Constraint_Error raised.
-       Arr_Obj1 := (Report.Ident_Int(3) .. 2 => Report.Ident_Int(1));
- 
-       Report.Comment ("Dead assignment prevention in Arr_Obj1 => " &
-                        Integer'Image (Arr_Obj1'Last));
- 
-    exception
- 
-       when Constraint_Error => 
-         Report.Failed ("Arr_Obj1 - Constraint_Error exception raised");
-       when others           => 
-         Report.Failed ("Arr_Obj1 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Arr_Int2 is array (Int range <>, Int range <>) of Integer;
-       Arr_Obj2 : Arr_Int2 (1 .. Report.Ident_Int(2), 
-                            Report.Ident_Int(3) .. Report.Ident_Int(2));
-                                                            -- null array object
-    begin
- 
-       -- Same lengths, no Constraint_Error raised.
-       Arr_Obj2 := Arr_Int2'(Report.Ident_Int(2) .. 3 => 
-                   (Report.Ident_Int(2) .. Report.Ident_Int(1) =>  
-                    Report.Ident_Int(1)));
- 
-       Report.Comment ("Dead assignment prevention in Arr_Obj2 => " &
-                        Integer'Image (Arr_Obj2'Last));
- 
-    exception
- 
-       when Constraint_Error => 
-         Report.Failed ("Arr_Obj2 - Constraint_Error exception raised");
-       when others           => 
-         Report.Failed ("Arr_Obj2 - others exception raised");
- 
-    end;
-    
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Arr_Int3 is array (Int range <>, Int range <>) of Integer;
-       Arr_Obj3 : Arr_Int3 (1 .. Report.Ident_Int(2), 
-                            Report.Ident_Int(3) .. Report.Ident_Int(2));
-                                                            -- null array object
- 
-    begin
- 
-       -- Lengths mismatch, Constraint_Error raised.
-       Arr_Obj3 := Arr_Int3'(Report.Ident_Int(3) .. 2 => 
-                   (Report.Ident_Int(1) .. Report.Ident_Int(3) =>  
-                    Report.Ident_Int(1)));
- 
-       Report.Comment ("Dead assignment prevention in Arr_Obj3 => " &
-                        Integer'Image (Arr_Obj3'Last));
- 
-       Report.Failed ("Constraint_Error not raised in Arr_Obj3");
- 
-    exception
- 
-       when Constraint_Error => null;      -- exception expected.
-       when others           => 
-         Report.Failed ("Arr_Obj3 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Arr_Int4 is array (Int range <>, Int range <>, Int range <>) of 
-         Integer;
-       Arr_Obj4 : Arr_Int4 (1 .. Report.Ident_Int(2), 
-                            Report.Ident_Int(1) .. Report.Ident_Int(3),
-                            Report.Ident_Int(3) .. Report.Ident_Int(2));
-                                                            -- null array object
-    begin
- 
-       -- Lengths mismatch, Constraint_Error raised.
-       Arr_Obj4 := Arr_Int4'(Report.Ident_Int(1) .. 3 => 
-                   (Report.Ident_Int(1) .. Report.Ident_Int(2) =>  
-                    (Report.Ident_Int(3) .. Report.Ident_Int(2) =>  
-                    Report.Ident_Int(1))));
- 
-       Report.Comment ("Dead assignment prevention in Arr_Obj4 => " &
-                        Integer'Image (Arr_Obj4'Last));
- 
-       Report.Failed ("Constraint_Error not raised in Arr_Obj4");
- 
-    exception
- 
-       when Constraint_Error => null;      -- exception expected.
-       when others           => 
-         Report.Failed ("Arr_Obj4 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Arr_Int5 is array (Int range <>) of Integer;
-       Arr_Obj5 : Arr_Int5 (2 .. Report.Ident_Int(1));     -- null array object
- 
-    begin
- 
-       -- Only lengths of two null ranges are different, no Constraint_Error 
-       -- raised.
-       Arr_Obj5 := (Report.Ident_Int(3) .. 1 => Report.Ident_Int(1));
- 
-       Report.Comment ("Dead assignment prevention in Arr_Obj5 => " &
-                        Integer'Image (Arr_Obj5'Last));
- 
-    exception
- 
-       when Constraint_Error => 
-         Report.Failed ("Arr_Obj5 - Constraint_Error exception raised");
-       when others           => 
-         Report.Failed ("Arr_Obj5 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
-       subtype Str is String (Report.Ident_Int(5) .. 4);  
-                                                             -- null string
-       Str_Obj : Str;
- 
-    begin
- 
-       -- Same lengths, no Constraint_Error raised.
-       Str_Obj := (Report.Ident_Int(1) .. 0 => 'Z');
-       Str_Obj(2 .. 1) := "";
-       Str_Obj(4 .. 2) := (others => 'X');
-       Str_Obj(Report.Ident_Int(6) .. 3) := "";
-       Str_Obj(Report.Ident_Int(0) .. Report.Ident_Int(-1)) := (others => 'Y');
- 
-    exception
- 
-       when Constraint_Error => 
-         Report.Failed ("Str_Obj - Constraint_Error exception raised");
-       when others           => 
-         Report.Failed ("Str_Obj - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Arr_Char5 is array (Int range <>, Int range <>) of Character;
-       subtype Formal is Arr_Char5 
-         (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));  
-       Arr_Obj5 : Arr_Char5 (Report.Ident_Int(2) .. Report.Ident_Int(1),
-                             Report.Ident_Int(1) .. Report.Ident_Int(2))
-                := (Report.Ident_Int(2) .. Report.Ident_Int(1) =>
-                   (Report.Ident_Int(1) .. Report.Ident_Int(2) => ' ')); 
- 
-       procedure Proc5 (P : in out Formal) is
-       begin
-          Report.Failed ("No exception raised in Proc5");
- 
-       exception       
- 
-          when Constraint_Error => 
-            Report.Failed ("Constraint_Error exception raised in Proc5");
-          when others           => 
-            Report.Failed ("Others exception raised in Proc5");
-       end;            
- 
-    begin
- 
-       -- Lengths mismatch in the type conversion, Constraint_Error raised.
-       Proc5 (Formal(Arr_Obj5));
- 
-       Report.Failed ("Constraint_Error not raised in the call Proc5");
- 
-    exception
- 
-       when Constraint_Error => null;      -- exception expected.
-       when others           => 
-         Report.Failed ("Arr_Obj5 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Formal is array 
-         (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
- 
-       type Actual is array 
-         (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
- 
-       Arr_Obj6 : Actual := (5 .. 3 => (3 .. 5 => ' '));
- 
-       procedure Proc6 (P : in out Formal) is
-       begin
-          Report.Failed ("No exception raised in Proc6");
- 
-       exception       
- 
-          when Constraint_Error => 
-            Report.Failed ("Constraint_Error exception raised in Proc6");
-          when others           => 
-            Report.Failed ("Others exception raised in Proc6");
-       end;            
- 
-    begin
- 
-       -- Lengths mismatch in the type conversion, Constraint_Error raised.
-       Proc6 (Formal(Arr_Obj6));
- 
-       Report.Failed ("Constraint_Error not raised in the call Proc6");
- 
-    exception
- 
-       when Constraint_Error => null;      -- exception expected.
-       when others           => 
-         Report.Failed ("Arr_Obj6 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Formal is array (Int range <>, Int range <>) of Character;
-       type Actual is array (Positive range 5 .. 2,
-                             Positive range 1 .. 3) of Character;
- 
-       Arr_Obj7 : Actual := (5 .. 2 => (1 .. 3 => ' '));
- 
-       procedure Proc7 (P : in out Formal) is
-       begin
-          if P'Last /= 2 and P'Last(2) /= 3 then
-             Report.Failed ("Wrong bounds passed for Arr_Obj7");
-          end if;
- 
-          -- Lengths mismatch, Constraint_Error raised.
-          P := (1 .. 3 => (3 .. 0 => ' '));
- 
-          Report.Comment ("Dead assignment prevention in Proc7 => " &
-                           Integer'Image (P'Last));
- 
-          Report.Failed ("No exception raised in Proc7");
- 
-       exception       
- 
-          when Constraint_Error => null;      -- exception expected.
-          when others           => 
-            Report.Failed ("Others exception raised in Proc7");
-       end;            
- 
-    begin
- 
-       -- Same lengths, no Constraint_Error raised.
-       Proc7 (Formal(Arr_Obj7));
- 
-       if Arr_Obj7'Last /= 2 and Arr_Obj7'Last(2) /= 3 then
-          Report.Failed ("Bounds changed for Arr_Obj7");
-       end if;
- 
-    exception
- 
-       when Constraint_Error => 
-         Report.Failed ("Constraint_Error exception raised after call Proc7");
-       when others           => 
-         Report.Failed ("Arr_Obj7 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Arr_Char8 is array (Int range <>, Int range <>) of Character;
-       subtype Formal is Arr_Char8 
-         (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));  
-       Arr_Obj8 : Arr_Char8 (Report.Ident_Int(2) .. Report.Ident_Int(1),
-                             Report.Ident_Int(1) .. Report.Ident_Int(2));
- 
-       procedure Proc8 (P : out Formal) is
-       begin
-          Report.Failed ("No exception raised in Proc8");
- 
-       exception       
- 
-          when Constraint_Error => 
-            Report.Failed ("Constraint_Error exception raised in Proc8");
-          when others           => 
-            Report.Failed ("Others exception raised in Proc8");
-       end;            
- 
-    begin
- 
-       -- Lengths mismatch in the type conversion, Constraint_Error raised.
-       Proc8 (Formal(Arr_Obj8));
- 
-       Report.Failed ("Constraint_Error not raised in the call Proc8");
- 
-    exception
- 
-       when Constraint_Error => null;      -- exception expected.
-       when others           => 
-         Report.Failed ("Arr_Obj8 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Formal is array 
-         (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
- 
-       type Actual is array 
-         (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
- 
-       Arr_Obj9 : Actual;
- 
-       procedure Proc9 (P : out Formal) is
-       begin
-          Report.Failed ("No exception raised in Proc9");
- 
-       exception       
- 
-          when Constraint_Error => 
-            Report.Failed ("Constraint_Error exception raised in Proc9");
-          when others           => 
-            Report.Failed ("Others exception raised in Proc9");
-       end;            
- 
-    begin
- 
-       -- Lengths mismatch in the type conversion, Constraint_Error raised.
-       Proc9 (Formal(Arr_Obj9));
- 
-       Report.Failed ("Constraint_Error not raised in the call Proc9");
- 
-    exception
- 
-       when Constraint_Error => null;      -- exception expected.
-       when others           => 
-         Report.Failed ("Arr_Obj9 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    declare
- 
-       type Formal is array (Int range <>, Int range <>) of Character;
-       type Actual is array (Positive range 5 .. 2,
-                             Positive range 1 .. 3) of Character;
- 
-       Arr_Obj10 : Actual;
- 
-       procedure Proc10 (P : out Formal) is
-       begin
-          if P'Last /= 2 and P'Last(2) /= 3 then
-             Report.Failed ("Wrong bounds passed for Arr_Obj10");
-          end if;
- 
-          -- Lengths mismatch, Constraint_Error raised.
-          P := (1 .. 3 => (3 .. 1 => ' '));
- 
-          Report.Comment ("Dead assignment prevention in Proc10 => " &
-                           Integer'Image (P'Last));
- 
-          Report.Failed ("No exception raised in Proc10");
- 
-       exception       
- 
-          when Constraint_Error => null;      -- exception expected.
-          when others           => 
-            Report.Failed ("Others exception raised in Proc10");
-       end;            
- 
-    begin
- 
-       -- Same lengths, no Constraint_Error raised.
-       Proc10 (Formal(Arr_Obj10));
- 
-       if Arr_Obj10'Last /= 2 and Arr_Obj10'Last(2) /= 3 then
-          Report.Failed ("Bounds changed for Arr_Obj10");
-       end if;
- 
-    exception
- 
-       when Constraint_Error => 
-         Report.Failed ("Constraint_Error exception raised after call Proc10");
-       when others           => 
-         Report.Failed ("Arr_Obj10 - others exception raised");
- 
-    end;
- 
-    ---------------------------------------------------------------------------
-    Report.Result;
- 
- end C460009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,354 ****
- -- C460010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for an array aggregate without an others choice assigned
- --      to an object of a constrained array subtype, Constraint_Error is not
- --      raised if the length of each dimension of the aggregate equals the
- --      length of the corresponding dimension of the target object, even if
- --      the bounds of the corresponding index ranges do not match.
- --
- -- TEST DESCRIPTION:
- --      The test verifies that sliding of array bounds is performed on array
- --      aggregates that are part of a larger aggregate, where the bounds of
- --      the corresponding index ranges do not match but the lengths of the
- --      corresponding dimensions are the same. Both aggregates containing
- --      named associations and positional associations are checked. Cases
- --      involving static and nonstatic index constraints, as well as pre-
- --      defined and modular integer index subtypes, are included.
- --
- --
- -- CHANGE HISTORY:
- --      15 Apr 96   SAIC    Prerelease version for ACVC 2.1.
- --      20 Oct 96   SAIC    Removed unnecessary parentheses and type
- --                          conversions.
- --
- --!
- 
- with Report;
- pragma Elaborate (Report);
- 
- package C460010_0 is
- 
-   type Modular_Type is mod 10;  -- Range 0 .. 9.
- 
- 
-   Two  : Modular_Type := Modular_Type (Report.Ident_Int(2));
-   Four : Modular_Type := Modular_Type (Report.Ident_Int(4));
- 
-   type Array_Modular_Index is array (Modular_Type range <>) of Integer;
- 
-   subtype Array_Static_Modular_Constraint    is Array_Modular_Index(2..4);
-   subtype Array_Nonstatic_Modular_Constraint is Array_Modular_Index(Two..Four);
- 
- end C460010_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- pragma Elaborate (Report);
- 
- package C460010_1 is
- 
-   One  : Integer := Report.Ident_Int(1);
-   Ten  : Integer := Report.Ident_Int(10);
- 
-   subtype Integer_Subtype is Integer range One .. Ten;
- 
- 
-   Two  : Integer := Report.Ident_Int(2);
-   Four : Integer := Report.Ident_Int(4);
- 
-   type Array_Integer_Index is array (Integer_Subtype range <>) of Boolean;
- 
-   subtype Array_Static_Integer_Constraint    is Array_Integer_Index(2..4);
-   subtype Array_Nonstatic_Integer_Constraint is Array_Integer_Index(Two..Four);
- 
- end C460010_1;
- 
- 
-      --==================================================================--
- 
- 
- -- Generic equality function:
- 
- generic
-    type Operand_Type is private;
- function C460010_2 (L, R : Operand_Type) return Boolean;
- 
- 
- function C460010_2 (L, R : Operand_Type) return Boolean is
- begin
-    return L = R;
- end C460010_2;
- 
- 
-      --==================================================================--
- 
- 
- with C460010_0;
- with C460010_1;
- with C460010_2;
- 
- with Report;
- 
- procedure C460010 is
- 
-    generic function Generic_Equality renames C460010_2;
- 
- begin
-    Report.Test ("C460010", "Check that Constraint_Error is not raised if " &
-                 "an array aggregate without an others choice is assigned " &
-                 "to an object of a constrained array subtype, and the "    &
-                 "length of each dimension of the aggregate equals the "    &
-                 "length of the corresponding dimension of the target object");
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    declare
-      type Arr is array (1..1) of C460010_0.Array_Static_Modular_Constraint;
-      function Equals is new Generic_Equality (Arr);
-      Target : Arr;
-    begin
-                        ---=---=---=---=---=---=---
-      CASE_1:
-      begin
-         Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 1");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 1");
-       end CASE_1;
- 
-                        ---=---=---=---=---=---=---
- 
-      CASE_2:
-      begin
-         Target := (1 => (5, 10, 15));  -- Positional associations.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 2");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 2");
-       end CASE_2;
- 
-                        ---=---=---=---=---=---=---
-    end;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    declare
-      type Rec (Disc : C460010_0.Modular_Type := 4) is record
-        Arr : C460010_0.Array_Modular_Index(2 .. Disc);
-      end record;
- 
-      function Equals is new Generic_Equality (Rec);
-      Target : Rec;
-    begin
-                        ---=---=---=---=---=---=---
-      CASE_3:
-      begin
-         Target := (Disc => 4, Arr => (1 => 1, 2 => 2, 3 => 3));  -- Named.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 3");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 3");
-       end CASE_3;
- 
-                        ---=---=---=---=---=---=---
- 
-      CASE_4:
-      begin
-         Target := (Disc => 4, Arr => (1 ,2, 3));    -- Positional.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 4");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 4");
-       end CASE_4;
- 
-                        ---=---=---=---=---=---=---
-    end;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    declare
-      type Arr is array (1..1) of C460010_0.Array_Nonstatic_Modular_Constraint;
-      function Equals is new Generic_Equality (Arr);
-      Target : Arr;
-    begin
-                        ---=---=---=---=---=---=---
-      CASE_5:
-      begin
-         Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 5");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 5");
-       end CASE_5;
- 
-                        ---=---=---=---=---=---=---
- 
-      CASE_6:
-      begin
-         Target := (1 => ((5, 10, 15)));  -- Positional associations.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 6");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 6");
-       end CASE_6;
- 
-                        ---=---=---=---=---=---=---
-    end;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    declare
-      type Arr is array (1..1) of C460010_1.Array_Static_Integer_Constraint;
-      function Equals is new Generic_Equality (Arr);
-      Target : Arr;
-    begin
-                        ---=---=---=---=---=---=---
-      CASE_7:
-      begin
-         Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 7");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 7");
-       end CASE_7;
- 
-                        ---=---=---=---=---=---=---
- 
-      CASE_8:
-      begin
-         Target := (1 => ((False, False, True)));  -- Positional.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 8");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 8");
-       end CASE_8;
- 
-                        ---=---=---=---=---=---=---
-    end;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    declare
-      type Arr is array (1..1) of C460010_1.Array_Nonstatic_Integer_Constraint;
-      function Equals is new Generic_Equality (Arr);
-      Target : Arr;
-    begin
-                        ---=---=---=---=---=---=---
-      CASE_9:
-      begin
-         Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 9");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 9");
-       end CASE_9;
- 
-                        ---=---=---=---=---=---=---
- 
-      CASE_10:
-      begin
-         Target := (1 => (False, False, True));      -- Positional.
- 
-         if not Equals (Target, Target) then
-              Report.Failed ("Avoid optimization");  -- Never executed.
-         end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised: Case 10");
-          when others           =>
-             Report.Failed ("Unexpected exception raised: Case 10");
-       end CASE_10;
- 
-                        ---=---=---=---=---=---=---
-    end;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-      Report.Result;
- 
- end C460010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,210 ****
- -- C460011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are 
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release, 
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that conversion of a decimal type to a modular type raises
- --     Constraint_Error when the operand value is outside the base range
- --     of the modular type.
- --     Check that a conversion of a decimal type to an integer type
- --     rounds correctly.
- --
- -- TEST DESCRIPTION:
- --      Test conversion from decimal types to modular types.  Test
- --      conversion to mod 255, mod 256 and mod 258 to test the boundaries
- --      of 8 bit (+/-) unsigned numbers.
- --      Test operand values that are negative, the value of the mod,
- --      and greater than the value of the mod.
- --      Declare a generic test procedure and instantiate it for each of the
- --      unsigned types for each operand type.
- --      Check that the operand is properly rounded during the conversion.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations which support
- --      decimal types.
- --
- -- CHANGE HISTORY:
- --      24 NOV 98   RLB  Split decimal cases from C460008 into this
- --                       test, added conversions to integer types.
- --      18 JAN 99   RLB  Repaired errors in test.
- --
- --!
- 
- ------------------------------------------------------------------- C460011
- 
- with Report;
- 
- procedure C460011 is
- 
-   Shy_By_One   : constant := 2**8-1;
-   Heavy_By_Two : constant := 2**8+2;
- 
-   type Unsigned_Edge_8 is mod Shy_By_One;
-   type Unsigned_8_Bit  is mod 2**8;
-   type Unsigned_Over_8 is mod Heavy_By_Two;
- 
-   type Signed_8_Bit is range -128 .. 127;
-   type Signed_Over_8 is range -200 .. 200;
- 
-   NPC : constant String := " not properly converted";
- 
-   procedure Assert( Truth: Boolean; Message: String ) is
-   begin
-     if not Truth then
-       Report.Failed(Message);
-     end if;
-   end Assert;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   type Decim is delta 0.1 digits 5;    -- N/A => ERROR.
- 
-   generic
-     type Source is delta <> digits <>;
-     type Target is mod <>;
-   procedure Decimal_Conversion_Check( For_The_Value : Source;
-                                       Message       : String );
- 
-   procedure Decimal_Conversion_Check( For_The_Value : Source;
-                                       Message       : String ) is
- 
-     Item : Target;
- 
-   begin  
-     Item := Target( For_The_Value );
-     Report.Failed("Deci expected Constraint_Error " & Message);
-     Report.Comment("Value of" & Target'Image(Item) & NPC);
-   exception
-     when Constraint_Error => null; -- expected case
-     when others => Report.Failed("Deci raised wrong exception " & Message);
-   end Decimal_Conversion_Check;
- 
-   procedure Decim_To_Short is
-     new Decimal_Conversion_Check( Decim, Unsigned_Edge_8 );
- 
-   procedure Decim_To_Eight is
-     new Decimal_Conversion_Check( Decim, Unsigned_8_Bit );
- 
-   procedure Decim_To_Wide is
-     new Decimal_Conversion_Check( Decim, Unsigned_Over_8 );
- 
-   function Identity( Launder: Decim ) return Decim is
-     Flat_Broke : constant Decim := 0.0;
-   begin
-     if Report.Ident_Bool( Launder = Flat_Broke ) then
-       return Flat_Broke;
-     else
-       return Launder;
-     end if;
-   end Identity;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C460011", "Check that conversion to " &
-                           "a modular type raises Constraint_Error when " &
-                           "the operand value is outside the base range " &
-                           "of the modular type" );
-    
-   -- Decimal Error cases
- 
-   Decim_To_Short( Identity( -5.00 ), "M2S Dynamic, Negative" );
-   Decim_To_Short( Shy_By_One * 1.0, "M2S Static,  At_Mod" );
-   Decim_To_Short( 1995.9, "M2S Static,  Over_Mod" );
- 
-   Decim_To_Eight( -0.5, "M28 Static, Negative" );
-   Decim_To_Eight( 2.0*128, "M28 Static,  At_Mod" );
-   Decim_To_Eight( Identity( 2001.2 ), "M28 Dynamic, Over_Mod" );
- 
-   Decim_To_Wide ( Decim'First, "M2W Static,  Negative" );
-   Decim_To_Wide ( Identity( 2*128.0 +2.0 ), "M2W Dynamic, At_Mod" );
-   Decim_To_Wide ( Decim'Last, "M2W Static,  Over_Mod" );
- 
-   -- Check a few, correct, edge cases, for modular types.
- 
-   Eye_Dew: declare
-     Sense     : Decim    := 0.00;
- 
-     Little   : Unsigned_Edge_8;
-     Moderate : Unsigned_8_Bit;
-     Big      : Unsigned_Over_8;
- 
-   begin
-     Moderate := Unsigned_8_Bit (Sense);
-     Assert( Moderate = 0, "Sense => Moderate, 0");
- 
-     Sense     := 2*128.0;
- 
-     Big := Unsigned_Over_8 (Sense);
-     Assert( Big = 256, "Sense => Big, 256");
- 
-   end Eye_Dew;
- 
-   Rounding: declare
-     Easy     : Decim  := Identity ( 2.0);
-     Simple   : Decim  := Identity ( 2.1);
-     Halfway  : Decim  := Identity ( 2.5);
-     Upward   : Decim  := Identity ( 2.8);
-     Chop     : Decim  := Identity (-2.2);
-     Neg_Half : Decim  := Identity (-2.5);
-     Downward : Decim  := Identity (-2.7);
- 
-     Little   : Unsigned_Edge_8;
-     Moderate : Unsigned_8_Bit;
-     Big      : Unsigned_Over_8;
- 
-     Also_Little:Signed_8_Bit;
-     Also_Big : Signed_Over_8;
-     
-   begin
-     Little := Unsigned_Edge_8 (Easy);
-     Assert( Little = 2, "Easy => Little, 2");
- 
-     Moderate := Unsigned_8_Bit (Simple);
-     Assert( Moderate = 2, "Simple => Moderate, 2");
- 
-     Big := Unsigned_Over_8 (Halfway); -- Rounds up by 4.6(33).
-     Assert( Big = 3, "Halfway => Big, 3");
- 
-     Little := Unsigned_Edge_8 (Upward);
-     Assert( Little = 3, "Upward => Little, 3");
- 
-     Also_Big := Signed_Over_8 (Halfway); -- Rounds up by 4.6(33).
-     Assert( Also_Big = 3, "Halfway => Also_Big, 3");
- 
-     Also_Little := Signed_8_Bit (Chop);
-     Assert( Also_Little = -2, "Chop => Also_Little, -2");
- 
-     Also_Big := Signed_Over_8 (Neg_Half); -- Rounds down by 4.6(33).
-     Assert( Also_Big = -3, "Halfway => Also_Big, -3");
- 
-     Also_Little := Signed_8_Bit (Downward);
-     Assert( Also_Little = -3, "Downward => Also_Little, -3");
- 
-   end Rounding;
- 
- 
-   Report.Result;
- 
- end C460011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C460012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that the view created by a view conversion is constrained if the
- --    target subtype is indefinite.  (Defect Report 8652/0017, Technical
- --    Corrigendum 4.6(54/1)).
- --
- -- CHANGE HISTORY:
- --    25 JAN 2001   PHL   Initial version.
- --    29 JUN 2001   RLB   Reformatted for ACATS. Added optimization blocking.
- --    02 JUL 2001   RLB   Fixed discriminant reference.
- --
- --!
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Report;
- use Report;
- procedure C460012 is
- 
-     subtype Index is Positive range 1 .. 10;
- 
-     type Definite_Parent (D1 : Index := 6) is
- 	record
- 	    F : String (1 .. D1) := (others => 'a');
- 	end record;
- 
-     type Indefinite_Child (D2 : Index) is new Definite_Parent (D1 => D2);
- 
-     Y : Definite_Parent;
- 
-     procedure P (X : in out Indefinite_Child) is
- 	C : Character renames X.F (3);
-     begin
- 	X := (1, "a");
-         if C /= 'a' then
-             Failed ("No exception raised when changing the " &
- 		    "discriminant of a view conversion, value of C changed");
-         elsif X.D2 /= 1 then
-             Failed ("No exception raised when changing the " &
- 		    "discriminant of a view conversion, discriminant not " &
-                     "changed");
-             -- This check primarily exists to prevent X from being optimized by
-             -- 11.6 permissions, or the Failed call being made before the assignment.
-         else
-             Failed ("No exception raised when changing the " &
- 		    "discriminant of a view conversion, discriminant changed");
-         end if;
-     exception
- 	when Constraint_Error =>
- 	    null;
- 	when E: others =>
- 	    Failed ("Wrong exception " & Exception_Name (E) & " raised - " &
- 		    Exception_Message (E));
-     end P;
- 
- begin
-     Test ("C460012",
-              "Check that the view created by a view conversion " &
- 	     "is constrained if the target subtype is indefinite");
- 
-     P (Indefinite_Child (Y));
- 
-     if Y.D1 /= Ident_Int(6) then
- 	Failed ("Discriminant of indefinite view changed");
-         -- This check exists mainly to prevent Y from being optimized away.
-     end if;
- 
-     Result;
- end C460012;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- C460013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that if the target subtype excludes null, the value is not
- --    null. Check access parameters, which null-excluding if:
- --     (1) not null is given in their definition;
- --     (2) the access parameter is controlling;
- --     (3) an Ada 95 compiler is in use.
- --
- --    Note that the not null syntax is required even for Ada 95 compilers
- --    (see AI95-00447).
- --
- -- CHANGE HISTORY:
- --    18 DEC 2006   RLB   Initial version.
- --    05 JAN 2007   RLB   Corrected syntax error.
- --
- --!
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Report;
- use Report;
- procedure C460013 is
- 
- 
-     package Nest1 is
-         type Doggie is tagged record
-             Cnt : Natural;
-         end record;
-         type Doggie_Access is access all Doggie;
- 
-         procedure Controlled (P : access Doggie); -- Always null-excluding.
-     end Nest1;
- 
-     package Nest2 is
-         type Kitty is record
-             Cnt : Natural;
-         end record;
-         type Kitty_Access is access all Kitty;
- 
-         procedure Include (P : access Kitty); -- Null-excluding only in Ada 95.
-         procedure Exclude (P : not null access Kitty); -- Always null-excluding.
-     end Nest2;
- 
- 
-     package body Nest1 is
-         procedure Controlled (P : access Doggie) is
-         begin
-             if P.Cnt /= Ident_Int(4) then
-                 Failed ("Bad value in null-excluding controlling parameter");
-             -- else OK
-             end if;
-         exception
-             when Constraint_Error => -- Dereference of null
-                 Failed ("Null allowed in null-excluding controlling parameter");
-         end Controlled;
-     end Nest1;
- 
-     package body Nest2 is
-         procedure Include (P : access Kitty) is
-         begin
-             if P.Cnt /= Ident_Int(31) then
-                 Failed ("Bad value in access parameter");
-             -- else OK
-             end if;
-         exception
-             when Constraint_Error => -- Dereference of null
-                 null;
-                 --Comment ("Null allowed in access parameter - Ada 2005 semantics");
-         end Include;
- 
-         procedure Exclude (P : not null access Kitty) is
-         begin
-             if P.Cnt /= Ident_Int(80) then
-                 Failed ("Bad value in explicit null-excluding parameter");
-             -- else OK
-             end if;
-         exception
-             when Constraint_Error => -- Dereference of null
-                 Failed ("Null allowed in explicit null-excluding parameter");
-         end Exclude;
-     end Nest2;
- 
-     Shep : aliased Nest1.Doggie := (Cnt => 4);
-     Frisky : aliased Nest2.Kitty := (Cnt => 80);
-     Snuggles : aliased Nest2.Kitty := (Cnt => 31);
- 
- begin
-     Test ("C460013",
-           "Check that if the target subtype excludes null, the value is not" &
-           " null - access parameter cases");
- 
-     declare
-         Ptr : Nest1.Doggie_Access := Shep'Access;
-     begin
-         begin
-             Nest1.Controlled (Ptr); -- OK.
-         exception
- 	    when A: others =>
- 	        Failed ("Unexpected exception " & Exception_Name (A) &
-                         " raised (1A) - " & Exception_Message (A));
-         end;
-         Ptr := null;
-         begin
-             Nest1.Controlled (Ptr);
- 	    Failed ("Null allowed for null-excluding controlling access parameter (1)");
-         exception
-             when Constraint_Error =>
-                 null;
- 	    when B: others =>
- 	        Failed ("Unexpected exception " & Exception_Name (B) &
-                         " raised (1B) - " & Exception_Message (B));
-         end;
-     end;
- 
-     declare
-         Ptr : Nest2.Kitty_Access := Frisky'Access;
-     begin
-         begin
-             Nest2.Exclude (Ptr); -- OK.
-         exception
- 	    when C: others =>
- 	        Failed ("Unexpected exception " & Exception_Name (C) &
-                         " raised (2A) - " & Exception_Message (C));
-         end;
-         Ptr := null;
-         begin
-             Nest2.Exclude (Ptr);
- 	    Failed ("Null allowed for null-excluding access parameter (2)");
-         exception
-             when Constraint_Error =>
-                 null;
- 	    when D: others =>
- 	        Failed ("Unexpected exception " & Exception_Name (D) &
-                         " raised (2B) - " & Exception_Message (D));
-         end;
-     end;
- 
-     declare
-         Ptr : Nest2.Kitty_Access := Snuggles'Access;
-     begin
-         begin
-             Nest2.Include (Ptr); -- OK.
-         exception
- 	    when E: others =>
- 	        Failed ("Unexpected exception " & Exception_Name (E) &
-                         " raised (3A) - " & Exception_Message (E));
-         end;
-         Ptr := null;
-         begin
-             Nest2.Include (Ptr);
-             Comment ("Null allowed for normal access parameter - " &
-                      "Ada 2005 semantics");
-         exception
-             when Constraint_Error =>
-                 Comment ("Null not allowed for normal access parameter - " &
-                          "Ada 95 semantics");
- 	    when F: others =>
- 	        Failed ("Unexpected exception " & Exception_Name (F) &
-                         " raised (3B) - " & Exception_Message (F));
-         end;
-     end;
- 
-     Result;
- end C460013;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,289 ****
- -- C460014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --
- --                                     Notice
- --
- --     The ACAA has created and maintains the Ada Conformity Assessment Test
- --     Suite for the purpose of conformity assessments conducted in accordance
- --     with the International Standard ISO/IEC 18009 - Ada: Conformity
- --     assessment of a language processor. This test suite should not be used
- --     to make claims of conformance unless used in accordance with
- --     ISO/IEC 18009 and any applicable ACAA procedures.
- --*
- -- OBJECTIVES:
- --      Check that if the operand type of a type conversion is
- --      access-to-class-wide, Constraint_Error is raised if the tag of the
- --      object designated by the operand does not identify a specific type
- --      that is covered by or descended from the target type.
- --
- -- TEST DESCRIPTION:
- --      Attempt to convert a parameter of a type that designates a class-wide
- --      type to an object of a type that designates a specific member of that
- --      class, for both an actual with a different tag and an actual with a
- --      matching tag.
- --
- --      This test checks 4.6(42) as required by 4.6(50).
- --
- -- CHANGE HISTORY:
- --      19 Aug 16   JAC     Initial pre-release version.
- --      19 Jan 17   RLB     Readied for release: replaced objective, renamed
- --                          to appropriate number, added class-wide cases,
- --                          eliminated 11.6 problems, added third level of
- --                          types, and checks on null.
- --
- --!
- package C460014_1 is
-    type Root_Facade_Type is tagged record
-       Error_Code : Integer;
-    end record;
- 
-    type Root_Facade_Ptr_Type is access all Root_Facade_Type;
- 
-    type Facade_Class_Ptr_Type is access all Root_Facade_Type'Class;
- 
-    type Data_A_Type is
-    record
-       A : Boolean;
-    end record;
- 
-    type Facade_A_Type is new Root_Facade_Type with
-    record
-       Data_A : Data_A_Type;
-    end record;
- 
-    type Facade_A_Ptr_Type is access all Facade_A_Type;
- 
-    type Facade_A_Class_Ptr_Type is access all Facade_A_Type'Class;
- 
-    type Facade_B_Type is new Facade_A_Type with
-    record
-       B : Character;
-    end record;
- 
-    type Facade_B_Ptr_Type is access all Facade_B_Type;
- 
-    type Facade_B_Class_Ptr_Type is access all Facade_B_Type'Class;
- 
-    procedure Define_Construct
-      (Facade_Class_Ptr : in Facade_Class_Ptr_Type);
- 
-    procedure Define_Class_Construct
-      (Facade_Class_Ptr : in Facade_Class_Ptr_Type);
- 
-    function Init_Root_Facade_Ptr return Root_Facade_Ptr_Type;
- 
-    function Init_Facade_A_Ptr     return Facade_A_Ptr_Type;
- 
-    function Init_Facade_B_Ptr     return Facade_B_Ptr_Type;
- 
-    function Init_Facade_Class_Ptr_with_Root return Facade_Class_Ptr_Type;
- 
-    function Init_Facade_Class_Ptr_with_A return Facade_Class_Ptr_Type;
- 
-    function Init_Facade_Class_Ptr_with_B return Facade_Class_Ptr_Type;
- 
- end C460014_1;
- 
- with Report;
- package body C460014_1 is
- 
-    procedure Define_Construct
-     (Facade_Class_Ptr : in Facade_Class_Ptr_Type) is
- 
-       Facade_A_Ptr : constant Facade_A_Ptr_Type :=
-                                          Facade_A_Ptr_Type (Facade_Class_Ptr);
- 
-       My_A : Data_A_Type renames Facade_A_Ptr.Data_A;
-    begin
-       if not My_A.A then
-          Report.Comment ("Wrong value"); -- So My_A is not dead by 11.6(5).
-       end if;
-    end Define_Construct;
- 
-    procedure Define_Class_Construct
-     (Facade_Class_Ptr : in Facade_Class_Ptr_Type) is
- 
-       Facade_Class_A_Ptr : constant Facade_A_Class_Ptr_Type :=
-                                   Facade_A_Class_Ptr_Type (Facade_Class_Ptr);
- 
-    begin
-       if Facade_Class_A_Ptr /= null and then
-          (not Facade_Class_A_Ptr.Data_A.A) then
-          Report.Comment ("Wrong value"); -- So the ptr is not dead by 11.6(5).
-       end if;
-    end Define_Class_Construct;
- 
-    Dummy_Root_Facade : aliased Root_Facade_Type := (Error_Code => 123);
- 
-    function Init_Root_Facade_Ptr return Root_Facade_Ptr_Type is
-    begin
-       return Dummy_Root_Facade'Access;
-    end Init_Root_Facade_Ptr;
- 
-    Dummy_Facade_A    : aliased Facade_A_Type := (Error_Code => 123,
-                                                  Data_A     => (A => True));
- 
-    function Init_Facade_A_Ptr     return Facade_A_Ptr_Type is
-    begin
-       return Dummy_Facade_A'Access;
-    end Init_Facade_A_Ptr;
- 
-    Dummy_Facade_B    : aliased Facade_B_Type := (Error_Code => 234,
-                                                  Data_A     => (A => True),
-                                                  B          => 'P');
- 
-    function Init_Facade_B_Ptr     return Facade_B_Ptr_Type is
-    begin
-       return Dummy_Facade_B'Access;
-    end Init_Facade_B_Ptr;
- 
-    function Init_Facade_Class_Ptr_with_Root return Facade_Class_Ptr_Type is
-    begin
-       return Dummy_Root_Facade'Access;
-    end Init_Facade_Class_Ptr_with_Root;
- 
-    function Init_Facade_Class_Ptr_with_A return Facade_Class_Ptr_Type is
-    begin
-       return Dummy_Facade_A'Access;
-    end Init_Facade_Class_Ptr_with_A;
- 
-    function Init_Facade_Class_Ptr_with_B return Facade_Class_Ptr_Type is
-    begin
-       return Dummy_Facade_B'Access;
-    end Init_Facade_Class_Ptr_with_B;
- 
- end C460014_1;
- 
- 
- with C460014_1;
- with Report;
- 
- procedure C460014 is
- 
-    My_Root_Facade_Ptr : constant C460014_1.Facade_Class_Ptr_Type :=
-                                     C460014_1.Init_Facade_Class_Ptr_with_Root;
- 
-    My_Facade_A_Ptr    : constant C460014_1.Facade_Class_Ptr_Type :=
-                                     C460014_1.Init_Facade_Class_Ptr_with_A;
- 
-    My_Facade_B_Ptr    : constant C460014_1.Facade_Class_Ptr_Type :=
-                                     C460014_1.Init_Facade_Class_Ptr_with_B;
- 
-    My_Null_Facade_B_Ptr    : constant C460014_1.Facade_B_Ptr_Type := null;
- 
-    Constraint_Error_Raised : Boolean;
- 
-    procedure Test_Define_Construct
-     (Facade_Class_Ptr : in C460014_1.Facade_Class_Ptr_Type) is
-    begin
-       Constraint_Error_Raised := False;
-       -- Should fail Tag_Check and therefore raise Constraint_Error if
-       -- parameter doesn't designate an object of Facade_A_Type
-       -- or Facade_B_Type.
-       C460014_1.Define_Construct (Facade_Class_Ptr => Facade_Class_Ptr);
-    exception
-       when Constraint_Error =>
-          Constraint_Error_Raised := True;
-    end Test_Define_Construct;
- 
- 
-    procedure Test_Define_Class_Construct
-     (Facade_Class_Ptr : in C460014_1.Facade_Class_Ptr_Type) is
-    begin
-       Constraint_Error_Raised := False;
-       -- Should fail Tag_Check and therefore raise Constraint_Error if
-       -- parameter doesn't designate an object of Facade_A_Type
-       -- or Facade_B_Type.
-       C460014_1.Define_Class_Construct (Facade_Class_Ptr => Facade_Class_Ptr);
-    exception
-       when Constraint_Error =>
-          Constraint_Error_Raised := True;
-    end Test_Define_Class_Construct;
- 
- begin
- 
-    Report.Test
-      ("C460014",
-       "Check that if the operand type of a type conversion is " &
-       "access-to-class-wide, Constraint_Error is raised if the tag of the " &
-       "object designated by the operand does not identify a specific type " &
-       "that is covered by or descended from the target type");
- 
-    Test_Define_Construct (Facade_Class_Ptr => My_Root_Facade_Ptr);
- 
-    if not Constraint_Error_Raised then
-       Report.Failed ("Didn't get expected Constraint_Error (1)");
-    end if;
- 
-    Test_Define_Construct
-      (Facade_Class_Ptr => My_Facade_A_Ptr);
- 
-    if Constraint_Error_Raised then
-       Report.Failed ("Unexpected Constraint_Error (2)");
-    end if;
- 
-    Test_Define_Construct
-      (Facade_Class_Ptr => My_Facade_B_Ptr);
- 
-    if Constraint_Error_Raised then
-       Report.Failed ("Unexpected Constraint_Error (3)");
-    end if;
- 
-    Test_Define_Class_Construct (Facade_Class_Ptr => My_Root_Facade_Ptr);
- 
-    if not Constraint_Error_Raised then
-       Report.Failed ("Didn't get expected Constraint_Error (4)");
-    end if;
- 
-    Test_Define_Class_Construct
-      (Facade_Class_Ptr => My_Facade_A_Ptr);
- 
-    if Constraint_Error_Raised then
-       Report.Failed ("Unexpected Constraint_Error (5)");
-    end if;
- 
-    Test_Define_Class_Construct
-      (Facade_Class_Ptr => My_Facade_B_Ptr);
- 
-    if Constraint_Error_Raised then
-       Report.Failed ("Unexpected Constraint_Error (6)");
-    end if;
- 
-    -- Check that it is OK to pass null and that does not cause some failure.
-    Test_Define_Class_Construct (Facade_Class_Ptr => null);
- 
-    if Constraint_Error_Raised then
-       Report.Failed ("Unexpected Constraint_Error (7)");
-    end if;
- 
-    Test_Define_Class_Construct (Facade_Class_Ptr =>
-       C460014_1.Facade_Class_Ptr_Type (My_Null_Facade_B_Ptr));
- 
-    if Constraint_Error_Raised then
-       Report.Failed ("Unexpected Constraint_Error (8)");
-    end if;
- 
-    Report.Result;
- 
- end C460014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C46011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INTEGER CONVERSIONS ARE PERFORMED CORRECTLY WHEN THE 
- -- TARGET AND OPERAND TYPES ARE BOTH INTEGER TYPES.
- 
- -- R.WILLIAMS 9/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46011A IS
- 
-      TYPE INT1 IS RANGE -100 .. 100;
-      I1 : INT1 := INT1'VAL (IDENT_INT (10));
-      F1 : INT1 := INT1'VAL (IDENT_INT (-100));
-      L1 : INT1 := INT1'VAL (IDENT_INT (100));
- 
-      TYPE INT2 IS RANGE -100 .. 100;
-      I2 : INT2 := INT2'VAL (IDENT_INT (10));
-      F2 : INT2 := INT2'VAL (IDENT_INT (-100));
-      L2 : INT2 := INT2'VAL (IDENT_INT (100));
- 
-      
-      TYPE NEWINTEGER IS NEW INTEGER;
-      N1 : NEWINTEGER := 
-           NEWINTEGER'VAL (IDENT_INT (10));
- 
-      T1 : INTEGER := IDENT_INT (10);
- 
-      U1 : CONSTANT := INTEGER'POS (10);
- BEGIN
-      TEST ( "C46011A", "CHECK THAT INTEGER CONVERSIONS ARE " &
-                        "PERFORMED CORRECTLY WHEN THE TARGET AND " &
-                        "OPERAND TYPES ARE BOTH INTEGER TYPES" );
-      
-      IF INT1 (U1) /= U1 THEN 
-           FAILED ( "INCORRECT CONVERSION OF 'INT1 (U1)'" );
-      END IF;
- 
-      IF INT1 (I1) /= I1 THEN 
-           FAILED ( "INCORRECT CONVERSION OF 'INT1 (I1)'" );
-      END IF;
- 
-      IF INT1 (N1) /= I1 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT1 (N1)'" );
-      END IF;
- 
-      IF INT1 (10) /= I1 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT1 (10)'" );
-      END IF;
- 
-      IF INT1 (T1) /= I1 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT1 (T1)'" );
-      END IF;
- 
-      IF INT1 (F2) /= F1 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT1 (F2)'" );
-      END IF;
- 
-      IF INT1 (L2) /= L1 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT1 (L2)'" );
-      END IF;
- 
-      IF INT2 (I1) /= I2 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT2 (I1)'" );
-      END IF;
- 
-      IF INT2 (T1) /= 10 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT2 (T1)'" );
-      END IF;
- 
-      IF INT2 (F1) /= -100 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT2 (F1)'" );
-      END IF;
- 
-      IF INT2 (L1) /= 100 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INT2 (L1)'" );
-      END IF;
- 
-      IF NEWINTEGER (I1) /= N1 THEN 
-           FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (I1)'" );
-      END IF;
- 
-      IF NEWINTEGER (N1) /= N1 THEN 
-           FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (N1)'" );
-      END IF;
- 
-      IF NEWINTEGER (T1) /= N1 THEN 
-           FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (T1)'" );
-      END IF;
- 
-      IF NEWINTEGER (INTEGER (N1)) /= N1 THEN 
-           FAILED ( "INCORRECT CONVERSION OF " &
-                    "'NEWINTEGER (INTEGER (N1))'" );
-      END IF;
- 
-      IF NEWINTEGER (INTEGER (N1 + 1)) /= 11 THEN 
-           FAILED ( "INCORRECT CONVERSION OF " &
-                    "'NEWINTEGER (INTEGER (N1 + 1))'" );
-      END IF;
- 
-      IF INTEGER (10) /= T1 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (10)'" );
-      END IF;
- 
-      IF INTEGER (N1) /= 10 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (N1)'" );
-      END IF;
-      
-      IF INTEGER (I1) /= T1 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (I1)'" );
-      END IF;     
- 
-      IF INTEGER (INT1 (NEWINTEGER (INT1 (I1)))) /= T1 THEN
-           FAILED ( "INCORRECT CONVERSION OF " &
-                    "'INTEGER (INT1 (NEWINTEGER (INT1 (I1)))'" );
-      END IF;     
- 
-      
-      IF INTEGER (I1 + 1) /= 11 THEN
-           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (I1 + 1)'" );
-      END IF;     
- 
-      RESULT;
- END C46011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46013a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46013a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46013a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,260 ****
- -- C46013A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER CONVERSIONS ARE PERFORMED CORRECTLY WHEN THE
- --     OPERAND TYPE IS A FIXED POINT TYPE.
- 
- -- HISTORY:
- --     JET 02/09/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C46013A IS
- 
-      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
-      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
-      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
-      TYPE FIX4 IS NEW FIX1;
- 
-      F1 : FIX1 := 7.75;
-      F2 : FIX2 := -111.25;
-      F3 : FIX3 := 0.875;
-      F4 : FIX4 := -15.25;
- 
-      TYPE INT IS RANGE -512 .. 512;
- 
-      FUNCTION IDENT (I : INT) RETURN INT IS
-      BEGIN
-           RETURN I * INT(IDENT_INT(1));
-      END IDENT;
- 
- BEGIN
-      TEST ("C46013A", "CHECK THAT INTEGER CONVERSIONS ARE PERFORMED " &
-                       "CORRECTLY WHEN THE OPERAND TYPE IS A FIXED " &
-                       "POINT TYPE");
- 
-      IF INTEGER(FIX1'(-7.25)) /= IDENT_INT(-7) THEN
-           FAILED ("INCORRECT VALUE (1)");
-      END IF;
- 
-      IF INTEGER(FIX1'(6.75)) /= IDENT_INT(7) THEN
-           FAILED ("INCORRECT VALUE (2)");
-      END IF;
- 
-      IF INTEGER(F1) /= IDENT_INT(8) THEN
-           FAILED ("INCORRECT VALUE (3)");
-      END IF;
- 
-      IF INT(FIX1'(-7.25)) /= IDENT(-7) THEN
-           FAILED ("INCORRECT VALUE (4)");
-      END IF;
- 
-      IF INTEGER(FIX1'(3.33)) /= IDENT_INT(3) AND
-         INTEGER(FIX1'(3.33)) /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE (5)");
-      END IF;
- 
-      IF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
-         INTEGER(FIX1'(-1.5)) = IDENT_INT(-1) AND
-         INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
-         INTEGER(FIX1'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX1 HALF VALUES ROUND UP");
-      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX1'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX1 HALF VALUES ROUND DOWN");
-      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX1 HALF VALUES ROUND TO EVEN");
-      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX1'(-1.5)) = IDENT_INT(-1) AND
-            INTEGER(FIX1'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX1 HALF VALUES ROUND TOWARD ZERO");
-      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX1'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX1 HALF VALUES ROUND AWAY FROM ZERO");
-      ELSE
-           COMMENT ("FIX1 HALF VALUES ROUND ERRATICALLY");
-      END IF;
- 
-      IF INTEGER(FIX2'(-127.9375)) /= IDENT_INT(-128) THEN
-           FAILED ("INCORRECT VALUE (6)");
-      END IF;
- 
-      IF INTEGER(FIX2'(127.0625)) /= IDENT_INT(127) THEN
-           FAILED ("INCORRECT VALUE (7)");
-      END IF;
- 
-      IF INTEGER(F2) /= IDENT_INT(-111) THEN
-           FAILED ("INCORRECT VALUE (8)");
-      END IF;
- 
-      IF INT(FIX2'(-0.25)) /= IDENT(0) THEN
-           FAILED ("INCORRECT VALUE (9)");
-      END IF;
- 
-      IF INTEGER(FIX2'(66.67)) /= IDENT_INT(67) AND
-         INTEGER(FIX2'(66.67)) /= IDENT_INT(66) THEN
-           FAILED ("INCORRECT VALUE (10)");
-      END IF;
- 
-      IF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
-         INTEGER(FIX2'(-1.5)) = IDENT_INT(-1) AND
-         INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
-         INTEGER(FIX2'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX2 HALF VALUES ROUND UP");
-      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX2'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX2 HALF VALUES ROUND DOWN");
-      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX2 HALF VALUES ROUND TO EVEN");
-      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX2'(-1.5)) = IDENT_INT(-1) AND
-            INTEGER(FIX2'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX2 HALF VALUES ROUND TOWARD ZERO");
-      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX2'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX2 HALF VALUES ROUND AWAY FROM ZERO");
-      ELSE
-           COMMENT ("FIX2 HALF VALUES ROUND ERRATICALLY");
-      END IF;
- 
-      IF INTEGER(FIX3'(-0.25)) /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE (11)");
-      END IF;
- 
-      IF INTEGER(FIX3'(511.75)) /= IDENT_INT(512) THEN
-           FAILED ("INCORRECT VALUE (12)");
-      END IF;
- 
-      IF INTEGER(F3) /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE (13)");
-      END IF;
- 
-      IF INT(FIX3'(-7.0)) /= IDENT(-7) THEN
-           FAILED ("INCORRECT VALUE (14)");
-      END IF;
- 
-      IF INTEGER(FIX3'(-66.67)) /= IDENT_INT(-67) AND
-         INTEGER(FIX3'(-66.67)) /= IDENT_INT(-66) THEN
-           FAILED ("INCORRECT VALUE (15)");
-      END IF;
- 
-      IF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
-         INTEGER(FIX3'(-1.5)) = IDENT_INT(-1) AND
-         INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
-         INTEGER(FIX3'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX3 HALF VALUES ROUND UP");
-      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX3'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX3 HALF VALUES ROUND DOWN");
-      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX3 HALF VALUES ROUND TO EVEN");
-      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX3'(-1.5)) = IDENT_INT(-1) AND
-            INTEGER(FIX3'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX3 HALF VALUES ROUND TOWARD ZERO");
-      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX3'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX3 HALF VALUES ROUND AWAY FROM ZERO");
-      ELSE
-           COMMENT ("FIX3 HALF VALUES ROUND ERRATICALLY");
-      END IF;
- 
-      IF INTEGER(FIX4'(-7.25)) /= IDENT_INT(-7) THEN
-           FAILED ("INCORRECT VALUE (16)");
-      END IF;
- 
-      IF INTEGER(FIX4'(6.75)) /= IDENT_INT(7) THEN
-           FAILED ("INCORRECT VALUE (17)");
-      END IF;
- 
-      IF INTEGER(F4) /= IDENT_INT(-15) THEN
-           FAILED ("INCORRECT VALUE (18)");
-      END IF;
- 
-      IF INT(FIX4'(-31.75)) /= IDENT(-32) THEN
-           FAILED ("INCORRECT VALUE (19)");
-      END IF;
- 
-      IF INTEGER(FIX4'(3.33)) /= IDENT_INT(3) AND
-         INTEGER(FIX4'(3.33)) /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE (20)");
-      END IF;
- 
-      IF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
-         INTEGER(FIX4'(-1.5)) = IDENT_INT(-1) AND
-         INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
-         INTEGER(FIX4'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX4 HALF VALUES ROUND UP");
-      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX4'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX4 HALF VALUES ROUND DOWN");
-      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX4 HALF VALUES ROUND TO EVEN");
-      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX4'(-1.5)) = IDENT_INT(-1) AND
-            INTEGER(FIX4'(1.5)) = IDENT_INT(1) AND
-            INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
-           COMMENT ("FIX4 HALF VALUES ROUND TOWARD ZERO");
-      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-3) AND
-            INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
-            INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
-            INTEGER(FIX4'(2.5)) = IDENT_INT(3) THEN
-           COMMENT ("FIX4 HALF VALUES ROUND AWAY FROM ZERO");
-      ELSE
-           COMMENT ("FIX4 HALF VALUES ROUND ERRATICALLY");
-      END IF;
- 
-      RESULT;
- 
- END C46013A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46014a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46014a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46014a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,287 ****
- -- C46014A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR PREDEFINED TYPE INTEGER, CHECK THAT
- --     CONSTRAINT_ERROR IS RAISED IF THE OPERAND VALUE OF A
- --     CONVERSION LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S BASE
- --     TYPE. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE
- --     OPERAND VALUE LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S
- --     SUBTYPE BUT WITHIN THE RANGE OF THE BASE TYPE.
- 
- -- HISTORY:
- --     RJW 09/08/86  CREATED ORIGINAL TEST.
- --     RJW 11/13/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
- --     JET 12/30/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
- --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- --     JRL 12/08/96  Changed usages of System.Max_Int and System.Min_Int to
- --                   Integer'Base'Last and Integer'Base'First in first two
- --                   subtests.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46014A IS
- 
-      SUBTYPE SMALL IS INTEGER RANGE -100 .. 100;
-      S1 : SMALL;
- 
-      TYPE INT IS RANGE -100 .. 100;
-      T1 : INT;
- 
-      TYPE NEWINTEGER IS NEW INTEGER;
-      N1 : NEWINTEGER;
- 
-      SUBTYPE SUBNEW IS NEWINTEGER RANGE -100 .. 100;
-      SN : SUBNEW;
- 
-      I1 : INTEGER;
-      P1 : POSITIVE;
-      L1 : NATURAL;
- 
-      FUNCTION IDENT (I : INTEGER) RETURN INT IS
-      BEGIN
-           RETURN INT'VAL (IDENT_INT (I));
-      END IDENT;
- 
-      FUNCTION IDENT (I : NEWINTEGER) RETURN NEWINTEGER IS
-      BEGIN
-           RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (I)));
-      END IDENT;
- 
- BEGIN
-      TEST ( "C46014A", "FOR PREDEFINED TYPE INTEGER, CHECK THAT " &
-                        "CONSTRAINT_ERROR IS RAISED IF " &
-                        "THE OPERAND VALUE OF A CONVERSION LIES " &
-                        "OUTSIDE OF THE RANGE OF THE TARGET TYPE'S " &
-                        "BASE TYPE. ALSO, CHECK THAT " &
-                        "CONSTRAINT_ERROR IS RAISED IF THE OPERAND " &
-                        "VALUE LIES OUTSIDE OF THE RANGE OF THE " &
-                        "TARGET TYPE'S SUBTYPE BUT WITHIN THE " &
-                        "RANGE OF THE BASE TYPE" );
- 
-      BEGIN
-           I1 := Integer'Base'Last + Ident_Int(1);
-           Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
-           IF EQUAL (I1, I1) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'LAST + 1");
-           WHEN OTHERS =>
-                Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
-      END;
- 
-      BEGIN
-           I1 := Integer'Base'First - Ident_Int(1);
-           Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
-           IF EQUAL (I1, I1) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'FIRST - 1");
-           WHEN OTHERS =>
-                Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
-      END;
- 
-      BEGIN
-           I1 := INTEGER (IDENT_INT (INTEGER'FIRST) - 1);
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "INTEGER (IDENT_INT (INTEGER'FIRST) - 1)" );
-           IF EQUAL (I1, I1) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
-                          "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
-      END;
- 
-      BEGIN
-           N1 := NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1);
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1)" );
-           IF EQUAL (INTEGER (N1), INTEGER (N1)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
-                          "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
-      END;
- 
-      BEGIN
-           T1 := INT (INT'BASE'FIRST - IDENT (1));
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "INT (INT'BASE'FIRST - IDENT (1))" );
-           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
-                          "INT (INT'BASE'FIRST - IDENT (1))" );
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "INT (INT'BASE'FIRST - IDENT (1))" );
-      END;
- 
-      BEGIN
-           T1 := IDENT (-101);
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "T1 := -101" );
-           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "T1 := -101" );
-      END;
- 
-      BEGIN
-           T1 := INTEGER'POS (IDENT_INT (101));
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "T1 := INTEGER'POS (IDENT_INT (101))" );
-           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "T1 := INTEGER'POS (IDENT_INT (101));" );
-      END;
- 
-      BEGIN
-           T1 := INT (IDENT (INTEGER (INT'FIRST)) - 1);
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "INT (INT'FIRST - 1)" );
-           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "INT (INT'FIRST - 1)" );
-      END;
- 
-      BEGIN
-           T1 := INT (IDENT_INT (101));
-           FAILED ( "NO EXCEPTION RAISED FOR INT (101)" );
-           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INT (101)" );
-      END;
- 
-      BEGIN
-           S1 := SMALL (IDENT_INT (101));
-           FAILED ( "NO EXCEPTION RAISED FOR SMALL (101)" );
-           IF EQUAL (S1, S1) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR SMALL (101)" );
-      END;
- 
-      BEGIN
-           SN := SUBNEW (IDENT_INT (-101));
-           FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (-101)" );
-           IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (-101)" );
-      END;
- 
-      BEGIN
-           P1 := IDENT_INT (101);
-           SN := SUBNEW (P1);
-           FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (P1)" );
-           IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (P1)" );
-      END;
- 
-      BEGIN
-           SN := IDENT (0);
-           P1 := POSITIVE (SN);
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "POSITIVE (SN)" );
-           IF EQUAL (P1, P1) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "POSITIVE (SN)" );
-      END;
- 
-      BEGIN
-           N1 := IDENT (-1);
-           L1 := NATURAL (N1);
-           FAILED ( "NO EXCEPTION RAISED FOR " &
-                    "NATURAL (N1)" );
-           IF EQUAL (L1, L1) THEN
-                COMMENT ("SHOULDN'T GET HERE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                         "NATURAL (N1)" );
-      END;
- 
-      RESULT;
- END C46014A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46021a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46021a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46021a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46021a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,210 ****
- -- C46021A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOATING POINT CONVERSIONS ARE PERFORMED CORRECTLY
- --     WHEN THE OPERAND TYPE IS AN INTEGER TYPE, FOR 5-DIGIT PRECISION.
- 
- -- HISTORY:
- --     JET 02/12/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C46021A IS
- 
-      TYPE FLOAT5 IS DIGITS 5;
-      TYPE INT IS RANGE -32768..32767;
- 
-      TYPE NFLOAT5 IS NEW FLOAT5;
- 
-      FUNCTION IDENT (A : FLOAT5) RETURN FLOAT5 IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN A;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT;
- 
-      FUNCTION IDENT (A : NFLOAT5) RETURN NFLOAT5 IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN A;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT;
- 
- BEGIN
-      TEST ("C46021A", "CHECK THAT FLOATING POINT CONVERSIONS ARE " &
-                       "PERFORMED CORRECTLY WHEN THE OPERAND TYPE " &
-                       "IS AN INTEGER TYPE, FOR 5-DIGIT PRECISION");
- 
-      IF FLOAT5(IDENT_INT(-7)) /= -7.0 THEN
-           FAILED ("INCORRECT VALUE (1)");
-      END IF;
- 
-      IF FLOAT5(IDENT_INT(3)) /= 3.0 THEN
-           FAILED ("INCORRECT VALUE (2)");
-      END IF;
- 
-      IF FLOAT5(IDENT_INT(-999)) /= -999.0 THEN
-           FAILED ("INCORRECT VALUE (3)");
-      END IF;
- 
-      IF FLOAT5(IDENT_INT(101)) /= 101.0 THEN
-           FAILED ("INCORRECT VALUE (4)");
-      END IF;
- 
-      IF FLOAT5(IDENT_INT(-32767)) /= -32767.0 THEN
-           FAILED ("INCORRECT VALUE (5)");
-      END IF;
- 
-      IF FLOAT5(IDENT_INT(32767)) /= 32767.0 THEN
-           FAILED ("INCORRECT VALUE (6)");
-      END IF;
- 
-      IF FLOAT5(-7) /= IDENT(-7.0) THEN
-           FAILED ("INCORRECT VALUE (7)");
-      END IF;
- 
-      IF FLOAT5(3) /= IDENT(3.0) THEN
-           FAILED ("INCORRECT VALUE (8)");
-      END IF;
- 
-      IF FLOAT5(-999) /= IDENT(-999.0) THEN
-           FAILED ("INCORRECT VALUE (9)");
-      END IF;
- 
-      IF FLOAT5(101) /= IDENT(101.0) THEN
-           FAILED ("INCORRECT VALUE (10)");
-      END IF;
- 
-      IF FLOAT5(-32767) /= IDENT(-32767.0) THEN
-           FAILED ("INCORRECT VALUE (11)");
-      END IF;
- 
-      IF FLOAT5(32767) /= IDENT(32767.0) THEN
-           FAILED ("INCORRECT VALUE (12)");
-      END IF;
- 
-      IF FLOAT5(INT'(-7)) /= IDENT(-7.0) THEN
-           FAILED ("INCORRECT VALUE (13)");
-      END IF;
- 
-      IF FLOAT5(INT'(3)) /= IDENT(3.0) THEN
-           FAILED ("INCORRECT VALUE (14)");
-      END IF;
- 
-      IF FLOAT5(INT'(-999)) /= IDENT(-999.0) THEN
-           FAILED ("INCORRECT VALUE (15)");
-      END IF;
- 
-      IF FLOAT5(INT'(101)) /= IDENT(101.0) THEN
-           FAILED ("INCORRECT VALUE (16)");
-      END IF;
- 
-      IF FLOAT5(INT'(-32767)) /= IDENT(-32767.0) THEN
-           FAILED ("INCORRECT VALUE (17)");
-      END IF;
- 
-      IF FLOAT5(INT'(32767)) /= IDENT(32767.0) THEN
-           FAILED ("INCORRECT VALUE (18)");
-      END IF;
- 
-      IF NFLOAT5(IDENT_INT(-7)) /= -7.0 THEN
-           FAILED ("INCORRECT VALUE (19)");
-      END IF;
- 
-      IF NFLOAT5(IDENT_INT(3)) /= 3.0 THEN
-           FAILED ("INCORRECT VALUE (20)");
-      END IF;
- 
-      IF NFLOAT5(IDENT_INT(-999)) /= -999.0 THEN
-           FAILED ("INCORRECT VALUE (21)");
-      END IF;
- 
-      IF NFLOAT5(IDENT_INT(101)) /= 101.0 THEN
-           FAILED ("INCORRECT VALUE (22)");
-      END IF;
- 
-      IF NFLOAT5(IDENT_INT(-32767)) /= -32767.0 THEN
-           FAILED ("INCORRECT VALUE (23)");
-      END IF;
- 
-      IF NFLOAT5(IDENT_INT(32767)) /= 32767.0 THEN
-           FAILED ("INCORRECT VALUE (24)");
-      END IF;
- 
-      IF NFLOAT5(-7) /= IDENT(-7.0) THEN
-           FAILED ("INCORRECT VALUE (25)");
-      END IF;
- 
-      IF NFLOAT5(3) /= IDENT(3.0) THEN
-           FAILED ("INCORRECT VALUE (26)");
-      END IF;
- 
-      IF NFLOAT5(-999) /= IDENT(-999.0) THEN
-           FAILED ("INCORRECT VALUE (27)");
-      END IF;
- 
-      IF NFLOAT5(101) /= IDENT(101.0) THEN
-           FAILED ("INCORRECT VALUE (28)");
-      END IF;
- 
-      IF NFLOAT5(-32767) /= IDENT(-32767.0) THEN
-           FAILED ("INCORRECT VALUE (29)");
-      END IF;
- 
-      IF NFLOAT5(32767) /= IDENT(32767.0) THEN
-           FAILED ("INCORRECT VALUE (30)");
-      END IF;
- 
-      IF NFLOAT5(INT'(-7)) /= IDENT(-7.0) THEN
-           FAILED ("INCORRECT VALUE (31)");
-      END IF;
- 
-      IF NFLOAT5(INT'(3)) /= IDENT(3.0) THEN
-           FAILED ("INCORRECT VALUE (32)");
-      END IF;
- 
-      IF NFLOAT5(INT'(-999)) /= IDENT(-999.0) THEN
-           FAILED ("INCORRECT VALUE (33)");
-      END IF;
- 
-      IF NFLOAT5(INT'(101)) /= IDENT(101.0) THEN
-           FAILED ("INCORRECT VALUE (34)");
-      END IF;
- 
-      IF NFLOAT5(INT'(-32767)) /= IDENT(-32767.0) THEN
-           FAILED ("INCORRECT VALUE (35)");
-      END IF;
- 
-      IF NFLOAT5(INT'(32767)) /= IDENT(32767.0) THEN
-           FAILED ("INCORRECT VALUE (36)");
-      END IF;
- 
-      RESULT;
- 
- END C46021A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46024a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46024a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46024a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46024a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C46024A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK FLOATING POINT CONVERSIONS WHEN THE TARGET TYPE IS A
- --     FIXED POINT TYPE, FOR DIGITS 5.
- 
- -- HISTORY:
- --     JET 02/19/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C46024A IS
- 
-      TYPE FLOAT5 IS DIGITS 5;
-      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
-      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
-      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
- 
-      F5, F5A, F5B : FLOAT5;
- 
-      GENERIC
-           TYPE F IS DELTA <>;
-      FUNCTION IDENTG (A : F) RETURN F;
- 
-      FUNCTION IDENTG (A : F) RETURN F IS
-      BEGIN
-           RETURN A + F(IDENT_INT(0));
-      END IDENTG;
- 
-      FUNCTION IDENT1 IS NEW IDENTG(FIX1);
-      FUNCTION IDENT2 IS NEW IDENTG(FIX2);
-      FUNCTION IDENT3 IS NEW IDENTG(FIX3);
- 
- BEGIN
-      TEST ("C46024A", "CHECK FLOATING POINT CONVERSIONS WHEN THE " &
-                       "TARGET TYPE IS A FIXED POINT TYPE, FOR " &
-                       "5-DIGIT PRECISION");
- 
-      IF FIX1(FLOAT5'(2#0.1000_0000_0000_0000_00#E-1)) /=
-         IDENT1(2#0.01#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
-      END IF;
- 
-      IF FIX1(FLOAT5'(-2#0.1111_1110_0000_0000_00#E5)) /=
-         IDENT1(-2#1_1111.11#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
-      END IF;
- 
-      IF FIX1(FLOAT5'(-2#0.1010_0111_1111_1111_11#E4)) <
-         IDENT1(-2#1010.10#) OR
-         FIX1(FLOAT5'(-2#0.1010_0111_1111_1111_11#E4)) >
-         IDENT1(-2#1010.01#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
-      END IF;
- 
-      IF FIX2(FLOAT5'(-2#0.1000_0000_0000_0000_00#E-3)) /=
-         IDENT2(-2#0.0001#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
-      END IF;
- 
-      IF FIX2(FLOAT5'(2#0.1111_1111_1110_0000_00#E7)) /=
-         IDENT2(2#111_1111.1111#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
-      END IF;
- 
-      F5 := 2#0.1010_1010_1010_1010_10#E5;
-      IF FIX2(F5) < IDENT2(2#1_0101.0101#) OR
-         FIX2(F5) > IDENT2(2#1_0101.0110#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
-      END IF;
- 
-      IF FIX3(FLOAT5'(2#0.1000_0000_0000_0000_00#E-5)) /=
-         IDENT3(2#0.000001#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
-      END IF;
- 
-      IF FIX3(FLOAT5'(-2#0.1111_1111_1111_1110_00#E9)) /=
-         IDENT3(-2#1_1111_1111.1111_11#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
-      END IF;
- 
-      F5 := -2#0.1010_1010_1010_1010_10#E8;
-      IF FIX3(F5) < IDENT3(-2#1010_1010.1010_11#) OR
-         FIX3(F5) > IDENT3(-2#1010_1010.1010_10#) THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
-      END IF;
- 
-      F5A := 2#0.1010_1010_1010_1010_10#E4;
-      F5B := 2#0.1010_1010_1010_1010_10#E5;
- 
-      IF FIX1(F5A) = IDENT1(2#1010.11#)   AND
-         FIX1(-F5A) = IDENT1(-2#1010.11#) AND
-         FIX1(F5B) = IDENT1(2#1_0101.01#) AND
-         FIX1(-F5B) = IDENT1(-2#1_0101.01#) THEN
-           COMMENT ("CONVERSION ROUNDS TO NEAREST");
-      ELSIF FIX1(F5A) = IDENT1(2#1010.10#) AND
-            FIX1(-F5B) = IDENT1(-2#1_0101.10#) THEN
-           COMMENT ("CONVERSION ROUNDS TO LEAST FIXED-POINT VALUE");
-      ELSIF FIX1(F5B) = IDENT1(2#1_0101.10#) AND
-            FIX1(-F5A) = IDENT1(-2#1010.10#) THEN
-           COMMENT ("CONVERSION ROUNDS TO GREATEST FIXED-POINT VALUE");
-      ELSIF FIX1(F5A) = IDENT1(2#1010.10#) AND
-            FIX1(-F5A) = IDENT1(-2#1010.10#) THEN
-           COMMENT ("CONVERSION ROUNDS TOWARD ZERO");
-      ELSIF FIX1(F5B) = IDENT1(2#1_0101.10#) AND
-            FIX1(-F5B) = IDENT1(-2#1_0101.10#) THEN
-           COMMENT ("CONVERSION ROUNDS AWAY FROM ZERO");
-      ELSE
-           COMMENT ("UNABLE TO DETERMINE CONVERSION PATTERN");
-      END IF;
- 
-      RESULT;
- 
- END C46024A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46031a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46031a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46031a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46031a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C46031A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
- --     IS AN INTEGER TYPE.
- 
- -- HISTORY:
- --     JET 07/11/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46031A IS
- 
-      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
-      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
-      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
- 
-      TYPE NEW_INT IS NEW INTEGER RANGE -16#200# .. 16#200#;
- 
-      I : INTEGER;
-      J : NEW_INT;
- 
-      FUNCTION IDENT_NEW (X : NEW_INT) RETURN NEW_INT IS
-      BEGIN
-           RETURN X * NEW_INT(IDENT_INT(1));
-      END IDENT_NEW;
- 
- BEGIN
-      TEST ("C46031A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
-                       "THE OPERAND TYPE IS AN INTEGER TYPE");
- 
-      I := IDENT_INT(-16#1F#);
-      IF FIX1(I) /= -16#1F.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
-      END IF;
- 
-      J := IDENT_NEW(0);
-      IF FIX1(J) /= 0.0 THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
-      END IF;
- 
-      I := IDENT_INT(16#7F#);
-      IF FIX2(I) /= 16#7F.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
-      END IF;
- 
-      J := IDENT_NEW(16#1#);
-      IF FIX2(J) /= 16#1.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
-      END IF;
- 
-      I := IDENT_INT(-16#55#);
-      IF FIX3(I) /= -16#55.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
-      END IF;
- 
-      J := IDENT_NEW(-16#1#);
-      IF FIX3(J) /= -16#1.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
-      END IF;
- 
-      RESULT;
- 
- END C46031A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46032a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46032a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46032a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46032a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C46032A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
- --     IS A FLOATING POINT TYPE OF 5 DIGITS PRECISION.
- 
- -- HISTORY:
- --     JET 07/11/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46032A IS
- 
-      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
-      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
-      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
- 
-      TYPE FLOAT5 IS DIGITS 5;
- 
-      F5 : FLOAT5;
- 
-      FUNCTION IDENT5 (X : FLOAT5) RETURN FLOAT5 IS
-      BEGIN
-           RETURN X * FLOAT5(IDENT_INT(1));
-      END IDENT5;
- 
- BEGIN
-      TEST ("C46032A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
-                       "THE OPERAND TYPE IS A FLOATING POINT TYPE " &
-                       "OF 5 DIGITS PRECISION");
- 
-      F5 := IDENT5(2#0.1100_0000_0000_0000_00#E0);
-      IF FIX1(F5) /= 16#0.C# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
-      END IF;
- 
-      F5 := IDENT5(2#0.1111_1110_0000_0000_00#E5);
-      IF FIX1(F5) /= 16#1F.C# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
-      END IF;
- 
-      F5 := IDENT5(-2#0.1010_1010_1010_1010_10#E2);
-      IF FIX1(F5) < -16#2.C# OR
-         FIX1(F5) > -16#2.8# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
-      END IF;
- 
-      F5 := IDENT5(2#0.1111_0000_0000_0000_00#E0);
-      IF FIX2(F5) /= 16#0.F# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
-      END IF;
- 
-      F5 := IDENT5(-2#0.1111_1110_0000_0000_00#E7);
-      IF FIX2(F5) /= -16#7F.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
-      END IF;
- 
-      F5 := IDENT5(2#0.1111_1111_1101_0000_00#E7);
-      IF FIX2(F5) < 16#7F.E# OR
-         FIX2(F5) > 16#7F.F# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
-      END IF;
- 
-      F5 := IDENT5(2#0.1000_0000_0000_0000_00#E-5);
-      IF FIX3(F5) /= 16#0.04# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
-      END IF;
- 
-      F5 := -IDENT5(2#0.1010_1010_1010_1010_00#E9);
-      IF FIX3(F5) /= -16#155.54# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
-      END IF;
- 
-      F5 := IDENT5(2#0.1000_0000_0000_0010_11#E9);
-      IF FIX3(F5) < 16#100.04# OR
-         FIX3(F5) > 16#100.08# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
-      END IF;
- 
-      RESULT;
- 
- END C46032A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46033a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46033a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46033a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46033a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C46033A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
- --     IS ANOTHER FIXED POINT TYPE.
- 
- -- HISTORY:
- --     JET 07/12/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46033A IS
- 
-      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
-      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
-      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
- 
-      F1 : FIX1;
-      F2 : FIX2;
-      F3 : FIX3;
- 
-      GENERIC
-           TYPE F IS DELTA <>;
-      FUNCTION IDENT_G (X : F) RETURN F;
- 
-      FUNCTION IDENT_G (X : F) RETURN F IS
-      BEGIN
-           RETURN X + F(IDENT_INT(0));
-      END IDENT_G;
- 
-      FUNCTION IDENT IS NEW IDENT_G(FIX1);
-      FUNCTION IDENT IS NEW IDENT_G(FIX2);
-      FUNCTION IDENT IS NEW IDENT_G(FIX3);
- 
- BEGIN
-      TEST ("C46033A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
-                       "THE OPERAND TYPE IS ANOTHER FIXED POINT TYPE");
- 
-      F1 := IDENT(-16#1F.C#);
-      IF FIX1(F1) /= -16#1F.C# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
-      END IF;
- 
-      F1 := IDENT(16#0.4#);
-      IF FIX2(F1) /= 16#0.4# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
-      END IF;
- 
-      F1 := IDENT(-16#10.4#);
-      IF FIX3(F1) /= -16#10.4# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
-      END IF;
- 
-      F2 := IDENT(16#3.3#);
-      IF FIX1(F2) < 16#3.0# OR
-         FIX1(F2) > 16#3.4# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
-      END IF;
- 
-      F2 := IDENT(-16#40.1#);
-      IF FIX2(F2) /= -16#40.1# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
-      END IF;
- 
-      F2 := IDENT(16#0.0#);
-      IF FIX3(F2) /= 16#0.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
-      END IF;
- 
-      F3 := IDENT(-16#0.04#);
-      IF FIX1(F3) < -16#0.4# OR
-         FIX1(F3) > -16#0.0# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
-      END IF;
- 
-      F3 := -IDENT(16#55.A8#);
-      IF FIX2(F3) < -16#55.B# OR
-         FIX2(F3) > -16#55.A# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
-      END IF;
- 
-      F3 := IDENT(16#101.84#);
-      IF FIX3(F3) /= 16#101.84# THEN
-           FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
-      END IF;
- 
-      RESULT;
- 
- END C46033A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46041a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46041a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46041a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46041a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- C46041A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK ARRAY CONVERSIONS WHEN THE TARGET TYPE IS AN UNCONSTRAINED 
- -- ARRAY TYPE AND THE OPERAND TYPE REQUIRES CONVERSION OF THE INDEX
- -- BOUNDS.
- 
- -- R.WILLIAMS 9/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46041A IS
-      
-      TYPE INT IS RANGE -100 .. 100;
-      TYPE NEWINTEGER IS NEW INTEGER;
- 
-      TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
- 
-      TYPE NDAY1 IS NEW DAY RANGE SUN .. FRI;
-      TYPE NDAY2 IS NEW DAY RANGE MON .. SAT;
-      
-      TYPE NNDAY1 IS NEW NDAY1;
- 
-      FUNCTION IDENT (X : INT) RETURN INT IS
-      BEGIN
-           RETURN INT'VAL (IDENT_INT (INT'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS
-      BEGIN
-           RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS
-      BEGIN
-           RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS
-      BEGIN
-           RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS
-      BEGIN
-           RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X)));
-      END IDENT;
- 
- BEGIN
-      TEST ( "C46041A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " &
-                        "TYPE IS AN UNCONSTRAINED ARRAY TYPE AND " &
-                        "THE OPERAND TYPE REQUIRES CONVERSION OF " &
-                        "THE INDEX BOUNDS" );
- 
-      DECLARE
- 
-           TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-      
-           TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>) 
-                OF INTEGER;
-      
-           TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER;
-           A1 : ARR1 (IDENT (11) .. IDENT (20)) := 
-                     (IDENT (11) .. IDENT (20) => 0);
- 
-           TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>) 
-                OF INTEGER;
-           A2 : ARR2 (IDENT (11) .. IDENT (20), 
-                      IDENT (TUE) .. IDENT (THU)) :=
-                     (IDENT (11) .. IDENT (20) => 
-                     (IDENT (TUE) .. IDENT (THU) => 0));
-      
-           TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>)
-                OF INTEGER;
-           A3 : ARR3 (IDENT (11) .. IDENT (20),
-                      IDENT (TUE) .. IDENT (THU)) :=
-                     (IDENT (11) .. IDENT (20) => 
-                     (IDENT (TUE) .. IDENT (THU) => 0));
- 
-           PROCEDURE CHECK (A : UNARR1) IS
-           BEGIN
-                IF A'FIRST /= 11 OR A'LAST /= 20 THEN
-                     FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" );
-                END IF;
-           END CHECK;
- 
-           PROCEDURE CHECK (A : UNARR2; STR : STRING) IS
-           BEGIN
-                IF A'FIRST (1) /= 11 OR A'LAST /= 20 OR
-                   A'FIRST (2) /= TUE OR A'LAST (2) /= THU THEN
-                     FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" & 
-                               STR & ")" );
-                END IF;
-           END CHECK;
- 
-      BEGIN
-           BEGIN
-                CHECK (UNARR1 (A1));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED BY 'UNARR1 (A1)'" );
-           END;
-                              
-           BEGIN
-                CHECK (UNARR2 (A2), "2");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED BY 'UNARR2 (A2)'" );
-           END;
-                              
-           BEGIN
-                CHECK (UNARR2 (A3), "3");                             
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED BY 'UNARR2 (A3)'" );
-           END;
-                              
-      END;
- 
-      RESULT;
- END C46041A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46042a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46042a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46042a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46042a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- C46042A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK ARRAY CONVERSIONS WHEN THE TARGET TYPE IS A CONSTRAINED 
- -- ARRAY TYPE AND THE OPERAND TYPE HAS BOUNDS THAT DO NOT BELONG TO
- -- THE BASE TYPE OF THE TARGET TYPE'S INDEX SUBTYPE.
- 
- -- R.WILLIAMS 9/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46042A IS
-      
-      TYPE INT IS RANGE -100 .. 100;
- 
-      TYPE NEWINTEGER IS NEW INTEGER;
- 
-      TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
- 
-      TYPE NDAY1 IS NEW DAY RANGE MON .. FRI;
-      TYPE NDAY2 IS NEW DAY RANGE MON .. FRI;
-      
-      TYPE NNDAY1 IS NEW NDAY1;
- 
-      FUNCTION IDENT (X : INT) RETURN INT IS
-      BEGIN
-           RETURN INT'VAL (IDENT_INT (INT'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS
-      BEGIN
-           RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS
-      BEGIN
-           RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS
-      BEGIN
-           RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X)));
-      END IDENT;
- 
-      FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS
-      BEGIN
-           RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X)));
-      END IDENT;
- 
- BEGIN
-      TEST ( "C46042A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " &
-                        "TYPE IS A CONSTRAINED ARRAY TYPE AND THE " &
-                        "OPERAND TYPE HAS BOUNDS THAT DO NOT " &
-                        "BELONG TO THE BASE TYPE OF THE TARGET " &
-                        "TYPE'S INDEX SUBTYPE" );
- 
-      DECLARE
- 
-           TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           SUBTYPE CONARR1 IS UNARR1 (IDENT_INT (1) .. IDENT_INT (10));
- 
-           TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>) 
-                OF INTEGER;
-           SUBTYPE CONARR2 IS UNARR2 (IDENT_INT (1) .. IDENT_INT (10),
-                                      IDENT (MON) .. IDENT (TUE));
-           
-           TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER;
-           A1 : ARR1 (IDENT (11) .. IDENT (20)) := 
-                     (IDENT (11) .. IDENT (20) => 0);
- 
-           TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>) 
-                OF INTEGER;
-           A2 : ARR2 (IDENT (11) .. IDENT (20), 
-                      IDENT (WED) .. IDENT (THU)) :=
-                     (IDENT (11) .. IDENT (20) =>
-                     (IDENT (WED) .. IDENT (THU) => 0));
-      
-           TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>)
-                OF INTEGER;
-           A3 : ARR3 (IDENT (11) .. IDENT (20),
-                      IDENT (WED) .. IDENT (THU)) :=
-                     (IDENT (11) .. IDENT (20) =>
-                     (IDENT (WED) .. IDENT (THU) => 0));
- 
-           PROCEDURE CHECK (A : UNARR1) IS
-           BEGIN
-                IF A'FIRST /= 1 OR A'LAST /= 10 THEN
-                     FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" );
-                END IF;
-           END CHECK;
- 
-           PROCEDURE CHECK (A : UNARR2; STR : STRING) IS
-           BEGIN
-                IF A'FIRST (1) /= 1 OR A'LAST /= 10 OR
-                   A'FIRST (2) /= MON OR A'LAST (2) /= TUE THEN
-                     FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" & 
-                               STR & ")" );
-                END IF;
-           END CHECK;
- 
-      BEGIN
-           BEGIN
-                CHECK (CONARR1 (A1));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED BY 'CONARR1 (A1)'" );
-           END;
-                              
-           BEGIN
-                CHECK (CONARR2 (A2), "2");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A2)'" );
-           END;
-                              
-           BEGIN
-                CHECK (CONARR2 (A3), "3");                             
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A3)'" );
-           END;
-                              
-      END;
- 
-      RESULT;
- END C46042A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46043b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46043b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46043b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46043b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- C46043B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO AN 
- -- UNCONSTRAINED ARRAY TYPE IF, FOR A NON-NULL DIMENSION OF THE 
- -- OPERAND TYPE, ONE BOUND DOES NOT BELONG TO THE CORRESPONDING INDEX
- -- SUBTYPE OF THE TARGET TYPE.
- 
- -- R.WILLIAMS 9/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46043B IS
-           
-      SUBTYPE SUBINT IS INTEGER RANGE IDENT_INT (0) .. IDENT_INT (9);
- 
- BEGIN
-      TEST ( "C46043B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
-                        "CONVERSION TO AN UNCONSTRAINED ARRAY TYPE " &
-                        "IF, FOR A NON-NULL DIMENSION OF THE OPERAND " &
-                        "TYPE, ONE BOUND DOES NOT BELONG TO THE " &
-                        "CORRESPONDING INDEX SUBTYPE OF THE TARGET " &
-                        "TYPE" );
- 
-      DECLARE
-           TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10));
- 
-           TYPE ARR2 IS ARRAY (SUBINT RANGE <>) OF INTEGER;
-           
-           PROCEDURE CHECK (A : ARR2) IS
-           BEGIN               
-                FAILED ( "NO EXCEPTION RAISED WITH ONE DIMENSIONAL " &
-                         "ARRAYS" );
-           END CHECK;
-                
-      BEGIN
-           A1 := (A1'RANGE => 0);
-           CHECK (ARR2 (A1));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WITH ONE " &
-                         "DIMENSIONAL ARRAYS" );
-      END;
- 
-      DECLARE
-           TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
-                INTEGER;
-           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
-                      IDENT_INT (1) .. IDENT_INT (1));
- 
-           TYPE ARR2 IS ARRAY (SUBINT RANGE <>, INTEGER RANGE <>) OF 
-                INTEGER;
-           
-           PROCEDURE CHECK (A : ARR2) IS
-           BEGIN               
-                FAILED ( "NO EXCEPTION RAISED WITH TWO DIMENSIONAL " &
-                         "ARRAYS" );
-           END CHECK;
-                
-      BEGIN
-           A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
-           CHECK (ARR2 (A1));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WITH TWO " &
-                         "DIMENSIONAL ARRAYS" );
-      END;
- 
-      DECLARE
-           TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
-                INTEGER;
-           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
-                      IDENT_INT (1) .. IDENT_INT (0));
- 
-           TYPE ARR2 IS ARRAY (SUBINT RANGE <>, INTEGER RANGE <>) OF 
-                INTEGER;
-           
-           PROCEDURE CHECK (A : ARR2) IS
-           BEGIN               
-                FAILED ( "NO EXCEPTION RAISED WITH NULL ARRAYS - 1" );
-           END CHECK;
-                
-      BEGIN
-           A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
-           CHECK (ARR2 (A1));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " & 
-                         "WITH NULL ARRAYS - 1" );
-      END;
- 
-      DECLARE
-           TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
-                INTEGER;
-           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
-                      IDENT_INT (1) .. IDENT_INT (0));
- 
-           SUBTYPE NOINT IS INTEGER 
-                RANGE IDENT_INT (1) .. IDENT_INT (0);
- 
-           TYPE ARR2 IS ARRAY (SUBINT RANGE <>, NOINT RANGE <>) OF 
-                INTEGER;
-           
-           PROCEDURE CHECK (A : ARR2) IS
-           BEGIN               
-                FAILED ( "NO EXCEPTION RAISED WITH NULL ARRAYS - 2" );
-           END CHECK;
-                
-      BEGIN
-           A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
-           CHECK (ARR2 (A1));
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED " & 
-                         "WITH NULL ARRAYS - 2" );
-      END;
- 
-      RESULT;
- END C46043B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46044b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46044b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46044b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46044b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,235 ****
- -- C46044B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT ERROR IS RAISED FOR CONVERSION TO A  
- -- CONSTRAINED ARRAY TYPE IF THE TARGET TYPE IS NON-NULL AND
- -- CORRESPONDING DIMENSIONS OF THE TARGET AND OPERAND DO NOT HAVE
- -- THE SAME LENGTH. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF
- -- THE TARGET TYPE IS NULL AND THE OPERAND TYPE IS NON-NULL.
- 
- -- R.WILLIAMS 9/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46044B IS
- 
-      TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
- 
-      SUBTYPE CARR1A IS ARR1 (IDENT_INT (1) .. IDENT_INT (6));
-      C1A : CARR1A := (CARR1A'RANGE => 0);
- 
-      SUBTYPE CARR1B IS ARR1 (IDENT_INT (2) .. IDENT_INT (5));
-      C1B : CARR1B := (CARR1B'RANGE => 0);
- 
-      SUBTYPE CARR1N IS ARR1 (IDENT_INT (1) .. IDENT_INT (0));
-      C1N : CARR1N := (CARR1N'RANGE => 0);
- 
-      TYPE ARR2 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
-           INTEGER;
- 
-      SUBTYPE CARR2A IS ARR2 (IDENT_INT (1) .. IDENT_INT (2),
-                              IDENT_INT (1) .. IDENT_INT (2));
-      C2A : CARR2A := (CARR2A'RANGE (1) => (CARR2A'RANGE (2) => 0));
- 
-      SUBTYPE CARR2B IS ARR2 (IDENT_INT (0) .. IDENT_INT (2),
-                              IDENT_INT (0) .. IDENT_INT (2));
-      C2B : CARR2B := (CARR2B'RANGE (1) => (CARR2B'RANGE (2) => 0));
- 
-      SUBTYPE CARR2N IS ARR2 (IDENT_INT (2) .. IDENT_INT (1),
-                              IDENT_INT (1) .. IDENT_INT (2));
-      C2N : CARR2N := (CARR2N'RANGE (1) => (CARR2N'RANGE (2) => 0));
-      
-      PROCEDURE CHECK1 (A : ARR1; STR : STRING) IS
-      BEGIN
-           FAILED ( "NO EXCEPTION RAISED - " & STR );
-      END CHECK1;
- 
-      PROCEDURE CHECK2 (A : ARR2; STR : STRING) IS
-      BEGIN
-           FAILED ( "NO EXCEPTION RAISED - " & STR );
-      END CHECK2;
- 
- BEGIN
-      TEST ( "C46044B", "CHECK THAT CONSTRAINT ERROR IS RAISED FOR " &
-                        "CONVERSION TO A CONSTRAINED ARRAY TYPE " &
-                        "IF THE TARGET TYPE IS NON-NULL AND " &
-                        "CORRESPONDING DIMENSIONS OF THE TARGET AND " &
-                        "OPERAND DO NOT HAVE THE SAME LENGTH. " &
-                        "ALSO, CHECK THAT CONSTRAINT_ERROR IS " &
-                        "RAISED IF THE TARGET TYPE IS NULL AND " &
-                        "THE OPERAND TYPE IS NON-NULL" );
- 
-      BEGIN -- (A).
-           C1A := C1B;
-           CHECK1 (C1A, "(A)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (A)" );
-      END;
- 
-      BEGIN -- (B).
-           CHECK1 (CARR1A (C1B), "(B)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (B)" );
-      END; 
- 
-      BEGIN -- (C).
-           C1B := C1A;
-           CHECK1 (C1B, "(C)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (C)" );
-      END;
- 
-      BEGIN -- (D).
-           CHECK1 (CARR1B (C1A), "(D)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (D)" );
-      END;
- 
-      BEGIN -- (E).
-           C1A := C1N;
-           CHECK1 (C1A, "(E)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (E)" );
-      END;
- 
-      BEGIN -- (F).
-           CHECK1 (CARR1A (C1N), "(F)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (F)" );
-      END;
- 
-      BEGIN -- (G).
-           C2A := C2B;
-           CHECK2 (C2A, "(G)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (G)" );
-      END;
- 
-      BEGIN -- (H).
-           CHECK2 (CARR2A (C2B), "(H)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (H)" );
-      END;
- 
-      BEGIN -- (I).
-           C2B := C2A;
-           CHECK2 (C2B, "(I)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (I)" );
-      END;
- 
-      BEGIN -- (J).
-           CHECK2 (CARR2A (C2B), "(J)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (J)" );
-      END;
- 
-      BEGIN -- (K).
-           C2A := C2N;
-           CHECK2 (C2A, "(K)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (K)" );
-      END;
- 
-      BEGIN -- (L).
-           CHECK2 (CARR2A (C2N), "(L)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (L)" );
-      END;
- 
-      BEGIN -- (M).
-           C1N := C1A;
-           CHECK1 (C1N, "(M)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (M)" );
-      END;
- 
-      BEGIN -- (N).
-           CHECK1 (CARR1N (C1A), "(N)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (N)" );
-      END;
- 
-      BEGIN -- (O).
-           C2N := C2A;
-           CHECK2 (C2N, "(O)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (O)" );
-      END;
- 
-      BEGIN -- (P).
-           CHECK2 (CARR2N (C2A), "(P)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED - (P)" );
-      END;
- 
-      RESULT;
- END C46044B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46051a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46051a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46051a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46051a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,414 ****
- -- C46051A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ENUMERATION, RECORD, ACCESS, PRIVATE, AND TASK VALUES CAN
- -- BE CONVERTED IF THE OPERAND AND TARGET TYPES ARE RELATED BY 
- -- DERIVATION.
- 
- -- R.WILLIAMS 9/8/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46051A IS
-      
- BEGIN
-      TEST ( "C46051A", "CHECK THAT ENUMERATION, RECORD, ACCESS, " &
-                        "PRIVATE, AND TASK VALUES CAN BE CONVERTED " &
-                        "IF THE OPERAND AND TARGET TYPES ARE " &
-                        "RELATED BY DERIVATION" );
- 
-      DECLARE
-           TYPE ENUM IS (A, AB, ABC, ABCD);
-           E : ENUM := ABC;
- 
-           TYPE ENUM1 IS NEW ENUM;
-           E1 : ENUM1 := ENUM1'VAL (IDENT_INT (2));
- 
-           TYPE ENUM2 IS NEW ENUM;
-           E2 : ENUM2 := ABC;
- 
-           TYPE NENUM1 IS NEW ENUM1;
-           NE : NENUM1 := NENUM1'VAL (IDENT_INT (2));
-      BEGIN
-           IF ENUM (E) /= E THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" );
-           END IF;
- 
-           IF ENUM (E1) /= E THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" );
-           END IF;
- 
-           IF ENUM1 (E2) /= E1 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" );
-           END IF;
-                               
-           IF ENUM2 (NE) /= E2 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (NE)'" );
-           END IF;
- 
-           IF NENUM1 (E) /= NE THEN
-                FAILED ( "INCORRECT CONVERSION OF 'NENUM (E)'" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                         "ENUMERATION TYPES" );
-      END;
- 
-      DECLARE
-           TYPE REC IS 
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           R : REC;
- 
-           TYPE REC1 IS NEW REC;
-           R1 : REC1;
- 
-           TYPE REC2 IS NEW REC;
-           R2 : REC2;
- 
-           TYPE NREC1 IS NEW REC1;
-           NR : NREC1;
-      BEGIN
-           IF REC (R) /= R THEN
-                FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" );
-           END IF;
- 
-           IF REC (R1) /= R THEN
-                FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" );
-           END IF;
- 
-           IF REC1 (R2) /= R1 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" );
-           END IF;
-                               
-           IF REC2 (NR) /= R2 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'REC2 (NR)'" );
-           END IF;
- 
-           IF NREC1 (R) /= NR THEN
-                FAILED ( "INCORRECT CONVERSION OF 'NREC (R)'" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                         "RECORD TYPES" );
-      END;
- 
-      DECLARE
-           TYPE REC (D : INTEGER) IS 
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           SUBTYPE CREC IS REC (3);
-           R : CREC;
- 
-           TYPE CREC1 IS NEW REC (3);
-           R1 : CREC1;
- 
-           TYPE CREC2 IS NEW REC (3);
-           R2 : CREC2;
- 
-           TYPE NCREC1 IS NEW CREC1;
-           NR : NCREC1;
-      BEGIN
-           IF CREC (R) /= R THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CREC (R)'" );
-           END IF;
- 
-           IF CREC (R1) /= R THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CREC (R1)'" );
-           END IF;
- 
-           IF CREC1 (R2) /= R1 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CREC1 (R2)'" );
-           END IF;
-                               
-           IF CREC2 (NR) /= R2 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CREC2 (NR)'" );
-           END IF;
- 
-           IF NCREC1 (R) /= NR THEN
-                FAILED ( "INCORRECT CONVERSION OF 'NCREC (R)'" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                         "RECORD TYPES WITH DISCRIMINANTS" );
-      END;
- 
-      DECLARE
-           TYPE REC IS 
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACCREC IS ACCESS REC;
-           AR : ACCREC;
- 
-           TYPE ACCREC1 IS NEW ACCREC;
-           AR1 : ACCREC1;
- 
-           TYPE ACCREC2 IS NEW ACCREC;
-           AR2 : ACCREC2;
- 
-           TYPE NACCREC1 IS NEW ACCREC1;
-           NAR : NACCREC1;
- 
-           FUNCTION F (A : ACCREC) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (0);
-           END F;
- 
-           FUNCTION F (A : ACCREC1) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (1);
-           END F;
- 
-           FUNCTION F (A : ACCREC2) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (2);
-           END F;
- 
-           FUNCTION F (A : NACCREC1) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (3);
-           END F;
- 
-      BEGIN
-           IF F (ACCREC (AR)) /= 0 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR)'" );
-           END IF;
- 
-           IF F (ACCREC (AR1)) /= 0 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR1)'" );
-           END IF;
- 
-           IF F (ACCREC1 (AR2)) /= 1 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ACCREC1 (AR2)'" );
-           END IF;
-                               
-           IF F (ACCREC2 (NAR)) /= 2 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'ACCREC2 (NAR)'" );
-           END IF;
- 
-           IF F (NACCREC1 (AR)) /= 3 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'NACCREC (AR)'" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                         "ACCESS TYPES" );
-      END;
- 
-      DECLARE
-           TYPE REC (D : INTEGER) IS 
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACCR IS ACCESS REC;
- 
-           SUBTYPE CACCR IS ACCR (3);
-           AR : CACCR;
- 
-           TYPE CACCR1 IS NEW ACCR (3);
-           AR1 : CACCR1;
- 
-           TYPE CACCR2 IS NEW ACCR (3);
-           AR2 : CACCR2;
- 
-           TYPE NCACCR1 IS NEW CACCR1;
-           NAR : NCACCR1;
- 
-           FUNCTION F (A : CACCR) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (0);
-           END F;
- 
-           FUNCTION F (A : CACCR1) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (1);
-           END F;
- 
-           FUNCTION F (A : CACCR2) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (2);
-           END F;
- 
-           FUNCTION F (A : NCACCR1) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (3);
-           END F;
- 
-      BEGIN
-           IF F (CACCR (AR)) /= 0 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR)'" );
-           END IF;
- 
-           IF F (CACCR (AR1)) /= 0 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR1)'" );
-           END IF;
- 
-           IF F (CACCR1 (AR2)) /= 1 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CACCR1 (AR2)'" );
-           END IF;
-                               
-           IF F (CACCR2 (NAR)) /= 2 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'CACCR2 (NAR)'" );
-           END IF;
- 
-           IF F (NCACCR1 (AR)) /= 3 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'NCACCR (AR)'" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                         "CONSTRAINED ACCESS TYPES" );
-      END;
- 
-      DECLARE
-           PACKAGE PKG1 IS
-                TYPE PRIV IS PRIVATE;
-           PRIVATE
-                TYPE PRIV IS 
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PKG1;
- 
-           USE PKG1;
- 
-           PACKAGE PKG2 IS
-                R : PRIV;
- 
-                TYPE PRIV1 IS NEW PRIV;
-                R1 : PRIV1;
- 
-                TYPE PRIV2 IS NEW PRIV;
-                R2 : PRIV2;
-           END PKG2;
-      
-           USE PKG2;
- 
-           PACKAGE PKG3 IS
-                TYPE NPRIV1 IS NEW PRIV1;
-                NR : NPRIV1;
-           END PKG3;
- 
-           USE PKG3;
-      BEGIN
-           IF PRIV (R) /= R THEN
-                FAILED ( "INCORRECT CONVERSION OF 'PRIV (R)'" );
-           END IF;
- 
-           IF PRIV (R1) /= R THEN
-                FAILED ( "INCORRECT CONVERSION OF 'PRIV (R1)'" );
-           END IF;
- 
-           IF PRIV1 (R2) /= R1 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'PRIV1 (R2)'" );
-           END IF;
-                               
-           IF PRIV2 (NR) /= R2 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'PRIV2 (NR)'" );
-           END IF;
- 
-           IF NPRIV1 (R) /= NR THEN
-                FAILED ( "INCORRECT CONVERSION OF 'NPRIV (R)'" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                         "PRIVATE TYPES" );
-      END;
- 
-      DECLARE
-           TASK TYPE TK;
-           T : TK;
- 
-           TYPE TK1 IS NEW TK;
-           T1 : TK1; 
- 
-           TYPE TK2 IS NEW TK;
-           T2 : TK2;
- 
-           TYPE NTK1 IS NEW TK1;
-           NT : NTK1;
-           
-           TASK BODY TK IS
-           BEGIN
-                NULL;
-           END;
- 
-           FUNCTION F (T : TK) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (0);
-           END F;
- 
-           FUNCTION F (T : TK1) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (1);
-           END F;
- 
-           FUNCTION F (T : TK2) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (2);
-           END F;
- 
-           FUNCTION F (T : NTK1) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT (3);
-           END F;
- 
-      BEGIN
-           IF F (TK (T)) /= 0 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'TK (T))'" );
-           END IF;
- 
-           IF F (TK (T1)) /= 0 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'TK (T1))'" );
-           END IF;
- 
-           IF F (TK1 (T2)) /= 1 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'TK1 (T2))'" );
-           END IF;
-                               
-           IF F (TK2 (NT)) /= 2 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'TK2 (NT))'" );
-           END IF;
- 
-           IF F (NTK1 (T)) /= 3 THEN
-                FAILED ( "INCORRECT CONVERSION OF 'NTK (T))'" );
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                         "TASK TYPES" );
-      END;
- 
-      RESULT;
- END C46051A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46051b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46051b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46051b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46051b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C46051B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ENUMERATION VALUES CAN BE CONVERTED IF THE OPERAND
- --     AND TARGET TYPES ARE RELATED BY DERIVATION, EVEN IF THE OPERAND
- --     AND TARGET TYPES HAVE DIFFERENT REPRESENTATIONS.
- 
- -- HISTORY:
- --     JET 07/13/88  CREATED ORIGINAL TEST.
- --     RJW 08/28/89  REMOVED APPLICABILITY CRITERIA AND CHANGED
- --                   EXTENSION TO 'ADA'.  CHANGED THE CODES IN SECOND
- --                   ENUMERATION REPRESENTATION CLAUSE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46051B IS
- 
-      TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
- 
-      TYPE ENUM1 IS NEW ENUM;
-      FOR ENUM1 USE
-           (WE => -1, LOVE => 0, WRITING => 3, TESTS => 9);
- 
-      TYPE ENUM2 IS NEW ENUM;
-      FOR ENUM2 USE
-           (WE => 10, LOVE => 15, WRITING => 16, TESTS => 19);
- 
-      TYPE ENUM3 IS NEW ENUM1;
- 
-      E : ENUM := ENUM'VAL (IDENT_INT (0));
-      E1 : ENUM1 := ENUM1'VAL (IDENT_INT (1));
-      E2 : ENUM2 := ENUM2'VAL (IDENT_INT (2));
-      E3 : ENUM3 := ENUM3'VAL (IDENT_INT (3));
- 
- BEGIN
-      TEST ( "C46051B", "CHECK THAT ENUMERATION VALUES CAN BE " &
-                        "CONVERTED IF THE OPERAND AND TARGET TYPES " &
-                        "ARE RELATED BY DERIVATION, EVEN IF THE " &
-                        "OPERAND AND TARGET TYPES HAVE DIFFERENT " &
-                        "REPRESENTATIONS");
- 
-      IF ENUM1 (E) /= WE THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E)'" );
-      END IF;
- 
-      IF ENUM (E1) /= LOVE THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" );
-      END IF;
- 
-      IF ENUM1 (E2) /= WRITING THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" );
-      END IF;
- 
-      IF ENUM2 (E3) /= TESTS THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (E3)'" );
-      END IF;
- 
-      IF ENUM (E) /= WE THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" );
-      END IF;
- 
-      IF ENUM2 (E1) /= LOVE THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (E1)'" );
-      END IF;
- 
-      IF ENUM3 (E2) /= WRITING THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM3 (E2)'" );
-      END IF;
- 
-      IF ENUM (E3) /= TESTS THEN
-           FAILED ( "INCORRECT CONVERSION OF 'ENUM (E3)'" );
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                    "ENUMERATION TYPES" );
-           RESULT;
- END C46051B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46051c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46051c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46051c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46051c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C46051C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT RECORD VALUES CAN BE CONVERTED IF THE OPERAND
- --     AND TARGET TYPES ARE RELATED BY DERIVATION, EVEN IF THE OPERAND
- --     AND TARGET TYPES HAVE DIFFERENT REPRESENTATIONS.
- 
- -- HISTORY:
- --     JET 07/13/88  CREATED ORIGINAL TEST.
- --     RJW 08/28/89  REMOVED APPLICABILITY CRITERIA AND CHANGED
- --                   EXTENSION TO 'ADA'.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- 
- PROCEDURE C46051C IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-           (INTEGER'SIZE+SYSTEM.STORAGE_UNIT-1) / SYSTEM.STORAGE_UNIT;
- 
-      TYPE ARR IS ARRAY (1..2) OF INTEGER;
- 
-      TYPE REC IS RECORD
-           F1 : INTEGER;
-           F2 : INTEGER;
-           F3 : INTEGER;
-      END RECORD;
- 
-      TYPE REC1 IS NEW REC;
-      FOR REC1 USE
-           RECORD
-                F1 AT 0 RANGE 0 .. INTEGER'SIZE - 1;
-                F2 AT 1*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
-                F3 AT 3*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
-           END RECORD;
- 
-      TYPE REC2 IS NEW REC;
-      FOR REC2 USE
-           RECORD
-                F1 AT 0 RANGE 0 .. INTEGER'SIZE - 1;
-                F2 AT 2*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
-                F3 AT 3*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
-           END RECORD;
- 
-      TYPE REC3 IS NEW REC1;
- 
-      R  : REC  := (IDENT_INT (0), 1, 2);
-      R1 : REC1 := (IDENT_INT (1), 2, 3);
-      R2 : REC2 := (IDENT_INT (2), 3, 4);
-      R3 : REC3 := (IDENT_INT (3), 4, 5);
- 
- BEGIN
-      TEST ( "C46051C", "CHECK THAT RECORD VALUES CAN BE " &
-                        "CONVERTED IF THE OPERAND AND TARGET TYPES " &
-                        "ARE RELATED BY DERIVATION, EVEN IF THE " &
-                        "OPERAND AND TARGET TYPES HAVE DIFFERENT " &
-                        "REPRESENTATIONS");
- 
-      IF REC1(R) /= (0,1,2) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC1 (R)'" );
-      END IF;
- 
-      IF REC (R1) /= (1,2,3) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" );
-      END IF;
- 
-      IF REC1 (R2) /= (2,3,4) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" );
-      END IF;
- 
-      IF REC2 (R3) /= (3,4,5) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC2 (R3)'" );
-      END IF;
- 
-      IF REC (R) /= (0,1,2) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" );
-      END IF;
- 
-      IF REC2 (R1) /= (1,2,3) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC2 (R1)'" );
-      END IF;
- 
-      IF REC3 (R2) /= (2,3,4) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC3 (R2)'" );
-      END IF;
- 
-      IF REC (R3) /= (3,4,5) THEN
-           FAILED ( "INCORRECT CONVERSION OF 'REC (R3)'" );
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
-                    "RECORD TYPES" );
-           RESULT;
- END C46051C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46052a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46052a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46052a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46052a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C46052A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO AN 
- -- ENUMERATION TYPE IF THE VALUE OF THE OPERAND DOES NOT BELONG TO THE
- -- RANGE OF ENUMERATION VALUES FOR THE TARGET SUBTYPE.
- 
- -- R.WILLIAMS 9/9/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46052A IS
-      
-      TYPE ENUM IS (A, AB, ABC, ABCD);
-      E : ENUM := ENUM'VAL (IDENT_INT (0));
-      
-      FUNCTION IDENT (E : ENUM) RETURN ENUM IS
-      BEGIN
-           RETURN ENUM'VAL (IDENT_INT (ENUM'POS (E)));
-      END IDENT;
- 
- BEGIN
-      TEST ( "C46052A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
-                        "CONVERSION TO AN ENUMERATION TYPE IF THE " &
-                        "VALUE OF THE OPERAND DOES NOT BELONG TO " &
-                        "THE RANGE OF ENUMERATION VALUES FOR THE " &
-                        "TARGET SUBTYPE" );
- 
-      DECLARE
-           SUBTYPE SENUM IS ENUM RANGE AB .. ABCD;
-      BEGIN
-           E := IDENT (SENUM (E));
-           FAILED ( "NO EXCEPTION RAISED FOR 'SENUM (E)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'SENUM (E)'" );
-      END;
- 
-      DECLARE
-           SUBTYPE NOENUM IS ENUM RANGE ABCD .. AB;
-      BEGIN
-           E := IDENT (NOENUM (E));
-           FAILED ( "NO EXCEPTION RAISED FOR 'NOENUM (E)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'NOENUM (E)'" );
-      END;
- 
-      DECLARE
-           SUBTYPE SCHAR IS CHARACTER RANGE 'C' .. 'R';
-           A : CHARACTER := IDENT_CHAR ('A');
-      BEGIN
-           A := IDENT_CHAR (SCHAR (A));
-           FAILED ( "NO EXCEPTION RAISED FOR 'SCHAR (A)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'SCHAR (A)'" );
-      END;
- 
-      DECLARE
-           SUBTYPE FRANGE IS BOOLEAN RANGE FALSE .. FALSE;
-           T : BOOLEAN := IDENT_BOOL (TRUE);
-      BEGIN
-           T := IDENT_BOOL (FRANGE (T));
-           FAILED ( "NO EXCEPTION RAISED FOR 'FRANGE (T)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'FRANGE (T)'" );
-      END;
- 
-      RESULT;
- END C46052A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46053a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46053a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46053a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46053a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,139 ****
- -- C46053A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO A 
- -- CONSTRAINED RECORD, PRIVATE, OR LIMITED PRIVATE SUBTYPE IF THE 
- -- DISCRIMINANTS OF THE TARGET SUBTYPE DO NOT EQUAL THOSE OF THE 
- -- OPERAND.
- 
- -- R.WILLIAMS 9/9/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46053A IS
-      
- BEGIN
-      TEST ( "C46053A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
-                        "CONVERSION TO A CONSTRAINED RECORD, " &
-                        "PRIVATE, OR LIMITED PRIVATE SUBTYPE IF " &
-                        "THE DISCRIMINANTS OF THE TARGET SUBTYPE DO " &
-                        "NOT EQUAL THOSE OF THE OPERAND" );
- 
-      DECLARE
-           TYPE REC (D : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           
-           SUBTYPE REC3 IS REC (IDENT_INT (3));
-           R : REC (IDENT_INT (1));
- 
-           PROCEDURE PROC (R : REC) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (R.D);
-           END PROC;
-                
-      BEGIN
-           PROC (REC3 (R));
-           FAILED ( "NO EXCEPTION RAISED FOR 'REC3 (R)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'REC3 (R)'" );
-      END;
- 
-      DECLARE
-           PACKAGE PKG1 IS
-                TYPE PRIV (D : INTEGER) IS PRIVATE;
-                SUBTYPE PRIV3 IS PRIV (IDENT_INT (3));
-           PRIVATE
-                TYPE PRIV  (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PKG1;
-           
-           USE PKG1;
- 
-           PACKAGE PKG2 IS
-                P : PRIV (IDENT_INT (0));
-           END PKG2;
- 
-           USE PKG2;
- 
-           PROCEDURE PROC (P : PRIV) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (P.D);
-           END PROC;
-                
-      BEGIN
-           PROC (PRIV3 (P));
-           FAILED ( "NO EXCEPTION RAISED FOR 'PRIV3 (P)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'PRIV3 (P)'" );
-      END;
- 
-      DECLARE
-           PACKAGE PKG1 IS
-                TYPE LIM (D : INTEGER) IS LIMITED PRIVATE;
-                SUBTYPE LIM3 IS LIM (IDENT_INT (3));
-           PRIVATE
-                TYPE LIM  (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PKG1;
-           
-           USE PKG1;
- 
-           PACKAGE PKG2 IS
-                L : LIM (IDENT_INT (0));
-                I : INTEGER;
-           END PKG2;
- 
-           USE PKG2;
- 
-           PROCEDURE PROC (L : LIM) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (L.D);
-           END PROC;
-                
-      BEGIN
-           PROC (LIM3 (L));
-           FAILED ( "NO EXCEPTION RAISED FOR 'LIM3 (L)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'LIM3 (L)'" );
-      END;
- 
-      RESULT;
- END C46053A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46054a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46054a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c46054a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c46054a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C46054A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO AN 
- -- ACCESS SUBTYPE IF THE OPERAND VALUE IS NOT NULL AND THE 
- -- DISCRIMINANTS OR INDEX BOUNDS OF THE DESIGNATED OBJECT DO NOT
- -- MATCH THOSE OF THE TARGET TYPE.
- 
- -- R.WILLIAMS 9/9/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C46054A IS
-      
- BEGIN
-      TEST ( "C46054A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
-                        "CONVERSION TO AN ACCESS SUBTYPE IF THE " &
-                        "OPERAND VALUE IS NOT NULL AND THE " &
-                        "DISCRIMINANTS OR INDEX BOUNDS OF THE " &
-                        "DESIGNATED OBJECT DO NOT MATCH THOSE OF " &
-                        "THE TARGET TYPE" );
- 
-      DECLARE
-           TYPE REC (D : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           
-           TYPE ACREC IS ACCESS REC;
-           A : ACREC (IDENT_INT (0)) := NEW REC (IDENT_INT (0));
- 
-           SUBTYPE ACREC3 IS ACREC (IDENT_INT (3));
- 
-           PROCEDURE PROC (A : ACREC) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (A.D);
-           END PROC;
- 
-      BEGIN
-           PROC (ACREC3 (A));
-           FAILED ( "NO EXCEPTION RAISED FOR 'ACREC3 (A)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACREC3 (A)'" );
-      END;
- 
-      DECLARE
-           TYPE REC (D1, D2 : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           
-           TYPE ACREC IS ACCESS REC;
- 
-           A : ACREC (IDENT_INT (3), IDENT_INT (1)) := 
-               NEW REC (IDENT_INT (3), IDENT_INT (1));
- 
-           SUBTYPE ACREC13 IS ACREC (IDENT_INT (1), IDENT_INT (3));
- 
-           PROCEDURE PROC (A : ACREC) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (A.D1);
-           END PROC;
- 
-      BEGIN
-           PROC (ACREC13 (A));
-           FAILED ( "NO EXCEPTION RAISED FOR 'ACREC13 (A)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACREC13 (A)'" );
-      END;
- 
-      DECLARE
-           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           
-           TYPE ACARR IS ACCESS ARR;
-           A : ACARR (IDENT_INT (0) .. IDENT_INT (1)) := 
-               NEW ARR'(IDENT_INT (0) .. IDENT_INT (1) => 0);
- 
-           SUBTYPE ACARR02 IS ACARR (IDENT_INT (0) .. IDENT_INT (2));
- 
-           PROCEDURE PROC (A : ACARR) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (A'LAST);
-           END PROC;
- 
-      BEGIN
-           PROC (ACARR02 (A));
-           FAILED ( "NO EXCEPTION RAISED FOR 'ACARR02 (A)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACARR02 (A)'" );
-      END;
- 
-      DECLARE
-           TYPE ARR IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
-                INTEGER;
-           
-           TYPE ACARR IS ACCESS ARR;
-           A : ACARR (IDENT_INT (1) .. IDENT_INT (0),
-                      IDENT_INT (4) .. IDENT_INT (5)) := 
-               NEW ARR'(IDENT_INT (1) .. IDENT_INT (0) =>
-                       (IDENT_INT (4) .. IDENT_INT (5) => 0));
- 
-           SUBTYPE NACARR IS ACARR (IDENT_INT (0) .. IDENT_INT (1),
-                                    IDENT_INT (5) .. IDENT_INT (4));
- 
-           PROCEDURE PROC (A : NACARR) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (A'LAST (1));
-           END PROC;
- 
-      BEGIN
-           PROC (NACARR (A));
-           FAILED ( "NO EXCEPTION RAISED FOR 'NACARR (A)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'NACARR (A)'" );
-      END;
- 
-      DECLARE
-           PACKAGE PKG1 IS
-                TYPE PRIV (D : INTEGER) IS PRIVATE;
-                TYPE ACPRV IS ACCESS PRIV;
-                SUBTYPE ACPRV3 IS ACPRV (IDENT_INT (3));
- 
-           PRIVATE
-                TYPE PRIV (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                END RECORD;
-           END PKG1;
-           
-           USE PKG1;
-           
-           PACKAGE PKG2 IS
-                A : ACPRV (IDENT_INT (0)) := NEW PRIV (IDENT_INT (0));
-           END PKG2;
- 
-           USE PKG2;
- 
-           PROCEDURE PROC (A : ACPRV) IS
-                I : INTEGER;
-           BEGIN
-                I := IDENT_INT (A.D);
-           END PROC;
- 
-      BEGIN
-           PROC (ACPRV3 (A));
-           FAILED ( "NO EXCEPTION RAISED FOR 'ACPRV3 (A)'" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACPRV3 (A)'" );
-      END;
- 
-      RESULT;
- END C46054A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,408 ****
- -- C460A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the target type of a type conversion is a general
- --      access type, Program_Error is raised if the accessibility level of
- --      the operand type is deeper than that of the target type. Check for
- --      cases where the type conversion occurs in an instance body, and
- --      the operand type is passed as an actual during instantiation.
- --
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the operand type must
- --      be at the same or a less deep nesting level than the target type -- the
- --      operand type must "live" as long as the target type. Nesting levels
- --      are the run-time nestings of masters: block statements; subprogram,
- --      task, and entry bodies; and accept statements. Packages are invisible
- --      to accessibility rules.
- --
- --      This test checks for cases where the operand is a subprogram formal
- --      parameter.
- --
- --      The test declares three generic packages, each containing an access
- --      type conversion in which the operand type is a formal type:
- --
- --         (1) One in which the target type is declared within the
- --             specification, and the conversion occurs within a nested
- --             function.
- --
- --         (2) One in which the target type is also a formal type, and
- --             the conversion occurs within a nested function.
- --
- --         (3) One in which the target type is declared outside the
- --             generic, and the conversion occurs within a nested
- --             procedure.
- --
- --      The test verifies the following:
- --
- --         For (1), Program_Error is not raised when the nested function is
- --         called. Since the actual corresponding to the formal operand type
- --         must always have the same or a less deep level than the target
- --         type declared within the instance, the access type conversion is
- --         always safe.
- --
- --         For (2), Program_Error is raised when the nested function is
- --         called if the operand type passed as an actual during instantiation
- --         has an accessibility level deeper than that of the target type
- --         passed as an actual, and that no exception is raised otherwise.
- --         The exception is propagated to the innermost enclosing master.
- --
- --         For (3), Program_Error is raised when the nested procedure is
- --         called if the operand type passed as an actual during instantiation
- --         has an accessibility level deeper than that of the target type.
- --         The exception is handled within the nested procedure.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F460A00.A
- --      => C460A01.A
- --
- --
- -- CHANGE HISTORY:
- --      09 May 95   SAIC    Initial prerelease version.
- --      24 Apr 96   SAIC    Added code to avoid dead variable optimization.
- --      13 Feb 97   PWB.CTA Removed 'Class from qual expression at line 342.
- --!
- 
- generic
-    type Designated_Type is tagged private;
-    type Operand_Type is access Designated_Type;
- package C460A01_0 is
-    type Target_Type is access all Designated_Type;
-    function Convert (P : Operand_Type) return Target_Type;
- end C460A01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C460A01_0 is
-    function Convert (P : Operand_Type) return Target_Type is
-    begin
-       return Target_Type(P); -- Never fails.
-    end Convert;
- end C460A01_0;
- 
- 
-      --==================================================================--
- 
- 
- generic
-    type Designated_Type is tagged private;
-    type Operand_Type is access all Designated_Type;
-    type Target_Type  is access all Designated_Type;
- package C460A01_1 is
-    function Convert (P : Operand_Type) return Target_Type;
- end C460A01_1;
- 
- 
-      --==================================================================--
- 
- 
- package body C460A01_1 is
-    function Convert (P : Operand_Type) return Target_Type is
-    begin
-       return Target_Type(P);
-    end Convert;
- end C460A01_1;
- 
- 
-      --==================================================================--
- 
- 
- with F460A00;
- generic
-    type Designated_Type (<>) is new F460A00.Tagged_Type with private;
-    type Operand_Type is access Designated_Type;
- package C460A01_2 is
-    procedure Proc (P   : Operand_Type; 
-                    Res : out F460A00.TC_Result_Kind);
- end C460A01_2;
- 
- 
-      --==================================================================--
- 
- with Report;
- package body C460A01_2 is
-    procedure Proc (P   : Operand_Type; 
-                    Res : out F460A00.TC_Result_Kind) is
-       Ptr : F460A00.AccTag_L0;
-    begin
-       Ptr := F460A00.AccTag_L0(P);
- 
-       -- Avoid optimization (dead variable removal of Ptr):
-       if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
-          Report.Failed ("Unexpected error in C460A01_2 instance");
-       end if;
- 
-       Res := F460A00.OK;
-    exception
-       when Program_Error => Res := F460A00.PE_Exception;
-       when others        => Res := F460A00.Others_Exception;
-    end Proc;
- end C460A01_2;
- 
- 
-      --==================================================================--
- 
- 
- with F460A00;
- with C460A01_0;
- with C460A01_1;
- with C460A01_2;
- 
- with Report;
- procedure C460A01 is
- begin -- C460A01.                                              -- [ Level = 1 ]
- 
-    Report.Test ("C460A01", "Run-time accessibility checks: instance " &
-                 "bodies. Operand type of access type conversion is "  &
-                 "passed as actual to instance");
- 
- 
-    SUBTEST1:
-    declare                                                     -- [ Level = 2 ]
-       type AccTag_L2 is access all F460A00.Tagged_Type;
-       Operand: AccTag_L2 := new F460A00.Tagged_Type;
- 
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST1.
- 
-       declare                                                  -- [ Level = 3 ]
-          -- The instantiation of C460A01_0 should NOT result in any
-          -- exceptions.
- 
-          package Pack_OK is new C460A01_0 (F460A00.Tagged_Type, AccTag_L2);
-          Target : Pack_OK.Target_Type;
-       begin
-          -- The accessibility level of Pack_OK.Target_Type will always be at
-          -- least as deep as the operand type passed as an actual. Thus,
-          -- a call to Pack_OK.Convert does not propagate an exception:
- 
-          Target := Pack_OK.Convert(Operand);
- 
-          -- Avoid optimization (dead variable removal of Target):
-          if not Report.Equal (Target.C, Target.C) then      -- Always false.
-             Report.Failed ("Unexpected error in SUBTEST #1");
-          end if;
- 
-          Result := F460A00.OK;                              -- Expected result.
-       exception
-          when Program_Error => Result := F460A00.PE_Exception;
-          when others        => Result := F460A00.Others_Exception;
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #1: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #1: Unexpected exception raised");
-    end SUBTEST1;
- 
- 
- 
-    SUBTEST2:
-    declare                                                     -- [ Level = 2 ]
-       type AccTag_L2 is access all F460A00.Tagged_Type;
-       Operand : AccTag_L2 := new F460A00.Tagged_Type;
- 
-       Result  : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST2.
- 
-       declare                                                  -- [ Level = 3 ]
- 
-          type AccTag_L3 is access all F460A00.Tagged_Type;
-          Target : AccTag_L3;
- 
-          -- The instantiation of C460A01_1 should NOT result in any
-          -- exceptions.
- 
-          package Pack_OK is new C460A01_1
-            (Designated_Type => F460A00.Tagged_Type,
-             Operand_Type    => AccTag_L2,
-             Target_Type     => AccTag_L3);
-       begin
-          -- The accessibility level of the actual passed as the operand type
-          -- in Pack_OK is 2. The accessibility level of the actual passed as
-          -- the target type is 3. Therefore, the access type conversion in
-          -- Pack_OK.Convert does not raise an exception when the subprogram is
-          -- called. If an exception is (incorrectly) raised, it is propagated 
-          -- to the innermost enclosing master:
- 
-          Target := Pack_OK.Convert(Operand);
- 
-          -- Avoid optimization (dead variable removal of Target):
-          if not Report.Equal (Target.C, Target.C) then      -- Always false.
-             Report.Failed ("Unexpected error in SUBTEST #2");
-          end if;
- 
-          Result := F460A00.OK;                              -- Expected result.
-       exception
-          when Program_Error => Result := F460A00.PE_Exception;
-          when others        => Result := F460A00.Others_Exception;
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #2");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #2: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #2: Unexpected exception raised");
-    end SUBTEST2;
- 
- 
- 
-    SUBTEST3:
-    declare                                                     -- [ Level = 2 ]
-       type AccTag_L2 is access all F460A00.Tagged_Type;
-       Target : AccTag_L2;
- 
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST3.
- 
-       declare                                                  -- [ Level = 3 ]
- 
-          type AccTag_L3 is access all F460A00.Tagged_Type;
-          Operand : AccTag_L3 := new F460A00.Tagged_Type;
- 
-          -- The instantiation of C460A01_1 should NOT result in any
-          -- exceptions.
- 
-          package Pack_PE is new C460A01_1
-            (Designated_Type => F460A00.Tagged_Type,
-             Operand_Type    => AccTag_L3,
-             Target_Type     => AccTag_L2);
-       begin
-          -- The accessibility level of the actual passed as the operand type
-          -- in Pack_PE is 3. The accessibility level of the actual passed as
-          -- the target type is 2. Therefore, the access type conversion in
-          -- Pack_PE.Convert raises Program_Error when the subprogram is
-          -- called. The exception is propagated to the innermost enclosing
-          -- master:
- 
-          Target := Pack_PE.Convert(Operand);
- 
-          -- Avoid optimization (dead variable removal of Target):
-          if not Report.Equal (Target.C, Target.C) then      -- Always false.
-             Report.Failed ("Unexpected error in SUBTEST #3");
-          end if;
- 
-          Result := F460A00.OK;
-       exception
-          when Program_Error => Result := F460A00.PE_Exception; 
-                                                           -- Expected result.
-          when others        => Result := F460A00.Others_Exception;
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #3");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #3: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #3: Unexpected exception raised");
-    end SUBTEST3;
- 
- 
- 
-    SUBTEST4:
-    declare                                                     -- [ Level = 2 ]
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST4.
- 
-       declare                                                  -- [ Level = 3 ]
- 
-          TType   :  F460A00.Tagged_Type;
-          Operand :  F460A00.AccTagClass_L0 
-                  := new F460A00.Tagged_Type'(TType);
- 
-          -- The instantiation of C460A01_2 should NOT result in any
-          -- exceptions.
- 
-          package Pack_OK is new C460A01_2 (F460A00.Tagged_Type'Class,
-                                            F460A00.AccTagClass_L0);
-       begin
-          -- The accessibility level of the actual passed as the operand type
-          -- in Pack_OK is 0. The accessibility level of the target type
-          -- (F460A00.AccTag_L0) is also 0. Therefore, the access type
-          -- conversion in Pack_OK.Proc does not raise an exception when the
-          -- subprogram is called. If an exception is (incorrectly) raised, 
-          -- it is handled within the subprogram:
- 
-          Pack_OK.Proc(Operand, Result);
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #4");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #4: Unexpected exception raised");
-    end SUBTEST4;
- 
- 
- 
-    SUBTEST5:
-    declare                                                     -- [ Level = 2 ]
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST5.
- 
-       declare                                                  -- [ Level = 3 ]
- 
-          type AccDerTag_L3 is access all F460A00.Derived_Tagged_Type;
-          Operand : AccDerTag_L3 := new F460A00.Derived_Tagged_Type;
- 
-          -- The instantiation of C460A01_2 should NOT result in any
-          -- exceptions.
- 
-          package Pack_PE is new C460A01_2 (F460A00.Derived_Tagged_Type,
-                                            AccDerTag_L3);
-       begin
-          -- The accessibility level of the actual passed as the operand type
-          -- in Pack_PE is 3. The accessibility level of the target type
-          -- (F460A00.AccTag_L0) is 0. Therefore, the access type conversion
-          -- in Pack_PE.Proc raises Program_Error when the subprogram is
-          -- called. The exception is handled within the subprogram:
- 
-          Pack_PE.Proc(Operand, Result);
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #5");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #5: Unexpected exception raised");
-    end SUBTEST5;
- 
-    Report.Result;
- 
- end C460A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c460a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c460a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,413 ****
- -- C460A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the target type of a type conversion is a general
- --      access type, Program_Error is raised if the accessibility level of
- --      the operand type is deeper than that of the target type. Check for
- --      cases where the type conversion occurs in an instance body, and
- --      the operand type is declared inside the instance or is the anonymous
- --      access type of an access parameter or access discriminant.
- --
- -- TEST DESCRIPTION:
- --      In order to satisfy accessibility requirements, the operand type must
- --      be at the same or a less deep nesting level than the target type -- the
- --      operand type must "live" as long as the target type. Nesting levels
- --      are the run-time nestings of masters: block statements; subprogram,
- --      task, and entry bodies; and accept statements. Packages are invisible
- --      to accessibility rules.
- --
- --      This test checks for cases where the operand is a component of a
- --      generic formal object, a stand-alone object, and an access parameter.
- --
- --      The test declares three generic units, each containing an access
- --      type conversion in which the target type is a formal type:
- --
- --         (1) A generic package in which the operand type is the anonymous
- --             access type of an access discriminant, and the conversion
- --             occurs within the declarative part of the body.
- --
- --         (2) A generic package in which the operand type is declared within
- --             the specification, and the conversion occurs within the
- --             sequence of statements of the body.
- --
- --         (3) A generic procedure in which the operand type is the anonymous
- --             access type of an access parameter, and the conversion occurs
- --             within the sequence of statements.
- --
- --      The test verifies the following:
- --
- --         For (1), Program_Error is raised when the package is instantiated
- --         if the actual passed through the formal object has an accessibility
- --         level deeper than that of the target type passed as an actual, and
- --         that no exception is raised otherwise. The exception is propagated
- --         to the innermost enclosing master.
- --
- --         For (2), Program_Error is raised when the package is instantiated
- --         if the package is instantiated at a level deeper than that of the
- --         target type passed as an actual, and that no exception is raised
- --         otherwise. The exception is handled within the package body.
- --
- --         For (3), Program_Error is raised when the instance procedure is
- --         called if the actual passed through the access parameter has an
- --         accessibility level deeper than that of the target type passed as
- --         an actual, and that no exception is raised otherwise. The exception
- --         is handled within the instance procedure.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F460A00.A
- --      => C460A02.A
- --
- --
- -- CHANGE HISTORY:
- --      10 May 95   SAIC    Initial prerelease version.
- --      24 Apr 96   SAIC    Changed the target type formal to be 
- --                          access-to-constant; Modified code to avoid dead 
- --                          variable optimization.
- --
- --!
- 
- with F460A00;
- generic
-    type Target_Type is access all F460A00.Tagged_Type;
-    FObj: in out F460A00.Composite_Type;
- package C460A02_0 is
-    procedure Dummy; -- Needed to allow package body.
- end C460A02_0;
- 
- 
-      --==================================================================--
- 
- with Report;
- package body C460A02_0 is
-    Ptr: Target_Type := Target_Type(FObj.D);
- 
-    procedure Dummy is
-    begin
-       null;
-    end Dummy;
- 
- begin
-    -- Avoid optimization (dead variable removal of Ptr):
-    if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
-       Report.Failed ("Unexpected error in C460A02_0 instance");
-    end if;
- 
- end C460A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with F460A00;
- generic
-    type Designated_Type is private;
-    type Target_Type is access all Designated_Type;
-    FObj : in out Target_Type;
-    FRes : in out F460A00.TC_Result_Kind;
- package C460A02_1 is
-    type Operand_Type is access Designated_Type;
-    Ptr : Operand_Type := new Designated_Type;
- 
-    procedure Dummy; -- Needed to allow package body.
- end C460A02_1;
- 
- 
-      --==================================================================--
- 
- 
- package body C460A02_1 is
-    procedure Dummy is
-    begin
-       null;
-    end Dummy;
- begin
-    FRes := F460A00.UN_Init;
-    FObj := Target_Type(Ptr);
-    FRes := F460A00.OK;
- exception
-    when Program_Error => FRes := F460A00.PE_Exception;
-    when others        => FRes := F460A00.Others_Exception;
- end C460A02_1;
- 
- 
-      --==================================================================--
- 
- 
- with F460A00;
- generic
-    type Designated_Type is new F460A00.Tagged_Type with private;
-    type Target_Type is access constant Designated_Type;
- procedure C460A02_2 (P   : access Designated_Type'Class;
-                      Res : out    F460A00.TC_Result_Kind);
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- procedure C460A02_2 (P   : access Designated_Type'Class;
-                      Res : out    F460A00.TC_Result_Kind) is
-    Ptr : Target_Type;
- begin
-    Res := F460A00.UN_Init;
-    Ptr := Target_Type(P);
- 
-    -- Avoid optimization (dead variable removal of Ptr):
-    if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
-       Report.Failed ("Unexpected error in C460A02_2 instance");
-    end if;
-    Res := F460A00.OK;
- exception
-    when Program_Error => Res := F460A00.PE_Exception;
-    when others        => Res := F460A00.Others_Exception;
- end C460A02_2;
- 
- 
-      --==================================================================--
- 
- 
- with F460A00;
- with C460A02_0;
- with C460A02_1;
- with C460A02_2;
- 
- with Report;
- procedure C460A02 is
- begin -- C460A02.                                              -- [ Level = 1 ]
- 
-    Report.Test ("C460A02", "Run-time accessibility checks: instance " &
-                 "bodies. Operand type of access type conversion is "  &
-                 "declared inside instance or is anonymous");
- 
- 
-    SUBTEST1:
-    declare                                                     -- [ Level = 2 ]
-       type AccTag_L2 is access all F460A00.Tagged_Type;
-       PTag_L2    : AccTag_L2 := new F460A00.Tagged_Type;
-       Operand_L2 : F460A00.Composite_Type(PTag_L2);
- 
-       Result     : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST1.
- 
-       begin                                                    -- [ Level = 3 ]
-          declare                                               -- [ Level = 4 ]
-             -- The accessibility level of the actual passed as the target type
-             -- in Pack_OK is 2. The accessibility level of the composite actual
-             -- (and thus, the level of the anonymous type of the access
-             -- discriminant, which is the same as that of the containing 
-             -- object) is also 2. Therefore, the access type conversion in 
-             -- Pack_OK does not raise an exception upon instantiation:
- 
-             package Pack_OK is new C460A02_0 
-               (Target_Type => AccTag_L2, FObj => Operand_L2);
-          begin
-             Result := F460A00.OK;                           -- Expected result.
-          end;
-       exception
-          when Program_Error => Result := F460A00.PE_Exception;
-          when others        => Result := F460A00.Others_Exception;
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
- 
-    end SUBTEST1;
- 
- 
- 
-    SUBTEST2:
-    declare                                                     -- [ Level = 2 ]
-       type AccTag_L2 is access all F460A00.Tagged_Type;
-       PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;
- 
-       Result  : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST2.
- 
-       declare                                                  -- [ Level = 3 ]
-          Operand_L3 : F460A00.Composite_Type(PTag_L2);
-       begin
-          declare                                               -- [ Level = 4 ]
-             -- The accessibility level of the actual passed as the target type
-             -- in Pack_PE is 2. The accessibility level of the composite actual
-             -- (and thus, the level of the anonymous type of the access
-             -- discriminant, which is the same as that of the containing 
-             -- object) is 3. Therefore, the access type conversion in Pack_PE 
-             -- propagates Program_Error upon instantiation:
- 
-             package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3);
-          begin
-             Result := F460A00.OK;
-          end;
-       exception
-          when Program_Error => Result := F460A00.PE_Exception;       
-                                                           -- Expected result.
-          when others        => Result := F460A00.Others_Exception;
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2");
- 
-    end SUBTEST2;
- 
- 
- 
-    SUBTEST3:
-    declare                                                     -- [ Level = 2 ]
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST3.
- 
-       declare                                                  -- [ Level = 3 ]
-          type AccArr_L3 is access all F460A00.Array_Type;
-          Target: AccArr_L3;
- 
-          -- The accessibility level of the actual passed as the target type
-          -- in Pack_OK is 3. The accessibility level of the operand type is
-          -- that of the instance, which is also 3. Therefore, the access type
-          -- conversion in Pack_OK does not raise an exception upon
-          -- instantiation. If an exception is (incorrectly) raised, it is 
-          -- handled within the instance:
- 
-          package Pack_OK is new C460A02_1
-            (Designated_Type => F460A00.Array_Type,
-             Target_Type     => AccArr_L3,
-             FObj            => Target,
-             FRes            => Result);
-       begin
-          null;
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated");
-       when others        =>
-          Report.Failed ("SUBTEST #3: Unexpected exception propagated");
-    end SUBTEST3;
- 
- 
- 
-    SUBTEST4:
-    declare                                                     -- [ Level = 2 ]
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST4.
- 
-       declare                                                  -- [ Level = 3 ]
-          Target: F460A00.AccArr_L0;
- 
-          -- The accessibility level of the actual passed as the target type
-          -- in Pack_PE is 0. The accessibility level of the operand type is
-          -- that of the instance, which is 3. Therefore, the access type
-          -- conversion in Pack_PE raises Program_Error upon instantiation.
-          -- The exception is handled within the instance:
- 
-          package Pack_PE is new C460A02_1
-            (Designated_Type => F460A00.Array_Type,
-             Target_Type     => F460A00.AccArr_L0,
-             FObj            => Target,
-             FRes            => Result);
-       begin
-          null;
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #4: Unexpected exception raised");
-    end SUBTEST4;
- 
- 
- 
-    SUBTEST5:
-    declare                                                     -- [ Level = 2 ]
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST5.
- 
-       declare                                                  -- [ Level = 3 ]
-          -- The instantiation of C460A02_2 should NOT result in any
-          -- exceptions.
- 
-          procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
-                                           F460A00.AccTag_L0);
-       begin
-          -- The accessibility level of the actual passed to Proc is 0. The
-          -- accessibility level of the actual passed as the target type is
-          -- also 0. Therefore, the access type conversion in Proc does not
-          -- raise an exception when the subprogram is called. If an exception
-          -- is (incorrectly) raised, it is handled within the subprogram:
- 
-          Proc (F460A00.PTagClass_L0, Result);
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #5: Unexpected exception raised");
-    end SUBTEST5;
- 
- 
- 
-    SUBTEST6:
-    declare                                                     -- [ Level = 2 ]
-       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
-    begin -- SUBTEST6.
- 
-       declare                                                  -- [ Level = 3 ]
-          -- The instantiation of C460A02_2 should NOT result in any
-          -- exceptions.
- 
-          procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
-                                           F460A00.AccTag_L0);
-       begin
-          -- In the call to (instantiated) procedure Proc, the first actual
-          -- parameter is an allocator. Its accessibility level is that of 
-          -- the level of execution of Proc, which is 3. The accessibility 
-          -- level of the actual passed as the target type is 0.  Therefore, 
-          -- the access type conversion in Proc raises Program_Error when the
-          -- subprogram is called. The exception is handled within the
-          -- subprogram:
- 
-          Proc (new F460A00.Tagged_Type, Result);
-       end;
- 
-       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6");
- 
-    exception
-       when Program_Error =>
-          Report.Failed ("SUBTEST #6: Program_Error incorrectly raised");
-       when others        =>
-          Report.Failed ("SUBTEST #6: Unexpected exception raised");
-    end SUBTEST6;
- 
-    Report.Result;
- 
- end C460A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- C47002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
- -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
- -- THIS TEST IS FOR DISCRETE TYPES.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47002A IS
- 
- BEGIN
- 
-      TEST( "C47002A", "CHECK THAT VALUES HAVING DISCRETE TYPES " &
-                       "CAN BE WRITTEN AS THE OPERANDS OF " &
-                       "QUALIFIED EXPRESSIONS" );
- 
-      DECLARE  -- ENUMERATION TYPES.
-           
-           TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
-           TYPE WEEKEND IS (SAT, SUN);
- 
-           TYPE CHAR IS ('B', 'A');
- 
-           TYPE MYBOOL IS (TRUE, FALSE);
-           
-           TYPE NBOOL IS NEW BOOLEAN;
- 
-      BEGIN
-           IF WEEKEND'(SAT) >= SUN THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE WEEKEND" );
-           END IF;
- 
-           IF CHAR'('B') >= 'A' THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE CHAR" );
-           END IF;
- 
-           IF MYBOOL'(TRUE) >= FALSE THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE MYBOOL" );
-           END IF;
- 
-           IF NBOOL'(TRUE) <= FALSE THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE NBOOL" );
-           END IF;
-      END;
- 
-      DECLARE -- INTEGER TYPES.
- 
-           TYPE RESULTS IS (INT1, INT2, INT3);
-    
-           TYPE NEWINT IS NEW INTEGER;
-           
-           TYPE INT IS RANGE -10 .. 10;
- 
-           FUNCTION F (I : NEWINT) RETURN RESULTS IS
-           BEGIN
-                RETURN INT1;
-           END F;
- 
-           FUNCTION F (I : INT) RETURN RESULTS IS
-           BEGIN
-                RETURN INT2;
-           END F;
- 
-           FUNCTION F (I : INTEGER) RETURN RESULTS IS
-           BEGIN
-                RETURN INT3;
-           END F;
- 
-      BEGIN
-           IF F (NEWINT'(5)) /= INT1 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE NEWINT" );
-           END IF;
- 
-           IF F (INT'(5)) /= INT2 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE INT" );
-           END IF;
- 
-           IF F (INTEGER'(5)) /= INT3 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE INTEGER" );
-           END IF;
-      END;
- 
-      RESULT;
- END C47002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- C47002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
- -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
- -- THIS TEST IS FOR REAL TYPES.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47002B IS
- 
- BEGIN
- 
-      TEST( "C47002B", "CHECK THAT VALUES HAVING REAL TYPES " &
-                       "CAN BE WRITTEN AS THE OPERANDS OF " &
-                       "QUALIFIED EXPRESSIONS" );
- 
-      DECLARE -- FLOATING POINT TYPES.
-      
-           TYPE RESULTS IS (FL1, FL2, FL3);
- 
-           TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
- 
-           TYPE NFLT IS NEW FLOAT;
- 
-           FUNCTION F (FL : FLT) RETURN RESULTS IS 
-           BEGIN
-                RETURN FL1;
-           END F;
- 
-           FUNCTION F (FL : NFLT) RETURN RESULTS IS
-           BEGIN
-                RETURN FL2;
-           END F;
- 
-           FUNCTION F (FL : FLOAT) RETURN RESULTS IS
-           BEGIN
-                RETURN FL3;
-           END F;
- 
-      BEGIN
-           IF F (FLT'(0.0)) /= FL1 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE FLT" );
-           END IF;
- 
-           IF F (NFLT'(0.0)) /= FL2 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE NFLT" );
-           END IF;
- 
-           IF F (FLOAT'(0.0)) /= FL3 THEN 
-                FAILED ( "INCORRECT RESULTS FOR TYPE FLOAT" );
-           END IF;
-      END;   
-      
-      DECLARE -- FIXED POINT TYPES.
-      
-           TYPE RESULTS IS (FI1, FI2, FI3);
- 
-           TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
- 
-           TYPE NFIX IS NEW FIXED;
- 
-           FUNCTION F (FI : FIXED) RETURN RESULTS IS 
-           BEGIN
-                RETURN FI1;
-           END F;
- 
-           FUNCTION F (FI : NFIX) RETURN RESULTS IS
-           BEGIN
-                RETURN FI2;
-           END F;
- 
-           FUNCTION F (FI : DURATION) RETURN RESULTS IS
-           BEGIN
-                RETURN FI3;
-           END F;
- 
-      BEGIN
-           IF F (FIXED'(0.0)) /= FI1 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE FIXED" );
-           END IF;
- 
-           IF F (NFIX'(0.0)) /= FI2 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE NFIX" );
-           END IF;
- 
-           IF F (DURATION'(0.0)) /= FI3 THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE DURATION" );
-           END IF;
-      END;   
-      
-      RESULT;
- END C47002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,212 ****
- -- C47002C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
- -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
- -- THIS TEST IS FOR ARRAY, RECORD, AND ACCESS TYPES.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47002C IS
- 
- BEGIN
- 
-      TEST( "C47002C", "CHECK THAT VALUES HAVING ARRAY, RECORD, AND " &
-                       "ACCESS TYPES CAN BE WRITTEN AS THE OPERANDS " &
-                       "OF QUALIFIED EXPRESSIONS" );
- 
-      DECLARE -- ARRAY TYPES.
-      
-           TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           SUBTYPE ARR1 IS ARR (1 .. 1);
-           SUBTYPE ARR5 IS ARR (1 .. 5);
- 
-           TYPE NARR IS NEW ARR;
-           SUBTYPE NARR2 IS NARR (2 .. 2);
- 
-           TYPE TARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 
-                OF INTEGER;
-           SUBTYPE TARR15 IS TARR (1 .. 1, 1 .. 5);
-           SUBTYPE TARR51 IS TARR (1 .. 5, 1 .. 1);
- 
-           TYPE NTARR IS NEW TARR;
-           SUBTYPE NTARR26 IS NTARR (2 .. 6, 2 .. 6);
- 
-           FUNCTION F (X : ARR) RETURN ARR IS
-           BEGIN
-                RETURN X;
-           END;
- 
-           FUNCTION F (X : NARR) RETURN NARR IS
-           BEGIN
-                RETURN X;
-           END;
- 
-           FUNCTION F (X : TARR) RETURN TARR IS
-           BEGIN
-                RETURN X;
-           END;
- 
-           FUNCTION F (X : NTARR) RETURN NTARR IS
-           BEGIN
-                RETURN X;
-           END;
- 
-      BEGIN
-           IF F (ARR1'(OTHERS => 0))'LAST /= 1 THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR1" );
-           END IF;
- 
-           IF F (ARR5'(OTHERS => 0))'LAST /= 5 THEN 
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR5" );
-           END IF;
- 
-           IF F (NARR2'(OTHERS => 0))'FIRST /= 2 OR 
-              F (NARR2'(OTHERS => 0))'LAST /= 2 THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE NARR2" );
-           END IF;
- 
-           IF F (TARR15'(OTHERS => (OTHERS => 0)))'LAST /= 1 OR 
-              F (TARR15'(OTHERS => (OTHERS => 0)))'LAST (2) /= 5 THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR15" );
-           END IF;
- 
-           IF F (TARR51'(OTHERS => (OTHERS => 0)))'LAST /= 5 OR 
-              F (TARR51'(OTHERS => (OTHERS => 0)))'LAST (2) /= 1 THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR51" );
-           END IF;
- 
-           IF F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST /= 2 OR 
-              F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST /= 6 OR
-              F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST (2) /= 2 OR 
-              F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST (2) /= 6 THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE NTARR26" );
-           END IF;
- 
-      END;   
-      
-      DECLARE -- RECORD TYPES.
- 
-           TYPE GENDER IS (MALE, FEMALE, NEUTER);
-           
-           TYPE MAN IS
-                RECORD
-                     AGE : POSITIVE;
-                END RECORD;
- 
-           TYPE WOMAN IS
-                RECORD
-                     AGE : POSITIVE;
-                END RECORD;
- 
-           TYPE ANDROID IS NEW MAN;
-           
-           FUNCTION F (X: WOMAN) RETURN GENDER IS
-           BEGIN
-                RETURN FEMALE;
-           END F;
- 
-           FUNCTION F (X: MAN) RETURN GENDER IS
-           BEGIN
-                RETURN MALE;
-           END F;
-           
-           FUNCTION F (X : ANDROID) RETURN GENDER IS
-           BEGIN
-                RETURN NEUTER;
-           END F;
- 
-      BEGIN
-           IF F (MAN'(AGE => 23)) /= MALE THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE MAN" );
-           END IF;
- 
-           IF F (WOMAN'(AGE => 38)) /= FEMALE THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE WOMAN" );
-           END IF;
- 
-           IF F (ANDROID'(AGE => 2001)) /= NEUTER THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE ANDRIOD" );
-           END IF;
-      END;     
-                     
-      DECLARE -- ACCESS TYPES.
- 
-           TYPE CODE IS (OLD, BRANDNEW, WRECK);
-           
-           TYPE CAR (D : CODE) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE KEY IS ACCESS CAR;
- 
-           TYPE KEY_OLD IS ACCESS CAR (OLD);
-           KO : KEY_OLD := NEW CAR'(D => OLD);          
- 
-           TYPE KEY_WRECK IS ACCESS CAR (WRECK);
- 
-           TYPE KEY_CARD IS NEW KEY;
-           KC : KEY_CARD := NEW CAR'(D => BRANDNEW);          
-  
-           FUNCTION F (X : KEY_OLD) RETURN CODE IS
-           BEGIN
-                RETURN OLD;
-           END F;
- 
-           FUNCTION F (X : KEY_WRECK) RETURN CODE IS
-           BEGIN
-                RETURN WRECK;
-           END F;
- 
-           FUNCTION F (X : KEY_CARD) RETURN CODE IS
-           BEGIN
-                RETURN BRANDNEW;
-           END F;
-      BEGIN
-           IF KEY_OLD'(KO) /= KO THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE KEY_OLD - 1" );
-           END IF;
- 
-           IF KEY_CARD'(KC) /= KC THEN 
-                FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 1" );
-           END IF;
- 
- 
-           IF F (KEY_OLD'(NULL)) /= OLD THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_OLD - 2" );
-           END IF;
- 
-           IF F (KEY_WRECK'(NULL)) /= WRECK THEN
-                FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_WRECK" );
-           END IF;
- 
-           IF F (KEY_CARD'(NULL)) /= BRANDNEW THEN
-                FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 2" );
-           END IF;
-      END;
-           
-      RESULT;
- END C47002C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47002d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47002d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,273 ****
- -- C47002D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
- -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
- -- THIS TEST IS FOR PRIVATE AND LIMITED PRIVATE TYPES.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47002D IS
- 
- BEGIN
- 
-      TEST( "C47002D", "CHECK THAT VALUES HAVING PRIVATE AND LIMITED " &
-                       "PRIVATE TYPES CAN BE WRITTEN AS THE OPERANDS " &
-                       "OF QUALIFIED EXPRESSIONS" );
- 
-      DECLARE -- PRIVATE TYPES.
- 
-           TYPE RESULTS IS (P1, P2, P3, P4, P5);
- 
-           PACKAGE PKG1 IS
-                TYPE PINT IS PRIVATE;
-                TYPE PCHAR IS PRIVATE;
-                TYPE PARR IS PRIVATE;
-                TYPE PREC (D : INTEGER) IS PRIVATE;
-                TYPE PACC IS PRIVATE;
- 
-                FUNCTION F RETURN PINT;
-                FUNCTION F RETURN PCHAR;
-                FUNCTION F RETURN PARR;
-                FUNCTION F RETURN PREC;
-                FUNCTION F RETURN PACC;
- 
-           PRIVATE
-                TYPE PINT IS NEW INTEGER;
-                TYPE PCHAR IS NEW CHARACTER;
-                TYPE PARR IS ARRAY (1 .. 2) OF NATURAL;
- 
-                TYPE PREC (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-      
-                TYPE PACC IS ACCESS PREC;
- 
-           END PKG1;
-           
-           PACKAGE BODY PKG1 IS
-                FUNCTION F RETURN PINT IS
-                BEGIN
-                     RETURN 1;
-                END F;
-                     
-                FUNCTION F RETURN PCHAR IS
-                BEGIN
-                     RETURN 'B';
-                END F;
- 
-                FUNCTION F RETURN PARR IS
-                BEGIN
-                     RETURN PARR'(OTHERS => 3);
-                END F;
- 
-                FUNCTION F RETURN PREC IS
-                BEGIN
-                     RETURN PREC'(D => 4);
-                END F;
- 
-                FUNCTION F RETURN PACC IS
-                BEGIN
-                     RETURN NEW PREC'(F);
-                END F;
- 
-           END PKG1;
-                     
-           PACKAGE PKG2 IS END PKG2;
- 
-           PACKAGE BODY PKG2 IS
-                USE PKG1;
- 
-                FUNCTION CHECK (P : PINT) RETURN RESULTS IS
-                BEGIN
-                     RETURN  P1;
-                END CHECK;
-      
-                FUNCTION CHECK (P : PCHAR) RETURN RESULTS IS
-                BEGIN
-                     RETURN  P2;
-                END CHECK;
-      
-                FUNCTION CHECK (P : PARR) RETURN RESULTS IS
-                BEGIN
-                     RETURN  P3;
-                END CHECK;
-      
-                FUNCTION CHECK (P : PREC) RETURN RESULTS IS
-                BEGIN
-                     RETURN  P4;
-                END CHECK;
- 
-                FUNCTION CHECK (P : PACC) RETURN RESULTS IS
-                BEGIN
-                     RETURN  P5;
-                END CHECK;
-           
-           BEGIN              
-                IF CHECK (PINT'(F)) /= P1 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE PINT" );
-                END IF;
- 
-                IF CHECK (PCHAR'(F)) /= P2 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE PCHAR" );
-                END IF;
-                  
-                IF CHECK (PARR'(F)) /= P3 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE PARR" );
-                END IF;
-                  
-                IF CHECK (PREC'(F)) /= P4 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE PREC" );
-                END IF;
- 
-                IF CHECK (PACC'(F)) /= P5 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE PACC" );
-                END IF;
-                  
-           END PKG2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE -- LIMITED PRIVATE TYPES.
- 
-           TYPE RESULTS IS (LP1, LP2, LP3, LP4, LP5);
- 
-           PACKAGE PKG1 IS
-                TYPE LPINT IS LIMITED PRIVATE;
-                TYPE LPCHAR IS LIMITED PRIVATE;
-                TYPE LPARR IS LIMITED PRIVATE;
-                TYPE LPREC (D : INTEGER) IS LIMITED PRIVATE;
-                TYPE LPACC IS LIMITED PRIVATE;
- 
-                FUNCTION F RETURN LPINT;
-                FUNCTION F RETURN LPCHAR;
-                FUNCTION F RETURN LPARR;
-                FUNCTION F RETURN LPREC;
-                FUNCTION F RETURN LPACC;
- 
-           PRIVATE
-                TYPE LPINT IS NEW INTEGER;
-                TYPE LPCHAR IS NEW CHARACTER;
-                TYPE LPARR IS ARRAY (1 .. 2) OF NATURAL;
- 
-                TYPE LPREC (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-      
-                TYPE LPACC IS ACCESS LPREC;
- 
-           END PKG1;
-           
-           PACKAGE BODY PKG1 IS
-                FUNCTION F RETURN LPINT IS
-                BEGIN
-                     RETURN 1;
-                END F;
-                     
-                FUNCTION F RETURN LPCHAR IS
-                BEGIN
-                     RETURN 'B';
-                END F;
- 
-                FUNCTION F RETURN LPARR IS
-                BEGIN
-                     RETURN LPARR'(OTHERS => 3);
-                END F;
- 
-                FUNCTION F RETURN LPREC IS
-                BEGIN
-                     RETURN LPREC'(D => 4);
-                END F;
- 
-                FUNCTION F RETURN LPACC IS
-                BEGIN
-                     RETURN NEW LPREC'(F);
-                END F;
- 
-           END PKG1;
-                     
-           PACKAGE PKG2 IS END PKG2;
- 
-           PACKAGE BODY PKG2 IS
-                USE PKG1;
- 
-                FUNCTION CHECK (LP : LPINT) RETURN RESULTS IS
-                BEGIN
-                     RETURN  LP1;
-                END CHECK;
-      
-                FUNCTION CHECK (LP : LPCHAR) RETURN RESULTS IS
-                BEGIN
-                     RETURN  LP2;
-                END CHECK;
-      
-                FUNCTION CHECK (LP : LPARR) RETURN RESULTS IS
-                BEGIN
-                     RETURN  LP3;
-                END CHECK;
-      
-                FUNCTION CHECK (LP : LPREC) RETURN RESULTS IS
-                BEGIN
-                     RETURN  LP4;
-                END CHECK;
- 
-                FUNCTION CHECK (LP : LPACC) RETURN RESULTS IS
-                BEGIN
-                     RETURN  LP5;
-                END CHECK;
-           
-           BEGIN              
-                IF CHECK (LPINT'(F)) /= LP1 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE LPINT" );
-                END IF;
- 
-                IF CHECK (LPCHAR'(F)) /= LP2 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE LPCHAR" );
-                END IF;
-                  
-                IF CHECK (LPARR'(F)) /= LP3 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE LPARR" );
-                END IF;
-                  
-                IF CHECK (LPREC'(F)) /= LP4 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE LPREC" );
-                END IF;
- 
-                IF CHECK (LPACC'(F)) /= LP5 THEN
-                     FAILED ( "INCORRECT RESULTS FOR TYPE LPACC" );
-                END IF;
-                  
-           END PKG2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C47002D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- C47003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN 
- -- ENUMERATION TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE 
- -- VALUE OF THE OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47003A IS
- 
- BEGIN
- 
-      TEST( "C47003A", "WHEN THE TYPE MARK IN A QUALIFIED " &
-                       "EXPRESSION DENOTES AN ENUMERATION " &
-                       "TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
-                       "WITHIN THE RANGE OF THE TYPE MARK" );
- 
-      DECLARE  
-           
-           TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
-           SUBTYPE MIDWEEK IS WEEK RANGE TUE .. THU;
- 
-           FUNCTION IDENT (W : WEEK) RETURN WEEK IS
-           BEGIN
-                RETURN WEEK'VAL (IDENT_INT (WEEK'POS (W)));
-           END IDENT;
- 
-      BEGIN
-           IF MIDWEEK'(IDENT (SUN)) = TUE THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE MIDWEEK - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE MIDWEEK - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE MIDWEEK" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE CHAR IS CHARACTER RANGE 'C' .. 'R';
- 
-      BEGIN
-           IF CHAR'(IDENT_CHAR ('A')) = 'C' THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE CHAR - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE CHAR - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE CHAR" );
-      END;
- 
-      DECLARE  
- 
-           TYPE NBOOL IS NEW BOOLEAN;
-           SUBTYPE NFALSE IS NBOOL RANGE FALSE .. FALSE;
- 
-           FUNCTION IDENT (B : NBOOL) RETURN NBOOL IS
-           BEGIN
-                RETURN NBOOL (IDENT_BOOL (BOOLEAN (B)));
-           END IDENT;
- 
-      BEGIN
-           IF NFALSE'(IDENT (TRUE)) = FALSE THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE NFALSE - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE NFALSE - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE NFALSE" );
-      END;
- 
-      RESULT;
- END C47003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- C47004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN INTEGER 
- -- TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE OF THE 
- -- OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47004A IS
- 
- BEGIN
- 
-      TEST( "C47004A", "WHEN THE TYPE MARK IN A QUALIFIED " &
-                       "EXPRESSION DENOTES AN INTEGER " &
-                       "TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
-                       "WITHIN THE RANGE OF THE TYPE MARK" );
- 
-      DECLARE  
-           
-           TYPE INT IS RANGE -10 .. 10;
-           SUBTYPE SINT IS INT RANGE -5 .. 5;
-           
-           FUNCTION IDENT (I : INT) RETURN INT IS
-           BEGIN
-                RETURN INT (IDENT_INT (INTEGER (I)));
-           END;
- 
-      BEGIN
-           IF SINT'(IDENT (10)) = 5 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SINT - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SINT - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SINT" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE SINTEGER IS INTEGER RANGE -10 .. 10;
-           
-      BEGIN
-           IF SINTEGER'(IDENT_INT (20)) = 15 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SINTEGER - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SINTEGER - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SINTEGER" );
-      END;
- 
-      DECLARE  
-           
-           TYPE NINTEGER IS NEW INTEGER;
-           SUBTYPE SNINT IS NINTEGER RANGE -10 .. 10;
-           
-           FUNCTION IDENT (I : NINTEGER) RETURN NINTEGER IS
-           BEGIN
-                RETURN NINTEGER (IDENT_INT (INTEGER (I)));
-           END;
- 
-      BEGIN
-           IF SNINT'(IDENT (-20)) = -10 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SNINT - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SNINT - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SNINT" );
-      END;
- 
-      RESULT;
- END C47004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C47005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FLOATING
- --     POINT TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE
- --     OF THE OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
- 
- -- HISTORY:
- --     RJW 07/23/86  CREATED ORIGINAL TEST.
- --     BCB 08/19/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  ADDED
- --                   TEST FOR UPPER SIDE OF RANGE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C47005A IS
- 
- BEGIN
- 
-      TEST( "C47005A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
-                       "DENOTES A FLOATING POINT TYPE, CHECK THAT " &
-                       "CONSTRAINT_ERROR IS RAISED WHEN THE VALUE " &
-                       "OF THE OPERAND DOES NOT LIE WITHIN THE " &
-                       "RANGE OF THE TYPE MARK" );
- 
-      DECLARE
- 
-           SUBTYPE SFLOAT IS FLOAT RANGE -1.0 .. 1.0;
- 
-           FUNCTION IDENT (F : FLOAT) RETURN FLOAT IS
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RETURN F;
-                ELSE
-                     RETURN 0.0;
-                END IF;
-           END IDENT;
- 
-      BEGIN
-           IF SFLOAT'(IDENT (-2.0)) = -1.0 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SFLOAT - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SFLOAT - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SFLOAT" );
-      END;
- 
-      DECLARE
- 
-           TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
-           SUBTYPE SFLT IS FLT RANGE -1.0 .. 1.0;
- 
-           FUNCTION IDENT (F : FLT) RETURN FLT IS
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RETURN F;
-                ELSE
-                     RETURN 0.0;
-                END IF;
-           END IDENT;
- 
-      BEGIN
-           IF SFLT'(IDENT (-2.0)) = -1.0 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SFLT - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SFLT - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SFLT" );
-      END;
- 
-      DECLARE
- 
-           TYPE NFLT IS NEW FLOAT;
-           SUBTYPE SNFLT IS NFLT RANGE -1.0 .. 1.0;
- 
-           FUNCTION IDENT (F : NFLT) RETURN NFLT IS
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RETURN F;
-                ELSE
-                     RETURN 0.0;
-                END IF;
-           END IDENT;
- 
-      BEGIN
-           IF SNFLT'(IDENT (2.0)) = 1.0 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SNFLT 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SNFLT 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SNFLT" );
-      END;
- 
-      RESULT;
- END C47005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C47006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FIXED POINT 
- -- TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE OF THE 
- -- OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47006A IS
- 
-      TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
- 
- BEGIN
- 
-      TEST( "C47006A", "WHEN THE TYPE MARK IN A QUALIFIED " &
-                       "EXPRESSION DENOTES A FIXED POINT TYPE, " &
-                       "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
-                       "WITHIN THE RANGE OF THE TYPE MARK" );
- 
-      DECLARE  
- 
-           SUBTYPE SFIXED IS FIXED RANGE -2.0 .. 2.0;
- 
-           FUNCTION IDENT (X : FIXED) RETURN FIXED IS
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RETURN X;
-                ELSE
-                     RETURN 0.0;
-                END IF;
-           END IDENT;
- 
-      BEGIN
-           IF SFIXED'(IDENT (-5.0)) = -2.0 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SFIXED - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SFIXED - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SFIXED" );
-      END;
- 
-      DECLARE  
- 
-           TYPE NFIX IS NEW FIXED;
-           SUBTYPE SNFIX IS NFIX RANGE -2.0 .. 2.0;
- 
-           FUNCTION IDENT (X : NFIX) RETURN NFIX IS
-           BEGIN
-                RETURN NFIX (IDENT_INT (INTEGER (X)));
-           END IDENT;
- 
-      BEGIN
-           IF SNFIX'(IDENT (-5.0)) = -2.0 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SNFIX - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
-                         "SUBTYPE SNFIX - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
-                         "OF SUBTYPE SNFIX" );
-      END;
- 
-      RESULT;
- END C47006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C47007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A CONSTRAINED 
- -- ARRAY TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE BOUNDS 
- -- OF THE OPERAND ARE NOT THE SAME AS THE BOUNDS OF THE TYPE MARK.
- 
- -- RJW 7/23/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C47007A IS
- 
-      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
- 
-      TYPE TARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 
-           OF INTEGER;
- 
-      TYPE NARR IS NEW ARR;
- 
-      TYPE NTARR IS NEW TARR;
- 
- BEGIN
- 
-      TEST( "C47007A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
-                       "DENOTES A CONSTRAINED ARRAY TYPE, CHECK THAT " &
-                       "CONSTRAINT_ERROR IS RAISED WHEN THE BOUNDS " &
-                       "OF THE OPERAND ARE NOT THE SAME AS THE " &
-                       "BOUNDS OF THE TYPE MARK" );
- 
-      DECLARE  
-           
-           SUBTYPE SARR IS ARR (IDENT_INT (1) .. IDENT_INT (1));
-           A : ARR (IDENT_INT (2) .. IDENT_INT (2));
-      BEGIN
-           A := SARR'(A'RANGE => 0);
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE SARR" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE SARR" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE NULLA IS ARR (IDENT_INT (1) .. IDENT_INT (0));
-           A : ARR (IDENT_INT (2) .. IDENT_INT (1));
- 
-      BEGIN
-           A := NULLA'(A'FIRST .. A'LAST => 0);
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE NULLA" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE NULLA" );
-      END;
- 
-      DECLARE  
- 
-           SUBTYPE STARR IS TARR (IDENT_INT (1) .. IDENT_INT (1), 
-                                  IDENT_INT (1) .. IDENT_INT (5));
-           A : TARR (IDENT_INT (2) .. IDENT_INT (6),
-                     IDENT_INT (1) .. IDENT_INT (1));
-      BEGIN
-           A := STARR'(A'RANGE => (A'RANGE (2) => 0));
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE STARR" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE STARR" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE NULLT IS TARR (IDENT_INT (1) .. IDENT_INT (5), 
-                                  IDENT_INT (1) .. IDENT_INT (0));
- 
-           A : TARR (IDENT_INT (1) .. IDENT_INT (5),
-                     IDENT_INT (2) .. IDENT_INT (1));
-      BEGIN
-           A := NULLT'(A'FIRST .. A'LAST  => 
-                      (A'FIRST (2) .. A'LAST (2) => 0));
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE NULLT" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE NULLT" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE SNARR IS NARR (IDENT_INT (1) .. IDENT_INT (1));
-           A : NARR (IDENT_INT (2) .. IDENT_INT (2));
- 
-      BEGIN
-           A := SNARR'(A'RANGE => 0);
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE SNARR" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE SNARR" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE NULLNA IS NARR (IDENT_INT (1) .. IDENT_INT (0));
-           A : NARR (IDENT_INT (2) .. IDENT_INT (1));
- 
-      BEGIN
-           A := NULLNA'(A'RANGE => 0);
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE NULLNA" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE NULLNA" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE SNTARR IS NTARR (IDENT_INT (1) .. IDENT_INT (1), 
-                                    IDENT_INT (1) .. IDENT_INT (5));
- 
-           A : NTARR (IDENT_INT (2) .. IDENT_INT (2),
-                      IDENT_INT (1) .. IDENT_INT (5));
-      BEGIN
-           A := SNTARR'(A'RANGE => (A'RANGE (2) => 0));
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE SNTARR" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE SNTARR" );
-      END;
- 
-      DECLARE  
-           
-           SUBTYPE NULLNT IS NTARR (IDENT_INT (1) .. IDENT_INT (5), 
-                                    IDENT_INT (1) .. IDENT_INT (0));
- 
-           A : NTARR (IDENT_INT (1) .. IDENT_INT (5),
-                     IDENT_INT (1) .. IDENT_INT (1));
-      BEGIN
-           A := NULLNT'(A'RANGE => (A'RANGE (2) => 0));
-           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
-                    "THOSE OF SUBTYPE NULLNT" );
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
-                         "THE SAME AS THOSE OF SUBTYPE NULLNT" );
-      END;
- 
-      RESULT;
- END C47007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,299 ****
- -- C47008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A
- --     CONSTRAINED RECORD, PRIVATE, OR LIMITED PRIVATE TYPE, CHECK THAT
- --     CONSTRAINT_ERROR IS RAISED WHEN THE DISCRIMINANTS OF THE OPERAND
- --     DO NOT EQUAL THOSE OF THE TYPE MARK.
- 
- -- HISTORY:
- --     RJW 07/23/86
- --     DWC 07/24/87  CHANGED CODE TO TEST FOR FIRST DISCRIMINANT
- --                   AND LAST DISCRIMINANT MISMATCH.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C47008A IS
- 
-      TYPE GENDER IS (MALE, FEMALE, NEUTER);
- 
-      FUNCTION IDENT (G : GENDER) RETURN GENDER IS
-      BEGIN
-           RETURN GENDER'VAL (IDENT_INT (GENDER'POS (G)));
-      END IDENT;
- 
- BEGIN
- 
-      TEST( "C47008A", "WHEN THE TYPE MARK IN A QUALIFIED " &
-                       "EXPRESSION DENOTES A CONSTRAINED RECORD, " &
-                       "PRIVATE, OR LIMITED PRIVATE TYPE, CHECK " &
-                       "THAT CONSTRAINT_ERROR IS RAISED WHEN THE " &
-                       "DISCRIMANTS OF THE OPERAND DO NOT EQUAL " &
-                       "THOSE OF THE TYPE MARK" );
- 
-      DECLARE
- 
-           TYPE PERSON (SEX : GENDER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           SUBTYPE WOMAN IS PERSON (IDENT (FEMALE));
-           TOM : PERSON (MALE) := (SEX => IDENT (MALE));
- 
-      BEGIN
-           IF WOMAN'(TOM) = PERSON'(SEX => MALE) THEN
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE WOMAN - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE WOMAN - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
-                         "DISC NOT EQUAL TO THOSE OF SUBTYPE WOMAN" );
-      END;
- 
-      DECLARE
-           TYPE PAIR (SEX1, SEX2 : GENDER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           SUBTYPE COUPLE IS PAIR (IDENT (FEMALE), IDENT (MALE));
-           JONESES : PAIR (IDENT (MALE), IDENT (FEMALE));
- 
-      BEGIN
-           IF COUPLE'(JONESES) = PAIR'(SEX1 => MALE, SEX2 => FEMALE)
-              THEN
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE COUPLE - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE COUPLE - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
-                         "DISC NOT EQUAL TO THOSE OF SUBTYPE COUPLE" );
-      END;
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE PERSON (SEX : GENDER) IS PRIVATE;
-                SUBTYPE MAN IS PERSON (IDENT (MALE));
- 
-                TESTWRITER : CONSTANT PERSON;
- 
-           PRIVATE
-                TYPE PERSON (SEX : GENDER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TESTWRITER : CONSTANT PERSON := (SEX => FEMALE);
- 
-           END PKG;
- 
-           USE PKG;
- 
-           ROSA : PERSON (IDENT (FEMALE));
- 
-      BEGIN
-           IF MAN'(ROSA) = TESTWRITER THEN
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE MAN - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE MAN - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
-                         "DISC NOT EQUAL TO THOSE OF SUBTYPE MAN" );
-      END;
- 
-      DECLARE
-           PACKAGE PKG IS
-                TYPE PAIR (SEX1, SEX2 : GENDER) IS PRIVATE;
-                SUBTYPE FRIENDS IS PAIR (IDENT (FEMALE), IDENT (MALE));
- 
-                ALICE_AND_JERRY : CONSTANT FRIENDS;
- 
-           PRIVATE
-                TYPE PAIR (SEX1, SEX2 : GENDER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                ALICE_AND_JERRY : CONSTANT FRIENDS :=
-                                  (IDENT (FEMALE), IDENT (MALE));
- 
-           END PKG;
- 
-           USE PKG;
- 
-           DICK_AND_JOE : PAIR (IDENT (MALE), IDENT (MALE));
- 
-      BEGIN
-           IF FRIENDS'(DICK_AND_JOE) = ALICE_AND_JERRY THEN
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE FRIENDS - 1");
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
-                         "NOT EQUAL TO THOSE OF SUBTYPE FRIENDS - 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
-                         "DISC NOT EQUAL TO THOSE OF SUBTYPE FRIENDS" );
-      END;
- 
-      DECLARE
- 
-           PACKAGE PKG1 IS
-                TYPE PERSON (SEX : GENDER) IS LIMITED PRIVATE;
-                SUBTYPE ANDROID IS PERSON (IDENT (NEUTER));
- 
-                FUNCTION F RETURN PERSON;
-                FUNCTION "=" (A, B : PERSON) RETURN BOOLEAN;
-           PRIVATE
-                TYPE PERSON (SEX : GENDER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-           END PKG1;
- 
-           PACKAGE BODY PKG1 IS
- 
-                FUNCTION F RETURN PERSON IS
-                BEGIN
-                     RETURN PERSON'(SEX => (IDENT (MALE)));
-                END F;
- 
-                FUNCTION "=" (A, B : PERSON) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN A.SEX = B.SEX;
-                END;
- 
-           END PKG1;
- 
-           PACKAGE PKG2 IS END PKG2;
- 
-           PACKAGE BODY PKG2 IS
-                USE PKG1;
- 
-           BEGIN
-                IF ANDROID'(F) = F THEN
-                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
-                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
-                              "ANDROID - 1");
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
-                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
-                              "ANDROID - 2");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND " &
-                              "WITH DISC NOT EQUAL TO THOSE OF " &
-                              "SUBTYPE ANDROID" );
-           END PKG2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE
-           PACKAGE PKG1 IS
-                TYPE PAIR (SEX1, SEX2 : GENDER) IS LIMITED PRIVATE;
-                SUBTYPE LOVERS IS PAIR (IDENT (FEMALE), IDENT (MALE));
- 
-                FUNCTION F RETURN PAIR;
-                FUNCTION "=" (A, B : PAIR) RETURN BOOLEAN;
-           PRIVATE
-                TYPE PAIR (SEX1, SEX2 : GENDER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PKG1;
- 
-           PACKAGE BODY PKG1 IS
- 
-                FUNCTION F RETURN PAIR IS
-                BEGIN
-                     RETURN PAIR'(SEX1 => (IDENT (FEMALE)),
-                                    SEX2 => (IDENT (FEMALE)));
-                END F;
- 
-                FUNCTION "=" (A, B : PAIR) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN A.SEX1 = B.SEX2;
-                END;
- 
-           END PKG1;
- 
-           PACKAGE PKG2 IS END PKG2;
- 
-           PACKAGE BODY PKG2 IS
-                USE PKG1;
- 
-           BEGIN
-                IF LOVERS'(F) = F THEN
-                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
-                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
-                              "LOVERS - 1");
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
-                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
-                              "LOVERS - 2");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND " &
-                              "WITH DISC NOT EQUAL TO THOSE OF " &
-                              "SUBTYPE LOVERS" );
-           END PKG2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C47008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,254 ****
- -- C47009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A
- --     CONSTRAINED ACCESS TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED
- --     WHEN THE VALUE OF THE OPERAND IS NOT NULL AND THE DESIGNATED
- --     OBJECT HAS INDEX BOUNDS OR DISCRIMINANT VALUES THAT DO NOT EQUAL
- --     THOSE SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT.
- 
- -- HISTORY:
- --     RJW 7/23/86
- --     DWC 07/24/87  REVISED TO MAKE THE ACCESS TYPE UNCONSTRAINED
- --                   AND TO PREVENT DEAD VARIABLE OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C47009A IS
- 
- BEGIN
- 
-      TEST( "C47009A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
-                       "DENOTES A CONSTRAINED ACCESS TYPE, CHECK " &
-                       "THAT CONSTRAINT_ERROR IS RAISED WHEN THE " &
-                       "VALUE OF THE OPERAND IS NOT NULL AND THE " &
-                       "DESIGNATED OBJECT HAS INDEX BOUNDS OR " &
-                       "DISCRIMINANT VALUES THAT DO NOT EQUAL THOSE " &
-                       "SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT" );
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
-           TYPE ACC1 IS ACCESS ARR;
-           SUBTYPE ACC1S IS ACC1 (IDENT_INT (1) .. IDENT_INT (5));
-           A : ACC1;
-           B : ARR (IDENT_INT (2) .. IDENT_INT (6));
- 
-      BEGIN
-           A := ACC1S'(NEW ARR'(B'FIRST .. B'LAST => 0));
-           IF A'FIRST = 1 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC1 - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC1 - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC1" );
-      END;
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
-                OF INTEGER;
-           TYPE ACC2 IS ACCESS ARR;
-           SUBTYPE ACC2S IS ACC2 (IDENT_INT (1) .. IDENT_INT (5),
-                                    IDENT_INT (1) .. IDENT_INT (1));
-           A : ACC2;
-           B : ARR (IDENT_INT (1) .. IDENT_INT (5),
-                    IDENT_INT (2) .. IDENT_INT (2));
- 
-      BEGIN
-           A := ACC2S'(NEW ARR'(B'RANGE => (B'RANGE (2) => 0)));
-           IF A'FIRST = 1 THEN
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC2 - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC2 - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC2" );
-      END;
- 
-      DECLARE
- 
-           TYPE REC (D : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACC3 IS ACCESS REC;
-           SUBTYPE ACC3S IS ACC3 (IDENT_INT (3));
-           A : ACC3;
-           B : REC (IDENT_INT (5)) := (D => (IDENT_INT (5)));
- 
-      BEGIN
-           A := ACC3S'(NEW REC'(B));
-           IF A = NULL THEN
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC3 - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC3 - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC3" );
-      END;
- 
-      DECLARE
- 
-           TYPE REC (D1,D2 : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACC4 IS ACCESS REC;
-           SUBTYPE ACC4S IS ACC4 (IDENT_INT (4), IDENT_INT (5));
-           A : ACC4;
-           B : REC (IDENT_INT (5), IDENT_INT (4)) :=
-               (D1 => (IDENT_INT (5)), D2 => (IDENT_INT (4)));
- 
-      BEGIN
-           A := ACC4S'(NEW REC'(B));
-           IF A = NULL THEN
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC4 - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC4 - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC4" );
-      END;
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE REC (D : INTEGER) IS PRIVATE;
- 
-                B : CONSTANT REC;
-           PRIVATE
-                TYPE REC (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                B : CONSTANT REC := (D => (IDENT_INT (4)));
-           END PKG;
- 
-           USE PKG;
- 
-           TYPE ACC5 IS ACCESS REC;
-           SUBTYPE ACC5S IS ACC5 (IDENT_INT (3));
-           A : ACC5;
- 
-      BEGIN
-           A := ACC5S'(NEW REC'(B));
-           IF A = NULL THEN
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC5 - 1" );
-           ELSE
-                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC5 - 2" );
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
-                         "DIFFERENT FROM THOSE OF TYPE ACC5" );
-      END;
- 
-      DECLARE
- 
-           PACKAGE PKG1 IS
-                TYPE REC (D : INTEGER) IS LIMITED PRIVATE;
-                TYPE ACC6 IS ACCESS REC;
-                SUBTYPE ACC6S IS ACC6 (IDENT_INT (6));
- 
-                FUNCTION F RETURN ACC6;
-           PRIVATE
-                TYPE REC (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PKG1;
- 
-           PACKAGE BODY PKG1 IS
- 
-                FUNCTION F RETURN ACC6 IS
-                BEGIN
-                     RETURN NEW REC'(D => IDENT_INT (5));
-                END F;
- 
-           END PKG1;
- 
-           PACKAGE PKG2 IS END PKG2;
- 
-           PACKAGE BODY PKG2 IS
-                USE PKG1;
- 
-                A : ACC6;
- 
-           BEGIN
-                A := ACC6S'(F);
-                IF A = NULL THEN
-                     FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                              "DIFFERENT FROM THOSE OF TYPE ACC6 - 1" );
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
-                              "DIFFERENT FROM THOSE OF TYPE ACC6 - 2" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED FOR DISC " &
-                              "VALUES DIFFERENT FROM THOSE OF TYPE " &
-                              "ACC6" );
-           END PKG2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C47009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47009b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c47009b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c47009b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,282 ****
- -- C47009B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN ACCESS
- --     TYPE, CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE VALUE
- --     OF THE OPERAND IS NULL.
- 
- -- HISTORY:
- --     RJW 07/23/86  CREATED ORIGINAL TEST.
- --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
- --                   CONSTRAINTS OF B SUBTYPES TO VALUES WHICH ARE
- --                   CLOSER TO THE VALUES OF THE A SUBTYPES.  INDENTED
- --                   THE EXCEPTION STATEMENTS IN SUBTEST 11.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C47009B IS
- 
- BEGIN
- 
-      TEST( "C47009B", "WHEN THE TYPE MARK IN A QUALIFIED " &
-                       "EXPRESSION DENOTES AN ACCESS TYPE, " &
-                       "CHECK THAT CONSTRAINT_ERROR IS NOT " &
-                       "RAISED WHEN THE VALUE OF THE OPERAND IS NULL" );
- 
-      DECLARE
- 
-           TYPE ACC1 IS ACCESS BOOLEAN;
-           A : ACC1;
- 
-      BEGIN
-           A := ACC1'(NULL);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC1" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC1" );
-      END;
- 
-      DECLARE
- 
-           TYPE ACC2 IS ACCESS INTEGER;
-           A : ACC2;
- 
-      BEGIN
-           A := ACC2'(NULL);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC2" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC2" );
-      END;
- 
-      DECLARE
- 
-           TYPE CHAR IS ('A', 'B');
-           TYPE ACC3 IS ACCESS CHAR;
-           A : ACC3;
- 
-      BEGIN
-           A := ACC3'(NULL);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC3" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC3" );
-      END;
- 
-      DECLARE
- 
-           TYPE FLOAT1 IS DIGITS 5 RANGE -1.0 .. 1.0;
-           TYPE ACC4 IS ACCESS FLOAT1;
-           A : ACC4;
- 
-      BEGIN
-           A := ACC4'(NULL);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC4" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC4" );
-      END;
- 
-      DECLARE
- 
-           TYPE FIXED IS DELTA 0.5 RANGE -1.0 .. 1.0;
-           TYPE ACC5 IS ACCESS FIXED;
-           A : ACC5;
- 
-      BEGIN
-           A := ACC5'(NULL);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC5" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC5" );
-      END;
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
-           TYPE ACC6 IS ACCESS ARR;
-           SUBTYPE ACC6A IS ACC6 (IDENT_INT (1) .. IDENT_INT (5));
-           SUBTYPE ACC6B IS ACC6 (IDENT_INT (2) .. IDENT_INT (10));
-           A : ACC6A;
-           B : ACC6B;
- 
-      BEGIN
-           A := ACC6A'(B);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC6" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC6" );
-      END;
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
-                OF INTEGER;
-           TYPE ACC7 IS ACCESS ARR;
-           SUBTYPE ACC7A IS ACC7 (IDENT_INT (1) .. IDENT_INT (5),
-                                  IDENT_INT (1) .. IDENT_INT (1));
-           SUBTYPE ACC7B IS ACC7 (IDENT_INT (1) .. IDENT_INT (15),
-                                  IDENT_INT (1) .. IDENT_INT (10));
-           A : ACC7A;
-           B : ACC7B;
- 
-      BEGIN
-           A := ACC7A'(B);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC7" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC7" );
-      END;
- 
-      DECLARE
- 
-           TYPE REC (D : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACC8 IS ACCESS REC;
-           SUBTYPE ACC8A IS ACC8 (IDENT_INT (5));
-           SUBTYPE ACC8B IS ACC8 (IDENT_INT (6));
-           A : ACC8A;
-           B : ACC8B;
- 
-      BEGIN
-           A := ACC8A'(B);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC8" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC8" );
-      END;
- 
-      DECLARE
- 
-           TYPE REC (D1,D2 : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACC9 IS ACCESS REC;
-           SUBTYPE ACC9A IS ACC9 (IDENT_INT (4), IDENT_INT (5));
-           SUBTYPE ACC9B IS ACC9 (IDENT_INT (5), IDENT_INT (4));
-           A : ACC9A;
-           B : ACC9B;
- 
-      BEGIN
-           A := ACC9A'(B);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC9" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC9" );
-      END;
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE REC (D : INTEGER) IS PRIVATE;
- 
-           PRIVATE
-                TYPE REC (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-           END PKG;
- 
-           USE PKG;
- 
-           TYPE ACC10 IS ACCESS REC;
-           SUBTYPE ACC10A IS ACC10 (IDENT_INT (10));
-           SUBTYPE ACC10B IS ACC10 (IDENT_INT (9));
-           A : ACC10A;
-           B : ACC10B;
- 
-      BEGIN
-           A := ACC10A'(B);
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC10" );
-           WHEN OTHERS =>
-                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
-                         "TYPE ACC10" );
-      END;
- 
-      DECLARE
- 
-           PACKAGE PKG1 IS
-                TYPE REC (D : INTEGER) IS LIMITED PRIVATE;
- 
-           PRIVATE
-                TYPE REC (D : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PKG1;
- 
-           PACKAGE PKG2 IS END PKG2;
- 
-           PACKAGE BODY PKG2 IS
-                USE PKG1;
- 
-                TYPE ACC11 IS ACCESS REC;
-                SUBTYPE ACC11A IS ACC11 (IDENT_INT (11));
-                SUBTYPE ACC11B IS ACC11 (IDENT_INT (12));
-                A : ACC11A;
-                B : ACC11B;
- 
-           BEGIN
-                A := ACC11A'(B);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF" &
-                              " TYPE ACC11" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
-                              "TYPE ACC11" );
-           END PKG2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C47009B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- C48004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A SCALAR SUBTYPE.
- 
- -- RM  01/12/80
- -- JBG 03/03/83
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE  C48004A  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48004A","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF " &
-                     "T IS A SCALAR SUBTYPE");
- 
-      DECLARE
- 
-           SUBTYPE TA IS INTEGER RANGE 1 .. 7;
-           TYPE ATA IS ACCESS TA;
-           VA : ATA;
- 
-      BEGIN
- 
-           VA := NEW TA;
-           VA.ALL := IDENT_INT(6);
-           IF VA.ALL /= 6 THEN
-                FAILED ("INCORRECT VALUE");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- C48004B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A CONSTRAINED
- -- RECORD, PRIVATE, OR LIMITED PRIVATE TYPE.
- 
- -- RM  01/12/80
- -- JBG 03/03/83
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE C48004B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48004B","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF " &
-                     "T IS A CONSTRAINED RECORD, PRIVATE, OR "      &
-                     "LIMITED PRIVATE TYPE");
- 
-      DECLARE
- 
-           TYPE  TB0(A , B : INTEGER )  IS
-                RECORD
-                     C : INTEGER := 7;
-                END RECORD;
-           SUBTYPE  TB  IS  TB0( 2 , 3 );
-           TYPE ATB IS ACCESS TB0;
-           VB : ATB;
- 
-           TYPE  TBB0(  A , B : INTEGER := 5 )  IS
-                RECORD
-                     C : INTEGER := 6;
-                END RECORD;
-           SUBTYPE  TBB  IS  TBB0( 4 , 5 );
-           TYPE ATBB IS ACCESS TBB0;
-           VBB : ATBB;
- 
-           PACKAGE  P  IS
-                TYPE   PRIV0( A , B : INTEGER )  IS PRIVATE;
-                TYPE  LPRIV0( A , B : INTEGER := 1 )  IS LIMITED PRIVATE;
-                FUNCTION FUN(LP : LPRIV0) RETURN INTEGER;
-           PRIVATE
-                TYPE  PRIV0( A , B : INTEGER )  IS
-                     RECORD
-                          Q : INTEGER;
-                     END RECORD;
-                TYPE  LPRIV0( A , B : INTEGER := 1 )  IS
-                     RECORD
-                          Q : INTEGER := 7;
-                     END RECORD;
-           END P;
-      
-           USE P;
- 
-           SUBTYPE  PRIV  IS  P.PRIV0( 12 , 13 );
-           TYPE  A_PRIV  IS  ACCESS P.PRIV0;
-           VP : A_PRIV;
- 
-           TYPE  A_LPRIV  IS  ACCESS LPRIV0;
-           VLP : A_LPRIV;
- 
-           TYPE LCR(A, B : INTEGER := 4) IS
-                RECORD
-                     C : P.LPRIV0;
-                END RECORD;
-           SUBTYPE SLCR IS LCR(1, 2);
-           TYPE A_SLCR IS ACCESS SLCR;
-           VSLCR : A_SLCR;
- 
-           PACKAGE BODY P IS
-                FUNCTION FUN(LP : LPRIV0) RETURN INTEGER IS
-                BEGIN
-                     RETURN LP.Q;
-                END FUN;
-           END P;
- 
-      BEGIN
- 
-           VB  :=  NEW TB;
-           IF ( VB.A /= IDENT_INT(2)  OR
-                VB.B /= 3  OR
-                VB.C /= 7 )  THEN FAILED( "WRONG VALUES  -  B1" );
-           END IF;
- 
-           VBB  :=  NEW TBB0;
-           IF ( VBB.A /= IDENT_INT(5)  OR
-                VBB.B /= 5  OR
-                VBB.C /= 6 )  THEN
-                FAILED( "WRONG VALUES  -  B2" );
-           END IF;
-           
-           VP  :=  NEW PRIV;
-           IF ( VP.A /= IDENT_INT(12)  OR
-                VP.B /= 13 )  THEN 
-                FAILED( "WRONG VALUES  -  B3" );
-           END IF;
-           
-           VLP  :=  NEW LPRIV0;
-           IF ( VLP.A /= IDENT_INT(1)  OR
-                VLP.B /= 1 OR
-                P.FUN(VLP.ALL) /= IDENT_INT(7) )  THEN 
-                FAILED( "WRONG VALUES  -  B4" );
-           END IF;
- 
-           VSLCR := NEW SLCR;
-           IF ( VSLCR.A /= IDENT_INT(1) OR
-                VSLCR.B /= IDENT_INT(2) OR
-                P.FUN(VSLCR.C) /= IDENT_INT(7) ) THEN
-                FAILED ("WRONG VALUES - B5");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48004B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C48004C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS AN UNCONSTRAINED
- -- RECORD, PRIVATE, OR LIMITED TYPE WHOSE DISCRIMINANTS HAVE DEFAULT
- -- VALUES.
- 
- -- EG  08/03/84
- 
- WITH REPORT;
- 
- PROCEDURE C48004C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48004C","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF "   &
-                     "T IS AN UNCONSTRAINED RECORD, PRIVATE, OR "     &
-                     "LIMITED TYPE WHOSE DISCRIMINANTS HAVE DEFAULT " &
-                     "VALUES");
- 
-      DECLARE
- 
-           TYPE  UR(A : INTEGER := 1; B : INTEGER := 2)  IS
-                RECORD
-                     C : INTEGER := 7;
-                END RECORD;
- 
-           PACKAGE  P  IS
- 
-                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS PRIVATE;
-                TYPE UL(A, B : INTEGER := 1) IS LIMITED PRIVATE;
- 
-           PRIVATE
- 
-                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
-                     RECORD
-                          Q : INTEGER;
-                     END RECORD;
-                TYPE UL(A, B : INTEGER := 1) IS
-                     RECORD
-                          Q : INTEGER;
-                     END RECORD;
- 
-           END P;
-      
-           USE P;
- 
-           TYPE A_UR IS ACCESS UR;
-           TYPE A_UP IS ACCESS UP;
-           TYPE A_UL IS ACCESS UL;
- 
-           V_UR : A_UR;
-           V_UP : A_UP;
-           V_UL : A_UL;
- 
-      BEGIN
- 
-           V_UR := NEW UR;
-           IF ( V_UR.A /= IDENT_INT(1) OR V_UR.B /= 2 OR
-                V_UR.C /= 7 ) THEN 
-                FAILED("WRONG VALUES - UR");
-           END IF;
- 
-           V_UP := NEW UP;
-           IF ( V_UP.A /= IDENT_INT(12) OR V_UP.B /= 13 ) THEN
-                FAILED("WRONG VALUES - UP");
-           END IF;
-           
-           V_UL := NEW UL;
-           IF ( V_UL.A /= IDENT_INT(1) OR V_UL.B /= 1 ) THEN
-                FAILED("WRONG VALUES - UL");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48004C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C48004D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A RECORD, PRIVATE,
- -- OR LIMITED TYPE WITHOUT DISCRIMINANTS.
- 
- -- RM  01/12/80
- -- JBG 03/03/83
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE C48004D IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48004D","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
-                     "IS A RECORD, PRIVATE, OR LIMITED TYPE WITHOUT " &
-                     "DISCRIMINANTS");
- 
-      DECLARE
- 
-           TYPE  TC  IS
-                RECORD
-                     C : INTEGER := 18;
-                END RECORD;
-           TYPE ATC IS ACCESS TC;
-           VC : ATC;
- 
-           PACKAGE  P  IS
-                TYPE   PRIV  IS PRIVATE;
-                TYPE  LPRIV  IS LIMITED PRIVATE;
-                TYPE A_PRIV  IS  ACCESS PRIV;
-                TYPE A_LPRIV  IS  ACCESS LPRIV;
-                PROCEDURE   CHECK( X: A_PRIV  );
-                PROCEDURE  LCHECK( X: A_LPRIV );
-                PROCEDURE LRCHECK( X: LPRIV );
-           PRIVATE
-                TYPE   PRIV  IS
-                     RECORD
-                          Q : INTEGER := 19;
-                     END RECORD;
-                TYPE  LPRIV  IS
-                     RECORD
-                          Q : INTEGER := 20;
-                     END RECORD;
-           END P;
- 
-      
-           VP  :  P.A_PRIV;
-           VLP : P.A_LPRIV;
- 
-           TYPE LCR IS
-                RECORD
-                     C : P.LPRIV;
-                END RECORD;
-           TYPE A_LCR IS ACCESS LCR;
-           VLCR : A_LCR;
- 
-           PACKAGE BODY  P  IS
- 
-                PROCEDURE  CHECK( X: A_PRIV )  IS
-                BEGIN
-                     IF  X.Q /= 19  THEN  FAILED( "WRONG VALUES - C2" );
-                     END IF;
-                END CHECK;
-      
-                PROCEDURE  LCHECK( X: A_LPRIV )  IS
-                BEGIN
-                     IF  X.Q /= 20  THEN  FAILED( "WRONG VALUES - C3" );
-                     END IF;
-                END LCHECK;
- 
-                PROCEDURE LRCHECK (X : LPRIV) IS
-                BEGIN
-                     IF X.Q /= 20 THEN
-                          FAILED ("WRONG VALUES - C4");
-                     END IF;
-                END LRCHECK;
- 
-           END P;
- 
-      BEGIN
- 
-           VC  :=  NEW TC;
-           IF  VC.C /= 18  THEN FAILED( "WRONG VALUES  -  C1" );
-           END IF;
-           
-           VP  :=  NEW P.PRIV;
-           P.CHECK( VP );
-           VLP :=  NEW P.LPRIV;
-           P.LCHECK( VLP );
- 
-           VLCR := NEW LCR;
-           P.LRCHECK( VLCR.ALL.C );
- 
-      END;
- 
-      RESULT;
- 
- END C48004D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- C48004E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A CONSTRAINED ARRAY
- -- TYPE.
- 
- -- RM  01/12/80
- -- JBG 03/03/83
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE  C48004E  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48004E","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
-                     "IS A CONSTRAINED ARRAY TYPE");
- 
-      DECLARE
- 
-           TYPE ARR0 IS ARRAY( INTEGER RANGE <> ) OF BOOLEAN;
-           SUBTYPE ARR IS ARR0(1 .. 10);
-           TYPE  A_ARR  IS  ACCESS ARR;
-           VARR : A_ARR;
- 
-           PACKAGE P IS
-                TYPE LPRIV IS LIMITED PRIVATE;
-                FUNCTION CHECK (X : LPRIV) RETURN INTEGER;
-           PRIVATE
-                TYPE LPRIV IS
-                     RECORD
-                          Q : INTEGER := 20;
-                     END RECORD;
-           END P;
- 
-           TYPE LPARR IS ARRAY(1 .. 2) OF P.LPRIV;
-           TYPE A_LPARR IS ACCESS LPARR;
- 
-           V_A_LPARR : A_LPARR;
- 
-           PACKAGE BODY P IS
-                FUNCTION CHECK (X : LPRIV) RETURN INTEGER IS
-                BEGIN
-                     RETURN X.Q;
-                END CHECK;
-           END P;
-           
-      BEGIN
- 
-           VARR := NEW ARR;
-           IF  ( VARR'FIRST /= IDENT_INT(1)  OR
-                 VARR'LAST /= 10 )  THEN FAILED("WRONG BOUNDS - CASE 1");
-           END IF;
- 
-           V_A_LPARR := NEW LPARR;
-           IF ( P.CHECK(V_A_LPARR.ALL(1)) /= IDENT_INT(20) OR
-                P.CHECK(V_A_LPARR.ALL(2)) /= IDENT_INT(20) ) THEN
-                FAILED ("WRONG VALUES - CASE 2");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48004E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48004f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48004f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C48004F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS AN ACCESS TYPE.
- 
- -- RM  01/12/80
- -- JBG 03/03/83
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE C48004F  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48004F","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
-                     "IS AN ACCESS TYPE");
- 
-      DECLARE
- 
-           TYPE AINT IS ACCESS INTEGER;
-           TYPE A_AINT IS ACCESS AINT;
-           VA_AINT : A_AINT;
- 
-           TYPE AST IS ACCESS STRING;
-           SUBTYPE CAST_4 IS AST(1 .. 4);
-           TYPE A_AST IS ACCESS AST;
-           TYPE ACAST_3 IS ACCESS AST(1 .. 3);
-           V_AAST : A_AST;
-           V_ACAST_3 : ACAST_3;
- 
-           TYPE UR(A, B : INTEGER) IS
-                RECORD
-                     C : INTEGER;
-                END RECORD;
-           SUBTYPE CR IS UR(1, 2);
-           TYPE A_CR IS ACCESS CR;
-           TYPE AA_CR IS ACCESS A_CR;
-           V_AA_CR : AA_CR;
- 
-      BEGIN
- 
-           VA_AINT := NEW AINT;
-           IF VA_AINT.ALL /= NULL THEN
-                FAILED ("VARIABLE IS NOT NULL - CASE 1");
-           END IF;
- 
-           BEGIN
- 
-                V_ACAST_3 := NEW CAST_4;
-                IF V_ACAST_3.ALL /= NULL THEN
-                     FAILED ("VARIABLE IS NOT NULL - CASE 2");
-                END IF;
- 
-           EXCEPTION
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - CASE 2");
- 
-           END;
- 
-           V_AAST := NEW AST;
-           IF V_AAST.ALL /= NULL THEN
-                FAILED ("VARIABLE IS NOT NULL - CASE 3");
-           END IF;
- 
-           V_AA_CR := NEW A_CR;
-           IF V_AA_CR.ALL /= NULL THEN
-                FAILED ("VARIABLE IS NOT NULL - CASE 4");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48004F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- C48005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T X" ALLOCATES A NEW OBJECT
- -- EACH TIME IT IS EXECUTED AND THAT IF T IS AN UNCONSTRAINED RECORD,
- -- PRIVATE, OR LIMITED TYPE, THE ALLOCATED OBJECT HAS THE DISCRIMINANT
- -- VALUES SPECIFIED BY X.
- 
- -- EG  08/08/84
- 
- WITH REPORT;
- 
- PROCEDURE C48005A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48005A","CHECK THAT THE FORM 'NEW T X' ALLOCATES A " &
-                     "NEW OBJECT AND THAT IF T IS AN UNCONSTRAINED " &
-                     "RECORD, PRIVATE, OR LIMITED TYPE, THE " &
-                     "ALLOCATED OBJECT HAS THE DISCRIMINANT " &
-                     "VALUES SPECIFIED BY X");
- 
-      DECLARE
- 
-           TYPE UR1(A : INTEGER) IS
-                RECORD
-                     B : INTEGER := 7;
-                     C : INTEGER := 4;
-                END RECORD;
-           TYPE UR2(A : INTEGER) IS
-                RECORD
-                     CASE A IS
-                          WHEN 1 =>
-                               A1 : INTEGER := 4;
-                          WHEN 2 =>
-                               A2 : INTEGER := 5;
-                          WHEN OTHERS =>
-                               NULL;
-                     END CASE;
-                END RECORD;
- 
-           TYPE A_UR1 IS ACCESS UR1;
-           TYPE A_UR2 IS ACCESS UR2;
- 
-           V1AUR1 : A_UR1;
-           V1AUR2, V2AUR2 : A_UR2;
- 
-           TYPE REC (A : INTEGER) IS
-                RECORD
-                     B : INTEGER;
-                END RECORD;
- 
-           TYPE A_REC IS ACCESS REC;
- 
-           V_A_REC : A_REC;
- 
-           TYPE ARR IS ARRAY(1 .. 1) OF INTEGER;
- 
-           TYPE RECVAL IS
-                RECORD
-                     A : INTEGER;
-                     B : ARR;
-                END RECORD;
- 
-           FUNCTION FUN (A : INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT(A);
-           END FUN;
-           FUNCTION FUN (A : INTEGER) RETURN RECVAL IS
-           BEGIN
-                FAILED ("WRONG OVERLOADED FUNCTION CALLED");
-                RETURN (1, (1 => 2));
-           END FUN;
- 
-      BEGIN
- 
-           V1AUR1 := NEW UR1(3);
-           IF ( V1AUR1.A /= 3 OR V1AUR1.B /= 7 OR
-                V1AUR1.C /= IDENT_INT(4) ) THEN
-                FAILED("WRONG VALUES - V1UAR1");
-           END IF;
- 
-           V1AUR2 := NEW UR2(IDENT_INT(2));
-           IF ( V1AUR2.A /= 2 OR V1AUR2.A2 /= IDENT_INT(5) ) THEN
-                FAILED("WRONG VALUES - V1AUR2");
-           END IF;
- 
-           V2AUR2 := NEW UR2(IDENT_INT(3));
-           IF ( V2AUR2.A /= IDENT_INT(3) ) THEN
-                FAILED("WRONG VALUES - V2AUR2");
-           END IF;
- 
-           V_A_REC := NEW REC(FUN(2));
-      END;
- 
-      RESULT;
- 
- END C48005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- C48005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T X" ALLOCATES A NEW OBJECT
- -- EACH TIME IT IS EXECUTED AND THAT IF X IS AN INDEX CONSTRAINT AND T
- -- AN UNCONSTRAINED ARRAY TYPE, THE ALLOCATED OBJECT HAS THE INDEX
- -- BOUNDS SPECIFIED BY X.
- 
- -- EG  08/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C48005B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48005B","CHECK THAT THE FORM 'NEW T X' ALLOCATES A " &
-                     "NEW OBJECT AND THAT IF X IS AN INDEX "      &
-                     "CONSTRAINT AND T AN UNCONSTRAINED ARRAY "   &
-                     "TYPE, THE ALLOCATED OBJECT HAS THE INDEX "  &
-                     "BOUND SPECIFIED BY X");
- 
-      DECLARE
- 
-           TYPE UA1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-           TYPE UA2 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
-                               OF INTEGER;
- 
-           TYPE A_UA1 IS ACCESS UA1;
-           TYPE A_UA2 IS ACCESS UA2;
- 
-           V_A_UA1 : A_UA1;
-           V_A_UA2 : A_UA2;
- 
-      BEGIN
- 
-           V_A_UA1 := NEW UA1(4 .. 7);
-           IF ( V_A_UA1'FIRST /= IDENT_INT(4) OR
-                V_A_UA1'LAST  /= IDENT_INT(7) ) THEN
-                FAILED("WRONG ARRAY BOUNDS - V_A_UA1");
-           END IF;
- 
-           V_A_UA2 := NEW UA2(2 .. 3, 4 .. 6);
-           IF ( V_A_UA2'FIRST(1) /= IDENT_INT(2) OR
-                V_A_UA2'LAST(1)  /= IDENT_INT(3) OR
-                V_A_UA2'FIRST(2) /= IDENT_INT(4) OR
-                V_A_UA2'LAST(2)  /= IDENT_INT(6) ) THEN
-                FAILED("WRONG ARRAY BOUNDS - V_A_UA2");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- C48006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW 
- -- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A SCALAR OR ACCESS
- -- TYPE, THE ALLOCATED OBJECT HAS THE VALUE OF X.
- 
- -- RM  01/14/80
- -- RM  01/O1/82
- -- SPS 10/27/82
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE C48006A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48006A","CHECK THAT THE FORM 'NEW T'(X)' " &
-                     "ALLOCATES A NEW OBJECT " &
-                     "AND THAT IF T IS A SCALAR OR ACCESS TYPE, THE "   &
-                     "ALLOCATED OBJECT HAS THE VALUE OF X");
- 
-      DECLARE
- 
-           TYPE ATA IS ACCESS INTEGER;
-           TYPE AATA IS ACCESS ATA;
-           VA1, VA2, VA3 : ATA;
-           VAA1, VAA2, VAA3 : AATA;
- 
-      BEGIN
- 
-           VA1 := NEW INTEGER'(5 + 7);
-           IF VA1.ALL /= IDENT_INT(12) THEN
-                FAILED("WRONG VALUES - VA1");
-           END IF;
- 
-           VA2 := NEW INTEGER'(1 + 2);
-           IF (VA1.ALL /= IDENT_INT(12) OR
-               VA2.ALL /= IDENT_INT( 3)) THEN
-                FAILED("WRONG VALUES - VA2");
-           END IF;
- 
-           VA3 := NEW INTEGER'(IDENT_INT(3) + IDENT_INT(4));
-           IF (VA1.ALL /= IDENT_INT(12) OR
-               VA2.ALL /= IDENT_INT( 3) OR
-               VA3.ALL /= IDENT_INT( 7)) THEN
-                FAILED("WRONG VALUES - VA3");
-           END IF;
- 
-           VAA1 := NEW ATA'(NEW INTEGER'(3));
-           IF VAA1.ALL.ALL /= IDENT_INT(3) THEN
-                FAILED ("WRONG VALUES - VAA1");
-           END IF;
- 
-           VAA2 := NEW ATA'(NEW INTEGER'(IDENT_INT(5)));
-           IF (VAA1.ALL.ALL /= 3 OR
-               VAA2.ALL.ALL /= 5 ) THEN
-                FAILED ("WRONG VALUES - VAA2");
-           END IF;
- 
-           VAA3 := NEW ATA'(NEW INTEGER'(IDENT_INT(6)));
-           IF (VAA1.ALL.ALL /= 3 OR
-               VAA2.ALL.ALL /= 5 OR
-               VAA3.ALL.ALL /= 6 ) THEN
-                FAILED ("WRONG VALUES - VAA3");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48006b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48006b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48006b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,236 ****
- -- C48006B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW
- -- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A RECORD, ARRAY, OR
- -- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED), THE ALLOCATED OBJECT HAS
- -- THE VALUE OF (X).
- 
- -- RM  01/14/80
- -- RM  01/O1/82
- -- SPS 10/27/82
- -- EG  07/05/84
- -- JBG 11/08/85 AVOID CONFLICT WITH AI-7 OR AI-275
- 
- WITH REPORT;
- 
- PROCEDURE C48006B IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("C48006B","CHECK THAT THE FORM 'NEW T'(X)' " &
-                     "ALLOCATES A NEW OBJECT " &
-                     "AND THAT IF T IS A RECORD, ARRAY, OR PRIVATE "    &
-                     "TYPE, THE ALLOCATED OBJECT HAS THE VALUE (X)");
- 
-      -- RECORD OR ARRAY TYPE (CONSTRAINED OR UNCONSTRAINED)
- 
-      DECLARE
- 
-           TYPE  TB0(  A , B : INTEGER )  IS
-                RECORD
-                     C : INTEGER := 7 ;
-                END RECORD;
-           SUBTYPE  TB  IS  TB0( 2 , 3 );
-           TYPE ATB  IS  ACCESS TB  ;
-           TYPE ATB0 IS  ACCESS TB0 ;
-           VB1  ,  VB2  : ATB  ;
-           VB01 , VB02  : ATB0 ;
- 
-           TYPE  ARR0  IS  ARRAY( INTEGER RANGE <> ) OF INTEGER ;
-           SUBTYPE  ARR  IS ARR0( 1..4 );
-           TYPE  A_ARR   IS  ACCESS ARR  ;
-           TYPE  A_ARR0  IS  ACCESS ARR0 ;
-           VARR1  , VARR2  : A_ARR  ;
-           VARR01 , VARR02 : A_ARR0 ;
- 
-      BEGIN
- 
-           VB1  :=  NEW TB'( 2 , 3 , 5 );
-           IF ( VB1.A /=IDENT_INT( 2)  OR
-                VB1.B /=IDENT_INT( 3)  OR
-                VB1.C /=IDENT_INT( 5) )
-           THEN FAILED( "WRONG VALUES  -  B1 1" );
-           END IF;
- 
-           VB2  :=  NEW TB'( IDENT_INT(2), IDENT_INT(3), IDENT_INT(6));
-           IF ( VB2.A /= 2  OR
-                VB2.B /= 3  OR
-                VB2.C /= 6  OR
-                VB1.A /= 2  OR
-                VB1.B /= 3  OR
-                VB1.C /= 5 )
-           THEN FAILED( "WRONG VALUES  -  B1 2" );
-           END IF;
- 
-           VB01  :=  NEW TB0'( 1 , 2 , 3 );
-           IF ( VB01.A /=IDENT_INT( 1)  OR
-                VB01.B /=IDENT_INT( 2)  OR
-                VB01.C /=IDENT_INT( 3) )
-           THEN FAILED( "WRONG VALUES  -  B2 1" );
-           END IF;
- 
-           VB02  :=  NEW TB0'( IDENT_INT(4) , IDENT_INT(5) ,
-                                                       IDENT_INT(6) );
-           IF ( VB02.A /=IDENT_INT( 4)  OR
-                VB02.B /=IDENT_INT( 5)  OR
-                VB02.C /=IDENT_INT( 6)  OR
-                VB01.A /=IDENT_INT( 1)  OR
-                VB01.B /=IDENT_INT( 2)  OR
-                VB01.C /=IDENT_INT( 3) )
-           THEN FAILED( "WRONG VALUES  -  B2 2" );
-           END IF;
- 
-           VARR1 := NEW ARR'( 5 , 6 , 7 , 8 );
-           IF  ( VARR1(1) /=IDENT_INT( 5)  OR
-                 VARR1(2) /=IDENT_INT( 6)  OR
-                 VARR1(3) /=IDENT_INT( 7)  OR
-                 VARR1(4) /=IDENT_INT( 8) )
-           THEN FAILED( "WRONG VALUES  -  B3 1" );
-           END IF ;
- 
-           VARR2 := NEW ARR'( IDENT_INT(1) , IDENT_INT(2) , IDENT_INT(3),
-                                                          IDENT_INT(4) );
-           IF  ( VARR2(1) /= 1  OR
-                 VARR2(2) /= 2  OR
-                 VARR2(3) /= 3  OR
-                 VARR2(4) /= 4  OR
-                 VARR1(1) /= 5  OR
-                 VARR1(2) /= 6  OR
-                 VARR1(3) /= 7  OR
-                 VARR1(4) /= 8 )
-           THEN FAILED( "WRONG VALUES  -  B3 2" );
-           END IF ;
- 
-           VARR01 := NEW ARR0'( 11 , 12 , 13 );
-           IF  ( VARR01(INTEGER'FIRST) /= IDENT_INT(11)  OR
-                 VARR01(INTEGER'FIRST + 1) /= IDENT_INT(12)  OR
-                 VARR01(INTEGER'FIRST + 2) /= IDENT_INT(13) )
-           THEN FAILED( "WRONG VALUES -  B4 1" );
-           END IF ;
-           IF  ( VARR01.ALL'FIRST /= IDENT_INT( INTEGER'FIRST )  OR
-                 VARR01.ALL'LAST  /= IDENT_INT( INTEGER'FIRST + 2 ) )
-           THEN FAILED( "WRONG VALUES -  B4 2" );
-           END IF ;
- 
-           VARR02 := NEW ARR0'( 1 => IDENT_INT(14) , 2 => IDENT_INT(15));
-           IF  ( VARR02(1) /= 14  OR
-                 VARR02(2) /= 15  OR
-                 VARR01(INTEGER'FIRST) /= 11  OR
-                 VARR01(INTEGER'FIRST + 1) /= 12  OR
-                 VARR01(INTEGER'FIRST + 2) /= 13 )
-           THEN FAILED( "WRONG VALUES -  B4 3" );
-           END IF ;
- 
-      END ;
- 
-      -- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED)
- 
-      DECLARE
- 
-           PACKAGE P IS
-                TYPE UP(A, B : INTEGER) IS PRIVATE;
- --             SUBTYPE CP IS UP(1, 2);
- --             TYPE A_CP IS ACCESS CP;
-                TYPE A_UP IS ACCESS UP;
-                CONS1_UP : CONSTANT UP;
-                CONS2_UP : CONSTANT UP;
-                CONS3_UP : CONSTANT UP;
-                CONS4_UP : CONSTANT UP;
- --             PROCEDURE CHECK1 (X : A_CP);
- --             PROCEDURE CHECK2 (X, Y : A_CP);
-                PROCEDURE CHECK3 (X : A_UP);
-                PROCEDURE CHECK4 (X, Y : A_UP);
-           PRIVATE
-                TYPE UP(A, B : INTEGER) IS
-                     RECORD
-                          C : INTEGER;
-                     END RECORD;
-                CONS1_UP : CONSTANT UP := (1, 2, 3);
-                CONS2_UP : CONSTANT UP := (IDENT_INT(1), IDENT_INT(2),
-                                           IDENT_INT(4));
-                CONS3_UP : CONSTANT UP := (7, 8, 9);
-                CONS4_UP : CONSTANT UP := (IDENT_INT(10), IDENT_INT(11),
-                                           IDENT_INT(12));
-           END P;
- 
-           USE P;
- 
- --        V_A_CP1, V_A_CP2 : A_CP;
-           V_A_UP1, V_A_UP2 : A_UP;
- 
-           PACKAGE BODY P IS
- --             PROCEDURE CHECK1 (X : A_CP) IS
- --             BEGIN
- --                  IF (X.A /= IDENT_INT(1) OR
- --                      X.B /= IDENT_INT(2) OR
- --                      X.C /= IDENT_INT(3)) THEN
- --                       FAILED ("WRONG VALUES - CP1");
- --                  END IF;
- --             END CHECK1;
- --             PROCEDURE CHECK2 (X, Y : A_CP) IS
- --             BEGIN
- --                  IF (X.A /= 1 OR X.B /= 2 OR X.C /= 3 OR
- --                      Y.A /= 1 OR Y.B /= 2 OR Y.C /= 4) THEN
- --                       FAILED ("WRONG VALUES - CP2");
- --                  END IF;
- --             END CHECK2;
-                PROCEDURE CHECK3 (X : A_UP) IS
-                BEGIN
-                     IF (X.A /= IDENT_INT(7) OR
-                         X.B /= IDENT_INT(8) OR
-                         X.C /= IDENT_INT(9)) THEN
-                          FAILED ("WRONG VALUES - UP1");
-                     END IF;
-                END CHECK3;
-                PROCEDURE CHECK4 (X, Y : A_UP) IS
-                BEGIN
-                     IF (X.A /=  7 OR X.B /=  8 OR X.C /=  9 OR
-                         Y.A /= 10 OR Y.B /= 11 OR Y.C /= 12) THEN
-                          FAILED ("WRONG VALUES - UP2");
-                     END IF;
-                END CHECK4;
-           END P;
- 
-      BEGIN
- 
- --        V_A_CP1 := NEW CP'(CONS1_UP);
- --        CHECK1(V_A_CP1);
- 
- --        V_A_CP2 := NEW CP'(CONS2_UP);
- --        CHECK2(V_A_CP1, V_A_CP2);
- 
-           V_A_UP1 := NEW P.UP'(CONS3_UP);
-           CHECK3(V_A_UP1);
- 
-           V_A_UP2 := NEW P.UP'(CONS4_UP);
-           CHECK4(V_A_UP1, V_A_UP2);
- 
-      END;
- 
-      RESULT;
- 
- END C48006B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- C48007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
- -- RAISED IF T IS AN UNCONSTRAINED TYPE WITH DEFAULT DISCRIMINANTS
- -- (RECORD, PRIVATE OR LIMITED) AND ONE DEFAULT DISCRIMINANT VALUE DOES
- -- NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE ALLOCATOR'S BASE
- -- TYPE.
- 
- -- EG  08/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C48007A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48007A","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
-                     "APPROPRIATE - UNCONSTRAINED TYPE WITH "    &
-                     "DEFAULT DISCRIMINANTS");
- 
-      DECLARE
- 
-           TYPE UR(A : INTEGER := 1; B : INTEGER := 2) IS
-                RECORD
-                     C : INTEGER := 7;
-                END RECORD;
- 
-           PACKAGE P IS
- 
-                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
-                     PRIVATE;
-                TYPE UL(A, B : INTEGER := 4) IS LIMITED PRIVATE;
- 
-           PRIVATE
- 
-                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
-                     RECORD
-                          C : INTEGER := 8;
-                     END RECORD;
-                TYPE UL(A, B : INTEGER := 4) IS
-                     RECORD
-                          C : INTEGER := 9;
-                     END RECORD;
- 
-           END P;
- 
-           USE P;
- 
-           TYPE A_UR IS ACCESS UR(1, 9);
-           TYPE A_UP IS ACCESS UP(9, 13);
-           TYPE A_UL IS ACCESS UL(4, 9);
- 
-           VUR : A_UR;
-           VUP : A_UP;
-           VUL : A_UL;
- 
-      BEGIN
- 
-           BEGIN -- UR
- 
-                VUR := NEW UR;
-                FAILED("NO EXCEPTION RAISED - UR");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - UR");
- 
-           END;
- 
-           BEGIN -- UP
- 
-                VUP := NEW UP;
-                FAILED("NO EXCEPTION RAISED - UP");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - UP");
- 
-           END;
- 
-           BEGIN -- UL
- 
-                VUL := NEW UL;
-                FAILED("NO EXCEPTION RAISED - UL");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - UL");
- 
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48007b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48007b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48007b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- C48007B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
- -- RAISED IF T IS A CONSTRAINED TYPE WITH DISCRIMINANTS (RECORD, PRIVATE
- -- OR LIMITED) AND AT LEAST ONE DISCRIMINANT VALUE SPECIFIED FOR T DOES
- -- NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE ALLOCATOR'S BASE
- -- TYPE.
- 
- -- EG  08/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C48007B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48007B","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
-                     "APPROPRIATE - CONSTRAINED TYPE WITH "      &
-                     "DISCRIMINANT");
- 
-      DECLARE
- 
-           TYPE UR(A, B : INTEGER) IS
-                RECORD
-                     C : INTEGER;
-                END RECORD;
- 
-           PACKAGE P IS
- 
-                TYPE UP(A, B : INTEGER) IS PRIVATE;
-                TYPE UL(A, B : INTEGER) IS LIMITED PRIVATE;
- 
-           PRIVATE
- 
-                TYPE UP(A, B : INTEGER) IS
-                     RECORD
-                          C : INTEGER;
-                     END RECORD;
-                TYPE UL(A, B : INTEGER) IS
-                     RECORD
-                          C : INTEGER;
-                     END RECORD;
- 
-           END P;
- 
-           USE P;
- 
-           SUBTYPE CR IS UR(1, 2);
-           SUBTYPE CP IS UP(12, 13);
-           SUBTYPE CL IS UL(4, 4);
- 
-           TYPE A_UR IS ACCESS UR(1, 9);
-           TYPE A_UP IS ACCESS UP(9, 13);
-           TYPE A_UL IS ACCESS UL(4, 9);
- 
-           VUR : A_UR;
-           VUP : A_UP;
-           VUL : A_UL;
- 
-      BEGIN
- 
-           BEGIN -- CR
- 
-                VUR := NEW CR;
-                FAILED("NO EXCEPTION RAISED - CR");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - CR");
- 
-           END;
- 
-           BEGIN -- CP
- 
-                VUP := NEW CP;
-                FAILED("NO EXCEPTION RAISED - CP");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - CP");
- 
-           END;
- 
-           BEGIN -- CL
- 
-                VUL := NEW CL;
-                FAILED("NO EXCEPTION RAISED - CL");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - CL");
- 
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48007B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48007c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48007c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48007c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48007c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,162 ****
- -- C48007C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
- -- RAISED IF T IS A CONSTRAINED ARRAY TYPE AND AT LEAST ONE INDEX BOUND
- -- FOR T DOES NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE
- -- ALLOCATOR'S BASE TYPE.
- 
- -- EG  08/10/84
- 
- WITH REPORT;
- 
- PROCEDURE C48007C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48007C","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
-                     "APPROPRIATE - CONSTRAINED ARRAY TYPE");
- 
-      DECLARE
- 
-           TYPE UA1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-           TYPE UA2 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) OF
-                          INTEGER;
-           TYPE UA3 IS ARRAY(INTEGER RANGE <>) OF UA1(1 .. 2);
- 
-           SUBTYPE CA11 IS UA1(1 .. 3);
-           SUBTYPE CA12 IS UA1(3 .. 2);
-           SUBTYPE CA21 IS UA2(1 .. 2, 1 .. 2);
-           SUBTYPE CA22 IS UA2(1 .. 2, 2 .. 0);
-           SUBTYPE CA31 IS UA3(1 .. 2);
-           SUBTYPE CA32 IS UA3(4 .. 1);
- 
-           TYPE A_UA11 IS ACCESS UA1(2 .. 4);
-           TYPE A_UA12 IS ACCESS UA1(4 .. 3);
-           TYPE A_UA21 IS ACCESS UA2(1 .. 3, 1 .. 2);
-           TYPE A_UA22 IS ACCESS UA2(1 .. 2, 2 .. 1);
-           TYPE A_UA31 IS ACCESS UA3(1 .. 3);
-           TYPE A_UA32 IS ACCESS UA3(3 .. 1);
- 
-           V11 : A_UA11;
-           V12 : A_UA12;
-           V21 : A_UA21;
-           V22 : A_UA22;
-           V31 : A_UA31;
-           V32 : A_UA32;
- 
-      BEGIN
- 
-           BEGIN -- V11
- 
-                V11 := NEW CA11;
-                FAILED("NO EXCEPTION RAISED - V11");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - V11");
- 
-           END;
- 
-           BEGIN -- V12
- 
-                V12 := NEW CA12;
-                FAILED("NO EXCEPTION RAISED - V12");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - V12");
- 
-           END;
- 
-           BEGIN -- V21
- 
-                V21 := NEW CA21;
-                FAILED("NO EXCEPTION RAISED - V21");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - V21");
- 
-           END;
- 
-           BEGIN -- V22
- 
-                V22 := NEW CA22;
-                FAILED("NO EXCEPTION RAISED - V22");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - V22");
- 
-           END;
- 
-           BEGIN -- V31
- 
-                V31 := NEW CA31;
-                FAILED("NO EXCEPTION RAISED - V31");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - V31");
- 
-           END;
- 
-           BEGIN -- V32
- 
-                V32 := NEW CA32;
-                FAILED("NO EXCEPTION RAISED - V32");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED - V32");
- 
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48007C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,345 ****
- -- C48008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T X", CHECK THAT CONSTRAINT_ERROR IS
- -- RAISED IF T IS AN UNCONSTRAINED RECORD, PRIVATE, OR LIMITED TYPE, X
- -- IS A DISCRIMINANT CONSTRAINT, AND
- --   1) ONE OF THE VALUES OF X IS OUTSIDE THE RANGE OF THE CORRESPONDING
- --      DISCRIMINANT;
- --   2) ONE OF THE DISCRIMINANT VALUES IS NOT COMPATIBLE WITH A
- --      CONSTRAINT OF A SUBCOMPONENT IN WHICH IT IS USED;
- --   3) ONE OF THE DISCRIMINANT VALUES DOES NOT EQUAL THE CORRESPONDING
- --      VALUE OF THE ALLOCATOR'S BASE TYPE;
- --   4) A DEFAULT INITIALIZATION RAISES AN EXCEPTION.
- 
- -- RM  01/08/80
- -- NL  10/13/81
- -- SPS 10/26/82
- -- JBG 03/02/83
- -- EG  07/05/84
- -- PWB 02/05/86  CORRECTED TEST ERROR:
- --               CHANGED "FAILED" TO "COMMENT" IN PROCEDURE INCR_CHECK,
- --               SO AS NOT TO PROHIBIT EVAL OF DEFLT EXPR (AI-00397/01)
- --               ADDED COMMENTS FOR CASES.
- 
- WITH REPORT;
- 
- PROCEDURE  C48008A  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "C48008A" , "FOR ALLOCATORS OF THE FORM 'NEW T X', " &
-                        "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                        "APPROPRIATE - UNCONSTRAINED RECORD AND " &
-                        "PRIVATE TYPES");
- 
-      DECLARE
- 
-           DISC_FLAG : BOOLEAN := FALSE;
-           INCR_VAL : INTEGER;
-           FUNCTION INCR(A : INTEGER) RETURN INTEGER;
- 
-           SUBTYPE I1_7 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(7);
-           SUBTYPE I1_10 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(10);
-           SUBTYPE I2_9 IS INTEGER RANGE IDENT_INT(2)..IDENT_INT(9);
- 
-           TYPE REC (A : I2_9) IS
-                RECORD
-                     B : INTEGER := INCR(2);
-                END RECORD;
- 
-           TYPE ARR IS ARRAY (I2_9 RANGE <>) OF INTEGER;
- 
-           TYPE T_REC (C : I1_10) IS
-                RECORD
-                     D : REC(C);
-                END RECORD;
- 
-           TYPE T_ARR (C : I1_10) IS
-                RECORD
-                     D : ARR(2..C);
-                     E : ARR(C..9);
-                END RECORD;
- 
-           TYPE T_REC_REC (A : I1_10) IS
-                RECORD
-                     B : T_REC(A);
-                END RECORD;
- 
-           TYPE T_REC_ARR (A : I1_10) IS
-                RECORD
-                     B : T_ARR(A);
-                END RECORD;
- 
-           TYPE  TB (  A : I1_7 )  IS
-                RECORD
-                     R : INTEGER := INCR(1);
-                END RECORD;
- 
-           TYPE UR (A : INTEGER) IS
-                RECORD
-                     B : I2_9 := INCR(1);
-                END RECORD;
- 
-           TYPE A_T_REC_REC IS ACCESS T_REC_REC;
-           TYPE A_T_REC_ARR IS ACCESS T_REC_ARR;
-           TYPE ATB IS ACCESS TB;
-           TYPE ACTB IS ACCESS TB(3);
-           TYPE A_UR IS ACCESS UR;
- 
-           VA_T_REC_REC : A_T_REC_REC;
-           VA_T_REC_ARR : A_T_REC_ARR;
-           VB  : ATB;
-           VCB : ACTB;
-           V_A_UR : A_UR;
- 
-           BOOL : BOOLEAN;
- 
-           FUNCTION DISC (A : INTEGER) RETURN INTEGER;
- 
- 
-           PACKAGE  P  IS
-                TYPE  PRIV( A : I1_10 := DISC(8) )  IS PRIVATE;
-                CONS_PRIV : CONSTANT PRIV;
-           PRIVATE
-                TYPE  PRIV( A : I1_10 := DISC(8) )  IS
-                     RECORD
-                          R : INTEGER := INCR(1);
-                     END RECORD;
-                CONS_PRIV : CONSTANT PRIV := (2, 3);
-           END P;
- 
-           TYPE  A_PRIV  IS  ACCESS P.PRIV;
-           TYPE  A_CPRIV IS  ACCESS P.PRIV (3);
- 
-           VP  : A_PRIV;
-           VCP : A_CPRIV;
- 
-           PROCEDURE PREC_REC (X : A_T_REC_REC) IS
-           BEGIN
-                NULL;
-           END PREC_REC;
- 
-           PROCEDURE PREC_ARR (X : A_T_REC_ARR) IS
-           BEGIN
-                NULL;
-           END PREC_ARR;
- 
-           PROCEDURE PB (X : ATB) IS
-           BEGIN
-                NULL;
-           END PB;
- 
-           PROCEDURE PCB (X : ACTB) IS
-           BEGIN
-                NULL;
-           END PCB;
- 
-           PROCEDURE PPRIV (X : A_PRIV) IS
-           BEGIN
-                NULL;
-           END PPRIV;
- 
-           PROCEDURE PCPRIV (X : A_CPRIV) IS
-           BEGIN
-                NULL;
-           END PCPRIV;
- 
-           FUNCTION DISC (A : INTEGER) RETURN INTEGER IS
-           BEGIN
-                DISC_FLAG := TRUE;
-                RETURN A;
-           END DISC;
- 
-           FUNCTION INCR(A : INTEGER) RETURN INTEGER IS
-           BEGIN
-                INCR_VAL := IDENT_INT(INCR_VAL+1);
-                RETURN A;
-           END INCR;
- 
-           PROCEDURE INCR_CHECK(CASE_ID : STRING) IS
-           BEGIN
-                IF INCR_VAL /= IDENT_INT(0) THEN
-                     COMMENT ("DEFAULT INITIAL VALUE WAS EVALUATED - " &
-                              "CASE " & CASE_ID);
-                END IF;
-           END INCR_CHECK;
- 
-      BEGIN
- 
-           BEGIN  -- A1A: 0 ILLEGAL FOR TB.A.
-                INCR_VAL := 0;
-                VB  :=  NEW TB (A => 0);
-                FAILED ("NO EXCEPTION RAISED - CASE A1A");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>
-                     INCR_CHECK("A1A");
-                WHEN  OTHERS            =>
-                     FAILED( "WRONG EXCEPTION RAISED - CASE A1A" );
-           END;   -- A1A
- 
-           BEGIN  -- A1B: 8 ILLEGAL IN I1_7.
-                INCR_VAL := 0;
-                VB  :=  NEW TB (A => I1_7'(IDENT_INT(8)));
-                FAILED ("NO EXCEPTION RAISED - CASE A1B");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>
-                     INCR_CHECK("A1B");
-                WHEN  OTHERS            =>
-                     FAILED( "WRONG EXCEPTION RAISED - CASE A1B");
-           END;   -- A1B
- 
-           BEGIN  -- A1C: 8 ILLEGAL FOR TB.A.
-                INCR_VAL := 0;
-                PB(NEW TB (A => 8));
-                FAILED ("NO EXCEPTION RAISED - CASE A1C");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>
-                     INCR_CHECK("A1C");
-                WHEN  OTHERS            =>
-                     FAILED( "WRONG EXCEPTION RAISED - CASE A1C");
-           END;   --A1C
- 
-           BEGIN  --A1D: 0 ILLEGAL FOR TB.A.
-                INCR_VAL := 0;
-                BOOL := ATB'(NEW TB(A => 0)) = NULL;
-                FAILED ("NO EXCEPTION RAISED - CASE A1D");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>
-                     INCR_CHECK("A1D");
-                WHEN  OTHERS            =>
-                     FAILED( "WRONG EXCEPTION RAISED - CASE A1D");
-           END;   --A1D
- 
-           BEGIN  --A1E: 11 ILLEGAL FOR PRIV.A.
-                DISC_FLAG := FALSE;
-                INCR_VAL := 0;
-                VP := NEW P.PRIV(11);
-                FAILED("NO EXCEPTION RAISED - CASE A1E");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF DISC_FLAG THEN
-                          FAILED ("DISCR DEFAULT EVALUATED WHEN " &
-                                  "EXPLICIT VALUE WAS PROVIDED - A1E");
-                     END IF;
-                     INCR_CHECK("A1E");
-                WHEN OTHERS           =>
-                     FAILED("WRONG EXCEPTION RAISED - CASE A1E");
-           END;   -- A1E
- 
-           BEGIN  -- A2A: 1 ILLEGAL FOR REC.A.
-                INCR_VAL := 0;
-                VA_T_REC_REC := NEW T_REC_REC(A => I1_10'(IDENT_INT(1)));
-                FAILED ("NO EXCEPTION RAISED - CASE A2A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     INCR_CHECK("A2A");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A2A");
-           END;   -- A2A
- 
-           BEGIN  --A2B: 10 ILLEGAL FOR REC.A.
-                INCR_VAL := 0;
-                VA_T_REC_REC := NEW T_REC_REC (10);
-                FAILED ("NO EXCEPTION RAISED - CASE A2B");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     INCR_CHECK("A2B");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A2B");
-           END;   -- A2B
- 
-           BEGIN  -- A2C: 1 ILLEGAL FOR T.ARR.E'FIRST.
-                INCR_VAL := 0;
-                PREC_ARR (NEW T_REC_ARR (1));
-                FAILED ("NO EXCEPTION RAISED - CASE A2C");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     INCR_CHECK ("A2C");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A2C");
-           END;   -- A2C
- 
-           BEGIN  -- A2D: 10 ILLEGAL FOR T_ARR.D'LAST.
-                INCR_VAL := 0;
-                BOOL := NEW T_REC_ARR (IDENT_INT(10)) = NULL;
-                FAILED ("NO EXCEPTION RAISED - CASE A2D");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     INCR_CHECK ("A2D");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A2D");
-           END;   -- A2D
- 
-           BEGIN -- A3A: ASSIGNMENT VIOLATES CONSTRAINT ON VCB'S SUBTYPE.
-                INCR_VAL := 0;
-                VCB := NEW TB (4);
-                FAILED ("NO EXCEPTION RAISED - CASE A3A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     INCR_CHECK("A3A");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A3A");
-           END;   -- A3A
- 
-           BEGIN  -- A3B: PARM ASSOC VIOLATES CONSTRAINT ON PARM SUBTYPE.
-                INCR_VAL := 0;
-                PCB (NEW TB (4));
-                FAILED ("NO EXCEPTION RAISED - CASE A3B");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     INCR_CHECK("A3B");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A3B");
-           END;   -- A3B
- 
-           BEGIN  -- A3C: 2 VIOLATES CONSTRAINT ON SUBTYPE ACTB.
-                INCR_VAL := 0;
-                BOOL := ACTB'(NEW TB (IDENT_INT(2))) = NULL;
-                FAILED ("NO EXCEPTION RAISED - CASE A3C");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     INCR_CHECK("A3C");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A3C");
-           END;   -- A3C
- 
-           BEGIN  -- A4A: EVALUATION OF DEFAULT RAISES EXCEPTION.
-                INCR_VAL := 0;
-                V_A_UR := NEW UR(4);
-                FAILED ("NO EXCEPTION RAISED - CASE A4A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE A4A");
-           END;   -- A4A
- 
-      END;
- 
-      RESULT;
- 
- END C48008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48008c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48008c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48008c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48008c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C48008C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T X", CHECK THAT CONSTRAINT_ERROR IS
- -- RAISED IF T IS AN UNCONSTRAINED ARRAY TYPE WITH INDEX SUBTYPE(S) S, X
- -- IS AN INDEX CONSTRAINT, AND THE BOUNDS OF X ARE NOT COMPATIBLE WITH
- -- AN INDEX SUBTYPE OF T.
- 
- -- RM 01/08/80
- -- NL 10/13/81
- -- EG 07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE C48008C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48008C","FOR ALLOCATORS OF THE FORM 'NEW T X', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                     "APPROPRIATE - UNCONSTRAINED ARRAY TYPE");
- 
-      DECLARE
- 
-           SUBTYPE  TWO  IS  INTEGER RANGE 1..2;
-           TYPE  TF IS ARRAY( TWO RANGE <> ,  TWO RANGE <> ) OF INTEGER;
-           TYPE  ATF  IS  ACCESS TF;
-           VF  : ATF;
- 
-      BEGIN
- 
-           BEGIN
-                VF  :=  NEW TF ( 0..1 , 1..2 );
-                FAILED ("NO EXCEPTION RAISED - CASE 1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>  
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 1");
-           END;
- 
-           BEGIN
-                VF := NEW TF(1 .. 2, 2 .. IDENT_INT(3));
-                FAILED ("NO EXCEPTION RAISED - CASE 2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 2");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48008C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C48009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS A SCALAR SUBTYPE AND X IS OUTSIDE THE RANGE OF T,
- -- OR IS WITHIN T'S RANGE AND OUTSIDE OF THE RANGE OF VALUES PERMITTED
- -- FOR OBJECTS DESIGNATED BY VALUES OF THE ALLOCATOR'S BASE TYPE.
- 
- -- RM  01/08/80
- -- NL  10/13/81
- -- SPS 10/26/82
- -- JBG 03/02/83
- -- EG  07/05/84
- -- EDS 12/01/97  ADDED IDENT_INT TO MAKE EXPRESSION NON-STATIC.
- 
- WITH REPORT;
- 
- PROCEDURE  C48009A  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "C48009A" , "FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK" &
-                        " THAT CONSTRAINT_ERROR IS RAISED WHEN" &
-                        " APPROPRIATE - SCALAR TYPES");
-      DECLARE        -- A1
- 
-           SUBTYPE  TA  IS  INTEGER RANGE 1..7;
-           TYPE ATA IS ACCESS TA;
-           VA : ATA;
- 
-      BEGIN
- 
-           VA  :=  NEW TA'( IDENT_INT(0) );
-           FAILED ("NO EXCEPTION RAISED - 1");
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR  =>  NULL;
-           WHEN  OTHERS      =>  FAILED ( "WRONG EXCEPTION RAISED - 1" );
- 
-      END;  -- A1
- 
-      DECLARE        -- A2
- 
-           SUBTYPE T1_7 IS INTEGER RANGE 1..7;
-           TYPE AT2_6 IS ACCESS INTEGER RANGE 2..6;
-           VAT2_6 : AT2_6;
- 
-      BEGIN
- 
-           BEGIN
- 
-                VAT2_6 := NEW T1_7'(1);
-                FAILED ("NO EXCEPTION RAISED - 2");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => 
-                     FAILED ("WRONG EXCEPTION RAISED - 2");
- 
-           END;
- 
-           BEGIN
- 
-                VAT2_6 := NEW T1_7'(7);
-                FAILED ("NO EXCEPTION RAISED - 3");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 3");
- 
-           END;
- 
-      END; -- A2
- 
-      RESULT;
- 
- END C48009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,255 ****
- -- C48009B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS AN UNCONSTRAINED RECORD OR PRIVATE TYPE, (X) IS AN
- -- AGGREGATE OR A VALUE OF TYPE T, AND ONE OF THE DISCRIMINANT VALUES IN
- -- X:
- --   1) DOES NOT SATISFY THE RANGE CONSTRAINT FOR THE CORRESPONDING
- --      DISCRIMINANT OF T.
- --   2) DOES NOT EQUAL THE DISCRIMINANT VALUE SPECIFIED IN THE
- --      DECLARATION OF THE ALLOCATOR'S BASE TYPE.
- --   3) A DISCRIMINANT VALUE IS COMPATIBLE WITH A DISCRIMINANT'S SUBTYPE
- --      BUT DOES NOT PROVIDE A COMPATIBLE INDEX OR DISCRIMINANT
- --      CONSTRAINT FOR A SUBCOMPONENT DEPENDENT ON THE DISCRIMINANT.
- 
- -- RM  01/08/80
- -- NL  10/13/81
- -- SPS 10/26/82
- -- JBG 03/02/83
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE  C48009B  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "C48009B" , "FOR ALLOCATORS OF THE FORM 'NEW T '(X)', " &
-                        "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                        "APPROPRIATE - UNCONSTRAINED RECORD AND " &
-                        "PRIVATE TYPES");
- 
-      DECLARE
- 
-           SUBTYPE I1_7 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(7);
-           SUBTYPE I1_10 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(10);
-           SUBTYPE I2_9 IS INTEGER RANGE IDENT_INT(2)..IDENT_INT(9);
- 
-           TYPE REC (A : I2_9) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ARR IS ARRAY (I2_9 RANGE <>) OF INTEGER;
- 
-           TYPE T_REC (C : I1_10) IS
-                RECORD
-                     D : REC(C);
-                END RECORD;
- 
-           TYPE T_ARR (C : I1_10) IS
-                RECORD
-                     D : ARR(2..C);
-                     E : ARR(C..9);
-                END RECORD;
- 
-           TYPE T_REC_REC (A : I1_10) IS
-                RECORD
-                     B : T_REC(A);
-                END RECORD;
- 
-           TYPE T_REC_ARR (A : I1_10) IS
-                RECORD
-                     B : T_ARR(A);
-                END RECORD;
- 
-           TYPE  TB (  A : I1_7 )  IS
-                RECORD
-                     R : INTEGER;
-                END RECORD;
- 
-           TYPE A_T_REC_REC IS ACCESS T_REC_REC;
-           TYPE A_T_REC_ARR IS ACCESS T_REC_ARR;
-           TYPE ATB IS ACCESS TB;
-           TYPE ACTB IS ACCESS TB(3);
- 
-           VA_T_REC_REC : A_T_REC_REC;
-           VA_T_REC_ARR : A_T_REC_ARR;
-           VB  : ATB;
-           VCB : ACTB;
- 
-           PACKAGE  P  IS
-                TYPE  PRIV( A : I1_10 )  IS PRIVATE;
-                CONS_PRIV : CONSTANT PRIV;
-           PRIVATE
-                TYPE  PRIV( A : I1_10 )  IS
-                     RECORD
-                          R : INTEGER;
-                     END RECORD;
-                CONS_PRIV : CONSTANT PRIV := (2, 3);
-           END P;
- 
-           USE P;
- 
-           TYPE  A_PRIV  IS  ACCESS P.PRIV;
-           TYPE  A_CPRIV IS  ACCESS P.PRIV (3);
-      
-           VP  : A_PRIV;
-           VCP : A_CPRIV;
- 
-           FUNCTION ALLOC1(X : P.PRIV) RETURN A_CPRIV IS
-           BEGIN
-                IF EQUAL(1, 1) THEN
-                     RETURN NEW P.PRIV'(X);
-                ELSE
-                     RETURN NULL;
-                END IF;
-           END ALLOC1;
-           FUNCTION ALLOC2(X : TB) RETURN ACTB IS
-           BEGIN
-                IF EQUAL(1, 1) THEN
-                     RETURN NEW TB'(X);
-                ELSE
-                     RETURN NULL;
-                END IF;
-           END ALLOC2;
- 
-      BEGIN
- 
-           BEGIN     -- B1
-                VB  :=  NEW TB'(A => IDENT_INT(0), R => 1);
-                FAILED ("NO EXCEPTION RAISED - CASE 1A");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>  NULL;
-                WHEN  OTHERS            =>
-                     FAILED( "WRONG EXCEPTION RAISED - CASE 1A" );
-           END;
- 
-           BEGIN     
-                VB  :=  NEW TB'(A => 8, R => 1);
-                FAILED ("NO EXCEPTION RAISED - CASE 1B");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>  NULL;
-                WHEN  OTHERS            =>
-                     FAILED( "WRONG EXCEPTION RAISED - CASE 1B");
-           END; -- B1
- 
-           BEGIN     -- B2
-                VCB := NEW TB'(2, 3);
-                FAILED ("NO EXCEPTION RAISED - CASE 2A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 2A");
-           END;
- 
-           BEGIN
-                IF ALLOC2((IDENT_INT(4), 3)) = NULL THEN
-                     FAILED ("IMPOSSIBLE - CASE 2B");
-                END IF;
-                FAILED ("NO EXCEPTION RAISED - CASE 2B");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 2B");
-           END;
- 
-           BEGIN
- 
-                IF ALLOC1(CONS_PRIV) = NULL THEN
-                     FAILED ("IMPOSSIBLE - CASE 2C");
-                END IF;
-                FAILED ("NO EXCEPTION RAISED - CASE 2C");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 2C");
- 
-           END; -- B2
- 
-           BEGIN     -- B3
- 
-                VA_T_REC_REC := NEW T_REC_REC'(1, (1, (A => 1)));
-                FAILED ("NO EXCEPTION RAISED - CASE 3A");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
- 
-           END;
- 
-           BEGIN
- 
-                VA_T_REC_REC := NEW T_REC_REC'(10, 
-                                              (10, (A => 10)));
-                FAILED ("NO EXCEPTION RAISED - CASE 3B");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
- 
-           END;
- 
-           BEGIN
- 
-                VA_T_REC_ARR := NEW T_REC_ARR'(1, (1, (OTHERS => 1),
-                                                      (OTHERS => 2)));
-                FAILED ("NO EXCEPTION RAISED - CASE 3C");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 3C");
- 
-           END;
- 
-           BEGIN
- 
-                VA_T_REC_ARR := NEW T_REC_ARR'(10, (10, (OTHERS => 1),
-                                                        (OTHERS => 2)));
-                FAILED ("NO EXCEPTION RAISED - CASE 3D");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 3D");
- 
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48009B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C48009C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS A CONSTRAINED RECORD OR PRIVATE TYPE, (X) IS AN
- -- AGGREGATE OR A VALUE OF TYPE T, AND ONE OF THE DISCRIMINANT VALUES IN
- -- X:
- --   1) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE FOR T.
- --   2) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE SPECIFIED
- --      IN THE DECLARATION OF THE ALLOCATOR'S BASE TYPE.
- --   3) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE IN THE
- --      ACCESS TO ACCESS CASE.
- 
- -- RM  01/08/80
- -- NL  10/13/81
- -- SPS 10/26/82
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE C48009C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48009C","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
-                     "APPROPRIATE - CONSTRAINED RECORD TYPES");
- 
-      DECLARE
- 
-           TYPE TC0(A, B : INTEGER) IS
-                RECORD
-                     C : INTEGER RANGE 1 .. 7;
-                END RECORD;
-           SUBTYPE TC IS TC0(2, 3);
-           TYPE ATC IS ACCESS TC0(2, 3);
-           SUBTYPE TC4_5 IS TC0(IDENT_INT(4), IDENT_INT(5));
-           VC : ATC;
- 
-      BEGIN
- 
-           BEGIN
-                VC := NEW TC'(102, 3, 4);
-                FAILED ("NO EXCEPTION RAISED - CASE 1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS           =>  
-                     FAILED("WRONG EXCEPTION RAISED - CASE 1");
-           END;
- 
-           BEGIN
-                VC := NEW TC4_5'(IDENT_INT(4), IDENT_INT(5), 1);
-                FAILED ("NO EXCEPTION RAISED - CASE 2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS           =>  
-                     FAILED("WRONG EXCEPTION RAISED - CASE 2");
-           END;
- 
-      END;
- 
-      DECLARE
- 
-           TYPE UR(A : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           TYPE A_UR IS ACCESS UR;
-           SUBTYPE CA_UR IS A_UR(2);
-           TYPE A_CA_UR IS ACCESS CA_UR;
- 
-           V : A_CA_UR;
- 
-      BEGIN
- 
-           V := NEW CA_UR'(NEW UR'(A => IDENT_INT(3)));
-           FAILED ("NO EXCEPTION RAISED - CASE 3");
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - CASE 3");
- 
-      END;
- 
-      RESULT;
- 
- END C48009C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C48009D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS AN UNCONSTRAINED ARRAY TYPE WITH INDEX SUBTYPE(S)
- -- S,
- --   1) X HAS TOO MANY VALUES FOR S;
- --   2) A NAMED NON-NULL BOUND OF X LIES OUTSIDE S'S RANGE;
- --   3) THE BOUND'S OF X ARE NOT EQUAL TO BOUNDS SPECIFIED FOR THE
- --      ALLOCATOR'S DESIGNATED BASE TYPE. (THEY ARE EQUAL TO THE BOUNDS
- --      SPECIFIED FOR T).
- 
- -- RM  01/08/80
- -- NL  10/13/81
- -- SPS 10/26/82
- -- JBG 03/03/83
- -- EG  07/05/84
- -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
- -- KAS 11/14/95 FOR SLIDING ASSIGNMENT, CHANGED FAIL TO COMMENT ON LANGUAGE
- -- KAS 12/02/95 INCLUDED SECOND CASE
- -- PWN 05/03/96 Enforced Ada 95 sliding rules
- 
- WITH REPORT;
- 
- PROCEDURE  C48009D  IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("C48009D","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
-                     "APPROPRIATE - UNCONSTRAINED ARRAY TYPES");
-      DECLARE
- 
-           SUBTYPE TWO  IS INTEGER RANGE 1 .. 2;
-           SUBTYPE TWON IS INTEGER RANGE IDENT_INT(1) .. IDENT_INT(2);
-           TYPE UA  IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-           TYPE TD  IS ARRAY(TWO  RANGE <>) OF INTEGER RANGE 1 .. 7;
-           TYPE TDN IS ARRAY(TWON RANGE <>) OF INTEGER RANGE 1 .. 7;
-           TYPE ATD  IS ACCESS TD;
-           TYPE ATDN IS ACCESS TDN;
-           TYPE A_UA IS ACCESS UA;
-           TYPE A_CA IS ACCESS UA(3 .. 4);
-           TYPE A_CAN IS ACCESS UA(4 .. 3);
-           VD  : ATD;
-           VDN : ATDN;
-           V_A_CA : A_CA;
-           V_A_CAN : A_CAN;
- 
-      BEGIN
- 
-           BEGIN
-                VD := NEW TD'(3, 4, 5);
-                FAILED ("NO EXCEPTION RAISED - CASE 1A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>  
-                     NULL;
-                WHEN OTHERS =>  
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 1A");
-           END;
- 
-           BEGIN
-                VDN := NEW TDN'(3, 4, 5);
-                FAILED ("NO EXCEPTION RAISED - CASE 1B");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 1B");
-           END;
- 
-           BEGIN
-                VD := NEW TD'(IDENT_INT(0) .. 2 => 6);
-                FAILED ("NO EXCEPTION RAISED - CASE 2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     NULL;
-                WHEN OTHERS =>  
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 2");
-           END;
- 
-           BEGIN
-                V_A_CA := NEW UA'(2 .. 3 => 3);
-                COMMENT ("ADA 95 SLIDING ASSIGNMENT - CASE 3A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("ADA 83 NON SLIDING ASSIGNMENT - CASE 3A");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
-           END;
- 
-           BEGIN
-                V_A_CAN := NEW UA'(IDENT_INT(3) .. IDENT_INT(2) => 3);
-                COMMENT ("ADA 95 SLIDING ASSIGNMENT - CASE 3B");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("ADA 83 NON SLIDING ASSIGNMENT - CASE 3B");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48009D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,224 ****
- -- C48009E.ADA
-  
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS A CONSTRAINED ARRAY TYPE AND:
- --   1) A NAMED NULL OR NON-NULL BOUND FOR X DOES NOT EQUAL THE
- --      CORRESPONDING BOUND FOR T;
- --   2) A BOUND OF T DOES NOT EQUAL THE CORRESPONDING VALUE SPECIFIED IN
- --      THE DECLARATION OF THE ALLOCATOR'S BASE TYPE; 
- --   3) A POSITIONAL AGGREGATE DOES NOT HAVE THE NUMBER OF COMPONENTS
- --      REQUIRED BY T OR BY THE ALLOCATOR'S BASE TYPE. 
-  
-  -- RM  01/08/80
-  -- NL  10/13/81
-  -- SPS 10/26/82
-  -- JBG 03/03/83
-  -- EG  07/05/84
-  -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
-  -- KAS 11/14/95 CHANGED FAILURE AT SLIDING ASSIGNMENT TO COMMENT ON LANGUAGE
-  -- KAS 11/30/95 REINSTRUMENTED CASES TO SELECT LANGUAGE SEMANTICS
-  -- PWN 05/03/96 Enforced Ada 95 sliding rules
-  -- PWN 10/24/96 Adjusted expected results for Ada 95.
-  -- TMB 11/19/96 BACKED OUT CHANGE FOR SLIDING WITH ACCESS TYPES
-  -- MRM 12/16/96 Removed problem code from withdrawn version of test, and
-  --              implemented a dereference-index check to ensure Ada95
-  --              required behavior.
-  -- PWB.CTA 03/07/97 Restored checks from 1.11 in 2 cases where sliding does
-  --                  not occur 
-  WITH REPORT;
-  
-  PROCEDURE  C48009E  IS
-  
-       USE REPORT ;
-  
-  BEGIN
-  
-       TEST("C48009E","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                      "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
-                      "APPROPRIATE - CONSTRAINED ARRAY TYPES");
-       DECLARE
-  
-            TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-            TYPE CA3_2 IS ARRAY(3 .. 2) OF INTEGER;
-            TYPE SA1_3 IS ARRAY(1 .. 3) OF INTEGER;
-            TYPE NA1_3 IS ARRAY(1 .. IDENT_INT(3)) OF INTEGER;
-            SUBTYPE CA2_6 IS UA(2 .. 6);
-            SUBTYPE CA1_4 IS UA(1 .. 4);
-            SUBTYPE CA1_6 IS UA(1 .. 6);
-            SUBTYPE CA4_1 IS UA(4 .. 1);
-            SUBTYPE CA4_2 IS UA(4 .. 2);
-  
-            TYPE A_CA3_2 IS ACCESS CA3_2;
-            TYPE A_SA1_3 IS ACCESS SA1_3;
-            TYPE A_NA1_3 IS ACCESS NA1_3;
-            TYPE A_CA1_5 IS ACCESS UA(1 .. 5);
-            TYPE A_CA4_2 IS ACCESS CA4_2;
-  
-            V_A_CA3_2 : A_CA3_2;
-            V_A_SA1_3 : A_SA1_3;
-            V_A_NA1_3 : A_NA1_3;
-            V_A_CA1_5 : A_CA1_5;
-  
-            FUNCTION ALLOC1(X : CA2_6) RETURN A_CA1_5 IS
-            BEGIN
-                 IF EQUAL(1, 1) THEN
-                      RETURN NEW CA2_6'(X);
-                 ELSE
-                      RETURN NULL;
-                 END IF;
-            END ALLOC1;
-            FUNCTION ALLOC2(X : CA4_1) RETURN A_CA4_2 IS
-            BEGIN
-                 IF EQUAL(1, 1) THEN
-                      RETURN NEW CA4_1'(X);
-                 ELSE
-                      RETURN NULL;
-                 END IF;
-            END ALLOC2;
-  
-       BEGIN
-  
-           BEGIN
-                V_A_CA3_2 := NEW CA3_2'(IDENT_INT(4) .. IDENT_INT(2)
-                                        => 5);
-                FAILED ("NO EXCEPTION RAISED - CASE 1A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 1A");
-           END;
-  
-            BEGIN
-                 V_A_NA1_3 := NEW NA1_3'(1 .. IDENT_INT(2) => 4);
-                 FAILED ("NO EXCEPTION RAISED - CASE 1B");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>
-                      NULL;
-                 WHEN OTHERS =>
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 1B");
-            END;
-  
-            BEGIN
-                 -- note that ALLOC1 returns A_CA1_5, so both
-                 -- (1) and (5) are valid index references!
-                 IF ALLOC1((2 .. 6 => 2))(5) /= 2 THEN
-                      FAILED ("Wrong Value Returned - CASE 2A");
-                 ELSIF ALLOC1((2 .. 6 => 3))(1) /= 3 THEN
-                      FAILED ("Unlikely Index Case - CASE 2A");
-                 END IF;
-            EXCEPTION
-                 WHEN OTHERS =>
-                      FAILED ("EXCEPTION RAISED - CASE 2A");
-            END;
-  
-            BEGIN
-                 IF ALLOC2((4 .. 1 => 3)) = NULL THEN
-                      FAILED ("IMPOSSIBLE - CASE 2B");
-                 END IF;
-                 COMMENT ("ADA 95 SLIDING ASSIGNMENT");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>
-                      FAILED ("ADA 83 NON-SLIDING ASSIGNMENT");
-                 WHEN OTHERS =>
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 2B");
-            END;
-  
-            BEGIN
-                 V_A_SA1_3 := NEW SA1_3'(1, 2);
-                 FAILED ("NO EXCEPTION RAISED - CASE 3A");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>  
-                      NULL;
-                 WHEN OTHERS =>  
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
-            END;
-  
-            BEGIN
-                 V_A_SA1_3 := NEW SA1_3'(3, 4, 5, 6);
-                 FAILED ("NO EXCEPTION RAISED - CASE 3B");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>  
-                      NULL;
-                 WHEN OTHERS =>  
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
-            END;
-  
-            BEGIN
-                 V_A_NA1_3 := NEW NA1_3'(1, 2);
-                 FAILED ("NO EXCEPTION RAISED - CASE 3C");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>  
-                      NULL;
-                 WHEN OTHERS =>  
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 3C");
-            END;
-  
-            BEGIN -- SATISFIES T BUT NOT BASE TYPE.
-                 V_A_CA1_5 := NEW CA1_4'(1, 2, 3, 4);
-                 FAILED ("NO EXCEPTION RAISED - CASE 3D");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>  
-                      NULL;
-                 WHEN OTHERS =>  
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 3D");
-            END;
-  
-            BEGIN -- SATISFIES T BUT NOT BASE TYPE.
-                 V_A_CA1_5 := NEW CA1_6'(1, 2, 3, 4, 5, 6);
-                 FAILED ("NO EXCEPTION RAISED - CASE 3E");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>
-                      NULL;
-                 WHEN OTHERS =>
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 3E");
-            END;
-  
-            BEGIN -- SATISFIES BASE TYPE BUT NOT T.
-                 V_A_CA1_5 := NEW CA1_4'(1, 2, 3, 4, 5);
-                 FAILED ("NO EXCEPTION RAISED - CASE 3F");
-            EXCEPTION
-                 WHEN CONSTRAINT_ERROR =>
-                      NULL;
-                 WHEN OTHERS =>
-                      FAILED ("WRONG EXCEPTION RAISED - CASE 3F");
-            END;
-  
-           BEGIN -- SATISFIES BASE TYPE BUT NOT T.
-                V_A_CA1_5 := NEW CA1_6'(1, 2, 3, 4, 5);
-                FAILED ("NO EXCEPTION RAISED - CASE 3G");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CASE 3G");
-           END;
-  
-       END ;
-  
-       RESULT ;
-  
-  END C48009E ;
-  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C48009F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS A CONSTRAINED OR UNCONSTRAINED MULTI-DIMENSIONAL
- -- ARRAY TYPE AND ALL COMPONENTS OF X DO NOT HAVE THE SAME LENGTH OR
- -- BOUNDS. 
- 
- -- RM  01/08/80
- -- NL  10/13/81
- -- SPS 10/26/82
- -- JBG 03/03/83
- -- EG  07/05/84
- 
- WITH REPORT;
- 
- PROCEDURE  C48009F  IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48009F","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
-                     "X IS AN ILL-FORMED MULTIDIMENSIONAL AGGREGATE");
- 
-      DECLARE
- 
-           TYPE  TG00  IS  ARRAY( 4..2 ) OF  INTEGER;
-           TYPE  TG10  IS  ARRAY( 1..2 ) OF  INTEGER;
-           TYPE  TG20  IS  ARRAY( INTEGER RANGE <> ) OF  INTEGER;
- 
-           TYPE  TG0  IS  ARRAY( 3..2 ) OF  TG00;
-           TYPE  TG1  IS  ARRAY( 1..2 ) OF  TG10;
-           TYPE  TG2  IS  ARRAY( INTEGER RANGE <> ) OF  TG20(1..3);
- 
-           TYPE  ATG0  IS  ACCESS TG0;
-           TYPE  ATG1  IS  ACCESS TG1;
-           TYPE  ATG2  IS  ACCESS TG2;
- 
-           VG0  : ATG0;
-           VG1  : ATG1;
-           VG2  : ATG2;
- 
-      BEGIN
- 
-           BEGIN
-                VG0  :=  NEW TG0 '( 5..4 => ( 3..1 => 2 ) );
-                FAILED ("NO EXCEPTION RAISED - CASE 0");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>  NULL;
-                WHEN  OTHERS            =>
-                     FAILED( "WRONG EXCEPTION RAISED - CASE 0" );
-           END;
- 
-           BEGIN
-                VG1  :=  NEW TG1 '( ( 1 , 2 ) , ( 3 , 4 , 5 ) );
-                FAILED ("NO EXCEPTION RAISED - CASE 1");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>  NULL;
-                WHEN  OTHERS            =>  
-                     FAILED( "WRONG EXCEPTION RAISED - CASE 1" );
-           END;
- 
-           BEGIN
-                VG2 := NEW TG2'( 1 => ( 1..2 => 7) , 2 => ( 1..3 => 7));
-                FAILED ("NO EXCEPTION RAISED - CASE 2");
-           EXCEPTION
-                WHEN  CONSTRAINT_ERROR  =>  NULL;
-                WHEN  OTHERS            =>  
-                     FAILED( "WRONG EXCEPTION RAISED - CASE 2" );
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48009F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,209 ****
- -- C48009G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT
- --     CONSTRAINT_ERROR IS RAISED IF T IS A CONSTRAINED ACCESS
- --     TYPE AND THE OBJECT DESIGNATED BY X DOES NOT HAVE DISCRIMINANTS
- --     OR INDEX BOUNDS THAT EQUAL THE CORRESPONDING VALUES FOR T.
- 
- -- HISTORY:
- --     EG  08/30/84  CREATED ORIGINAL TEST.
- --     JET 01/05/87  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
- --                   OPTIMIZATION.
- 
- WITH REPORT;
- 
- PROCEDURE C48009G IS
- 
-      USE REPORT;
- 
-      GENERIC
-           TYPE G_TYPE IS PRIVATE;
-      FUNCTION EQUAL_G (X : G_TYPE; Y : G_TYPE) RETURN BOOLEAN;
- 
-      FUNCTION EQUAL_G (X : G_TYPE; Y : G_TYPE) RETURN BOOLEAN IS
-      BEGIN
-           IF (IDENT_INT(3) = 3) AND (X = Y) THEN
-                RETURN TRUE;
-           ELSE
-                RETURN FALSE;
-           END IF;
-      END EQUAL_G;
- 
- BEGIN
- 
-      TEST("C48009G","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                     "APPROPRIATE - CONSTRAINED ACCESS TYPE");
- 
-      DECLARE
- 
-           TYPE INT IS RANGE 1 .. 5;
- 
-           TYPE UR(A : INT) IS
-                RECORD
-                     B : INTEGER;
-                END RECORD;
-           TYPE UA IS ARRAY(INT RANGE <>) OF INTEGER;
- 
-           PACKAGE P IS
-                TYPE UP(A, B : INT) IS PRIVATE;
-                TYPE UL(A, B : INT) IS LIMITED PRIVATE;
-                CONS_UP : CONSTANT UP;
-           PRIVATE
-                TYPE UP(A, B : INT) IS
-                     RECORD
-                          C : INTEGER;
-                     END RECORD;
-                TYPE UL(A, B : INT) IS
-                     RECORD
-                          C : INTEGER;
-                     END RECORD;
-                CONS_UP : CONSTANT UP := (2, 2, (IDENT_INT(3)));
-           END P;
- 
-           TYPE A_UR IS ACCESS UR;
-           TYPE A_UA IS ACCESS UA;
-           TYPE A_UP IS ACCESS P.UP;
-           TYPE A_UL IS ACCESS P.UL;
- 
-           SUBTYPE CA_UR IS A_UR(2);
-           SUBTYPE CA_UA IS A_UA(2 .. 3);
-           SUBTYPE CA_UP IS A_UP(3, 2);
-           SUBTYPE CA_UL IS A_UL(2, 4);
- 
-           TYPE A_CA_UR IS ACCESS CA_UR;
-           TYPE A_CA_UA IS ACCESS CA_UA;
-           TYPE A_CA_UP IS ACCESS CA_UP;
-           TYPE A_CA_UL IS ACCESS CA_UL;
- 
-           V_A_CA_UR : A_CA_UR;
-           V_A_CA_UA : A_CA_UA;
-           V_A_CA_UP : A_CA_UP;
-           V_A_CA_UL : A_CA_UL;
- 
-           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UR);
-           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UA);
-           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UP);
-           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UL);
- 
-      BEGIN
- 
-           BEGIN
-                V_A_CA_UR := NEW CA_UR'(NEW UR'(1,(IDENT_INT(2))));
- 
-                IF EQUAL (V_A_CA_UR, V_A_CA_UR) THEN
-                     FAILED ("NO EXCEPTION RAISED - UR");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UR");
-           END;
- 
-           BEGIN
-                V_A_CA_UA := NEW CA_UA'(NEW UA'(1 => 2,
-                                                2 => IDENT_INT(3)));
- 
-                IF EQUAL (V_A_CA_UA, V_A_CA_UA) THEN
-                     FAILED ("NO EXCEPTION RAISED - UA");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UA");
-           END;
- 
-           BEGIN
-                V_A_CA_UP := NEW CA_UP'(NEW P.UP'(P.CONS_UP));
- 
-                IF EQUAL (V_A_CA_UP, V_A_CA_UP) THEN
-                     FAILED ("NO EXCEPTION RAISED - UP");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UP");
-           END;
- 
-           BEGIN
-                V_A_CA_UR := NEW CA_UR'(NULL);
- 
-                IF NOT EQUAL (V_A_CA_UR, V_A_CA_UR) THEN
-                     COMMENT ("NO EXCEPTION RAISED - UR");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - UR");
-           END;
- 
-           BEGIN
-                V_A_CA_UA := NEW CA_UA'(NULL);
- 
-                IF NOT EQUAL (V_A_CA_UA, V_A_CA_UA) THEN
-                     COMMENT ("NO EXCEPTION RAISED - UA");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - UA");
-           END;
- 
-           BEGIN
-                V_A_CA_UP := NEW CA_UP'(NULL);
- 
-                IF NOT EQUAL (V_A_CA_UP, V_A_CA_UP) THEN
-                     COMMENT ("NO EXCEPTION RAISED - UP");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - UP");
-           END;
- 
-           BEGIN
-                V_A_CA_UL := NEW CA_UL'(NULL);
- 
-                IF NOT EQUAL (V_A_CA_UL, V_A_CA_UL) THEN
-                     COMMENT ("NO EXCEPTION RAISED - UL");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - UL");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48009G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- C48009H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS AN (UNCONSTRAINED) ACCESS TYPE, THE DESIGNATED TYPE
- -- FOR T'BASE IS CONSTRAINED, AND THE OBJECT DESIGNATED BY X DOES NOT
- -- HAVE DISCRIMINANTS OR INDEX BOUNDS THAT EQUAL THE CORRESPONDING
- -- VALUES FOR T'S DESIGNATED TYPE.
- 
- -- EG  08/30/84
- 
- WITH REPORT;
- 
- PROCEDURE C48009H IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48009H","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                     "APPROPRIATE - UNCONSTRAINED ACCESS TYPE OF A " &
-                     "CONSTRAINED TYPE");
- 
-      DECLARE
- 
-           TYPE UR(A : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
- 
-           PACKAGE P IS
-                TYPE UP(A : INTEGER) IS PRIVATE;
-                TYPE UL(A : INTEGER) IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE UP(A : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-                TYPE UL(A : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END P;
- 
-           TYPE A_CR IS ACCESS UR(IDENT_INT(2));
-           TYPE A_CA IS ACCESS UA(2 .. IDENT_INT(4));
-           TYPE A_CP IS ACCESS P.UP(3);
-           TYPE A_CL IS ACCESS P.UL(4);
- 
-           TYPE AA_CR IS ACCESS A_CR;
-           TYPE AA_CA IS ACCESS A_CA;
-           TYPE AA_CP IS ACCESS A_CP;
-           TYPE AA_CL IS ACCESS A_CL;
- 
-           V_AA_CR : AA_CR;
-           V_AA_CA : AA_CA;
-           V_AA_CP : AA_CP;
-           V_AA_CL : AA_CL;
- 
-      BEGIN
- 
-           BEGIN
-                V_AA_CR := NEW A_CR'(NEW UR(3));
-                FAILED ("NO EXCEPTION RAISED - CR");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CR");
-           END;
- 
-           BEGIN
-                V_AA_CA := NEW A_CA'(NEW UA(IDENT_INT(3) .. 5));
-                FAILED ("NO EXCEPTION RAISED - CA");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CA");
-           END;
- 
-           BEGIN
-                V_AA_CP := NEW A_CP'(NEW P.UP(IDENT_INT(4)));
-                FAILED ("NO EXCEPTION RAISED - CP");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CP");
-           END;
- 
-           BEGIN
-                V_AA_CL := NEW A_CL'(NEW P.UL(5));
-                FAILED ("NO EXCEPTION RAISED - CL");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CL");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48009H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C48009I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF THE DESIGNATED TYPE FOR "NEW T'(X)" IS A CONSTRAINED
- -- ACCESS TYPE, CA, T IS CA'BASE, AND A DISCRIMINANT OR INDEX VALUE OF X
- -- DOES NOT EQUAL A VALUE SPECIFIED FOR CA.
- 
- -- EG  08/30/84
- 
- WITH REPORT;
- 
- PROCEDURE C48009I IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48009I","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                     "APPROPRIATE - ACCESS TYPE OF CONSTRAINED " &
-                     "ACCESS TYPE");
- 
-      DECLARE
- 
-           TYPE UR(A : INTEGER) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-           
-           PACKAGE P IS
-                TYPE UP(A : INTEGER) IS PRIVATE;
-                TYPE UL(A : INTEGER) IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE UP(A : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-                TYPE UL(A : INTEGER) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END P;
- 
-           TYPE A_UR IS ACCESS UR;
-           TYPE A_UA IS ACCESS UA;
-           TYPE A_UP IS ACCESS P.UP;
-           TYPE A_UL IS ACCESS P.UL;
- 
-           TYPE AC_A_UR IS ACCESS A_UR(2);
-           TYPE AC_A_UA IS ACCESS A_UA(2 .. 4);
-           TYPE AC_A_UP IS ACCESS A_UP(3);
-           TYPE AC_A_UL IS ACCESS A_UL(4);
- 
-           V_AC_A_UR : AC_A_UR;
-           V_AC_A_UA : AC_A_UA;
-           V_AC_A_UP : AC_A_UP;
-           V_AC_A_UL : AC_A_UL;
- 
-      BEGIN
- 
-           BEGIN
-                V_AC_A_UR := NEW A_UR'(NEW UR(3));
-                FAILED ("NO EXCEPTION RAISED - UR");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UR");
-           END;
- 
-           BEGIN
-                V_AC_A_UA := NEW A_UA'(NEW UA(3 .. 5));
-                FAILED ("NO EXCEPTION RAISED - UA");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UA");
-           END;
- 
-           BEGIN
-                V_AC_A_UP := NEW A_UP'(NEW P.UP(IDENT_INT(4)));
-                FAILED ("NO EXCEPTION RAISED - UP");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UP");
-           END;
- 
-           BEGIN
-                V_AC_A_UL := NEW A_UL'(NEW P.UL(IDENT_INT(5)));
-                FAILED ("NO EXCEPTION RAISED - UL");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UL");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48009I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48009j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48009j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- C48009J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
- -- IS RAISED IF T IS AN UNCONSTRAINED ACCESS TYPE, ITS DESIGNATED TYPE
- -- IS ALSO UNCONSTRAINED, AND A DISCRIMINANT VALUE FOR X LIES OUTSIDE
- -- THE RANGE OF THE CORRESPONDING DISCRIMINANT SPECIFICATION FOR THE
- -- DESIGNATED TYPE, OR A NON-NULL INDEX BOUND LIES OUTSIDE THE RANGE OF
- -- AN INDEX SUBTYPE OF THE DESIGNATED TYPE.
- 
- -- EG  08/30/84
- 
- WITH REPORT;
- 
- PROCEDURE C48009J IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48009J","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
-                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                     "APPROPRIATE - ACCESS TYPE OF UNCONSTRAINED " &
-                     "ACCESS TYPE");
- 
-      DECLARE
- 
-           TYPE INT IS RANGE 1 .. 5;
- 
-           TYPE UR(A : INT) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           TYPE UA IS ARRAY(INT RANGE <>) OF INTEGER;
- 
-           PACKAGE P IS
-                TYPE UP(A : INT) IS PRIVATE;
-                TYPE UL(A : INT) IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE UP(A : INT) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-                TYPE UL(A : INT) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END P;
- 
-           TYPE A_UR IS ACCESS UR;
-           TYPE A_UA IS ACCESS UA;
-           TYPE A_UP IS ACCESS P.UP;
-           TYPE A_UL IS ACCESS P.UL;
- 
-           TYPE AA_UR IS ACCESS A_UR;
-           TYPE AA_UA IS ACCESS A_UA;
-           TYPE AA_UP IS ACCESS A_UP;
-           TYPE AA_UL IS ACCESS A_UL;
- 
-           V_AA_UR : AA_UR;
-           V_AA_UA : AA_UA;
-           V_AA_UP : AA_UP;
-           V_AA_UL : AA_UL;
- 
-      BEGIN
- 
-           BEGIN
-                V_AA_UR := NEW A_UR'(NEW UR(INT(IDENT_INT(6))));
-                FAILED ("NO EXCEPTION RAISED - UR");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UR");
-           END;
- 
-           BEGIN
-                V_AA_UA := NEW A_UA'(NEW UA(4 .. 7));
-                FAILED ("NO EXCEPTION RAISED - UA");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UA");
-           END;
- 
-           BEGIN
-                V_AA_UP := NEW A_UP'(NEW P.UP(0));
-                FAILED ("NO EXCEPTION RAISED - UP");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UP");
-           END;
- 
-           BEGIN
-                V_AA_UL := NEW A_UL'(NEW P.UL(INT(IDENT_INT(0))));
-                FAILED ("NO EXCEPTION RAISED - UL");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - UL");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C48009J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C48010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NULL ARRAYS AND NULL RECORDS CAN BE ALLOCATED.
- 
- -- EG  08/30/84
- 
- WITH REPORT;
- 
- PROCEDURE C48010A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48010A","CHECK THAT NULL ARRAYS AND NULL RECORDS CAN " &
-                     "BE ALLOCATED");
- 
-      DECLARE
- 
-           TYPE CA IS ARRAY(4 .. 3) OF INTEGER;
-           TYPE CR IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE A_CA IS ACCESS CA;
-           TYPE A_CR IS ACCESS CR;
- 
-           TYPE AA_CA IS ACCESS A_CA;
-           TYPE AA_CR IS ACCESS A_CR;
- 
-           V_A_CA  : A_CA;
-           V_A_CR  : A_CR;
-           V_AA_CA : AA_CA;
-           V_AA_CR : AA_CR;
- 
-      BEGIN
- 
-           V_A_CA := NEW CA;
-           IF V_A_CA = NULL THEN
-                FAILED ("NULL ARRAY WAS NOT ALLOCATED - CA");
-           ELSIF V_A_CA.ALL'FIRST /= 4 AND V_A_CA.ALL'LAST /= 3 THEN
-                FAILED ("NULL ARRAY BOUNDS ARE INCORRECT - CA");
-           END IF;
- 
-           V_A_CR := NEW CR;
-           IF V_A_CR = NULL THEN
-                FAILED ("NULL RECORD WAS NOT ALLOCATED - CR");
-           END IF;
- 
-           V_AA_CA := NEW A_CA'(NEW CA);
-           IF V_AA_CA.ALL = NULL THEN
-                FAILED ("NULL ARRAY WAS NOT ALLOCATED - A_CA");
-           ELSIF V_AA_CA.ALL.ALL'FIRST /= 4 AND 
-                 V_AA_CA.ALL.ALL'LAST /= 3 THEN
-                FAILED ("NULL ARRAY BOUNDS ARE INCORRECT - A_CA");
-           END IF;
- 
-           V_AA_CR := NEW A_CR'(NEW CR);
-           IF (V_AA_CR = NULL OR V_AA_CR.ALL = NULL) THEN
-                FAILED ("NULL RECORD WAS NOT ALLOCATED - A_CR");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C48011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OVERLOADED ALLOCATORS ARE DETERMINED TO HAVE THE
- --     APPROPRIATE TYPE.
- 
- -- HISTORY:
- --     JET 08/17/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C48011A IS
- 
-      TYPE ACC1 IS ACCESS INTEGER;
-      TYPE ACC2 IS ACCESS INTEGER;
- 
-      A1 : ACC1 := NULL;
-      A2 : ACC2 := NULL;
- 
-      TYPE REC1 IS RECORD
-           A : INTEGER;
-      END RECORD;
- 
-      TYPE REC2 IS RECORD
-           A : ACC2;
-      END RECORD;
- 
-      TYPE AREC1 IS ACCESS REC1;
-      TYPE AREC2 IS ACCESS REC2;
- 
-      PROCEDURE PROC(A : ACC1) IS
-      BEGIN
-           IF A.ALL /= 1 THEN
-                FAILED("INCORRECT CALL OF FIRST PROC");
-           END IF;
-      END PROC;
- 
-      PROCEDURE PROC(A : INTEGER) IS
-      BEGIN
-           IF A /= 2 THEN
-                FAILED("INCORRECT CALL OF SECOND PROC");
-           END IF;
-      END PROC;
- 
-      FUNCTION FUNC(I : INTEGER) RETURN AREC1 IS
-      BEGIN
-           IF I /= 1 THEN
-                FAILED("INCORRECT CALL OF FIRST FUNC");
-           END IF;
-           RETURN NEW REC1'(A => 0);
-      END FUNC;
- 
-      FUNCTION FUNC(I : INTEGER) RETURN AREC2 IS
-      BEGIN
-           IF I /= 2 THEN
-                FAILED("INCORRECT CALL OF SECOND FUNC");
-           END IF;
-           RETURN NEW REC2'(A => NULL);
-      END FUNC;
- 
- BEGIN
-      TEST ("C48011A", "CHECK THAT OVERLOADED ALLOCATORS ARE " &
-                       "DETERMINED TO HAVE THE APPROPRIATE TYPE");
- 
-      IF A1 = NEW INTEGER'(1) THEN
-           FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 1");
-      END IF;
- 
-      IF A2 = NEW INTEGER'(2) THEN
-           FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 2");
-      END IF;
- 
-      FUNC(1).A := INTEGER'(1);
-      FUNC(IDENT_INT(2)).A := NEW INTEGER'(2);
- 
-      PROC(NEW INTEGER'(IDENT_INT(1)));
-      PROC(IDENT_INT(2));
- 
-      RESULT;
- END C48011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48012a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c48012a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c48012a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C48012A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DISCRIMINANTS GOVERNING VARIANT PARTS NEED NOT BE
- -- SPECIFIED WITH STATIC VALUES IN AN ALLOCATOR OF THE FORM 
- -- "NEW T X".
- 
- -- EG  08/30/84
- 
- WITH REPORT;
- 
- PROCEDURE C48012A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C48012A","CHECK THAT DISCRIMINANTS GOVERNING VARIANT " &
-                     "PARTS NEED NOT BE SPECIFIED WITH STATIC "    &
-                     "VALUES IN AN ALLOCATOR OF THE FORM 'NEW T X'");
- 
-      DECLARE
- 
-           TYPE INT IS RANGE 1 .. 5;
-           TYPE ARR IS ARRAY(INT RANGE <>) OF INTEGER;
- 
-           TYPE UR(A : INT) IS
-                RECORD
-                     CASE A IS
-                          WHEN 1 =>
-                               NULL;
-                          WHEN OTHERS =>
-                               B : ARR(1 .. A);
-                     END CASE;
-                END RECORD;
- 
-           TYPE A_UR IS ACCESS UR;
- 
-           V_A_UR : A_UR;
- 
-      BEGIN
- 
-           V_A_UR := NEW UR(A => INT(IDENT_INT(2)));
-           IF V_A_UR.A /= 2 THEN
-                FAILED ("WRONG DISCRIMINANT VALUE");
-           ELSIF V_A_UR.B'FIRST /= 1 AND V_A_UR.B'LAST /= 2 THEN
-                FAILED ("WRONG BOUNDS IN VARIANT PART");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C48012A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c490001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c490001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c490001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c490001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- C490001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for a real static expression that is not part of a larger
- --      static expression, and whose expected type T is a floating point type
- --      that is not a descendant of a formal scalar type, the value is rounded
- --      to the nearest machine number of T if T'Machine_Rounds is true, and is
- --      truncated otherwise. Check that if rounding is performed, and the value
- --      is exactly halfway between two machine numbers, one of the two machine
- --      numbers is used.
- --
- -- TEST DESCRIPTION:
- --      The test obtains a machine number M1 for a floating point subtype S by
- --      passing a real literal to S'Machine. It then obtains an adjacent
- --      machine number M2 by using S'Succ (or S'Pred). It then constructs
- --      values which lie between these two machine numbers: one (A) which is
- --      closer to M1, one (B) which is exactly halfway between M1 and M2, and
- --      one (C) which is closer to M2. This is done for both positive and
- --      negative machine numbers.
- --
- --      Let M1 be closer to zero than M2. Then if S'Machine_Rounds is true,
- --      C must be rounded to M2, A must be rounded to M1, and B must be rounded
- --      to either M1 or M2. If S'Machine_Rounds is false, all the values must
- --      be truncated to M1.
- --
- --      A, B, and C are constructed using the following static expressions:
- --
- --         A: constant S := M1 + (M2 - M1)*Z; -- Z slightly less than 0.5.
- --         B: constant S := M1 + (M2 - M1)*Z; -- Z equals 0.5.
- --         C: constant S := M1 + (M2 - M1)*Z; -- Z slightly more than 0.5.
- --
- --      Since these are static expressions, they must be evaluated exactly,
- --      and no rounding may occur until the final result is calculated.
- --
- --      The checks for equality between the members of (A, B, C) and (M1, M2)
- --      are performed at run-time within the body of a subprogram.
- --
- --      The test performs additional checks that the rounding performed on
- --      real literals is consistent for a floating point subtype. A literal is
- --      assigned to a constant of a floating point subtype S. The same literal
- --      is then passed to a subprogram, along with the constant, and an
- --      equality check is performed within the body of the subprogram.
- --
- --
- -- CHANGE HISTORY:
- --      25 Sep 95   SAIC    Initial prerelease version.
- --      25 May 01   RLB     Repaired to work with the repeal of the round away
- --                          rule by AI-268.
- --
- --!
- 
- with System;
- package C490001_0 is
- 
-    type My_Flt is digits System.Max_Digits;
- 
-    procedure Float_Subtest (A, B: in My_Flt; Msg: in String);
- 
-    procedure Float_Subtest (A, B, C: in My_Flt; Msg: in String);
- 
- 
- --
- -- Positive cases:
- --
- 
-    --  |----|-------------|-----------------|-------------------|-----------|
-    --  |    |             |                 |                   |           |
-    --  0   P_M1  Less_Pos_Than_Half  Pos_Exactly_Half  More_Pos_Than_Half  P_M2
- 
- 
-    Positive_Float : constant My_Flt := 12.440193950021943;
- 
-    -- The literal value 12.440193950021943 is rounded up or down to the
-    -- nearest machine number of My_Flt when Positive_Float is initialized.
-    -- The value of Positive_Float should therefore be a machine number, and
-    -- the use of 'Machine in the initialization of P_M1 will be redundant for
-    -- a correct implementation. It's done anyway to make certain that P_M1 is
-    -- a machine number, independent of whether an implementation correctly
-    -- performs rounding.
- 
-    P_M1 : constant My_Flt := My_Flt'Machine(Positive_Float);
-    P_M2 : constant My_Flt := My_Flt'Succ(P_M1);
- 
-    -- P_M1 and P_M2 are adjacent machine numbers. Note that because it is not
-    -- certain whether 12.440193950021943 is a machine number, nor whether
-    -- 'Machine rounds it up or down, 12.440193950021943 may not lie between
-    -- P_M1 and P_M2. The test does not depend on this information, however;
-    -- the literal is only used as a "seed" to obtain the machine numbers.
- 
- 
-    -- The following entities are used to verify that rounding is performed
-    -- according to the value of 'Machine_Rounds. If language rules are
-    -- obeyed, the intermediate expressions in the following static
-    -- initialization expressions will not be rounded; all calculations will
-    -- be performed exactly. The final result, however, will be rounded to
-    -- a machine number (either P_M1 or P_M2, depending on the value of
-    -- My_Flt'Machine_Rounds). Thus, the value of each constant below will
-    -- equal that of P_M1 or P_M2.
- 
-    Less_Pos_Than_Half : constant My_Flt := P_M1 + ((P_M2 - P_M1)*2.9/6.0);
-    Pos_Exactly_Half   : constant My_Flt := P_M1 + ((P_M2 - P_M1)/2.0);
-    More_Pos_Than_Half : constant My_Flt := P_M1 + ((P_M2 - P_M1)*4.6/9.0);
- 
- 
- --
- -- Negative cases:
- --
- 
-    --  -|-------------|-----------------|-------------------|-----------|----|
-    --   |             |                 |                   |           |    |
-    --  N_M2  More_Neg_Than_Half  Neg_Exactly_Half  Less_Neg_Than_Half  N_M1  0
- 
- 
-    -- The descriptions for the positive cases above apply to the negative
-    -- cases below as well. Note that, for N_M2, 'Pred is used rather than
-    -- 'Succ. Thus, N_M2 is further from 0.0 (i.e. more negative) than N_M1.
- 
-    Negative_Float : constant My_Flt := -0.692074550952117;
- 
- 
-    N_M1 : constant My_Flt := My_Flt'Machine(Negative_Float);
-    N_M2 : constant My_Flt := My_Flt'Pred(N_M1);
- 
-    More_Neg_Than_Half : constant My_Flt := N_M1 + ((N_M2 - N_M1)*4.1/8.0);
-    Neg_Exactly_Half   : constant My_Flt := N_M1 + ((N_M2 - N_M1)/2.0);
-    Less_Neg_Than_Half : constant My_Flt := N_M1 + ((N_M2 - N_M1)*2.4/5.0);
- 
- end C490001_0;
- 
- 
-      --==================================================================--
- 
- 
- with TCTouch;
- package body C490001_0 is
- 
-    procedure Float_Subtest (A, B: in My_Flt; Msg: in String) is
-    begin
-        TCTouch.Assert (A = B, Msg);
-    end Float_Subtest;
- 
-    procedure Float_Subtest (A, B, C: in My_Flt; Msg: in String) is
-    begin
-        TCTouch.Assert (A = B or A = C, Msg);
-    end Float_Subtest;
- 
- end C490001_0;
- 
- 
-      --==================================================================--
- 
- 
- with C490001_0;  -- Floating point support.
- use  C490001_0;
- 
- with Report;
- procedure C490001 is
- begin
-    Report.Test ("C490001", "Rounding of real static expressions: " &
-                 "floating point subtypes");
- 
- 
-    -- Check that rounding direction is consistent for literals:
- 
-    Float_Subtest (12.440193950021943, P_M1, "Positive Float: literal");
-    Float_Subtest (-0.692074550952117, N_M1, "Negative Float: literal");
- 
- 
-    -- Now check that rounding is performed correctly for values between
-    -- machine numbers, according to the value of 'Machine_Rounds:
- 
-    if My_Flt'Machine_Rounds then
-       Float_Subtest (Pos_Exactly_Half,   P_M1, P_M2, "Positive Float: = half");
-       Float_Subtest (More_Pos_Than_Half, P_M2, "Positive Float: > half");
-       Float_Subtest (Less_Pos_Than_Half, P_M1, "Positive Float: < half");
- 
-       Float_Subtest (Neg_Exactly_Half,   N_M1, N_M2, "Negative Float: = half");
-       Float_Subtest (More_Neg_Than_Half, N_M2, "Negative Float: > half");
-       Float_Subtest (Less_Neg_Than_Half, N_M1, "Negative Float: < half");
-    else
-       Float_Subtest (Pos_Exactly_Half,   P_M1, "Positive Float: = half");
-       Float_Subtest (More_Pos_Than_Half, P_M1, "Positive Float: > half");
-       Float_Subtest (Less_Pos_Than_Half, P_M1, "Positive Float: < half");
- 
-       Float_Subtest (Neg_Exactly_Half,   N_M1, "Negative Float: = half");
-       Float_Subtest (More_Neg_Than_Half, N_M1, "Negative Float: > half");
-       Float_Subtest (Less_Neg_Than_Half, N_M1, "Negative Float: < half");
-    end if;
- 
- 
-    Report.Result;
- end C490001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c490002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c490002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c490002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c490002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,239 ****
- -- C490002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for a real static expression that is not part of a larger
- --      static expression, and whose expected type T is an ordinary fixed
- --      point type that is not a descendant of a formal scalar type, the value
- --      is rounded to the nearest integral multiple of the small of T if
- --      T'Machine_Rounds is true, and is truncated otherwise. Check that if
- --      rounding is performed, and the value is exactly halfway between two
- --      multiples of the small, one of the two multiples of small is used.
- --
- -- TEST DESCRIPTION:
- --      The test obtains an integral multiple M1 of the small of an ordinary
- --      fixed point subtype S by dividing a real literal by S'Small, and then
- --      truncating the result using 'Truncation. It then obtains an adjacent
- --      multiple M2 of the small by using S'Succ (or S'Pred). It then
- --      constructs values which lie between these multiples: one (A) which is
- --      closer to M1, one (B) which is exactly halfway between M1 and M2, and
- --      one (C) which is closer to M2. This is done for both positive and
- --      negative multiples of the small.
- --
- --      Let M1 be closer to zero than M2. Then if S'Machine_Rounds is true,
- --      C must be rounded to M2, A must be rounded to M1, and B must be rounded
- --      to either M1 or M2. If S'Machine_Rounds is false, all the values must
- --      be truncated to M1.
- --
- --      A, B, and C are constructed using the following static expressions:
- --
- --         A: constant S := M1 + (M2 - M1)/Z; -- Z slightly more than 2.0.
- --         B: constant S := M1 + (M2 - M1)/Z; -- Z equals 2.0.
- --         C: constant S := M1 + (M2 - M1)/Z; -- Z slightly less than 2.0.
- --
- --      Since these are static expressions, they must be evaluated exactly,
- --      and no rounding may occur until the final result is calculated.
- --
- --      The checks for equality between the members of (A, B, C) and (M1, M2)
- --      are performed at run-time within the body of a subprogram.
- --
- --      The test performs additional checks that the rounding performed on
- --      real literals is consistent for ordinary fixed point subtypes. A
- --      named number (initialized with a literal) is assigned to a constant of
- --      a fixed point subtype S. The same literal is then passed to a
- --      subprogram, along with the constant, and an equality check is
- --      performed within the body of the subprogram.
- --
- --
- -- CHANGE HISTORY:
- --      26 Sep 95   SAIC    Initial prerelease version.
- --
- --!
- 
- package C490002_0 is
- 
-    type My_Fix is delta 0.0625 range -1000.0 .. 1000.0;
- 
-    Small : constant := My_Fix'Small;                      -- Named number.
- 
-    procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String);
- 
-    procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String);
- 
- 
- --
- -- Positive cases:
- --
- 
-    --  |----|-------------|-----------------|-------------------|-----------|
-    --  |    |             |                 |                   |           |
-    --  0   P_M1  Less_Pos_Than_Half  Pos_Exactly_Half  More_Pos_Than_Half  P_M2
- 
- 
-    Positive_Real  : constant := 0.11433;          -- Named number.
-    Pos_Multiplier : constant := Float'Truncation(Positive_Real/Small);
- 
-    -- Pos_Multiplier is the number of integral multiples of small contained
-    -- in Positive_Real. P_M1 is thus the largest integral multiple of
-    -- small less than or equal to Positive_Real. Note that since Positive_Real
-    -- is a named number and not a fixed point object, P_M1 is generated
-    -- without assuming that rounding is performed correctly for fixed point
-    -- subtypes.
- 
-    Positive_Fixed : constant My_Fix := Positive_Real;
- 
-    P_M1 : constant My_Fix := Pos_Multiplier * Small;
-    P_M2 : constant My_Fix := My_Fix'Succ(P_M1);
- 
-    -- P_M1 and P_M2 are adjacent multiples of the small of My_Fix. Note that
-    -- 0.11433 either equals P_M1 (if it is an integral multiple of the small)
-    -- or lies between P_M1 and P_M2 (since truncation was forced in
-    -- generating Pos_Multiplier). It is not certain, however, exactly where
-    -- it lies between them (halfway, less than halfway, more than halfway).
-    -- This fact is irrelevant to the test.
- 
- 
-    -- The following entities are used to verify that rounding is performed
-    -- according to the value of 'Machine_Rounds. If language rules are
-    -- obeyed, the intermediate expressions in the following static
-    -- initialization expressions will not be rounded; all calculations will
-    -- be performed exactly. The final result, however, will be rounded to
-    -- an integral multiple of the small (either P_M1 or P_M2, depending on the
-    -- value of My_Fix'Machine_Rounds). Thus, the value of each constant below
-    -- will equal that of P_M1 or P_M2.
- 
-    Less_Pos_Than_Half : constant My_Fix := P_M1 + ((P_M2 - P_M1)/2.050);
-    Pos_Exactly_Half   : constant My_Fix := P_M1 + ((P_M2 - P_M1)/2.000);
-    More_Pos_Than_Half : constant My_Fix := P_M1 + ((P_M2 - P_M1)/1.975);
- 
- 
- --
- -- Negative cases:
- --
- 
-    --  -|-------------|-----------------|-------------------|-----------|----|
-    --   |             |                 |                   |           |    |
-    --  N_M2  More_Neg_Than_Half  Neg_Exactly_Half  Less_Neg_Than_Half  N_M1  0
- 
- 
-    -- The descriptions for the positive cases above apply to the negative
-    -- cases below as well. Note that, for N_M2, 'Pred is used rather than
-    -- 'Succ. Thus, N_M2 is further from 0.0 (i.e. more negative) than N_M1.
- 
-    Negative_Real  : constant := -467.13988;       -- Named number.
-    Neg_Multiplier : constant := Float'Truncation(Negative_Real/Small);
- 
-    Negative_Fixed : constant My_Fix := Negative_Real;
- 
-    N_M1 : constant My_Fix := Neg_Multiplier * Small;
-    N_M2 : constant My_Fix := My_Fix'Pred(N_M1);
- 
-    More_Neg_Than_Half : constant My_Fix := N_M1 + ((N_M2 - N_M1)/1.980);
-    Neg_Exactly_Half   : constant My_Fix := N_M1 + ((N_M2 - N_M1)/2.000);
-    Less_Neg_Than_Half : constant My_Fix := N_M1 + ((N_M2 - N_M1)/2.033);
- 
- end C490002_0;
- 
- 
-      --==================================================================--
- 
- 
- with TCTouch;
- package body C490002_0 is
- 
-    procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String) is
-    begin
-        TCTouch.Assert (A = B, Msg);
-    end Fixed_Subtest;
- 
-    procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String) is
-    begin
-        TCTouch.Assert (A = B or A = C, Msg);
-    end Fixed_Subtest;
- 
- end C490002_0;
- 
- 
-      --==================================================================--
- 
- 
- with C490002_0;  -- Fixed point support.
- use  C490002_0;
- 
- with Report;
- procedure C490002 is
- begin
-    Report.Test ("C490002", "Rounding of real static expressions: " &
-                 "ordinary fixed point subtypes");
- 
- 
-    -- Literal cases: If the named numbers used to initialize Positive_Fixed
-    -- and Negative_Fixed are rounded to an integral multiple of the small
-    -- prior to assignment (as expected), then Positive_Fixed and
-    -- Negative_Fixed are already integral multiples of the small, and
-    -- equal either P_M1 or P_M2 (resp., N_M1 or N_M2). An equality check
-    -- can determine in which direction rounding occurred. For example:
-    --
-    --        if (Positive_Fixed = P_M1) then -- Rounding was toward 0.0.
-    --
-    -- Check here that the rounding direction is consistent for literals:
- 
-    if (Positive_Fixed = P_M1) then
-       Fixed_Subtest (0.11433, P_M1, "Positive Fixed: literal");
-    else
-       Fixed_Subtest (0.11433, P_M2, "Positive Fixed: literal");
-    end if;
- 
-    if (Negative_Fixed = N_M1) then
-       Fixed_Subtest (-467.13988, N_M1, "Negative Fixed: literal");
-    else
-       Fixed_Subtest (-467.13988, N_M2, "Negative Fixed: literal");
-    end if;
- 
- 
-    -- Now check that rounding is performed correctly for values between
-    -- multiples of the small, according to the value of 'Machine_Rounds:
- 
-    if My_Fix'Machine_Rounds then
-       Fixed_Subtest (Pos_Exactly_Half,   P_M1, P_M2, "Positive Fixed: = half");
-       Fixed_Subtest (More_Pos_Than_Half, P_M2, "Positive Fixed: > half");
-       Fixed_Subtest (Less_Pos_Than_Half, P_M1, "Positive Fixed: < half");
- 
-       Fixed_Subtest (Neg_Exactly_Half,   N_M1, N_M2, "Negative Fixed: = half");
-       Fixed_Subtest (More_Neg_Than_Half, N_M2, "Negative Fixed: > half");
-       Fixed_Subtest (Less_Neg_Than_Half, N_M1, "Negative Fixed: < half");
-    else
-       Fixed_Subtest (Pos_Exactly_Half,   P_M1, "Positive Fixed: = half");
-       Fixed_Subtest (More_Pos_Than_Half, P_M1, "Positive Fixed: > half");
-       Fixed_Subtest (Less_Pos_Than_Half, P_M1, "Positive Fixed: < half");
- 
-       Fixed_Subtest (Neg_Exactly_Half,   N_M1, "Negative Fixed: = half");
-       Fixed_Subtest (More_Neg_Than_Half, N_M1, "Negative Fixed: > half");
-       Fixed_Subtest (Less_Neg_Than_Half, N_M1, "Negative Fixed: < half");
-    end if;
- 
- 
-    Report.Result;
- end C490002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c490003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c490003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c490003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c490003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- C490003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a static expression is legal if its evaluation fails
- --      no language-defined check other than Overflow_Check. Check that such
- --      a static expression is legal if it is part of a larger static
- --      expression, even if its value is outside the base range of the
- --      expected type.
- --
- --      Check that if a static expression is part of the right operand of a
- --      short circuit control form whose value is determined by its left
- --      operand, it is not evaluated.
- --
- --      Check that a static expression in a non-static context is evaluated
- --      exactly.
- --
- -- TEST DESCRIPTION:
- --      The first part of the objective is tested by constructing static
- --      expressions which involve predefined operations of integer, floating
- --      point, and fixed point subtypes. Intermediate expressions within the
- --      static expressions have values outside the base range of the expected
- --      type. In one case, the extended-range intermediates are compared as
- --      part of a boolean expression. In the remaining two cases, further
- --      predefined operations on the intermediates bring the final result
- --      within the base range. An implementation which compiles these static
- --      expressions satisfies this portion of the objective. A check is
- --      performed at run-time to ensure that the static expressions evaluate
- --      to values within the base range of their respective expected types.
- --
- --      The second part of the objective is tested by constructing
- --      short-circuit control forms whose left operands have the values
- --      shown below:
- --
- --         (TRUE)  or else  (...)
- --         (FALSE) and then (...)
- --    
- --      In both cases the left operand determines the value of the condition.
- --      In the test each right operand involves a division by zero, which will
- --      raise Constraint_Error if evaluated. A check is made that no exception
- --      is raised when each short-circuit control form is evaluated, and that
- --      the value of the condition is that of the left operand.
- --    
- --      The third part of the objective is tested by evaluating static
- --      expressions involving many operations in contexts which do not
- --      require a static expression, and verifying that the exact
- --      mathematical results are calculated.
- --    
- --
- -- CHANGE HISTORY:
- --      15 Sep 95   SAIC    Initial prerelease version for ACVC 2.1.
- --      20 Oct 96   SAIC    Modified expressions in C490003_0 to avoid
- --                          the use of universal operands.
- --
- --!
- 
- with System;
- package C490003_0 is
- 
-    type My_Flt is digits System.Max_Digits;
- 
-    Flt_Range_Diff : My_Flt := (My_Flt'Base'Last - My_Flt'Base'First) -
-                               (My_Flt'Last - My_Flt'First);           -- OK.
- 
- 
-    type My_Fix is delta 0.125 range -128.0 .. 128.0;
- 
-    Symmetric : Boolean := (My_Fix'Base'Last - My_Fix'Base'First) = 
-                           (My_Fix'Base'Last + My_Fix'Base'Last);      -- OK.
- 
- 
-    Center : constant Integer := Integer'Base'Last -
-                                  (Integer'Base'Last -
-                                   Integer'Base'First) / 2;            -- OK.
- 
- end C490003_0;
- 
- 
-      --==================================================================--
- 
- 
- with Ada.Numerics;
- package C490003_1 is
- 
-    Zero       : constant := 0.0;
-    Pi         : constant := Ada.Numerics.Pi;
- 
-    Two_Pi     : constant := 2.0 * Pi;
-    Half_Pi    : constant := Pi/2.0;
- 
-    Quarter    : constant := 90.0;
-    Half       : constant := 180.0;
-    Full       : constant := 360.0;
- 
-    Deg_To_Rad : constant := Half_Pi/90;
-    Rad_To_Deg : constant := 1.0/Deg_To_Rad;
-    
- end C490003_1;
- 
- 
-      --==================================================================--
- 
- 
- with C490003_0;
- with C490003_1;
- 
- with Report;
- procedure C490003 is
- begin
-    Report.Test ("C490003", "Check that static expressions failing "          &
-                 "Overflow_Check are legal if part of a larger static "       &
-                 "expression. Check that static expressions as right "        &
-                 "operands of short-circuit control forms are not "           &
-                 "evaluated if value of control form is determined by "       &
-                 "left operand. Check that static expressions in non-static " &
-                 "contexts are evaluated exactly");
- 
- 
- --
- -- Static expressions within larger static expressions:
- --
- 
- 
-    if C490003_0.Flt_Range_Diff not in C490003_0.My_Flt'Base'Range then
-       Report.Failed ("Error evaluating static expression: floating point");
-    end if;
- 
-    if C490003_0.Symmetric not in Boolean'Range then
-       Report.Failed ("Error evaluating static expression: fixed point");
-    end if;
- 
-    if C490003_0.Center not in Integer'Base'Range then
-       Report.Failed ("Error evaluating static expression: integer");
-    end if;
- 
- 
- --
- -- Short-circuit control forms:
- --
- 
-    declare
-       N : constant := 0.0;
-    begin
- 
-       begin
-          if not ( (N = 0.0) or else (1.0/N > 0.5) ) then
-             Report.Failed ("Error evaluating OR ELSE");
-          end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Right side of OR ELSE was evaluated");
-          when others           =>
-             Report.Failed ("OR ELSE: unexpected exception raised");
-       end;
- 
-       begin
-          if (N /= 0.0) and then (1.0/N <= 0.5) then
-             Report.Failed ("Error evaluating AND THEN");
-          end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Right side of AND THEN was evaluated");
-          when others           =>
-             Report.Failed ("AND THEN: unexpected exception raised");
-       end;
- 
-    end;
- 
- 
- --
- -- Exact evaluation of static expressions:
- --
- 
- 
-    declare
-       use C490003_1;
- 
-       Left  : constant := 6.0 + 0.3125*( (Full*0.375) + (Half/2.4) -
-                              ((Quarter + 36.0)/3.0) )/10.0;            -- 11.25
-       Right : constant := (Pi/3.0) * 1.2 * (15.0/96.0);                -- Pi/16
-    begin
-       if Deg_To_Rad*Left /= Right then
-          Report.Failed ("Static expressions not evaluated exactly: #1");
-       end if;
- 
-       if ((Pi*Rad_To_Deg)*2.0 + 4.0*Quarter)/16.0 /= Rad_To_Deg*(Pi/4.0) then
-          Report.Failed ("Static expressions not evaluated exactly: #2");
-       end if;
-    end;
- 
- 
-    Report.Result;
- end C490003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49020a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49020a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49020a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49020a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C49020A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ENUMERATION LITERALS (INCLUDING CHARACTER LITERALS) CAN BE
- -- USED IN STATIC EXPRESSIONS TOGETHER WITH RELATIONAL AND EQUALITY 
- -- OPERATORS.
- 
- -- L.BROWN   09/30/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  C49020A  IS
- 
-      CAS_BOL : BOOLEAN := TRUE;
-      OBJ1 : INTEGER := 4;
-      TYPE ENUM IS (RED,GREEN,BLUE,OFF,ON,'A','B');
- 
- BEGIN
-      TEST("C49020A","ENUMERATION LITERALS (INCLUDING CHARACTER "&
-                     "LITERALS) TOGETHER WITH RELATIONAL OPERATORS "&
-                     "CAN BE USED IN STATIC EXPRESSION");
- 
-      CASE CAS_BOL IS
-           WHEN (RED <= BLUE) =>
-                OBJ1 := 5;
-           WHEN (BLUE = GREEN) =>
-                FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
-                       "EXPRESSION 1");
-      END CASE;
- 
-      CAS_BOL := TRUE;
- 
-      CASE CAS_BOL IS
-           WHEN (GREEN >= ON) =>
-                FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
-                       "EXPRESSION 2");
-           WHEN (ENUM'('A') < ENUM'('B')) =>
-                OBJ1 := 6;
-      END CASE;
- 
-      CAS_BOL := TRUE;
- 
-      CASE CAS_BOL IS
-           WHEN (BLUE > 'B') =>
-                FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
-                       "EXPRESSION 3");
-           WHEN (OFF /= 'A') =>
-                OBJ1 := 7;
-      END CASE;
- 
-      RESULT;
- 
- END C49020A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49021a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49021a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49021a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49021a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C49021A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT BOOLEAN LITERALS CAN BE USED IN STATIC EXPRESSIONS 
- -- TOGETHER WITH THE LOGICAL OPERATORS, THE NOT OPERATOR, AND THE
- -- RELATIONAL AND EQUALITY OPERATORS.
- 
- -- L.BROWN  09/25/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  C49021A  IS
- 
-      CAS_BOL : BOOLEAN := TRUE;
-      X1 : CONSTANT := BOOLEAN'POS((TRUE AND FALSE)OR(TRUE AND TRUE));
-      X2 : CONSTANT := BOOLEAN'POS((TRUE <= FALSE)AND(FALSE >= FALSE));
- 
- BEGIN
-      TEST("C49021A","BOOLEAN LITERALS TOGETHER WITH CERTAIN OPERATORS,"&
-                     "CAN BE USED IN STATIC EXPRESSIONS.");
-      IF X1 /= 1  THEN
-           FAILED("INCORRECT VALUE RETURNED BY BOOLEAN EXPRESSION 1");
-      END IF;
- 
-      IF X2 /= 0  THEN
-           FAILED("INCORRECT VALUE RETURNED BY BOOLEAN EXPRESSION 2");
-      END IF;
- 
-      CASE CAS_BOL IS
-           WHEN ((TRUE AND FALSE) XOR (TRUE XOR TRUE)) =>
-                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
-                       "EXPRESSION 2");
-           WHEN OTHERS =>
-                CAS_BOL := TRUE;
-      END CASE;
- 
-      CASE CAS_BOL IS
-           WHEN ((TRUE > FALSE) OR (FALSE <= TRUE)) =>
-                CAS_BOL := TRUE;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
-                       "EXPRESSION 3");
-      END CASE;
- 
-      CASE CAS_BOL IS
-           WHEN NOT((TRUE OR FALSE) = (FALSE AND TRUE)) =>
-                CAS_BOL := TRUE;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
-                       "EXPRESSION 4");
-      END CASE;
- 
-      CASE CAS_BOL IS
-           WHEN (((TRUE = FALSE) OR (FALSE AND TRUE)) /= (TRUE < TRUE))=>
-                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
-                       "EXPRESSION 5");
-           WHEN OTHERS =>
-                CAS_BOL := TRUE;
-      END CASE;
- 
-      RESULT;
- 
- END C49021A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49022a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49022a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49022a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49022a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C49022A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NAMED NUMBER DECLARATIONS (INTEGER) MAY USE EXPRESSIONS
- -- WITH INTEGERS.
- 
- -- BAW 29 SEPT 80
- -- TBN 10/28/85     RENAMED FROM C4A001A.ADA. ADDED RELATIONAL
- --                  OPERATORS AND USE OF NAMED NUMBERS.
- 
- WITH REPORT;
- PROCEDURE C49022A IS
- 
-      USE REPORT;
- 
-      ADD1 : CONSTANT :=   1   +  1;
-      ADD2 : CONSTANT :=   1   + (-1);
-      ADD3 : CONSTANT := (-1)  +   1;
-      ADD4 : CONSTANT := (-1)  + (-1);
-      SUB1 : CONSTANT :=   1   -   1;
-      SUB2 : CONSTANT :=   1   - (-1);
-      SUB3 : CONSTANT := (-1)  -   1;
-      SUB4 : CONSTANT := (-1)  - (-1);
-      MUL1 : CONSTANT :=   1   *   1;
-      MUL2 : CONSTANT :=   1   * (-1);
-      MUL3 : CONSTANT := (-1)  *   1;
-      MUL4 : CONSTANT := (-1)  * (-1);
-      DIV1 : CONSTANT :=   1   /   1;
-      DIV2 : CONSTANT :=   1   / (-1);
-      DIV3 : CONSTANT := (-1)  /   1;
-      DIV4 : CONSTANT := (-1)  / (-1);
-      REM1 : CONSTANT :=  14  REM  5;
-      REM2 : CONSTANT :=  14  REM(-5);
-      REM3 : CONSTANT :=(-14) REM  5;
-      REM4 : CONSTANT :=(-14) REM(-5);
-      MOD1 : CONSTANT :=   4  MOD   3;
-      MOD2 : CONSTANT :=   4  MOD (-3);
-      MOD3 : CONSTANT := (-4) MOD   3;
-      MOD4 : CONSTANT := (-4) MOD (-3);
-      EXP1 : CONSTANT :=   1  ** 1;
-      EXP2 : CONSTANT := (-1) ** 1;
-      ABS1 : CONSTANT := ABS( - 10 );
-      ABS2 : CONSTANT := ABS( + 10 );
-      TOT1 : CONSTANT := ADD1 + SUB1 - MUL1 + DIV1 - REM3 + MOD2 - EXP1;
-      LES1 : CONSTANT := BOOLEAN'POS (1 < 2);
-      LES2 : CONSTANT := BOOLEAN'POS (1 < (-2));
-      LES3 : CONSTANT := BOOLEAN'POS ((-1) < (-2));
-      LES4 : CONSTANT := BOOLEAN'POS (ADD1 < SUB1);
-      GRE1 : CONSTANT := BOOLEAN'POS (2 > 1);
-      GRE2 : CONSTANT := BOOLEAN'POS ((-1) > 2);
-      GRE3 : CONSTANT := BOOLEAN'POS ((-1) > (-2));
-      GRE4 : CONSTANT := BOOLEAN'POS (ADD1 > SUB1);
-      LEQ1 : CONSTANT := BOOLEAN'POS (1 <= 1);
-      LEQ2 : CONSTANT := BOOLEAN'POS ((-1) <= 1);
-      LEQ3 : CONSTANT := BOOLEAN'POS ((-1) <= (-2));
-      LEQ4 : CONSTANT := BOOLEAN'POS (ADD2 <= SUB3);
-      GEQ1 : CONSTANT := BOOLEAN'POS (2 >= 1);
-      GEQ2 : CONSTANT := BOOLEAN'POS ((-2) >= 1);
-      GEQ3 : CONSTANT := BOOLEAN'POS ((-2) >= (-1));
-      GEQ4 : CONSTANT := BOOLEAN'POS (ADD2 >= SUB3);
-      EQU1 : CONSTANT := BOOLEAN'POS (2 = 2);
-      EQU2 : CONSTANT := BOOLEAN'POS ((-2) = 2);
-      EQU3 : CONSTANT := BOOLEAN'POS ((-2) = (-2));
-      EQU4 : CONSTANT := BOOLEAN'POS (ADD2 = SUB3);
-      NEQ1 : CONSTANT := BOOLEAN'POS (2 /= 2);
-      NEQ2 : CONSTANT := BOOLEAN'POS ((-2) /= 1);
-      NEQ3 : CONSTANT := BOOLEAN'POS ((-2) /= (-2));
-      NEQ4 : CONSTANT := BOOLEAN'POS (ADD2 /= SUB3);
- 
- 
- BEGIN
-      TEST("C49022A","CHECK THAT NAMED NUMBER DECLARATIONS (INTEGER) " &
-                     "MAY USE EXPRESSIONS WITH INTEGERS");
- 
-      IF ADD1 /= 2 OR ADD2 /= 0 OR ADD3 /= 0 OR ADD4 /= -2 THEN
-           FAILED("ERROR IN THE ADDING OPERATOR +");
-      END IF;
- 
-      IF SUB1 /= 0 OR SUB2 /= 2 OR SUB3 /= -2 OR SUB4 /= 0 THEN
-           FAILED("ERROR IN THE ADDING OPERATOR -");
-      END IF;
- 
-      IF MUL1 /= 1 OR MUL2 /= -1 OR MUL3 /= -1 OR MUL4 /= 1 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
-      END IF;
- 
-      IF DIV1 /= 1 OR DIV2 /= -1 OR DIV3 /= -1 OR DIV4 /= 1 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
-      END IF;
- 
-      IF REM1 /= 4 OR REM2 /=  4 OR REM3 /= -4 OR REM4 /= -4 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR REM");
-      END IF;
- 
-      IF MOD1 /= 1 OR MOD2 /= -2 OR MOD3 /= 2 OR MOD4 /= -1 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR MOD");
-      END IF;
- 
-      IF EXP1 /= 1 OR EXP2 /= -1 THEN
-           FAILED("ERROR IN THE EXPONENTIATING OPERATOR");
-      END IF;
- 
-      IF ABS1 /= 10 OR ABS2 /= 10 THEN
-           FAILED("ERROR IN THE ABS OPERATOR");
-      END IF;
- 
-      IF TOT1 /= 3 THEN
-           FAILED("ERROR IN USING NAMED NUMBERS WITH OPERATORS");
-      END IF;
- 
-      IF LES1 /= 1 OR LES2 /= 0 OR LES3 /= 0 OR LES4 /= 0 THEN
-           FAILED("ERROR IN THE LESS THAN OPERATOR");
-      END IF;
- 
-      IF GRE1 /= 1 OR GRE2 /= 0 OR GRE3 /= 1 OR GRE4 /= 1 THEN
-           FAILED("ERROR IN THE GREATER THAN OPERATOR");
-      END IF;
- 
-      IF LEQ1 /= 1 OR LEQ2 /= 1 OR LEQ3 /= 0 OR LEQ4 /= 0 THEN
-           FAILED("ERROR IN THE LESS THAN EQUAL OPERATOR");
-      END IF;
- 
-      IF GEQ1 /= 1 OR GEQ2 /= 0 OR GEQ3 /= 0 OR GEQ4 /= 1 THEN
-           FAILED("ERROR IN THE GREATER THAN EQUAL OPERATOR");
-      END IF;
- 
-      IF EQU1 /= 1 OR EQU2 /= 0 OR EQU3 /= 1 OR EQU4 /= 0 THEN
-           FAILED("ERROR IN THE EQUAL OPERATOR");
-      END IF;
- 
-      IF NEQ1 /= 0 OR NEQ2 /= 1 OR NEQ3 /= 0 OR NEQ4 /= 1 THEN
-           FAILED("ERROR IN THE NOT EQUAL OPERATOR");
-      END IF;
- 
-      RESULT;
- 
- END C49022A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49022b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49022b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49022b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49022b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C49022B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN NUMBER DECLARATIONS, IDENTIFIERS CORRECTLY REPRESENT
- -- VALUES OF OTHER LITERALS.
- 
- -- BAW 29 SEPT 80
- -- TBN 10/22/85     RENAMED FROM C4A003A.ADA AND ADDED RELATIONAL 
- --                  OPERATORS USING NAMED NUMBERS.
- 
- 
- WITH REPORT;
- PROCEDURE C49022B IS
- 
-      USE REPORT;
- 
-      A : CONSTANT := 10;                     -- A =  10
-      B : CONSTANT := 25 - (2 * A);           -- B =   5
-      C : CONSTANT := A / B;                  -- C =   2
-      D : CONSTANT := (C * A) - (B - C);      -- D =  17
-      E : CONSTANT := D ** C;                 -- E = 289
-      F : CONSTANT := (E MOD A) + 1;          -- F =  10
-      G : CONSTANT := A REM B + C + D + E + ABS(-F);  -- G = 318
-      H : CONSTANT := BOOLEAN'POS (A > B);    -- H = 1
-      I : CONSTANT := BOOLEAN'POS (A < B);    -- I = 0
-      J : CONSTANT := BOOLEAN'POS (C >= A);   -- J = 0
-      K : CONSTANT := BOOLEAN'POS (B <= B);   -- K = 1
-      L : CONSTANT := BOOLEAN'POS (D = A);    -- L = 0
-      M : CONSTANT := BOOLEAN'POS (A /= F);   -- M = 0
- 
- BEGIN
-      TEST("C49022B","CHECK THAT IN NUMBER DECLARATIONS, IDENTIFIERS " &
-                     "CORRECTLY REPRESENT VALUES OF OTHER LITERALS");
- 
-      IF G /= 318 THEN
-           FAILED("USE OF OTHER NUMBER DECLARATIONS GIVES " &
-                  "WRONG RESULTS");
-      END IF;
- 
-      IF H /= 1 OR I /= 0 OR J /= 0 OR K /= 1 THEN
-           FAILED("USE OF NAMED NUMBERS AND RELATIONAL OPERATORS " &
-                  "GIVES WRONG RESULTS");
-      END IF;
- 
-      IF L /= 0 OR M /= 0 THEN
-           FAILED("USE OF NAMED NUMBERS AND EQUALITY OPERATORS " &
-                  "GIVES WRONG RESULTS");
-      END IF;
- 
-      RESULT;
- 
- END C49022B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49022c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49022c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49022c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49022c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C49022C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NAMED NUMBER DECLARATIONS (REAL) MAY USE EXPRESSIONS
- -- WITH REALS.
- 
- -- BAW 29 SEPT 80
- -- TBN 10/24/85     RENAMED FROM C4A011A.ADA. ADDED RELATIONAL
- --                  OPERATORS AND NAMED NUMBERS.
- 
- WITH REPORT;
- PROCEDURE C49022C IS
- 
-      USE REPORT;
- 
-      ADD1 : CONSTANT :=   2.5  +   1.5;
-      ADD2 : CONSTANT :=   2.5  + (-1.5);
-      ADD3 : CONSTANT := (-2.5) +   1.5;
-      ADD4 : CONSTANT := (-2.5) + (-1.5);
-      SUB1 : CONSTANT :=   2.5  -   1.5;
-      SUB2 : CONSTANT :=   2.5  - (-1.5);
-      SUB3 : CONSTANT := (-2.5) -   1.5;
-      SUB4 : CONSTANT := (-2.5) - (-1.5);
-      MUL1 : CONSTANT :=   2.5  *   1.5;
-      MUL2 : CONSTANT :=   2.5  * (-1.5);
-      MUL3 : CONSTANT := (-2.5) *   1.5;
-      MUL4 : CONSTANT := (-2.5) * (-1.5);
-      MLR1 : CONSTANT :=   2    *   1.5;
-      MLR2 : CONSTANT := (-2)   *   1.5;
-      MLR3 : CONSTANT :=   2    * (-1.5);
-      MLR4 : CONSTANT := (-2)   * (-1.5);
-      MLL1 : CONSTANT :=  1.5   *    2 ;
-      MLL2 : CONSTANT :=  1.5   *  (-2);
-      MLL3 : CONSTANT :=(-1.5)  *    2 ;
-      MLL4 : CONSTANT :=(-1.5)  *  (-2);
-      DIV1 : CONSTANT :=   3.75  /   2.5;
-      DIV2 : CONSTANT :=   3.75  / (-2.5);
-      DIV3 : CONSTANT := (-3.75) /   2.5;
-      DIV4 : CONSTANT := (-3.75) / (-2.5);
-      DVI1 : CONSTANT :=   3.0   /   2;
-      DVI2 : CONSTANT := (-3.0)  /   2;
-      DVI3 : CONSTANT :=   3.0   / (-2);
-      DVI4 : CONSTANT := (-3.0)  / (-2);
-      EXP1 : CONSTANT :=   2.0  **   1;
-      EXP2 : CONSTANT :=   2.0  ** (-1);
-      EXP3 : CONSTANT := (-2.0) **   1;
-      EXP4 : CONSTANT := (-2.0) ** (-1);
-      ABS1 : CONSTANT := ABS( - 3.75 );
-      ABS2 : CONSTANT := ABS( + 3.75 );
-      TOT1 : CONSTANT := ADD1 + SUB4 - MUL1 + DIV1 - EXP2 + ABS1;
-      LES1 : CONSTANT := BOOLEAN'POS (1.5 < 2.0);
-      LES2 : CONSTANT := BOOLEAN'POS (1.5 < (-2.0));
-      LES3 : CONSTANT := BOOLEAN'POS ((-1.5) < (-2.0));
-      LES4 : CONSTANT := BOOLEAN'POS (ADD2 < SUB1);
-      GRE1 : CONSTANT := BOOLEAN'POS (2.0 > 1.5);
-      GRE2 : CONSTANT := BOOLEAN'POS ((-2.0) > 1.5);
-      GRE3 : CONSTANT := BOOLEAN'POS ((-2.0) > (-1.5));
-      GRE4 : CONSTANT := BOOLEAN'POS (ADD1 > SUB1);
-      LEQ1 : CONSTANT := BOOLEAN'POS (1.5 <= 2.0);
-      LEQ2 : CONSTANT := BOOLEAN'POS (1.5 <= (-2.0));
-      LEQ3 : CONSTANT := BOOLEAN'POS ((-1.5) <= (-2.0));
-      LEQ4 : CONSTANT := BOOLEAN'POS (ADD2 <= SUB1);
-      GEQ1 : CONSTANT := BOOLEAN'POS (2.0 >= 1.5);
-      GEQ2 : CONSTANT := BOOLEAN'POS ((-2.0) >= 1.5);
-      GEQ3 : CONSTANT := BOOLEAN'POS ((-2.0) >= (-1.5));
-      GEQ4 : CONSTANT := BOOLEAN'POS (ADD1 >= SUB2);
-      EQU1 : CONSTANT := BOOLEAN'POS (1.5 = 2.0);
-      EQU2 : CONSTANT := BOOLEAN'POS ((-1.5) = 2.0);
-      EQU3 : CONSTANT := BOOLEAN'POS ((-1.5) = (-1.5));
-      EQU4 : CONSTANT := BOOLEAN'POS (ADD1 = SUB2);
-      NEQ1 : CONSTANT := BOOLEAN'POS (1.5 /= 1.5);
-      NEQ2 : CONSTANT := BOOLEAN'POS ((-1.5) /= 1.5);
-      NEQ3 : CONSTANT := BOOLEAN'POS ((-1.5) /= (-2.0));
-      NEQ4 : CONSTANT := BOOLEAN'POS (ADD1 /= SUB2);
- 
- 
- BEGIN
-      TEST("C49022C","CHECK THAT NAMED NUMBER DECLARATIONS (REAL) " &
-                     "MAY USE EXPRESSIONS WITH REALS.");
- 
-      IF ADD1 /= 4.0 OR ADD2 /= 1.0 OR ADD3 /= -1.0 OR ADD4 /= -4.0 THEN
-           FAILED("ERROR IN THE ADDING OPERATOR +");
-      END IF;
- 
-      IF SUB1 /= 1.0 OR SUB2 /= 4.0 OR SUB3 /= -4.0 OR SUB4 /= -1.0 THEN
-           FAILED("ERROR IN THE ADDING OPERATOR -");
-      END IF;
- 
-      IF MUL1 /= 3.75 OR MUL2 /= -3.75 OR
-         MUL3 /= -3.75 OR MUL4 /= 3.75 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
-      END IF;
- 
-      IF MLR1 /= 3.0 OR MLR2 /= -3.0 OR
-         MLR3 /= -3.0 OR MLR4 /= 3.0 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
-      END IF;
- 
-      IF MLL1 /= 3.0 OR MLL2 /= -3.0 OR MLL3 /= -3.0 OR MLL4 /= 3.0 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
-      END IF;
- 
-      IF DIV1 /= 1.5 OR DIV2 /= -1.5 OR DIV3 /= -1.5 OR DIV4 /= 1.5 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
-      END IF;
- 
-      IF DVI1 /= 1.5 OR DVI2 /= -1.5 OR DVI3 /= -1.5 OR DVI4 /= 1.5 THEN
-           FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
-      END IF;
- 
-      IF EXP1 /= 2.0 OR EXP2 /= 0.5 OR EXP3 /= -2.0 OR EXP4 /= -0.5 THEN
-           FAILED("ERROR IN THE EXPONENTIATING OPERATOR");
-      END IF;
- 
-      IF ABS1 /= 3.75 OR ABS2 /= 3.75 THEN
-           FAILED("ERROR IN THE ABS OPERATOR");
-      END IF;
- 
-      IF TOT1 /= 4.00 THEN
-           FAILED("ERROR IN USE OF NAMED NUMBERS WITH OPERATORS");
-      END IF;
- 
-      IF LES1 /= 1 OR LES2 /= 0 OR LES3 /= 0 OR LES4 /= 0 THEN
-           FAILED("ERROR IN THE LESS THAN OPERATOR");
-      END IF;
- 
-      IF GRE1 /= 1 OR GRE2 /= 0 OR GRE3 /= 0 OR GRE4 /= 1 THEN
-           FAILED("ERROR IN THE GREATER THAN OPERATOR");
-      END IF;
- 
-      IF LEQ1 /= 1 OR LEQ2 /= 0 OR LEQ3 /= 0 OR LEQ4 /= 1 THEN
-           FAILED("ERROR IN THE LESS THAN EQUAL OPERATOR");
-      END IF;
- 
-      IF GEQ1 /= 1 OR GEQ2 /= 0 OR GEQ3 /= 0 OR GEQ4 /= 1 THEN
-           FAILED("ERROR IN THE GREATER THAN EQUAL OPERATOR");
-      END IF;
- 
-      IF EQU1 /= 0 OR EQU2 /= 0 OR EQU3 /= 1 OR EQU4 /= 1 THEN
-           FAILED("ERROR IN THE EQUAL OPERATOR");
-      END IF;
- 
-      IF NEQ1 /= 0 OR NEQ2 /= 1 OR NEQ3 /= 1 OR NEQ4 /= 0 THEN
-           FAILED("ERROR IN THE NOT EQUAL OPERATOR");
-      END IF;
- 
-      RESULT;
- 
- END C49022C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49023a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49023a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49023a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49023a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C49023A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CONSTANT DECLARED BY AN OBJECT DECLARATION CAN BE USED
- -- IN A STATIC EXPRESSION IF THE CONSTANT WAS DECLARED WITH A STATIC
- -- SUBTYPE AND INITIALIZED WITH A STATIC EXPRESSION.
- 
- -- L.BROWN  10/01/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  C49023A  IS
- 
- BEGIN
-      TEST("C49023A","A CONSTANT DECLARED BY AN OBJECT DECLARATION "&
-                     "UNDER CERTAIN CONDITIONS CAN BE USED IN A "&
-                     "STATIC EXPRESSION");
-      DECLARE
-           TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
-           SUBTYPE SENUM IS ENUM RANGE RED .. BLUE;
-           CONEN : CONSTANT SENUM := GREEN;
-           TYPE INT IS RANGE 1 .. 10;
-           SUBTYPE SINT IS INT RANGE 1 .. 5;
-           CONIN : CONSTANT SINT := 3;
-           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
-           SUBTYPE SFLT IS FLT RANGE 10.0 .. 20.0;
-           CONFL : CONSTANT SFLT := 11.0;
-           TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 25.0;
-           SUBTYPE SFIX IS FIX RANGE 0.0 .. 12.0;
-           CONFI : CONSTANT SFIX := 0.25;
-           CAS_EN : ENUM := CONEN;
-           TYPE ITEG IS RANGE 1 .. CONIN;
-           TYPE FLTY IS DIGITS CONIN;
-           TYPE FIXY IS DELTA CONFI RANGE 0.0 .. 10.0;
-           TYPE REAL IS DELTA 0.25 RANGE 0.0 .. 11.0;
-           TYPE FIXTY IS DELTA 0.25 RANGE 0.0 .. CONFL;
- 
-           FUNCTION IDENT_REAL (X : REAL) RETURN REAL;
- 
-           PACKAGE P IS
-                TYPE T IS PRIVATE;
-                CON1 : CONSTANT T;
-           PRIVATE
-                TYPE T IS NEW INTEGER;
-                CON1 : CONSTANT T := 10;
-                TYPE NINT IS RANGE 1 .. CON1;
-           END P;
-           PACKAGE BODY P IS
-                TYPE CON2 IS RANGE CON1 .. 50;
-           BEGIN
-                IF NINT'LAST /= NINT(IDENT_INT(10)) THEN
-                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 1");
-                END IF;
-                IF CON2'FIRST /= CON2(IDENT_INT(10)) THEN
-                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 2");
-                END IF;
-           END P;
- 
-           FUNCTION IDENT_REAL (X : REAL) RETURN REAL IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN X;
-                ELSE
-                     RETURN 0.0;
-                END IF;
-           END IDENT_REAL;
- 
-      BEGIN
- 
-           IF ITEG'LAST /= ITEG(IDENT_INT(3))  THEN
-                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 3");
-           END IF;
- 
-           IF FLTY'DIGITS /= IDENT_INT(3)  THEN
-                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 4");
-           END IF;
- 
-           IF FIXY'DELTA /= IDENT_REAL(0.25)  THEN
-                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 5");
-           END IF;
- 
-           IF FIXTY'LAST /= FIXTY(IDENT_REAL(11.0)) THEN
-                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 6");
-           END IF;
- 
-           CASE CAS_EN IS
-                WHEN CONEN =>
-                     CAS_EN := RED;
-                WHEN OTHERS =>
-                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 7");
-           END CASE;
- 
-      END;
- 
-      RESULT;
- 
- END C49023A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49024a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49024a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49024a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49024a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- C49024A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A FUNCTION CALL CAN APPEAR IN A STATIC EXPRESSION IF THE
- -- FUNCTION NAME DENOTES A PREDEFINED OPERATOR AND HAS THE FORM OF AN
- -- OPERATOR SYMBOL OR AN EXPANDED NAME WHOSE SELECTOR IS AN OPERATOR
- -- SYMBOL.
- 
- -- L.BROWN  10/02/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  C49024A  IS
- 
-      PACKAGE P IS
-           TYPE TY IS NEW INTEGER;
-      END P;
- 
-      CON1 : CONSTANT P.TY := 3;
-      CON2 : CONSTANT P.TY := 4;
-      TYPE INT1 IS RANGE 1 .. P."+"(CON1,CON2);
-      CON3 : CONSTANT := 5;
-      CON4 : CONSTANT := 7;
-      TYPE FLT IS DIGITS "-"(CON4,CON3);
-      TYPE FIX1 IS DELTA 1.0 RANGE 0.0 .. 25.0;
-      CON5 : CONSTANT := 3.0;
-      CON6 : CONSTANT := 6.0;
-      TYPE FIX2 IS DELTA 1.0 RANGE 0.0 .. "/"(CON6,CON5);
-      TYPE ENUM IS (RED,BLUE,GREEN,BLACK);
-      CON7 : CONSTANT BOOLEAN := TRUE;
-      CON8 : CONSTANT ENUM := BLUE;
-      CAS_INT1 : CONSTANT := 10;
-      CAS_INT2 : CONSTANT := 2;
-      OBJ1 : INTEGER := 10;
-      CAS_BOL : BOOLEAN := TRUE;
-      CON9 : CONSTANT ENUM := BLACK;
-      CON10 : CONSTANT FIX1 := 2.0;
-      CON11 : CONSTANT FIX1 := 10.0;
-      TYPE FIX3 IS DELTA "+"(CON10) RANGE 0.0 .. 20.0;
-      TYPE INT2 IS RANGE 0 .. "ABS"("-"(CON4));
-      CON12 : CONSTANT CHARACTER := 'D';
-      CON13 : CONSTANT CHARACTER := 'B';
-      CON14 : CONSTANT BOOLEAN := FALSE;
-      CON15 : CONSTANT := 10;
- 
- BEGIN
- 
-      TEST("C49024A","A FUNCTION CALL CAN BE IN A STATIC EXPRESSION "&
-                     "IF THE FUNCTION NAME DENOTES A PREDEFINED "&
-                     "OPERATOR AND HAS THE FORM OF AN OPERATOR SYMBOL");
- 
-      CASE CAS_BOL IS
-           WHEN ("NOT"(CON7)) =>
-                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
-                       "OPERATORS 1");
-           WHEN ("/="(CON8,CON9)) =>
-                OBJ1 := 2;
-      END CASE;
-      CAS_BOL := TRUE;
- 
-      CASE CAS_BOL IS
-           WHEN ("*"(CON3,CON4) = CAS_INT1) =>
-                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
-                       "OPERATORS 2");
-           WHEN ("ABS"(CON15) = CAS_INT1) =>
-                OBJ1 := 3;
-      END CASE;
-      CAS_BOL := TRUE;
- 
-      CASE CAS_BOL IS
-           WHEN ("<"(CON11,CON10)) =>
-                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
-                       "OPERATORS 3");
-           WHEN ("<="(CON13,CON12)) =>
-                OBJ1 := 4;
-      END CASE;
-      CAS_BOL := TRUE;
- 
-      CASE CAS_BOL IS
-           WHEN ("REM"(CON4,CON3) = CAS_INT2) =>
-                OBJ1 := 5;
-           WHEN ("**"(CON3,CON4) = CAS_INT2) =>
-                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
-                       "OPERATORS 4");
-      END CASE;
- 
-      CASE CAS_BOL IS
-           WHEN (P.">"(CON1,CON2)) =>
-                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
-                       "OPERATORS 5");
-           WHEN ("OR"(CON7,CON14)) =>
-                OBJ1 := 6;
-      END CASE;
-      CAS_BOL := TRUE;
- 
-      CASE CAS_BOL IS
-           WHEN ("MOD"(CON4,CON3) = CAS_INT2) =>
-                OBJ1 := 7;
-           WHEN ("ABS"(CON4) = CAS_INT2) =>
-                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
-                       "OPERATORS 6");
-      END CASE;
- 
-      CASE CAS_BOL IS
-           WHEN ("AND"(CON7,CON14)) =>
-                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
-                       "OPERATORS 7");
-           WHEN (">="(CON12,CON13)) =>
-                OBJ1 := 9;
-      END CASE;
- 
-      RESULT;
- 
- END C49024A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49025a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49025a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49025a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49025a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C49025A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CERTAIN ATTRIBUTES CAN BE USED IN STATIC EXPRESSIONS
- -- SUCH AS: 'SUCC, 'PRED, 'POS, 'VAL, 'AFT, 'DELTA, 'DIGITS, 'FIRST,
- --'FORE, 'LAST, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_MANTISSA, 
- --'MACHINE_OVERFLOWS, 'MACHINE_RADIX, 'MACHINE_ROUNDS, 'SIZE, 'SMALL, 'WIDTH.
- 
- -- L.BROWN  10/07/86
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C49025A  IS
- 
-      TYPE ENUM IS (RED,BLUE,GREEN,BLACK);
-      TYPE FIX IS DELTA 0.125 RANGE 0.0 .. 20.0;
-      TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
-      TYPE INT IS RANGE 1 .. 100;
-      TYPE TINT1 IS RANGE 1 .. ENUM'POS(BLUE);
-      TYPE TFLT IS DIGITS FIX'AFT RANGE 0.0 .. 10.0;
-      TYPE TFIX2 IS DELTA FIX'DELTA RANGE 0.0 .. 5.0;
-      TYPE TFLT1 IS DIGITS FLT'DIGITS;
-      TYPE ITN IS RANGE 0 .. INT'FIRST;
-      TYPE TINT2 IS RANGE 1 .. FIX'FORE;
-      TYPE TFLT3 IS DIGITS 3 RANGE 5.0 .. FLT'LAST;
-      CON3 : CONSTANT := FLT'MACHINE_EMAX;
-      TYPE TINT3 IS RANGE FLT'MACHINE_EMIN .. 1;
-      CON4 : CONSTANT := FLT'MACHINE_MANTISSA;
-      TYPE TINT4 IS RANGE 1 .. FLT'MACHINE_RADIX;
-      CON6 : CONSTANT := INT'SIZE;
-      TYPE TFIX5 IS DELTA 0.125 RANGE 0.0 .. FIX'SMALL;
-      TYPE TINT6 IS RANGE 1 .. ENUM'WIDTH;
-      OBJ1 : INTEGER := 1;
-      CAS_OBJ : BOOLEAN := TRUE;
- 
- BEGIN
- 
-      TEST("C49025A","CHECK THAT CERTAIN ATTRIBUTES CAN "&
-                     "BE USED IN STATIC EXPRESSIONS.");
- 
-      CASE CAS_OBJ IS
-           WHEN (ENUM'PRED(BLUE) = ENUM'(RED)) =>
-                OBJ1 := 2;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 1");
-      END CASE;
-      CAS_OBJ := TRUE;
- 
-      CASE CAS_OBJ IS
-           WHEN (ENUM'SUCC(RED) = ENUM'(BLUE)) =>
-                OBJ1 := 3;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 2");
-      END CASE;
-      CAS_OBJ := TRUE;
- 
-      CASE CAS_OBJ IS
-           WHEN (ENUM'VAL(3) = ENUM'(BLACK)) =>
-                OBJ1 := 4;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 3");
-      END CASE;
-      CAS_OBJ := TRUE;
- 
-      CASE CAS_OBJ IS
-           WHEN (TRUE OR FLT'MACHINE_OVERFLOWS) =>
-                OBJ1 := 5;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 4");
-      END CASE;
-      CAS_OBJ := FALSE;
- 
-      CASE CAS_OBJ IS
-           WHEN (FALSE AND FIX'MACHINE_ROUNDS) =>
-                OBJ1 := 6;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 5");
-      END CASE;
- 
-      RESULT;
- 
- END C49025A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49026a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49026a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c49026a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c49026a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- C49026A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A QUALIFIED EXPRESSION CAN APPEAR IN A STATIC EXPRESSION.
- 
- -- L.BROWN  10/07/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  C49026A  IS
- 
-      TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
-      TYPE INT1 IS RANGE 1 .. 50;
-      TYPE FLT1 IS DIGITS 3 RANGE 1.0 .. 5.0;
-      TYPE FIX1 IS DELTA 0.125 RANGE 0.0 .. 10.0;
-      TYPE INT2 IS RANGE 1 .. INT1'(25);
-      TYPE FLT2 IS DIGITS 3 RANGE 1.0 .. FLT1'(2.0);
-      TYPE FIX2 IS DELTA 0.125 RANGE 0.0 .. FIX1'(5.0);
-      TYPE FLT3 IS DIGITS INT1'(3);
-      TYPE FIX3 IS DELTA FIX1'(0.125) RANGE 0.0 .. 5.0;
-      OBJ1 : INTEGER := 2;
-      CAS_OBJ : ENUM := GREEN;
- 
- BEGIN
- 
-      TEST("C49026A","QUALIFIED EXPRESSIONS CAN APPEAR IN STATIC "&
-                     "EXPRESSIONS");
- 
-      CASE CAS_OBJ IS
-           WHEN ENUM'(GREEN) =>
-                OBJ1 := 3;
-           WHEN OTHERS =>
-                FAILED("INCORRECT VALUE FOR QUALIFIED EXPRESSION 1");
-      END CASE;
- 
-      RESULT;
- 
- END C49026A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C4A005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A NONSTATIC UNIVERSAL INTEGER EXPRESSION RAISES
- -- CONSTRAINT_ERROR IF DIVISION BY ZERO IS ATTEMPTED
- -- OR IF THE SECOND OPERAND OF REM OR MOD IS ZERO.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- JBG 5/2/85
- -- EG  10/24/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387; PREVENT DEAD VARIABLE OPTIMIZATION
- -- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C4A005B IS
- BEGIN
-      TEST("C4A005B", "CHECK CONSTRAINT_ERROR FOR " &
-                      "NONSTATIC UNIVERSAL " &
-                      "INTEGER EXPRESSIONS - DIVISION BY ZERO");
-      BEGIN
-           DECLARE
-                X : BOOLEAN := 1 = 1/INTEGER'POS(IDENT_INT(0));
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - DIV");
-                IF X /= IDENT_BOOL(X) THEN
-                     FAILED ("WRONG RESULT - DIV");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION IN WRONG PLACE - DIV");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED FOR / BY 0");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - DIV");
-      END;
- 
-      BEGIN
-           DECLARE
-                X : BOOLEAN := 1 = 1 REM INTEGER'POS(IDENT_INT(0));
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - REM");
-                IF X /= IDENT_BOOL(X) THEN
-                     FAILED ("WRONG RESULT - REM");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION IN WRONG PLACE - REM");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED FOR REM BY 0");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - REM");
-      END;
- 
-      BEGIN
-           DECLARE
-                X : BOOLEAN := 1 = INTEGER'POS(IDENT_INT(1)) MOD 0;
-           BEGIN
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - MOD");
-                IF X /= IDENT_BOOL(X) THEN
-                     FAILED ("WRONG RESULT - MOD");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION IN WRONG PLACE - MOD");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED FOR MOD BY 0");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - MOD");
-      END;
- 
-      RESULT;
- 
- END C4A005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- C4A006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A UNIVERSAL_INTEGER 
- -- EXPRESSION CONTAINING AN EXPONENTIATION OPERATOR IF THE EXPONENT
- -- HAS A NEGATIVE VALUE.
- 
- -- BAW 9/29/80
- -- SPS 4/7/82
- -- TBN 10/23/85     RENAMED FROM B4A006A-B.ADA. REVISED TO CHECK FOR
- --                  CONSTRAINT_ERROR WHEN EXPONENT IS NEGATIVE IN
- --                  A NONSTATIC CONTEXT.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C4A006A IS
- 
- BEGIN 
-      TEST ("C4A006A", "CHECK THAT A NEGATIVE EXPONENT IN " &
-                       "UNIVERSAL_INTEGER EXPONENTIATION RAISES " &
-                       "CONSTRAINT_ERROR");
- 
-      DECLARE
-           B : BOOLEAN;
-      BEGIN
- 
-           B := (1 ** IDENT_INT(-1)) = 1;
-           FAILED ("EXCEPTION NOT RAISED");
-           IF NOT B THEN
-                FAILED ("(1 ** (-1)) /= 1");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;     
- 
-      RESULT;
- END C4A006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a007a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a007a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a007a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a007a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,47 ****
- -- C4A007A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- USE OF MAX_INT IN NUMBER DECLARATION
- 
- -- BAW 29 SEPT 80
- 
- WITH REPORT;
- PROCEDURE C4A007A IS
- 
-      USE REPORT;
- 
-      X : CONSTANT := $MAX_INT - ($MAX_INT MOD 2);
-      Y : CONSTANT := ($MAX_INT / 2) * 2;
- 
- BEGIN TEST("C4A007A","USING THE INTEGER VALUE  MAX_INT IN NUMBER " &
-            " DECLARATIONS ");
- 
-       IF X /= Y
-       THEN FAILED("USING THE INTEGER VALUE MAX_INT GIVES " &
-                   " GIVES WRONG RESULTS ");
-       END IF;
- 
-       RESULT;
- 
- END C4A007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C4A010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT STATIC UNIVERSAL_REAL EXPRESSIONS ARE EVALUATED EXACTLY.
- 
- -- SMALL RATIONAL NUMBERS ARE USED IN THIS TEST.
- 
- -- JBG 5/3/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C4A010A IS
- 
-      C13 : CONSTANT := 1.0/3.0;
-      C47 : CONSTANT := 4.0/7.0;
-      C112: CONSTANT := 13.0/12.0;
-      HALF: CONSTANT := 3.5/7.0;
- 
- BEGIN
- 
-      TEST ("C4A010A", "CHECK STATIC UNIVERSAL_REAL ACCURACY FOR " &
-                       "SMALL RATIONAL NUMBERS");
- 
-      IF C13 - C47 /= -5.0/21.0 THEN
-           FAILED ("REAL SUBTRACTION RESULT INCORRECT");
-      END IF;
- 
-      IF C47 + C112 = 1.0 + 55.0/84.0 THEN
-           NULL;
-      ELSE
-           FAILED ("REAL ADDITION RESULT INCORRECT");
-      END IF;
- 
-      IF C112 - C13 /= 6.0/8.0 THEN
-           FAILED ("LCD NOT FOUND");
-      END IF;
- 
-      IF 0.1 * 0.1 /= 0.01 THEN
-           FAILED ("REAL MULTIPLICATION RESULT INCORRECT");
-      END IF;
- 
-      IF C112/C13 /= 13.0/4 THEN
-           FAILED ("REAL QUOTIENT RESULT INCORRECT");
-      END IF;
- 
-      IF 0.1 ** 4 /= 0.0001 THEN
-           FAILED ("POSITIVE EXPONENTIATION RESULT INCORRECT");
-      END IF;
- 
-      IF C13 ** (-3) /= 27.0 * 0.5 * 2 THEN
-           FAILED ("NEGATIVE EXPONENTIATION RESULT INCORRECT");
-      END IF;
- 
-      IF HALF /= 0.1/0.2 THEN
-           FAILED ("FRACTIONAL NUMERATOR AND DENOMINATOR");
-      END IF;
- 
-      RESULT;
- 
- END C4A010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a010b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a010b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a010b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a010b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C4A010B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT STATIC UNIVERSAL REAL EXPRESSIONS ARE EVALUATED 
- -- EXACTLY.  IN PARTICULAR, CHECK THAT THE CASCADING USE OF FRACTIONAL
- -- VALUES DOES NOT RESULT IN THE LOSS OF PRECISION.
- 
- -- RJW 7/31/86
- 
- WITH REPORT; USE REPORT; 
- PROCEDURE C4A010B IS
- 
- 
- BEGIN
- 
-      TEST( "C4A010B", "CHECK THAT STATIC UNIVERSAL REAL EXPRESSIONS " &
-                       "ARE EVALUATED EXACTLY.  IN PARTICULAR, CHECK " &
-                       "THAT THE CASCADING USE OF FRACTIONAL VALUES " &
-                       "DOES NOT RESULT IN THE LOSS OF PRECISION" );
- 
-      DECLARE
-           B : CONSTANT := 2.0/3.0;
-           
-           X0 : CONSTANT := 1.0;
-           X1 : CONSTANT := X0 + B;
-           X2 : CONSTANT := X1 + B ** 2;
-           X3 : CONSTANT := X2 + B ** 3;
-           X4 : CONSTANT := X3 + B ** 4;
-           X5 : CONSTANT := X4 + B ** 5;
-           X6 : CONSTANT := X5 + B ** 6;
-           X7 : CONSTANT := X6 + B ** 7;
-           X8 : CONSTANT := X7 + B ** 8;
-           X9 : CONSTANT := X8 + B ** 9;
-      
-           Y1 : CONSTANT := B ** 10;
-           Y2 : CONSTANT := 1.0;
-           Y3 : CONSTANT := Y1 - Y2;
-           Y4 : CONSTANT := B;
-           Y5 : CONSTANT := Y4 - Y2;
-           Y6 : CONSTANT := Y3 / Y5;
- 
-      BEGIN
-           IF X9 /= 58025.0/19683.0 THEN
-                FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
-                         "NUMBERS  - 1" );
-           END IF;
-           
-           IF Y6 /= 58025.0/19683.0 THEN
-                FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
-                         "NUMBERS  - 2" );
-           END IF;
-           
-           IF X9 /= Y6 THEN
-                FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
-                         "NUMBERS  - 3" );
-           END IF;
-           
-      END;   
-      
-      RESULT;
- END C4A010B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,334 ****
- -- C4A011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NONSTATIC UNIVERSAL REAL EXPRESSIONS ARE EVALUATED WITH
- -- THE ACCURACY OF THE MOST PRECISE PREDEFINED FLOATING POINT TYPE
- -- (I. E., THE TYPE FOR WHICH 'DIGITS EQUALS SYSTEM.MAX_DIGITS).
- 
- -- RJW 8/4/86
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C4A011A IS
- 
-      TYPE MAX_FLOAT IS DIGITS MAX_DIGITS;
- 
-      C5L : CONSTANT := 16#0.AAAA8#;
-      C5U : CONSTANT := 16#0.AAAAC#;
- 
-      C6L : CONSTANT := 16#0.AAAAA8#;
-      C6U : CONSTANT := 16#0.AAAAB0#;
- 
-      C7L : CONSTANT := 16#0.AAAAAA8#;
-      C7U : CONSTANT := 16#0.AAAAAB0#;
- 
-      C8L : CONSTANT := 16#0.AAAAAAA#;
-      C8U : CONSTANT := 16#0.AAAAAAB#;
- 
-      C9L : CONSTANT := 16#0.AAAAAAAA#;
-      C9U : CONSTANT := 16#0.AAAAAAAC#;
- 
-      C10L : CONSTANT := 16#0.AAAAAAAAA#;
-      C10U : CONSTANT := 16#0.AAAAAAAAC#;
- 
-      C11L : CONSTANT := 16#0.AAAAAAAAA8#;
-      C11U : CONSTANT := 16#0.AAAAAAAAAC#;
- 
-      C12L : CONSTANT := 16#0.AAAAAAAAAA8#;
-      C12U : CONSTANT := 16#0.AAAAAAAAAB0#;
- 
-      C13L : CONSTANT := 16#0.AAAAAAAAAAA8#;
-      C13U : CONSTANT := 16#0.AAAAAAAAAAB0#;
- 
-      C14L : CONSTANT := 16#0.AAAAAAAAAAAA#;
-      C14U : CONSTANT := 16#0.AAAAAAAAAAAB#;
- 
-      C15L : CONSTANT := 16#0.AAAAAAAAAAAAA#;
-      C15U : CONSTANT := 16#0.AAAAAAAAAAAAC#;
- 
-      C16L : CONSTANT := 16#0.AAAAAAAAAAAAAA#;
-      C16U : CONSTANT := 16#0.AAAAAAAAAAAAAC#;
- 
-      C17L : CONSTANT := 16#0.AAAAAAAAAAAAAA8#;
-      C17U : CONSTANT := 16#0.AAAAAAAAAAAAAAC#;
- 
-      C18L : CONSTANT := 16#0.AAAAAAAAAAAAAAA8#;
-      C18U : CONSTANT := 16#0.AAAAAAAAAAAAAAB0#;
- 
-      C19L : CONSTANT := 16#0.AAAAAAAAAAAAAAAA8#;
-      C19U : CONSTANT := 16#0.AAAAAAAAAAAAAAAB0#;
- 
-      C20L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAA#;
-      C20U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAB#;
- 
-      C21L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAA#;
-      C21U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAC#;
- 
-      C22L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAA#;
-      C22U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAC#;
- 
-      C23L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAA8#;
-      C23U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAC#;
- 
-      C24L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAA8#;
-      C24U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAB0#;
- 
-      C25L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAA8#;
-      C25U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAB0#;
- 
-      C26L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAA#;
-      C26U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAB#;
- 
-      C27L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAA#;
-      C27U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAC#;
- 
-      C28L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAA#;
-      C28U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAC#;
- 
-      C29L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAA8#;
-      C29U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAC#;
- 
-      C30L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAA8#;
-      C30U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAB0#;
- 
-      C31L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAA#;
-      C31U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAB#;
- 
-      C32L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAA#;
-      C32U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAB#;
- 
-      C33L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAA#;
-      C33U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
- 
-      C34L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAA8#;
-      C34U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
- 
-      C35L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAA8#;
-      C35U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
- 
- BEGIN
- 
-      TEST ( "C4A011A", "CHECK THAT NONSTATIC UNIVERSAL REAL " & 
-                        "EXPRESSIONS ARE EVALUATED WITH THE " &
-                        "ACCURACY OF THE MOST PRECISE PREDEFINED " &
-                        "FLOATING POINT TYPE (I. E., THE TYPE FOR " &
-                        "WHICH 'DIGITS EQUALS SYSTEM.MAX_DIGITS" );
- 
-      CASE MAX_DIGITS IS
-           WHEN 5 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C5L ..  C5U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 5" );
-                END IF;
-           WHEN 6 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C6L ..  C6U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 6" );
-                END IF;
-           WHEN 7 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C7L ..  C7U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 7" );
-                END IF;
-           WHEN 8 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C8L ..  C8U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 8" );
-                END IF;
-           WHEN 9 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C9L ..  C9U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 9" );
-                END IF;
-           WHEN 10 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C10L ..  C10U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 10" );
-                END IF;
-           WHEN 11 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C11L ..  C11U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 11" );
-                END IF;
-           WHEN 12 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C12L ..  C12U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 12" );
-                END IF;
-           WHEN 13 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C13L ..  C13U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 13" );
-                END IF;
-           WHEN 14 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C14L ..  C14U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 14" );
-                END IF;
-           WHEN 15 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C15L ..  C15U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 15" );
-                END IF;
-           WHEN 16 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C16L ..  C16U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 16" );
-                END IF;
-           WHEN 17 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C17L ..  C17U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 17" );
-                END IF;
-           WHEN 18 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C18L ..  C18U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 18" );
-                END IF;
-           WHEN 19 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C19L ..  C19U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 19" );
-                END IF;
-           WHEN 20 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C20L ..  C20U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 20" );
-                END IF;
-           WHEN 21 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C21L ..  C21U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 21" );
-                END IF;
-           WHEN 22 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C22L ..  C22U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 22" );
-                END IF;
-           WHEN 23 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C23L ..  C23U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 23" );
-                END IF;
-           WHEN 24 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C24L ..  C24U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 24" );
-                END IF;
-           WHEN 25 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C25L ..  C25U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 25" );
-                END IF;
-           WHEN 26 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C26L ..  C26U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 26" );
-                END IF;
-           WHEN 27 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C27L ..  C27U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 27" );
-                END IF;
-           WHEN 28 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C28L ..  C28U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 28" );
-                END IF;
-           WHEN 29 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C29L ..  C29U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 29" );
-                END IF;
-           WHEN 30 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C30L ..  C30U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 30" );
-                END IF;
-           WHEN 31 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C31L ..  C31U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 31" );
-                END IF;
-           WHEN 32 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C32L ..  C32U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 32" );
-                END IF;
-           WHEN 33 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C33L ..  C33U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 33" );
-                END IF;
-           WHEN 34 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C34L ..  C34U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 34" );
-                END IF;
-           WHEN 35 =>
-                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
-                   C35L ..  C35U THEN
-                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
-                              "VALUE OF 35" );
-                END IF;
-           WHEN OTHERS =>
-                NOT_APPLICABLE ( "MAX_DIGITS OUT OF RANGE OF TEST.  " &
-                                 "MAX_DIGITS = " & 
-                                  INTEGER'IMAGE (MAX_DIGITS));
-      END CASE;
- 
-      RESULT;
- 
- END C4A011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a012b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a012b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a012b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a012b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- C4A012B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR
- --     A UNIVERSAL_REAL EXPRESSION IF DIVISION BY ZERO IS ATTEMPTED.
- 
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR
- --     0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT VALUE).
- 
- -- HISTORY:
- --     RJW 09/04/86  CREATED ORIGINAL TEST.
- --     CJJ 09/04/87  ADDED PASS MESSAGE FOR RAISING NUMERIC_ERROR;
- --                   MODIFIED CODE TO PREVENT COMPILER OPTIMIZING
- --                   OUT THE TEST.
- --     JET 12/31/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
- --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- --     JRL 02/29/96  Added code to check for value of Machine_Overflows; if
- --                   False, test is inapplicable.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C4A012B IS
- 
-      F : FLOAT;
- 
-      I3 : INTEGER := -3;
- 
-      SUBTYPE SINT IS INTEGER RANGE -10 .. 10;
-      SI5 : CONSTANT SINT := -5;
- 
-      FUNCTION IDENT (X:FLOAT) RETURN FLOAT IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN X;
-           ELSE
-                RETURN 1.0;
-           END IF;
-      END IDENT;
- 
- BEGIN
- 
-      TEST ( "C4A012B", "CHECK THAT CONSTRAINT_ERROR " &
-                        "IS RAISED FOR " &
-                        "0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT " &
-                        "VALUE)" );
- 
-      IF FLOAT'MACHINE_OVERFLOWS = FALSE THEN
-         REPORT.NOT_APPLICABLE ("Float'Machine_Overflows = False");
-      ELSE
- 
-         BEGIN
-              F := IDENT (0.0) ** (-1);
-              FAILED ( "THE EXPRESSION '0.0 ** (-1)' DID NOT RAISE " &
-                       "AN EXCEPTION" );
-              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
-                   COMMENT ("SHOULDN'T BE HERE!");
-              END IF;
-         EXCEPTION
-              WHEN CONSTRAINT_ERROR =>
-                   COMMENT ("CONSTRAINT_ERROR RAISED - 1");
-              WHEN OTHERS =>
-                   FAILED ( "THE EXPRESSION '0.0 ** (-1)' RAISED THE " &
-                            "WRONG EXCEPTION" );
-         END;
- 
-         BEGIN
-              F := 0.0 ** (IDENT_INT (-1));
-              FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' DID " &
-                        "NOT RAISE AN EXCEPTION" );
-              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
-                   COMMENT ("SHOULDN'T BE HERE!");
-              END IF;
-         EXCEPTION
-              WHEN CONSTRAINT_ERROR =>
-                   COMMENT ("CONSTRAINT_ERROR RAISED - 2");
-              WHEN OTHERS =>
-                   FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' " &
-                            "RAISED THE WRONG EXCEPTION" );
-         END;
- 
-         BEGIN
-              F := 0.0 ** (INTEGER'POS (IDENT_INT (-1)));
-              FAILED ( "THE EXPRESSION '0.0 ** " &
-                       "(INTEGER'POS (IDENT_INT (-1)))' DID " &
-                       "NOT RAISE AN EXCEPTION" );
-              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
-                   COMMENT ("SHOULDN'T BE HERE!");
-              END IF;
-         EXCEPTION
-              WHEN CONSTRAINT_ERROR =>
-                   COMMENT ("CONSTRAINT_ERROR RAISED - 3");
-              WHEN OTHERS =>
-                   FAILED ( "THE EXPRESSION '0.0 ** " &
-                            "(INTEGER'POS (IDENT_INT (-1)))' RAISED " &
-                            "THE WRONG EXCEPTION" );
-         END;
- 
-         BEGIN
-              F := IDENT(0.0) ** I3;
-              FAILED ( "THE EXPRESSION '0.0 ** I3' DID NOT RAISE " &
-                        "AN EXCEPTION" );
-              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
-                   COMMENT ("SHOULDN'T BE HERE!");
-              END IF;
-         EXCEPTION
-              WHEN CONSTRAINT_ERROR =>
-                   COMMENT ("CONSTRAINT_ERROR RAISED - 4");
-              WHEN OTHERS =>
-                   FAILED ( "THE EXPRESSION '0.0 ** I3' RAISED THE " &
-                            "WRONG EXCEPTION" );
-         END;
- 
-         BEGIN
-              F := 0.0 ** (IDENT_INT (I3));
-              FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' DID " &
-                       "NOT RAISE AN EXCEPTION" );
-              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
-                   COMMENT ("SHOULDN'T BE HERE!");
-              END IF;
-         EXCEPTION
-              WHEN CONSTRAINT_ERROR =>
-                   COMMENT ("CONSTRAINT_ERROR RAISED - 5");
-              WHEN OTHERS =>
-                   FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' " &
-                             "RAISED THE WRONG EXCEPTION" );
-         END;
- 
-         BEGIN
-              F := IDENT (0.0) ** SI5;
-              FAILED ( "THE EXPRESSION '0.0 ** SI5' DID NOT RAISE " &
-                        "AN EXCEPTION" );
-              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
-                   COMMENT ("SHOULDN'T BE HERE!");
-              END IF;
-         EXCEPTION
-              WHEN CONSTRAINT_ERROR =>
-                   COMMENT ("CONSTRAINT_ERROR RAISED - 6");
-              WHEN OTHERS =>
-                   FAILED ( "THE EXPRESSION '0.0 ** SI5' RAISED THE " &
-                            "WRONG EXCEPTION" );
-         END;
- 
-         BEGIN
-              F := 0.0 ** (IDENT_INT (SI5));
-              FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' DID " &
-                       "NOT RAISE AN EXCEPTION" );
-              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
-                   COMMENT ("SHOULDN'T BE HERE!");
-              END IF;
-         EXCEPTION
-              WHEN CONSTRAINT_ERROR =>
-                   COMMENT ("CONSTRAINT_ERROR RAISED - 7");
-              WHEN OTHERS =>
-                   FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' " &
-                             "RAISED THE WRONG EXCEPTION" );
-         END;
- 
-      END IF;
- 
-      RESULT;
- 
- END C4A012B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a013a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a013a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a013a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C4A013A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A NONSTATIC
- -- UNIVERSAL_REAL EXPRESSION IF THE VALUE WOULD LIE OUTSIDE THE RANGE OF
- -- THE BASE TYPE OF THE MOST ACCURATE PREDEFINED FLOATING POINT TYPE AND
- -- MACHINE_OVERFLOWS IS TRUE FOR THAT TYPE.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- BAW 29 SEPT 80
- -- TBN 10/30/85     RENAMED FROM C4A013A.ADA.
- -- JRK 1/13/86      COMPLETELY REVISED TO CHECK NONSTATIC UNIVERSAL_REAL
- --                  EXPRESSIONS WHOSE RESULTS OVERFLOW.  REVISED
- --                  NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --                  AI-00387.
- -- MRM 03/30/93     REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH SYSTEM, REPORT;
- USE SYSTEM, REPORT;
- 
- PROCEDURE C4A013A IS
- 
-      TYPE F IS DIGITS MAX_DIGITS;
- 
-      B : BOOLEAN;
- 
- BEGIN
-      TEST ("C4A013A", "CHECK NONSTATIC UNIVERSAL_REAL EXPRESSIONS " &
-                       "WHOSE RESULTS OVERFLOW");
- 
-      BEGIN
-           B := 1.0 < 1.0 / (1.0 * INTEGER'POS (IDENT_INT (0)));
- 
-           IF F'MACHINE_OVERFLOWS THEN
-                FAILED ("MACHINE_OVERFLOWS IS TRUE, BUT NO EXCEPTION " &
-                        "WAS RAISED");
-           ELSE COMMENT ("MACHINE_OVERFLOWS IS FALSE AND NO EXCEPTION " &
-                         "WAS RAISED");
-           END IF;
- 
-           IF NOT B THEN  -- USE B TO PREVENT DEAD VARIABLE OPTIMIZATION.
-                COMMENT ("1.0 < 1.0 / 0.0 YIELDS FALSE");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END C4A013A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a014a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c4/c4a014a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c4/c4a014a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C4A014A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ROUNDING IS DONE CORRECTLY FOR STATIC UNIVERSAL REAL
- -- EXPRESSIONS.
- 
- -- JBG 5/3/85
- -- JBG 11/3/85   DECLARE INTEGER CONSTANTS INSTEAD OF UNIVERSAL INTEGER
- -- DTN 11/27/91  DELETED SUBPART (B).
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C4A014A IS
- 
-      C15  : CONSTANT := 1.5;
-      C25  : CONSTANT := 2.5;
-      CN15 : CONSTANT := -1.5;
-      CN25 : CONSTANT := -2.5;
- 
-      C15R  : CONSTANT INTEGER := INTEGER(C15);
-      C25R  : CONSTANT INTEGER := INTEGER(C25);
-      CN15R : CONSTANT INTEGER := INTEGER(CN15);
-      CN25R : CONSTANT INTEGER := INTEGER(CN25);
- 
-      C15_1   : BOOLEAN := 1 = C15R;
-      C15_2   : BOOLEAN := 2 = C15R;
-      C25_2   : BOOLEAN := 2 = C25R;
-      C25_3   : BOOLEAN := 3 = C25R;
- 
-      CN15_N1 : BOOLEAN := -1 = CN15R;
-      CN15_N2 : BOOLEAN := -2 = CN15R;
-      CN25_N2 : BOOLEAN := -2 = CN25R;
-      CN25_N3 : BOOLEAN := -3 = CN25R;
- 
- BEGIN
- 
-      TEST ("C4A014A", "CHECK ROUNDING TO INTEGER FOR UNIVERSAL REAL " &
-                       "EXPRESSIONS");
- 
-      IF 1 /= INTEGER(1.4) THEN
-           FAILED ("INTEGER(1.4) DOES NOT EQUAL 1");
-      END IF;
- 
-      IF 2 /= INTEGER(1.6) THEN
-           FAILED ("INTEGER(1.6) DOES NOT EQUAL 2");
-      END IF;
- 
-      IF -1 /= INTEGER(-1.4) THEN
-           FAILED ("INTEGER(-1.4) DOES NOT EQUAL -1");
-      END IF;
- 
-      IF -2 /= INTEGER(-1.6) THEN
-           FAILED ("INTEGER(-1.6) DOES NOT EQUAL -2");
-      END IF;
- 
-      IF NOT (C15_1 OR C15_2) OR (NOT (C25_2 OR C25_3)) THEN
-           FAILED ("ROUNDING OF POSITIVE VALUES NOT CORRECT");
-      END IF;
- 
-      IF NOT (CN15_N1 OR CN15_N2) OR (NOT (CN25_N2 OR CN25_N3)) THEN
-           FAILED ("ROUNDING OF NEGATIVE VALUES NOT CORRECT");
-      END IF;
- 
-      RESULT;
- 
- END C4A014A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c51004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c51004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c51004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c51004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,261 ****
- -- C51004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LABELS, LOOP IDENTIFIERS, AND BLOCK IDENTIFIERS ARE
- -- IMPLICITLY DECLARED AT THE END OF THE DECLARATIVE PART.  PRIOR TO
- -- THE END OF THE DECLARATIVE PART, THEY MAY BE USED TO REFERENCE
- -- ENTITIES IN AN ENCLOSING SCOPE.  SUBTESTS ARE:
- --        (A) BLOCK.
- --        (B) PROCEDURE BODY.
- --        (C) PACKAGE BODY.
- --        (D) GENERIC FUNCTION BODY.
- --        (E) GENERIC PACKAGE BODY.
- --        (F) TASK BODY.
- 
- -- CPP  6/1/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C51004A IS
- 
- BEGIN
-      TEST("C51004A", "CHECK THAT LABELS, LOOP IDENTIFIERS, AND BLOCK " &
-           "IDENTIFIERS MAY BE USED PRIOR TO THEIR IMPLICIT " &
-           "DECLARATION");
- 
- OUTER: DECLARE
- 
-           TYPE IDN1 IS NEW INTEGER;
-           IDN2 : CONSTANT INTEGER := 2;
-           TYPE IDN3 IS ACCESS INTEGER;
- 
-      BEGIN     -- OUTER
- 
-      -----------------------------------------------
- 
-      A :  DECLARE
- 
-                A1 : IDN1;
-                A2 : CONSTANT INTEGER := IDN2;
-                A3 : IDN3;
- 
-                TEMP : INTEGER;
- 
-           BEGIN     -- A
- 
-            <<IDN1>> TEMP := 0;
- 
-              IDN2 : FOR I IN 1..1 LOOP
-                          TEMP := A2;
-                     END LOOP IDN2;
- 
-              IDN3 : BEGIN
-                          NULL;
-                     END IDN3;
- 
-           END A;
- 
-      -----------------------------------------------
- 
-      B :  DECLARE
- 
-                PROCEDURE P (TEMP : OUT INTEGER) IS
- 
-                     B1 : IDN1;
-                     B2 : CONSTANT INTEGER := IDN2 + 2;
-                     B3 : IDN3;
- 
-                BEGIN     -- P
-                
-           <<L>> <<IDN1>> TEMP := 0;
- 
-                   IDN2 : WHILE B2 < 0 LOOP
-                               TEMP := 0;
-                          END LOOP IDN2;
- 
-                   IDN3 : DECLARE
-                          BEGIN
-                               NULL;
-                          END IDN3;
- 
-                END P;
- 
-           BEGIN     -- B
-                NULL;
-           END B;
- 
-      -----------------------------------------------
- 
-      C :  DECLARE
- 
-                PACKAGE PKG IS
-                END PKG;
- 
-                PACKAGE BODY PKG IS
- 
-                     C1 : IDN1;
-                     C2 : CONSTANT INTEGER := 2 * IDN2;
-                     C3 : IDN3;
- 
-                     TEMP : INTEGER;
- 
-                BEGIN
- 
-                 <<IDN1>> TEMP := 0;
- 
-                   IDN2 : LOOP
-                               TEMP := 0;
-                               EXIT;          
-                          END LOOP IDN2;
- 
-                   IDN3 : BEGIN
-                               NULL;
-                          END IDN3;
- 
-                END PKG;
- 
-           BEGIN     -- C
-                NULL;
-           END C;
- 
-      ---------------------------------------------------
- 
-      D :  DECLARE
- 
-                GENERIC
-                     TYPE Q IS (<>);
-                FUNCTION FN RETURN INTEGER;
- 
-                FUNCTION FN RETURN INTEGER IS
- 
-                     D1 : IDN1;
-                     D2 : CONSTANT INTEGER := IDN2;
-                     D3 : IDN3;
- 
-                     TEMP : INTEGER;
- 
-                BEGIN     
- 
-                 <<IDN1>> TEMP := 0;
- 
-                   IDN2 : FOR I IN 1..5 LOOP
-                               TEMP := 0;
-                          END LOOP IDN2;
- 
-                   IDN3 : BEGIN
-                               NULL;
-                          END IDN3;  
-                     
-                          RETURN TEMP;
- 
-                END FN;
- 
-           BEGIN
-                NULL;
-           END D;
- 
-      -----------------------------------------------
- 
-      E :  DECLARE
- 
-                GENERIC
- 
-                     TYPE ELEMENT IS (<>);
-                     ITEM : ELEMENT;
- 
-                PACKAGE PKG IS
-                END PKG;
- 
-                PACKAGE BODY PKG IS
- 
-                     E1 : IDN1 RANGE 1..5;
-                     E2 : CONSTANT INTEGER := IDN2;
-                     E3 : IDN3;
- 
-                     TEMP : ELEMENT;
- 
-                BEGIN
- 
-           <<IDN1>> <<L>> TEMP := ITEM;
- 
-                   IDN2 : WHILE TEMP /= ITEM LOOP
-                               TEMP := ITEM;
-                          END LOOP IDN2;
- 
-                   IDN3 : DECLARE
-                          BEGIN
-                               NULL;
-                          END IDN3;
- 
-                END PKG;
-           
-           BEGIN     -- E
- 
-                DECLARE
-                     PACKAGE P1 IS NEW PKG (INTEGER, 0);
-                BEGIN
-                     NULL;
-                END;
-                
-           END E;
- 
-      -----------------------------------------------
- 
-      F :  DECLARE
- 
-                TASK T;
- 
-                TASK BODY T IS
- 
-                     F1 : IDN1 RANGE -4..2;
-                     F2 : CONSTANT INTEGER := IDN2;
-                     F3 : IDN3;
- 
-                     TEMP : INTEGER;
- 
-                BEGIN
- 
-                 <<IDN1>> TEMP := 1;
- 
-                   IDN2 : LOOP
-                               TEMP := TEMP + 1;
-                               EXIT;
-                          END LOOP IDN2;
- 
-                   IDN3 : DECLARE
-                          BEGIN
-                               TEMP := TEMP + 1;
-                          END IDN3;
- 
-                END T;
- 
-           BEGIN     -- F
-                NULL;
-           END F;
- 
-      -----------------------------------------------
- 
-      END OUTER;
- 
-      RESULT;
- END C51004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,177 ****
- -- C52005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED WHEN A STATIC
- --    EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE OF INTEGER, BOOLEAN,
- --    CHARACTER, AND ENUMERATION ASSIGNMENT TARGET VARIABLES.
- 
- -- DCB 2/5/80
- -- JRK 7/21/80
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52005A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C52005A", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED "
-          & "ON STATIC OUT OF RANGE INTEGER, BOOLEAN, CHARACTER, " &
-            "AND ENUMERATION ASSIGNMENTS");
- 
- -------------------------
- 
-      DECLARE
-           I1 : INTEGER RANGE 0..10 := 5;
- 
-      BEGIN
-           I1 := 11;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE INT ASSNMT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF I1 /= 5 THEN
-                FAILED ("VALUE ALTERED BEFORE INT RANGE" &
-                        "EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           I2 : INTEGER RANGE 0..10 := 5;
- 
-      BEGIN
-           I2 := 10;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL INTEGER ASSIGNMENT");
-      END;
- 
- -------------------------
- 
-      DECLARE
-           B1 : BOOLEAN RANGE TRUE..TRUE := TRUE;
- 
-      BEGIN
-           B1 := FALSE;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE BOOL ASSNMT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF B1 /= TRUE THEN
-                FAILED ("VALUE ALTERED BEFORE BOOLEAN RANGE EXCEPTION");
-           END IF;
-      END;
- 
- -------------------------
- 
-      DECLARE
-           B2 : BOOLEAN := TRUE;
- 
-      BEGIN
-           B2 := FALSE;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL BOOLEAN ASSNMNT");
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           C1 : CHARACTER RANGE 'B'..'Z' := 'M';
- 
-      BEGIN
-           C1 := 'A';
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE CHAR ASSNMNT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF C1 /= 'M' THEN
-                FAILED ("VALUE ALTERED BEFORE CHARACTER RANGE " &
-                        "EXCEPTION");
-           END IF; 
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           C2 : CHARACTER RANGE 'B'..'Z' := 'M';
- 
-      BEGIN
-           C2 := 'B';
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED OF LEGAL CHARACTER ASSNMNT");
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
-           WORKDAY : DAY RANGE MON..FRI := TUE;
- 
-      BEGIN
-           WORKDAY := SUN;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE ENUM. " &
-                   "ASSIGNMENT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF WORKDAY /= TUE THEN
-                FAILED ("VALUE ALTERED BEFORE ENUM. RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
-           WORKDAY : DAY RANGE MON..FRI := TUE;
- 
-      BEGIN
-           WORKDAY := FRI;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL ENUM. ASSNMNT");
- 
-      END;
- 
- -------------------------
- 
-      RESULT;
- END C52005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- C52005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
- --    WHEN A STATIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
- --    OF FLOATING POINT ASSIGNMENTS.
- 
- -- DCB 2/6/80
- -- JRK 7/21/80
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52005B IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C52005B", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
-          & " ON STATIC OUT OF RANGE FLOATING POINT ASSIGNMENTS");
- 
- -------------------------
- 
-      DECLARE
-           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
-           FL1 : FLT RANGE 0.0 .. 100.0 := 50.0;
- 
-      BEGIN
-           FL1 := 101.0;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLT1 PT " &
-                   "ASSIGNMENT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF FL1 /= 50.0 THEN
-                FAILED ("VALUE ALTERED BEFORE FLT1 PT RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
-           FL2 : FLT RANGE 0.0 .. 100.0 := 50.0;
- 
- 
-      BEGIN
-           FL2 := 100.0;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING1 PT" &
-                   "ASSIGNMENT");
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           FL1 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
- 
-      BEGIN
-           FL1 := -0.001;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLTG PT " &
-                   "ASSIGNMENT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF FL1 /= 50.0 THEN
-                FAILED ("VALUE ALTERED BEFORE FLTG PT RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           FL2 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
- 
-      BEGIN
-           FL2 := 0.0;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING PT ASSNMT");
- 
-      END;
- 
- ----------------------
- 
-      RESULT;
- END C52005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C52005C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
- --    WHEN A STATIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
- --    OF FIXED POINT ASSIGNMENTS.
- 
- -- DCB 2/6/80
- -- JRK 7/21/80
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52005C IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C52005C", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
-          & " ON STATIC OUT OF RANGE FIXED POINT ASSIGNMENTS");
- 
- -----------------------
- 
-      DECLARE
-           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
-           FX1 : REAL RANGE 0.00 .. 7.00 := 4.50;
- 
-      BEGIN
-           FX1 := 7.01;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FIXED ASSNMT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF FX1 /= 4.50 THEN
-                FAILED ("VALUE ALTERED BEFORE FIXED PT RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
-           FX2 : REAL RANGE 0.00 .. 7.00 := 4.50;
- 
-      BEGIN
-           FX2 := 7.00;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL FIXED PT ASSNMT");
- 
-      END;
- 
- -------------------------
- 
-      RESULT;
- END C52005C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- C52005D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED WHEN A DYNAMIC
- --    EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE OF INTEGER, BOOLEAN,
- --    CHARACTER, AND ENUMERATION ASSIGNMENT TARGET VARIABLES.
- 
- -- JRK 7/21/80
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52005D IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C52005D", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED "
-          & "ON DYNAMIC OUT OF RANGE INTEGER, BOOLEAN, CHARACTER, " &
-            "AND ENUMERATION ASSIGNMENTS");
- 
- -------------------------
- 
-      DECLARE
-           I1 : INTEGER RANGE 0..10 := 5;
- 
-      BEGIN
-           I1 := IDENT_INT(11);
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE INT ASSNMT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF I1 /= 5 THEN
-                FAILED ("VALUE ALTERED BEFORE INT RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           I2 : INTEGER RANGE 0..10 := 5;
- 
-      BEGIN
-           I2 := IDENT_INT(10);
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL INTEGER ASSIGNMENT");
-      END;
- 
- -------------------------
- 
-      DECLARE
-           B1 : BOOLEAN RANGE TRUE..TRUE := TRUE;
- 
-      BEGIN
-           B1 := IDENT_BOOL(FALSE);
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE BOOL ASSNMT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF B1 /= TRUE THEN
-                FAILED ("VALUE ALTERED BEFORE BOOLEAN RANGE EXCEPTION");
-           END IF;
-      END;
- 
- -------------------------
- 
-      DECLARE
-           B2 : BOOLEAN := TRUE;
- 
-      BEGIN
-           B2 := IDENT_BOOL(FALSE);
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL BOOLEAN ASSNMNT");
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           C1 : CHARACTER RANGE 'B'..'Z' := 'M';
- 
-      BEGIN
-           C1 := IDENT_CHAR('A');
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE CHAR ASSNMNT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF C1 /= 'M' THEN
-                FAILED ("VALUE ALTERED BEFORE CHARACTER RANGE " &
-                        "EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           C2 : CHARACTER RANGE 'B'..'Z' := 'M';
- 
-      BEGIN
-           C2 := IDENT_CHAR('B');
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED OF LEGAL CHARACTER ASSNMNT");
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
-           ALLDAYS : DAY := TUE;
-           WORKDAY : DAY RANGE MON..FRI := TUE;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                ALLDAYS := SUN;
-           END IF;
-           WORKDAY := ALLDAYS;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE ENUM. " &
-                   "ASSIGNMENT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF WORKDAY /= TUE THEN
-                FAILED ("VALUE ALTERED BEFORE ENUM. RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
-           ALLDAYS : DAY := TUE;
-           WORKDAY : DAY RANGE MON..FRI := TUE;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                ALLDAYS := FRI;
-           END IF;
-           WORKDAY := ALLDAYS;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL ENUM. ASSNMNT");
- 
-      END;
- 
- -------------------------
- 
-      RESULT;
- END C52005D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- C52005E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
- --    WHEN A DYNAMIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
- --    OF FLOATING POINT ASSIGNMENTS.
- 
- -- JRK 7/21/80
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52005E IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C52005E", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
-         &  " ON DYNAMIC OUT OF RANGE FLOATING POINT ASSIGNMENTS");
- 
- -------------------------
- 
-      DECLARE
-           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
-           FL : FLT := 50.0;
-           FL1 : FLT RANGE 0.0 .. 100.0 := 50.0;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FL := 101.0;
-           END IF;
-           FL1 := FL;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLT1 PT " &
-                   "ASSIGNMENT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF FL1 /= 50.0 THEN
-                FAILED ("VALUE ALTERED BEFORE FLT1 PT RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
-           FL : FLT := 50.0;
-           FL2 : FLT RANGE 0.0 .. 100.0 := 50.0;
- 
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FL := 100.0;
-           END IF;
-           FL2 := FL;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING1 PT ASSNMT");
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           FL : FLOAT := 50.0;
-           FL1 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FL := -0.001;
-           END IF;
-           FL1 := FL;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLTG PT " &
-                   "ASSIGNMENT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF FL1 /= 50.0 THEN
-                FAILED ("VALUE ALTERED BEFORE FLTG PT RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           FL : FLOAT := 50.0;
-           FL2 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FL := 0.0;
-           END IF;
-           FL2 := FL;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING PT ASSNMT");
- 
-      END;
- 
- ----------------------
- 
-      RESULT;
- END C52005E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52005f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52005f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C52005F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
- --    WHEN A DYNAMIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
- --    OF FIXED POINT ASSIGNMENTS.
- 
- -- JRK 7/21/80
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52005F IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C52005F", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
-          & " ON DYNAMIC OUT OF RANGE FIXED POINT ASSIGNMENTS");
- 
- -----------------------
- 
-      DECLARE
-           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
-           FX : REAL := 4.50;
-           FX1 : REAL RANGE 0.00 .. 7.00 := 4.50;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FX := 7.01;
-           END IF;
-           FX1 := FX;
- 
-           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FIXED ASSNMT");
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           IF FX1 /= 4.50 THEN
-                FAILED ("VALUE ALTERED BEFORE FIXED PT RANGE EXCEPTION");
-           END IF;
- 
-      END;
- 
- -------------------------
- 
-      DECLARE
-           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
-           FX : REAL := 4.50;
-           FX2 : REAL RANGE 0.00 .. 7.00 := 4.50;
- 
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FX := 7.00;
-           END IF;
-           FX2 := FX;
- 
-      EXCEPTION
-      WHEN CONSTRAINT_ERROR =>
-           FAILED ("EXCEPTION RAISED ON LEGAL FIXED PT ASSNMT");
- 
-      END;
- 
- -------------------------
- 
-      RESULT;
- END C52005F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C52008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RECORD VARIABLE CONSTRAINED BY A SPECIFIED DISCRIMINANT
- -- VALUE CANNOT HAVE ITS DISCRIMINANT VALUE ALTERED BY ASSIGNMENT.  
- -- ASSIGNING AN ENTIRE RECORD VALUE WITH A DIFFERENT DISCRIMINANT VALUE
- -- SHOULD RAISE CONSTRAINT_ERROR AND LEAVE THE TARGET VARIABLE 
- -- UNALTERED.  THIS TEST USES STATIC DISCRIMINANT VALUES.
-  
- -- ASL 6/25/81
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52008A IS
-  
-      USE REPORT;
-  
-      TYPE REC(DISC : INTEGER) IS
-           RECORD
-                COMP : INTEGER;
-           END RECORD;
-  
-      R : REC(5) := (5,0);
-  
- BEGIN
-  
-      TEST ("C52008A", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " &
-                       "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " &
-                       "STATIC DISCRIMINANT VALUE");
-  
-      BEGIN
-           R := (DISC => 5, COMP => 3);
-           IF R /= (5,3) THEN
-                FAILED ("LEGAL ASSIGNMENT FAILED");
-           END IF;
-           R := (DISC => 4, COMP => 2);
-           FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
-                   "VALUE");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF R /= (5,3) THEN
-                     FAILED ("TARGET RECORD VALUE ALTERED BY " &
-                             "ASSIGNMENT TO VALUE WITH DIFFERENT " &
-                             "DISCRIMINANT VALUE EVEN AFTER " &
-                             "CONSTRAINT_ERROR RAISED");
-                END IF;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION");
-      END;
-  
-      RESULT;
-  
- END C52008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52008b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52008b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52008b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C52008B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD VARIABLE DECLARED WITH A SPECIFIED
- --     DISCRIMINANT CONSTRAINT CANNOT HAVE A DISCRIMINANT VALUE ALTERED
- --     BY ASSIGNMENT.  ASSIGNING AN ENTIRE RECORD VALUE WITH A
- --     DIFFERENT DISCRIMINANT VALUE SHOULD RAISE CONSTRAINT_ERROR AND
- --     LEAVE THE TARGET VARIABLE UNALTERED.  THIS TEST USES NON-STATIC
- --     DISCRIMINANT VALUES.
- 
- -- HISTORY:
- --     ASL  6/25/81  CREATED ORIGINAL TEST
- --     JRK 11/18/82
- --     RJW  8/17/89  ADDED SUBTYPE 'SUBINT'.
- 
- WITH REPORT;
- PROCEDURE C52008B IS
- 
-      USE REPORT;
- 
-      TYPE REC1(D1,D2 : INTEGER) IS
-           RECORD
-                COMP1 : STRING(D1..D2);
-           END RECORD;
- 
-      TYPE AR_REC1 IS ARRAY (NATURAL RANGE <>) OF REC1(IDENT_INT(3),
-                                                       IDENT_INT(5));
- 
-      SUBTYPE SUBINT IS INTEGER RANGE -128 .. 127;
- 
-      TYPE REC2(D1,D2,D3,D4 : SUBINT := 0) IS
-           RECORD
-                COMP1 : STRING(1..D1);
-                COMP2 : STRING(D2..D3);
-                COMP5 : AR_REC1(1..D4);
-                COMP6 : REC1(D3,D4);
-           END RECORD;
- 
-      STR : STRING(IDENT_INT(3)..IDENT_INT(5)) := "ZZZ";
- 
-      R1A : REC1(IDENT_INT(3),IDENT_INT(5)) := (3,5,STR);
-      R1C : REC1(5,6) := (5,6,COMP1 => (5..6 => 'K'));
- 
-      Q,R : REC2(IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6));
-      TEMP : REC2(2,3,5,6);
- 
-      W : REC2(1,4,6,8);
-      OK : BOOLEAN := FALSE;
- 
- 
- BEGIN
- 
-      TEST ("C52008B", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " &
-                       "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " &
-                       "(DYNAMIC) DISCRIMINANT VALUE");
- 
-      BEGIN
-           R1A := (IDENT_INT(3),5,"XYZ");
- 
-           R := (IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6),
-                 "AB",
-                 STR,
-                 (1..6 => R1A),
-                 R1C);
- 
-           TEMP := R;
-           Q := TEMP;
-           R.COMP1 := "YY";
-           OK := TRUE;
-           W := R;
-           FAILED ("ASSIGNMENT MADE USING INCORRECT DISCRIMINANT " &
-                   "VALUES");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT OK
-                OR Q /= TEMP
-                OR R = TEMP
-                OR R = Q
-                OR W.D4 /= 8 THEN
-                     FAILED ("LEGITIMATE ASSIGNMENT FAILED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION");
-      END;
- 
-      RESULT;
- 
- END C52008B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C52009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RECORD VARIABLE DESIGNATED BY AN ACCESS VALUE CANNOT
- -- HAVE ITS DISCRIMINANT ALTERED, EVEN BY A COMPLETE RECORD
- -- ASSIGNMENT, AND EVEN THOUGH THE THE TARGET ACCESS VARIABLE IS NOT 
- -- CONSTRAINED TO A SPECIFIC DISCRIMINANT VALUE.  ATTEMPTING TO
- -- CHANGE THE TARGET'S DISCRIMINANT RAISES CONSTRAINT_ERROR AND LEAVES 
- -- THE TARGET RECORD UNALTERED.  THIS  TEST USES STATIC DISCRIMINANT 
- -- VALUES.
-  
- -- ASL 6/25/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C52009A IS
-  
-      USE REPORT;
-  
-      TYPE REC (DISC : INTEGER) IS
-           RECORD
-                COMP : INTEGER;
-           END RECORD;
-  
-      TYPE REC_NAME IS ACCESS REC;
-  
-      HR : REC_NAME := NEW REC'(5,0);
-  
- BEGIN
-  
-      TEST ("C52009A", "CANNOT CHANGE, THROUGH ASSIGNMENT, THE " &
-            "(STATIC) DISCRIMINANT VALUE OF A RECORD DESIGNATED " &
-            "BY AN ACCESS VALUE");
-  
-      BEGIN
-           HR.ALL := (DISC => 5, COMP => 3);
-           IF HR.ALL /= (5,3) THEN
-                FAILED ("LEGAL ASSIGNMENT FAILED");
-           END IF;
-           HR.ALL := (DISC => 4, COMP => 2);
-           FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
-                   "VALUE");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF HR.ALL /= (5,3) THEN
-                     FAILED ("TARGET RECORD VALUE ALTERED BY " &
-                             "ASSIGNMENT WITH A DIFFERENT " &
-                             "DISCRIMINANT VALUE EVEN AFTER " &
-                             "CONSTRAINT_ERROR RAISED");
-                END IF;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION");
-      END;
-  
-      RESULT;
-  
- END C52009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52009b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52009b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52009b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C52009B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RECORD VARIABLE DESIGNATED BY AN ACCESS VALUE CANNOT
- -- HAVE ITS DISCRIMINANT ALTERED, EVEN BY A COMPLETE RECORD
- -- ASSIGNMENT, AND EVEN THOUGH THE THE TARGET ACCESS VARIABLE IS NOT 
- -- CONSTRAINED TO A SPECIFIC DISCRIMINANT VALUE.  ATTEMPTING TO
- -- CHANGE THE TARGET'S DISCRIMINANT RAISES CONSTRAINT_ERROR AND LEAVES 
- -- THE TARGET RECORD UNALTERED.  THIS TEST USES NON-STATIC DISCRIMINANT 
- -- VALUES AND A TYPE WITH DEFAULT DISCRIMINANTS.
-  
- -- ASL 7/6/81
- -- SPS 10/26/82
- -- JBG 1/10/84
- 
- WITH REPORT;
- PROCEDURE C52009B IS
-  
-      USE REPORT;
-  
-      TYPE REC(DISC : INTEGER := 5) IS
-           RECORD
-                COMP : INTEGER := 0;
-           END RECORD;
-  
-      TYPE REC_NAME IS ACCESS REC;
-  
-      HR : REC_NAME := NEW REC;
-  
- BEGIN
-  
-      TEST ("C52009B", "CANNOT CHANGE, THROUGH ASSIGNMENT, THE " &
-            "(DYNAMIC) DISCRIMINANT VALUE OF A RECORD DESIGNATED " &
-            "BY AN ACCESS VALUE");
-  
-      BEGIN
-           HR.ALL := (DISC => IDENT_INT(5), COMP => 3);
-           IF HR.ALL /= (IDENT_INT(5),3) THEN
-                FAILED ("LEGAL ASSIGNMENT FAILED");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => 
-                FAILED ("CONSTRAINT_ERROR RAISED WHEN DISCRIMINANT " &
-                        "VALUE NOT CHANGED");
-      END;
- 
-      BEGIN
-           HR.ALL := (DISC => IDENT_INT(4), COMP => 2);
-           FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
-                   "VALUE");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("DETECTED ATTEMPT TO CHANGE DISCRIMINANT " &
-                         "VALUE");
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION");
-      END;
-  
-      RESULT;
-  
- END C52009B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- C52010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT RECORD ASSIGNMENTS USE "COPY" SEMANTICS. (PART I).
- 
- 
- -- FACTORS AFFECTING THE SITUATION TO BE TESTED:
- --
- --        COMPONENT TYPE                     * INTEGER
- --                                           * BOOLEAN (OMITTED)
- --                                           * CHARACTER (OMITTED)
- --                                           * USER-DEFINED ENUMERATION
- --
- --        DERIVED VS. NON-DERIVED
- --
- --        TYPE VS. SUBTYPE
- --
- --        ORDER OF COMPONENT ASSIGNMENTS     * LEFT-TO-RIGHT
- --                                           * RIGHT-TO-LEFT
- --                                           * INSIDE-OUT
- --                                           * OUTSIDE IN
- 
- 
- -- RM 02/23/80
- -- SPS 3/21/83
- 
- WITH REPORT;
- PROCEDURE C52010A IS
- 
-      USE REPORT;
- 
-      TYPE  ENUM  IS  ( AA , BB , CC , DD , EE , FF , GG , HH ,
-                        II , JJ , KK , LL , MM , NN , PP , QQ ,
-                                  TT , UU , VV , WW , XX , YY );
- 
- BEGIN
- 
-      TEST ( "C52010A" ,  "CHECK THAT RECORD ASSIGNMENTS USE ""COPY""" &
-                          " SEMANTICS" );
- 
- 
-      DECLARE
-           TYPE  REC  IS
-                RECORD
-                     X , Y  :  INTEGER ;
-                END RECORD;
-           R  :  REC ;
-      BEGIN
- 
-           R  :=  ( 5 , 8 ) ;
-           R  :=  ( X => 1 , Y => R.X ) ;
-           IF  R  /=  ( 1 , 5 )  THEN
-                FAILED ( "WRONG VALUE  (1)" );
-           END IF;
- 
-           R  :=  ( 5 , 8 ) ;
-           R  :=  ( Y => 1 , X => R.Y ) ;
-           IF  R  /=  ( 8 , 1 )  THEN
-                FAILED ( "WRONG VALUE  (2)" );
-           END IF;
- 
-           R  :=  ( 5 , 8 ) ;
-           R  :=  ( R.Y+1 , R.X+1 ) ;
-           IF  R  /=  ( 9 , 6 ) THEN
-                FAILED ( "WRONG VALUE  (3)" );
-           END IF;
- 
-      END;
- 
-      DECLARE
-           TYPE  REC3  IS
-                RECORD
-                     DEEP0     :  INTEGER   ;
-                     DEEP      :  INTEGER   ;
-                END RECORD;
-           TYPE  REC2  IS
-                RECORD
-                     YX        :  REC3      ;
-                     MODERATE  :  INTEGER   ;
-                END RECORD;
-           TYPE  REC  IS
-                RECORD
-                     SHALLOW   :  INTEGER   ;
-                     YZ        :  REC2      ;
-                END RECORD;
-           R  :  REC ;
-      BEGIN
-           R  :=  ( 0              , ((5,  1         ), 2             ));
-           R  :=  ( R.YZ.MODERATE+8, ((7, R.SHALLOW+1),R.YZ.YX.DEEP+99));
-           IF R/= (              10, ((7,           1),            100))
-           THEN
-                FAILED ( "WRONG VALUE  (4)" );
-           END IF;
-      END;
- 
- 
-      DECLARE
-           TYPE  SUB_ENUM  IS  NEW ENUM RANGE  AA..DD ;
-           TYPE  REC  IS
-                RECORD
-                     X , Y  :  SUB_ENUM ;
-                END RECORD;
-           R  :  REC ;
-      BEGIN
-           R  :=  ( AA , CC ) ;
-           R  :=  ( X => BB , Y => R.X ) ;
-           IF  R  /=  ( BB , AA )  THEN
-                FAILED ( "WRONG VALUE  (5)" );
-           END IF;
- 
-           R  :=  ( AA , CC ) ;
-           R  :=  ( Y => BB , X => R.Y ) ;
-           IF  R  /=  ( CC , BB )  THEN
-                FAILED ( "WRONG VALUE  (6)" );
-           END IF;
- 
-           R  :=  ( AA , CC ) ;
-           R  :=  ( SUB_ENUM'SUCC( R.Y ) , SUB_ENUM'SUCC( R.X ) ) ;
-           IF  R /= ( DD , BB )  THEN
-                FAILED ( "WRONG VALUE  (7)" );
-           END IF;
- 
-      END;
- 
- 
-      DECLARE
-           TYPE  REC3  IS
-                RECORD
-                     DEEP0      :  ENUM ;
-                     DEEP       :  ENUM ;
-                END RECORD;     
-           TYPE  REC2  IS
-                RECORD
-                     YX         :  REC3 ;
-                     MODERATE   :  ENUM ;
-                END RECORD;
-           TYPE  REC  IS
-                RECORD
-                     SHALLOW    :  ENUM ;
-                     YZ         :  REC2 ;
-                END RECORD;
-           R  :  REC ;
-      BEGIN
- 
-           R  :=  (    TT ,
-                    (( YY , II ) ,
-                       AA ) ) ;
- 
-           R  :=  (    ENUM'SUCC(ENUM'SUCC( R.YZ.MODERATE )) ,
-                    (( AA , ENUM'SUCC( R.SHALLOW ) ) ,
-                     ( ENUM'SUCC(ENUM'SUCC(ENUM'SUCC(ENUM'SUCC(
-                                 R.YZ.YX.DEEP )))) ) ) ) ;
- 
-           IF R/= (    CC ,
-                    (( AA , UU ) ,
-                       MM ) )
-           THEN
-                FAILED ( "WRONG VALUE  (8)" );
-           END IF;
- 
-      END;
- 
-      RESULT ;
- 
- END C52010A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C52011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK INDEX CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES.
- -- SPECIFICALLY, CHECK THAT:
- 
- -- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT
- -- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED
- -- IS NULL.
- 
- -- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED
- -- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE.
- 
- -- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS
- -- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES.
- 
- -- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT
- -- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS
- -- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER
- -- FROM THOSE ON THE SUBTYPE.
- 
- -- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED
- -- SUBTYPES OF THIS TYPE.
- 
- -- ASL 6/29/81
- --  RM 6/17/82
- -- SPS 10/26/82
- -- RLB  6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION.
- 
- WITH REPORT;
- PROCEDURE C52011A IS
- 
-      USE REPORT;
- 
-      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
-      TYPE ARR_NAME IS ACCESS ARR;
-      SUBTYPE S1 IS ARR_NAME(IDENT_INT(1)..IDENT_INT(10));
-      SUBTYPE S2 IS ARR_NAME(IDENT_INT(3)..IDENT_INT(6));
- 
-      W : ARR_NAME := NULL;                    -- E.
-      X1,X2 : S1 := NULL;                      -- E.
-      Y1,Y2 : S2 := NULL;                      -- E.
- 
-      W_NONNULL  : ARR_NAME := NEW ARR'(3..5=>7) ;
-      X1_NONNULL : S1       := NEW ARR'(IDENT_INT(1)..IDENT_INT(10)=>7);
-      Y1_NONNULL : S2       := NEW ARR'(IDENT_INT(3)..IDENT_INT( 6)=>7);
- 
-      TOO_EARLY : BOOLEAN := TRUE;
- 
- BEGIN
- 
-      TEST ("C52011A", "INDEX CONSTRAINTS ON ACCESS SUBTYPE OBJECTS " &
-                       "MUST BE SATISFIED FOR ASSIGNMENT");
- 
-      BEGIN
- 
-           IF EQUAL(3,3) THEN
-                W_NONNULL := X1;               -- A.
-           END IF;
-           IF W_NONNULL /= X1 THEN
-                FAILED ("ASSIGNMENT FAILED - 1");
-           END IF;
- 
-           IF EQUAL(3,3) THEN
-                X1_NONNULL := X2;              -- A.
-           END IF;
-           IF X1_NONNULL /= X2 THEN
-                FAILED ("ASSIGNMENT FAILED - 2");
-           END IF;
- 
-           IF EQUAL(3,3) THEN
-                X1_NONNULL := Y1;              -- A.
-           END IF;
-           IF X1 /= Y1 THEN
-                FAILED ("ASSIGNMENT FAILED - 3");
-           END IF;
- 
-           X1 := NEW ARR'(1..IDENT_INT(10) => 5);
-           IF EQUAL(3,3) THEN
-                X2 := X1;                      -- B.
-           END IF;
-           IF X2 /= X1 THEN
-                FAILED ("ASSIGNMENT FAILED - 4");
-           END IF;
- 
-           IF EQUAL(3,3) THEN
-                W := X1;                       -- B.
-           END IF;
-           IF W /= X1 THEN
-                FAILED ("ASSIGNMENT FAILED - 5");
-           END IF;
- 
-           BEGIN
-                Y1 := X1;                      -- C.
-                IF Y1'FIRST /= REPORT.IDENT_INT(3) THEN
-                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
-                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
-                      "AND CONSTRAINT IS CHANGED");
-                ELSE
-                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
-                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
-                      "AND CONSTRAINT IS NOT CHANGED");
-                END IF;
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION - 1");
- 
-           END;
- 
-           W := NEW ARR'(IDENT_INT(3)..IDENT_INT(6) => 3);
- 
-           BEGIN
-                X1 := W;                            -- D.
-                IF X1'FIRST /= REPORT.IDENT_INT(1) THEN
-                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
-                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
-                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
-                           "AND CONSTRAINT IS CHANGED");
-                ELSE
-                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
-                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
-                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
-                           "AND CONSTRAINT IS NOT CHANGED");
-                END IF;
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL ;
- 
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION - 2");
- 
-           END;
- 
-      EXCEPTION
- 
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED");
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END C52011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52011b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52011b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52011b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,180 ****
- -- C52011B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK DISCRIMINANT CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES.
- -- SPECIFICALLY, CHECK THAT:
- 
- -- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT
- -- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED
- -- IS NULL.
- 
- -- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED
- -- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE.
- 
- -- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS
- -- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES.
- 
- -- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT
- -- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS
- -- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER
- -- FROM THOSE ON THE SUBTYPE.
- 
- -- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED
- -- SUBTYPES OF THIS TYPE.
- 
- -- ASL 7/06/81
- --  RM 6/17/82
- -- RLB 6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION.
- 
- WITH REPORT;
- PROCEDURE C52011B IS
- 
-      USE REPORT;
- 
-      TYPE REC(DISC : INTEGER := -1 ) IS
-           RECORD
-                NULL;
-           END RECORD;
- 
-      TYPE REC_NAME IS ACCESS REC;
-      SUBTYPE S1 IS REC_NAME(IDENT_INT(5));
-      SUBTYPE S2 IS REC_NAME(IDENT_INT(3));
- 
-      W : REC_NAME := NULL;                    -- E.
-      X1,X2 : S1 := NULL;                      -- E.
-      Y1,Y2 : S2 := NULL;                      -- E.
- 
-      W_NONNULL  : REC_NAME := NEW REC(7) ;
-      X1_NONNULL : S1       := NEW REC(IDENT_INT(5));
-      Y1_NONNULL : S2       := NEW REC(IDENT_INT(3));
- 
-      TOO_EARLY : BOOLEAN := TRUE;
- 
- BEGIN
- 
-      TEST ("C52011B", "DISCRIMINANT CONSTRAINTS ON ACCESS SUBTYPE " &
-                       "OBJECTS MUST BE SATISFIED FOR ASSIGNMENT");
- 
-      BEGIN
- 
-           IF EQUAL(3,3) THEN
-                W_NONNULL := X1;               -- A.
-           END IF;
-           IF W_NONNULL /= X1 THEN
-                FAILED ("ASSIGNMENT FAILED - 1");
-           END IF;
- 
-           IF EQUAL(3,3) THEN
-                W := Y1;                       -- A.
-           END IF;
-           IF W /= Y1 THEN
-                FAILED ("ASSIGNMENT FAILED - 2");
-           END IF;
- 
-           IF EQUAL(3,3) THEN
-                X1_NONNULL := Y1;              -- A.
-           END IF;
-           IF X1_NONNULL /= Y1 THEN
-                FAILED ("ASSIGNMENT FAILED - 3");
-           END IF;
- 
-           IF EQUAL(3,3) THEN
-                Y1_NONNULL := Y2;              -- A.
-           END IF;
-           IF Y1_NONNULL /= Y2 THEN
-                FAILED ("ASSIGNMENT FAILED - 4");
-           END IF;
- 
-           X1 := NEW REC(IDENT_INT(5));
-           IF EQUAL(3,3) THEN
-                X2 := X1;                      -- B.
-           END IF;
-           IF X1 /= X2 THEN
-                FAILED ("ASSIGNMENT FAILED - 5");
-           END IF;
- 
-           IF EQUAL(3,3) THEN
-                W := X1;                       -- B.
-           END IF;
-           IF W /= X1 THEN
-                FAILED ("ASSIGNMENT FAILED - 6");
-           END IF;
- 
-           BEGIN
-                Y1 := X1;                      -- C.
-                IF Y1.DISC /= REPORT.IDENT_INT(3) THEN
-                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
-                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
-                      "AND CONSTRAINT IS CHANGED");
-                ELSE
-                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
-                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
-                      "AND CONSTRAINT IS NOT CHANGED");
-                END IF;
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR => NULL;
- 
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION - 1");
- 
-           END;
- 
-           W := NEW REC(IDENT_INT(3));
- 
-           BEGIN
-                X1 := W;                            -- D.
-                IF X1.DISC /= REPORT.IDENT_INT(5) THEN
-                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
-                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
-                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
-                           "AND CONSTRAINT IS CHANGED");
-                ELSE
-                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
-                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
-                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
-                           "AND CONSTRAINT IS NOT CHANGED");
-                END IF;
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     NULL ;
- 
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION - 2");
- 
-           END;
- 
-      EXCEPTION
- 
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED");
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END C52011B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52101a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52101a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52101a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C52101A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAY SUBTYPE CONVERSION IS APPLIED AFTER AN ARRAY VALUE
- -- IS DETERMINED.
- 
- -- BHS 6/22/84
- 
- WITH REPORT;
- PROCEDURE C52101A IS
- 
-      USE REPORT;
- 
-      TYPE DAY IS (MON, TUE, WED, THU, FRI, SAT, SUN);
-      SUBTYPE WEEKDAY IS DAY RANGE MON..FRI;
- 
-      TYPE ARR IS ARRAY  (WEEKDAY RANGE <>) OF INTEGER;
-      TYPE ARR_DAY IS ARRAY (DAY RANGE <>) OF INTEGER;
- 
-      NORM     : ARR (MON..FRI);          -- INDEX SUBTYPE WEEKDAY
-      NORM_DAY : ARR_DAY (MON..FRI);      -- INDEX SUBTYPE DAY
- 
- BEGIN
-      TEST ("C52101A", "CHECK THAT ARRAY SUBTYPE CONVERSION " &
-                       "APPLIED AFTER ARRAY VAL. DETERMINED");
- 
-      BEGIN   -- ILLEGAL CASE
-           NORM := (WED..SUN => 0);        -- ERROR: INDEX SUBTYPE
- 
-           FAILED ("EXCEPTION NOT RAISED FOR INDEX SUBTYPE ERROR");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("IMPROPER AGGREGATE BOUNDS DETECTED");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
- 
-      END;
- 
- 
-      BEGIN    -- LEGAL CASE
-           NORM_DAY := (WED..FRI => 0, SAT..SUN => 1);
-           IF NORM_DAY /= ( 0, 0, IDENT_INT(0), IDENT_INT(1),
-                                                IDENT_INT(1)) THEN
-                FAILED ("INCORRECT ASSIGNMENT IN LEGAL CASE");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED ON LEGAL INDEX " &
-                        "SUBTYPE CONVERSION");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED IN LEGAL CASE");
- 
-      END;
- 
- 
-      RESULT;
- 
- END C52101A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,251 ****
- -- C52102A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
- --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
- --    THE SEMANTICS OF "COPY" ASSIGNMENT.  (THIS TEST IS IN TWO PARTS,
- --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
- 
- -- PART 1:  STATIC BOUNDS
- 
- 
- -- RM 02/25/80
- -- SPS 2/18/83
- -- JBG 8/21/83
- -- JBG 5/8/84
- -- JBG 6/09/84
- 
- WITH REPORT;
- PROCEDURE  C52102A  IS
- 
-      USE  REPORT; 
- 
- 
- BEGIN
- 
- 
-      TEST( "C52102A" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
-                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
-                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
-                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
-                        "ASSIGNMENT (PART 1: STATIC BOUNDS)" );
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF INTEGERS  -------------------------
- 
-      DECLARE
-           A   :    ARRAY( 1..4 ) OF INTEGER; 
- 
-      BEGIN
-           A   :=   (  11  ,  12  ,  13  ,  14  );
-           A   :=   (  1   , A(1) , A(2) , A(1) );
-           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
-                FAILED( "WRONG VALUES  -  I1" );
-           END IF;
- 
-           A   :=   (  11  ,  12  ,  13  ,  14  );
-           A   :=   ( A(4) , A(3) , A(4) ,  1   );
-           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
-                FAILED( "WRONG VALUES  -  I2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( INTEGER RANGE -4..4 ) OF INTEGER; 
- 
-      BEGIN
-           A   :=  (  -4 , -3 , -2 , -1 , 100 , 1 , 2 , 3 , 4 );
-           A(-4..0)  :=  A(0..4); 
-           IF  A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
-           THEN
-                FAILED( "WRONG VALUES  -  I3" );
-           END IF;
- 
-           A   :=  ( -4 , -3 , -2 , -1 , 100 ,  1 ,  2 ,  3 ,  4 );
-           A(0..4)   :=  A(-4..0); 
-           IF  A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
-           THEN
-                FAILED( "WRONG VALUES  -  I4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           A  :  INT_ARR (1..10);
- 
-      BEGIN
-           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
-           A   :=  0  &  A(1..2)  &  A(1..2)  &  A(1..5); 
-           IF  A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
-           THEN
-                FAILED( "WRONG VALUES  -  I5" );
-           END IF;
- 
-           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
-           A   :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  0  &  0; 
-           IF  A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
-           THEN
-                FAILED( "WRONG VALUES  -  I6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF BOOLEANS  -------------------------
- 
-      DECLARE
-           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A   :=   (  FALSE , TRUE , TRUE , FALSE );
-           A   :=   (  TRUE  , A(1) , A(2) , A(1)  );
-           IF  A /= (  TRUE , FALSE , TRUE , FALSE )
-           THEN
-                FAILED( "WRONG VALUES  -  B1" );
-           END IF;
- 
-           A   :=   (  FALSE , TRUE , TRUE , FALSE );
-           A   :=   (  A(4)  , A(3) , A(4) ,  TRUE );
-           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
-           THEN
-                FAILED( "WRONG VALUES  -  B2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( INTEGER RANGE -4..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A  := (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE, TRUE, TRUE,TRUE);
-           A(-4..0)  :=  A(0..4); 
-           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B3" );
-           END IF;
- 
-           A  := (FALSE,FALSE,FALSE,FALSE, TRUE,TRUE, TRUE, TRUE,TRUE);
-           A(0..4)   :=  A(-4..0); 
-           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-           A  :  B_ARR (1..10); 
- 
-      BEGIN
-           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
-           A :=  FALSE  &  A(1..2)  &  A(1..2)  &  A(1..5); 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B5" );
-           END IF;
- 
-           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
-           A :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  FALSE  &  TRUE; 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  CHARACTER STRINGS  --------------------------
- 
-      DECLARE
-           A   :    STRING( 1..4 ); 
- 
-      BEGIN
-           A   :=   "ARGH"; 
-           A   :=   (  'Q' , A(1) , A(2) , A(1) );
-           IF  A /= "QARA"  THEN
-                FAILED( "WRONG VALUES  -  C1" );
-           END IF;
- 
-           A   :=   "ARGH"; 
-           A   :=   ( A(4) , A(3) , A(4) , 'X' );
-           IF  A /= "HGHX"  THEN
-                FAILED( "WRONG VALUES  -  C2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    STRING( 96..104 );
- 
-      BEGIN
-           A  :=  "APHRODITE"; 
-           A(96..100)  :=  A(100..104); 
-           IF  A  /=  "ODITEDITE"   THEN
-                FAILED( "WRONG VALUES  -  C3" );
-           END IF;
- 
-           A  :=  "APHRODITE"; 
-           A(100..104) :=  A(96..100) ; 
-           IF  A  /=  "APHRAPHRO"   THEN
-                FAILED( "WRONG VALUES  -  C4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
-           A  :  CH_ARR (1..9);
- 
-      BEGIN
-           A   :=  "CAMBRIDGE"; 
-           A   :=  'S'  &  A(1..2)  &  A(1..2)  &  A(1..4); 
-           IF  A  /=  "SCACACAMB"  THEN
-                FAILED( "WRONG VALUES  -  C5" );
-           END IF;
- 
-           A   :=  "CAMBRIDGE"; 
-           A   :=  A(8..8)  &  A(6..8)  &  A(6..8)  &  "EA"; 
-           IF  A  /=  "GIDGIDGEA"  THEN
-                FAILED( "WRONG VALUES  -  C6" );
-           END IF;
- 
-      END; 
- 
- 
-      RESULT; 
- 
- 
- END C52102A; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,278 ****
- -- C52102B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
- --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
- --    THE SEMANTICS OF "COPY" ASSIGNMENT.  (THIS TEST IS IN TWO PARTS,
- --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
- 
- -- PART 2:  DYNAMIC BOUNDS
- 
- 
- -- RM 02/27/80
- -- SPS 2/18/83
- -- JBG 3/15/84
- -- JBG 6/9/84
- 
- WITH REPORT;
- PROCEDURE  C52102B  IS
- 
-      USE  REPORT; 
-      IDENT_INT_0 : INTEGER := IDENT_INT(0);
-      IDENT_INT_1 : INTEGER := IDENT_INT (1);
-      IDENT_INT_2 : INTEGER := IDENT_INT (2);
-      IDENT_INT_3 : INTEGER := IDENT_INT (3);
-      IDENT_INT_4 : INTEGER := IDENT_INT (4);
-      IDENT_INT_5 : INTEGER := IDENT_INT (5);
-      IDENT_INT_6 : INTEGER := IDENT_INT (6);
-      IDENT_INT_8 : INTEGER := IDENT_INT (8);
-      IDENT_INT_9 : INTEGER := IDENT_INT (9);
- 
- BEGIN
- 
- 
-      TEST( "C52102B" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
-                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
-                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
-                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
-                        "ASSIGNMENT (PART 2: DYNAMIC BOUNDS)" );
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF INTEGERS  -------------------------
- 
-      DECLARE
-           A   :   ARRAY( 1..IDENT_INT_4 ) OF INTEGER; 
- 
-      BEGIN
-           A   :=   (  11  ,  12  ,  13  ,  14  );
-           A   :=   (  1   , A(IDENT_INT_1) , A(IDENT_INT_2) ,
-                                               A(IDENT_INT_1) );
-           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
-                FAILED( "WRONG VALUES  -  I1" );
-           END IF;
- 
-           A   :=   (  11  ,  12  ,  13  ,  14  );
-           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
-                                        A(IDENT_INT_4) ,  1   );
-           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
-                FAILED( "WRONG VALUES  -  I2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( -4..IDENT_INT_4 ) OF INTEGER; 
- 
-      BEGIN
-           A         :=  (  -4 , -3 , -2 , -1 , 100 , 1 , 2 , 3 , 4 );
-           A(-4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
-           IF    A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
-           THEN
-                FAILED( "WRONG VALUES  -  I3" );
-           END IF;
- 
-           A   :=  ( -4 , -3 , -2 , -1 , 100 ,  1 ,  2 ,  3 ,  4 );
-           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
-           IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
-           THEN
-                FAILED( "WRONG VALUES  -  I4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           A   :  ARR (1..10);
- 
-      BEGIN
-           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
-           A   :=  0  &  A(IDENT_INT_1..IDENT_INT_2)  &
-                         A(IDENT_INT_1..IDENT_INT_2)  &
-                          A(IDENT_INT_1..IDENT_INT_5); 
-           IF   A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
-           THEN
-                FAILED( "WRONG VALUES  -  I5" );
-           END IF;
- 
-           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
-           A   :=  A(IDENT_INT_6..IDENT_INT_9)  &
-                   A(IDENT_INT_8..IDENT_INT_9)  &
-                   A(IDENT_INT_8..IDENT_INT_9)  &  0  &  0; 
-           IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
-           THEN
-                FAILED( "WRONG VALUES  -  I6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF BOOLEANS  -------------------------
- 
-      DECLARE
-           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A   :=   (  FALSE , TRUE , TRUE , FALSE );
-           A   :=   (  TRUE  , A(IDENT_INT_1) , A(IDENT_INT_2) ,
-                                                 A(IDENT_INT_1)  );
-           IF  A /= (  TRUE , FALSE , TRUE , FALSE )
-           THEN
-                FAILED( "WRONG VALUES  -  B1" );
-           END IF;
- 
-           A   :=   (  FALSE , TRUE , TRUE , FALSE );
-           A   :=   (  A(IDENT_INT_4)  , A(IDENT_INT_3) ,
-                                          A(IDENT_INT_4) ,  TRUE );
-           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
-           THEN
-                FAILED( "WRONG VALUES  -  B2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( -IDENT_INT_4..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A  := (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE, TRUE, TRUE,TRUE);
-           A(-IDENT_INT_4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
-           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B3" );
-           END IF;
- 
-           A  := (FALSE,FALSE,FALSE,FALSE, TRUE,TRUE, TRUE, TRUE,TRUE);
-           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
-           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-           A  :  B_ARR (1..10); 
- 
-      BEGIN
-           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
-           A :=  FALSE  &  A(IDENT_INT_1..IDENT_INT_2)  &
-                           A(IDENT_INT_1..IDENT_INT_2)  &
-                           A(IDENT_INT_1..IDENT_INT_5); 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B5" );
-           END IF;
- 
-           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
-           A :=  A(IDENT_INT_6..IDENT_INT_9)  &
-                 A(IDENT_INT_8..IDENT_INT_9)  &
-                 A(IDENT_INT_8..IDENT_INT_9)  &      FALSE  &  TRUE; 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  CHARACTER STRINGS  --------------------------
- 
-      DECLARE
-           A   :    STRING( 1..4 ); 
- 
-      BEGIN
-           A   :=   "ARGH"; 
-           A   :=   (  'Q' , A(IDENT_INT_1) , A(IDENT_INT_2) ,
-                                               A(IDENT_INT_1) );
-           IF  A /= "QARA"  THEN
-                FAILED( "WRONG VALUES  -  C1" );
-           END IF;
- 
-           A   :=   "ARGH"; 
-           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
-                      A(IDENT_INT_4) , 'X' );
-           IF  A /= "HGHX"  THEN
-                FAILED( "WRONG VALUES  -  C2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    STRING( IDENT_INT(96)..104 );
- 
-      BEGIN
-           A   :=  "APHRODITE"; 
-           A(IDENT_INT(96)..IDENT_INT(100))  :=  A(IDENT_INT(100)..
-                                                   IDENT_INT(104)); 
-           IF  A  /=  "ODITEDITE"   THEN
-                FAILED( "WRONG VALUES  -  C3" );
-           END IF;
- 
-           A   :=  "APHRODITE"; 
-           A(IDENT_INT(100)..IDENT_INT(104)) :=  A(IDENT_INT(96)..
-                                                   IDENT_INT(100)) ; 
-           IF  A  /=  "APHRAPHRO"   THEN
-                FAILED( "WRONG VALUES  -  C4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
-           A  :  CH_ARR (IDENT_INT_1..9); 
- 
-      BEGIN
-           A   :=  "CAMBRIDGE"; 
-           A   :=  'S'  &  A(IDENT_INT_1..IDENT_INT_2)  &
-                           A(IDENT_INT_1..IDENT_INT_2)  &
-                           A(IDENT_INT_1..IDENT_INT_4); 
-           IF  A  /=  "SCACACAMB"  THEN
-                FAILED( "WRONG VALUES  -  C5" );
-           END IF;
- 
-           A   :=  "CAMBRIDGE"; 
-           A   :=  A(IDENT_INT_8..IDENT_INT_8)  &
-                   A(IDENT_INT_6..IDENT_INT_8)  &
-                   A(IDENT_INT_6..IDENT_INT_8)  &  "EA"; 
-           IF  A  /=  "GIDGIDGEA"  THEN
-                FAILED( "WRONG VALUES  -  C6" );
-           END IF;
- 
-      END; 
- 
- 
-      RESULT; 
- 
- 
- END C52102B; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,280 ****
- -- C52102C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
- --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
- --    THE SEMANTICS OF "COPY" ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES
- --    REQUIRE RUN-TIME EVALUATION.   (THIS TEST IS IN TWO PARTS,
- --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
- 
- -- PART 1:  STATIC BOUNDS
- 
- 
- -- RM 02/25/80
- -- SPS 2/18/83
- -- JBG 8/21/83
- -- JBG 5/8/84
- -- JBG 6/09/84
- -- BHS 6/26/84
- 
- WITH REPORT;
- PROCEDURE  C52102C  IS
- 
-      USE  REPORT; 
- 
-      FUNCTION ID_I (X : INTEGER) RETURN INTEGER RENAMES IDENT_INT;
-      FUNCTION ID_B (X : BOOLEAN) RETURN BOOLEAN RENAMES IDENT_BOOL;
- 
- BEGIN
- 
- 
-      TEST( "C52102C" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
-                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
-                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
-                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
-                        "ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES " &
-                        "ARE DYNAMIC  (PART 1: STATIC BOUNDS)" );
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF INTEGERS  -------------------------
- 
-      DECLARE
-           A   :    ARRAY( 1..4 ) OF INTEGER; 
- 
-      BEGIN
-           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
-           A   :=   (  1   , A(1) , A(2) , A(1) );
-           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
-                FAILED( "WRONG VALUES  -  I1" );
-           END IF;
- 
-           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
-           A   :=   ( A(4) , A(3) , A(4) ,  1   );
-           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
-                FAILED( "WRONG VALUES  -  I2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( INTEGER RANGE -4..4 ) OF INTEGER; 
- 
-      BEGIN
-           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
-                      ID_I(100), ID_I(1),ID_I(2), ID_I(3), ID_I(4) );
-           A(-4..0)  :=  A(0..4); 
-           IF    A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
-           THEN
-                FAILED( "WRONG VALUES  -  I3" );
-           END IF;
- 
-           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
-                ID_I(100),  ID_I(1), ID_I(2),  ID_I(3),  ID_I(4) );
-           A(0..4)   :=  A(-4..0); 
-           IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
-           THEN
-                FAILED( "WRONG VALUES  -  I4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           A  :  INT_ARR (1..10);
- 
-      BEGIN
-           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
-                      ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
-           A   :=  0  &  A(1..2)  &  A(1..2)  &  A(1..5); 
-           IF   A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
-           THEN
-                FAILED( "WRONG VALUES  -  I5" );
-           END IF;
- 
-           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
-                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
-           A   :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  0  &  0; 
-           IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
-           THEN
-                FAILED( "WRONG VALUES  -  I6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF BOOLEANS  -------------------------
- 
-      DECLARE
-           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
-           A   :=   (  TRUE  , A(1) , A(2) , A(1)  );
-           IF  A /= (  TRUE  ,FALSE , TRUE , FALSE )
-           THEN
-                FAILED( "WRONG VALUES  -  B1" );
-           END IF;
- 
-           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
-           A   :=   (  A(4)  , A(3) , A(4) ,  TRUE );
-           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
-           THEN
-                FAILED( "WRONG VALUES  -  B2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( INTEGER RANGE -4..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
-                   ID_B(FALSE), ID_B(TRUE), ID_B(TRUE),
-                   ID_B(TRUE), ID_B(TRUE));
-           A(-4..0)  :=  A(0..4); 
-           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B3" );
-           END IF;
- 
-           A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
-                   ID_B(TRUE), ID_B(TRUE), ID_B(TRUE),
-                   ID_B(TRUE), ID_B(TRUE));
-           A(0..4)   :=  A(-4..0); 
-           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-           A  :  B_ARR (1..10); 
- 
-      BEGIN
-           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
-                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), 
-                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
-           A :=  FALSE  &  A(1..2)  &  A(1..2)  &  A(1..5); 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B5" );
-           END IF;
- 
-           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
-                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
-                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
-           A :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  FALSE  &  TRUE; 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  CHARACTER STRINGS  --------------------------
- 
-      DECLARE
-           A   :    STRING( 1..4 ); 
- 
-      BEGIN
-           IF EQUAL (3,3) THEN
-                A   :=   "ARGH"; 
-           END IF;
-           A   :=   (  'Q' , A(1) , A(2) , A(1) );
-           IF  A /= "QARA"  THEN
-                FAILED( "WRONG VALUES  -  C1" );
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                A   :=   "ARGH"; 
-           END IF;
-           A   :=   ( A(4) , A(3) , A(4) , 'X' );
-           IF  A /= "HGHX"  THEN
-                FAILED( "WRONG VALUES  -  C2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    STRING( 96..104 );
- 
-      BEGIN
-           IF EQUAL (3,3) THEN
-                A      :=  "APHRODITE"; 
-           END IF;
-           A(96..100)  :=  A(100..104); 
-           IF  A  /=  "ODITEDITE"   THEN
-                FAILED( "WRONG VALUES  -  C3" );
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                A      :=  "APHRODITE"; 
-           END IF;
-           A(100..104) :=  A(96..100) ; 
-           IF  A  /=  "APHRAPHRO"   THEN
-                FAILED( "WRONG VALUES  -  C4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
-           A  :  CH_ARR (1..9); 
- 
-      BEGIN
-           IF EQUAL (3,3) THEN
-                A   :=  "CAMBRIDGE"; 
-           END IF;
-           A   :=  'S'  &  A(1..2)  &  A(1..2)  &  A(1..4); 
-           IF  A  /=  "SCACACAMB"  THEN
-                FAILED( "WRONG VALUES  -  C5" );
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                A   :=  "CAMBRIDGE"; 
-           END IF;
-           A   :=  A(8..8)  &  A(6..8)  &  A(6..8)  &  "EA"; 
-           IF  A  /=  "GIDGIDGEA"  THEN
-                FAILED( "WRONG VALUES  -  C6" );
-           END IF;
- 
-      END; 
- 
- 
-      RESULT; 
- 
- 
- END C52102C; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52102d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52102d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,307 ****
- -- C52102D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
- --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
- --    THE SEMANTICS OF "COPY" ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES
- --    REQUIRE RUN-TIME EVALUATION.   (THIS TEST IS IN TWO PARTS,
- --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
- 
- -- PART 2:  DYNAMIC BOUNDS
- 
- 
- -- RM 02/27/80
- -- SPS 2/18/83
- -- JBG 3/15/84
- -- JBG 6/9/84
- -- BHS 6/26/84
- 
- WITH REPORT;
- PROCEDURE  C52102D  IS
- 
-      USE  REPORT; 
-      IDENT_INT_0 : INTEGER := IDENT_INT(0);
-      IDENT_INT_1 : INTEGER := IDENT_INT (1);
-      IDENT_INT_2 : INTEGER := IDENT_INT (2);
-      IDENT_INT_3 : INTEGER := IDENT_INT (3);
-      IDENT_INT_4 : INTEGER := IDENT_INT (4);
-      IDENT_INT_5 : INTEGER := IDENT_INT (5);
-      IDENT_INT_6 : INTEGER := IDENT_INT (6);
-      IDENT_INT_8 : INTEGER := IDENT_INT (8);
-      IDENT_INT_9 : INTEGER := IDENT_INT (9);
- 
-      FUNCTION ID_I (X : INTEGER) RETURN INTEGER RENAMES IDENT_INT;
-      FUNCTION ID_B (X : BOOLEAN) RETURN BOOLEAN RENAMES IDENT_BOOL;
- 
- BEGIN
- 
- 
-      TEST( "C52102D" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
-                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
-                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
-                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
-                        "ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES " &
-                        "ARE DYNAMIC  (PART 2: DYNAMIC BOUNDS)" );
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF INTEGERS  -------------------------
- 
-      DECLARE
-           A   :    ARRAY( 1..IDENT_INT_4 ) OF INTEGER; 
- 
-      BEGIN
-           A   :=   ( ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14) );
-           A   :=   (  1   , A(IDENT_INT_1) , A(IDENT_INT_2) ,
-                                               A(IDENT_INT_1) );
-           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
-                FAILED( "WRONG VALUES  -  I1" );
-           END IF;
- 
-           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14) );
-           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
-                                        A(IDENT_INT_4) ,  1   );
-           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
-                FAILED( "WRONG VALUES  -  I2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( -4..IDENT_INT_4 ) OF INTEGER; 
- 
-      BEGIN
-           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
-                     ID_I(100), ID_I(1), ID_I(2), ID_I(3), ID_I(4));
-           A(-4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
-           IF    A   /=  ( 100 , 1 , 2 , 3 , 4 , 1 , 2 , 3 , 4 )
-           THEN
-                FAILED( "WRONG VALUES  -  I3" );
-           END IF;
- 
-           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
-                     ID_I(100), ID_I(1), ID_I(2), ID_I(3), ID_I(4));
-           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
-           IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
-           THEN
-                FAILED( "WRONG VALUES  -  I4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           A   :  INT_ARR (1..10);
- 
-      BEGIN
-           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
-                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10));
-           A   :=  0  &  A(IDENT_INT_1..IDENT_INT_2)  &
-                         A(IDENT_INT_1..IDENT_INT_2)  &
-                         A(IDENT_INT_1..IDENT_INT_5); 
-           IF     A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
-           THEN
-                FAILED( "WRONG VALUES  -  I5" );
-           END IF;
- 
-           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
-                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10));
-           A   :=  A(IDENT_INT_6..IDENT_INT_9)  &
-                   A(IDENT_INT_8..IDENT_INT_9)  &
-                   A(IDENT_INT_8..IDENT_INT_9)  &  0  &  0; 
-           IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
-           THEN
-                FAILED( "WRONG VALUES  -  I6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  ARRAYS OF BOOLEANS  -------------------------
- 
-      DECLARE
-           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
-           A   :=   (  TRUE  , A(IDENT_INT_1) , A(IDENT_INT_2) ,
-                                                 A(IDENT_INT_1)  );
-           IF  A /= (  TRUE  ,FALSE , TRUE , FALSE )
-           THEN
-                FAILED( "WRONG VALUES  -  B1" );
-           END IF;
- 
-           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
-           A   :=   (  A(IDENT_INT_4)  , A(IDENT_INT_3) ,
-                                          A(IDENT_INT_4) ,  TRUE );
-           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
-           THEN
-                FAILED( "WRONG VALUES  -  B2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    ARRAY( -IDENT_INT_4..4 ) OF BOOLEAN; 
- 
-      BEGIN
-           A  := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
-                  ID_B(FALSE), ID_B(TRUE), ID_B(TRUE),
-                  ID_B(TRUE), ID_B(TRUE));
-           A(-IDENT_INT_4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
-           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B3" );
-           END IF;
- 
-           A  := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
-                  ID_B(TRUE), ID_B(TRUE), ID_B(TRUE),
-                  ID_B(TRUE), ID_B(TRUE));
-           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
-           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-           A  :  B_ARR (1..10); 
- 
-      BEGIN
-           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE), 
-                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), 
-                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
-           A :=  FALSE  &  A(IDENT_INT_1..IDENT_INT_2)  &
-                           A(IDENT_INT_1..IDENT_INT_2)  &
-                           A(IDENT_INT_1..IDENT_INT_5); 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B5" );
-           END IF;
- 
-           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
-                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
-                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
-           A :=  A(IDENT_INT_6..IDENT_INT_9)  &
-                 A(IDENT_INT_8..IDENT_INT_9)  &
-                 A(IDENT_INT_8..IDENT_INT_9)  &  FALSE  &  TRUE; 
-           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
-           THEN
-                FAILED( "WRONG VALUES  -  B6" );
-           END IF;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
-      --------------------  CHARACTER STRINGS  --------------------------
- 
-      DECLARE
-           A   :    STRING( 1..4 ); 
- 
-      BEGIN
-           IF EQUAL (3,3) THEN          
-                A   :=   "ARGH"; 
-           END IF;
-           A   :=   (  'Q' , A(IDENT_INT_1) , A(IDENT_INT_2) ,
-                                               A(IDENT_INT_1) );
-           IF  A /= "QARA"  THEN
-                FAILED( "WRONG VALUES  -  C1" );
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                A   :=   "ARGH"; 
-           END IF;
-           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
-                      A(IDENT_INT_4) , 'X' );
-           IF  A /= "HGHX"  THEN
-                FAILED( "WRONG VALUES  -  C2" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           A   :    STRING( IDENT_INT(96)..104 );
- 
-      BEGIN
-           IF EQUAL (3,3) THEN
-                A  :=  "APHRODITE"; 
-           END IF;
-           A(IDENT_INT(96)..IDENT_INT(100))  :=  A(IDENT_INT(100)..
-                                                   IDENT_INT(104)); 
-           IF   A  /=  "ODITEDITE"   THEN
-                FAILED( "WRONG VALUES  -  C3" );
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                A  :=  "APHRODITE"; 
-           END IF;
-           A(IDENT_INT(100)..IDENT_INT(104)) :=  A(IDENT_INT(96)..
-                                                   IDENT_INT(100)) ; 
-           IF   A  /=  "APHRAPHRO"   THEN
-                FAILED( "WRONG VALUES  -  C4" );
-           END IF;
- 
-      END; 
- 
- 
-      DECLARE
-           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
-           A  :  CH_ARR (IDENT_INT_1..9); 
- 
-      BEGIN
-           IF EQUAL (3,3) THEN
-                A  :=  "CAMBRIDGE"; 
-           END IF;
-           A  :=  'S'  &  A(IDENT_INT_1..IDENT_INT_2)  &
-                          A(IDENT_INT_1..IDENT_INT_2)  &
-                          A(IDENT_INT_1..IDENT_INT_4); 
-           IF  A  /=  "SCACACAMB"  THEN
-                FAILED( "WRONG VALUES  -  C5" );
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                A  :=  "CAMBRIDGE"; 
-           END IF;
-           A  :=  A(IDENT_INT_8..IDENT_INT_8)  &
-                  A(IDENT_INT_6..IDENT_INT_8)  &
-                  A(IDENT_INT_6..IDENT_INT_8)  &  "EA"; 
-           IF  A  /=  "GIDGIDGEA"  THEN
-                FAILED( "WRONG VALUES  -  C6" );
-           END IF;
- 
-      END; 
- 
- 
-      RESULT; 
- 
- 
- END C52102D; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,385 ****
- -- C52103A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 2/18/83
- 
- WITH REPORT;
- PROCEDURE  C52103A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103A" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
-      --                                AND PRECISELY 5 CASES FROM THE
-      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
-      --                                                  10-11-12-13-14)
-      --
-      --                              ( IN THE CURRENT DIVISION, THE 5
-      --                                FLOATING SELECTIONS ARE 2-11-4-
-      --                                -13-6 ; THUS THE 8 SELECTIONS ARE
-      --                                2-11-4-13-6-7-8-9 (IN THIS ORDER)
-      --                                .)
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
-      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
-      --
-      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
-      --        IN THE SAME DECLARATION.)
-      --
-      --
-      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
-      --        USING AGGREGATES
-      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
-      --                SEE  (5) )
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
-      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
-      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
-      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
-      --                TO THE TYPEMARK OF  ARR ),
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --        (SINCE WE ARE NOT USING AGGREGATES
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
-      --
-      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
-      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
-      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
-      --        ALSO WHEN NO SLIDING IS INVOLVED.)
-      --
-      --
-      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
-      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
-      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
-      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TA21  IS  ARRAY( INTEGER RANGE 1..5 , INTEGER RANGE 0..7
-                                )  OF INTEGER ;
- 
-           SUBTYPE  TA22  IS  TA21 ;
- 
-           ARR21  :  TA21 ;
-           ARR22  :  TA22 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
- 
-                FOR  J  IN  0..7  LOOP
-                     ARR21( I , J )  :=   I * I * J  ;
-                END LOOP;
- 
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARR22 := ARR21 ;
- 
-           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-           FOR  I  IN  1..5  LOOP
- 
-                FOR  J  IN  0..7  LOOP
- 
-                     IF  ARR22( I , J )  /=  ( I-0 ) * ( I-0 ) * ( J-0 )
-                     THEN
-                          FAILED( "ARRAY ASSIGNMENT NOT CORRECT" );
-                     END IF;
- 
-                END LOOP;
- 
-           END LOOP;
- 
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 2" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
- 
-           SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
- 
-           ARRX11  :  TABOX11 ;
-           ARRX12  :  TABOX1( 5..9 );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
-                ARRX11( I )  :=   I * I  ;
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX12 := ARRX11 ;
- 
-           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-           FOR  I  IN  5..9  LOOP
- 
-                IF  ARRX12( I )  /=  ( I-4 ) * ( I-4 )
-                THEN
-                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (11)" );
-                END IF;
- 
-           END LOOP;
- 
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 11" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TA42  IS  ARRAY( INTEGER RANGE 1..5 )  OF BOOLEAN ;
- 
-           SUBTYPE  TA41  IS  TA42 ;
- 
-           ARR41  :  TA41 ;
-           ARR42  :  TA42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
-                ARR41( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
-           END LOOP;
- 
-           ARR41(2) := TRUE ;
- 
-           ARR41(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
- 
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR42( 1 )  :=  TRUE ;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARR42(2..5) := ARR41(1..4) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           FOR  I  IN  2..5  LOOP
- 
-                IF  ARR42( I )  /=  FALSE  AND  I /= 3
-                THEN
-                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
-                ELSIF  ARR42( I ) /= TRUE  AND  I  = 3
-                THEN
-                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
-                END IF;
- 
-           END LOOP;
- 
-           IF  ARR42( 1 )  /=  TRUE
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (SLIDING)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 4" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,139 ****
- -- C52103B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE SECOND FILE IN
- --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 2/18/83
- 
- WITH REPORT;
- PROCEDURE  C52103B  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103B" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           ARRX31  :  TABOX3( 11..15 );
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARRX31 :=  "QUINC" ; -- "QUINC"(1..5)  SLIDES TO 11..15
- 
- 
-           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-           IF  ARRX31           /=  "QUINC"  OR
-               ARRX31( 11..15 ) /=  "QUINC"
-           THEN
-                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 13" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
- 
-      DECLARE
- 
-           TYPE  TA61  IS  ARRAY( INTEGER RANGE 11..15 )  OF CHARACTER ;
- 
-           ARR61  :  TA61 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR61( 11..11 )  :=  "Q"  ;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARR61( 12..15 ) :=  "UINC" ; -- "UINC"(1..4)  SLIDES TO 12..15
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR61           /=  "QUINC"  OR
-               ARR61( 11..15 ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (6)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 6" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,178 ****
- -- C52103C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- 
- 
- PROCEDURE  C52103C  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103C" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( 1..5 )  := "ABCDE" ;
-           ARR72  :  STRING( 5..9 )  := "FGHIJ" ;
- 
-      BEGIN
- 
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-           IF  ARR72 /= "ABCDE"
-           THEN
-                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( 5..9 ) ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR82( 5..5 )  :=  "Q"  ;
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( 5..9 )( 6..9 ) :=  "BCDE" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR82           /=  "QBCDE"  OR
-               ARR82(  5..9  ) /=  "QBCDE"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
- 
-           ARR91  :  STRING( 1..5 )  := "ABCDE" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR92( 5..5 )  :=  "Q"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( 5..9 )( 6..9 ) :=  ARR91( 1..5 )(2..5 )( 2..5 ) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR92           /=  "QBCDE"  OR
-               ARR92(  5..9  ) /=  "QBCDE"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,338 ****
- -- C52103F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- PROCEDURE  C52103F  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103F" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
-      --                                AND PRECISELY 5 CASES FROM THE
-      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
-      --                                                  10-11-12-13-14)
-      --
-      --                              ( IN THE CURRENT DIVISION, THE 5
-      --                                FLOATING SELECTIONS ARE 10-3-12-
-      --                                -5-14 ; THUS THE 8 SELECTIONS ARE
-      --                                10-3-12-5-14-7-8-9 (IN THIS ORDER
-      --                                ).)
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
-      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
-      --
-      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
-      --        IN THE SAME DECLARATION.)
-      --
-      --
-      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
-      --        USING AGGREGATES
-      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
-      --                SEE  (5) )
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
-      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
-      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
-      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
-      --                TO THE TYPEMARK OF  ARR ),
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --        (SINCE WE ARE NOT USING AGGREGATES
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
-      --
-      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
-      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
-      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
-      --        ALSO WHEN NO SLIDING IS INVOLVED.)
-      --
-      --
-      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
-      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
-      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
-                                  )  OF INTEGER ;
- 
-           SUBTYPE  TABOX01  IS  TABOX0( 1..0 ,  0..7  );
-           SUBTYPE  TABOX02  IS  TABOX0 ;
- 
-           ARRX01  :  TABOX01 ;
-           ARRX02  :  TABOX02( 7..6 , 20..27 );
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX02 := ARRX01 ;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 10" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TA3  IS  ARRAY( INTEGER RANGE 100..99 )  OF INTEGER ;
- 
-           SUBTYPE  TA31  IS  TA3 ;
-           SUBTYPE  TA32  IS  TA3 ;
- 
-           ARR31  :  TA31 ;
-           ARR32  :  TA32 ;
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARR32 := ARR31 ;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 3" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
- 
-           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
- 
-           ARRX51  :  TABOX51 ;
-           ARRX52  :  TABOX5( 5..9 );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
-                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
-           END LOOP;
- 
-           ARRX51(2) := TRUE ;
- 
-           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  5..9  LOOP
-                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
-           END LOOP;
- 
-           ARRX52(6) := FALSE ;
- 
-           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX52(6..5) := ARRX51(4..3) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARRX52( 5 )  /=  TRUE   OR
-               ARRX52( 6 )  /=  FALSE  OR
-               ARRX52( 7 )  /=  TRUE   OR
-               ARRX52( 8 )  /=  TRUE   OR
-               ARRX52( 9 )  /=  FALSE
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                 FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C52103G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE SECOND FILE IN
- --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- PROCEDURE  C52103G  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103G" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
- 
-      DECLARE
- 
-           TYPE  TA51  IS  ARRAY( INTEGER RANGE 11..10 )  OF CHARACTER ;
- 
-           ARR51  :  TA51 ;
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARR51 :=  "" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-           IF  ARR51           /=  ""
-           THEN
-                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (5)" );
-           END IF;
- 
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 5" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           SUBTYPE  TABOX42  IS  TABOX4( 11..15 );
- 
-           ARRX42  :  TABOX42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARRX42  :=  "QUINC"  ;
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX42( 13..12 ) :=  "" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARRX42           /=  "QUINC"  OR
-               ARRX42( 11..15 ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (14)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 14" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,175 ****
- -- C52103H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- PROCEDURE  C52103H  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103H" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( 1..0 )  := "" ;
-           ARR72  :  STRING( 5..4 )  ;
- 
-      BEGIN
- 
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-           IF  ARR72 /= ""
-           THEN
-                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( 5..9 ) ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR82( 5..9 )  :=  "QUINC"  ;
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( 5..9 )( 6..9 )( 6..5 ) :=  "" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR82           /=  "QUINC"  OR
-               ARR82(  5..9  ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
- 
-           ARR91  :  STRING( 1..5 )  := "ABCDE" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR92( 5..9 )  :=  "QUINC"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( 5..9 )( 6..9 )( 8..7 ) :=  ARR91( 1..5 )( 5..4 ) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR92           /=  "QUINC"  OR
-               ARR92(  5..9  ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,393 ****
- -- C52103K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
- --                   STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- PROCEDURE  C52103K  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
-      --                                AND PRECISELY 5 CASES FROM THE
-      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
-      --                                                  10-11-12-13-14)
-      --
-      --                              ( IN THE CURRENT DIVISION, THE 5
-      --                                FLOATING SELECTIONS ARE 2-11-4-
-      --                                -13-6 ; THUS THE 8 SELECTIONS ARE
-      --                                2-11-4-13-6-7-8-9 (IN THIS ORDER)
-      --                                .)
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
-      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
-      --
-      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
-      --        IN THE SAME DECLARATION.)
-      --
-      --
-      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
-      --        USING AGGREGATES
-      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
-      --                SEE  (5) )
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
-      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
-      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
-      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
-      --                TO THE TYPEMARK OF  ARR ),
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --        (SINCE WE ARE NOT USING AGGREGATES
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
-      --
-      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
-      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
-      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
-      --        ALSO WHEN NO SLIDING IS INVOLVED.)
-      --
-      --
-      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
-      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
-      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
-      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TA21  IS  ARRAY(
-                INTEGER RANGE IDENT_INT(1)..IDENT_INT(5) ,
-                INTEGER RANGE IDENT_INT(0)..IDENT_INT(7)
-                                )  OF INTEGER ;
- 
-           SUBTYPE  TA22  IS  TA21 ;
- 
-           ARR21  :  TA21 ;
-           ARR22  :  TA22 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
- 
-                FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
-                     ARR21( I , J )  :=   I * I * J  ;
-                END LOOP;
- 
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARR22 := ARR21 ;
- 
-           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
- 
-                FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
- 
-                     IF  ARR22( I , J )  /=  ( I-0 ) * ( I-0 ) * ( J-0 )
-                     THEN
-                          FAILED( "ARRAY ASSIGNMENT NOT CORRECT" );
-                     END IF;
- 
-                END LOOP;
- 
-           END LOOP;
- 
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 2" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
- 
-           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ;
- 
-           ARRX11  :  TABOX11 ;
-           ARRX12  :  TABOX1( IDENT_INT(5)..IDENT_INT(9) );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
-                ARRX11( I )  :=   I * I  ;
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX12 := ARRX11 ;
- 
-           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
- 
-                IF  ARRX12( I )  /=  ( I-4 ) * ( I-4 )
-                THEN
-                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (11)" );
-                END IF;
- 
-           END LOOP;
- 
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 11" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TA42  IS  ARRAY(
-                INTEGER RANGE IDENT_INT(1)..IDENT_INT(5)
-                                )  OF BOOLEAN ;
- 
-           SUBTYPE  TA41  IS  TA42 ;
- 
-           ARR41  :  TA41 ;
-           ARR42  :  TA42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
-                ARR41( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
-           END LOOP;
- 
-           ARR41(2) := TRUE ;
- 
-           ARR41(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
- 
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR42( 1 )  :=  TRUE ;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARR42( IDENT_INT(2)..IDENT_INT(5) ) :=
-                ARR41(
-                  IDENT_INT(1)..IDENT_INT(4) ) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           FOR  I  IN  IDENT_INT(2)..IDENT_INT(5)  LOOP
- 
-                IF  ARR42( I )  /=  FALSE  AND  I /= 3
-                THEN
-                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
-                ELSIF  ARR42( I ) /= TRUE  AND  I  = 3
-                THEN
-                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
-                END IF;
- 
-           END LOOP;
- 
-           IF  ARR42( 1 )  /=  TRUE
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (SLIDING)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 4" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C52103L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE SECOND FILE IN
- --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
- --                   STATICALLY.
- 
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- PROCEDURE  C52103L  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103L" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           ARRX31  :  TABOX3( IDENT_INT(11)..IDENT_INT(15) );
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARRX31 :=  "QUINC" ; -- "QUINC"(1..5)  SLIDES TO 11..15
- 
- 
-           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-           IF  ARRX31                                 /=  "QUINC"  OR
-               ARRX31( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
-           THEN
-                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 13" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
- 
-      DECLARE
- 
-           TYPE  TA61  IS  ARRAY(
-                INTEGER RANGE IDENT_INT(11)..IDENT_INT(15)
-                                )  OF CHARACTER ;
- 
-           ARR61  :  TA61 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR61( IDENT_INT(11)..IDENT_INT(11) )  :=  "Q"  ;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARR61( IDENT_INT(12)..IDENT_INT(15) ) :=  "UINC" ;
-                                    -- "UINC"(1..4)  SLIDES TO 12..15
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR61                                 /=  "QUINC"  OR
-               ARR61( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (6)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 6" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END  C52103L ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- C52103M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
- --                   STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- PROCEDURE  C52103M  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103M" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
-           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(9) )  := "FGHIJ" ;
- 
-      BEGIN
- 
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-           IF  ARR72 /= "ABCDE"
-           THEN
-                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR82( IDENT_INT(5)..IDENT_INT(5) )  :=  "Q"  ;
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) ) :=  "BCDE" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR82                                 /=  "QBCDE"  OR
-               ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QBCDE"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
- 
-           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(5) )  :=  "Q"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) ) :=
-                ARR91
-                ( IDENT_INT(1)..IDENT_INT(5) )
-                ( IDENT_INT(2)..IDENT_INT(5) )
-                ( IDENT_INT(2)..IDENT_INT(5) ) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR92                                 /=  "QBCDE"  OR
-               ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QBCDE"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END  C52103M ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103p.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,344 ****
- -- C52103P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- 
- WITH REPORT;
- PROCEDURE  C52103P  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103P" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
-      --                                AND PRECISELY 5 CASES FROM THE
-      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
-      --                                                  10-11-12-13-14)
-      --
-      --                              ( IN THE CURRENT DIVISION, THE 5
-      --                                FLOATING SELECTIONS ARE 10-3-12-
-      --                                -5-14 ; THUS THE 8 SELECTIONS ARE
-      --                                10-3-12-5-14-7-8-9 (IN THIS ORDER
-      --                                ).)
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
-      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
-      --
-      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
-      --        IN THE SAME DECLARATION.)
-      --
-      --
-      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
-      --        USING AGGREGATES
-      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
-      --                SEE  (5) )
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
-      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
-      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
-      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
-      --                TO THE TYPEMARK OF  ARR ),
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --        (SINCE WE ARE NOT USING AGGREGATES
-      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
-      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
-      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
-      --
-      --
-      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
-      --
-      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
-      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
-      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
-      --        ALSO WHEN NO SLIDING IS INVOLVED.)
-      --
-      --
-      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
-      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
-      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
-                                  )  OF INTEGER ;
- 
-           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(0) ,
-                                         IDENT_INT(0)..IDENT_INT(7)  );
-           SUBTYPE  TABOX02  IS  TABOX0 ;
- 
-           ARRX01  :  TABOX01 ;
-           ARRX02  :  TABOX02( IDENT_INT(7)..IDENT_INT(6) ,
-                               IDENT_INT(20)..IDENT_INT(27) );
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX02 := ARRX01 ;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 10" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TA3  IS  ARRAY(
-                INTEGER RANGE IDENT_INT(100)..IDENT_INT(99)
-                               )  OF INTEGER ;
- 
-           SUBTYPE  TA31  IS  TA3 ;
-           SUBTYPE  TA32  IS  TA3 ;
- 
-           ARR31  :  TA31 ;
-           ARR32  :  TA32 ;
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARR32 := ARR31 ;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 3" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
- 
-           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
- 
-           ARRX51  :  TABOX51 ;
-           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
-                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
-           END LOOP;
- 
-           ARRX51(2) := TRUE ;
- 
-           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
-                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
-           END LOOP;
- 
-           ARRX52(6) := FALSE ;
- 
-           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX52( IDENT_INT(6)..IDENT_INT(5) ) :=
-                ARRX51(
-                   IDENT_INT(4)..IDENT_INT(3) ) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARRX52( 5 )  /=  TRUE   OR
-               ARRX52( 6 )  /=  FALSE  OR
-               ARRX52( 7 )  /=  TRUE   OR
-               ARRX52( 8 )  /=  TRUE   OR
-               ARRX52( 9 )  /=  FALSE
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                 FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103q.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,143 ****
- -- C52103Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSWEWHERE.)
- 
- -- THIS IS THE SECOND FILE IN
- --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 2/18/83
- 
- WITH REPORT;
- PROCEDURE  C52103Q  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103Q" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
- 
-      DECLARE
- 
-           TYPE  TA51  IS  ARRAY(
-                INTEGER RANGE IDENT_INT(11)..IDENT_INT(10)
-                                )  OF CHARACTER ;
- 
-           ARR51  :  TA51 ;
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARR51 :=  "" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-           IF  ARR51           /=  ""
-           THEN
-                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (5)" );
-           END IF;
- 
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 5" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(11)..IDENT_INT(15) );
- 
-           ARRX42  :  TABOX42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARRX42  :=  "QUINC"  ;
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX42( IDENT_INT(13)..IDENT_INT(12) ) :=  "" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARRX42                                 /=  "QUINC"  OR
-               ARRX42( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (14)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 14" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103r.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,181 ****
- -- C52103R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSWEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 2/18/83
- 
- WITH REPORT;
- PROCEDURE  C52103R  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103R" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(0) )  := "" ;
-           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(4) )  ;
- 
-      BEGIN
- 
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-           IF  ARR72 /= ""
-           THEN
-                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR82( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(5) ) :=  "" ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR82                                 /=  "QUINC"  OR
-               ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
- 
-           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) )
-                ( IDENT_INT(8)..IDENT_INT(7) ) :=
-                ARR91
-                ( IDENT_INT(1)..IDENT_INT(5) )
-                ( IDENT_INT(5)..IDENT_INT(4) ) ;
- 
- 
-           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-           IF  ARR92                                 /=  "QUINC"  OR
-               ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
-           THEN
-                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52103R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103x.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52103x.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52103x.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,241 ****
- -- C52103X.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS A SPECIAL CASE IN
- 
- --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
- --                   STATICALLY
- 
- -- WHICH TREATS ARRAYS OF LENGTH GREATER THAN  INTEGER'LAST .
- --    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
- --    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE
- --    CONSTRAINT_ERROR TO BE RAISED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- RM  07/31/81
- -- SPS 10/26/82
- -- JBG 06/15/83
- -- EG  11/02/84
- -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387.
- -- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
- -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT;
- PROCEDURE  C52103X  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52103X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
-                        "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
-                        "CHECK WHETHER CONSTRAINT_ERROR " &
-                        "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS" );
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
- CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
-                     -- FOR THE TYPE DECLARATION.
-      BEGIN
- 
- DCL_ARR:  DECLARE   -- THIS BLOCK DECLARES THE ARRAY TYPE
- 
-                TYPE  TA42  IS  ARRAY(
-                     INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST)
-                                     )  OF BOOLEAN ;
-                -- CONSTRAINT_ERROR MAY BE RAISED BY THE
-                -- ARRAY TYPE DECLARATION.
-                PRAGMA PACK (TA42);
- 
-                SUBTYPE  TA41  IS  TA42 ;
- 
-           BEGIN
- 
-                COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
-                         "WITH 'LENGTH = INTEGER'LAST + 3");
- 
- OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
-                          -- HAVE INTEGER'LAST + 3 COMPONENTS;
-                          -- STORAGE_ERROR MAY BE RAISED.
-                     ARR41  :  TA41 ;
-                     ARR42  :  TA42 ;
- 
-                BEGIN
- 
-                COMMENT ("NO STORAGE_ERROR OR CONSTRAINT_ERROR RAISED " &
-                         "WHEN ALLOCATING TWO BIG BOOLEAN ARRAYS");
-                -- INITIALIZATION OF RHS ARRAY:
- 
-                -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
-                -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
-                -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
-                -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
- 
- NO_EXCP:       BEGIN     -- NO EXCEPTION SHOULD OCCUR HERE.
-                     FOR  I  IN  IDENT_INT(-2)..IDENT_INT(2)  LOOP
-                          ARR41(I)  :=  FALSE  ;  -- VALUES ARE:: FTFFT
-                     END LOOP;
- 
-                     ARR41(-1) := TRUE ;
- 
-                     ARR41( 2) := TRUE ;          -- RHS IS: F T F F T
- 
- 
-                     -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
- 
-                     ARR42( -2 )  :=  TRUE ;
- 
-                EXCEPTION
- 
-                     WHEN CONSTRAINT_ERROR =>
-                          FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
-                                  "ASSIGNING TO ARRAY COMPONENTS");
-                     WHEN OTHERS =>
-                          FAILED ("OTHER EXCEPTION RAISED - 1");
- 
-                END NO_EXCP;
- 
- DO_SLICE:      BEGIN
-                     -- SLICE ASSIGNMENT:
- 
-                     ARR42(  IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
-                          ARR41(
-                             IDENT_INT(-2)..IDENT_INT(INTEGER'LAST-1)) ;
- 
-                     COMMENT ("NO EXCEPTION RAISED DURING SLICE " &
-                              "ASSIGNMENT");
- 
-                     -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-      CHK_SLICE:     BEGIN
-                          FOR  I  IN  IDENT_INT(-1)..IDENT_INT(2)  LOOP
- 
-                               IF  ARR42( I )  /=  FALSE  AND  I /= 0
-                               THEN
-                                    FAILED( "SLICE ASSIGNMENT NOT " &
-                                            "CORRECT (VALUES)" );
-                               ELSIF  ARR42( I ) /= TRUE  AND  I  = 0
-                               THEN
-                                    FAILED( "SLICE ASSIGNMENT NOT " &
-                                            "CORRECT (VALUES)" );
-                               END IF;
- 
-                          END LOOP;
- 
-                          IF  ARR42( -2 )  /=  TRUE
-                          THEN
-                               FAILED( "SLICE ASSIGNMENT NOT CORRECT " &
-                                       "(SLIDING)" );
-                          END IF;
- 
-                     EXCEPTION
- 
-                          WHEN OTHERS =>
-                               FAILED ("SOME EXCEPTION RAISED - 2");
- 
-                     END CHK_SLICE;
- 
-                EXCEPTION
- 
-                     WHEN CONSTRAINT_ERROR =>
-                          COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
-                                   "SLICE ASSIGNMENT");
-                     WHEN STORAGE_ERROR =>
-                          COMMENT ("STORAGE_ERROR RAISED DURING SLICE " &
-                                   "ASSIGNMENT");
-                     WHEN OTHERS =>
-                          FAILED ("SOME EXCEPTION DURING SLICE " &
-                                  "ASSIGNMENT");
-                END DO_SLICE;
- 
-           END OBJ_DCL;
- 
-           EXCEPTION
- 
-                WHEN STORAGE_ERROR =>
-                     COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
-                              "TWO PACKED BOOLEAN ARRAYS WITH " &
-                              "INTEGER'LAST + 3 COMPONENTS");
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
-                              "TWO PACKED BOOLEAN ARRAYS WITH " &
-                              "INTEGER'LAST + 3 COMPONENTS");
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED - 3");
- 
-           END DCL_ARR;
- 
-      EXCEPTION
- 
- 
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
-                         "ARRAY TYPE WITH INTEGER'LAST + 3 COMPONENTS");
- 
-           WHEN STORAGE_ERROR =>
-                FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
- 
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 4");
- 
-      END CONSTR_ERR;
- 
- 
-      RESULT ;
- 
- 
- END C52103X;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,343 ****
- -- C52104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- WITH REPORT;
- PROCEDURE  C52104A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104A" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
-      --                                SERIES 10-11-12-13-14 FOLLOWED
-      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
-      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
-      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
-      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
-      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (1..6: NOT APPLICABLE)
-      --
-      --
- 
-      -------------------------------------------------------------------
- 
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
-                                  )  OF INTEGER ;
- 
-           SUBTYPE  TABOX01  IS  TABOX0( 1..5 ,  0..7  );
-           SUBTYPE  TABOX02  IS  TABOX0( 0..5 ,  2..9  );
- 
-           ARRX01  :  TABOX01 ;
-           ARRX02  :  TABOX02 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
- 
-                FOR  J  IN  0..7  LOOP
-                     ARRX01( I , J )  :=   I * I * J  ;
-                END LOOP;
- 
-           END LOOP;
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  0..5  LOOP
- 
-                FOR  J  IN  2..9  LOOP
-                     ARRX02( I , J )  :=   I * I * J * 3  ;
-                END LOOP;
- 
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX02 := ARRX01 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-                FOR  I  IN  0..5  LOOP
- 
-                     FOR  J  IN  2..9  LOOP
- 
-                          IF  ARRX02( I , J )  /=   I * I * J * 3
-                          THEN
-                               FAILED( "ORIG. VALUE ALTERED (10)" );
-                          END IF;
- 
-                     END LOOP;
- 
-                END LOOP;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
- 
-           SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
- 
-           ARRX11  :  TABOX11 ;
-           ARRX12  :  TABOX1( 6..9 );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
- 
-                ARRX11( I )  :=   I * I  ;
- 
-           END LOOP;
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  6..9  LOOP
-                ARRX12( I )  :=   I * I * 3  ;
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX12 := ARRX11 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-                FOR  I  IN  6..9  LOOP
- 
-                     IF  ARRX12( I )  /=   I * I * 3
-                     THEN
-                          FAILED( "ORIG. VALUE ALTERED (11)" );
-                     END IF;
- 
-                END LOOP;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
- 
-           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
- 
-           ARRX51  :  TABOX51 ;
-           ARRX52  :  TABOX5( 5..9 );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  5..9  LOOP
-                ARRX52( I )  :=  FALSE  ;
-           END LOOP;
- 
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
-                ARRX51( I )  :=  TRUE  ;
-           END LOOP;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARRX52(6..9) := ARRX51(3..3) ;
-           FAILED( "EXCEPTION NOT RAISED  (12)" );
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                FOR  I  IN  5..9  LOOP
- 
-                     IF  ARRX52( I )  /=  FALSE
-                     THEN
-                          FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
-                     END IF;
- 
-                END LOOP;
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- C52104B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE SECOND FILE IN
- --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- WITH REPORT;
- PROCEDURE  C52104B  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104B" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           ARRX31  :  TABOX3( 2..6 )  :=  "QUINC"  ;
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARRX31 :=  "ABCD" ;
-           FAILED( "NO EXCEPTION RAISED  (13)" );
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-                IF  ARRX31           /=  "QUINC"  OR
-                    ARRX31(  2..6  ) /=  "QUINC"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (13)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           SUBTYPE  TABOX42  IS  TABOX4( 5..9 );
- 
-           ARRX42  :  TABOX42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARRX42  :=  "QUINC"  ;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARRX42( 6..9 )  :=  "ABCDEFGH"  ;
-           FAILED( "NO EXCEPTION RAISED  (14)" );
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-                IF  ARRX42           /=  "QUINC"  OR
-                    ARRX42(  5..9  ) /=  "QUINC"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (14)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,178 ****
- -- C52104C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- WITH REPORT;
- PROCEDURE  C52104C  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104C" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( 1..5 )  := "ABCDE" ;
-           ARR72  :  STRING( 5..8 )  := "FGHI"  ;
- 
-      BEGIN
- 
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF  ARR72 /= "FGHI"
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( 5..9 )  :=  "QBCDE"  ;
- 
-      BEGIN
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( 5..9 )( 6..9 ) :=  "EIN" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARR82           /=  "QBCDE"  OR
-                    ARR82(  5..9  ) /=  "QBCDE"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (8)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
- 
-           ARR91  :  STRING( 1..7 )  := "ABCDEFG" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR92( 5..9 )  :=  "QUINC"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( 5..9 )( 6..9 ) :=  ARR91( 1..7 )( 1..6 )( 1..6 ) ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARR92           /=  "QUINC"  OR
-                    ARR92(  5..9  ) /=  "QUINC"
-                THEN
-                     FAILED( "LHS VALUE ALTERED  (9)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,292 ****
- -- C52104F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSWEWHERE.)
- 
- --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 10/27/82
- 
- WITH REPORT;
- PROCEDURE  C52104F  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104F" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
-      --                                SERIES 10-11-12-13-14 FOLLOWED
-      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
-      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
-      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
-      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (1 .. 6: NOT APPLICABLE)
-      --
-      --
- 
-      -------------------------------------------------------------------
- 
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
-                                  )  OF INTEGER ;
- 
-           SUBTYPE  TABOX01  IS  TABOX0( 1..1 ,  0..7  );
-           SUBTYPE  TABOX02  IS  TABOX0 ;
- 
-           ARRX01  :  TABOX01 ;
-           ARRX02  :  TABOX02( 1..0 , 0..7 );
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX02 := ARRX01 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                NULL ;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
- 
-           SUBTYPE  TABOX11  IS  TABOX1( 4..5 ) ;
- 
-           ARRX11  :  TABOX11 ;
-           ARRX12  :  TABOX1( 5..4 );
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX12 := ARRX11 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                NULL ;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
- 
-           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
- 
-           ARRX51  :  TABOX51 ;
-           ARRX52  :  TABOX5( 5..9 );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  1..5  LOOP
-                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
-           END LOOP;
- 
-           ARRX51(2) := TRUE ;
- 
-           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  5..9  LOOP
-                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
-           END LOOP;
- 
-           ARRX52(6) := FALSE ;
- 
-           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX52( 6..5 ) := ARRX51( 4..4 ) ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
-                IF  ARRX52( 5 )  /=  TRUE   OR
-                    ARRX52( 6 )  /=  FALSE  OR
-                    ARRX52( 7 )  /=  TRUE   OR
-                    ARRX52( 8 )  /=  TRUE   OR
-                    ARRX52( 9 )  /=  FALSE
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (12)" );
-                END IF;
- 
-           WHEN  OTHERS =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- C52104G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE SECOND FILE IN
- --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- -- JBG 4/24/84
- 
- WITH REPORT;
- PROCEDURE  C52104G  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104G" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX3  IS  ARRAY( NATURAL RANGE <> )  OF CHARACTER ;
- 
-           ARRX31  :  TABOX3( 11..10 )  :=  ""  ;
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARRX31 :=  "AZ" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 13" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARRX31  /=  ""
-                THEN
-                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
-                END IF;
- 
-           WHEN  OTHERS =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           SUBTYPE  TABOX42  IS  TABOX4( 11..15 );
- 
-           ARRX42  :  TABOX42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARRX42  :=  "QUINC"  ;
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX42( 13..12 ) :=  "ABCD" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 14" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARRX42           /=  "QUINC"  OR
-                    ARRX42( 11..15 ) /=  "QUINC"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (14)" );
-                END IF;
- 
-           WHEN  OTHERS =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- C52104H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- WITH REPORT;
- PROCEDURE  C52104H  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104H" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( 1..1 )  := "A" ;
-           ARR72  :  STRING( 5..4 )  := ""  ;
- 
-      BEGIN
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF  ARR72 /= ""
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( 5..9 ) ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR82( 5..9 )  :=  "QUINC"  ;
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( 5..9 )( 6..9 )( 6..5 ) :=  "ABC" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF  ARR82           /=  "QUINC"  OR
-                    ARR82(  5..9  ) /=  "QUINC"
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (8)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
- 
-           ARR91  :  STRING( 1..5 )  := "ABCDE" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR92( 5..9 )  :=  "QUINC"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( 5..9 )( 6..9 )( 8..7 ) :=  ARR91( 1..5 )( 5..7 ) ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF ARR92           /=  "QUINC"  OR
-                   ARR92(  5..9  ) /=  "QUINC"
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (9)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,347 ****
- -- C52104K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- --    DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- WITH REPORT;
- PROCEDURE  C52104K  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
-      --                                SERIES 10-11-12-13-14 FOLLOWED
-      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
-      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
-      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
-      --    (-) THE STATIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
-      --        VISIONS A (FOR NON-NULL ARRAYS) AND B (FOR NULL ARRAYS).
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (1..6: NOT APPLICABLE)
-      --
-      --
- 
-      -------------------------------------------------------------------
- 
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
-                                  )  OF INTEGER ;
- 
-           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(5) ,
-                                         IDENT_INT(0)..IDENT_INT(7) );
-           SUBTYPE  TABOX02  IS  TABOX0( IDENT_INT(0)..IDENT_INT(5) ,
-                                         IDENT_INT(2)..IDENT_INT(9) );
- 
-           ARRX01  :  TABOX01 ;
-           ARRX02  :  TABOX02 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
- 
-                FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
-                     ARRX01( I , J )  :=   I * I * J  ;
-                END LOOP;
- 
-           END LOOP;
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
- 
-                FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
-                     ARRX02( I , J )  :=   I * I * J * 3  ;
-                END LOOP;
- 
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX02 := ARRX01 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-                FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
- 
-                     FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
- 
-                          IF  ARRX02( I , J )  /=   I * I * J * 3
-                          THEN
-                               FAILED( "ORIG. VALUE ALTERED (10)" );
-                          END IF;
- 
-                     END LOOP;
- 
-                END LOOP;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
- 
-           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ;
- 
-           ARRX11  :  TABOX11 ;
-           ARRX12  :  TABOX1( IDENT_INT(6)..IDENT_INT(9) );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
- 
-                ARRX11( I )  :=   I * I  ;
- 
-           END LOOP;
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
-                ARRX12( I )  :=   I * I * 3  ;
-           END LOOP;
- 
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX12 := ARRX11 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
- 
-                FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
- 
-                     IF  ARRX12( I )  /=   I * I * 3
-                     THEN
-                          FAILED( "ORIG. VALUE ALTERED (11)" );
-                     END IF;
- 
-                END LOOP;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
- 
-           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
- 
-           ARRX51  :  TABOX51 ;
-           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
-                ARRX52( I )  :=  FALSE  ;
-           END LOOP;
- 
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
-                ARRX51( I )  :=  TRUE  ;
-           END LOOP;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARRX52( IDENT_INT(6)..IDENT_INT(9) ) :=
-                ARRX51(
-                   IDENT_INT(3)..IDENT_INT(3) ) ;
-           FAILED( "EXCEPTION NOT RAISED  (12)" );
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
- 
-                     IF  ARRX52( I )  /=  FALSE
-                     THEN
-                          FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
-                     END IF;
- 
-                END LOOP;
- 
-           WHEN  OTHERS  =>
-                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- C52104L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --     MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --     ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --     INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --     (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --     ARE TREATED ELSEWHERE.)
- 
- --     THIS IS THE SECOND FILE IN
- --     DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- -- HISTORY:
- --     RM  07/20/81 CREATED ORIGINAL TEST.
- --     SPS 03/22/83
- --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT;
- PROCEDURE  C52104L  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104L" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           ARRX31  :  TABOX3( IDENT_INT(2)..IDENT_INT(6) )  := "QUINC" ;
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARRX31 :=  "ABCD" ;
-           FAILED( "NO EXCEPTION RAISED  (13)" );
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-                IF  ARRX31                               /=  "QUINC"  OR
-                    ARRX31( IDENT_INT(2)..IDENT_INT(6) ) /=  "QUINC"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (13)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(5)..IDENT_INT(9) );
- 
-           ARRX42  :  TABOX42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARRX42  :=  "QUINC"  ;
- 
- 
-           -- SLICE ASSIGNMENT:
- 
-           ARRX42( IDENT_INT(6)..IDENT_INT(9) )  :=  "ABCDEFGH"  ;
-           FAILED( "NO EXCEPTION RAISED  (14)" );
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
- 
-                IF  ARRX42                               /=  "QUINC"  OR
-                    ARRX42( IDENT_INT(5)..IDENT_INT(9) ) /=  "QUINC"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (14)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- C52104M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- WITH REPORT;
- PROCEDURE  C52104M  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104M" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
-           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(8) )  := "FGHI"  ;
- 
-      BEGIN
- 
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF  ARR72 /= "FGHI"
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) )  :=  "QBCDE"  ;
- 
-      BEGIN
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) ) :=  "EIN" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARR82                               /=  "QBCDE"  OR
-                    ARR82( IDENT_INT(5)..IDENT_INT(9) ) /=  "QBCDE"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (8)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
- 
-           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(7) )  := "ABCDEFG" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) ) :=
-                ARR91
-                ( IDENT_INT(1)..IDENT_INT(7) )
-                ( IDENT_INT(1)..IDENT_INT(6) )
-                ( IDENT_INT(1)..IDENT_INT(6) ) ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARR92                               /=  "QUINC"  OR
-                    ARR92( IDENT_INT(5)..IDENT_INT(9) ) /=  "QUINC"
-                THEN
-                     FAILED( "LHS VALUE ALTERED  (9)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104p.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,292 ****
- -- C52104P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- 
- 
- WITH REPORT;
- PROCEDURE  C52104P  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104P" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
-      --
-      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
-      --                                SERIES 10-11-12-13-14 FOLLOWED
-      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
-      --
-      --
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
-      --
-      --
-      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
-      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
-      --
-      --
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
-      --
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
-      --
-      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
-      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
-      --
-      --
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
-      --
-      --
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
-      --
-      --
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
-      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
-      --        BY THE TYPEMARK WILL NOT BE  1 .)
-      --
-      --
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
-      --
-      --
-      --
-      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
-      --                                            ARRAYS ONLY,
-      --                                            DIVISIONS C AND D .)
-      --
-      --
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (1 .. 6: NOT APPLICABLE)
-      --
-      --
- 
-      -------------------------------------------------------------------
- 
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
-                                  )  OF INTEGER ;
- 
-           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(1) ,
-                                         IDENT_INT(0)..IDENT_INT(7)  );
-           SUBTYPE  TABOX02  IS  TABOX0 ;
- 
-           ARRX01  :  TABOX01 ;
-           ARRX02  :  TABOX02( IDENT_INT(1)..IDENT_INT(0) ,
-                               IDENT_INT(0)..IDENT_INT(7) );
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX02 := ARRX01 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                NULL ;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
- 
-      DECLARE
- 
-           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
- 
-           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(4)..IDENT_INT(5) ) ;
- 
-           ARRX11  :  TABOX11 ;
-           ARRX12  :  TABOX1( IDENT_INT(5)..IDENT_INT(4) );
- 
-      BEGIN
- 
-           -- ARRAY ASSIGNMENT:
- 
-           ARRX12 := ARRX11 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                NULL ;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
-      DECLARE
- 
-           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
- 
-           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
- 
-           ARRX51  :  TABOX51 ;
-           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
- 
-      BEGIN
- 
-           -- INITIALIZATION OF RHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
-                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
-           END LOOP;
- 
-           ARRX51(2) := TRUE ;
- 
-           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
-                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
-           END LOOP;
- 
-           ARRX52(6) := FALSE ;
- 
-           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX52( IDENT_INT(6)..IDENT_INT(5) ) :=
-                ARRX51
-                 ( IDENT_INT(4)..IDENT_INT(4) ) ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
-                IF  ARRX52( 5 )  /=  TRUE   OR
-                    ARRX52( 6 )  /=  FALSE  OR
-                    ARRX52( 7 )  /=  TRUE   OR
-                    ARRX52( 8 )  /=  TRUE   OR
-                    ARRX52( 9 )  /=  FALSE
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (12)" );
-                END IF;
- 
-           WHEN  OTHERS =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104q.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- C52104Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE SECOND FILE IN
- --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- -- JBG 4/24/84
- 
- WITH REPORT;
- PROCEDURE  C52104Q  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104Q" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX3  IS  ARRAY( NATURAL RANGE <> )  OF CHARACTER ;
- 
-           ARRX31  :  TABOX3( IDENT_INT(11)..IDENT_INT(10) )  :=  ""  ;
- 
-      BEGIN
- 
- 
-           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
- 
-           ARRX31 :=  "AZ" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 13" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARRX31  /=  ""
-                THEN
-                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
-                END IF;
- 
-           WHEN  OTHERS =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
- 
-      DECLARE
- 
-           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
- 
-           SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(11)..IDENT_INT(15) );
- 
-           ARRX42  :  TABOX42 ;
- 
-      BEGIN
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARRX42  :=  "QUINC"  ;
- 
- 
-           -- NULL SLICE ASSIGNMENT:
- 
-           ARRX42( IDENT_INT(13)..IDENT_INT(12) ) :=  "ABCD" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 14" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
- 
-                IF  ARRX42                                 /= "QUINC"  OR
-                    ARRX42( IDENT_INT(11)..IDENT_INT(15) ) /= "QUINC"
-                THEN
-                     FAILED( "LHS ARRAY ALTERED  (14)" );
-                END IF;
- 
-           WHEN  OTHERS =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104r.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,190 ****
- -- C52104R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS THE THIRD FILE IN
- --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
- 
- 
- -- RM 07/20/81
- -- SPS 3/22/83
- 
- WITH REPORT;
- PROCEDURE  C52104R  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104R" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
- 
- 
-      --                              ( EACH DIVISION COMPRISES 3 FILES,
-      --                                COVERING RESPECTIVELY THE FIRST
-      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
-      --                                SELECTIONS FOR THE DIVISION.)
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
- 
-      DECLARE
- 
-           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(1) )  := "A" ;
-           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(4) )  := ""  ;
- 
-      BEGIN
- 
-           -- STRING ASSIGNMENT:
- 
-           ARR72 := ARR71 ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF  ARR72 /= ""
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
-      --        STRING LITERALS.
-      --
- 
-      DECLARE
- 
-           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR82( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
- 
- 
-           -- STRING LITERAL ASSIGNMENT:
- 
-           ARR82( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(5) ) := "ABC" ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF  ARR82                                 /=  "QUINC"  OR
-                    ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (8)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
-      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
-      --        THEMSELVES).
-      --
- 
-      DECLARE
- 
-           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
- 
-           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
-           ARR92  :  TA92 ;
- 
-      BEGIN
- 
- 
-           -- INITIALIZATION OF LHS ARRAY:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
- 
- 
-           -- STRING SLICE ASSIGNMENT:
- 
-           ARR92( IDENT_INT(5)..IDENT_INT(9) )
-                ( IDENT_INT(6)..IDENT_INT(9) )
-                ( IDENT_INT(8)..IDENT_INT(7) ) :=
-                ARR91
-                ( IDENT_INT(1)..IDENT_INT(5) )
-                ( IDENT_INT(5)..IDENT_INT(7) ) ;
-           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
- 
-      EXCEPTION
- 
-           WHEN  CONSTRAINT_ERROR =>
- 
-                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
- 
-                IF ARR92                                 /=  "QUINC"  OR
-                   ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
-                THEN
-                     FAILED( "ORIGINAL VALUE ALTERED (9)" );
-                END IF;
- 
-           WHEN  OTHERS  =>
- 
-                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END C52104R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104x.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104x.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104x.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,222 ****
- -- C52104X.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS A SPECIAL CASE IN
- 
- --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
- --                   STATICALLY
- 
- -- WHICH TREATS ARRAYS OF LENGTH GREATER THAN  INTEGER'LAST .
- --    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
- --    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE
- --    CONSTRAINT_ERROR TO BE RAISED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- RM  07/31/81
- -- SPS 02/07/83
- -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387.
- -- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
- -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X INCOMPATIBILITY
- 
- WITH REPORT;
- PROCEDURE  C52104X  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
-                        "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
-                        "CHECK WHETHER CONSTRAINT_ERROR " &
-                        "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS");
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
-      --        WERE DEFINED USING THE "BOX" SYMBOL
-      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
-      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
- 
- CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
-                     -- FOR THE SUBTYPE DECLARATION.
-      BEGIN
- 
- DCL_ARR:  DECLARE        -- THIS BLOCK DECLARES THE ARRAY SUBTYPE.
- 
-                TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
-                PRAGMA PACK (TABOX5);
- 
-                SUBTYPE  TABOX51  IS  TABOX5
-                              (IDENT_INT(-6)..IDENT_INT(INTEGER'LAST-4));
-                -- CONSTRAINT_ERROR MAY BE RAISED BY THIS
-                -- SUBTYPE DECLARATION.
- 
-           BEGIN
- 
-                COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
-                         "WITH 'LENGTH = INTEGER'LAST + 3");
- 
- OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
-                          -- HAVE INTEGER'LAST + 3 COMPONENTS;
-                          -- STORAGE_ERROR MAY BE RAISED.
-                     ARRX51  :  TABOX51 ;
-                     ARRX52  :  TABOX5
-                              (IDENT_INT(-2)..IDENT_INT( INTEGER'LAST));
- 
-                BEGIN
- 
-                COMMENT ("NO STORAGE_ERROR OR " &
-                         "CONSTRAINT_ERROR RAISED WHEN ALLOCATING TWO " &
-                         "BIG BOOLEAN ARRAYS");
- 
-                -- INITIALIZATION OF LHS ARRAY:
- 
- NO_EXCP:       BEGIN          -- NO EXCEPTION SHOULD OCCUR IN THIS BLOCK
-                     FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
-                          ARRX52( I )  :=  FALSE  ;
-                     END LOOP;
- 
- 
-                -- INITIALIZATION OF RHS ARRAY:
- 
-                -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
-                -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
-                -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
-                -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
- 
-                     FOR  I  IN  IDENT_INT(-6)..IDENT_INT(5)  LOOP
-                          ARRX51( I )  :=  TRUE  ;
-                     END LOOP;
- 
-                EXCEPTION
- 
-                     WHEN CONSTRAINT_ERROR =>
-                          FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
-                                  "ASSIGNING TO ARRAY COMPONENTS");
-                     WHEN OTHERS =>
-                          FAILED ("OTHER EXCEPTION RAISED - 1");
- 
-                END NO_EXCP;
- 
- DO_SLICE:      BEGIN
-                -- SLICE ASSIGNMENT:
- 
-                     ARRX52( IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
-                          ARRX51(
-                             IDENT_INT(-4)..IDENT_INT(INTEGER'LAST-4) ) ;
-                     FAILED( "EXCEPTION NOT RAISED  (12)" );
- 
-                EXCEPTION
- 
-                     WHEN CONSTRAINT_ERROR =>
- 
-                          COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
-                                   "CHECK FOR SLICE ASSIGNMENT");
- 
-                          -- CHECKING THE VALUES AFTER THE SLICE
-                          -- ASSIGNMENT:
- 
-                          FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
- 
-                               IF  ARRX52( I )  /=  FALSE
-                               THEN
-                                    FAILED( "LHS ARRAY ALTERED  (12A)");
-                               END IF;
- 
-                          END LOOP;
- 
- 
-                     WHEN STORAGE_ERROR =>
-                          COMMENT ("STORAGE_ERROR RAISED DURING CHECK " &
-                                   "FOR SLICE ASSIGNMENT");
- 
-                     WHEN OTHERS =>
-                          FAILED ("SOME EXCEPTION RAISED DURING SLICE");
- 
-                END DO_SLICE;
- 
-           END OBJ_DCL;
- 
-           EXCEPTION
- 
-                WHEN STORAGE_ERROR =>
-                     COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
-                              "TWO PACKED BOOLEAN ARRAYS WITH " &
-                              "INTEGER'LAST + 3 COMPONENTS");
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
-                              "TWO PACKED BOOLEAN ARRAYS WITH " &
-                              "INTEGER'LAST + 3 COMPONENTS");
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED - 3");
- 
-           END DCL_ARR;
- 
-      EXCEPTION
- 
- 
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
-                         "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
-                         "COMPONENTS");
- 
-           WHEN STORAGE_ERROR =>
-                FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
- 
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 4");
- 
-      END CONSTR_ERR;
- 
-      RESULT ;
- 
- END C52104X;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104y.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104y.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c52104y.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c52104y.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- -- C52104Y.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
- --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
- --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- -- THIS IS A SPECIAL CASE IN
- 
- --    DIVISION  D :  NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
- --                   STATICALLY
- 
- -- WHICH (THE SPECIAL CASE) TREATS TWO-DIMENSIONAL ARRAYS WHOSE LENGTH
- --    ALONG ONE DIMENSION IS GREATER THAN  INTEGER'LAST  AND WHOSE
- --    LENGTH ALONG THE OTHER DIMENSION IS  0 .
- --    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
- --    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE  CONSTRAINT_ERROR
- --    TO BE RAISED.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- RM  07/31/81
- -- SPS 03/22/83
- -- JBG 06/16/83
- -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387.
- -- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT;
- PROCEDURE  C52104Y  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C52104Y" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
-                        " ASSIGNMENTS, THE LENGTHS MUST MATCH" );
- 
-      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
-      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
-      --
-      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
-      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
- 
- 
-      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
-      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
-      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
-      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
-      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
-      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
-      --    INTEGER , CHARACTER , BOOLEAN .)
- 
- 
-      -------------------------------------------------------------------
- 
-      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
-      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
-      --        (TWO-DIMENSIONAL ARRAYS OF BOOLEANS.)
- 
- CONSTR_ERR:
-      BEGIN          -- THIS BLOCK CATCHES CONSTRAINT_ERROR IF IT IS
-                     -- RAISED BY THE SUBTYPE DECLARATION.
- 
- DCL_ARR:  DECLARE
- 
-                TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> ,
-                                         INTEGER RANGE <> )  OF BOOLEAN ;
-                PRAGMA PACK (TABOX5);
- 
-                SUBTYPE  TABOX52  IS  TABOX5(
-                          IDENT_INT(13)..IDENT_INT(       13       ) ,
-                          IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
- 
-           BEGIN
- 
-                COMMENT ("NO CONSTRAINT_ERROR FOR NON-NULL ARRAY SUBTYPE " &
-                         "WHEN ONE DIMENSION HAS INTEGER'LAST + 3 " &
-                         "COMPONENTS");
- 
- OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES ONE NULL ARRAY AND ONE
-                          -- PACKED BOOLEAN ARRAY WITH INTEGER'LAST + 3
-                          -- COMPONENTS;  STORAGE ERROR MAY BE RAISED.
- 
-                     ARRX51  :  TABOX5(
-                          IDENT_INT(13)..IDENT_INT(       12       ) ,
-                          IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
-                     ARRX52  :  TABOX52 ;     -- BIG ARRAY HERE.
- 
-                BEGIN
- 
-                     COMMENT ("NO CONSTRAINT OR STORAGE ERROR WHEN ARRAY "&
-                             "WITH INTEGER'LAST+3 COMPONENTS ALLOCATED");
- 
-                -- NULL ARRAY ASSIGNMENT:
- 
-                     ARRX52 := ARRX51 ;
-                     FAILED( "EXCEPTION NOT RAISED  (10)" );
- 
-                EXCEPTION
- 
-                     WHEN CONSTRAINT_ERROR =>
-                          COMMENT ("CONSTRAINT_ERROR RAISED WHEN " &
-                                   "CHECKING LENGTHS FOR ARRAY HAVING " &
-                                   "> INTEGER'LAST COMPONENTS ON ONE " &
-                                   "DIMENSION");
- 
- 
-                     WHEN  OTHERS  =>
-                          FAILED( "OTHER EXCEPTION RAISED - SUBTEST 10");
- 
-                END OBJ_DCL;
- 
-           EXCEPTION
- 
-                WHEN STORAGE_ERROR =>
-                     COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING ONE "&
-                              "PACKED BOOLEAN ARRAY WITH INTEGER'LAST "&
-                              "+ 3 COMPONENTS");
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING "&
-                              "ONE PACKED BOOLEAN ARRAY WITH "&
-                              "INTEGER'LAST + 3 COMPONENTS");
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED - 3");
- 
-           END DCL_ARR;
- 
-      EXCEPTION
- 
- 
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
-                         "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
-                         "COMPONENTS");
- 
-           WHEN STORAGE_ERROR =>
-                FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
- 
-           WHEN  OTHERS  =>
-                FAILED( "OTHER EXCEPTION RAISED - 4");
- 
-      END CONSTR_ERR;
- 
-      RESULT ;
- 
- END C52104Y;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c53007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c53007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c53007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c53007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,139 ****
- -- C53007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONTROL FLOWS CORRECTLY IN SIMPLE NESTED IF_STATEMENTS.
- 
- -- JRK 7/23/80
- -- SPS 3/4/83
- 
- WITH REPORT;
- PROCEDURE C53007A IS
- 
-      USE REPORT;
- 
-      CI1 : CONSTANT INTEGER := 1;
-      CI9 : CONSTANT INTEGER := 9;
-      CBT : CONSTANT BOOLEAN := TRUE;
-      CBF : CONSTANT BOOLEAN := FALSE;
- 
-      VI1 : INTEGER := IDENT_INT(1);
-      VI9 : INTEGER := IDENT_INT(9);
-      VBT : BOOLEAN := IDENT_BOOL(TRUE);
-      VBF : BOOLEAN := IDENT_BOOL(FALSE);
- 
-      FLOW_COUNT : INTEGER := 0;
- 
- BEGIN
-      TEST ("C53007A", "CHECK THAT CONTROL FLOWS CORRECTLY IN SIMPLE " &
-            "NESTED IF_STATEMENTS");
- 
-      IF VBF THEN  -- (FALSE)
-           FAILED ("INCORRECT CONTROL FLOW 1");
-      ELSIF CI9 < 20 THEN  -- (TRUE)
-           FLOW_COUNT := FLOW_COUNT + 1;
-           IF VI1 /= 0 AND TRUE THEN  -- (TRUE)
-                FLOW_COUNT := FLOW_COUNT + 1;
-           ELSE FAILED ("INCORRECT CONTROL FLOW 2");
-           END IF;
-      ELSE FAILED ("INCORRECT CONTROL FLOW 3");
-      END IF;
- 
-      IF CBF OR ELSE VI9 = 9 THEN  -- (TRUE)
-           IF VI1 + CI9 > 0 OR (CBF AND VBT) THEN  -- (TRUE)
-                FLOW_COUNT := FLOW_COUNT + 1;
-           END IF;
-      ELSIF VBF OR VI1 > 10 THEN  -- (FALSE)
-           FAILED ("INCORRECT CONTROL FLOW 4");
-      END IF;
- 
-      IF NOT CBT AND THEN NOT VBT AND THEN CI9 < 0 THEN  -- (FALSE)
-           IF FALSE OR NOT TRUE THEN  -- (FALSE)
-                FAILED ("INCORRECT CONTROL FLOW 5");
-           ELSIF VI1 >= 0 THEN  -- (TRUE)
-                NULL;
-           ELSE FAILED ("INCORRECT CONTROL FLOW 6");
-           END IF;
-           FAILED ("INCORRECT CONTROL FLOW 7");
-      ELSIF (VI1 * CI9 + 3 < 0) OR (VBT AND NOT (CI1 < 0)) THEN -- (TRUE)
-           FLOW_COUNT := FLOW_COUNT + 1;
-           IF NOT CBT OR ELSE CI9 + 1 = 0 THEN  -- (FALSE)
-                FAILED ("INCORRECT CONTROL FLOW 8");
-           ELSE FLOW_COUNT := FLOW_COUNT + 1;
-                IF VI1 * 2 > 0 THEN  -- (TRUE)
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                ELSIF TRUE THEN  -- (TRUE)
-                     FAILED ("INCORRECT CONTROL FLOW 9");
-                ELSE NULL;
-                END IF;
-           END IF;
-      ELSIF FALSE AND CBF THEN  -- (FALSE)
-           FAILED ("INCORRECT CONTROL FLOW 10");
-      ELSE IF VBT THEN  -- (TRUE)
-                FAILED ("INCORRECT CONTROL FLOW 11");
-           ELSIF VI1 = 0 THEN  -- (FALSE)
-                FAILED ("INCORRECT CONTROL FLOW 12");
-           ELSE FAILED ("INCORRECT CONTROL FLOW 13");
-           END IF;
-      END IF;
- 
-      IF 3 = 5 OR NOT VBT THEN  -- (FALSE)
-           FAILED ("INCORRECT CONTROL FLOW 14");
-           IF TRUE AND CBT THEN  -- (TRUE)
-                FAILED ("INCORRECT CONTROL FLOW 15");
-           ELSE FAILED ("INCORRECT CONTROL FLOW 16");
-           END IF;
-      ELSIF CBF THEN  -- (FALSE)
-           IF VI9 >= 0 OR FALSE THEN  -- (TRUE)
-                IF VBT THEN  -- (TRUE)
-                     FAILED ("INCORRECT CONTROL FLOW 17");
-                END IF;
-                FAILED ("INCORRECT CONTROL FLOW 18");
-           ELSIF VI1 + CI9 /= 0 THEN  -- (TRUE)
-                FAILED ("INCORRECT CONTROL FLOW 19");
-           END IF;
-           FAILED ("INCORRECT CONTROL FLOW 20");
-      ELSE IF VBT AND CI9 - 9 = 0 THEN  -- (TRUE)
-                IF FALSE THEN  -- (FALSE)
-                     FAILED ("INCORRECT CONTROL FLOW 21");
-                ELSIF NOT VBF AND THEN CI1 > 0 THEN  -- (TRUE)
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                ELSE FAILED ("INCORRECT CONTROL FLOW 22");
-                END IF;
-                FLOW_COUNT := FLOW_COUNT + 1;
-           ELSIF NOT CBF OR VI1 /= 0 THEN  -- (TRUE)
-                IF VBT THEN  -- (TRUE)
-                     NULL;
-                END IF;
-                FAILED ("INCORRECT CONTROL FLOW 23");
-           ELSE FAILED ("INCORRECT CONTROL FLOW 24");
-           END IF;
-           FLOW_COUNT := FLOW_COUNT + 1;
-      END IF;
- 
-      IF FLOW_COUNT /= 9 THEN
-           FAILED ("INCORRECT FLOW_COUNT VALUE");
-      END IF;
- 
-      RESULT;
- END C53007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c540001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c540001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c540001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c540001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,410 ****
- -- C540001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an expression in a case statement may be of a generic formal
- --      type.  Check that a function call may be used as a case statement 
- --      expression.  Check that a call to a generic formal function may be 
- --      used as a case statement expression.  Check that a call to an inherited
- --      function may be used as a case statement expression even if its result
- --      type does not correspond to any nameable subtype.
- --
- -- TEST DESCRIPTION:
- --      This transition test creates examples where expressions in a case
- --      statement can be a generic formal object and a call to a generic formal
- --      function.  This test also creates examples when either a function call,
- --      a renaming of a function, or a call to an inherited function is used
- --      in the case expressions, the choices of the case statement only need 
- --      to cover the values in the result of the function.
- --
- --      Inspired by B54A08A.ADA.
- --
- --
- -- CHANGE HISTORY:
- --      12 Feb 96   SAIC    Initial version for ACVC 2.1.
- --
- --!
- 
- package C540001_0 is 
-    type Int is range 1 .. 2;
- 
- end C540001_0;
- 
-      --==================================================================--
- 
- with C540001_0;
- package C540001_1 is 
-    type Enum_Type is (Eh, Bee, Sea, Dee); -- Range of Enum_Type'Val is 0..3.
-    type Mixed     is ('A','B', 'C', None); 
-    subtype Small_Num is Natural range 0 .. 10;
-    type Small_Int is range 1 .. 2;
-    function Get_Small_Int (P : Boolean) return Small_Int;
-    procedure Assign_Mixed (P1 : in     Boolean;
-                            P2 :    out Mixed);
- 
-    type Tagged_Type is tagged
-      record
-         C1 : Enum_Type;
-      end record;
-    function Get_Tagged (P : Tagged_Type) return C540001_0.Int;
- 
- end C540001_1;
- 
-      --==================================================================--
- 
- package body C540001_1 is 
-    function Get_Small_Int (P : Boolean) return Small_Int is
-    begin
-       if P then
-          return Small_Int'First;
-       else
-          return Small_Int'Last; 
-       end if;
-    end Get_Small_Int;
- 
-    ---------------------------------------------------------------------
-    procedure Assign_Mixed (P1 : in     Boolean;
-                            P2 :    out Mixed) is
-    begin
-       case Get_Small_Int (P1) is          -- Function call as expression
-            when 1  => P2 := None;         -- in case statement.
-            when 2  => P2 := 'A';
-            -- No others needed.
-       end case;
- 
-    end Assign_Mixed;
- 
-    ---------------------------------------------------------------------
-    function Get_Tagged (P : Tagged_Type) return C540001_0.Int is
-    begin
-       return C540001_0.Int'Last;
-    end Get_Tagged;
- 
- end C540001_1;
- 
-      --==================================================================--
- 
- generic               
- 
-    type Formal_Scalar is range <>;  
- 
-    FSO : Formal_Scalar;
- 
- package C540001_2 is              
- 
-    type Enum is (Alpha, Beta, Theta);
- 
-    procedure Assign_Enum (ET : out Enum);
- 
- end C540001_2;
- 
-      --==================================================================--
- 
- package body C540001_2 is              
- 
-    procedure Assign_Enum (ET : out Enum) is
-    begin
-       case FSO is                         -- Type of expression in case
-            when 1      => ET := Alpha;    -- statement is generic formal type.
-            when 2      => ET := Beta;
-            when others => ET := Theta;
-       end case;
- 
-    end Assign_Enum;
- 
- end C540001_2;
- 
-      --==================================================================--
- 
- with C540001_1;
- generic               
- 
-    type Formal_Enum_Type is new C540001_1.Enum_Type;
- 
-    with function Formal_Func (P : C540001_1.Small_Num) 
-      return Formal_Enum_Type is <>;
- 
- function C540001_3 (P : C540001_1.Small_Num) return Formal_Enum_Type;
- 
-      --==================================================================--
- 
- function C540001_3 (P : C540001_1.Small_Num) return Formal_Enum_Type is
- 
- begin
-    return Formal_Func (P);
- end C540001_3;
- 
-      --==================================================================--
- 
- with C540001_1;
- generic               
- 
-    type Formal_Int_Type is new C540001_1.Small_Int;
- 
-    with function Formal_Func return Formal_Int_Type;
- 
- package C540001_4 is
- 
-    procedure Gen_Assign_Mixed (P : out C540001_1.Mixed);
- 
- end C540001_4;
- 
-      --==================================================================--
- 
- package body C540001_4 is
- 
-    procedure Gen_Assign_Mixed (P : out C540001_1.Mixed) is
-    begin
-       case Formal_Func is                          -- Case expression is
-          when 1      => P := C540001_1.'A';        -- generic function.
-          when others => P := C540001_1.'B';
-       end case;
- 
-    end Gen_Assign_Mixed;
- 
- end C540001_4;
- 
-      --==================================================================--
- 
- with C540001_1;
- package C540001_5 is
-    type New_Tagged is new C540001_1.Tagged_Type with
-       record
-          C2 : C540001_1.Mixed;
-       end record;
- 
-     -- Inherits Get_Tagged (P : New_Tagged) return C540001_0.Int;
-     -- Note that the return type of the inherited function is not
-     -- nameable here.
- 
-    procedure Assign_Tagged (P1 : in     New_Tagged;
-                             P2 :    out New_Tagged);
- 
- end C540001_5;
- 
-      --==================================================================--
- 
- package body C540001_5 is
- 
-    procedure Assign_Tagged (P1 : in     New_Tagged;
-                             P2 :    out New_Tagged) is
-    begin
-       case Get_Tagged (P1) is                      -- Case expression is
-                                                    -- inherited function.
-          when 2      => P2 := (C540001_1.Bee, 'B');       
-          when others => P2 := (C540001_1.Sea, C540001_1.None);
-       end case;
- 
-    end Assign_Tagged;
- 
- end C540001_5;
- 
-      --==================================================================--
- 
- with Report;
- with C540001_1;
- with C540001_2;
- with C540001_3;
- with C540001_4;
- with C540001_5;
- 
- procedure C540001 is
-    type Value is range 1 .. 5;
- 
- begin
-    Report.Test ("C540001", "Check that an expression in a case statement " &
-                 "may be of a generic formal type.  Check that a function " &
-                 "call may be used as a case statement expression.  Check " &
-                 "that a call to a generic formal function may be used as " &
-                 "a case statement expression.  Check that a call to an "   &
-                 "inherited function may be used as a case statement "      &
-                 "expression");
- 
-    Generic_Formal_Object_Subtest:
-    begin
-       declare
-          One  : Value := 1;
-          package One_Pck is new C540001_2 (Value, One);
-          use One_Pck;
-          EObj : Enum;
-       begin
-          Assign_Enum (EObj);
-          if EObj /= Alpha then
-             Report.Failed ("Incorrect result for value of one in generic" &
-                            "formal object subtest");
-          end if;
-       end;
- 
-       declare
-          Five : Value := 5;
-          package Five_Pck is new C540001_2 (Value, Five);
-          use Five_Pck;
-          EObj : Enum;
-       begin
-          Assign_Enum (EObj);
-          if EObj /= Theta then
-             Report.Failed ("Incorrect result for value of five in generic" &
-                            "formal object subtest");
-          end if;
-       end;
- 
-    end Generic_Formal_Object_Subtest;
- 
-    Instantiated_Generic_Function_Subtest:
-    declare
-       type New_Enum_Type is new C540001_1.Enum_Type;
- 
-       function Get_Enum_Value (P : C540001_1.Small_Num) 
-         return New_Enum_Type is
-       begin
-          return New_Enum_Type'Val (P);
-       end Get_Enum_Value;
- 
-       function Val_Func is new C540001_3 
-         (Formal_Enum_Type => New_Enum_Type, 
-          Formal_Func      => Get_Enum_Value);
- 
-       procedure Assign_Num (P : in out C540001_1.Small_Num) is
-       begin
-          case Val_Func (P) is                         -- Case expression is
-                                                       -- instantiated generic
-              when New_Enum_Type (C540001_1.Eh) |      -- function.
-                   New_Enum_Type (C540001_1.Sea)   => P := 4;
-              when New_Enum_Type (C540001_1.Bee)   => P := 7;
-              when others                          => P := 9;
-          end case;
- 
-       end Assign_Num;
- 
-       SNObj  : C540001_1.Small_Num;
- 
-    begin
-       SNObj := 0;
-       Assign_Num (SNObj);       
-       if SNObj /= 4 then
-          Report.Failed ("Incorrect result for value of zero in call to " &
-                         "generic function subtest");
-       end if;
- 
-       SNObj := 3;
-       Assign_Num (SNObj);       
-       if SNObj /= 9 then
-          Report.Failed ("Incorrect result for value of three in call to " &
-                         "generic function subtest");
-       end if;
- 
-    end Instantiated_Generic_Function_Subtest;
- 
-    -- When a function call, a renaming of a function, or a call to an 
-    -- inherited function is used in the case expressions, the choices 
-    -- of the case statement only need to cover the values in the result 
-    -- of the function.
- 
-    Function_Call_Subtest:
-    declare
-       MObj : C540001_1.Mixed := 'B';
-       BObj : Boolean         := True;
-       use type C540001_1.Mixed;
-    begin
-       C540001_1.Assign_Mixed (BObj, MObj);
-       if MObj /= C540001_1.None then
-          Report.Failed ("Incorrect result for value of true in function" &
-                         "call subtest");
-          end if;
- 
-       BObj := False;
-       C540001_1.Assign_Mixed (BObj, MObj);
-       if MObj /= C540001_1.'A' then
-          Report.Failed ("Incorrect result for value of false in function" &
-                         "call subtest");
-       end if;
- 
-    end Function_Call_Subtest;
- 
-    Function_Renaming_Subtest:
-    declare
-       use C540001_1;
-       function Rename_Get_Small_Int (P : Boolean) 
-         return Small_Int renames Get_Small_Int;
-       MObj : Mixed   := None;
-       BObj : Boolean := False;
-    begin
-       case Rename_Get_Small_Int (BObj) is
-           when 1 => MObj := 'A';
-           when 2 => MObj := 'B';
-           -- No others needed.
-       end case;
- 
-       if MObj /= 'B' then
-          Report.Failed ("Incorrect result for value of false in function" &
-                         "renaming subtest");
-       end if;
- 
-    end Function_Renaming_Subtest;
- 
-    Call_To_Generic_Formal_Function_Subtest:
-    declare
-       type New_Small_Int is new C540001_1.Small_Int;
- 
-       function Get_Int_Value return New_Small_Int is
-       begin
-          return New_Small_Int'First;
-       end Get_Int_Value;
- 
-       package Int_Pck is new C540001_4 
-         (Formal_Int_Type => New_Small_Int, 
-          Formal_Func     => Get_Int_Value);
- 
-       use type C540001_1.Mixed;
-       MObj : C540001_1.Mixed := C540001_1.None; 
- 
-    begin
-       Int_Pck.Gen_Assign_Mixed (MObj); 
-       if MObj /= C540001_1.'A' then
-          Report.Failed ("Incorrect result in call to generic formal " &
-                         "function subtest");
-       end if;
- 
-    end Call_To_Generic_Formal_Function_Subtest;
- 
-    Call_To_Inherited_Function_Subtest:
-    declare
-       NTObj1 : C540001_5.New_Tagged := (C1 => C540001_1.Eh,
-                                         C2 => C540001_1.'A');
-       NTObj2 : C540001_5.New_Tagged := (C540001_1.Dee, C540001_1.'C');
-       use type C540001_1.Mixed;
-       use type C540001_1.Enum_Type;
-    begin
-       C540001_5.Assign_Tagged (NTObj1, NTObj2);
-       if NTObj2.C1 /= C540001_1.Bee or  
-          NTObj2.C2 /= C540001_1.'B' then
-          Report.Failed ("Incorrect result in inherited function subtest");
-       end if;
- 
-    end Call_To_Inherited_Function_Subtest;
- 
-    Report.Result;
- 
- end C540001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a03a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a03a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a03a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C54A03A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT BOOLEAN, CHARACTER, USER-DEFINED ENUMERATED, INTEGER,
- --    AND DERIVED TYPES MAY BE USED IN A CASE EXPRESSION.
- 
- -- DAT 1/22/81
- -- PWB 4/22/86  RENAME TO -AB;
- --              REMOVE EXTRANEOUS <CR> FROM BEGINNING OF LINE 45.
- 
- WITH REPORT;
- PROCEDURE C54A03A IS
- 
-      USE REPORT;
- 
-      TYPE D_INT IS NEW INTEGER RANGE 1 .. 2;
-      TYPE D_BOOL IS NEW BOOLEAN;
-      TYPE D_BOOL_2 IS NEW D_BOOL;
-      TYPE M_ENUM IS (FIRST, SECOND, THIRD);
-      TYPE M_CHAR IS NEW CHARACTER RANGE ASCII.NUL .. 'Z';
-      TYPE M_ENUM_2 IS NEW M_ENUM;
- 
-      I : INTEGER := 1;
-      D_I : D_INT := 1;
-      B : BOOLEAN := TRUE;
-      D_B : D_BOOL := TRUE;
-      D_B_2 : D_BOOL_2 := FALSE;
-      E : M_ENUM := THIRD;
-      C : CHARACTER := 'A';
-      M_C : M_CHAR := 'Z';
-      D_E : M_ENUM_2 := SECOND;
- 
- BEGIN
-      TEST ("C54A03A", "CHECK VARIOUS DISCRETE TYPES " &
-                       "IN CASE EXPRESSIONS");
- 
-      CASE I IS
-           WHEN 2 | 3 => FAILED ("WRONG CASE 1");
-           WHEN 1 => NULL;
-           WHEN OTHERS => FAILED ("WRONG CASE 2");
-      END CASE;
- 
-      CASE D_I IS
-           WHEN 1 => NULL;
-           WHEN 2 => FAILED ("WRONG CASE 2A");
-      END CASE;
- 
-      CASE B IS
-           WHEN TRUE => NULL;
-           WHEN FALSE => FAILED ("WRONG CASE 3");
-      END CASE;
- 
-      CASE D_B IS
-           WHEN TRUE => NULL;
-           WHEN FALSE => FAILED ("WRONG CASE 4");
-      END CASE;
- 
-      CASE D_B_2 IS
-           WHEN FALSE => NULL;
-           WHEN TRUE => FAILED ("WRONG CASE 5");
-      END CASE;
- 
-      CASE E IS
-           WHEN SECOND | FIRST => FAILED ("WRONG CASE 6");
-           WHEN THIRD => NULL;
-      END CASE;
- 
-      CASE C IS
-           WHEN 'A' .. 'Z' => NULL;
-           WHEN OTHERS => FAILED ("WRONG CASE 7");
-      END CASE;
- 
-      CASE M_C IS
-           WHEN 'Z' => NULL;
-           WHEN OTHERS => FAILED ("WRONG CASE 8");
-      END CASE;
- 
-      CASE D_E IS
-           WHEN FIRST => FAILED ("WRONG CASE 9");
-           WHEN SECOND | THIRD => NULL;
-      END CASE;
- 
-      RESULT;
- END C54A03A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a04a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a04a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a04a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a04a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C54A04A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PRIVATE (DISCRETE) TYPES MAY BE USED IN CASE EXPRESSIONS
- --     WITHIN THE DEFINING PACKAGE.
- 
- -- DAT 1/29/81
- 
- WITH REPORT;
- PROCEDURE C54A04A IS
- 
-      USE REPORT;
- 
-      PACKAGE P IS
- 
-           TYPE T IS PRIVATE;
-           TYPE LT IS LIMITED PRIVATE;
- 
-      PRIVATE
- 
-           TYPE T IS ('Z', X);
-           TYPE LT IS NEW INTEGER RANGE 0 .. 1;
- 
-      END P;
- 
-      VT : P.T;
-      VLT : P.LT;
- 
-      PACKAGE BODY P IS
- 
-      BEGIN
-           TEST ("C54A04A", "PRIVATE DISCRETE TYPES MAY APPEAR IN " &
-                 "CASE EXPRESSIONS IN PACKAGE BODY");
- 
-           VT := 'Z';
-           VLT := LT (IDENT_INT (1));
- 
-           CASE VT IS
-                WHEN X => FAILED ("WRONG CASE 1");
-                WHEN 'Z' => NULL; -- OK
-           END CASE;
- 
-           CASE VLT IS
-                WHEN 1 => NULL; -- OK
-                WHEN 0 => FAILED ("WRONG CASE 2");
-           END CASE;
-      END P;
- 
- BEGIN
- 
-      -- TEST CALLED FROM PACKAGE BODY, ALREADY ELABORATED.
- 
-      RESULT;
- END C54A04A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a07a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a07a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a07a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a07a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C54A07A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A VARIABLE USED AS A CASE EXPRESSION IS NOT CONSIDERED
- --    LOCAL TO THE CASE STATEMENT.  IN PARTICULAR, CHECK THAT THE
- --    VARIABLE CAN BE ASSIGNED A NEW VALUE, AND THE ASSIGNMENT TAKES
- --    EFFECT IMMEDIATELY (I.E. THE CASE STATEMENT DOES NOT USE A
- --    COPY OF THE CASE EXPRESSION).
- 
- 
- -- RM 01/21/80
- 
- 
- WITH REPORT ;
- PROCEDURE  C54A07A  IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("C54A07A" , "CHECK THAT A VARIABLE USED AS A CASE" &
-                       " EXPRESSION IS NOT CONSIDERED LOCAL TO" &
-                       " THE CASE STATEMENT" );
- 
-      DECLARE   -- A
-      BEGIN
- 
- B1 :      DECLARE
- 
-                TYPE  VARIANT_REC( DISCR : BOOLEAN := TRUE )  IS
-                     RECORD
-                          A , B : INTEGER ;
-                          CASE  DISCR  IS
-                               WHEN  TRUE   =>  P , Q : CHARACTER ;
-                               WHEN  FALSE  =>  X , Y : INTEGER   ;
-                          END CASE;
-                     END RECORD ;
- 
-                V : VARIANT_REC := ( TRUE , 1 , 2 ,
-                                            IDENT_CHAR( 'P' )   ,
-                                            IDENT_CHAR( 'Q' )   );
- 
-           BEGIN
- 
-                IF  EQUAL( 3 , 7 )  THEN  V := ( FALSE , 3 , 4 , 7 , 8 );
-                END IF;
- 
-                CASE  V.DISCR  IS
- 
-                     WHEN  TRUE    =>  
- 
-                          IF  ( V.P /= 'P'  OR
-                                V.Q /= 'Q'  )
-                          THEN  FAILED( "WRONG VALUES  -  1" );
-                          END IF;
- 
-                          B1.V  :=  ( FALSE , 3 , 4 ,
-                                              IDENT_INT( 5 )   ,
-                                              IDENT_INT( 6 )   );
- 
-                          IF  V.DISCR  THEN FAILED( "WRONG DISCR." );
-                          END IF;
- 
-                          IF  ( V.X /= 5  OR
-                                V.Y /= 6  )
-                          THEN  FAILED( "WRONG VALUES  -  2" );
-                          END IF;
- 
-                     WHEN  FALSE   =>  
-                          FAILED( "WRONG BRANCH IN CASE STMT." );
- 
-                END CASE;
- 
-           EXCEPTION
- 
-                WHEN  OTHERS  =>  FAILED("EXCEPTION RAISED");
- 
-           END B1 ;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>  FAILED( "EXCEPTION RAISED BY DECLARATIONS");
- 
-      END ;    -- A
- 
- 
-      RESULT ;
- 
- 
- END C54A07A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C54A13A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A CASE EXPRESSION IS A DECLARED VARIABLE OR
- --     CONSTANT, OR ONE OF THESE IN PARENTHESES, AND ITS SUBTYPE IS
- --     NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
- --     APPEAR AS A CHOICE.
- 
- -- HISTORY:
- --     BCB 02/29/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C54A13A IS
- 
-      SUBTYPE INT IS INTEGER RANGE IDENT_INT(5) .. IDENT_INT(10);
- 
-      A : INT := 8;
-      B : CONSTANT INT := 7;
-      C, D : INTEGER;
- 
-      FUNCTION IDENT(X : INT) RETURN INT IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN X;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT;
- 
- BEGIN
-      TEST ("C54A13A", "CHECK THAT IF A CASE EXPRESSION IS A DECLARED " &
-                       "VARIABLE OR CONSTANT, OR ONE OF THESE IN " &
-                       "PARENTHESES, AND ITS SUBTYPE IS NONSTATIC, " &
-                       "THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE " &
-                       "MAY APPEAR AS A CHOICE");
- 
-      CASE A IS
-           WHEN 0 => C := IDENT_INT(5);
-           WHEN 8 => C := IDENT_INT(10);
-           WHEN 30000 => C := IDENT_INT(15);
-           WHEN -30000 => C := IDENT_INT(20);
-           WHEN OTHERS => C := IDENT_INT(25);
-      END CASE;
- 
-      IF C /= IDENT_INT(10) THEN
-           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 1");
-      END IF;
- 
-      CASE B IS
-           WHEN 0 => D := IDENT_INT(5);
-           WHEN 100 => D := IDENT_INT(10);
-           WHEN 30000 => D := IDENT_INT(15);
-           WHEN -30000 => D := IDENT_INT(20);
-           WHEN OTHERS => D := IDENT_INT(25);
-      END CASE;
- 
-      IF D /= IDENT_INT(25) THEN
-           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 2");
-      END IF;
- 
-      CASE (A) IS
-           WHEN 0 => C := IDENT_INT(5);
-           WHEN 8 => C := IDENT_INT(10);
-           WHEN 30000 => C := IDENT_INT(15);
-           WHEN -30000 => C := IDENT_INT(20);
-           WHEN OTHERS => C := IDENT_INT(25);
-      END CASE;
- 
-      IF C /= IDENT_INT(10) THEN
-           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 3");
-      END IF;
- 
-      CASE (B) IS
-           WHEN 0 => D := IDENT_INT(5);
-           WHEN 110 => D := IDENT_INT(10);
-           WHEN 30000 => D := IDENT_INT(15);
-           WHEN -30000 => D := IDENT_INT(20);
-           WHEN OTHERS => D := IDENT_INT(25);
-      END CASE;
- 
-      IF D /= IDENT_INT(25) THEN
-           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 4");
-      END IF;
- 
-      RESULT;
- END C54A13A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C54A13B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A CASE EXPRESSION IS A GENERIC "IN" OR "IN OUT"
- --     PARAMETER WITH A NON-STATIC SUBTYPE OR ONE OF THESE IN
- --     PARENTHESES, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
- --     APPEAR AS A CHOICE.
- 
- -- HISTORY:
- --     BCB 07/13/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C54A13B IS
- 
-      L : INTEGER := IDENT_INT(1);
-      R : INTEGER := IDENT_INT(100);
- 
-      SUBTYPE INT IS INTEGER RANGE L .. R;
- 
-      GENERIC
-           IN_PAR : IN INT;
-           IN_OUT_PAR : IN OUT INT;
-      PROCEDURE GEN_PROC (I : IN OUT INTEGER);
- 
-      IN_VAR : INT := IDENT_INT (10);
-      IN_OUT_VAR : INT := IDENT_INT (100);
-      CHECK_VAR : INT := IDENT_INT (1);
- 
-      PROCEDURE GEN_PROC (I : IN OUT INTEGER) IS
-      BEGIN
-           CASE IN_PAR IS
-                WHEN 0 => I := I + IDENT_INT (2);
-                WHEN 10 => I := I + IDENT_INT (1);
-                WHEN -3000 => I := I + IDENT_INT (3);
-                WHEN OTHERS => I := I + IDENT_INT (4);
-           END CASE;
- 
-           CASE IN_OUT_PAR IS
-                WHEN 0 => IN_OUT_PAR := IDENT_INT (0);
-                WHEN 100 => IN_OUT_PAR := IDENT_INT (50);
-                WHEN -3000 => IN_OUT_PAR := IDENT_INT (-3000);
-                WHEN OTHERS => IN_OUT_PAR := IDENT_INT (5);
-           END CASE;
- 
-           CASE (IN_PAR) IS
-                WHEN 0 => I := I + IDENT_INT (2);
-                WHEN 10 => I := I + IDENT_INT (1);
-                WHEN -3000 => I := I + IDENT_INT (3);
-                WHEN OTHERS => I := I + IDENT_INT (4);
-           END CASE;
- 
-           CASE (IN_OUT_PAR) IS
-                WHEN 0 => IN_OUT_PAR := IDENT_INT (200);
-                WHEN 50 => IN_OUT_PAR := IDENT_INT (25);
-                WHEN -3000 => IN_OUT_PAR := IDENT_INT (300);
-                WHEN OTHERS => IN_OUT_PAR := IDENT_INT (400);
-           END CASE;
- 
-      END GEN_PROC;
- 
-      PROCEDURE P IS NEW GEN_PROC (IN_VAR, IN_OUT_VAR);
- 
- BEGIN
-      TEST ("C54A13B", "CHECK THAT IF A CASE EXPRESSION IS A " &
-                       "GENERIC 'IN' OR 'IN OUT' PARAMETER WITH A " &
-                       "NON-STATIC SUBTYPE OR ONE OF " &
-                       "THESE IN PARENTHESES, THEN ANY VALUE OF " &
-                       "THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
-                       "A CHOICE");
- 
-      P (CHECK_VAR);
- 
-      IF NOT EQUAL (CHECK_VAR, IDENT_INT(3)) THEN
-           FAILED ("INCORRECT CHOICES MADE FOR IN PARAMETER IN CASE");
-      END IF;
- 
-      IF NOT EQUAL (IN_OUT_VAR, IDENT_INT(25)) THEN
-           FAILED ("INCORRECT CHOICESMADE FOR IN OUT PARAMETER IN CASE");
-      END IF;
- 
-      RESULT;
- END C54A13B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C54A13C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A CASE EXPRESSION IS A QUALIFIED EXPRESSION, A
- --     TYPE CONVERSION, OR ONE OF THESE IN PARENTHESES, AND ITS
- --     SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S
- --     BASE TYPE MAY APPEAR AS A CHOICE.
- 
- -- HISTORY:
- --     BCB 07/13/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C54A13C IS
- 
-      L : INTEGER := 1;
-      R : INTEGER := 100;
- 
-      SUBTYPE INT IS INTEGER RANGE L .. R;
- 
-      A : INT := 50;
- 
-      B : INTEGER := 50;
- 
-      C : INTEGER;
- 
- BEGIN
-      TEST ("C54A13C", "CHECK THAT IF A CASE EXPRESSION IS A " &
-                       "QUALIFIED EXPRESSION, A TYPE CONVERSION, " &
-                       "OR ONE OF THESE IN PARENTHESES, AND ITS " &
-                       "SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE " &
-                       "EXPRESSION'S BASE TYPE MAY APPEAR AS A CHOICE");
- 
-      CASE INT'(A) IS
-           WHEN 0 => C := IDENT_INT (5);
-           WHEN 50 => C := IDENT_INT (10);
-           WHEN -3000 => C := IDENT_INT (15);
-           WHEN OTHERS => C := IDENT_INT (20);
-      END CASE;
- 
-      IF C /= IDENT_INT (10) THEN
-           FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
-                   "CASE");
-      END IF;
- 
-      CASE INT(B) IS
-           WHEN 0 => C := IDENT_INT (5);
-           WHEN 50 => C := IDENT_INT (10);
-           WHEN -3000 => C := IDENT_INT (15);
-           WHEN OTHERS => C := IDENT_INT (20);
-      END CASE;
- 
-      IF C /= IDENT_INT (10) THEN
-           FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN CASE");
-      END IF;
- 
-      CASE (INT'(A)) IS
-           WHEN 0 => C := IDENT_INT (5);
-           WHEN 50 => C := IDENT_INT (10);
-           WHEN -3000 => C := IDENT_INT (15);
-           WHEN OTHERS => C := IDENT_INT (20);
-      END CASE;
- 
-      IF C /= IDENT_INT (10) THEN
-           FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
-                   "PARENTHESES IN CASE");
-      END IF;
- 
-      CASE (INT(B)) IS
-           WHEN 0 => C := IDENT_INT (5);
-           WHEN 50 => C := IDENT_INT (10);
-           WHEN -3000 => C := IDENT_INT (15);
-           WHEN OTHERS => C := IDENT_INT (20);
-      END CASE;
- 
-      IF C /= IDENT_INT (10) THEN
-           FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN " &
-                   "PARENTHESES IN CASE");
-      END IF;
- 
-      RESULT;
- END C54A13C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a13d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a13d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- C54A13D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A CASE EXPRESSION IS A FUNCTION INVOCATION,
- --     ATTRIBUTE, STATIC EXPRESSION, OR ONE OF THESE IN PARENTHESES,
- --     THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS A
- --     CHOICE.
- 
- -- HISTORY:
- --     BCB 07/19/88  CREATED ORIGINAL TEST.
- --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- --     GJD 11/15/95  REMOVED ADA 95 INCOMPATIBLE ALTERNATIVE IN FIRST CASE.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C54A13D IS
- 
-      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
- 
-      CONS : CONSTANT INT := 0;
- 
-      C : INT;
- 
-      TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
- 
-      SUBTYPE SUBENUM IS ENUM RANGE THREE .. FOUR;
- 
-      FUNCTION FUNC RETURN INT IS
-      BEGIN
-           RETURN 0;
-      END FUNC;
- 
- BEGIN
-      TEST ("C54A13D", "CHECK THAT IF A CASE EXPRESSION IS A FUNCTION " &
-                       "INVOCATION, ATTRIBUTE, STATIC EXPRESSION, OR " &
-                       "ONE OF THESE IN PARENTHESES, THEN ANY VALUE " &
-                       "OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
-                       "A CHOICE");
- 
-      CASE FUNC IS
-           WHEN 0 => C := IDENT_INT (5);
-           WHEN 100 => C := IDENT_INT (10);
-           WHEN OTHERS => C := IDENT_INT (20);
-      END CASE;
- 
-      IF NOT EQUAL (C,5) THEN
-           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
-                   "FUNCTION INVOCATION - 1");
-      END IF;
- 
-      CASE (FUNC) IS
-           WHEN 0 => C := IDENT_INT (25);
-           WHEN 100 => C := IDENT_INT (50);
-           WHEN -3000 => C := IDENT_INT (75);
-           WHEN OTHERS => C := IDENT_INT (90);
-      END CASE;
- 
-      IF NOT EQUAL (C,25) THEN
-           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
-                   "FUNCTION INVOCATION - 2");
-      END IF;
- 
-      CASE SUBENUM'FIRST IS
-           WHEN ONE => C := IDENT_INT (100);
-           WHEN TWO => C := IDENT_INT (99);
-           WHEN THREE => C := IDENT_INT (98);
-           WHEN FOUR => C := IDENT_INT (97);
-           WHEN FIVE => C := IDENT_INT (96);
-           WHEN SIX => C := IDENT_INT (95);
-      END CASE;
- 
-      IF NOT EQUAL (C,98) THEN
-           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
-                   "ATTRIBUTE - 1");
-      END IF;
- 
-      CASE (SUBENUM'FIRST) IS
-           WHEN ONE => C := IDENT_INT (90);
-           WHEN TWO => C := IDENT_INT (89);
-           WHEN THREE => C := IDENT_INT (88);
-           WHEN FOUR => C := IDENT_INT (87);
-           WHEN FIVE => C := IDENT_INT (86);
-           WHEN SIX => C := IDENT_INT (85);
-      END CASE;
- 
-      IF NOT EQUAL (C,88) THEN
-           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
-                   "ATTRIBUTE - 2");
-      END IF;
- 
-      CASE CONS * 1 IS
-           WHEN 0 => C := IDENT_INT (1);
-           WHEN 100 => C := IDENT_INT (2);
-           WHEN -3000 => C := IDENT_INT (3);
-           WHEN OTHERS => C := IDENT_INT (4);
-      END CASE;
- 
-      IF NOT EQUAL (C,1) THEN
-           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
-                   "STATIC EXPRESSION - 1");
-      END IF;
- 
-      CASE (CONS * 1) IS
-           WHEN 0 => C := IDENT_INT (10);
-           WHEN 100 => C := IDENT_INT (20);
-           WHEN -3000 => C := IDENT_INT (30);
-           WHEN OTHERS => C := IDENT_INT (40);
-      END CASE;
- 
-      IF NOT EQUAL (C,10) THEN
-           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
-                   "STATIC EXPRESSION - 2");
-      END IF;
- 
-      RESULT;
- END C54A13D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a22a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a22a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a22a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a22a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,68 ****
- -- C54A22A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK ALL FORMS OF CHOICE IN CASE CHOICES.
- 
- -- DAT 1/29/81
- -- SPS 1/21/83
- 
- WITH REPORT;
- PROCEDURE C54A22A IS
- 
-      USE REPORT;
- 
-      TYPE T IS RANGE 1 .. 10;
-      C5 : CONSTANT T := 5;
-      SUBTYPE S1 IS T RANGE 1 .. 5;
-      SUBTYPE S2 IS T RANGE C5 + 1 .. 7;
-      SUBTYPE SN IS T RANGE C5 + 4 .. C5 - 4 + 7;  -- NULL RANGE.
-      SUBTYPE S10 IS T RANGE C5 + 5 .. T'LAST;
- 
- BEGIN
-      TEST ("C54A22A", "CHECK ALL FORMS OF CASE CHOICES");
- 
-      CASE T'(C5 + 3) IS
-           WHEN SN                       -- 9..8
-           | S1 RANGE 1 .. 0             -- 1..0
-           | S2 RANGE C5 + 2 .. C5 + 1   -- 7..6
-           | 3 .. 2                      -- 3..2
-                => FAILED ("WRONG CASE 1");
- 
-           WHEN  S1 RANGE 4 .. C5        -- 4..5
-           | S1 RANGE C5 - 4 .. C5 / 2   -- 1..2
-           | 3 .. 1 + C5 MOD 3           -- 3..3
-           | SN                          -- 9..8
-           | S1 RANGE 5 .. C5 - 1        -- 5..4
-           | 6 .. 7                      -- 6..7
-           | S10                         -- 10..10
-           | 9                           -- 9
-           | S10 RANGE 10 .. 9 =>        -- 10..9
-                FAILED ("WRONG CASE 2");
- 
-           WHEN C5 + C5 - 2 .. 8         -- 8
-                => NULL;
-      END CASE;
- 
-      RESULT;
- END C54A22A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a23a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a23a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a23a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a23a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,49 ****
- -- C54A23A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CASE CHOICES MAY BE CONSTANT NAMES
- 
- -- DAT 3/18/81
- -- SPS 4/7/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C54A23A IS
- 
-      C1 : CONSTANT INTEGER := 1;
-      C2 : CONSTANT INTEGER := 2;
-      C3 : CONSTANT INTEGER := 3;
- 
- BEGIN
-      TEST ("C54A23A", "CASE CHOICES MAY BE CONSTANTS");
- 
-      CASE IDENT_INT (C3) IS
-           WHEN C1 | C2
-                => FAILED ("WRONG CASE CHOICE 1");
-           WHEN 3 => NULL;
-           WHEN OTHERS => FAILED ("WRONG CASE CHOICE 2");
-      END CASE;
- 
-      RESULT;
- END C54A23A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a24a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a24a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a24a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a24a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- C54A24A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NULL SUBRANGE CHOICES MAY OCCUR IN CASE STATEMENT, WITH
- -- OUT-OF-BOUNDS RANGE BOUNDS, AND WHERE VACUOUS CHOICES ARE NULL.
- -- CHECK THAT AN UNNEEDED OTHERS CHOICE IS PERMITTED.
- 
- -- DAT 1/29/81
- -- JBG 8/21/83
- 
- WITH REPORT;
- PROCEDURE C54A24A IS
- 
-      USE REPORT;
- 
-      TYPE T IS RANGE 1 .. 1010;
-      SUBTYPE ST IS T RANGE 5 .. 7;
- 
-      V : ST := 6;
- 
- BEGIN
-      TEST ("C54A24A", "CHECK NULL CASE SUBRANGE CHOICES, WITH " &
-            "OUTRAGEOUS BOUNDS");
- 
-      CASE V IS
-           WHEN -1000 .. -1010 => NULL;
-           WHEN T RANGE -5 .. -6 => NULL;
-           WHEN 12 .. 11 | ST RANGE 1000 .. 99 => NULL;
-           WHEN ST RANGE -99 .. -999 => NULL;
-           WHEN ST RANGE 6 .. 6 => V := V - 1;
-           WHEN T RANGE ST'BASE'LAST .. ST'BASE'FIRST => NULL;
-           WHEN 5 | 7 => NULL;
-           WHEN ST RANGE T'BASE'LAST .. T'BASE'FIRST => NULL;
-           WHEN T'BASE'LAST .. T'BASE'FIRST => NULL;
-           WHEN OTHERS => V := V + 1;
-      END CASE;
-      IF V /= 5 THEN
-           FAILED ("IMPROPER CASE EXECUTION");
-      END IF;
- 
-      RESULT;
- END C54A24A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a24b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a24b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a24b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a24b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- C54A24B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NULL SUBTYPE RANGES ARE ACCEPTABLE CASE CHOICES,
- --     WHERE THE BOUNDS ARE BOTH OUT OF THE SUBRANGE'S RANGE, AND
- --     WHERE VACUOUS CHOICES HAVE NON-NULL STATEMENT SEQUENCES.
- --     CHECK THAT AN UNNEEDED OTHERS CLAUSE IS PERMITTED.
- 
- -- HISTORY:
- --     DAT 01/29/81 CREATED ORIGINAL TEST.
- --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT;
- PROCEDURE C54A24B IS
- 
-      USE REPORT;
- 
-      TYPE C IS NEW CHARACTER RANGE 'A' .. 'D';
-      X : C := 'B';
- 
- BEGIN
-      TEST ("C54A24B", "NULL CASE CHOICE SUBRANGES WITH VALUES " &
-            "OUTSIDE SUBRANGE");
- 
-      CASE X IS
-           WHEN C RANGE C'BASE'LAST .. C'BASE'FIRST
-                | C RANGE 'Z' .. ' ' => X := 'A';
-           WHEN C => NULL;
-           WHEN OTHERS => X := 'C';
-      END CASE;
-      IF X /= 'B' THEN
-           FAILED ("WRONG CASE EXECUTION");
-      END IF;
- 
-      RESULT;
- END C54A24B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,173 ****
- -- C54A42A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A  CASE_STATEMENT  MAY HANDLE A LARGE NUMBER OF
- --    POTENTIAL VALUES GROUPED INTO A SMALL NUMBER OF ALTERNATIVES
- --    AND THAT EACH TIME THE APPROPRIATE ALTERNATIVE IS EXECUTED.
- 
- -- (OPTIMIZATION TEST.)
- 
- 
- -- RM 03/24/81
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- 
- WITH REPORT;
- PROCEDURE  C54A42A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C54A42A" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
-                        " A LARGE NUMBER OF POTENTIAL VALUES GROUPED"   &
-                        " INTO A SMALL NUMBER OF ALTERNATIVES" );
- 
-      DECLARE
- 
-           STATCON : CONSTANT CHARACTER := 'B' ;
-           STATVAR :          CHARACTER := 'Q' ;
-           DYNCON  : CONSTANT CHARACTER := IDENT_CHAR( 'Y' );
-           DYNVAR  :          CHARACTER := IDENT_CHAR( 'Z' );
- 
-      BEGIN
- 
-           CASE  CHARACTER'('A')  IS
-                WHEN  ASCII.NUL .. 'A'  =>  NULL ;
-                WHEN  'B'               =>  FAILED( "WRONG ALTERN. A2" );
-                WHEN  'P'               =>  FAILED( "WRONG ALTERN. A3" );
-                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. A4" );
-                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. A5" );
-                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. A6" );
-           END CASE;
- 
-           CASE  STATCON  IS
-                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. B1" );
-                WHEN  'B'               =>  NULL ;
-                WHEN  'P'               =>  FAILED( "WRONG ALTERN. B3" );
-                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. B4" );
-                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. B5" );
-                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. B6" );
-           END CASE;
- 
-           CASE  STATVAR  IS
-                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. C1" );
-                WHEN  'B'               =>  FAILED( "WRONG ALTERN. C2" );
-                WHEN  'P'               =>  FAILED( "WRONG ALTERN. C3" );
-                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. C4" );
-                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. C5" );
-                WHEN  OTHERS            =>  NULL ;
-           END CASE;
- 
-           CASE  DYNCON  IS
-                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. D1" );
-                WHEN  'B'               =>  FAILED( "WRONG ALTERN. D2" );
-                WHEN  'P'               =>  FAILED( "WRONG ALTERN. D3" );
-                WHEN  'Y'               =>  NULL ;
-                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. D5" );
-                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. D6" );
-           END CASE;
- 
-           CASE  DYNVAR  IS
-                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. E1" );
-                WHEN  'B'               =>  FAILED( "WRONG ALTERN. E2" );
-                WHEN  'P'               =>  FAILED( "WRONG ALTERN. E3" );
-                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. E4" );
-                WHEN  'Z' .. ASCII.DEL  =>  NULL ;
-                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. E6" );
-           END CASE;
- 
-      END ;
- 
- 
-      DECLARE
- 
-           NUMBER  : CONSTANT           := -100 ;
-           LITEXPR : CONSTANT           := 0 * NUMBER  + 16 ;
-           STATCON : CONSTANT INTEGER   := +100 ;
-           DYNVAR  :          INTEGER   := IDENT_INT( 102 ) ;
-           DYNCON  : CONSTANT INTEGER   := IDENT_INT(  17 ) ;
- 
-      BEGIN
- 
-           CASE  INTEGER'(-102)  IS
-                WHEN  INTEGER'FIRST..-101 => NULL ;
-                WHEN  -100                => FAILED("WRONG ALTERN. F2");
-                WHEN  17                  => FAILED("WRONG ALTERN. F2");
-                WHEN  100                 => FAILED("WRONG ALTERN. F4");
-                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. F5");
-                WHEN  OTHERS              => FAILED("WRONG ALTERN. F6");
-           END CASE;
- 
-           CASE  IDENT_INT(NUMBER)  IS
-                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. G1");
-                WHEN  -100                => NULL ;
-                WHEN  17                  => FAILED("WRONG ALTERN. G3");
-                WHEN  100                 => FAILED("WRONG ALTERN. G4");
-                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. G5");
-                WHEN  OTHERS              => FAILED("WRONG ALTERN. G6");
-           END CASE;
- 
-           CASE  IDENT_INT(LITEXPR)  IS
-                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. H1");
-                WHEN  -100                => FAILED("WRONG ALTERN. H2");
-                WHEN  17                  => FAILED("WRONG ALTERN. H3");
-                WHEN  100                 => FAILED("WRONG ALTERN. H4");
-                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. H5");
-                WHEN  OTHERS              => NULL ;
-           END CASE;
- 
-           CASE  STATCON  IS
-                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. I1");
-                WHEN  -100                => FAILED("WRONG ALTERN. I2");
-                WHEN  17                  => FAILED("WRONG ALTERN. I3");
-                WHEN  100                 => NULL ;
-                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. I5");
-                WHEN  OTHERS              => FAILED("WRONG ALTERN. I6");
-           END CASE;
- 
-           CASE  DYNVAR   IS
-                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. J1");
-                WHEN  -100                => FAILED("WRONG ALTERN. J2");
-                WHEN  17                  => FAILED("WRONG ALTERN. J3");
-                WHEN  100                 => FAILED("WRONG ALTERN. J4");
-                WHEN  101..INTEGER'LAST   => NULL ;
-                WHEN  OTHERS              => FAILED("WRONG ALTERN. J6");
-           END CASE;
- 
-           CASE  DYNCON  IS
-                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. K1");
-                WHEN  -100                => FAILED("WRONG ALTERN. K2");
-                WHEN  17                  => NULL ;
-                WHEN  100                 => FAILED("WRONG ALTERN. K4");
-                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. K5");
-                WHEN  OTHERS              => FAILED("WRONG ALTERN. K6");
-           END CASE;
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C54A42A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,173 ****
- -- C54A42B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES A SMALL RANGE OF
- --    POTENTIAL VALUES GROUPED INTO A SMALL NUMBER OF ALTERNATIVES.
- 
- -- (OPTIMIZATION TEST -- JUMP TABLE.)
- 
- 
- -- RM 03/26/81
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- 
- WITH REPORT;
- PROCEDURE  C54A42B  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C54A42B" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
-                        " A SMALL NUMBER OF POTENTIAL VALUES GROUPED"   &
-                        " INTO A SMALL NUMBER OF ALTERNATIVES" );
- 
-      DECLARE
- 
-           STATCON : CONSTANT CHARACTER RANGE 'A'..'K' := 'J' ;
-           STATVAR :          CHARACTER RANGE 'A'..'K' := 'A' ;
-           DYNCON  : CONSTANT CHARACTER RANGE 'A'..'K' :=IDENT_CHAR('K');
-           DYNVAR  :          CHARACTER RANGE 'A'..'K' :=IDENT_CHAR('G');
- 
-      BEGIN
- 
-           CASE  STATVAR  IS
-                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE A1" );
-                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE A2" );
-                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE A3" );
-                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE A4" );
-                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE A5" );
-                WHEN  OTHERS         => NULL ;
-           END CASE;
- 
-           CASE  CHARACTER'('B')  IS
-                WHEN  'B' | 'E'      => NULL ;
-                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE B2" );
-                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE B3" );
-                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE B4" );
-                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE B5" );
-                WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE B6" );
-           END CASE;
- 
-           CASE  DYNVAR   IS
-                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE C1" );
-                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE C2" );
-                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE C3" );
-                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE C4" );
-                WHEN  'G'            => NULL ;
-                WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE C6" );
-           END CASE;
- 
-           CASE  IDENT_CHAR(STATCON)  IS
-                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE D1" );
-                WHEN  'J' | 'C'      => NULL ;
-                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE D3" );
-                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE D4" );
-                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE D5" );
-                WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE D6" );
-           END CASE;
- 
-           CASE  DYNCON   IS
-                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE E1" );
-                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE E2" );
-                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE E3" );
-                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE E4" );
-                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE E5" );
-                WHEN  OTHERS         => NULL ;
-           END CASE;
- 
-      END ;
- 
- 
-      DECLARE
- 
-           NUMBER  : CONSTANT                      := 1 ;
-           LITEXPR : CONSTANT                      := NUMBER + 5 ;
-           STATCON : CONSTANT INTEGER RANGE 0..10  := 9 ;
-           DYNVAR  :          INTEGER RANGE 0..10  := IDENT_INT( 10 );
-           DYNCON  : CONSTANT INTEGER RANGE 0..10  := IDENT_INT(  2 );
- 
-      BEGIN
- 
-           CASE  INTEGER'(0)  IS
-                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE F1");
-                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE F2");
-                WHEN  5               =>  FAILED("WRONG ALTERNATIVE F3");
-                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE F4");
-                WHEN  6               =>  FAILED("WRONG ALTERNATIVE F5");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  INTEGER'(NUMBER)   IS
-                WHEN  1 | 4           =>  NULL ;
-                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE G2");
-                WHEN  5               =>  FAILED("WRONG ALTERNATIVE G3");
-                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE G4");
-                WHEN  6               =>  FAILED("WRONG ALTERNATIVE G5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
-           END CASE;
- 
-           CASE  IDENT_INT(LITEXPR)  IS
-                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE H1");
-                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE H2");
-                WHEN  5               =>  FAILED("WRONG ALTERNATIVE H3");
-                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE H4");
-                WHEN  6               =>  NULL ;
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H6");
-           END CASE;
- 
-           CASE  STATCON  IS
-                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE I1");
-                WHEN  9 | 2           =>  NULL ;
-                WHEN  5               =>  FAILED("WRONG ALTERNATIVE I3");
-                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE I4");
-                WHEN  6               =>  FAILED("WRONG ALTERNATIVE I5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
-           END CASE;
- 
-           CASE  DYNVAR   IS
-                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE J1");
-                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE J2");
-                WHEN  5               =>  FAILED("WRONG ALTERNATIVE J3");
-                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE J4");
-                WHEN  6               =>  FAILED("WRONG ALTERNATIVE J5");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  DYNCON  IS
-                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE K1");
-                WHEN  9 | 2           =>  NULL ;
-                WHEN  5               =>  FAILED("WRONG ALTERNATIVE K3");
-                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE K4");
-                WHEN  6               =>  FAILED("WRONG ALTERNATIVE K5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
-           END CASE;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C54A42B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- -- C54A42C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A  CASE_STATEMENT  CORRECTLY HANDLES A SPARSE SET OF
- --    POTENTIAL VALUES (OF TYPE INTEGER) IN A LARGE RANGE.
- 
- --    (OPTIMIZATION TEST)
- 
- 
- -- RM 03/26/81
- 
- 
- WITH REPORT;
- PROCEDURE  C54A42C  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C54A42C" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
-                        " A SPARSE SET OF POTENTIAL VALUES IN A LARGE"  &
-                        " RANGE" );
- 
-      DECLARE
- 
-           NUMBER  : CONSTANT                           := 1001 ;
-           LITEXPR : CONSTANT                           := NUMBER + 998 ;
-           STATCON : CONSTANT INTEGER RANGE  1..INTEGER'LAST :=    1000 ;
-           DYNVAR  :          INTEGER RANGE  1..INTEGER'LAST :=
-                                            IDENT_INT( INTEGER'LAST-50 );
-           DYNCON  : CONSTANT INTEGER RANGE  1..INTEGER'LAST :=
-                                            IDENT_INT( 1000 );
- 
-      BEGIN
- 
-           CASE  INTEGER'( NUMBER )  IS
-                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE F1");
-                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE F2");
-                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE F3");
-                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE F4");
-                WHEN  INTEGER'LAST-100 ..
-                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE F5");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  IDENT_INT( 10 )  IS
-                WHEN  1 .. 10         =>  NULL ;
-                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE G2");
-                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE G3");
-                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE G4");
-                WHEN  INTEGER'LAST -100 ..
-                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE G5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
-           END CASE;
- 
-           CASE  IDENT_INT(LITEXPR)  IS
-                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE H1");
-                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE H2");
-                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE H3");
-                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE H4");
-                WHEN  INTEGER'LAST -100 ..
-                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE H5");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  STATCON  IS
-                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE I1");
-                WHEN  1000            =>  NULL ;
-                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE I3");
-                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE I4");
-                WHEN  INTEGER'LAST -100 ..
-                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE I5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
-           END CASE;
- 
-           CASE  DYNVAR   IS
-                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE J1");
-                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE J2");
-                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE J3");
-                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE J4");
-                WHEN  INTEGER'LAST -100 ..
-                      INTEGER'LAST    =>  NULL ;
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE J6");
-           END CASE;
- 
-           CASE  DYNCON  IS
-                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE K1");
-                WHEN  1000            =>  NULL ;
-                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE K3");
-                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE K4");
-                WHEN  INTEGER'LAST -100 ..
-                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE K5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
-           END CASE;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C54A42C ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C54A42D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES A FEW ALTERNATIVES
- --    COVERING A LARGE RANGE OF INTEGERS.
- 
- 
- -- (OPTIMIZATION TEST.)
- 
- 
- -- RM 03/30/81
- 
- 
- WITH REPORT;
- PROCEDURE  C54A42D  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C54A42D" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
-                        " A FEW ALTERNATIVES COVERING A LARGE RANGE" &
-                        " OF INTEGERS" );
- 
-      DECLARE
- 
-           NUMBER  : CONSTANT          := 2000 ;
-           LITEXPR : CONSTANT          := NUMBER + 2000 ;
-           STATCON : CONSTANT INTEGER  := 2001 ;
-           DYNVAR  :          INTEGER  := IDENT_INT( 0 );
-           DYNCON  : CONSTANT INTEGER  := IDENT_INT( 1 );
- 
-      BEGIN
- 
-           CASE  INTEGER'(-4000)  IS
-                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE F1");
-                WHEN  INTEGER'FIRST..0=>  NULL ;
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE F3");
-                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE F4");
-           END CASE;
- 
-           CASE  INTEGER'(NUMBER)   IS
-                WHEN  1..2000         =>  NULL ;
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE G2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE G3");
-                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE G4");
-           END CASE;
- 
-           CASE  IDENT_INT(LITEXPR)  IS
-                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE H1");
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE H2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE H3");
-                WHEN  2002..INTEGER'LAST=>NULL ;
-           END CASE;
- 
-           CASE  STATCON  IS
-                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE I1");
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE I2");
-                WHEN  2001            =>  NULL ;
-                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE I4");
-           END CASE;
- 
-           CASE  DYNVAR   IS
-                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE J1");
-                WHEN  INTEGER'FIRST..0=>  NULL ;
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE J3");
-                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE J4");
-           END CASE;
- 
-           CASE  DYNCON   IS
-                WHEN  1..2000         =>  NULL ;
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE K2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE K3");
-                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE K4");
-           END CASE;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C54A42D ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C54A42E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A  CASE_STATEMENT  CORRECTLY HANDLES A SMALL RANGE OF
- --    POTENTIAL VALUES OF TYPE INTEGER, SITUATED FAR FROM  0  AND
- --    GROUPED INTO A SMALL NUMBER OF ALTERNATIVES.
- 
- -- (OPTIMIZATION TEST -- BIASED JUMP TABLE.)
- 
- 
- -- RM 03/26/81
- 
- 
- WITH REPORT;
- PROCEDURE  C54A42E  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C54A42E" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
-                        " A SMALL, FAR RANGE OF POTENTIAL VALUES OF" &
-                        " TYPE INTEGER" );
- 
-      DECLARE
- 
-           NUMBER  : CONSTANT                           := 4001 ;
-           LITEXPR : CONSTANT                           := NUMBER + 5 ;
-           STATCON : CONSTANT INTEGER RANGE 4000..4010  := 4009 ;
-           DYNVAR  :          INTEGER RANGE 4000..4010  :=
-                                                       IDENT_INT( 4010 );
-           DYNCON  : CONSTANT INTEGER RANGE 4000..4010  :=
-                                                       IDENT_INT( 4002 );
- 
-      BEGIN
- 
-           CASE  INTEGER'(4000)  IS
-                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE F1");
-                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE F2");
-                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE F3");
-                WHEN  4003 |
-                      4007..4008      =>  FAILED("WRONG ALTERNATIVE F4");
-                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE F5");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  IDENT_INT(NUMBER)  IS
-                WHEN  4001 | 4004     =>  NULL ;
-                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE G2");
-                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE G3");
-                WHEN  4003 |
-                      4007..4008      =>  FAILED("WRONG ALTERNATIVE G4");
-                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE G5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
-           END CASE;
- 
-           CASE  IDENT_INT(LITEXPR)  IS
-                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE H1");
-                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE H2");
-                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE H3");
-                WHEN  4003 |
-                      4007..4008      =>  FAILED("WRONG ALTERNATIVE H4");
-                WHEN  4006            =>  NULL ;
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H6");
-           END CASE;
- 
-           CASE  STATCON  IS
-                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE I1");
-                WHEN  4009 | 4002     =>  NULL ;
-                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE I3");
-                WHEN  4003 |
-                      4007..4008      =>  FAILED("WRONG ALTERNATIVE I4");
-                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE I5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
-           END CASE;
- 
-           CASE  DYNVAR   IS
-                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE J1");
-                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE J2");
-                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE J3");
-                WHEN  4003 |
-                      4007..4008      =>  FAILED("WRONG ALTERNATIVE J4");
-                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE J5");
-                WHEN  OTHERS          =>  NULL ;
- 
-           END CASE;
- 
-           CASE  DYNCON  IS
-                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE K1");
-                WHEN  4009 | 4002     =>  NULL ;
-                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE K3");
-                WHEN  4003 |
-                      4007..4008      =>  FAILED("WRONG ALTERNATIVE K4");
-                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE K5");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
-           END CASE;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C54A42E ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- C54A42F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES SEVERAL SMALL,
- --    NON-CONTIGUOUS RANGES OF INTEGERS COVERED BY A SINGLE  'OTHERS'
- --    ALTERNATIVE.
- 
- 
- -- (OPTIMIZATION TEST.)
- 
- 
- -- RM 03/31/81
- 
- 
- WITH REPORT;
- PROCEDURE  C54A42F  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C54A42F" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
-                        " SEVERAL SMALL, NON-CONTIGUOUS ENUMERATION"    &
-                        " RANGES COVERED BY A SINGLE  'OTHERS'  "       &
-                        " ALTERNATIVE"  );
- 
-      DECLARE
- 
-           TYPE  DAY  IS (SUN , MON , TUE , WED , THU , FRI ,  SAT );
- 
-           DYNVAR2 :          DAY  := MON ;
-           STATVAR :          DAY  := TUE ;
-           STATCON : CONSTANT DAY  := WED ;
-           DYNVAR  :          DAY  := THU ;
-           DYNCON  : CONSTANT DAY  :=     DAY'VAL( IDENT_INT(5) ); -- FRI
- 
-      BEGIN
- 
-           IF EQUAL(1,289) THEN
-                DYNVAR  := SUN ;
-                DYNVAR2 := SUN ;
-           END IF;
- 
-           CASE  SUN  IS        --  SUN
-                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE F1");
-                WHEN  SUN       =>  NULL ;
-                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE F3");
-                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE F4");
-                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE F5");
-           END CASE;
- 
-           CASE  DYNVAR2   IS   --  MON
-                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE G1");
-                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE G2");
-                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE G3");
-                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE G4");
-                WHEN  OTHERS    =>  NULL ;
-           END CASE;
- 
-           CASE  STATVAR  IS    --  TUE
-                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE H1");
-                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE H2");
-                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE H3");
-                WHEN  TUE..WED  =>  NULL ;
-                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE H5");
-           END CASE;
- 
-           CASE  STATCON  IS    --  WED
-                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE I1");
-                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE I2");
-                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE I3");
-                WHEN  TUE..WED  =>  NULL ;
-                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE I5");
-           END CASE;
- 
-           CASE  DYNVAR   IS    --  THU
-                WHEN  THU       =>  NULL ;
-                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE J2");
-                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE J3");
-                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE J4");
-                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE J5");
-           END CASE;
- 
-           CASE  DYNCON   IS    --  FRI
-                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE K1");
-                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE K2");
-                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE K3");
-                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE K4");
-                WHEN  OTHERS    =>  NULL ;
-           END CASE;
- 
-           CASE  DAY'SUCC( DYNCON )  IS   --  SAT
-                WHEN THU       =>  FAILED("WRONG ALTERNATIVE L1");
-                WHEN SUN       =>  FAILED("WRONG ALTERNATIVE L2");
-                WHEN SAT       =>  NULL ;
-                WHEN TUE..WED  =>  FAILED("WRONG ALTERNATIVE L4");
-                WHEN OTHERS    =>  FAILED("WRONG ALTERNATIVE L5");
-           END CASE;
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C54A42F ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c54a42g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c54a42g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- C54A42G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES SEVERAL NON-CONTIGUOUS
- --    RANGES OF INTEGERS COVERED BY A SINGLE  'OTHERS'  ALTERNATIVE.
- 
- 
- -- (OPTIMIZATION TEST.)
- 
- 
- -- RM 03/30/81
- 
- 
- WITH REPORT;
- PROCEDURE  C54A42G  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C54A42G" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
-                        " SEVERAL NON-CONTIGUOUS RANGES OF INTEGERS"    &
-                        " COVERED BY A SINGLE  'OTHERS'  ALTERNATIVE"  );
- 
-      DECLARE
- 
-           NUMBER  : CONSTANT          := 2000 ;
-           LITEXPR : CONSTANT          := NUMBER + 2000 ;
-           STATCON : CONSTANT INTEGER  := 2002 ;
-           DYNVAR  :          INTEGER  := IDENT_INT( 0 );
-           DYNCON  : CONSTANT INTEGER  := IDENT_INT( 1 );
- 
-      BEGIN
- 
-           CASE  INTEGER'(-4000)  IS
-                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE F1");
-                WHEN  INTEGER'FIRST..0=>  NULL ;
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE F3");
-                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE F4");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE F5");
-           END CASE;
- 
-           CASE  IDENT_INT(NUMBER)   IS
-                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE G1");
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE G2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE G3");
-                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE G4");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  IDENT_INT(LITEXPR)  IS
-                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE H1");
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE H2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE H3");
-                WHEN  2100..INTEGER'LAST=>NULL ;
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H5");
-           END CASE;
- 
-           CASE  IDENT_INT(STATCON)  IS
-                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE I1");
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE I2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE I3");
-                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE I4");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  DYNVAR   IS
-                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE J1");
-                WHEN  INTEGER'FIRST..0=>  NULL ;
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE J3");
-                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE J4");
-                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE J5");
-           END CASE;
- 
-           CASE  DYNCON   IS
-                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE K1");
-                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE K2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE K3");
-                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE K4");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-           CASE  IDENT_INT( -3900 )  IS
-                WHEN  -3000..1999     =>  FAILED("WRONG ALTERNATIVE X1");
-                WHEN  INTEGER'FIRST..
-                            -4000     =>  FAILED("WRONG ALTERNATIVE X2");
-                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE X3");
-                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE X4");
-                WHEN  OTHERS          =>  NULL ;
-           END CASE;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C54A42G ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b03a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b03a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b03a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- C55B03A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE LOOP_PARAMETER IS ASSIGNED VALUES IN ASCENDING ORDER 
- --   IF REVERSE IS ABSENT, AND DESCENDING ORDER IF REVERSE IS PRESENT.
- 
- -- DAS 1/12/81
- -- SPS 3/2/83
- 
- WITH REPORT;
- PROCEDURE C55B03A IS
- 
-      USE REPORT;
-      I1 : INTEGER;
- 
- BEGIN
-      TEST( "C55B03A" , "CHECK CORRECT ORDER OF VALUE SEQUENCING" & 
-            " FOR A LOOP_PARAMETER" );
- 
-      I1 := 0;
-      FOR I IN IDENT_INT(1)..IDENT_INT(5) LOOP
-           I1 := I1 + 1;
-           IF ( I /= I1 ) THEN
-                FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY" );
-           END IF;
-      END LOOP;
- 
-      I1 := 6;
-      FOR I IN REVERSE IDENT_INT(1)..IDENT_INT(5) LOOP
-           I1 := I1 - 1;
-           IF ( I /= I1 ) THEN
-                FAILED ( "LOOP_PARAMETER DESCENDING INCORRECTLY" );
-           END IF;
-      END LOOP;
- 
-      RESULT;
- 
- END C55B03A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b04a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b04a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b04a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b04a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- --  C55B04A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A LOOP IS NOT ENTERED IF THE LOWER BOUND OF THE DISCRETE
- --   RANGE IS GREATER THAN THE UPPER BOUND, WHETHER REVERSE IS PRESENT
- --   OR NOT.
- 
- -- CHECK THAT LOOP BOUNDS ARE EVALUATED ONLY ONCE, UPON ENTRY TO 
- --   THE LOOP.
- 
- -- DAS  01/12/81
- -- SPS 3/2/83
- -- JBG 8/21/83
- 
- WITH REPORT;
- PROCEDURE C55B04A IS
- 
-      USE REPORT;
- 
-      C10 : CONSTANT INTEGER := 10;
-      I10 : INTEGER;
- 
- BEGIN
-      TEST ( "C55B04A", "CHECK OPERATION OF A FOR LOOP OVER A NULL " & 
-                        "DISCRETE RANGE" );
- 
-      -- NOTE: EXIT STATEMENTS ARE INCLUDED TO AID IN RECOVERY FROM
-      --   TEST FAILURE.
- 
-      -- SUBTESTS INVOLVING STATIC BOUNDS:
- 
-      FOR I IN 10..1 LOOP
-           FAILED ( "LOOPING OVER NULL RANGE 10..1" );
-           EXIT;
-      END LOOP;
- 
-      FOR I IN REVERSE INTEGER RANGE -1..-10 LOOP
-           FAILED ( "LOOPING OVER NULL RANGE -1..-10" );
-           EXIT;
-      END LOOP;
- 
-      FOR I IN (C10 + 3)..(-3 * C10 + 27) LOOP     -- 13..-3
-           FAILED ("LOOPING OVER NULL RANGE (C10 + 3)..(-3 * C10 + 27)");
-           EXIT;
-      END LOOP;
- 
- 
-      -- SUBTESTS INVOLVING DYNAMIC BOUNDS:
- 
-      I10 := IDENT_INT(10);
- 
-      FOR I IN REVERSE I10..(I10-1) LOOP           -- 10..9
-           FAILED ( "LOOPING OVER NULL RANGE I10..(I10-1)");
-           EXIT;
-      END LOOP;
- 
- 
-      FOR I IN (C10 - I10)..(I10 - 11) LOOP        -- 0..-1
-           FAILED ( "LOOPING OVER NULL RANGE (C10 - I10)..(I10 - 11)" );
-           EXIT;
-      END LOOP;
- 
- 
-      -- SUBTEST OF BOUNDS EVALUTION ONLY AT ENTRY:
- 
-      FOR I IN 1..I10 LOOP
-           I10 := I10 - 1;
-      END LOOP;
-      IF (I10 /= 0) THEN
-           FAILED ( "LOOP BOUNDS NOT FIXED AT LOOP ENTRY" );
-      END IF;
- 
-      RESULT;
- 
- END C55B04A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b05a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b05a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b05a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C55B05A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LOOPS WITH BOUNDS INTEGER'LAST OR
- -- INTEGER'FIRST DO NOT RAISE INVALID EXCEPTIONS.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- DAT 3/26/81
- -- SPS 3/2/83
- -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C55B05A IS
- BEGIN
-      TEST ("C55B05A", "LOOPS WITH INTEGER'FIRST AND 'LAST AS BOUNDS");
- 
-      DECLARE
- 
-           COUNT : INTEGER := 0;
- 
-           PROCEDURE C IS
-           BEGIN
-                COUNT := COUNT + 1;
-           END C;
- 
-      BEGIN
-           FOR I IN INTEGER'LAST .. INTEGER'FIRST LOOP
-                FAILED ("WRONG NULL RANGE LOOP EXECUTION");
-                EXIT;
-           END LOOP;
-           FOR I IN INTEGER'FIRST .. INTEGER'FIRST LOOP
-                C;
-           END LOOP;
-           FOR I IN INTEGER'FIRST .. INTEGER'FIRST + 2 LOOP
-                C; C;
-           END LOOP;
-           FOR I IN INTEGER'FIRST + 1 .. INTEGER'FIRST LOOP
-                FAILED ("NULL RANGE ERROR 2");
-                EXIT;
-           END LOOP;
-           FOR I IN INTEGER'FIRST .. INTEGER'LAST LOOP
-                C;
-                EXIT;
-           END LOOP;
-           FOR I IN INTEGER LOOP
-                C;
-                EXIT;
-           END LOOP;
-           FOR I IN INTEGER'LAST - 2 .. INTEGER'LAST LOOP
-                C; C; C;
-           END LOOP;
-           FOR I IN INTEGER'LAST - 2 .. INTEGER'LAST - 1 LOOP
-                C;
-           END LOOP;
-           FOR I IN 0 .. INTEGER'FIRST LOOP
-                FAILED ("NULL LOOP ERROR 3");
-                EXIT;
-           END LOOP;
-           FOR I IN -1 .. INTEGER'FIRST LOOP
-                FAILED ("NULL LOOP ERROR 4");
-                EXIT;
-           END LOOP;
-           FOR I IN -3 .. IDENT_INT(0) LOOP
-                FOR J IN INTEGER'FIRST .. INTEGER'FIRST - I LOOP
-                     C; C; C; C;
-                END LOOP;
-                FOR J IN INTEGER'FIRST - I .. INTEGER'FIRST + 3 - I LOOP
-                     C; C; C; C;
-                END LOOP;
-                FOR J IN INTEGER'LAST - 3 .. INTEGER'LAST + I LOOP
-                     C; C; C; C;
-                END LOOP;
-                FOR J IN INTEGER'LAST + I .. INTEGER'LAST LOOP
-                     C; C; C; C;
-                END LOOP;
-           END LOOP;
- 
-           FOR I IN REVERSE INTEGER'LAST .. INTEGER'FIRST LOOP
-                FAILED ("REVERSE WRONG NULL RANGE LOOP EXECUTION");
-                EXIT;
-           END LOOP;
-           FOR I IN REVERSE INTEGER'FIRST .. INTEGER'FIRST LOOP
-                C;
-           END LOOP;
-           FOR I IN REVERSE INTEGER'FIRST .. INTEGER'FIRST + 2 LOOP
-                C; C;
-           END LOOP;
-           FOR I IN REVERSE INTEGER'FIRST + 1 .. INTEGER'FIRST LOOP
-                FAILED ("NULL RANGE ERROR 8");
-                EXIT;
-           END LOOP;
-           FOR I IN REVERSE INTEGER'FIRST .. INTEGER'LAST LOOP
-                C;
-                EXIT;
-           END LOOP;
-           FOR I IN REVERSE INTEGER LOOP
-                C;
-                EXIT;
-           END LOOP;
-           FOR I IN REVERSE INTEGER'LAST - 2 .. INTEGER'LAST LOOP
-                C; C; C;
-           END LOOP;
-           FOR I IN REVERSE INTEGER'LAST - 2 .. INTEGER'LAST - 1 LOOP
-                C;
-           END LOOP;
-           FOR I IN REVERSE 0 .. INTEGER'FIRST LOOP
-                FAILED ("NULL LOOP ERROR 9");
-                EXIT;
-           END LOOP;
-           FOR I IN REVERSE -1 .. INTEGER'FIRST LOOP
-                FAILED ("NULL LOOP ERROR 7");
-                EXIT;
-           END LOOP;
-           FOR I IN REVERSE -3 .. IDENT_INT(0) LOOP
-                FOR J IN REVERSE INTEGER'FIRST .. INTEGER'FIRST - I LOOP
-                     C; C; C; C;
-                END LOOP;
-                FOR J IN REVERSE INTEGER'FIRST - I
-                     .. INTEGER'FIRST + 3 - I
-                LOOP
-                     C; C; C; C;
-                END LOOP;
-                FOR J IN REVERSE INTEGER'LAST - 3 .. INTEGER'LAST + I
-                LOOP
-                     C; C; C; C;
-                END LOOP;
-                FOR J IN REVERSE INTEGER'LAST + I .. INTEGER'LAST LOOP
-                     C; C; C; C;
-                END LOOP;
-           END LOOP;
- 
-           IF COUNT /= 408 THEN
-                FAILED ("WRONG LOOP EXECUTION COUNT");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED INCORRECTLY");
-           WHEN OTHERS =>
-                FAILED ("UNKNOWN EXCEPTION RAISED INCORRECTLY");
-      END;
- 
-      RESULT;
- END C55B05A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b06a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b06a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b06a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b06a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,313 ****
- -- C55B06A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LOOPS MAY BE SPECIFIED FOR BOOLEAN, INTEGER,
- -- CHARACTER, ENUMERATION, AND DERIVED TYPES, INCLUDING
- -- TYPES DERIVED FROM DERIVED TYPES. DERIVED BOOLEAN IS NOT
- -- TESTED IN THIS TEST.
- 
- -- DAT 3/26/81
- -- JBG 9/29/82
- -- SPS 3/11/83
- -- JBG 10/5/83
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C55B06A IS
- 
-      TYPE ENUM IS ('A', 'B', 'D', 'C', Z, X, D, A, C);
- 
-      TYPE D1 IS NEW CHARACTER RANGE 'A' .. 'Z';
-      TYPE D2 IS NEW INTEGER;
-      TYPE D3 IS NEW ENUM;
-      TYPE D4 IS NEW D1;
-      TYPE D5 IS NEW D2;
-      TYPE D6 IS NEW D3;
- 
-      ONE : INTEGER := IDENT_INT(1);
-      COUNT : INTEGER := 0;
-      OLDCOUNT : INTEGER := 0;
- 
-      PROCEDURE Q IS
-      BEGIN
-           COUNT := COUNT + ONE;
-      END Q;
- 
- BEGIN
-      TEST ("C55B06A", "TEST LOOPS FOR ALL DISCRETE TYPES");
- 
-      FOR I IN BOOLEAN LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 1");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN FALSE .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 2");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN BOOLEAN RANGE FALSE .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 3");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN INTEGER LOOP
-           Q;
-           EXIT WHEN I = INTEGER'FIRST + 2;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
-           FAILED ("LOOP 4");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN 3 .. IDENT_INT (5) LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
-           FAILED ("LOOP 5");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN INTEGER RANGE -2 .. -1 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 6");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN INTEGER RANGE INTEGER'FIRST .. INTEGER'FIRST + 1 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 7");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN 'A' .. CHARACTER'('Z') LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
-           FAILED ("LOOP 9");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN CHARACTER RANGE 'A' .. 'D' LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
-           FAILED ("LOOP 10");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN ENUM LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(9) /= COUNT THEN
-           FAILED ("LOOP 11");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN ENUM RANGE D .. C LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
-           FAILED ("LOOP 12");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN 'A' .. ENUM'(Z) LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
-           FAILED ("LOOP 13");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D1 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
-           FAILED ("LOOP 14");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D1 RANGE 'A' .. 'Z' LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
-           FAILED ("LOOP 15");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D1'('A') .. 'D' LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
-           FAILED ("LOOP 16");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D2 LOOP
-           Q;
-           IF I > D2'FIRST + 3 THEN
-                EXIT;
-           END IF;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
-           FAILED ("LOOP 17");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D2 RANGE -100 .. -99 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 18");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D2'(1) .. 2 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 19");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D3 LOOP
-           IF I IN 'A' .. 'C' THEN
-                Q;        -- 4
-           ELSE
-                Q; Q;     -- 10
-           END IF;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(14) /= COUNT THEN
-           FAILED ("LOOP 20");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D3 RANGE 'A' .. Z LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
-           FAILED ("LOOP 21");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN 'A' .. D3'(Z) LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
-           FAILED ("LOOP 22");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D4 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
-           FAILED ("LOOP 23");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D4'('A') .. 'Z' LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
-           FAILED ("LOOP 24");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR I IN D4 RANGE 'B' .. 'D' LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
-           FAILED ("LOOP 25");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR J IN D5 LOOP
-           Q;        -- 4
-           EXIT WHEN J = D5(INTEGER'FIRST) + 3;
-           Q;        -- 3
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(7) /= COUNT THEN
-           FAILED ("LOOP 26");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR J IN D5 RANGE -2 .. -1 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
-           FAILED ("LOOP 27");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR  J IN D5'(-10) .. D5'(-6) LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
-           FAILED ("LOOP 28");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR J IN D6 LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(9) /= COUNT THEN
-           FAILED ("LOOP 29");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR J IN D6 RANGE Z .. A LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
-           FAILED ("LOOP 30");
-      END IF;
-      OLDCOUNT := COUNT;
- 
-      FOR J IN D6'('D') .. D LOOP
-           Q;
-      END LOOP;
-      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
-           FAILED ("LOOP 31");
-      END IF;
-      OLDCOUNT := COUNT;
- 
- 
-      RESULT;
- END C55B06A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b06b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b06b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b06b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b06b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- C55B06B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LOOPS MAY BE SPECIFIED FOR DERIVED BOOLEAN AND
- -- DERIVED DERIVED BOOLEAN.
- 
- -- DAT 3/26/81
- -- SPS 3/2/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C55B06B IS
- 
-      TYPE E IS (FALSE, TRUE);
-      TYPE B1 IS NEW BOOLEAN;
-      TYPE B2 IS NEW B1;
-      TYPE B3 IS NEW E;
- 
-      ONE : INTEGER := IDENT_INT (1);
-      COUNT : INTEGER := 0;
-      OLD_COUNT : INTEGER := 0;
- 
-      PROCEDURE Q IS
-      BEGIN
-           COUNT := COUNT + 1;
-      END Q;
- 
- BEGIN
-      TEST ("C55B06B", "LOOPS OVER DERIVED BOOLEAN");
- 
-      FOR I IN BOOLEAN LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 1");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN BOOLEAN RANGE FALSE .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 2");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN BOOLEAN'(FALSE) .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 3");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN E LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 4");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN E RANGE FALSE .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 5");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN FALSE .. E'(TRUE) LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 6");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN B1 LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 7");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN B1 RANGE FALSE .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 8");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN FALSE .. B1'(TRUE) LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 9");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN B2 LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 10");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN B2 RANGE FALSE .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 11");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN B2'(FALSE) .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 12");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN B3 LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 13");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN B3 RANGE FALSE .. TRUE LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 14");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      FOR I IN FALSE .. B3'(TRUE) LOOP
-           Q;
-      END LOOP;
-      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
-           FAILED ("LOOP 15");
-      ELSE
-           OLD_COUNT := COUNT;
-      END IF;
- 
-      RESULT;
-  END C55B06B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b07a.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b07a.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b07a.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b07a.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- C55B07A.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT LOOPS OVER RANGES OF TYPE LONG_INTEGER
- --     CAN BE WRITTEN.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     THE TYPE LONG_INTEGER.
- --
- --     IF THE TYPE LONG_INTEGER IS NOT SUPPORTED, THEN THE
- --     DECLARATION OF CHECK MUST BE REJECTED.
- 
- -- HISTORY:
- --     RM  07/06/82  CREATED ORIGINAL TEST.
- --     BCB 01/04/88  MODIFIED HEADER.
- 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C55B07A IS
- 
-      CHECK : LONG_INTEGER;                             -- N/A => ERROR.
- 
-      TYPE  NEW_LONG_INTEGER  IS  NEW LONG_INTEGER ;
- 
-      THE_COUNT : INTEGER := 777 ;   -- JUST A DUMMY...
- 
-      LI_VAR   :           LONG_INTEGER      :=  1 ;
-      LI_CON   :  CONSTANT LONG_INTEGER      :=  1 ;
- 
-      NLI_VAR  :           NEW_LONG_INTEGER  :=  1 ;
-      NLI_CON  :  CONSTANT NEW_LONG_INTEGER  :=  1 ;
- 
-      SUBTYPE   LI_SEGMENT  IS  LONG_INTEGER RANGE
-                                LONG_INTEGER'LAST..LONG_INTEGER'LAST ;
- 
-      SUBTYPE  NLI_SEGMENT  IS  NEW_LONG_INTEGER RANGE
-                                NEW_LONG_INTEGER'FIRST..
-                                NEW_LONG_INTEGER'FIRST ;
- 
-      COUNT : INTEGER := 0;
- 
-      PROCEDURE  BUMP ( DUMMY : INTEGER )  IS
-      BEGIN
-           COUNT := COUNT + 1;
-      END  BUMP;
- 
- BEGIN
- 
-      TEST ( "C55B07A" , "LOOPS OVER RANGES OF TYPE  LONG_INTEGER " );
- 
-      FOR  I  IN  1..LI_CON  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  NLI_VAR..1  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  1..LONG_INTEGER(1)  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  1..NEW_LONG_INTEGER(1)  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  LI_SEGMENT  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  REVERSE NLI_SEGMENT  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  LONG_INTEGER RANGE 1..1  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  NEW_LONG_INTEGER RANGE 1..1  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  LONG_INTEGER LOOP
-           BUMP(THE_COUNT) ;
-           EXIT WHEN  I = LONG_INTEGER'FIRST + 1;
-      END LOOP;
- 
-      FOR  I  IN  NEW_LONG_INTEGER LOOP
-           BUMP(THE_COUNT) ;
-           EXIT WHEN  I = NEW_LONG_INTEGER'FIRST + 1;
-      END LOOP;
- 
- 
-      IF  COUNT /= 12  THEN
-           FAILED ("WRONG LOOP COUNT");
-      END IF;
- 
- 
-      RESULT;
- 
- 
- END  C55B07A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b07b.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b07b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b07b.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b07b.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- C55B07B.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT LOOPS OVER RANGES OF TYPE SHORT_INTEGER
- --     CAN BE WRITTEN.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     THE TYPE SHORT_INTEGER.
- --
- --     IF THE TYPE SHORT_INTEGER IS NOT SUPPORTED, THEN THE
- --     DECLARATION OF CHECK MUST BE REJECTED.
- 
- -- HISTORY:
- --     RM  07/08/82  CREATED ORIGINAL TEST.
- --     BCB 01/04/88  MODIFIED HEADER.
- 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C55B07B IS
- 
-      CHECK : SHORT_INTEGER;                            -- N/A => ERROR.
- 
-      TYPE  NEW_SHORT_INTEGER  IS  NEW SHORT_INTEGER ;
- 
-      THE_COUNT : INTEGER := 777 ;   -- JUST A DUMMY...
- 
-      SI_VAR   :           SHORT_INTEGER      :=  1 ;
-      SI_CON   :  CONSTANT SHORT_INTEGER      :=  1 ;
- 
-      NSI_VAR  :           NEW_SHORT_INTEGER  :=  1 ;
-      NSI_CON  :  CONSTANT NEW_SHORT_INTEGER  :=  1 ;
- 
-      SUBTYPE   SI_SEGMENT  IS  SHORT_INTEGER RANGE
-                                SHORT_INTEGER'LAST..SHORT_INTEGER'LAST ;
- 
-      SUBTYPE  NSI_SEGMENT  IS  NEW_SHORT_INTEGER RANGE
-                                NEW_SHORT_INTEGER'FIRST..
-                                NEW_SHORT_INTEGER'FIRST ;
- 
-      COUNT : INTEGER := 0;
- 
-      PROCEDURE  BUMP ( DUMMY : INTEGER )  IS
-      BEGIN
-           COUNT := COUNT + 1;
-      END  BUMP;
- 
- BEGIN
- 
-      TEST ( "C55B07B" , "LOOPS OVER RANGES OF TYPE  SHORT_INTEGER " );
- 
-      FOR  I  IN  1..SI_CON  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  NSI_VAR..1  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  1..SHORT_INTEGER(1)  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  1..NEW_SHORT_INTEGER(1)  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  SI_SEGMENT  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  REVERSE NSI_SEGMENT  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  SHORT_INTEGER RANGE 1..1  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  NEW_SHORT_INTEGER RANGE 1..1  LOOP
-           BUMP(THE_COUNT) ;
-      END LOOP;
- 
-      FOR  I  IN  SHORT_INTEGER LOOP
-           BUMP(THE_COUNT) ;
-           EXIT WHEN  I = SHORT_INTEGER'FIRST + 1;
-      END LOOP;
- 
-      FOR  I  IN  NEW_SHORT_INTEGER LOOP
-           BUMP(THE_COUNT) ;
-           EXIT WHEN  I = NEW_SHORT_INTEGER'FIRST + 1;
-      END LOOP;
- 
- 
-      IF  COUNT /= 12  THEN
-           FAILED ("WRONG LOOP COUNT");
-      END IF;
- 
- 
-      RESULT;
- 
- 
- END  C55B07B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b10a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b10a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b10a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b10a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C55B10A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, IN 'FOR I IN L .. R LOOP', IF EITHER L OR R IS AN
- --     OVERLOADED ENUMERATION LITERAL, THE OVERLOADING IS CORRECTLY
- --     RESOLVED AND THE LOOP PARAMETER HAS THE APPROPRIATE TYPE.
- 
- -- HISTORY:
- --     DHH 08/15/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C55B10A IS
- 
-      TYPE ENUM IS (ALPH, BET, NEITHER);
- 
-      GLOBAL : ENUM := NEITHER;
- 
-      TYPE ALPHA IS (A, B, C, D, E);
-      TYPE BETA IS (G, F, E, D, C);
- 
-      PROCEDURE VAR(DEC : ALPHA) IS
-      BEGIN
-           IF EQUAL(3, 3) THEN
-                GLOBAL := ALPH;
-           END IF;
-      END;
- 
-      PROCEDURE VAR(DEC : BETA) IS
-      BEGIN
-           IF EQUAL(3, 3) THEN
-                GLOBAL := BET;
-           END IF;
-      END;
- 
- BEGIN
-      TEST("C55B10A", "CHECK THAT, IN 'FOR I IN L .. R LOOP', IF " &
-                      "EITHER L OR R IS AN OVERLOADED ENUMERATION " &
-                      "LITERAL, THE OVERLOADING IS CORRECTLY RESOLVED " &
-                      "AND THE LOOP PARAMETER HAS THE APPROPRIATE TYPE");
- 
-      FOR I IN A .. E LOOP
-           VAR(I);
- 
-           IF GLOBAL /= ALPH THEN
-                FAILED("WRONG TYPE FOR ALPHA");
-           END IF;
-      END LOOP;
- 
-      FOR I IN G .. E LOOP
-           VAR(I);
- 
-           IF GLOBAL /= BET THEN
-                FAILED("WRONG TYPE FOR BETA");
-           END IF;
-      END LOOP;
- 
-      RESULT;
- END C55B10A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b11a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b11a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b11a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b11a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C55B11A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, IN 'FOR IN ST RANGE L .. R LOOP', THE PARAMETER IS OF
- --     THE TYPE ST'BASE; THAT IS THAT IT CAN BE ASSIGNED TO OTHER
- --     VARIABLES DECLARED WITH SOME OTHER SUBTYPES OF ST.
- 
- -- HISTORY:
- --     DHH 08/15/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C55B11A IS
- 
-      TYPE ENUM IS (A, B, C, D, E, F, G, H);
- 
-      SUBTYPE ONE IS ENUM RANGE A .. H;
-      SUBTYPE TWO IS ENUM RANGE B .. H;
-      SUBTYPE THREE IS ENUM RANGE C .. H;
-      SUBTYPE FOUR IS ENUM RANGE D .. H;
- 
-      GLOBAL : INTEGER := 0;
- 
-      VAR_1 : ONE;
-      VAR_2 : TWO;
-      VAR_3 : THREE;
-      VAR_4 : FOUR;
- 
-      PROCEDURE CHECK_VAR(T : ENUM) IS
-      BEGIN
-           GLOBAL := GLOBAL + 1;
-           CASE T IS
-                WHEN D =>
-                     IF GLOBAL /= IDENT_INT(1) THEN
-                          FAILED("VAR_1 WRONG VALUE");
-                     END IF;
- 
-                WHEN E =>
-                     IF GLOBAL /= IDENT_INT(2) THEN
-                          FAILED("VAR_2 WRONG VALUE");
-                     END IF;
- 
-                WHEN F =>
-                     IF GLOBAL /= IDENT_INT(3) THEN
-                          FAILED("VAR_3 WRONG VALUE");
-                     END IF;
- 
-                WHEN G =>
-                     IF GLOBAL /= IDENT_INT(4) THEN
-                          FAILED("VAR_4 WRONG VALUE");
-                     END IF;
- 
-                WHEN OTHERS =>
- 
-                    FAILED("WRONG VALUE TO PROCEDURE");
-           END CASE;
-      END CHECK_VAR;
- 
- BEGIN
-      TEST("C55B11A", "CHECK THAT, IN 'FOR IN ST RANGE L .. R LOOP', " &
-                      "THE PARAMETER IS OF THE TYPE ST'BASE; THAT IS " &
-                      "THAT IT CAN BE ASSIGNED TO OTHER VARIABLES " &
-                      "DECLARED WITH SOME OTHER SUBTYPES OF ST");
- 
-      FOR I IN ONE RANGE D .. G LOOP
-           CASE I IS
-                WHEN D =>
-                     VAR_1 := I;
-                     CHECK_VAR(VAR_1);
-                WHEN E =>
-                     VAR_2 := I;
-                     CHECK_VAR(VAR_2);
-                WHEN F =>
-                     VAR_3 := I;
-                     CHECK_VAR(VAR_3);
-                WHEN G =>
-                     VAR_4 := I;
-                     CHECK_VAR(VAR_4);
-           END CASE;
-      END LOOP;
- 
-      RESULT;
- END C55B11A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b11b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b11b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b11b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b11b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C55B11B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FORM 'FOR I IN ST RANGE L .. R LOOP' IS ACCEPTED
- --     EVEN IF BOTH L AND R ARE OVERLOADED ENUMERATION LITERALS (SO
- --     THAT L .. R WOULD BE ILLEGAL WITHOUT ST RANGE).
- 
- -- HISTORY:
- --     DHH 09/07/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C55B11B IS
-      TYPE ST IS (A, B, C, D, E, F, G, H);
-      TYPE SI IS (A, B, C, D, F, E, G, H);
- 
-      GLOBAL : INTEGER := 0;
- 
-      PROCEDURE CHECK_VAR(T : ST) IS
-      BEGIN
-           GLOBAL := GLOBAL + 1;
-           CASE T IS
-                WHEN D =>
-                     IF GLOBAL /= IDENT_INT(1) THEN
-                          FAILED("1 WRONG VALUE");
-                     END IF;
- 
-                WHEN E =>
-                     IF GLOBAL /= IDENT_INT(2) THEN
-                          FAILED("2 WRONG VALUE");
-                     END IF;
- 
-                WHEN F =>
-                     IF GLOBAL /= IDENT_INT(3) THEN
-                          FAILED("3 WRONG VALUE");
-                     END IF;
- 
-                WHEN G =>
-                     IF GLOBAL /= IDENT_INT(4) THEN
-                          FAILED("4 WRONG VALUE");
-                     END IF;
- 
-                WHEN OTHERS =>
-                    FAILED("WRONG VALUE TO PROCEDURE");
- 
-           END CASE;
-      END CHECK_VAR;
- 
-      PROCEDURE CHECK_VAR(T : SI) IS
-      BEGIN
-           FAILED("WRONG PROCEDURE CALLED");
-      END CHECK_VAR;
- 
- BEGIN
-      TEST ("C55B11B", "CHECK THAT THE 'FORM FOR I IN ST RANGE L .. R " &
-                       "LOOP' IS ACCEPTED EVEN IF BOTH L AND R ARE " &
-                       "OVERLOADED ENUMERATION LITERALS (SO THAT L .. " &
-                       "R WOULD BE ILLEGAL WITHOUT ST RANGE)");
- 
-      FOR I IN ST RANGE D .. G LOOP
-           CHECK_VAR(I);
-      END LOOP;
- 
-      RESULT;
- END C55B11B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,207 ****
- -- C55B15A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A DISCRETE_RANGE OF THE FORM  'ST RANGE L..R'
- --    RAISES AN EXCEPTION BECAUSE  L  OR  R  IS A NON-STATIC
- --    EXPRESSION WHOSE VALUE IS OUTSIDE  THE RANGE OF VALUES
- --    ASSOCIATED WITH  ST  (OR BECAUSE  ST'FIRST  IS NON-STATIC
- --    AND  L  IS STATIC AND LESS THAN  ST'FIRST ; SIMILARLY FOR
- --     ST'LAST  AND  R ), CONTROL DOES NOT ENTER THE LOOP.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- RM  04/13/81
- -- SPS 11/01/82
- -- BHS 07/13/84
- -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387.
- -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- -- GJD 11/15/95  REMOVED CASE OF POTENTIALLY STATICALLY INCOMPATIBLE RANGE.
- 
- WITH SYSTEM;
- WITH REPORT;
- PROCEDURE  C55B15A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C55B15A" , "WHEN  'FOR  I  IN  ST RANGE L..R  LOOP' "     &
-                        "RAISES AN EXCEPTION, CONTROL DOES NOT ENTER " &
-                        "THE BODY OF THE LOOP" );
- 
-      -------------------------------------------------------------------
-      ----------------- STATIC (SUB)TYPE, DYNAMIC RANGE -----------------
- 
-      DECLARE
- 
-           SUBTYPE  ST  IS  INTEGER RANGE 1..4 ;
- 
-           FIRST   :  CONSTANT INTEGER := IDENT_INT( 1) ;
-           SECOND  :  CONSTANT INTEGER := IDENT_INT( 2) ;
-           THIRD   :  CONSTANT INTEGER := IDENT_INT( 3) ;
-           FOURTH  :  CONSTANT INTEGER := IDENT_INT( 4) ;
-           FIFTH   :  CONSTANT INTEGER := IDENT_INT( 5) ;
-           TENTH   :  CONSTANT INTEGER := IDENT_INT(10) ;
-           ZEROTH  :  CONSTANT INTEGER := IDENT_INT( 0) ;
- 
-      BEGIN
- 
-           BEGIN
- 
-                FOR  I  IN  ST RANGE 3..TENTH  LOOP
-                     FAILED( "EXCEPTION NOT RAISED (I1)" );
-                END LOOP;
- 
-           EXCEPTION
- 
-                WHEN  CONSTRAINT_ERROR => NULL ;
-                WHEN  OTHERS           =>
-                     FAILED( "WRONG EXCEPTION RAISED (I1)" );
- 
-           END ;
- 
- 
-           BEGIN
- 
-                FOR  I  IN  ST RANGE 0..THIRD  LOOP
-                     FAILED( "EXCEPTION NOT RAISED (I2)" );
-                END LOOP;
- 
-           EXCEPTION
- 
-                WHEN  CONSTRAINT_ERROR => NULL ;
-                WHEN  OTHERS           =>
-                     FAILED( "WRONG EXCEPTION RAISED (I2)" );
- 
-           END ;
-      END ;
- 
- 
-      -------------------------------------------------------------------
-      ----------------- DYNAMIC (SUB)TYPE, STATIC RANGE -----------------
- 
-      DECLARE
- 
-           TYPE  ENUM   IS  ( AMINUS , A,B,C,D,E,  F,G,H,I,J );
- 
-           SUBTYPE  ST  IS  ENUM RANGE ENUM'VAL( IDENT_INT( 1) ) ..
-                                       ENUM'VAL( IDENT_INT( 4) ) ;
- 
-           FIRST   :  CONSTANT ENUM := A ;
-           SECOND  :  CONSTANT ENUM := B ;
-           THIRD   :  CONSTANT ENUM := C ;
-           FOURTH  :  CONSTANT ENUM := D ;
-           FIFTH   :  CONSTANT ENUM := E ;
-           TENTH   :  CONSTANT ENUM := J ;
-           ZEROTH  :  CONSTANT ENUM := AMINUS ;
- 
-      BEGIN
- 
-           BEGIN
- 
-                FOR  I  IN  ST RANGE C..TENTH  LOOP
-                     FAILED( "EXCEPTION NOT RAISED (E1)" );
-                END LOOP;
- 
-           EXCEPTION
- 
-                WHEN  CONSTRAINT_ERROR => NULL ;
-                WHEN  OTHERS           =>
-                     FAILED( "WRONG EXCEPTION RAISED (E1)" );
- 
-           END ;
- 
- 
-           BEGIN
- 
-                FOR  I  IN  ST RANGE AMINUS..THIRD  LOOP
-                     FAILED( "EXCEPTION NOT RAISED (E2)" );
-                END LOOP;
- 
-           EXCEPTION
- 
-                WHEN  CONSTRAINT_ERROR => NULL ;
-                WHEN  OTHERS           =>
-                     FAILED( "WRONG EXCEPTION RAISED (E2)" );
- 
-           END ;
- 
-      END ;
- 
- 
-      DECLARE
- 
-           SUBTYPE  ST  IS  CHARACTER RANGE IDENT_CHAR( 'A' ) ..
-                                            IDENT_CHAR( 'D' ) ;
- 
-           FIRST   :  CONSTANT CHARACTER := 'A' ;
-           SECOND  :  CONSTANT CHARACTER := 'B' ;
-           THIRD   :  CONSTANT CHARACTER := 'C' ;
-           FOURTH  :  CONSTANT CHARACTER := 'D' ;
-           FIFTH   :  CONSTANT CHARACTER := 'E' ;
-           TENTH   :  CONSTANT CHARACTER := 'J' ;
-           ZEROTH  :  CONSTANT CHARACTER := '0' ;--ZERO; PRECEDES LETTERS
- 
-      BEGIN
- 
-           BEGIN
- 
-                FOR  I  IN  ST RANGE 'C'..TENTH  LOOP
-                     FAILED( "EXCEPTION NOT RAISED (C1)" );
-                END LOOP;
- 
-           EXCEPTION
- 
-                WHEN  CONSTRAINT_ERROR => NULL ;
-                WHEN  OTHERS           =>
-                     FAILED( "WRONG EXCEPTION RAISED (C1)" );
- 
-           END ;
- 
- 
-           BEGIN
- 
-                FOR  I  IN  ST RANGE '0'..THIRD  LOOP -- ZERO..'C'
-                     FAILED( "EXCEPTION NOT RAISED (C2)" );
-                END LOOP;
- 
-           EXCEPTION
- 
-                WHEN  CONSTRAINT_ERROR => NULL ;
-                WHEN  OTHERS           =>
-                     FAILED( "WRONG EXCEPTION RAISED (C2)" );
- 
-           END ;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C55B15A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b16a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b16a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55b16a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55b16a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C55B16A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THE PROCESSING OF ITERATIONS OVER AN ENUMERATION TYPE
- --     WHOSE (USER-DEFINED) REPRESENTATION CONSISTS OF A NON-CONTIGUOUS
- --     SET OF INTEGERS.
- --
- --     (INHERITANCE (AND SUBSEQUENT OVERRIDING) OF REPRESENTATION
- --     SPECIFICATIONS WILL BE TESTED ELSEWHERE.)
- 
- -- HISTORY:
- --     RM  08/06/82  CREATED ORIGINAL TEST.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE  C55B16A  IS
- 
-      I1  :  INTEGER := 0 ;
- 
-      TYPE  ENUM  IS  ( 'A' , 'B' , 'D' , 'C' , Z , X , D , A , C );
-      FOR   ENUM  USE ( -15 , -14 , -11 , -10 ,
-                          1 , 3 , 4 , 8 , 9 );
- 
- BEGIN
- 
-      TEST ("C55B16A" , "TEST LOOPING OVER ENUMERATION TYPES WITH"  &
-                        " NON-CONTIGUOUS REPRESENTATION"            );
- 
-      I1 := IDENT_INT(0) ;
- 
-      FOR  X  IN ENUM LOOP
- 
-           IF  X /= ENUM'VAL(I1)  OR
-               ENUM'POS(X) /= I1                               -- 0..8
-           THEN
-                FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY (1)" );
-           END IF;
- 
-           I1 := I1 + IDENT_INT(1) ;
- 
-      END LOOP;
- 
- 
-      I1 := IDENT_INT(6) ;
- 
-      FOR  X  IN ENUM RANGE D .. C LOOP
- 
-           IF  X /= ENUM'VAL(I1)  OR
-               ENUM'POS(X) /= I1                               -- 6..8
-           THEN
-                FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY (2)" );
-           END IF;
- 
-           I1 := I1 + IDENT_INT(1) ;
- 
-      END LOOP;
- 
- 
-      I1 := IDENT_INT(4) ;
- 
-      FOR  X  IN REVERSE 'A'..ENUM'(Z) LOOP
- 
-           IF  X /= ENUM'VAL(I1)  OR
-               ENUM'POS(X) /= I1                               -- 4..0
-           THEN
-                FAILED ( "LOOP_PARAMETER DESCENDING INCORRECTLY (3)" );
-           END IF;
- 
-           I1 := I1 - IDENT_INT(1) ;
- 
-      END LOOP;
- 
- 
-      RESULT ;
- 
- 
- END  C55B16A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55c02a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55c02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55c02a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55c02a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,49 ****
- -- C55C02A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHILE LOOPS WITH FALSE CONDITIONS ARE NEVER EXECUTED.
- 
- -- DAT 1/29/81
- -- DLD 8/06/82
- 
- WITH REPORT;
- PROCEDURE C55C02A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C55C02A", "INITIAL FALSE CONDITIONS IN WHILE LOOPS");
- 
-      WHILE FALSE LOOP
-           FAILED ("STATIC FALSE WHILE LOOP ENTERED");
-           EXIT;
-      END LOOP;
- 
-      WHILE IDENT_BOOL (FALSE) LOOP
-           FAILED ("DYNAMIC FALSE WHILE LOOP ENTERED");
-           EXIT;
-      END LOOP;
- 
-      RESULT;
- END C55C02A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55c02b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55c02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c55c02b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c55c02b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- C55C02B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE WHILE CONDITION IS EVALUATED EACH TIME.
- 
- -- DAT 1/29/81
- -- SPS 3/2/83
- 
- WITH REPORT;
- PROCEDURE C55C02B IS
- 
-      USE REPORT;
- 
-      I : INTEGER := 0;
- 
-      FT : ARRAY (FALSE .. TRUE) OF BOOLEAN 
-           := (IDENT_BOOL (FALSE), IDENT_BOOL (TRUE));
- 
- BEGIN
-      TEST ("C55C02B", "WHILE CONDITION IS EVALUATED EACH TIME THROUGH");
- 
-      WHILE I /= 10 LOOP
-           I := I + 1;
-      END LOOP;
-      IF I /= 10 THEN
-           FAILED ("BAD LOOP FLOW - OPTIMIZABLE CONDITION");
-      END IF;
- 
-      I := 10;
-      WHILE FT (IDENT_BOOL (I /= 14)) LOOP
-           I := I + 1;
-      END LOOP;
-      IF I /= 14 THEN
-           FAILED ("BAD LOOP FLOW - DYNAMIC CONDITION");
-      END IF;
- 
-      RESULT;
- END C55C02B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c56002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c56002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c56002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c56002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- C56002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT BLOCKS CAN HAVE DECLARATIVE PARTS AND THAT
- --    THE EFFECT OF THESE DECLARATIONS IS LIMITED TO THE BLOCKS
- --    IN WHICH THEY OCCUR.
- 
- 
- -- RM 04/16/81
- -- SPS 3/4/83
- 
- WITH REPORT;
- PROCEDURE  C56002A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C56002A" , "BLOCKS CAN HAVE DECLARATIVE PARTS AND"         &
-                        " THE EFFECT OF THESE DECLARATIONS IS LIMITED"  &
-                        " TO THE BLOCKS IN WHICH THEY OCCUR" )          ;
- 
-      DECLARE
- 
-           FIRST   :  CONSTANT INTEGER := IDENT_INT( 1) ;
-           SECOND  :  CONSTANT INTEGER := IDENT_INT( 2) ;
-           THIRD   :  CONSTANT INTEGER := IDENT_INT( 3) ;
-           FOURTH  :  CONSTANT INTEGER := IDENT_INT( 4) ;
-           FIFTH   :  CONSTANT INTEGER := IDENT_INT( 5) ;
-           TENTH   :  CONSTANT INTEGER := IDENT_INT(10) ;
-           ZEROTH  :  CONSTANT INTEGER := IDENT_INT( 0) ;
- 
-      BEGIN
- 
-           IF   FIRST   /= 1  OR
-                SECOND  /= 2  OR
-                THIRD   /= 3  OR
-                FOURTH  /= 4  OR
-                FIFTH   /= 5  OR
-                TENTH   /=10  OR
-                ZEROTH  /= 0
-           THEN
-                FAILED( "WRONG VALUES  -  1" );
-           END IF;
- 
-           DECLARE
- 
-                TYPE  ENUM   IS  ( AMINUS , A,B,C,D,E,  F,G,H,I,J );
- 
-                FIRST   :  CONSTANT ENUM := A ;
-                SECOND  :  CONSTANT ENUM := B ;
-                THIRD   :  CONSTANT ENUM := C ;
-                FOURTH  :  CONSTANT ENUM := D ;
-                FIFTH   :  CONSTANT ENUM := E ;
-                TENTH   :  CONSTANT ENUM := J ;
-                ZEROTH  :  CONSTANT ENUM := AMINUS ;
- 
-           BEGIN
- 
-                IF   FIRST   /= ENUM'VAL( IDENT_INT( 1 ) )  OR
-                     SECOND  /= ENUM'VAL( IDENT_INT( 2 ) )  OR
-                     THIRD   /= ENUM'VAL( IDENT_INT( 3 ) )  OR
-                     FOURTH  /= ENUM'VAL( IDENT_INT( 4 ) )  OR
-                     FIFTH   /= ENUM'VAL( IDENT_INT( 5 ) )  OR
-                     TENTH   /= ENUM'VAL( IDENT_INT(10 ) )  OR
-                     ZEROTH  /= ENUM'VAL( IDENT_INT( 0 ) )
-                THEN
-                     FAILED( "WRONG VALUES  -  2" );
-                END IF;
- 
-           END ;
- 
-           IF   FIRST   /= 1  OR
-                SECOND  /= 2  OR
-                THIRD   /= 3  OR
-                FOURTH  /= 4  OR
-                FIFTH   /= 5  OR
-                TENTH   /=10  OR
-                ZEROTH  /= 0
-           THEN
-                FAILED( "WRONG VALUES  -  3" );
-           END IF;
- 
-           DECLARE
- 
-                FIRST   :  CONSTANT CHARACTER := 'A' ;
-                SECOND  :  CONSTANT CHARACTER := 'B' ;
-                THIRD   :  CONSTANT CHARACTER := 'C' ;
-                FOURTH  :  CONSTANT CHARACTER := 'D' ;
-                FIFTH   :  CONSTANT CHARACTER := 'E' ;
-                TENTH   :  CONSTANT CHARACTER := 'J' ;
-                ZEROTH  :  CONSTANT CHARACTER := '0' ;--ZERO < ANY LETTER
- 
-           BEGIN
- 
-                IF   FIRST   /= IDENT_CHAR( 'A' )  OR
-                     SECOND  /= IDENT_CHAR( 'B' )  OR
-                     THIRD   /= IDENT_CHAR( 'C' )  OR
-                     FOURTH  /= IDENT_CHAR( 'D' )  OR
-                     FIFTH   /= IDENT_CHAR( 'E' )  OR
-                     TENTH   /= IDENT_CHAR( 'J' )  OR
-                     ZEROTH  /= IDENT_CHAR( '0' )
-                THEN
-                     FAILED( "WRONG VALUES  -  4" );
-                END IF;
- 
-           END ;
- 
-           IF   FIRST   /= 1  OR
-                SECOND  /= 2  OR
-                THIRD   /= 3  OR
-                FOURTH  /= 4  OR
-                FIFTH   /= 5  OR
-                TENTH   /=10  OR
-                ZEROTH  /= 0
-           THEN
-                FAILED( "WRONG VALUES  -  5" );
-           END IF;
- 
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C56002A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c57003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c57003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c57003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c57003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,334 ****
- -- C57003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE EXIT STATEMENT IS EVALUATED EACH TIME THROUGH A LOOP,
- --    AND THAT IT IS EVALUATED CORRECTLY WHETHER POSITIONED AT THE
- --    BEGINNING, MIDDLE, OR END OF THE LOOP.
- 
- 
- 
- -- EACH TEST IS A LOOP ON  J  WHERE THE EXIT CONDITIONS ARE TO EVALUATE
- --    TO  'FALSE'  A CERTAIN NUMBER OF TIMES UNTIL, AT THE APPROPRIATE
- --    TIME, ONE OF THEM EVALUATES TO  'TRUE'  AND CAUSES THE LOOP TO BE
- --    EXITED.
- --
- --
- --    THE TEST IS PERFORMED 30 TIMES FOR EACH OF THE FIRST TWO
- --    DATA TYPES CONSIDERED ('INTEGER', USER-DEFINED ENUMERATION)
- --    AND 26 TIMES FOR 'CHARACTER' (THUS 86 TIMES ALTOGETHER).
- --
- --
- --    EACH DATA TYPE HAS ITS OWN SEPARATE SECTION OF CODE.  ALL SECTIONS
- --    FOLLOW THE SAME TESTING ALGORITHM (MUTATIS MUTANDIS).  THE CALCU-
- --    LATIONS WHICH KEEP TRACK OF THE FLOW OF CONTROL ARE ALL DONE IN
- --    INTEGER ARITHMETIC.  THERE ARE THREE DATA TYPES, THUS THREE
- --    SECTIONS.
- --
- --
- --    FOR EACH DATA TYPE, THE 30 TESTS ARE DIVIDED INTO 3 "SEGMENTS"
- --
- --               << NOTE:  THE NUMBER OF SEGMENTS IS WRITTEN  " 3 "    ,
- --                         THE NUMBER OF SECTIONS IS WRITTEN  "THREE" >>
- --
- --    (OF 10 TESTS EACH, EXCEPT 10,10,6 FOR 'CHARACTER'), NUMBERED
- --     0 , 1 , 2  AND CORRESPONDING TO THE 3 SIGNIFICANTLY DIFFERENT
- --    POSITIONS OF AN EXIT STATEMENT WITH RESPECT TO THE LOOP IT IS IN
- --    ( "AT THE VERY TOP" , "AT THE VERY BOTTOM" , "ANYWHERE IN BETWEEN"
- --    ).  AT THE BEGINNING OF EACH TEST, THE VARIABLE  WHICH_SEGMENT
- --    IS UPDATED TO CONTAIN THE NEW VALUE OF THIS IDENTIFYING NUMBER
- --    (FOR THE TEST ABOUT TO BEGIN):
- --
- --             EXIT AT THE TOP      ........   WHICH_SEGMENT = 0
- --             EXIT FROM THE MIDDLE ........   WHICH_SEGMENT = 1
- --             EXIT AT THE BOTTOM   ........   WHICH_SEGMENT = 2   .
- --
- --
- --    WITHIN EACH SECTION, THE TESTS ARE NUMBERED  FROM  1  TO  30
- --    (26 FOR 'CHARACTER').  THIS NUMBER IS STORED IN THE INTEGER
- --    VARIABLE  INT_I  (EQUAL TO THE CURRENT VALUE OF THE OUTER-LOOP
- --    INDEX WHEN THAT INDEX IS OF INTEGER TYPE), WHOSE APPROPRIATE VALUE
- --    FOR EACH TEST IS SET AT THE BEGINNING OF THE TEST.
- --
- --
- --    AS PART OF THE EVALUATION PROCESS, THE PROGRAM COMPUTES FOR EACH
- --    TEST (I.E.  FOR EACH VALUE OF  I , OR OF  INT_I ) THE APPROPRIATE
- --    NUMBER OF INNER-LOOP ITERATIONS REQUIRED BEFORE EXIT; THIS IS
- --    THE EXPECTED VALUE OF  J  (EXPRESSED AS AN INTEGER IN THE RANGE
- --     1..10 ) AND STORES IT IN  EXPECTED_J .  FOR EACH OF THE THREE
- --    SECTIONS, THE TIME SEQUENCE OF THESE 30 VALUES IS
- --
- --             1   2   3   4   5   6   7   8   9  10     << SEGMENT 1 >>
- --             6   6   7   7   8   8   9   9  10  10     << SEGMENT 2 >>
- --             7   8   8   8   9   9   9  10  10  10     << SEGMENT 3 >>
- --
- --    (EACH SECTION GETS ALL 3 ROWS, NOT ONE ROW PER SECTION;
- --    FOR 'CHARACTER', WHERE ONLY 26 VALUES ARE REQUIRED, THE LAST 4
- --    VALUES ARE OMITTED).  THIS NUMBER IS COMPARED WITH THE ACTUAL
- --    VALUE OF  J  (ACTUAL NUMBER OF INNER-LOOP ITERATIONS BEFORE THE
- --    EXECUTION OF THE EXIT STATEMENT) AS SAVED JUST BEFORE THE EXIT
- --    FROM THE LOOP (AGAIN IN THE FORM OF AN INTEGER IN THE RANGE
- --     1..30 , IRRESPECTIVE OF THE DATA TYPE BEING TESTED),  I F
- --    SUCH SAVED VALUE IS AVAILABLE.
- --
- --
- --    THE ACTUAL VALUE OF INNER-LOOP ITERATIONS (AS SAVED IMMEDIATELY
- --    BEFORE THE EXIT, AS OPPOSED TO A VALUE LEFT OVER FROM SOME
- --    PREVIOUS ITERATION) IS AVAILABLE ONLY IF  WHICH_SEGMENT /= 0 ,
- --    AND IS THEN STORED IN  SAVE_J .
- --
- --
- --    FOR THE CASE  WHICH_SEGMENT = 0 , THE ITERATIONS ARE COUNTED IN
- --    THE VARIABLE  COUNT , WHOSE VALUE AT THE COMPLETION OF THE
- --    I-TH TEST ( I IN 1..10 ) MUST BE EQUAL TO  EXPECTED_J - 1 ,
- --    AND THUS TO  I - 1  (METHODOLOGICALLY AS WELL AS COMPUTATIONALLY
- --    THIS IS NO DIFFERENT FROM USING THE MOST RECENT VALUE OF  SAVE_J
- --    WHEN A CURRENT ONE CANNOT BE OBTAINED).  AFTER BEING INCREMENTED
- --    BY  1 ,  COUNT  IS CHECKED AGAINST  EXPECTED_J .
- --
- --
- --    THIS CONCLUDES THE DESCRIPTION OF THE CASE  WHICH_SEGMENT = 0 ,
- --    AND THUS OF THE ALGORITHM.  THE ONLY REASON FOR SPLITTING THE
- --    CASE  WHICH_SEGMENT /= 0  INTO TWO IS THE DESIRE TO PROVIDE FOR
- --    DISTINCT MESSAGES.
- 
- 
- 
- -- RM 04/23/81
- -- SPS 3/7/83
- 
- WITH REPORT;
- PROCEDURE  C57003A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C57003A" , "TEST THAT THE EXIT STATEMENT IS EVALUATED" &
-                        " EACH TIME THROUGH THE LOOP"               );
- 
-      DECLARE
- 
-           WHICH_SEGMENT  :  INTEGER RANGE 0..2   ;   -- BOUNDS ARE TIGHT
-           SAVE_J         :  INTEGER RANGE 1..10  ;
-           EXPECTED_J     :  INTEGER RANGE 1..10  ;
-           COUNT          :  INTEGER RANGE 0..100     := 0 ;
-           INT_I          :  INTEGER RANGE 1..30  ;
- 
-           TYPE  ENUM  IS    ( CHANGE_THE_ORIGIN_FROM_0_TO_1 ,
- 
-                A1 , A2 , A3 , A4 , A5 , A6 , A7 , A8 , A9 , A10 ,
-                A11, A12, A13, A14, A15, A16, A17, A18, A19, A20 ,
-                A21, A22, A23, A24, A25, A26, A27, A28, A29, A30 );
- 
-      BEGIN
- 
- 
-           --------------------------------------------------------------
-           -----------------------  INTEGER  ----------------------------
- 
- 
-           FOR  I  IN  INTEGER RANGE 1..30  LOOP
- 
- 
-                WHICH_SEGMENT  :=  ( I - 1 ) / 10        ;
-                EXPECTED_J     :=  ( I + WHICH_SEGMENT ) /
-                                   ( WHICH_SEGMENT + 1 ) ;
- 
-                COUNT  :=  0 ;
- 
- 
-                FOR  J  IN  INTEGER RANGE 1..10  LOOP
- 
-                     --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
- 
-                     EXIT WHEN  WHICH_SEGMENT = 0  AND
-                                1*J >= I ;--COUNT+:=1 ON NXT LINE INSTEAD
-                     COUNT := COUNT + 1 ;
- 
-                     NULL ;
-                     NULL ;
-                     NULL ;
-                     SAVE_J := J ;
-                     EXIT WHEN  WHICH_SEGMENT = 1  AND
-                                2*J >= I ;
- 
-                     NULL ;
-                     NULL ;
-                     NULL ;
-                     SAVE_J := J ;
-                     EXIT WHEN  WHICH_SEGMENT = 2  AND
-                                3*J >= I ;
- 
-                END LOOP;
- 
- 
-                COUNT          :=  COUNT + 1             ;  -- SEE HEADER
- 
-                CASE  WHICH_SEGMENT  IS
-                     WHEN  0  =>
-                          IF  COUNT  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT; INT, EXIT AT TOP" );
-                          END IF;
-                     WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
-                          IF  SAVE_J  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT; I,EXIT AT MIDDLE" );
-                          END IF;
-                     WHEN  2  =>
-                          IF  SAVE_J  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT; I,EXIT AT BOTTOM" );
-                          END IF;
-                END CASE;
- 
-           END LOOP;
- 
- 
- 
-           --------------------------------------------------------------
-           ----------------------  CHARACTER  ---------------------------
- 
- 
-           FOR  I  IN  CHARACTER RANGE 'A'..'Z'  LOOP
- 
-                INT_I  := CHARACTER'POS(I) - CHARACTER'POS('A') + 1;
- 
-                WHICH_SEGMENT  :=  ( INT_I - 1 ) / 10        ;
-                EXPECTED_J     :=  ( INT_I + WHICH_SEGMENT ) /
-                                   ( WHICH_SEGMENT + 1 )     ;
- 
-                COUNT  :=  0 ;
- 
- 
-                FOR  J  IN  CHARACTER RANGE 'A'..'J'  LOOP
- 
-                     --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
- 
-                     EXIT WHEN  WHICH_SEGMENT = 0  AND
-                                J >= I ; -- COUNT+:=1 ON NXT LINE INSTEAD
-                     COUNT := COUNT + 1 ;
- 
-                     NULL ;
-                     NULL ;
-                     NULL ;
-                     SAVE_J := CHARACTER'POS(J) - CHARACTER'POS('A') + 1;
-                     EXIT WHEN  WHICH_SEGMENT = 1  AND
-                                2 * SAVE_J >= INT_I ;
- 
-                     NULL ;
-                     NULL ;
-                     NULL ;
-                     EXIT WHEN  WHICH_SEGMENT = 2  AND
-                                3 * SAVE_J >= INT_I ;
- 
-                END LOOP;
- 
- 
-                COUNT          :=    COUNT + 1               ;
- 
-                CASE  WHICH_SEGMENT  IS
-                     WHEN  0  =>
-                          IF  COUNT  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT;CHAR, EXIT AT TOP" );
-                          END IF;
-                     WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
-                          IF  SAVE_J  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT; C,EXIT AT MIDDLE" );
-                          END IF;
-                     WHEN  2  =>
-                          IF  SAVE_J  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT; C,EXIT AT BOTTOM" );
-                          END IF;
-                END CASE;
- 
-           END LOOP;
- 
- 
- 
-           --------------------------------------------------------------
-           ---------------------  ENUMERATION  --------------------------
- 
- 
-           FOR  I  IN  ENUM RANGE A1..A30  LOOP
- 
- 
-                INT_I          :=    ENUM'POS(I) ;
- 
-                WHICH_SEGMENT  :=  ( INT_I - 1 ) / 10        ;
-                EXPECTED_J     :=  ( INT_I + WHICH_SEGMENT ) /
-                                   ( WHICH_SEGMENT + 1 )     ;
- 
-                COUNT  :=  0 ;
- 
- 
-                FOR  J  IN  ENUM RANGE A1..A10  LOOP
- 
-                     --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
- 
-                     EXIT WHEN  WHICH_SEGMENT = 0  AND
-                                J >= I ; -- COUNT+:=1 ON NXT LINE INSTEAD
-                     COUNT := COUNT + 1 ;
- 
-                     NULL ;
-                     NULL ;
-                     NULL ;
-                     SAVE_J := ENUM'POS(J) ;
-                     EXIT WHEN  WHICH_SEGMENT = 1  AND
-                                2 * SAVE_J >= INT_I ;
- 
-                     NULL ;
-                     NULL ;
-                     NULL ;
-                     EXIT WHEN  WHICH_SEGMENT = 2  AND
-                                3 * SAVE_J >= INT_I ;
- 
-                END LOOP;
- 
- 
-                COUNT          :=    COUNT + 1               ;
- 
-                CASE  WHICH_SEGMENT  IS
-                     WHEN  0  =>
-                          IF  COUNT  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT;ENUM, EXIT AT TOP" );
-                          END IF;
-                     WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
-                          IF  SAVE_J  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT; E,EXIT AT MIDDLE" );
-                          END IF;
-                     WHEN  2  =>
-                          IF  SAVE_J  /=  EXPECTED_J  THEN
-                               FAILED( "WRONG COUNT; E,EXIT AT BOTTOM" );
-                          END IF;
-                END CASE;
- 
-           END LOOP;
- 
-           --------------------------------------------------------------
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C57003A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c57004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c57004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c57004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c57004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- C57004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXIT STATEMENT WITH A LOOP NAME TERMINATES EXECUTION
- --    OF THE LOOP STATEMENT WHOSE NAME IT MENTIONS, AND OF ALL OTHER
- --    LOOP STATEMENTS (IF ANY) INTERIOR TO THE FIRST LOOP AND ENCLOSING
- --    THE EXIT STATEMENT.
- 
- -- CASE 1 :  UNCONDITIONAL EXITS.
- 
- 
- -- RM 04/24/81
- -- SPS 3/7/83
- 
- WITH REPORT;
- PROCEDURE  C57004A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C57004A" , "CHECK THAT A NAMING EXIT STATEMENT TERMINATES" &
-                        " EXECUTION OF THE NAMED LOOP AND OF ALL LOOPS" &
-                        " SITUATED IN-BETWEEN"                         );
- 
-      DECLARE
- 
-           COUNT : INTEGER     := 0   ;
- 
-      BEGIN
- 
-           OUTERMOST :
-           FOR  X  IN  INTEGER RANGE 1..2  LOOP
- 
-                FOR  Y  IN  INTEGER RANGE 1..2  LOOP
- 
-                     COMMENT( "BEFORE 1" );
- 
-                     LOOP1 :
-                     FOR  I  IN  1..10  LOOP
-                          COMMENT( "INSIDE 1" );
-                          EXIT  LOOP1 ;
-                          FAILED( "EXIT NOT OBEYED (1)" );
-                          FOR  J  IN  1..10  LOOP
-                               FAILED( "OUTER EXIT NOT OBEYED (1)" );
-                               EXIT ;
-                               FAILED( "BOTH EXITS IGNORED (1)" );
-                          END LOOP;
-                     END LOOP  LOOP1 ;
- 
- 
-                     COMMENT( "BEFORE 2" );
-                     COUNT := COUNT + 1 ;
- 
-                     LOOP2 :
-                     FOR  A  IN  1..1  LOOP
-                          FOR  B  IN  1..1  LOOP
- 
-                               FOR  I  IN  CHARACTER  LOOP
-                                    COMMENT( "INSIDE 2" );
-                                    EXIT  LOOP2 ;
-                                    FAILED( "EXIT NOT OBEYED (2)" );
-                                    FOR  J  IN  BOOLEAN  LOOP
-                                         FAILED( "OUTER EXIT NOT " &
-                                                 "OBEYED (2)");
-                                         EXIT ;
-                                         FAILED( "BOTH EXITS IGNORED " &
-                                                 "(2)");
-                                    END LOOP;
-                               END LOOP;
- 
-                          END LOOP;
-                     END LOOP  LOOP2 ;
- 
- 
-                     COMMENT( "BEFORE 3" );
-                     COUNT := COUNT + 1 ;
- 
-                     LOOP3 :
-                     FOR  A  IN  1..1  LOOP
-                          FOR  B  IN  1..1  LOOP
- 
-                               FOR  I  IN  BOOLEAN  LOOP
-                                    COMMENT( "INSIDE 3" );
-                                    BEGIN
-                                         EXIT  LOOP3 ;
-                                         FAILED( "EXIT NOT OBEYED (3)" );
-                                    END ;
-                                    FAILED( "EXIT NOT OBEYED (3BIS)" );
-                               END LOOP;
- 
-                          END LOOP;
-                     END LOOP  LOOP3 ;
- 
- 
-                     COMMENT( "BEFORE 4" );
-                     COUNT := COUNT + 1 ;
- 
-                     LOOP4 :
-                     FOR  A  IN  1..1  LOOP
-                          FOR  B  IN  1..1  LOOP
- 
- 
-                               FOR  I  IN  INTEGER RANGE 1..10  LOOP
-                                    COMMENT( "INSIDE 4" );
-                                    CASE  A  IS
-                                         WHEN  1  =>
-                                              EXIT  LOOP4 ;
-                                              FAILED("EXIT NOT OBEYED " &
-                                                     "(4)" );
-                                    END CASE;
-                                    FAILED( "EXIT NOT OBEYED (4BIS)" );
-                               END LOOP;
- 
-                          END LOOP;
-                     END LOOP  LOOP4 ;
- 
- 
-                     COMMENT( "AFTER 4" );
-                     COUNT := COUNT + 1 ;
-                     EXIT  OUTERMOST ;
- 
-                END LOOP;
- 
-                FAILED( "MISSED FINAL EXIT" );
- 
-           END LOOP  OUTERMOST ;
- 
- 
-           IF  COUNT /= 4  THEN
-                FAILED( "WRONG FLOW OF CONTROL" );
-           END IF;
- 
-      END ;
- 
-      RESULT ;
- 
- 
- END  C57004A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c57004b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c57004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c57004b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c57004b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,162 ****
- -- C57004B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXIT STATEMENT WITH A LOOP NAME TERMINATES EXECUTION
- --    OF THE LOOP STATEMENT WHOSE NAME IT MENTIONS, AND OF ALL OTHER
- --    LOOP STATEMENTS (IF ANY) INTERIOR TO THE FIRST LOOP AND ENCLOSING
- --    THE EXIT STATEMENT.
- 
- -- CASE 2 :  CONDITIONAL EXITS.
- 
- 
- -- RM 04/27/81
- -- SPS 3/7/83
- 
- WITH REPORT;
- PROCEDURE  C57004B  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C57004B" , "CHECK THAT A NAMING EXIT STATEMENT TERMINATES" &
-                        " EXECUTION OF THE NAMED LOOP AND OF ALL LOOPS" &
-                        " SITUATED IN-BETWEEN"                         );
- 
-      DECLARE
- 
-           COUNT : INTEGER     := 0   ;
- 
-      BEGIN
- 
-           OUTERMOST :
-           FOR  X  IN  INTEGER RANGE 1..2  LOOP
- 
-                FOR  Y  IN  INTEGER RANGE 1..2  LOOP
- 
-                     COMMENT( "BEFORE 1" );
- 
-                     LOOP1 :
-                     FOR  I  IN  1..10  LOOP
-                          COMMENT( "INSIDE 1" );
-                          EXIT  LOOP1  WHEN  EQUAL(1,1) ;
-                          FAILED( "EXIT NOT OBEYED (1)" );
-                          FOR  J  IN  1..10  LOOP
-                               FAILED( "OUTER EXIT NOT OBEYED (1)" );
-                               EXIT  WHEN EQUAL(1,1) ;
-                               FAILED( "BOTH EXITS IGNORED (1)" );
-                          END LOOP;
-                     END LOOP  LOOP1 ;
- 
- 
-                     COMMENT( "BEFORE 2" );
-                     COUNT := COUNT + 1 ;
- 
-                     LOOP2 :
-                     FOR  A  IN  1..1  LOOP
-                          FOR  B  IN  1..1  LOOP
- 
-                               FOR  I  IN  CHARACTER  LOOP
-                                    COMMENT( "INSIDE 2" );
-                                    EXIT  LOOP2  WHEN  EQUAL(1,1) ;
-                                    FAILED( "EXIT NOT OBEYED (2)" );
-                                    FOR  J  IN  BOOLEAN  LOOP
-                                         FAILED( "OUTER EXIT NOT " &
-                                                 "OBEYED (2)");
-                                         EXIT  WHEN EQUAL(1,1) ;
-                                         FAILED( "BOTH EXITS IGNORED " &
-                                                 "(2)");
-                                    END LOOP;
-                               END LOOP;
- 
-                          END LOOP;
-                     END LOOP  LOOP2 ;
- 
- 
-                     COMMENT( "BEFORE 3" );
-                     COUNT := COUNT + 1 ;
- 
-                     LOOP3 :
-                     FOR  A  IN  1..1  LOOP
-                          FOR  B  IN  1..1  LOOP
- 
-                               FOR  I  IN  BOOLEAN  LOOP
-                                    COMMENT( "INSIDE 3" );
-                                    BEGIN
-                                         EXIT  LOOP3  WHEN  EQUAL(1,1) ;
-                                         FAILED( "EXIT NOT OBEYED (3)" );
-                                    END ;
-                                    FAILED( "EXIT NOT OBEYED (3BIS)" );
-                               END LOOP;
- 
-                          END LOOP;
-                     END LOOP  LOOP3 ;
- 
- 
-                     COMMENT( "BEFORE 4" );
-                     COUNT := COUNT + 1 ;
- 
-                     LOOP4 :
-                     FOR  A  IN  1..1  LOOP
-                          FOR  B  IN  1..1  LOOP
- 
- 
-                               FOR  I  IN  INTEGER RANGE 1..10  LOOP
-                                    COMMENT( "INSIDE 4" );
-                                    CASE  A  IS
-                                         WHEN  1  =>
-                                              EXIT LOOP4 WHEN EQUAL(1,1);
-                                              FAILED("EXIT NOT OBEYED " &
-                                                     "(4)" );
-                                    END CASE;
-                                    FAILED( "EXIT NOT OBEYED (4BIS)" );
-                               END LOOP;
- 
-                          END LOOP;
-                     END LOOP  LOOP4 ;
- 
- 
-                     COMMENT( "AFTER 4" );
-                     COUNT := COUNT + 1 ;
-                     EXIT  OUTERMOST ;
- 
-                END LOOP;
- 
-                FAILED( "MISSED FINAL EXIT" );
- 
-           END LOOP  OUTERMOST ;
- 
- 
-           IF  COUNT /= 4  THEN
-                FAILED( "WRONG FLOW OF CONTROL" );
-           END IF;
- 
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END  C57004B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58004c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58004c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58004c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C58004C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE RETURN STATEMENT WORKS FOR RECURSIVE SUBPROGRAMS,
- --    BOTH FUNCTIONS AND PROCEDURES.
- 
- -- DCB 2/8/80
- -- SPS 3/7/83
- -- JBG 5/17/83
- 
- WITH REPORT;
- PROCEDURE C58004C IS
- 
-      USE REPORT;
- 
-      I1, I2 : INTEGER := 0;   -- INITIAL VALUE IS IMMATERIAL
- 
-      PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER) IS
- 
-      BEGIN
-           IF IP1 = 1 THEN
-                IP2 := 1;
-                RETURN;
-           ELSE FACTORIALP (IP1 - 1, IP2);
-                IP2 := IP1 * IP2;
-                RETURN;
-           END IF;
- 
-           IP2 := 0;
- 
-      END FACTORIALP;
- 
-      FUNCTION FACTORIALF (IF1 : INTEGER) RETURN INTEGER IS
- 
-      BEGIN
-           IF IF1 = 1 THEN RETURN (1);
-           END IF;
- 
-           RETURN (IF1 * FACTORIALF(IF1 - 1) );
- 
-      END FACTORIALF;
- 
- BEGIN
-      TEST ("C58004C", "CHECK THAT THE RETURN STATEMENT WORKS FOR" &
-            " RECURSIVE FUNCTIONS AND PROCEDURES");
- 
-      I1 := FACTORIALF (5);
- 
-      IF I1 /= 120 THEN
-            FAILED ("RETURN STATEMENT IN RECURSIVE FUNCTION NOT " &
-                    "WORKING");
-      END IF;
- 
-      FACTORIALP (5, I2);
- 
-      IF I2 = 0 THEN
-           FAILED ("RETURN STATEMENT IN RECURSIVE PROCEDURE NOT " &
-                   "WORKING");
-      ELSIF I2 /= 120 THEN
-           FAILED
-           ("RETURN STMT IN RECURSIVE PROCEDURE NOT WORKING CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C58004C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58004d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58004d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58004d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58004d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C58004D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RETURN STATEMENT TERMINATES EXECUTION
- --    OF THE INNERMOST ENCLOSING SUBPROGRAM.
- 
- -- CHECKS GENERIC SUBPROGRAMS.
- 
- -- SPS 3/7/83
- -- JRK 1/31/84
- 
- WITH REPORT;
- PROCEDURE C58004D IS
- 
-      USE REPORT;
- 
-      I1, I2 : INTEGER;
- 
-      GENERIC
-      PROCEDURE ADDM (IA1 : IN OUT INTEGER; IA2 : IN INTEGER);
- 
-      PROCEDURE ADDM (IA1 : IN OUT INTEGER; IA2 : IN INTEGER) IS
- 
-           GENERIC
-           PROCEDURE MULT (IM1 : IN OUT INTEGER; IM2 : IN INTEGER);
- 
-           PROCEDURE MULT (IM1 : IN OUT INTEGER; IM2 : IN INTEGER) IS
-           BEGIN
-                IM1 := IM1 * IM2;
- 
-                IF IM1 > 0 THEN RETURN;
-                END IF;
- 
-                IM1 := 0;
-           END MULT;
- 
-           PROCEDURE MLT IS NEW MULT;
- 
-      BEGIN
-           MLT (IA1, IA2);
-           IA1 := IA1 + IA2;
- 
-           IF IA1 > 0 THEN RETURN;
-           END IF;
- 
-           IA1 := 0;
-      END ADDM;
- 
-      PROCEDURE ADM IS NEW ADDM;
- 
- BEGIN
-      TEST ("C58004D","CHECK THAT RETURN TERMINATES EXECUTION OF ONLY" &
-            " THE INNERMOST ENCLOSING GENERIC SUBPROGRAM");
- 
-      I1 := 2;
-      I2 := 3;
-      ADM (I1,I2);     -- SAME AS I1 := (I1 * I2) + I2
- 
-      IF I1 = 0 THEN
-           FAILED ("RETURN DOES NOT TERMINATE SUBPROGRAM");
-      ELSIF I1 = 6 THEN
-           FAILED
-           ("RETURN TERMINATES ALL SUBPROGRAMS NOT JUST INNERMOST");
-      ELSIF I1 /= 9 THEN
-           FAILED ("RETURN STATEMENT NOT WORKING CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C58004D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58004g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58004g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58004g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58004g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C58004G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE RETURN STATEMENT WORKS FOR RECURSIVE SUBPROGRAMS,
- --    BOTH FUNCTIONS AND PROCEDURES.
- 
- -- CHECK GENERIC SUBPROGRAMS.
- 
- -- SPS 3/7/83
- -- JBG 9/13/83
- 
- WITH REPORT;
- PROCEDURE C58004G IS
- 
-      USE REPORT;
- 
-      I1, I2 : INTEGER := 0;
- 
-      GENERIC
-      PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER);
- 
-      GENERIC
-      FUNCTION FACTORIALF (IF1: INTEGER) RETURN INTEGER;
- 
-      PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER) IS
-      BEGIN
-           IF IP1 = 1 THEN
-                IP2 := 1;
-                RETURN;
-           ELSE FACTORIALP (IP1 - 1, IP2);
-                IP2 := IP1 * IP2;
-                RETURN;
-           END IF;
- 
-           IP2 := 0;
- 
-      END FACTORIALP;
- 
-      FUNCTION FACTORIALF (IF1 : INTEGER) RETURN INTEGER IS
- 
-      BEGIN
-           IF IF1 = 1 THEN RETURN (1);
-           END IF;
- 
-           RETURN (IF1 * FACTORIALF(IF1 - 1) );
- 
-      END FACTORIALF;
- 
-      PROCEDURE FACTP IS NEW FACTORIALP;
-      FUNCTION FACTF IS NEW FACTORIALF;
- 
- BEGIN
-      TEST ("C58004G", "CHECK THAT THE RETURN STATEMENT WORKS FOR" &
-            " RECURSIVE GENERIC FUNCTIONS AND PROCEDURES");
- 
-      I1 := FACTF (5);
- 
-      IF I1 /= 120 THEN
-            FAILED ("RETURN STATEMENT IN RECURSIVE FUNCTION NOT " &
-                    "WORKING");
-      END IF;
- 
-      FACTP (5, I2);
- 
-      IF I2 = 0 THEN
-           FAILED ("RETURN STATEMENT IN RECURSIVE PROCEDURE NOT " &
-                   "WORKING");
-      ELSIF I2 /= 120 THEN
-           FAILED
-           ("RETURN STMT IN RECURSIVE PROCEDURE NOT WORKING CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C58004G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- C58005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A FUNCTION IS READY TO RETURN CONTROL TO ITS INVOKER
- --    THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT
- --     CONSTRAINT ERROR  IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS
- --    ARE NOT SATISFIED.
- 
- -- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE
- --    CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION.  THE
- --    PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED
- --    ELSEWHERE.
- 
- 
- -- RM 05/14/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE  C58005A  IS
- 
-      USE  REPORT ;
- 
-      INTVAR  :  INTEGER ;
- 
- BEGIN
- 
-      TEST( "C58005A" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
-                        " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
-                        " VIOLATED" );
- 
- 
-      DECLARE
-           SUBTYPE I1 IS INTEGER RANGE -10..90;
-           SUBTYPE I2 IS INTEGER RANGE 1..10;
-           FUNCTION  FN1( X : I1 )
-                     RETURN  I2  IS
-           BEGIN
-                RETURN  0 ;
-           END  FN1 ;
- 
-           FUNCTION  FN2( X : I1 )
-                     RETURN  I2  IS
-           BEGIN
-                RETURN  X + IDENT_INT(0) ;
-           END  FN2 ;
- 
-           FUNCTION  FN3( X : I1  )
-                     RETURN  I2  IS
-                HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100) ;
-           BEGIN
-                RETURN  HUNDRED - 90 ;
-           END  FN3 ;
- 
-      BEGIN
- 
-           INTVAR := 0 ;
- 
-           BEGIN
-                INTVAR := FN1( 0 ) + INTVAR ;  -- EXCEPTION.
-                FAILED( "EXCEPTION NOT RAISED  -  1" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ;
-                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" ) ;
-           END ;
- 
-           BEGIN
-                INTVAR := FN2( 1 ) + INTVAR ; -- 10+1=11 -- NO EXCEPTION.
-                INTVAR := INTVAR + 100 ;   -- 11+100=111
-           EXCEPTION
-                WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  2" ) ;
-           END ;
- 
-           BEGIN
-                INTVAR := FN2(11 ) + INTVAR ;  -- EXCEPTION.
-                FAILED( "EXCEPTION NOT RAISED  -  3" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ; -- 121
-                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  3" ) ;
-           END ;
- 
-           BEGIN
-                INTVAR := FN3( 0 ) + INTVAR ;--121+10=131 --NO EXCEPTION.
-                INTVAR := INTVAR + 1000 ;-- 131+1000=1131
-           EXCEPTION
-                WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  4" ) ;
-           END ;
- 
- 
-      END ;
- 
- 
-      IF  INTVAR /= 1131  THEN
-           FAILED("WRONG FLOW OF CONTROL" );
-      END IF;
- 
- 
-      RESULT ;
- 
- 
- END C58005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C58005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC FUNCTION IS READY TO RETURN CONTROL TO ITS 
- --    INVOKER THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT
- --    CONSTRAINT ERROR  IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS
- --    ARE NOT SATISFIED.
- 
- -- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE
- --    CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION.  THE
- --    PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED
- --    ELSEWHERE.
- 
- -- SPS 3/10/83
- -- JBG 9/13/83
- -- AH  8/29/86  ADDED CALLS TO "FAILED" AFTER "IF" STATEMENTS.
- 
- WITH REPORT;
- PROCEDURE  C58005B  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "C58005B" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
-                        " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
-                        " VIOLATED" );
- 
- 
-      DECLARE
-           SUBTYPE I1 IS INTEGER RANGE -10..90;
-           SUBTYPE I2 IS INTEGER RANGE 1..10;
- 
-           GENERIC
-           FUNCTION FN1 ( X : I1 ) RETURN I2;
- 
-           FUNCTION  FN1( X : I1 )
-                     RETURN  I2  IS
-           BEGIN
-                RETURN X;
-           END  FN1;
- 
-           FUNCTION F1 IS NEW FN1;
- 
-      BEGIN
- 
-           BEGIN
-                IF F1(IDENT_INT(0)) IN I2 THEN
-                     FAILED( "EXCEPTION NOT RAISED  -  1A" );
-                ELSE
-                     FAILED( "EXCEPTION NOT RAISED  -  1B" );
-                END IF;          
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" );
-           END;
- 
-           BEGIN
-                IF F1(IDENT_INT(11)) IN I2 THEN
-                     FAILED( "EXCEPTION NOT RAISED  -  2A" );
-                ELSE
-                     FAILED( "EXCEPTION NOT RAISED  -  2B" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  2" );
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C58005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58005h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58005h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58005h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58005h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,172 ****
- -- C58005H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINTS ON THE RETURN VALUE OF A FUNCTION ARE
- -- SATISIFIED WHEN THE FUNCTION RETURNS CONTROL TO ITS INVOKER.
- 
- -- THIS TESTS CHECKS FOR CONSTRAINTS ON CONSTRAINED ACCESS TYPES WITH
- -- RECORD, ARRAY, PRIVATE AND LIMITED PRIVATE DESIGNATED TYPES.
- 
- -- SPS 3/10/83
- -- RLB 6/29/01 - Repaired test to work in the face of aggressive optimizations.
- --               The objects must be used, and must be tied somehow to the
- --               calls to Failed.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C58005H IS
- 
-      PACKAGE PACK IS
-           TYPE PV (D : NATURAL) IS PRIVATE;
-           TYPE LP (D : NATURAL) IS LIMITED PRIVATE;
-      PRIVATE
-           TYPE PV (D : NATURAL) IS RECORD
-                NULL;
-           END RECORD;
-           TYPE LP (D : NATURAL) IS RECORD
-                NULL;
-           END RECORD;
-      END PACK;
- 
-      USE PACK;
- 
-      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF NATURAL;
-      TYPE REC (D : NATURAL) IS RECORD
-           NULL;
-      END RECORD;
- 
-      TYPE ACC_REC IS ACCESS REC;
-      TYPE ACC_ARR IS ACCESS ARR;
-      TYPE ACC_PV IS ACCESS PV;
-      TYPE ACC_LP IS ACCESS LP;
- 
-      SUBTYPE ACC_REC1 IS ACC_REC (D => 1);
-      SUBTYPE ACC_REC2 IS ACC_REC (D => 2);
- 
-      SUBTYPE ACC_ARR1 IS ACC_ARR (1 .. 10);
-      SUBTYPE ACC_ARR2 IS ACC_ARR (2 .. 5);
- 
-      SUBTYPE ACC_PV1 IS ACC_PV (D => 1);
-      SUBTYPE ACC_PV2 IS ACC_PV (D => 2);
- 
-      SUBTYPE ACC_LP1 IS ACC_LP (D => 1);
-      SUBTYPE ACC_LP2 IS ACC_LP (D => 2);
- 
-      VAR1 : ACC_REC1 := NEW REC(1);
-      VAR2 : ACC_REC2 := NEW REC(2);
-      VAA1 : ACC_ARR1 := NEW ARR(1 .. 10);
-      VAA2 : ACC_ARR2 := NEW ARR(2 .. 5);
-      VAP1 : ACC_PV1 := NEW PV(1);
-      VAP2 : ACC_PV2 := NEW PV(2);
-      VAL1 : ACC_LP1 := NEW LP(1);
-      VAL2 : ACC_LP2 := NEW LP(2);
- 
-      FUNCTION FREC ( X : ACC_REC1) RETURN ACC_REC2 IS
-      BEGIN
-           RETURN X;
-      END FREC;
- 
-      FUNCTION FARR ( X : ACC_ARR1) RETURN ACC_ARR2 IS
-      BEGIN
-           RETURN X;
-      END FARR;
- 
-      FUNCTION FPV ( X : ACC_PV1) RETURN ACC_PV2 IS
-      BEGIN
-           RETURN X;
-      END FPV;
- 
-      FUNCTION FLP ( X : ACC_LP1) RETURN ACC_LP2 IS
-      BEGIN
-           RETURN X;
-      END FLP;
- 
-      PACKAGE BODY PACK IS
-           FUNCTION LF (X : LP) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT(3);
-           END LF;
-      BEGIN
-           NULL;
-      END PACK;
- 
- BEGIN
- 
-      TEST ("C58005H", "CHECK ACCESS CONSTRAINTS ON RETURN VALUES " &
-                       "OF FUNCTIONS");
- 
-      BEGIN
-           VAR2 := FREC (VAR1);
-           IF VAR2.D /= REPORT.IDENT_INT(2) THEN
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 1");
-           ELSE
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - REC");
-      END;
- 
-      BEGIN
-           VAA2 := FARR (VAA1);
-           IF VAA2'FIRST /= REPORT.IDENT_INT(2) THEN
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 1");
-           ELSE
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - ARR");
-      END;
- 
-      BEGIN
-           VAP2 := FPV (VAP1);
-           IF VAP2.D /= REPORT.IDENT_INT(2) THEN
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 1");
-           ELSE
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - PV");
-      END;
- 
-      BEGIN
-           VAL2 := FLP (VAL1);
-           IF VAL2.D /= REPORT.IDENT_INT(2) THEN
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 1");
-           ELSE
-               FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 2");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR => NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - LP");
-      END;
- 
-      RESULT;
- END C58005H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C58006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE EVALUATION OF A RETURN STATEMENT'S EXPRESSION
- -- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
- -- THE FUNCTION. 
- 
- -- RM 05/11/81
- -- SPS 10/26/82
- -- SPS 3/8/83
- -- JBG 9/13/83
- 
- WITH REPORT;
- PROCEDURE  C58006A  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "C58006A" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
-                        " STATEMENT CAN BE HANDLED LOCALLY" );
- 
- 
-      DECLARE
-           SUBTYPE I1 IS INTEGER RANGE -10..90;
-           SUBTYPE I2 IS INTEGER RANGE 1..10; 
- 
-           FUNCTION  FN1( X : I1 )
-                     RETURN  I2  IS
-           BEGIN
-                RETURN  0;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     COMMENT ("EXCEPTION RAISED - F1");
-                     RETURN 1;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FN1");
-           END  FN1;
- 
-           FUNCTION  FN2( X : I1 )
-                     RETURN  I2  IS
-           BEGIN
-                RETURN  X + IDENT_INT(0);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     COMMENT ("EXCEPTION RAISED - F2");
-                     RETURN 1;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FN2");
-           END  FN2;
- 
-           FUNCTION  FN3( X : I1 )
-                     RETURN  I2  IS
-                HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
-           BEGIN
-                RETURN  HUNDRED;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     COMMENT ("EXCEPTION RAISED - F3");
-                     RETURN 1;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FN3");
-           END  FN3;
- 
-      BEGIN
- 
-           BEGIN
-                IF FN1( 0 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - FN1( 0 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - FN1( 0 )");
-           END;
- 
-           BEGIN
-                IF FN2( 0 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - FN2( 0 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - FN2( 0 )");
-           END;
- 
-           BEGIN
-                IF FN2(11 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - FN2(11 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - FN2(11 )");
-           END;
- 
-           BEGIN
-                IF FN3( 0 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - FN3( 0 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - FN3( 0 )");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C58006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58006b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c58006b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c58006b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- C58006B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE EVALUATION OF A RETURN STATEMENT'S EXPRESSION
- -- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
- -- THE FUNCTION. 
- 
- -- CHECKS GENERIC FUNCTIONS.
- 
- -- SPS 3/8/83
- -- JBG 9/13/83
- 
- WITH REPORT;
- PROCEDURE  C58006B  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "C58006B" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
-                        " STATEMENT CAN BE HANDLED LOCALLY" );
- 
- 
-      DECLARE
-           SUBTYPE I1 IS INTEGER RANGE -10..90;
-           SUBTYPE I2 IS INTEGER RANGE 1..10; 
- 
-           GENERIC
-           FUNCTION FN1 (X : I1) RETURN I2;
- 
-           GENERIC
-           FUNCTION FN2 (X : I1) RETURN I2;
- 
-           GENERIC
-           FUNCTION FN3 (X : I1) RETURN I2;
- 
-           FUNCTION  FN1( X : I1 )
-                     RETURN  I2  IS
-           BEGIN
-                RETURN  0;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     COMMENT ("EXCEPTION RAISED - F1");
-                     RETURN 1;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FN1");
-           END  FN1;
- 
-           FUNCTION  FN2( X : I1 )
-                     RETURN  I2  IS
-           BEGIN
-                RETURN  X + IDENT_INT(0);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     COMMENT ("EXCEPTION RAISED - F2");
-                     RETURN 1;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FN2");
-           END  FN2;
- 
-           FUNCTION  FN3( X : I1 )
-                     RETURN  I2  IS
-                HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
-           BEGIN
-                RETURN  HUNDRED;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => 
-                     COMMENT ("EXCEPTION RAISED - F3");
-                     RETURN 1;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FN3");
-           END  FN3;
- 
-           FUNCTION F1 IS NEW FN1;
-           FUNCTION F2 IS NEW FN2;
-           FUNCTION F3 IS NEW FN3;
- 
-      BEGIN
- 
-           BEGIN
-                IF F1( 0 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - F1( 0 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - F1( 0 )");
-           END;
- 
-           BEGIN
-                IF F2( 0 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - F2( 0 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - F2( 0 )");
-           END;
- 
-           BEGIN
-                IF F2(11 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - F2(11 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - F2(11 )");
-           END;
- 
-           BEGIN
-                IF F3( 0 ) /= IDENT_INT(1) THEN
-                     FAILED ("NO EXCEPTION RAISED - F3( 0 )");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION PROPAGATED - F3( 0 )");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END C58006B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c59002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c59002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c59002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c59002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C59002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT JUMPS OUT OF AN EXCEPTION HANDLER CONTAINED IN A BLOCK
- --    TO A STATEMENT IN AN ENCLOSING UNIT ARE ALLOWED AND ARE PERFORMED 
- --    CORRECTLY.
- 
- 
- -- RM 05/22/81
- -- SPS 3/8/83
- 
- WITH REPORT;
- PROCEDURE  C59002A  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C59002A" , "CHECK THAT JUMPS OUT OF EXCEPTION HANDLERS" &
-                        " ARE ALLOWED" );
- 
-      DECLARE
- 
-           FLOW : INTEGER := 1 ;
-           EXPON: INTEGER RANGE 0..3 := 0 ;
- 
-      BEGIN
- 
-           GOTO  START ;
- 
-           FAILED( "'GOTO' NOT OBEYED" );
- 
-           << BACK_LABEL >>
-           FLOW  := FLOW  * 3**EXPON ;                    -- 1*5*9
-           EXPON := EXPON + 1 ;
-           GOTO  FINISH ;
- 
-           << START >>
-           FLOW  := FLOW  * 7**EXPON ;                    -- 1
-           EXPON := EXPON + 1 ;
- 
-           DECLARE
-           BEGIN
-                RAISE  CONSTRAINT_ERROR ;
-                FAILED( "EXCEPTION NOT RAISED  -  1" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR  =>
-                     GOTO  FORWARD_LABEL ;
-           END ;
- 
-           FAILED( "INNER 'GOTO' NOT OBEYED  -  1" );
- 
-           << FORWARD_LABEL >>
-           FLOW  := FLOW  * 5**EXPON ;                    -- 1*5
-           EXPON := EXPON + 1 ;
- 
-           DECLARE
-           BEGIN
-                RAISE  CONSTRAINT_ERROR ;
-                FAILED( "EXCEPTION NOT RAISED  -  2" );
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR  =>
-                     GOTO  BACK_LABEL ;
-           END ;
- 
-           FAILED( "INNER 'GOTO' NOT OBETED  -  2" );
- 
-           << FINISH >>
-           FLOW  := FLOW  * 2**EXPON ;                    -- 1*5*9*8
- 
-           IF  FLOW /= 360  THEN
-                FAILED( "WRONG FLOW OF CONTROL" );
-           END IF;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END C59002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c59002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c59002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c59002b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c59002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,209 ****
- -- C59002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT JUMPS OUT OF COMPOUND STATEMENTS (OTHER THAN
- --    ACCEPT STATEMENTS) ARE POSSIBLE AND ARE CORRECTLY PERFORMED.
- 
- 
- -- FLOW OF CONTROL:   A ->  B ->  C ->  D ->   E ->  F ->  G ->  H .
- --                    |     |     |     |      |     |     |
- --                    IF   LOOP   CASE  BLOCK  IF   LOOP   CASE
- --                                             LOOP CASE   BLOCK
- 
- 
- --          A : GOTO B              L111 -> L311
- --          FAILURE                 L121
- --          E : GOTO F              L131 -> L331
- 
- --          FAILURE                 L100
- 
- --          C : GOTO D              L211 -> L411
- --          FAILURE                 L221
- --          G : GOTO H              L231
- 
- --          FAILURE                 L200
- 
- --          B : GOTO C              L311 -> L211
- --          FAILURE                 L321
- --          F : GOTO G              L331
- 
- --          FAILURE                 L300
- 
- --          D : GOTO E              L411 -> L131
- --          FAILURE                 L421
- --          H :                     L431 -> (OUT)
- 
- --          PRINT RESULTS
- 
- 
- -- RM 06/05/81
- -- SPS 3/8/83
- 
- WITH REPORT;
- PROCEDURE  C59002B  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "C59002B" , "CHECK THAT ONE CAN JUMP OUT OF COMPOUND STATE" &
-                        "MENTS" );
- 
- 
-      DECLARE
- 
-           FLOW_STRING : STRING(1..8) := "XXXXXXXX" ;
-           INDEX       : INTEGER      :=  1 ;
- 
-      BEGIN
- 
-           << L111 >>
- 
-           FLOW_STRING(INDEX) := 'A' ;
-           INDEX              := INDEX + 1 ;
- 
-           IF  FALSE  THEN
-                FAILED( "WRONG 'IF' BRANCH" );
-           ELSE
-                GOTO  L311 ;
-           END IF;
- 
-           << L121 >>
- 
-           FAILED( "AT L121  -  WRONGLY" );
- 
-           << L131 >>
- 
-           FLOW_STRING(INDEX) := 'E' ;
-           INDEX              := INDEX + 1 ;
- 
-           IF  FALSE  THEN
-                FAILED( "WRONG 'IF' BRANCH" );
-           ELSE
-                FOR  J  IN  1..1  LOOP
-                     GOTO  L331 ;
-                END LOOP;
-           END IF;
- 
-           << L100 >>
- 
-           FAILED( "AT L100  -  WRONGLY" );
- 
-           << L211 >>
- 
-           FLOW_STRING(INDEX) := 'C' ;
-           INDEX              := INDEX + 1 ;
- 
-           CASE  2  IS
-                WHEN  1  =>
-                     FAILED( "WRONG 'CASE' BRANCH" );
-                WHEN  OTHERS  =>
-                     GOTO  L411 ;
-           END CASE;
- 
-           << L221 >>
- 
-           FAILED( "AT L221  -  WRONGLY" );
- 
-           << L231 >>
- 
-           FLOW_STRING(INDEX) := 'G' ;
-           INDEX              := INDEX + 1 ;
- 
-           CASE  2  IS
-                WHEN  1  =>
-                     FAILED( "WRONG 'CASE' BRANCH" );
-                WHEN  OTHERS  =>
-                     DECLARE
-                     BEGIN
-                          GOTO  L431 ;
-                     END ;
-           END CASE;
- 
-           << L200 >>
- 
-           FAILED( "AT L200  -  WRONGLY" );
- 
-           << L311 >>
- 
-           FLOW_STRING(INDEX) := 'B' ;
-           INDEX              := INDEX + 1 ;
- 
-           FOR  I  IN  1..1  LOOP
-                GOTO  L211 ;
-           END LOOP;
- 
-           << L321 >>
- 
-           FAILED( "AT L321  -  WRONGLY" );
- 
-           << L331 >>
- 
-           FLOW_STRING(INDEX) := 'F' ;
-           INDEX              := INDEX + 1 ;
- 
-           FOR  I  IN  1..1  LOOP
-                CASE  2  IS
-                     WHEN  1  =>
-                          FAILED( "WRONG 'CASE' BRANCH" );
-                     WHEN  OTHERS  =>
-                          GOTO  L231 ;
-                END CASE;
-           END LOOP;
- 
-           << L300 >>
- 
-           FAILED( "AT L300  -  WRONGLY" );
- 
-           << L411 >>
- 
-           FLOW_STRING(INDEX) := 'D' ;
-           INDEX              := INDEX + 1 ;
- 
-           DECLARE
-                K : INTEGER := 17 ;
-           BEGIN
-                GOTO  L131 ;
-           END;
- 
-           << L421 >>
- 
-           FAILED( "AT L421  -  WRONGLY" );
- 
-           << L431 >>
- 
-           FLOW_STRING(INDEX) := 'H' ;
- 
- 
-           IF  FLOW_STRING /= "ABCDEFGH"  THEN
-                FAILED("WRONG FLOW OF CONTROL" );
-           END IF;
- 
-      END ;
- 
- 
-      RESULT ;
- 
- 
- END C59002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c59002c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c59002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c5/c59002c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c5/c59002c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- C59002C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT JUMPS OUT OF SELECT STATEMENTS (OTHER THAN
- --    FROM INSIDE  ACCEPT  BODIES IN SELECT_ALTERNATIVES)
- --    ARE POSSIBLE AND ARE CORRECTLY PERFORMED.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES.
- 
- 
- -- RM 08/15/82
- -- SPS 12/13/82
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT;
- WITH SYSTEM;
- USE SYSTEM;
- PROCEDURE  C59002C  IS
- 
-      USE  REPORT ;
- 
-      FLOW_STRING : STRING(1..2) := "XX" ;
-      INDEX       : INTEGER      :=  1 ;
- 
- 
- BEGIN
- 
-      TEST( "C59002C" , "CHECK THAT ONE CAN JUMP OUT OF SELECT STATE" &
-                        "MENTS" );
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           TASK  T  IS
- 
- 
-                ENTRY  E1 ;
-                ENTRY  E2 ;
-           END  T ;
- 
-           TASK BODY T IS
-           BEGIN
- 
-                WHILE  E2'COUNT <= 0  LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                SELECT 
-                     ACCEPT  E1  DO
-                          FAILED( " E1  ACCEPTED; NO ENTRY CALL (1)" );
-                     END ;
-                OR
-                     ACCEPT  E2 ;
-                     GOTO  L123 ;
-                     FAILED( "'GOTO' NOT OBEYED (1)" );
-                OR
-                     DELAY 10.0 * Impdef.One_Second;
-                     FAILED( "DELAY ALTERNATIVE SELECTED (1)" );
-                END SELECT;
- 
-                FAILED( "WRONG DESTINATION FOR 'GOTO' (1)" );
- 
-                << L123 >>
- 
-                FLOW_STRING(INDEX) := 'A' ;
-                INDEX              := INDEX + 1 ;
- 
-           END T;
- 
-      BEGIN
- 
-           T.E2 ;
- 
-      END;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
- 
-           TASK  T  IS
-                ENTRY  E1 ;
-                ENTRY  E2 ;
-           END  T ;
- 
-           TASK BODY T IS
-           BEGIN
- 
-                SELECT 
-                     ACCEPT  E1  DO
-                          FAILED( " E1  ACCEPTED; NO ENTRY CALL (2)" );
-                     END ;
-                OR
-                     ACCEPT  E2  DO
-                          FAILED( " E2  ACCEPTED; NO ENTRY CALL (2)" );
-                     END ;
-                OR
-                     DELAY 10.0 * Impdef.One_Second;
-                     GOTO  L321 ;
-                     FAILED( "'GOTO' NOT OBEYED (2)" );
-                END SELECT;
- 
-                FAILED( "WRONG DESTINATION FOR 'GOTO' (2)" );
- 
-                << L321 >>
- 
-                FLOW_STRING(INDEX) := 'B' ;
-                INDEX              := INDEX + 1 ;
- 
-           END T;
- 
-      BEGIN
- 
-           NULL ;
- 
-      END;
- 
-      -------------------------------------------------------------------
- 
-      IF  FLOW_STRING /= "AB"  THEN
-           FAILED("WRONG FLOW OF CONTROL" );
-      END IF;
- 
- 
-      RESULT ;
- 
- 
- END  C59002C ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c61008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c61008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c61008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c61008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- C61008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF THE DEFAULT VALUE
- -- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE 
- -- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
- -- THE DEFAULT IS USED.
- 
- --   SUBTESTS ARE:
- --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
- --            INITIALIZED WITH A STATIC AGGREGATE.
- --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
- --            INITIALIZED WITH A STATIC VALUE.
- --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
- --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
- --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
- --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
- --            WITH A STATIC AGGREGATE.
- --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
- --            INITIALIZED WITH A STATIC AGGREGATE.
- 
- -- DAS  1/20/81
- -- SPS 10/26/82
- -- VKG 1/13/83
- -- SPS 2/9/83
- -- BHS 7/9/84
- 
- WITH REPORT;
- PROCEDURE C61008A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                       "CONSTRAINTS ON A FORMAL PARAMETER");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           PROCEDURE PA (I1, I2 : INTEGER) IS
- 
-                TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
- 
-                PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
-                BEGIN
-                     FAILED ("BODY OF PA1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN PA1");
-                END PA1;
- 
-           BEGIN
-                PA1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PA1");
-           END PA;
- 
-      BEGIN   -- (A)
-           PA (IDENT_INT(1), IDENT_INT(10));
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN CALL TO PA");
-      END;    -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           PROCEDURE PB (I1, I2 : INTEGER) IS
- 
-                SUBTYPE INT IS INTEGER RANGE I1..I2;
- 
-                PROCEDURE PB1 (I : INT := -1) IS
-                BEGIN
-                     FAILED ("BODY OF PB1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN PB1");
-                END PB1;
- 
-           BEGIN
-                PB1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PB1");
-           END PB;
- 
-      BEGIN   -- (B)
-           PB (IDENT_INT(0), IDENT_INT(63));
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN CALL TO PB");
-      END;    -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           PROCEDURE PC (I1, I2 : INTEGER) IS
-                TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2; 
-                TYPE REC IS
-                     RECORD
-                          I : INTEGER RANGE I1..I2;
-                          A : AR1 ;
-                     END RECORD;
- 
-                PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
-                BEGIN
-                     FAILED ("BODY OF PC1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN PC1");
-                END PC1;
- 
-           BEGIN
-                PC1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PC1");
-           END PC;
- 
-      BEGIN   -- (C)
-           PC (IDENT_INT(1), IDENT_INT(3));
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN CALL TO PC");
-      END;    -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D1)
- 
-           PROCEDURE P1D (I1, I2 : INTEGER) IS
- 
-                TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
- 
-                PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
-                BEGIN
-                     FAILED ("BODY OF P1D1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN P1D1");
-                END P1D1;
- 
-           BEGIN
-                P1D1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - P1D1");
-           END P1D;
- 
-      BEGIN   -- (D1)
-           P1D (IDENT_INT(1), IDENT_INT(2));
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN CALL TO P1D");
-      END;    -- (D1)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D2)
- 
-           PROCEDURE P2D (I1, I2 : INTEGER) IS
-                
-                TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
- 
-                PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
-                BEGIN
-                     FAILED ("BODY OF P2D1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN P2D1");
-                END P2D1;
- 
-           BEGIN
-                P2D1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - P2D1");
-           END P2D;
- 
-      BEGIN  -- (D2)
-           P2D (IDENT_INT(1), IDENT_INT(2));
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN CALL TO P2D");
-      END;   -- (D2)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (E)
- 
-           PROCEDURE PE (I1, I2 : INTEGER) IS
-                SUBTYPE INT IS INTEGER RANGE 0..10;
-                TYPE ARR IS ARRAY (1..3) OF INT;
-                TYPE REC (I : INT) IS
-                     RECORD
-                          A : ARR;
-                     END RECORD;
- 
-                SUBTYPE REC4 IS REC(I1);
- 
-                PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
-                BEGIN
-                     FAILED ("BODY OF PE1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN PE1");
-                END PE1;
- 
-           BEGIN
-                PE1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PE1");
-           END PE;
- 
-      BEGIN   -- (E)
-           PE (IDENT_INT(4), IDENT_INT(10));
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN CALL TO PE");
-      END;    -- (E)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C61008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c61009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c61009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c61009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c61009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- C61009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A STATIC EXPRESSION, CONSTANT NAME, ATTRIBUTE NAME,
- --   VARIABLE, DEREFERENCED ACCESS, USER-DEFINED OPERATOR, USER-
- --   DEFINED FUNCTION, OR ALLOCATOR CAN BE USED IN THE INITIALIZATION
- --   EXPRESSION OF A FORMAL PARAMETER, AND THAT THE APPROPRIATE
- --   VALUE IS USED AS A DEFAULT PARAMETER VALUE WHEN THE SUBPROGRAM
- --   IS CALLED.
- 
- -- DAS  1/21/81
- -- ABW  7/20/82
- -- SPS  12/10/82
- 
- WITH REPORT;
- PROCEDURE C61009A IS
- 
-      USE REPORT;
- 
-      TYPE INT IS RANGE 1 .. 10;
- 
-      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
- 
-      TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-           RECORD
-                A : ARR (0..CONSTRAINT); 
-           END RECORD;
- 
-      C7   : CONSTANT INTEGER  := 7;
-      V7   : INTEGER  := 7;
-      
-      TYPE  A_INT IS ACCESS INTEGER;
-      C_A  : CONSTANT A_INT  := NEW INTEGER'(7);
- 
-      SUBTYPE RECTYPE1 IS RECTYPE (2 + 5);
-      SUBTYPE RECTYPE2 IS RECTYPE (C7);
-      SUBTYPE RECTYPE3 IS RECTYPE (V7);
- 
-      FUNCTION "&" (X,Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN 10;
-      END "&";
- 
-      FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN X;
-      END FUNC;
- 
-      -- STATIC EXPRESSION
- 
-      PROCEDURE PROC1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7))) IS
-      BEGIN
-           IF (REC /= (7,(0,1,2,3,4,5,6,7))) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC1 PARAMETER");
-           END IF;
-      END PROC1;
- 
-      -- CONSTANT NAME
- 
-      PROCEDURE PROC2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7))) IS
-      BEGIN
-           IF (REC /= (C7,(0,1,2,3,4,5,6,7))) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC2 PARAMETER");
-           END IF;
-      END PROC2;
- 
-      -- ATTRIBUTE NAME
- 
-      PROCEDURE PROC3 (P1 : INT := INT'LAST) IS
-      BEGIN
-           IF (P1 /= INT (10)) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC3 PARAMETER");
-           END IF;
-      END PROC3;
- 
-      -- VARIABLE
- 
-      PROCEDURE PROC4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7))) IS
-      BEGIN
-           IF (P4 /= (V7,(0,1,2,3,4,5,6,7))) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC4 PARAMETER");
-                END IF;
-           END PROC4;
- 
-      --DEREFERENCED ACCESS
- 
-      PROCEDURE PROC5 (P5 : INTEGER := C_A.ALL) IS
-      BEGIN
-           IF(P5 /= C_A.ALL) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC5 PARAMETER");
-           END IF;
-      END PROC5;
- 
-      --USER-DEFINED OPERATOR
- 
-      PROCEDURE PROC6 (P6 : INTEGER := 6&4) IS
-      BEGIN
-           IF (P6 /= IDENT_INT(10)) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC6 PARAMETER");
-           END IF;
-      END PROC6;
- 
-      --USER-DEFINED FUNCTION
- 
-      PROCEDURE PROC7 (P7 : INTEGER := FUNC(10)) IS
-      BEGIN
-           IF (P7 /= IDENT_INT(10)) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC7 PARAMETER");
-           END IF;
-      END PROC7;
- 
-      -- ALLOCATOR
- 
-      PROCEDURE PROC8 (P8 : A_INT := NEW INTEGER'(7)) IS
-      BEGIN
-           IF (P8.ALL /= IDENT_INT(7)) THEN
-                FAILED ("INCORRECT DEFAULT VALUE FOR PROC8 PARAMETER");
-           END IF;
-      END PROC8;
- 
- BEGIN
-      TEST ("C61009A", "CHECK USE OF STATIC EXPRESSIONS, CONSTANT " &
-                       "NAMES, ATTRIBUTE NAMES, VARIABLES, USER- " &
-                       "DEFINED OPERATORS, USER-DEFINED FUNCTIONS " &
-                       "DEREFERENCED ACCESSES, AND ALLOCATORS IN " &
-                       "THE FORMAL PART OF A SUBPROGRAM SPECIFICATION");
- 
-      PROC1;
-      PROC2;
-      PROC3;
-      PROC4;
-      PROC5;
-      PROC6;
-      PROC7;
-      PROC8;
- 
-      RESULT;
- 
- END C61009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c61010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c61010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c61010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c61010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,246 ****
- -- C61010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN IN OR IN OUT FORMAL PARAMETER CAN BE DECLARED WITH A
- -- LIMITED PRIVATE TYPE OR A LIMITED COMPOSITE TYPE.
- 
- -- DAS  1/22/81
- -- JRK  1/20/84  TOTALLY REVISED.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C61010A IS
- 
-      PACKAGE PKG IS
- 
-           TYPE ITYPE IS LIMITED PRIVATE;
- 
-           PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
- 
-           PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
-                                   M : STRING);
- 
-           PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER);
- 
-           SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
-           TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
- 
-           PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
-                                 S : STRING; M : STRING);
- 
-           PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
-                                    I : INTEGER; S : STRING;
-                                    M : STRING);
- 
-           PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
-                             S : STRING);
- 
-      PRIVATE
- 
-           TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
- 
-           TYPE VRTYPE (C : INT_0_20 := 20) IS
-                RECORD
-                     I : INTEGER;
-                     S : STRING (1 .. C);
-                END RECORD;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      I1 : ITYPE;
- 
-      TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
- 
-      A1 : ATYPE;
- 
-      VR1 : VRTYPE;
- 
-      D : CONSTANT INT_0_20 := 10;
- 
-      TYPE RTYPE IS
-           RECORD
-                J : ITYPE;
-                R : VRTYPE (D);
-           END RECORD;
- 
-      R1 : RTYPE;
- 
-      PACKAGE BODY PKG IS
- 
-           PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
-           BEGIN
-                IF INTEGER (X) /= V THEN
-                     FAILED ("WRONG SCALAR VALUE - " & M);
-                END IF;
-           END LOOK_IN_I;
- 
-           PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
-                                   M : STRING) IS
-           BEGIN
-                IF INTEGER (X) /= V THEN
-                     FAILED ("WRONG SCALAR VALUE - " & M);
-                END IF;
-           END LOOK_INOUT_I;
- 
-           PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER) IS
-           BEGIN
-                X := ITYPE (IDENT_INT (V));
-           END SET_I;
- 
-           PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
-                                 S : STRING; M : STRING) IS
-           BEGIN
-                IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
-                     FAILED ("WRONG COMPOSITE VALUE - " & M);
-                END IF;
-           END LOOK_IN_VR;
- 
-           PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
-                                    I : INTEGER; S : STRING;
-                                    M : STRING) IS
-           BEGIN
-                IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
-                     FAILED ("WRONG COMPOSITE VALUE - " & M);
-                END IF;
-           END LOOK_INOUT_VR;
- 
-           PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
-                             S : STRING) IS
-           BEGIN
-                X := (IDENT_INT(C), IDENT_INT(I), IDENT_STR(S));
-           END SET_VR;
- 
-      BEGIN
-           I1 := ITYPE (IDENT_INT(2));
- 
-           FOR I IN A1'RANGE LOOP
-                A1 (I) := ITYPE (3 + IDENT_INT(I));
-           END LOOP;
- 
-           VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
- 
-           R1.J := ITYPE (IDENT_INT(6));
-           R1.R := (IDENT_INT(D), IDENT_INT(19),
-                    IDENT_STR("ABCDEFGHIJ"));
-      END PKG;
- 
-      PROCEDURE CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
-      BEGIN
-           LOOK_IN_I (X, V, M);
-      END CHECK_IN_I;
- 
-      PROCEDURE CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
-                               NV : INTEGER; M : STRING) IS
-      BEGIN
-           LOOK_INOUT_I (X, OV, M & " - A");
-           SET_I (X, NV);
-           LOOK_INOUT_I (X, NV, M & " - B");
-           LOOK_IN_I (X, NV, M & " - C");
-      END CHECK_INOUT_I;
- 
-      PROCEDURE CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) IS
-      BEGIN
-           FOR I IN X'RANGE LOOP
-                LOOK_IN_I (X(I), V+I, M & " -" & INTEGER'IMAGE (I));
-           END LOOP;
-      END CHECK_IN_A;
- 
-      PROCEDURE CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
-                               NV : INTEGER; M : STRING) IS
-      BEGIN
-           FOR I IN X'RANGE LOOP
-                LOOK_INOUT_I (X(I), OV+I, M & " - A" &
-                                          INTEGER'IMAGE (I));
-                SET_I (X(I), NV+I);
-                LOOK_INOUT_I (X(I), NV+I, M & " - B" &
-                                          INTEGER'IMAGE (I));
-                LOOK_IN_I (X(I), NV+I, M & " - C" & INTEGER'IMAGE (I));
-           END LOOP;
-      END CHECK_INOUT_A;
- 
-      PROCEDURE CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
-                             S : STRING; M : STRING) IS
-      BEGIN
-           LOOK_IN_VR (X, C, I, S, M);
-      END CHECK_IN_VR;
- 
-      PROCEDURE CHECK_INOUT_VR (X : IN OUT VRTYPE;
-                                OC : INTEGER; OI : INTEGER; OS : STRING;
-                                NC : INTEGER; NI : INTEGER; NS : STRING;
-                                M : STRING) IS
-      BEGIN
-           LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
-           SET_VR (X, NC, NI, NS);
-           LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
-           LOOK_IN_VR (X, NC, NI, NS, M & " - C");
-      END CHECK_INOUT_VR;
- 
-      PROCEDURE CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
-                            I : INTEGER; S : STRING; M : STRING) IS
-      BEGIN
-           LOOK_IN_I (X.J, J, M & " - A");
-           LOOK_IN_VR (X.R, C, I, S, M & " - B");
-      END CHECK_IN_R;
- 
-      PROCEDURE CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
-                               OC : INTEGER; OI : INTEGER; OS : STRING;
-                               NJ : INTEGER;
-                               NC : INTEGER; NI : INTEGER; NS : STRING;
-                               M : STRING) IS
-      BEGIN
-           LOOK_INOUT_I (X.J, OJ, M & " - A");
-           LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
-           SET_I (X.J, NJ);
-           SET_VR (X.R, NC, NI, NS);
-           LOOK_INOUT_I (X.J, NJ, M & " - C");
-           LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
-           LOOK_IN_I (X.J, NJ, M & " - E");
-           LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
-      END CHECK_INOUT_R;
- 
- BEGIN
-      TEST ("C61010A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
-                       "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
- 
-      CHECK_IN_I (I1, 2, "IN I");
- 
-      CHECK_INOUT_I (I1, 2, 5, "INOUT I");
- 
-      CHECK_IN_A (A1, 3, "IN A");
- 
-      CHECK_INOUT_A (A1, 3, 17, "INOUT A");
- 
-      CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
- 
-      CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
-                      "INOUT VR");
- 
-      CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
- 
-      CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, "ZYXWVUTSRQ",
-                     "INOUT R");
- 
-      RESULT;
- END C61010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c620001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c620001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c620001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c620001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,340 ****
- -- C620001.A
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    Check that elementary parameters are passed by copy.
- --
- --    Part 1: Integer, float, and access types, procedures and functions.
- --
- -- TEST DESCRIPTION:
- --    Subtests are:
- --        (A) Scalar parameters to procedures.
- --        (B) Scalar parameters to functions.
- --        (C) Access parameters to procedures.
- --        (D) Access parameters to functions.
- --
- --    For the procedure examples, we pass array elements indexed by dynamically
- --    determined indexes. Doing this side-steps the check of 6.4.1(6.15/3) and
- --    makes the test more realistic.
- --
- --    To completely test this objective, we should also try in out and out
- --    parameters for functions (Ada 2012), in/in out/out parameters for
- --    task and protected entries, and a variety of different scalar types
- --    (enumeration, modular, fixed, decimal).
- --
- -- CHANGE HISTORY:
- --    14 Jan 1980 DAS Created test.
- --    26 Oct 1982 SPS
- --    25 May 1984 CPP
- --    29 Oct 1985 EG  Eliminate the use of Numeric_Error in the test.
- --    14 Mar 2014 RLB Revised so test cases are legal for Ada 2012, modernized
- --                    objective, converted to modern format, added float cases.
- 
- with Report;
- procedure C620001 is
- 
-      use Report;
- 
- begin
-      Test ("C620001", "Check that elementary parameters are passed by copy");
- 
-      --------------------------------------------------
- 
-      declare  -- (A)
- 
-           I,J,K : Natural := Report.Ident_Int(1); -- Index values.
-           Arr   : array (1 .. 4) of Integer;
-           E     : exception;
- 
-           procedure P (PI  : in     Integer;
-                        PO  :    out Integer;
-                        PIO : in out Integer) is
- 
-                Tmp  : Integer;
- 
-           begin
- 
-                Tmp := PI;     -- Save value of PI at procedure entry.
- 
-                PO := 10;
-                if (PI /= Tmp) then
-                     Failed ("Assignement to scalar out " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                     Tmp := PI;     -- Reset Tmp for next case.
-                end if;
- 
-                PIO := PIO + 100;
-                if (PI /= Tmp) then
-                     Failed ("Assignment to scalar in out " &
-                             "parameter changes the value of " &
-                             "inputparameter");
-                     Tmp := PI;     -- Reset Tmp for next case.
-                end if;
- 
-                Arr(I) := Arr(I) + 1;
-                if (PI /= Tmp) then
-                     Failed ("Assignment to scalar actual " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                end if;
- 
-                raise E;  -- Check exception handling.
-           end P;
- 
-      begin  -- (A)
-           Arr := (others => 0);
-           P (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - A");
-      exception
-           when E =>
-                if (Arr(I) /= 1) then
-                     case Arr(I) is
-                          when 11  =>
-                               Failed ("Out actual scalar parameter " &
-                                       "changed global value");
-                          when 101 =>
-                               Failed ("In out actual scalar " &
-                                       "parameter changed global value");
-                          when 111 =>
-                               Failed ("Out and in out actual scalar " &
-                                       "parameters changed global " &
-                                       "value");
-                          when others =>
-                               Failed ("Uundetermined change to global " &
-                                       "value");
-                     end case;
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - A");
-      end;  -- (A)
- 
-      --------------------------------------------------
- 
-      declare  -- (B)
- 
-           I,J  : Integer;
- 
-           function F (FI : in Integer) return Integer is
- 
-                Tmp  : Integer := FI;
- 
-           begin
- 
-                I := I + 1;
-                if (FI /= Tmp) then
-                     Failed ("Assignment to scalar actual function " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                end if;
- 
-                return (100);
-           end F;
- 
-      begin  -- (B)
-           I := 100;
-           J := F (I);
-      end;  -- (B)
- 
-      --------------------------------------------------
- 
-      declare  -- (C)
- 
-           type Acctype is access Integer;
- 
-           I,J,K : Natural := Report.Ident_Int(2); -- Index values.
-           Arr   : array (1 .. 5) of Acctype;
-           E     : exception;
- 
-           procedure P (PI  : in     Acctype;
-                        PO  :    out Acctype;
-                        PIO : in out Acctype) is
- 
-                Tmp  : Acctype;
- 
-           begin
- 
-                Tmp := PI;     -- Save value of PI at procedure entry.
- 
-                Arr(I) := new Integer'(101);
-                if (PI /= Tmp) then
-                     Failed ("Assignment to access actual " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                     Tmp := PI;     -- Reset Tmp for next case.
-                end if;
- 
-                PO := new Integer'(1);
-                if (PI /= Tmp) then
-                     Failed ("Assignment to access out " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                     Tmp := PI;     -- Reset Tmp for next case.
-                end if;
- 
-                PIO := new Integer'(10);
-                if (PI /= Tmp) then
-                     Failed ("Assignment to access in out " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                end if;
- 
-                raise E;  -- Check exception handling.
-           end P;
- 
-      begin  -- (C)
-           Arr(I) := new Integer'(100);
-           P (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - C");
-      exception
-           when E =>
-                if (Arr(I).all /= 101) then
-                     Failed ("Out or in out actual procedure " &
-                             "parameter value changed despite " &
-                             "raised exception");
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - C");
-      end;  -- (C)
- 
-      --------------------------------------------------
- 
-      declare  -- (D)
- 
-           Type Acctype is access Integer;
- 
-           I,J  : Acctype;
- 
-           function F (FI : in Acctype) return Acctype is
- 
-                Tmp  : Acctype := FI;
- 
-           begin
- 
-                I := new Integer;
-                if (FI /= Tmp) then
-                     Failed ("Assignment to access actual function " &
-                             "parameter changes the value of " &
-                             "Input parameter");
-                end if;
- 
-                return null;
-           end F;
- 
-      begin  -- (D)
-           I := null;
-           J := F(I);
-      end;  -- (D)
- 
-      --------------------------------------------------
- 
-      declare  -- (E)
- 
-           I,J,K : Natural := Report.Ident_Int(3); -- Index values.
-           Arr   : array (1 .. 3) of Float;
-           E     : exception;
- 
-           procedure P (PI  : in     Float;
-                        PO  :    out Float;
-                        PIO : in out Float) is
- 
-                Tmp  : Float;
- 
-           begin
- 
-                Tmp := PI;     -- Save value of PI at procedure entry.
- 
-                PO := 0.5;
-                if (PI /= Tmp) then
-                     Failed ("Assignement to float out " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                     Tmp := PI;     -- Reset Tmp for next case.
-                end if;
- 
-                PIO := PIO + 0.25;
-                if (PI /= Tmp) then
-                     Failed ("Assignment to float in out " &
-                             "parameter changes the value of " &
-                             "inputparameter");
-                     Tmp := PI;     -- Reset Tmp for next case.
-                end if;
- 
-                Arr(I) := Arr(I) + 1.0;
-                if (PI /= Tmp) then
-                     Failed ("Assignment to float actual " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                end if;
- 
-                raise E;  -- Check exception handling.
-           end P;
- 
-      begin  -- (E)
-           Arr := (others => 0.0);
-           P (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - E");
-      exception
-           when E =>
-                if (Arr(I) /= 1.0) then
-                     Failed ("Out or in out actual procedure " &
-                             "parameter value changed despite " &
-                             "raised exception");
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - E");
-      end;  -- (E)
- 
-      --------------------------------------------------
- 
-      declare  -- (F)
- 
-           I,J  : Float;
- 
-           function F (FI : in Float) return Float is
- 
-                Tmp  : Float := FI;
- 
-           begin
- 
-                I := I + 1.0;
-                if (FI /= Tmp) then
-                     Failed ("Assignment to float actual function " &
-                             "parameter changes the value of " &
-                             "input parameter");
-                end if;
- 
-                return 100.0;
-           end F;
- 
-      begin  -- (F)
-           I := 100.0;
-           J := F (I);
-      end;  -- (F)
- 
-      --------------------------------------------------
- 
-      Result;
- 
- end C620001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c620002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c620002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c620002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c620002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,509 ****
- -- C620001.A
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    Check that elementary parameters are passed by copy.
- --
- --    Part 2: Integer, float, and access types, task and protected entries.
- --
- -- TEST DESCRIPTION:
- --    Subtests are:
- --        (A) Scalar parameters to task entries.
- --        (B) Scalar parameters to protected entries.
- --        (C) Access parameters to task entries.
- --        (D) Access parameters to protected entries.
- --
- --    For all of these examples, we pass array elements indexed by dynamically
- --    determined indexes. Doing this side-steps the check of 6.4.1(6.15/3) and
- --    makes the test more realistic.
- --
- --    Note: This is based on legacy test C95072A.ADA (which was withdrawn).
- --
- -- CHANGE HISTORY:
- --    22 Jul 1985 DAS Created test.
- --    12 May 2020 RLB Revised so test cases are legal for Ada 2012, modernized
- --                    objective, converted to modern format, added float 
- --                    and protected cases.
- 
- with Report;
- procedure C620002 is
- 
-      use Report;
- 
- begin
-      Test ("C620002", "Check that elementary parameters are passed by copy," &
-                       " part 2 - task and protected entries");
- 
-      --------------------------------------------------
- 
-      declare  -- (A)
- 
-           I,J,K : Natural := Report.Ident_Int (1); -- Index values.
-           Arr   : array (1 .. 4) of Integer;
-           E     : exception;
- 
-           task TA is
-                entry EA (EI  : in     Integer;
-                          EO  :    out Integer;
-                          EIO : in out Integer);
-           end TA;
- 
-           task body TA is
- 
-                Tmp : Integer;
- 
-           begin
- 
-                accept EA (EI  : in     Integer;
-                           EO  :    out Integer;
-                           EIO : in out Integer) do
- 
-                     Tmp := EI;     -- Save value of EI at accept.
- 
-                     EO := 10;
-                     if EI /= Tmp then
-                          Failed ("Assignement to scalar out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - A");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EIO := EIO + 100;
-                     if EI /= Tmp then
-                          Failed ("Assignment to scalar in out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - A");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     Arr(I) := Arr(I) + 1;
-                     if EI /= Tmp then
-                          Failed ("Assignment to scalar actual " &
-                                  "parameter changes the value of " &
-                                  "input parameter - A");
-                     end if;
-  
-                     raise E;  -- Check exception handling.
-                end EA;
- 
-           exception
-                when others => null;
-           end TA;
- 
-      begin  -- (A)
-           Arr := (others => 0);
-           TA.EA (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - A");
-      exception
-           when E =>
-                if Arr(I) /= 1 then
-                     case Arr(I) is
-                          when 11  =>
-                               Failed ("Out actual scalar parameter " &
-                                       "changed global value - A");
-                          when 101 =>
-                               Failed ("In out actual scalar " &
-                                       "parameter changed global value - A");
-                          when 111 =>
-                               Failed ("Out and in out actual scalar " &
-                                       "parameters changed global " &
-                                       "value - A");
-                          when others =>
-                               Failed ("Undetermined change to global " &
-                                       "value - A");
-                     end case;
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - A");
-      end;  -- (A)
- 
-      --------------------------------------------------
- 
-      declare  -- (B)
- 
-           I,J,K : Natural := Report.Ident_Int (3); -- Index values.
-           Arr   : array (1 .. 5) of Integer;
-           E     : exception;
- 
-           protected PA is
-                entry EA (EI  : in     Integer;
-                          EO  :    out Integer;
-                          EIO : in out Integer);
-           end PA;
- 
-           protected body PA is
- 
-                entry EA (EI  : in     Integer;
-                          EO  :    out Integer;
-                          EIO : in out Integer) when True is
- 
-                    Tmp : Integer;
- 
-                begin
- 
-                     Tmp := EI;     -- Save value of EI at entry.
- 
-                     EO := 10;
-                     if EI /= Tmp then
-                          Failed ("Assignement to scalar out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - B");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EIO := EIO + 100;
-                     if EI /= Tmp then
-                          Failed ("Assignment to scalar in out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - B");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     Arr(I) := Arr(I) + 1;
-                     if EI /= Tmp then
-                          Failed ("Assignment to scalar actual " &
-                                  "parameter changes the value of " &
-                                  "input parameter - B");
-                     end if;
-  
-                     raise E;  -- Check exception handling.
-                end EA;
- 
-           end PA;
- 
-      begin  -- (B)
-           Arr := (others => 0);
-           PA.EA (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - B");
-      exception
-           when E =>
-                if Arr(I) /= 1 then
-                     case Arr(I) is
-                          when 11  =>
-                               Failed ("Out actual scalar parameter " &
-                                       "changed global value - B");
-                          when 101 =>
-                               Failed ("In out actual scalar " &
-                                       "parameter changed global value - B");
-                          when 111 =>
-                               Failed ("Out and in out actual scalar " &
-                                       "parameters changed global " &
-                                       "value - B");
-                          when others =>
-                               Failed ("Undetermined change to global " &
-                                       "value - B");
-                     end case;
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - B");
-      end;  -- (B)
- 
-      --------------------------------------------------
- 
-      declare  -- (C)
- 
-           type Acctype is access Integer;
- 
-           I,J,K : Natural := Report.Ident_Int (2); -- Index values.
-           Arr   : array (1 .. 5) of Acctype;
-           E     : exception;
- 
-           task TB is
-                entry EB (EI  : in     Acctype;
-                          EO  :    out Acctype;
-                          EIO : in out Acctype);
-           end TB;
- 
-           task body TB is
- 
-                Tmp  : Acctype;
- 
-           begin
- 
-                accept EB (EI  : in     Acctype;
-                           EO  :    out Acctype;
-                           EIO : in out Acctype) do
- 
-                     Tmp := EI;     -- Save value of EI at accept.
- 
-                     Arr(I) := new Integer'(101);
-                     if EI /= Tmp then
-                          Failed ("Assignment to access actual " &
-                                  "parameter changes the value of " &
-                                  "input parameter - C");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EO := new Integer'(1);
-                     if EI /= Tmp then
-                          Failed ("Assignment to access out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - C");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EIO := new Integer'(10);
-                     if EI /= Tmp then
-                          Failed ("Assignment to access in out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - C");
-                     end if;
- 
-                     raise E;  -- Check exception handling.
-               end EB;
- 
-           exception
-                when others => null;
-           end TB;
- 
-      begin  -- (C)
-           Arr(I) := new Integer'(100);
-           TB.EB (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - C");
-      exception
-           when E =>
-                if (Arr(I).all /= 101) then
-                     Failed ("Out or in out actual " &
-                             "parameter value changed despite " &
-                             "raised exception - C");
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - C");
-      end;  -- (C)
- 
-      --------------------------------------------------
- 
-      declare  -- (D)
- 
-           type Acctype is access Integer;
- 
-           I,J,K : Natural := Report.Ident_Int (4); -- Index values.
-           Arr   : array (1 .. 6) of Acctype;
-           E     : exception;
- 
-           protected PB is
-                entry EB (EI  : in     Acctype;
-                          EO  :    out Acctype;
-                          EIO : in out Acctype);
-           end PB;
- 
-           protected body PB is
- 
-                entry EB (EI  : in     Acctype;
-                          EO  :    out Acctype;
-                          EIO : in out Acctype) when True is
- 
-                     Tmp  : Acctype;
- 
-                begin
-                     Tmp := EI;     -- Save value of EI at entry.
- 
-                     Arr(I) := new Integer'(101);
-                     if EI /= Tmp then
-                          Failed ("Assignment to access actual " &
-                                  "parameter changes the value of " &
-                                  "input parameter - D");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EO := new Integer'(1);
-                     if EI /= Tmp then
-                          Failed ("Assignment to access out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - D");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EIO := new Integer'(10);
-                     if EI /= Tmp then
-                          Failed ("Assignment to access in out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - D");
-                     end if;
- 
-                     raise E;  -- Check exception handling.
-                end EB;
- 
-           end PB;
- 
-      begin  -- (D)
-           Arr(I) := new Integer'(100);
-           PB.EB (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - D");
-      exception
-           when E =>
-                if (Arr(I).all /= 101) then
-                     Failed ("Out or in out actual " &
-                             "parameter value changed despite " &
-                             "raised exception - D");
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - D");
-      end;  -- (D)
- 
-      --------------------------------------------------
- 
-      declare  -- (E)
- 
-           I,J,K : Natural := Report.Ident_Int (3); -- Index values.
-           Arr   : array (1 .. 3) of Float;
-           E     : exception;
- 
-           task TC is
-                entry EC (EI  : in     Float;
-                          EO  :    out Float;
-                          EIO : in out Float);
-           end TC;
- 
-           task body TC is
- 
-                Tmp : Float;
- 
-           begin
- 
-                accept EC (EI  : in     Float;
-                           EO  :    out Float;
-                           EIO : in out Float) do
- 
-                     Tmp := EI;     -- Save value of EI at accept.
- 
-                     EO := 0.5;
-                     if EI /= Tmp then
-                          Failed ("Assignement to float out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - E");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EIO := EIO + 0.25;
-                     if EI /= Tmp then
-                          Failed ("Assignment to float in out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - E");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     Arr(I) := Arr(I) + 1.0;
-                     if EI /= Tmp then
-                          Failed ("Assignment to float actual " &
-                                  "parameter changes the value of " &
-                                  "input parameter - E");
-                     end if;
-  
-                     raise E;  -- Check exception handling.
-                end EC;
- 
-           exception
-                when others => null;
-           end TC;
- 
-      begin  -- (E)
-           Arr := (others => 0.0);
-           TC.EC (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - E");
-      exception
-           when E =>
-                if (Arr(I) /= 1.0) then
-                     Failed ("Out or in out actual procedure " &
-                             "parameter value changed despite " &
-                             "raised exception - E");
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - E");
-      end;  -- (E)
- 
-      --------------------------------------------------
- 
-      declare  -- (F)
- 
-           I,J,K : Natural := Report.Ident_Int (6); -- Index values.
-           Arr   : array (1 .. 7) of Float;
-           E     : exception;
- 
-           protected PC is
-                entry EC (EI  : in     Float;
-                          EO  :    out Float;
-                          EIO : in out Float);
-           end PC;
- 
-           protected body PC is
- 
-                entry EC (EI  : in     Float;
-                          EO  :    out Float;
-                          EIO : in out Float) when True is
- 
-                     Tmp : Float;
- 
-                begin
- 
-                     Tmp := EI;     -- Save value of EI at entry.
- 
-                     EO := 0.5;
-                     if EI /= Tmp then
-                          Failed ("Assignement to float out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - F");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     EIO := EIO + 0.25;
-                     if EI /= Tmp then
-                          Failed ("Assignment to float in out " &
-                                  "parameter changes the value of " &
-                                  "input parameter - F");
-                          Tmp := EI;     -- Reset Tmp for next case.
-                     end if;
- 
-                     Arr(I) := Arr(I) + 1.0;
-                     if EI /= Tmp then
-                          Failed ("Assignment to float actual " &
-                                  "parameter changes the value of " &
-                                  "input parameter - F");
-                     end if;
-  
-                     raise E;  -- Check exception handling.
-                end EC;
- 
-           end PC;
- 
-      begin  -- (F)
-           Arr := (others => 0.0);
-           PC.EC (Arr(I), Arr(J), Arr(K));
-           Failed ("Exception not raised - F");
-      exception
-           when E =>
-                if (Arr(I) /= 1.0) then
-                     Failed ("Out or in out actual procedure " &
-                             "parameter value changed despite " &
-                             "raised exception - F");
-                end if;
-           when others =>
-                Failed ("Wrong exception raised - F");
-      end;  -- (F)
- 
-      --------------------------------------------------
- 
-      Result;
- 
- end C620002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,190 ****
- -- C62002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE COMPONENTS OF ACCESS IN PARAMETERS CAN BE USED AS THE
- --   TARGET OF AN ASSIGNMENT STATEMENT OR AS AN ACTUAL PARAMETER OF
- --   ANY MODE.  SUBTESTS ARE:
- --        (A) INTEGER ACCESS TYPE.
- --        (B) ARRAY ACCESS TYPE.
- --        (C) RECORD ACCESS TYPE.
- 
- -- DAS  1/23/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C62002A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C62002A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS" &
-                       " MAY BE USED IN ASSIGNMENT CONTEXTS");
- 
-      --------------------------------------------------
- 
-      DECLARE   -- (A)
- 
-           TYPE PTRINT IS ACCESS INTEGER;
-           PI   : PTRINT;
- 
-           PROCEDURE PROCA (PI : IN PTRINT) IS
- 
-                PROCEDURE PROCA1 (I : OUT INTEGER) IS
-                BEGIN
-                     I := 7;
-                END PROCA1;
- 
-                PROCEDURE PROCA2 (I : IN OUT INTEGER) IS
-                BEGIN
-                     I := I + 1;
-                END PROCA2;
-           BEGIN
- 
-                PROCA1 (PI.ALL);
-                PROCA2 (PI.ALL);
-                PI.ALL := PI.ALL + 1;
-                IF (PI.ALL /= 9) THEN
-                     FAILED ("ASSIGNMENT TO COMPONENT OF INTEGER" &
-                             " ACCESS PARAMETER FAILED");
-                END IF;
-           END PROCA;
- 
-      BEGIN     -- (A)
- 
-           PI := NEW INTEGER '(0);
-           PROCA (PI);
- 
-      END;      -- (A)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (B)
- 
-           TYPE TBL IS ARRAY (1..3) OF INTEGER;
-           TYPE PTRTBL IS ACCESS TBL;
-           PT   : PTRTBL;
- 
-           PROCEDURE PROCB (PT : IN PTRTBL) IS
- 
-                PROCEDURE PROCB1 (I : OUT INTEGER) IS
-                BEGIN
-                     I := 7;
-                END  PROCB1;
- 
-                PROCEDURE PROCB2 (I : IN OUT INTEGER) IS
-                BEGIN
-                     I := I + 1;
-                END PROCB2;
- 
-                PROCEDURE PROCB3 (T : OUT TBL) IS
-                BEGIN
-                     T := (1,2,3);
-                END PROCB3;
- 
-                PROCEDURE PROCB4 (T : IN OUT TBL) IS
-                BEGIN
-                     T(3) := T(3) - 1;
-                END PROCB4;
- 
-           BEGIN
- 
-                PROCB3 (PT.ALL);         -- (1,2,3)
-                PROCB4 (PT.ALL);         -- (1,2,2)
-                PROCB1 (PT(2));          -- (1,7,2)
-                PROCB2 (PT(1));          -- (2,7,2)
-                PT(3) := PT(3) + 7;      -- (2,7,9)
-                IF (PT.ALL /= (2,7,9)) THEN
-                     FAILED ("ASSIGNMENT TO COMPONENT OF ARRAY" &
-                             " ACCESS PARAMETER FAILED");
-                END IF;
-           END PROCB;
- 
-      BEGIN     -- (B)
- 
-           PT := NEW TBL '(0,0,0);
-           PROCB (PT);
- 
-      END;      -- (B)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (C)
- 
-           TYPE REC IS
-                RECORD
-                     I1   : INTEGER;
-                     I2   : INTEGER;
-                     I3   : INTEGER;
-                END RECORD;
-           TYPE PTRREC IS ACCESS REC;
-           PR   : PTRREC;
- 
-           PROCEDURE PROCC (PR : IN PTRREC) IS
- 
-                PROCEDURE PROCC1 (I : OUT INTEGER) IS
-                BEGIN
-                     I := 7;
-                END  PROCC1;
- 
-                PROCEDURE PROCC2 (I : IN OUT INTEGER) IS
-                BEGIN
-                     I := I + 1;
-                END PROCC2;
- 
-                PROCEDURE PROCC3 (R : OUT REC) IS
-                BEGIN
-                     R := (1,2,3);
-                END PROCC3;
- 
-                PROCEDURE PROCC4 (R : IN OUT REC) IS
-                BEGIN
-                     R.I3 := R.I3 - 1;
-                END PROCC4;
- 
-           BEGIN
- 
-                PROCC3 (PR.ALL);         -- (1,2,3)
-                PROCC4 (PR.ALL);         -- (1,2,2)
-                PROCC1 (PR.I2);          -- (1,7,2)
-                PROCC2 (PR.I1);          -- (2,7,2)
-                PR.I3 := PR.I3 + 7;      -- (2,7,9)
-                IF (PR.ALL /= (2,7,9)) THEN
-                     FAILED ("ASSIGNMENT TO COMPONENT OF RECORD" &
-                             " ACCESS PARAMETER FAILED");
-                END IF;
-           END PROCC;
- 
-      BEGIN     -- (C)
- 
-           PR := NEW REC '(0,0,0);
-           PROCC (PR);
- 
-      END;      -- (C)
- 
-      ---------------------------------------------
- 
-      RESULT;
- 
- END C62002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- C62003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SCALAR AND ACCESS PARAMETERS ARE COPIED.
- --   SUBTESTS ARE:
- --        (A) SCALAR PARAMETERS TO PROCEDURES.
- --        (B) SCALAR PARAMETERS TO FUNCTIONS.
- --        (C) ACCESS PARAMETERS TO PROCEDURES.
- --        (D) ACCESS PARAMETERS TO FUNCTIONS.
- 
- -- DAS 01/14/80
- -- SPS 10/26/82
- -- CPP 05/25/84
- -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- 
- WITH REPORT;
- PROCEDURE C62003A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C62003A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
-                       "COPIED");
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           I    : INTEGER;
-           E    : EXCEPTION;
- 
-           PROCEDURE P (PI : IN INTEGER;  PO : OUT INTEGER;
-                        PIO : IN OUT INTEGER) IS
- 
-                TMP  : INTEGER;
- 
-           BEGIN
- 
-                TMP := PI;     -- SAVE VALUE OF PI AT PROC ENTRY.
- 
-                PO := 10;
-                IF (PI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO SCALAR OUT " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
-                END IF;
- 
-                PIO := PIO + 100;
-                IF (PI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
-                END IF;
- 
-                I := I + 1;
-                IF (PI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                END IF;
- 
-                RAISE E;  -- CHECK EXCEPTION HANDLING.
-           END P;
- 
-      BEGIN  -- (A)
-           I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
-           P (I, I, I);
-           FAILED ("EXCEPTION NOT RAISED - A");
-      EXCEPTION
-           WHEN E =>
-                IF (I /= 1) THEN
-                     CASE I IS
-                          WHEN 11  =>
-                               FAILED ("OUT ACTUAL SCALAR PARAMETER " &
-                                       "CHANGED GLOBAL VALUE");
-                          WHEN 101 =>
-                               FAILED ("IN OUT ACTUAL SCALAR " &
-                                       "PARAMETER CHANGED GLOBAL VALUE");
-                          WHEN 111 =>
-                               FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
-                                       "PARAMETERS CHANGED GLOBAL " &
-                                       "VALUE");
-                          WHEN OTHERS =>
-                               FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
-                                       "VALUE");
-                     END CASE;
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - A");
-      END;  -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           I,J  : INTEGER;
- 
-           FUNCTION F (FI : IN INTEGER) RETURN INTEGER IS
- 
-                TMP  : INTEGER := FI;
- 
-           BEGIN
- 
-                I := I + 1;
-                IF (FI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO SCALAR ACTUAL FUNCTION " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                END IF;
- 
-                RETURN (100);
-           END F;
- 
-      BEGIN  -- (B)
-           I := 100;
-           J := F(I);
-      END;  -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (C)
- 
-           TYPE ACCTYPE IS ACCESS INTEGER;
- 
-           I    : ACCTYPE;
-           E    : EXCEPTION;
- 
-           PROCEDURE P (PI : IN ACCTYPE;  PO : OUT ACCTYPE;
-                        PIO : IN OUT ACCTYPE) IS
- 
-                TMP  : ACCTYPE;
- 
-           BEGIN
- 
-                TMP := PI;     -- SAVE VALUE OF PI AT PROC ENTRY.
- 
-                I := NEW INTEGER'(101);
-                IF (PI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
-                END IF;
- 
-                PO := NEW INTEGER'(1);
-                IF (PI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO ACCESS OUT " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
-                END IF;
- 
-                PIO := NEW INTEGER'(10);
-                IF (PI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                END IF;
- 
-                RAISE E;  -- CHECK EXCEPTION HANDLING.
-           END P;
- 
-      BEGIN  -- (C)
-           I := NEW INTEGER'(100);
-           P (I, I, I);
-           FAILED ("EXCEPTION NOT RAISED - C");
-      EXCEPTION
-           WHEN E =>
-                IF (I.ALL /= 101) THEN
-                     FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
-                             "PARAMETER VALUE CHANGED DESPITE " &
-                             "RAISED EXCEPTION");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - C");
-      END;  -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (D)
- 
-           TYPE ACCTYPE IS ACCESS INTEGER;
- 
-           I,J  : ACCTYPE;
- 
-           FUNCTION F (FI : IN ACCTYPE) RETURN ACCTYPE IS
- 
-                TMP  : ACCTYPE := FI;
- 
-           BEGIN
- 
-                I := NEW INTEGER;
-                IF (FI /= TMP) THEN
-                     FAILED ("ASSIGNMENT TO ACCESS ACTUAL FUNCTION " &
-                             "PARAMETER CHANGES THE VALUE OF " &
-                             "INPUT PARAMETER");
-                END IF;
- 
-                RETURN (NULL);
-           END F;
- 
-      BEGIN  -- (D)
-           I := NULL;
-           J := F(I);
-      END;  -- (D)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C62003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62003b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62003b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62003b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,301 ****
- -- C62003B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
- --   PASSED BY COPY.
- --   SUBTESTS ARE:
- --        (A) PRIVATE SCALAR PARAMETERS TO PROCEDURES.
- --        (B) PRIVATE SCALAR PARAMETERS TO FUNCTIONS.
- --        (C) PRIVATE ACCESS PARAMETERS TO PROCEDURES.
- --        (D) PRIVATE ACCESS PARAMETERS TO FUNCTIONS.
- 
- -- CPP 05/25/84
- -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C62003B IS
- 
- BEGIN
-      TEST("C62003B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
-                      "PARAMETERS ARE COPIED");
- 
-      ---------------------------------------------------
- 
- A_B: DECLARE
- 
-           PACKAGE SCALAR_PKG IS
- 
-                TYPE T IS PRIVATE;
-                C0 : CONSTANT T;
-                C1 : CONSTANT T;
-                C10 : CONSTANT T;
-                C100 : CONSTANT T;
- 
-                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
-                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
- 
-           PRIVATE
-                TYPE T IS NEW INTEGER;
-                C0 : CONSTANT T := 0;
-                C1 : CONSTANT T := 1;
-                C10 : CONSTANT T := 10;
-                C100 : CONSTANT T := 100;
- 
-           END SCALAR_PKG;
- 
- 
-           PACKAGE BODY SCALAR_PKG IS
- 
-                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
-                BEGIN     -- "+"
-                     RETURN T(INTEGER(OLD) + INTEGER(INCREMENT));
-                END "+";
- 
-                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
-                BEGIN     -- CONVERT
-                     RETURN INTEGER(OLD_PRIVATE);
-                END CONVERT;
- 
-           END SCALAR_PKG;
- 
-           USE SCALAR_PKG;
- 
-      ---------------------------------------------------
- 
-      BEGIN     -- A_B
- 
-       A : DECLARE
- 
-                I : T;
-                E : EXCEPTION;
- 
-                PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
- 
-                     TEMP : T;
- 
-                BEGIN  -- P
- 
-                     TEMP := PI;    -- SAVE VALUE OF PI AT PROC ENTRY.
- 
-                     PO := C10;
-                     IF (PI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) OUT " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
-                     END IF;
- 
-                     PIO := PIO + C100;
-                     IF (PI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) IN " &
-                                  "OUT PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
-                     END IF;
- 
-                     I := I + C1;
-                     IF (PI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
-                                  "ACTUAL PARAMETER CHANGES THE " &
-                                  "VALUE OF INPUT PARAMETER");
-                     END IF;
- 
-                     RAISE E;  -- CHECK EXCEPTION HANDLING.
-                END P;
- 
-           BEGIN  -- A
-                I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
-                          -- DETECTED.
-                P (I, I, I);
-                FAILED ("EXCEPTION NOT RAISED - A");
-           EXCEPTION
-                WHEN E =>
-                     IF (I /= C1) THEN
-                          CASE CONVERT(I) IS
-                               WHEN 11 =>
-                                    FAILED ("OUT ACTUAL PRIVATE " &
-                                            "(SCALAR) PARAMETER " &
-                                            "CHANGED GLOBAL VALUE");
-                               WHEN 101 =>
-                                    FAILED ("IN OUT ACTUAL PRIVATE " &
-                                            "(SCALAR) PARAMETER " &
-                                            "CHANGED GLOBAL VALUE");
-                               WHEN 111 =>
-                                    FAILED ("OUT AND IN OUT ACTUAL " &
-                                            "PRIVATE (SCALAR) " &
-                                            "PARAMETER CHANGED " &
-                                            "GLOBAL VALUE");
-                               WHEN OTHERS =>
-                                    FAILED ("UNDETERMINED CHANGE TO " &
-                                            "GLOBAL VALUE");
-                          END CASE;
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - A");
-           END A;
- 
-      ---------------------------------------------------
- 
-       B : DECLARE
- 
-                I, J : T;
- 
-                FUNCTION F (FI : IN T) RETURN T IS
- 
-                     TEMP : T := FI;  -- SAVE VALUE OF FI AT FN ENTRY.
- 
-                BEGIN  -- F
- 
-                     I := I + C1;
-                     IF (FI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
-                                  "ACTUAL FUNCTION PARAMETER CHANGES " &
-                                  "THE VALUE OF INPUT PARAMETER ");
-                     END IF;
- 
-                     RETURN C0;
-                END F;
- 
-           BEGIN  -- B
-                I := C0;
-                J := F(I);
-           END B;
- 
-      END A_B;
- 
-      ---------------------------------------------------
- 
- C_D: DECLARE
- 
-           PACKAGE ACCESS_PKG IS
- 
-                TYPE T IS PRIVATE;
-                C_NULL : CONSTANT T;
-                C1 : CONSTANT T;
-                C10 : CONSTANT T;
-                C100 : CONSTANT T;
-                C101 : CONSTANT T;
- 
-           PRIVATE
-                TYPE T IS ACCESS INTEGER;
-                C_NULL : CONSTANT T := NULL;
-                C1 : CONSTANT T := NEW INTEGER'(1);
-                C10 : CONSTANT T := NEW INTEGER'(10);
-                C100 : CONSTANT T := NEW INTEGER'(100);
-                C101 : CONSTANT T := NEW INTEGER'(101);
- 
-           END ACCESS_PKG;
- 
-           USE ACCESS_PKG;
- 
-      ---------------------------------------------------
- 
-      BEGIN     -- C_D;
- 
-       C : DECLARE
- 
-                I : T;
-                E : EXCEPTION;
-                PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
- 
-                     TEMP : T;
- 
-                BEGIN     -- P
- 
-                     TEMP := PI;    -- SAVE VALUE OF PI AT PROC ENTRY.
- 
-                     I := C101;
-                     IF (PI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) " &
-                                  "ACTUAL VARIABLE CHANGES THE VALUE " &
-                                  "OF INPUT PARAMETER");
-                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
-                     END IF;
- 
-                     PO := C1;
-                     IF (PI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) OUT " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
-                     END IF;
- 
-                     PIO := C10;
-                     IF (PI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) IN " &
-                                  "OUT PARAMETER CHANGES THE VALUE " &
-                                  "OF INPUT PARAMETER");
-                     END IF;
- 
-                     RAISE E;  -- CHECK EXCEPTION HANDLING.
-                END P;
- 
-           BEGIN     -- C
-                I := C100;
-                P (I, I, I);
-                FAILED ("EXCEPTION NOT RAISED - C");
-           EXCEPTION
-                WHEN E =>
-                     IF (I /= C101) THEN
-                          FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
-                                  "PARAMETER VALUE CHANGED DESPITE " &
-                                  "RAISED EXCEPTION");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - C");
-           END C;
- 
-      ---------------------------------------------------
- 
-       D : DECLARE
- 
-                I, J : T;
- 
-                FUNCTION F (FI : IN T) RETURN T IS
- 
-                     TEMP : T := FI;     -- SAVE VALUE OF FI AT FN ENTRY.
- 
-                BEGIN     -- F
-                     I := C100;
-                     IF (FI /= TEMP) THEN
-                          FAILED ("ASSIGNMENT TO PRIVATE " &
-                                  "(ACCESS) ACTUAL FUNCTION " &
-                                  "PARAMETER CHANGES THE VALUE " &
-                                  "OF INPUT PARAMETER");
-                     END IF;
-                     RETURN C_NULL;
-                END F;
- 
-            BEGIN     -- D
-                I := C_NULL;
-                J := F(I);
-           END D;
- 
-      END C_D;
- 
-      ---------------------------------------------------
- 
-      RESULT;
- 
- END C62003B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C62004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALIASING IS PERMITTED FOR PARAMETERS OF COMPOSITE TYPES,
- --   E.G., THAT A MATRIX ADDITION PROCEDURE CAN BE CALLED WITH THREE
- --   IDENTICAL ARGUMENTS.  (NOTE: ALIASING MAY NOT WORK FOR ARGUMENTS
- --   TO ALL SUBROUTINES SINCE PARAMETER PASSING IS IMPLEMENTATION
- --   DEPENDENT.  HOWEVER, THIS TEST IS NOT ERRONEOUS.)
- 
- -- DAS  1/26/81
- 
- WITH REPORT;
- PROCEDURE C62004A IS
- 
-      USE REPORT;
- 
-      TYPE MATRIX IS ARRAY (1..3,1..3) OF INTEGER;
- 
-      A    : MATRIX  := ((1,2,3),(4,5,6),(7,8,9));
- 
-      PROCEDURE MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX) IS
-      BEGIN
-           FOR I IN 1..3 LOOP
-                FOR J IN 1..3 LOOP
-                     SUM(I,J) := X(I,J) + Y(I,J);
-                END LOOP;
-           END LOOP;
-      END MAT_ADD;
- 
- BEGIN
- 
-      TEST ("C62004A", "CHECK THAT ALIASING IS PERMITTED FOR" &
-                       " PARAMETERS OF COMPOSITE TYPES");
- 
-      MAT_ADD (A, A, A);
- 
-      IF (A /= ((2,4,6),(8,10,12),(14,16,18))) THEN
-           FAILED ("THE RESULT OF THE MATRIX ADDITION IS INCORRECT");
-      END IF;
- 
-      RESULT;
- 
- END C62004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c62006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c62006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- C62006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE DISCRIMINANTS OF AN OUT FORMAL PARAMETER, AS WELL AS
- -- THE DISCRIMINANTS OF THE SUBCOMPONENTS OF AN OUT FORMAL PARAMETER,
- -- MAY BE READ INSIDE THE PROCEDURE.
- 
- -- SPS 2/17/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C62006A IS
- BEGIN
- 
-      TEST ("C62006A", "CHECK THAT THE DISCRIMINANTS OF AN OUT FORMAL " &
-            "PARAMETER CAN BE READ INSIDE THE PROCEDURE");
- 
-      DECLARE
- 
-           TYPE R1 (D1 : INTEGER) IS RECORD
-                NULL;
-           END RECORD;
- 
-           TYPE R2 (D2 : POSITIVE) IS RECORD
-                C : R1 (2);
-           END RECORD;
- 
-           R : R2 (5);
- 
-           PROCEDURE P (REC : OUT R2) IS
-           BEGIN
- 
-                IF REC.D2 /= 5 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
-                             " OUT PARAMETER");
-                END IF;
- 
-                IF REC.C.D1 /= 2 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
-                             " OF THE SUBCOMPONENT OF AN OUT PARAMETER");
-                END IF;
-           END P;
- 
-      BEGIN
-           P (R);
-      END;
- 
-      RESULT;
- 
- END C62006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c631001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c631001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c631001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c631001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- C631001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if different forms of a name are used in the default 
- --      expression of a discriminant part, the selector may be an operator
- --      symbol or a character literal.
- --
- -- TEST DESCRIPTION:
- --      This transition test defines private types where their selectors in
- --      the default expression of the discriminant parts at the full type 
- --      declarations are an operator and a literal, respectively. 
- --      The test also declares procedures that use an operator and a literal
- --      as selectors in the formal parts. 
- --
- --      Inspired by B63102A.ADA.
- --
- --
- -- CHANGE HISTORY:
- --      25 Mar 96   SAIC    Initial version for ACVC 2.1.
- --      26 Feb 97   PWB.CTA Removed use of function called before elaboration
- --!
- 
- with Report;
- 
- procedure C631001 is
- 
-    package C631001_0 is 
- 
-       type Int_Type is range 1 .. 100;
-       type Enu_Type is ('A', 'B', 'C', 'D');
- 
-       type Private_Enu (D : Enu_Type := 'B')       is private;
- 
-       function "+" (X, Y : Int_Type) return Int_Type;
- 
-       procedure Int_Proc (P1 : in  Int_Type := "+" (10, 15);
-                           P2 : out Int_Type);
-                                     
-       procedure Enu_Proc (P1 : in  Enu_Type := 'C';
-                           P2 : out Enu_Type);
- 
-    private
- 
-       type Private_Enu (D : Enu_Type := C631001_0.'B') is              -- OK.
-         record
-            C2 : Enu_Type := D;
-         end record;
- 
-       -----------------------------------------------------------------
-       PE_Obj  : C631001_0.Private_Enu;
- 
-    end C631001_0;
- 
-      --==================================================================--
- 
-    package body C631001_0 is 
- 
-       function "+" (X, Y : Int_Type) return Int_Type is
-       begin
-          return 10;
-       end "+";
- 
-       -----------------------------------------------------------------
-       procedure Int_Proc (P1 : in  Int_Type := C631001_0."+" (10, 15); -- OK.
-                           P2 : out Int_Type) is
-                                     
-       begin
-          P2 := P1;
-       end Int_Proc;
- 
-       -----------------------------------------------------------------
-       procedure Enu_Proc (P1 : in  Enu_Type := C631001_0.'C';          -- OK.
-                           P2 : out Enu_Type) is
-       begin
-          P2 := P1;
-       end Enu_Proc;
- 
-       -----------------------------------------------------------------
- 
-    end C631001_0;
- 
-    ---------------------------------------------------------------------------
-    Int_Obj : C631001_0.Int_Type := 50;
-    Enu_Obj : C631001_0.Enu_Type := C631001_0.'D';
- 
-    -- Direct visibility to operator symbols
-    use type C631001_0.Int_Type;
-    use type C631001_0.Enu_Type;
- 
- begin  -- main
- 
-    Report.Test ("C631001", "Check that if different forms of a name are " &
-                 "used in the default expression of a discriminant part, " &
-                 "the selector may be an operator symbol or a character "  &
-                 "literal");
- 
-    C631001_0.Int_Proc (P2 => Int_Obj);
- 
-    if Int_Obj /= 10 then
-      Report.Failed ("Wrong result for Int_Obj");
-    end if;
- 
-    C631001_0.Enu_Proc (P2 => Enu_Obj);
- 
-    if Enu_Obj /= 'C' then
-      Report.Failed ("Wrong result for Enu_Obj");
-    end if;
- 
-    Report.Result;
- 
- end C631001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c640001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c640001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c640001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c640001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,334 ****
- -- C640001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the prefix of a subprogram call with an actual parameter
- --      part may be an implicit dereference of an access-to-subprogram value.
- --      Check that, for an access-to-subprogram type whose designated profile
- --      contains parameters of a tagged generic formal type, an access-to-
- --      subprogram value may designate dispatching and non-dispatching
- --      operations, and that dereferences of such a value call the appropriate
- --      subprogram.
- --
- -- TEST DESCRIPTION:
- --      The test declares a tagged type (Table) with a dispatching operation
- --      (Clear), as well as a derivative (Table2) which overrides that
- --      operation. A subprogram with the same name and profile as Clear is
- --      declared in a separate package -- it is therefore not a dispatching
- --      operation of Table. For the purposes of the test, each version of Clear
- --      modifies the components of its parameter in a unique way.
- --
- --      Additionally, an operation (Reset) of type Table is declared which
- --      makes a re-dispatching call to Clear, i.e.,
- --
- --         procedure Reset (A: in out Table) is
- --         begin
- --            ...
- --            Clear (Table'Class(A));  -- Re-dispatch based on tag of actual.
- --            ...
- --         end Reset;   
- --
- --      An access-to-subprogram type is declared within a generic package,
- --      with a designated profile which declares a parameter of a generic
- --      formal tagged private type.
- --
- --      The generic is instantiated with type Table. The instance defines an
- --      array of access-to-subprogram values (which represents a table of
- --      operations to be performed sequentially on a single operand).
- --      Access values designating the dispatching version of Clear, the
- --      non-dispatching version of Clear, and Reset (which re-dispatches to
- --      Clear) are placed in this array.
- --
- --      In the instance, each subprogram in the array is called by implicitly
- --      dereferencing the corresponding access value. For the dispatching and
- --      non-dispatching versions of Clear, the actual parameter passed is of
- --      type Table. For Reset, the actual parameter passed is a view conversion
- --      of an object of type Table2 to type Table, i.e., Table(Table2_Obj).
- --      Since the tag of the operand never changes, the call to Clear within
- --      Reset should execute Table2's version of Clear.
- --
- --      The main program verifies that the appropriate version of Clear is
- --      called in each case, by checking that the components of the actual are
- --      updated as expected.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C640001_0 is
- 
-    -- Data type artificial for testing purposes.
- 
-    Row_Len : constant := 10;
- 
-    T : constant Boolean := True;
-    F : constant Boolean := False;
- 
-    type Row_Type is array (1 .. Row_Len) of Boolean;
- 
-    function Is_True  (A : in Row_Type) return Boolean;
-    function Is_False (A : in Row_Type) return Boolean;
- 
- 
-    Init : constant Row_Type := (T, F, T, F, T, F, T, F, T, F);
- 
-    type Table is tagged record                  -- Tagged type.
-       Row1 : Row_Type := Init;
-       Row2 : Row_Type := Init;
-    end record;
- 
-    procedure Clear (A : in out Table);          -- Dispatching operation.
- 
-    procedure Reset (A : in out Table);          -- Re-dispatching operation.
- 
-    -- ...Other operations.
- 
- 
-    type Table2 is new Table with null record;   -- Extension of Table (but
-                                                 -- structurally identical).
- 
-    procedure Clear (A : in out Table2);         -- Overrides parent's op.
- 
-    -- ...Other operations.
- 
- 
- end C640001_0;
- 
- 
-      --===================================================================--
- 
- 
- package body C640001_0 is
- 
-    function Is_True (A : in Row_Type) return Boolean is
-    begin
-       for I in A'Range loop
-          if A(I) /= True then                  -- Return true if all elements
-             return False;                      -- of A are True.
-          end if;
-       end loop;
-       return True;
-    end Is_True;
- 
- 
-    function Is_False (A : in Row_Type) return Boolean is
-    begin
-       return A = Row_Type'(others => False);   -- Return true if all elements
-    end Is_False;                               -- of A are False.
- 
- 
-    procedure Clear (A : in out Table) is
-    begin
-       for I in Row_Type'Range loop             -- This version of Clear sets
-          A.Row1(I) := False;                   -- the elements of Row1 only
-       end loop;                                -- to False.
-    end Clear;
- 
- 
-    procedure Reset (A : in out Table) is
-    begin
-       Clear (Table'Class(A));                  -- Redispatch to appropriate
-       -- ... Other "reset" activities.         -- version of Clear.
-    end Reset;
- 
- 
-    procedure Clear (A : in out Table2) is
-    begin
-       for I in Row_Type'Range loop             -- This version of Clear sets
-          A.Row1(I) := True;                    -- the elements of Row1 only
-       end loop;                                -- to True.
-    end Clear;
- 
- 
- end C640001_0;
- 
- 
-      --===================================================================--
- 
- 
- with C640001_0;
- package C640001_1 is
- 
-    procedure Clear (T : in out C640001_0.Table);  -- Non-dispatching operation.
- 
- end C640001_1;
- 
- 
-      --===================================================================--
- 
- 
- package body C640001_1 is
- 
-    procedure Clear (T : in out C640001_0.Table) is
-    begin
-       for I in C640001_0.Row_Type'Range loop   -- This version of Clear sets
-          T.Row2(I) := True;                    -- the elements of Row2 only
-       end loop;                                -- to True.
-    end Clear;
- 
- end C640001_1;
- 
- 
-      --===================================================================--
- 
- 
- -- This unit represents a support package for table-driven processing of
- -- data objects. Process_Operand performs a set of operations are performed
- -- sequentially on a single operand. Note that parameters are provided to
- -- specify which subset of operations in the operations table are to be
- -- performed (ordinarily these might be omitted, but the test requires that
- -- each operation be called individually for a single operand).
- 
- generic
-    type Tag is tagged private;
- package C640001_2 is
- 
-    type Proc_Ptr is access procedure (P: in out Tag);
- 
-    type Op_List is private;
- 
-    procedure Add_Op (Op   : in     Proc_Ptr;                -- Add operation to
-                      List : in out Op_List);                -- to list of ops.
- 
-    procedure Process_Operand (Operand  : in out Tag;        -- Execute a subset
-                               List     : in     Op_List;    -- of a list of
-                               First_Op : in     Positive;   -- operations using
-                               Last_Op  : in     Positive);  -- a given operand.
- 
-    -- ...Other operations.
- 
- private
-    type Op_Array is array (1 .. 3) of Proc_Ptr;
- 
-    type Op_List is record
-       Top : Natural := 0;
-       Ops : Op_Array;
-    end record;
- end C640001_2;
- 
- 
-      --===================================================================--
- 
- 
- package body C640001_2 is
- 
-    procedure Add_Op (Op   : in     Proc_Ptr;
-                      List : in out Op_List) is
-    begin
-       List.Top := List.Top + 1;  -- Artificial; no Constraint_Error protection.
-       List.Ops(List.Top) := Op;
-    end Add_Op;
- 
- 
-    procedure Process_Operand (Operand  : in out Tag;
-                               List     : in     Op_List;
-                               First_Op : in     Positive;
-                               Last_Op  : in     Positive) is
-    begin
-       for I in First_Op .. Last_Op loop
-          List.Ops(I)(Operand);       -- Implicit dereference of an
-       end loop;                      -- access-to-subprogram value.
-    end Process_Operand;
- 
- end C640001_2;
- 
- 
-      --===================================================================--
- 
- 
- with C640001_0;
- with C640001_1;
- with C640001_2;
- 
- with Report;
- procedure C640001 is
- 
-    package Table_Support is new C640001_2 (C640001_0.Table);
- 
-    Sub_Ptr   : Table_Support.Proc_Ptr;
-    My_List   : Table_Support.Op_List;
-    My_Table1 : C640001_0.Table;             -- Initial values of both Row1 &
-                                             -- Row2 are (T,F,T,F,T,F,T,F,T,F).
-    My_Table2 : C640001_0.Table2;            -- Initial values of both Row1 &
-                                             -- Row2 are (T,F,T,F,T,F,T,F,T,F).
- begin
-    Report.Test ("C640001", "Check that, for an access-to-subprogram type " &
-                            "whose designated profile contains parameters " &
-                            "of a tagged generic formal type, an access-" &
-                            "to-subprogram value may designate dispatching " &
-                            "and non-dispatching operations");
- 
-    --
-    -- Add subprogram access values to list:
-    --
- 
-    Sub_Ptr := C640001_0.Clear'Access;       -- Designates dispatching op.
-    Table_Support.Add_Op (Sub_Ptr, My_List); -- (1st operation on My_List).
- 
-    Sub_Ptr := C640001_1.Clear'Access;       -- Designates non-dispatching op.
-    Table_Support.Add_Op (Sub_Ptr, My_List); -- (2nd operation on My_List).
- 
-    Sub_Ptr := C640001_0.Reset'Access;       -- Designates re-dispatching op.
-    Table_Support.Add_Op (Sub_Ptr, My_List); -- (3rd operation on My_List).
- 
- 
-    --
-    -- Call dispatching operation:
-    --
- 
-    Table_Support.Process_Operand (My_Table1, My_List, 1, 1);   -- Call 1st op.
-    
-    if not C640001_0.Is_False (My_Table1.Row1) then
-       Report.Failed ("Wrong result after calling dispatching operation");
-    end if;
- 
- 
-    --
-    -- Call non-dispatching operation:
-    --
- 
-    Table_Support.Process_Operand (My_Table1, My_List, 2, 2);   -- Call 2nd op.
-    
-    if not C640001_0.Is_True (My_Table1.Row2) then
-       Report.Failed ("Wrong result after calling non-dispatching operation");
-    end if;
- 
- 
-    --
-    -- Call re-dispatching operation:
-    --
- 
-    Table_Support.Process_Operand (C640001_0.Table(My_Table2),  -- View conv.
-                                   My_List, 3, 3);              -- Call 3rd op.
-    
-    if not C640001_0.Is_True (My_Table2.Row1) then
-       Report.Failed ("Wrong result after calling re-dispatching operation");
-    end if;
- 
- 
-    Report.Result;
- end C640001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64002b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- C64002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PARAMETERLESS SUBPROGRAMS CAN BE CALLED WITH APPROPRIATE
- --   NOTATION.
- 
- -- DAS  1/27/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64002B IS
- 
-      USE REPORT;
- 
-      I    : INTEGER := 1;
- 
-      FUNCTION F0 RETURN INTEGER IS
-      BEGIN
-           RETURN 7;
-      END F0;
- 
-      PROCEDURE P0 IS
-      BEGIN
-           I := 15;
-      END P0;
- 
- BEGIN
- 
-      TEST ("C64002B", "CHECK THAT PARAMETERLESS SUBPROGRAMS CAN BE" &
-                       " CALLED");
- 
-      IF (F0 /= 7) THEN
-           FAILED ("PARAMETERLESS FUNCTION CALL RETURNS BAD VALUE");
-      END IF;
- 
-      P0;
-      IF (I /= 15) THEN
-           FAILED ("PARAMETERLESS PROCEDURE CALL YIELDS INCORRECT" &
-                   " RESULT");
-      END IF;
- 
-      RESULT;
- 
- END C64002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64004g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64004g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64004g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64004g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C64004G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR CALLS TO SUBPROGRAMS HAVING AT LEAST ONE DEFAULT
- --   PARAMETER, THE CORRECT ASSOCIATION IS MADE BETWEEN ACTUAL AND
- --   FORMAL PARAMETERS.
- 
- -- DAS  1/27/81
- 
- 
- WITH REPORT;
- PROCEDURE C64004G IS
- 
-      USE REPORT;
- 
-      Y1,Y2,Y3  : INTEGER := 0;
-      O1,O2     : INTEGER := 0;
- 
-      PROCEDURE P (I1: INTEGER; I2: INTEGER := 2; I3: INTEGER := 3;
-                   O1,O2,O3: OUT INTEGER) IS
-      BEGIN
-           O1 := I1;
-           O2 := I2;
-           O3 := I3;
-      END P;
- 
-      FUNCTION F (I1: INTEGER := 1; I2: INTEGER) RETURN INTEGER IS
-      BEGIN
-           C64004G.O1 := I1;
-           C64004G.O2 := I2;
-           RETURN 1;
-      END F;
- 
- BEGIN
- 
-      TEST ("C64004G", "CHECK ASSOCIATIONS BETWEEN ACTUAL AND FORMAL" &
-                       " PARAMETERS (HAVING DEFAULT VALUES)");
- 
-      P (I1=>11, I2=>12, I3=>13, O1=>Y1, O2=>Y2, O3=>Y3);
-      IF (Y1 /= 11) OR (Y2 /= 12) OR (Y3 /= 13) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 1");
-      END IF;
- 
-      P (I1=>21, O1=>Y1, O2=>Y2, O3=>Y3);
-      IF (Y1 /= 21) OR (Y2 /= 2) OR (Y3 /= 3) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 2");
-      END IF;
- 
-      P (O1=>Y1, O3=>Y3, I1=>31, I3=>33, O2=>Y2);
-      IF (Y1 /= 31) OR (Y2 /= 2) OR (Y3 /= 33) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 3");
-      END IF;
- 
-      P (41, 42, O1=>Y1, O2=>Y2, O3=>Y3);
-      IF (Y1 /= 41) OR (Y2 /= 42) OR (Y3 /= 3) THEN
-           FAILED ("INCORRECT PARANETER ASSOCIATION - 4");
-      END IF;
- 
-      P (51, O3=>Y3, O1=>Y1, O2=>Y2, I3=>53);
-      IF (Y1 /= 51) OR (Y2 /= 2) OR (Y3 /= 53) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 5");
-      END IF;
- 
-      Y1 := F (I1=>61, I2=>62);
-      IF (O1 /= 61) OR (O2 /= 62) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 6");
-      END IF;
- 
-      Y2 := F (I2=>72, I1=>71);
-      IF (O1 /= 71) OR (O2 /= 72) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 7");
-      END IF;
- 
-      Y3 := F (I2=>82);
-      IF (O1 /= 1) OR (O2 /= 82) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 8");
-      END IF;
- 
-      RESULT;
- 
- END C64004G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C64005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SUBPROGRAM CAN BE CALLED
- -- RECURSIVELY AND THAT NON-LOCAL VARIABLES AND 
- -- CONSTANTS ARE PROPERLY ACCESSED FROM WITHIN
- -- RECURSIVE INVOCATIONS.
- 
- -- CVP 5/1/81
- 
- WITH REPORT;
- PROCEDURE C64005A IS
- 
-      USE REPORT;
- 
-      TWENTY : CONSTANT INTEGER := 20;
-      C1 : CONSTANT INTEGER := 1;
-      I1, I2 : INTEGER := 0;
- 
-      PROCEDURE RECURSE (I1A : INTEGER; I2 : IN OUT INTEGER) IS
-           C1 : CONSTANT INTEGER := 5;
-      BEGIN
-           IF I1A < TWENTY THEN
-                RECURSE (I1A+C1, I2);
-                I1 := I1 + C64005A.C1;
-                I2 := I2 + I1A;
-           END IF;
-      END RECURSE;
- 
- BEGIN
-      TEST ("C64005A", "RECURSIVE SUBPROGRAMS WITH " &
-            "NON-LOCAL DATA ACCESS");
- 
-      RECURSE (0, I2);
- 
-      IF I1 /= 4 OR I2 /= 30 THEN
-           FAILED ("RECURSIVE PROCEDURE INVOCATIONS " &
-                   "WITH GLOBAL DATA ACCESS NOT PERFORMED " &
-                   "CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C64005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C64005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SUBPROGRAM CAN BE CALLED RECURSIVELY AND THAT NON-LOCAL
- -- VARIABLES AND CONSTANTS ARE PROPERLY ACCESSED FROM WITHIN RECURSIVE
- -- INVOCATIONS.
- 
- -- CPP 7/2/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64005B IS
- 
-      COUNT : INTEGER := 0;
-      TWENTY : CONSTANT INTEGER := 20;
-      C1 : CONSTANT INTEGER := 1;
-      G1, G2, G3 : INTEGER := 0;
-      G4, G5 : INTEGER := 0;
- 
-      PROCEDURE R (A1 : INTEGER; A2 : IN OUT INTEGER; A3 : OUT INTEGER)
-      IS
-           C1 : CONSTANT INTEGER := 5;
-           TEN : CONSTANT INTEGER := 10;
-           J1, J2 : INTEGER := 1;
-           J3 : INTEGER := 0;
- 
-           PROCEDURE RECURSE (P1 : INTEGER; P2 : IN OUT INTEGER) IS
-                C1 : INTEGER := 2;
-           BEGIN     -- RECURSE
-                C1 := IDENT_INT (10);
-                IF P1 < TWENTY THEN
-                     RECURSE (P1 + C1, G2);
-                     G1 := G1 + C64005B.C1;
-                     G3 := G3 + P1;
-                     P2 := P2 + IDENT_INT(2);
-                     A2 := A2 + IDENT_INT(1);
-                     J2 := J2 + R.C1;
-                END IF;
-           END RECURSE;
- 
-      BEGIN     -- R
-           IF A2 < TEN THEN
-                A2 := A2 + C1;
-                RECURSE (0, J1);
-                J3 := J3 + TEN;
-                COUNT := COUNT + 1;
-                COMMENT ("ON PASS # " & INTEGER'IMAGE(COUNT));
-                COMMENT ("VALUE OF A2 IS " & INTEGER'IMAGE(A2));
-                COMMENT ("VALUE OF J3 IS " & INTEGER'IMAGE(J3));
-                R (0, A2, J3);
-                J3 := J3 + A2;
-           END IF;
-           A3 := J1 + J3;
-      END R;
- 
- BEGIN
-      TEST("C64005B", "RECURSIVE SUBPROGRAMS WITH ALL KINDS " &
-           "OF DATA ACCESS");
- 
-      R (0, G4, G5);
- 
-      IF (COUNT /=  2) OR (G1 /=  4) OR
-         (G2    /=  4) OR (G3 /= 20) OR
-         (G4    /= 14) OR (G5 /= 35) THEN
-           FAILED ("RECURSIVE INVOCATIONS' DATA ACCESS IS NOT" &
-                   " WORKING CORRECTLY");
-      END IF;
- 
-      COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
-      COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
-      COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
-      COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
-      COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
-      COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN PROGRAM_ERROR =>
-           FAILED ("PROGRAM_ERROR RAISED");
-           COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
-           COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
-           COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
-           COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
-           COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
-           COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
-           RESULT;
- 
- END C64005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,330 ****
- -- C64005C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT
- -- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM
- -- WITHIN RECURSIVE INVOCATIONS.  THIS TEST CHECKS THAT EVERY DISPLAY OR
- -- STATIC CHAIN LEVEL CAN BE ACCESSED.
- 
- -- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES.
- 
- -- JRK 7/26/84
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C64005C IS
- 
-      SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C';
-      SUBTYPE CALL IS CHARACTER RANGE '1' .. '3';
- 
-      MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) -
-                            LEVEL'POS (LEVEL'FIRST) + 1;
-      T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV +
-                                        MAX_LEV*(MAX_LEV+1)/2*2)) + 1;
-      G_LEN : CONSTANT := 2 + 4 * MAX_LEV;
- 
-      TYPE TRACE IS
-           RECORD
-                E : NATURAL := 0;
-                S : STRING (1 .. T_LEN);
-           END RECORD;
- 
-      V : CHARACTER := IDENT_CHAR ('<');
-      L : CHARACTER := IDENT_CHAR ('>');
-      T : TRACE;
-      G : STRING (1 .. G_LEN);
- 
-      PROCEDURE C64005CA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
- 
-           V : STRING (1..2);
- 
-           M : CONSTANT NATURAL := LEVEL'POS (L) -
-                                   LEVEL'POS (LEVEL'FIRST) + 1;
-           N : CONSTANT NATURAL := 2 * M + 1;
- 
-           PROCEDURE C64005CB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
- 
-                V : STRING (1..2);
- 
-                M : CONSTANT NATURAL := LEVEL'POS (L) -
-                                        LEVEL'POS (LEVEL'FIRST) + 1;
-                N : CONSTANT NATURAL := 2 * M + 1;
- 
-                PROCEDURE C64005CC (L : LEVEL; C : CALL;
-                                    T : IN OUT TRACE) IS
- 
-                     V : STRING (1..2);
- 
-                     M : CONSTANT NATURAL := LEVEL'POS (L) -
-                                             LEVEL'POS (LEVEL'FIRST) + 1;
-                     N : CONSTANT NATURAL := 2 * M + 1;
- 
-                BEGIN
- 
-                     V (1) := IDENT_CHAR (ASCII.LC_C);
-                     V (2) := C;
- 
-                     -- APPEND ALL V TO T.
-                     T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
-                                             C64005CB.V & C64005CC.V;
-                     T.E := T.E + N;
- 
-                     CASE C IS
- 
-                          WHEN '1' =>
-                               C64005CA (IDENT_CHAR(LEVEL'FIRST),
-                                         IDENT_CHAR('2'), T);
- 
-                          WHEN '2' =>
-                               C64005CC (L, IDENT_CHAR('3'), T);
- 
-                          WHEN '3' =>
-                               -- APPEND MID-POINT SYMBOL TO T.
-                               T.S (T.E+1) := IDENT_CHAR ('=');
-                               T.E := T.E + 1;
- 
-                               -- G := CATENATE ALL V, L, C;
-                               G := C64005C.V & C64005C.L &
-                                   C64005CA.V & C64005CA.L & C64005CA.C &
-                                   C64005CB.V & C64005CB.L & C64005CB.C &
-                                   C64005CC.V & C64005CC.L & C64005CC.C;
-                     END CASE;
- 
-                     -- APPEND ALL L AND C TO T IN REVERSE ORDER.
-                     T.S (T.E+1 .. T.E+N) := C64005CC.L & C64005CC.C &
-                                             C64005CB.L & C64005CB.C &
-                                             C64005CA.L & C64005CA.C &
-                                             C64005C.L;
-                     T.E := T.E + N;
- 
-                END C64005CC;
- 
-           BEGIN
- 
-                V (1) := IDENT_CHAR (ASCII.LC_B);
-                V (2) := C;
- 
-                -- APPEND ALL V TO T.
-                T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
-                                        C64005CB.V;
-                T.E := T.E + N;
- 
-                CASE C IS
- 
-                     WHEN '1' =>
-                          C64005CC (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
- 
-                     WHEN '2' =>
-                          C64005CB (L, IDENT_CHAR('3'), T);
- 
-                     WHEN '3' =>
-                          C64005CC (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
-                END CASE;
- 
-                -- APPEND ALL L AND C TO T IN REVERSE ORDER.
-                T.S (T.E+1 .. T.E+N) := C64005CB.L & C64005CB.C &
-                                        C64005CA.L & C64005CA.C &
-                                        C64005C.L;
-                T.E := T.E + N;
- 
-           END C64005CB;
- 
-      BEGIN
- 
-           V (1) := IDENT_CHAR (ASCII.LC_A);
-           V (2) := C;
- 
-           -- APPEND ALL V TO T.
-           T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V;
-           T.E := T.E + N;
- 
-           CASE C IS
- 
-                WHEN '1' =>
-                     C64005CB (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
- 
-                WHEN '2' =>
-                     C64005CA (L, IDENT_CHAR('3'), T);
- 
-                WHEN '3' =>
-                     C64005CB (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
-           END CASE;
- 
-           -- APPEND ALL L AND C TO T IN REVERSE ORDER.
-           T.S (T.E+1 .. T.E+N) := C64005CA.L & C64005CA.C & C64005C.L;
-           T.E := T.E + N;
- 
-      END C64005CA;
- 
- BEGIN
-      TEST ("C64005C", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
-                       "PARAMETERS AT ALL LEVELS OF NESTED " &
-                       "RECURSIVE PROCEDURES ARE ACCESSIBLE");
- 
-      -- APPEND V TO T.
-      T.S (T.E+1) := V;
-      T.E := T.E + 1;
- 
-      C64005CA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T);
- 
-      -- APPEND L TO T.
-      T.S (T.E+1) := L;
-      T.E := T.E + 1;
- 
-      COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E));
-      COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E));
-      COMMENT ("GLOBAL SNAPSHOT IS: " & G);
- 
-      -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY.
- 
-      DECLARE
-           SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A ..
-                CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1);
- 
-           CT : TRACE;
-           CG : STRING (1 .. G_LEN);
-      BEGIN
-           COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " &
-                    INTEGER'IMAGE(T_LEN));
- 
-           IF T.E /= IDENT_INT (T_LEN) THEN
-                FAILED ("WRONG FINAL CALL TRACE LENGTH");
- 
-           ELSE CT.S (CT.E+1) := '<';
-                CT.E := CT.E + 1;
- 
-                FOR I IN LC_LEVEL LOOP
-                     CT.S (CT.E+1) := '<';
-                     CT.E := CT.E + 1;
- 
-                     FOR J IN LC_LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '1';
-                          CT.E := CT.E + 2;
-                     END LOOP;
-                END LOOP;
- 
-                FOR I IN LC_LEVEL LOOP
-                     CT.S (CT.E+1) := '<';
-                     CT.E := CT.E + 1;
- 
-                     FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := I;
-                     CT.S (CT.E+2) := '2';
-                     CT.E := CT.E + 2;
- 
-                     CT.S (CT.E+1) := '<';
-                     CT.E := CT.E + 1;
- 
-                     FOR J IN LC_LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
-                END LOOP;
- 
-                CT.S (CT.E+1) := '=';
-                CT.E := CT.E + 1;
- 
-                FOR I IN REVERSE LEVEL LOOP
-                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := '>';
-                     CT.E := CT.E + 1;
- 
-                     CT.S (CT.E+1) := I;
-                     CT.S (CT.E+2) := '2';
-                     CT.E := CT.E + 2;
- 
-                     FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := '>';
-                     CT.E := CT.E + 1;
-                END LOOP;
- 
-                FOR I IN REVERSE LEVEL LOOP
-                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '1';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := '>';
-                     CT.E := CT.E + 1;
-                END LOOP;
- 
-                CT.S (CT.E+1) := '>';
-                CT.E := CT.E + 1;
- 
-                IF CT.E /= IDENT_INT (T_LEN) THEN
-                     FAILED ("WRONG ITERATIVE TRACE LENGTH");
- 
-                ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S);
- 
-                     IF T.S /= CT.S THEN
-                          FAILED ("WRONG FINAL CALL TRACE");
-                     END IF;
-                END IF;
-           END IF;
- 
-           DECLARE
-                E : NATURAL := 0;
-           BEGIN
-                CG (1..2) := "<>";
-                E := E + 2;
- 
-                FOR I IN LEVEL LOOP
-                     CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) -
-                                               LEVEL'POS(LEVEL'FIRST) +
-                                               LC_LEVEL'POS
-                                                       (LC_LEVEL'FIRST));
-                     CG (E+2) := '3';
-                     CG (E+3) := I;
-                     CG (E+4) := '3';
-                     E := E + 4;
-                END LOOP;
- 
-                COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG);
- 
-                IF G /= CG THEN
-                     FAILED ("WRONG GLOBAL SNAPSHOT");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END C64005C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005d0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005d0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005d0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,219 ****
- -- C64005D0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT
- -- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM
- -- WITHIN RECURSIVE INVOCATIONS.  THIS TEST CHECKS THAT EVERY DISPLAY OR
- -- STATIC CHAIN LEVEL CAN BE ACCESSED.
- 
- -- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES (SEPARATELY
- -- COMPILED AS SUBUNITS).
- 
- -- SEPARATE FILES ARE:
- --   C64005D0M THE MAIN PROCEDURE.
- --   C64005DA  A RECURSIVE PROCEDURE SUBUNIT OF C64005D0M.
- --   C64005DB  A RECURSIVE PROCEDURE SUBUNIT OF C64005DA.
- --   C64005DC  A RECURSIVE PROCEDURE SUBUNIT OF C64005DB.
- 
- -- JRK 7/30/84
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C64005D0M IS
- 
-      SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C';
-      SUBTYPE CALL IS CHARACTER RANGE '1' .. '3';
- 
-      MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) -
-                            LEVEL'POS (LEVEL'FIRST) + 1;
-      T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV +
-                                        MAX_LEV*(MAX_LEV+1)/2*2)) + 1;
-      G_LEN : CONSTANT := 2 + 4 * MAX_LEV;
- 
-      TYPE TRACE IS
-           RECORD
-                E : NATURAL := 0;
-                S : STRING (1 .. T_LEN);
-           END RECORD;
- 
-      V : CHARACTER := IDENT_CHAR ('<');
-      L : CHARACTER := IDENT_CHAR ('>');
-      T : TRACE;
-      G : STRING (1 .. G_LEN);
- 
-      PROCEDURE C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
-           SEPARATE;
- 
- BEGIN
-      TEST ("C64005D", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
-                       "PARAMETERS AT ALL LEVELS OF NESTED " &
-                       "RECURSIVE PROCEDURES ARE ACCESSIBLE (FOR " &
-                       "3 LEVELS OF SEPARATELY COMPILED SUBUNITS)");
- 
-      -- APPEND V TO T.
-      T.S (T.E+1) := V;
-      T.E := T.E + 1;
- 
-      C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T);
- 
-      -- APPEND L TO T.
-      T.S (T.E+1) := L;
-      T.E := T.E + 1;
- 
-      COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E));
-      COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E));
-      COMMENT ("GLOBAL SNAPSHOT IS: " & G);
- 
-      -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY.
- 
-      DECLARE
-           SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A ..
-                CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1);
- 
-           CT : TRACE;
-           CG : STRING (1 .. G_LEN);
-      BEGIN
-           COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " &
-                    INTEGER'IMAGE(T_LEN));
- 
-           IF T.E /= IDENT_INT (T_LEN) THEN
-                FAILED ("WRONG FINAL CALL TRACE LENGTH");
- 
-           ELSE CT.S (CT.E+1) := '<';
-                CT.E := CT.E + 1;
- 
-                FOR I IN LC_LEVEL LOOP
-                     CT.S (CT.E+1) := '<';
-                     CT.E := CT.E + 1;
- 
-                     FOR J IN LC_LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '1';
-                          CT.E := CT.E + 2;
-                     END LOOP;
-                END LOOP;
- 
-                FOR I IN LC_LEVEL LOOP
-                     CT.S (CT.E+1) := '<';
-                     CT.E := CT.E + 1;
- 
-                     FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := I;
-                     CT.S (CT.E+2) := '2';
-                     CT.E := CT.E + 2;
- 
-                     CT.S (CT.E+1) := '<';
-                     CT.E := CT.E + 1;
- 
-                     FOR J IN LC_LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
-                END LOOP;
- 
-                CT.S (CT.E+1) := '=';
-                CT.E := CT.E + 1;
- 
-                FOR I IN REVERSE LEVEL LOOP
-                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := '>';
-                     CT.E := CT.E + 1;
- 
-                     CT.S (CT.E+1) := I;
-                     CT.S (CT.E+2) := '2';
-                     CT.E := CT.E + 2;
- 
-                     FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '3';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := '>';
-                     CT.E := CT.E + 1;
-                END LOOP;
- 
-                FOR I IN REVERSE LEVEL LOOP
-                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
-                          CT.S (CT.E+1) := J;
-                          CT.S (CT.E+2) := '1';
-                          CT.E := CT.E + 2;
-                     END LOOP;
- 
-                     CT.S (CT.E+1) := '>';
-                     CT.E := CT.E + 1;
-                END LOOP;
- 
-                CT.S (CT.E+1) := '>';
-                CT.E := CT.E + 1;
- 
-                IF CT.E /= IDENT_INT (T_LEN) THEN
-                     FAILED ("WRONG ITERATIVE TRACE LENGTH");
- 
-                ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S);
- 
-                     IF T.S /= CT.S THEN
-                          FAILED ("WRONG FINAL CALL TRACE");
-                     END IF;
-                END IF;
-           END IF;
- 
-           DECLARE
-                E : NATURAL := 0;
-           BEGIN
-                CG (1..2) := "<>";
-                E := E + 2;
- 
-                FOR I IN LEVEL LOOP
-                     CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) -
-                                               LEVEL'POS(LEVEL'FIRST) +
-                                               LC_LEVEL'POS
-                                                       (LC_LEVEL'FIRST));
-                     CG (E+2) := '3';
-                     CG (E+3) := I;
-                     CG (E+4) := '3';
-                     E := E + 4;
-                END LOOP;
- 
-                COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG);
- 
-                IF G /= CG THEN
-                     FAILED ("WRONG GLOBAL SNAPSHOT");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END C64005D0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005da.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005da.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005da.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005da.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- C64005DA.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- JRK 7/30/84
- 
- SEPARATE (C64005D0M)
- 
- PROCEDURE C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
- 
-      V : STRING (1..2);
- 
-      M : CONSTANT NATURAL := LEVEL'POS (L) -
-                              LEVEL'POS (LEVEL'FIRST) + 1;
-      N : CONSTANT NATURAL := 2 * M + 1;
- 
-      PROCEDURE C64005DB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
-           SEPARATE;
- 
- BEGIN
- 
-      V (1) := IDENT_CHAR (ASCII.LC_A);
-      V (2) := C;
- 
-      -- APPEND ALL V TO T.
-      T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V;
-      T.E := T.E + N;
- 
-      CASE C IS
- 
-           WHEN '1' =>
-                C64005DB (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
- 
-           WHEN '2' =>
-                C64005DA (L, IDENT_CHAR('3'), T);
- 
-           WHEN '3' =>
-                C64005DB (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
-      END CASE;
- 
-      -- APPEND ALL L AND C TO T IN REVERSE ORDER.
-      T.S (T.E+1 .. T.E+N) := C64005DA.L & C64005DA.C & C64005D0M.L;
-      T.E := T.E + N;
- 
- END C64005DA;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005db.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005db.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005db.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005db.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- C64005DB.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- JRK 7/30/84
- 
- SEPARATE (C64005D0M.C64005DA)
- 
- PROCEDURE C64005DB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
- 
-      V : STRING (1..2);
- 
-      M : CONSTANT NATURAL := LEVEL'POS (L) -
-                              LEVEL'POS (LEVEL'FIRST) + 1;
-      N : CONSTANT NATURAL := 2 * M + 1;
- 
-      PROCEDURE C64005DC (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
-           SEPARATE;
- 
- BEGIN
- 
-      V (1) := IDENT_CHAR (ASCII.LC_B);
-      V (2) := C;
- 
-      -- APPEND ALL V TO T.
-      T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V & C64005DB.V;
-      T.E := T.E + N;
- 
-      CASE C IS
- 
-           WHEN '1' =>
-                C64005DC (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
- 
-           WHEN '2' =>
-                C64005DB (L, IDENT_CHAR('3'), T);
- 
-           WHEN '3' =>
-                C64005DC (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
-      END CASE;
- 
-      -- APPEND ALL L AND C TO T IN REVERSE ORDER.
-      T.S (T.E+1 .. T.E+N) := C64005DB.L & C64005DB.C &
-                              C64005DA.L & C64005DA.C &
-                              C64005D0M.L;
-      T.E := T.E + N;
- 
- END C64005DB;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005dc.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005dc.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64005dc.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64005dc.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C64005DC.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- JRK 7/30/84
- 
- SEPARATE (C64005D0M.C64005DA.C64005DB)
- 
- PROCEDURE C64005DC (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
- 
-      V : STRING (1..2);
- 
-      M : CONSTANT NATURAL := LEVEL'POS (L) -
-                              LEVEL'POS (LEVEL'FIRST) + 1;
-      N : CONSTANT NATURAL := 2 * M + 1;
- 
- BEGIN
- 
-      V (1) := IDENT_CHAR (ASCII.LC_C);
-      V (2) := C;
- 
-      -- APPEND ALL V TO T.
-      T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V & C64005DB.V &
-                              C64005DC.V;
-      T.E := T.E + N;
- 
-      CASE C IS
- 
-           WHEN '1' =>
-                C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('2'), T);
- 
-           WHEN '2' =>
-                C64005DC (L, IDENT_CHAR('3'), T);
- 
-           WHEN '3' =>
-                -- APPEND MID-POINT SYMBOL TO T.
-                T.S (T.E+1) := IDENT_CHAR ('=');
-                T.E := T.E + 1;
- 
-                -- G := CATENATE ALL V, L, C;
-                G := C64005D0M.V & C64005D0M.L &
-                     C64005DA.V & C64005DA.L & C64005DA.C &
-                     C64005DB.V & C64005DB.L & C64005DB.C &
-                     C64005DC.V & C64005DC.L & C64005DC.C;
-      END CASE;
- 
-      -- APPEND ALL L AND C TO T IN REVERSE ORDER.
-      T.S (T.E+1 .. T.E+N) := C64005DC.L & C64005DC.C &
-                              C64005DB.L & C64005DB.C &
-                              C64005DA.L & C64005DA.C &
-                              C64005D0M.L;
-      T.E := T.E + N;
- 
- END C64005DC;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c641001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c641001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c641001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c641001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,281 ****
- -- C641001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that actual parameters passed by reference are view converted
- --      to the nominal subtype of the formal parameter.
- --
- -- TEST DESCRIPTION:
- --      Check that sliding is allowed for formal parameters, especially
- --      check cases that would have caused errors in Ada'83.
- --      Check that length check for a formal parameter (esp out mode)
- --      is performed before the call, not after.
- --
- --  notes: 6.2; by reference ::= tagged, task, protected,
- --                       limited (nonprivate), or composite containing such
- --         4.6; view conversion
- --
- --
- -- CHANGE HISTORY:
- --      26 JAN 96   SAIC   Initial version
- --      04 NOV 96   SAIC   Commentary revision for release 2.1
- --      27 FEB 97   PWB.CTA Corrected reference to the wrong string
- --!
- 
- ----------------------------------------------------------------- C641001_0
- 
- package C641001_0 is
- 
-   subtype String_10 is String(1..10);
- 
-   procedure Check_String_10( S : out String_10; Start, Stop: Natural );
- 
-   procedure Check_Illegal_Slice_Reference( Slice_Passed : in out String;
-                                            Index: Natural );
- 
-   type Tagged_Data(Bound: Natural) is tagged record
-     Data_Item : String(1..Bound) := (others => '*');
-   end record;
- 
-   type Tag_List is array(Natural range <>) of Tagged_Data(5);
- 
-   subtype Tag_List_10 is Tag_List(1..10);
- 
-   procedure Check_Tag_Slice( TL : in out Tag_List_10 );
- 
-   procedure Check_Out_Tagged_Data( Formal : out Tagged_Data );
- 
- end C641001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body C641001_0 is
- 
-   String_Data : constant String := "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ";
- 
-   procedure Check_String_10( S : out String_10; Start, Stop: Natural ) is
-   begin
-     if S'Length /= 10 then
-       Report.Failed("Length check not performed prior to execution");
-     end if;
-     S := String_Data(Start..Stop);
-   exception
-     when others => Report.Failed("Exception encountered in Check_String_10");
-   end Check_String_10;
- 
-   procedure Check_Illegal_Slice_Reference( Slice_Passed : in out String;
-                                            Index: Natural ) is
-   begin
-     -- essentially "do-nothing" for optimization foilage...
-     if Slice_Passed(Index) in Character then
-     -- Intent is    ^^^^^  should raise Constraint_Error
-       Report.Failed("Illegal Slice provided legal character");
-     else
-       Report.Failed("Illegal Slice provided illegal character");
-     end if;
-   exception
-     when Constraint_Error =>
-       null; -- expected case
-     when others =>
-       Report.Failed("Wrong exception in Check_Illegal_Slice_Reference");
-   end Check_Illegal_Slice_Reference;
- 
-   procedure Check_Tag_Slice( TL : in out Tag_List_10 ) is
-     -- if the view conversion is not performed, one of the following checks
-     -- will fail (given data passed as 0..9 and then 2..11)
-   begin
-     Check_Under_Index:  -- index 0 should raise C_E
-     begin
-       TCTouch.Assert( TL(Report.Ident_Int(0)).Data_Item = "*****",
-                       "Index 0 (illegal); bad data" );
-       Report.Failed("Index 0 did not raise Constraint_Error");
-     exception
-       when Constraint_Error =>
-         null; -- expected case
-       when others =>
-         Report.Failed("Wrong exception in Check_Under_Index ");
-     end Check_Under_Index;
- 
-     Check_Over_Index:  -- index 11 should raise C_E
-     begin
-       TCTouch.Assert( TL(Report.Ident_Int(11)).Data_Item = "*****",
-                       "Index 11 (illegal); bad data" );
-       Report.Failed("Index 11 did not raise Constraint_Error");
-     exception
-       when Constraint_Error =>
-         null; -- expected case
-       when others =>
-         Report.Failed("Wrong exception in Check_Over_Index ");
-     end Check_Over_Index;
- 
-   end Check_Tag_Slice;
- 
-   procedure Check_Out_Tagged_Data( Formal : out Tagged_Data ) is
-   begin
-     TCTouch.Assert( Formal.Data_Item = "*****", "out formal data bad" );
-     Formal.Data_Item(1) := '!';
-   end Check_Out_Tagged_Data;
- 
- end C641001_0;
- 
- ------------------------------------------------------------------- C641001
- 
- with Report;
- with TCTouch;
- with C641001_0;
- procedure C641001 is
- 
-   function II( I: Integer ) return Integer renames Report.Ident_Int;
-         -- ^^ name chosen to allow embedding in calls
- 
-   A_String_10 : C641001_0.String_10;
-   Slicable    : String(1..40);
-   Tag_Slices  : C641001_0.Tag_List(0..11);
- 
-   Global_Data : String(1..26) := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
- 
-   procedure Check_Out_Sliding( Lo1, Hi1, Lo2, Hi2 : Natural ) is
- 
-     subtype One_Constrained_String is String(Lo1..Hi1);   -- 1  5
-     subtype Two_Constrained_String is String(Lo2..Hi2);   -- 6 10
- 
-     procedure Out_Param( Param : out One_Constrained_String ) is
-     begin
-       Param := Report.Ident_Str( Global_Data(Lo2..Hi2) );
-     end Out_Param;
-     Object : Two_Constrained_String;
-   begin
-     Out_Param( Object );
-     if Object /= Report.Ident_Str( Global_Data(Lo2..Hi2) ) then
-       Report.Failed("Bad result in Check_Out_Sliding");
-     end if;
-   exception
-     when others => Report.Failed("Exception in Check_Out_Sliding");
-   end Check_Out_Sliding;
- 
-   procedure Check_Dynamic_Subtype_Cases(F_Lower,F_Upper: Natural;
-                                         A_Lower,A_Upper: Natural) is
- 
-     subtype Dyn_String is String(F_Lower..F_Upper);
- 
-     procedure Check_Dyn_Subtype_Formal_Out( Param : out Dyn_String ) is
-     begin
-       Param := Global_Data(11..20);
-     end Check_Dyn_Subtype_Formal_Out;
- 
-     procedure Check_Dyn_Subtype_Formal_In( Param : in Dyn_String ) is
-     begin
-       if Param /= Global_Data(11..20) then
-         Report.Failed("Dynamic case, data mismatch");
-       end if;
-     end Check_Dyn_Subtype_Formal_In;
- 
-     Stuff: String(A_Lower..A_Upper);
- 
-   begin
-     Check_Dyn_Subtype_Formal_Out( Stuff );
-     Check_Dyn_Subtype_Formal_In( Stuff );
-   end Check_Dynamic_Subtype_Cases;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C641001", "Check that actual parameters passed by " &
-                           "reference are view converted to the nominal " &
-                           "subtype of the formal parameter" );
- 
-   -- non error cases for string slices
- 
-   C641001_0.Check_String_10( A_String_10, 1, 10 );
-   TCTouch.Assert( A_String_10 = "1234567890", "Nominal case" );
- 
-   C641001_0.Check_String_10( A_String_10, 11, 20 );
-   TCTouch.Assert( A_String_10 = "ABCDEFGHIJ", "Sliding to subtype" );
- 
-   C641001_0.Check_String_10( Slicable(1..10), 1, 10 );
-   TCTouch.Assert( Slicable(1..10) = "1234567890", "Slice, no sliding" );
- 
-   C641001_0.Check_String_10( Slicable(1..10), 21, 30 );
-   TCTouch.Assert( Slicable(1..10) = "KLMNOPQRST", "Sliding to slice" );
- 
-   C641001_0.Check_String_10( Slicable(11..20), 11, 20 );
-   TCTouch.Assert( Slicable(11..20) = "ABCDEFGHIJ", "Sliding to same" );
- 
-   C641001_0.Check_String_10( Slicable(21..30), 11, 20 );
-   TCTouch.Assert( Slicable(21..30) = "ABCDEFGHIJ", "Sliding up" );
- 
-   -- error cases for string slices
- 
-   C641001_0.Check_Illegal_Slice_Reference( Slicable(21..30), 20 );
- 
-   C641001_0.Check_Illegal_Slice_Reference( Slicable(1..15), Slicable'Last );
- 
-   -- checks for view converting actuals to formals
- 
-   -- catch low bound fault
-   C641001_0.Check_Tag_Slice( Tag_Slices(II(0)..9) );     -- II ::= Ident_Int
-   TCTouch.Assert( Tag_Slices'First = 0, "Tag_Slices'First = 0" );
-   TCTouch.Assert( Tag_Slices'Last = 11, "Tag_Slices'Last = 11" );
- 
-   -- catch high bound fault
-   C641001_0.Check_Tag_Slice( Tag_Slices(2..II(11)) );
-   TCTouch.Assert( Tag_Slices'First = 0, "Tag_Slices'First = 0" );
-   TCTouch.Assert( Tag_Slices'Last = 11, "Tag_Slices'Last = 11" );
- 
-   Check_Formal_Association_Check:
-   begin
-     C641001_0.Check_String_10( Slicable, 1, 10 ); -- catch length fault
-     Report.Failed("Exception not raised at Check_Formal_Association_Check");
-   exception
-     when Constraint_Error =>
-       null; -- expected case
-     when others =>
-       Report.Failed("Wrong exception at Check_Formal_Association_Check");
-   end Check_Formal_Association_Check;
- 
-   -- check for constrained actual, unconstrained formal
-   C641001_0.Check_Out_Tagged_Data( Tag_Slices(5) );
-   TCTouch.Assert( Tag_Slices(5).Data_Item = "!****",
-                   "formal out returned bad result" );
- 
-   -- additional checks for out mode formal parameters, dynamic subtypes
- 
-   Check_Out_Sliding( II(1),II(5), II(6),II(10) );
- 
-   Check_Out_Sliding( 21,25, 6,10 );
- 
-   Check_Dynamic_Subtype_Cases(F_Lower => II(1), F_Upper => II(10),
-                               A_Lower => II(1), A_Upper => II(10));
- 
-   Check_Dynamic_Subtype_Cases(F_Lower => II(21), F_Upper => II(30),
-                               A_Lower => II( 1), A_Upper => II(10));
- 
-   Check_Dynamic_Subtype_Cases(F_Lower => II( 1), F_Upper => II(10),
-                               A_Lower => II(21), A_Upper => II(30));
- 
-   Report.Result;
- 
- end C641001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,379 ****
- -- C64103B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR IN-OUT PARAMETERS OF A SCALAR TYPE,
- --     CONSTRAINT_ERROR IS RAISED:
- --          BEFORE A SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL
- --          PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL PARAMETER'S
- --          SUBTYPE;
- --          AFTER A SUBPROGRAM CALL WHEN THE CONVERTED FORMAL PARAMETER
- --          IS OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S SUBTYPE.
- 
- -- HISTORY:
- --     CPP  07/18/84  CREATED ORIGINAL TEST.
- --     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
- --                    REFERENCED THE ACTUAL PARAMETERS IN THE SECOND
- --                    SUBTEST.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64103B IS
- BEGIN
-      TEST ("C64103B", "FOR IN-OUT PARAMETERS OF A SCALAR TYPE, " &
-                       "CONSTRAINT_ERROR IS RAISED:  BEFORE A " &
-                       "SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL " &
-                       "PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL " &
-                       "PARAMETER'S SUBTYPE;  AFTER A SUBPROGRAM " &
-                       "CALL WHEN THE CONVERTED FORMAL PARAMETER IS " &
-                       "OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S " &
-                       "SUBTYPE");
- 
- 
-      DECLARE
-           A0 : INTEGER := -9;
-           A1 : INTEGER := IDENT_INT(-1);
-           TYPE SUBINT IS RANGE -8 .. -2;
- 
-           TYPE FLOAT_TYPE IS DIGITS 3 RANGE 0.0 .. 3.0;
-           A2 : FLOAT_TYPE := 0.12;
-           A3 : FLOAT_TYPE := 2.5;
-           TYPE NEW_FLOAT IS DIGITS 3 RANGE 1.0 .. 2.0;
- 
-           TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
-           A4 : FIXED_TYPE := -2.0;
-           A5 : FIXED_TYPE := 4.0;
-           TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
- 
-           A6 : CHARACTER := 'A';
-           SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
- 
-           TYPE COLOR IS (RED, BURGUNDY, LILAC, MAROON, MAGENTA);
-           SUBTYPE A_COLOR IS COLOR RANGE RED..LILAC;
-           SUBTYPE B_COLOR IS COLOR RANGE MAROON..MAGENTA;
-           A7 : B_COLOR := MAROON;
- 
-           PROCEDURE P1 (X : IN OUT SUBINT;
-                         S :        STRING) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (A" &
-                        S & ")");
-           END P1;
- 
-           PROCEDURE P2 (X : IN OUT NEW_FLOAT;
-                         S :        STRING)     IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A" &
-                        S & ")");
-           END P2;
- 
-           PROCEDURE P3 (X : IN OUT NEW_FIXED;
-                         S :        STRING)     IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P3 (A" &
-                        S & ")");
-           END P3;
- 
-           PROCEDURE P4 (X : IN OUT SUPER_CHAR;
-                         S :        STRING)     IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P4 (A" &
-                         S & ")");
-           END P4;
- 
-           PROCEDURE P5 (X : IN OUT A_COLOR;
-                         S :        STRING) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P5 (A" &
-                        S & ")");
-           END P5;
-      BEGIN
-           BEGIN
-                P1 (SUBINT (A0), "1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (A1)");
-           END;
- 
-           BEGIN
-                P1 (SUBINT (A1), "2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (A2)");
-           END;
- 
-           BEGIN
-                P2 (NEW_FLOAT (A2), "1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P2 (A1)");
-           END;
- 
-           BEGIN
-                P2 (NEW_FLOAT (A3), "2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P2 (A2)");
-           END;
- 
-           BEGIN
-                P3 (NEW_FIXED (A4), "1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P3 (A1)");
-           END;
- 
-           BEGIN
-                P3 (NEW_FIXED (A5), "2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P3 (A2)");
-           END;
- 
-           BEGIN
-                P4 (SUPER_CHAR (A6),"1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P4 (A1)");
-           END;
- 
-           BEGIN
-                P5 (A_COLOR (A7), "1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P5 (A1)");
-           END;
-      END;
- 
- 
-      DECLARE
-           CALLED : BOOLEAN;
-           TYPE SUBINT IS RANGE -8 .. -2;
-           A0 : SUBINT := -3;
-           A1 : INTEGER := -9;
-           A2 : INTEGER := -1;
- 
-           TYPE FLOAT IS DIGITS 3 RANGE -1.0 .. 2.0;
-           TYPE A_FLOAT IS DIGITS 3 RANGE 0.0 .. 1.0;
-           A3 : A_FLOAT := 1.0;
-           A4 : FLOAT := -0.5;
-           A5 : FLOAT := 1.5;
- 
-           TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
-           A6 : NEW_FIXED := 0.0;
-           TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
-           A7 : FIXED_TYPE := -2.0;
-           A8 : FIXED_TYPE := 4.0;
- 
-           SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
-           A9  : SUPER_CHAR := 'C';
-           A10 : CHARACTER := 'A';
-           A11 : CHARACTER := 'R';
- 
-           PROCEDURE P1 (X : IN OUT INTEGER; Y : INTEGER) IS
-           BEGIN
-                CALLED := TRUE;
-                X := IDENT_INT (Y);
-           END P1;
- 
-           PROCEDURE P2 (X : IN OUT FLOAT; Y : FLOAT) IS
-           BEGIN
-                CALLED := TRUE;
-                X := Y;
-           END P2;
- 
-           PROCEDURE P3 ( X : IN OUT FIXED_TYPE; Y : FIXED_TYPE) IS
-           BEGIN
-                CALLED := TRUE;
-                X := Y;
-           END P3;
- 
-           PROCEDURE P4 (X : IN OUT CHARACTER; Y : CHARACTER) IS
-           BEGIN
-                CALLED := TRUE;
-                X := IDENT_CHAR(Y);
-           END P4;
-      BEGIN
-           BEGIN
-                CALLED := FALSE;
-                P1 (INTEGER(A0), A1);
-                IF A0 = -3 THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P1 (B1)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
-           END;
- 
-           BEGIN
-                CALLED := FALSE;
-                P1 (INTEGER(A0), A2);
-                IF A0 = -3 THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B3)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B4)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P1 (B2)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
-           END;
- 
-           BEGIN
-                CALLED := FALSE;
-                P2 (FLOAT (A3), A4);
-                IF A3 = 1.0 THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P2 (B1)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P2 (B1)");
-           END;
- 
-           BEGIN
-                CALLED := FALSE;
-                P2 (FLOAT (A3), A5);
-                IF A3 = 1.0 THEN
-                     FAILED ("EXCEPTION NOT RAISED -P2 (B3)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED -P2 (B4)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P2 (B2)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P2 (B2)");
-           END;
- 
-           BEGIN
-                CALLED := FALSE;
-                P3 (FIXED_TYPE (A6), A7);
-                IF A6 = 0.0 THEN
-                     FAILED ("EXCEPTION NOT RAISED -P3 (B1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED -P3 (B2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P3 (B1)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P3 (B1)");
-           END;
- 
-           BEGIN
-                CALLED := FALSE;
-                P3 (FIXED_TYPE (A6), A8);
-                IF A6 = 0.0 THEN
-                     FAILED ("EXCEPTION NOT RAISED -P3 (B3)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED -P3 (B4)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P3 (B2)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P3 (B2)");
-           END;
- 
-           BEGIN
-                CALLED := FALSE;
-                P4 (CHARACTER (A9), A10);
-                IF A9 = 'C' THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P4 (B1)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P4 (B1)");
-           END;
- 
-           BEGIN
-                CALLED := FALSE;
-                P4 (CHARACTER (A9), A11);
-                IF A9 = 'C' THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B3)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B4)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P4 (B2)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P4 (B2)");
-           END;
-      END;
- 
-      RESULT;
- END C64103B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,230 ****
- -- C64103C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
- -- ON IN OUT ARRAY PARAMETERS.  IN PARTICULAR:
- --   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
- --       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
- --       CONSTRAINTS.
- --   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
- --       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
- --       OUTSIDE OF A FORMAL INDEX SUBTYPE FOR A NON-NULL DIMENSION (SEE
- --       AI-00313 FOR MULTIDIMENSIONAL CASE)
- --   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
- --       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
- --       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
- --   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
- --       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
- --       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- CPP 07/19/84
- -- JBG 06/05/85
- -- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387.
- -- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- PROCEDURE C64103C IS
- 
-      BEGIN
-      TEST ("C64103C", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
-            "TYPE CONVERSIONS OF IN OUT ARRAY PARAMETERS");
- 
-      -----------------------------------------------
- 
-      DECLARE   -- (A)
-      BEGIN     -- (A)
- 
-           DECLARE
-                TYPE SUBINT IS RANGE 0..8;
-                TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
-                A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
- 
-                PROCEDURE P2 (X : IN OUT ARRAY_TYPE) IS
-                BEGIN
-                     NULL;
-                END P2;
-           BEGIN
-                P2 (ARRAY_TYPE (A0));                  -- OK.
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED -P2 (A)");
-           END;
- 
-      END; -- (A)
- 
-      -----------------------------------------------
- 
-      DECLARE   -- (B1) NON-NULL ACTUAL PARAMETER
- 
-           TYPE SUBINT IS RANGE 0..8;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
-           TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-           A1 : AR1 (-1..7) := (-1..7 => TRUE);
-           A2 : AR1 (1..9) := (1..9 => TRUE);
- 
-           PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
-           END P1;
- 
-      BEGIN     -- (B1)
- 
-           BEGIN
-                COMMENT ("CALL TO P1 (B1) ON A1");
-                P1 (ARRAY_TYPE (A1));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
-           END;
- 
-           BEGIN
-                COMMENT ("CALL TO P1 (B1) ON A2");
-                P1 (ARRAY_TYPE (A2));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
-           END;
- 
-      END; -- (B1)
- 
-      DECLARE   -- (B2) NULL ACTUAL PARAMETER; MULTIDIMENSIONAL
- 
-           TYPE SUBINT IS RANGE 0..8;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>,
-                                     SUBINT RANGE <>) OF BOOLEAN;
-           TYPE AR1 IS ARRAY (INTEGER RANGE <>,
-                              INTEGER RANGE <>)OF BOOLEAN;
-           A1 : AR1 (IDENT_INT(-1)..7, 5..4) :=
-                                            (OTHERS => (OTHERS => TRUE));
-           A2 : AR1 (5..4, 1..IDENT_INT(9)) :=
-                                            (OTHERS => (OTHERS => TRUE));
-           PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
-           END P1;
- 
-      BEGIN     -- (B2)
- 
-           BEGIN
-                COMMENT ("CALL TO P1 (B2) ON A1");
-                P1 (ARRAY_TYPE (A1));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
-           END;
- 
-           BEGIN
-                COMMENT ("CALL TO P1 (B2) ON A2");
-                P1 (ARRAY_TYPE (A2));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
-           END;
- 
-      END; -- (B2)
- 
-      -----------------------------------------------
- 
-      BEGIN     -- (C)
- 
-           DECLARE
-                TYPE INDEX1 IS RANGE 1..3;
-                TYPE INDEX2 IS RANGE 1..4;
-                TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
-                A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
- 
-                TYPE I1 IS RANGE 1..4;
-                TYPE I2 IS RANGE 1..3;
-                TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
- 
-                PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
-                BEGIN
-                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
-                END P1;
-           BEGIN
-                P1 (ARRAY_TYPE (A0));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
-           END;
- 
-      END; -- (C)
- 
-      -----------------------------------------------
- 
-      DECLARE   -- (D)
-      BEGIN     -- (D)
- 
-           DECLARE
-                TYPE SM_INT IS RANGE 0..2;
-                TYPE LG IS RANGE 0 .. SYSTEM.MAX_INT;
-                SUBTYPE LG_INT IS LG RANGE SYSTEM.MAX_INT - 3 ..
-                                           SYSTEM.MAX_INT;
-                TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
-                TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
-                A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
-                     (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
- 
-                PROCEDURE P1 (X : IN OUT AR_SMALL) IS
-                BEGIN
-                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
-                END P1;
-           BEGIN
-                IF LG (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
-                     P1 (AR_SMALL (A0));
-                ELSE
-                     COMMENT ("NOT APPLICABLE -P1 (D)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
-           END;
- 
-      END; -- (D)
- 
-      -----------------------------------------------
- 
-      RESULT;
- 
- END C64103C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,187 ****
- -- C64103D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
- -- ON OUT ARRAY PARAMETERS.  IN PARTICULAR:
- --   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
- --       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
- --       CONSTRAINTS.
- --   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
- --       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
- --       OUTSIDE OF A FORMAL INDEX SUBTYPE.
- --   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
- --       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
- --       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
- --   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
- --       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
- --       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- CPP 07/19/84
- -- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387.
- -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- PROCEDURE C64103D IS
- 
-      BEGIN
-      TEST ("C64103D", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
-            "TYPE CONVERSIONS OF OUT ARRAY PARAMETERS");
- 
-      -----------------------------------------------
- 
-      DECLARE   -- (A)
-      BEGIN     -- (A)
- 
-           DECLARE
-                TYPE SUBINT IS RANGE 0..8;
-                TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
-                A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
- 
-                PROCEDURE P2 (X : OUT ARRAY_TYPE) IS
-                BEGIN
-                     NULL;
-                END P2;
-           BEGIN
-                P2 (ARRAY_TYPE (A0));                  -- OK.
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED -P2 (A)");
-           END;
- 
-      END; -- (A)
- 
-      -----------------------------------------------
- 
-      DECLARE   -- (B)
- 
-           TYPE SUBINT IS RANGE 0..8;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
-           TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-           A1 : AR1 (-1..7) := (-1..7 => TRUE);
-           A2 : AR1 (1..9) := (1..9 => TRUE);
- 
-           PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
-           END P1;
- 
-      BEGIN     -- (B)
- 
-           BEGIN
-                COMMENT ("CALL TO P1 (B) ON A1");
-                P1 (ARRAY_TYPE (A1));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
-           END;
- 
-           BEGIN
-                COMMENT ("CALL TO P1 (B) ON A2");
-                P1 (ARRAY_TYPE (A2));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
-           END;
- 
-      END; -- (B)
- 
-      -----------------------------------------------
- 
-      DECLARE   -- (C)
-      BEGIN     -- (C)
- 
-           DECLARE
-                TYPE INDEX1 IS RANGE 1..3;
-                TYPE INDEX2 IS RANGE 1..4;
-                TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
-                A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
- 
-                TYPE I1 IS RANGE 1..4;
-                TYPE I2 IS RANGE 1..3;
-                TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
- 
-                PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
-                BEGIN
-                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
-                END P1;
-           BEGIN
-                P1 (ARRAY_TYPE (A0));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
-           END;
- 
-      END; -- (C)
- 
-      -----------------------------------------------
- 
-      DECLARE   -- (D)
-      BEGIN     -- (D)
- 
-           DECLARE
-                TYPE SM_INT IS RANGE 0..2;
-                TYPE LG_INT IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
-                TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
-                TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
-                A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
-                     (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
- 
-                PROCEDURE P1 (X : OUT AR_SMALL) IS
-                BEGIN
-                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
-                END P1;
-           BEGIN
-                IF LG_INT (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
-                     P1 (AR_SMALL (A0));
-                ELSE
-                     COMMENT ("NOT APPLICABLE -P1 (D)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
-           END;
- 
-      END; -- (D)
- 
-      -----------------------------------------------
- 
-      RESULT;
- 
- END C64103D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,219 ****
- -- C64103E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR IN-OUT PARAMETERS OF AN ACCESS TYPE,
- --     CONSTRAINT_ERROR IS RAISED:
- --          BEFORE A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
- --          OF THE ACTUAL DESIGNATED PARAMETER ARE DIFFERENT FROM
- --          THOSE OF THE FORMAL DESIGNATED PARAMETER;
- --          AFTER A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
- --          OF THE FORMAL DESIGNATED PARAMETER ARE DIFFERENT FROM
- --          THOSE OF THE ACTUAL DESIGNATED PARAMETER.
- 
- -- HISTORY:
- --     CPP  07/23/84  CREATED ORIGINAL TEST.
- --     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
- --                    REFERENCED THE ACTUAL PARAMETERS IN THE SECOND
- --                    SUBTEST.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64103E IS
- BEGIN
-      TEST ("C64103E", "FOR IN-OUT PARAMETERS OF AN ACCESS TYPE, " &
-                       "CONSTRAINT_ERROR IS RAISED:  BEFORE A " &
-                       "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
-                       "DISCRIMINANTS OF THE ACTUAL DESIGNATED " &
-                       "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
-                       "FORMAL DESIGNATED PARAMETER;  AFTER A " &
-                       "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
-                       "DISCRIMINANTS OF THE FORMAL DESIGNATED " &
-                       "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
-                       "ACTUAL DESIGNATED PARAMETER");
- 
- 
-      BEGIN
-           DECLARE
-                TYPE AST IS ACCESS STRING;
-                SUBTYPE AST_3 IS AST(1..3);
-                SUBTYPE AST_5 IS AST(3..5);
-                X_3 : AST_3 := NEW STRING(1..IDENT_INT(3));
- 
-                PROCEDURE P1 (X : IN OUT AST_5) IS
-                BEGIN
-                     FAILED("EXCEPTION NOT RAISED BEFORE CALL -P1 (A)");
-                END P1;
-           BEGIN
-                P1 (AST_5 (X_3));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (A)");
-           END;
- 
-           DECLARE
-                TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-                TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
-                SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
-                TYPE A2_ARRAY IS NEW A_ARRAY (2..4);
-                A0 : A1_ARRAY := NEW ARRAY_TYPE (1..3);
- 
-                PROCEDURE P2 (X : IN OUT A2_ARRAY) IS
-                BEGIN
-                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A)");
-                END P2;
-           BEGIN
-                P2 (A2_ARRAY (A0));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P2 (A)");
-           END;
- 
-           DECLARE
-                TYPE SUBINT IS RANGE 0..8;
-                TYPE REC1 (DISC : SUBINT := 8) IS
-                     RECORD
-                          FIELD : SUBINT := DISC;
-                     END RECORD;
-                TYPE A1_REC IS ACCESS REC1;
-                TYPE A2_REC IS NEW A1_REC(3);
-                A0 : A1_REC := NEW REC1(4);
- 
-                PROCEDURE P3 (X : IN OUT A2_REC) IS
-                BEGIN
-                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL " &
-                             "-P3 (A)");
-                END P3;
- 
-           BEGIN
-                P3 (A2_REC (A0));
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P3 (A)");
-           END;
- 
-      END;
- 
- 
-      BEGIN
-           DECLARE
-                TYPE AST IS ACCESS STRING;
-                SUBTYPE AST_3 IS AST(IDENT_INT(1)..IDENT_INT(3));
-                X_3 : AST_3 := NEW STRING'(1..IDENT_INT(3) => 'A');
-                CALLED : BOOLEAN := FALSE;
- 
-                PROCEDURE P1 (X : IN OUT AST) IS
-                BEGIN
-                     CALLED := TRUE;
-                     X := NEW STRING'(3..5 => 'C');
-                END P1;
-           BEGIN
-                P1 (AST (X_3));
-                IF X_3.ALL = STRING'(1 .. 3 => 'A') THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL" &
-                                  "-P1 (B)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
-           END;
- 
-           DECLARE
-                TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-                TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
-                SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
-                A0 : A1_ARRAY := NEW ARRAY_TYPE'(1..3 => TRUE);
-                CALLED : BOOLEAN := FALSE;
- 
-                PROCEDURE P2 (X : IN OUT A_ARRAY) IS
-                BEGIN
-                     CALLED := TRUE;
-                     X := NEW ARRAY_TYPE'(2..4 => FALSE);
-                END P2;
-           BEGIN
-                P2 (A_ARRAY (A0));
-                IF A0.ALL = ARRAY_TYPE'(1 .. 3 => TRUE) THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL" &
-                                  "-P1 (B)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P2 (B)");
-           END;
- 
-           DECLARE
-                TYPE SUBINT IS RANGE 0..8;
-                TYPE REC1 (DISC : SUBINT := 8) IS
-                     RECORD
-                          FIELD : SUBINT := DISC;
-                     END RECORD;
-                TYPE A1_REC IS ACCESS REC1;
-                TYPE A2_REC IS NEW A1_REC;
-                A0 : A1_REC(4) := NEW REC1(4);
-                CALLED : BOOLEAN := FALSE;
- 
-                PROCEDURE P3 (X : IN OUT A2_REC) IS
-                BEGIN
-                     CALLED := TRUE;
-                     X := NEW REC1;
-                END P3;
- 
-           BEGIN
-                P3 (A2_REC (A0));
-                IF A0.ALL = REC1'(4,4) THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (B1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (B2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL" &
-                                  "-P1 (B)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P3 (B)");
-           END;
- 
-      END;
- 
-      RESULT;
- END C64103E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64103f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64103f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- C64103F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR OUT PARAMETERS OF AN ACCESS TYPE,
- --     CONSTRAINT_ERROR IS RAISED:
- --          AFTER A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
- --          OF THE FORMAL DESIGNATED PARAMETER ARE DIFFERENT FROM
- --          THOSE OF THE ACTUAL DESIGNATED PARAMETER.
- 
- -- HISTORY:
- --     CPP  07/23/84  CREATED ORIGINAL TEST.
- --     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
- --                    REFERENCE THE ACTUAL PARAMETERS.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64103F IS
- BEGIN
-      TEST ("C64103F", "FOR OUT PARAMETERS OF AN ACCESS TYPE, " &
-                       "CONSTRAINT_ERROR IS RAISED:  AFTER A " &
-                       "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
-                       "DISCRIMINANTS OF THE FORMAL DESIGNATED " &
-                       "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
-                       "ACTUAL DESIGNATED PARAMETER");
- 
- 
-      BEGIN
-           DECLARE
-                TYPE AST IS ACCESS STRING;
-                SUBTYPE AST_3 IS AST(IDENT_INT(1)..IDENT_INT(3));
-                SUBTYPE AST_5 IS AST(3..5);
-                X_3 : AST_3 := NEW STRING'(1..IDENT_INT(3) => 'A');
-                CALLED : BOOLEAN := FALSE;
- 
-                PROCEDURE P1 (X : OUT AST_5) IS
-                BEGIN
-                     CALLED := TRUE;
-                     X := NEW STRING'(3..5 => 'C');
-                END P1;
-           BEGIN
-                P1 (AST_5 (X_3));
-                IF X_3.ALL = STRING'(1 .. 3 => 'A') THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (A1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (A2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P1 (A)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P1 (A)");
-           END;
- 
-           DECLARE
-                TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-                TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
-                SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
-                TYPE A2_ARRAY IS NEW A_ARRAY (2..4);
-                A0 : A1_ARRAY := NEW ARRAY_TYPE'(1..3 => TRUE);
-                CALLED : BOOLEAN := FALSE;
- 
-                PROCEDURE P2 (X : OUT A2_ARRAY) IS
-                BEGIN
-                     CALLED := TRUE;
-                     X := NEW ARRAY_TYPE'(2..4 => FALSE);
-                END P2;
-           BEGIN
-                P2 (A2_ARRAY (A0));
-                IF A0.ALL = ARRAY_TYPE'(1 .. 3 => TRUE) THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (A1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (A2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P1 (A)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P2 (A)");
-           END;
- 
-           DECLARE
-                TYPE SUBINT IS RANGE 0..8;
-                TYPE REC1 (DISC : SUBINT := 8) IS
-                     RECORD
-                          FIELD : SUBINT := DISC;
-                     END RECORD;
-                TYPE A1_REC IS ACCESS REC1;
-                TYPE A2_REC IS NEW A1_REC (3);
-                A0 : A1_REC(4) := NEW REC1(4);
-                CALLED : BOOLEAN := FALSE;
- 
-                PROCEDURE P3 (X : OUT A2_REC) IS
-                BEGIN
-                     CALLED := TRUE;
-                     X := NEW REC1(3);
-                END P3;
- 
-           BEGIN
-                P3 (A2_REC (A0));
-                IF A0.ALL = REC1'(4,4) THEN
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (A1)");
-                ELSE
-                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (A2)");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                                  "-P1 (A)");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED -P3 (A)");
-           END;
-      END;
- 
-      RESULT;
- END C64103F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- C64104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT CONSTRAINT_ERROR IS RAISED FOR OUT OF RANGE SCALAR
- --      ARGUMENTS.  SUBTESTS ARE:
- --           (A) STATIC IN ARGUMENT.
- --           (B) DYNAMIC IN ARGUMENT.
- --           (C) IN OUT, OUT OF RANGE ON CALL.
- --           (D) OUT, OUT OF RANGE ON RETURN.
- --           (E) IN OUT, OUT OF RANGE ON RETURN.
- 
- -- HISTORY:
- --    DAS  01/14/81
- --    CPP  07/03/84
- --    LB   11/20/86  ADDED CODE TO ENSURE IN SUBTESTS WHICH CHECK
- --                     RETURNED VALUES, THAT SUBPROGRAMS ARE ACTUALLY
- --                     CALLED.
- --    JET  08/04/87  FIXED HEADER FOR STANDARD FORMAT.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64104A IS
- 
-      SUBTYPE DIGIT IS INTEGER RANGE 0..9;
- 
-      CALLED : BOOLEAN;
-      D    : DIGIT;
-      I    : INTEGER;
-      M1 : CONSTANT INTEGER := IDENT_INT(-1);
-      COUNT     : INTEGER := 0;
-      SUBTYPE SI IS INTEGER RANGE M1 .. 10;
- 
-      PROCEDURE P1 (PIN : IN DIGIT; WHO : STRING) IS         -- (A), (B)
-      BEGIN
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P1 " & WHO);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN P1 FOR " & WHO);
-      END P1;
- 
-      PROCEDURE P2 (PINOUT : IN OUT DIGIT; WHO : STRING) IS  -- (C)
-      BEGIN
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P2 " & WHO);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN P2 FOR " & WHO);
-      END P2;
- 
-      PROCEDURE P3 (POUT : OUT SI; WHO : STRING) IS          -- (D)
-      BEGIN
-           IF WHO = "10" THEN
-                POUT := IDENT_INT(10);    -- (10 IS NOT A DIGIT)
-           ELSE
-                POUT := -1;
-           END IF;
-           CALLED := TRUE;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN P3 FOR " & WHO);
-      END P3;
- 
-      PROCEDURE P4 (PINOUT : IN OUT INTEGER; WHO : STRING) IS     -- (E)
-      BEGIN
-           IF WHO = "10" THEN
-                PINOUT := 10;       -- (10 IS NOT A DIGIT)
-           ELSE
-                PINOUT := IDENT_INT(-1);
-           END IF;
-           CALLED := TRUE;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN P4 FOR" & WHO);
-      END P4;
- 
- BEGIN
- 
-      TEST ("C64104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "FOR OUT OF RANGE SCALAR ARGUMENTS");
- 
-      BEGIN  -- (A)
-           P1 (10, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P1 (10)");
-      END;  -- (A)
- 
-      BEGIN  -- (B)
-           P1 (IDENT_INT (-1), "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (" &
-                   "IDENT_INT (-1))");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P1 (" &
-                        "IDENT_INT (-1))");
-      END;  --(B)
- 
-      BEGIN  -- (C)
-           I := IDENT_INT (10);
-           P2 (I, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P2 (10)");
-      END;  -- (C)
- 
-      BEGIN -- (C1)
-           I := IDENT_INT (-1);
-           P2 (I, "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P2 (-1)");
-      END; -- (C1)
- 
-      BEGIN  -- (D)
-           CALLED := FALSE;
-           D := IDENT_INT (1);
-           P3 (D, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
-                   " P3 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P3 (10)");
-      END;  -- (D)
- 
-      BEGIN -- (D1)
-           CALLED := FALSE;
-           D := IDENT_INT (1);
-           P3 (D, "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
-                   " P3 (-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P3 (-1)");
-      END; -- (D1)
- 
-      BEGIN  -- (E)
-           CALLED := FALSE;
-           D := 9;
-           P4 (D, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
-                   " P4 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P4 (10)");
-      END;  -- (E)
- 
-      BEGIN -- (E1)
-           CALLED := FALSE;
-           D := 0;
-           P4 (D, "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
-                   " P4 (-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR P4 (-1)");
-      END; -- (E1)
- 
-      IF (COUNT /= 8) THEN
-           FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
-      END IF;
- 
-      RESULT;
- 
- END C64104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C64104B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER APPROPRIATE CIRCUMSTANCES
- --    WITH RESPECT TO PARAMETERS OF RECORD TYPES.  SUBTESTS INVOLVE 
- --    ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT EQUAL 
- --    TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
- --        (A) IN PARAMETER, STATIC AGGREGATE.
- --        (B) IN PARAMETER, DYNAMIC AGGREGATE.
- --        (C) IN PARAMETER, VARIABLE.
- --        (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
- --        (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
- 
- -- DAS 2/11/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64104B IS
- 
-      USE REPORT;
-      SUBTYPE INT IS INTEGER RANGE 0..10;
-      TYPE REC (N : INT := 0) IS
-           RECORD
-                A : STRING (1..N);
-           END RECORD;
-      SUBTYPE SREC IS REC(N=>3);
-      PROCEDURE P1 (R : IN SREC) IS
-      BEGIN
-           FAILED ("EXCEPTION NOT RAISED ON CALL TO P1");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
-      END P1;
- 
-      PROCEDURE P2 (R : IN OUT SREC) IS
-      BEGIN
-           FAILED ("EXCEPTION NOT RAISED ON CALL TO P2");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
-      END P2;
- 
-      PROCEDURE P3 (R : OUT SREC) IS
-      BEGIN
-           FAILED ("EXCEPTION NOT RAISED ON CALL TO P3");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
-      END P3;
- 
- BEGIN
- 
-      TEST ("C64104B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
-                       "PARAMETERS OF RECORD TYPES");
- 
-      BEGIN     -- (A)
-           P1 ((2,"AA"));
-           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
-      END; -- (A)
- 
-      BEGIN     -- (B)
-           P1 ((IDENT_INT(2), "AA"));
-           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
-      END; -- (B)
- 
-      DECLARE   -- (C)
-           R : REC     := (IDENT_INT(2), "AA");
-      BEGIN     -- (C)
-           P1 (R);
-           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
-      END; -- (C)
- 
-      DECLARE   -- (D)
-           R : REC     := (IDENT_INT(2), "AA");
-      BEGIN     -- (D)
-           P2 (R);
-           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
-      END; -- (D)
- 
- 
-      DECLARE   -- (E)
-           R  : REC;
-      BEGIN     -- (E)
-           P3 (R);
-           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
-      END; -- (E)
- 
-      RESULT;
- 
- END C64104B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,200 ****
- -- C64104C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE
- --   APPROPRIATE CIRCUMSTANCES FOR ARRAY PARAMETERS, NAMELY
- --   WHEN THE ACTUAL BOUNDS DON'T MATCH THE FORMAL BOUNDS
- --   (BEFORE THE CALL FOR ALL MODES).
- --   SUBTESTS ARE:
- --      (A) IN MODE, ONE DIMENSION, STATIC AGGREGATE.
- --      (B) IN MODE, TWO DIMENSIONS, DYNAMIC AGGREGATE.
- --      (C) IN MODE, TWO DIMENSIONS, DYNAMIC VARIABLE.
- --      (D) IN OUT MODE, THREE DIMENSIONS, STATIC VARIABLE.
- --      (E) OUT MODE, ONE DIMENSION, DYNAMIC VARIABLE.
- --      (F) IN OUT MODE, NULL STRING AGGREGATE.
- --      (G) IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE (OK CASE).
- --          IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE.
- 
- -- JRK 3/17/81
- -- SPS 10/26/82
- -- CPP 8/6/84
- -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
- 
- WITH REPORT;
- PROCEDURE C64104C IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-            "ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
-           SUBTYPE ST IS STRING (1..3);
- 
-           PROCEDURE P (A : ST) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (A)");
-           END P;
- 
-      BEGIN -- (A)
- 
-           P ("AB");
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (A)");
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           SUBTYPE S IS INTEGER RANGE 1..3;
-           TYPE T IS ARRAY (S,S) OF INTEGER;
- 
-           PROCEDURE P (A : T) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (B)");
-           END P;
- 
-      BEGIN -- (B)
- 
-           P ((1..3 => (1..IDENT_INT(2) => 0)));
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (B)");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE S IS INTEGER RANGE 1..5;
-           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
-           SUBTYPE ST IS T (1..3,1..3);
-           V : T (1..IDENT_INT(2), 1..3) :=
-                 (1..IDENT_INT(2) => (1..3 => 0));
- 
-           PROCEDURE P (A :ST) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
-           END P;
- 
-      BEGIN -- (C)
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (C)");
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           SUBTYPE S IS INTEGER RANGE 1..5;
-           TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
-                     INTEGER;
-           SUBTYPE ST IS T (1..3, 1..3, 1..3);
-           V : T (1..3, 1..2, 1..3) :=
-                 (1..3 => (1..2 => (1..3 => 0)));
- 
-           PROCEDURE P (A : IN OUT ST) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALLL - (D)");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
-           END P;
- 
-      BEGIN -- (D)
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (D)");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
- 
-      DECLARE -- (G)
- 
-           SUBTYPE S IS INTEGER RANGE 1..5;
-           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
-           SUBTYPE ST IS T (2..1, 2..1);
-           V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
- 
-           PROCEDURE P (A : IN OUT ST) IS
-           BEGIN
-                COMMENT ("OK CASE CALLED CORRECTLY");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (G)");
-           END P;
- 
-      BEGIN -- (G)
- 
-           P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
-      END; -- (G)
- 
-      --------------------------------------------------
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C64104C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C64104D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
- --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (A) BEFORE CALL, IN MODE, STATIC PRIVATE DISCRIMINANT.
- 
- -- JRK 3/18/81
- -- NL 10/13/81
- -- ABW 6/11/82
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64104D IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104D", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2, E3);
-                TYPE T (D : E := E1) IS PRIVATE;
-                TYPE AR IS ARRAY (E1 .. E3) OF INTEGER;
-           PRIVATE
-                TYPE T (D : E := E1) IS
-                     RECORD
-                          I : INTEGER;
-                          A : AR;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE A1 IS A(E3);
-           V : A (E2) := NEW T (E2);
- 
-           PROCEDURE P (X : A1) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALL");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      ------------------------------------------------
- 
-      RESULT;
- 
- END C64104D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C64104E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
- --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (B) BEFORE CALL, IN MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
- 
- -- JRK 3/18/81
- -- NL 10/13/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64104E IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104E", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           TYPE T IS ARRAY (BOOLEAN RANGE <>, CHARACTER RANGE <>) OF
-                     INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE A1 IS A(BOOLEAN, 'A'..'C');
-           V : A := NEW T (BOOLEAN, 'A'..IDENT_CHAR('B'));
- 
-           PROCEDURE P (X : A1) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALL");
-           EXCEPTION
-               WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                 FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C64104F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
- --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (C) BEFORE CALL, IN OUT MODE, STATIC ONE DIMENSIONAL BOUNDS.
- 
- -- JRK 3/18/81
- -- NL 10/13/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64104F IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104F", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           TYPE A IS ACCESS STRING;
-           SUBTYPE A1 IS A(1..3);
-           V : A (2..4) := NEW STRING (2..4);
- 
-           PROCEDURE P (X : IN OUT A1) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALL");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C64104G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
- --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (D) BEFORE CALL, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
- 
- -- JRK 3/18/81
- -- NL 10/13/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64104G IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104G", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
-           SUBTYPE INT IS INTEGER RANGE 0..10;
-           TYPE T (C : CHARACTER := 'A';
-                   B : BOOLEAN := FALSE;
-                   I : INT := 0
-                  ) IS
-                RECORD
-                     J : INTEGER;
-                     CASE B IS
-                          WHEN FALSE =>
-                               K : INTEGER;
-                          WHEN TRUE =>
-                               S : STRING (1 .. I);
-                     END CASE;
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A ('Z', TRUE, 5);
-           V : A := NEW T ('Z', IDENT_BOOL(FALSE), 5);
- 
-           PROCEDURE P (X : IN OUT SA ) IS
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED ON CALL");
-           EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C64104H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --         (E) AFTER RETURN, IN OUT MODE, STATIC LIMITED PRIVATE
- --             DISCRIMINANTS.
- 
- -- HISTORY:
- --     JRK 03/18/81  CREATED ORIGINAL TEST.
- --     NL  10/13/81
- --     LB  11/25/86  ADDED CODE TO ENSURE THAT SUBPROGRAMS ARE
- --                   ACTUALLY BEING CALLED.
- --     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.
- 
- 
- WITH REPORT;
- PROCEDURE C64104H IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104H", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                SUBTYPE INT IS INTEGER RANGE 0..10;
-                SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'C';
-                TYPE T (I : INT := 0; C : CHAR := 'A') IS
-                     LIMITED PRIVATE;
-           PRIVATE
-                TYPE T (I : INT := 0; C : CHAR := 'A') IS
-                     RECORD
-                          J : INTEGER;
-                          CASE C IS
-                               WHEN 'A' =>
-                                    K : INTEGER;
-                               WHEN 'B' =>
-                                    S : STRING (1..I);
-                               WHEN OTHERS =>
-                                    NULL;
-                          END CASE;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           CALLED : BOOLEAN;
-           TYPE A IS ACCESS T;
- 
-           V : A (2,'B') := NEW T (2,'B');
- 
-           PROCEDURE P (X : IN OUT A) IS
-           BEGIN
-                CALLED := TRUE;
-                X := NEW T (2,'A');
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           CALLED := FALSE;
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C64104I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --         (F) AFTER RETURN, IN OUT MODE, DYNAMIC THREE DIMENSIONAL
- --             BOUNDS.
- 
- -- HISTORY:
- --     JRK 03/18/81  CREATED ORIGINAL TEST.
- --     NL  10/13/81
- --     LB  11/25/86  ADDED CODE TO ENSURE THAT SUBPROGRAMS ARE
- --                   ACTUALLY BEING CALLED.
- --     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.
- 
- 
- WITH REPORT;
- PROCEDURE C64104I IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104I", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           CALLED : BOOLEAN;
- 
-           TYPE E IS (E1, E2, E3);
- 
-           TYPE T IS ARRAY (CHARACTER RANGE <>,
-                            E RANGE <>,
-                            BOOLEAN RANGE <>
-                           ) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
- 
-           V : A ('A'..'Z', E1..E2, BOOLEAN) :=
-                     NEW T ('A'..'Z', E1..E2, BOOLEAN);
- 
-           PROCEDURE P (X : IN OUT A) IS
-           BEGIN
-                CALLED := TRUE;
-                IF EQUAL (3,3) THEN
-                     X := NEW T ('A'..'Z', E2..E3, BOOLEAN);
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           CALLED := FALSE;
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- C64104J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --         (G) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, STATIC ONE
- --             DIMENSIONAL BOUNDS.
- 
- -- HISTORY:
- --     JRK 03/18/81  CREATED ORIGINAL TEST.
- --     NL  10/13/81
- --     BCB 11/12/87  CHANGED HEADING TO STANDARD FORMAT.  ADDED CODE TO
- --                   ENSURE THAT SUBPROGRAMS ARE ACTUALLY CALLED.
- 
- WITH REPORT;
- PROCEDURE C64104J IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104J", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           TYPE A IS ACCESS STRING;
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           V : A (1..3) := NEW STRING (1..3);
- 
-           PROCEDURE P (X : OUT A) IS
-           BEGIN
-                CALLED := TRUE;
-                X := NEW STRING (2..3);
-           EXCEPTION
-               WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C64104K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --         (H) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, DYNAMIC
- --             RECORD DISCRIMINANT.
- 
- -- HISTORY:
- --     JRK 03/18/81  CREATED ORIGINAL TEST.
- --     NL  10/13/81
- --     SPS 10/26/82
- --     BCB 11/12/87  CHANGED HEADING TO STANDARD FORMAT.  ADDED CODE TO
- --                   ENSURE THAT SUBPROGRAMS ARE ACTUALLY CALLED.
- 
- WITH REPORT;
- PROCEDURE C64104K IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104K", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
-           TYPE ARR IS ARRAY (BOOLEAN RANGE <>) OF INTEGER;
-           TYPE T (B : BOOLEAN := FALSE) IS
-                RECORD
-                     I : INTEGER;
-                     A : ARR (FALSE..B);
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           V : A (IDENT_BOOL(FALSE)) := NEW T (IDENT_BOOL(FALSE));
- 
-           PROCEDURE P (X : OUT A) IS
-           BEGIN
-                CALLED := TRUE;
-                X := NEW T (TRUE);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C64104L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
- --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (I) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, STATIC
- --           PRIVATE DISCRIMINANTS.
- 
- -- JRK 3/18/81
- -- NL 10/13/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64104L IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104L", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2, E3);
-                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
-                     PRIVATE;
-           PRIVATE
-                TYPE ARR IS ARRAY (E RANGE <>) OF INTEGER;
-                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
-                     RECORD
-                          I : INTEGER;
-                          CASE B IS
-                               WHEN FALSE =>
-                                    J : INTEGER;
-                               WHEN TRUE =>
-                                    A : ARR (E1 .. D);
-                          END CASE;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(E2, TRUE);
-           V : A (E2, FALSE) := NEW T (E2, FALSE);
- 
-           ENTERED : BOOLEAN := FALSE;
- 
-           PROCEDURE P (X : OUT SA ) IS
-           BEGIN
-                ENTERED := TRUE;
-                X := NEW T (E2, TRUE);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("CONSTRAINT_ERROR RAISED BEFORE " & 
-                             "CALL");
-                END IF;
-           WHEN OTHERS =>
-                IF NOT ENTERED THEN
-                    FAILED ("OTHER EXCEPTION RAISED BEFORE CALL");
-                ELSE FAILED ("WRONG EXCEPTION RAISED AFTER " & 
-                             "RETURN");
-                END IF;
-      END;
- 
-      ------------------------------------------------
- 
-      RESULT;
- 
- END C64104L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C64104M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
- --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
- --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (J) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, DYNAMIC TWO
- --           DIMENSIONAL BOUNDS.
- 
- -- JRK 3/18/81
- -- NL 10/13/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64104M IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64104M", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-            "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           TYPE T IS ARRAY (INTEGER RANGE <>,
-                            CHARACTER RANGE <>
-                           ) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
- 
-           V : A (1..10, 'A'..'Z') := NEW T (1..10, 'A'..'Z');
- 
-           ENTERED : BOOLEAN := FALSE;
-           Y : CONSTANT CHARACTER := IDENT_CHAR('Y');
-           SUBTYPE SA IS A(1..10, 'A'..Y);
-           PROCEDURE P (X : OUT SA ) IS
-           BEGIN
-                ENTERED := TRUE;
-                X := NEW T (1..10, 'A'..IDENT_CHAR('Y'));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
-           END P;
- 
-      BEGIN
- 
-           P (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("CONSTRAINT_ERROR RAISED BEFORE " & 
-                             "CALL");
-                END IF;
-           WHEN OTHERS =>
-                IF NOT ENTERED THEN
-                     FAILED ("OTHER EXCEPTION RAISED BEFORE CALL");
-                ELSE FAILED ("WRONG EXCEPTION RAISED AFTER " & 
-                             "RETURN");
-                END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64104M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104n.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C64104N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED AT THE PLACE OF THE CALL
- --     FOR THE CASE OF A PRIVATE TYPE IMPLEMENTED AS A SCALAR TYPE
- --     WHERE THE VALUE OF THE FORMAL PARAMETER DOES NOT BELONG TO THE
- --     SUBTYPE OF THE ACTUAL PARAMETER.
- 
- -- HISTORY:
- --     DAVID A. TAFFS
- --     CPP 07/23/84
- --     RDH 04/18/90  REVISED TO CHECK THAT SUBPROGRAM IS ACTUALLY
- --                   CALLED.
- --     THS 09/21/90  REWORDED COMMENT STATING THAT THE TEST DOES NOT
- --                   ACCEPT THE LITERAL INTERPRETATION OF 6.4.1(9).
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C64104N IS
- 
- BEGIN
-      TEST ("C64104N", "CHECK THAT PRIVATE TYPE (SCALAR) RAISES " &
-            "CONSTRAINT_ERROR WHEN ACTUAL AND FORMAL PARAMETER " &
-            "BOUNDS DIFFER");
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           PACKAGE P IS
-                TYPE T IS PRIVATE;
-                DC : CONSTANT T;
- 
-                GENERIC PACKAGE PP IS
-                END PP;
-           PRIVATE
-                TYPE T IS NEW INTEGER;
-                DC : CONSTANT T := -1;
-           END P;
- 
-           PROCEDURE Q (X : IN OUT P.T) IS
-           BEGIN
-                CALLED := TRUE;
-                X := P.DC;
-                IF P. "=" (X, P.DC) THEN
-                     COMMENT("PROCEDURE Q WAS CALLED");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("EXCEPTION RAISED INSIDE SUBPROGRAM");
-           END Q;
- 
-           GENERIC
-                Y : IN OUT P.T;
-           PACKAGE CALL IS
-           END CALL;
- 
-           PACKAGE BODY CALL IS
-           BEGIN
-                Q (Y);
-           END CALL;
- 
- -- NOTE CALL HAS VARIABLE OF A PRIVATE TYPE AS AN OUT PARAMETER.  
- -- THIS TEST DOES NOT ACCEPT THE LITERAL INTERPRETATION OF 6.4.1(9).
- -- REFER TO ADA IMPLEMENTOR'S GUIDE 6.4.1 SEMANTIC RAMIFICATION 19
- -- AND AI-00025 FOR CLARIFICATION AS TO WHY THE LITERAL
- -- INTERPRETATION IS REJECTED.
- 
-           PACKAGE BODY P IS
-                Z : T RANGE 0..1 := 0;
-                PACKAGE BODY PP IS
-                     PACKAGE CALL_Q IS NEW CALL(Z);
-                END PP;
-           END P;
- 
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE CALL_Q_NOW IS NEW P.PP;    -- EXCEPTION
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED("SUBPROGRAM Q WAS NOT CALLED");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED");
-           END;
- 
-           RESULT;
- 
-      END;
- END C64104N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64104o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64104o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C64104O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE
- --    CHECK THAT CONSTRAINT_ERROR IS RAISED AT THE PLACE OF THE CALL
- --    FOR THE CASE OF A PRIVATE TYPE IMPLEMENTED AS AN ACCESS TYPE WHERE
- --    THE ACTUAL BOUNDS OR DISCRIMINANTS OF THE DESIGNATED OBJECT DIFFER
- --    FROM THOSE OF THE FORMAL.
- 
- -- HISTORY
- --    CPP 7/23/84 CREATED ORIGINAL TEST.
- --    DHH 8/31/87 ADDED COMMENT IN PROCEDURE Q SO THAT CODE WILL NOT BE
- --                OPTIMIZED OUT OF EXISTENCE.
- 
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64104O IS
- 
- BEGIN
- 
-      TEST ("C64104O", "CHECK THAT PRIVATE TYPE (ACCESS) RAISES " &
-            "CONSTRAINT_ERROR WHEN ACTUAL AND FORMAL PARAMETER BOUNDS " &
-            "DIFFER");
- 
-      DECLARE
- 
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           PACKAGE P IS
-                TYPE T IS PRIVATE;
-                DC : CONSTANT T;
-                GENERIC PACKAGE PP IS
-                END PP;
-           PRIVATE
-                TYPE T IS ACCESS STRING;
-                DC : CONSTANT T := NEW STRING'("AAA");
-           END P;
- 
-           PROCEDURE Q (X : IN OUT P.T) IS
- 
-           BEGIN
- 
-                CALLED := TRUE;
-                X := P.DC;
-                IF P. "=" (X, P.DC) THEN
-                     COMMENT("PROCEDURE Q WAS CALLED");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED INSIDE SUBPROGRAM");
-           END Q;
- 
-           GENERIC
-                Y : IN OUT P.T;
-           PACKAGE CALL IS
-           END CALL;
- 
-           PACKAGE BODY CALL IS
-           BEGIN
-                Q(Y);
-           END CALL;
- 
-           PACKAGE BODY P IS
-                Z : T(1..5) := NEW STRING'("CCCCC");
-                PACKAGE BODY PP IS
-                     PACKAGE CALL_Q IS NEW CALL(Z);
-                END PP;
-           END P;
- 
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE CALL_Q_NOW IS NEW P.PP;
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("SUBPROGRAM Q WAS NOT CALLED");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END;
- 
-           RESULT;
-      END;
- 
- END C64104O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C64105A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED AT THE TIME OF CALL WHEN 
- --   THE VALUE OF AN ACTUAL OUT SCALAR PARAMETER DOES NOT SATISFY THE 
- --   RANGE CONSTRAINTS OF THE FORMAL PARAMETER.
- 
- -- DAS  1/29/81
- -- CPP  8/6/84
- 
- WITH REPORT;
- PROCEDURE C64105A IS
- 
-      USE REPORT;
- 
-      SUBTYPE SUBINT1 IS INTEGER RANGE -10..10;
-      SUBTYPE SUBINT2 IS INTEGER RANGE -20..20;
- 
-      I10  : SUBINT1 := 10;
-      I20  : SUBINT2 := 20;
- 
-      PROCEDURE P1 (I : OUT SUBINT1) IS
-      BEGIN
-           I := SUBINT1'FIRST;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
-      END P1;
- 
- BEGIN
- 
-      TEST ("C64105A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED" &
-                       " AT THE TIME OF CALL WHEN THE VALUE OF AN" &
-                       " ACTUAL OUT SCALAR PARAMETER DOES NOT" &
-                       " SATISFY THE RANGE CONSTRAINTS OF THE FORMAL" &
-                       " PARAMETER");
- 
-      DECLARE
-      BEGIN
-           P1 (SUBINT1(I20));
-           IF I20 /= IDENT_INT(-10) THEN
-                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 1");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED ON CALL TO P1 - 1");
-      END;
- 
-      DECLARE
-      BEGIN
-           I20 := IDENT_INT(20);
-           P1 (I20);
-           IF I20 /= IDENT_INT(-10) THEN
-                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED ON CALL TO P1 - 2");
-      END;
- 
-      RESULT;
- 
- END C64105A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- C64105B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
- --   IN THE FOLLOWING CIRCUMSTANCES:
- --       (1) BEFORE THE CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS
- --           PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT 
- --           FROM THE FORMAL PARAMETER.
- --       (2)
- --       (3)
- --   SUBTESTS ARE:
- --       (A) CASE 1, IN MODE, STATIC ONE DIMENSIONAL BOUNDS.
- --       (B) CASE 1, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
- --       (C) CASE (A), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
- --       (D) CASE (B), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
- 
- -- JRK 3/20/81
- -- SPS 10/26/82
- -- CPP 8/6/84
- 
- WITH REPORT;
- PROCEDURE C64105B IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64105B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-            "BEFORE THE CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS " &
-            "PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT " &
-            "FROM THE FORMAL PARAMETER" );
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           TYPE E IS (E1, E2, E3, E4);
-           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(E2..E4);
-           V : A (E1..E2) := NULL;
- 
-           PROCEDURE P (X : SA ) IS
-           BEGIN
-                NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (A)");
-           END P;
-      
-      BEGIN -- (A)
- 
-           P (V);
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (A)");
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
-           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
-           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN FALSE =>
-                               J : INTEGER;
-                          WHEN TRUE =>
-                               A : ARR ('A' .. C);
-                     END CASE;
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(TRUE, 'C');
-           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
- 
-           PROCEDURE P (X : IN OUT SA ) IS
-           BEGIN
-                NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (B)");
-           END P;
- 
-      BEGIN -- (B)
- 
-           P (V);
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (B)");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           TYPE E IS (E1, E2, E3, E4);
-           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(E2..E4);
-           V : A (E1..E2) := NULL;
- 
-           PROCEDURE P (X : SA ) IS
-           BEGIN
-                NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
-           END P;
-      
-      BEGIN -- (C)
- 
-           P (SA(V));
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (C)");
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
-           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
-           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN FALSE =>
-                               J : INTEGER;
-                          WHEN TRUE =>
-                               A : ARR ('A' .. C);
-                     END CASE;
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(TRUE, 'C');
-           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
- 
-           PROCEDURE P (X : IN OUT SA ) IS
-           BEGIN
-                NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
-           END P;
- 
-      BEGIN -- (D)
- 
-           P (SA(V));
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (D)");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C64105B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,230 ****
- -- C64105C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
- --   IN THE FOLLOWING CIRCUMSTANCES:
- --       (1)
- --       (2) AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL 
- --           ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS 
- --           DIFFERENT CONSTRAINTS.
- --       (3)
- --   SUBTESTS ARE:
- --       (C) CASE 2, IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
- --       (D) CASE 2, OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
- --       (E) SAME AS (C), WITH TYPE CONVERSION.
- --       (F) SAME AS (D), WITH TYPE CONVERSION.
- 
- -- JRK 3/20/81
- -- SPS 10/26/82
- -- CPP 8/8/84
- 
- WITH REPORT;
- PROCEDURE C64105C IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64105C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-            "AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL " &
-            "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
-            "DIFFERENT CONSTRAINTS" );
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2);
-                TYPE T (D : E := E1) IS PRIVATE;
-           PRIVATE
-                TYPE T (D : E := E1) IS
-                     RECORD
-                          I : INTEGER;
-                          CASE D IS
-                               WHEN E1 =>
-                                    B : BOOLEAN;
-                               WHEN E2 =>
-                                    C : CHARACTER;
-                          END CASE;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(E2);
-           V : A (E1) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           PROCEDURE P (X : IN OUT SA) IS
-           BEGIN
-                ENTERED := TRUE;
-                X := NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
-           END P;
- 
-      BEGIN -- (C)
- 
-           P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (C)");
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
-                     INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
-           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
-                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           PROCEDURE P (X : OUT SA) IS
-           BEGIN
-                ENTERED := TRUE;
-                X := NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
-           END P;
- 
-      BEGIN -- (D)
- 
-           P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (D)");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (E)
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2);
-                TYPE T (D : E := E1) IS PRIVATE;
-           PRIVATE
-                TYPE T (D : E := E1) IS
-                     RECORD
-                          I : INTEGER;
-                          CASE D IS
-                               WHEN E1 =>
-                                    B : BOOLEAN;
-                               WHEN E2 =>
-                                    C : CHARACTER;
-                          END CASE;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(E2);
-           V : A (E1) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           PROCEDURE P (X : IN OUT SA) IS
-           BEGIN
-                ENTERED := TRUE;
-                X := NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
-           END P;
- 
-      BEGIN -- (E)
- 
-           P (SA(V));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (E)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (E)");
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (F)
- 
-           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
-                     INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
-           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
-                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           PROCEDURE P (X : OUT SA) IS
-           BEGIN
-                ENTERED := TRUE;
-                X := NULL;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
-           END P;
- 
-      BEGIN -- (D)
- 
-           P (SA(V));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (F)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (F)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (F)");
-      END; -- (F)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C64105C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64105d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64105d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- C64105D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
- --   IN THE FOLLOWING CIRCUMSTANCES:
- --       (1)
- --       (2)
- --       (3) BEFORE OR AFTER THE CALL, WHEN AN UNCONSTRAINED ACTUAL 
- --           OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE
- --           CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL
- --           PARAMETER.
- --   SUBTESTS ARE:
- --       (G) CASE 3, STATIC LIMITED PRIVATE DISCRIMINANT.
- --       (H) CASE 3, DYNAMIC ONE DIMENSIONAL BOUNDS.
- 
- -- JRK 3/20/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C64105D IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64105D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-            "BEFORE AND AFTER THE CALL, WHEN AN UNCONSTRAINED ACTUAL " &
-            "OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE " &
-            "CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL " &
-            "PARAMETER" );
- 
-      --------------------------------------------------
- 
-      DECLARE -- (G)
- 
-           PACKAGE PKG IS
-                SUBTYPE INT IS INTEGER RANGE 0..5;
-                TYPE T (I : INT := 0) IS LIMITED PRIVATE; 
-           PRIVATE          
-                TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-                TYPE T (I : INT := 0) IS 
-                     RECORD
-                          J : INTEGER;
-                          A : ARR (1..I);
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A(3);
-           V : A := NEW T (2);
-           CALLED : BOOLEAN := FALSE;
- 
-           PROCEDURE P (X : OUT SA) IS
-           BEGIN
-                CALLED := TRUE;
-                X := NEW T (3);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (G)");
-           END P;
- 
-      BEGIN -- (G)
-  
-           P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (G)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (G)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (G)");
-      END; -- (G)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (H)
- 
-           TYPE A IS ACCESS STRING;
-           SUBTYPE SA IS A (1..2);
-           V : A := NEW STRING (IDENT_INT(5) .. IDENT_INT(7));
-           CALLED : BOOLEAN := FALSE;
- 
-           PROCEDURE P (X : OUT SA) IS
-           BEGIN
-                CALLED := TRUE;
-                X := NEW STRING (IDENT_INT(1) .. IDENT_INT(2));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (H)");
-           END P;
- 
-      BEGIN -- (H)
- 
-           P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (H)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (H)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (H)");
-      END; -- (H)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C64105D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,351 ****
- -- C64106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
- --   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
- --   SUBTESTS ARE:
- --        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
- --        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
- --        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
- --        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
- 
- -- DAS  1/15/81
- -- JBG  5/16/83
- -- CPP  5/22/84
- 
- WITH REPORT;
- PROCEDURE C64106A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C64106A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
-                       "UNCONSTRAINED FORMAL PARAMETERS");
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-               SUBTYPE INT IS INTEGER RANGE 0..100;
- 
-               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
- 
-                REC1  : RECTYPE   := (10,10,"0123456789");
-                REC2  : RECTYPE   := (17,7,"C64106A..........");
-                REC3  : RECTYPE   := (1,1,"A");
-                REC4  : RECTYPE;  -- 80
- 
-                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
-                                        REC2 : OUT RECTYPE;
-                                        REC3 : IN OUT RECTYPE);
- 
-                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
-           END PKG;
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
-                                        REC2 : OUT RECTYPE;
-                                        REC3 : IN OUT RECTYPE) IS
-                BEGIN
-                     IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
-                          FAILED ("RECORD TYPE IN PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF ACTUAL");
-                     END IF;
-                     IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
-                          FAILED ("RECORD TYPE OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF ACTUAL");
-                     END IF;
-                     IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
-                          FAILED ("RECORD TYPE IN OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF ACTUAL");
-                     END IF;
-                     REC2 := PKG.REC2;
-                END CHK_RECTYPE1;
- 
-                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
-                BEGIN
-                     IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
-                          FAILED ("RECORD TYPE OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF " &
-                                  "UNINITIALIZED ACTUAL");
-                     END IF;
-                     REC := (10,10,"9876543210");
-                END CHK_RECTYPE2;
-           END PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.CHK_RECTYPE1 (PKG.REC1, PKG.REC2, PKG.REC3);
-           PKG.CHK_RECTYPE2 (PKG.REC4);
- 
-      END;   -- (A)
- 
-      ---------------------------------------------
- 
- B :  DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INT IS INTEGER RANGE 0..100;
- 
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
- 
- 
-                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
-                                        REC2 : OUT RECTYPE;
-                                        REC3 : IN OUT RECTYPE);
- 
-                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
- 
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC1  : PKG.RECTYPE(10);
-           REC2  : PKG.RECTYPE(17);   
-           REC3  : PKG.RECTYPE(1);    
-           REC4  : PKG.RECTYPE(10);
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
-                                        REC2 : OUT RECTYPE;
-                                        REC3 : IN OUT RECTYPE) IS
-                BEGIN
-                     IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
-                          FAILED ("PRIVATE TYPE IN PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF ACTUAL");
-                     END IF;
-                     IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
-                          FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF ACTUAL");
-                     END IF;
-                     IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
-                          FAILED ("PRIVATE TYPE IN OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF ACTUAL");
-                     END IF;
-                     REC2 := B.REC2;
-                END CHK_RECTYPE1;
- 
-                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
-                BEGIN
-                     IF (REC.CONSTRAINT /= IDENT_INT(10)) THEN
-                          FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINT OF " &
-                                  "UNINITIALIZED ACTUAL");
-                     END IF;
-                     REC := (10,10,"9876543210");
-                END CHK_RECTYPE2;
- 
-           BEGIN
-                REC1 := (10,10,"0123456789");
-                REC2 := (17,7,"C64106A..........");
-                REC3 := (1,1,"A");
- 
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
-           PKG.CHK_RECTYPE2 (REC4);
- 
-      END B;  -- (B)
- 
-      ---------------------------------------------
- 
- C :  DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INT IS INTEGER RANGE 0..100;
- 
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     LIMITED PRIVATE;
- 
-                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
-                                        REC2 : OUT RECTYPE;
-                                        REC3 : IN OUT RECTYPE);
- 
-                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
- 
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC1  : PKG.RECTYPE;     -- 10   
-           REC2  : PKG.RECTYPE;     -- 17
-           REC3  : PKG.RECTYPE;     --  1
-           REC4  : PKG.RECTYPE;     -- 80
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
-                                        REC2 : OUT RECTYPE;
-                                        REC3 : IN OUT RECTYPE) IS
-                BEGIN
-                     IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
-                          FAILED ("LIMITED PRIVATE TYPE IN PARAMETER " &
-                                  "DID NOT USE CONSTRAINT OF " &
-                                  "ACTUAL");
-                     END IF;
-                     IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
-                          FAILED ("LIMITED PRIVATE TYPE OUT PARAMETER " &
-                                  "DID NOT USE CONSTRAINT OF " &
-                                  "ACTUAL");
-                     END IF;
-                     IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
-                          FAILED ("LIMITED PRIVATE TYPE IN OUT " &
-                                  "PARAMETER DID NOT USE " &
-                                  "CONSTRAINT OF ACTUAL");
-                     END IF;
-                     REC2 := C.REC2;
-                END CHK_RECTYPE1;
- 
-                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
-                BEGIN
-                     IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
-                          FAILED ("LIMITED PRIVATE TYPE OUT " &
-                                  "PARAMETER DID NOT USE " &
-                                  "CONSTRAINT OF UNINITIALIZED ACTUAL");
-                     END IF;
-                     REC := (10,10,"9876543210");
-                END CHK_RECTYPE2;
- 
-           BEGIN
-                REC1 := (10,10,"0123456789");
-                REC2 := (17,7,"C64106A..........");
-                REC3 := (1,1,"A");
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
-           PKG.CHK_RECTYPE2 (REC4);
- 
-      END C;   -- (C)
- 
-      ---------------------------------------------
- 
- D :  DECLARE  -- (D)
- 
-           TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
-                CHARACTER;
- 
-           A1, A2, A3  : ATYPE(-1..1, 4..5)  := (('A','B'),
-                                                 ('C','D'),
-                                                 ('E','F'));
- 
-           A4  : ATYPE(-1..1, 4..5);
- 
-           CA1 : CONSTANT ATYPE(8..9, -7..INTEGER'FIRST) := 
-                               (8..9 => (-7..INTEGER'FIRST => 'A'));
- 
-           S1  : STRING(1..INTEGER'FIRST) := "";
-           S2  : STRING(-5..-7) := "";
-           S3  : STRING(1..0) := "";
- 
-           PROCEDURE CHK_ARRAY1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
-                                 A3 : IN OUT ATYPE) IS
-           BEGIN
-                IF ((A1'FIRST(1) /= IDENT_INT(-1)) OR
-                    (A1'LAST(1)  /= IDENT_INT(1)) OR
-                    (A1'FIRST(2) /= IDENT_INT(4)) OR
-                    (A1'LAST(2)  /= IDENT_INT(5))) THEN
-                     FAILED ("ARRAY TYPE IN PARAMETER DID NOT " &
-                             "USE CONSTRAINTS OF ACTUAL");
-                END IF;
-                IF ((A2'FIRST(1) /= IDENT_INT(-1)) OR
-                    (A2'LAST(1)  /= IDENT_INT(1)) OR
-                    (A2'FIRST(2) /= IDENT_INT(4)) OR
-                    (A2'LAST(2)  /= IDENT_INT(5))) THEN
-                     FAILED ("ARRAY TYPE OUT PARAMETER DID NOT USE" &
-                             "CONSTRAINTS OF ACTUAL");
-                END IF;
-                IF ((A3'FIRST(1) /= IDENT_INT(-1)) OR
-                    (A3'LAST(1)  /= IDENT_INT(1)) OR
-                    (A3'FIRST(2) /= IDENT_INT(4)) OR
-                    (A3'LAST(2)  /= IDENT_INT(5))) THEN
-                     FAILED ("ARRAY TYPE IN OUT PARAMETER DID NOT " &
-                             "USE CONSTRAINTS OF ACTUAL");
-                END IF;
-                A2 := D.A2;
-           END CHK_ARRAY1;
- 
-           PROCEDURE CHK_ARRAY2 (A4 : OUT ATYPE) IS
-           BEGIN
-                IF ((A4'FIRST(1) /= IDENT_INT(-1)) OR
-                    (A4'LAST(1)  /= IDENT_INT(1)) OR
-                    (A4'FIRST(2) /= IDENT_INT(4)) OR
-                    (A4'LAST(2)  /= IDENT_INT(5))) THEN
-                     FAILED ("ARRAY TYPE OUT PARAMETER DID NOT " &
-                             "USE CONSTRAINTS OF UNINITIALIZED " &
-                             "ACTUAL");
-                END IF;
-                A4 := A2;
-           END CHK_ARRAY2;
- 
-           PROCEDURE CHK_STRING (S1 : IN STRING;
-                                 S2 : IN OUT STRING;
-                                 S3 : OUT STRING) IS
-           BEGIN
-                IF ((S1'FIRST /= IDENT_INT(1)) OR
-                    (S1'LAST  /= IDENT_INT(INTEGER'FIRST))) THEN
-                     FAILED ("STRING TYPE IN PARAMETER DID NOT " &
-                             "USE CONSTRAINTS OF ACTUAL NULL " &
-                             "STRING");
-                END IF;
-                IF ((S2'FIRST /= IDENT_INT(-5)) OR
-                    (S2'LAST  /= IDENT_INT(-7))) THEN 
-                     FAILED ("STRING TYPE IN OUT PARAMETER DID NOT " &
-                             "USE CONSTRAINTS OF ACTUAL NULL STRING");
-                END IF;
-                IF ((S3'FIRST /= IDENT_INT(1)) OR
-                    (S3'LAST  /= IDENT_INT(0))) THEN
-                     FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
-                             "USE CONSTRAINTS OF ACTUAL NULL STRING");
-                END IF;
-                S3 := "";
-           END CHK_STRING;
- 
-      BEGIN  -- (D)
-           CHK_ARRAY1 (A1, A2, A3);
-           CHK_ARRAY2 (A4);
-           CHK_STRING (S1, S2, S3);
-      END D;  -- (D)
- 
-      RESULT;
- END C64106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,237 ****
- -- C64106B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED RECORD,
- --   PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT CONSTRAINTS
- --   RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE THE 
- --   CONSTRAINT OF THE ACTUAL PARAMETER.
- --   SUBTESTS ARE:
- --        (A) RECORD TYPE.
- --        (B) PRIVATE TYPE.
- --        (C) LIMITED PRIVATE TYPE.
- 
- -- DAS  1/15/81
- -- CPP  8/9/84
- 
- WITH REPORT;
- PROCEDURE C64106B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C64106B", "CHECK ASSIGNMENT TO FORMAL PARAMETERS OF " &
-                       "UNCONSTRAINED TYPE (WITH NO DEFAULT)");
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
- 
-                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
-                                       REC6 : IN OUT RECTYPE);
-           END PKG;
- 
-           REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
-                  (IDENT_INT(9), 9, "123456789");
-           REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
-                  (IDENT_INT(6), 5, "AEIOUY");
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
-                                       REC6 : IN OUT RECTYPE) IS
- 
-                     REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
-                            (IDENT_INT(4), 4, "OOPS"); 
- 
-                BEGIN
-                     BEGIN  -- (A.1)
-                          REC9 := REC6;
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED - A.1");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - A.1");
-                     END;   -- (A.1)
- 
-                     BEGIN  -- (A.2)
-                          REC6 := REC4;
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED - A.2");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - A.2");
-                     END;   -- (A.2)
- 
-                     REC9 := (IDENT_INT(9), 9, "987654321");
- 
-                END CHK_RECTYPE;
-           END PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.CHK_RECTYPE (REC9, REC6);
-           IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
-                FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
-           END IF;
- 
-      END;   -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
- 
-                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
-                                       REC6 : IN OUT RECTYPE);
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC9 : PKG.RECTYPE(9);
-           REC6 : PKG.RECTYPE(6);
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
-                                       REC6 : IN OUT RECTYPE) IS
- 
-                     REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS"); 
- 
-                BEGIN
-                     BEGIN  -- (B.1)
-                          REC9 := REC6;
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED - B.1");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - B.1");
-                     END;   -- (B.1)
- 
-                     BEGIN  -- (B.2)
-                          REC6 := REC4;
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED - B.2");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - B.2");
-                     END;   -- (B.2)
-                END CHK_RECTYPE;
- 
-           BEGIN
-                REC9 := (9, 9, "123456789");
-                REC6 := (6, 5, "AEIOUY");
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.CHK_RECTYPE (REC9, REC6);
- 
-      END;   -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
- 
-                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
-                                       REC6 : IN OUT RECTYPE);
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC6 : PKG.RECTYPE(IDENT_INT(6));
-           REC9 : PKG.RECTYPE(IDENT_INT(9));
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
-                                       REC6 : IN OUT RECTYPE) IS
- 
-                     REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS"); 
- 
-                BEGIN
-                     BEGIN  -- (C.1)
-                          REC9 := REC6;
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED - C.1");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - C.1");
-                     END;   -- (C.1)
- 
-                     BEGIN  -- (C.2)
-                          REC6 := REC4;
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED - C.2");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - C.2");
-                     END;   -- (C.2)
-                END CHK_RECTYPE;
- 
-           BEGIN
-                REC6 := (6, 5, "AEIOUY");
-                REC9 := (9, 9, "123456789");
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.CHK_RECTYPE (REC9, REC6);
- 
-      END;   -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64106B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,309 ****
- -- C64106C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED
- --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
- --    CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS
- --    CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING
- --    ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER.  
- 
- --    SUBTESTS ARE:
- --        (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
- --        (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
- --        (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
- 
- -- DAS  1/16/81
- -- VKG  1/7/83
- -- CPP  8/9/84
- 
- WITH REPORT;
- PROCEDURE C64106C IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C64106C", "CHECK ASSIGNMENTS TO FORMAL PARAMETERS OF " &
-                       "UNCONSTRAINED TYPES (WITH DEFAULTS)");
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
- 
-                REC91,REC92,REC93  : RECTYPE(9);
-                REC_OOPS           : RECTYPE(4);
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE);
-           END PKG;
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE) IS
- 
-                     PROCEDURE P1 (REC11 : IN RECTYPE;
-                                   REC12 : IN OUT RECTYPE;
-                                   REC13 : OUT RECTYPE) IS
-                     BEGIN
-                          IF (NOT REC11'CONSTRAINED) OR
-                             (REC11.CONSTRAINT /= IDENT_INT(9)) THEN
-                               FAILED ("CONSTRAINT ON RECORD " &
-                                       "TYPE IN PARAMETER " &
-                                       "NOT RECOGNIZED");
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
-                               REC12 := REC_OOPS;
-                               FAILED ("CONSTRAINT ERROR NOT RAISED - " &
-                                       "A.1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED - " &
-                                            "A.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
-                               REC13 := REC_OOPS;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                                       "A.2");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED - " &
-                                            "A.2");
-                          END;
-                     END P1;
- 
-                BEGIN
-                     P1 (REC1, REC2, REC3);
-                END P;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.P (PKG.REC91, PKG.REC92, PKG.REC93);
- 
-      END;   -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE);
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91, REC92, REC93  : PKG.RECTYPE(9);
-           REC_OOPS             : PKG.RECTYPE(4);
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE) IS
- 
-                     PROCEDURE P1 (REC11 : IN RECTYPE;
-                                   REC12 : IN OUT RECTYPE;
-                                   REC13 : OUT RECTYPE) IS
-                     BEGIN
-                          IF (NOT REC11'CONSTRAINED) OR
-                             (REC11.CONSTRAINT /= IDENT_INT(9)) THEN
-                               FAILED ("CONSTRAINT ON PRIVATE " &
-                                       "TYPE IN PARAMETER " &
-                                       "NOT RECOGNIZED");
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
-                               REC12 := REC_OOPS;
-                               FAILED ("CONSTRAINT ERROR NOT RAISED - " &
-                                       "B.1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED - " &
-                                            "B.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
-                               REC13 := REC_OOPS;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                                       "B.2");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED - " &
-                                            "B.2");
-                          END;
-                     END P1;
- 
-                BEGIN
-                     P1 (REC1, REC2, REC3);
-                END P;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.P (REC91, REC92, REC93);
- 
-      END;   -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     LIMITED PRIVATE;
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE);
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91,REC92,REC93  : PKG.RECTYPE(9);
-           REC_OOPS           : PKG.RECTYPE(4);
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE) IS
- 
-                     PROCEDURE P1 (REC11 : IN RECTYPE;
-                                   REC12 : IN OUT RECTYPE;
-                                   REC13 : OUT RECTYPE) IS
-                     BEGIN
-                          IF (NOT REC11'CONSTRAINED) OR
-                             (REC11.CONSTRAINT /= 9) THEN
-                               FAILED ("CONSTRAINT ON LIMITED PRIVATE " &
-                                       "TYPE IN PARAMETER " &
-                                       "NOT RECOGNIZED");
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
-                               REC12 := REC_OOPS;
-                               FAILED ("CONSTRAINT ERROR NOT RAISED - " &
-                                       "C.1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED - " &
-                                            "C.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
-                               REC13 := REC_OOPS;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                                       "C.2");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED - " &
-                                            "C.2");
-                          END;
-                     END P1;
- 
-                BEGIN
-                     P1 (REC1, REC2, REC3);
-                END P;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.P (REC91, REC92, REC93);
- 
-      END;   -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64106C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64106d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64106d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,280 ****
- -- C64106D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED
- --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
- --    CONSTRAINTS DO NOT RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER
- --    IS UNCONSTRAINED, EVEN IF THE CONSTRAINT VALUES OF THE OBJECT 
- --    BEING ASSIGNED ARE DIFFERENT THAN THOSE OF THE ACTUAL PARAMETER.  
- 
- --    SUBTESTS ARE:
- --        (A) UNCONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
- --        (B) UNCONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
- --        (C) UNCONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
- 
- -- JRK  4/16/81
- -- CPP  8/9/84
- -- JRK 11/28/84
- 
- WITH REPORT;
- PROCEDURE C64106D IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C64106D", "CHECK ASSIGNMENTS TO FORMAL PARAMETERS OF " &
-                       "UNCONSTRAINED TYPES WITH UNCONSTRAINED " &
-                       "ACTUAL PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE);
-           END PKG;
- 
-           REC91, REC92, REC93 : PKG.RECTYPE :=
-                (IDENT_INT(5), 5, IDENT_STR("12345"));
-           REC_OOPS            : PKG.RECTYPE;
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE) IS
- 
-                     PROCEDURE P1 (REC11 : IN RECTYPE;
-                                   REC12 : IN OUT RECTYPE;
-                                   REC13 : OUT RECTYPE) IS
-                     BEGIN
- 
-                          IF NOT REC11'CONSTRAINED THEN
-                               FAILED ("REC11 IS NOT CONSTRAINED - A.1");
-                          END IF;
-                          IF REC11.CONSTRAINT /= IDENT_INT(9) THEN
-                               FAILED ("REC11 CONSTRAINT IS NOT 9 " &
-                                       "- A.1");
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
-                               REC12 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ("EXCEPTION RAISED - A.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
-                               REC13 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ("EXCEPTION RAISED - A.2");
-                          END;
-                     END P1;
- 
-                BEGIN
-                     P1 (REC1, REC2, REC3);
-                END P;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-           USE PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.P (REC91, REC92, REC93);
-           IF (REC92 /= REC_OOPS) OR (REC93 /= REC_OOPS) THEN
-                FAILED ("RESULTANT VALUE OF REC92 OR REC93 INCORRECT");
-           END IF;
- 
-      END;   -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE);
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91, REC92, REC93  : PKG.RECTYPE;
-           REC_OOPS             : PKG.RECTYPE;
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE) IS
- 
-                     PROCEDURE P1 (REC11 : IN RECTYPE;
-                                   REC12 : IN OUT RECTYPE;
-                                   REC13 : OUT RECTYPE) IS
-                     BEGIN
- 
-                          IF REC3'CONSTRAINED THEN
-                               FAILED ("REC3 IS CONSTRAINED - B.1");
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
-                               REC12 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ("EXCEPTION RAISED - B.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
-                               REC13 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ("EXCEPTION RAISED - B.2");
-                          END;
-                     END P1;
- 
-                BEGIN
-                     P1 (REC1, REC2, REC3);
-                END P;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.P (REC91, REC92, REC93);
- 
-      END;   -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     LIMITED PRIVATE;
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE);
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91, REC92, REC93  : PKG.RECTYPE;
-           REC_OOPS             : PKG.RECTYPE;
- 
-           PACKAGE BODY PKG IS
- 
-                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                             REC3 : OUT RECTYPE) IS
- 
-                     PROCEDURE P1 (REC11 : IN RECTYPE;
-                                   REC12 : IN OUT RECTYPE;
-                                   REC13 : OUT RECTYPE) IS
-                     BEGIN
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
-                               REC12 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ("EXCEPTION RAISED - C.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
-                               REC13 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ("EXCEPTION RAISED - C.2");
-                          END;
-                     END P1;
- 
-                BEGIN
-                     P1 (REC1, REC2, REC3);
-                END P;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.P (REC91, REC92, REC93);
- 
-      END;   -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C64106D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64107a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64107a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64107a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C64107A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ACTUAL PARAMETERS ARE EVALUATED AND IDENTIFIED AT THE
- --   TIME OF CALL.
- 
- -- DAS  1/29/81
- -- SPS 12/13/82
- 
- WITH REPORT;
- PROCEDURE C64107A IS
- 
-      USE REPORT;
- 
-      TYPE VECTOR IS ARRAY (1..10) OF INTEGER;
-      TYPE PTRINT IS ACCESS INTEGER;
- 
-      I    : INTEGER := 1;
-      A    : VECTOR  := (1,2,3,4,5,6,7,8,9,10);
-      P1   : PTRINT  := NEW INTEGER'(2);
-      P2   : PTRINT  := P1;
- 
-      PROCEDURE PROC1 (I : OUT INTEGER; J : OUT INTEGER) IS
-      BEGIN
-           I := 10;
-           J := -1;
-      END PROC1;
- 
-      PROCEDURE PROC2 (P : OUT PTRINT; I : OUT INTEGER) IS
-      BEGIN
-           P := NEW INTEGER'(3);
-           I := 5;
-      END PROC2;
- 
- BEGIN
- 
-      TEST ("C64107A", "CHECK THAT ACTUAL PARAMETERS ARE EVALUATED" &
-                       " AND IDENTIFIED AT THE TIME OF CALL");
- 
-      PROC1 (I, A(I));
-      IF (A /= (-1,2,3,4,5,6,7,8,9,10)) THEN
-           FAILED ("A(I) EVALUATED UPON RETURN");
-      END IF;
- 
-      PROC2 (P1, P1.ALL);
-      IF (P2.ALL /= 5) THEN
-           FAILED ("P1.ALL EVALUATED UPON RETURN");
-      END IF;
- 
-      RESULT;
- 
- END C64107A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64108a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64108a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64108a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- C64108A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL PERMITTED FORMS OF VARIABLE NAMES ARE PERMITTED
- --   AS ACTUAL PARAMETERS.
- 
- -- DAS 2/10/81
- -- SPS 10/26/82
- -- SPS 11/5/82
- 
- WITH REPORT;
- PROCEDURE C64108A IS
- 
-      USE REPORT;
-      SUBTYPE INT IS INTEGER RANGE 1..3;
-      TYPE REC (N : INT) IS
-           RECORD
-                S : STRING (1..N);
-           END RECORD;
-      TYPE PTRSTR IS ACCESS STRING;
- 
-      R1,R2,R3 : REC(3);
-      S1,S2,S3 : STRING (1..3);
-      PTRTBL   : ARRAY (1..3) OF PTRSTR;
- 
-      PROCEDURE P1 (S1 : IN STRING; S2: IN OUT STRING; 
-                    S3 : OUT STRING) IS
-      BEGIN
-           S3 := S2;
-           S2 := S1;
-      END P1;
- 
-      PROCEDURE P2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
-                    C3 : OUT CHARACTER) IS
-      BEGIN
-           C3 := C2;
-           C2 := C1;
-      END P2;
- 
-      FUNCTION F1 (X : INT) RETURN PTRSTR IS
-      BEGIN
-           RETURN PTRTBL(X);
-      END F1;
- 
-      FUNCTION "+" (S1,S2 : STRING) RETURN PTRSTR IS
-      BEGIN
-           RETURN PTRTBL(CHARACTER'POS(S1(1))-CHARACTER'POS('A')+1);
-      END "+";
- 
- BEGIN
- 
-      TEST ("C64108A", "CHECK THAT ALL PERMITTED FORMS OF VARIABLE" &
-                       " NAMES ARE PERMITTED AS ACTUAL PARAMETERS");
- 
-      S1 := "AAA";
-      S2 := "BBB";
-      P1 (S1, S2, S3);
-      IF (S2 /= "AAA") OR (S3 /= "BBB") THEN
-           FAILED ("SIMPLE VARIABLE AS AN ACTUAL PARAMETER NOT WORKING");
-      END IF;
- 
-      S1 := "AAA";
-      S2 := "BBB";
-      S3 := IDENT_STR("CCC");
-      P2 (S1(1), S2(IDENT_INT(1)), S3(1));
-      IF (S2 /= "ABB") OR (S3 /= "BCC") THEN
-           FAILED ("INDEXED COMPONENT AS AN ACTUAL PARAMETER NOT " &
-                   "WORKING");
-      END IF;
- 
-      R1.S := "AAA";
-      R2.S := "BBB";
-      P1 (R1.S, R2.S, R3.S);
-      IF (R2.S /= "AAA") OR (R3.S /= "BBB") THEN
-           FAILED ("SELECTED COMPONENT AS AN ACTUAL PARAMETER" &
-                   " NOT WORKING");
-      END IF;
- 
-      S1 := "AAA";
-      S2 := "BBB";
-      P1 (S1(1..IDENT_INT(2)), S2(1..2), S3(IDENT_INT(1)..IDENT_INT(2)));
-      IF (S2 /= "AAB") OR (S3 /= "BBC") THEN
-           FAILED ("SLICE AS AN ACTUAL PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      P1 (F1(1).ALL, F1(2).ALL, F1(IDENT_INT(3)).ALL);
-      IF (PTRTBL(2).ALL /= "AAA") OR (PTRTBL(3).ALL /= "BBB") THEN
-           FAILED ("SELECTED COMPONENT OF FUNCTION VALUE AS AN ACTUAL" &
-                   " PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      S1 := IDENT_STR("AAA");
-      S2 := IDENT_STR("BBB");
-      S3 := IDENT_STR("CCC");
-      P1 ("+"(S1,S1).ALL, "+"(S2,S2).ALL, "+"(S3,S3).ALL);
-      IF (PTRTBL(2).ALL /= "AAA") OR (PTRTBL(3).ALL /= "BBB") THEN
-           FAILED ("SELECTED COMPONENT OF OVERLOADED OPERATOR FUNCTION" &
-                   " VALUE AS AN ACTUAL PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      P2 (F1(1)(1), F1(IDENT_INT(2))(1), F1(3)(IDENT_INT(1)));
-      IF (PTRTBL(2).ALL /= "ABB") OR (PTRTBL(3).ALL /= "BCC") THEN
-           FAILED ("INDEXED COMPONENT OF FUNCTION VALUE AS AN ACTUAL" &
-                   " PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      P1 (F1(1)(2..3), F1(2)(IDENT_INT(2)..3), F1(3)(2..IDENT_INT(3)));
-      IF (PTRTBL(2).ALL /= "BAA") OR (PTRTBL(3).ALL /= "CBB") THEN
-           FAILED ("SLICE OF FUNCTION VALUE AS AN ACTUAL PARAMETER" &
-                   " NOT WORKING");
-      END IF;
- 
-      RESULT;
- 
- END C64108A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C64109A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
- -- TO SUBPROGRAMS.  SPECIFICALLY,
- --   (A) CHECK ALL PARAMETER MODES.
- 
- -- CPP 8/20/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109A IS
- 
- BEGIN
-      TEST ("C64109A", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
-            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS");
- 
-      --------------------------------------------
- 
-      DECLARE   -- (A)
- 
-           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
-           TYPE RECORD_TYPE IS
-                RECORD
-                     I : INTEGER;
-                     A : ARRAY_SUBTYPE;
-                END RECORD;
-           REC : RECORD_TYPE := (I => 23,
-                                 A => (1..3 => IDENT_INT(7), 4..5 => 9));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (7, 7, 7, 9, 9) THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(1) OR
-                   ARR'LAST /= IDENT_INT(5) THEN
-                     FAILED ("WRONG BOUNDS FOR IN PARAMETER");
-                END IF;
-           END P1;
- 
-           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (7, 7, 7, 9, 9) THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY TO FN");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(1) OR
-                   ARR'LAST /= IDENT_INT(5) THEN
-                     FAILED ("WRONG BOUNDS FOR IN PARAMETER FOR FN");
-                END IF;
- 
-                RETURN TRUE;
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (7, 7, 7, 9, 9) THEN
-                     FAILED ("IN OUT PARAMETER NOT PASSED " &
-                             "CORRECTLY");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(1) OR
-                   ARR'LAST /= IDENT_INT(5) THEN
-                     FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
-                END IF;
-                ARR := (ARR'RANGE => 5);
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR'FIRST /= IDENT_INT(1) OR
-                   ARR'LAST /= IDENT_INT(5) THEN
-                     FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
-                END IF;
- 
-                ARR := (ARR'RANGE => 3);
-           END P3;
- 
-      BEGIN     -- (A)
- 
-           P1 (REC.A);
-           IF REC.A /= (7, 7, 7, 9, 9) THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE");
-           END IF;
- 
-           BOOL := F1 (REC.A);
-           IF REC.A /= (7, 7, 7, 9, 9) THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION");
-           END IF;
- 
-           P2 (REC.A);
-           IF REC.A /= (5, 5, 5, 5, 5) THEN
-                FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
-           END IF;
- 
-           P3 (REC.A);
-           IF REC.A /= (3, 3, 3, 3, 3) THEN
-                FAILED ("OUT PARAM RETURNED INCORRECTLY");
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------
- 
-      RESULT;
- END C64109A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- C64109B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
- -- TO SUBPROGRAMS.  SPECIFICALLY,
- --   (B) CHECK MULTIDIMENSIONAL ARRAYS.
- 
- -- CPP 8/20/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109B IS
- 
- BEGIN
-      TEST ("C64109B", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
-            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
-            "MULTIDIMENSIONAL ARRAYS");
- 
-      DECLARE   -- (B)
- 
-           TYPE MULTI_TYPE IS ARRAY (POSITIVE RANGE <>, 
-                                     POSITIVE RANGE <>) OF BOOLEAN;
-           SUBTYPE MULTI_SUBTYPE IS MULTI_TYPE (1..2, 1..3);
-           TYPE RECORD_TYPE IS
-                RECORD
-                     I : BOOLEAN;
-                     A : MULTI_SUBTYPE;
-                END RECORD;
-           REC : RECORD_TYPE :=
-                     (I => FALSE,
-                      A => (1..2 => (1..3 => IDENT_BOOL(TRUE))));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : MULTI_TYPE) IS
-           BEGIN
-                IF ARR /= (1..2 => (1..3 => TRUE)) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
-                     FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER");
-                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
-                   THEN 
-                     FAILED ("2ND DIM NOT CORRECT - IN PARAMETER");
-                END IF;                  
-           END P1;
- 
-           FUNCTION F1 (ARR : MULTI_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (1..2 => (1..3 => TRUE)) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
- 
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
-                     FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER FN");
-                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
-                   THEN 
-                     FAILED ("2ND DIM NOT CORRECT - IN PARAMETER FN");
-                END IF;                  
-                RETURN TRUE;
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT MULTI_TYPE) IS
-           BEGIN
-                IF ARR /= (1..2 => (1..3 => TRUE)) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
-                     FAILED ("FIRST DIM NOT CORRECT - IN OUT PARAMETER");
-                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
-                   THEN 
-                     FAILED ("2ND DIM NOT CORRECT - IN OUT PARAMETER");
-                END IF;                  
-                ARR := (ARR'RANGE(1) => (ARR'RANGE(2) => FALSE));
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT MULTI_TYPE) IS
-           BEGIN
-                FOR I IN 1 .. 2 LOOP
-                     FOR J IN 1 .. 3 LOOP
-                          IF (J MOD 2) = 0 THEN
-                               ARR(I, J) := TRUE;
-                          ELSE
-                               ARR(I, J) := FALSE;
-                          END IF;
-                     END LOOP;
-                END LOOP;
- 
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
-                     FAILED ("FIRST DIM NOT CORRECT - OUT PARAMETER");
-                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
-                   THEN 
-                     FAILED ("2ND DIM NOT CORRECT - OUT PARAMETER");
-                END IF;                  
-           END P3;
- 
-      BEGIN     -- (B)
- 
-           P1 (REC.A);
-           IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE");
-           END IF;
- 
-           BOOL := F1 (REC.A);
-           IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION");
-           END IF;
- 
-           P2 (REC.A);
-           IF REC.A /= (1..2 => (1..3 => FALSE)) THEN
-                FAILED ("IN OUT PARAM CHANGED BY PROCEDURE");
-           END IF;
- 
-           P3 (REC.A);
-           FOR I IN 1 .. 2 LOOP
-                FOR J IN 1 .. 3 LOOP
-                     IF (J MOD 2) = 0 THEN
-                          IF REC.A(I, J) /= TRUE THEN
-                               FAILED ("OUT PARAM RETURNED " &
-                                       "INCORRECTLY - (B)");
-                          END IF;
-                     ELSE
-                          IF REC.A(I, J) /= FALSE THEN
-                               FAILED ("OUT PARAM RETURNED " &
-                                       "INCORRECTLY - (B)2");
-                          END IF;
-                     END IF;
-                END LOOP;
-           END LOOP;
- 
-      END; -- (B)
- 
-      RESULT;
- END C64109B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- C64109C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
- -- TO SUBPROGRAMS.  SPECIFICALLY,
- --   (C) CHECK RECORDS HAVING A DISCRIMINANT, WITH MORE THAN ONE ARRAY
- --       COMPONENT, WHERE THE BOUNDS OF THE ARRAY DEPEND ON THE
- --       DISCRIMINANT.
- 
- -- CPP 8/20/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109C IS
- 
- BEGIN
-      TEST ("C64109C", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
-            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
-            "RECORDS WITH DISCRIMINANTS");
- 
-      DECLARE   -- (C)
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 1..6;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
-           TYPE RECORD_TYPE (BOUND : INTEGER) IS
-                RECORD
-                     B : BOOLEAN;
-                     A : ARRAY_TYPE (1..BOUND);
-                     AA : ARRAY_TYPE (BOUND..6);
-                END RECORD;
-           REC : RECORD_TYPE (BOUND => IDENT_INT(4)) :=
-                                (BOUND => 4,
-                                 B => TRUE,
-                                 A => (1..IDENT_INT(4) => 6),
-                                 AA => (4..6 => 8));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (6, 6, 6, 6) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER");
-                END IF;
-           END P1;
- 
-           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (6, 6, 6, 6) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
- 
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
-                END IF;
-                RETURN TRUE;
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (8, 8, 8) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= 4 OR ARR'LAST /= IDENT_INT(6) THEN
-                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
-                END IF;
- 
-                ARR := (ARR'RANGE => 10);
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
-                END IF;
-                ARR := (ARR'RANGE => 4);
-           END P3;
- 
-      BEGIN     -- (C)
- 
-           P1 (REC.A);
-           IF REC.A /= (6, 6, 6, 6) THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE");
-           END IF;
- 
-           BOOL := F1 (REC.A);
-           IF REC.A /= (6, 6, 6, 6) THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION");
-           END IF;
- 
-           P2 (REC.AA);
-           IF REC.AA /= (10, 10, 10) THEN
-                FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
-           END IF;
- 
-           P3 (REC.A);
-           IF REC.A /= (4, 4, 4, 4) THEN
-                FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
-           END IF;
- 
-      END; -- (C)
- 
-      RESULT;
- END C64109C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C64109D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
- -- TO SUBPROGRAMS.  SPECIFICALLY,
- --   (D) CHECK OBJECTS DESIGNATED BY ACCESS TYPES.
- 
- -- CPP 8/20/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109D IS
- 
- BEGIN
-      TEST ("C64109D", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
-            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
-            "OBJECTS DESIGNATED BY ACCESS TYPES");
- 
-      DECLARE   -- (D)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..3;
-           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>) OF INTEGER;
-           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(3));
-           TYPE NODE_TYPE;
-           TYPE ACCESS_TYPE IS ACCESS NODE_TYPE;
-           TYPE NODE_TYPE IS
-                RECORD
-                     A    : ARRAY_SUBTYPE;
-                     NEXT : ACCESS_TYPE;
-                END RECORD;
-           PTR : ACCESS_TYPE := NEW NODE_TYPE'
-                     (A => (IDENT_INT(1)..3 => IDENT_INT(5)),
-                      NEXT => NULL);
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (5, 5, 5) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER");
-                END IF;
-           END P1;
- 
-           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (5, 5, 5) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
-                END IF;
- 
-                RETURN TRUE;
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_SUBTYPE) IS
-           BEGIN
-                IF ARR /= (5, 5, 5) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
-                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
-                END IF;
- 
-                ARR := (OTHERS => 6);
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
-           BEGIN
- 
-                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
-                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
-                END IF;
- 
-                ARR := (ARR'RANGE => 7);
-           END P3;
- 
-      BEGIN     -- (D)
- 
-           P1 (PTR.A);
-           IF PTR.A /= (5, 5, 5) THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE");
-           END IF;
- 
-           BOOL := F1 (PTR.A);
-           IF PTR.A /= (5, 5, 5) THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION");
-           END IF;
- 
-           P2 (PTR.A);
-           IF PTR.A /= (6, 6, 6) THEN
-                FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
-           END IF;
- 
-           P3 (PTR.A);
-           IF PTR.A /= (7, 7, 7) THEN
-                FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
-           END IF;
- 
-      END; -- (D)
- 
-      RESULT;
- END C64109D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- C64109E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
- -- TO SUBPROGRAMS.  SPECIFICALLY,
- --   (E) CHECK THE CASE WHERE THE FORMAL IS UNCONSTRAINED, AND ARRAYS
- --       WITH DIFFERENT BOUNDS ARE PASSED AS ACTUALS.
- 
- -- CPP 8/20/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109E IS
- 
- BEGIN
-      TEST ("C64109E", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
-            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
-            "ARRAYS WITH DIFFERENT BOUNDS PASSED TO UNCONSTRAINED " &
-            "FORMAL");
- 
-      DECLARE   -- (E)
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 0..5;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
-           TYPE RECORD_TYPE IS
-                RECORD
-                     A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(2));
-                     B : ARRAY_TYPE (1..3);
-                END RECORD;
-           REC : RECORD_TYPE := (A => (0..2 => IDENT_BOOL(TRUE)),
-                                 B => (1..3 => IDENT_BOOL(FALSE)));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS - 1");
-                END IF;
-                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
-                END IF;
-                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS - 2");
-                END IF;
-           END P1;
- 
-           FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) 
-                RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
-                END IF;
-                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
-                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
-                END IF;
-                RETURN TRUE;
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
-                         ARR2 : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
-                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
-                END IF;
-                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
-                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
-                END IF;
-                ARR := (ARR'RANGE => FALSE);
-                ARR2 := (ARR2'RANGE => TRUE);
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
-                     FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
-                END IF;
-                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG OUT  PARAMETER BOUNDS - 2");
-                END IF;
-                ARR := (ARR'RANGE => FALSE);
-                ARR2 := (ARR2'RANGE => TRUE);
-           END P3;
- 
-      BEGIN     -- (E)
- 
-           P1 (REC.A, REC.B);
-           IF REC.A /= (TRUE, TRUE, TRUE) THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE");
-           END IF;
-           IF REC.B /= (FALSE, FALSE, FALSE) THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
-           END IF;
- 
-           BOOL := F1 (REC.A, REC.B);
-           IF REC.A /= (TRUE, TRUE, TRUE) THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION");
-           END IF;
-           IF REC.B /= (FALSE, FALSE, FALSE) THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
-           END IF;
- 
-           P2 (REC.A, REC.B);
-           IF REC.A /= (FALSE, FALSE, FALSE) THEN
-                FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
-           END IF;
-           IF REC.B /= (TRUE, TRUE, TRUE) THEN
-                FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
-           END IF;
- 
-           P3 (REC.A, REC.B);
-           IF REC.A /= (FALSE, FALSE, FALSE) THEN
-                FAILED ("OUT PARAM RETURNED INCORRECTLY");
-           END IF;
-           IF REC.B /= (TRUE, TRUE, TRUE) THEN
-                FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
-           END IF;
- 
-      END; -- (E)
- 
-      RESULT;
- END C64109E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- C64109F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
- -- TO SUBPROGRAMS.  SPECIFICALLY,
- --   (F) CHECK THAT A FORMAL PARAMETER CAN BE USED AS AN ACTUAL IN
- --       ANOTHER CALL.
- 
- -- CPP 8/20/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109F IS
- 
- BEGIN
-      TEST ("C64109F", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
-            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
-            "FORMAL AS AN ACTUAL");
- 
-      DECLARE   -- (F)
- 
-           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           SUBTYPE ARRAY_SUBTYPE IS 
-                     ARRAY_TYPE (IDENT_INT(1)..IDENT_INT(5));
-           TYPE RECORD_TYPE IS
-                RECORD
-                     I : INTEGER;
-                     A : ARRAY_SUBTYPE;
-                END RECORD;
-           REC : RECORD_TYPE := (I => 23,
-                                 A => (1..3 => 7, 4..5 => 9));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P_CALLED (A : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF A /= (7, 7, 7, 9, 9) THEN
-                     FAILED ("IN OUT PARAM NOT RECEIVED CORRECTLY");
-                END IF;
-                IF A'FIRST /= 1 OR A'LAST /= 5 THEN
-                     FAILED ("BOUNDS WRONG - IN OUT");
-                END IF;
-                A := (6, 6, 6, 6, 6);
-           END P_CALLED;
- 
-           PROCEDURE P (A : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                P_CALLED (A);
-           END P;
- 
-           FUNCTION F_CALLED (A : ARRAY_SUBTYPE) RETURN BOOLEAN IS
-                GOOD : BOOLEAN;
-           BEGIN
-                GOOD := (A = (7, 7, 7, 9, 9));
-                IF NOT GOOD THEN
-                     FAILED ("IN PARAMETER NOT RECEIVED CORRECTLY");
-                END IF;
-                IF A'FIRST /= 1 OR A'LAST /= IDENT_INT(5) THEN
-                     FAILED ("BOUNDS WRONG - FUNCTION");
-                END IF;
-                RETURN GOOD;
-           END F_CALLED;
- 
-           FUNCTION F (A : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                RETURN (F_CALLED (A));
-           END F;
- 
-           PROCEDURE P_OUT_CALLED (A : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF A'FIRST /= 1 OR A'LAST /= 5 THEN
-                     FAILED ("BOUNDS WRONG - OUT");
-                END IF;
-                A := (8, 8, 8, 8, 8);
-           END P_OUT_CALLED;
- 
-           PROCEDURE P_OUT (A : OUT ARRAY_TYPE) IS
-           BEGIN
-                P_OUT_CALLED (A);
-                A := (9, 9, 9, 9, 9);
-           END P_OUT;
- 
-      BEGIN     -- (F)
- 
-           P (REC.A);
-           IF REC.A /= (6, 6, 6, 6, 6) THEN
-                FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
-           END IF;
- 
-           REC.A := (7, 7, 7, 9, 9);
-           BOOL := F (REC.A);
-           IF NOT BOOL THEN
-                FAILED ("IN PARAM NOT RETURNED CORRECTLY");
-           END IF;
- 
-           REC.A := (7, 7, 7, 9, 9);
-           P_OUT (REC.A);
-           IF REC.A /= (9, 9, 9, 9, 9) THEN
-                FAILED ("OUT PARAM NOT RETURNED CORRECTLY - 2");
-           END IF;
- 
-      END; -- (F)
- 
-      --------------------------------------------
- 
-      RESULT;
- END C64109F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C64109G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SLICES OF ARRAYS ARE PASSED CORRECTLY TO SUBPROGRAMS.
- -- SPECIFICALLY,
- --   (A) CHECK ALL PARAMETER MODES.
- 
- -- CPP 8/28/84
- -- PWN 05/31/96  Corrected spelling problem.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109G IS
- 
- BEGIN
-      TEST ("C64109G", "CHECK THAT SLICES OF ARRAYS ARE PASSED " &
-            "CORRECTLY TO SUBPROGRAMS");
- 
-      --------------------------------------------
- 
-      DECLARE   -- (A)
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 1..5;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
-           ARR : ARRAY_TYPE (1..5) := (1..3 => 7, 4..5 => 9);
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (S : ARRAY_TYPE) IS
-           BEGIN
-                IF S(IDENT_INT(3)) /= 7 THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)");
-                END IF;
-                IF S(4) /= 9 THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)2");
-                END IF;
-           END P1;
- 
-           FUNCTION F1 (S : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF S(3) /= 7 THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)");
-                END IF;
-                IF S(IDENT_INT(4)) /= 9 THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)2");
-                END IF;
-                RETURN TRUE;
-           END F1;
- 
-           PROCEDURE P2 (S : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF S(3) /= 7 THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY - (A)");
-                END IF;
-                IF S(4) /= 9 THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY - (A)2");
-                END IF;
-                FOR I IN 3 .. 4 LOOP
-                     S(I) := 5;
-                END LOOP;
-           END P2;
- 
-           PROCEDURE P3 (S : OUT ARRAY_TYPE) IS
-           BEGIN
-                FOR I IN 3 .. 4 LOOP
-                     S(I) := 3;
-                END LOOP;
-           END P3;
- 
-      BEGIN     -- (A)
- 
-           P1 (ARR(3..4));
-           IF ARR(3) /= 7 THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE - (A)");
-           END IF;
-           IF ARR(4) /= 9 THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE - (A)2");
-           END IF;
- 
-           BOOL := F1 (ARR(IDENT_INT(3)..IDENT_INT(4)));
-           IF ARR(3) /= 7 THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION - (A)");
-           END IF;
-           IF ARR(4) /= 9 THEN
-                FAILED ("IN PARAM CHANGED BY FUNCTION - (A)2");
-           END IF;
- 
-           P2 (ARR(3..4));
-           FOR I IN 3 .. 4 LOOP
-                IF ARR(I) /= 5 THEN
-                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY - (A)");
-                END IF;
-           END LOOP;
- 
-           P3 (ARR(IDENT_INT(3)..4));
-           FOR I IN 3 .. 4 LOOP
-                IF ARR(I) /= 3 THEN
-                     FAILED ("OUT PARAM RETURNED INCORRECTLY - (A)");
-                END IF;
-           END LOOP;
- 
-      END;
- 
-      RESULT;
- 
- END C64109G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- C64109H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
- --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
- --       (A) CHECK ALL PARAMETER MODES.
- 
- -- HISTORY:
- --    TBN 07/11/86          CREATED ORIGINAL TEST.
- --    JET 08/04/87          MODIFIED REC.A REFERENCES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C64109H IS
- 
- BEGIN
-      TEST ("C64109H", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
-                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
-                       "TO SUBPROGRAMS");
- 
-      DECLARE   -- (A)
- 
-           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
-           TYPE RECORD_TYPE IS
-                RECORD
-                     I : INTEGER;
-                     A : ARRAY_SUBTYPE;
-                END RECORD;
-           REC : RECORD_TYPE := (I => 23,
-                                 A => (1..3 => IDENT_INT(7), 4..5 => 9));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (7, 9, 9) THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(3) OR
-                   ARR'LAST /= IDENT_INT(5) THEN
-                     FAILED ("WRONG BOUNDS FOR IN PARAMETER");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
-           END P1;
- 
-           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (7, 7, 9) THEN
-                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY TO FN");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(2) OR
-                   ARR'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG BOUNDS FOR IN PARAMETER FOR FN");
-                END IF;
- 
-                RETURN TRUE;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (7, 7, 7, 9) THEN
-                     FAILED ("IN OUT PARAMETER NOT PASSED " &
-                             "CORRECTLY");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(1) OR
-                   ARR'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
-                END IF;
-                ARR := (ARR'RANGE => 5);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR'FIRST /= IDENT_INT(3) OR
-                   ARR'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
-                END IF;
- 
-                ARR := (ARR'RANGE => 3);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
-           END P3;
- 
-      BEGIN     -- (A)
- 
-           BEGIN     -- (B)
-                P1 (REC.A (3..5));
-                IF REC.A /= (7, 7, 7, 9, 9) THEN
-                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
-           END;     -- (B)
- 
-           BEGIN     -- (C)
-                BOOL := F1 (REC.A (2..4));
-                IF REC.A /= (7, 7, 7, 9, 9) THEN
-                     FAILED ("IN PARAM CHANGED BY FUNCTION");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
-           END;     -- (C)
- 
-           BEGIN     -- (D)
-                P2 (REC.A (1..4));
-                IF REC.A /= (5, 5, 5, 5, 9) THEN
-                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
-           END;     -- (D)
- 
-           BEGIN     -- (E)
-                P3 (REC.A (3..4));
-                IF REC.A /= (5, 5, 3, 3, 9) THEN
-                     FAILED ("OUT PARAM RETURNED INCORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
-           END;     -- (E)
- 
-      END; -- (A)
- 
-      RESULT;
- END C64109H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- C64109I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
- --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
- --    (C) CHECK RECORDS HAVING A DISCRIMINANT, WITH MORE THAN ONE ARRAY
- --       COMPONENT, WHERE THE BOUNDS OF THE ARRAY DEPEND ON THE
- --       DISCRIMINANT.
- 
- -- HISTORY:
- --    TBN 07/10/86          CREATED ORIGINAL TEST.
- --    JET 08/04/87          REMOVED PARTIAL ARRAY REFERENCES IN
- --                          RECORD FIELDS.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109I IS
- 
- BEGIN
-      TEST ("C64109I", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
-                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
-                       "TO SUBPROGRAMS - RECORDS WITH DISCRIMINANTS");
- 
-      DECLARE   -- (C)
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 1..6;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
-           TYPE RECORD_TYPE (BOUND : INTEGER) IS
-                RECORD
-                     B : BOOLEAN;
-                     A : ARRAY_TYPE (1..BOUND);
-                     AA : ARRAY_TYPE (BOUND..6);
-                END RECORD;
-           REC : RECORD_TYPE (BOUND => IDENT_INT(4)) :=
-                                (BOUND => 4,
-                                 B => TRUE,
-                                 A => (1..IDENT_INT(4) => 6),
-                                 AA => (4..6 => 8));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (6, 6, 6) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
-           END P1;
- 
-           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (6, 6, 6) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
- 
-                IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
-                END IF;
-                RETURN TRUE;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (8, 8) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= 4 OR ARR'LAST /= IDENT_INT(5) THEN
-                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
-                END IF;
- 
-                ARR := (ARR'RANGE => 10);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
-                END IF;
-                ARR := (ARR'RANGE => 4);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
-           END P3;
- 
-      BEGIN     -- (C)
- 
-           BEGIN     -- (D)
-                P1 (REC.A (1..3));
-                IF REC.A /= (6, 6, 6, 6) THEN
-                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
-           END;     -- (D)
- 
-           BEGIN     -- (E)
-                BOOL := F1 (REC.A (2..4));
-                IF REC.A /= (6, 6, 6, 6) THEN
-                     FAILED ("IN PARAM CHANGED BY FUNCTION");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
-           END;     -- (E)
- 
-           BEGIN     -- (F)
-                P2 (REC.AA (4..5));
-                IF REC.AA /= (10, 10, 8) THEN
-                     FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
-           END;     -- (F)
- 
-           BEGIN     -- (G)
-                P3 (REC.A (2..3));
-                IF REC.A /= (6, 4, 4, 6) THEN
-                     FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
-           END;     -- (G)
- 
-      END; -- (C)
- 
-      RESULT;
- END C64109I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C64109J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
- --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
- --      (D) CHECK OBJECTS DESIGNATED BY ACCESS TYPES.
- 
- -- HISTORY:
- --    TBN 07/10/86          CREATED ORIGINAL TEST.
- --    JET 08/04/87          MODIFIED PTR.A REFERENCES.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C64109J IS
- 
- BEGIN
-      TEST ("C64109J", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
-                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
-                       "TO SUBPROGRAMS - OBJECTS DESIGNATED BY ACCESS " &
-                       "TYPES");
- 
-      DECLARE   -- (D)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..5;
-           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>) OF INTEGER;
-           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
-           TYPE NODE_TYPE;
-           TYPE ACCESS_TYPE IS ACCESS NODE_TYPE;
-           TYPE NODE_TYPE IS
-                RECORD
-                     A    : ARRAY_SUBTYPE;
-                     NEXT : ACCESS_TYPE;
-                END RECORD;
-           PTR : ACCESS_TYPE := NEW NODE_TYPE'
-                     (A => (IDENT_INT(1)..5 => IDENT_INT(5)),
-                      NEXT => NULL);
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (5, 5, 5) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
-           END P1;
- 
-           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (5, 5, 5) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
-                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
-                END IF;
- 
-                RETURN TRUE;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (5, 5, 5) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
- 
-                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
-                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
-                END IF;
- 
-                ARR := (ARR'RANGE => 6);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
-           BEGIN
- 
-                IF ARR'FIRST /= IDENT_INT(3) OR ARR'LAST /= 5 THEN
-                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
-                END IF;
- 
-                ARR := (ARR'RANGE => 7);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
-           END P3;
- 
-      BEGIN     -- (D)
- 
-           BEGIN     -- (E)
-                P1 (PTR.A (1..3));
-                IF PTR.A /= (5, 5, 5, 5, 5) THEN
-                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
-           END;     -- (E)
- 
-           BEGIN     -- (F)
-                BOOL := F1 (PTR.A (2..4));
-                IF PTR.A /= (5, 5, 5, 5, 5) THEN
-                     FAILED ("IN PARAM CHANGED BY FUNCTION");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
-           END;     -- (F)
- 
-           BEGIN     -- (G)
-                P2 (PTR.A (1..3));
-                IF PTR.A /= (6, 6, 6, 5, 5) THEN
-                     FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
-           END;     -- (G)
- 
-           BEGIN     -- (H)
-                P3 (PTR.A (3..5));
-                IF PTR.A /= (6, 6, 7, 7, 7) THEN
-                     FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
-           END;     -- (H)
- 
-      END; -- (D)
- 
-      RESULT;
- END C64109J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- C64109K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
- --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
- --    (E) CHECK THE CASE WHERE THE FORMAL IS UNCONSTRAINED, AND ARRAYS
- --       WITH DIFFERENT BOUNDS ARE PASSED AS ACTUALS.
- 
- -- HISTORY:
- --    TBN 07/11/86          CREATED ORIGINAL TEST.
- --    JET 08/04/87          MODIFIED REC.A REFERENCES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C64109K IS
- 
- BEGIN
-      TEST ("C64109K", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
-                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
-                       "TO SUBPROGRAMS - ARRAYS WITH DIFFERENT BOUNDS " &
-                       "PASSED TO UNCONSTRAINED FORMAL");
- 
-      DECLARE   -- (E)
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 0..5;
-           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
-           TYPE RECORD_TYPE IS
-                RECORD
-                     A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(4));
-                     B : ARRAY_TYPE (1..5);
-                END RECORD;
-           REC : RECORD_TYPE := (A => (0..4 => IDENT_BOOL(TRUE)),
-                                 B => (1..5 => IDENT_BOOL(FALSE)));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS - 1");
-                END IF;
-                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
-                END IF;
-                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS - 2");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
-           END P1;
- 
-           FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE)
-                RETURN BOOLEAN IS
-           BEGIN
-                IF ARR /= (TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
-                END IF;
-                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
-                END IF;
-                IF ARR2'FIRST /= 3 OR ARR2'LAST /= IDENT_INT(5) THEN
-                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
-                END IF;
-                RETURN TRUE;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
-           END F1;
- 
-           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
-                         ARR2 : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR /= (TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
-                IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
-                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
-                END IF;
-                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
-                END IF;
-                IF ARR2'FIRST /= 2 OR ARR2'LAST /= IDENT_INT(4) THEN
-                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
-                END IF;
-                ARR := (ARR'RANGE => FALSE);
-                ARR2 := (ARR2'RANGE => TRUE);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
-           END P2;
- 
-           PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
-                     FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
-                END IF;
-                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
-                     FAILED ("WRONG OUT  PARAMETER BOUNDS - 2");
-                END IF;
-                ARR := (ARR'RANGE => FALSE);
-                ARR2 := (ARR2'RANGE => TRUE);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
-           END P3;
- 
-      BEGIN     -- (E)
- 
-           BEGIN     -- (F)
-                P1 (REC.A (0..2), REC.B (1..3));
-                IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
-                END IF;
-                IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
-           END;     -- (F)
- 
-           BEGIN     -- (G)
-                BOOL := F1 (REC.A (1..3), REC.B (3..5));
-                IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
-                     FAILED ("IN PARAM CHANGED BY FUNCTION");
-                END IF;
-                IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
-           END;     -- (G)
- 
-           BEGIN     -- (H)
-                P2 (REC.A (2..4), REC.B (2..4));
-                IF REC.A /= (TRUE, TRUE, FALSE, FALSE, FALSE) THEN
-                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
-                END IF;
-                IF REC.B /= (FALSE, TRUE, TRUE, TRUE, FALSE) THEN
-                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
-           END;     -- (H)
- 
-           BEGIN     -- (I)
-                P3 (REC.A (0..2), REC.B (1..3));
-                IF REC.A /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
-                     FAILED ("OUT PARAM RETURNED INCORRECTLY");
-                END IF;
-                IF REC.B /= (TRUE, TRUE, TRUE, TRUE, FALSE) THEN
-                     FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
-           END;     -- (I)
- 
-      END; -- (E)
- 
-      RESULT;
- END C64109K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64109l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64109l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C64109L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
- --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
- --       (F) CHECK THAT A FORMAL PARAMETER CAN BE USED AS AN ACTUAL IN
- --       ANOTHER SUBPROGRAM CALL.
- 
- -- HISTORY:
- --    TBN 07/11/86          CREATED ORIGINAL TEST.
- --    JET 08/04/87          MODIFIED REC.A REFERENCES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C64109L IS
- 
- BEGIN
-      TEST ("C64109L", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
-                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
-                       "TO SUBPROGRAMS - FORMAL AS AN ACTUAL");
- 
-      DECLARE   -- (F)
- 
-           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           SUBTYPE ARRAY_SUBTYPE IS
-                     ARRAY_TYPE (IDENT_INT(1)..IDENT_INT(5));
-           TYPE RECORD_TYPE IS
-                RECORD
-                     I : INTEGER;
-                     A : ARRAY_SUBTYPE;
-                END RECORD;
-           REC : RECORD_TYPE := (I => 23,
-                                 A => (1..3 => 7, 4..5 => 9));
-           BOOL : BOOLEAN;
- 
-           PROCEDURE P_CALLED (A : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                IF A /= (7, 7, 7) THEN
-                     FAILED ("IN OUT PARAM NOT RECEIVED CORRECTLY");
-                END IF;
-                IF A'FIRST /= 1 OR A'LAST /= IDENT_INT(3) THEN
-                     FAILED ("BOUNDS WRONG - IN OUT");
-                END IF;
-                A := (A'RANGE => 6);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P_CALLED");
-           END P_CALLED;
- 
-           PROCEDURE P (A : IN OUT ARRAY_TYPE) IS
-           BEGIN
-                P_CALLED (A);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P");
-           END P;
- 
-           FUNCTION F_CALLED (A : ARRAY_TYPE) RETURN BOOLEAN IS
-                GOOD : BOOLEAN;
-           BEGIN
-                GOOD := (A = (6, 9, 9));
-                IF NOT GOOD THEN
-                     FAILED ("IN PARAMETER NOT RECEIVED CORRECTLY");
-                END IF;
-                IF A'FIRST /= 3 OR A'LAST /= IDENT_INT(5) THEN
-                     FAILED ("BOUNDS WRONG - FUNCTION");
-                END IF;
-                RETURN GOOD;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN FUNCTION F_CALLED");
-           END F_CALLED;
- 
-           FUNCTION F (A : ARRAY_TYPE) RETURN BOOLEAN IS
-           BEGIN
-                RETURN (F_CALLED (A));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN FUNCTION F");
-           END F;
- 
-           PROCEDURE P_OUT_CALLED (A : OUT ARRAY_TYPE) IS
-           BEGIN
-                IF A'FIRST /= IDENT_INT(2) OR A'LAST /= 4 THEN
-                     FAILED ("BOUNDS WRONG - OUT");
-                END IF;
-                A := (8, 8, 8);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE " &
-                                  "P_OUT_CALLED");
-           END P_OUT_CALLED;
- 
-           PROCEDURE P_OUT (A : OUT ARRAY_TYPE) IS
-           BEGIN
-                P_OUT_CALLED (A);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN PROCEDURE P_OUT");
-           END P_OUT;
- 
-      BEGIN     -- (F)
- 
-           BEGIN     -- (G)
-                P (REC.A (1..3));
-                IF REC.A /= (6, 6, 6, 9, 9) THEN
-                     FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P");
-           END;     -- (G)
- 
-           BEGIN     -- (H)
-                BOOL := F (REC.A (3..5));
-                IF NOT BOOL THEN
-                     FAILED ("IN PARAM NOT RETURNED CORRECTLY");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF F");
-           END;     -- (H)
- 
-           BEGIN     -- (I)
-                P_OUT (REC.A (2..4));
-                IF REC.A /= (6, 8, 8, 8, 9) THEN
-                     FAILED ("OUT PARAM NOT RETURNED CORRECTLY - 2");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED DURING CALL OF P_OUT");
-           END;     -- (I)
- 
-      END; -- (F)
- 
-      RESULT;
- END C64109L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64201b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64201b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64201b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C64201B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INITALIZATION OF IN PARAMETERS OF A TASK
- -- TYPE IS PERMITTED.
- -- (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
- 
- -- CVP 5/14/81
- -- ABW 7/1/82
- -- BHS 7/9/84
- 
- WITH REPORT;
- PROCEDURE C64201B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "C64201B" , "CHECK THAT INITIALIZATION OF IN PARAMETERS " &
-                        "OF A TASK TYPE IS PERMITTED" );
- 
-      DECLARE
- 
-           GLOBAL : INTEGER := 10;
- 
-           TASK TYPE T_TYPE IS
-                ENTRY E (X : IN OUT INTEGER);
-           END;
- 
-           TSK1, TSK2 : T_TYPE;
- 
-           TASK BODY T_TYPE IS
-           BEGIN
-                ACCEPT E (X : IN OUT INTEGER) DO
-                     X := X - 1;
-                END E;
-                ACCEPT E (X : IN OUT INTEGER) DO
-                     X := X + 1;
-                END E;
-           END T_TYPE;
- 
- 
-           PROCEDURE PROC1 (T : T_TYPE := TSK1) IS
-           BEGIN
-                T.E (X => GLOBAL);
-           END PROC1;
- 
-           PROCEDURE PROC2 (T : T_TYPE := TSK1) IS
-           BEGIN
-                T.E (X => GLOBAL);
-                IF (GLOBAL /= IDENT_INT(8)) THEN
-                     FAILED( "TASK NOT PASSED IN PROC1, " &
-                             "DEFAULT TSK1 EMPLOYED" );
-                END IF;
-           END PROC2;
- 
-           PROCEDURE TERM (T : T_TYPE; NUM : CHARACTER) IS
-           BEGIN
-                IF NOT T'TERMINATED THEN
-                     ABORT T;
-                     COMMENT ("ABORTING TASK " & NUM);
-                END IF;
-           END TERM;
- 
-      BEGIN
- 
-           PROC1(TSK2);
-           IF GLOBAL /= 9 THEN
-                FAILED ("INCORRECT GLOBAL VALUE AFTER PROC1");
-           ELSE
-                PROC2;
-           END IF;
- 
-           TERM(TSK1, '1');
-           TERM(TSK2, '2');
-      END;
- 
-      RESULT;
- 
- END C64201B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64201c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64201c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64201c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64201c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- C64201C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INITIALIZATION OF IN PARAMETERS OF A COMPOSITE
- --   TYPE HAVING AT LEAST ONE COMPONENT (INCLUDING COMPONENTS
- --   OF COMPONENTS) OF A TASK TYPE IS PERMITTED.
- --  (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
- 
- -- CVP 5/14/81
- -- ABW 7/1/82
- -- BHS 7/9/84
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C64201C IS
- 
- 
-      GLOBAL : INTEGER := 10;
- 
- 
-      TASK TYPE T IS
-           ENTRY E (X : IN OUT INTEGER);
-      END;
- 
-      TYPE REC_T IS
-           RECORD
-                TT : T;
-                BB : BOOLEAN := TRUE;
-           END RECORD;
- 
-      TYPE REC_REC_T IS
-           RECORD
-                RR : REC_T;
-           END RECORD;
- 
-      TYPE ARR_T IS ARRAY (1 .. 2) OF T;
- 
-      TYPE ARR_REC_T IS ARRAY (1 .. 2) OF REC_T;
- 
-      RT1, RT2   : REC_T;
-      RRT1, RRT2 : REC_REC_T;
-      AT1, AT2   : ARR_T;
-      ART1, ART2 : ARR_REC_T;
- 
-      
-      TASK BODY T IS
-      BEGIN
-           ACCEPT E (X : IN OUT INTEGER) DO
-                X := X - 1;
-           END E;
-           ACCEPT E (X : IN OUT INTEGER) DO
-                X := X + 1;
-           END E;
-      END T;
- 
- 
-      PROCEDURE PROC1A (P1X : REC_T := RT1) IS
-      BEGIN
-           IF P1X.BB THEN                 -- EXPECT RT2 PASSED.
-                FAILED( "RECORD OF TASK NOT PASSED, DEFAULT EMPLOYED" );
-           END IF;
-      END PROC1A;
- 
-      PROCEDURE PROC1B (P1X : REC_T := RT1) IS
-      BEGIN
-           IF NOT P1X.BB THEN             -- EXPECT DEFAULT USED.
-                FAILED( "DEFAULT RECORD OF TASK NOT EMPLOYED" );
-           END IF;
-      END PROC1B;
- 
- 
-      PROCEDURE PROC2A (P2X : REC_REC_T := RRT1) IS
-      BEGIN
-           IF P2X.RR.BB THEN             -- EXPECT RRT2 PASSED.
-                FAILED( "RECORD OF RECORD OF TASK NOT PASSED, " &
-                        "DEFAULT EMPLOYED" );
-           END IF;
-      END PROC2A;
- 
-      PROCEDURE PROC2B (P2X : REC_REC_T := RRT1) IS
-      BEGIN
-           IF NOT P2X.RR.BB THEN         -- EXPECT DEFAULT USED.
-                FAILED( "DEFAULT RECORD OF RECORD OF TASK " &
-                        "NOT EMPLOYED" );
-           END IF;
-      END PROC2B;
- 
- 
-      PROCEDURE PROC3 (P3X : ARR_T := AT1) IS
-      BEGIN
-           P3X(1).E (X => GLOBAL);        -- CALL TO AT2(1).E,
-                                          -- GLOBAL => GLOBAL - 1.
-      END PROC3;
- 
-      PROCEDURE PROC4 (P4X : ARR_T := AT1) IS
-      BEGIN
-           P4X(1).E (X => GLOBAL);     -- CALL TO DEFAULT AT1(1).E,
-                                       -- GLOBAL => GLOBAL - 1.
-           IF GLOBAL /= IDENT_INT(8) THEN
-                FAILED( "ARRAY OF TASKS NOT PASSED " &
-                        "CORRECTLY IN PROC3" );
-           END IF;
-      END PROC4;
- 
-      PROCEDURE PROC5 (P5X : ARR_REC_T := ART1) IS
-      BEGIN
-           P5X(1).TT.E (X => GLOBAL);      -- CALL TO ART2(1).TT.E,
-                                           -- GLOBAL => GLOBAL - 1.
-      END PROC5;
- 
-      PROCEDURE PROC6 (P6X : ARR_REC_T := ART1) IS
-      BEGIN
-           P6X(1).TT.E (X => GLOBAL);      -- CALL DEFAULT ART1(1).TT.E,
-                                           -- GLOBAL => GLOBAL - 1.
-           IF GLOBAL /= IDENT_INT(8) THEN
-                FAILED( "ARRAY OF RECORDS OF TASKS NOT " &
-                        "PASSED IN PROC5" );
-           END IF;
-      END PROC6;
- 
-      PROCEDURE TERM (TSK : T; NUM : CHARACTER) IS
-      BEGIN
-           IF NOT TSK'TERMINATED THEN
-                ABORT TSK;
-                COMMENT ("ABORTING TASK " & NUM);
-           END IF;
-      END TERM;
- 
- 
- BEGIN
- 
-      TEST( "C64201C" , "CHECK THAT INITIALIZATION OF IN " &
-                        "PARAMETERS OF A COMPOSITE TYPE " &
-                        "IS PERMITTED" );
- 
-      RT2.BB := FALSE;
-      RRT2.RR.BB := FALSE;
- 
-      PROC1A(RT2);                               -- NO ENTRY CALL
-      PROC1B;                                    -- NO ENTRY CALL
-      PROC2A(RRT2);                              -- NO ENTRY CALL
-      PROC2B;                                    -- NO ENTRY CALL
- 
-      PROC3(AT2);                                -- CALL AT2(1).E
-      IF GLOBAL /= 9 THEN
-           FAILED ("INCORRECT GLOBAL VALUE AFTER PROC3");
-      ELSE
-           PROC4;                                -- CALL AT1(1).E
-      END IF;
- 
-      GLOBAL := 10;
-      PROC5(ART2);                              -- CALL ART2(1).TT.E
-      IF GLOBAL /= 9 THEN
-           FAILED ("INCORRECT GLOBAL VALUE AFTER PROC5");
-      ELSE
-           PROC6;                               -- CALL ART1(1).TT.E
-      END IF;
- 
- -- MAKE SURE ALL TASKS TERMINATED
-      TERM (RT1.TT, '1');
-      TERM (RT2.TT, '2');
-      TERM (RRT1.RR.TT, '3');
-      TERM (RRT2.RR.TT, '4');
-      TERM (AT1(1), '5');
-      TERM (AT2(1), '6');
-      TERM (AT1(2), '7');
-      TERM (AT2(2), '8');
-      TERM (ART1(1).TT, '9');
-      TERM (ART2(1).TT, 'A');
-      TERM (ART1(2).TT, 'B');
-      TERM (ART2(2).TT, 'C');
- 
-      RESULT;
- 
- END C64201C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64202a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c64202a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c64202a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C64202A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE DEFAULT EXPRESSIONS OF FORMAL PARAMETERS ARE EVALUATED
- -- EACH TIME THEY ARE NEEDED.
- 
- -- SPS 2/22/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C64202A IS
- BEGIN
- 
-      TEST ("C64202A", "CHECK THAT THE DEFAULT EXPRESSION IS EVALUATED" &
-            " EACH TIME IT IS NEEDED");
- 
-      DECLARE
-           X : INTEGER := 1;
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                X := X + 1;
-                RETURN X;
-           END F;
- 
-           PROCEDURE P (CALL : POSITIVE; X, Y : INTEGER := F) IS 
-           BEGIN
-                IF CALL = 1 THEN
-                     IF X = Y OR Y /= 2 THEN
-                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - 1" &
-                                  " X =" & INTEGER'IMAGE(X) & " Y =" &
-                                  INTEGER'IMAGE(Y));
-                     END IF;
-                ELSIF CALL = 2 THEN
-                     IF X = Y OR 
-                        NOT ((X = 3 AND Y = 4) OR (X = 4 AND Y = 3)) THEN
-                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - 2" &
-                                  " X =" & INTEGER'IMAGE(X) & " Y =" &
-                                  INTEGER'IMAGE(Y));
-                     END IF;
-                END IF;
-           END P;
- 
-      BEGIN
-           COMMENT ("FIRST CALL");
-           P (1, 3);
-           COMMENT ("SECOND CALL");
-           P(2);
-      END;
- 
-      RESULT;
- 
- END C64202A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c650001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c650001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c650001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c650001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,412 ****
- -- C650001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for a function result type that is a return-by-reference
- --      type, Program_Error is raised if the return expression is a name that
- --      denotes an object view whose accessibility level is deeper than that
- --      of the master that elaborated the function body.
- --      
- --      Check for cases where the result type is:
- --         (a) A tagged limited type.
- --         (b) A task type.
- --         (c) A protected type.
- --         (d) A composite type with a subcomponent of a
- --             return-by-reference type (task type).
- --      
- -- TEST DESCRIPTION:
- --      The accessibility level of the master that elaborates the body of a
- --      return-by-reference function will always be less deep than that of
- --      the function (which is itself a master). 
- --
- --      Thus, the return object may not be any of the following, since each
- --      has an accessibility level at least as deep as that of the function:
- --
- --         (1) An object declared local to the function. 
- --         (2) The result of a local function.           
- --         (3) A parameter of the function.              
- --
- --      Verify that Program_Error is raised within the return-by-reference
- --      function if the return object is any of (1)-(3) above, for various
- --      subsets of the return types (a)-(d) above. Include cases where (1)-(3)
- --      are operands of parenthesized expressions.
- --
- --      Verify that no exception is raised if the return object is any of the
- --      following:
- --
- --         (4) An object declared at a less deep level than that of the
- --             master that elaborated the function body.
- --         (5) The result of a function declared at the same level as the
- --             original function (assuming the new function is also legal).
- --         (6) A parameter of the master that elaborated the function body.
- --
- --      For (5), pass the new function as an actual via an access-to-
- --      subprogram parameter of the original function. Check for cases where
- --      the new function does and does not raise an exception.
- --
- --      Since the functions to be tested cannot be part of an assignment
- --      statement (since they return values of a limited type), pass each
- --      function result as an actual parameter to a dummy procedure, e.g.,
- --
- --         Dummy_Proc ( Function_Call );
- --
- --
- -- CHANGE HISTORY:
- --      03 May 95   SAIC    Initial prerelease version.
- --      08 Feb 99   RLB     Removed subcase with two errors.
- --
- --!
- 
- package C650001_0 is
- 
-    type Tagged_Limited is tagged limited record
-       C: String (1 .. 10);
-    end record;
- 
-    task type Task_Type;
- 
-    protected type Protected_Type is
-       procedure Op;
-    end Protected_Type;
- 
-    type Task_Array is array (1 .. 10) of Task_Type;
- 
-    type Variant_Record (Toggle: Boolean) is record
-       case Toggle is
-          when True  =>
-             T: Task_Type;  -- Return-by-reference component.
-          when False =>
-             I: Integer;    -- Non-return-by-reference component.
-       end case;
-    end record;
- 
-    -- Limited type even though variant contains no limited components:
-    type Non_Task_Variant is new Variant_Record (Toggle => False);
- 
- end C650001_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C650001_0 is
- 
-    task body Task_Type is
-    begin
-       null;
-    end Task_Type;
- 
-    protected body Protected_Type is
-       procedure Op is
-       begin
-          null;
-       end Op;
-    end Protected_Type;
- 
- end C650001_0;
- 
- 
-      --==================================================================--
- 
- 
- with C650001_0;
- package C650001_1 is
- 
-    type TC_Result_Kind is (OK, P_E, O_E);
- 
-    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
-                                  Expected: in TC_Result_Kind;
-                                  Message : in String);
- 
-    -- Dummy procedures:
- 
-    procedure Check_Tagged    (P: C650001_0.Tagged_Limited);
-    procedure Check_Task      (P: C650001_0.Task_Type);
-    procedure Check_Protected (P: C650001_0.Protected_Type);
-    procedure Check_Composite (P: C650001_0.Non_Task_Variant);
- 
- end C650001_1;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C650001_1 is
- 
-    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
-                                  Expected: in TC_Result_Kind;
-                                  Message : in String) is
-    begin
-       if Actual /= Expected then
-          case Actual is
-             when OK  =>
-                Report.Failed ("No exception raised: "         & Message);
-             when P_E =>
-                Report.Failed ("Program_Error raised: "        & Message);
-             when O_E =>
-                Report.Failed ("Unexpected exception raised: " & Message);
-          end case;
-       end if;
-    end TC_Display_Results;
- 
- 
-    procedure Check_Tagged (P: C650001_0.Tagged_Limited) is
-    begin
-       null;
-    end;
- 
-    procedure Check_Task (P: C650001_0.Task_Type) is
-    begin
-       null;
-    end;
- 
-    procedure Check_Protected (P: C650001_0.Protected_Type) is
-    begin
-       null;
-    end;
- 
-    procedure Check_Composite (P: C650001_0.Non_Task_Variant) is
-    begin
-       null;
-    end;
- 
- end C650001_1;
- 
- 
- 
-      --==================================================================--
- 
- 
- with C650001_0;
- with C650001_1;
- 
- with Report;
- procedure C650001 is
- begin
- 
-    Report.Test ("C650001", "Check that, for a function result type that " &
-                 "is a return-by-reference type, Program_Error is raised " &
-                 "if the return expression is a name that denotes an "     &
-                 "object view whose accessibility level is deeper than "   &
-                 "that of the master that elaborated the function body");
- 
- 
- 
-    SUBTEST1:
-    declare
- 
-       Result: C650001_1.TC_Result_Kind;
-       PO    : C650001_0.Protected_Type;
- 
-       function Return_Prot (P: C650001_0.Protected_Type)
-         return C650001_0.Protected_Type is
-       begin
-          Result := C650001_1.OK;
-          return P;                                     -- Formal parameter (3).
-       exception
-          when Program_Error =>
-             Result := C650001_1.P_E;                        -- Expected result.
-             return PO;
-          when others        =>
-             Result := C650001_1.O_E;
-             return PO;
-       end Return_Prot;
- 
-    begin  -- SUBTEST1.
-       C650001_1.Check_Protected ( Return_Prot(PO) );
-       C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #1");
-    exception
-       when others =>
-          Report.Failed ("SUBTEST #1: Unexpected exception in outer block");
-    end SUBTEST1;
- 
- 
- 
-    SUBTEST2:
-    declare
- 
-       Result: C650001_1.TC_Result_Kind;
-       Comp  : C650001_0.Non_Task_Variant;
- 
-       function Return_Composite return C650001_0.Non_Task_Variant is
-          Local: C650001_0.Non_Task_Variant;
-       begin
-          Result := C650001_1.OK;
-          return (Local);                     -- Parenthesized local object (1).
-       exception
-          when Program_Error =>
-             Result := C650001_1.P_E;                        -- Expected result.
-             return Comp;
-          when others        =>
-             Result := C650001_1.O_E;
-             return Comp;
-       end Return_Composite;
- 
-    begin -- SUBTEST2.
-       C650001_1.Check_Composite ( Return_Composite );
-       C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #2");
-    exception
-       when others =>
-          Report.Failed ("SUBTEST #2: Unexpected exception in outer block");
-    end SUBTEST2;
- 
- 
- 
-    SUBTEST3:
-    declare
- 
-       Result: C650001_1.TC_Result_Kind;
-       Tsk   : C650001_0.Task_Type;
-       TskArr: C650001_0.Task_Array;
- 
-       function Return_Task (P: C650001_0.Task_Array)
-         return C650001_0.Task_Type is
- 
-          function Inner return C650001_0.Task_Type is
-          begin
-             return P(P'First);           -- OK: should not raise exception (6).
-          exception
-             when Program_Error =>
-                Report.Failed ("SUBTEST #3: Program_Error incorrectly " &
-                               "raised within function Inner");
-                return Tsk;
-             when others        =>
-                Report.Failed ("SUBTEST #3: Unexpected exception " &
-                               "raised within function Inner");
-                return Tsk;
-          end Inner;
- 
-       begin -- Return_Task.
-          Result := C650001_1.OK;
-          return Inner;                           -- Call to local function (2).
-       exception
-          when Program_Error =>
-             Result := C650001_1.P_E;                        -- Expected result.
-             return Tsk;
-          when others        =>
-             Result := C650001_1.O_E;
-             return Tsk;
-       end Return_Task;
- 
-    begin -- SUBTEST3.
-       C650001_1.Check_Task ( Return_Task(TskArr) );
-       C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #3");
-    exception
-       when others =>
-          Report.Failed ("SUBTEST #3: Unexpected exception in outer block");
-    end SUBTEST3;
- 
- 
- 
-    SUBTEST4:
-    declare
- 
-       Result: C650001_1.TC_Result_Kind;
-       TagLim: C650001_0.Tagged_Limited;
- 
-       function Return_TagLim (P: C650001_0.Tagged_Limited'Class)
-         return C650001_0.Tagged_Limited is
-       begin
-          Result := C650001_1.OK;
-          return C650001_0.Tagged_Limited(P); -- Conversion of formal param (3).
-       exception
-          when Program_Error =>
-             Result := C650001_1.P_E;                        -- Expected result.
-             return TagLim;
-          when others        =>
-             Result := C650001_1.O_E;
-             return TagLim;
-       end Return_TagLim;
- 
-    begin -- SUBTEST4.
-       C650001_1.Check_Tagged ( Return_TagLim(TagLim) );
-       C650001_1.TC_Display_Results (Result, C650001_1.P_E,
-                                     "SUBTEST #4 (root type)");
-    exception
-       when others =>
-          Report.Failed ("SUBTEST #4: Unexpected exception in outer block");
-    end SUBTEST4;
- 
- 
- 
-    SUBTEST5:
-    declare
-       Tsk : C650001_0.Task_Type;
-    begin  -- SUBTEST5.
- 
-       declare
-          Result: C650001_1.TC_Result_Kind;
- 
-          type AccToFunc is access function return C650001_0.Task_Type;
- 
-          function Return_Global return C650001_0.Task_Type is
-          begin
-             return Tsk;                  -- OK: should not raise exception (4).
-          end Return_Global;
- 
-          function Return_Local return C650001_0.Task_Type is
-             Local : C650001_0.Task_Type;
-          begin
-             return Local;                           -- Propagate Program_Error.
-          end Return_Local;
- 
- 
-          function Return_Func (P: AccToFunc) return C650001_0.Task_Type is
-          begin
-             Result := C650001_1.OK;
-             return P.all;                                 -- Function call (5).
-          exception
-             when Program_Error =>
-                Result := C650001_1.P_E;
-                return Tsk;
-             when others        =>
-                Result := C650001_1.O_E;
-                return Tsk;
-          end Return_Func;
- 
-          RG : AccToFunc := Return_Global'Access;
-          RL : AccToFunc := Return_Local'Access;
- 
-       begin
-          C650001_1.Check_Task ( Return_Func(RG) );
-          C650001_1.TC_Display_Results (Result, C650001_1.OK,
-                                        "SUBTEST #5 (global task)");
- 
-          C650001_1.Check_Task ( Return_Func(RL) );
-          C650001_1.TC_Display_Results (Result, C650001_1.P_E,
-                                        "SUBTEST #5 (local task)");
-       exception
-          when others =>
-             Report.Failed ("SUBTEST #5: Unexpected exception in outer block");
-       end;
- 
-    end SUBTEST5;
- 
- 
- 
-    Report.Result;
- 
- end C650001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c65003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c65003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c65003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c65003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C65003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF NO RETURN STATEMENT IS EXECUTED, A FUNCTION RAISES
- -- PROGRAM_ERROR.  DETERMINE WHERE THE EXCEPTION IS RAISED.
- 
- -- THIS LACK OF AN EXECUTABLE RETURN IS DETECTABLE AT COMPILE TIME IN
- -- THIS TEST.
- 
- -- JBG 10/14/83
- -- SPS 2/22/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C65003A IS
- 
-      EXCEPTION_RAISED : BOOLEAN := FALSE;
-      FUNCTION RETURN_IN_EXCEPTION RETURN INTEGER IS
-      BEGIN
-           IF FALSE THEN
-                RETURN 5;
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED IN FUNCTION BODY - " &
-                         "RETURN_IN_EXCEPTION");
-                EXCEPTION_RAISED := TRUE;
-                RETURN 5;
-      END RETURN_IN_EXCEPTION;
- 
-      FUNCTION NO_RETURN RETURN INTEGER IS
-           NO_RETURN_EXCEPTION : EXCEPTION;
-      BEGIN
-           RAISE NO_RETURN_EXCEPTION;
-           RETURN 5;
-      EXCEPTION
-           WHEN NO_RETURN_EXCEPTION =>
-                NULL;
-      END NO_RETURN;
- 
- BEGIN
- 
-      TEST ("C65003A", "CHECK THAT PROGRAM_ERROR IS RAISED IF A " &
-                       "FUNCTION RETURNS WITHOUT EXECUTING A RETURN " &
-                       "STATEMENT");
- 
-      BEGIN
- 
-           IF RETURN_IN_EXCEPTION = RETURN_IN_EXCEPTION THEN
-                IF NOT EXCEPTION_RAISED THEN
-                     FAILED ("PROGRAM_ERROR NOT RAISED - " &
-                             "RETURN_IN_EXCEPTION");
-                END IF;
-           END IF;
- 
-      EXCEPTION
-      
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED AT POINT OF CALL " &
-                         "- RETURN_IN_EXCEPTION");
- 
-      END;
- 
- 
-      BEGIN
- 
-           IF NO_RETURN = NO_RETURN THEN
-                FAILED ("PROGRAM_ERROR NOT RAISED - NO_RETURN");
-           END IF;
- 
-      EXCEPTION
-      
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED WHEN NO RETURN IN " &
-                         "EXCEPTION HANDLER");
-      END;
- 
-      RESULT;
- 
- END C65003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c65003b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c65003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c65003b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c65003b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C65003B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF NO RETURN STATEMENT IS EXECUTED, A FUNCTION RAISES
- -- PROGRAM_ERROR.  DETERMINE WHERE THE EXCEPTION IS RAISED.
- 
- -- THIS LACK OF AN EXECUTABLE RETURN IS NOT DETECTABLE AT COMPILE TIME.
- 
- -- JBG 10/14/83
- -- SPS 2/22/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C65003B IS
- 
-      EXCEPTION_RAISED : BOOLEAN := FALSE;
- 
-      FUNCTION RETURN_IN_EXCEPTION RETURN INTEGER IS
-      BEGIN
-           WHILE NOT EQUAL (1, 1) LOOP
-                RETURN 5;
-           END LOOP;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED IN FUNCTION BODY");
-                EXCEPTION_RAISED := TRUE;
-                RETURN 5;
-      END RETURN_IN_EXCEPTION;
- 
- BEGIN
- 
-      TEST ("C65003B", "CHECK THAT PROGRAM_ERROR IS RAISED IF A " &
-                       "FUNCTION RETURNS WITHOUT EXECUTING A RETURN " &
-                       "STATEMENT");
- 
-      BEGIN
- 
-           IF RETURN_IN_EXCEPTION = RETURN_IN_EXCEPTION THEN
-                IF NOT EXCEPTION_RAISED THEN
-                     FAILED ("PROGRAM_ERROR NOT RAISED");
-                END IF;
-           END IF;
- 
-      EXCEPTION
-      
-           WHEN PROGRAM_ERROR =>
-                COMMENT ("PROGRAM_ERROR RAISED AT POINT OF CALL");
- 
-      END;
- 
-      RESULT;
- 
- END C65003B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C66002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (A) ONE SUBPROGRAM IS A FUNCTION; THE OTHER IS A PROCEDURE.
- 
- -- CVP 5/4/81
- -- JRK 5/8/81
- -- NL 10/13/81
- -- SPS 11/2/82
- 
- WITH REPORT;
- PROCEDURE C66002A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C66002A", "SUBPROGRAM OVERLOADING WITH " &
-            "MINIMAL DIFFERENCES ALLOWED");
- 
-      --------------------------------------------------
- 
-      -- ONE SUBPROGRAM IS A PROCEDURE; THE OTHER IS
-      -- A FUNCTION. BOTH PARAMETERIZED AND PARAMETERLESS
-      -- SUBPROGRAMS ARE TESTED.
- 
-      DECLARE
-           I, J, K : INTEGER := 0;
-           S : STRING (1..2) := "12";
- 
-           PROCEDURE P1 (I1, I2 : INTEGER) IS
-           BEGIN
-                S(1) := 'A';
-           END P1;
- 
-           FUNCTION P1 (I1, I2 : INTEGER) RETURN INTEGER IS
-           BEGIN
-                S(2) := 'B';
-                RETURN I1; -- RETURNED VALUE IS IRRELEVENT.
-           END P1;
- 
-           PROCEDURE P2 IS
-           BEGIN
-                S(1) := 'C';
-           END P2;
- 
-           FUNCTION P2 RETURN INTEGER IS
-           BEGIN
-                S(2) := 'D';
-                RETURN I; -- RETURNED VALUE IS IRRELEVENT.
-           END P2;
- 
-      BEGIN
-           P1 (I, J);
-           K := P1 (I, J);
- 
-           IF S /= "AB" THEN
-                FAILED ("PARAMETERIZED OVERLOADED " &
-                        "SUBPROGRAMS, ONE A PROCEDURE AND " &
-                        "THE OTHER A FUNCTION, CAUSED " &
-                        "CONFUSION");
-           END IF;
- 
-           S := "12";
-           P2;
-           K := P2 ;
- 
-           IF S /= "CD" THEN 
-                FAILED ("PARAMETERLESS OVERLOADED " &
-                        "SUBPROGRAMS, ONE A PROCEDURE AND " &
-                        "THE OTHER A FUNCTION, CAUSED " &
-                        "CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C66002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C66002C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (C) ONE SUBPROGRAM HAS ONE LESS PARAMETER THAN THE OTHER.
- 
- -- CVP 5/4/81
- -- JRK 5/8/81
- -- NL 10/13/81
- 
- WITH REPORT;
- PROCEDURE C66002C IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C66002C", "SUBPROGRAM OVERLOADING WITH " &
-            "MINIMAL DIFFERENCES ALLOWED");
- 
-      --------------------------------------------------
- 
-      -- ONE PROCEDURE HAS ONE MORE PARAMETER
-      -- THAN THE OTHER.  THIS IS TESTED IN THE
-      -- CASE IN WHICH THAT PARAMETER HAS A DEFAULT
-      -- VALUE, AND THE CASE IN WHICH IT DOES NOT.
- 
-      DECLARE
-           I, J : INTEGER := 0;
-           B : BOOLEAN := TRUE;
-           S : STRING (1..2) := "12";
- 
-           PROCEDURE P1 (I1, I2 : INTEGER; B1 : IN OUT BOOLEAN) IS
-           BEGIN
-                S(1) := 'A';
-           END P1;
- 
-           PROCEDURE P1 (I1, I2 : INTEGER) IS
-           BEGIN
-                S(2) := 'B';
-           END P1;
- 
-           PROCEDURE P2 (B1 : IN OUT BOOLEAN; I1 : INTEGER := 0) IS
-           BEGIN
-                S(1) := 'C';
-           END P2;
- 
-           PROCEDURE P2 (B1 : IN OUT BOOLEAN) IS
-           BEGIN
-                S(2) := 'D';
-           END P2;
- 
-      BEGIN
-           P1 (I, J, B);
-           P1 (I, J);
- 
-           IF S /= "AB" THEN
-                FAILED ("PROCEDURES DIFFERING ONLY IN " &
-                        "NUMBER OF PARAMETERS (NO DEFAULTS) " &
-                        "CAUSED CONFUSION");
-           END IF;
- 
-           S := "12";
-           P2 (B, I);
-           -- NOTE THAT A CALL TO P2 WITH ONLY
-           -- ONE PARAMETER IS AMBIGUOUS.
- 
-           IF S /= "C2" THEN
-                FAILED ("PROCEDURES DIFFERING ONLY IN " &
-                        "EXISTENCE OF ONE PARAMETER (WITH " &
-                        "DEFAULT) CAUSED CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C66002C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C66002D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (D) THE BASE TYPE OF A PARAMETER IS DIFFERENT FROM THAT
- --         OF THE CORRESPONDING ONE.
- 
- -- CVP 5/4/81
- -- JRK 5/8/81
- -- NL 10/13/81
- 
- WITH REPORT;
- PROCEDURE C66002D IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C66002D", "SUBPROGRAM OVERLOADING WITH " &
-            "MINIMAL DIFFERENCES ALLOWED");
- 
-      --------------------------------------------------
- 
-      -- THE BASE TYPE OF ONE PARAMETER IS
-      -- DIFFERENT FROM THAT OF THE CORRESPONDING
-      -- ONE.
- 
-      DECLARE
-           I, J, K : INTEGER := 0;
-           B : BOOLEAN;
-           S : STRING (1..2) := "12";
- 
-           PROCEDURE P (I1 : INTEGER; BI : OUT BOOLEAN;
-                        I2 : IN OUT INTEGER) IS
-           BEGIN
-                S(1) := 'A';
-                BI := TRUE; -- THIS VALUE IS IRRELEVENT.
-           END P;
- 
-           PROCEDURE P (I1 : INTEGER; BI : OUT INTEGER;
-                I2 : IN OUT INTEGER) IS
-           BEGIN
-                S(2) := 'B';
-                BI := 0; -- THIS VALUE IS IRRELEVENT.
-           END P;
- 
-      BEGIN
-           P (I, B, K);
-           P (I, J, K);
- 
-           IF S /= "AB" THEN
-                FAILED ("PROCEDURES DIFFERING ONLY BY " &
-                        "THE BASE TYPE OF A PARAMETER " &
-                        "CAUSED CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C66002D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C66002E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (E) ONE SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
- --         PART, THE OTHER IN AN INNER PART, AND THE PARAMETERS ARE 
- --         ORDERED DIFFERENTLY.
- 
- -- CVP 5/4/81
- -- JRK 5/8/81
- -- NL 10/13/81
- 
- WITH REPORT;
- PROCEDURE C66002E IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C66002E", "SUBPROGRAM OVERLOADING WITH " &
-            "MINIMAL DIFFERENCES ALLOWED");
- 
-      --------------------------------------------------
- 
-      -- ONE SUBPROGRAM IS DECLARED IN AN OUTER
-      -- DECLARATIVE PART, THE OTHER IN AN INNER
-      -- PART, AND THE PARAMETERS ARE ORDERED
-      -- DIFFERENTLY.
- 
-      DECLARE
-           S : STRING (1..2) := "12";
- 
-           PROCEDURE P (I1 : INTEGER; I2 : IN OUT INTEGER;
-                        B1 : BOOLEAN) IS
-           BEGIN
-                S(1) := 'A';
-           END P;
- 
-      BEGIN
-           DECLARE
-                I : INTEGER := 0;
- 
-                PROCEDURE P (B1 : BOOLEAN; I1 : INTEGER;
-                             I2 : IN OUT INTEGER) IS
-                BEGIN
-                     S(2) := 'B';
-                END P;
- 
-           BEGIN
-                P (5, I, TRUE);
-                P (TRUE, 5, I);
-                -- NOTE THAT A CALL IN WHICH ALL ACTUAL PARAMETERS 
-                -- ARE NAMED_ASSOCIATIONS IS AMBIGUOUS.
- 
-                IF S /= "AB" THEN
-                     FAILED ("PROCEDURES IN " &
-                             "ENCLOSING-ENCLOSED SCOPES " &
-                             "DIFFERING ONLY IN PARAMETER " &
-                             "TYPE ORDER CAUSED CONFUSION");
-                END IF;
-           END;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C66002E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C66002F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (F) ONE SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE PART,
- --         THE OTHER IN AN INNER PART, AND ONE HAS ONE MORE PARAMETER
- --         THAN THE OTHER; THE OMITTED PARAMETER HAS A DEFAULT VALUE.
- 
- -- CVP 5/4/81
- -- JRK 5/8/81
- -- NL 10/13/81
- 
- WITH REPORT;
- PROCEDURE C66002F IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C66002F", "SUBPROGRAM OVERLOADING WITH " &
-            "MINIMAL DIFFERENCES ALLOWED");
- 
-      --------------------------------------------------
- 
-      -- ONE SUBPROGRAM IS IN AN OUTER DECLARATIVE 
-      -- PART, THE OTHER IN AN INNER PART, AND ONE
-      -- HAS ONE MORE PARAMETER (WITH A DEFAULT
-      -- VALUE) THAN THE OTHER.
- 
-      BF : 
-      DECLARE
-           S : STRING (1..3) := "123";
- 
-           PROCEDURE P (I1, I2, I3 : INTEGER := 1) IS
-                C : CONSTANT STRING := "CXA";
-           BEGIN
-                S(I3) := C(I3);
-           END P;
- 
-           PROCEDURE ENCLOSE IS
-  
-                PROCEDURE P (I1, I2 : INTEGER := 1) IS
-                BEGIN
-                     S(2) := 'B';
-                END P;
- 
-           BEGIN -- ENCLOSE
-                P (1, 2, 3);
-                ENCLOSE.P (1, 2); -- NOTE THAT THESE CALLS
-                BF.P (1, 2);      -- MUST BE DISAMBIGUATED.
- 
-                IF S /= "CBA" THEN
-                     FAILED ("PROCEDURES IN ENCLOSING-" &
-                             "ENCLOSED SCOPES DIFFERING " &
-                             "ONLY IN EXISTENCE OF ONE " &
-                             "DEFAULT-VALUED PARAMETER CAUSED " &
-                             "CONFUSION");
-                END IF;
-           END ENCLOSE;
- 
-      BEGIN
-           ENCLOSE;
-      END BF;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C66002F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c66002g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c66002g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C66002G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (G) THE RESULT TYPE OF TWO FUNCTION DECLARATIONS IS DIFFERENT.
- 
- -- CVP 5/4/81
- -- JRK 5/8/81
- -- NL 10/13/81
- -- SPS 10/26/82
- 
- WITH REPORT;
- PROCEDURE C66002G IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C66002G", "SUBPROGRAM OVERLOADING WITH " &
-            "MINIMAL DIFFERENCES ALLOWED");
- 
-      --------------------------------------------------
- 
-      -- THE RESULT TYPES OF TWO FUNCTION
-      -- DECLARATIONS ARE DIFFERENT.
- 
-      DECLARE
-           I : INTEGER;
-           B : BOOLEAN;
-           S : STRING (1..2) := "12";
- 
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                S(1) := 'A';
-                RETURN IDENT_INT (0); -- THIS VALUE IS IRRELEVENT.
-           END F;
- 
-           FUNCTION F RETURN BOOLEAN IS
-           BEGIN
-                S(2) := 'B';
-                RETURN IDENT_BOOL (TRUE); -- THIS VALUE IS IRRELEVANT.
-           END F;
- 
-      BEGIN
-           I := F;
-           B := F;
- 
-           IF S /= "AB" THEN
-                FAILED ("FUNCTIONS DIFFERING ONLY IN " &
-                        "BASE TYPE OF RETURNED VALUE " &
-                        "CAUSED CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C66002G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,426 ****
- -- C67002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
- --   FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
- --   SUBTESTS ARE:
- --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
- --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
- --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
- --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
- --             WITH ONE PARAMETER.
- 
- -- CVP 5/7/81
- -- JRK 6/1/81
- -- CPP 6/25/84
- 
- WITH REPORT;
- PROCEDURE C67002A IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C67002A", "USE OF OPERATOR SYMBOLS IN " &
-            "(OVERLOADED) FUNCTION SPECIFICATIONS");
- 
-      -------------------------------------------------
- 
-      DECLARE -- (A)
-           PACKAGE EQU IS
-                TYPE  LP IS LIMITED PRIVATE;
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
-           PRIVATE
-                TYPE LP IS NEW INTEGER;
-           END EQU;
-           USE EQU;
- 
-           LP1, LP2 : LP;
- 
-           PACKAGE BODY EQU IS
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN LPA > LPB;
-                END "=";
-           BEGIN
-                LP1 := LP (IDENT_INT (7));
-                LP2 := LP (IDENT_INT (8));
-           END EQU;
- 
-      BEGIN -- (A)
-           IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
-              (LP1 = LP1) OR (LP2 /= LP1) THEN
-                FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (A)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (B)
-           FUNCTION "AND" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "AND";
- 
-      BEGIN -- (B)
-           IF (IDENT_INT (10) AND 1) /= 'G' OR
-              (5 AND 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (B)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (C)
-           FUNCTION "OR" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "OR";
- 
-      BEGIN -- (C)
-           IF (IDENT_INT (10) OR 1) /= 'G' OR
-              (5 OR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (C)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (D)
-           FUNCTION "XOR" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "XOR";
- 
-      BEGIN -- (D)
-           IF (IDENT_INT (10) XOR 1) /= 'G' OR
-              (5 XOR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (D)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (E)
-           FUNCTION "<" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "<";
- 
-      BEGIN -- (E)
-           IF (IDENT_INT (10) < 1) /= 'G' OR
-              (5 < 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (E)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (F)
-           FUNCTION "<=" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "<=";
- 
-      BEGIN -- (F)
-           IF (IDENT_INT (10) <= 1) /= 'G' OR
-              (5 <= 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (F)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (G)
-           FUNCTION ">" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END ">";
- 
-      BEGIN -- (G)
-           IF (IDENT_INT (10) > 1) /= 'G' OR
-              (5 > 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (G)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (H)
-           FUNCTION ">=" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END ">=";
- 
-      BEGIN -- (H)
-           IF (IDENT_INT (10) >= 1) /= 'G' OR
-              (5 >= 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (H)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (I)
-           FUNCTION "&" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "&";
- 
-      BEGIN -- (I)
-           IF (IDENT_INT (10) & 1) /= 'G' OR
-              (5 & 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (I)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (J)
-           FUNCTION "*" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "*";
- 
-      BEGIN -- (J)
-           IF (IDENT_INT (10) * 1) /= 'G' OR
-              (5 * 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (J)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (K)
-           FUNCTION "/" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "/";
- 
-      BEGIN -- (K)
-           IF (IDENT_INT (10) / 1) /= 'G' OR
-              (5 / 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (K)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (L)
-           FUNCTION "MOD" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "MOD";
- 
-      BEGIN -- (L)
-           IF (IDENT_INT (10) MOD 1) /= 'G' OR
-              (5 MOD 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (L)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (M)
-           FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "REM";
- 
-      BEGIN -- (M)
-           IF (IDENT_INT (10) REM 1) /= 'G' OR
-              (5 REM 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (M)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (N)
-           FUNCTION "**" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "**";
- 
-      BEGIN -- (N)
-           IF (IDENT_INT (10) ** 1) /= 'G' OR
-              (5 ** 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (N)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (O)
-           FUNCTION "+" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "+";
- 
-      BEGIN -- (O)
-           IF (IDENT_INT (10) + 1) /= 'G' OR
-              (5 + 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (O)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (P)
-           FUNCTION "-" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "-";
- 
-      BEGIN -- (P)
-           IF (IDENT_INT (10) - 1) /= 'G' OR
-              (5 - 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (P)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (Q)
-           FUNCTION "+" (I1 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 < IDENT_INT (0) THEN
-                     RETURN 'N';
-                ELSE RETURN 'P';
-                END IF;
-           END "+";
- 
-      BEGIN -- (Q)
-           IF (+ IDENT_INT(25) /= 'P') OR
-              (+ (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""+"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (Q)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (R)
-           FUNCTION "-" (I1 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 < IDENT_INT (0) THEN
-                     RETURN 'N';
-                ELSE RETURN 'P';
-                END IF;
-           END "-";
- 
-      BEGIN -- (R)
-           IF (- IDENT_INT(25) /= 'P') OR
-              (- (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""-"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (R)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (S)
-           FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 < IDENT_INT (0) THEN
-                     RETURN 'N';
-                ELSE RETURN 'P';
-                END IF;
-           END "NOT";
- 
-      BEGIN -- (S)
-           IF (NOT IDENT_INT(25) /= 'P') OR
-              (NOT (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""NOT"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (S)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (T)
-           FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 < IDENT_INT (0) THEN
-                     RETURN 'N';
-                ELSE RETURN 'P';
-                END IF;
-           END "ABS";
- 
-      BEGIN -- (T)
-           IF (ABS IDENT_INT(25) /= 'P') OR
-              (ABS (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""ABS"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (T)
- 
-      -------------------------------------------------
- 
-      RESULT;
- END C67002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,176 ****
- -- C67002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
- --   FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
- --   THIS TEST CHECKS THE CASE OF CERTAIN OPERATOR SYMBOLS.
- --   SUBTESTS ARE:
- --        (A) THROUGH (E): "AND", "OR", "XOR", "MOD", "REM"
- --            RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
- --        (F) AND (G): "NOT" AND "ABS", RESPECTIVELY,
- --             WITH ONE PARAMETER.
- 
- -- CPP 6/26/84
- 
- WITH REPORT;
- PROCEDURE C67002B IS
- 
-      USE REPORT;
- 
- BEGIN
-      TEST ("C67002B", "USE OF OPERATOR SYMBOLS IN " &
-            "(OVERLOADED) FUNCTION SPECIFICATIONS");
- 
-      -------------------------------------------------
- 
-      DECLARE -- (A)
-           FUNCTION "And" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "And";
- 
-      BEGIN -- (A)
-           IF (IDENT_INT (10) AND 1) /= 'G' OR
-              (5 AnD 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""And"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (A)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (B)
-           FUNCTION "or" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "or";
- 
-      BEGIN -- (B)
-           IF (IDENT_INT (10) Or 1) /= 'G' OR
-              (5 OR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""or"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (B)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (C)
-           FUNCTION "xOR" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "xOR";
- 
-      BEGIN -- (C)
-           IF (IDENT_INT (10) XoR 1) /= 'G' OR
-              (5 xOR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""xOR"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (C)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (D)
-           FUNCTION "mOd" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "mOd";
- 
-      BEGIN -- (D)
-           IF (IDENT_INT (10) MoD 1) /= 'G' OR
-              (5 moD 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""mOd"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (D)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (E)
-           FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 > I2 THEN
-                     RETURN 'G';
-                ELSE RETURN 'L';
-                END IF;
-           END "REM";
- 
-      BEGIN -- (E)
-           IF (IDENT_INT (10) rem 1) /= 'G' OR
-              (5 Rem 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (E)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (F)
-           FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 < IDENT_INT (0) THEN
-                     RETURN 'N';
-                ELSE RETURN 'P';
-                END IF;
-           END "NOT";
- 
-      BEGIN -- (F)
-           IF (Not IDENT_INT(25) /= 'P') OR
-              (noT (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""NOT"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (F)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (G)
-           FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER IS
-           BEGIN
-                IF I1 < IDENT_INT (0) THEN
-                     RETURN 'N';
-                ELSE RETURN 'P';
-                END IF;
-           END "ABS";
- 
-      BEGIN -- (G)
-           IF (abs IDENT_INT(25) /= 'P') OR
-              (Abs (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""ABS"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (T)
- 
-      -------------------------------------------------
- 
-      RESULT;
- END C67002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,548 ****
- -- C67002C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
- -- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
- -- THIS TEST CHECKS FORMAL SUBPROGRAM PARAMETERS.
- --   SUBTESTS ARE:
- --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
- --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
- --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
- --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
- --             WITH ONE PARAMETER.
- 
- -- CPP 6/26/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C67002C IS
- 
-      FUNCTION TWO_PARAMS (I1, I2 : INTEGER) RETURN CHARACTER IS
-      BEGIN
-           IF I1 > I2 THEN
-                RETURN 'G';
-           ELSE RETURN 'L';
-           END IF;
-      END TWO_PARAMS;
- 
-      FUNCTION ONE_PARAM (I1 : INTEGER) RETURN CHARACTER IS
-      BEGIN
-           IF I1 < IDENT_INT(0) THEN
-                RETURN 'N';
-           ELSE RETURN 'P';
-           END IF;
-      END ONE_PARAM;
- 
- BEGIN
-      TEST ("C67002C", "USE OF OPERATOR SYMBOLS IN " &
-            "(OVERLOADED) FUNCTION SPECIFICATIONS");
- 
-      -------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           PACKAGE EQU IS
-                TYPE  LP IS LIMITED PRIVATE;
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
-           PRIVATE
-                TYPE LP IS NEW INTEGER;
-           END EQU;
-           USE EQU;
- 
-           LP1, LP2 : LP;
- 
-           PACKAGE BODY EQU IS
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN LPA > LPB;
-                END "=";
-           BEGIN
-                LP1 := LP (IDENT_INT (7));
-                LP2 := LP (IDENT_INT (8));
-           END EQU;
- 
-           GENERIC
-                WITH FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
-                   (LP1 = LP1) OR (LP2 /= LP1) THEN
-                     FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE EQUAL IS NEW PKG ("=" => EQU."=");
- 
-      BEGIN -- (A)
-           NULL;
-      END; -- (A)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           GENERIC
-                WITH FUNCTION "AND" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) AND 1) /= 'G' OR
-                   (5 AND 10) /= 'L' THEN
-                    FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("AND" => TWO_PARAMS);
- 
-      BEGIN -- (B)
-           NULL;
-      END; -- (B)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           GENERIC
-                WITH FUNCTION "OR" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) OR 1) /= 'G' OR
-                   (5 OR 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("OR" => TWO_PARAMS);
- 
-      BEGIN -- (C)
-           NULL;
-      END; -- (C)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           GENERIC
-                WITH FUNCTION "XOR" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) XOR 1) /= 'G' OR
-                   (5 XOR 10) /= 'L' THEN
-                    FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("XOR" => TWO_PARAMS);
- 
-      BEGIN -- (D)
-           NULL;
-      END; -- (D)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (E)
- 
-           GENERIC
-                WITH FUNCTION "<" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) < 1) /= 'G' OR
-                   (5 < 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("<" => TWO_PARAMS);
- 
-      BEGIN -- (E)
-           NULL;
-      END; -- (E)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (F)
- 
-           GENERIC
-                WITH FUNCTION "<=" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) <= 1) /= 'G' OR
-                   (5 <= 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("<=" => TWO_PARAMS);
- 
-      BEGIN -- (F)
-           NULL;
-      END; -- (F)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (G)
- 
-           GENERIC
-                WITH FUNCTION ">" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) > 1) /= 'G' OR
-                   (5 > 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG (">" => TWO_PARAMS);
- 
-      BEGIN -- (G)
-           NULL;
-      END; -- (G)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (H)
- 
-           GENERIC
-                WITH FUNCTION ">=" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) >= 1) /= 'G' OR
-                   (5 >= 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG (">=" => TWO_PARAMS);
- 
-      BEGIN -- (H)
-           NULL;
-      END; -- (H)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (I)
- 
-           GENERIC
-                WITH FUNCTION "&" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) & 1) /= 'G' OR
-                   (5 & 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("&" => TWO_PARAMS);
- 
-      BEGIN -- (I)
-           NULL;
-      END; -- (I)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (J)
- 
-           GENERIC
-                WITH FUNCTION "*" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) * 1) /= 'G' OR
-                   (5 * 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("*" => TWO_PARAMS);
- 
-      BEGIN -- (J)
-           NULL;
-      END; -- (J)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (K)
- 
-           GENERIC
-                WITH FUNCTION "/" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) / 1) /= 'G' OR
-                   (5 / 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("/" => TWO_PARAMS);
- 
-      BEGIN -- (K)
-           NULL;
-      END; -- (K)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (L)
- 
-           GENERIC
-                WITH FUNCTION "MOD" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) MOD 1) /= 'G' OR
-                   (5 MOD 10) /= 'L' THEN
-                    FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("MOD" => TWO_PARAMS);
- 
-      BEGIN -- (L)
-           NULL;
-      END; -- (L)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (M)
- 
-           GENERIC
-                WITH FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) REM 1) /= 'G' OR
-                   (5 REM 10) /= 'L' THEN
-                    FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("REM" => TWO_PARAMS);
- 
-      BEGIN -- (M)
-           NULL;
-      END; -- (M)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (N)
- 
-           GENERIC
-                WITH FUNCTION "**" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) ** 1) /= 'G' OR
-                   (5 ** 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("**" => TWO_PARAMS);
- 
-      BEGIN -- (N)
-           NULL;
-      END; -- (N)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (O)
- 
-           GENERIC
-                WITH FUNCTION "+" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) + 1) /= 'G' OR
-                   (5 + 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("+" => TWO_PARAMS);
- 
-      BEGIN -- (O)
-           NULL;
-      END; -- (O)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (P)
- 
-           GENERIC
-                WITH FUNCTION "-" (I1, I2 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (IDENT_INT (10) - 1) /= 'G' OR
-                   (5 - 10) /= 'L' THEN
-                     FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("-" => TWO_PARAMS);
- 
-      BEGIN -- (P)
-           NULL;
-      END; -- (P)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (Q)
- 
-           GENERIC
-                WITH FUNCTION "+" (I1 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (+ IDENT_INT(25) /= 'P') OR
-                   (+ (0-25) /= 'N') THEN
-                     FAILED ("OVERLOADING OF ""+"" " &
-                             "OPERATOR (ONE OPERAND) DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("+" => ONE_PARAM);
- 
-      BEGIN -- (Q)
-           NULL;
-      END; -- (Q)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (R)
- 
-           GENERIC
-                WITH FUNCTION "-" (I1 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (- IDENT_INT(25) /= 'P') OR
-                   (- (0-25) /= 'N') THEN
-                     FAILED ("OVERLOADING OF ""-"" " &
-                             "OPERATOR (ONE OPERAND) DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("-" => ONE_PARAM);
- 
-      BEGIN -- (R)
-           NULL;
-      END; -- (R)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (S)
- 
-           GENERIC
-                WITH FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (NOT IDENT_INT(25) /= 'P') OR
-                   (NOT (0-25) /= 'N') THEN
-                     FAILED ("OVERLOADING OF ""NOT"" " &
-                             "OPERATOR (ONE OPERAND) DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("NOT" => ONE_PARAM);
- 
-      BEGIN -- (S)
-           NULL;
-      END; -- (S)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (T)
- 
-           GENERIC
-                WITH FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER;
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF (ABS IDENT_INT(25) /= 'P') OR
-                   (ABS (0-25) /= 'N') THEN
-                     FAILED ("OVERLOADING OF ""ABS"" " &
-                             "OPERATOR (ONE OPERAND) DEFECTIVE");
-                END IF;
-           END PKG;
- 
-           PACKAGE PACK IS NEW PKG ("ABS" => ONE_PARAM);
- 
-      BEGIN -- (T)
-           NULL;
-      END; -- (T)
- 
-      -------------------------------------------------
- 
-      RESULT;
- END C67002C;
-   
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,354 ****
- -- C67002D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
- -- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
- -- THIS TEST CHECKS GENERIC INSTANTIATIONS FOR THESE FUNCTIONS.
- --   SUBTESTS ARE:
- --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
- --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
- --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
- --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
- --             WITH ONE PARAMETER.
- 
- -- CPP 6/25/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C67002D IS
- 
-      GENERIC
-           TYPE ELEMENT IS (<>);
-      FUNCTION TWO_PARAMS (I1, I2 : ELEMENT) RETURN CHARACTER;
-      FUNCTION TWO_PARAMS (I1, I2 : ELEMENT) RETURN CHARACTER IS
-      BEGIN
-           IF I1 > I2 THEN
-                RETURN 'G';
-           ELSE RETURN 'L';
-           END IF;
-      END TWO_PARAMS;
- 
-      GENERIC
-           TYPE ELEMENT IS (<>);
-      FUNCTION ONE_PARAM (I1 : ELEMENT) RETURN CHARACTER;
-      FUNCTION ONE_PARAM (I1 : ELEMENT) RETURN CHARACTER IS
-      BEGIN
-           IF I1 < ELEMENT'VAL(IDENT_INT(0)) THEN
-                RETURN 'N';
-           ELSE RETURN 'P';
-           END IF;
-      END ONE_PARAM;
-      
- BEGIN
-      TEST ("C67002D", "USE OF OPERATOR SYMBOLS IN " &
-            "(OVERLOADED) FUNCTION SPECIFICATIONS");
- 
-      -------------------------------------------------
- 
-      DECLARE -- (A)
-           GENERIC
-                TYPE LP IS LIMITED PRIVATE;
-                WITH FUNCTION ">" (L, R : LP) RETURN BOOLEAN IS <>;
-           PACKAGE PKG IS
-                LP1, LP2 : LP;
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN LPA > LPB;
-                END "=";
-           END PKG;
- 
-      BEGIN -- (A)
-           DECLARE
-                PACKAGE PACK IS NEW PKG (LP => INTEGER);
-                USE PACK;
-                FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN
-                     RENAMES PACK."=";
-           BEGIN
-                LP1 := IDENT_INT(7);
-                LP2 := IDENT_INT(8);
-                IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
-                   (LP1 = LP1) OR (LP2 /= LP1) THEN
-                     FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
-                END IF;
-           END;
-      END; -- (A)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (B)
-           FUNCTION "AND" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (B)
-           IF (IDENT_INT (10) AND 1) /= 'G' OR
-              (5 AND 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (B)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (C)
-           FUNCTION "OR" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (C)
-           IF (IDENT_INT (10) OR 1) /= 'G' OR
-              (5 OR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (C)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (D)
-           FUNCTION "XOR" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (D)
-           IF (IDENT_INT (10) XOR 1) /= 'G' OR
-              (5 XOR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (D)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (E)
-           FUNCTION "<" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (E)
-           IF (IDENT_INT (10) < 1) /= 'G' OR
-              (5 < 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (E)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (F)
-           FUNCTION "<=" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (F)
-           IF (IDENT_INT (10) <= 1) /= 'G' OR
-              (5 <= 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (F)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (G)
-           FUNCTION ">" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (G)
-           IF (IDENT_INT (10) > 1) /= 'G' OR
-              (5 > 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (G)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (H)
-           FUNCTION ">=" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (H)
-           IF (IDENT_INT (10) >= 1) /= 'G' OR
-              (5 >= 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (H)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (I)
-           FUNCTION "&" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (I)
-           IF (IDENT_INT (10) & 1) /= 'G' OR
-              (5 & 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (I)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (J)
-           FUNCTION "*" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (J)
-           IF (IDENT_INT (10) * 1) /= 'G' OR
-              (5 * 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (J)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (K)
-           FUNCTION "/" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (K)
-           IF (IDENT_INT (10) / 1) /= 'G' OR
-              (5 / 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (K)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (L)
-           FUNCTION "MOD" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (L)
-           IF (IDENT_INT (10) MOD 1) /= 'G' OR
-              (5 MOD 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (L)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (M)
-           FUNCTION "REM" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (M)
-           IF (IDENT_INT (10) REM 1) /= 'G' OR
-              (5 REM 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (M)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (N)
-           FUNCTION "**" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (N)
-           IF (IDENT_INT (10) ** 1) /= 'G' OR
-              (5 ** 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (N)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (O)
-           FUNCTION "+" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (O)
-           IF (IDENT_INT (10) + 1) /= 'G' OR
-              (5 + 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (O)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (P)
-           FUNCTION "-" IS NEW TWO_PARAMS
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (P)
-           IF (IDENT_INT (10) - 1) /= 'G' OR
-              (5 - 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (P)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (Q)
-           FUNCTION "+" IS NEW ONE_PARAM
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (Q)
-           IF (+ IDENT_INT(25) /= 'P') OR
-              (+ (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""+"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (Q)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (R)
-           FUNCTION "-" IS NEW ONE_PARAM
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (R)
-           IF (- IDENT_INT(25) /= 'P') OR
-              (- (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""-"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (R)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (S)
-           FUNCTION "NOT" IS NEW ONE_PARAM
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (S)
-           IF (NOT IDENT_INT(25) /= 'P') OR
-              (NOT (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""NOT"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (S)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (T)
-           FUNCTION "ABS" IS NEW ONE_PARAM
-                (ELEMENT => INTEGER);
- 
-      BEGIN -- (T)
-           IF (ABS IDENT_INT(25) /= 'P') OR
-              (ABS (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""ABS"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (T)
- 
-      -------------------------------------------------
- 
-      RESULT;
- END C67002D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67002e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67002e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,348 ****
- -- C67002E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
- -- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
- -- THIS TEST CHECKS RENAMING DECLARATIONS FOR THESE FUNCTIONS.
- --   SUBTESTS ARE:
- --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
- --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
- --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
- --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
- --             WITH ONE PARAMETER.
- 
- -- CPP 6/26/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C67002E IS
- 
-      FUNCTION TWO_PARAMS (I1, I2 : INTEGER) RETURN CHARACTER IS
-      BEGIN
-           IF I1 > I2 THEN
-                RETURN 'G';
-           ELSE RETURN 'L';
-           END IF;
-      END TWO_PARAMS;
- 
-      FUNCTION ONE_PARAM (I1 : INTEGER) RETURN CHARACTER IS
-      BEGIN
-           IF I1 < IDENT_INT(0) THEN
-                RETURN 'N';
-           ELSE RETURN 'P';
-           END IF;
-      END ONE_PARAM;
- 
- BEGIN
-      TEST ("C67002E", "USE OF OPERATOR SYMBOLS IN " &
-            "(OVERLOADED) FUNCTION SPECIFICATIONS");
- 
-      -------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           PACKAGE PKG IS
-                TYPE LP IS LIMITED PRIVATE;
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
-           PRIVATE
-                TYPE LP IS NEW INTEGER;
-           END PKG;
-           USE PKG;
- 
-           LP1, LP2 : LP;
- 
-           FUNCTION "=" (LPA, LPB : LP)
-                RETURN BOOLEAN RENAMES PKG."=";
- 
-           PACKAGE BODY PKG IS
-                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN LPA > LPB;
-                END "=";
-           BEGIN
-                LP1 := LP (IDENT_INT (7));
-                LP2 := LP (IDENT_INT (8));
-           END PKG;
- 
-      BEGIN -- (A)
-           IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
-              (LP1 = LP1) OR (LP2 /= LP1) THEN
-                FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (A)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (B)
-           FUNCTION "AND" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (B)
-           IF (IDENT_INT (10) AND 1) /= 'G' OR
-              (5 AND 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (B)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (C)
-           FUNCTION "OR" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (C)
-           IF (IDENT_INT (10) OR 1) /= 'G' OR
-              (5 OR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (C)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (D)
-           FUNCTION "XOR" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (D)
-           IF (IDENT_INT (10) XOR 1) /= 'G' OR
-              (5 XOR 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (D)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (E)
-           FUNCTION "<" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (E)
-           IF (IDENT_INT (10) < 1) /= 'G' OR
-              (5 < 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (E)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (F)
-           FUNCTION "<=" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (F)
-           IF (IDENT_INT (10) <= 1) /= 'G' OR
-              (5 <= 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (F)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (G)
-           FUNCTION ">" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (G)
-           IF (IDENT_INT (10) > 1) /= 'G' OR
-              (5 > 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (G)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (H)
-           FUNCTION ">=" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (H)
-           IF (IDENT_INT (10) >= 1) /= 'G' OR
-              (5 >= 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (H)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (I)
-           FUNCTION "&" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (I)
-           IF (IDENT_INT (10) & 1) /= 'G' OR
-              (5 & 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (I)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (J)
-           FUNCTION "*" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (J)
-           IF (IDENT_INT (10) * 1) /= 'G' OR
-              (5 * 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (J)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (K)
-           FUNCTION "/" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (K)
-           IF (IDENT_INT (10) / 1) /= 'G' OR
-              (5 / 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (K)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (L)
-           FUNCTION "MOD" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (L)
-           IF (IDENT_INT (10) MOD 1) /= 'G' OR
-              (5 MOD 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (L)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (M)
-           FUNCTION "REM" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (M)
-           IF (IDENT_INT (10) REM 1) /= 'G' OR
-              (5 REM 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (M)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (N)
-           FUNCTION "**" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (N)
-           IF (IDENT_INT (10) ** 1) /= 'G' OR
-              (5 ** 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (N)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (O)
-           FUNCTION "+" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (O)
-           IF (IDENT_INT (10) + 1) /= 'G' OR
-              (5 + 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (O)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (P)
-           FUNCTION "-" (I1, I2 : INTEGER)
-                RETURN CHARACTER RENAMES TWO_PARAMS;
- 
-      BEGIN -- (P)
-           IF (IDENT_INT (10) - 1) /= 'G' OR
-              (5 - 10) /= 'L' THEN
-                FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
-           END IF;
-      END; -- (P)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (Q)
-           FUNCTION "+" (I1 : INTEGER)
-                RETURN CHARACTER RENAMES ONE_PARAM;
- 
-      BEGIN -- (Q)
-           IF (+ IDENT_INT(25) /= 'P') OR
-              (+ (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""+"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (Q)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (R)
-           FUNCTION "-" (I1 : INTEGER)
-                RETURN CHARACTER RENAMES ONE_PARAM;
- 
-      BEGIN -- (R)
-           IF (- IDENT_INT(25) /= 'P') OR
-              (- (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""-"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (R)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (S)
-           FUNCTION "NOT" (I1 : INTEGER)
-                RETURN CHARACTER RENAMES ONE_PARAM;
- 
-      BEGIN -- (S)
-           IF (NOT IDENT_INT(25) /= 'P') OR
-              (NOT (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""NOT"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (S)
- 
-      -------------------------------------------------
- 
-      DECLARE -- (T)
-           FUNCTION "ABS" (I1 : INTEGER)
-                RETURN CHARACTER RENAMES ONE_PARAM;
- 
-      BEGIN -- (T)
-           IF (ABS IDENT_INT(25) /= 'P') OR
-              (ABS (0-25) /= 'N') THEN
-                FAILED ("OVERLOADING OF ""ABS"" " &
-                        "OPERATOR (ONE OPERAND) DEFECTIVE");
-           END IF;
-      END; -- (T)
- 
-      -------------------------------------------------
- 
-      RESULT;
- END C67002E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67003f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67003f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67003f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67003f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,319 ****
- -- C67003F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE PREDEFINED OPERATORS FOR THE PREDEFINED TYPES CAN BE 
- --   REDEFINED.
- -- CHECK THAT THE REDEFINED OPERATOR IS INVOKED WHEN INFIX OR PREFIX
- --   NOTATION IS USED.
- 
- -- HISTORY:
- --   WMC 03/21/92   TEST CREATED FROM CONSOLIDATION OF C67003[A-E].ADA
- 
- 
- WITH REPORT;
- 
- PROCEDURE C67003F IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C67003F", "CHECK THAT REDEFINITION OF " &
-            "OPERATORS FOR PREDEFINED TYPES WORKS");
- 
-      DECLARE     -- INTEGER OPERATORS.
- 
-           -- INTEGER INFIX OPERATORS.
- 
-           FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF X /= Y THEN
-                     RETURN 1;
-                ELSE RETURN 0;
-                END IF;
-           END "*";
- 
-           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF X /= Y THEN
-                     RETURN 2;
-                ELSE RETURN 0;
-                END IF;
-           END "+";
-      
-           FUNCTION "REM" (X, Y : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF X /= Y THEN
-                     RETURN 3;
-                ELSE RETURN 0;
-                END IF;
-           END "REM";
-      
-           -- INTEGER PREFIX OPERATORS.
- 
-           FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF X /= 0 THEN
-                     RETURN 4;
-                ELSE RETURN 0;
-                END IF;
-           END "+";
- 
-           FUNCTION "ABS" (X : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF X /= 0 THEN
-                     RETURN 5;
-                ELSE RETURN 0;
-                END IF;
-           END "ABS";
- 
-           -- INTEGER RELATIONAL OPERATOR.
- 
-           FUNCTION "<" (X, Y : INTEGER) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END "<";
- 
-      BEGIN
- 
-           IF IDENT_INT (3) * IDENT_INT (5) /= 1 THEN
-                FAILED ("REDEFINITION OF INTEGER ""*"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_INT (1) + IDENT_INT (30) /= 2 THEN
-                FAILED ("REDEFINITION OF INTEGER ""+"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_INT (7) REM IDENT_INT (8) /= 3 THEN
-                FAILED ("REDEFINITION OF ""REM"" IS DEFECTIVE");
-           END IF;
- 
-           IF + (IDENT_INT (10)) /= 4 THEN
-                FAILED ("REDEFINITION OF INTEGER UNARY ""+"" IS DEFECTIVE");
-           END IF;
- 
-           IF ABS (IDENT_INT (2)) /= 5 THEN
-                FAILED ("REDEFINITION OF INTEGER ""ABS"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_INT (7) < IDENT_INT (8) THEN
-                FAILED ("REDEFINITION OF INTEGER ""<"" IS DEFECTIVE");
-           END IF;
- 
-      END;
- 
-      DECLARE   -- FLOAT OPERATORS.
- 
-           -- NOTE THAT ALL LITERAL VALUES USED SHOULD BE
-           --   REPRESENTABLE EXACTLY.
- 
-           FUNCTION IDENT_FLOAT (X : FLOAT) RETURN FLOAT IS
-              I : INTEGER := INTEGER (X);
-           BEGIN
-              IF EQUAL (I, I) THEN          -- ALWAYS EQUAL.
-                   RETURN X;
-              END IF;
-              RETURN 0.0;
-           END IDENT_FLOAT;
- 
-           -- FLOAT INFIX OPERATORS.
- 
-           FUNCTION "-" (X, Y : FLOAT) RETURN FLOAT IS
-           BEGIN
-                IF X /= Y THEN
-                     RETURN 1.0;
-                ELSE RETURN 0.0;
-                END IF;
-           END "-";
- 
-           FUNCTION "/" (X, Y : FLOAT) RETURN FLOAT IS
-           BEGIN
-                IF X /= Y THEN
-                     RETURN 2.0;
-                ELSE RETURN 0.0;
-                END IF;
-           END "/";
- 
-           FUNCTION "**" (X : FLOAT; Y : INTEGER) RETURN FLOAT IS
-           BEGIN
-                IF INTEGER (X) /= Y THEN
-                     RETURN 3.0;
-                ELSE RETURN 0.0;
-                END IF;
-           END "**";
- 
-           -- FLOAT PREFIX OPERATOR.
- 
-           FUNCTION "-" (X : FLOAT) RETURN FLOAT IS
-           BEGIN
-                IF X /= 0.0 THEN
-                     RETURN 4.0;
-                ELSE RETURN 0.0;
-                END IF;
-           END "-";
- 
-           -- FLOAT RELATIONAL OPERATOR.
- 
-           FUNCTION "<=" (X, Y : FLOAT) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END "<=";
- 
-      BEGIN
- 
-           IF IDENT_FLOAT (50.0) - IDENT_FLOAT (100.0) /= 1.0 THEN
-                FAILED ("REDEFINITION OF FLOAT ""-"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_FLOAT (5.0) / IDENT_FLOAT (1.0) /= 2.0 THEN
-                FAILED ("REDEFINITION OF FLOAT ""/"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_FLOAT (3.0) ** IDENT_INT (2) /= 3.0 THEN
-                FAILED ("REDEFINITION OF FLOAT ""**"" IS DEFECTIVE");
-           END IF;
- 
-           IF -(IDENT_FLOAT (5.0)) /= 4.0 THEN
-                FAILED ("REDEFINITION OF FLOAT UNARY ""-"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_FLOAT (1.0) <= IDENT_FLOAT (5.0) THEN
-                FAILED ("REDEFINITION OF FLOAT ""<="" IS DEFECTIVE");
-           END IF;
- 
-      END;
- 
-      DECLARE     -- BOOLEAN OPERATORS.
- 
-           -- BOOLEAN LOGICAL OPERATORS.
- 
-           FUNCTION "AND" (X, Y : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                IF X AND THEN Y THEN
-                     RETURN FALSE;
-                ELSE RETURN TRUE;
-                END IF;
-           END "AND";
- 
-           FUNCTION "XOR" (X, Y : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END "XOR";
- 
-           -- BOOLEAN RELATIONAL OPERATOR.
- 
-           FUNCTION ">" (X, Y : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END ">";
- 
-      BEGIN
- 
-           IF IDENT_BOOL (TRUE) AND IDENT_BOOL (TRUE) THEN
-                FAILED ("REDEFINITION OF ""AND"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_BOOL (TRUE) XOR IDENT_BOOL (FALSE) THEN
-                FAILED ("REDEFINITION OF ""XOR"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_BOOL (TRUE) > IDENT_BOOL (FALSE) THEN
-                FAILED ("REDEFINITION OF BOOLEAN "">"" IS DEFECTIVE");
-           END IF;
- 
-      END;
-     
-      DECLARE     -- STRING OPERATORS.
- 
-           S1 : STRING (1..2) := "A" & IDENT_CHAR ('B');
-           S2 : STRING (1..2) := "C" & IDENT_CHAR ('D');
- 
-           FUNCTION "&" (X, Y : STRING) RETURN STRING IS
-                Z : STRING (1 .. X'LENGTH + Y'LENGTH);
-           BEGIN
-                Z (1 .. Y'LENGTH) := Y;
-                Z (Y'LENGTH + 1 .. Z'LAST) := X;
-                RETURN Z;
-           END "&";
- 
-           FUNCTION "&" (X : CHARACTER; Y : STRING) RETURN STRING IS
-                Z : STRING (1 .. Y'LENGTH + 1);
-           BEGIN
-                Z (1 .. Y'LENGTH) := Y;
-                Z (Z'LAST) := X;
-                RETURN Z;
-           END "&";
- 
-           -- STRING RELATIONAL OPERATOR.
- 
-           FUNCTION ">=" (X, Y : STRING) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END ">=";
- 
-      BEGIN
- 
-           IF S1 & S2 /= "CDAB" THEN
-                FAILED ("BAD REDEFINITION OF ""&"" (S,S)");
-           END IF;
- 
-           IF IDENT_CHAR ('C') & S1 /= "ABC" THEN
-                FAILED ("BAD REDEFINITION OF ""&"" (C,S)");
-           END IF;
- 
-           IF S2 >= S1 THEN
-                FAILED ("BAD REDEFINITION OF STRING "">=""");
-           END IF;
- 
-      END;
- 
-      DECLARE      -- CHARACTER OPERATORS.
- 
-           -- CHARACTER RELATIONAL OPERATORS.
- 
-           FUNCTION ">" (X, Y : CHARACTER) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END ">";
- 
-           FUNCTION "<=" (X, Y : CHARACTER) RETURN BOOLEAN IS
-           BEGIN
-                RETURN X = Y;
-           END "<=";
- 
-      BEGIN
- 
-           IF IDENT_CHAR ('C') > IDENT_CHAR ('B') THEN
-                FAILED ("REDEFINITION OF CHARACTER "">"" IS DEFECTIVE");
-           END IF;
- 
-           IF IDENT_CHAR ('A') <= IDENT_CHAR ('E') THEN
-                FAILED ("REDEFINITION OF CHARACTER ""<="" IS DEFECTIVE");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C67003F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- C67005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK IF A RENAMING DECLARATION DECLARES AN EQUALITY OPERATOR, THE
- -- TYPES OF THE PARAMETERS NEED NOT BE LIMITED TYPES. 
- 
- -- JBG 9/28/83
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C67005A IS
- BEGIN
-      TEST ("C67005A", "CHECK THAT AN EQUALITY OPERATOR DECLARED BY " &
-                       "A RENAMING DECLARATION NEED NOT HAVE " &
-                       "PARAMETERS OF A LIMITED TYPE");
-      DECLARE
-           GENERIC
-                TYPE LP IS LIMITED PRIVATE;
-                WITH FUNCTION EQUAL (L, R : LP) RETURN BOOLEAN;
-           PACKAGE EQUALITY_OPERATOR IS
-                FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
-           END EQUALITY_OPERATOR;
- 
-           PACKAGE BODY EQUALITY_OPERATOR IS
-                FUNCTION "=" (L, R : LP) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN EQUAL(L, R);
-                END "=";
-           END EQUALITY_OPERATOR;
- 
-           PACKAGE POLAR_COORDINATES IS
-                TYPE POLAR_COORD IS
-                     RECORD
-                          R     : INTEGER;
-                          THETA : INTEGER;
-                     END RECORD;
-                FUNCTION EQUAL (L, R : POLAR_COORD) RETURN BOOLEAN;
-                PACKAGE POLAR_EQUAL IS NEW EQUALITY_OPERATOR
-                          (POLAR_COORD, EQUAL);
-                FUNCTION "=" (L, R : POLAR_COORD) RETURN BOOLEAN
-                          RENAMES POLAR_EQUAL."=";
-           END POLAR_COORDINATES;
- 
-           PACKAGE BODY POLAR_COORDINATES IS
-                FUNCTION EQUAL (L, R : POLAR_COORD) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN (L.THETA MOD 360) = (R.THETA MOD 360) AND
-                            L.R = R.R;
-                END EQUAL;
-           END POLAR_COORDINATES;
- 
-           USE POLAR_COORDINATES;
- 
-           PACKAGE VARIABLES IS
-                P270 : POLAR_COORD := (R => 3, THETA => 270);
-                P360 : POLAR_COORD := (R => 3, THETA => IDENT_INT(360));
-           END VARIABLES;
- 
-           USE VARIABLES;
- 
-      BEGIN
- 
-           IF P270 /= (3, -90) THEN
-                FAILED ("INCORRECT INEQUALITY OPERATOR");
-           END IF;
- 
-           IF P360 = (3, 0) THEN
-                NULL;
-           ELSE
-                FAILED ("INCORRECT EQUALITY OPERATOR");
-           END IF;
- 
-           RESULT;
- 
-      END;
- END C67005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C67005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF EQUALITY IS REDEFINED FOR A SCALAR TYPE, CASE
- -- STATEMENTS STILL USE THE PREDEFINED EQUALITY OPERATION.
- 
- -- JBG 9/28/83
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C67005B IS
- 
-      GENERIC
-           TYPE LP IS LIMITED PRIVATE;
-           WITH FUNCTION EQUAL (L, R : LP) RETURN BOOLEAN;
-      PACKAGE EQUALITY_OPERATOR IS
-           FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
-      END EQUALITY_OPERATOR;
-      
-      PACKAGE BODY EQUALITY_OPERATOR IS
-           FUNCTION "=" (L, R : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN EQUAL(L, R);
-           END "=";
-      END EQUALITY_OPERATOR;
- 
- BEGIN
-      TEST ("C67005B", "CHECK THAT REDEFINING EQUALITY FOR A " &
-                       "SCALAR TYPE DOES NOT AFFECT CASE STATEMENTS");
- 
-      DECLARE
-           TYPE MY IS NEW INTEGER;
-           CHECK : MY;
- 
-           VAR : INTEGER RANGE 1..3 := 3;
- 
-           PACKAGE INTEGER_EQUALS IS
-                FUNCTION EQUAL (L, R : INTEGER) RETURN BOOLEAN;
-                PACKAGE INTEGER_EQUAL IS NEW EQUALITY_OPERATOR
-                          (INTEGER, EQUAL);
-           END INTEGER_EQUALS;
- 
-           FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN RENAMES
-                        INTEGER_EQUALS.INTEGER_EQUAL."=";
- 
-           PACKAGE BODY INTEGER_EQUALS IS
-                FUNCTION EQUAL (L, R : INTEGER) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN FALSE;
-                END EQUAL;
-           END INTEGER_EQUALS;
- 
-      BEGIN
- 
-           IF VAR = 3 THEN
-                FAILED ("DID NOT USE REDEFINED '=' - 1");
-           END IF;
- 
-           IF VAR /= 3 THEN
-                NULL;
-           ELSE
-                FAILED ("DID NOT USE REDEFINED '/=' - 1");
-           END IF;
- 
-           IF VAR = IDENT_INT(3) THEN
-                FAILED ("DID NOT USE REDEFINED '=' - 2");
-           END IF;
- 
-           IF VAR /= IDENT_INT(3) THEN
-                NULL;
-           ELSE
-                FAILED ("DID NOT USE REDEFINED '/=' - 2");
-           END IF;
- 
-           CHECK := MY(IDENT_INT(0));
-           IF CHECK /= 0 THEN
-                FAILED ("USING WRONG EQUALITY FOR DERIVED TYPE");
-           END IF;
- 
-           CASE VAR IS
-                WHEN 1..3 => CHECK := MY(IDENT_INT(1));
-                WHEN OTHERS => NULL;
-           END CASE;
- 
-           IF CHECK /= 1 THEN
-                FAILED ("DID NOT USE PREDEFINED EQUALS IN CASE - 1");
-           END IF;
- 
-           CASE IDENT_INT(VAR) IS
-                WHEN 1 => CHECK := 4;
-                WHEN 2 => CHECK := 5;
-                WHEN 3 => CHECK := 6;
-                WHEN OTHERS => CHECK := 7;
-           END CASE;
- 
-           IF CHECK /= 6 THEN
-                FAILED ("DID NOT USE PREDEFINED EQUALS IN CASE - 2");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C67005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C67005C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A DECLARATION OF "=" NEED NOT HAVE PARAMETERS
- -- OF A LIMITED TYPE IN A RENAMING DECLARATION. THIS TEST CHECKS
- -- ACCESS TYPES.
- 
- -- BRYCE BARDIN (HUGHES AIRCRAFT) 7/2/84
- -- CPP 7/12/84
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C67005C IS
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-           WITH FUNCTION EQUAL (LEFT, RIGHT : T) RETURN BOOLEAN IS <>;
-      PACKAGE EQUALITY IS
-           FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN;
-           -- PRAGMA INLINE ("=");
-      END EQUALITY;
- 
-      PACKAGE BODY EQUALITY IS
-           FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
-           BEGIN
-                RETURN EQUAL (LEFT, RIGHT);
-           END "=";
-      END EQUALITY;
- 
-      PACKAGE STARTER IS
-           TYPE INT IS PRIVATE;
-           FUNCTION VALUE_OF (I : INTEGER) RETURN INT;
-           FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN;
-      PRIVATE
-           TYPE INT IS ACCESS INTEGER;
-      END STARTER;
- 
-      PACKAGE BODY STARTER IS
-           FUNCTION VALUE_OF (I : INTEGER) RETURN INT IS
-           BEGIN
-                RETURN NEW INTEGER'(I);
-           END VALUE_OF;
- 
-           FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN IS
-           BEGIN
-                RETURN LEFT.ALL = RIGHT.ALL;
-           END EQUAL;
-      END STARTER;
- 
-      PACKAGE ABSTRACTION IS
-           TYPE INT IS NEW STARTER.INT;
-           PACKAGE INT_EQUALITY IS NEW EQUALITY (INT, EQUAL);
-           FUNCTION "=" (LEFT, RIGHT : INT) RETURN BOOLEAN
-                RENAMES INT_EQUALITY."=";
-      END ABSTRACTION;    
-      USE ABSTRACTION;
- 
- BEGIN
- 
-      TEST ("C67005C", "RENAMING OF EQUALITY OPERATOR WITH " &
-            "NON-LIMITED PARAMETERS");
- 
-      DECLARE
- 
-           I : INT := VALUE_OF(1);
-           J : INT := VALUE_OF(0);
- 
-           PROCEDURE CHECK (B : BOOLEAN) IS
-           BEGIN
-                IF I = J AND B THEN
-                     COMMENT ("I = J");
-                ELSIF I /= J AND NOT B THEN
-                     COMMENT ("I /= J");
-                ELSE
-                     FAILED ("WRONG ""="" OPERATOR");
-                END IF;
-           END CHECK;
- 
-      BEGIN
- 
-           CHECK(FALSE);
-           I := VALUE_OF(0);
-           CHECK(TRUE);
-      
-           RESULT;
- 
-      END;
- 
- END C67005C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c6/c67005d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c6/c67005d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- C67005D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EQUALITY CAN BE REDEFINED FOR AN ARBITRARY TYPE BY USING A
- -- SEQUENCE OF RENAMING DECLARATIONS.
- 
- -- JBG 9/11/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C67005D IS
- 
-      FUNCTION MY_EQUALS  (L, R : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN FALSE;
-      END MY_EQUALS;
- 
-      GENERIC
-           TYPE LP IS LIMITED PRIVATE;
-           WITH FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
-      PACKAGE EQUALITY_OPERATOR IS
-           PACKAGE INNER IS
-                FUNCTION "=" (L, R : LP) RETURN BOOLEAN RENAMES
-                              EQUALITY_OPERATOR."=";
-           END INNER;
-      END EQUALITY_OPERATOR;
- 
- BEGIN
-      TEST ("C67005D", "CHECK REDEFINITION OF ""="" BY RENAMING");
- 
-      DECLARE
- 
-           CHK1 : BOOLEAN := 3 = IDENT_INT(3);     -- PREDEFINED "="
- 
-           -- REDEFINE INTEGER "=".
- 
-           PACKAGE INT_EQUALITY IS NEW
-                EQUALITY_OPERATOR (INTEGER, MY_EQUALS);
-           FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN RENAMES
-                INT_EQUALITY.INNER."=";
- 
-           CHK2 : BOOLEAN := 3 = IDENT_INT(3);     -- REDEFINED "=".
- 
-      BEGIN
- 
-           IF NOT CHK1 THEN
-                FAILED ("PREDEFINED ""="" NOT USED");
-           END IF;
- 
-           IF CHK2 THEN
-                FAILED ("REDEFINED ""="" NOT USED");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C67005D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c72001b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c72001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c72001b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c72001b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- C72001B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A PACKAGE BODY CAN BE PROVIDED FOR A PACKAGE SPECIFICATION
- --    THAT DOES NOT CONTAIN ANY SUBPROGRAM OR TASK DECLARATIONS AND THAT
- --    STATEMENTS WITHIN THE PACKAGE BODIES CAN BE USED TO INITIALIZE
- --    VARIABLES VISIBLE WITHIN THE PACKAGE BODY.
- 
- -- RM 04/30/81
- -- RM 05/07/81 (TO INCORPORATE OLD TEST OBJECTIVE  7.1/T1 )
- -- ABW 6/10/82
- -- SPS 11/4/82
- -- JBG 9/15/83
- 
- WITH REPORT;
- PROCEDURE  C72001B  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "C72001B" , "CHECK: PACKAGE BODIES CAN INITIALIZE VISIBLE" &
-                        " VARIABLES" );
- 
-      DECLARE
- 
- 
-           PACKAGE  P5  IS
- 
-                A : CHARACTER := 'B';
-                B : BOOLEAN   := FALSE;
- 
-                PACKAGE  P6  IS
-                     I : INTEGER := IDENT_INT(6);
-                END  P6;
- 
-           END  P5;
- 
- 
-           PACKAGE BODY  P5  IS
-                PACKAGE BODY  P6  IS
-                BEGIN
-                     A := 'C';
-                     I := 17;
-                     B := IDENT_BOOL(TRUE);
-                END  P6;
-           BEGIN
-                A := 'A';
-           END  P5;
- 
- 
-           USE  P5;
-           USE  P6;
- 
-      BEGIN
- 
-           IF A /= 'A' THEN
-                FAILED ("INITIALIZATIONS NOT CORRECT - 1");
-           END IF;
- 
-           IF B /= TRUE THEN
-                FAILED ("INITIALIZATIONS NOT CORRECT - 2");
-           END IF;
- 
-           IF I /= 17 THEN
-                FAILED ("INITIALIZATIONS NOT CORRECT - 3");
-           END IF;
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END C72001B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c72002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c72002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c72002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c72002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,229 ****
- -- C72002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE SPECIFICATION ARE
- --     ELABORATED IN THE ORDER DECLARED.
- 
- -- HISTORY:
- --     DHH 03/09/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C72002A IS
- 
-      A : INTEGER := 0;
-      TYPE ORDER_ARRAY IS ARRAY(1 .. 14) OF INTEGER;
-      OBJECT_ARRAY : ORDER_ARRAY;
-      TYPE REAL IS DIGITS 4;
-      TYPE ENUM IS (RED,YELLOW,BLUE);
- 
-      TYPE ARR IS ARRAY(1 ..2) OF BOOLEAN;
-      D : ARR := (TRUE, TRUE);
-      E : ARR := (FALSE, FALSE);
- 
-      TYPE REC IS
-           RECORD
-                I : INTEGER;
-           END RECORD;
-      B : REC := (I => IDENT_INT(1));
-      C : REC := (I => IDENT_INT(2));
- 
-      FUNCTION GIVEN_ORDER(X : INTEGER) RETURN INTEGER IS
-           Y : INTEGER;
-      BEGIN
-           Y := X + 1;
-           RETURN Y;
-      END GIVEN_ORDER;
- 
-      FUNCTION BOOL(X : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           IF X = IDENT_INT(1) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN TRUE;
-           ELSIF X = IDENT_INT(8) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN FALSE;
-           END IF;
-      END BOOL;
- 
-      FUNCTION INT(X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           IF X = IDENT_INT(2) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN IDENT_INT(1);
-           ELSIF X = IDENT_INT(9) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN IDENT_INT(2);
-           END IF;
-      END INT;
- 
-      FUNCTION FLOAT(X : INTEGER) RETURN REAL IS
-      BEGIN
-           IF X = IDENT_INT(3) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN 1.0;
-           ELSIF X = IDENT_INT(10) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN 2.0;
-           END IF;
-      END FLOAT;
- 
-      FUNCTION CHAR(X : INTEGER) RETURN CHARACTER IS
-      BEGIN
-           IF X = IDENT_INT(4) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN 'A';
-           ELSIF X = IDENT_INT(11) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN 'Z';
-           END IF;
-      END CHAR;
- 
-      FUNCTION ENUMR(X : INTEGER) RETURN ENUM IS
-      BEGIN
-           IF X = IDENT_INT(5) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN RED;
-           ELSIF X = IDENT_INT(12) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN YELLOW;
-           END IF;
-      END ENUMR;
- 
-      FUNCTION ARRY(X : INTEGER) RETURN ARR IS
-      BEGIN
-           IF X = IDENT_INT(6) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN D;
-           ELSIF X = IDENT_INT(13) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN E;
-           END IF;
-      END ARRY;
- 
-      FUNCTION RECOR(X : INTEGER) RETURN REC IS
-      BEGIN
-           IF X = IDENT_INT(7) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN B;
-           ELSIF X = IDENT_INT(14) THEN
-                A := GIVEN_ORDER(A);
-                OBJECT_ARRAY(X) := A;
-                RETURN C;
-           END IF;
-      END RECOR;
- 
-      PACKAGE PACK IS
-           A : BOOLEAN   := BOOL(1);
-           B : INTEGER   := INT(2);
-           C : REAL      := FLOAT(3);
-           D : CHARACTER := CHAR(4);
-           E : ENUM      := ENUMR(5);
-           F : ARR       := ARRY(6);
-           G : REC       := RECOR(7);
-           H : BOOLEAN   := BOOL(8);
-           I : INTEGER   := INT(9);
-           J : REAL      := FLOAT(10);
-           K : CHARACTER := CHAR(11);
-           L : ENUM      := ENUMR(12);
-           M : ARR       := ARRY(13);
-           N : REC       := RECOR(14);
-      END PACK;
- 
- BEGIN
-      TEST("C72002A", "CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE " &
-                      "SPECIFICATION ARE ELABORATED IN THE ORDER " &
-                      "DECLARED");
- 
-      IF OBJECT_ARRAY(1) /= IDENT_INT(1) THEN
-           FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(2) /= IDENT_INT(2) THEN
-           FAILED("INTEGER 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(3) /= IDENT_INT(3) THEN
-           FAILED("REAL 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(4) /= IDENT_INT(4) THEN
-           FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(5) /= IDENT_INT(5) THEN
-           FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(6) /= IDENT_INT(6) THEN
-           FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(7) /= IDENT_INT(7) THEN
-           FAILED("RECORD 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(8) /= IDENT_INT(8) THEN
-           FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(9) /= IDENT_INT(9) THEN
-           FAILED("INTEGER 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(10) /= IDENT_INT(10) THEN
-           FAILED("REAL 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(11) /= IDENT_INT(11) THEN
-           FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(12) /= IDENT_INT(12) THEN
-           FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(13) /= IDENT_INT(13) THEN
-           FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF OBJECT_ARRAY(14) /= IDENT_INT(14) THEN
-           FAILED("RECORD 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      RESULT;
- END C72002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,437 ****
- -- C730001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the full view of a private extension may be derived
- --      indirectly from the ancestor type (i.e., the parent type of the full
- --      type may be any descendant of the ancestor type). Check that, for
- --      a primitive subprogram of the private extension that is inherited from
- --      the ancestor type and not overridden, the formal parameter names and
- --      default expressions come from the corresponding primitive subprogram
- --      of the ancestor type, while the body comes from that of the parent
- --      type.  Check both dispatching and non-dispatching cases.
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      package P is
- --         type Ancestor is tagged ...
- --         procedure Op (P1: Ancestor; P2: Boolean := True);
- --      end P;
- --
- --      with P;
- --      package Q is
- --         type Derived is new P.Ancestor with ...
- --         procedure Op (X: Ancestor; Y: Boolean := False);
- --      end Q;
- --
- --      with P, Q;
- --      package R is
- --         type Priv_Ext is new P.Ancestor with private;   -- (A)
- --         -- Inherits procedure Op (P1: Priv_Ext; P2: Boolean := True);
- --         -- But body executed is that of Q.Op.
- --      private
- --         type Priv_Ext is new Q.Derived with record ...  -- (B)
- --      end R;
- --
- --      The ancestor type in (A) differs from the parent type in (B); the
- --      parent of the full type is descended from the ancestor type of the
- --      private extension. For a call to Op (from outside the scope of the
- --      full view) with an operand of type Priv_Ext, the formal parameter
- --      names and default expression come from that of P.Op (the ancestor
- --      type's version), but the body executed will be that of 
- --      Q.Op (the parent type's version)
- --
- --      One half of the test mirrors the above template, where an inherited
- --      subprogram (Set_Display) is called using the formal parameter 
- --      name (C) and default parameter expression of the ancestor type's 
- --      version (type Clock), but the version of the body executed is from
- --      the parent type.
- --
- --      The test also includes an examination of the dynamic evaluation
- --      case, where correct body associations are required through dispatching 
- --      calls.  As described for the non-dispatching case above, the formal
- --      parameter name and default values of the ancestor type's (Phone) 
- --      version of the inherited subprogram (Answer) are used in the 
- --      dispatching call, but the body executed is from the parent type.
- --      
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C730001_0 is
- 
-    type Display_Kind      is (None, Analog, Digital);
-    type Illumination_Type is (None, Light, Phosphorescence);
-    type Capability_Type   is (Available, In_Use, Call_Waiting, Conference);
-    type Indicator_Type    is (None, Light, Bell, Buzzer, Click, Modem);
- 
-    type Clock is abstract tagged record           -- ancestor type associated
-       Display      : Display_Kind      := None;   -- with non-dispatching case.
-       Illumination : Illumination_Type := None;
-    end record;
- 
-    type Phone is tagged record                    -- ancestor type associated
-       Status    : Capability_Type := Available;   -- with dispatching case.
-       Indicator : Indicator_Type  := None;
-    end record;
- 
-    -- The Set_Display procedure for type Clock implements a basic, no-frills
-    -- clock display.
-    procedure Set_Display (C   : in out Clock;
-                           Disp: in     Display_Kind := Digital);
- 
-    -- The Answer procedure for type Phone implements a phone status change
-    -- operation.
-    procedure Answer (The_Phone : in out Phone;
-                      Ind       : in     Indicator_Type := Light);
-    -- ...Other general clock and/or phone operations (not specified in this
-    -- test scenario).
- 
- end C730001_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C730001_0 is
- 
-    procedure Set_Display (C   : in out Clock;
-                           Disp: in     Display_Kind := Digital) is
-    begin
-       C.Display      := Disp;
-       C.Illumination := Light;
-    end Set_Display;
- 
-    procedure Answer (The_Phone : in out Phone;
-                      Ind       : in     Indicator_Type := Light) is
-    begin
-       The_Phone.Status    := In_Use;
-       The_Phone.Indicator := Ind;
-    end Answer;
- 
- end C730001_0;
- 
- 
-      --==================================================================--
- 
- 
- with C730001_0; use C730001_0;
- package C730001_1 is
- 
-    type Power_Supply_Type is (Spring, Battery, AC_Current);
-    type Speaker_Type      is (None, Present, Adjustable, Stereo);
- 
-    type Wall_Clock is new Clock with record
-       Power_Source : Power_Supply_Type := Spring;
-    end record;
- 
-    type Office_Phone is new Phone with record
-       Speaker : Speaker_Type := Present;
-    end record;
- 
-    -- Note: Both procedures below, parameter names and defaults differ from
-    --       parent's version.
- 
-    -- The Set_Display procedure for type Wall_Clock improves upon the
-    -- basic Set_Display procedure of type Clock.
- 
-    procedure Set_Display (WC: in out Wall_Clock;
-                           D : in     Display_Kind := Analog);
- 
-    procedure Answer (OP : in out Office_Phone;
-                      OI : in     Indicator_Type := Buzzer);
- 
-    -- ...Other wall clock and/or Office_Phone operations (not specified in
-    -- this test scenario).
- 
- end C730001_1;
- 
- 
-      --==================================================================--
- 
- 
- package body C730001_1 is
- 
-    -- Note: This body is the one that should be executed in the test block
-    --       below, not the version of the body corresponding to type Clock.
- 
-    procedure Set_Display (WC: in out Wall_Clock;
-                           D : in     Display_Kind := Analog) is
-    begin
-       WC.Display      := D;
-       WC.Illumination := Phosphorescence;
-    end Set_Display;
- 
- 
-    procedure Answer (OP : in out Office_Phone;
-                      OI : in     Indicator_Type := Buzzer) is
-    begin
-       OP.Status    := Call_Waiting;
-       OP.Indicator := OI;
-    end Answer;
- 
- end C730001_1;
- 
- 
-      --==================================================================--
- 
- 
- with C730001_0; use C730001_0;
- with C730001_1; use C730001_1;
- package C730001_2 is
- 
-    type Alarm_Type  is (Buzzer, Radio, Both);
-    type Video_Type  is (None, TV_Monitor, Wall_Projection);
- 
-    type Alarm_Clock is new Clock with private;
-    -- Inherits proc Set_Display (C   : in out Clock;
-    --                            Disp: in     Display_Kind := Digital); -- (A)
-    --
-    -- Would also inherit other general clock operations (if present).
- 
- 
-    type Conference_Room_Phone is new Office_Phone with record
-       Display : Video_Type := TV_Monitor;
-    end record;
- 
-    procedure Answer (CP : in out Conference_Room_Phone;
-                      CI : in     Indicator_Type := Modem);
- 
- 
-    function TC_Get_Display              (C: Alarm_Clock) return Display_Kind;
-    function TC_Get_Display_Illumination (C: Alarm_Clock) 
-      return Illumination_Type;
- 
- private
- 
-    -- ...however, certain of the wall clock's operations (Set_Display, in 
-    -- this example) improve on the implementations provided for the general
-    -- clock. We want to call the improved implementations, so we
-    -- derive from Wall_Clock in the private part.
- 
-    type Alarm_Clock is new Wall_Clock with record
-       Alarm : Alarm_Type := Buzzer;
-    end record;
- 
-    -- Inherits proc Set_Display (WC: in out Wall_Clock;
-    --                            D : in     Display_Kind := Analog);    -- (B)
- 
-    -- The implicit Set_Display at (B) overrides the implicit Set_Display at 
-    -- (A), but only within the scope of the full view. 
-    --
-    -- Outside the scope of the full view, only (A) is visible, so calls
-    -- from outside the scope will get the formal parameter names and default
-    -- from (A). Both inside and outside the scope, however, the body executed
-    -- will be that corresponding to Set_Display of the parent type.
- 
- end C730001_2;
- 
- 
-      --==================================================================--
- 
- 
- package body C730001_2 is
- 
-    procedure Answer (CP : in out Conference_Room_Phone;
-                      CI : in     Indicator_Type := Modem)is
-    begin
-       CP.Status    := Conference;
-       CP.Indicator := CI;
-    end Answer;
- 
- 
-    function TC_Get_Display (C: Alarm_Clock) return Display_Kind is
-    begin
-       return C.Display;
-    end TC_Get_Display;
- 
- 
-    function TC_Get_Display_Illumination (C: Alarm_Clock) 
-      return Illumination_Type is
-    begin
-       return C.Illumination;
-    end TC_Get_Display_Illumination;
- 
- end C730001_2;
- 
- 
-      --==================================================================--
- 
- 
- with C730001_0; use C730001_0;
- with C730001_1; use C730001_1;
- with C730001_2; use C730001_2;
- 
- package C730001_3 is
- 
-    -- Types extended from the ancestor (Phone) type in the specification.
- 
-    type Secure_Phone_Type     is new Phone with private;
-    type Auditorium_Phone_Type is new Phone with private;
-    -- Inherit versions of Answer from ancestor (Phone).
- 
-    function TC_Get_Phone_Status (P : Phone'Class) return Capability_Type;
-    function TC_Get_Indicator    (P : Phone'Class) return Indicator_Type;
- 
- private
- 
-    -- Types extended from descendents of Phone_Type in the private part.
- 
-    type Secure_Phone_Type is new Office_Phone with record
-       Scrambled_Communication : Boolean := True;
-    end record;
- 
-    type Auditorium_Phone_Type is new Conference_Room_Phone with record
-       Volume_Control : Boolean := True;
-    end record;
- 
- end C730001_3;
- 
-      --==================================================================--
- 
- package body C730001_3 is
- 
-    function TC_Get_Phone_Status (P : Phone'Class) return Capability_Type is
-    begin
-       return P.Status;
-    end TC_Get_Phone_Status;
- 
-    function TC_Get_Indicator (P : Phone'Class) return Indicator_Type is
-    begin
-       return P.Indicator;
-    end TC_Get_Indicator;
- 
- end C730001_3;
- 
-      --==================================================================--
- 
- with C730001_0; use C730001_0;
- with C730001_1; use C730001_1;
- with C730001_2; use C730001_2;
- with C730001_3; use C730001_3;
- 
- with Report;
- 
- procedure C730001 is
- begin
- 
-    Report.Test ("C730001","Check that the full view of a private extension " &
-                           "may be derived indirectly from the ancestor "     &
-                           "type. Check that, for a primitive subprogram "    &
-                           "of the private extension that is inherited from " &
-                           "the ancestor type and not overridden, the "       &
-                           "formal parameter names and default expressions "  &
-                           "come from the corresponding primitive "           &
-                           "subprogram of the ancestor type, while the body " &
-                           "comes from that of the parent type");
- 
-    Test_Block:
-    declare
- 
-       Alarm                : Alarm_Clock;
-       Hot_Line             : Secure_Phone_Type;
-       TeleConference_Phone : Auditorium_Phone_Type;
- 
-    begin
- 
-    -- Evaluate non-dispatching case:
- 
-       -- Call Set_Display using formal parameter name from 
-       -- C730001_0.Set_Display.
-       -- Give no 2nd parameter so that default expression must be used.
- 
-       Set_Display (C => Alarm);
-     
-       -- The value of the Display component should equal Digital, which is
-       -- the default value from the ancestor's version of Set_Display,
-       -- and not the default value from the parent's version of Set_Display.
- 
-       if TC_Get_Display (Alarm) /= Digital then
-          Report.Failed ("Default expression for ancestor op not used " &
-                         "in non-dispatching case");
-       end if;
- 
-       -- However, the value of the Illumination component should equal
-       -- Phosphorescence, which is assigned in the parent type's version of
-       -- the body of Set_Display.
- 
-       if TC_Get_Display_Illumination (Alarm) /= Phosphorescence then
-          Report.Failed ("Wrong body was executed in non-dispatching case");
-       end if;
- 
- 
-    -- Evaluate dispatching case:
-       declare
- 
-          Hot_Line             : Secure_Phone_Type;
-          TeleConference_Phone : Auditorium_Phone_Type;
- 
-          procedure Answer_The_Phone (P : in out Phone'Class) is
-          begin
-             -- Give no 2nd parameter so that default expression must be used.
-             Answer (P);
-          end Answer_The_Phone;
- 
-       begin
- 
-          Answer_The_Phone (Hot_Line);
-          Answer_The_Phone (TeleConference_Phone);
- 
-          -- The value of the Indicator field shold equal "Light", the default
-          -- value from the ancestor's version of Answer, and not the default
-          -- from either of the parent versions of Answer.
- 
-          if TC_Get_Indicator(Hot_Line)             /= Light   or
-             TC_Get_Indicator(TeleConference_Phone) /= Light
-          then
-             Report.Failed("Default expression from ancestor operation " &
-                           "not used in dispatching case");
-          end if;
- 
-          -- However, the value of the Status component should equal
-          -- Call_Waiting or Conference respectively, based on the assignment
-          -- in the parent type's version of the body of Answer.
- 
-          if TC_Get_Phone_Status(Hot_Line)  /=  Call_Waiting then
-             Report.Failed("Wrong body executed in dispatching case - 1");
-          end if;
- 
-          if TC_Get_Phone_Status(TeleConference_Phone) /= Conference then
-             Report.Failed("Wrong body executed in dispatching case - 2");
-          end if;
- 
-       end;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end C730001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,383 ****
- -- C730002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the full view of a private extension may be derived
- --      indirectly from the ancestor type (i.e., the parent type of the full
- --      type may be any descendant of the ancestor type). Check that, for
- --      a primitive subprogram of the private extension that is inherited from
- --      the ancestor type and not overridden, the formal parameter names and
- --      default expressions come from the corresponding primitive subprogram
- --      of the ancestor type, while the body comes from that of the parent
- --      type.
- --      Check for a case where the parent type is derived from the ancestor
- --      type through a series of types produced by generic instantiations.
- --      Examine both the static and dynamic binding cases.
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      package P is
- --         type Ancestor is tagged ...
- --         procedure Op (P1: Ancestor; P2: Boolean := True);
- --      end P;
- --
- --      with P;
- --      generic
- --         type T is new P.Ancestor with private;  
- --      package Gen1 is
- --         type Enhanced is new T with private;
- --         procedure Op (A: Enhanced; B: Boolean := True);
- --         -- other specific procedures...
- --      private
- --         type Enhanced is new T with ...
- --      end Gen1;
- --
- --      with P, Gen1;
- --      package N is new Gen1 (P.Ancestor);
- --
- --      with N;
- --      generic
- --         type T is new N.Enhanced with private;
- --      package Gen2 is
- --         type Enhanced_Again is new T with private;
- --         procedure Op (X: Enhanced_Again; Y: Boolean := False);
- --         -- other specific procedures...
- --      private
- --         type Enhanced_Again is new T with ...
- --      end Gen2;
- --
- --      with N, Gen2;
- --      package Q is new Gen2 (N.Enhanced);
- --
- --      with P, Q;
- --      package R is
- --         type Priv_Ext is new P.Ancestor with private;         -- (A)
- --         -- Inherits procedure Op (P1: Priv_Ext; P2: Boolean := True);
- --         -- But body executed is that of Q.Op.
- --      private
- --         type Priv_Ext is new Q.Enhanced_Again with record ... -- (B)
- --      end R;
- --
- --      The ancestor type in (A) differs from the parent type in (B); the
- --      parent of the full type is descended from the ancestor type of the
- --      private extension, in this case through a series of types produced
- --      by generic instantiations.  Gen1 redefines the implementation of Op
- --      for any type that has one.  N is an instance of Gen1 for the ancestor
- --      type. Gen2 again redefines the implementation of Op for any type that
- --      has one. Q is an instance of Gen2 for the extension of the P.Ancestor
- --      declared in N.  Both N and Q could define other operations which we
- --      don't want to be available in R.  For a call to Op (from outside the
- --      scope of the full view) with an operand of type R.Priv_Ext, the body
- --      executed will be that of Q.Op (the parent type's version), but the
- --      formal parameter names and default expression come from that of P.Op
- --      (the ancestor type's version).
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      27 Feb 97   CTA.PWB Added elaboration pragmas.
- --!
- 
- package C730002_0 is
- 
-    type Hours_Type      is range 0..1000;
-    type Personnel_Type  is range 0..10;
-    type Specialist_ID is (Manny, Moe, Jack, Curly, Joe, Larry);
- 
-    type Engine_Type is tagged record
-       Ave_Repair_Time    : Hours_Type     := 0;     -- Default init. for
-       Personnel_Required : Personnel_Type := 0;     -- component fields.
-       Specialist         : Specialist_ID  := Manny;
-    end record;
- 
-    procedure Routine_Maintenance (Engine     : in out Engine_Type ; 
-                                   Specialist : in     Specialist_ID := Moe);
- 
-    -- The Routine_Maintenance procedure implements the processing required
-    -- for an engine.
- 
- end C730002_0;
- 
-      --==================================================================--
- 
- package body C730002_0 is
- 
-    procedure Routine_Maintenance (Engine     : in out Engine_Type ; 
-                                   Specialist : in     Specialist_ID := Moe) is
-    begin
-       Engine.Ave_Repair_Time     := 3;
-       Engine.Personnel_Required  := 1;
-       Engine.Specialist := Specialist;
-    end Routine_Maintenance;
- 
- end C730002_0;
- 
-      --==================================================================--
- 
- with C730002_0; use C730002_0;
- generic
-    type T is new C730002_0.Engine_Type with private;
- package C730002_1 is
- 
-    -- This generic package contains types/procedures specific to engines 
-    -- of the diesel variety.
- 
-    type Repair_Facility_Type is (On_Site, Repair_Shop, Factory);
- 
-    type Diesel_Series is new T with private;
- 
-    procedure Routine_Maintenance (Eng      : in out Diesel_Series;
-                                   Spec_Req : in     Specialist_ID := Jack);
-   
-    -- Other diesel specific operations... (not required in this test).
- 
- private
- 
-    type Diesel_Series is new T with record
-       Repair_Facility_Required : Repair_Facility_Type := On_Site;
-    end record;
- 
- end C730002_1;
- 
-      --==================================================================--
- 
- package body C730002_1 is
- 
-    procedure Routine_Maintenance (Eng      : in out Diesel_Series;
-                                   Spec_Req : in     Specialist_ID := Jack) is
-    begin
-       Eng.Ave_Repair_Time          := 6;
-       Eng.Personnel_Required       := 2;
-       Eng.Specialist               := Spec_Req;
-       Eng.Repair_Facility_Required := On_Site;
-    end Routine_Maintenance;
- 
- end C730002_1;
- 
-      --==================================================================--
- 
- with C730002_0;
- with C730002_1;
- pragma Elaborate (C730002_1);
- package C730002_2 is new C730002_1 (C730002_0.Engine_Type);
- 
-      --==================================================================--
- 
- with C730002_0; use C730002_0;
- with C730002_2; use C730002_2;
- generic
-   type T is new C730002_2.Diesel_Series with private;
- package C730002_3 is
- 
-    type Time_Of_Operation_Type is range 0..100_000;
- 
-    type Electric_Series is new T with private;
- 
-    procedure Routine_Maintenance (E  : in out Electric_Series;
-                                   SR : in     Specialist_ID := Curly);
- 
-    -- Other electric specific operations... (not required in this test).
- 
- private
- 
-    type Electric_Series is new T with record
-       Mean_Time_Between_Repair : Time_Of_Operation_Type := 0;
-    end record; 
- 
- end C730002_3;
- 
-      --==================================================================--
- 
- package body C730002_3 is
- 
-    procedure Routine_Maintenance (E  : in out Electric_Series;
-                                   SR : in     Specialist_ID := Curly) is
-    begin
-       E.Ave_Repair_Time          := 9;
-       E.Personnel_Required       := 3;
-       E.Specialist               := SR;
-       E.Mean_Time_Between_Repair := 1000;
-    end Routine_Maintenance;
- 
- end C730002_3;
- 
-      --==================================================================--
- 
- with C730002_2;
- with C730002_3;
- pragma Elaborate (C730002_3);
- package C730002_4 is new C730002_3 (C730002_2.Diesel_Series);
- 
-      --==================================================================--
- 
- with C730002_0;  use C730002_0;
- with C730002_4;  use C730002_4;
- 
- package C730002_5 is
- 
-    type Inspection_Type is (AAA, MIL_STD, NRC);
- 
-    type Nuclear_Series is new Engine_Type with private;              -- (A)
- 
-    -- Inherits procedure Routine_Maintenance from ancestor; does not override.
-    --                      (Engine     : in out Nuclear_Series; 
-    --                       Specialist : in     Specialist_ID := Moe);
-    -- But body executed will be that of C730002_4.Routine_Maintenance, 
-    -- the parent type.
- 
-    function TC_Specialist         (E : Nuclear_Series) return Specialist_ID;
-    function TC_Personnel_Required (E : Nuclear_Series) return Personnel_Type;
-    function TC_Time_Required      (E : Nuclear_Series) return Hours_Type;
- 
-    -- Dispatching subprogram.
-    procedure Maintain_The_Engine (The_Engine : in out Engine_Type'Class);
- 
- private
- 
-    type Nuclear_Series is new Electric_Series with record           -- (B)
-       Inspector_Rep : Inspection_Type := NRC;
-    end record;
- 
-    -- The ancestor type is used in the type extension (A), while the parent
-    -- of the full type (B) is a descendent of the ancestor type, through a
-    -- series of types produced by generic instantiation.
- 
- end C730002_5;
- 
-      --==================================================================--
- 
- package body C730002_5 is
- 
-    function TC_Specialist (E : Nuclear_Series) return Specialist_ID is
-    begin
-       return E.Specialist;
-    end TC_Specialist;
- 
-    function TC_Personnel_Required (E : Nuclear_Series) 
-      return Personnel_Type is
-    begin
-       return E.Personnel_Required;
-    end TC_Personnel_Required;
- 
-    function TC_Time_Required (E : Nuclear_Series) return Hours_Type is
-    begin
-       return E.Ave_Repair_Time;
-    end TC_Time_Required;
- 
-    -- Dispatching subprogram.
-    procedure Maintain_The_Engine (The_Engine : in out Engine_Type'Class) is
-    begin
-       Routine_Maintenance (The_Engine);
-    end Maintain_The_Engine;
- 
- 
- end C730002_5;
- 
-      --==================================================================--
- 
- with Report;
- with C730002_0;  use C730002_0;
- with C730002_2;  use C730002_2;
- with C730002_4;  use C730002_4;
- with C730002_5;  use C730002_5;
- 
- procedure C730002 is
- begin
- 
-    Report.Test ("C730002", "Check that the full view of a private "        &
-                            "extension may be derived indirectly from "     &
-                            "the ancestor type.  Check for a case where "   &
-                            "the parent type is derived from the ancestor " &
-                            "type through a series of types produced by "   &
-                            "generic instantiations");
- 
-    Test_Block:
-    declare
-       Nuclear_Drive : Nuclear_Series;
-       Warp_Drive    : Nuclear_Series;
-    begin
- 
-       -- Non-Dispatching Case:
-       -- Call Routine_Maintenance using formal parameter name from
-       -- C730002_0.Routine_Maintenance (ancestor version).
-       -- Give no second parameter so that the default expression must be
-       -- used.
- 
-       Routine_Maintenance (Engine => Nuclear_Drive);
- 
-       -- The value of the Specialist component should equal "Moe",
-       -- which is the default value from the ancestor's version of
-       -- Routine_Maintenance, and not the default value from the parent's
-       -- version of Routine_Maintenance.
- 
-       if TC_Specialist (Nuclear_Drive) /= Moe then
-          Report.Failed
-            ("Default expression for ancestor op not used " &
-             " - non-dispatching case");
-       end if;
- 
-       -- However the value of the Ave_Repair_Time and Personnel_Required 
-       -- components should be those assigned in the parent type's version 
-       -- of the body of Routine_Maintenance.
-       -- Note: Only components associated with the ancestor type are
-       --       evaluated for the purposes of this test.
- 
-       if TC_Personnel_Required (Nuclear_Drive) /= 3  or
-          TC_Time_Required (Nuclear_Drive)      /= 9
-       then
-          Report.Failed("Wrong body was executed - non-dispatching case");
-       end if;
- 
-       -- Dispatching Case:
-       -- Use a dispatching subprogram to ensure that the correct body is 
-       -- used at runtime.
- 
-       Maintain_The_Engine (Warp_Drive);
- 
-       -- The resulting assignments to the fields of the Warp_Drive variable
-       -- should be the same as those of the Nuclear_Drive above, indicating
-       -- that the body of the parent version of the inherited subprogram
-       -- was used.
- 
-       if TC_Specialist (Warp_Drive) /= Moe then
-          Report.Failed
-            ("Default expression for ancestor op not used - dispatching case");
-       end if;
- 
-       if TC_Personnel_Required (Nuclear_Drive) /= 3  or
-          TC_Time_Required (Nuclear_Drive)      /= 9
-       then
-          Report.Failed("Wrong body was executed - dispatching case");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end C730002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,283 ****
- -- C730003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the characteristics of a type derived from a private
- --      extension (outside the scope of the full view) are those defined by
- --      the partial view of the private extension.
- --      In particular, check that a component of the derived type may be
- --      explicitly declared with the same name as a component declared for
- --      the full view of the private extension.
- --      Check that a component defined in the private extension of a type
- --      may be updated through a view conversion of a type derived from
- --      the type.
- --
- -- TEST DESCRIPTION:
- --      Consider:
- --
- --      package Parent is
- --         type T is tagged record
- --            ...
- --         end record;
- --
- --         type DT is new T with private;
- --         procedure Op1 (P: in out DT);
- --
- --      private
- --         type DT is new T with record
- --            Y: ...;                                             -- (A)
- --         end record;
- --      end Parent;
- --
- --      package body Parent is
- --         function Op1 (P: in DT) return ... is
- --         begin
- --            return P.Y;
- --         end Op1;
- --      end Parent;
- --
- --      package Unrelated is
- --         type Intermediate is new DT with record
- --            Y: ...;  -- Note: same name as component of         -- (B)
- --                     --       parent's full view.
- --         end record;
- --      end Unrelated;
- --
- --      package Parent.Child is
- --         type DDT is new Intermediate with null record;
- --         -- Implicit declared Op1 (P.DDT);                      -- (C)
- --
- --         procedure Op2 (P: in out DDT);
- --      end Parent.Child;
- --
- --      package body Parent.Child is
- --         procedure Op2 (P: in out DDT) is
- --            Obj : DT renames DT(P);
- --         begin
- --            ...
- --            P.Y := ...;      -- Updates DDT's Y.                -- (D)
- --            DT(P).Y := ...;  -- Updates DT's Y.                 -- (E)
- --            Obj.Y := ...;    -- Updates DT's Y.                 -- (F)
- --         end Op2;
- --      end Parent.Child;
- --
- --      Types DT and DDT both declare a component Y at (A) and (B),
- --      respectively. The component Y of the full view of DT is not visible
- --      at the place where DDT is declared. Therefore, it is invisible for
- --      all views of DDT (although it still exists for objects of DDT), and
- --      it is legal to declare another component for DDT with the same name.
- --
- --      DDT inherits the primitive subprogram Op1 from DT at (C). Op1 returns
- --      the component Y; for calls with an operand of type DDT, Op1 returns
- --      the Y inherited from DT, not the new Y explicitly declared for DDT,
- --      even though the inherited Y is not visible for any view of DDT.
- --
- --      Within the body of Op2, the assignment statement at (D) updates the
- --      Y explicitly declared for DDT. At (E) and (F), however, a view
- --      conversion denotes a new view of P as an object of type DT, which
- --      enables access to the Y from the full view of DT. Thus, the
- --      assignment statements at (E) and (F) update the (invisible) Y from DT.
- --
- --      Note that the above analysis would be wrong if the new component Y
- --      were declared directly in Child.  In that case, the two same-named
- --      components would be illegal -- see AI-150.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 1994   SAIC    ACVC 2.0
- --      29 JUN 1999   RAD     Declare same-named component in an
- --                            unrelated package -- see AI-150.
- --
- --!
- 
- package C730003_0 is
- 
-    type Suit_Kind is (Clubs, Diamonds, Hearts, Spades);
-    type Face_Kind is (Up, Down);
- 
-    type Playing_Card is tagged record
-       Face: Face_Kind;
-       Suit: Suit_Kind;
-    end record;
- 
-    procedure Turn_Over_Card (Card : in out Playing_Card);
- 
-    type Disp_Card is new Playing_Card with private;
- 
-    subtype ASCII_Representation is Natural range 1..14;
- 
-    function Get_Private_View (A_Card : Disp_Card) return ASCII_Representation;
- 
- private
- 
-    type Disp_Card is new Playing_Card with record
-       View: ASCII_Representation;                                       -- (A)
-    end record;
- 
- end C730003_0;
- 
- --==================================================================--
- 
- package body C730003_0 is
- 
-    procedure Turn_Over_Card (Card: in out Playing_Card) is
-    begin
-       Card.Face := Up;
-    end Turn_Over_Card;
- 
-    function Get_Private_View (A_Card : Disp_Card)
-      return ASCII_Representation is
-    begin
-       return A_Card.View;
-    end Get_Private_View;
- 
- end C730003_0;
- 
- --==================================================================--
- 
- with C730003_0; use C730003_0;
- package C730003_1 is
- 
-    subtype Graphic_Representation is String (1 .. 2);
- 
-    type Graphic_Card is new Disp_Card with record
-       View : Graphic_Representation;                                    -- (B)
-                                           -- "Duplicate" component field name.
-    end record;
- 
- end C730003_1;
- 
- --==================================================================--
- 
- with C730003_1; use C730003_1;
- package C730003_0.C730003_2 is
- 
-    Queen_Of_Spades   : constant C730003_0.ASCII_Representation := 12;
-    Ace_Of_Hearts     : constant String := "AH";
-    Close_To_The_Vest : constant C730003_0.ASCII_Representation := 14;
-    Read_Em_And_Weep  : constant String := "AA";
- 
-    type Graphic_Card is new C730003_1.Graphic_Card with null record;
- 
-    -- Implicit function Get_Private_View                                -- (C)
-    --           (A_Card : Graphic_Card) return C730003_0.ASCII_Representation;
- 
-    function  Get_View       (Card : Graphic_Card) return String;
-    procedure Update_View    (Card : in out Graphic_Card);
-    procedure Hide_From_View (Card : in out Graphic_Card);
- 
- end C730003_0.C730003_2;
- 
- --==================================================================--
- 
- package body C730003_0.C730003_2 is
- 
-    function Get_View (Card : Graphic_Card) return String is
-    begin
-       return Card.View;
-    end Get_View;
- 
-    procedure Update_View (Card : in out Graphic_Card) is
-       ASCII_View      : Disp_Card renames Disp_Card(Card); -- View conversion.
-    begin
-       ASCII_View.View := Queen_Of_Spades;                               -- (F)
-                                               -- Assignment to "hidden" field.
-       Card.View       := Ace_Of_Hearts;                                 -- (D)
-                                  -- Assignment to Graphic_Card declared field.
-    end Update_View;
- 
-    procedure Hide_From_View (Card : in out Graphic_Card) is
-    begin
-       -- Update both of Card's View components.
-       Disp_Card(Card).View := Close_To_The_Vest;                        -- (E)
-                                               -- Assignment to "hidden" field.
-       Card.View            := Read_Em_And_Weep;                         -- (D)
-                                  -- Assignment to Graphic_Card declared field.
-    end Hide_From_View;
- 
- end C730003_0.C730003_2;
- 
- --==================================================================--
- 
- with C730003_0;
- with C730003_0.C730003_2;
- with Report;
- 
- procedure C730003 is
- begin
- 
-    Report.Test ("C730003", "Check that the characteristics of a type "   &
-                            "derived from a private extension (outside "  &
-                            "the scope of the full view) are those "      &
-                            "defined by the partial view of the private " &
-                            "extension");
- 
-    Check_Your_Cards:
-    declare
-       use C730003_0;
-       use C730003_0.C730003_2;
- 
-       Top_Card_On_The_Deck : Graphic_Card;
- 
-    begin
- 
-       -- Update value in the components of the card.  There are two
-       -- component fields named View, although one is not visible for
-       -- any view of a Graphic_Card.
- 
-       Update_View(Top_Card_On_The_Deck);
- 
-       -- Verify that both "View" components of the card have been updated.
- 
-       if Get_View(Top_Card_On_The_Deck) /= Ace_Of_Hearts then
-          Report.Failed ("Incorrect value in visible component - 1");
-       end if;
- 
-       if Get_Private_View(Top_Card_On_The_Deck) /= Queen_Of_Spades
-       then
-          Report.Failed ("Incorrect value in non-visible component - 1");
-       end if;
- 
-       -- Again, update the components of the card (to blank values).
- 
-       Hide_From_View(Top_Card_On_The_Deck);
- 
-       -- Verify that both components have been updated.
- 
-       if Get_View(Top_Card_On_The_Deck) /= Read_Em_And_Weep then
-          Report.Failed ("Incorrect value in visible component - 2");
-       end if;
- 
-       if Get_Private_View(Top_Card_On_The_Deck) /= Close_To_The_Vest
-       then
-          Report.Failed ("Incorrect value in non-visible component - 2");
-       end if;
- 
-    exception
-       when others => Report.Failed("Exception raised in test block");
-    end Check_Your_Cards;
- 
-    Report.Result;
- 
- end C730003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,327 ****
- -- C730004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that for a type declared in a package, descendants of the package
- --      use the full view of type.  Specifically check that full view of the
- --      limited type is visible only in private descendants (children) and in
- --      the private parts and bodies of public descendants (children).
- --      Check that a limited type may be used as an out parameter outside
- --      the package that defines the type.
- --
- -- TEST DESCRIPTION:
- --      This test defines a parent package containing limited private type 
- --      definitions. Children packages are defined (one public, one private) 
- --      that use the nonlimited full view of the types defined in the private 
- --      part of the parent specification.
- --      The main declares a procedure with an out parameter that was defined
- --      as limited in the specification of the parent package.
- --
- --
- -- CHANGE HISTORY:
- --      15 Sep 95   SAIC    Initial prerelease version.
- --      23 Apr 96   SAIC    Added prefix for parameter in Call_Modify_File.
- --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue and Test.Report. 
- --
- --!
- 
- package C730004_0 is 
- 
-    -- Full views of File_Descriptor, File_Mode, File_Name, and File_Type are
-    -- are nonlimited.
- 
-    type File_Descriptor is limited private;
- 
-    type File_Mode is limited private;
- 
-    Active_Mode  : constant File_Mode;
- 
-    type File_Name is limited private;
- 
-    type File_Type is limited private;
- 
-    function Next_Available_File return File_Descriptor;
- 
- private
- 
-    type File_Descriptor is new Integer;
- 
-    Null_File    : constant File_Descriptor := 0;
-    First_File   : constant File_Descriptor := 1;
- 
-    type File_Mode is 
-      (Read_Only, Write_Only, Read_Write, Archived, Corrupt, Lost);
- 
-    Default_Mode : constant File_Mode       := Read_Only;
-    Active_Mode  : constant File_Mode       := Read_Write;
- 
-    type File_Name is array (1 .. 6) of Character;
- 
-    Null_String : File_Name := "      ";
-    String1     : File_Name := "ACVC  ";
-    String2     : File_Name := "  1995";
- 
-    type File_Type is 
-      record
-         Descriptor : File_Descriptor := Null_File;
-         Mode       : File_Mode       := Default_Mode;
-         Name       : File_Name       := Null_String;
-      end record;
- 
- end C730004_0;       
- 
-      --=================================================================--
- 
- package body C730004_0 is     
- 
-    File_Count : Integer := 0;
- 
-    function Next_Available_File return File_Descriptor is
-    begin
-       File_Count := File_Count + 1;
-       return (File_Descriptor(File_Count));    -- Type conversion.
-    end Next_Available_File;
- 
- end C730004_0;     
- 
-      --=================================================================--
- 
- private
- package C730004_0.C730004_1 is                             -- private child
- 
-    -- Since full view of the nontagged File_Name is nonlimited in the parent 
-    -- package, it is not limited in the private child, so concatenation is 
-    -- available.
- 
-    System_File_Name :  constant File_Name
-                     := String1(1..4) & String2(5..6);
- 
-    -- Since full view of the nontagged File_Type is nonlimited in the parent 
-    -- package, it is not limited in the private child, so a default expression
-    -- is available.
- 
-    function New_File_Validated (File :  File_Type 
-                                      := (Descriptor => First_File,
-                                          Mode       => Active_Mode,
-                                          Name       => System_File_Name))
-      return Boolean;
- 
-    -- Since full view of the nontagged File_Type is nonlimited in the parent 
-    -- package, it is not limited in the private child, so initialization
-    -- expression in an object declaration is available.
- 
-    System_File      :  File_Type 
-                     := (Null_File, Read_Only, System_File_Name);
- 
- 
- end C730004_0.C730004_1;    
- 
-      --=================================================================--
- 
- package body C730004_0.C730004_1 is 
- 
-    function New_File_Validated (File :  File_Type 
-                                      := (Descriptor => First_File,
-                                          Mode       => Active_Mode,
-                                          Name       => System_File_Name))
-      return Boolean is                                   
-       Result : Boolean := False;                         
-    begin                                                 
-       if (File.Descriptor > System_File.Descriptor) and  
-          (File.Mode in Read_Only .. Read_Write) and (File.Name = "ACVC95")
-       then
-          Result := True;
-       end if;
- 
-       return (Result);
- 
-    end New_File_Validated;
- 
- end C730004_0.C730004_1;       
- 
-      --=================================================================--
- 
- package C730004_0.C730004_2 is                   -- public child
- 
-    -- File_Type is limited here.
- 
-    procedure Create_File (File : out File_Type);    
-                           
-    procedure Modify_File (File : out File_Type);
- 
-    type File_Dir is limited private;
- 
-    -- The following three validation functions provide the capability to 
-    -- check the limited private types defined in the parent and the
-    -- private child package from within the client program.
-                                    
-    function  Validate_Create (File : in File_Type) return Boolean;
- 
-    function  Validate_Modification (File : in File_Type) 
-      return Boolean;
- 
-    function  Validate_Dir (Dir : in File_Dir) return Boolean;
- 
- private
- 
-    -- Since full view of the nontagged File_Type is nonlimited in the parent 
-    -- package, it is not limited in the private part of the public child, so 
-    -- aggregates are available.
- 
-    Child_File :  File_Type 
-               := File_Type'(Descriptor => Null_File, 
-                             Mode       => Write_Only,
-                             Name       => String2);
-                      
-    -- Since full view of the nontagged component File_Type is nonlimited in 
-    -- the parent package, it is not limited in the private part of the public 
-    -- child, so default expressions are available.
- 
-    type File_Dir is 
-      record
-         Comp : File_Type := Child_File;
-      end record;
- 
- end C730004_0.C730004_2;             
- 
-      --=================================================================--
- 
- with C730004_0.C730004_1;
- 
- package body C730004_0.C730004_2 is  
- 
-    procedure Create_File (File : out File_Type) is
-       New_File : File_Type;
- 
-    begin
-       New_File.Descriptor := Next_Available_File;       
-       New_File.Mode       := Default_Mode;
-       New_File.Name       := C730004_0.C730004_1.System_File_Name;
- 
-       if C730004_0.C730004_1.New_File_Validated (New_File) then
-          File := New_File;
-       else 
-          File := (Null_File, Lost, "MISSED");
-       end if;
- 
-    end Create_File;
- 
-    --------------------------------------------------------------
-    procedure Modify_File (File : out File_Type) is
-    begin
-       File.Descriptor := Next_Available_File;      
-       File.Mode       := Active_Mode;
-       File.Name       := String1;
-    end Modify_File;     
- 
-    --------------------------------------------------------------
-    function  Validate_Create (File : in File_Type) return Boolean is
-    begin
-       if ((File.Descriptor /= Child_File.Descriptor) and
-           (File.Mode = Read_Only) and (File.Name = "ACVC95"))
-       then
-          return True;
-       else
-          return False;
-       end if;
-    end Validate_Create;
-   
-    ------------------------------------------------------------------------
-    function  Validate_Modification (File : in File_Type) 
-       return Boolean is      
-    begin
-       if ((File.Descriptor /= C730004_0.C730004_1.System_File.Descriptor) and 
-           (File.Mode = Read_Write) and (File.Name = "ACVC  "))
-       then
-          return True;
-       else
-          return False;
-       end if;
-    end Validate_Modification;
- 
-    ------------------------------------------------------------------------
-    function  Validate_Dir (Dir : in File_Dir) return Boolean is      
-    begin
-       if ((Dir.Comp.Descriptor = C730004_0.C730004_1.System_File.Descriptor) 
-         and (Dir.Comp.Mode = Write_Only) and (Dir.Comp.Name = String2))
-       then
-          return True;
-       else
-          return False;
-       end if;
-    end Validate_Dir;
- 
- end C730004_0.C730004_2;
- 
-      --=================================================================--
- 
- with C730004_0.C730004_2; 
- with Report;
- 
- procedure C730004 is
- 
-    package File      renames C730004_0;
-    package File_Ops  renames C730004_0.C730004_2;            
- 
-    Validation_File : File.File_Type;     
- 
-    Validation_Dir  : File_Ops.File_Dir;
- 
-    ------------------------------------------------------------------------ 
-    -- Limited File_Type is allowed as an out parameter outside package File.
- 
-    procedure Call_Modify_File (Modified_File : out File.File_Type) is
-    begin
-       File_Ops.Modify_File (Modified_File);
-    end Call_Modify_File;     
-   
- begin
- 
-    Report.Test ("C730004", "Check that for a type declared in a package, "   &
-                            "descendants of the package use the full view "   &
-                            "of the type.  Specifically check that full "     &
-                            "view of the limited type is visible only in "    &
-                            "private children and in the private parts and "  &
-                            "bodies of public children");
- 
-    File_Ops.Create_File (Validation_File);
- 
-    if not File_Ops.Validate_Create (Validation_File) then
-       Report.Failed ("Incorrect creation of file");
-    end if;
- 
-    Call_Modify_File (Validation_File);
- 
-    if not File_Ops.Validate_Modification (Validation_File) then 
-       Report.Failed ("Incorrect modification of file");
-    end if;
- 
-    if not File_Ops.Validate_Dir (Validation_Dir) then
-       Report.Failed ("Incorrect creation of directory");
-    end if;
- 
-    Report.Result;
- 
- end C730004; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c73002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c73002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c73002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c73002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C73002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE STATEMENTS IN A PACKAGE BODY ARE EXECUTED AFTER THE
- --    ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).
- 
- 
- -- RM 05/15/81
- -- JBG 9/21/83
- 
- WITH REPORT;
- PROCEDURE  C73002A  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "C73002A" , "CHECK: EXECUTION OF STATEMENTS IN A PACKAGE " &
-                        "BODY FOLLOWS ELABORATION OF THE DECLARATIONS");
- 
-      DECLARE
- 
-           PACKAGE  P1  IS
- 
-                A : INTEGER := IDENT_INT(7);
- 
-                PACKAGE  P2  IS
-                     B : INTEGER := IDENT_INT(11);
-                END  P2;
- 
-           END  P1;
- 
- 
-           PACKAGE BODY  P1  IS               --   A  AA   B  BB
- 
-                AA : INTEGER := IDENT_INT(7); --   7   7  11 (11)
- 
-                PACKAGE BODY  P2  IS
-                     BB : INTEGER := IDENT_INT(11);--  7  11  11
-                BEGIN
- 
-                     B  := 2*B ;             --   7   7  22  11
-                     BB := 2*BB;             --   7   7  22  22
-                     A  := 5*A ;             --  35   7  22  22
-                     AA := 2*AA;             --  35  14  22  22
- 
-                     IF  BB /=  22  OR
-                         AA /=  14  OR
-                         A  /=  35  OR
-                         B  /=  22
-                     THEN
-                          FAILED( "ASSIGNED VALUES INCORRECT  -  1" );
-                     END IF;
- 
-                END  P2;
- 
-           BEGIN
- 
-                A  :=  A  + 20;              --  55  14  22  22
-                AA :=  AA + 20;              --  55  34  22  22
- 
-                IF  AA /=  34  OR
-                    A  /=  55  OR
-                    P2.B /=  22
-                THEN
-                     FAILED( "ASSIGNED VALUES INCORRECT  -  2" );
-                END IF;
- 
-           END  P1;
- 
- 
-           USE  P1;
-           USE  P2;
- 
-      BEGIN
- 
-           IF  A  /=  55  OR
-               B  /=  22
-           THEN
-                FAILED( "ASSIGNED VALUES INCORRECT  -  3" );
-           END IF;
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END C73002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,176 ****
- -- C730A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a tagged type declared in a package specification
- --      may be passed as a generic formal (tagged) private type to a generic
- --      package declaration. Check that the formal type may be extended with
- --      a private extension in the generic package.
- --
- --      Check that, in the instance, the private extension inherits the
- --      user-defined primitive subprograms of the tagged actual.
- --
- -- TEST DESCRIPTION:
- --      Declare a tagged type and an associated primitive subprogram in a
- --      package specification (foundation code). Declare a generic package
- --      which takes a tagged type as a formal parameter, and then extends
- --      it with a private extension (foundation code).
- --      
- --      Instantiate the generic package with the tagged type from the first
- --      package (the "generic" extension should now have inherited
- --      the primitive subprogram of the tagged type from the first
- --      package).
- -- 
- --      In the main program, call the primitive subprogram inherited by the
- --      "generic" extension, and verify the correctness of the components.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F730A000.A
- --         F730A001.A
- --      => C730A01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with F730A001;        -- Book definitions.
- package C730A01_0 is  -- Raw data to be used in creating book elements.
- 
- 
-    Book_Count : constant := 3;
- 
-    subtype Number_Of_Books is Integer range 1 .. Book_Count;
- 
-    type Data_List is array (Number_Of_Books) of F730A001.Text_Ptr;
- 
-    Title_List  : Data_List := (new String'("Wuthering Heights"),
-                                new String'("Heart of Darkness"),
-                                new String'("Ulysses"));
- 
-    Author_List : Data_List := (new String'("Bronte, Emily"),
-                                new String'("Conrad, Joseph"),
-                                new String'("Joyce, James"));
- 
- end C730A01_0;
- 
- 
-      --==================================================================--
- 
- 
- 
- 
-      --==================================================================--
- 
- 
- -- Library-level instantiation. Actual parameter is tagged record.
- 
- with F730A001;  -- Book definitions.
- with F730A000;  -- Singly-linked list abstraction.
- package C730A01_1 is new F730A000 (Parent_Type => F730A001.Book_Type);
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with F730A001;   -- Book definitions.
- with C730A01_0;  -- Raw book data.
- with C730A01_1;  -- Instance.
- 
- use  F730A001;   -- Primitive operations of Book_Type directly visible.
- use  C730A01_1;  -- Operations inherited by Node_Type directly visible.
- 
- procedure C730A01 is
- 
- 
-    List_Of_Books : Priv_Node_Ptr := null;  -- Head of linked list of books.
- 
- 
-           --========================================================--
- 
- 
-    procedure Create_List (Title, Author : in     C730A01_0.Data_List;
-                           Head          : in out Priv_Node_Ptr) is
- 
-       Book     : Priv_Node_Type;  -- Object of extended type.
-       Book_Ptr : Priv_Node_Ptr;
- 
-    begin
-       for I in C730A01_0.Number_Of_Books loop
-          Create_Book (Title (I), Author (I), Book);    -- Call inherited
-                                                        -- operation.
-          Book_Ptr := new Priv_Node_Type'(Book);
-          Add (Book_Ptr, Head);
-       end loop;
-    end Create_List;
- 
- 
-           --========================================================--
- 
- 
-    function Bad_List_Contents return Boolean is
-       Book1_Ptr : Priv_Node_Ptr;
-       Book2_Ptr : Priv_Node_Ptr;
-       Book3_Ptr : Priv_Node_Ptr;
-    begin
-       Remove (List_Of_Books, Book1_Ptr);
-       Remove (List_Of_Books, Book2_Ptr);
-       Remove (List_Of_Books, Book3_Ptr);
-       return (Book1_Ptr.Title.all  /= "Ulysses"           or   -- Inherited
-               Book1_Ptr.Author.all /= "Joyce, James"      or   -- components
-               Book2_Ptr.Title.all  /= "Heart of Darkness" or   -- should still
-               Book2_Ptr.Author.all /= "Conrad, Joseph"    or   -- be visible in
-               Book3_Ptr.Title.all  /= "Wuthering Heights" or   -- private
-               Book3_Ptr.Author.all /= "Bronte, Emily");        -- extension.
- 
-    end Bad_List_Contents;
- 
- 
-           --========================================================--
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("C730A01", "Inheritance of primitive operations: private " &
-                 "extension of formal tagged private type; actual is " &
-                 "an ultimate ancestor type");
- 
-    -- Create linked list using inherited operation:
-    Create_List (C730A01_0.Title_List, C730A01_0.Author_List, List_Of_Books);
- 
-    -- Verify results:
-    if Bad_List_Contents then
-       Report.Failed ("Wrong values after call to inherited operation");
-    end if;
- 
-    Report.Result;
- 
- end C730A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c730a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c730a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,252 ****
- -- C730A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a private extension (declared in a package specification) of
- --      a tagged type (declared in a different package specification) may be
- --      passed as a generic formal (tagged) private type to a generic package
- --      declaration. Check that the formal type may be further extended with a
- --      private extension in the generic package.
- --
- --      Check that the (visible) components inherited by the "generic"
- --      extension are visible outside the generic package.
- --
- --      Check that, in the instance, the private extension inherits the
- --      user-defined primitive subprograms of the tagged actual, including
- --      those inherited by the actual from its parent.
- --
- -- TEST DESCRIPTION:
- --      Declare a tagged type and an associated primitive subprogram in a
- --      package specification (foundation code). Declare a private extension
- --      of the tagged type and an associated primitive subprogram in a second
- --      package specification. Declare a generic package which takes a tagged
- --      type as a formal parameter, and then extends it with a private
- --      extension (foundation code).
- --      
- --      Instantiate the generic package with the private extension from the
- --      second package (the "generic" extension should now have inherited
- --      the primitive subprograms of the private extension from the second
- --      package).
- -- 
- --      In the main program, call the primitive subprograms inherited by the
- --      "generic" extension. There are two: (1) Create_Book, declared for
- --      the root tagged type in the first package (inherited by the private
- --      extension of the second package, and then in turn by the "generic"
- --      extension), and (2) Update_Pages, declared for the private extension
- --      in the second package. Verify the correctness of the components.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         F730A000.A
- --         F730A001.A
- --      => C730A02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with F730A001;        -- Book definitions.
- package C730A02_0 is  -- Extended book abstraction.
- 
- 
-    type Detailed_Book_Type is new F730A001.Book_Type          -- Private ext.
-      with private;                                            -- of root tagged
-                                                               -- type.
- 
-    -- Inherits Create_Book from Book_Type.
- 
-    procedure Update_Pages (Book  : in out Detailed_Book_Type; -- Primitive op.
-                            Pages : in     Natural);           -- of extension.
- 
- 
-    -- The following function is needed to verify the value of the
-    -- extension's private component. It will be inherited by extensions
-    -- of Detailed_Book_Type.
- 
-    function Get_Pages (Book : in Detailed_Book_Type) return Natural;
-                                                    
- private
- 
-    type Detailed_Book_Type is new F730A001.Book_Type with record
-       Pages : Natural;
-    end record;
- 
- end C730A02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C730A02_0 is
- 
- 
-    procedure Update_Pages (Book  : in out Detailed_Book_Type;
-                            Pages : in     Natural) is
-    begin
-       Book.Pages := Pages;
-    end Update_Pages;
- 
- 
-    function Get_Pages (Book : in Detailed_Book_Type) return Natural is
-    begin
-       return (Book.Pages);
-    end Get_Pages;
- 
- 
- end C730A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with F730A001;        -- Book definitions. 
- package C730A02_1 is  -- Raw data to be used in creating book elements.
- 
- 
-    Book_Count : constant := 3;
- 
-    subtype Number_Of_Books is Integer range 1 .. Book_Count;
- 
-    type Data_List   is array (Number_Of_Books) of F730A001.Text_Ptr;
-    type Page_Counts is array (Number_Of_Books) of Natural;
- 
-    Title_List  : Data_List   := (new String'("Wuthering Heights"),
-                                  new String'("Heart of Darkness"),
-                                  new String'("Ulysses"));
- 
-    Author_List : Data_List   := (new String'("Bronte, Emily"),
-                                  new String'("Conrad, Joseph"),
-                                  new String'("Joyce, James"));
- 
-    Page_List   : Page_Counts := (237, 215, 456);
- 
- end C730A02_1;
- 
- 
- -- No body for C730A02_1.
- 
- 
-      --==================================================================--
- 
- 
- -- Library-level instantiation. Actual parameter is private extension.
- 
- with C730A02_0;  -- Extended book abstraction.
- with F730A000;   -- Singly-linked list abstraction.
- package C730A02_2 is new F730A000
-   (Parent_Type => C730A02_0.Detailed_Book_Type);
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with C730A02_0; -- Extended book abstraction.
- with C730A02_1; -- Raw book data.
- with C730A02_2; -- Instance.
- 
- use  C730A02_0; -- Primitive operations of Detailed_Book_Type directly visible.
- use  C730A02_2; -- Operations inherited by Priv_Node_Type directly visible.
- 
- procedure C730A02 is
- 
- 
-    List_Of_Books : Priv_Node_Ptr := null;  -- Head of linked list of books.
- 
- 
-           --========================================================--
- 
- 
-    procedure Create_List (Title, Author : in     C730A02_1.Data_List;
-                           Pages         : in     C730A02_1.Page_Counts;
-                           Head          : in out Priv_Node_Ptr) is
- 
-       Book     : Priv_Node_Type;  -- Object of extended type.
-       Book_Ptr : Priv_Node_Ptr;
- 
-    begin
-       for I in C730A02_1.Number_Of_Books loop
-          Create_Book (Title (I), Author (I), Book);    -- Call twice-inherited
-                                                        -- operation.
-          Update_Pages (Book, Pages (I));               -- Call inherited op.
-          Book_Ptr := new Priv_Node_Type'(Book);
-          Add (Book_Ptr, Head);
-       end loop;
-    end Create_List;
- 
- 
-           --========================================================--
- 
- 
-    function Bad_List_Contents return Boolean is
-       Book1_Ptr : Priv_Node_Ptr;
-       Book2_Ptr : Priv_Node_Ptr;
-       Book3_Ptr : Priv_Node_Ptr;
-    begin
- 
-       Remove (List_Of_Books, Book1_Ptr);
-       Remove (List_Of_Books, Book2_Ptr);
-       Remove (List_Of_Books, Book3_Ptr);
- 
-       return (Book1_Ptr.Title.all   /= "Ulysses"           or   -- Inherited
-               Book1_Ptr.Author.all  /= "Joyce, James"      or   -- components
-               Book2_Ptr.Title.all   /= "Heart of Darkness" or   -- should still
-               Book2_Ptr.Author.all  /= "Conrad, Joseph"    or   -- be visible
-               Book3_Ptr.Title.all   /= "Wuthering Heights" or   -- in private
-               Book3_Ptr.Author.all  /= "Bronte, Emily"     or   -- "generic"
-                                                                 -- extension.
-               -- Call inherited operations using dereferenced pointers.
-               Get_Pages (Book1_Ptr.all) /= 456             or
-               Get_Pages (Book2_Ptr.all) /= 215             or
-               Get_Pages (Book3_Ptr.all) /= 237);
- 
-    end Bad_List_Contents;
- 
- 
-           --========================================================--
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("C730A02", "Inheritance of primitive operations: private " &
-                 "extension of formal tagged private type; actual is " &
-                 "a private extension");
- 
-    -- Create linked list using inherited operation:
-    Create_List (C730A02_1.Title_List, C730A02_1.Author_List,
-                 C730A02_1.Page_List,  List_Of_Books);
- 
-    -- Verify results:
-    if Bad_List_Contents then
-       Report.Failed ("Wrong values after call to inherited operations");
-    end if;
- 
-    Report.Result;
- 
- end C730A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c731001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c731001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c731001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c731001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,407 ****
- -- C731001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check that inherited operations can be overridden, even when they are
- --     inherited in a body.
- --     The test cases here are inspired by the AARM examples given in
- --     the discussion of AARM-7.3.1(7.a-7.v).
- --     This discussion was confirmed by AI95-00035.
- --
- -- TEST DESCRIPTION
- --     See AARM-7.3.1.
- --
- -- CHANGE HISTORY:
- --      29 JUN 1999   RAD   Initial Version
- --      23 SEP 1999   RLB   Improved comments, renamed, issued.
- --      20 AUG 2001   RLB   Corrected 'verbose' flag.
- --
- --!
- 
- with Report; use Report; pragma Elaborate_All(Report);
- package C731001_1 is
-     pragma Elaborate_Body;
- private
-     procedure Check_String(X, Y: String);
-     function Check_String(X, Y: String) return String;
-         -- This one is a function, so we can call it in package specs.
- end C731001_1;
- 
- package body C731001_1 is
- 
-     Verbose: Boolean := False;
- 
-     procedure Check_String(X, Y: String) is
-     begin
-         if Verbose then
-             Comment("""" & X & """ = """ & Y & """?");
-         end if;
-         if X /= Y then
-             Failed("""" & X & """ should be """ & Y & """");
-         end if;
-     end Check_String;
- 
-     function Check_String(X, Y: String) return String is
-     begin
-         Check_String(X, Y);
-         return X;
-     end Check_String;
- 
- end C731001_1;
- 
- private package C731001_1.Parent is
- 
-     procedure Call_Main;
- 
-     type Root is tagged null record;
-     subtype Renames_Root is Root;
-     subtype Root_Class is Renames_Root'Class;
-     function Make return Root;
-     function Op1(X: Root) return String;
-     function Call_Op2(X: Root'Class) return String;
- private
-     function Op2(X: Root) return String;
- end C731001_1.Parent;
- 
- procedure C731001_1.Parent.Main;
- 
- with C731001_1.Parent.Main;
- package body C731001_1.Parent is
- 
-     procedure Call_Main is
-     begin
-         Main;
-     end Call_Main;
- 
-     function Make return Root is
-         Result: Root;
-     begin
-         return Result;
-     end Make;
- 
-     function Op1(X: Root) return String is
-     begin
-         return "Parent.Op1 body";
-     end Op1;
- 
-     function Op2(X: Root) return String is
-     begin
-         return "Parent.Op2 body";
-     end Op2;
- 
-     function Call_Op2(X: Root'Class) return String is
-     begin
-         return Op2(X);
-     end Call_Op2;
- 
- begin
- 
-     Check_String(Op1(Root'(Make)), "Parent.Op1 body");
-     Check_String(Op1(Root_Class(Root'(Make))), "Parent.Op1 body");
- 
-     Check_String(Op2(Root'(Make)), "Parent.Op2 body");
-     Check_String(Op2(Root_Class(Root'(Make))), "Parent.Op2 body");
- 
- end C731001_1.Parent;
- 
- with C731001_1.Parent; use C731001_1.Parent;
- private package C731001_1.Unrelated is
- 
-     type T2 is new Root with null record;
-     subtype T2_Class is T2'Class;
-     function Make return T2;
-     function Op2(X: T2) return String;
- end C731001_1.Unrelated;
- 
- with C731001_1.Parent; use C731001_1.Parent;
-     pragma Elaborate(C731001_1.Parent);
- package body C731001_1.Unrelated is
- 
-     function Make return T2 is
-         Result: T2;
-     begin
-         return Result;
-     end Make;
- 
-     function Op2(X: T2) return String is
-     begin
-         return "Unrelated.Op2 body";
-     end Op2;
- begin
- 
-     Check_String(Op1(T2'(Make)), "Parent.Op1 body");
-     Check_String(Op1(T2_Class(T2'(Make))), "Parent.Op1 body");
-     Check_String(Op1(Root_Class(T2'(Make))), "Parent.Op1 body");
- 
-     Check_String(Op2(T2'(Make)), "Unrelated.Op2 body");
-     Check_String(Op2(T2_Class(T2'(Make))), "Unrelated.Op2 body");
-     Check_String(Call_Op2(T2'(Make)), "Parent.Op2 body");
-     Check_String(Call_Op2(T2_Class(T2'(Make))), "Parent.Op2 body");
-     Check_String(Call_Op2(Root_Class(T2'(Make))), "Parent.Op2 body");
- 
- end C731001_1.Unrelated;
- 
- package C731001_1.Parent.Child is
-     pragma Elaborate_Body;
- 
-     type T3 is new Root with null record;
-     subtype T3_Class is T3'Class;
-     function Make return T3;
- 
-     T3_Obj: T3;
-     T3_Class_Obj: T3_Class := T3_Obj;
-     T3_Root_Class_Obj: Root_Class := T3_Obj;
- 
-     X3: constant String :=
-       Check_String(Op1(T3_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
- 
-       Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
- 
-     package Nested is
-         type T4 is new Root with null record;
-         subtype T4_Class is T4'Class;
-         function Make return T4;
- 
-         T4_Obj: T4;
-         T4_Class_Obj: T4_Class := T4_Obj;
-         T4_Root_Class_Obj: Root_Class := T4_Obj;
- 
-         X4: constant String :=
-           Check_String(Op1(T4_Obj), "Parent.Op1 body") &
-           Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
-           Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
- 
-           Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
-           Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
-           Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
-     private
- 
-         XX4: constant String :=
-           Check_String(Op1(T4_Obj), "Parent.Op1 body") &
-           Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
-           Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
- 
-           Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
-           Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
-           Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
-     end Nested;
- 
-     use Nested;
- 
-     XXX4: constant String :=
-       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
- 
-       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
- private
- 
-     XX3: constant String :=
-       Check_String(Op1(T3_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
- 
-       Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
- 
-       Check_String(Op2(T3_Obj), "Parent.Op2 body") &
-       Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
-       Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
- 
-     XXXX4: constant String :=
-       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
- 
-       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
- 
-       Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
- end C731001_1.Parent.Child;
- 
- with C731001_1.Unrelated; use C731001_1.Unrelated;
-     pragma Elaborate(C731001_1.Unrelated);
- package body C731001_1.Parent.Child is
- 
-     XXX3: constant String :=
-       Check_String(Op1(T3_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
- 
-       Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
- 
-       Check_String(Op2(T3_Obj), "Parent.Op2 body") &
-       Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
-       Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
- 
-     XXXXX4: constant String :=
-       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
- 
-       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
- 
-       Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
-     function Make return T3 is
-         Result: T3;
-     begin
-         return Result;
-     end Make;
- 
-     package body Nested is
-         function Make return T4 is
-             Result: T4;
-         begin
-             return Result;
-         end Make;
- 
-         XXXXXX4: constant String :=
-           Check_String(Op1(T4_Obj), "Parent.Op1 body") &
-           Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
-           Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
- 
-           Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
-           Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
-           Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
- 
-           Check_String(Op2(T4_Obj), "Parent.Op2 body") &
-           Check_String(Op2(T4_Class_Obj), "Parent.Op2 body") &
-           Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
-     end Nested;
- 
-     type T5 is new T2 with null record;
-     subtype T5_Class is T5'Class;
-     function Make return T5;
- 
-     function Make return T5 is
-         Result: T5;
-     begin
-         return Result;
-     end Make;
- 
-     XXXXXXX4: constant String :=
-       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
-       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
- 
-       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
-       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
- 
-       Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
- end C731001_1.Parent.Child;
- 
- procedure C731001_1.Main;
- 
- with C731001_1.Parent;
- procedure C731001_1.Main is
- begin
-     C731001_1.Parent.Call_Main;
- end C731001_1.Main;
- 
- with C731001_1.Parent.Child;
-     use C731001_1.Parent;
-     use C731001_1.Parent.Child;
-     use C731001_1.Parent.Child.Nested;
- with C731001_1.Unrelated; use C731001_1.Unrelated;
- procedure C731001_1.Parent.Main is
- 
-     Root_Obj: Root := Make;
-     Root_Class_Obj: Root_Class := Root'(Make);
- 
-     T2_Obj: T2 := Make;
-     T2_Class_Obj: T2_Class := T2_Obj;
-     T2_Root_Class_Obj: Root_Class := T2_Class_Obj;
- 
-     T3_Obj: T3 := Make;
-     T3_Class_Obj: T3_Class := T3_Obj;
-     T3_Root_Class_Obj: Root_Class := T3_Obj;
- 
-     T4_Obj: T4 := Make;
-     T4_Class_Obj: T4_Class := T4_Obj;
-     T4_Root_Class_Obj: Root_Class := T4_Obj;
- 
- begin
-     Test("C731001_1", "Check that inherited operations can be overridden, even"
-                     & " when they are inherited in a body");
- 
-     Check_String(Op1(Root_Obj), "Parent.Op1 body");
-     Check_String(Op1(Root_Class_Obj), "Parent.Op1 body");
- 
-     Check_String(Call_Op2(Root_Obj), "Parent.Op2 body");
-     Check_String(Call_Op2(Root_Class_Obj), "Parent.Op2 body");
- 
-     Check_String(Op1(T2_Obj), "Parent.Op1 body");
-     Check_String(Op1(T2_Class_Obj), "Parent.Op1 body");
-     Check_String(Op1(T2_Root_Class_Obj), "Parent.Op1 body");
- 
-     Check_String(Op2(T2_Obj), "Unrelated.Op2 body");
-     Check_String(Op2(T2_Class_Obj), "Unrelated.Op2 body");
-     Check_String(Call_Op2(T2_Obj), "Parent.Op2 body");
-     Check_String(Call_Op2(T2_Class_Obj), "Parent.Op2 body");
-     Check_String(Call_Op2(T2_Root_Class_Obj), "Parent.Op2 body");
- 
-     Check_String(Op1(T3_Obj), "Parent.Op1 body");
-     Check_String(Op1(T3_Class_Obj), "Parent.Op1 body");
-     Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body");
- 
-     Check_String(Call_Op2(T3_Obj), "Parent.Op2 body");
-     Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body");
-     Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
- 
-     Check_String(Op1(T4_Obj), "Parent.Op1 body");
-     Check_String(Op1(T4_Class_Obj), "Parent.Op1 body");
-     Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body");
- 
-     Check_String(Call_Op2(T4_Obj), "Parent.Op2 body");
-     Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body");
-     Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
- 
-     Result;
- end C731001_1.Parent.Main;
- 
- with C731001_1.Main;
- procedure C731001 is
- begin
-     C731001_1.Main;
- end C731001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,375 ****
- -- C74004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OPERATIONS DEPENDING ON THE FULL DECLARATION OF A
- --     PRIVATE TYPE ARE AVAILABLE WITHIN THE PACKAGE BODY.
- 
- -- HISTORY:
- --     BCB 04/05/88  CREATED ORIGINAL TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74004A IS
- 
-      PACKAGE P IS
-           TYPE PR IS PRIVATE;
-           TYPE ARR1 IS LIMITED PRIVATE;
-           TYPE ARR2 IS PRIVATE;
-           TYPE REC (D : INTEGER) IS PRIVATE;
-           TYPE ACC IS PRIVATE;
-           TYPE TSK IS LIMITED PRIVATE;
-           TYPE FLT IS LIMITED PRIVATE;
-           TYPE FIX IS LIMITED PRIVATE;
- 
-           TASK TYPE T IS
-                ENTRY ONE(V : IN OUT INTEGER);
-           END T;
- 
-           PROCEDURE CHECK (V : ARR2);
-      PRIVATE
-           TYPE PR IS NEW INTEGER;
- 
-           TYPE ARR1 IS ARRAY(1..5) OF INTEGER;
- 
-           TYPE ARR2 IS ARRAY(1..5) OF BOOLEAN;
- 
-           TYPE REC (D : INTEGER) IS RECORD
-                COMP1 : INTEGER;
-                COMP2 : BOOLEAN;
-           END RECORD;
- 
-           TYPE ACC IS ACCESS INTEGER;
- 
-           TYPE TSK IS NEW T;
- 
-           TYPE FLT IS DIGITS 5;
- 
-           TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
-      END P;
- 
-      PACKAGE BODY P IS
-           X1, X2, X3 : PR;
-           BOOL : BOOLEAN := IDENT_BOOL(FALSE);
-           VAL : INTEGER := IDENT_INT(0);
-           FVAL : FLOAT := 0.0;
-           ST : STRING(1..2);
-           O1 : ARR1 := (1,2,3,4,5);
-           Y1 : ARR2 := (FALSE,TRUE,FALSE,TRUE,FALSE);
-           Y2 : ARR2 := (OTHERS => TRUE);
-           Y3 : ARR2 := (OTHERS => FALSE);
-           Z1 : REC(0) := (0,1,FALSE);
-           W1, W2 : ACC := NEW INTEGER'(0);
-           V1 : TSK;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT ONE(V : IN OUT INTEGER) DO
-                     V := IDENT_INT(10);
-                END ONE;
-           END T;
- 
-           PROCEDURE CHECK (V : ARR2) IS
-           BEGIN
-                IF V /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
-                     FAILED ("IMPROPER VALUE PASSED AS AGGREGATE");
-                END IF;
-           END CHECK;
-      BEGIN
-           TEST ("C74004A", "CHECK THAT OPERATIONS DEPENDING ON THE " &
-                            "FULL DECLARATION OF A PRIVATE TYPE ARE " &
-                            "AVAILABLE WITHIN THE PACKAGE BODY");
- 
-           X1 := 10;
-           X2 := 5;
- 
-           X3 := X1 + X2;
- 
-           IF X3 /= 15 THEN
-                FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
-           END IF;
- 
-           X3 := X1 - X2;
- 
-           IF X3 /= 5 THEN
-                FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
-           END IF;
- 
-           X3 := X1 * X2;
- 
-           IF X3 /= 50 THEN
-                FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
-           END IF;
- 
-           X3 := X1 / X2;
- 
-           IF X3 /= 2 THEN
-                FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
-           END IF;
- 
-           X3 := X1 ** 2;
- 
-           IF X3 /= 100 THEN
-                FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
-           END IF;
- 
-           BOOL := X1 < X2;
- 
-           IF BOOL THEN
-                FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
-           END IF;
- 
-           BOOL := X1 > X2;
- 
-           IF NOT BOOL THEN
-                FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
-           END IF;
- 
-           BOOL := X1 <= X2;
- 
-           IF BOOL THEN
-                FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
-                        "OPERATOR");
-           END IF;
- 
-           BOOL := X1 >= X2;
- 
-           IF NOT BOOL THEN
-                FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
-                        "TO OPERATOR");
-           END IF;
- 
-           X3 := X1 MOD X2;
- 
-           IF X3 /= 0 THEN
-                FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
-           END IF;
- 
-           X3 := X1 REM X2;
- 
-           IF X3 /= 0 THEN
-                FAILED ("IMPROPER RESULT FROM REM OPERATOR");
-           END IF;
- 
-           X3 := ABS(X1);
- 
-           IF X3 /= 10 THEN
-                FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 1");
-           END IF;
- 
-           X1 := -10;
- 
-           X3 := ABS(X1);
- 
-           IF X3 /= 10 THEN
-                FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 2");
-           END IF;
- 
-           X3 := PR'BASE'FIRST;
- 
-           IF X3 /= PR(INTEGER'FIRST) THEN
-                FAILED ("IMPROPER RESULT FROM 'BASE'FIRST");
-           END IF;
- 
-           X3 := PR'FIRST;
- 
-           IF X3 /= PR(INTEGER'FIRST) THEN
-                FAILED ("IMPROPER RESULT FROM 'FIRST");
-           END IF;
- 
-           VAL := PR'WIDTH;
- 
-           IF NOT EQUAL(VAL,INTEGER'WIDTH) THEN
-                FAILED ("IMPROPER RESULT FROM 'WIDTH");
-           END IF;
- 
-           VAL := PR'POS(X3);
- 
-           IF NOT EQUAL(VAL,INTEGER'FIRST) THEN
-                FAILED ("IMPROPER RESULT FROM 'POS");
-           END IF;
- 
-           X3 := PR'VAL(VAL);
- 
-           IF X3 /= PR(INTEGER'FIRST) THEN
-                FAILED ("IMPROPER RESULT FROM 'VAL");
-           END IF;
- 
-           X3 := PR'SUCC(X2);
- 
-           IF X3 /= 6 THEN
-                FAILED ("IMPROPER RESULT FROM 'SUCC");
-           END IF;
- 
-           X3 := PR'PRED(X2);
- 
-           IF X3 /= 4 THEN
-                FAILED ("IMPROPER RESULT FROM 'PRED");
-           END IF;
- 
-           ST := PR'IMAGE(X3);
- 
-           IF ST /= INTEGER'IMAGE(INTEGER(X3)) THEN
-                FAILED ("IMPROPER RESULT FROM 'IMAGE");
-           END IF;
- 
-           X3 := PR'VALUE(ST);
- 
-           IF X3 /= PR(INTEGER'VALUE(ST)) THEN
-                FAILED ("IMPROPER RESULT FROM 'VALUE");
-           END IF;
- 
-           CHECK ((TRUE,FALSE,TRUE,FALSE,TRUE));
- 
-           IF O1(2) /= IDENT_INT(2) THEN
-                FAILED ("IMPROPER VALUE FROM INDEXING");
-           END IF;
- 
-           IF O1(2..4) /= (2,3,4) THEN
-                FAILED ("IMPROPER VALUES FROM SLICING");
-           END IF;
- 
-           IF VAL IN O1'RANGE THEN
-                FAILED ("IMPROPER RESULT FROM 'RANGE");
-           END IF;
- 
-           VAL := O1'LENGTH;
- 
-           IF NOT EQUAL(VAL,5) THEN
-                FAILED ("IMPROPER RESULT FROM 'LENGTH");
-           END IF;
- 
-           Y3 := Y1(1..2) & Y2(3..5);
- 
-           IF Y3 /= (FALSE,TRUE,TRUE,TRUE,TRUE) THEN
-                FAILED ("IMPROPER RESULT FROM CATENATION");
-           END IF;
- 
-           Y3 := NOT Y1;
- 
-           IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
-                FAILED ("IMPROPER RESULT FROM NOT OPERATOR");
-           END IF;
- 
-           Y3 := Y1 AND Y2;
- 
-           IF Y3 /= (FALSE,TRUE,FALSE,TRUE,FALSE) THEN
-                FAILED ("IMPROPER RESULT FROM AND OPERATOR");
-           END IF;
- 
-           Y3 := Y1 OR Y2;
- 
-           IF Y3 /= (TRUE,TRUE,TRUE,TRUE,TRUE) THEN
-                FAILED ("IMPROPER RESULT FROM OR OPERATOR");
-           END IF;
- 
-           Y3 := Y1 XOR Y2;
- 
-           IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
-                FAILED ("IMPROPER RESULT FROM XOR OPERATOR");
-           END IF;
- 
-           VAL := Z1.COMP1;
- 
-           IF NOT EQUAL(VAL,1) THEN
-                FAILED ("IMPROPER RESULT FROM SELECTION OF RECORD " &
-                        "COMPONENTS");
-           END IF;
- 
-           W1 := NEW INTEGER'(0);
- 
-           IF NOT EQUAL(W1.ALL,0) THEN
-                FAILED ("IMPROPER RESULT FROM ALLOCATION");
-           END IF;
- 
-           W1 := NULL;
- 
-           IF W1 /= NULL THEN
-                FAILED ("IMPROPER RESULT FROM NULL LITERAL");
-           END IF;
- 
-           VAL := W2.ALL;
- 
-           IF NOT EQUAL(VAL,0) THEN
-                FAILED ("IMPROPER RESULT FROM SELECTED COMPONENT");
-           END IF;
- 
-           BOOL := V1'CALLABLE;
- 
-           IF NOT BOOL THEN
-                FAILED ("IMPROPER RESULT FROM 'CALLABLE");
-           END IF;
- 
-           BOOL := V1'TERMINATED;
- 
-           IF BOOL THEN
-                FAILED ("IMPROPER RESULT FROM 'TERMINATED");
-           END IF;
- 
-           V1.ONE(VAL);
- 
-           IF NOT EQUAL(VAL,10) THEN
-                FAILED ("IMPROPER RESULT RETURNED FROM ENTRY SELECTION");
-           END IF;
- 
-           IF NOT (FLT(1.0) IN FLT) THEN
-                FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
-           END IF;
- 
-           VAL := FLT'DIGITS;
- 
-           IF NOT EQUAL(VAL,5) THEN
-                FAILED ("IMPROPER RESULT FROM 'DIGITS");
-           END IF;
- 
-           BOOL := FLT'MACHINE_ROUNDS;
- 
-           BOOL := FLT'MACHINE_OVERFLOWS;
- 
-           VAL := FLT'MACHINE_RADIX;
- 
-           VAL := FLT'MACHINE_MANTISSA;
- 
-           VAL := FLT'MACHINE_EMAX;
- 
-           VAL := FLT'MACHINE_EMIN;
- 
-           FVAL := FIX'DELTA;
- 
-           IF FVAL /= 2.0**(-1) THEN
-                FAILED ("IMPROPER RESULT FROM 'DELTA");
-           END IF;
- 
-           VAL := FIX'FORE;
- 
-           VAL := FIX'AFT;
- 
-      END P;
- 
-      USE P;
- 
- BEGIN
-      RESULT;
- END C74004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74203a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74203a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74203a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,263 ****
- -- C74203A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT MEMBERSHIP TESTS, QUALIFICATION, AND EXPLICIT
- --     CONVERSION ARE AVAILABLE FOR LIMITED AND NON-LIMITED PRIVATE
- --     TYPES.  INCLUDE TYPES WITH DISCRIMINANTS AND TYPES
- --     WITH LIMITED COMPONENTS.
- 
- -- HISTORY:
- --     BCB 03/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74203A IS
- 
-      PACKAGE PP IS
-           TYPE LIM IS LIMITED PRIVATE;
-           PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER);
- 
-           TYPE A IS PRIVATE;
-           SUBTYPE SUBA IS A;
-           A1 : CONSTANT A;
- 
-           TYPE B IS LIMITED PRIVATE;
-           B1 : CONSTANT B;
- 
-           TYPE C IS PRIVATE;
-           C1 : CONSTANT C;
- 
-           TYPE D IS LIMITED PRIVATE;
-           D1 : CONSTANT D;
- 
-           TYPE E (DISC1 : INTEGER := 5) IS PRIVATE;
-           SUBTYPE SUBE IS E;
-           E1 : CONSTANT E;
- 
-           TYPE F (DISC2 : INTEGER := 15) IS LIMITED PRIVATE;
-           F1 : CONSTANT F;
- 
-           TYPE G (DISC3 : INTEGER) IS PRIVATE;
-           G1 : CONSTANT G;
- 
-           TYPE H (DISC4 : INTEGER) IS LIMITED PRIVATE;
-           H1 : CONSTANT H;
- 
-           TYPE I IS RECORD
-                COMPI : LIM;
-           END RECORD;
-           SUBTYPE SUBI IS I;
- 
-           TYPE J IS ARRAY(1..5) OF LIM;
-           SUBTYPE SUBJ IS J;
- 
-           TYPE S1 IS (VINCE, TOM, PHIL, JODIE, ROSA, TERESA);
-           TYPE S2 IS (THIS, THAT, THESE, THOSE, THEM);
-           TYPE S3 IS RANGE 1 .. 100;
-           TYPE S4 IS RANGE 1 .. 100;
-      PRIVATE
-           TYPE LIM IS RANGE 1 .. 100;
- 
-           TYPE A IS (RED, BLUE, GREEN, YELLOW, BLACK, WHITE);
-           A1 : CONSTANT A := BLUE;
- 
-           TYPE B IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
-           B1 : CONSTANT B := THREE;
- 
-           TYPE C IS RANGE 1 .. 100;
-           C1 : CONSTANT C := 50;
- 
-           TYPE D IS RANGE 1 .. 100;
-           D1 : CONSTANT D := 50;
- 
-           TYPE E (DISC1 : INTEGER := 5) IS RECORD
-                COMPE : S1;
-           END RECORD;
-           E1 : CONSTANT E := (DISC1 => 5, COMPE => TOM);
- 
-           TYPE F (DISC2 : INTEGER := 15) IS RECORD
-                COMPF : S2;
-           END RECORD;
-           F1 : CONSTANT F := (DISC2 => 15, COMPF => THAT);
- 
-           TYPE G (DISC3 : INTEGER) IS RECORD
-                COMPG : S3;
-           END RECORD;
-           G1 : CONSTANT G := (DISC3 => 25, COMPG => 50);
- 
-           TYPE H (DISC4 : INTEGER) IS RECORD
-                COMPH : S4;
-           END RECORD;
-           H1 : CONSTANT H := (DISC4 => 30, COMPH => 50);
-      END PP;
- 
-      USE PP;
- 
-      AVAR : SUBA := A1;
-      EVAR : SUBE := E1;
- 
-      IVAR : SUBI;
-      JVAR : SUBJ;
- 
-      PACKAGE BODY PP IS
-           PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER) IS
-           BEGIN
-                Z1 := LIM (Z2);
-           END INIT;
-      BEGIN
-           NULL;
-      END PP;
- 
-      PROCEDURE QUAL_PRIV (W : A) IS
-      BEGIN
-           NULL;
-      END QUAL_PRIV;
- 
-      PROCEDURE QUAL_LIM_PRIV (X : B) IS
-      BEGIN
-           NULL;
-      END QUAL_LIM_PRIV;
- 
-      PROCEDURE EXPL_CONV_PRIV_1 (Y : C) IS
-      BEGIN
-           NULL;
-      END EXPL_CONV_PRIV_1;
- 
-      PROCEDURE EXPL_CONV_LIM_PRIV_1 (Z : D) IS
-      BEGIN
-           NULL;
-      END EXPL_CONV_LIM_PRIV_1;
- 
-      PROCEDURE EXPL_CONV_PRIV_2 (Y2 : G) IS
-      BEGIN
-           NULL;
-      END EXPL_CONV_PRIV_2;
- 
-      PROCEDURE EXPL_CONV_LIM_PRIV_2 (Z2 : H) IS
-      BEGIN
-           NULL;
-      END EXPL_CONV_LIM_PRIV_2;
- 
-      PROCEDURE EXPL_CONV_PRIV_3 (Y3 : I) IS
-      BEGIN
-           NULL;
-      END EXPL_CONV_PRIV_3;
- 
-      PROCEDURE EXPL_CONV_PRIV_4 (Y4 : J) IS
-      BEGIN
-           NULL;
-      END EXPL_CONV_PRIV_4;
- 
- BEGIN
-      TEST ("C74203A", "CHECK THAT MEMBERSHIP TESTS, QUALIFICATION, " &
-                       "AND EXPLICIT CONVERSION ARE AVAILABLE FOR " &
-                       "LIMITED AND NON-LIMITED PRIVATE TYPES.  " &
-                       "INCLUDE TYPES WITH DISCRIMINANTS AND " &
-                       "TYPES WITH LIMITED COMPONENTS");
- 
-      INIT (IVAR.COMPI, 50);
- 
-      FOR K IN IDENT_INT (1) .. IDENT_INT (5) LOOP
-           INIT (JVAR(K), 25);
-      END LOOP;
- 
-      IF NOT (AVAR IN A) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
-                   "PRIVATE TYPE - 1");
-      END IF;
- 
-      IF (AVAR NOT IN A) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
-                   "PRIVATE TYPE - 1");
-      END IF;
- 
-      IF NOT (B1 IN B) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
-                   "LIMITED PRIVATE TYPE - 1");
-      END IF;
- 
-      IF (B1 NOT IN B) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
-                   "LIMITED PRIVATE TYPE - 1");
-      END IF;
- 
-      QUAL_PRIV (A'(AVAR));
- 
-      QUAL_LIM_PRIV (B'(B1));
- 
-      EXPL_CONV_PRIV_1 (C(C1));
- 
-      EXPL_CONV_LIM_PRIV_1 (D(D1));
- 
-      IF NOT (EVAR IN E) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
-                   "PRIVATE TYPE - 2");
-      END IF;
- 
-      IF (EVAR NOT IN E) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
-                   "PRIVATE TYPE - 2");
-      END IF;
- 
-      IF NOT (F1 IN F) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
-                   "LIMITED PRIVATE TYPE - 2");
-      END IF;
- 
-      IF (F1 NOT IN F) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
-                   "LIMITED PRIVATE TYPE - 2");
-      END IF;
- 
-      EXPL_CONV_PRIV_2 (G(G1));
- 
-      EXPL_CONV_LIM_PRIV_2 (H(H1));
- 
-      IF NOT (IVAR IN I) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
-                   "PRIVATE TYPE - 3");
-      END IF;
- 
-      IF (IVAR NOT IN I) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
-                   "PRIVATE TYPE - 3");
-      END IF;
- 
-      EXPL_CONV_PRIV_3 (I(IVAR));
- 
-      IF NOT (JVAR IN J) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
-                   "PRIVATE TYPE - 4");
-      END IF;
- 
-      IF (JVAR NOT IN J) THEN
-           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
-                   "PRIVATE TYPE - 4");
-      END IF;
- 
-      EXPL_CONV_PRIV_4 (J(JVAR));
- 
-      RESULT;
- END C74203A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74206a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74206a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74206a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- C74206A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A COMPOSITE TYPE IS DECLARED IN THE PACKAGE AS A
- -- PRIVATE TYPE AND CONTAINS A COMPONENT OF THE PRIVATE TYPE, OPERATIONS
- -- OF THE COMPOSITE TYPE WHICH DO NOT DEPEND ON CHARACTERISTICS OF THE
- -- PRIVATE TYPE ARE AVAILABLE AFTER THE FULL DECLARATION OF THE PRIVATE
- -- TYPE, BUT BEFORE THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
- -- DECLARATION OF THE COMPOSITE TYPE THAT IS AFTER THE FULL DECLARATION
- -- OF THE PRIVATE TYPE.  IN PARTICULAR, CHECK FOR THE FOLLOWING :
- 
- --   'FIRST, 'LAST, 'RANGE, AND 'LENGTH FOR ARRAY TYPES
- --   SELECTED COMPONENTS FOR DISCRIMINANTS AND COMPONENTS OF RECORDS
- --   INDEXED COMPONENTS AND SLICES FOR ARRAYS
- 
- -- DSJ 5/5/83
- -- JBG 3/8/84
- 
- WITH REPORT; 
- PROCEDURE C74206A IS
- 
-      USE REPORT; 
- 
- BEGIN
- 
-      TEST("C74206A", "CHECK THAT ADDITIONAL OPERATIONS FOR "
-                    & "COMPOSITE TYPES OF PRIVATE TYPES ARE "
-                    & "AVAILABLE AT THE EARLIEST PLACE AFTER THE "
-                    & "FULL DECLARATION OF THE PRIVATE TYPE EVEN "
-                    & "IF BEFORE THE EARLIEST PLACE WITHIN THE "
-                    & "IMMEDIATE SCOPE OF THE COMPOSITE TYPE"); 
- 
-      DECLARE
- 
-           PACKAGE PACK1 IS
-                TYPE P1  IS PRIVATE; 
-                TYPE LP1 IS LIMITED PRIVATE; 
- 
-                PACKAGE PACK_LP IS
-                     TYPE LP_ARR IS ARRAY (1 .. 2) OF LP1; 
-                     TYPE LP_REC (D : INTEGER) IS
-                          RECORD
-                               C1, C2 : LP1; 
-                          END RECORD; 
-                END PACK_LP; 
- 
-                PACKAGE PACK2 IS
-                     TYPE ARR IS ARRAY ( 1 .. 2 ) OF P1; 
-                     TYPE REC (D : INTEGER) IS
-                          RECORD
-                               C1, C2 : P1; 
-                          END RECORD; 
-                END PACK2; 
-           PRIVATE
-                TYPE P1  IS NEW BOOLEAN; 
-                TYPE LP1 IS NEW BOOLEAN; 
-           END PACK1; 
- 
-           PACKAGE BODY PACK1 IS
- 
-                USE PACK_LP; 
-                USE PACK2; 
- 
-                A1 : ARR; 
-                L1 : LP_ARR; 
- 
-                N1 : INTEGER := ARR'FIRST;           -- LEGAL
-                N2 : INTEGER := ARR'LAST;            -- LEGAL
-                N3 : INTEGER := A1'LENGTH;           -- LEGAL
-                N4 : INTEGER := LP_ARR'FIRST;        -- LEGAL
-                N5 : INTEGER := LP_ARR'LAST;         -- LEGAL
-                N6 : INTEGER := L1'LENGTH;           -- LEGAL
-                B1 : BOOLEAN := 1 IN ARR'RANGE;      -- LEGAL
-                B2 : BOOLEAN := 5 IN LP_ARR'RANGE;   -- LEGAL
- 
-                N7 : INTEGER := A1(1)'SIZE;          -- LEGAL: A1(1)
-                N8 : INTEGER := L1(2)'SIZE;          -- LEGAL: L1(2)
- 
-                R1 : REC(1); 
-                Q1 : LP_REC(1); 
- 
-                K1 : INTEGER := R1.D'SIZE;           -- LEGAL: R1.D
-                K2 : INTEGER := R1.C1'SIZE;          -- LEGAL: R1.C1
-                K3 : INTEGER := Q1.D'SIZE;           -- LEGAL: Q1.D
-                K4 : INTEGER := Q1.C2'SIZE;          -- LEGAL: Q1.C2
- 
-           BEGIN
- 
-                IF N1 /= 1 OR N4 /= 1 THEN
-                     FAILED ("WRONG VALUE FOR 'FIRST"); 
-                END IF; 
- 
-                IF N2 /= 2 OR N5 /= 2 THEN
-                     FAILED ("WRONG VALUE FOR 'LAST"); 
-                END IF; 
- 
-                IF N3 /= 2 OR N6 /= 2 THEN
-                     FAILED ("WRONG VALUE FOR 'LENGTH"); 
-                END IF; 
- 
-                IF B1 /= TRUE OR B2 /= FALSE THEN
-                     FAILED ("INCORRECT RANGE TEST"); 
-                END IF; 
- 
-                IF N7 /= N8 THEN
-                     FAILED ("INCORRECT INDEXED COMPONENTS"); 
-                END IF; 
- 
-                IF K1 /= K3 OR K2 /= K4 THEN
-                     FAILED ("INCORRECT COMPONENT SELECTION"); 
-                END IF; 
- 
-           END PACK1; 
- 
-      BEGIN
- 
-           NULL; 
- 
-      END; 
- 
-      RESULT; 
- 
- END C74206A; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74207b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74207b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74207b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C74207B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'CONSTRAINED CAN BE APPLIED AFTER THE FULL DECLARATION OF
- -- A PRIVATE TYPE THAT IS DERIVED FROM A PRIVATE TYPE.
- 
- -- BHS 6/18/84
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE C74207B IS
- BEGIN
-      TEST ("C74207B", "AFTER THE FULL DECLARATION OF A PRIVATE " &
-                       "TYPE DERIVED FROM A PRIVATE TYPE, " &
-                       "'CONSTRAINED MAY BE APPLIED");
- 
-      DECLARE
-           PACKAGE P1 IS
-                TYPE PREC (D : INTEGER) IS PRIVATE;
-                TYPE P IS PRIVATE;
-           PRIVATE
-                TYPE PREC (D : INTEGER) IS RECORD
-                          NULL; 
-                     END RECORD;
-                TYPE P IS NEW INTEGER;
-           END P1;
- 
-           PACKAGE P2 IS
-                TYPE LP1 IS LIMITED PRIVATE;
-                TYPE LP2 IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE LP1 IS NEW P1.PREC(3);
-                TYPE LP2 IS NEW P1.P;
-                B1 : BOOLEAN := LP1'CONSTRAINED;
-                B2 : BOOLEAN := LP2'CONSTRAINED;
-           END P2;
- 
-           PACKAGE BODY P2 IS
-           BEGIN
-                IF NOT IDENT_BOOL(B1) THEN
-                     FAILED ("WRONG VALUE FOR LP1'CONSTRAINED");
-                END IF;
-                IF NOT IDENT_BOOL(B2) THEN
-                     FAILED ("WRONG VALUE FOR LP2'CONSTRAINED");
-                END IF;
-           END P2;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END C74207B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74208a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74208a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74208a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74208a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C74208A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'SIZE AND 'ADDRESS FOR OBJECTS OF LIMITED AND
- --     NON-LIMITED TYPES ARE AVAILABLE BOTH INSIDE AND OUTSIDE THE
- --     PACKAGE DECLARING THE TYPES.
- 
- -- HISTORY:
- --     BCB 03/14/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE C74208A IS
- 
-      PACKAGE P IS
-           TYPE T IS PRIVATE;
-           TYPE U IS LIMITED PRIVATE;
-      PRIVATE
-           TYPE T IS RANGE 1 .. 100;
-           TYPE U IS RANGE 1 .. 100;
-      END P;
- 
-      A : P.T;
-      B : P.U;
-      ASIZE, BSIZE : INTEGER;
-      AADDRESS, BADDRESS : ADDRESS;
- 
-      FUNCTION IDENT_ADR(X : ADDRESS) RETURN ADDRESS IS
-           Y : P.T;
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN X;
-           END IF;
-           RETURN Y'ADDRESS;
-      END IDENT_ADR;
- 
-      PACKAGE BODY P IS
-           X : T;
-           Y : U;
-           XSIZE, YSIZE : INTEGER;
-           XADDRESS, YADDRESS : ADDRESS;
-      BEGIN
-           TEST ("C74208A", "CHECK THAT 'SIZE AND 'ADDRESS FOR " &
-                            "OBJECTS OF LIMITED AND NON-LIMITED TYPES " &
-                            "ARE AVAILABLE BOTH INSIDE AND OUTSIDE " &
-                            "THE PACKAGE DECLARING THE TYPES");
- 
-           XSIZE := X'SIZE;
-           YSIZE := Y'SIZE;
-           XADDRESS := X'ADDRESS;
-           YADDRESS := Y'ADDRESS;
- 
-           IF NOT EQUAL(XSIZE,X'SIZE) THEN
-                FAILED ("IMPROPER VALUE FOR X'SIZE");
-           END IF;
- 
-           IF XADDRESS /= IDENT_ADR(X'ADDRESS) THEN
-                FAILED ("IMPROPER VALUE FOR X'ADDRESS");
-           END IF;
- 
-           IF NOT EQUAL(YSIZE,Y'SIZE) THEN
-                FAILED ("IMPROPER VALUE FOR Y'SIZE");
-           END IF;
- 
-           IF YADDRESS /= IDENT_ADR(Y'ADDRESS) THEN
-                FAILED ("IMPROPER VALUE FOR Y'ADDRESS");
-           END IF;
-      END P;
- 
- BEGIN
-      ASIZE := A'SIZE;
-      BSIZE := B'SIZE;
-      AADDRESS := A'ADDRESS;
-      BADDRESS := B'ADDRESS;
- 
-      IF NOT EQUAL(ASIZE,A'SIZE) THEN
-           FAILED ("IMPROPER VALUE FOR A'SIZE");
-      END IF;
- 
-      IF AADDRESS /= IDENT_ADR(A'ADDRESS) THEN
-           FAILED ("IMPROPER VALUE FOR A'ADDRESS");
-      END IF;
- 
-      IF NOT EQUAL(BSIZE,B'SIZE) THEN
-           FAILED ("IMPROPER VALUE FOR B'SIZE");
-      END IF;
- 
-      IF BADDRESS /= IDENT_ADR(B'ADDRESS) THEN
-           FAILED ("IMPROPER VALUE FOR B'ADDRESS");
-      END IF;
- 
-      RESULT;
- END C74208A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74208b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74208b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74208b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74208b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- C74208B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT 'CONSTRAINED FOR OBJECTS OF A PRIVATE TYPE WITH
- --     VISIBLE DISCRIMINANTS IS AVAILABLE OUTSIDE THE PACKAGE DECLARING
- --     THE TYPE AND IS AVAILABLE BEFORE AND AFTER THE FULL DECLARATION.
- 
- -- HISTORY:
- --     BCB 07/14/88  CREATED ORIGINAL TEST.
- --     GJD 11/15/95  MOVED REC2_VAR OUT OF P DUE TO ADA 95 FREEZING RULES.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74208B IS
- 
-      PACKAGE P IS
-           TYPE REC (D : INTEGER := 0) IS PRIVATE;
-           R1 : CONSTANT REC;
-           TYPE REC2 IS RECORD
-                COMP : BOOLEAN := R1'CONSTRAINED;
-           END RECORD;
-      PRIVATE
-           TYPE REC (D : INTEGER := 0) IS RECORD
-                NULL;
-           END RECORD;
-           R1 : CONSTANT REC := (D => 5);
-           R2 : REC := (D => 0);
-           R2A : REC(3);
-           R2CON : CONSTANT REC := (D => 3);
-           C : BOOLEAN := R2'CONSTRAINED;
-           D : BOOLEAN := R2A'CONSTRAINED;
-           E : BOOLEAN := R2CON'CONSTRAINED;
-      END P;
- 
-      REC2_VAR : P.REC2;
-      
-      R3 : P.REC(0);
-      R3A : P.REC;
- 
-      A : BOOLEAN := R3'CONSTRAINED;
-      B : BOOLEAN := R3A'CONSTRAINED;
- 
-      PACKAGE BODY P IS
-      BEGIN
-           TEST ("C74208B", "CHECK THAT 'CONSTRAINED FOR OBJECTS OF A " &
-                            "PRIVATE TYPE WITH VISIBLE DISCRIMINANTS " &
-                            "IS AVAILABLE OUTSIDE THE PACKAGE " &
-                            "DECLARING THE TYPE AND IS AVAILABLE " &
-                            "BEFORE AND AFTER THE FULL DECLARATION");
- 
-           IF NOT REC2_VAR.COMP THEN
-                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED BEFORE THE " &
-                        "FULL DECLARATION OF THE PRIVATE TYPE");
-           END IF;
- 
-           IF C THEN
-                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
-                        "FULL DECLARATION OF THE PRIVATE TYPE - 1");
-           END IF;
- 
-           IF NOT D THEN
-                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
-                        "FULL DECLARATION OF THE PRIVATE TYPE - 2");
-           END IF;
- 
-           IF NOT E THEN
-                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
-                        "FULL DECLARATION OF THE PRIVATE TYPE - 3");
-           END IF;
-      END P;
- 
- BEGIN
-      IF NOT A THEN
-           FAILED ("IMPROPER VALUE FOR 'CONSTRAINED OUTSIDE THE " &
-                   "PACKAGE DECLARING THE PRIVATE TYPE - 1");
-      END IF;
- 
-      IF B THEN
-           FAILED ("IMPROPER VALUE FOR 'CONSTRAINED OUTSIDE THE " &
-                   "PACKAGE DECLARING THE PRIVATE TYPE - 2");
-      END IF;
- 
-      RESULT;
- END C74208B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74209a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74209a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74209a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74209a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,224 ****
- -- C74209A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OUTSIDE A PACKAGE WHICH DEFINES PRIVATE TYPES AND LIMITED
- --    PRIVATE TYPES  IT IS POSSIBLE TO DECLARE SUBPROGRAMS WHICH USE
- --    THOSE TYPES AS TYPES FOR PARAMETERS (OF ANY MODE EXCEPT OUT FOR A
- --    LIMITED TYPE) OR AS THE TYPE FOR THE RESULT (FOR FUNCTION
- --    SUBPROGRAMS). 
- 
- -- RM 07/14/81
- 
- 
- WITH REPORT;
- PROCEDURE  C74209A  IS
- 
-      USE  REPORT;
- 
- BEGIN
- 
-      TEST( "C74209A" , "CHECK THAT PROCEDURE SIGNATURES CAN USE " &
-                        "PRIVATE TYPES" );
- 
-      DECLARE
- 
-           PACKAGE  PACK  IS
- 
-                TYPE  LIM_PRIV  IS LIMITED PRIVATE;
-                TYPE  PRIV      IS         PRIVATE;
-                PRIV_CONST_IN   :  CONSTANT  PRIV;
-                PRIV_CONST_OUT  :  CONSTANT  PRIV;
-                FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV;
-                FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN ;
-                PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV );
- 
-           PRIVATE
- 
-                TYPE  LIM_PRIV  IS NEW INTEGER;
-                TYPE  PRIV      IS NEW STRING( 1..5 );
-                PRIV_CONST_IN   :  CONSTANT  PRIV :=  "ABCDE";
-                PRIV_CONST_OUT  :  CONSTANT  PRIV :=  "FGHIJ";
- 
-           END  PACK;
- 
- 
-           PRIV_VAR_1 ,     PRIV_VAR_2      :  PACK.PRIV;
-           LIM_PRIV_VAR_1 , LIM_PRIV_VAR_2  :  PACK.LIM_PRIV;
- 
- 
-           USE  PACK;
- 
- 
-           PACKAGE BODY  PACK  IS
- 
-                FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV  IS
-                BEGIN
-                     RETURN  LIM_PRIV(X);
-                END  PACKAGED;
- 
-                FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN  IS
-                BEGIN
-                     RETURN  X = Y ;
-                END  EQUALS;
- 
-                PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV) IS
-                BEGIN
-                     Y := X;
-                END  ASSIGN;
- 
-           END  PACK;
- 
- 
-           PROCEDURE  PROC1( X : IN OUT PACK.PRIV;
-                             Y : IN     PACK.PRIV := PACK.PRIV_CONST_IN;
-                             Z : OUT    PACK.PRIV;
-                             U :        PACK.PRIV )  IS
-           BEGIN
- 
-                IF  X /= PACK.PRIV_CONST_IN  OR
-                    Y /= PACK.PRIV_CONST_IN  OR
-                    U /= PACK.PRIV_CONST_IN
-                THEN
-                     FAILED( "WRONG INPUT VALUES  -  PROC1" );
-                END IF;
- 
-                X := PACK.PRIV_CONST_OUT;
-                Z := PACK.PRIV_CONST_OUT;
- 
-           END  PROC1;
- 
- 
-           PROCEDURE  PROC2( X : IN OUT LIM_PRIV;
-                             Y : IN     LIM_PRIV;
-                             Z : IN OUT LIM_PRIV;
-                             U :        LIM_PRIV )  IS
-           BEGIN
- 
-                IF  NOT(EQUALS( X , PACKAGED(17) ))  OR
-                    NOT(EQUALS( Y , PACKAGED(17) ))  OR
-                    NOT(EQUALS( U , PACKAGED(17) ))
-                THEN
-                     FAILED( "WRONG INPUT VALUES  -  PROC2" );
-                END IF;
- 
-                ASSIGN( PACKAGED(13) , X );
-                ASSIGN( PACKAGED(13) , Z );
- 
-           END  PROC2;
- 
- 
-           FUNCTION  FUNC1( Y : IN  PRIV  :=  PRIV_CONST_IN;
-                            U :     PRIV  )   RETURN  PRIV  IS
-           BEGIN
- 
-                IF  Y /= PRIV_CONST_IN  OR
-                    U /= PRIV_CONST_IN
-                THEN
-                     FAILED( "WRONG INPUT VALUES  -  FUNC1" );
-                END IF;
- 
-                RETURN  PRIV_CONST_OUT;
- 
-           END  FUNC1;
- 
- 
-           FUNCTION  FUNC2( Y : IN  LIM_PRIV;
-                            U :     LIM_PRIV )  RETURN  LIM_PRIV  IS
-           BEGIN
- 
-                IF  NOT(EQUALS( Y , PACKAGED(17) ))  OR
-                    NOT(EQUALS( U , PACKAGED(17) ))
-                THEN
-                     FAILED( "WRONG INPUT VALUES  -  FUNC2" );
-                END IF;
- 
-                RETURN  PACKAGED(13);
- 
-           END  FUNC2;
- 
- 
-      BEGIN
- 
-           --------------------------------------------------------------
- 
-           PRIV_VAR_1 := PRIV_CONST_IN;
-           PRIV_VAR_2 := PRIV_CONST_IN;
- 
-           PROC1( PRIV_VAR_1 , Z => PRIV_VAR_2 , U => PRIV_CONST_IN );
- 
-           IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT  OR
-               PRIV_VAR_2 /= PACK.PRIV_CONST_OUT
-           THEN
-                FAILED( "WRONG OUTPUT VALUES  -  PROC1" );
-           END IF;
- 
-           --------------------------------------------------------------
- 
-           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
-           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
- 
-           PROC2( LIM_PRIV_VAR_1 , PACKAGED(17) ,
-                  LIM_PRIV_VAR_2 , PACKAGED(17) );
- 
-           IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))  OR
-               NOT(EQUALS( LIM_PRIV_VAR_2 , PACKAGED(13) ))
-           THEN
-                FAILED( "WRONG OUTPUT VALUES  -  PROC2" );
-           END IF;
- 
-           --------------------------------------------------------------
- 
-           PRIV_VAR_1 := PRIV_CONST_IN;
-           PRIV_VAR_2 := PRIV_CONST_IN;
- 
-           PRIV_VAR_1 :=
-               FUNC1( PRIV_VAR_1 , U => PRIV_CONST_IN );
- 
-           IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT  
-           THEN
-                FAILED( "WRONG OUTPUT VALUES  -  FUNC1" );
-           END IF;
- 
-           --------------------------------------------------------------
- 
-           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
-           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
- 
-           ASSIGN( FUNC2( LIM_PRIV_VAR_1 , PACKAGED(17)) ,
-                   LIM_PRIV_VAR_1 );
- 
-           IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))
-           THEN
-                FAILED( "WRONG OUTPUT VALUES  -  FUNC2" );
-           END IF;
- 
-           --------------------------------------------------------------
- 
-      END;
- 
- 
-      RESULT;
- 
- 
- END C74209A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74210a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74210a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74210a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C74210A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OPERATOR SYMBOLS OVERLOADED IN A PACKAGE ARE
- --   USED AND DERIVED IN PREFERENCE TO THOSE OF THE PARENT OF A DERIVED
- --   PRIVATE TYPE. 
- 
- -- CHECK THAT OPERATOR DEFINITIONS FOR A PRIVATE TYPE MAY BE
- --   OVERLOADED OUTSIDE THE PACKAGE.
- 
- -- CHECK THAT EQUALITY CAN BE DEFINED FOR LIMITED TYPES AND COMPOSITE
- --   TYPES WITH LIMITED COMPONENTS. 
- 
- -- DAT 5/11/81
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74210A IS
- BEGIN
-      TEST ("C74210A", "OVERLOADED OPERATORS FOR PRIVATE TYPES");
- 
-      DECLARE
-           PACKAGE P IS
-                TYPE T IS PRIVATE;
-                FUNCTION "+" (X, Y : T) RETURN T;
-                ONE, TWO : CONSTANT T;
- 
-                TYPE L IS LIMITED PRIVATE;
-                TYPE A IS ARRAY (0 .. 0) OF L;
-                TYPE R IS RECORD
-                     C : L;
-                END RECORD;
-                FUNCTION "=" (X, Y : L) RETURN BOOLEAN;
-           PRIVATE
-                TYPE T IS NEW INTEGER;
-                ONE : CONSTANT T := T(IDENT_INT(1));
-                TWO : CONSTANT T := T(IDENT_INT(2));
-                TYPE L IS (ENUM);
-           END P;
-           USE P;
- 
-           VR : R;
-           VA : A;
- 
-           PACKAGE BODY P IS
-                FUNCTION "+" (X, Y : T) RETURN T IS
-                BEGIN
-                     RETURN 1;
-                END "+";
- 
-                FUNCTION "=" (X, Y : L) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN IDENT_BOOL(FALSE);
-                END "=";
-           BEGIN
-                VR := (C => ENUM);
-                VA := (0 => VR.C);
-           END P;
-      BEGIN
-           IF ONE + TWO /= ONE THEN
-                FAILED ("WRONG ""+"" OPERATOR");
-           END IF;
- 
-           DECLARE
-                TYPE NEW_T IS NEW T;
- 
-                FUNCTION "=" (X, Y : A) RETURN BOOLEAN;
-                FUNCTION "=" (X, Y : R) RETURN BOOLEAN;
- 
-                FUNCTION "+" (X, Y : T) RETURN T IS
-                BEGIN
-                     RETURN TWO;
-                END "+";
- 
-                FUNCTION "=" (X, Y : A) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN X(0) = Y(0);
-                END "=";
- 
-                FUNCTION "=" (X, Y : R) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN X.C = Y.C;
-                END "=";
-           BEGIN
-                IF ONE + TWO /= TWO THEN
-                     FAILED ("WRONG DERIVED ""+"" OPERATOR");
-                END IF;
- 
-                IF VR = VR OR VA = VA THEN
-                     FAILED ("CANNOT OVERLOAD ""="" CORRECTLY");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END C74210A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74211a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74211a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74211a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C74211A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WITHIN THE PACKAGE SPECIFICATION AND BODY, ANY EXPLICIT
- -- DECLARATIONS OF OPERATORS AND SUBPROGRAMS HIDE ANY OPERATIONS WHICH
- -- ARE IMPLICITLY DECLARED AT THE POINT OF THE FULL DECLARATION,
- -- REGARDLESS OF THE ORDER OF OCCURENCE OF THE DECLARATIONS.
- 
- -- CHECK THAT IMPLICITLY DECLARED DERIVED SUBPROGRAMS HIDE IMPLICITLY
- -- DECLARED PREDEFINED OPERATORS, REGARDLESS OF THE ORDER OF OCCURENCE
- -- OF THE DECLARATIONS.
- 
- -- DSJ 4/28/83
- -- JBG 9/23/83
- 
- --   A) EXPLICIT DECLARATION HIDES LATER IMPLICIT DECL OF PREDEFINED OP.
- --   B)     "        "         "   LATER     "      "  "  DERIVED OP.
- --   C)     "        "         "   EARLIER   "      "  "  PREDEFINED OP.
- --   D)     "        "         "   EARLIER   "      "  "  DERIVED OP.
- 
- WITH REPORT;
- PROCEDURE C74211A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST ("C74211A", "CHECK THAT HIDING OF IMPLICITLY DECLARED " &
-                       "OPERATORS AND DERIVED SUBPROGRAMS IS DONE " &
-                       "CORRECTLY REGARDLESS OF ORDER OF DECL'S");
- 
-      DECLARE
- 
-           PACKAGE P1 IS 
-                TYPE T1 IS RANGE 1 .. 50;
-                C1 : CONSTANT T1 := T1(IDENT_INT(2));
-                D1 : CONSTANT T1 := C1 + C1;        -- PREDEFINED "+"
-                FUNCTION "+" (L, R : T1) RETURN T1; -- C) FOR "+".
-                FUNCTION "-" (L, R : T1) RETURN T1; -- C) FOR "-".
-                FUNCTION "/" (L, R : T1) RETURN T1; 
-           END P1;
- 
-           USE P1;
- 
-           PACKAGE BODY P1 IS
-                A,B : T1 := 3;
- 
-                FUNCTION "+" (L, R : T1) RETURN T1 IS
-                BEGIN
-                     IF L = R THEN
-                          RETURN 1;
-                     ELSE RETURN 2;
-                     END IF;
-                END "+";
- 
-                FUNCTION "-" (L, R : T1) RETURN T1 IS
-                BEGIN
-                     IF L = R THEN
-                          RETURN 3;
-                     ELSE RETURN 4;
-                     END IF;
-                END "-";
- 
-                FUNCTION "/" (L, R : T1) RETURN T1 IS
-                BEGIN
-                     IF L = R THEN
-                          RETURN T1(IDENT_INT(INTEGER(L)));
-                     ELSE
-                          RETURN T1(IDENT_INT(50));
-                     END IF;
-                END "/";
- 
-           BEGIN
-                IF D1 /= 4 THEN
-                     FAILED ("WRONG PREDEFINED OPERATION - '+' ");
-                END IF;
- 
-                IF D1 + C1 /= 2 THEN
-                     FAILED ("IMPLICIT '+' NOT HIDDEN BY EXPLICIT '+'");
-                END IF;
- 
-                IF A + B /= 1 THEN
-                     FAILED ("IMPLICIT DECLARATION NOT HIDDEN " &
-                             "BY EXPLICIT DECLARATION - '+' ");
-                END IF;
- 
-                IF A - B /= 3 THEN
-                     FAILED ("IMPLICIT DECLARATION NOT HIDDEN " &
-                             "BY EXPLICIT DECLARATION - '-' ");
-                END IF;
- 
-                IF A * B /= 9 THEN
-                     FAILED ("WRONG PREDEFINED OPERATION - '*' ");
-                END IF;
- 
-                IF B / A  /=  T1(IDENT_INT(3)) THEN
-                     FAILED ("NOT REDEFINED '/' ");
-                END IF;
-           END P1;
- 
-           PACKAGE P2 IS
-                TYPE T2 IS PRIVATE;
-                X , Y : CONSTANT T2;
-                FUNCTION "+" (L, R : T2) RETURN T2;     -- B)
-                FUNCTION "*" (L, R : T2) RETURN T2;     -- A)
-           PRIVATE
-                TYPE T2 IS NEW T1;                 -- B) +; A) *
-                Z : T2 := T2(IDENT_INT(3))/4;      -- Z = 50 USING
-                                                   -- DERIVED /
-                FUNCTION "/" (L, R : T2) RETURN T2;  -- D) FOR /
-                X , Y : CONSTANT T2 := 3;
-           END P2;
- 
-           PACKAGE BODY P2 IS
-                FUNCTION "+" (L, R : T2) RETURN T2 IS
-                BEGIN
-                     IF L = R THEN
-                          RETURN T2(IDENT_INT(5));
-                     ELSE RETURN T2(IDENT_INT(6));
-                     END IF;
-                END "+";
- 
-                FUNCTION "*" (L, R : T2) RETURN T2 IS
-                BEGIN
-                     IF L = R THEN
-                          RETURN T2(IDENT_INT(7));
-                     ELSE RETURN T2(IDENT_INT(8));
-                     END IF;
-                END "*";
- 
-                FUNCTION "/" (L, R : T2) RETURN T2 IS
-                BEGIN
-                     IF L = R THEN
-                          RETURN T2(IDENT_INT(9));
-                     ELSE RETURN T2(IDENT_INT(10));
-                     END IF;
-                END "/";
-           BEGIN
-                IF X + Y /= 5 THEN
-                          FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
-                                  "EXPLICIT DECLARATION - '+' ");
-                END IF;
- 
-                IF Y - X /= 3 THEN
-                          FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
-                                  "DERIVED SUBPROGRAM - '-' ");
-                END IF;
- 
-                IF X * Y /= 7 THEN
-                          FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
-                                  "EXPLICIT DECLARATION - '*' ");
-                END IF;
- 
-                IF Y / X /= T2(IDENT_INT(9)) THEN
-                          FAILED ("DERIVED OPERATOR NOT HIDDEN BY " &
-                                  "EXPLICIT DECLARATION - '/' ");
-                END IF;
- 
-                IF Z /= 50 THEN
-                     FAILED ("DERIVED OPERATOR HIDDEN PREMATURELY " &
-                             " BY REDECLARED OPERATOR");
-                END IF;
- 
-           END P2;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END C74211A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74211b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74211b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74211b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74211b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- C74211B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IMPLICITLY DECLARED INEQUALITY WHICH ACCOMPANIES AN
- -- EXPLICIT DECLARATION OF EQUALITY HIDES OTHER IMPLICITLY DECLARED
- -- HOMOGRAPHS, AND THAT DERIVED INEQUALITY HIDES PREDEFINED INEQUALITY.
- 
- -- DSJ 4/29/83
- -- JBG 9/23/83
- 
- WITH REPORT;
- PROCEDURE C74211B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "C74211B", "CHECK THAT HIDING OF IMPLICITLY DECLARED " &
-                       "OPERATORS AND DERIVED SUBPROGRAMS IS DONE " &
-                       "CORRECTLY REGARDLESS OF ORDER OF DECL'S");
- 
-      DECLARE
- 
-           PACKAGE P1 IS 
-                TYPE LT1 IS LIMITED PRIVATE;
-                FUNCTION "="(L, R : LT1) RETURN BOOLEAN;
-                FUNCTION LT1_VALUE_2 RETURN LT1;
-                FUNCTION LT1_VALUE_4 RETURN LT1;
-                TYPE LT2 IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE LT1 IS RANGE 1 .. 10;
-                TYPE LT2 IS RANGE 1 .. 10;
-           END P1;
- 
-           USE P1;
- 
-           PACKAGE P2 IS
-                TYPE LT3 IS LIMITED PRIVATE;
-                TYPE LT4 IS NEW LT1;
-           PRIVATE
-                FUNCTION "=" (L, R : LT3) RETURN BOOLEAN;
-                TYPE LT3 IS NEW LT1;
-           END P2;
- 
-           USE P2;
- 
-           PACKAGE BODY P1 IS
-                A , B : CONSTANT LT1 := 4;
-                C , D : CONSTANT LT2 := 6;
- 
-                FUNCTION "=" (L, R : LT1) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN INTEGER(L) /= INTEGER(R);
-                END "=";
- 
-                FUNCTION LT1_VALUE_2 RETURN LT1 IS
-                BEGIN
-                     RETURN 2;
-                END LT1_VALUE_2;
- 
-                FUNCTION LT1_VALUE_4 RETURN LT1 IS
-                BEGIN
-                     RETURN 4;
-                END LT1_VALUE_4;
- 
-           BEGIN
-                IF A = B THEN
-                     FAILED ("PREDEFINED EQUALITY NOT HIDDEN BY " &
-                             "EXPLICIT DECLARATION - LT1");
-                END IF;
- 
-                IF C /= D  THEN
-                     FAILED ("WRONG PREDEFINED OPERATION - T2");
-                END IF;
-           END P1;
- 
-           PACKAGE BODY P2 IS
-                FUNCTION U RETURN LT3 IS
-                BEGIN
-                     RETURN LT1_VALUE_2;
-                END U;
- 
-                FUNCTION V RETURN LT3 IS
-                BEGIN
-                     RETURN LT1_VALUE_4;
-                END V;
- 
-                FUNCTION W RETURN LT4 IS
-                BEGIN
-                     RETURN LT1_VALUE_2;
-                END W;
- 
-                FUNCTION X RETURN LT4 IS
-                BEGIN
-                     RETURN LT1_VALUE_4;
-                END X;
- 
-                FUNCTION "=" (L, R : LT3) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN NOT (LT1(L) = LT1(R));
-                END "=";
- 
-           BEGIN
-                IF NOT (U /= V) THEN
-                     FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
-                             "IMPLICITLY DECLARED INEQUALITY " &
-                             "FROM EXPLICITLY DECLARED EQUALITY"); 
-                END IF;
- 
-                IF NOT (LT3(W) = U) THEN
-                     FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
-                             "EXPLICIT DECLARATION - '=' ");
-                END IF;
- 
-                IF W /= X THEN
-                     FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
-                             "DERIVED SUBPROGRAM - '/=' ");
-                END IF;
- 
-                IF NOT ( X = W ) THEN
-                     FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
-                             "DERIVED SUBPROGRAM - '=' ");
-                END IF;
- 
-           END P2;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END C74211B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74302a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74302a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74302a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C74302A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT MULTIPLE DECLARATIONS MAY BE USED FOR DEFERRED CONSTANT
- -- DECLARATIONS, EVEN IF THE FULL DECLARATIONS ARE GIVEN INDIVIDUALLY.
- 
- -- CHECK THAT MULTIPLE DECLARATIONS MAY BE USED FOR THE FULL
- -- DECLARATIONS, EVEN IF THE DEFERRED CONSTANT DECLARATIONS ARE GIVEN
- -- INDIVIDUALLY.
- 
- 
- -- DSJ  5/09/83
- -- SPS 10/24/83
- -- EG  12/19/83
- -- JRK 12/20/83
- 
- -- DTN 11/19/91     DELETED SUBPART (C).
- 
- WITH REPORT;
- PROCEDURE C74302A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C74302A", "CHECK THAT MULTIPLE DECLARATIONS MAY BE USED " &
-                      "FOR DEFERRED CONSTANT DECLARATIONS");
- 
-      DECLARE
- 
-           PACKAGE PACK1 IS
- 
-                TYPE T IS PRIVATE;
- 
-                B, E : CONSTANT T;
- 
-                F : CONSTANT T;
-           PRIVATE
- 
-                TYPE T IS NEW INTEGER;
- 
-                E : CONSTANT T := T(IDENT_INT(4));
- 
-                B, F : CONSTANT T := T(IDENT_INT(2));
- 
-           END PACK1;
- 
-           USE PACK1;
- 
-      BEGIN
- 
-           IF B/=F THEN
-                FAILED("VALUES OF DEFERRED CONSTANTS B AND F NOT EQUAL");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C74302A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74302b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74302b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74302b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74302b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,308 ****
- -- C74302B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN THE FULL DECLARATION OF A DEFERRED CONSTANT IS
- --     GIVEN AS A MULTIPLE DECLARATION, THE INITIALIZATION EXPRESSION
- --     IS EVALUATED ONCE FOR EACH DEFERRED CONSTANT.  (USE ENUMERATION,
- --     INTEGER, FIXED POINT, FLOATING POINT, ARRAY, RECORD (INCLUDING
- --     USE OF DEFAULT EXPRESSIONS FOR COMPONENTS), ACCESS, AND PRIVATE
- --     TYPES AS FULL DECLARATION OF PRIVATE TYPE)
- 
- -- HISTORY:
- --     BCB 07/25/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74302B IS
- 
-      TYPE ARR_RAN IS RANGE 1..2;
- 
-      BUMP : INTEGER := IDENT_INT(0);
- 
-      GENERIC
-           TYPE DT IS (<>);
-      FUNCTION F1 RETURN DT;
- 
-      GENERIC
-           TYPE FE IS DELTA <>;
-      FUNCTION F2 RETURN FE;
- 
-      GENERIC
-           TYPE FLE IS DIGITS <>;
-      FUNCTION F3 RETURN FLE;
- 
-      GENERIC
-           TYPE CA IS ARRAY(ARR_RAN) OF INTEGER;
-      FUNCTION F4 RETURN CA;
- 
-      GENERIC
-           TYPE GP IS LIMITED PRIVATE;
-      FUNCTION F5 (V : GP) RETURN GP;
- 
-      GENERIC
-           TYPE GP1 IS LIMITED PRIVATE;
-      FUNCTION F6 (V1 : GP1) RETURN GP1;
- 
-      GENERIC
-           TYPE AC IS ACCESS INTEGER;
-      FUNCTION F7 RETURN AC;
- 
-      GENERIC
-           TYPE PP IS PRIVATE;
-      FUNCTION F8 (P1 : PP) RETURN PP;
- 
-      FUNCTION F1 RETURN DT IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN DT'VAL(BUMP);
-      END F1;
- 
-      FUNCTION F2 RETURN FE IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN FE(BUMP);
-      END F2;
- 
-      FUNCTION F3 RETURN FLE IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN FLE(BUMP);
-      END F3;
- 
-      FUNCTION F4 RETURN CA IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN ((BUMP,BUMP-1));
-      END F4;
- 
-      FUNCTION F5 (V : GP) RETURN GP IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN V;
-      END F5;
- 
-      FUNCTION F6 (V1 : GP1) RETURN GP1 IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN V1;
-      END F6;
- 
-      FUNCTION F7 RETURN AC IS
-           VAR : AC;
-      BEGIN
-           BUMP := BUMP + 1;
-           VAR := NEW INTEGER'(BUMP);
-           RETURN VAR;
-      END F7;
- 
-      FUNCTION F8 (P1 : PP) RETURN PP IS
-      BEGIN
-           BUMP := BUMP + 1;
-           RETURN P1;
-      END F8;
- 
-      PACKAGE PACK IS
-           TYPE SP IS PRIVATE;
-           CONS : CONSTANT SP;
-      PRIVATE
-           TYPE SP IS RANGE 1 .. 100;
-           CONS : CONSTANT SP := 50;
-      END PACK;
- 
-      USE PACK;
- 
-      PACKAGE P IS
-           TYPE INT IS PRIVATE;
-           TYPE ENUM IS PRIVATE;
-           TYPE FIX IS PRIVATE;
-           TYPE FLT IS PRIVATE;
-           TYPE CON_ARR IS PRIVATE;
-           TYPE REC IS PRIVATE;
-           TYPE REC1 IS PRIVATE;
-           TYPE ACC IS PRIVATE;
-           TYPE PRIV IS PRIVATE;
- 
-           GENERIC
-                TYPE LP IS PRIVATE;
-           FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN;
- 
-           I1, I2, I3, I4 : CONSTANT INT;
-           E1, E2, E3, E4 : CONSTANT ENUM;
-           FI1, FI2, FI3, FI4 : CONSTANT FIX;
-           FL1, FL2, FL3, FL4 : CONSTANT FLT;
-           CA1, CA2, CA3, CA4 : CONSTANT CON_ARR;
-           R1, R2, R3, R4 : CONSTANT REC;
-           R1A, R2A, R3A, R4A : CONSTANT REC1;
-           A1, A2, A3, A4 : CONSTANT ACC;
-           PR1, PR2, PR3, PR4 : CONSTANT PRIV;
-      PRIVATE
-           TYPE INT IS RANGE 1 .. 100;
- 
-           TYPE ENUM IS (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);
- 
-           TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
- 
-           TYPE FLT IS DIGITS 5 RANGE -100.0 .. 100.0;
- 
-           TYPE CON_ARR IS ARRAY(ARR_RAN) OF INTEGER;
- 
-           TYPE REC IS RECORD
-                COMP1 : INTEGER;
-                COMP2 : INTEGER;
-                COMP3 : BOOLEAN;
-           END RECORD;
- 
-           TYPE REC1 IS RECORD
-                COMP1 : INTEGER := 10;
-                COMP2 : INTEGER := 20;
-                COMP3 : BOOLEAN := FALSE;
-           END RECORD;
- 
-           TYPE ACC IS ACCESS INTEGER;
- 
-           TYPE PRIV IS NEW SP;
- 
-           FUNCTION DDT IS NEW F1 (INT);
-           FUNCTION EDT IS NEW F1 (ENUM);
-           FUNCTION FDT IS NEW F2 (FIX);
-           FUNCTION FLDT IS NEW F3 (FLT);
-           FUNCTION CADT IS NEW F4 (CON_ARR);
-           FUNCTION RDT IS NEW F5 (REC);
-           FUNCTION R1DT IS NEW F6 (REC1);
-           FUNCTION ADT IS NEW F7 (ACC);
-           FUNCTION PDT IS NEW F8 (PRIV);
- 
-           REC_OBJ : REC := (1,2,TRUE);
-           REC1_OBJ : REC1 := (3,4,FALSE);
- 
-           I1, I2, I3, I4 : CONSTANT INT := DDT;
-           E1, E2, E3, E4 : CONSTANT ENUM := EDT;
-           FI1, FI2, FI3, FI4 : CONSTANT FIX := FDT;
-           FL1, FL2, FL3, FL4 : CONSTANT FLT := FLDT;
-           CA1, CA2, CA3, CA4 : CONSTANT CON_ARR := CADT;
-           R1, R2, R3, R4 : CONSTANT REC := RDT(REC_OBJ);
-           R1A, R2A, R3A, R4A : CONSTANT REC1 := R1DT(REC1_OBJ);
-           A1, A2, A3, A4 : CONSTANT ACC := ADT;
-           PR1, PR2, PR3, PR4 : CONSTANT PRIV := PDT(PRIV(CONS));
-      END P;
- 
-      PACKAGE BODY P IS
-           AVAR1 : ACC := NEW INTEGER'(29);
-           AVAR2 : ACC := NEW INTEGER'(30);
-           AVAR3 : ACC := NEW INTEGER'(31);
-           AVAR4 : ACC := NEW INTEGER'(32);
- 
-           FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN Z1 = Z2;
-           END GEN_EQUAL;
- 
-           FUNCTION INT_EQUAL IS NEW GEN_EQUAL (INT);
-           FUNCTION ENUM_EQUAL IS NEW GEN_EQUAL (ENUM);
-           FUNCTION FIX_EQUAL IS NEW GEN_EQUAL (FIX);
-           FUNCTION FLT_EQUAL IS NEW GEN_EQUAL (FLT);
-           FUNCTION ARR_EQUAL IS NEW GEN_EQUAL (CON_ARR);
-           FUNCTION REC_EQUAL IS NEW GEN_EQUAL (REC);
-           FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
-           FUNCTION ACC_EQUAL IS NEW GEN_EQUAL (INTEGER);
-           FUNCTION PRIV_EQUAL IS NEW GEN_EQUAL (PRIV);
-      BEGIN
-           TEST ("C74302B", "CHECK THAT WHEN THE FULL DECLARATION OF " &
-                            "A DEFERRED CONSTANT IS GIVEN AS A " &
-                            "MULTIPLE DECLARATION, THE INITIALIZATION " &
-                            "EXPRESSION IS EVALUATED ONCE FOR EACH " &
-                            "DEFERRED CONSTANT");
- 
-           IF NOT EQUAL(BUMP,36) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED CONSTANTS IN A MULIPLE DECLARATION");
-           END IF;
- 
-           IF NOT INT_EQUAL(I1,1) OR NOT INT_EQUAL(I2,2) OR
-              NOT INT_EQUAL(I3,3) OR NOT INT_EQUAL(I4,4) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED INTEGER CONSTANTS");
-           END IF;
- 
-           IF NOT ENUM_EQUAL(E1,SIX) OR NOT ENUM_EQUAL(E2,SEVEN) OR
-              NOT ENUM_EQUAL(E3,EIGHT) OR NOT ENUM_EQUAL(E4,NINE) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED ENUMERATION CONSTANTS");
-           END IF;
- 
-           IF NOT FIX_EQUAL(FI1,9.0) OR NOT FIX_EQUAL(FI2,10.0) OR
-              NOT FIX_EQUAL(FI3,11.0) OR NOT FIX_EQUAL(FI4,12.0) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED FIXED POINT CONSTANTS");
-           END IF;
- 
-           IF NOT FLT_EQUAL(FL1,13.0) OR NOT FLT_EQUAL(FL2,14.0) OR
-              NOT FLT_EQUAL(FL3,15.0) OR NOT FLT_EQUAL(FL4,16.0) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED FLOATING POINT CONSTANTS");
-           END IF;
- 
-           IF NOT ARR_EQUAL(CA1,(17,16)) OR NOT ARR_EQUAL(CA2,(18,17))
-            OR NOT ARR_EQUAL(CA3,(19,18)) OR NOT ARR_EQUAL(CA4,(20,19))
-                THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                             "DEFERRED ARRAY CONSTANTS");
-           END IF;
- 
-           IF NOT REC_EQUAL(R1,REC_OBJ) OR NOT REC_EQUAL(R2,REC_OBJ)
-              OR NOT REC_EQUAL(R3,REC_OBJ) OR NOT REC_EQUAL(R4,REC_OBJ)
-                THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                             "DEFERRED RECORD CONSTANTS");
-           END IF;
- 
-           IF NOT REC1_EQUAL(R1A,REC1_OBJ) OR NOT REC1_EQUAL(R2A,
-              REC1_OBJ) OR NOT REC1_EQUAL(R3A,REC1_OBJ) OR NOT
-              REC1_EQUAL(R4A,REC1_OBJ) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED RECORD CONSTANTS WITH DEFAULT " &
-                        "EXPRESSIONS");
-           END IF;
- 
-           IF NOT ACC_EQUAL(A1.ALL,AVAR1.ALL) OR NOT ACC_EQUAL(A2.ALL,
-              AVAR2.ALL) OR NOT ACC_EQUAL(A3.ALL,AVAR3.ALL) OR NOT
-              ACC_EQUAL(A4.ALL,AVAR4.ALL) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED ACCESS CONSTANTS");
-           END IF;
- 
-           IF NOT PRIV_EQUAL(PR1,PRIV(CONS)) OR NOT PRIV_EQUAL(PR2,
-              PRIV(CONS)) OR NOT PRIV_EQUAL(PR3,PRIV(CONS)) OR NOT
-              PRIV_EQUAL(PR4,PRIV(CONS)) THEN
-                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
-                        "DEFERRED PRIVATE CONSTANTS");
-           END IF;
- 
-           RESULT;
-      END P;
- 
-      USE P;
- 
- BEGIN
-      NULL;
- END C74302B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74305a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74305a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74305a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- C74305A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --    CHECK THAT A DEFERRED CONSTANT CAN BE USED AS A DEFAULT
- --    INITIALIZATION FOR A PARAMETER OR AS A DEFAULT INITIA-
- --    LIZATION FOR A COMPONENT (NON GENERIC CASE).
- 
- -- DAT  4/06/81
- -- RM   5/21/81
- -- SPS  8/23/82
- -- SPS  2/10/83
- -- SPS 10/20/83
- -- EG  12/20/83
- -- GJD 11/15/95  REMOVED ADA 95 INCOMPATIBILITY.
- 
- WITH REPORT;
- 
- PROCEDURE C74305A IS
- 
-      USE REPORT;
- 
-      PACKAGE PK IS
-           TYPE T1 IS PRIVATE;
-           TYPE T2 IS PRIVATE; 
-           C1 : CONSTANT T1;                   -- OK.
- 
-           PROCEDURE P1 (P : T1 := C1);        -- OK.                
- 
-           TYPE R1 IS RECORD
-                C : T1 := C1;                  -- OK.                
-           END RECORD;
-      PRIVATE
-           PROCEDURE PROC2 (P : T1 := C1);     -- OK.                
- 
-           TYPE R2 IS RECORD
-                C : T1 := C1;                  -- OK.                
-                D : INTEGER := C1'SIZE;        -- OK.                
-           END RECORD;
- 
-           FUNCTION F1 (P : T1) RETURN T1;
- 
-           TYPE T1 IS NEW INTEGER;
-           TYPE T2 IS ARRAY (1..2) OF INTEGER; -- OK.
- 
-           FUNCTION F2 (P : T1) RETURN T1;
- 
-           PROCEDURE P3 (P : T1 := C1+1);      -- OK.
- 
-           PROCEDURE P4 (P : T1 := F1(C1));
-   
-           TYPE R5 IS RECORD
-                C : T1 := F2(C1);
-           END RECORD;
- 
-           PROCEDURE P5 (P : T1 := C1+2) RENAMES P3;
- 
-           TYPE R3 IS RECORD
-                C : T1 := C1;                  -- OK.
-           END RECORD;
- 
-           C1 : CONSTANT T1 := 1;              -- OK.
-           C2 : CONSTANT T2 := (1,1);          -- OK. 
-      END PK;
- 
-      USE PK;
- 
-      PACKAGE BODY PK IS
- 
-           R11 : R1;
- 
-           PROCEDURE P1 (P : T1 := C1) IS
-           BEGIN
-                IF ( P /= 1 ) THEN
-                     FAILED ("PARAMETER DEFAULT OF P1 NOT PROPERLY " &
-                             "INITIALIZED");
-                END IF;
-           END P1;
- 
-           PROCEDURE PROC2 (P : T1 := C1) IS
-           BEGIN NULL; END PROC2;
- 
-           PROCEDURE P3 (P : T1 := C1+1) IS
-           BEGIN
-                IF ( P /= 3 ) THEN
-                     FAILED ("PARAMETER DEFAULT OF P5 NOT PROPERLY " &
-                             "INITIALIZED");
-                END IF;
-           END P3;
- 
-           FUNCTION F1 (P : T1) RETURN T1 IS
-           BEGIN
-                RETURN P+10;
-           END F1;
- 
-           PROCEDURE P4 (P : T1 := F1(C1)) IS
-           BEGIN
-                IF ( P /= 11 ) THEN
-                     FAILED ("WRONG ACTUAL PARAMETER RECEIVED");
-                END IF;
-           END P4;
- 
-           FUNCTION F2 (P : T1) RETURN T1 IS
-           BEGIN
-                RETURN P+20;
-           END F2;
- 
-      BEGIN -- PK BODY.
- 
-           DECLARE
- 
-                R55 : R5;
- 
-           BEGIN
-                TEST ("C74305A","CHECK THAT A DEFERRED CONSTANT CAN " &
-                                "BE USED AS A DEFAULT INITIALIZATION " &
-                                "FOR A PARAMETER OR AS A DEFAULT " &
-                                "INITIALIZATION FOR A COMPONENT (NON " &
-                                "GENERIC CASE)");
- 
-                IF ( R11.C /= 1 ) THEN
-                     FAILED ("RECORD R11 NOT PROPERLY INITIALIZED");
-                END IF;
- 
-                P4;
- 
-                IF ( R55.C /= 21 ) THEN
-                     FAILED ("RECORD R55 NOT PROPERLY INITIALIZED");
-                END IF;
- 
-                P5;
-           END;
-      END PK;
- 
- BEGIN
- 
-      P1;
- 
-      RESULT;
- END C74305A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74305b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74305b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74305b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74305b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C74305B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --    CHECK THAT A DEFERRED CONSTANT CAN BE USED AS A DEFAULT
- --    INITIALIZATION FOR A PARAMETER OR AS A DEFAULT INITIA-
- --    LIZATION FOR A COMPONENT (GENERIC CASE).
- 
- -- EG  12/20/83
- 
- WITH REPORT;
- 
- PROCEDURE C74305B IS
- 
-      USE REPORT;
- 
-      PACKAGE PK IS
-           TYPE TD IS PRIVATE;
-           CD : CONSTANT TD;
-           DD : CONSTANT TD;
- 
-           GENERIC
-                TYPE T1 IS PRIVATE;
-                C1 : T1;
-                WITH PROCEDURE P2 (A1 : T1 := C1; A2 : TD := CD);
-           PROCEDURE P1 (A1 : TD := CD);
- 
-      PRIVATE
-           TYPE TD IS NEW INTEGER;
-           CD : CONSTANT TD := 2;
-           DD : CONSTANT TD := 3;
-      END PK;
- 
-      USE PK;
- 
-      PACKAGE BODY PK IS
- 
-           PROCEDURE P1 (A1 : TD := CD) IS
-           BEGIN
-               IF ( A1 /= 2 ) THEN
-                    FAILED ("WRONG ACTUAL PARAMETER RECEIVED (1)");
-               END IF;
-               P2;
-           END P1;
- 
-           PROCEDURE P3 (X : TD := DD; Y : TD := DD) IS
-           BEGIN
-               IF ( X /= 2 ) THEN
-                    FAILED ("WRONG ACTUAL PARAMETER RECEIVED (2)");
-               END IF;
-               IF ( Y /= 2 ) THEN
-                    FAILED ("WRONG ACTUAL PARAMETER RECEIVED (3)");
-               END IF;
-           END P3;
- 
-           PROCEDURE P4 IS NEW P1 (TD,CD,P3);
- 
-      BEGIN
-           TEST ("C74305B","CHECK THAT A DEFERRED CONSTANT CAN BE "    &
-                           "USED AS A DEFAULT INITIALIZATION FOR A "   &
-                           "PARAMETER OR AS A DEFAULT INITIALIZATION " &
-                           "FOR A COMPONENT (GENERIC CASE)");
-           P4;
-      END PK;
- 
-      PROCEDURE P5 (X : TD := DD; Y : TD := DD) IS
-      BEGIN
-           IF ( X /= CD ) THEN
-                FAILED ("WRONG ACTUAL PARAMETER RECEIVED (4)");
-           END IF;
-           IF ( Y /= CD ) THEN
-                FAILED ("WRONG ACTUAL PARAMETER RECEIVED (5)");
-           END IF;
-      END P5;
- 
-      PROCEDURE P6 IS NEW P1 (TD,CD,P5);
- 
- BEGIN
-      P6;
-      RESULT;
- END C74305B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74306a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74306a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74306a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74306a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,279 ****
- -- C74306A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     AFTER THE FULL DECLARATION OF A DEFERRED CONSTANT, THE VALUE OF
- --     THE CONSTANT MAY BE USED IN ANY EXPRESSION, PARTICULARLY
- --     EXPRESSIONS IN WHICH THE USE WOULD BE ILLEGAL BEFORE THE FULL
- --     DECLARATION.
- 
- -- HISTORY:
- --     BCB 03/14/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74306A IS
- 
-      GENERIC
-           TYPE GENERAL_PURPOSE IS LIMITED PRIVATE;
-           Y : IN OUT GENERAL_PURPOSE;
-      FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
- 
-      FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN X;
-           END IF;
-           RETURN Y;
-      END IDENT;
- 
-      PACKAGE P IS
-           TYPE T IS PRIVATE;
-           C : CONSTANT T;
-      PRIVATE
-           TYPE T IS RANGE 1 .. 100;
- 
-           TYPE A IS ARRAY(1..2) OF T;
- 
-           TYPE B IS ARRAY(INTEGER RANGE <>) OF T;
- 
-           TYPE D (DISC : T) IS RECORD
-                NULL;
-           END RECORD;
- 
-           C : CONSTANT T := 50;
- 
-           PARAM : T := 99;
- 
-           FUNCTION IDENT_T IS NEW IDENT (T, PARAM);
- 
-           FUNCTION F (X : T := C) RETURN T;
- 
-           SUBTYPE RAN IS T RANGE 1 .. C;
- 
-           SUBTYPE IND IS B(1..INTEGER(C));
- 
-           SUBTYPE DIS IS D (DISC => C);
- 
-           OBJ : T := C;
- 
-           CON : CONSTANT T := C;
- 
-           ARR : A := (5, C);
- 
-           PAR : T := IDENT_T (C);
- 
-           RANOBJ : T RANGE 1 .. C := C;
- 
-           INDOBJ : B(1..INTEGER(C));
- 
-           DIS_VAL : DIS;
- 
-           REN : T RENAMES C;
- 
-           GENERIC
-                FOR_PAR : T := C;
-           PACKAGE GENPACK IS
-                VAL : T;
-           END GENPACK;
- 
-           GENERIC
-                IN_PAR : IN T;
-           PACKAGE NEWPACK IS
-                IN_VAL : T;
-           END NEWPACK;
-      END P;
- 
-      USE P;
- 
-      PACKAGE BODY P IS
-           TYPE A1 IS ARRAY(1..2) OF T;
- 
-           TYPE B1 IS ARRAY(INTEGER RANGE <>) OF T;
- 
-           TYPE D1 (DISC1 : T) IS RECORD
-                NULL;
-           END RECORD;
- 
-           SUBTYPE RAN1 IS T RANGE 1 .. C;
- 
-           SUBTYPE IND1 IS B1(1..INTEGER(C));
- 
-           SUBTYPE DIS1 IS D1 (DISC1 => C);
- 
-           OBJ1 : T := C;
- 
-           FUNCVAR : T;
- 
-           CON1 : CONSTANT T := C;
- 
-           ARR1 : A1 := (5, C);
- 
-           PAR1 : T := IDENT_T (C);
- 
-           RANOBJ1 : T RANGE 1 .. C := C;
- 
-           INDOBJ1 : B1(1..INTEGER(C));
- 
-           DIS_VAL1 : DIS1;
- 
-           REN1 : T RENAMES C;
- 
-           FUNCTION F (X : T := C) RETURN T IS
-           BEGIN
-                RETURN C;
-           END F;
- 
-           PACKAGE BODY GENPACK IS
-           BEGIN
-                VAL := FOR_PAR;
-           END GENPACK;
- 
-           PACKAGE BODY NEWPACK IS
-           BEGIN
-                IN_VAL := IN_PAR;
-           END NEWPACK;
- 
-           PACKAGE PACK IS NEW GENPACK (FOR_PAR => C);
- 
-           PACKAGE NPACK IS NEW NEWPACK (IN_PAR => C);
-      BEGIN
-           TEST ("C74306A", "AFTER THE FULL DECLARATION OF A DEFERRED " &
-                            "CONSTANT, THE VALUE OF THE CONSTANT MAY " &
-                            "BE USED IN ANY EXPRESSION, PARTICULARLY " &
-                            "EXPRESSIONS IN WHICH THE USE WOULD BE " &
-                            "ILLEGAL BEFORE THE FULL DECLARATION");
- 
-           IF OBJ /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR OBJ");
-           END IF;
- 
-           IF CON /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR CON");
-           END IF;
- 
-           IF ARR /= (IDENT_T(5), IDENT_T(50)) THEN
-                FAILED ("IMPROPER VALUES FOR ARR");
-           END IF;
- 
-           IF PAR /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR PAR");
-           END IF;
- 
-           IF OBJ1 /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR OBJ1");
-           END IF;
- 
-           IF CON1 /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR CON1");
-           END IF;
- 
-           IF ARR1 /= (IDENT_T(5), IDENT_T(50)) THEN
-                FAILED ("IMPROPER VALUES FOR ARR1");
-           END IF;
- 
-           IF PAR1 /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR PAR1");
-           END IF;
- 
-           IF PACK.VAL /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR PACK.VAL");
-           END IF;
- 
-           IF NPACK.IN_VAL /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR NPACK.IN_VAL");
-           END IF;
- 
-           IF RAN'LAST /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR RAN'LAST");
-           END IF;
- 
-           IF RANOBJ /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR RANOBJ");
-           END IF;
- 
-           IF IND'LAST /= IDENT_INT(50) THEN
-                FAILED ("IMPROPER VALUE FOR IND'LAST");
-           END IF;
- 
-           IF INDOBJ'LAST /= IDENT_INT(50) THEN
-                FAILED ("IMPROPER VALUE FOR INDOBJ'LAST");
-           END IF;
- 
-           IF DIS_VAL.DISC /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR DIS_VAL.DISC");
-           END IF;
- 
-           IF REN /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR REN");
-           END IF;
- 
-           IF RAN1'LAST /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR RAN1'LAST");
-           END IF;
- 
-           IF RANOBJ1 /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR RANOBJ1");
-           END IF;
- 
-           IF IND1'LAST /= IDENT_INT(50) THEN
-                FAILED ("IMPROPER VALUE FOR IND1'LAST");
-           END IF;
- 
-           IF INDOBJ1'LAST /= IDENT_INT(50) THEN
-                FAILED ("IMPROPER VALUE FOR INDOBJ1'LAST");
-           END IF;
- 
-           IF DIS_VAL1.DISC1 /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR DIS_VAL1.DISC1");
-           END IF;
- 
-           IF REN1 /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR REN1");
-           END IF;
- 
-           FUNCVAR := F(C);
- 
-           IF FUNCVAR /= IDENT_T(50) THEN
-                FAILED ("IMPROPER VALUE FOR FUNCVAR");
-           END IF;
- 
-           RESULT;
-      END P;
- 
- BEGIN
-      DECLARE
-           TYPE ARR IS ARRAY(1..2) OF T;
- 
-           VAL1 : T := C;
- 
-           VAL2 : ARR := (C, C);
- 
-           VAL3 : T RENAMES C;
-      BEGIN
-           NULL;
-      END;
- 
-      NULL;
- END C74306A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74307a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74307a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74307a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74307a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- C74307A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXPLICIT CONSTRAINT MAY BE GIVEN IN THE SUBTYPE
- --     INDICATION OF THE FULL DECLARATION OF A DEFERRED CONSTANT.
- 
- -- HISTORY:
- --     BCB 03/14/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74307A IS
- 
-      PACKAGE P IS
-           TYPE T (D : INTEGER) IS PRIVATE;
-           C : CONSTANT T;
-      PRIVATE
-           TYPE T (D : INTEGER) IS RECORD
-                NULL;
-           END RECORD;
-           C : CONSTANT T(2) := (D => 2);
-      END P;
- 
-      USE P;
- 
- BEGIN
-      TEST ("C74307A", "CHECK THAT AN EXPLICIT CONSTRAINT MAY BE " &
-                       "GIVEN IN THE SUBTYPE INDICATION OF THE FULL " &
-                       "DECLARATION OF A DEFERRED CONSTANT");
- 
-      IF C.D /= 2 THEN
-           FAILED ("IMPROPER RESULTS FOR C.D");
-      END IF;
- 
-      RESULT;
- END C74307A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C74401D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN OUT PARAMETER HAVING A LIMITED TYPE IS ALLOWED FOR
- -- FORMAL SUBPROGRAM PARAMETERS.  (ONLY THE CASE OF PRACTICAL INTEREST,
- -- NAMELY, LIMITED PRIVATE TYPES, IS CHECKED HERE.)
- 
- -- CHECK THAT AN OUT PARAMETER IN A RENAMING DECLARATION CAN HAVE A
- -- LIMITED PRIVATE TYPE WHEN IT RENAMES A GENERIC FORMAL SUBPROGRAM.
- 
- -- JBG 5/1/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C74401D IS
- 
-      PACKAGE P IS
-           TYPE LP IS LIMITED PRIVATE;
-           PROCEDURE P1 (X : OUT LP);
-           PROCEDURE P2 (X : OUT LP);
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
-           VAL1 : CONSTANT LP;
-           VAL2 : CONSTANT LP;
-      PRIVATE
-           TYPE LP IS NEW INTEGER;
-           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
-           VAL2 : CONSTANT LP := LP(IDENT_INT(-3));
-      END P;
- 
-      PACKAGE BODY P IS
-           PROCEDURE P1 (X : OUT LP) IS
-           BEGIN
-                X := 3;
-           END P1;
- 
-           PROCEDURE P2 (X : OUT LP) IS
-           BEGIN
-                X := -3;
-           END P2;
- 
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN L = R;
-           END EQ;
-      END P;
- 
-      GENERIC
-           WITH PROCEDURE P3 (Y : OUT P.LP);
-           TYPE GLP IS LIMITED PRIVATE;
-           WITH PROCEDURE P4 (Y : OUT GLP);
-           VAL_P3 : IN OUT P.LP;
-           VAL_P4 : IN OUT GLP;
-      PACKAGE GPACK IS
-           PROCEDURE RENAMED (X : OUT GLP) RENAMES P4;   -- OK. RENAMING.
-      END GPACK;
- 
-      PACKAGE BODY GPACK IS
-      BEGIN
-           P3 (VAL_P3);
-           P4 (VAL_P4);
-      END GPACK;
- 
- BEGIN
- 
-      TEST ("C74401D", "CHECK THAT GENERIC FORMAL SUBPROGRAMS CAN HAVE "&
-                       "LIMITED PRIVATE OUT PARAMETERS");
- 
-      DECLARE
-           VAR1 : P.LP;
-           VAR2 : P.LP;
-           PACKAGE PACK IS NEW GPACK (P.P1, P.LP, P.P2, VAR1, VAR2);
-      BEGIN
-           IF NOT P.EQ (VAR1, P.VAL1) THEN
-                FAILED ("P1 INVOCATION INCORRECT");
-           END IF;
- 
-           IF NOT P.EQ (VAR2, P.VAL2) THEN
-                FAILED ("P2 INVOCATION INCORRECT");
-           END IF;
- 
-           P.P1 (VAR2);        -- RESET VALUE OF VAR2.
-           PACK.RENAMED (VAR2);
- 
-           IF NOT P.EQ (VAR2, P.VAL2) THEN
-                FAILED ("RENAMED INVOCATION INCORRECT");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C74401D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- C74401E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OUT PARAMETERS HAVING A LIMITED PRIVATE TYPE CAN BE
- -- DECLARED IN A PACKAGE SPECIFICATION, INCLUDING WITHIN PACKAGES
- -- NESTED IN A VISIBLE PART.
- 
- -- CHECK THAT A RENAMING DECLARATION CAN RENAME A PROCEDURE DECLARED
- -- WITH AN OUT PARAMETER.
- 
- -- JBG 5/1/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C74401E IS
- 
-      PACKAGE PKG IS
-           TYPE LP IS LIMITED PRIVATE;
-           PROCEDURE P20 (X : OUT LP);        -- OK.
-           PROCEDURE RESET (X : OUT LP);
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
-           VAL1 : CONSTANT LP;
- 
-           PACKAGE NESTED IS
-                PROCEDURE NEST1 (X : OUT LP);
-           PRIVATE
-                PROCEDURE NEST2 (X : OUT LP);
-           END NESTED;
-      PRIVATE
-           TYPE LP IS NEW INTEGER;
-           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
-      END PKG;
- 
-      VAR : PKG.LP;
- 
-      PACKAGE BODY PKG IS
-           PROCEDURE P20 (X : OUT LP) IS
-           BEGIN
-                X := 3;
-           END P20;
- 
-           PROCEDURE RESET (X : OUT LP) IS
-           BEGIN
-                X := LP(IDENT_INT(0));
-           END RESET;
- 
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN L = R;
-           END EQ;
- 
-           PACKAGE BODY NESTED IS
-                PROCEDURE NEST1 (X : OUT LP) IS
-                BEGIN
-                     X := 3;
-                END NEST1;
- 
-                PROCEDURE NEST2 (X : OUT LP) IS
-                BEGIN
-                     X := LP(IDENT_INT(3));
-                END NEST2;
-           END NESTED;
-      BEGIN
-           VAR := LP(IDENT_INT(0));
-      END PKG;
- 
-      PACKAGE PKG1 IS
-           PROCEDURE P21 (X : OUT PKG.LP) RENAMES PKG.P20;   -- OK:
-                                                             -- RENAMING.
-      END PKG1;
- 
- BEGIN
- 
-      TEST ("C74401E", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
-                       "PARAMETER WITH A LIMITED PRIVATE TYPE");
- 
-      PKG.RESET (VAR);
-      PKG.P20 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("DIRECT CALL NOT CORRECT");
-      END IF;
- 
-      PKG.RESET (VAR);
-      PKG1.P21 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("RENAMED CALL NOT CORRECT");
-      END IF;
- 
-      PKG.RESET (VAR);
-      PKG.NESTED.NEST1 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("NESTED CALL NOT CORRECT");
-      END IF;
- 
-      RESULT;
- 
- END C74401E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C74401K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OUT PARAMETERS OF AN ENTRY DECLARATION CAN HAVE A LIMITED
- -- PRIVATE TYPE IF THE ENTRY DECLARATION OCCURS IN THE VISIBLE PART OF A
- -- PACKAGE SPECIFICATION, INCLUDING WITHIN PACKAGES NESTED IN A VISIBLE
- -- PART.
- 
- -- CHECK THAT A RENAMING DECLARATION CAN RENAME AN ENTRY DECLARED
- -- WITH AN OUT PARAMETER.
- 
- -- JBG 5/1/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C74401K IS
- 
-      PACKAGE PKG IS
-           TYPE LP IS LIMITED PRIVATE;
-           TASK P20 IS
-                ENTRY TP20 (X : OUT LP);        -- OK.
-                ENTRY RESET (X : OUT LP);
-           END P20;
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
-           VAL1 : CONSTANT LP;
- 
-           PACKAGE NESTED IS
-                TASK NEST1 IS
-                     ENTRY TNEST1 (X : OUT LP);
-                END NEST1;
-           PRIVATE
-                TASK NEST2 IS
-                     ENTRY TNEST2 (X : OUT LP);
-                END NEST2;
-           END NESTED;
-      PRIVATE
-           TYPE LP IS NEW INTEGER;
-           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
-      END PKG;
- 
-      VAR : PKG.LP;
- 
-      PACKAGE BODY PKG IS
-           TASK BODY P20 IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT TP20 (X : OUT LP) DO
-                               X := 3;
-                          END TP20;
-                     OR   
-                          ACCEPT RESET (X : OUT LP) DO
-                               X := 0;
-                          END RESET;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END P20;
- 
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN L = R;
-           END EQ;
- 
-           PACKAGE BODY NESTED IS
-                TASK BODY NEST1 IS
-                BEGIN
-                     ACCEPT TNEST1 (X : OUT LP) DO
-                          X := 3;
-                     END TNEST1;
-                END NEST1;
- 
-                TASK BODY NEST2 IS
-                BEGIN
-                     NULL;
-                END NEST2;
-           END NESTED;
-      BEGIN
-           VAR := LP(IDENT_INT(0));
-      END PKG;
- 
-      PACKAGE PKG1 IS
-           PROCEDURE P21 (X : OUT PKG.LP) RENAMES PKG.P20.TP20;   -- OK:
-                                                             -- RENAMING.
-      END PKG1;
- 
- BEGIN
- 
-      TEST ("C74401K", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
-                       "PARAMETER WITH A LIMITED PRIVATE TYPE");
- 
-      PKG.P20.RESET (VAR);
-      PKG.P20.TP20 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("DIRECT CALL NOT CORRECT");
-      END IF;
- 
-      PKG.P20.RESET (VAR);
-      PKG1.P21 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("RENAMED CALL NOT CORRECT");
-      END IF;
- 
-      PKG.P20.RESET (VAR);
-      PKG.NESTED.NEST1.TNEST1 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("NESTED CALL NOT CORRECT");
-      END IF;
- 
-      RESULT;
- 
- END C74401K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74401q.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74401q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- C74401Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OUT PARAMETERS HAVING A LIMITED PRIVATE TYPE CAN BE
- -- DECLARED FOR A GENERIC SUBPROGRAM IN A PACKAGE SPECIFICATION,
- -- INCLUDING WITHIN PACKAGES NESTED IN A VISIBLE PART.
- 
- -- JBG 5/1/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C74401Q IS
- 
-      PACKAGE PKG IS
-           TYPE LP IS LIMITED PRIVATE;
- 
-           GENERIC
-           PROCEDURE P20 (X : OUT LP);        -- OK.
-           PROCEDURE RESET (X : OUT LP);
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
-           VAL1 : CONSTANT LP;
- 
-           PACKAGE NESTED IS
-                GENERIC
-                PROCEDURE NEST1 (X : OUT LP);
-           PRIVATE
-                GENERIC
-                PROCEDURE NEST2 (X : OUT LP);
-           END NESTED;
-      PRIVATE
-           TYPE LP IS NEW INTEGER;
-           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
-      END PKG;
- 
-      VAR : PKG.LP;
- 
-      PACKAGE BODY PKG IS
-           PROCEDURE P20 (X : OUT LP) IS
-           BEGIN
-                X := 3;
-           END P20;
- 
-           PROCEDURE RESET (X : OUT LP) IS
-           BEGIN
-                X := 0;
-           END RESET;
- 
-           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN L = R;
-           END EQ;
- 
-           PACKAGE BODY NESTED IS
-                PROCEDURE NEST1 (X : OUT LP) IS
-                BEGIN
-                     X := 3;
-                END NEST1;
- 
-                PROCEDURE NEST2 (X : OUT LP) IS
-                BEGIN
-                     X := LP(IDENT_INT(3));
-                END NEST2;
-           END NESTED;
-      BEGIN
-           VAR := LP(IDENT_INT(0));
-      END PKG;
- 
-      PACKAGE INSTANCES IS
-           PROCEDURE NP20 IS NEW PKG.P20;
-           PROCEDURE NNEST1 IS NEW PKG.NESTED.NEST1;
-      END INSTANCES;
-      USE INSTANCES;
- 
-      PACKAGE PKG1 IS
-           PROCEDURE P21 (X : OUT PKG.LP) RENAMES INSTANCES.NP20;
-      END PKG1;
- 
- BEGIN
- 
-      TEST ("C74401Q", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
-                       "PARAMETER WITH A LIMITED PRIVATE TYPE");
- 
-      PKG.RESET (VAR);
-      NP20 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("DIRECT CALL NOT CORRECT");
-      END IF;
- 
-      PKG.RESET (VAR);
-      PKG1.P21 (VAR);
- 
-      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
-           FAILED ("RENAMED CALL NOT CORRECT");
-      END IF;
- 
-      RESULT;
- 
- END C74401Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74402a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74402a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74402a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,154 ****
- -- C74402A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED TYPE MAY HAVE A
- -- DEFAULT EXPRESSION, EVEN IF THE SUBPROGRAM IS DECLARED OUTSIDE
- -- THE PACKAGE THAT DECLARES THE LIMITED TYPE.
- -- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
- 
- -- DSJ 5/6/83
- -- SPS 10/24/83
- 
- WITH REPORT;
- PROCEDURE C74402A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C74402A", "CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED " &
-                      "TYPE MAY HAVE A DEFAULT EXPRESSION, EVEN IF "    &
-                      "THE SUBPROGRAM IS DECLARED OUTSIDE THE PACKAGE " &
-                      "THAT DECLARES THE LIMITED TYPE");
- 
-      DECLARE
- 
-           PACKAGE PACK1 IS
- 
-                TYPE LP1 IS LIMITED PRIVATE;
-                TYPE LP2 IS ARRAY (1 .. 2) OF LP1;
-                TYPE LP3 IS
-                     RECORD
-                          C1, C2 : LP2;
-                     END RECORD;
- 
-                FUNCTION F1 RETURN LP1;
-                FUNCTION F2 RETURN LP2;
-                FUNCTION F3 RETURN LP3;
- 
-                PROCEDURE G1 (X : LP1 := F1);      -- LEGAL
-                PROCEDURE G2 (X : LP2 := F2);      -- LEGAL
-                PROCEDURE G3 (X : LP3 := F3);      -- LEGAL
- 
-           PRIVATE
- 
-                TYPE LP1 IS NEW INTEGER;
- 
-           END PACK1;
- 
-           PACKAGE BODY PACK1 IS
- 
-                FUNCTION F1 RETURN LP1 IS
-                BEGIN
-                     RETURN LP1'(1);
-                END F1;
- 
-                FUNCTION F2 RETURN LP2 IS
-                BEGIN
-                     RETURN LP2'(2,3);
-                END F2;
- 
-                FUNCTION F3 RETURN LP3 IS
-                BEGIN
-                     RETURN LP3'((4,5),(6,7));
-                END F3;
- 
-                PROCEDURE G1 (X : LP1 := F1) IS
-                BEGIN
-                     IF X /= LP1'(1) THEN
-                          FAILED("WRONG DEFAULT VALUE - LP1");
-                     END IF;
-                END G1;
- 
-                PROCEDURE G2 (X : LP2 := F2) IS
-                BEGIN
-                     IF X /= LP2'(2,3) THEN
-                          FAILED("WRONG DEFAULT VALUE - LP2");
-                     END IF;
-                END G2;
- 
-                PROCEDURE G3 (X : LP3 := F3) IS
-                BEGIN
-                     IF X /= LP3'((4,5),(6,7)) THEN
-                          FAILED("WRONG DEFAULT VALUE - LP3");
-                     END IF;
-                END G3;
- 
-           BEGIN
- 
-                G1;            -- LEGAL, DEFAULT USED
-                G2;            -- LEGAL, DEFAULT USED
-                G3;            -- LEGAL, DEFAULT USED
- 
-                G1(F1);        -- LEGAL
-                G2(F2);        -- LEGAL
-                G3(F3);        -- LEGAL
- 
-           END PACK1;
- 
-           USE PACK1;
- 
-           PROCEDURE G4 (X : LP1 := F1) IS
-           BEGIN
-                G1;            -- LEGAL, DEFAULT USED
-                G1(X);
-           END G4;
- 
-           PROCEDURE G5 (X : LP2 := F2) IS
-           BEGIN
-                G2;            -- LEGAL, DEFAULT USED
-                G2(X);
-           END G5;
- 
-           PROCEDURE G6 (X : LP3 := F3) IS
-           BEGIN
-                G3;            -- DEFAULT USED
-                G3(X);
-           END G6;
- 
-      BEGIN
- 
-           G4;                 -- LEGAL, DEFAULT USED
-           G5;                 -- LEGAL, DEFAULT USED
-           G6;                 -- LEGAL, DEFAULT USED
- 
-           G4(F1);             -- LEGAL
-           G5(F2);             -- LEGAL
-           G6(F3);             -- LEGAL
- 
-      END;
- 
-      RESULT;
- 
- END C74402A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74402b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74402b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74402b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74402b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C74402B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INITIALIZATION OF IN PARAMETERS THAT ARE OF
- -- LIMITED PRIVATE TYPE IS PERMITTED.
- -- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
- 
- -- DAS  1/21/81
- -- ABW  6/30/82
- -- BHS  7/10/84
- 
- WITH REPORT;
- PROCEDURE C74402B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST( "C74402B" , "CHECK THAT INITIALIZATION OF IN PARAMETERS " &
-                        "OF LIMITED PRIVATE TYPE IS PERMITTED" );
- 
-      DECLARE
- 
-           PACKAGE PKG IS
- 
-                TYPE LPTYPE IS LIMITED PRIVATE;
-                CLP : CONSTANT LPTYPE;
-                XLP : CONSTANT LPTYPE;
-                FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN;
-                FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN;
- 
-           PRIVATE
- 
-                TYPE LPTYPE IS NEW INTEGER RANGE 0..127;
-                CLP : CONSTANT LPTYPE := 127;
-                XLP : CONSTANT LPTYPE := 0;
- 
-           END;
- 
-           PACKAGE BODY PKG IS
- 
-                FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN (L = CLP);
-                END EQCLP;
- 
-                FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN (L = XLP);
-                END EQXLP;
- 
-           END PKG;
- 
-           USE PKG;
- 
-           PROCEDURE PROC1 (Y : IN LPTYPE := CLP) IS
-           BEGIN
-                IF (EQCLP (Y)) THEN
-                     FAILED( "LIMITED PRIVATE NOT PASSED, " &
-                             "DEFAULT CLP EMPLOYED" );
-                ELSIF (NOT EQXLP (Y)) THEN
-                     FAILED( "NO LIMITED PRIVATE FOUND" );
-                END IF;
-           END PROC1;
- 
-           PROCEDURE PROC2 (Y : IN LPTYPE := CLP) IS
-           BEGIN
-                IF (NOT EQCLP(Y)) THEN
-                     FAILED( "DEFAULT NOT EMPLOYED" );
-                END IF;
-           END PROC2;
- 
-      BEGIN
- 
-           PROC1(XLP);
-           PROC2;
- 
-      END;
- 
-      RESULT;
- 
- END C74402B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74406a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74406a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74406a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74406a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- C74406A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FULL DECLARATION OF A LIMITED PRIVATE TYPE CAN
- --     DECLARE A TASK TYPE, A TYPE DERIVED FROM A LIMITED PRIVATE TYPE,
- --     AND A COMPOSITE TYPE WITH A COMPONENT OF A LIMITED TYPE.
- 
- -- HISTORY:
- --     BCB 03/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74406A IS
- 
-      PACKAGE TP IS
-           TYPE T IS LIMITED PRIVATE;
-           PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER);
-           FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN;
-      PRIVATE
-           TYPE T IS RANGE 1 .. 100;
-      END TP;
- 
-      PACKAGE BODY TP IS
-           PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER) IS
-           BEGIN
-                Z1 := T (Z2);
-           END INIT;
- 
-           FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN ONE = TWO;
-                ELSE
-                     RETURN ONE /= TWO;
-                END IF;
-           END EQUAL_T;
-      BEGIN
-           NULL;
-      END TP;
- 
-      USE TP;
- 
-      PACKAGE P IS
-           TYPE T1 IS LIMITED PRIVATE;
-           TYPE T2 IS LIMITED PRIVATE;
-           TYPE T3 IS LIMITED PRIVATE;
-           TYPE T4 IS LIMITED PRIVATE;
-      PRIVATE
-           TASK TYPE T1 IS
-                ENTRY HERE(VAL1 : IN OUT INTEGER);
-           END T1;
- 
-           TYPE T2 IS NEW T;
- 
-           TYPE T3 IS RECORD
-                INT : T;
-           END RECORD;
- 
-           TYPE T4 IS ARRAY(1..5) OF T;
-      END P;
- 
-      PACKAGE BODY P IS
-           X1 : T1;
-           X3 : T3;
-           X4 : T4;
-           VAR : INTEGER := 25;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT HERE(VAL1 : IN OUT INTEGER) DO
-                     VAL1 := VAL1 * 2;
-                END HERE;
-           END T1;
- 
-      BEGIN
-           TEST ("C74406A", "CHECK THAT THE FULL DECLARATION OF A " &
-                            "LIMITED PRIVATE TYPE CAN DECLARE A TASK " &
-                            "TYPE, A TYPE DERIVED FROM A LIMITED " &
-                            "PRIVATE TYPE, AND A COMPOSITE TYPE WITH " &
-                            "A COMPONENT OF A LIMITED TYPE");
- 
-           X1.HERE(VAR);
- 
-           IF NOT EQUAL(VAR,IDENT_INT(50)) THEN
-                FAILED ("IMPROPER VALUE FOR VAL");
-           END IF;
- 
-           INIT (X3.INT, 50);
- 
-           IF X3.INT NOT IN T THEN
-                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
-           END IF;
- 
-           INIT (X4(3), 17);
- 
-           IF NOT EQUAL_T(T'(X4(3)),T(X4(3))) THEN
-                FAILED ("IMPROPER RESULT FROM QUALIFICATION AND " &
-                        "EXPLICIT CONVERSION");
-           END IF;
- 
-           RESULT;
-      END P;
- 
-      USE P;
- 
- BEGIN
-      NULL;
- END C74406A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74407b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74407b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74407b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74407b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C74407B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, FOR A LIMITED PRIVATE TYPE, THAT PRE-DEFINED EQUALITY AND
- --     ASSIGNMENT ARE DEFINED AND AVAILABLE WITHIN THE PRIVATE PART AND
- --     THE BODY OF A PACKAGE, AFTER THE FULL DECLARATION, IF THE FULL
- --     DECLARATION IS NOT LIMITED.
- 
- -- HISTORY:
- --     BCB 07/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C74407B IS
- 
-      PACKAGE PP IS
-           TYPE PRIV IS PRIVATE;
-           C1 : CONSTANT PRIV;
-           C2 : CONSTANT PRIV;
-      PRIVATE
-           TYPE PRIV IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
-           C1 : CONSTANT PRIV := ONE;
-           C2 : CONSTANT PRIV := TWO;
-      END PP;
- 
-      USE PP;
- 
-      PACKAGE P IS
-           TYPE INT IS LIMITED PRIVATE;
-           TYPE COMP IS LIMITED PRIVATE;
-           TYPE DER IS LIMITED PRIVATE;
-      PRIVATE
-           TYPE INT IS RANGE 1 .. 100;
-           TYPE COMP IS ARRAY(1..5) OF INTEGER;
-           TYPE DER IS NEW PRIV;
-           D, E : INT := 10;
-           F : INT := 20;
-           CONS_INT1 : CONSTANT INT := 30;
-           G : BOOLEAN := D = E;
-           H : BOOLEAN := D /= F;
-           CONS_BOOL1 : CONSTANT BOOLEAN := D = E;
-           CONS_BOOL2 : CONSTANT BOOLEAN := D /= F;
-           I : COMP := (1,2,3,4,5);
-           CONS_COMP1 : CONSTANT COMP := (6,7,8,9,10);
-           J : DER := DER(C1);
-           CONS_DER1 : CONSTANT DER := DER(C2);
-      END P;
- 
-      PACKAGE BODY P IS
-           A, B, C : INT;
-           X, Y, Z : COMP;
-           L, M, N : DER;
-           CONS_INT2 : CONSTANT INT := 10;
-           CONS_COMP2 : CONSTANT COMP := (1,2,3,4,5);
-           CONS_DER2 : CONSTANT DER := DER(C1);
-      BEGIN
-           TEST ("C74407B", "CHECK, FOR A LIMITED PRIVATE TYPE, THAT " &
-                            "PRE-DEFINED EQUALITY AND ASSIGNMENT ARE " &
-                            "DEFINED AND AVAILABLE WITHIN THE PRIVATE " &
-                            "PART AND THE BODY OF A PACKAGE, AFTER " &
-                            "THE FULL DECLARATION, IF THE FULL " &
-                            "DECLARATION IS NOT LIMITED");
- 
-           A := 10;
- 
-           B := 10;
- 
-           C := 20;
- 
-           IF A = C THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 1");
-           END IF;
- 
-           IF A /= B THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 1");
-           END IF;
- 
-           IF CONS_INT2 = C THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 2");
-           END IF;
- 
-           IF CONS_INT2 /= B THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 2");
-           END IF;
- 
-           IF NOT G THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
-                        "PACKAGE - 1");
-           END IF;
- 
-           IF NOT H THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
-                        "PACKAGE - 1");
-           END IF;
- 
-           IF NOT CONS_BOOL1 THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
-                        "PACKAGE - 2");
-           END IF;
- 
-           IF NOT CONS_BOOL2 THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
-                        "PACKAGE - 2");
-           END IF;
- 
-           X := (1,2,3,4,5);
- 
-           Y := (1,2,3,4,5);
- 
-           Z := (5,4,3,2,1);
- 
-           IF X = Z THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 3");
-           END IF;
- 
-           IF X /= Y THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 3");
-           END IF;
- 
-           IF CONS_COMP2 = Z THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 4");
-           END IF;
- 
-           IF CONS_COMP2 /= Y THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 4");
-           END IF;
- 
-           L := DER(C1);
- 
-           M := DER(C1);
- 
-           N := DER(C2);
- 
-           IF L = N THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 5");
-           END IF;
- 
-           IF L /= M THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 5");
-           END IF;
- 
-           IF CONS_DER2 = N THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 6");
-           END IF;
- 
-           IF CONS_DER2 /= M THEN
-                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
-                        "OPERATION WITHIN THE PACKAGE BODY - 6");
-           END IF;
- 
-           RESULT;
-      END P;
- 
-      USE P;
- 
- BEGIN
-      NULL;
- END C74407B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74409b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74409b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c74409b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c74409b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C74409B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A COMPOSITE TYPE IS DECLARED IN THE SAME PACKAGE 
- -- AS A LIMITED PRIVATE TYPE AND HAS A COMPONENT OF THAT TYPE, 
- -- THE COMPOSITE TYPE IS TREATED AS A LIMITED TYPE UNTIL THE 
- -- EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE DECLARATION 
- -- OF THE COMPOSITE TYPE AND AFTER THE FULL DECLARATION OF THE 
- -- LIMITED PRIVATE TYPE
- 
- -- DSJ 5/5/83
- -- JBG 9/23/83
- 
- WITH REPORT;
- PROCEDURE C74409B IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C74409B", "CHECK THAT A COMPOSITE TYPE WITH A LIMITED " &
-                      "PRIVATE COMPONENT IS TREATED AS A LIMITED " &
-                      "TYPE UNTIL ASSIGNMENT AND EQUALITY ARE BOTH " &
-                      "AVAILABLE FOR THE COMPOSITE TYPE");
- 
-      DECLARE
- 
-           PACKAGE P IS
-                TYPE LP IS LIMITED PRIVATE;
-                PACKAGE Q IS
-                     TYPE LP_ARRAY IS ARRAY (1 .. 2) OF LP;
-                END Q;
-           PRIVATE
-                TYPE LP IS NEW INTEGER;
-           END P;
- 
-           PACKAGE BODY P IS
-                USE Q;
-                FUNCTION "=" (L,R : LP_ARRAY) RETURN BOOLEAN IS  -- LEGAL
-                BEGIN
-                     RETURN TRUE;
-                END;
- 
-                GENERIC
-                     TYPE T IS PRIVATE;     -- NOTE: NOT LIMITED PRIVATE
-                     C, D : T;
-                PACKAGE A IS
-                     -- IRRELEVANT DETAILS
-                END A;
- 
-                PACKAGE BODY A IS
-                BEGIN
-                     IF C = D THEN
-                          FAILED ("USED WRONG EQUALITY OPERATOR");
-                     END IF;
-                END A;
- 
-                PACKAGE BODY Q IS
-                     PACKAGE ANOTHER_NEW_A IS 
-                          NEW A (LP_ARRAY, (2,3), (4,5)); -- LEGAL
-                END Q;
-           END P;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END C74409B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,390 ****
- -- C760001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Initialize is called for objects and components of
- --      a controlled type when the objects and components are not
- --      assigned explicit initial values.  Check this for "simple" controlled
- --      objects, controlled record components and arrays with controlled
- --      components.
- --
- --      Check that if an explicit initial value is assigned to an object
- --      or component of a controlled type then Initialize is not called.
- --
- -- TEST DESCRIPTION:
- --      This test derives a type for Ada.Finalization.Controlled, and
- --      overrides the Initialize and Adjust operations for the type.  The
- --      intent of the type is that it should carry incremental values
- --      indicating the ordering of events with respect to these (and default
- --      initialization) operations.  The body of the test uses these values
- --      to determine that the implicit calls to these subprograms happen
- --      (or don't) at the appropriate times.
- --
- --      The test further derives types from this "root" type, which are the
- --      actual types used in the test.  One of the types is "simply" derived
- --      from the "root" type, the other contains a component of the first
- --      type, thus nesting a controlled object as a record component in
- --      controlled objects.
- --
- --      The main program declares objects of these types and checks the
- --      values of the components to ascertain that they have been touched
- --      as expected.
- --
- --      Note that Finalization procedures are provided.  This test does not
- --      test that the calls to Finalization are made correctly.  The
- --      Finalization procedures are provided to catch an implementation that
- --      calls Finalization at an incorrect time.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Oct 95   SAIC    Update and repair for ACVC 2.0.1
- --
- --!
- 
- ---------------------------------------------------------------- C760001_0
- 
- with Ada.Finalization;
- package C760001_0 is
-   subtype Unique_ID is Natural;
-   function Unique_Value return Unique_ID;
-   -- increments each time it's called
- 
-   function Most_Recent_Unique_Value return Unique_ID;
-   -- returns the same value as the most recent call to Unique_Value
- 
-   type Root_Controlled is new Ada.Finalization.Controlled with record
-     My_ID      : Unique_ID := Unique_Value;
-     My_Init_ID : Unique_ID := Unique_ID'First;
-     My_Adj_ID  : Unique_ID := Unique_ID'First;
-   end record;
- 
-   procedure Initialize( R: in out Root_Controlled );
-   procedure Adjust    ( R: in out Root_Controlled );
- 
-   TC_Initialize_Calls_Is_Failing : Boolean := False;
- 
- end C760001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C760001_0 is
- 
-   Global_Unique_Counter : Unique_ID := 0;
-   
-   function Unique_Value return Unique_ID is
-   begin
-     Global_Unique_Counter := Global_Unique_Counter +1;
-     return Global_Unique_Counter;
-   end Unique_Value;
-   
-   function Most_Recent_Unique_Value return Unique_ID is
-   begin
-     return Global_Unique_Counter;
-   end Most_Recent_Unique_Value;
-   
-   procedure Initialize( R: in out Root_Controlled ) is
-   begin
-     if TC_Initialize_Calls_Is_Failing then
-       Report.Failed("Initialized incorrectly called");
-     end if;
-     R.My_Init_ID := Unique_Value;
-   end Initialize;
- 
-   procedure Adjust( R: in out Root_Controlled ) is
-   begin
-     R.My_Adj_ID := Unique_Value;
-   end Adjust;
- 
- end C760001_0;
- 
- ---------------------------------------------------------------- C760001_1
- 
- with Ada.Finalization;
- with C760001_0;
- package C760001_1 is
- 
-   type Proc_ID is (None, Init, Adj, Fin);
- 
-   type Test_Controlled is new C760001_0.Root_Controlled with record
-     Last_Proc_Called: Proc_ID := None;
-   end record;
- 
-   procedure Initialize( TC: in out Test_Controlled );
-   procedure Adjust    ( TC: in out Test_Controlled );
-   procedure Finalize  ( TC: in out Test_Controlled );
- 
-   type Nested_Controlled is new C760001_0.Root_Controlled with record
-     Nested : C760001_0.Root_Controlled;
-     Last_Proc_Called: Proc_ID := None;
-   end record;
- 
-   procedure Initialize( TC: in out Nested_Controlled );
-   procedure Adjust    ( TC: in out Nested_Controlled );
-   procedure Finalize  ( TC: in out Nested_Controlled );
- 
- end C760001_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C760001_1 is
- 
-   procedure Initialize( TC: in out Test_Controlled ) is
-   begin
-     if TC.Last_Proc_Called /= None then
-       Report.Failed("Initialize for Test_Controlled");
-     end if;
-     TC.Last_Proc_Called := Init;
-     C760001_0.Initialize(C760001_0.Root_Controlled(TC));
-   end Initialize;
- 
-   procedure Adjust    ( TC: in out Test_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Adj;
-     C760001_0.Adjust(C760001_0.Root_Controlled(TC));
-   end Adjust;
- 
-   procedure Finalize  ( TC: in out Test_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Fin;
-   end Finalize;
- 
-   procedure Initialize( TC: in out Nested_Controlled ) is
-   begin
-     if TC.Last_Proc_Called /= None then
-       Report.Failed("Initialize for Nested_Controlled");
-     end if;
-     TC.Last_Proc_Called := Init;
-     C760001_0.Initialize(C760001_0.Root_Controlled(TC));
-   end Initialize;
- 
-   procedure Adjust    ( TC: in out Nested_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Adj;
-     C760001_0.Adjust(C760001_0.Root_Controlled(TC));
-   end Adjust;
- 
-   procedure Finalize  ( TC: in out Nested_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Fin;
-   end Finalize;
- 
- end C760001_1;
- 
- ---------------------------------------------------------------- C760001
- 
- with Report;
- with TCTouch;
- with C760001_0;
- with C760001_1;
- with Ada.Finalization;
- procedure C760001 is
- 
-   use type C760001_1.Proc_ID;
- 
-   -- in the first test, test the simple case.  Check that a controlled object
-   -- causes a call to the procedure Initialize.
-   -- Also check that assignment causes a call to Adjust.
- 
-   procedure Check_Simple_Objects is
-     S,T : C760001_1.Test_Controlled;
-   begin
-     TCTouch.Assert(S.My_ID < S.My_Init_ID,"Default before dispatch");
-     TCTouch.Assert((S.Last_Proc_Called = C760001_1.Init) and
-                                         (T.Last_Proc_Called = C760001_1.Init),
-                    "Initialize for simple object");
-     S := T;
-     TCTouch.Assert((S.Last_Proc_Called = C760001_1.Adj),
-                    "Adjust for simple object");
-     TCTouch.Assert((S.My_ID = T.My_ID),
-                    "Simple object My_ID's don't match");
-     TCTouch.Assert((S.My_Init_ID = T.My_Init_ID),
-                    "Simple object My_Init_ID's don't match");
-     TCTouch.Assert((S.My_Adj_ID > T.My_Adj_ID),
-                    "Simple object My_Adj_ID's in wrong order");
-   end Check_Simple_Objects;
- 
-   -- in the second test, test a more complex case, check that a controlled
-   -- component of a controlled object gets processed correctly
- 
-   procedure Check_Nested_Objects is
-     NO1 : C760001_1.Nested_Controlled;
-   begin
-     TCTouch.Assert((NO1.My_ID < NO1.My_Init_Id),
-                    "Default value order incorrect");
-     TCTouch.Assert((NO1.My_Init_Id > NO1.Nested.My_Init_ID),
-                    "Initialization call order incorrect");
-   end Check_Nested_Objects;
- 
-   -- check that objects assigned an initial value at declaration are Adjusted
-   -- and NOT Initialized
- 
-   procedure Check_Objects_With_Initial_Values is
- 
-     TC_Now : constant C760001_0.Unique_ID := C760001_0.Unique_Value;
- 
-     A: C760001_1.Test_Controlled := 
-       ( Ada.Finalization.Controlled
-         with TC_Now,
-              TC_Now,
-              TC_Now,
-              C760001_1.None);
- 
-     B: C760001_1.Nested_Controlled := 
-       ( Ada.Finalization.Controlled
-         with TC_Now,
-              TC_Now,
-              TC_Now,
-              C760001_0.Root_Controlled(A),
-              C760001_1.None);
- 
-   begin
-     -- the implementation may or may not call Adjust for the values
-     -- assigned into A and B,
-     -- but should NOT call Initialize.
-     -- if the value used in the aggregate is overwritten by Initialize,
-     -- this indicates failure
-     TCTouch.Assert(A.My_Init_Id = TC_Now,
-                    "Initialize was called for A with initial value");
-     TCTouch.Assert(B.My_Init_Id = TC_Now,
-                    "Initialize was called for B with initial value");
-     TCTouch.Assert(B.Nested.My_Init_ID = TC_Now,
-                    "Initialize was called for B.Nested initial value");
-   end Check_Objects_With_Initial_Values;
- 
-   procedure Check_Array_Case is
-     type Array_Simple is array(1..4) of C760001_1.Test_Controlled;
-     type Array_Nested is array(1..4) of C760001_1.Nested_Controlled;
- 
-     Simple_Array_Default : Array_Simple;
- 
-     Nested_Array_Default : Array_Nested;
- 
-     TC_A_Bit_Later : C760001_0.Unique_ID;
- 
-   begin
-     TC_A_Bit_Later := C760001_0.Unique_Value;
-     for N in 1..4 loop
-       TCTouch.Assert(Simple_Array_Default(N).Last_Proc_Called
-                      = C760001_1.Init,
-                      "Initialize for array initial value");
- 
-       TCTouch.Assert( (Simple_Array_Default(N).My_Init_ID
-                        > C760001_0.Unique_ID'First)
-                       and (Simple_Array_Default(N).My_Init_ID
-                        < TC_A_Bit_Later),
-                      "Initialize timing for simple array");
- 
-       TCTouch.Assert( (Nested_Array_Default(N).My_Init_ID
-                        > C760001_0.Unique_ID'First)
-                       and (Nested_Array_Default(N).My_Init_ID
-                        < TC_A_Bit_Later),
-                      "Initialize timing for container array");
- 
-       TCTouch.Assert(Nested_Array_Default(N).Last_Proc_Called
-                      = C760001_1.Init,
-                      "Initialize for nested array (outer) initial value");
- 
-       TCTouch.Assert( (Nested_Array_Default(N).Nested.My_Init_ID
-                        > C760001_0.Unique_ID'First)
-                       and (Nested_Array_Default(N).Nested.My_Init_ID
-                        < Nested_Array_Default(N).My_Init_ID),
-                      "Initialize timing for array content");
-     end loop;
-   end Check_Array_Case;
- 
-   procedure Check_Array_Case_With_Initial_Values is
- 
-     TC_Now : constant C760001_0.Unique_ID := C760001_0.Unique_Value;
- 
-     type Array_Simple is array(1..4) of C760001_1.Test_Controlled;
-     type Array_Nested is array(1..4) of C760001_1.Nested_Controlled;
- 
-     Simple_Array_Explicit : Array_Simple := ( 1..4 => (
-         Ada.Finalization.Controlled
-         with TC_Now,
-              TC_Now,
-              TC_Now,
-              C760001_1.None                 )         );
- 
-     A : constant C760001_0.Root_Controlled := 
-       ( Ada.Finalization.Controlled
-         with others => TC_Now);
- 
-     Nested_Array_Explicit : Array_Nested := ( 1..4 => (
-         Ada.Finalization.Controlled
-         with TC_Now,
-              TC_Now,
-              TC_Now,
-              A,
-              C760001_1.None                 )         );
- 
-   begin
-     -- the implementation may or may not call Adjust for the values
-     -- assigned into Simple_Array_Explicit and Nested_Array_Explicit,
-     -- but should NOT call Initialize.
-     -- if the value used in the aggregate is overwritten by Initialize,
-     -- this indicates failure
-     for N in 1..4 loop
-       TCTouch.Assert(Simple_Array_Explicit(N).My_Init_ID
-                      = TC_Now,
-                      "Initialize was called for array with initial value");
-       TCTouch.Assert(Nested_Array_Explicit(N).My_Init_ID
-                      = TC_Now,
-         "Initialize was called for nested array (outer) with initial value");
-       TCTouch.Assert(Nested_Array_Explicit(N).Nested.My_Init_ID = TC_Now,
-         "Initialize was called for nested array (inner) with initial value");
-     end loop;
-   end Check_Array_Case_With_Initial_Values;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C760001", "Check that Initialize is called for objects " &
-                           "and components of a controlled type when the " &
-                           "objects and components are not assigned " &
-                           "explicit initial values.  Check that if an " &
-                           "explicit initial value is assigned to an " &
-                           "object or component of a controlled type " &
-                           "then Initialize is not called" );
- 
-   Check_Simple_Objects;
- 
-   Check_Nested_Objects;
- 
-   Check_Array_Case;
- 
-   C760001_0.TC_Initialize_Calls_Is_Failing := True;
- 
-   Check_Objects_With_Initial_Values;
- 
-   Check_Array_Case_With_Initial_Values;
- 
-   Report.Result;
- 
- end C760001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,489 ****
- -- C760002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that assignment to an object of a (non-limited) controlled
- --      type causes the Adjust operation of the type to be called.
- --      Check that Adjust is called after copying the value of the
- --      source expression to the target object.
- --
- --      Check that Adjust is called for all controlled components when
- --      the containing object is assigned.  (Test this for the cases
- --      where the type of the containing object is controlled and
- --      noncontrolled; test this for initialization as well as
- --      assignment statements.)
- --
- --      Check that for an object of a controlled type with controlled
- --      components, Adjust for each of the components is called before
- --      the containing object is adjusted.
- --
- --      Check that an Adjust procedure for a Limited_Controlled type is
- --      not called by the implementation.
- --
- -- TEST DESCRIPTION:
- --      This test is loosely "derived" from C760001.
- --
- --      Visit Tags:
- --        D - Default value at declaration
- --        d - Default value at declaration, limited root
- --        I - initialize at root controlled
- --        i - initialize at root limited controlled
- --        A - adjust at root controlled
- --        X,Y,Z,x,y,z - used in test body
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Correct test assertion logic for Sinister case
- --
- --!
- 
- ---------------------------------------------------------------- C760002_0
- 
- with Ada.Finalization;
- package C760002_0 is
-   subtype Unique_ID is Natural;
-   function Unique_Value return Unique_ID;
-   -- increments each time it's called
- 
-   function Most_Recent_Unique_Value return Unique_ID;
-   -- returns the same value as the most recent call to Unique_Value
- 
-   type Root is tagged record
-     My_ID      : Unique_ID := Unique_Value;
-     Visit_Tag  : Character := 'D';  -- Default
-   end record;
- 
-   procedure Initialize( R: in out Root );
-   procedure Adjust    ( R: in out Root );
- 
-   type Root_Controlled is new Ada.Finalization.Controlled with record
-     My_ID      : Unique_ID := Unique_Value;
-     Visit_Tag  : Character := 'D'; ---------------------------------------- D
-   end record;
- 
-   procedure Initialize( R: in out Root_Controlled );
-   procedure Adjust    ( R: in out Root_Controlled );
- 
-   type Root_Limited_Controlled is
-        new Ada.Finalization.Limited_Controlled with record
-     My_ID      : Unique_ID := Unique_Value;
-     Visit_Tag  : Character := 'd'; ---------------------------------------- d
-   end record;
- 
-   procedure Initialize( R: in out Root_Limited_Controlled );
-   procedure Adjust    ( R: in out Root_Limited_Controlled );
- 
- end C760002_0;
- 
- with Report;
- package body C760002_0 is
- 
-   Global_Unique_Counter : Unique_ID := 0;
-   
-   function Unique_Value return Unique_ID is
-   begin
-     Global_Unique_Counter := Global_Unique_Counter +1;
-     return Global_Unique_Counter;
-   end Unique_Value;
-   
-   function Most_Recent_Unique_Value return Unique_ID is
-   begin
-     return Global_Unique_Counter;
-   end Most_Recent_Unique_Value;
- 
-   procedure Initialize( R: in out Root ) is
-   begin
-     Report.Failed("Initialize called for Non_Controlled type");
-   end Initialize;
- 
-   procedure Adjust    ( R: in out Root ) is
-   begin
-     Report.Failed("Adjust called for Non_Controlled type");
-   end Adjust;
- 
-   procedure Initialize( R: in out Root_Controlled ) is
-   begin
-     R.Visit_Tag := 'I'; --------------------------------------------------- I
-   end Initialize;
- 
-   procedure Adjust( R: in out Root_Controlled ) is
-   begin
-     R.Visit_Tag := 'A'; --------------------------------------------------- A
-   end Adjust;
- 
-   procedure Initialize( R: in out Root_Limited_Controlled ) is
-   begin
-     R.Visit_Tag := 'i'; --------------------------------------------------- i
-   end Initialize;
- 
-   procedure Adjust( R: in out Root_Limited_Controlled ) is
-   begin
-     Report.Failed("Adjust called for Limited_Controlled type");
-   end Adjust;
- 
- end C760002_0;
- 
- ---------------------------------------------------------------- C760002_1
- 
- with Ada.Finalization;
- with C760002_0;
- package C760002_1 is
- 
-   type Proc_ID is (None, Init, Adj, Fin);
- 
-   type Test_Controlled is new C760002_0.Root_Controlled with record
-     Last_Proc_Called: Proc_ID := None;
-   end record;
- 
-   procedure Initialize( TC: in out Test_Controlled );
-   procedure Adjust    ( TC: in out Test_Controlled );
-   procedure Finalize  ( TC: in out Test_Controlled );
- 
-   type Nested_Controlled is new C760002_0.Root_Controlled with record
-     Nested : C760002_0.Root_Controlled;
-     Last_Proc_Called: Proc_ID := None;
-   end record;
- 
-   procedure Initialize( TC: in out Nested_Controlled );
-   procedure Adjust    ( TC: in out Nested_Controlled );
-   procedure Finalize  ( TC: in out Nested_Controlled );
- 
-   type Test_Limited_Controlled is
-        new C760002_0.Root_Limited_Controlled with record
-     Last_Proc_Called: Proc_ID := None;
-   end record;
- 
-   procedure Initialize( TC: in out Test_Limited_Controlled );
-   procedure Adjust    ( TC: in out Test_Limited_Controlled );
-   procedure Finalize  ( TC: in out Test_Limited_Controlled );
- 
-   type Nested_Limited_Controlled is
-        new C760002_0.Root_Limited_Controlled with record
-     Nested : C760002_0.Root_Limited_Controlled;
-     Last_Proc_Called: Proc_ID := None;
-   end record;
- 
-   procedure Initialize( TC: in out Nested_Limited_Controlled );
-   procedure Adjust    ( TC: in out Nested_Limited_Controlled );
-   procedure Finalize  ( TC: in out Nested_Limited_Controlled );
- 
- end C760002_1;
- 
- with Report;
- package body C760002_1 is
- 
-   procedure Initialize( TC: in out Test_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Init;
-     C760002_0.Initialize(C760002_0.Root_Controlled(TC));
-   end Initialize;
- 
-   procedure Adjust    ( TC: in out Test_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Adj;
-     C760002_0.Adjust(C760002_0.Root_Controlled(TC));
-   end Adjust;
- 
-   procedure Finalize  ( TC: in out Test_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Fin;
-   end Finalize;
- 
-   procedure Initialize( TC: in out Nested_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Init;
-     C760002_0.Initialize(C760002_0.Root_Controlled(TC));
-   end Initialize;
- 
-   procedure Adjust    ( TC: in out Nested_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Adj;
-     C760002_0.Adjust(C760002_0.Root_Controlled(TC));
-   end Adjust;
- 
-   procedure Finalize  ( TC: in out Nested_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Fin;
-   end Finalize;
- 
-   procedure Initialize( TC: in out Test_Limited_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Init;
-     C760002_0.Initialize(C760002_0.Root_Limited_Controlled(TC));
-   end Initialize;
- 
-   procedure Adjust    ( TC: in out Test_Limited_Controlled ) is
-   begin
-     Report.Failed("Adjust called for Test_Limited_Controlled");
-   end Adjust;
- 
-   procedure Finalize  ( TC: in out Test_Limited_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Fin;
-   end Finalize;
- 
-   procedure Initialize( TC: in out Nested_Limited_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Init;
-     C760002_0.Initialize(C760002_0.Root_Limited_Controlled(TC));
-   end Initialize;
- 
-   procedure Adjust    ( TC: in out Nested_Limited_Controlled ) is
-   begin
-     Report.Failed("Adjust called for Nested_Limited_Controlled");
-   end Adjust;
- 
-   procedure Finalize  ( TC: in out Nested_Limited_Controlled ) is
-   begin
-     TC.Last_Proc_Called := Fin;
-   end Finalize;
- 
- end C760002_1;
- 
- ---------------------------------------------------------------- C760002
- 
- with Report;
- with TCTouch;
- with C760002_0;
- with C760002_1;
- with Ada.Finalization;
- procedure C760002 is
- 
-   use type C760002_1.Proc_ID;
- 
-   -- in the first test, test the simple cases.
-   -- Also check that assignment causes a call to Adjust for a controlled
-   -- object.  Check that assignment of a non-controlled object does not call
-   -- an Adjust procedure.
- 
-   procedure Check_Simple_Objects is
- 
-     A,B : C760002_0.Root;
-     S,T : C760002_1.Test_Controlled;
-     Q   : C760002_1.Test_Limited_Controlled;  -- Adjust call shouldn't happen
-   begin
- 
-     S := T;
- 
-     TCTouch.Assert((S.Last_Proc_Called = C760002_1.Adj),
-                    "Adjust for simple object");
-     TCTouch.Assert((S.My_ID = T.My_ID),
-                    "Assignment failed for simple object");
- 
-     -- Check that adjust was called
-     TCTouch.Assert((S.Visit_Tag = 'A'), "Adjust timing incorrect");
- 
-     -- Check that Adjust has not been called
-     TCTouch.Assert_Not((T.Visit_Tag = 'A'), "Adjust incorrectly called");
- 
-     -- Check that Adjust does not get called
-     A.My_ID := A.My_ID +1;
-     B := A;  -- see: Adjust: Report.Failed
- 
-   end Check_Simple_Objects;
- 
-   -- in the second test, test a more complex case, check that a controlled
-   -- component of a controlled object gets processed correctly
- 
-   procedure Check_Nested_Objects is
-     NO1 : C760002_1.Nested_Controlled;
-     NO2 : C760002_1.Nested_Controlled := NO1;
- 
-   begin
- 
-     -- NO2 should be flagged with adjust markers
-     TCTouch.Assert((NO2.Last_Proc_Called = C760002_1.Adj),
-                    "Adjust not called for NO2 enclosure declaration");
-     TCTouch.Assert((NO2.Nested.Visit_Tag = 'A'),
-                    "Adjust not called for NO2 enclosed declaration");
- 
-     NO2.Visit_Tag := 'x';
-     NO2.Nested.Visit_Tag := 'y';
- 
-     NO1 := NO2;
- 
-     -- NO1 should be flagged with adjust markers
-     TCTouch.Assert((NO1.Visit_Tag = 'A'),
-                    "Adjust not called for NO1 enclosure declaration");
-     TCTouch.Assert((NO1.Nested.Visit_Tag = 'A'),
-                    "Adjust not called for NO1 enclosed declaration");
- 
-   end Check_Nested_Objects;
- 
-   procedure Check_Array_Case is
-     type Array_Simple is array(1..4) of C760002_1.Test_Controlled;
-     type Array_Nested is array(1..4) of C760002_1.Nested_Controlled;
- 
-     Left,Right      : Array_Simple;
-     Overlap         : Array_Simple := Left;
- 
-     Sinister,Dexter : Array_Nested;
-     Underlap        : Array_Nested := Sinister;
- 
-     Now : Natural;
- 
-   begin
- 
-     -- get a current unique value since initializations
-     Now := C760002_0.Unique_Value;
- 
-     -- check results of declarations
-     for N in 1..4 loop
-       TCTouch.Assert(Left(N).My_Id < Now,
-                      "Initialize for array initial value");
-       TCTouch.Assert(Overlap(N).My_Id < Now,
-                      "Adjust for nested array (outer) initial value");
-       TCTouch.Assert(Sinister(N).Nested.My_Id < Now,
-                      "Initialize for nested array (inner) initial value");
-       TCTouch.Assert(Sinister(N).My_Id < Sinister(N).Nested.My_Id,
-                      "Initialize for enclosure should be after enclosed");
-       TCTouch.Assert(Overlap(N).Visit_Tag = 'A',"Adjust at declaration");
-       TCTouch.Assert(Underlap(N).Nested.Visit_Tag = 'A',
-                      "Adjust at declaration, nested object");
-     end loop;
- 
-     -- set visit tags
-     for O in 1..4 loop
-       Overlap(O).Visit_Tag         := 'X';
-       Underlap(O).Visit_Tag        := 'Y';
-       Underlap(O).Nested.Visit_Tag := 'y';
-     end loop;
- 
-     -- check that overlapping assignments don't cause odd grief
-     Overlap(1..3)  := Overlap(2..4);
-     Underlap(2..4) := Underlap(1..3);
- 
-     for M in 2..3 loop
-       TCTouch.Assert(Overlap(M).Last_Proc_Called = C760002_1.Adj,
-                      "Adjust for overlap");
-       TCTouch.Assert(Overlap(M).Visit_Tag = 'A',
-                      "Adjust for overlap ID");
-       TCTouch.Assert(Underlap(M).Last_Proc_Called = C760002_1.Adj,
-                      "Adjust for Underlap");
-       TCTouch.Assert(Underlap(M).Nested.Visit_Tag = 'A',
-                      "Adjust for Underlaps nested ID");
-     end loop;
- 
-   end Check_Array_Case;
- 
-   procedure Check_Access_Case is
-     type TC_Ref is access C760002_1.Test_Controlled;
-     type NC_Ref is access C760002_1.Nested_Controlled;
-     type TL_Ref is access C760002_1.Test_Limited_Controlled;
-     type NL_Ref is access C760002_1.Nested_Limited_Controlled;
- 
-     A,B : TC_Ref;
-     C,D : NC_Ref;
-     E   : TL_Ref;
-     F   : NL_Ref;
- 
-   begin
- 
-     A := new C760002_1.Test_Controlled;
-     B := new C760002_1.Test_Controlled'( A.all );
- 
-     C := new C760002_1.Nested_Controlled;
-     D := new C760002_1.Nested_Controlled'( C.all );
- 
-     E := new C760002_1.Test_Limited_Controlled;
-     F := new C760002_1.Nested_Limited_Controlled;
- 
-     TCTouch.Assert(A.Visit_Tag = 'I',"TC Allocation");
-     TCTouch.Assert(B.Visit_Tag = 'A',"TC Allocation, with value");
- 
-     TCTouch.Assert(C.Visit_Tag = 'I',"NC Allocation");
-     TCTouch.Assert(C.Nested.Visit_Tag = 'I',"NC Allocation, Nested");
-     TCTouch.Assert(D.Visit_Tag = 'A',"NC Allocation, with value");
-     TCTouch.Assert(D.Nested.Visit_Tag = 'A',
-                    "NC Allocation, Nested, with value");
- 
-     TCTouch.Assert(E.Visit_Tag = 'i',"TL Allocation");
-     TCTouch.Assert(F.Visit_Tag = 'i',"NL Allocation");
- 
-     A.all := B.all;
-     C.all := D.all;
- 
-     TCTouch.Assert(A.Visit_Tag = 'A',"TC Assignment");
-     TCTouch.Assert(C.Visit_Tag = 'A',"NC Assignment");
-     TCTouch.Assert(C.Nested.Visit_Tag = 'A',"NC Assignment, Nested");
- 
-   end Check_Access_Case;
- 
-   procedure Check_Access_Limited_Array_Case is
-     type Array_Simple is array(1..4) of C760002_1.Test_Limited_Controlled;
-     type AS_Ref is access Array_Simple;
-     type Array_Nested is array(1..4) of C760002_1.Nested_Limited_Controlled;
-     type AN_Ref is access Array_Nested;
- 
-     Simple_Array_Limited : AS_Ref;
- 
-     Nested_Array_Limited : AN_Ref;
- 
-   begin
- 
-     Simple_Array_Limited := new Array_Simple;
- 
-     Nested_Array_Limited := new Array_Nested;
-     
-     for N in 1..4 loop
-       TCTouch.Assert(Simple_Array_Limited(N).Last_Proc_Called
-                      = C760002_1.Init,  
-                      "Initialize for array initial value");
-       TCTouch.Assert(Nested_Array_Limited(N).Last_Proc_Called
-                      = C760002_1.Init,
-                      "Initialize for nested array (outer) initial value");
-       TCTouch.Assert(Nested_Array_Limited(N).Nested.Visit_Tag = 'i',
-                      "Initialize for nested array (inner) initial value");
-     end loop;
-   end Check_Access_Limited_Array_Case;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C760002", "Check that assignment causes the Adjust " &
-                           "operation of the type to be called.  Check " &
-                           "that Adjust is called after copying the " &
-                           "value of the source expression to the target " &
-                           "object.  Check that Adjust is called for all " &
-                           "controlled components when the containing " &
-                           "object is assigned.  Check that Adjust is " &
-                           "called for components before the containing " &
-                           "object is adjusted.  Check that Adjust is not " &
-                           "called for a Limited_Controlled type by the " &
-                           "implementation" );
- 
-   Check_Simple_Objects;
- 
-   Check_Nested_Objects;
- 
-   Check_Array_Case;
- 
-   Check_Access_Case;
- 
-   Check_Access_Limited_Array_Case;
- 
-   Report.Result;
- 
- end C760002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,247 ****
- -- C760007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Adjust is called for the execution of a return
- --      statement for a function returning a result of a (non-limited)
- --      controlled type.
- --
- --      Check that Adjust is called when evaluating an aggregate
- --      component association for a controlled component.
- --
- --      Check that Adjust is called for the assignment of the ancestor
- --      expression of an extension aggregate when the type of the
- --      aggregate is controlled.
- --
- -- TEST DESCRIPTION:
- --      A type is derived from Ada.Finalization.Controlled; the dispatching
- --      procedure Adjust is defined for the new type.  Structures and
- --      subprograms to model the test objectives are used to check that
- --      Adjust is called at the right time.  For the sake of simplicity,
- --      globally accessible data is used to check that the calls are made.
- --
- --
- -- CHANGE HISTORY:
- --      06 DEC 94   SAIC    ACVC 2.0
- --      14 OCT 95   SAIC    Update and repair for ACVC 2.0.1
- --      05 APR 96   SAIC    Add RM reference
- --      06 NOV 96   SAIC    Reduce adjust requirement
- --      25 NOV 97   EDS     Allowed zero calls to adjust at line 144
- --!
- 
- ---------------------------------------------------------------- C760007_0
- 
- with Ada.Finalization;
- package C760007_0 is
- 
-   type Controlled is new Ada.Finalization.Controlled with record
-     TC_ID : Natural := Natural'Last;
-   end record;
-   procedure Adjust( Object: in out Controlled );
- 
-   type Structure is record
-     Controlled_Component : Controlled;
-   end record;
- 
-   type Child is new Controlled with record
-     TC_XX : Natural := Natural'Last;
-   end record;
-   procedure Adjust( Object: in out Child );
- 
-   Adjust_Count       : Natural := 0;
-   Child_Adjust_Count : Natural := 0;
- 
- end C760007_0;
-  
- package body C760007_0 is
- 
-   procedure Adjust( Object: in out Controlled ) is
-   begin
-     Adjust_Count := Adjust_Count +1;
-   end Adjust;
- 
-   procedure Adjust( Object: in out Child ) is
-   begin
-     Child_Adjust_Count := Child_Adjust_Count +1;
-   end Adjust;
- 
- end C760007_0;
- 
- ------------------------------------------------------------------ C760007
- 
- with Report;
- with C760007_0;
- procedure C760007 is
- 
-   procedure Check_Adjust_Count(Message: String;
-                                Min: Natural := 1;
-                                Max: Natural := 2) is
-   begin
- 
-      -- in order to allow for the anonymous objects referred to in
-      -- the reference manual, the check for calls to Adjust must be
-      -- in a range.  This number must then be further adjusted
-      -- to allow for the optimization that does not call for an adjust
-      -- of an aggregate initial value built directly in the object
- 
-      if C760007_0.Adjust_Count not in Min..Max then
-        Report.Failed(Message
-                    & " = " & Natural'Image(C760007_0.Adjust_Count));
-      end if;
-      C760007_0.Adjust_Count := 0;
-   end Check_Adjust_Count;
- 
-   procedure Check_Child_Adjust_Count(Message: String;
-                                      Min: Natural := 1;
-                                      Max: Natural := 2) is
-   begin
-      -- ditto above
- 
-      if C760007_0.Child_Adjust_Count not in Min..Max then
-        Report.Failed(Message
-                    & " = " & Natural'Image(C760007_0.Child_Adjust_Count));
-      end if;
-      C760007_0.Child_Adjust_Count := 0;
-   end Check_Child_Adjust_Count;
- 
-   Object : C760007_0.Controlled;
- 
- --      Check that Adjust is called for the execution of a return
- --      statement for a function returning a result of a (non-limited)
- --      controlled type or a result of a noncontrolled type with
- --      controlled components.
- 
-   procedure Subtest_1 is
-     function Create return C760007_0.Controlled is
-       New_Object : C760007_0.Controlled;
-     begin
-       return New_Object;
-     end Create;
- 
-     procedure Examine( Thing : in C760007_0.Controlled ) is
-     begin
-       Check_Adjust_Count("Function call passed as parameter",0);
-     end Examine;
- 
-   begin
-     -- this assignment must call Adjust:
-     --   1: on the value resulting from the function
-     --      ** unless this is optimized out by building the result directly
-     --         in the target object.
-     --   2: on Object once it's been assigned
-     -- may call adjust
-     --   1: for a anonymous object created in the evaluation of the function
-     --   2: for a anonymous object created in the assignment operation
- 
-     Object := Create;
- 
-     Check_Adjust_Count("Function call",1,4);
- 
-     Examine( Create );
- 
-   end Subtest_1;
- 
- --      Check that Adjust is called when evaluating an aggregate
- --      component association for a controlled component.
- 
-   procedure Subtest_2 is
-     S : C760007_0.Structure;
- 
-     procedure Examine( Thing : in C760007_0.Structure ) is
-     begin
-       Check_Adjust_Count("Aggregate passed as parameter");
-     end Examine;
- 
-   begin
-     -- this assignment must call Adjust:
-     --   1: on the value resulting from the aggregate
-     --      ** unless this is optimized out by building the result directly
-     --         in the target object.
-     --   2: on Object once it's been assigned
-     -- may call adjust
-     --   1: for a anonymous object created in the evaluation of the aggregate
-     --   2: for a anonymous object created in the assignment operation
-     S := ( Controlled_Component => Object );
-     Check_Adjust_Count("Aggregate and Assignment", 1, 4);
- 
-     Examine( C760007_0.Structure'(Controlled_Component => Object) );
-   end Subtest_2;
- 
- --      Check that Adjust is called for the assignment of the ancestor
- --      expression of an extension aggregate when the type of the
- --      aggregate is controlled.
- 
-   procedure Subtest_3 is
-     Bambino : C760007_0.Child;
- 
-     procedure Examine( Thing : in C760007_0.Child ) is
-     begin
-       Check_Adjust_Count("Extension aggregate as parameter (ancestor)", 0, 2);
-       Check_Child_Adjust_Count("Extension aggregate as parameter", 0, 4);
-     end Examine;
- 
-   begin
-     -- implementation permissions make all of the following calls to adjust
-     -- optional:
-     -- these assignments may call Adjust:
-     --   1: on the value resulting from the aggregate
-     --   2: on Object once it's been assigned
-     --   3: for a anonymous object created in the evaluation of the aggregate
-     --   4: for a anonymous object created in the assignment operation
-     Bambino := ( Object with TC_XX => 10 );
-     Check_Adjust_Count("Ancestor (expression) part of aggregate", 0, 2);
-     Check_Child_Adjust_Count("Child aggregate assignment 1", 0, 4 );
- 
-     Bambino := ( C760007_0.Controlled with TC_XX => 11 );
-     Check_Adjust_Count("Ancestor (subtype_mark) part of aggregate", 0, 2);
-     Check_Child_Adjust_Count("Child aggregate assignment 2", 0, 4 );
- 
-     Examine( ( Object with TC_XX => 21 ) );
- 
-     Examine( ( C760007_0.Controlled with TC_XX => 37 ) );
- 
-   end Subtest_3;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C760007", "Check that Adjust is called for the " &
-                           "execution of a return statement for a " &
-                           "function returning a result containing a " &
-                           "controlled type.  Check that Adjust is " &
-                           "called when evaluating an aggregate " &
-                           "component association for a controlled " &
-                           "component.  " &
-                           "Check that Adjust is called for the " &
-                           "assignment of the ancestor expression of an " &
-                           "extension aggregate when the type of the " &
-                           "aggregate is controlled" );
- 
-   Subtest_1;
-   Subtest_2;
-   Subtest_3;
- 
-   Report.Result;
- 
- end C760007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,533 ****
- -- C760009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that for an extension_aggregate whose ancestor_part is a
- --      subtype_mark (i.e. Typemark'( Subtype with Field => x, etc.) )
- --      Initialize is called on all controlled subcomponents of the
- --      ancestor part; if the type of the ancestor part is itself controlled,
- --      the Initialize procedure of the ancestor type is called, unless that
- --      Initialize procedure is abstract.
- --
- --      Check that the utilization of a controlled type for a generic actual
- --      parameter supports the correct behavior in the instantiated package.
- --
- -- TEST DESCRIPTION:
- --      Declares a generic package instantiated to check that controlled
- --      types are not impacted by the "generic boundary."
- --      This instance is then used to perform the tests of various
- --      aggregate formations of the controlled type.  After each operation
- --      in the main program that should cause implicit calls, the "state" of
- --      the software is checked.  The "state" of the software is maintained in
- --      several variables which count the calls to the Initialize, Adjust and
- --      Finalize procedures in each context.  Given the nature of the
- --      language rules, the test specifies a minimum number of times that
- --      these subprograms should have been called.  The test also checks cases
- --      where the subprograms should not have been called.
- --     
- --      As per the example in AARM 7.6(11a..d);6.0, the distinctions between
- --      the presence/absence of default values is tested.
- --
- -- DATA STRUCTURES
- --
- --      C760009_3.Master_Control is derived from
- --        C760009_2.Control is derived from
- --          Ada.Finalization.Controlled
- --
- --      C760009_1.Simple_Control is derived from
- --        Ada.Finalization.Controlled
- --
- --      C760009_3.Master_Control contains
- --        Standard.Integer
- --
- --      C760009_2.Control contains
- --        C760009_1.Simple_Control (default value)
- --        C760009_1.Simple_Control (default initialized)
- --
- --
- -- CHANGE HISTORY:
- --      01 MAY 95   SAIC    Initial version
- --      19 FEB 96   SAIC    Fixed elaboration Initialize count
- --      14 NOV 96   SAIC    Allowed for 7.6(21) optimizations
- --      13 FEB 97   PWB.CTA Initialized counters at lines 127-129
- --      26 JUN 98   EDS     Added pragma Elaborate_Body to C760009_0
- --                          to avoid possible instantiation error
- --!
- 
- ---------------------------------------------------------------- C760009_0
- 
- with Ada.Finalization;
- generic
- 
-   type Private_Formal is private;
- 
-   with procedure TC_Validate( APF: in out Private_Formal );
- 
- package C760009_0 is -- Check_1
- 
-   pragma Elaborate_Body;
-   procedure TC_Check_1( APF: in     Private_Formal );
-   procedure TC_Check_2( APF:    out Private_Formal );
-   procedure TC_Check_3( APF: in out Private_Formal );
- 
- end C760009_0;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C760009_0 is -- Check_1
- 
-     procedure TC_Check_1( APF: in     Private_Formal ) is
-       Local : Private_Formal;
-     begin
-       Local := APF;
-       TC_Validate( Local );
-     end TC_Check_1;
- 
-     procedure TC_Check_2( APF:    out Private_Formal ) is
-       Local : Private_Formal;  -- initialized by virtue of actual being
-                                -- Controlled
-     begin
-       APF := Local;
-       TC_Validate( APF );
-     end TC_Check_2;
- 
-     procedure TC_Check_3( APF: in out Private_Formal ) is
-       Local : Private_Formal;
-     begin
-       Local := APF;
-       TC_Validate( Local );
-     end TC_Check_3;
- 
- end C760009_0;
-  
- ---------------------------------------------------------------- C760009_1
- 
- with Ada.Finalization;
- package C760009_1 is
- 
-   Initialize_Called : Natural := 0;
-   Adjust_Called     : Natural := 0;
-   Finalize_Called   : Natural := 0;
- 
-   procedure Reset_Counters;
- 
-   type Simple_Control is new Ada.Finalization.Controlled with private;
- 
-   procedure Initialize( AV: in out Simple_Control );
-   procedure Adjust    ( AV: in out Simple_Control );
-   procedure Finalize  ( AV: in out Simple_Control );
-   procedure Validate  ( AV: in out Simple_Control );
- 
-   function Item( AV: Simple_Control'Class ) return String;
- 
-   Empty : constant Simple_Control;
- 
-   procedure TC_Trace( Message: String );
- 
- private
-   type Simple_Control is new Ada.Finalization.Controlled with record
-     Item: Natural;
-   end record;
- 
-   Empty : constant Simple_Control := ( Ada.Finalization.Controlled with 0 );
- 
- end C760009_1;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C760009_1 is
- 
-   -- Maintenance_Mode and TC_Trace are for the test writers and compiler
-   -- developers to get more information from this test as it executes.
-   -- Maintenance_Mode is always False for validation purposes.
- 
-   Maintenance_Mode : constant Boolean := False;
- 
-   procedure TC_Trace( Message: String ) is
-   begin
-     if Maintenance_Mode then
-       Report.Comment( Message );
-     end if;
-   end TC_Trace;
- 
-   procedure Reset_Counters is
-   begin
-     Initialize_Called := 0;
-     Adjust_Called     := 0;
-     Finalize_Called   := 0;
-   end Reset_Counters;
- 
-   Master_Count : Natural := 100;  -- Help distinguish values
- 
-   procedure Initialize( AV: in out Simple_Control ) is
-   begin
-     Initialize_Called := Initialize_Called +1;
-     AV.Item := Master_Count;
-     Master_Count := Master_Count +100;
-     TC_Trace( "Initialize _1.Simple_Control" );
-   end Initialize;
- 
-   procedure Adjust    ( AV: in out Simple_Control ) is
-   begin
-     Adjust_Called := Adjust_Called +1;
-     AV.Item := AV.Item +1;
-     TC_Trace( "Adjust _1.Simple_Control" );
-   end Adjust;
- 
-   procedure Finalize  ( AV: in out Simple_Control ) is
-   begin
-     Finalize_Called := Finalize_Called +1;
-     AV.Item := AV.Item +1;
-     TC_Trace( "Finalize _1.Simple_Control" );
-   end Finalize;
- 
-   procedure Validate  ( AV: in out Simple_Control ) is
-   begin
-     Report.Failed("Attempt to Validate at Simple_Control level");
-   end Validate;
- 
-   function Item( AV: Simple_Control'Class ) return String is
-   begin
-     return Natural'Image(AV.Item);
-   end Item;
- 
- end C760009_1;
-  
- ---------------------------------------------------------------- C760009_2
- 
- with C760009_1;
- with Ada.Finalization;
- package C760009_2 is
- 
-   type Control is new Ada.Finalization.Controlled with record
-     Element_1 : C760009_1.Simple_Control;
-     Element_2 : C760009_1.Simple_Control := C760009_1.Empty;
-   end record;
- 
-   procedure Initialize( AV: in out Control );
-   procedure Finalize  ( AV: in out Control );
- 
-   Initialized : Natural := 0;
-   Finalized   : Natural := 0;
- 
- end C760009_2;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C760009_2 is
- 
-   procedure Initialize( AV: in out Control ) is
-   begin
-     Initialized := Initialized +1;
-     C760009_1.TC_Trace( "Initialize _2.Control" );
-   end Initialize;
- 
-   procedure Finalize  ( AV: in out Control ) is
-   begin
-     Finalized := Finalized +1;
-     C760009_1.TC_Trace( "Finalize _2.Control" );
-   end Finalize;
- 
- end C760009_2;
-  
- ---------------------------------------------------------------- C760009_3
- 
- with C760009_0;
- with C760009_2;
- package C760009_3 is
- 
-   type Master_Control is new C760009_2.Control with record
-     Data: Integer;
-   end record;
- 
-   procedure Initialize( AC: in out Master_Control );
-   -- calls C760009_2.Initialize
-   -- embedded data causes 1 call to C760009_1.Initialize
- 
-   -- Adjusting operation will
-   -- make 1 call to C760009_2.Adjust 
-   -- make 2 call to C760009_1.Adjust 
- 
-   -- Finalize operation will
-   -- make 1 call to C760009_2.Finalize 
-   -- make 2 call to C760009_1.Finalize 
- 
-   procedure Validate( AC: in out Master_Control );
- 
-   package Check_1 is
-     new C760009_0(Master_Control, Validate);
- 
- end C760009_3;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with C760009_1;
- package body C760009_3 is
- 
-   procedure Initialize( AC: in out Master_Control ) is
-   begin
-     AC.Data := 42;
-     C760009_2.Initialize(C760009_2.Control(AC));
-     C760009_1.TC_Trace( "Initialize Master_Control" );
-   end Initialize;
- 
-   procedure Validate( AC: in out Master_Control ) is
-   begin
-     if AC.Data not in 0..1000 then
-       Report.Failed("C760009_3.Control did not Initialize" );
-     end if;
-   end Validate;
- 
- end C760009_3;
-  
- --------------------------------------------------------------------- C760009
- 
- with Report;
- with C760009_1;
- with C760009_2;
- with C760009_3;
- procedure C760009 is
- 
-   -- Comment following declaration indicates expected calls in the order:
-   -- Initialize of a C760009_2 value
-   -- Finalize   of a C760009_2 value
-   -- Initialize of a C760009_1 value
-   -- Adjust     of a C760009_1 value
-   -- Finalize   of a C760009_1 value
- 
-   Global_Control : C760009_3.Master_Control;
-   -- 1, 0, 1, 1, 0
- 
-   Parent_Control : C760009_2.Control;
-   -- 1, 0, 1, 1, 0
- 
-   -- Global_Control is a derived tagged type, the parent type
-   --   of Master_Control, Control, is derived from Controlled, and contains
-   --   two components of a Controlled type, Simple_Control.  One of these
-   --   components has a default value, the other does not.
- 
-   procedure Fail( Which: String; Expect, Got: Natural ) is
-   begin
-     Report.Failed(Which & " Expected" & Natural'Image(Expect)
-                         & " got" & Natural'Image(Got) );
-   end Fail;
- 
-   procedure Master_Assertion( Layer_2_Inits   : Natural;
-                               Layer_2_Finals  : Natural;
-                               Layer_1_Inits   : Natural;
-                               Layer_1_Adjs    : Natural;
-                               Layer_1_Finals  : Natural;
-                               Failing_Message : String ) is
- 
-   begin
- 
- 
- 
-    if C760009_2.Initialized /= Layer_2_Inits then
-      Fail("C760009_2.Initialize " & Failing_Message,
-           Layer_2_Inits, C760009_2.Initialized );
-    end if;
- 
-    if C760009_2.Finalized not in Layer_2_Finals..Layer_2_Finals*2 then
-      Fail("C760009_2.Finalize " & Failing_Message,
-            Layer_2_Finals, C760009_2.Finalized );
-    end if;
- 
-    if C760009_1.Initialize_Called /= Layer_1_Inits then
-      Fail("C760009_1.Initialize " & Failing_Message,
-            Layer_1_Inits,
-           C760009_1.Initialize_Called );
-    end if;
- 
-    if C760009_1.Adjust_Called not in Layer_1_Adjs..Layer_1_Adjs*2 then
-      Fail("C760009_1.Adjust " & Failing_Message,
-            Layer_1_Adjs, C760009_1.Adjust_Called );
-    end if;
- 
-    if C760009_1.Finalize_Called not in Layer_1_Finals..Layer_1_Finals*2 then
-      Fail("C760009_1.Finalize " & Failing_Message,
-            Layer_1_Finals, C760009_1.Finalize_Called );
-    end if;
- 
-    C760009_1.Reset_Counters;
-    C760009_2.Initialized := 0;
-    C760009_2.Finalized   := 0;
- 
-   end Master_Assertion;
- 
-   procedure Lesser_Assertion( Layer_2_Inits   : Natural;
-                               Layer_2_Finals  : Natural;
-                               Layer_1_Inits   : Natural;
-                               Layer_1_Adjs    : Natural;
-                               Layer_1_Finals  : Natural;
-                               Failing_Message : String ) is
-   begin
- 
- 
-    if C760009_2.Initialized > Layer_2_Inits then
-      Fail("C760009_2.Initialize " & Failing_Message,
-            Layer_2_Inits, C760009_2.Initialized );
-    end if;
- 
-    if C760009_2.Finalized < Layer_2_Inits 
-       or C760009_2.Finalized > Layer_2_Finals*2 then
-      Fail("C760009_2.Finalize " & Failing_Message,
-            Layer_2_Finals, C760009_2.Finalized );
-    end if;
- 
-    if C760009_1.Initialize_Called > Layer_1_Inits then
-      Fail("C760009_1.Initialize " & Failing_Message,
-            Layer_1_Inits,
-           C760009_1.Initialize_Called );
-    end if;
- 
-    if C760009_1.Adjust_Called > Layer_1_Adjs*2 then
-      Fail("C760009_1.Adjust " & Failing_Message,
-            Layer_1_Adjs, C760009_1.Adjust_Called );
-    end if;
- 
-    if C760009_1.Finalize_Called < Layer_1_Inits
-       or C760009_1.Finalize_Called > Layer_1_Finals*2 then
-      Fail("C760009_1.Finalize " & Failing_Message,
-            Layer_1_Finals, C760009_1.Finalize_Called );
-    end if;
- 
-    C760009_1.Reset_Counters;
-    C760009_2.Initialized := 0;
-    C760009_2.Finalized   := 0;
- 
-   end Lesser_Assertion;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C760009", "Check that for an extension_aggregate whose " &
-                           "ancestor_part is a subtype_mark, Initialize " &
-                           "is called on all controlled subcomponents of " &
-                           "the ancestor part.  Also check that the " &
-                           "utilization of a controlled type for a generic " &
-                           "actual parameter supports the correct behavior " &
-                           "in the instantiated software" );
- 
-   C760009_1.TC_Trace( "=====> Case 0 <=====" );
- 
-   C760009_1.Reset_Counters;
-   C760009_2.Initialized := 0;
-   C760009_2.Finalized   := 0;
- 
-   C760009_3.Validate( Global_Control ); -- check that it Initialized correctly
- 
-   C760009_1.TC_Trace( "=====> Case 1 <=====" );
- 
-   C760009_3.Check_1.TC_Check_1( ( C760009_2.Control with Data => 1 ) );
-   Lesser_Assertion( 2, 3, 2, 3, 6, "Check_1.TC_Check_1" );
-   --                |  |  |  |  + Finalize 2 embedded in aggregate
-   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_1
-   --                |  |  |  |  + Finalize 2 embedded in local variable
-   --                |  |  |  + Adjust 2 caused by assignment in TC_Check_1
-   --                |  |  |  + Adjust at declaration in TC_Check_1
-   --                |  |  + Initialize at declaration in TC_Check_1
-   --                |  |  + Initialize of aggregate object
-   --                |  + Finalize of assignment target
-   --                |  + Finalize of local variable
-   --                |  + Finalize of aggregate object
-   --               + Initialize of aggregate object
-   --               + Initialize of local variable
- 
- 
-   C760009_1.TC_Trace( "=====> Case 2 <=====" );
- 
-   C760009_3.Check_1.TC_Check_2( Global_Control );
-   Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_2" );
-   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_2
-   --                |  |  |  |  + Finalize 2 embedded in local variable
-   --                |  |  |  + Adjust 2 caused by assignment in TC_Check_2
-   --                |  |  |  + Adjust at declaration in TC_Check_2
-   --                |  |  + Initialize at declaration in TC_Check_2
-   --                |  + Finalize of assignment target
-   --                |  + Finalize of local variable
-   --               + Initialize of local variable
- 
- 
-   C760009_1.TC_Trace( "=====> Case 3 <=====" );
- 
-   Global_Control := ( C760009_2.Control with Data => 2 );
-   Lesser_Assertion( 1, 1, 1, 3, 2, "Aggregate -> object" );
-   --                |  |  |  |  + Finalize 2 by assignment
-   --                |  |  |  + Adjust 2 caused by assignment
-   --                |  |  |  + Adjust in aggregate creation
-   --                |  |  + Initialize of aggregate object
-   --                |  + Finalize of assignment target
-   --               + Initialize of aggregate object
- 
- 
-   C760009_1.TC_Trace( "=====> Case 4 <=====" );
- 
-   C760009_3.Check_1.TC_Check_3( Global_Control );
-   Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_3" );
-   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_3
-   --                |  |  |  |  + Finalize 2 embedded in local variable
-   --                |  |  |  + Adjust 2 at assignment in TC_Check_3
-   --                |  |  |  + Adjust in local variable creation
-   --                |  |  + Initialize of local variable in TC_Check_3
-   --                |  + Finalize of assignment target
-   --                |  + Finalize of local variable
-   --               + Initialize of local variable
- 
- 
-   C760009_1.TC_Trace( "=====> Case 5 <=====" );
- 
-   Global_Control := ( Parent_Control with Data => 3 );
-   Lesser_Assertion( 1, 1, 1, 3, 2, "Object Aggregate -> object" );
-   --                |  |  |  |  + Finalize 2 by assignment
-   --                |  |  |  + Adjust 2 caused by assignment
-   --                |  |  |  + Adjust in aggregate creation
-   --                |  |  + Initialize of aggregate object
-   --                |  + Finalize of assignment target
-   --               + Initialize of aggregate object
- 
- 
- 
-   C760009_1.TC_Trace( "=====> Case 6 <=====" );
- 
-   -- perform this check a second time to make sure nothing is "remembered"
- 
-   C760009_3.Check_1.TC_Check_3( Global_Control );
-   Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_3 second time" );
-   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_3
-   --                |  |  |  |  + Finalize 2 embedded in local variable
-   --                |  |  |  + Adjust 2 at assignment in TC_Check_3
-   --                |  |  |  + Adjust in local variable creation
-   --                |  |  + Initialize of local variable in TC_Check_3
-   --                |  + Finalize of assignment target
-   --                |  + Finalize of local variable
-   --               + Initialize of local variable
- 
- 
-   Report.Result;
- 
- end C760009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,418 ****
- -- C760010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that explicit calls to Initialize, Adjust and Finalize
- --      procedures that raise exceptions propagate the exception raised,
- --      not Program_Error.  Check this for both a user defined exception
- --      and a language defined exception.  Check that implicit calls to
- --      initialize procedures that raise an exception propagate the
- --      exception raised, not Program_Error;
- --
- --      Check that the utilization of a controlled type as the actual for
- --      a generic formal tagged private parameter supports the correct
- --      behavior in the instantiated software.
- --
- -- TEST DESCRIPTION:
- --      Declares a generic package instantiated to check that controlled
- --      types are not impacted by the "generic boundary."
- --      This instance is then used to perform the tests of various calls to
- --      the procedures.  After each operation in the main program that should
- --      cause implicit calls where an exception is raised, the program handles
- --      Program_Error.  After each explicit call, the program handles the
- --      Expected_Error.  Handlers for the opposite exception are provided to
- --      catch the obvious failure modes.  The predefined exception
- --      Tasking_Error is used to be certain that some other reason has not
- --      raised a predefined exception.
- --
- --     
- -- DATA STRUCTURES
- --
- --      C760010_1.Simple_Control is derived from
- --        Ada.Finalization.Controlled
- --
- --      C760010_2.Embedded_Derived is derived from C760010_1.Simple_Control
- --        by way of generic instantiation
- --
- --
- -- CHANGE HISTORY:
- --      01 MAY 95   SAIC    Initial version
- --      23 APR 96   SAIC    Fix visibility problem for 2.1
- --      14 NOV 96   SAIC    Revisit for 2.1 release
- --      26 JUN 98   EDS     Added pragma Elaborate_Body to
- --                          package C760010_0.Check_Formal_Tagged
- --                          to avoid possible instantiation error
- --!
- 
- ---------------------------------------------------------------- C760010_0
- 
- package C760010_0 is
- 
-   User_Defined_Exception : exception;
- 
-   type Actions is ( No_Action,
-                     Init_Raise_User_Defined, Init_Raise_Standard,
-                     Adj_Raise_User_Defined,  Adj_Raise_Standard,
-                     Fin_Raise_User_Defined,  Fin_Raise_Standard );
- 
-   Action : Actions := No_Action;
- 
-   function Unique return Natural;
- 
- end C760010_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C760010_0 is
- 
-   Value : Natural := 101;
- 
-   function Unique return Natural is
-   begin
-     Value := Value +1;
-     return Value;
-   end Unique;
- 
- end C760010_0;
- 
- ---------------------------------------------------------------- C760010_0
- ------------------------------------------------------ Check_Formal_Tagged
- 
- generic
- 
-   type Formal_Tagged is tagged private;
- 
- package C760010_0.Check_Formal_Tagged is
- 
-   pragma Elaborate_Body;
- 
-   type Embedded_Derived is new Formal_Tagged with record
-     TC_Meaningless_Value : Natural := Unique;
-   end record;
- 
-   procedure Initialize( ED: in out Embedded_Derived );
-   procedure Adjust    ( ED: in out Embedded_Derived );
-   procedure Finalize  ( ED: in out Embedded_Derived );
- 
- end C760010_0.Check_Formal_Tagged;
- 
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C760010_0.Check_Formal_Tagged is
- 
- 
-   procedure Initialize( ED: in out Embedded_Derived ) is
-   begin
-     ED.TC_Meaningless_Value := Unique;
-     case Action is
-       when Init_Raise_User_Defined => raise User_Defined_Exception;
-       when Init_Raise_Standard     => raise Tasking_Error;
-       when others                  => null;
-     end case;
-   end Initialize;
- 
-   procedure Adjust    ( ED: in out Embedded_Derived ) is
-   begin
-     ED.TC_Meaningless_Value := Unique;
-     case Action is
-       when Adj_Raise_User_Defined => raise User_Defined_Exception;
-       when Adj_Raise_Standard     => raise Tasking_Error;
-       when others                 => null;
-     end case;
-   end Adjust;
- 
-   procedure Finalize  ( ED: in out Embedded_Derived ) is
-   begin
-     ED.TC_Meaningless_Value := Unique;
-     case Action is
-       when Fin_Raise_User_Defined => raise User_Defined_Exception;
-       when Fin_Raise_Standard     => raise Tasking_Error;
-       when others                 => null;
-     end case;
-   end Finalize;
- 
- end C760010_0.Check_Formal_Tagged;
-  
- ---------------------------------------------------------------- C760010_1
- 
- with Ada.Finalization;
- package C760010_1 is
- 
-   procedure Check_Counters(Init,Adj,Fin : Natural; Message: String);
-   procedure Reset_Counters;
- 
-   type Simple_Control is new Ada.Finalization.Controlled with record
-     Item: Integer;
-   end record;
-   procedure Initialize( AV: in out Simple_Control );
-   procedure Adjust    ( AV: in out Simple_Control );
-   procedure Finalize  ( AV: in out Simple_Control );
- 
- end C760010_1;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C760010_1 is
- 
-   Initialize_Called : Natural;
-   Adjust_Called     : Natural;
-   Finalize_Called   : Natural;
- 
-   procedure Check_Counters(Init,Adj,Fin : Natural; Message: String) is
-   begin
-     if Init /= Initialize_Called then
-       Report.Failed("Initialize mismatch " & Message);
-     end if;
-     if Adj /= Adjust_Called then
-       Report.Failed("Adjust mismatch " & Message);
-     end if;
-     if Fin /= Finalize_Called then
-       Report.Failed("Finalize mismatch " & Message);
-     end if;
-   end Check_Counters;
- 
-   procedure Reset_Counters is
-   begin
-     Initialize_Called := 0;
-     Adjust_Called     := 0;
-     Finalize_Called   := 0;
-   end Reset_Counters;
- 
-   procedure Initialize( AV: in out Simple_Control ) is
-   begin
-     Initialize_Called := Initialize_Called +1;
-     AV.Item := 0;
-   end Initialize;
- 
-   procedure Adjust    ( AV: in out Simple_Control ) is
-   begin
-     Adjust_Called := Adjust_Called +1;
-     AV.Item := AV.Item +1;
-   end Adjust;
- 
-   procedure Finalize  ( AV: in out Simple_Control ) is
-   begin
-     Finalize_Called := Finalize_Called +1;
-     AV.Item := AV.Item +1;
-   end Finalize;
- 
- end C760010_1;
-  
- ---------------------------------------------------------------- C760010_2
- 
- with C760010_0.Check_Formal_Tagged;
- with C760010_1;
- package C760010_2 is
-   new C760010_0.Check_Formal_Tagged(C760010_1.Simple_Control);
-  
- ---------------------------------------------------------------------------
- 
- with Report;
- with C760010_0;
- with C760010_1;
- with C760010_2;
- procedure C760010 is
- 
-   use type C760010_0.Actions;
- 
-   procedure Case_Failure(Message: String) is
-   begin
-     Report.Failed(Message & " for case "
-                   & C760010_0.Actions'Image(C760010_0.Action) );
-   end Case_Failure;
- 
-   procedure Check_Implicit_Initialize is
-     Item   : C760010_2.Embedded_Derived;  -- exception here propagates to
-     Gadget : C760010_2.Embedded_Derived;  -- caller
-   begin
-     if C760010_0.Action
-        in C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard
-     then
-       Case_Failure("Anticipated exception at implicit init");
-     end if;
-     begin
-       Item := Gadget;                     -- exception here handled locally
-       if C760010_0.Action in C760010_0.Adj_Raise_User_Defined
-                                    .. C760010_0.Fin_Raise_Standard then
-         Case_Failure ("Anticipated exception at assignment");
-       end if;
-     exception
-       when Program_Error =>
-         if C760010_0.Action not in C760010_0.Adj_Raise_User_Defined
-                                    .. C760010_0.Fin_Raise_Standard then
-           Report.Failed("Program_Error in Check_Implicit_Initialize");
-         end if;
-       when Tasking_Error =>
-         Report.Failed("Tasking_Error in Check_Implicit_Initialize");
-       when C760010_0.User_Defined_Exception =>
-         Report.Failed("User_Error in Check_Implicit_Initialize");
-       when others =>
-         Report.Failed("Wrong exception Check_Implicit_Initialize");
-     end;
-   end Check_Implicit_Initialize;
- 
- ---------------------------------------------------------------------------
- 
-   Global_Item : C760010_2.Embedded_Derived;
- 
- ---------------------------------------------------------------------------
- 
-   procedure Check_Explicit_Initialize is
-   begin
-     begin
-       C760010_2.Initialize( Global_Item );
-     if C760010_0.Action
-        in C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard
-     then
-       Case_Failure("Anticipated exception at explicit init");
-     end if;
-     exception
-       when Program_Error =>
-         Report.Failed("Program_Error in Check_Explicit_Initialize");
-       when Tasking_Error =>
-         if C760010_0.Action /= C760010_0.Init_Raise_Standard then
-           Report.Failed("Tasking_Error in Check_Explicit_Initialize");
-         end if;
-       when C760010_0.User_Defined_Exception =>
-         if C760010_0.Action /= C760010_0.Init_Raise_User_Defined then
-           Report.Failed("User_Error in Check_Explicit_Initialize");
-         end if;
-       when others =>
-         Report.Failed("Wrong exception in Check_Explicit_Initialize");
-     end;
-   end Check_Explicit_Initialize;
- 
- ---------------------------------------------------------------------------
- 
-   procedure Check_Explicit_Adjust is
-   begin
-     begin
-       C760010_2.Adjust( Global_Item );
-     if C760010_0.Action
-        in C760010_0.Adj_Raise_User_Defined..C760010_0.Adj_Raise_Standard
-     then
-       Case_Failure("Anticipated exception at explicit Adjust");
-     end if;
-     exception
-       when Program_Error =>
-         Report.Failed("Program_Error in Check_Explicit_Adjust");
-       when Tasking_Error =>
-         if C760010_0.Action /= C760010_0.Adj_Raise_Standard then
-           Report.Failed("Tasking_Error in Check_Explicit_Adjust");
-         end if;
-       when C760010_0.User_Defined_Exception =>
-         if C760010_0.Action /= C760010_0.Adj_Raise_User_Defined then
-           Report.Failed("User_Error in Check_Explicit_Adjust");
-         end if;
-       when others =>
-         Report.Failed("Wrong exception in Check_Explicit_Adjust");
-     end;
-   end Check_Explicit_Adjust;
- 
- ---------------------------------------------------------------------------
- 
-   procedure Check_Explicit_Finalize is
-   begin
-     begin
-       C760010_2.Finalize( Global_Item );
-     if C760010_0.Action
-        in C760010_0.Fin_Raise_User_Defined..C760010_0.Fin_Raise_Standard
-     then
-       Case_Failure("Anticipated exception at explicit Finalize");
-     end if;
-     exception
-       when Program_Error =>
-         Report.Failed("Program_Error in Check_Explicit_Finalize");
-       when Tasking_Error =>
-         if C760010_0.Action /= C760010_0.Fin_Raise_Standard then
-           Report.Failed("Tasking_Error in Check_Explicit_Finalize");
-         end if;
-       when C760010_0.User_Defined_Exception =>
-         if C760010_0.Action /= C760010_0.Fin_Raise_User_Defined then
-           Report.Failed("User_Error in Check_Explicit_Finalize");
-         end if;
-       when others =>
-         Report.Failed("Wrong exception in Check_Explicit_Finalize");
-     end;
-   end Check_Explicit_Finalize;
- 
- ---------------------------------------------------------------------------
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C760010", "Check that explicit calls to finalization " &
-                           "procedures that raise exceptions propagate " &
-                           "the exception raised.  Check the utilization " &
-                           "of a controlled type as the actual for a " &
-                           "generic formal tagged private parameter" );
- 
-   for Act in C760010_0.Actions loop
-     C760010_1.Reset_Counters;
-     C760010_0.Action := Act;
- 
-     begin
-       Check_Implicit_Initialize;
-       if Act in
-          C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard then
-         Case_Failure("No exception at Check_Implicit_Initialize");
-       end if;
-     exception
-       when Tasking_Error =>
-         if Act /= C760010_0.Init_Raise_Standard then
-           Case_Failure("Tasking_Error at Check_Implicit_Initialize");
-         end if;
-       when C760010_0.User_Defined_Exception =>
-         if Act /= C760010_0.Init_Raise_User_Defined then
-           Case_Failure("User_Error at Check_Implicit_Initialize");
-         end if;
-       when Program_Error =>
-          -- If finalize raises an exception, all other object are finalized
-          -- first and Program_Error is raised upon leaving the master scope.
-          -- 7.6.1:14
-          if Act not in C760010_0.Fin_Raise_User_Defined..
-                        C760010_0.Fin_Raise_Standard then
-             Case_Failure("Program_Error at Check_Implicit_Initialize");
-          end if;
-       when others =>
-         Case_Failure("Wrong exception at Check_Implicit_Initialize");
-     end;
- 
-     Check_Explicit_Initialize;
-     Check_Explicit_Adjust;
-     Check_Explicit_Finalize;
- 
-     C760010_1.Check_Counters(0,0,0, C760010_0.Actions'Image(Act));
- 
-   end loop;
- 
-   -- Set to No_Action to avoid exception in finalizing Global_Item
-   C760010_0.Action := C760010_0.No_Action;
- 
-   Report.Result;
- 
- end C760010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,291 ****
- -- C760011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the anonymous objects of a controlled type associated with
- --      function results and aggregates are finalized no later than the
- --      end of the innermost enclosing declarative_item or statement.  Also
- --      check this for function calls and aggregates of a noncontrolled type
- --      with controlled components.
- --
- -- TEST DESCRIPTION:
- --      This test defines a controlled type with a discriminant, the
- --      discriminant is use as an index into a global table to indicate that
- --      the object has been finalized.  The controlled type is used as the
- --      component of a non-controlled type, and the non-controlled type is
- --      used for the same set of tests.  Following is a table of the tests
- --      performed and their associated tag character.
- --
- --      7.6(21) allows for the optimizations that remove these temporary
- --      objects from ever existing.  As such this test checks that in the
- --      case the object was initialized (the only access we have to
- --      determining if it ever existed) it must subsequently be finalized.
- --
- -- CASE TABLE:
- --      A - aggregate test, controlled
- --      B - aggregate test, controlled
- --      C - aggregate test, non_controlled
- --      D - function test, controlled
- --      E - function test, non_controlled
- --      F - formal parameter function test, controlled
- --      G - formal parameter aggregate test, controlled
- --      H - formal parameter function test, non_controlled
- --      I - formal parameter aggregate test, non_controlled
- --
- --      X - scratch object, not consequential to the objective
- --      Y - scratch object, not consequential to the objective
- --      Z - scratch object, not consequential to the objective
- --
- --
- -- CHANGE HISTORY:
- --      22 MAY 95   SAIC    Initial version
- --      24 APR 96   SAIC    Minor doc fixes, visibility patch
- --      14 NOV 96   SAIC    Revised for release 2.1
- --
- --!
- 
- ------------------------------------------------------------------- C760011_0
- 
- with Ada.Finalization;
- package C760011_0 is
-   type Tracking_Array is array(Character range 'A'..'Z') of Boolean;
- 
-   Initialized : Tracking_Array := (others => False);
-   Finalized   : Tracking_Array := (others => False);
- 
-   type Controlled_Type(Tag : Character) is
-     new Ada.Finalization.Controlled with record
-       TC_Component : String(1..4) := "ACVC";
-     end record;
-   procedure Initialize( It: in out Controlled_Type );
-   procedure Finalize  ( It: in out Controlled_Type );
-   function Create(With_Tag: Character) return Controlled_Type;
- 
-   type Non_Controlled(Tag : Character := 'Y') is record
-     Controlled_Component : Controlled_Type(Tag);
-   end record;
-   procedure Initialize( It: in out Non_Controlled );
-   procedure Finalize  ( It: in out Non_Controlled );
-   function Create(With_Tag: Character) return Non_Controlled;
- 
-   Under_Debug : constant Boolean := False;  -- construction lines
- 
- end C760011_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body C760011_0 is
- 
-   procedure Initialize( It: in out Controlled_Type ) is
-   begin
-     It.TC_Component := (others => It.Tag);
-     if It.Tag in Tracking_Array'Range then 
-       Initialized(It.Tag) := True;
-     end if;
-     if Under_Debug then
-       Report.Comment("Initializing Tag: " & It.Tag );
-     end if;
-   end Initialize;
-   
-   procedure Finalize( It: in out Controlled_Type ) is
-   begin
-     if Under_Debug then
-       Report.Comment("Finalizing for Tag: " & It.Tag );
-     end if;
-     if It.Tag in Finalized'Range then 
-       Finalized(It.Tag) := True;
-     end if;
-   end Finalize;
- 
-   function Create(With_Tag: Character) return Controlled_Type is
-   begin
-     return Controlled_Type'(Ada.Finalization.Controlled
-                             with Tag          => With_Tag,
-                                  TC_Component => "*CON" );
-   end Create;
- 
-   procedure Initialize( It: in out Non_Controlled ) is
-   begin
-     Report.Failed("Called Initialize for Non_Controlled");
-   end Initialize;
-   
-   procedure Finalize( It: in out Non_Controlled ) is
-   begin
-     Report.Failed("Called Finalize for Non_Controlled");
-   end Finalize;
- 
-   function Create(With_Tag: Character) return Non_Controlled is
-   begin
-     return Non_Controlled'(Tag => With_Tag, Controlled_Component => (
-                                   Ada.Finalization.Controlled
-                                     with Tag          => With_Tag,
-                                          TC_Component => "#NON" ) );
-   end Create;
- 
- end C760011_0;
- 
- --------------------------------------------------------------------- C760011
- 
- with Report;
- with TCTouch;
- with C760011_0;
- with Ada.Finalization; -- needed to be able to create extension aggregates
- procedure C760011 is
- 
-   use type C760011_0.Controlled_Type;
-   use type C760011_0.Controlled_Type'Class;
-   use type C760011_0.Non_Controlled;
- 
-   subtype AFC is Ada.Finalization.Controlled;
- 
-   procedure Check_Result( Tag : Character; Message : String ) is
-   -- make allowance for 7.6(21) optimizations
-   begin
-     if C760011_0.Initialized(Tag) then
-       TCTouch.Assert(C760011_0.Finalized(Tag),Message);
-     elsif C760011_0.Under_Debug then
-       Report.Comment("Optimized away: " & Tag );
-     end if;
-   end Check_Result;
- 
-   procedure Subtest_1 is
- 
- 
-     procedure Subtest_1_Local_1 is
-       An_Object : C760011_0.Controlled_Type'Class
-                 := C760011_0.Controlled_Type'(AFC with 'X', "ONE*");
-                    -- initialize An_Object
-     begin
-       if C760011_0.Controlled_Type(An_Object)   
-          = C760011_0.Controlled_Type'(AFC with 'A', "ONE*") then
-         Report.Failed("Comparison bad");  -- A = X !!!
-       end if;
-     end Subtest_1_Local_1;
-     -- An_Object must be Finalized by this point.
- 
-     procedure Subtest_1_Local_2 is
-       An_Object : C760011_0.Controlled_Type('B');
-     begin
-       An_Object := (AFC with 'B',  "TWO!" );
-       if Report.Ident_Char(An_Object.Tag) /= 'B' then
-         Report.Failed("Subtest_1_Local_2 Optimization Foil: Bad Data!");
-       end if;
-     exception
-       when others => Report.Failed("Bad controlled assignment");
-     end Subtest_1_Local_2;
-     -- An_Object must be Finalized by this point.
- 
-     procedure Subtest_1_Local_3 is
-       An_Object : C760011_0.Non_Controlled('C');
-     begin
-       TCTouch.Assert_Not(C760011_0.Finalized('C'),
-                            "Non_Controlled declaration C");
-       An_Object := C760011_0.Non_Controlled'('C', Controlled_Component
-                                      => (AFC with 'C', "TEE!"));
-       if Report.Ident_Char(An_Object.Tag) /= 'C' then
-         Report.Failed("Subtest_1_Local_3 Optimization Foil: Bad Data!");
-       end if;
-     end Subtest_1_Local_3;
-     -- Only controlled components of An_Object must be finalized; it is an
-     -- error to call Finalize for An_Object
- 
-   begin
-     Subtest_1_Local_1;
-     Check_Result( 'A', "Aggregate in subprogram 1" );
- 
-     Subtest_1_Local_2;
-     Check_Result( 'B', "Aggregate in subprogram 2" );
- 
-     Subtest_1_Local_3;
-     Check_Result( 'C', "Embedded aggregate in subprogram 3" );
-   end Subtest_1;
- 
- 
-   procedure Subtest_2 is
-     -- using 'Z' for both evades order issues
-     Con_Object : C760011_0.Controlled_Type('Z');
-     Non_Object : C760011_0.Non_Controlled('Z');
-   begin
-     if Report.Ident_Bool( Con_Object = C760011_0.Create('D') ) then
-       Report.Failed("Con_Object catastrophe");
-     end if;
-      -- Controlled function result should be finalized by now
-     Check_Result( 'D', "Function Result" );
- 
-     if Report.Ident_Bool( Non_Object = C760011_0.Create('E') ) then
-       Report.Failed("Non_Object catastrophe");
-     end if;
-      -- Controlled component of function result should be finalized by now
-     Check_Result( 'E', "Function Result" );
-   end Subtest_2;
- 
- 
-   procedure Subtest_3(Con : in C760011_0.Controlled_Type) is
-   begin
-     if Con.Tag not in 'F'..'G' then  
-       Report.Failed("Bad value passed to subtest 3 " & Con.Tag & ' ' 
-                     & Report.Ident_Str(Con.TC_Component));
-     end if;
-   end Subtest_3;
- 
- 
-   procedure Subtest_4(Non : in C760011_0.Non_Controlled) is
-   begin
-     if Non.Tag not in 'H'..'I' then  
-       Report.Failed("Bad value passed to subtest 4 "
-                    & Non.Tag & ' ' 
-                    & Report.Ident_Str(Non.Controlled_Component.TC_Component));
-     end if;
-   end Subtest_4;
- 
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C760011", "Check that anonymous objects of controlled " &
-                           "types or types containing controlled types " &
-                           "are finalized no later than the end of the " &
-                           "innermost enclosing declarative_item or " &
-                           "statement" );
- 
-   Subtest_1;
- 
-   Subtest_2;
- 
-   Subtest_3(C760011_0.Create('F'));
-   Check_Result( 'F', "Function as formal F" );
- 
-   Subtest_3(C760011_0.Controlled_Type'(AFC with 'G',"GIGI"));
-   Check_Result( 'G', "Aggregate as formal G" );
- 
-   Subtest_4(C760011_0.Create('H'));
-   Check_Result( 'H', "Function as formal H" );
- 
-   Subtest_4(C760011_0.Non_Controlled'('I', (AFC with 'I',"IAGO")));
-   Check_Result( 'I', "Aggregate as formal I" );
- 
-   Report.Result;
- 
- end C760011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,256 ****
- -- C760012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that record components that have per-object access discriminant
- --      constraints are initialized in the order of their component
- --      declarations, and after any components that are not so constrained.
- --
- --      Check that record components that have per-object access discriminant
- --      constraints are finalized in the reverse order of their component
- --      declarations, and before any components that are not so constrained.
- --
- -- TEST DESCRIPTION:
- --      The type List_Item is the "container" type.  It holds two fields that
- --      have per-object access discriminant constraints, and two fields that
- --      are not discriminated.  These four fields are all controlled types.
- --      A fifth field is a pointer used to maintain a linked list of these
- --      data objects.  Each component is of a unique type which allows for
- --      the test to simply track the order of initialization and finalization.
- --
- --      The types and their purpose are:
- --        Constrained_First  - a controlled discriminated type
- --        Constrained_Second - a controlled discriminated type
- --        Simple_First       - a controlled type with no discriminant
- --        Simple_Second      - a controlled type with no discriminant
- --
- --      The required order of operations:
- --        Initialize
- --          ( Simple_First | Simple_Second )   -- no "internal order" required
- --          Constrained_First
- --          Constrained_Second
- --        Finalize
- --          Constrained_Second
- --          Constrained_First
- --          ( Simple_First | Simple_Second )   -- must be inverse of init.
- --
- --
- -- CHANGE HISTORY:
- --      23 MAY 95   SAIC    Initial version
- --      02 MAY 96   SAIC    Reorganized for 2.1
- --      05 DEC 96   SAIC    Simplified for 2.1; added init/fin ordering check
- --      31 DEC 97   EDS     Remove references to and uses of
- --                          Initialization_Sequence
- --!
- 
- ---------------------------------------------------------------- C760012_0
- 
- with Ada.Finalization;
- with Ada.Unchecked_Deallocation;
- package C760012_0 is
- 
-   type List_Item;
- 
-   type List is access all List_Item;
- 
-   package Firsts is  -- distinguish first from second
-     type Constrained_First(Container : access List_Item) is 
-            new Ada.Finalization.Limited_Controlled with null record;
-     procedure Initialize( T : in out Constrained_First );
-     procedure Finalize  ( T : in out Constrained_First );
- 
-     type Simple_First is new Ada.Finalization.Controlled with
-       record
-         My_Init_Seq_Number : Natural;
-       end record;
-     procedure Initialize( T : in out Simple_First );
-     procedure Finalize  ( T : in out Simple_First );
- 
-   end Firsts;
- 
-   type Constrained_Second(Container : access List_Item) is
-          new Ada.Finalization.Limited_Controlled with null record;
-   procedure Initialize( T : in out Constrained_Second );
-   procedure Finalize  ( T : in out Constrained_Second );
- 
-   type Simple_Second is new Ada.Finalization.Controlled with
-     record
-       My_Init_Seq_Number : Natural;
-     end record; 
-   procedure Initialize( T : in out Simple_Second );
-   procedure Finalize  ( T : in out Simple_Second );
- 
-   -- by 3.8(18);6.0 the following type contains components constrained
-   -- by per-object expressions
- 
- 
-   type List_Item is new Ada.Finalization.Limited_Controlled
-     with record
-       ContentA : Firsts.Constrained_First( List_Item'Access ); -- C S
-       SimpleA  : Firsts.Simple_First;                          -- A T
-       SimpleB  : Simple_Second;                                -- A T
-       ContentB : Constrained_Second( List_Item'Access );       -- D R
-       Next     : List;                                         -- | |
-     end record;                                                -- | |
-   procedure Initialize( L : in out List_Item ); ------------------+ |
-   procedure Finalize  ( L : in out List_Item ); --------------------+
- 
-   -- the tags are the same for SimpleA and SimpleB due to the fact that
-   -- the language does not specify an ordering with respect to this
-   -- component pair. 7.6(12) does specify the rest of the ordering.
- 
-   procedure Deallocate is new Ada.Unchecked_Deallocation(List_Item,List);
- 
- end C760012_0;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body C760012_0 is
- 
-   package body Firsts is
- 
-     procedure Initialize( T : in out Constrained_First ) is
-     begin
-       TCTouch.Touch('C');   ----------------------------------------------- C
-     end Initialize;
- 
-     procedure Finalize  ( T : in out Constrained_First ) is
-     begin
-       TCTouch.Touch('S');   ----------------------------------------------- S
-     end Finalize;
- 
-     procedure Initialize( T : in out Simple_First ) is
-     begin
-       T.My_Init_Seq_Number := 0;
-       TCTouch.Touch('A');   ----------------------------------------------- A
-     end Initialize;
- 
-     procedure Finalize  ( T : in out Simple_First ) is
-     begin
-       TCTouch.Touch('T');   ----------------------------------------------- T
-     end Finalize;
- 
-   end Firsts;
- 
-   procedure Initialize( T : in out Constrained_Second ) is
-   begin
-     TCTouch.Touch('D');   ------------------------------------------------- D
-   end Initialize;
- 
-   procedure Finalize  ( T : in out Constrained_Second ) is
-   begin
-     TCTouch.Touch('R');   ------------------------------------------------- R
-   end Finalize;
- 
- 
-   procedure Initialize( T : in out Simple_Second ) is
-   begin
-     T.My_Init_Seq_Number := 0;
-     TCTouch.Touch('A');   ------------------------------------------------- A
-   end Initialize;
- 
-   procedure Finalize  ( T : in out Simple_Second ) is
-   begin
-     TCTouch.Touch('T');   ------------------------------------------------- T
-   end Finalize;
- 
-   procedure Initialize( L : in out List_Item ) is
-   begin
-     TCTouch.Touch('F');   ------------------------------------------------- F
-   end Initialize;
- 
-   procedure Finalize  ( L : in out List_Item ) is
-   begin
-     TCTouch.Touch('Q');   ------------------------------------------------- Q
-   end Finalize;
- 
- end C760012_0;
-  
- --------------------------------------------------------------------- C760012
- 
- with Report;
- with TCTouch;
- with C760012_0;
- procedure C760012 is
- 
-   use type C760012_0.List;
- 
-   procedure Subtest_1 is
-   -- by 3.8(18);6.0 One_Of_Them is constrained by per-object constraints
-   -- 7.6.1(9);6.0 dictates the order of finalization of the components
- 
-     One_Of_Them : C760012_0.List_Item;
-   begin
-     if One_Of_Them.Next /= null then  -- just to hold the subtest in place
-       Report.Failed("No default value for Next");
-     end if;
-   end Subtest_1;
- 
-   List : C760012_0.List;
- 
-   procedure Subtest_2 is
-   begin
- 
-     List := new C760012_0.List_Item;
- 
-     List.Next := new C760012_0.List_Item;
- 
-   end Subtest_2;
- 
-   procedure Subtest_3 is
-   begin
- 
-     C760012_0.Deallocate( List.Next );
- 
-     C760012_0.Deallocate( List );
- 
-   end Subtest_3;
-   
- begin  -- Main test procedure.
- 
-   Report.Test ("C760012", "Check that record components that have " &
-                           "per-object access discriminant constraints " &
-                           "are initialized in the order of their " &
-                           "component declarations, and after any " &
-                           "components that are not so constrained.  " &
-                           "Check that record components that have " &
-                           "per-object access discriminant constraints " &
-                           "are finalized in the reverse order of their " &
-                           "component declarations, and before any " &
-                           "components that are not so constrained" );
- 
-   Subtest_1;
-   TCTouch.Validate("AACDFQRSTT", "One object");
- 
-   Subtest_2;
-   TCTouch.Validate("AACDFAACDF", "Two objects dynamically allocated");
- 
-   Subtest_3;
-   TCTouch.Validate("QRSTTQRSTT", "Two objects deallocated");
- 
-   Report.Result;
- 
- end C760012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c760013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c760013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C760013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that Initialize is not called for default-initialized subcomponents
- --    of the ancestor type of an extension aggregate.  (Defect Report
- --    8652/0021, Technical Corrigendum 7.6(11/1)).
- --
- -- CHANGE HISTORY:
- --    25 JAN 2001   PHL   Initial version.
- --    29 JUN 2001   RLB   Reformatted for ACATS.
- --
- --!
- with Ada.Finalization;
- use Ada.Finalization;
- package C760013_0 is
- 
-     type Ctrl1 is new Controlled with
- 	record
- 	    C : Integer := 0;
- 	end record;
-     type Ctrl2 is new Controlled with
- 	record
- 	    C : Integer := 0;
- 	end record;
- 
-     procedure Initialize (Obj1 : in out Ctrl1);
-     procedure Initialize (Obj2 : in out Ctrl2);
- 
- end C760013_0;
- 
- with Report;
- use Report;
- package body C760013_0 is
- 
-     procedure Initialize (Obj1 : in out Ctrl1) is
-     begin
- 	Obj1.C := Ident_Int (47);
-     end Initialize;
- 
-     procedure Initialize (Obj2 : in out Ctrl2) is
-     begin
- 	Failed ("Initialize called for type Ctrl2");
-     end Initialize;
- 
- end C760013_0;
- 
- with Ada.Finalization;
- with C760013_0;
- use C760013_0;
- with Report;
- use Report;
- procedure C760013 is
- 
-     type T is tagged
- 	record
- 	    C1 : Ctrl1;
- 	    C2 : Ctrl2 := (Ada.Finalization.Controlled with
- 			   C => Ident_Int (23));
- 	end record;
- 
-     type Nt is new T with
- 	record
- 	    C3 : Float;
- 	end record;
- 
-     X : Nt;
- 
- begin
-     Test ("C760013",
- 	  "Check that Initialize is not called for " &
- 	     "default-initialized subcomponents of the ancestor type of an " &
- 	     "extension aggregate");
- 
-     X := (T with C3 => 5.0);
- 
-     if X.C1.C /= Ident_Int (47) then
- 	Failed ("Initialize not called for type Ctrl1");
-     end if;
-     if X.C2.C /= Ident_Int (23) then
- 	Failed ("Initial value not assigned for type Ctrl2");
-     end if;
- 
-     Result;
- end C760013;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C761001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that controlled objects declared immediately within a library
- --      package are finalized following the completion of the environment
- --      task (and prior to termination of the program).
- --
- -- TEST DESCRIPTION:
- --      This test derives a type from Ada.Finalization.Controlled, and
- --      declares an object of that type in the body of a library package.
- --      The dispatching procedure Finalize is redefined for the derived
- --      type to perform a check that it has been called only once, and in
- --      turn calls Report.Result.  This test may fail by not calling
- --      Report.Result.  This test may also fail by calling Report.Result
- --      twice, the first call will report a false pass.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      13 Nov 95   SAIC    Updated for ACVC 2.0.1
- --
- --!
- 
- with Ada.Finalization;
- package C761001_0 is
- 
-   type Global is new Ada.Finalization.Controlled with null record;
-   procedure Finalize( It: in out Global );
- 
- end C761001_0;
- 
- package C761001_1 is
- 
-   task Library_Task is
-     entry Never_Called;
-   end Library_Task;
- 
- end C761001_1;
- 
- with Report;
- with C761001_1;
- package body C761001_0 is
- 
-   My_Object : Global;
- 
-   Done : Boolean := False;
- 
-   procedure Finalize( It: in out Global ) is
-   begin
-     if not C761001_1.Library_Task'Terminated then
-       Report.Failed("Library task not terminated before finalize");
-     end if;
-     if Done then  -- checking included "just in case"
-       Report.Comment("Test FAILED, even if previously reporting passed");
-       Report.Failed("Unwarranted multiple call to finalize");
-     end if;
-     Report.Result;
-     Done := True;
-   end Finalize;
- 
- end C761001_0;
- 
- with Report;
- package body C761001_1 is
- 
-   task body Library_Task is
-   begin
-     if Report.Ident_Int( 1 ) /= 1 then
-       Report.Failed( "Baseline failure in Library_Task");
-     end if;
-   end Library_Task;
- 
- end C761001_1;
- 
- with Report;
- with C761001_0;
- 
- procedure C761001 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C761001", "Check that controlled objects declared "
-                         & "immediately within a library package are "
-                         & "finalized following the completion of the "
-                         & "environment task (and prior to termination "
-                         & "of the program)");
- 
-   -- note that if the test DOES call report twice, the first will report a
-   -- false pass, the second call will correctly fail the test.
- 
-   -- not calling Report.Result;
-   -- Result is called as part of the finalization of C761001_0.My_Object.
- 
- end C761001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,245 ****
- -- C761002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that objects of a controlled type that are created
- --      by an allocator are finalized at the appropriate time.  In 
- --      particular, check that such objects are not finalized due to 
- --      completion of the master in which they were allocated if the 
- --      corresponding access type is declared outside of that master.
- --
- --      Check that Unchecked_Deallocation of a controlled 
- --      object causes finalization of that object.
- --
- -- TEST DESCRIPTION:
- --      This test derives a type from Ada.Finalization.Controlled, and
- --      declares access types to that type in various scope scenarios.
- --      The dispatching procedure Finalize is redefined for the derived
- --      type to perform a check that it has been called at the 
- --      correct time.  This is accomplished using a global variable 
- --      which indicates what state the software is currently 
- --      executing.  The test utilizes the TCTouch facilities to 
- --      verify that Finalize is called the correct number of times, at 
- --      the correct times.  Several calls are made to validate passing 
- --      the null string to check that Finalize has NOT been called at 
- --      that point.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Finalization;
- package C761002_0 is
-   type Global is new Ada.Finalization.Controlled with null record;
-   procedure Finalize( It: in out Global );
-   
-   type Second is new Ada.Finalization.Limited_Controlled with null record;
-   procedure Finalize( It: in out Second );
- end C761002_0;
- 
- with Report;
- with TCTouch;
- package body C761002_0 is
- 
-   procedure Finalize( It: in out Global ) is
-   begin
-     TCTouch.Touch('F');  ------------------------------------------------- F
-   end Finalize;
- 
-   procedure Finalize( It: in out Second ) is
-   begin
-     TCTouch.Touch('S');  ------------------------------------------------- S
-   end Finalize;
- end C761002_0;
- 
- with Report;
- with TCTouch;
- with C761002_0;
- with Unchecked_Deallocation;
- procedure C761002 is
- 
-   -- check the straightforward case
-   procedure Subtest_1 is
-     type Access_1 is access C761002_0.Global;
-     V1 : Access_1;
-     procedure Allocate is
-       V2 : Access_1;
-     begin
-       V2 := new C761002_0.Global;
-       V1 := V2;  -- "dead" assignment must not be optimized away due to
-                  -- finalization "side effects", many more of these follow
-     end Allocate;
-   begin
-     Allocate;
-     -- no calls to Finalize should have occurred at this point
-     TCTouch.Validate("","Allocated nested, retained");
-   end Subtest_1;
-   
-   -- check Unchecked_Deallocation
-   procedure Subtest_2 is
-     type Access_2 is access C761002_0.Global;
-     procedure Free is
-               new Unchecked_Deallocation(C761002_0.Global, Access_2);
-     V1 : Access_2;
-     V2 : Access_2;
- 
-     procedure Allocate is
-     begin
-       V1 := new C761002_0.Global;
-       V2 := new C761002_0.Global;
-     end Allocate;
- 
-   begin
-     Allocate;
-     -- no calls to Finalize should have occurred at this point.
-     TCTouch.Validate("","Allocated nested, non-local");
-     
-     Free(V1); -- instance of Unchecked_Deallocation
-     -- should cause the finalization of V1.all
-     TCTouch.Validate("F","Unchecked Deallocation");
-   end Subtest_2; -- leaving this scope should cause the finalization of V2.all
-   
-   -- check various master-exit scenarios
-   -- the "Fake" parameters are used to avoid unwanted optimizations
-   procedure Subtest_3 is
-     procedure With_Local_Block is
-       type Access_3 is access C761002_0.Global;
-       V1 : Access_3;
-     begin
-       declare
-         V2 : Access_3 := new C761002_0.Global;
-       begin
-         V1 := V2;
-       end;
-       TCTouch.Validate("","Local Block, normal exit");
-       -- the allocated object should be finalized on leaving this scope
-     end With_Local_Block;
-     
-     procedure With_Local_Block_Return(Fake: Integer) is
-       type Access_4 is access C761002_0.Global;
-       V1 : Access_4 := new C761002_0.Global;
-     begin
-       if Fake = 0 then
-         declare
-           V2 : Access_4;
-         begin
-           V2 := new C761002_0.Global;
-           return; -- the two allocated objects should be finalized
-         end;      -- upon leaving this scope
-       else
-         V1 := null;
-       end if;
-     end With_Local_Block_Return;
- 
-     procedure With_Goto(Fake: Integer) is
-       type Access_5 is access C761002_0.Global;
-       V1 : Access_5 := new C761002_0.Global;
-       V2 : Access_5;
-       V3 : Access_5;
-     begin
-       if Fake = 0 then
-         declare
-           type Access_6 is access C761002_0.Second;
-           V6 : Access_6;
-         begin
-           V6 := new C761002_0.Second;
-           goto check;
-         end;
-       else
-         V2 := V1;
-       end if;
-       V3 := V2;
- <<check>>
-       TCTouch.Validate("S","goto past master end");
-      end With_Goto;
- 
-   begin
-     With_Local_Block;
-     TCTouch.Validate("F","Local Block, normal exit, after master");
- 
-     With_Local_Block_Return( Report.Ident_Int(0) );
-     TCTouch.Validate("FF","Local Block, return from block");
- 
-     With_Goto( Report.Ident_Int(0) );
-     TCTouch.Validate("F","With Goto");
- 
-   end Subtest_3;
- 
-   procedure Subtest_4 is
- 
-     Oops : exception;
-     
-     procedure Alley( Fake: Integer ) is
-       type Access_1 is access C761002_0.Global;
-       V1 : Access_1;
-     begin
-       V1 := new C761002_0.Global;
-       if Fake = 1 then
-         raise Oops;
-       end if;
-       V1 := null;
-     end Alley;
-   
-   begin
-     Catch: begin
-       Alley( Report.Ident_Int(1) );
-     exception
-       when Oops   => TCTouch.Validate("F","leaving via exception");
-       when others => Report.Failed("Wrong exception");
-     end Catch;
-   end Subtest_4;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C761002", "Check that objects of a controlled type created "
-                         & "by an allocator are finalized appropriately. " 
-                         & "Check that Unchecked_Deallocation of a "
-                         & "controlled object causes finalization " 
-                         & "of that object" );
-   
-   Subtest_1;
-   -- leaving the scope of the access type should finalize the 
-   -- collection
-   TCTouch.Validate("F","Allocated nested, Subtest 1");
-   
-   Subtest_2;
-   -- Unchecked_Deallocation already finalized one of the two 
-   -- objects allocated, the other should be the only one finalized 
-   -- at leaving the scope of the access type.
-   TCTouch.Validate("F","Allocated non-local");
- 
-   Subtest_3;
-   -- there should be no remaining finalizations from this subtest
-   TCTouch.Validate("","Localized objects");
- 
-   Subtest_4;
-   -- there should be no remaining finalizations from this subtest
-   TCTouch.Validate("","Exception testing");
- 
-   Report.Result;
- 
- end C761002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,447 ****
- -- C761003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an object of a controlled type is finalized when the
- --      enclosing master is complete.
- --      Check this for controlled types where the derived type has a
- --      discriminant.
- --      Check this for subprograms of abstract types derived from the
- --      types in Ada.Finalization.
- --
- --      Check that finalization of controlled objects is
- --      performed in the correct order.  In particular, check that if
- --      multiple objects of controlled types are declared immediately
- --      within the same declarative part then type are finalized in the
- --      reverse order of their creation.
- --
- -- TEST DESCRIPTION:
- --      This test checks these conditions for subprograms and
- --      block statements; both variables and constants of controlled
- --      types; cases of a controlled component of a record type, as
- --      well as an array with controlled components.
- --
- --      The base controlled types used for the test are defined
- --      with a character discriminant.  The initialize procedure for
- --      the types will record the order of creation in a globally
- --      accessible array, the finalize procedure for the types will call
- --      TCTouch with that tag character.  The test can then check that
- --      the order of finalization is indeed the reverse of the order of
- --      creation (assuming that the implementation calls Initialize in
- --      the order that the objects are created).
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 Nov 95   SAIC    ACVC 2.0.1
- --
- --!
- 
- ------------------------------------------------------------ C761003_Support
- 
- package C761003_Support is
-   
-   function Pick_Char return Character;
-   -- successive calls to Pick_Char return distinct characters which may
-   -- be assigned to objects to track an order sequence.  These characters
-   -- are then used in calls to TCTouch.Touch.
- 
-   procedure Validate(Initcount   : Natural;
-                      Testnumber  : Natural;
-                      Check_Order : Boolean := True);
-   -- does a little extra processing prior to calling TCTouch.Validate,
-   -- specifically, it reverses the stored string of characters, and checks
-   -- for a correct count.
- 
-   Inits_Order  : String(1..255);
-   Inits_Called : Natural := 0;
- 
- end C761003_Support;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body C761003_Support is
-   type Pick_Rotation is mod 52;
-   type Pick_String is array(Pick_Rotation) of Character;
- 
-   From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-                                 & "abcdefghijklmnopqrstuvwxyz";
-   Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
- 
-   function Pick_Char return Character is
-   begin
-     Recent_Pick := Recent_Pick +1;
-     return From(Recent_Pick);
-   end Pick_Char;
- 
-   function Invert(S:String) return String is
-     T: String(1..S'Length);
-   begin
-     for SI in reverse S'Range loop
-       T(S'Last - SI + 1) := S(SI);
-     end loop;
-     return T;
-   end Invert;
- 
-   procedure Validate(Initcount   : Natural;
-                      Testnumber  : Natural;
-                      Check_Order : Boolean := True) is
-     Number : constant String := Natural'Image(Testnumber);
-   begin
-     if Inits_Called /= Initcount then
-       Report.Failed("Got" & Natural'Image(Inits_Called) & " inits, expected"
-                     & Natural'Image(Initcount) & ", Subtest " & Number);
-       TCTouch.Flush;
-     else
-       TCTouch.Validate(
-         Invert(Inits_Order(1..Inits_Called)),
-                "Subtest " & Number, Order_Meaningful => Check_Order );
-     end if;
-     Inits_Called := 0;  -- reset for the next batch
-   end Validate;
- 
- end C761003_Support;
- 
- ------------------------------------------------------------------ C761003_0
- 
- with Ada.Finalization;
- package C761003_0 is
- 
-   type Global(Tag: Character) is new Ada.Finalization.Controlled
-     with null record;
- 
-   procedure Initialize( It: in out Global );
-   procedure Finalize  ( It: in out Global );
- 
-   Null_Global : Global('1') := (Ada.Finalization.Controlled with Tag => '1');
- 
-   type Second(Tag: Character) is new Ada.Finalization.Limited_Controlled
-     with null record;
- 
-   procedure Initialize( It: in out Second );
-   procedure Finalize  ( It: in out Second );
- 
- end C761003_0;
- 
- ------------------------------------------------------------------ C761003_1
- 
- with Ada.Finalization;
- package C761003_1 is
- 
-   type Global is abstract new Ada.Finalization.Controlled with record
-     Tag: Character;
-   end record;
- 
-   procedure Initialize( It: in out Global );
-   procedure Finalize  ( It: in out Global );
- 
-   type Second is abstract new Ada.Finalization.Limited_Controlled with record
-     Tag: Character;
-   end record;
- 
-   procedure Initialize( It: in out Second );
-   procedure Finalize  ( It: in out Second );
- 
- end C761003_1;
- 
- ------------------------------------------------------------------ C761003_2
- 
- with C761003_1;
- package C761003_2 is
- 
-   type Global is new C761003_1.Global with null record;
-   -- inherits Initialize and Finalize
- 
-   type Second is new C761003_1.Second with null record;
-   -- inherits Initialize and Finalize
- 
- end C761003_2;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --  C761003_0
- 
- with TCTouch;
- with C761003_Support;
- package body C761003_0 is
- 
-   package Sup renames C761003_Support;
- 
-   procedure Initialize( It: in out Global ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
- 
-   procedure Finalize( It: in out Global ) is
-   begin
-     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
-   end Finalize;
- 
-   procedure Initialize( It: in out Second ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
- 
-   procedure Finalize( It: in out Second ) is
-   begin
-     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
-   end Finalize;
- 
- end C761003_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --  C761003_1
- 
- with TCTouch;
- with C761003_Support;
- package body C761003_1 is
- 
-   package Sup renames C761003_Support;
- 
-   procedure Initialize( It: in out Global ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     It.Tag := Sup.Pick_Char;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
- 
-   procedure Finalize( It: in out Global ) is
-   begin
-     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
-   end Finalize;
- 
-   procedure Initialize( It: in out Second ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     It.Tag := Sup.Pick_Char;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
- 
-   procedure Finalize( It: in out Second ) is
-   begin
-     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
-   end Finalize;
- 
- end C761003_1;
- 
- -------------------------------------------------------------------- C761003
- 
- with Report;
- with TCTouch;
- with C761003_0;
- with C761003_2;
- with C761003_Support;
- procedure C761003 is
- 
-   package Sup renames C761003_Support;
- 
- ---------------------------------------------------------------- Subtest_1
- 
-   Subtest_1_Inits_Expected : constant := 5;  -- includes 1 previous
- 
-   procedure Subtest_1 is
- 
-     -- the constant will take its constraint from the value.
-     -- must be declared first to be finalized last (and take the
-     -- initialize from before calling subtest_1)
-     Item_1 : constant C761003_0.Global := C761003_0.Null_Global;
- 
-     -- Item_2, declared second, should be finalized second to last.
-     Item_2 : C761003_0.Global(Sup.Pick_Char);
- 
-     -- Item_3 and Item_4 will be created in the order of the
-     -- list.
-     Item_3, Item_4 : C761003_0.Global(Sup.Pick_Char);
- 
-    -- Item_5 will be finalized first.
-     Item_5 : C761003_0.Second(Sup.Pick_Char);
- 
-   begin
-     if Item_3.Tag >= Item_4.Tag then
-       Report.Failed("Controlled objects created by list in wrong order");
-     end if;
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 1 body");
-   end Subtest_1;
- 
- ---------------------------------------------------------------- Subtest_2
- 
-   -- These declarations should cause calls to initialize and
-   -- finalize.  The expected operations are the subprograms associated
-   -- with the abstract types.  Note that for these objects, the
-   -- Initialize and Finalize are visible only by inheritance.
- 
-   Subtest_2_Inits_Expected : constant := 4;
- 
-   procedure Subtest_2 is
- 
-     Item_1 : C761003_2.Global;
-     Item_2, Item_3 : C761003_2.Global;
-     Item_4 : C761003_2.Second;
- 
-   begin
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 2 body");
-   end Subtest_2;
- 
- ---------------------------------------------------------------- Subtest_3
- 
-   -- Test for controlled objects embedded in arrays.  Using structures
-   -- that will cause a checkable order.
- 
-   Subtest_3_Inits_Expected : constant := 8;
- 
-   procedure Subtest_3 is
- 
-     type Global_List is array(Natural range <>)
-                           of C761003_0.Global(Sup.Pick_Char);
- 
-     Items : Global_List(1..4);  -- components have the same tag
- 
-     type Second_List is array(Natural range <>)
-                           of C761003_0.Second(Sup.Pick_Char);
- 
-     Second_Items : Second_List(1..4);  -- components have the same tag,
-                                        -- distinct from the tag used in Items
- 
-   begin
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 3 body");
-   end Subtest_3;
- 
- ---------------------------------------------------------------- Subtest_4
- 
-   -- These declarations should cause dispatching calls to initialize and
-   -- finalize.  The expected operations are the subprograms associated
-   -- with the abstract types.
- 
-   Subtest_4_Inits_Expected : constant := 2;
- 
-   procedure Subtest_4 is
- 
-     type Global_Rec is record
-       Item1: C761003_0.Global(Sup.Pick_Char);
-     end record;
- 
-     type Second_Rec is record
-       Item2: C761003_2.Second;
-     end record;
- 
-     G : Global_Rec;
-     S : Second_Rec;
- 
-   begin
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 4 body");
-   end Subtest_4;
- 
- ---------------------------------------------------------------- Subtest_5
- 
-   -- Test for controlled objects embedded in arrays.  In these cases, the
-   -- order of the finalization of the components is not defined by the
-   -- language.
- 
-   Subtest_5_Inits_Expected : constant := 8;
- 
-   procedure Subtest_5 is
- 
- 
-     type Another_Global_List is array(Natural range <>)
-                           of C761003_2.Global;
- 
-     More_Items : Another_Global_List(1..4);
- 
-     type Another_Second_List is array(Natural range <>)
-                           of C761003_2.Second;
- 
-     Second_More_Items : Another_Second_List(1..4);
- 
-   begin
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 5 body");
-   end Subtest_5;
- 
- ---------------------------------------------------------------- Subtest_6
- 
-   -- These declarations should cause dispatching calls to initialize and
-   -- finalize.  The expected operations are the subprograms associated
-   -- with the abstract types.
- 
-   Subtest_6_Inits_Expected : constant := 2;
- 
-   procedure Subtest_6 is
- 
-     type Global_Rec is record
-      Item2: C761003_2.Global;
-     end record;
- 
-     type Second_Rec is record
-       Item1: C761003_0.Second(Sup.Pick_Char);
-    end record;
- 
-     G : Global_Rec;
-     S : Second_Rec;
- 
-   begin
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 6 body");
-   end Subtest_6;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C761003", "Check that an object of a controlled type "
-                         & "is finalized when the enclosing master is "
-                         & "complete, left by a transfer of control, "
-                         & "and performed in the correct order" );
- 
-   -- adjust for optional adjusts and initializes for C761003_0.Null_Global
-   TCTouch.Flush; -- clear the optional adjust
-   if Sup.Inits_Called /= 1 then
-     -- C761003_0.Null_Global did not get "initialized"
-     C761003_0.Initialize(C761003_0.Null_Global);  -- prime the pump
-   end if;
- 
-   Subtest_1;
-   Sup.Validate(Subtest_1_Inits_Expected, 1);
- 
-   Subtest_2;
-   Sup.Validate(Subtest_2_Inits_Expected, 2);
- 
-   Subtest_3;
-   Sup.Validate(Subtest_3_Inits_Expected, 3);
- 
-   Subtest_4;
-   Sup.Validate(Subtest_4_Inits_Expected, 4);
- 
-   Subtest_5;
-   Sup.Validate(Subtest_5_Inits_Expected, 5, Check_Order => False);
- 
-   Subtest_6;
-   Sup.Validate(Subtest_6_Inits_Expected, 6);
- 
-   Report.Result;
- 
- end C761003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,305 ****
- -- C761004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an object of a controlled type is finalized with the
- --      enclosing master is complete.
- --      Check that finalization occurs in the case where the master is
- --      left by a transfer of control.
- --      Specifically check for types where the derived types do not have
- --      discriminants.
- --      
- --      Check that finalization of controlled objects is 
- --      performed in the correct order.  In particular, check that if 
- --      multiple objects of controlled types are declared immediately 
- --      within the same declarative part then they are finalized in the 
- --      reverse order of their creation.
- --
- -- TEST DESCRIPTION:
- --      This test checks these conditions for subprograms and 
- --      block statements; both variables and constants of controlled 
- --      types; cases of a controlled component of a record type, as 
- --      well as an array with controlled components.
- --
- --      The base controlled types used for the test are defined 
- --      with a character discriminant.  The initialize procedure for 
- --      the types will record the order of creation in a globally 
- --      accessible array, the finalize procedure for the types will call
- --      TCTouch with that tag character.  The test can then check that 
- --      the order of finalization is indeed the reverse of the order of 
- --      creation (assuming that the implementation calls Initialize in 
- --      the order that the objects are created).
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1
- --
- --! 
- 
- package C761004_Support is
-   
-   function Pick_Char return Character;
-   -- successive calls to Pick_Char return distinct characters which may
-   -- be assigned to objects to track an order sequence.  These characters
-   -- are then used in calls to TCTouch.Touch.
- 
-   procedure Validate(Initcount: Natural; Testnumber:Natural);
-   -- does a little extra processing prior to calling TCTouch.Validate,
-   -- specifically, it reverses the stored string of characters, and checks
-   -- for a correct count.
- 
-   Inits_Order  : String(1..255);
-   Inits_Called : Natural := 0;
- 
- end C761004_Support;
- 
- with Report;
- with TCTouch;
- package body C761004_Support is
-   type Pick_Rotation is mod 52;
-   type Pick_String is array(Pick_Rotation) of Character;
- 
-   From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-                                 & "abcdefghijklmnopqrstuvwxyz";
-   Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
- 
-   function Pick_Char return Character is
-   begin
-     Recent_Pick := Recent_Pick +1;
-     return From(Recent_Pick);
-   end Pick_Char;
- 
-   function Invert(S:String) return String is
-     T: String(1..S'Length);
-     TI: Positive := 1;
-   begin
-     for SI in reverse S'Range loop
-       T(TI) := S(SI);
-       TI := TI +1;
-     end loop;
-     return T;
-   end Invert;
- 
-   procedure Validate(Initcount: Natural; Testnumber:Natural) is
-     Number : constant String := Natural'Image(Testnumber);
-   begin
-     if Inits_Called /= Initcount then
-       Report.Failed("Wrong number of inits, Subtest " & Number);
-       TCTouch.Flush;
-     else
-       TCTouch.Validate(
-         Invert(Inits_Order(1..Inits_Called)),
-                "Subtest " & Number, True);
-     end if;
-   end Validate;
- 
- end C761004_Support;
- 
- ----------------------------------------------------------------- C761004_0
- 
- with Ada.Finalization;
- package C761004_0 is
-   type Global is new Ada.Finalization.Controlled with record
-     Tag : Character;
-   end record;
-   procedure Initialize( It: in out Global );
-   procedure Finalize  ( It: in out Global );
- 
-   type Second is new Ada.Finalization.Limited_Controlled with record
-     Tag : Character;
-   end record;
-   procedure Initialize( It: in out Second );
-   procedure Finalize  ( It: in out Second );
- 
- end C761004_0;
- 
- with TCTouch;
- with C761004_Support;
- package body C761004_0 is
-   
-   package Sup renames C761004_Support;
- 
-   procedure Initialize( It: in out Global ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     It.Tag := Sup.Pick_Char;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
-   
-   procedure Finalize( It: in out Global ) is
-   begin
-     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
-   end Finalize;
- 
-   procedure Initialize( It: in out Second ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     It.Tag := Sup.Pick_Char;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
-   
-   procedure Finalize( It: in out Second ) is
-   begin
-     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
-   end Finalize;
- end C761004_0;
- 
- ------------------------------------------------------------------- C761004
- 
- with Report;
- with TCTouch;
- with C761004_0;
- with C761004_Support;
- with Ada.Finalization; -- needed to be able to create extension aggregates
- procedure C761004 is
- 
-   Verbose : constant Boolean := False;
- 
-   package Sup renames C761004_Support;
- 
-   -- Subtest 1, general case.  Check that several objects declared in a
-   -- subprogram are created, and finalized in opposite order.
- 
-   Subtest_1_Expected_Inits : constant := 3;
- 
-   procedure Subtest_1 is
-     Item_1 : C761004_0.Global;
-     Item_2, Item_3 : C761004_0.Global;
-  begin
-     if Item_2.Tag = Item_3.Tag then  -- not germane to the test
-       Report.Failed("Duplicate tag");-- but helps prevent code elimination
-     end if;
-   end Subtest_1;
- 
-   -- Subtest 2, extension of the general case.  Check that several objects
-   -- created identically on the stack (via a recursive procedure) are
-   -- finalized in the opposite order of their creation.
-   Subtest_2_Expected_Inits : constant := 12;
-   User_Exception : exception;
-   
-   procedure Subtest_2 is
-     
-     Item_1 : C761004_0.Global;
- 
-     -- combine recursion and exit by exception:
- 
-     procedure Nested(Recurs: Natural) is
-       Item_3 : C761004_0.Global;
-     begin
-       if Verbose then
-         Report.Comment("going in: " & Item_3.Tag);
-       end if;
-       if Recurs = 1 then
-         raise User_Exception;
-       else
-         Nested(Recurs -1);
-       end if;
-     end Nested;
-     
-     Item_2 : C761004_0.Global;
-   
-   begin
-     Nested(10);
-   end Subtest_2;
- 
-   -- subtest 3, check the case of objects embedded in structures:
-   -- an array
-   -- a record
-   Subtest_3_Expected_Inits : constant := 3;
-   procedure Subtest_3 is
-     type G_List is array(Positive range <>) of C761004_0.Global;
-     type Pandoras_Box is record
-       G : G_List(1..1);
-     end record;
- 
-     procedure Nested(Recursions: Natural) is
-       Merlin : Pandoras_Box;
-     begin
-       if Recursions > 1 then
-         Nested(Recursions-1);
-       else
-         TCTouch.Validate("","Final Nested call");
-       end if;
-     end Nested;
- 
-   begin
-     Nested(3);
-   end Subtest_3;
- 
-   -- subtest 4, check the case of objects embedded in structures:
-   -- an array
-   -- a record
-   Subtest_4_Expected_Inits : constant := 3;
-   procedure Subtest_4 is
-     type S_List is array(Positive range <>) of C761004_0.Second;
-     type Pandoras_Box is record
-       S : S_List(1..1);
-     end record;
- 
-     procedure Nested(Recursions: Natural) is
-       Merlin : Pandoras_Box;
-     begin
-       if Recursions > 1 then
-         Nested(Recursions-1);
-       else
-         TCTouch.Validate("","Final Nested call");
-       end if;
-     end Nested;
- 
-   begin
-     Nested(3);
-   end Subtest_4;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C761004", "Check that an object of a controlled type "
-                         & "is finalized when the enclosing master is "
-                         & "complete, left by a transfer of control, "
-                         & "and performed in the correct order" );
- 
-   Subtest_1;
-   Sup.Validate(Subtest_1_Expected_Inits,1); 
- 
-   Subtest_2_Frame: begin
-     Sup.Inits_Called := 0;
-     Subtest_2;
-   exception           
-     when User_Exception => null;
-     when others => Report.Failed("Wrong Exception, Subtest 2");
-   end Subtest_2_Frame;
-   Sup.Validate(Subtest_2_Expected_Inits,2);
-   
-   Sup.Inits_Called := 0;
-   Subtest_3;
-   Sup.Validate(Subtest_3_Expected_Inits,3);
-   
-   Sup.Inits_Called := 0;
-   Subtest_4;
-   Sup.Validate(Subtest_4_Expected_Inits,4);
-   
-   Report.Result;
- 
- end C761004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,288 ****
- -- C761005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that deriving abstract types from the types in Ada.Finalization
- --      does not negatively impact the implicit operations.
- --      Check that an object of a controlled type is finalized when the
- --      enclosing master is complete.
- --      Check that finalization occurs in the case where the master is
- --      left by a transfer of control.
- --      Check this for controlled types where the derived type has a
- --      discriminant.
- --      Check this for cases where the type is defined as private,  
- --      and the full type is derived from the types in Ada.Finalization.
- --      
- --      Check that finalization of controlled objects is 
- --      performed in the correct order.  In particular, check that if 
- --      multiple objects of controlled types are declared immediately 
- --      within the same declarative part then type are finalized in the 
- --      reverse order of their creation.
- --
- -- TEST DESCRIPTION:
- --      This test checks these conditions for subprograms and 
- --      block statements; both variables and constants of controlled 
- --      types; cases of a controlled component of a record type, as 
- --      well as an array with controlled components.
- --
- --      The base controlled types used for the test are defined 
- --      with a character discriminant.  The initialize procedure for 
- --      the types will record the order of creation in a globally 
- --      accessible array, the finalize procedure for the types will call
- --      TCTouch with that tag character.  The test can then check that 
- --      the order of finalization is indeed the reverse of the order of 
- --      creation (assuming that the implementation calls Initialize in 
- --      the order that the objects are created).
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
- --
- --!
- 
- package C761005_Support is  
-   
-   function Pick_Char return Character;
-   procedure Validate(Initcount: Natural; Testnumber:Natural);
- 
-   Inits_Order  : String(1..255);
-   Inits_Called : Natural := 0;
- 
- end C761005_Support;
- 
- with Report;
- with TCTouch;
- package body C761005_Support is
-   type Pick_Rotation is mod 52;
-   type Pick_String is array(Pick_Rotation) of Character;
- 
-   From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-                                 & "abcdefghijklmnopqrstuvwxyz";
-   Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
- 
-   function Pick_Char return Character is
-   begin
-     Recent_Pick := Recent_Pick +1;
-     return From(Recent_Pick);
-   end Pick_Char;
- 
-   function Invert(S:String) return String is
-     T: String(1..S'Length);
-     TI: Positive := 1;
-   begin
-     for SI in reverse S'Range loop
-       T(TI) := S(SI);
-       TI := TI +1;
-     end loop;
-     return T;
-   end Invert;
- 
-   procedure Validate(Initcount: Natural; Testnumber:Natural) is
-     Number : constant String := Natural'Image(Testnumber);
-   begin
-     if Inits_Called /= Initcount then
-       Report.Failed("Wrong number of inits, Subtest " & Number);
-     else
-       TCTouch.Validate(
-         Invert(Inits_Order(1..Inits_Called)),
-                "Subtest " & Number, True);
-     end if;
-     Inits_Called := 0;
-   end Validate;
- 
- end C761005_Support;
- 
- -----------------------------------------------------------------------------
- with Ada.Finalization;
- package C761005_0 is
-   type Final_Root(Tag: Character) is private;
- 
-   type Ltd_Final_Root(Tag: Character) is limited private; 
-   
-   Inits_Order  : String(1..255);
-   Inits_Called : Natural := 0;
- private
-   type Final_Root(Tag: Character) is new Ada.Finalization.Controlled 
-     with null record;
-   procedure Initialize( It: in out Final_Root );
-   procedure Finalize  ( It: in out Final_Root );
-   
-   type Ltd_Final_Root(Tag: Character) is new
- Ada.Finalization.Limited_Controlled 
-     with null record;
-   procedure Initialize( It: in out Ltd_Final_Root );
-   procedure Finalize  ( It: in out Ltd_Final_Root );
- end C761005_0;
- 
- -----------------------------------------------------------------------------
- with Ada.Finalization;
- package C761005_1 is
-   type Final_Abstract is abstract tagged private;
- 
-   type Ltd_Final_Abstract_Child is abstract tagged limited private;
-   
-   Inits_Order  : String(1..255);
-   Inits_Called : Natural := 0;
- 
- private
-   type Final_Abstract is abstract new Ada.Finalization.Controlled with record
-     Tag: Character;
-   end record;
-   procedure Initialize( It: in out Final_Abstract );
-   procedure Finalize  ( It: in out Final_Abstract );
- 
-   type Ltd_Final_Abstract_Child is
-        abstract new Ada.Finalization.Limited_Controlled with record
-     Tag: Character;
-   end record;
-   procedure Initialize( It: in out Ltd_Final_Abstract_Child );
-   procedure Finalize  ( It: in out Ltd_Final_Abstract_Child );
- 
- end C761005_1;
- 
- -----------------------------------------------------------------------------
- with C761005_1;
- package C761005_2 is
-   
-   type Final_Child is new C761005_1.Final_Abstract with null record;
-   type Ltd_Final_Child is
-        new C761005_1.Ltd_Final_Abstract_Child with null record;
- 
- end C761005_2;
- 
- -----------------------------------------------------------------------------
- with Report;        
- with TCTouch;
- with C761005_Support;
- package body C761005_0 is
- 
-   package Sup renames C761005_Support;
- 
-   procedure Initialize( It: in out Final_Root ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
-   
-   procedure Finalize( It: in out Final_Root ) is
-   begin
-     TCTouch.Touch(It.Tag);
-   end Finalize;
- 
-   procedure Initialize( It: in out Ltd_Final_Root ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
-   
-   procedure Finalize( It: in out Ltd_Final_Root ) is
-   begin
-     TCTouch.Touch(It.Tag);
-   end Finalize;
- end C761005_0;
- 
- -----------------------------------------------------------------------------
- with Report;        
- with TCTouch;
- with C761005_Support;
- package body C761005_1 is
- 
-   package Sup renames C761005_Support;
- 
-   procedure Initialize( It: in out Final_Abstract ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     It.Tag := Sup.Pick_Char;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
-   
-   procedure Finalize( It: in out Final_Abstract ) is
-   begin
-     TCTouch.Touch(It.Tag);
-   end Finalize;
- 
-   procedure Initialize( It: in out Ltd_Final_Abstract_Child ) is
-   begin
-     Sup.Inits_Called := Sup.Inits_Called +1;
-     It.Tag := Sup.Pick_Char;
-     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
-   end Initialize;
-   
-   procedure Finalize( It: in out Ltd_Final_Abstract_Child ) is
-   begin
-     TCTouch.Touch(It.Tag);
-   end Finalize;
- end C761005_1;
- 
- -----------------------------------------------------------------------------
- with Report;
- with TCTouch;
- with C761005_0;
- with C761005_2;
- with C761005_Support;
- procedure C761005 is
- 
-   package Sup renames C761005_Support;
- 
-   Subtest_1_Inits_Expected : constant := 4;
-   procedure Subtest_1 is
-     Item_1 : C761005_0.Final_Root(Sup.Pick_Char);
-     Item_2, Item_3 : C761005_0.Final_Root(Sup.Pick_Char);
-     Item_4 : C761005_0.Ltd_Final_Root(Sup.Pick_Char);
-   begin
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 1 body");
-   end Subtest_1;
- 
-   -- These declarations should cause calls to initialize and
-   -- finalize.  The expected operations are the subprograms associated
-   -- with the abstract types.
-   Subtest_2_Inits_Expected : constant := 4;
-   procedure Subtest_2 is
-     Item_1 : C761005_2.Final_Child;
-     Item_2, Item_3 : C761005_2.Final_Child;
-     Item_4 : C761005_2.Ltd_Final_Child;
-   begin
-     -- check that nothing has happened yet!
-     TCTouch.Validate("","Subtest 2 body");
-   end Subtest_2;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C761005", "Check that an object of a controlled type "
-                         & "is finalized when the enclosing master is "
-                         & "complete, left by a transfer of control, "
-                         & "and performed in the correct order" );
- 
-   Subtest_1;
-   Sup.Validate(Subtest_1_Inits_Expected,1); 
-   
-   Subtest_2;
-   Sup.Validate(Subtest_2_Inits_Expected,2);
- 
-   Report.Result;
- 
- end C761005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,446 ****
- -- C761006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Program_Error is raised when:
- --        * an exception is raised if Finalize invoked as part of an
- --          assignment operation; or
- --        * an exception is raised if Adjust invoked as part of an assignment
- --          operation, after any other adjustment due to be performed are
- --          performed; or
- --        * an exception is raised if Finalize invoked as part of a call on
- --          Unchecked_Deallocation, after any other finalizations to be
- --          performed are performed.
- --
- -- TEST DESCRIPTION:
- --      This test defines these four controlled types:
- --        Good
- --        Bad_Initialize
- --        Bad_Adjust
- --        Bad_Finalize
- --      The type name conveys the associated failure.  The operations in type
- --      good will "touch" the boolean array indicating correct path
- --      utilization for the purposes of checking "other <operations> are
- --      performed", where <operations> ::= initialization, adjusting, and
- --      finalization
- --
- --
- --
- -- CHANGE HISTORY:
- --      12 APR 94   SAIC   Initial version
- --      02 MAY 96   SAIC   Visibility fixed for 2.1
- --      13 FEB 97   PWB.CTA Corrected value of Events_Occurring at line 286
- --      01 DEC 97   EDS    Made correction wrt RM 7.6(21)
- --      16 MAR 01   RLB    Corrected Adjust cases to avoid problems with
- --                         RM 7.6.1(16/1) from Technical Corrigendum 1.
- --      05 JUL 12   RLB    Redid Unchecked_Deallocation case to handle
- --                         the fact that the behavior is unspecified (see
- --                         AI95-0179-1). Also fixed indentation.
- --
- --!
- 
- ------------------------------------------------------------- C761006_Support
- 
- package C761006_Support is
- 
-   type Events is ( Good_Initialize, Good_Adjust, Good_Finalize );
- 
-   type Event_Array is array(Events) of Boolean;
- 
-   Events_Occurring : Event_Array := (others => False);
- 
-   Propagating_Exception : exception;
- 
-   procedure Raise_Propagating_Exception(Do_It: Boolean);
- 
-   function Unique_Value return Natural;
- 
- end C761006_Support;
- 
- ------------------------------------------------------------- C761006_Support
- 
- with Report;
- package body C761006_Support is
- 
-   procedure Raise_Propagating_Exception(Do_It: Boolean) is
-   begin
-      if Report.Ident_Bool(Do_It) then
-        raise Propagating_Exception;
-      end if;
-   end Raise_Propagating_Exception;
- 
-   Seed : Natural := 0;
- 
-   function Unique_Value return Natural is
-   begin
-     Seed := Seed +1;
-     return Seed;
-   end Unique_Value;
- 
- end C761006_Support;
- 
- ------------------------------------------------------------------- C761006_0
- 
- with Ada.Finalization;
- with C761006_Support;
- package C761006_0 is
- 
-   type Good is new Ada.Finalization.Controlled
-     with record
-       Initialized : Boolean := False;
-       Adjusted    : Boolean := False;
-       Unique      : Natural := C761006_Support.Unique_Value;
-     end record;
- 
-   procedure Initialize( It: in out Good );
-   procedure Adjust    ( It: in out Good );
-   procedure Finalize  ( It: in out Good );
- 
-   type Bad_Initialize is private;
- 
-   type Bad_Adjust     is private;
- 
-   type Bad_Finalize   is private;
- 
-   Inits_Order  : String(1..255);
-   Inits_Called : Natural := 0;
- private
-   type Bad_Initialize is new Ada.Finalization.Controlled
-                                              with null record;
-   procedure Initialize( It: in out Bad_Initialize );
- 
-   type Bad_Adjust is new Ada.Finalization.Controlled
-                                          with null record;
-   procedure Adjust    ( It: in out Bad_Adjust );
- 
-   type Bad_Finalize is
-        new Ada.Finalization.Controlled with null record;
-   procedure Finalize  ( It: in out Bad_Finalize );
- end C761006_0;
- 
- ------------------------------------------------------------------- C761006_1
- 
- with Ada.Finalization;
- with C761006_0;
- package C761006_1 is
- 
-   type Init_Check_Root is new Ada.Finalization.Controlled with record
-     Good_Component : C761006_0.Good;
-     Init_Fails     : C761006_0.Bad_Initialize;
-   end record;
- 
-   type Adj_Check_Root is new Ada.Finalization.Controlled with record
-     Good_Component : C761006_0.Good;
-     Adj_Fails      : C761006_0.Bad_Adjust;
-   end record;
- 
-   type Fin_Check_Root is new Ada.Finalization.Controlled with record
-     Good_Component : C761006_0.Good;
-     Fin_Fails      : C761006_0.Bad_Finalize;
-   end record;
- 
- end C761006_1;
- 
- ------------------------------------------------------------------- C761006_2
- 
- with C761006_1;
- package C761006_2 is
- 
-   type Init_Check is new C761006_1.Init_Check_Root with null record;
-   type Adj_Check is  new C761006_1.Adj_Check_Root  with null record;
-   type Fin_Check is  new C761006_1.Fin_Check_Root  with null record;
- 
- end C761006_2;
- 
- ------------------------------------------------------------------- C761006_0
- 
- with Report;
- with C761006_Support;
- package body C761006_0 is
- 
-   package Sup renames C761006_Support;
- 
-   procedure Initialize( It: in out Good ) is
-   begin
-     Sup.Events_Occurring( Sup.Good_Initialize ) := True;
-     It.Initialized := True;
-   end Initialize;
- 
-   procedure Adjust    ( It: in out Good ) is
-   begin
-     Sup.Events_Occurring( Sup.Good_Adjust ) := True;
-     It.Adjusted := True;
-     It.Unique := C761006_Support.Unique_Value;
-   end Adjust;
- 
-   procedure Finalize  ( It: in out Good ) is
-   begin
-     Sup.Events_Occurring( Sup.Good_Finalize ) := True;
-   end Finalize;
- 
-   procedure Initialize( It: in out Bad_Initialize ) is
-   begin
-     Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
-   end Initialize;
- 
-   procedure Adjust( It: in out Bad_Adjust ) is
-   begin
-     Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
-   end Adjust;
- 
-   procedure Finalize( It: in out Bad_Finalize ) is
-   begin
-     Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
-   end Finalize;
- 
- end C761006_0;
- 
- --------------------------------------------------------------------- C761006
- 
- with Report;
- with C761006_0;
- with C761006_2;
- with C761006_Support;
- with Ada.Exceptions;
- with Ada.Finalization;
- with Unchecked_Deallocation;
- procedure C761006 is
- 
-   package Sup renames C761006_Support;
-   use type Sup.Event_Array;
- 
-   type Procedure_Handle is access procedure;
- 
-   type Test_ID is ( Simple, Initialize, Adjust, Finalize );
- 
-   Sub_Tests : array(Test_ID) of Procedure_Handle;
- 
-   procedure Simple_Test is
-     A_Good_Object : C761006_0.Good; -- should call Initialize
-   begin
-     if not A_Good_Object.Initialized then
-       Report.Failed("Good object not initialized");
-     end if;
- 
-     -- should call Adjust
-     A_Good_Object := ( Ada.Finalization.Controlled
-                        with Unique => 0, others => False );
-     if not A_Good_Object.Adjusted then
-       Report.Failed("Good object not adjusted");
-     end if;
- 
-     -- should call Finalize before end of scope
-   end Simple_Test;
- 
-   procedure Initialize_Test is
-   begin
-     declare
-       This_Object_Fails_In_Initialize : C761006_2.Init_Check;
-     begin
-       Report.Failed("Exception in Initialize did not occur");
-     exception
-       when others =>
-         Report.Failed("Initialize caused exception at wrong lex");
-     end;
- 
-     Report.Failed("Error in execution sequence");
- 
-   exception
-     when Sup.Propagating_Exception => -- this is correct
-       if not Sup.Events_Occurring(Sup.Good_Initialize) then
-         Report.Failed("Initialization of Good Component did not occur");
-       end if;
-   end Initialize_Test;
- 
-   procedure Adjust_Test is
-     This_Object_OK     : C761006_2.Adj_Check;
-     This_Object_Target : C761006_2.Adj_Check;
-   begin
- 
-     Check_Adjust_Due_To_Assignment: begin
-       This_Object_Target := This_Object_OK;
-       Report.Failed("Adjust did not propagate any exception");
-     exception
-       when Program_Error =>  -- expected case
-              if not This_Object_Target.Good_Component.Adjusted then
-                Report.Failed("other adjustment not performed");
-              end if;
-       when others =>
-              Report.Failed("Adjust propagated wrong exception");
-     end Check_Adjust_Due_To_Assignment;
- 
-     C761006_Support.Events_Occurring := (True, False, False);
- 
-     Check_Adjust_Due_To_Initial_Assignment: declare
-       Another_Target : C761006_2.Adj_Check := This_Object_OK;
-     begin
-       Report.Failed("Adjust did not propagate any exception");
-     exception
-       when others => Report.Failed("Adjust caused exception at wrong lex");
-     end Check_Adjust_Due_To_Initial_Assignment;
- 
-   exception
-     when Program_Error =>  -- expected case
-            if Sup.Events_Occurring(Sup.Good_Finalize) /=
-               Sup.Events_Occurring(Sup.Good_Adjust) then
-               -- RM 7.6.1(16/1) says that the good Adjust may or may not
-               -- be performed; but if it is, then the Finalize must be
-               -- performed; and if it is not, then the Finalize must not
-               -- performed.
-               if Sup.Events_Occurring(Sup.Good_Finalize) then
-                  Report.Failed("Good adjust not performed with bad adjust, " &
-                                "but good finalize was");
-               else
-                  Report.Failed("Good adjust performed with bad adjust, " &
-                                "but good finalize was not");
-               end if;
-            end if;
-     when others =>
-            Report.Failed("Adjust propagated wrong exception");
-   end Adjust_Test;
- 
-   procedure Finalize_Test is
- 
-     Fin_Not_Perf : constant String := "other finalizations not performed";
- 
-     procedure Finalize_15 is
-       Item   : C761006_2.Fin_Check;
-       Target : C761006_2.Fin_Check;
-     begin
- 
-       Item := Target;
-       -- finalization of Item should cause PE
-       -- ARM7.6:21 allows the implementation to omit the assignment of the
-       -- value into an anonymous object, which is the point at which Adjust
-       -- is normally called.  However, this would result in Program_Error's
-       -- being raised before the call to Adjust, with the consequence that
-       -- Adjust is never called.
- 
-     exception
-       when Program_Error => -- expected case
-              if not Sup.Events_Occurring(Sup.Good_Finalize) then
-                Report.Failed("Assignment: " & Fin_Not_Perf);
-              end if;
-       when others =>
-              Report.Failed("Other exception in Finalize_15");
- 
-     -- finalization of Item/Target should cause PE
-     end Finalize_15;
- 
-     -- check failure in finalize due to Unchecked_Deallocation
- 
-     procedure Finalize_17_Outer is
-       -- This procedure exists to make Shark local, so everything allocated
-       -- on it will be finalized when this routine exits.
- 
-       type Shark is access C761006_2.Fin_Check;
- 
-       procedure Catch is
-         new Unchecked_Deallocation( C761006_2.Fin_Check, Shark );
- 
-       procedure Finalize_17_Inner is
-         White : Shark := new C761006_2.Fin_Check;
-       begin
-         Catch (White);
-           -- Note: It is unspecified if Catch deallocates the memory
-           -- of the allocated object, and if it ceases to exist.
-           -- As such, it is possible that it will be finalized when
-           -- the scope of the access type is exited. We check for this
-           -- case below.
-       exception
-         when Program_Error =>
-            if not Sup.Events_Occurring(Sup.Good_Finalize) then
-              Report.Failed("Unchecked_Deallocation: " & Fin_Not_Perf);
-            end if;
-       end Finalize_17_Inner;
- 
-     begin
-        Finalize_17_Inner;
-     exception
-       when others =>
-         Report.Failed("Unchecked_Deallocation check, unwanted exception in Outer");
-     end Finalize_17_Outer;
- 
-   begin
- 
-     Exception_In_Finalization: begin
-       Finalize_15;
-     exception
-       when Program_Error => null; -- anticipated
-     end Exception_In_Finalization;
- 
-     Use_Of_Unchecked_Deallocation: begin
-       Finalize_17_Outer;
-     exception
-       when Program_Error =>
-         Report.Comment("Unchecked_Deallocation check, double finalization occurred");
-       when others =>
-         Report.Failed("Unchecked_Deallocation check, unwanted exception in caller");
-     end Use_Of_Unchecked_Deallocation;
- 
-   end Finalize_Test;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C761006", "Check that exceptions raised in Initialize, " &
-                           "Adjust and Finalize are processed correctly" );
- 
-   Sub_Tests := (Simple_Test'Access, Initialize_Test'Access,
-                 Adjust_Test'Access, Finalize_Test'Access);
- 
-   for Test in Sub_Tests'Range loop
-     begin
- 
-       Sup.Events_Occurring := (others => False);
- 
-       Sub_Tests(Test).all;
- 
-       case Test is
-         when Simple | Adjust =>
-           if Sup.Events_Occurring /= Sup.Event_Array ' ( others => True ) then
-             Report.Failed ( "Other operation missing in " &
-                             Test_ID'Image ( Test ) );
-           end if;
-         when  Initialize =>
-           null;
-         when Finalize  =>
-           -- Note that for Good_Adjust, we may get either True or False
-           if Sup.Events_Occurring ( Sup.Good_Initialize ) = False or
-              Sup.Events_Occurring ( Sup.Good_Finalize ) = False
-           then
-             Report.Failed ( "Other operation missing in " &
-                             Test_ID'Image ( Test ) );
-           end if;
-       end case;
- 
-     exception
-        when How: others => Report.Failed( Ada.Exceptions.Exception_Name( How )
-                                         & " from " & Test_ID'Image( Test ) );
-     end;
-   end loop;
- 
-   Report.Result;
- 
- end C761006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,419 ****
- -- C761007.A
- --
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a finalize procedure invoked by a transfer of control
- --      due to selection of a terminate alternative attempts to propagate an
- --      exception, the exception is ignored, but any other finalizations due
- --      to be performed are performed.
- --
- --
- -- TEST DESCRIPTION:
- --      This test declares a nested controlled data type, and embeds an object
- --      of that type within a protected type.  Objects of the protected type
- --      are created and destroyed, and the actions of the embedded controlled
- --      object are checked.  The container controlled type causes an exception
- --      as the last part of it's finalization operation.
- --
- --      This test utilizes several tasks to accomplish the objective.  The
- --      tasks contain delays to ensure that the expected order of processing
- --      is indeed accomplished.
- --
- --      Subtest 1:
- --        local task object runs to normal completion
- --
- --      Subtest 2:
- --        local task aborts a nested task to cause finalization
- --
- --      Subtest 3: 
- --        local task sleeps long enough to allow procedure started
- --        asynchronously to go into infinite loop.  Procedure is then aborted
- --        via ATC, causing finalization of objects.
- --
- --      Subtest 4:
- --        local task object takes terminate alternative, causing finalization
- --
- --
- -- CHANGE HISTORY:
- --      06 JUN 95   SAIC    Initial version
- --      05 APR 96   SAIC    Documentation changes
- --      03 MAR 97   PWB.CTA Allowed two finalization orders for ATC test
- --      02 DEC 97   EDS     Remove duplicate characters from check string.
- --!
- 
- ---------------------------------------------------------------- C761007_0
- 
- with Ada.Finalization;
- package C761007_0 is
- 
-   type Internal is new Ada.Finalization.Controlled
-     with record
-       Effect : Character;
-     end record;
- 
-   procedure Finalize( I: in out Internal );
- 
-   Side_Effect : String(1..80);  -- way bigger than needed
-   Side_Effect_Finger : Natural := 0;
- 
- end C761007_0;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body C761007_0 is
- 
-   procedure Finalize( I : in out Internal ) is
-     Previous_Side_Effect : Boolean := False;
-   begin
-     -- look to see if this character has been finalized yet
-     for SEI in 1..Side_Effect_Finger loop
-       Previous_Side_Effect := Previous_Side_Effect
-                               or Side_Effect(Side_Effect_Finger) = I.Effect;
-     end loop;
- 
-     -- if not, then tack it on to the string, and touch the character
-     if not Previous_Side_Effect then
-       Side_Effect_Finger := Side_Effect_Finger +1;
-       Side_Effect(Side_Effect_Finger) := I.Effect;
-       TCTouch.Touch(I.Effect);
-     end if;
- 
-   end Finalize;
- 
- end C761007_0;
- 
- ---------------------------------------------------------------- C761007_1
- 
- with C761007_0;
- with Ada.Finalization;
- package C761007_1 is
- 
-   type Container is new Ada.Finalization.Controlled
-     with record
-       Effect   : Character;
-       Content  : C761007_0.Internal;
-     end record;
- 
-   procedure Finalize( C: in out Container );
- 
-   Side_Effect : String(1..80);  -- way bigger than needed
-   Side_Effect_Finger : Natural := 0;
- 
-   This_Exception_Is_Supposed_To_Be_Ignored : exception;
- 
- end C761007_1;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body C761007_1 is
- 
-   procedure Finalize( C: in out Container ) is
-     Previous_Side_Effect : Boolean := False;
-   begin
-     -- look to see if this character has been finalized yet
-     for SEI in 1..Side_Effect_Finger loop
-       Previous_Side_Effect := Previous_Side_Effect
-                               or Side_Effect(Side_Effect_Finger) = C.Effect;
-     end loop;
- 
-     -- if not, then tack it on to the string, and touch the character
-     if not Previous_Side_Effect then
-       Side_Effect_Finger := Side_Effect_Finger +1;
-       Side_Effect(Side_Effect_Finger) := C.Effect;
-       TCTouch.Touch(C.Effect);
-     end if;
- 
-     raise This_Exception_Is_Supposed_To_Be_Ignored;
- 
-   end Finalize;
- 
- end C761007_1;
-  
- ---------------------------------------------------------------- C761007_2
- with C761007_1;
- package C761007_2 is
- 
-   protected type Prot_W_Fin_Obj is
-     procedure Set_Effects( Container, Filling: Character );
-   private
-     The_Data_Under_Test : C761007_1.Container;
-     -- finalization for this will occur when the Prot_W_Fin_Obj object
-     --  "goes out of existence" for whatever reason.
-   end Prot_W_Fin_Obj;
- 
- end C761007_2;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body C761007_2 is
- 
-   protected body Prot_W_Fin_Obj is
-     procedure Set_Effects( Container, Filling: Character ) is
-     begin
-       The_Data_Under_Test.Effect := Container;           -- A, etc.
-       The_Data_Under_Test.Content.Effect := Filling;     -- B, etc.
-     end Set_Effects;
-   end Prot_W_Fin_Obj;
- 
- end C761007_2;
- 
- ------------------------------------------------------------------ C761007
- 
- with Report;
- with Impdef;
- with TCTouch;
- with C761007_0;
- with C761007_1;
- with C761007_2;
- procedure C761007 is
- 
-   task type Subtests( Outer, Inner : Character) is
-     entry Ready;
-     entry Complete;
-   end Subtests;
- 
-   task body Subtests is
-     Local_Prot_W_Fin_Obj : C761007_2.Prot_W_Fin_Obj;
-   begin
-     Local_Prot_W_Fin_Obj.Set_Effects( Outer, Inner );
- 
-     accept Ready;
- 
-     select
-       accept Complete;
-     or terminate;       -- used in Subtest 4
-     end select;
-   exception
-     -- the exception caused by the finalization of Local_Prot_W_Fin_Obj
-     --  should never be visible to this scope.
-     when others => Report.Failed("Exception in a Subtest object "
-                                  & Outer & Inner);
-   end Subtests;
- 
-   procedure Subtest_1 is
-     -- check the case where "nothing special" happens.
- 
-     This_Subtest : Subtests( 'A', 'B' );
-   begin
- 
-     This_Subtest.Ready;
-     This_Subtest.Complete;
- 
-     while not This_Subtest'Terminated loop -- wait for finalization
-       delay Impdef.Clear_Ready_Queue;
-     end loop;
- 
-     -- in the finalization of This_Subtest, the controlled object embedded in
-     -- the Prot_W_Fin_Obj will finalize.  An exception is raised in the
-     -- container object, after "touching" it's tag character.
-     -- The finalization of the contained controlled object must be performed.
- 
- 
-     TCTouch.Validate( "AB", "Item embedded in task" );
- 
- 
-   exception
-     when others => Report.Failed("Undesirable exception in Subtest_1");
- 
-   end Subtest_1;
- 
-   procedure Subtest_2 is
-     -- check for explicit abort
- 
-     task Subtest_Task is
-       entry Complete;
-     end Subtest_Task;
- 
-     task body Subtest_Task is
- 
-       task Nesting;
-       task body Nesting is
-         Deep_Nesting : Subtests( 'E', 'F' );
-       begin
-         if Report.Ident_Bool( True ) then
-           -- controlled objects have been created in the elaboration of
-           -- Deep_Nesting.  Deep_Nesting must call the Set_Effects operation
-           -- in the Prot_W_Fin_Obj, and then hang waiting for the Complete
-           -- entry call.
-           Deep_Nesting.Ready;
-           abort Deep_Nesting;
-         else
-           Report.Failed("Dead code in Nesting");
-         end if;
-       exception
-         when others => Report.Failed("Exception in Subtest_Task.Nesting");
-       end Nesting;
- 
-       Local_2 : C761007_2.Prot_W_Fin_Obj;
- 
-     begin
-       -- Nesting has activated at this point, which implies the activation
-       -- of Deep_Nesting as well.
- 
-       Local_2.Set_Effects( 'C', 'D' );
- 
-       -- wait for Nesting to terminate
- 
-       while not Nesting'Terminated loop
-         delay Impdef.Clear_Ready_Queue;
-       end loop;
- 
-       accept Complete;
- 
-     exception
-       when others => Report.Failed("Exception in Subtest_Task");
-     end Subtest_Task;
- 
-   begin
- 
-     -- wait for everything in Subtest_Task to happen
-     Subtest_Task.Complete;
- 
-     while not Subtest_Task'Terminated loop -- wait for finalization
-       delay Impdef.Clear_Ready_Queue;
-     end loop;
- 
-     TCTouch.Validate( "EFCD", "Aborted nested task" );
- 
-   exception
-     when others => Report.Failed("Undesirable exception in Subtest_2");
-   end Subtest_2;
- 
-   procedure Subtest_3 is
-     -- check abort caused by asynchronous transfer of control
- 
-     task Subtest_3_Task is
-       entry Complete;
-     end Subtest_3_Task;
- 
-     procedure Check_Atc_Operation is
-       Check_Atc : C761007_2.Prot_W_Fin_Obj;
-     begin
- 
-       Check_Atc.Set_Effects( 'G', 'H' );
- 
- 
-       while Report.Ident_Bool( True ) loop -- wait to be aborted
-         if Report.Ident_Bool( True ) then
-           Impdef.Exceed_Time_Slice;
-           delay Impdef.Switch_To_New_Task;
-         else
-           Report.Failed("Optimization prevention");
-         end if;
-       end loop;
- 
-       Report.Failed("Check_Atc_Operation loop completed");
- 
-     end Check_Atc_Operation;
- 
-     task body Subtest_3_Task is
-       task Nesting is
-         entry Complete;
-       end Nesting;
- 
-       task body Nesting is
-         Nesting_3 : C761007_2.Prot_W_Fin_Obj;
-       begin
-         Nesting_3.Set_Effects( 'G', 'H' );
- 
-         -- give Check_Atc_Operation sufficient time to perform it's
-         -- Set_Effects on it's local Prot_W_Fin_Obj object
-         delay Impdef.Clear_Ready_Queue;
- 
-         accept Complete;
-       exception
-         when others => Report.Failed("Exception in Subtest_3_Task.Nesting");
-       end Nesting;
- 
-       Local_3 : C761007_2.Prot_W_Fin_Obj;
- 
-     begin -- Subtest_3_Task
- 
-       Local_3.Set_Effects( 'I', 'J' );
- 
-       select
-         Nesting.Complete;
-       then abort ---------------------------------------------------- cause KL
-         Check_ATC_Operation;
-       end select;
- 
-       accept Complete;
- 
-     exception
-       when others => Report.Failed("Exception in Subtest_3_Task");
-     end Subtest_3_Task;
- 
-   begin -- Subtest_3
-     Subtest_3_Task.Complete;
- 
-     while not Subtest_3_Task'Terminated loop -- wait for finalization
-       delay Impdef.Clear_Ready_Queue;
-     end loop;
- 
-     TCTouch.Validate( "GHIJ", "Asynchronously aborted operation" );
- 
-   exception
-     when others => Report.Failed("Undesirable exception in Subtest_3");
-   end Subtest_3;
- 
-   procedure Subtest_4 is
-     -- check the case where transfer is caused by terminate alternative
-     -- highly similar to Subtest_1
- 
-     This_Subtest : Subtests( 'M', 'N' );
-   begin
- 
-     This_Subtest.Ready;
-     -- don't call This_Subtest.Complete;
- 
-   exception
-     when others => Report.Failed("Undesirable exception in Subtest_4");
- 
-   end Subtest_4;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C761007", "Check that if a finalize procedure invoked by " &
-                           "a transfer of control or selection of a " &
-                           "terminate alternative attempts to propagate " &
-                           "an exception, the exception is ignored, but " &
-                           "any other finalizations due to be performed " &
-                           "are performed" );
- 
-   Subtest_1;  -- checks internal
- 
-   Subtest_2;  -- checks internal
- 
-   Subtest_3;  -- checks internal
- 
-   Subtest_4;
-   TCTouch.Validate( "MN", "transfer due to terminate alternative" );
- 
-   Report.Result;
- 
- end C761007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,447 ****
- -- C761010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check the requirements of the new 7.6(17.1/1) from Technical
- --     Corrigendum 1 (originally discussed as AI95-00083).
- --     This new paragraph requires that the initialization of an object with
- --     an aggregate does not involve calls to Adjust.
- --
- -- TEST DESCRIPTION
- --     We include several cases of initialization:
- --        - Explicit initialization of an object declared by an
- --          object declaration.
- --        - Explicit initialization of a heap object.
- --        - Default initialization of a record component.
- --        - Initialization of a formal parameter during a call.
- --        - Initialization of a formal parameter during a call with
- --          a defaulted parameter.
- --        - Lots of nested records, arrays, and pointers.
- --     In this test, Initialize should never be called, because we
- --     never declare a default-initialized controlled object (although
- --     we do declare default-initialized records containing controlled
- --     objects, with default expressions for the components).
- --     Adjust should never be called, because every initialization
- --     is via an aggregate.  Finalize is called, because the objects
- --     themselves need to be finalized.
- --     Thus, Initialize and Adjust call Failed.
- --     In some of the cases, these procedures will not yet be elaborated,
- --     anyway.
- --
- -- CHANGE HISTORY:
- --      29 JUN 1999   RAD   Initial Version
- --      23 SEP 1999   RLB   Improved comments, renamed, issued.
- --      10 APR 2000   RLB   Corrected errors in comments and text, fixed
- --                          discriminant error. Fixed so that Report.Test
- --                          is called before any Report.Failed call. Added
- --                          a marker so that the failed subtest can be
- --                          determined.
- --      26 APR 2000   RAD   Try to defeat optimizations.
- --      04 AUG 2000   RLB   Corrected error in Check_Equal.
- --      18 AUG 2000   RLB   Removed dubious main subprogram renames (see AI-172).
- --      19 JUL 2002   RLB   Fixed to avoid calling comment after Report.Result.
- --
- --!
- 
- with Ada; use Ada;
- with Report; use Report; pragma Elaborate_All(Report);
- with Ada.Finalization;
- package C761010_1 is
-     pragma Elaborate_Body;
-     function Square(X: Integer) return Integer;
- private
-     type TC_Control is new Ada.Finalization.Limited_Controlled with null record;
-     procedure Initialize (Object : in out TC_Control);
-     procedure Finalize (Object : in out TC_Control);
-     TC_Finalize_Called : Boolean := False;
- end C761010_1;
- 
- package body C761010_1 is
-     function Square(X: Integer) return Integer is
-     begin
-         return X**2;
-     end Square;
- 
-     procedure Initialize (Object : in out TC_Control) is
-     begin
-         Test("C761010_1",
-              "Check that Adjust is not called"
-               & " when aggregates are used to initialize objects");
-     end Initialize;
- 
-     procedure Finalize (Object : in out TC_Control) is
-     begin
-         if not TC_Finalize_Called then
-             Failed("Var_Strings Finalize never called");
-         end if;
-         Result;
-     end Finalize;
- 
-     TC_Test : TC_Control; -- Starts test; finalization ends test.
- end C761010_1;
- 
- with Ada.Finalization;
- package C761010_1.Var_Strings is
-     type Var_String(<>) is private;
- 
-     Some_String: constant Var_String;
- 
-     function "=" (X, Y: Var_String) return Boolean;
- 
-     procedure Check_Equal(X, Y: Var_String);
-         -- Calls to this are used to defeat optimizations
-         -- that might otherwise defeat the purpose of the
-         -- test.  I'm talking about the optimization of removing
-         -- unused controlled objects.
- 
- private
- 
-     type String_Ptr is access constant String;
- 
-     type Var_String(Length: Natural) is new Finalization.Controlled with
-         record
-             Comp_1: String_Ptr := new String'(2..Square(Length)-1 => 'x');
-             Comp_2: String_Ptr(1..Length) := null;
-             Comp_3: String(Length..Length) := (others => '.');
-             TC_Lab: Character := '1';
-         end record;
-     procedure Initialize(X: in out Var_String);
-     procedure Adjust(X: in out Var_String);
-     procedure Finalize(X: in out Var_String);
- 
-     Some_String: constant Var_String
-       := (Finalization.Controlled with Length => 1,
-           Comp_1 => null,
-           Comp_2 => null,
-           Comp_3 => "x",
-           TC_Lab => 'A');
- 
-     Another_String: constant Var_String
-       := (Finalization.Controlled with Length => 10,
-           Comp_1 => Some_String.Comp_2,
-           Comp_2 => new String'("1234567890"),
-           Comp_3 => "x",
-           TC_Lab => 'B');
- 
- end C761010_1.Var_Strings;
- 
- package C761010_1.Var_Strings.Types is
- 
-     type Ptr is access all Var_String;
-     Ptr_Const: constant Ptr;
- 
-     type Ptr_Arr is array(Positive range <>) of Ptr;
-     Ptr_Arr_Const: constant Ptr_Arr;
- 
-     type Ptr_Rec(N_Strings: Natural) is
-         record
-             Ptrs: Ptr_Arr(1..N_Strings);
-         end record;
-     Ptr_Rec_Const: constant Ptr_Rec;
- 
- private
- 
-     Ptr_Const: constant Ptr := new Var_String'
-       (Finalization.Controlled with
-        Length => 1,
-        Comp_1 => null,
-        Comp_2 => null,
-        Comp_3 => (others => ' '),
-        TC_Lab => 'C');
- 
-     Ptr_Arr_Const: constant Ptr_Arr :=
-       (1 => new Var_String'
-        (Finalization.Controlled with
-         Length => 1,
-         Comp_1 => new String'("abcdefghij"),
-         Comp_2 => null,
-         Comp_3 => (2..2 => ' '),
-         TC_Lab => 'D'));
- 
-     Ptr_Rec_Var: Ptr_Rec :=
-       (3,
-        (1..2 => null,
-         3 => new Var_String'
-         (Finalization.Controlled with
-          Length => 2,
-          Comp_1 => new String'("abcdefghij"),
-          Comp_2 => null,
-          Comp_3 => (2..2 => ' '),
-          TC_Lab => 'E')));
- 
-     Ptr_Rec_Const: constant Ptr_Rec :=
-       (3,
-        (1..2 => null,
-         3 => new Var_String'
-         (Finalization.Controlled with
-          Length => 2,
-          Comp_1 => new String'("abcdefghij"),
-          Comp_2 => null,
-          Comp_3 => (2..2 => ' '),
-          TC_Lab => 'F')));
- 
-     type Arr is array(Positive range <>) of Var_String(Length => 2);
- 
-     Arr_Var: Arr :=
-       (1 => (Finalization.Controlled with
-          Length => 2,
-          Comp_1 => new String'("abcdefghij"),
-          Comp_2 => null,
-          Comp_3 => (2..2 => ' '),
-          TC_Lab => 'G'));
- 
-     type Rec(N_Strings: Natural) is
-         record
-             Ptrs: Ptr_Rec(N_Strings);
-             Strings: Arr(1..N_Strings) :=
-               (others =>
-                  (Finalization.Controlled with
-                   Length => 2,
-                   Comp_1 => new String'("abcdefghij"),
-                   Comp_2 => null,
-                   Comp_3 => (2..2 => ' '),
-                   TC_Lab => 'H'));
-         end record;
- 
-     Default_Init_Rec_Var: Rec(N_Strings => 10);
-     Empty_Default_Init_Rec_Var: Rec(N_Strings => 0);
- 
-     Rec_Var: Rec(N_Strings => 2) :=
-       (N_Strings => 2,
-        Ptrs =>
-          (2,
-           (1..1 => null,
-            2 => new Var_String'
-            (Finalization.Controlled with
-             Length => 2,
-             Comp_1 => new String'("abcdefghij"),
-             Comp_2 => null,
-             Comp_3 => (2..2 => ' '),
-             TC_Lab => 'J'))),
-        Strings =>
-          (1 =>
-             (Finalization.Controlled with
-              Length => 2,
-              Comp_1 => new String'("abcdefghij"),
-              Comp_2 => null,
-              Comp_3 => (2..2 => ' '),
-              TC_Lab => 'K'),
-           others =>
-             (Finalization.Controlled with
-              Length => 2,
-              Comp_1 => new String'("abcdefghij"),
-              Comp_2 => null,
-              Comp_3 => (2..2 => ' '),
-              TC_Lab => 'L')));
- 
-     procedure Check_Equal(X, Y: Rec);
- 
- end C761010_1.Var_Strings.Types;
- 
- package body C761010_1.Var_Strings.Types is
- 
-     -- Check that parameter passing doesn't create new objects,
-     -- and therefore doesn't need extra Adjusts or Finalizes.
- 
-     procedure Check_Equal(X, Y: Rec) is
-         -- We assume that the arguments should be equal.
-         -- But we cannot assume that pointer values are the same.
-     begin
-         if X.N_Strings /= Y.N_Strings then
-             Failed("Records should be equal (1)");
-         else
-             for I in 1 .. X.N_Strings loop
-                 if X.Ptrs.Ptrs(I) /= Y.Ptrs.Ptrs(I) then
-                     if X.Ptrs.Ptrs(I) = null or else
-                        Y.Ptrs.Ptrs(I) = null or else
-                        X.Ptrs.Ptrs(I).all /= Y.Ptrs.Ptrs(I).all then
-                        Failed("Records should be equal (2)");
-                     end if;
-                 end if;
-                 if X.Strings(I) /= Y.Strings(I) then
-                     Failed("Records should be equal (3)");
-                 end if;
-             end loop;
-         end if;
-     end Check_Equal;
- 
-     procedure My_Check_Equal
-               (X: Rec := Rec_Var;
-                Y: Rec :=
-       (N_Strings => 2,
-        Ptrs =>
-          (2,
-           (1..1 => null,
-            2 => new Var_String'
-            (Finalization.Controlled with
-             Length => 2,
-             Comp_1 => new String'("abcdefghij"),
-             Comp_2 => null,
-             Comp_3 => (2..2 => ' '),
-             TC_Lab => 'M'))),
-        Strings =>
-          (1 =>
-             (Finalization.Controlled with
-              Length => 2,
-              Comp_1 => new String'("abcdefghij"),
-              Comp_2 => null,
-              Comp_3 => (2..2 => ' '),
-              TC_Lab => 'N'),
-           others =>
-             (Finalization.Controlled with
-              Length => 2,
-              Comp_1 => new String'("abcdefghij"),
-              Comp_2 => null,
-              Comp_3 => (2..2 => ' '),
-              TC_Lab => 'O'))))
-               renames Check_Equal;
- begin
- 
-     My_Check_Equal;
- 
-     Check_Equal(Rec_Var,
-       (N_Strings => 2,
-        Ptrs =>
-          (2,
-           (1..1 => null,
-            2 => new Var_String'
-            (Finalization.Controlled with
-             Length => 2,
-             Comp_1 => new String'("abcdefghij"),
-             Comp_2 => null,
-             Comp_3 => (2..2 => ' '),
-             TC_Lab => 'P'))),
-        Strings =>
-          (1 =>
-             (Finalization.Controlled with
-              Length => 2,
-              Comp_1 => new String'("abcdefghij"),
-              Comp_2 => null,
-              Comp_3 => (2..2 => ' '),
-              TC_Lab => 'Q'),
-           others =>
-             (Finalization.Controlled with
-              Length => 2,
-              Comp_1 => new String'("abcdefghij"),
-              Comp_2 => null,
-              Comp_3 => (2..2 => ' '),
-              TC_Lab => 'R'))));
- 
-     -- Use the objects to avoid optimizations.
- 
-     Check_Equal(Ptr_Const.all, Ptr_Const.all);
-     Check_Equal(Ptr_Arr_Const(1).all, Ptr_Arr_Const(1).all);
-     Check_Equal(Ptr_Rec_Const.Ptrs(Ptr_Rec_Const.N_Strings).all,
-                 Ptr_Rec_Const.Ptrs(Ptr_Rec_Const.N_Strings).all);
-     Check_Equal(Ptr_Rec_Var.Ptrs(Ptr_Rec_Var.N_Strings).all,
-                 Ptr_Rec_Var.Ptrs(Ptr_Rec_Var.N_Strings).all);
- 
-     if Report.Equal (3, 2) then
-        -- Can't get here.
-        Check_Equal (Arr_Var(1), Default_Init_Rec_Var.Strings(1));
-        Check_Equal (Arr_Var(1), Empty_Default_Init_Rec_Var.Strings(1));
-     end if;
- 
- end C761010_1.Var_Strings.Types;
- 
- with C761010_1.Var_Strings;
- with C761010_1.Var_Strings.Types;
- procedure C761010_1.Main is
- begin
-     -- Report.Test is called by the elaboration of C761010_1, and
-     -- Report.Result is called by the finalization of C761010_1.
-     -- This will happen before any objects are created, and after any
-     -- are finalized.
-     null;
- end C761010_1.Main;
- 
- with C761010_1.Main;
- procedure C761010 is
- begin
-     C761010_1.Main;
- end C761010;
- 
- package body C761010_1.Var_Strings is
- 
-     Some_Error: exception;
- 
-     procedure Initialize(X: in out Var_String) is
-     begin
-         Failed("Initialize should never be called");
-         raise Some_Error;
-     end Initialize;
- 
-     procedure Adjust(X: in out Var_String) is
-     begin
-         Failed("Adjust should never be called - case " & X.TC_Lab);
-         raise Some_Error;
-     end Adjust;
- 
-     procedure Finalize(X: in out Var_String) is
-     begin
-         Comment("Finalize called - case " & X.TC_Lab);
- 	C761010_1.TC_Finalize_Called := True;
-     end Finalize;
- 
-     function "=" (X, Y: Var_String) return Boolean is
-         -- Don't check the TC_Lab component, but do check the contents of the
- 	-- access values.
-     begin
-         if X.Length /= Y.Length then
-             return False;
-         end if;
-         if X.Comp_3 /= Y.Comp_3 then
-             return False;
-         end if;
-         if X.Comp_1 /= Y.Comp_1 then
-             -- Still OK if the values are the same.
-             if X.Comp_1 = null or else
-                Y.Comp_1 = null or else
-                X.Comp_1.all /= Y.Comp_1.all then
-                return False;
-             --else OK.
-             end if;
-         end if;
-         if X.Comp_2 /= Y.Comp_2 then
-             -- Still OK if the values are the same.
-             if X.Comp_2 = null or else
-                Y.Comp_2 = null or else
-                X.Comp_2.all /= Y.Comp_2.all then
-                return False;
-             end if;
-         end if;
-         return True;
-     end "=";
- 
-     procedure Check_Equal(X, Y: Var_String) is
-     begin
-         if X /= Y then
-             Failed("Check_Equal of Var_String");
-         end if;
-     end Check_Equal;
- 
- begin
-     Check_Equal(Another_String, Another_String);
- end C761010_1.Var_Strings;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,410 ****
- -- C761011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that if a Finalize propagates an exception, other Finalizes due
- --    to be performed are performed.
- --        Case 1: A Finalize invoked due to the end of execution of
- --        a master. (Defect Report 8652/0023, as reflected in Technical
- --        Corrigendum 1).
- --        Case 2: A Finalize invoked due to finalization of an anonymous
- --        object. (Defect Report 8652/0023, as reflected in Technical
- --        Corrigendum 1).
- --        Case 3: A Finalize invoked due to the transfer of control
- --        due to an exit statement.
- --        Case 4: A Finalize invoked due to the transfer of control
- --        due to a goto statement.
- --        Case 5: A Finalize invoked due to the transfer of control
- --        due to a return statement.
- --        Case 6: A Finalize invoked due to the transfer of control
- --        due to raises an exception.
- --
- --
- -- CHANGE HISTORY:
- --    29 JAN 2001   PHL   Initial version
- --    15 MAR 2001   RLB   Readied for release; added optimization blockers.
- --                        Added test cases for paragraphs 18 and 19 of the
- --                        standard (the previous tests were withdrawn).
- --
- --!
- with Ada.Finalization;
- use Ada.Finalization;
- package C761011_0 is
- 
-     type Ctrl (D : Boolean) is new Ada.Finalization.Controlled with
-         record
-             Finalized : Boolean := False;
-             case D is
-                 when False =>
-                     C1 : Integer;
-                 when True =>
-                     C2 : Float;
-             end case;
-         end record;
- 
-     function Create (Id : Integer) return Ctrl;
-     procedure Finalize (Obj : in out Ctrl);
-     function Was_Finalized (Id : Integer) return Boolean;
-     procedure Use_It (Obj : in Ctrl);
-        -- Use Obj to prevent optimization.
- 
- end C761011_0;
- 
- with Report;
- use Report;
- package body C761011_0 is
- 
-     User_Error : exception;
- 
-     Finalize_Called : array (0 .. 50) of Boolean := (others => False);
- 
-     function Create (Id : Integer) return Ctrl is
-         Obj : Ctrl (Boolean'Val (Id mod Ident_Int (2)));
-     begin
-         case Obj.D is
-             when False =>
-                 Obj.C1 := Ident_Int (Id);
-             when True =>
-                 Obj.C2 := Float (Ident_Int (Id + Ident_Int (Id)));
-         end case;
-         return Obj;
-     end Create;
- 
-     procedure Finalize (Obj : in out Ctrl) is
-     begin
-         if not Obj.Finalized then
-             Obj.Finalized := True;
-             if Obj.D then
-                 if Integer (Obj.C2 / 2.0) mod Ident_Int (10) =
-                    Ident_Int (3) then
-                     raise User_Error;
-                 else
-                     Finalize_Called (Integer (Obj.C2) / 2) := True;
-                 end if;
-             else
-                 if Obj.C1 mod Ident_Int (10) = Ident_Int (0) then
-                     raise Tasking_Error;
-                 else
-                     Finalize_Called (Obj.C1) := True;
-                 end if;
-             end if;
-         end if;
-     end Finalize;
- 
-     function Was_Finalized (Id : Integer) return Boolean is
-     begin
-         return Finalize_Called (Ident_Int (Id));
-     end Was_Finalized;
- 
-     procedure Use_It (Obj : in Ctrl) is
-        -- Use Obj to prevent optimization.
-     begin
-         case Obj.D is
-             when True =>
-                 if not Equal (Boolean'Pos(Obj.Finalized),
-                               Boolean'Pos(Obj.Finalized)) then
-                     Failed ("Identity check - 1");
-                 end if;
-             when False =>
-                 if not Equal (Obj.C1, Obj.C1) then
-                     Failed ("Identity check - 2");
-                 end if;
-         end case;
-     end Use_It;
- 
- end C761011_0;
- 
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Ada.Finalization;
- with C761011_0;
- use C761011_0;
- with Report;
- use Report;
- procedure C761011 is
- begin
-     Test
-        ("C761011",
-         " Check that if a finalize propagates an exception, other finalizes " &
-          "due to be performed are performed");
- 
-     Normal: -- Case 1
-         begin
-             declare
-                 Obj1 : Ctrl := Create (Ident_Int (1));
-                 Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
-                                          D => False,
-                                          Finalized => Ident_Bool (False),
-                                          C1 => Ident_Int (2));
-                 Obj3 : Ctrl :=
-                    (Ada.Finalization.Controlled with
-                     D => True,
-                     Finalized => Ident_Bool (False),
-                     C2 => 2.0 * Float (Ident_Int
-                                           (3))); -- Finalization: User_Error
-                 Obj4 : Ctrl := Create (Ident_Int (4));
-             begin
-                 Comment ("Finalization of normal object");
-                 Use_It (Obj1); -- Prevent optimization of Objects.
-                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
-                 Use_It (Obj3);
-                 Use_It (Obj4);
-             end;
-             Failed ("No exception raised by finalization of normal object");
-         exception
-             when Program_Error =>
-                 if not Was_Finalized (Ident_Int (1)) or
-                    not Was_Finalized (Ident_Int (2)) or
-                    not Was_Finalized (Ident_Int (4)) then
-                     Failed ("Missing finalizations - 1");
-                 end if;
-             when E: others =>
-                 Failed ("Exception " & Exception_Name (E) &
-                         " raised - " & Exception_Message (E) & " - 1");
-         end Normal;
- 
-     Anon: -- Case 2
-         begin
-             declare
-                 Obj1 : Ctrl := (Ada.Finalization.Controlled with
-                                 D => True,
-                                 Finalized => Ident_Bool (False),
-                                 C2 => 2.0 * Float (Ident_Int (5)));
-                 Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
-                                          D => False,
-                                          Finalized => Ident_Bool (False),
-                                          C1 => Ident_Int (6));
-                 Obj3 : Ctrl := (Ada.Finalization.Controlled with
-                                 D => True,
-                                 Finalized => Ident_Bool (False),
-                                 C2 => 2.0 * Float (Ident_Int (7)));
-                 Obj4 : Ctrl := Create (Ident_Int (8));
-             begin
-                 Comment ("Finalization of anonymous object");
- 
-                 -- The finalization of the anonymous object below will raise
-                 -- Tasking_Error.
-                 if Create (Ident_Int (10)).C1 /= Ident_Int (10) then
-                     Failed ("Incorrect construction of an anonymous object");
-                 end if;
-                 Failed ("Anonymous object not finalized at the end of the " &
-                         "enclosing statement");
-                 Use_It (Obj1); -- Prevent optimization of Objects.
-                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
-                 Use_It (Obj3);
-                 Use_It (Obj4);
-             end;
-             Failed ("No exception raised by finalization of an anonymous " &
-                     "object of a function");
-         exception
-             when Program_Error =>
-                 if not Was_Finalized (Ident_Int (5)) or
-                    not Was_Finalized (Ident_Int (6)) or
-                    not Was_Finalized (Ident_Int (7)) or
-                    not Was_Finalized (Ident_Int (8)) then
-                     Failed ("Missing finalizations - 2");
-                 end if;
-             when E: others =>
-                 Failed ("Exception " & Exception_Name (E) &
-                         " raised - " & Exception_Message (E) & " - 2");
-         end Anon;
- 
-     An_Exit: -- Case 3
-         begin
-             for Counter in 1 .. 4 loop
-                 declare
-                     Obj1 : Ctrl := Create (Ident_Int (11));
-                     Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
-                                              D => False,
-                                              Finalized => Ident_Bool (False),
-                                              C1 => Ident_Int (12));
-                     Obj3 : Ctrl :=
-                         (Ada.Finalization.Controlled with
-                          D => True,
-                          Finalized => Ident_Bool (False),
-                          C2 => 2.0 * Float (
-                                Ident_Int(13))); -- Finalization: User_Error
-                     Obj4 : Ctrl := Create (Ident_Int (14));
-                 begin
-                     Comment ("Finalization because of exit of loop");
- 
-                     Use_It (Obj1); -- Prevent optimization of Objects.
-                     Use_It (Obj2); -- (Critical if AI-147 is adopted.)
-                     Use_It (Obj3);
-                     Use_It (Obj4);
- 
-                     exit when not Ident_Bool (Obj2.D);
- 
-                     Failed ("Exit not taken");
-                 end;
-             end loop;
-             Failed ("No exception raised by finalization on exit");
-         exception
-             when Program_Error =>
-                 if not Was_Finalized (Ident_Int (11)) or
-                    not Was_Finalized (Ident_Int (12)) or
-                    not Was_Finalized (Ident_Int (14)) then
-                     Failed ("Missing finalizations - 3");
-                 end if;
-             when E: others =>
-                 Failed ("Exception " & Exception_Name (E) &
-                         " raised - " & Exception_Message (E) & " - 3");
-         end An_Exit;
- 
-     A_Goto: -- Case 4
-         begin
-             declare
-                 Obj1 : Ctrl := Create (Ident_Int (15));
-                 Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
-                                          D => False,
-                                          Finalized => Ident_Bool (False),
-                                          C1 => Ident_Int (0));
-                              -- Finalization: Tasking_Error
-                 Obj3 : Ctrl := Create (Ident_Int (16));
-                 Obj4 : Ctrl := (Ada.Finalization.Controlled with
-                                 D => True,
-                                 Finalized => Ident_Bool (False),
-                                 C2 => 2.0 * Float (Ident_Int (17)));
-             begin
-                 Comment ("Finalization because of goto statement");
- 
-                 Use_It (Obj1); -- Prevent optimization of Objects.
-                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
-                 Use_It (Obj3);
-                 Use_It (Obj4);
- 
-                 if Ident_Bool (Obj4.D) then
-                    goto Continue;
-                 end if;
- 
-                 Failed ("Goto not taken");
-             end;
-          <<Continue>>
-             Failed ("No exception raised by finalization on goto");
-         exception
-             when Program_Error =>
-                 if not Was_Finalized (Ident_Int (15)) or
-                    not Was_Finalized (Ident_Int (16)) or
-                    not Was_Finalized (Ident_Int (17)) then
-                     Failed ("Missing finalizations - 4");
-                 end if;
-             when E: others =>
-                 Failed ("Exception " & Exception_Name (E) &
-                         " raised - " & Exception_Message (E) & " - 4");
-         end A_Goto;
- 
-     A_Return: -- Case 5
-         declare
-             procedure Do_Something is
-                 Obj1 : Ctrl := Create (Ident_Int (18));
-                 Obj2 : Ctrl := (Ada.Finalization.Controlled with
-                                 D => True,
-                                 Finalized => Ident_Bool (False),
-                                 C2 => 2.0 * Float (Ident_Int (19)));
-                 Obj3 : constant Ctrl := (Ada.Finalization.Controlled with
-                                          D => False,
-                                          Finalized => Ident_Bool (False),
-                                          C1 => Ident_Int (20));
-                              -- Finalization: Tasking_Error
-             begin
-                 Comment ("Finalization because of return statement");
- 
-                 Use_It (Obj1); -- Prevent optimization of Objects.
-                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
-                 Use_It (Obj3);
- 
-                 if not Ident_Bool (Obj3.D) then
-                    return;
-                 end if;
- 
-                 Failed ("Return not taken");
-             end Do_Something;
-         begin
-             Do_Something;
-             Failed ("No exception raised by finalization on return statement");
-         exception
-             when Program_Error =>
-                 if not Was_Finalized (Ident_Int (18)) or
-                    not Was_Finalized (Ident_Int (19)) then
-                     Failed ("Missing finalizations - 5");
-                 end if;
-             when E: others =>
-                 Failed ("Exception " & Exception_Name (E) &
-                         " raised - " & Exception_Message (E) & " - 5");
-         end A_Return;
- 
-     Except: -- Case 6
-         declare
-             Funky_Error : exception;
- 
-             procedure Do_Something is
-                 Obj1 : Ctrl :=
-                     (Ada.Finalization.Controlled with
-                      D => True,
-                      Finalized => Ident_Bool (False),
-                      C2 => 2.0 * Float (
-                            Ident_Int(23))); -- Finalization: User_Error
-                 Obj2 : Ctrl := Create (Ident_Int (24));
-                 Obj3 : Ctrl := Create (Ident_Int (25));
-                 Obj4 : constant Ctrl := (Ada.Finalization.Controlled with
-                                          D => False,
-                                          Finalized => Ident_Bool (False),
-                                          C1 => Ident_Int (26));
-             begin
-                 Comment ("Finalization because of exception propagation");
- 
-                 Use_It (Obj1); -- Prevent optimization of Objects.
-                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
-                 Use_It (Obj3);
-                 Use_It (Obj4);
- 
-                 if not Ident_Bool (Obj4.D) then
-                    raise Funky_Error;
-                 end if;
- 
-                 Failed ("Exception not raised");
-             end Do_Something;
-         begin
-             Do_Something;
-             Failed ("No exception raised by finalization on exception " &
-                     "propagation");
-         exception
-             when Program_Error =>
-                 if not Was_Finalized (Ident_Int (24)) or
-                    not Was_Finalized (Ident_Int (25)) or
-                    not Was_Finalized (Ident_Int (26)) then
-                     Failed ("Missing finalizations - 6");
-                 end if;
-             when Funky_Error =>
-                 Failed ("Wrong exception propagated");
-                     -- Should be Program_Error (7.6.1(19)).
-             when E: others =>
-                 Failed ("Exception " & Exception_Name (E) &
-                         " raised - " & Exception_Message (E) & " - 6");
-         end Except;
- 
-     Result;
- end C761011;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c7/c761012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c7/c761012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- C761012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that an anonymous object is finalized with its enclosing master if
- --    a transfer of control or exception occurs prior to performing its normal
- --    finalization.  (Defect Report 8652/0023, as reflected in
- --    Technical Corrigendum 1, RM95 7.6.1(13.1/1)).
- --
- -- CHANGE HISTORY:
- --    29 JAN 2001   PHL   Initial version.
- --     5 DEC 2001   RLB   Reformatted for ACATS.
- --
- --!
- with Ada.Finalization;
- use Ada.Finalization;
- package C761012_0 is
- 
-     type Ctrl (D : Boolean) is new Controlled with
-         record
-             case D is
-                 when False =>
-                     C1 : Integer;
-                 when True =>
-                     C2 : Float;
-             end case;
-         end record;
- 
-     function Create return Ctrl;
-     procedure Finalize (Obj : in out Ctrl);
-     function Finalize_Was_Called return Boolean;
- 
- end C761012_0;
- 
- with Report;
- use Report;
- package body C761012_0 is
- 
-     Finalization_Flag : Boolean := False;
- 
-     function Create return Ctrl is
-         Obj : Ctrl (Ident_Bool (True));
-     begin
-         Obj.C2 := 3.0;
-         return Obj;
-     end Create;
- 
-     procedure Finalize (Obj : in out Ctrl) is
-     begin
-         Finalization_Flag := True;
-     end Finalize;
- 
-     function Finalize_Was_Called return Boolean is
-     begin
-         if Finalization_Flag then
-             Finalization_Flag := False;
-             return True;
-         else
-             return False;
-         end if;
-     end Finalize_Was_Called;
- 
- end C761012_0;
- 
- with Ada.Exceptions;
- use Ada.Exceptions;
- with C761012_0;
- use C761012_0;
- with Report;
- use Report;
- procedure C761012 is
- begin
-     Test ("C761012",
-           "Check that an anonymous object is finalized with its enclosing " &
-              "master if a transfer of control or exception occurs prior to " &
-              "performing its normal finalization");
- 
-     Excep:
-         begin
- 
-             declare
-                 I : Integer := Create.C1; -- Raises Constraint_Error
-             begin
-                 Failed
-                    ("Improper component selection did not raise Constraint_Error, I =" &
-                     Integer'Image (I));
-             exception
-                 when Constraint_Error =>
-                     Failed ("Constraint_Error caught by the wrong handler");
-             end;
- 
-             Failed ("Transfer of control did not happen correctly");
- 
-         exception
-             when Constraint_Error =>
-                 if not Finalize_Was_Called then
-                     Failed ("Finalize wasn't called when the master was left " &
-                             "- Constraint_Error");
-                 end if;
-             when E: others =>
-                 Failed ("Exception " & Exception_Name (E) &
-                         " raised - " & Exception_Information (E));
-         end Excep;
- 
-     Transfer:
-         declare
-             Finalize_Was_Called_Before_Leaving_Exit : Boolean;
-         begin
- 
-             begin
-                 loop
-                     exit when Create.C2 = 3.0;
-                 end loop;
-                 Finalize_Was_Called_Before_Leaving_Exit := Finalize_Was_Called;
-                 if Finalize_Was_Called_Before_Leaving_Exit then
-                     Comment ("Finalize called before the transfer of control");
-                 end if;
-             end;
- 
-             if not Finalize_Was_Called and then
-                not Finalize_Was_Called_Before_Leaving_Exit then
-                 Failed ("Finalize wasn't called when the master was left " &
-                         "- transfer of control");
-             end if;
-         end Transfer;
- 
-     Result;
- end C761012;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C83007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FORMAL PARAMETER OF A SUBPROGRAM DECLARED BY A
- --     RENAMING DECLARATION CAN HAVE THE SAME IDENTIFIER AS A
- --     DECLARATION IN THE BODY OF THE RENAMED SUBPROGRAM.
- 
- -- HISTORY:
- --     VCL  02/18/88  CREATED ORIGINAL TEST.
- 
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C83007A IS
- BEGIN
-      TEST ("C83007A", "A FORMAL PARAMETER OF A SUBPROGRAM DECLARED " &
-                       "BY A RENAMING DECLARATION CAN HAVE THE SAME " &
-                       "IDENTIFIER AS A DECLARATION IN THE BODY OF " &
-                       "THE RENAMED SUBPROGRAM");
-      DECLARE
-           PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING);
- 
-           PROCEDURE R (D1 : INTEGER;
-                        D2 : FLOAT;
-                        D3 : STRING)  RENAMES P;
- 
-           PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING) IS
-                TYPE D1 IS RANGE 1..10;
-                I : D1 := D1(IDENT_INT (7));
- 
-                D2 : FLOAT;
- 
-                FUNCTION D3 RETURN STRING IS
-                BEGIN
-                     RETURN "D3";
-                END D3;
- 
-                FUNCTION IDENT_FLOAT (VAL : FLOAT) RETURN FLOAT IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN VAL;
-                     ELSE
-                          RETURN 0.0;
-                     END IF;
-                END IDENT_FLOAT;
- 
-           BEGIN
-                IF ONE /= 5 THEN
-                     FAILED ("INCORRECT VALUE FOR PARAMETER ONE");
-                END IF;
-                IF TWO /= 4.5 THEN
-                     FAILED ("INCORRECT VALUE FOR PARAMETER TWO");
-                END IF;
-                IF THREE /= "R1" THEN
-                     FAILED ("INCORRECT VALUE FOR PARAMETER THREE");
-                END IF;
- 
-                IF I /= 7 THEN
-                     FAILED ("INCORRECT VALUE FOR OBJECT I");
-                END IF;
-                D2 := IDENT_FLOAT (3.5);
-                IF D2 /= 3.5 THEN
-                     FAILED ("INCORRECT VALUE FOR OBJECT D2");
-                END IF;
-                IF D3 /= "D3" THEN
-                     FAILED ("INCORRECT VALUE FOR FUNCTION D3");
-                END IF;
-           END P;
-      BEGIN
-           R (D1=>5, D2=>4.5, D3=>"R1");
-      END;
- 
-      RESULT;
- END C83007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83012d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83012d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83012d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83012d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C83012D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WITHIN A GENERIC PACKAGE INSTANTIATION, A DECLARATION
- --     HAVING THE SAME IDENTIFIER AS THE PACKAGE IS VISIBLE BY
- --     SELECTION.
- 
- -- HISTORY:
- --     JET 08/11/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83012D IS
- 
-      PACKAGE PACK IS
-           SUBTYPE PACK1 IS INTEGER;
-           PACK2 : INTEGER := 2;
-      END PACK;
- 
-      TYPE REC IS RECORD
-           PACK3 : INTEGER;
-           PACK4 : INTEGER;
-      END RECORD;
- 
-      R : REC := (PACK3 => 3, PACK4 => 1);
- 
-      GENERIC
-           TYPE T IS RANGE <>;
-      PACKAGE GEN1 IS
-           J : INTEGER := IDENT_INT(1);
-      END GEN1;
- 
-      GENERIC
-           I : INTEGER;
-      PACKAGE GEN2 IS
-           J : INTEGER := IDENT_INT(I);
-      END GEN2;
- 
-      GENERIC
-           R : REC;
-      PACKAGE GEN3 IS
-           J : INTEGER := IDENT_INT(R.PACK4);
-      END GEN3;
- 
-      GENERIC
-           PACK6 : INTEGER;
-      PACKAGE GEN4 IS
-           J : INTEGER := IDENT_INT(PACK6);
-      END GEN4;
- 
-      FUNCTION FUNC (PACK5: INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN IDENT_INT(PACK5);
-      END FUNC;
- 
-      PACKAGE PACK1 IS NEW GEN1(PACK.PACK1);
-      PACKAGE PACK2 IS NEW GEN2(PACK.PACK2);
-      PACKAGE PACK3 IS NEW GEN2(R.PACK3);
-      PACKAGE PACK4 IS NEW GEN3((1, PACK4 => 4));
-      PACKAGE PACK5 IS NEW GEN2(FUNC(PACK5 => 5));
-      PACKAGE PACK6 IS NEW GEN4(PACK6 => 6);
- 
- BEGIN
-      TEST ("C83012D", "CHECK THAT WITHIN A GENERIC PACKAGE " &
-                       "INSTANTIATION, A DECLARATION HAVING THE SAME " &
-                       "IDENTIFIER AS THE PACKAGE IS VISIBLE BY " &
-                       "SELECTION");
- 
-      IF PACK1.J /= 1 THEN
-           FAILED ("INCORRECT VALUE OF PACK1.J");
-      END IF;
- 
-      IF PACK2.J /= 2 THEN
-           FAILED ("INCORRECT VALUE OF PACK2.J");
-      END IF;
- 
-      IF PACK3.J /= 3 THEN
-           FAILED ("INCORRECT VALUE OF PACK3.J");
-      END IF;
- 
-      IF PACK4.J /= 4 THEN
-           FAILED ("INCORRECT VALUE OF PACK4.J");
-      END IF;
- 
-      IF PACK5.J /= 5 THEN
-           FAILED ("INCORRECT VALUE OF PACK5.J");
-      END IF;
- 
-      IF PACK6.J /= 6 THEN
-           FAILED ("INCORRECT VALUE OF PACK6.J");
-      END IF;
- 
-      RESULT;
- 
- END C83012D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83022a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83022a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83022a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83022a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,338 ****
- -- C83022A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A SUBPROGRAM FORMAL PART OR BODY
- --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
- --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
- --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
- --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAH DECLARATION.
- 
- -- HISTORY:
- --     TBN 08/01/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83022A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83022A", "CHECK THAT A DECLARATION IN A SUBPROGRAM " &
-                       "FORMAL PART OR BODY HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      ONE:
-      DECLARE                      -- SUBPROGRAM DECLARATIVE REGION.
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
- 
-           PROCEDURE INNER (X : IN OUT INTEGER) IS
-                C : INTEGER := A;
-                A : INTEGER := IDENT_INT(3);
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-                END IF;
-                IF ONE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-                END IF;
-                IF ONE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-                END IF;
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-                END IF;
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 5");
-                END IF;
-                IF EQUAL(1,1) THEN
-                     X := A;
-                ELSE
-                     X := ONE.A;
-                END IF;
-           END INNER;
- 
-      BEGIN  -- ONE
-           INNER (A);
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 6");
-           END IF;
-      END ONE;
- 
-      TWO:
-      DECLARE                     -- FORMAL PARAMETER OF SUBPROGRAM.
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
-           OBJ : INTEGER := IDENT_INT(3);
- 
-           PROCEDURE INNER (X : IN INTEGER := A;
-                            A : IN OUT INTEGER) IS
-                C : INTEGER := A;
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
-                END IF;
-                IF TWO.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-                END IF;
-                IF TWO.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-                END IF;
-                IF C /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-                END IF;
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 14");
-                END IF;
-                IF EQUAL(1,1) THEN
-                     A := IDENT_INT(4);
-                ELSE
-                     A := 1;
-                END IF;
-           END INNER;
- 
-      BEGIN  -- TWO
-           INNER (A => OBJ);
-           IF OBJ /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 15");
-           END IF;
-      END TWO;
- 
-      THREE:
-      DECLARE            -- AFTER THE SPECIFICATION OF SUBPROGRAM.
-           A : INTEGER := IDENT_INT(2);
- 
-           FUNCTION INNER (X : INTEGER) RETURN INTEGER;
- 
-           B : INTEGER := A;
- 
-           FUNCTION INNER (X : INTEGER) RETURN INTEGER IS
-                C : INTEGER := A;
-                A : INTEGER := IDENT_INT(3);
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
-                END IF;
-                IF THREE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
-                END IF;
-                IF THREE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
-                END IF;
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
-                END IF;
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 24");
-                END IF;
-                IF EQUAL(1,1) THEN
-                     RETURN A;
-                ELSE
-                     RETURN X;
-                END IF;
-           END INNER;
- 
-      BEGIN  -- THREE
-           IF INNER(A) /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 25");
-           END IF;
-      END THREE;
- 
-      FOUR:
-      DECLARE                              -- RENAMING DECLARATION.
-           A : INTEGER := IDENT_INT(2);
- 
-           PROCEDURE TEMPLATE (X : IN INTEGER := A;
-                               Y : IN OUT INTEGER);
- 
-           PROCEDURE INNER (Z : IN INTEGER := A;
-                            A : IN OUT INTEGER) RENAMES TEMPLATE;
- 
-           B : INTEGER := A;
-           OBJ : INTEGER := 5;
- 
-           PROCEDURE TEMPLATE (X : IN INTEGER := A;
-                               Y : IN OUT INTEGER) IS
-           BEGIN  -- TEMPLATE
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FOR VARIABLE - 30");
-                END IF;
-                IF Y /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT RESULTS FOR VARIABLE - 31");
-                END IF;
-                Y := IDENT_INT(2 * X);
-                IF FOUR.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FOR OUTER HOMOGRAPH - " &
-                             "32");
-                END IF;
-           END TEMPLATE;
- 
-      BEGIN  -- FOUR
-           IF B /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 32");
-           END IF;
-           INNER (A => OBJ);
-           IF OBJ /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 33");
-           END IF;
-      END FOUR;
- 
-      FIVE:
-      DECLARE                         -- GENERIC FORMAL SUBPROGRAM.
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
- 
-           PROCEDURE INNER (X : IN OUT INTEGER);
- 
-           GENERIC
-                WITH PROCEDURE SUBPR (Y : IN OUT INTEGER) IS <>;
-           PACKAGE P IS
-                PAC_VAR : INTEGER := 1;
-           END P;
- 
-           PROCEDURE INNER (X : IN OUT INTEGER) IS
-                C : INTEGER := A;
-                A : INTEGER := IDENT_INT(3);
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 41");
-                END IF;
-                IF FIVE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 42");
-                END IF;
-                IF FIVE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 43");
-                END IF;
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 44");
-                END IF;
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 45");
-                END IF;
-                IF EQUAL(1,1) THEN
-                     X := A;
-                ELSE
-                     X := FIVE.A;
-                END IF;
-           END INNER;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                SUBPR (A);
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE PASSED OUT - 46");
-                END IF;
-                IF PAC_VAR /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE FOR PAC_VAR - 47");
-                END IF;
-           END P;
- 
-           PACKAGE NEW_P IS NEW P (INNER);
- 
-      BEGIN  -- FIVE
-           NULL;
-      END FIVE;
- 
-      SIX:
-      DECLARE                              -- GENERIC INSTANTIATION.
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
-           OBJ : INTEGER := IDENT_INT(3);
- 
-           GENERIC
-           PROCEDURE INNER (X : IN INTEGER := A;
-                            A : IN OUT INTEGER);
- 
-           PROCEDURE INNER (X : IN INTEGER := SIX.A;
-                            A : IN OUT INTEGER) IS
-                C : INTEGER := A;
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -50");
-                END IF;
-                IF SIX.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 51");
-                END IF;
-                IF SIX.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 52");
-                END IF;
-                IF C /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 53");
-                END IF;
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 54");
-                END IF;
-                IF EQUAL(1,1) THEN
-                     A := IDENT_INT(4);
-                ELSE
-                     A := 1;
-                END IF;
-           END INNER;
- 
-           PROCEDURE SUBPR IS NEW INNER;
- 
-      BEGIN  -- SIX
-           SUBPR (A => OBJ);
-           IF OBJ /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 55");
-           END IF;
-      END SIX;
- 
-      SEVEN:
-      DECLARE                 --  OVERLOADING OF FUNCTIONS.
- 
-           OBJ : INTEGER := 1;
-           FLO : FLOAT := 5.0;
- 
-           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT);
- 
-           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS
-           BEGIN
-                X := INTEGER(F);
-           END INNER;
- 
-      BEGIN
-           FLO := 6.25;
-           INNER (OBJ, FLO);
-           IF OBJ /= IDENT_INT(6) THEN
-                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
-           END IF;
-      END SEVEN;
- 
- 
-      RESULT;
- END C83022A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83022g0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83022g0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83022g0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83022g0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C83022G0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A SUBPROGRAM FORMAL PART OR BODY
- --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
- --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
- --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
- --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAPH DECLARATION, IF THE SUBPROGRAM BODY IS COMPILED
- --     SEPARATELY AS A SUBUNIT.
- 
- -- SEPARATE FILES ARE:
- --     C83022G0M.ADA - (THIS FILE) MAIN PROGRAM.
- --     C83022G1.ADA -- SUBPROGRAM BODIES.
- 
- -- HISTORY:
- --     BCB 08/26/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C83022G0M IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      A : INTEGER := IDENT_INT(2);
-      B : INTEGER := A;
- 
-      OBJ : INTEGER := IDENT_INT(3);
- 
-      FLO : FLOAT := 5.0;
- 
-      PROCEDURE TEMPLATE (X : IN INTEGER := A;
-                          Y : IN OUT INTEGER);
- 
-      PROCEDURE INNER4 (Z : IN INTEGER := A;
-                        A : IN OUT INTEGER) RENAMES TEMPLATE;
- 
-      PROCEDURE INNER (X : IN OUT INTEGER) IS SEPARATE;
- 
-      PROCEDURE INNER2 (X : IN INTEGER := A;
-                        A : IN OUT INTEGER) IS SEPARATE;
- 
-      FUNCTION INNER3 (X : INTEGER) RETURN INTEGER IS SEPARATE;
- 
-      PROCEDURE TEMPLATE (X : IN INTEGER := A;
-                          Y : IN OUT INTEGER) IS SEPARATE;
- 
-      PROCEDURE INNER5 (X : IN OUT INTEGER) IS SEPARATE;
- 
-      GENERIC
-           WITH PROCEDURE SUBPR (Y : IN OUT INTEGER) IS <>;
-      PACKAGE P IS
-           PAC_VAR : INTEGER := 1;
-      END P;
- 
-      PACKAGE BODY P IS
-      BEGIN
-           SUBPR (A);
- 
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 1");
-           END IF;
- 
-           IF PAC_VAR /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE FOR PAC_VAR - 2");
-           END IF;
-      END P;
- 
-      PACKAGE NEW_P IS NEW P (INNER5);
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
-      FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-      PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT);
- 
-      FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-      PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT) IS SEPARATE;
- 
- BEGIN
-      TEST ("C83022G", "CHECK THAT A DECLARATION IN A SUBPROGRAM " &
-                       "FORMAL PART OR BODY HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      A := IDENT_INT(2);
-      B := A;
- 
-      INNER (A);
- 
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 3");
-      END IF;
- 
-      A := IDENT_INT(2);
- 
-      INNER2 (A => OBJ);
- 
-      IF OBJ /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 4");
-      END IF;
- 
-      A := IDENT_INT(2);
- 
-      B := A;
- 
-      IF INNER3(A) /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 5");
-      END IF;
- 
-      A := IDENT_INT(2);
- 
-      B := A;
-      OBJ := 5;
- 
-      IF B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 6");
-      END IF;
- 
-      INNER4 (A => OBJ);
- 
-      IF OBJ /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 7");
-      END IF;
- 
-      OBJ := 1;
- 
-      FLO := 6.25;
- 
-      INNER6 (OBJ, FLO);
- 
-      IF OBJ /= IDENT_INT(6) THEN
-           FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 8");
-      END IF;
- 
-      RESULT;
- END C83022G0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83022g1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83022g1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83022g1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83022g1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,189 ****
- -- C83022G1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A SUBPROGRAM FORMAL PART OR BODY
- --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
- --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
- --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
- --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAPH DECLARATION, IF THE SUBPROGRAM BODY IS COMPILED
- --     SEPARATELY AS A SUBUNIT.
- 
- -- HISTORY:
- --     BCB 08/26/88  CREATED ORIGINAL TEST.
- 
- SEPARATE (C83022G0M)
- PROCEDURE INNER (X : IN OUT INTEGER) IS
-      C : INTEGER := A;
-      A : INTEGER := IDENT_INT(3);
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-      END IF;
- 
-      IF C83022G0M.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-      END IF;
- 
-      IF C83022G0M.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-      END IF;
- 
-      IF C /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 5");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           X := A;
-      ELSE
-           X := C83022G0M.A;
-      END IF;
- END INNER;
- 
- SEPARATE (C83022G0M)
- PROCEDURE INNER2 (X : IN INTEGER := C83022G0M.A;
-                   A : IN OUT INTEGER) IS
-      C : INTEGER := A;
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
-      END IF;
- 
-      IF C83022G0M.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-      END IF;
- 
-      IF C83022G0M.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-      END IF;
- 
-      IF C /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 14");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           A := IDENT_INT(4);
-      ELSE
-           A := 1;
-      END IF;
- END INNER2;
- 
- SEPARATE (C83022G0M)
- FUNCTION INNER3 (X : INTEGER) RETURN INTEGER IS
-      C : INTEGER := A;
-      A : INTEGER := IDENT_INT(3);
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
-      END IF;
- 
-      IF C83022G0M.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
-      END IF;
- 
-      IF C83022G0M.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
-      END IF;
- 
-      IF C /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 24");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           RETURN A;
-      ELSE
-           RETURN X;
-      END IF;
- END INNER3;
- 
- SEPARATE (C83022G0M)
- PROCEDURE TEMPLATE (X : IN INTEGER := A;
-                     Y : IN OUT INTEGER) IS
- BEGIN  -- TEMPLATE
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT RESULTS FOR VARIABLE - 30");
-      END IF;
- 
-      IF Y /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT RESULTS FOR VARIABLE - 31");
-      END IF;
- 
-      Y := IDENT_INT(2 * X);
- 
-      IF C83022G0M.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT RESULTS FOR OUTER HOMOGRAPH - " &
-                   "32");
-      END IF;
- END TEMPLATE;
- 
- SEPARATE (C83022G0M)
- PROCEDURE INNER5 (X : IN OUT INTEGER) IS
-      C : INTEGER := A;
-      A : INTEGER := IDENT_INT(3);
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 41");
-      END IF;
- 
-      IF C83022G0M.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 42");
-      END IF;
- 
-      IF C83022G0M.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 43");
-      END IF;
- 
-      IF C /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 44");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 45");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           X := A;
-      ELSE
-           X := C83022G0M.A;
-      END IF;
- END INNER5;
- 
- SEPARATE (C83022G0M)
- PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT) IS
- BEGIN
-      X := INTEGER(F);
- END INNER6;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83023a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83023a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83023a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83023a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,194 ****
- -- C83023A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A DECLARATIVE REGION OF A TASK
- --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
- --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
- --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
- --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAPH DECLARATION.
- 
- -- HISTORY:
- --     BCB 08/29/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83023A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83023A", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
-                       "REGION OF A TASK HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      ONE:
-      DECLARE                      -- DECLARATIVE REGION.
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
- 
-           TASK INNER IS
-                ENTRY HERE (X : IN OUT INTEGER);
-           END INNER;
- 
-           TASK BODY INNER IS
-                C : INTEGER := A;
-                A : INTEGER := IDENT_INT(3);
-           BEGIN
-                ACCEPT HERE (X : IN OUT INTEGER) DO
-                     IF A /= IDENT_INT(3) THEN
-                          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH" &
-                                  " - 1");
-                     END IF;
- 
-                     IF ONE.A /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH" &
-                                  " - 2");
-                     END IF;
- 
-                     IF ONE.B /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE " &
-                                  "- 3");
-                     END IF;
- 
-                     IF C /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE FOR INNER VARIABLE " &
-                                  "- 4");
-                     END IF;
- 
-                     IF X /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE PASSED IN - 5");
-                     END IF;
- 
-                     IF EQUAL(1,1) THEN
-                          X := A;
-                     ELSE
-                          X := ONE.A;
-                     END IF;
-                END HERE;
-           END INNER;
- 
-      BEGIN  -- ONE
-           INNER.HERE(A);
- 
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 6");
-           END IF;
-      END ONE;
- 
-      TWO:
-      DECLARE            -- AFTER THE SPECIFICATION OF TASK.
-           TASK INNER IS
-                ENTRY HERE (X : IN OUT INTEGER);
-           END INNER;
- 
-           A : INTEGER := IDENT_INT(2);
- 
-           B : INTEGER := A;
- 
-           TASK BODY INNER IS
-                C : INTEGER := A;
-                A : INTEGER := IDENT_INT(3);
-           BEGIN
-                ACCEPT HERE (X : IN OUT INTEGER) DO
-                     IF A /= IDENT_INT(3) THEN
-                          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH" &
-                                  " - 10");
-                     END IF;
- 
-                     IF TWO.A /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH" &
-                                  " - 11");
-                     END IF;
- 
-                     IF TWO.B /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE " &
-                                  "- 12");
-                     END IF;
- 
-                     IF C /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE FOR INNER VARIABLE " &
-                                  "- 13");
-                     END IF;
- 
-                     IF X /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE PASSED IN - 14");
-                     END IF;
- 
-                     IF EQUAL(1,1) THEN
-                          X := A;
-                     ELSE
-                          NULL;
-                     END IF;
-                END HERE;
-           END INNER;
- 
-      BEGIN  -- TWO
-           INNER.HERE(A);
- 
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 15");
-           END IF;
-      END TWO;
- 
-      THREE:
-      DECLARE                 --  OVERLOADING OF FUNCTIONS.
- 
-           OBJ : INTEGER := 1;
-           FLO : FLOAT := 5.0;
- 
-           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-           TASK INNER IS
-                ENTRY HERE (X : IN OUT INTEGER);
-           END INNER;
- 
-           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-           TASK BODY INNER IS
-                F : FLOAT := 6.25;
-           BEGIN
-                ACCEPT HERE (X : IN OUT INTEGER) DO
-                     X := INTEGER(F);
-                END HERE;
-           END INNER;
- 
-      BEGIN
-           INNER.HERE (OBJ);
- 
-           IF OBJ /= IDENT_INT(6) THEN
-                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 20");
-           END IF;
-      END THREE;
- 
-      RESULT;
- END C83023A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83024a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83024a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83024a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83024a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,185 ****
- -- C83024A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A DECLARATIVE REGION FOR A GENERIC
- --     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
- --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
- --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
- --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAH DECLARATION.
- 
- -- HISTORY:
- --     BCB 08/30/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C83024A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83024A", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
-                       "REGION FOR A GENERIC PACKAGE HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      ONE:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
-           OBJ : INTEGER := IDENT_INT(3);
- 
-           GENERIC
-                X : IN INTEGER := A;
-                A : IN OUT INTEGER;
-           PACKAGE INNER IS
-                C : INTEGER := A;
-           END INNER;
- 
-           PACKAGE BODY INNER IS
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
-                END IF;
- 
-                IF ONE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-                END IF;
- 
-                IF ONE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-                END IF;
- 
-                IF C /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-                END IF;
- 
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 14");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     A := IDENT_INT(4);
-                ELSE
-                     A := 1;
-                END IF;
-           END INNER;
- 
-           PACKAGE NEW_INNER IS NEW INNER (A => OBJ);
- 
-      BEGIN  -- ONE
-           IF OBJ /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 15");
-           END IF;
-      END ONE;
- 
-      TWO:
-      DECLARE            -- AFTER THE SPECIFICATION OF PACKAGE.
-           A : INTEGER := IDENT_INT(2);
- 
-           GENERIC
-                X : IN OUT INTEGER;
-           PACKAGE INNER IS
-                A : INTEGER := IDENT_INT(3);
-           END INNER;
- 
-           B : INTEGER := A;
- 
-           PACKAGE BODY INNER IS
-                C : INTEGER := TWO.A;
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
-                END IF;
- 
-                IF TWO.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
-                END IF;
- 
-                IF TWO.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
-                END IF;
- 
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
-                END IF;
- 
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 24");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     X := A;
-                ELSE
-                     NULL;
-                END IF;
-           END INNER;
- 
-           PACKAGE NEW_INNER IS NEW INNER (A);
- 
-      BEGIN  -- TWO
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 25");
-           END IF;
-      END TWO;
- 
-      THREE:
-      DECLARE                 --  OVERLOADING OF FUNCTIONS.
- 
-           OBJ : INTEGER := 1;
-           FLO : FLOAT := 6.25;
- 
-           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-           GENERIC
-                X : IN OUT INTEGER;
-                F : IN FLOAT;
-           PACKAGE INNER IS
-           END INNER;
- 
-           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-           PACKAGE BODY INNER IS
-           BEGIN
-                X := INTEGER(F);
-           END INNER;
- 
-           PACKAGE NEW_INNER IS NEW INNER (OBJ, FLO);
- 
-      BEGIN
-           IF OBJ /= IDENT_INT(6) THEN
-                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
-           END IF;
-      END THREE;
- 
-      RESULT;
- END C83024A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83024e0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83024e0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83024e0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83024e0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C83024E0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN THE DECLARATIVE REGION OF A GENERIC
- --     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
- --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
- --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
- --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAPH DECLARATION, IF THE GENERIC PACKAGE BODY IS SEPARATELY
- --     COMPILED, BUT NOT AS A SUBUNIT.
- 
- -- HISTORY:
- --     BCB 08/30/88  CREATED ORIGINAL TEST.
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- GENERIC
-      TYPE T IS PRIVATE;
-      X : T;
- FUNCTION C83024E_GEN_FUN RETURN T;
- 
- FUNCTION C83024E_GEN_FUN RETURN T IS
- BEGIN
-      RETURN X;
- END C83024E_GEN_FUN;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE(REPORT);
- PACKAGE C83024E_P1 IS
-      A : INTEGER := IDENT_INT(2);
-      B : INTEGER := A;
- 
-      PROCEDURE REQUIRE_BODY;
- 
-      GENERIC
-           X : IN OUT INTEGER;
-      PACKAGE C83024E_PACK1 IS
-           C : INTEGER := A;
-           A : INTEGER := IDENT_INT(3);
-      END C83024E_PACK1;
- END C83024E_P1;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE(REPORT);
- PACKAGE C83024E_P2 IS
-      A : INTEGER := IDENT_INT(2);
-      B : INTEGER := A;
-      OBJ : INTEGER := IDENT_INT(3);
- 
-      PROCEDURE REQUIRE_BODY;
- 
-      GENERIC
-           X : IN INTEGER := A;
-           A : IN OUT INTEGER;
-      PACKAGE C83024E_PACK2 IS
-           C : INTEGER := A;
-      END C83024E_PACK2;
- END C83024E_P2;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE(REPORT);
- PACKAGE C83024E_P3 IS
-      A : INTEGER := IDENT_INT(2);
-      B : INTEGER := A;
- 
-      PROCEDURE REQUIRE_BODY;
- 
-      GENERIC
-           X : IN OUT INTEGER;
-      PACKAGE C83024E_PACK3 IS
-      END C83024E_PACK3;
- END C83024E_P3;
- 
- WITH REPORT; USE REPORT;
- WITH C83024E_GEN_FUN;
- PRAGMA ELABORATE(REPORT,C83024E_GEN_FUN);
- PACKAGE C83024E_P4 IS
-      OBJ : INTEGER := IDENT_INT(1);
-      FLO : FLOAT := 6.25;
- 
-      PROCEDURE REQUIRE_BODY;
- 
-      FUNCTION F IS NEW C83024E_GEN_FUN (INTEGER, OBJ);
-      FUNCTION F IS NEW C83024E_GEN_FUN (FLOAT, FLO);
- 
-      GENERIC
-           X : IN OUT INTEGER;
-           F : IN FLOAT;
-      PACKAGE C83024E_PACK4 IS
-      END C83024E_PACK4;
- END C83024E_P4;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83024e1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83024e1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83024e1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83024e1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,220 ****
- -- C83024E1M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN THE DECLARATIVE REGION OF A GENERIC
- --     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
- --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
- --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
- --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAPH DECLARATION, IF THE GENERIC PACKAGE BODY IS SEPARATELY
- --     COMPILED, BUT NOT AS A SUBUNIT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT SEPARATE
- --     COMPILATIONS OF GENERIC SPECIFICATIONS AND BODIES.
- 
- -- SEPARATE FILES ARE:
- --     C83024E0.ADA -- GENERIC PACKAGE SPECIFICATIONS.
- --     C83024E1M.ADA - (THIS FILE) GENERIC PACKAGE BODIES AND
- --                     MAIN PROGRAM.
- 
- -- HISTORY:
- --     BCB 08/30/88  CREATED ORIGINAL TEST.
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- PACKAGE BODY C83024E_P1 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
-      PACKAGE BODY C83024E_PACK1 IS
-      BEGIN
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-           END IF;
- 
-           IF C83024E_P1.A /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-           END IF;
- 
-           IF C83024E_P1.B /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-           END IF;
- 
-           IF C /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-           END IF;
- 
-           IF X /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE PASSED IN - 5");
-           END IF;
- 
-           IF EQUAL(1,1) THEN
-                X := A;
-           ELSE
-                X := C83024E_P1.A;
-           END IF;
-      END C83024E_PACK1;
- END C83024E_P1;
- 
- PACKAGE BODY C83024E_P2 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
-      PACKAGE BODY C83024E_PACK2 IS
-      BEGIN
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
-           END IF;
- 
-           IF C83024E_P2.A /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-           END IF;
- 
-           IF C83024E_P2.B /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-           END IF;
- 
-           IF C /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-           END IF;
- 
-           IF X /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE PASSED IN - 14");
-           END IF;
- 
-           IF EQUAL(1,1) THEN
-                A := IDENT_INT(4);
-           ELSE
-                A := 1;
-           END IF;
-      END C83024E_PACK2;
- END C83024E_P2;
- 
- PACKAGE BODY C83024E_P3 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
-      PACKAGE BODY C83024E_PACK3 IS
-           C : INTEGER := A;
-           A : INTEGER := IDENT_INT(3);
-      BEGIN
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
-           END IF;
- 
-           IF C83024E_P3.A /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
-           END IF;
- 
-           IF C83024E_P3.B /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
-           END IF;
- 
-           IF C /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
-           END IF;
- 
-           IF X /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE PASSED IN - 24");
-           END IF;
- 
-           IF EQUAL(1,1) THEN
-                X := A;
-           ELSE
-                NULL;
-           END IF;
-      END C83024E_PACK3;
- END C83024E_P3;
- 
- PACKAGE BODY C83024E_P4 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
-      PACKAGE BODY C83024E_PACK4 IS
-      BEGIN
-           X := INTEGER(F);
-      END C83024E_PACK4;
- END C83024E_P4;
- 
- WITH REPORT; USE REPORT;
- WITH C83024E_P1; WITH C83024E_P2;
- WITH C83024E_P3; WITH C83024E_P4;
- USE C83024E_P1; USE C83024E_P2;
- USE C83024E_P3; USE C83024E_P4;
- PROCEDURE C83024E1M IS
- 
- BEGIN
-      TEST ("C83024E", "CHECK THAT A DECLARATION IN THE DECLARATIVE " &
-                       "REGION OF A GENERIC PACKAGE HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      DECLARE
-           PACKAGE NEW_C83024E_PACK1 IS NEW C83024E_PACK1 (C83024E_P1.A);
-      BEGIN
-           IF C83024E_P1.A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 6");
-           END IF;
-      END;
- 
-      DECLARE
-           PACKAGE NEW_C83024E_PACK2 IS
-                NEW C83024E_PACK2 (A => C83024E_P2.OBJ);
-      BEGIN
-           IF C83024E_P2.OBJ /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 15");
-           END IF;
-      END;
- 
-      DECLARE
-           PACKAGE NEW_C83024E_PACK3 IS NEW C83024E_PACK3 (C83024E_P3.A);
-      BEGIN
-           IF C83024E_P3.A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 25");
-           END IF;
-      END;
- 
-      DECLARE
-           PACKAGE NEW_C83024E_PACK4 IS
-                NEW C83024E_PACK4 (C83024E_P4.OBJ, FLO);
-      BEGIN
-           IF C83024E_P4.OBJ /= IDENT_INT(6) THEN
-                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
-           END IF;
-      END;
- 
-      RESULT;
- END C83024E1M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83025a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83025a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83025a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83025a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,283 ****
- -- C83025A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN THE DECLARATIVE REGION OF A GENERIC
- --     SUBPROGRAM HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
- --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
- --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
- --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAPH DECLARATION.
- 
- -- HISTORY:
- --     BCB 08/31/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C83025A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83025A", "CHECK THAT A DECLARATION IN THE DECLARATIVE " &
-                       "REGION OF A GENERIC SUBPROGRAM HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      ONE:
-      DECLARE                      -- SUBPROGRAM DECLARATIVE REGION.
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
- 
-           GENERIC
-           PROCEDURE INNER (X : IN OUT INTEGER);
- 
-           PROCEDURE INNER (X : IN OUT INTEGER) IS
-                C : INTEGER := A;
-                A : INTEGER := IDENT_INT(3);
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-                END IF;
- 
-                IF ONE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-                END IF;
- 
-                IF ONE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-                END IF;
- 
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-                END IF;
- 
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 5");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     X := A;
-                ELSE
-                     X := ONE.A;
-                END IF;
-           END INNER;
- 
-           PROCEDURE NEW_INNER IS NEW INNER;
- 
-      BEGIN  -- ONE
-           NEW_INNER (A);
- 
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 6");
-           END IF;
-      END ONE;
- 
-      TWO:
-      DECLARE               -- FORMAL PARAMETER OF GENERIC SUBPROGRAM.
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
-           OBJ : INTEGER := IDENT_INT(3);
- 
-           GENERIC
-           PROCEDURE INNER (X : IN INTEGER := A;
-                            A : IN OUT INTEGER);
- 
-           PROCEDURE INNER (X : IN INTEGER := TWO.A;
-                            A : IN OUT INTEGER) IS
-                C : INTEGER := A;
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
-                END IF;
- 
-                IF TWO.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-                END IF;
- 
-                IF TWO.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-                END IF;
- 
-                IF C /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-                END IF;
- 
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 14");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     A := IDENT_INT(4);
-                ELSE
-                     A := 1;
-                END IF;
-           END INNER;
- 
-           PROCEDURE NEW_INNER IS NEW INNER;
- 
-      BEGIN  -- TWO
-           NEW_INNER (A => OBJ);
- 
-           IF OBJ /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 15");
-           END IF;
-      END TWO;
- 
-      THREE:
-      DECLARE      -- AFTER THE SPECIFICATION OF GENERIC SUBPROGRAM.
-           GENERIC
-                A : INTEGER := IDENT_INT(3);
-           FUNCTION INNER (X : INTEGER) RETURN INTEGER;
- 
-           A : INTEGER := IDENT_INT(2);
- 
-           B : INTEGER := A;
- 
-           FUNCTION INNER (X : INTEGER) RETURN INTEGER IS
-                C : INTEGER := THREE.A;
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
-                END IF;
- 
-                IF THREE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
-                END IF;
- 
-                IF THREE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
-                END IF;
- 
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
-                END IF;
- 
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 24");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     RETURN A;
-                ELSE
-                     RETURN X;
-                END IF;
-           END INNER;
- 
-           FUNCTION NEW_INNER IS NEW INNER;
- 
-      BEGIN  -- THREE
-           IF NEW_INNER(A) /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 25");
-           END IF;
-      END THREE;
- 
-      FOUR:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
- 
-           GENERIC
-                A : INTEGER;
-                B : INTEGER := A;
-           PROCEDURE INNER (X : IN OUT INTEGER);
- 
-           PROCEDURE INNER (X : IN OUT INTEGER) IS
-                C : INTEGER := FOUR.A;
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 30");
-                END IF;
- 
-                IF B /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 31");
-                END IF;
- 
-                IF FOUR.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 32");
-                END IF;
- 
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 33");
-                END IF;
- 
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 34");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     X := A;
-                ELSE
-                     X := FOUR.A;
-                END IF;
-           END INNER;
- 
-           PROCEDURE NEW_INNER IS NEW INNER (A => IDENT_INT(3));
- 
-      BEGIN
-           NEW_INNER (A);
- 
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 35");
-           END IF;
-      END FOUR;
- 
-      FIVE:
-      DECLARE                 --  OVERLOADING OF FUNCTIONS.
- 
-           OBJ : INTEGER := 1;
-           FLO : FLOAT := 5.0;
- 
-           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-           GENERIC
-           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT);
- 
-           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS
-           BEGIN
-                X := INTEGER(F);
-           END INNER;
- 
-           PROCEDURE NEW_INNER IS NEW INNER;
- 
-      BEGIN  -- FIVE
-           FLO := 6.25;
- 
-           NEW_INNER (OBJ, FLO);
- 
-           IF OBJ /= IDENT_INT(6) THEN
-                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 40");
-           END IF;
-      END FIVE;
- 
-      RESULT;
- END C83025A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83025c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83025c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83025c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83025c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,345 ****
- -- C83025C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A DECLARATIVE REGION OF A GENERIC
- --     SUBPROGRAM HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
- --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
- --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
- --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
- --     HOMOGRAPH DECLARATION, IF THE GENERIC SUBPROGRAM BODY IS COMPILED
- --     AS A SUBUNIT IN THE SAME COMPILATION.
- 
- -- HISTORY:
- --     BCB 09/01/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE(REPORT);
- PACKAGE C83025C_PACK IS
-      Y : INTEGER := IDENT_INT(5);
-      Z : INTEGER := Y;
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      A : INTEGER := IDENT_INT(2);
-      B : INTEGER := A;
- 
-      OBJ : INTEGER := IDENT_INT(3);
- 
-      FLO : FLOAT := 5.0;
- 
-      TYPE ENUM IS (ONE, TWO, THREE, FOUR);
- 
-      EOBJ : ENUM := ONE;
- 
-      GENERIC
-           Y : FLOAT := 2.0;
-      PROCEDURE INNER (X : IN OUT INTEGER);
- 
-      GENERIC
-           Y : BOOLEAN := TRUE;
-      PROCEDURE INNER2 (X : IN INTEGER := A;
-                        A : IN OUT INTEGER);
- 
-      GENERIC
-           Y : ENUM := ONE;
-      FUNCTION INNER3 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER;
- 
-      GENERIC
-           Y : ENUM;
-      FUNCTION INNER4 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER;
- 
-      GENERIC
-           Y : CHARACTER := 'A';
-      PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
-                        Z : CHARACTER := Y);
- END C83025C_PACK;
- 
- PACKAGE BODY C83025C_PACK IS
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
-      FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-      FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-      PROCEDURE INNER (X : IN OUT INTEGER) IS SEPARATE;
- 
-      PROCEDURE INNER2 (X : IN INTEGER := C83025C_PACK.A;
-                        A : IN OUT INTEGER) IS SEPARATE;
- 
-      FUNCTION INNER3 (X : INTEGER;
-                       Z : ENUM := Y) RETURN INTEGER IS SEPARATE;
- 
-      FUNCTION INNER4 (X : INTEGER;
-                       Z : ENUM := Y) RETURN INTEGER IS SEPARATE;
- 
-      PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
-                        Z : CHARACTER := Y) IS SEPARATE;
- END C83025C_PACK;
- 
- SEPARATE (C83025C_PACK)
- PROCEDURE INNER (X : IN OUT INTEGER) IS
-      C : INTEGER := A;
-      A : INTEGER := IDENT_INT(3);
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-      END IF;
- 
-      IF C83025C_PACK.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-      END IF;
- 
-      IF C83025C_PACK.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-      END IF;
- 
-      IF C /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 5");
-      END IF;
- 
-      IF Y /= 2.0 THEN
-           FAILED ("INCORRECT VALUE INNER HOMOGRAPH - 6");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           X := A;
-      ELSE
-           X := C83025C_PACK.A;
-      END IF;
- END INNER;
- 
- SEPARATE (C83025C_PACK)
- PROCEDURE INNER2 (X : IN INTEGER := C83025C_PACK.A;
-                  A : IN OUT INTEGER) IS
-      C : INTEGER := A;
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
-      END IF;
- 
-      IF C83025C_PACK.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-      END IF;
- 
-      IF C83025C_PACK.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-      END IF;
- 
-      IF C /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 14");
-      END IF;
- 
-      IF Y /= TRUE THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 15");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           A := IDENT_INT(4);
-      ELSE
-           A := 1;
-      END IF;
- END INNER2;
- 
- SEPARATE (C83025C_PACK)
- FUNCTION INNER3 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER IS
-      C : INTEGER := A;
-      A : INTEGER := IDENT_INT(3);
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
-      END IF;
- 
-      IF C83025C_PACK.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
-      END IF;
- 
-      IF C83025C_PACK.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
-      END IF;
- 
-      IF C /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 24");
-      END IF;
- 
-      IF Y /= ONE THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 25");
-      END IF;
- 
-      IF Z /= ONE THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 26");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           RETURN A;
-      ELSE
-           RETURN X;
-      END IF;
- END INNER3;
- 
- SEPARATE (C83025C_PACK)
- FUNCTION INNER4 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER IS
-      C : INTEGER := A;
-      A : INTEGER := IDENT_INT(3);
- BEGIN
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 30");
-      END IF;
- 
-      IF C83025C_PACK.A /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 31");
-      END IF;
- 
-      IF C83025C_PACK.B /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 32");
-      END IF;
- 
-      IF C /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 33");
-      END IF;
- 
-      IF X /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE PASSED IN - 34");
-      END IF;
- 
-      IF Y /= ONE THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 35");
-      END IF;
- 
-      IF Z /= ONE THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 36");
-      END IF;
- 
-      IF EQUAL(1,1) THEN
-           RETURN A;
-      ELSE
-           RETURN X;
-      END IF;
- END INNER4;
- 
- SEPARATE (C83025C_PACK)
- PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
-                   Z : CHARACTER := Y) IS
- BEGIN
-      X := INTEGER(F);
- 
-      IF Y /= 'A' THEN
-           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 40");
-      END IF;
- 
-      IF Z /= 'A' THEN
-           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 41");
-      END IF;
- END INNER5;
- 
- WITH REPORT; USE REPORT;
- WITH C83025C_PACK; USE C83025C_PACK;
- PROCEDURE C83025C IS
- 
-      PROCEDURE NEW_INNER IS NEW INNER;
- 
-      PROCEDURE NEW_INNER2 IS NEW INNER2;
- 
-      FUNCTION NEW_INNER3 IS NEW INNER3;
- 
-      FUNCTION NEW_INNER4 IS NEW INNER4 (Y => EOBJ);
- 
-      PROCEDURE NEW_INNER5 IS NEW INNER5;
- 
- BEGIN
-      TEST ("C83025C", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
-                       "REGION OF A GENERIC SUBPROGRAM HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      A := IDENT_INT(2);
-      B := A;
- 
-      NEW_INNER (A);
- 
-      IF A /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 7");
-      END IF;
- 
-      A := IDENT_INT(2);
- 
-      NEW_INNER2 (A => OBJ);
- 
-      IF OBJ /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 16");
-      END IF;
- 
-      A := IDENT_INT(2);
- 
-      B := A;
- 
-      IF NEW_INNER3(A) /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 27");
-      END IF;
- 
-      A := IDENT_INT(2);
- 
-      B := A;
- 
-      IF NEW_INNER4(A) /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE PASSED OUT - 37");
-      END IF;
- 
-      OBJ := 1;
- 
-      FLO := 6.25;
- 
-      NEW_INNER5 (OBJ, FLO);
- 
-      IF OBJ /= IDENT_INT(6) THEN
-           FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 42");
-      END IF;
- 
-      IF Y /= 5 THEN
-           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 50");
-      END IF;
- 
-      IF Z /= 5 THEN
-           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 51");
-      END IF;
- 
-      RESULT;
- END C83025C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83027a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83027a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83027a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83027a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- C83027A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A RECORD DECLARATION HIDES AN OUTER
- --     DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION
- --     IS DIRECTLY VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE
- --     DECLARATION OF THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS
- --     VISIBLE BY SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
- 
- -- HISTORY:
- --     BCB 09/02/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83027A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83027A", "CHECK THAT A DECLARATION IN A RECORD " &
-                       "DECLARATION HIDES AN OUTER DECLARATION OF " &
-                       "A HOMOGRAPH");
- 
-      ONE:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
-           OBJ : INTEGER := IDENT_INT(3);
- 
-           TYPE INNER2 (A : INTEGER := IDENT_INT(3)) IS RECORD
-                C : INTEGER := ONE.A;
-                D : INTEGER := A;
-           END RECORD;
- 
-           E : INTEGER := A;
- 
-           RECVAR : INNER2;
- 
-      BEGIN  -- ONE
-           IF A /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 1");
-           END IF;
- 
-           IF RECVAR.A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 2");
-           END IF;
- 
-           IF E /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-           END IF;
- 
-           IF RECVAR.C /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-           END IF;
- 
-           IF RECVAR.D /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 5");
-           END IF;
- 
-           IF EQUAL(1,1) THEN
-                OBJ := RECVAR.A;
-           ELSE
-                OBJ := 1;
-           END IF;
- 
-           IF OBJ /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 6");
-           END IF;
-      END ONE;
- 
-      TWO:
-      DECLARE
- 
-           GENERIC
-                A : INTEGER := IDENT_INT(2);
-                B : INTEGER := A;
-           PACKAGE P IS
-                TYPE INNER (C : INTEGER := A;
-                            A : INTEGER := IDENT_INT(3)) IS RECORD
-                     D : INTEGER := A;
-                END RECORD;
-           END P;
- 
-           PACKAGE BODY P IS
-                RECVAR : INNER;
-           BEGIN
-                IF RECVAR.A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
-                END IF;
- 
-                IF A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-                END IF;
- 
-                IF B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-                END IF;
- 
-                IF RECVAR.C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-                END IF;
- 
-                IF RECVAR.D /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 14");
-                END IF;
-           END P;
- 
-           PACKAGE PACK IS NEW P;
- 
-      BEGIN  -- TWO
-           NULL;
-      END TWO;
- 
-      THREE:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
-           OBJ : INTEGER := IDENT_INT(3);
- 
-           TYPE INNER4 (C : INTEGER := A;
-                        A : INTEGER := IDENT_INT(3);
-                        X : INTEGER := THREE.A) IS RECORD
-                D : INTEGER := A;
-           END RECORD;
- 
-           RECVAR : INNER4;
- 
-      BEGIN  -- THREE
-           IF A /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 20");
-           END IF;
- 
-           IF RECVAR.A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 21");
-           END IF;
- 
-           IF RECVAR.C /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 22");
-           END IF;
- 
-           IF RECVAR.D /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
-           END IF;
- 
-           IF RECVAR.X /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 24");
-           END IF;
- 
-           IF EQUAL(1,1) THEN
-                OBJ := RECVAR.A;
-           ELSE
-                OBJ := 1;
-           END IF;
- 
-           IF OBJ /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 25");
-           END IF;
-      END THREE;
- 
-      RESULT;
- END C83027A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83027c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83027c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83027c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83027c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- C83027C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION WITHIN THE DISCRIMINANT PART OF A
- --     PRIVATE TYPE DECLARATION, AN INCOMPLETE TYPE DECLARATION, AND A
- --     GENERIC FORMAL TYPE DECLARATION HIDES AN OUTER DECLARATION OF A
- --     HOMOGRAPH.  ALSO, CHECK THAT THE OUTER DECLARATION IS DIRECTLY
- --     VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE
- --     INNER HOMOGRAPH AND THE OUTER DECLARATION IS VISIBLE BY SELECTION
- --     AFTER THE INNER HOMOGRAPH DECLARATION.
- 
- -- HISTORY:
- --     BCB 09/06/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83027C IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83027C", "CHECK THAT A DECLARATION IN THE DISCRIMINANT " &
-                       "PART OF A PRIVATE TYPE DECLARATION, AN " &
-                       "INCOMPLETE TYPE DECLARATION, AND A GENERIC " &
-                       "FORMAL TYPE DECLARATION HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      ONE:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
- 
-           D : INTEGER := IDENT_INT(2);
- 
-           G : INTEGER := IDENT_INT(2);
-           H : INTEGER := G;
- 
-           TYPE REC (Z : INTEGER) IS RECORD
-                NULL;
-           END RECORD;
- 
-           GENERIC
-                TYPE INNER3 (G : INTEGER) IS PRIVATE;
-           PACKAGE P_ONE IS
-                TYPE INNER (X : INTEGER := A;
-                            A : INTEGER := IDENT_INT(3);
-                            C : INTEGER := ONE.A) IS PRIVATE;
-                TYPE INNER2 (Y : INTEGER := D;
-                             D : INTEGER := IDENT_INT(3);
-                             F : INTEGER := ONE.D);
-                TYPE INNER2 (Y : INTEGER := D;
-                             D : INTEGER := IDENT_INT(3);
-                             F : INTEGER := ONE.D) IS RECORD
-                     E : INTEGER := D;
-                END RECORD;
-           PRIVATE
-                TYPE INNER (X : INTEGER := A;
-                            A : INTEGER := IDENT_INT(3);
-                            C : INTEGER := ONE.A) IS RECORD
-                     B : INTEGER := A;
-                END RECORD;
-           END P_ONE;
- 
-           PACKAGE BODY P_ONE IS
-                RECVAR : INNER;
-                RECVAR2 : INNER2;
-                RECVAR3 : INNER3(3);
-           BEGIN
-                IF RECVAR.A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-                END IF;
- 
-                IF A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-                END IF;
- 
-                IF RECVAR.B /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 3");
-                END IF;
- 
-                IF RECVAR.C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-                END IF;
- 
-                IF RECVAR.X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 5");
-                END IF;
- 
-                IF RECVAR2.D /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 6");
-                END IF;
- 
-                IF D /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 7");
-                END IF;
- 
-                IF RECVAR2.E /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 8");
-                END IF;
- 
-                IF RECVAR2.F /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 9");
-                END IF;
- 
-                IF RECVAR2.Y /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 10");
-                END IF;
- 
-                IF RECVAR3.G /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 11");
-                END IF;
- 
-                IF G /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 12");
-                END IF;
- 
-                IF H /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 13");
-                END IF;
-           END P_ONE;
- 
-           PACKAGE NEW_P_ONE IS NEW P_ONE (REC);
- 
-      BEGIN  -- ONE
-           NULL;
-      END ONE;
- 
-      RESULT;
- END C83027C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83028a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83028a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83028a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83028a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- C83028A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DECLARATION IN A BLOCK STATEMENT HIDES AN OUTER
- --     DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION
- --     IS DIRECTLY VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE
- --     DECLARATION OF THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS
- --     VISIBLE BY SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
- 
- -- HISTORY:
- --     BCB 09/06/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83028A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83028A", "CHECK THAT A DECLARATION IN A BLOCK " &
-                       "STATEMENT HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      ONE:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
- 
-      BEGIN  -- ONE
-           DECLARE
-                C : INTEGER := A;
-                A : INTEGER := IDENT_INT(3);
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-                END IF;
- 
-                IF ONE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-                END IF;
- 
-                IF ONE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-                END IF;
- 
-                IF C /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     ONE.A := A;
-                END IF;
-           END;
- 
-           IF A /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 6");
-           END IF;
-      END ONE;
- 
-      TWO:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
-           OBJ : INTEGER := IDENT_INT(3);
- 
-      BEGIN  -- TWO
-           DECLARE
-                X : INTEGER := A;
-                A : INTEGER := OBJ;
-                C : INTEGER := A;
-           BEGIN
-                IF A /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
-                END IF;
- 
-                IF TWO.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
-                END IF;
- 
-                IF TWO.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
-                END IF;
- 
-                IF C /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
-                END IF;
- 
-                IF X /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE PASSED IN - 14");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     TWO.OBJ := IDENT_INT(4);
-                ELSE
-                     TWO.OBJ := 1;
-                END IF;
-           END;
- 
-           IF OBJ /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 15");
-           END IF;
-      END TWO;
- 
-      THREE:
-      DECLARE                 --  OVERLOADING OF FUNCTIONS.
- 
-           OBJ : INTEGER := 1;
-           FLO : FLOAT := 5.0;
- 
-           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-      BEGIN
-           DECLARE
-                F : FLOAT := 6.25;
-           BEGIN
-                THREE.OBJ := INTEGER(F);
-           END;
- 
-           IF OBJ /= IDENT_INT(6) THEN
-                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 20");
-           END IF;
-      END THREE;
- 
-      RESULT;
- END C83028A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83029a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83029a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83029a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83029a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C83029A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A LOOP PARAMETER HIDES AN OUTER DECLARATION OF A
- --     HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION IS DIRECTLY
- --     VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE DECLARATION OF
- --     THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS VISIBLE BY
- --     SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
- 
- -- HISTORY:
- --     BCB 09/06/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83029A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           X : T;
-      FUNCTION GEN_FUN RETURN T;
- 
-      FUNCTION GEN_FUN RETURN T IS
-      BEGIN
-           RETURN X;
-      END GEN_FUN;
- 
- BEGIN
-      TEST ("C83029A", "CHECK THAT A LOOP PARAMETER HIDES AN OUTER " &
-                       "DECLARATION OF A HOMOGRAPH");
- 
-      ONE:
-      DECLARE
-           A : INTEGER := IDENT_INT(2);
-           B : INTEGER := A;
-           C : INTEGER;
- 
-      BEGIN  -- ONE
- 
-           FOR A IN 1 .. 1 LOOP
-                C := A;
- 
-                IF A /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
-                END IF;
- 
-                IF ONE.A /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
-                END IF;
- 
-                IF ONE.B /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
-                END IF;
- 
-                IF C /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
-                END IF;
- 
-                IF EQUAL(1,1) THEN
-                     ONE.A := A;
-                END IF;
-           END LOOP;
- 
-           IF A /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE PASSED OUT - 6");
-           END IF;
-      END ONE;
- 
-      TWO:
-      DECLARE                 --  OVERLOADING OF FUNCTIONS.
- 
-           OBJ : INTEGER := 1;
-           FLO : FLOAT := 5.0;
- 
-           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
- 
-           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
- 
-      BEGIN
-           FOR F IN 1 .. 1 LOOP
-                OBJ := INTEGER(F);
-           END LOOP;
- 
-           IF OBJ /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE RETURNED - 10");
-           END IF;
-      END TWO;
- 
-      RESULT;
- END C83029A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83030a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83030a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83030a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83030a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- C83030A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY, NO SUBPROGRAM
- --     DECLARED IN AN OUTER DECLARATIVE REGION IS HIDDEN (UNLESS THE
- --     SUBPROGRAM IS A HOMOGRAPH OF THE GENERIC SUBPROGRAM).
- 
- -- HISTORY:
- --     TBN 08/03/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83030A IS
- 
-      GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
-      SWITCH1 : BOOLEAN := TRUE;
- 
-      PROCEDURE P IS
-      BEGIN
-           GLOBAL := IDENT_INT(1);
-      END P;
- 
-      PROCEDURE P (X : INTEGER) IS
-      BEGIN
-           GLOBAL := IDENT_INT(X);
-      END P;
- 
- BEGIN
-      TEST ("C83030A", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY, " &
-                       "NO SUBPROGRAM DECLARED IN AN OUTER " &
-                       "DECLARATIVE REGION IS HIDDEN " &
-                       "(UNLESS THE SUBPROGRAM IS A HOMOGRAPH OF THE " &
-                       "GENERIC SUBPROGRAM)");
- 
-      ONE:
-      DECLARE
-           GENERIC
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-                A : INTEGER := IDENT_INT(2);
-           BEGIN
-                IF SWITCH1 THEN
-                     SWITCH1 := FALSE;
-                     P;
-                     IF GLOBAL /= IDENT_INT(3) THEN
-                          FAILED ("INCORRECT VALUE FOR PROCEDURE CALL " &
-                                  "- 1");
-                     END IF;
-                END IF;
-                P(A);
-                IF GLOBAL /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
-                END IF;
-                GLOBAL := IDENT_INT(3);
-           END P;
- 
-           PROCEDURE NEW_P IS NEW P;
- 
-      BEGIN
-           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
-                FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
-           END IF;
-           NEW_P;
-           IF GLOBAL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
-           END IF;
-      END ONE;
- 
- 
-      TWO:
-      DECLARE
-           GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
-           SWITCH : BOOLEAN := TRUE;
- 
-           GENERIC
-                TYPE T IS (<>);
-           PROCEDURE P (X : T);
- 
-           PROCEDURE P (X : T) IS
-                A : T := T'FIRST;
-           BEGIN
-                IF SWITCH THEN
-                     SWITCH := FALSE;
-                     P (X);
-                     IF GLOBAL /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE FOR PROCEDURE CALL " &
-                                  "- 20");
-                     END IF;
-                     GLOBAL := IDENT_INT(3);
-                ELSE
-                     GLOBAL := IDENT_INT(2);
-                END IF;
-           END P;
- 
-           PROCEDURE NEW_P IS NEW P (INTEGER);
- 
-      BEGIN
-           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
-                FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
-           END IF;
-           NEW_P (1);
-           IF GLOBAL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
-           END IF;
-      END TWO;
- 
- 
-      THREE:
-      DECLARE
-           SWITCH : BOOLEAN := TRUE;
- 
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT(1);
-           END F;
- 
-           FUNCTION F RETURN BOOLEAN IS
-           BEGIN
-                RETURN IDENT_BOOL(FALSE);
-           END F;
- 
-           FUNCTION F (X : INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT(X);
-           END F;
- 
-      BEGIN
-           DECLARE
-                GENERIC
-                FUNCTION F RETURN INTEGER;
- 
-                FUNCTION F RETURN INTEGER IS
-                     A : INTEGER := INTEGER'LAST;
-                BEGIN
-                     IF SWITCH THEN
-                          SWITCH := FALSE;
-                          IF F /= IDENT_INT(3) THEN
-                               FAILED ("INCORRECT VALUE FROM FUNCTION " &
-                                       "CALL - 30");
-                          END IF;
-                     END IF;
-                     IF F(A) /= IDENT_INT(INTEGER'LAST) THEN
-                          FAILED ("INCORRECT VALUE FROM FUNCTION CALL " &
-                                  "- 31");
-                     END IF;
-                     IF F THEN
-                          FAILED ("INCORRECT VALUE FROM FUNCTION CALL " &
-                                  "- 32");
-                     END IF;
-                     RETURN IDENT_INT(3);
-                END F;
- 
-                FUNCTION NEW_F IS NEW F;
- 
-           BEGIN
-                IF NEW_F /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
-                END IF;
-           END;
-      END THREE;
- 
- 
-      FOUR:
-      DECLARE
-           SWITCH : BOOLEAN := TRUE;
- 
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT(1);
-           END F;
- 
-           FUNCTION F RETURN BOOLEAN IS
-           BEGIN
-                RETURN IDENT_BOOL(FALSE);
-           END F;
- 
-      BEGIN
-           DECLARE
-                GENERIC
-                     TYPE T IS (<>);
-                FUNCTION F RETURN T;
- 
-                FUNCTION F RETURN T IS
-                     A : T := T'LAST;
-                BEGIN
-                     IF SWITCH THEN
-                          SWITCH := FALSE;
-                          IF F /= T'LAST THEN
-                               FAILED ("INCORRECT VALUE FROM FUNCTION " &
-                                       "CALL - 40");
-                          END IF;
-                          RETURN T'FIRST;
-                     ELSE
-                          IF F THEN
-                               FAILED ("INCORRECT VALUE FROM FUNCTION " &
-                                       "CALL - 41");
-                          END IF;
-                          RETURN T'LAST;
-                     END IF;
-                END F;
- 
-                FUNCTION NEW_F IS NEW F (INTEGER);
- 
-           BEGIN
-                IF NEW_F /= IDENT_INT(INTEGER'FIRST) THEN
-                     FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
-                END IF;
-           END;
-      END FOUR;
- 
-      RESULT;
- END C83030A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83030c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83030c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83030c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83030c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,263 ****
- -- C83030C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY COMPILED AS A SUBUNIT
- --     IN THE SAME COMPILATION, NON-HOMOGRAPH SUBPROGRAMS DECLARED
- --     OUTSIDE THE GENERIC UNIT, AND HAVING THE SAME IDENTIFIER, ARE NOT
- --     HIDDEN.
- 
- -- HISTORY:
- --     JET 10/17/88  CREATED ORIGINAL TEST.
- --     BCB 10/03/90  ADDED "PRAGMA ELABORATE (REPORT);".
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE C83030C_DECL1 IS
-      GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
-      SWITCH : BOOLEAN := TRUE;
- 
-      PROCEDURE C83030C_PROC1;
-      PROCEDURE C83030C_PROC1 (X : INTEGER);
-      PROCEDURE C83030C_PROC2;
-      PROCEDURE C83030C_PROC2 (X : INTEGER);
-      FUNCTION C83030C_FUNC3 RETURN INTEGER;
-      FUNCTION C83030C_FUNC3 RETURN BOOLEAN;
-      FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER;
-      FUNCTION C83030C_FUNC4 RETURN INTEGER;
-      FUNCTION C83030C_FUNC4 RETURN BOOLEAN;
- END C83030C_DECL1;
- 
- WITH REPORT; USE REPORT;
- WITH C83030C_DECL1; USE C83030C_DECL1;
- PACKAGE C83030C_DECL2 IS
-      GENERIC
-      PROCEDURE C83030C_PROC1;
- 
-      GENERIC
-           TYPE T IS (<>);
-      PROCEDURE C83030C_PROC2 (X : T);
- 
-      GENERIC
-      FUNCTION C83030C_FUNC3 RETURN INTEGER;
- 
-      GENERIC
-           TYPE T IS (<>);
-      FUNCTION C83030C_FUNC4 RETURN T;
- END C83030C_DECL2;
- 
- WITH REPORT; USE REPORT;
- PACKAGE BODY C83030C_DECL1 IS
-      PROCEDURE C83030C_PROC1 IS
-      BEGIN
-           GLOBAL := IDENT_INT(1);
-      END C83030C_PROC1;
- 
-      PROCEDURE C83030C_PROC1 (X : INTEGER) IS
-      BEGIN
-           GLOBAL := IDENT_INT(X);
-      END C83030C_PROC1;
- 
-      PROCEDURE C83030C_PROC2 IS
-      BEGIN
-           GLOBAL := IDENT_INT(1);
-      END C83030C_PROC2;
- 
-      PROCEDURE C83030C_PROC2 (X : INTEGER) IS
-      BEGIN
-           GLOBAL := IDENT_INT(X);
-      END C83030C_PROC2;
- 
-      FUNCTION C83030C_FUNC3 RETURN INTEGER IS
-      BEGIN
-           RETURN IDENT_INT(1);
-      END C83030C_FUNC3;
- 
-      FUNCTION C83030C_FUNC3 RETURN BOOLEAN IS
-      BEGIN
-           RETURN IDENT_BOOL(FALSE);
-      END C83030C_FUNC3;
- 
-      FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN IDENT_INT(X);
-      END C83030C_FUNC3;
- 
-      FUNCTION C83030C_FUNC4 RETURN INTEGER IS
-      BEGIN
-           RETURN IDENT_INT(1);
-      END C83030C_FUNC4;
- 
-      FUNCTION C83030C_FUNC4 RETURN BOOLEAN IS
-      BEGIN
-           RETURN IDENT_BOOL(FALSE);
-      END C83030C_FUNC4;
- END C83030C_DECL1;
- 
- WITH REPORT; USE REPORT;
- WITH C83030C_DECL1; USE C83030C_DECL1;
- PACKAGE BODY C83030C_DECL2 IS
-      PROCEDURE C83030C_PROC1 IS SEPARATE;
-      PROCEDURE C83030C_PROC2 (X : T) IS SEPARATE;
-      FUNCTION C83030C_FUNC3 RETURN INTEGER IS SEPARATE;
-      FUNCTION C83030C_FUNC4 RETURN T IS SEPARATE;
- END C83030C_DECL2;
- 
- SEPARATE (C83030C_DECL2)
- PROCEDURE C83030C_PROC1 IS
-      A : INTEGER := IDENT_INT(2);
- BEGIN
-      IF SWITCH THEN
-           SWITCH := FALSE;
-           C83030C_PROC1;
-           IF GLOBAL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 1");
-           END IF;
-      END IF;
-      C83030C_PROC1(A);
-      IF GLOBAL /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
-      END IF;
-      GLOBAL := IDENT_INT(3);
- END C83030C_PROC1;
- 
- SEPARATE (C83030C_DECL2)
- PROCEDURE C83030C_PROC2 (X : T) IS
-      A : T := T'FIRST;
- BEGIN
-      IF SWITCH THEN
-           SWITCH := FALSE;
-           C83030C_PROC2 (X);
-           IF GLOBAL /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 20");
-           END IF;
-           GLOBAL := IDENT_INT(3);
-      ELSE
-           GLOBAL := IDENT_INT(2);
-      END IF;
- END C83030C_PROC2;
- 
- SEPARATE (C83030C_DECL2)
- FUNCTION C83030C_FUNC3 RETURN INTEGER IS
-      A : INTEGER := INTEGER'LAST;
- BEGIN
-      IF SWITCH THEN
-           SWITCH := FALSE;
-           IF C83030C_FUNC3 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 30");
-           END IF;
-      END IF;
-      IF C83030C_FUNC3(A) /= IDENT_INT(INTEGER'LAST) THEN
-           FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 31");
-      END IF;
-      IF C83030C_FUNC3 THEN
-           FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 32");
-      END IF;
-      RETURN IDENT_INT(3);
- END C83030C_FUNC3;
- 
- SEPARATE (C83030C_DECL2)
- FUNCTION C83030C_FUNC4 RETURN T IS
-      A : T := T'LAST;
- BEGIN
-      IF SWITCH THEN
-           SWITCH := FALSE;
-           IF C83030C_FUNC4 /= T'LAST THEN
-                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 40");
-           END IF;
-           RETURN T'FIRST;
-      ELSE
-           IF C83030C_FUNC4 THEN
-                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 41");
-           END IF;
-           RETURN T'LAST;
-      END IF;
- END C83030C_FUNC4;
- 
- WITH REPORT; USE REPORT;
- WITH C83030C_DECL1, C83030C_DECL2; USE C83030C_DECL1, C83030C_DECL2;
- PROCEDURE C83030C IS
- BEGIN
-      TEST ("C83030C", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY " &
-                       "COMPILED AS A SUBUNIT IN THE SAME COMPILATION," &
-                       " NON-HOMOGRAPH SUBPROGRAMS DECLARED OUTSIDE " &
-                       "THE GENERIC UNIT, AND HAVING THE SAME " &
-                       "IDENTIFIER, ARE NOT HIDDEN");
- 
-      ONE:
-      DECLARE
-           PROCEDURE PROC1 IS NEW C83030C_DECL2.C83030C_PROC1;
-      BEGIN
-           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
-                FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
-           END IF;
-           PROC1;
-           IF GLOBAL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
-           END IF;
- 
-           GLOBAL := IDENT_INT(INTEGER'FIRST);
-           SWITCH := TRUE;
-      END ONE;
- 
-      TWO:
-      DECLARE
-           PROCEDURE PROC2 IS NEW C83030C_DECL2.C83030C_PROC2(INTEGER);
-      BEGIN
-           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
-                FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
-           END IF;
-           PROC2 (1);
-           IF GLOBAL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
-           END IF;
- 
-           SWITCH := TRUE;
-      END TWO;
- 
-      THREE:
-      DECLARE
-           FUNCTION FUNC3 IS NEW C83030C_DECL2.C83030C_FUNC3;
-      BEGIN
-           IF FUNC3 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
-           END IF;
- 
-           SWITCH := TRUE;
-      END THREE;
- 
-      FOUR:
-      DECLARE
-           FUNCTION FUNC4 IS NEW C83030C_DECL2.C83030C_FUNC4 (INTEGER);
-      BEGIN
-           IF FUNC4 /= IDENT_INT(INTEGER'FIRST) THEN
-                FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
-           END IF;
- 
-           GLOBAL := INTEGER'FIRST;
-           SWITCH := TRUE;
-      END FOUR;
- 
-      RESULT;
- END C83030C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83031a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83031a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83031a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83031a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- C83031A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
- --     AN ENUMERATION LITERAL IS HIDDEN BY A SUBPROGRAM DECLARATION OR
- --     A RENAMING DECLARATION WHICH DECLARES A HOMOGRAPH OF THE
- --     OPERATOR OR LITERAL.
- 
- -- HISTORY:
- --     VCL  08/10/88  CREATED ORIGINAL TEST.
- --     JRL  03/20/92  ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C83031A IS
- BEGIN
-      TEST ("C83031A", "AN IMPLICIT DECLARATION OF A PREDEFINED " &
-                       "OPERATOR OR AN ENUMERATION LITERAL IS HIDDEN " &
-                       "BY A SUBPROGRAM DECLARATION OR A RENAMING " &
-                       "DECLARATION WHICH DECLARES A HOMOGRAPH OF THE " &
-                       "OPERATOR OR LITERAL");
- 
-      DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
-           PACKAGE P IS
-                TYPE INT IS RANGE -20 .. 20;
- 
-                M : INT := 3 * INT(IDENT_INT(3));
-                N : INT := 4 + INT(IDENT_INT(4));
- 
-                FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT;
-                TYPE INT2 IS PRIVATE;
-                FUNCTION "+" (LEFT, RIGHT : INT2) RETURN INT2;
-           PRIVATE
-                FUNCTION "+" (LEFT, RIGHT : INT) RETURN INT
-                             RENAMES "/" ;
- 
-                TYPE INT2 IS RANGE -20 .. 20;
-           END P;
-           USE P;
- 
-           PACKAGE BODY P IS
-                FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT IS
-                BEGIN
-                     RETURN LEFT / RIGHT;
-                END "*";
- 
-                FUNCTION "+" (LEFT, RIGHT : INT2) RETURN INT2 IS
-                BEGIN
-                     RETURN LEFT - RIGHT;
-                END "+";
- 
-           BEGIN
-                IF 2 * INT(IDENT_INT(2)) /= 1 THEN
-                     FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
-                             "EXPLICIT '*' OPERATOR - 1");
-                END IF;
- 
-                IF N /= 8 THEN
-                     FAILED ("INCORRECT INITIAL VALUE FOR N - 1");
-                END IF;
-                N := 2 + 2;
-                IF N /= INT(IDENT_INT (1)) THEN
-                FAILED ("INCORRECT VALUE FOR N AFTER CALL TO " &
-                        "EXPLICIT '+' OPERATOR - 1");
-                END IF;
- 
-                DECLARE
-                     Q : INT2 := 8 + 9;
-                BEGIN
-                     IF Q /= -1 THEN
-                          FAILED ("INCORRECT VALUE FOR Q");
-                     END IF;
-                END;
-           END P;
-      BEGIN
-           IF M /= 9 THEN
-                FAILED ("INCORRECT INITIAL VALUE FOR M - 2");
-           END IF;
-           IF 2 * INT(IDENT_INT(2)) /= 1 THEN
-                FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
-                        "EXPLICIT '*' OPERATOR - 2");
-           END IF;
- 
-           N := 2 + 2;
-           IF N /= INT(IDENT_INT (4)) THEN
-                FAILED ("INCORRECT VALUE FOR N AFTER CALL TO " &
-                        "IMPLICIT '+' OPERATOR - 2");
-           END IF;
- 
-      END;
- 
-      DECLARE   -- CHECK SUBPROGRAM DECLARATIONS OF ENUMERATION LITERALS.
- 
-           PACKAGE P1 IS
-                TYPE ENUM1 IS (E11, E12, E13);
-                TYPE PRIV1 IS PRIVATE;
-                FUNCTION E11 RETURN PRIV1;
-           PRIVATE
-                TYPE PRIV1 IS NEW ENUM1;
-                FUNCTION E12 RETURN PRIV1 RENAMES E13;
-           END P1;
-           USE P1;
- 
-           E13 : INTEGER := IDENT_INT (5);
- 
-           FUNCTION E12 RETURN ENUM1 RENAMES E11 ;
- 
-           FUNCTION CHECK (E: ENUM1) RETURN INTEGER IS
-           BEGIN
-                RETURN ENUM1'POS (E);
-           END CHECK;
- 
-           FUNCTION CHECK (E: INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN INTEGER'POS (E);
-           END CHECK;
- 
-           PACKAGE BODY P1 IS
-                FUNCTION E11 RETURN PRIV1 IS
-                BEGIN
-                     RETURN E13;
-                END E11;
-           BEGIN
-                IF PRIV1'(E11) /= E13 THEN
-                     FAILED ("INCORRECT VALUE FOR E11");
-                END IF;
- 
-                IF E12 /= PRIV1'LAST THEN
-                     FAILED ("INCORRECT VALUE FOR E12 - 1");
-                END IF;
-           END P1;
-      BEGIN
-           IF E12 /= ENUM1'FIRST THEN
-                FAILED ("INCORRECT VALUE FOR E12 - 2");
-           END IF;
- 
-           IF CHECK (E13) /= 5 THEN
-                FAILED ("INCORRECT VALUE FOR E13");
-           END IF;
-      END;
-      RESULT;
- END C83031A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83031c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83031c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83031c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83031c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C83031C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
- --     ENUMERATION LITERAL IS HIDDEN BY A GENERIC INSTANTIATION WHICH
- --     DECLARES A HOMOGRAPH OF THE OPERATOR OR LITERAL.
- 
- -- HISTORY:
- --     BCB 09/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83031C IS
- 
- BEGIN
-      TEST ("C83031C", "CHECK THAT AN IMPLICIT DECLARATION OF A " &
-                       "PREDEFINED OPERATOR OR ENUMERATION LITERAL IS " &
-                       "HIDDEN BY A GENERIC INSTANTIATION WHICH " &
-                       "DECLARES A HOMOGRAPH OF THE OPERATOR OR " &
-                       "LITERAL");
- 
-      DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
-           PACKAGE P IS
-                TYPE INT IS RANGE -20 .. 20;
- 
-                GENERIC
-                     TYPE X IS RANGE <>;
-                FUNCTION GEN_FUN (LEFT, RIGHT : X) RETURN X;
-           END P;
-           USE P;
- 
-           PACKAGE BODY P IS
-                FUNCTION GEN_FUN (LEFT, RIGHT : X) RETURN X IS
-                BEGIN
-                     RETURN LEFT / RIGHT;
-                END GEN_FUN;
- 
-                FUNCTION "*" IS NEW GEN_FUN (INT);
-           BEGIN
-                IF 2 * INT(IDENT_INT(2)) /= 1 THEN
-                     FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
-                             "EXPLICIT '*' OPERATOR - 1");
-                END IF;
-           END P;
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE   -- CHECK SUBPROGRAM DECLARATIONS OF ENUMERATION LITERALS.
- 
-           PACKAGE P1 IS
-                TYPE ENUM1 IS (E11, E12, E13);
-                TYPE PRIV1 IS PRIVATE;
- 
-                GENERIC
-                     TYPE X IS (<>);
-                FUNCTION GEN_FUN RETURN X;
-           PRIVATE
-                TYPE PRIV1 IS NEW ENUM1;
-           END P1;
-           USE P1;
- 
-           PACKAGE BODY P1 IS
-                FUNCTION GEN_FUN RETURN X IS
-                BEGIN
-                     RETURN X'LAST;
-                END GEN_FUN;
- 
-                FUNCTION E11 IS NEW GEN_FUN (PRIV1);
-           BEGIN
-                IF PRIV1'(E11) /= E13 THEN
-                     FAILED ("INCORRECT VALUE FOR E11");
-                END IF;
-           END P1;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C83031C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83031e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83031e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83031e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83031e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- C83031E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR IS
- --     HIDDEN BY A GENERIC FORMAL SUBPROGRAM DECLARATION WHICH DECLARES
- --     A HOMOGRAPH OF THE OPERATOR.
- 
- -- HISTORY:
- --     BCB 09/19/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C83031E IS
- 
- BEGIN
-      TEST ("C83031E", "CHECK THAT AN IMPLICIT DECLARATION OF A " &
-                       "PREDEFINED OPERATOR IS HIDDEN BY A GENERIC " &
-                       "FORMAL SUBPROGRAM DECLARATION WHICH DECLARES " &
-                       "A HOMOGRAPH OF THE OPERATOR");
- 
-      DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
-           TYPE INT IS RANGE -20 .. 20;
- 
-           GENERIC
-                WITH FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT;
-           PACKAGE P IS
-           END P;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                IF 2 * INT(IDENT_INT(2)) /= 1 THEN
-                     FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
-                             "EXPLICIT '*' OPERATOR - 1");
-                END IF;
-           END P;
- 
-           FUNCTION MULT (X, Y : INT) RETURN INT IS
-           BEGIN
-                RETURN X / Y;
-           END MULT;
- 
-           PACKAGE NEW_P IS NEW P (MULT);
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C83031E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83032a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83032a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83032a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83032a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C83032A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
- --     AN ENUMERATION LITERAL IS HIDDEN BY A DERIVED SUBPROGRAM
- --     HOMOGRAPH.
- 
- -- HISTORY:
- --     VCL  08/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83032A IS
- BEGIN
-      TEST ("C83032A", "AN IMPLICIT DECLARATION OF A PREDEFINED " &
-                       "OPERATOR OR AN ENUMERATION LITERAL IS HIDDEN " &
-                       "BY A DERIVED SUBPROGRAM HOMOGRAPH");
- 
-      DECLARE             -- CHECK PREDEFINED OPERATOR.
-           PACKAGE P IS
-                TYPE INT IS RANGE -20 .. 20;
-                FUNCTION "ABS" (X : INT) RETURN INT;
-           END P;
-           USE P;
- 
-           TYPE NINT IS NEW INT;
- 
-           I2 : NINT := -5;
- 
-           PACKAGE BODY P IS
-                I1 : NINT := 5;
- 
-                FUNCTION "ABS" (X : INT) RETURN INT IS
-                BEGIN
-                     RETURN INT (- (ABS (INTEGER (X))));
-                END "ABS";
- 
-           BEGIN
-                IF "ABS"(I1) /= -5 THEN
-                     FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
-                             "TO DERIVED ""ABS"" - 1");
-                END IF;
- 
-                I1 := ABS (-10);
-                IF ABS I1 /= NINT(IDENT_INT (-10)) THEN
-                     FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
-                             "TO DERIVED ""ABS"" - 2");
-                END IF;
-           END P;
-      BEGIN
-           IF "ABS"(I2) /= -5 THEN
-                FAILED ("INCORRECT VALUE FOR 'I2' AFTER CALL " &
-                     "TO DERIVED ""ABS"" - 1");
-           END IF;
- 
-           I2 := ABS (10);
-           IF ABS I2 /= NINT (IDENT_INT (-10)) THEN
-                FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
-                         "TO DERIVED ""ABS"" - 2");
-           END IF;
-      END;
- 
-      DECLARE   -- CHECK ENUMERATION LITERALS.
- 
-           PACKAGE P1 IS
-                TYPE ENUM1 IS (E11, E12, E13);
-                TYPE PRIV1 IS PRIVATE;
-                FUNCTION E11 RETURN PRIV1;
-           PRIVATE
-                TYPE PRIV1 IS NEW ENUM1;
-                TYPE NPRIV1 IS NEW PRIV1;
-           END P1;
-           USE P1;
- 
-           PACKAGE BODY P1 IS
-                FUNCTION E11 RETURN PRIV1 IS
-                BEGIN
-                     RETURN E13;
-                END E11;
-           BEGIN
-                IF NPRIV1'(E11) /= E13 THEN
-                     FAILED ("INCORRECT VALUE FOR E11");
-                END IF;
-           END P1;
- 
-      BEGIN
-           NULL;
-      END;
-      RESULT;
- END C83032A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83033a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83033a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83033a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83033a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- C83033A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK NAME, A LOOP NAME,
- --     OR A STATEMENT LABEL HIDES THE DECLARATION OF AN ENUMERATION
- --     LITERAL OR OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED TYPE
- --     DEFINITION.
- 
- -- HISTORY:
- --     DHH 09/21/88  CREATED ORIGINAL TEST.
- --     WMC 03/25/92  REMOVED TEST REDUNDANCIES.
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C83033A IS
- 
-      PACKAGE BASE_P IS
-           TYPE A IS (RED, BLUE, YELO);
-           FUNCTION RED(T : INTEGER; X : A) RETURN A;
-           FUNCTION BLUE(T : INTEGER; X : A) RETURN A;
-      END BASE_P;
- 
-      PACKAGE BODY BASE_P IS
-           FUNCTION RED(T : INTEGER; X : A) RETURN A IS
-           BEGIN
-                IF EQUAL(T, T) THEN
-                     RETURN X;
-                ELSE
-                     RETURN YELO;
-                END IF;
-           END RED;
- 
-           FUNCTION BLUE(T : INTEGER; X : A) RETURN A IS
-           BEGIN
-                IF EQUAL(T, T) THEN
-                     RETURN X;
-                ELSE
-                     RETURN YELO;
-                END IF;
-           END BLUE;
- 
-      END BASE_P;
- BEGIN
-      TEST ("C83033A", "CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK " &
-                       "NAME, A LOOP NAME, OR A STATEMENT LABEL HIDES " &
-                       "THE DECLARATION OF AN ENUMERATION LITERAL OR " &
-                       "OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED " &
-                       "TYPE DEFINITION");
- 
-      B1:
-      DECLARE
-           TYPE STMT2 IS NEW BASE_P.A;
-      BEGIN
- 
-           DECLARE
-                C, D : STMT2;
-           BEGIN
-                C := C83033A.B1.RED(3, C83033A.B1.RED);
-                D := C83033A.B1.RED;
- 
-                GOTO RED;              -- DEMONSTRATES USE OF STATEMENT LABEL.
-                FAILED("STATEMENT LABEL - 1");
- 
-      <<RED>>   IF C /= D THEN
-                   FAILED("STATEMENT LABEL - 2");
-                END IF;
-           END;
-      END B1;
- 
-      B2:
-      DECLARE
-           TYPE STMT2 IS NEW BASE_P.A;
-      BEGIN
- 
-           DECLARE
-                A : STMT2 := BLUE;
-                B : STMT2 := BLUE(3, BLUE);
-           BEGIN
- 
-                BLUE:
-                FOR I IN 1 .. 1 LOOP
-                     IF A /= B THEN
-                          FAILED("LOOP NAME - 1");
-                     END IF;
-                     EXIT BLUE;                -- DEMONSTRATES USE OF LOOP LABEL.
-                     FAILED("LOOP NAME - 2");
-                END LOOP BLUE;
-           END;
-      END B2;
- 
-      B4:
-      DECLARE
-           PACKAGE P IS
-                GLOBAL : INTEGER := 1;
-                TYPE ENUM IS (GREEN, BLUE);
-                TYPE PRIV IS PRIVATE;
-                FUNCTION GREEN RETURN PRIV;
-           PRIVATE
-                TYPE PRIV IS NEW ENUM;
-           END P;
- 
-           PACKAGE BODY P IS
-                FUNCTION GREEN RETURN PRIV IS
-                BEGIN
-                     GLOBAL := GLOBAL + 1;
-                     RETURN BLUE;
-                END GREEN;
-           BEGIN
-                NULL;
-           END P;
-           USE P;
-      BEGIN
-           GREEN:
-           DECLARE
-                COLOR : PRIV := C83033A.B4.P.GREEN;
-           BEGIN
-                IF GREEN.COLOR /= C83033A.B4.P.GREEN OR ELSE GLOBAL /= 3 THEN
-                   FAILED("BLOCK NAME");
-                END IF;
-           END GREEN;
-      END B4;
- 
-      RESULT;
- END C83033A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83051a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83051a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83051a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83051a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,397 ****
- -- C83051A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DECLARATIONS IN THE VISIBLE PART OF A PACKAGE NESTED
- --     WITHIN THE VISIBLE PART OF A PACKAGE ARE VISIBLE BY SELECTION
- --     FROM OUTSIDE THE OUTERMOST PACKAGE.
- 
- -- HISTORY:
- --     GMT 09/07/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C83051A IS
- 
- BEGIN
-      TEST ("C83051A", "CHECK THAT DECLARATIONS IN THE VISIBLE " &
-                       "PART OF A PACKAGE NESTED WITHIN THE VISIBLE " &
-                       "PART OF A PACKAGE ARE VISIBLE BY SELECTION " &
-                       "FROM OUTSIDE THE OUTERMOST PACKAGE");
-      A_BLOCK:
-      DECLARE
-           PACKAGE APACK IS
-                PACKAGE BPACK  IS
-                     TYPE    T1  IS (RED,GREEN);
-                     TYPE    T2A IS ('A', 'B', 'C', 'D');
-                     TYPE    T3  IS NEW BOOLEAN;
-                     TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
-                     TYPE    T5  IS DIGITS 5;
-                     TYPE    T67 IS DELTA 0.5 RANGE -2.0 .. 10.0;
-                     TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
-                     SUBTYPE T9B IS T9A (1..10);
-                     TYPE    T9C IS ACCESS T9B;
-                     TYPE    T10 IS PRIVATE;
-                     V1       : T3 := FALSE;
-                     ZERO     : CONSTANT T4 := 0;
-                     A_FLT    : T5 := 3.0;
-                     A_FIX    : T67 := -1.0;
-                     ARY      : T9A(1..4) := (TRUE,TRUE,TRUE,FALSE);
-                     P1 : T9C := NEW T9B'( 1..5  => T3'(TRUE),
-                                           6..10 => T3'(FALSE) );
-                     C1 : CONSTANT T10;
- 
-                     FUNCTION RET_T1 (X : T1) RETURN T1;
- 
-                     FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
- 
-                     GENERIC
-                     PROCEDURE DO_NOTHING (X : IN OUT T3);
-                PRIVATE
-                     TYPE T10 IS NEW CHARACTER;
-                     C1 : CONSTANT T10 := 'J';
-                END BPACK;
-           END APACK;
- 
-      PACKAGE BODY APACK IS
-           PACKAGE BODY BPACK IS
-                FUNCTION RET_T1 (X : T1) RETURN T1 IS
-                BEGIN
-                     IF X = RED THEN
-                          RETURN GREEN;
-                     ELSE
-                          RETURN RED;
-                     END IF;
-                END RET_T1;
- 
-                FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
-                BEGIN
-                     RETURN T10(X);
-                END RET_CHAR;
- 
-                PROCEDURE DO_NOTHING (X : IN OUT T3) IS
-                BEGIN
-                     IF X = TRUE THEN
-                          X := FALSE;
-                     ELSE
-                          X := TRUE;
-                     END IF;
-                END DO_NOTHING;
-           END BPACK;
-      END APACK;
- 
-      PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING;
- 
-      BEGIN
- 
-           -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS
- 
-           IF  APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN
-                FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " &
-                        "LITERAL BAD - A1");
-           END IF;
- 
- 
-           -- A2: VISIBILITY FOR OVERLOADED
-           --     ENUMERATION CHARACTER LITERALS
- 
-           IF  APACK.BPACK."<"(APACK.BPACK.T2A'(APACK.BPACK.'C'),
-                               APACK.BPACK.T2A'(APACK.BPACK.'B')) THEN
-                FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " &
-                        "LITERAL BAD - A2");
-           END IF;
- 
- 
-           -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE
- 
-           IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK.BPACK.TRUE),
-                              APACK.BPACK.FALSE) THEN
-                FAILED ("VISIBILITY FOR DERIVED BOOLEAN BAD - A3");
-           END IF;
- 
- 
-           -- A4: VISIBILITY FOR AN INTEGER TYPE
- 
-           IF APACK.BPACK."/="(APACK.BPACK."MOD"(6,2),APACK.BPACK.ZERO)
-                THEN FAILED ("VISIBILITY FOR INTEGER TYPE BAD - A4");
-           END IF;
- 
- 
-           -- A5: VISIBILITY FOR A FLOATING POINT TYPE
- 
-           IF APACK.BPACK.">"(APACK.BPACK.T5'(2.7),APACK.BPACK.A_FLT)
-                THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5");
-           END IF;
- 
- 
-           -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS
- 
-           IF APACK.BPACK."<"(APACK.BPACK.A_FIX,APACK.BPACK.T67'
-                             (APACK.BPACK."-"(1.5))) THEN
-                FAILED ("VISIBILITY FOR FIXED POINT WITH UNARY MINUS " &
-                        "BAD - A6");
-           END IF;
- 
- 
-           -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER
- 
-           IF APACK.BPACK."/="(APACK.BPACK.T67(-0.5),APACK.BPACK."/"
-                              (APACK.BPACK.A_FIX,2)) THEN
-                FAILED ("VISIBILITY FOR FIXED POINT DIVIDED BY " &
-                        "INTEGER BAD - A7");
-           END IF;
- 
- 
-           -- A8: VISIBILITY FOR ARRAY EQUALITY
- 
-           IF APACK.BPACK."/="(APACK.BPACK.ARY,(APACK.BPACK.T3(TRUE),
-              APACK.BPACK.T3(TRUE),APACK.BPACK.T3(TRUE),
-              APACK.BPACK.T3(FALSE))) THEN
-                FAILED ("VISIBILITY FOR ARRAY EQUALITY BAD - A8");
-           END IF;
- 
- 
-           -- A9: VISIBILITY FOR ACCESS EQUALITY
- 
-           IF APACK.BPACK."/="(APACK.BPACK.P1(3),
-                               APACK.BPACK.T3(IDENT_BOOL(TRUE)))
-                THEN FAILED ("VISIBILITY FOR ACCESS EQUALITY BAD - A9");
-           END IF;
- 
- 
-           -- A10: VISIBILITY FOR PRIVATE TYPE
- 
-           IF APACK.BPACK."/="(APACK.BPACK.C1,
-                               APACK.BPACK.RET_CHAR('J')) THEN
-                FAILED ("VISIBILITY FOR PRIVATE TYPE BAD - A10");
-           END IF;
- 
- 
-           -- A11: VISIBILITY FOR DERIVED SUBPROGRAM
- 
-           IF APACK.BPACK."/="(APACK.BPACK.RET_T1(APACK.BPACK.RED),
-                               APACK.BPACK.GREEN) THEN
-                FAILED ("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11");
-           END IF;
- 
-           -- A12: VISIBILITY FOR GENERIC SUBPROGRAM
- 
-           NEW_DO_NOTHING (APACK.BPACK.V1);
- 
-           IF APACK.BPACK."/="(APACK.BPACK.V1,APACK.BPACK.T3(TRUE)) THEN
-                FAILED ("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12");
-           END IF;
- 
-      END A_BLOCK;
- 
-      B_BLOCK:
-      DECLARE
-           GENERIC
-                TYPE T1 IS (<>);
-           PACKAGE GENPACK IS
-                PACKAGE APACK IS
-                     PACKAGE BPACK  IS
-                          TYPE    T1  IS (ORANGE,GREEN);
-                          TYPE    T2A IS ('E', 'F', 'G');
-                          TYPE    T3  IS NEW BOOLEAN;
-                          TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
-                          TYPE    T5  IS DIGITS 5;
-                          TYPE    T67 IS DELTA 0.5 RANGE -3.0 .. 25.0;
-                          TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
-                          SUBTYPE T9B IS T9A (2 .. 8);
-                          TYPE    T9C IS ACCESS T9B;
-                          TYPE    T10 IS PRIVATE;
-                          V1    : T3 := TRUE;
-                          SIX   : T4 := 6;
-                          B_FLT : T5 := 4.0;
-                          ARY   : T9A(1..4) := (TRUE,FALSE,TRUE,FALSE);
-                          P1    : T9C := NEW T9B'( 2..4 => T3'(FALSE),
-                                                   5..8 => T3'(TRUE));
-                          K1 : CONSTANT T10;
- 
-                          FUNCTION RET_T1 (X : T1) RETURN T1;
- 
-                          FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
- 
-                          GENERIC
-                          PROCEDURE DO_NOTHING (X : IN OUT T3);
-                     PRIVATE
-                          TYPE T10 IS NEW CHARACTER;
-                          K1 : CONSTANT T10 := 'V';
-                     END BPACK;
-                END APACK;
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
-                PACKAGE BODY APACK IS
-                     PACKAGE BODY BPACK IS
-                          FUNCTION RET_T1 (X : T1) RETURN T1 IS
-                          BEGIN
-                               IF X = ORANGE THEN
-                                    RETURN GREEN;
-                               ELSE
-                                    RETURN ORANGE;
-                               END IF;
-                          END RET_T1;
- 
-                          FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
-                          BEGIN
-                               RETURN T10(X);
-                          END RET_CHAR;
- 
-                          PROCEDURE DO_NOTHING (X : IN OUT T3) IS
-                          BEGIN
-                               IF X = TRUE THEN
-                                    X := FALSE;
-                               ELSE
-                                    X := TRUE;
-                               END IF;
-                          END DO_NOTHING;
-                     END BPACK;
-                END APACK;
-           END GENPACK;
- 
-           PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER);
- 
-           PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING;
- 
-      BEGIN
- 
-           -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL
- 
-           IF MYPACK.APACK.BPACK."<"(MYPACK.APACK.BPACK.GREEN,
-                                     MYPACK.APACK.BPACK.ORANGE) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
-                        "UNOVERLOADED ENUMERATION LITERAL BAD - B1");
-           END IF;
- 
- 
-           -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL
- 
-           IF  MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK.
-              APACK.BPACK.'F'),MYPACK.APACK.BPACK.T2A'(MYPACK.APACK.
-              BPACK.'G')) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
-                        "OVERLOADED ENUMERATION LITERAL BAD - B2");
-           END IF;
- 
- 
-           -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK.
-              APACK.BPACK.T3'(MYPACK.APACK.BPACK.TRUE)),MYPACK.APACK.
-              BPACK.FALSE) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
-                        "BOOLEAN BAD - B3");
-           END IF;
- 
- 
-           -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."MOD"(MYPACK.
-              APACK.BPACK.SIX,2),0) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF INTEGER " &
-                        "BAD - B4");
-           END IF;
- 
- 
-           -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT
- 
-           IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T5'(1.9),MYPACK.
-              APACK.BPACK.B_FLT) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FLOATING " &
-                        "POINT BAD - B5");
-           END IF;
- 
- 
-           -- B6: VISIBILITY FOR GENERIC INSTANCE OF
-           --     FIXED POINT UNARY PLUS
- 
-           IF MYPACK.APACK.BPACK."<"(2.5,MYPACK.APACK.BPACK.T67'(MYPACK.
-              APACK.BPACK."+"(1.75))) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
-                        "POINT UNARY PLUS BAD - B6");
-           END IF;
- 
- 
-           -- B7: VISIBILITY FOR GENERIC INSTANCE OF
-           --     FIXED POINT DIVIDED BY INTEGER
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."/"(2.5,4),
-              0.625) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
-                        "POINT DIVIDED BY INTEGER BAD - B7");
-           END IF;
- 
- 
-           -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.ARY,(MYPACK.
-              APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE),MYPACK.
-              APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE))) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ARRAY " &
-                        "EQUALITY BAD - B8");
-           END IF;
- 
- 
-           -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.P1(3),MYPACK.
-              APACK.BPACK.T3(IDENT_BOOL(FALSE))) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ACCESS " &
-                        "EQUALITY BAD - B9");
-           END IF;
- 
- 
-           -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.K1,MYPACK.APACK.
-              BPACK.RET_CHAR('V')) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF PRIVATE " &
-                        "EQUALITY BAD - B10");
-           END IF;
- 
- 
-           -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.RET_T1(MYPACK.
-              APACK.BPACK.ORANGE),MYPACK.APACK.BPACK.GREEN) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
-                        "SUBPROGRAM BAD - B11");
-           END IF;
- 
-           -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM
- 
-           MY_DO_NOTHING (MYPACK.APACK.BPACK.V1);
- 
-           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.V1,
-                                      MYPACK.APACK.BPACK.T3(FALSE)) THEN
-                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF GENERIC " &
-                        "SUBPROGRAM BAD - B12");
-           END IF;
- 
-      END B_BLOCK;
- 
-      RESULT;
- END C83051A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83b02a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83b02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83b02a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83b02a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C83B02A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NESTED LOOPS CAN HAVE IDENTICALLY NAMED PARAMETERS,
- --    AND REFERENCES IN THE INNERMOST LOOP ARE ASSOCIATED WITH THE
- --    INNERMOST PARAMETER, ETC.
- 
- 
- --    RM     4 JUNE 1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83B02A  IS
- 
-      USE REPORT;
- 
-      I , J , K : INTEGER := 1 ;
- 
- BEGIN
- 
-      TEST ( "C83B02A" ,
-             "CHECK THAT NESTED LOOPS CAN HAVE IDENTICALLY NAMED" &
-             " PARAMETERS" );
- 
-                                                         --   I    J    K
-      FOR  LOOP_PAR  IN  2..2  LOOP
-           I := I * LOOP_PAR ;                           --   2    1    1
-           FOR  LOOP_PAR  IN  3..3  LOOP
-                I := I * LOOP_PAR ;                      --   6    1    1
-                FOR  LOOP_PAR  IN  5..5  LOOP
-                     I := I * LOOP_PAR ;                 --  30    1    1
-                     FOR  SECOND_LOOP_PAR  IN  7..7  LOOP
-                          J := J * SECOND_LOOP_PAR ;     --  30    7    1
-                          FOR  SECOND_LOOP_PAR  IN  11..11  LOOP
-                               J := J * SECOND_LOOP_PAR ;--  30   77    1
-                               FOR  SECOND_LOOP_PAR  IN  13..13  LOOP
-                                    J := J *
-                                         SECOND_LOOP_PAR;--  30 1001    1
-                               END LOOP;
-                               K := K * LOOP_PAR ;       --  30 1001    5
-                          END LOOP;
-                          K := K * LOOP_PAR ;            --  30 1001   25
-                     END LOOP;
-                     K := K * LOOP_PAR ;                 --  30 1001  125
-                END LOOP;
-                K := K * LOOP_PAR ;                      --  30 1001  375
-           END LOOP;
-           K := K * LOOP_PAR ;                           --  30 1001  750
-      END LOOP;
- 
-      IF  I /= 30 OR J /= 1001 OR K /= 750  THEN
-            FAILED ( "DID NOT ACCESS INNERMOST ENCLOSING IDENTICALLY " &
-                     "NAMED LOOP PARAMETER IN NESTED LOOPS" );
-      END IF;
- 
-      RESULT;
- 
- END C83B02A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83b02b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83b02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83b02b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83b02b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C83B02B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NON-NESTED LOOPS CAN HAVE IDENTICALLY NAMED PARAMETERS,
- --    AND REFERENCES IN EACH LOOP ARE ASSOCIATED WITH THAT LOOP'S
- --    LOOP PARAMETER.  (THIS IS PART  B  OF THE OBJECTIVE.)
- -- CHECK ALSO THAT A LOOP PARAMETER CAN HAVE THE SAME IDENTIFIER
- --    AS A VARIABLE DECLARED IN THE SCOPE IMMEDIATELY CONTAINING
- --    THE LOOP.  (THIS IS PART  C  OF THE OBJECTIVE.)
- 
- 
- 
- --    RM     6 JUNE 1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83B02B  IS
- 
-      USE REPORT;
- 
-      I , J : INTEGER := 1 ;
- 
- BEGIN
- 
-      TEST ( "C83B02B" ,
-             "CHECK THAT NON-NESTED LOOPS CAN HAVE IDENTICALLY NAMED" &
-             " PARAMETERS" );
- 
-      COMMENT ( "THE NAME MAY BE THE SAME AS THAT OF A VARIABLE" &
-                " KNOWN OUTSIDE THE LOOP" );
- 
-      -- CHECK PART B OF THE OBJECTIVE
-      DECLARE
-           TYPE  WEEKDAY  IS  ( MON , TUE , WED , THU , FRI );
-      BEGIN
- 
-           FOR  LOOP_PAR  IN  3..3  LOOP
-                I := I * LOOP_PAR ;              --    3
-           END LOOP;
- 
-           FOR  LOOP_PAR  IN  FRI..FRI  LOOP
-                I := I * WEEKDAY'POS(LOOP_PAR) ; --   12
-           END LOOP;
- 
-           FOR  LOOP_PAR  IN  7..7  LOOP
-                I := I * LOOP_PAR ;              --  84
-           END LOOP;
- 
-      END;
- 
-      IF I /= 84 THEN
-           FAILED ("DID NOT ACCESS ENCLOSING IDENTICALLY NAMED " &
-                   "LOOP PARAMETER IN NON-NESTED LOOPS");
-      END IF;
- 
-      -- CHECK PART C OF THE OBJECTIVE
-      DECLARE
-           LOOP_PAR : INTEGER := 2 ;
-      BEGIN
- 
-           J := J * LOOP_PAR ;                          --    2
- 
-           FOR  LOOP_PAR  IN  3..3  LOOP
-                J := J * LOOP_PAR ;                     --    6
-           END LOOP;
- 
-           J := J * LOOP_PAR ;                          --   12
- 
-           FOR  LOOP_PAR  IN  5..5  LOOP
-                J := J * LOOP_PAR ;                     --   60
-           END LOOP;
- 
-           J := J * LOOP_PAR ;                          --  120
- 
-           FOR  LOOP_PAR  IN  7..7  LOOP
-                J := J * LOOP_PAR ;                     --  840
-           END LOOP;
- 
-           J := J * LOOP_PAR ;                          -- 1680
- 
-      END;
- 
-      IF J /= 1680 THEN
-           FAILED ("DID NOT ACCESS IDENTICALLY NAMED LOOP PARAMETER " &
-                   "INSIDE NON-NESTED LOOPS OR IDENTICALLY NAMED " &
-                   "VARIABLE OUTSIDE LOOPS");
-      END IF;
- 
-      RESULT;
- 
- END C83B02B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83e02a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83e02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83e02a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83e02a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C83E02A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WITHIN THE BODY OF A SUBPROGRAM A FORMAL PARAMETER CAN BE
- --    USED DIRECTLY IN A RANGE CONSTRAINT, A DISCRIMINANT CONSTRAINT,
- --    AND AN INDEX CONSTRAINT.
- 
- --    RM    8 JULY 1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83E02A  IS
- 
-      USE REPORT;
- 
-      Z : INTEGER := 0 ;
- 
-      PROCEDURE  P1 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
-           X : INTEGER RANGE A+1..1+B ;
-      BEGIN
-           X := A + 1 ;
-           C := X * B + B * X * A ;         -- 4*3+3*4*3=48
-      END ;
- 
-      PROCEDURE  P2 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
-           TYPE  T (MAX : INTEGER)  IS
-                RECORD
-                     VALUE : INTEGER RANGE 1..3 ;
-                END RECORD ;
-           X : T(A);
-      BEGIN
-           X := ( MAX => 4 , VALUE => B ) ; -- ( 4 , 3 )
-           C := 10*C + X.VALUE + 2 ;        -- 10*48+3+2=485
-      END ;
- 
-      FUNCTION  F3 ( A , B : INTEGER )  RETURN INTEGER  IS
-           TYPE  TABLE  IS  ARRAY( A..B ) OF INTEGER ;
-           X : TABLE ;
-           Y : ARRAY( A..B ) OF INTEGER ;
-      BEGIN
-           X(A) := A ;                      -- 5
-           Y(B) := B ;                      -- 6
-           RETURN X(A)-Y(B)+4 ;             -- 3
-      END ;
- 
- 
- BEGIN
- 
-      TEST( "C83E02A" , "CHECK THAT WITHIN THE BODY OF A SUBPROGRAM " &
-                        " A FORMAL PARAMETER CAN BE USED DIRECTLY IN" &
-                        " A RANGE CONSTRAINT, A DISCRIMINANT CONSTRAINT"&
-                        ", AND AN INDEX CONSTRAINT" ) ;
- 
-      P1 ( 3 , 3 , Z );                     --  Z  BECOMES  48
-      P2 ( 4 , F3( 5 , 6 ) , Z );           --  Z  BECOMES 485
- 
-      IF  Z /= 485  THEN
-           FAILED( "ACCESSING ERROR OR COMPUTATION ERROR" );
-      END IF;
- 
-      RESULT;
- 
- END C83E02A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83e02b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83e02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83e02b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83e02b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- C83E02B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WITHIN THE BODY OF A SUBPROGRAM A FORMAL PARAMETER CAN BE
- --    USED IN AN EXCEPTION HANDLER.
- 
- --    RM   10 JULY 1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83E02B  IS
- 
-      USE REPORT;
- 
-      Z : INTEGER := 0 ;
- 
-      PROCEDURE  P1 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
-           E : EXCEPTION ;
-      BEGIN
-           RAISE  E ;
-           FAILED( "FAILURE TO RAISE  E " );
-      EXCEPTION
-           WHEN  E  =>
-                C := A + B ;
-           WHEN  OTHERS  =>
-                FAILED( "WRONG EXCEPTION RAISED" );
-      END ;
- 
- 
- BEGIN
- 
-      TEST( "C83E02B" , "CHECK THAT WITHIN THE BODY OF A SUBPROGRAM " &
-                        " A FORMAL PARAMETER CAN BE USED IN AN EXCEP" &
-                        "TION HANDLER" ) ;
- 
-      P1 ( 3 , 14 , Z );
- 
-      IF  Z /= 17  THEN
-           FAILED( "ACCESSING ERROR OR COMPUTATION ERROR" );
-      END IF;
- 
-      RESULT;
- 
- END C83E02B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83e03a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83e03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83e03a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83e03a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C83E03A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A FORMAL PARAMETER IN A NAMED PARAMETER ASSOCIATION
- --    IS NOT CONFUSED WITH AN ACTUAL PARAMETER IDENTIFIER  HAVING THE
- --    SAME SPELLING.
- 
- 
- --    RM    23 JULY 1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83E03A  IS
- 
-      USE REPORT;
- 
-      P : INTEGER RANGE 1..23 := 17 ;
-      FLOW_INDEX : INTEGER := 0 ;
- 
- BEGIN
- 
-      TEST( "C83E03A" , "CHECK THAT A FORMAL PARAMETER IN A NAMED" &
-                        " PARAMETER ASSOCIATION  IS NOT CONFUSED" &
-                        " WITH AN ACTUAL PARAMETER HAVING THE" &
-                        " SAME SPELLING" );
- 
-      DECLARE
- 
-           PROCEDURE  BUMP  IS
-           BEGIN
-                FLOW_INDEX := FLOW_INDEX + 1 ;
-           END BUMP ;
- 
-           PROCEDURE  P1 ( P : INTEGER )  IS
-           BEGIN
-                IF  P = 17  THEN  BUMP ; END IF ;
-           END ;
- 
-           FUNCTION  F1 ( P : INTEGER ) RETURN INTEGER  IS
-           BEGIN
-                RETURN  P ;
-           END ;
- 
-      BEGIN
- 
-           P1 ( P );
-           P1 ( P => P );
- 
-           IF  F1 ( P + 1 )      = 17 + 1  THEN  BUMP ;  END IF;
-           IF  F1 ( P => P + 1 ) = 17 + 1  THEN  BUMP ;  END IF;
- 
-      END ;
- 
-      IF  FLOW_INDEX /= 4  THEN
-           FAILED( "INCORRECT ACCESSING OR INCORRECT FLOW" );
-      END IF;
- 
-      RESULT;
- 
- END C83E03A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C83F01A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INSIDE A PACKAGE BODY,  AN ATTEMPT TO REFERENCE AN IDENTI-
- --    FIER DECLARED IN THE CORRESPONDING PACKAGE SPECIFICATION
- --    IS SUCCESSFUL, EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
- --    ENVIRONMENT SURROUNDING THE PACKAGE BODY.
- 
- -- NESTED PACKAGE BODIES ARE TESTED IN  C83F01B , C83F01C , C83F01D
- 
- 
- --    RM    05 AUGUST 1980
- --    JRK   13 NOV    1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83F01A  IS
- 
-      USE REPORT;
- 
-      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
- 
-      TYPE  T1  IS  ( A , B , C) ;
- 
-      Z : T1 := A ;
- 
- 
- BEGIN
- 
-      TEST( "C83F01A" , "CHECK THAT INSIDE A PACKAGE BODY, " &
-                        "AN ATTEMPT TO REFERENCE AN IDENTIFIER " &
-                        "DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
-                        "FICATION IS SUCCESSFUL EVEN IF THE SAME IDEN" &
-                        "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
-                        "ING THE PACKAGE BODY" ) ;
- 
-      COMMENT( "NESTED PACKAGE BODIES ARE TESTED IN  C83F01B , -C , -D");
- 
- 
-      DECLARE
- 
- 
-           PACKAGE  P  IS
- 
-                X1 : BOOLEAN := FALSE ;
-                X2 : INTEGER RANGE 1..23 := 11 ;
-                Y1 : BOOLEAN := TRUE ;
-                Y2 : INTEGER := 5 ;
-                T1 : INTEGER := 6 ;
-                Z  : INTEGER := 7 ;
- 
-           END  P ;
- 
- 
-           Y1 , Y2 : INTEGER := 13 ;
- 
- 
-           PACKAGE BODY  P  IS
-           BEGIN
- 
-                X1 := X1 OR Y1 ;
-                Z  :=  Z + T1 ;
-                Y2 := X2 * Y2 ;
- 
-                -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
-                --    ASSIGNMENTS  MANIFEST THEMSELVES AT
-                --    COMPILE TIME AS TYPE ERRORS.
- 
-           END P ;
- 
- 
-      BEGIN
- 
-           IF  X1 /= 17  OR
-               Z  /= A   OR
-               Y2 /= 13   OR
-               NOT P.X1    OR
-               P.Z  /= 13  OR
-               P.Y2 /= 55
-           THEN  FAILED( "INCORRECT ACCESSING" );
-           END IF;
- 
-      END ;
- 
- 
-      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
- 
- END C83F01A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- C83F01B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN ANOTHER PACKAGE BODY
- --    AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
- --    CORRESPONDING PACKAGE SPECIFICATION
- --    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
- --    OUTER PACKAGE (SPECIFICATION OR BODY)  OR  IN THE
- --    ENVIRONMENT SURROUNDING THE OUTER PACKAGE BODY.
- 
- -- INTERACTIONS WITH SEPARATE COMPILATION ARE TESTED IN  C83F01C ,
- --    C83F01D .
- 
- 
- --    RM    08 AUGUST 1980
- --    JRK   13 NOV    1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83F01B  IS
- 
-      USE REPORT;
- 
-      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
- 
-      TYPE  T1  IS  ( A , B , C) ;
- 
-      Z : T1 := A ;
- 
- 
- BEGIN
- 
-      TEST( "C83F01B" , "CHECK THAT INSIDE A NESTED PACKAGE BODY" &
-                        " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
-                        " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
-                        "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
-                        "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
-                        "ING THE PACKAGE BODY" ) ;
- 
-      COMMENT("SEPARATELY COMPILED PACKAGES ARE TESTED IN  C83F01C, -D");
- 
- 
-      DECLARE
- 
- 
-           Y1 , Y2 : INTEGER := 100 ;
- 
- 
-           PACKAGE  OUTER  IS
- 
-                Y3 : INTEGER := 100 ;
- 
-                PACKAGE  P  IS
- 
-                     X1 : BOOLEAN := FALSE ;
-                     X2 : INTEGER RANGE 1..23 := 11 ;
-                     Y1 , Y3 : BOOLEAN := TRUE ;
-                     Y2 , Y4 : INTEGER := 5 ;
-                     T1 : INTEGER := 6 ;
-                     Z  : INTEGER := 7 ;
- 
-                END  P ;
- 
-           END  OUTER ;
- 
- 
-           X2 : INTEGER := 100 ;
- 
- 
-           PACKAGE BODY  OUTER  IS
- 
-                Y4 : INTEGER := 200 ;
- 
-                PACKAGE BODY  P  IS
-                BEGIN
- 
-                     X1 :=  NOT X1  AND  Y1  AND  Y3 ;
-                     Z  :=  Z + T1 ;
-                     Y2 := X2 * Y2 ;
-                     Y4 := X2 * Y4 ;
- 
-                     -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
-                     --    ASSIGNMENTS  MANIFEST THEMSELVES AT
-                     --    COMPILE TIME AS TYPE ERRORS
- 
-                END P ;
- 
-           END OUTER ;
- 
- 
-      BEGIN
- 
-           IF  X1 /= 17   OR
-               Z  /= A    OR
-               Y2 /= 100  OR
-               NOT OUTER.P.X1    OR
-               OUTER.P.Z  /= 13  OR
-               OUTER.P.Y2 /= 55  OR
-               OUTER.P.Y4 /= 55
-           THEN FAILED( "INCORRECT ACCESSING" );
-           END IF;
- 
-      END ;
- 
- 
-      RESULT;   --  POSSIBLE ERROR DURING ELABORATION OF  P
- 
- END C83F01B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- C83F01C0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F01C2M
- 
- -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
- --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F01D0M ,
- --    C83F01D1 ). THE PRESENT FILE CONTAINS THE SPECIFICATION
- --    OF THE PACKAGE. THE BODY IS IN FILE C83F01C1.
- 
- 
- --    RM    13 AUGUST 1980
- --    RM    22 AUGUST 1980
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- 
- PACKAGE  C83F01C0  IS
- 
-      Y3 : INTEGER := 100 ;
- 
-      PACKAGE  P  IS
-      
-           X1 : BOOLEAN := FALSE ;
-           X2 : INTEGER RANGE 1..23 := 11 ;
-           Y1 , Y3 : BOOLEAN := TRUE ;
-           Y2 , Y4 : INTEGER := 5 ;
-           T1 : INTEGER := 6 ;
-           Z  : INTEGER := 7 ;
-      
-      END  P ;
- 
-      PROCEDURE REQUIRE_BODY;
- 
- END  C83F01C0 ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- C83F01C1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F01C2M
- 
- -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
- --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F01D0M ,
- --    C83F01D1 ). THE PRESENT FILE CONTAINS THE BODY OF THE PACKAGE.
- 
- -- FOR THIS FILE, THE FILE NAME AND THE UNIT NAME ARE NOT THE SAME.
- 
- 
- --    RM    13 AUGUST 1980
- --    RM    22 AUGUST 1980
- --    RM    28 AUGUST 1980  ('FAILED(.)' MOVED TO MAIN)
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- 
- PACKAGE BODY  C83F01C0  IS
- 
-      Y4 : INTEGER := 200 ;
- 
-      PACKAGE BODY  P  IS
-      BEGIN
- 
-           X1 :=  NOT X1  AND  Y1  AND  Y3 ;
-           Z  :=  Z + T1 ;
-           Y2 := X2 * Y2 ;
-           Y4 := X2 * Y4 ;
- 
-           -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
-           --    ASSIGNMENTS  MANIFEST THEMSELVES AT
-           --    COMPILE TIME AS TYPE ERRORS.
- 
-           -- ALL 4 ASSIGNMENTS ARE TESTED IN THE MAIN PROGRAM (RATHER
-           --    THAN HERE) TO PRECLUDE FALSE NEGATIVES (WHERE THE LACK
-           --    OF ELABORATION-TIME ERROR MESSAGES SIMPLY MEANS THAT THE
-           --    PACKAGE WAS NOT ELABORATED).
- 
- 
-      END P ;
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
- END C83F01C0 ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- C83F01C2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE
- --    ( C83F01C0 ; SPECIFICATION IN  C83F01C0.ADA ,
- --                 BODY IN           C83F01C1.ADA )
- 
- -- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN A SEPARATELY COMPILED
- --    PACKAGE BODY AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
- --    CORRESPONDING PACKAGE SPECIFICATION
- --    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
- --    OUTER PACKAGE (SPECIFICATION OR BODY).
- 
- -- CASE 1:  PACKAGE IS A FULL-FLEDGED COMPILATION UNIT
- 
- 
- --    RM    11 AUGUST 1980
- --    RM    22 AUGUST 1980
- --    RM    29 AUGUST 1980 (MOVED 'FAILED(.)' FROM C83F01C1.ADA TO HERE)
- 
- 
- WITH REPORT , C83F01C0 ;
- PROCEDURE  C83F01C2M  IS
- 
-      USE  REPORT , C83F01C0 ;
- 
- BEGIN
- 
-      TEST( "C83F01C" , "CHECK THAT INSIDE A  PACKAGE BODY" &
-                        " NESTED WITHIN A SEPARATELY" &
-                        " COMPILED PACKAGE BODY LIBRARY UNIT," &
-                        " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
-                        " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
-                        "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
-                        "TIFIER IS DECLARED IN THE OUTER PACKAGE" &
-                        " (SPECIFICATION OR BODY)" ) ;
- 
-      IF  NOT P.X1    OR
-          P.Z  /= 13  OR
-          P.Y2 /= 55  OR
-          P.Y4 /= 55
-      THEN FAILED( "INCORRECT ACCESSING" );
-      END IF;
- 
-      RESULT ;
- 
- 
- END C83F01C2M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C83F01D0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE BODY SUBUNIT
- --    ( C83F01D1.ADA )
- 
- -- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN A SEPARATELY COMPILED
- --    PACKAGE BODY AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
- --    CORRESPONDING PACKAGE SPECIFICATION
- --    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
- --    OUTER PACKAGE (SPECIFICATION OR BODY).
- 
- -- CASE 2:  PACKAGE BODY IS A COMPILATION SUBUNIT
- 
- 
- --    RM    13 AUGUST 1980
- --    RM    29 AUGUST 1980
- --    JRK   13 NOV    1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83F01D0M  IS
- 
-      USE REPORT ;
- 
-      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
-      Y1      : INTEGER := 157 ;
- 
-      TYPE  T1  IS  ( A , B , C) ;
- 
-      Z : T1 := A ;
- 
- 
-      PACKAGE  C83F01D1  IS
- 
-           Y3 : INTEGER := 100 ;
- 
-           PACKAGE  P  IS
- 
-                X1 : BOOLEAN := FALSE ;
-                X2 : INTEGER RANGE 1..23 := 11 ;
-                Y1 , Y3 : BOOLEAN := TRUE ;
-                Y2 , Y4 : INTEGER := 5 ;
-                T1 : INTEGER := 23 ;
-                Z  : INTEGER := 0 ;
- 
-           END  P ;
- 
-      END  C83F01D1 ;
- 
- 
-      Y2 : INTEGER := 200 ;
- 
- 
-      PACKAGE BODY  C83F01D1  IS SEPARATE ;
- 
- 
- BEGIN
- 
-      TEST( "C83F01D" , "CHECK THAT INSIDE A  PACKAGE BODY" &
-                        " NESTED WITHIN A SEPARATELY" &
-                        " COMPILED PACKAGE BODY SUBUNIT," &
-                        " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
-                        " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
-                        "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
-                        "TIFIER IS DECLARED IN THE OUTER PACKAGE" &
-                        " (SPECIFICATION OR BODY)" ) ;
- 
-      IF  X1 /= 17   OR
-          Z  /= A    OR
-          Y2 /= 200  OR
-          NOT C83F01D1.P.X1    OR
-          C83F01D1.P.Z  /= 23  OR
-          C83F01D1.P.Y2 /= 55  OR
-          C83F01D1.P.Y4 /= 55
-      THEN FAILED( "INCORRECT ACCESSING" );
-      END IF;
- 
-      RESULT ;
- 
- 
- END C83F01D0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- C83F01D1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATELY COMPILED PACKAGE BODY FOR USE WITH  C83F01D0M
- 
- 
- --    RM    13 AUGUST 1980
- --    RM    29 AUGUST 1980
- 
- 
- 
- SEPARATE (C83F01D0M)
- PACKAGE BODY  C83F01D1  IS
- 
-      Y4 : INTEGER := 200 ;
- 
-      PACKAGE BODY  P  IS
-      BEGIN
- 
-           X1 :=  NOT X1  AND  Y1  AND  Y3 ;
-           Z  :=  Z + T1 ;
-           Y2 := X2 * Y2 ;
-           Y4 := X2 * Y4 ;
- 
-           -- ALL 4 ASSIGNMENTS ARE TESTED IN THE MAIN PROGRAM (RATHER
-           --    THAN HERE) TO PRECLUDE FALSE NEGATIVES (WHERE THE LACK
-           --    OF ELABORATION-TIME ERROR MESSAGES SIMPLY MEANS THAT THE
-           --    PACKAGE WAS NOT ELABORATED).
- 
-           -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
-           --    ASSIGNMENTS  MANIFEST THEMSELVES AT
-           --    COMPILE TIME AS TYPE ERRORS.
- 
-      END P ;
- 
- END C83F01D1 ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C83F03A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INSIDE A PACKAGE BODY  AN ATTEMPT TO PLACE AND REFERENCE
- --    A LABEL IS SUCCESSFUL EVEN IF ITS IDENTIFIER IS DECLARED IN THE
- --    ENVIRONMENT SURROUNDING THE PACKAGE BODY.
- 
- -- NESTED PACKAGE BODIES ARE TESTED IN  C83F03B , C83F03C , C83F03D
- 
- 
- --    RM    03 SEPTEMBER 1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83F03A  IS
- 
-      USE REPORT;
- 
-      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
- 
-      TYPE  T1  IS  ( A , B , C) ;
- 
-      Z : T1 := A ;
- 
-      FLOW_INDEX : INTEGER := 0 ;
- 
- BEGIN
- 
-      TEST( "C83F03A" , "CHECK THAT INSIDE A PACKAGE BODY " &
-                        " AN ATTEMPT TO PLACE AND REFERENCE A LABEL" &
-                        " IS SUCCESSFUL EVEN IF ITS IDEN" &
-                        "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
-                        "ING THE PACKAGE BODY" ) ;
- 
- 
-      DECLARE
- 
- 
-           Y1 , Y2 : INTEGER := 13 ;
- 
- 
-           PROCEDURE  BUMP  IS
-           BEGIN
-                FLOW_INDEX := FLOW_INDEX + 1 ;
-           END BUMP ;
- 
- 
-           PACKAGE  P  IS
- 
-                AA : BOOLEAN := FALSE ;
- 
-           END  P ;
- 
- 
-           PACKAGE BODY  P  IS
-           BEGIN
- 
-                GOTO  X1 ;
- 
-                BUMP ;
-                BUMP ;
- 
-                <<X1>>   BUMP ;  GOTO  X2 ;
-                BUMP ;
-                <<T1>>   BUMP ;  GOTO  Z ;
-                BUMP ;
-                <<Y1>>   BUMP ;  GOTO  Y2 ;
-                BUMP ;
-                <<Y2>>   BUMP ;  GOTO  T1 ;
-                BUMP ;
-                <<X2>>   BUMP ;  GOTO  Y1 ;
-                BUMP ;
-                <<Z >>   BUMP ;  GOTO  ENDING ;
-                BUMP ;
- 
-                << ENDING >>  NULL;
- 
-           END P ;
- 
- 
-      BEGIN
- 
-           IF  FLOW_INDEX /= 6
-           THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
-           END IF;
- 
-      END ;
- 
- 
-      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
- 
- END C83F03A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- C83F03B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE ANOTHER PACKAGE BODY
- --    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
- --    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY, TO AN IDENTI-
- --    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION,
- --    OR TO A LABEL IDENTIFIER OR OTHER IDENTIFIER IN THE
- --    ENVIRONMENT SURROUNDING THE OUTER PACKAGE BODY.
- 
- 
- -- INTERACTIONS WITH SEPARATE COMPILATION ARE TESTED IN  C83F03C ,
- --    C83F03D .
- 
- 
- --    RM    04 SEPTEMBER 1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83F03B  IS
- 
-      USE REPORT;
- 
-      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
- 
-      TYPE  T1  IS  ( A , B , C) ;
- 
-      Z : T1 := A ;
- 
-      FLOW_INDEX : INTEGER := 0 ;
- 
- BEGIN
- 
-      TEST( "C83F03B" , "CHECK THAT IF A PACKAGE BODY IS NESTED" &
-                        " INSIDE ANOTHER PACKAGE BODY, THE INNER" &
-                        " PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER" &
-                        " IDENTICAL TO A LABEL IDENTIFIER IN THE OUTER" &
-                        " PACKAGE BODY, TO AN IDENTIFIER DECLARED IN" &
-                        " THE OUTER PACKAGE BODY OR IN ITS SPECIFICA" &
-                        "TION, OR TO A LABEL IDENTIFIER OR OTHER" &
-                        " IDENTIFIER IN THE ENVIRONMENT SURROUNDING" &
-                        " THE OUTER PACKAGE BODY" ) ;
- 
- 
-      DECLARE
- 
- 
-           Y1 , Y2 : INTEGER := 100 ;
- 
-           X2 : INTEGER := 100 ;
- 
- 
-           PROCEDURE  BUMP  IS
-           BEGIN
-                FLOW_INDEX := FLOW_INDEX + 1 ;
-           END BUMP ;
- 
- 
-           PACKAGE  OUTER  IS
- 
-                Y3 : INTEGER := 100 ;
- 
-                TYPE  T3  IS  ( D , E , F ) ;
- 
-                PACKAGE  P  IS
-                     AA : BOOLEAN := FALSE ;
-                END  P ;
- 
-           END  OUTER ;
- 
- 
-           PACKAGE BODY  OUTER  IS
- 
-                Y4 : INTEGER := 200 ;
- 
-                TYPE  T4  IS  ( G , H , I ) ;
- 
-                PACKAGE BODY  P  IS
-                BEGIN
- 
- 
-                     GOTO  X1 ;
- 
-                     BUMP ;
-                     BUMP ;
- 
-                     <<X1>>   BUMP ;  GOTO  X2 ;
-                     BUMP ;
-                     <<T1>>   BUMP ;  GOTO  Z ;
-                     BUMP ;
-                     <<Y1>>   BUMP ;  GOTO  Y2 ;
-                     BUMP ;
-                     <<Y2>>   BUMP ;  GOTO  T1 ;
-                     BUMP ;
-                     <<X2>>   BUMP ;  GOTO  Y1 ;
-                     BUMP ;
-                     <<Z >>   BUMP ;  GOTO  T3 ;
-                     BUMP ;
-                     <<T3>>   BUMP ;  GOTO  T4 ;
-                     BUMP ;
-                     <<LABEL_IN_OUTER>>   BUMP ;  GOTO  LABEL_IN_MAIN ;
-                     BUMP ;
-                     <<Y3>>   BUMP ;  GOTO  Y4 ;
-                     BUMP ;
-                     <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
-                     BUMP ;
-                     <<T4>>   BUMP ;  GOTO  Y3 ;
-                     BUMP ;
-                     <<LABEL_IN_MAIN >>   BUMP ;  GOTO  ENDING ;
-                     BUMP ;
- 
-                     << ENDING >>  NULL;
- 
-                END P ;
- 
-           BEGIN
- 
-                << LABEL_IN_OUTER >>  NULL ;
- 
-           END OUTER ;
- 
- 
-      BEGIN
- 
-           << LABEL_IN_MAIN >>
- 
-           IF  FLOW_INDEX /= 12
-           THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
-           END IF;
- 
-      END ;
- 
- 
-      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
- 
- END C83F03B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- C83F03C0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F03C2M
- 
- -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
- --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F03D0M ,
- --    C83F03D1 ). THE PRESENT FILE CONTAINS THE SPECIFICATION
- --    OF THE PACKAGE.  THE PACKAGE BODY IS IN  C83F03C1.ADA .
- 
- 
- --    RM    04 SEPTEMBER 1980
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- 
- PACKAGE  C83F03C0  IS
- 
-      Y3 : INTEGER := 100 ;
- 
-      TYPE  T3  IS  ( D , E , F ) ;
- 
-      FLOW_INDEX : INTEGER := 0 ;
- 
-      PROCEDURE REQUIRE_BODY;
- 
-      PACKAGE  P  IS
-      
-           AA : BOOLEAN := FALSE ;
-      
-      END  P ;
- 
- END  C83F03C0 ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C83F03C1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F03C2M
- 
- -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
- --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F03D0M ,
- --    C83F03D1 ). THE PRESENT FILE CONTAINS THE BODY OF THE PACKAGE.
- 
- -- FOR THIS FILE, THE FILE NAME AND THE UNIT NAME ARE NOT THE SAME.
- 
- 
- --    RM    05 SEPTEMBER 1980
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- 
- PACKAGE BODY  C83F03C0  IS
- 
-      Y4 : INTEGER := 200 ;
- 
-      TYPE  T4  IS  ( G , H , I ) ;
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           FLOW_INDEX := FLOW_INDEX + 1 ;
-      END BUMP ;
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
-      PACKAGE BODY  P  IS
-      BEGIN
- 
-           GOTO  T3 ;
- 
-           BUMP ;
-           BUMP ;
- 
-           <<T3>>   BUMP ;  GOTO  T4 ;
-           BUMP ;
-           <<LABEL_IN_OUTER>>   BUMP ;  GOTO  ENDING ;
-           BUMP ;
-           <<Y3>>   BUMP ;  GOTO  Y4 ;
-           BUMP ;
-           <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
-           BUMP ;
-           <<T4>>   BUMP ;  GOTO  Y3 ;
-           BUMP ;
- 
-           << ENDING >>  NULL;
- 
-      END P ;
- 
- BEGIN
- 
-      << LABEL_IN_OUTER >>  NULL ;
- 
- END  C83F03C0 ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C83F03C2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE
- --    ( C83F03C0 ; SPECIFICATION IN  C83F03C0.ADA ,
- --                 BODY IN           C83F03C1.ADA )
- 
- -- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE A SEPARATELY COMPILED
- --    PACKAGE BODY
- --    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
- --    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY OR TO AN IDENTI-
- --    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION.
- 
- -- CASE 1:  PACKAGE IS A FULL-FLEDGED COMPILATION UNIT
- 
- 
- --    RM    05 SEPTEMBER 1980
- 
- 
- WITH REPORT , C83F03C0 ;
- PROCEDURE  C83F03C2M  IS
- 
-      USE  REPORT , C83F03C0 ;
- 
- BEGIN
- 
-      TEST( "C83F03C" , "CHECK THAT IF A PACKAGE BODY IS NESTED" &
-                        " INSIDE A SEPARATELY COMPILED PACKAGE BODY" &
-                        " LIBRARY UNIT, THE INNER" &
-                        " PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER" &
-                        " IDENTICAL TO A LABEL IDENTIFIER IN THE OUTER" &
-                        " PACKAGE BODY OR TO AN IDENTIFIER DECLARED IN" &
-                        " THE OUTER PACKAGE BODY OR IN ITS SPECIFICA" &
-                        "TION" ) ;
- 
-      IF  FLOW_INDEX /= 5
-      THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
-      END IF;
- 
-      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
- 
- 
- END C83F03C2M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- C83F03D0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE BODY SUBUNIT
- --    ( C83F03D1.ADA )
- 
- -- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE A SEPARATELY COMPILED
- --    PACKAGE BODY
- --    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
- --    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY OR TO AN IDENTI-
- --    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION
- --    OR IN ITS ENVIRONMENT.
- 
- -- CASE 2:  PACKAGE BODY IS A COMPILATION SUBUNIT
- 
- 
- --    RM    08 SEPTEMBER 1980
- --    JRK   14 NOVEMBER  1980
- 
- 
- WITH REPORT;
- PROCEDURE  C83F03D0M  IS
- 
-      USE REPORT ;
- 
-      X1 : INTEGER := 17 ;
- 
-      TYPE  T1  IS  ( A, B, C ) ;
- 
-      Z : T1 := A ;
- 
-      FLOW_INDEX : INTEGER := 0 ;
- 
- 
-      PACKAGE  C83F03D1  IS
- 
-           Y3 : INTEGER := 100 ;
- 
-           TYPE  T3  IS  ( D , E , F ) ;
- 
-           PACKAGE  P  IS
-                AA : BOOLEAN := FALSE ;
-           END  P ;
- 
-      END  C83F03D1 ;
- 
- 
-      Y1 : INTEGER := 100 ;
- 
- 
-      PACKAGE BODY  C83F03D1  IS SEPARATE ;
- 
- 
- BEGIN
- 
-      TEST( "C83F03D" , "CHECK THE RECOGNITION OF LABELS IN NESTED" &
-                        " PACKAGES SEPARATELY COMPILED AS SUBUNITS" );
- 
-      << LABEL_IN_MAIN >>
- 
-      IF  FLOW_INDEX /= 10
-      THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
-      END IF;
- 
-      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
- 
- 
- END C83F03D0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C83F03D1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATELY COMPILED PACKAGE BODY FOR USE WITH  C83F03D0M
- 
- 
- --    RM    08 SEPTEMBER 1980
- --    JRK   14 NOVEMBER  1980
- 
- 
- 
- SEPARATE (C83F03D0M)
- PACKAGE BODY  C83F03D1  IS
- 
-      Y4 : INTEGER := 200 ;
- 
-      TYPE  T4  IS  ( G , H , I ) ;
- 
-      PROCEDURE  BUMP  IS
-      BEGIN
-           FLOW_INDEX := FLOW_INDEX + 1 ;
-      END BUMP ;
- 
-      PACKAGE BODY  P  IS
-      BEGIN
- 
-           GOTO  X1 ;
- 
-           BUMP ;
-           BUMP ;
- 
-           <<LABEL_IN_MAIN>>   BUMP ;  GOTO  T3 ;
-           BUMP ;
-           <<T1>>   BUMP ;  GOTO  Z ;
-           BUMP ;
-           <<Y1>>   BUMP ;  GOTO  LABEL_IN_MAIN ;
-           BUMP ;
-           <<X1>>   BUMP ;  GOTO  T1 ;
-           BUMP ;
-           <<Z>>    BUMP ;  GOTO  Y1 ;
-           BUMP ;
-           <<T3>>   BUMP ;  GOTO  T4 ;
-           BUMP ;
-           <<LABEL_IN_OUTER>>   BUMP ;  GOTO  ENDING ;
-           BUMP ;
-           <<Y3>>   BUMP ;  GOTO  Y4 ;
-           BUMP ;
-           <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
-           BUMP ;
-           <<T4>>   BUMP ;  GOTO  Y3 ;
-           BUMP ;
- 
-           << ENDING >>  NULL;
- 
-      END P ;
- 
- BEGIN
- 
-      << LABEL_IN_OUTER >>  NULL ;
- 
- END C83F03D1 ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c840001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c840001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c840001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c840001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,257 ****
- -- C840001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for the type determined by the subtype mark of a use type
- --      clause, the declaration of each primitive operator is use-visible
- --      within the scope of the clause, even if explicit operators with the
- --      same names as the type's operators are declared for the subtype. Check
- --      that a call to such an operator executes the body of the type's
- --      operation.
- --
- -- TEST DESCRIPTION:
- --      A type may declare a primitive operator, and a subtype of that type
- --      may overload the operator. If a use type clause names the subtype,
- --      it is the primitive operator of the type (not the subtype) which
- --      is made directly visible, and the primitive operator may be called
- --      unambiguously. Such a call executes the body of the type's operation.
- --
- --      In a package, declare a type for which a predefined operator is
- --      overridden.  In another package, declare a subtype of the type in the
- --      previous package.  Declare another version of the predefined operator
- --      for the subtype.
- --
- --      The main program declares objects of both the type and the explicit
- --      subtype, and uses the "**" operator for both.  In all cases, the
- --      operator declared for the 1st subtype should be the one executed,
- --      since it is the primitive operators of the *type* that are made
- --      visible; the operators which were declared for the explicit subtype
- --      are not primitive operators of the type, since they were declared in
- --      a separate package from the original type.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      23 Sep 99   RLB     Added test case where operator made visible is
- --                          not visible by selection (as in AI-00122).
- --
- --!
- 
- package C840001_0 is
- -- Usage scenario: the predefined operators for a floating point type
- -- are overridden in order to take advantage of improved algorithms.
- 
-    type Precision_Float is new Float range -100.0 .. 100.0;
-    -- Implicit: function "**" (Left: Precision_Float; Right: Integer'Base)
-    -- return Precision_Float;
- 
-    function "**" (Left: Precision_Float; Right: Integer'Base)
-      return Precision_Float;
-    -- Overrides predefined operator.
- 
-    function "+" (Right: Precision_Float)
-      return Precision_Float;
-    -- Overrides predefined operator.
- 
-    -- ... Other overridden operations.
- 
-    TC_Expected : constant Precision_Float := 68.0;
- 
- end C840001_0;
- 
- 
-      --==================================================================--
- 
- package body C840001_0 is
- 
-    function "**" (Left: Precision_Float; Right: Integer'Base)
-      return Precision_Float is
-    begin
-       -- ... Utilize desired algorithm.
-       return (TC_Expected);  -- Artificial for testing purposes.
-    end "**";
- 
-    function "+" (Right: Precision_Float)
-      return Precision_Float is
-    -- Overrides predefined operator.
-    begin
-       return Right*2.0;
-    end "+";
- 
- end C840001_0;
- 
- 
-      --==================================================================--
- 
- -- Take advantage of some even better algorithms designed for positive
- -- floating point values.
- 
- with C840001_0;
- package C840001_1 is
- 
-    subtype Precision_Pos_Float is C840001_0.Precision_Float
-      range 0.0 .. 100.0;
- 
- -- This is not a new type, so it has no primitives of it own. However, it
- -- can declare another version of the operator and call it as long as both it
- -- and the corresponding operator of the 1st subtype are not directly visible
- -- in the same place.
- 
-    function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
-      return Precision_Pos_Float;           -- Accepts only positive exponent.
- 
- end C840001_1;
- 
- 
-      --==================================================================--
- 
- package body C840001_1 is
- 
-    function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
-      return Precision_Pos_Float is
-    begin
-       -- ... Utilize some other algorithms.
-       return 57.0;           -- Artificial for testing purposes.
-    end "**";
- 
- end C840001_1;
- 
- 
-      --==================================================================--
- 
- with Report;
- with C840001_1;
- procedure C840001_2 is
- 
-    -- Note that C840001_0 and it's contents is not visible in any form here.
- 
-    TC_Operand   : C840001_1.Precision_Pos_Float := 41.0;
- 
-    TC_Operand2  : C840001_1.Precision_Pos_Float;
- 
-    use type C840001_1.Precision_Pos_Float;
-       -- Makes the operators of its parent type directly visible, even though
-       -- the parent type and operators are not otherwise visible at all.
- 
- begin
- 
-    TC_Operand2 := +TC_Operand; -- Overridden operator is visible and called.
- 
-    if TC_Operand2 /= 82.0 then -- Predefined equality.
-       Report.Failed ("3rd test: type's overridden operation not called for " &
-                      "operand of 1st subtype");
-    end if;
-    if TC_Operand + 3.0 >= TC_Operand2 - 13.0 then -- Various predefined operators.
-       Report.Failed ("3rd test: wrong result from predefined operators");
-    end if;
- 
- end C840001_2;
- 
-      --==================================================================--
- 
- 
- with C840001_0;
- with C840001_1;
- with C840001_2;
- 
- with Report;
- 
- procedure C840001 is
- 
- begin
-    Report.Test ("C840001", "Check that, for the type determined by the "   &
-                 "subtype mark of a use type clause, the declaration of "   &
-                 "each primitive operator is use-visible within the scope " &
-                 "of the clause, even if explicit operators with the same " &
-                 "names as the type's operators are declared for the subtype");
- 
- 
-    Use_Type_Precision_Pos_Float:
-    declare
-       TC_Operand          : C840001_0.Precision_Float
-                           := C840001_0.Precision_Float(-2.0);
-       TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  6.0;
- 
-       TC_Actual_Type      : C840001_0.Precision_Float;
-       TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
- 
-       use type C840001_1.Precision_Pos_Float;
-       -- Both calls to "**" should return 68.0 (that is, Precision_Float's
-       -- operation should be called).
- 
-    begin
- 
-       TC_Actual_Type := TC_Operand**2;
- 
-       if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
-          Report.Failed ("1st block: type's operation not called for " &
-                         "operand of 1st subtype");
-       end if;
- 
-       TC_Actual_Subtype := TC_Positive_Operand**2;
- 
-       if not (C840001_0."="
-              (TC_Actual_Subtype, C840001_0.TC_Expected)) then
-          Report.Failed ("1st block: type's operation not called for " &
-                         "operand of explicit subtype");
-       end if;
- 
-    end Use_Type_Precision_Pos_Float;
- 
-    Use_Type_Precision_Float:
-    declare
-       TC_Operand          : C840001_0.Precision_Float
-                           := C840001_0.Precision_Float(4.0);
-       TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  7.0;
- 
-       TC_Actual_Type      : C840001_0.Precision_Float;
-       TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
- 
-       use type C840001_0.Precision_Float;
-       -- Again, both calls to "**" should return 68.0.
- 
-   begin
- 
-       TC_Actual_Type := TC_Operand**2;
- 
-       if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
-          Report.Failed ("2nd block: type's operation not called for " &
-                         "operand of 1st subtype");
-       end if;
- 
-       TC_Actual_Subtype := TC_Positive_Operand**2;
- 
-       if not C840001_0."=" (TC_Actual_Subtype, C840001_0.TC_Expected) then
-          Report.Failed ("2nd block: type's operation not called for " &
-                         "operand of explicit subtype");
-       end if;
- 
-    end Use_Type_Precision_Float;
- 
-    C840001_2; -- 3rd test.
- 
-    Report.Result;
- 
- end C840001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- C84002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT:
- 
- --   A) IF A USE CLAUSE NAMES AN ENCLOSING PACKAGE, THE USE CLAUSE
- --      HAS NO EFFECT.
- 
- --   B) IF A DECLARATION IS DIRECTLY VISIBLE PRIOR TO THE OCCURRENCE
- --      OF A USE CLAUSE, AND IS NOT IN THE SET OF POTENTIALLY
- --      VISIBLE DECLARATIONS, IT REMAINS DIRECTLY VISIBLE AFTER THE
- --      USE CLAUSE.
- 
- --   C) IF A HOMOGRAPH FOR A POTENTIALLY VISIBLE SUBPROGRAM OR
- --      OBJECT IS DECLARED AFTER A USE CLAUSE, THE POTENTIALLY
- --      VISIBLE ENTITY IS NO LONGER VISIBLE.
- 
- -- EG  02/16/84
- 
- WITH REPORT;
- 
- PROCEDURE C84002A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C84002A","CHECK THAT DECLARATIONS DIRECTLY VISIBLE PRIOR " &
-                     "TO THE USE CLAUSE REMAIN VISIBLE AFTERWARDS");
- 
-      BEGIN
- 
-           COMMENT ("CASE A : CHECK THAT IF A USE CLAUSE NAMES AN " &
-                    "ENCLOSING PACKAGE, THE USE CLAUSE HAS NO EFFECT");
- 
- CASE_A :  DECLARE
- 
-                PACKAGE P1 IS
-                     X : FLOAT := 1.5;
-                END P1;
-                PACKAGE P2 IS
-                     X : INTEGER := 15;
- 
-                     USE P1;
-                     USE P2;
- 
-                     A : INTEGER := X;
-                END P2;
-                PACKAGE BODY P1 IS
-                BEGIN
-                     NULL;
-                END P1;
-                PACKAGE BODY P2 IS
-                BEGIN
-                     IF X /= IDENT_INT(15) OR X /= P2.X OR
-                        A /= P2.X THEN
-                          FAILED ("CASE A : USE CLAUSE HAS AN EFFECT");
-                     END IF;
-                END P2;
- 
-           BEGIN
- 
-                NULL;
- 
-           END CASE_A;
- 
-           COMMENT ("CASE B : CHECK THAT IF A DECLARATION IS DIRECTLY " &
-                    "VISIBLE PRIOR TO THE OCCURRENCE OF A USE CLAUSE, " &
-                    "AND IS NOT IN THE SET OF POTENTIALLY VISIBLE "     &
-                    "DECLARATIONS, IT REMAINS DIRECTLY VISIBLE");
- 
- CASE_B :  BEGIN
- 
-      CASE_B1 : DECLARE
- 
-                     PACKAGE P1 IS
-                          Y : FLOAT := 1.5;
-                     END P1;
-                     PACKAGE P2 IS
-                          X : INTEGER := 15;
- 
-                          USE P1;
- 
-                          A : INTEGER := X;
-                     END P2;
- 
-                     PACKAGE BODY P1 IS
-                     BEGIN
-                          NULL;
-                     END P1;
-                     PACKAGE BODY P2 IS
-                     BEGIN
-                          IF X /= IDENT_INT(15) OR X /= P2.X OR
-                             A /= P2.X THEN
-                               FAILED ("CASE B1 : DECLARATION NO " &
-                                       "LONGER DIRECTLY VISIBLE");
-                          END IF;
-                     END P2;
- 
-                BEGIN
- 
-                     NULL;
- 
-                END CASE_B1;
- 
-      CASE_B2 : DECLARE
- 
-                     PROCEDURE PROC1 (X : STRING) IS
-                     BEGIN
-                          NULL;
-                     END PROC1;
- 
-                     PACKAGE P1 IS
-                          PROCEDURE PROC1 (X : STRING);
-                     END P1;
-                     PACKAGE BODY P1 IS
-                          PROCEDURE PROC1 (X : STRING) IS
-                          BEGIN
-                               FAILED ("CASE B2 : WRONG PROCEDURE " &
-                                       "DIRECTLY VISIBLE");
-                          END PROC1;
-                     END P1;
- 
-                     USE P1;
- 
-                BEGIN
- 
-                     PROC1 ("ABC");
- 
-                END CASE_B2;
- 
-      CASE_B3 : DECLARE
- 
-                     PROCEDURE PROC1 (X : STRING) IS
-                     BEGIN
-                          NULL;
-                     END PROC1;
- 
-                     PACKAGE P1 IS
-                          PROCEDURE PROC1 (Y : STRING);
-                     END P1;
-                     PACKAGE BODY P1 IS
-                          PROCEDURE PROC1 (Y : STRING) IS
-                          BEGIN
-                               FAILED ("CASE B3 : WRONG PROCEDURE " &
-                                       "DIRECTLY VISIBLE");
-                          END PROC1;
-                     END P1;
- 
-                     USE P1;
- 
-                BEGIN
- 
-                     PROC1 ("ABC");
- 
-                END CASE_B3;
- 
-           END CASE_B;
- 
-           COMMENT ("CASE C : IF A HOMOGRAPH FOR A POTENTIALLY "      &
-                    "VISIBLE SUBPROGRAM OR OBJECT IS DECLARED AFTER " &
-                    "A USE CLAUSE, THE POTENTIALLY VISIBLE ENTITY "   &
-                    "IS NO LONGER VISIBLE");
- 
- CASE_C :  BEGIN
- 
-      CASE_C1 : DECLARE
- 
-                     PACKAGE P1 IS
-                          PROCEDURE PROC1 (X : FLOAT);
-                     END P1;
- 
-                     USE P1;
- 
-                     PACKAGE BODY P1 IS
-                          PROCEDURE PROC1 (X : FLOAT) IS
-                          BEGIN
-                               IF X = -1.5 THEN
-                                    FAILED ("CASE C1 : WRONG PROCEDURE" &
-                                            " CALLED (A)");
-                               ELSIF X /= 1.5 THEN
-                                    FAILED ("CASE C1 : WRONG VALUE " &
-                                            "PASSED (A)");
-                               END IF;
-                          END PROC1;
-                     BEGIN
-                          NULL;
-                     END P1;
- 
-                     PROCEDURE PROC2 IS
-                     BEGIN
-                          PROC1 (1.5);
-                     END PROC2;
- 
-                     PROCEDURE PROC1 (X : FLOAT) IS
-                     BEGIN
-                          IF X = 1.5 THEN
-                               FAILED ("CASE C1 : WRONG PROCEDURE" &
-                                       " CALLED (B)");
-                          ELSIF X /= -1.5 THEN
-                               FAILED ("CASE C1 : WRONG VALUE " &
-                                       "PASSED (B)");
-                          END IF;
-                     END PROC1;
- 
-                BEGIN
- 
-                     PROC2;
-                     PROC1 (-1.5);
- 
-                END CASE_C1;
- 
-      CASE_C2 : DECLARE
- 
-                     PACKAGE P1 IS
-                          X : INTEGER := 15;
-                     END P1;
- 
-                     USE P1;
- 
-                     A : INTEGER := X;
- 
-                     X : BOOLEAN := TRUE;
- 
-                     B : BOOLEAN := X;
- 
-                BEGIN
- 
-                     IF A /= IDENT_INT(15) THEN
-                          FAILED ("CASE C2 : VARIABLE A DOES NOT " &
-                                  "CONTAIN THE CORRECT VALUE");
-                     END IF;
-                     IF B /= IDENT_BOOL(TRUE) THEN
-                          FAILED ("CASE C2 : VARIABLE B DOES NOT " &
-                                  "CONTAIN THE CORRECT VALUE");
-                     END IF;
- 
-                END CASE_C2;
- 
-           END CASE_C;
- 
-      END;
- 
-      RESULT;
- 
- END C84002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C84005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT TWO POTENTIALLY VISIBLE HOMOGRAPHS OF A SUBPROGRAM
- --     IDENTIFIER CAN BE MADE DIRECTLY VISIBLE BY A USE CLAUSE, AND THAT
- --     WHEN DIFFERENT FORMAL PARAMETER NAMES ARE USED THE SUBPROGRAMS
- --     ARE REFERENCED CORRECTLY.
- 
- -- HISTORY:
- --     JET 03/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C84005A IS
- 
-      PACKAGE PACK1 IS
-           FUNCTION FUNK(A : INTEGER) RETURN INTEGER;
-           PROCEDURE PROK(A : INTEGER; B : OUT INTEGER);
-      END PACK1;
- 
-      PACKAGE PACK2 IS
-           FUNCTION FUNK(X : INTEGER) RETURN INTEGER;
-           PROCEDURE PROK(X : INTEGER; Y : OUT INTEGER);
-      END PACK2;
- 
-      USE PACK1, PACK2;
-      VAR1, VAR2 : INTEGER;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION FUNK(A : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF EQUAL (A,A) THEN
-                     RETURN (1);
-                ELSE
-                     RETURN (0);
-                END IF;
-           END FUNK;
- 
-           PROCEDURE PROK(A : INTEGER; B : OUT INTEGER) IS
-           BEGIN
-                IF EQUAL (A,A) THEN
-                     B := 1;
-                ELSE
-                     B := 0;
-                END IF;
-           END PROK;
-      END PACK1;
- 
-      PACKAGE BODY PACK2 IS
-           FUNCTION FUNK(X : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF EQUAL (X,X) THEN
-                     RETURN (2);
-                ELSE
-                     RETURN (0);
-                END IF;
-           END FUNK;
- 
-           PROCEDURE PROK(X : INTEGER; Y : OUT INTEGER) IS
-           BEGIN
-                IF EQUAL (X,X) THEN
-                     Y := 2;
-                ELSE
-                     Y := 0;
-                END IF;
-           END PROK;
-      END PACK2;
- 
- BEGIN
-      TEST ("C84005A", "CHECK THAT TWO POTENTIALLY VISIBLE HOMOGRAPHS " &
-                       "OF A SUBPROGRAM IDENTIFIER CAN BE MADE " &
-                       "DIRECTLY VISIBLE BY A USE CLAUSE, AND THAT " &
-                       "WHEN DIFFERENT FORMAL PARAMETER NAMES ARE " &
-                       "USED, THE SUBPROGRAMS ARE REFERENCED CORRECTLY");
- 
-      IF FUNK(A => 3) /= IDENT_INT(1) THEN
-           FAILED("PACK1.FUNK RETURNS INCORRECT RESULT");
-      END IF;
- 
-      IF FUNK(X => 3) /= IDENT_INT(2) THEN
-           FAILED("PACK2.FUNK RETURNS INCORRECT RESULT");
-      END IF;
- 
-      PROK(A => 3, B => VAR1);
-      PROK(X => 3, Y => VAR2);
- 
-      IF VAR1 /= IDENT_INT(1) THEN
-           FAILED("PACK1.PROK RETURNS INCORRECT RESULT");
-      END IF;
- 
-      IF VAR2 /= IDENT_INT(2) THEN
-           FAILED("PACK2.PROK RETURNS INCORRECT RESULT");
-      END IF;
- 
-      RESULT;
- END C84005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C84008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NAMES MADE VISIBLE BY A USE CLAUSE IN THE VISIBLE
- --     PART OF A PACKAGE ARE VISIBLE IN THE PRIVATE PART AND BODY OF
- --     THE PACKAGE.
- 
- -- HISTORY:
- --     JET 03/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C84008A IS
- 
-      PACKAGE PACK1 IS
-           TYPE A IS RANGE 0..100;
-           TYPE B IS RANGE -100..0;
-      END PACK1;
- 
-      PACKAGE PACK2 IS
-           USE PACK1;
-           TYPE C IS PRIVATE;
-           PROCEDURE PROC (X : OUT A; Y : OUT B);
-      PRIVATE
-           TYPE C IS NEW A RANGE 0..9;
-      END PACK2;
- 
-      VAR1 : PACK1.A;
-      VAR2 : PACK1.B;
- 
-      PACKAGE BODY PACK2 IS
-           PROCEDURE PROC (X : OUT A; Y : OUT B) IS
-                SUBTYPE D IS B RANGE -9..0;
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     X := A'(2);
-                     Y := D'(-2);
-                ELSE
-                     X := A'(0);
-                     Y := D'(0);
-                END IF;
-           END PROC;
-      END PACK2;
- 
- BEGIN
-      TEST ("C84008A", "CHECK THAT THE NAMES MADE VISIBLE BY A USE " &
-                       "CLAUSE IN THE VISIBLE PART OF A PACKAGE ARE " &
-                       "VISIBLE IN THE PRIVATE PART AND BODY OF " &
-                       "THE PACKAGE");
- 
-      PACK2.PROC (VAR1,VAR2);
- 
-      IF PACK1."/=" (VAR1, 2) THEN
-           FAILED("INCORRECT RETURN VALUE FOR VAR1");
-      END IF;
- 
-      IF PACK1."/=" (VAR2, PACK1."-"(2)) THEN
-           FAILED("INCORRECT RETURN VALUE FOR VAR2");
-      END IF;
- 
-      RESULT;
- END C84008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c84009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c84009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C84009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A USE CLAUSE MAKES AN IMPLICITLY OR EXPLICITLY
- --     DECLARED OPERATOR DIRECTLY VISIBLE IF NO HOMOGRAPH OF THE
- --     OPERATOR IS ALREADY DIRECTLY VISIBLE.
- 
- -- HISTORY:
- --     JET 03/10/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C84009A IS
- 
-      TYPE INT IS NEW INTEGER RANGE -100 .. 100;
- 
-      PACKAGE PACK IS
-           FUNCTION "+" (LEFT : INTEGER; RIGHT : INT) RETURN INTEGER;
-           FUNCTION "-" (LEFT, RIGHT : INT) RETURN INT;
-           FUNCTION "-" (RIGHT : INT) RETURN INTEGER;
-           FUNCTION "+" (RIGHT : INT) RETURN INTEGER;
-      END PACK;
- 
-      FUNCTION "+" (RIGHT : INT) RETURN INTEGER IS
-      BEGIN
-           RETURN INTEGER'(1) + INTEGER(RIGHT);
-      END "+";
- 
-      PACKAGE BODY PACK IS
-           FUNCTION "+" (LEFT : INTEGER; RIGHT : INT) RETURN INTEGER IS
-           BEGIN
-                RETURN LEFT + INTEGER(RIGHT);
-           END "+";
- 
-           FUNCTION "-" (LEFT, RIGHT : INT) RETURN INT IS
-           BEGIN
-                FAILED ("BINARY ""-"" ALREADY VISIBLE FOR TYPE INT");
-                RETURN LEFT + (-RIGHT);
-           END "-";
- 
-           FUNCTION "-" (RIGHT : INT) RETURN INTEGER IS
-           BEGIN
-                RETURN INTEGER'(0) - INTEGER(RIGHT);
-           END "-";
- 
-           FUNCTION "+" (RIGHT : INT) RETURN INTEGER IS
-           BEGIN
-                FAILED ("UNARY ""+"" ALREADY VISIBLE FOR TYPE INT");
-                RETURN INTEGER'(0) + INTEGER(RIGHT);
-           END "+";
-      END PACK;
- 
-      USE PACK;
- 
- BEGIN
-      TEST ("C84009A", "CHECK THAT A USE CLAUSE MAKES AN IMPLICITLY " &
-                       "OR EXPLICITLY DECLARED OPERATOR DIRECTLY " &
-                       "VISIBLE IF NO HOMOGRAPH OF THE OPERATOR IS " &
-                       "ALREADY DIRECTLY VISIBLE");
- 
-      IF INTEGER'(10) + INT'(10) /= IDENT_INT(20) THEN
-           FAILED ("INCORRECT RESULT FROM BINARY ""+""");
-      END IF;
- 
-      IF INT'(5) - INT'(3) /= INT'(2) THEN
-           FAILED ("INCORRECT RESULT FROM BINARY ""-""");
-      END IF;
- 
-      IF -INT'(20) /= IDENT_INT(-INTEGER'(20)) THEN
-           FAILED ("INCORRECT RESULT FROM UNARY ""-""");
-      END IF;
- 
-      IF +INT'(20) /= IDENT_INT(+INTEGER'(21)) THEN
-           FAILED ("INCORRECT RESULT FROM UNARY ""+""");
-      END IF;
- 
-      RESULT;
- END C84009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85004b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85004b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85004b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C85004B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RENAMED CONSTANT OBJECT, "IN" PARAMETER OF A
- --     SUBPROGRAM OR ENTRY, "IN" FORMAL GENERIC, RECORD DISCRIMINANT,
- --     LOOP PARAMETER, DEFERRED CONSTANT, OR RENAMED CONSTANT HAS THE
- --     CORRECT VALUE.
- 
- -- HISTORY:
- --     JET 07/25/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85004B IS
- 
-      TYPE A IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      SUBTYPE P IS POSITIVE RANGE 1 .. 10;
- 
-      C1 : CONSTANT INTEGER := 1;
-      X1 : INTEGER RENAMES C1;
-      X2 : INTEGER RENAMES X1;
- 
-      TYPE REC (D : P := 1) IS
-           RECORD
-                I : A(1..D);
-           END RECORD;
-      TYPE ACCREC1 IS ACCESS REC;
-      TYPE ACCREC2 IS ACCESS REC(10);
- 
-      R1 : REC;
-      R2 : REC(10);
-      AR1 : ACCREC1 := NEW REC;
-      AR2 : ACCREC2 := NEW REC(10);
- 
-      X3 : P RENAMES R1.D;
-      X4 : P RENAMES R2.D;
-      X5 : P RENAMES AR1.D;
-      X6 : P RENAMES AR2.D;
- 
-      C2 : CONSTANT A(1..3) := (1, 2, 3);
-      X7 : INTEGER RENAMES C2(1);
- 
-      GENERIC
-           K1 : IN INTEGER;
-      PACKAGE GENPKG IS
-           TYPE K IS PRIVATE;
-           K2 : CONSTANT K;
-      PRIVATE
-           TYPE K IS RANGE 1..100;
-           K2 : CONSTANT K := 5;
-      END GENPKG;
- 
-      TASK FOOEY IS
-           ENTRY ENT1 (I : IN INTEGER);
-      END FOOEY;
- 
-      TASK BODY FOOEY IS
-      BEGIN
-           ACCEPT ENT1 (I : IN INTEGER) DO
-                DECLARE
-                     TX1 : INTEGER RENAMES I;
-                BEGIN
-                     IF TX1 /= IDENT_INT(2) THEN
-                          FAILED ("INCORRECT VALUE");
-                     END IF;
-                END;
-           END ENT1;
-      END FOOEY;
- 
-      PACKAGE BODY GENPKG IS
-           KX1 : INTEGER RENAMES K1;
-           KX2 : K RENAMES K2;
-      BEGIN
-           IF KX1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF KX1");
-           END IF;
- 
-           IF KX2 /= K(IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF KX2");
-           END IF;
-      END GENPKG;
- 
-      PROCEDURE PROC (I : IN INTEGER) IS
-           PX1 : INTEGER RENAMES I;
-      BEGIN
-           IF PX1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF PX1");
-           END IF;
-      END PROC;
- 
-      PACKAGE PKG IS NEW GENPKG(4);
- 
- BEGIN
-      TEST ("C85004B", "CHECK THAT A RENAMED CONSTANT OBJECT, 'IN' " &
-            "PARAMETER OF A SUBPROGRAM OR ENTRY, 'IN' FORMAL GENERIC, " &
-            "RECORD DISCRIMINANT, LOOP PARAMETER, DEFERRED CONSTANT, " &
-            "OR RENAMED CONSTANT HAS THE CORRECT VALUE");
- 
-      FOOEY.ENT1(2);
- 
-      PROC(3);
- 
-      IF X1 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF X1");
-      END IF;
- 
-      IF X2 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF X2");
-      END IF;
- 
-      IF X3 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF X3");
-      END IF;
- 
-      IF X4 /= IDENT_INT(10) THEN
-           FAILED ("INCORRECT VALUE OF X4");
-      END IF;
- 
-      IF X5 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF X5");
-      END IF;
- 
-      IF X6 /= IDENT_INT(10) THEN
-           FAILED ("INCORRECT VALUE OF X6");
-      END IF;
- 
-      IF X7 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF X7");
-      END IF;
- 
-      FOR I IN 1..IDENT_INT(2) LOOP
-           DECLARE
-                X8 : INTEGER RENAMES I;
-           BEGIN
-                IF X8 /= IDENT_INT(I) THEN
-                     FAILED ("INCORRECT VALUE OF X8");
-                END IF;
-           END;
-      END LOOP;
- 
-      RESULT;
- 
- END C85004B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,391 ****
- -- C85005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A VARIABLE CREATED BY AN OBJECT DECLARATION CAN BE
- --     RENAMED AND HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN
- --     BE USED IN AN ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL
- --     SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN
- --     ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF
- --     THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED
- --     BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85005A IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           K1 : INTEGER := 0;
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      TASK TYPE TASK2 IS
-           ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                         TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                         TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
-                         TK1 : IN OUT INTEGER);
-      END TASK2;
- 
-      I1 : INTEGER := 0;
-      A1 : ARRAY1(1..3) := (OTHERS => 0);
-      R1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-      P1 : POINTER1 := NEW INTEGER'(0);
-      V1 : PACK1.PRIVY := PACK1.ZERO;
-      T1 : TASK1;
- 
-      XI1 : INTEGER RENAMES I1;
-      XA1 : ARRAY1 RENAMES A1;
-      XR1 : RECORD1 RENAMES R1;
-      XP1 : POINTER1 RENAMES P1;
-      XV1 : PACK1.PRIVY RENAMES V1;
-      XT1 : TASK1 RENAMES T1;
-      XK1 : INTEGER RENAMES PACK1.K1;
- 
-      I : INTEGER;
-      CHK_TASK : TASK2;
- 
-      GENERIC
-           GI1 : IN OUT INTEGER;
-           GA1 : IN OUT ARRAY1;
-           GR1 : IN OUT RECORD1;
-           GP1 : IN OUT POINTER1;
-           GV1 : IN OUT PACK1.PRIVY;
-           GT1 : IN OUT TASK1;
-           GK1 : IN OUT INTEGER;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
-                       PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
-                       PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
-                       PK1 : OUT INTEGER) IS
- 
-      BEGIN
-           PI1 := PI1 + 1;
-           PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
-           PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
-           PP1 := NEW INTEGER'(P1.ALL + 1);
-           PV1 := PACK1.NEXT(V1);
-           PT1.NEXT;
-           PK1 := PACK1.K1 + 1;
-      END PROC1;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GI1 := GI1 + 1;
-           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
-           GR1 := (D => 1, FIELD1 => GR1.FIELD1+1);
-           GP1 := NEW INTEGER'(GP1.ALL + 1);
-           GV1 := PACK1.NEXT(GV1);
-           GT1.NEXT;
-           GK1 := GK1 + 1;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
-      TASK BODY TASK2 IS
-      BEGIN
-           ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                          TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                          TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
-                          TK1 : IN OUT INTEGER) DO
- 
-                TI1 := I1 + 1;
-                TA1 := (A1(1)+1, A1(2)+1, A1(3)+1);
-                TR1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
-                TP1 := NEW INTEGER'(TP1.ALL + 1);
-                TV1 := PACK1.NEXT(TV1);
-                TT1.NEXT;
-                TK1 := TK1 + 1;
-           END ENTRY1;
-      END TASK2;
- 
- BEGIN
-      TEST ("C85005A", "CHECK THAT A VARIABLE CREATED BY AN OBJECT " &
-                       "DECLARATION CAN BE RENAMED AND HAS THE " &
-                       "CORRECT VALUE, AND THAT THE NEW NAME CAN " &
-                       "BE USED IN AN ASSIGNMENT STATEMENT " &
-                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
-                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
-                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
-                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
-                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
-                       "VALUE OF THE NEW NAME");
- 
-      DECLARE
-           PACKAGE GENPACK1 IS NEW
-                GENERIC1 (XI1, XA1, XR1, XP1, XV1, XT1, XK1);
-      BEGIN
-           NULL;
-      END;
- 
-      IF XI1 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF XI1 (1)");
-      END IF;
- 
-      IF XA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-           FAILED ("INCORRECT VALUE OF XA1 (1)");
-      END IF;
- 
-      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-           FAILED ("INCORRECT VALUE OF XR1 (1)");
-      END IF;
- 
-      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF XP1 (1)");
-      END IF;
- 
-      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.ONE)) THEN
-           FAILED ("INCORRECT VALUE OF XV1 (1)");
-      END IF;
- 
-      XT1.VALU(I);
-      IF I /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (1)");
-      END IF;
- 
-      IF XK1 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF XK1 (1)");
-      END IF;
- 
-      PROC1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
- 
-      IF XI1 /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE OF XI1 (2)");
-      END IF;
- 
-      IF XA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-           FAILED ("INCORRECT VALUE OF XA1 (2)");
-      END IF;
- 
-      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-           FAILED ("INCORRECT VALUE OF XR1 (2)");
-      END IF;
- 
-      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE OF XP1 (2)");
-      END IF;
- 
-      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.TWO)) THEN
-           FAILED ("INCORRECT VALUE OF XV1 (2)");
-      END IF;
- 
-      XT1.VALU(I);
-      IF I /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT RETURN VALUE FROM XT1.VALU (2)");
-      END IF;
- 
-      IF XK1 /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE OF XK1 (2)");
-      END IF;
- 
-      CHK_TASK.ENTRY1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
- 
-      IF XI1 /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE OF XI1 (3)");
-      END IF;
- 
-      IF XA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-           FAILED ("INCORRECT VALUE OF XA1 (3)");
-      END IF;
- 
-      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-           FAILED ("INCORRECT VALUE OF XR1 (3)");
-      END IF;
- 
-      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE OF XP1 (3)");
-      END IF;
- 
-      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.THREE)) THEN
-           FAILED ("INCORRECT VALUE OF XV1 (3)");
-      END IF;
- 
-      XT1.VALU(I);
-      IF I /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (3)");
-      END IF;
- 
-      IF XK1 /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE OF XK1 (3)");
-      END IF;
- 
-      XI1 := XI1 + 1;
-      XA1 := (XA1(1)+1, XA1(2)+1, XA1(3)+1);
-      XR1 := (D => 1, FIELD1 => XR1.FIELD1 + 1);
-      XP1 := NEW INTEGER'(XP1.ALL + 1);
-      XV1 := PACK1.NEXT(XV1);
-      XT1.NEXT;
-      XK1 := XK1 + 1;
- 
-      IF XI1 /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE OF XI1 (4)");
-      END IF;
- 
-      IF XA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-           FAILED ("INCORRECT VALUE OF XA1 (4)");
-      END IF;
- 
-      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-           FAILED ("INCORRECT VALUE OF XR1 (4)");
-      END IF;
- 
-      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE OF XP1 (4)");
-      END IF;
- 
-      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FOUR)) THEN
-           FAILED ("INCORRECT VALUE OF XV1 (4)");
-      END IF;
- 
-      XT1.VALU(I);
-      IF I /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (4)");
-      END IF;
- 
-      IF XK1 /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE OF XK1 (4)");
-      END IF;
- 
-      I1 := I1 + 1;
-      A1 := (A1(1)+1, A1(2)+1, A1(3)+1);
-      R1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
-      P1 := NEW INTEGER'(P1.ALL + 1);
-      V1 := PACK1.NEXT(V1);
-      T1.NEXT;
-      PACK1.K1 := PACK1.K1 + 1;
- 
-      IF XI1 /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT VALUE OF XI1 (5)");
-      END IF;
- 
-      IF XA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-           FAILED ("INCORRECT VALUE OF XA1 (5)");
-      END IF;
- 
-      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-           FAILED ("INCORRECT VALUE OF XR1 (5)");
-      END IF;
- 
-      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT VALUE OF XP1 (5)");
-      END IF;
- 
-      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FIVE)) THEN
-           FAILED ("INCORRECT VALUE OF XV1 (5)");
-      END IF;
- 
-      XT1.VALU(I);
-      IF I /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (5)");
-      END IF;
- 
-      IF XK1 /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT VALUE OF XK1 (5)");
-      END IF;
- 
-      T1.STOP;
- 
-      RESULT;
- END C85005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,366 ****
- -- C85005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM 'IN OUT' FORMAL
- --     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
- --     THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
- --     ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
- --     AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
- --     VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
- --     REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85005B IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      DI1 : INTEGER := 0;
-      DA1 : ARRAY1(1..3) := (OTHERS => 0);
-      DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-      DP1 : POINTER1 := NEW INTEGER'(0);
-      DV1 : PACK1.PRIVY := PACK1.ZERO;
-      DT1 : TASK1;
- 
-      I : INTEGER;
- 
-      GENERIC
-           GI1 : IN OUT INTEGER;
-           GA1 : IN OUT ARRAY1;
-           GR1 : IN OUT RECORD1;
-           GP1 : IN OUT POINTER1;
-           GV1 : IN OUT PACK1.PRIVY;
-           GT1 : IN OUT TASK1;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GI1 := GI1 + 1;
-           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
-           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
-           GP1 := NEW INTEGER'(GP1.ALL + 1);
-           GV1 := PACK1.NEXT(GV1);
-           GT1.NEXT;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
-      PROCEDURE PROC (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
-                      PR1 : IN OUT RECORD1; PP1 : IN OUT POINTER1;
-                      PV1 : IN OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
-           XPI1 : INTEGER RENAMES PI1;
-           XPA1 : ARRAY1 RENAMES PA1;
-           XPR1 : RECORD1 RENAMES PR1;
-           XPP1 : POINTER1 RENAMES PP1;
-           XPV1 : PACK1.PRIVY RENAMES PV1;
-           XPT1 : TASK1 RENAMES PT1;
- 
-           TASK TYPE TASK2 IS
-                ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                              TV1 : IN OUT PACK1.PRIVY;
-                              TT1 : IN OUT TASK1);
-           END TASK2;
- 
-           CHK_TASK : TASK2;
- 
-           PROCEDURE PROC1 (PPI1 : IN OUT INTEGER; PPA1 : IN OUT ARRAY1;
-                            PPR1 : IN OUT RECORD1; PPP1 : OUT POINTER1;
-                            PPV1 : OUT PACK1.PRIVY;
-                            PPT1 : IN OUT TASK1) IS
-           BEGIN
-                PPI1 := PPI1 + 1;
-                PPA1 := (PPA1(1)+1, PPA1(2)+1, PPA1(3)+1);
-                PPR1 := (D => 1, FIELD1 => PPR1.FIELD1 + 1);
-                PPP1 := NEW INTEGER'(PP1.ALL + 1);
-                PPV1 := PACK1.NEXT(PV1);
-                PPT1.NEXT;
-           END PROC1;
- 
-           TASK BODY TASK2 IS
-           BEGIN
-                ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                               TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                               TV1 : IN OUT PACK1.PRIVY;
-                               TT1 : IN OUT TASK1)
-                DO
-                     TI1 := PI1 + 1;
-                     TA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
-                     TR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
-                     TP1 := NEW INTEGER'(TP1.ALL + 1);
-                     TV1 := PACK1.NEXT(TV1);
-                     TT1.NEXT;
-                END ENTRY1;
-           END TASK2;
- 
-           PACKAGE GENPACK1 IS NEW GENERIC1
-                (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
- 
-      BEGIN
-           IF XPI1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XPI1 (1)");
-           END IF;
- 
-           IF XPA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XPA1 (1)");
-           END IF;
- 
-           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XPR1 (1)");
-           END IF;
- 
-           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XPP1 (1)");
-           END IF;
- 
-           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.ONE)) THEN
-                FAILED ("INCORRECT VALUE OF XPV1 (1)");
-           END IF;
- 
-           XPT1.VALU(I);
-           IF I /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (1)");
-           END IF;
- 
-           PROC1(XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
- 
-           IF XPI1 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XPI1 (2)");
-           END IF;
- 
-           IF XPA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XPA1 (2)");
-           END IF;
- 
-           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XPR1 (2)");
-           END IF;
- 
-           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XPP1 (2)");
-           END IF;
- 
-           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.TWO)) THEN
-                FAILED ("INCORRECT VALUE OF XPV1 (2)");
-           END IF;
- 
-           XPT1.VALU(I);
-           IF I /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XPT1.VALU (2)");
-           END IF;
- 
-           CHK_TASK.ENTRY1 (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
- 
-           IF XPI1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XPI1 (3)");
-           END IF;
- 
-           IF XPA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XPA1 (3)");
-           END IF;
- 
-           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XPR1 (3)");
-           END IF;
- 
-           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XPP1 (3)");
-           END IF;
- 
-           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.THREE)) THEN
-                FAILED ("INCORRECT VALUE OF XPV1 (3)");
-           END IF;
- 
-           XPT1.VALU(I);
-           IF I /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (3)");
-           END IF;
- 
-           XPI1 := XPI1 + 1;
-           XPA1 := (XPA1(1)+1, XPA1(2)+1, XPA1(3)+1);
-           XPR1 := (D => 1, FIELD1 => XPR1.FIELD1 + 1);
-           XPP1 := NEW INTEGER'(XPP1.ALL + 1);
-           XPV1 := PACK1.NEXT(XPV1);
-           XPT1.NEXT;
- 
-           IF XPI1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XPI1 (4)");
-           END IF;
- 
-           IF XPA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XPA1 (4)");
-           END IF;
- 
-           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XPR1 (4)");
-           END IF;
- 
-           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XPP1 (4)");
-           END IF;
- 
-           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FOUR)) THEN
-                FAILED ("INCORRECT VALUE OF XPV1 (4)");
-           END IF;
- 
-           XPT1.VALU(I);
-           IF I /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (4)");
-           END IF;
- 
-           PI1 := PI1 + 1;
-           PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
-           PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
-           PP1 := NEW INTEGER'(PP1.ALL + 1);
-           PV1 := PACK1.NEXT(PV1);
-           PT1.NEXT;
- 
-           IF XPI1 /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XPI1 (5)");
-           END IF;
- 
-           IF XPA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XPA1 (5)");
-           END IF;
- 
-           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XPR1 (5)");
-           END IF;
- 
-           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XPP1 (5)");
-           END IF;
- 
-           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FIVE)) THEN
-                FAILED ("INCORRECT VALUE OF XPV1 (5)");
-           END IF;
- 
-           XPT1.VALU(I);
-           IF I /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (5)");
-           END IF;
-      END PROC;
- 
- BEGIN
-      TEST ("C85005B", "CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM " &
-                       "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
-                       "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
-                       "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
-                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
-                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
-                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
-                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
-                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
-                       "VALUE OF THE NEW NAME");
- 
-      PROC (DI1, DA1, DR1, DP1, DV1, DT1);
- 
-      DT1.STOP;
- 
-      RESULT;
- END C85005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,416 ****
- -- C85005C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A VARIABLE CREATED BY AN ENTRY 'IN OUT' FORMAL
- --     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
- --     THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
- --     ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
- --     AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
- --     VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
- --     REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85005C IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      DI1 : INTEGER := 0;
-      DA1 : ARRAY1(1..3) := (OTHERS => 0);
-      DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-      DP1 : POINTER1 := NEW INTEGER'(0);
-      DV1 : PACK1.PRIVY := PACK1.ZERO;
-      DT1 : TASK1;
- 
-      I : INTEGER;
- 
-      GENERIC
-           GI1 : IN OUT INTEGER;
-           GA1 : IN OUT ARRAY1;
-           GR1 : IN OUT RECORD1;
-           GP1 : IN OUT POINTER1;
-           GV1 : IN OUT PACK1.PRIVY;
-           GT1 : IN OUT TASK1;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GI1 := GI1 + 1;
-           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
-           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
-           GP1 := NEW INTEGER'(GP1.ALL + 1);
-           GV1 := PACK1.NEXT(GV1);
-           GT1.NEXT;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
- BEGIN
-      TEST ("C85005C", "CHECK THAT A VARIABLE CREATED BY AN ENTRY " &
-                       "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
-                       "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
-                       "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
-                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
-                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
-                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
-                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
-                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
-                       "VALUE OF THE NEW NAME");
- 
-      DECLARE
-           TASK MAIN_TASK IS
-                ENTRY START (TI1 : IN OUT INTEGER; TA1 : IN OUT ARRAY1;
-                             TR1 : IN OUT RECORD1; TP1 : IN OUT POINTER1;
-                             TV1 : IN OUT PACK1.PRIVY;
-                             TT1 : IN OUT TASK1);
-           END MAIN_TASK;
- 
-           TASK BODY MAIN_TASK IS
-           BEGIN
-                ACCEPT START (TI1: IN OUT INTEGER; TA1: IN OUT ARRAY1;
-                              TR1: IN OUT RECORD1; TP1: IN OUT POINTER1;
-                              TV1: IN OUT PACK1.PRIVY;
-                              TT1: IN OUT TASK1) DO
-                     DECLARE
-                          XTI1 : INTEGER RENAMES TI1;
-                          XTA1 : ARRAY1 RENAMES TA1;
-                          XTR1 : RECORD1 RENAMES TR1;
-                          XTP1 : POINTER1 RENAMES TP1;
-                          XTV1 : PACK1.PRIVY RENAMES TV1;
-                          XTT1 : TASK1 RENAMES TT1;
- 
-                          TASK TYPE TASK2 IS
-                               ENTRY ENTRY1 (TTI1 : OUT INTEGER;
-                                             TTA1 : OUT ARRAY1;
-                                             TTR1 : OUT RECORD1;
-                                             TTP1 : IN OUT POINTER1;
-                                             TTV1 : IN OUT PACK1.PRIVY;
-                                             TTT1 : IN OUT TASK1);
-                          END TASK2;
- 
-                          CHK_TASK : TASK2;
- 
-                          PROCEDURE PROC1 (PTI1 : IN OUT INTEGER;
-                                           PTA1 : IN OUT ARRAY1;
-                                           PTR1 : IN OUT RECORD1;
-                                           PTP1 : OUT POINTER1;
-                                           PTV1 : OUT PACK1.PRIVY;
-                                           PTT1 : IN OUT TASK1) IS
-                          BEGIN
-                               PTI1 := PTI1 + 1;
-                               PTA1 := (PTA1(1)+1, PTA1(2)+1, PTA1(3)+1);
-                               PTR1 := (D => 1,
-                                        FIELD1 => PTR1.FIELD1 + 1);
-                               PTP1 := NEW INTEGER'(TP1.ALL + 1);
-                               PTV1 := PACK1.NEXT(TV1);
-                               PTT1.NEXT;
-                          END PROC1;
- 
-                          TASK BODY TASK2 IS
-                          BEGIN
-                               ACCEPT ENTRY1 (TTI1 : OUT INTEGER;
-                                              TTA1 : OUT ARRAY1;
-                                              TTR1 : OUT RECORD1;
-                                              TTP1 : IN OUT POINTER1;
-                                              TTV1 : IN OUT PACK1.PRIVY;
-                                              TTT1 : IN OUT TASK1)
-                               DO
-                                    TTI1 := TI1 + 1;
-                                    TTA1 := (TA1(1)+1,
-                                    TA1(2)+1, TA1(3)+1);
-                                    TTR1 := (D => 1,
-                                             FIELD1 => TR1.FIELD1 + 1);
-                                    TTP1 := NEW INTEGER'(TTP1.ALL + 1);
-                                    TTV1 := PACK1.NEXT(TTV1);
-                                    TTT1.NEXT;
-                               END ENTRY1;
-                          END TASK2;
- 
-                          PACKAGE GENPACK1 IS NEW GENERIC1
-                               (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
-                     BEGIN
-                          IF XTI1 /= IDENT_INT(1) THEN
-                               FAILED ("INCORRECT VALUE OF XTI1 (1)");
-                          END IF;
- 
-                          IF XTA1 /= (IDENT_INT(1),IDENT_INT(1),
-                                      IDENT_INT(1)) THEN
-                               FAILED ("INCORRECT VALUE OF XTA1 (1)");
-                          END IF;
- 
-                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(1))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTR1 (1)");
-                          END IF;
- 
-                          IF XTP1 /= IDENT(TP1) OR
-                             XTP1.ALL /= IDENT_INT(1) THEN
-                               FAILED ("INCORRECT VALUE OF XTP1 (1)");
-                          END IF;
- 
-                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.ONE))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTV1 (1)");
-                          END IF;
- 
-                          XTT1.VALU(I);
-                          IF I /= IDENT_INT(1) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XTT1.VALU (1)");
-                          END IF;
- 
-                          PROC1(XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
- 
-                          IF XTI1 /= IDENT_INT(2) THEN
-                               FAILED ("INCORRECT VALUE OF XTI1 (2)");
-                          END IF;
- 
-                          IF XTA1 /= (IDENT_INT(2),IDENT_INT(2),
-                                      IDENT_INT(2)) THEN
-                               FAILED ("INCORRECT VALUE OF XTA1 (2)");
-                          END IF;
- 
-                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(2))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTR1 (2)");
-                          END IF;
- 
-                          IF XTP1 /= IDENT(TP1) OR
-                             XTP1.ALL /= IDENT_INT(2) THEN
-                               FAILED ("INCORRECT VALUE OF XTP1 (2)");
-                          END IF;
- 
-                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.TWO))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTV1 (2)");
-                          END IF;
- 
-                          XTT1.VALU(I);
-                          IF I /= IDENT_INT(2) THEN
-                               FAILED ("INCORRECT RETURN VALUE FROM " &
-                                       "XTT1.VALU (2)");
-                          END IF;
- 
-                          CHK_TASK.ENTRY1
-                               (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
- 
-                          IF XTI1 /= IDENT_INT(3) THEN
-                               FAILED ("INCORRECT VALUE OF XTI1 (3)");
-                          END IF;
- 
-                          IF XTA1 /= (IDENT_INT(3),IDENT_INT(3),
-                                      IDENT_INT(3)) THEN
-                               FAILED ("INCORRECT VALUE OF XTA1 (3)");
-                          END IF;
- 
-                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(3))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTR1 (3)");
-                          END IF;
- 
-                          IF XTP1 /= IDENT(TP1) OR
-                             XTP1.ALL /= IDENT_INT(3) THEN
-                               FAILED ("INCORRECT VALUE OF XTP1 (3)");
-                          END IF;
- 
-                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.THREE))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTV1 (3)");
-                          END IF;
- 
-                          XTT1.VALU(I);
-                          IF I /= IDENT_INT(3) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XTT1.VALU (3)");
-                          END IF;
- 
-                          XTI1 := XTI1 + 1;
-                          XTA1 := (XTA1(1)+1, XTA1(2)+1, XTA1(3)+1);
-                          XTR1 := (D => 1, FIELD1 => XTR1.FIELD1 + 1);
-                          XTP1 := NEW INTEGER'(XTP1.ALL + 1);
-                          XTV1 := PACK1.NEXT(XTV1);
-                          XTT1.NEXT;
- 
-                          IF XTI1 /= IDENT_INT(4) THEN
-                               FAILED ("INCORRECT VALUE OF XTI1 (4)");
-                          END IF;
- 
-                          IF XTA1 /= (IDENT_INT(4),IDENT_INT(4),
-                                      IDENT_INT(4)) THEN
-                               FAILED ("INCORRECT VALUE OF XTA1 (4)");
-                          END IF;
- 
-                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(4))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTR1 (4)");
-                          END IF;
- 
-                          IF XTP1 /= IDENT(TP1) OR
-                             XTP1.ALL /= IDENT_INT(4) THEN
-                               FAILED ("INCORRECT VALUE OF XTP1 (4)");
-                          END IF;
- 
-                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FOUR))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTV1 (4)");
-                          END IF;
- 
-                          XTT1.VALU(I);
-                          IF I /= IDENT_INT(4) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XTT1.VALU (4)");
-                          END IF;
- 
-                          TI1 := TI1 + 1;
-                          TA1 := (TA1(1)+1, TA1(2)+1, TA1(3)+1);
-                          TR1 := (D => 1, FIELD1 => TR1.FIELD1 + 1);
-                          TP1 := NEW INTEGER'(TP1.ALL + 1);
-                          TV1 := PACK1.NEXT(TV1);
-                          TT1.NEXT;
- 
-                          IF XTI1 /= IDENT_INT(5) THEN
-                               FAILED ("INCORRECT VALUE OF XTI1 (5)");
-                          END IF;
- 
-                          IF XTA1 /= (IDENT_INT(5),IDENT_INT(5),
-                                      IDENT_INT(5)) THEN
-                               FAILED ("INCORRECT VALUE OF XTA1 (5)");
-                          END IF;
- 
-                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(5))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTR1 (5)");
-                          END IF;
- 
-                          IF XTP1 /= IDENT(TP1) OR
-                             XTP1.ALL /= IDENT_INT(5) THEN
-                               FAILED ("INCORRECT VALUE OF XTP1 (5)");
-                          END IF;
- 
-                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FIVE))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XTV1 (5)");
-                          END IF;
- 
-                          XTT1.VALU(I);
-                          IF I /= IDENT_INT(5) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XTT1.VALU (5)");
-                          END IF;
-                     END;
-                END START;
-           END MAIN_TASK;
- 
-      BEGIN
-           MAIN_TASK.START (DI1, DA1, DR1, DP1, DV1, DT1);
-      END;
- 
-      DT1.STOP;
- 
-      RESULT;
- END C85005C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,378 ****
- -- C85005D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A VARIABLE CREATED BY A GENERIC 'IN OUT' FORMAL
- --     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND
- --     THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND
- --     PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
- --     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
- --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
- --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85005D IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      DI1 : INTEGER := 0;
-      DA1 : ARRAY1(1..3) := (OTHERS => 0);
-      DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-      DP1 : POINTER1 := NEW INTEGER'(0);
-      DV1 : PACK1.PRIVY := PACK1.ZERO;
-      DT1 : TASK1;
- 
-      I : INTEGER;
- 
-      GENERIC
-           GI1 : IN OUT INTEGER;
-           GA1 : IN OUT ARRAY1;
-           GR1 : IN OUT RECORD1;
-           GP1 : IN OUT POINTER1;
-           GV1 : IN OUT PACK1.PRIVY;
-           GT1 : IN OUT TASK1;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-           XGI1 : INTEGER RENAMES GI1;
-           XGA1 : ARRAY1 RENAMES GA1;
-           XGR1 : RECORD1 RENAMES GR1;
-           XGP1 : POINTER1 RENAMES GP1;
-           XGV1 : PACK1.PRIVY RENAMES GV1;
-           XGT1 : TASK1 RENAMES GT1;
- 
-           TASK TYPE TASK2 IS
-                ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                              TV1 : IN OUT PACK1.PRIVY;
-                              TT1 : IN OUT TASK1);
-           END TASK2;
- 
-           G_CHK_TASK : TASK2;
- 
-           GENERIC
-                GGI1 : IN OUT INTEGER;
-                GGA1 : IN OUT ARRAY1;
-                GGR1 : IN OUT RECORD1;
-                GGP1 : IN OUT POINTER1;
-                GGV1 : IN OUT PACK1.PRIVY;
-                GGT1 : IN OUT TASK1;
-           PACKAGE GENERIC2 IS
-           END GENERIC2;
- 
-           PACKAGE BODY GENERIC2 IS
-           BEGIN
-                GGI1 := GGI1 + 1;
-                GGA1 := (GGA1(1)+1, GGA1(2)+1, GGA1(3)+1);
-                GGR1 := (D => 1, FIELD1 => GGR1.FIELD1 + 1);
-                GGP1 := NEW INTEGER'(GGP1.ALL + 1);
-                GGV1 := PACK1.NEXT(GGV1);
-                GGT1.NEXT;
-           END GENERIC2;
- 
-           TASK BODY TASK2 IS
-           BEGIN
-                ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                               TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                               TV1 : IN OUT PACK1.PRIVY;
-                               TT1 : IN OUT TASK1)
-                DO
-                     TI1 := GI1 + 1;
-                     TA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
-                     TR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
-                     TP1 := NEW INTEGER'(TP1.ALL + 1);
-                     TV1 := PACK1.NEXT(TV1);
-                     TT1.NEXT;
-                END ENTRY1;
-           END TASK2;
- 
-           PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
-                            PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
-                            PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
-           BEGIN
-                PI1 := PI1 + 1;
-                PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
-                PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
-                PP1 := NEW INTEGER'(GP1.ALL + 1);
-                PV1 := PACK1.NEXT(GV1);
-                PT1.NEXT;
-           END PROC1;
- 
-           PACKAGE GENPACK2 IS NEW GENERIC2
-                (XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
- 
-      BEGIN
-           IF XGI1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XGI1 (1)");
-           END IF;
- 
-           IF XGA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XGA1 (1)");
-           END IF;
- 
-           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XGR1 (1)");
-           END IF;
- 
-           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XGP1 (1)");
-           END IF;
- 
-           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.ONE)) THEN
-                FAILED ("INCORRECT VALUE OF XGV1 (1)");
-           END IF;
- 
-           XGT1.VALU(I);
-           IF I /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (1)");
-           END IF;
- 
-           PROC1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
- 
-           IF XGI1 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XGI1 (2)");
-           END IF;
- 
-           IF XGA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XGA1 (2)");
-           END IF;
- 
-           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XGR1 (2)");
-           END IF;
- 
-           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XGP1 (2)");
-           END IF;
- 
-           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.TWO)) THEN
-                FAILED ("INCORRECT VALUE OF XGV1 (2)");
-           END IF;
- 
-           XGT1.VALU(I);
-           IF I /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (2)");
-           END IF;
- 
-           G_CHK_TASK.ENTRY1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
- 
-           IF XGI1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XGI1 (3)");
-           END IF;
- 
-           IF XGA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XGA1 (3)");
-           END IF;
- 
-           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XGR1 (3)");
-           END IF;
- 
-           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XGP1 (3)");
-           END IF;
- 
-           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.THREE)) THEN
-                FAILED ("INCORRECT VALUE OF XGV1 (3)");
-           END IF;
- 
-           XGT1.VALU(I);
-           IF I /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (3)");
-           END IF;
- 
-           XGI1 := XGI1 + 1;
-           XGA1 := (XGA1(1)+1, XGA1(2)+1, XGA1(3)+1);
-           XGR1 := (D => 1, FIELD1 => XGR1.FIELD1 + 1);
-           XGP1 := NEW INTEGER'(XGP1.ALL + 1);
-           XGV1 := PACK1.NEXT(XGV1);
-           XGT1.NEXT;
- 
-           IF XGI1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XGI1 (4)");
-           END IF;
- 
-           IF XGA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XGA1 (4)");
-           END IF;
- 
-           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XGR1 (4)");
-           END IF;
- 
-           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XGP1 (4)");
-           END IF;
- 
-           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FOUR)) THEN
-                FAILED ("INCORRECT VALUE OF XGV1 (4)");
-           END IF;
- 
-           XGT1.VALU(I);
-           IF I /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (4)");
-           END IF;
- 
-           GI1 := GI1 + 1;
-           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
-           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
-           GP1 := NEW INTEGER'(GP1.ALL + 1);
-           GV1 := PACK1.NEXT(GV1);
-           GT1.NEXT;
- 
-           IF XGI1 /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XGI1 (5)");
-           END IF;
- 
-           IF XGA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XGA1 (5)");
-           END IF;
- 
-           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XGR1 (5)");
-           END IF;
- 
-           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XGP1 (5)");
-           END IF;
- 
-           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FIVE)) THEN
-                FAILED ("INCORRECT VALUE OF XGV1 (5)");
-           END IF;
- 
-           XGT1.VALU(I);
-           IF I /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (5)");
-           END IF;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
- BEGIN
-      TEST ("C85005D", "CHECK THAT A VARIABLE CREATED BY A GENERIC " &
-                       "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
-                       "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
-                       "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
-                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
-                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
-                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
-                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
-                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
-                       "VALUE OF THE NEW NAME");
- 
-      DECLARE
-           PACKAGE GENPACK1 IS NEW
-                GENERIC1 (DI1, DA1, DR1, DP1, DV1, DT1);
-      BEGIN
-           NULL;
-      END;
- 
-      DT1.STOP;
- 
-      RESULT;
- END C85005D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,397 ****
- -- C85005E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR CAN BE RENAMED AND
- --     HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN
- --     ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR
- --     ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC
- --     'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED
- --     VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF
- --     THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85005E IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PACKACC IS ACCESS INTEGER;
-           AK1 : PACKACC := NEW INTEGER'(0);
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      GENERIC
-           GI1 : IN OUT INTEGER;
-           GA1 : IN OUT ARRAY1;
-           GR1 : IN OUT RECORD1;
-           GP1 : IN OUT POINTER1;
-           GV1 : IN OUT PACK1.PRIVY;
-           GT1 : IN OUT TASK1;
-           GK1 : IN OUT INTEGER;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GI1 := GI1 + 1;
-           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
-           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
-           GP1 := NEW INTEGER'(GP1.ALL + 1);
-           GV1 := PACK1.NEXT(GV1);
-           GT1.NEXT;
-           GK1 := GK1 + 1;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
- BEGIN
-      TEST ("C85005E", "CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR " &
-                       "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
-                       "THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT" &
-                       " STATEMENT AND PASSED ON AS AN ACTUAL " &
-                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
-                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
-                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
-                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE " &
-                       "IS REFLECTED BY THE VALUE OF THE NEW NAME");
- 
-      DECLARE
-           TYPE ACCINT IS ACCESS INTEGER;
-           TYPE ACCARR IS ACCESS ARRAY1;
-           TYPE ACCREC IS ACCESS RECORD1;
-           TYPE ACCPTR IS ACCESS POINTER1;
-           TYPE ACCPVT IS ACCESS PACK1.PRIVY;
-           TYPE ACCTSK IS ACCESS TASK1;
- 
-           AI1 : ACCINT := NEW INTEGER'(0);
-           AA1 : ACCARR := NEW ARRAY1'(0, 0, 0);
-           AR1 : ACCREC := NEW RECORD1'(D => 1, FIELD1 => 0);
-           AP1 : ACCPTR := NEW POINTER1'(NEW INTEGER'(0));
-           AV1 : ACCPVT := NEW PACK1.PRIVY'(PACK1.ZERO);
-           AT1 : ACCTSK := NEW TASK1;
- 
-           XAI1 : INTEGER RENAMES AI1.ALL;
-           XAA1 : ARRAY1 RENAMES AA1.ALL;
-           XAR1 : RECORD1 RENAMES AR1.ALL;
-           XAP1 : POINTER1 RENAMES AP1.ALL;
-           XAV1 : PACK1.PRIVY RENAMES AV1.ALL;
-           XAK1 : INTEGER RENAMES PACK1.AK1.ALL;
-           XAT1 : TASK1 RENAMES AT1.ALL;
- 
-           TASK TYPE TASK2 IS
-                ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                              TV1 : IN OUT PACK1.PRIVY;
-                              TT1 : IN OUT TASK1; TK1 : IN OUT INTEGER);
-           END TASK2;
- 
-           I : INTEGER;
-           A_CHK_TASK : TASK2;
- 
-           PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
-                            PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
-                            PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
-                            PK1 : OUT INTEGER) IS
- 
-           BEGIN
-                PI1 := PI1 + 1;
-                PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
-                PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
-                PP1 := NEW INTEGER'(AP1.ALL.ALL + 1);
-                PV1 := PACK1.NEXT(AV1.ALL);
-                PT1.NEXT;
-                PK1 := PACK1.AK1.ALL + 1;
-           END PROC1;
- 
-           TASK BODY TASK2 IS
-           BEGIN
-                ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
-                               TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
-                               TV1 : IN OUT PACK1.PRIVY;
-                               TT1 : IN OUT TASK1;
-                               TK1 : IN OUT INTEGER) DO
-                     TI1 := AI1.ALL + 1;
-                     TA1 := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
-                     TR1 := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
-                     TP1 := NEW INTEGER'(TP1.ALL + 1);
-                     TV1 := PACK1.NEXT(TV1);
-                     TT1.NEXT;
-                     TK1 := TK1 + 1;
-                END ENTRY1;
-           END TASK2;
- 
-           PACKAGE GENPACK2 IS NEW
-                GENERIC1 (XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
- 
-      BEGIN
-           IF XAI1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XAI1 (1)");
-           END IF;
- 
-           IF XAA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1 (1)");
-           END IF;
- 
-           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1 (1)");
-           END IF;
- 
-           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XAP1 (1)");
-           END IF;
- 
-           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.ONE)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1 (1)");
-           END IF;
- 
-           XAT1.VALU(I);
-           IF I /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (1)");
-           END IF;
- 
-           IF XAK1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XAK1 (1)");
-           END IF;
- 
-           PROC1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
- 
-           IF XAI1 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XAI1 (2)");
-           END IF;
- 
-           IF XAA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1 (2)");
-           END IF;
- 
-           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1 (2)");
-           END IF;
- 
-           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XAP1 (2)");
-           END IF;
- 
-           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.TWO)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1 (2)");
-           END IF;
- 
-           XAT1.VALU(I);
-           IF I /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (2)");
-           END IF;
- 
-           IF XAK1 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XAK1 (2)");
-           END IF;
- 
-           A_CHK_TASK.ENTRY1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
- 
-           IF XAI1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XAI1 (3)");
-           END IF;
- 
-           IF XAA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1 (3)");
-           END IF;
- 
-           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1 (3)");
-           END IF;
- 
-           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XAP1 (3)");
-           END IF;
- 
-           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.THREE)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1 (3)");
-           END IF;
- 
-           XAT1.VALU(I);
-           IF I /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (3)");
-           END IF;
- 
-           IF XAK1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XAK1 (3)");
-           END IF;
- 
-           XAI1 := XAI1 + 1;
-           XAA1 := (XAA1(1)+1, XAA1(2)+1, XAA1(3)+1);
-           XAR1 := (D => 1, FIELD1 => XAR1.FIELD1 + 1);
-           XAP1 := NEW INTEGER'(XAP1.ALL + 1);
-           XAV1 := PACK1.NEXT(XAV1);
-           XAT1.NEXT;
-           XAK1 := XAK1 + 1;
- 
-           IF XAI1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XAI1 (4)");
-           END IF;
- 
-           IF XAA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1 (4)");
-           END IF;
- 
-           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1 (4)");
-           END IF;
- 
-           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XAP1 (4)");
-           END IF;
- 
-           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FOUR)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1 (4)");
-           END IF;
- 
-           XAT1.VALU(I);
-           IF I /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (4)");
-           END IF;
- 
-           IF XAK1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XAK1 (4)");
-           END IF;
- 
-           AI1.ALL := AI1.ALL + 1;
-           AA1.ALL := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
-           AR1.ALL := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
-           AP1.ALL := NEW INTEGER'(AP1.ALL.ALL + 1);
-           AV1.ALL := PACK1.NEXT(AV1.ALL);
-           AT1.NEXT;
-           PACK1.AK1.ALL := PACK1.AK1.ALL + 1;
- 
-           IF XAI1 /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XAI1 (5)");
-           END IF;
- 
-           IF XAA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1 (5)");
-           END IF;
- 
-           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1 (5)");
-           END IF;
- 
-           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XAP1 (5)");
-           END IF;
- 
-           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FIVE)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1 (5)");
-           END IF;
- 
-           XAT1.VALU(I);
-           IF I /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (5)");
-           END IF;
- 
-           IF XAK1 /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XAK1 (5)");
-           END IF;
- 
-           AT1.STOP;
-      END;
- 
-      RESULT;
- END C85005E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C85005F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR A RENAMED VARIABLE DESIGNATED BY AN ACCESS VALUE,
- --     A CHANGE IN THE ACCESS VALUE DOES NOT AFFECT WHICH VARIABLE IS
- --     DENOTED BY THE NEW NAME.
- 
- -- HISTORY:
- --     JET 07/26/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85005F IS
-      TYPE ACC IS ACCESS INTEGER;
- 
-      BUMP : INTEGER := 0;
- 
-      A : ACC := NULL;
- 
-      FUNCTION GET_POINTER RETURN ACC IS
-      BEGIN
-           BUMP := IDENT_INT(BUMP) + 1;
-           RETURN NEW INTEGER'(BUMP);
-      END GET_POINTER;
- 
- BEGIN
-      TEST ("C85005F", "CHECK THAT, FOR A RENAMED VARIABLE DESIGNATED " &
-                       "BY AN ACCESS VALUE, A CHANGE IN THE ACCESS " &
-                       "VALUE DOES NOT AFFECT WHICH VARIABLE IS " &
-                       "DENOTED BY THE NEW NAME");
- 
-      A := GET_POINTER;
- 
-      DECLARE
-           X1 : INTEGER RENAMES A.ALL;
-           X2 : INTEGER RENAMES GET_POINTER.ALL;
-      BEGIN
-           A := GET_POINTER;
- 
-           IF X1 /= 1 THEN
-                FAILED("CHANGING ACCESS VALUE CHANGED RENAMED VARIABLE");
-           END IF;
- 
-           IF X2 /= 2 THEN
-                FAILED("INCORRECT RESULT FROM FUNCTION AS PREFIX");
-           END IF;
-      END;
- 
-      RESULT;
- END C85005F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85005g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85005g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C85005G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY THE TYPE MARK USED
- --     IN THE RENAMING DECLARATION IS IGNORED, AND THE SUBTYPE
- --     CONSTRAINT ASSOCIATED WITH THE RENAMED VARIABLE IS USED INSTEAD.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     JET 07/26/88  CREATED ORIGINAL TEST.
- --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85005G IS
- 
-      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
- 
-      I : INTEGER := IDENT_INT(INTEGER'LAST);
-      J : INT := IDENT_INT(INT'LAST);
- 
-      DG1 : INTEGER := IDENT_INT(INTEGER'LAST);
-      DG2 : INT := IDENT_INT(INT'LAST);
- 
-      XI : INT RENAMES I;
-      XJ : INTEGER RENAMES J;
- 
-      GENERIC
-           G1 : IN OUT INT;
-           G2 : IN OUT INTEGER;
-      PROCEDURE GEN;
- 
-      PROCEDURE GEN IS
-           XG1 : INT RENAMES G1;
-           XG2 : INTEGER RENAMES G2;
-      BEGIN
-           IF XG1 /= INTEGER'LAST THEN
-                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G1");
-           END IF;
- 
-           XG1 := IDENT_INT(INTEGER'FIRST);
- 
-           IF XG1 /= INTEGER'FIRST THEN
-                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G2");
-           END IF;
- 
-           IF XG2 /= INT'LAST THEN
-                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G3");
-           END IF;
- 
-           XG2 := IDENT_INT(INT'FIRST);
- 
-           IF XG2 /= INT'FIRST THEN
-                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G4");
-           END IF;
- 
-           BEGIN
-                XG2 := IDENT_INT(INTEGER'LAST);
-                FAILED ("NO EXCEPTION RAISED BY XG2 := INTEGER'LAST");
-                IF NOT EQUAL(XG2,XG2) THEN
-                     COMMENT ("DON'T OPTIMIZE XG2");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION (G)");
-           END;
-      END GEN;
- 
-      PROCEDURE PROC IS NEW GEN(DG1, DG2);
- 
- BEGIN
-      TEST ("C85005G", "CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY " &
-                       "THE TYPE MARK USED IN THE RENAMING " &
-                       "DECLARATION IS IGNORED, AND THE SUBTYPE " &
-                       "CONSTRAINT ASSOCIATED WITH THE RENAMED " &
-                       "VARIABLE IS USED INSTEAD");
- 
-      IF XI /= INTEGER'LAST THEN
-           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 1");
-      END IF;
- 
-      XI := IDENT_INT(INTEGER'FIRST);
- 
-      IF XI /= INTEGER'FIRST THEN
-           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 2");
-      END IF;
- 
-      IF XJ /= INT'LAST THEN
-           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 3");
-      END IF;
- 
-      XJ := IDENT_INT(INT'FIRST);
- 
-      IF XJ /= INT'FIRST THEN
-           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 4");
-      END IF;
- 
-      BEGIN
-           XJ := IDENT_INT(INTEGER'LAST);
-           FAILED ("NO EXCEPTION RAISED BY XJ := INTEGER'LAST");
-           IF NOT EQUAL(XJ,XJ) THEN
-                COMMENT ("DON'T OPTIMIZE XJ");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                 NULL;
-           WHEN OTHERS =>
-                 FAILED ("UNEXPECTED EXCEPTION - 1");
-      END;
- 
-      PROC;
- 
-      RESULT;
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED("UNEXPECTED EXCEPTION - 2");
-           RESULT;
- END C85005G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,681 ****
- -- C85006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY AN
- --     OBJECT DECLARATION CAN BE RENAMED AND HAS THE CORRECT VALUE,
- --     AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT
- --     AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
- --     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
- --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
- --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/22/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85006A IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
-      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
-      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
-      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
-      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
-      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
- 
-      TASK TYPE TASK2 IS
-           ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                         TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
-                         TRV1 : IN OUT PACK1.PRIVY; TRT1 : IN OUT TASK1;
-                         TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                         TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                         TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK);
-      END TASK2;
- 
-      TYPE REC_TYPE IS RECORD
-           RI1 : INTEGER := 0;
-           RA1 : ARRAY1(1..3) := (OTHERS => 0);
-           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-           RP1 : POINTER1 := NEW INTEGER'(0);
-           RV1 : PACK1.PRIVY := PACK1.ZERO;
-           RT1 : TASK1;
-      END RECORD;
- 
-      REC : REC_TYPE;
- 
-      AI1 : ARR_INT(1..8) := (OTHERS => 0);
-      AA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
-      AR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
-      AP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
-      AV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
-      AT1 : ARR_TSK(1..8);
- 
-      XRI1 : INTEGER RENAMES REC.RI1;
-      XRA1 : ARRAY1 RENAMES REC.RA1;
-      XRR1 : RECORD1 RENAMES REC.RR1;
-      XRP1 : POINTER1 RENAMES REC.RP1;
-      XRV1 : PACK1.PRIVY RENAMES REC.RV1;
-      XRT1 : TASK1 RENAMES REC.RT1;
-      XAI1 : ARR_INT RENAMES AI1(1..3);
-      XAA1 : ARR_ARR RENAMES AA1(2..4);
-      XAR1 : ARR_REC RENAMES AR1(3..5);
-      XAP1 : ARR_PTR RENAMES AP1(4..6);
-      XAV1 : ARR_PVT RENAMES AV1(5..7);
-      XAT1 : ARR_TSK RENAMES AT1(6..8);
- 
-      I : INTEGER;
-      CHK_TASK : TASK2;
- 
-      GENERIC
-           GRI1 : IN OUT INTEGER;
-           GRA1 : IN OUT ARRAY1;
-           GRR1 : IN OUT RECORD1;
-           GRP1 : IN OUT POINTER1;
-           GRV1 : IN OUT PACK1.PRIVY;
-           GRT1 : IN OUT TASK1;
-           GAI1 : IN OUT ARR_INT;
-           GAA1 : IN OUT ARR_ARR;
-           GAR1 : IN OUT ARR_REC;
-           GAP1 : IN OUT ARR_PTR;
-           GAV1 : IN OUT ARR_PVT;
-           GAT1 : IN OUT ARR_TSK;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
-                       PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
-                       PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
-                       PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
-                       PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
-                       PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
- 
-      BEGIN
-           PRI1 := PRI1 + 1;
-           PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
-           PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
-           PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-           PRV1 := PACK1.NEXT(REC.RV1);
-           PRT1.NEXT;
-           PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
-           PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
-           PAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (PAR1(PAR1'FIRST).FIELD1 + 1)));
-           PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
-           FOR J IN PAV1'RANGE LOOP
-                PAV1(J) := PACK1.NEXT(AV1(J));
-           END LOOP;
-           FOR J IN PAT1'RANGE LOOP
-                PAT1(J).NEXT;
-           END LOOP;
-      END PROC1;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GRI1 := GRI1 + 1;
-           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
-           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
-           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
-           GRV1 := PACK1.NEXT(GRV1);
-           GRT1.NEXT;
-           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
-           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
-           GAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
-           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
-           FOR J IN GAV1'RANGE LOOP
-                GAV1(J) := PACK1.NEXT(GAV1(J));
-           END LOOP;
-           FOR J IN GAT1'RANGE LOOP
-                GAT1(J).NEXT;
-           END LOOP;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
-      TASK BODY TASK2 IS
-      BEGIN
-           ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                          TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
-                          TRV1 : IN OUT PACK1.PRIVY; TRT1: IN OUT TASK1;
-                          TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                          TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                          TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK)
-           DO
-                TRI1 := REC.RI1 + 1;
-                TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
-                TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
-                TRP1 := NEW INTEGER'(TRP1.ALL + 1);
-                TRV1 := PACK1.NEXT(TRV1);
-                TRT1.NEXT;
-                TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
-                TAA1 := (OTHERS => (OTHERS => AA1(TAA1'FIRST)(1) + 1));
-                TAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1)));
-                TAP1 := (OTHERS => NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
-                FOR J IN TAV1'RANGE LOOP
-                     TAV1(J) := PACK1.NEXT(TAV1(J));
-                END LOOP;
-                FOR J IN TAT1'RANGE LOOP
-                     TAT1(J).NEXT;
-                END LOOP;
-           END ENTRY1;
-      END TASK2;
- 
- BEGIN
-      TEST ("C85006A", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
-                       "CREATED BY AN OBJECT DECLARATION CAN BE " &
-                       "RENAMED AND HAS THE CORRECT VALUE, AND THAT " &
-                       "THE NEW NAME CAN BE USED IN AN ASSIGNMENT " &
-                       "STATEMENT AND PASSED ON AS AN ACTUAL " &
-                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
-                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
-                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
-                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
-                       "REFLECTED BY THE VALUE OF THE NEW NAME");
- 
-      DECLARE
-           PACKAGE GENPACK1 IS NEW
-                GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
-      BEGIN
-           NULL;
-      END;
- 
-      IF XRI1 /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF XRI1 (1)");
-      END IF;
- 
-      IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-           FAILED ("INCORRECT VALUE OF XRA1 (1)");
-      END IF;
- 
-      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-           FAILED ("INCORRECT VALUE OF XRR1 (1)");
-      END IF;
- 
-      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT VALUE OF XRP1 (1)");
-      END IF;
- 
-      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
-           FAILED ("INCORRECT VALUE OF XRV1 (1)");
-      END IF;
- 
-      XRT1.VALU(I);
-      IF I /= IDENT_INT(1) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
-      END IF;
- 
-      FOR J IN XAI1'RANGE LOOP
-           IF XAI1(J) /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
-                        ") (1)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAA1'RANGE LOOP
-           IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
-                        ") (1)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAR1'RANGE LOOP
-           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
-                        ") (1)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAP1'RANGE LOOP
-           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(1)
-           THEN
-                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
-                        ") (1)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAV1'RANGE LOOP
-           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
-                        ") (1)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAT1'RANGE LOOP
-           XAT1(J).VALU(I);
-           IF I /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                        INTEGER'IMAGE(J) & ").VALU (1)");
-           END IF;
-      END LOOP;
- 
-      PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-             XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-      IF XRI1 /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE OF XRI1 (2)");
-      END IF;
- 
-      IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-           FAILED ("INCORRECT VALUE OF XRA1 (2)");
-      END IF;
- 
-      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-           FAILED ("INCORRECT VALUE OF XRR1 (2)");
-      END IF;
- 
-      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT VALUE OF XRP1 (2)");
-      END IF;
- 
-      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
-           FAILED ("INCORRECT VALUE OF XRV1 (2)");
-      END IF;
- 
-      XRT1.VALU(I);
-      IF I /= IDENT_INT(2) THEN
-           FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
-      END IF;
- 
-      FOR J IN XAI1'RANGE LOOP
-           IF XAI1(J) /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
-                        ") (2)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAA1'RANGE LOOP
-           IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
-                        ") (2)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAR1'RANGE LOOP
-           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
-                        ") (2)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAP1'RANGE LOOP
-           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(2)
-           THEN
-                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
-                        ") (2)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAV1'RANGE LOOP
-           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
-                        ") (2)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAT1'RANGE LOOP
-           XAT1(J).VALU(I);
-           IF I /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                        INTEGER'IMAGE(J) & ").VALU (2)");
-           END IF;
-      END LOOP;
- 
-      CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                      XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-      IF XRI1 /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE OF XRI1 (3)");
-      END IF;
- 
-      IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-           FAILED ("INCORRECT VALUE OF XRA1 (3)");
-      END IF;
- 
-      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-           FAILED ("INCORRECT VALUE OF XRR1 (3)");
-      END IF;
- 
-      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT VALUE OF XRP1 (3)");
-      END IF;
- 
-      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
-           FAILED ("INCORRECT VALUE OF XRV1 (3)");
-      END IF;
- 
-      XRT1.VALU(I);
-      IF I /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
-      END IF;
- 
-      FOR J IN XAI1'RANGE LOOP
-           IF XAI1(J) /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
-                        ") (3)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAA1'RANGE LOOP
-           IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
-                        ") (3)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAR1'RANGE LOOP
-           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
-                        ") (3)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAP1'RANGE LOOP
-           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(3)
-           THEN
-                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
-                        ") (3)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAV1'RANGE LOOP
-           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
-                        ") (3)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAT1'RANGE LOOP
-           XAT1(J).VALU(I);
-           IF I /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                        INTEGER'IMAGE(J) & ").VALU (3)");
-           END IF;
-      END LOOP;
- 
-      XRI1 := XRI1 + 1;
-      XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
-      XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
-      XRP1 := NEW INTEGER'(XRP1.ALL + 1);
-      XRV1 := PACK1.NEXT(XRV1);
-      XRT1.NEXT;
-      XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
-      XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
-      XAR1 := (OTHERS => (D => 1,
-                          FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
-      XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
-      FOR J IN XAV1'RANGE LOOP
-           XAV1(J) := PACK1.NEXT(XAV1(J));
-      END LOOP;
-      FOR J IN XAT1'RANGE LOOP
-           XAT1(J).NEXT;
-      END LOOP;
- 
-      IF XRI1 /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE OF XRI1 (4)");
-      END IF;
- 
-      IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-           FAILED ("INCORRECT VALUE OF XRA1 (4)");
-      END IF;
- 
-      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-           FAILED ("INCORRECT VALUE OF XRR1 (4)");
-      END IF;
- 
-      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT VALUE OF XRP1 (4)");
-      END IF;
- 
-      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
-           FAILED ("INCORRECT VALUE OF XRV1 (4)");
-      END IF;
- 
-      XRT1.VALU(I);
-      IF I /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
-      END IF;
- 
-      FOR J IN XAI1'RANGE LOOP
-           IF XAI1(J) /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
-                        ") (4)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAA1'RANGE LOOP
-           IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
-                        ") (4)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAR1'RANGE LOOP
-           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
-                        ") (4)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAP1'RANGE LOOP
-           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(4)
-           THEN
-                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
-                        ") (4)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAV1'RANGE LOOP
-           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
-                        ") (4)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAT1'RANGE LOOP
-           XAT1(J).VALU(I);
-           IF I /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                        INTEGER'IMAGE(J) & ").VALU (4)");
-           END IF;
-      END LOOP;
- 
-      REC.RI1 := REC.RI1 + 1;
-      REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
-      REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
-      REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-      REC.RV1 := PACK1.NEXT(REC.RV1);
-      REC.RT1.NEXT;
-      AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
-      AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
-      AR1 := (OTHERS => (D => 1,
-                         FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
-      AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
-      FOR J IN XAV1'RANGE LOOP
-           AV1(J) := PACK1.NEXT(AV1(J));
-      END LOOP;
-      FOR J IN XAT1'RANGE LOOP
-           AT1(J).NEXT;
-      END LOOP;
- 
-      IF XRI1 /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT VALUE OF XRI1 (5)");
-      END IF;
- 
-      IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-           FAILED ("INCORRECT VALUE OF XRA1 (5)");
-      END IF;
- 
-      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-           FAILED ("INCORRECT VALUE OF XRR1 (5)");
-      END IF;
- 
-      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT VALUE OF XRP1 (5)");
-      END IF;
- 
-      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
-           FAILED ("INCORRECT VALUE OF XRV1 (5)");
-      END IF;
- 
-      XRT1.VALU(I);
-      IF I /= IDENT_INT(5) THEN
-           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
-      END IF;
- 
-      FOR J IN XAI1'RANGE LOOP
-           IF XAI1(J) /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
-                        ") (5)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAA1'RANGE LOOP
-           IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
-                        ") (5)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAR1'RANGE LOOP
-           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
-                        ") (5)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAP1'RANGE LOOP
-           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(5)
-           THEN
-                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
-                        ") (5)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAV1'RANGE LOOP
-           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
-                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
-                        ") (5)");
-           END IF;
-      END LOOP;
- 
-      FOR J IN XAT1'RANGE LOOP
-           XAT1(J).VALU(I);
-           IF I /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                        INTEGER'IMAGE(J) & ").VALU (5)");
-           END IF;
-      END LOOP;
- 
-      REC.RT1.STOP;
- 
-      FOR I IN AT1'RANGE LOOP
-           AT1(I).STOP;
-      END LOOP;
- 
-      RESULT;
- END C85006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,699 ****
- -- C85006B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY A
- --     SUBPROGRAM 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE
- --     CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
- --     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT'
- --     OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
- --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
- --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/22/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85006B IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
-      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
-      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
-      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
-      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
-      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
- 
-      TYPE REC_TYPE IS RECORD
-           RI1 : INTEGER := 0;
-           RA1 : ARRAY1(1..3) := (OTHERS => 0);
-           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-           RP1 : POINTER1 := NEW INTEGER'(0);
-           RV1 : PACK1.PRIVY := PACK1.ZERO;
-           RT1 : TASK1;
-      END RECORD;
- 
-      DREC : REC_TYPE;
- 
-      DAI1 : ARR_INT(1..8) := (OTHERS => 0);
-      DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
-      DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
-      DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
-      DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
-      DAT1 : ARR_TSK(1..8);
- 
-      GENERIC
-           GRI1 : IN OUT INTEGER;
-           GRA1 : IN OUT ARRAY1;
-           GRR1 : IN OUT RECORD1;
-           GRP1 : IN OUT POINTER1;
-           GRV1 : IN OUT PACK1.PRIVY;
-           GRT1 : IN OUT TASK1;
-           GAI1 : IN OUT ARR_INT;
-           GAA1 : IN OUT ARR_ARR;
-           GAR1 : IN OUT ARR_REC;
-           GAP1 : IN OUT ARR_PTR;
-           GAV1 : IN OUT ARR_PVT;
-           GAT1 : IN OUT ARR_TSK;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GRI1 := GRI1 + 1;
-           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
-           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
-           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
-           GRV1 := PACK1.NEXT(GRV1);
-           GRT1.NEXT;
-           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
-           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
-           GAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
-           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
-           FOR J IN GAV1'RANGE LOOP
-                GAV1(J) := PACK1.NEXT(GAV1(J));
-           END LOOP;
-           FOR J IN GAT1'RANGE LOOP
-                GAT1(J).NEXT;
-           END LOOP;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
-      PROCEDURE PROC (REC : IN OUT REC_TYPE;
-                      AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
-                      AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
-                      AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK) IS
- 
-           XRI1 : INTEGER RENAMES REC.RI1;
-           XRA1 : ARRAY1 RENAMES REC.RA1;
-           XRR1 : RECORD1 RENAMES REC.RR1;
-           XRP1 : POINTER1 RENAMES REC.RP1;
-           XRV1 : PACK1.PRIVY RENAMES REC.RV1;
-           XRT1 : TASK1 RENAMES REC.RT1;
-           XAI1 : ARR_INT RENAMES AI1(1..3);
-           XAA1 : ARR_ARR RENAMES AA1(2..4);
-           XAR1 : ARR_REC RENAMES AR1(3..5);
-           XAP1 : ARR_PTR RENAMES AP1(4..6);
-           XAV1 : ARR_PVT RENAMES AV1(5..7);
-           XAT1 : ARR_TSK RENAMES AT1(6..8);
- 
-           TASK TYPE TASK2 IS
-                ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                              TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
-                              TRV1 : IN OUT PACK1.PRIVY;
-                              TRT1 : IN OUT TASK1;
-                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                              TAV1 : IN OUT ARR_PVT;
-                              TAT1 : IN OUT ARR_TSK);
-           END TASK2;
- 
-           I : INTEGER;
-           CHK_TASK : TASK2;
- 
-           TASK BODY TASK2 IS
-           BEGIN
-                ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                               TRR1 : OUT RECORD1;
-                               TRP1 : IN OUT POINTER1;
-                               TRV1 : IN OUT PACK1.PRIVY;
-                               TRT1: IN OUT TASK1;
-                               TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                               TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                               TAV1 : IN OUT ARR_PVT;
-                               TAT1 : IN OUT ARR_TSK)
-                DO
-                     TRI1 := REC.RI1 + 1;
-                     TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
-                     TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
-                     TRP1 := NEW INTEGER'(TRP1.ALL + 1);
-                     TRV1 := PACK1.NEXT(TRV1);
-                     TRT1.NEXT;
-                     TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
-                     TAA1 := (OTHERS => (OTHERS =>
-                                         AA1(TAA1'FIRST)(1) + 1));
-                     TAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1)));
-                     TAP1 := (OTHERS =>
-                               NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
-                     FOR J IN TAV1'RANGE LOOP
-                          TAV1(J) := PACK1.NEXT(TAV1(J));
-                     END LOOP;
-                     FOR J IN TAT1'RANGE LOOP
-                          TAT1(J).NEXT;
-                     END LOOP;
-                END ENTRY1;
-           END TASK2;
- 
-           PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
-                            PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
-                            PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
-                            PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
-                            PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
-                            PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
-           BEGIN
-                PRI1 := PRI1 + 1;
-                PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
-                PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
-                PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-                PRV1 := PACK1.NEXT(REC.RV1);
-                PRT1.NEXT;
-                PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
-                PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
-                PAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                    (PAR1(PAR1'FIRST).FIELD1 + 1)));
-                PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL+1));
-                FOR J IN PAV1'RANGE LOOP
-                     PAV1(J) := PACK1.NEXT(AV1(J));
-                END LOOP;
-                FOR J IN PAT1'RANGE LOOP
-                     PAT1(J).NEXT;
-                END LOOP;
-           END PROC1;
- 
-           PACKAGE GENPACK1 IS NEW
-                GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-      BEGIN
-           IF XRI1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (1)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (1)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (1)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (1)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (1)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(1)
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (1)");
-                END IF;
-           END LOOP;
- 
-           PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                  XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-           IF XRI1 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (2)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (2)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (2)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (2)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (2)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (2)");
-                END IF;
-           END LOOP;
- 
-           CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                           XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-           IF XRI1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (3)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (3)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (3)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (3)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (3)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (3)");
-                END IF;
-           END LOOP;
- 
-           XRI1 := XRI1 + 1;
-           XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
-           XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
-           XRP1 := NEW INTEGER'(XRP1.ALL + 1);
-           XRV1 := PACK1.NEXT(XRV1);
-           XRT1.NEXT;
-           XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
-           XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
-           XAR1 := (OTHERS => (D => 1,
-                          FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
-           XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
-           FOR J IN XAV1'RANGE LOOP
-                XAV1(J) := PACK1.NEXT(XAV1(J));
-           END LOOP;
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).NEXT;
-           END LOOP;
- 
-           IF XRI1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (4)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (4)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (4)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (4)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (4)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (4)");
-                END IF;
-           END LOOP;
- 
-           REC.RI1 := REC.RI1 + 1;
-           REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
-           REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
-           REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-           REC.RV1 := PACK1.NEXT(REC.RV1);
-           REC.RT1.NEXT;
-           AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
-           AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
-           AR1 := (OTHERS => (D => 1,
-                              FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
-           AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
-           FOR J IN XAV1'RANGE LOOP
-                AV1(J) := PACK1.NEXT(AV1(J));
-           END LOOP;
-           FOR J IN XAT1'RANGE LOOP
-                AT1(J).NEXT;
-           END LOOP;
- 
-           IF XRI1 /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (5)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (5)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (5)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (5)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (5)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                XAP1(J).ALL /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (5)");
-                END IF;
-           END LOOP;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("C85006B", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
-                       "CREATED BY A SUBPROGRAM 'IN OUT' FORMAL " &
-                       "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " &
-                       "VALUE, AND THAT THE NEW NAME CAN BE USED IN " &
-                       "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " &
-                       "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
-                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
-                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
-                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
-                       "REFLECTED BY THE VALUE OF THE NEW NAME");
- 
-      PROC (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
- 
-      DREC.RT1.STOP;
- 
-      FOR I IN DAT1'RANGE LOOP
-           DAT1(I).STOP;
-      END LOOP;
- 
-      RESULT;
- END C85006B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,778 ****
- -- C85006C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY AN ENTRY
- --     'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE CORRECT
- --     VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
- --     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY
- --     'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT'
- --     PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS
- --     CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/22/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85006C IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
-      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
-      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
-      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
-      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
-      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
- 
-      TYPE REC_TYPE IS RECORD
-           RI1 : INTEGER := 0;
-           RA1 : ARRAY1(1..3) := (OTHERS => 0);
-           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-           RP1 : POINTER1 := NEW INTEGER'(0);
-           RV1 : PACK1.PRIVY := PACK1.ZERO;
-           RT1 : TASK1;
-      END RECORD;
- 
-      DREC : REC_TYPE;
- 
-      DAI1 : ARR_INT(1..8) := (OTHERS => 0);
-      DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
-      DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
-      DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
-      DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
-      DAT1 : ARR_TSK(1..8);
- 
-      I : INTEGER;
- 
-      GENERIC
-           GRI1 : IN OUT INTEGER;
-           GRA1 : IN OUT ARRAY1;
-           GRR1 : IN OUT RECORD1;
-           GRP1 : IN OUT POINTER1;
-           GRV1 : IN OUT PACK1.PRIVY;
-           GRT1 : IN OUT TASK1;
-           GAI1 : IN OUT ARR_INT;
-           GAA1 : IN OUT ARR_ARR;
-           GAR1 : IN OUT ARR_REC;
-           GAP1 : IN OUT ARR_PTR;
-           GAV1 : IN OUT ARR_PVT;
-           GAT1 : IN OUT ARR_TSK;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GRI1 := GRI1 + 1;
-           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
-           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
-           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
-           GRV1 := PACK1.NEXT(GRV1);
-           GRT1.NEXT;
-           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
-           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
-           GAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
-           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
-           FOR J IN GAV1'RANGE LOOP
-                GAV1(J) := PACK1.NEXT(GAV1(J));
-           END LOOP;
-           FOR J IN GAT1'RANGE LOOP
-                GAT1(J).NEXT;
-           END LOOP;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
- BEGIN
-      TEST ("C85006C", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
-                       "CREATED BY AN ENTRY 'IN OUT' FORMAL PARAMETER " &
-                       "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
-                       "THAT THE NEW NAME CAN BE USED IN AN ASSIGN" &
-                       "MENT STATEMENT AND PASSED ON AS AN ACTUAL " &
-                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
-                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
-                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
-                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
-                       "REFLECTED BY THE VALUE OF THE NEW NAME");
- 
-      DECLARE
-           TASK MAIN_TASK IS
-                ENTRY START (REC : IN OUT REC_TYPE;
-                             AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
-                             AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
-                             AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK);
-           END MAIN_TASK;
- 
-           TASK BODY MAIN_TASK IS
-           BEGIN
-              ACCEPT START (REC : IN OUT REC_TYPE;
-                            AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
-                            AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
-                            AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK)
-                 DO
-                 DECLARE
-                    XRI1 : INTEGER RENAMES REC.RI1;
-                    XRA1 : ARRAY1 RENAMES REC.RA1;
-                    XRR1 : RECORD1 RENAMES REC.RR1;
-                    XRP1 : POINTER1 RENAMES REC.RP1;
-                    XRV1 : PACK1.PRIVY RENAMES REC.RV1;
-                    XRT1 : TASK1 RENAMES REC.RT1;
-                    XAI1 : ARR_INT RENAMES AI1(1..3);
-                    XAA1 : ARR_ARR RENAMES AA1(2..4);
-                    XAR1 : ARR_REC RENAMES AR1(3..5);
-                    XAP1 : ARR_PTR RENAMES AP1(4..6);
-                    XAV1 : ARR_PVT RENAMES AV1(5..7);
-                    XAT1 : ARR_TSK RENAMES AT1(6..8);
- 
-                    TASK TYPE TASK2 IS
-                       ENTRY ENTRY1 (TRI1 : OUT INTEGER;
-                                     TRA1 : OUT ARRAY1;
-                                     TRR1 : OUT RECORD1;
-                                     TRP1 : IN OUT POINTER1;
-                                     TRV1 : IN OUT PACK1.PRIVY;
-                                     TRT1 : IN OUT TASK1;
-                                     TAI1 : OUT ARR_INT;
-                                     TAA1 : OUT ARR_ARR;
-                                     TAR1 : OUT ARR_REC;
-                                     TAP1 : IN OUT ARR_PTR;
-                                     TAV1 : IN OUT ARR_PVT;
-                                     TAT1 : IN OUT ARR_TSK);
-                    END TASK2;
- 
-                    CHK_TASK : TASK2;
- 
-                    TASK BODY TASK2 IS
-                    BEGIN
-                       ACCEPT ENTRY1 (TRI1 : OUT INTEGER;
-                                      TRA1 : OUT ARRAY1;
-                                      TRR1 : OUT RECORD1;
-                                      TRP1 : IN OUT POINTER1;
-                                      TRV1 : IN OUT PACK1.PRIVY;
-                                      TRT1: IN OUT TASK1;
-                                      TAI1 : OUT ARR_INT;
-                                      TAA1 : OUT ARR_ARR;
-                                      TAR1 : OUT ARR_REC;
-                                      TAP1 : IN OUT ARR_PTR;
-                                      TAV1 : IN OUT ARR_PVT;
-                                      TAT1 : IN OUT ARR_TSK)
-                       DO
-                          TRI1 := REC.RI1 + 1;
-                          TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
-                                   REC.RA1(3)+1);
-                          TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
-                          TRP1 := NEW INTEGER'(TRP1.ALL + 1);
-                          TRV1 := PACK1.NEXT(TRV1);
-                          TRT1.NEXT;
-                          TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
-                          TAA1 := (OTHERS => (OTHERS =>
-                                              AA1(TAA1'FIRST)(1) + 1));
-                          TAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                         (AR1(TAR1'FIRST).FIELD1 + 1)));
-                          TAP1 := (OTHERS =>
-                                   NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
-                          FOR J IN TAV1'RANGE LOOP
-                             TAV1(J) := PACK1.NEXT(TAV1(J));
-                          END LOOP;
-                          FOR J IN TAT1'RANGE LOOP
-                             TAT1(J).NEXT;
-                          END LOOP;
-                       END ENTRY1;
-                    END TASK2;
- 
-                    PROCEDURE PROC1 (PRI1 : IN OUT INTEGER;
-                                     PRA1 : IN OUT ARRAY1;
-                                     PRR1 : IN OUT RECORD1;
-                                     PRP1 : OUT POINTER1;
-                                     PRV1 : OUT PACK1.PRIVY;
-                                     PRT1 : IN OUT TASK1;
-                                     PAI1 : IN OUT ARR_INT;
-                                     PAA1 : IN OUT ARR_ARR;
-                                     PAR1 : IN OUT ARR_REC;
-                                     PAP1 : OUT ARR_PTR;
-                                     PAV1 : OUT ARR_PVT;
-                                     PAT1 : IN OUT ARR_TSK) IS
-                    BEGIN
-                       PRI1 := PRI1 + 1;
-                       PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
-                       PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
-                       PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-                       PRV1 := PACK1.NEXT(REC.RV1);
-                       PRT1.NEXT;
-                       PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
-                       PAA1 := (OTHERS => (OTHERS =>
-                                           PAA1(PAA1'FIRST)(1) + 1));
-                       PAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                          (PAR1(PAR1'FIRST).FIELD1+1)));
-                       PAP1 := (OTHERS =>
-                                NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
-                       FOR J IN PAV1'RANGE LOOP
-                          PAV1(J) := PACK1.NEXT(AV1(J));
-                       END LOOP;
-                       FOR J IN PAT1'RANGE LOOP
-                          PAT1(J).NEXT;
-                       END LOOP;
-                    END PROC1;
- 
-                    PACKAGE GENPACK2 IS NEW GENERIC1
-                       (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                        XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-                 BEGIN
-                          IF XRI1 /= IDENT_INT(1) THEN
-                               FAILED ("INCORRECT VALUE OF XRI1 (1)");
-                          END IF;
- 
-                          IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),
-                                      IDENT_INT(1)) THEN
-                               FAILED ("INCORRECT VALUE OF XRA1 (1)");
-                          END IF;
- 
-                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRR1 (1)");
-                          END IF;
- 
-                          IF XRP1 /= IDENT(REC.RP1) OR
-                             XRP1.ALL /= IDENT_INT(1) THEN
-                               FAILED ("INCORRECT VALUE OF XRP1 (1)");
-                          END IF;
- 
-                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRV1 (1)");
-                          END IF;
- 
-                          XRT1.VALU(I);
-                          IF I /= IDENT_INT(1) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XRT1.VALU (1)");
-                          END IF;
- 
-                          FOR J IN XAI1'RANGE LOOP
-                               IF XAI1(J) /= IDENT_INT(1) THEN
-                                    FAILED ("INCORRECT VALUE OF XAI1(" &
-                                            INTEGER'IMAGE(J) & ") (1)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAA1'RANGE LOOP
-                               IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),
-                                              IDENT_INT(1)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAA1(" &
-                                            INTEGER'IMAGE(J) & ") (1)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAR1'RANGE LOOP
-                               IF XAR1(J) /= (D => 1,
-                                       FIELD1 => IDENT_INT(1)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAR1(" &
-                                            INTEGER'IMAGE(J) & ") (1)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAP1'RANGE LOOP
-                               IF XAP1(J) /= IDENT(AP1(J)) OR
-                                  XAP1(J).ALL /= IDENT_INT(1) THEN
-                                    FAILED ("INCORRECT VALUE OF XAP1(" &
-                                            INTEGER'IMAGE(J) & ") (1)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAV1'RANGE LOOP
-                               IF PACK1."/=" (XAV1(J),
-                                         PACK1.IDENT(PACK1.ONE)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAV1(" &
-                                            INTEGER'IMAGE(J) & ") (1)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAT1'RANGE LOOP
-                               XAT1(J).VALU(I);
-                               IF I /= IDENT_INT(1) THEN
-                                    FAILED ("INCORRECT RETURN VALUE " &
-                                       "FROM XAT1(" & INTEGER'IMAGE(J) &
-                                       ").VALU (1)");
-                               END IF;
-                          END LOOP;
- 
-                          PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                                 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-                          IF XRI1 /= IDENT_INT(2) THEN
-                               FAILED ("INCORRECT VALUE OF XRI1 (2)");
-                          END IF;
- 
-                          IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),
-                                      IDENT_INT(2)) THEN
-                               FAILED ("INCORRECT VALUE OF XRA1 (2)");
-                          END IF;
- 
-                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRR1 (2)");
-                          END IF;
- 
-                          IF XRP1 /= IDENT(REC.RP1) OR
-                             XRP1.ALL /= IDENT_INT(2) THEN
-                               FAILED ("INCORRECT VALUE OF XRP1 (2)");
-                          END IF;
- 
-                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRV1 (2)");
-                          END IF;
- 
-                          XRT1.VALU(I);
-                          IF I /= IDENT_INT(2) THEN
-                               FAILED ("INCORRECT RETURN VALUE FROM " &
-                                       "XRT1.VALU (2)");
-                          END IF;
- 
-                          FOR J IN XAI1'RANGE LOOP
-                               IF XAI1(J) /= IDENT_INT(2) THEN
-                                    FAILED ("INCORRECT VALUE OF XAI1(" &
-                                            INTEGER'IMAGE(J) & ") (2)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAA1'RANGE LOOP
-                               IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),
-                                              IDENT_INT(2)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAA1(" &
-                                            INTEGER'IMAGE(J) & ") (2)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAR1'RANGE LOOP
-                               IF XAR1(J) /= (D => 1,
-                                        FIELD1 => IDENT_INT(2)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAR1(" &
-                                            INTEGER'IMAGE(J) & ") (2)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAP1'RANGE LOOP
-                               IF XAP1(J) /= IDENT(AP1(J)) OR
-                                  XAP1(J).ALL /= IDENT_INT(2) THEN
-                                    FAILED ("INCORRECT VALUE OF XAP1(" &
-                                            INTEGER'IMAGE(J) & ") (2)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAV1'RANGE LOOP
-                               IF PACK1."/=" (XAV1(J),
-                                       PACK1.IDENT(PACK1.TWO)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAV1(" &
-                                            INTEGER'IMAGE(J) & ") (2)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAT1'RANGE LOOP
-                               XAT1(J).VALU(I);
-                               IF I /= IDENT_INT(2) THEN
-                                    FAILED ("INCORRECT RETURN VALUE " &
-                                       "FROM XAT1(" & INTEGER'IMAGE(J) &
-                                       ").VALU (2)");
-                               END IF;
-                          END LOOP;
- 
-                          CHK_TASK.ENTRY1
-                               (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                                XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-                          IF XRI1 /= IDENT_INT(3) THEN
-                               FAILED ("INCORRECT VALUE OF XRI1 (3)");
-                          END IF;
- 
-                          IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),
-                                      IDENT_INT(3)) THEN
-                               FAILED ("INCORRECT VALUE OF XRA1 (3)");
-                          END IF;
- 
-                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRR1 (3)");
-                          END IF;
- 
-                          IF XRP1 /= IDENT(REC.RP1) OR
-                             XRP1.ALL /= IDENT_INT(3) THEN
-                               FAILED ("INCORRECT VALUE OF XRP1 (3)");
-                          END IF;
- 
-                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRV1 (3)");
-                          END IF;
- 
-                          XRT1.VALU(I);
-                          IF I /= IDENT_INT(3) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XRT1.VALU (3)");
-                          END IF;
- 
-                          FOR J IN XAI1'RANGE LOOP
-                               IF XAI1(J) /= IDENT_INT(3) THEN
-                                    FAILED ("INCORRECT VALUE OF XAI1(" &
-                                            INTEGER'IMAGE(J) & ") (3)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAA1'RANGE LOOP
-                               IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),
-                                              IDENT_INT(3))
-                               THEN
-                                    FAILED ("INCORRECT VALUE OF XAA1(" &
-                                            INTEGER'IMAGE(J) & ") (3)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAR1'RANGE LOOP
-                               IF XAR1(J) /= (D => 1,
-                                       FIELD1 => IDENT_INT(3)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAR1(" &
-                                            INTEGER'IMAGE(J) & ") (3)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAP1'RANGE LOOP
-                               IF XAP1(J) /= IDENT(AP1(J)) OR
-                                  XAP1(J).ALL /= IDENT_INT(3) THEN
-                                    FAILED ("INCORRECT VALUE OF XAP1(" &
-                                            INTEGER'IMAGE(J) & ") (3)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAV1'RANGE LOOP
-                               IF PACK1."/=" (XAV1(J),
-                                       PACK1.IDENT(PACK1.THREE)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAV1(" &
-                                            INTEGER'IMAGE(J) & ") (3)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAT1'RANGE LOOP
-                               XAT1(J).VALU(I);
-                               IF I /= IDENT_INT(3) THEN
-                                    FAILED ("INCORRECT RETURN VALUE " &
-                                       "FROM XAT1(" &
-                                       INTEGER'IMAGE(J) & ").VALU (3)");
-                               END IF;
-                          END LOOP;
- 
-                          XRI1 := XRI1 + 1;
-                          XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
-                          XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
-                          XRP1 := NEW INTEGER'(XRP1.ALL + 1);
-                          XRV1 := PACK1.NEXT(XRV1);
-                          XRT1.NEXT;
-                          XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
-                          XAA1 := (OTHERS =>
-                                   (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
-                          XAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                   (XAR1(XAR1'FIRST).FIELD1 + 1)));
-                          XAP1 := (OTHERS =>
-                               NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
-                          FOR J IN XAV1'RANGE LOOP
-                               XAV1(J) := PACK1.NEXT(XAV1(J));
-                          END LOOP;
-                          FOR J IN XAT1'RANGE LOOP
-                               XAT1(J).NEXT;
-                          END LOOP;
- 
-                          IF XRI1 /= IDENT_INT(4) THEN
-                               FAILED ("INCORRECT VALUE OF XRI1 (4)");
-                          END IF;
- 
-                          IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),
-                                      IDENT_INT(4)) THEN
-                               FAILED ("INCORRECT VALUE OF XRA1 (4)");
-                          END IF;
- 
-                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRR1 (4)");
-                          END IF;
- 
-                          IF XRP1 /= IDENT(REC.RP1) OR
-                             XRP1.ALL /= IDENT_INT(4) THEN
-                               FAILED ("INCORRECT VALUE OF XRP1 (4)");
-                          END IF;
- 
-                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRV1 (4)");
-                          END IF;
- 
-                          XRT1.VALU(I);
-                          IF I /= IDENT_INT(4) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XRT1.VALU (4)");
-                          END IF;
- 
-                          FOR J IN XAI1'RANGE LOOP
-                               IF XAI1(J) /= IDENT_INT(4) THEN
-                                    FAILED ("INCORRECT VALUE OF XAI1(" &
-                                            INTEGER'IMAGE(J) & ") (4)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAA1'RANGE LOOP
-                               IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),
-                                              IDENT_INT(4)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAA1(" &
-                                            INTEGER'IMAGE(J) & ") (4)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAR1'RANGE LOOP
-                               IF XAR1(J) /= (D => 1, FIELD1 =>
-                                       IDENT_INT(4)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAR1(" &
-                                            INTEGER'IMAGE(J) & ") (4)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAP1'RANGE LOOP
-                               IF XAP1(J) /= IDENT(AP1(J)) OR
-                                  XAP1(J).ALL /= IDENT_INT(4) THEN
-                                    FAILED ("INCORRECT VALUE OF XAP1(" &
-                                            INTEGER'IMAGE(J) & ") (4)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAV1'RANGE LOOP
-                               IF PACK1."/=" (XAV1(J),
-                                         PACK1.IDENT(PACK1.FOUR)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAV1(" &
-                                            INTEGER'IMAGE(J) & ") (4)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAT1'RANGE LOOP
-                               XAT1(J).VALU(I);
-                               IF I /= IDENT_INT(4) THEN
-                                    FAILED ("INCORRECT RETURN VALUE " &
-                                       "FROM XAT1(" &
-                                       INTEGER'IMAGE(J) & ").VALU (4)");
-                               END IF;
-                          END LOOP;
- 
-                          REC.RI1 := REC.RI1 + 1;
-                          REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
-                                      REC.RA1(3)+1);
-                          REC.RR1 := (D => 1, FIELD1 =>
-                                         REC.RR1.FIELD1 + 1);
-                          REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-                          REC.RV1 := PACK1.NEXT(REC.RV1);
-                          REC.RT1.NEXT;
-                          AI1(XAI1'RANGE) := (OTHERS =>
-                                              AI1(XAI1'FIRST) + 1);
-                          AA1(XAA1'RANGE) := (OTHERS =>
-                                     (OTHERS => AA1(XAA1'FIRST)(1) + 1));
-                          AR1(XAR1'RANGE) := (OTHERS => (D => 1,
-                                FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
-                          AP1(XAP1'RANGE) := (OTHERS =>
-                                NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
-                          FOR J IN XAV1'RANGE LOOP
-                               AV1(J) := PACK1.NEXT(AV1(J));
-                          END LOOP;
-                          FOR J IN XAT1'RANGE LOOP
-                               AT1(J).NEXT;
-                          END LOOP;
- 
-                          IF XRI1 /= IDENT_INT(5) THEN
-                               FAILED ("INCORRECT VALUE OF XRI1 (5)");
-                          END IF;
- 
-                          IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),
-                                      IDENT_INT(5)) THEN
-                               FAILED ("INCORRECT VALUE OF XRA1 (5)");
-                          END IF;
- 
-                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRR1 (5)");
-                          END IF;
- 
-                          IF XRP1 /= IDENT(REC.RP1) OR
-                             XRP1.ALL /= IDENT_INT(5) THEN
-                               FAILED ("INCORRECT VALUE OF XRP1 (5)");
-                          END IF;
- 
-                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE))
-                          THEN
-                               FAILED ("INCORRECT VALUE OF XRV1 (5)");
-                          END IF;
- 
-                          XRT1.VALU(I);
-                          IF I /= IDENT_INT(5) THEN
-                               FAILED ("INCORRECT RETURN VALUE OF " &
-                                       "XRT1.VALU (5)");
-                          END IF;
- 
-                          FOR J IN XAI1'RANGE LOOP
-                               IF XAI1(J) /= IDENT_INT(5) THEN
-                                    FAILED ("INCORRECT VALUE OF XAI1(" &
-                                            INTEGER'IMAGE(J) & ") (5)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAA1'RANGE LOOP
-                               IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),
-                                              IDENT_INT(5)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAA1(" &
-                                            INTEGER'IMAGE(J) & ") (5)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAR1'RANGE LOOP
-                               IF XAR1(J) /= (D => 1, FIELD1 =>
-                                       IDENT_INT(5)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAR1(" &
-                                            INTEGER'IMAGE(J) & ") (5)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAP1'RANGE LOOP
-                               IF XAP1(J) /= IDENT(AP1(J)) OR
-                                  XAP1(J).ALL /= IDENT_INT(5) THEN
-                                    FAILED ("INCORRECT VALUE OF XAP1(" &
-                                            INTEGER'IMAGE(J) & ") (5)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAV1'RANGE LOOP
-                               IF PACK1."/=" (XAV1(J),
-                                            PACK1.IDENT(PACK1.FIVE)) THEN
-                                    FAILED ("INCORRECT VALUE OF XAV1(" &
-                                            INTEGER'IMAGE(J) & ") (5)");
-                               END IF;
-                          END LOOP;
- 
-                          FOR J IN XAT1'RANGE LOOP
-                               XAT1(J).VALU(I);
-                               IF I /= IDENT_INT(5) THEN
-                                    FAILED ("INCORRECT RETURN VALUE " &
-                                       "FROM XAT1(" &
-                                       INTEGER'IMAGE(J) & ").VALU (5)");
-                               END IF;
-                          END LOOP;
-                     END;
-                END START;
-           END MAIN_TASK;
- 
-      BEGIN
-           MAIN_TASK.START (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
-      END;
- 
-      DREC.RT1.STOP;
- 
-      FOR I IN DAT1'RANGE LOOP
-           DAT1(I).STOP;
-      END LOOP;
- 
-      RESULT;
- END C85006C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,712 ****
- -- C85006D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY A
- --     GENERIC 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE
- --     CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
- --     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT'
- --     OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
- --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
- --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/22/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85006D IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
-      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
-      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
-      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
-      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
-      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
- 
-      TYPE REC_TYPE IS RECORD
-           RI1 : INTEGER := 0;
-           RA1 : ARRAY1(1..3) := (OTHERS => 0);
-           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-           RP1 : POINTER1 := NEW INTEGER'(0);
-           RV1 : PACK1.PRIVY := PACK1.ZERO;
-           RT1 : TASK1;
-      END RECORD;
- 
-      DREC : REC_TYPE;
- 
-      DAI1 : ARR_INT(1..8) := (OTHERS => 0);
-      DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
-      DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
-      DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
-      DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
-      DAT1 : ARR_TSK(1..8);
- 
-      GENERIC
-           REC : IN OUT REC_TYPE;
-           AI1 : IN OUT ARR_INT;
-           AA1 : IN OUT ARR_ARR;
-           AR1 : IN OUT ARR_REC;
-           AP1 : IN OUT ARR_PTR;
-           AV1 : IN OUT ARR_PVT;
-           AT1 : IN OUT ARR_TSK;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-           XRI1 : INTEGER RENAMES REC.RI1;
-           XRA1 : ARRAY1 RENAMES REC.RA1;
-           XRR1 : RECORD1 RENAMES REC.RR1;
-           XRP1 : POINTER1 RENAMES REC.RP1;
-           XRV1 : PACK1.PRIVY RENAMES REC.RV1;
-           XRT1 : TASK1 RENAMES REC.RT1;
-           XAI1 : ARR_INT RENAMES AI1(1..3);
-           XAA1 : ARR_ARR RENAMES AA1(2..4);
-           XAR1 : ARR_REC RENAMES AR1(3..5);
-           XAP1 : ARR_PTR RENAMES AP1(4..6);
-           XAV1 : ARR_PVT RENAMES AV1(5..7);
-           XAT1 : ARR_TSK RENAMES AT1(6..8);
- 
-           TASK TYPE TASK2 IS
-                ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                              TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
-                              TRV1 : IN OUT PACK1.PRIVY;
-                              TRT1 : IN OUT TASK1;
-                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                              TAV1 : IN OUT ARR_PVT;
-                              TAT1 : IN OUT ARR_TSK);
-           END TASK2;
- 
-           CHK_TASK : TASK2;
-           I : INTEGER;
- 
-           GENERIC
-                GRI1 : IN OUT INTEGER;
-                GRA1 : IN OUT ARRAY1;
-                GRR1 : IN OUT RECORD1;
-                GRP1 : IN OUT POINTER1;
-                GRV1 : IN OUT PACK1.PRIVY;
-                GRT1 : IN OUT TASK1;
-                GAI1 : IN OUT ARR_INT;
-                GAA1 : IN OUT ARR_ARR;
-                GAR1 : IN OUT ARR_REC;
-                GAP1 : IN OUT ARR_PTR;
-                GAV1 : IN OUT ARR_PVT;
-                GAT1 : IN OUT ARR_TSK;
-           PACKAGE GENERIC2 IS
-           END GENERIC2;
- 
-           PACKAGE BODY GENERIC2 IS
-           BEGIN
-                GRI1 := GRI1 + 1;
-                GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
-                GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
-                GRP1 := NEW INTEGER'(GRP1.ALL + 1);
-                GRV1 := PACK1.NEXT(GRV1);
-                GRT1.NEXT;
-                GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
-                GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
-                GAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
-                GAP1 := (OTHERS =>
-                          NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
-                FOR J IN GAV1'RANGE LOOP
-                     GAV1(J) := PACK1.NEXT(GAV1(J));
-                END LOOP;
-                FOR J IN GAT1'RANGE LOOP
-                     GAT1(J).NEXT;
-                END LOOP;
-           END GENERIC2;
- 
-           PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
-                            PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
-                            PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
-                            PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
-                            PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
-                            PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
-           BEGIN
-                PRI1 := PRI1 + 1;
-                PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
-                PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
-                PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-                PRV1 := PACK1.NEXT(REC.RV1);
-                PRT1.NEXT;
-                PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
-                PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
-                PAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                    (PAR1(PAR1'FIRST).FIELD1 + 1)));
-                PAP1 := (OTHERS =>
-                         NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
-                FOR J IN PAV1'RANGE LOOP
-                     PAV1(J) := PACK1.NEXT(AV1(J));
-                END LOOP;
-                FOR J IN PAT1'RANGE LOOP
-                     PAT1(J).NEXT;
-                END LOOP;
-           END PROC1;
- 
-           TASK BODY TASK2 IS
-           BEGIN
-                ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                               TRR1 : OUT RECORD1;
-                               TRP1 : IN OUT POINTER1;
-                               TRV1 : IN OUT PACK1.PRIVY;
-                               TRT1: IN OUT TASK1;
-                               TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                               TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                               TAV1 : IN OUT ARR_PVT;
-                               TAT1 : IN OUT ARR_TSK)
-                DO
-                     TRI1 := REC.RI1 + 1;
-                     TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
-                     TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
-                     TRP1 := NEW INTEGER'(TRP1.ALL + 1);
-                     TRV1 := PACK1.NEXT(TRV1);
-                     TRT1.NEXT;
-                     TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
-                     TAA1 := (OTHERS => (OTHERS =>
-                                         AA1(TAA1'FIRST)(1) + 1));
-                     TAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                         (AR1(TAR1'FIRST).FIELD1 + 1)));
-                     TAP1 := (OTHERS =>
-                              NEW INTEGER'(TAP1(TAP1'FIRST).ALL + 1));
-                     FOR J IN TAV1'RANGE LOOP
-                          TAV1(J) := PACK1.NEXT(TAV1(J));
-                     END LOOP;
-                     FOR J IN TAT1'RANGE LOOP
-                          TAT1(J).NEXT;
-                     END LOOP;
-                END ENTRY1;
-           END TASK2;
- 
-           PACKAGE GENPACK2 IS NEW
-                GENERIC2 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-      BEGIN
-           IF XRI1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (1)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (1)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (1)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (1)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (1)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(1)
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (1)");
-                END IF;
-           END LOOP;
- 
-           PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                  XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-           IF XRI1 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (2)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (2)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (2)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (2)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (2)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (2)");
-                END IF;
-           END LOOP;
- 
-           CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                           XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-           IF XRI1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (3)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (3)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (3)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (3)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (3)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (3)");
-                END IF;
-           END LOOP;
- 
-           XRI1 := XRI1 + 1;
-           XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
-           XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
-           XRP1 := NEW INTEGER'(XRP1.ALL + 1);
-           XRV1 := PACK1.NEXT(XRV1);
-           XRT1.NEXT;
-           XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
-           XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
-           XAR1 := (OTHERS => (D => 1,
-                          FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
-           XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
-           FOR J IN XAV1'RANGE LOOP
-                XAV1(J) := PACK1.NEXT(XAV1(J));
-           END LOOP;
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).NEXT;
-           END LOOP;
- 
-           IF XRI1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (4)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (4)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (4)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (4)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (4)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (4)");
-                END IF;
-           END LOOP;
- 
-           REC.RI1 := REC.RI1 + 1;
-           REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
-           REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
-           REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
-           REC.RV1 := PACK1.NEXT(REC.RV1);
-           REC.RT1.NEXT;
-           AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
-           AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
-           AR1 := (OTHERS => (D => 1,
-                              FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
-           AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
-           FOR J IN XAV1'RANGE LOOP
-                AV1(J) := PACK1.NEXT(AV1(J));
-           END LOOP;
-           FOR J IN XAT1'RANGE LOOP
-                AT1(J).NEXT;
-           END LOOP;
- 
-           IF XRI1 /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (5)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (5)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (5)");
-           END IF;
- 
-           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (5)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (5)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                XAP1(J).ALL /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (5)");
-                END IF;
-           END LOOP;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
- BEGIN
-      TEST ("C85006D", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
-                       "CREATED BY A GENERIC 'IN OUT' FORMAL " &
-                       "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " &
-                       "VALUE, AND THAT THE NEW NAME CAN BE USED IN " &
-                       "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " &
-                       "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
-                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
-                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
-                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
-                       "REFLECTED BY THE VALUE OF THE NEW NAME");
- 
-      DECLARE
-           PACKAGE GENPACK IS NEW
-                GENERIC1 (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
-      BEGIN
-           NULL;
-      END;
- 
-      DREC.RT1.STOP;
- 
-      FOR I IN DAT1'RANGE LOOP
-           DAT1(I).STOP;
-      END LOOP;
- 
-      RESULT;
- END C85006D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,702 ****
- -- C85006E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY AN
- --     ALLOCATOR CAN BE RENAMED AND HAS THE CORRECT VALUE,
- --     AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT
- --     AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
- --     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
- --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
- --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
- 
- -- HISTORY:
- --     JET 03/22/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85006E IS
- 
-      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-      TYPE RECORD1 (D : INTEGER) IS
-           RECORD
-                FIELD1 : INTEGER := 1;
-           END RECORD;
-      TYPE POINTER1 IS ACCESS INTEGER;
- 
-      PACKAGE PACK1 IS
-           TYPE PRIVY IS PRIVATE;
-           ZERO : CONSTANT PRIVY;
-           ONE : CONSTANT PRIVY;
-           TWO : CONSTANT PRIVY;
-           THREE : CONSTANT PRIVY;
-           FOUR : CONSTANT PRIVY;
-           FIVE : CONSTANT PRIVY;
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
-      PRIVATE
-           TYPE PRIVY IS RANGE 0..127;
-           ZERO : CONSTANT PRIVY := 0;
-           ONE : CONSTANT PRIVY := 1;
-           TWO : CONSTANT PRIVY := 2;
-           THREE : CONSTANT PRIVY := 3;
-           FOUR : CONSTANT PRIVY := 4;
-           FIVE : CONSTANT PRIVY := 5;
-      END PACK1;
- 
-      TASK TYPE TASK1 IS
-           ENTRY ASSIGN (J : IN INTEGER);
-           ENTRY VALU (J : OUT INTEGER);
-           ENTRY NEXT;
-           ENTRY STOP;
-      END TASK1;
- 
-      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
-      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
-      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
-      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
-      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
-      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
- 
-      TYPE REC_TYPE IS RECORD
-           RI1 : INTEGER := 0;
-           RA1 : ARRAY1(1..3) := (OTHERS => 0);
-           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
-           RP1 : POINTER1 := NEW INTEGER'(0);
-           RV1 : PACK1.PRIVY := PACK1.ZERO;
-           RT1 : TASK1;
-      END RECORD;
- 
-      GENERIC
-           GRI1 : IN OUT INTEGER;
-           GRA1 : IN OUT ARRAY1;
-           GRR1 : IN OUT RECORD1;
-           GRP1 : IN OUT POINTER1;
-           GRV1 : IN OUT PACK1.PRIVY;
-           GRT1 : IN OUT TASK1;
-           GAI1 : IN OUT ARR_INT;
-           GAA1 : IN OUT ARR_ARR;
-           GAR1 : IN OUT ARR_REC;
-           GAP1 : IN OUT ARR_PTR;
-           GAV1 : IN OUT ARR_PVT;
-           GAT1 : IN OUT ARR_TSK;
-      PACKAGE GENERIC1 IS
-      END GENERIC1;
- 
-      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
-      BEGIN
-           IF EQUAL (3,3) THEN
-                RETURN P;
-           ELSE
-                RETURN NULL;
-           END IF;
-      END IDENT;
- 
-      PACKAGE BODY PACK1 IS
-           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN I;
-                ELSE
-                     RETURN PRIVY'(0);
-                END IF;
-           END IDENT;
- 
-           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
-           BEGIN
-                RETURN I+1;
-           END NEXT;
-      END PACK1;
- 
-      PACKAGE BODY GENERIC1 IS
-      BEGIN
-           GRI1 := GRI1 + 1;
-           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
-           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
-           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
-           GRV1 := PACK1.NEXT(GRV1);
-           GRT1.NEXT;
-           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
-           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
-           GAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
-           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
-           FOR J IN GAV1'RANGE LOOP
-                GAV1(J) := PACK1.NEXT(GAV1(J));
-           END LOOP;
-           FOR J IN GAT1'RANGE LOOP
-                GAT1(J).NEXT;
-           END LOOP;
-      END GENERIC1;
- 
-      TASK BODY TASK1 IS
-           TASK_VALUE : INTEGER := 0;
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ASSIGN (J : IN INTEGER) DO
-                          TASK_VALUE := J;
-                     END ASSIGN;
-                OR
-                     ACCEPT VALU (J : OUT INTEGER) DO
-                          J := TASK_VALUE;
-                     END VALU;
-                OR
-                     ACCEPT NEXT DO
-                          TASK_VALUE := TASK_VALUE + 1;
-                     END NEXT;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END TASK1;
- 
- BEGIN
-      TEST ("C85006E", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
-                       "CREATED BY AN ALLOCATOR CAN BE " &
-                       "RENAMED AND HAS THE CORRECT VALUE, AND THAT " &
-                       "THE NEW NAME CAN BE USED IN AN ASSIGNMENT " &
-                       "STATEMENT AND PASSED ON AS AN ACTUAL " &
-                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
-                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
-                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
-                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
-                       "REFLECTED BY THE VALUE OF THE NEW NAME");
- 
-      DECLARE
-           TYPE AREC_TYPE IS ACCESS REC_TYPE;
-           AREC : AREC_TYPE := NEW REC_TYPE;
- 
-           TYPE ACC_INT IS ACCESS ARR_INT;
-           TYPE ACC_ARR IS ACCESS ARR_ARR;
-           TYPE ACC_REC IS ACCESS ARR_REC;
-           TYPE ACC_PTR IS ACCESS ARR_PTR;
-           TYPE ACC_PVT IS ACCESS ARR_PVT;
-           TYPE ACC_TSK IS ACCESS ARR_TSK;
- 
-           AI1 : ACC_INT := NEW ARR_INT'(1..8 => 0);
-           AA1 : ACC_ARR := NEW ARR_ARR'(1..8 => (OTHERS => 0));
-           AR1 : ACC_REC := NEW ARR_REC'(1..8 => (D => 1, FIELD1 => 0));
-           AP1 : ACC_PTR := NEW ARR_PTR'(1..8 => NEW INTEGER'(0));
-           AV1 : ACC_PVT := NEW ARR_PVT'(1..8 => PACK1.ZERO);
-           AT1 : ACC_TSK := NEW ARR_TSK(1..8);
- 
-           XRI1 : INTEGER RENAMES AREC.RI1;
-           XRA1 : ARRAY1 RENAMES AREC.RA1;
-           XRR1 : RECORD1 RENAMES AREC.RR1;
-           XRP1 : POINTER1 RENAMES AREC.RP1;
-           XRV1 : PACK1.PRIVY RENAMES AREC.RV1;
-           XRT1 : TASK1 RENAMES AREC.RT1;
-           XAI1 : ARR_INT RENAMES AI1(1..3);
-           XAA1 : ARR_ARR RENAMES AA1(2..4);
-           XAR1 : ARR_REC RENAMES AR1(3..5);
-           XAP1 : ARR_PTR RENAMES AP1(4..6);
-           XAV1 : ARR_PVT RENAMES AV1(5..7);
-           XAT1 : ARR_TSK RENAMES AT1(6..8);
- 
-           TASK TYPE TASK2 IS
-                ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                              TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
-                              TRV1 : IN OUT PACK1.PRIVY;
-                              TRT1 : IN OUT TASK1;
-                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                              TAV1 : IN OUT ARR_PVT;
-                              TAT1 : IN OUT ARR_TSK);
-           END TASK2;
- 
-           I : INTEGER;
-           CHK_TASK : TASK2;
- 
-           PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
-                            PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
-                            PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
-                            PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
-                            PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
-                            PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
-           BEGIN
-                PRI1 := PRI1 + 1;
-                PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
-                PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
-                PRP1 := NEW INTEGER'(AREC.RP1.ALL + 1);
-                PRV1 := PACK1.NEXT(AREC.RV1);
-                PRT1.NEXT;
-                PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
-                PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
-                PAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                    (PAR1(PAR1'FIRST).FIELD1 + 1)));
-                PAP1 := (OTHERS =>
-                         NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
-                FOR J IN PAV1'RANGE LOOP
-                     PAV1(J) := PACK1.NEXT(AV1(J));
-                END LOOP;
-                FOR J IN PAT1'RANGE LOOP
-                     PAT1(J).NEXT;
-                END LOOP;
-           END PROC1;
- 
-           TASK BODY TASK2 IS
-           BEGIN
-                ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
-                               TRR1 : OUT RECORD1;
-                               TRP1 : IN OUT POINTER1;
-                               TRV1 : IN OUT PACK1.PRIVY;
-                               TRT1: IN OUT TASK1;
-                               TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
-                               TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
-                               TAV1 : IN OUT ARR_PVT;
-                               TAT1 : IN OUT ARR_TSK)
-                DO
-                     TRI1 := AREC.RI1 + 1;
-                     TRA1 := (AREC.RA1(1)+1, AREC.RA1(2)+1,
-                              AREC.RA1(3)+1);
-                     TRR1 := (D => 1, FIELD1 => AREC.RR1.FIELD1 + 1);
-                     TRP1 := NEW INTEGER'(TRP1.ALL + 1);
-                     TRV1 := PACK1.NEXT(TRV1);
-                     TRT1.NEXT;
-                     TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
-                     TAA1 := (OTHERS => (OTHERS =>
-                                         AA1(TAA1'FIRST)(1) + 1));
-                     TAR1 := (OTHERS => (D => 1, FIELD1 =>
-                                         (AR1(TAR1'FIRST).FIELD1 + 1)));
-                     TAP1 := (OTHERS =>
-                              NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
-                     FOR J IN TAV1'RANGE LOOP
-                          TAV1(J) := PACK1.NEXT(TAV1(J));
-                     END LOOP;
-                     FOR J IN TAT1'RANGE LOOP
-                          TAT1(J).NEXT;
-                     END LOOP;
-                END ENTRY1;
-           END TASK2;
- 
-           PACKAGE GENPACK2 IS NEW
-                GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
-      BEGIN
-           IF XRI1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (1)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (1)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (1)");
-           END IF;
- 
-           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (1)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (1)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (1)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(1) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (1)");
-                END IF;
-           END LOOP;
- 
-           PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                  XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-           IF XRI1 /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (2)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (2)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (2)");
-           END IF;
- 
-           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (2)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (2)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(2) THEN
-                FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (2)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (2)");
-                END IF;
-           END LOOP;
- 
-           CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
-                           XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
- 
-           IF XRI1 /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (3)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (3)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (3)");
-           END IF;
- 
-           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (3)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (3)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(3) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (3)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (3)");
-                END IF;
-           END LOOP;
- 
-           XRI1 := XRI1 + 1;
-           XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
-           XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
-           XRP1 := NEW INTEGER'(XRP1.ALL + 1);
-           XRV1 := PACK1.NEXT(XRV1);
-           XRT1.NEXT;
-           XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
-           XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
-           XAR1 := (OTHERS => (D => 1,
-                               FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
-           XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
-           FOR J IN XAV1'RANGE LOOP
-                XAV1(J) := PACK1.NEXT(XAV1(J));
-           END LOOP;
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).NEXT;
-           END LOOP;
- 
-           IF XRI1 /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (4)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (4)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (4)");
-           END IF;
- 
-           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (4)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (4)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(4) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (4)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (4)");
-                END IF;
-           END LOOP;
- 
-           AREC.RI1 := AREC.RI1 + 1;
-           AREC.RA1 := (AREC.RA1(1)+1, AREC.RA1(2)+1, AREC.RA1(3)+1);
-           AREC.RR1 := (D => 1, FIELD1 => AREC.RR1.FIELD1 + 1);
-           AREC.RP1 := NEW INTEGER'(AREC.RP1.ALL + 1);
-           AREC.RV1 := PACK1.NEXT(AREC.RV1);
-           AREC.RT1.NEXT;
-           AI1(XAI1'RANGE) := (OTHERS => AI1(XAI1'FIRST) + 1);
-           AA1(XAA1'RANGE) := (OTHERS =>
-                         (OTHERS => AA1(XAA1'FIRST)(1) + 1));
-           AR1(XAR1'RANGE) := (OTHERS => (D => 1,
-                         FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
-           AP1(XAP1'RANGE) := (OTHERS =>
-                              NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
-           FOR J IN XAV1'RANGE LOOP
-                AV1(J) := PACK1.NEXT(AV1(J));
-           END LOOP;
-           FOR J IN XAT1'RANGE LOOP
-                AT1(J).NEXT;
-           END LOOP;
- 
-           IF XRI1 /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XRI1 (5)");
-           END IF;
- 
-           IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XRA1 (5)");
-           END IF;
- 
-           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                FAILED ("INCORRECT VALUE OF XRR1 (5)");
-           END IF;
- 
-           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT VALUE OF XRP1 (5)");
-           END IF;
- 
-           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
-                FAILED ("INCORRECT VALUE OF XRV1 (5)");
-           END IF;
- 
-           XRT1.VALU(I);
-           IF I /= IDENT_INT(5) THEN
-                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
-           END IF;
- 
-           FOR J IN XAI1'RANGE LOOP
-                IF XAI1(J) /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT VALUE OF XAI1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAA1'RANGE LOOP
-                IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
-                THEN
-                     FAILED ("INCORRECT VALUE OF XAA1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAR1'RANGE LOOP
-                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
-                     FAILED ("INCORRECT VALUE OF XAR1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAP1'RANGE LOOP
-                IF XAP1(J) /= IDENT(AP1(J)) OR
-                   XAP1(J).ALL /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT VALUE OF XAP1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAV1'RANGE LOOP
-                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
-                     FAILED ("INCORRECT VALUE OF XAV1(" &
-                             INTEGER'IMAGE(J) & ") (5)");
-                END IF;
-           END LOOP;
- 
-           FOR J IN XAT1'RANGE LOOP
-                XAT1(J).VALU(I);
-                IF I /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
-                             INTEGER'IMAGE(J) & ").VALU (5)");
-                END IF;
-           END LOOP;
- 
-           AREC.RT1.STOP;
- 
-           FOR I IN AT1'RANGE LOOP
-                AT1(I).STOP;
-           END LOOP;
-      END;
- 
-      RESULT;
- END C85006E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- C85006F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RENAMED SLICE CAN BE SLICED AND INDEXED FOR PURPOSES
- --     OF ASSIGNMENT AND TO READ THE VALUE.
- 
- -- HISTORY:
- --     JET 07/26/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85006F IS
- 
-      S : STRING(1..30) := "IT WAS A DARK AND STORMY NIGHT";
- 
-      ADJECTIVES : STRING RENAMES S(10..24);
- 
- BEGIN
-      TEST ("C85006F", "CHECK THAT A RENAMED SLICE CAN BE SLICED AND " &
-                       "INDEXED FOR PURPOSES OF ASSIGNMENT AND TO " &
-                       "READ THE VALUE");
- 
-      ADJECTIVES(19..24) := "STARRY";
- 
-      IF ADJECTIVES /= IDENT_STR("DARK AND STARRY") THEN
-           FAILED ("INCORRECT VALUE OF SLICE AFTER ASSIGNMENT (1)");
-      END IF;
- 
-      IF S /= IDENT_STR("IT WAS A DARK AND STARRY NIGHT") THEN
-           FAILED ("INCORRECT VALUE OF ORIGINAL STRING (1)");
-      END IF;
- 
-      ADJECTIVES(17) := ''';
- 
-      IF ADJECTIVES /= IDENT_STR("DARK AN' STARRY") THEN
-           FAILED ("INCORRECT VALUE OF SLICE AFTER ASSIGNMENT (2)");
-      END IF;
- 
-      IF S /= IDENT_STR("IT WAS A DARK AN' STARRY NIGHT") THEN
-           FAILED ("INCORRECT VALUE OF ORIGINAL STRING (2)");
-      END IF;
- 
-      IF ADJECTIVES(10..13) /= IDENT_STR("DARK") THEN
-           FAILED ("INCORRECT VALUE OF SLICE WHEN READING");
-      END IF;
- 
-      RESULT;
- 
- END C85006F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85006g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85006g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C85006G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY THE TYPE MARK USED
- --     IN THE SLICE RENAMING DECLARATION IS IGNORED, AND THAT THE
- --     SUBTYPE CONSTRAINT ASSOCIATED WITH THE RENAMED VARIABLE IS
- --     USED INSTEAD.
- 
- -- HISTORY:
- --     JET 07/26/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85006G IS
- 
-      SUBTYPE STR IS STRING(1..10);
- 
-      S : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
-      T : STR := IDENT_STR("0123456789");
- 
-      DG1 : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
-      DG2 : STR := IDENT_STR("0123456789");
- 
-      XS : STR RENAMES S(10..24);
-      XT : STRING RENAMES T(1..5);
- 
-      GENERIC
-           G1 : IN OUT STR;
-           G2 : IN OUT STRING;
-      PACKAGE GEN IS
-           XG1 : STR RENAMES G1(10..24);
-           XG2 : STRING RENAMES G2(1..5);
-      END GEN;
- 
-      PACKAGE PACK IS NEW GEN(DG1, DG2);
-      USE PACK;
- 
- BEGIN
-      TEST ("C85006G", "CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY " &
-                       "THE TYPE MARK USED IN THE SLICE RENAMING " &
-                       "DECLARATION IS IGNORED, AND THAT THE SUBTYPE " &
-                       "CONSTRAINT ASSOCIATED WITH THE RENAMED " &
-                       "VARIABLE IS USED INSTEAD");
- 
-      IF XS'FIRST /= IDENT_INT(10) OR
-         XS'LAST /= IDENT_INT(24) OR
-         XS'LENGTH /= IDENT_INT(15) THEN
-           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 1");
-      END IF;
- 
-      IF XS /= "DARK AND STORMY" THEN
-           FAILED("INCORRECT VALUE OF RENAMING SLICE - 1");
-      END IF;
- 
-      XS := IDENT_STR("STORMY AND DARK");
- 
-      IF S /= "IT WAS A STORMY AND DARK NIGHT" THEN
-           FAILED("INCORRECT VALUE OF ORIGINAL STRING - 1");
-      END IF;
- 
-      IF XT'FIRST /= IDENT_INT(1) OR
-         XT'LAST /= IDENT_INT(5) OR
-         XT'LENGTH /= IDENT_INT(5) THEN
-           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 2");
-      END IF;
- 
-      IF XT /= "01234" THEN
-           FAILED("INCORRECT VALUE OF RENAMING SLICE - 2");
-      END IF;
- 
-      XT := IDENT_STR("43210");
- 
-      IF T /= "4321056789" THEN
-           FAILED("INCORRECT VALUE OF ORIGINAL STRING - 2");
-      END IF;
- 
-      IF XG1'FIRST /= IDENT_INT(10) OR
-         XG1'LAST /= IDENT_INT(24) OR
-         XG1'LENGTH /= IDENT_INT(15) THEN
-           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G1");
-      END IF;
- 
-      IF XG1 /= "DARK AND STORMY" THEN
-           FAILED("INCORRECT VALUE OF RENAMING SLICE - G1");
-      END IF;
- 
-      XG1 := IDENT_STR("STORMY AND DARK");
- 
-      IF DG1 /= "IT WAS A STORMY AND DARK NIGHT" THEN
-           FAILED("INCORRECT VALUE OF ORIGINAL STRING - G1");
-      END IF;
- 
-      IF XG2'FIRST /= IDENT_INT(1) OR
-         XG2'LAST /= IDENT_INT(5) OR
-         XG2'LENGTH /= IDENT_INT(5) THEN
-           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G2");
-      END IF;
- 
-      IF XG2 /= "01234" THEN
-           FAILED("INCORRECT VALUE OF RENAMING SLICE - G2");
-      END IF;
- 
-      XG2 := IDENT_STR("43210");
- 
-      IF DG2 /= "4321056789" THEN
-           FAILED("INCORRECT VALUE OF ORIGINAL STRING - G2");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED("UNEXPECTED EXCEPTION RAISED");
-           RESULT;
- END C85006G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- C85007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE DISCRIMINANTS OF A RENAMED OUT FORMAL PARAMETER, AS
- -- WELL AS THE DISCRIMINANTS OF THE RENAMED SUBCOMPONENTS OF AN OUT
- -- FORMAL PARAMETER, MAY BE READ INSIDE THE PROCEDURE.
- 
- -- SPS 02/17/84 (SEE C62006A-B.ADA)
- -- EG  02/21/84
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C85007A IS
- 
- BEGIN
- 
-      TEST ("C85007A", "CHECK THAT THE DISCRIMINANTS OF A RENAMED OUT " &
-            "FORMAL PARAMETER CAN BE READ INSIDE THE PROCEDURE");
- 
-      DECLARE
- 
-           TYPE R1 (D1 : INTEGER) IS RECORD
-                NULL;
-           END RECORD;
- 
-           TYPE R2 (D2 : POSITIVE) IS RECORD
-                C : R1 (2);
-           END RECORD;
- 
-           SUBTYPE R1_2 IS R1(2);
- 
-           R : R2 (5);
- 
-           PROCEDURE PROC (REC : OUT R2) IS
- 
-                REC1 : R2   RENAMES REC;
-                REC2 : R1_2 RENAMES REC.C;
-                REC3 : R2   RENAMES REC1;
-                REC4 : R1_2 RENAMES REC1.C;
-                REC5 : R1_2 RENAMES REC4;
- 
-           BEGIN
- 
-                IF REC1.D2 /= 5 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
-                             " A RENAMED OUT PARAMETER");
-                END IF;
- 
-                IF REC1.C.D1 /= 2 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
-                             "OF THE SUBCOMPONENT OF A RENAMED OUT "  &
-                             "PARAMETER");
-                END IF;
- 
-                IF REC2.D1 /= 2 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
-                             "OF A RENAMED SUBCOMPONENT OF AN OUT "   &
-                             "PARAMETER");
-                END IF;
- 
-                IF REC3.D2 /= 5 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
-                             " A RENAME OF A RENAMED OUT PARAMETER");
-                END IF;
- 
-                IF REC3.C.D1 /= 2 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
-                             "OF THE SUBCOMPONENT OF A RENAME OF A "  &
-                             "RENAMED OUT PARAMETER");
-                END IF;
- 
-                IF REC4.D1 /= 2 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
-                             "OF A RENAMED SUBCOMPONENT OF A RENAMED" &
-                             " OUT PARAMETER");
-                END IF;
- 
-                IF REC5.D1 /= 2 THEN
-                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
-                             "OF A RENAME OF RENAMED SUBCOMPONENT OF" &
-                             " A RENAMED OUT PARAMETER");
-                END IF;
- 
-           END PROC;
- 
-      BEGIN
- 
-           PROC (R);
- 
-      END;
- 
-      RESULT;
- 
- END C85007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85007e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85007e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85007e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85007e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C85007E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RENAMED OUT PARAMETER, OUT PARAMETER COMPONENT, OR
- -- OUT PARAMETER SLICE CAN BE ASSIGNED TO.
- 
- -- EG  02/22/84
- 
- WITH REPORT;
- 
- PROCEDURE C85007E IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C85007E","CHECK THAT A RENAMED OUT PARAMETER, PARAMETER " &
-                     "COMPONENT, OR PARAMETER SLICE CAN BE ASSIGNED TO");
- 
-      DECLARE
- 
-           TYPE AT1 IS ARRAY(1 .. 3) OF INTEGER;
-           TYPE RT (A : INTEGER) IS
-                RECORD
-                     B : AT1;
-                     C : INTEGER;
-                END RECORD;
- 
-           A1, B1 : INTEGER;
-           A2, B2 : AT1;
-           A3, B3 : RT(1);
- 
-           PROCEDURE PROC1 (A : OUT INTEGER;
-                            B : OUT AT1;
-                            C : OUT RT) IS
- 
-                AA : INTEGER RENAMES A;
-                BB : AT1     RENAMES B;
-                CC : RT      RENAMES C;
- 
-           BEGIN
- 
-                AA := -1;
-                BB := (1 .. 3 => -2);
-                CC := (1, (2, 3, 4), 5);
- 
-           END PROC1;
- 
-           PROCEDURE PROC2 (X : OUT AT1;
-                            Y : OUT INTEGER;
-                            Z : OUT RT) IS
- 
-                XX : AT1     RENAMES X;
-                YY : INTEGER RENAMES Y;
-                ZZ : RT      RENAMES Z;
- 
-           BEGIN
- 
-                PROC1 (YY, XX, ZZ);
- 
-           END PROC2;
- 
-      BEGIN
- 
-           PROC1 (A1, A2, A3);
-           IF A1 /= IDENT_INT(-1) OR A2 /= (1 .. 3 => IDENT_INT(-2)) OR
-              A3 /= (1, (2, 3, 4), IDENT_INT(5)) THEN
-                FAILED ("CASE 1 : ERROR IN ASSIGNMENT");
-           END IF;
- 
-           PROC2 (B2, B1, B3);
-           IF B1 /= IDENT_INT(-1) OR B2 /= (1 .. 3 => IDENT_INT(-2)) OR
-              B3 /= (1, (2, 3, 4), IDENT_INT(5)) THEN
-                FAILED ("CASE 2 : ERROR IN ASSIGNMENT");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C85007E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C85009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PREDEFINED AND USER-DEFINED EXCEPTIONS CAN BE RENAMED
- --     AND THAT HANDLERS REFERRING TO EITHER NAME ARE INVOKED WHEN THE
- --     EXCEPTION IS RAISED, EVEN BY AN EXPLICIT 'RAISE' STATEMENT
- --     REFERRING TO THE OTHER NAME.
- 
- -- HISTORY:
- --     JET 03/24/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85009A IS
- 
-      MY_EXCEPTION : EXCEPTION;
- 
-      MY_EXCEPTION2 : EXCEPTION RENAMES MY_EXCEPTION;
- 
-      CONSTRAINT_ERROR2 : EXCEPTION RENAMES CONSTRAINT_ERROR;
- 
-      I : INTEGER := 1;
- 
- BEGIN
-      TEST ("C85009A", "CHECK THAT PREDEFINED AND USER-DEFINED " &
-                       "EXCEPTIONS CAN BE RENAMED AND THAT HANDLERS " &
-                       "REFERRING TO EITHER NAME ARE INVOKED WHEN " &
-                       "THE EXCEPTION IS RAISED, EVEN BY AN EXPLICIT " &
-                       "'RAISE' STATEMENT REFERRING TO THE OTHER NAME");
- 
-      BEGIN
-           RAISE MY_EXCEPTION;
-           FAILED ("MY_EXCEPTION NOT RAISED");
-      EXCEPTION
-           WHEN MY_EXCEPTION2 =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY MY_EXCEPTION");
-      END;
- 
-      BEGIN
-           RAISE MY_EXCEPTION2;
-           FAILED ("MY_EXCEPTION2 NOT RAISED");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY MY_EXCEPTION2");
-      END;
- 
-      DECLARE
-           TYPE COLORS IS (RED, BLUE, YELLOW);
-           E : COLORS := RED;
-      BEGIN
-           E := COLORS'PRED(E);
-           IF NOT EQUAL(COLORS'POS(E),COLORS'POS(E)) THEN
-                COMMENT("DON'T OPTIMIZE E");
-           END IF;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED BY PRED(RED)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR2 =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY PRED(RED)");
-      END;
- 
-      BEGIN
-           RAISE CONSTRAINT_ERROR;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR2 =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY CONSTRAINT_ERROR");
-      END;
- 
-      BEGIN
-           RAISE CONSTRAINT_ERROR2;
-           FAILED ("CONSTRAINT_ERROR2 NOT RAISED");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY CONSTRAINT_ERROR2");
-      END;
- 
-      RESULT;
- END C85009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- C85011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A PACKAGE CAN BE RENAMED AND THE NEW NAME CAN APPEAR
- --     IN A RENAMING DECLARATION, AND THAT A 'USE' CLAUSE CAN REFER TO
- --     THE PACKAGE BY EITHER NAME, INCLUDING RENAMINGS OF GENERIC AND
- --     NONGENERIC PACKAGES INSIDE THEMSELVES.
- 
- -- HISTORY:
- --     JET 04/28/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85011A IS
- 
-      PACKAGE PACK1 IS
-           I : NATURAL := 0;
-           PACKAGE PACKA RENAMES PACK1;
-      END PACK1;
- 
-      GENERIC
-           TYPE T IS RANGE <>;
-      PACKAGE GPACK IS
-           J : T := T'FIRST;
-           PACKAGE PACKB RENAMES GPACK;
-      END GPACK;
- 
-      PACKAGE PACK2 IS NEW GPACK(NATURAL);
- 
-      PACKAGE PACK3 RENAMES PACK1;
-      PACKAGE PACK4 RENAMES PACK2;
-      PACKAGE PACK5 RENAMES PACK3;
-      PACKAGE PACK6 RENAMES PACK4;
- 
- BEGIN
-      TEST ("C85011A", "CHECK THAT A PACKAGE CAN BE RENAMED AND THE " &
-                       "NEW NAME CAN APPEAR IN A RENAMING " &
-                       "DECLARATION, AND THAT A 'USE' CLAUSE CAN " &
-                       "REFER TO THE PACKAGE BY EITHER NAME, " &
-                       "INCLUDING RENAMINGS OF GENERIC AND NONGENERIC " &
-                       "PACKAGES INSIDE THEMSELVES");
- 
-      IF PACK1.I /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK1.I");
-      END IF;
- 
-      IF PACK2.J /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK2.J");
-      END IF;
- 
-      IF PACK3.I /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK3.I");
-      END IF;
- 
-      IF PACK4.J /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK4.J");
-      END IF;
- 
-      IF PACK5.I /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK5.I");
-      END IF;
- 
-      IF PACK6.J /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK6.J");
-      END IF;
- 
-      IF PACK1.PACKA.I /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK1.PACKA.I");
-      END IF;
- 
-      IF PACK2.PACKB.J /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF PACK2.PACKB.J");
-      END IF;
- 
-      DECLARE
-           USE PACK1, PACK2;
-      BEGIN
-           IF I /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF I (1)");
-           END IF;
- 
-           IF J /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF J (1)");
-           END IF;
-      END;
- 
-      DECLARE
-           USE PACK3, PACK4;
-      BEGIN
-           IF I /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF I (2)");
-           END IF;
- 
-           IF J /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF J (2)");
-           END IF;
-      END;
- 
-      DECLARE
-           USE PACK5, PACK6;
-      BEGIN
-           IF I /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF I (3)");
-           END IF;
- 
-           IF J /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF J (3)");
-           END IF;
-      END;
- 
-      DECLARE
-           USE PACK1.PACKA, PACK2.PACKB;
-      BEGIN
-           IF I /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF I (4)");
-           END IF;
- 
-           IF J /= IDENT_INT(0) THEN
-                FAILED ("INCORRECT VALUE OF J (4)");
-           END IF;
-      END;
- 
-      RESULT;
- END C85011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85013a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85013a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85013a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- C85013A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT:
- 
- --   A) A SUBPROGRAM OR ENTRY CAN BE RENAMED WITH:
- --        A1) DIFFERENT PARAMETER NAMES;
- --        A2) DIFFERENT DEFAULT VALUES;
- --        A3) DIFFERENT PARAMETERS HAVING DEFAULT VALUES;
- --      AND THAT THE NEW NAMES/DEFAULTS ARE USED WHEN THE NEW NAME
- --      IS USED IN A CALL.
- 
- --   B) FORMAL PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
- --      FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
- 
- -- EG  02/22/84
- 
- WITH REPORT;
- 
- PROCEDURE C85013A IS
- 
-      USE REPORT;
- 
- BEGIN
- 
-      TEST("C85013A","CHECK THAT A SUBPROGRAM CAN BE RENAMED AND " &
-                     "THAT THE NEW NAMES/DEFAULTS ARE USED WITH "  &
-                     "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED" &
-                     " ENTITY");
- 
-      DECLARE
- 
-           TYPE TA IS ARRAY(1 .. 5) OF INTEGER;
- 
-           FUNCTION PROC1 (A : INTEGER := 1;
-                           B : TA := (1 .. 5 => 1)) RETURN INTEGER;
-           FUNCTION PROCA (C : INTEGER := 1;
-                           D : TA := (1 .. 5 => 1)) RETURN INTEGER
-                           RENAMES PROC1;
-           FUNCTION PROCB (B : INTEGER := 1;
-                           A : TA := (1 .. 5 => 1)) RETURN INTEGER
-                           RENAMES PROC1;
-           FUNCTION PROCC (A : INTEGER := 2;
-                           B : TA := (1, 2, 3, 4, 5)) RETURN INTEGER
-                           RENAMES PROC1;
-           FUNCTION PROCD (C : INTEGER := 2;
-                           D : TA := (1, 2, 3, 4, 5))RETURN INTEGER
-                           RENAMES PROC1;
- 
-           FUNCTION PROC1 (A : INTEGER := 1;
-                           B : TA := (1 .. 5 => 1)) RETURN INTEGER IS
-           BEGIN
-                FOR I IN 1 .. 5 LOOP
-                     IF A = B(I) THEN
-                          RETURN I;
-                     END IF;
-                END LOOP;
-                RETURN 0;
-           END PROC1;
- 
-      BEGIN
- 
-           IF PROC1 /= 1 THEN
-                FAILED ("CASE A : PARAMETERS NOT PROPERLY INITIALIZED");
-           END IF;
-           IF PROC1(A => 2) /= 0 THEN
-                FAILED ("CASE A : INCORRECT RESULT");
-           END IF;
-           IF PROCA /= 1 THEN
-                FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
-           END IF;
-           IF PROCA(D => (5, 4, 3, 2, 1)) /= 5 THEN
-                FAILED ("CASE A1 : INCORRECT RESULT");
-           END IF;
-           IF PROCB /= 1 THEN
-                FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
-           END IF;
-           IF PROCB(A => (5, 4, 3, 2, 1), B => 2) /= 4 THEN
-                FAILED ("CASE A1 : INCORRECT RESULT ");
-           END IF;
-           IF PROCC /= 2 THEN
-                FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
-           END IF;
-           IF PROCC(3) /= 3 THEN
-                FAILED ("CASE A2 : INCORRECT RESULT ");
-           END IF;
-           IF PROCD /= 2 THEN
-                FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
-           END IF;
-           IF PROCD(4) /= 4 THEN
-                FAILED ("CASE A2 : INCORRECT RESULT ");
-           END IF;
- 
-      END;
- 
-      DECLARE
- 
-           TYPE TA IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           SUBTYPE STA1 IS TA(1 .. 5);
-           SUBTYPE STA2 IS TA(11 .. 15);
- 
-           PROCEDURE PROC1 (A : STA1;
-                            ID : STRING);
-           PROCEDURE PROC2 (A : STA2;
-                            ID : STRING) RENAMES PROC1;
- 
-           PROCEDURE PROC1 (A : STA1;
-                            ID : STRING) IS
-           BEGIN
-                IF A'FIRST /= IDENT_INT(1) THEN
-                     FAILED ("CASE B : INCORRECT LOWER BOUND " &
-                             "GENERATED BY " & ID);
-                END IF;
-                IF A'LAST /= IDENT_INT(5) THEN
-                     FAILED ("CASE B : INCORRECT UPPER BOUND " &
-                             "GENERATED BY " & ID);
-                END IF;
-           END PROC1;
- 
-      BEGIN
- 
-           PROC1 ((1, 2, 3, 4, 5),"PROC1");
-           PROC2 ((6, 7, 8, 9, 10),"PROC2");
- 
-      END;
- 
-      RESULT;
- 
- END C85013A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85014a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85014a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85014a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C85014A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NUMBER OF FORMAL PARAMETERS IS USED TO DETERMINE
- --     WHICH SUBPROGRAM OR ENTRY IS BEING RENAMED.
- 
- -- HISTORY:
- --     JET 03/24/88  CREATED ORIGINAL TEST.
- --     BCB 04/18/90  CORRECTED ERROR MESSAGE FOR ENTRY2.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85014A IS
- 
-      TASK TYPE T1 IS
-           ENTRY ENTER (I1: IN OUT INTEGER);
-           ENTRY STOP;
-      END T1;
- 
-      TASK TYPE T2 IS
-           ENTRY ENTER (I1, I2: IN OUT INTEGER);
-           ENTRY STOP;
-      END T2;
- 
-      TASK1 : T1;
-      TASK2 : T2;
- 
-      FUNCTION F RETURN T1 IS
-      BEGIN
-           RETURN TASK1;
-      END F;
- 
-      FUNCTION F RETURN T2 IS
-      BEGIN
-           RETURN TASK2;
-      END F;
- 
-      PROCEDURE PROC (I1: IN OUT INTEGER) IS
-      BEGIN
-           I1 := I1 + 1;
-      END PROC;
- 
-      PROCEDURE PROC (I1, I2: IN OUT INTEGER) IS
-      BEGIN
-           I1 := I1 + 2;
-           I2 := I2 + 2;
-      END PROC;
- 
-      TASK BODY T1 IS
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ENTER (I1 : IN OUT INTEGER) DO
-                          I1 := I1 + 1;
-                     END ENTER;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END T1;
- 
-      TASK BODY T2 IS
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ENTER (I1, I2 : IN OUT INTEGER) DO
-                          I1 := I1 + 2;
-                          I2 := I2 + 2;
-                     END ENTER;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END T2;
- 
- BEGIN
-      TEST ("C85014A", "CHECK THAT THE NUMBER OF FORMAL PARAMETERS IS " &
-                       "USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY " &
-                       "IS BEING RENAMED");
- 
-      DECLARE
-           PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC;
-           PROCEDURE PROC2 (J1, J2: IN OUT INTEGER) RENAMES PROC;
- 
-           PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER;
-           PROCEDURE ENTRY2 (J1, J2: IN OUT INTEGER) RENAMES F.ENTER;
- 
-           K1, K2 : INTEGER := 0;
-      BEGIN
-           PROC1(K1);
-           IF K1 /= IDENT_INT(1) THEN
-                FAILED("INCORRECT RETURN VALUE FROM PROC1");
-           END IF;
- 
-           ENTRY1(K2);
-           IF K2 /= IDENT_INT(1) THEN
-                FAILED("INCORRECT RETURN VALUE FROM ENTRY1");
-           END IF;
- 
-           PROC2(K1, K2);
-           IF K1 /= IDENT_INT(3) OR K2 /= IDENT_INT(3) THEN
-                FAILED("INCORRECT RETURN VALUE FROM PROC2");
-           END IF;
- 
-           ENTRY2(K1, K2);
-           IF K1 /= IDENT_INT(5) OR K2 /= IDENT_INT(5) THEN
-                FAILED("INCORRECT RETURN VALUE FROM ENTRY2");
-           END IF;
-      END;
- 
-      TASK1.STOP;
-      TASK2.STOP;
- 
-      RESULT;
- END C85014A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85014b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85014b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85014b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85014b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- C85014B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE BASE TYPE OF THE FORMAL PARAMETER AND THE RESULT
- --     TYPE ARE USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING
- --     RENAMED.
- 
- -- HISTORY:
- --     JET 03/24/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85014B IS
- 
-      TYPE INT IS NEW INTEGER;
-      SUBTYPE SUBINT0 IS INT RANGE 0..INT'LAST;
-      SUBTYPE SUBINT1 IS INT RANGE 1..INT'LAST;
- 
-      TASK TYPE T1 IS
-           ENTRY ENTER (I1: IN OUT INTEGER);
-           ENTRY STOP;
-      END T1;
- 
-      TASK TYPE T2 IS
-           ENTRY ENTER (I1: IN OUT INT);
-           ENTRY STOP;
-      END T2;
- 
-      TASK1 : T1;
-      TASK2 : T2;
- 
-      FUNCTION F RETURN T1 IS
-      BEGIN
-           RETURN TASK1;
-      END F;
- 
-      FUNCTION F RETURN T2 IS
-      BEGIN
-           RETURN TASK2;
-      END F;
- 
-      PROCEDURE PROC (I1: IN OUT INTEGER) IS
-      BEGIN
-           I1 := I1 + 1;
-      END PROC;
- 
-      PROCEDURE PROC (I1: IN OUT INT) IS
-      BEGIN
-           I1 := I1 + 2;
-      END PROC;
- 
-      FUNCTION FUNK (I1: INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN I1 + 1;
-      END FUNK;
- 
-      FUNCTION FUNK (I1: INTEGER) RETURN INT IS
-      BEGIN
-           RETURN INT(I1) + 2;
-      END FUNK;
- 
-      FUNCTION FUNKX (N : NATURAL) RETURN POSITIVE IS
-      BEGIN
-           RETURN N + 1;
-      END FUNKX;
- 
-      FUNCTION FUNKX (N : SUBINT0) RETURN SUBINT1 IS
-      BEGIN
-           RETURN N + 2;
-      END FUNKX;
- 
-      TASK BODY T1 IS
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ENTER (I1 : IN OUT INTEGER) DO
-                          I1 := I1 + 1;
-                     END ENTER;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END T1;
- 
-      TASK BODY T2 IS
-           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
-      BEGIN
-           WHILE ACCEPTING_ENTRIES LOOP
-                SELECT
-                     ACCEPT ENTER (I1 : IN OUT INT) DO
-                          I1 := I1 + 2;
-                     END ENTER;
-                OR
-                     ACCEPT STOP DO
-                          ACCEPTING_ENTRIES := FALSE;
-                     END STOP;
-                END SELECT;
-           END LOOP;
-      END T2;
- 
- BEGIN
-      TEST ("C85014B", "CHECK THAT THE BASE TYPE OF THE FORMAL " &
-                       "PARAMETER AND THE RESULT TYPE ARE USED TO " &
-                       "DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING " &
-                       "RENAMED");
- 
-      DECLARE
-           PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC;
-           PROCEDURE PROC2 (J1: IN OUT INT) RENAMES PROC;
- 
-           FUNCTION FUNK1 (J1: INTEGER) RETURN INTEGER RENAMES FUNK;
-           FUNCTION FUNK2 (J1: INTEGER) RETURN INT RENAMES FUNK;
- 
-           PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER;
-           PROCEDURE ENTRY2 (J1: IN OUT INT) RENAMES F.ENTER;
- 
-           FUNCTION FUNK3 (J1: POSITIVE) RETURN NATURAL RENAMES FUNKX;
-           FUNCTION FUNK4 (J1: SUBINT1) RETURN SUBINT0 RENAMES FUNKX;
- 
-           K1 : INTEGER := 0;
-           K2 : INT := 0;
-      BEGIN
-           PROC1(K1);
-           IF K1 /= IDENT_INT(1) THEN
-                FAILED("INCORRECT RETURN VALUE FROM PROC1");
-           END IF;
- 
-           K1 := FUNK1(K1);
-           IF K1 /= IDENT_INT(2) THEN
-                FAILED("INCORRECT RETURN VALUE FROM FUNK1");
-           END IF;
- 
-           ENTRY1(K1);
-           IF K1 /= IDENT_INT(3) THEN
-                FAILED("INCORRECT RETURN VALUE FROM ENTRY1");
-           END IF;
- 
-           K1 := FUNK3(K1);
-           IF K1 /= IDENT_INT(4) THEN
-                FAILED("INCORRECT RETURN VALUE FROM FUNK3");
-           END IF;
- 
-           PROC2(K2);
-           IF INTEGER(K2) /= IDENT_INT(2) THEN
-                FAILED("INCORRECT RETURN VALUE FROM PROC2");
-           END IF;
- 
-           K2 := FUNK2(INTEGER(K2));
-           IF INTEGER(K2) /= IDENT_INT(4) THEN
-                FAILED("INCORRECT RETURN VALUE FROM FUNK2");
-           END IF;
- 
-           ENTRY2(K2);
-           IF INTEGER(K2) /= IDENT_INT(6) THEN
-                FAILED("INCORRECT RETURN VALUE FROM ENTRY2");
-           END IF;
- 
-           K2 := FUNK4(K2);
-           IF INTEGER(K2) /= IDENT_INT(8) THEN
-                FAILED("INCORRECT RETURN VALUE FROM FUNK4");
-           END IF;
-      END;
- 
-      TASK1.STOP;
-      TASK2.STOP;
- 
-      RESULT;
- END C85014B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85014c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85014c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85014c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85014c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- C85014C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PRESENCE OR ABSENCE OF A RESULT TYPE IS USED TO
- --     DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING RENAMED.
- 
- -- HISTORY:
- --     JET 03/24/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85014C IS
- 
-      I, J : INTEGER;
- 
-      TASK TYPE T IS
-           ENTRY Q (I1 : INTEGER);
-      END T;
- 
-      TASK0 : T;
- 
-      PACKAGE FUNC IS
-           FUNCTION Q (I1 : INTEGER) RETURN INTEGER;
-           FUNCTION FUNC RETURN T;
-      END FUNC;
-      USE FUNC;
- 
-      PROCEDURE PROC (I1: INTEGER) IS
-      BEGIN
-           I := I1;
-      END PROC;
- 
-      FUNCTION PROC (I1: INTEGER) RETURN INTEGER IS
-      BEGIN
-           I := I1 + 1;
-           RETURN 0;
-      END PROC;
- 
-      TASK BODY T IS
-      BEGIN
-           ACCEPT Q (I1 : INTEGER) DO
-                I := I1;
-           END Q;
-      END T;
- 
-      PACKAGE BODY FUNC IS
-           FUNCTION Q (I1 : INTEGER) RETURN INTEGER IS
-           BEGIN
-                I := I1 + 1;
-                RETURN 0;
-           END Q;
- 
-           FUNCTION FUNC RETURN T IS
-           BEGIN
-                RETURN TASK0;
-           END FUNC;
-      END FUNC;
- 
- BEGIN
-      TEST ("C85014C", "CHECK THAT THE PRESENCE OR ABSENCE OF A " &
-                       "RESULT TYPE IS USED TO DETERMINE WHICH " &
-                       "SUBPROGRAM OR ENTRY IS BEING RENAMED");
- 
-      DECLARE
-           PROCEDURE PROC1 (J1: INTEGER) RENAMES PROC;
- 
-           FUNCTION PROC2 (J1: INTEGER) RETURN INTEGER RENAMES PROC;
-      BEGIN
-           PROC1(1);
-           IF I /= IDENT_INT(1) THEN
-                FAILED("INCORRECT VALUE OF I AFTER PROC1");
-           END IF;
- 
-           J := PROC2(1);
-           IF I /= IDENT_INT(2) THEN
-                FAILED("INCORRECT VALUE OF I AFTER PROC2");
-           END IF;
-      END;
- 
-      DECLARE
-           PROCEDURE FUNC1 (J1 : INTEGER) RENAMES FUNC.FUNC.Q;
- 
-           FUNCTION FUNC2 (J1 : INTEGER) RETURN INTEGER RENAMES FUNC.Q;
-      BEGIN
-           FUNC1(1);
-           IF I /= IDENT_INT(1) THEN
-                FAILED("INCORRECT VALUE OF I AFTER FUNC1");
-           END IF;
- 
-           J := FUNC2(1);
-           IF I /= IDENT_INT(2) THEN
-                FAILED("INCORRECT VALUE OF I AFTER FUNC2");
-           END IF;
-      END;
- 
-      RESULT;
- END C85014C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85017a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85017a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85017a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85017a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- C85017A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT RENAMING A PREDEFINED OPERATION WITH AN IDENTIFIER
- --     AND THEN RENAMING THE IDENTIFIER AS AN OPERATOR SYMBOL ALLOWS THE
- --     NEW NAME TO BE USED IN A STATIC EXPRESSION.
- 
- -- HISTORY:
- --     JET 03/24/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C85017A IS
- 
-      FUNCTION PLUS (L,R : INTEGER) RETURN INTEGER RENAMES "+";
-      FUNCTION MINUS (L,R : INTEGER) RETURN INTEGER RENAMES "-";
- 
-      FUNCTION "-" (L,R : INTEGER) RETURN INTEGER RENAMES PLUS;
-      FUNCTION "+" (L,R : INTEGER) RETURN INTEGER RENAMES MINUS;
- 
-      I1 : CONSTANT INTEGER := 10 + 10;
-      I2 : CONSTANT INTEGER := 10 - 10;
- 
-      TYPE INT IS RANGE I1 .. I2;
- BEGIN
-      TEST("C85017A","CHECK THAT RENAMING A PREDEFINED OPERATION WITH " &
-                     "AN IDENTIFIER AND THEN RENAMING THE IDENTIFIER " &
-                     "AS AN OPERATOR SYMBOL ALLOWS THE NEW NAME TO BE " &
-                     "USED IN A STATIC EXPRESSION");
- 
-      IF I1 /= IDENT_INT(0) THEN
-           FAILED ("INCORRECT VALUE OF I1: " & INTEGER'IMAGE(I1));
-      END IF;
- 
-      IF I2 /= IDENT_INT(20) THEN
-           FAILED ("INCORRECT VALUE OF I2: " & INTEGER'IMAGE(I2));
-      END IF;
- 
-      RESULT;
- END C85017A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85018a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85018a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85018a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85018a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- C85018A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ENTRY FAMILY MEMBER CAN BE RENAMED WITH:
- --           1) DIFFERENT PARAMETER NAMES;
- --           2) DIFFERENT DEFAULT VALUES;
- --      AND THAT THE NEW NAMES/DEFAULTS ARE USED WHEN THE NEW NAME
- --      IS USED IN A CALL.
- 
- -- RJW 6/3/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C85018A IS
- 
- BEGIN
- 
-      TEST( "C85018A", "CHECK THAT AN ENTRY FAMILY MEMBER CAN BE " &
-                       "RENAMED AND THAT THE NEW NAMES/DEFAULTS ARE "  &
-                       "THOSE ASSOCIATED WITH THE RENAMED ENTITY" );
- 
-      DECLARE
- 
-           RESULTS : INTEGER;
- 
-           TYPE TA IS ARRAY(1 .. 5) OF INTEGER;
- 
-           TASK T IS 
-                ENTRY ENT1 (BOOLEAN)
-                     (A : INTEGER := 1; B : TA := (1 .. 5 => 1));
-           END T;
- 
-           PROCEDURE ENTA (C : INTEGER := 1; D : TA := (1 .. 5 => 1))
-                           RENAMES T.ENT1 (TRUE);
- 
-           PROCEDURE ENTB (B : INTEGER := 1; A : TA := (1 .. 5 => 1))
-                           RENAMES T.ENT1 (TRUE);
- 
-           PROCEDURE ENTC (A : INTEGER := 2; B : TA := (1, 2, 3, 4, 5))
-                           RENAMES T.ENT1 (TRUE);
- 
-           PROCEDURE ENTD (C : INTEGER := 2; D : TA := (1, 2, 3, 4, 5))
-                           RENAMES T.ENT1 (TRUE);
- 
-           TASK BODY T IS 
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT ENT1 (IDENT_BOOL (TRUE)) 
-                                      (A : INTEGER := 1; 
-                                       B : TA := (1 .. 5 => 1)) DO
-                               IF A IN 1 .. 5 THEN
-                                    RESULTS := B(A);
-                               ELSE
-                                    RESULTS := 0;
-                               END IF;
-                          END;
-                     OR 
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
- 
-      BEGIN
- 
-           T.ENT1 (TRUE);
-           IF RESULTS /= 1 THEN
-                FAILED ( "PARAMETERS NOT PROPERLY INITIALIZED" );
-           END IF;
- 
-           T.ENT1 (TRUE) (A => 6);
-           IF RESULTS /= 0 THEN
-                FAILED ( "INCORRECT RESULTS" );
-           END IF;
- 
-           ENTA;
-           IF RESULTS /= 1 THEN
-                FAILED ( "CASE 1 : INCORRECT RESULTS (DEFAULT)" );
-           END IF;
- 
-           ENTA(D => (5, 4, 3, 2, 1));
-           IF RESULTS /= 5 THEN
-                FAILED ( "CASE 1 : INCORRECT RESULTS" );
-           END IF;
- 
-           ENTB;
-           IF RESULTS /= 1 THEN
-                FAILED ( "CASE 1 : INCORRECT RESULTS (DEFAULT)" );
-           END IF;
- 
-           ENTB(A => (5, 4, 3, 2, 1), B => 2);
-           IF RESULTS /= 4 THEN
-                FAILED ( "CASE 1 : INCORRECT RESULTS " );
-           END IF;
- 
-           ENTC;
-           IF RESULTS /= 2 THEN
-                FAILED ( "CASE 2 : INCORRECT RESULTS (DEFAULT)" );
-           END IF;
- 
-           ENTC(3);
-           IF RESULTS /= 3 THEN
-                FAILED ( "CASE 2 : INCORRECT RESULTS " );
-           END IF;
- 
-           ENTD;
-           IF RESULTS /= 2 THEN
-                FAILED ( "CASE 2 : INCORRECT RESULTS (DEFAULT)" );
-           END IF;
- 
-           ENTD(4);
-           IF RESULTS /= 4 THEN
-                FAILED ( "CASE 2 : INCORRECT RESULTS " );
-           END IF;
- 
-      END;
-      RESULT;
- 
- END C85018A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85018b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85018b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85018b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85018b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,288 ****
- -- C85018B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN AN ENTRY FAMILY MEMBER IS RENAMED THE FORMAL
- --     PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
- --     FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
- 
- -- HISTORY:
- --     RJW 06/03/86 CREATED ORIGINAL TEST.
- --     DHH 10/15/87 CORRECTED RANGE ERRORS.
- --     GJD 11/15/95 REMOVED ADA 95 INCOMPATIBILITY (INDEX CONSTRAINT).
- --     PWN 10/24/96 RESTORED CHECKS WITH ADA 95 RESULTS NOW EXPECTED.
- --     PWN 12/11/96 ADJUSTED VALUES FOR ADA 95 COMPATIBILITY.
- --     PWB.CTA 2/17/97 CHANGED CALL TO ENT2 TO NOT EXPECT EXCEPTION
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C85018B IS
- 
- BEGIN
- 
-      TEST( "C85018B", "CHECK THAT WHEN AN ENTRY FAMILY MEMBER IS " &
-                       "RENAMED THE FORMAL PARAMETER CONSTRAINTS "  &
-                       "FOR THE NEW NAME ARE IGNORED IN FAVOR OF " &
-                       "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED " &
-                       "ENTITY" );
- 
-      DECLARE
-           TYPE INT IS RANGE 1 .. 10;
-           SUBTYPE INT1 IS INT RANGE 1 .. 5;
-           SUBTYPE INT2 IS INT RANGE 6 .. 10;
- 
-           OBJ1 : INT1 := 5;
-           OBJ2 : INT2 := 6;
- 
-           SUBTYPE SHORTCHAR IS CHARACTER RANGE 'A' .. 'C';
- 
-           TASK T IS
-                ENTRY ENT1 (SHORTCHAR)
-                     (A : INT1; OK : BOOLEAN);
-           END T;
- 
-           PROCEDURE ENT2 (A : INT2; OK : BOOLEAN)
-                RENAMES T.ENT1 ('C');
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT ENT1 ('C')
-                                      (A : INT1; OK : BOOLEAN) DO
-                               IF NOT OK THEN
-                                    FAILED ( "WRONG CALL EXECUTED " &
-                                             "WITH INTEGER TYPE" );
-                               END IF;
-                          END;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
-      BEGIN
-           BEGIN
-                ENT2 (OBJ1, TRUE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR  =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
-                              "INTEGER TYPE" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "INTEGER TYPE - 1" );
-           END;
- 
-           BEGIN
-                ENT2 (OBJ2, TRUE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "INTEGER TYPE - 2" );
-           END;
-      END;
- 
-      DECLARE
-           TYPE REAL IS DIGITS 3;
-           SUBTYPE REAL1 IS REAL RANGE -2.0 .. 0.0;
-           SUBTYPE REAL2 IS REAL RANGE  0.0 .. 2.0;
- 
-           OBJ1 : REAL1 := -0.25;
-           OBJ2 : REAL2 :=  0.25;
- 
-           SUBTYPE SHORTINT IS INTEGER RANGE 9 .. 11;
- 
-           TASK T IS
-                ENTRY ENT1 (SHORTINT)
-                     (A : REAL1; OK : BOOLEAN);
-           END T;
- 
-           PROCEDURE ENT2 (A : REAL2; OK : BOOLEAN)
-                RENAMES T.ENT1 (10);
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT ENT1 (10)
-                                      (A : REAL1; OK : BOOLEAN) DO
-                               IF NOT OK THEN
-                                    FAILED ( "WRONG CALL EXECUTED " &
-                                             "WITH FLOATING POINT " &
-                                             "TYPE" );
-                               END IF;
-                          END;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
-      BEGIN
-           BEGIN
-                ENT2 (OBJ1, TRUE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR  =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
-                              "FLOATING POINT " &
-                              "TYPE" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "FLOATING POINT " &
-                              "TYPE - 1" );
-           END;
- 
-           BEGIN
-                ENT2 (OBJ2, FALSE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "FLOATING POINT " &
-                              "TYPE - 2" );
-           END;
-      END;
- 
-      DECLARE
-           TYPE COLOR IS (RED, YELLOW, BLUE, GREEN);
- 
-           TYPE FIXED IS DELTA  0.125 RANGE -1.0 .. 1.0;
-           SUBTYPE FIXED1 IS FIXED RANGE  0.0 .. 0.5;
-           SUBTYPE FIXED2 IS FIXED RANGE -0.5 .. 0.0;
- 
-           OBJ1 : FIXED1 :=  0.125;
-           OBJ2 : FIXED2 := -0.125;
- 
-           TASK T IS
-                ENTRY ENT1 (COLOR)
-                     (A : FIXED1; OK : BOOLEAN);
-           END T;
- 
-           PROCEDURE ENT2 (A : FIXED2; OK : BOOLEAN)
-                RENAMES T.ENT1 (BLUE);
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT ENT1 (BLUE)
-                                      (A : FIXED1; OK : BOOLEAN) DO
-                               IF NOT OK THEN
-                                    FAILED ( "WRONG CALL EXECUTED " &
-                                             "WITH FIXED POINT " &
-                                             "TYPE" );
-                               END IF;
-                          END;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
-      BEGIN
-           BEGIN
-                ENT2 (OBJ1, TRUE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR  =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
-                              "FIXED POINT " &
-                              "TYPE" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "FIXED POINT " &
-                              "TYPE - 1" );
-           END;
- 
-           BEGIN
-                ENT2 (OBJ2, FALSE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "FIXED POINT " &
-                              "TYPE - 2" );
-           END;
-      END;
- 
-      DECLARE
-           TYPE TA IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-           SUBTYPE STA1 IS TA(1 .. 5);
-           SUBTYPE STA2 IS TA(6 .. 10);
- 
-           OBJ1 : STA1 := (1, 2, 3, 4, 5);
-           OBJ2 : STA2 := (6, 7, 8, 9, 10);
- 
-           TASK T IS
-                ENTRY ENT1 (BOOLEAN)
-                     (A : STA1; OK : BOOLEAN);
-           END T;
- 
-           PROCEDURE ENT2 (A : STA2; OK : BOOLEAN)
-                RENAMES T.ENT1 (FALSE);
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT ENT1 (FALSE)
-                                      (A : STA1; OK : BOOLEAN) DO
-                               IF NOT OK THEN
-                                    FAILED ( "WRONG CALL EXECUTED " &
-                                             "WITH CONSTRAINED " &
-                                             "ARRAY" );
-                               END IF;
-                          END;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
-      BEGIN
-           BEGIN
-                ENT2 (OBJ1, TRUE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR  =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
-                              "CONSTRAINED ARRAY" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "CONSTRAINED ARRAY - 1" );
-           END;
- 
-           BEGIN
-                ENT2 (OBJ2, TRUE);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
-                              "CONSTRAINED ARRAY" );
-                WHEN OTHERS =>
-                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
-                              "CONSTRAINED ARRAY - 2" );
-           END;
-      END;
- 
-      RESULT;
- 
- END C85018B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85019a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85019a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c85019a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c85019a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- C85019A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CHARACTER OR OTHER ENUMERATION LITERAL MAY BE RENAMED 
- -- AS A FUNCTION.
- 
- -- RJW 6/4/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C85019A IS
- 
- BEGIN
- 
-      TEST( "C85019A", "CHECK THAT A CHARACTER OR OTHER ENUMERATION " &
-                       "LITERAL MAY BE RENAMED AS A FUNCTION" );
- 
-      DECLARE
-           FUNCTION SEA RETURN CHARACTER RENAMES 'C';
- 
-           TYPE COLOR IS (RED, YELLOW, BLUE, GREEN);
-           
-           FUNCTION TEAL RETURN COLOR RENAMES BLUE;
- 
-      BEGIN
-           IF SEA /= 'C' THEN
-                FAILED ( "SEA IS NOT EQUAL TO 'C'" );
-           END IF;
- 
-           IF TEAL /= BLUE THEN
-                FAILED ( "TEAL IS NOT EQUAL TO BLUE" );
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END C85019A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c854001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c854001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c854001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c854001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,277 ****
- -- C854001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a subprogram declaration can be completed by a
- --      subprogram renaming declaration. In particular, check that such a
- --      renaming-as-body can be given in a package body to complete a
- --      subprogram declared in the package specification. Check that calls
- --      to the subprogram invoke the body of the renamed subprogram.  Check
- --      that a renaming allows a copy of an inherited or predefined subprogram
- --      before overriding it later.  Check that renaming a dispatching 
- --      operation calls the correct body in case of overriding.
- --
- -- TEST DESCRIPTION:
- --      This test declares a record type, an integer type, and a tagged type
- --      with a set of operations in a package. A renaming of a predefined 
- --      equality operation of a tagged type is also defined in this package.
- --      The predefined operation is overridden in the private part. In a 
- --      separate package, a subtype of the record type and integer type 
- --      are declared.  Subset of the full set of operations for the record 
- --      and types is reexported using renamings-as-bodies. Other operations 
- --      are given explicit bodies.  The test verifies that the appropriate 
- --      body is executed for each operation on the subtype.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      07 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --
- --!
- 
- package C854001_0 is
- 
-    type Component is (Op_Of_Type, Op_Of_Subtype, Initial_Value);
- 
-    type Root is record
-       Called : Component := Op_Of_Subtype;
-    end record;
- 
-    procedure Root_Proc (P: in out Root);
-    procedure Over_Proc (P: in out Root);
- 
-    function Root_Func return Root;
-    function Over_Func return Root;
- 
-    type Short_Int is range 1 .. 98;
- 
-    function "+" (P1, P2 : Short_Int) return Short_Int;
-    function Name (P1, P2 : Short_Int) return Short_Int;
- 
-    type Tag_Type is tagged record
-       C : Component := Initial_Value;
-    end record;
-    -- Inherits predefined operator "=" and others.
- 
-    function Predefined_Equal (P1, P2 : Tag_Type) return Boolean
-      renames "=";             
-    -- Renames predefined operator "=" before overriding.
- 
- private
-    function "=" (P1, P2 : Tag_Type) 
-      return Boolean;                   -- Overrides predefined operator "=".
- 
- 
- end C854001_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C854001_0 is
- 
-    procedure Root_Proc (P: in out Root) is
-    begin
-       P.Called := Initial_Value;
-    end Root_Proc;
- 
-    ---------------------------------------
-    procedure Over_Proc (P: in out Root) is
-    begin
-       P.Called := Op_Of_Type;
-    end Over_Proc;
- 
-    ---------------------------------------
-    function Root_Func return Root is
-    begin
-       return (Called => Op_Of_Type);
-    end Root_Func;
-  
-    ---------------------------------------
-    function Over_Func return Root is
-    begin
-       return (Called => Initial_Value);
-    end Over_Func;
- 
-    ---------------------------------------
-    function "+" (P1, P2 : Short_Int) return Short_Int is
-    begin
-       return 15;
-    end "+";
- 
-    ---------------------------------------
-    function Name (P1, P2 : Short_Int) return Short_Int is
-    begin
-       return 47;
-    end Name;
- 
-    ---------------------------------------
-    function "=" (P1, P2 : Tag_Type) return Boolean is
-    begin
-       return False;
-    end "=";
- 
- end C854001_0;
- 
-      --==================================================================--
- 
- 
- with C854001_0;
- package C854001_1 is
- 
-    subtype Root_Subtype is C854001_0.Root;
-    subtype Short_Int_Subtype is C854001_0.Short_Int;
-    
-    procedure Ren_Proc  (P: in out Root_Subtype);       
-    procedure Same_Proc (P: in out Root_Subtype);       
- 
-    function Ren_Func  return Root_Subtype;             
-    function Same_Func return Root_Subtype;             
- 
-    function Other_Name (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype;
-    function "-" (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype;
- 
-    function User_Defined_Equal (P1, P2 : C854001_0.Tag_Type) return Boolean 
-      renames C854001_0."=";                       -- Executes body of the
-                                                   -- overriding declaration in
-                                                   -- the private part.
- end C854001_1;
- 
- 
-      --==================================================================--
- 
- 
- with C854001_0;
- package body C854001_1 is
- 
-    --
-    -- Renaming-as-body for procedure:
-    --
- 
-    procedure Ren_Proc  (P: in out Root_Subtype)  
-      renames C854001_0.Root_Proc;
-    procedure Same_Proc (P: in out Root_Subtype) 
-      renames C854001_0.Over_Proc;
- 
-    --
-    -- Renaming-as-body for function:
-    --
- 
-    function Ren_Func  return Root_Subtype renames C854001_0.Root_Func;
-    function Same_Func return Root_Subtype renames C854001_0.Over_Func;
-  
-    function Other_Name (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype
-      renames C854001_0."+";
-    function "-" (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype 
-      renames C854001_0.Name;
- 
- end C854001_1;
- 
- 
-      --==================================================================--
- 
- with C854001_0;
- with C854001_1;  -- Subtype and associated operations.
- use  C854001_1;
- 
- with Report;
- 
- procedure C854001 is
-    Operand1  : Root_Subtype;
-    Operand2  : Root_Subtype;
-    Operand3  : Root_Subtype;
-    Operand4  : Root_Subtype;
-    Operand5  : Short_Int_Subtype := 55;
-    Operand6  : Short_Int_Subtype := 46;
-    Operand7  : Short_Int_Subtype;
-    Operand8  : C854001_0.Tag_Type;         -- Both Operand8 & Operand9 have
-    Operand9  : C854001_0.Tag_Type;         -- the same default values.
- 
-    -- Direct visibility to operator symbols
-    use type C854001_0.Component;
-    use type C854001_0.Short_Int;
- 
- begin
-    Report.Test ("C854001", "Check that a renaming-as-body can be given " &
-                            "in a package body to complete a subprogram " &
-                            "declared in the package specification. "     &
-                            "Check that calls to the subprogram invoke "  &
-                            "the body of the renamed subprogram");
- 
-    --
-    -- Only operations of the subtype are available.
-    --
- 
-    Ren_Proc  (Operand1);
-    if Operand1.Called /= C854001_0.Initial_Value then
-       Report.Failed ("Error calling procedure Ren_Proc");
-    end if;
- 
-    ---------------------------------------
-    Same_Proc (Operand2);
-    if Operand2.Called /= C854001_0.Op_Of_Type then
-       Report.Failed ("Error calling procedure Same_Proc");
-    end if;
- 
-    ---------------------------------------
-    Operand3 := Ren_Func;
-    if Operand3.Called /= C854001_0.Op_Of_Type then
-       Report.Failed ("Error calling function Ren_Func");
-    end if;
- 
-    ---------------------------------------
-    Operand4 := Same_Func;
-    if Operand4.Called /= C854001_0.Initial_Value then
-       Report.Failed ("Error calling function Same_Func");
-    end if;
-    
-    ---------------------------------------
-    Operand7 := C854001_1."-" (Operand5, Operand6);
-    if Operand7 /= 47 then
-       Report.Failed ("Error calling function & ""-""");
-    end if;
- 
-    ---------------------------------------
-    Operand7 := Other_Name (Operand5, Operand6);
-    if Operand7 /= 15 then
-       Report.Failed ("Error calling function Other_Name");
-    end if;
- 
-    ---------------------------------------
-    -- Executes body of the overriding declaration in the private part
-    -- of C854001_0.
-    if User_Defined_Equal (Operand8, Operand9) then
-       Report.Failed ("Error calling function User_Defined_Equal");
-    end if;
- 
-    ---------------------------------------
-    -- Executes predefined operation.
-    if not C854001_0.Predefined_Equal (Operand8, Operand9) then
-       Report.Failed ("Error calling function Predefined_Equal");
-    end if;
- 
-    Report.Result;
- 
- end C854001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c854002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c854002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c854002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c854002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,185 ****
- -- C854002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check the requirements of the new 8.5.4(8.A) from Technical
- --     Corrigendum 1 (originally discussed as AI95-00064).
- --     This paragraph requires an elaboration check on renamings-as-body:
- --     even if the body of the ultimately-called subprogram has been
- --     elaborated, the check should fail if the renaming-as-body
- --     itself has not yet been elaborated.
- --
- -- TEST DESCRIPTION
- --     We declare two functions F and G, and ensure that they are
- --     elaborated before anything else, by using pragma Pure.  Then we
- --     declare two renamings-as-body: the renaming of F is direct, and
- --     the renaming of G is via an access-to-function object.  We call
- --     the renamings during elaboration, and check that they raise
- --     Program_Error.  We then call them again after elaboration; this
- --     time, they should work.
- --
- -- CHANGE HISTORY:
- --      29 JUN 1999   RAD   Initial Version
- --      23 SEP 1999   RLB   Improved comments, renamed, issued.
- --      28 JUN 2002   RLB   Added pragma Elaborate_All for Report.
- --!
- 
- package C854002_1 is
-     pragma Pure;
-     -- Empty.
- end C854002_1;
- 
- package C854002_1.Pure is
-     pragma Pure;
-     function F return String;
-     function G return String;
- end C854002_1.Pure;
- 
- with C854002_1.Pure;
- package C854002_1.Renamings is
- 
-     F_Result: constant String := C854002_1.Pure.F; -- Make sure we can call F.
-     function Renamed_F return String;
- 
-     G_Result: constant String := C854002_1.Pure.G;
-     type String_Function is access function return String;
-     G_Pointer: String_Function := null;
-         -- Will be set to C854002_1.Pure.G'Access in the body.
-     function Renamed_G return String;
- 
- end C854002_1.Renamings;
- 
- package C854002_1.Caller is
- 
-     -- These procedures call the renamings; when called during elaboration,
-     -- we pass Should_Fail => True, which checks that Program_Error is
-     -- raised.  Later, we use Should_Fail => False.
- 
-     procedure Call_Renamed_F(Should_Fail: Boolean);
-     procedure Call_Renamed_G(Should_Fail: Boolean);
- 
- end C854002_1.Caller;
- 
- with Report; use Report; pragma Elaborate_All (Report);
- with C854002_1.Renamings;
- package body C854002_1.Caller is
- 
-     Some_Error: exception;
- 
-     procedure Call_Renamed_F(Should_Fail: Boolean) is
-     begin
-         if Should_Fail then
-             begin
-                 Failed(C854002_1.Renamings.Renamed_F);
-                 raise Some_Error;
-                     -- This raise statement is necessary, because the
-                     -- Report package has a bug -- if Failed is called
-                     -- before Test, then the failure is ignored, and the
-                     -- test prints "PASSED".
-                     -- Presumably, this raise statement will cause the
-                     -- program to crash, thus avoiding the PASSED message.
-             exception
-                 when Program_Error =>
-                     Comment("Program_Error -- OK");
-             end;
-         else
-             if C854002_1.Renamings.F_Result /= C854002_1.Renamings.Renamed_F then
-                 Failed("Bad result from renamed F");
-             end if;
-         end if;
-     end Call_Renamed_F;
- 
-     procedure Call_Renamed_G(Should_Fail: Boolean) is
-     begin
-         if Should_Fail then
-             begin
-                 Failed(C854002_1.Renamings.Renamed_G);
-                 raise Some_Error;
-             exception
-                 when Program_Error =>
-                     Comment("Program_Error -- OK");
-             end;
-         else
-             if C854002_1.Renamings.G_Result /= C854002_1.Renamings.Renamed_G then
-                 Failed("Bad result from renamed G");
-             end if;
-         end if;
-     end Call_Renamed_G;
- 
- begin
-     -- At this point, the bodies of Renamed_F and Renamed_G have not yet
-     -- been elaborated, so calling them should raise Program_Error:
-     Call_Renamed_F(Should_Fail => True);
-     Call_Renamed_G(Should_Fail => True);
- end C854002_1.Caller;
- 
- package body C854002_1.Pure is
- 
-     function F return String is
-     begin
-         return "This is function F";
-     end F;
- 
-     function G return String is
-     begin
-         return "This is function G";
-     end G;
- 
- end C854002_1.Pure;
- 
- with C854002_1.Pure;
- with C854002_1.Caller; pragma Elaborate(C854002_1.Caller);
-     -- This pragma ensures that this package body (Renamings)
-     -- will be elaborated after Caller, so that when Caller calls
-     -- the renamings during its elaboration, the renamings will
-     -- not have been elaborated (although what the rename have been).
- package body C854002_1.Renamings is
- 
-     function Renamed_F return String renames C854002_1.Pure.F;
- 
-     package Dummy is end; -- So we can insert statements here.
-     package body Dummy is
-     begin
-         G_Pointer := C854002_1.Pure.G'Access;
-     end Dummy;
- 
-     function Renamed_G return String renames G_Pointer.all;
- 
- end C854002_1.Renamings;
- 
- with Report; use Report;
- with C854002_1.Caller;
- procedure C854002 is
- begin
-     Test("C854002",
-          "An elaboration check is performed for a call to a subprogram"
-          & " whose body is given as a renaming-as-body");
- 
-     -- By the time we get here, all library units have been elaborated,
-     -- so the following calls should not raise Program_Error:
-     C854002_1.Caller.Call_Renamed_F(Should_Fail => False);
-     C854002_1.Caller.Call_Renamed_G(Should_Fail => False);
- 
-     Result;
- end C854002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c854003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c854003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c854003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c854003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C854003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that a renaming-as-body used before the subprogram is frozen only
- --    requires mode conformance.  (Defect Report 8652/0028, as reflected in
- --    Technical Corrigendum 1, RM95 8.5.4(5/1)).
- --
- -- CHANGE HISTORY:
- --    29 JAN 2001   PHL   Initial version.
- --     5 DEC 2001   RLB   Reformatted for ACATS.
- --
- --!
- with Report;
- use Report;
- procedure C854003 is
- 
-     package P is
-         type T is private;
-         C1 : constant T;
-         C2 : constant T;
-     private
-         type T is new Integer'Base;
-         C1 : constant T := T (Ident_Int (1));
-         C2 : constant T := T (Ident_Int (1));
-     end P;
- 
-     function Equals (X, Y : P.T) return Boolean;
-     function Equals (X, Y : P.T) return Boolean renames P."=";
- 
- begin
-     Test ("C854003",
-           "Check that a renaming-as-body used before the subprogram " &
-              "is frozen only requires mode conformance");
- 
-     if not Equals (P.C1, P.C2) then
-         Failed ("Equality returned an unexpected result");
-     end if;
- 
-     Result;
- end C854003;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- C86003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT  'STANDARD'  IS NOT TREATED AS A RESERVED WORD IN
- --    SELECTED COMPONENT NAMES.
- 
- -- RM  01/21/80
- -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
- 
- WITH REPORT ;
- PROCEDURE  C86003A  IS
- 
-      USE REPORT ;
- 
- BEGIN
- 
-      TEST("C86003A" , "CHECK THAT  'STANDARD'  IS NOT TREATED AS A" &
-                       " RESERVED WORD IN SELECTED COMPONENT NAMES" );
- 
-      DECLARE    -- A
-      BEGIN
- 
-           DECLARE
- 
-                PACKAGE  STANDARD  IS
-                     CHARACTER      :  BOOLEAN ;
-                     TYPE  INTEGER  IS (FALSE, TRUE) ;
-                     CONSTRAINT_ERROR :  EXCEPTION ;
-                END  STANDARD ;
- 
-                TYPE  REC2  IS
-                     RECORD
-                          AA , BB  :  BOOLEAN  := FALSE ;
-                     END RECORD;
- 
-                TYPE  REC1  IS
-                     RECORD
-                          STANDARD : REC2 ;
-                     END RECORD;
- 
-                A    :  REC1 ;
-                TYPE  ASI  IS  ACCESS STANDARD.INTEGER ;
-                VASI  :  ASI ;
-                VI : INTEGER RANGE 1 .. 10;   -- THE "REAL" STANDARD
-                                              -- TYPE 'INTEGER'
- 
-           BEGIN
- 
-                VASI  :=  NEW STANDARD.INTEGER'(STANDARD.FALSE);
-                STANDARD.CHARACTER  :=  A.STANDARD.BB ;
- 
-                IF  STANDARD.CHARACTER  THEN FAILED( "RES. (VAR.)" );
-                END IF;
- 
-                VI  :=  IDENT_INT(11);   -- TO CAUSE THE "REAL"
-                                         -- (PREDEFINED) CONSTRAINT_ERROR
-                                         -- EXCEPTION.
-                IF VI /= IDENT_INT(11) THEN
-                    FAILED ("WRONG VALUE - V1");
-                ELSE
-                    FAILED ("OUT OF RANGE VALUE - V1");
-                END IF;
-           EXCEPTION
- 
-                WHEN STANDARD.CONSTRAINT_ERROR => FAILED ("RES. (EXC.)");
- 
-                WHEN CONSTRAINT_ERROR => NULL;
- 
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED - A");
- 
-           END ;
- 
-      EXCEPTION
- 
-           WHEN  OTHERS  =>  FAILED( "EXCEPTION RAISED BY DECL. (A)" );
- 
-      END ;    -- A
- 
- 
-      DECLARE    -- B
- 
-           TYPE  REC  IS
-                RECORD
-                     INTEGER  :  BOOLEAN  := FALSE ;
-                END RECORD;
- 
-           STANDARD :  REC ;
- 
-      BEGIN
- 
-           IF  STANDARD.INTEGER  THEN  FAILED( "RESERVED  -  REC.,INT.");
-           END IF;
- 
-      END ;    -- B
- 
- 
-      RESULT ;
- 
- 
- END C86003A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C86004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A LIBRARY SUBPROGRAM DECLARATION IS PRECEDED BY A
- --     "WITH" CLAUSE FOR A GENERIC LIBRARY PROCEDURE M, THEN IN THE
- --     BODY OF THE SUBPROGRAM, "STANDARD.M" IS A LEGAL NAME
- --     FOR THE GENERIC PROCEDURE.
- 
- -- HISTORY:
- --     DHH 03/14/88 CREATED ORIGINAL TEST.
- 
- -- BEGIN BUILDING LIBRARY PROCEDURES
- 
- GENERIC
-      TYPE ITEM IS (<>);
- PROCEDURE C86004A_SWAP(X,Y: IN OUT ITEM);
- 
- PROCEDURE C86004A_SWAP(X,Y: IN OUT ITEM) IS
-      T : ITEM;
- BEGIN
-      T := X;
-      X := Y;
-      Y := T;
- END C86004A_SWAP;
- 
- WITH C86004A_SWAP; WITH REPORT; USE REPORT;
- PROCEDURE C86004A1 IS
-      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
-      A : INT := IDENT_INT(10);
-      B : INT := IDENT_INT(0);
-      PROCEDURE SWITCH IS NEW STANDARD.C86004A_SWAP(INT);
- BEGIN
-      SWITCH(A,B);
- 
-      IF A /= IDENT_INT(0) THEN
-           FAILED("STANDARD.GENERIC PROCEDURE - 1");
-      END IF;
- 
-      IF B /= IDENT_INT(10) THEN
-           FAILED("STANDARD.GENERIC PROCEDURE - 2");
-      END IF;
- END C86004A1;
- 
- WITH C86004A_SWAP; WITH REPORT; USE REPORT;
- PROCEDURE C86004A2;
- 
- PROCEDURE C86004A2 IS
-      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
-      A : INT := IDENT_INT(10);
-      B : INT := IDENT_INT(0);
- BEGIN
-      DECLARE
-           PROCEDURE SWITCH IS NEW STANDARD.C86004A_SWAP(INT);
-      BEGIN
-           SWITCH(A,B);
-      END;
-      IF A /= IDENT_INT(0) THEN
-           FAILED("STANDARD.GENERIC PROCEDURE - B-0");
-      END IF;
-      IF B /= IDENT_INT(10) THEN
-           FAILED("STANDARD.GENERIC PROCEDURE - B-10");
-      END IF;
- END C86004A2;
- 
- WITH C86004A1; WITH C86004A2;
- WITH REPORT; USE REPORT;
- PROCEDURE C86004A IS
- BEGIN
-      TEST("C86004A", "CHECK THAT IF A LIBRARY SUBPROGRAM DECLARATION " &
-                      "IS PRECEDED BY A ""WITH"" CLAUSE FOR A GENERIC " &
-                      "LIBRARY PROCEDURE M, THEN IN THE BODY OF THE " &
-                      "SUBPROGRAM, ""STANDARD.M"" IS A " &
-                      "LEGAL NAME FOR THE GENERIC PROCEDURE");
-      C86004A1;
-      C86004A2;
- 
-      RESULT;
- END C86004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004b0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004b0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004b0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,44 ****
- -- C86004B0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     INDEPENDENT FUNCTION AND SUBPROGRAM SPECIFICATION FOR C86004B
- --     TEST.
- 
- -- HISTORY:
- --     DHH 08/15/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- FUNCTION C86004B0(X : INTEGER) RETURN INTEGER IS
- BEGIN
-      IF EQUAL(3,3) THEN
-           RETURN X;
-      ELSE
-           RETURN 0;
-      END IF;
- END C86004B0;
- 
- WITH C86004B0;
- WITH REPORT; USE REPORT;                          -- SPEC
- PROCEDURE C86004B1(INTGR : INTEGER := STANDARD.C86004B0(4));
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004b1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004b1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004b1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- C86004B1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     LIBRARY SUBPROGRAM BODY FOR C86004B TEST.
- 
- -- HISTORY:
- --     DHH 08/15/88 CREATED ORIGINAL TEST.
- 
- PROCEDURE C86004B1(INTGR : INTEGER := STANDARD.C86004B0(4)) IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
-      A : INT := STANDARD.C86004B0(10);
-      B : INT := STANDARD.C86004B0(INTGR);
- 
- BEGIN
-      TEST("C86004B", "CHECK THAT IF THE SPECIFICATION OF A LIBRARY " &
-                      "SUBPROGRAM HAS A ""WITH"" CLAUSE FOR A LIBRARY " &
-                      "SUBPROGRAM M, THEN IN THE FORMAL PART AND IN " &
-                      "THE BODY (IN ANOTHER FILE), ""STANDARD.M"" IS " &
-                       "A LEGAL NAME FOR THE SUBPROGRAM M");
- 
-      IF B /= STANDARD.C86004B0(0) THEN
-           FAILED("STANDARD.SUBPROGRAM - B");
-      END IF;
- 
-      IF A /= STANDARD.C86004B0(10) THEN
-           FAILED("STANDARD.SUBPROGRAM - A");
-      END IF;
- 
-      RESULT;
- END C86004B1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004b2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004b2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004b2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,46 ****
- -- C86004B2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF THE SPECIFICATION OF A LIBRARY SUBPROGRAM HAS A
- --     "WITH" CLAUSE FOR A LIBRARY SUBPROGRAM M, THEN IN THE FORMAL PART
- --     AND IN THE BODY (IN ANOTHER FILE), "STANDARD.M" IS A LEGAL NAME
- --     FOR THE SUBPROGRAM M.
- 
- -- SEPARATE FILES ARE:
- --     C86004B0  A LIBRARY FUNCTION AND A LIBRARY SUBPROGRAM
- --               SPECIFICATION.
- --     C86004B1  A LIBRARY SUBPROGRAM BODY FOR THE C86004B0
- --               SPECIFICATION.
- --     C86004B2M MAIN PROCEDURE USING THE SUBPROGRAM OF C86004B1.
- 
- -- HISTORY:
- --     DHH 08/15/88 CREATED ORIGINAL TEST.
- 
- WITH C86004B1;
- WITH REPORT; USE REPORT;
- PROCEDURE C86004B2M IS
- BEGIN
-      C86004B1(IDENT_INT(0));
- END C86004B2M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004c0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- C86004C0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     INDEPENDENT GENERIC FUNCTION AND SUBPROGRAM FOR C86004C TEST.
- 
- -- HISTORY:
- --     DHH 09/14/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- GENERIC
- FUNCTION C86004C0_GEN(X : INTEGER) RETURN INTEGER;
- 
- FUNCTION C86004C0_GEN(X : INTEGER) RETURN INTEGER IS
- BEGIN
-      IF EQUAL(3,3) THEN
-           RETURN X;
-      ELSE
-           RETURN 0;
-      END IF;
- END C86004C0_GEN;
- 
- WITH C86004C0_GEN;
- PRAGMA ELABORATE(C86004C0_GEN);
- FUNCTION C86004C0 IS NEW C86004C0_GEN;
- 
- WITH C86004C0;
- WITH REPORT; USE REPORT;
- PROCEDURE C86004C01(INTGR : INTEGER := STANDARD.C86004C0(4)) IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
-      A : INT := STANDARD.C86004C0(10);
-      B : INT := STANDARD.C86004C0(INTGR);
- 
-      PROCEDURE C86004C1 IS SEPARATE;
- 
- BEGIN
-      C86004C1;
- END;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004c1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- C86004C1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     SUBUNIT FOR THE C86004C01 PARENT.
- 
- -- HISTORY:
- --     DHH 09/14/88 CREATED ORIGINAL TEST.
- 
- SEPARATE (C86004C01)
- PROCEDURE C86004C1 IS
- BEGIN
-      TEST("C86004C", "CHECK THAT IF THE SPECIFICATION OF A " &
-                      "SUBPROGRAM HAS A ""WITH"" CLAUSE FOR A GENERIC " &
-                      "SUBPROGRAM INSTANTIANTION M, THEN IN THE " &
-                      "FORMAL PART AND IN THE BODY (A SUBUNIT IN " &
-                      "ANOTHER FILE), ""STANDARD.M"" IS " &
-                      "A LEGAL NAME FOR THE SUBPROGRAM M");
- 
-      IF B /= STANDARD.C86004C0(0) THEN
-           FAILED("STANDARD.SUBPROGRAM - B");
-      END IF;
- 
-      IF A /= STANDARD.C86004C0(10) THEN
-           FAILED("STANDARD.SUBPROGRAM - A");
-      END IF;
- 
-      RESULT;
- END C86004C1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004c2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86004c2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86004c2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,45 ****
- -- C86004C2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF THE SPECIFICATION OF A LIBRARY SUBPROGRAM HAS A
- --     "WITH" CLAUSE FOR A GENERIC SUBPROGRAM INSTANTIATION M, THEN IN
- --     THE FORMAL PART AND IN THE BODY (A SUBUNIT IN ANOTHER FILE),
- --     "STANDARD.M" IS A LEGAL NAME FOR THE SUBPROGRAM M.
- 
- -- SEPARATE FILES ARE:
- --     C86004C0  A GENERIC LIBRARY FUNCTION AND A LIBRARY SUBPROGRAM
- --               DECLARING A SEPARATE SUBUNIT.
- --     C86004C1  A SUBUNIT FOR THE C86004C0 PARENT.
- --     C86004C2M MAIN PROCEDURE USING THE SUBPROGRAM OF C86004C0.
- 
- -- HISTORY:
- --     DHH 09/14/88 CREATED ORIGINAL TEST.
- 
- WITH C86004C01;
- WITH REPORT; USE REPORT;
- PROCEDURE C86004C2M IS
- BEGIN
-      C86004C01(IDENT_INT(0));
- END C86004C2M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86006i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86006i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86006i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86006i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C86006I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE IDENTIFIERS "BOOLEAN, TRUE, AND FALSE" AND THE 
- --     IDENTIFIERS "INTEGER, NATURAL, AND POSITIVE" ARE DECLARED IN 
- --     THE PACKAGE "STANDARD", ALONG WITH THE OPERATORS OF THE TYPE 
- --     BOOLEAN AND THE TYPE INTEGER.                                          
- 
- -- HISTORY:
- --     DTN 04/15/92 CONSOLIDATION OF C86006A AND C86006B.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C86006I IS
-      
-      ABOOL, BBOOL : STANDARD.BOOLEAN := STANDARD.FALSE;
-      CBOOL : STANDARD.BOOLEAN := STANDARD.TRUE;
-      INT1 : STANDARD.INTEGER := -2;
-      NAT1 : STANDARD.NATURAL := 0;
-      POS1, POS2 : STANDARD.POSITIVE := 2;
- 
- BEGIN
- 
-      TEST("C86006I", "CHECK THAT THE IDENTIFIERS ""BOOLEAN, TRUE, AND " &
-                      "FALSE"" AND THE IDENTIFIERS ""INTEGER, NATURAL, " &
-                      "AND POSITIVE"" ARE DECLARED IN THE PACKAGE " &
-                      """STANDARD"", ALONG WITH THE OPERATORS OF THE " &
-                      "TYPE BOOLEAN AND THE TYPE INTEGER");
- 
-      -- STANDARD.">" OPERATOR.
- 
-      IF STANDARD.">"(ABOOL,BBOOL) THEN
-           FAILED("STANDARD.> FAILED FOR BOOLEAN TYPE");
-      END IF;
- 
-      IF STANDARD.">"(INT1,NAT1) THEN
-           FAILED("STANDARD.> FAILED FOR INTEGER-NATURAL TYPE");
-      END IF;
- 
-      -- STANDARD."/=" OPERATOR.
- 
-      IF STANDARD."/="(ABOOL,BBOOL) THEN
-           FAILED("STANDARD./= FAILED FOR BOOLEAN TYPE");
-      END IF;
- 
-      IF STANDARD."/="(POS1,POS2) THEN
-           FAILED("STANDARD./= FAILED FOR INTEGER-POSITIVE TYPE");
-      END IF;
- 
-      -- STANDARD."AND" OPERATOR.
- 
-      IF STANDARD."AND"(CBOOL,ABOOL) THEN
-           FAILED("STANDARD.AND FAILED");
-      END IF;
- 
-      -- STANDARD."-" BINARY OPERATOR.
- 
-      IF STANDARD."-"(INT1,POS1) /= IDENT_INT(-4) THEN
-           FAILED("STANDARD.- FAILED");
-      END IF;
- 
-      -- STANDARD."-" UNARY OPERATOR.
- 
-      IF STANDARD."-"(INT1) /= IDENT_INT(2) THEN
-           FAILED("STANDARD.UNARY - FAILED");
-      END IF;
- 
-      -- STANDARD."REM" OPERATOR.
- 
-      IF STANDARD."REM"(IDENT_INT(14),IDENT_INT(5)) /= IDENT_INT(4) THEN
-           FAILED("STANDARD.REM (++=+) FAILED");
-      END IF;
- 
-      -- STANDARD."MOD" OPERATOR.
- 
-      IF STANDARD."MOD"(IDENT_INT(14),IDENT_INT(-5)) /= IDENT_INT(-1) THEN
-           FAILED("STANDARD.MOD (+-=-) FAILED");
-      END IF;
- 
-      RESULT;
- 
- END C86006I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c86007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c86007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C86007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXPANDED NAME FOR AN ENTITY DECLARED IN THE VISIBLE
- --     PART OF A LIBRARY PACKAGE CAN START WITH THE NAME "STANDARD".
- 
- -- HISTORY:
- --     DHH 03/15/88 CREATED ORIGINAL TEST.
- --     RJW 10/26/89 ADDED "PRAGMA ELABORATE (REPORT);"
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE C86007A_PACK IS
-      SUBTYPE ITEM IS INTEGER RANGE 0 .. 10;
-      Y : STANDARD.C86007A_PACK.ITEM := IDENT_INT(5);
-      TYPE ACC IS ACCESS STANDARD.C86007A_PACK.ITEM;
-      PROCEDURE SWAP(X,Y: IN OUT ITEM);
-      PROCEDURE PROC;
- END C86007A_PACK;
- 
- PACKAGE BODY C86007A_PACK IS
-      PROCEDURE SWAP(X,Y: IN OUT STANDARD.C86007A_PACK.ITEM) IS
-           T : STANDARD.C86007A_PACK.ITEM;
-      BEGIN
-           T := X;
-           X := Y;
-           Y := T;
-      END SWAP;
- 
-      PROCEDURE PROC IS
-           X : STANDARD.C86007A_PACK.ITEM := IDENT_INT(10);
-           W : STANDARD.C86007A_PACK.ACC;
-      BEGIN
- 
-           W := NEW STANDARD.C86007A_PACK.ITEM;
-           W.ALL := X;
-           STANDARD.C86007A_PACK.SWAP(X, STANDARD.C86007A_PACK.Y);
-           IF STANDARD.C86007A_PACK.Y /= IDENT_INT(10) THEN
-                FAILED("FAILED STANDARD.NAME CALL PROCEDURE - B-10");
-           END IF;
-           IF X /= IDENT_INT(5) THEN
-                FAILED("FAILED STANDARD.NAME CALL PROCEDURE - B-5");
-           END IF;
-      END PROC;
- END C86007A_PACK;
- 
- WITH C86007A_PACK; WITH REPORT; USE REPORT;
- PROCEDURE C86007A IS
- BEGIN
-      TEST("C86007A", "CHECK THAT AN EXPANDED NAME FOR AN ENTITY " &
-                      "DECLARED IN THE VISIBLE PART OF A LIBRARY " &
-                      "PACKAGE CAN START WITH THE NAME ""STANDARD""");
- 
-      STANDARD.C86007A_PACK.PROC;
- 
-      RESULT;
- END C86007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87a05a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87a05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87a05a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87a05a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C87A05A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FUNCTION CALLS AND INDEXED COMPONENT EXPRESSIONS CAN BE 
- -- DISTINGUISHED BY THE RULES OF OVERLOADING RESOLUTION.
- --
- -- PART 1 : CORRECT RESOLUTION IS INDEXED COMPONENT EXPRESSION
-   
- -- TRH  13 JULY 82
- -- DSJ  09 JUNE 83
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87A05A IS
-      
-      OK : BOOLEAN := TRUE;
-      TYPE VECTOR IS ARRAY (1 .. 5) OF BOOLEAN;
-   
-      PROCEDURE P (ARG : BOOLEAN) IS          -- THIS IS CORRECT P
-      BEGIN 
-           OK := ARG;
-      END P;
-   
-      PROCEDURE P (ARG : CHARACTER) IS
-      BEGIN 
-           OK := FALSE;
-      END P;
- 
-      FUNCTION Y RETURN VECTOR IS             -- THIS IS CORRECT Y
-      BEGIN
-           RETURN (VECTOR'RANGE => TRUE);
-      END Y;
- 
-      FUNCTION Y (ARG : INTEGER) RETURN FLOAT IS
-      BEGIN 
-           OK := FALSE;
-           RETURN 0.0;
-      END Y;
-        
-      FUNCTION Y (ARG : CHARACTER) RETURN CHARACTER IS
-      BEGIN 
-           OK := FALSE;
-           RETURN 'A';
-      END Y;
-    
-      FUNCTION Y (ARG : FLOAT) RETURN FLOAT IS
-      BEGIN 
-           OK := FALSE;
-           RETURN 0.0;
-      END Y;
-        
-      FUNCTION Y RETURN BOOLEAN IS
-      BEGIN 
-           OK := FALSE;
-           RETURN FALSE;
-      END Y;
-        
-      FUNCTION Y (ARG : CHARACTER := 'A') RETURN BOOLEAN IS
-      BEGIN 
-           OK := FALSE;
-           RETURN FALSE;
-      END Y;
-     
-      FUNCTION Z RETURN INTEGER IS            -- THIS IS CORRECT Z
-      BEGIN 
-           RETURN 3;
-      END Z;
-        
-      FUNCTION Z RETURN FLOAT IS
-      BEGIN 
-           OK := FALSE;
-           RETURN 3.0;
-      END Z;
-    
- BEGIN
-      TEST ("C87A05A","OVERLOADING RESOLUTION FOR DISTINGUISHING " &
-            "FUNCTION CALLS FROM INDEXED COMPONENTS WHERE INDEXED " &
-            "COMPONENTS ARE CORRECT");
-   
-      P (Y (Z) );
-   
-      IF NOT OK THEN 
-           FAILED ("RESOLUTION INCORRECT");
-      END IF;
-     
-      RESULT;
- END C87A05A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87a05b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87a05b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87a05b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87a05b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- C87A05B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FUNCTION CALLS AND INDEXED COMPONENT EXPRESSIONS CAN BE 
- -- DISTINGUISHED BY THE RULES OF OVERLOADING RESOLUTION.
- --
- -- PART 2 : CORRECT RESOLUTION IS FUNCTION CALL
-   
- -- TRH  15 JULY 82
- -- DSJ  09 JUNE 83
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87A05B IS
-      
-      OK : BOOLEAN := TRUE;
-      TYPE VECTOR IS ARRAY (1 .. 5) OF BOOLEAN;
-   
-      PROCEDURE P (ARG : CHARACTER := 'A') IS
-      BEGIN 
-           OK := FALSE;
-      END P;
-      
-      PROCEDURE P IS
-      BEGIN 
-           OK := FALSE;
-      END P;
-   
-      PROCEDURE P (ARG : INTEGER) IS               -- THIS IS CORRECT P
-      BEGIN 
-           OK := (ARG = 1);
-      END P;
- 
-      FUNCTION Y RETURN VECTOR IS
-      BEGIN
-           OK := FALSE;
-           RETURN (VECTOR'RANGE => TRUE);
-      END Y;
-      
-      FUNCTION Y RETURN CHARACTER IS
-      BEGIN
-           OK := FALSE;
-           RETURN 'A';
-      END Y;
-        
-      FUNCTION Y (ARG : FLOAT) RETURN FLOAT IS
-      BEGIN 
-           OK := FALSE;
-           RETURN 0.0;
-      END Y;
-    
-      FUNCTION Y (ARG : CHARACTER) RETURN INTEGER IS
-      BEGIN 
-           OK := FALSE;
-           RETURN 0;
-      END Y;
-     
-      FUNCTION Y (ARG : FLOAT) RETURN INTEGER IS   -- THIS IS CORRECT Y
-      BEGIN 
-           RETURN 1;
-      END Y;
-        
-      FUNCTION Z RETURN INTEGER IS
-      BEGIN 
-           OK := FALSE;
-           RETURN 3;
-      END Z;
-        
-      FUNCTION Z RETURN FLOAT IS                   -- THIS IS CORRECT Z
-      BEGIN 
-           RETURN 3.0;
-      END Z;
-    
- BEGIN
-      TEST ("C87A05B","OVERLOADING RESOLUTION FOR DISTINGUISHING " &
-            "FUNCTION CALLS FROM INDEXED COMPONENTS WHERE CORRECT " &
-            "RESOLUTION IS FUNCTION CALL");
-   
-      P (Y (Z) );
-   
-      IF NOT OK THEN 
-           FAILED ("RESOLUTION INCORRECT");
-      END IF;
-     
-      RESULT;
- END C87A05B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b02a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b02a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b02a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C87B02A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A CONSTANT DECLARATION, THE TYPE OF THE INITIALIZATION
- -- EXPRESSION MUST MATCH THE CONSTANT'S EXPLICIT TYPEMARK.
- --      
- -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
- -- 
- --    (A): A CALL TO AN OVERLOADED FUNCTION.
- --    (B): AN OVERLOADED OPERATOR SYMBOL.
- --    (C): AN OVERLOADED (INFIX) OPERATOR.
- --    (D): AN OVERLOADED ENUMERATION LITERAL.
-   
- -- TRH  17 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B02A IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-      
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END F1;
-     
-      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B02A","OVERLOADED INITIALIZATION EXPRESSIONS" &
-           " IN CONSTANT DECLARATIONS");
-      DECLARE
- 
-           FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES F1;
-     
-           FUNCTION "*" (X, Y : WHOLE)   RETURN WHOLE
-                RENAMES F1;
-      
-           FUNCTION "*" (X, Y : INTEGER) RETURN HUE
-                RENAMES F1;
-    
-           FUNCTION "*" (X, Y : INTEGER) RETURN CITRUS
-                RENAMES F1;
-       
-           I1 : CONSTANT INTEGER := F1 (0, 0);
-           W1 : CONSTANT WHOLE   := F1 (0, 0);
-           C1 : CONSTANT CITRUS  := F1 (0, 0);
-           H1 : CONSTANT HUE     := F1 (0, 0);
-    
-           I2 : CONSTANT INTEGER := "*" (0, 0);
-           W2 : CONSTANT WHOLE   := "*" (0, 0);
-           C2 : CONSTANT CITRUS  := "*" (0, 0);
-           H2 : CONSTANT HUE     := "*" (0, 0);
-       
-           I3 : CONSTANT INTEGER := (0 * 0);
-           W3 : CONSTANT WHOLE   := (0 * 0);
-           C3 : CONSTANT CITRUS  := (0 * 0);
-           H3 : CONSTANT HUE     := (0 * 0);
-       
-           C4 : CONSTANT CITRUS  := ORANGE;
-           H4 : CONSTANT HUE     := ORANGE;
- 
-      BEGIN
-           IF I1              /= -1 OR W1           /= 0 OR
-              CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
-              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
-           END IF;
-     
-           IF I2              /= -1 OR W2           /= 0 OR
-              CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
-              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
-           END IF;
-     
-           IF I3              /= -1 OR W3           /= 0 OR
-              CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
-              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
-           END IF;
-     
-           IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
-              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B02A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b02b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b02b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b02b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C87B02B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A VARIABLE DECLARATION, THE TYPE OF THE INITIALIZATION
- -- EXPRESSION MUST MATCH THE VARIABLE'S EXPLICIT TYPEMARK.
- --      
- -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
- -- 
- --    (A): A CALL TO AN OVERLOADED FUNCTION.
- --    (B): AN OVERLOADED OPERATOR SYMBOL.
- --    (C): AN OVERLOADED (INFIX) OPERATOR.
- --    (D): AN OVERLOADED ENUMERATION LITERAL.
-   
- -- TRH  17 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B02B IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-      
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END F1;
-     
-      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B02B","OVERLOADED INITIALIZATION EXPRESSIONS" &
-            " IN VARIABLE DECLARATIONS");
-      DECLARE
- 
-           FUNCTION "REM" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES F1;
-     
-           FUNCTION "REM" (X, Y : WHOLE)   RETURN WHOLE
-                RENAMES F1;
-      
-           FUNCTION "REM" (X, Y : INTEGER) RETURN HUE
-                RENAMES F1;
-    
-           FUNCTION "REM" (X, Y : INTEGER) RETURN CITRUS
-                RENAMES F1;
-       
-           I1 : INTEGER := F1 (0, 0);
-           W1 : WHOLE   := F1 (0, 0);
-           C1 : CITRUS  := F1 (0, 0);
-           H1 : HUE     := F1 (0, 0);
-    
-           I2 : INTEGER := "REM" (0, 0);
-           W2 : WHOLE   := "REM" (0, 0);
-           C2 : CITRUS  := "REM" (0, 0);
-           H2 : HUE     := "REM" (0, 0);
-       
-           I3 : INTEGER := (0 REM 0);
-           W3 : WHOLE   := (0 REM 0);
-           C3 : CITRUS  := (0 REM 0);
-           H3 : HUE     := (0 REM 0);
-       
-           C4 : CITRUS  := ORANGE;
-           H4 : HUE     := ORANGE;
- 
-      BEGIN
-           IF I1              /= -1 OR W1           /= 0 OR
-              CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
-              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
-           END IF;
-     
-           IF I2              /= -1 OR W2           /= 0 OR
-              CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
-              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
-           END IF;
-     
-           IF I3              /= -1 OR W3           /= 0 OR
-              CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
-              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
-           END IF;
-     
-           IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
-              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B02B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b03a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b03a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b03a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- C87B03A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE EXPRESSION IN A NUMBER DECLARATION MUST BE EITHER OF THE TYPE
- -- UNIVERSAL_INTEGER OR UNIVERSAL_REAL.
-    
- -- TRH  16 JUNE 82
-      
- WITH REPORT; USE REPORT;
-     
- PROCEDURE C87B03A IS
-     
- BEGIN
-      TEST ("C87B03A","OVERLOADED EXPRESSIONS IN NUMBER DECLARATIONS");
-   
-      DECLARE
-           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES STANDARD."-";
-            
-           FUNCTION "+" (X, Y : FLOAT)   RETURN FLOAT
-                RENAMES STANDARD."-";
-   
-           I1 : CONSTANT         := 1 + 1;
-           I2 : CONSTANT INTEGER := 1 + 1;
-    
-           R1 : CONSTANT       := 1.0 + 1.0;
-           R2 : CONSTANT FLOAT := 1.0 + 1.0;
-   
-      BEGIN
-           IF I1 /= 2   OR I2 /= 0   OR 
-              R1 /= 2.0 OR R2 /= 0.0 THEN
-              FAILED ("OVERLOADED EXPRESSIONS IN NUMBER DECLARATIONS" &
-                      " RESOLVED INCORRECTLY");
-           END IF;
-      END;
-    
-      RESULT;
- END C87B03A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b04a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b04a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b04a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b04a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C87B04A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A RANGE CONSTRAINT OF A SUBTYPE INDICATION, THE EXPRESSIONS
- -- FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE WITH THE SUBTYPE'S
- -- EXPLICIT TYPEMARK.
-   
- -- TRH  28 JUNE 82
- -- JBG 3/8/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C87B04A IS
-   
-      TYPE AGE    IS NEW INTEGER RANGE 1 .. 120;
-      TYPE BASE10 IS NEW INTEGER RANGE 0 .. 9;
-      
-      FUNCTION F1 RETURN AGE IS
-      BEGIN
-           RETURN 18;
-      END F1;
- 
-      FUNCTION F1 RETURN INTEGER IS
-      BEGIN
-           FAILED ("RESOLUTION INCORRECT - RANGE CONSTRAINT OF " &
-                   "SUBTYPE INDICATION");
-           RETURN 0;
-      END F1;
-     
-      FUNCTION "+" (X : INTEGER) RETURN BASE10 IS
-      BEGIN
-           RETURN 1;
-      END "+";
- 
-      FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           FAILED ("RESOLUTION INCORRECT - RANGE CONSTRAINT OF " &
-                   "SUBTYPE INDICATION");
-           RETURN -X;
-      END "+";
-   
- BEGIN
-      TEST ("C87B04A","OVERLOADED EXPRESSIONS IN RANGE CONTRAINTS" &
-            " OF SUBTYPE INDICATIONS");
-    
-      DECLARE
-           SUBTYPE MINOR IS AGE RANGE 1 .. F1;
-   
-      BEGIN
-           FOR I IN BASE10 RANGE +(INTEGER'(0)) .. 0 LOOP
-                FAILED ("RESOLUTION INCORRECT - SUBTYPE INDICATION " &
-                        " IN LOOP CONSTRUCT");
-           END LOOP;
-      END;
-     
-      RESULT;
- END C87B04A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b04b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b04b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b04b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b04b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C87B04B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- 
- --      IN AN ACCURACY CONSTRAINT OF A SUBTYPE INDICATION, THE
- --      EXPRESSIONS FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE
- --      WITH THE SUBTYPE'S EXPLICIT TYPEMARK.
- 
- -- HISTORY:
- --      TRH 06/29/82  CREATED ORIGINAL TEST.
- --      BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.  CORRECTED
- --                    CONSTRAINT ERRORS.
- --      KAS 11/24/95  DELETED SUBTYPE DIGITS CONSTRAINT
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C87B04B IS
- 
-      TYPE EXACT IS DIGITS 5     RANGE -1.0 .. 1.0;
-      TYPE HEX IS DELTA  2.0 ** (-4) RANGE -1.0 .. 1.0;
- 
-      FUNCTION F1 RETURN EXACT IS
-      BEGIN
-           RETURN 0.0;
-      END F1;
- 
-      FUNCTION F1 RETURN FLOAT IS
-      BEGIN
-           FAILED ("RESOLUTION INCORRECT - ACCURACY CONSTRAINT OF " &
-                   "SUBTYPE INDICATION - F1");
-           RETURN 0.0;
-      END F1;
- 
-      FUNCTION "+" (X : INTEGER) RETURN HEX IS
-      BEGIN
-           RETURN 0.0;
-      END "+";
- 
-      FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
-      BEGIN
-           FAILED ("RESOLUTION INCORRECT - ACCURACY CONSTRAINT OF " &
-                   "SUBTYPE INDICATION - +");
-           RETURN 0.0;
-      END "+";
- 
- BEGIN
-      TEST ("C87B04B","OVERLOADED EXPRESSIONS IN ACCURACY CONTRAINTS" &
-            " OF FLOATING/FIXED POINT SUBTYPE INDICATIONS");
- 
-      DECLARE
-           SUBTYPE CLOSE IS EXACT RANGE -1.0 .. F1;
-           SUBTYPE BIN IS HEX DELTA 2.0 ** (-1) RANGE "+" (0) .. 0.5;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C87B04B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b04c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b04c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b04c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b04c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- C87B04C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A RANGE CONSTRAINT OF A SUBTYPE INDICATION, THE EXPRESSIONS
- -- FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE WITH THE SUBTYPE'S
- -- EXPLICIT TYPEMARK.
-   
- -- TRH  29 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B04C IS
-   
-      TYPE DAY IS (MON, TUE, WED, THU, FRI, SAT, SUN);
-      TYPE ORB IS (SUN, MOON, MARS, EARTH);
-   
-      TYPE GRADE IS ('A', 'B', 'C', 'D', 'F');
-      TYPE VOWEL IS ('C', 'E', 'A', 'O', 'I', 'U', 'Y');
-   
- BEGIN
-      TEST ("C87B04C","OVERLOADED EXPRESSIONS IN RANGE CONSTRAINTS" &
-           " OF ENUMERATION SUBTYPE INDICATIONS");
-   
-      DECLARE
-           SUBTYPE PASSING IS GRADE RANGE 'A' .. 'C';
-           SUBTYPE DISTANT IS ORB   RANGE SUN .. MARS;
-   
-      BEGIN
-           IF DISTANT'POS (DISTANT'FIRST) /= 0 OR
-              PASSING'POS (PASSING'FIRST) /= 0 THEN 
-              FAILED ("RESOLUTION INCORRECT FOR OVERLOADED " &
-                      " ENUMERATION LITERALS");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B04C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b05a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b05a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b05a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- C87B05A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN AN INTEGER TYPE DEFINITION WITH A RANGE CONSTRAINT, THE BOUNDS
- -- OF THE RANGE MUST BE OF SOME INTEGER TYPE.
-   
- -- TRH  1 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B05A IS
-   
-      ERR : BOOLEAN := FALSE;
-      TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      TYPE AGE   IS NEW INTEGER RANGE 0 .. 120;
-      
-      FUNCTION "+" (X : WHOLE) RETURN FLOAT IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN 2.0;
-      END "+";
- 
-      FUNCTION "-" (X : AGE) RETURN BOOLEAN IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN FALSE;
-      END "-";
-   
- BEGIN
-      TEST ("C87B05A","OVERLOADED EXPRESSIONS IN RANGE BOUNDS " &
-            " OF INTEGER TYPE DEFINITIONS");
-    
-      DECLARE
-           TYPE ADULT IS RANGE 18 .. "+" (WHOLE'(120));
-           TYPE MINOR IS RANGE "-" (AGE'(0))  .. "+" (WHOLE'(17));
-           TYPE NEG10 IS RANGE "-" (AGE'(10)) .. "-" (AGE'(1));
-   
-      BEGIN
-           IF ERR THEN 
-                FAILED ("RESOLUTION INCORRECT - INTEGER TYPE " &
-                        "DEFINITIONS MUST HAVE INTEGER TYPE "  &
-                        "RANGE BOUNDS");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B05A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b06a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b06a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b06a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b06a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C87B06A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- --     FOR EACH INTEGER TYPE, THERE EXISTS AN IMPLICIT CONVERSION THAT
- --     CONVERTS A UNIVERSAL INTEGER VALUE INTO THE CORRESPONDING VALUE
- --     OF THE INTEGER TYPE. THIS TEST USES LITERALS AS UNIVERSAL INTEGER
- --     VALUES.
- 
- -- HISTORY:
- --     TRH 08/11/82 CREATED ORIGINAL TEST.
- --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C87B06A IS
- 
-      TYPE MINOR IS NEW INTEGER RANGE 0 .. 17;
-      TYPE FIXED IS NEW DURATION;
-      TYPE REAL  IS NEW FLOAT;
- 
-      ERR : BOOLEAN := FALSE;
- 
-      PROCEDURE P (X : BOOLEAN) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
-      PROCEDURE P (X : FIXED) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
- 
-      PROCEDURE P (X : REAL) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
- 
-      PROCEDURE P (X : FLOAT) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
- 
-      PROCEDURE P (X : STRING) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
- 
-      PROCEDURE P (X : MINOR) IS
-      BEGIN
-           NULL;
-      END P;
- 
- BEGIN
-      TEST("C87B06A","OVERLOADING RESOLUTION WITH IMPLICIT CONVERSION " &
-           "OF UNIVERSAL INTEGER VALUES TO INTEGER VALUES. " &
-           "CONVERSIONS TO INTEGER VALUES EXISTS FOR ANY INTEGER TYPE");
- 
-      P (2);
-      P (2 * 2 + 2);
- 
-      IF ERR THEN
-           FAILED("INCORRECT IMPLICIT CONVERSION FROM UNIVERSAL " &
-                  " INTEGER VALUES TO INTEGER TYPE VALUES");
-      END IF;
- 
-      RESULT;
- END C87B06A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C87B07A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR THE ATTRIBUTE OF THE FORM T'POS (X), THE OPERAND X MUST 
- -- BE A VALUE OF TYPE T. THE RESULT IS OF TYPE UNIVERSAL_INTEGER.
-   
- -- TRH  13 SEPT 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B07A IS
-  
-      TYPE NATURAL IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
-      TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      TYPE COLOR   IS (BROWN, RED, WHITE);
-      TYPE SCHOOL  IS (HARVARD, BROWN, YALE);
-      TYPE SUGAR   IS (DEXTROSE, CANE, BROWN);
-  
-      FUNCTION "+" (X, Y : NATURAL) RETURN NATURAL
-           RENAMES "*";
-      FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE
-           RENAMES "-";
-     
- BEGIN
-      TEST ("C87B07A","OVERLOADED OPERANDS TO THE 'POS' ATTRIBUTE");
-   
-      IF NATURAL'POS (1 + 1) /= 1 OR COLOR'POS  (BROWN) /= 0 OR
-         WHOLE'POS   (1 + 1) /= 0 OR SCHOOL'POS (BROWN) /= 1 OR
-         INTEGER'POS (1 + 1) /= 2 OR SUGAR'POS  (BROWN) /= 2 THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERAND TO 'POS' ATTRIBUTE");
-      END IF;
-  
-      IF NATURAL'POS (3 + 3) + 1 /= 10 OR    -- SECOND "+" IS UNIVERSAL.
-         WHOLE'POS   (3 + 3) + 1 /=  1 OR    -- SECOND "+" IS UNIVERSAL.
-         INTEGER'POS (3 + 3) + 1 /=  7 THEN  -- SECOND "+" IS UNIVERSAL.
-         FAILED ("RESOLUTION INCORRECT - 'POS' ATTRIBUTE RETURNS " &
-                 "A UNIVERSAL_INTEGER VALUE");
-      END IF;
- 
-      RESULT;
- END C87B07A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C87B07B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR THE ATTRIBUTE OF THE FORM T'VAL (X), THE OPERAND X MAY
- -- BE OF ANY INTEGER TYPE. THE RESULT IS OF TYPE T.
-   
- -- TRH  15 SEPT 82
- -- DSJ  06 JUNE 83
- -- PWN  01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B07B IS
-  
-      TYPE NEW_INT IS NEW INTEGER;
-      TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      TYPE FLAG IS (PASS, FAIL);
-      
-      FUNCTION "+" (X, Y : NEW_INT) RETURN NEW_INT
-           RENAMES "-";
-      FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE
-           RENAMES "*";
-  
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("THE 'VAL' ATTRIBUTE TAKES AN OPERAND " &
-                        "OF AN INTEGER TYPE");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (CHARACTER, '1', FAIL);
-      FUNCTION F IS NEW F1 (DURATION,  1.0, FAIL);
-      FUNCTION F IS NEW F1 (FLOAT,     1.0, FAIL);
-      FUNCTION F IS NEW F1 (NEW_INT,   1,   PASS);
-     
- BEGIN
-      TEST ("C87B07B","OVERLOADED OPERANDS TO THE 'VAL' ATTRIBUTE");
-     
-      IF (INTEGER'VAL (F) /= 1)          THEN
-           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
-                   "MUST RETURN A VALUE OF TYPE T - 1");
-      END IF;
- 
-      IF (INTEGER'VAL (3 + 3) + 1 /= 7)  THEN
-           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
-                   "MUST RETURN A VALUE OF TYPE T - 2");
-      END IF;
- 
-      IF (NEW_INT'VAL (F) /= 1)          THEN
-           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
-                   "MUST RETURN A VALUE OF TYPE T - 3");
-      END IF;
- 
-      IF (NEW_INT'VAL  (3 + 3) + 1 /= 5) THEN
-           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
-                   "MUST RETURN A VALUE OF TYPE T - 4");
-      END IF;
- 
-      IF (WHOLE'VAL    (F) /= 1)         THEN
-           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
-                   "MUST RETURN A VALUE OF TYPE T - 5");
-      END IF;
- 
-      IF (WHOLE'VAL    (3 + 3) + 1 /= 6) THEN
-           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
-                   "MUST RETURN A VALUE OF TYPE T - 6");
-      END IF;
-  
-      RESULT;
- END C87B07B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C87B07C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR THE ATTRIBUTE OF THE FORM T'VALUE (X), THE OPERAND X MUST 
- -- BE OF THE PREDEFINED TYPE STRING. THE RESULT IS OF TYPE T.
-   
- -- TRH  13 SEPT 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B07C IS
-  
-      TYPE CHAR IS NEW CHARACTER;
-      TYPE LITS IS (' ', '+', '1');
-      TYPE WORD IS ARRAY (POSITIVE RANGE 1..4) OF CHARACTER;
-      TYPE LINE IS ARRAY (POSITIVE RANGE 1..4) OF CHAR;
-      TYPE LIST IS ARRAY (POSITIVE RANGE 1..4) OF LITS;
-      TYPE STR  IS ARRAY (POSITIVE RANGE 1..4) OF STRING (1 .. 1);
-      TYPE STR2 IS NEW STRING (1..4);
-      TYPE FLAG IS (PASS, FAIL);
-      SUBTYPE MY_STRING IS STRING (1..4);
-      
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("THE 'VALUE' ATTRIBUTE TAKES AN OPERAND" &
-                        " OF THE TYPE PREDEFINED STRING");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (STR2,   " +1 ",               FAIL);
-      FUNCTION F IS NEW F1 (LIST,   " +1 ",               FAIL);
-      FUNCTION F IS NEW F1 (WORD,   (' ', '+', '1', ' '), FAIL);
-      FUNCTION F IS NEW F1 (STR,    (" ", "+", "1", " "), FAIL);
-      FUNCTION F IS NEW F1 (LINE,   (' ', '+', '1', ' '), FAIL);
-      FUNCTION F IS NEW F1 (MY_STRING, " +1 ",               PASS);
-     
- BEGIN
-      TEST ("C87B07C","OVERLOADED OPERANDS TO THE 'VALUE' ATTRIBUTE");
-     
-      DECLARE
-           TYPE INT IS NEW INTEGER;
-           FUNCTION "-" (X : INT) RETURN INT 
-                RENAMES "+";
-  
-      BEGIN
-           IF INT'VALUE (F) /= -1 THEN
-                FAILED ("THE ATTRIBUTE T'VALUE MUST RETURN A VALUE" &
-                        " OF TYPE T");
-           END IF;
-      END;
-  
-      RESULT;
- END C87B07C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- C87B07D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE ATTRIBUTES OF THE FORM T'SUCC (X) AND T'PRED (X) TAKE AN
- -- OPERAND X OF TYPE T AND RETURN A VALUE OF TYPE T.
-   
- -- TRH  15 SEPT 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B07D IS
-  
-      TYPE NEW_INT IS NEW INTEGER;
-      TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-   
-      FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE 
-           RENAMES "*";
-      FUNCTION "+" (X, Y : NEW_INT) RETURN NEW_INT
-           RENAMES "-";
-     
- BEGIN
-      TEST ("C87B07D","OVERLOADED OPERANDS TO THE ATTRIBUTES " &
-            "'PRED' AND 'SUCC'");
-     
-      IF INTEGER'SUCC (1 + 1) /= 3  OR INTEGER'SUCC (3 + 3) + 1 /= 8  OR
-         NEW_INT'SUCC (1 + 1) /= 1  OR NEW_INT'SUCC (3 + 3) + 1 /= 0  OR
-         WHOLE'SUCC   (1 + 1) /= 2  OR WHOLE'SUCC   (3 + 3) + 1 /= 10 OR
-         INTEGER'PRED (1 + 1) /= 1  OR INTEGER'PRED (3 + 3) + 1 /= 6  OR
-         NEW_INT'PRED (1 + 1) /= -1 OR NEW_INT'PRED (3 + 3) + 1 /= -2 OR
-         WHOLE'PRED   (1 + 1) /= 0  OR WHOLE'PRED   (3 + 3) + 1 /= 8  
-         THEN FAILED ("RESOLUTION INCORRECT FOR OPERAND OR RESULT OF" &
-                      " THE 'PRED' OR 'SUCC' ATTRIBUTE");
-      END IF;
-      
-      RESULT;
- END C87B07D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b07e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b07e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- C87B07E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR THE ATTRIBUTE OF THE FORM T'IMAGE (X), THE OPERAND X MUST
- -- BE OF TYPE T. THE RESULT IS OF THE PREDEFINED TYPE STRING.
-   
- -- TRH  15 SEPT 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B07E IS
-  
-      TYPE NEW_INT IS NEW INTEGER;
-      TYPE NUMBER  IS NEW INTEGER;
-      TYPE NEW_STR IS NEW STRING;
-   
-      FUNCTION "+" (X : NEW_INT) RETURN NEW_INT
-           RENAMES "-";
-      FUNCTION "-" (X : NUMBER)  RETURN NUMBER
-           RENAMES "+";
-  
-      PROCEDURE P (X : NEW_STR) IS
-      BEGIN
-           FAILED ("THE IMAGE ATTRIBUTE MUST RETURN A VALUE OF THE" &
-                   " PREDEFINED TYPE STRING");
-      END P;
-  
-      PROCEDURE P (X : STRING) IS
-      BEGIN
-           NULL;
-      END P;
-     
- BEGIN
-      TEST ("C87B07E","OVERLOADED OPERANDS TO THE IMAGE ATTRIBUTE");
-     
-      IF INTEGER'IMAGE (+12) & INTEGER'IMAGE (-12) &
-         NEW_INT'IMAGE (+12) & NEW_INT'IMAGE (-12) &
-         NUMBER'IMAGE  (+12) & NUMBER'IMAGE  (-12)  /=
-         " 12-12-12-12 12 12" THEN
-         FAILED ("RESOLUTION INCORRECT FOR THE 'IMAGE' ATTRIBUTE");
-      END IF;
-    
-      P (INTEGER'IMAGE (+1) & NEW_INT'IMAGE (+1) & NUMBER'IMAGE (-1));
-      
-      RESULT;
- END C87B07E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b08a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b08a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b08a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b08a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C87B08A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR EACH REAL TYPE, THERE EXISTS AN IMPLICIT CONVERSION THAT
- -- CONVERTS A UNIVERSAL REAL VALUE INTO THE CORRESPONDING VALUE 
- -- OF THE REAL TYPE. THIS TEST USES LITERALS AS UNIVERSAL REAL
- -- VALUES.
-   
- -- TRH  16 AUG 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B08A IS
-  
-      TYPE FIXED IS DELTA 0.1 RANGE -2.0 .. 2.0;
-      TYPE FLT   IS DIGITS  2 RANGE -2.0 .. 2.0;
-      TYPE FLAG  IS (PASS, FAIL);
-  
-      GENERIC
-           TYPE T IS PRIVATE;
-           STAT : IN FLAG;
-      PROCEDURE P1 (X : T);
-   
-      PROCEDURE P1 (X : T) IS
-      BEGIN
-           IF STAT = FAIL THEN
-                FAILED ("INCORRECT IMPLICIT CONVERSION FROM UNIVERSAL" &
-                        " REAL VALUES TO REAL TYPE VALUES");
-           END IF;
-      END P1;
-  
-      PROCEDURE P IS NEW P1 (INTEGER,   FAIL);
-      PROCEDURE P IS NEW P1 (FLT,       PASS);
-      PROCEDURE Q IS NEW P1 (FIXED,     PASS);
-      PROCEDURE Q IS NEW P1 (BOOLEAN,   FAIL);
-      PROCEDURE Q IS NEW P1 (CHARACTER, FAIL);
-  
- BEGIN
-      TEST ("C87B08A","IMPLICIT CONVERSION OF UNIVERSAL REAL " &
-            "VALUES TO REAL VALUES EXISTS FOR ANY REAL TYPE");
-     
-      P (0.0);
-      P (1.0 + 1.0);
-      Q (1.0);
-      Q (1.0 - 1.0);
-  
-      RESULT;
- END C87B08A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b09a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b09a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b09a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b09a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- C87B09A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A FLOATING POINT TYPE DEFINITION, THE DIGITS EXPRESSION MUST 
- -- BE OF SOME INTEGER TYPE.
-   
- -- TRH  30 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B09A IS
-      
-      FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
-      BEGIN 
-            FAILED ("DIGITS EXPRESSION MUST BE OF AN INTEGER TYPE");
-            RETURN 2.0;
-      END "+";
- 
- BEGIN
-      TEST ("C87B09A","OVERLOADED DIGITS EXPRESSIONS IN " &
-            "FLOATING POINT TYPE DEFINITIONS");
-    
-      DECLARE
-           TYPE EXACT IS DIGITS "+" (3);
-           TYPE CLOSE IS DIGITS "+" (1) RANGE -1.0 .. 1.0;
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B09A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b09c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b09c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b09c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b09c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C87B09C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A FLOATING POINT TYPE DEFINITION, THE DIGITS EXPRESSION MUST
- -- BE OF SOME INTEGRAL TYPE. SIMILARLY, THE DELTA EXPRESSION IN A
- -- FIXED POINT TYPE DEFINITION MUST BE OF SOME REAL TYPE.
-   
- -- TRH  30 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B09C IS
-      
-      FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
-      BEGIN 
-            FAILED ("DIGITS EXPRESSION MUST BE OF AN INTEGRAL TYPE");
-            RETURN 2.0;
-      END "+";
- 
-      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
-      BEGIN 
-            FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
-            RETURN 2;
-      END "+";
-   
- BEGIN
-      TEST ("C87B09C","OVERLOADED DIGITS/DELTA EXPRESSIONS IN " &
-            "REAL TYPE DEFINITIONS");
-    
-      DECLARE
-           TYPE EXACT IS DIGITS "+" (4);
-           TYPE CENTI IS DELTA  "+" (0.01) RANGE -2.0 .. 2.0;
-           TYPE CLOSE IS DIGITS "+" (2)    RANGE -1.0 .. 1.0;
-           TYPE DECI  IS DELTA  "+" (0.1)  RANGE -1.0 .. 1.0;
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B09C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b10a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b10a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b10a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b10a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C87B10A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A RANGE CONSTRAINT OF A FIXED POINT OR FLOATING POINT TYPE
- -- DEFINITION, BOTH BOUNDS MUST BE OF SOME REAL TYPE, ALTHOUGH
- -- THE TWO BOUNDS DO NOT HAVE TO BE OF THE SAME TYPE.
-   
- -- TRH 7/28/82
- -- DSJ 6/10/83
- -- JBG 9/19/84
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B10A IS
- 
-      SUBTYPE DUR IS DURATION;
- 
-      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
-      BEGIN
-           FAILED ("RANGE CONSTRAINT FOR REAL TYPE DEFINITIONS " &
-                   "MUST HAVE REAL BOUNDS");
-           RETURN -10;
-      END "+";
- 
-      FUNCTION "+" (X, Y : FLOAT) RETURN INTEGER IS
-      BEGIN 
-           FAILED ("RANGE CONSTRAINT FOR REAL TYPE DEFINITIONS " &
-                   "MUST HAVE REAL BOUNDS");
-           RETURN -10;
-      END "+";
-   
- BEGIN
-      TEST ("C87B10A","RANGE BOUNDS IN REAL TYPE DEFINITIONS MUST BE" &
-            " OF SOME (NOT NECESSARILY THE SAME) REAL TYPE");
-    
-      DECLARE
-           TYPE R1 IS DIGITS  2 RANGE 0.0 .. 1.0 + FLOAT'(1.0);
-           TYPE R2 IS DELTA 0.1 RANGE FLOAT'(1.0) + 1.0 .. DUR'(2.0);
-           TYPE R3 IS DIGITS  2 RANGE +1.0 .. "+" (FLOAT'(2.0), 2.0);
-           TYPE R4 IS DELTA 0.1 RANGE 0.0 + FLOAT'(0.0) .. +1.0;
-  
-   
-      BEGIN
-           IF 2.0 NOT IN R1 OR -1.0 IN R2 OR
-                -1.0 IN R3 OR -0.9 IN R4 THEN
-                FAILED ("RANGE BOUNDS IN REAL TYPE DEFINITIONS DO NOT "
-                     & "HAVE TO BE OF THE SAME REAL TYPE");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B10A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b11a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b11a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b11a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b11a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- C87B11A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A FIXED POINT TYPE DEFINITION, THE DELTA EXPRESSION MUST
- -- BE OF SOME REAL TYPE.
-   
- -- TRH  30 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B11A IS
-      
-      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
-      BEGIN 
-            FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
-            RETURN 2;
-      END "+";
-   
- BEGIN
-      TEST ("C87B11A","OVERLOADED DELTA EXPRESSIONS IN " &
-            "FIXED POINT TYPE DEFINITIONS");
-    
-      DECLARE
-           TYPE SEMI IS DELTA "+" (0.5) RANGE -2.0 .. 2.0;
-           TYPE DECI IS DELTA "+" (0.1) RANGE -1.0 .. 1.0;
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B11A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b11b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b11b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b11b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b11b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- C87B11B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A SUBTYPE INDICATION, THE DELTA EXPRESSION FOR A FIXED POINT
- -- NUMBER MUST BE OF SOME REAL TYPE. 
-   
- -- TRH  29 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B11B IS
-   
-      TYPE DELT3 IS DELTA 3.0 RANGE -30.0 .. 30.0;
-      
-      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
-      BEGIN 
-            FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
-            RETURN 2;
-      END "+";
-   
- BEGIN
-      TEST ("C87B11B","OVERLOADED DELTA EXPRESSIONS IN " &
-            "FIXED POINT SUBTYPE INDICATIONS");
-    
-      DECLARE
-           SUBTYPE DELT2 IS DELT3 DELTA "+"(6.0);
-           SUBTYPE DELT1 IS DELT3 DELTA "+"(10.0) RANGE -10.0 .. 10.0;
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B11B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b13a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b13a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b13a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b13a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C87B13A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE LOWER AND UPPER BOUNDS OF AN INDEX CONSTRAINT IN A CONSTRAINED
- -- ARRAY TYPE DEFINITION MUST BE DISCRETE AND OF THE SAME TYPE.
-   
- -- TRH  1 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B13A IS
-      
-      TYPE CENTI IS DELTA 0.01 RANGE -1.0 .. 1.0;
-    
-      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
-      BEGIN 
-           RETURN X;
-      END F1;
- 
-      FUNCTION F1 (X : INTEGER) RETURN CENTI IS
-      BEGIN 
-           FAILED ("INDEX CONSTRAINT BOUNDS MUST BE DISCRETE AND " &
-                   " OF THE SAME TYPE");
-           RETURN 0.0;
-      END F1;
-   
-      FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
-      BEGIN 
-           FAILED ("INDEX CONSTRAINT BOUNDS MUST BE DISCRETE AND " &
-                   " OF THE SAME TYPE");
-           RETURN 1.0;
-      END F1;
-   
- BEGIN
-      TEST ("C87B13A","OVERLOADED INDEX CONSTRAINTS IN " &
-            "CONSTRAINED ARRAY TYPE DEFINITIONS");
-    
-      DECLARE
-           TYPE A1 IS ARRAY (F1 (1) .. F1 (1)) OF BOOLEAN;
-           TYPE A2 IS ARRAY (1      .. F1 (2)) OF BOOLEAN;
-           TYPE A3 IS ARRAY (F1 (1) ..     2)  OF BOOLEAN;
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B13A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C87B14A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
- -- BOUNDS MUST BE OF THE INDEX BASE TYPE.
- --
- -- TEST (A): INDEX CONSTRAINTS WITH OVERLOADED FUNCTIONS.
-   
- -- TRH  30 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B14A IS
-      
-      SUBTYPE WHOLE  IS INTEGER RANGE 0 .. INTEGER'LAST;
-      SUBTYPE BASE10 IS INTEGER RANGE 0 .. 9;
-      TYPE LIST IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
-      TYPE GRID IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF BOOLEAN;
-    
-      FUNCTION F1 RETURN WHOLE IS
-      BEGIN 
-           RETURN 1;
-      END F1;
- 
-      FUNCTION F1 RETURN BOOLEAN IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
-                   " IN SUBTYPE INDICATIONS");
-           RETURN TRUE;
-      END F1;
-   
-      FUNCTION F2 RETURN BASE10 IS
-      BEGIN 
-           RETURN 2;
-      END F2;
- 
-      FUNCTION F2 RETURN FLOAT IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
-                   " IN SUBTYPE INDICATIONS");
-           RETURN 2.0;
-      END F2;
-   
- BEGIN
-      TEST ("C87B14A","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &
-            "OF SUBTYPE INDICATIONS");
-    
-      DECLARE
-           SUBTYPE LIST1 IS LIST (1  .. F1);
-           SUBTYPE LIST2 IS LIST (F1 ..  1);
-           SUBTYPE LIST3 IS LIST (F2 .. F2);
-           SUBTYPE LIST4 IS LIST (F1 .. F2);
-    
-           SUBTYPE GRID1 IS GRID (1  .. F1, F1 ..  1);
-           SUBTYPE GRID2 IS GRID (F1 ..  2, 2  .. F2);
-           SUBTYPE GRID3 IS GRID (F1 .. F1, F2 .. F2);
-           SUBTYPE GRID4 IS GRID (F1 .. F2, 1  ..  2);
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B14A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C87B14B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
- -- BOUNDS MUST BE OF THE INDEX BASE TYPE.
- --
- -- TEST (B): INDEX CONSTRAINTS WITH OVERLOADED OPERATOR SYMBOLS.
-   
- -- TRH  30 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B14B IS
-      
-      SUBTYPE CHAR IS CHARACTER;
-      SUBTYPE VAR  IS CHAR RANGE 'X' .. 'Z';
-      SUBTYPE NOTE IS CHAR RANGE 'A' .. 'G';
-      TYPE LIST IS ARRAY (CHAR RANGE <>) OF CHAR;
-      TYPE GRID IS ARRAY (CHAR RANGE <>, CHAR RANGE <>) OF CHAR;
-    
-      FUNCTION "*" (X, Y : INTEGER) RETURN VAR IS
-      BEGIN 
-           RETURN 'X';
-      END "*";
- 
-      FUNCTION "*" (X, Y : INTEGER) RETURN BOOLEAN IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
-                   " IN SUBTYPE INDICATIONS");
-           RETURN TRUE;
-      END "*";
-   
-      FUNCTION "+" (X, Y : INTEGER) RETURN NOTE IS
-      BEGIN 
-           RETURN 'A';
-      END "+";
- 
-      FUNCTION "+" (X, Y : INTEGER) RETURN FLOAT IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
-                   " IN SUBTYPE INDICATIONS");
-           RETURN 2.0;
-      END "+";
-   
- BEGIN
-      TEST ("C87B14B","OVERLOADED OPERATOR SYMBOLS IN INDEX " &
-            "CONSTRAINTS OF SUBTYPE INDICATIONS");
-    
-      DECLARE
- 
-           SUBTYPE LIST1 IS LIST ('W' .. "*" (0, 0));
-           SUBTYPE LIST2 IS LIST ("+" (0, 0) .. 'C');
-           SUBTYPE LIST3 IS LIST ("+" (0, 0) .. "*" (0, 0));
-           SUBTYPE LIST4 IS LIST ("*" (0, 0) .. "*" (0, 0));
-    
-           SUBTYPE GRID1 IS GRID ('V' .. "*" (0, 0), "*" (0, 0) .. 'Y');
-           SUBTYPE GRID2 IS GRID ("*" (0, 0) .. 'W', 'H' .. "+" (0, 0));
-           SUBTYPE GRID3 IS GRID
-               ("*" (0, 0) .. "*" (0, 0), "+" (0, 0) .. "+" (0, 0));
-           SUBTYPE GRID4 IS GRID ("+" (0, 0) .. "*" (0, 0),'L' .. 'N');
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B14B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- C87B14C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
- -- BOUNDS MUST BE OF THE INDEX BASE TYPE.
- --
- -- TEST (C): INDEX CONSTRAINTS WITH OVERLOADED INFIX OPERATORS.
-   
- -- TRH  30 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B14C IS
-      
-      TYPE DAY  IS (MON, TUE, WED, THU, FRI, SAT, SUN);
-      TYPE LIST IS ARRAY (DAY RANGE <>) OF BOOLEAN;
-      TYPE GRID IS ARRAY (DAY RANGE <>, DAY RANGE <>) OF BOOLEAN;
-      SUBTYPE WEEKEND IS DAY RANGE SAT .. SUN;
-      SUBTYPE WEEKDAY IS DAY RANGE MON .. FRI;
-    
-      FUNCTION "*" (X, Y : INTEGER) RETURN WEEKDAY IS
-      BEGIN 
-           RETURN MON;
-      END "*";
- 
-      FUNCTION "*" (X, Y : INTEGER) RETURN BOOLEAN IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
-                   " IN SUBTYPE INDICATIONS");
-           RETURN TRUE;
-      END "*";
-   
-      FUNCTION "+" (X, Y : INTEGER) RETURN WEEKEND IS
-      BEGIN 
-           RETURN SAT;
-      END "+";
- 
-      FUNCTION "+" (X, Y : INTEGER) RETURN FLOAT IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
-                   " IN SUBTYPE INDICATIONS");
-           RETURN 2.0;
-      END "+";
-   
- BEGIN
-      TEST ("C87B14C","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &  
-            "OF SUBTYPE INDICATIONS");
-    
-      DECLARE
-           SUBTYPE LIST1 IS LIST (WED .. (0 + 0));
-           SUBTYPE LIST2 IS LIST ( 0 * 0 .. TUE);
-           SUBTYPE LIST3 IS LIST ((0 + 0) .. (0 + 0));
-           SUBTYPE LIST4 IS LIST ((0 * 0) .. (0 + 0));
-    
-           SUBTYPE GRID1 IS GRID (MON .. (0 * 0), (0 * 0) .. TUE);
-           SUBTYPE GRID2 IS GRID ((0 * 0) .. WED, FRI .. (0 + 0));
-           SUBTYPE GRID3 IS GRID
-               ((0 * 0) .. (0 * 0), (0 + 0) .. (0 + 0));
-           SUBTYPE GRID4 IS GRID ((0 * 0) .. (0 + 0), TUE .. THU);
-   
-      BEGIN
-           NULL;
-      END;
-     
-      RESULT;
- END C87B14C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b14d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b14d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- C87B14D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, IF A BOUND IS OF
- -- TYPE UNIVERSAL_INTEGER, IT IS IMPLICITLY CONVERTED TO THE
- -- INDEX BASE TYPE.
-   
- -- TRH  7 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B14D IS
-      
-      TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      TYPE LIST  IS ARRAY (WHOLE RANGE <>) OF BOOLEAN;
-   
- BEGIN
-      TEST ("C87B14D","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &
-            "OF SUBTYPE INDICATIONS WITH UNIVERSAL_INTEGER BOUNDS");
-    
-      DECLARE
-           FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE 
-                RENAMES "*";
-    
-           SUBTYPE LIST1 IS LIST (1 + 1 .. 1 + 1);
-           SUBTYPE LIST2 IS LIST (1     .. 3 + 3);
-           SUBTYPE LIST3 IS LIST (1 + 1 ..     2);
-   
-      BEGIN
-           IF LIST1'FIRST /= 1 OR LIST1'LAST /= 1 OR
-              LIST2'FIRST /= 1 OR LIST2'LAST /= 9 OR
-              LIST3'FIRST /= 1 OR LIST3'LAST /= 2 THEN 
-              FAILED ("RESOLUTION INCORRECT - IMPLICIT CONVERSION " &
-                      "OF UNIVERSAL_INTEGER TYPE TO INDEX CONSTRAINT " &
-                      "BASE TYPE");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B14D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b15a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b15a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b15a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b15a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C87B15A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE ARRAY ATTRIBUTES OF THE FORM: A'FIRST (N), A'LAST (N), 
- -- A'RANGE (N) AND A'LENGTH (N) MUST HAVE A PARAMETER (N) WHICH IS OF
- -- THE TYPE UNIVERSAL_INTEGER.
-   
- -- TRH  26 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B15A IS
-  
-      FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
-           RENAMES STANDARD."*";
-  
-      TYPE BOX IS ARRAY (0 .. 1, 3 .. 6, 5 .. 11) OF BOOLEAN;
-      B1 : BOX;
-  
- BEGIN
-      TEST ("C87B15A","ARRAY ATTRIBUTES: FIRST (N), LAST (N), RANGE " &
-            "(N) AND LENGTH (N) TAKE UNIVERSAL_INTEGER OPERANDS");
-  
-      IF BOX'FIRST  (1 + 0) /= 0    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 1");
-      END IF;
- 
-      IF B1'FIRST   (1 + 1) /= 3    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 2");
-      END IF;
- 
-      IF B1'FIRST   (2 + 1) /= 5    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 3");
-      END IF;
- 
-      IF BOX'LAST   (0 + 1) /= 1    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 4");
-      END IF;
- 
-      IF B1'LAST    (1 + 1) /= 6    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 5");
-      END IF;
- 
-      IF B1'LAST    (1 + 2) /= 11   THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 6");
-      END IF;
- 
-      IF BOX'LENGTH (0 + 1) /= 2    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 7");
-      END IF;
- 
-      IF B1'LENGTH  (1 + 1) /= 4    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 8");
-      END IF;
- 
-      IF B1'LENGTH  (2 + 1) /= 7    THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 9");
-      END IF;
- 
-      IF 1 NOT IN BOX'RANGE (0 + 1) THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 10");
-      END IF;
- 
-      IF 4 NOT IN B1'RANGE  (1 + 1) THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 11");
-      END IF;
- 
-      IF 9 NOT IN B1'RANGE  (2 + 1) THEN
-           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
-                   "UNIVERSAL_INTEGER - 12");
-      END IF;
- 
-      RESULT;
- END C87B15A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b16a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b16a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b16a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b16a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- C87B16A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR A DEFAULT RECORD COMPONENT, THE TYPE OF THE INITIALIZATION
- -- EXPRESSION MUST MATCH THE COMPONENTS'S EXPLICIT TYPEMARK.
- --      
- -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
- -- 
- --    (A): A CALL TO AN OVERLOADED FUNCTION.
- --    (B): AN OVERLOADED OPERATOR SYMBOL.
- --    (C): AN OVERLOADED (INFIX) OPERATOR.
- --    (D): AN OVERLOADED ENUMERATION LITERAL.
-   
- -- TRH  23 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B16A IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-      
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END F1;
-     
-      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B16A","OVERLOADED INITIALIZATION EXPRESSIONS" &
-            " IN DEFAULT RECORD COMPONENTS");
-      DECLARE
- 
-           FUNCTION "-" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES F1;
-     
-           FUNCTION "-" (X, Y : WHOLE)   RETURN WHOLE
-                RENAMES F1;
-      
-           FUNCTION "-" (X, Y : INTEGER) RETURN HUE
-                RENAMES F1;
-    
-           FUNCTION "-" (X, Y : INTEGER) RETURN CITRUS
-                RENAMES F1;
-       
-           TYPE REC IS
-                RECORD
-                     I1 : INTEGER := F1  (0, 0);
-                     W1 : WHOLE   := F1  (0, 0);
-                     C1 : CITRUS  := F1  (0, 0);
-                     H1 : HUE     := F1  (0, 0);
-    
-                     I2 : INTEGER := "-" (0, 0);
-                     W2 : WHOLE   := "-" (0, 0);
-                     C2 : CITRUS  := "-" (0, 0);
-                     H2 : HUE     := "-" (0, 0);
-       
-                     I3 : INTEGER := (0 - 0);
-                     W3 : WHOLE   := (0 - 0);
-                     C3 : CITRUS  := (0 - 0);
-                     H3 : HUE     := (0 - 0);
-       
-                     C4 : CITRUS  := ORANGE;
-                     H4 : HUE     := ORANGE;
-                END RECORD;
- 
-           R1 : REC;
-   
-      BEGIN
-           IF R1.I1              /= -1 OR R1.W1           /= 0 OR
-              CITRUS'POS (R1.C1) /=  2 OR HUE'POS (R1.H1) /= 1 THEN
-              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
-           END IF;
-     
-           IF R1.I2              /= -1 OR R1.W2           /= 0 OR
-              CITRUS'POS (R1.C2) /=  2 OR HUE'POS (R1.H2) /= 1 THEN
-              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
-           END IF;
-     
-           IF R1.I3              /= -1 OR R1.W3           /= 0 OR
-              CITRUS'POS (R1.C3) /=  2 OR HUE'POS (R1.H3) /= 1 THEN
-              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
-           END IF;
-     
-           IF CITRUS'POS (R1.C4) /=  2 OR HUE'POS (R1.H4) /= 1 THEN
-              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B16A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b17a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b17a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b17a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b17a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- C87B17A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
-   
- -- THE INITIALIZATION EXPRESSION FOR A DEFAULT DISCRIMINANT
- -- IN A TYPE DECLARATION MUST MATCH THE DISCRIMINANT'S EXPLICIT
- -- TYPEMARK.
- --
- -- THE THREE KINDS OF TYPE DECLARATIONS TESTED HERE ARE:
- --
- --    (A): RECORD TYPE.
- --    (B): PRIVATE TYPE.
- --    (C): INCOMPLETE RECORD TYPE.
-     
- -- TRH  18 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B17A IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-    
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END F1;
-     
-      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B17A","OVERLOADED INITIALIZATION EXPRESSIONS" &
-            " IN DEFAULT DISCRIMINANTS");
-    
-      DECLARE
- 
-           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES F1;
-     
-           FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE
-                RENAMES F1;
-      
-           FUNCTION "+" (X, Y : INTEGER) RETURN HUE
-                RENAMES F1;
-    
-           FUNCTION "+" (X, Y : INTEGER) RETURN CITRUS
-                RENAMES F1;
- 
-           TYPE REC1 (I1 : INTEGER := 0 + 0; H1 : HUE := F1 (0, 0) ) IS
-                RECORD
-                     NULL;
-                END RECORD;
-     
-           PACKAGE PVT IS 
-                TYPE REC2 (H2 : HUE := ORANGE; W2 : WHOLE := 0 + 0 )
-                     IS PRIVATE;
-           PRIVATE
-                TYPE REC2 (H2 : HUE := ORANGE; W2 : WHOLE := 0 + 0 ) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
-           END PVT;
-           USE PVT;
-   
-           TYPE REC3 (C1 : CITRUS := ORANGE; W1 : WHOLE := "+" (0, 0));
-   
-           TYPE LINK IS ACCESS REC3;
-    
-           TYPE REC3 (C1 : CITRUS := ORANGE; W1 : WHOLE := "+" (0, 0)) IS
-                RECORD
-                     NULL;
-                END RECORD;
-    
-           R1 : REC1;
-           R2 : REC2;
-           R3 : REC3;
-    
-      BEGIN
-           IF R1.I1 /= -1 OR HUE'POS (R1.H1) /= 1 THEN 
-              FAILED ("(A): RESOLUTION INCORRECT FOR RECORD TYPES");
-           END IF;
-    
-           IF HUE'POS (R2.H2) /=  1 OR R2.W2 /= 0 THEN
-              FAILED ("(B): RESOLUTION INCORRECT FOR PRIVATE TYPES");
-           END IF;
-   
-           IF CITRUS'POS (R3.C1) /= 2 OR R3.W1 /= 0 THEN
-              FAILED ("(C): RESOLUTION INCORRECT FOR INCOMPLETE" &
-                      " RECORD TYPES");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B17A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b18a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b18a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b18a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b18a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C87B18A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE TYPES OF THE EXPRESSIONS IN A DISCRIMINANT CONSTRAINT IN
- -- A SUBTYPE INDICATION MUST MATCH THE DISCRIMINANT'S EXPLICIT
- -- TYPEMARK.
-   
- -- TRH  1 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B18A IS
-      
-      ERR : BOOLEAN := FALSE;
-  
-      FUNCTION F1 RETURN INTEGER IS
-      BEGIN 
-           RETURN 1;
-      END F1;
- 
-      FUNCTION F1 RETURN FLOAT IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN 0.0;
-      END F1;
-  
-      FUNCTION F2 RETURN BOOLEAN IS
-      BEGIN
-           RETURN TRUE;
-      END F2;
- 
-      FUNCTION F2 RETURN STRING IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN "STRING";
-      END F2;
-   
- BEGIN
-      TEST ("C87B18A","OVERLOADED EXPRESSIONS IN DISCRIMINANT " &
-            "CONSTRAINTS");
-    
-      DECLARE
-           TYPE REC (X : INTEGER := 0; Y : BOOLEAN := TRUE) IS
-                RECORD
-                     NULL;
-                END RECORD;
-  
-           R1 : REC (F1, F2);
-           R2 : REC (Y => F2, X => F1);
- 
-      BEGIN
-           IF ERR THEN 
-                FAILED ("RESOLUTION INCORRECT - DISCRIMINANT " &
-                        "CONSTRAINT MUST MATCH DISCRIMINANT TYPE");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B18A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b18b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b18b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b18b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b18b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C87B18B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE EXPRESSION IN A NAMED OR POSITIONAL DISCRIMINANT ASSOCIATION
- -- MUST MATCH THE TYPE OF THE CORRESPONDING DISCRIMINANT.
-   
- -- TRH  9 AUG 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B18B IS
-  
-      TYPE REC (W, X : CHARACTER; Y, Z : BOOLEAN) IS
-           RECORD
-                NULL;
-           END RECORD;
-  
-      TYPE FLAG IS (PASS, FAIL);
-      
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("DISCRIMINANT ASSOCIATION EXPRESSION MUST " &
-                        "MATCH THE TYPE OF THE CORRESPONDING " &
-                        "DISCRIMINANT");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (FLOAT,     2.0, FAIL);
-      FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
-      FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
-      FUNCTION F IS NEW F1 (CHARACTER, 'E', PASS);
-  
-      FUNCTION G IS NEW F1 (FLOAT,     2.0, FAIL);
-      FUNCTION G IS NEW F1 (INTEGER,     5, FAIL);
-      FUNCTION G IS NEW F1 (BOOLEAN,  TRUE, PASS);
-      FUNCTION G IS NEW F1 (CHARACTER, 'E', FAIL);
-     
- BEGIN
-      TEST ("C87B18B","OVERLOADED DISCRIMINANT ASSOCIATIONS");
-     
-      DECLARE
-           SUBTYPE R1 IS REC (F, F, G, G);
-           SUBTYPE R2 IS REC (X => F, Y => G, Z => G, W => F);
-           SUBTYPE R3 IS REC (F, F, Z => G, Y => G);
-    
-      BEGIN
-           NULL;
-      END;
-  
-      RESULT;
- END C87B18B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b19a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b19a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b19a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b19a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- C87B19A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- --     SIMPLE EXPRESSIONS AND RANGE BOUNDS OF VARIANT CHOICES MUST MATCH
- --     THE TYPE OF THE DISCRIMINANT'S EXPLICIT TYPEMARK.
- 
- --HISTORY:
- --     DSJ 06/15/83 CREATED ORIGINAL TEST.
- --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C87B19A IS
- 
-      TYPE COLOR  IS (YELLOW, RED, BLUE, GREEN, BROWN);
-      TYPE SCHOOL IS (YALE, HARVARD, PRINCETON, BROWN, STANFORD);
-      TYPE COOK   IS (BROIL, BAKE, BROWN, TOAST, FRY);
-      TYPE MIXED  IS (GREEN, BROWN, YALE, BAKE, BLUE, FRY);
- 
-      RATING : INTEGER := 0;
- 
-      FUNCTION OK RETURN BOOLEAN IS
-      BEGIN
-           RATING := RATING + 1;
-           RETURN FALSE;
-      END OK;
- 
-      FUNCTION ERR RETURN BOOLEAN IS
-      BEGIN
-           FAILED ("VARIANT CHOICES MUST MATCH TYPE OF DISCRIMINANT");
-           RETURN FALSE;
-      END ERR;
- 
- BEGIN
-      TEST ("C87B19A","OVERLOADED EXPRESSIONS AND RANGE BOUNDS" &
-            " OF VARIANT CHOICES");
-      DECLARE
- 
-           TYPE REC (X : MIXED := BROWN) IS
-                RECORD
-                     CASE X IS
-                          WHEN GREEN .. BROWN  => NULL;
-                          WHEN BLUE            => NULL;
-                          WHEN FRY             => NULL;
-                          WHEN YALE            => NULL;
-                          WHEN OTHERS          => NULL;
-                     END CASE;
-                END RECORD;
- 
-           R1 : REC (X => FRY);
-           R2 : REC (X => BLUE);
-           R3 : REC (X => BAKE);
-           R4 : REC (X => YALE);
-           R5 : REC (X => BROWN);
-           R6 : REC (X => GREEN);
- 
-      BEGIN
-           IF MIXED'POS(R1.X) /= 5 THEN
-              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
-                      "DISCRIMINANT-R1");
-           END IF;
-           IF MIXED'POS(R2.X) /= 4 THEN
-              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
-                      "DISCRIMINANT-R2");
-           END IF;
-           IF MIXED'POS(R3.X) /= 3 THEN
-              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
-                      "DISCRIMINANT-R3");
-           END IF;
-           IF MIXED'POS(R4.X) /= 2 THEN
-              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
-                      "DISCRIMINANT-R4");
-           END IF;
-           IF MIXED'POS(R5.X) /= 1 THEN
-              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
-                      "DISCRIMINANT-R5");
-           END IF;
-           IF MIXED'POS(R6.X) /= 0 THEN
-              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
-                      "DISCRIMINANT-R6");
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C87B19A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b23a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b23a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b23a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b23a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C87B23A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR AN INDEXED COMPONENT OF AN ARRAY, THE PREFIX MUST BE 
- -- APPROPRIATE FOR AN ARRAY TYPE. EACH EXPRESSION FOR THE INDEXED 
- -- COMPONENT MUST BE OF THE TYPE OF THE CORRESPONDING INDEX AND
- -- THERE MUST BE ONE SUCH EXPRESSION FOR EACH INDEX POSITION OF THE 
- -- ARRAY TYPE.
-   
- -- TRH  15 SEPT 82
- -- DSJ  07 JUNE 83
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B23A IS
- 
-      SUBTYPE CHAR IS CHARACTER;
-      TYPE GRADE IS (A, B, C, D, F);
-      TYPE NOTE  IS (A, B, C, D, E, F, G);
-      TYPE INT   IS NEW INTEGER;
-      TYPE POS   IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
-      TYPE NAT   IS NEW POS;
-      TYPE BOOL  IS NEW BOOLEAN;
-      TYPE BIT   IS NEW BOOL;
-      TYPE LIT   IS (FALSE, TRUE);
-      TYPE FLAG  IS (PASS, FAIL);
- 
-      TYPE NUM2 IS DIGITS(2);
-      TYPE NUM3 IS DIGITS(2);
-      TYPE NUM4 IS DIGITS(2);
- 
-      TYPE A1 IS ARRAY (POS'(1)..5, NOTE'(A)..D, BOOL'(FALSE)..TRUE)
-           OF FLOAT;
-      TYPE A2 IS ARRAY (INT'(1)..5, NOTE'(A)..D, BIT'(FALSE)..TRUE)
-           OF NUM2;
-      TYPE A3 IS ARRAY (POS'(1)..5, GRADE'(A)..D, BOOL'(FALSE)..TRUE)
-           OF NUM3;
-      TYPE A4 IS ARRAY (NAT'(1)..5, NOTE'(A)..D, LIT'(FALSE)..TRUE)
-           OF NUM4;
-      
-      OBJ1 : A1 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
-      OBJ2 : A2 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
-      OBJ3 : A3 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
-      OBJ4 : A4 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("PREFIX OR INDEX IS NOT APPROPRIATE FOR" &
-                        " INDEXED COMPONENT");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION A IS NEW F1 (A1, OBJ1, PASS);
-      FUNCTION A IS NEW F1 (A2, OBJ2, FAIL);
-      FUNCTION A IS NEW F1 (A3, OBJ3, FAIL);
-      FUNCTION A IS NEW F1 (A4, OBJ4, FAIL);
-   
- BEGIN
-      TEST ("C87B23A","OVERLOADED ARRAY INDEXES");
-     
-      DECLARE
-           F1 : FLOAT := A (3, C, TRUE);
-    
-      BEGIN
-           NULL;
-      END;
-  
-      RESULT;
- END C87B23A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b24a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b24a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b24a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b24a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C87B24A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
-     
- -- THE PREFIX OF A SLICE MUST BE APPROPRIATE FOR A ONE DIMENSIONAL
- -- ARRAY TYPE.
-   
- -- TRH  26 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B24A IS
-  
-      TYPE LIST IS ARRAY (1 .. 5) OF INTEGER;
-      TYPE GRID IS ARRAY (1 .. 5, 1 .. 5) OF INTEGER;
-      TYPE CUBE IS ARRAY (1 .. 5, 1 .. 5, 1 .. 5) OF INTEGER;
-      TYPE HYPE IS ARRAY (1 .. 5, 1 .. 5, 1 .. 5, 1 .. 5) OF INTEGER;
-      TYPE FLAG IS (PASS, FAIL);
-    
-      L : LIST := (1 .. 5 => 0);
-      G : GRID := (1 .. 5 => (1 .. 5 => 0));
-      C : CUBE := (1 .. 5 => (1 .. 5 => (1 .. 5 => 0)));
-      H : HYPE := (1 .. 5 => (1 .. 5 => (1 .. 5 => (1 .. 5 => 0))));
-  
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN
-           IF STAT = FAIL THEN 
-              FAILED ("SLICE PREFIX MUST BE APPROPRIATE FOR ONE " &
-                      "DIMENSIONAL ARRAY");
-           END IF;
-           RETURN ARG;
-      END F1;
-  
-      FUNCTION F2 IS NEW F1 (LIST, L, PASS);
-      FUNCTION F2 IS NEW F1 (GRID, G, FAIL);
-      FUNCTION F2 IS NEW F1 (CUBE, C, FAIL);
-      FUNCTION F2 IS NEW F1 (HYPE, H, FAIL);
-     
- BEGIN
-      TEST ("C87B24A","OVERLOADED PREFIX FOR SLICE RESOLVED TO " &
-            "ONE DIMENSIONAL ARRAY TYPE");
-  
-      DECLARE
-           S1 : INTEGER;
-  
-      BEGIN
-           S1 := F2 (2 .. 3)(2);
-      END;
-  
-      RESULT;
- END C87B24A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b24b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b24b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b24b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b24b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C87B24B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
-     
- -- THE RANGE BOUNDS FOR A SLICE MUST BE DISCRETE AND OF THE SAME BASE
- -- TYPE AS THE ARRAY INDEX.
-   
- -- TRH  15 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B24B IS
-  
-      TYPE PIECE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-  
-      PI  : PIECE (1 .. 8) := (3, 1, 4, 1, 5, 9, 2, 6);
-      S1  : PIECE (1 .. 3);
-      S2  : PIECE (4 .. 8);
-      ERR : BOOLEAN := FALSE;
-        
-      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
-      BEGIN 
-           RETURN X;
-      END F1;
-        
-      FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN 0.0;
-      END F1;
-     
-      FUNCTION F2 (X : INTEGER) RETURN INTEGER IS
-      BEGIN 
-           RETURN X;
-      END F2;
-     
-      FUNCTION F2 (X :INTEGER) RETURN CHARACTER IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN 'A';
-      END F2;
-     
- BEGIN
-      TEST ("C87B24B","OVERLOADING RESOLUTION OF RANGE " &
-            "CONSTRAINTS FOR SLICES");
-  
-      DECLARE
-           FUNCTION "+" (X : INTEGER) RETURN INTEGER 
-                RENAMES F1;
-    
-           FUNCTION "+" (X : INTEGER) RETURN FLOAT 
-                RENAMES F1;
-    
-           FUNCTION "-" (X : INTEGER) RETURN INTEGER 
-                RENAMES F2;
-  
-           FUNCTION "-" (X : INTEGER) RETURN CHARACTER
-                RENAMES F2;
-   
-      BEGIN 
-           S1 := PI ("+" (3) .. "-" (5));
-           S1 := PI (F2  (2) .. "+" (4));
-           S1 := PI ("-" (6) .. F1  (8));
-           S1 := PI (F2  (1) .. F2  (3));
-           S2 := PI (F2  (4) .. F1  (8));
-           S2 := PI (2       .. "+" (6));
-           S2 := PI (F1  (1) ..       5);
-           S2 := PI ("+" (3) .. "+" (7));
-   
-           IF ERR THEN
-                FAILED (" OVERLOADING RESOLUTION INCORRECT FOR SLICES");
-           END IF;
-      END;
-  
-      RESULT;
- END C87B24B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b26b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b26b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b26b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b26b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- C87B26B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'ADDRESS, 'CONSTRAINED, 'SIZE, AND 'STORAGE_SIZE MAY BE
- -- USED WITH THE DESIGNATED OBJECTS OF ACCESS VALUES RETURNED FROM
- -- OVERLOADED FUNCTIONS, AND THAT EXPLICIT DEREFERENCING IS USED BY
- -- OVERLOADING RESOLUTION TO RESOLVE THE PREFIXES OF THE ATTRIBUTES.
- 
- -- DSJ 22 JUN 83
- -- JBG 11/22/83
- -- JBG 4/23/84
- -- JBG 5/25/85
- 
- WITH REPORT;  WITH SYSTEM;
- USE  REPORT;  USE  SYSTEM;
- 
- PROCEDURE C87B26B IS
- 
-      TYPE REC (D : INTEGER) IS
-           RECORD
-                C1, C2 : INTEGER;
-           END RECORD;
-      TYPE P_REC IS ACCESS REC;
- 
-      P_REC_OBJECT : P_REC := NEW REC'(1,1,1);
- 
-      TYPE BIG_INT IS RANGE 0..SYSTEM.MAX_INT;
-      TASK TYPE TASK_TYPE IS
-           -- NOTHING AT ALL
-      END TASK_TYPE;
- 
-      TYPE P_TASK IS ACCESS TASK_TYPE;
- 
-      P_TASK_OBJECT : P_TASK;
- 
-      TASK BODY TASK_TYPE IS
-      BEGIN
-           NULL;
-      END TASK_TYPE;
- 
-      ------------------------------------------------------------
- 
-      FUNCTION F RETURN REC IS
-      BEGIN
-           RETURN (0,0,0);
-      END F;
- 
-      FUNCTION F RETURN P_REC IS
-      BEGIN
-           RETURN P_REC_OBJECT;
-      END F;
- 
-      ------------------------------------------------------------
- 
-      FUNCTION G RETURN TASK_TYPE IS
-           NEW_TASK : TASK_TYPE;
-      BEGIN
-           RETURN NEW_TASK;
-      END G;
- 
-      FUNCTION G RETURN P_TASK IS
-      BEGIN
-           RETURN P_TASK_OBJECT;
-      END G;
- 
-      ------------------------------------------------------------
- 
- BEGIN
- 
-      TEST("C87B26B","CHECK THAT EXPLICIT DEREFERENCING IN AN " &
-           "ATTRIBUTE PREFIX IS USED IN OVERLOADING RESOLUTION " &
-           "WITH 'ADDRESS, 'CONSTRAINED, 'SIZE, AND 'STORAGE_SIZE");
- 
-      DECLARE
- 
-           A : ADDRESS;   -- FOR 'ADDRESS OF RECORD
-           B : BOOLEAN;   -- FOR 'CONSTRAINED OF RECORD
-           C : INTEGER;   -- FOR 'SIZE OF RECORD
-           D : ADDRESS;   -- FOR 'ADDRESS OF TASK
-           E : BIG_INT;   -- FOR 'STORAGE_SIZE OF TASK
- 
-      BEGIN
- 
-           P_TASK_OBJECT := NEW TASK_TYPE;
-           A := F.ALL'ADDRESS;
-           B := F.ALL'CONSTRAINED;
-           C := F.ALL'SIZE;
-           D := G.ALL'ADDRESS;
-           E := G.ALL'STORAGE_SIZE;
- 
-           IF A /= P_REC_OBJECT.ALL'ADDRESS THEN
-                FAILED("INCORRECT RESOLUTION FOR 'ADDRESS - REC");
-           END IF;
- 
-           IF B /= P_REC_OBJECT.ALL'CONSTRAINED THEN
-                FAILED("INCORRECT RESOLUTION FOR 'CONSTRAINED");
-           END IF;
- 
-           IF C /= P_REC_OBJECT.ALL'SIZE THEN
-                FAILED("INCORRECT RESOLUTION FOR 'SIZE");
-           END IF;
- 
-           IF D /= P_TASK_OBJECT.ALL'ADDRESS THEN
-                FAILED("INCORRECT RESOLUTION FOR 'ADDRESS - TASK");
-           END IF;
- 
-           IF E /= P_TASK_OBJECT.ALL'STORAGE_SIZE THEN
-                FAILED("INCORRECT RESOLUTION FOR 'STORAGE_SIZE");
-           END IF;
- 
-           IF A = P_REC_OBJECT'ADDRESS THEN
-                FAILED("INCORRECT DEREFERENCING FOR 'ADDRESS - REC");
-           END IF;
- 
-           IF C = P_REC_OBJECT'SIZE AND C /= P_REC_OBJECT.ALL'SIZE THEN
-                FAILED("INCORRECT DEREFERENCING FOR 'SIZE");
-           END IF;
- 
-           IF D = P_TASK_OBJECT'ADDRESS THEN
-                FAILED("INCORRECT DEREFERENCING FOR 'ADDRESS - TASK");
-           END IF;
- 
- 
-      END;
- 
-      RESULT;
- 
- END C87B26B; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b27a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b27a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b27a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b27a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C87B27A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE TYPE OF A STRING LITERAL MUST BE DETERMINED FROM THE FACT
- -- THAT A STRING LITERAL IS A VALUE OF A ONE DIMENSIONAL ARRAY OF
- -- CHARACTER COMPONENTS.
-   
- -- TRH  18 AUG 82
- -- DSJ  07 JUN 83
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B27A IS
-  
-      TYPE ENUMLIT   IS (A, B, C, D, E, F);
-      TYPE NEW_CHAR  IS NEW CHARACTER RANGE 'G' .. 'Z';
-      TYPE CHARS3    IS ('G','H','I','K','M','N','P','R','S','T');
-      TYPE CHARS4    IS ('S','T','R','I','N','G','Z','A','P');
-      TYPE NEW_STR   IS ARRAY  (A .. F) OF NEW_CHAR;
-      TYPE STRING3   IS ARRAY  (11..16) OF CHARS3;
-      TYPE STRING4   IS ARRAY  (21..26) OF CHARS4;
-      TYPE ENUM_VEC  IS ARRAY  (1 .. 6) OF ENUMLIT;
-      TYPE CHAR_GRID IS ARRAY  (D .. F, 1 .. 3) OF NEW_CHAR;
-      TYPE STR_LIST  IS ARRAY  (1 .. 6) OF STRING (1 .. 1);
-      ERR : BOOLEAN  := FALSE;
-  
-      PROCEDURE P (X : NEW_STR) IS
-      BEGIN
-           NULL;
-      END P;
-  
-      PROCEDURE P (X : ENUM_VEC) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
-  
-      PROCEDURE P (X : CHAR_GRID) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
-  
-      PROCEDURE P (X : STR_LIST) IS
-      BEGIN
-           ERR := TRUE;
-      END P;
-  
- BEGIN
-      TEST ("C87B27A","OVERLOADING RESOLUTION OF STRING LITERALS");
-     
-      P ("STRING");
-  
-      IF ERR THEN
-           FAILED ("RESOLUTION INCORRECT FOR STRING LITERALS");
-      END IF;
-  
-      RESULT;
- END C87B27A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b28a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b28a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b28a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b28a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C87B28A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE TYPE OF THE LITERAL "NULL" MUST BE DETERMINED FROM THE FACT 
- -- THAT "NULL" IS A VALUE OF AN ACCESS TYPE.
-   
- -- TRH  13 AUG 82
- -- JRK 2/2/84
- 
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B28A IS
-  
-      ERR : BOOLEAN := FALSE;
-  
-      TYPE A2 IS ACCESS BOOLEAN;
-      TYPE A3 IS ACCESS INTEGER;
-      TYPE A1 IS ACCESS A2;
-  
-      FUNCTION F RETURN A1 IS
-      BEGIN 
-           RETURN NEW A2;
-      END F;
-  
-      FUNCTION F RETURN A2 IS
-      BEGIN
-           ERR := TRUE;
-           RETURN NEW BOOLEAN;
-      END F;
-  
-      FUNCTION F RETURN A3 IS
-      BEGIN
-           ERR := TRUE;
-           RETURN (NEW INTEGER);
-      END F;
-  
- BEGIN
-      TEST ("C87B28A", "OVERLOADING OF THE ACCESS TYPE LITERAL 'NULL'");
-     
-      F.ALL := NULL;
-  
-      IF ERR THEN
-           FAILED ("RESOLUTION INCORRECT FOR THE ACCESS TYPE LITERAL " &
-                   "'NULL'");
-      END IF;
-  
-      RESULT;
- END C87B28A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b29a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b29a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b29a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b29a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C87B29A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- AGGREGATES CONTAINING A SINGLE COMPONENT ASSOCIATION MUST
- -- USE ONLY NAMED NOTATION.
-   
- -- TRH  4 AUG 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B29A IS
-      
-      TYPE VECTOR IS ARRAY (1 .. 1) OF INTEGER;
-  
-      TYPE REC IS
-           RECORD
-                X : INTEGER;
-           END RECORD;
-  
-      ERR : BOOLEAN := FALSE;
-  
-      PROCEDURE P1 (X : INTEGER) IS
-      BEGIN
-           NULL;
-      END P1;
-  
-      PROCEDURE P1 (X : VECTOR) IS
-      BEGIN
-           ERR := TRUE;
-      END P1;
-  
-      PROCEDURE P1 (X : REC) IS
-      BEGIN
-           ERR := TRUE;
-      END P1;
-  
- BEGIN
-      TEST ("C87B29A","AGGREGATES CONTAINING A SINGLE COMPONENT " &
-            "ASSOCIATION MUST USE NAMED NOTATION");
-    
-      P1 ( (0) );  -- INTEGER PARAMETER, NOT AN AGGREGATE PARAMETER
-  
-      IF ERR THEN
-         FAILED ("RESOLUTION INCORRECT - AGGREGATES WITH A SINGLE " &
-                 "COMPONENT ASSOCIATION MUST USE NAMED NOTATION");
-      END IF;
-     
-      RESULT;
- END C87B29A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b30a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b30a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b30a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b30a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C87B30A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE EXPRESSION OF A COMPONENT ASSOCIATION MUST MATCH THE TYPE OF THE 
- -- ASSOCIATED RECORD COMPONENT.
-   
- -- TRH  9 AUG 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B30A IS
-  
-      TYPE REC IS
-           RECORD
-                W, X : FLOAT;
-                Y, Z : INTEGER;
-           END RECORD;
-  
-      TYPE FLAG IS (PASS, FAIL);
-      
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("COMPONENT ASSOCIATION EXPRESSION MUST MATCH " &
-                        "RECORD COMPONENT TYPE");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (FLOAT,     2.0, PASS);
-      FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
-      FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
-      FUNCTION F IS NEW F1 (CHARACTER, 'E', FAIL);
-  
-      FUNCTION G IS NEW F1 (FLOAT,     2.0, FAIL);
-      FUNCTION G IS NEW F1 (INTEGER,     5, PASS);
-      FUNCTION G IS NEW F1 (BOOLEAN,  TRUE, FAIL);
-      FUNCTION G IS NEW F1 (CHARACTER, 'E', FAIL);
-     
- BEGIN
-      TEST ("C87B30A","OVERLOADED EXPRESSIONS IN RECORD AGGREGATE " &
-            "COMPONENT ASSOCIATIONS");
-     
-      DECLARE
-           R1 : REC := (F, F, G, G);
-           R2 : REC := (X => F, Y => G, Z => G, W => F);
-           R3 : REC := (F, F, Z => G, Y => G);
-    
-      BEGIN
-           NULL;
-      END;
-  
-      RESULT;
- END C87B30A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b31a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b31a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b31a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b31a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- C87B31A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IF THE TYPE OF AN AGGREGATE IS A ONE-DIMENSIONAL ARRAY TYPE
- -- THEN EACH CHOICE MUST SPECIFY VALUES OF THE INDEX TYPE, AND
- -- THE EXPRESSION OF EACH COMPONENT ASSOCIATION MUST BE OF THE
- -- COMPONENT TYPE.
-   
- -- TRH  8 AUG 82
- -- DSJ 15 JUN 83
- -- JRK  2 FEB 84
- -- JBG 4/23/84
- 
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B31A IS
-  
-      TYPE LETTER  IS NEW CHARACTER RANGE 'A' .. 'Z';
-      TYPE NOTE    IS (A, B, C, D, E, F, G, H);
-      TYPE STR     IS NEW STRING (1 .. 1);
-      TYPE BIT     IS NEW BOOLEAN;
-      TYPE YES     IS NEW BOOLEAN RANGE TRUE  .. TRUE;
-      TYPE NO      IS NEW BOOLEAN RANGE FALSE .. FALSE;
-      TYPE BOOLEAN IS (FALSE, TRUE);
-      TYPE LIST    IS ARRAY (CHARACTER RANGE <>) OF BIT;
-      TYPE FLAG    IS (PASS,  FAIL);
-      
-      SUBTYPE LIST_A  IS LIST('A'..'A');
-      SUBTYPE LIST_E  IS LIST('E'..'E');
-      SUBTYPE LIST_AE IS LIST('A'..'E');
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("RESOLUTION INCORRECT FOR EXPRESSIONS " &
-                        "IN ARRAY AGGREGATES");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
-      FUNCTION F IS NEW F1 (YES,     TRUE,  FAIL);
-      FUNCTION F IS NEW F1 (NO,      FALSE, FAIL);
-      FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
-   
-      FUNCTION G IS NEW F1 (CHARACTER, 'A', PASS);
-      FUNCTION G IS NEW F1 (LETTER,    'A', FAIL);
-      FUNCTION G IS NEW F1 (STR,       "A", FAIL);
-   
-      FUNCTION H IS NEW F1 (CHARACTER, 'E', PASS);
-      FUNCTION H IS NEW F1 (LETTER,    'E', FAIL);
-      FUNCTION H IS NEW F1 (STR,       "E", FAIL);
-     
- BEGIN
-      TEST ("C87B31A", "OVERLOADED EXPRESSIONS IN ARRAY AGGREGATES");
-     
-      DECLARE
-           L1, L2 : LIST_A :=  (OTHERS => FALSE);
-           L3, L4 : LIST_E :=  (OTHERS => FALSE);
-           L5, L6 : LIST_AE := (OTHERS => FALSE);
-           L7, L8 : LIST_AE := (OTHERS => FALSE);
- 
-      BEGIN
-           L1 := ('A' => F);
-           L2 := ( G  => F);
-           L3 := ('E' => F);
-           L4 := ( H  => F);
-           L5 := ('A'..'E' => F);
-           L6 := (F,F,F,F,F);
-           L7 := (F,F,F, OTHERS => F);
-           L8 := LIST_AE'('E' => F, 'B' => F, OTHERS => F);
-   
-           IF L1 /= LIST_A'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L1");
-           END IF;
-           IF L2 /= LIST_A'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L2");
-           END IF;
-           IF L3 /= LIST_E'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L3");
-           END IF;
-           IF L4 /= LIST_E'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L4");
-           END IF;
-           IF L5 /= LIST_AE'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L5");
-           END IF;
-           IF L6 /= LIST_AE'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L6");
-           END IF;
-           IF L7 /= LIST_AE'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L7");
-           END IF;
-           IF L8 /= LIST_AE'(OTHERS => TRUE) THEN
-                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
-                          " EXPRESSIONS IN ARRAY AGGREGATES - L8");
-           END IF;
-      END;
-  
-      RESULT;
- END C87B31A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b32a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b32a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b32a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b32a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,199 ****
- -- C87B32A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE FOLLOWING RULES:
-     
- -- FOR ATTRIBUTES OF THE FORM: T'SUCC (X), T'PRED (X), T'POS (X),
- -- AND T'IMAGE (X) , THE OPERAND X MUST BE OF TYPE T.
- --
- -- FOR THE ATTRIBUTE OF THE FORM T'VAL (X), THE OPERAND X MUST BE
- -- OF AN INTEGER TYPE.
- --
- -- FOR THE ATTRIBUTE OF THE FORM T'VALUE (X), THE OPERAND X MUST 
- -- BE OF THE PREDEFINED TYPE STRING.
-   
- -- TRH  13 SEPT 82
- -- JRK  12 JAN  84
- 
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B32A IS
-  
-      TYPE COLOR  IS (BROWN, RED, WHITE);
-      TYPE SCHOOL IS (HARVARD, BROWN, YALE);
-      TYPE COOK   IS (SIMMER, SAUTE, BROWN, BOIL);
-      TYPE SUGAR  IS (DEXTROSE, CANE, GLUCOSE, BROWN);
-      TYPE WHOLE  IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      TYPE LIT_CHAR IS ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7',
-                        '8', '9');
-      TYPE LIT_STRING IS ARRAY (POSITIVE RANGE <>) OF LIT_CHAR;
- 
-      FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE 
-           RENAMES "*";
-  
-      FUNCTION F1 RETURN STRING IS
-      BEGIN 
-           RETURN "+10";
-      END F1;
-   
-      FUNCTION F1 RETURN LIT_STRING IS
-      BEGIN 
-           FAILED ("THE VALUE ATTRIBUTE TAKES A PREDEFINED STRING " &
-                   "OPERAND");
-           RETURN "+3";
-      END F1;
-   
-      FUNCTION F1 RETURN CHARACTER IS
-      BEGIN
-           FAILED ("THE VALUE ATTRIBUTE TAKES A STRING OPERAND");
-           RETURN '2';
-      END F1;
-    
-      FUNCTION F2 (X : INTEGER) RETURN FLOAT IS
-      BEGIN
-           FAILED ("THE VAL ATTRIBUTE TAKES AN INTEGER TYPE OPERAND");
-           RETURN 0.0;
-      END F2;
-   
-      FUNCTION F2 (X : INTEGER := 1) RETURN INTEGER IS
-      BEGIN 
-           RETURN X;
-      END F2;
-  
- BEGIN
-      TEST ("C87B32A","OVERLOADED OPERANDS FOR THE ATTRIBUTES " &
-            "T'PRED, T'SUCC, T'POS, T'VAL, T'IMAGE AND T'VALUE");
-   
-      IF COLOR'POS   (BROWN) /= 0        THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 1");
-      END IF;
-  
-      IF SCHOOL'POS (BROWN) /= 1         THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 2");
-      END IF;
-  
-      IF COOK'POS    (BROWN) /= 2        THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 3");
-      END IF;
-  
-      IF SUGAR'POS  (BROWN) /= 3         THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 4");
-      END IF;
-  
-      IF SCHOOL'PRED (BROWN) /= HARVARD  THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 5");
-      END IF;
-  
-      IF COOK'PRED  (BROWN) /= SAUTE     THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 6");
-      END IF;
-  
-      IF SUGAR'PRED  (BROWN) /= GLUCOSE  THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 7");
-      END IF;
-  
-      IF COLOR'SUCC (BROWN) /= RED       THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 8");
-      END IF;
-  
-      IF SCHOOL'SUCC (BROWN) /= YALE     THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 9");
-      END IF;
-  
-      IF COOK'SUCC  (BROWN) /= BOIL      THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 10");
-      END IF;
-  
-      IF COLOR'VAL (F2 (0))  /= BROWN    THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 11");
-      END IF;
-  
-      IF SCHOOL'VAL (F2)    /= BROWN     THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 12");
-      END IF;
-  
-      IF COOK'VAL  (F2 (2))  /= BROWN    THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 13");
-      END IF;
-  
-      IF SUGAR'VAL  (F2)    /= CANE      THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 14");
-      END IF;
-  
-      IF WHOLE'POS   (1 + 1)   /= 1      THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 15");
-      END IF;
-  
-      IF WHOLE'VAL   (1 + 1) /= 2        THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 16");
-      END IF;
-  
-      IF WHOLE'SUCC  (1 + 1)   /= 2      THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 17");
-      END IF;
-  
-      IF WHOLE'PRED  (1 + 1) /= 0        THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 18");
-      END IF;
-  
-      IF WHOLE'VALUE ("+1") + 1 /= 1     THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 19");
-      END IF;
-  
-      IF WHOLE'IMAGE (1 + 1) /= " 1"     THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 20");
-      END IF;
-  
-      IF WHOLE'VALUE (F1) + 1  /= 10     THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 21");
-      END IF;
-  
-      IF WHOLE'VAL (1) + 1   /= 1        THEN
-         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
-                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 22");
-      END IF;
-  
-      RESULT;
- END C87B32A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b33a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b33a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b33a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b33a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C87B33A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE SHORT CIRCUIT CONTROL FORMS "AND THEN" AND "OR ELSE" ARE
- -- DEFINED AS BINARY BOOLEAN OPERATORS WHICH RETURN A BOOLEAN VALUE
- -- OF THE SAME TYPE AS THE OPERANDS.
-   
- -- TRH  13 SEPT 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B33A IS
-      
-      TYPE ON   IS NEW BOOLEAN RANGE TRUE  .. TRUE;
-      TYPE OFF  IS NEW BOOLEAN RANGE FALSE .. FALSE;
-      TYPE YES  IS NEW ON;
-      TYPE NO   IS NEW OFF;
-      TYPE BIT  IS NEW BOOLEAN;
-      TYPE FLAG IS (PASS, FAIL);
-  
-      TYPE BOOLEAN IS (FALSE, TRUE);  -- STANDARD BOOLEAN HIDDEN.
-  
-      GENERIC 
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : FLAG;
-      FUNCTION F1 RETURN T;
-      
-      FUNCTION F1 RETURN T IS
-      BEGIN
-           IF STAT = FAIL THEN
-                FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT " &
-                        "CONTROL FORMS 'AND THEN' AND 'OR ELSE' ");
-           END IF;
-           RETURN ARG;
-      END F1;
-  
-      FUNCTION A IS NEW F1 (BOOLEAN, TRUE,  FAIL);
-      FUNCTION A IS NEW F1 (NO,      FALSE, PASS);
-      FUNCTION A IS NEW F1 (ON,      TRUE,  FAIL);
-      FUNCTION A IS NEW F1 (YES,     TRUE,  FAIL);
-      FUNCTION B IS NEW F1 (BOOLEAN, TRUE,  FAIL);
-      FUNCTION B IS NEW F1 (NO,      FALSE, FAIL);
-      FUNCTION B IS NEW F1 (OFF,     FALSE, FAIL);
-      FUNCTION B IS NEW F1 (BIT,     TRUE,  FAIL);
-      FUNCTION C IS NEW F1 (BOOLEAN, FALSE, FAIL);
-      FUNCTION C IS NEW F1 (YES,     TRUE,  PASS);
-      FUNCTION C IS NEW F1 (ON,      TRUE,  FAIL);
-      FUNCTION C IS NEW F1 (NO,      FALSE, FAIL);
-      FUNCTION D IS NEW F1 (BOOLEAN, FALSE, FAIL);
-      FUNCTION D IS NEW F1 (OFF,     FALSE, FAIL);
-      FUNCTION D IS NEW F1 (YES,     TRUE,  FAIL);
-      FUNCTION D IS NEW F1 (BIT,     TRUE,  FAIL);
-      FUNCTION E IS NEW F1 (BOOLEAN, FALSE, FAIL);
-      FUNCTION E IS NEW F1 (BIT,     TRUE,  PASS);
-      FUNCTION E IS NEW F1 (YES,     TRUE,  FAIL);
-      FUNCTION E IS NEW F1 (NO,      FALSE, FAIL);
-      FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
-      FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
-      FUNCTION F IS NEW F1 (ON,      TRUE,  FAIL);
-      FUNCTION F IS NEW F1 (OFF,     FALSE, FAIL);
-      FUNCTION G IS NEW F1 (BOOLEAN, TRUE,  FAIL);
-      FUNCTION G IS NEW F1 (BIT,     FALSE, PASS);
-      FUNCTION G IS NEW F1 (NO,      FALSE, FAIL);
-      FUNCTION G IS NEW F1 (YES,     TRUE,  FAIL);
-      FUNCTION H IS NEW F1 (BOOLEAN, TRUE,  FAIL);
-      FUNCTION H IS NEW F1 (BIT,     FALSE, PASS);
-      FUNCTION H IS NEW F1 (OFF,     FALSE, FAIL);
-      FUNCTION H IS NEW F1 (ON,      TRUE,  FAIL);
-  
- BEGIN
-      TEST ("C87B33A","OVERLOADED OPERANDS FOR SHORT CIRCUIT CONTROL " &
-            "FORMS 'AND THEN' AND 'OR ELSE' ");
-     
-      IF (A AND THEN B)                        THEN
-           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - A&B");
-      END IF;
- 
-      IF NOT (C OR ELSE D) THEN
-           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - C&D");
-      END IF;
- 
-      IF NOT (E AND THEN F AND THEN E
-           AND THEN F AND THEN E AND THEN F)   THEN
-           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - E&F");
-      END IF;
- 
-      IF (G OR ELSE H OR ELSE G
-           OR ELSE H OR ELSE G OR ELSE H)      THEN
-           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - G&H");
-      END IF;
-     
-      RESULT;
- END C87B33A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b34a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b34a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b34a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b34a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,68 ****
- -- C87B34A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE MEMBERSHIP TESTS "IN" AND "NOT IN" RESULT IN THE PREDEFINED
- -- TYPE BOOLEAN. 
-   
- -- TRH  4 AUG 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B34A IS
-      
-      TYPE BIT   IS NEW BOOLEAN;
-      TYPE FLAG  IS NEW BOOLEAN;
-  
-      ERR : BOOLEAN := FALSE;
-  
-      PROCEDURE P1 (X : BIT) IS
-      BEGIN
-           ERR := TRUE;
-      END P1;
-  
-      PROCEDURE P1 (X : FLAG) IS
-      BEGIN
-           ERR := TRUE;
-      END P1;
-  
-      PROCEDURE P1 (X : BOOLEAN) IS
-      BEGIN
-           NULL;
-      END P1;
-   
- BEGIN
-      TEST ("C87B34A","MEMBERSHIP TESTS 'IN' AND 'NOT IN' RETURN " &
-            "TYPE PREDEFINED BOOLEAN");
-    
-      P1 (3 IN 1 .. 5);
-      P1 (3 NOT IN 1 .. 5);
-  
-      IF ERR THEN
-         FAILED ("MEMBERSHIP TESTS MUST RETURN PREDEFINED BOOLEAN TYPE");
-      END IF;
-     
-      RESULT;
- END C87B34A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b34b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b34b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b34b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b34b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C87B34B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
-     
- -- THE "IN" (OR MEMBERSHIP) OPERATOR OF THE FORM:  X IN L .. R
- -- REQUIRES THE OPERANDS X, L AND R TO BE OF THE SAME SCALAR TYPE.
-   
- -- TRH  19 JULY 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B34B IS
-  
-      TYPE FLAG IS (PASS, FAIL);
-   
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-              FAILED ("RESOLUTION INCORRECT FOR 'IN' MEMBERSHIP TEST");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION X IS NEW F1 (FLOAT,     2.0, PASS);
-      FUNCTION L IS NEW F1 (FLOAT,    -1.0, PASS);
-      FUNCTION R IS NEW F1 (FLOAT,     1.0, PASS);
-      FUNCTION X IS NEW F1 (INTEGER,     5, FAIL);
-      FUNCTION L IS NEW F1 (INTEGER,     1, FAIL);
-      FUNCTION L IS NEW F1 (CHARACTER, 'A', FAIL);
-      FUNCTION R IS NEW F1 (CHARACTER, 'E', FAIL);
-      FUNCTION X IS NEW F1 (BOOLEAN,  TRUE, FAIL);
-      FUNCTION R IS NEW F1 (BOOLEAN,  TRUE, FAIL);
-     
- BEGIN
-      TEST ("C87B34B","OVERLOADED MEMBERSHIP OPERANDS");
-  
-      IF X IN L .. R THEN 
-         FAILED ("RESOLUTION INCORRECT FOR MEMBERSHIP OPERATOR");
-      END IF;
-  
-      RESULT;
- END C87B34B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b34c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b34c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b34c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b34c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C87B34C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
-     
- -- FOR A MEMBERSHIP RELATION WITH A TYPEMARK, THE TYPE OF THE
- -- SIMPLE EXPRESSION MUST BE THE BASE TYPE OF THE TYPEMARK.
-   
- -- TRH  15 SEPT 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B34C IS
-  
-      TYPE VOWEL IS (A, E, I, O, U, VOCALIC_Y);
-      TYPE ALPHA IS (A, 'A');
-      TYPE GRADE IS (A, B, C, D, F);
-      SUBTYPE BAD_GRADE IS GRADE RANGE D .. F;
-      SUBTYPE PASSING   IS GRADE RANGE A .. C;
-  
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - EXPRESSION IN MEMBER" &
-                   "SHIP TEST WITH TYPEMARK MUST MATCH TYPEMARK");
-           RETURN ARG;
-      END F1;
-  
-      FUNCTION F IS NEW F1 (CHARACTER, 'A');
-      FUNCTION F IS NEW F1 (DURATION,  1.0);
-      FUNCTION F IS NEW F1 (INTEGER,   -10);
-      FUNCTION F IS NEW F1 (BOOLEAN,   TRUE);
-      FUNCTION F IS NEW F1 (FLOAT,     1.0);
-      FUNCTION F IS NEW F1 (VOWEL,     A);
-      FUNCTION F IS NEW F1 (ALPHA,     A);
-     
- BEGIN
-      TEST ("C87B34C","OVERLOADED EXPRESSION IN MEMBERSHIP TEST " &
-            "WITH A TYPEMARK");
-  
-      IF (F NOT IN GRADE) OR (F NOT IN BAD_GRADE)
-           OR (F IN PASSING) THEN 
-           FAILED ("RESOLUTION INCORRECT FOR MEMBERSHIP TEST " &
-                   "WITH TYPEMARK");
-      END IF;
-     
-      RESULT;
-  
- END C87B34C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b35c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b35c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b35c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b35c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C87B35C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE EXPONENT OPERAND OF A FLOATING POINT EXPONENTIATION MUST BE
- -- OF THE TYPE PREDEFINED INTEGER.
-   
- -- TRH  4 AUG 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B35C IS
-  
-      TYPE FIXED IS DELTA 0.01 RANGE 0.0 .. 4.0;
-      ERR : BOOLEAN := FALSE;
-    
-      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
-      BEGIN 
-           RETURN X;
-      END F1;
-        
-      FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN 1.0;
-      END F1;
-     
-      FUNCTION F1 (X : INTEGER) RETURN FIXED IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN 1.0;
-      END F1;
-  
- BEGIN
-      TEST ("C87B35C","EXPONENT OPERAND FOR FLOATING POINT " &
-            "EXPONENTIATION MUST BE OF TYPE PREDEFINED INTEGER");
-   
-      DECLARE
-           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES STANDARD."*";
-     
-      BEGIN
-           IF ( FLOAT'(2.0) ** F1(3)   /= 8.0 OR
-                FLOAT'(2.0) ** (3 + 1) /= 8.0 ) THEN
-                FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION "
-                     & "MUST BE PREDEFINED INTEGER (A)");
-           END IF;
-           IF ( 2.0 ** F1(3)   /= FLOAT'(8.0) OR
-                2.0 ** (3 + 1) /= FLOAT'(8.0) ) THEN
-                FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION"
-                     & "MUST BE PREDEFINED INTEGER (B)");
-           END IF;
-           IF ERR THEN
-                FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION"
-                     & "MUST BE PREDEFINED INTEGER (C)");
-           END IF;
-      END;
-  
-      RESULT;
- END C87B35C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b38a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b38a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b38a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b38a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- C87B38A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
-     
- -- IN A QUALIFIED EXPRESSION, THE OPERAND MUST HAVE THE SAME TYPE
- -- AS THE BASE TYPE OF THE TYPEMARK.
-   
- -- TRH  13 SEPT 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B38A IS
-  
-      SUBTYPE BOOL IS BOOLEAN;
-      TYPE YES  IS NEW BOOLEAN RANGE TRUE  .. TRUE;
-      TYPE NO   IS NEW BOOLEAN RANGE FALSE .. FALSE;
-      TYPE BIT  IS NEW BOOLEAN;
-      TYPE LIT  IS (FALSE, TRUE);   
-      TYPE FLAG IS (PASS,  FAIL);
-  
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("RESOLUTION INCORRECT FOR OVERLOADED " &
-                        " OPERANDS OF QUALIFIED EXPRESSIONS");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (LIT,     FALSE, FAIL);
-      FUNCTION F IS NEW F1 (BIT,     TRUE,  FAIL);
-      FUNCTION F IS NEW F1 (BOOLEAN, TRUE,  PASS);
-      FUNCTION F IS NEW F1 (YES,     TRUE,  FAIL);
-      FUNCTION F IS NEW F1 (NO,      FALSE, FAIL);
-     
- BEGIN
-      TEST ("C87B38A","OVERLOADED OPERANDS IN QUALIFIED EXPRESSIONS ");
-  
-      DECLARE 
-           B : BOOL;
-  
-      BEGIN
-           B := BOOL' (F);
-           B := BOOL' ((NOT F) OR ELSE (F AND THEN F));
-      END;
-  
-      RESULT;
- END C87B38A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- C87B39A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT:
- 
- --   A) AN OVERLOADED CALL CAN BE RESOLVED BECAUSE AN ALLOCATOR RETURNS
- --      AN ACCESS TYPE WHOSE DESIGNATED TYPE IS THE TYPE REFERRED TO IN
- --      THE ALLOCATOR.
- --
- --   B) IF THE NAME OF THE DESIGNATED TYPE IN AN ALLOCATOR DOES NOT
- --      UNIQUELY DETERMINE THE ACCESS TYPE OF AN ALLOCATOR, THE CONTEXT
- --      MUST DETERMINE THE TYPE.
- 
- -- JBG 1/30/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C87B39A IS
- 
-      TYPE S IS (M, F);
-      TYPE R (D : S) IS
-           RECORD NULL; END RECORD;
-      SUBTYPE M1 IS R(M);
-      SUBTYPE M2 IS R(M);
- 
-      TYPE ACC_M1 IS ACCESS M1;
-      TYPE ACC_M2 IS ACCESS M2;
-      TYPE ACC_BOOL IS ACCESS BOOLEAN;
-      TYPE ACC_ACC_M1 IS ACCESS ACC_M1;
-      
-      TYPE WHICH IS (IS_M1, IS_M2, IS_BOOL);
- 
-      PROCEDURE P (X : ACC_M1; RESOLUTION : WHICH) IS
-      BEGIN
-           IF RESOLUTION /= IS_M1 THEN
-                FAILED ("INCORRECT RESOLUTION -- ACC_M1");
-           END IF;
-      END P;    -- ACC_M1
- 
-      PROCEDURE P (X : ACC_M2; RESOLUTION : WHICH) IS
-      BEGIN
-           IF RESOLUTION /= IS_M2 THEN
-                FAILED ("INCORRECT RESOLUTION -- ACC_M2");
-           END IF;
-      END P;    -- ACC_M2
- 
-      PROCEDURE P (X : ACC_BOOL; RESOLUTION : WHICH) IS
-      BEGIN
-           IF RESOLUTION /= IS_BOOL THEN
-                FAILED ("INCORRECT RESOLUTION -- ACC_BOOL");
-           END IF;
-      END P;    -- ACC_BOOL
- 
-      PROCEDURE P (X : ACC_ACC_M1; RESOLUTION : WHICH) IS
-      BEGIN
-           FAILED ("INCORRECT RESOLUTION -- ACC_ACC_M1");
-      END P;    -- ACC_ACC_M1
- 
-      PROCEDURE Q (X : ACC_M1) IS
-      BEGIN
-           NULL;
-      END Q;    -- ACC_M1
- 
-      PROCEDURE Q (X : ACC_BOOL) IS
-      BEGIN
-           FAILED ("INCORRECT RESOLUTION -- ACC_BOOL: Q");
-      END Q;    -- ACC_BOOL
- 
- BEGIN
- 
-      TEST ("C87B39A", "OVERLOADING RESOLUTION FOR ALLOCATORS");
- 
-      P (ACC_M1'(NEW R(M)), IS_M1);    -- B
- 
-      P (ACC_M2'(NEW M1), IS_M2);      -- B
- 
-      P (NEW BOOLEAN'(TRUE), IS_BOOL); -- A
- 
-      Q (NEW M2);              -- A
-      Q (NEW M1);              -- A
-      Q (NEW R(M));            -- A
-      Q (NEW R'(D => M));      -- A
- 
-      RESULT;
- 
- END C87B39A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b40a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b40a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b40a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b40a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- C87B40A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE FOLLOWING RULES:
- --
- -- THE SAME OPERATIONS ARE PREDEFINED FOR THE TYPE UNIVERSAL_INTEGER
- -- AS FOR ANY INTEGER TYPE. THE SAME OPERATIONS ARE PREDEFINED FOR THE
- -- TYPE UNIVERSAL_REAL AS FOR ANY FLOATING POINT TYPE. IN ADDITION
- -- THESE OPERATIONS INCLUDE THE FOLLOWING MULTIPLICATION AND DIVISION
- -- OPERATORS:
- --
- --   "*" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
- --   "*" (UNIVERSAL_INTEGER, UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
- --   "*" (UNIVERSAL_REAL,    UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
- --   "*" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
- --   "/" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
- --  "**" (UNIVERSAL_INTEGER, INTEGER) RETURN UNIVERSAL_INTEGER
- --  "**" (UNIVERSAL_REAL, INTEGER) RETURN UNIVERSAL_REAL
- -- "MOD" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
- -- "DIV" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
- -- "ABS" (UNIVERSAL_INTEGER) RETURN UNIVERSAL INTEGER
- -- "ABS" (UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
- 
- -- TRH  15 SEPT 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B40A IS
-   
-      ERR : BOOLEAN := FALSE;
-      B : ARRAY (1 .. 12) OF BOOLEAN := (1 .. 12 => TRUE);
- 
-      FUNCTION "-" (X : INTEGER) RETURN INTEGER
-           RENAMES STANDARD."+";
- 
-      FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN X;
-      END "+";
-  
-      FUNCTION "+" (X : FLOAT) RETURN FLOAT IS
-      BEGIN 
-           ERR := TRUE;
-           RETURN X;
-      END "+";
-  
- BEGIN
-      TEST ("C87B40A","OVERLOADING RESOLUTION OF UNIVERSAL " &
-            "EXPRESSIONS");
-  
-      B(1)  := 1.0 * (+1) IN 0.0 .. 0.0;       -- 1.0 * 1
-      B(2)  := (+1) * 1.0 IN 0.0 .. 0.0;       -- 1 * 1.0
-      B(3)  := 1.0 / (+1) IN 0.0 .. 0.0;       -- 1.0 / 1
-      B(4)  := (+1)  +  (+1) <= (+1)  -  (+1); -- 1+1< 1 - 1
-      B(5)  := (+1)  *  (+1) >  (+1)  /  (+1); -- 1*1 > 1/1
-      B(6)  := (+1) MOD (+1) /= (+1) REM (+1); -- 1 MOD 1 /= 1 REM 1
- 
-      BEGIN
-           B(7)  := (+2) **  (-2) <  "-"  (-1);     -- 2**2 < 1
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED("INCORRECT RESOLUTION FOR INTEGER EXPONENT - 7");
-      END;
- 
-      B(8)  := (+1) REM (+1) > "ABS" (+1);     -- 1 REM 1 > ABS 1
-      B(9)  := (+1.0)  +  (+1.0) <= (+1.0)  -  (+1.0); -- 2.0 <= 0.0
-      B(10) := (+1.0)  *  (+1.0) >  (+1.0)  /  (+1.0); -- 1.0 > 1.0
-      B(11) := (+2.0) **  (-1)   <  "-"  (-1.0);       -- 2.0 < 1.0
-      B(12) := (+2.0) **  (-1)  <= "ABS" (+1.0);       -- 2.0 <= 1.0
- 
-      FOR I IN B'RANGE
-      LOOP
-           IF B(I) /= FALSE THEN
-                FAILED("RESOLUTION OR OPERATIONS INCORRECT FOR "
-                & "UNIVERSAL EXPRESSIONS - " & INTEGER'IMAGE(I) );
-           END IF;
-      END LOOP;
-  
-      IF ERR THEN 
-           FAILED ("RESOLUTION INCORRECT FOR UNIVERSAL EXPRESSIONS");
-      END IF;
-  
-      RESULT;
- END C87B40A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C87B41A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE NAMED VARIABLE AND THE RIGHT HAND SIDE EXPRESSION
- -- IN AN ASSIGNMENT STATEMENT MUST BE OF THE SAME TYPE. THIS TYPE
- -- MUST NOT BE A LIMITED TYPE.
-   
- -- TRH  15 SEPT 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B41A IS
-      
-      TYPE NOTE IS (A, B, C, D, E, F, G);
-      TYPE POSITIVE IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
-      TYPE ACC_CHAR IS ACCESS CHARACTER;
-      TYPE ACC_DUR  IS ACCESS DURATION;
-      TYPE ACC_POS  IS ACCESS POSITIVE;
-      TYPE ACC_INT  IS ACCESS INTEGER;
-      TYPE ACC_BOOL IS ACCESS BOOLEAN;
-      TYPE ACC_STR  IS ACCESS STRING;
-      TYPE ACC_FLT  IS ACCESS FLOAT;
-      TYPE ACC_NOTE IS ACCESS NOTE;
-    
-      TYPE NEW_CHAR IS NEW CHARACTER;
-      TYPE NEW_DUR  IS NEW DURATION;
-      TYPE NEW_POS  IS NEW POSITIVE;
-      TYPE NEW_INT  IS NEW INTEGER;
-      TYPE NEW_BOOL IS NEW BOOLEAN;
-      TYPE NEW_FLT  IS NEW FLOAT;
-      TYPE NEW_NOTE IS NEW NOTE RANGE A .. F;
-      TASK TYPE T;
-    
-      TASK BODY T IS
-      BEGIN
-           NULL;
-      END T;
-   
-      FUNCTION G RETURN T IS
-           T1 : T;
-      BEGIN
-           FAILED ("LIMITED TYPES MAY NOT OCCUR IN ASSIGNMENT " &
-                   "STATEMENTS");
-           RETURN T1;
-      END G;
-   
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           FAILED ("RESOLUTION INCORRECT - RIGHT HAND SIDE OF " &
-                   "ASSIGNMENT STATEMENT MUST MATCH TYPE OF VARIABLE");
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (ACC_CHAR, NEW CHARACTER);
-      FUNCTION F IS NEW F1 (ACC_DUR,  NEW DURATION);
-      FUNCTION F IS NEW F1 (ACC_POS,  NEW POSITIVE);
-      FUNCTION F IS NEW F1 (ACC_INT,  NEW INTEGER);
-      FUNCTION F IS NEW F1 (ACC_BOOL, NEW BOOLEAN);
-      FUNCTION F IS NEW F1 (ACC_STR,  NEW STRING(1..2) );
-      FUNCTION F IS NEW F1 (ACC_FLT,  NEW FLOAT);
- 
-      FUNCTION F RETURN ACC_NOTE IS
-      BEGIN
-           RETURN  (NEW NOTE);
-      END F;
-  
-      FUNCTION G IS NEW F1 (NEW_CHAR, 'G');
-      FUNCTION G IS NEW F1 (NEW_DUR,  1.0);
-      FUNCTION G IS NEW F1 (NEW_POS,  +10);
-      FUNCTION G IS NEW F1 (NEW_INT,  -10);
-      FUNCTION G IS NEW F1 (NEW_BOOL, TRUE);
-      FUNCTION G IS NEW F1 (NEW_FLT,  1.0);
-      FUNCTION G IS NEW F1 (NEW_NOTE, F);
-     
- BEGIN
-      TEST ("C87B41A","OVERLOADED CONSTRUCTS ON BOTH SIDES OF THE " &
-            "ASSIGNMENT STATEMENT");
-  
-      F.ALL := G;
-     
-      RESULT;
-  
- END C87B41A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b42a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b42a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b42a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b42a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C87B42A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- A CONDITIONAL EXPRESSION MUST BE OF A BOOLEAN TYPE.
-   
- -- TRH  27 JULY 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B42A IS
-  
-      TYPE BIT     IS NEW BOOLEAN;
-      TYPE BOOLEAN IS (FALSE, TRUE);
-      TYPE LIT     IS (FALSE, TRUE);
-      TYPE FLAG    IS (PASS, FAIL);
-  
-      GENERIC 
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS 
-      BEGIN
-           IF STAT = FAIL THEN 
-                FAILED ("CONDITIONAL EXPRESSION MUST BE OF A BOOLEAN" &
-                        " TYPE");
-           END IF;
-           RETURN ARG;
-      END F1;
-  
-      FUNCTION F IS NEW F1 (BOOLEAN, FALSE,  FAIL);
-      FUNCTION F IS NEW F1 (BIT,     FALSE,  PASS);
-      FUNCTION F IS NEW F1 (LIT,     FALSE,  FAIL);
-      FUNCTION F IS NEW F1 (INTEGER,   -11,  FAIL);
-      FUNCTION F IS NEW F1 (FLOAT,    +0.0,  FAIL);
-     
- BEGIN
-      TEST ("C87B42A","OVERLOADED CONDITIONAL EXPRESSIONS");
-  
-      WHILE (F OR NOT F)
-      LOOP
-           IF (F OR ELSE NOT F) THEN
-                NULL;
-           END IF;
-           EXIT WHEN (F AND NOT F);
-           EXIT WHEN (F OR  NOT F);
-           EXIT WHEN (F);
-           EXIT WHEN (NOT F);
-      END LOOP;
-  
-      RESULT;
- END C87B42A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b43a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b43a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b43a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b43a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- C87B43A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- IN A CASE STATEMENT, THE TYPE OF EACH CHOICE MUST MATCH THE TYPE 
- -- OF THE EXPRESSION.
-   
- -- TRH  3 AUG 82
- -- DSJ 10 JUN 83
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B43A IS
-      
-      TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-  
-      FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER 
-           RENAMES "*";
-  
-      ERR : BOOLEAN := FALSE;
-      X   : WHOLE   := 6;
-   
- BEGIN
-      TEST ("C87B43A","TYPE OF CASE CHOICE MUST MATCH TYPE OF " &
-            "EXPRESSION");
-    
-      CASE X IS
-           WHEN (2 + 3) => ERR := TRUE;
-           WHEN (3 + 3) => NULL; 
-           WHEN OTHERS  => ERR := TRUE;
-      END CASE;
-  
-      IF ERR THEN
-         FAILED ("CASE STATEMENT CHOICE MUST MATCH TYPE OF EXPRESSION");
-      END IF;
-     
-      RESULT;
- END C87B43A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b44a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b44a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b44a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b44a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C87B44A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE TYPE OF THE EXPRESSION IN A RETURN STATEMENT MUST MATCH THE
- -- EXPLICIT TYPEMARK IN THE RETURN CLAUSE OF THE FUNCTION'S
- -- SPECIFICATION.
- --
- -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
- -- 
- --    (A): A CALL TO AN OVERLOADED FUNCTION.
- --    (B): AN OVERLOADED OPERATOR SYMBOL.
- --    (C): AN OVERLOADED (INFIX) OPERATOR.
- --    (D): AN OVERLOADED ENUMERATION LITERAL.
-   
- -- TRH  25 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B44A IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-      
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION "*" (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END "*";
-     
-      FUNCTION "*" (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END "*";
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B44A","OVERLOADED EXPRESSIONS IN RETURN STATEMENTS");
-      DECLARE
- 
-           FUNCTION F2 (X, Y : INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN F1 (X, Y);
-           END F2;
-    
-           FUNCTION F2 (X, Y : WHOLE) RETURN WHOLE IS
-           BEGIN
-                RETURN "*" (X, Y);
-           END F2;
-    
-           FUNCTION F2 (X, Y : INTEGER) RETURN HUE IS
-           BEGIN
-                RETURN (X * Y);
-           END F2;
-    
-           FUNCTION F2 (X, Y : INTEGER) RETURN CITRUS IS
-           BEGIN
-                RETURN ORANGE;
-           END F2;
-    
- 
-      BEGIN
-           IF INTEGER'(F2 (0, 0)) /= -1 THEN
-              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
-           END IF;
-     
-           IF WHOLE'(F2 (0, 0)) /= 0 THEN
-              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
-           END IF;
-     
-           IF HUE'POS (F2 (0, 0)) /= 1 THEN 
-              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
-           END IF;
-     
-           IF CITRUS'POS (F2 (0, 0)) /= 2 THEN 
-              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
-           END IF;
-      END;
-     
-      RESULT;
- END C87B44A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b45a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b45a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b45a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b45a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- C87B45A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR A DEFAULT SUBPROGRAM PARAMETER, THE TYPE OF THE INITIALIZATION
- -- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
- --      
- -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
- -- 
- --    (A): A CALL TO AN OVERLOADED FUNCTION.
- --    (B): AN OVERLOADED OPERATOR SYMBOL.
- --    (C): AN OVERLOADED (INFIX) OPERATOR.
- --    (D): AN OVERLOADED ENUMERATION LITERAL.
-   
- -- TRH  24 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B45A IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-      
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END F1;
-     
-      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B45A","OVERLOADED INITIALIZATION EXPRESSIONS" &
-            " IN DEFAULT SUBPROGRAM PARAMETERS");
-      DECLARE
- 
-           FUNCTION "/" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES F1;
-     
-           FUNCTION "/" (X, Y : WHOLE)   RETURN WHOLE
-                RENAMES F1;
-      
-           FUNCTION "/" (X, Y : INTEGER) RETURN HUE
-                RENAMES F1;
-    
-           FUNCTION "/" (X, Y : INTEGER) RETURN CITRUS
-                RENAMES F1;
-       
-           PROCEDURE P1 (I1 : INTEGER := F1  (0, 0);
-                         W1 : WHOLE   := F1  (0, 0);
-                         C1 : CITRUS  := F1  (0, 0);
-                         H1 : HUE     := F1  (0, 0);
-                         I2 : INTEGER := "/" (0, 0);
-                         W2 : WHOLE   := "/" (0, 0);
-                         C2 : CITRUS  := "/" (0, 0);
-                         H2 : HUE     := "/" (0, 0);
-                         I3 : INTEGER := (0 / 0);
-                         W3 : WHOLE   := (0 / 0);
-                         C3 : CITRUS  := (0 / 0);
-                         H3 : HUE     := (0 / 0);
-                         C4 : CITRUS  := ORANGE;
-                         H4 : HUE     := ORANGE)  IS
-           BEGIN
-                IF I1              /= -1 OR W1           /= 0 OR
-                   CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
-                   FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
-                END IF;
-     
-                IF I2              /= -1 OR W2           /= 0 OR
-                   CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
-                   FAILED ("(B): RESOLUTION INCORRECT " &
-                           "- OPERATOR SYMBOL");
-                END IF;
-     
-                IF I3              /= -1 OR W3           /= 0 OR
-                   CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
-                   FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
-                END IF;
-     
-                IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
-                   FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION " &
-                           "LITERAL");
-                END IF;
-           END P1;
- 
-      BEGIN
-           P1;
-      END;
-     
-      RESULT;
- END C87B45A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b45c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b45c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b45c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b45c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- C87B45C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR A DEFAULT ENTRY PARAMETER, THE TYPE OF THE INITIALIZATION
- -- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
- --      
- -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
- -- 
- --    (A): A CALL TO AN OVERLOADED FUNCTION.
- --    (B): AN OVERLOADED OPERATOR SYMBOL.
- --    (C): AN OVERLOADED (INFIX) OPERATOR.
- --    (D): AN OVERLOADED ENUMERATION LITERAL.
-   
- -- TRH  7 JULY 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B45C IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-      
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END F1;
-     
-      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B45C","OVERLOADED INITIALIZATION EXPRESSIONS" &
-            " IN DEFAULT ENTRY PARAMETERS");
-      DECLARE
- 
-           FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES F1;
-     
-           FUNCTION "*" (X, Y : WHOLE)   RETURN WHOLE
-                RENAMES F1;
-      
-           FUNCTION "*" (X, Y : INTEGER) RETURN HUE
-                RENAMES F1;
-    
-           FUNCTION "*" (X, Y : INTEGER) RETURN CITRUS
-                RENAMES F1;
-       
-           TASK T1 IS
-                ENTRY E1 (I1 : INTEGER := F1  (0, 0);
-                          W1 : WHOLE   := F1  (0, 0);
-                          C1 : CITRUS  := F1  (0, 0);
-                          H1 : HUE     := F1  (0, 0);
-                          I2 : INTEGER := "*" (0, 0);
-                          W2 : WHOLE   := "*" (0, 0);
-                          C2 : CITRUS  := "*" (0, 0);
-                          H2 : HUE     := "*" (0, 0);
-                          I3 : INTEGER := (0 * 0);
-                          W3 : WHOLE   := (0 * 0);
-                          C3 : CITRUS  := (0 * 0);
-                          H3 : HUE     := (0 * 0);
-                          C4 : CITRUS  := ORANGE;
-                          H4 : HUE     := ORANGE);  
-           END T1;
-     
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E1 (I1 : INTEGER := F1  (0, 0);
-                           W1 : WHOLE   := F1  (0, 0);
-                           C1 : CITRUS  := F1  (0, 0);
-                           H1 : HUE     := F1  (0, 0);
-                           I2 : INTEGER := "*" (0, 0);
-                           W2 : WHOLE   := "*" (0, 0);
-                           C2 : CITRUS  := "*" (0, 0);
-                           H2 : HUE     := "*" (0, 0);
-                           I3 : INTEGER := (0 * 0);
-                           W3 : WHOLE   := (0 * 0);
-                           C3 : CITRUS  := (0 * 0);
-                           H3 : HUE     := (0 * 0);
-                           C4 : CITRUS  := ORANGE;
-                           H4 : HUE     := ORANGE) DO
-     
-                     IF I1              /= -1 OR W1           /= 0 OR
-                        CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
-                        FAILED ("(A): RESOLUTION INCORRECT - FUNCTION");
-                     END IF;
-     
-                     IF I2              /= -1 OR W2           /= 0 OR
-                        CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
-                        FAILED ("(B): RESOLUTION INCORRECT " &
-                                "- OPERATOR SYMBOL");
-                     END IF;
-     
-                     IF I3              /= -1 OR W3           /= 0 OR
-                        CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
-                        FAILED ("(C): RESOLUTION INCORRECT - INFIX " &
-                                "OPERATOR");
-                     END IF;
-     
-                     IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
-                        FAILED ("(D): RESOLUTION INCORRECT - " &
-                           "ENUMERATION LITERAL");
-                     END IF;
-    
-                END E1;
-           END T1;
- 
-      BEGIN
-           T1.E1;
-      END;
-     
-      RESULT;
- END C87B45C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b47a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b47a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b47a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b47a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C87B47A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- ACTUAL PARAMETERS MUST MATCH THE EXPLICIT TYPEMARK OF THE
- -- PARAMETER.
-   
- -- TRH  8 AUG 82
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B47A IS
-  
-      TYPE FLAG IS (PASS, FAIL);
-      
-      GENERIC
-           TYPE T IS PRIVATE;
-           ARG  : IN T;
-           STAT : IN FLAG;
-      FUNCTION F1 RETURN T;
-  
-      FUNCTION F1 RETURN T IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-              FAILED ("ACTUAL PARAMETER MUST MATCH PARAMETER TYPE");
-           END IF;
-           RETURN ARG;
-      END F1;
-   
-      FUNCTION F IS NEW F1 (FLOAT,     2.0, PASS);
-      FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
-      FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
-      FUNCTION F IS NEW F1 (DURATION,  1.0, FAIL);
-      FUNCTION F IS NEW F1 (CHARACTER, 'E', FAIL);
-     
- BEGIN
-      TEST ("C87B47A","OVERLOADED ACTUAL PARAMETERS");
-     
-      DECLARE
-           PROCEDURE P (X : FLOAT) IS
-           BEGIN
-                NULL;
-           END P;
-    
-      BEGIN
-           P (F);
-           P (X => F);
-      END;
-  
-      RESULT;
- END C87B47A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b48a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b48a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b48a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b48a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C87B48A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- NAMED ACTUAL PARAMETERS CAN RESOLVE OVERLOADING OF SUBPROGRAMS.
- -- THIS TEST USES FUNCTIONS AND OPERATOR SYMBOLS ONLY.
-   
- -- TRH  13 AUG 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B48A IS
-  
-      ERR, B1, B2 : BOOLEAN := FALSE;
-  
-      PACKAGE A IS
-           FUNCTION "-"    (X : BOOLEAN) RETURN BOOLEAN;
-           FUNCTION TOGGLE (X : BOOLEAN) RETURN BOOLEAN
-                RENAMES "-";
-      END A;
-      
-      PACKAGE BODY A IS
-           FUNCTION "-" (X : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                RETURN NOT X;
-           END "-";
-      END A;
-  
-      PACKAGE B IS
-           FUNCTION "-"    (Y : BOOLEAN) RETURN BOOLEAN;
-           FUNCTION TOGGLE (Y : BOOLEAN) RETURN BOOLEAN
-                RENAMES "-";
-      END B;
-      
-      PACKAGE BODY B IS
-           FUNCTION "-" (Y : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                ERR := TRUE;
-                RETURN NOT Y;
-           END "-";
-      END B;
-  
-      PACKAGE C IS
-           FUNCTION "-"    (Z : BOOLEAN) RETURN BOOLEAN;
-           FUNCTION TOGGLE (Z : BOOLEAN) RETURN BOOLEAN
-                RENAMES "-";
-      END C;
-      
-      PACKAGE BODY C IS
-           FUNCTION "-" (Z : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN
-                ERR := TRUE;
-                RETURN NOT Z;
-           END "-";
-      END C;
-    
-      USE A, B, C;
-  
- BEGIN
-      TEST ("C87B48A","RESOLUTION OF OVERLOADED SUBPROGRAMS BY NAMED " &
-            "ACTUAL PARAMETERS");
-  
-      B1 := "-"    (X => FALSE);
-      B2 := TOGGLE (X => FALSE);
-    
-      IF ERR OR ELSE NOT B1 OR ELSE NOT B2 THEN 
-           FAILED ("RESOLUTION INCORRECT FOR OVERLOADED SUBPROGRAMS" &
-                   " WITH NAMED ACTUAL PARAMETERS");
-      END IF;
-  
-      RESULT;
- END C87B48A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b48b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b48b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b48b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b48b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C87B48B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- POSITIONAL ACTUAL PARAMETERS CAN RESOLVE OVERLOADING OF SUBPROGRAMS.
-   
- -- TRH  16 AUG 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B48B IS
-  
-      TYPE FLAG IS (PASS, FAIL);
-      TYPE INT  IS NEW INTEGER;
-      TYPE BIT  IS NEW BOOLEAN;
-      TYPE WHL  IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      
-      GENERIC
-           TYPE T1 IS PRIVATE;
-           TYPE T2 IS PRIVATE;
-           TYPE T3 IS PRIVATE;
-           TYPE T4 IS PRIVATE;
-           STAT : IN FLAG;
-      PROCEDURE P1 (W : T1; X : T2; Y : T3; Z : T4);
-  
-      PROCEDURE P1 (W : T1; X : T2; Y : T3; Z : T4) IS
-      BEGIN 
-           IF STAT = FAIL THEN 
-                FAILED ("RESOLUTION INCORRECT FOR OVERLOADED SUB" &
-                        "PROGRAMS WITH POSITIONAL ACTUAL PARAMETERS");
-           END IF;
-      END P1;
-   
-      PROCEDURE P IS NEW P1 (WHL, INT, WHL, BIT, PASS);
-      PROCEDURE P IS NEW P1 (WHL, WHL, BIT, INT, FAIL);
-      PROCEDURE P IS NEW P1 (WHL, INT, BIT, WHL, FAIL);
-      PROCEDURE P IS NEW P1 (INT, BIT, WHL, WHL, FAIL);
-      PROCEDURE P IS NEW P1 (BIT, WHL, WHL, INT, FAIL);
-      PROCEDURE P IS NEW P1 (BIT, INT, WHL, WHL, FAIL);
-     
- BEGIN
-      TEST ("C87B48B","OVERLOADING RESOLUTION OF SUBPROGRAMS WITH" &
-            " POSITIONAL ACTUAL PARAMETERS");
-     
-      BEGIN
-           P (0, 0, 0, TRUE);
-      END;
-  
-      RESULT;
- END C87B48B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b50a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b50a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b50a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b50a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- C87B50A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A FUNCTION RENAMING DECLARATION CAN RESOLVE AND RENAME AN
- -- OVERLOADED ENUMERATION LITERAL.
- 
- -- GOM 11/29/84
- -- JWC 7/12/85
- -- PWB 03/06/86  CORRECTED ERROR: ADDED "USE" CLAUSE TO MAKE
- --               "/=" VISIBLE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C87B50A IS
- 
- BEGIN
-      TEST ("C87B50A", "CHECK THAT A FUNCTION RENAMING DECLARATION " &
-                       "CAN RESOLVE AND RENAME AN OVERLOADED " &
-                       "ENUMERATION LITERAL");
- 
-      DECLARE
- 
-           PACKAGE A IS
-                TYPE COLORS IS (RED,GREEN);
-                TYPE LIGHT  IS (BLUE,RED);
-           END A;
- 
-           PACKAGE B IS
-                FUNCTION RED RETURN A.COLORS RENAMES A.RED;
-                FUNCTION GREEN RETURN A.COLORS RENAMES A.GREEN;
-           END B;
- 
-           USE A;      -- TO MAKE /= VISIBLE.
- 
-      BEGIN
- 
-           IF (A.RED /= B.RED) OR (A.GREEN /= B.GREEN) THEN
-                FAILED ("RENAMED VALUES NOT EQUAL");
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C87B50A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b54a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b54a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b54a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b54a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C87B54A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- THE ARGUMENT OF THE DELAY STATEMENT IS OF THE PREDEFINED FIXED 
- -- POINT TYPE DURATION.
-   
- -- TRH  7 SEPT 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B54A IS
-  
-      TYPE TEMPS  IS NEW DURATION;
-      TYPE REAL   IS NEW FLOAT;
-      TYPE TEMPUS IS DELTA 0.1 RANGE -1.0 .. 1.0;
-      ERR : BOOLEAN := FALSE;
-  
-      FUNCTION F (X : TEMPS) RETURN TEMPS IS
-      BEGIN
-           ERR := TRUE;
-           RETURN X;
-      END F;
-     
-      FUNCTION F (X : REAL) RETURN REAL IS
-      BEGIN
-           ERR := TRUE;
-           RETURN X;
-      END F;
-  
-      FUNCTION F (X : TEMPUS) RETURN TEMPUS IS
-      BEGIN
-           ERR := TRUE;
-           RETURN X;
-      END F;
-     
-      FUNCTION F (X : DURATION) RETURN DURATION IS
-      BEGIN
-           RETURN X;
-      END F;
-     
- BEGIN
-      TEST ("C87B54A","OVERLOADED EXPRESSION WITHIN DELAY STATEMENT");
-     
-      DECLARE
-           TASK T IS
-                ENTRY E;
-           END T;
-   
-           TASK BODY T IS
-           BEGIN
-                DELAY F (0.0);
-                DELAY F (1.0);
-                DELAY F (-1.0);
-           END T;
-   
-      BEGIN
-           IF ERR THEN FAILED ("DELAY STATEMENT TAKES AN ARGUMENT OF " &
-                               "THE PREDEFINED FIXED POINT TYPE " &
-                               "DURATION");
-           END IF;
-      END;
-  
-      RESULT;
- END C87B54A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b57a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b57a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b57a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b57a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- C87B57A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- -- FOR A DEFAULT GENERIC IN PARAMETER, THE TYPE OF THE INITIALIZATION
- -- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
- --      
- -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
- -- 
- --    (A): A CALL TO AN OVERLOADED FUNCTION.
- --    (B): AN OVERLOADED OPERATOR SYMBOL.
- --    (C): AN OVERLOADED (INFIX) OPERATOR.
- --    (D): AN OVERLOADED ENUMERATION LITERAL.
-   
- -- TRH  25 JUNE 82
-   
- WITH REPORT; USE REPORT;
-    
- PROCEDURE C87B57A IS
-   
-      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
-      TYPE CITRUS IS (LEMON, LIME, ORANGE);
-      TYPE HUE    IS (RED, ORANGE, YELLOW);
-      
-      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN -1;
-      END F1;
- 
-      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
-      BEGIN
-           RETURN 0;
-      END F1;
-     
-      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
- 
-      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
-      BEGIN
-           RETURN ORANGE;
-      END F1;
-    
- BEGIN
-      TEST ("C87B57A","OVERLOADED INITIALIZATION EXPRESSIONS" &
-            " IN DEFAULT GENERIC IN PARAMETERS");
-      DECLARE
- 
-           FUNCTION "/" (X, Y : INTEGER) RETURN INTEGER
-                RENAMES F1;
-     
-           FUNCTION "/" (X, Y : WHOLE)   RETURN WHOLE
-                RENAMES F1;
-      
-           FUNCTION "/" (X, Y : INTEGER) RETURN HUE
-                RENAMES F1;
-    
-           FUNCTION "/" (X, Y : INTEGER) RETURN CITRUS
-                RENAMES F1;
-       
-           GENERIC
-                I1 : INTEGER := F1  (0, 0);
-                W1 : WHOLE   := F1  (0, 0);
-                C1 : CITRUS  := F1  (0, 0);
-                H1 : HUE     := F1  (0, 0);
-                I2 : INTEGER := "/" (0, 0);
-                W2 : WHOLE   := "/" (0, 0);
-                C2 : CITRUS  := "/" (0, 0);
-                H2 : HUE     := "/" (0, 0);
-                I3 : INTEGER := (0 / 0);
-                W3 : WHOLE   := (0 / 0);
-                C3 : CITRUS  := (0 / 0);
-                H3 : HUE     := (0 / 0);
-                C4 : CITRUS  := ORANGE;
-                H4 : HUE     := ORANGE;
-  
-           PACKAGE P IS
-           END P;
-   
-           PACKAGE BODY P IS
-           BEGIN
-                IF I1              /= -1 OR W1           /= 0 OR
-                   CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
-                   FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
-                END IF;
-     
-                IF I2              /= -1 OR W2           /= 0 OR
-                   CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
-                   FAILED ("(B): RESOLUTION INCORRECT " &
-                           "- OPERATOR SYMBOL");
-                END IF;
-     
-                IF I3              /= -1 OR W3           /= 0 OR
-                   CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
-                   FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
-                END IF;
-     
-                IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
-                   FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION " &
-                           "LITERAL");
-                END IF;
-           END P;
-   
-           PACKAGE P1 IS NEW P;
-   
-      BEGIN 
-           NULL;
-      END;
-     
-      RESULT;
- END C87B57A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- C87B62A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- --       IN A LENGTH CLAUSE THAT SPECIFIES 'SIZE,
- --       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
- 
- -- HISTORY:
- --     TRH 09/08/82  CREATED ORIGINAL TEST.
- --     PWB 02/19/85  ADDED COMMENTS CLARIFYING NON-APPLICABILITY;
- --                   DELETED TEXT NOT RELATED TO TEST OBJECTIVE.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C87B62A IS
- 
-      TYPE POS_INT IS RANGE 1 .. INTEGER'LAST;
-      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
-      ERR : BOOLEAN := FALSE;
- 
-      FUNCTION "+" (X : POS_INT) RETURN POS_FIX IS
-      BEGIN
-           ERR := TRUE;
-           RETURN POS_FIX (X);
-      END "+";
- 
-      FUNCTION "+" (X : POS_FIX) RETURN POS_INT IS
-      BEGIN
-           ERR := TRUE;
-           RETURN POS_INT (X);
-      END "+";
- 
- BEGIN
-      TEST ("C87B62A","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
-            "- SPECIFICATION OF ATTRIBUTE T'SIZE");
- 
-      DECLARE
-           TYPE DECEM IS NEW INTEGER RANGE    1 .. 10;
-           TYPE JUST_LIKE_DECEM IS NEW INTEGER RANGE 1 .. 10;
-           DECEM_SIZE :  CONSTANT  := JUST_LIKE_DECEM'SIZE;
-           TYPE CHECK IS NEW INTEGER RANGE 1 .. 10;
- 
-           FOR CHECK'SIZE USE DECEM_SIZE;
-           FOR DECEM'SIZE        USE + DECEM_SIZE;
- 
-      BEGIN
-           IF ERR THEN
-                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
-                        "LENGTH CLAUSE USING 'SIZE");
-           END IF;
-      END;
- 
-      RESULT;
- END C87B62A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C87B62B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- --       IN A LENGTH CLAUSE THAT SPECIFIES 'STORAGE_SIZE,
- --       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
- --       ACCESS TYPES ARE HERE; TASK TYPES ARE IN C87B62D.DEP.
- 
- -- HISTORY:
- --     TRH 09/08/82  CREATED ORIGINAL TEST.
- --     EG  06/04/84
- --     PWB 01/19/86  CLARIFIED COMMENTS REGARDING NON-APPLICABILITY;
- --                   REMOVED TEXT NOT RELATED TO TEST OBJECTIVE
- --                   MOVED TASK TYPES TO C87B62D.DEP.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C87B62B IS
- 
-      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
-      TYPE POS_INT IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      TYPE NUMERAL IS NEW CHARACTER RANGE '0' .. '9';
-      TYPE BASE_5  IS ('0', '1', '2', '3', '4');
-      ERR : BOOLEAN := FALSE;
- 
-      FUNCTION F (X : INTEGER) RETURN NUMERAL IS
-      BEGIN
-           ERR := TRUE;
-           RETURN ('9');
-      END F;
- 
-      FUNCTION F (X : INTEGER) RETURN BASE_5 IS
-      BEGIN
-           ERR := TRUE;
-           RETURN ('4');
-      END F;
- 
-      FUNCTION F (X : INTEGER) RETURN POS_FIX IS
-      BEGIN
-           ERR := TRUE;
-           RETURN POS_FIX (X);
-      END F;
- 
-      FUNCTION F (X : INTEGER) RETURN POS_INT IS
-      BEGIN
-           RETURN POS_INT (X);
-      END F;
- 
- BEGIN
-      TEST ("C87B62B","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
-                      "- SPECIFICATION OF ATTRIBUTE T'STORAGE_SIZE " &
-                      "FOR ACCESS TYPES");
- 
-      DECLARE
- 
-           TYPE DECEM IS NEW INTEGER RANGE    1 .. 10;
-           TYPE LINK  IS ACCESS DECEM;
- 
-           TYPE JUST_LIKE_LINK IS ACCESS DECEM;
-           TYPE CHECK IS ACCESS DECEM;
- 
-           FOR CHECK'STORAGE_SIZE
-                USE 1024;
-           FOR LINK'STORAGE_SIZE USE F (1024);
- 
-      BEGIN
-           IF ERR THEN
-                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
-                        "LENGTH CLAUSE USING 'STORAGE_SIZE");
-           END IF;
-      END;
- 
-      RESULT;
- END C87B62B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C87B62C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- --       IN A LENGTH CLAUSE THAT SPECIFIES 'SMALL, THE EXPRESSION
- --       MUST BE OF SOME REAL TYPE.
- 
- -- HISTORY:
- --     TRH 09/08/82  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED COMMENTS TO CLARIFY NON-APPLICABILITY;
- --                   REMOVED TEXT NOT RELATED TO TEST OBJECTIVE.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C87B62C IS
- 
-      TYPE POS_INT IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
-      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
-      ERR : BOOLEAN := FALSE;
- 
-      FUNCTION "+" (X : POS_INT) RETURN POS_FIX IS
-      BEGIN
-           ERR := TRUE;
-           RETURN POS_FIX (X);
-      END "+";
- 
-      FUNCTION "+" (X : POS_FIX) RETURN POS_INT IS
-      BEGIN
-           ERR := TRUE;
-           RETURN POS_INT (X);
-      END "+";
- 
- BEGIN
-      TEST ("C87B62C","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
-            "- SPECIFICATION OF ATTRIBUTE T'SMALL");
- 
-      DECLARE
-           TYPE JUST_LIKE_FIXED IS DELTA 0.1 RANGE -1.0 .. 1.0;
-           TYPE FIXED IS DELTA 0.1   RANGE -1.0 .. 1.0;
- 
-           FIKST_SMALL : CONSTANT := JUST_LIKE_FIXED'SMALL;
-           TYPE CHECK IS DELTA 0.1 RANGE -1.0 .. 1.0;
- 
-           FOR CHECK'SMALL USE FIKST_SMALL;
-           FOR FIXED'SMALL       USE + FIKST_SMALL;
- 
-      BEGIN
-           IF ERR THEN
-                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
-                        "LENGTH CLAUSE USING 'SMALL");
-           END IF;
-      END;
- 
-      RESULT;
- END C87B62C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62d.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c8/c87b62d.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c8/c87b62d.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C87B62D.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
- --
- --       IN A LENGTH CLAUSE THAT SPECIFIES 'STORAGE_SIZE,
- --       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
- --       TASK TYPE IS HERE; ACCESS TYPE IS IN C87B62B.DEP.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY:
- --     TRH 09/08/82  CREATED ORIGINAL TEST.
- --     EG  06/04/84
- --     PWB 01/19/86  CREATED THIS TEST FILE FROM THE TASK TYPE PART
- --                   OF THE OLD C87B62B;
- --                   CLARIFIED COMMENTS REGARDING NON-APPLICABILITY.
- --     BCB 01/04/88  MODIFIED HEADER.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.TST'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C87B62D IS
- 
-      TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
-      TYPE POS_INT IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
-      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
-      TYPE NUMERAL IS NEW CHARACTER RANGE '0' .. '9';
-      TYPE BASE_5  IS ('0', '1', '2', '3', '4');
-      ERR : BOOLEAN := FALSE;
- 
-      FUNCTION F (X : INTEGER) RETURN NUMERAL IS
-      BEGIN
-           ERR := TRUE;
-           RETURN ('9');
-      END F;
- 
-      FUNCTION F (X : INTEGER) RETURN BASE_5 IS
-      BEGIN
-           ERR := TRUE;
-           RETURN ('4');
-      END F;
- 
-      FUNCTION F (X : INTEGER) RETURN POS_FIX IS
-      BEGIN
-           ERR := TRUE;
-           RETURN POS_FIX (X);
-      END F;
- 
-      FUNCTION F (X : INTEGER) RETURN POS_INT IS
-      BEGIN
-           RETURN POS_INT (X);
-      END F;
- 
- BEGIN
-      TEST ("C87B62D","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
-            "- SPECIFICATION OF ATTRIBUTE T'STORAGE_SIZE " &
-            "FOR TASK TYPES ");
- 
-      DECLARE
- 
-           TASK TYPE TSK1  IS
-           END TSK1;
- 
-           FOR TSK1'STORAGE_SIZE USE F (TASK_STORAGE_SIZE);
- 
-           TASK BODY TSK1 IS
-           BEGIN
-                NULL;
-           END TSK1;
- 
-      BEGIN
-           IF ERR THEN
-                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
-                        "LENGTH CLAUSE USING 'STORAGE_SIZE");
-           END IF;
-      END;
- 
-      RESULT;
- END C87B62D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c910001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c910001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c910001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c910001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,224 ****
- -- C910001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that tasks may have discriminants.  Specifically, check where
- --      the subtype of the discriminant is a discrete subtype and where it is
- --      an access subtype.  Check the case where the default values of the
- --      discriminants are used.
- --
- -- TEST DESCRIPTION:
- --      A task is defined with two discriminants, one a discrete subtype and
- --      another that is an access subtype.  Tasks are created with various
- --      values for discriminants and code within the task checks that these
- --      are passed in correctly.  One instance of a default is used.  The
- --      values passed to the task as the discriminants are taken from an
- --      array of test data and the values received are checked against the
- --      same array.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- 
- procedure C910001 is
-  
- 
-    type App_Priority is range 1..10;
-    Default_Priority : App_Priority := 5;
- 
-    type Message_ID is range 1..10_000; 
- 
-    type TC_Number_of_Messages is range 1..5;
- 
-    type TC_rec is record
-       TC_ID       : Message_ID;
-       A_Priority  : App_Priority;
-       TC_Checked  : Boolean;
-    end record;
- 
-    -- This table is used to create the messages and to check them
-    TC_table : array (1..TC_Number_of_Messages'Last) of TC_Rec := 
-                               (  ( 10, 6, false ),
-                                  ( 20, 2, false ),
-                                  ( 30, 9, false ),
-                                  ( 40, 1, false ),
-                                  ( 50, Default_Priority, false ) );
- 
- begin -- C910001
- 
-    Report.Test ("C910001", "Check that tasks may have discriminants");
- 
-       
-    declare     -- encapsulate the test
- 
-       type Transaction_Record is 
-          record
-             ID               : Message_ID;
-             Account_Number   : integer := 0;
-             Stock_Number     : integer := 0;
-             Quantity         : integer := 0;
-             Return_Value     : integer := 0;
-          end record;
-       -- 
-       type acc_Transaction_Record is access Transaction_Record;
- 
- 
-       task type Message_Task
-                    (In_Message  : acc_Transaction_Record := null;
-                     In_Priority : App_Priority := Default_Priority) is
-          entry Start;
-       end Message_Task;
-       type acc_Message_Task is access Message_Task;
-       --
-       --
-       task body Message_Task is
-          This_Message   : acc_Transaction_Record := In_Message;
-          This_Priority  : App_Priority           := In_Priority; 
-          TC_Match_Found : Boolean                := false;
-       begin 
-          accept Start;
-          -- In the example envisioned this task would then queue itself
-          -- upon some Distributor task which would send it off (requeue) to
-          -- the message processing tasks according to the priority of the 
-          -- message and the current load on the system.  For the test we
-          -- just verify the data passed in as discriminants and exit the task
-          -- 
-          -- Check for the special case of default discriminants
-          if This_Message = null then
-             -- The default In_Message has been passed, check that the
-             -- default priority was also passed
-             if This_Priority /= Default_Priority then
-                Report.Failed ("Incorrect Default Priority");
-             end if;
-             if TC_Table (TC_Number_of_Messages'Last).TC_Checked then
-                Report.Failed ("Duplicate Default messages");
-             else
-                -- Mark that default has been seen
-                TC_Table (TC_Number_of_Messages'Last).TC_Checked := True;
-             end if; 
-             TC_Match_Found := true;
-          else
-             -- Check the data against the table
-             for i in TC_Number_of_Messages loop
-                if TC_Table(i).TC_ID = This_Message.ID then
-                   -- this is the right slot in the table
-                   if TC_Table(i).TC_checked then
-                      -- Already checked
-                      Report.Failed ("Duplicate Data");
-                   else 
-                      TC_Table(i).TC_checked := true;
-                   end if;
-                   TC_Match_Found := true;
-                   if TC_Table(i).A_Priority /= This_Priority then
-                      Report.Failed ("ID/Priority mismatch");
-                   end if;
-                   exit;
-                end if;
-             end loop;
-          end if;
- 
-          if not TC_Match_Found then
-             Report.Failed ("No ID match in table");
-          end if;
- 
-          -- Allow the task to terminate
- 
-       end Message_Task;
- 
- 
-       -- The Line Driver task accepts data from an external source and 
-       -- builds them into a transaction record.  It then generates a
-       -- message task.  This message "contains" the record and is given 
-       -- a priority according to the contents of the message.  The priority 
-       -- and transaction records are passed to the task as discriminants.
-       --    In this test we use a dummy record.  Only the ID is of interest 
-       --    so we pick that and the required priority from an array of 
-       --    test data.  We artificially limit the endless driver-loop to 
-       --    the number of messages required for the test and add a special
-       --    case to check the defaults.
-       --
-       task Driver_Task;
-       --
-       task body Driver_Task is
-       begin
- 
-          -- Create all but one of the required tasks
-          --
-          for i in 1..TC_Number_of_Messages'Last - 1   loop
-             declare
-                -- Create a record for the next message
-                Next_Transaction : acc_Transaction_Record := 
-                                                 new Transaction_Record;
-                -- Create a task for the next message
-                Next_Message_Task : acc_Message_Task := 
-                                  new Message_Task( Next_Transaction,  
-                                                    TC_Table(i).A_Priority );
- 
-             begin
-                -- Artificially plug the ID with the next from the table
-                --    In reality the whole record would be built here
-                Next_Transaction.ID := TC_Table(i).TC_ID;
-                
-                -- Ensure the task does not start executing till the 
-                -- transaction record is properly constructed
-                Next_Message_Task.Start;
- 
-             end;  -- declare
-          end loop;
- 
-          -- For this subtest create one task with the default discriminants
-          --
-          declare 
- 
-             -- Create the task 
-             Next_Message_Task : acc_Message_Task := new Message_Task;
- 
-          begin
-             
-             Next_Message_Task.Start;
- 
-          end; -- declare
- 
- 
-       end Driver_Task;
- 
-    begin    
-       null;
-    end;     -- encapsulation
- 
-    -- Now verify that all the tasks executed and checked in
-    for i in TC_Number_of_Messages loop
-       if not TC_Table(i).TC_Checked then 
-          Report.Failed 
-                  ("Task" & integer'image(integer (i) ) & " did not verify");
-       end if;
-    end loop; 
-    Report.Result;
- 
- end C910001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c910002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c910002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c910002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c910002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,143 ****
- -- C910002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the contents of a task object include the values
- --      of its discriminants.
- --      Check that selected_component notation can be used to
- --      denote a discriminant of a task.
- --
- -- TEST DESCRIPTION:
- --      This test declares a task type that contains discriminants.
- --      Objects of the task type are created with different values.
- --      The task type has nested tasks that are used to check that
- --      the discriminate values are the expected values.
- --      Note that the names of the discriminants in the body of task
- --      type DTT denote the current instance of the unit.
- --
- --
- -- CHANGE HISTORY:
- --      12 OCT 95   SAIC    Initial release for 2.1
- --       8 MAY 96   SAIC    Incorporated Reviewer comments.
- --
- --!
- 
- 
- with Report;
- procedure C910002 is
-   Verbose : constant Boolean := False;
- begin
-   Report.Test ("C910002",
-                "Check that selected_component notation can be" &
-                " used to access task discriminants");
-   declare
- 
-     task type DTT
-          (IA, IB : Integer;
-           CA, CB : Character) is
-       entry Check_Values (First_Int : Integer;
-                           First_Char : Character);
-     end DTT;
- 
-     task body DTT is
-        Int1 : Integer;
-        Char1 : Character;
- 
-        -- simple nested task to check the character values
-        task Check_Chars is
-           entry Start_Check;
-        end Check_Chars;
-        task body Check_Chars is
-        begin
-           accept Start_Check;
-           if DTT.CA /= Char1 or
-              DTT.CB /= Character'Succ (Char1) then
-             Report.Failed ("character check failed.  Expected: '" &
-                      Char1 & Character'Succ (Char1) &
-                      "' but found '" &
-                      DTT.CA & DTT.CB & "'");
-           elsif Verbose then
-             Report.Comment ("char check for " & Char1);
-           end if;
-        exception
-           when others => Report.Failed ("exception in Check_Chars");
-        end Check_Chars;
- 
-        -- use a discriminated task to check the integer values
-        task type Check_Ints (First : Integer);
-        task body Check_Ints is
-        begin
-           if DTT.IA /= Check_Ints.First or
-              IB     /= First+1 then
-             Report.Failed ("integer check failed.  Expected:" &
-                      Integer'Image (Check_Ints.First) & 
-                      Integer'Image (First+1) &
-                      " but found" &
-                      Integer'Image (DTT.IA) & Integer'Image (IB) );
-           elsif Verbose then
-             Report.Comment ("int check for" & Integer'Image (First));
-           end if;
-        exception
-           when others => Report.Failed ("exception in Check_Ints");
-        end Check_Ints;
-     begin
-       accept Check_Values (First_Int : Integer;
-                            First_Char : Character) do
-         Int1 := First_Int;
-         Char1 := First_Char;
-       end Check_Values;
- 
-       -- kick off the character check
-       Check_Chars.Start_Check;
- 
-       -- do the integer check
-       declare
-          Int_Checker : Check_Ints (Int1);
-       begin
-         null;  -- let task do its thing
-       end;
- 
-       -- do one test here too
-       if DTT.IA /= Int1 then
-         Report.Failed ("DTT check failed.  Expected:" &
-               Integer'Image (Int1) &
-               " but found:" &
-               Integer'Image (DTT.IA));
-       elsif Verbose then
-         Report.Comment ("DTT check for" & Integer'Image (Int1));
-       end if;
-     exception
-       when others => Report.Failed ("exception in DTT");
-     end DTT;
- 
-     T1a : DTT (1,  2, 'a', 'b');
-     T9C : DTT (9, 10, 'C', 'D');
-   begin   -- test encapsulation
-     T1a.Check_Values (1, 'a');
-     T9C.Check_Values (9, 'C');
-   end;
- 
-   Report.Result;
- end C910002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c910003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c910003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c910003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c910003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,185 ****
- -- C910003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that task discriminants that have an access subtype may be
- --      dereferenced.
- --
- --      Note that discriminants in Ada 83 never can be dereferenced with
- --      selection or indexing, as they cannot have an access type.
- --
- -- TEST DESCRIPTION:
- --      A protected object is defined to create a simple buffer.
- --      Two task types are defined, one to put values into the buffer,
- --      and one to remove them. The tasks are passed a buffer object as
- --      a discriminant with an access subtype. The producer task type includes
- --      a discriminant to determine the values to product. The consumer task
- --      type includes a value to save the results.
- --      Two producer and one consumer tasks are declared, and the results
- --      are checked.
- --
- -- CHANGE HISTORY:
- --      10 Mar 99   RLB    Created test.
- --
- --!
- 
- package C910003_Pack is
- 
-     type Item_Type is range 1 .. 100; -- In a real application, this probably
-                                       -- would be a record type.
- 
-     type Item_Array is array (Positive range <>) of Item_Type;
- 
-     protected type Buffer is
-        entry Put (Item  : in Item_Type);
-        entry Get (Item  : out Item_Type);
-        function TC_Items_Buffered return Item_Array;
-     private
-        Saved_Item : Item_Type;
-        Empty : Boolean := True;
-        TC_Items : Item_Array (1 .. 10);
-        TC_Last  : Natural := 0;
-     end Buffer;
- 
-     type Buffer_Access_Type is access Buffer;
- 
-     PRODUCE_COUNT : constant := 2; -- Number of items to produce.
- 
-     task type Producer (Buffer_Access : Buffer_Access_Type;
-                         Start_At : Item_Type);
-         -- Produces PRODUCE_COUNT items. Starts when activated.
- 
-     type TC_Item_Array_Access_Type is access Item_Array (1 .. PRODUCE_COUNT*2);
- 
-     task type Consumer (Buffer_Access : Buffer_Access_Type;
-                         Results : TC_Item_Array_Access_Type) is
-         -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
-         -- activated.
-         entry Wait_until_Done;
-     end Consumer;
- 
- end C910003_Pack;
- 
- 
- with Report;
- package body C910003_Pack is
- 
-     protected body Buffer is
-        entry Put (Item  : in Item_Type) when Empty is
-        begin
-            Empty := False;
-            Saved_Item := Item;
-            TC_Last := TC_Last + 1;
-            TC_Items(TC_Last) := Item;
-        end Put;
- 
-        entry Get (Item  : out Item_Type) when not Empty is
-        begin
-            Empty := True;
-            Item := Saved_Item;
-        end Get;
- 
-        function TC_Items_Buffered return Item_Array is
-        begin
-            return TC_Items(1..TC_Last);
-        end TC_Items_Buffered;
- 
-     end Buffer;
- 
- 
-     task body Producer is
-         -- Produces PRODUCE_COUNT items. Starts when activated.
-     begin
-         for I in 1 .. Report.Ident_Int(PRODUCE_COUNT) loop
-            Buffer_Access.Put (Start_At + (Item_Type(I)-1)*2);
-         end loop;
-     end Producer;
- 
- 
-     task body Consumer is
-         -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
-         -- activated.
-     begin
-         for I in 1 .. Report.Ident_Int(PRODUCE_COUNT*2) loop
-             Buffer_Access.Get (Results (I));
-             -- Buffer_Access and Results are both dereferenced.
-         end loop;
- 
-         -- Check the results (and function call with a prefix dereference).
-         if Results.all(Report.Ident_Int(1)) /= Buffer_Access.all.TC_Items_Buffered(Report.Ident_Int(1)) then
-            Report.Failed ("First item mismatch");
-         end if;
-         if Results(Report.Ident_Int(2)) /= Buffer_Access.TC_Items_Buffered(Report.Ident_Int(2)) then
-            Report.Failed ("Second item mismatch");
-         end if;
-         accept Wait_until_Done; -- Tell main that we're done.
-     end Consumer;
- 
- end C910003_Pack;
- 
- 
- with Report;
- with C910003_Pack;
- 
- procedure C910003 is
- 
- begin -- C910003
- 
-    Report.Test ("C910003", "Check that tasks discriminants of access types can be dereferenced");
- 
- 
-    declare     -- encapsulate the test
- 
-       Buffer_Access : C910003_Pack.Buffer_Access_Type :=
-          new C910003_Pack.Buffer;
- 
-       TC_Results : C910003_Pack.TC_Item_Array_Access_Type :=
-          new C910003_Pack.Item_Array (1 .. C910003_Pack.PRODUCE_COUNT*2);
- 
-       Producer_1 : C910003_Pack.Producer (Buffer_Access, 12);
-       Producer_2 : C910003_Pack.Producer (Buffer_Access, 23);
- 
-       Consumer : C910003_Pack.Consumer (Buffer_Access, TC_Results);
- 
-       use type C910003_Pack.Item_Array; -- For /=.
- 
-    begin
-       Consumer.Wait_until_Done;
-       if TC_Results.all /= Buffer_Access.TC_Items_Buffered then
-            Report.Failed ("Different items buffered than returned - Main");
-       end if;
-       if (TC_Results.all /= (12, 14, 23, 25) and
-           TC_Results.all /= (12, 23, 14, 25) and
-           TC_Results.all /= (12, 23, 25, 14) and
-           TC_Results.all /= (23, 12, 14, 25) and
-           TC_Results.all /= (23, 12, 25, 14) and
-           TC_Results.all /= (23, 25, 12, 14)) then
-           -- Above are the only legal results.
-            Report.Failed ("Wrong results");
-       end if;
-    end;     -- encapsulation
- 
-    Report.Result;
- 
- end C910003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91004b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91004b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91004b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C91004B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A TASK (TYPE) IDENTIFIER, WHEN USED WITHIN ITS OWN
- --     BODY, REFERS TO THE EXECUTING TASK.
- 
- --      TEST USING IDENTIFIER IN ABORT STATEMENT, AS AN EXPRESSION IN
- --      A MEMBERSHIP TEST, AND THE PREFIX OF 'CALLABLE AND
- --      'TERMINATED.
- 
- -- HISTORY:
- --     WEI  3/ 4/82  CREATED ORIGINAL TEST.
- --     RJW 11/13/87  RENAMED TEST FROM C910BDA.ADA.  ADDED CHECKS FOR
- --                   MEMBERSHIP TEST, AND 'CALLABLE AND 'TERMINATED
- --                   ATTRIBUTES.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C91004B IS
- 
-      TYPE I0 IS RANGE 0..1;
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      TASK TYPE TT1 IS
-           ENTRY E1 (P1 : IN I0; P2 : ARG);
-           ENTRY BYE;
-      END TT1;
- 
-      SUBTYPE SUB_TT1 IS TT1;
- 
-      OBJ_TT1 : ARRAY (NATURAL RANGE 1..2) OF TT1;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
-      TASK BODY TT1 IS
-      BEGIN
-           IF TT1 NOT IN SUB_TT1 THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST");
-           END IF;
- 
-           IF NOT TT1'CALLABLE THEN
-                FAILED ("INCORRECT RESULTS FOR 'CALLABLE");
-           END IF;
- 
-           IF TT1'TERMINATED THEN
-                FAILED ("INCORRECT RESULTS FOR 'TERMINATED");
-           END IF;
- 
-           ACCEPT E1 (P1 : IN I0; P2 : ARG) DO
-                IF P1 = 1 THEN
-                     ABORT TT1;
-                     ACCEPT BYE;    -- WILL DEADLOCK IF NOT ABORTED.
-                END IF;
-                PSPY_NUMB (ARG (P2));
-           END E1;
- 
-      END TT1;
- 
- BEGIN
- 
-      TEST ("C91004B", "TASK IDENTIFIER IN OWN BODY");
- 
-      BEGIN
-           OBJ_TT1 (1).E1 (1,1);
-           FAILED ("NO TASKING_ERROR RAISED");
- -- ABORT DURING RENDEVOUS RAISES TASKING ERROR
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-      END;
- 
-      OBJ_TT1 (2).E1 (0,2);
- 
-      IF SPYNUMB /= 2 THEN
-           FAILED ("WRONG TASK OBJECT REFERENCED");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C91004B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91004c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91004c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91004c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C91004C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK (TYPE) IDENTIFIER, WHEN USED WITHIN ITS OWN BODY
- -- REFERS TO THE EXECUTING TASK.
- --
- -- TEST USING CONDITIONAL ENTRY CALL.
- 
- -- WEI  3/ 4/82
- -- TLB 10/30/87  RENAMED FROM C910BDB.ADA.
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C91004C IS
- 
-      TASK TYPE TT1 IS
-           ENTRY E1;
-           ENTRY BYE;
-      END TT1;
- 
-      OBJ_TT1 : ARRAY (NATURAL RANGE 1..2) OF TT1;
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
-      TASK BODY TT1 IS
-      BEGIN
-           ACCEPT E1 DO
-                PSPY_NUMB (1);
-           END E1;
- 
-           SELECT
-                TT1.E1;
-           ELSE
-                PSPY_NUMB (2);
-           END SELECT;
- 
-           ACCEPT BYE;
-      END TT1;
- 
- BEGIN
- 
-      TEST ("C91004C", "TASK IDENTIFIER IN OWN BODY");
-      OBJ_TT1 (1).E1;
-      OBJ_TT1 (1).BYE;
- 
-      IF SPYNUMB /=12 THEN
-           FAILED ("WRONG TASK OBJECT REFERENCED");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      ABORT OBJ_TT1 (2);
- 
-      RESULT;
- 
- END C91004C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C91006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IN A TASK SPECIFICATION ENTRY DECLARATIONS ARE ELABORATED
- -- WHEN THE SPECIFICATION IS ELABORATED, AND IN TEXTUAL ORDER.
- 
- -- WEI  3/04/82
- -- BHS  7/13/84
- -- TBN 12/17/85     RENAMED FROM C910AHA-B.ADA;
- --                  ADDED DECLARATIONS OF FIRST AND LAST.
- -- PWB  5/15/86     MOVED DECLARATIONS OF FIRST, TASK T1, AND LAST
- --                  INTO A DECLARE/BEGIN/END BLOCK.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C91006A IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      INDEX : INTEGER RANGE 0..5 := 0;
-      SPYNUMB : STRING(1..5) := (1..5 => ' ');
- 
-      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
-           TEMP : STRING(1..2);
-      BEGIN
-           TEMP := ARG'IMAGE(DIGT);
-           INDEX := INDEX + 1;
-           SPYNUMB(INDEX) := TEMP(2);
-           RETURN DIGT;
-      END FINIT_POS;
- 
- BEGIN
-      TEST ("C91006A", "CHECK THAT IN A TASK SPEC, ELABORATION IS IN " &
-                       "TEXTUAL ORDER");
-      DECLARE
- 
-           FIRST : INTEGER := FINIT_POS (1);
- 
-           TASK T1 IS
-                ENTRY E2 (NATURAL RANGE 1 .. FINIT_POS (2));
-                ENTRY E3 (NATURAL RANGE 1 .. FINIT_POS (3));
-                ENTRY E4 (NATURAL RANGE 1 .. FINIT_POS (4));
-           END T1;
- 
-           LAST : INTEGER := FINIT_POS (5);
- 
-           TASK BODY T1 IS
-           BEGIN
-                NULL;
-           END T1;
- 
-      BEGIN
-            NULL;
-      END;
- 
-      IF SPYNUMB /= "12345" THEN 
-           FAILED ("TASK SPEC T1 NOT ELABORATED IN TEXTUAL ORDER");
-           COMMENT ("ACTUAL ORDER WAS: " & SPYNUMB);
-      END IF;
- 
-      RESULT;
- 
- END C91006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c91007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c91007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C91007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IF THE ELABORATION OF AN ENTRY DECLARATION RAISES
- --     "CONSTRAINT_ERROR", THEN NO TASKS ARE ACTIVATED, AND
- --     "TASKING_ERROR" IS NOT RAISED.
- 
- -- HISTORY:
- --     LDC 06/17/88  CREATED ORGINAL TEST
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE C91007A IS
- 
-      TYPE ENUM IS (TERESA, BRIAN, PHIL, JOLEEN, LYNN, DOUG, JODIE,
-                    VINCE, TOM, DAVE, JOHN, ROSA);
-      SUBTYPE ENUM_SUB IS ENUM RANGE BRIAN..LYNN;
- 
- BEGIN
-      TEST("C91007A","IF THE ELABORATION OF AN ENTRY DECLARATION " &
-                     "RAISES 'CONSTRAINT_ERROR', THEN NO TASKS ARE " &
-                     "ACTIVATED, AND 'TASKING_ERROR' IS NOT RAISED");
- 
-      BEGIN
-           DECLARE
-                TASK TYPE TSK1;
-                T1 : TSK1;
-                TASK BODY TSK1 IS
-                BEGIN
-                     FAILED("TSK1 WAS ACTIVATED");
-                END TSK1;
- 
- 
-                TASK TSK2 IS
-                     ENTRY ENT(ENUM_SUB RANGE TERESA..LYNN);
-                END TSK2;
- 
-                TASK BODY TSK2 IS
-                BEGIN
-                     FAILED("TASK BODY WAS ACTIVATED");
-                END TSK2;
- 
-                TASK TSK3;
-                TASK BODY TSK3 IS
-                BEGIN
-                     FAILED("TSK3 WAS ACTIVATED");
-                END TSK3;
- 
-           BEGIN
-                NULL;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("CONSTRAINT_ERROR WAS RAISED IN THE " &
-                            "BEGIN BLOCK");
-                WHEN TASKING_ERROR =>
-                     FAILED("TASKING_ERROR WAS RAISED INSTEAD OF " &
-                            "CONSTRAINT_ERROR IN THE BEGIN BLOCK");
-                WHEN OTHERS =>
-                     FAILED("OTHER EXCEPTION WAS RAISED IN " &
-                            "THE BEGIN BLOCK");
-           END;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN TASKING_ERROR =>
-                FAILED("TASKING_ERROR WAS RAISED INSTEAD OF " &
-                       "CONSTRAINT_ERROR");
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION WAS RAISED");
-      END;
- 
-      RESULT;
- 
- END C91007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C92002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ASSIGNMENT TO A COMPONENT (FOR WHICH ASSIGNMENT IS
- --   AVAILABLE) OF A RECORD CONTAINING A TASK IS AVAILABLE.
- 
- -- JRK 9/17/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C92002A IS
- 
- BEGIN
-      TEST ("C92002A", "CHECK THAT CAN ASSIGN TO ASSIGNABLE " &
-                       "COMPONENTS OF RECORDS WITH TASK " &
-                       "COMPONENTS");
- 
-      DECLARE
- 
-           TASK TYPE TT IS
-                ENTRY E;
-           END TT;
- 
-           TYPE RT IS
-                RECORD
-                     I : INTEGER := 0;
-                     T : TT;
-                     J : INTEGER := 0;
-                END RECORD;
- 
-           R : RT;
- 
-           TASK BODY TT IS
-           BEGIN
-                NULL;
-           END TT;
- 
-      BEGIN
- 
-           R.I := IDENT_INT (7);
-           R.J := IDENT_INT (9);
- 
-           IF R.I /= 7 AND R.J /= 9 THEN
-                FAILED ("WRONG VALUE(S) WHEN ASSIGNING TO " &
-                        "INTEGER COMPONENTS OF RECORDS WITH " &
-                        "TASK COMPONENTS");
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C92002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C92003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK CAN BE PASSED AS AN ACTUAL IN OR IN OUT PARAMETER
- -- IN A SUBPROGRAM CALL AND THAT THE ACTUAL AND FORMAL PARAMETERS DENOTE
- -- THE SAME TASK OBJECT.
- 
- -- JRK  1/17/81
- -- TBN 12/19/85  ADDED IN OUT PARAMETER CASE.
- -- PWB  8/04/86  ADDED CHECK THAT FORMAL AND ACTUAL PARAMETERS DENOTE
- --               THE SAME TASK OBJECT.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C92003A IS
- 
- BEGIN
- 
-      TEST ("C92003A", "CHECK TASKS PASSED AS ACTUAL IN OR IN OUT " &
-                        "PARAMETERS TO SUBPROGRAMS");
- 
-      DECLARE
- 
-           TASK TYPE TT IS
-                ENTRY E (I : INTEGER);
-           END TT;
- 
-           T, S : TT;
- 
-           TASK BODY TT IS
-                SOURCE : INTEGER;
-           BEGIN
- 
-                SELECT
-                     ACCEPT E (I : INTEGER) DO
-                          SOURCE := I;
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
- 
-                IF SOURCE /= 1 THEN
-                     FAILED ("EXPECTED 1, GOT " & INTEGER'IMAGE(SOURCE));
-                END IF;
- 
-                SELECT
-                     ACCEPT E (I : INTEGER) DO
-                          SOURCE := I;
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
- 
-                IF SOURCE /= 2 THEN
-                     FAILED ("EXPECTED 2, GOT " & INTEGER'IMAGE(SOURCE));
-                END IF;
- 
-                SELECT
-                     ACCEPT E (I : INTEGER) DO
-                          SOURCE := I;
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
- 
-                IF SOURCE /= 3 THEN
-                     FAILED ("EXPECTED 3, GOT " & INTEGER'IMAGE(SOURCE));
-                END IF;
- 
-           END TT;
- 
-           PROCEDURE P (T : TT) IS
-           BEGIN
-                T.E(2);
-           END P;
- 
-           PROCEDURE Q (S : IN OUT TT) IS
-           BEGIN
-                S.E(2);
-           END Q;
- 
-      BEGIN
- 
-           T.E(1);                  -- FIRST CALL TO T.E
-           P(T);                    -- SECOND CALL TO T.E
-           T.E(3);                  -- THIRD CALL TO T.E
- 
-           S.E(1);                  -- FIRST CALL TO S.E
-           Q(S);                    -- SECOND CALL TO S.E
-           S.E(3);                  -- THIRD CALL TO S.E
- 
-      END;
- 
-      RESULT;
- 
- END C92003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- C92005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR A NON-SINGLE TASK THE OBJECT VALUE IS SET DURING
- -- ELABORATION OF THE CORRESPONDING OBJECT DECLARATION.
- 
- -- WEI  3/ 4/82
- -- JBG 5/25/85
- -- PWB  2/3/86    CORRECTED TEST ERROR; ADDED 'USE' CLAUSE TO MAKE "/="
- --                FOR BIG_INT VISIBLE.
- 
- WITH REPORT, SYSTEM;
-  USE REPORT;
- PROCEDURE C92005A IS
- BEGIN
- 
-      TEST ("C92005A", "TASK OBJECT VALUE DURING ELABORATION");
- 
-      DECLARE
-           TASK TYPE TT1;
- 
-           OBJ_TT1 : TT1;
- 
-           PACKAGE PACK IS
-                TYPE BIG_INT IS RANGE 0 .. SYSTEM.MAX_INT;
-                I : BIG_INT;
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                I := OBJ_TT1'STORAGE_SIZE;  -- O.K.
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("TASK OBJECT RAISED EXCEPTION");
-           END PACK;
- 
-           USE PACK;
- 
-           TASK BODY TT1 IS
-           BEGIN
-                NULL;
-           END TT1;
- 
-      BEGIN
-           IF PACK.I /= OBJ_TT1'STORAGE_SIZE THEN
-                COMMENT ("STORAGE SIZE CHANGED AFTER TASK ACTIVATED");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY STORAGE_SIZE");
-      END;
- 
-      RESULT;
- END C92005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C92005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR A TASK OBJECT CREATED BY AN ALLOCATOR THE
- -- OBJECT VALUE IS SET DURING EXECUTION OF THE ALLOCATOR.
- 
- -- WEI  3/ 4/82
- -- JBG  5/25/85
- -- RLB  1/ 7/05
- 
- WITH REPORT;
-  USE REPORT;
- WITH SYSTEM;
- PROCEDURE C92005B IS
-      TYPE BIG_INT IS RANGE 0..SYSTEM.MAX_INT;
- BEGIN
-      TEST ("C92005B", "TASK VALUE SET BY EXECUTION OF ALLOCATOR");
- 
- BLOCK:
-      DECLARE
-           TASK TYPE TT1;
- 
-           TYPE ATT1 IS ACCESS TT1;
- 
-           TASK BODY TT1 IS
-           BEGIN
-                NULL;
-           END TT1;
- 
-           PACKAGE PACK IS
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                POINTER_TT1 : ATT1 := NEW TT1;
-                I : BIG_INT := POINTER_TT1.ALL'STORAGE_SIZE;
-           BEGIN
-                IF NOT EQUAL(INTEGER(I MOD 1024), INTEGER(I MOD 1024)) THEN
-                     FAILED ("UNEXPECTED PROBLEM");
-                END IF;
-           END PACK;
-      BEGIN
-           NULL;
-      EXCEPTION
-           WHEN PROGRAM_ERROR | CONSTRAINT_ERROR =>
-                FAILED ("TASK OBJECT VALUE NOT SET DURING " &
-                        "EXECUTION OF ALLOCATOR");
-      END BLOCK;
- 
-      RESULT;
- 
- END C92005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c92006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c92006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C92006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT TASK OBJECTS CAN BE INTERCHANGED BY ASSIGNMENT OF
- -- CORRESPONDING ACCESS TYPE OBJECTS.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C920BIA-B.ADA
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C92006A IS
- 
-      TASK TYPE TT1 IS
-           ENTRY E1;
-           ENTRY E2;
-      END TT1;
- 
-      TYPE ATT1 IS ACCESS TT1;
-      POINTER_TT1_1, POINTER_TT1_2 : ATT1;
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
-      PROCEDURE PROC (P1, P2 : IN OUT ATT1) IS
-      -- SWAP TASK OBJECTS P1, P2.
-           SCRATCH : ATT1;
-      BEGIN
-           SCRATCH := P1;
-           P1 := P2;
-           P2 := SCRATCH;
- 
-           P1.E2;  -- ENTRY2 SECOND OBJECT.
-           P2.E1;  -- VICE VERSA.
- 
-      END PROC;
- 
-      TASK BODY TT1 IS
-      BEGIN
-           ACCEPT E1 DO
-                PSPY_NUMB (1);
-           END E1;
-           ACCEPT E2 DO
-                PSPY_NUMB (2);
-           END E2;
-      END TT1;
- 
- BEGIN
- 
-      TEST ("C92006A", "INTERCHANGING TASK OBJECTS");
-      POINTER_TT1_1 := NEW TT1;
-      POINTER_TT1_2 := NEW TT1;
- 
-      POINTER_TT1_2.ALL.E1;
-      PROC (POINTER_TT1_1, POINTER_TT1_2);
-      POINTER_TT1_2.E2;        -- E2 OF FIRST OBJECT
- -- EACH ENTRY OF EACH TASK OBJECT SHOULD HAVE BEEN CALLED.
- 
-      IF SPYNUMB /= 1212 THEN
-           FAILED ("FAILURE TO SWAP TASK OBJECTS " &
-                   "IN PROCEDURE PROC");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C92006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c930001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c930001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c930001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c930001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- C930001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check when a dependent task and its master both
- --      terminate as a result of a terminate alternative that
- --      finalization is performed and that the finalization is
- --      performed in the proper order.
- --
- -- TEST DESCRIPTION:
- --      A controlled type with finalization is used to determine
- --      the order in which finalization occurs.  The finalization
- --      procedure records the identity of the object being
- --      finalized.
- --      Two tasks, one nested inside the other, both contain 
- --      objects of the above finalization type.  These tasks
- --      cooperatively terminate so the termination and finalization
- --      order can be noted.
- --
- --
- -- CHANGE HISTORY:
- --      08 Jan 96   SAIC    ACVC 2.1
- --      09 May 96   SAIC    Addressed Reviewer comments.
- --
- --!
- 
- 
- with Ada.Finalization;
- package C930001_0 is
-     Verbose : constant Boolean := False;
- 
-     type Ids is range 0..10;
-     Finalization_Order : array (Ids) of Ids := (Ids => 0);
-     Finalization_Cnt : Ids := 0;
- 
-     protected Note is
-        -- serializes concurrent access to Finalization_* above
-        procedure Done (Id : Ids);
-     end Note;
- 
-     -- Objects of the following type are used to note the order in
-     -- which finalization occurs.
-     type Has_Finalization is new Ada.Finalization.Limited_Controlled with
-           record
-              Id : Ids;
-           end record;
-     procedure Finalize (Object : in out Has_Finalization);
- end C930001_0;
- 
- 
- with Report;
- package body C930001_0 is
- 
-     protected body Note is
-         procedure Done (Id : Ids) is
-         begin
-             Finalization_Cnt := Finalization_Cnt + 1;
-             Finalization_Order (Finalization_Cnt) := Id;
-         end Done;
-     end Note;
- 
-     procedure Finalize (Object : in out Has_Finalization) is
-     begin
-         Note.Done (Object.Id);
-         if Verbose then
-             Report.Comment ("in Finalize for" & Ids'Image (Object.Id));
-         end if;
-     end Finalize;
- end C930001_0;
- 
- 
- with Report;
- with ImpDef;
- with C930001_0;   use C930001_0;
- procedure C930001 is
- begin
-  
-     Report.Test ("C930001", "Check that dependent tasks are terminated" &
-                             " before the remaining finalization");
- 
-     declare
-         task Level_1;
-         task body Level_1 is
-             V1a : C930001_0.Has_Finalization;        -------> 4
-             task Level_2 is
-                 entry Not_Taken;
-             end Level_2;
-             task body Level_2 is
-                 V2 : C930001_0.Has_Finalization;     -------> 2
-             begin
-                 V2.Id := 2;
-                 C930001_0.Note.Done (1);             -------> 1
-                 select
-                     accept Not_Taken;
-                 or
-                     terminate;
-                     -- cooperative termination at this point of
-                     -- both tasks
-                 end select;
-             end Level_2;
- 
-             -- 7.6.1(11) requires that V1b be finalized before V1a
-             V1b : C930001_0.Has_Finalization;        -------> 3
-         begin
-             V1a.Id := 4;
-             V1b.Id := 3;
-         end Level_1;
-     begin  -- declare
-         while not Level_1'Terminated loop
-              delay ImpDef.Switch_To_New_Task;
-         end loop;
-         C930001_0.Note.Done (5);                     -------> 5
-         
-         -- now check the order
-         for I in Ids range 1..5 loop
-             if Verbose then
-                 Report.Comment (Ids'Image (I) & 
-                        Ids'Image (Finalization_Order (I)));
-             end if;
-             if Finalization_Order (I) /= I then
-                 Report.Failed ("Finalization occurred out of order" &
-                    " expected:" &
-                    Ids'Image (I) &
-                    " actual:" &
-                    Ids'Image (Finalization_Order (I)));
-             end if;
-         end loop;
-     end;
- 
-     Report.Result;
- end C930001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93001a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,296 ****
- -- C93001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DECLARED TASK OBJECTS ARE NOT ACTIVATED BEFORE
- --   THE END OF THE DECLARATIVE PART.
- -- SUBTESTS ARE:
- --   (A)  A SIMPLE TASK OBJECT, IN A BLOCK.
- --   (B)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
- --   (C)  A RECORD OF TASK OBJECT, IN A PACKAGE SPECIFICATION.
- --   (D)  A RECORD OF ARRAY OF TASK OBJECT, IN A PACKAGE BODY.
- --   (E)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
- 
- -- THIS TEST ASSUMES THAT ACTIVATION IS A SEQUENTIAL STEP
- --   IN THE FLOW OF CONTROL OF THE PARENT (AS IS REQUIRED BY THE
- --   ADA RM).  IF AN IMPLEMENTATION (ILLEGALLY) ACTIVATES A
- --   TASK IN PARALLEL WITH ITS PARENT, THIS TEST
- --   IS NOT GUARANTEED TO DETECT THE VIOLATION, DUE TO A
- --   RACE CONDITION.
- 
- -- JRK 9/23/81
- -- SPS 11/1/82
- -- SPS 11/21/82
- -- R.WILLIAMS 10/8/86  ADDED CHECKS ON INITIALIZATIONS OF NON-TASK
- --                     COMPONENTS OF RECORD TYPES.
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93001A IS
- 
-      GLOBAL : INTEGER;
- 
-      FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           GLOBAL := IDENT_INT (I);
-           RETURN 0;
-      END SIDE_EFFECT;
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-           I : INTEGER := SIDE_EFFECT (1);
-      BEGIN
-           NULL;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C93001A", "CHECK THAT DECLARED TASK OBJECTS ARE NOT " &
-                       "ACTIVATED BEFORE THE END OF THE DECLARATIVE " &
- 
-                       "PART");
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (A)
- 
-           T : TT;
-           I : INTEGER := GLOBAL;
- 
-      BEGIN -- (A)
- 
-           IF I /= 0 THEN
-                FAILED ("A SIMPLE TASK OBJECT IN A BLOCK WAS " &
-                        "ACTIVATED TOO SOON - (A)");
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (B)
- 
-           J : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                A : ARRAY (1..1) OF TT;
-                I : INTEGER := GLOBAL;
-           BEGIN
-                IF I /= 0 THEN
-                     FAILED ("AN ARRAY OF TASK OBJECT IN A FUNCTION " &
-                             "WAS ACTIVATED TOO SOON - (B)");
-                END IF;
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           J := F ;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C)
- 
-           PACKAGE P IS
- 
-                TYPE REC IS
-                     RECORD
-                          T  : TT;
-                          N1 : INTEGER := GLOBAL;
-                     END RECORD;
- 
-                TYPE RT IS
-                     RECORD
-                          M : INTEGER := GLOBAL;
-                          T : TT;
-                          N : REC;
-                     END RECORD;
-                R : RT;
-                I : INTEGER := GLOBAL;
-           END P;
- 
-           PACKAGE Q IS
-                J : INTEGER;
-           PRIVATE
-                TYPE RT IS
-                     RECORD
-                          N : P.REC;
-                          T : TT;
-                          M : INTEGER := GLOBAL;
-                     END RECORD;
-                R : RT;
-           END Q;
- 
-           K : INTEGER := GLOBAL;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF R.M /= 0  OR R.N.N1 /= 0 THEN
-                     FAILED ( "NON-TASK COMPONENTS OF RECORD R NOT " &
-                              "INITIALIZED BEFORE TASKS ACTIVATED " &
-                              "- (C.1)" );
-                END IF;
-           END Q;
- 
-      BEGIN -- (C)
- 
-           IF P.R.M /= 0 OR P.R.N.N1 /= 0 THEN
-                FAILED ( "NON-TASK COMPONENTS OF RECORDS NOT " &
-                         "INITIALIZED BEFORE TASKS ACTIVATED " &
-                         "- (C.2)" );
-           END IF;
- 
-           IF P.I /= 0 OR K /= 0 THEN
-                FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
-                        "SPECIFICATION WAS ACTIVATED TOO SOON - (C)");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (D)
- 
-           PACKAGE P IS
- 
-                TYPE GRADE IS (GOOD, FAIR, POOR);
-      
-                TYPE REC (G : GRADE) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TYPE ACCR IS ACCESS REC;
-                TYPE ACCI IS ACCESS INTEGER;
- 
-                TYPE ARR IS ARRAY (1..1) OF TT;
-                TYPE RAT IS
-                     RECORD
-                          M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
-                          A : ARR;
-                          N : ACCI := NEW INTEGER'(GLOBAL);
-                     END RECORD;
-                RA1 : RAT;
-           PRIVATE
-                RA2 : RAT;
-           END P;
- 
-           PACKAGE BODY P IS
-                RA3 : RAT;
-                I : INTEGER := GLOBAL;
-           BEGIN
-                IF RA1.M.G /= GOOD  OR RA1.N.ALL /= 0 THEN
-                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA1 NOT " &
-                              "INITIALIZED BEFORE TASKS ACTIVATED " &
-                              "- (D)" );
-                END IF;
-                
-                IF RA2.M.G /= GOOD  OR RA2.N.ALL /= 0 THEN
-                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA2 NOT " &
-                              "INITIALIZED BEFORE TASKS ACTIVATED " &
-                              "- (D)" );
-                END IF;
-                
-                IF RA3.M.G /= GOOD  OR RA3.N.ALL /= 0 THEN
-                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA3 NOT " &
-                              "INITIALIZED BEFORE TASKS ACTIVATED " &
-                              "- (D)" );
-                END IF;
-                
-                IF I /= 0 THEN
-                     FAILED ("A RECORD OF ARRAY OF TASK OBJECT IN A " &
-                             "PACKAGE SPEC OR BODY WAS ACTIVATED " &
-                             "TOO SOON - (D)");
-                END IF;
-           END P;
- 
-      BEGIN -- (D)
- 
-           NULL;
- 
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (E)
- 
-           TYPE REC IS
-                RECORD
-                     B : BOOLEAN := BOOLEAN'VAL (GLOBAL);
-                     T : TT;
-                     C :CHARACTER :=CHARACTER'VAL (GLOBAL);
-                END RECORD;
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-                TYPE RT IS
-                     RECORD
-                          M : REC;
-                          T : TT;
-                          N : REC;
-                     END RECORD;
-                AR : ARRAY (1..1) OF RT;
-                I : INTEGER := GLOBAL;
-           BEGIN
-                IF AR (1).M.B /= FALSE OR AR (1).M.C /= ASCII.NUL OR
-                   AR (1).N.B /= FALSE OR AR (1).N.C /= ASCII.NUL THEN
-                     FAILED ( "NON-TASK COMPONENTS OF RECORD RT NOT " &
-                              "INITIALIZED BEFORE TASKS ACTIVATED " &
-                              "- (E)" );
-                END IF;
-                
-                IF I /= 0 THEN
-                     FAILED ("AN ARRAY OF RECORD OF TASK OBJECT IN A " &
-                             "TASK BODY WAS ACTIVATED TOO SOON - (E)");
-                END IF;
-           END T;
- 
-      BEGIN -- (E)
- 
-           NULL;
- 
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C93001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,231 ****
- -- C93002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DECLARED TASK OBJECTS ARE ACTIVATED BEFORE EXECUTION
- --   OF THE FIRST STATEMENT FOLLOWING THE DECLARATIVE PART.
- -- SUBTESTS ARE:
- --   (A)  A SIMPLE TASK OBJECT, IN A BLOCK.
- --   (B)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
- --   (C)  A RECORD OF TASK OBJECT, IN A PACKAGE SPECIFICATION.
- --   (D)  A RECORD OF ARRAY OF TASK OBJECT, IN A PACKAGE BODY.
- --   (E)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
- 
- -- JRK 9/28/81
- -- SPS 11/1/82
- -- SPS 11/21/82
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93002A IS
- 
-      GLOBAL : INTEGER;
- 
-      FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           GLOBAL := IDENT_INT (I);
-           RETURN 0;
-      END SIDE_EFFECT;
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-           I : INTEGER := SIDE_EFFECT (1);
-      BEGIN
-           NULL;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C93002A", "CHECK THAT DECLARED TASK OBJECTS ARE " &
-                       "ACTIVATED BEFORE EXECUTION OF THE FIRST " &
-                       "STATEMENT FOLLOWING THE DECLARATIVE PART");
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (A)
- 
-           T : TT;
- 
-      BEGIN -- (A)
- 
-           IF GLOBAL /= 1 THEN
-                FAILED ("A SIMPLE TASK OBJECT IN A BLOCK WAS " &
-                        "ACTIVATED TOO LATE - (A)");
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (B)
- 
-           J : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                A : ARRAY (1..1) OF TT;
-           BEGIN
-                IF GLOBAL /= 1 THEN
-                     FAILED ("AN ARRAY OF TASK OBJECT IN A FUNCTION " &
-                             "WAS ACTIVATED TOO LATE - (B)");
-                END IF;
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           J := F ;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C1)
- 
-           PACKAGE P IS
-                TYPE ARR IS ARRAY (1..1) OF TT;
-                TYPE RT IS
-                     RECORD
-                          A : ARR;
-                     END RECORD;
-                R : RT;
-           END P;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                IF GLOBAL /= 1 THEN
-                     FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
-                             "SPECIFICATION WAS ACTIVATED TOO LATE " &
-                             "- (C1)");
-                END IF;
-           END P;
- 
-      BEGIN -- (C1)
- 
-           NULL;
- 
-      END; -- (C1)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C2)
- 
-           PACKAGE Q IS
-                J : INTEGER;
-           PRIVATE
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                R : RT;
-           END Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF GLOBAL /= 1 THEN
-                     FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
-                             "SPECIFICATION WAS ACTIVATED TOO LATE " &
-                             "- (C2)");
-                END IF;
-           END Q;
- 
-      BEGIN -- (C2)
- 
-           NULL;
- 
-      END; -- (C2)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (D)
- 
-           PACKAGE P IS
-                TYPE ARR IS ARRAY (1..1) OF TT;
-                TYPE RAT IS
-                     RECORD
-                          A : ARR;
-                     END RECORD;
-           END P;
- 
-           PACKAGE BODY P IS
-                RA : RAT;
-           BEGIN
-                IF GLOBAL /= 1 THEN
-                     FAILED ("A RECORD OF ARRAY OF TASK OBJECT IN A " &
-                             "PACKAGE BODY WAS ACTIVATED " &
-                             "TOO LATE - (D)");
-                END IF;
-           END P;
- 
-      BEGIN -- (D)
- 
-           NULL;
- 
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (E)
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                AR : ARRAY (1..1) OF RT;
-           BEGIN
-                IF GLOBAL /= 1 THEN
-                     FAILED ("AN ARRAY OF RECORD OF TASK OBJECT IN A " &
-                             "TASK BODY WAS ACTIVATED TOO LATE - (E)");
-                END IF;
-           END T;
- 
-      BEGIN -- (E)
- 
-           NULL;
- 
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C93002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,351 ****
- -- C93003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ACTIVATION OF TASKS CREATED BY ALLOCATORS PRESENT IN A
- --   DECLARATIVE PART TAKES PLACE DURING ELABORATION OF THE
- --   CORRESPONDING DECLARATION.
- -- SUBTESTS ARE:
- --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
- --   (B)  AN ARRAY OF TASK ALLOCATOR, IN A FUNCTION.
- --   (C)  A RECORD OF TASK ALLOCATOR, IN A PACKAGE SPECIFICATION.
- --   (D)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY.
- --   (E)  AN ARRAY OF RECORD OF TASK ALLOCATOR, IN A TASK BODY.
- 
- -- JRK 9/28/81
- -- SPS 11/11/82
- -- SPS 11/21/82
- -- RJW 8/4/86    ADDED CHECKS ON INITIALIZATIONS OF NON-TASK COMPONENTS
- --               OF RECORD TYPES.
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93003A IS
- 
-      GLOBAL : INTEGER;
- 
-      FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           GLOBAL := IDENT_INT (I);
-           RETURN 0;
-      END SIDE_EFFECT;
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-           I : INTEGER := SIDE_EFFECT (1);
-      BEGIN
-           NULL;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C93003A", "CHECK THAT ACTIVATION OF TASKS CREATED BY " &
-                       "ALLOCATORS PRESENT IN A DECLARATIVE PART " &
-                       "TAKES PLACE DURING ELABORATION OF THE " &
-                       "CORRESPONDING DECLARATION");
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (A)
- 
-           TYPE A IS ACCESS TT;
-           T1 : A := NEW TT;
-           I1 : INTEGER := GLOBAL;
-           J  : INTEGER := SIDE_EFFECT (0);
-           T2 : A := NEW TT;
-           I2 : INTEGER := GLOBAL;
- 
-      BEGIN -- (A)
- 
-           IF I1 /= 1 OR I2 /= 1 THEN
-                FAILED ("A SIMPLE TASK ALLOCATOR IN A BLOCK WAS " &
-                        "ACTIVATED TOO LATE - (A)");
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (B)
- 
-           J : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
- 
-                TYPE A_T IS ARRAY (1 .. 1) OF TT;
-                TYPE A IS ACCESS A_T;
-                A1 : A := NEW A_T;
-                I1 : INTEGER := GLOBAL;
-                J  : INTEGER := SIDE_EFFECT (0);
-                A2 : A := NEW A_T;
-                I2 : INTEGER := GLOBAL;
- 
-           BEGIN
-                IF I1 /= 1 OR I2 /= 1 THEN
-                     FAILED ("AN ARRAY OF TASK ALLOCATOR IN A " &
-                             "FUNCTION WAS ACTIVATED TOO LATE - (B)");
-                END IF;
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           J := F ;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C1)
- 
-           PACKAGE P IS
- 
-                TYPE INTREC IS
-                     RECORD
-                          N1 : INTEGER := GLOBAL;
-                     END RECORD;
- 
-                TYPE RT IS
-                     RECORD
-                          M : INTEGER := GLOBAL;
-                          T : TT;
-                          N : INTREC;
-                     END RECORD;
- 
-                TYPE A IS ACCESS RT;
- 
-                R1 : A := NEW RT;
-                I1 : INTEGER := GLOBAL;
-                J  : INTEGER := SIDE_EFFECT (0);
-                R2 : A := NEW RT;
-                I2 : INTEGER := GLOBAL;
- 
-           END P;
- 
-      BEGIN -- (C1)
- 
-           IF P.R1.M /= 0 OR P.R1.N.N1 /= 0 THEN 
-                FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
-                        "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
-           END IF;
- 
-           IF P.R2.M /= 0 OR P.R2.N.N1 /= 0 THEN 
-                FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
-                        "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
-           END IF;
- 
-           IF P.I1 /= 1 OR P.I2 /= 1 THEN
-                FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
-                        "SPECIFICATION WAS ACTIVATED TOO LATE - (C1)");
-           END IF;
- 
-      END; -- (C1)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C2)
- 
-           PACKAGE Q IS
-                J1 : INTEGER;
-           PRIVATE
-                
-                TYPE GRADE IS (GOOD, FAIR, POOR);
-      
-                TYPE REC (G : GRADE) IS
-                     RECORD
-                          NULL;
-                     END RECORD;
- 
-                TYPE ACCR IS ACCESS REC;
- 
-                TYPE ACCI IS ACCESS INTEGER;
- 
-                TYPE RT IS
-                     RECORD
-                          M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
-                          T : TT;
-                          N : ACCI := NEW INTEGER'(GLOBAL);
-                     END RECORD;
- 
-                TYPE A IS ACCESS RT;
- 
-                R1 : A := NEW RT;
-                I1 : INTEGER := GLOBAL;
-                J2 : INTEGER := SIDE_EFFECT (0);
-                R2 : A := NEW RT;
-                I2 : INTEGER := GLOBAL;
- 
-           END Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                IF R1.M.G /= GOOD OR R1.N.ALL /= 0 THEN 
-                     FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
-                             "INITIALIZED BEFORE TASK ACTIVATED " &
-                             "- (C2)" );
-                END IF;
- 
-                IF R2.M.G /= GOOD OR R2.N.ALL /= 0 THEN 
-                     FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
-                             "INITIALIZED BEFORE TASK ACTIVATED " &
-                             "- (C2)" );
-                END IF;
- 
-                IF I1 /= 1 OR I2 /= 1 THEN
-                     FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
-                             "SPECIFICATION WAS ACTIVATED TOO LATE " &
-                             "- (C2)");
-                END IF;
-           END Q;
- 
-      BEGIN -- (C2)
- 
-           NULL;
- 
-      END; -- (C2)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (D)
- 
-           PACKAGE P IS
- 
-                TYPE ARR IS ARRAY (1 .. 1) OF TT;
-                TYPE INTARR IS ARRAY (1 .. 1) OF INTEGER;
- 
-                TYPE RAT IS
-                     RECORD
-                          M : INTARR := (1 => GLOBAL);
-                          A : ARR;
-                          N : INTARR := (1 => GLOBAL);
-                     END RECORD;
-           END P;
- 
-           PACKAGE BODY P IS
- 
-                TYPE A IS ACCESS RAT;
- 
-                RA1 : A := NEW RAT;
-                I1  : INTEGER := GLOBAL;
-                J   : INTEGER := SIDE_EFFECT (0);
-                RA2 : A := NEW RAT;
-                I2  : INTEGER := GLOBAL;
- 
-           BEGIN
-                IF RA1.M (1) /= 0 OR RA1.N (1) /= 0 THEN 
-                     FAILED ("NON-TASK COMPONENTS OF RECORD RA1 NOT " &
-                             "INITIALIZED BEFORE TASK ACTIVATED " &
-                             "- (D)" );
-                END IF;
- 
-                IF RA2.M (1) /= 0 OR RA2.N (1) /= 0 THEN 
-                     FAILED ("NON-TASK COMPONENTS OF RECORD RA2 NOT " &
-                             "INITIALIZED BEFORE TASK ACTIVATED " &
-                             "- (D)" );
-                END IF;
- 
-                IF I1 /= 1 OR I2 /= 1 THEN
-                     FAILED ("A RECORD OF ARRAY OF TASK ALLOCATOR IN " &
-                             "A PACKAGE BODY WAS ACTIVATED " &
-                             "TOO LATE - (D)");
-                END IF;
-           END P;
- 
-      BEGIN -- (D)
- 
-           NULL;
- 
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (E)
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-                TYPE RT IS
-                     RECORD
-                          M : BOOLEAN := BOOLEAN'VAL (GLOBAL);
-                          T : TT;
-                          N : CHARACTER := CHARACTER'VAL (GLOBAL);
-                     END RECORD;
- 
-                TYPE ART IS ARRAY (1 .. 1) OF RT;
-                TYPE A IS ACCESS ART;
- 
-                AR1 : A := NEW ART;
-                I1  : INTEGER := GLOBAL;
-                J   : INTEGER := SIDE_EFFECT (0);
-                AR2 : A := NEW ART;
-                I2  : INTEGER := GLOBAL;
- 
-           BEGIN
-                IF AR1.ALL (1).M /= FALSE     OR 
-                   AR1.ALL (1).N /= ASCII.NUL THEN 
-                     FAILED ("NON-TASK COMPONENTS OF RECORD AR1 NOT " &
-                             "INITIALIZED BEFORE TASK ACTIVATED " &
-                             "- (E)" );
-                END IF;
- 
-                IF AR2.ALL (1).M /= FALSE     OR 
-                   AR2.ALL (1).N /= ASCII.NUL THEN 
-                     FAILED ("NON-TASK COMPONENTS OF RECORD AR2 NOT " &
-                             "INITIALIZED BEFORE TASK ACTIVATED " &
-                             "- (E)" );
-                END IF;
- 
-                IF I1 /= 1 OR I2 /= 1 THEN
-                     FAILED ("AN ARRAY OF RECORD OF TASK ALLOCATOR IN " &
-                             "A TASK BODY WAS ACTIVATED TOO LATE - (E)");
-                END IF;
-           END T;
- 
-      BEGIN -- (E)
- 
-           NULL;
- 
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C93003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- C93004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK BECOMES COMPLETED WHEN AN EXCEPTION OCCURS DURING
- -- ITS ACTIVATION.
- 
- -- WEI  3/ 4/82
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C93004A IS
- BEGIN
- 
-      TEST ("C93004A", "TASK COMPLETION CAUSED BY EXCEPTION");
- 
- BLOCK:
-      DECLARE
-           TYPE I0 IS RANGE 0..1;
- 
-           TASK T1 IS
-                ENTRY BYE;
-           END T1;
- 
-           TASK BODY T1 IS
-                SUBTYPE I1 IS I0 RANGE 0 .. 2;     -- CONSTRAINT ERROR.
-           BEGIN
-                ACCEPT BYE;
-           END T1;
-      BEGIN
-           FAILED ("NO EXCEPTION RAISED");
-           IF NOT T1'TERMINATED THEN 
-                FAILED ("TASK NOT TERMINATED");
-                T1.BYE;
-           END IF;
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                NULL;
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED");
-      END BLOCK;
- 
-      RESULT;
- 
- END C93004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- C93004B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
- -- TASK, OTHER TASKS ARE UNAFFECTED.
- 
- -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
- 
- -- CHECK THAT TASKS WAITING ON ENTRIES OF SUCH TASKS RECEIVE
- -- TASKING_ERROR
- 
- -- JEAN-PIERRE ROSEN 09-MAR-1984
- -- JBG 06/01/84
- -- JBG 05/23/85
- -- EG  10/29/85 ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93004B IS
- 
- BEGIN
-      TEST("C93004B", "EXCEPTIONS DURING ACTIVATION");
- 
-      DECLARE
- 
-           TASK TYPE T1 IS
-           END T1;
- 
-           TASK TYPE T2 IS
-                ENTRY E;
-           END T2;
- 
-           ARR_T2: ARRAY(INTEGER RANGE 1..1) OF T2;
- 
-           TYPE AT1 IS ACCESS T1;
- 
-           PACKAGE START_T1 IS  -- THIS PACKAGE TO AVOID ACCESS BEFORE
-           END START_T1;        -- ELABORATION ON T1.
- 
-           TASK BODY T1 IS
-           BEGIN
-                DECLARE    -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
-                     TASK T1BIS IS
-                     END T1BIS;
- 
-                     TASK BODY T1BIS IS
-                     BEGIN
-                          ARR_T2(IDENT_INT(1)).E;
-                          FAILED ("RENDEZVOUS COMPLETED - T1BIS");
-                     EXCEPTION
-                          WHEN TASKING_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("ABNORMAL EXCEPTION - T1BIS");
-                     END T1BIS;
-                BEGIN
-                     NULL;
-                END;
- 
-                ARR_T2(IDENT_INT(1)).E;  -- ARR_T2(1) IS NOW TERMINATED.
- 
-                FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
- 
-           EXCEPTION
-                WHEN TASKING_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("ABNORMAL EXCEPTION - T1");
-           END;
- 
-           PACKAGE BODY START_T1 IS
-                V_AT1 : AT1 := NEW T1;
-           END START_T1;
- 
-           TASK BODY T2 IS
-                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
-           BEGIN
-                IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
-                     FAILED("T2 ACTIVATED OK");
-                END IF;
-           END T2;
- 
-           TASK T3 IS
-                ENTRY E;
-           END T3;
- 
-           TASK BODY T3 IS
-           BEGIN     -- T3 MUST BE ACTIVATED OK.
-                ACCEPT E;
-           END T3;
- 
-      BEGIN
-           FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
-           T3.E;          -- CLEAN UP.
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                BEGIN
-                     T3.E;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          FAILED ("T3 NOT ACTIVATED");
-                END;
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
-           WHEN OTHERS =>
-                FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
-      END;
- 
-      RESULT;
- END C93004B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C93004C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
- -- TASK, OTHER TASKS ARE UNAFFECTED.
- 
- -- IF SEVERAL TASKS FAIL THEIR ACTIVATION, ONLY ONE TASKING_ERROR IS
- -- RAISED.
- 
- -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
- 
- -- CHECK THAT TASKS WAITING ON ENTRIES OF SUCH TASKS RECEIVE
- -- TASKING_ERROR
- 
- -- JEAN-PIERRE ROSEN 09-MAR-1984
- -- JBG 06/01/84
- -- JBG 05/23/85
- -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93004C IS
- 
- BEGIN
-      TEST("C93004C", "EXCEPTIONS DURING ACTIVATION");
- 
-      DECLARE
- 
-           TASK TYPE T1 IS
-           END T1;
- 
-           TASK TYPE T2 IS
-                ENTRY E;
-           END T2;
- 
-           ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2;
- 
-           TYPE AT1 IS ACCESS T1;
- 
-           PACKAGE START_T1 IS      -- THIS PACKAGE TO AVOID ACCESS
-           END START_T1;            -- BEFORE ELABORATION ON T1.
- 
-           TASK BODY T1 IS
-           BEGIN
-                DECLARE   -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
-                     TASK T1BIS IS
-                     END T1BIS;
- 
-                     TASK BODY T1BIS IS
-                     BEGIN
-                          ARR_T2(IDENT_INT(2)).E;
-                          FAILED ("RENDEZVOUS COMPLETED - T3");
-                     EXCEPTION
-                          WHEN TASKING_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("ABNORMAL EXCEPTION - T3");
-                     END T1BIS;
-                BEGIN
-                     NULL;
-                END;
- 
-                ARR_T2(IDENT_INT(2)).E;   -- ARR_T2(2) IS NOW TERMINATED.
- 
-                FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
- 
-           EXCEPTION
-                WHEN TASKING_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("ABNORMAL EXCEPTION - T1");
-           END;
- 
-           PACKAGE BODY START_T1 IS
-                V_AT1 : AT1 := NEW T1;
-           END START_T1;
- 
-           TASK BODY T2 IS
-                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
-           BEGIN
-                IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
-                     FAILED("T2 ACTIVATED OK");
-                END IF;
-           END T2;
- 
-           TASK T3 IS
-                ENTRY E;
-           END T3;
- 
-           TASK BODY T3 IS
-           BEGIN     -- T3 MUST BE ACTIVATED OK.
-                ACCEPT E;
-           END T3;
- 
-      BEGIN
-           FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
-           T3.E;          -- CLEAN UP.
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                BEGIN
-                     T3.E;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          FAILED ("T3 NOT ACTIVATED");
-                END;
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
-           WHEN OTHERS =>
-                FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
-      END;
- 
-      RESULT;
- 
- END C93004C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C93004D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
- -- TASK, OTHER TASKS ARE UNAFFECTED.
- 
- -- THIS TEST CHECKS THE CASE IN WHICH SOME OF THE OTHER TASKS ARE 
- -- PERHAPS ACTIVATED BEFORE THE EXCEPTION OCCURS AND SOME TASKS ARE 
- -- PERHAPS ACTIVATED AFTER.
- 
- -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
- 
- -- CHECK THAT TASKS WAITING FOR ENTRIES OF SUCH TASKS RECEIVE
- -- TASKING_ERROR.
- 
- -- R. WILLIAMS 8/6/86
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C93004D IS
- 
-           
- BEGIN
-      TEST ( "C93004D", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
-                        "DURING ACTIVATION OF A TASK, OTHER TASKS " &
-                        "ARE NOT AFFECTED. IN THIS TEST, SOME OF THE " &
-                        "TASKS ARE PERHAPS ACTIVATED BEFORE THE " &
-                        "EXCEPTION OCCURS AND SOME PERHAPS AFTER" );
- 
- 
-      DECLARE
- 
-           TASK T0 IS
-                ENTRY E;
-           END T0;
- 
-           TASK TYPE T1 IS
-           END T1;
- 
-           TASK TYPE T2 IS
-                ENTRY E;
-           END T2;     
- 
-           ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2;
- 
-           TYPE AT1 IS ACCESS T1;
- 
-           TASK BODY T0 IS
-           BEGIN
-                ACCEPT E;
-           END T0;
- 
-           PACKAGE START_T1 IS      -- THIS PACKAGE TO AVOID ACCESS
-           END START_T1;            -- BEFORE ELABORATION ON T1.
- 
-           TASK BODY T1 IS
-           BEGIN
-                DECLARE   -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
-                     TASK T1BIS IS
-                     END T1BIS;
- 
-                     TASK BODY T1BIS IS
-                     BEGIN
-                          ARR_T2(IDENT_INT(2)).E;
-                          FAILED ("RENDEZVOUS COMPLETED - T3");
-                     EXCEPTION
-                          WHEN TASKING_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("ABNORMAL EXCEPTION - T3");
-                     END T1BIS;
-                BEGIN
-                     NULL;
-                END;
- 
-                ARR_T2(IDENT_INT(2)).E;   -- ARR_T2(2) IS NOW 
-                                          -- TERMINATED.
- 
-                FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
- 
-           EXCEPTION
-                WHEN TASKING_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("ABNORMAL EXCEPTION - T1");
-           END;
- 
-           PACKAGE BODY START_T1 IS
-                V_AT1 : AT1 := NEW T1;
-           END START_T1;
- 
-           TASK BODY T2 IS
-                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
-           BEGIN
-                IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
-                     FAILED("T2 ACTIVATED OK");
-                END IF;
-           END T2;
- 
-           TASK T3 IS
-                ENTRY E;
-           END T3;
- 
-           TASK BODY T3 IS
-           BEGIN     -- T3 MUST BE ACTIVATED OK.
-                ACCEPT E;
-           END T3;
- 
-      BEGIN -- T0, ARR_T2 (1 .. 4), T3 ACTIVATED HERE.
- 
-           FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
-           T3.E;          -- CLEAN UP.
-           T0.E;
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                BEGIN
-                     T3.E;
-                     T0.E;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          FAILED ("T0 OR T3 NOT ACTIVATED");
-                END;
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
-           WHEN OTHERS =>
-                FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
-      END;
- 
-      RESULT;
- END C93004D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93004f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93004f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- C93004F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
- -- TASK, OTHER TASKS ARE UNAFFECTED.
- 
- -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
- 
- -- THIS TESTS CHECKS THE CASE IN WHICH THE TASKS ARE CREATED BY THE
- -- ALLOCATION OF A RECORD OF TASKS OR AN ARRAY OF TASKS.
- 
- -- R. WILLIAMS 8/7/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C93004F IS
- 
- BEGIN
-      TEST ( "C93004F", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
-                        "DURING THE ACTIVATION OF A TASK, OTHER " &
-                        "TASKS ARE UNAFFECTED. IN THIS TEST, THE " &
-                        "TASKS ARE CREATED BY THE ALLOCATION OF A " &
-                        "RECORD OR AN ARRAY OF TASKS" );
- 
-      DECLARE
- 
-           TASK TYPE T IS 
-                ENTRY E;
-           END T;
- 
-           TASK TYPE TT;
- 
-           TASK TYPE TX IS 
-                ENTRY E;
-           END TX;
- 
-           TYPE REC IS
-                RECORD
-                     TR : T;
-                END RECORD;
- 
-           TYPE ARR IS ARRAY (IDENT_INT (1) .. IDENT_INT (1)) OF T;
- 
-           TYPE RECX IS
-                RECORD 
-                     TTX1 : TX;
-                     TTT  : TT;
-                     TTX2 : TX;
-                END RECORD;
- 
-           TYPE ACCR IS ACCESS REC;
-           AR : ACCR;
- 
-           TYPE ACCA IS ACCESS ARR;
-           AA : ACCA;
-                
-           TYPE ACCX IS ACCESS RECX;
-           AX : ACCX;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E;
-           END T;
- 
-           TASK BODY TT IS
-           BEGIN
-                AR.TR.E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "TASK AR.TR NOT ACTIVE" );
-           END TT;
- 
-           TASK BODY TX IS
-                I : POSITIVE := IDENT_INT (0); -- RAISE 
-                                               -- CONSTRAINT_ERROR.
-           BEGIN
-                IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
-                     FAILED ( "TX ACTIVATED OK" );
-                END IF;
-           END TX;
- 
-      BEGIN
-           AR := NEW REC;
-           AA := NEW ARR;
-           AX := NEW RECX;
- 
-           FAILED ( "TASKING_ERROR NOT RAISED IN MAIN" );
-           
-           AA.ALL (1).E;        -- CLEAN UP.
- 
-      EXCEPTION
-           WHEN TASKING_ERROR =>
- 
-                BEGIN
-                     AA.ALL (1).E;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          FAILED ( "AA.ALL (1) NOT ACTIVATED" );
-                END;
- 
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ( "CONSTRAINT_ERROR RAISED IN MAIN" );
-           WHEN OTHERS =>
-                FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
-      END;
- 
-      RESULT;
- 
- END C93004F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- C93005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN AN EXCEPTION IS RAISED IN A DECLARATIVE PART, A TASK
- -- DECLARED IN THE SAME DECLARATIVE PART BECOMES TERMINATED.
- 
- -- CHECK THAT A TASK WAITING ON ENTRIES OF SUCH A
- -- TERMINATED-BEFORE-ACTIVATION TASK RECEIVES TASKING_ERROR.
- 
- -- JEAN-PIERRE ROSEN 3/9/84
- -- JBG 06/01/84
- -- JBG 05/23/85
- -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93005A IS
- 
- BEGIN
-      TEST("C93005A", "EXCEPTIONS RAISED IN A DECLARATIVE PART " &
-                      "CONTAINING TASKS");
- 
-      BEGIN
- 
-           DECLARE
-                TASK TYPE T1 IS     -- CHECKS THAT T2 TERMINATES.
-                END T1;
- 
-                TYPE AT1 IS ACCESS T1;
- 
-                TASK T2 IS          -- WILL NEVER BE ACTIVATED.
-                     ENTRY E;
-                END T2;
- 
-                PACKAGE RAISE_IT IS
-                END RAISE_IT;
- 
-                TASK BODY T2 IS
-                BEGIN
-                     FAILED ("T2 ACTIVATED");
-                     -- IN CASE OF FAILURE
-                     LOOP
-                          SELECT
-                               ACCEPT E;
-                          OR
-                               TERMINATE;
-                          END SELECT;
-                     END LOOP;
-                END T2;
- 
-                TASK BODY T1 IS
-                BEGIN
-                     DECLARE  -- THIS BLOCK TO CHECK THAT T3 TERMINATES.
-                          TASK T3 IS
-                          END T3;
- 
-                          TASK BODY T3 IS
-                          BEGIN
-                               T2.E;
-                               FAILED ("RENDEZVOUS COMPLETED WITHOUT " &
-                                       "ERROR - T3");
-                          EXCEPTION
-                               WHEN TASKING_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED("ABNORMAL EXCEPTION - T3");
-                          END T3;
-                     BEGIN
-                          NULL;
-                     END;
- 
-                     T2.E;    --T2 IS NOW TERMINATED
- 
-                     FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
- 
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("ABNORMAL EXCEPTION - T1");
-                END;
- 
-                PACKAGE BODY RAISE_IT IS
-                     PT1 : AT1 := NEW T1;
-                     I   : POSITIVE := IDENT_INT(0); -- RAISE
-                                                     -- CONSTRAINT_ERROR.
-                BEGIN
-                     IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
-                          FAILED ("PACKAGE DIDN'T RAISE EXCEPTION");
-                     END IF;
-                END RAISE_IT;
- 
-           BEGIN     -- CAN'T LEAVE BLOCK UNTIL T1, T2, AND T3 ARE TERM.
-                FAILED ("EXCEPTION NOT RAISED");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR IN MAIN PROGRAM");
-           WHEN OTHERS =>
-                FAILED ("ABNORMAL EXCEPTION IN MAIN-1");
-      END;
- 
-      RESULT;
- 
- END C93005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,273 ****
- -- C93005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN AN EXCEPTION IS RAISED IN A DECLARATIVE PART, A TASK
- -- DECLARED IN THE SAME DECLARATIVE PART BECOMES TERMINATED.
- 
- -- CHECK THAT A TASK WAITING ON ENTRIES OF SUCH A
- -- TERMINATED-BEFORE-ACTIVATION TASK RECEIVES TASKING_ERROR.
- 
- -- THIS TEST CHECKS THE CASE IN WHICH SEVERAL TASKS ARE WAITING FOR
- -- ACTIVATION WHEN THE EXCEPTION OCCURS.
- 
- -- R. WILLIAMS 8/7/86
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C93005B IS
- 
- 
- BEGIN
-      TEST ( "C93005B", "CHECK THAT WHEN AN EXCEPTION IS RAISED IN A " &
-                        "DECLARATIVE PART, A TASK DECLARED IN THE " &
-                        "SAME DECLARATIVE PART BECOMES TERMINATED. " &
-                        "IN THIS CASE, SEVERAL TASKS ARE WAITING FOR " &
-                        "ACTIVATION WHEN THE EXCEPTION OCCURS" );
-  
-      BEGIN
-  
-           DECLARE
-                TASK TYPE TA IS      -- CHECKS THAT TX TERMINATES.
-                END TA;
-   
-                TYPE ATA IS ACCESS TA;
-  
-                TASK TYPE TB IS      -- CHECKS THAT TY TERMINATES.
-                END TB;
-                  
-                TYPE TBREC IS
-                     RECORD
-                          TTB: TB;
-                     END RECORD;
-   
-                TASK TX IS          -- WILL NEVER BE ACTIVATED.
-                     ENTRY E;
-                END TX;
- 
-                TASK BODY TA IS
-                BEGIN
-                     DECLARE  -- THIS BLOCK TO CHECK THAT TAB 
-                              -- TERMINATES.
-                          TASK TAB IS
-                          END TAB;
- 
-                          TASK BODY TAB IS
-                          BEGIN
-                               TX.E;
-                               FAILED ( "RENDEZVOUS COMPLETED " &
-                                        "WITHOUT ERROR - TAB" );
-                          EXCEPTION
-                               WHEN TASKING_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "ABNORMAL EXCEPTION " &
-                                             "- TAB" );
-                          END TAB;
-                     BEGIN
-                          NULL;
-                     END;
-   
-                     TX.E;    --TX IS NOW TERMINATED.
-  
-                     FAILED ( "RENDEZVOUS COMPLETED WITHOUT ERROR " &
-                              "- TA" );
-   
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "ABNORMAL EXCEPTION - TA" );
-                END TA;
-  
-                PACKAGE RAISE_IT IS 
-                     TASK TY IS             -- WILL NEVER BE ACTIVATED.
-                          ENTRY E;
-                     END TY;                                         
-                END RAISE_IT;
-  
-                TASK BODY TB IS
-                BEGIN
-                     DECLARE  -- THIS BLOCK TO CHECK THAT TBB 
-                              -- TERMINATES.
-                          TASK TBB IS
-                          END TBB;
-  
-                          TASK BODY TBB IS
-                          BEGIN
-                               RAISE_IT.TY.E;
-                               FAILED ( "RENDEZVOUS COMPLETED " &
-                                        "WITHOUT ERROR - TBB" );
-                          EXCEPTION
-                               WHEN TASKING_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "ABNORMAL EXCEPTION " &
-                                             "- TBB" );
-                          END TBB;
-                     BEGIN
-                          NULL;
-                     END;
- 
-                     RAISE_IT.TY.E;    -- TY IS NOW TERMINATED.
- 
-                     FAILED ( "RENDEZVOUS COMPLETED WITHOUT ERROR " &
-                              "- TB" );
- 
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "ABNORMAL EXCEPTION - TB" );
-                END TB;
- 
-                PACKAGE START_TC IS END START_TC;
- 
-                TASK BODY TX IS
-                BEGIN
-                     FAILED ( "TX ACTIVATED" );
-                     -- IN CASE OF FAILURE.
-                     LOOP
-                          SELECT
-                               ACCEPT E;
-                          OR
-                               TERMINATE;
-                          END SELECT;
-                     END LOOP;
-                END TX;
- 
-                PACKAGE START_TZ IS
-                     TASK TZ IS             -- WILL NEVER BE ACTIVATED.
-                          ENTRY E;
-                     END TZ;
-                END START_TZ;
- 
-                PACKAGE BODY START_TC IS
-                     TBREC1 : TBREC;     -- CHECKS THAT TY TERMINATES.
- 
-                     TASK TC IS -- CHECKS THAT TZ TERMINATES.
-                     END TC;
-                 
-                     TASK BODY TC IS
-                     BEGIN
-                          DECLARE  -- THIS BLOCK TO CHECK THAT TCB 
-                                   -- TERMINATES.
-  
-                               TASK TCB IS
-                               END TCB;
-           
-                               TASK BODY TCB IS
-                               BEGIN
-                                    START_TZ.TZ.E;
-                                    FAILED ( "RENDEZVOUS COMPLETED " &
-                                             "WITHOUT " &
-                                             "ERROR - TCB" );
-                               EXCEPTION
-                                    WHEN TASKING_ERROR =>
-                                         NULL;
-                                    WHEN OTHERS =>
-                                         FAILED ( "ABNORMAL " &
-                                                  "EXCEPTION - TCB" );
-                               END TCB;
-                          BEGIN
-                               NULL;
-                          END;
- 
-                          START_TZ.TZ.E;    -- TZ IS NOW TERMINATED.
-       
-                          FAILED ( "RENDEZVOUS COMPLETED WITHOUT " &
-                                   "ERROR - TC" );
-       
-                     EXCEPTION
-                          WHEN TASKING_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ( "ABNORMAL EXCEPTION - TC" );
-                     END TC;
-                END START_TC;     -- TBREC1 AND TC ACTIVATED HERE.
-                      
-                PACKAGE BODY RAISE_IT IS
-                     NTA : ATA := NEW TA;  -- NTA.ALL ACTIVATED HERE.
-  
-                     TASK BODY TY IS
-                     BEGIN
-                          FAILED ( "TY ACTIVATED" );
-                          -- IN CASE OF FAILURE.
-                          LOOP
-                               SELECT
-                                    ACCEPT E;
-                               OR
-                                    TERMINATE;
-                               END SELECT;
-                          END LOOP;
-                     END TY;
-  
-                     PACKAGE XCEPTION IS
-                          I : POSITIVE := IDENT_INT (0); -- RAISE
-                                                    -- CONSTRAINT_ERROR.
-                     END XCEPTION;
-                 
-                     USE XCEPTION;
-  
-                BEGIN   -- TY WOULD BE ACTIVATED HERE.
- 
-                     IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
-                          FAILED ( "PACKAGE DIDN'T RAISE EXCEPTION" );
-                     END IF;
-                END RAISE_IT;
-  
-                PACKAGE BODY START_TZ IS
-                     TASK BODY TZ IS
-                     BEGIN
-                          FAILED ( "TZ ACTIVATED" );
-                          -- IN CASE OF FAILURE.
-                          LOOP
-                               SELECT
-                                    ACCEPT E;
-                               OR
-                                    TERMINATE;
-                               END SELECT;
-                          END LOOP;
-                     END TZ;
-                END START_TZ;    -- TZ WOULD BE ACTIVATED HERE.
-  
-           BEGIN     -- TX WOULD BE ACTIVATED HERE.
-                     -- CAN'T LEAVE BLOCK UNTIL TA, TB, AND TC ARE TERM.
- 
-                FAILED ( "EXCEPTION NOT RAISED" );
-           END;
-  
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN TASKING_ERROR =>
-                FAILED ( "TASKING_ERROR IN MAIN PROGRAM" );
-           WHEN OTHERS =>
-                FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
-      END;
-  
-      RESULT;
-  
- END C93005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,250 ****
- -- C93005C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
- -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
- -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
- -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
- 
- -- CASE 1: TASKS IN DECLARATIVE PART OF A BLOCK AND PACKAGE
- -- SPECIFICATION.  THE TASKS DEPEND ON THE DECLARATIVE PART.
- 
- -- RAC 19-MAR-1985
- -- JBG 06/03/85
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PRAGMA ELABORATE (REPORT);
- 
- with Impdef;
- 
- PACKAGE C93005C_PK1 IS
- 
-      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
-      TASK TYPE UNACTIVATED IS
-           ENTRY E;
-      END UNACTIVATED;
- 
-      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
- 
-      -- *******************************************
-      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
-      --
-      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
-      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
-      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
-      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
-      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
-      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
-      -- DECREMENT).
- 
-      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
-      -- BY ANYONE BUT THEMSELVES.
-      --
-      TASK TYPE MNT_TASK IS
-      END MNT_TASK;
- 
-      FUNCTION F RETURN INTEGER;
- 
-      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
-      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
-      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
-      -- COUNT.
-      --
-      TYPE MNT IS
-           RECORD
-                DUMMY : INTEGER :=  F;
-                T     : MNT_TASK;
-           END RECORD;
- 
-      PROCEDURE CHECK;
- 
- 
-      -- *******************************************
-      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
- 
- END C93005C_PK1;
- 
- 
- PACKAGE BODY C93005C_PK1 IS
- 
- -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
- -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
- 
-      TASK T IS
-           ENTRY E;
-      END;
- 
-      -- ***********************************************
-      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
- -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
- -- ARE STILL ACTIVE.
- 
-      MNT_COUNT : INTEGER := 0;
- 
- -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
- 
-      TASK MNT_COUNTER IS
-           ENTRY INCR;
-           ENTRY DECR;
-      END MNT_COUNTER;
- 
- -- SYNCHRONIZING TASK
- 
-      TASK BODY MNT_COUNTER IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT INCR DO
-                          MNT_COUNT := MNT_COUNT +1;
-                     END INCR;
- 
-                OR  ACCEPT DECR DO
-                          MNT_COUNT := MNT_COUNT -1;
-                     END DECR;
- 
-                OR  TERMINATE;
- 
-                END SELECT;
-           END LOOP;
-      END MNT_COUNTER;
- 
- -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
- --
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           MNT_COUNTER.INCR;
-           RETURN 0;
-      END F;
- 
- -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
- -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
- -- ITSELF IS NOT TERMINATED.
- --
-      PROCEDURE CHECK IS
-      BEGIN
-           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
-                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
-                        "TERMINATED");
-           END IF;
- -- RESET THE COUNT FOR THE NEXT SUBTEST:
-           MNT_COUNT := 0;
-      END CHECK;
- 
- -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
- -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
- -- DECREMENT THE COUNTER.
- --
-      TASK BODY MNT_TASK IS
-      BEGIN
-           DELAY 5.0 * Impdef.One_Second;
-           MNT_COUNTER.DECR;
-      END MNT_TASK;
- 
-      -- ***********************************************
-      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E DO
-                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
-                     END E;
- 
-                OR   TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T;
- 
-      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
-      --
-      TASK BODY UNACTIVATED IS
-      BEGIN
-           T.E;
-      END UNACTIVATED;
- END C93005C_PK1;
- 
- WITH REPORT, C93005C_PK1;
- USE  REPORT, C93005C_PK1;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93005C IS
- 
- 
- BEGIN
- 
-      TEST("C93005C", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
-                      "TASKS");
- 
-      COMMENT("SUBTEST 1: TASKS IN DECL PART OF A BLOCK AND A PACKAGE " &
-              "SPEC");
-      COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
- B1:  DECLARE
-           X : MNT;
-      BEGIN
- B2:       BEGIN
- B3:            DECLARE
-                     TYPE ACC_MNT IS ACCESS MNT;
-                     T1 : UNACTIVATED;
-                     M2 : ACC_MNT := NEW MNT;
- 
-                     PACKAGE RAISES_EXCEPTION IS
-                          T2 : UNACTIVATED;
-                          M3 : ACC_MNT := NEW MNT;
-                          I  : POSITIVE := IDENT_INT(0); -- RAISE
-                                           -- CONSTRAINT_ERROR EXCEPTION
-                     END RAISES_EXCEPTION;
-                     USE RAISES_EXCEPTION;
-                BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
-                     IF EQUAL (I, I) THEN
-                          FAILED ("EXCEPTION NOT RAISED");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
-                END B3;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("SUBTEST 1 COMPLETED");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN B2");
-           END B2;
-      END B1;
- 
-      CHECK;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("EXCEPTION NOT ABSORBED");
-           RESULT;
- END C93005C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,289 ****
- -- C93005D.ADA 
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
- -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
- -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
- -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
- 
- -- CASE 2: TASKS IN DECLARATIVE PART OF A BLOCK AND PACKAGE
- -- SPECIFICATION.  THE TASKS DEPEND ON THE DECLARATIVE PART.
- -- OTHER TASKS HAVE BEEN QUEUED ON THE TASKS' ENTRIES.
- 
- -- RAC 19-MAR-1985
- -- JBG 06/03/85
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- --               ADDED PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- with Impdef;
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PRAGMA ELABORATE (REPORT);
- PACKAGE C93005D_PK1 IS
- 
-      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
-      TASK TYPE UNACTIVATED IS
-           ENTRY E;
-      END UNACTIVATED;
- 
-      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
- 
-      -- *******************************************
-      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
-      --
-      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
-      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
-      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
-      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
-      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
-      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
-      -- DECREMENT).
- 
-      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
-      -- BY ANYONE BUT THEMSELVES.
-      --
-      TASK TYPE MNT_TASK IS
-      END MNT_TASK;
- 
-      FUNCTION F RETURN INTEGER;
- 
-      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
-      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
-      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
-      -- COUNT.
-      --
-      TYPE MNT IS
-           RECORD
-                DUMMY : INTEGER :=  F;
-                T     : MNT_TASK;
-           END RECORD;
- 
-      PROCEDURE CHECK;
- 
- 
-      -- *******************************************
-      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
- 
- END C93005D_PK1;
- 
- 
- PACKAGE BODY C93005D_PK1 IS
- 
- -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
- -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
- 
-      TASK T IS
-           ENTRY E;
-      END;
- 
-      -- ***********************************************
-      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
- -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
- -- ARE STILL ACTIVE.
- 
-      MNT_COUNT : INTEGER := 0;
- 
- -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
- 
-      TASK MNT_COUNTER IS
-           ENTRY INCR;
-           ENTRY DECR;
-      END MNT_COUNTER;
- 
- -- SYNCHRONIZING TASK
- 
-      TASK BODY MNT_COUNTER IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT INCR DO
-                          MNT_COUNT := MNT_COUNT +1;
-                     END INCR;
- 
-                OR  ACCEPT DECR DO
-                          MNT_COUNT := MNT_COUNT -1;
-                     END DECR;
- 
-                OR  TERMINATE;
- 
-                END SELECT;
-           END LOOP;
-      END MNT_COUNTER;
- 
- -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
- --
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           MNT_COUNTER.INCR;
-           RETURN 0;
-      END F;
- 
- -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
- -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
- -- ITSELF IS NOT TERMINATED.
- --
-      PROCEDURE CHECK IS
-      BEGIN
-           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
-                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
-                        "TERMINATED");
-           END IF;
- -- RESET THE COUNT FOR THE NEXT SUBTEST:
-           MNT_COUNT := 0;
-      END CHECK;
- 
- -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
- -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
- -- DECREMENT THE COUNTER.
- --
-      TASK BODY MNT_TASK IS
-      BEGIN
-           DELAY 5.0 * Impdef.One_Second;
-           MNT_COUNTER.DECR;
-      END MNT_TASK;
- 
-      -- ***********************************************
-      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E DO
-                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
-                     END E;
- 
-                OR   TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T;
- 
-      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
-      --
-      TASK BODY UNACTIVATED IS
-      BEGIN
-           T.E;
-      END UNACTIVATED;
- END C93005D_PK1;
- 
- WITH C93005D_PK1; USE C93005D_PK1;
- PRAGMA ELABORATE (C93005D_PK1);
- GENERIC
-      T1 : IN OUT UNACTIVATED;
- PACKAGE C93005D_ENQUEUE IS
-      PROCEDURE REQUIRE_BODY;
- END;
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY C93005D_ENQUEUE IS
- 
-      TASK T3 IS
-      END T3;
- 
-      TASK BODY T3 IS
-      BEGIN
-           T1.E;
-           FAILED ("ENQUEUED CALLER DID NOT GET EXCEPTION");
-      EXCEPTION
-           WHEN TASKING_ERROR => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED");
-      END T3;
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- BEGIN                    -- T3 CALLS T1 HERE
-      DELAY 1.0 * Impdef.One_Second;            -- ENSURE THAT T3 EXECUTES
- END C93005D_ENQUEUE;
- 
- WITH REPORT, C93005D_PK1, C93005D_ENQUEUE;
- USE  REPORT, C93005D_PK1;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93005D IS
- 
- 
- BEGIN
- 
-      TEST("C93005D", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
-                      "TASKS");
- 
-      COMMENT("SUBTEST 2: TASKS IN DECL PART OF A BLOCK AND A PACKAGE " &
-              "SPEC");
-      COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
-      COMMENT("  OTHER TASKS HAVE BEEN ENQUEUED ON THE TASKS' ENTRIES");
- B21: DECLARE
-           X : MNT;
-      BEGIN
- B22:      BEGIN
- B23:           DECLARE
-                     TYPE ACC_MNT IS ACCESS MNT;
-                     T1 : UNACTIVATED;
-                     Y  : ACC_MNT := NEW MNT;
- 
-                     PACKAGE HAS_UNACTIVATED IS
-                          T2 : UNACTIVATED;
-                          Z  : ACC_MNT := NEW MNT;
-                          PACKAGE ENQUEUE1 IS NEW C93005D_ENQUEUE(T1);
-                          PACKAGE ENQUEUE2 IS NEW C93005D_ENQUEUE(T2);
-                          I : POSITIVE := IDENT_INT(0); -- RAISE
-                                          -- CONSTRAINT_ERROR EXCEPTION.
-                     -- TERMINATES T1 AND T2 AND INDIRECTLY THE 2 T3'S
-                     END HAS_UNACTIVATED;
-                     USE HAS_UNACTIVATED;
-                BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
-                     IF EQUAL (I, I) THEN
-                          FAILED ("EXCEPTION NOT RAISED");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
-                END B23;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT("SUBTEST 2 COMPLETED");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN B22");
-           END B22;
-      END B21;
- 
-      CHECK;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("EXCEPTION NOT ABSORBED");
-           RESULT;
- END C93005D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,247 ****
- -- C93005E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
- -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
- -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
- -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
- 
- -- CASE 3: TASKS IN PACKAGE SPECIFICATION.
- --         THE TASKS DON'T DEPEND ON THE PACKAGE SPECIFICATION.
- 
- -- RAC 19-MAR-1985
- -- JBG 06/03/85
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PRAGMA ELABORATE (REPORT);
- PACKAGE C93005E_PK1 IS
- 
-      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
-      TASK TYPE UNACTIVATED IS
-           ENTRY E;
-      END UNACTIVATED;
- 
-      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
- 
-      TYPE BAD_REC IS
-           RECORD
-                T : UNACTIVATED;
-                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
-           END RECORD;
- 
-      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
- 
- 
-      -- *******************************************
-      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
-      --
-      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
-      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
-      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
-      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
-      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
-      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
-      -- DECREMENT).
- 
-      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
-      -- BY ANYONE BUT THEMSELVES.
-      --
-      TASK TYPE MNT_TASK IS
-      END MNT_TASK;
- 
-      FUNCTION F RETURN INTEGER;
- 
-      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
-      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
-      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
-      -- COUNT.
-      --
-      TYPE MNT IS
-           RECORD
-                DUMMY : INTEGER :=  F;
-                T     : MNT_TASK;
-           END RECORD;
- 
-      PROCEDURE CHECK;
- 
- 
-      -- *******************************************
-      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
- 
- END C93005E_PK1;
- 
- with Impdef;
- PACKAGE BODY C93005E_PK1 IS
- 
- -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
- -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
- 
-      TASK T IS
-           ENTRY E;
-      END;
- 
-      -- ***********************************************
-      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
- -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
- -- ARE STILL ACTIVE.
- 
-      MNT_COUNT : INTEGER := 0;
- 
- -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
- 
-      TASK MNT_COUNTER IS
-           ENTRY INCR;
-           ENTRY DECR;
-      END MNT_COUNTER;
- 
- -- SYNCHRONIZING TASK
- 
-      TASK BODY MNT_COUNTER IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT INCR DO
-                          MNT_COUNT := MNT_COUNT +1;
-                     END INCR;
- 
-                OR  ACCEPT DECR DO
-                          MNT_COUNT := MNT_COUNT -1;
-                     END DECR;
- 
-                OR  TERMINATE;
- 
-                END SELECT;
-           END LOOP;
-      END MNT_COUNTER;
- 
- -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
- --
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           MNT_COUNTER.INCR;
-           RETURN 0;
-      END F;
- 
- -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
- -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
- -- ITSELF IS NOT TERMINATED.
- --
-      PROCEDURE CHECK IS
-      BEGIN
-           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
-                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
-                        "TERMINATED");
-           END IF;
- -- RESET THE COUNT FOR THE NEXT SUBTEST:
-           MNT_COUNT := 0;
-      END CHECK;
- 
- -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
- -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
- -- DECREMENT THE COUNTER.
- --
-      TASK BODY MNT_TASK IS
-      BEGIN
-           DELAY 5.0 * Impdef.One_Second;
-           MNT_COUNTER.DECR;
-      END MNT_TASK;
- 
-      -- ***********************************************
-      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E DO
-                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
-                     END E;
- 
-                OR   TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T;
- 
-      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
-      --
-      TASK BODY UNACTIVATED IS
-      BEGIN
-           T.E;
-      END UNACTIVATED;
- END C93005E_PK1;
- 
- WITH REPORT, C93005E_PK1;
- USE  REPORT, C93005E_PK1;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93005E IS
- 
- 
- BEGIN
- 
-      TEST("C93005E", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
-                      "TASKS");
- 
-      COMMENT("SUBTEST 3: TASK IN DECL PART OF PACKAGE SPEC");
-      COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
- B31: DECLARE
-           X : MNT;
-      BEGIN
- B32:      BEGIN
- B33:           DECLARE
-                     PACKAGE RAISES_EXCEPTION IS
-                          TYPE ACC_MNT IS ACCESS MNT;
-                          Y   : ACC_MNT := NEW MNT;
-                          PTR : ACC_BAD_REC := NEW BAD_REC;
-                     END RAISES_EXCEPTION;
-                BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
-                     FAILED("EXCEPTION NOT RAISED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
-                END B33;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT("SUBTEST 3 COMPLETED");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN B32");
-           END B32;
-      END B31;
- 
-      CHECK;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("EXCEPTION NOT ABSORBED");
-           RESULT;
- END C93005E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,255 ****
- -- C93005F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
- -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
- -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
- -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
- 
- -- CASE 4: TASKS IN STATEMENT PART OF A BLOCK.  THE TASKS DEPEND ON THE
- --         DECLARATIVE PART.
- 
- -- RAC 19-MAR-1985
- -- JBG 06/03/85
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- -- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PRAGMA ELABORATE (REPORT);
- PACKAGE C93005F_PK1 IS
- 
-      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
-      TASK TYPE UNACTIVATED IS
-           ENTRY E;
-      END UNACTIVATED;
- 
-      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
- 
-      TYPE BAD_REC IS
-           RECORD
-                T : UNACTIVATED;
-                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
-           END RECORD;
- 
-      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
- 
- 
-      -- *******************************************
-      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
-      --
-      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
-      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
-      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
-      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
-      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
-      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
-      -- DECREMENT).
- 
-      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
-      -- BY ANYONE BUT THEMSELVES.
-      --
-      TASK TYPE MNT_TASK IS
-      END MNT_TASK;
- 
-      FUNCTION F RETURN INTEGER;
- 
-      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
-      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
-      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
-      -- COUNT.
-      --
-      TYPE MNT IS
-           RECORD
-                DUMMY : INTEGER :=  F;
-                T     : MNT_TASK;
-           END RECORD;
- 
-      PROCEDURE CHECK;
- 
- 
-      -- *******************************************
-      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
- 
- END C93005F_PK1;
- 
- with Impdef;
- PACKAGE BODY C93005F_PK1 IS
- 
- -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
- -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
- 
-      TASK T IS
-           ENTRY E;
-      END;
- 
-      -- ***********************************************
-      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
- -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
- -- ARE STILL ACTIVE.
- 
-      MNT_COUNT : INTEGER := 0;
- 
- -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
- 
-      TASK MNT_COUNTER IS
-           ENTRY INCR;
-           ENTRY DECR;
-      END MNT_COUNTER;
- 
- -- SYNCHRONIZING TASK
- 
-      TASK BODY MNT_COUNTER IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT INCR DO
-                          MNT_COUNT := MNT_COUNT +1;
-                     END INCR;
- 
-                OR  ACCEPT DECR DO
-                          MNT_COUNT := MNT_COUNT -1;
-                     END DECR;
- 
-                OR  TERMINATE;
- 
-                END SELECT;
-           END LOOP;
-      END MNT_COUNTER;
- 
- -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
- --
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           MNT_COUNTER.INCR;
-           RETURN 0;
-      END F;
- 
- -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
- -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
- -- ITSELF IS NOT TERMINATED.
- --
-      PROCEDURE CHECK IS
-      BEGIN
-           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
-                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
-                        "TERMINATED");
-           END IF;
- -- RESET THE COUNT FOR THE NEXT SUBTEST:
-           MNT_COUNT := 0;
-      END CHECK;
- 
- -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
- -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
- -- DECREMENT THE COUNTER.
- --
-      TASK BODY MNT_TASK IS
-      BEGIN
-           DELAY 5.0 * Impdef.One_Second;
-           MNT_COUNTER.DECR;
-      END MNT_TASK;
- 
-      -- ***********************************************
-      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E DO
-                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
-                     END E;
- 
-                OR   TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T;
- 
-      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
-      --
-      TASK BODY UNACTIVATED IS
-      BEGIN
-           T.E;
-      END UNACTIVATED;
- END C93005F_PK1;
- 
- WITH REPORT, C93005F_PK1;
- USE  REPORT, C93005F_PK1;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93005F IS
- 
- 
- BEGIN
- 
-      TEST("C93005F", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
-                      "TASKS");
- 
-      COMMENT("SUBTEST 4: TASK IN STATEMENT PART OF BLOCK");
-      COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
- B41: DECLARE
-           X : MNT;
-      BEGIN
- B42:      DECLARE
-                TYPE LOCAL_ACC IS ACCESS BAD_REC;
-                Y : MNT;
-                PTR : LOCAL_ACC;
- 
-                TYPE ACC_MNT IS ACCESS MNT;
-                Z : ACC_MNT;
- 
-           BEGIN
-                Z  := NEW MNT;
-                PTR := NEW BAD_REC;
-                IF PTR.I /= REPORT.IDENT_INT(0) THEN
-                   FAILED ("EXCEPTION NOT RAISED, VALUE CHANGED");
-                ELSE
-                   FAILED ("EXCEPTION NOT RAISED, CONSTRAINT IGNORED");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION IN B42");
-           END B42;
- 
-           COMMENT("SUBTEST 4: COMPLETED");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION NOT ABSORBED");
-      END B41;
- 
-      CHECK;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("EXCEPTION NOT ABSORBED");
-           RESULT;
- END C93005F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,245 ****
- -- C93005G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
- -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
- -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
- -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
- 
- -- CASE 5: TASKS IN STATEMENT PART OF A BLOCK.  THE TASKS DON'T DEPEND
- --         ON THE DECLARATIVE PART.
- 
- -- RAC 19-MAR-1985
- -- JBG 06/03/85
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PRAGMA ELABORATE (REPORT);
- PACKAGE C93005G_PK1 IS
- 
-      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
-      TASK TYPE UNACTIVATED IS
-           ENTRY E;
-      END UNACTIVATED;
- 
-      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
- 
-      TYPE BAD_REC IS
-           RECORD
-                T : UNACTIVATED;
-                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
-           END RECORD;
- 
-      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
- 
- 
-      -- *******************************************
-      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
-      --
-      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
-      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
-      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
-      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
-      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
-      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
-      -- DECREMENT).
- 
-      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
-      -- BY ANYONE BUT THEMSELVES.
-      --
-      TASK TYPE MNT_TASK IS
-      END MNT_TASK;
- 
-      FUNCTION F RETURN INTEGER;
- 
-      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
-      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
-      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
-      -- COUNT.
-      --
-      TYPE MNT IS
-           RECORD
-                DUMMY : INTEGER :=  F;
-                T     : MNT_TASK;
-           END RECORD;
- 
-      PROCEDURE CHECK;
- 
- 
-      -- *******************************************
-      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
- 
- END C93005G_PK1;
- 
- with Impdef;
- PACKAGE BODY C93005G_PK1 IS
- 
- -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
- -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
- 
-      TASK T IS
-           ENTRY E;
-      END;
- 
-      -- ***********************************************
-      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
- -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
- -- ARE STILL ACTIVE.
- 
-      MNT_COUNT : INTEGER := 0;
- 
- -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
- 
-      TASK MNT_COUNTER IS
-           ENTRY INCR;
-           ENTRY DECR;
-      END MNT_COUNTER;
- 
- -- SYNCHRONIZING TASK
- 
-      TASK BODY MNT_COUNTER IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT INCR DO
-                          MNT_COUNT := MNT_COUNT +1;
-                     END INCR;
- 
-                OR  ACCEPT DECR DO
-                          MNT_COUNT := MNT_COUNT -1;
-                     END DECR;
- 
-                OR  TERMINATE;
- 
-                END SELECT;
-           END LOOP;
-      END MNT_COUNTER;
- 
- -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
- --
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           MNT_COUNTER.INCR;
-           RETURN 0;
-      END F;
- 
- -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
- -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
- -- ITSELF IS NOT TERMINATED.
- --
-      PROCEDURE CHECK IS
-      BEGIN
-           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
-                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
-                        "TERMINATED");
-           END IF;
- -- RESET THE COUNT FOR THE NEXT SUBTEST:
-           MNT_COUNT := 0;
-      END CHECK;
- 
- -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
- -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
- -- DECREMENT THE COUNTER.
- --
-      TASK BODY MNT_TASK IS
-      BEGIN
-           DELAY 5.0 * Impdef.One_Second;
-           MNT_COUNTER.DECR;
-      END MNT_TASK;
- 
-      -- ***********************************************
-      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E DO
-                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
-                     END E;
- 
-                OR   TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T;
- 
-      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
-      --
-      TASK BODY UNACTIVATED IS
-      BEGIN
-           T.E;
-      END UNACTIVATED;
- END C93005G_PK1;
- 
- WITH REPORT, C93005G_PK1;
- USE  REPORT, C93005G_PK1;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93005G IS
- 
- 
- BEGIN
- 
-      TEST("C93005G", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
-                      "TASKS");
- 
-      COMMENT("SUBTEST 5: TASK IN STATEMENT PART OF BLOCK");
-      COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
- B51: DECLARE
-           X : MNT;
-      BEGIN
- B52:      DECLARE
-                Y   : MNT;
-                PTR : ACC_BAD_REC;
-           BEGIN
-                PTR := NEW BAD_REC;
-                FAILED ("EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION IN B52");
-           END B52;
- 
-           COMMENT ("SUBTEST 5: COMPLETED");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION NOT ABSORBED");
-      END B51;
- 
-      CHECK;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("EXCEPTION NOT ABSORBED");
-           RESULT;
- END C93005G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93005h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93005h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,250 ****
- -- C93005H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
- -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
- -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
- -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
- 
- -- CASE 6: TASK IN STATEMENT PART OF PACKAGE AND THE TASKS DON'T DEPEND
- --         ON THE PACKAGE SPECIFICATION.
- 
- -- RAC 19-MAR-1985
- -- JBG 06/03/85
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PRAGMA ELABORATE (REPORT);
- PACKAGE C93005H_PK1 IS
- 
-      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
-      TASK TYPE UNACTIVATED IS
-           ENTRY E;
-      END UNACTIVATED;
- 
-      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
- 
-      TYPE BAD_REC IS
-           RECORD
-                T : UNACTIVATED;
-                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
-           END RECORD;
- 
-      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
- 
- 
-      -- *******************************************
-      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
-      --
-      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
-      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
-      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
-      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
-      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
-      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
-      -- DECREMENT).
- 
-      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
-      -- BY ANYONE BUT THEMSELVES.
-      --
-      TASK TYPE MNT_TASK IS
-      END MNT_TASK;
- 
-      FUNCTION F RETURN INTEGER;
- 
-      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
-      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
-      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
-      -- COUNT.
-      --
-      TYPE MNT IS
-           RECORD
-                DUMMY : INTEGER :=  F;
-                T     : MNT_TASK;
-           END RECORD;
- 
-      PROCEDURE CHECK;
- 
- 
-      -- *******************************************
-      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
-      -- *******************************************
- 
- END C93005H_PK1;
- 
- with Impdef;
- PACKAGE BODY C93005H_PK1 IS
- 
- -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
- -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
- 
-      TASK T IS
-           ENTRY E;
-      END;
- 
-      -- ***********************************************
-      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
- -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
- -- ARE STILL ACTIVE.
- 
-      MNT_COUNT : INTEGER := 0;
- 
- -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
- 
-      TASK MNT_COUNTER IS
-           ENTRY INCR;
-           ENTRY DECR;
-      END MNT_COUNTER;
- 
- -- SYNCHRONIZING TASK
- 
-      TASK BODY MNT_COUNTER IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT INCR DO
-                          MNT_COUNT := MNT_COUNT +1;
-                     END INCR;
- 
-                OR  ACCEPT DECR DO
-                          MNT_COUNT := MNT_COUNT -1;
-                     END DECR;
- 
-                OR  TERMINATE;
- 
-                END SELECT;
-           END LOOP;
-      END MNT_COUNTER;
- 
- -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
- --
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           MNT_COUNTER.INCR;
-           RETURN 0;
-      END F;
- 
- -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
- -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
- -- ITSELF IS NOT TERMINATED.
- --
-      PROCEDURE CHECK IS
-      BEGIN
-           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
-                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
-                        "TERMINATED");
-           END IF;
- -- RESET THE COUNT FOR THE NEXT SUBTEST:
-           MNT_COUNT := 0;
-      END CHECK;
- 
- -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
- -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
- -- DECREMENT THE COUNTER.
- --
-      TASK BODY MNT_TASK IS
-      BEGIN
-           DELAY 5.0 * Impdef.One_Second;
-           MNT_COUNTER.DECR;
-      END MNT_TASK;
- 
-      -- ***********************************************
-      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
-      -- ***********************************************
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E DO
-                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
-                     END E;
- 
-                OR   TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T;
- 
-      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
-      --
-      TASK BODY UNACTIVATED IS
-      BEGIN
-           T.E;
-      END UNACTIVATED;
- END C93005H_PK1;
- 
- WITH REPORT, C93005H_PK1;
- USE  REPORT, C93005H_PK1;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C93005H IS
- 
- 
- BEGIN
- 
-      TEST("C93005H", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
-                      "TASKS");
- 
-      COMMENT("SUBTEST 6: TASK IN STATEMENT PART OF PACKAGE");
-      COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
- B61: DECLARE
-           X : MNT;
- 
-           PACKAGE P IS
-                Y : MNT;
-           END P;
- 
-           PACKAGE BODY P IS
-                PTR : ACC_BAD_REC;
-                Z   : MNT;
-           BEGIN
-                PTR := NEW BAD_REC;
-                FAILED("EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN P");
-           END P;
- 
-      BEGIN
-           COMMENT ("SUBTEST 6: COMPLETED");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION NOT ABSORBED");
-      END B61;
- 
-      CHECK;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED ("EXCEPTION NOT ABSORBED");
-           RESULT;
- END C93005H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- C93006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK OBJECT DECLARED IN A LIBRARY PACKAGE SPEC IS
- -- ACTIVATED EVEN IF THE PACKAGE HAS NO BODY.
- 
- -- JEAN-PIERRE ROSEN 16-MAR-1984
- -- JBG 6/1/84
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- PACKAGE C93006A0 IS
-      TASK TYPE TT IS
-           ENTRY E;
-      END;
- END C93006A0;
- 
- PACKAGE BODY C93006A0 IS
-      TASK BODY TT IS
-      BEGIN
-           ACCEPT E;
-      END;
- END C93006A0;
- 
- WITH C93006A0; USE C93006A0;
- PRAGMA ELABORATE(C93006A0);
- PACKAGE C93006A1 IS
-      T : TT;
- END C93006A1;
- 
- with Impdef;
- WITH REPORT, C93006A1, SYSTEM;
- USE  REPORT, C93006A1, SYSTEM;
- PROCEDURE C93006A IS
- BEGIN
- 
-      TEST("C93006A", "CHECK ACTIVATION OF TASK DECLARED IN PACKAGE " &
-                      "SPECIFICATION");
- 
-      SELECT
-           T.E;
-      OR 
-           DELAY 60.0 * Impdef.One_Second;
-           FAILED("RENDEZVOUS NOT ACCEPTED WITHIN 60 SECONDS");
-      END SELECT;
- 
-      RESULT;
- END C93006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C93007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF AN ATTEMPT IS MADE TO ACTIVATE A TASK BEFORE ITS
- --     BODY HAS BEEN ELABORATED, THE TASK IS COMPLETED AND "PROGRAM_
- --     ERROR" (RATHER THAN "TASKING_ERROR") IS RAISED.
- 
- -- HISTORY:
- --     DHH 03/16/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C93007A IS
- 
- BEGIN
- 
-      TEST("C93007A", "CHECK THAT IF AN ATTEMPT IS MADE TO ACTIVATE " &
-                      "A TASK BEFORE ITS BODY HAS BEEN ELABORATED, " &
-                      "THE TASK IS COMPLETED AND ""PROGRAM_ERROR"" " &
-                      "(RATHER THAN ""TASKING_ERROR"") IS RAISED");
- 
-      DECLARE
-           TASK TYPE PROG_ERR IS
-                ENTRY START;
-           END PROG_ERR;
- 
-           TYPE REC IS
-                RECORD
-                     B : PROG_ERR;
-                END RECORD;
- 
-           TYPE ACC IS ACCESS PROG_ERR;
- 
-           PACKAGE P IS
-                OBJ : REC;
-           END P;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                FAILED("EXCEPTION NOT RAISED - 1");
-                OBJ.B.START;
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     NULL;
-                WHEN TASKING_ERROR =>
-                     FAILED("TASKING ERROR RAISED INCORRECTLY");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED");
-           END P;
- 
-           PACKAGE Q IS
-                OBJ : ACC;
-           END Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                OBJ := NEW PROG_ERR;
-                FAILED("EXCEPTION NOT RAISED - 2");
-                OBJ.START;
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     NULL;
-                WHEN TASKING_ERROR =>
-                     FAILED("ACCESS TASKING ERROR RAISED INCORRECTLY");
-                WHEN OTHERS =>
-                     FAILED("ACCESS UNEXPECTED EXCEPTION RAISED");
-           END;
- 
-           TASK BODY PROG_ERR IS
-           BEGIN
-                ACCEPT START DO
-                     IF TRUE THEN
-                          COMMENT("IRRELEVANT");
-                     END IF;
-                END START;
-           END PROG_ERR;
-      BEGIN
-           NULL;
-      END; -- DECLARE
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN PROGRAM_ERROR =>
-           FAILED("PROGRAM_ERROR RAISED AT INCORRECT POSITION");
-           RESULT;
- 
-      WHEN OTHERS =>
-           FAILED("UNEXPECTED EXCEPTION RAISED");
-           RESULT;
- 
- END C93007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C93008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR A TASK CREATED BY AN OBJECT DECLARATION, EXECUTION 
- -- DOES NOT PROCEED IN PARALLEL WITH ACTIVATION.
- 
- -- R.WILLIAMS 8/20/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C93008A IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      TASK T IS
-           ENTRY FINIT_POS (DIGT : IN ARG);
-      END T;
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT FINIT_POS (DIGT : IN ARG) DO
-                          SPYNUMB := 10*SPYNUMB+DIGT;
-                     END FINIT_POS;
-                OR
-                     TERMINATE;
-                END SELECT;          
-           END LOOP;
-      END T;
- 
- BEGIN
- 
-      TEST ("C93008A", "CHECK THAT EXECUTION DOES NOT PROCEED IN  " &
-                       "PARALLEL WITH ACTIVATION OF A TASK CREATED " &
-                       "BY AN OBJECT DECLARATION");
- 
- BLOCK:
-      DECLARE
- 
-           TASK TYPE TT1;
- 
-           TASK TT2;
- 
-           T1 : TT1;
- 
-           TASK BODY TT1 IS
-                PACKAGE DUMMY IS
-                END DUMMY;
- 
-                PACKAGE BODY DUMMY IS
-                BEGIN
-                     DELAY 2.0 * Impdef.One_Second;
-                     T.FINIT_POS(1);
-                END DUMMY;
-           BEGIN
-                NULL;
-           END TT1;
- 
-           TASK BODY TT2 IS
-                PACKAGE DUMMY IS
-                END DUMMY;
- 
-                PACKAGE BODY DUMMY IS
-                BEGIN
-                     DELAY 2.0 * Impdef.One_Second;
-                     T.FINIT_POS(2);
-                END DUMMY;
-           BEGIN
-                NULL;
-           END TT2;
-           
- 
-      BEGIN               -- TASKS ACTIVATED NOW.
- 
-           IF SPYNUMB = 12 OR SPYNUMB = 21 THEN
-                NULL;
-           ELSE
-                FAILED ("TASKS NOT ACTIVATED PROPERLY - SPYNUMB HAS " &
-                        "ACTUAL VALUE OF: " & INTEGER'IMAGE(SPYNUMB));
-           END IF;
-      END BLOCK;
- 
-      RESULT;
- 
- END C93008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93008b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c93008b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c93008b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C93008B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AFTER CREATION OF A TASK OBJECT BY AN ALLOCATOR, ANY
- -- OPERATION INVOLVING THE RESULT DELIVERED BY THE ALLOCATOR IS
- -- EXECUTED ONLY AFTER THE ACTIVATION OF THE TASK HAS COMPLETED.
- 
- -- WEI  3/ 4/82
- -- TBN 12/20/85     RENAMED FROM C930AJA-B.ADA. ADDED DELAY STATEMENT
- --                  DURING TASK ACTIVATION.
- -- RJW 4/11/86      ADDED PACKAGE DUMMY.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C93008B IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-           RETURN DIGT;
-      END FINIT_POS;
- 
- BEGIN
- 
-      TEST ("C93008B", "USE OF RESULT AFTER CREATION OF " &
-                       "A TASK BY ALLOCATOR");
- 
- BLOCK:
-      DECLARE
- 
-           TASK TYPE TT1;
- 
-           TYPE ATT1 IS ACCESS TT1;
-           TYPE ARRAY_ATT1 IS ARRAY (NATURAL RANGE 2 .. 3) OF ATT1;
-           MY_ARRAY : ARRAY_ATT1;
-           POINTER_TT1 : ATT1;
- 
-           TASK BODY TT1 IS
-                PACKAGE DUMMY IS
-                END DUMMY;
- 
-                PACKAGE BODY DUMMY IS
-                BEGIN
-                     DELAY 2.0 * Impdef.One_Second;
-                     DECLARE
-                          IDUMMY1 : NATURAL := FINIT_POS (1);
-                     BEGIN
-                          NULL;
-                     END;
-                END DUMMY;
-           BEGIN
-                NULL;
-           END TT1;
- 
-      BEGIN
- 
-           MY_ARRAY := (2 => NEW TT1, 3 => NULL);  -- TASK ACTIVATED NOW.
-           POINTER_TT1 := MY_ARRAY (FINIT_POS (2));
- 
-           MY_ARRAY (FINIT_POS (3)) := POINTER_TT1;
- 
-           IF SPYNUMB /= 123 THEN
-                IF SPYNUMB = 132 OR SPYNUMB = 13 OR
-                   SPYNUMB = 12  OR SPYNUMB = 1  OR
-                   SPYNUMB = 0
-                THEN
-                     FAILED ("TASK ACTIVATION RIGHT IN TIME, " &
-                             "BUT OTHER ERROR");
-                ELSE
-                     FAILED ("RESULT OF ALLOCATOR ACCESSED BEFORE " &
-                             "TASK ACTIVATION HAS COMPLETED");
-                END IF;
-                COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-           END IF;
-      END BLOCK;
- 
-      RESULT;
- 
- END C93008B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,212 ****
- -- C940001.A
- --
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a protected object provides coordinated access to
- --      shared data.  Check that it can be used to sequence a number of tasks.
- --      Use the protected object to control a single token for which three 
- --      tasks compete.  Check that only one task is running at a time and that
- --      all tasks get a chance to run sometime.
- --
- -- TEST DESCRIPTION:
- --      Declare a protected type with two entries.  A task may call the Take
- --      entry to get a token which allows it to continue processing.  If it 
- --      has the token, it may call the Give entry to return it.  The tasks 
- --      implement a discipline whereby only the task with the token may be 
- --      active.  The test does not require any specific order for the tasks 
- --      to run.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      07 Jul 96   SAIC    Fixed spelling nits.
- --
- --!
- 
- package C940001_0 is
- 
-   type Token_Type is private;
-   True_Token : constant Token_Type;   -- Create a deferred constant in order 
-                                       -- to provide a component init for the
-                                       -- protected object
- 
-   protected type Token_Mgr_Prot_Unit is
-     entry Take (T : out Token_Type);
-     entry Give (T : in out  Token_Type);
-   private
-     Token : Token_Type := True_Token;
-   end Token_Mgr_Prot_Unit;
- 
-   function Init_Token return Token_Type;   -- call to initialize an 
-                                            -- object of Token_Type
-   function Token_Value (T : Token_Type) return Boolean;
-                                            -- call to inspect the value of an
-                                            -- object of Token_Type
- private
-   type Token_Type is new boolean;
-   True_Token : constant Token_Type := true;
- end C940001_0;
- 
- --=================================================================--
- 
- package body C940001_0 is
-   protected body  Token_Mgr_Prot_Unit is
-     entry Take (T : out Token_Type) when Token = true is
-       begin                   -- Calling task will Take the token, so
-         T := Token;           -- check first that token_mgr owns the
-         Token := false;       -- token to give, then give it to caller
-       end Take;
- 
-     entry Give (T : in out Token_Type)  when Token = false is
-       begin                   -- Calling task will Give the token back,
-         if T = true then      -- so first check that token_mgr does not
-           Token := T;         -- own the token, then check that the task has
-           T := false;         -- the token to give, then take it from the
-         end if;               -- task
-                               -- if caller does not own the token, then
-       end Give;               -- it falls out of the entry body with no
-   end Token_Mgr_Prot_Unit;    -- action
- 
-   function Init_Token return Token_Type is
-     begin
-       return false;
-     end Init_Token;
- 
-   function Token_Value (T : Token_Type) return Boolean is
-     begin
-       return Boolean (T);
-     end Token_Value;
- 
- end C940001_0;
- 
- --===============================================================--
- 
- with Report;
- with ImpDef;
- with C940001_0;
- 
- procedure C940001 is
- 
-   type TC_Int_Type is range 0..2;
-               -- range is very narrow so that erroneous execution may
-               -- raise Constraint_Error
- 
-   type TC_Artifact_Type is record
-      TC_Int : TC_Int_Type := 1;
-      Number_of_Accesses : integer := 0;
-   end record;
- 
-   TC_Artifact : TC_Artifact_Type;
- 
-   Sequence_Mgr : C940001_0.Token_Mgr_Prot_Unit;
-     
-   procedure Bump (Item : in out TC_Int_Type) is
-     begin
-       Item := Item + 1;
-     exception
-       when Constraint_Error =>
-         Report.Failed ("Incremented without corresponding decrement");
-       when others =>
-         Report.Failed ("Bump raised Unexpected Exception");
-    end Bump;
- 
-   procedure Decrement (Item : in out TC_Int_Type) is
-     begin
-       Item := Item - 1;
-     exception
-       when Constraint_Error =>
-         Report.Failed ("Decremented without corresponding increment");
-       when others =>
-         Report.Failed ("Decrement raised Unexpected Exception");
-     end Decrement;
-     
-     --==============--
- 
-   task type Network_Node_Type;
- 
-   task body Network_Node_Type is
- 
-     Slot_for_Token : C940001_0.Token_Type := C940001_0.Init_Token;
- 
-     begin
-  
-       -- Ask for token - if request is not granted, task will be queued
-       Sequence_Mgr.Take (Slot_for_Token);        
- 
-       -- Task now has token and may perform its work
- 
-       --==========================--
-       -- in this case, the work is to ensure that the test results
-       -- are the expected ones!
-       --==========================--
-       Bump (TC_Artifact.TC_Int);   -- increment when request is granted
-       TC_Artifact.Number_Of_Accesses := 
-         TC_Artifact.Number_Of_Accesses + 1;
-       if not C940001_0.Token_Value ( Slot_for_Token) then
-         Report.Failed ("Incorrect results from entry Take");
-       end if;
-  
-       -- give a chance for other tasks to (incorrectly) run
-       delay ImpDef.Minimum_Task_Switch;
- 
-       Decrement (TC_Artifact.TC_Int); -- prepare to return token
- 
-       -- Task has completed its work and will return token
- 
-       Sequence_Mgr.Give (Slot_for_Token);   -- return token to sequence manager
- 
-       if c940001_0.Token_Value (Slot_for_Token) then
-         Report.Failed ("Incorrect results from entry Give");
-       end if;
- 
-     exception
-       when others => Report.Failed ("Unexpected exception raised in task");
- 
-     end Network_Node_Type; 
- 
-     --==============--
- 
- begin
- 
-   Report.Test ("C940001", "Check that a protected object can control " &
-                           "tasks by coordinating access to shared data");
- 
-   declare
-      Node_1, Node_2, Node_3 : Network_Node_Type;
-                            -- declare three tasks which will compete for
-                            -- a single token, managed by Sequence Manager
- 
-   begin                    -- tasks start
-     null;
-   end; -- wait for all tasks to terminate before reporting result
- 
-   if TC_Artifact.Number_of_Accesses /= 3 then
-     Report.Failed ("Not all tasks got through");
-   end if;
- 
-   Report.Result;
- 
- end C940001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,309 ****
- -- C940002.A
- --
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a protected object provides coordinated access to shared 
- --      data.  Check that it can implement a semaphore-like construct using a
- --      parameterless procedure which allows a specific maximum number of tasks
- --      to run and excludes all others
- --
- -- TEST DESCRIPTION:
- --      Implement a counting semaphore type that can be initialized to a 
- --      specific number of available resources.  Declare an entry for 
- --      requesting a resource and a procedure for releasing it.  Declare an 
- --      object of this type, initialized to two resources.  Declare and start 
- --      three tasks each of which asks for a resource.  Verify that only two 
- --      resources are granted and that the last task in is queued.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package C940002_0 is
-      -- Semaphores
- 
-   protected type Semaphore_Type (Resources_Available : Integer :=1) is
-     entry Request;
-     procedure Release;
-     function Available return Integer;
-   private
-     Currently_Available : Integer := Resources_Available;
-   end Semaphore_Type;
- 
-   Max_Resources : constant Integer := 2;
-   Resource      : Semaphore_Type (Max_Resources);
- 
- end C940002_0;
-  -- Semaphores;
- 
- 
-           --========================================================--
- 
- 
- package body C940002_0 is
-           -- Semaphores
- 
-   protected body Semaphore_Type is
- 
-     entry Request when Currently_Available >0 is  -- when granted, secures
-     begin                                         -- a resource
-       Currently_Available := Currently_Available - 1;
-     end Request;
- 
-     procedure Release is                          -- when called, releases
-     begin                                         -- a resource
-       Currently_Available := Currently_Available + 1;
-     end Release;
- 
-     function Available return Integer is          -- returns number of
-     begin                                         -- available resources
-       return Currently_Available;
-     end Available;
- 
-   end Semaphore_Type;
- 
- end C940002_0;
-  -- Semaphores;
- 
- 
-           --========================================================--
- 
- 
- package C940002_1 is
-      -- Task_Pkg
- 
-   task type Requesting_Task is
-      entry Done;                        -- call on Done instructs the task
-   end Requesting_Task;                  -- to release resource
- 
-   type Task_Ptr is access Requesting_Task;
- 
-   protected Counter is
-     procedure Increment;
-     procedure Decrement;
-     function Number return integer;
-   private
-     Count : Integer := 0;
-   end Counter;
- 
-   protected Hold_Lock is
-     procedure Lock;
-     procedure Unlock;
-     function  Locked return Boolean;
-   private
-     Lock_State  : Boolean := true;        -- starts out locked
-   end Hold_Lock;
- 
- 
- end C940002_1;
-  -- Task_Pkg
- 
- 
-           --========================================================--
- 
- 
- with Report;
- with C940002_0;
-   -- Semaphores;    
- 
- package body C940002_1 is
-           -- Task_Pkg is
-   
-   protected body Counter is
- 
-     procedure Increment is
-       begin
-         Count := Count + 1;
-       end Increment;
- 
-     procedure Decrement is
-       begin
-         Count := Count - 1;
-       end Decrement;
- 
-     function Number return Integer is
-       begin
-         return Count;
-       end Number;
- 
-   end Counter;
- 
- 
-   protected body Hold_Lock is
- 
-     procedure Lock is 
-     begin
-       Lock_State := true;
-     end Lock;
- 
-     procedure Unlock is 
-     begin
-       Lock_State := false;
-     end Unlock;
- 
-     function  Locked return Boolean is 
-     begin
-       return Lock_State;
-     end Locked;
- 
-   end Hold_Lock;
- 
- 
-   task body Requesting_Task is
-   begin
-     C940002_0.Resource.Request;        -- request a resource
-                                        -- if resource is not available, 
-                                        -- task will be queued to wait
-     Counter.Increment;                 -- add to count of resources obtained
-     Hold_Lock.Unlock;                  -- and unlock Lock - system is stable;
-                                        -- status may now be queried
- 
-     accept Done do                     -- hold resource until Done is called
-       C940002_0.Resource.Release;      -- release the resource and
-       Counter.Decrement;               -- note release
-     end Done;                           
- 
-   exception
-     when others => Report.Failed ("Unexpected Exception in Requesting_Task");
-   end Requesting_Task;
- 
- end C940002_1;
-  -- Task_Pkg;
- 
- 
-           --========================================================--
- 
- 
- with Report;
- with ImpDef;
- with C940002_0,
-   -- Semaphores, 
-      C940002_1;
-   -- Task_Pkg;
- 
- procedure C940002 is
- 
-   package Semaphores renames C940002_0;
-   package Task_Pkg renames C940002_1;
- 
-   Ptr1,
-   Ptr2, 
-   Ptr3 : Task_Pkg.Task_Ptr;
-   Num  : Integer;
- 
-   procedure Spinlock is
-     begin
-       -- loop until unlocked
-       while Task_Pkg.Hold_Lock.Locked loop
-         delay ImpDef.Minimum_Task_Switch;   
-       end loop;
-       Task_Pkg.Hold_Lock.Lock;
-     end Spinlock;
- 
- begin
- 
-   Report.Test ("C940002", "Check that a protected record can be used to " &
-                           "control access to resources");
- 
-   if (Task_Pkg.Counter.Number /=0)
-   or (Semaphores.Resource.Available /= 2) then
-     Report.Failed ("Wrong initial conditions");
-   end if;
-                                   
-   Ptr1 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
-                                    -- resource; request for resource should 
-                                    -- be granted
-   Spinlock;                        -- ensure that task obtains resource
- 
-                                    -- Task 1 waiting for call to Done
-                                    -- One resource assigned to task 1
-                                    -- One resource still available
-   if (Task_Pkg.Counter.Number /= 1) 
-   or (Semaphores.Resource.Available /= 1) then
-     Report.Failed ("Resource not assigned to task 1");
-   end if;
- 
-   Ptr2 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
-                                    -- resource; request for resource should 
-                                    -- be granted
-   Spinlock;                        -- ensure that task obtains resource  
- 
-                                    -- Task 1 waiting for call to Done
-                                    -- Task 2 waiting for call to Done
-                                    -- Resources held by tasks 1 and 2
-                                    -- No resources available
-   if (Task_Pkg.Counter.Number /= 2) 
-   or (Semaphores.Resource.Available /= 0) then
-     Report.Failed ("Resource not assigned to task 2");
-   end if;
- 
-   Ptr3 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
-                                    -- resource; request for resource should 
-                                    -- be denied and task queued to wait for 
-                                    -- next available resource
- 
- 
-   Ptr1.all.Done;                   -- Task 1 releases resource and lock
-                                    -- Resource should be given to queued task
-   Spinlock;                        -- ensure that resource is released
- 
- 
-                                    -- Task 1 holds no resource
-                                    -- One resource still assigned to task 2
-                                    -- One resource assigned to task 3
-                                    -- No resources available
-   if (Task_Pkg.Counter.Number /= 2) 
-   or (Semaphores.Resource.Available /= 0) then
-     Report.Failed ("Resource not properly released/assigned to task 3");
-   end if;
- 
-   Ptr2.all.Done;                   -- Task 2 releases resource and lock
-                                    -- No outstanding request for resource
- 
-                                    -- Tasks 1 and 2 hold no resources
-                                    -- One resource assigned to task 3
-                                    -- One resource available
-   if (Task_Pkg.Counter.Number /= 1)
-   or (Semaphores.Resource.Available /= 1) then 
-     Report.Failed ("Resource not properly released from task 2");
-   end if;
- 
-   Ptr3.all.Done;                   -- Task 3 releases resource and lock
- 
-                                    -- All resources released
-                                    -- All tasks terminated (or close)
-                                    -- Two resources available
-   if (Task_Pkg.Counter.Number /=0) 
-   or (Semaphores.Resource.Available /= 2) then 
-     Report.Failed ("Resource not properly released from task 3");
-   end if;
- 
-   Report.Result;
- 
- end C940002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,416 ****
- -- C940004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that a protected record can be used to control access to
- --      resources (data internal to the protected record).
- --
- -- TEST DESCRIPTION:
- --      Declare a resource descriptor tagged type.  Extend the type and
- --      use the extended type in a protected data structure.
- --      Implement a binary semaphore type.  Declare an entry for
- --      requesting a specific resource and an procedure for releasing the
- --      same resource.  Declare an object of this (protected) type.
- --      Declare and start three tasks each of which asks for a resource
- --      when directed to.  Verify that resources are properly allocated
- --      and deallocated.
- --
- --
- -- CHANGE HISTORY:
- --
- --      12 DEC 93   SAIC    Initial PreRelease version
- --      23 JUL 95   SAIC    Second PreRelease version
- --      16 OCT 95   SAIC    ACVC 2.1
- --      13 MAR 03   RLB     Fixed race condition in test.
- --
- --!
- 
- package C940004_0 is
- -- Resource_Pkg
- 
-    type ID_Type is new Integer range 0..10;
-    type User_Descriptor_Type is tagged record
-       Id : ID_Type := 0;
-    end record;
- 
- end C940004_0; -- Resource_Pkg
- 
- --============================--
- -- no body for C940004_0
- --=============================--
- 
- with C940004_0; -- Resource_Pkg
- 
- -- This generic package implements a semaphore to control a single resource
- 
- generic
- 
-   type Generic_Record_Type is new C940004_0.User_Descriptor_Type
-                                                          with private;
- 
- package C940004_1 is
- -- Generic_Semaphore_Pkg
-                 -- generic package extends the tagged formal generic
-                 -- type with some implementation relevant details, and
-                 -- it provides a semaphore with operations that work
-                 -- on that type
-    type User_Rec_Type is new Generic_Record_Type with private;
- 
-    protected type Semaphore_Type is
-       function  TC_Count return Integer;
-       entry     Request (R : in out User_Rec_Type);
-       procedure Release (R : in out User_Rec_Type);
-    private
-       In_Use : Boolean := false;
-    end Semaphore_Type;
- 
-    function Has_Access (R : User_Rec_Type) return Boolean;
- 
- private
- 
-    type User_Rec_Type is new Generic_Record_Type with record
-       Access_To_Resource : boolean := false;
-    end record;
- 
- end C940004_1;        -- Generic_Semaphore_Pkg
- 
- --===================================================--
- 
- package body C940004_1 is
- -- Generic_Semaphore_Pkg
- 
-    protected body Semaphore_Type is
- 
-       function TC_Count return Integer is
-       begin
-          return Request'Count;
-       end TC_Count;
- 
-       entry Request (R : in out User_Rec_Type)
-                                                when not In_Use is
-       begin
-          In_Use := true;
-          R.Access_To_Resource := true;
-       end Request;
- 
-       procedure Release (R : in out User_Rec_Type) is
-       begin
-          In_Use := false;
-          R.Access_To_Resource := false;
-       end Release;
- 
-    end Semaphore_Type;
- 
-    function Has_Access (R : User_Rec_Type) return Boolean is
-    begin
-       return R.Access_To_Resource;
-    end Has_Access;
- 
- end C940004_1;       -- Generic_Semaphore_Pkg
- 
- --=============================================--
- 
- with Report;
- with C940004_0; -- Resource_Pkg,
- with C940004_1; -- Generic_Semaphore_Pkg;
- 
- package C940004_2 is
- -- Printer_Mgr_Pkg
- 
-    -- Instantiate the generic to get code to manage a single printer;
-    -- User processes contend for the printer, asking for it by a call
-    -- to Request, and relinquishing it by a call to Release
- 
-    -- This package extends a tagged type to customize it for the printer
-    -- in question, then it uses the type to instantiate the generic and
-    -- declare a semaphore specific to the particular resource
- 
-    package Resource_Pkg          renames C940004_0;
- 
-    type User_Desc_Type is new Resource_Pkg.User_Descriptor_Type with record
-        New_Details : Integer := 0;    -- for example
-    end record;
- 
-    package Instantiation is new C940004_1   -- Generic_Semaphore_Pkg
-                                    (Generic_Record_Type => User_Desc_Type);
- 
-    Printer_Access_Mgr : Instantiation.Semaphore_Type;
- 
- 
- end C940004_2; -- Printer_Mgr_Pkg
- 
- --============================--
- -- no body for C940004_2
- --============================--
- 
- with C940004_0; -- Resource_Pkg,
- with C940004_2; -- Printer_Mgr_Pkg;
- 
- package C940004_3 is
- -- User_Task_Pkg
- 
- -- This package models user tasks  that will request and release
- -- the printer
-    package Resource_Pkg    renames C940004_0;
-    package Printer_Mgr_Pkg renames C940004_2;
- 
-    task type User_Task_Type (ID : Resource_Pkg.ID_Type) is
-       entry Get_Printer;   -- instructs task to request resource
- 
-       entry Release_Printer    -- instructs task to release printer
-           (Descriptor : in out Printer_Mgr_pkg.Instantiation.User_Rec_Type);
- 
-       --==================--
-       -- Test management machinery
-       --==================--
-       entry TC_Get_Descriptor       -- returns descriptor
-             (Descriptor :  out Printer_Mgr_Pkg.Instantiation.User_Rec_Type);
- 
-    end User_Task_Type;
- 
-    --==================--
-    -- Test management machinery
-    --==================--
-    TC_Times_Obtained : Integer := 0;
-    TC_Times_Released : Integer := 0;
- 
- end C940004_3; -- User_Task_Pkg;
- 
- --==============================================--
- 
- with Report;
- with C940004_0; -- Resource_Pkg,
- with C940004_2; -- Printer_Mgr_Pkg,
- 
- package body C940004_3 is
- -- User_Task_Pkg
- 
-    task body User_Task_Type is
-       D : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
-    begin
-       D.Id := ID;
-             -----------------------------------
-       Main:
-       loop
-          select
-             accept Get_Printer;
-             Printer_Mgr_Pkg.Printer_Access_Mgr.Request (D);
-                       -- request resource; if resource is not available,
-                       -- task will be queued to wait
-             --===================--
-             -- Test management machinery
-             --===================--
-             TC_Times_Obtained := TC_Times_Obtained + 1;
-                       -- when request granted, note it and post a message
- 
-          or
-            accept Release_Printer  (Descriptor : in out
-                              Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
- 
-               Printer_Mgr_Pkg.Printer_Access_Mgr.Release (D);
-                           -- release the resource, note its release
-               TC_Times_Released := TC_Times_Released + 1;
-               Descriptor := D;
-            end Release_Printer;
-            exit Main;
- 
-          or
-            accept TC_Get_Descriptor  (Descriptor : out
-                             Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
- 
-               Descriptor := D;
-            end TC_Get_Descriptor;
- 
-          end select;
-       end loop main;
- 
-    exception
-       when others => Report.Failed ("exception raised in User_Task");
-    end User_Task_Type;
- 
- end C940004_3;   -- User_Task_Pkg;
- 
- --==========================================================--
- 
- with Report;
- with ImpDef;
- 
- with C940004_0; -- Resource_Pkg,
- with C940004_2; -- Printer_Mgr_Pkg,
- with C940004_3; -- User_Task_Pkg;
- 
- procedure C940004 is
-    Verbose : constant Boolean := False;
-    package Resource_Pkg    renames C940004_0;
-    package Printer_Mgr_Pkg renames C940004_2;
-    package User_Task_Pkg   renames C940004_3;
- 
-    Task1 : User_Task_Pkg.User_Task_Type (1);
-    Task2 : User_Task_Pkg.User_Task_Type (2);
-    Task3 : User_Task_Pkg.User_Task_Type (3);
- 
-    User_Rec_1,
-    User_Rec_2,
-    User_Rec_3 : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
- 
- begin
- 
-    Report.Test ("C940004", "Check that a protected record can be used to " &
-                            "control access to resources");
- 
-    if    (User_Task_Pkg.TC_Times_Obtained /= 0)
-       or (User_Task_Pkg.TC_Times_Released /= 0)
-       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
-       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
-       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
-          Report.Failed ("Wrong initial conditions");
-    end if;
- 
-    Task1.Get_Printer;           -- ask for resource
-                                 -- request for resource should be granted
-    Task1.TC_Get_Descriptor (User_Rec_1);-- wait here 'til task gets resource
- 
-    if        (User_Task_Pkg.TC_Times_Obtained /= 1)
-       or     (User_Task_Pkg.TC_Times_Released /= 0)
-       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1) then
-          Report.Failed ("Resource not assigned to task 1");
-    end if;
- 
-    Task2.Get_Printer;              -- ask for resource
-                                    -- request for resource should be denied
-                                    -- and task queued to wait
- 
-    -- Task 1 still waiting to accept Release_Printer, still holds resource
-    -- Task 2 queued on Semaphore.Request
- 
-    -- Ensure that Task2 is queued before continuing to make checks and queue
-    -- Task3. We use a for loop here to avoid hangs in broken implementations.
-    for TC_Cnt in 1 .. 20 loop
-       exit when Printer_Mgr_Pkg.Printer_Access_Mgr.TC_Count >= 1;
-       delay Impdef.Minimum_Task_Switch;
-    end loop;
- 
-    if    (User_Task_Pkg.TC_Times_Obtained /= 1)
-       or (User_Task_Pkg.TC_Times_Released /= 0) then
-         Report.Failed ("Resource assigned to task 2");
-    end if;
- 
-    Task3.Get_Printer;        -- ask for resource
-                              -- request for resource should be denied
-                              -- and task 3 queued on Semaphore.Request
- 
-    Task1.Release_Printer (User_Rec_1);-- task 1 releases resource
-                                       -- released resource should be given to
-                                       -- queued task 2.
- 
-    Task2.TC_Get_Descriptor (User_Rec_2);-- wait here for task 2
- 
-    -- Task 1 has released resource and completed
-    -- Task 2 has seized the resource
-    -- Task 3 is queued on Semaphore.Request
- 
-    if        (User_Task_Pkg.TC_Times_Obtained /= 2)
-       or     (User_Task_Pkg.TC_Times_Released /= 1)
-       or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
-       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2) then
-           Report.Failed ("Resource not properly released/assigned" &
-                          " to task 2");
-           if Verbose then
-              Report.Comment ("TC_Times_Obtained: " &
-                  Integer'Image (User_Task_Pkg.TC_Times_Obtained));
-              Report.Comment ("TC_Times_Released: " &
-                  Integer'Image (User_Task_Pkg.TC_Times_Released));
-              Report.Comment ("User 1 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_1)));
-              Report.Comment ("User 2 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_2)));
-           end if;
-    end if;
- 
-    Task2.Release_Printer (User_Rec_2);-- task 2 releases resource
- 
-    -- task 3 is released from queue, and is given resource
- 
-    Task3.TC_Get_Descriptor (User_Rec_3);-- wait for task 3
- 
-    if        (User_Task_Pkg.TC_Times_Obtained /= 3)
-       or     (User_Task_Pkg.TC_Times_Released /= 2)
-       or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
-       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
-         Report.Failed ("Resource not properly released/assigned " &
-                        "to task 3");
-           if Verbose then
-              Report.Comment ("TC_Times_Obtained: " &
-                 Integer'Image (User_Task_Pkg.TC_Times_Obtained));
-              Report.Comment ("TC_Times_Released: " &
-                 Integer'Image (User_Task_Pkg.TC_Times_Released));
-              Report.Comment ("User 1 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_1)));
-              Report.Comment ("User 2 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_2)));
-              Report.Comment ("User 3 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_3)));
-           end if;
-    end if;
- 
-    Task3.Release_Printer (User_Rec_3);-- task 3 releases resource
- 
-    if    (User_Task_Pkg.TC_Times_Obtained /=3)
-       or (User_Task_Pkg.TC_Times_Released /=3)
-       or Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
-          Report.Failed ("Resource not properly released by task 3");
-          if Verbose then
-              Report.Comment ("TC_Times_Obtained: " &
-                 Integer'Image (User_Task_Pkg.TC_Times_Obtained));
-              Report.Comment ("TC_Times_Released: " &
-                 Integer'Image (User_Task_Pkg.TC_Times_Released));
-              Report.Comment ("User 1 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_1)));
-              Report.Comment ("User 2 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_2)));
-              Report.Comment ("User 3 Has_Access:" &
-                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
-                                Has_Access (User_Rec_3)));
-          end if;
- 
-    end if;
- 
-    -- Ensure that all tasks have terminated before reporting the result
-    while not (Task1'terminated
-               and Task2'terminated
-               and Task3'terminated) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    Report.Result;
- 
- end C940004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,370 ****
- -- C940005.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the body of a protected function can have internal calls
- --      to other protected functions and that the body of a protected
- --      procedure can have internal calls to protected procedures and to 
- --      protected functions.
- --
- -- TEST DESCRIPTION:
- --      Simulate a meter at a freeway on-ramp which, when real-time sensors
- --      determine that the freeway is becoming saturated, triggers stop lights
- --      which control the access of vehicles to prevent further saturation. 
- --      Each on-ramp is represented by a protected object - in this case only
- --      one is shown (Test_Ramp).  The routines to sample and alter the states
- --      of the various sensors, to queue the vehicles on the meter and to
- --      release them are all part of the  protected object and can be shared
- --      by various tasks. Apart from the function/procedure tests this example
- --      has a mix of other tasking features. 
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      13 Nov 95   SAIC    Updated and fixed bugs ACVC 2.0.1
- --
- --!
- 
- 
- with Report;
- with ImpDef;
- with Ada.Calendar;
-                 
- procedure C940005 is
- 
- begin
- 
-    Report.Test ("C940005", "Check internal calls of protected functions" &
-                         " and procedures");
- 
-    declare  -- encapsulate the test
- 
-       function "+" (Left : Ada.Calendar.Time; Right: Duration)
-                             return Ada.Calendar.Time renames Ada.Calendar."+";
- 
-       -- Weighted load given to each potential problem area and accumulated
-       type Load_Factor is range 0..8;
-       Clear_Level    : constant Load_Factor := 0;
-       Minimum_Level  : constant Load_Factor := 1;
-       Moderate_Level : constant Load_Factor := 2;
-       Serious_Level  : constant Load_Factor := 4;
-       Critical_Level : constant Load_Factor := 6;
- 
-       -- Weighted loads given to each  Sample Point (pure weights, not levels)
-       Local_Overload_wt         : constant Load_Factor := 1;
-       Next_Ramp_in_Overload_wt  : constant Load_Factor := 1;
-       Ramp_Junction_in_Overload_wt : constant Load_Factor :=2; --higher wght
-       -- ::::  other weighted loads
-           
-       TC_Multiplier : integer := 1;  -- changed half way through
-       TC_Expected_Passage_Total : constant integer := 486;
- 
-       -- This is the time between synchronizing pulses to the ramps.
-       -- In reality one would expect a time of 5 to 10 seconds.  In
-       -- the interests of speeding up the test suite a shorter time
-       -- is used
-       Pulse_Time_Delta : constant duration := ImpDef.Long_Switch_To_New_Task;
- 
-       -- control over stopping tasks
-       protected Control is
-          procedure Stop_Now;
-          function Stop return Boolean;
-       private
-          Halt : Boolean := False;
-       end Control;
- 
-       protected body Control is
-          procedure Stop_Now is
-          begin
-             Halt := True;
-          end Stop_Now;
- 
-          function Stop return Boolean is
-          begin
-             return Halt;
-          end Stop;
-       end Control;
- 
-       task Pulse_Task;       -- task to generate a pulse for each ramp
- 
-       -- Carrier task. One is created for each vehicle arriving at the ramp
-       task type Vehicle;      
-       type acc_Vehicle is access Vehicle;
- 
-       --================================================================
-       protected Test_Ramp is
-          function Next_Ramp_in_Overload return Load_Factor;
-          function Local_Overload        return Load_Factor;
-          function Freeway_Overload      return Load_Factor;
-          function Freeway_Breakdown     return Boolean;
-          function Meter_in_use_State    return Boolean; 
-          procedure Set_Local_Overload;
-          procedure Add_Meter_Queue;
-          procedure Subtract_Meter_Queue;
-          procedure Time_Pulse_Received;
-          entry Wait_at_Meter;
-          procedure TC_Passage (Pass_Point : Integer);
-          function TC_Get_Passage_Total return integer;
-          -- ::::::::: many routines are not shown (for example none of the
-          --            clears, none of the real-time-sensor handlers)
-    
-       private
- 
-          Release_One_Vehicle : Boolean := false;
-          Meter_in_Use        : Boolean := false;
-          Fwy_Break_State     : Boolean := false;
-                
-    
-          Ramp_Count : integer range 0..20 := 0;
-          Ramp_Count_Threshold : integer := 15;
-    
-          -- Current state of the various Sample Points
-          Local_State     : Load_Factor := Clear_Level;
-          Next_Ramp_State : Load_Factor := Clear_Level;
-             -- ::::  other Sample Point states not shown
-    
-          TC_Passage_Total : integer := 0;
-       end Test_Ramp;  
-       --================================================================
-       protected body Test_Ramp is
-    
-             procedure Start_Meter is
-             begin
-                Meter_in_Use := True;
-                null;  -- stub  :::: trigger the metering hardware
-             end Start_Meter;
-          
-          -- External call for Meter_in_Use
-          function Meter_in_Use_State return Boolean is
-          begin
-             return Meter_in_Use;
-          end Meter_in_Use_State;
-    
-          -- Trace the paths through the various routines by totaling the
-          -- weighted call parameters
-          procedure TC_Passage (Pass_Point : Integer) is
-          begin
-             TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
-          end TC_Passage;
-    
-          -- For the final check of the whole test
-          function TC_Get_Passage_Total return integer is
-          begin
-             return TC_Passage_Total;
-          end TC_Get_Passage_Total;
-    
-          -- These Set/Clear routines are triggered by real-time sensors that
-          -- reflect traffic state
-          procedure Set_Local_Overload is
-          begin
-             Local_State := Local_Overload_wt;
-             if not Meter_in_Use then
-                Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
-             end if;
-          end Set_Local_Overload;
-    
-          --::::: Set/Clear routines for all the other sensors not shown
- 
-          function Local_Overload return Load_Factor is
-          begin
-             return Local_State;
-          end Local_Overload;
-    
-          function Next_Ramp_in_Overload return Load_Factor is
-          begin
-             return Next_Ramp_State;
-          end Next_Ramp_in_Overload;
-    
-          -- ::::::::  other overload factor states not shown
-    
-          -- return the summation of all the load factors
-          function Freeway_Overload return Load_Factor is
-          begin
-             return    Local_Overload                    -- EACH IS A CALL OF A
-                       -- + :::: others                  -- FUNCTION FROM WITHIN
-                       + Next_Ramp_in_Overload;          -- A FUNCTION
-          end Freeway_Overload;
- 
-          -- Freeway Breakdown is defined as traffic moving < 5mph
-          function Freeway_Breakdown return Boolean is
-          begin
-             return Fwy_Break_State;
-          end Freeway_Breakdown;
-    
-          -- Keep count of vehicles currently on meter queue - we can't use
-          -- the 'count because we need the outcall trigger
-          procedure Add_Meter_Queue is
-             TC_Pass_Point : constant integer := 22;
-          begin
-             Ramp_Count := Ramp_Count + 1;  
-             TC_Passage ( TC_Pass_Point );  -- note passage through here
-             if Ramp_Count > Ramp_Count_Threshold then
-                null;  -- :::: stub, trigger surface street notification
-             end if;
-          end Add_Meter_Queue;  
-          --
-          procedure Subtract_Meter_Queue is
-             TC_Pass_Point : constant integer := 24;
-          begin
-             Ramp_Count := Ramp_Count - 1;  
-             TC_Passage ( TC_Pass_Point );  -- note passage through here
-          end Subtract_Meter_Queue;  
-    
-          -- Here each Vehicle task queues itself awaiting release
-          entry Wait_at_Meter when Release_One_Vehicle is
-          -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
-             TC_Pass_Point : constant integer := 23;
-          begin
-             TC_Passage ( TC_Pass_Point );   -- note passage through here
-             Release_One_Vehicle := false;   -- Consume the signal
-             -- Decrement number of vehicles on ramp 
-             Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY
-          end Wait_at_Meter;      
-    
-    
-          procedure Time_Pulse_Received is
-             Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL
-                                                     -- FUNCTION 
-                                                     -- FROM WITHIN PROCEDURE
-          begin
-             -- if broken down, no vehicles are released
-             if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE
-                if Load < Moderate_Level then
-                   Release_One_Vehicle := true;
-                end if;
-                null;    -- stub  ::: If other levels, release every other
-                         --           pulse, every third pulse  etc.
-             end if;
-          end Time_Pulse_Received;
-        
-       end Test_Ramp;  
-       --================================================================
-        
- 
-       -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
-       -- generation of an accompanying carrier task
-       procedure New_Arrival is
-          Next_Vehicle_Task: acc_Vehicle := new Vehicle;
-          TC_Pass_Point : constant integer := 3; 
-       begin
-          Test_Ramp.TC_Passage ( TC_Pass_Point );  -- Note passage through here
-          null;
-       end New_arrival;
- 
- 
-       -- Carrier task. One is created for each vehicle arriving at the ramp
-       task body Vehicle is
-          TC_Pass_point   : constant integer :=  1;
-          TC_Pass_Point_2 : constant integer := 21;
-          TC_Pass_Point_3 : constant integer :=  2;
-       begin
-          Test_Ramp.TC_Passage ( TC_Pass_Point );  -- note passage through here
-          if Test_Ramp.Meter_in_Use_State then  
-             Test_Ramp.TC_Passage ( TC_Pass_Point_2 );  -- note passage
-             -- Increment count of number of vehicles on ramp 
-             Test_Ramp.Add_Meter_Queue;    -- CALL a protected PROCEDURE
-                                           -- which is also called from within
-             -- enter the meter queue
-             Test_Ramp.Wait_at_Meter;      -- CALL a protected ENTRY   
-          end if;
-          Test_Ramp.TC_Passage ( TC_Pass_Point_3 );  -- note passage thru here
-          null;  --:::: call to the first in the series of the Ramp_Sensors
-                 --     this "passes" the vehicle from one sensor to the next
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Vehicle Task");
-       end Vehicle;
- 
- 
-       -- Task transmits a synchronizing "pulse" to all ramps
-       --
-       task body Pulse_Task is
-          Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
-       begin
-          While not Control.Stop loop
-             delay until Pulse_Time;  
-             Test_Ramp.Time_Pulse_Received;  -- causes INTERNAL CALLS
-             -- ::::::::::  and to all the others
-             Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
-          end loop;
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Pulse_Task");
-       end Pulse_Task;
- 
- 
-    begin -- declare
- 
-       -- Test driver.  This is ALL test control code
- 
-       -- First simulate calls to the protected functions and procedures
-       -- from without the protected object
-       --
-       -- CALL FUNCTIONS
-       if Test_Ramp.Local_Overload /= Clear_Level then
-          Report.Failed ("External Call to Local_Overload incorrect");
-       end if;
-       if Test_Ramp.Next_Ramp_in_Overload /= Clear_Level then
-          Report.Failed ("External Call to Next_Ramp_in_Overload incorrect");
-       end if;
-       if Test_Ramp.Freeway_Overload /= Clear_Level then
-          Report.Failed ("External Call to Freeway_Overload incorrect");
-       end if;
- 
-       -- Now Simulate the arrival of a vehicle to verify path through test
-       New_Arrival; 
-       delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
- 
-       TC_Multiplier := 5;  -- change the weights for the paths for the next
-                            -- part of the test
-       
-       -- Simulate a real-time sensor reporting overload
-       Test_Ramp.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
- 
-       -- CALL FUNCTIONS again
-       if Test_Ramp.Local_Overload /= Minimum_Level then
-          Report.Failed ("External Call to Local_Overload incorrect - 2");
-       end if;
-       if Test_Ramp.Freeway_Overload /= Minimum_Level then
-          Report.Failed ("External Call to Freeway_Overload incorrect -2");
-       end if;
- 
-       -- Now Simulate the arrival of another vehicle again causing
-       -- INTERNAL CALLS but following different paths (queuing on the 
-       -- meter etc.)
-       New_Arrival; 
-       delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
- 
-       Control.Stop_Now;  -- finish test
- 
-       if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then
-          Report.Failed ("Unexpected paths taken");
-       end if;
- 
-    end; -- declare
- 
-    Report.Result;
- 
- end C940005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,223 ****
- -- C940006.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the body of a protected function can have external calls
- --      to other protected functions and that the body of a protected
- --      procedure can have external calls to protected procedures and to 
- --      protected functions.
- --
- -- TEST DESCRIPTION:
- --      Use a subset of the simulation of the freeway on-ramp described in
- --      c940005.  In this case two protected objects are used but only a
- --      minimum of routines are shown in each.  Both objects are hard coded
- --      and detail two adjacent on-ramps (Ramp_31 & Ramp_32) with routines in 
- --      each which use external calls to the  other.  
- 
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- 
- procedure C940006 is
- 
- begin
- 
-    Report.Test ("C940006", "Check external calls of protected functions" &
-                         " and procedures");
- 
-    declare  -- encapsulate the test
- 
-       -- Weighted load given to each potential problem area and accumulated
-       type Load_Factor is range 0..8;
-       -- 
-       Clear_Level    : constant Load_Factor := 0;
-       Minimum_Level  : constant Load_Factor := 1;
-       Moderate_Level : constant Load_Factor := 3;
-       Serious_Level  : constant Load_Factor := 4;
-       Critical_Level : constant Load_Factor := 6;
- 
-       --================================================================
-       -- Only the Routines that are used in this test are shown
-       --
-       protected Ramp_31 is
- 
-          function Local_Overload        return Load_Factor;
-          procedure Set_Local_Overload(Sensor_Level : Load_Factor);
-          procedure Notify;
-          function Next_Ramp_Overload    return Load_Factor;
-          function Freeway_Overload      return Load_Factor;
-          procedure Downstream_Ramps;
-          function Get_DSR_Accumulate    return Load_Factor;
- 
-       private
-          Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
- 
-          -- Current state of the various Sample Points
-          Local_State     : Load_Factor := Clear_Level;
-          -- Accumulated load for next three downstream ramps
-          DSR_Accumulate  : Load_Factor := Clear_Level;  
-    
-       end Ramp_31;  
-       --================================================================
-       -- Only the Routines that are used in this test are shown
-       --
-       protected Ramp_32 is
-       
-          function Local_Overload return Load_Factor;
-          procedure Set_Local_Overload (Sensor_Level : Load_Factor); 
- 
-       private
- 
-          Local_State : Load_Factor := Clear_Level;
- 
-       end Ramp_32;  
-       --================================================================
-       protected body Ramp_31 is
-    
-          -- These Set/Clear routines are triggered by real-time sensors that
-          -- reflect traffic state
-          procedure Set_Local_Overload (Sensor_Level : Load_Factor) is
-          begin
-             -- Notify "previous" ramp to check this one for current state.
-             -- Subsequent changes in state will not send an alert 
-             null;   --::::: (see Ramp_32 for this code)
-             Local_State := Sensor_Level;
-             null;   --::::: Start local meter if not already started
-          end Set_Local_Overload;
-    
-          function Local_Overload return Load_Factor is
-          begin
-             return Local_State;
-          end Local_Overload;
-    
-          -- This is notification from the next ramp that it is in
-          -- overload.  With this provision we only need to sample the next
-          -- ramp during adverse conditions.  
-          procedure Notify is
-          begin
-             Next_Ramp_Alert := true;
-          end Notify;
- 
-          function Next_Ramp_Overload return Load_Factor is
-          begin
-             if Next_Ramp_Alert then
-                -- EXTERNAL FUNCTION CALL FROM FUNCTION
-                -- Get next ramp's current state
-                return Ramp_32.Local_Overload;
-             else
-                return Clear_Level;  
-             end if;
-          end Next_Ramp_Overload;
-    
-          -- return the summation of all the load factors
-          function Freeway_Overload return Load_Factor is
-          begin
-             return    Local_Overload                   
-                       -- + :::: others                  
-                       + Next_Ramp_Overload;             
-          end Freeway_Overload;
- 
-          -- Snapshot the states of the next three downstream ramps
-          procedure Downstream_Ramps is
-          begin
-             DSR_Accumulate := Ramp_32.Local_Overload;    -- EXTERNAL FUNCTION
-             -- ::::         + Ramp_33.Local_Overload     -- FROM  PROCEDURE
-             -- ::::         + Ramp_34.Local_Overload
-          end Downstream_Ramps;
- 
-          -- Get last snapshot
-          function Get_DSR_Accumulate return Load_Factor is
-          begin
-             return DSR_Accumulate;
-          end Get_DSR_Accumulate;
- 
-       end Ramp_31;  
-       --================================================================
-       protected body Ramp_32 is
- 
-          function Local_Overload return Load_Factor is
-          begin
-             return Local_State;
-          end;
-    
-    
-          -- These Set/Clear routines are triggered by real-time sensors that
-          -- reflect traffic state
-          procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
-          begin
-             if Local_State = Clear_Level then
-                -- Notify "previous" ramp to check this one for current state.
-                -- Subsequent changes in state will not send an alert
-                -- When the situation clears another routine performs the 
-                -- all_clear notification. (not shown)
-                -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
-                Ramp_31.Notify;
-             end if;
-             Local_State := Sensor_Level;
-             null;   --::::: Start local meter if not already started
-          end;
- 
-       end Ramp_32;  
-       --================================================================
- 
- 
- 
-    begin -- declare
- 
-       -- Test driver.  This is ALL test control code
-       -- Simulate calls to the protected functions and procedures
-       -- from without the protected object, these will, in turn make the
-       -- external calls.
- 
-       -- Check initial conditions, exercising the simple calls
-       if not (Ramp_31.Local_Overload     = Clear_Level  and
-               Ramp_31.Next_Ramp_Overload = Clear_Level  and
-               Ramp_31.Freeway_Overload   = Clear_Level) and
-               Ramp_32.Local_Overload     = Clear_Level    then
-                   Report.Failed ("Initial Calls provided unexpected Results");
-       end if;
-       
-       -- Simulate real-time sensors reporting overloads at a hardware level
-       Ramp_31.Set_Local_Overload (1);
-       Ramp_32.Set_Local_Overload (3);
-      
-       Ramp_31.Downstream_Ramps;   -- take the current snapshot
- 
-       if not (Ramp_31.Local_Overload     = Minimum_Level  and
-               Ramp_31.Get_DSR_Accumulate = Moderate_Level and
-               Ramp_31.Freeway_Overload   = Serious_Level)   then
-          Report.Failed ("Secondary Calls provided unexpected Results");
-       end if;
-       
-    end; -- declare
- 
-    Report.Result;
- 
- end C940006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,427 ****
- -- C940007.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the body of a protected function declared as an object of a
- --      given type can have internal calls to other protected functions and
- --      that a protected procedure in such an object can have internal calls
- --      to protected procedures and to  protected functions. 
- --
- -- TEST DESCRIPTION:
- --      Simulate a meter at a freeway on-ramp which, when real-time sensors
- --      determine that the freeway is becoming saturated, triggers stop lights
- --      which control the access of vehicles to prevent further saturation. 
- --      Each on-ramp is represented by a protected object of the type Ramp. 
- --      The routines to sample and alter the states of the various sensors, to
- --      queue the vehicles on the meter and to release them are all part of
- --      the  protected object and can be shared by various tasks. Apart from
- --      the function/procedure tests this example has a mix of other tasking
- --      features.  In this test two objects representing two adjacent ramps
- --      are created from the same type.  The same "traffic" is simulated for
- --      each ramp.  The results should be identical.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      13 Nov 95   SAIC    Replaced shared global variable Pulse_Stop
- --                          with a protected object.
- --                          ACVC 2.0.1
- --
- --!
- 
- 
- with Report;
- with ImpDef;
- with Ada.Calendar;
-         
-                 
- procedure C940007 is
- 
- begin
- 
-    Report.Test ("C940007", "Check internal calls of protected functions" &
-                         " and procedures in objects declared as a type");
- 
-    declare  -- encapsulate the test
- 
-       function "+" (Left : Ada.Calendar.Time; Right: Duration)
-                           return Ada.Calendar.Time renames Ada.Calendar."+";
- 
-       -- Weighted load given to each potential problem area and accumulated
-       type Load_Factor is range 0..8;
-       Clear_Level    : constant Load_Factor := 0;
-       Minimum_Level  : constant Load_Factor := 1;
-       Moderate_Level : constant Load_Factor := 2;
-       Serious_Level  : constant Load_Factor := 4;
-       Critical_Level : constant Load_Factor := 6;
- 
-       -- Weighted loads given to each  Sample Point (pure weights, not levels)
-       Local_Overload_wt            : constant Load_Factor := 1;
-       Next_Ramp_in_Overload_wt     : constant Load_Factor := 1;
-       Ramp_Junction_in_Overload_wt : constant Load_Factor :=2; --higher wght
-       -- ::::  other weighted loads
-           
-       TC_Expected_Passage_Total : integer := 486;
- 
- 
-       -- This is the time between synchronizing pulses to the ramps.
-       -- In reality one would expect a time of 5 to 10 seconds.  In
-       -- the interests of speeding up the test suite a shorter time
-       -- is used
-       Pulse_Time_Delta : constant duration := ImpDef.Long_Switch_To_New_Task;
- 
- 
-       -- control over stopping tasks
-       protected Control is
-          procedure Stop_Now;
-          function Stop return Boolean;
-       private
-          Halt : Boolean := False;
-       end Control;
- 
-       protected body Control is
-          procedure Stop_Now is
-          begin
-             Halt := True;
-          end Stop_Now;
- 
-          function Stop return Boolean is
-          begin
-             return Halt;
-          end Stop;
-       end Control;
- 
- 
-       task Pulse_Task;       -- task to generate a pulse for each ramp
- 
-       -- Carrier tasks. One is created for each vehicle arriving at each ramp
-       task type Vehicle_31;            -- For Ramp_31
-       type acc_Vehicle_31 is access Vehicle_31;
-       --
-       task type Vehicle_32;            -- For Ramp_32
-       type acc_Vehicle_32 is access Vehicle_32;
-                 
-       --================================================================
-       protected type Ramp is
-          function Next_Ramp_in_Overload return Load_Factor;
-          function Local_Overload        return Load_Factor;
-          function Freeway_Overload      return Load_Factor;
-          function Freeway_Breakdown     return Boolean;
-          function Meter_in_Use_State    return Boolean;
-          procedure Set_Local_Overload;
-          procedure Add_Meter_Queue;
-          procedure Subtract_Meter_Queue;
-          procedure Time_Pulse_Received;
-          entry Wait_at_Meter;
-          procedure TC_Passage (Pass_Point : Integer);
-          function TC_Get_Passage_Total return integer;
-          -- ::::::::: many routines are not shown (for example none of the
-          --            clears, none of the real-time-sensor handlers)
-    
-       private
- 
-          Release_One_Vehicle : Boolean := false;
-          Meter_in_Use        : Boolean := false;
-          Fwy_Break_State     : Boolean := false;
-                
-    
-          Ramp_Count : integer range 0..20 := 0;
-          Ramp_Count_Threshold : integer := 15;
-    
-          -- Current state of the various Sample Points
-          Local_State     : Load_Factor := Clear_Level;
-          Next_Ramp_State : Load_Factor := Clear_Level;
-             -- ::::  other Sample Point states not shown
-    
-          TC_Multiplier    : integer := 1;  -- changed half way through
-          TC_Passage_Total : integer := 0;
-       end Ramp;  
-       --================================================================
-       protected body Ramp is
-    
-             procedure Start_Meter is
-             begin
-                Meter_in_Use := True;
-                null;  -- stub  :::: trigger the metering hardware
-             end Start_Meter;
-    
-          function Meter_in_Use_State return Boolean is
-          begin
-             return Meter_in_Use;
-          end Meter_in_Use_State;
- 
-          -- Trace the paths through the various routines by totaling the
-          -- weighted call parameters
-          procedure TC_Passage (Pass_Point : Integer) is
-          begin
-             TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
-          end TC_Passage;
-    
-          -- For the final check of the whole test
-          function TC_Get_Passage_Total return integer is
-          begin
-             return TC_Passage_Total;
-          end TC_Get_Passage_Total;
-    
-          -- These Set/Clear routines are triggered by real-time sensors that
-          -- reflect traffic state
-          procedure Set_Local_Overload is
-          begin
-             Local_State := Local_Overload_wt;
-             if not Meter_in_Use then
-                Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
-             end if;
-             -- Change the weights for the paths for the next part of the test
-             TC_Multiplier :=5;
-          end Set_Local_Overload;
-    
-          --::::: Set/Clear routines for all the other sensors not shown
- 
-          function Local_Overload return Load_Factor is
-          begin
-             return Local_State;
-          end Local_Overload;
-    
-          function Next_Ramp_in_Overload return Load_Factor is
-          begin
-             return Next_Ramp_State;
-          end Next_Ramp_in_Overload;
-    
-          -- ::::::::  other overload factor states not shown
-    
-          -- return the summation of all the load factors
-          function Freeway_Overload return Load_Factor is
-          begin
-             return    Local_Overload                    -- EACH IS A CALL OF A
-                       -- + :::: others                  -- FUNCTION FROM WITHIN
-                       + Next_Ramp_in_Overload;          -- A FUNCTION
-          end Freeway_Overload;
- 
-          -- Freeway Breakdown is defined as traffic moving < 5mph
-          function Freeway_Breakdown return Boolean is
-          begin
-             return Fwy_Break_State;
-          end Freeway_Breakdown;
-    
-          -- Keep count of vehicles currently on meter queue - we can't use
-          -- the 'count because we need the outcall trigger
-          procedure Add_Meter_Queue is
-             TC_Pass_Point : constant integer := 22;
-          begin
-             Ramp_Count := Ramp_Count + 1;  
-             TC_Passage ( TC_Pass_Point );  -- note passage through here
-             if Ramp_Count > Ramp_Count_Threshold then
-                null;  -- :::: stub, trigger surface street notification
-             end if;
-          end Add_Meter_Queue;  
-          --
-          procedure Subtract_Meter_Queue is
-             TC_Pass_Point : constant integer := 24;
-          begin
-             Ramp_Count := Ramp_Count - 1;  
-             TC_Passage ( TC_Pass_Point );  -- note passage through here
-          end Subtract_Meter_Queue;  
-    
-          -- Here each Vehicle task queues itself awaiting release
-          entry Wait_at_Meter when Release_One_Vehicle is
-          -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
-             TC_Pass_Point : constant integer := 23;
-          begin
-             TC_Passage ( TC_Pass_Point );   -- note passage through here
-             Release_One_Vehicle := false;   -- Consume the signal
-             -- Decrement number of vehicles on ramp 
-             Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY
-          end Wait_at_Meter;      
-    
-    
-          procedure Time_Pulse_Received is
-             Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL FUNCTN 
-                                                     -- FROM WITHIN PROCEDURE
-          begin
-             -- if broken down, no vehicles are released
-             if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE
-                if Load < Moderate_Level then
-                   Release_One_Vehicle := true;
-                end if;
-                null;    -- stub  ::: If other levels, release every other
-                         --           pulse, every third pulse  etc.
-             end if;
-          end Time_Pulse_Received;
-        
-       end Ramp;  
-       --================================================================
- 
-       -- Now create two Ramp objects from this type
-       Ramp_31 : Ramp;
-       Ramp_32 : Ramp;
- 
-        
- 
-       -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
-       -- and the generation of an accompanying carrier task
-       procedure New_Arrival_31 is
-          Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
-          TC_Pass_Point : constant integer := 3; 
-       begin
-          Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
-          null;   --::: stub
-       end New_arrival_31;
- 
- 
-       -- Carrier task. One is created for each vehicle arriving at Ramp_31
-       task body Vehicle_31 is
-          TC_Pass_point   : constant integer :=  1;
-          TC_Pass_Point_2 : constant integer := 21;
-          TC_Pass_Point_3 : constant integer :=  2;
-       begin
-          Ramp_31.TC_Passage ( TC_Pass_Point );  -- note passage through here
-          if Ramp_31.Meter_in_Use_State then  
-             Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
-             -- Increment count of number of vehicles on ramp 
-             Ramp_31.Add_Meter_Queue;    -- CALL a protected PROCEDURE
-                                           -- which is also called from within
-             -- enter the meter queue
-             Ramp_31.Wait_at_Meter;      -- CALL a protected ENTRY   
-          end if;
-          Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
-          null;  --:::: call to the first in the series of the Ramp_Sensors
-                 --     this "passes" the vehicle from one sensor to the next
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Vehicle Task");
-       end Vehicle_31;
- 
- 
-       -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
-       -- generation of an accompanying carrier task
-       procedure New_Arrival_32 is
-          Next_Vehicle_Task_32 : acc_Vehicle_32 := new Vehicle_32;
-          TC_Pass_Point : constant integer := 3; 
-       begin
-          Ramp_32.TC_Passage ( TC_Pass_Point );  -- Note passage through here
-          null;  --::: stub
-       end New_arrival_32;
- 
- 
-       -- Carrier task. One is created for each vehicle arriving at Ramp_32
-       task body Vehicle_32 is
-          TC_Pass_point   : constant integer :=  1;
-          TC_Pass_Point_2 : constant integer := 21;
-          TC_Pass_Point_3 : constant integer :=  2;
-       begin
-          Ramp_32.TC_Passage ( TC_Pass_Point );  -- note passage through here
-          if Ramp_32.Meter_in_Use_State then  
-             Ramp_32.TC_Passage ( TC_Pass_Point_2 );  -- note passage
-             -- Increment count of number of vehicles on ramp 
-             Ramp_32.Add_Meter_Queue;    -- CALL a protected PROCEDURE
-                                           -- which is also called from within
-             -- enter the meter queue
-             Ramp_32.Wait_at_Meter;      -- CALL a protected ENTRY   
-          end if;
-          Ramp_32.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
-          null;  --:::: call to the first in the series of the Ramp_Sensors
-                 --     this "passes" the vehicle from one sensor to the next
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Vehicle Task");
-       end Vehicle_32;
- 
- 
-       -- Task transmits a synchronizing "pulse" to all ramps
-       --
-       task body Pulse_Task is
-          Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
-       begin
-          While not Control.Stop loop
-             delay until Pulse_Time;  
-             Ramp_31.Time_Pulse_Received;    -- CALL OF PROCEDURE CAUSES
-             Ramp_32.Time_Pulse_Received;    -- INTERNAL CALLS
-             -- ::::::::::  and to all the others
-             Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
-          end loop;
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Pulse_Task");
-       end Pulse_Task;
- 
- 
-    begin -- declare
- 
-       -- Test driver.  This is ALL test control code
- 
-       -- First simulate calls to the protected functions and procedures
-       -- from without the protected object
-       --
-       -- CALL FUNCTIONS
-       if not ( Ramp_31.Local_Overload = Clear_Level and
-                Ramp_31.Next_Ramp_in_Overload = Clear_Level and
-                Ramp_31.Freeway_Overload = Clear_Level ) then
-          Report.Failed ("Initial Calls to Ramp_31 incorrect");
-       end if;
-       if not ( Ramp_32.Local_Overload = Clear_Level and
-                Ramp_32.Next_Ramp_in_Overload = Clear_Level and
-                Ramp_32.Freeway_Overload = Clear_Level ) then
-          Report.Failed ("Initial Calls to Ramp_32 incorrect");
-       end if;
- 
-       -- Now Simulate the arrival of a vehicle at each ramp to verify 
-       -- basic paths through the test
-       New_Arrival_31; 
-       New_Arrival_32; 
-       delay Pulse_Time_Delta*2;  -- allow them to pass through the complex
- 
-       -- Simulate real-time sensors reporting overload
-       Ramp_31.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
-       Ramp_32.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
- 
-       -- CALL FUNCTIONS again
-       if not ( Ramp_31.Local_Overload = Minimum_Level and
-                Ramp_31.Freeway_Overload = Minimum_Level ) then
-          Report.Failed ("Secondary Calls to Ramp_31 incorrect");
-       end if;
-       if not ( Ramp_32.Local_Overload = Minimum_Level and
-                Ramp_32.Freeway_Overload = Minimum_Level ) then
-          Report.Failed ("Secondary Calls to Ramp_32 incorrect");
-       end if;
- 
-       -- Now Simulate the arrival of another vehicle at each ramp again causing
-       -- INTERNAL CALLS but following different paths (queuing on the 
-       -- meter etc.)
-       New_Arrival_31; 
-       New_Arrival_32; 
-       delay Pulse_Time_Delta*2;  -- allow them to pass through the complex
- 
-       Control.Stop_Now;  -- finish test
- 
-       if not (TC_Expected_Passage_Total = Ramp_31.TC_Get_Passage_Total and
-               TC_Expected_Passage_Total = Ramp_32.TC_Get_Passage_Total) then
-          Report.Failed ("Unexpected paths taken");
-       end if;
- 
-    end; -- declare
- 
-    Report.Result;
- 
- end C940007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,269 ****
- -- C940010.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if an exception is raised during the execution of an 
- --      entry body it is propagated back to the caller
- --
- -- TEST DESCRIPTION:
- --      Use a small fragment of code from the simulation of a freeway meter
- --      used in c940007. Create three individual tasks which will be queued on
- --      the entry as the barrier is set.  Release them one at a time.  A
- --      procedure which is called within the entry has been modified for this
- --      test to raise a different exception for each pass through.  Check that
- --      all expected exceptions are raised and propagated.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with Report;
- with ImpDef;
-                 
- procedure C940010 is
- 
-     TC_Failed_1 : Boolean := false; 
- 
- begin
- 
-    Report.Test ("C940010", "Check that an exception raised in an entry " &
-                         "body is propagated back to the caller");
- 
-    declare  -- encapsulate the test
- 
-       TC_Defined_Error : Exception;    -- User defined exception
-       TC_Expected_Passage_Total : constant integer := 669;
-       TC_Int                    : constant integer := 5;
- 
-       -- Carrier tasks. One is created for each vehicle arriving at each ramp
-       task type Vehicle_31;            -- For Ramp_31
-       type acc_Vehicle_31 is access Vehicle_31;
- 
- 
-       --================================================================
-       protected Ramp_31 is
- 
-          function Meter_in_Use_State return Boolean;
-          procedure Add_Meter_Queue;
-          procedure Subtract_Meter_Queue;
-          entry Wait_at_Meter;
-          procedure Pulse;
-          --
-          procedure TC_Passage (Pass_Point : Integer);
-          function TC_Get_Passage_Total return integer;
-          function TC_Get_Current_Exception return integer;
- 
-       private
- 
-          Release_One_Vehicle : Boolean := false;
-          Meter_in_Use        : Boolean := true;  -- TC: set true for this test
-          --
-          TC_Multiplier       : integer := 1;
-          TC_Passage_Total    : integer := 0;
-          -- Use this to cycle through the required exceptions
-          TC_Current_Exception : integer range 0..3 := 0;
- 
-       end Ramp_31;  
-       --================================================================
-       protected body Ramp_31 is
-                
-    
-          -- Trace the paths through the various routines by totaling the
-          -- weighted call parameters
-          procedure TC_Passage (Pass_Point : Integer) is
-          begin
-             TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
-          end TC_Passage;
-    
-          -- For the final check of the whole test
-          function TC_Get_Passage_Total return integer is
-          begin
-             return TC_Passage_Total;
-          end TC_Get_Passage_Total;
- 
-          function TC_Get_Current_Exception return integer is
-          begin 
-             return TC_Current_Exception;
-          end TC_Get_Current_Exception;
- 
-    
-          -----------------
- 
-          function Meter_in_Use_State return Boolean is
-          begin
-             return Meter_in_Use;
-          end Meter_in_Use_State;
-        
-          -- Simulate the effects of the regular signal pulse 
-          procedure Pulse is
-          begin
-             Release_one_Vehicle := true;
-          end Pulse;
- 
-          -- Keep count of vehicles currently on meter queue - we can't use
-          -- the 'count because we need the outcall trigger
-          procedure Add_Meter_Queue is
-          begin
-             null;    --::: stub
-          end Add_Meter_Queue;  
- 
-          -- TC: This routine has been modified to raise the required 
-          --     exceptions
-          procedure Subtract_Meter_Queue is
-             TC_Pass_Point1 : constant integer := 10;
-             TC_Pass_Point2 : constant integer := 20;
-             TC_Pass_Point3 : constant integer := 30;
-             TC_Pass_Point9 : constant integer := 1000;  -- error
-          begin
-             -- Cycle through the required exceptions, one per call
-             TC_Current_Exception := TC_Current_Exception + 1;
-             case TC_Current_Exception is
-                when 1 => 
-                      TC_Passage (TC_Pass_Point1);  -- note passage through here
-                      raise Storage_Error;    -- PREDEFINED EXCEPTION
-                when 2 => 
-                      TC_Passage (TC_Pass_Point2);  -- note passage through here
-                      raise TC_Defined_Error;    -- USER DEFINED EXCEPTION
-                when 3 => 
-                      TC_Passage (TC_Pass_Point3);  -- note passage through here
-                      -- RUN TIME EXCEPTION (Constraint_Error)
-                      -- Add the value 3 to 5 then try to assign it to an object
-                      -- whose range is 0..3  - this causes the exception.
-                      -- Disguise the values which cause the Constraint_Error
-                      -- so that the optimizer will not eliminate this code
-                      --    Note: the variable is checked at the end to ensure
-                      --    that the actual assignment is attempted.  Also note
-                      --    the value remains at 3 as the assignment does not
-                      --    take place.  This is the value that is checked at
-                      --    the end of the test.
-                      -- Otherwise the optimizer could decide that the result 
-                      -- of the assignment was not used so why bother to do it?
-                      TC_Current_Exception := 
-                                Report.Ident_Int (TC_Current_Exception) + 
-                                Report.Ident_Int (TC_Int);
-                when others =>
-                      -- Set flag for Report.Failed which cannot be called from
-                      -- within a Protected Object 
-                      TC_Failed_1 := True;
-             end case;
- 
-             TC_Passage ( TC_Pass_Point9 );  -- note passage through here
-          end Subtract_Meter_Queue;  
-    
-          -- Here each Vehicle task queues itself awaiting release
-          entry Wait_at_Meter when Release_One_Vehicle is
-          -- Example of entry with barriers and persistent signal
-             TC_Pass_Point : constant integer := 2;
-          begin
-             TC_Passage ( TC_Pass_Point );   -- note passage through here
-             Release_One_Vehicle := false;   -- Consume the signal
-             -- Decrement number of vehicles on ramp 
-             Subtract_Meter_Queue;  -- Call procedure from within entry body
-          end Wait_at_Meter;      
-    
-       end Ramp_31;  
-       --================================================================
-         
-       -- Carrier task. One is created for each vehicle arriving at Ramp_31
-       task body Vehicle_31 is
-          TC_Pass_Point_1 : constant integer := 100;
-          TC_Pass_Point_2 : constant integer := 200;
-          TC_Pass_Point_3 : constant integer := 300;
-       begin
-          if Ramp_31.Meter_in_Use_State then  
-             -- Increment count of number of vehicles on ramp 
-             Ramp_31.Add_Meter_Queue;    -- Call a protected procedure
-                                           -- which is also called from within
-             -- enter the meter queue
-             Ramp_31.Wait_at_Meter;      -- Call a protected entry   
-             Report.Failed ("Exception not propagated back");
-          end if;
-          null;  --:::: call to the first in the series of the Ramp_Sensors
-                 --     this "passes" the vehicle from one sensor to the next
-       exception
-          when Storage_Error =>
-                Ramp_31.TC_Passage ( TC_Pass_Point_1 );  -- note passage
-          when TC_Defined_Error =>  
-                Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
-          when Constraint_Error =>
-                Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage
-          when others => 
-                Report.Failed ("Unexpected exception in Vehicle Task");
-       end Vehicle_31;
- 
-       -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
-       -- and the generation of an accompanying carrier task
-       procedure New_Arrival_31 is
-          Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
-          TC_Pass_Point : constant integer := 1; 
-       begin
-          Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
-          null;  --::: stub
-       end New_arrival_31;
- 
- 
- 
-    begin -- declare
- 
-       -- Test driver.  This is ALL test control code
- 
-       -- Create three independent tasks which will queue themselves on the
-       -- entry.  Each task will get a different exception
-       New_Arrival_31;
-       New_Arrival_31;
-       New_Arrival_31;
- 
-       delay ImpDef.Clear_Ready_Queue;
- 
-       -- Set the barrier condition of the entry true, releasing one task
-       Ramp_31.Pulse; 
-       delay ImpDef.Clear_Ready_Queue;
-       
-       Ramp_31.Pulse; 
-       delay ImpDef.Clear_Ready_Queue;
-       
-       Ramp_31.Pulse; 
-       delay ImpDef.Clear_Ready_Queue;
- 
-       if (TC_Expected_Passage_Total /= Ramp_31.TC_Get_Passage_Total)  or
-          -- Note: We are not really interested in this next check.  It is 
-          --       here to ensure the earlier statements which raised the 
-          --       Constraint_Error are not optimized out
-          (Ramp_31.TC_Get_Current_Exception /= 3) then
-             Report.Failed ("Unexpected paths taken");
-       end if;
-       
-    end; -- declare
- 
-    if TC_Failed_1 then 
-       Report.Failed ("Bad path through Subtract_Meter_Queue");
-    end if;
- 
-    Report.Result;
- 
- end C940010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,175 ****
- -- C940011.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, in the body of a protected object created by the execution
- --      of an allocator, external calls to other protected objects via 
- --      the access type are correctly performed
- --
- -- TEST DESCRIPTION:
- --      Use a subset of the simulation of the freeway on-ramp described in
- --      c940005.  In this case an array of access types is built with pointers
- --      to successive ramps.  The external calls within the protected
- --      objects are made via the index into the array.  Routines which refer
- --      to the "previous" ramp and the "next" ramp are exercised.  (Note: The
- --      first and last ramps are assumed to be dummies and no first/last
- --      condition code is included)
- --      
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with Report;
- 
- 
- procedure C940011 is
- 
-    type Ramp;     
-    type acc_Ramp is access Ramp;
- 
-    subtype Ramp_Index is integer range 1..4;
-    
- 
-    -- Weighted load given to each potential problem area and accumulated
-    type Load_Factor is range 0..8;
-    Clear_Level    : constant Load_Factor := 0;
-    Moderate_Level : constant Load_Factor := 3;
-    
-    --================================================================
-    -- Only the Routines that are used in this test are shown
-    --
-    protected type Ramp is
- 
-       procedure Set_Index (Index : Ramp_Index);
-       procedure Set_Local_Overload (Sensor_Level : Load_Factor);
-       function Local_Overload        return Load_Factor;
-       procedure Notify;
-       function Next_Ramp_Overload    return Load_Factor;
- 
-    private
- 
-       This_Ramp : Ramp_Index;
- 
-       Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
- 
-       -- Current state of the various Sample Points
-       Local_State     : Load_Factor := Clear_Level;
-    
-    end Ramp;
-    --================================================================
- 
-    -- Build a set of Ramp objects and an array of pointers to them
-    --
-    Ramp_Array : array (Ramp_Index) of acc_Ramp := (Ramp_Index => new Ramp);
- 
-    --================================================================
-    protected body Ramp is
-    
-       procedure Set_Index (Index : Ramp_Index) is
-       begin
-          This_Ramp := Index;            
-       end Set_Index;
- 
-       -- These Set/Clear routines are triggered by real-time sensors that
-       -- reflect traffic state
-       procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
-       begin
-          if Local_State = Clear_Level then
-             -- Notify "previous" ramp to check this one for current state.
-             -- Subsequent changes in state will not send an alert
-             -- When the situation clears another routine performs the 
-             -- all_clear notification. (not shown)
-             -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
-             Ramp_Array(This_Ramp - 1).Notify;   -- index to previous ramp
-          end if;
-          Local_State := Sensor_Level;
-          null;   --::::: Start local meter if not already started
-       end Set_Local_Overload;
- 
-       function Local_Overload return Load_Factor is
-       begin
-          return Local_State;
-       end Local_Overload;
-    
-       -- This is notification from the next ramp that it is in
-       -- overload.  With this provision we only need to sample the next
-       -- ramp during adverse conditions.  
-       procedure Notify is
-       begin
-          Next_Ramp_Alert := true;
-       end Notify;
- 
-       function Next_Ramp_Overload return Load_Factor is
-       begin
-          if Next_Ramp_Alert then
-             -- EXTERNAL FUNCTION CALL FROM FUNCTION
-             -- Get next ramp's current state
-             return Ramp_Array(This_Ramp + 1).Local_Overload;
-          else
-             return Clear_Level;  
-          end if;
-       end Next_Ramp_Overload;
-    end Ramp;
- 
-    --================================================================
- 
- 
- begin
- 
- 
-    Report.Test ("C940011", "Protected Objects created by allocators: " &
-                      "external calls via access types");
- 
-    -- Initialize each Ramp 
-    for i in Ramp_Index loop
-       Ramp_Array(i).Set_Index (i);
-    end loop;      
- 
-    -- Test driver.  This is ALL test control code
-    
-    -- Simulate calls to the protected functions and procedures
-    -- external calls. (do not call the "dummy" end ramps)
- 
-    -- Simple Call
-    if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then
-       Report.Failed ("Primary call incorrect");
-    end if;
-    
-    -- Call which results in an external procedure call via the array
-    -- index from within the protected object
-    Ramp_Array(3).Set_Local_Overload (Moderate_Level);
-    
-    -- Call which results in an external function call via the array
-    -- index from within the protected object
-    if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then
-       Report.Failed ("Secondary call incorrect");
-    end if;
-       
-    Report.Result;
- 
- end C940011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- -- C940012.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a protected object can have discriminants
- --
- -- TEST DESCRIPTION:
- --      Use a subset of the simulation of the freeway on-ramp described in
- --      c940005.  In this case an array of access types is built with pointers
- --      to successive ramps.  Each ramp has its Ramp_Number specified by 
- --      discriminant and this corresponds to the index in the array.  The test
- --      checks that the ramp numbers are assigned as expected then uses calls
- --      to  procedures within the objects (ramps) to verify external calls to
- --      ensure the structures are valid.  The external references within the
- --      protected objects are made via the index into the array.  Routines
- --      which refer to the "previous" ramp and the "next" ramp are exercised. 
- --      (Note: The first and last ramps are assumed to be dummies and no
- --      first/last condition code is included)
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with Report;
- 
- 
- procedure C940012 is
- 
-    type Ramp_Index is range 1..4;
- 
-    type Ramp;
-    type a_Ramp is access Ramp;
- 
-    Ramp_Array : array (Ramp_Index) of a_Ramp;
- 
-    -- Weighted load given to each potential problem area and accumulated
-    type Load_Factor is range 0..8;
-    Clear_Level    : constant Load_Factor := 0;
-    Moderate_Level : constant Load_Factor := 3;
-    
-    --================================================================
-    -- Only the Routines that are used in this test are shown
-    --
-    protected type Ramp (Ramp_In : Ramp_Index) is
- 
-       function Ramp_Number           return Ramp_Index;
-       function Local_Overload        return Load_Factor;
-       function Next_Ramp_Overload    return Load_Factor;
-       procedure Set_Local_Overload(Sensor_Level : Load_Factor);
-       procedure Notify;
- 
-    private
- 
-       Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
- 
-       -- Current state of the various Sample Points
-       Local_State     : Load_Factor := Clear_Level;
-    
-    end Ramp;
-    --================================================================
-    protected body Ramp is
-    
-       function Ramp_Number return Ramp_Index is
-       begin
-          return Ramp_In;
-       end Ramp_Number;
- 
-       -- These Set/Clear routines are triggered by real-time sensors that
-       -- reflect traffic state
-       procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
-       begin
-          if Local_State = Clear_Level then
-             -- Notify "previous" ramp to check this one for current state.
-             -- Subsequent changes in state will not send an alert
-             -- When the situation clears another routine performs the 
-             -- all_clear notification. (not shown)
-             Ramp_Array(Ramp_In - 1).Notify;   -- index to previous ramp
-          end if;
-          Local_State := Sensor_Level;
-          null;   --::::: Start local meter if not already started
-       end;
- 
-       function Local_Overload return Load_Factor is
-       begin
-          return Local_State;
-       end Local_Overload;
-    
-       -- This is notification from the next ramp that it is in
-       -- overload.  With this provision we only need to sample the next
-       -- ramp during adverse conditions.  
-       procedure Notify is
-       begin
-          Next_Ramp_Alert := true;
-       end Notify;
- 
-       function Next_Ramp_Overload return Load_Factor is
-       begin
-          if Next_Ramp_Alert then
-             -- Get next ramp's current state
-             return Ramp_Array(Ramp_In + 1).Local_Overload;
-          else
-             return Clear_Level;  
-          end if;
-       end Next_Ramp_Overload;
-    end Ramp;
-    --================================================================
-    
- begin
- 
- 
-    Report.Test ("C940012", "Check that a protected object " &
-                         "can have discriminants");
- 
-    -- Build the ramps and populate the ramp array
-    for i in Ramp_Index loop
-       Ramp_Array(i) := new Ramp (i);
-    end loop;      
- 
-    -- Test driver.  This is ALL test control code
- 
-    -- Check the assignment of the index
-    for i in Ramp_Index loop
-       if Ramp_Array(i).Ramp_Number /= i then
-          Report.Failed ("Ramp_Number assignment incorrect");
-       end if;
-    end loop;      
- 
-    -- Simulate calls to the protected functions and procedures
-    -- external calls. (do not call the "dummy" end ramps)
- 
-    -- Simple Call
-    if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then
-       Report.Failed ("Primary call incorrect");
-    end if;
-    
-    -- Call which results in an external procedure call via the array
-    -- index from within the protected object
-    Ramp_Array(3).Set_Local_Overload (Moderate_Level);
-       
-    -- Call which results in an external function call via the array
-    -- index from within the protected object
-    if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then
-       Report.Failed ("Secondary call incorrect");
-    end if;
-       
-       
-    Report.Result;
- 
- end C940012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,379 ****
- -- C940013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that items queued on a protected entry are handled FIFO and that
- --      the  'count attribute of that entry reflects the length of the queue.
- -- 
- -- TEST DESCRIPTION:
- --      Use a small subset of the freeway ramp simulation shown in other
- --      tests.  With the timing pulse off (which prevents items from being
- --      removed from the queue) queue up a small number of calls.  Start the
- --      timing pulse and, at the first execution of the entry code, check the
- --      'count attribute. Empty the queue.   Pass the items being removed from
- --      the queue to the Ramp_Sensor_01 task; there check that the items are
- --      arriving in FIFO order.  Check the final 'count value  
- --      
- --      Send another batch of items at a rate which will, if the delay timing
- --      of the implementation is reasonable, cause the queue length to
- --      fluctuate in both directions.   Again check that all items arrive
- --      FIFO.  At the end check that the 'count returned to zero reflecting
- --      the empty queue.  
- --      
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with ImpDef;
- with Ada.Calendar;
-                 
- procedure C940013 is
- 
-    TC_Failed_1 : Boolean := false;
- 
- begin
- 
-    Report.Test ("C940013", "Check that queues on protected entries are " &
-                            "handled FIFO and that 'count is correct");
- 
-    declare  -- encapsulate the test
- 
-       function "+" (Left : Ada.Calendar.Time; Right: Duration)
-                             return Ada.Calendar.Time renames Ada.Calendar."+";
- 
-       -- Weighted load given to each potential problem area and accumulated
-       type Load_Factor is range 0..8;
-       Clear_Level    : constant Load_Factor := 0;
-       Minimum_Level  : constant Load_Factor := 1;
-       Moderate_Level : constant Load_Factor := 2;
-       Serious_Level  : constant Load_Factor := 4;
-       Critical_Level : constant Load_Factor := 6;
- 
-       TC_Expected_Passage_Total : constant integer := 624;
- 
-       -- For this test give each vehicle an integer ID incremented
-       -- by one for each successive vehicle.  In reality this would be
-       -- a more complex alpha-numeric ID assigned at pickup time.
-       type Vehicle_ID is range 1..5000;
-       Next_ID : Vehicle_ID := Vehicle_ID'first;  
- 
-       -- In reality this would be about 5 seconds. The default value of 
-       -- this constant in the implementation defined package is similar
-       -- but could, of course be considerably different - it would not 
-       -- affect the test 
-       -- 
-       Pulse_Time_Delta : duration := ImpDef.Clear_Ready_Queue;
- 
- 
-       task Pulse_Task;       -- task to generate a pulse for each ramp
- 
-       -- Carrier task. One is created for each vehicle arriving at the ramp
-       task type Vehicle is
-          entry Get_ID (Input_ID : in Vehicle_ID);
-       end Vehicle;      
-       type acc_Vehicle is access Vehicle;
- 
-       task Ramp_Sensor_01 is
-          entry  Accept_Vehicle (Input_ID : in Vehicle_ID);
-          entry  TC_First_Three_Handled;
-          entry  TC_All_Done;
-       end Ramp_Sensor_01;
- 
-       protected Pulse_State is 
-          procedure Start_Pulse;
-          procedure Stop_Pulse;
-          function Pulsing return Boolean;
-       private
-          State : Boolean := false;   -- start test will pulse off
-       end Pulse_State;
- 
-       protected body Pulse_State is 
- 
-          procedure Start_Pulse is
-          begin
-             State := true;
-          end Start_Pulse;
- 
-          procedure Stop_Pulse is
-          begin 
-             State := false;
-          end Stop_Pulse;
- 
-          function Pulsing return Boolean is
-          begin 
-             return State;
-          end Pulsing;
-      
-       end Pulse_State;
- 
-       --================================================================
-       protected Test_Ramp is 
-       
-          function Meter_in_use_State    return Boolean; 
-          procedure Time_Pulse_Received;
-          entry Wait_at_Meter;
-          procedure TC_Passage (Pass_Point : Integer);
-          function TC_Get_Passage_Total return integer;
-          function TC_Get_Count return integer;
-    
-       private
- 
-          Release_One_Vehicle : Boolean := false;
-          -- For this test have Meter_in_Use already set
-          Meter_in_Use        : Boolean := true;
- 
-          TC_Wait_at_Meter_First : Boolean := true;
-          TC_Entry_Queue_Count   : integer := 0; -- 'count of Wait_at_Meter
-          TC_Passage_Total       : integer := 0;
-          TC_Pass_Point_WAM      : integer := 23;
- 
-       end Test_Ramp;  
-       --================================================================
-       protected body Test_Ramp is
-    
-          -- External call for Meter_in_Use
-          function Meter_in_Use_State return Boolean is
-          begin
-             return Meter_in_Use;
-          end Meter_in_Use_State;
-    
-          -- Trace the paths through the various routines by totalling the
-          -- weighted call parameters
-          procedure TC_Passage (Pass_Point : Integer) is
-          begin
-             TC_Passage_Total := TC_Passage_Total + Pass_Point;
-          end TC_Passage;
-    
-          -- For the final check of the whole test
-          function TC_Get_Passage_Total return integer is
-          begin
-             return TC_Passage_Total;
-          end TC_Get_Passage_Total;
-    
-          function TC_Get_Count return integer is
-          begin
-             return TC_Entry_Queue_Count;
-          end TC_Get_Count;
-    
- 
-          -- Here each Vehicle task queues itself awaiting release
-          --
-          entry Wait_at_Meter when Release_One_Vehicle is
-          -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
-          begin
-             --
-             TC_Passage ( TC_Pass_Point_WAM );   -- note passage
-             -- For this test three vehicles are queued before the first
-             -- is released.  If the queueing mechanism is working correctly
-             -- the first time we pass through here the entry'count should
-             -- reflect this
-             if TC_Wait_at_Meter_First then
-                if Wait_at_Meter'count /= 2 then
-                   TC_Failed_1 := true;
-                end if;
-                TC_Wait_at_Meter_First := false;
-             end if;
-             TC_Entry_Queue_Count := Wait_at_Meter'count;  -- note for later
-                
-             Release_One_Vehicle := false;   -- Consume the signal
-             null; -- stub ::: Decrement count of number of vehicles on ramp 
-          end Wait_at_Meter;      
- 
-    
-          procedure Time_Pulse_Received is
-             Load : Load_factor := Minimum_Level;   -- for this version of the 
-             Freeway_Breakdown : Boolean := false;  -- test, freeway is Minimum
-          begin
-             -- if broken down, no vehicles are released
-             if not Freeway_Breakdown then 
-                if Load < Moderate_Level then
-                   Release_One_Vehicle := true;
-                end if;
-                null;    -- stub  ::: If other levels, release every other
-                         --           pulse, every third pulse  etc.
-             end if;
-          end Time_Pulse_Received;
-        
-       end Test_Ramp;  
-       --================================================================
- 
-       -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
-       -- generation of an accompanying carrier task
-       procedure New_Arrival is
-          Next_Vehicle_Task: acc_Vehicle := new Vehicle;
-          TC_Pass_Point : constant integer := 3; 
-       begin
-          Next_ID := Next_ID + 1;
-          Next_Vehicle_Task.Get_ID(Next_ID);
-          Test_Ramp.TC_Passage ( TC_Pass_Point );  -- Note passage through here
-          null;
-       end New_arrival;
- 
- 
-       -- Carrier task. One is created for each vehicle arriving at the ramp
-       task body Vehicle is
-          This_ID : Vehicle_ID;
-          TC_Pass_Point_2 : constant integer := 21;
-       begin
-          accept Get_ID (Input_ID : in Vehicle_ID) do 
-             This_ID := Input_ID;
-          end Get_ID;
- 
-          if Test_Ramp.Meter_in_Use_State then  
-             Test_Ramp.TC_Passage ( TC_Pass_Point_2 );  -- note passage
-             null;  -- stub::: Increment count of number of vehicles on ramp 
-             Test_Ramp.Wait_at_Meter;      -- Queue on the meter entry
-          end if;
- 
-          -- Call to the first in the series of the Ramp_Sensors
-          --     this "passes" the vehicle from one sensor to the next
-          --     Each sensor will requeue the call to the next thus this
-          --     rendezvous will only be completed as the vehicle is released
-          --     by the last sensor on the ramp.
-          Ramp_Sensor_01.Accept_Vehicle (This_ID);
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Vehicle Task");
-       end Vehicle;
- 
-       task body Ramp_Sensor_01 is
-          TC_Pass_Point : constant integer := 31; 
-          This_ID    : Vehicle_ID;
-          TC_Last_ID : Vehicle_ID := Vehicle_ID'first;
-       begin
-          loop
-             select
-                accept Accept_Vehicle (Input_ID : in Vehicle_ID) do 
-                   null;   -- stub:::: match up with next Real-Time notification
-                           -- from the sensor.  Requeue to next ramp sensor
-                   This_ID := Input_ID;
-                   
-                   -- The following is all Test_Control code
-                   Test_Ramp.TC_Passage ( TC_Pass_Point );  -- note passage
-                   -- The items arrive in the order they are taken from
-                   -- the Wait_at_Meter entry queue
-                   if ( This_ID - TC_Last_ID ) /= 1 then
-                      -- The tasks are being queued (or unqueued) in the
-                      -- wrong order
-                      Report.Failed
-                               ("Queueing on the Wait_at_Meter queue failed");
-                   end if;
-                   TC_Last_ID := This_ID;    -- for the next check
-                   if TC_Last_ID = 4 then
-                      -- rendezvous with the test driver
-                      accept TC_First_Three_Handled;
-                   elsif TC_Last_ID = 9 then
-                      -- rendezvous with the test driver
-                      accept TC_All_Done;
-                   end if;
-                end Accept_Vehicle;
-             or
-                terminate;
-             end select;
-          end loop;
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Ramp_Sensor_01");
-       end Ramp_Sensor_01;
- 
- 
-       -- Task transmits a synchronizing "pulse" to all ramps
-       --
-       task body Pulse_Task is
-          Pulse_Time : Ada.Calendar.Time;
-       begin
-          While not Pulse_State.Pulsing loop
-             -- Starts up in the quiescent state
-             delay ImpDef.Minimum_Task_Switch; 
-          end loop;
-          Pulse_Time := Ada.Calendar.Clock;
-          While Pulse_State.Pulsing loop
-             delay until Pulse_Time;  
-             Test_Ramp. Time_Pulse_Received;   -- Transmit pulse to test_ramp
-             -- ::::::::::  and to all the other ramps
-             Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
-          end loop;
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Pulse_Task");
-       end Pulse_Task;
- 
- 
-    begin -- declare
- 
-       -- Test driver.  This is ALL test control code
- 
-       -- Arrange to queue three vehicles on the Wait_at_Meter queue.  The 
-       -- timing pulse is quiescent so the queue will build
-       for i in 1..3 loop
-          New_Arrival; 
-       end loop;
- 
-       delay Pulse_Time_Delta;  -- ensure all is settled
- 
-       Pulse_State.Start_Pulse;     -- Start the timing pulse, the queue will 
-                                    -- be serviced
-       
-       -- wait here until the first three are complete
-       Ramp_Sensor_01.TC_First_Three_Handled;
- 
-       if Test_Ramp.TC_Get_Count /= 0 then
-          Report.Failed ("Intermediate Wait_at_Entry'count is incorrect");
-       end if;
- 
-       -- generate new arrivals at a rate that will make the queue increase
-       -- and decrease "randomly"
-       for i in 1..5 loop
-          New_Arrival; 
-          delay Pulse_Time_Delta/2;
-       end loop;
- 
-       -- wait here till all have been handled
-       Ramp_Sensor_01.TC_All_Done;
- 
-       if Test_Ramp.TC_Get_Count /= 0 then
-          Report.Failed ("Final Wait_at_Entry'count is incorrect");
-       end if;
- 
-       Pulse_State.Stop_Pulse;       -- finish test
- 
- 
-       if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then
-          Report.Failed ("Unexpected paths taken");
-       end if;
- 
- 
-    end; -- declare
- 
-    if TC_Failed_1 then 
-       Report.Failed ("Wait_at_Meter'count incorrect");
-    end if;
- 
-    Report.Result;
- 
- end C940013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,177 ****
- -- C940014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that as part of the finalization of a protected object
- --      each call remaining on an entry queue of the objet is removed
- --      from its queue and Program_Error is raised at the place of
- --      the corresponding entry_call_statement.
- --
- -- TEST DESCRIPTION:
- --      The example in 9.4(20a-20f);6.0 demonstrates how to cause a
- --      protected object to finalize while tasks are still waiting
- --      on its entry queues.  The first part of this test mirrors
- --      that example.  The second part of the test expands upon
- --      the example code to add an object with finalization code
- --      to the protected object.  The finalization code should be
- --      executed after Program_Error is raised in the callers left
- --      on the entry queues.
- --
- --
- -- CHANGE HISTORY:
- --      08 Jan 96   SAIC    Initial Release for 2.1
- --      10 Jul 96   SAIC    Incorporated Reviewer comments to fix race 
- --                          condition.
- --
- --!
- 
- 
- with Ada.Finalization;
- package C940014_0 is
-     Verbose : constant Boolean := False;
-     Finalization_Occurred : Boolean := False;
- 
-     type Has_Finalization is new Ada.Finalization.Limited_Controlled with
-           record
-              Placeholder : Integer;
-           end record;
-     procedure Finalize (Object : in out Has_Finalization);
- end C940014_0;
- 
- 
- with Report;
- with ImpDef;
- package body C940014_0 is
-     procedure Finalize (Object : in out Has_Finalization) is
-     begin
- 	delay ImpDef.Clear_Ready_Queue;
-         Finalization_Occurred := True;
-         if Verbose then
-             Report.Comment ("in Finalize");
-         end if;
-     end Finalize;
- end C940014_0;
- 
- 
- 
- with Report;
- with ImpDef;
- with Ada.Finalization;
- with C940014_0;
- 
- procedure C940014 is
-    Verbose : constant Boolean := C940014_0.Verbose;
- 
- begin
-  
-    Report.Test ("C940014", "Check that the finalization of a protected" &
-                            " object results in program_error being raised" &
-                            " at the point of the entry call statement for" &
-                            " any tasks remaining on any entry queue");
- 
-    First_Check: declare
-        -- example from ARM 9.4(20a-f);6.0 with minor mods
-        task T is
-            entry E;
-        end T;
-        task body T is
-            protected PO is
-                entry Ee;
-            end PO;
-            protected body PO is
-                entry Ee when Report.Ident_Bool (False) is
-                begin
-                    null;
-                end Ee;
-            end PO;
-        begin
-            accept E do
-                 requeue PO.Ee;
-            end E;
-            if Verbose then
-                 Report.Comment ("task about to terminate");
-            end if;
-        end T;
-    begin  -- First_Check
-        begin
-            T.E;
-            delay ImpDef.Clear_Ready_Queue;
-            Report.Failed ("exception not raised in First_Check");
-        exception
-            when Program_Error =>
-                if Verbose then
-                    Report.Comment ("ARM Example passed");
-                end if;
-            when others =>
-                Report.Failed ("wrong exception in First_Check");
-        end;
-    end First_Check;
-  
- 
-    Second_Check : declare
-       -- here we want to check that the raising of Program_Error
-       -- occurs before the other finalization actions.
-        task T is
-            entry E;
-        end T;
-        task body T is
-            protected PO is
-                entry Ee;
-            private
-                Component : C940014_0.Has_Finalization;
-            end PO;
-            protected body PO is
-                entry Ee when Report.Ident_Bool (False) is
-                begin
-                    null;
-                end Ee;
-            end PO;
-        begin
-            accept E do
-                 requeue PO.Ee;
-            end E;
-            if Verbose then
-                 Report.Comment ("task about to terminate");
-            end if;
-        end T;
-    begin  -- Second_Check
-        T.E;
-        delay ImpDef.Clear_Ready_Queue;
-        Report.Failed ("exception not raised in Second_Check");
-    exception
-        when Program_Error =>
-            if C940014_0.Finalization_Occurred then
-                Report.Failed ("wrong order for finalization");
-            elsif Verbose then
-                Report.Comment ("Second_Check passed");
-            end if;
-        when others =>
-            Report.Failed ("Wrong exception in Second_Check");
-    end Second_Check;
- 
- 
-    Report.Result;
-  
- end C940014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- C940015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that the component_declarations of a protected_operation
- --      are elaborated in the proper order.
- --
- -- TEST DESCRIPTION:
- --      A discriminated protected object is declared with some
- --      components that depend upon the discriminant and some that
- --      do not depend upon the discriminant.  All the components
- --      are initialized with a function call.  As a side-effect of
- --      the function call the parameter passed to the function is
- --      recorded in an elaboration order array.  
- --      Two objects of the protected type are declared.  The 
- --      elaboration order is recorded and checked against the
- --      expected order.
- --
- --
- -- CHANGE HISTORY:
- --      09 Jan 96   SAIC    Initial Version for 2.1
- --      09 Jul 96   SAIC    Addressed reviewer comments.
- --      13 Feb 97   PWB.CTA Removed doomed attempt to check per-object
- --                          constraint elaborations.
- --!
- 
- 
- with Report;
- 
- procedure C940015 is
-     Verbose : constant Boolean := False;
-     Do_Display : Boolean := Verbose;
-      
-     type Index is range 0..10;
- 
-     type List is array (1..10) of Integer;
-     Last : Natural range 0 .. List'Last := 0;
-     E_List : List := (others => 0);
- 
-     function Elaborate (Id : Integer) return Index is
-     begin
-         Last := Last + 1;
-         E_List (Last) := Id;
-         if Verbose then
-             Report.Comment ("Elaborating" & Integer'Image (Id));
-         end if;
-         return Index(Id mod 10);
-     end Elaborate;
- 
-     function Elaborate (Id, Per_Obj_Expr : Integer) return Index is
-     begin
-         return Elaborate (Id);
-     end Elaborate;
- 
- begin
-  
-     Report.Test ("C940015", "Check that the component_declarations of a" &
-                             " protected object are elaborated in the" &
-                             " proper order");
-     declare
-         -- an unprotected queue type
-         type Storage is array (Index range <>) of Integer;
-         type Queue (Size, Flag : Index := 1) is
-             record
-                 Head : Index := 1;
-                 Tail : Index := 1;
-                 Count : Index := 0;
-                 Buffer : Storage (1..Size);
-             end record;
- 
-         -- protected group of queues type
-         protected type Prot_Queues (Size : Index := Elaborate (104)) is 
-             procedure Clear;
-             -- other needed procedures not provided at this time
-         private
-                -- elaborate at type elaboration
-             Fixed_Queue_1    : Queue (3,  
-                                       Elaborate (105));
-                -- elaborate at type elaboration
-             Fixed_Queue_2    : Queue (6,    
-                                       Elaborate (107));
-         end Prot_Queues;
-         protected body Prot_Queues is
-             procedure Clear is
-             begin 
-                 Fixed_Queue_1.Count := 0;
-                 Fixed_Queue_1.Head := 1;
-                 Fixed_Queue_1.Tail := 1;
-                 Fixed_Queue_2.Count := 0;
-                 Fixed_Queue_2.Head := 1;
-                 Fixed_Queue_2.Tail := 1;
-             end Clear;
-         end Prot_Queues;
-           
-         PO1 : Prot_Queues(9);
-         PO2 : Prot_Queues;
- 
-         Expected_Elab_Order : List := (
-            -- from the elaboration of the protected type Prot_Queues
-            105, 107,
-            -- from the unconstrained object PO2
-            104,
-            others => 0);
-     begin
-         for I in List'Range loop
-             if E_List (I) /= Expected_Elab_Order (I) then
-                 Report.Failed ("wrong elaboration order"); 
-                 Do_Display := True;
-             end if;
-         end loop;
-         if Do_Display then
-             Report.Comment ("Expected  Actual");
-             for I in List'Range loop
-                 Report.Comment (
-                    Integer'Image (Expected_Elab_Order(I)) &
-                    Integer'Image (E_List(I)));
-             end loop;
-         end if;
- 
-         -- make use of the protected objects
-         PO1.Clear;
-         PO2.Clear;
-     end;
- 
-     Report.Result;
-  
- end C940015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940016.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940016.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940016.a	Thu Jan  1 00:00:00 1970
***************
*** 1,211 ****
- -- C940016.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that an Unchecked_Deallocation of a protected object
- --      performs the required finalization on the protected object.
- --
- -- TEST DESCRIPTION:
- --      Test that finalization takes place when an Unchecked_Deallocation
- --      deallocates a protected object with queued callers. 
- --      Try protected objects that have no other finalization code and
- --      protected objects with user defined finalization.
- --
- --
- -- CHANGE HISTORY:
- --      16 Jan 96   SAIC    ACVC 2.1
- --      10 Jul 96   SAIC    Fixed race condition noted by reviewers.
- --
- --!
- 
- 
- with Ada.Finalization;
- package C940016_0 is
-     Verbose : constant Boolean := False;
-     Finalization_Occurred : Boolean := False;
- 
-     type Has_Finalization is new Ada.Finalization.Limited_Controlled with
-           record
-              Placeholder : Integer;
-           end record;
-     procedure Finalize (Object : in out Has_Finalization);
- end C940016_0;
- 
- 
- with Report;
- with ImpDef;
- package body C940016_0 is
-     procedure Finalize (Object : in out Has_Finalization) is
-     begin
- 	delay ImpDef.Clear_Ready_Queue;
-         Finalization_Occurred := True;
-         if Verbose then
-             Report.Comment ("in Finalize");
-         end if;
-     end Finalize;
- end C940016_0;
- 
- 
- 
- with Report;
- with Ada.Finalization;
- with C940016_0;
- with Ada.Unchecked_Deallocation;
- with ImpDef;
- 
- procedure C940016 is
-    Verbose : constant Boolean := C940016_0.Verbose;
- 
- begin
-  
-    Report.Test ("C940016", "Check that Unchecked_Deallocation of a" &
-                            " protected object finalizes the" &
-                            " protected object");
- 
-    First_Check: declare
-        protected type Semaphore is
-            entry Wait;
-            procedure Signal;
-        private
-            Count : Integer := 0;
-        end Semaphore;
-        protected body Semaphore is
-            entry Wait when Count > 0 is
-            begin
-                Count := Count - 1;
-            end Wait;
- 
-            procedure Signal is
-            begin
-               Count := Count + 1;
-            end Signal;
-        end Semaphore;
- 
-        type pSem is access Semaphore;
-        procedure Zap_Semaphore is new 
-            Ada.Unchecked_Deallocation (Semaphore, pSem);
-        Sem_Ptr : pSem := new Semaphore;
- 
-        -- positive confirmation that Blocker got the exception
-        Ok : Boolean := False;
- 
-        task Blocker;
- 
-        task body Blocker is
-        begin
-            Sem_Ptr.Wait;
-            Report.Failed ("Program_Error not raised in waiting task");
-        exception
-            when Program_Error =>
-                Ok := True;
-                if Verbose then
-                    Report.Comment ("Blocker received Program_Error");
-                end if;
-            when others =>
-                Report.Failed ("Wrong exception in Blocker");
-        end Blocker;
- 
-    begin  -- First_Check
-        -- wait for Blocker to get blocked on the semaphore
-        delay ImpDef.Clear_Ready_Queue;
-        Zap_Semaphore (Sem_Ptr);
-        -- make sure Blocker has time to complete
-        delay ImpDef.Clear_Ready_Queue * 2;
-        if not Ok then
-            Report.Failed ("finalization not properly performed");
-            -- Blocker is probably hung so kill it
-            abort Blocker;
-        end if;
-    end First_Check;
-  
- 
-    Second_Check : declare
-       -- here we want to check that the raising of Program_Error
-       -- occurs before the other finalization actions.
-        protected type Semaphore is
-            entry Wait;
-            procedure Signal;
-        private
-            Count : Integer := 0;
-            Component : C940016_0.Has_Finalization;
-        end Semaphore;
-        protected body Semaphore is
-            entry Wait when Count > 0 is
-            begin
-                Count := Count - 1;
-            end Wait;
- 
-            procedure Signal is
-            begin
-               Count := Count + 1;
-            end Signal;
-        end Semaphore;
- 
-        type pSem is access Semaphore;
-        procedure Zap_Semaphore is new 
-            Ada.Unchecked_Deallocation (Semaphore, pSem);
-        Sem_Ptr : pSem := new Semaphore;
- 
-        -- positive confirmation that Blocker got the exception
-        Ok : Boolean := False;
- 
-        task Blocker;
- 
-        task body Blocker is
-        begin
-            Sem_Ptr.Wait;
-            Report.Failed ("Program_Error not raised in waiting task 2");
-        exception
-            when Program_Error =>
-                Ok := True;
-                if C940016_0.Finalization_Occurred then
-                    Report.Failed ("wrong order for finalization 2");
-                elsif Verbose then
-                    Report.Comment ("Blocker received Program_Error 2");
-                end if;
-            when others =>
-                Report.Failed ("Wrong exception in Blocker 2");
-        end Blocker;
- 
-    begin  -- Second_Check
-        -- wait for Blocker to get blocked on the semaphore
-        delay ImpDef.Clear_Ready_Queue;
-        Zap_Semaphore (Sem_Ptr);
-        -- make sure Blocker has time to complete
-        delay ImpDef.Clear_Ready_Queue * 2;
-        if not Ok then
-            Report.Failed ("finalization not properly performed 2");
-            -- Blocker is probably hung so kill it
-            abort Blocker;
-        end if;
-        if not C940016_0.Finalization_Occurred then
-            Report.Failed ("user defined finalization didn't happen");
-        end if;
-    end Second_Check;
-  
- 
-    Report.Result;
-  
- end C940016;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,259 ****
- -- C94001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A UNIT WITH DEPENDENT TASKS CREATED BY OBJECT
- --   DECLARATIONS IS NOT TERMINATED UNTIL ALL DEPENDENT TASKS BECOME
- --   TERMINATED.
- -- SUBTESTS ARE:
- --   (A, B)  A SIMPLE TASK OBJECT, IN A BLOCK.
- --   (C, D)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
- --   (E, F)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
- 
- -- JRK 10/2/81
- -- SPS 11/21/82
- -- JRK 11/29/82
- -- TBN  8/22/86     REVISED; ADDED CASES THAT EXIT BY RAISING AN
- --                  EXCEPTION.
- -- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94001A IS
- 
-      MY_EXCEPTION : EXCEPTION;
-      GLOBAL : INTEGER;
- 
-      TASK TYPE TT IS
-           ENTRY E (I : INTEGER);
-      END TT;
- 
-      TASK BODY TT IS
-           LOCAL : INTEGER;
-      BEGIN
-           ACCEPT E (I : INTEGER) DO
-                LOCAL := I;
-           END E;
-           DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
-                          -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
-                          -- TERMINATE IF THE ERROR IS PRESENT.
-           GLOBAL := LOCAL;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C94001A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
-                       "CREATED BY OBJECT DECLARATIONS IS NOT " &
-                       "TERMINATED UNTIL ALL DEPENDENT TASKS " &
-                       "BECOME TERMINATED");
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (A)
- 
-           T : TT;
- 
-      BEGIN -- (A)
- 
-           T.E (IDENT_INT(1));
- 
-      END; -- (A)
- 
-      IF GLOBAL /= 1 THEN
-           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                   "BLOCK EXIT - 1");
-      END IF;
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      BEGIN -- (B)
-           DECLARE
-                T : TT;
-           BEGIN
-                T.E (IDENT_INT(1));
-                RAISE MY_EXCEPTION;
-           END;
- 
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 1 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "BLOCK EXIT - 2");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - 2");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                A : ARRAY (1..1) OF TT;
-           BEGIN
-                A(1).E (IDENT_INT(2));
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (C)
- 
-           I := F;
- 
-           IF GLOBAL /= 2 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "FUNCTION EXIT - 3");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (D)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                A : ARRAY (1..1) OF TT;
-           BEGIN
-                A(1).E (IDENT_INT(2));
-                IF EQUAL (3, 3) THEN
-                     RAISE MY_EXCEPTION;
-                END IF;
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (D)
-           I := F;
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 2 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "FUNCTION EXIT - 4");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - 4");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (E)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                AR : ARRAY (1..1) OF RT;
-           BEGIN
-                AR(1).T.E (IDENT_INT(3));
-           END TSK;
- 
-      BEGIN -- (E)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 1.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
-                        "HOUR - 5");
-           ELSIF GLOBAL /= 3 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "TASK EXIT - 5");
-           END IF;
- 
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (F)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                AR : ARRAY (1..1) OF RT;
-           BEGIN
-                AR(1).T.E (IDENT_INT(3));
-                IF EQUAL (3, 3) THEN
-                     RAISE MY_EXCEPTION;
-                END IF;
-                FAILED ("EXCEPTION WAS NOT RAISED - 6");
-           END TSK;
- 
-      BEGIN -- (F)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 1.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
-                        "HOUR - 6");
-           ELSIF GLOBAL /= 3 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "TASK EXIT - 6");
-           END IF;
- 
-      END; -- (F)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C94001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,268 ****
- -- C94001B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A UNIT WITH DEPENDENT TASKS CREATED BY AN OBJECT
- -- DECLARATION OF LIMITED PRIVATE TYPE IS NOT TERMINATED UNTIL ALL
- -- DEPENDENT TASKS BECOME TERMINATED.
- -- SUBTESTS ARE:
- --   (A, B)  A SIMPLE TASK OBJECT, IN A BLOCK.
- --   (C, D)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
- --   (E, F)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
- 
- -- TBN  8/22/86
- -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94001B IS
- 
-      PACKAGE P IS
-           MY_EXCEPTION : EXCEPTION;
-           GLOBAL : INTEGER;
-           TYPE TT IS LIMITED PRIVATE;
-           PROCEDURE CALL_ENTRY (A : TT; B : INTEGER);
-      PRIVATE
-           TASK TYPE TT IS
-                ENTRY E (I : INTEGER);
-           END TT;
-      END P;
- 
-      PACKAGE BODY P IS
- 
-           PROCEDURE CALL_ENTRY (A : TT; B : INTEGER) IS
-           BEGIN
-                A.E (B);
-           END CALL_ENTRY;
- 
-           TASK BODY TT IS
-                LOCAL : INTEGER;
-           BEGIN
-                ACCEPT E (I : INTEGER) DO
-                     LOCAL := I;
-                END E;
-                DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER
-                               -- PRIORITY AT THIS POINT, IT WILL
-                               -- RECEIVE CONTROL AND TERMINATE IF
-                               -- THE ERROR IS PRESENT.
-                GLOBAL := LOCAL;
-           END TT;
-      END P;
- 
-      USE P;
- 
- 
- BEGIN
-      TEST ("C94001B", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
-                       "CREATED BY AN OBJECT DECLARATION OF LIMITED " &
-                       "PRIVATE TYPE IS NOT TERMINATED UNTIL ALL " &
-                       "DEPENDENT TASKS BECOME TERMINATED");
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (A)
- 
-           T : TT;
- 
-      BEGIN -- (A)
- 
-           CALL_ENTRY (T, IDENT_INT(1));
- 
-      END; -- (A)
- 
-      IF GLOBAL /= 1 THEN
-           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                   "BLOCK EXIT - 1");
-      END IF;
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      BEGIN -- (B)
-           DECLARE
-                T : TT;
-           BEGIN
-                CALL_ENTRY (T, IDENT_INT(2));
-                RAISE MY_EXCEPTION;
-           END;
- 
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 2 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "BLOCK EXIT - 2");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - 2");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                A : ARRAY (1..1) OF TT;
-           BEGIN
-                CALL_ENTRY (A(1), IDENT_INT(3));
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (C)
- 
-           I := F;
- 
-           IF GLOBAL /= 3 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "FUNCTION EXIT - 3");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (D)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                A : ARRAY (1..1) OF TT;
-           BEGIN
-                CALL_ENTRY (A(1), IDENT_INT(4));
-                IF EQUAL (3, 3) THEN
-                     RAISE MY_EXCEPTION;
-                END IF;
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (D)
-           I := F;
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 4 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "FUNCTION EXIT - 4");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - 4");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (E)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                AR : ARRAY (1..1) OF RT;
-           BEGIN
-                CALL_ENTRY (AR(1).T, IDENT_INT(5));
-           END TSK;
- 
-      BEGIN -- (E)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 1.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
-                        "HOUR - 5");
-           ELSIF GLOBAL /= 5 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "TASK EXIT - 5");
-           END IF;
- 
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (F)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                AR : ARRAY (1..1) OF RT;
-           BEGIN
-                CALL_ENTRY (AR(1).T, IDENT_INT(6));
-                IF EQUAL (3, 3) THEN
-                     RAISE MY_EXCEPTION;
-                END IF;
-                FAILED ("EXCEPTION WAS NOT RAISED - 6");
-           END TSK;
- 
-      BEGIN -- (F)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 1.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
-                        "HOUR - 6");
-           ELSIF GLOBAL /= 6 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "TASK EXIT - 6");
-           END IF;
- 
-      END; -- (F)
- 
-      RESULT;
- END C94001B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- C94001C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A UNIT WITH INDIRECT DEPENDENT TASKS CREATED BY OBJECT
- -- DECLARATIONS IS NOT TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS
- -- BECOME TERMINATED.
- -- SUBTESTS ARE:
- --   (A, B)  A BLOCK CONTAINING A SIMPLE TASK OBJECT, IN A BLOCK.
- --   (C, D)  A FUNCTION CONTAINING AN ARRAY OF TASK OBJECT, IN A
- --           FUNCTION.
- --   (E, F)  A TASK CONTAINING AN ARRAY OF RECORD OF TASK OBJECT,
- --           IN A TASK BODY.
- --   CASES (B, D, F) EXIT BY RAISING AN EXCEPTION.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
- 
- -- TBN  8/25/86
- -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94001C IS
- 
-      MY_EXCEPTION : EXCEPTION;
-      GLOBAL : INTEGER;
- 
-      TASK TYPE TT IS
-           ENTRY E (I : INTEGER);
-      END TT;
- 
-      TASK BODY TT IS
-           LOCAL : INTEGER;
-      BEGIN
-           ACCEPT E (I : INTEGER) DO
-                LOCAL := I;
-           END E;
-           DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
-                          -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
-                          -- TERMINATE IF THE ERROR IS PRESENT.
-           GLOBAL := LOCAL;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C94001C", "CHECK THAT A UNIT WITH INDIRECT DEPENDENT " &
-                       "TASKS CREATED BY OBJECT DECLARATIONS IS NOT " &
-                       "TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS " &
-                       "BECOME TERMINATED");
- 
-      --------------------------------------------------
-      GLOBAL := IDENT_INT (0);
- 
-      BEGIN -- (A)
- 
-           DECLARE
-                T : TT;
-           BEGIN
-                T.E (IDENT_INT(1));
-           END;
- 
-      END; -- (A)
- 
-      IF GLOBAL /= 1 THEN
-           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                   "BLOCK EXIT - 1");
-      END IF;
- 
-      --------------------------------------------------
- 
-      BEGIN -- (B)
-           GLOBAL := IDENT_INT (0);
- 
-           BEGIN
-                DECLARE
-                     T : TT;
-                BEGIN
-                     T.E (IDENT_INT(2));
-                     RAISE MY_EXCEPTION;
-                END;
-           END;
- 
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 2 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "BLOCK EXIT - 2");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - 2");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C)
- 
-           OBJ_INT : INTEGER;
- 
-           FUNCTION F1 RETURN INTEGER IS
-                I : INTEGER;
- 
-                FUNCTION F2 RETURN INTEGER IS
-                     A : ARRAY (1..1) OF TT;
-                BEGIN
-                     A(1).E (IDENT_INT(3));
-                     RETURN 0;
-                END F2;
-           BEGIN
-                I := F2;
-                RETURN (0);
-           END F1;
- 
-      BEGIN -- (C)
-           OBJ_INT := F1;
-           IF GLOBAL /= 3 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "FUNCTION EXIT - 3");
-           END IF;
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           OBJ_INT : INTEGER;
- 
-           FUNCTION F1 RETURN INTEGER IS
-                I : INTEGER;
- 
-                FUNCTION F2 RETURN INTEGER IS
-                     A : ARRAY (1..1) OF TT;
-                BEGIN
-                     A(1).E (IDENT_INT(4));
-                     IF EQUAL (3, 3) THEN
-                          RAISE MY_EXCEPTION;
-                     END IF;
-                     RETURN 0;
-                END F2;
-           BEGIN
-                I := F2;
-                RETURN (0);
-           END F1;
- 
-      BEGIN -- (D)
-           GLOBAL := IDENT_INT (0);
-           OBJ_INT := F1;
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 4 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "FUNCTION EXIT - 4");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - 4");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (E)
-           DELAY_COUNT : INTEGER := 0;
-           TASK OUT_TSK;
- 
-           TASK BODY OUT_TSK IS
- 
-                TASK TSK IS
-                     ENTRY ENT;
-                END TSK;
- 
-                TASK BODY TSK IS
-                     TYPE RT IS
-                          RECORD
-                               T : TT;
-                          END RECORD;
-                     AR : ARRAY (1..1) OF RT;
-                BEGIN
-                     AR(1).T.E (IDENT_INT(5));
-                END TSK;
- 
-           BEGIN
-                NULL;
-           END OUT_TSK;
- 
-      BEGIN -- (E)
-           WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
-                DELAY 1.0 * Impdef.One_Long_Second;
-                DELAY_COUNT := DELAY_COUNT + 1;
-           END LOOP;
-           IF DELAY_COUNT = 60 THEN
-                FAILED ("OUT_TSK HAS NOT TERMINATED - 5");
-           ELSIF GLOBAL /= 5 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "BLOCK EXIT - 5");
-           END IF;
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE
-           DELAY_COUNT : INTEGER := 0;
- 
-           TASK OUT_TSK;
-      
-           TASK BODY OUT_TSK IS
- 
-                TASK TSK IS
-                     ENTRY ENT;
-                END TSK;
- 
-                TASK BODY TSK IS
-                     TYPE RT IS
-                          RECORD
-                               T : TT;
-                          END RECORD;
-                     AR : ARRAY (1..1) OF RT;
-                BEGIN
-                     AR(1).T.E (IDENT_INT(6));
-                     RAISE MY_EXCEPTION;
-                END TSK;
- 
-           BEGIN
-                RAISE MY_EXCEPTION;
-           END OUT_TSK;
- 
-      BEGIN
-           WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
-                DELAY 1.0 * Impdef.One_Long_Second;
-                DELAY_COUNT := DELAY_COUNT + 1;
-           END LOOP;
-           IF DELAY_COUNT = 60 THEN
-                FAILED ("OUT_TSK HAS NOT TERMINATED - 6");
-           ELSIF GLOBAL /= 6 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "BLOCK EXIT - 6");
-           END IF;
-      END;
- 
-      RESULT;
- END C94001C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C94001E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK IS ALSO COMPLETED IF AN EXCEPTION IS RAISED BY
- -- THE EXECUTION OF ITS SEQUENCE OF STATEMENTS.
- -- THIS MUST HOLD FOR BOTH CASES WHERE A HANDLER IS PRESENT OR NOT.
- --    VERSION WITH EXCEPTION HANDLER.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C940AGA-B.ADA
- -- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C94001E IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
- BEGIN
- 
-      TEST ("C94001E", "TASK COMPLETION BY EXCEPTION");
- 
- BLOCK:
-      DECLARE
- 
-           TASK T1;
- 
-           TASK BODY T1 IS
-                TYPE I1 IS RANGE 0 .. 1;
-                OBJ_I1 : I1;
-           BEGIN
-                OBJ_I1 := I1(IDENT_INT(2));  -- CONSTRAINT_ERROR.
-                IF OBJ_I1 /= I1(IDENT_INT(0)) THEN
-                   PSPY_NUMB (1);
-                ELSE
-                   PSPY_NUMB (2);
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-                WHEN OTHERS => FAILED ("OTHER EXCEPTION RAISED");
-           END T1;
- 
-      BEGIN
-           NULL;
-      END BLOCK;
- 
-      IF SPYNUMB /= 0 THEN
-           FAILED ("TASK T1 NOT COMPLETED AFTER EXCEPTION");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C94001E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- C94001F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK IS ALSO COMPLETED IF AN EXCEPTION IS RAISED BY
- -- THE EXECUTION OF ITS SEQUENCE OF STATEMENTS.
- -- THIS MUST HOLD FOR BOTH CASES WHERE A HANDLER IS PRESENT OR NOT.
- --   VERSION WITHOUT EXCEPTION HANDLER.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C940AGB-B.ADA
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C94001F IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
- BEGIN
- 
-      TEST ("C94001F", "TASK COMPLETION BY EXCEPTION -- NO HANDLER");
- 
- BLOCK:
-      DECLARE
- 
-           TASK T1;
- 
-           TASK BODY T1 IS
-                TYPE I1 IS RANGE 0 .. 1;
-                OBJ_I1 : I1;
-           BEGIN
-                OBJ_I1 := I1(IDENT_INT(2));  -- CONSTRAINT_ERROR.
-                PSPY_NUMB (1);
-           END T1;
- 
-      BEGIN
-           NULL;          -- WAIT FOR TERMINATION.
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("PROPAGATED CONSTRAINT_ERROR OUT OF TASK");
-           WHEN TASKING_ERROR =>
-                FAILED ("RAISED TASKING_ERROR");
-           WHEN OTHERS =>
-                FAILED ("RAISED OTHER EXCEPTION");
-      END BLOCK;
- 
-      IF SPYNUMB /= 0 THEN
-           FAILED ("TASK T1 NOT COMPLETED AFTER EXCEPTION IN SEQUENCE " &
-                   "OF STATEMENTS");
-      END IF;
- 
-      RESULT;
- 
- END C94001F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94001g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94001g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C94001G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A COMPLETED TASK WITH DEPENDENT TASKS TERMINATES WHEN
- -- A L L  DEPENDENT TASKS HAVE TERMINATED.
- 
- -- WEI  3/ 4/82
- -- JBG 4/2/84
- -- JWC 6/28/85   RENAMED FROM C940AIA-B.ADA
- 
- with Impdef;
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C94001G IS
- 
-      PACKAGE SPY IS      -- PROVIDE PROTECTED ACCESS TO SPYNUMB
-           SUBTYPE ARG IS NATURAL RANGE 0..9;
-           FUNCTION SPYNUMB RETURN NATURAL;                      -- READ
-           FUNCTION FINIT_POS (DIGT : IN ARG) RETURN NATURAL;    -- WRITE
-           PROCEDURE PSPY_NUMB (DIGT : IN ARG);                  -- WRITE
-      END SPY;
- 
-      USE SPY;
- 
-      PACKAGE BODY SPY IS
- 
-           TASK GUARD IS
-                ENTRY READ  (NUMB : OUT NATURAL);
-                ENTRY WRITE (NUMB : IN NATURAL);
-           END GUARD;
- 
-           TASK BODY GUARD IS
-                SPYNUMB : NATURAL := 0;
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT READ (NUMB : OUT NATURAL) DO
-                               NUMB := SPYNUMB;
-                          END READ;
-                     OR   ACCEPT WRITE (NUMB : IN NATURAL) DO
-                               SPYNUMB := 10*SPYNUMB+NUMB;
-                          END WRITE;
-                     OR   TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END GUARD;
- 
-           FUNCTION SPYNUMB RETURN NATURAL IS
-                TEMP : NATURAL;
-           BEGIN
-                GUARD.READ (TEMP);
-                RETURN TEMP;
-           END SPYNUMB;
- 
-           FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
-           BEGIN
-                GUARD.WRITE (DIGT);
-                RETURN DIGT;
-           END FINIT_POS;
- 
-           PROCEDURE PSPY_NUMB (DIGT : IN ARG) IS
-           BEGIN
-                GUARD.WRITE (DIGT);
-           END PSPY_NUMB;
-      END SPY;
- 
- BEGIN
-      TEST ("C94001G", "TERMINATION WHEN ALL DEPENDENT TASKS " &
-                       "HAVE TERMINATED");
- 
- BLOCK:
-      DECLARE
- 
-           TASK TYPE TT1;
- 
-           TASK BODY TT1 IS
-           BEGIN
-                DELAY 1.0 * Impdef.One_Second;
-                PSPY_NUMB (1);
-           END TT1;
- 
-           TASK T1 IS
-           END T1;
- 
-           TASK BODY T1 IS
-                OBJ_TT1_1, OBJ_TT1_2, OBJ_TT1_3 : TT1;
-           BEGIN
-                NULL;
-           END T1;
- 
-      BEGIN
-           NULL;
-      END BLOCK;               -- WAIT HERE FOR TERMINATION.
- 
-      IF SPYNUMB /= 111 THEN
-           FAILED ("TASK T1 TERMINATED BEFORE " &
-                   "ALL DEPENDENT TASKS HAVE TERMINATED");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C94001G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,331 ****
- -- C94002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A UNIT WITH DEPENDENT TASKS CREATED BY (LOCAL)
- --   ALLOCATORS DOES NOT TERMINATE UNTIL ALL DEPENDENT TASKS ARE
- --   TERMINATED.
- -- SUBTESTS ARE:
- --   (A, B)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
- --   (C, D)  A RECORD OF TASK ALLOCATOR, IN A FUNCTION.
- --   (E, F)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
- 
- -- JRK 10/2/81
- -- SPS 11/2/82
- -- SPS 11/21/82
- -- JRK 11/29/82
- -- TBN  8/25/86     REDUCED DELAYS; ADDED LIMITED PRIVATE TYPES; 
- --                  INCLUDED EXITS BY RAISING AN EXCEPTION.
- -- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94002A IS
- 
-      PACKAGE P IS
-           MY_EXCEPTION : EXCEPTION;
-           GLOBAL : INTEGER;
-           TASK TYPE T1 IS
-                ENTRY E (I : INTEGER);
-           END T1;
-           TYPE T2 IS LIMITED PRIVATE;
-           PROCEDURE CALL_ENTRY (A : T2; B : INTEGER);
-      PRIVATE
-           TASK TYPE T2 IS
-                ENTRY E (I : INTEGER);
-           END T2;
-      END P;
- 
-      PACKAGE BODY P IS
-           TASK BODY T1 IS
-                LOCAL : INTEGER;
-           BEGIN
-                ACCEPT E (I : INTEGER) DO
-                     LOCAL := I;
-                END E;
-                DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER
-                               -- PRIORITY AT THIS POINT, IT WILL
-                               -- RECEIVE CONTROL AND TERMINATE IF
-                               -- THE ERROR IS PRESENT.
-                GLOBAL := LOCAL;
-           END T1;
- 
-           TASK BODY T2 IS
-                LOCAL : INTEGER;
-           BEGIN
-                ACCEPT E (I : INTEGER) DO
-                     LOCAL := I;
-                END E;
-                DELAY 30.0 * Impdef.One_Second;
-                GLOBAL := LOCAL;
-           END T2;
- 
-           PROCEDURE CALL_ENTRY (A : T2; B : INTEGER) IS
-           BEGIN
-                A.E (B);
-           END CALL_ENTRY;
-      END P;
- 
-      USE P;
- 
- 
- BEGIN
-      TEST ("C94002A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
-                       "CREATED BY (LOCAL) ALLOCATORS DOES NOT " &
-                       "TERMINATE UNTIL ALL DEPENDENT TASKS " &
-                       "ARE TERMINATED");
- 
-      --------------------------------------------------
-      GLOBAL := IDENT_INT (0);
-      BEGIN -- (A)
-           DECLARE
-                TYPE A_T IS ACCESS T1;
-                A : A_T;
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     A := NEW T1;
-                     A.ALL.E (IDENT_INT(1));
-                     RAISE MY_EXCEPTION;
-                END IF;
-           END;
- 
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 1");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 1 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "BLOCK EXIT - 1");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (B)
-           TYPE A_T IS ACCESS T2;
-           A : A_T;
-      BEGIN -- (B)
-           IF EQUAL (3, 3) THEN
-                A := NEW T2;
-                CALL_ENTRY (A.ALL, IDENT_INT(2));
-           END IF;
-      END; -- (B)
- 
-      IF GLOBAL /= 2 THEN
-           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                   "BLOCK EXIT - 2");
-      END IF;
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C)
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                TYPE RT;
-                TYPE ART IS ACCESS RT;
-                TYPE RT IS
-                     RECORD
-                          A : ART;
-                          T : T1;
-                     END RECORD;
-                LIST : ART;
-                TEMP : ART;
-           BEGIN
-                FOR I IN 1 .. IDENT_INT (1) LOOP
-                     TEMP := NEW RT;
-                     TEMP.A := LIST;
-                     LIST := TEMP;
-                     LIST.T.E (IDENT_INT(3));
-                END LOOP;
-                RETURN 0;
-           END F;
-      BEGIN -- (C)
-           I := F;
- 
-           IF GLOBAL /= 3 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "FUNCTION EXIT - 3");
-           END IF;
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (D)
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
-                TYPE RT;
-                TYPE ART IS ACCESS RT;
-                TYPE RT IS
-                     RECORD
-                          A : ART;
-                          T : T2;
-                     END RECORD;
-                LIST : ART;
-                TEMP : ART;
-           BEGIN
-                FOR I IN 1 .. IDENT_INT (1) LOOP
-                     TEMP := NEW RT;
-                     TEMP.A := LIST;
-                     LIST := TEMP;
-                     CALL_ENTRY (LIST.T, IDENT_INT(4));
-                     IF EQUAL (3, 3) THEN
-                          RAISE MY_EXCEPTION;
-                     END IF;
-                END LOOP;
-                RETURN 0;
-           END F;
-      BEGIN -- (D)
-           I := F;
- 
-           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL /= 4 THEN
-                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                             "FUNCTION EXIT - 4");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (E)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
-                TYPE ARR IS ARRAY (1..1) OF T1;
-                TYPE RAT;
-                TYPE ARAT IS ACCESS RAT;
-                TYPE RAT IS
-                     RECORD
-                          A : ARAT;
-                          T : ARR;
-                     END RECORD;
-                LIST : ARAT;
-                TEMP : ARAT;
-           BEGIN
-                FOR I IN 1 .. IDENT_INT (1) LOOP
-                     TEMP := NEW RAT;
-                     TEMP.A := LIST;
-                     LIST := TEMP;
-                     LIST.T(1).E (IDENT_INT(5));
-                     IF EQUAL (3, 3) THEN
-                          RAISE MY_EXCEPTION;
-                     END IF;
-                END LOOP;
-           END TSK;
- 
-      BEGIN -- (E)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 1.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
-                        "MINUTES - 5");
-           END IF;
- 
-           IF GLOBAL /= 5 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "TASK EXIT - 5");
-           END IF;
- 
-      END; -- (E)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (F)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
-                TYPE ARR IS ARRAY (1..1) OF T2;
-                TYPE RAT;
-                TYPE ARAT IS ACCESS RAT;
-                TYPE RAT IS
-                     RECORD
-                          A : ARAT;
-                          T : ARR;
-                     END RECORD;
-                LIST : ARAT;
-                TEMP : ARAT;
-           BEGIN
-                FOR I IN 1 .. IDENT_INT (1) LOOP
-                     TEMP := NEW RAT;
-                     TEMP.A := LIST;
-                     LIST := TEMP;
-                     CALL_ENTRY (LIST.T(1), IDENT_INT(6));
-                END LOOP;
-           END TSK;
- 
-      BEGIN -- (F)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 1.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
-                        "MINUTES - 6");
-           END IF;
- 
-           IF GLOBAL /= 6 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "TASK EXIT - 6");
-           END IF;
- 
-      END; -- (F)
- 
-      RESULT;
- END C94002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,208 ****
- -- C94002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL ACCESS
- --   TYPE MAY TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS TO
- --   TERMINATE.
- 
- -- SUBTESTS ARE:
- --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
- --   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
- --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
- 
- -- JRK 10/8/81
- -- SPS 11/2/82
- -- SPS 11/21/82
- -- JRK 11/29/82
- -- TBN 1/20/86     REPLACED WITH C94006A-B.ADA AFTER LOWERING THE DELAY
- --                 VALUES, AND MODIFYING THE COMMENTS.
- -- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94002B IS
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-      BEGIN
-           ACCEPT E;
-           ACCEPT E;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C94002B", "CHECK THAT A MASTER UNIT, WHICH ALLOCATES " &
-                       "TASKS OF A GLOBAL ACCESS TYPE MAY TERMINATE " &
-                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
-                       "TERMINATE");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           TYPE A_T IS ACCESS TT;
-           A1 : A_T;
- 
-      BEGIN -- (A)
- 
-           DECLARE
-                A2 : A_T;
-           BEGIN
-                A2 := NEW TT;
-                A2.ALL.E;
-                A1 := A2;
-           END;
- 
-           IF A1.ALL'TERMINATED THEN
-                FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
-           END IF;
- 
-           A1.ALL.E;
- 
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
- 
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                TYPE ART IS ACCESS RT;
-                AR1 : ART;
- 
-                PROCEDURE P (AR : OUT ART) IS
-                     AR2 : ART;
-                BEGIN
-                     AR2 := NEW RT;
-                     AR2.T.E;
-                     AR := AR2;
-                END P;
- 
-           BEGIN
-                P (AR1);
- 
-                IF AR1.T'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
-                             "- (B)");
-                END IF;
- 
-                AR1.T.E;
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           I := F;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60;                -- DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
- 
-                LOOP_COUNT1 : INTEGER := 0;
-                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
- 
-                TYPE RAT;
-                TYPE ARAT IS ACCESS RAT;
-                TYPE ARR IS ARRAY (1..1) OF TT;
-                TYPE RAT IS
-                     RECORD
-                          A : ARAT;
-                          T : ARR;
-                     END RECORD;
-                ARA1 : ARAT;
- 
-                TASK TSK1 IS
-                     ENTRY ENT1 (ARA : OUT ARAT);
-                END TSK1;
- 
-                TASK BODY TSK1 IS
-                     ARA2 : ARAT;
-                BEGIN
-                     ARA2 := NEW RAT;
-                     ARA2.T(1).E;
-                     ACCEPT ENT1 (ARA : OUT ARAT) DO
-                          ARA := ARA2;
-                     END ENT1;
-                END TSK1;
- 
-           BEGIN
-                TSK1.ENT1 (ARA1);
- 
-                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
-                END LOOP;
- 
-                IF LOOP_COUNT1 >= CUT_OFF1 THEN
-                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
-                             "WITHIN ONE MINUTE - (C)");
-                END IF;
- 
-                IF ARA1.T(1)'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
-                             "- (C)");
-                END IF;
- 
-                ARA1.T(1).E;
-           END TSK;
- 
-      BEGIN -- (C)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 2.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
-                        "TWO MINUTES - (C)");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C94002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C94002D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK DOES  N O T  DEPEND ON A UNIT IF IT IS DESIGNATED
- -- BY A LOCAL ACCESS VARIABLE (OF THIS UNIT) WHOSE TYPE IS DECLARED
- -- OUTSIDE THIS UNIT.
- 
- -- WEI  3/ 4/82
- -- JBG 2/20/84
- -- TBN 11/25/85     RENAMED FROM C940ACB-B.ADA.
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C94002D IS
- 
-      TASK TYPE TT1 IS
-           ENTRY E1;
-           ENTRY E2;
-      END TT1;
- 
-      TYPE ATT1 IS ACCESS TT1;
-      OUTER_TT1 : ATT1;
- 
-      TASK BODY TT1 IS
-      BEGIN
-           ACCEPT E1;
-           ACCEPT E2;
-      END TT1;
- 
- BEGIN
-      TEST ("C94002D", "DEPENDENCY IS INDEPENDENT OF WHERE ACCESS " &
-                       "VARIABLE IS DECLARED");
- 
- BLOCK1 :
-      DECLARE
-           POINTER_TT1 : ATT1 := NEW TT1;
-      BEGIN
-           OUTER_TT1 := POINTER_TT1;
-           POINTER_TT1.ALL.E1;
-      END BLOCK1;         -- MAY DEADLOCK HERE IF INCORRECT DEPENDENCY
-                          -- RULE IS IMPLEMENTED.
- 
-      IF OUTER_TT1.ALL'TERMINATED THEN
-           FAILED ("NON-DEPENDENT TASK IS TERMINATED " &
-                   "IMMEDIATELY AFTER ENCLOSING UNIT HAS " &
-                   "BEEN COMPLETED");
-      END IF;
- 
-      OUTER_TT1.E2;       -- RELEASE TASK
- 
-      RESULT;
- 
- END C94002D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,207 ****
- -- C94002E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
- --   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
- --   TO TERMINATE.
- 
- -- SUBTESTS ARE:
- --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
- --   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
- --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
- 
- -- JRK 10/8/81
- -- SPS 11/2/82
- -- SPS 11/21/82
- -- JRK 11/29/82
- -- TBN 1/20/86     RENAMED FROM C94006A-B.ADA.  LOWERED THE DELAY VALUES
- --                 AND MODIFIED THE COMMENTS.
- -- JRK 5/1/86      IMPROVED ERROR RECOVERY LOGIC.
- -- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94002E IS
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-      BEGIN
-           ACCEPT E;
-           ACCEPT E;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C94002E", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
-                       "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
-                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
-                       "TERMINATE");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           TYPE A_T IS ACCESS TT;
-           A1 : A_T;
- 
-      BEGIN -- (A)
- 
-           DECLARE
-                A2 : A_T;
-           BEGIN
-                A2 := NEW TT;
-                A2.ALL.E;
-                A1 := A2;
-           END;
- 
-           IF A1.ALL'TERMINATED THEN
-                FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
-           ELSE A1.ALL.E;
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
- 
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                TYPE ART IS ACCESS RT;
-                AR1 : ART;
- 
-                PROCEDURE P (AR : OUT ART) IS
-                     AR2 : ART;
-                BEGIN
-                     AR2 := NEW RT;
-                     AR2.T.E;
-                     AR := AR2;
-                END P;
- 
-           BEGIN
-                P (AR1);
- 
-                IF AR1.T'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
-                             "- (B)");
-                ELSE AR1.T.E;
-                END IF;
- 
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           I := F;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60;                -- DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
- 
-                LOOP_COUNT1 : INTEGER := 0;
-                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
- 
-                TYPE RAT;
-                TYPE ARAT IS ACCESS RAT;
-                TYPE ARR IS ARRAY (1..1) OF TT;
-                TYPE RAT IS
-                     RECORD
-                          A : ARAT;
-                          T : ARR;
-                     END RECORD;
-                ARA1 : ARAT;
- 
-                TASK TSK1 IS
-                     ENTRY ENT1 (ARA : OUT ARAT);
-                END TSK1;
- 
-                TASK BODY TSK1 IS
-                     ARA2 : ARAT;
-                BEGIN
-                     ARA2 := NEW RAT;
-                     ARA2.T(1).E;
-                     ACCEPT ENT1 (ARA : OUT ARAT) DO
-                          ARA := ARA2;
-                     END ENT1;
-                END TSK1;
- 
-           BEGIN
-                TSK1.ENT1 (ARA1);
- 
-                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
-                END LOOP;
- 
-                IF LOOP_COUNT1 >= CUT_OFF1 THEN
-                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
-                             "WITHIN ONE MINUTE - (C)");
-                END IF;
- 
-                IF ARA1.T(1)'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
-                             "- (C)");
-                ELSE ARA1.T(1).E;
-                END IF;
-           END TSK;
- 
-      BEGIN -- (C)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 2.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
-                        "TWO MINUTES - (C)");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C94002E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,227 ****
- -- C94002F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
- --   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
- --   TO TERMINATE IF AN EXCEPTION IS RAISED AND HANDLED IN THE
- --   NON-MASTER UNIT.
- 
- -- SUBTESTS ARE:
- --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
- --   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
- --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
- 
- -- TBN 1/20/86
- -- JRK 5/1/86   IMPROVED ERROR RECOVERY.  FIXED EXCEPTION HANDLING.
- -- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94002F IS
- 
-      MY_EXCEPTION : EXCEPTION;
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-      BEGIN
-           ACCEPT E;
-           ACCEPT E;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C94002F", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
-                       "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
-                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
-                       "TERMINATE IF AN EXCEPTION IS RAISED AND " &
-                       "HANDLED IN THE NON-MASTER UNIT");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           TYPE A_T IS ACCESS TT;
-           A1 : A_T;
- 
-      BEGIN -- (A)
- 
-           DECLARE
-                A2 : A_T;
-           BEGIN
-                A2 := NEW TT;
-                A2.ALL.E;
-                A1 := A2;
-                RAISE MY_EXCEPTION;
-                FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
-           EXCEPTION
-                WHEN MY_EXCEPTION =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION IN (A)");
-           END;
- 
-           IF A1.ALL'TERMINATED THEN
-                FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
-           ELSE A1.ALL.E;
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
- 
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                TYPE ART IS ACCESS RT;
-                AR1 : ART;
- 
-                PROCEDURE P (AR : OUT ART) IS
-                     AR2 : ART;
-                BEGIN
-                     AR2 := NEW RT;
-                     AR2.T.E;
-                     AR := AR2;
-                     RAISE MY_EXCEPTION;
-                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
-                EXCEPTION
-                     WHEN MY_EXCEPTION =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION IN (B)");
-                END P;
- 
-           BEGIN
-                P (AR1);
- 
-                IF AR1.T'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
-                             "- (B)");
-                ELSE AR1.T.E;
-                END IF;
- 
-                RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           I := F;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60;                -- DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
- 
-                LOOP_COUNT1 : INTEGER := 0;
-                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
- 
-                TYPE RAT;
-                TYPE ARAT IS ACCESS RAT;
-                TYPE ARR IS ARRAY (1..1) OF TT;
-                TYPE RAT IS
-                     RECORD
-                          A : ARAT;
-                          T : ARR;
-                     END RECORD;
-                ARA1 : ARAT;
- 
-                TASK TSK1 IS
-                     ENTRY ENT1 (ARA : OUT ARAT);
-                END TSK1;
- 
-                TASK BODY TSK1 IS
-                     ARA2 : ARAT;
-                BEGIN
-                     ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
-                     ARA2.T(1).E;
-                     ACCEPT ENT1 (ARA : OUT ARAT) DO
-                          ARA := ARA2;
-                     END ENT1;
-                     RAISE MY_EXCEPTION;
-                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
-                EXCEPTION
-                     WHEN MY_EXCEPTION =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION IN (C)");
-                END TSK1;
- 
-           BEGIN
-                TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
- 
-                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
-                END LOOP;
- 
-                IF LOOP_COUNT1 >= CUT_OFF1 THEN
-                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
-                             "WITHIN ONE MINUTE - (C)");
-                END IF;
- 
-                IF ARA1.T(1)'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
-                             "- (C)");
-                ELSE ARA1.T(1).E;
-                END IF;
-           END TSK;
- 
-      BEGIN -- (C)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 2.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
-                        "TWO MINUTES - (C)");
-           END IF;
- 
-      END; -- (C)
- 
-      ---------------------------------------------------------------
- 
-      RESULT;
- END C94002F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94002g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94002g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,350 ****
- -- C94002G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
- --     ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED
- --     TASKS TO TERMINATE IF AN EXCEPTION IS RAISED BUT NOT HANDLED IN
- --     THE NON-MASTER UNIT.
- 
- --     SUBTESTS ARE:
- --        (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
- --        (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
- --        (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY, NOT
- --             DURING RENDEZVOUS.
- --        (D)  A LIMITED PRIVATE TASK ALLOCATOR, IN A TASK BODY, DURING
- --             RENDEZVOUS.
- 
- -- HISTORY:
- --     TBN 01/20/86  CREATED ORIGINAL TEST.
- --      JRK 05/01/86  IMPROVED ERROR RECOVERY.  FIXED EXCEPTION
- --                    HANDLING.  ADDED CASE (D).
- --      BCB 09/24/87  ADDED A RETURN STATEMENT TO THE HANDLER FOR OTHERS
- --                    IN FUNCTION F, CASE B.
- --      PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94002G IS
- 
-      MY_EXCEPTION : EXCEPTION;
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-      BEGIN
-           ACCEPT E;
-           ACCEPT E;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C94002G", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
-                       "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
-                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
-                       "TERMINATE IF AN EXCEPTION IS RAISED BUT NOT " &
-                       "HANDLED IN THE NON-MASTER UNIT");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           TYPE A_T IS ACCESS TT;
-           A1 : A_T;
- 
-      BEGIN -- (A)
- 
-           DECLARE
-                A2 : A_T;
-           BEGIN
-                A2 := NEW TT;
-                A2.ALL.E;
-                A1 := A2;
-                RAISE MY_EXCEPTION;
-                FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
-           END;
- 
-           ABORT A1.ALL;
- 
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF A1.ALL'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - " &
-                             "(A)");
-                ELSE A1.ALL.E;
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION IN (A)");
-                IF A1 /= NULL THEN
-                     ABORT A1.ALL;
-                END IF;
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
- 
-                TYPE RT IS
-                     RECORD
-                          T : TT;
-                     END RECORD;
-                TYPE ART IS ACCESS RT;
-                AR1 : ART;
- 
-                PROCEDURE P IS
-                     AR2 : ART;
-                BEGIN
-                     AR2 := NEW RT;
-                     AR2.T.E;
-                     AR1 := AR2;
-                     RAISE MY_EXCEPTION;
-                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
-                END P;
- 
-           BEGIN
-                P;
-                ABORT AR1.T;
-                RETURN 0;
-           EXCEPTION
-                WHEN MY_EXCEPTION =>
-                     IF AR1.T'TERMINATED THEN
-                          FAILED ("ALLOCATED TASK PREMATURELY " &
-                                  "TERMINATED - (B)");
-                     ELSE AR1.T.E;
-                     END IF;
-                     RETURN 0;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION IN (B)");
-                     IF AR1 /= NULL THEN
-                          ABORT AR1.T;
-                     END IF;
-                     RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           I := F;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60;                -- DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
- 
-                LOOP_COUNT1 : INTEGER := 0;
-                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
- 
-                TYPE RAT;
-                TYPE ARAT IS ACCESS RAT;
-                TYPE ARR IS ARRAY (1..1) OF TT;
-                TYPE RAT IS
-                     RECORD
-                          A : ARAT;
-                          T : ARR;
-                     END RECORD;
-                ARA1 : ARAT;
- 
-                TASK TSK1 IS
-                     ENTRY ENT1 (ARA : OUT ARAT);
-                END TSK1;
- 
-                TASK BODY TSK1 IS
-                     ARA2 : ARAT;
-                BEGIN
-                     ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
-                     ARA2.T(1).E;
-                     ACCEPT ENT1 (ARA : OUT ARAT) DO
-                          ARA := ARA2;
-                     END ENT1;
-                     RAISE MY_EXCEPTION;       -- NOT PROPOGATED.
-                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
-                END TSK1;
- 
-           BEGIN
-                TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
- 
-                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
-                END LOOP;
- 
-                IF LOOP_COUNT1 >= CUT_OFF1 THEN
-                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
-                             "WITHIN ONE MINUTE - (C)");
-                END IF;
- 
-                IF ARA1.T(1)'TERMINATED THEN
-                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
-                             "- (C)");
-                ELSE ARA1.T(1).E;
-                END IF;
-           END TSK;
- 
-      BEGIN -- (C)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 2.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
-                        "TWO MINUTES - (C)");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           LOOP_COUNT : INTEGER := 0;
-           CUT_OFF : CONSTANT := 60;                -- DELAY.
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
- 
-                LOOP_COUNT1 : INTEGER := 0;
-                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
- 
-                PACKAGE PKG IS
-                     TYPE LPT IS LIMITED PRIVATE;
-                     PROCEDURE CALL (X : LPT);
-                     PROCEDURE KILL (X : LPT);
-                     FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN;
-                PRIVATE
-                     TYPE LPT IS NEW TT;
-                END PKG;
- 
-                USE PKG;
- 
-                TYPE ALPT IS ACCESS LPT;
-                ALP1 : ALPT;
- 
-                PACKAGE BODY PKG IS
-                     PROCEDURE CALL (X : LPT) IS
-                     BEGIN
-                          X.E;
-                     END CALL;
- 
-                     PROCEDURE KILL (X : LPT) IS
-                     BEGIN
-                          ABORT X;
-                     END KILL;
- 
-                     FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN IS
-                     BEGIN
-                          RETURN X'TERMINATED;
-                     END TERMINATED;
-                END PKG;
- 
-                TASK TSK1 IS
-                     ENTRY ENT1 (ALP : OUT ALPT);
-                     ENTRY DIE;
-                END TSK1;
- 
-                TASK BODY TSK1 IS
-                     ALP2 : ALPT;
-                BEGIN
-                     ALP2 := NEW LPT;         -- INITIATE TASK ALP2.ALL.
-                     CALL (ALP2.ALL);
-                     ACCEPT ENT1 (ALP : OUT ALPT) DO
-                          ALP := ALP2;
-                     END ENT1;
-                     ACCEPT DIE DO
-                          RAISE MY_EXCEPTION;       -- PROPOGATED.
-                          FAILED ("MY_EXCEPTION WAS NOT RAISED IN (D)");
-                     END DIE;
-                END TSK1;
- 
-           BEGIN
-                TSK1.ENT1 (ALP1); -- ALP1.ALL BECOMES ALIAS FOR ALP2.ALL.
-                TSK1.DIE;
-                FAILED ("MY_EXCEPTION WAS NOT PROPOGATED TO CALLING " &
-                        "TASK - (D)");
-                KILL (ALP1.ALL);
-                ABORT TSK1;
-           EXCEPTION
-                WHEN MY_EXCEPTION =>
-                     WHILE NOT TSK1'TERMINATED AND
-                           LOOP_COUNT1 < CUT_OFF1 LOOP
-                          DELAY 1.0 * Impdef.One_Second;
-                          LOOP_COUNT1 := LOOP_COUNT1 + 1;
-                     END LOOP;
- 
-                     IF LOOP_COUNT1 >= CUT_OFF1 THEN
-                          FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
-                                  "WITHIN ONE MINUTE - (D)");
-                     END IF;
- 
-                     IF TERMINATED (ALP1.ALL) THEN
-                          FAILED ("ALLOCATED TASK PREMATURELY " &
-                                  "TERMINATED - (D)");
-                     ELSE CALL (ALP1.ALL);
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION IN (D)");
-                     IF ALP1 /= NULL THEN
-                          KILL (ALP1.ALL);
-                     END IF;
-                     ABORT TSK1;
-           END TSK;
- 
-      BEGIN -- (D)
- 
-           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
-                DELAY 2.0 * Impdef.One_Second;
-                LOOP_COUNT := LOOP_COUNT + 1;
-           END LOOP;
- 
-           IF LOOP_COUNT >= CUT_OFF THEN
-                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
-                        "TWO MINUTES - (D)");
-           END IF;
- 
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C94002G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C94004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
- -- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
- -- MAIN PROGRAM TERMINATION.
- 
- -- CASE A:  TASK OBJECT DECLARED IN LIBRARY PACKAGE USED BY MAIN
- --          PROGRAM.
- 
- -- JRK 10/8/81
- -- SPS 11/21/82
- -- JBG 12/6/84
- -- JRK 11/21/85  RENAMED FROM C94004A-B.ADA; REVISED ACCORDING TO
- --               AI-00399.
- -- JRK 10/24/86  RENAMED FROM E94004A-B.ADA; REVISED ACCORDING TO
- --               REVISED AI-00399.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- PACKAGE C94004A_PKG IS
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
- END C94004A_PKG;
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY C94004A_PKG IS
- 
-      TASK BODY TT IS
-           I : INTEGER := IDENT_INT (120);
-      BEGIN
-           ACCEPT E;
-           COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
-           DELAY DURATION(I) * Impdef.One_Second;
-           -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
-           RESULT;
-      END TT;
- 
- END C94004A_PKG;
- 
- WITH C94004A_PKG; USE C94004A_PKG;
- PRAGMA ELABORATE (C94004A_PKG);
- PACKAGE C94004A_TASK IS
-      T : TT;
- END;
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH C94004A_TASK;
- PROCEDURE C94004A IS
- 
- 
- BEGIN
-      TEST ("C94004A", "CHECK THAT A MAIN PROGRAM TERMINATES " &
-                       "WITHOUT WAITING FOR TASKS THAT DEPEND " &
-                       "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
-                       "CONTINUE TO EXECUTE");
- 
-      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
-               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
- 
-      C94004A_TASK.T.E;      -- ALLOW TASK TO PROCEED.
-      IF C94004A_TASK.T'TERMINATED THEN
-           FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
-      END IF;
- 
-      -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
- 
- END C94004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94004b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94004b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94004b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C94004B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
- -- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
- -- MAIN PROGRAM TERMINATION.
- 
- -- CASE B:  ACCESS TO TASK TYPE DECLARED IN LIBRARY PACKAGE; TASK
- --          ACTIVATED IN MAIN PROGRAM.
- 
- -- JRK 10/8/81
- -- SPS 11/21/82
- -- JBG 12/6/84
- -- JRK 11/21/85  RENAMED FROM C94004B-B.ADA; REVISED ACCORDING TO
- --               AI-00399.
- -- JRK 10/24/86  RENAMED FROM E94004B-B.ADA; REVISED ACCORDING TO
- --               REVISED AI-00399.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- PACKAGE C94004B_PKG IS
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
- END C94004B_PKG;
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY C94004B_PKG IS
- 
-      TASK BODY TT IS
-           I : INTEGER := IDENT_INT (120);
-      BEGIN
-           ACCEPT E;
-           COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
-           DELAY DURATION(I) * Impdef.One_Second;
-           -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
-           RESULT;
-      END TT;
- 
- END C94004B_PKG;
- 
- WITH C94004B_PKG; USE C94004B_PKG;
- PRAGMA ELABORATE (C94004B_PKG);
- PACKAGE C94004B_TASK IS
-      TYPE ACC_TASK IS ACCESS C94004B_PKG.TT;
- END;
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH C94004B_TASK; WITH C94004B_PKG;
- PROCEDURE C94004B IS
- 
-      T : C94004B_TASK.ACC_TASK;
- 
- BEGIN
-      TEST ("C94004B", "CHECK THAT A MAIN PROGRAM TERMINATES " &
-                       "WITHOUT WAITING FOR TASKS THAT DEPEND " &
-                       "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
-                       "CONTINUE TO EXECUTE");
- 
-      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
-               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
- 
-      T := NEW C94004B_PKG.TT;
-      T.E;      -- ALLOW TASK TO PROCEED.
-      IF T'TERMINATED THEN
-           FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
-      END IF;
- 
-      -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
- 
- END C94004B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94004c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94004c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94004c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C94004C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
- -- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
- -- MAIN PROGRAM TERMINATION.
- 
- -- CASE C:  TASK OBJECT DECLARED IN LIBRARY PACKAGE USED BY MAIN PROGRAM
- --          AND WAITING AT A SELECTIVE WAIT WITH TERMINATE.
- 
- -- JRK 10/8/81
- -- SPS 11/21/82
- -- JBG 12/6/84
- -- JRK 11/21/85  RENAMED FROM C94004C-B.ADA; REVISED ACCORDING TO
- --               AI-00399.
- -- JRK 10/24/86  RENAMED FROM E94004C-B.ADA; REVISED ACCORDING TO
- --               REVISED AI-00399.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- PACKAGE C94004C_PKG IS
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
- END C94004C_PKG;
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY C94004C_PKG IS
- 
-      TASK BODY TT IS
-           I : INTEGER := IDENT_INT (120);
-      BEGIN
-           ACCEPT E;
-           COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
-           DELAY DURATION(I) * Impdef.One_Second;
-           -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
-           RESULT;
-           -- USE LOOP FOR SELECTIVE WAIT WITH TERMINATE.
-           LOOP
-                SELECT
-                     ACCEPT E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END LOOP;
-           -- FAILS IF JOB HANGS UP WITHOUT TERMINATING.
-      END TT;
- 
- END C94004C_PKG;
- 
- WITH C94004C_PKG; USE C94004C_PKG;
- PRAGMA ELABORATE (C94004C_PKG);
- PACKAGE C94004C_TASK IS
-      T : TT;
- END;
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH C94004C_TASK;
- PROCEDURE C94004C IS
- 
- 
- BEGIN
-      TEST ("C94004C", "CHECK THAT A MAIN PROGRAM TERMINATES " &
-                       "WITHOUT WAITING FOR TASKS THAT DEPEND " &
-                       "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
-                       "CONTINUE TO EXECUTE");
- 
-      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
-               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
- 
-      C94004C_TASK.T.E;      -- ALLOW TASK TO PROCEED.
-      IF C94004C_TASK.T'TERMINATED THEN
-           FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
-      END IF;
- 
-      -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
- 
- END C94004C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C94005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, A MAIN
- --   PROGRAM THAT DECLARES OBJECTS OF THAT TYPE DOES WAIT FOR
- --   TERMINATION OF SUCH OBJECTS.
- 
- -- THIS TEST CONTAINS RACE CONDITIONS.
- 
- -- JRK 10/8/81
- -- SPS 11/21/82
- -- JWC 11/15/85    MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005A_PKG.
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- 
- WITH SYSTEM; USE SYSTEM;
- PACKAGE C94005A_PKG IS
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
- END C94005A_PKG;
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PACKAGE BODY C94005A_PKG IS
- 
-      TASK BODY TT IS
-           I : INTEGER := IDENT_INT (0);
-      BEGIN
-           ACCEPT E;
-           FOR J IN 1..60 LOOP
-                I := IDENT_INT (I);
-                DELAY 1.0 * Impdef.One_Second;
-           END LOOP;
-           RESULT;   -- FAILURE IF THIS MESSAGE IS NOT WRITTEN.
-      END TT;
- 
- END C94005A_PKG;
- 
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH C94005A_PKG;
- PROCEDURE C94005A IS
- 
-      T : C94005A_PKG.TT;
- 
- 
- BEGIN
-      TEST ("C94005A", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
-                       "LIBRARY PACKAGE, A MAIN PROGRAM THAT " &
-                       "DECLARES OBJECTS OF THAT TYPE DOES WAIT FOR " &
-                       "TERMINATION OF SUCH OBJECTS");
- 
-      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
-               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
- 
-      T.E;
- 
-      IF T'TERMINATED THEN
-           COMMENT ("TEST INCONCLUSIVE BECAUSE TASK T PREMATURELY " &
-                    "TERMINATED");
-      END IF;
- 
-      -- TASK T SHOULD WRITE THE RESULT MESSAGE.
- 
- END C94005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,168 ****
- -- C94005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, ANY
- --   BLOCKS, SUBPROGRAMS, OR TASKS THAT DECLARE OBJECTS OF THAT TYPE
- --   DO WAIT FOR TERMINATION OF SUCH OBJECTS.
- -- SUBTESTS ARE:
- --   (A)  IN A MAIN PROGRAM BLOCK.
- --   (B)  IN A LIBRARY FUNCTION.
- --   (C)  IN A MAIN PROGRAM TASK BODY.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
- 
- -- JRK 10/8/81
- -- SPS 11/2/82
- -- SPS 11/21/82
- -- JWC 11/15/85    MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005B_PKG.
- -- PWN 01/31/95    REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- 
- WITH SYSTEM; USE SYSTEM;
- PACKAGE C94005B_PKG IS
- 
-      GLOBAL : INTEGER;
- 
-      TASK TYPE TT IS
-           ENTRY E (I : INTEGER);
-      END TT;
- 
- END C94005B_PKG;
- 
- with Impdef;
- PACKAGE BODY C94005B_PKG IS
- 
-      TASK BODY TT IS
-           LOCAL : INTEGER;
-      BEGIN
-           ACCEPT E (I : INTEGER) DO
-                LOCAL := I;
-           END E;
-           DELAY 60.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
-                          -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
-                          -- TERMINATE IF THE ERROR IS PRESENT.
-           GLOBAL := LOCAL;
-      END TT;
- 
- END C94005B_PKG;
- 
- 
- WITH REPORT; USE REPORT;
- WITH C94005B_PKG; USE C94005B_PKG;
- FUNCTION F RETURN INTEGER IS
- 
-      T : TT;
- 
- BEGIN
- 
-      T.E (IDENT_INT(2));
-      RETURN 0;
- 
- END F;
- 
- with Impdef;
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH C94005B_PKG; USE C94005B_PKG;
- WITH F;
- PROCEDURE C94005B IS
- 
- 
- BEGIN
-      TEST ("C94005B", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
-                       "LIBRARY PACKAGE, ANY BLOCKS, SUBPROGRAMS, OR " &
-                       "TASKS THAT DECLARE OBJECTS OF THAT TYPE DO " &
-                       "WAIT FOR TERMINATION OF SUCH OBJECTS");
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (A)
- 
-           T : TT;
- 
-      BEGIN -- (A)
- 
-           T.E (IDENT_INT(1));
- 
-      END; -- (A)
- 
-      IF GLOBAL /= 1 THEN
-           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                   "BLOCK EXIT - (A)");
-      END IF;
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (B)
- 
-           I : INTEGER;
- 
-      BEGIN -- (B)
- 
-           I := F ;
- 
-           IF GLOBAL /= 2 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "FUNCTION EXIT - (B)");
-           END IF;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      GLOBAL := IDENT_INT (0);
- 
-      DECLARE -- (C)
- 
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           TASK BODY TSK IS
-                T : TT;
-           BEGIN
-                T.E (IDENT_INT(3));
-           END TSK;
- 
-      BEGIN -- (C)
- 
-           WHILE NOT TSK'TERMINATED LOOP
-                DELAY 0.1 * Impdef.One_Second;
-           END LOOP;
- 
-           IF GLOBAL /= 3 THEN
-                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
-                        "TASK EXIT - (C)");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C94005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- C94006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A DECLARATION THAT RENAMES A TASK DOES NOT CREATE A NEW
- -- MASTER FOR THE TASK.
- 
- -- TBN  9/17/86
- -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94006A IS
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TASK BODY TT IS
-      BEGIN
-           SELECT
-                ACCEPT E;
-           OR
-                DELAY 30.0 * Impdef.One_Long_Second;
-           END SELECT;
-      END TT;
- 
- 
- BEGIN
-      TEST ("C94006A", "CHECK THAT A DECLARATION THAT RENAMES A TASK " &
-                       "DOES NOT CREATE A NEW MASTER FOR THE TASK");
- 
-      -------------------------------------------------------------------
-      DECLARE
-           T1 : TT;
-      BEGIN
-           DECLARE
-                RENAME_TASK : TT RENAMES T1;
-           BEGIN
-                NULL;
-           END;
-           IF T1'TERMINATED THEN
-                FAILED ("TASK DEPENDENT ON WRONG UNIT - 1");
-           ELSE
-                T1.E;
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
-           T2 : TT;
- 
-           PACKAGE P IS
-                Q : TT RENAMES T2;
-           END P;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                NULL;
-           END P;
- 
-           USE P;
-      BEGIN
-           IF Q'TERMINATED THEN
-                FAILED ("TASK DEPENDENT ON WRONG UNIT - 2");
-           ELSE
-                Q.E;
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
-           TYPE ACC_TT IS ACCESS TT;
-           P1 : ACC_TT;
-      BEGIN
-           DECLARE
-                RENAME_ACCESS : ACC_TT RENAMES P1;
-           BEGIN
-                RENAME_ACCESS := NEW TT;
-           END;
-           IF P1'TERMINATED THEN
-                FAILED ("TASK DEPENDENT ON WRONG UNIT - 3");
-           ELSE
-                P1.E;
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
- 
-      DECLARE
-           TYPE ACC_TT IS ACCESS TT;
-           P2 : ACC_TT;
- 
-           PACKAGE Q IS
-                RENAME_ACCESS : ACC_TT RENAMES P2;
-           END Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                RENAME_ACCESS := NEW TT;
-           END Q;
- 
-           USE Q;
-      BEGIN
-           IF RENAME_ACCESS'TERMINATED THEN
-                FAILED ("TASK DEPENDENT ON WRONG UNIT - 4");
-           ELSE
-                RENAME_ACCESS.E;
-           END IF;
-      END;
- 
-      RESULT;
- END C94006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,270 ****
- -- C94007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE
- --     (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
- --     BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
- --     OR TASK BODY.
- --     SUBTESTS ARE:
- --       (A)  A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK.
- --       (B)  AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION.
- --       (C)  AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY,
- --            IN A TASK BODY.
- 
- -- HISTORY:
- --     JRK 10/13/81
- --     SPS 11/21/82
- --     DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER
- --                  BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A
- --                  PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS.
- --     PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94007A IS
- 
-      TASK TYPE SYNC IS
-           ENTRY ID (C : CHARACTER);
-           ENTRY INNER;
-           ENTRY OUTER;
-      END SYNC;
- 
-      TASK BODY SYNC IS
-           ID_C : CHARACTER;
-      BEGIN
-           ACCEPT ID (C : CHARACTER) DO
-                ID_C := C;
-           END ID;
-           DELAY 1.0 * Impdef.One_Second;
-           SELECT
-                ACCEPT OUTER;
-           OR
-                DELAY 120.0 * Impdef.One_Second;
-                FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
-           END SELECT;
-           ACCEPT INNER;
-      END SYNC;
- 
- 
- BEGIN
-      TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " &
-                       "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
-                       "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
-                       "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
-                       "BODY, OR TASK BODY");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           S : SYNC;
- 
-      BEGIN -- (A)
- 
-           S.ID ('A');
- 
-           DECLARE
- 
-                PACKAGE PKG IS
-                     TASK T IS
-                          ENTRY E;
-                     END T;
-                END PKG;
- 
-                PACKAGE BODY PKG IS
-                     TASK BODY T IS
-                     BEGIN
-                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
-                     END T;
-                END PKG;            -- PROBABLE OUTER BLOCK POINT.
- 
-           BEGIN
- 
-                S.OUTER;
- 
-           EXCEPTION
-                WHEN TASKING_ERROR => NULL;
-           END;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED - A");
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           S : SYNC;
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
- 
-                PACKAGE PKG IS
-                PRIVATE
-                     TASK TYPE TT IS
-                          ENTRY E;
-                     END TT;
-                     A : ARRAY (1..1) OF TT;
-                END PKG;
- 
-                PACKAGE BODY PKG IS
-                     TASK BODY TT IS
-                     BEGIN
-                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
-                     END TT;
-                END PKG;            -- PROBABLE OUTER BLOCK POINT.
- 
-           BEGIN -- F
- 
-                S.OUTER;
-                RETURN 0;
- 
-           EXCEPTION
-                WHEN TASKING_ERROR => RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           S.ID ('B');
-           I := F;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED - B");
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           S : SYNC;
- 
-      BEGIN -- (C)
- 
-           S.ID ('C');
- 
-           DECLARE
- 
-                TASK TSK IS
-                END TSK;
- 
-                TASK BODY TSK IS
- 
-                     PACKAGE PKG IS
-                     END PKG;
- 
-                     PACKAGE BODY PKG IS
-                          TASK TYPE TT IS
-                               ENTRY E;
-                          END TT;
- 
-                          TYPE RT IS
-                               RECORD
-                                    T : TT;
-                               END RECORD;
- 
-                          AR : ARRAY (1..1) OF RT;
- 
-                          TASK BODY TT IS
-                          BEGIN
-                               S.INNER;  -- PROBABLE INNER BLOCK POINT.
-                          END TT;
-                     END PKG;            -- PROBABLE OUTER BLOCK POINT.
- 
-                BEGIN -- TSK
- 
-                     S.OUTER;
- 
-                EXCEPTION
-                     WHEN TASKING_ERROR => NULL;
-                END TSK;
- 
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED - C");
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-      GLOBAL : INTEGER := IDENT_INT(5);
- 
-      BEGIN -- (D)
- 
-           DECLARE
- 
-                PACKAGE PKG IS
-                     TASK T IS
-                          ENTRY E;
-                     END T;
- 
-                     TASK T1 IS
-                     END T1;
-                END PKG;
- 
-                PACKAGE BODY PKG IS
-                     TASK BODY T IS
-                     BEGIN
-                          ACCEPT E DO
-                               RAISE CONSTRAINT_ERROR;
-                          END E;
-                     END T;
- 
-                     TASK BODY T1 IS
-                     BEGIN
-                          DELAY 120.0 * Impdef.One_Second;
-                          GLOBAL := IDENT_INT(1);
-                     END T1;
- 
-                BEGIN
-                     T.E;
- 
-                END PKG;
-                USE PKG;
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF GLOBAL /= IDENT_INT(1) THEN
-                     FAILED("TASK NOT COMPLETED");
-                END IF;
- 
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED - D");
-      END; -- (D)
- 
-      RESULT;
- END C94007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94007b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94007b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94007b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,224 ****
- -- C94007B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK THAT IS ALLOCATED IN A NON-LIBRARY PACKAGE
- --   (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
- --   BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
- --   OR TASK BODY.
- -- SUBTESTS ARE:
- --   (A)  A SIMPLE TASK ALLOCATOR, IN A VISIBLE PART, IN A BLOCK.
- --   (B)  A RECORD OF TASK ALLOCATOR, IN A PRIVATE PART, IN A FUNCTION.
- --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY,
- --           IN A TASK BODY.
- 
- -- JRK 10/16/81
- -- SPS 11/2/82
- -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94007B IS
- 
-      TASK TYPE SYNC IS
-           ENTRY ID (C : CHARACTER);
-           ENTRY INNER;
-           ENTRY OUTER;
-      END SYNC;
- 
-      TASK BODY SYNC IS
-           ID_C : CHARACTER;
-      BEGIN
-           ACCEPT ID (C : CHARACTER) DO
-                ID_C := C;
-           END ID;
-           DELAY 1.0 * Impdef.One_Second;
-           SELECT
-                ACCEPT OUTER;
-           OR
-                DELAY 120.0 * Impdef.One_Second;
-                FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
-           END SELECT;
-           ACCEPT INNER;
-      END SYNC;
- 
- 
- BEGIN
-      TEST ("C94007B", "CHECK THAT A TASK THAT IS ALLOCATED IN A " &
-                       "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
-                       "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
-                       "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
-                       "BODY, OR TASK BODY");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           S : SYNC;
- 
-      BEGIN -- (A)
- 
-           S.ID ('A');
- 
-           DECLARE
- 
-                PACKAGE PKG IS
-                     TASK TYPE TT IS
-                          ENTRY E;
-                     END TT;
-                     TYPE A_T IS ACCESS TT;
-                     A : A_T;
-                END PKG;
- 
-                PACKAGE BODY PKG IS
-                     TASK BODY TT IS
-                     BEGIN
-                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
-                     END TT;
-                BEGIN
-                     A := NEW TT;
-                END PKG;            -- PROBABLE OUTER BLOCK POINT.
- 
-           BEGIN
- 
-                S.OUTER;
- 
-           EXCEPTION
-                WHEN TASKING_ERROR => NULL;
-           END;
- 
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           S : SYNC;
- 
-           I : INTEGER;
- 
-           FUNCTION F RETURN INTEGER IS
- 
-                PACKAGE PKG IS
-                PRIVATE
-                     TASK TYPE TT IS
-                          ENTRY E;
-                     END TT;
- 
-                     TYPE RT IS
-                          RECORD
-                               T : TT;
-                          END RECORD;
- 
-                     TYPE ART IS ACCESS RT;
- 
-                     AR : ART;
-                END PKG;
- 
-                PACKAGE BODY PKG IS
-                     TASK BODY TT IS
-                     BEGIN
-                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
-                     END TT;
-                BEGIN
-                     AR := NEW RT;
-                END PKG;            -- PROBABLE OUTER BLOCK POINT.
- 
-           BEGIN -- F
- 
-                S.OUTER;
-                RETURN 0;
- 
-           EXCEPTION
-                WHEN TASKING_ERROR => RETURN 0;
-           END F;
- 
-      BEGIN -- (B)
- 
-           S.ID ('B');
-           I := F ;
- 
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           S : SYNC;
- 
-      BEGIN -- (C)
- 
-           S.ID ('C');
- 
-           DECLARE
- 
-                TASK TSK IS
-                END TSK;
- 
-                TASK BODY TSK IS
- 
-                     PACKAGE PKG IS
-                     END PKG;
- 
-                     PACKAGE BODY PKG IS
-                          TASK TYPE TT IS
-                               ENTRY E;
-                          END TT;
-                          
-                          TYPE ARR IS ARRAY (1..1) OF TT;
-                          TYPE RAT IS
-                               RECORD
-                                    T : ARR;
-                               END RECORD;
- 
-                          TYPE ARAT IS ACCESS RAT;
- 
-                          ARA : ARAT;
- 
-                          TASK BODY TT IS
-                          BEGIN
-                               S.INNER;  -- PROBABLE INNER BLOCK POINT.
-                          END TT;
-                     BEGIN
-                          ARA := NEW RAT;
-                     END PKG;            -- PROBABLE OUTER BLOCK POINT.
- 
-                BEGIN -- TSK
- 
-                     S.OUTER;
- 
-                EXCEPTION
-                     WHEN TASKING_ERROR => NULL;
-                END TSK;
- 
-           BEGIN
-                NULL;
-           END;
- 
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C94007B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- C94008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK WAITING AT AN OPEN TERMINATE ALTERNATIVE
- -- DOES  N O T  TERMINATE WHILE THE UNIT THE TASK DEPENDS ON
- -- HAS NOT COMPLETED ITS EXECUTION.
- 
- -- WEI  3/ 4/82
- -- TBN  11/25/85     RENAMED FROM C940BAA-B.ADA.
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C94008A IS
- BEGIN
-      TEST ("C94008A", "TERMINATION WHILE WAITING AT " &
-                       "AN OPEN TERMINATE ALTERNATIVE");
- 
- BLOCK1 :
-      DECLARE
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                SELECT
-                     WHEN TRUE => TERMINATE;
-                     OR WHEN FALSE => ACCEPT E1;
-                END SELECT;
-           END T1;
-      BEGIN  -- BLOCK1
-           IF T1'TERMINATED THEN
-                FAILED ("TASK T1 TERMINATED BEFORE OUTER UNIT HAS " &
-                        "BEEN LEFT");
-           END IF;
-      END BLOCK1;
- 
-      RESULT;
- 
- END C94008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C94008B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK WAITING AT AN OPEN TERMINATE ALTERNATIVE
- -- DOES  N O T  TERMINATE UNTIL ALL OTHER TASKS DEPENDING ON THE SAME
- -- UNIT EITHER ARE TERMINATED OR ARE WAITING AT AN OPEN TERMINATE.
- 
- -- WEI  3/ 4/82
- -- TBN 11/25/85     RENAMED FROM C940BBA-B.ADA.
- 
- with Impdef;
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C94008B IS
- BEGIN
-      TEST ("C94008B", "TERMINATION WHILE WAITING AT AN OPEN TERMINATE");
- 
- BLOCK1 :
-      DECLARE
- 
-           TASK TYPE TT1 IS
-                ENTRY E1;
-           END TT1;
- 
-           NUMB_TT1 : CONSTANT NATURAL := 3;
-           DELAY_TIME : DURATION := 0.0;
-           ARRAY_TT1 : ARRAY (1 .. NUMB_TT1) OF TT1;
- 
-           TASK BODY TT1 IS
-           BEGIN
-                DELAY_TIME := DELAY_TIME + 1.0 * Impdef.One_Second;
-                DELAY DELAY_TIME;
-                FOR I IN 1 .. NUMB_TT1
-                LOOP
-                     IF ARRAY_TT1 (I)'TERMINATED THEN
-                          FAILED ("TOO EARLY TERMINATION OF " &
-                                  "TASK TT1 INDEX" & INTEGER'IMAGE(I));
-                     END IF;
-                END LOOP;
- 
-                SELECT
-                     WHEN TRUE => TERMINATE;
-                  OR WHEN FALSE => ACCEPT E1;
-                END SELECT;
-           END TT1;
- 
-      BEGIN  -- BLOCK1.
-           FOR I IN 1 .. NUMB_TT1
-           LOOP
-                IF ARRAY_TT1 (I)'TERMINATED THEN
-                     FAILED ("TERMINATION BEFORE OUTER " &
-                             "UNIT HAS BEEN LEFT OF TASK TT1 INDEX " &
-                             INTEGER'IMAGE(I));
-                END IF;
-           END LOOP;
-      END BLOCK1;
- 
-      RESULT;
- 
- END C94008B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,265 ****
- -- C94008C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
- -- NESTED TASKS.
- 
- -- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
- -- CONTAINS TASKS.
- 
- -- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
- -- JRK 4/7/86
- -- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94008C IS
- 
- 
- -- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
-      GENERIC
-           TYPE HOLDER_TYPE IS PRIVATE;
-           TYPE VALUE_TYPE IS PRIVATE;
-           INITIAL_VALUE : HOLDER_TYPE;
-           WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
-                               VALUE  : IN  HOLDER_TYPE) IS <>;
-           WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
-                                  VALUE  : IN  VALUE_TYPE) IS <>;
-      PACKAGE SHARED IS
-           PROCEDURE SET (VALUE : IN HOLDER_TYPE);
-           PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
-           FUNCTION GET RETURN HOLDER_TYPE;
-      END SHARED;
- 
-      PACKAGE BODY SHARED IS
-           TASK SHARE IS
-                ENTRY SET    (VALUE : IN HOLDER_TYPE);
-                ENTRY UPDATE (VALUE : IN VALUE_TYPE);
-                ENTRY READ   (VALUE : OUT HOLDER_TYPE);
-           END SHARE;
- 
-           TASK BODY SHARE IS
-                VARIABLE : HOLDER_TYPE;
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
-                               SHARED.SET (VARIABLE, VALUE);
-                          END SET;
-                     OR
-                          ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
-                               SHARED.UPDATE (VARIABLE, VALUE);
-                          END UPDATE;
-                     OR
-                          ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
-                               VALUE := VARIABLE;
-                          END READ;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END SHARE;
- 
-           PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
-           BEGIN
-                SHARE.SET (VALUE);
-           END SET;
- 
-           PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
-           BEGIN
-                SHARE.UPDATE (VALUE);
-           END UPDATE;
- 
-           FUNCTION GET RETURN HOLDER_TYPE IS
-                VALUE : HOLDER_TYPE;
-           BEGIN
-                SHARE.READ (VALUE);
-                RETURN VALUE;
-           END GET;
- 
-      BEGIN
-           SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
-      END SHARED;
- 
-      PACKAGE EVENTS IS
- 
-           TYPE EVENT_TYPE IS
-                RECORD
-                     TRACE  : STRING (1..4) := "....";
-                     LENGTH : NATURAL := 0;
-                END RECORD;
- 
-           PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
-           PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
-      END EVENTS;
- 
-      PACKAGE COUNTER IS
-           PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
-           PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
-      END COUNTER;
- 
-      PACKAGE BODY COUNTER IS
-           PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
-           BEGIN
-                VAR := VAR + VAL;
-           END UPDATE;
- 
-           PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
-           BEGIN
-                VAR := VAL;
-           END SET;
-      END COUNTER;
- 
-      PACKAGE BODY EVENTS IS
-           PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
-           BEGIN
-                VAR.LENGTH := VAR.LENGTH + 1;
-                VAR.TRACE(VAR.LENGTH) := VAL;
-           END UPDATE;
- 
-           PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
-           BEGIN
-                VAR := VAL;
-           END SET;
- 
-      END EVENTS;
- 
-      USE EVENTS, COUNTER;
- 
-      PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
-      PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
- 
-      FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
-      BEGIN
-           TERMINATE_COUNT.UPDATE (1);
-           RETURN TRUE;
-      END ENTER_TERMINATE;
- 
- BEGIN -- C94008C
- 
-      TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
-                       "TERMINATE ALTERNATIVE");
- 
-      DECLARE
- 
-           PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
- 
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
- 
-           TASK BODY T1 IS
- 
-                TASK T2 IS
-                     ENTRY E2;
-                END T2;
- 
-                TASK BODY T2 IS
- 
-                     TASK T3 IS
-                          ENTRY E3;
-                     END T3;
- 
-                     TASK BODY T3 IS
-                     BEGIN
-                          SELECT
-                               ACCEPT E3;
-                          OR WHEN ENTER_TERMINATE => TERMINATE;
-                          END SELECT;
-                          EVENT ('D');
-                     END T3;
- 
-                BEGIN -- T2
- 
-                     SELECT
-                          ACCEPT E2;
-                     OR WHEN ENTER_TERMINATE => TERMINATE;
-                     END SELECT;
- 
-                     DELAY 10.0 * Impdef.One_Second;
- 
-                     IF TERMINATE_COUNT.GET /= 1 THEN
-                          DELAY 20.0 * Impdef.One_Long_Second;
-                     END IF;
- 
-                     IF TERMINATE_COUNT.GET /= 1 THEN
-                          FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
-                     END IF;
- 
-                     EVENT ('C');
-                     T1.E1;
-                     T3.E3;
-                END T2;
- 
-           BEGIN -- T1;
- 
-                SELECT
-                     ACCEPT E1;
-                OR WHEN ENTER_TERMINATE => TERMINATE;
-                END SELECT;
- 
-                EVENT ('B');
-                TERMINATE_COUNT.SET (0);
-                T2.E2;
- 
-                SELECT
-                     ACCEPT E1;
-                OR WHEN ENTER_TERMINATE => TERMINATE;
-                END SELECT;
- 
-                SELECT
-                     ACCEPT E1;
-                OR TERMINATE;  -- ONLY THIS ONE EVER CHOSEN.
-                END SELECT;
- 
-                FAILED ("TERMINATE NOT SELECTED IN T1");
-           END T1;
- 
-      BEGIN
- 
-           DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
- 
-            IF TERMINATE_COUNT.GET /= 3 THEN
-                 DELAY 20.0 * Impdef.One_Long_Second;
-            END IF;
- 
-            IF TERMINATE_COUNT.GET /= 3 THEN
-                 FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
-            END IF;
- 
-           EVENT ('A');
-           T1.E1;
- 
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
-      END;
- 
-      IF TRACE.GET.TRACE /= "ABCD" THEN
-           FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
-      END IF;
- 
-      RESULT;
- END C94008C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94008d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94008d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,235 ****
- -- C94008D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK CORRECT OPERATION OF SELECT WITH TERMINATE ALTERNATIVE WHEN
- -- EXECUTED FROM AN INNER BLOCK WITH OUTER DEPENDING TASKS.
- 
- -- JEAN-PIERRE ROSEN 03-MAR-84
- -- JRK 4/7/86
- -- JBG 9/4/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT/SUBUNIT
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- -- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
- GENERIC
-      TYPE HOLDER_TYPE IS PRIVATE;
-      TYPE VALUE_TYPE IS PRIVATE;
-      INITIAL_VALUE : HOLDER_TYPE;
-      WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
-                          VALUE  : IN  HOLDER_TYPE) IS <>;
-      WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
-                             VALUE  : IN  VALUE_TYPE) IS <>;
- PACKAGE SHARED_C94008D IS
-      PROCEDURE SET (VALUE : IN HOLDER_TYPE);
-      PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
-      FUNCTION GET RETURN HOLDER_TYPE;
- END SHARED_C94008D;
- 
- PACKAGE BODY SHARED_C94008D IS
-      TASK SHARE IS
-           ENTRY SET    (VALUE : IN HOLDER_TYPE);
-           ENTRY UPDATE (VALUE : IN VALUE_TYPE);
-           ENTRY READ   (VALUE : OUT HOLDER_TYPE);
-      END SHARE;
- 
-      TASK BODY SHARE IS SEPARATE;
- 
-      PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
-      BEGIN
-           SHARE.SET (VALUE);
-      END SET;
- 
-      PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
-      BEGIN
-           SHARE.UPDATE (VALUE);
-      END UPDATE;
- 
-      FUNCTION GET RETURN HOLDER_TYPE IS
-           VALUE : HOLDER_TYPE;
-      BEGIN
-           SHARE.READ (VALUE);
-           RETURN VALUE;
-      END GET;
- 
- BEGIN
-      SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
- END SHARED_C94008D;
- 
- PACKAGE EVENTS_C94008D IS
- 
-      TYPE EVENT_TYPE IS
-           RECORD
-                TRACE  : STRING (1..4) := "....";
-                LENGTH : NATURAL := 0;
-           END RECORD;
- 
-      PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
-      PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
- END EVENTS_C94008D;
- 
- PACKAGE COUNTER_C94008D IS
-      PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
-      PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
- END COUNTER_C94008D;
- 
- PACKAGE BODY COUNTER_C94008D IS
-      PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
-      BEGIN
-           VAR := VAR + VAL;
-      END UPDATE;
- 
-      PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
-      BEGIN
-           VAR := VAL;
-      END SET;
- END COUNTER_C94008D;
- 
- PACKAGE BODY EVENTS_C94008D IS
-      PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
-      BEGIN
-           VAR.LENGTH := VAR.LENGTH + 1;
-           VAR.TRACE(VAR.LENGTH) := VAL;
-      END UPDATE;
- 
-      PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
-      BEGIN
-           VAR := VAL;
-      END SET;
- 
- END EVENTS_C94008D;
- 
- SEPARATE (SHARED_C94008D)
- TASK BODY SHARE IS
-      VARIABLE : HOLDER_TYPE;
- BEGIN
-      LOOP
-           SELECT
-                ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
-                     SHARED_C94008D.SET (VARIABLE, VALUE);
-                END SET;
-           OR
-                ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
-                     SHARED_C94008D.UPDATE (VARIABLE, VALUE);
-                END UPDATE;
-           OR
-                ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
-                     VALUE := VARIABLE;
-                END READ;
-           OR
-                TERMINATE;
-           END SELECT;
-      END LOOP;
- END SHARE;
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- WITH SHARED_C94008D, COUNTER_C94008D, EVENTS_C94008D;
- USE  COUNTER_C94008D, EVENTS_C94008D;
- PROCEDURE C94008D IS
- 
-      PACKAGE TRACE IS
-           NEW SHARED_C94008D (EVENT_TYPE, CHARACTER, ("....", 0));
-      PACKAGE TERMINATE_COUNT IS
-           NEW SHARED_C94008D (INTEGER, INTEGER, 0);
- 
-      PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
- 
-      FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
-      BEGIN
-           TERMINATE_COUNT.UPDATE (1);
-           RETURN TRUE;
-      END ENTER_TERMINATE;
- 
- BEGIN
-      TEST ("C94008D", "CHECK CORRECT OPERATION OF SELECT WITH " &
-                       "TERMINATE ALTERNATIVE FROM AN INNER BLOCK");
- 
-      DECLARE
- 
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                DECLARE
- 
-                     TASK T2 IS
-                          ENTRY E2;
-                     END T2;
- 
-                     TASK BODY T2 IS
-                     BEGIN
-                          DELAY 10.0 * Impdef.One_Second;
- 
-                          IF TERMINATE_COUNT.GET /= 1 THEN
-                               DELAY 20.0 * Impdef.One_Second;
-                          END IF;
- 
-                          IF TERMINATE_COUNT.GET /= 1 THEN
-                               FAILED ("30 SECOND DELAY NOT ENOUGH");
-                          END IF;
- 
-                          IF T1'TERMINATED OR NOT T1'CALLABLE THEN
-                               FAILED ("T1 PREMATURELY TERMINATED");
-                          END IF;
- 
-                          EVENT ('A');
- 
-                          SELECT
-                               ACCEPT E2;
-                          OR TERMINATE;
-                          END SELECT;
- 
-                          FAILED ("TERMINATE NOT SELECTED IN T2");
-                     END T2;
- 
-                BEGIN
-                     BEGIN
-                          EVENT ('B');
- 
-                          SELECT
-                               ACCEPT E1;
-                          OR WHEN ENTER_TERMINATE => TERMINATE;
-                          END SELECT;
- 
-                          FAILED ("TERMINATE NOT SELECTED IN T1");
-                     END;
-                END;
-           END T1;
- 
-      BEGIN
-           EVENT ('C');
-      EXCEPTION
-           WHEN OTHERS => FAILED ("EXCEPTION RECEIVED IN MAIN");
-      END;
- 
-      IF TRACE.GET.TRACE(3) = '.' OR TRACE.GET.TRACE(4) /= '.' THEN
-           FAILED ("ALL EVENTS NOT PROCESSED CORRECTLY");
-      END IF;
- 
-      COMMENT ("EXECUTION ORDER WAS " & TRACE.GET.TRACE);
- 
-      RESULT;
- END C94008D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,243 ****
- -- C94010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A GENERIC UNIT HAS A FORMAL LIMITED PRIVATE TYPE AND
- -- DECLARES AN OBJECT OF THAT TYPE (OR HAS A SUBCOMPONENT OF THAT TYPE),
- -- AND IF THE UNIT IS INSTANTIATED WITH A TASK TYPE OR AN OBJECT HAVING
- -- A SUBCOMPONENT OF A TASK TYPE, THEN THE USUAL RULES APPLY TO THE
- -- INSTANTIATED UNIT, NAMELY:
- --     A) IF THE GENERIC UNIT IS A SUBPROGRAM, CONTROL CANNOT LEAVE THE
- --        SUBPROGRAM UNTIL THE TASK CREATED BY THE OBJECT DECLARATION IS
- --        TERMINATED.
- 
- -- THIS TEST CONTAINS RACE CONDITIONS AND SHARED VARIABLES.
- 
- -- TBN  9/22/86
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C94010A IS
- 
-      GLOBAL_INT : INTEGER := 0;
-      MY_EXCEPTION : EXCEPTION;
- 
-      PACKAGE P IS
-           TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
-      PRIVATE
-           TASK TYPE LIM_PRI_TASK IS
-           END LIM_PRI_TASK;
-      END P;
- 
-      USE P;
- 
-      TASK TYPE TT IS
-      END TT;
- 
-      TYPE REC IS
-           RECORD
-                A : INTEGER := 1;
-                B : TT;
-           END RECORD;
- 
-      TYPE LIM_REC IS
-           RECORD
-                A : INTEGER := 1;
-                B : LIM_PRI_TASK;
-           END RECORD;
- 
-      PACKAGE BODY P IS
-           TASK BODY LIM_PRI_TASK IS
-           BEGIN
-                DELAY 30.0 * Impdef.One_Second;
-                GLOBAL_INT := IDENT_INT (2);
-           END LIM_PRI_TASK;
-      END P;
- 
-      TASK BODY TT IS
-      BEGIN
-           DELAY 30.0 * Impdef.One_Second;
-           GLOBAL_INT := IDENT_INT (1);
-      END TT;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PROCEDURE PROC (A : INTEGER);
- 
-      PROCEDURE PROC (A : INTEGER) IS
-           OBJ_T : T;
-      BEGIN
-           IF A = IDENT_INT (1) THEN
-                RAISE MY_EXCEPTION;
-           END IF;
-      END PROC;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      FUNCTION FUNC (A : INTEGER) RETURN INTEGER;
- 
-      FUNCTION FUNC (A : INTEGER) RETURN INTEGER IS
-           OBJ_T : T;
-      BEGIN
-           IF A = IDENT_INT (1) THEN
-                RAISE MY_EXCEPTION;
-           END IF;
-           RETURN 1;
-      END FUNC;
- 
- 
- BEGIN
-      TEST ("C94010A", "CHECK TERMINATION RULES FOR INSTANTIATIONS OF " &
-                       "GENERIC SUBPROGRAM UNITS WHICH CREATE TASKS");
- 
-      -------------------------------------------------------------------
-      DECLARE
-           PROCEDURE PROC1 IS NEW PROC (TT);
-      BEGIN
-           PROC1 (0);
-           IF GLOBAL_INT = IDENT_INT (0) THEN
-                FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
-                DELAY 35.0;
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           PROCEDURE PROC2 IS NEW PROC (REC);
-      BEGIN
-           PROC2 (1);
-           FAILED ("EXCEPTION WAS NOT RAISED - 2");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL_INT = IDENT_INT (0) THEN
-                     FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
-                     DELAY 35.0 * Impdef.One_Second;
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           PROCEDURE PROC3 IS NEW PROC (LIM_PRI_TASK);
-      BEGIN
-           PROC3 (1);
-           FAILED ("EXCEPTION WAS NOT RAISED - 3");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL_INT = IDENT_INT (0) THEN
-                     FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
-                     DELAY 35.0 * Impdef.One_Second;
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           PROCEDURE PROC4 IS NEW PROC (LIM_REC);
-      BEGIN
-           PROC4 (0);
-           IF GLOBAL_INT = IDENT_INT (0) THEN
-                FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
-                DELAY 35.0 * Impdef.One_Second;
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           A : INTEGER;
-           FUNCTION FUNC1 IS NEW FUNC (TT);
-      BEGIN
-           A := FUNC1 (1);
-           FAILED ("EXCEPTION NOT RAISED - 5");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL_INT = IDENT_INT (0) THEN
-                     FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
-                     DELAY 35.0 * Impdef.One_Second;
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           A : INTEGER;
-           FUNCTION FUNC2 IS NEW FUNC (REC);
-      BEGIN
-           A := FUNC2 (0);
-           IF GLOBAL_INT = IDENT_INT (0) THEN
-                FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
-                DELAY 35.0 * Impdef.One_Second;
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           A : INTEGER;
-           FUNCTION FUNC3 IS NEW FUNC (LIM_PRI_TASK);
-      BEGIN
-           A := FUNC3 (0);
-           IF GLOBAL_INT = IDENT_INT (0) THEN
-                FAILED ("TASK NOT DEPENDENT ON MASTER - 7");
-                DELAY 35.0 * Impdef.One_Second;
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           A : INTEGER;
-           FUNCTION FUNC4 IS NEW FUNC (LIM_REC);
-      BEGIN
-           A := FUNC4 (1);
-           FAILED ("EXCEPTION NOT RAISED - 8");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL_INT = IDENT_INT (0) THEN
-                     FAILED ("TASK NOT DEPENDENT ON MASTER - 8");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
-      END;
- 
-      -------------------------------------------------------------------
-           
-      RESULT;
- END C94010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,268 ****
- -- C94011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A FORMAL ACCESS TYPE OF A GENERIC UNIT DESIGNATES A
- -- FORMAL LIMITED PRIVATE TYPE, THEN WHEN THE UNIT IS INSTANTIATED WITH
- -- A TASK TYPE OR A TYPE HAVING A SUBCOMPONENT OF A TASK TYPE, THE
- -- MASTER FOR ANY TASKS ALLOCATED WITHIN THE INSTANTIATED UNIT IS
- -- DETERMINED BY THE ACTUAL PARAMETER.
- 
- -- TBN  9/22/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C94011A IS
- 
-      GLOBAL_INT : INTEGER := 0;
-      MY_EXCEPTION : EXCEPTION;
- 
-      PACKAGE P IS
-           TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
-           PROCEDURE E (T : LIM_PRI_TASK);
-      PRIVATE
-           TASK TYPE LIM_PRI_TASK IS
-                ENTRY E;
-           END LIM_PRI_TASK;
-      END P;
- 
-      USE P;
- 
-      TASK TYPE TT IS
-           ENTRY E;
-      END TT;
- 
-      TYPE REC IS
-           RECORD
-                A : INTEGER := 1;
-                B : TT;
-           END RECORD;
- 
-      TYPE LIM_REC IS
-           RECORD
-                A : INTEGER := 1;
-                B : LIM_PRI_TASK;
-           END RECORD;
- 
-      PACKAGE BODY P IS
-           TASK BODY LIM_PRI_TASK IS
-           BEGIN
-                ACCEPT E;
-                GLOBAL_INT := IDENT_INT (2);
-           END LIM_PRI_TASK;
- 
-           PROCEDURE E (T : LIM_PRI_TASK) IS
-           BEGIN
-                T.E;
-           END E;
-      END P;
- 
-      TASK BODY TT IS
-      BEGIN
-           ACCEPT E;
-           GLOBAL_INT := IDENT_INT (1);
-      END TT;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-           TYPE ACC_T IS ACCESS T;
-      PROCEDURE PROC (A : OUT ACC_T);
- 
-      PROCEDURE PROC (A : OUT ACC_T) IS
-      BEGIN
-           A := NEW T;
-      END PROC;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-           TYPE ACC_T IS ACCESS T;
-      FUNCTION FUNC RETURN ACC_T;
- 
-      FUNCTION FUNC RETURN ACC_T IS
-      BEGIN
-           RETURN NEW T;
-      END FUNC;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-           TYPE ACC_T IS ACCESS T;
-      PACKAGE PAC IS
-           PTR_T : ACC_T := NEW T;
-      END PAC;
- 
- BEGIN
-      TEST ("C94011A", "CHECK THAT IF A FORMAL ACCESS TYPE OF A " &
-                       "GENERIC UNIT DESIGNATES A FORMAL LIMITED " &
-                       "PRIVATE TYPE, THEN WHEN THE UNIT IS " &
-                       "INSTANTIATED, THE MASTER FOR ANY TASKS " &
-                       "ALLOCATED WITHIN THE INSTANTIATED UNIT IS " &
-                       "DETERMINED BY THE ACTUAL PARAMETER");
- 
-      -------------------------------------------------------------------
-      DECLARE
-           TYPE ACC_TT IS ACCESS TT;
-           ACC1 : ACC_TT;
-           PROCEDURE PROC1 IS NEW PROC (TT, ACC_TT);
-      BEGIN
-           PROC1 (ACC1);
-           ACC1.E;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TASK DEPENDENT ON WRONG MASTER - 1");
-      END;
-      IF GLOBAL_INT = IDENT_INT (0) THEN
-           FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
-      END IF;
-      
-      -------------------------------------------------------------------
-      BEGIN
-           GLOBAL_INT := IDENT_INT (0);
-           DECLARE
-                TYPE ACC_REC IS ACCESS REC;
-                A : ACC_REC;
-                FUNCTION FUNC1 IS NEW FUNC (REC, ACC_REC);
-           BEGIN
-                A := FUNC1;
-                A.B.E;
-                RAISE MY_EXCEPTION;
-           EXCEPTION
-                WHEN MY_EXCEPTION =>
-                     RAISE MY_EXCEPTION;
-                WHEN OTHERS =>
-                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 2");
-           END;
-           FAILED ("MY_EXCEPTION NOT RAISED - 2");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL_INT = IDENT_INT (0) THEN
-                     FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
-      
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      BEGIN
-           DECLARE
-                TYPE ACC_LIM_TT IS ACCESS LIM_PRI_TASK;
-           BEGIN
-                DECLARE
-                     A : ACC_LIM_TT;
-                     FUNCTION FUNC2 IS NEW FUNC (LIM_PRI_TASK,
-                                                             ACC_LIM_TT);
-                BEGIN
-                     A := FUNC2;
-                     E (A.ALL);
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 3");
-           END;
-           IF GLOBAL_INT = IDENT_INT (0) THEN
-                FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      BEGIN
-           DECLARE
-                TYPE ACC_LIM_REC IS ACCESS LIM_REC;
-           BEGIN
-                DECLARE
-                     ACC2 : ACC_LIM_REC;
-                     PROCEDURE PROC2 IS NEW PROC (LIM_REC, ACC_LIM_REC);
-                BEGIN
-                     PROC2 (ACC2);
-                     E (ACC2.B);
-                END;
-                RAISE MY_EXCEPTION;
-           EXCEPTION
-                WHEN MY_EXCEPTION =>
-                     RAISE MY_EXCEPTION;
-                WHEN OTHERS =>
-                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 4");
-           END;
-           FAILED ("MY_EXCEPTION NOT RAISED - 4");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL_INT = IDENT_INT (0) THEN
-                     FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
-      END;
- 
-      -------------------------------------------------------------------
-      BEGIN
-            GLOBAL_INT := IDENT_INT (0);
- 
-           DECLARE
-                TYPE ACC_TT IS ACCESS TT;
-                PACKAGE PAC1 IS NEW PAC (TT, ACC_TT);
-                USE PAC1; 
-           BEGIN
-                PTR_T.E;
-                RAISE MY_EXCEPTION;
-           EXCEPTION
-                WHEN MY_EXCEPTION =>
-                     RAISE MY_EXCEPTION;
-                WHEN OTHERS =>
-                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 5");
-           END;
-           FAILED ("MY_EXCEPTION NOT RAISED - 5");
-      EXCEPTION
-           WHEN MY_EXCEPTION =>
-                IF GLOBAL_INT = IDENT_INT (0) THEN
-                     FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-      END;
-      
-      -------------------------------------------------------------------
-      GLOBAL_INT := IDENT_INT (0);
- 
-      DECLARE
-           TYPE ACC_LIM_REC IS ACCESS LIM_REC;
-      BEGIN
-           DECLARE
-                PACKAGE PAC2 IS NEW PAC (LIM_REC, ACC_LIM_REC);
-                USE PAC2;
-           BEGIN
-                E (PTR_T.B);
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TASK DEPENDENT ON WRONG MASTER - 6");
-      END;
-      IF GLOBAL_INT = IDENT_INT (0) THEN
-           FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
-      END IF;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- END C94011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94020a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94020a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c94020a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c94020a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C94020A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE CONDITIONS FOR TERMINATION ARE RECOGNIZED WHEN THE
- -- LAST MISSING TASK TERMINATES DUE TO AN ABORT
- 
- -- JEAN-PIERRE ROSEN 08-MAR-1984
- -- JBG 6/1/84
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C94020A IS
- 
-      TASK TYPE T2 IS
-      END T2;
-      
-      TASK TYPE T3 IS
-           ENTRY E;
-      END T3;
-      
-      TASK BODY T2 IS
-      BEGIN
-           COMMENT("T2");
-      END;
-      
-      TASK BODY T3 IS
-      BEGIN
-           COMMENT("T3");
-           SELECT
-                ACCEPT E;
-           OR TERMINATE;
-           END SELECT;
-           FAILED("T3 EXITED SELECT OR TERMINATE");
-      END;
- 
- BEGIN
- 
-      TEST ("C94020A", "TEST OF TASK DEPENDENCES, TERMINATE, ABORT");
- 
-      DECLARE
-           TASK TYPE T1 IS
-           END T1;
-           
-           V1 : T1;
-           TYPE A_T1 IS ACCESS T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ABORT T1;
-                DELAY 0.0;          --SYNCHRONIZATION POINT
-                FAILED("T1 NOT ABORTED");
-           END;
-           
-      BEGIN
-           DECLARE
-                V2 : T2;
-                A1 : A_T1;
-           BEGIN
-                DECLARE
-                     V3 : T3;
-                     TASK T4 IS
-                     END T4;
-                     TASK BODY T4 IS
-                          TASK T41 IS
-                          END T41;
-                          TASK BODY T41 IS
-                          BEGIN
-                               COMMENT("T41");
-                               ABORT T4;
-                               DELAY 0.0;       --SYNCHRONIZATION POINT
-                               FAILED("T41 NOT ABORTED");
-                          END;
-                     BEGIN  --T4
-                          COMMENT("T4");
-                     END;
-                BEGIN
-                     COMMENT("BLOC 3");
-                END;
-                COMMENT("BLOC 2");
-                A1 := NEW T1;
-           END;
-           COMMENT("BLOC 1");
-      EXCEPTION
-           WHEN OTHERS => FAILED("SOME EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C94020A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940a03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c940a03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c940a03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,350 ****
- -- C940A03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a protected object provides coordinated access to
- --      shared data.  Check that it can implement a semaphore-like construct
- --      controlling access to shared data through procedure parameters to
- --      allow a specific maximum number of tasks to run and exclude all
- --      others.
- --
- -- TEST DESCRIPTION:
- --      Declare a resource descriptor tagged type.  Extend the type and
- --      use the extended type in a protected data structure.
- --      Implement a counting semaphore type that can be initialized to a 
- --      specific number of available resources.  Declare an entry for 
- --      requesting a specific resource and an procedure for releasing the 
- --      same resource it.  Declare an object of this (protected) type, 
- --      initialized to two resources.  Declare and start three tasks each 
- --      of which asks for a resource.  Verify that only two resources are 
- --      granted and that the last task in is queued.
- --
- --      This test models a multi-user operating system that allows a limited
- --      number of logins.  Users requesting login are modeled by tasks.
- --
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         F940A00
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      13 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1
- --
- --!
- 
- package C940A03_0 is
-       --Resource_Pkg
- 
-   -- General type declarations that will be extended to model available
-   -- logins
- 
-   type Resource_ID_Type is range 0..10;
-   type Resource_Type is tagged record 
-     Id : Resource_ID_Type := 0;
-   end record;
- 
- end C940A03_0;
-   --Resource_Pkg
- 
- --======================================--
- -- no body for C940A3_0
- --======================================--
- 
- with F940A00;     -- Interlock_Foundation
- with C940A03_0;   -- Resource_Pkg;
- 
- package C940A03_1 is
-      -- Semaphores
- 
-   -- Models a counting semaphore that will allow up to a specific 
-   -- number of logins
-   -- Users (tasks) request a login slot by calling the Request_Login
-   -- entry and logout by calling the Release_Login procedure
- 
-   Max_Logins : constant Integer := 2;
-   
- 
-   type Key_Type is range 0..100;
-                                       -- When a user requests a login, an
-                                       -- identifying key will be returned
-   Init_Key : constant Key_Type := 0;
- 
-   type Login_Record_Type is new C940A03_0.Resource_Type with record
-     Key  : Key_Type := Init_Key;
-   end record;
- 
- 
-   protected type Login_Semaphore_Type (Resources_Available : Integer :=1) is
- 
-     entry     Request_Login   (Resource_Key : in out Login_Record_Type);
-     procedure Release_Login;
-     function  Available return Integer;  -- how many logins are available?
-   private
-     Logins_Avail : Integer  := Resources_Available;
-     Next_Key     : Key_Type := Init_Key;
- 
-   end Login_Semaphore_Type;
- 
-   Login_Semaphore      : Login_Semaphore_Type (Max_Logins);
- 
-   --====== machinery for the test, not the model =====--
-   TC_Control_Message : F940A00.Interlock_Type;    
-   function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer;
- 
- 
- end C940A03_1;
-  -- Semaphores;
- 
- --=========================================================--
- 
- package body C940A03_1 is
-           -- Semaphores is
- 
-   protected body Login_Semaphore_Type is
- 
-     entry Request_Login (Resource_Key : in out Login_Record_Type)
-                                              when Logins_Avail > 0 is
-     begin
-       Next_Key := Next_Key + 1;        -- login process returns a key
-       Resource_Key.Key := Next_Key;     -- to the requesting user
-       Logins_Avail := Logins_Avail - 1;
-     end Request_Login;
- 
-     procedure Release_Login is
-     begin
-       Logins_Avail := Logins_Avail + 1;
-     end Release_Login;
- 
-     function Available return Integer is
-       begin
-         return Logins_Avail;
-       end Available;
- 
-   end Login_Semaphore_Type;
- 
-   function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer is
-     begin
-       return Integer (Login_Rec.Key);
-     end TC_Key_Val;
- 
- end C940A03_1;
-  -- Semaphores;
- 
- --=========================================================--
- 
- with C940A03_0;    -- Resource_Pkg,
- with C940A03_1;    -- Semaphores;
- 
- package C940A03_2 is
-      -- Task_Pkg
- 
-   package Semaphores renames C940A03_1;
- 
-   task type User_Task_Type is
- 
-      entry Login  (user_id : C940A03_0.Resource_Id_Type);
-                       -- instructs the task to ask for a login
-      entry Logout;    -- instructs the task to release the login
-      --=======================--
-      -- this entry is used to get information to verify test operation
-      entry Get_Status (User_Record : out Semaphores.Login_Record_Type);
- 
-   end User_Task_Type;
- 
- end C940A03_2;
-  -- Task_Pkg
- 
- --=========================================================--
- 
- with Report;
- with C940A03_0;   -- Resource_Pkg,
- with C940A03_1;   -- Semaphores,
- with F940A00;     -- Interlock_Foundation;
-     
- package body C940A03_2 is
-           -- Task_Pkg 
- 
-   -- This task models a user requesting a login from the system
-   -- For control of this test, we can ask the task to login, logout, or
-   -- give us the current user record (containing login information)
- 
-   task body User_Task_Type is
-     Rec  : Semaphores.Login_Record_Type;
-   begin
-     loop
-       select
-         accept Login (user_id : C940A03_0.Resource_Id_Type) do
-           Rec.Id := user_id;
-         end Login;
- 
-         Semaphores.Login_Semaphore.Request_Login (Rec);
-                       -- request a resource; if resource is not available, 
-                       -- task will be queued to wait
- 
-         --== following is test control machinery ==--
-         F940A00.Counter.Increment;
-         Semaphores.TC_Control_Message.Post;   
-                -- after resource is obtained, post message
- 
-       or
-         accept Logout do  
-           Semaphores.Login_Semaphore.Release_Login;
-                       -- release the resource
-           --== test control machinery ==--
-           F940A00.Counter.Decrement;
-         end Logout;
-         exit;
- 
-       or
-         accept Get_Status (User_Record : out Semaphores.Login_Record_Type) do
-           User_Record := Rec;
-         end Get_Status;
- 
-       end select;  
-     end loop;
- 
-   exception
-     when others => Report.Failed ("Exception raised in model user task");
-   end User_Task_Type;
- 
- end C940A03_2;
-  -- Task_Pkg
- 
- --=========================================================--
- 
- with Report;
- with ImpDef;
- with C940A03_1;   -- Semaphores, 
- with C940A03_2;   -- Task_Pkg,
- with F940A00;     -- Interlock_Foundation;
- 
- procedure C940A03 is
- 
-   package Semaphores renames C940A03_1;
-   package Users      renames C940A03_2;  
- 
-   Task1, Task2, Task3 : Users.User_Task_Type;
-   User_Rec            : Semaphores.Login_Record_Type;
- 
- begin      -- Tasks start here
- 
-   Report.Test ("C940A03", "Check that a protected object can coordinate " &
-                           "shared data access using procedure parameters");
- 
-   if F940A00.Counter.Number /=0 then
-     Report.Failed ("Wrong initial conditions");
-   end if;
-                                  
-   Task1.Login (1);               -- request resource; request should be granted
-   Semaphores.TC_Control_Message.Consume;  
-                                  -- ensure that task obtains resource by
-                                  -- waiting for task to post message
- 
-                                  -- Task 1 waiting for call to Logout
-                                  -- Others still available
-   Task1.Get_Status (User_Rec);
-   if (F940A00.Counter.Number /= 1)
-   or (Semaphores.Login_Semaphore.Available /=1)
-   or (Semaphores.TC_Key_Val (User_Rec) /= 1) then
-     Report.Failed ("Resource not assigned to task 1");
-   end if;
-  
-   Task2.Login (2);               -- Request for resource should be granted  
-   Semaphores.TC_Control_Message.Consume;  
-                                  -- ensure that task obtains resource by
-                                  -- waiting for task to post message
-  
-   Task2.Get_Status (User_Rec);
-   if (F940A00.Counter.Number /= 2)
-   or (Semaphores.Login_Semaphore.Available /=0)
-   or (Semaphores.TC_Key_Val (User_Rec) /= 2) then
-     Report.Failed ("Resource not assigned to task 2");
-   end if;
-  
- 
-   Task3.Login (3);               -- request for resource should be denied
-                                  -- and task queued
- 
- 
-                                  -- Tasks 1 and 2 holds resources
-                                  -- and are waiting for a call to Logout
-                                  -- Task 3 is queued
- 
-   if (F940A00.Counter.Number /= 2)
-   or (Semaphores.Login_Semaphore.Available /=0) then
-     Report.Failed ("Resource incorrectly assigned to task 3");
-   end if;
- 
-   Task1.Logout;                  -- released resource should be given to
-                                  -- queued task
-   Semaphores.TC_Control_Message.Consume;  
-                                  -- wait for confirming message from task
- 
-                                  -- Task 1 holds no resources
-                                  --   and is terminated (or will soon)
-                                  -- Tasks 2 and 3 hold resources
-                                  --   and are waiting for a call to Logout
- 
-   Task3.Get_Status (User_Rec);
-   if (F940A00.Counter.Number /= 2)
-                       or (Semaphores.Login_Semaphore.Available /=0)
-                       or (Semaphores.TC_Key_Val (User_Rec) /= 3) then
-     Report.Failed ("Resource not properly released/assigned to task 3");
-   end if;
- 
-   Task2.Logout;                  -- no outstanding request for released
-                                  -- resource
-                                  -- Tasks 1 and 2 hold no resources
-                                  -- Task 3 holds a resource
-                                  --   and is waiting for a call to Logout
- 
-   if (F940A00.Counter.Number /= 1)
-                         or (Semaphores.Login_Semaphore.Available /=1) then
-     Report.Failed ("Resource not properly released from task 2");
-   end if;
- 
-   Task3.Logout;
- 
-                                  -- all resources have been returned
-                                  -- all tasks have terminated or will soon
- 
-   if (F940A00.Counter.Number /=0)
-                           or (Semaphores.Login_Semaphore.Available /=2) then
-     Report.Failed ("Resource not properly released from task 3");
-   end if;
- 
-   -- Ensure all tasks have terminated before calling Result
-   while not (Task1'terminated and     
-              Task2'terminated and
-              Task3'terminated)     loop
-     delay ImpDef.Minimum_Task_Switch;   
-   end loop;
- 
-   Report.Result;
- 
- end C940A03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,426 ****
- -- C95008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE EXCEPTION CONSTRAINT_ERROR IS RAISED FOR AN
- --   OUT-OF-RANGE INDEX VALUE WHEN REFERENCING AN ENTRY FAMILY,
- --   EITHER IN AN ACCEPT_STATEMENT OR IN AN ENTRY_CALL.
- 
- -- SUBTESTS ARE:
- --   (A)  INTEGER TYPE, STATIC LOWER BOUND, NO PARAMETERS.
- --   (B)  CHARACTER TYPE, DYNAMIC UPPER BOUND, NO PARAMETERS.
- --   (C)  BOOLEAN TYPE, STATIC NULL RANGE, NO PARAMETERS.
- --   (D)  USER-DEFINED ENUMERATED TYPE, DYNAMIC LOWER BOUND, ONE
- --           PARAMETER.
- --   (E)  DERIVED INTEGER TYPE, DYNAMIC NULL RANGE, ONE PARAMETER.
- --   (F)  DERIVED USER-DEFINED ENUMERATED TYPE, STATIC UPPER BOUND,
- --           ONE PARAMETER.
- 
- -- JRK 11/4/81
- -- JBG 11/11/84
- -- SAIC 11/14/95 fixed test for 2.0.1
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C95008A IS
- 
-      C_E_NOT_RAISED : BOOLEAN;
-      WRONG_EXC_RAISED : BOOLEAN;
- 
- BEGIN
-      TEST ("C95008A", "OUT-OF-RANGE ENTRY FAMILY INDICES IN " &
-                       "ACCEPT_STATEMENTS AND ENTRY_CALLS");
- 
-      --------------------------------------------------
- 
-      C_E_NOT_RAISED := FALSE;
-      WRONG_EXC_RAISED := FALSE;
- 
-      DECLARE -- (A)
- 
-           TASK T IS
-                ENTRY E (1..10);
-                ENTRY CONTINUE;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT CONTINUE;
-                SELECT
-                     ACCEPT E (0);
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                END SELECT;
-                C_E_NOT_RAISED := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     WRONG_EXC_RAISED := TRUE;
-           END T;
- 
-      BEGIN -- (A)
- 
-           SELECT
-                T.E (0);
-           OR
-                DELAY 15.0 * Impdef.One_Second;
-           END SELECT;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ENTRY_CALL - (A)");
-           T.CONTINUE;
- 
-      EXCEPTION -- (A)
- 
-           WHEN CONSTRAINT_ERROR =>
-                T.CONTINUE;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN " &
-                        "ENTRY_CALL - (A)");
-                T.CONTINUE;
- 
-      END; -- (A)
- 
-      IF C_E_NOT_RAISED THEN
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ACCEPT_STATEMENT - (A)");
-      END IF;
- 
-      IF WRONG_EXC_RAISED THEN
-           FAILED ("WRONG EXCEPTION RAISED IN " &
-                   "ACCEPT_STATEMENT - (A)");
-      END IF;
- 
-      --------------------------------------------------
- 
-      C_E_NOT_RAISED := FALSE;
-      WRONG_EXC_RAISED := FALSE;
- 
-      DECLARE -- (B)
- 
-           TASK T IS
-                ENTRY E (CHARACTER RANGE 'A'..'Y');
-                ENTRY CONTINUE;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT CONTINUE;
-                SELECT
-                     ACCEPT E (IDENT_CHAR('Z'));
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                END SELECT;
-                C_E_NOT_RAISED := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     WRONG_EXC_RAISED := TRUE;
-           END T;
- 
-      BEGIN -- (B)
- 
-           SELECT
-                T.E (IDENT_CHAR('Z'));
-           OR
-                DELAY 15.0 * Impdef.One_Second;
-           END SELECT;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ENTRY_CALL - (B)");
-           T.CONTINUE;
- 
-      EXCEPTION -- (B)
- 
-           WHEN CONSTRAINT_ERROR =>
-                T.CONTINUE;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN " &
-                        "ENTRY_CALL - (B)");
-                T.CONTINUE;
- 
-      END; -- (B)
- 
-      IF C_E_NOT_RAISED THEN
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ACCEPT_STATEMENT - (B)");
-      END IF;
- 
-      IF WRONG_EXC_RAISED THEN
-           FAILED ("WRONG EXCEPTION RAISED IN " &
-                   "ACCEPT_STATEMENT - (B)");
-      END IF;
- 
-      --------------------------------------------------
- 
-      C_E_NOT_RAISED := FALSE;
-      WRONG_EXC_RAISED := FALSE;
- 
-      DECLARE -- (C)
- 
-           TASK T IS
-                ENTRY E (TRUE..FALSE);
-                ENTRY CONTINUE;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT CONTINUE;
-                SELECT
-                     ACCEPT E (FALSE);
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                END SELECT;
-                C_E_NOT_RAISED := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     WRONG_EXC_RAISED := TRUE;
-           END T;
- 
-      BEGIN -- (C)
- 
-           SELECT
-                T.E (TRUE);
-           OR
-                DELAY 15.0 * Impdef.One_Second;
-           END SELECT;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ENTRY_CALL - (C)");
-           T.CONTINUE;
- 
-      EXCEPTION -- (C)
- 
-           WHEN CONSTRAINT_ERROR =>
-                T.CONTINUE;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN " &
-                        "ENTRY_CALL - (C)");
-                T.CONTINUE;
- 
-      END; -- (C)
- 
-      IF C_E_NOT_RAISED THEN
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ACCEPT_STATEMENT - (C)");
-      END IF;
- 
-      IF WRONG_EXC_RAISED THEN
-           FAILED ("WRONG EXCEPTION RAISED IN " &
-                   "ACCEPT_STATEMENT - (C)");
-      END IF;
- 
-      --------------------------------------------------
- 
-      C_E_NOT_RAISED := FALSE;
-      WRONG_EXC_RAISED := FALSE;
- 
-      DECLARE -- (D)
- 
-           TYPE ET IS (E0, E1, E2);
-           DLB : ET := ET'VAL (IDENT_INT(1));      -- E1.
- 
-           TASK T IS
-                ENTRY E (ET RANGE DLB..E2) (I : INTEGER);
-                ENTRY CONTINUE;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT CONTINUE;
-                SELECT
-                     ACCEPT E (E0) (I : INTEGER);
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                END SELECT;
-                C_E_NOT_RAISED := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     WRONG_EXC_RAISED := TRUE;
-           END T;
- 
-      BEGIN -- (D)
- 
-           SELECT
-                T.E (E0) (0);
-           OR
-                DELAY 15.0 * Impdef.One_Second;
-           END SELECT;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ENTRY_CALL - (D)");
-           T.CONTINUE;
- 
-      EXCEPTION -- (D)
- 
-           WHEN CONSTRAINT_ERROR =>
-                T.CONTINUE;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN " &
-                        "ENTRY_CALL - (D)");
-                T.CONTINUE;
- 
-      END; -- (D)
- 
-      IF C_E_NOT_RAISED THEN
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ACCEPT_STATEMENT - (D)");
-      END IF;
- 
-      IF WRONG_EXC_RAISED THEN
-           FAILED ("WRONG EXCEPTION RAISED IN " &
-                   "ACCEPT_STATEMENT - (D)");
-      END IF;
- 
-      --------------------------------------------------
- 
-      C_E_NOT_RAISED := FALSE;
-      WRONG_EXC_RAISED := FALSE;
- 
-      DECLARE -- (E)
- 
-           TYPE D_I IS NEW INTEGER;
-           SUBTYPE DI IS D_I RANGE 3 .. D_I(IDENT_INT(2));
- 
-           TASK T IS
-                ENTRY E (DI) (I : INTEGER);
-                ENTRY CONTINUE;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT CONTINUE;
-                SELECT
-                     ACCEPT E (D_I(3)) (I : INTEGER);
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                END SELECT;
-                C_E_NOT_RAISED := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     WRONG_EXC_RAISED := TRUE;
-           END T;
- 
-      BEGIN -- (E)
- 
-           SELECT
-                T.E (D_I(2)) (0);
-           OR
-                DELAY 15.0 * Impdef.One_Second;
-           END SELECT;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ENTRY_CALL - (E)");
-           T.CONTINUE;
- 
-      EXCEPTION -- (E)
- 
-           WHEN CONSTRAINT_ERROR =>
-                T.CONTINUE;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN " &
-                        "ENTRY_CALL - (E)");
-                T.CONTINUE;
- 
-      END; -- (E)
- 
-      IF C_E_NOT_RAISED THEN
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ACCEPT_STATEMENT - (E)");
-      END IF;
- 
-      IF WRONG_EXC_RAISED THEN
-           FAILED ("WRONG EXCEPTION RAISED IN " &
-                   "ACCEPT_STATEMENT - (E)");
-      END IF;
- 
-      --------------------------------------------------
- 
-      C_E_NOT_RAISED := FALSE;
-      WRONG_EXC_RAISED := FALSE;
- 
-      DECLARE -- (F)
- 
-           TYPE ET IS (E0, E1, E2);
-           TYPE D_ET IS NEW ET;
- 
-           TASK T IS
-                ENTRY E (D_ET RANGE E0..E1) (I : INTEGER);
-                ENTRY CONTINUE;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT CONTINUE;
-                SELECT
-                     ACCEPT E (D_ET'(E2)) (I : INTEGER);
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                END SELECT;
-                C_E_NOT_RAISED := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     WRONG_EXC_RAISED := TRUE;
-           END T;
- 
-      BEGIN -- (F)
- 
-           SELECT
-                T.E (D_ET'(E2)) (0);
-           OR
-                DELAY 15.0 * Impdef.One_Second;
-           END SELECT;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ENTRY_CALL - (F)");
-           T.CONTINUE;
- 
-      EXCEPTION -- (F)
- 
-           WHEN CONSTRAINT_ERROR =>
-                T.CONTINUE;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN " &
-                        "ENTRY_CALL - (F)");
-                T.CONTINUE;
- 
-      END; -- (F)
- 
-      IF C_E_NOT_RAISED THEN
-           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
-                   "ACCEPT_STATEMENT - (F)");
-      END IF;
- 
-      IF WRONG_EXC_RAISED THEN
-           FAILED ("WRONG EXCEPTION RAISED IN " &
-                   "ACCEPT_STATEMENT - (F)");
-      END IF;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- C95009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK OBJECT CAN CALL ENTRIES OF OTHER TASKS.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES.
- 
- -- JRK 11/5/81
- -- JRK 8/3/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95009A IS
- 
-      V1 : INTEGER := 0;
-      V2 : INTEGER := 0;
- 
-      PI : INTEGER := 0;
-      PO : INTEGER := 0;
- 
- BEGIN
-      TEST ("C95009A", "CHECK THAT A TASK OBJECT CAN CALL ENTRIES " &
-                       "OF OTHER TASKS");
- 
-      DECLARE
- 
-           SUBTYPE INT IS INTEGER RANGE 1..5;
- 
-           TASK T1 IS
-                ENTRY E1N;
-                ENTRY EF1P (INT) (I : OUT INTEGER);
-           END T1;
- 
-           TASK TYPE T2T IS
-                ENTRY E2P (I : INTEGER);
-                ENTRY EF2N (INT);
-           END T2T;
- 
-           TYPE AT2T IS ACCESS T2T;
-           AT2 : AT2T;
- 
-           TASK BODY T1 IS
-           BEGIN
-                V1 := 1;
-                ACCEPT E1N;
-                V1 := 2;
-                AT2.E2P (1);
-                V1 := 3;
-                ACCEPT EF1P (2) (I : OUT INTEGER) DO
-                     I := 2;
-                END EF1P;
-                V1 := 4;
-                AT2.EF2N (IDENT_INT(3));
-                V1 := 5;
-           END T1;
- 
-           TASK BODY T2T IS
-           BEGIN
-                V2 := 1;
-                T1.E1N;
-                V2 := 2;
-                ACCEPT E2P (I : INTEGER) DO
-                     PI := I;
-                END E2P;
-                V2 := 3;
-                T1.EF1P (2) (PO);
-                V2 := 4;
-                ACCEPT EF2N (1+IDENT_INT(2));
-                V2 := 5;
-           END T2T;
- 
-           PACKAGE DUMMY IS
-           END DUMMY;
- 
-           PACKAGE BODY DUMMY IS
-           BEGIN
-                AT2 := NEW T2T;
-           END DUMMY;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      IF V1 /= 5 THEN
-           FAILED ("TASK T1 ONLY REACHED V1 = " & INTEGER'IMAGE(V1));
-      END IF;
- 
-      IF V2 /= 5 THEN
-           FAILED ("TASK AT2 ONLY REACHED V2 = " & INTEGER'IMAGE(V2));
-      END IF;
- 
-      IF PI /= 1 THEN
-           FAILED ("ENTRY IN PARAMETER NOT PASSED CORRECTLY");
-      END IF;
- 
-      IF PO /= 2 THEN
-           FAILED ("ENTRY OUT PARAMETER NOT PASSED CORRECTLY");
-      END IF;
- 
-      RESULT;
- END C95009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C95010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK MAY CONTAIN MORE THAN ONE ACCEPT_STATEMENT
- --   FOR AN ENTRY.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES.
- 
- -- JRK 11/5/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95010A IS
- 
-      V : INTEGER := 0;
- 
- BEGIN
-      TEST ("C95010A", "CHECK THAT A TASK MAY CONTAIN MORE THAN " &
-                       "ONE ACCEPT_STATEMENT FOR AN ENTRY");
- 
-      DECLARE
- 
-           SUBTYPE INT IS INTEGER RANGE 1..5;
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY EF (INT) (I : INTEGER);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                V := 1;
-                ACCEPT E;
-                V := 2;
-                ACCEPT E;
-                V := 3;
-                ACCEPT EF (2) (I : INTEGER) DO
-                     V := I;
-                END EF;
-                V := 5;
-                ACCEPT EF (2) (I : INTEGER) DO
-                     V := I;
-                END EF;
-                V := 7;
-           END T;
- 
-      BEGIN
- 
-           T.E;
-           T.E;
-           T.EF (2) (4);
-           T.EF (2) (6);
- 
-      END;
- 
-      IF V /= 7 THEN
-           FAILED ("WRONG CONTROL FLOW VALUE");
-      END IF;
- 
-      RESULT;
- END C95010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- C95011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK NEED NOT CONTAIN ANY ACCEPT_STATEMENTS FOR AN
- --   ENTRY.
- 
- -- THIS TEST CONTAINS SHARED VARIABLES.
- 
- -- JRK 11/5/81
- -- JWC 6/28/85   RENAMED TO -AB
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95011A IS
- 
-      V : INTEGER := 0;
- 
- BEGIN
-      TEST ("C95011A", "CHECK THAT A TASK NEED NOT CONTAIN ANY " &
-                       "ACCEPT_STATEMENTS FOR AN ENTRY");
- 
-      DECLARE
- 
-           SUBTYPE INT IS INTEGER RANGE 1..5;
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY EF (INT) (I : INTEGER);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                V := 1;
-           END T;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      IF V /= 1 THEN
-           FAILED ("WRONG CONTROL FLOW VALUE");
-      END IF;
- 
-      RESULT;
- END C95011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95012a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95012a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95012a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- C95012A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CALL TO AN ENTRY OF A TASK THAT HAS NOT BEEN ACTIVATED
- --   DOES NOT RAISE EXCEPTIONS.
- 
- -- THIS TEST CONTAINS RACE CONDITIONS.
- 
- -- JRK 11/6/81
- -- SPS 11/21/82
- -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C95012A IS
- 
-      I : INTEGER := 0;
- 
- 
- BEGIN
-      TEST ("C95012A", "CHECK THAT A CALL TO AN ENTRY OF A TASK " &
-                       "THAT HAS NOT BEEN ACTIVATED DOES NOT " &
-                       "RAISE EXCEPTIONS");
- 
-      DECLARE
- 
-           TASK T1 IS
-                ENTRY E1 (I : OUT INTEGER);
-           END T1;
- 
-           TASK TYPE T2T IS
-                ENTRY E2 (I : OUT INTEGER);
-           END T2T;
- 
-           TYPE AT2T IS ACCESS T2T;
-           AT2 : AT2T;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E1 (I : OUT INTEGER) DO
-                     I := IDENT_INT (1);
-                END E1;
-           END T1;
- 
-           TASK BODY T2T IS
-                J : INTEGER := 0;
-           BEGIN
-                BEGIN
-                     T1.E1 (J);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          J := -1;
-                END;
-                ACCEPT E2 (I : OUT INTEGER) DO
-                     I := J;
-                END E2;
-           END T2T;
- 
-           PACKAGE PKG IS
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                AT2 := NEW T2T;
-                DELAY 60.0 * Impdef.One_Second;
-           END PKG;
- 
-      BEGIN
- 
-           AT2.ALL.E2 (I);
- 
-           IF I = -1 THEN 
-                FAILED ("EXCEPTION RAISED");
-                T1.E1 (I);
-           END IF;
- 
-           IF I /= 1 THEN
-                FAILED ("WRONG VALUE PASSED");
-           END IF;
- 
-      END;
- 
-      RESULT;
- END C95012A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95021a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95021a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95021a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95021a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- C95021A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE.
- 
- -- JBG 2/22/84
- -- DAS 10/8/90  ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO
- --              DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE
- --              IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM
- --              FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR
- --              AN ENTRY E).
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- -- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE.
- --
- -- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS
- -- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY.  THE TEST
- -- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD.  (IT IS
- -- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO
- -- THIS MORE COMPLICATED APPROACH IS NECESSARY.)
- --
- -- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO
- -- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL.
- --
- -- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE
- -- ENTRY IN THE TASK QUEUE.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE C95021A IS
- BEGIN
- 
-      TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES");
- 
- -- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING.
-      FOR I IN 1..3 LOOP  
-           COMMENT ("ITERATION" & INTEGER'IMAGE(I));
- 
-      DECLARE
- 
-           TASK TYPE CALLERS IS
-                ENTRY NAME (N : NATURAL);
-           END CALLERS;
- 
-           TASK QUEUE IS
-                ENTRY GO;
-                ENTRY E1 (NAME : NATURAL);
-           END QUEUE;
- 
-           TASK DISPATCH IS
-                ENTRY READY;
-           END DISPATCH;
- 
-           TASK BODY CALLERS IS
-                MY_NAME : NATURAL;
-           BEGIN
- 
- -- GET NAME OF THIS TASK OBJECT
-                ACCEPT NAME (N : NATURAL) DO
-                     MY_NAME := N;
-                END NAME;
- 
- -- PUT THIS TASK ON QUEUE FOR QUEUE.E1
-                QUEUE.E1 (MY_NAME);
-           END CALLERS;
- 
-           TASK BODY DISPATCH IS
-                TYPE ACC_CALLERS IS ACCESS CALLERS;
-                OBJ : ACC_CALLERS;
-           BEGIN
- 
- -- FIRE UP TWO CALLERS FOR QUEUE.E1
-                OBJ := NEW CALLERS;
-                OBJ.NAME(1);
-                OBJ := NEW CALLERS;
-                OBJ.NAME(2);
- 
- -- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED).
-                QUEUE.GO;
- 
- -- WAIT TILL ONE CALL HAS BEEN PROCESSED.
-                ACCEPT READY;       -- CALLED FROM QUEUE
- 
- -- FIRE UP THIRD CALLER
-                OBJ := NEW CALLERS;
-                OBJ.NAME(3);
- 
-           END DISPATCH;
- 
-           TASK BODY QUEUE IS
-                NEXT : NATURAL;     -- NUMBER OF SECOND CALLER IN QUEUE.
-           BEGIN
- 
- -- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED.
-                ACCEPT GO;
- 
- -- WAIT FOR TWO CALLS TO BE AVAILABLE.  THIS WAIT ASSUMES THAT THE
- -- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY
- -- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD.
-                FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
-                LOOP
-                     EXIT WHEN E1'COUNT = 2;
-                     DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
-                END LOOP;
- 
-                IF E1'COUNT /= 2 THEN
-                     FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
-                             "MINUTE - 1");
-                END IF;
- 
- -- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS.
-                ACCEPT E1 (NAME : NATURAL) DO
- 
- -- GET NAME OF NEXT CALLER
-                     CASE NAME IS
-                          WHEN 1 => 
-                               NEXT := 2;
-                          WHEN 2 => 
-                               NEXT := 1;
-                          WHEN OTHERS => 
-                               FAILED ("UNEXPECTED ERROR");
-                     END CASE;
-                END E1;
- 
- -- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE).
-                DISPATCH.READY;
- 
- -- WAIT FOR CALL TO ARRIVE.
-                FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
-                LOOP
-                     EXIT WHEN E1'COUNT = 2;
-                     DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
-                END LOOP;
- 
-                IF E1'COUNT /= 2 THEN
-                     FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
-                             "MINUTE - 2");
-                END IF;
- 
- -- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE
- -- CORRECT TASK.
-                ACCEPT E1 (NAME : NATURAL) DO
-                     IF NAME /= NEXT THEN
-                          FAILED ("FIFO DISCIPLINE NOT OBEYED");
-                     END IF;
-                END E1;
- 
- -- ACCEPT THE LAST CALLER
-                ACCEPT E1 (NAME : NATURAL);
- 
-           END QUEUE;
- 
-      BEGIN
-           NULL;
-      END;           -- ALL TASKS NOW TERMINATED.
-      END LOOP;
- 
-      RESULT;
- 
- END C95021A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95022a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95022a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95022a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95022a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- --C95022A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --CHECK THAT IT IS POSSIBLE TO ACCEPT AN ENTRY CALL FROM INSIDE THE
- --THE BODY OF AN ACCEPT STATEMENT.
- 
- --CHECK THE CASE OF NORMAL ENTRY TERMINATION.
- 
- -- JEAN-PIERRE ROSEN 25-FEB-1984
- -- JBG 6/1/84
- 
- -- FOUR CLIENT TASKS CALL ONE SERVER TASK.  EACH CLIENT CALLS JUST ONE
- -- ENTRY OF THE SERVER TASK.  THE TEST CHECKS TO BE SURE THAT CALLS FROM
- -- DIFFERENT TASKS ARE NOT MIXED UP.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95022A IS
- 
- BEGIN
-      TEST("C95022A", "CHECK THAT EMBEDDED RENDEZVOUS ARE PROCESSED " &
-                      "CORRECTLY");
-      DECLARE
- 
-           TASK TYPE CLIENT IS
-                ENTRY GET_ID (I : INTEGER);
-                ENTRY RESTART;
-           END CLIENT;
-      
-           T_ARR : ARRAY (1..4) OF CLIENT;
-      
-           TASK SERVER IS
-                ENTRY E1 (I : IN OUT INTEGER);
-                ENTRY E2 (I : IN OUT INTEGER);
-                ENTRY E3 (I : IN OUT INTEGER);
-                ENTRY E4 (I : IN OUT INTEGER);
-           END SERVER;
-      
-           TASK BODY SERVER IS
-           BEGIN
-      
-                ACCEPT E1 (I : IN OUT INTEGER) DO
-                     ACCEPT E2 (I : IN OUT INTEGER) DO
-                          I := IDENT_INT(I);
-                          ACCEPT E3 (I : IN OUT INTEGER) DO
-                               ACCEPT E4 (I : IN OUT INTEGER) DO
-                                    I := IDENT_INT(I);
-                               END E4;
-                               I := IDENT_INT(I);
-                          END E3;
-                     END E2;
-                     I := IDENT_INT(I);
-                END E1;
-      
-                FOR I IN 1 .. 4 LOOP
-                     T_ARR(I).RESTART;
-                END LOOP;
-           END SERVER;
-      
-           TASK BODY CLIENT IS
-                ID      : INTEGER;
-                SAVE_ID : INTEGER;
-           BEGIN
-                ACCEPT GET_ID (I : INTEGER) DO
-                     ID := I;
-                END GET_ID;
-      
-                SAVE_ID := ID;
-      
-                CASE ID IS
-                     WHEN 1      => SERVER.E1(ID);
-                     WHEN 2      => SERVER.E2(ID);
-                     WHEN 3      => SERVER.E3(ID);
-                     WHEN 4      => SERVER.E4(ID);
-                     WHEN OTHERS => FAILED("INCORRECT ID");
-                END CASE;
- 
-                ACCEPT RESTART;  -- WAIT FOR ALL TASKS TO HAVE COMPLETED
-                                 -- RENDEZVOUS
-                IF ID /= SAVE_ID THEN
-                     FAILED("SCRAMBLED EMBEDDED RENDEZVOUS");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS => FAILED("EXCEPTION IN CLIENT");
-           END CLIENT;
-      
-      BEGIN
-           FOR I IN 1 .. 4 LOOP
-                T_ARR(I).GET_ID(I);
-           END LOOP;
-      END;
- 
-      RESULT;
- 
- END C95022A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95022b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95022b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95022b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95022b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C95022B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IT IS POSSIBLE TO ACCEPT AN ENTRY CALL FROM INSIDE
- -- THE BODY OF AN ACCEPT STATEMENT.
- 
- -- CHECK THE CASE OF ABORT DURING THE INNERMOST ACCEPT.
- 
- -- JEAN-PIERRE ROSEN 25-FEB-1984
- -- JBG 6/1/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95022B IS
- 
- BEGIN
- 
-      TEST("C95022B", "CHECK THAT EMBEDDED RENDEZVOUS ARE PROCESSED " &
-                      "CORRECTLY (ABORT CASE)");
-      DECLARE
-           TASK TYPE CLIENT IS
-                ENTRY GET_ID (I : INTEGER);
-           END CLIENT;
-      
-           T_ARR : ARRAY (1..4) OF CLIENT;
-      
-           TASK KILL IS
-                ENTRY ME;
-           END KILL;
-      
-           TASK SERVER IS
-                ENTRY E1;
-                ENTRY E2;
-                ENTRY E3;
-                ENTRY E4;
-           END SERVER;
-      
-           TASK BODY SERVER IS
-           BEGIN
-      
-                ACCEPT E1 DO
-                     ACCEPT E2 DO
-                          ACCEPT E3 DO
-                               ACCEPT E4 DO
-                                    KILL.ME;
-                                    E1;  -- WILL DEADLOCK UNTIL ABORT.
-                               END E4;
-                          END E3;
-                     END E2;
-                END E1;
-      
-           END SERVER;
-      
-           TASK BODY KILL IS
-           BEGIN
-                ACCEPT ME;
-                ABORT SERVER;
-           END;
- 
-           TASK BODY CLIENT IS
-                ID : INTEGER;
-           BEGIN
-                ACCEPT GET_ID( I : INTEGER) DO
-                     ID := I;
-                END GET_ID;
-      
-                CASE ID IS
-                     WHEN 1      => SERVER.E1;
-                     WHEN 2      => SERVER.E2;
-                     WHEN 3      => SERVER.E3;
-                     WHEN 4      => SERVER.E4;
-                     WHEN OTHERS => FAILED ("INCORRECT ID");
-                END CASE;
-      
-                FAILED ("TASKING_ERROR NOT RAISED IN CLIENT" & 
-                        INTEGER'IMAGE(ID));
-      
-           EXCEPTION
-                WHEN TASKING_ERROR => 
-                     NULL;
-                WHEN OTHERS => 
-                     FAILED("EXCEPTION IN CLIENT" & INTEGER'IMAGE(ID));
-           END CLIENT;
-      BEGIN
-           FOR I IN 1 .. 4 LOOP
-                T_ARR(I).GET_ID(I);
-           END LOOP;
-      END;
- 
-      RESULT;
- 
- END C95022B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95033a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95033a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95033a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95033a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C95033A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT - IN THE CASE OF AN ENTRY FAMILY - EXECUTION OF AN
- -- ACCEPT STATEMENT STARTS WITH THE EVALUATION OF AN ENTRY INDEX.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C950BGA-B.ADA
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C95033A IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
-      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-           RETURN DIGT;
-      END FINIT_POS;
- 
-      TASK T1 IS
-           ENTRY E1 (NATURAL RANGE 1 .. 2);
-           ENTRY BYE;
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1 (FINIT_POS (1)) DO
-                PSPY_NUMB (2);
-           END E1;
-           ACCEPT BYE;
-      END T1;
- 
- BEGIN
-      TEST ("C95033A", "EVALUATION OF ENTRY INDEX");
- 
-      T1.E1 (1);
-      T1.BYE;
-      IF SPYNUMB /= 12 THEN
-           FAILED ("ENTRY INDEX NOT EVALUATED FIRST");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C95033A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95033b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95033b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95033b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95033b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- C95033B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EXECUTION OF AN ENTRY CALL STARTS WITH THE EVALUATION OF
- -- ANY ENTRY INDEX, FOLLOWED BY THE EVALUATION OF ANY EXPRESSION IN
- -- THE PARAMETER LIST.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C950BHA-B.ADA
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C95033B IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-           RETURN DIGT;
-      END FINIT_POS;
- 
-      TASK T1 IS
-           ENTRY E1 (NATURAL RANGE 1 .. 2) (P1 : IN NATURAL);
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1 (1) (P1 : IN NATURAL);
-      END T1;
- 
- BEGIN
- 
-      TEST ("C95033B", "EVALUATION OF ENTRY INDEX AND OF " &
-                       "EXPRESSIONS IN PARAMETER LIST");
- 
-      T1.E1 (FINIT_POS (1)) (FINIT_POS (2));
-      IF SPYNUMB /= 12 THEN
-           FAILED ("ENTRY INDEX NOT EVALUATED FIRST");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C95033B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95034a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95034a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95034a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95034a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C95034A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CALLING TASK IS SUSPENDED IF THE RECEIVING TASK
- -- HAS NOT REACHED A CORRESPONDING ACCEPT STATEMENT.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C950BJA-B.ADA
- 
- with Impdef;
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C95034A IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
-      TASK T1 IS
-           ENTRY E1;
-           ENTRY E2;
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1 DO
-                PSPY_NUMB (1);
-                DELAY 1.0 * Impdef.One_Second;
-           END E1;
-           ACCEPT E2 DO
-                PSPY_NUMB (2);
-           END E2;
-      END T1;
- 
-      TASK T2 IS
-           ENTRY BYE;
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           T1.E2;
-           PSPY_NUMB (3);
-           ACCEPT BYE;
-      END T2;
- 
- BEGIN
- 
-      TEST ("C95034A", "SUSPENSION OF CALLING TASK");
- 
-      T1.E1;
-      T2.BYE;
- 
-      IF SPYNUMB /= 123 THEN
-           FAILED ("ERROR DURING TASK EXECUTION");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C95034A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95034b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95034b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95034b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95034b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- C95034B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CALLING TASK REMAINS SUSPENDED UNTIL THE ACCEPT
- -- STATEMENT RECEIVING THIS ENTRY CALL HAS COMPLETED THE EXECUTION OF
- -- ITS SEQUENCE OF STATEMENTS.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C950CBA-B.ADA
- 
- with Impdef;
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C95034B IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
-      TASK T1 IS
-           ENTRY E1;
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1 DO
-                PSPY_NUMB (1);
-                DELAY 1.0 * Impdef.One_Second;
-                PSPY_NUMB (2);
-           END E1;
-      END T1;
- 
-      TASK T2 IS
-           ENTRY BYE;
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           T1.E1;
-           PSPY_NUMB (3);
-           ACCEPT BYE;
-      END T2;
- 
- BEGIN
- 
-      TEST ("C95034B", "TASK SUSPENSION UNTIL COMPLETION OF ACCEPT " &
-                       "STATEMENT");
- 
-      T2.BYE;
- 
-      IF SPYNUMB /= 123 THEN
-           FAILED ("ERROR DURING TASK EXECUTION");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C95034B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95035a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95035a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95035a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95035a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- C95035A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK IS SUSPENDED IF IT REACHES AN ACCEPT STATEMENT
- -- PRIOR TO ANY CALL OF THE CORRESPONDING ENTRY.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C950CAA-B.ADA
- 
- with Impdef;
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C95035A IS
- 
-      SUBTYPE ARG IS NATURAL RANGE 0..9;
-      SPYNUMB : NATURAL := 0;
- 
-      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
-      BEGIN
-           SPYNUMB := 10*SPYNUMB+DIGT;
-      END PSPY_NUMB;
- 
-      TASK T1 IS
-           ENTRY E1;
-           ENTRY BYE;
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1;
-           PSPY_NUMB (2);
-           ACCEPT BYE;
-      END T1;
- 
-      TASK T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           DELAY 1.0 * Impdef.One_Second;
-           PSPY_NUMB (1);
-           T1.E1;
-      END T2;
- 
- BEGIN
- 
-      TEST ("C95035A", "TASK SUSPENSION PRIOR TO ENTRY CALL");
- 
-      T1.BYE;
- 
-      IF SPYNUMB /= 12 THEN
-           FAILED ("ERROR DURING TASK EXECUTION");
-           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
-      END IF;
- 
-      RESULT;
- 
- END C95035A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- C95040A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE EXCEPTION TASKING_ERROR IS RAISED IF AN ENTRY OF A
- -- COMPLETED TASK IS CALLED.
- 
- -- WEI  3/ 4/82
- -- JWC 6/28/85   RENAMED FROM C950CHA-B.ADA
- 
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C95040A IS
- BEGIN
- 
-      TEST ("C95040A", "ENTRY CALL OF COMPLETED TASK");
- 
- BLOCK1 :
-      DECLARE
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E1;
-           END T1;
-      BEGIN  -- BLOCK1
-           T1.E1;
-           T1.E1;
- 
-           FAILED ("DID NOT RAISE TASKING_ERROR");
-      EXCEPTION
-           WHEN TASKING_ERROR => NULL;
-      END BLOCK1;
- 
-      RESULT;
- 
- END C95040A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- C95040B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE EXCEPTION TASKING_ERROR IS RAISED BY A TASK IF THE
- -- TASK BECOMES COMPLETED OR ABNORMAL BEFORE ACCEPTING THE CALL.
- 
- -- WEI  3/ 4/82
- -- TLB 10/30/87  RENAMED FROM C950CHC.ADA.
- 
- with Impdef;
- WITH REPORT;
-  USE REPORT;
- PROCEDURE C95040B IS
- 
-      TASK T1 IS
-           ENTRY E1;
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           DELAY 1.0 * Impdef.One_Second;
-           IF EQUAL (1, 1) THEN
-                ABORT T1;
-           END IF;
-           ACCEPT E1;
-      END T1;
- 
- BEGIN
- 
-      TEST ("C95040B", "TASK COMPLETION BEFORE ACCEPTING AN ENTRY CALL");
- 
-      T1.E1;
- 
-      FAILED ("NO EXCEPTION TASKING_ERROR RAISED");
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN TASKING_ERROR =>
-           RESULT;
- 
- END C95040B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- C95040C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECKS THAT A TASK COMPLETED, BUT NOT TERMINATED (I.E. WAITING
- -- FOR TERMINATION OF A DEPENDENT TASK) IS NEITHER 'TERMINATED NOR
- -- 'CALLABLE.  CALLS TO ENTRIES BELONGING TO SUCH A TASK RAISE
- -- TASKING_ERROR.
- 
- -- J.P. ROSEN, ADA PROJECT, NYU
- -- JBG 6/1/84
- -- JWC 6/28/85   RENAMED FROM C9A009A-B.ADA
- -- PWN 9/11/94   REMOVED PRAGMA PRIORITY FOR ADA 9X
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C95040C IS
- BEGIN
- 
-      TEST ("C95040C", "TASKING_ERROR RAISED WHEN CALLING COMPLETED " &
-                       "BUT UNTERMINATED TASK");
- 
-      DECLARE
- 
-           TASK T1 IS
-                ENTRY E;
-           END T1;
- 
-           TASK BODY T1 IS
- 
-                TASK T2 IS
-                END T2;
- 
-                TASK BODY T2 IS
-                BEGIN
-                     COMMENT ("BEGIN T2");
-                     T1.E;          -- T1 WILL COMPLETE BEFORE THIS CALL
-                                    -- OR WHILE WAITING FOR THIS CALL TO
-                                    -- BE ACCEPTED.  WILL DEADLOCK IF
-                                    -- TASKING_ERROR IS NOT RAISED.
-                     FAILED ("NO TASKING_ERROR RAISED");
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          IF T1'CALLABLE THEN
-                               FAILED ("T1 STILL CALLABLE");
-                          END IF;
- 
-                          IF T1'TERMINATED THEN    -- T1 CAN'T TERMINATE
-                                                   -- UNTIL T2 HAS
-                                                   -- TERMINATED.
-                               FAILED ("T1 TERMINATED");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION");
-                END T2;
-           BEGIN
-                NULL;
-           END;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END C95040C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95040d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95040d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- C95040D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT TASKING_ERROR IS RAISED IN A CALLING
- -- TASK WHEN THE TASK OWNING THE ENTRY TERMINATES BEFORE RENDEZVOUS
- -- CAN OCCUR.
- 
- -- CHECK THAT RE-RAISING TASKING_ERROR, ONCE TRAPPED IN THE CALLER,
- -- DOES NOT PROPAGATE OUTSIDE THE TASK BODY.
- 
- -- GOM 11/29/84
- -- JWC 05/14/85
- -- PWB 02/11/86  CORRECTED CALL TO TEST TO SHOW CORRECT TEST NAME.
- -- RLB 12/15/99  REMOVED POTENTIALLY ERRONEOUS CALLS TO REPORT.COMMENT.
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE C95040D IS
- 
-      PROCEDURE DRIVER IS
- 
-           TASK NEST IS
-                ENTRY OUTER;
-                ENTRY INNER;
-           END NEST;
- 
-           TASK SLAVE;
- 
-           TASK BODY NEST IS
-           BEGIN
-                --COMMENT("AT TOP OF 'NEST' TASK WAITING ON 'OUTER' " &
-                --        "RENDEZVOUS");
- 
-                ACCEPT OUTER DO
-                     --COMMENT("IN 'OUTER' RENDEZVOUS OF 'NEST' TASK " &
-                     --        "ABOUT TO 'RETURN'");
- 
-                     RETURN;  -- CAUSES 'INNER' RENDEZVOUS TO BE SKIPPED.
- 
-                     ACCEPT INNER DO
-                          FAILED("'INNER' RENDEZVOUS OF 'NEST' TASK " &
-                                 "SHOULD NEVER BE PERFORMED");
-                     END INNER;
-                END OUTER;
- 
-                --COMMENT("'OUTER' RENDEZVOUS COMPLETED IN 'NEST' TASK " &
-                --        "AND NOW TERMINATING");
-           END NEST;
- 
-           TASK BODY SLAVE IS
-           BEGIN
-                --COMMENT("AT TOP OF 'SLAVE' TASK. CALLING 'INNER' " &
-                --        "RENDEZVOUS");
- 
-                NEST.INNER;
- 
-                FAILED("SHOULD HAVE RAISED 'TASKING_ERROR' IN 'SLAVE' " &
-                       "TASK");
-           EXCEPTION
-                WHEN TASKING_ERROR =>
-                     --COMMENT("'SLAVE' TASK CORRECTLY TRAPPING " &
-                     --        "'TASKING_ERROR' AND RE-RAISING IT (BUT " &
-                     --        "SHOULD NOT BE PROPAGATED)");
-                     RAISE;
-           END SLAVE;
- 
-      BEGIN  -- START OF DRIVER PROCEDURE.
- 
-           --COMMENT("AT TOP OF 'DRIVER'. CALLING 'OUTER' ENTRY OF " &
-           --        "'NEST' TASK");
- 
-           NEST.OUTER;
- 
-           --COMMENT("'OUTER' RENDEZVOUS COMPLETED. 'DRIVER' AWAITING " &
-           --        "TERMINATION OF 'NEST' AND 'SLAVE' TASKS");
- 
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                FAILED("'TASKING_ERROR' CAUGHT IN 'DRIVER' WHEN IT " &
-                       "SHOULD HAVE BEEN CAUGHT IN 'SLAVE' TASK, OR " &
-                       "'TASKING_ERROR' WAS INCORRECTLY PROPAGATED BY " &
-                       "'SLAVE' TASK");
-      END DRIVER;
- 
- BEGIN  -- START OF MAIN PROGRAM.
- 
-      TEST("C95040D","CHECK THAT 'TASKING_ERROR' IS RAISED IN A " &
-                     "CALLER TASK WHEN TASK OWNING THE ENTRY CANNOT " &
-                     "PERFORM RENDEZVOUS. ALSO CHECK THAT " &
-                     "'TASKING_ERROR', ONCE RAISED, IS NOT PROPAGATED " &
-                     "OUTSIDE THE TASK BODY");
- 
-      --COMMENT("MAIN PROGRAM CALLING 'DRIVER' PROCEDURE");
- 
-      DRIVER;
- 
-      --COMMENT("MAIN PROGRAM NOW TERMINATING");
- 
-      RESULT;
- END C95040D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95041a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95041a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95041a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95041a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C95041A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENTRY FAMILY INDEX CAN BE SPECIFIED WITH THE FORM
- --     A'RANGE.
- 
- -- HISTORY:
- --     DHH 03/17/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95041A IS
- 
-      GLOBAL_A, GLOBAL_B : INTEGER;
-      GLOBAL_C, GLOBAL_D : INTEGER;
-      TYPE COLOR IS (RED, BLUE, YELLOW);
-      TYPE ARR IS ARRAY(COLOR RANGE RED .. BLUE) OF BOOLEAN;
-      ARRY : ARR;
- 
-      TASK CHECK IS
-           ENTRY CHECK_LINK(ARR'RANGE)(I : INTEGER);
-      END CHECK;
- 
-      TASK CHECK_OBJ IS
-           ENTRY CHECK_OBJ_LINK(ARRY'RANGE)(I : INTEGER);
-      END CHECK_OBJ;
- 
-      TASK BODY CHECK IS
-      BEGIN
-                ACCEPT CHECK_LINK(RED)(I : INTEGER) DO
-                     GLOBAL_A := IDENT_INT(I);
-                END;
- 
-                ACCEPT CHECK_LINK(BLUE)(I : INTEGER) DO
-                     GLOBAL_B := IDENT_INT(I);
-                END;
-      END CHECK;
- 
-      TASK BODY CHECK_OBJ IS
-      BEGIN
-                ACCEPT CHECK_OBJ_LINK(RED)(I : INTEGER) DO
-                     GLOBAL_C := IDENT_INT(I);
-                END;
- 
-                ACCEPT CHECK_OBJ_LINK(BLUE)(I : INTEGER) DO
-                     GLOBAL_D := IDENT_INT(I);
-                END;
-      END CHECK_OBJ;
- 
- BEGIN
-      TEST("C95041A", "CHECK THAT AN ENTRY FAMILY INDEX CAN BE " &
-                      "SPECIFIED WITH THE FORM A'RANGE");
-      CHECK.CHECK_LINK(RED)(10);
-      CHECK.CHECK_LINK(BLUE)(5);
- 
-      CHECK_OBJ.CHECK_OBJ_LINK(RED)(10);
-      CHECK_OBJ.CHECK_OBJ_LINK(BLUE)(5);
- 
-      IF GLOBAL_A /= IDENT_INT(10) THEN
-           FAILED("ENTRY CHECK_LINK(RED) HAS INCORRECT VALUE");
-      END IF;
- 
-      IF GLOBAL_B /= IDENT_INT(5) THEN
-           FAILED("ENTRY CHECK_LINK(BLUE) HAS INCORRECT VALUE");
-      END IF;
- 
-      IF GLOBAL_C /= IDENT_INT(10) THEN
-           FAILED("ENTRY CHECK_LINK(RED) HAS INCORRECT VALUE");
-      END IF;
- 
-      IF GLOBAL_D /= IDENT_INT(5) THEN
-           FAILED("ENTRY CHECK_LINK(BLUE) HAS INCORRECT VALUE");
-      END IF;
- 
-      RESULT;
- END C95041A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C95065A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
- -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
- -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
- -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
- 
- -- CASE (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
- --          INITIALIZED WITH A STATIC AGGREGATE.
- 
- -- JWC 6/19/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95065A IS
- 
- BEGIN
- 
-      TEST ("C95065A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
-                       "FORMAL PART IS ELABORATED");
- 
-      BEGIN
- 
-           DECLARE
- 
-                TYPE A1 IS ARRAY (1 .. IDENT_INT(1), 1 .. IDENT_INT(10))
-                                 OF INTEGER;
- 
-                TASK T IS
-                     ENTRY E1 (A : A1 := ((1, 0), (0, 1)));
-                END T;
- 
-                TASK BODY T IS
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (A : A1 := ((1, 0), (0, 1))) DO
-                               FAILED ("ACCEPT E1 EXECUTED");
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN TASK T");
-                END T;
- 
-           BEGIN
-                T.E1;
-                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - E1");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C95065A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C95065B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
- -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
- -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
- -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
- 
- -- CASE (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
- --          INITIALIZED WITH A STATIC VALUE.
- 
- -- JWC 6/19/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95065B IS
- 
- BEGIN
- 
-      TEST ("C95065B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
-                       "FORMAL PART IS ELABORATED");
- 
-      BEGIN
- 
-           DECLARE
- 
-                SUBTYPE INT IS INTEGER
-                               RANGE IDENT_INT(0) .. IDENT_INT(63);
- 
-                TASK T IS
-                     ENTRY E1 (I : INT := -1);
-                END T;
- 
-                TASK BODY T IS
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (I : INT := -1) DO
-                               FAILED ("ACCEPT E1 EXECUTED");
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN TASK T");
-                END T;
- 
-           BEGIN
-                T.E1;
-                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - E1");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C95065B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C95065C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
- -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
- -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
- -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
- 
- -- CASE (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
- --          CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
- 
- -- JWC 6/19/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95065C IS
- 
- BEGIN
- 
-      TEST ("C95065C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
-                       "FORMAL PART IS ELABORATED");
- 
-      BEGIN
- 
-           DECLARE
- 
-                TYPE A1 IS ARRAY (1 .. 3) OF INTEGER
-                                 RANGE IDENT_INT(1) .. IDENT_INT(3);
- 
-                TYPE REC IS
-                     RECORD
-                          I : INTEGER RANGE IDENT_INT(1)..IDENT_INT(3);
-                          A : A1;
-                     END RECORD;
- 
-                TASK T IS
-                     ENTRY E1 (R : REC := (-3,(0,2,3)));
-                END T;
- 
-                TASK BODY T IS
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (R : REC := (-3,(0,2,3))) DO
-                               FAILED ("ACCEPT E1 EXECUTED");
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN TASK T");
-                END T;
- 
-           BEGIN
-                T.E1;
-                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - E1");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C95065C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C95065D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
- -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
- -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
- -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
- 
- -- CASE (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON
- --          SUBSCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
- --          WITH A STATIC AGGREGATE.
- 
- -- JWC 6/19/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95065D IS
- 
- BEGIN
- 
-      TEST ("C95065D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
-                       "FORMAL PART IS ELABORATED");
- 
-      BEGIN
- 
-           DECLARE
- 
-                TYPE A1 IS ARRAY (1 .. 2, 1 .. 2) OF INTEGER
-                                 RANGE IDENT_INT(1) .. IDENT_INT(2);
- 
-                TASK T IS
-                     ENTRY E1 (A : A1 := ((1, -1), (1, 2)));
-                END T;
- 
-                TASK BODY T IS
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (A : A1 := ((1, -1), (1, 2))) DO
-                               FAILED ("ACCEPT E1 EXECUTED");
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN TASK T");
-                END T;
- 
-           BEGIN
-                T.E1;
-                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - E1");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C95065D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- C95065E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
- -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
- -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
- -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
- 
- -- CASE (E) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON
- --          SUBSCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
- --          WITH A STATIC AGGREGATE.
- 
- -- JWC 6/19/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95065E IS
- 
- BEGIN
- 
-      TEST ("C95065E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
-                       "FORMAL PART IS ELABORATED");
- 
-      BEGIN
- 
-           DECLARE
- 
-                TYPE A1 IS ARRAY (1 .. 2, 1 .. 2) OF INTEGER
-                                 RANGE IDENT_INT(1) .. IDENT_INT(2);
- 
-                TASK T IS
-                     ENTRY E1 (A : A1 := (3 .. 4 => (1, 2)));
-                END T;
- 
-                TASK BODY T IS
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (A : A1 := (3 .. 4 => (1, 2))) DO
-                               FAILED ("ACCEPT E1 EXECUTED");
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN TASK T");
-                END T;
- 
-           BEGIN
-                T.E1;
-                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - E1");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C95065E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95065f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95065f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C95065F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
- -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
- -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
- -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
- 
- -- CASE (F) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
- --          INITIALIZED WITH A STATIC AGGREGATE.
- 
- -- JWC 6/19/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95065F IS
- 
- BEGIN
- 
-      TEST ("C95065F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
-                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
-                       "FORMAL PART IS ELABORATED");
- 
-      BEGIN
- 
-           DECLARE
- 
-                SUBTYPE INT IS INTEGER RANGE 0 .. 10;
-                TYPE A1 IS ARRAY (1 .. 3) OF INT;
-                TYPE REC (I : INT) IS
-                     RECORD
-                          A : A1;
-                     END RECORD;
- 
-                SUBTYPE REC4 IS REC (IDENT_INT(4));
- 
-                TASK T IS
-                     ENTRY E1 (R : REC4 := (3,(1,2,3)));
-                END T;
- 
-                TASK BODY T IS
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (R : REC4 := (3,(1,2,3))) DO
-                               FAILED ("ACCEPT E1 EXECUTED");
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN TASK T");
-                END T;
- 
-           BEGIN
-                T.E1;
-                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - E1");
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- 
- END C95065F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95066a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95066a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95066a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95066a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,214 ****
- -- C95066A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A STATIC EXPRESSION, CONSTANT NAME, ATTRIBUTE NAME,
- -- VARIABLE, DEREFERENCED ACCESS, USER-DEFINED OPERATOR, USER-
- -- DEFINED FUNCTION, OR ALLOCATOR CAN BE USED IN THE INITIALIZATION
- -- EXPRESSION OF A FORMAL PARAMETER, AND THAT THE APPROPRIATE
- -- VALUE IS USED AS A DEFAULT PARAMETER VALUE WHEN THE ENTRY
- -- IS CALLED.
- 
- -- GLH  6/19/85
- 
- WITH REPORT;
- PROCEDURE C95066A IS
- 
-      USE REPORT;
- 
-      TYPE INT IS RANGE 1 .. 10;
- 
-      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
- 
-      TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-           RECORD
-                A : ARR (0..CONSTRAINT);
-           END RECORD;
- 
-      C7   : CONSTANT INTEGER  := 7;
-      V7   : INTEGER  := 7;
- 
-      TYPE  A_INT IS ACCESS INTEGER;
-      C_A  : CONSTANT A_INT  := NEW INTEGER'(7);
- 
-      SUBTYPE RECTYPE1 IS RECTYPE (2 + 5);
-      SUBTYPE RECTYPE2 IS RECTYPE (C7);
-      SUBTYPE RECTYPE3 IS RECTYPE (V7);
- 
-      FUNCTION "&" (X,Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN 10;
-      END "&";
- 
-      FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN X;
-      END FUNC;
- 
-       -- STATIC EXPRESSION.
- 
-      TASK T1 IS
-           ENTRY E1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7)));
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7))) DO
-                IF (REC /= (7,(0,1,2,3,4,5,6,7))) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
-                             "E1 PARAMETER");
-                END IF;
-           END E1;
-      END T1;
- 
-      -- CONSTANT NAME.
- 
-      TASK T2 IS
-           ENTRY E2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7)));
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           ACCEPT E2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7))) DO
-                IF (REC /= (C7,(0,1,2,3,4,5,6,7))) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
-                             "E2 PARAMETER");
-                END IF;
-           END E2;
-      END T2;
- 
-      -- ATTRIBUTE NAME.
- 
-      TASK T3 IS
-           ENTRY E3 (P1 : INT := INT'LAST);
-      END T3;
- 
-      TASK BODY T3 IS
-      BEGIN
-           ACCEPT E3 (P1 : INT := INT'LAST) DO
-                IF (P1 /= INT (10)) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
-                             "E3 PARAMETER");
-                END IF;
-           END E3;
-      END T3;
- 
-      -- VARIABLE.
- 
-      TASK T4 IS
-           ENTRY E4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7)));
-      END T4;
- 
-      TASK BODY T4 IS
-      BEGIN
-           ACCEPT E4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7))) DO
-                IF (P4 /= (V7,(0,1,2,3,4,5,6,7))) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
-                             "E4 PARAMETER");
-                END IF;
-           END E4;
-      END T4;
- 
-      -- DEREFERENCED ACCESS.
- 
-      TASK T5 IS
-           ENTRY E5 (P5 : INTEGER := C_A.ALL);
-      END T5;
- 
-      TASK BODY T5 IS
-      BEGIN
-           ACCEPT E5 (P5 : INTEGER := C_A.ALL) DO
-                IF (P5 /= C_A.ALL) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
-                             "E5 PARAMETER");
-                END IF;
-           END E5;
-      END T5;
- 
-      -- USER-DEFINED OPERATOR.
- 
-      TASK T6 IS
-           ENTRY E6 (P6 : INTEGER := 6&4);
-      END T6;
- 
-      TASK BODY T6 IS
-      BEGIN
-           ACCEPT E6 (P6 : INTEGER := 6&4) DO
-                IF (P6 /= IDENT_INT(10)) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE " &
-                             "FOR E6 PARAMETER");
-                END IF;
-           END E6;
-      END T6;
- 
-      -- USER-DEFINED FUNCTION.
- 
-      TASK T7 IS
-           ENTRY E7 (P7 : INTEGER := FUNC(10));
-      END T7;
- 
-      TASK BODY T7 IS
-      BEGIN
-           ACCEPT E7 (P7 : INTEGER := FUNC(10)) DO
-                IF (P7 /= IDENT_INT(10)) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
-                             "E7 PARAMETER");
-                END IF;
-           END E7;
-      END T7;
- 
-      -- ALLOCATOR.
- 
-      TASK T8 IS
-           ENTRY E8 (P8 : A_INT := NEW INTEGER'(7));
-      END T8;
- 
-      TASK BODY T8 IS
-      BEGIN
-           ACCEPT E8 (P8 : A_INT := NEW INTEGER'(7)) DO
-                IF (P8.ALL /= IDENT_INT(7)) THEN
-                     FAILED ("INCORRECT DEFAULT VALUE " &
-                             "FOR E8 PARAMETER");
-                END IF;
-           END E8;
-      END T8;
- 
- BEGIN
-      TEST ("C95066A", "CHECK USE OF STATIC EXPRESSIONS, CONSTANT " &
-                       "NAMES, ATTRIBUTE NAMES, VARIABLES, USER- " &
-                       "DEFINED OPERATORS, USER-DEFINED FUNCTIONS, " &
-                       "DEREFERENCED ACCESSES, AND ALLOCATORS IN " &
-                       "THE FORMAL PART OF A TASK SPECIFICATION");
- 
-      T1.E1;
-      T2.E2;
-      T3.E3;
-      T4.E4;
-      T5.E5;
-      T6.E6;
-      T7.E7;
-      T8.E8;
- 
-      RESULT;
- 
- END C95066A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95067a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95067a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95067a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95067a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,302 ****
- -- C95067A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
- -- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
- 
- -- JWC 6/20/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95067A IS
- 
-      PACKAGE PKG IS
- 
-           TYPE ITYPE IS LIMITED PRIVATE;
- 
-           TASK T1 IS
- 
-                ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
- 
-                ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
-                                    M : STRING);
- 
-                ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER);
- 
-           END T1;
- 
-           SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
-           TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
- 
-           TASK T2 IS
- 
-                ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
-                                  I : INTEGER; S : STRING; M : STRING);
- 
-                ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
-                                     I : INTEGER; S : STRING;
-                                     M : STRING);
- 
-                ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER;
-                              I : INTEGER; S : STRING);
- 
-           END T2;
- 
-      PRIVATE
- 
-           TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
- 
-           TYPE VRTYPE (C : INT_0_20 := 20) IS
-                RECORD
-                     I : INTEGER;
-                     S : STRING (1 .. C);
-                END RECORD;
- 
-      END PKG;
- 
-      USE PKG;
- 
-      I1 : ITYPE;
- 
-      TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
- 
-      A1 : ATYPE;
- 
-      VR1 : VRTYPE;
- 
-      D : CONSTANT INT_0_20 := 10;
- 
-      TYPE RTYPE IS
-           RECORD
-                J : ITYPE;
-                R : VRTYPE (D);
-           END RECORD;
- 
-      R1 : RTYPE;
- 
-      PACKAGE BODY PKG IS
- 
-           TASK BODY T1 IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER;
-                                            M : STRING) DO
-                               IF INTEGER (X) /= V THEN
-                                    FAILED ("WRONG SCALAR VALUE - " & M);
-                               END IF;
-                          END LOOK_IN_I;
-                     OR
-                          ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE;
-                                               V : INTEGER;
-                                               M : STRING) DO
-                               IF INTEGER (X) /= V THEN
-                                    FAILED ("WRONG SCALAR VALUE - " & M);
-                               END IF;
-                          END LOOK_INOUT_I;
-                     OR
-                          ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO
-                               X := ITYPE (IDENT_INT (V));
-                          END SET_I;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T1;
- 
-           TASK BODY T2 IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
-                                             I : INTEGER; S : STRING;
-                                             M : STRING) DO
-                               IF (X.C /= C OR X.I /= I) OR ELSE
-                                  X.S /= S THEN
-                                    FAILED ("WRONG COMPOSITE VALUE - " &
-                                            M);
-                               END IF;
-                          END LOOK_IN_VR;
-                     OR
-                          ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE;
-                                                C : INTEGER; I : INTEGER;
-                                                S : STRING;
-                                                M : STRING) DO
-                               IF (X.C /= C OR X.I /= I) OR ELSE
-                                  X.S /= S THEN
-                                    FAILED ("WRONG COMPOSITE VALUE - " &
-                                            M);
-                               END IF;
-                          END LOOK_INOUT_VR;
-                     OR
-                          ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER;
-                                         I : INTEGER; S : STRING) DO
-                               X := (IDENT_INT(C), IDENT_INT(I),
-                                     IDENT_STR(S));
-                          END SET_VR;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T2;
- 
-      BEGIN
-           I1 := ITYPE (IDENT_INT(2));
- 
-           FOR I IN A1'RANGE LOOP
-                A1 (I) := ITYPE (3 + IDENT_INT(I));
-           END LOOP;
- 
-           VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
- 
-           R1.J := ITYPE (IDENT_INT(6));
-           R1.R := (IDENT_INT(D), IDENT_INT(19),
-                    IDENT_STR("ABCDEFGHIJ"));
-      END PKG;
- 
-      TASK T3 IS
-           ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
- 
-           ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
-                                NV : INTEGER; M : STRING);
- 
-           ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING);
- 
-           ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
-                                NV : INTEGER; M : STRING);
- 
-           ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
-                              S : STRING; M : STRING);
- 
-           ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE;
-                                OC : INTEGER; OI : INTEGER; OS : STRING;
-                                NC : INTEGER; NI : INTEGER; NS : STRING;
-                                M : STRING);
- 
-           ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
-                             I : INTEGER; S : STRING; M : STRING);
- 
-           ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
-                               OC : INTEGER; OI : INTEGER; OS : STRING;
-                               NJ : INTEGER;
-                               NC : INTEGER; NI : INTEGER; NS : STRING;
-                               M : STRING);
-      END T3;
- 
-      TASK BODY T3 IS
-      BEGIN
-           ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO
-                T1.LOOK_IN_I (X, V, M);
-           END CHECK_IN_I;
- 
-           ACCEPT CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
-                                 NV : INTEGER; M : STRING) DO
-                T1.LOOK_INOUT_I (X, OV, M & " - A");
-                T1.SET_I (X, NV);
-                T1.LOOK_INOUT_I (X, NV, M & " - B");
-                T1.LOOK_IN_I (X, NV, M & " - C");
-           END CHECK_INOUT_I;
- 
-           ACCEPT CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) DO
-                FOR I IN X'RANGE LOOP
-                     T1.LOOK_IN_I (X(I), V+I, M & " -" &
-                                              INTEGER'IMAGE (I));
-                END LOOP;
-           END CHECK_IN_A;
- 
-           ACCEPT CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
-                                 NV : INTEGER; M : STRING) DO
-                FOR I IN X'RANGE LOOP
-                     T1.LOOK_INOUT_I (X(I), OV+I, M & " - A" &
-                                                  INTEGER'IMAGE (I));
-                     T1.SET_I (X(I), NV+I);
-                     T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" &
-                                                  INTEGER'IMAGE (I));
-                     T1.LOOK_IN_I (X(I), NV+I, M & " - C" &
-                                               INTEGER'IMAGE (I));
-                END LOOP;
-           END CHECK_INOUT_A;
- 
-           ACCEPT CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
-                               S : STRING; M : STRING) DO
-                T2.LOOK_IN_VR (X, C, I, S, M);
-           END CHECK_IN_VR;
- 
-           ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE;
-                                  OC : INTEGER; OI : INTEGER;
-                                  OS : STRING;
-                                  NC : INTEGER; NI : INTEGER;
-                                  NS : STRING;
-                                  M : STRING) DO
-                T2.LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
-                T2.SET_VR (X, NC, NI, NS);
-                T2.LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
-                T2.LOOK_IN_VR (X, NC, NI, NS, M & " - C");
-           END CHECK_INOUT_VR;
- 
-           ACCEPT CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
-                              I : INTEGER; S : STRING; M : STRING) DO
-                T1.LOOK_IN_I (X.J, J, M & " - A");
-                T2.LOOK_IN_VR (X.R, C, I, S, M & " - B");
-           END CHECK_IN_R;
- 
-           ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
-                                 OC : INTEGER; OI : INTEGER; OS : STRING;
-                                 NJ : INTEGER;
-                                 NC : INTEGER; NI : INTEGER; NS : STRING;
-                                 M : STRING) DO
-                T1.LOOK_INOUT_I (X.J, OJ, M & " - A");
-                T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
-                T1.SET_I (X.J, NJ);
-                T2.SET_VR (X.R, NC, NI, NS);
-                T1.LOOK_INOUT_I (X.J, NJ, M & " - C");
-                T2.LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
-                T1.LOOK_IN_I (X.J, NJ, M & " - E");
-                T2.LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
-           END CHECK_INOUT_R;
-      END T3;
- 
- BEGIN
-      TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
-                       "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
- 
-      T3.CHECK_IN_I (I1, 2, "IN I");
- 
-      T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I");
- 
-      T3.CHECK_IN_A (A1, 3, "IN A");
- 
-      T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A");
- 
-      T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
- 
-      T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
-                         "INOUT VR");
- 
-      T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
- 
-      T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5,
-                        "ZYXWVUTSRQ", "INOUT R");
- 
-      RESULT;
- END C95067A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95071a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95071a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95071a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95071a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,230 ****
- -- C95071A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN
- -- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL
- -- PARAMETER OF ANY MODE.  SUBTESTS ARE:
- --        (A) INTEGER ACCESS TYPE.
- --        (B) ARRAY ACCESS TYPE.
- --        (C) RECORD ACCESS TYPE.
- 
- -- JWC 7/11/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95071A IS
- 
- BEGIN
- 
-      TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &
-                       "MAY BE USED IN ASSIGNMENT CONTEXTS");
- 
-      --------------------------------------------------
- 
-      DECLARE   -- (A)
- 
-           TYPE PTRINT IS ACCESS INTEGER;
-           PI : PTRINT;
- 
-           TASK TA IS
-                ENTRY EA (PI : IN PTRINT);
-           END TA;
- 
-           TASK BODY TA IS
-           BEGIN
-                ACCEPT EA (PI : IN PTRINT) DO
-                     DECLARE
-                          TASK TA1 IS
-                               ENTRY EA1 (I : OUT INTEGER);
-                               ENTRY EA2 (I : IN OUT INTEGER);
-                          END TA1;
- 
-                          TASK BODY TA1 IS
-                          BEGIN
-                               ACCEPT EA1 (I : OUT INTEGER) DO
-                                    I := 7;
-                               END EA1;
- 
-                               ACCEPT EA2 (I : IN OUT INTEGER) DO
-                                    I := I + 1;
-                               END EA2;
-                          END TA1;
- 
-                     BEGIN
-                          TA1.EA1 (PI.ALL);
-                          TA1.EA2 (PI.ALL);
-                          PI.ALL := PI.ALL + 1;
-                          IF (PI.ALL /= 9) THEN
-                               FAILED ("ASSIGNMENT TO COMPONENT OF " &
-                                       "INTEGER ACCESS PARAMETER " &
-                                       "FAILED");
-                          END IF;
-                     END;
-                END EA;
-           END TA;
- 
-      BEGIN     -- (A)
- 
-           PI := NEW INTEGER'(0);
-           TA.EA (PI);
- 
-      END;      -- (A)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (B)
- 
-           TYPE TBL IS ARRAY (1..3) OF INTEGER;
-           TYPE PTRTBL IS ACCESS TBL;
-           PT : PTRTBL;
- 
-           TASK TB IS
-                ENTRY EB (PT : IN PTRTBL);
-           END TB;
- 
-           TASK BODY TB IS
-           BEGIN
-                ACCEPT EB (PT : IN PTRTBL) DO
-                     DECLARE
-                          TASK TB1 IS
-                               ENTRY EB1 (T : OUT TBL);
-                               ENTRY EB2 (T : IN OUT TBL);
-                               ENTRY EB3 (I : OUT INTEGER);
-                               ENTRY EB4 (I : IN OUT INTEGER);
-                          END TB1;
- 
-                          TASK BODY TB1 IS
-                          BEGIN
-                               ACCEPT EB1 (T : OUT TBL) DO
-                                    T := (1,2,3);
-                               END EB1;
- 
-                               ACCEPT EB2 (T : IN OUT TBL) DO
-                                    T(3) := T(3) - 1;
-                               END EB2;
- 
-                               ACCEPT EB3 (I : OUT INTEGER) DO
-                                    I := 7;
-                               END EB3;
- 
-                               ACCEPT EB4 (I : IN OUT INTEGER) DO
-                                    I := I + 1;
-                               END EB4;
-                          END TB1;
- 
-                     BEGIN
-                          TB1.EB1 (PT.ALL);         -- (1,2,3)
-                          TB1.EB2 (PT.ALL);         -- (1,2,2)
-                          TB1.EB3 (PT(2));          -- (1,7,2)
-                          TB1.EB4 (PT(1));          -- (2,7,2)
-                          PT(3) := PT(3) + 7;      -- (2,7,9)
-                          IF (PT.ALL /= (2,7,9)) THEN
-                               FAILED ("ASSIGNMENT TO COMPONENT OF " &
-                                       "ARRAY ACCESS PARAMETER FAILED");
-                          END IF;
-                     END;
-                END EB;
-           END TB;
- 
-      BEGIN     -- (B)
- 
-           PT := NEW TBL'(0,0,0);
-           TB.EB (PT);
- 
-      END;      -- (B)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (C)
- 
-           TYPE REC IS
-                RECORD
-                     I1   : INTEGER;
-                     I2   : INTEGER;
-                     I3   : INTEGER;
-                END RECORD;
- 
-           TYPE PTRREC IS ACCESS REC;
-           PR : PTRREC;
- 
-           TASK TC IS
-                ENTRY EC (PR : IN PTRREC);
-           END TC;
- 
-           TASK BODY TC IS
-           BEGIN
-                ACCEPT EC (PR : IN PTRREC) DO
-                     DECLARE
-                          TASK TC1 IS
-                               ENTRY EC1 (R : OUT REC);
-                               ENTRY EC2 (R : IN OUT REC);
-                               ENTRY EC3 (I : OUT INTEGER);
-                               ENTRY EC4 (I : IN OUT INTEGER);
-                          END TC1;
- 
-                          TASK BODY TC1 IS
-                          BEGIN
-                               ACCEPT EC1 (R : OUT REC) DO
-                                    R := (1,2,3);
-                               END EC1;
- 
-                               ACCEPT EC2 (R : IN OUT REC) DO
-                                    R.I3 := R.I3 - 1;
-                               END EC2;
- 
-                               ACCEPT EC3 (I : OUT INTEGER) DO
-                                    I := 7;
-                               END  EC3;
- 
-                               ACCEPT EC4 (I : IN OUT INTEGER) DO
-                                    I := I + 1;
-                               END EC4;
-                          END TC1;
- 
-                     BEGIN
-                          TC1.EC1 (PR.ALL);         -- (1,2,3)
-                          TC1.EC2 (PR.ALL);         -- (1,2,2)
-                          TC1.EC3 (PR.I2);          -- (1,7,2)
-                          TC1.EC4 (PR.I1);          -- (2,7,2)
-                          PR.I3 := PR.I3 + 7;       -- (2,7,9)
-                          IF (PR.ALL /= (2,7,9)) THEN
-                               FAILED ("ASSIGNMENT TO COMPONENT OF " &
-                                       "RECORD ACCESS PARAMETER " &
-                                       "FAILED");
-                          END IF;
-                     END;
-                END EC;
-           END TC;
- 
-      BEGIN     -- (C)
- 
-           PR := NEW REC'(0,0,0);
-           TC.EC (PR);
- 
-      END;      -- (C)
- 
-      ---------------------------------------------
- 
-      RESULT;
- 
- END C95071A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95072a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95072a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95072a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95072a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,197 ****
- -- C95072A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SCALAR AND ACCESS PARAMETERS ARE COPIED FOR ALL THREE
- -- PARAMETER MODES.
- -- SUBTESTS ARE:
- --   (A)  SCALAR PARAMETERS TO ENTRIES.
- --   (B)  ACCESS PARAMETERS TO ENTRIES.
- 
- -- JWC 7/22/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95072A IS
- 
- BEGIN
-      TEST ("C95072A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
-                       "COPIED");
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           I : INTEGER;
-           E : EXCEPTION;
- 
-           TASK TA IS
-                ENTRY EA (EI : IN INTEGER; EO : OUT INTEGER;
-                          EIO : IN OUT INTEGER);
-           END TA;
- 
-           TASK BODY TA IS
- 
-                TMP : INTEGER;
- 
-           BEGIN
- 
-                ACCEPT EA (EI : IN INTEGER; EO : OUT INTEGER;
-                           EIO : IN OUT INTEGER) DO
- 
-                     TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
- 
-                     EO := 10;
-                     IF EI /= TMP THEN
-                          FAILED ("ASSIGNMENT TO SCALAR OUT " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
-                     END IF;
- 
-                     EIO := EIO + 100;
-                     IF EI /= TMP THEN
-                          FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
-                     END IF;
- 
-                     I := I + 1;
-                     IF EI /= TMP THEN
-                          FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                     END IF;
- 
-                     RAISE E;            -- CHECK EXCEPTION HANDLING.
-                END EA;
- 
-           EXCEPTION
-                WHEN OTHERS => NULL;
-           END TA;
- 
-      BEGIN  -- (A)
- 
-           I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
-           TA.EA (I, I, I);
-           FAILED ("EXCEPTION NOT RAISED - A");
- 
-      EXCEPTION
-           WHEN E =>
-                IF I /= 1 THEN
-                     CASE I IS
-                          WHEN 11  =>
-                               FAILED ("OUT ACTUAL SCALAR PARAMETER " &
-                                       "CHANGED GLOBAL VALUE");
-                          WHEN 101 =>
-                               FAILED ("IN OUT ACTUAL SCALAR " &
-                                       "PARAMETER CHANGED GLOBAL VALUE");
-                          WHEN 111 =>
-                               FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
-                                       "PARAMETERS CHANGED GLOBAL " &
-                                       "VALUE");
-                          WHEN OTHERS =>
-                               FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
-                                       "VALUE");
-                     END CASE;
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - A");
-      END;  -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           TYPE ACCTYPE IS ACCESS INTEGER;
- 
-           I : ACCTYPE;
-           E : EXCEPTION;
- 
-           TASK TB IS
-                ENTRY EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
-                          EIO : IN OUT ACCTYPE);
-           END TB;
- 
-           TASK BODY TB IS
- 
-                TMP : ACCTYPE;
- 
-           BEGIN
- 
-                ACCEPT EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
-                           EIO : IN OUT ACCTYPE) DO
- 
-                     TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
- 
-                     I := NEW INTEGER'(101);
-                     IF EI /= TMP THEN
-                          FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
-                     END IF;
- 
-                     EO := NEW INTEGER'(1);
-                     IF EI /= TMP THEN
-                          FAILED ("ASSIGNMENT TO ACCESS OUT " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
-                     END IF;
- 
-                     EIO := NEW INTEGER'(10);
-                     IF EI /= TMP THEN
-                          FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
-                                  "PARAMETER CHANGES THE VALUE OF " &
-                                  "INPUT PARAMETER");
-                     END IF;
- 
-                     RAISE E;            -- CHECK EXCEPTION HANDLING.
-                END EB;
- 
-           EXCEPTION
-                WHEN OTHERS => NULL;
-           END TB;
- 
-      BEGIN  -- (B)
- 
-           I := NEW INTEGER'(100);
-           TB.EB (I, I, I);
-           FAILED ("EXCEPTION NOT RAISED - B");
- 
-      EXCEPTION
-           WHEN E =>
-                IF I.ALL /= 101 THEN
-                     FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
-                             "PARAMETER VALUE CHANGED DESPITE " &
-                             "RAISED EXCEPTION");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - B");
-      END;  -- (B)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95072A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95072b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95072b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95072b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95072b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,278 ****
- -- C95072B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
- -- PASSED BY COPY FOR ALL MODES.
- -- SUBTESTS ARE:
- --   (A)  PRIVATE SCALAR PARAMETERS TO ENTRIES.
- --   (B)  PRIVATE ACCESS PARAMETERS TO ENTRIES.
- 
- -- JWC 7/22/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95072B IS
- 
- BEGIN
-      TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
-                      "PARAMETERS ARE COPIED");
- 
-      ---------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           PACKAGE SCALAR_PKG IS
- 
-                TYPE T IS PRIVATE;
-                C0 : CONSTANT T;
-                C1 : CONSTANT T;
-                C10 : CONSTANT T;
-                C100 : CONSTANT T;
- 
-                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
-                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
- 
-           PRIVATE
- 
-                TYPE T IS NEW INTEGER;
-                C0 : CONSTANT T := 0;
-                C1 : CONSTANT T := 1;
-                C10 : CONSTANT T := 10;
-                C100 : CONSTANT T := 100;
- 
-           END SCALAR_PKG;
- 
-           PACKAGE BODY SCALAR_PKG IS
- 
-                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
-                BEGIN
-                     RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
-                END "+";
- 
-                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
-                BEGIN
-                     RETURN INTEGER (OLD_PRIVATE);
-                END CONVERT;
- 
-           END SCALAR_PKG;
- 
-           USE SCALAR_PKG;
- 
-      BEGIN  -- (A)
- 
-           DECLARE  -- (A1)
- 
-                I : T;
-                E : EXCEPTION;
- 
-                TASK TA IS
-                     ENTRY EA (EI : IN T; EO : OUT T;
-                               EIO : IN OUT T);
-                END TA;
- 
-                TASK BODY TA IS
- 
-                     TEMP : T;
- 
-                BEGIN
- 
-                     ACCEPT EA (EI : IN T; EO : OUT T;
-                                EIO : IN OUT T) DO
- 
-                          TEMP := EI;    -- SAVE VALUE OF EI AT ACCEPT.
- 
-                          EO := C10;
-                          IF EI /= TEMP THEN
-                               FAILED ("ASSIGNMENT TO PRIVATE " &
-                                       "(SCALAR) OUT PARAMETER " &
-                                       "CHANGES THE VALUE OF INPUT " &
-                                       "PARAMETER");
-                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
-                          END IF;
- 
-                          EIO := EIO + C100;
-                          IF EI /= TEMP THEN
-                               FAILED ("ASSIGNMENT TO PRIVATE " &
-                                       "(SCALAR) IN OUT PARAMETER " &
-                                       "CHANGES THE VALUE OF INPUT " &
-                                       "PARAMETER");
-                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
-                          END IF;
- 
-                          I := I + C1;
-                          IF EI /= TEMP THEN
-                               FAILED ("ASSIGNMENT TO PRIVATE " &
-                                       "(SCALAR) ACTUAL PARAMETER " &
-                                       "CHANGES THE VALUE OF " &
-                                       "INPUT PARAMETER");
-                          END IF;
- 
-                          RAISE E;              -- CHECK EXCEPTION
-                                                -- HANDLING.
-                     END EA;
- 
-                EXCEPTION
-                     WHEN OTHERS => NULL;
-                END TA;
- 
-           BEGIN    -- (A1)
- 
-                I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
-                          -- DETECTED.
-                TA.EA (I, I, I);
-                FAILED ("EXCEPTION NOT RAISED - A");
- 
-           EXCEPTION
-                WHEN E =>
-                     IF I /= C1 THEN
-                          CASE CONVERT (I) IS
-                               WHEN 11 =>
-                                    FAILED ("OUT ACTUAL PRIVATE " &
-                                            "(SCALAR) PARAMETER " &
-                                            "CHANGED GLOBAL VALUE");
-                               WHEN 101 =>
-                                    FAILED ("IN OUT ACTUAL PRIVATE " &
-                                            "(SCALAR) PARAMETER " &
-                                            "CHANGED GLOBAL VALUE");
-                               WHEN 111 =>
-                                    FAILED ("OUT AND IN OUT ACTUAL " &
-                                            "PRIVATE (SCALAR) " &
-                                            "PARAMETER CHANGED " &
-                                            "GLOBAL VALUE");
-                               WHEN OTHERS =>
-                                    FAILED ("UNDETERMINED CHANGE TO " &
-                                            "GLOBAL VALUE");
-                          END CASE;
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - A");
-           END;  -- (A1)
- 
-      END;  -- (A)
- 
-      ---------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           PACKAGE ACCESS_PKG IS
- 
-                TYPE T IS PRIVATE;
-                C_NULL : CONSTANT T;
-                C1 : CONSTANT T;
-                C10 : CONSTANT T;
-                C100 : CONSTANT T;
-                C101 : CONSTANT T;
- 
-           PRIVATE
- 
-                TYPE T IS ACCESS INTEGER;
-                C_NULL : CONSTANT T := NULL;
-                C1 : CONSTANT T := NEW INTEGER'(1);
-                C10 : CONSTANT T := NEW INTEGER'(10);
-                C100 : CONSTANT T := NEW INTEGER'(100);
-                C101 : CONSTANT T := NEW INTEGER'(101);
- 
-           END ACCESS_PKG;
- 
-           USE ACCESS_PKG;
- 
-      BEGIN    -- (B)
- 
-           DECLARE  -- (B1)
- 
-                I : T;
-                E : EXCEPTION;
- 
-                TASK TB IS
-                     ENTRY EB (EI : IN T; EO : OUT T;
-                               EIO : IN OUT T);
-                END TB;
- 
-                TASK BODY TB IS
- 
-                     TEMP : T;
- 
-                BEGIN
- 
-                     ACCEPT EB (EI : IN T; EO : OUT T;
-                                EIO : IN OUT T) DO
- 
-                          TEMP := EI;  -- SAVE VALUE OF EI AT ACCEPT.
- 
-                          I := C101;
-                          IF EI /= TEMP THEN
-                               FAILED ("ASSIGNMENT TO PRIVATE " &
-                                       "(ACCESS) ACTUAL VARIABLE " &
-                                       "CHANGES THE VALUE OF INPUT " &
-                                       "PARAMETER");
-                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
-                          END IF;
- 
-                          EO := C1;
-                          IF EI /= TEMP THEN
-                               FAILED ("ASSIGNMENT TO PRIVATE " &
-                                       "(ACCESS) OUT PARAMETER " &
-                                       "CHANGES THE VALUE OF INPUT " &
-                                       "PARAMETER");
-                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
-                          END IF;
- 
-                          EIO := C10;
-                          IF EI /= TEMP THEN
-                               FAILED ("ASSIGNMENT TO PRIVATE " &
-                                       "(ACCESS) IN OUT PARAMETER " &
-                                       "CHANGES THE VALUE OF INPUT " &
-                                       "PARAMETER");
-                          END IF;
- 
-                          RAISE E;                 -- CHECK EXCEPTION
-                                                   -- HANDLING.
-                     END EB;
- 
-                EXCEPTION
-                     WHEN OTHERS => NULL;
-                END TB;
- 
-           BEGIN     -- (B1)
- 
-                I := C100;
-                TB.EB (I, I, I);
-                FAILED ("EXCEPTION NOT RAISED - B");
- 
-           EXCEPTION
-                WHEN E =>
-                     IF I /= C101 THEN
-                          FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
-                                  "PARAMETER VALUE CHANGED DESPITE " &
-                                  "RAISED EXCEPTION");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - B");
-           END;  -- (B1)
- 
-      END;  -- (B)
- 
-      ---------------------------------------------------
- 
-      RESULT;
- END C95072B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95073a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95073a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95073a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95073a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- C95073A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALIASING IS PERMITTED FOR PARAMETERS OF COMPOSITE TYPES,
- -- E.G., THAT A MATRIX ADDITION PROCEDURE CAN BE CALLED WITH THREE
- -- IDENTICAL ARGUMENTS.
- 
- -- JWC 7/29/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95073A IS
- 
-      TYPE MATRIX IS ARRAY (1..3, 1..3) OF INTEGER;
- 
-      A : MATRIX := ((1,2,3), (4,5,6), (7,8,9));
- 
-      TASK T IS
-           ENTRY MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX);
-      END T;
- 
-      TASK BODY T IS
-      BEGIN
-           ACCEPT MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX) DO
-                FOR I IN 1..3 LOOP
-                     FOR J IN 1..3 LOOP
-                          SUM (I,J) := X (I,J) + Y (I,J);
-                     END LOOP;
-                END LOOP;
-           END MAT_ADD;
-      END T;
- 
- BEGIN
- 
-      TEST ("C95073A", "CHECK THAT ALIASING IS PERMITTED FOR " &
-                       "PARAMETERS OF COMPOSITE TYPES");
- 
-      T.MAT_ADD (A, A, A);
- 
-      IF A /= ((2,4,6), (8,10,12), (14,16,18)) THEN
-           FAILED ("THE RESULT OF THE MATRIX ADDITION IS INCORRECT");
-      END IF;
- 
-      RESULT;
- 
- END C95073A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95074c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95074c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95074c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95074c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C95074C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT 'FIRST, 'LAST, 'LENGTH, AND 'RANGE, CAN BE APPLIED TO AN
- -- OUT PARAMETER OR OUT PARAMETER SUBCOMPONENT THAT DOES NOT HAVE AN
- -- ACCESS TYPE.
- 
- -- JWC 6/25/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95074C IS
- 
- BEGIN
- 
-      TEST ("C95074C", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " &
-                       "NON-ACCESS FORMAL OUT PARAMETERS");
- 
-      DECLARE
- 
-           TYPE ARR IS ARRAY (1 .. 10) OF NATURAL;
- 
-           TYPE REC IS RECORD
-                A : ARR;
-           END RECORD;
- 
-           A1 : ARR;
-           R1 : REC;
- 
-           TASK T1 IS
-                ENTRY E (A2 : OUT ARR; R2 : OUT REC);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E (A2 : OUT ARR; R2 : OUT REC) DO
- 
-                     IF A2'FIRST /= 1 THEN
-                          FAILED ("WRONG VALUE FOR A2'FIRST");
-                     END IF;
- 
-                     IF A2'LAST /= 10 THEN
-                          FAILED ("WRONG VALUE FOR A2'LAST");
-                     END IF;
- 
-                     IF A2'LENGTH /= 10 THEN
-                          FAILED ("WRONG VALUE FOR A2'LENGTH");
-                     END IF;
- 
-                     IF (1 NOT IN A2'RANGE) OR
-                        (10 NOT IN A2'RANGE) OR
-                        (0 IN A2'RANGE) OR
-                        (11 IN A2'RANGE) THEN
-                          FAILED ("WRONG VALUE FOR A2'RANGE");
-                     END IF;
- 
-                     IF R2.A'FIRST /= 1 THEN
-                          FAILED ("WRONG VALUE FOR R2.A'FIRST");
-                     END IF;
- 
-                     IF R2.A'LAST /= 10 THEN
-                          FAILED ("WRONG VALUE FOR R2.A'LAST");
-                     END IF;
- 
-                     IF R2.A'LENGTH /= 10 THEN
-                          FAILED ("WRONG VALUE FOR R2.A'LENGTH");
-                     END IF;
- 
-                     IF (1 NOT IN R2.A'RANGE) OR
-                        (10 NOT IN R2.A'RANGE) OR
-                        (0 IN R2.A'RANGE) OR
-                        (11 IN R2.A'RANGE) THEN
-                          FAILED ("WRONG VALUE FOR R2.A'RANGE");
-                     END IF;
-                END E;
-           END T1;
- 
-      BEGIN
-           T1.E (A1,R1);
-      END;
- 
-      RESULT;
- END C95074C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95076a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95076a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95076a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95076a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C95076A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ACCEPT STATEMENT WITH AND WITHOUT A RETURN
- -- STATEMENT RETURNS CORRECTLY.
- 
- -- GLH  7/11/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C95076A IS
- 
-      I : INTEGER;
- 
-      TASK T1 IS
-           ENTRY E1 (N : IN OUT INTEGER);
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1 (N : IN OUT INTEGER) DO
-                IF (N = 5) THEN
-                     N := N + 5;
-                ELSE
-                     N := 0;
-                END IF;
-           END E1;
-      END T1;
- 
-      TASK T2 IS
-           ENTRY E2 (N : IN OUT INTEGER);
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           ACCEPT E2 (N : IN OUT INTEGER) DO
-                IF (N = 10) THEN
-                     N := N + 5;
-                     RETURN;
-                END IF;
-                N := 0;
-           END E2;
-      END T2;
- 
- BEGIN
- 
-      TEST ("C95076A", "CHECK THAT AN ACCEPT STATEMENT WITH AND " &
-                       "WITHOUT A RETURN STATEMENT RETURNS CORRECTLY");
- 
-      I := 5;
-      T1.E1 (I);
-      IF (I /= 10) THEN
-           FAILED ("INCORRECT RENDEVOUS WITHOUT A RETURN");
-      END IF;
- 
-      I := 10;
-      T2.E2 (I);
-      IF (I /= 15) THEN
-           FAILED ("INCORRECT RENDEVOUS WITH A RETURN");
-      END IF;
- 
-      RESULT;
- 
- END C95076A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95078a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95078a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95078a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95078a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- C95078A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXCEPTION RAISED DURING THE EXECUTION OF AN ACCEPT
- --     STATEMENT CAN BE HANDLED WITHIN THE ACCEPT BODY.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     DHH 03/21/88 CREATED ORIGINAL TEST.
- --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95078A IS
- 
- BEGIN
- 
-      TEST("C95078A", "CHECK THAT AN EXCEPTION RAISED DURING THE " &
-                      "EXECUTION OF AN ACCEPT STATEMENT CAN BE " &
-                      "HANDLED WITHIN THE ACCEPT BODY");
- 
-      DECLARE
-           O,PT,QT,R,S,TP,B,C,D :INTEGER := 0;
-           TASK TYPE PROG_ERR IS
-                ENTRY START(M,N,A : IN OUT INTEGER);
-                ENTRY STOP;
-           END PROG_ERR;
- 
-           TASK T IS
-                ENTRY START(M,N,A : IN OUT INTEGER);
-                ENTRY STOP;
-           END T;
- 
-           TYPE REC IS
-                RECORD
-                     B : PROG_ERR;
-                END RECORD;
- 
-           TYPE ACC IS ACCESS PROG_ERR;
- 
-           SUBTYPE X IS INTEGER RANGE 1 .. 10;
- 
-           PACKAGE P IS
-                OBJ : REC;
-           END P;
- 
-           TASK BODY PROG_ERR IS
-                FAULT : X;
-           BEGIN
-                ACCEPT START(M,N,A : IN OUT INTEGER) DO
-                     BEGIN
-                          M := IDENT_INT(1);
-                          FAULT := IDENT_INT(11);
-                          FAULT := IDENT_INT(FAULT);
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("UNEXPECTED ERROR RAISED - " &
-                                      "CONSTRAINT - TASK TYPE");
-                     END; -- EXCEPTION
-                     BEGIN
-                          N := IDENT_INT(1);
-                          FAULT := IDENT_INT(5);
-                          FAULT := FAULT/IDENT_INT(0);
-                          FAULT := IDENT_INT(FAULT);
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("UNEXPECTED ERROR RAISED - " &
-                                      "CONSTRAINT - TASK TYPE");
-                     END; -- EXCEPTION
-                     A := IDENT_INT(1);
-                END START;
- 
-                ACCEPT STOP;
-           END PROG_ERR;
- 
-           TASK BODY T IS
-                FAULT : X;
-           BEGIN
-                ACCEPT START(M,N,A : IN OUT INTEGER) DO
-                     BEGIN
-                          M := IDENT_INT(1);
-                          FAULT := IDENT_INT(11);
-                          FAULT := IDENT_INT(FAULT);
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("UNEXPECTED ERROR RAISED - " &
-                                      "CONSTRAINT - TASK");
-                     END; -- EXCEPTION
-                     BEGIN
-                          N := IDENT_INT(1);
-                          FAULT := IDENT_INT(5);
-                          FAULT := FAULT/IDENT_INT(0);
-                          FAULT := IDENT_INT(FAULT);
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("UNEXPECTED ERROR RAISED - " &
-                                      "CONSTRAINT - TASK");
-                     END; -- EXCEPTION
-                     A := IDENT_INT(1);
-                END START;
- 
-                ACCEPT STOP;
-           END T;
- 
-           PACKAGE BODY P IS
-           BEGIN
-                OBJ.B.START(O,PT,B);
-                OBJ.B.STOP;
- 
-                IF O /= IDENT_INT(1) OR PT /= IDENT_INT(1) THEN
-                     FAILED("EXCEPTION HANDLER NEVER ENTERED " &
-                            "PROPERLY - TASK TYPE OBJECT");
-                END IF;
- 
-                IF B /= IDENT_INT(1) THEN
-                     FAILED("TASK NOT EXITED PROPERLY - TASK TYPE " &
-                            "OBJECT");
-                END IF;
-           END P;
- 
-           PACKAGE Q IS
-                OBJ : ACC;
-           END Q;
- 
-           PACKAGE BODY Q IS
-           BEGIN
-                OBJ := NEW PROG_ERR;
-                OBJ.START(QT,R,C);
-                OBJ.STOP;
- 
-                IF QT /= IDENT_INT(1) OR R /= IDENT_INT(1) THEN
-                     FAILED("EXCEPTION HANDLER NEVER ENTERED " &
-                            "PROPERLY - ACCESS TASK TYPE");
-                END IF;
- 
-                IF C /= IDENT_INT(1) THEN
-                     FAILED("TASK NOT EXITED PROPERLY - ACCESS TASK " &
-                            "TYPE");
-                END IF;
-           END;
- 
-      BEGIN
-           T.START(S,TP,D);
-           T.STOP;
- 
-           IF S /= IDENT_INT(1) OR TP /= IDENT_INT(1) THEN
-                FAILED("EXCEPTION HANDLER NEVER ENTERED PROPERLY " &
-                       "- TASK");
-           END IF;
- 
-           IF D /= IDENT_INT(1) THEN
-                FAILED("TASK NOT EXITED PROPERLY - TASK");
-           END IF;
-      END; -- DECLARE
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED("EXCEPTION NOT HANDLED INSIDE ACCEPT BODY");
-           RESULT;
- END C95078A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95080b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95080b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95080b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95080b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C95080B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PARAMETERLESS ENTRIES CAN BE CALLED WITH THE APPROPRIATE
- -- NOTATION.
- 
- -- JWC 7/15/85
- -- JRK 8/21/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95080B IS
- 
-      I : INTEGER := 1;
- 
-      TASK T IS
-           ENTRY E;
-           ENTRY EF (1..3);
-      END T;
- 
-      TASK BODY T IS
-      BEGIN
-           ACCEPT E DO
-                I := 15;
-           END E;
-           ACCEPT EF (2) DO
-                I := 20;
-           END EF;
-      END T;
- 
- BEGIN
- 
-      TEST ("C95080B", "CHECK THAT PARAMETERLESS ENTRIES CAN BE " &
-                       "CALLED");
- 
-      T.E;
-      IF I /= 15 THEN
-           FAILED ("PARAMETERLESS ENTRY CALL YIELDS INCORRECT " &
-                   "RESULT");
-      END IF;
- 
-      I := 0;
-      T.EF (2);
-      IF I /= 20 THEN
-           FAILED ("PARAMETERLESS ENTRY FAMILY CALL YIELDS " &
-                   "INCORRECT RESULT");
-      END IF;
- 
-      RESULT;
- 
- END C95080B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95082g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95082g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95082g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95082g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- C95082G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR CALLS TO ENTRIES HAVING AT LEAST ONE DEFAULT
- -- PARAMETER, THE CORRECT ASSOCIATION IS MADE BETWEEN ACTUAL AND
- -- FORMAL PARAMETERS.
- 
- -- JWC 7/17/85
- 
- WITH REPORT;USE REPORT;
- PROCEDURE C95082G IS
- 
-      Y1,Y2,Y3  : INTEGER := 0;
- 
-      TASK T IS
-           ENTRY E (I1: INTEGER; I2: INTEGER := 2; I3: INTEGER := 3;
-                    O1,O2,O3: OUT INTEGER);
-      END T;
- 
-      TASK BODY T IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E (I1: INTEGER; I2: INTEGER := 2;
-                               I3: INTEGER := 3;
-                               O1,O2,O3: OUT INTEGER) DO
-                          O1 := I1;
-                          O2 := I2;
-                          O3 := I3;
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T;
- 
- 
- BEGIN
- 
-      TEST ("C95082G", "CHECK ASSOCIATIONS BETWEEN ACTUAL AND FORMAL " &
-                       "PARAMETERS (HAVING DEFAULT VALUES)");
- 
-      T.E (I1=>11, I2=>12, I3=>13, O1=>Y1, O2=>Y2, O3=>Y3);
-      IF (Y1 /= 11) OR (Y2 /= 12) OR (Y3 /= 13) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 1");
-      END IF;
- 
-      T.E (I1=>21, O1=>Y1, O2=>Y2, O3=>Y3);
-      IF (Y1 /= 21) OR (Y2 /= 2) OR (Y3 /= 3) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 2");
-      END IF;
- 
-      T.E (O1=>Y1, O3=>Y3, I1=>31, I3=>33, O2=>Y2);
-      IF (Y1 /= 31) OR (Y2 /= 2) OR (Y3 /= 33) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 3");
-      END IF;
- 
-      T.E (41, 42, O1=>Y1, O2=>Y2, O3=>Y3);
-      IF (Y1 /= 41) OR (Y2 /= 42) OR (Y3 /= 3) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 4");
-      END IF;
- 
-      T.E (51, O3=>Y3, O1=>Y1, O2=>Y2, I3=>53);
-      IF (Y1 /= 51) OR (Y2 /= 2) OR (Y3 /= 53) THEN
-           FAILED ("INCORRECT PARAMETER ASSOCIATION - 5");
-      END IF;
- 
-      RESULT;
- 
- END C95082G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,279 ****
- -- C95085A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR OUT OF RANGE SCALAR
- -- ARGUMENTS.  SUBTESTS ARE:
- --        (A) STATIC IN ARGUMENT.
- --        (B) DYNAMIC IN ARGUMENT.
- --        (C) IN OUT, OUT OF RANGE ON CALL.
- --        (D) OUT, OUT OF RANGE ON RETURN.
- --        (E) IN OUT, OUT OF RANGE ON RETURN.
- 
- -- GLH 7/15/85
- -- JRK 8/23/85
- -- JWC 11/15/85     ADDED VARIABLE "CALLED" TO ENSURE THAT THE ENTRY
- --                  CALL WAS MADE FOR THOSE CASES THAT ARE APPLICABLE.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE C95085A IS
- 
-      SUBTYPE DIGIT IS INTEGER RANGE 0..9;
- 
-      D      : DIGIT;
-      I      : INTEGER;
-      M1     : CONSTANT INTEGER := IDENT_INT (-1);
-      COUNT  : INTEGER := 0;
-      CALLED : BOOLEAN;
- 
-      SUBTYPE SI IS INTEGER RANGE M1 .. 10;
- 
-      TASK T1 IS
-           ENTRY E1 (PIN : IN DIGIT; WHO : STRING);  -- (A), (B).
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           LOOP
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (PIN : IN DIGIT;
-                                     WHO : STRING) DO  -- (A), (B).
-                               FAILED ("EXCEPTION NOT RAISED BEFORE " &
-                                       "CALL - E1 " & WHO);
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN E1");
-                END;
-           END LOOP;
-      END T1;
- 
-      TASK T2 IS
-           ENTRY E2 (PINOUT : IN OUT DIGIT; WHO : STRING);  -- (C).
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           LOOP
-                BEGIN
-                     SELECT
-                          ACCEPT E2 (PINOUT : IN OUT DIGIT;
-                                     WHO : STRING) DO  -- (C).
-                               FAILED ("EXCEPTION NOT RAISED BEFORE " &
-                                       "CALL - E2 " & WHO);
-                          END E2;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN E2");
-                END;
-           END LOOP;
-      END T2;
- 
-      TASK T3 IS
-           ENTRY E3 (POUT : OUT SI; WHO : STRING);  -- (D).
-      END T3;
- 
-      TASK BODY T3 IS
-      BEGIN
-           LOOP
-                BEGIN
-                     SELECT
-                          ACCEPT E3 (POUT : OUT SI;
-                                     WHO : STRING) DO  -- (D).
-                               CALLED := TRUE;
-                               IF WHO = "10" THEN
-                                    POUT := IDENT_INT (10);  -- 10 IS NOT
-                                                             -- A DIGIT.
-                               ELSE
-                                    POUT := -1;
-                               END IF;
-                          END E3;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN E3");
-                END;
-           END LOOP;
-      END T3;
- 
-      TASK T4 IS
-           ENTRY E4 (PINOUT : IN OUT INTEGER; WHO : STRING);  -- (E).
-      END T4;
- 
-      TASK BODY T4 IS
-      BEGIN
-           LOOP
-                BEGIN
-                     SELECT
-                          ACCEPT E4 (PINOUT : IN OUT INTEGER;
-                                     WHO : STRING) DO  -- (E).
-                               CALLED := TRUE;
-                               IF WHO = "10" THEN
-                                    PINOUT := 10;  -- 10 IS NOT A DIGIT.
-                               ELSE
-                                    PINOUT := IDENT_INT (-1);
-                               END IF;
-                          END E4;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN E4");
-                END;
-           END LOOP;
-      END T4;
- 
- BEGIN
- 
-      TEST ("C95085A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "FOR OUT OF RANGE SCALAR ARGUMENTS");
- 
-      BEGIN  -- (A)
-           T1.E1 (10, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E1 (10)");
-      END;  -- (A)
- 
-      BEGIN  -- (B)
-           T1.E1 (IDENT_INT (-1), "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (" &
-                   "IDENT_INT (-1))");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E1 (" &
-                        "IDENT_INT (-1))");
-      END;  -- (B)
- 
-      BEGIN  -- (C)
-           I := IDENT_INT (10);
-           T2.E2 (I, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E2 (10)");
-      END;  -- (C)
- 
-      BEGIN -- (C1)
-           I := IDENT_INT (-1);
-           T2.E2 (I, "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E2 (-1)");
-      END; -- (C1)
- 
-      BEGIN  -- (D)
-           CALLED := FALSE;
-           D := IDENT_INT (1);
-           T3.E3 (D, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
-                   "E3 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                             "E3 (10)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E3 (10)");
-      END;  -- (D)
- 
-      BEGIN -- (D1)
-           CALLED := FALSE;
-           D := IDENT_INT (1);
-           T3.E3 (D, "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
-                   "E3 (-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                             "E3 (-1)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E3 (-1)");
-      END; -- (D1)
- 
-      BEGIN  -- (E)
-           CALLED := FALSE;
-           D := 9;
-           T4.E4 (D, "10");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
-                   "E4 (10)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                             "E4 (10)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E4 (10)");
-      END;  -- (E)
- 
-      BEGIN -- (E1)
-           CALLED := FALSE;
-           D := 0;
-           T4.E4 (D, "-1");
-           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
-                   "E4 (-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                COUNT := COUNT + 1;
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
-                             "E4 (-1)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR E4 (-1)");
-      END; -- (E1)
- 
-      IF COUNT /= 8 THEN
-           FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
-      END IF;
- 
-      RESULT;
- 
- END C95085A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- C95085B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER APPROPRIATE CIRCUMSTANCES
- -- WITH RESPECT TO PARAMETERS OF RECORD TYPES IN ENTRY CALLS.  SUBTESTS
- -- INVOLVE ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT
- -- EQUAL TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
- --        (A) IN PARAMETER, STATIC AGGREGATE.
- --        (B) IN PARAMETER, DYNAMIC AGGREGATE.
- --        (C) IN PARAMETER, VARIABLE.
- --        (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
- --        (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
- 
- -- JWC 10/25/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085B IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0..10;
- 
-      TYPE REC (N : INT := 0) IS
-           RECORD
-                A : STRING (1..N);
-           END RECORD;
- 
-      SUBTYPE SREC IS REC(N=>3);
- 
- BEGIN
- 
-      TEST ("C95085B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
-                       "PARAMETERS OF RECORD TYPES");
- 
-      DECLARE
- 
-           TASK TSK1 IS
-                ENTRY E (R : IN SREC);
-           END TSK1;
- 
-           TASK BODY TSK1 IS
-           BEGIN
-                LOOP
-                     BEGIN
-                          SELECT
-                               ACCEPT E (R : IN SREC) DO
-                                    FAILED ("EXCEPTION NOT RAISED ON " &
-                                            "CALL TO TSK1");
-                               END E;
-                          OR
-                               TERMINATE;
-                          END SELECT;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED IN TSK1");
-                     END;
-                END LOOP;
-           END TSK1;
- 
-      BEGIN
- 
-           BEGIN -- (A)
-                TSK1.E ((2,"AA"));
-                FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
-           END; -- (A)
- 
-           BEGIN -- (B)
-                TSK1.E ((IDENT_INT(2), "AA"));
-                FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
-           END; -- (B)
- 
-           DECLARE -- (C)
-                R : REC     := (IDENT_INT(2), "AA");
-           BEGIN -- (C)
-                TSK1.E (R);
-                FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
-           END; -- (C)
- 
-      END;
- 
-      DECLARE -- (D)
- 
-           R : REC := (IDENT_INT(2), "AA");
- 
-           TASK TSK2 IS
-                ENTRY E (R : IN OUT SREC);
-           END TSK2;
- 
-           TASK BODY TSK2 IS
-           BEGIN
-                SELECT
-                     ACCEPT E (R : IN OUT SREC) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
-                                  "TSK2");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TSK2");
-           END TSK2;
- 
-      BEGIN -- (D)
-           TSK2.E (R);
-           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
-      END; -- (D)
- 
-      DECLARE -- (E)
- 
-           R : REC;
- 
-           TASK TSK3 IS
-                ENTRY E (R : OUT SREC);
-           END TSK3;
- 
-           TASK BODY TSK3 IS
-           BEGIN
-                SELECT
-                     ACCEPT E (R : OUT SREC) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
-                                  "TSK3");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TSK3");
-           END TSK3;
- 
-      BEGIN -- (E)
-           TSK3.E (R);
-           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
-      END; -- (E)
- 
-      RESULT;
- 
- END C95085B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,245 ****
- -- C95085C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE
- -- APPROPRIATE CIRCUMSTANCES FOR ARRAY PARAMETERS IN ENTRY CALLS,
- -- NAMELY WHEN THE ACTUAL BOUNDS DON'T MATCH THE FORMAL BOUNDS
- -- (BEFORE THE CALL FOR ALL MODES).
- -- SUBTESTS ARE:
- --      (A) IN MODE, ONE DIMENSION, STATIC AGGREGATE.
- --      (B) IN MODE, TWO DIMENSIONS, DYNAMIC AGGREGATE.
- --      (C) IN MODE, TWO DIMENSIONS, DYNAMIC VARIABLE.
- --      (D) IN OUT MODE, THREE DIMENSIONS, STATIC VARIABLE.
- --      (E) OUT MODE, ONE DIMENSION, DYNAMIC VARIABLE.
- --      (F) IN OUT MODE, NULL STRING AGGREGATE.
- --      (G) IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE (OK CASE).
- --          IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE.
- 
- -- JWC 10/28/85
- -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085C IS
- 
- BEGIN
-      TEST ("C95085C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
-                       "ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
-           SUBTYPE ST IS STRING (1..3);
- 
-           TASK TSK IS
-                ENTRY E (A : ST);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (A : ST) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
-           END TSK;
- 
-      BEGIN -- (A)
- 
-           TSK.E ("AB");
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (A)");
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           SUBTYPE S IS INTEGER RANGE 1..3;
-           TYPE T IS ARRAY (S,S) OF INTEGER;
- 
-           TASK TSK IS
-                ENTRY E (A : T);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (A : T) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
-           END TSK;
- 
-      BEGIN -- (B)
- 
-           TSK.E ((1..3 => (1..IDENT_INT(2) => 0)));
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (B)");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE S IS INTEGER RANGE 1..5;
-           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
-           SUBTYPE ST IS T (1..3,1..3);
-           V : T (1..IDENT_INT(2), 1..3) :=
-                 (1..IDENT_INT(2) => (1..3 => 0));
- 
-           TASK TSK IS
-                ENTRY E (A :ST);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (A :ST) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
-           END TSK;
- 
-      BEGIN -- (C)
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (C)");
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           SUBTYPE S IS INTEGER RANGE 1..5;
-           TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
-                     INTEGER;
-           SUBTYPE ST IS T (1..3, 1..3, 1..3);
-           V : T (1..3, 1..2, 1..3) :=
-                 (1..3 => (1..2 => (1..3 => 0)));
- 
-           TASK TSK IS
-                ENTRY E (A : IN OUT ST);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (A : IN OUT ST) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL - (D)");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
-           END TSK;
- 
-      BEGIN -- (D)
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - (D)");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
- 
-      DECLARE -- (G)
- 
-           SUBTYPE S IS INTEGER RANGE 1..5;
-           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
-           SUBTYPE ST IS T (2..1, 2..1);
-           V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
- 
-           TASK TSK IS
-                ENTRY E (A : IN OUT ST);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (A : IN OUT ST)  DO
-                          COMMENT ("OK CASE CALLED CORRECTLY");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (G)");
-           END TSK;
- 
-      BEGIN -- (G)
- 
-           TSK.E (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
-      END; -- (G)
- 
-      --------------------------------------------------
- 
- 
-      RESULT;
- END C95085C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C95085D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (A) BEFORE CALL, IN MODE, STATIC PRIVATE DISCRIMINANT.
- 
- -- JWC 10/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085D IS
- 
- BEGIN
-      TEST ("C95085D", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2, E3);
-                TYPE T (D : E := E1) IS PRIVATE;
-                TYPE AR IS ARRAY (E1 .. E3) OF INTEGER;
-           PRIVATE
-                TYPE T (D : E := E1) IS
-                     RECORD
-                          I : INTEGER;
-                          A : AR;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE A1 IS A (E3);
-           V : A (E2) := NEW T (E2);
- 
-           TASK TSK IS
-                ENTRY E (X : A1);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : A1) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      ------------------------------------------------
- 
-      RESULT;
- END C95085D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C95085E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (B) BEFORE CALL, IN MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
- 
- -- JWC 10/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085E IS
- 
- BEGIN
-      TEST ("C95085E", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           TYPE T IS ARRAY (BOOLEAN RANGE <>, CHARACTER RANGE <>) OF
-                     INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE A1 IS A (BOOLEAN, 'A'..'C');
-           V : A := NEW T (BOOLEAN, 'A'..IDENT_CHAR('B'));
- 
-           TASK TSK IS
-                ENTRY E (X : A1);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : A1) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-               WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                 FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C95085F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY
- -- WHEN THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (C) BEFORE CALL, IN OUT MODE, STATIC ONE DIMENSIONAL BOUNDS.
- 
- -- JWC 10/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085F IS
- 
- BEGIN
-      TEST ("C95085F", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           TYPE A IS ACCESS STRING;
-           SUBTYPE A1 IS A (1..3);
-           V : A (2..4) := NEW STRING (2..4);
- 
-           TASK TSK IS
-                ENTRY E (X : IN OUT A1);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : IN OUT A1) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C95085G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (D) BEFORE CALL, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
- 
- -- JWC 10/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085G IS
- 
- BEGIN
-      TEST ("C95085G", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           SUBTYPE INT IS INTEGER RANGE 0..10;
-           TYPE T (C : CHARACTER := 'A';
-                   B : BOOLEAN := FALSE;
-                   I : INT := 0) IS
-                RECORD
-                     J : INTEGER;
-                     CASE B IS
-                          WHEN FALSE =>
-                               K : INTEGER;
-                          WHEN TRUE =>
-                               S : STRING (1 .. I);
-                     END CASE;
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A ('Z', TRUE, 5);
-           V : A := NEW T ('Z', IDENT_BOOL(FALSE), 5);
- 
-           TASK TSK IS
-                ENTRY E (X : IN OUT SA);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : IN OUT SA) DO
-                          FAILED ("EXCEPTION NOT RAISED ON CALL");
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                      FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- C95085H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (E) AFTER RETURN, IN OUT MODE, STATIC LIMITED PRIVATE
- --           DISCRIMINANTS.
- 
- -- JWC 10/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085H IS
- 
- BEGIN
-      TEST ("C95085H", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           PACKAGE PKG IS
-                SUBTYPE INT IS INTEGER RANGE 0..10;
-                SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'C';
-                TYPE T (I : INT := 0; C : CHAR := 'A') IS
-                     LIMITED PRIVATE;
-           PRIVATE
-                TYPE T (I : INT := 0; C : CHAR := 'A') IS
-                     RECORD
-                          J : INTEGER;
-                          CASE C IS
-                               WHEN 'A' =>
-                                    K : INTEGER;
-                               WHEN 'B' =>
-                                    S : STRING (1..I);
-                               WHEN OTHERS =>
-                                    NULL;
-                          END CASE;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
- 
-           V : A (2,'B') := NEW T (2,'B');
- 
-           TASK TSK IS
-                ENTRY E (X : IN OUT A);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : IN OUT A) DO
-                          CALLED := TRUE;
-                          X := NEW T (2,'A');
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C95085I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (F) AFTER RETURN, IN OUT MODE, DYNAMIC THREE DIMENSIONAL
- --           BOUNDS.
- 
- -- JWC 10/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085I IS
- 
- BEGIN
-      TEST ("C95085I", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           TYPE E IS (E1, E2, E3);
- 
-           TYPE T IS ARRAY (CHARACTER RANGE <>,
-                            E RANGE <>,
-                            BOOLEAN RANGE <>
-                           ) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
- 
-           V : A ('A'..'Z', E1..E2, BOOLEAN) :=
-                     NEW T ('A'..'Z', E1..E2, BOOLEAN);
- 
-           TASK TSK IS
-                ENTRY E (X : IN OUT A);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : IN OUT A) DO
-                          CALLED := TRUE;
-                          IF EQUAL (3,3) THEN
-                               X := NEW T ('A'..'Z', E2..E3, BOOLEAN);
-                          END IF;
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C95085J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (G) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, STATIC ONE
- --           DIMENSIONAL BOUNDS.
- 
- -- JWC 10/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085J IS
- 
- BEGIN
-      TEST ("C95085J", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           TYPE A IS ACCESS STRING;
- 
-           V : A (1..3) := NEW STRING (1..3);
- 
-           TASK TSK IS
-                ENTRY E (X : OUT A);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : OUT A) DO
-                          CALLED := TRUE;
-                          X := NEW STRING (2..3);
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-               WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C95085K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (H) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, DYNAMIC
- --           RECORD DISCRIMINANT.
- 
- -- JWC 10/24/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085K IS
- 
- BEGIN
-      TEST ("C95085K", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           TYPE ARR IS ARRAY (BOOLEAN RANGE <>) OF INTEGER;
-           TYPE T (B : BOOLEAN := FALSE) IS
-                RECORD
-                     I : INTEGER;
-                     A : ARR (FALSE..B);
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
- 
-           V : A (IDENT_BOOL(FALSE)) := NEW T (IDENT_BOOL(FALSE));
- 
-           TASK TSK IS
-                ENTRY E (X : OUT A);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : OUT A) DO
-                          CALLED := TRUE;
-                          X := NEW T (TRUE);
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- C95085L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
- -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (I) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, STATIC
- --           PRIVATE DISCRIMINANTS.
- 
- -- JWC 10/24/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085L IS
- 
- BEGIN
-      TEST ("C95085L", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2, E3);
-                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
-                     PRIVATE;
-           PRIVATE
-                TYPE ARR IS ARRAY (E RANGE <>) OF INTEGER;
-                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
-                     RECORD
-                          I : INTEGER;
-                          CASE B IS
-                               WHEN FALSE =>
-                                    J : INTEGER;
-                               WHEN TRUE =>
-                                    A : ARR (E1 .. D);
-                          END CASE;
-                     END RECORD;
-           END PKG;
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (E2, TRUE);
-           V : A (E2, FALSE) := NEW T (E2, FALSE);
- 
-           TASK TSK IS
-                ENTRY E (X : OUT SA);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : OUT SA) DO
-                          CALLED := TRUE;
-                          X := NEW T (E2, TRUE);
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      ------------------------------------------------
- 
-      RESULT;
- END C95085L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- C95085M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
- -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN THE
- -- ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
- -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
- -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
- -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
- 
- --       (J) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, DYNAMIC TWO
- --           DIMENSIONAL BOUNDS.
- 
- -- JWC 10/24/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085M IS
- 
- BEGIN
-      TEST ("C95085M", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
-                       "APPROPRIATELY FOR ACCESS PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           TYPE T IS ARRAY (INTEGER RANGE <>,
-                            CHARACTER RANGE <>) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
- 
-           V : A (1..10, 'A'..'Z') := NEW T (1..10, 'A'..'Z');
- 
-           Y : CONSTANT CHARACTER := IDENT_CHAR('Y');
-           SUBTYPE SA IS A (1..10, 'A'..Y);
- 
-           TASK TSK IS
-                ENTRY E (X : OUT SA);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : OUT SA) DO
-                          CALLED := TRUE;
-                          X := NEW T (1..10, 'A'..IDENT_CHAR('Y'));
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-      BEGIN
- 
-           TSK.E (V);
-           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95085M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085n.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C95085N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED AFTER AN ENTRY CALL FOR THE
- -- CASE OF A PRIVATE TYPE IMPLEMENTED AS A SCALAR TYPE WHERE THE VALUE
- -- OF THE FORMAL PARAMETER DOES NOT BELONG TO THE SUBTYPE OF THE ACTUAL
- -- PARAMETER.
- 
- -- JWC 10/29/85
- -- JRK 1/15/86      ENSURE THAT EXCEPTION RAISED AFTER CALL, NOT BEFORE
- --                  CALL.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085N IS
- 
- BEGIN
-      TEST ("C95085N", "CHECK THAT PRIVATE TYPE (SCALAR) RAISES " &
-                       "CONSTRAINT_ERROR AFTER CALL WHEN FORMAL " &
-                       "PARAMETER VALUE IS NOT IN ACTUAL'S SUBTYPE");
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           PACKAGE P IS
-                TYPE T IS PRIVATE;
-                DC : CONSTANT T;
- 
-                GENERIC PACKAGE PP IS
-                END PP;
-           PRIVATE
-                TYPE T IS NEW INTEGER;
-                DC : CONSTANT T := -1;
-           END P;
- 
-           TASK TSK IS
-                ENTRY E (X : OUT P.T);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : OUT P.T) DO
-                          CALLED := TRUE;
-                          X := P.DC;
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-           GENERIC
-                Y : IN OUT P.T;
-           PACKAGE CALL IS
-           END CALL;
- 
-           PACKAGE BODY CALL IS
-           BEGIN
-                TSK.E (Y);
-                FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END CALL;
- 
-           PACKAGE BODY P IS
-                Z : T RANGE 0..1 := 0;
-                PACKAGE BODY PP IS
-                     PACKAGE CALL_Q IS NEW CALL (Z);
-                END PP;
-           END P;
- 
-      BEGIN
- 
-           BEGIN
-                DECLARE
-                     PACKAGE CALL_Q_NOW IS NEW P.PP;    -- START HERE.
-                BEGIN
-                     NULL;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER INVOKED");
-           END;
- 
-      END;
- 
-      RESULT;
- END C95085N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95085o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95085o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- C95085O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED AFTER AN ENTRY CALL FOR THE
- -- CASE OF A PRIVATE TYPE IMPLEMENTED AS AN ACCESS TYPE WHERE THE VALUE
- -- OF THE FORMAL PARAMETER DOES NOT BELONG TO THE SUBTYPE OF THE ACTUAL
- -- PARAMETER.
- 
- -- JWC 10/30/85
- -- JRK 1/15/86      ENSURE THAT EXCEPTION RAISED AFTER CALL, NOT BEFORE
- --                  CALL.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95085O IS
- 
- BEGIN
- 
-      TEST ("C95085O", "CHECK THAT PRIVATE TYPE (ACCESS) RAISES " &
-                       "CONSTRAINT_ERROR AFTER CALL WHEN FORMAL " &
-                       "PARAMETER VALUE IS NOT IN ACTUAL'S SUBTYPE");
- 
-      DECLARE
- 
-           CALLED : BOOLEAN := FALSE;
- 
-           PACKAGE P IS
-                TYPE T IS PRIVATE;
-                DC : CONSTANT T;
- 
-                GENERIC PACKAGE PP IS
-                END PP;
-           PRIVATE
-                TYPE T IS ACCESS STRING;
-                DC : CONSTANT T := NEW STRING'("AAA");
-           END P;
- 
-           TASK TSK IS
-                ENTRY E (X : IN OUT P.T);
-           END TSK;
- 
-           TASK BODY TSK IS
-           BEGIN
-                SELECT
-                     ACCEPT E (X : IN OUT P.T) DO
-                          CALLED := TRUE;
-                          X := P.DC;
-                     END E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK BODY");
-           END TSK;
- 
-           GENERIC
-                Y : IN OUT P.T;
-           PACKAGE CALL IS
-           END CALL;
- 
-           PACKAGE BODY CALL IS
-           BEGIN
-                TSK.E (Y);
-                FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF NOT CALLED THEN
-                          FAILED ("EXCEPTION RAISED BEFORE CALL");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END CALL;
- 
-           PACKAGE BODY P IS
-                Z : T (1..5) := NEW STRING'("CCCCC");
-                PACKAGE BODY PP IS
-                     PACKAGE CALL_Q IS NEW CALL (Z);
-                END PP;
-           END P;
- 
-      BEGIN
- 
-           BEGIN
-                DECLARE
-                     PACKAGE CALL_Q_NOW IS NEW P.PP;    -- START HERE.
-                BEGIN
-                     NULL;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER INVOKED");
-           END;
- 
-      END;
- 
-      RESULT;
- END C95085O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C95086A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED AT THE TIME OF CALL WHEN
- -- THE VALUE OF AN ACTUAL OUT SCALAR PARAMETER DOES NOT SATISFY THE
- -- RANGE CONSTRAINTS OF THE FORMAL PARAMETER.
- 
- -- GLH 7/16/85
- -- JRK 8/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95086A IS
- 
-      SUBTYPE SUBINT1 IS INTEGER RANGE -10..10;
-      SUBTYPE SUBINT2 IS INTEGER RANGE -20..20;
- 
-      I10  : SUBINT1 := 10;
-      I20  : SUBINT2 := 20;
- 
-      TASK T1 IS
-           ENTRY E1 (I : OUT SUBINT1);
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           LOOP
-                BEGIN
-                     SELECT
-                          ACCEPT E1 (I : OUT SUBINT1) DO
-                               I := SUBINT1'FIRST;
-                          END E1;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED IN ACCEPT E1");
-                END;
-           END LOOP;
-      END T1;
- 
- BEGIN
- 
-      TEST ("C95086A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-                       "AT THE TIME OF CALL WHEN THE VALUE OF AN " &
-                       "ACTUAL OUT SCALAR PARAMETER DOES NOT " &
-                       "SATISFY THE RANGE CONSTRAINTS OF THE FORMAL " &
-                       "PARAMETER");
- 
-      BEGIN
-           T1.E1 (SUBINT1(I20));
-           IF I20 /= IDENT_INT (-10) THEN
-                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 1");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED ON CALL TO E1 - 1");
-      END;
- 
-      BEGIN
-           I20 := IDENT_INT (20);
-           T1.E1 (I20);
-           IF I20 /= IDENT_INT (-10) THEN
-                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 2");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED ON CALL TO E1 - 2");
-      END;
- 
-      RESULT;
- 
- END C95086A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,202 ****
- -- C95086B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
- --   BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS
- --   PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT
- --   FROM THE FORMAL PARAMETER.
- --
- --   SUBTESTS ARE:
- --       (A) IN MODE, STATIC ONE DIMENSIONAL BOUNDS.
- --       (B) IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
- --       (C) CASE (A), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
- --       (D) CASE (B), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
- 
- -- RJW 1/27/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95086B IS
- 
- BEGIN
-      TEST ( "C95086B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-             "BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL " &
-             "ACCESS PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS " &
-             "DIFFERENT FROM THE FORMAL PARAMETER" );
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           TYPE E IS (E1, E2, E3, E4);
-           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (E2..E4);
-           V : A (E1..E2) := NULL;
- 
-           TASK T1 IS
-                ENTRY P (X : SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : SA);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED IN TASK - (A)" );
-           END T1;
- 
-      BEGIN -- (A)
- 
-           T1.P (V);
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - (A)" );
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
- 
-           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN FALSE =>
-                               J : INTEGER;
-                          WHEN TRUE =>
-                               A : ARR ('A' .. C);
-                     END CASE;
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (TRUE, 'C');
-           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
- 
-           TASK T1 IS
-                ENTRY P (X : IN OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : IN OUT SA) DO
-                     NULL;
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED IN TASK - (B)" );
-           END T1;
- 
-      BEGIN -- (B)
- 
-           T1.P (V);
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - (B)" );
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           TYPE E IS (E1, E2, E3, E4);
-           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (E2..E4);
-           V : A (E1..E2) := NULL;
- 
-           TASK T1 IS
-                ENTRY P (X : SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : SA) DO
-                     NULL;
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED IN TASK - (C)" );
-           END T1;
- 
-      BEGIN -- (C)
- 
-           T1.P (SA(V));
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - (C)" );
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
- 
-           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
-                RECORD
-                     I : INTEGER;
-                     CASE B IS
-                          WHEN FALSE =>
-                               J : INTEGER;
-                          WHEN TRUE =>
-                               A : ARR ('A' .. C);
-                     END CASE;
-                END RECORD;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (TRUE, 'C');
-           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
- 
-           TASK T1 IS
-                ENTRY P (X : IN OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : IN OUT SA);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED IN TASK - (D)" );
-           END T1;
- 
-      BEGIN -- (D)
- 
-           T1.P (SA(V));
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ( "EXCEPTION RAISED - (D)" );
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95086B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,250 ****
- -- C95086C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
- --   AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL
- --   ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS
- --   DIFFERENT CONSTRAINTS.
- --
- --   SUBTESTS ARE:
- --       (A) IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
- --       (B) OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
- --       (C) SAME AS (A), WITH TYPE CONVERSION.
- --       (D) SAME AS (B), WITH TYPE CONVERSION.
- 
- -- RJW 1/29/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95086C IS
- 
- BEGIN
-      TEST ("C95086C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-            "AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL " &
-            "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
-            "DIFFERENT CONSTRAINTS" );
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2);
-                TYPE T (D : E := E1) IS PRIVATE;
-           PRIVATE
-                TYPE T (D : E := E1) IS
-                     RECORD
-                          I : INTEGER;
-                          CASE D IS
-                               WHEN E1 =>
-                                    B : BOOLEAN;
-                               WHEN E2 =>
-                                    C : CHARACTER;
-                          END CASE;
-                     END RECORD;
-           END PKG;
- 
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (E2);
-           V : A (E1) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           TASK T1 IS
-                ENTRY P (X : IN OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : IN OUT SA) DO
-                     ENTERED := TRUE;
-                     X := NULL;
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
-           END T1;
- 
-      BEGIN -- (A)
- 
-           T1.P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (A)");
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
-                     INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
-           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
-                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           TASK T1 IS
-                ENTRY P (X : OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : OUT SA) DO
-                     ENTERED := TRUE;
-                     X := NULL;
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
-           END T1;
- 
-      BEGIN -- (B)
- 
-           T1.P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (B)");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (C)
- 
-           PACKAGE PKG IS
-                TYPE E IS (E1, E2);
-                TYPE T (D : E := E1) IS PRIVATE;
-           PRIVATE
-                TYPE T (D : E := E1) IS
-                     RECORD
-                          I : INTEGER;
-                          CASE D IS
-                               WHEN E1 =>
-                                    B : BOOLEAN;
-                               WHEN E2 =>
-                                    C : CHARACTER;
-                          END CASE;
-                     END RECORD;
-           END PKG;
- 
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (E2);
-           V : A (E1) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           TASK T1 IS
-                ENTRY P (X : IN OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : IN OUT SA) DO
-                     ENTERED := TRUE;
-                     X := NULL;
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
-           END T1;
- 
-      BEGIN -- (C)
- 
-           T1.P (SA(V));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (C)");
-      END; -- (C)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (D)
- 
-           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
-                     INTEGER;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
-           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
-                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
-           ENTERED : BOOLEAN := FALSE;
- 
-           TASK T1 IS
-                ENTRY P (X : OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : OUT SA) DO
-                     ENTERED := TRUE;
-                     X := NULL;
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
-           END T1;
- 
-      BEGIN -- (D)
- 
-           T1.P (SA(V));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT ENTERED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (D)");
-      END; -- (D)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95086C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- C95086D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
- --    BEFORE OR AFTER THE ENTRY CALL, WHEN AN UNCONSTRAINED ACTUAL
- --    OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE
- --    ENTRY CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL
- --    PARAMETER.
- --
- --   SUBTESTS ARE:
- --       (A) STATIC LIMITED PRIVATE DISCRIMINANT.
- --       (B) DYNAMIC ONE DIMENSIONAL BOUNDS.
- 
- -- RJW 2/3/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95086D IS
- 
- BEGIN
-      TEST ("C95086D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-            "BEFORE AND AFTER THE ENTRY CALL, WHEN AN UNCONSTRAINED " &
-            "ACTUAL OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR " &
-            "TO THE ENTRY CALL) WITH CONSTRAINTS DIFFERENT FROM THE " &
-            "FORMAL PARAMETER");
- 
-      --------------------------------------------------
- 
-      DECLARE -- (A)
- 
-           PACKAGE PKG IS
-                SUBTYPE INT IS INTEGER RANGE 0..5;
-                TYPE T (I : INT := 0) IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-                TYPE T (I : INT := 0) IS
-                     RECORD
-                          J : INTEGER;
-                          A : ARR (1..I);
-                     END RECORD;
-           END PKG;
- 
-           USE PKG;
- 
-           TYPE A IS ACCESS T;
-           SUBTYPE SA IS A (3);
-           V : A := NEW T (2);
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T1 IS
-                ENTRY P (X : OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : OUT SA) DO
-                     CALLED := TRUE;
-                     X := NEW T (3);
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
-           END T1;
- 
-      BEGIN -- (A)
- 
-           T1.P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (A)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (A)");
-      END; -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE -- (B)
- 
-           TYPE A IS ACCESS STRING;
-           SUBTYPE SA IS A (1..2);
-           V : A := NEW STRING (IDENT_INT(5) .. IDENT_INT(7));
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T1 IS
-                ENTRY P (X : OUT SA);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT P (X : OUT SA) DO
-                     CALLED := TRUE;
-                     X := NEW STRING (IDENT_INT(1) .. IDENT_INT(2));
-                END P;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
-           END T1;
- 
-      BEGIN -- (B)
- 
-           T1.P (V);
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (B)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (B)");
-      END; -- (B)
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95086D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,282 ****
- -- C95086E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED BEFORE OR AFTER THE ENTRY
- -- CALL FOR IN OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
- -- FORM OF A TYPE CONVERSION.  THE FOLLOWING CASES ARE TESTED:
- --   (A) OK CASE.
- --   (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
- --       COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
- --       FORMAL INDEX SUBTYPE.
- --   (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
- --       COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
- --       ARRAYS.
- --   (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
- --       FORMAL INDEX SUBTYPE.
- --   (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
- --       FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
- 
- -- RJW 2/3/86
- -- TMB 11/15/95 ELIMINATED INCOMPATIBILITY WITH ADA95
- -- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95086E IS
- 
- BEGIN
-      TEST ("C95086E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-            "BEFORE OR AFTER THE ENTRY CALL FOR IN OUT ARRAY " &
-            "PARAMETERS, WITH THE ACTUAL HAVING THE FORM OF A TYPE " &
-            "CONVERSION");
- 
-      ---------------------------------------------
- 
-      DECLARE -- (A)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..5;
-           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
-                OF BOOLEAN;
-           SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
-           SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
-           AR : ACTUAL := (1..3 => (1..3 => TRUE));
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : IN OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : IN OUT FORMAL) DO
-                     CALLED := TRUE;
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
-           END T;
- 
-      BEGIN -- (A)
- 
-           T.E (FORMAL (AR));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (A)");
-      END; -- (A)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (B)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..3;
-           TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
-           TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
-           AR : ACTUAL := (3..5 => (3..5 => FALSE));
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : IN OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : IN OUT FORMAL) DO
-                     CALLED := TRUE;
-                     X(3, 3) := TRUE;
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
-           END T;
- 
-      BEGIN -- (B)
- 
-           T.E (FORMAL (AR));
-           IF AR(5, 5) /= TRUE THEN
-                FAILED ("INCORRECT RETURNED VALUE - (B)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (B)");
-      END; -- (B)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..5;
-           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
-                OF CHARACTER;
-           SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
-           AR : ARRAY_TYPE (2..1, 1..3) := (2..1 => (1..3 => ' '));
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : IN OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : IN OUT FORMAL) DO
-                     IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
-                          FAILED ("WRONG BOUNDS PASSED - (C)");
-                     END IF;
-                     CALLED := TRUE;
-                     X := (2..0 => (1..3 => 'A'));
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
-           END T;
- 
-      BEGIN -- (C)
- 
-           T.E (FORMAL (AR));
-           IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
-                FAILED ("BOUNDS CHANGED - (C)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (C)");
-      END; -- (C)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (D)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..3;
-           TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
-                OF CHARACTER;
-           TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
-           AR : ACTUAL := (3..5 => (5..3 => ' '));
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : IN OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : IN OUT FORMAL) DO
-                     IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
-                          FAILED ("WRONG BOUNDS PASSED - (D)");
-                     END IF;
-                     CALLED := TRUE;
-                     X := (1..3 => (3..1 => 'A'));
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
-           END T;
- 
-      BEGIN -- (D)
- 
-           T.E (FORMAL (AR));
-           IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
-                FAILED ("BOUNDS CHANGED - (D)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (D)");
-      END; -- (D)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (E)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..3;
-           TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
-                OF CHARACTER;
-           TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
-                                 POSITIVE RANGE 1..3) OF CHARACTER;
-           AR : ACTUAL := (5..2 => (1..3 => ' '));
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : IN OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : IN OUT FORMAL) DO
-                     IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
-                          FAILED ("WRONG BOUNDS PASSED - (E)");
-                     END IF;
-                     CALLED := TRUE;
-                     X := (3..1 => (1..3 => ' '));
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (E)");
-           END T;
- 
-      BEGIN -- (E)
- 
-           T.E (FORMAL (AR));
-           IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
-                FAILED ("BOUNDS CHANGED - (E)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (E)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (E)");
-      END; -- (E)
- 
-      ---------------------------------------------
- 
-      RESULT;
- END C95086E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95086f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95086f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,282 ****
- -- C95086F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED BEFORE OR AFTER THE ENTRY
- -- CALL FOR OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
- -- FORM OF A TYPE CONVERSION.  THE FOLLOWING CASES ARE TESTED:
- --   (A) OK CASE.
- --   (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
- --       COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
- --       FORMAL INDEX SUBTYPE.
- --   (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
- --       COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
- --       ARRAYS.
- --   (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
- --       FORMAL INDEX SUBTYPE.
- --   (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
- --       FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
- 
- -- RJW 2/3/86
- -- TMB 11/15/95 FIXED INCOMPATIBILITIES WITH ADA95
- -- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95086F IS
- 
- BEGIN
-      TEST ("C95086F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
-            "BEFORE OR AFTER THE ENTRY CALL FOR OUT ARRAY PARAMETERS, " &
-            "WITH THE ACTUAL HAVING THE FORM OF A TYPE CONVERSION");
- 
-      ---------------------------------------------
- 
-      DECLARE -- (A)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..5;
-           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
-                OF BOOLEAN;
-           SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
-           SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
-           AR : ACTUAL;
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : OUT FORMAL) DO
-                     CALLED := TRUE;
-                     X := (1..3 => (1..3 => TRUE));
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
-           END T;
- 
-      BEGIN -- (A)
- 
-           T.E (FORMAL (AR));
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (A)");
-      END; -- (A)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (B)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..3;
-           TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
-           TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
-           AR : ACTUAL;
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : OUT FORMAL) DO
-                     CALLED := TRUE;
-                     X(3, 3) := TRUE;
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
-           END T;
- 
-      BEGIN -- (B)
- 
-           T.E (FORMAL (AR));
-           IF AR(5, 5) /= TRUE THEN
-                FAILED ("INCORRECT RETURNED VALUE - (B)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (B)");
-      END; -- (B)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (C)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..5;
-           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
-                OF CHARACTER;
-           SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
-           AR : ARRAY_TYPE (2..1, 1..3);
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : OUT FORMAL) DO
-                     IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
-                          FAILED ("WRONG BOUNDS PASSED - (C)");
-                     END IF;
-                     CALLED := TRUE;
-                     X := (2..0 => (1..3 => 'A'));
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
-           END T;
- 
-      BEGIN -- (C)
- 
-           T.E (FORMAL (AR));
-           IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
-                FAILED ("BOUNDS CHANGED - (C)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (C)");
-      END; -- (C)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (D)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..3;
-           TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
-                OF CHARACTER;
-           TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
-           AR : ACTUAL;
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : OUT FORMAL) DO
-                     IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
-                          FAILED ("WRONG BOUNDS PASSED - (D)");
-                     END IF;
-                     CALLED := TRUE;
-                     X := (1..3 => (3..1 => 'A'));
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
-           END T;
- 
-      BEGIN -- (D)
- 
-           T.E (FORMAL (AR));
-           IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
-                FAILED ("BOUNDS CHANGED - (D)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (D)");
-      END; -- (D)
- 
-      ---------------------------------------------
- 
-      DECLARE -- (E)
- 
-           SUBTYPE INDEX IS INTEGER RANGE 1..3;
-           TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
-                OF CHARACTER;
-           TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
-                                 POSITIVE RANGE 1..3) OF CHARACTER;
-           AR : ACTUAL;
-           CALLED : BOOLEAN := FALSE;
- 
-           TASK T IS
-                ENTRY E (X : OUT FORMAL);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (X : OUT FORMAL) DO
-                     IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
-                          FAILED ("WRONG BOUNDS PASSED - (E)");
-                     END IF;
-                     CALLED := TRUE;
-                     X := (3..1 => (1..3 => ' ' ));
-                END E;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TASK - (E)");
-           END T;
- 
-      BEGIN -- (E)
- 
-           T.E (FORMAL (AR));
-           IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
-                FAILED ("BOUNDS CHANGED - (E)");
-           END IF;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                IF NOT CALLED THEN
-                     FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
-                ELSE
-                     FAILED ("EXCEPTION RAISED ON RETURN - (E)");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (E)");
-      END; -- (E)
- 
-      ---------------------------------------------
- 
-      RESULT;
- END C95086F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,412 ****
- -- C95087A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
- --   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
- --   SUBTESTS ARE:
- --        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
- --        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
- --        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
- --        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
- 
- -- GLH  7/19/85
- -- JRK 8/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95087A IS
- 
- BEGIN
-      TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
-                       "UNCONSTRAINED FORMAL PARAMETERS");
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-               SUBTYPE INT IS INTEGER RANGE 0..100;
- 
-               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     RECORD
-                          INTFIELD : INTEGER;
-                          STRFIELD : STRING (1..CONSTRAINT);
-                     END RECORD;
- 
-                REC1 : RECTYPE := (10,10,"0123456789");
-                REC2 : RECTYPE := (17,7,"C95087A..........");
-                REC3 : RECTYPE := (1,1,"A");
-                REC4 : RECTYPE;  -- 80.
- 
-                TASK T1 IS
-                     ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB");
-                               REC2 : OUT RECTYPE;
-                               REC3 : IN OUT RECTYPE);
-                END T1;
- 
-                TASK T2 IS
-                     ENTRY E2 (REC : OUT RECTYPE);
-                END T2;
-           END PKG;
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T1 IS
-                BEGIN
-                     ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB");
-                                REC2 : OUT RECTYPE;
-                                REC3 : IN OUT RECTYPE) DO
- 
-                          IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
-                               FAILED ("RECORD TYPE IN PARAMETER " &
-                                       "DID NOT USE CONSTRAINT " &
-                                       "OF ACTUAL");
-                          END IF;
-                          IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
-                               FAILED ("RECORD TYPE OUT " &
-                                       "PARAMETER DID NOT USE " &
-                                       "CONSTRAINT OF ACTUAL");
-                          END IF;
-                          IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
-                               FAILED ("RECORD TYPE IN OUT " &
-                                       "PARAMETER DID NOT USE " &
-                                       "CONSTRAINT OF ACTUAL");
-                          END IF;
-                          REC2 := PKG.REC2;
-                     END E1;
-                END T1;
- 
-                TASK BODY T2 IS
-                BEGIN
-                     ACCEPT E2 (REC : OUT RECTYPE) DO
-                          IF REC.CONSTRAINT /= IDENT_INT (80) THEN
-                               FAILED ("RECORD TYPE OUT " &
-                                       "PARAMETER DID " &
-                                       "NOT USE CONSTRAINT OF " &
-                                       "UNINITIALIZED ACTUAL");
-                          END IF;
-                          REC := (10,10,"9876543210");
-                     END E2;
-                END T2;
-           END PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3);
-           PKG.T2.E2 (PKG.REC4);
- 
-      END;   -- (A)
- 
-      ---------------------------------------------
- 
- B :  DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INT IS INTEGER RANGE 0..100;
- 
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
- 
- 
-                TASK T1 IS
-                     ENTRY E1 (REC1 : IN RECTYPE;
-                               REC2 : OUT RECTYPE;
-                               REC3 : IN OUT RECTYPE);
-                END T1;
- 
-                TASK T2 IS
-                     ENTRY E2  (REC : OUT RECTYPE);
-                END T2;
- 
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     RECORD
-                          INTFIELD : INTEGER;
-                          STRFIELD : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC1 : PKG.RECTYPE (10);
-           REC2 : PKG.RECTYPE (17);
-           REC3 : PKG.RECTYPE (1);
-           REC4 : PKG.RECTYPE (10);
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T1 IS
-                BEGIN
-                     ACCEPT E1 (REC1 : IN RECTYPE;
-                                REC2 : OUT RECTYPE;
-                                REC3 : IN OUT RECTYPE) DO
-                          IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
-                               FAILED ("PRIVATE TYPE IN " &
-                                       "PARAMETER DID " &
-                                       "NOT USE CONSTRAINT OF " &
-                                       "ACTUAL");
-                          END IF;
-                          IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
-                               FAILED ("PRIVATE TYPE OUT " &
-                                       "PARAMETER DID " &
-                                       "NOT USE CONSTRAINT OF " &
-                                       "ACTUAL");
-                          END IF;
-                          IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
-                               FAILED ("PRIVATE TYPE IN OUT " &
-                                       "PARAMETER DID " &
-                                       "NOT USE CONSTRAINT OF " &
-                                       "ACTUAL");
-                          END IF;
-                          REC2 := B.REC2;
-                     END E1;
-                END T1;
- 
-                TASK BODY T2 IS
-                BEGIN
-                     ACCEPT E2 (REC : OUT RECTYPE) DO
-                          IF REC.CONSTRAINT /= IDENT_INT (10) THEN
-                               FAILED ("PRIVATE TYPE OUT " &
-                                       "PARAMETER DID " &
-                                       "NOT USE CONSTRAINT OF " &
-                                       "UNINITIALIZED ACTUAL");
-                          END IF;
-                          REC := (10,10,"9876543210");
-                     END E2;
-                END T2;
- 
-           BEGIN
-                REC1 := (10,10,"0123456789");
-                REC2 := (17,7,"C95087A..........");
-                REC3 := (1,1,"A");
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.T1.E1 (REC1, REC2, REC3);
-           PKG.T2.E2 (REC4);
- 
-      END B;  -- (B)
- 
-      ---------------------------------------------
- 
- C :  DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INT IS INTEGER RANGE 0..100;
- 
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     LIMITED PRIVATE;
- 
-                TASK T1 IS
-                     ENTRY E1 (REC1 : IN RECTYPE;
-                               REC2 : OUT RECTYPE;
-                               REC3 : IN OUT RECTYPE);
-                END T1;
- 
-                TASK T2 IS
-                     ENTRY E2 (REC : OUT RECTYPE);
-                END T2;
- 
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
-                     RECORD
-                          INTFIELD : INTEGER;
-                          STRFIELD : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC1 : PKG.RECTYPE;     -- 10.
-           REC2 : PKG.RECTYPE;     -- 17.
-           REC3 : PKG.RECTYPE;     --  1.
-           REC4 : PKG.RECTYPE;     -- 80.
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T1 IS
-                BEGIN
-                     ACCEPT E1 (REC1 : IN RECTYPE;
-                                REC2 : OUT RECTYPE;
-                                REC3 : IN OUT RECTYPE) DO
-                          IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
-                               FAILED ("LIMITED PRIVATE TYPE IN " &
-                                       "PARAMETER DID NOT USE " &
-                                       "CONSTRAINT OF ACTUAL");
-                          END IF;
-                          IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
-                               FAILED ("LIMITED PRIVATE TYPE OUT " &
-                                       "PARAMETER DID NOT USE " &
-                                       "CONSTRAINT OF " &
-                                       "ACTUAL");
-                          END IF;
-                          IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
-                               FAILED ("LIMITED PRIVATE TYPE IN " &
-                                       "OUT PARAMETER DID NOT " &
-                                       "USE CONSTRAINT OF ACTUAL");
-                          END IF;
-                          REC2 := C.REC2;
-                     END E1;
-                END T1;
- 
-                TASK BODY T2 IS
-                BEGIN
-                     ACCEPT E2 (REC : OUT RECTYPE) DO
-                          IF REC.CONSTRAINT /= IDENT_INT (80) THEN
-                               FAILED ("LIMITED PRIVATE TYPE OUT " &
-                                       "PARAMETER DID NOT USE " &
-                                       "CONSTRAINT OF UNINITIALIZED " &
-                                       "ACTUAL");
-                          END IF;
-                          REC := (10,10,"9876543210");
-                     END E2;
-                END T2;
- 
-           BEGIN
-                REC1 := (10,10,"0123456789");
-                REC2 := (17,7,"C95087A..........");
-                REC3 := (1,1,"A");
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.T1.E1 (REC1, REC2, REC3);
-           PKG.T2.E2 (REC4);
- 
-      END C;   -- (C)
- 
-      ---------------------------------------------
- 
- D :  DECLARE  -- (D)
- 
-           TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
-                CHARACTER;
- 
-           A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'),
-                                                ('C','D'),
-                                                ('E','F'));
- 
-           A4  : ATYPE (-1..1, 4..5);
- 
-           CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) :=
-                                (8..9 => (-7..INTEGER'FIRST => 'A'));
- 
-           S1  : STRING (1..INTEGER'FIRST) := "";
-           S2  : STRING (-5..-7)           := "";
-           S3  : STRING (1..0)             := "";
- 
-           TASK T1 IS
-                ENTRY E1 (A1 : IN ATYPE := CA1;
-                          A2 : OUT ATYPE;
-                          A3 : IN OUT ATYPE);
-           END T1;
- 
-           TASK T2 IS
-                ENTRY E2 (A4 : OUT ATYPE);
-           END T2;
- 
-           TASK T3 IS
-                ENTRY E3 (S1 : IN STRING;
-                          S2 : IN OUT STRING;
-                          S3 : OUT STRING);
-           END T3;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
-                           A3 : IN OUT ATYPE) DO
-                     IF A1'FIRST(1) /= IDENT_INT (-1) OR
-                        A1'LAST(1)  /= IDENT_INT (1)  OR
-                        A1'FIRST(2) /= IDENT_INT (4)  OR
-                        A1'LAST(2)  /= IDENT_INT (5)  THEN
-                          FAILED ("ARRAY TYPE IN PARAMETER DID " &
-                                  "NOT USE CONSTRAINTS OF ACTUAL");
-                     END IF;
-                     IF A2'FIRST(1) /= IDENT_INT (-1) OR
-                        A2'LAST(1)  /= IDENT_INT (1)  OR
-                        A2'FIRST(2) /= IDENT_INT (4)  OR
-                        A2'LAST(2)  /= IDENT_INT (5)  THEN
-                          FAILED ("ARRAY TYPE OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINTS OF ACTUAL");
-                     END IF;
-                     IF A3'FIRST(1) /= IDENT_INT (-1) OR
-                        A3'LAST(1)  /= IDENT_INT (1)  OR
-                        A3'FIRST(2) /= IDENT_INT (4)  OR
-                        A3'LAST(2)  /= IDENT_INT (5)  THEN
-                          FAILED ("ARRAY TYPE IN OUT PARAMETER " &
-                                  "DID NOT USE CONSTRAINTS OF " &
-                                  "ACTUAL");
-                     END IF;
-                     A2 := D.A2;
-                END E1;
-           END T1;
- 
-           TASK BODY T2 IS
-           BEGIN
-                ACCEPT E2 (A4 : OUT ATYPE) DO
-                     IF A4'FIRST(1) /= IDENT_INT (-1) OR
-                        A4'LAST(1)  /= IDENT_INT (1)  OR
-                        A4'FIRST(2) /= IDENT_INT (4)  OR
-                        A4'LAST(2)  /= IDENT_INT (5)  THEN
-                          FAILED ("ARRAY TYPE OUT PARAMETER DID " &
-                                  "NOT USE CONSTRAINTS OF " &
-                                  "UNINITIALIZED ACTUAL");
-                     END IF;
-                     A4 := A2;
-                END E2;
-           END T2;
- 
-           TASK BODY T3 IS
-           BEGIN
-                ACCEPT E3 (S1 : IN STRING;
-                           S2 : IN OUT STRING;
-                           S3 : OUT STRING) DO
-                     IF S1'FIRST /= IDENT_INT (1) OR
-                        S1'LAST  /= IDENT_INT (INTEGER'FIRST) THEN
-                          FAILED ("STRING TYPE IN PARAMETER DID " &
-                                  "NOT USE CONSTRAINTS OF ACTUAL " &
-                                  "NULL STRING");
-                     END IF;
-                     IF S2'FIRST /= IDENT_INT (-5) OR
-                        S2'LAST  /= IDENT_INT (-7) THEN
-                          FAILED ("STRING TYPE IN OUT PARAMETER " &
-                                  "DID NOT USE CONSTRAINTS OF " &
-                                  "ACTUAL NULL STRING");
-                     END IF;
-                     IF S3'FIRST /= IDENT_INT (1) OR
-                        S3'LAST  /= IDENT_INT (0) THEN
-                          FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
-                                  "USE CONSTRAINTS OF ACTUAL NULL " &
-                                  "STRING");
-                     END IF;
-                     S3 := "";
-                END E3;
-           END T3;
- 
-      BEGIN  -- (D)
- 
-           T1.E1 (A1, A2, A3);
-           T2.E2 (A4);
-           T3.E3 (S1, S2, S3);
- 
-      END D;  -- (D)
- 
-      RESULT;
- END C95087A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- C95087B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
- --   RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT
- --   CONSTRAINTS RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE
- --   THE CONSTRAINT OF THE ACTUAL PARAMETER.
- --   SUBTESTS ARE:
- --        (A) RECORD TYPE.
- --        (B) PRIVATE TYPE.
- --        (C) LIMITED PRIVATE TYPE.
- 
- -- RJW  1/10/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95087B IS
- 
- BEGIN
- 
-      TEST ( "C95087B", "CHECK ASSIGNMENT TO ENTRY FORMAL PARAMETERS " &
-                        "OF UNCONSTRAINED TYPE (WITH NO DEFAULT)" );
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
- 
-                TASK T IS
-                     ENTRY E (REC9 : OUT RECTYPE;
-                              REC6 : IN OUT RECTYPE);
-                END T;
- 
-           END PKG;
- 
-           REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
-                  (IDENT_INT(9), 9, "123456789");
-           REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
-                  (IDENT_INT(6), 5, "AEIOUY");
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
- 
-                     REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
-                            (IDENT_INT(4), 4, "OOPS");
- 
-                BEGIN
-                     ACCEPT E (REC9 : OUT RECTYPE;
-                               REC6 : IN OUT RECTYPE) DO
- 
-                          BEGIN  -- (A.1)
-                               REC9 := REC6;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
-                                       "- A.1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED " &
-                                            "- A.1");
-                          END;   -- (A.1)
- 
-                          BEGIN  -- (A.2)
-                               REC6 := REC4;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
-                                       "- A.2");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED " &
-                                            "- A.2");
-                          END;   -- (A.2)
- 
-                          REC9 := (IDENT_INT(9), 9, "987654321");
- 
-                     END E;
-                END T;
-           END PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.T.E (REC9, REC6);
- 
-           IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
-                FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
-           END IF;
- 
-      END;   -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
- 
-                TASK T IS
-                     ENTRY  E (REC9 : OUT RECTYPE;
-                               REC6 : IN OUT RECTYPE);
-                END T;
- 
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC9 : PKG.RECTYPE(9);
-           REC6 : PKG.RECTYPE(6);
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
- 
-                     REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
- 
-                BEGIN
-                     ACCEPT E (REC9 : OUT RECTYPE;
-                               REC6 : IN OUT RECTYPE) DO
- 
-                          BEGIN  -- (B.1)
-                               REC9 := REC6;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
-                                       "- B.1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED " &
-                                            "- B.1");
-                          END;   -- (B.1)
- 
-                          BEGIN  -- (B.2)
-                               REC6 := REC4;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
-                                       "- B.2");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED " &
-                                            "- B.2");
-                          END;   -- (B.2)
- 
-                     END E;
-                END T;
- 
-           BEGIN
-                REC9 := (9, 9, "123456789");
-                REC6 := (6, 5, "AEIOUY");
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.T.E (REC9, REC6);
- 
-      END;   -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
- 
-                TASK T IS
-                     ENTRY  E (REC9 : OUT RECTYPE;
-                               REC6 : IN OUT RECTYPE);
-                END T;
- 
-           PRIVATE
-                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
-                     RECORD
-                          INTFIELD  : INTEGER;
-                          STRFIELD  : STRING (1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC6 : PKG.RECTYPE(IDENT_INT(6));
-           REC9 : PKG.RECTYPE(IDENT_INT(9));
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
- 
-                     REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
- 
-                BEGIN
-                     ACCEPT E (REC9 : OUT RECTYPE;
-                               REC6 : IN OUT RECTYPE) DO
- 
-                          BEGIN  -- (C.1)
-                               REC9 := REC6;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
-                                       "- C.1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED " &
-                                            "- C.1");
-                          END;   -- (C.1)
- 
-                          BEGIN  -- (C.2)
-                               REC6 := REC4;
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
-                                       "- C.2");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ("WRONG EXCEPTION RAISED " &
-                                            "- C.2");
-                          END;   -- (C.2)
- 
-                     END E;
-                END T;
- 
-           BEGIN
-                REC6 := (6, 5, "AEIOUY");
-                REC9 := (9, 9, "123456789");
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.T.E (REC9, REC6);
- 
-      END;   -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C95087B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,299 ****
- -- C95087C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
- --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
- --    CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS
- --    CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING
- --    ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER.
- 
- --    SUBTESTS ARE:
- --        (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
- --        (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
- --        (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
- 
- -- RJW  1/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95087C IS
- 
- BEGIN
- 
-      TEST ( "C95087C", "CHECK ASSIGNMENTS TO ENTRY FORMAL " &
-                        "PARAMETERS OF UNCONSTRAINED TYPES " &
-                        "(WITH DEFAULTS)" );
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
- 
-                REC91,REC92,REC93  : RECTYPE(9);
-                REC_OOPS           : RECTYPE(4);
- 
-                TASK T IS
-                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                              REC3 : OUT RECTYPE);
-                END T;
- 
-           END PKG;
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
-                BEGIN
-                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                               REC3 : OUT RECTYPE) DO
- 
-                          IF (NOT REC1'CONSTRAINED) OR
-                             (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
-                               FAILED ( "CONSTRAINT ON RECORD TYPE " &
-                                        "IN PARAMETER NOT RECOGNIZED" );
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
-                               REC2 := REC_OOPS;
-                               FAILED ( "CONSTRAINT_ERROR NOT " &
-                                        "RAISED - A.1" );
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "WRONG EXCEPTION " &
-                                             "RAISED - A.1" );
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
-                               REC3 := REC_OOPS;
-                               FAILED ( "CONSTRAINT_ERROR NOT " &
-                                        "RAISED - A.2" );
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "WRONG EXCEPTION " &
-                                             "RAISED - A.2" );
-                          END;
- 
-                     END E;
-                END T;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.T.E (PKG.REC91, PKG.REC92, PKG.REC93);
- 
-      END;   -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
- 
-                TASK T IS
-                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                              REC3 : OUT RECTYPE);
-                END T;
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91, REC92, REC93  : PKG.RECTYPE(9);
-           REC_OOPS             : PKG.RECTYPE(4);
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
-                BEGIN
-                      ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                                REC3 : OUT RECTYPE) DO
- 
-                          IF (NOT REC1'CONSTRAINED) OR
-                             (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
-                               FAILED ( "CONSTRAINT ON PRIVATE TYPE " &
-                                        "IN PARAMETER NOT RECOGNIZED" );
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
-                               REC2 := REC_OOPS;
-                               FAILED ( "CONSTRAINT_ERROR NOT " &
-                                        "RAISED - B.1" );
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "WRONG EXCEPTION " &
-                                             "RAISED - B.1" );
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
-                               REC3 := REC_OOPS;
-                               FAILED ( "CONSTRAINT_ERROR NOT " &
-                                        "RAISED - B.2" );
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "WRONG EXCEPTION " &
-                                             "RAISED - B.2" );
-                          END;
- 
-                     END E;
-               END T;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.T.E (REC91, REC92, REC93);
- 
-      END;   -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     LIMITED PRIVATE;
- 
-                TASK T IS
-                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                              REC3 : OUT RECTYPE);
-                END T;
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91,REC92,REC93  : PKG.RECTYPE(9);
-           REC_OOPS           : PKG.RECTYPE(4);
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
-                BEGIN
-                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                               REC3 : OUT RECTYPE) DO
- 
-                          IF (NOT REC1'CONSTRAINED) OR
-                             (REC1.CONSTRAINT /= 9) THEN
-                               FAILED ( "CONSTRAINT ON LIMITED " &
-                                        "PRIVATE TYPE IN PARAMETER " &
-                                        "NOT RECOGNIZED" );
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
-                               REC2 := REC_OOPS;
-                               FAILED ( "CONSTRAINT_ERROR NOT " &
-                                        "RAISED - C.1" );
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "WRONG EXCEPTION " &
-                                             "RAISED - C.1" );
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
-                               REC3 := REC_OOPS;
-                               FAILED ( "CONSTRAINT_ERROR NOT RAISED " &
-                                        "- C.2" );
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR =>
-                                    NULL;
-                               WHEN OTHERS =>
-                                    FAILED ( "WRONG EXCEPTION " &
-                                             "RAISED - C.2" );
-                          END;
- 
-                     END E;
-                END T;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.T.E (REC91, REC92, REC93);
- 
-      END;   -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C95087C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95087d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95087d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,268 ****
- -- C95087D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
- --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
- --    CONSTRAINTS DO NOT RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER
- --    IS UNCONSTRAINED, EVEN IF THE CONSTRAINT VALUES OF THE OBJECT
- --    BEING ASSIGNED ARE DIFFERENT THAN THOSE OF THE ACTUAL PARAMETER.
- 
- --    SUBTESTS ARE:
- --        (A) UNCONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
- --        (B) UNCONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
- --        (C) UNCONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
- 
- -- RJW  1/17/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95087D IS
- 
- BEGIN
- 
-      TEST ( "C95087D", "CHECK ASSIGNMENTS TO ENTRY FORMAL PARAMETERS " &
-                        "OF UNCONSTRAINED TYPES WITH UNCONSTRAINED " &
-                        "ACTUAL PARAMETERS");
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (A)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
- 
-                TASK T IS
-                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                              REC3 : OUT RECTYPE);
-                END T;
- 
-           END PKG;
- 
-           REC91, REC92, REC93 : PKG.RECTYPE :=
-                (IDENT_INT(5), 5, IDENT_STR( "12345"));
-           REC_OOPS            : PKG.RECTYPE;
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
-                BEGIN
-                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                               REC3 : OUT RECTYPE) DO
- 
-                          IF NOT REC1'CONSTRAINED THEN
-                               FAILED ( "REC1 IS NOT CONSTRAINED - A.1");
-                          END IF;
-                          IF REC1.CONSTRAINT /= IDENT_INT(9) THEN
-                               FAILED ( "REC1 CONSTRAINT IS NOT 9 " &
-                                  "- A.1");
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
-                               REC2 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ( "EXCEPTION RAISED - A.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
-                               REC3 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ( "EXCEPTION RAISED - A.2");
-                          END;
- 
-                     END E;
-                END T;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-           USE PKG;
- 
-      BEGIN  -- (A)
- 
-           PKG.T.E  (REC91, REC92, REC93);
-           IF (REC92 /= REC_OOPS) OR (REC93 /= REC_OOPS) THEN
-                FAILED ( "RESULTANT VALUE OF REC92 OR REC93 INCORRECT");
-           END IF;
- 
-      END;   -- (A)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (B)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
- 
-                TASK T IS
-                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                              REC3 : OUT RECTYPE);
-                END T;
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91, REC92, REC93  : PKG.RECTYPE;
-           REC_OOPS             : PKG.RECTYPE;
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
-                BEGIN
-                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                               REC3 : OUT RECTYPE) DO
- 
-                          IF REC3'CONSTRAINED THEN
-                               FAILED ( "REC3 IS CONSTRAINED - B.1");
-                          END IF;
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
-                               REC2 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ( "EXCEPTION RAISED - B.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
-                               REC3 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ( "EXCEPTION RAISED - B.2");
-                          END;
- 
-                     END E;
-                END T;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (B)
- 
-           PKG.T.E (REC91, REC92, REC93);
- 
-      END;   -- (B)
- 
-      --------------------------------------------------
- 
-      DECLARE  -- (C)
- 
-           PACKAGE PKG IS
- 
-                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     LIMITED PRIVATE;
- 
-                TASK T IS
-                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                              REC3 : OUT RECTYPE);
-                END T;
- 
-           PRIVATE
- 
-                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
-                     RECORD
-                          INTFLD   : INTRANGE;
-                          STRFLD   : STRING(1..CONSTRAINT);
-                     END RECORD;
-           END PKG;
- 
-           REC91, REC92, REC93  : PKG.RECTYPE;
-           REC_OOPS             : PKG.RECTYPE;
- 
-           PACKAGE BODY PKG IS
- 
-                TASK BODY T IS
-                BEGIN
-                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
-                               REC3 : OUT RECTYPE) DO
- 
-                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
-                               REC2 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ( "EXCEPTION RAISED - C.1");
-                          END;
- 
-                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
-                               REC3 := REC_OOPS;
-                          EXCEPTION
-                               WHEN OTHERS =>
-                                    FAILED ( "EXCEPTION RAISED - C.2");
-                          END;
- 
-                     END E;
-                END T;
- 
-           BEGIN
- 
-                REC91 := (9, 9, "123456789");
-                REC92 := REC91;
-                REC93 := REC91;
- 
-                REC_OOPS := (4, 4, "OOPS");
- 
-           END PKG;
- 
-      BEGIN  -- (C)
- 
-           PKG.T.E (REC91, REC92, REC93);
- 
-      END;   -- (C)
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C95087D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95088a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95088a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95088a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95088a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- C95088A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ACTUAL PARAMETERS ARE EVALUATED AND IDENTIFIED AT THE
- --   TIME OF CALL.
- 
- -- GLH 7/10/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C95088A IS
- 
-      TYPE VECTOR IS ARRAY (1..10) OF INTEGER;
-      TYPE PTRINT IS ACCESS INTEGER;
- 
-      I    : INTEGER := 1;
-      A    : VECTOR  := (1,2,3,4,5,6,7,8,9,10);
-      P1   : PTRINT  := NEW INTEGER'(2);
-      P2   : PTRINT  := P1;
- 
-      TASK T1 IS
-           ENTRY E1 (I : OUT INTEGER; J : OUT INTEGER);
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           ACCEPT E1 (I : OUT INTEGER; J : OUT INTEGER) DO
-                I := 10;
-                J := -1;
-           END E1;
-      END T1;
- 
-      TASK T2 IS
-           ENTRY E2 (P : OUT PTRINT; I : OUT INTEGER);
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           ACCEPT E2 (P : OUT PTRINT; I : OUT INTEGER) DO
-                P := NEW INTEGER'(3);
-                I := 5;
-           END E2;
-      END T2;
- 
- BEGIN
- 
-      TEST ("C95088A", "CHECK THAT ACTUAL PARAMETERS ARE EVALUATED " &
-                       "AND IDENTIFIED AT THE TIME OF CALL");
- 
-      COMMENT ("FIRST CALL");
-      T1.E1 (I, A(I));
-      IF (A /= (-1,2,3,4,5,6,7,8,9,10)) THEN
-           FAILED ("A(I) EVALUATED UPON RETURN");
-      END IF;
- 
-      COMMENT ("SECOND CALL");
-      T2.E2 (P1, P1.ALL);
-      IF (P2.ALL /= 5) THEN
-           FAILED ("P1.ALL EVALUATED UPON RETURN");
-      END IF;
- 
-      RESULT;
- 
- END C95088A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95089a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95089a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95089a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95089a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,175 ****
- -- C95089A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL PERMITTED FORMS OF VARIABLE NAMES ARE PERMITTED
- -- AS ACTUAL PARAMETERS.
- 
- -- GLH 7/25/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95089A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1..3;
- 
-      TYPE REC (N : INT) IS
-           RECORD
-                S : STRING (1..N);
-           END RECORD;
- 
-      TYPE PTRSTR IS ACCESS STRING;
- 
-      R1, R2, R3 : REC (3);
-      S1, S2, S3 : STRING (1..3);
-      PTRTBL     : ARRAY (1..3) OF PTRSTR;
- 
-      TASK T1 IS
-           ENTRY E1 (S1 : IN STRING; S2: IN OUT STRING;
-                     S3 : OUT STRING);
-      END T1;
- 
-      TASK BODY T1 IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E1 (S1 : IN STRING; S2: IN OUT STRING;
-                                S3 : OUT STRING) DO
-                          S3 := S2;
-                          S2 := S1;
-                     END E1;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T1;
- 
-      TASK T2 IS
-           ENTRY E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
-                     C3 : OUT CHARACTER);
-      END T2;
- 
-      TASK BODY T2 IS
-      BEGIN
-           LOOP
-                SELECT
-                     ACCEPT E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
-                                C3 : OUT CHARACTER) DO
-                          C3 := C2;
-                          C2 := C1;
-                     END E2;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END LOOP;
-      END T2;
- 
-      FUNCTION F1 (X : INT) RETURN PTRSTR IS
-      BEGIN
-           RETURN PTRTBL (X);
-      END F1;
- 
-      FUNCTION "+" (S1, S2 : STRING) RETURN PTRSTR IS
-      BEGIN
-           RETURN PTRTBL (CHARACTER'POS(S1(1))-CHARACTER'POS('A')+1);
-      END "+";
- 
- BEGIN
- 
-      TEST ("C95089A", "CHECK THAT ALL PERMITTED FORMS OF VARIABLE " &
-                       "NAMES ARE PERMITTED AS ACTUAL PARAMETERS");
- 
-      S1 := "AAA";
-      S2 := "BBB";
-      T1.E1 (S1, S2, S3);
-      IF S2 /= "AAA" OR S3 /= "BBB" THEN
-           FAILED ("SIMPLE VARIABLE AS AN ACTUAL PARAMETER NOT WORKING");
-      END IF;
- 
-      S1 := "AAA";
-      S2 := "BBB";
-      S3 := IDENT_STR ("CCC");
-      T2.E2 (S1(1), S2(IDENT_INT(1)), S3(1));
-      IF S2 /= "ABB" OR S3 /= "BCC" THEN
-           FAILED ("INDEXED COMPONENT AS AN ACTUAL PARAMETER NOT " &
-                   "WORKING");
-      END IF;
- 
-      R1.S := "AAA";
-      R2.S := "BBB";
-      T1.E1 (R1.S, R2.S, R3.S);
-      IF R2.S /= "AAA" OR R3.S /= "BBB" THEN
-           FAILED ("SELECTED COMPONENT AS AN ACTUAL PARAMETER " &
-                   "NOT WORKING");
-      END IF;
- 
-      S1 := "AAA";
-      S2 := "BBB";
-      T1.E1 (S1(1..IDENT_INT(2)), S2(1..2),
-             S3(IDENT_INT(1)..IDENT_INT(2)));
-      IF S2 /= "AAB" OR S3 /= "BBC" THEN
-           FAILED ("SLICE AS AN ACTUAL PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      T1.E1 (F1(1).ALL, F1(2).ALL, F1(IDENT_INT(3)).ALL);
-      IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN
-           FAILED ("SELECTED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " &
-                   "PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      S1 := IDENT_STR("AAA");
-      S2 := IDENT_STR("BBB");
-      S3 := IDENT_STR("CCC");
-      T1.E1 ("+"(S1,S1).ALL, "+"(S2,S2).ALL, "+"(S3,S3).ALL);
-      IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN
-           FAILED ("SELECTED COMPONENT OF OVERLOADED OPERATOR " &
-                   "FUNCTION VALUE AS AN ACTUAL PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      T2.E2 (F1(1)(1), F1(IDENT_INT(2))(1), F1(3)(IDENT_INT(1)));
-      IF PTRTBL(2).ALL /= "ABB" OR PTRTBL(3).ALL /= "BCC" THEN
-           FAILED ("INDEXED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " &
-                   "PARAMETER NOT WORKING");
-      END IF;
- 
-      PTRTBL(1) := NEW STRING'("AAA");
-      PTRTBL(2) := NEW STRING'("BBB");
-      PTRTBL(3) := NEW STRING'("CCC");
-      T1.E1 (F1(1)(2..3), F1(2)(IDENT_INT(2)..3),
-             F1(3)(2..IDENT_INT(3)));
-      IF PTRTBL(2).ALL /= "BAA" OR PTRTBL(3).ALL /= "CBB" THEN
-           FAILED ("SLICE OF FUNCTION VALUE AS AN ACTUAL PARAMETER " &
-                   "NOT WORKING");
-      END IF;
- 
-      RESULT;
- 
- END C95089A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95090a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95090a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95090a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95090a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C95090A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
- -- TO ENTRIES.  SPECIFICALLY,
- --   (A) CHECK ALL PARAMETER MODES.
- 
- -- GLH 7/25/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95090A IS
- 
- BEGIN
-      TEST ("C95090A", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
-                       "RECORDS ARE PASSED CORRECTLY TO ENTRIES");
- 
-      --------------------------------------------
- 
-      DECLARE   -- (A)
- 
-           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE (1..IDENT_INT(5));
- 
-           TYPE RECORD_TYPE IS
-                RECORD
-                     I : INTEGER;
-                     A : ARRAY_SUBTYPE;
-                END RECORD;
- 
-           REC : RECORD_TYPE := (I => 23,
-                                 A => (1..3 => IDENT_INT(7), 4..5 => 9));
-           BOOL : BOOLEAN;
- 
-           TASK T1 IS
-                ENTRY E1 (ARR : ARRAY_TYPE);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E1 (ARR : ARRAY_TYPE) DO
-                     IF ARR /= (7, 7, 7, 9, 9) THEN
-                          FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
-                     END IF;
-                     IF ARR'FIRST /= IDENT_INT (1) OR
-                        ARR'LAST /= IDENT_INT (5) THEN
-                          FAILED ("WRONG BOUNDS FOR IN PARAMETER");
-                     END IF;
-                END E1;
-           END T1;
- 
-           TASK T2 IS
-                ENTRY E2 (ARR : IN OUT ARRAY_TYPE);
-           END T2;
- 
-           TASK BODY T2 IS
-           BEGIN
-                ACCEPT E2 (ARR : IN OUT ARRAY_TYPE) DO
-                     IF ARR /= (7, 7, 7, 9, 9) THEN
-                          FAILED ("IN OUT PARAMETER NOT PASSED " &
-                                  "CORRECTLY");
-                     END IF;
-                     IF ARR'FIRST /= IDENT_INT (1) OR
-                        ARR'LAST /= IDENT_INT (5) THEN
-                          FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
-                     END IF;
-                     ARR := (ARR'RANGE => 5);
-                END E2;
-           END T2;
- 
-           TASK T3 IS
-                ENTRY E3 (ARR : OUT ARRAY_TYPE);
-           END T3;
- 
-           TASK BODY T3 IS
-           BEGIN
-                ACCEPT E3 (ARR : OUT ARRAY_TYPE) DO
-                     IF ARR'FIRST /= IDENT_INT (1) OR
-                        ARR'LAST /= IDENT_INT (5) THEN
-                          FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
-                     END IF;
-                     ARR := (ARR'RANGE => 3);
-                END E3;
-           END T3;
- 
-      BEGIN     -- (A)
- 
-           T1.E1 (REC.A);
-           IF REC.A /= (7, 7, 7, 9, 9) THEN
-                FAILED ("IN PARAM CHANGED BY PROCEDURE");
-           END IF;
- 
-           T2.E2 (REC.A);
-           IF REC.A /= (5, 5, 5, 5, 5) THEN
-                FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
-           END IF;
- 
-           T3.E3 (REC.A);
-           IF REC.A /= (3, 3, 3, 3, 3) THEN
-                FAILED ("OUT PARAM RETURNED INCORRECTLY");
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------
- 
-      RESULT;
- END C95090A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95092a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95092a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95092a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95092a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,193 ****
- -- C95092A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR ENTRIES OF TASKS, DEFAULT VALUES OF ALL TYPES CAN
- --     BE GIVEN FOR A FORMAL PARAMETER.
- 
- -- HISTORY:
- --     DHH 03/22/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95092A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 ..10;
-      TYPE FLT IS DIGITS 5;
-      TYPE FIX IS DELTA 0.125 RANGE 0.0 .. 10.0;
-      TYPE ENUM IS (RED, BLUE, YELLOW);
-      SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'F';
-      TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
-      TYPE REC IS
-           RECORD
-                A : INT;
-                B : ENUM;
-                C : CHAR;
-           END RECORD;
- 
-      FUNCTION IDENT_FLT(E : FLT) RETURN FLT IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN E;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT_FLT;
- 
-      FUNCTION IDENT_FIX(E : FIX) RETURN FIX IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN E;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT_FIX;
- 
-      FUNCTION IDENT_ENUM(E : ENUM) RETURN ENUM IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN E;
-           ELSE
-                RETURN YELLOW;
-           END IF;
-      END IDENT_ENUM;
- 
-      FUNCTION IDENT_CHAR(E : CHAR) RETURN CHAR IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN E;
-           ELSE
-                RETURN 'F';
-           END IF;
-      END IDENT_CHAR;
- 
-      FUNCTION IDENT_ARR(E : ARR) RETURN ARR IS
-           Z : ARR := (3,2,1);
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN E;
-           ELSE
-                RETURN Z;
-           END IF;
-      END IDENT_ARR;
- 
-      FUNCTION IDENT_REC(E : REC) RETURN REC IS
-           Z : REC := (10, YELLOW, 'F');
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RETURN E;
-           ELSE
-                RETURN Z;
-           END IF;
-      END IDENT_REC;
- 
-      TASK TEST_DEFAULTS IS
-           ENTRY BOOL(G : BOOLEAN := TRUE);
-           ENTRY INTEGR(X : IN INT := 5);
-           ENTRY FLOAT(Y : IN FLT := 1.25);
-           ENTRY FIXED(Z : IN FIX := 1.0);
-           ENTRY ENUMERAT(A : IN ENUM := RED);
-           ENTRY CHARACTR(B : IN CHAR := 'A');
-           ENTRY ARRY(C : IN ARR := (1, 2, 3));
-           ENTRY RECD(D : IN REC := (5, RED, 'A'));
-      END TEST_DEFAULTS;
- 
-      TASK BODY TEST_DEFAULTS IS
-      BEGIN
- 
-           ACCEPT BOOL(G : BOOLEAN := TRUE) DO
-                IF G /= IDENT_BOOL(TRUE) THEN
-                     FAILED("BOOLEAN DEFAULT FAILED");
-                END IF;
-           END BOOL;
- 
-           ACCEPT INTEGR(X : IN INT := 5) DO
-                IF X /= IDENT_INT(5) THEN
-                     FAILED("INTEGER DEFAULT FAILED");
-                END IF;
-           END INTEGR;
- 
-           ACCEPT FLOAT(Y : IN FLT := 1.25) DO
-                IF Y /= IDENT_FLT(1.25) THEN
-                     FAILED("FLOAT DEFAULT FAILED");
-                END IF;
-           END FLOAT;
- 
-           ACCEPT FIXED(Z : IN FIX := 1.0) DO
-                IF Z /= IDENT_FIX(1.0) THEN
-                     FAILED("FIXED DEFAULT FAILED");
-                END IF;
-           END FIXED;
- 
-           ACCEPT ENUMERAT(A : IN ENUM := RED) DO
-                IF A /= IDENT_ENUM(RED) THEN
-                     FAILED("ENUMERATION DEFAULT FAILED");
-                END IF;
-           END ENUMERAT;
- 
-           ACCEPT CHARACTR(B : IN CHAR := 'A') DO
-                IF B /= IDENT_CHAR('A') THEN
-                     FAILED("CHARACTER DEFAULT FAILED");
-                END IF;
-           END CHARACTR;
- 
-           ACCEPT ARRY(C : IN ARR := (1, 2, 3)) DO
-                FOR I IN 1 ..3 LOOP
-                     IF C(I) /= IDENT_INT(I) THEN
-                          FAILED("ARRAY " & INTEGER'IMAGE(I) &
-                                 "DEFAULT FAILED");
-                     END IF;
-                END LOOP;
-           END ARRY;
- 
-           ACCEPT RECD(D : IN REC := (5, RED, 'A')) DO
-                IF D.A /= IDENT_INT(5) THEN
-                     FAILED("RECORD INTEGER DEFAULT FAILED");
-                END IF;
-                IF D.B /= IDENT_ENUM(RED) THEN
-                     FAILED("RECORD ENUMERATION DEFAULT FAILED");
-                END IF;
-                IF D.C /= IDENT_CHAR('A') THEN
-                     FAILED("RECORD CHARACTER DEFAULT FAILED");
-                END IF;
-           END RECD;
- 
-      END TEST_DEFAULTS;
- 
- BEGIN
- 
-      TEST("C95092A", "CHECK THAT FOR ENTRIES OF TASKS, DEFAULT " &
-                      "VALUES OF ALL TYPES CAN BE GIVEN FOR A FORMAL " &
-                      "PARAMETER");
- 
-           TEST_DEFAULTS.BOOL;
-           TEST_DEFAULTS.INTEGR;
-           TEST_DEFAULTS.FLOAT;
-           TEST_DEFAULTS.FIXED;
-           TEST_DEFAULTS.ENUMERAT;
-           TEST_DEFAULTS.CHARACTR;
-           TEST_DEFAULTS.ARRY;
-           TEST_DEFAULTS.RECD;
- 
-      RESULT;
- END C95092A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95093a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95093a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95093a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95093a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- C95093A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE DEFAULT EXPRESSIONS OF FORMAL PARAMETERS ARE EVALUATED
- -- EACH TIME THEY ARE NEEDED.
- 
- -- GLH 7/2/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE C95093A IS
- BEGIN
- 
-      TEST ("C95093A", "CHECK THAT THE DEFAULT EXPRESSION IS " &
-                       "EVALUATED EACH TIME IT IS NEEDED");
- 
-      DECLARE
- 
-           X : INTEGER := 1;
- 
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                X := X + 1;
-                RETURN X;
-           END F;
- 
-           TASK T1 IS
-                ENTRY E1 (X, Y : INTEGER := F);
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
- 
-                ACCEPT E1 (X, Y : INTEGER := F) DO
-                     IF X = Y OR Y /= 2 THEN
-                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - " &
-                                  "1, X =" & INTEGER'IMAGE(X) &
-                                  ", Y =" & INTEGER'IMAGE(Y));
-                     END IF;
-                END E1;
- 
-                ACCEPT E1 (X, Y : INTEGER := F) DO
-                     IF X = Y OR
-                        NOT ((X = 3 AND Y = 4) OR
-                             (X = 4 AND Y = 3)) THEN
-                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - " &
-                                  "2, X =" & INTEGER'IMAGE(X) &
-                                  ", Y =" & INTEGER'IMAGE(Y));
-                     END IF;
-                END E1;
- 
-           END T1;
- 
-      BEGIN
- 
-           COMMENT ("FIRST CALL");
-           T1.E1 (3);
- 
-           COMMENT ("SECOND CALL");
-           T1.E1;
- 
-      END;
- 
-      RESULT;
- 
- END C95093A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C95095A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (A) A FUNCTION AND AN ENTRY.
- 
- -- JWC 7/24/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95095A IS
- 
- BEGIN
-      TEST ("C95095A", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
-                       "MINIMAL DIFFERENCES");
- 
-      --------------------------------------------------
- 
-      -- BOTH PARAMETERIZED AND PARAMETERLESS SUBPROGRAMS AND ENTRIES
-      -- ARE TESTED.
- 
-      DECLARE
-           I, J, K : INTEGER := 0;
-           S : STRING (1..2) := "12";
- 
-           TASK T IS
-                ENTRY E1 (I1, I2 : INTEGER);
-                ENTRY E2;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT E1 (I1, I2 : INTEGER) DO
-                               S (1) := 'A';
-                          END E1;
-                     OR
-                          ACCEPT E2 DO
-                               S (1) := 'C';
-                          END E2;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
- 
-           FUNCTION E1 (I1, I2 : INTEGER) RETURN INTEGER IS
-           BEGIN
-                S (2) := 'B';
-                RETURN I1; -- RETURNED VALUE IS IRRELEVENT.
-           END E1;
- 
- 
-           FUNCTION E2 RETURN INTEGER IS
-           BEGIN
-                S (2) := 'D';
-                RETURN I; -- RETURNED VALUE IS IRRELEVENT.
-           END E2;
- 
-      BEGIN
-           T.E1 (I, J);
-           K := E1 (I, J);
- 
-           IF S /= "AB" THEN
-                FAILED ("PARAMETERIZED OVERLOADED " &
-                        "SUBPROGRAM AND ENTRY " &
-                        "CAUSED CONFUSION");
-           END IF;
- 
-           S := "12";
-           T.E2;
-           K := E2;
- 
-           IF S /= "CD" THEN
-                FAILED ("PARAMETERLESS OVERLOADED " &
-                        "SUBPROGRAM AND ENTRY " &
-                        "CAUSED CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95095A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- C95095B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED ENTRY DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (B) ONE ENTRY HAS ONE LESS PARAMETER THAN THE OTHER.
- 
- -- JWC 7/24/85
- -- JRK 10/2/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95095B IS
- 
- BEGIN
-      TEST ("C95095B", "ENTRY OVERLOADING WITH " &
-                       "MINIMAL DIFFERENCES");
- 
-      --------------------------------------------------
- 
-      -- ONE ENTRY HAS ONE MORE PARAMETER
-      -- THAN THE OTHER.  THIS IS TESTED IN THE
-      -- CASE IN WHICH THAT PARAMETER HAS A DEFAULT
-      -- VALUE, AND THE CASE IN WHICH IT DOES NOT.
- 
-      DECLARE
-           I, J : INTEGER := 0;
-           B : BOOLEAN := TRUE;
-           S : STRING (1..2) := "12";
- 
-           TASK T IS
-                ENTRY E1 (I1, I2 : INTEGER; B1 : IN OUT BOOLEAN);
-                ENTRY E1 (I1, I2 : INTEGER);
-                ENTRY E2 (B1 : IN OUT BOOLEAN; I1 : INTEGER := 0);
-                ENTRY E2 (B1 : IN OUT BOOLEAN);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT E1 (I1, I2 : INTEGER;
-                                     B1 : IN OUT BOOLEAN) DO
-                               S (1) := 'A';
-                          END E1;
-                     OR
-                          ACCEPT E1 (I1, I2 : INTEGER) DO
-                               S (2) := 'B';
-                          END E1;
-                     OR
-                          ACCEPT E2 (B1 : IN OUT BOOLEAN;
-                                     I1 : INTEGER := 0) DO
-                               S (1) := 'C';
-                          END E2;
-                     OR
-                          ACCEPT E2 (B1 : IN OUT BOOLEAN) DO
-                               S (2) := 'D';
-                          END E2;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
- 
-      BEGIN
-           T.E1 (I, J, B);
-           T.E1 (I, J);
- 
-           IF S /= "AB" THEN
-                FAILED ("ENTRIES DIFFERING ONLY IN " &
-                        "NUMBER OF PARAMETERS (NO DEFAULTS) " &
-                        "CAUSED CONFUSION");
-           END IF;
- 
-           S := "12";
-           T.E2 (B, I);
-           -- NOTE THAT A CALL TO T.E2 WITH ONLY
-           -- ONE PARAMETER IS AMBIGUOUS.
- 
-           IF S /= "C2" THEN
-                FAILED ("ENTRIES DIFFERING ONLY IN " &
-                        "EXISTENCE OF ONE PARAMETER (WITH " &
-                        "DEFAULT) CAUSED CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95095B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- C95095C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED ENTRY DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (C) THE BASE TYPE OF A PARAMETER IS DIFFERENT FROM THAT
- --         OF THE CORRESPONDING ONE.
- 
- -- JWC 7/24/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95095C IS
- 
- BEGIN
-      TEST ("C95095C", "ENTRY OVERLOADING WITH " &
-                       "MINIMAL DIFFERENCES");
- 
-      --------------------------------------------------
- 
-      -- THE BASE TYPE OF ONE PARAMETER IS
-      -- DIFFERENT FROM THAT OF THE CORRESPONDING
-      -- ONE.
- 
-      DECLARE
- 
-           TYPE NEWINT IS NEW INTEGER;
- 
-           I, J, K : INTEGER := 0;
-           N : NEWINT;
-           S : STRING (1..2) := "12";
- 
-           TASK T IS
-                ENTRY E (I1 : INTEGER; N1 : OUT NEWINT;
-                         I2 : IN OUT INTEGER);
-                ENTRY E (I1 : INTEGER; N1 : OUT INTEGER;
-                         I2 : IN OUT INTEGER);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT E (I1 : INTEGER; N1 : OUT NEWINT;
-                                    I2 : IN OUT INTEGER) DO
-                               S (1) := 'A';
-                               N1 := 0; -- THIS VALUE IS IRRELEVENT.
-                          END E;
-                     OR
-                          ACCEPT E (I1 : INTEGER; N1 : OUT INTEGER;
-                                    I2 : IN OUT INTEGER) DO
-                               S (2) := 'B';
-                               N1 := 0; -- THIS VALUE IS IRRELEVENT.
-                          END E;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
- 
-      BEGIN
-           T.E (I, N, K);
-           T.E (I, J, K);
- 
-           IF S /= "AB" THEN
-                FAILED ("ENTRIES DIFFERING ONLY BY " &
-                        "THE BASE TYPE OF A PARAMETER " &
-                        "CAUSED CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95095C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- C95095D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (D) A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
- --         PART, AN ENTRY IS DECLARED IN A TASK, AND THE
- --         PARAMETERS ARE ORDERED DIFFERENTLY.
- 
- -- JWC 7/24/85
- -- JRK 10/2/85
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C95095D IS
- 
- 
- BEGIN
-      TEST ("C95095D", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
-                       "MINIMAL DIFFERENCES");
- 
-      --------------------------------------------------
- 
-      -- A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
-      -- PART, AN ENTRY IS DECLARED IN A TASK, AND THE
-      -- PARAMETERS ARE ORDERED DIFFERENTLY.
- 
-      DECLARE
-           S : STRING (1..2) := "12";
- 
-           I : INTEGER := 0;
- 
-           PROCEDURE E (I1 : INTEGER; I2 : IN OUT INTEGER;
-                        B1 : BOOLEAN) IS
-           BEGIN
-                S (1) := 'A';
-           END E;
- 
-           TASK T IS
-                ENTRY E (B1 : BOOLEAN; I1 : INTEGER;
-                         I2 : IN OUT INTEGER);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                E (5, I, TRUE);          -- PROCEDURE CALL.
-                ACCEPT E (B1 : BOOLEAN; I1 : INTEGER;
-                          I2 : IN OUT INTEGER) DO
-                     S (2) := 'B';
-                END E;
-                E (TRUE, 5, I);          -- ENTRY CALL; SELF-BLOCKING.
-                -- NOTE THAT A CALL IN WHICH ALL ACTUAL PARAMETERS
-                -- ARE NAMED_ASSOCIATIONS IS AMBIGUOUS.
-                FAILED ("TASK DID NOT BLOCK ITSELF");
-           END T;
- 
-      BEGIN
- 
-           T.E (TRUE, 5, I);
- 
-           DELAY 10.0 * Impdef.One_Second;
-           ABORT T;
- 
-           IF S /= "AB" THEN
-                FAILED ("PROCEDURES/ENTRIES " &
-                        "DIFFERING ONLY IN PARAMETER " &
-                        "TYPE ORDER CAUSED CONFUSION");
-           END IF;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95095D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c95095e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c95095e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- C95095E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
- -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
- -- DIFFERENCE BETWEEN THE DECLARATIONS.
- 
- --     (E) A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE PART,
- --         AN ENTRY IN A TASK, AND ONE HAS ONE MORE PARAMETER
- --         THAN THE OTHER; THE OMITTED PARAMETER HAS A DEFAULT VALUE.
- 
- -- JWC 7/30/85
- -- JRK 10/2/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C95095E IS
- 
- BEGIN
-      TEST ("C95095E", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
-                       "MINIMAL DIFFERENCES ALLOWED");
- 
-      --------------------------------------------------
- 
-      -- A SUBPROGRAM IS IN AN OUTER DECLARATIVE
-      -- PART, AN ENTRY IN A TASK, AND ONE
-      -- HAS ONE MORE PARAMETER (WITH A DEFAULT
-      -- VALUE) THAN THE OTHER.
- 
-      DECLARE
-           S : STRING (1..3) := "123";
- 
-           PROCEDURE E (I1, I2, I3 : INTEGER := 1) IS
-                C : CONSTANT STRING := "CXA";
-           BEGIN
-                S (I3) := C (I3);
-           END E;
- 
-           TASK T IS
-                ENTRY E (I1, I2 : INTEGER := 1);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (I1, I2 : INTEGER := 1) DO
-                     S (2) := 'B';
-                END E;
-           END T;
- 
-      BEGIN
- 
-           E (1, 2, 3);
-           T.E (1, 2);
-           E (1, 2);
- 
-           IF S /= "CBA" THEN
-                FAILED ("PROCEDURES/ENTRIES DIFFERING " &
-                        "ONLY IN EXISTENCE OF ONE " &
-                        "DEFAULT-VALUED PARAMETER CAUSED " &
-                        "CONFUSION");
-           END IF;
- 
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END C95095E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c951001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c951001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c951001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c951001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- C951001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that two procedures in a protected object will not be 
- --      executed concurrently.
- --
- -- TEST DESCRIPTION:
- --      A very simple example of two tasks calling two procedures in the same 
- --      protected object is used.  Test control code has been added to the
- --      procedures such that, whichever gets called first executes a lengthy
- --      calculation giving sufficient time (on a multiprocessor or a
- --      time-slicing machine) for the other task to get control and call the
- --      other procedure.  The control code verifies that entry to the second
- --      routine is postponed until the first is complete.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- procedure C951001 is
- 
-    protected Ramp_31 is
- 
-       procedure Add_Meter_Queue;
-       procedure Subtract_Meter_Queue;
-       function  TC_Failed return Boolean;
-    
-    private
- 
-       Ramp_Count : integer range 0..20 := 4;  -- Start test with some
-                                               -- vehicles on the ramp
-    
-       TC_Add_Started       : Boolean := false;
-       TC_Subtract_Started  : Boolean := false;
-       TC_Add_Finished      : Boolean := false;
-       TC_Subtract_Finished : Boolean := false;
-       TC_Concurrent_Running: Boolean := false;
-       
-    end Ramp_31;
- 
-    
-    protected body Ramp_31 is
- 
-       function TC_Failed return Boolean is
-       begin
-          -- this indicator will have been set true if any instance
-          -- of concurrent running has been proved
-          return TC_Concurrent_Running;
-       end TC_Failed;
- 
- 
-       procedure Add_Meter_Queue is
-       begin
-          --==================================================
-          -- This section is all Test_Control code
-          TC_Add_Started := true;
-          if TC_Subtract_Started then 
-             if not TC_Subtract_Finished then
-                TC_Concurrent_Running := true;
-             end if;
-          else
-             -- Subtract has not started. 
-             -- Execute a lengthy routine to give it a chance to do so
-             ImpDef.Exceed_Time_Slice;
- 
-             if TC_Subtract_Started then 
-                -- Subtract was able to start so we have concurrent 
-                -- running and the test has failed
-                TC_Concurrent_Running := true;
-             end if;
-          end if;
-          TC_Add_Finished := true;
-          --==================================================
-          Ramp_Count := Ramp_Count + 1;
-       end Add_Meter_Queue;
- 
-       procedure Subtract_Meter_Queue is
-       begin
-          --==================================================
-          -- This section is all Test_Control code
-          TC_Subtract_Started := true;
-          if TC_Add_Started then 
-             if not TC_Add_Finished then
-                -- We already have concurrent running
-                TC_Concurrent_Running := true;
-             end if;
-          else
-             -- Add has not started. 
-             -- Execute a lengthy routine to give it a chance to do so
-             ImpDef.Exceed_Time_Slice;
- 
-             if TC_Add_Started then 
-                -- Add was able to start so we have concurrent 
-                -- running and the test has failed
-                TC_Concurrent_Running := true;
-             end if;
-          end if;
-          TC_Subtract_Finished := true;
-          --==================================================
-          Ramp_Count := Ramp_Count - 1;
-       end Subtract_Meter_Queue;
-    
-    end Ramp_31;
- 
- begin
- 
-    Report.Test ("C951001", "Check that two procedures in a protected" &
-                            " object will not be executed concurrently");
- 
-    declare -- encapsulate the test
- 
-       task Vehicle_1;
-       task Vehicle_2;
- 
- 
-       -- Vehicle_1 and Vehicle_2 are simulations of Instances of the task
-       -- of type Vehicle in different stages of execution
- 
-       task body Vehicle_1 is
-       begin
-          null;  -- ::::: stub.  preparation code
-          
-          -- Add to the count of vehicles on the queue   
-          Ramp_31.Add_Meter_Queue;
- 
-          null;  -- ::::: stub:  wait at the meter then pass to first sensor
- 
-          -- Reduce the count of vehicles on the queue
-          null;  -- ::::: stub: Ramp_31.Subtract_Meter_Queue
-       exception
-          when others =>
-                Report.Failed ("Unexpected Exception in Vehicle_1 task");
-       end Vehicle_1;
- 
- 
-       task body Vehicle_2 is
-       begin
-          null;  -- ::::: stub.  preparation code
-          
-          -- Add to the count of vehicles on the queue   
-          null;  -- ::::: stub Ramp_31.Add_Meter_Queue;  
- 
-          null;  -- ::::: stub:  wait at the meter then pass to first sensor
- 
-          -- Reduce the count of vehicles on the queue
-          Ramp_31.Subtract_Meter_Queue;
-       exception
-          when others =>
-                Report.Failed ("Unexpected Exception in Vehicle_2 task");
-       end Vehicle_2;
- 
-   
- 
-    begin
-       null;
-    end;   -- encapsulation
- 
-    if Ramp_31.TC_Failed then
-       Report.Failed ("Concurrent Running detected");
-    end if;
- 
-    Report.Result;
- 
- end C951001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c951002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c951002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c951002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c951002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,334 ****
- -- C951002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an entry and a procedure within the same protected object
- --      will not be executed simultaneously.
- --
- -- TEST DESCRIPTION:
- --      Two tasks are used.  The first calls an entry who's barrier is set
- --      and is thus queued.  The second calls a procedure in the same 
- --      protected object.  This procedure clears the entry barrier of the 
- --      first then executes a lengthy compute bound procedure.  This is 
- --      intended to allow a multiprocessor, or a time-slicing implementation 
- --      of a uniprocessor, to (erroneously) permit the first task to continue
- --      while the second is still computing.  Flags in each process in the 
- --      PO are checked to ensure that they do not run out of sequence or in 
- --      parallel.  
- --      In the second part of the test another entry and procedure are used
- --      but in this case the procedure is started first.  A different task
- --      calls the entry AFTER the procedure has started.  If the entry 
- --      completes before the procedure the test fails.
- --
- --      This test will not be effective on a uniprocessor without time-slicing
- --      It is designed to increase the chances of failure on a multiprocessor,
- --      or a uniprocessor with time-slicing, if the entry and procedure in a 
- --      Protected Object are not forced to acquire a single execution 
- --      resource.  It is not guaranteed to fail.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- procedure C951002 is
-    
-    -- These global error flags are used for failure conditions within
-    -- the protected object.  We cannot call Report.Failed (thus Text_io)
-    -- which would result in a bounded error.
-    --
-    TC_Error_01 : Boolean := false;
-    TC_Error_02 : Boolean := false;
-    TC_Error_03 : Boolean := false;
-    TC_Error_04 : Boolean := false;
-    TC_Error_05 : Boolean := false;
-    TC_Error_06 : Boolean := false;
- 
- begin
- 
-    Report.Test ("C951002", "Check that a procedure and an entry body " &
-                            "in a protected object will not run concurrently");
- 
-    declare -- encapsulate the test
-       
-       task Credit_Message is
-          entry TC_Start;
-       end Credit_Message;
- 
-       task Credit_Task is
-          entry TC_Start;
-       end Credit_Task;
- 
-       task Debit_Message is
-          entry TC_Start;
-       end Debit_Message;
- 
-       task Debit_Task is
-          entry TC_Start;
-       end Debit_Task;
- 
-       --====================================
- 
-       protected Hold is
- 
-          entry Wait_for_CR_Underload;
-          procedure Clear_CR_Overload;
-          entry Wait_for_DB_Underload;
-          procedure Set_DB_Overload;
-          procedure Clear_DB_Overload;
-          --
-          function TC_Message_is_Queued return Boolean;
- 
-       private
-          Credit_Overloaded     : Boolean := true;  -- Test starts in overload
-          Debit_Overloaded      : Boolean := false; 
-          -- 
-          TC_CR_Proc_Finished   : Boolean := false;
-          TC_CR_Entry_Finished  : Boolean := false;
-          TC_DB_Proc_Finished   : Boolean := false;
-          TC_DB_Entry_Finished  : Boolean := false;
-       end Hold;
-       --====================
-       protected body Hold is
-    
-          entry Wait_for_CR_Underload when not Credit_Overloaded is
-          begin
-             -- The barrier must only be re-evaluated at the end of the 
-             -- of the execution of the procedure, also while the procedure
-             -- is executing this entry body must not be executed
-             if not TC_CR_Proc_Finished then
-                TC_Error_01 := true;  -- Set error indicator
-             end if;
-             TC_CR_Entry_Finished := true;
-          end Wait_for_CR_Underload ;
-    
-          -- This is the procedure which should NOT be able to run in 
-          -- parallel with the entry body
-          --
-          procedure Clear_CR_Overload is
-          begin
- 
-             -- The entry body must not be executed until this procedure
-             -- is completed.  
-             if TC_CR_Entry_Finished then
-                TC_Error_02 := true;  -- Set error indicator
-             end if;
-             Credit_Overloaded := false;   -- clear the entry barrier
- 
-             -- Execute an implementation defined compute bound routine which 
-             -- is designed to run long enough to allow a task switch on a
-             -- time-sliced uniprocessor, or for a multiprocessor to pick up
-             -- another task.
-             -- 
-             ImpDef.Exceed_Time_Slice;
-             
-             -- Again, the entry body must not be executed until the current 
-             -- procedure is completed.  
-             --
-             if TC_CR_Entry_Finished then
-                TC_Error_03 := true;  -- Set error indicator
-             end if;
-             TC_CR_Proc_Finished := true;
- 
-          end Clear_CR_Overload;
-    
-          --============
-          -- The following subprogram and entry body are used in the second
-          -- part of the test
-          
-          entry Wait_for_DB_Underload when not Debit_Overloaded is
-          begin
-             -- By the time the task that calls this entry is allowed access to
-             -- the queue the barrier, which starts off as open, will be closed
-             -- by the Set_DB_Overload procedure.  It is only reopened 
-             -- at the end of the test
-             if not TC_DB_Proc_Finished then
-                TC_Error_04 := true;  -- Set error indicator
-             end if;
-             TC_DB_Entry_Finished := true;
-          end Wait_for_DB_Underload ;
-    
-    
-          procedure Set_DB_Overload is
-          begin
-             -- The task timing is such that this procedure should be started
-             -- before the entry is called.  Thus the entry should be blocked
-             -- until the end of this procedure which then sets the barrier
-             --
-             if TC_DB_Entry_Finished then
-                TC_Error_05 := true;  -- Set error indicator
-             end if;
- 
-             -- Execute an implementation defined compute bound routine which 
-             -- is designed to run long enough to allow a task switch on a
-             -- time-sliced uniprocessor, or for a multiprocessor to pick up
-             -- another task
-             -- 
-             ImpDef.Exceed_Time_Slice;
-             
-             Debit_Overloaded := true;   -- set the entry barrier
- 
-             if TC_DB_Entry_Finished then
-                TC_Error_06 := true;  -- Set error indicator
-             end if;
-             TC_DB_Proc_Finished := true;
- 
-          end Set_DB_Overload;
-    
-          procedure Clear_DB_Overload is
-          begin
-             Debit_Overloaded := false;  -- open the entry barrier
-          end Clear_DB_Overload;
- 
-          function TC_Message_is_Queued return Boolean is
-          begin
-    
-             -- returns true when one message arrives on the queue
-             return (Wait_for_CR_Underload'Count = 1);   
-                                                     
-          end TC_Message_is_Queued ;
- 
-       end Hold;
- 
-       --====================================
- 
-       task body Credit_Message is
-       begin
-          accept TC_Start;
-          --::  some application processing.  Part of the process finds that
-          --    the Overload threshold has been exceeded for the Credit
-          --    application.  This message task queues itself on a queue
-          --    waiting till the overload in no longer in effect 
-          Hold.Wait_for_CR_Underload;
-       exception
-          when others =>
-             Report.Failed ("Unexpected Exception in Credit_Message Task");
-       end Credit_Message;
- 
-       task body Credit_Task is
-       begin
-          accept TC_Start;
-          --  Application code here (not shown) determines that the
-          --  underload threshold has been reached
-          Hold.Clear_CR_Overload;
-       exception
-          when others =>
-             Report.Failed ("Unexpected Exception in Credit_Task");
-       end Credit_Task;
- 
-       --============== 
- 
-       -- The following two tasks are used in the second part of the test
- 
-       task body Debit_Message is
-       begin
-          accept TC_Start;
-          --::  some application processing.  Part of the process finds that
-          --    the Overload threshold has been exceeded for the Debit 
-          --    application.  This message task queues itself on a queue
-          --    waiting till the overload is no longer in effect 
-          --
-          Hold.Wait_for_DB_Underload;
-       exception
-          when others =>
-             Report.Failed ("Unexpected Exception in Debit_Message Task");
-       end Debit_Message;
- 
-       task body Debit_Task is
-       begin
-          accept TC_Start;
-          --  Application code here (not shown) determines that the
-          --  underload threshold has been reached
-          Hold.Set_DB_Overload;
-       exception
-          when others =>
-             Report.Failed ("Unexpected Exception in Debit_Task");
-       end Debit_Task;
-    
-    begin -- declare
- 
-       Credit_Message.TC_Start;
-       
-       -- Wait until the message is queued on the entry before starting
-       -- the Credit_Task
-       while not Hold.TC_Message_is_Queued loop
-          delay ImpDef.Long_Minimum_Task_Switch;   
-       end loop;
-       --
-       Credit_Task.TC_Start;
- 
-       -- Ensure the first part of the test is complete before continuing
-       while not (Credit_Message'terminated and Credit_Task'terminated) loop
-          delay ImpDef.Long_Minimum_Task_Switch;   
-       end loop;
- 
-       --======================================================
-       -- Second part of the test
- 
- 
-       Debit_Task.TC_Start;
-       
-       -- Delay long enough to allow a task switch to the Debit_Task and
-       -- for it to reach the accept statement and call Hold.Set_DB_Overload
-       -- before starting Debit_Message
-       --
-       delay ImpDef.Long_Switch_To_New_Task;
- 
-       Debit_Message.TC_Start;
- 
-       while not Debit_Task'terminated loop
-          delay ImpDef.Long_Minimum_Task_Switch;   
-       end loop;    
-   
-       Hold.Clear_DB_Overload;  -- Allow completion 
-    
-    end; -- declare (encapsulation)
- 
-    if TC_Error_01 then
-       Report.Failed ("Wait_for_CR_Underload executed out of sequence");
-    end if;
-    if TC_Error_02 then
-       Report.Failed ("Credit: Entry executed before procedure");
-    end if;
-    if TC_Error_03 then
-       Report.Failed ("Credit: Entry executed in parallel");
-    end if;
-    if TC_Error_04 then
-       Report.Failed ("Wait_for_DB_Underload executed out of sequence");
-    end if;
-    if TC_Error_05 then
-       Report.Failed ("Debit: Entry executed before procedure");
-    end if;
-    if TC_Error_06 then
-       Report.Failed ("Debit: Entry executed in parallel");
-    end if;
-    
-    Report.Result;
- 
- end C951002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c953001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c953001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c953001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c953001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- C953001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the evaluation of an entry_barrier condition
- --      propagates an exception, the exception Program_Error
- --      is propagated to all current callers of all entries of the
- --      protected object.
- --
- -- TEST DESCRIPTION:
- --      This test declares a protected object (PO) with two entries and
- --      a 5 element entry family.
- --      All the entries are always closed.  However, one of the entries
- --      (Oh_No) will get a constraint_error in its barrier_evaluation
- --      whenever the global variable Blow_Up is true.
- --      An array of tasks is created where the tasks wait on the various
- --      entries of the protected object.  Once all the tasks are waiting
- --      the main procedure calls the entry Oh_No and causes an exception
- --      to be propagated to all the tasks.  The tasks record the fact 
- --      that they got the correct exception in global variables that
- --      can be checked after the tasks complete.
- --
- --
- -- CHANGE HISTORY:
- --      19 OCT 95   SAIC    ACVC 2.1
- --
- --!
- 
- 
- with Report;
- with ImpDef;
- procedure C953001 is
-     Verbose : constant Boolean := False;
-     Max_Tasks : constant := 12;
- 
-       -- note status and error conditions
-     Blocked_Entry_Taken : Boolean := False;
-     In_Oh_No            : Boolean := False;
-     Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False);
- 
- begin
-   Report.Test ("C953001",
-                "Check that an exception in an entry_barrier condition" &
-                " causes Program_Error to be propagated to all current" &
-                " callers of all entries of the protected object");
- 
-   declare -- test encapsulation
-     -- miscellaneous values
-     Cows : Integer := Report.Ident_Int (1);
-     Came_Home : Integer := Report.Ident_Int (2);
- 
-     -- make the Barrier_Condition fail only when we want it to
-     Blow_Up : Boolean := False;
- 
-     function Barrier_Condition return Boolean is
-     begin
-       if Blow_Up then
-          return 5 mod Report.Ident_Int(0) = 1;
-       else
-          return False;
-       end if;
-     end Barrier_Condition;
- 
-     subtype Family_Index is Integer range 1..5;
- 
-     protected PO is
-       entry Block1;
-       entry Oh_No;
-       entry Family (Family_Index);
-     end PO;
- 
-     protected body PO is
-       entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is
-       begin
-         Blocked_Entry_Taken := True;
-       end Block1;
- 
-       -- barrier will get a Constraint_Error (divide by 0)
-       entry Oh_No when Barrier_Condition is
-       begin
-         In_Oh_No := True;
-       end Oh_No;
- 
-       entry Family (for Member in Family_Index) when Cows = Came_Home is
-       begin
-         Blocked_Entry_Taken := True;
-       end Family;
-     end PO;
-      
- 
-     task type Waiter is
-       entry Take_Id (Id : Integer);
-     end Waiter;
- 
-     Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;
- 
-     task body Waiter is
-       Me : Integer;
-       Action : Integer;
-     begin
-       accept Take_Id (Id : Integer) do
-          Me := Id;
-       end Take_Id;
- 
-       Action := Me mod (Family_Index'Last + 1);
-       begin
-         if Action = 0 then
-           PO.Block1; 
-         else
-           PO.Family (Action);
-         end if;
-         Report.Failed ("no exception for task" & Integer'Image (Me));
-       exception
-          when Program_Error =>
-            Task_Passed (Me) := True;
-            if Verbose then
-              Report.Comment ("pass for task" & Integer'Image (Me));
-            end if;
-          when others =>
-            Report.Failed ("wrong exception raised in task" &
-                           Integer'Image (Me));
-       end;
-     end Waiter;
- 
- 
-   begin   -- test encapsulation
-     for I in 1..Max_Tasks loop
-       Bunch_Of_Waiters(I).Take_Id (I);
-     end loop;
- 
-     -- give all the Waiters time to get queued
-     delay 2*ImpDef.Clear_Ready_Queue;
- 
-     -- cause the protected object to fail
-     begin
-       Blow_Up := True;
-       PO.Oh_No;
-       Report.Failed ("no exception in call to PO.Oh_No");
-     exception
-       when Constraint_Error =>
-          Report.Failed ("Constraint_Error instead of Program_Error");
-       when Program_Error =>
-          if Verbose then
-            Report.Comment ("main exception passed");
-          end if;
-       when others =>
-          Report.Failed ("wrong exception in main");
-     end;
-   end;    -- test encapsulation
- 
-   -- all the tasks have now completed.
-   -- check the flags for pass/fail info
-   if Blocked_Entry_Taken then
-      Report.Failed ("blocked entry taken");
-   end if;
-   if In_Oh_No then
-      Report.Failed ("entry taken with exception in barrier");
-   end if;
-   for I in 1..Max_Tasks loop
-     if not Task_Passed (I) then
-       Report.Failed ("task" & Integer'Image (I) & " did not pass");
-     end if;
-   end loop;
- 
-   Report.Result;
- end C953001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c953002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c953002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c953002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c953002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,242 ****
- -- C953002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the servicing of entry queues of a protected object 
- --      continues until there are no open entries with queued calls
- --      and that this takes place as part of a single protected 
- --      operation.
- --
- -- TEST DESCRIPTION:
- --      This test enqueues a bunch of tasks on the entries of the
- --      protected object Main_PO.  At the same time another bunch of
- --      of tasks are queued on the single entry of protected object
- --      Holding_Pen.
- --      Once all the tasks have had time to block, the main procedure
- --      opens all the entries for Main_PO by calling the 
- --      Start_Protected_Operation protected procedure.  This should
- --      process all the pending callers as part of a single protected
- --      operation.
- --      During this protected operation, the entries of Main_PO release
- --      the tasks blocked on Holding_Pen by calling the protected 
- --      procedure Release.
- --      Once released from Holding_Pen, the task immediately calls
- --      an entry in Main_PO.
- --      These new calls should not gain access to Main_PO until
- --      the initial protected operation on that object completes.
- --      The order in which the entry calls on Main_PO are taken is
- --      recorded in a global array and checked after all the tasks
- --      have terminated.
- --
- --
- -- CHANGE HISTORY:
- --      25 OCT 95   SAIC    ACVC 2.1
- --      15 JAN 95   SAIC    Fixed deadlock problem.
- --
- --!
- 
- with Report;
- procedure C953002 is
-   Verbose : constant Boolean := False;
- 
-   Half_Tasks : constant := 15;   -- how many tasks of each group 
-   Max_Tasks : constant := Half_Tasks * 2;  -- total number of tasks
- 
-   Note_Order : array (1..Max_Tasks) of Integer := (1..Max_Tasks => 0);
-   Note_Cnt : Integer := 0;
- begin
-   Report.Test ("C953002",
-                "Check that the servicing of entry queues handles all" &
-                " open entries as part of a single protected operation");
-   declare
-      task type Assault_PO is
-         entry Take_ID (Id : Integer);
-      end Assault_PO;
- 
-      First_Wave  : array (1 .. Half_Tasks) of Assault_PO;
-      Second_Wave : array (1 .. Half_Tasks) of Assault_PO;
- 
-      protected Main_PO is
-         entry E0 (Who : Integer);
-         entry E1 (Who : Integer);
-         entry E2 (Who : Integer);
-         entry E3 (Who : Integer);
-         entry All_Present;
-         procedure Start_Protected_Operation;
-      private
-         Open : Boolean := False;
-      end Main_PO;
- 
-      protected Holding_Pen is
-         -- Note that Release is called by tasks executing in 
-         -- the protected object Main_PO.
-         entry Wait (Who : Integer);
-         entry All_Present;
-         procedure Release;
-      private
-         Open : Boolean := False;
-      end Holding_Pen;
- 
-      
-      protected body Main_PO is
-         procedure Start_Protected_Operation is
-         begin
-            Open := True;
-            -- at this point all the First_Wave tasks are
-            -- waiting at the entries and all of them should
-            -- be processed as part of the protected operation.
-         end Start_Protected_Operation;
- 
-         entry All_Present when E0'Count + E1'Count + E2'Count + E3'Count =
-                                Max_Tasks / 2  is
-         begin
-            null;   -- all tasks are waiting
-         end All_Present; 
- 
-         entry E0 (Who : Integer) when Open is
-         begin
-            Holding_Pen.Release;
-            -- note the order in which entry calls are handled.
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-         end E0;
- 
-         entry E1 (Who : Integer) when Open is
-         begin
-            Holding_Pen.Release;
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-         end E1;
- 
-         entry E2 (Who : Integer) when Open is
-         begin
-            Holding_Pen.Release;
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-         end E2;
- 
-         entry E3 (Who : Integer) when Open is
-         begin
-            Holding_Pen.Release;
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-         end E3;
-      end Main_PO;
- 
- 
-      protected body Holding_Pen is
-         procedure Release is
-         begin
-            Open := True;
-         end Release;
- 
-         entry All_Present when Wait'Count = Max_Tasks / 2 is
-         begin
-            null;  -- all tasks waiting
-         end All_Present;
- 
-         entry Wait (Who : Integer) when Open is
-         begin
-            null;  -- unblock the task
-         end Wait;
-      end Holding_Pen;
- 
-      task body Assault_PO is
-         Me : Integer;
-      begin
-         accept Take_Id (Id : Integer) do
-            Me := Id;
-         end Take_Id;
-         if Me >= 200 then
-            Holding_Pen.Wait (Me);
-         end if;
-         case Me mod 4 is
-            when 0 => Main_PO.E0 (Me);
-            when 1 => Main_PO.E1 (Me);
-            when 2 => Main_PO.E2 (Me);
-            when 3 => Main_PO.E3 (Me);
-            when others => null;  -- cant happen
-         end case;
-         if Verbose then
-            Report.Comment ("task" & Integer'Image (Me) &
-                            " done");
-         end if;
-      exception
-         when others =>
-            Report.Failed ("exception in task");
-      end Assault_PO;
- 
-   begin   -- test encapsulation
-      for I in First_Wave'Range loop
-         First_Wave (I).Take_ID (100 + I);
-      end loop;
-      for I in Second_Wave'Range loop
-         Second_Wave (I).Take_ID (200 + I);
-      end loop;
-      
-      -- let all the tasks get blocked
-      Main_PO.All_Present;
-      Holding_Pen.All_Present; 
- 
-      -- let the games begin
-      if Verbose then
-         Report.Comment ("starting protected operation");
-      end if;
-      Main_PO.Start_Protected_Operation;
- 
-      -- wait for all the tasks to complete
-      if Verbose then
-         Report.Comment ("waiting for tasks to complete");
-      end if;
-   end;
- 
-   -- make sure all tasks registered their order
-   if Note_Cnt /= Max_Tasks then
-      Report.Failed ("task registration count wrong. " &
-                     Integer'Image (Note_Cnt));
-   end if;
- 
-   -- check the order in which entries were handled.
-   -- all the 100 level items should be handled as part of the
-   -- first protected operation and thus should be completed
-   -- before any 200 level item.
- 
-   if Verbose then
-      for I in 1..Max_Tasks loop
-         Report.Comment ("order" & Integer'Image (I) & " is" &
-                         Integer'Image (Note_Order (I))); 
-      end loop;
-   end if;
-   for I in 2 .. Max_Tasks loop
-      if Note_Order (I)   <  200 and
-         Note_Order (I-1) >= 200 then
-         Report.Failed ("protected operation failure" &
-                        Integer'Image (Note_Order (I-1)) &
-                        Integer'Image (Note_Order (I)));
-      end if;
-   end loop;
-   
-   Report.Result;
- end C953002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c953003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c953003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c953003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c953003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,189 ****
- -- C953003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the servicing of entry queues of a protected object 
- --      continues until there are no open entries with queued (or 
- --      requeued) calls and that internal requeues are handled 
- --      as part of a single protected operation.
- --
- -- TEST DESCRIPTION:
- --      A number of tasks are created and blocked on a protected object
- --      so that they can all be released at one time.  When released,
- --      these tasks make an entry call to an entry in the Main_PO 
- --      protected object.  As part of the servicing of this entry
- --      call the call is passed through the remaining entries of the
- --      protected object by using internal requeues.  The protected
- --      object checks that no other entry call is accepted until 
- --      after all the internal requeuing has completed.
- --
- --
- -- CHANGE HISTORY:
- --      12 JAN 96   SAIC    Initial version for 2.1
- --
- --!
- 
- with Report;
- procedure C953003 is
-   Verbose : constant Boolean := False;
- 
-   Order_Error : Boolean := False;
- 
-   Max_Tasks : constant := 10;  -- total number of tasks
-   Max_Entries : constant := 4;  -- number of entries in Main_PO
-   Note_Cnt : Integer := 0;
-   Note_Order : array (1..Max_Tasks*Max_Entries) of Integer;
- begin
-   Report.Test ("C953003",
-                "Check that the servicing of entry queues handles all" &
-                " open entries as part of a single protected operation," &
-                " including those resulting from an internal requeue");
-   declare
-      task type Assault_PO is
-         entry Take_ID (Id : Integer);
-      end Assault_PO;
- 
-      Marines  : array (1 .. Max_Tasks) of Assault_PO;
- 
-      protected Main_PO is
-         entry E0 (Who : Integer);
-      private
-         entry E3 (Who : Integer);
-         entry E2 (Who : Integer);
-         entry E1 (Who : Integer);
-         Expected_Next : Integer := 0;
-      end Main_PO;
- 
-      
-      protected body Main_PO is
- 
-         entry E0 (Who : Integer) when True is
-         begin
-            Order_Error := Order_Error or Expected_Next /= 0;
-            Expected_Next := 1;
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-            requeue E1;
-         end E0;
- 
-         entry E1 (Who : Integer) when True is
-         begin
-            Order_Error := Order_Error or Expected_Next /= 1;
-            Expected_Next := 2;
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-            requeue E2;
-         end E1;
- 
-         entry E3 (Who : Integer) when True is
-         begin
-            Order_Error := Order_Error or Expected_Next /= 3;
-            Expected_Next := 0;
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-            -- all done - return now
-         end E3;
- 
-         entry E2 (Who : Integer) when True is
-         begin
-            Order_Error := Order_Error or Expected_Next /= 2;
-            Expected_Next := 3;
-            Note_Cnt := Note_Cnt + 1;
-            Note_Order (Note_Cnt) := Who;
-            requeue E3;
-         end E2;
-      end Main_PO;
- 
-      protected Holding_Pen is
-         entry Wait_For_All_Present;
-         entry Wait;
-      private
-         Open : Boolean := False;
-      end Holding_Pen;
- 
-      protected body Holding_Pen is
-         entry Wait_For_All_Present when Wait'Count = Max_Tasks is
-         begin
-            Open := True;
-         end Wait_For_All_Present;
- 
-         entry Wait when Open is
-         begin
-            null;  -- just go
-         end Wait;
-      end Holding_Pen;
- 
- 
-      task body Assault_PO is
-         Me : Integer;
-      begin
-         accept Take_Id (Id : Integer) do
-            Me := Id;
-         end Take_Id;
-         Holding_Pen.Wait;
-         Main_PO.E0 (Me);
-         if Verbose then
-            Report.Comment ("task" & Integer'Image (Me) &
-                            " done");
-         end if;
-      exception
-         when others =>
-            Report.Failed ("exception in task");
-      end Assault_PO;
- 
-   begin   -- test encapsulation
-      for I in Marines'Range loop
-         Marines (I).Take_ID (100 + I);
-      end loop;
-      
-      -- let all the tasks get blocked so we can release them all
-      -- at one time
-      Holding_Pen.Wait_For_All_Present; 
- 
-      -- wait for all the tasks to complete
-      if Verbose then
-         Report.Comment ("waiting for tasks to complete");
-      end if;
-   end;
- 
-   -- make sure all tasks registered their order
-   if Note_Cnt /= Max_Tasks * Max_Entries then
-      Report.Failed ("task registration count wrong. " &
-                     Integer'Image (Note_Cnt));
-   end if;
- 
-   if Order_Error then
-      Report.Failed ("internal requeue not handled as part of operation");
-   end if;
- 
-   if Verbose or Order_Error then
-      for I in 1..Max_Tasks * Max_Entries loop
-         Report.Comment ("order" & Integer'Image (I) & " is" &
-                         Integer'Image (Note_Order (I))); 
-      end loop;
-   end if;
- 
-   Report.Result;
- end C953003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,273 ****
- -- C954001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a requeue statement within an entry_body with parameters
- --      may requeue the entry call to a protected entry with a subtype-
- --      conformant parameter profile. Check that, if the call is queued on the
- --      new entry's queue, the original caller remains blocked after the
- --      requeue, but the entry_body containing the requeue is completed.
- --
- -- TEST DESCRIPTION:
- --      Declare a protected object which simulates a disk device. Declare an
- --      entry that requeues the caller to a second entry if the disk head is
- --      not in the proper location, but first sets the second entry's barrier
- --      to false. Declare a procedure which sets the second entry's barrier
- --      to true.
- --
- --      Declare a task which calls the first entry such that the requeue is
- --      called. This task should be queued on the second entry and remain
- --      blocked, and the first entry should be complete. Call the procedure
- --      which releases the second entry's queue. The second entry should
- --      complete, after which the task should complete.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C954001_0 is  -- Disk management abstraction.
- 
- 
-    -- Simulate a read-only disk device with a head that may be moved to
-    -- different tracks. If a read request is issued for the current
-    -- track, the request can be satisfied immediately. Otherwise, the head
-    -- must be moved to the correct track, during which time the calling task
-    -- is blocked. When the head reaches the correct track, the disk generates
-    -- an interrupt, after which the request can be satisfied, and the
-    -- calling task can proceed.
- 
-    Buffer_Size : constant := 100;
- 
-    type Disk_Buffer is new String (1 .. Buffer_Size);
-    type Disk_Track  is new Natural;
- 
-    type Disk_Address is record
-       Track : Disk_Track;
-       -- Additional components.
-    end record;
- 
-    Initial_Track : constant Disk_Track := 0;
-    New_Track     : constant Disk_Track := 5;
- 
-                --==============================================--
- 
-    protected Disk_Device is
- 
-       entry Read (Where :     Disk_Address;            -- Read data from disk
-                   Data  : out Disk_Buffer);            -- track.
- 
-       procedure Disk_Interrupt;                        -- Handle interrupt 
-                                                        -- from disk.
- 
-       function TC_Track return Disk_Track;             -- Return current track.
- 
-       function TC_Pending_Queued return Boolean;       -- True when there is
-                                                        -- an entry in queue
- 
-    private
- 
-       entry Pending_Read (Where :     Disk_Address;    -- Wait for head to 
-                           Data  : out Disk_Buffer);    -- move then read data.
- 
-       Current_Track     : Disk_Track := Initial_Track; -- Current disk track.
-       Operation_Pending : Boolean    := False;         -- Vis.  entry barrier.
-       Disk_Interrupted  : Boolean    := False;         -- Priv. entry barrier.
- 
-    end Disk_Device;
- 
- 
- end C954001_0;
- 
- 
-      --==================================================================--
- 
- 
- package body C954001_0 is  -- Disk management abstraction.
- 
- 
-    protected body Disk_Device is
- 
-       entry Read (Where : Disk_Address; Data : out Disk_Buffer)
-         when not Operation_Pending is
-       begin
-          if (Where.Track = Current_Track) then      -- If the head is over the
-             -- Read data from disk...               -- requested track, read
-             null;                                   -- the data.
- 
-          else                                       -- Otherwise, defer read
-             Operation_Pending := True;              -- while head is moved to
-                                                     -- correct track (signaled
-             --                        --            -- by a disk interrupt).
-             -- Requeue is tested here --
-             --                        --
- 
-             requeue Pending_Read;                  
- 
-          end if;
-       end Read;
- 
- 
-       procedure Disk_Interrupt is                   -- Called when the disk
-       begin                                         -- interrupts, indicating
-          Disk_Interrupted := True;                  -- that the head is over
-       end Disk_Interrupt;                           -- the correct track.
- 
- 
-       function TC_Track return Disk_Track is        -- Artifice required for
-       begin                                         -- testing purposes.
-          return (Current_Track);
-       end TC_Track;
- 
- 
-       entry Pending_Read (Where : Disk_Address; Data : out Disk_Buffer)
-         when Disk_Interrupted is
-       begin
-          Current_Track := Where.Track;              -- Head is now over the
-          -- Read data from disk...                  -- correct track; read
-          Operation_Pending := False;                -- the data.
-          Disk_Interrupted := False;
-       end Pending_Read;
- 
-       function TC_Pending_Queued return Boolean is
-       begin
-          -- Return true when there is something on the Pending_Read queue
-          return (Pending_Read'Count /=0);   
-       end TC_Pending_Queued;
- 
-    end Disk_Device;
- 
- 
- end C954001_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with C954001_0;  -- Disk management abstraction.
- use  C954001_0;
- 
- procedure C954001 is
- 
- 
-    task type Read_Task is        -- an unusual (but legal) declaration
-    end Read_Task;
-    --
-    --
-    task body Read_Task is
-       Location : constant Disk_Address := (Track => New_Track);
-       Data     :          Disk_Buffer  := (others => ' ');
-    begin
-       Disk_Device.Read (Location, Data);   -- Invoke requeue statement.
-    exception
-       when others =>
-          Report.Failed ("Exception raised in task");
-    end Read_Task;
- 
-                --==============================================--
- 
- begin  -- Main program.
- 
-    Report.Test ("C954001", "Requeue from an entry within a P.O. " &
-                            "to a private entry within the same P.O.");
- 
- 
-    declare
- 
-       IO_Request : Read_Task;                  -- Request a read from other
-                                                -- than the current track.
-                                                -- IO_Request will be requeued
-                                                -- from Read to Pending_Read.
-    begin
- 
-       -- To pass this test, the following must be true:
-       --
-       --    (A) The Read entry call made by the task IO_Request must be
-       --        completed by the requeue.
-       --    (B) IO_Request must remain blocked following the requeue.
-       --    (C) IO_Request must be queued on the Pending_Read entry queue.
-       --    (D) IO_Request must continue execution after the Pending_Read
-       --        entry completes.
-       --
-       -- First, verify (A): that the Read entry call is complete.
-       --
-       -- Call a protected operation (Disk_Device.TC_Track). Since no two
-       -- protected actions may proceed concurrently unless both are protected
-       -- function calls, a call to a protected operation at this point can
-       -- proceed only if the Read entry call is already complete.
-       --
-       -- Note that if Read is NOT complete, the test will likely hang here.
-       --
-       -- Next, verify (B): that IO_Request remains blocked following the
-       -- requeue. Also verify that Pending_Read (the entry to which
-       -- IO_Request should have been queued) has not yet executed.
- 
-       -- Wait until the task had made the call and the requeue has been
-       -- effected.  
-       while not Disk_Device.TC_Pending_Queued loop
-          delay ImpDef.Minimum_Task_Switch;
-       end loop;
- 
-       if Disk_Device.TC_Track /= Initial_Track then
-          Report.Failed ("Target entry of requeue executed prematurely");
-       elsif IO_Request'Terminated then
-          Report.Failed ("Caller did not remain blocked after " &
-                         "the requeue or was never requeued");
-       else
- 
-          -- Verify (C): that IO_Request is queued on the
-          -- Pending_Read entry queue.
-          --
-          -- Set the barrier for Pending_Read to true. Check that the
-          -- current track is updated and that IO_Request terminates.
- 
-          Disk_Device.Disk_Interrupt;           -- Simulate a disk interrupt,
-                                                -- signaling that the head is
-                                                -- over the correct track.
- 
-          -- The Pending_Read entry body will complete before the next
-          -- protected action is called (Disk_Device.TC_Track).
- 
-          if Disk_Device.TC_Track /= New_Track then
-             Report.Failed ("Caller was not requeued on target entry");
-          end if;
- 
-          -- Finally, verify (D): that Read_Task continues after Pending_Read
-          -- completes.
-          -- 
-          -- Note that the test will hang here if Read_Task does not continue
-          -- executing following the completion of the requeued entry call.
- 
-       end if;
- 
-    end;  -- We will not exit the declare block until the task completes
- 
-    Report.Result;
- 
- end C954001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,286 ****
- -- C954010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a requeue within an accept statement does not block.
- --      This test uses: Requeue to an entry in a different task
- --                      Parameterless call
- --                      Requeue with abort
- --
- -- TEST DESCRIPTION:
- --      In the Distributor task, requeue two successive calls on the entries
- --      of two separate target tasks.  Verify that the target tasks are
- --      run in parallel proving that the first requeue does not block
- --      while the first target rendezvous takes place.                 
- --
- --      This series of tests uses a simulation of a transaction driven 
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then 
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system. The message tasks put themselves on the 
- --      input queue of a Distributor which, from information in the 
- --      transaction and/or system load conditions forwards them to other 
- --      operating tasks. These in turn might forward the transactions to yet 
- --      other tasks for further action.  The  routing is, in real life, 
- --      dynamic and unpredictable at the time of message generation. All 
- --      rerouting in this  model is done by means of requeues.
- --
- --      This test is directed towards the BLOCKING of the REQUEUE only
- --      If the original caller does not block, the outcome of the test will
- --      not be affected.  If the original caller does not continue after
- --      the return, the test will not pass.  
- --      If the requeue gets placed on the wrong entry a failing test could
- --      pass (eg. if the first message is delivered to the second
- --      computation task and the second message to the first) - a check for
- --      this condition is made in other tests
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- procedure C954010 is
- 
-    -- Mechanism to count the number of Message tasks completed
-    protected TC_Tasks_Completed is
-       procedure Increment;
-       function  Count return integer;
-    private
-       Number_Complete : integer := 0;
-    end TC_Tasks_Completed;
-    --
-    TC_Expected_To_Complete   : constant integer := 2;
- 
- 
-    task type Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is
-       entry Start;
-    end Line_Driver;
- 
-    task Distributor is 
-       entry Input;
-    end Distributor;
- 
-    task Credit_Computation is
-       entry Input;
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input;
-       entry TC_Artificial_Rendezvous_1;      -- test purposes only
-       entry TC_Artificial_Rendezvous_2;      -- test purposes only
-    end Debit_Computation;
- 
-    
-    -- Mechanism to count the number of Message tasks completed
-    protected body TC_Tasks_Completed is
-       procedure Increment is
-       begin
-          Number_Complete := Number_Complete + 1;
-       end Increment;
- 
-       function Count return integer is
-       begin
-          return Number_Complete;
-       end Count;
-    end TC_Tasks_Completed;
- 
- 
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each and sends this to a Distributor 
-    --   for appropriate disposal around the network of tasks
-    --      Such a task would normally be designed to loop continuously
-    --      creating the messages as input is received.  Simulate this 
-    --      but limit it to two dummy messages for this test and allow it
-    --      to terminate at that point
-    --
-    task body Line_Driver is
- 
-    begin
- 
-       accept Start;      -- Wait for trigger from main
- 
-       for i in 1..2 loop
-          declare
-             -- create a new message task 
-             N : acc_Message_Task := new Message_Task; 
-          begin
-             -- preparation code
-             null; -- stub
- 
-          end;   -- declare
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
- 
-    task body Message_Task is
-    begin
-       -- Queue up on Distributor's Input queue
-       Distributor.Input;
-       
-       -- After the required computations have been performed
-       -- return the message appropriately (probably to an output
-       -- line driver
-       null;            -- stub
- 
-       -- Increment to show completion of this task
-       TC_Tasks_Completed.Increment;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Message_Task");
- 
-    end Message_Task;
- 
- 
-    -- Dispose each input message to the appropriate computation tasks
-    --    Normally this would be according to some parameters in the entry
-    --    but this simple test is using parameterless entries.  
-    --
-    task body Distributor is
-      Last_was_for_Credit_Computation : Boolean := false;   -- switch
-    begin
-       loop
-          select
-             accept Input do
-                -- Determine to which task the message should be 
-                -- distributed
-                --      For this test arbitrarily send the first to 
-                --      Credit_Computation and the second to Debit_Computation
-                if Last_was_for_Credit_Computation then
-                   requeue Debit_Computation.Input with abort;
-                else 
-                   Last_was_for_Credit_Computation := true;
-                   requeue Credit_Computation.Input with abort;
-                end if;
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Distributor");
-    end Distributor;
-                                           
-                                                 
-    -- Computation task.  After the computation is performed the rendezvous
-    -- in the original message task is completed.                              
-    task body Credit_Computation is
-    begin
-       loop
-          select 
-             accept Input do
-                -- Perform the computations required for this message
-                --
-                null;     -- stub
- 
-                --   For the test:
-                --   Artificially rendezvous with Debit_Computation.
-                --   If the first requeue in Distributor has blocked 
-                --   waiting for the current rendezvous to complete then the
-                --   second message will not be sent to Debit_Computation 
-                --   which will still be waiting on its Input accept.  
-                --   This task will HANG
-                --
-                Debit_Computation.TC_Artificial_Rendezvous_1;
-                --
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
-                                                 
-    -- Computation task.  After the computation is performed the rendezvous
-    -- in the original message task is completed.                              
-    task body Debit_Computation is
-       Message_Count      : integer := 0;
-       TC_AR1_is_complete : Boolean := false;
-    begin
-       loop
-          select
-             accept Input do
-                -- Perform the computations required for this message
-                null;    -- stub
-             end Input;
-             Message_Count := Message_Count + 1;
-          or
-             -- Guard until the rendezvous with the message for this task
-             -- has completed
-             when Message_Count > 0 =>
-             accept TC_Artificial_Rendezvous_1;    -- see comments in
-                                                   -- Credit_Computation above
-             TC_AR1_is_complete := true; 
-          or
-             -- Completion rendezvous with the main procedure
-             when TC_AR1_is_complete =>
-             accept TC_Artificial_Rendezvous_2;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Debit_Computation");
- 
- 
-    end Debit_Computation;
- 
- 
- begin -- c954010
-    Report.Test ("C954010", "Requeue in an accept body does not block");
- 
-    Line_Driver.Start;
- 
-    -- Ensure that both messages were delivered to the computation tasks
-    -- This shows that both requeues were effective.
-    -- 
-    Debit_Computation.TC_Artificial_Rendezvous_2;
- 
-    -- Ensure that the message tasks completed
-    while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
-       delay ImpDef.Minimum_Task_Switch;   
-    end loop;
- 
-    Report.Result;
- 
- end C954010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,384 ****
- -- C954011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a requeue is placed on the correct entry; that the 
- --      original caller waits for the completion of the requeued rendezvous;
- --      that the original caller continues after the rendezvous.
- --      Specifically, this test checks requeue to an entry in a different
- --      task, requeue where the entry has parameters, and requeue with
- --      abort.
- --
- -- TEST DESCRIPTION:
- --      In the Distributor task, requeue two successive calls on the entries
- --      of two separate target tasks.  Each task in each of the  paths adds 
- --      identifying information in the transaction being passed.  This
- --      information is checked by the Message tasks on completion ensuring that
- --      the requeues have been placed on the correct queues.
- --
- --      This series of tests uses a simulation of a transaction driven 
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then 
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system. The message tasks put themselves on the 
- --      input queue of a Distributor which, from information in the 
- --      transaction and/or system load conditions forwards them to other 
- --      operating tasks. These in turn might forward the transactions to yet 
- --      other tasks for further action.  The routing is, in real life, 
- --      dynamic and unpredictable at the time of message generation. All 
- --      rerouting in this  model is done by means of requeues.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Nov 95   SAIC    Fixed problems with shared global variables
- --                          for ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;
-          
- procedure C954011 is
-  
- 
-    -- Arbitrary test values
-    Credit_Return : constant := 1;
-    Debit_Return  : constant := 2;
- 
-    type Transaction_Code is (Credit, Debit);
- 
-    type Transaction_Record;
-    type acc_Transaction_Record is access Transaction_Record;
-    type Transaction_Record is 
-       record
-          ID               : integer := 0;
-          Code             : Transaction_Code := Debit;
-          Account_Number   : integer := 0;
-          Stock_Number     : integer := 0;
-          Quantity         : integer := 0;
-          Return_Value     : integer := 0;
-          TC_Message_Count : integer := 0;  
-          TC_Thru_Distrib  : Boolean := false;
-       end record;
- 
-    protected type Message_Mgr is
-       procedure Mark_Complete;
-       function Is_Complete return Boolean;
-    private
-       Complete : Boolean := False;
-    end Message_Mgr;
- 
-    protected body Message_Mgr is
-       procedure Mark_Complete is
-       begin
-          Complete := True;
-       end Mark_Complete;
- 
-       Function Is_Complete return Boolean is
-       begin
-          return Complete;
-       end Is_Complete;
-    end Message_Mgr;
- 
-    TC_Debit_Message  : Message_Mgr;
-    TC_Credit_Message : Message_Mgr;
- 
- 
-    task type Message_Task is 
-       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-    end Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is 
-       entry Start;
-    end Line_Driver;   
- 
-    task Distributor is 
-       entry Input(Transaction : acc_Transaction_Record);
-    end Distributor;
- 
-    task Credit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Debit_Computation;
- 
- 
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each. The message tasks remain extant
-    --   for the life of the messages in the system.
-    --      The Line Driver task would normally be designed to loop continuously
-    --      creating the messages as input is received.  Simulate this 
-    --      but limit it to two dummy messages for this test and allow it
-    --      to terminate at that point
-    --
-    task body Line_Driver is
-       Current_ID : integer := 1;
-       TC_Last_was_for_credit : Boolean := false;
- 
-       procedure Build_Credit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 100;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Credit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Credit_Record;     
- 
- 
-       procedure Build_Debit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 200;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Debit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Debit_Record;     
- 
-    begin
- 
-       accept Start;      -- Wait for trigger from Main
- 
-       for i in 1..2 loop  -- arbitrarily limit to two messages for the test
-          declare 
-             -- Create a task for the next message
-             Next_Message_Task : acc_Message_Task := new Message_Task;
-             -- Create a record for it
-             Next_Transaction : acc_Transaction_Record 
-                                                  := new Transaction_Record;
-          begin
-             if TC_Last_was_for_credit then
-                Build_Debit_Record ( Next_Transaction );            
-             else
-                Build_Credit_Record( Next_Transaction );
-                TC_Last_was_for_credit := true;
-             end if;
-             Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-          end;   -- declare
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
-    
- 
- 
-    task body Message_Task is
- 
-       TC_Original_Transaction_Code : Transaction_Code;  
-       This_Transaction : acc_Transaction_Record := new Transaction_Record;
- 
-    begin
-       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
-          This_Transaction.all := In_Transaction.all;
-       end Accept_Transaction;
- 
-       -- Note the original code to ensure correct return
-       TC_Original_Transaction_Code := This_Transaction.Code;
-  
-       -- Queue up on Distributor's Input queue
-       Distributor.Input ( This_Transaction );
-       -- This task will now wait for the requeued rendezvous 
-       -- to complete before proceeding
- 
-       -- After the required computations have been performed
-       -- return the Transaction_Record appropriately (probably to an output
-       -- line driver)
-       null;            -- stub
- 
-       
-       -- The following is all Test Control Code
- 
-       -- Check that the return values are as expected
-       if TC_Original_Transaction_Code /= This_Transaction.Code then
-          -- Incorrect rendezvous
-          Report.Failed ("Message Task: Incorrect code returned");
-       end if;
- 
-       if This_Transaction.Code = Credit then
-          if This_Transaction.Return_Value     /= Credit_Return or   
-             This_Transaction.TC_Message_Count /= 1             or not
-             This_Transaction.TC_Thru_Distrib     then
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Credit_Message.Mark_Complete;
-       else
-          if This_Transaction.Return_Value     /= Debit_Return or   
-             This_Transaction.TC_Message_Count /= 1             or not
-             This_Transaction.TC_Thru_Distrib      then
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Debit_Message.Mark_Complete;
-       end if;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Message_Task");
- 
-    end Message_Task;
- 
- 
- 
-    -- Dispose each input Transaction_Record to the appropriate
-    -- computation tasks
-    --
-    task body Distributor is
- 
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Mark the message as having passed through the distributor
-                Transaction.TC_Thru_Distrib := true;
- 
-                -- Pass this transaction on the appropriate computation
-                -- task
-                case Transaction.Code is 
-                   when Credit =>
-                      requeue Credit_Computation.Input with abort;
-                   when Debit => 
-                      requeue Debit_Computation.Input with abort;
-                end case;
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Distributor");
-    end Distributor;
-                                           
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    --                                           
-    task body Credit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select 
-             accept Input ( Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this transaction
-                null;      -- stub
- 
-                -- For the test: 
-                if not Transaction.TC_Thru_Distrib then
-                   Report.Failed 
-                          ("Credit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Credit then
-                   Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Credit_Return;
-                -- one, and only one message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    --                                                
-    task body Debit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this message
-                null;      -- stub
- 
-                -- For the test: 
-                if not Transaction.TC_Thru_Distrib then
-                   Report.Failed 
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Debit then
-                   Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Debit_Return;
-                -- one, and only one, message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Debit_Computation");
- 
- 
-    end Debit_Computation;
- 
- 
- begin -- c954011
- 
-    Report.Test ("C954011", "Requeue from task body to task entry");
- 
-    Line_Driver.Start;        -- Start the test
- 
-    -- Ensure that the message tasks complete before reporting the result
-    while not (TC_Credit_Message.Is_Complete and 
-               TC_Debit_Message.Is_Complete) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    Report.Result;
- 
- end C954011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,496 ****
- -- C954012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check a requeue within an accept body to another entry in the same task
- --     Specifically, check a call with parameters and a requeue with abort.
- --
- -- TEST DESCRIPTION:
- --      One transaction is sent through to check the paths. After
- --      processing this the Credit task sets the "overloaded" indicator.  Once
- --      this indicator is set the Distributor queues low priority transactions
- --      on a Wait_for_Underload queue in the same task using a requeue.  The
- --      Distributor still delivers high priority transactions.  After two high
- --      priority transactions have been processed by the Credit task it clears
- --      the overload condition.  The low priority transactions should now be
- --      delivered.
- --
- --      This series of tests uses a simulation of a transaction driven
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system.  The message tasks put themselves on the
- --      input queue of a Distributor which, from information in the
- --      transaction and/or system load conditions forwards them to other
- --      operating tasks. These in turn might forward the transactions to yet
- --      other tasks for further action.  The routing is, in real life, dynamic
- --      and unpredictable at the time of message generation.  All rerouting in
- --      this  model is done by means of requeues.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Nov 95   SAIC    Fixed shared global variable problem for
- --                          ACVC 2.0.1
- --      14 Mar 03   RLB     Fixed a race condition and an incorrect termination
- --                          condition in the test.
- --!
- 
- with Report;
- with ImpDef;
- with Ada.Calendar;
- 
- procedure C954012 is
- 
-    function "=" (X,Y: Ada.Calendar.Time) return Boolean
-                                                    renames Ada.Calendar."=";
- 
-    -- Arbitrary test values
-    Credit_Return : constant := 1;
-    Debit_Return  : constant := 2;
- 
- 
-    -- This is used as an "initializing" time for the messages as they are
-    -- created.  As they pass through the Distributor they get a time_stamp
-    -- of the current time. An arbitrary base time is chosen.
-    --    TC: this fact is used, incidentally, to check that the messages have,
-    --    indeed, passed through the Distributor as expected.
-    --
-    Base_Time : Ada.Calendar.Time := Ada.Calendar.Time_of(1959,3,9);
- 
- 
-    -- Mechanism to count the number of Credit Message tasks completed
-    protected TC_Tasks_Completed is
-       procedure Increment;
-       function  Count return integer;
-    private
-       Number_Complete : integer := 0;
-    end TC_Tasks_Completed;
- 
-    protected type Shared_Boolean (Initial_Value : Boolean := False) is
-       procedure Set_True;
-       procedure Set_False;
-       function  Value return Boolean;
-    private
-       Current_Value : Boolean := Initial_Value;
-    end Shared_Boolean;
- 
-    protected body Shared_Boolean is
-       procedure Set_True is
-       begin
-          Current_Value := True;
-       end Set_True;
- 
-       procedure Set_False is
-       begin
-          Current_Value := False;
-       end Set_False;
- 
-       function Value return Boolean is
-       begin
-          return Current_Value;
-       end Value;
-    end Shared_Boolean;
- 
-    TC_Debit_Message_Complete    : Shared_Boolean (False);
-    -- Handshaking mechanism between the Line Driver and the Credit task
-    TC_First_Message_Has_Arrived : Shared_Boolean (False);
-    Credit_Overloaded : Shared_Boolean (False);
- 
-    TC_Credit_Messages_Expected  : constant integer := 5;
- 
-    type Transaction_Code is (Credit, Debit);
-    type Transaction_Priority is (High, Low);
- 
-    type Transaction_Record;
-    type acc_Transaction_Record is access Transaction_Record;
-    type Transaction_Record is
-       record
-          ID               : integer := 0;
-          Code             : Transaction_Code := Debit;
-          Priority         : Transaction_Priority := High;
-          Account_Number   : integer := 0;
-          Stock_Number     : integer := 0;
-          Quantity         : integer := 0;
-          Return_Value     : integer := 0;
-          Message_Count    : integer := 0;          -- for test
-          Time_Stamp       : Ada.Calendar.Time := Base_Time;
-       end record;
- 
- 
-    task type Message_Task is
-       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-    end Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is
-       entry Start;
-    end Line_Driver;
- 
-    task Distributor is
-       entry Input (Transaction : acc_Transaction_Record);
-       entry Wait_for_Underload (Transaction : acc_Transaction_Record);
-       entry TC_Credit_OK;
-    end Distributor;
- 
-    task Credit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Debit_Computation;
- 
- 
-    -- Mechanism to count the number of Message tasks completed (Credit)
-    protected body TC_Tasks_Completed is
-       procedure Increment is
-       begin
-          Number_Complete := Number_Complete + 1;
-       end Increment;
- 
-       function Count return integer is
-       begin
-          return Number_Complete;
-       end Count;
-    end TC_Tasks_Completed;
- 
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each. The message tasks remain extant
-    --   for the life of the messages in the system.
-    --      The Line Driver task would normally be designed to loop continuously
-    --      creating the messages as input is received.  Simulate this
-    --      but limit it to the required number of dummy messages needed for
-    --      this test and allow it to terminate at that point.  Artificially
-    --      alternate High and Low priority Credit transactions for this test.
-    --
-    task body Line_Driver is
-       Current_ID       : integer := 1;
-       Current_Priority : Transaction_Priority := High;
- 
-       -- Artificial: number of messages required for this test
-       type TC_Trans_Range is range 1..6;
- 
-       procedure Build_Credit_Record
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 100;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Credit;
-             Next_Transaction.Priority := Current_Priority;
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Credit_Record;
- 
- 
-       procedure Build_Debit_Record
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 200;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Debit;
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Debit_Record;
- 
-    begin
- 
-       accept Start;   -- Wait for trigger from Main
- 
-       for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
-          declare
-             -- Create a task for the next message
-             Next_Message_Task : acc_Message_Task := new Message_Task;
-             -- Create a record for it
-             Next_Transaction : acc_Transaction_Record
-                                                  := new Transaction_Record;
-          begin
-             if Transaction_Numb = TC_Trans_Range'first then
-                -- Send the first Credit message
-                Build_Credit_Record ( Next_Transaction );
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );
-                -- TC: Wait until the first message has been received by the
-                -- Credit task and it has set the Overload indicator for the
-                -- Distributor
-                while not TC_First_Message_Has_Arrived.Value loop
-                   delay ImpDef.Minimum_Task_Switch;
-                end loop;
-             elsif Transaction_Numb = TC_Trans_Range'last then
-                -- For this test send the last transaction to the Debit task
-                -- to improve the mix
-                Build_Debit_Record( Next_Transaction );
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );
-             else
-                -- TC: Alternate high and low priority transactions
-                if Current_Priority = High then
-                   Current_Priority := Low;
-                else
-                   Current_Priority := High;
-                end if;
-                Build_Credit_Record( Next_Transaction );
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );
-             end if;
-          end;   -- declare
-       end loop;
- 
-       -- TC: Wait for Credit_Overloaded to be cleared, then insure that the
-       -- Distributor has evalated all tasks. Otherwise, some tasks may never
-       -- be evaluated.
-       while Credit_Overloaded.Value loop
-         delay ImpDef.Minimum_Task_Switch;
-       end loop;
-       Distributor.TC_Credit_OK;
- 
-    exception
-       when others =>
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
- 
- 
- 
-    task body Message_Task is
- 
-       TC_Original_Transaction_Code : Transaction_Code;
-       This_Transaction : acc_Transaction_Record := new Transaction_Record;
- 
-    begin
- 
-       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
-          This_Transaction.all := In_Transaction.all;
-       end Accept_Transaction;
- 
-       -- Note the original code to ensure correct return
-       TC_Original_Transaction_Code := This_Transaction.Code;
- 
-       -- Queue up on Distributor's Input queue
-       Distributor.Input ( This_Transaction );
-       -- This task will now wait for the requeued rendezvous
-       -- to complete before proceeding
- 
-       -- After the required computations have been performed
-       -- return the Transaction_Record appropriately (probably to an output
-       -- line driver)
-       null;            -- stub
- 
-       -- For the test check that the return values are as expected
-       if TC_Original_Transaction_Code /= This_Transaction.Code then
-          -- Incorrect rendezvous
-          Report.Failed ("Message Task: Incorrect code returned");
-       end if;
- 
-       if This_Transaction.Code = Credit then
-          if This_Transaction.Return_Value  /= Credit_Return or
-             This_Transaction.Time_Stamp     = Base_Time     then
-                Report.Failed ("Expected path not traversed");
-          end if;
-             TC_Tasks_Completed.Increment;
-       else
-          if This_Transaction.Return_Value  /= Debit_Return or
-             This_Transaction.Message_Count /= 1             or
-             This_Transaction.Time_Stamp     = Base_Time     then
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Debit_Message_Complete.Set_True;
-       end if;
- 
-    exception
-       when others =>
-          Report.Failed ("Unexpected exception in Message_Task");
- 
-    end Message_Task;
- 
- 
- 
- 
-    -- Dispose each input Transaction_Record to the appropriate
-    -- computation tasks
-    --
-    task body Distributor is
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Time_Stamp the messages with the current time
-                --    TC: Used, incidentally, by the test to check that the
-                --    message did pass through the Distributor Task
-                Transaction.Time_Stamp := Ada.Calendar.Clock;
- 
-                -- Pass this transaction on to the appropriate computation
-                -- task but temporarily hold low-priority transactions under
-                -- overload conditions
-                case Transaction.Code is
-                   when Credit =>
-                      if Credit_Overloaded.Value and
-                         Transaction.Priority = Low then
-                         requeue Wait_for_Underload with abort;
-                      else
-                         requeue Credit_Computation.Input with abort;
-                      end if;
-                   when Debit =>
-                      requeue Debit_Computation.Input with abort;
-                end case;
-             end Input;
-          or
-             when not Credit_Overloaded.Value =>
-             accept Wait_for_Underload (Transaction : acc_Transaction_Record) do
-                requeue Credit_Computation.Input with abort;
-             end Wait_for_Underload;
-          or
-             accept TC_Credit_OK;
-                -- We need this to insure that we evaluate the guards at least
-                -- once when Credit_Overloaded is False. Otherwise, tasks
-                -- could stay queued on Wait_for_Underload forever (starvation).
-          or
-             terminate;
-          end select;
-       end loop;
- 
-    exception
-       when others =>
-          Report.Failed ("Unexpected exception in Distributor");
-    end Distributor;
- 
- 
- 
-    -- Computation task.  After the computation is performed the rendezvous
-    -- in the original message task is completed.
-    --
-    task body Credit_Computation is
- 
-       Message_Count   : integer := 0;
- 
-    begin
-       loop
-          select
-             accept Input ( Transaction : acc_Transaction_Record) do
-                if Credit_Overloaded.Value and
-                   Transaction.Priority = Low then
-                   -- We should not be getting any Low Priority messages. They
-                   -- should be waiting on the Distributor's Wait_for_Underload
-                   -- queue
-                   Report.Failed
-                      ("Credit Task: Low priority transaction during overload");
-                end if;
-                -- Perform the computations required for this transaction
-                null; -- stub
- 
-                -- For the test:
-                if Transaction.Time_Stamp = Base_Time then
-                   Report.Failed
-                          ("Credit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Credit then
-                   Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- The following is all Test Control code:
-                Transaction.Return_Value := Credit_Return;
-                Message_Count := Message_Count + 1;
-                --
-                -- Now take special action depending on which Message
-                if Message_Count = 1 then
-                   -- After the first message :
-                   Credit_Overloaded.Set_True;
-                   -- Now flag the Line_Driver that the second and subsequent
-                   -- messages may now be sent
-                   TC_First_Message_Has_Arrived.Set_True;
-                end if;
-                if Message_Count = 3 then
-                   -- The two high priority transactions created subsequent
-                   -- to the overload have now been processed
-                   Credit_Overloaded.Set_False;
-                end if;
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others =>
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
- 
- 
-    -- Computation task.  After the computation is performed the rendezvous
-    -- in the original message task is completed.
-    --
-    task body Debit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this message
-                null;      -- stub
- 
-                -- For the test:
-                if Transaction.Time_Stamp = Base_Time then
-                   Report.Failed
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Debit then
-                   Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Debit_Return;
-                -- one, and only one, message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.Message_Count := Message_Count;
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others =>
-          Report.Failed ("Unexpected exception in Debit_Computation");
- 
- 
-    end Debit_Computation;
- 
- 
- begin -- c954012
-    Report.Test ("C954012", "Requeue within an accept body" &
-                            " to another entry in the same task");
- 
-    Line_Driver.Start;  -- Start the test
- 
-    -- Ensure that the message tasks complete before reporting the result
-    while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected)
-          or (not TC_Debit_Message_Complete.Value) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    Report.Result;
- 
- end C954012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,521 ****
- -- C954013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a requeue is cancelled and that the requeuing task is
- --      unaffected when the calling task is aborted. 
- --      Specifically, check requeue to an entry in a different task,
- --      requeue where the entry has parameters, and requeue with abort.
- --
- -- TEST DESCRIPTION:
- --      Abort a task that has a call requeued to the entry queue of another
- --      task.  We do this by sending two messages to the Distributor which 
- --      requeues them to the Credit task.  In the accept body of the Credit 
- --      task we wait for the second message to arrive then check that an 
- --      abort of the second message task does result in the requeue being 
- --      removed.  The Line Driver task which generates the messages and the 
- --      Credit task communicate artificially in this test to arrange for the 
- --      proper timing of the messages and the abort.  One extra message is 
- --      sent to the Debit task to ensure that the Distributor is still viable
- --      and has been unaffected by the abort.
- --
- --      This series of tests uses a simulation of a transaction driven 
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then 
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system.  The message tasks put themselves on the 
- --      input queue of a Distributor which, from information in the 
- --      transaction and/or system load conditions forwards them to other 
- --      operating tasks. These in turn might forward the transactions to yet 
- --      other tasks for further action.  The routing is, in real life, dynamic
- --      and unpredictable at the time of message generation.  All rerouting in
- --      this  model is done by means of requeues.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Nov 95   SAIC    Fixed shared global variable problems for
- --                          ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;
-          
- procedure C954013 is
-  
- 
-    -- Arbitrary test values
-    Credit_Return : constant := 1;
-    Debit_Return  : constant := 2;
- 
- 
-    protected type Shared_Boolean (Initial_Value : Boolean := False) is
-       procedure Set_True;
-       procedure Set_False;
-       function  Value return Boolean;
-    private
-       Current_Value : Boolean := Initial_Value;
-    end Shared_Boolean;
- 
-    protected body Shared_Boolean is
-       procedure Set_True is
-       begin
-          Current_Value := True;
-       end Set_True;
- 
-       procedure Set_False is
-       begin
-          Current_Value := False;
-       end Set_False;
- 
-       function Value return Boolean is
-       begin
-          return Current_Value;
-       end Value;
-    end Shared_Boolean;
-  
- 
-    TC_Debit_Message_Complete  : Shared_Boolean (False);
-    TC_Credit_Message_Complete : Shared_Boolean (False);
- 
- 
-    type Transaction_Code is (Credit, Debit);
- 
-    type Transaction_Record;
-    type acc_Transaction_Record is access Transaction_Record;
-    type Transaction_Record is 
-       record
-          ID               : integer := 0;
-          Code             : Transaction_Code := Debit;
-          Account_Number   : integer := 0;
-          Stock_Number     : integer := 0;
-          Quantity         : integer := 0;
-          Return_Value     : integer := 0;
-          TC_Message_Count : integer := 0;
-          TC_Thru_Dist     : Boolean := false;
-       end record;
- 
-    
-    task type Message_Task is 
-       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-    end Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is
-       entry Start;   
-    end Line_Driver;
- 
-    task Distributor is 
-       entry Input(Transaction : acc_Transaction_Record);
-    end Distributor;
- 
-    task Credit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Debit_Computation;
- 
-    -- This protected object is here for Test Control purposes only
-    protected TC_Prt is 
-       procedure Set_First_Has_Arrived;
-       procedure Set_Second_Has_Arrived;
-       procedure Set_Abort_Has_Completed;
-       function  First_Has_Arrived   return Boolean;
-       function  Second_Has_Arrived  return Boolean;
-       function  Abort_Has_Completed return Boolean;
-    private 
-       First_Flag, Second_Flag, Abort_Flag : Boolean := false;
-    end TC_Prt;
- 
-    protected body TC_Prt is
- 
-       Procedure Set_First_Has_Arrived is
-       begin
-          First_Flag := true;
-       end Set_First_Has_Arrived;
- 
-       Procedure Set_Second_Has_Arrived is
-       begin
-          Second_Flag := true;
-       end Set_Second_Has_Arrived;
- 
-       Procedure Set_Abort_Has_Completed is
-       begin
-          Abort_Flag := true;
-       end Set_Abort_Has_Completed;
-    
-       Function First_Has_Arrived return boolean is
-       begin
-          return First_Flag;
-       end First_Has_Arrived;
- 
-       Function Second_Has_Arrived return boolean is
-       begin
-          return Second_Flag;
-       end Second_has_Arrived;
- 
-       Function Abort_Has_Completed return boolean is
-       begin
-          return Abort_Flag;
-       end Abort_Has_Completed;
-    
-    end TC_PRT;
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each. The message tasks remain extant
-    --   for the life of the messages in the system.
-    --      TC: The Line Driver task would normally be designed to loop
-    --      continuously creating the messages as input is received.  Simulate
-    --      this  but limit it to three dummy messages for this test and use
-    --      special artificial checks to pace the messages out under controlled
-    --      conditions for the test; allow it to terminate at the end
-    --
-    task body Line_Driver is
-       Current_ID : integer := 1;
-       TC_First_message_sent: Boolean := false;
- 
-       procedure Build_Credit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 100;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Credit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Credit_Record;     
- 
- 
-       procedure Build_Debit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 200;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Debit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Debit_Record;     
- 
-    begin
-       
-       accept Start;       -- Wait for trigger from main
- 
-       for i in 1..3 loop  -- TC: arbitrarily limit to two credit messages
-                           --     and one debit, then complete
-          declare 
-             -- Create a task for the next message
-             Next_Message_Task : acc_Message_Task := new Message_Task;
-             -- Create a record for it
-             Next_Transaction : acc_Transaction_Record :=
-                                                        new Transaction_Record;
-          begin
-             if not TC_First_Message_Sent then
-                -- send out the first message to start up the Credit task
-                Build_Credit_Record ( Next_Transaction );            
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-                TC_First_Message_Sent := true;
-             elsif not TC_Prt.Abort_Has_Completed then
-                -- We have not yet processed the second message
-                -- Wait to send the second message until we know the first
-                -- has arrived at the Credit task and that task is in the 
-                -- accept body 
-                while not TC_Prt.First_Has_Arrived loop
-                   delay ImpDef.Minimum_Task_Switch;   
-                end loop;
- 
-                -- We can now send the second message
-                Build_Credit_Record( Next_Transaction );
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-                
-                -- Now wait for the second to arrive on the Credit input queue
-                while not TC_Prt.Second_Has_Arrived loop
-                   delay ImpDef.Minimum_Task_Switch;   
-                end loop;
-                
-                -- At this point: The Credit task is in the accept block 
-                -- dealing with the first message and the second message is
-                -- is on the input queue
-                abort Next_Message_Task.all;  -- Note: we are still in the 
-                                              -- declare block for the 
-                                              -- second message task
- 
-                -- Make absolutely certain that all the actions
-                -- associated with the abort have been completed, that the
-                -- task has gone from Abnormal right through to
-                -- Termination.  All requeues that are to going to be
-                -- cancelled will have been by the point of Termination.
-                while not Next_Message_Task.all'terminated loop
-                   delay ImpDef.Minimum_Task_Switch;   
-                end loop;
- 
- 
-                -- We now signal the Credit task that the abort has taken place
-                -- so that it can check that the entry queue is empty as the
-                -- requeue should have been cancelled
-                TC_Prt.Set_Abort_Has_Completed;
-             else
-                -- The main part of the test is complete. Send one Debit message
-                -- as further exercise of the Distributor to ensure it has not
-                -- been affected by the cancellation of the requeue.
-                Build_Debit_Record ( Next_Transaction );            
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-             end if;
-          end;   -- declare
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
-    
- 
- 
-    task body Message_Task is
- 
-       TC_Original_Transaction_Code : Transaction_Code;  
-       This_Transaction : acc_Transaction_Record := new Transaction_Record;
- 
-    begin
-       
-       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
-          This_Transaction.all := In_Transaction.all;
-       end Accept_Transaction;      
- 
-       -- Note the original code to ensure correct return
-       TC_Original_Transaction_Code := This_Transaction.Code;
-                                                                   
-       -- Queue up on Distributor's Input queue
-       Distributor.Input ( This_Transaction );
-       -- This task will now wait for the requeued rendezvous 
-       -- to complete before proceeding
-                                              
-       -- After the required computations have been performed
-       -- return the Transaction_Record appropriately (probably to an output
-       -- line driver)
-       null;            -- stub
-       
-       -- For the test check that the return values are as expected
-       if TC_Original_Transaction_Code /= This_Transaction.Code then
-          -- Incorrect rendezvous
-          Report.Failed ("Message Task: Incorrect code returned");
-       end if;
- 
-       if This_Transaction.Code = Credit then
-          if This_Transaction.Return_Value     /= Credit_Return or   
-             This_Transaction.TC_Message_Count /= 1             or not
-             This_Transaction.TC_Thru_Dist                      then 
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Credit_Message_Complete.Set_True;
-       else
-          if This_Transaction.Return_Value     /= Debit_Return  or   
-             This_Transaction.TC_Message_Count /= 1             or not
-             This_Transaction.TC_Thru_Dist                      then 
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Debit_Message_Complete.Set_True;
-       end if;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Message_Task");
- 
-    end Message_Task;
- 
- 
- 
-    -- Dispose each input Transaction_Record to the appropriate
-    -- computation tasks
-    --
-    task body Distributor is
- 
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Show that this message did pass through the Distributor Task
-                Transaction.TC_Thru_Dist := true;
- 
-                -- Pass this transaction on the appropriate computation
-                -- task
-                case Transaction.Code is 
-                   when Credit =>
-                      requeue Credit_Computation.Input with abort;
-                   when Debit => 
-                      requeue Debit_Computation.Input with abort;
-                end case;
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Distributor");
-    end Distributor;
-                                           
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    task body Credit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select 
-             accept Input ( Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this transaction
-                --
-                null;     -- stub
- 
-                -- The rest of this code is for Test Control
-                --
-                if not Transaction.TC_Thru_Dist then 
-                   Report.Failed 
-                          ("Credit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Credit then
-                   Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Credit_Return;
-                -- one, and only one message should pass through
-                if Message_Count /= 0 then
-                   Report.Failed ("Aborted Requeue was not cancelled -1");
-                end if;
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-          
-                
-                -- Having done the basic housekeeping we now need to signal
-                -- that we are in the accept body of the credit task.  The
-                -- first message has arrived and the Line Driver may now send
-                -- the second one
-                TC_Prt.Set_First_Has_Arrived;
- 
-                -- Now wait for the second to arrive
- 
-                while Input'Count = 0 loop
-                   delay ImpDef.Minimum_Task_Switch;   
-                end loop;
-                -- Second message has been requeued - the Line driver may 
-                -- now abort the calling task
-                TC_Prt.Set_Second_Has_Arrived;
- 
-                -- Now wait for the Line Driver to signal that the abort of
-                -- the first task is complete - the requeue should be cancelled
-                -- at this time
-                while not TC_Prt.Abort_Has_Completed loop
-                   delay ImpDef.Minimum_Task_Switch;   
-                end loop;
-                
-                if Input'Count /=0 then
-                   Report.Failed ("Aborted Requeue was not cancelled -2");
-                end if;
-                -- We can now complete the rendezvous with the first caller
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    task body Debit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this message
-                --
-                null;      -- stub
- 
-                -- The rest of this code is for Test Control
-                --
-                if not Transaction.TC_Thru_Dist then 
-                   Report.Failed 
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Debit then
-                   Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Debit_Return;
-                -- one, and only one, message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Debit_Computation");
- 
- 
-    end Debit_Computation;
- 
- 
- begin -- c954013
- 
-    Report.Test ("C954013", "Abort a task that has a call requeued");
- 
-    Line_Driver.Start;   -- start the test
- 
-    -- Wait for the message tasks to complete before calling Report.Result.
-    -- Although two Credit tasks are generated one is aborted so only
-    -- one completes, thus a single flag is sufficient
-    -- Note: the test will hang here if there is a problem with the 
-    -- completion of the tasks
-    while not (TC_Credit_Message_Complete.Value and 
-               TC_Debit_Message_Complete.Value) loop
-       delay ImpDef.Minimum_Task_Switch;   
-    end loop;
- 
-    Report.Result;
- 
- end C954013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,485 ****
- -- C954014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that a requeue is not canceled and that the requeueing 
- --     task is unaffected when a calling task is aborted. Check that the
- --     abort is deferred until the entry call is complete.
- --     Specifically, check requeue to an entry in a different task,
- --     requeue where the entry call has parameters, and requeue
- --     without the abort option.
- --
- -- TEST DESCRIPTION
- --     In the Driver create a task that places a call on the
- --     Distributor.  In the Distributor requeue this call on the Credit task.
- --     Abort the calling task when it is known to be in rendezvous with the
- --     Credit task. (We arrange this by using artificial synchronization
- --     points in the Driver and the accept body of the Credit task) Ensure
- --     that the abort is deferred (the task is not terminated) until the
- --     accept body completes.   Afterwards, send one extra message through
- --     the Distributor to check that the requeueing task has not been
- --     disrupted. 
- --
- --     This series of tests uses a simulation of a transaction driven
- --     processing system.  Line Drivers accept input from an external source
- --     and build them into transaction records.  These records are then
- --     encapsulated in message tasks which remain extant for the life of the
- --     transaction in the system.  The message tasks put themselves on the
- --     input queue of a Distributor which, from information in the
- --     transaction and/or system load conditions forwards them to other
- --     operating tasks. These in turn might forward the transactions to yet
- --     other tasks for further action.  The routing is, in real life, dynamic
- --     and unpredictable at the time of message generation.  All rerouting in
- --     this  model is done by means of requeues.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Nov 95   SAIC    Replaced global variables with protected objects
- --                          for ACVC 2.0.1.
- --
- --!
- 
- with Report;
- with ImpDef;
-          
- procedure C954014 is
-  
-    -- Arbitrary test values
-    Credit_Return : constant := 1;
-    Debit_Return  : constant := 2;
- 
- 
-    protected type Shared_Boolean (Initial_Value : Boolean := False) is
-       procedure Set_True;
-       procedure Set_False;
-       function  Value return Boolean;
-    private
-       Current_Value : Boolean := Initial_Value;
-    end Shared_Boolean;
- 
-    protected body Shared_Boolean is
-       procedure Set_True is
-       begin
-          Current_Value := True;
-       end Set_True;
- 
-       procedure Set_False is
-       begin
-          Current_Value := False;
-       end Set_False;
- 
-       function Value return Boolean is
-       begin
-          return Current_Value;
-       end Value;
-    end Shared_Boolean;
-  
- 
-    TC_Debit_Message_Complete  : Shared_Boolean (False);
-    
-    -- Synchronization flags for handshaking between the Line_Driver
-    -- and the Accept body in the Credit Task
-    TC_Handshake_A : Shared_Boolean (False);
-    TC_Handshake_B : Shared_Boolean (False);
-    TC_Handshake_C : Shared_Boolean (False);
-    TC_Handshake_D : Shared_Boolean (False);
-    TC_Handshake_E : Shared_Boolean (False);
-    TC_Handshake_F : Shared_Boolean (False);
- 
- 
-    type Transaction_Code is (Credit, Debit);
- 
-    type Transaction_Record;
-    type acc_Transaction_Record is access Transaction_Record;
-    type Transaction_Record is 
-       record
-          ID               : integer := 0;
-          Code             : Transaction_Code := Debit;
-          Account_Number   : integer := 0;
-          Stock_Number     : integer := 0;
-          Quantity         : integer := 0;
-          Return_Value     : integer := 0;
-          TC_Message_Count : integer := 0; 
-          TC_Thru_Distrib  : Boolean;
-       end record;
- 
-    
-    task type Message_Task is 
-       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-    end Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is
-       entry start;
-    end Line_Driver;   
- 
-    task Distributor is 
-       entry Input(Transaction : acc_Transaction_Record);
-    end Distributor;
- 
-    task Credit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Debit_Computation;
- 
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each. The message tasks remain extant
-    --   for the life of the messages in the system.
-    --      TC: The Line Driver task would normally be designed to loop
-    --      continuously creating the messages as input is received.  Simulate
-    --      this  but limit it to two dummy messages for this test and use
-    --      special artificial handshaking checks with the Credit accept body
-    --      to control the test. Allow it to terminate at the end
-    --
-    task body Line_Driver is
-       Current_ID : integer := 1;
-       TC_First_message_sent: Boolean := false;
- 
-       procedure Build_Credit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 100;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Credit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Credit_Record;     
- 
- 
-       procedure Build_Debit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 200;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Debit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Debit_Record;     
- 
-    begin
-    
-       accept Start;       -- Wait for trigger from main
- 
-       for i in 1..2 loop  -- TC: arbitrarily limit to one credit message
-                           --     and one debit, then complete
-          declare 
-             -- Create a task for the next message
-             Next_Message_Task : acc_Message_Task := new Message_Task;
-             -- Create a record for it
-             Next_Transaction : acc_Transaction_Record := 
-                                                    new Transaction_Record;
-          begin
-             if not TC_First_Message_Sent then
-                -- send out the first message which will be aborted
-                Build_Credit_Record ( Next_Transaction );            
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-                TC_First_Message_Sent := true;
- 
-                -- Wait for Credit task to get into the accept body
-                --   The call from the Message Task has been requeued by
-                --   the distributor
-                while not TC_Handshake_A.Value loop
-                   delay ImpDef.Minimum_Task_Switch;
-                end loop;
- 
-                -- Abort the calling task; the Credit task is guaranteed to 
-                -- be in the accept body
-                abort Next_Message_Task.all;     -- We are still in this declare
-                                                 -- block
-               
-                -- Inform the Credit task that the abort has been initiated
-                TC_Handshake_B.Set_True;
-                
-                -- Now wait for the "acknowledgment" from the Credit task
-                -- this ensures a complete task switch (at least) 
-                while not TC_Handshake_C.Value loop
-                   delay ImpDef.Minimum_Task_Switch;
-                end loop;
- 
-                -- The aborted task must not terminate till the accept body
-                -- has completed
-                if Next_Message_Task'terminated then
-                   Report.Failed ("The abort was not deferred");
-                end if;
- 
-                -- Inform the Credit task that the termination has been checked
-                TC_Handshake_D.Set_True;
-                
-                -- Now wait for the completion of the accept body in the 
-                -- Credit task
-                while not TC_Handshake_E.Value loop
-                   delay ImpDef.Minimum_Task_Switch;
-                end loop;
-                
-                while not ( Next_Message_Task'terminated ) loop
-                   delay ImpDef.Minimum_Task_Switch;
-                end loop;
- 
-                -- Indicate to the Main program that this section is complete
-                TC_Handshake_F.Set_True;
- 
-             else
-                -- The main part of the test is complete. Send one Debit message
-                -- as further exercise of the Distributor to ensure it has not
-                -- been affected by the abort of the requeue;
-                Build_Debit_Record ( Next_Transaction );            
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-             end if;
-          end;   -- declare
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
-    
- 
-    task body Message_Task is
- 
-       TC_Original_Transaction_Code : Transaction_Code;  
-       This_Transaction : acc_Transaction_Record := new Transaction_Record;
- 
-    begin
-       
-       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
-          This_Transaction.all := In_Transaction.all;
-       end Accept_Transaction;      
- 
-       -- Note the original code to ensure correct return
-       TC_Original_Transaction_Code := This_Transaction.Code;
-                                                                   
-       -- Queue up on Distributor's Input queue
-       Distributor.Input ( This_Transaction );
-       -- This task will now wait for the requeued rendezvous 
-       -- to complete before proceeding
-                                              
-       -- After the required computations have been performed
-       -- return the Transaction_Record appropriately (probably to an output
-       -- line driver)
-       null;            -- stub
-       
-       -- For the test check that the return values are as expected
-       if TC_Original_Transaction_Code /= This_Transaction.Code then
-          -- Incorrect rendezvous
-          Report.Failed ("Message Task: Incorrect code returned");
-       end if;
- 
-       if This_Transaction.Code = Credit then
-          -- The only Credit message was the one that should have been aborted
-          Report.Failed ("Abort was not effective");
-       else
-          if This_Transaction.Return_Value     /= Debit_Return or   
-             This_Transaction.TC_Message_Count /= 1            or not
-             This_Transaction.TC_Thru_Distrib       then
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Debit_Message_Complete.Set_True;
-       end if;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Message_Task");
- 
-    end Message_Task;
- 
- 
- 
-    -- Dispose each input Transaction_Record to the appropriate 
-    -- computation tasks
-    --
-    task body Distributor is
- 
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
- 
-                -- Indicate that the  message did pass through the
-                -- Distributor Task
-                Transaction.TC_Thru_Distrib := true;
- 
-                -- Pass this transaction on the appropriate computation
-                -- task
-                case Transaction.Code is 
-                   when Credit =>
-                      requeue Credit_Computation.Input;   -- without abort
-                   when Debit => 
-                      requeue Debit_Computation.Input;    -- without abort
-                end case;
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Distributor");
-    end Distributor;
-                                           
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    task body Credit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select 
-             accept Input ( Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this transaction
-                --
-                null;     -- stub
- 
-                -- The rest of this code is for Test Control
-                --
-                if not Transaction.TC_Thru_Distrib then
-                   Report.Failed 
-                          ("Credit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Credit then
-                   Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Credit_Return;
-                -- one, and only one message should pass through
-                if Message_Count /= 0 then
-                   Report.Failed ("Aborted Requeue was not canceled -1");
-                end if;
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-                         
-                -- Having done the basic housekeeping we now need to signal
-                -- that we are in the accept body of the credit task.  The
-                -- message has arrived and the Line Driver may now abort the
-                -- calling task
-                TC_Handshake_A.Set_True;
- 
-                -- Now wait for the Line Driver to inform us the calling 
-                -- task has been aborted
-                while not TC_Handshake_B.Value loop
-                   delay ImpDef.Minimum_Task_Switch;
-                end loop;
- 
-                -- The abort has taken place
-                -- Inform the Line Driver that we are still running in the
-                -- accept body
-                TC_Handshake_C.Set_True;
- 
-                -- Now wait for the Line Driver to digest this information
-                while not TC_Handshake_D.Value loop
-                   delay ImpDef.Minimum_Task_Switch;
-                end loop;
- 
-                -- The Line driver has checked that the caller is not terminated
-                -- We can now complete the accept
-                
-             end Input;
-             -- We are out of the accept
-             TC_Handshake_E.Set_True; 
-                    
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    task body Debit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this message
-                --
-                null;      -- stub
- 
-                -- The rest of this code is for Test Control
-                --
-                if not Transaction.TC_Thru_Distrib then
-                   Report.Failed 
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Debit then
-                   Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Debit_Return;
-                -- one, and only one, message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Debit_Computation");
- 
- 
-    end Debit_Computation;
- 
- 
- begin -- c954014
-    Report.Test ("C954014", "Abort a task that has a call" &
-                                           " requeued_without_abort");
- 
-    Line_Driver.Start;   -- Start the test
- 
-    -- Wait for the message tasks to complete before reporting the result
-    --
-    while not (TC_Handshake_F.Value                  -- abort not effective?
-               and TC_Debit_Message_Complete.Value   -- Distributor affected?
-               and TC_Handshake_E.Value ) loop       -- accept not completed?
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    Report.Result;
- 
- end C954014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,549 ****
- -- C954015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that requeued calls to task entries may, in turn, be requeued.  
- --      Check that the intermediate requeues are not blocked and that the
- --      original caller remains blocked until the last requeue is complete.
- --         This test uses: 
- --                      Call with parameters
- --                      Requeue with abort
- --      
- -- TEST DESCRIPTION
- --      A call is placed on the input queue of the Distributor.  The
- --      Distributor requeues to the Credit task; the Credit task requeues to a
- --      secondary task which, in turn requeues to yet another task.  This
- --      continues down the chain.  At the furthest point of the chain the
- --      rendezvous is completed.  To verify the action, the furthest task
- --      waits in the accept statement for a second message to arrive before
- --      completing.  This second message can only arrive if none of the earlier
- --      tasks in the chain are blocked waiting for completion.   Apart from
- --      the two Credit messages which are used to check the requeue chain one
- --      Debit message is sent to validate the mix.
- --
- --                                                    
- --      This series of tests uses a simulation of a transaction driven
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system.  The message tasks put themselves on the
- --      input queue of a Distributor which, from information in the
- --      transaction and/or system load conditions forwards them to other
- --      operating tasks. These in turn might forward the transactions to yet
- --      other tasks for further action.  The routing is, in real life, dynamic
- --      and unpredictable at the time of message generation.  All rerouting in
- --      this  model is done by means of requeues.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with Report;
- with ImpDef;
-          
- procedure C954015 is
-  
-    -- Arbitrary test values
-    Credit_Return : constant := 1;
-    Debit_Return  : constant := 2;
- 
-    -- Mechanism to count the number of Credit Message tasks completed
-    protected TC_Tasks_Completed is
-       procedure Increment;
-       function  Count return integer;
-    private
-       Number_Complete : integer := 0;
-    end TC_Tasks_Completed;
-    
-    TC_Expected_To_Complete   : constant integer := 3;
- 
- 
-    -- Values added to the Return_Value indicating passage through the
-    -- particular task
-    TC_Credit_Value :  constant integer := 1;
-    TC_Sub_1_Value  :  constant integer := 2;
-    TC_Sub_2_Value  :  constant integer := 3;
-    TC_Sub_3_Value  :  constant integer := 4;
-    TC_Sub_4_Value  :  constant integer := 5;
-    --
-    TC_Full_Value   :  integer := TC_Credit_Value + TC_Sub_1_Value + 
-                                  TC_Sub_2_Value  + TC_Sub_3_Value +
-                                  TC_Sub_4_Value;
- 
-    type Transaction_Code is (Credit, Debit);
- 
-    type Transaction_Record;
-    type acc_Transaction_Record is access Transaction_Record;
-    type Transaction_Record is 
-       record
-          ID               : integer := 0;
-          Code             : Transaction_Code := Debit;
-          Account_Number   : integer := 0;
-          Stock_Number     : integer := 0;
-          Quantity         : integer := 0;
-          Return_Value     : integer := 0;
-          TC_Message_Count : integer := 0;
-          TC_Thru_Distrib  : Boolean := false;
-       end record;
- 
- 
-    task type Message_Task is 
-       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-    end Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is
-       entry Start;
-    end Line_Driver;   
- 
-    task Distributor is 
-       entry Input(Transaction : acc_Transaction_Record);
-    end Distributor;
- 
-    task Credit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Debit_Computation;
- 
-    -- The following are almost identical for the purpose of the test
-    task Credit_Sub_1 is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Sub_1;
-    --
-    task Credit_Sub_2 is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Sub_2;
-    --
-    task Credit_Sub_3 is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Sub_3;
- 
-    -- This is the last in the chain
-    task Credit_Sub_4 is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Sub_4;
-   
-    
-    -- Mechanism to count the number of Message tasks completed (Credit)
-    protected body TC_Tasks_Completed is
-       procedure Increment is
-       begin
-          Number_Complete := Number_Complete + 1;
-       end Increment;
- 
-       function Count return integer is
-       begin
-          return Number_Complete;
-       end Count;
-    end TC_Tasks_Completed;
- 
- 
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each. The message tasks remain extant
-    --   for the life of the messages in the system.
-    --      The Line Driver task would normally be designed to loop continuously
-    --      creating the messages as input is received.  Simulate this 
-    --      but limit it to the number of dummy messages needed for this 
-    --      test and allow it to terminate at that point. 
-    --
-    task body Line_Driver is
-       Current_ID : integer := 1;
-       TC_Last_was_for_credit : Boolean := false;
- 
-        -- Arbitrary limit for the number of messages sent for this test
-       type TC_Trans_Range is range 1..3;
- 
-       procedure Build_Credit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 100;
-       begin
-          Next_Transaction.ID := Current_ID;
-          Next_Transaction.Code := Credit; 
-          Next_Transaction.Account_Number := Dummy_Account;
-          Current_ID := Current_ID + 1;
-       end Build_Credit_Record;     
- 
-       procedure Build_Debit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 200;
-       begin
-          Next_Transaction.ID := Current_ID;
-          Next_Transaction.Code := Debit; 
-          Next_Transaction.Account_Number := Dummy_Account;
-          Current_ID := Current_ID + 1;
-       end Build_Debit_Record;     
- 
- 
-    begin
- 
-       accept Start;   -- wait for trigger from Main
-       
-       -- Arbitrarily limit the loop to the number needed for this test only
-       for Transaction_Numb in TC_Trans_Range  loop
-          declare 
-             -- Create a task for the next message
-             Next_Message_Task : acc_Message_Task := new Message_Task;
-             -- Create a record for it
-             Next_Transaction : acc_Transaction_Record := 
-                                                 new Transaction_Record;
-          begin
-             -- Artificially send out in the order required
-             case Transaction_Numb is
-                when 1 => 
-                   Build_Credit_Record( Next_Transaction );
-                when 2 =>
-                   Build_Credit_Record( Next_Transaction );
-                when 3 =>
-                   Build_Debit_Record ( Next_Transaction );            
-             end case;
- 
-             -- Present the record to the message task
-             Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-          end;   -- declare
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
- 
- 
-    task body Message_Task is
- 
-       TC_Original_Transaction_Code : Transaction_Code;  
-       This_Transaction : acc_Transaction_Record := new Transaction_Record;
- 
-    begin
-       
-       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
-          This_Transaction.all := In_Transaction.all;
-       end Accept_Transaction;
- 
-       -- Note the original code to ensure correct return
-       TC_Original_Transaction_Code := This_Transaction.Code;
-  
-       -- Queue up on Distributor's Input queue
-       Distributor.Input ( This_Transaction );
-       -- This task will now wait for the requeued rendezvous 
-       -- to complete before proceeding
- 
-       -- After the required computations have been performed
-       -- return the Transaction_Record appropriately (probably to an output
-       -- line driver)
-       null;            -- stub
- 
-       
-       -- The following is all Test Control Code
- 
-       -- Check that the return values are as expected
-       if TC_Original_Transaction_Code /= This_Transaction.Code then
-          -- Incorrect rendezvous
-          Report.Failed ("Message Task: Incorrect code returned");
-       end if;
- 
-       if This_Transaction.Code = Credit then
-          if This_Transaction.Return_Value  /= TC_Full_Value or not  
-             This_Transaction.TC_Thru_Distrib       then
-                Report.Failed ("Expected path not traversed - CR");
-          end if;
-          if 
-             This_Transaction.TC_Message_Count not in 1..2 then
-                Report.Failed ("Incorrect Message Count");
-          end if;
-       else
-          if This_Transaction.Return_Value  /= Debit_Return or   
-             This_Transaction.TC_Message_Count /= 1            or not
-             This_Transaction.TC_Thru_Distrib     then
-                Report.Failed ("Expected path not traversed - DB");
-          end if;
-       end if;
-       TC_Tasks_Completed.Increment;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Message_Task");
- 
-    end Message_Task;
- 
- 
- 
-    -- Dispose each input Transaction_Record to the appropriate 
-    -- computation tasks
-    --
-    task body Distributor is
- 
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Show that the message did pass through the Distributor Task
-                Transaction.TC_Thru_Distrib := true;
- 
-                -- Pass this transaction on to the appropriate computation
-                -- task
-                case Transaction.Code is 
-                   when Credit =>
-                      requeue Credit_Computation.Input with abort;
-                   when Debit => 
-                      requeue Debit_Computation.Input with abort;
-                end case;
-             end Input;
-          or
-             terminate;
-          end select;
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Distributor");
-    end Distributor;
-                                           
- 
- 
-                                                 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task the message is
-    --   passed on for further processing to some subsidiary task.  The choice
-    --   of subsidiary task is made according to criteria not specified in
-    --   this test.  
-    --                                           
-    task body Credit_Computation is
-       Message_Count   : integer := 0;   
-    begin
-       loop
-          select 
-             accept Input ( Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this transaction
-                null;      -- stub
- 
-                -- For the test: 
-                if not Transaction.TC_Thru_Distrib then
-                   Report.Failed 
-                          ("Credit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Credit then
-                   Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test, plug a known value and count
-                Transaction.Return_Value := TC_Credit_Value;
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
- 
-                -- Depending on transaction content send it on to the
-                -- some other task for further processing
-                -- TC: Arbitrarily send the message on to Credit_Sub_1
-                requeue Credit_Sub_1.Input with abort;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
- 
- 
-    task body Credit_Sub_1 is
-    begin
-       loop
-          select
-             accept Input(Transaction : acc_Transaction_Record) do
-                -- Process this transaction
-                null;   -- stub
-             
-                -- Add the value showing passage through this task
-                Transaction.Return_Value := 
-                                     Transaction.Return_Value + TC_Sub_1_Value;
-                -- Depending on transaction content send it on to the
-                -- some other task for further processing
-                -- Arbitrarily send the message on to Credit_Sub_2
-                requeue Credit_Sub_2.Input with abort;  
-             end Input;
-          or 
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Sub_1");
- 
-    end Credit_Sub_1;
- 
-    task body Credit_Sub_2 is
-    begin
-       loop
-          select
-             accept Input(Transaction : acc_Transaction_Record) do
-                -- Process this transaction
-                null;   -- stub
-             
-                -- Add the value showing passage through this task
-                Transaction.Return_Value := 
-                                     Transaction.Return_Value + TC_Sub_2_Value;
-                -- Depending on transaction content send it on to the
-                -- some other task for further processing
-                -- Arbitrarily send the message on to Credit_Sub_3
-                requeue Credit_Sub_3.Input with abort;  
-             end Input;
-          or 
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Sub_2");
-    end Credit_Sub_2;
- 
-    task body Credit_Sub_3 is
-    begin
-       loop
-          select
-             accept Input(Transaction : acc_Transaction_Record) do
-                -- Process this transaction
-                null;   -- stub
-             
-                -- Add the value showing passage through this task
-                Transaction.Return_Value := 
-                                     Transaction.Return_Value + TC_Sub_3_Value;
-                -- Depending on transaction content send it on to the
-                -- some other task for further processing
-                -- Arbitrarily send the message on to Credit_Sub_4
-                requeue Credit_Sub_4.Input with abort;  
-             end Input;
-          or 
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Sub_3");
-    end Credit_Sub_3;
- 
-    -- This is the last in the chain of tasks to which transactions will
-    -- be requeued
-    --
-    task body Credit_Sub_4 is
-    
-       TC_First_Message : Boolean := true;
- 
-    begin
-       loop
-          select
-             accept Input(Transaction : acc_Transaction_Record) do
-                -- Process this transaction
-                null;   -- stub
-             
-                -- Add the value showing passage through this task
-                Transaction.Return_Value := 
-                                     Transaction.Return_Value + TC_Sub_4_Value;
-                -- TC: stay in the accept body dealing with the first message
-                -- until the second arrives.  If any of the requeues are 
-                -- blocked the test will hang here indicating failure
-                if TC_First_Message then
-                   while Input'count = 0 loop
-                      delay ImpDef.Minimum_Task_Switch;
-                   end loop;
-                TC_First_Message := false;
-                end if;
-                -- for the second message, just complete the rendezvous
-             end Input;
-          or 
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Sub_4");
-    end Credit_Sub_4;
- 
- 
-                                                 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    --                                                
-    task body Debit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this message
-                null;      -- stub
- 
-                -- For the test: 
-                if not Transaction.TC_Thru_Distrib then
-                   Report.Failed 
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Debit then
-                   Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Debit_Return;
-                -- one, and only one, message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Debit_Computation");
- 
- 
-    end Debit_Computation;
- 
- 
- begin 
- 
-    Report.Test ("C954015", "Test multiple levels of requeue to task entry");
- 
-    Line_Driver.Start;  -- Start the test
- 
-    -- Ensure that the message tasks completed before calling Result
-    while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    Report.Result;
- 
- end C954015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954016.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954016.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954016.a	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- C954016.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that when a task that is called by a requeue is aborted, the 
- --      original caller receives Tasking_Error and the requeuing task is 
- --      unaffected.
- --
- -- TEST DESCRIPTION:
- --      The Intermediate task requeues a call from the Original_Caller to the
- --      Receiver.  While the Receiver is in the accept body for this
- --      rendezvous the Main aborts it.  Check that Tasking_Error is raised in
- --      the Original_Caller, that the Receiver does, indeed, get aborted and
- --      the Intermediate task is undisturbed.
- --      There are several delay loops in this test any one of which could 
- --      cause it to hang which would constitute failure.  
- --      
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Nov 95   SAIC    Replaced shared global variable with protected
- --                          object for ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- procedure C954016 is
- 
-    TC_Original_Caller_Complete  : Boolean := false;
-    TC_Intermediate_Complete     : Boolean := false;
- 
- 
-    protected type Shared_Boolean (Initial_Value : Boolean := False) is
-       procedure Set_True;
-       procedure Set_False;
-       function  Value return Boolean;
-    private
-       Current_Value : Boolean := Initial_Value;
-    end Shared_Boolean;
- 
-    protected body Shared_Boolean is
-       procedure Set_True is
-       begin
-          Current_Value := True;
-       end Set_True;
- 
-       procedure Set_False is
-       begin
-          Current_Value := False;
-       end Set_False;
- 
-       function Value return Boolean is
-       begin
-          return Current_Value;
-       end Value;
-    end Shared_Boolean;
-  
-    TC_Receiver_in_Accept        : Shared_Boolean (False);
- 
- 
-    task Original_Caller is
-       entry Start;
-    end Original_Caller;
- 
-    task Intermediate is
-       entry Input;
-       entry TC_Abort_Process_Complete;
-    end Intermediate;
-    
-    task Receiver is
-       entry Input;
-       entry TC_Never_Called;
-    end Receiver;
- 
-    
-    task body Original_Caller is
-    begin 
-       accept Start;    -- wait for the trigger from Main
- 
-       Intermediate.Input;
-       Report.Failed ("Tasking_Error not raised in Original_Caller task");
- 
-    exception
-       when tasking_error => 
-                TC_Original_Caller_Complete := true;     -- expected behavior
-       when others        => 
-                Report.Failed ("Unexpected Exception in Original_Caller task");
-    end Original_Caller;
-    
-    
-    task body Intermediate is
-    begin
-       accept Input do
-          -- Within this accept call another task
-          requeue Receiver.Input with abort;
-       end Input;
- 
-       -- Wait for Main to ensure that the abort housekeeping is finished
-       accept TC_Abort_Process_Complete;
- 
-       TC_Intermediate_Complete := true;
- 
-    exception
-       when others => 
-                 Report.Failed ("Unexpected exception in Intermediate task");
-    end Intermediate;
- 
- 
-    task body Receiver is
-    begin
-       accept Input do
-          TC_Receiver_in_Accept.Set_True;
-          -- Hang within the accept body to allow Main to abort this task
-          accept TC_Never_Called;  
-       end Input;
-    exception
-       when others  =>
-             Report.Failed ("Unexpected Exception in Receiver Task");
-                                                           
-    end Receiver;
-    
-    
- begin
-    Report.Test ("C954016", "Requeue: abort the called task");
- 
-    Original_Caller.Start;
- 
-    -- Wait till the rendezvous with Receiver is started
-    while not TC_Receiver_in_Accept.Value loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    -- At this point the Receiver is guaranteed to be in its accept
-    --
-    abort Receiver;
- 
-    -- Wait for the whole of the abort process to complete
-    while not ( Original_Caller'terminated and Receiver'terminated ) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    -- Inform the Intermediate task that the process is complete to allow
-    -- it to continue to completion itself
-    Intermediate.TC_Abort_Process_Complete;
- 
-    -- Wait for everything to settle before reporting the result
-    while not ( Intermediate'terminated ) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
- 
-    if not ( TC_Original_Caller_Complete and TC_Intermediate_Complete ) then
-       Report.Failed ("Proper paths not traversed");
-    end if;
- 
-    Report.Result;
- 
- end C954016;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954017.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954017.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954017.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954017.a	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- C954017.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that when an exception is raised in the rendezvous of a task 
- --      that was called by a requeue the exception is propagated to the 
- --      original caller and that the requeuing task is unaffected.  
- --
- -- TEST DESCRIPTION:
- --      The Intermediate task requeues a call from the Original_Caller to the
- --      Receiver.  While the Receiver is in the accept body for this
- --      rendezvous a Constraint_Error exception is raised.  Check that the 
- --      exception is propagated to the Original_Caller, that the Receiver's 
- --      normal exception logic is employed and that the Intermediate task
- --      is undisturbed.
- --      There are several delay loops in this test any one of which could 
- --      cause it to hang (and thus fail).
- --      
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Nov 95   SAIC    Fixed shared global variable problem for
- --                          ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- 
- procedure C954017 is
- 
-    TC_Original_Caller_Complete   : Boolean := false;
-    TC_Intermediate_Complete      : Boolean := false;
-    TC_Receiver_Complete          : Boolean := false;
-    TC_Exception                  : Exception;
- 
- 
-    protected type Shared_Boolean (Initial_Value : Boolean := False) is
-       procedure Set_True;
-       procedure Set_False;
-       function  Value return Boolean;
-    private
-       Current_Value : Boolean := Initial_Value;
-    end Shared_Boolean;
- 
-    protected body Shared_Boolean is
-       procedure Set_True is
-       begin
-          Current_Value := True;
-       end Set_True;
- 
-       procedure Set_False is
-       begin
-          Current_Value := False;
-       end Set_False;
- 
-       function Value return Boolean is
-       begin
-          return Current_Value;
-       end Value;
-    end Shared_Boolean;
-  
-    TC_Exception_Process_Complete : Shared_Boolean (False);
- 
-    task Original_Caller is
-       entry Start;
-    end Original_Caller;
- 
-    task Intermediate is
-       entry Input;
-    end Intermediate;
-    
-    task Receiver is
-       entry Input;
-    end Receiver;
- 
-    
-    task body Original_Caller is
-    begin 
-       accept Start;    -- wait for the trigger from Main
- 
-       Intermediate.Input;
-       Report.Failed ("Exception not propagated to Original_Caller");
- 
-    exception
-       when TC_Exception => 
-                TC_Original_Caller_Complete := true;     -- Expected behavior
-       when others        => 
-                Report.Failed ("Unexpected Exception in Original_Caller task");
-    end Original_Caller;
-    
-    
-    task body Intermediate is
-    begin
-       accept Input do
-          -- Within this accept call another task
-          requeue Receiver.Input with abort;
-       end Input;
- 
-       -- Wait for Main to ensure that the exception housekeeping is finished
-       while not TC_Exception_Process_Complete.Value loop
-          delay ImpDef.Minimum_Task_Switch;
-       end loop;
- 
-       TC_Intermediate_Complete := true;
- 
-    exception
-       when others => 
-                   Report.Failed ("Unexpected exception in Intermediate task");
-    end Intermediate;
- 
- 
-    task body Receiver is
-    --
-    begin
-       accept Input do
-          null;  -- the user code for the rendezvous is stubbed out
- 
-          -- Test Control: Raise an exception in the destination task which
-          -- should then be propagated
-          raise TC_Exception;
- 
-       end Input;
-    exception
-       when TC_Exception =>
-             TC_Receiver_Complete := true;  -- expected behavior
-       when others        =>
-             Report.Failed ("Unexpected Exception in Receiver Task");
-    end Receiver;
-    
-    
- begin
- 
-    Report.Test ("C954017", "Requeue: exception processing");
- 
-    Original_Caller.Start;   -- Start the test after the Report.Test
-    
-    -- Wait for the whole of the exception process to complete
-    while not ( Original_Caller'terminated and Receiver'terminated ) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    -- Inform the Intermediate task that the process is complete to allow
-    -- it to continue to completion itself
-    TC_Exception_Process_Complete.Set_True;
- 
-    -- Wait for everything to settle before reporting the result
-    while not ( Intermediate'terminated ) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
- 
-    if not ( TC_Original_Caller_Complete and 
-             TC_Intermediate_Complete    and
-             TC_Receiver_Complete)       then
-       Report.Failed ("Proper paths not traversed");
-    end if;
- 
-    Report.Result;
- 
- end C954017;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954018.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954018.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954018.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954018.a	Thu Jan  1 00:00:00 1970
***************
*** 1,227 ****
- -- C954018.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a task is aborted while a requeued call is queued 
- --      on one of its entries the original caller receives Tasking_Error
- --      and the requeuing task is unaffected.
- --         This test uses: Requeue to an entry in a different task
- --                         Parameterless call
- --                         Requeue with abort
- --
- -- TEST DESCRIPTION:
- --      The Intermediate task requeues a call from the Original_Caller to the
- --      Receiver on an entry with a guard that is always false.  While the 
- --      Original_Caller is still queued the Receiver is aborted.
- --      Check that Tasking_Error is raised in the Original_Caller, that the 
- --      Receiver does, indeed, get aborted and the Intermediate task 
- --      is undisturbed.
- --      There are several delay loops in this test any one of which could 
- --      cause it to hang and thus indicate failure.  
- --      
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with Report;
- with ImpDef;
- 
- 
- procedure C954018 is
- 
- 
-    -- Protected object to control the shared test variables
-    --
-    protected TC_State is
-       function  On_Entry_Queue return Boolean;
-       procedure Set_On_Entry_Queue; 
-       function  Original_Caller_Complete return Boolean;
-       procedure Set_Original_Caller_Complete;
-       function  Intermediate_Complete return Boolean;
-       procedure Set_Intermediate_Complete;
-    private
-       On_Entry_Queue_Flag           : Boolean := false;
-       Original_Caller_Complete_Flag : Boolean := false;
-       Intermediate_Complete_Flag    : Boolean := false;
-    end TC_State;
-    --
-    --
-    protected body TC_State is
-       function On_Entry_Queue return Boolean is
-       begin 
-          return On_Entry_Queue_Flag;
-       end On_Entry_Queue;
-       
-       procedure Set_On_Entry_Queue is
-       begin
-          On_Entry_Queue_Flag := true; 
-       end Set_On_Entry_Queue; 
- 
-       function Original_Caller_Complete return Boolean is
-       begin
-          return Original_Caller_Complete_Flag;
-       end Original_Caller_Complete;
- 
-       procedure Set_Original_Caller_Complete is
-       begin
-          Original_Caller_Complete_Flag := true;
-       end Set_Original_Caller_Complete;
- 
-       function Intermediate_Complete return Boolean is
-       begin
-          return Intermediate_Complete_Flag;
-       end Intermediate_Complete;
- 
-       procedure Set_Intermediate_Complete is
-       begin
-          Intermediate_Complete_Flag := true;
-       end Set_Intermediate_Complete;
- 
-    end TC_State;
- 
-    --================================
- 
-    task Original_Caller is
-       entry Start;
-    end Original_Caller;
- 
-    task Intermediate is
-       entry Input;
-       entry TC_Abort_Process_Complete;
-    end Intermediate;
-    
-    task Receiver is
-       entry Input;
-    end Receiver;
- 
-    
-    task body Original_Caller is
-    begin 
-       accept Start;    -- wait for the trigger from Main
- 
-       Intermediate.Input;
-       Report.Failed ("Tasking_Error not raised in Original_Caller task");
- 
-    exception
-       when tasking_error => 
-                TC_State.Set_Original_Caller_Complete; -- expected behavior
-       when others        => 
-                Report.Failed ("Unexpected Exception in Original_Caller task");
-    end Original_Caller;
-    
-    
-    task body Intermediate is
-    begin
-       accept Input do
-          -- Within this accept call another task
-          TC_State.Set_On_Entry_Queue;
-          requeue Receiver.Input with abort;  
-          Report.Failed ("Requeue did not complete the Accept");
-       end Input;
- 
-       -- Wait for Main to ensure that the abort housekeeping is finished
-       accept TC_Abort_Process_Complete;
- 
-       TC_State.Set_Intermediate_Complete;
- 
-    exception
-       when others => 
-               Report.Failed ("Unexpected exception in Intermediate task");
-    end Intermediate;
- 
- 
-    task body Receiver is
-    begin
-       loop
-          select
-             -- A call to Input will be placed on the queue and never serviced
-             when Report.Equal (1,2) =>     -- Always false
-             accept Input do
-                Report.Failed ("Receiver in Accept");  
-             end Input;
-          or 
-             delay ImpDef.Minimum_Task_Switch;
-          end select;
-       end loop;
-    exception
-       when others =>
-             Report.Failed ("Unexpected Exception in Receiver Task");
-                                                           
-    end Receiver;
-    
-    
- begin
- 
-    Report.Test ("C954018", "Requeue: abort the called task" &
-                            " while Caller is still queued");
- 
-    Original_Caller.Start;
- 
- 
-    -- This is the main part of the test  
- 
-    -- Wait for the requeue
-    while not TC_State.On_Entry_Queue loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
-    -- Delay long enough to ensure that the requeue has "arrived" on 
-    -- the entry queue.  Note: TC_State.Set_On_Entry_Queue is called the
-    -- statement before the requeue
-    --
-    delay ImpDef.Switch_To_New_Task;
- 
-    -- At this point the Receiver is guaranteed to have the requeue on
-    -- the entry queue
-    --
-    abort Receiver;
-    
-    -- Wait for the whole of the abort process to complete
-    while not ( Original_Caller'terminated and Receiver'terminated ) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
- 
- 
-    -- Inform the Intermediate task that the process is complete to allow
-    -- it to continue to completion itself
-    Intermediate.TC_Abort_Process_Complete;
- 
-    -- Wait for everything to settle before reporting the result
-    while not ( Intermediate'terminated ) loop
-       delay ImpDef.Minimum_Task_Switch;
-    end loop;
-    
- 
-    if not ( TC_State.Original_Caller_Complete and 
-             TC_State.Intermediate_Complete )       then
-       Report.Failed ("Proper paths not traversed");
-    end if;
- 
-    Report.Result;
- 
- end C954018;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954019.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954019.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954019.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954019.a	Thu Jan  1 00:00:00 1970
***************
*** 1,314 ****
- -- C954019.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that when a requeue is to the same entry the items go to the
- --      right queue and that they are placed back on the end of the queue.
- --
- -- TEST DESCRIPTION:
- --      Simulate part of a message handling application where the messages are
- --      composed of several segments.  The sequence of the segments within the
- --      message is specified by Seg_Sequence_No.   The segments are handled by
- --      different tasks  and finally forwarded to an output driver.  The
- --      segments can arrive in any order but must be assembled into the proper
- --      sequence for final output.  There is a Sequencer task interposed
- --      before the Driver.  This takes the segments of the message off the
- --      Ordering_Queue and those that are in the right order it sends on to
- --      the driver; those that are out of order it places back on the end of
- --      the queue.
- --
- --      The test just simulates the arrival of the segments at the Sequencer.
- --      The task generating the segments handshakes with the Sequencer during
- --      the  "Await Arrival" phase  ensuring that the three segments of a
- --      message arrive in REVERSE order (the End-of-Message segment arrives
- --      first and the Header last).  In the first cycle the sequencer pulls
- --      segments off the queue and puts them back on the end till it
- --      encounters the header.  It checks the sequence of the ones it pulls
- --      off in case the segments are being put back on in the wrong part of
- --      the queue. Having cycled once through it no longer verifies the
- --      sequence - it just executes the "application" code for the correct
- --      order for dispatch to the driver.
- -- 
- --      In this simple example no attempt is made to address segments of
- --      another message arriving or any other error conditions (such as
- --      missing segments, timing etc.)
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Dec 94   SAIC    Remove parameter from requeue statement
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- procedure C954019 is
- begin
- 
- 
-    Report.Test ("C954019", "Check Requeue to the same Accept");
-    
-    declare  -- encapsulate the test
- 
-       type Segment_Sequence is range 1..8;
-       Header : constant Segment_Sequence := Segment_Sequence'first;
- 
-       type Message_Segment is record
-          ID              : integer;            -- Message ID
-          Seg_Sequence_No : Segment_Sequence;   -- Within the message
-          Alpha           : string (1..128);
-          EOM             : Boolean := false;   -- true for final msg segment
-       end record;
-       type acc_Message_Segment is access Message_Segment;
- 
-       task TC_Simulate_Arrival;
-    
-       task type Carrier_Task is
-          entry Input ( Segment : acc_Message_Segment );
-       end Carrier_Task;
-       type acc_Carrier_Task is access Carrier_Task;
-    
-       task Sequencer is
-          entry Ordering_Queue ( Segment : acc_Message_Segment );
-          entry TC_Handshake_1;
-          entry TC_Handshake_2;
-       end Sequencer;
-    
-       task Output_Driver is
-          entry Input ( Segment : acc_Message_Segment );
-       end Output_Driver;
-    
- 
-       -- Simulate the arrival of three message segments in REVERSE order
-       --
-       task body TC_Simulate_Arrival is
-          begin
- 
-             for i in 1..3 loop
-                declare
-                   -- Create a task for the next message segment
-                   Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
-                   -- Create a record for the next segment
-                   Next_Segment : acc_Message_Segment := new Message_Segment;
-                begin
-                   if i = 1 then 
-                      -- Build the EOM segment as the first to "send"
-                      Next_Segment.Seg_Sequence_No := Header + 2;
-                      Next_Segment.EOM := true;
-                   elsif i = 2 then
-                      -- Wait for the first segment to arrive at the Sequencer
-                      -- before "sending" the second
-                      Sequencer.TC_Handshake_1;
-                      -- Build the segment
-                      Next_Segment.Seg_Sequence_No := Header + 1;
-                   else 
-                      -- Wait for the second segment to arrive at the Sequencer
-                      -- before "sending" the third
-                      Sequencer.TC_Handshake_2;
-                      -- Build the segment. The last segment in order to 
-                      -- arrive will be the "header" segment
-                      Next_Segment.Seg_Sequence_No := Header;
-                   end if;
-                   -- pass the record to its carrier
-                   Next_Segment_Task.Input ( Next_Segment );
-                end;
-             end loop;
-       exception
-          when others => 
-               Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
-       end TC_Simulate_Arrival;
-    
- 
-       -- One of these is generated for each message segment and the flow 
-       -- of the segments through the system is controlled by the calls the
-       -- task makes and the requeues of those calls
-       --
-       task body Carrier_Task is
-          This_Segment : acc_Message_Segment := new Message_Segment;
-       begin
-          accept Input ( Segment : acc_Message_Segment ) do
-             This_Segment.all := Segment.all;
-          end Input;
-          null; --:: stub.  Pass the segment around the application as needed
- 
-          -- Now output the segment to the Output_Driver.  First we have to 
-          -- go through the Sequencer.  
-          Sequencer.Ordering_Queue ( This_Segment );
-       exception
-          when others => 
-               Report.Failed ("Unexpected Exception in Carrier_Task");
-       end Carrier_Task;
-    
- 
-       -- Pull segments off the Ordering_Queue and deliver them in the correct
-       -- sequence to the Output_Driver.
-       --
-       task body Sequencer is
-          Next_Needed : Segment_Sequence := Header;
-    
-          TC_Await_Arrival     : Boolean := true;
-          TC_First_Cycle       : Boolean := true;  
-          TC_Expected_Sequence : Segment_Sequence := Header+2;
-       begin
-          loop
-             select
-                accept Ordering_Queue ( Segment : acc_Message_Segment ) do
- 
-                   --=====================================================
-                   -- This part is all Test_Control code
- 
-                   if TC_Await_Arrival then
-                      -- We have to arrange that the segments arrive on the 
-                      -- queue in the right order, so we handshake with the 
-                      -- TC_Simulate_Arrival task to "send" only one at 
-                      -- a time
-                      accept TC_Handshake_1;   -- the first  has arrived
-                                               -- and has been pulled off the
-                                               -- queue
- 
-                      -- Wait for the second to arrive (the first has already
-                      -- been pulled off the queue
-                      while Ordering_Queue'count < 1 loop
-                         delay ImpDef.Minimum_Task_Switch;
-                      end loop;
-                      --
-                      accept TC_Handshake_2;   -- the second has arrived
- 
-                      -- Wait for the third to arrive
-                      while Ordering_Queue'count < 2 loop
-                         delay ImpDef.Minimum_Task_Switch;
-                      end loop;
- 
-                      -- Subsequent passes through the loop, bypass this code
-                      TC_Await_Arrival := false; 
-                               
- 
-                   end if; -- await arrival
- 
-                   if TC_First_Cycle then 
-                      -- Check the order of the original three 
-                      if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
-                         -- The segments are not being pulled off in the 
-                         -- expected sequence.  This could occur if the 
-                         -- requeue is not putting them back on the end.
-                         Report.Failed ("Sequencer: Segment out of sequence");
-                      end if; -- sequence check
-                      -- Decrement the expected sequence
-                      if TC_Expected_Sequence /= Header then
-                         TC_Expected_Sequence := TC_Expected_Sequence - 1;
-                      else 
-                         TC_First_Cycle := false; -- This is the Header - the
-                                                  -- first two segments are
-                                                  -- back on the queue
-                                                  
-                      end if; -- decrementing
-                   end if; -- first pass
-                   --=====================================================
- 
-                   -- And this is the Application code
-                   if Segment.Seg_Sequence_No = Next_Needed then
-                      if Segment.EOM then
-                         Next_Needed := Header;  -- reset for next message
-                      else
-                         Next_Needed := Next_Needed + 1;
-                      end if;
-                      requeue Output_Driver.Input with abort;
-                      Report.Failed ("Requeue did not complete accept body");
-                   else
-                      -- Not the next needed - put it back on the queue
-                      requeue Sequencer.Ordering_Queue;
-                      Report.Failed ("Requeue did not complete accept body");
-                   end if;   
-                end Ordering_Queue;
-             or
-                terminate;
-             end select;
-          end loop;
-       exception
-          when others => 
-               Report.Failed ("Unexpected Exception in Sequencer");
-       end Sequencer;
-    
- 
-       task body Output_Driver is
-          This_Segment : acc_Message_Segment := new Message_Segment;
- 
-          TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
-          TC_Segment_Total     : integer := 0;
-          TC_Expected_Total    : integer := 3;
-       begin
-          loop
-             -- Note: normally we would expect this Accept to be in a select 
-             -- with terminate.  For the test we exit the loop on completion
-             -- to give better control
-             accept Input ( Segment : acc_Message_Segment ) do 
-                This_Segment.all := Segment.all;
-             end Input;
-    
-             null;  --::: stub - output the next segment of the message
- 
-             -- The following is all test control code
-             --
-             if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
-                Report.Failed ("Output_Driver: Segment out of sequence");
-             end if;
-             TC_Expected_Sequence := TC_Expected_Sequence + 1;
- 
-             -- Now count the number of segments
-             TC_Segment_Total := TC_Segment_Total + 1;
- 
-             -- Check the number and exit loop when complete
-             -- There must be exactly TC_Expected_Total in number and
-             --    the last one must be EOM
-             --    (test will hang if < TC_Expected_Total arrive
-             --    without EOM)
-             if This_Segment.EOM then
-                -- This is the last segment.
-                if TC_Segment_Total /= TC_Expected_Total then
-                   Report.Failed ("EOM and wrong number of segments");
-                end if;
-                exit;   -- the loop and terminate the task
-             elsif TC_Segment_Total = TC_Expected_Total then
-                Report.Failed ("No EOM found");
-                exit;
-             end if;
-          end loop;
-       exception
-          when others => 
-               Report.Failed ("Unexpected Exception in Output_Driver");
-       end Output_Driver;
- 
- 
- 
-    begin  
- 
-       null;
- 
-    end; -- encapsulation
- 
-    Report.Result;
-    
- end C954019;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,422 ****
- -- C954020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a call to a protected entry can be requeued to a task
- --      entry. Check that the requeue is placed on the correct entry; that the
- --      original caller waits for the completion of the requeue and continues
- --      after the requeued rendezvous.  Check that the requeue does not block.
- --      Specifically, check a requeue with abort from a protected entry to
- --      an entry in a task.
- --
- -- TEST DESCRIPTION:
- --
- --      In the Distributor protected object, requeue two successive calls on
- --      the entries of two separate target tasks.  Each task in each of the 
- --      paths adds identifying information in the transaction being passed. 
- --      This information is checked by the Message tasks on completion
- --      ensuring that the requeues have been placed on the correct queues.
- --      There is an artificial guard on the Credit Task to ensure that the
- --      input is queued; this guard is released by the Debit task which 
- --      handles its input immediately.  This ensures that we have one of the
- --      requeued items actually queued for later handling and also verifies
- --      that the requeuing process (in the protected object) is not blocked.
- --
- --      This series of tests uses a simulation of a transaction driven 
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then 
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system. The message tasks put themselves on the 
- --      input queue of a Distributor object which, from information in the
- --      transaction and/or system load conditions forwards them to other 
- --      operating tasks. These in turn might forward the transactions to yet 
- --      other tasks for further action.  The routing is, in real life, 
- --      dynamic and unpredictable at the time of message generation. All 
- --      rerouting in this  model is done by means of requeues.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      06 Nov 95   SAIC    Fixed problems for ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;
-          
- procedure C954020 is
-    Verbose : constant Boolean := False;
-  
-    -- Arbitrary test values
-    Credit_Return : constant := 1;
-    Debit_Return  : constant := 2;
- 
-    protected type Message_Status is
-       procedure Set_Complete;
-       function Complete return Boolean;
-    private
-       Is_Complete : Boolean := False;
-    end Message_Status;
- 
-    protected body Message_Status is
-       procedure Set_Complete is
-       begin
-          Is_Complete := True;
-       end Set_Complete;
- 
-       function Complete return Boolean is
-       begin
-          return Is_Complete;
-       end Complete;
-    end Message_Status;
- 
-    TC_Debit_Message : Message_Status;
-    TC_Credit_Message : Message_Status;
- 
-    type Transaction_Code is (Credit, Debit);
- 
-    type Transaction_Record;
-    type acc_Transaction_Record is access Transaction_Record;
-    type Transaction_Record is 
-       record
-          ID               : integer := 0;
-          Code             : Transaction_Code := Debit;
-          Account_Number   : integer := 0;
-          Stock_Number     : integer := 0;
-          Quantity         : integer := 0;
-          Return_Value     : integer := 0;
-          TC_Message_Count : integer := 0; 
-          TC_Thru_Dist     : Boolean := false;
-       end record;
- 
- 
-    task type Message_Task is 
-       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-    end Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is 
-       entry Start;
-    end Line_Driver;   
- 
-    task Credit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Debit_Computation;
- 
-    protected Time_Lock is
-       procedure Credit_Start;
-       function  Credit_Enabled return Boolean;
-    private
-       Credit_OK : Boolean := false;
-    end Time_Lock;
- 
-    protected body Time_Lock is
-       procedure Credit_Start is
-       begin
-          Credit_OK := true;
-       end Credit_Start;
- 
-       function  Credit_Enabled return Boolean is 
-       begin
-          return Credit_OK;
-       end Credit_Enabled;
-    end Time_Lock;
- 
- 
- 
-    protected Distributor is
-       entry Input (Transaction : acc_Transaction_Record);
-    end Distributor;
-    --
-    --
-    -- Dispose each input Transaction_Record to the appropriate
-    -- computation tasks
-    --
-    protected body Distributor is
-       entry Input (Transaction : acc_Transaction_Record) when true is
-                                                       -- barrier is always open
-       begin
-          -- Test Control: Set the indicator in the message to show it has
-          -- passed through the Distributor object
-          Transaction.TC_thru_Dist := true;
-              
-          -- Pass this transaction on to the appropriate computation
-          -- task
-          case Transaction.Code is
-             when Credit =>
-                requeue Credit_Computation.Input with abort;
-             when Debit =>
-                requeue Debit_Computation.Input with abort;
-          end case;
-       end Input;
-    end Distributor;
- 
- 
- 
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each. The message tasks remain extant
-    --   for the life of the messages in the system.
-    --      The Line Driver task would normally be designed to loop continuously
-    --      creating the messages as input is received.  Simulate this 
-    --      but limit it to two dummy messages for this test and allow it
-    --      to terminate at that point
-    --
-    task body Line_Driver is
-       Current_ID : integer := 1;
-       TC_Last_was_for_credit : Boolean := false;
- 
-       procedure Build_Credit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 100;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Credit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Credit_Record;     
- 
- 
-       procedure Build_Debit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 200;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Debit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Debit_Record;     
- 
-    begin
- 
-       accept Start;      -- Wait for trigger from Main
- 
-       for i in 1..2 loop  -- arbitrarily limit to two messages for the test
-          declare 
-             -- Create a task for the next message
-             Next_Message_Task : acc_Message_Task := new Message_Task;
-             -- Create a record for it
-             Next_Transaction : acc_Transaction_Record 
-                                                  := new Transaction_Record;
-          begin
-             if TC_Last_was_for_credit then
-                Build_Debit_Record ( Next_Transaction );            
-             else
-                Build_Credit_Record( Next_Transaction );
-                TC_Last_was_for_credit := true;
-             end if;
-             Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-          end;   -- declare
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
-    
- 
- 
-    task body Message_Task is
- 
-       TC_Original_Transaction_Code : Transaction_Code;  
-       This_Transaction : acc_Transaction_Record := new Transaction_Record;
- 
-    begin
-       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
-          This_Transaction.all := In_Transaction.all;
-       end Accept_Transaction;
- 
-       if Verbose then
-          Report.Comment ("message task got " &
-                          Transaction_Code'Image (This_Transaction.Code));
-       end if;
- 
-       -- Note the original code to ensure correct return
-       TC_Original_Transaction_Code := This_Transaction.Code;
-  
-       -- Queue up on Distributor's Input queue
-       Distributor.Input ( This_Transaction );
-       -- This task will now wait for the requeued rendezvous 
-       -- to complete before proceeding
- 
-       -- After the required computations have been performed
-       -- return the Transaction_Record appropriately (probably to an output
-       -- line driver)
-       null;            -- stub
- 
-       
-       -- The following is all Test Control Code
- 
-       -- Check that the return values are as expected
-       if TC_Original_Transaction_Code /= This_Transaction.Code then
-          -- Incorrect rendezvous
-          Report.Failed ("Message Task: Incorrect code returned");
-       end if;
- 
-       if This_Transaction.Code = Credit then
-          if This_Transaction.Return_Value  /= Credit_Return or   
-             This_Transaction.TC_Message_Count /= 1          or 
-             not This_Transaction.TC_thru_Dist       then
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Credit_Message.Set_Complete;
-       else
-          if This_Transaction.Return_Value  /= Debit_Return or   
-             This_Transaction.TC_Message_Count /= 1         or 
-             not This_Transaction.TC_thru_Dist       then
-                Report.Failed ("Expected path not traversed");
-          end if;
-          TC_Debit_Message.Set_Complete;
-       end if;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Message_Task");
- 
-    end Message_Task;
- 
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    --                                           
-    task body Credit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select 
-             when  Time_Lock.Credit_enabled =>
-             accept Input ( Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this transaction
-                null;      -- stub
- 
-                if Verbose then
-                   Report.Comment ("Credit_Computation in accept");
-                end if;
- 
-                -- For the test: 
-                if not Transaction.TC_thru_Dist then
-                   Report.Failed 
-                          ("Credit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Credit then
-                   Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Credit_Return;
-                -- one, and only one message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
- 
-             end Input;            
-             exit;   -- only handle 1 transaction
-          else
-             -- poll until we can accept credit transaction
-             delay ImpDef.Clear_Ready_Queue;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
- 
- 
-    -- Computation task.
-    --   Note:  After the computation is performed in this task and the 
-    --          accept body is completed the rendezvous in the original
-    --          message task is completed.                              
-    --                                                
-    task body Debit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this message
-                null;      -- stub
- 
-                if Verbose then
-                   Report.Comment ("Debit_Computation in accept");
-                end if;
- 
-                -- For the test: 
-                if not Transaction.TC_thru_Dist then
-                   Report.Failed
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Debit then
-                   Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Debit_Return;
-                -- one, and only one, message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-                -- for the test: once we have completed the only Debit
-                -- message release the Credit Messages which are queued
-                -- on the Credit Input queue
-                Time_Lock.Credit_Start;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Debit_Computation");
- 
- 
-    end Debit_Computation;
- 
- 
- begin -- C954020
- 
-    Report.Test ("C954020", "Requeue, with abort, from protected entry " &
-                                                          "to task entry");
- 
-    Line_Driver.Start;        -- Start the test
- 
-    -- Ensure that the message tasks complete before reporting the result
-    while not (TC_Credit_Message.Complete and TC_Debit_Message.Complete) loop
-       delay ImpDef.Minimum_Task_Switch;   
-    end loop;
- 
-    Report.Result;
- 
- end C954020;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954021.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954021.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954021.a	Thu Jan  1 00:00:00 1970
***************
*** 1,524 ****
- -- C954021.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that a requeue within a protected entry to an entry in a
- --     different protected object is queued correctly.
- --
- -- TEST DESCRIPTION: 
- --      One transaction is sent through to check the paths. After processing
- --      this the Credit task sets the "overloaded" indicator.  Once this
- --      indicator is set the Distributor (a protected object) queues low
- --      priority transactions on a Wait_for_Underload queue in another
- --      protected object using a requeue. The Distributor still delivers high
- --      priority transactions.  After two high priority transactions have been
- --      processed by the Credit task it clears the overload condition.  The
- --      low priority transactions should now be delivered. 
- --     
- --      This series of tests uses a simulation of a transaction driven
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system.  The message tasks put themselves on the
- --      input queue of a Distributor which, from information in the
- --      transaction and/or system load conditions forwards them to other
- --      operating tasks. These in turn might forward the transactions to yet
- --      other tasks for further action.  The routing is, in real life, dynamic
- --      and unpredictable at the time of message generation.  All rerouting in
- --      this  model is done by means of requeues.
- --     
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Nov 95   SAIC    Fixed shared global variable for ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;
-          
- procedure C954021 is
-  
-    -- Arbitrary test values
-    Credit_Return : constant := 1;
-    Debit_Return  : constant := 2;
- 
- 
-    -- Mechanism to count the number of Credit Message tasks completed
-    protected TC_Tasks_Completed is
-       procedure Increment;
-       function  Count return integer;
-    private
-       Number_Complete : integer := 0;
-    end TC_Tasks_Completed;
-    
-    
-    TC_Credit_Messages_Expected  : constant integer := 5;
- 
-    protected TC_Handshake is
-       procedure Set;
-       function First_Message_Arrived return Boolean;
-    private
-       Arrived_Flag : Boolean := false;
-    end TC_Handshake;
- 
-    -- Handshaking mechanism between the Line Driver and the Credit task
-    -- 
-    protected body TC_Handshake is
-       --
-       procedure Set is
-       begin 
-          Arrived_Flag := true;
-       end Set;
-       --
-       function First_Message_Arrived return Boolean is
-       begin
-          return Arrived_Flag;
-       end First_Message_Arrived;
-       -- 
-    end TC_Handshake;
- 
- 
-    protected type Shared_Boolean (Initial_Value : Boolean := False) is
-       procedure Set_True;
-       procedure Set_False;
-       function  Value return Boolean;
-    private
-       Current_Value : Boolean := Initial_Value;
-    end Shared_Boolean;
- 
-    protected body Shared_Boolean is
-       procedure Set_True is
-       begin
-          Current_Value := True;
-       end Set_True;
- 
-       procedure Set_False is
-       begin
-          Current_Value := False;
-       end Set_False;
- 
-       function Value return Boolean is
-       begin
-          return Current_Value;
-       end Value;
-    end Shared_Boolean;
-  
-    TC_Debit_Message_Complete    : Shared_Boolean (False);
- 
-    type Transaction_Code is (Credit, Debit);
-    type Transaction_Priority is (High, Low);
- 
-    type Transaction_Record;
-    type acc_Transaction_Record is access Transaction_Record;
-    type Transaction_Record is 
-       record
-          ID               : integer := 0;
-          Code             : Transaction_Code := Debit;
-          Priority         : Transaction_Priority := High;
-          Account_Number   : integer := 0;
-          Stock_Number     : integer := 0;
-          Quantity         : integer := 0;
-          Return_Value     : integer := 0;
-          TC_Message_Count : integer := 0;  
-          TC_Thru_Dist     : Boolean := false;
-       end record;
- 
- 
-    task type Message_Task is 
-       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-    end Message_Task;
-    type acc_Message_Task is access Message_Task;
- 
-    task Line_Driver is
-       entry Start;
-    end Line_Driver;
- 
-    protected Distributor is
-       procedure Set_Credit_Overloaded;
-       procedure Clear_Credit_Overloaded;
-       function  Credit_is_Overloaded return Boolean;
-       entry     Input (Transaction : acc_Transaction_Record);
-    private
-       Credit_Overloaded : Boolean := false;
-    end Distributor;
- 
-    protected Hold is
-       procedure Underloaded;
-       entry Wait_for_Underload (Transaction : acc_Transaction_Record);
-    private
-       Release_All : Boolean := false;
-    end Hold;
- 
-    task Credit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Credit_Computation;
- 
-    task Debit_Computation is
-       entry Input(Transaction : acc_Transaction_Record);
-    end Debit_Computation;
- 
-    --
-    -- Dispose each input Transaction_Record to the appropriate
-    -- computation tasks
-    --
-    protected body Distributor is
- 
-       procedure Set_Credit_Overloaded is
-       begin
-          Credit_Overloaded := true;
-       end Set_Credit_Overloaded;
- 
-       procedure Clear_Credit_Overloaded is
-       begin
-          Credit_Overloaded := false;
-          Hold.Underloaded;       -- Release all held messages
-       end Clear_Credit_Overloaded;
-   
-       function  Credit_is_Overloaded return Boolean is
-       begin
-          return Credit_Overloaded;
-       end Credit_is_Overloaded;
- 
- 
-       entry Input (Transaction : acc_Transaction_Record) when true is
-                                                      -- barrier is always open
-       begin
-          -- Test Control: Set the indicator in the message to show it has
-          -- passed through the Distributor object
-          Transaction.TC_thru_Dist := true;
-  
-          -- Pass this transaction on to the appropriate computation
-          -- task but temporarily hold low-priority transactions under
-          -- overload conditions
-          case Transaction.Code is
-             when Credit =>
-                if Credit_Overloaded and Transaction.Priority = Low then
-                   requeue Hold.Wait_for_Underload with abort;
-                else
-                   requeue Credit_Computation.Input with abort;
-               end if;
-             when Debit =>
-               requeue Debit_Computation.Input with abort;
-          end case;
-       end Input;
-    end Distributor;
- 
- 
-    -- Low priority Message tasks are held on the Wait_for_Underload queue
-    -- while the Credit computation system is overloaded.  Once the Credit
-    -- system reached underload send all queued messages immediately
-    --
-    protected body Hold is
-       
-       -- Once this is executed the barrier condition for the entry is 
-       -- evaluated 
-       procedure Underloaded is
-       begin 
-          Release_All := true;
-       end Underloaded;
- 
-       entry Wait_for_Underload (Transaction : acc_Transaction_Record)
-                                                      when Release_All is
-       begin
-          requeue Credit_Computation.Input with abort;
-          if Wait_for_Underload'count = 0 then
-             -- Queue is purged.  Set up to hold next batch
-             Release_All := false;
-          end if; 
-       end Wait_for_Underload;
- 
-    end Hold;
-    
-    -- Mechanism to count the number of Message tasks completed (Credit)
-    protected body TC_Tasks_Completed is
-       procedure Increment is
-       begin
-          Number_Complete := Number_Complete + 1;
-       end Increment;
- 
-       function Count return integer is
-       begin
-          return Number_Complete;
-       end Count;
-    end TC_Tasks_Completed;
- 
- 
-    -- Assemble messages received from an external source
-    --   Creates a message task for each. The message tasks remain extant
-    --   for the life of the messages in the system.
-    --      The Line Driver task would normally be designed to loop continuously
-    --      creating the messages as input is received.  Simulate this 
-    --      but limit it to the required number of dummy messages needed for
-    --      this test and allow it to terminate at that point.  Artificially
-    --      alternate High and Low priority Credit transactions for this test.
-    --
-    task body Line_Driver is
-       Current_ID       : integer := 1;
-       Current_Priority : Transaction_Priority := High;      
- 
-       -- Artificial: number of messages required for this test
-       type TC_Trans_Range is range 1..6;
- 
-       procedure Build_Credit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 100;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Credit; 
-             Next_Transaction.Priority := Current_Priority;
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Credit_Record;     
- 
- 
-       procedure Build_Debit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-          Dummy_Account : constant integer := 200;
-       begin
-             Next_Transaction.ID := Current_ID;
-             Next_Transaction.Code := Debit; 
- 
-             Next_Transaction.Account_Number := Dummy_Account;
-             Current_ID := Current_ID + 1;
-       end Build_Debit_Record;     
- 
-    begin
-       
-       accept Start;   -- Wait for trigger from Main
- 
-       for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
-          declare 
-             -- Create a task for the next message
-             Next_Message_Task : acc_Message_Task := new Message_Task;
-             -- Create a record for it
-             Next_Transaction : acc_Transaction_Record := 
-                                                 new Transaction_Record;
-          begin
-             if Transaction_Numb = TC_Trans_Range'first then
-                -- Send the first Credit message
-                Build_Credit_Record ( Next_Transaction );
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-                -- TC: Wait until the first message has been received by the
-                -- Credit task and it has set the Overload indicator for the 
-                -- Distributor
-                while not TC_Handshake.First_Message_Arrived loop
-                   delay ImpDef.Minimum_Task_Switch;   
-                end loop;
-             elsif Transaction_Numb = TC_Trans_Range'last then
-                -- For this test send the last transaction to the Debit task
-                -- to improve the mix
-                Build_Debit_Record( Next_Transaction );
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-             else
-                -- TC: Alternate high and low priority transactions
-                if Current_Priority = High then
-                   Current_Priority := Low;
-                else
-                   Current_Priority := High;
-                end if;
-                Build_Credit_Record( Next_Transaction );
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-             end if;
-          end;   -- declare
-       end loop;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Line_Driver");
-    end Line_Driver;
- 
-    
- 
- 
-    task body Message_Task is
- 
-       TC_Original_Transaction_Code : Transaction_Code;  
-       This_Transaction : acc_Transaction_Record := new Transaction_Record;
- 
-    begin
-       
-       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
-          This_Transaction.all := In_Transaction.all;
-       end Accept_Transaction;
- 
-       -- Note the original code to ensure correct return
-       TC_Original_Transaction_Code := This_Transaction.Code;
-  
-       -- Queue up on Distributor's Input queue
-       Distributor.Input ( This_Transaction );
-       -- This task will now wait for the requeued rendezvous 
-       -- to complete before proceeding
- 
-       -- After the required computations have been performed
-       -- return the Transaction_Record appropriately (probably to an output
-       -- line driver)
-       null;            -- stub
-       
-       -- For the test check that the return values are as expected
-       if TC_Original_Transaction_Code /= This_Transaction.Code then
-          -- Incorrect rendezvous
-          Report.Failed ("Message Task: Incorrect code returned");
-       end if;
- 
-       if This_Transaction.Code = Credit then
-          if This_Transaction.Return_Value  /= Credit_Return   or
-          not This_Transaction.TC_thru_Dist                    then
-             Report.Failed ("Expected path not traversed - Credit");
-          end if;
-          TC_Tasks_Completed.Increment;
-       else
-          if This_Transaction.Return_Value  /= Debit_Return or   
-             This_Transaction.TC_Message_Count /= 1         or
-             not This_Transaction.TC_thru_Dist               then
-                Report.Failed ("Expected path not traversed - Debit");
-          end if;
-          TC_Debit_Message_Complete.Set_True;
-       end if;
- 
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Message_Task");
-    end Message_Task;
- 
- 
- 
- 
-   
-    -- Computation task.  After the computation is performed the rendezvous
-    -- in the original message task is completed.                              
-    task body Credit_Computation is
- 
-       Message_Count   : integer := 0;
-       
-    begin
-       loop
-          select 
-             accept Input ( Transaction : acc_Transaction_Record) do
-                if Distributor.Credit_is_Overloaded
-                                     and Transaction.Priority = Low  then 
-                   -- We should not be getting any Low Priority messages. They
-                   -- should be waiting on the Hold.Wait_for_Underload 
-                   -- queue
-                   Report.Failed 
-                      ("Credit Task: Low priority transaction during overload");
-                end if;
-                -- Perform the computations required for this transaction
-                null; -- stub
- 
-                -- For the test: 
-                if not Transaction.TC_thru_Dist then
-                   Report.Failed 
-                          ("Credit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Credit then
-                   Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- The following is all Test Control code:
-                Transaction.Return_Value := Credit_Return;
-                Message_Count := Message_Count + 1;
-                --
-                -- Now take special action depending on which Message
-                if Message_Count = 1 then 
-                   -- After the first message :
-                   Distributor.Set_Credit_Overloaded;
-                   -- Now flag the Line_Driver that the second and subsequent
-                   -- messages may now be sent
-                   TC_Handshake.Set;
-                end if;
-                if Message_Count = 3 then
-                   -- The two high priority transactions created subsequent
-                   -- to the overload have now been processed
-                   Distributor.Clear_Credit_Overloaded;
-                end if;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Credit_Computation");
-    end Credit_Computation;
- 
- 
- 
-    -- Computation task.  After the computation is performed the rendezvous
-    -- in the original message task is completed.        
-    --                      
-    task body Debit_Computation is
-       Message_Count   : integer := 0;
-    begin
-       loop
-          select
-             accept Input (Transaction : acc_Transaction_Record) do
-                -- Perform the computations required for this message
-                null;      -- stub
- 
-                -- For the test: 
-                if not Transaction.TC_thru_Dist then
-                   Report.Failed 
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                end if;
-                if Transaction.code /= Debit then
-                   Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                end if;
- 
-                -- for the test plug a known value and count
-                Transaction.Return_Value := Debit_Return;
-                -- one, and only one, message should pass through
-                Message_Count := Message_Count + 1;
-                Transaction.TC_Message_Count := Message_Count;
-             end Input;            
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Debit_Computation");
-    end Debit_Computation;
- 
- 
- begin 
-    Report.Test ("C954021", "Requeue from one entry body to an entry in" &
-                                        " another protected object");
- 
-    Line_Driver.Start;  -- Start the test
- 
- 
-    -- Ensure that the message tasks have completed before reporting result
-    while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected) 
-          and not TC_Debit_Message_Complete.Value loop
-       delay ImpDef.Minimum_Task_Switch;   
-    end loop;
- 
-    Report.Result;
- 
- end C954021;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954022.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954022.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954022.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954022.a	Thu Jan  1 00:00:00 1970
***************
*** 1,351 ****
- -- C954022.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      In an entry body requeue the call to the same entry.  Check that the
- --      items go to the right queue and that they are placed back on the end 
- --      of the queue
- --
- -- TEST DESCRIPTION:
- --      Simulate part of a message handling application where the messages are
- --      composed of several segments.  The sequence of the segments within the
- --      message is specified by Seg_Sequence_No.   The segments are handled by
- --      different tasks and finally forwarded to an output driver.  The
- --      segments can arrive in any order but must be assembled into the proper
- --      sequence for final output.  There is a Sequencer task interposed
- --      before the Driver.  This takes the segments of the message off the
- --      Ordering_Queue and those that are in the right order it sends on to
- --      the driver; those that are out of order it places back on the end of
- --      the queue.
- --
- --      The test just simulates the arrival of the segments at the Sequencer.
- --      The task generating the segments handshakes with the Sequencer during
- --      the  "Await Arrival" phase  ensuring that the three segments of a
- --      message arrive in REVERSE order (the End-of-Message segment arrives
- --      first and the Header last).  In the first cycle the sequencer pulls
- --      segments off the queue and puts them back on the end till it
- --      encounters the header.  It checks the sequence of the ones it pulls
- --      off in case the segments are being put back on in the wrong part of
- --      the queue.  Having cycled once through it no longer verifies the
- --      sequence - it just executes the "application" code for the correct
- --      order for dispatch to the driver.
- -- 
- --      In this simple example no attempt is made to address segments of
- --      another message arriving or any other error conditions (such as
- --      missing segments, timing etc.)
- -- 
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      07 Nov 95   SAIC    ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- procedure C954022 is
- 
-    -- These global Booleans are set when failure conditions inside Protected
-    -- objects are encountered.  Report.Failed cannot be called within
-    -- the object or a Bounded Error would occur
-    --
-    TC_Failed_1 : Boolean := false;
-    TC_Failed_2 : Boolean := false;
-    TC_Failed_3 : Boolean := false;
- 
- begin
- 
- 
-    Report.Test ("C954022", "Check Requeue to the same Protected Entry");
-    
-    declare  -- encapsulate the test
- 
-       type Segment_Sequence is range 1..8;
-       Header : constant Segment_Sequence := Segment_Sequence'first;
- 
-       type Message_Segment is record
-          ID              : integer;            -- Message ID
-          Seg_Sequence_No : Segment_Sequence;   -- Within the message
-          Segs_In_Message : integer;            -- Total segs this message
-          EOM             : Boolean := false;   -- true for final msg segment
-          Alpha           : string (1..128);
-       end record;
-       type acc_Message_Segment is access Message_Segment;
- 
-       task TC_Simulate_Arrival;
-    
-       task type Carrier_Task is
-          entry Input ( Segment : acc_Message_Segment );
-       end Carrier_Task;
-       type acc_Carrier_Task is access Carrier_Task;
-    
-       protected Sequencer is
-          function  TC_Arrivals return integer;
-          entry Input          ( Segment : acc_Message_Segment );
-          entry Ordering_Queue ( Segment : acc_Message_Segment );
-       private
-          Number_of_Segments_Arrived  : integer := 0;
-          Number_of_Segments_Expected : integer := 0;
-          Next_Needed : Segment_Sequence := Header;
-          All_Segments_Arrived : Boolean := false;
-          Seen_EOM             : Boolean := false;
- 
-          TC_First_Cycle       : Boolean := true;
-          TC_Expected_Sequence : Segment_Sequence := Header+2;
- 
-       end Sequencer;
-    
- 
-       task Output_Driver is
-          entry Input ( Segment : acc_Message_Segment );
-       end Output_Driver;
-    
- 
-       -- Simulate the arrival of three message segments in REVERSE order
-       --
-       task body TC_Simulate_Arrival is
-          begin
-             for i in 1..3 loop
-                declare
-                   -- Create a task for the next message segment
-                   Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
-                   -- Create a record for the next segment
-                   Next_Segment : acc_Message_Segment := new Message_Segment;
-                begin
-                   if i = 1 then 
-                      -- Build the EOM segment as the first to "send"
-                      Next_Segment.Seg_Sequence_No := Header + 2;
-                      Next_Segment.Segs_In_Message := 3;
-                      Next_Segment.EOM := true;
-                   elsif i = 2 then
-                      -- Wait for the first segment to arrive at the Sequencer
-                      -- before "sending" the second
-                      while Sequencer.TC_Arrivals < 1 loop
-                         delay ImpDef.Minimum_Task_Switch;
-                      end loop;
-                      -- Build the segment
-                      Next_Segment.Seg_Sequence_No := Header +1;
-                   else
-                      -- Wait for the second segment to arrive at the Sequencer
-                      -- before "sending" the third
-                      while Sequencer.TC_Arrivals < 2 loop
-                         delay ImpDef.Minimum_Task_Switch;
-                      end loop;                  
-                      -- Build the segment. The last segment (in order) to
-                      -- arrive will be the "header" segment
-                      Next_Segment.Seg_Sequence_No := Header;
-                   end if;
-                   -- pass the record to its carrier
-                   Next_Segment_Task.Input ( Next_Segment );
-                end;
-             end loop;
-  
- 
-       exception
-          when others => 
-               Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
-       end TC_Simulate_Arrival;
-    
- 
-       -- One of these is generated for each message segment and the flow 
-       -- of the segments through the system is controlled by the calls the
-       -- task makes and the requeues of those calls
-       --
-       task body Carrier_Task is
-          This_Segment : acc_Message_Segment := new Message_Segment;
-       begin
-          accept Input ( Segment : acc_Message_Segment ) do
-             This_Segment.all := Segment.all;
-          end Input;
-          null; --:: stub.  Pass the segment around the application as needed
- 
-          -- Now output the segment to the Output_Driver.  First we have to 
-          -- go through the Sequencer.  
-          Sequencer.Input ( This_Segment );
-       exception
-          when others => 
-               Report.Failed ("Unexpected Exception in Carrier_Task");
-       end Carrier_Task;
-    
-       -- Store segments on the Ordering_Queue then deliver them in the correct
-       -- sequence to the Output_Driver.
-       --
-       protected body Sequencer is
- 
-          function  TC_Arrivals return integer is
-          begin
-             return Number_of_Segments_Arrived;
-          end TC_Arrivals;
- 
-          
-          -- Segments arriving at the Input queue are counted and checked
-          -- against the total number of segments for the message.  They
-          -- are requeued onto the ordering queue where they are held until
-          -- all the segments have arrived.
-          entry Input ( Segment : acc_Message_Segment ) when true is
-          begin
-             -- check for EOM, if so get the number of segments in the message
-             -- Note: in this portion of code no attempt is made to address
-             -- reset for new message , end conditions, missing segments, 
-             -- segments of a different message etc.
-             Number_of_Segments_Arrived := Number_of_Segments_Arrived + 1;
-             if Segment.EOM then
-                Number_of_Segments_Expected := Segment.Segs_In_Message;
-                Seen_EOM := true;
-             end if;
- 
-             if Seen_EOM then
-                if Number_of_Segments_Arrived = Number_of_Segments_Expected then
-                   -- This is the last segment for this message
-                   All_Segments_Arrived := true;    -- clear the barrier
-                end if;
-             end if;
- 
-             requeue Ordering_Queue;
- 
-             -- At this exit point the entry queue barriers are evaluated
- 
-          end Input;
- 
- 
-          entry Ordering_Queue ( Segment : acc_Message_Segment )
-                                                   when All_Segments_Arrived is
-             begin
- 
-             --=====================================================
-             -- This part is all Test_Control code
- 
-             if TC_First_Cycle then 
-                -- Check the order of the original three
-                if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
-                   -- The segments are not being pulled off in the 
-                   -- expected sequence.  This could occur if the 
-                   -- requeue is not putting them back on the end.
-                   TC_Failed_3 := true;
-                end if; -- sequence check
-                -- Decrement the expected sequence
-                if TC_Expected_Sequence /= Header then
-                   TC_Expected_Sequence := TC_Expected_Sequence - 1;
-                else 
-                   TC_First_Cycle := false; -- This is the Header - the
-                                            -- first two segments are
-                                            -- back on the queue
-                end if; -- decrementing
-             end if; -- first cycle 
-             --=====================================================
- 
-             -- And this is the Application code
-             if Segment.Seg_Sequence_No = Next_Needed then
-                if Segment.EOM then
-                   Next_Needed := Header;  -- reset for next message
-                   -- :: other resets not shown
-                else
-                   Next_Needed := Next_Needed + 1;
-                end if;
-                requeue Output_Driver.Input  with abort;
-                -- set to Report Failed - Requeue did not complete entry body
-                TC_Failed_1 := true;
-             else
-                -- Not the next needed - put it back on the queue
-                --    NOTE: here we are requeueing to the same entry
-                requeue Sequencer.Ordering_Queue;
-                -- set to Report Failed - Requeue did not complete entry body
-                TC_Failed_2 := true;
-             end if;
-          end Ordering_Queue;
-       end Sequencer;
-    
- 
-       task body Output_Driver is
-          This_Segment : acc_Message_Segment := new Message_Segment;
- 
-          TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
-          TC_Segment_Total : integer := 0;
-          TC_Expected_Total : integer := 3;
-       begin
-          loop
-             -- Note: normally we would expect this Accept to be in a select 
-             -- with terminate.  For the test we exit the loop on completion
-             -- to give better control
-             accept Input ( Segment : acc_Message_Segment ) do 
-                This_Segment.all := Segment.all;
-             end Input;
-    
-             null;  --::: stub - output the next segment of the message
- 
-             -- The following is all test control code
-             --
-             if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
-                Report.Failed ("Output_Driver: Segment out of sequence");
-             end if;
-             TC_Expected_Sequence := TC_Expected_Sequence + 1;
- 
-             -- Now count the number of segments
-             TC_Segment_Total := TC_Segment_Total + 1;
- 
-             -- Check the number and exit loop when complete
-             -- There must be exactly TC_Expected_Total in number and
-             --    the last one must be EOM
-             --    (test will hang if < TC_Expected_Total arrive
-             --    without EOM)
-             if This_Segment.EOM then
-                -- This is the last segment.
-                if TC_Segment_Total /= TC_Expected_Total then
-                   Report.Failed ("EOM and wrong number of segments");
-                end if;
-                exit;   -- the loop and terminate the task
-             elsif TC_Segment_Total = TC_Expected_Total then
-                Report.Failed ("No EOM found");
-                exit;
-             end if;
-          end loop;
-       exception
-          when others => 
-               Report.Failed ("Unexpected Exception in Output_Driver");
-       end Output_Driver;
- 
- 
-    begin  
- 
-       null;
- 
-    end; -- encapsulation
- 
-    if TC_Failed_1 then
-       Report.Failed ("Requeue did not complete entry body - 1");
-    end if;
- 
-    if TC_Failed_2 then
-       Report.Failed ("Requeue did not complete entry body - 2");
-    end if;
- 
-    if TC_Failed_3 then
-       Report.Failed ("Sequencer: Segment out of sequence");
-    end if;
- 
-    Report.Result;
-    
- end C954022;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954023.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954023.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954023.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954023.a	Thu Jan  1 00:00:00 1970
***************
*** 1,558 ****
- -- C954023.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that a requeue within a protected entry to a family of entries 
- --     in a different protected object is queued correctly
- --                      Call with parameters
- --                      Requeue with abort
- --
- -- TEST DESCRIPTION: 
- --      One transaction is sent through to check the paths.  After processing
- --      this, the Credit task sets the "overloaded" indicator.  Once this
- --      indicator is set the Distributor (a protected object) queues lower
- --      priority transactions on a family of queues (Wait_for_Underload) in
- --      another protected object using a requeue.  The Distributor still
- --      delivers high priority transactions. After two more high priority
- --      transactions have been processed by the Credit task the artificial
- --      test code clears the overload condition to the threshold level that
- --      allows only the items on the Medium priority queue of the family to be
- --      released.  When these have been processed and checked the test code
- --      then lowers the priority threshold once again, allowing the Low
- --      priority items from the last queue in the family to be released,
- --      processed and checked. Note: the High priority queue in the family is 
- --      not used.   
- --     
- --      This series of tests uses a simulation of a transaction driven
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system.  The message tasks put themselves on the
- --      input queue of a Distributor which, from information in the
- --      transaction and/or system load conditions forwards them to other
- --      operating tasks. These in turn might forward the transactions to yet
- --      other tasks for further action.  The routing is, in real life, dynamic
- --      and unpredictable at the time of message generation.  All rerouting in
- --      this  model is done by means of requeues.
- --     
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with ImpDef;
-          
- procedure C954023 is
- 
-    -- Artificial: number of messages required for this test
-    subtype TC_Trans_Range is integer range 1..8;
- 
-    TC_Credit_Messages_Expected  : constant integer 
-                                           := TC_Trans_Range'Last - 1;
- 
-    TC_Debit_Message_Complete    : Boolean := false;
- 
- 
-    -- Mechanism for handshaking between tasks
-    protected TC_PO is
-       procedure Increment_Tasks_Completed_Count;
-       function  Tasks_Completed_Count return integer;
-       function  First_Message_Has_Arrived return Boolean;
-       procedure  Set_First_Message_Has_Arrived;
-    private
-       Number_Complete : integer := 0;
-          Message_Arrived_Flag  : Boolean := false;
-    end TC_PO;
-    -- 
-    protected body TC_PO is
-       procedure Increment_Tasks_Completed_Count is
-       begin
-          Number_Complete := Number_Complete + 1;
-       end Increment_Tasks_Completed_Count;
-   
-       function Tasks_Completed_Count return integer is
-       begin
-          return Number_Complete;
-       end Tasks_Completed_Count;
- 
-       function  First_Message_Has_Arrived return Boolean is
-          begin
-             return Message_Arrived_Flag;
-          end First_Message_Has_Arrived;
- 
-       procedure  Set_First_Message_Has_Arrived is
-          begin
-             Message_Arrived_Flag := true;
-       end Set_First_Message_Has_Arrived;
- 
-    end TC_PO;
- 
- begin
-    
-    Report.Test ("C954023", "Requeue from within a protected object" &
-                       " to a family of entries in another protected object");
- 
-  
-    declare -- encapsulate the test
-    
-       -- Arbitrary test values
-       Credit_Return : constant := 1;
-       Debit_Return  : constant := 2;
- 
-       type Transaction_Code is (Credit, Debit);
-       type App_Priority     is (Low, Medium, High);
-       type Priority_Block   is array (App_Priority) of Boolean;
- 
-       type Transaction_Record;
-       type acc_Transaction_Record is access Transaction_Record;
-       type Transaction_Record is 
-          record
-             ID               : integer := 0;
-             Code             : Transaction_Code := Debit;
-             Priority         : App_Priority := High;
-             Account_Number   : integer := 0;
-             Stock_Number     : integer := 0;
-             Quantity         : integer := 0;
-             Return_Value     : integer := 0;
-             TC_Message_Count : integer := 0;
-             TC_Thru_Distrib  : Boolean := false;
-          end record;
-    
-    
-       task type Message_Task is 
-          entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-       end Message_Task;
-       type acc_Message_Task is access Message_Task;
-    
-       task Line_Driver is
-          entry Start;
-       end Line_Driver;
-    
-       protected Distributor is
-          procedure Set_Credit_Overloaded;
-          procedure Clear_Overload_to_Medium;
-          procedure Clear_Overload_to_Low;
-          entry     Input (Transaction : acc_Transaction_Record);
-       private
-          Credit_Overloaded : Boolean := false;
-       end Distributor;
-    
-       protected Hold is
-          procedure Release_Medium;
-          procedure Release_Low;
-          -- Family of entry queues indexed by App_Priority
-          entry Wait_for_Underload (App_Priority)
-                                      (Transaction : acc_Transaction_Record);
-       private
-          Release : Priority_Block := (others => false);
-       end Hold;
-    
-       task Credit_Computation is
-          entry Input(Transaction : acc_Transaction_Record);
-       end Credit_Computation;
-    
-       task Debit_Computation is
-          entry Input(Transaction : acc_Transaction_Record);
-       end Debit_Computation;
-    
-       --
-       -- Dispose each input Transaction_Record to the appropriate
-       -- computation tasks
-       --
-       protected body Distributor is
-    
-          procedure Set_Credit_Overloaded is
-          begin
-             Credit_Overloaded := true;
-          end Set_Credit_Overloaded;
-    
-          procedure Clear_Overload_to_Medium is
-          begin
-             Credit_Overloaded := false;
-             Hold.Release_Medium;       -- Release all held messages on Medium
-                                        -- priority queue
-          end Clear_Overload_to_Medium;
-      
-          procedure Clear_Overload_to_Low is
-          begin
-             Credit_Overloaded := false;
-             Hold.Release_Low;          -- Release all held messages on Low
-                                        -- priority queue
-          end Clear_Overload_to_Low;
-      
-    
-    
-          entry Input (Transaction : acc_Transaction_Record)   when true is
-                                                    -- barrier is always open
-          begin
-             -- Test Control: Set the indicator in the message to show it has
-             -- passed through the Distributor object
-             Transaction.TC_thru_Distrib := true;
-     
-             -- Pass this transaction on to the appropriate computation
-             -- task but temporarily hold low-priority transactions under
-             -- overload conditions
-             case Transaction.Code is
-                when Credit =>
-                   if Credit_Overloaded and Transaction.Priority /= High then
-                      -- use the appropriate queue in the family 
-                      requeue Hold.Wait_for_Underload(Transaction.Priority)
-                                                          with abort;
-                   else
-                      requeue Credit_Computation.Input with abort;
-                  end if;
-                when Debit =>
-                  requeue Debit_Computation.Input with abort;
-             end case;
-          end Input;
-       end Distributor;
-    
-    
-       -- Low priority Message tasks are held on the Wait_for_Underload queue
-       -- while the Credit computation system is overloaded.  Once the Credit
-       -- system reached underload send all queued messages immediately
-       --
-       protected body Hold is
-          
-          -- Once these are executed the barrier conditions for the entries
-          -- are evaluated 
-          procedure Release_Medium is
-          begin 
-             Release(Medium) := true;
-          end Release_Medium;
-          --
-          procedure Release_Low is
-          begin 
-             Release(Low) := true;
-          end Release_Low;
-    
-          -- This is a family of entry queues indexed by App_Priority
-          entry Wait_for_Underload  (for AP in App_Priority)
-                                    (Transaction : acc_Transaction_Record)
-                                                 when Release(AP) is
-          begin
-             requeue Credit_Computation.Input with abort;
-             if Wait_for_Underload(AP)'count = 0 then
-                -- Queue is purged.  Set up to hold next batch
-                Release(AP) := false;
-             end if; 
-          end Wait_for_Underload;
-    
-       end Hold;
-       
-    
-    
-    
-       -- Assemble messages received from an external source
-       --   Creates a message task for each. The message tasks remain extant
-       --   for the life of the messages in the system.
-       --      The Line Driver task would normally be designed to loop 
-       --      creating the messages as input is received.  Simulate this 
-       --      but limit it to the required number of dummy messages needed for
-       --      this test and allow it to terminate at that point.  Artificially
-       --      cycle the generation of High medium and Low priority Credit 
-       --      transactions for this test. Send out one final Debit message
-       --
-       task body Line_Driver is
-          Current_ID       : integer := 1;
-          Current_Priority : App_Priority := High;      
-    
-          procedure Build_Credit_Record 
-                               ( Next_Transaction : acc_Transaction_Record ) is
-             Dummy_Account : constant integer := 100;
-          begin
-                Next_Transaction.ID := Current_ID;
-                Next_Transaction.Code := Credit; 
-                Next_Transaction.Priority := Current_Priority;
-    
-                Next_Transaction.Account_Number := Dummy_Account;
-                Current_ID := Current_ID + 1;
-          end Build_Credit_Record;     
-    
-    
-          procedure Build_Debit_Record 
-                             ( Next_Transaction : acc_Transaction_Record ) is
-             Dummy_Account : constant integer := 200;
-          begin
-                Next_Transaction.ID := Current_ID;
-                Next_Transaction.Code := Debit; 
-    
-                Next_Transaction.Account_Number := Dummy_Account;
-                Current_ID := Current_ID + 1;
-          end Build_Debit_Record;     
-    
-       begin
-          
-          for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
-             declare 
-                -- Create a task for the next message
-                Next_Message_Task : acc_Message_Task := new Message_Task;
-                -- Create a record for it
-                Next_Transaction : acc_Transaction_Record := 
-                                                    new Transaction_Record;
-             begin
-                if Transaction_Numb = TC_Trans_Range'first then
-                   -- Send the first Credit message
-                   Build_Credit_Record ( Next_Transaction );
-                   Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-                   -- TC: Wait until the first message has been received by the
-                   -- Credit task and it has set the Overload indicator for the 
-                   -- Distributor
-                   while not TC_PO.First_Message_Has_Arrived loop
-                      delay ImpDef.Minimum_Task_Switch;   
-                   end loop;
-                elsif Transaction_Numb = TC_Trans_Range'last then
-                   -- For this test send the last transaction to the Debit task
-                   -- to improve the mix
-                   Build_Debit_Record( Next_Transaction );
-                   Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-                else
-                   -- TC: Cycle generation of  high medium and low priority 
-                   -- transactions
-                   if Current_Priority = High then
-                      Current_Priority := Medium;
-                   elsif  
-                      Current_Priority = Medium then
-                      Current_Priority := Low;
-                   else
-                      Current_Priority := High;
-                   end if;
-                   Build_Credit_Record( Next_Transaction );
-                   Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-                end if;
-             end;   -- declare
-          end loop;
-    
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Line_Driver");
-       end Line_Driver;
-    
-       
-    
-    
-       task body Message_Task is
-    
-          TC_Original_Transaction_Code : Transaction_Code;  
-          This_Transaction : acc_Transaction_Record := new Transaction_Record;
-    
-       begin
-          
-          accept Accept_Transaction(In_Transaction : acc_Transaction_Record) do
-             This_Transaction.all := In_Transaction.all;
-          end Accept_Transaction;
-    
-          -- Note the original code to ensure correct return
-          TC_Original_Transaction_Code := This_Transaction.Code;
-     
-          -- Queue up on Distributor's Input queue
-          Distributor.Input ( This_Transaction );
-          -- This task will now wait for the requeued rendezvous 
-          -- to complete before proceeding
-    
-          -- After the required computations have been performed
-          -- return the Transaction_Record appropriately (probably to an output
-          -- line driver)
-          null;            -- stub
-          
-          -- For the test check that the return values are as expected
-          if TC_Original_Transaction_Code /= This_Transaction.Code then
-             -- Incorrect rendezvous
-             Report.Failed ("Message Task: Incorrect code returned");
-          end if;
-    
-          if This_Transaction.Code = Credit then
-             if This_Transaction.Return_Value  /= Credit_Return   or
-             not This_Transaction.TC_thru_Distrib                 then
-                Report.Failed ("Expected path not traversed - Credit");
-             end if;
-             TC_PO.Increment_Tasks_Completed_Count;
-          else
-             if This_Transaction.Return_Value  /= Debit_Return or   
-                This_Transaction.TC_Message_Count /= 1         or
-                not This_Transaction.TC_thru_Distrib           then
-                   Report.Failed ("Expected path not traversed - Debit");
-             end if;
-             TC_Debit_Message_Complete := true;
-          end if;
-    
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Message_Task");
-       end Message_Task;
-    
-    
-    
-    
-      
-       -- Computation task.  After the computation is performed the rendezvous
-       -- in the original message task is completed.                              
-       task body Credit_Computation is
-    
-          Message_Count   : integer := 0;
-          
-       begin
-          loop
-             select 
-                accept Input ( Transaction : acc_Transaction_Record) do
-                   
-                   -- Perform the computations required for this transaction
-                   null; -- stub
-    
-                   
-                   -- The following is all Test Control code:
-                  
-                   if not Transaction.TC_thru_Distrib then
-                      Report.Failed 
-                             ("Credit Task: Wrong queue, Distributor bypassed");
-                   end if;
-    
-                   if Transaction.code /= Credit then
-                      Report.Failed
-                          ("Credit Task: Requeue delivered to the wrong queue");
-                   end if;
-    
-                   -- This is checked by the Message_Task:
-                   Transaction.Return_Value := Credit_Return;
-    
-                   -- Now take special action depending on which Message.
-                   -- Note: The count gives the order in which the messages are
-                   --       arriving at this task NOT the order in which they
-                   --       were originally generated and sent out.
-    
-                   Message_Count := Message_Count + 1;
-    
-                   if Message_Count < 4 then 
-                      -- This is one of the first three messages which must 
-                      -- be High priority because we will set "Overload" after 
-                      -- the first, which is known to be High. The lower
-                      -- priority should be waiting on the queues
-                      if Transaction.Priority /= High then  
-                      Report.Failed 
-                         ("Credit Task: Lower priority trans. during overload");
-                      end if;
-                      if Message_Count = 1 then 
-                         -- After the first message :
-                         Distributor.Set_Credit_Overloaded;
-                         -- Now flag the Line_Driver that the second and 
-                         -- subsequent messages may now be sent
-                         TC_PO.Set_First_Message_Has_Arrived;
-                      elsif
-                         Message_Count = 3 then
-                         -- The two high priority transactions created 
-                         -- subsequent to the overload have now been processed,
-                         --  release the Medium priority items
-                         Distributor.Clear_Overload_to_Medium; 
-                      end if;
-                   elsif Message_Count < 6 then
-                      -- This must be one of the Medium priority messages
-                      if Transaction.Priority /= Medium then  
-                      Report.Failed 
-                            ("Credit Task: Second group not Medium Priority");
-                      end if;
-                      if Message_Count = 5 then 
-                         -- The two medium priority transactions
-                         -- have now been processed - release the
-                         -- Low priority items
-                         Distributor.Clear_Overload_to_Low; 
-                      end if;
-                   elsif Message_Count < TC_Trans_Range'Last then
-                      -- This must be one of the Low priority messages
-                      if Transaction.Priority /= Low then  
-                      Report.Failed 
-                            ("Credit Task: Third group not Low Priority");
-                      end if;
-                   else
-                      -- Too many transactions have arrived.  Duplicates?
-                      -- the Debit transaction?
-                      Report.Failed 
-                            ("Credit Task: Too many transactions");
-                   end if;
-                end Input;            
-             or
-                terminate;
-             end select;
-          end loop;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Credit_Computation");
-       end Credit_Computation;
-    
-    
-    
-       -- Computation task.  After the computation is performed the rendezvous
-       -- in the original message task is completed.        
-       --                      
-       task body Debit_Computation is
-          Message_Count   : integer := 0;
-       begin
-          loop
-             select
-                accept Input (Transaction : acc_Transaction_Record) do
-                   -- Perform the computations required for this message
-                   null;      -- stub
-    
-                   -- For the test: 
-                   if not Transaction.TC_thru_Distrib then
-                      Report.Failed 
-                          ("Debit Task: Wrong queue, Distributor bypassed");
-                   end if;
-                   if Transaction.code /= Debit then
-                      Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                   end if;
-    
-                   -- for the test plug a known value and count
-                   Transaction.Return_Value := Debit_Return;
-                   -- one, and only one, message should pass through
-                   Message_Count := Message_Count + 1;
-                   Transaction.TC_Message_Count := Message_Count;
-                end Input;            
-             or
-                terminate;
-             end select;
-          end loop;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Debit_Computation");
-       end Debit_Computation;
-    
- 
-    begin -- declare 
- 
-       null;
- 
-    end; -- declare (test encapsulation)
- 
-    if (TC_PO.Tasks_Completed_Count /= TC_Credit_Messages_Expected) 
-                                     and not TC_Debit_Message_Complete then
-       Report.Failed ("Incorrect number of Message Tasks completed");
-    end if;
- 
-    Report.Result;
- 
- end C954023;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954024.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954024.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954024.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954024.a	Thu Jan  1 00:00:00 1970
***************
*** 1,380 ****
- -- C954024.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that a call to a protected entry can be requeued to a task
- --      entry. Check that the requeue is placed on the correct entry; that the
- --      original caller waits for the completion of the requeue and continues
- --      after the requeued rendezvous.  Check that the requeue does not block.
- --      Specifically, check a requeue without abort from a protected entry to
- --      an entry in a task.
- --
- -- TEST DESCRIPTION:
- --      In the Distributor protected object, requeue two successive calls on
- --      the entries of two separate target tasks.  Each task in each of the 
- --      paths adds identifying information in the transaction being passed. 
- --      This information is checked by the Message tasks on completion
- --      ensuring that the requeues have been placed on the correct queues.
- --      There is an artificial guard on the Credit Task to ensure that the
- --      input is queued; this guard is released by the Debit task which 
- --      handles its input immediately.  This ensures that we have one of the
- --      requeued items actually queued for later handling and also verifies
- --      that the requeuing process (in the protected object) is not blocked.
- --
- --      This series of tests uses a simulation of a transaction driven 
- --      processing system.  Line Drivers accept input from an external source
- --      and build them into transaction records.  These records are then 
- --      encapsulated in message tasks which remain extant for the life of the
- --      transaction in the system. The message tasks put themselves on the 
- --      input queue of a Distributor object which, from information in the
- --      transaction and/or system load conditions forwards them to other 
- --      operating tasks. These in turn might forward the transactions to yet 
- --      other tasks for further action.  The routing is, in real life, 
- --      dynamic and unpredictable at the time of message generation. All 
- --      rerouting in this  model is done by means of requeues.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      08 Nov 95   SAIC    Fixed reported problems for ACVC 2.0.1
- --
- --!
- 
- with Report;
- with ImpDef;         
- procedure C954024 is
-     
-    
- begin -- C954024
- 
-    Report.Test ("C954024", "Requeue from protected entry to task entry");
- 
-    declare -- encapsulate the test
- 
-       -- Arbitrary test values
-       Credit_Return : constant := 1;
-       Debit_Return  : constant := 2;
-    
-       type Transaction_Code is (Credit, Debit);
-    
-       type Transaction_Record;
-       type acc_Transaction_Record is access Transaction_Record;
-       type Transaction_Record is 
-          record
-             ID               : integer := 0;
-             Code             : Transaction_Code := Debit;
-             Account_Number   : integer := 0;
-             Stock_Number     : integer := 0;
-             Quantity         : integer := 0;
-             Return_Value     : integer := 0;
-             TC_Message_Count : integer := 0;       
-             TC_Thru_Dist     : Boolean := false;
-          end record;
-    
-    
-       task type Message_Task is 
-          entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
-       end Message_Task;
-       type acc_Message_Task is access Message_Task;
-    
-       task Line_Driver is 
-          entry Start;
-       end Line_Driver;   
-    
-       task Credit_Computation is
-          entry Input(Transaction : acc_Transaction_Record);
-       end Credit_Computation;
-    
-       task Debit_Computation is
-          entry Input(Transaction : acc_Transaction_Record);
-       end Debit_Computation;
-    
-       protected Time_Lock is
-          procedure Credit_Start;
-          function  Credit_Enabled return Boolean;
-       private
-          Credit_OK : Boolean := false;
-       end Time_Lock;
-    
-       protected body Time_Lock is
-          procedure Credit_Start is
-          begin
-             Credit_OK := true;
-          end Credit_Start;
-    
-          function  Credit_Enabled return Boolean is 
-          begin
-             return Credit_OK;
-          end Credit_Enabled;
-       end Time_Lock;
-    
-    
-    
-       protected Distributor is
-          entry Input (Transaction : acc_Transaction_Record);
-       end Distributor;
-       --
-       --
-       -- Dispose each input Transaction_Record to the appropriate
-       -- computation tasks
-       --
-       protected body Distributor is
-          entry Input (Transaction : acc_Transaction_Record) when true is
-                                                    -- barrier is always open
-          begin
-             -- Test Control: Set the indicator in the message to show it has
-             -- passed through the Distributor object
-             Transaction.TC_thru_Dist := true;
-                 
-             -- Pass this transaction on to the appropriate computation
-             -- task
-             case Transaction.Code is
-                when Credit =>
-                   requeue Credit_Computation.Input;
-                when Debit =>
-                   requeue Debit_Computation.Input;
-             end case;
-          end Input;
-       end Distributor;
-    
-    
-    
-    
-       -- Assemble messages received from an external source
-       --   Creates a message task for each. The message tasks remain extant
-       --   for the life of the messages in the system.
-       --   NOTE:
-       --   The Line Driver task would normally be designed to loop continuously
-       --   creating the messages as input is received.  Simulate this 
-       --   but limit it to two dummy messages for this test and allow it
-       --   to terminate at that point
-       --
-       task body Line_Driver is
-          Current_ID : integer := 1;
-          TC_Last_was_for_credit : Boolean := false;
-    
-          procedure Build_Credit_Record 
-                           ( Next_Transaction : acc_Transaction_Record ) is
-             Dummy_Account : constant integer := 100;
-          begin
-                Next_Transaction.ID := Current_ID;
-                Next_Transaction.Code := Credit; 
-    
-                Next_Transaction.Account_Number := Dummy_Account;
-                Current_ID := Current_ID + 1;
-          end Build_Credit_Record;     
-    
-    
-          procedure Build_Debit_Record 
-                           ( Next_Transaction : acc_Transaction_Record ) is
-             Dummy_Account : constant integer := 200;
-          begin
-                Next_Transaction.ID := Current_ID;
-                Next_Transaction.Code := Debit; 
-    
-                Next_Transaction.Account_Number := Dummy_Account;
-                Current_ID := Current_ID + 1;
-          end Build_Debit_Record;     
-    
-       begin
-    
-          accept Start;      -- Wait for trigger from Main
-    
-          for i in 1..2 loop  -- arbitrarily limit to two messages for the test
-             declare 
-                -- Create a task for the next message
-                Next_Message_Task : acc_Message_Task := new Message_Task;
-                -- Create a record for it
-                Next_Transaction : acc_Transaction_Record 
-                                                     := new Transaction_Record;
-             begin
-                if TC_Last_was_for_credit then
-                   Build_Debit_Record ( Next_Transaction );            
-                else
-                   Build_Credit_Record( Next_Transaction );
-                   TC_Last_was_for_credit := true;
-                end if;
-                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
-             end;   -- declare
-          end loop;
-    
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Line_Driver");
-       end Line_Driver;
-    
-       
-    
-    
-       task body Message_Task is
-    
-          TC_Original_Transaction_Code : Transaction_Code;  
-          This_Transaction : acc_Transaction_Record := new Transaction_Record;
-    
-       begin
-          accept Accept_Transaction
-                             (In_Transaction : acc_Transaction_Record) do
-             This_Transaction.all := In_Transaction.all;
-          end Accept_Transaction;
-    
-          -- Note the original code to ensure correct return
-          TC_Original_Transaction_Code := This_Transaction.Code;
-     
-          -- Queue up on Distributor's Input queue
-          Distributor.Input ( This_Transaction );
-          -- This task will now wait for the requeued rendezvous 
-          -- to complete before proceeding
-    
-          -- After the required computations have been performed
-          -- return the Transaction_Record appropriately (probably to an output
-          -- line driver)
-          null;            -- stub
-    
-          
-          -- The following is all Test Control Code
-    
-          -- Check that the return values are as expected
-          if TC_Original_Transaction_Code /= This_Transaction.Code then
-             -- Incorrect rendezvous
-             Report.Failed ("Message Task: Incorrect code returned");
-          end if;
-    
-          if This_Transaction.Code = Credit then
-             if This_Transaction.Return_Value     /= Credit_Return or   
-                This_Transaction.TC_Message_Count /= 1             or 
-                not This_Transaction.TC_thru_Dist       then
-                   Report.Failed ("Expected path not traversed");
-             end if;
-          else
-             if This_Transaction.Return_Value  /= Debit_Return or   
-                This_Transaction.TC_Message_Count /= 1         or 
-                not This_Transaction.TC_thru_Dist       then
-                   Report.Failed ("Expected path not traversed");
-             end if;
-          end if;
-    
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Message_Task");
-    
-       end Message_Task;
-    
-    
-    
-       -- Computation task.
-       --   Note:  After the computation is performed in this task and the 
-       --          accept body is completed the rendezvous in the original
-       --          message task is completed.                              
-       --                                           
-       task body Credit_Computation is
-          Message_Count   : integer := 0;
-       begin
-          loop
-             select 
-                when  Time_Lock.Credit_enabled =>
-                accept Input ( Transaction : acc_Transaction_Record) do
-                   -- Perform the computations required for this transaction
-                   null;      -- stub
-    
-                   -- For the test: 
-                   if not Transaction.TC_thru_Dist then
-                      Report.Failed 
-                           ("Credit Task: Wrong queue, Distributor bypassed");
-                   end if;
-                   if Transaction.code /= Credit then
-                      Report.Failed
-                        ("Credit Task: Requeue delivered to the wrong queue");
-                   end if;
-    
-                   -- for the test plug a known value and count
-                   Transaction.Return_Value := Credit_Return;
-                   -- one, and only one message should pass through
-                   Message_Count := Message_Count + 1;
-                   Transaction.TC_Message_Count := Message_Count;
-                end Input;            
-                exit;  -- one message is enough
-             else
-                delay ImpDef.Clear_Ready_Queue;  -- poll
-             end select;
-          end loop;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Credit_Computation");
-       end Credit_Computation;
-    
-    
-    
-       -- Computation task.
-       --   Note:  After the computation is performed in this task and the 
-       --          accept body is completed the rendezvous in the original
-       --          message task is completed.                              
-       --                                                
-       task body Debit_Computation is
-          Message_Count   : integer := 0;
-       begin
-          loop
-             select
-                accept Input (Transaction : acc_Transaction_Record) do
-                   -- Perform the computations required for this message
-                   null;      -- stub
-    
-                   -- For the test: 
-                   if not Transaction.TC_thru_Dist then
-                      Report.Failed
-                             ("Debit Task: Wrong queue, Distributor bypassed");
-                   end if;
-                   if Transaction.code /= Debit then
-                      Report.Failed
-                          ("Debit Task: Requeue delivered to the wrong queue");
-                   end if;
-    
-                   -- for the test plug a known value and count
-                   Transaction.Return_Value := Debit_Return;
-                   -- one, and only one, message should pass through
-                   Message_Count := Message_Count + 1;
-                   Transaction.TC_Message_Count := Message_Count;
-                   -- for the test: once we have completed the only Debit
-                   -- message release the Credit Messages which are queued
-                   -- on the Credit Input queue
-                   Time_Lock.Credit_Start;
-                   
-                end Input;            
-             or
-                terminate;
-             end select;
-          end loop;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception in Debit_Computation");
-    
-       end Debit_Computation;
-    
-    begin -- declare block
-       Line_Driver.Start;
-    end;  -- test encapsulation
- 
-    Report.Result;
- 
- end C954024;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954025.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954025.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954025.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954025.a	Thu Jan  1 00:00:00 1970
***************
*** 1,237 ****
- -- C954025.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the original entry call was a conditional entry call,
- --      the call is cancelled if a requeue-with-abort of the call is not
- --      selected immediately.
- --      Check that if the original entry call was a timed entry call, the 
- --      expiration time for a requeue-with-abort is the original expiration 
- --      time.
- --
- -- TEST DESCRIPTION:
- --      This test declares two tasks: Launch_Control and Mission_Control.
- --      Mission_Control instructs Launch_Control to start its countdown
- --      and then requeues (with abort) to the Launch_Control.Launch 
- --      entry.  This call to Launch will be accepted at the end of the
- --      countdown (if the task is still waiting).
- --      The main task does an unconditional, conditional, and timed 
- --      entry call to Mission_Control and checks to see if the launch
- --      was accepted.
- --
- --
- -- CHANGE HISTORY:
- --      18 OCT 95   SAIC    ACVC 2.1
- --      10 JUL 96   SAIC    Incorporated reviewer's comments.
- --
- --!
- 
- with Calendar;   use type Calendar.Time;
- with Report;
- with ImpDef;
- procedure C954025 is
-   Verbose : constant Boolean := False;
-   Countdown_Amount : constant Duration := 2.0 * Impdef.One_Long_Second;
-   Plenty_Of_Time : constant Duration := 
-          Countdown_Amount + ImpDef.Clear_Ready_Queue + 1.0 * Impdef.One_Long_Second;
-   Not_Enough_Time : constant Duration :=
-          Countdown_Amount - 0.5 * Impdef.One_Long_Second;
- begin
-   Report.Test ("C954025",
-                "Check that if the original entry" &
-                " call was a conditional or timed entry call, the" &
-                " expiration time for a requeue with abort is the" &
-                " original expiration time");
-   declare
-      -- note that the following object is a shared object and its use
-      -- governed by the rules of 9.10(3,4,8);6.0
-      Launch_Accepted : Boolean := False;
- 
-      task Launch_Control is
-         entry Enable_Launch_Control;
-         entry Start_Countdown (How_Long : Duration);
-         -- Launch will be accepted if a call is waiting when the countdown
-         -- reaches 0
-         entry Launch;
-      end Launch_Control;
- 
-      task body Launch_Control is
-         Wait_Amount : Duration := 0.0;
-      begin
-         loop
-            select
-               accept Enable_Launch_Control do
-                  Launch_Accepted := False;
-               end Enable_Launch_Control;
-            or
-               terminate;
-            end select;
- 
-            accept Start_Countdown (How_Long : Duration) do
-                  Wait_Amount := How_Long;
-            end Start_Countdown;
- 
-            delay Wait_Amount;
- 
-            select
-               accept Launch do
-                  Launch_Accepted := True;
-               end Launch;
-            else
-               null;
-               -- note that Launch_Accepted is False here
-            end select;
-         end loop;
-      end Launch_Control;
- 
-      task Mission_Control is
-         --  launch will occur if we are given enough time to complete
-         --  a standard countdown.  We will not be rushed!
-         entry Do_Launch;
-      end Mission_Control;
- 
-      task body Mission_Control is
-      begin
-         loop
-            select
-               accept Do_Launch do
-                  Launch_Control.Start_Countdown (Countdown_Amount);
-                  requeue Launch_Control.Launch with abort;
-               end Do_Launch;
-            or
-               terminate;
-            end select;
-         end loop;
-      end Mission_Control;
-      
-   begin   -- test encapsulation
-      -- unconditional entry call to check the simple case
-      Launch_Control.Enable_Launch_Control;
-      Mission_Control.Do_Launch;
-      if Launch_Accepted then
-         if Verbose then
-            Report.Comment ("simple case passed");
-         end if;
-       else
-          Report.Failed ("simple case");
-       end if;
- 
-   
-      -- timed but with plenty of time - delay relative
-      Launch_Control.Enable_Launch_Control;
-      select
-         Mission_Control.Do_Launch;
-      or 
-         delay Plenty_Of_Time;
-         if Launch_Accepted then
-            Report.Failed ("plenty of time timed out after accept (1)");
-         end if;
-      end select;
-      if Launch_Accepted then
-         if Verbose then
-            Report.Comment ("plenty of time case passed (1)");
-         end if;
-       else
-          Report.Failed ("plenty of time (1)");
-       end if;
- 
-   
-      -- timed but with plenty of time  -- delay until
-      Launch_Control.Enable_Launch_Control;
-      select
-         Mission_Control.Do_Launch;
-      or 
-         delay until Calendar.Clock + Plenty_Of_Time;
-         if Launch_Accepted then
-            Report.Failed ("plenty of time timed out after accept(2)");
-         end if;
-      end select;
-      if Launch_Accepted then
-         if Verbose then
-            Report.Comment ("plenty of time case passed (2)");
-         end if;
-       else
-          Report.Failed ("plenty of time (2)");
-       end if;
- 
-   
-      -- timed without enough time - delay relative
-      Launch_Control.Enable_Launch_Control;
-      select
-         Mission_Control.Do_Launch;
-         Report.Failed ("not enough time completed accept (1)");
-      or 
-         delay Not_Enough_Time;
-      end select;
-      if Launch_Accepted then
-         Report.Failed ("not enough time (1)");
-       else
-         if Verbose then
-            Report.Comment ("not enough time case passed (1)");
-         end if;
-       end if;
- 
-   
-      -- timed without enough time - delay until
-      Launch_Control.Enable_Launch_Control;
-      select
-         Mission_Control.Do_Launch;
-         Report.Failed ("not enough time completed accept (2)");
-      or 
-         delay until Calendar.Clock + Not_Enough_Time;
-      end select;
-      if Launch_Accepted then
-         Report.Failed ("not enough time (2)");
-       else
-         if Verbose then
-            Report.Comment ("not enough time case passed (2)");
-         end if;
-       end if;
- 
-   
-      -- conditional case
-      Launch_Control.Enable_Launch_Control;
-      -- make sure Mission_Control is ready to accept immediately
-      delay ImpDef.Clear_Ready_Queue; 
-      select
-         Mission_Control.Do_Launch;
-         Report.Failed ("no time completed accept");
-      else
-         if Verbose then
-            Report.Comment ("conditional case - else taken");
-          end if;
-      end select;
-      if Launch_Accepted then
-         Report.Failed ("no time");
-       else
-         if Verbose then
-            Report.Comment ("no time case passed");
-         end if;
-       end if;
- 
-   end;
- 
-   Report.Result;
- end C954025;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954026.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954026.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954026.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954026.a	Thu Jan  1 00:00:00 1970
***************
*** 1,269 ****
- -- C954026.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the original protected entry call was a conditional
- --      entry call, the call is cancelled if a requeue-with-abort of the 
- --      call is not selected immediately.
- --      Check that if the original protected entry call was a timed entry 
- --      call, the expiration time for a requeue-with-abort is the original 
- --      expiration time.
- --
- -- TEST DESCRIPTION:
- --      In this test the main task makes a variety of calls to the protected
- --      object Initial_PO.  These calls include a simple call, a conditional 
- --      call, and a timed call.  The timed calls include calls with enough
- --      time and those with less than the needed amount of time to get through
- --      the requeue performed by Initial_PO.
- --      Initial_PO requeues its entry call to Final_PO.
- --      Final_PO does not accept the requeued call until the protected 
- --      procedure Ok_To_Take_Requeue is called.
- --      A separate task, Delayed_Opener, is used to call Ok_To_Take_Requeue
- --      after a delay amount specified by the main task has expired. 
- --
- --
- -- CHANGE HISTORY:
- --      15 DEC 95   SAIC    ACVC 2.1
- --      10 JUL 96   SAIC    Incorporated reviewer comments.
- --      10 OCT 96   SAIC    Incorporated fix provided by vendor.
- --
- --!
- 
- with Calendar;
- use type Calendar.Time;
- with Report;
- with Impdef;
- procedure C954026 is
-     Verbose : constant Boolean := False;
-     Final_Po_Reached : Boolean := False;
-     Allowed_Time : constant Duration := 2.0 * Impdef.One_Long_Second;
-     Plenty_Of_Time : constant Duration :=
-        Allowed_Time + Impdef.Clear_Ready_Queue + 1.0 * Impdef.One_Long_Second;
-     Not_Enough_Time : constant Duration := Allowed_Time - 0.5 * Impdef.One_Long_Second;
- begin
-     Report.Test ("C954026",
-                  "Check that if the original entry" &
-                     " call was a conditional or timed entry call," &
-                     " the expiration time for a requeue with" &
-                     " abort to a protected" &
-                     " entry is the original expiration time");
-     declare
- 
-         protected Initial_Po is
-             entry Start_Here;
-         end Initial_Po;
- 
-         protected Final_Po is
-             entry Requeue_Target;
-             procedure Ok_To_Take_Requeue;
-             procedure Close_Requeue;
-         private
-             Open : Boolean := False;
-         end Final_Po;
- 
-         -- the Delayed_Opener task is used to notify Final_PO that it can
-         -- accept the Requeue_Target entry.
-         task Delayed_Opener is
-             entry Start_Timer (Amt : Duration);
-             entry Cancel_Timer;
-         end Delayed_Opener;
- 
-         task body Delayed_Opener is
-             Wait_Amt : Duration;
-         begin
-             loop
-                 accept Start_Timer (Amt : Duration) do
-                     Wait_Amt := Amt;
-                 end Start_Timer;
-                 exit when Wait_Amt < 0.0;
-                 if Verbose then
-                     Report.Comment ("Timer started");
-                 end if;
-                 select
-                     accept Cancel_Timer do
-                         Final_Po.Close_Requeue;
-                     end Cancel_Timer;   
-                 or              
-                     delay Wait_Amt;
-                     Final_Po.Ok_To_Take_Requeue;
-                     accept Cancel_Timer do
-                         Final_Po.Close_Requeue;
-                     end Cancel_Timer;   
-                 end select;     
-             end loop;
-         exception
-             when others =>
-                 Report.Failed ("exception in Delayed_Opener");
-         end Delayed_Opener;
- 
-         protected body Initial_Po is
-             entry Start_Here when True is
-             begin
-                 Final_Po_Reached := False;
-                 requeue Final_Po.Requeue_Target with abort;
-             end Start_Here;
-         end Initial_Po;
- 
-         protected body Final_Po is
-             entry Requeue_Target when Open is
-             begin
-                 Open := False;
-                 Final_Po_Reached := True;
-             end Requeue_Target;
- 
-             procedure Ok_To_Take_Requeue is
-             begin
-                 Open := True;
-             end Ok_To_Take_Requeue;
- 
-             procedure Close_Requeue is          
-             begin                       
-                 Open := False;  
-             end Close_Requeue;
-         end Final_Po;
- 
-     begin   -- test encapsulation
-         -- unconditional entry call to check the simple case
-         Delayed_Opener.Start_Timer (0.0);
-         Initial_Po.Start_Here;
-         if Final_Po_Reached then
-             if Verbose then
-                 Report.Comment ("simple case passed");
-             end if;
-         else
-             Report.Failed ("simple case");
-         end if;
-         Delayed_Opener.Cancel_Timer;
- 
- 
-         -- timed but with plenty of time - delay relative
-         Delayed_Opener.Start_Timer (Allowed_Time);
-         select
-             Initial_Po.Start_Here;
-         or
-             delay Plenty_Of_Time;
-             Report.Failed ("plenty of time timed out (1)");
-             if Final_Po_Reached then
-                 Report.Failed (
-                    "plenty of time timed out after accept (1)");
-             end if;
-         end select;
-         if Final_Po_Reached then
-             if Verbose then
-                 Report.Comment ("plenty of time case passed (1)");
-             end if;
-         else
-             Report.Failed ("plenty of time (1)");
-         end if;
-         Delayed_Opener.Cancel_Timer;
- 
- 
-         -- timed but with plenty of time  -- delay until
-         Delayed_Opener.Start_Timer (Allowed_Time);
-         select
-             Initial_Po.Start_Here;
-         or
-             delay until Calendar.Clock + Plenty_Of_Time;
-             Report.Failed ("plenty of time timed out (2)");
-             if Final_Po_Reached then
-                 Report.Failed (
-                   "plenty of time timed out after accept(2)");
-             end if;
-         end select;
-         if Final_Po_Reached then
-             if Verbose then
-                 Report.Comment ("plenty of time case passed (2)");
-             end if;
-         else
-             Report.Failed ("plenty of time (2)");
-         end if;
-         Delayed_Opener.Cancel_Timer;
- 
- 
-         -- timed without enough time - delay relative
-         Delayed_Opener.Start_Timer (Allowed_Time);
-         select
-             Initial_Po.Start_Here;
-             Report.Failed ("not enough time completed accept (1)");
-         or
-             delay Not_Enough_Time;
-         end select;
-         if Final_Po_Reached then
-             Report.Failed ("not enough time (1)");
-         else
-             if Verbose then
-                 Report.Comment ("not enough time case passed (1)");
-             end if;
-         end if;
-         Delayed_Opener.Cancel_Timer;
- 
- 
-         -- timed without enough time - delay until
-         Delayed_Opener.Start_Timer (Allowed_Time);
-         select
-             Initial_Po.Start_Here;
-             Report.Failed ("not enough time completed accept (2)");
-         or
-             delay until Calendar.Clock + Not_Enough_Time;
-         end select;
-         if Final_Po_Reached then
-             Report.Failed ("not enough time (2)");
-         else
-             if Verbose then
-                 Report.Comment ("not enough time case passed (2)");
-             end if;
-         end if;
-         Delayed_Opener.Cancel_Timer;
- 
- 
-         -- conditional case
-         Delayed_Opener.Start_Timer (Allowed_Time);
-         select
-             Initial_Po.Start_Here;
-             Report.Failed ("no time completed accept");
-         else
-             if Verbose then
-                 Report.Comment ("conditional case - else taken");
-             end if;
-         end select;
-         if Final_Po_Reached then
-             Report.Failed ("no time");
-         else
-             if Verbose then
-                 Report.Comment ("no time case passed");
-             end if;
-         end if;
-         Delayed_Opener.Cancel_Timer;
- 
-         -- kill off the Delayed_Opener task
-         Delayed_Opener.Start_Timer (-10.0);
- 
-     exception
-         when others =>
-             Report.Failed ("exception in main");
-     end;
- 
-     Report.Result;
- end C954026;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,262 ****
- -- C954A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a task requeued without abort on a protected entry queue
- --      is aborted, the abort is deferred until the entry call completes,
- --      after which the task becomes completed.
- --
- -- TEST DESCRIPTION:
- --      Declare a protected type which simulates a printer device driver
- --      (foundation code).
- --
- --      Declare a task which simulates a printer server for multiple printers.
- --
- --      For the protected type, declare an entry with a barrier that is set
- --      false by a protected procedure (which simulates starting a print job
- --      on the printer), and is set true by a second protected procedure (which
- --      simulates a handler called when the printer interrupts, indicating
- --      that printing is done).
- --
- --      For the task, declare an entry whose corresponding accept statement
- --      contains a call to first protected procedure of the protected type
- --      (which sets the barrier of the protected entry to false), followed by
- --      a requeue with abort to the protected entry. Declare a second entry
- --      which does nothing.
- --
- --      Declare a "requesting" task which calls the printer server task entry
- --      (and thus executes the requeue). Attempt to abort the requesting
- --      task. Verify that it is not aborted. Call the second protected
- --      procedure of the protected type (the interrupt handler) and verify that
- --      the protected entry completes for the requesting task. Verify that
- --      the requesting task is then aborted.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         F954A00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Oct 96   SAIC    Added pragma elaborate.
- --
- --!
- 
- package C954A01_0 is  -- Printer server abstraction.
- 
-    -- Simulate a system with multiple printers. The entry Print requests
-    -- that data be printed on the next available printer. The entry call
-    -- is accepted when a printer is available, and completes when printing
-    -- is done.
- 
- 
-    task Printer_Server is
-       entry Print (File_Name : String);        -- Test the requeue statement.
-       entry Verify_Results;                    -- Artifice for test purposes.
-    end Printer_Server;
- 
- end C954A01_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with F954A00;              -- Printer device abstraction.
- use  F954A00;
- pragma Elaborate(F954A00);
- 
- package body C954A01_0 is  -- Printer server abstraction.
- 
-    task body Printer_Server is
-       Printers_Busy  : Boolean    := True;
-       Index          : Printer_ID := 1;
-       Print_Accepted : Boolean    := False;
-    begin
- 
-       loop
-          -- Wait for a printer to become available:
- 
-          while Printers_Busy loop
-             Printers_Busy := False;                        -- Exit loop if
-                                                            -- entry accepted.
-             select
-                Printer(Index).Done_Printing;               -- Accepted immed.
-                                                            -- when printer is
-                                                            -- available.
-             else
-                Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
-                Printers_Busy := True;                      -- accepted; keep
-             end select;                                    -- looping.
-          end loop;
-                                                            -- Value of Index
-                                                            -- at loop exit
-                                                            -- identifies the
-                                                            -- avail. printer.
- 
-          -- Wait for a print request or terminate:
- 
-          select
-             accept Print (File_Name : String) do
-                Print_Accepted := True;                     -- Allow
-                                                            -- Verify_Results
-                                                            -- to be accepted.
- 
-                Printer(Index).Start_Printing (File_Name);  -- Begin printing on
-                                                            -- the available
-                --                        --                -- printer.
-                -- Requeue is tested here --
-                --                        --
-                                                            -- Requeue caller so
-                requeue Printer(Index).Done_Printing;       -- server task free
-                                                            -- to accept other
-             end Print;                                     -- requests.
-          or
-             --  Guard ensures that Verify_Results cannot be accepted
-             --  until after Print has been accepted. This avoids a
-             --  race condition in the main program.
- 
-             when Print_Accepted => accept Verify_Results;  -- Artifice for
-                                                            -- testing purposes.
-          or
-             terminate;
-          end select;
- 
-          -- Allow other tasks to get control
-          delay ImpDef.Long_Minimum_Task_Switch;
- 
-       end loop;
- 
-    exception
-       when others =>
-          Report.Failed ("Exception raised in Printer_Server task");
-    end Printer_Server;
- 
- 
- end C954A01_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with F954A00;    -- Printer device abstraction.
- with C954A01_0;  -- Printer server abstraction.
- 
- use  C954A01_0;
- use  F954A00;
- 
- procedure C954A01 is
- 
-    Long_Enough : constant Duration := ImpDef.Long_Switch_To_New_Task;
- 
-                --==============================================--
- 
-    task Print_Request;                       -- Send a print request.
- 
-    task body Print_Request is
-       My_File : constant String := "MYFILE.DAT";
-    begin
-       Printer_Server.Print (My_File);          -- Invoke requeue statement.
-       Report.Failed ("Task continued execution following entry call");
-    exception
-       when others =>
-          Report.Failed ("Exception raised in Print_Request task");
-    end Print_Request;
- 
-                --==============================================--
- 
- begin  -- Main program.
- 
-    Report.Test ("C954A01", "Requeue without abort - check that the abort " &
-             "is deferred until after the rendezvous completes. (Task to PO)");
- 
-    --  To pass this test, the following must be true:
-    -- 
-    --     (A) The abort of Print_Request is deferred until after the
-    --         Done_Printing entry body completes.
-    --     (B) Print_Request aborts after the Done_Printing entry call
-    --         completes.
-    -- 
-    --  Call the entry Verify_Results. The entry call will not be accepted
-    --  until after Print_Request has been requeued to Done_Printing.
- 
-    Printer_Server.Verify_Results;           -- Accepted after Print_Request is
-                                             -- requeued to Done_Printing.
- 
-    -- Simulate an application which needs access to the printer within
-    -- a specified time, and which aborts the current printer job if time
-    -- runs out.
- 
-    select
-       Printer(1).Done_Printing;             -- Wait for printer to come free.
-    or
-       delay Long_Enough;                    -- Print job took too long.
-       abort Print_Request;                  -- Abort print job.
-    end select;
- 
-    Printer_Server.Verify_Results;           -- Abortion completion point: force
-                                             -- abort to complete (if it's going
-                                             -- to).
- 
-    --  Verify that the Done_Printing entry body has not yet completed,
-    --  and thus that Print_Request has not been aborted.
- 
-    if Printer(1).Is_Done then
-       Report.Failed ("Target entry of requeue executed prematurely");
-    elsif Print_Request'Terminated then
-       Report.Failed ("Caller was aborted before entry was complete");
-    else
- 
-       Printer(1).Handle_Interrupt;          -- Simulate a printer interrupt,
-                                             -- signaling that printing is
-                                             -- done.
- 
-       --  The Done_Printing entry body will complete before the next protected
-       --  action is called (Printer(1).Is_Done). Verify (A) and (B): that the
-       --  Print_Request is aborted.
- 
-       Printer_Server.Verify_Results;        -- Abortion completion point: force
-                                             -- Print_Request abort to complete.
- 
-       if not Printer(1).Is_Done then
-          Report.Failed ("Target entry of requeue did not complete");
-       end if;
- 
-       if not Print_Request'Terminated then
-          Report.Failed ("Task not aborted following completion of entry call");
-          abort Print_Request;               -- Try to kill hung task.
-       end if;
- 
-    end if;
- 
-    Report.Result;
- 
- end C954A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,259 ****
- -- C954A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a task requeued with abort on a protected entry queue
- --      is aborted, the protected entry call is canceled and the aborted
- --      task becomes completed.
- --
- -- TEST DESCRIPTION:
- --      Declare a protected type which simulates a printer device driver
- --      (foundation code).
- --
- --      Declare a task which simulates a printer server for multiple printers.
- --
- --      For the protected type, declare an entry with a barrier that is set
- --      false by a protected procedure (which simulates starting a print job
- --      on the printer), and is set true by a second protected procedure (which
- --      simulates a handler called when the printer interrupts, indicating
- --      that printing is done).
- --
- --      For the task, declare an entry whose corresponding accept statement
- --      contains a call to first protected procedure of the protected type
- --      (which sets the barrier of the protected entry to false), followed by
- --      a requeue with abort to the protected entry. Declare a second entry
- --      which does nothing.
- --
- --      Declare a "requesting" task which calls the printer server task entry
- --      (and thus executes the requeue). Attempt to abort the requesting
- --      task. Verify that it is aborted, that the requeued entry call is
- --      canceled, and that the corresponding entry body is not executed.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         F954A00.A
- --
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Oct 96   SAIC    Added pragma elaborate
- --
- --!
- 
- package C954A02_0 is  -- Printer server abstraction.
- 
-    -- Simulate a system with multiple printers. The entry Print requests
-    -- that data be printed on the next available printer. The entry call
-    -- is accepted when a printer is available, and completes when printing
-    -- is done.
- 
- 
-    task Printer_Server is
-       entry Print (File_Name : String);        -- Test the requeue statement.
-       entry Verify_Results;                    -- Artifice for test purposes.
-    end Printer_Server;
- 
- end C954A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with F954A00;              -- Printer device abstraction.
- use  F954A00;
- pragma Elaborate(F954a00);
- 
- package body C954A02_0 is  -- Printer server abstraction.
- 
-    task body Printer_Server is
-       Printers_Busy  : Boolean    := True;
-       Index          : Printer_ID := 1;
-       Print_Accepted : Boolean    := False;
-    begin
- 
-       loop
-          -- Wait for a printer to become available:
- 
-          while Printers_Busy loop
-             Printers_Busy := False;                        -- Exit loop if
-                                                            -- entry accepted.
-             select
-                Printer(Index).Done_Printing;               -- Accepted immed.
-                                                            -- when printer is
-                                                            -- available.
-             else
-                Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
-                Printers_Busy := True;                      -- accepted; keep
-             end select;                                    -- looping.
- 
-             -- Allow other task to get control
-             delay ImpDef.Minimum_Task_Switch;  
- 
-          end loop;                                         -- Value of Index
-                                                            -- at loop exit
-                                                            -- identifies the
-                                                            -- avail. printer.
- 
-          -- Wait for a print request or terminate:
- 
-          select
-             accept Print (File_Name : String) do
-                Print_Accepted := True;                     -- Allow
-                                                            -- Verify_Results
-                                                            -- to be accepted.
- 
-                Printer(Index).Start_Printing (File_Name);  -- Begin printing on
-                                                            -- the available
-                --                        --                -- printer.
-                -- Requeue is tested here --
-                --                        --
-                                                            -- Requeue caller so
-                requeue Printer(Index).Done_Printing        -- server task free
-                  with abort;                               -- to accept other
-             end Print;                                     -- requests.
-          or
-             -- Guard ensures that Verify_Results cannot be accepted
-             -- until after Print has been accepted. This avoids a
-             -- race condition in the main program.
- 
-             when Print_Accepted => accept Verify_Results;  -- Artifice for
-                                                            -- testing purposes.
-          or
-             terminate;
-          end select;
- 
-       end loop;
- 
-    exception
-       when others =>
-          Report.Failed ("Exception raised in Printer_Server task");
-    end Printer_Server;
- 
- 
- end C954A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with F954A00;    -- Printer device abstraction.
- with C954A02_0;  -- Printer server abstraction.
- 
- use  C954A02_0;
- use  F954A00;
- 
- procedure C954A02 is
- 
-    -- Length of time which simulates a very long process
-    Long_Enough : constant Duration := ImpDef.Clear_Ready_Queue;
- 
-                --==============================================--
- 
-    task Print_Request;                       -- Send a print request.
- 
-    task body Print_Request is
-       My_File : constant String := "MYFILE.DAT";
-    begin
-       Printer_Server.Print (My_File);          -- Invoke requeue statement.
-       Report.Failed ("Task continued execution following entry call");
-    exception
-       when others =>
-          Report.Failed ("Exception raised in Print_Request task");
-    end Print_Request;
- 
-                --==============================================--
- 
- begin  -- Main program.
- 
-    Report.Test ("C954A02", "Abort a requeue on a Protected entry");
- 
-    -- To pass this test, the following must be true:
-    --
-    --    (A) The abort of Print_Request takes place immediately.
-    --    (B) The Done_Printing entry call is canceled, and the corresponding
-    --        entry body is not executed.
-    --
-    -- Call the entry Verify_Results. The entry call will not be accepted
-    -- until after Print_Request has been requeued to Done_Printing.
- 
-    Printer_Server.Verify_Results;           -- Accepted after Print_Request is
-                                             -- requeued to Done_Printing.
- 
-    -- Verify that the Done_Printing entry call has not been completed.
-    --
-    if Printer(1).Is_Done then
-       Report.Failed ("Target entry of requeue executed prematurely");
-    else
- 
-       -- Simulate an application which needs access to the printer within
-       -- a specified time, and which aborts the current printer job if time
-       -- runs out.
- 
-       select
-          Printer(1).Done_Printing;          -- Wait for printer to come free.
-       or
-          delay Long_Enough;                 -- Print job took too long.
-          abort Print_Request;               -- Abort print job.
-       end select;
- 
-       Printer_Server.Verify_Results;        -- Abortion completion point: force
-                                             -- Print_Request abort to complete.
- 
-       -- Verify (A): that Print_Request has been aborted.
-       -- Note: the test will hang if the task as not been aborted
-       --
-       while not Print_Request'Terminated loop
-          delay ImpDef.Minimum_Task_Switch;  
-       end loop;
- 
-       -- Verify (B): that the Done_Printing entry call was canceled, and
-       -- the corresponding entry body was not executed.
-       --
-       -- Set the barrier of the entry to true, then check that the entry
-       -- body is not executed. If the entry call is NOT canceled, the
-       -- entry body will execute when the barrier is set true.
- 
-       Printer(1).Handle_Interrupt;       -- Simulate a printer interrupt,
-                                          -- signaling that printing is
-                                          -- done.
-       if Printer(1).Is_Done then
-          Report.Failed ("Entry call was not canceled");
-       end if;
- 
- 
-    end if;
- 
- 
-    Report.Result;
- 
- end C954A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954a03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c954a03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c954a03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,322 ****
- -- C954A03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a requeue statement in an accept_statement with
- --      parameters may requeue the entry call to a protected entry with no
- --      parameters. Check that, if the call is queued on the new entry's
- --      queue, the original caller remains blocked after the requeue, but
- --      the accept_statement containing the requeue is completed.
- --
- --      Note that this test uses a requeue "with abort," although it does not
- --      check that such a requeued caller can be aborted; that feature is
- --      tested elsewhere.
- --
- -- TEST DESCRIPTION:
- --      Declare a protected type which simulates a printer device driver
- --      (foundation code).
- --
- --      Declare a task which simulates a printer server for multiple printers.
- --
- --      For the protected type, declare an entry with a barrier that is set
- --      false by a protected procedure (which simulates starting a print job
- --      on the printer), and is set true by a second protected procedure (which
- --      simulates a handler called when the printer interrupts, indicating
- --      that printing is done).
- --
- --      For the task, declare an entry whose corresponding accept statement
- --      contains a call to first protected procedure of the protected type
- --      (which sets the barrier of the protected entry to false), followed by
- --      a requeue with abort to the protected entry. Declare a second entry
- --      which does nothing.
- --
- --      Declare a "requesting" task which calls the printer server task entry
- --      (and thus executes the requeue). Verify that, following the requeue,
- --      the requesting task remains blocked. Call the second entry of the
- --      printer server task (the acceptance of this entry call verifies that
- --      the requeue statement completed the entry call by the requesting task.
- --      Call the second protected procedure of the protected type (the
- --      interrupt handler) and verify that the protected entry completes for
- --      the requesting task (which verifies that the requeue statement queued
- --      the first task object to the protected entry).
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         F954A00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Oct 96   SAIC    Added pragma elaborate.
- --
- --!
- 
- package C954A03_0 is  -- Printer server abstraction.
- 
-    -- Simulate a system with multiple printers. The entry Print requests
-    -- that data be printed on the next available printer. The entry call
-    -- is accepted when a printer is available, and completes when printing
-    -- is done.
- 
-    task Printer_Server is
-       entry Print (File_Name : String);        -- Test the requeue statement.
-       entry Verify_Results;                    -- Artifice for test purposes.
-    end Printer_Server;
- 
- end C954A03_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with F954A00;              -- Printer device abstraction.
- use  F954A00;
- pragma Elaborate(F954a00);
- 
- package body C954A03_0 is  -- Printer server abstraction.
- 
- 
-    task body Printer_Server is
-       Printers_Busy  : Boolean    := True;
-       Index          : Printer_ID := 1;
-       Print_Accepted : Boolean    := False;
-    begin
- 
-       loop
-          -- Wait for a printer to become available:
- 
-          while Printers_Busy loop
-             Printers_Busy := False;                        -- Exit loop if
-                                                            -- entry accepted.
-             select
-                Printer(Index).Done_Printing;               -- Accepted immed.
-                                                            -- when printer is
-                                                            -- available.
-             else
-                Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
-                Printers_Busy := True;                      -- accepted; keep
-             end select;                                    -- looping.
- 
-             -- Allow other tasks to get control
-             delay ImpDef.Minimum_Task_Switch;   
- 
-          end loop;
-                                                            -- Value of Index
-                                                            -- at loop exit
-                                                            -- identifies the
-                                                            -- avail. printer.
- 
-          -- Wait for a print request or terminate:
- 
-          select
-             accept Print (File_Name : String) do
-                Print_Accepted := True;                     -- Allow
-                                                            -- Verify_Results
-                                                            -- to be accepted.
- 
-                Printer(Index).Start_Printing (File_Name);  -- Begin printing on
-                                                            -- the available
-                --                        --                -- printer.
-                -- Requeue is tested here --
-                --                        --
-                                                            -- Requeue caller so
-                requeue Printer(Index).Done_Printing        -- server task free
-                  with abort;                               -- to accept other
-             end Print;                                     -- requests.
-          or
-             -- Guard ensures that Verify_Results cannot be accepted
-             -- until after Print has been accepted. This avoids a
-             -- race condition in the main program.
- 
-             when Print_Accepted => accept Verify_Results;  -- Artifice for
-                                                            -- testing purposes.
-          or
-             terminate;
-          end select;
- 
-       end loop;
- 
-    exception
-       when others =>
-          Report.Failed ("Exception raised in Printer_Server task");
-    end Printer_Server;
- 
- 
- end C954A03_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with F954A00;    -- Printer device abstraction.
- with C954A03_0;  -- Printer server abstraction.
- 
- use  C954A03_0;
- use  F954A00;
- 
- procedure C954A03 is
- 
-    Long_Enough : constant Duration := ImpDef.Clear_Ready_Queue;
- 
- 
-                --==============================================--
- 
-    Task_Completed : Boolean := False;          -- Testing flag.
- 
-    protected Interlock is                      -- Artifice for test purposes.
-       entry Wait;                              -- Wait for lock to be released.
-       procedure Release;                       -- Release the lock.
-    private
-       Locked : Boolean := True;
-    end Interlock;
- 
- 
-    protected body Interlock is
- 
-       entry Wait when not Locked is            -- Calls are queued until after
-       --                                       -- Release is called.
-       begin
-          Task_Completed := True;               
-       end Wait;
- 
-       procedure Release is                     -- Called by Print_Request.
-       begin
-          Locked := False;
-       end Release;
- 
-    end Interlock;
- 
-                --==============================================--
- 
-    task Print_Request is                       -- Send a print request.
-    end Print_Request;
- 
-    task body Print_Request is
-       My_File : constant String := "MYFILE.DAT";
-    begin
-       Printer_Server.Print (My_File);          -- Invoke requeue statement.
-       Interlock.Release;                       -- Allow main to continue.
-    exception
-       when others =>
-          Report.Failed ("Exception raised in Print_Request task");
-    end Print_Request;
- 
-                --==============================================--
- 
- begin  -- Main program.
- 
-    Report.Test ("C954A03", "Requeue from an Accept with parameters" &
-                               " to a Protected Entry without parameters");
- 
-    -- To pass this test, the following must be true:
-    --
-    --    (A) The Print entry call made by the task Print_Request must be
-    --        completed by the requeue statement.
-    --    (B) Print_Request must remain blocked following the requeue.
-    --    (C) Print_Request must be queued on the Done_Printing queue of
-    --        Printer(1).
-    --    (D) Print_Request must continue execution after Done_Printing is
-    --        complete.
-    --
-    -- First, verify (A): that the Print entry call is complete.
-    --
-    -- Call the entry Verify_Results. If the requeue statement completed the
-    -- entry call to Print, the entry call to Verify_Results should be
-    -- accepted. Since the main will hang if this is NOT the case, make this
-    -- a timed entry call.
- 
-    select
-       Printer_Server.Verify_Results;        -- Accepted if requeue completed
-                                             -- entry call to Print.
-    or
-       delay Long_Enough;                    -- Time out otherwise.
-       Report.Failed ("Requeue did not complete entry call");
-    end select;
- 
-    -- Now verify (B): that Print_Request remains blocked following the
-    -- requeue. Also verify that Done_Printing (the entry to which
-    -- Print_Request should have been queued) has not yet executed.
- 
-    if Printer(1).Is_Done then
-       Report.Failed ("Target entry of requeue executed prematurely");
-    elsif Print_Request'Terminated then
-       Report.Failed ("Caller did not remain blocked after the requeue");
-    else
- 
-       -- Verify (C): that Print_Request is queued on the
-       -- Done_Printing queue of Printer(1).
-       --
-       -- Set the barrier for Printer(1).Done_Printing to true. Check
-       -- that the Done flag is updated and that Print_Request terminates.
- 
-       Printer(1).Handle_Interrupt;             -- Simulate a printer interrupt,
-                                                -- signaling that printing is
-                                                -- done.
- 
-       -- The Done_Printing entry body will complete before the next
-       -- protected action is called (Printer(1).Is_Done).
- 
-       if not Printer(1).Is_Done then
-          Report.Failed ("Caller was not requeued on target entry");
-       end if;
- 
-       -- Finally, verify (D): that Print_Request continues after Done_Printing
-       -- completes.
-       --
-       -- After Done_Printing completes, there is a potential race condition
-       -- between the main program and Print_Request. The protected object
-       -- Interlock is provided to ensure that the check of whether
-       -- Print_Request continued is made *after* it has had a chance to do so.
-       -- The main program waits until the statement in Print_Request following
-       -- the requeue-causing statement has executed, then checks to see
-       -- whether Print_Request did in fact continue executing.
-       --
-       -- Note that the test will hang here if Print_Request does not continue
-       -- executing following the completion of the requeued entry call.
- 
-       Interlock.Wait;                          -- Wait until Print_Request is
-                                                -- done.
-       if not Task_Completed then
-          Report.Failed ("Caller remained blocked after target " &
-                         "entry released");
-       end if;
- 
-       -- Wait for Print_Request to finish before calling Report.Result.
-       while not Print_Request'Terminated loop
-          delay ImpDef.Minimum_Task_Switch;   
-       end loop;                             
- 
-    end if;
- 
-    Report.Result;
- 
- end C954A03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c960001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c960001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c960001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c960001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- C960001.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Confirm that a simple Delay Until statement is performed.  Check
- --      that the delay does not complete before the requested time and that it
- --      does complete thereafter
- --
- -- TEST DESCRIPTION:
- --      Simulate a task that sends a "pulse" at regular intervals.  The Delay
- --      Until statement is used to avoid accumulated drift.  For the
- --      test, we expect the delay to return very close to the requested time;
- --      we use an additional Pulse_Time_Delta for the limit.  The test
- --      driver (main) artificially limits the number of iterations by setting
- --      the Stop_Pulse Boolean after a small number.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Nov 95   SAIC    Fixed global variable problem for ACVC 2.0.1
- --
- --!
- 
- with Report;
- with Ada.Calendar;
- with ImpDef;
-          
- procedure C960001 is
- 
- begin
- 
-    Report.Test ("C960001", "Simple Delay Until");
- 
-    declare  -- To get the Report.Result after all has completed
- 
-       function "+" (Left : Ada.Calendar.Time; Right: Duration)
-                             return Ada.Calendar.Time renames Ada.Calendar."+";
-       function "<" (Left, Right : Ada.Calendar.Time)
-                             return Boolean       renames Ada.Calendar."<";
-       function ">" (Left, Right : Ada.Calendar.Time)
-                             return Boolean       renames Ada.Calendar.">";
- 
-       TC_Loop_Count : integer range 0..4 := 0; 
-      
- 
-       -- control over stopping tasks
-       protected Control is
-          procedure Stop_Now;
-          function Stop return Boolean;
-       private
-          Halt : Boolean := False;
-       end Control;
- 
-       protected body Control is
-          procedure Stop_Now is
-          begin
-             Halt := True;
-          end Stop_Now;
- 
-          function Stop return Boolean is
-          begin
-             return Halt;
-          end Stop;
-       end Control;
-  
-       task Pulse_Task is 
-          entry Trigger;
-       end Pulse_Task;
-    
- 
-       -- Task to synchronize all qualified receivers.  
-       -- The entry Trigger starts the synchronization; Control.Stop 
-       -- becoming true terminates the task.
-       --
-       task body Pulse_Task is
- 
-          Pulse_Time       : Ada.Calendar.Time;
- 
-          Pulse_Time_Delta : duration :=  ImpDef.Clear_Ready_Queue;
- 
-          TC_Last_Time : Ada.Calendar.Time;
-          TC_Current   : Ada.Calendar.Time;
- 
- 
-          -- This routine transmits a synchronizing "pulse" to
-          -- all receivers
-          procedure Pulse is
-          begin
-             null;  -- Stub
-             Report.Comment (".......PULSE........");
-          end Pulse;
-          
-       begin
-          accept Trigger;
- 
-          Pulse_Time   := Ada.Calendar.Clock + Pulse_Time_Delta; 
-          TC_Last_Time := Pulse_Time;
- 
-          while not Control.Stop loop
-             delay until Pulse_Time;
-             Pulse;
- 
-             -- Calculate time for next pulse.  Note: this is based on the
-             -- last pulse time, not the time we returned from the delay
-             --
-             Pulse_Time := Pulse_Time + Pulse_Time_Delta;
-             
-             -- Test Control:
-             TC_Current := Ada.Calendar.Clock;
-             if TC_Current < TC_Last_Time then
-                Report.Failed ("Delay expired before requested time");
-             end if;
-             if TC_Current > Pulse_Time then
-                Report.Failed ("Delay too long");
-             end if;               
-             TC_Last_Time := Pulse_Time;
-             TC_Loop_Count := TC_Loop_Count +1;
-          end loop; 
- 
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Pulse_Task");
-       end Pulse_Task;
- 
- 
- 
-    begin -- declare
- 
-       Pulse_Task.Trigger;      -- Start test                            
- 
-       -- Artificially limit the number of iterations
-       while TC_Loop_Count < 3 loop
-          delay ImpDef.Minimum_Task_Switch;
-       end loop;
-       --
-       Control.Stop_Now;      -- End test
- 
-    end; -- declare
- 
-    Report.Result;
- 
- end C960001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c960002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c960002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c960002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c960002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,171 ****
- -- C960002.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the simple "delay until" when the request time is "now" and
- --      also some time already in the past is obeyed and returns immediately
- --
- -- TEST DESCRIPTION:
- --      Simulate a task that sends a "pulse" at regular intervals.  The Delay
- --      Until statement is used to avoid accumulated drift.  In this test
- --      three simple situations simulating the start of drift are used:  the
- --      next pulse being called for at the normal time, the next pulse being
- --      called for at exactly the current time and then at some time which has
- --      already past.  We assume the delay is within a While Loop and, to
- --      simplify the test, we "unfold" the While Loop and  execute the Delays
- --      in a serial fashion.  This loop is shown in test C960001.
- --      It is not possible to test the actual immediacy of the expiration. We
- --      can only check that it returns in a "reasonable" time.  In this case
- --      we check that it expires before the next "pulse" should have been 
- --      issued.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- with Ada.Calendar;
- with System;                                       
-          
- procedure C960002 is
- 
- begin
- 
-    Report.Test ("C960002", "Simple Delay Until with requested time being" &
-                         " ""now"" and time already in the past");
- 
-    declare  -- To get the Report.Result after all has completed
- 
-       function "+" (Left : Ada.Calendar.Time; Right: Duration)
-                             return Ada.Calendar.Time renames Ada.Calendar."+";
-       function "-" (Left : Ada.Calendar.Time; Right: Duration)
-                             return Ada.Calendar.Time renames Ada.Calendar."-";
-       function "-" (Left, Right : Ada.Calendar.Time)
-                             return duration      renames Ada.Calendar."-";
-       function ">" (Left, Right : Ada.Calendar.Time)
-                             return Boolean       renames Ada.Calendar.">";
- 
-       
-       task Pulse_Task is 
-          entry Trigger;
-       end Pulse_Task;
-    
- 
-       -- Task to synchronize all qualified receivers.  
-       -- The entry Trigger starts the synchronization. 
-       --
-       task body Pulse_Task is
-          Pulse_Time       : Ada.Calendar.Time;
-          Pulse_Time_Delta : constant duration := ImpDef.Clear_Ready_Queue; 
- 
- 
- 
-          TC_Time_Back     : Ada.Calendar.Time;
- 
- 
-          -- This routine transmits a synchronizing "pulse" to
-          -- all receivers
-          procedure Pulse is
-          begin
-             null;  -- Stub
-             Report.Comment (".......PULSE........");      
-          end Pulse;
-          
-       begin
-          accept Trigger;
-          Pulse;
-          ---------------
-          -- normal calculation for "next"
-          Pulse_Time := Ada.Calendar.Clock + Pulse_Time_Delta; 
- 
-          -- TC:  unfold the "while" loop in C960001.  Four passes through 
-          -- the loop are shown
- 
-             delay until Pulse_Time;  
- 
-             Pulse;
-             ---------------
-             -- TC: the normal calculation for "next" would be
-             -- Pulse_Time := Pulse_Time + Pulse_Time_Delta;
-             -- Instead of this normal pulse time calculation simulate
-             -- the new pulse time to be exactly "now"  (or, as exactly as 
-             -- we can)
-             Pulse_Time := Ada.Calendar.Clock; 
-             delay until  Ada.Calendar.Clock; 
- 
-             TC_Time_Back := Ada.Calendar.Clock;
- 
-             -- Now check for reasonableness
-             if TC_Time_Back > Pulse_Time + Pulse_Time_Delta then
-                Report.Failed 
-                      ("""Now"" delayed for more than Pulse_Time_Delta - A");
-             end if;
-             Pulse;
-             ---------------
-             -- normal calculation for "next" would be
-             Pulse_Time := Pulse_Time + Pulse_Time_Delta;
- 
-             -- TC: Instead of this, simulate the new calculated pulse time
-             -- being already past
-             Pulse_Time := Ada.Calendar.Clock - System.Tick;
-             delay until Pulse_Time;
- 
-             TC_Time_Back := Ada.Calendar.Clock;
- 
-             -- Now check for reasonableness
-             if TC_Time_Back > Pulse_Time + Pulse_Time_Delta then
-                Report.Failed 
-                      ("""Now"" delayed for more than Pulse_Time_Delta - B");
-             end if;
-             Pulse;
-             ---------------
-             -- normal calculation for "next"
-             Pulse_Time := Pulse_Time + Pulse_Time_Delta;
-             -- Now simulate getting back into synch
-             delay until Pulse_Time;
-             Pulse;
-             ---------------
-          -- This would be the end of the "while" loop
- 
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Pulse_Task");
-       end Pulse_Task;
- 
- 
- 
-    begin -- declare
- 
-       Pulse_Task.Trigger;      -- Start test                            
- 
-    end; -- declare
- 
-    Report.Result;
- 
- end C960002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c960004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c960004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c960004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c960004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,206 ****
- -- C960004.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --      
- -- OBJECTIVE:
- --      With the triggering statement being a delay and with the Asynchronous
- --      Select statement being in a tasking situation complete the abortable
- --      part before the delay expires.  Check that the delay is cancelled 
- --      and that the optional statements in the triggering part are not
- --      executed.
- --
- -- TEST DESCRIPTION:
- --      Simulate the creation of a carrier task to control the output of 
- --      a message via a line driver.  If the message sending process is 
- --      not complete (the completion of the rendezvous) within a
- --      specified time the carrier task is designed to take corrective action.
- --      Use an asynchronous select to control the timing; arrange that
- --      the abortable part (the rendezvous) completes almost immediately.
- --      Check that the optional statements are not executed and that the
- --      test completes well before the time of the trigger delay request thus
- --      showing that it has been cancelled.
- --                 
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-          
-                    
- with Report;
- with Ada.Calendar;
-          
- procedure C960004 is
- 
-    function "-" (Left, Right : Ada.Calendar.Time)
-                                     return Duration  renames Ada.Calendar."-";
-    TC_Start_Time      : Ada.Calendar.Time := Ada.Calendar.Clock;
-    TC_Elapsed_Time    : duration;
- 
-    -- Note: a properly executing test will complete immediately.   
-    Allowable_ACK_Time : duration := 600.0;         
- 
- begin
- 
-    Report.Test ("C960004", "ATC: When abortable part completes before " &
-                              "a triggering delay, check that the delay " &
-                              "is cancelled & optional statements " &
-                              "are not performed. Tasking situation"); 
- 
-    declare  -- To get the Report.Result after all has completed
- 
-       type Sequence_Number is range 1..1_999_999;   -- Message Number
-       subtype S_length_subtype  is integer range 1..80;
- 
-       type Message_Type (Max_String : S_length_subtype := 1) is
-          record
-             Message_Number    : Sequence_Number;
-             Alpha             : string(1..Max_String);
-          end record;
- 
-       -- TC:  Dummy message for the test
-       Dummy_Alpha     : constant string := "This could be printed";
-       Message_to_Send : Message_Type (Max_string => Dummy_Alpha'length);
- 
- 
-       -- This is the carrier task.  One of these is created for each
-       -- message that requires ACK
-       --
-       task type Require_ACK_task is 
-          entry Message_In (Message_to_Send: Message_Type);
-       end Require_ACK_task;      
-       type acc_Require_ACK_task is access Require_ACK_task;
- 
- 
-       --:::::::::::::::::::::::::::::::::
-       -- There would also be another task type "No_ACK_Task" which would
-       -- be the carrier task for those messages not requiring an ACK. 
-       -- This task would call Send_Message.ACK_Not_Required.  It is not
-       -- shown in this test as it is not used.
-       --:::::::::::::::::::::::::::::::::
- 
- 
-    
-       task Send_Message is 
-          entry ACK_Required     (Message_to_Send: Message_Type);
-          entry ACK_Not_Required (Message_to_Send: Message_Type);
-       end Send_Message;
- 
- 
-       -- This is the carrier task.  One of these is created for each
-       -- message that requires ACK
-       --
-       task body Require_ACK_task is 
-          Hold_Message : Message_Type;
- 
-          procedure Time_Out (Failed_Message_Number : Sequence_Number) is
-          begin
-             -- Take remedial action on the timed-out message
-             null;    -- stub
- 
-             Report.Failed ("Optional statements in triggering part" &
-                                     " were performed");
-          end Time_out;
- 
-       begin   
-          accept Message_In (Message_to_Send: Message_Type) do
-             Hold_Message := Message_to_Send;    -- to release caller
-          end Message_In;
- 
-          -- Now put the message out to the Send_Message task and 
-          -- wait (no more than Allowable_Ack_Time) for its completion
-          --
-          select
-             delay Allowable_ACK_Time;
-             -- ACK not received in specified time
-             Time_out (Hold_Message.Message_Number);
-          then abort
-             -- If the rendezvous is not completed in the above time, this
-             -- call is cancelled
-             --    Note: for this test this call will complete immediately
-             --          and thus the trigger should be cancelled
-             Send_Message.ACK_Required (Hold_Message);
-          end select;
- 
-       exception
-          when others => 
-                Report.Failed ("Unexpected exception in Require_ACK_task");
-       end Require_ACK_task;      
- 
- 
-       -- This is the Line Driver task
-       --
-       task body Send_Message is
-          Hold_Non_ACK_Message : Message_Type;   
-       begin
-          loop
-             select
-                accept ACK_Required (Message_to_Send: Message_Type) do
-                   -- Here send the message from within the rendezvous 
-                   -- waiting for full transmission to complete
-                   null;  -- stub
-                   -- Note: In this test this accept will complete immediately
-                end ACK_Required;
-             or
-                accept ACK_Not_Required (Message_to_Send: Message_Type) do
-                   Hold_Non_ACK_Message := Message_to_Send;
-                end ACK_Not_Required;
-                -- Here send the message from outside the rendezvous
-                null;  -- stub
-             or 
-                terminate;
-             end select;
-          end loop;
-       exception
-          when others => Report.Failed ("Unexpected exception in Send_Message");
-       end Send_Message;
- 
-    begin -- declare
-       -- Build a dummy message 
-       Message_to_Send.Alpha          := Dummy_Alpha;
-       Message_to_Send.Message_Number := 110_693;
- 
-       declare
-          New_Require_ACK_task : acc_Require_ACK_task := 
-                                              new Require_ACK_task;
-       begin
-          -- Create a carrier task for this message and pass the latter in
-          New_Require_ACK_task.Message_In (Message_to_Send);
-       end; -- declare
- 
-    end; -- declare
- 
-    --Once we are out of the above declarative region, all tasks have completed
- 
-    TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;
-    
-    -- Check that the test has completed well before the time of the requested
-    -- delay to ensure the delay was cancelled
-    --
-    if (TC_Elapsed_Time > Allowable_ACK_Time/2) then
-       Report.Failed ("Triggering delay statement was not cancelled");
-    end if;
- 
-    Report.Result;
- end C960004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96001a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- C96001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT A DELAY STATEMENT DELAYS EXECUTION FOR AT LEAST THE
- --      SPECIFIED TIME. SPECIFICALLY,
- --        (A) POSITIVE DELAY ARGUMENT.
- --        (B) NEGATIVE DELAY ARGUMENT.
- --        (C) ZERO DELAY ARGUMENT.
- --        (D) DURATION'SMALL DELAY ARGUMENT.
- --        (E) EXPRESSION OF TYPE DURATION AS DELAY ARGUMENT.
- 
- -- HISTORY:
- --     CPP  8/14/84  CREATED ORIGINAL TEST.
- --     RJW 11/13/87  ADDED CODE WHICH ALLOWS TEST TO REPORT "PASSED"
- --                   IF TICK > DURATION'SMALL.
- 
- with Impdef;
- WITH CALENDAR;  USE CALENDAR;
- WITH SYSTEM;    USE SYSTEM;
- WITH REPORT;    USE REPORT;
- PROCEDURE C96001A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0 .. 20_000;
- 
- BEGIN
-      TEST ("C96001A", "CHECK THAT DELAY STATEMENT DELAYS " &
-            "EXECUTION FOR AT LEAST THE SPECIFIED TIME");
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (A)
-           X : DURATION := 5.0 * Impdef.One_Second;
-           OLD_TIME : TIME;
-           LAPSE : DURATION;
-      BEGIN     -- (A)
-           LOOP
-                OLD_TIME := CLOCK;
-                DELAY X;
-                LAPSE := CLOCK - OLD_TIME;
-                EXIT;
-           END LOOP;
-           IF LAPSE < X THEN
-                FAILED ("DELAY DID NOT LAPSE AT LEAST 5.0 " &
-                        "SECONDS - (A)");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (A)");
-      END;
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (B)
-           OLD_TIME : TIME;
-           LAPSE : DURATION;
-      BEGIN     -- (B)
-           LOOP
-                OLD_TIME := CLOCK;
-                DELAY -5.0;
-                LAPSE := CLOCK - OLD_TIME;
-                EXIT;
-           END LOOP;
-           COMMENT ("(B) - NEGATIVE DELAY LAPSED FOR " &
-                    INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (B)");
-      END;
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (C)
-           X : DURATION := 0.0;
-           OLD_TIME : TIME;
-           LAPSE : DURATION;
-      BEGIN     -- (C)
-           LOOP
-                OLD_TIME := CLOCK;
-                DELAY X;
-                LAPSE := CLOCK - OLD_TIME;
-                EXIT;
-           END LOOP;
-           COMMENT ("(C) - ZERO DELAY LAPSED FOR " &
-                    INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (C)");
-      END;
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (D)
-           X : DURATION := DURATION'SMALL;
-           OLD_TIME : TIME;
-           LAPSE : DURATION;
-      BEGIN     -- (D)
-           LOOP
-                OLD_TIME := CLOCK;
-                DELAY X;
-                LAPSE := CLOCK - OLD_TIME;
-                EXIT;
-           END LOOP;
-           IF LAPSE < X THEN
-                IF TICK < DURATION'SMALL THEN
-                     FAILED ("DELAY DID NOT LAPSE AT LEAST " &
-                             "DURATION'SMALL SECONDS - (D)");
-                ELSE
-                     COMMENT ("TICK > DURATION'SMALL SO DELAY IN " &
-                              "'(D)' IS NOT MEASURABLE");
-                END IF;
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (D)");
-      END;
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (E)
-           INC1 : DURATION := 2.0 * Impdef.One_Second;
-           INC2 : DURATION := 3.0 * Impdef.One_Second;
-           OLD_TIME : TIME;
-           LAPSE : DURATION;
-      BEGIN     -- (E)
-           LOOP
-                OLD_TIME := CLOCK;
-                DELAY INC1 + INC2;
-                LAPSE := CLOCK - OLD_TIME;
-                EXIT;
-           END LOOP;
-           IF LAPSE < (INC1 + INC2) THEN
-                FAILED ("DELAY DID NOT LAPSE AT LEAST " &
-                        "INC1 + INC2 SECONDS - (E)");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED - (E)");
-      END;
- 
-      RESULT;
- END C96001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,280 ****
- -- C96004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PRE-DEFINED SUBTYPES FROM THE PACKAGE CALENDAR,
- --     NAMELY YEAR_NUMBER, MONTH_NUMBER, DAY_NUMBER, AND DAY_DURATION,
- --     HAVE THE CORRECT RANGE CONSTRAINTS. SUBTESTS ARE:
- --       (A) YEAR_NUMBER.
- --       (B) MONTH_NUMBER.
- --       (C) DAY_NUMBER.
- --       (D) DAY_DURATION.
- 
- -- HISTORY:
- --     CPP 08/15/84  CREATED ORIGINAL TEST.
- --     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
- --                   OPTIMIZATION.
- --     RLB 12/18/06  Changed so that the test will work for Ada 2005
- --                   implementations.
- 
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- PROCEDURE C96004A IS
- 
- BEGIN
-      TEST("C96004A", "CHECK THAT PRE-DEFINED SUBTYPES FROM THE " &
-           "CALENDAR PACKAGE HAVE CORRECT RANGE CONSTRAINTS");
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (A)
- 
-           YR : YEAR_NUMBER;
- 
-      BEGIN     -- (A)
- 
-           BEGIN
-                YR := 1900;
-                FAILED ("EXCEPTION NOT RAISED - (A)1");
-                IF NOT EQUAL (YR, YR) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (A)1");
-           END;
- 
-           BEGIN
-                YR := 84;
-                FAILED ("EXCEPTION NOT RAISED - (A)2");
-                IF NOT EQUAL (YR, YR) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (A)2");
-           END;
- 
-           BEGIN
-                YR := 2099;
-                IF NOT EQUAL (YR, YR) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("OK CASE RAISED EXCEPTION ON 2099 - (A)");
-           END;
- 
-           BEGIN
-                YR := IDENT_INT(2100);
-                IF NOT EQUAL (YR, YR) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
-                BEGIN
-                     YR := 2399;
-                     IF NOT EQUAL (YR, YR) THEN
-                          COMMENT ("NO EXCEPTION RAISED");
-                     END IF;
- 
-                EXCEPTION
-                    WHEN OTHERS =>
-                         FAILED ("ADA 2005 CASE RAISED EXCEPTION ON 2399 - (A)");
-                END;
-                BEGIN
-                     YR := IDENT_INT(2400);
-                     IF NOT EQUAL (YR, YR) THEN
-                         COMMENT ("NO EXCEPTION RAISED");
-                     END IF;
-                     FAILED ("EXCEPTION NOT RAISED - (A)3");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          Comment ("Upper bound of Year_Number is appropriate" &
-                                   " for Ada 2005");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     Comment ("Upper bound of Year_Number is appropriate" &
-                              " for Ada 95");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (A)3");
-           END;
- 
-      END; -- (A)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (B)
- 
-           MO : MONTH_NUMBER;
- 
-      BEGIN     -- (B)
- 
-           BEGIN
-                MO := IDENT_INT(0);
-                FAILED ("EXCEPTION NOT RAISED - (B)1");
-                IF NOT EQUAL (MO, MO) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (B)1");
-           END;
- 
-           BEGIN
-                MO := 12;
-                IF NOT EQUAL (MO, MO) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("OK CASE RAISED EXCEPTION ON 12 - (B)");
-           END;
- 
-           BEGIN
-                MO := 13;
-                FAILED ("EXCEPTION NOT RAISED - (B)2");
-                IF NOT EQUAL (MO, MO) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (B)2");
-           END;
- 
-      END; -- (B)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (C)
- 
-           DY : DAY_NUMBER;
- 
-      BEGIN     -- (C)
- 
-           BEGIN
-                DY := 0;
-                FAILED ("EXCEPTION NOT RAISED - (C)1");
-                IF NOT EQUAL (DY, DY) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (C)1");
-           END;
- 
-           BEGIN
-                DY := IDENT_INT(32);
-                FAILED ("EXCEPTION NOT RAISED - (C)2");
-                IF NOT EQUAL (DY, DY) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (C)2");
-           END;
- 
-      END; -- (C)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (D)
- 
-           SEGMENT : DAY_DURATION;
- 
-           FUNCTION CHECK_OK (X : DAY_DURATION) RETURN BOOLEAN IS
-                I : INTEGER := INTEGER (X);
-           BEGIN
-                RETURN EQUAL (I,I);
-           END CHECK_OK;
- 
-      BEGIN     -- (D)
- 
-           BEGIN
-                SEGMENT := 86_400.0;
-                IF CHECK_OK (SEGMENT - 86_000.0) THEN
-                     COMMENT ("NO EXCEPTION RAISED (D1)");
-                ELSE
-                     COMMENT ("NO EXCEPTION RAISED (D2)");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("OK CASE RAISED EXCEPTION ON 86_400 - (D)");
-           END;
- 
-           BEGIN
-                SEGMENT := -4.0;
-                FAILED ("EXCEPTION NOT RAISED - (D)1");
-                IF NOT EQUAL (INTEGER(SEGMENT), INTEGER(SEGMENT)) THEN
-                     COMMENT ("NO EXCEPTION RAISED (D3)");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (D)1");
-           END;
- 
-           BEGIN
-                SEGMENT := 86_401.00;
-                IF CHECK_OK (SEGMENT - 86_000.0) THEN
-                     FAILED ("NO EXCEPTION RAISED (D4)");
-                ELSE
-                     FAILED ("NO EXCEPTION RAISED (D5)");
-                END IF;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (D)2");
-           END;
- 
-      END; -- (D)
- 
-      ---------------------------------------------
- 
-      RESULT;
- END C96004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,239 ****
- -- C96005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THE CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
- -- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
- -- SPECIFICALLY,
- --   (A) CHECK THAT ADDITION AND SUBTRACTION OPERATORS WORK CORRECTLY ON
- --       VALUES OF TYPE TIME.
- 
- -- CPP 8/16/84
- 
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- -- WITH TEXT_IO;  USE TEXT_IO;
- PROCEDURE C96005A IS
- 
-      -- PACKAGE DURATION_IO IS NEW FIXED_IO (DURATION);
-      -- USE DURATION_IO;
- 
- BEGIN
-      TEST ("C96005A", "CHECK THAT THE ADDITION AND SUBTRACTION " &
-            "FUNCTIONS FOR VALUES OF TYPE TIME WORK CORRECTLY");
- 
-      -----------------------------------------------
- 
-      BEGIN     -- (A)
- 
-           -- ADDITION TESTS FOLLOW.
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 0.0);
-                NEW_TIME := NOW + INCREMENT;
-                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
-                     FAILED ("SUM OF TIMES IS INCORRECT - (A)1");
-                END IF;
-           END;
- 
- 
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 0.0);
-                NEW_TIME :=  INCREMENT + NOW;
-                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
-                     FAILED ("SUM OF TIMES IS INCORRECT - (A)2");
-                END IF;
-           END;
- 
- 
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 0.0);
-                NEW_TIME := "+"(INCREMENT, NOW);
-                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
-                     FAILED ("SUM OF TIMES IS INCORRECT - (A)3");
-                END IF;
-           END;
- 
- 
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 0.0);
-                NEW_TIME := "+"(LEFT => NOW,
-                                RIGHT => INCREMENT);
-                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
-                     FAILED ("SUM OF TIMES IS INCORRECT - (A)4");
-                END IF;
-           END;
- 
- 
-           -- SUBTRACTION TESTS FOLLOW.
-           DECLARE
-                NOW, ONCE : TIME;
-                DIFFERENCE : DURATION;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 45_000.0);
-                ONCE := TIME_OF (1984, 8, 12, 45_000.0);
-                DIFFERENCE := NOW - ONCE;
-                IF DIFFERENCE /= 86_400.0 THEN
-                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)1");
-                     -- COMMENT ("DIFFERENCE YIELDS: ");
-                     -- PUT (DIFFERENCE);
-                END IF;
-           END;
- 
- 
-           DECLARE
-           -- TIMES IN DIFFERENT MONTHS.
-                NOW, ONCE : TIME;
-                DIFFERENCE : DURATION;
-           BEGIN
-                NOW := TIME_OF (1984, 8, IDENT_INT(1), 60.0);
-                ONCE := TIME_OF (1984, 7, 31, 86_399.0);
-                DIFFERENCE := "-"(NOW, ONCE);
-                IF DIFFERENCE /= 61.0 THEN
-                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)2");
-                     -- COMMENT ("DIFFERENCE YIELDS: ");
-                     -- PUT (DIFFERENCE);
-                END IF;
-           END;
- 
- 
-           DECLARE
-           -- TIMES IN DIFFERENT YEARS.
-                NOW, AFTER : TIME;
-                DIFFERENCE : DURATION;
-           BEGIN
-                NOW := TIME_OF (IDENT_INT(1999), 12, 31, 86_399.0);
-                AFTER := TIME_OF (2000, 1, 1, 1.0);
-                DIFFERENCE := "-"(LEFT => AFTER,
-                                  RIGHT => NOW);
-                IF DIFFERENCE /= 2.0 THEN
-                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)3");
-                     -- COMMENT ("DIFFERENCE YIELDS: ");
-                     -- PUT (DIFFERENCE);
-                END IF;
-           END;
- 
- 
-           DECLARE
-           -- TIMES IN A LEAP YEAR.
-                NOW, LEAP : TIME;
-                DIFFERENCE : DURATION;
-           BEGIN
-                NOW := TIME_OF (1984, 3, 1);
-                LEAP := TIME_OF (1984, 2, 29, 86_399.0);
-                DIFFERENCE := NOW - LEAP;
-                IF DIFFERENCE /= 1.0 THEN
-                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)4");
-                     -- COMMENT ("DIFFERENCE YIELDS: ");
-                     -- PUT (DIFFERENCE);
-                END IF;
-           END;
- 
- 
-           DECLARE
-           -- TIMES IN A NON-LEAP YEAR.
-                NOW, NON_LEAP : TIME;
-                DIFFERENCE : DURATION;
-           BEGIN
-                NOW := TIME_OF (1983, 3, 1);
-                NON_LEAP := TIME_OF (1983, 2, 28, 86_399.0);
-                DIFFERENCE := NOW - NON_LEAP;
-                IF DIFFERENCE /= 1.0 THEN
-                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)5");
-                     -- COMMENT ("DIFFERENCE YIELDS: ");
-                     -- PUT (DIFFERENCE);
-                END IF;
-           END;
- 
- 
-           -- SUBTRACTION TESTS FOLLOW: TIME - DURATION.
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 0.0);
-                NEW_TIME := NOW - INCREMENT;
-                IF NEW_TIME /= TIME_OF (1984, 8, 12, 86_399.0) THEN
-                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
-                             "INCORRECT - (A)6");
-                END IF;
-           END;
- 
- 
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 1, 0.0);
-                NEW_TIME := NOW - INCREMENT;
-                IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
-                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
-                             "INCORRECT - (A)7");
-                END IF;
-           END;
- 
- 
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 1, 0.0);
-                NEW_TIME := "-"(LEFT => NOW,
-                                RIGHT => INCREMENT);
-                IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
-                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
-                             "INCORRECT - (A)8");
-                END IF;
-           END;
- 
- 
-           DECLARE
-                NOW, NEW_TIME : TIME;
-                INCREMENT : DURATION := 1.0;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 1, 0.0);
-                NEW_TIME := "-"(NOW, INCREMENT);
-                IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
-                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
-                             "INCORRECT - (A)7");
-                END IF;
-           END;
- 
- 
-      END; -- (A)
- 
-      -----------------------------------------------
- 
-      RESULT;
- END C96005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005b.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005b.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005b.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005b.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- C96005B.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THE CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
- -- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
- -- SPECIFICALLY,
- --   (B) ADDITION AND SUBTRACTION OPERATORS RAISE CONSTRAINT_ERROR WHEN
- --       CALLED WITH AN OUT OF RANGE DURATION PARAMETER.
- 
- -- CPP 8/16/84
- 
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- PROCEDURE C96005B IS
- 
- BEGIN
-      TEST ("C96005B", "CHECK THAT ADDITION AND SUBTRACTION " &
-            "OPERATORS RAISE CONSTRAINT_ERROR WHEN CALLED WITH " &
-            "OUT OF RANGE DURATION PARAMETER");
- 
-      -----------------------------------------------
- 
-      BEGIN     -- (B)
- 
-           -- ADDITION TESTS FOLLOW.
-           DECLARE
-                BEFORE : TIME := CLOCK;
-           BEGIN
-                IF DURATION'BASE'FIRST < DURATION'FIRST THEN
-                     COMMENT("LOW VALUES EXIST - (B)1");
-                     BEFORE := BEFORE + ($LESS_THAN_DURATION);
-                     FAILED ("EXCEPTION NOT RAISED - (B)1");
-                ELSE
-                     NOT_APPLICABLE ("NO LOW VALUES EXIST - (B)1");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN TIME_ERROR =>
-                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - (B)1");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (B)1");
-           END;
- 
-           DECLARE
-                BEFORE : TIME := CLOCK;
-           BEGIN
-                IF DURATION'LAST < DURATION'BASE'LAST THEN
-                     COMMENT("HIGH VALUES EXIST - (B)2");
-                     BEFORE := $GREATER_THAN_DURATION + BEFORE;
-                     FAILED ("EXCEPTION NOT RAISED - (B)2");
-                ELSE
-                     NOT_APPLICABLE ("NO HIGH VALUES EXIST - (B)2");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN TIME_ERROR =>
-                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - (B)2");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (B)2");
-           END;
- 
- 
-           -- SUBTRACTION TESTS FOLLOW.
-           DECLARE
-                BEFORE : TIME := CLOCK;
-           BEGIN
-                IF DURATION'BASE'FIRST < DURATION'FIRST THEN
-                     COMMENT("LOW VALUES EXIST - (B)3");
-                     BEFORE := BEFORE - ($LESS_THAN_DURATION);
-                     FAILED ("EXCEPTION NOT RAISED - (B)3");
-                ELSE
-                     NOT_APPLICABLE ("NO LOW VALUES EXIST - (B)3");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN TIME_ERROR =>
-                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - (B)3");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (B)3");
-           END;
- 
-           DECLARE
-                BEFORE : TIME := CLOCK;
-           BEGIN
-                IF DURATION'LAST < DURATION'BASE'LAST THEN
-                     COMMENT("HIGH VALUES EXIST - (B)4");
-                     BEFORE := BEFORE - $GREATER_THAN_DURATION;
-                     FAILED ("EXCEPTION NOT RAISED - (B)4");
-                ELSE
-                     NOT_APPLICABLE ("NO HIGH VALUES EXIST - (B)4");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN TIME_ERROR =>
-                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - (B)4");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (B)4");
-           END;
- 
- 
-      END; -- (B)
- 
-      -----------------------------------------------
- 
-      RESULT;
- END C96005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C96005D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THE CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
- -- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
- -- SPECIFICALLY,
- --   (D) THE EXCEPTION TIME_ERROR IS RAISED WHEN THE FUNCTION "-"
- --       RETURNS A VALUE NOT IN THE SUBTYPE RANGE DURATION.
- 
- -- CPP 8/16/84
- 
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- PROCEDURE C96005D IS
- 
- BEGIN
-      TEST ("C96005D", "CHECK THAT THE SUBTRACTION OPERATOR RAISES " &
-            "TIME_ERROR APPROPRIATELY");
- 
-      ---------------------------------------------
- 
-      BEGIN     -- (D)
- 
-           DECLARE
-                NOW, LATER : TIME;
-                WAIT : DURATION;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 0.0);
-                LATER := (NOW + DURATION'LAST) + 1.0;
-                WAIT := LATER - NOW;
-                FAILED ("EXCEPTION NOT RAISED - (D)1");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (D)1");
-           END;
- 
- 
-           DECLARE
-                NOW, LATER : TIME;
-                WAIT : DURATION;
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, 0.0);
-                LATER := (NOW + DURATION'FIRST) - 1.0;
-                WAIT := NOW - LATER;
-                FAILED ("EXCEPTION NOT RAISED - (D)2");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (D)2");
-           END;
- 
-      END; -- (D)
- 
-      ---------------------------------------------
- 
-      RESULT;
- END C96005D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96005f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96005f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- C96005F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PACKAGE CALENDAR + AND - FUNCTIONS WORK PROPERLY,
- -- ESPECIALLY WITH VALUES AT MIDNIGHT.
-  
- -- GOM 02/18/85
- -- JWC 05/14/85
-  
- WITH REPORT;
- USE REPORT;
- WITH CALENDAR;
- USE CALENDAR;
-  
- PROCEDURE C96005F IS
- 
-      CURR_DAY1 : CONSTANT TIME := TIME_OF(1984,1,1,0.0);
-      CURR_DAY2 : CONSTANT TIME := TIME_OF(1984,1,1,DAY_DURATION'LAST);
-      CURR_DAY3 : CONSTANT TIME := TIME_OF(1984,1,1,10000.0);
- 
-      TOMORROW1 : CONSTANT TIME := TIME_OF(1984,1,2,0.0);
-      TOMORROW2 : CONSTANT TIME := TIME_OF(1984,1,2,DAY_DURATION'LAST);
-      TOMORROW3 : CONSTANT TIME := TIME_OF(1984,1,2,10000.0);
- 
-      YESTERDAY1 : CONSTANT TIME := TIME_OF(1983,12,31,0.0);
-      YESTERDAY2 : CONSTANT TIME := TIME_OF(1983,12,31,
-                                            DAY_DURATION'LAST);
-      YESTERDAY3 : CONSTANT TIME := TIME_OF(1983,12,31,10000.0);
- 
- BEGIN
-      TEST("C96005F","CHECKING PACKAGE CALENDAR + AND - FUNCTIONS");
- 
-      -- CHECK IF ADDING ONE DAY TO 'CURR_DAY#' TIMES YIELDS
-      -- TIMES EQUAL TO 'TOMORROW'.
- 
-      IF (CURR_DAY1 + DAY_DURATION'LAST) /= TOMORROW1 THEN
-           FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY1'");
-      END IF;
- 
-      IF (CURR_DAY2 + DAY_DURATION'LAST) /= TOMORROW2 THEN
-           FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY2'");
-      END IF;
-  
-      IF (CURR_DAY3 + DAY_DURATION'LAST) /= TOMORROW3 THEN
-           FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY3'");
-      END IF;
- 
-      IF (CURR_DAY1 + DAY_DURATION'LAST) /= CURR_DAY2 THEN
-           FAILED("'CURR_DAY1' + 1 /= 'CURR_DAY2'");
-      END IF;
-  
-      -- CHECK IF SUBTRACTING ONE DAY FROM 'CURR_DAY#' TIMES YIELDS
-      -- TIMES EQUAL TO 'YESTERDAY'.
- 
-      IF (CURR_DAY1 - DAY_DURATION'LAST) /= YESTERDAY1 THEN
-           FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY1'");
-      END IF;
- 
-      IF (CURR_DAY2 - DAY_DURATION'LAST) /= YESTERDAY2 THEN
-           FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY2'");
-      END IF;
- 
-      IF (CURR_DAY3 - DAY_DURATION'LAST) /= YESTERDAY3 THEN
-           FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY3'");
-      END IF;
- 
-      IF (CURR_DAY2 - DAY_DURATION'LAST) /= CURR_DAY1 THEN
-           FAILED("'CURR_DAY2' - 1 /= 'CURR_DAY1'");
-      END IF;
-  
-      RESULT;
- END C96005F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,298 ****
- -- C96006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR THE PACKAGE CALENDAR, THE RELATIONAL OPERATORS WORK
- -- CORRECTLY FOR OPERANDS OF TYPE TIME AND TYPE DURATION. PARTICULARLY,
- --   (A) RELATIONS BASED ON YEARS.
- --   (B) RELATIONS BASED ON MONTH.
- --   (C) RELATIONS BASED ON SECONDS.
- --   (D) RELATIONS AT EXTREMES OF THE PERMITTED RANGE OF TIME.
- 
- -- CPP 8/16/84
- 
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- PROCEDURE C96006A IS
- 
- BEGIN
-      TEST ("C96006A", "CHECK THAT RELATIONAL OPERATORS WORK " &
-            "CORRECTLY IN THE PACKAGE CALENDAR");
- 
-      --------------------------------------------
- 
-      DECLARE   -- (A)
-      -- RELATIONS BASED ON YEARS.
-           NOW, LATER : TIME;
-      BEGIN     -- (A)
-           NOW := TIME_OF (1984, 8, 12, 500.0);
-           LATER := TIME_OF (1985, 8, 12, 500.0);
- 
-           IF NOW < LATER THEN
-                COMMENT ("< OPERATOR OK - (A)");
-           ELSE
-                FAILED ("< OPERATOR INCORRECT - (A)");
-           END IF;
- 
-           IF NOW <= LATER THEN
-                COMMENT ("<= OPERATOR OK - (A)");
-           ELSE
-                FAILED ("<= OPERATOR INCORRECT - (A)");
-           END IF;
- 
-           IF NOW <= NOW THEN
-                COMMENT ("<= OPERATOR OK - (A)2");
-           ELSE
-                FAILED ("<= OPERATOR INCORRECT - (A)2");
-           END IF;
- 
-           IF LATER > NOW THEN
-                COMMENT ("> OPERATOR OK - (A)");
-           ELSE
-                FAILED ("> OPERATOR INCORRECT - (A)");
-           END IF;
- 
-           IF LATER >= NOW THEN
-                COMMENT (">= OPERATOR OK - (A)");
-           ELSE
-                FAILED (">= OPERATOR INCORRECT - (A)");
-           END IF;
- 
-           IF LATER >= LATER THEN
-                COMMENT (">= OPERATOR OK - (A)2");
-           ELSE
-                FAILED (">= OPERATOR INCORRECT - (A)2");
-           END IF;
- 
-      END; -- (A)
- 
-      --------------------------------------------
- 
-      DECLARE   -- (B)
-      -- RELATIONS BASED ON MONTH.
-           NOW, LATER : TIME;
-      BEGIN     -- (B)
-           NOW := TIME_OF (1984, 8, 12, 500.0);
-           LATER := TIME_OF (1984, 9, 12, 500.0);
- 
-           IF NOW < LATER THEN
-                COMMENT ("< OPERATOR OK - (B)");
-           ELSE
-                FAILED ("< OPERATOR INCORRECT - (B)");
-           END IF;
- 
-           IF NOW <= LATER THEN
-                COMMENT ("<= OPERATOR OK - (B)");
-           ELSE
-                FAILED ("<= OPERATOR INCORRECT - (B)");
-           END IF;
- 
-           IF NOW <= NOW THEN
-                COMMENT ("<= OPERATOR OK - (B)2");
-           ELSE
-                FAILED ("<= OPERATOR INCORRECT - (B)2");
-           END IF;
- 
-           IF LATER > NOW THEN
-                COMMENT ("> OPERATOR OK - (B)");
-           ELSE
-                FAILED ("> OPERATOR INCORRECT - (B)");
-           END IF;
- 
-           IF LATER >= NOW THEN
-                COMMENT (">= OPERATOR OK - (B)");
-           ELSE
-                FAILED (">= OPERATOR INCORRECT - (B)");
-           END IF;
- 
-           IF LATER >= LATER THEN
-                COMMENT (">= OPERATOR OK - (B)2");
-           ELSE
-                FAILED (">= OPERATOR INCORRECT - (B)2");
-           END IF;
- 
-           IF NOW = NOW THEN
-                COMMENT ("= OPERATOR OK - (B)");
-           ELSE
-                FAILED ("= OPERATOR INCORRECT - (B)");
-           END IF;
- 
-           IF LATER /= NOW THEN
-                COMMENT ("/= OPERATOR OK - (B)");
-           ELSE
-                FAILED ("/= OPERATOR INCORRECT - (B)");
-           END IF;
- 
-      END; -- (B)
- 
-      --------------------------------------------
- 
-      DECLARE   -- (C)
-      -- RELATIONS BASED ON SECONDS.
-           NOW, LATER : TIME;
-           INCREMENT : DURATION := 99.9;
-      BEGIN     -- (C)
-           NOW := TIME_OF (1984, 8, 12, 500.0);
-           LATER := NOW + INCREMENT;
- 
-           IF NOW < LATER THEN
-                COMMENT ("< OPERATOR OK - (C)");
-           ELSE
-                FAILED ("< OPERATOR INCORRECT - (C)");
-           END IF;
- 
-           IF NOW <= LATER THEN
-                COMMENT ("<= OPERATOR OK - (C)");
-           ELSE
-                FAILED ("<= OPERATOR INCORRECT - (C)");
-           END IF;
- 
-           IF NOW <= NOW THEN
-                COMMENT ("<= OPERATOR OK - (C)2");
-           ELSE
-                FAILED ("<= OPERATOR INCORRECT - (C)2");
-           END IF;
- 
-           IF LATER > NOW THEN
-                COMMENT ("> OPERATOR OK - (C)");
-           ELSE
-                FAILED ("> OPERATOR INCORRECT - (C)");
-           END IF;
- 
-           IF LATER >= NOW THEN
-                COMMENT (">= OPERATOR OK - (C)");
-           ELSE
-                FAILED (">= OPERATOR INCORRECT - (C)");
-           END IF;
- 
-           IF LATER >= LATER THEN
-                COMMENT (">= OPERATOR OK - (C)2");
-           ELSE
-                FAILED (">= OPERATOR INCORRECT - (C)2");
-           END IF;
- 
-           IF LATER = LATER THEN
-                COMMENT ("= OPERATOR OK - (C)");
-           ELSE
-                FAILED ("= OPERATOR INCORRECT - (C)");
-           END IF;
- 
-           IF NOW /= LATER THEN
-                COMMENT ("/= OPERATOR OK - (C)");
-           ELSE
-                FAILED ("/= OPERATOR INCORRECT - (C)");
-           END IF;
- 
-           IF NOW < NOW THEN
-                FAILED ("NOW < NOW INCORRECT - (C)");
-           ELSIF NOW /= NOW THEN
-                FAILED ("NOW = NOW INCORRECT - (C)");
-           ELSIF LATER < NOW THEN
-                FAILED ("LATER < NOW INCORRECT - (C)");
-           ELSIF LATER <= NOW THEN
-                FAILED ("LATER <= NOW INCORRECT - (C)");
-           ELSIF LATER = NOW THEN
-                FAILED ("NOW = LATER INCORRECT - (C)");
-           ELSIF NOW > LATER THEN
-                FAILED ("NOW > LATER INCORRECT - (C)");
-           ELSIF NOW > NOW THEN
-                FAILED ("NOW > NOW INCORRECT - (C)");
-           ELSIF NOW >= LATER THEN
-                FAILED ("NOW >= LATER INCORRECT - (C)");
-           ELSIF NOW = LATER THEN
-                FAILED ("NOW = LATER INCORRECT - (C)");
-           END IF;
- 
-      END; -- (C)
- 
-      --------------------------------------------
- 
-      DECLARE   -- (D)
- 
-           NOW, WAY_BACK_THEN : TIME;
- 
-      BEGIN     -- (D)
- 
-           NOW := TIME_OF (2099, 12, 31);
-           WAY_BACK_THEN := TIME_OF (1901, 1, 1);
- 
-           BEGIN
-                IF NOW < WAY_BACK_THEN THEN
-                     FAILED ("TEST < AT EXTREMES INCORRECT - (D)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("< AT EXTREMES RAISED EXCEPTION - (D)");
-           END;
- 
-           BEGIN
-                IF NOW <= WAY_BACK_THEN THEN
-                     FAILED ("TEST <= AT EXTREMES INCORRECT - (D)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("<= AT EXTREMES RAISED EXCEPTION - (D)");
-           END;
- 
-           BEGIN
-                IF WAY_BACK_THEN > NOW THEN
-                     FAILED ("TEST > AT EXTREMES INCORRECT - (D)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("> AT EXTREMES RAISED EXCEPTION - (D)");
-           END;
- 
-           BEGIN
-                IF WAY_BACK_THEN >= NOW THEN
-                     FAILED ("TEST >= AT EXTREMES INCORRECT - (D)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED (">= AT EXTREMES RAISED EXCEPTION - (D)");
-           END;
- 
-           BEGIN
-                IF WAY_BACK_THEN /= WAY_BACK_THEN THEN
-                     FAILED ("TEST /= AT EXTREMES INCORRECT - (D)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("/= AT EXTREMES RAISED EXCEPTION - (D)");
-           END;
- 
-           BEGIN
-                IF NOW = WAY_BACK_THEN THEN
-                     FAILED ("TEST = AT EXTREMES INCORRECT - (D)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("= AT EXTREMES RAISED EXCEPTION - (D)");
-           END;
- 
-      END; -- (D)
- 
-      --------------------------------------------
- 
-      RESULT;
- END C96006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,205 ****
- -- C96007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT APPROPRIATE EXCEPTIONS ARE RAISED FOR THE TIME_OF()
- -- FUNCTION IN THE PACKAGE CALENDAR. PARTICULARLY,
- --   (A) TIME_ERROR IS RAISED ON INVALID DATES.
- --   (B) CONSTRAINT_ERROR IS RAISED FOR OUT-OF-RANGE PARAMETERS.
- 
- -- CPP  8/16/84
- -- RLB 12/18/06 - Changed so that the test will work for Ada 2005
- --                implementations.
- 
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- PROCEDURE C96007A IS
- 
- BEGIN
-      TEST ("C96007A", "CHECK THAT APPROPRIATE EXCEPTIONS ARE RAISED " &
-            "FOR THE TIME_OF FUNCTION IN THE PACKAGE CALENDAR");
- 
-      --------------------------------------------
- 
-      DECLARE   -- (A)
- 
-           BAD_TIME : TIME;
- 
-      BEGIN     -- (A)
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 2, 30);
-                FAILED ("EXCEPTION NOT RAISED - 2/30 (A)");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2/30 (A)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 2, 31);
-                FAILED ("EXCEPTION NOT RAISED - 2/31 (A)");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2/31 (A)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 4, 31);
-                FAILED ("EXCEPTION NOT RAISED - 4/31 (A)");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 4/31 (A)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 6, 31);
-                FAILED ("EXCEPTION NOT RAISED - 6/31 (A)");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 6/31 (A)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 9, 31);
-                FAILED ("EXCEPTION NOT RAISED - 9/31 (A)");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 9/31 (A)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 11, 31);
-                FAILED ("EXCEPTION NOT RAISED - 11/31 (A)");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 11/31 (A)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1983, 2, 29);
-                FAILED ("EXCEPTION NOT RAISED - 2/29 (A)");
-           EXCEPTION
-                WHEN TIME_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2/29 (A)");
-           END;
- 
-      END; -- (A)
- 
-      --------------------------------------------
- 
-      DECLARE   -- (B)
- 
-           BAD_TIME : TIME;
- 
-      BEGIN     -- (B)
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1900, 8, 13);
-                FAILED ("EXCEPTION NOT RAISED - 1900 (B)");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 1900 (B)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (YEAR_NUMBER'LAST+1, 8, 13);
-                FAILED ("EXCEPTION NOT RAISED - YEAR_NUM'LAST+1 (B)");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - YEAR_NUM'LAST+1 (B)");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 0, 13);
-                FAILED ("EXCEPTION NOT RAISED - MONTH (B)1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - MONTH (B)1");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 13, 13);
-                FAILED ("EXCEPTION NOT RAISED - MONTH (B)2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - MONTH (B)2");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 8, 0);
-                FAILED ("EXCEPTION NOT RAISED - DAY (B)1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - DAY (B)1");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (19784, 8, 32);
-                FAILED ("EXCEPTION NOT RAISED - DAY (B)2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - DAY (B)2");
-           END;
- 
-           BEGIN
-                BAD_TIME := TIME_OF (1984, 8, 13, -0.5);
-                FAILED ("EXCEPTION NOT RAISED - SECONDS (B)1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - SECONDS (B)1");
-           END;
- 
-      END; -- (B)
- 
-      --------------------------------------------
- 
-      RESULT;
- END C96007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,203 ****
- -- C96008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- MISCELLANEOUS CHECKS ON THE PRE-DEFINED FUNCTIONS IN THE PACKAGE
- -- CALENDAR.  SUBTESTS ARE:
- --   (A) TIME_OF() AND SPLIT() ARE INVERSE FUNCTIONS.
- --   (B) FORMAL PARAMETERS OF TIME_OF() AND SPLIT() ARE NAMED CORRECTLY.
- --   (C) TIME_OF() GIVES THE PARAMETER SECONDS A DEFAULT VALUE OF 0.0.
- --   (D) THE FUNCTIONS YEAR(), MONTH(), DAY(), AND SECONDS() RETURN
- --       CORRECT VALUES USING NAMED NOTATION.
- --   (E) A VALUE RETURNED FROM CLOCK() CAN BE PROCESSED BY SPLIT().
- --   (F) DURATION'SMALL MEETS REQUIRED LIMIT.
- 
- -- CPP 8/16/84
- 
- WITH SYSTEM;
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- PROCEDURE C96008A IS
- 
- BEGIN
-      TEST ("C96008A", "CHECK MISCELLANEOUS FUNCTIONS IN THE " &
-            "PACKAGE CALENDAR");
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (A)
-           NOW : TIME;
-           YR : YEAR_NUMBER;
-           MO : MONTH_NUMBER;
-           DY : DAY_NUMBER;
-           SEC : DAY_DURATION;
-      BEGIN     -- (A)
-           BEGIN
-                NOW := TIME_OF (1984, 8, 13, DURATION(1.0/3.0));
-                SPLIT (NOW, YR, MO, DY, SEC);
-                IF NOW /= TIME_OF (YR, MO, DY, SEC) THEN
-                     COMMENT ("TIME_OF AND SPLIT ARE NOT INVERSES " &
-                              "WHEN SECONDS IS A NON-MODEL NUMBER " &
-                              "- (A)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("TIME_OF(SPLIT) RAISED EXCEPTION - (A)");
-           END;
- 
- 
-           BEGIN
-                -- RESET VALUES.
-                YR := 1984;
-                MO := 8;
-                DY := 13;
-                SEC := 1.0;
- 
-                SPLIT (TIME_OF (YR, MO, DY, SEC), YR, MO, DY, SEC);
- 
-                IF YR /= 1984 THEN
-                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF YR - (A)");
-                END IF;
- 
-                IF MO /= 8 THEN
-                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF MO - (A)");
-                END IF;
- 
-                IF DY /= 13 THEN
-                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF DY - (A)");
-                END IF;
- 
-                IF SEC /= 1.0 THEN
-                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF " &
-                             "SEC - (A)");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("SPLIT(TIME_OF) PROCESSING RAISED " &
-                             "EXCEPTION - (A)");
-           END;
-      END; -- (A)
- 
-      ---------------------------------------------
- 
-      BEGIN     -- (B)
-           DECLARE
-                NOW : TIME;
-           BEGIN
-                NOW := TIME_OF (YEAR => 1984,
-                                MONTH => 8,
-                                DAY => 13,
-                                SECONDS => 60.0);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NAMED ASSOCIATION ON TIME_OF() RAISED " &
-                             "EXCEPTION - (B)");
-           END;
- 
- 
-           DECLARE
-                NOW : TIME := CLOCK;
-                YR : YEAR_NUMBER := 1984;
-                MO : MONTH_NUMBER := 8;
-                DY : DAY_NUMBER := 13;
-                SEC : DAY_DURATION := 0.0;
-           BEGIN
-                SPLIT (DATE => NOW,
-                       YEAR => YR,
-                       MONTH => MO,
-                       DAY => DY,
-                       SECONDS => SEC);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("NAMED ASSOCIATION ON SPLIT() RAISED " &
-                             "EXCEPTION - (B)2");
-           END;
-      END; -- (B)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (C)
-           NOW : TIME;
-      BEGIN     -- (C)
-           NOW := TIME_OF (1984, 8, 13);
-           IF SECONDS (NOW) /= 0.0 THEN
-                FAILED ("TIME_OF() DID NOT ZERO SECONDS - (C)");
-           END IF;
-      END; -- (C)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (D)
-      -- ASSUMES TIME_OF() WORKS CORRECTLY.
-           HOLIDAY : TIME;
-      BEGIN     -- (D)
-           HOLIDAY := TIME_OF (1958, 9, 9, 1.0);
- 
-           IF YEAR (DATE => HOLIDAY) /= 1958 THEN
-                FAILED ("YEAR() DID NOT RETURN CORRECT VALUE - (D)");
-           END IF;
- 
-           IF MONTH (DATE => HOLIDAY) /= 9 THEN
-                FAILED ("MONTH() DID NOT RETURN CORRECT VALUE - (D)");
-           END IF;
- 
-           IF DAY (DATE => HOLIDAY) /= 9 THEN
-                FAILED ("DAY() DID NOT RETURN CORRECT VALUE - (D)");
-           END IF;
- 
-           IF SECONDS (HOLIDAY) /= 1.0 THEN
-                FAILED ("SECONDS() DID NOT RETURN CORRECT VALUE - (D)");
-           END IF;
-      END; -- (D)
- 
-      ---------------------------------------------
- 
-      DECLARE   -- (E)
-           YR : YEAR_NUMBER;
-           MO : MONTH_NUMBER;
-           DY : DAY_NUMBER;
-           SEC : DAY_DURATION;
-      BEGIN     -- (E)
-           SPLIT (CLOCK, YR, MO, DY, SEC);
-           DELAY SYSTEM.TICK;
- 
-           IF TIME_OF (YR, MO, DY, SEC) > CLOCK THEN
-                FAILED ("SPLIT() ON CLOCK INCORRECT - (E)");
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("SPLIT() ON CLOCK RAISED EXCEPTION - (E)");
-      END; -- (E)
- 
-      ---------------------------------------------
- 
-      BEGIN     -- (F)
-           IF DURATION'SMALL > 0.020 THEN
-                FAILED ("DURATION'SMALL LARGER THAN SPECIFIED - (F)");
-           END IF;
-      END; -- (F)
- 
-      ---------------------------------------------
- 
-      RESULT;
- END C96008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96008b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c96008b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c96008b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C96008B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- MISCELLANEOUS CHECKS ON THE PRE-DEFINED FUNCTIONS IN THE PACKAGE
- -- CALENDAR.  SUBTESTS ARE:
- --   (A) THE FUNCTION TIME_OF() MUST ADVANCE DAY WHEN CALLED WITH THE
- --       SECONDS ARGUMENT HAVING THE VALUE 86_400.
- 
- -- CPP 8/16/84
- -- JRK 12/4/84
- 
- WITH CALENDAR;  USE CALENDAR;
- WITH REPORT;  USE REPORT;
- PROCEDURE C96008B IS
- 
-      NOW1, NOW2 : TIME;
-      YR : YEAR_NUMBER;
-      MO : MONTH_NUMBER;
-      DY : DAY_NUMBER;
-      SEC : DAY_DURATION;
- 
- BEGIN
- 
-      TEST ("C96008B", "CHECK THAT TIME_OF() ADVANCES DAY");
- 
-      NOW1 := TIME_OF (1984, 8, 13, 86_400.0);
-      NOW2 := TIME_OF (1984, 8, 14, 0.0);
- 
-      IF NOW1 /= NOW2 THEN
-           FAILED ("TIME_OF DID NOT CONVERT 86_400 SECONDS TO A DAY");
-      END IF;
- 
-      SPLIT (NOW2, YR, MO, DY, SEC);
- 
-      IF DY /= 14 THEN
-           FAILED ("DAY OF NOW2 INCORRECT");
-      END IF;
-      IF SEC /= 0.0 THEN
-           FAILED ("SECONDS OF NOW2 INCORRECT");
-      END IF;
- 
-      SPLIT (NOW1, YR, MO, DY, SEC);
- 
-      IF DY /= 14 OR SEC /= 0.0 OR
-         DAY (NOW1) /= 14 OR SECONDS (NOW1) /= 0.0 THEN
-           FAILED ("TIME_OF DID NOT ADVANCE DAY");
-      END IF;
- 
-      RESULT;
- END C96008B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97112a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97112a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97112a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97112a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- C97112A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A DELAY STATEMENT IS ALLOWED IN THE SEQUENCE OF STATEMENTS
- -- OF A SELECT ALTERNATIVE OF A SELECTIVE WAIT CONTAINING A TERMINATE
- -- ALTERNATIVE OR AN ELSE PART.
- 
- -- WRG 7/9/86
- 
- with Impdef;
- WITH REPORT;   USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97112A IS
- 
-      ACCEPT_ALTERNATIVE_TAKEN : BOOLEAN := FALSE;
- 
- BEGIN
- 
-      TEST ("C97112A", "CHECK THAT A DELAY STATEMENT IS ALLOWED IN " &
-                       "THE SEQUENCE OF STATEMENTS OF A SELECT " &
-                       "ALTERNATIVE OF A SELECTIVE WAIT CONTAINING A " &
-                       "TERMINATE ALTERNATIVE OR AN ELSE PART");
- 
-      --------------------------------------------------
- 
-   A: DECLARE
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-                BEFORE, AFTER : TIME;
-           BEGIN
-                SELECT
-                     ACCEPT E;
-                     ACCEPT_ALTERNATIVE_TAKEN := TRUE;
-                     BEFORE := CLOCK;
-                     DELAY 10.0 * Impdef.One_Second;
-                     AFTER  := CLOCK;
-                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
-                          FAILED ("INSUFFICIENT DELAY (A)");
-                     END IF;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END T;
- 
-      BEGIN
- 
-           T.E;
- 
-      END A;
- 
-      IF NOT ACCEPT_ALTERNATIVE_TAKEN THEN
-           FAILED ("ACCEPT ALTERNATIVE NOT TAKEN");
-      END IF;
- 
-      --------------------------------------------------
- 
-   B: DECLARE
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-                BEFORE, AFTER : TIME;
-           BEGIN
-                --ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
-                WHILE E'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                SELECT
-                     ACCEPT E;
-                     BEFORE := CLOCK;
-                     DELAY 10.0 * Impdef.One_Second;
-                     AFTER  := CLOCK;
-                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
-                          FAILED ("INSUFFICIENT DELAY (B-1)");
-                     END IF;
-                ELSE
-                     FAILED ("ELSE PART EXECUTED (B-1)");
-                END SELECT;
- 
-                SELECT
-                     ACCEPT E;
-                     FAILED ("ACCEPT STATEMENT EXECUTED (B-2)");
-                ELSE
-                     BEFORE := CLOCK;
-                     DELAY 10.0 * Impdef.One_Second;
-                     AFTER  := CLOCK;
-                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
-                          FAILED ("INSUFFICIENT DELAY (B-2)");
-                     END IF;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED");
-           END T;
- 
-      BEGIN
- 
-           T.E;
- 
-      END B;
- 
-      --------------------------------------------------
- 
-      RESULT;
- 
- END C97112A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97113a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97113a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97113a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- C97113A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL CONDITIONS, OPEN DELAY ALTERNATIVE EXPRESSIONS, AND
- --   OPEN ENTRY FAMILY INDICES ARE EVALUATED (EVEN WHEN SOME (PERHAPS
- --   ALL BUT ONE) OF THE ALTERNATIVES CAN BE RULED OUT WITHOUT
- --   COMPLETING THE EVALUATIONS).
- 
- -- RM 5/06/82
- -- SPS 11/21/82
- -- WRG 7/9/86    ADDED DELAY EXPRESSIONS AND ENTRY FAMILY INDICES.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97113A IS
- 
-      EXPR1_EVALUATED : BOOLEAN := FALSE;
-      EXPR2_EVALUATED : BOOLEAN := FALSE;
-      EXPR3_EVALUATED : BOOLEAN := FALSE;
- 
-      FUNCTION F1 RETURN BOOLEAN IS
-      BEGIN
-           EXPR1_EVALUATED := TRUE;
-           RETURN TRUE;
-      END F1;
- 
-      FUNCTION F2 (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           EXPR2_EVALUATED := TRUE;
-           RETURN X;
-      END F2;
- 
-      FUNCTION F3 (X : DURATION) RETURN DURATION IS
-      BEGIN
-           EXPR3_EVALUATED := TRUE;
-           RETURN X;
-      END F3;
- 
- BEGIN
- 
-      TEST ("C97113A", "CHECK THAT ALL CONDITIONS, OPEN DELAY " &
-                       "ALTERNATIVE EXPRESSIONS, AND OPEN ENTRY " &
-                       "FAMILY INDICES ARE EVALUATED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E1;
-                ENTRY E2;
-                ENTRY E3 (1..1);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                --ENSURE THAT E1 HAS BEEN CALLED BEFORE PROCEEDING:
-                WHILE E1'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                SELECT
-                     ACCEPT E1;
-                OR
-                     WHEN F1 =>
-                          ACCEPT E2;
-                OR
-                     ACCEPT E3 ( F2(1) );
-                OR
-                     DELAY F3 ( 1.0 ) * Impdef.One_Second;
-                END SELECT;
-           END T;
- 
-      BEGIN
- 
-           T.E1;
- 
-      END;
- 
-      IF NOT EXPR1_EVALUATED THEN
-           FAILED ("GUARD NOT EVALUATED");
-      END IF;
- 
-      IF NOT EXPR2_EVALUATED THEN
-           FAILED ("ENTRY FAMILY INDEX NOT EVALUATED");
-      END IF;
- 
-      IF NOT EXPR3_EVALUATED THEN
-           FAILED ("OPEN DELAY ALTERNATIVE EXPRESSION NOT EVALUATED");
-      END IF;
- 
-      RESULT;
- 
- END C97113A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97114a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97114a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97114a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97114a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- C97114A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK WHETHER A DELAY EXPRESSION FOLLOWING AN OPEN GUARD IS EVALUATED
- -- DIRECTLY AFTER THE GUARD OR ONLY AFTER ALL GUARDS HAVE BEEN
- -- EVALUATED, OR IN SOME MIXED ORDER SUCH THAT DELAY EXPRESSIONS ARE
- -- EVALUATED AFTER THEIR GUARDS ARE DETERMINED TO BE OPEN.
- 
- -- RM 5/10/82
- -- SPS 11/21/82
- -- JBG 10/24/83
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97114A IS
- 
- 
-      -- THE TASK WILL HAVE LAST PRIORITY ( PRIORITY'FIRST )
- 
-      EVAL_ORDER  :  STRING (1..6)       := ( 1..6 => '*' );
-      EVAL_ORD    :  STRING (1..6)       := ( 1..6 => '*' );
-      INDEX       :  INTEGER             := 0; 
-      DUMMY       :  INTEGER             := 0; 
- 
- 
-      FUNCTION F1 (X:INTEGER) RETURN INTEGER IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'F';    -- 123: FGH
-           EVAL_ORD   (INDEX) := 'G';    -- 123: GGG ( 'G' FOR 'GUARD' )
-           RETURN ( IDENT_INT(7) ); 
-      END F1; 
- 
- 
-      FUNCTION F2 (X:INTEGER) RETURN INTEGER IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'G'; 
-           EVAL_ORD   (INDEX) := 'G'; 
-           RETURN ( IDENT_INT(7) ); 
-      END F2; 
- 
- 
-      FUNCTION F3 (X:INTEGER) RETURN INTEGER IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'H'; 
-           EVAL_ORD   (INDEX) := 'G'; 
-           RETURN ( IDENT_INT(7) ); 
-      END F3; 
- 
- 
-      FUNCTION  D1( X:INTEGER )  RETURN DURATION IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'A';    -- 123: ABC
-           EVAL_ORD   (INDEX) := 'D';    -- 123: DDD ( 'D' FOR 'DELAY' )
-           RETURN ( 1.0 );
-      END D1; 
- 
- 
-      FUNCTION  D2( X:INTEGER )  RETURN DURATION IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'B'; 
-           EVAL_ORD   (INDEX) := 'D'; 
-           RETURN ( 2.0 );
-      END D2; 
- 
- 
-      FUNCTION  D3( X:INTEGER )  RETURN DURATION IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'C'; 
-           EVAL_ORD   (INDEX) := 'D'; 
-           RETURN ( 3.0 );
-      END D3; 
- 
-      FUNCTION POS_OF (FUNC : CHARACTER) RETURN INTEGER  IS
-      BEGIN
-           FOR I IN EVAL_ORDER'RANGE LOOP
-                IF EVAL_ORDER(I) = FUNC THEN
-                     RETURN I;
-                END IF;
-           END LOOP;
-           FAILED ("DID NOT FIND LETTER " & FUNC);
-           RETURN 0;
-      END POS_OF;
- 
- BEGIN
- 
- 
-      TEST ("C97114A", "CHECK THAT THE DELAY EXPRESSIONS ARE" &
-                       " EVALUATED AFTER THE GUARDS BUT"      &
-                       " BEFORE THE RENDEZVOUS IS ATTEMPTED"  );
- 
- 
-      DECLARE
-  
- 
-           TASK T IS
- 
- 
-                ENTRY E1; 
- 
-           END T; 
- 
- 
-           TASK BODY T IS
-           BEGIN
- 
- 
-                WHILE  E1'COUNT = 0  -- IF  E1  NOT YET CALLED, THEN GIVE
-                LOOP                 --     THE MAIN TASK AN OPPORTUNITY
-                     DELAY  10.01 * Impdef.One_Second;   --     TO ISSUE THE CALL.
-                END LOOP;
- 
- 
-                SELECT               
- 
-                          ACCEPT  E1; 
- 
-                OR
- 
-                     WHEN  6 + F1(7) = 13  =>
-                          DELAY  D1( DUMMY ) * Impdef.One_Second;
- 
-                OR
- 
-                     WHEN  6 + F2(7) = 13  =>
-                          DELAY  D2( DUMMY ) * Impdef.One_Second;
- 
-                OR
- 
-                     WHEN  6 + F3(7) = 13  =>
-                          DELAY  D3( DUMMY ) * Impdef.One_Second;
- 
-                END SELECT;
- 
- 
-           END T; 
- 
- 
-      BEGIN
- 
-           T.E1; 
- 
-      END; -- END OF BLOCK CONTAINING THE ENTRY CALLS
- 
- 
-      COMMENT ("EVALUATIONS WERE DONE IN THE ORDER " & EVAL_ORD);
-      COMMENT ("FUNCTIONS WERE CALLED IN THE ORDER " & EVAL_ORDER);
- 
-      IF EVAL_ORD = "GGGDDD" THEN
-           COMMENT ("ALL GUARDS EVALUATED FIRST");
-      ELSIF EVAL_ORD = "GDGDGD" THEN
-           COMMENT ("DELAY EXPRESSION EVALUATED AFTER EACH GUARD");
-      END IF;
- 
- -- CHECK THAT GUARDS ARE ALWAYS EVALUATED BEFORE DELAY EXPRESSIONS
- 
-      IF   POS_OF ('F') > POS_OF ('A') OR
-           POS_OF ('G') > POS_OF ('B') OR
-           POS_OF ('H') > POS_OF ('C') THEN
-                FAILED ("A DELAY EXPRESSION WAS EVALUATED BEFORE ITS " &
-                        "GUARD");
-      END IF;
- 
- 
-      RESULT;
- 
- 
- END  C97114A;  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97115a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97115a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97115a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97115a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,189 ****
- -- C97115A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK WHETHER AN ENTRY FAMILY INDEX EXPRESSION FOLLOWING AN OPEN
- -- GUARD IS EVALUATED DIRECTLY AFTER THE GUARD, OR ONLY AFTER ALL GUARDS
- -- HAVE BEEN EVALUATED, OR IN SOME MIXED ORDER SUCH THAT INDEX
- -- EXPRESSIONS ARE EVALUATED AFTER THEIR GUARDS ARE DETERMINED TO BE
- -- OPEN. 
- 
- -- RM 5/11/82
- -- SPS 11/21/82
- -- JBG 10/24/83
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97115A IS
- 
- 
-      -- THE TASK WILL HAVE LAST PRIORITY ( PRIORITY'FIRST )
- 
-      EVAL_ORDER  :  STRING (1..6)       := ( 1..6 => '*' );
-      EVAL_ORD    :  STRING (1..6)       := ( 1..6 => '*' );
-      INDEX       :  INTEGER             := 0; 
- 
- 
-      FUNCTION F1 (X:INTEGER) RETURN INTEGER IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'F';    -- 123: FGH
-           EVAL_ORD   (INDEX) := 'G';    -- 123: GGG ( 'G' FOR 'GUARD' )
-           RETURN ( IDENT_INT(7) ); 
-      END F1; 
- 
- 
-      FUNCTION F2 (X:INTEGER) RETURN INTEGER IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'G'; 
-           EVAL_ORD   (INDEX) := 'G'; 
-           RETURN ( IDENT_INT(7) ); 
-      END F2; 
- 
- 
-      FUNCTION F3 (X:INTEGER) RETURN INTEGER IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'H'; 
-           EVAL_ORD   (INDEX) := 'G'; 
-           RETURN ( IDENT_INT(7) ); 
-      END F3; 
- 
- 
-      FUNCTION  I1 ( X:INTEGER )  RETURN BOOLEAN  IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'A';  -- 123: ABC
-           EVAL_ORD   (INDEX) := 'I';  -- 123: III ( 'I' FOR 'INDEX' )
-           RETURN ( IDENT_BOOL(TRUE) );    -- (THAT'S ENTRY-FAMILY INDEX)
-      END I1; 
- 
- 
-      FUNCTION  I2 ( X:INTEGER )  RETURN BOOLEAN  IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'B'; 
-           EVAL_ORD   (INDEX) := 'I'; 
-           RETURN ( IDENT_BOOL(TRUE) );
-      END I2; 
- 
- 
-      FUNCTION  I3 ( X:INTEGER )  RETURN BOOLEAN  IS
-      BEGIN
-           INDEX := INDEX + 1; 
-           EVAL_ORDER (INDEX) := 'C'; 
-           EVAL_ORD   (INDEX) := 'I'; 
-           RETURN ( IDENT_BOOL(TRUE) );
-      END I3; 
- 
-      FUNCTION POS_OF (FUNC : CHARACTER) RETURN INTEGER  IS
-      BEGIN
-           FOR I IN EVAL_ORDER'RANGE LOOP
-                IF EVAL_ORDER(I) = FUNC THEN
-                     RETURN I;
-                END IF;
-           END LOOP;
-           FAILED ("DID NOT FIND LETTER " & FUNC);
-           RETURN 0;
-      END POS_OF;
- 
- 
- BEGIN
- 
- 
-      TEST ("C97115A", "CHECK THAT THE INDEX EXPRESSIONS ARE" &
-                       " EVALUATED AFTER THE GUARDS BUT"      &
-                       " BEFORE THE RENDEZVOUS IS ATTEMPTED"  );
- 
- 
-      DECLARE
-  
- 
-           TASK T IS
- 
- 
-                ENTRY E ( BOOLEAN );
-                ENTRY E1; 
- 
-           END T; 
- 
- 
-           TASK BODY T IS
-           BEGIN
- 
- 
-                WHILE  E1'COUNT = 0  -- IF  E1  NOT YET CALLED, THEN GIVE
-                LOOP                 --     THE MAIN TASK AN OPPORTUNITY
-                     DELAY  10.01 * Impdef.One_Second;   --     TO ISSUE THE CALL.
-                END LOOP;
- 
- 
-                SELECT               
- 
-                          ACCEPT  E1; 
- 
-                OR
- 
-                     WHEN  6 + F1(7) = 13  =>
-                          ACCEPT  E ( I1(17) );
- 
-                OR
- 
-                     WHEN  6 + F2(7) = 13  =>
-                          ACCEPT  E ( I2(17) );
- 
-                OR
- 
-                     WHEN  6 + F3(7) = 13  =>
-                          ACCEPT  E ( I3(17) );
- 
-                END SELECT;
- 
- 
-           END T; 
- 
- 
-      BEGIN
- 
-           T.E1; 
- 
-      END; -- END OF BLOCK CONTAINING THE ENTRY CALLS
- 
- 
-      COMMENT ("GUARD AND INDEX FUNCTIONS WERE CALLED IN ORDER " & 
-                EVAL_ORDER);
-      COMMENT ("GUARD AND INDEX EXPRESSIONS WERE EVALUATED IN THE " &
-               "ORDER " & EVAL_ORD);
- 
-      IF POS_OF ('F') > POS_OF ('A') OR
-         POS_OF ('G') > POS_OF ('B') OR
-         POS_OF ('H') > POS_OF ('C') THEN
-           FAILED ("AN INDEX EXPRESSION WAS EVALUATED TOO EARLY");
-      END IF;
- 
-      RESULT;
- 
- END  C97115A;  
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97116a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97116a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97116a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97116a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C97116A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE GUARD CONDITIONS IN A SELECTIVE WAIT STATEMENT
- --     ARE NOT RE-EVALUATED DURING THE WAIT.
- 
- -- HISTORY:
- --     WRG 7/10/86  CREATED ORIGINAL TEST.
- --     RJW 5/15/90  REMOVED SHARED VARIABLES.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97116A IS
- 
-      GUARD_EVALUATIONS : NATURAL := 0;
- 
-      FUNCTION GUARD RETURN BOOLEAN IS
-      BEGIN
-           GUARD_EVALUATIONS := GUARD_EVALUATIONS + 1;
-           RETURN FALSE;
-      END GUARD;
- 
-      FUNCTION SO_LONG RETURN DURATION IS
-      BEGIN
-           RETURN 20.0;
-      END SO_LONG;
- 
- BEGIN
- 
-      TEST ("C97116A", "CHECK THAT THE GUARD CONDITIONS IN A " &
-                       "SELECTIVE WAIT STATEMENT ARE NOT RE-EVALUATED " &
-                       "DURING THE WAIT");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                SELECT
-                     ACCEPT E;
-                     FAILED ("ACCEPTED NONEXISTENT CALL TO E");
-                OR WHEN GUARD     =>
-                     DELAY 0.0;
-                     FAILED ("EXECUTED ALTERNATIVE CLOSED BY FALSE " &
-                             "GUARD FUNCTION" );
-                OR
-                     DELAY SO_LONG * Impdef.One_Second;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED");
-           END T;
- 
-           TASK GET_CPU;
- 
-           TASK BODY GET_CPU IS
-           BEGIN
-                WHILE NOT T'TERMINATED LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-           END GET_CPU;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      IF GUARD_EVALUATIONS /= 1 THEN
-           FAILED ("GUARD EVALUATED" &
-                   NATURAL'IMAGE(GUARD_EVALUATIONS) & " TIMES");
-      END IF;
- 
-      RESULT;
- 
- END C97116A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97117a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97117a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97117a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97117a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- C97117A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PROGRAM_ERROR IS RAISED IF ALL ALTERNATIVES ARE CLOSED AND
- -- NO ELSE PART IS PRESENT.
- 
- -- WRG 7/10/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97117A IS
- 
- BEGIN
- 
-      TEST ("C97117A", "CHECK THAT PROGRAM_ERROR IS RAISED IF ALL " &
-                       "ALTERNATIVES ARE CLOSED AND NO ELSE PART IS " &
-                       "PRESENT");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                SELECT
-                     WHEN IDENT_BOOL (FALSE) =>
-                          ACCEPT E;
-                          FAILED ("CLOSED ACCEPT ALTERNATIVE TAKEN " &
-                                  "FOR NONEXISTENT ENTRY CALL");
-                OR   WHEN IDENT_BOOL (FALSE) =>
-                          DELAY 0.0;
-                          FAILED ("CLOSED ALTERNATIVE TAKEN");
-                END SELECT;
-                FAILED ("PROGRAM_ERROR NOT RAISED");
-           EXCEPTION
-                WHEN PROGRAM_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END T;
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END C97117A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97117b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97117b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97117b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97117b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- C97117B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ELSE PART IS EXECUTED IF ALL ALTERNATIVES ARE CLOSED OR
- -- IF THERE ARE NO TASKS QUEUED FOR OPEN ALTERNATIVES.
- 
- -- WRG 7/10/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97117B IS
- 
- BEGIN
- 
-      TEST ("C97117B", "CHECK THAT AN ELSE PART IS EXECUTED IF ALL " &
-                       "ALTERNATIVES ARE CLOSED OR IF THERE ARE NO " &
-                       "TASKS QUEUED FOR OPEN ALTERNATIVES");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY NO_GO;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                -- ENSURE THAT NO_GO HAS BEEN CALLED BEFORE PROCEEDING:
-                WHILE NO_GO'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                SELECT
-                     WHEN IDENT_BOOL (FALSE) =>
-                          ACCEPT E;
-                          FAILED ("CLOSED ACCEPT ALTERNATIVE TAKEN " &
-                                  "FOR NONEXISTENT ENTRY CALL - 1");
-                OR
-                     WHEN IDENT_BOOL (FALSE) =>
-                          ACCEPT NO_GO;
-                          FAILED ("CLOSED ALTERNATIVE TAKEN - 1");
-                ELSE
-                     COMMENT ("ELSE PART EXECUTED - 1");
-                END SELECT;
- 
-                SELECT
-                     ACCEPT E;
-                     FAILED ("ACCEPTED NONEXISTENT ENTRY CALL - 2");
-                OR WHEN IDENT_BOOL (FALSE) =>
-                     ACCEPT NO_GO;
-                     FAILED ("CLOSED ALTERNATIVE TAKEN - 2");
-                ELSE
-                     COMMENT ("ELSE PART EXECUTED - 2");
-                END SELECT;
- 
-                ACCEPT NO_GO;
-           END T;
- 
-      BEGIN
- 
-           T.NO_GO;
- 
-      END;
- 
-      RESULT;
- 
- END C97117B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97117c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97117c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97117c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97117c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- C97117C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN ELSE PART IS NOT EXECUTED IF A TASK IS QUEUED AT AN
- -- OPEN ALTERNATIVE.
- 
- -- WRG 7/10/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97117C IS
- 
- BEGIN
- 
-      TEST ("C97117C", "CHECK THAT AN ELSE PART IS NOT EXECUTED IF A " &
-                       "TASK IS QUEUED AT AN OPEN ALTERNATIVE");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY NO_GO;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                --ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
-                WHILE E'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                SELECT
-                     ACCEPT NO_GO;
-                     FAILED ("ACCEPTED NONEXISTENT ENTRY CALL");
-                OR WHEN IDENT_BOOL (TRUE)  =>
-                     ACCEPT E;
-                OR WHEN IDENT_BOOL (FALSE) =>
-                     ACCEPT E;
-                     FAILED ("CLOSED ALTERNATIVE TAKEN");
-                ELSE
-                     FAILED ("ELSE PART EXECUTED");
-                END SELECT;
-           END T;
- 
-      BEGIN
- 
-           T.E;
- 
-      END;
- 
-      RESULT;
- 
- END C97117C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97118a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97118a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97118a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97118a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- C97118A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CALL TO A CLOSED ALTERNATIVE OF A SELECTIVE WAIT IS NOT
- -- ACCEPTED.
- 
- -- WRG 7/11/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97118A IS
- 
- BEGIN
- 
-      TEST ("C97118A", "CHECK THAT A CALL TO A CLOSED ALTERNATIVE OF " &
-                       "A SELECTIVE WAIT IS NOT ACCEPTED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                -- ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
-                WHILE E'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                SELECT
-                     WHEN IDENT_BOOL (FALSE) =>
-                          ACCEPT E;
-                          FAILED ("ACCEPTED CALL TO CLOSED ALTERNATIVE");
-                     ELSE
-                          NULL;
-                END SELECT;
- 
-                IF E'COUNT = 1 THEN
-                     ACCEPT E;
-                END IF;
-           END T;
- 
-      BEGIN
- 
-           T.E;
- 
-      END;
- 
-      RESULT;
- 
- END C97118A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97120a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97120a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97120a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97120a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- C97120A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SELECTIVE WAIT DELAYS AT LEAST AS LONG AS IS SPECIFIED
- -- IN A DELAY ALTERNATIVE.
- 
- -- WRG 7/11/86
- 
- with Impdef;
- WITH REPORT;   USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97120A IS
- 
- BEGIN
- 
-      TEST ("C97120A", "CHECK THAT A SELECTIVE WAIT DELAYS AT LEAST " &
-                       "AS LONG AS IS SPECIFIED IN A DELAY ALTERNATIVE");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY NO_GO;
-                ENTRY SYNCH;
-           END T;
- 
-           TASK BODY T IS
-                BEFORE, AFTER : TIME;
-           BEGIN
-                -- ENSURE THAT SYNCH HAS BEEN CALLED BEFORE PROCEEDING:
-                WHILE SYNCH'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                BEFORE := CLOCK;
-                SELECT
-                     ACCEPT NO_GO;
-                     FAILED ("ACCEPTED NONEXISTENT ENTRY CALL");
-                OR
-                     DELAY 10.0 * Impdef.One_Second;
-                     AFTER := CLOCK;
-                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
-                          FAILED ("INSUFFICIENT DELAY");
-                     END IF;
-                END SELECT;
- 
-                ACCEPT SYNCH;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED");
-           END T;
- 
-      BEGIN
- 
-           T.SYNCH;  -- SUSPEND MAIN TASK BEFORE READING CLOCK.
- 
-      END;
- 
-      RESULT;
- 
- END C97120A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97120b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97120b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97120b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97120b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- C97120B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A SPECIFIED DELAY IS ZERO OR NEGATIVE AND AN ENTRY CALL
- -- IS WAITING AT AN OPEN ALTERNATIVE WHEN THE SELECTIVE WAIT IS
- -- EXECUTED, THE CALL IS ACCEPTED.
- 
- -- WRG 7/11/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97120B IS
- 
-      ZERO, NEG : DURATION := 1.0;
- 
- BEGIN
- 
-      TEST ("C97120B", "CHECK THAT IF A SPECIFIED DELAY IS ZERO OR " &
-                       "NEGATIVE AND AN ENTRY CALL IS WAITING AT AN " &
-                       "OPEN ALTERNATIVE WHEN THE SELECTIVE WAIT IS " &
-                       "EXECUTED, THE CALL IS ACCEPTED");
- 
-      IF EQUAL (3, 3) THEN
-           ZERO :=  0.0;
-           NEG  := -1.0;
-      END IF;
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                WHILE E'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-             A: BEGIN
-                     SELECT
-                          WHEN IDENT_BOOL (TRUE) =>
-                               ACCEPT E;
-                     OR
-                          DELAY ZERO * Impdef.One_Second;
-                          FAILED ("ZERO DELAY ALTERNATIVE TAKEN");
-                          ACCEPT E;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED (A)");
-                END A;
- 
-                WHILE E'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-             B: BEGIN
-                     SELECT
-                          ACCEPT E;
-                     OR
-                          DELAY NEG;
-                          FAILED ("NEGATIVE DELAY ALTERNATIVE TAKEN");
-                          ACCEPT E;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED (B)");
-                END B;
- 
-           END T;
- 
-      BEGIN
- 
-           T.E;
-           T.E;
- 
-      END;
- 
-      RESULT;
- 
- END C97120B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- C97201A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
- --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
- 
- -- CASE  A:  THE TASK TO BE CALLED IS NOT YET ACTIVE AS OF THE
- --     MOMENT OF CALL (CONDITIONAL_ENTRY_CALL),
- --     AND THIS FACT CAN BE DETERMINED STATICALLY.
- 
- 
- -- RM 4/20/82
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97201A IS
- 
-      ELSE_BRANCH_TAKEN    :  INTEGER  :=  3 ;
- 
- BEGIN
- 
- 
-      TEST ("C97201A", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
-                       " A CONDITIONAL_ENTRY_CALL CAN OCCUR  WHILE" &
-                       " THE CALLED TASK IS NOT YET ACTIVE"         );
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_ORELSE ( AUTHORIZED : IN BOOLEAN ) ;
-           END  T ;
- 
- 
-           TASK BODY  T  IS
- 
-                PACKAGE       SECOND_ATTEMPT  IS    END  SECOND_ATTEMPT ;
-                PACKAGE BODY  SECOND_ATTEMPT  IS
-                BEGIN
- 
-                     SELECT
-                          DO_IT_NOW_ORELSE (FALSE) ;--CALLING (OWN) ENTRY
-                     ELSE    -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
-                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
-                          ELSE_BRANCH_TAKEN := 2 * ELSE_BRANCH_TAKEN ;
-                          COMMENT( "ELSE_BRANCH  TAKEN  (#2)" );
-                     END SELECT;
- 
-                END  SECOND_ATTEMPT ;
- 
-           BEGIN
- 
-                ACCEPT DO_IT_NOW_ORELSE ( AUTHORIZED : IN BOOLEAN )  DO
- 
-                     IF  AUTHORIZED  THEN
-                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
-                     ELSE
-                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
-                     END IF;
- 
-                END DO_IT_NOW_ORELSE ;
- 
- 
-           END  T ;
- 
- 
-           PACKAGE       FIRST_ATTEMPT  IS      END  FIRST_ATTEMPT ;
-           PACKAGE BODY  FIRST_ATTEMPT  IS
-           BEGIN
-                SELECT
-                     T.DO_IT_NOW_ORELSE (FALSE) ;
-                ELSE        -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
-                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
-                     ELSE_BRANCH_TAKEN := 1 + ELSE_BRANCH_TAKEN ;
-                     COMMENT( "ELSE_BRANCH  TAKEN  (#1)" );
-                END SELECT;
- 
-           END  FIRST_ATTEMPT ;
- 
- 
-      BEGIN
- 
-           T.DO_IT_NOW_ORELSE ( TRUE );   -- TO SATISFY THE SERVER'S
-                                           --     WAIT FOR SUCH A CALL
- 
-      EXCEPTION
- 
-           WHEN  TASKING_ERROR  =>
-                FAILED( "TASKING ERROR" );
- 
-      END  ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      -- BY NOW, THE TASK IS TERMINATED  (AND THE NONLOCALS UPDATED)
- 
- 
-      CASE  ELSE_BRANCH_TAKEN  IS
- 
-           WHEN  3  =>
-                FAILED( "NO 'ELSE'; BOTH (?) RENDEZVOUS ATTEMPTED?" );
- 
-           WHEN  4  =>
-                FAILED( "'ELSE' #1 ONLY; RENDEZVOUS (#2) ATTEMPTED?" );
- 
-           WHEN  6  =>
-                FAILED( "'ELSE' #2 ONLY; RENDEZVOUS (#1) ATTEMPTED?" );
- 
-           WHEN  7  =>
-                FAILED( "WRONG ORDER FOR 'ELSE':  #2,#1 " );
- 
-           WHEN  8  =>
-                NULL ;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG CASE_VALUE" );
- 
-      END CASE;
- 
- 
-      RESULT;
- 
- 
- END  C97201A ; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C97201B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CONDITIONAL ENTRY CALL IS NOT ACCEPTED IF THERE IS
- -- ANOTHER TASK QUEUED FOR THE ENTRY.
- 
- -- WRG 7/11/86
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97201B IS
- 
- 
- BEGIN
- 
-      TEST ("C97201B", "CHECK THAT A CONDITIONAL ENTRY CALL IS NOT " &
-                       "ACCEPTED IF THERE IS ANOTHER TASK QUEUED " &
-                       "FOR THE ENTRY");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY SYNCH;
-                ENTRY DONE;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                -- ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
-                WHILE E'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
- 
-                ACCEPT SYNCH;
- 
-                SELECT
-                     WHEN IDENT_BOOL (FALSE) =>
-                          ACCEPT E;
-                          FAILED ("CLOSED ALTERNATIVE TAKEN");
-                OR
-                     ACCEPT DONE DO
-                          IF E'COUNT /= 1 THEN
-                               FAILED (NATURAL'IMAGE(E'COUNT) &
-                                       " CALLS WERE QUEUED FOR ENTRY " &
-                                       "E OF TASK T");
-                          END IF;
-                     END DONE;
-                OR
-                     DELAY 1000.0 * Impdef.One_Second;
-                     FAILED ("DELAY EXPIRED; E'COUNT =" &
-                             NATURAL'IMAGE(E'COUNT) );
-                END SELECT;
- 
-                WHILE E'COUNT > 0 LOOP
-                     ACCEPT E;
-                END LOOP;
-           END T;
- 
-           TASK AGENT;
- 
-           TASK BODY AGENT IS
-           BEGIN
-                T.E;
-           END AGENT;
- 
-      BEGIN
- 
-           T.SYNCH;
- 
-           DELAY 10.0 * Impdef.One_Second;
- 
-           SELECT
-                T.E;
-                FAILED ("CONDITIONAL ENTRY CALL ACCEPTED" );
-           ELSE
-                COMMENT ("ELSE PART EXECUTED");
-                T.DONE;
-           END SELECT;
- 
-      END;
- 
-      RESULT;
- 
- END C97201B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- C97201C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CONDITIONAL ENTRY CALL IS NOT ACCEPTED IF AN ACCEPT
- -- STATEMENT FOR THE CALLED ENTRY HAS NOT YET BEEN REACHED.
- 
- -- WRG 7/11/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97201C IS
- 
- BEGIN
- 
-      TEST ("C97201C", "CHECK THAT A CONDITIONAL ENTRY CALL IS NOT " &
-                       "ACCEPTED IF AN ACCEPT STATEMENT FOR THE " &
-                       "CALLED ENTRY HAS NOT YET BEEN REACHED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY BARRIER;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT BARRIER;
-                IF E'COUNT > 0 THEN
-                     FAILED ("ENTRY CALL WAS QUEUED");
-                     ACCEPT E;
-                END IF;
-           END T;
- 
-      BEGIN
- 
-           SELECT
-                T.E;
-                FAILED ("CONDITIONAL ENTRY CALL ACCEPTED");
-           ELSE
-                COMMENT ("ELSE PART EXECUTED");
-           END SELECT;
- 
-           T.BARRIER;
- 
-      END;
- 
-      RESULT;
- 
- END C97201C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C97201D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
- --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
- 
- -- CASE  D:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
- --     DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
- --     AND THIS FACT IS DETERMINED STATICALLY.
- 
- 
- -- RM 4/12/82
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97201D IS
- 
-      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
- 
- BEGIN
- 
- 
-      TEST ("C97201D", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
-                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
-                       " IN THE ABSENCE OF A CORRESPONDING "        &
-                       " ACCEPT_STATEMENT "                         );
- 
- 
-      DECLARE
- 
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_ORELSE ;
-                ENTRY  KEEP_ALIVE ;
-           END  T ;
-           
- 
-           TASK BODY  T  IS
-           BEGIN
- 
-                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED
- 
-                ACCEPT  KEEP_ALIVE ;  -- TO PREVENT THIS SERVER TASK FROM
-                                      --     TERMINATING IF
-                                      --     UPON ACTIVATION
-                                      --     IT GETS TO RUN    
-                                      --     AHEAD OF THE CALLER (WHICH
-                                      --     WOULD LEAD TO A SUBSEQUENT
-                                      --     TASKING_ERROR AT THE TIME OF
-                                      --     THE NO-WAIT CALL).
- 
-           END ;
- 
- 
-      BEGIN
- 
-           SELECT
-                T.DO_IT_NOW_ORELSE ;
-           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
-                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
-                ELSE_BRANCH_TAKEN := TRUE ;
-                COMMENT( "ELSE_BRANCH  TAKEN" );
-           END SELECT;
- 
-           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
- 
-      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
- 
- 
-      -- BY NOW, THE TASK IS TERMINATED
- 
-      IF  ELSE_BRANCH_TAKEN  THEN
-           NULL ;
-      ELSE
-           FAILED( "RENDEZVOUS ATTEMPTED?" );
-      END IF;
- 
-      RESULT;
- 
- 
- END  C97201D ; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- C97201E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
- --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
- 
- -- CASE  E:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
- --     DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
- --     AND THIS FACT CAN NOT BE DETERMINED STATICALLY.
- --     (THE ENTRY BELONGS TO AN ENTRY FAMILY; SOME FAMILY MEMBERS
- --     ARE "ACCEPTABLE", BUT NOT THE CALLED ONE.)
- 
- 
- -- RM 4/13/82
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97201E IS
- 
-      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
- 
- BEGIN
- 
- 
-      TEST ("C97201E", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
-                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
-                       " IN THE ABSENCE OF A CORRESPONDING "        &
-                       " ACCEPT_STATEMENT "                         );
- 
- 
-      DECLARE
- 
-           SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
- 
-           KEEP_ALIVE  :  INTEGER  := 15 ;
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_ORELSE ( SHORT ) ;
-           END  T ;
-           
- 
-           TASK BODY  T  IS
-           BEGIN
- 
-                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED
-                ACCEPT  DO_IT_NOW_ORELSE ( IDENT_INT(15) );
- 
-                                      -- THIS ALSO PREVENTS THIS SERVER
-                                      --     TASK FROM TERMINATING IF
-                                      --     UPON ACTIVATION
-                                      --     IT GETS TO RUN    
-                                      --     AHEAD OF THE CALLER (WHICH
-                                      --     WOULD LEAD TO A SUBSEQUENT
-                                      --     TASKING_ERROR AT THE TIME OF
-                                      --     THE NO-WAIT CALL).
- 
-           END ;
- 
- 
-      BEGIN
- 
-           SELECT
-                T.DO_IT_NOW_ORELSE (10) ;  -- ACCEPT_STATEMENT HAS  15
-           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
-                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
-                ELSE_BRANCH_TAKEN := TRUE ;
-                COMMENT( "ELSE_BRANCH  TAKEN" );
-           END SELECT;
- 
-           T.DO_IT_NOW_ORELSE(KEEP_ALIVE) ;-- THIS ALSO UPDATES NONLOCALS
- 
-      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
- 
- 
-      -- BY NOW, THE TASK IS TERMINATED
- 
-      IF  ELSE_BRANCH_TAKEN  THEN
-           NULL ;
-      ELSE
-           FAILED( "RENDEZVOUS ATTEMPTED?" );
-      END IF;
- 
-      RESULT;
- 
- 
- END  C97201E ; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- C97201G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
- --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
- 
- -- CASE  G:  THE CORRESPONDING ACCEPT_STATEMENT IS CLOSED
- --     AND THIS FACT IS STATICALLY DETERMINABLE.
- 
- 
- -- RM 4/21/82
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97201G IS
- 
-      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
-      RENDEZVOUS_OCCURRED  :  BOOLEAN  :=  FALSE ;
-      QUEUE_NOT_EMPTY      :  BOOLEAN  :=  FALSE ;
-      X                    :  INTEGER  :=  17 ;
- 
- BEGIN
- 
- 
-      TEST ("C97201G", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
-                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
-                       " IF THE CORRESPONDING ACCEPT_STATEMENT IS"  &
-                       " CLOSED"                                    );
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
-                ENTRY  KEEP_ALIVE ;
-           END  T ;
-           
- 
-           TASK BODY  T  IS
-           BEGIN
- 
-                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
-                     QUEUE_NOT_EMPTY := TRUE ;
-                END IF;
- 
- 
-                SELECT
-                     WHEN  3 = 5  =>
-                          ACCEPT  DO_IT_NOW_ORELSE
-                                       ( DID_YOU_DO_IT : IN OUT BOOLEAN)
-                          DO
-                               DID_YOU_DO_IT := TRUE ;
-                          END;
-                OR
-                          ACCEPT  KEEP_ALIVE ; -- TO PREVENT SELECT_ERROR
-                END SELECT;
- 
- 
-                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
-                     QUEUE_NOT_EMPTY := TRUE ;
-                END IF;
- 
- 
-           END  T ;
- 
- 
-      BEGIN
- 
-           COMMENT( "PERMANENTLY CLOSED" );
- 
-           SELECT
-                T.DO_IT_NOW_ORELSE( RENDEZVOUS_OCCURRED );
-           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
-                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
-                ELSE_BRANCH_TAKEN := TRUE ;
-                COMMENT( "ELSE_BRANCH  TAKEN" );
-           END SELECT;
- 
-           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
- 
-      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      -- BY NOW, THE TASK IS TERMINATED
- 
-      IF  RENDEZVOUS_OCCURRED
-      THEN
-           FAILED( "RENDEZVOUS OCCURRED" );
-      END IF;
- 
-      IF  QUEUE_NOT_EMPTY
-      THEN
-           FAILED( "ENTRY QUEUE NOT EMPTY" );
-      END IF;
- 
-      IF  ELSE_BRANCH_TAKEN  THEN
-           NULL ;
-      ELSE
-           FAILED( "RENDEZVOUS ATTEMPTED?" );
-      END IF;
- 
-      RESULT;
- 
- 
- END  C97201G ; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- C97201H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
- --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
- 
- -- CASE  H:  THE CORRESPONDING ACCEPT_STATEMENT IS CLOSED
- --     AND THIS FACT IS NOT STATICALLY DETERMINABLE.
- 
- 
- -- RM 4/22/82
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97201H IS
- 
-      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
-      RENDEZVOUS_OCCURRED  :  BOOLEAN  :=  FALSE ;
-      QUEUE_NOT_EMPTY      :  BOOLEAN  :=  FALSE ;
-      X                    :  INTEGER  :=  17 ;
- 
- BEGIN
- 
- 
-      TEST ("C97201H", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
-                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
-                       " IF THE CORRESPONDING ACCEPT_STATEMENT IS"  &
-                       " CLOSED"                                    );
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
-                ENTRY  KEEP_ALIVE ;
-           END  T ;
-           
- 
-           TASK BODY  T  IS
-           BEGIN
- 
-                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
-                     QUEUE_NOT_EMPTY := TRUE ;
-                END IF;
- 
- 
-                SELECT
-                     WHEN  3 = IDENT_INT(5)  =>
-                          ACCEPT  DO_IT_NOW_ORELSE
-                                       ( DID_YOU_DO_IT : IN OUT BOOLEAN)
-                          DO
-                               DID_YOU_DO_IT := TRUE ;
-                          END;
-                OR
-                          ACCEPT  KEEP_ALIVE ; -- TO PREVENT SELECT_ERROR
-                END SELECT;
- 
- 
-                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
-                     QUEUE_NOT_EMPTY := TRUE ;
-                END IF;
- 
- 
-           END  T ;
- 
- 
-      BEGIN
- 
-           COMMENT( "PERMANENTLY CLOSED" );
- 
-           SELECT
-                T.DO_IT_NOW_ORELSE( RENDEZVOUS_OCCURRED );
-           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
-                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
-                ELSE_BRANCH_TAKEN := TRUE ;
-                COMMENT( "ELSE_BRANCH  TAKEN" );
-           END SELECT;
- 
-           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
- 
-      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      -- BY NOW, THE TASK IS TERMINATED
- 
-      IF  RENDEZVOUS_OCCURRED
-      THEN
-           FAILED( "RENDEZVOUS OCCURRED" );
-      END IF;
- 
-      IF  QUEUE_NOT_EMPTY
-      THEN
-           FAILED( "ENTRY QUEUE NOT EMPTY" );
-      END IF;
- 
-      IF  ELSE_BRANCH_TAKEN  THEN
-           NULL ;
-      ELSE
-           FAILED( "RENDEZVOUS ATTEMPTED?" );
-      END IF;
- 
-      RESULT;
- 
- 
- END  C97201H ; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201x.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97201x.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97201x.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- C97201X.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NO RENDEZVOUS CAN EVER OCCUR IF BOTH PARTNERS REFUSE TO
- --     WAIT (THAT IS, IF THE ENTRY CALL IS ISSUED BY A
- --     "CONDITIONAL_ENTRY_CALL" AND THUS FOLLOWS A NO-WAIT POLICY
- --     (DEMANDING UNCONDITIONALLY THAT "YOU DO IT   N O W  , OR ELSE"),
- --     WHILE THE CALLEE IS ALSO COMMITTED TO A NO-WAIT POLICY,
- --     BY VIRTUE OF A SELECTIVE_WAIT STATEMENT OF THE THIRD KIND
- --     (WITH AN "ELSE" PART) IN WHICH THE CORRESPONDING ACCEPT_STATEMENT
- --     IS EMBEDDED).
- --     ("CLOSE ENCOUNTERS OF THE THIRD KIND"  --  ARE THEY POSSIBLE?)
- 
- 
- -- THE SEMANTICS OF THIS ENTRY CALL REQUIRES THAT THE CALLING TASK
- --     N O T   ENTER ITSELF ON ANY QUEUE BUT RATHER ATTEMPT AN IMMEDIATE
- --     RENDEZVOUS WHICH IS TO TAKE PLACE IF AND ONLY IF THE CALLED TASK
- --     HAS REACHED A POINT WHERE IT IS READY TO ACCEPT THE CALL (I.E.
- --     IT IS EITHER WAITING AT AN ACCEPT STATEMENT FOR THE CORRESPONDING
- --     ENTRY OR IT IS WAITING AT A SELECTIVE_WAIT STATEMENT WITH AN OPEN
- --     ALTERNATIVE STARTING WITH SUCH AN ACCEPT STATEMENT).  IT ALSO
- --     REQUIRES THAT THE ENTRY CALL BE CANCELLED IF THE CALLED TASK 
- --     IS NOT AT SUCH A POINT.  ON THE OTHER HAND, THE SEMANTICS OF THE
- --     SELECTIVE_WAIT STATEMENT WITH AN  'ELSE'  PART  SPECIFIES THAT
- --     THE  'ELSE'  PART  MUST BE SELECTED IF NO 'ACCEPT' ALTERNATIVE
- --     CAN BE IMMEDIATELY SELECTED,  AND THAT SUCH AN ALTERNATIVE
- --     IS DEEMED TO BE IMMEDIATELY SELECTABLE ("SELECTION OF ONE SUCH
- --     ALTERNATIVE OCCURS IMMEDIATELY"), AND A CORRESPONDING RENDEZVOUS
- --     POSSIBLE,  IF AND ONLY IF THERE IS A CORRESPONDING ENTRY CALL
- --     W A I T I N G   TO BE ACCCEPTED.  A "CONDITIONAL ENTRY CALL"
- --     NEVER WAITS, AND IS NEVER ENTERED IN WAIT QUEUES; IT TAKES
- --     THE 'ELSE' PART INSTEAD.
- 
- 
- -- NOTE: IF THIS TEST PROGRAM HANGS UP, THE COMPILER WILL BE DEEMED
- --     TO HAVE FAILED.
- 
- 
- -- RM 3/19/82
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97201X IS
- 
-      RENDEZVOUS_OCCURRED        :  BOOLEAN  :=  FALSE ;
- 
-      CALLER_TAKES_WRONG_BRANCH  :  BOOLEAN  :=  TRUE  ;
-      SERVER_TAKES_WRONG_BRANCH  :  BOOLEAN  :=  TRUE  ;
-      QUEUE_NOT_EMPTY            :  BOOLEAN  :=  FALSE ;
- 
- BEGIN
- 
- 
-      TEST ("C97201X", "CHECK THAT NO RENDEZVOUS CAN EVER OCCUR IF" &
-                       " BOTH PARTNERS REFUSE TO WAIT" );
- 
- 
-      DECLARE
- 
- 
-           TASK  T  IS
-                ENTRY  SYNCHRONIZE ;
-                ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
-                ENTRY  KEEP_ALIVE  ;
-           END  T ;
-           
- 
-           TASK BODY  T  IS
-           BEGIN
- 
- 
-                ACCEPT  SYNCHRONIZE ;
- 
- 
-                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
-                     QUEUE_NOT_EMPTY := TRUE ;
-                END IF;
- 
- 
-                SELECT
-                          ACCEPT  DO_IT_NOW_ORELSE
-                                       ( DID_YOU_DO_IT : IN OUT BOOLEAN )
-                          DO
-                               DID_YOU_DO_IT  :=  TRUE ;
-                          END ;
-                ELSE         -- (I.E. TASK ADOPTS NO-WAIT POLICY)
-                             -- 'ELSE' BRANCH MUST THEREFORE BE CHOSEN
-                     SERVER_TAKES_WRONG_BRANCH := FALSE ;
-                END SELECT;
- 
- 
-                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
-                     QUEUE_NOT_EMPTY := TRUE ;
-                END IF;
- 
- 
-                ACCEPT  KEEP_ALIVE ;  -- TO PREVENT THIS SERVER TASK FROM
-                                      --     TERMINATING IF IT GETS TO
-                                      --     THE NO-WAIT MEETING-PLACE
-                                      --     AHEAD OF THE CALLER (WHICH
-                                      --     WOULD LEAD TO A SUBSEQUENT
-                                      --     TASKING_ERROR AT THE TIME OF
-                                      --     THE NO-WAIT CALL).
- 
- 
-           END  T ;
- 
- 
-      BEGIN
- 
- 
-           T.SYNCHRONIZE ;  -- TO MINIMIZE THE   N E E D   TO WAIT
- 
- 
-           SELECT
-                T.DO_IT_NOW_ORELSE ( RENDEZVOUS_OCCURRED );
-           ELSE              -- (I.E. CALLER TOO ADOPTS A NO-WAIT POLICY)
-                                     -- MUST THEREFORE CHOOSE THIS BRANCH
-                CALLER_TAKES_WRONG_BRANCH := FALSE ;
-           END SELECT;
- 
- 
-           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
- 
- 
-      END;   -- END OF BLOCK CONTAINING THE NO-WAIT ENTRY CALL
- 
- 
-      IF  RENDEZVOUS_OCCURRED
-      THEN
-           FAILED( "RENDEZVOUS OCCURRED" );
-      END IF;
- 
-      IF  CALLER_TAKES_WRONG_BRANCH  OR
-          SERVER_TAKES_WRONG_BRANCH
-      THEN
-           FAILED( "WRONG BRANCH TAKEN" );
-      END IF;
- 
-      IF  QUEUE_NOT_EMPTY
-      THEN
-           FAILED( "ENTRY QUEUE NOT EMPTY" );
-      END IF;
- 
- 
-      RESULT;
- 
- 
- END  C97201X ; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97202a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97202a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97202a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C97202A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE INDEX IS EVALUATED BEFORE THE ENTRY PARAMETER AND BOTH
- -- THE INDEX AND THE ENTRY PARAMETER ARE EVALUATED BEFORE THE RENDEZVOUS
- -- IS ATTEMPED.
- 
- -- RM 4/05/82
- -- TBN 2/3/86     ADDED A CHECK THAT INDEX IS EVALUATED BEFORE THE ENTRY
- --                PARAMETER AND FIXED APPROPRIATE COMMENTS.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97202A IS
- 
-      INDEX_COMPUTED   :  BOOLEAN  :=  FALSE ;
-      FORMAL_COMPUTED  :  BOOLEAN  :=  FALSE ;
- 
- BEGIN
- 
-      TEST ("C97202A", "CHECK THAT THE INDEX IS EVALUATED BEFORE THE " &
-                       "ENTRY PARAMETER AND BOTH INDEX AND THE ENTRY " &
-                       "PARAMETER ARE EVALUATED BEFORE THE RENDEZVOUS " &
-                       "IS ATTEMPTED");
- 
-      DECLARE
-           SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_ORELSE (SHORT)
-                                        (DID_YOU_DO_IT : IN BOOLEAN);
-                ENTRY  KEEP_ALIVE ;
-           END  T ;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  KEEP_ALIVE ;
-           END  T ;
- 
-           FUNCTION  F1 (X:INTEGER) RETURN INTEGER  IS
-           BEGIN
-                IF FORMAL_COMPUTED THEN
-                     FAILED ("INDEX WAS NOT EVALUATED FIRST");
-                END IF;
-                INDEX_COMPUTED  :=  TRUE ;
-                RETURN (7) ;
-           END  F1 ;
- 
-           FUNCTION  F2 (X:INTEGER) RETURN BOOLEAN  IS
-           BEGIN
-                FORMAL_COMPUTED  :=  TRUE ;
-                RETURN (FALSE) ;
-           END  F2 ;
- 
-      BEGIN
-           SELECT
-                T.DO_IT_NOW_ORELSE ( 6 + F1(7)  )
-                                   ( NOT(F2(7)) ) ;
-           ELSE
-                NULL ;
-           END SELECT;
- 
-           T.KEEP_ALIVE ;
-      END;   -- END OF BLOCK CONTAINING THE ENTRY CALLS.
- 
-      IF  INDEX_COMPUTED  THEN
-           NULL ;
-      ELSE
-           FAILED( "ENTRY INDEX WAS NOT COMPUTED" );
-      END IF;
- 
-      IF  FORMAL_COMPUTED  THEN
-           NULL ;
-      ELSE
-           FAILED( "ENTRY PARAMETER WAS NOT COMPUTED" );
-      END IF;
- 
-      RESULT;
- 
- END  C97202A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97203a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97203a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97203a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- C97203A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CONDITIONAL_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
- --     SELECTIVE_WAIT  CANNOT.
- 
- -- PART 1: PACKAGE BODY EMBEDDED IN TASK BODY.
- 
- 
- -- RM 4/01/1982
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE  C97203A  IS
- 
- 
- BEGIN
- 
- 
-      TEST ( "C97203A" , "CHECK THAT A  CONDITIONAL_ENTRY_CALL  CAN" &
-                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK  TT  IS
-                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
-           END  TT ;
- 
- 
-           TASK BODY  TT  IS
- 
- 
-                PACKAGE  WITHIN_TASK_BODY  IS
-                     -- NOTHING HERE
-                END  WITHIN_TASK_BODY ;
- 
- 
-                PACKAGE BODY  WITHIN_TASK_BODY  IS
-                BEGIN
- 
-                     SELECT  -- NOT A SELECTIVE_WAIT
-                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
-                     ELSE 
-                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
-                     END SELECT;
-                     
-                END  WITHIN_TASK_BODY ;
- 
- 
-           BEGIN
- 
-                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
- 
-                     IF  AUTHORIZED  THEN
-                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
-                     ELSE
-                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
-                     END IF;
- 
-                END  A ;
- 
-           END  TT ;
- 
- 
-           PACKAGE  OUTSIDE_TASK_BODY  IS
-                -- NOTHING HERE
-           END  OUTSIDE_TASK_BODY ;
- 
- 
-           PACKAGE BODY  OUTSIDE_TASK_BODY  IS
-           BEGIN
- 
-                SELECT  -- NOT A SELECTIVE_WAIT
-                     TT.A ( FALSE ) ;  -- UNBORN
-                ELSE 
-                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
-                END SELECT;
- 
-           END  OUTSIDE_TASK_BODY ;
- 
- 
-      BEGIN
- 
-           TT.A ( TRUE );
- 
-      EXCEPTION
- 
-           WHEN  TASKING_ERROR  =>
-                FAILED( "TASKING ERROR" );
- 
-      END  ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT ;
- 
- 
- END  C97203A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97203b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97203b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97203b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,131 ****
- -- C97203B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CONDITIONAL_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
- --     SELECTIVE_WAIT  CANNOT.
- 
- -- PART 2: PROCEDURE BODY EMBEDDED IN TASK BODY.
- 
- 
- -- RM 4/09/1982
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE  C97203B  IS
- 
- 
- BEGIN
- 
- 
-      TEST ( "C97203B" , "CHECK THAT A  CONDITIONAL_ENTRY_CALL  CAN" &
-                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK  TT  IS
-                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
-           END  TT ;
- 
- 
-           TASK BODY  TT  IS
- 
- 
-                PROCEDURE  WITHIN_TASK_BODY ;
- 
- 
-                PROCEDURE  WITHIN_TASK_BODY  IS
-                BEGIN
- 
-                     SELECT  -- NOT A SELECTIVE_WAIT
-                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
-                     ELSE 
-                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
-                     END SELECT;
-                     
-                END  WITHIN_TASK_BODY ;
- 
- 
-           BEGIN
- 
- 
-                -- CALL THE INNER PROC. TO FORCE EXEC. OF COND_E_CALL
-                WITHIN_TASK_BODY ;
- 
- 
-                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
- 
-                     IF  AUTHORIZED  THEN
-                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
-                     ELSE
-                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
-                     END IF;
- 
-                END  A ;
- 
-           END  TT ;
- 
- 
-           PROCEDURE  OUTSIDE_TASK_BODY  IS
-           BEGIN
- 
-                SELECT  -- NOT A SELECTIVE_WAIT
-                     TT.A ( FALSE ) ;  -- UNBORN
-                ELSE 
-                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
-                END SELECT;
- 
-           END  OUTSIDE_TASK_BODY ;
- 
- 
-           PACKAGE       CREATE_OPPORTUNITY_TO_CALL           IS END;   
-           PACKAGE BODY  CREATE_OPPORTUNITY_TO_CALL  IS
-           BEGIN
-                -- CALL THE OTHER PROC. TO FORCE EXEC. OF COND_E_CALL
-                OUTSIDE_TASK_BODY ;
-           END  CREATE_OPPORTUNITY_TO_CALL ;
- 
- 
-      BEGIN
- 
-           TT.A ( TRUE );
- 
-      EXCEPTION
- 
-           WHEN  TASKING_ERROR  =>
-                FAILED( "TASKING ERROR" );
- 
-      END  ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT ;
- 
- 
- END  C97203B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97203c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97203c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97203c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97203c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- C97203C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A CONDITIONAL ENTRY CALL CAN APPEAR IN PLACES WHERE A
- -- SELECTIVE WAIT IS NOT ALLOWED.
- 
- -- PART 3: TASK BODY NESTED WITHIN A TASK.
- 
- -- WRG 7/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97203C IS
- 
- BEGIN
- 
-      TEST ("C97203C", "CHECK THAT A CONDITIONAL ENTRY CALL CAN " &
-                       "APPEAR IN PLACES WHERE A SELECTIVE WAIT " &
-                       "IS NOT ALLOWED; CASE: TASK BODY NESTED " &
-                       "WITHIN A TASK");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY SYNCH;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT SYNCH;
-                ACCEPT SYNCH;
-                ACCEPT SYNCH;
-                ACCEPT E;
-           END T;
- 
-           TASK OUTER IS
-                ENTRY E;
-                ENTRY SYNCH;
-           END OUTER;
- 
-           TASK BODY OUTER IS
- 
-                TASK TYPE INNER;
- 
-                INNER1 : INNER;
- 
-                TASK BODY INNER IS
-                BEGIN
-                     SELECT
-                          T.E;
-                          FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - " &
-                                  "INNER (1)");
-                     ELSE
-                          T.SYNCH;
-                     END SELECT;
- 
-                     SELECT
-                          OUTER.E;
-                          FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - " &
-                                  "INNER (2)");
-                     ELSE
-                          OUTER.SYNCH;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED - INNER");
-                END INNER;
- 
-                PACKAGE DUMMY IS
-                     TYPE ACC_INNER IS ACCESS INNER;
-                     INNER2 : ACC_INNER := NEW INNER;
-                END DUMMY;
- 
-           BEGIN
- 
-                SELECT
-                     T.E;
-                     FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - OUTER");
-                ELSE
-                     T.SYNCH;
-                END SELECT;
- 
-                ACCEPT SYNCH;
-                ACCEPT SYNCH;
-                ACCEPT E;
- 
-           EXCEPTION
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - OUTER");
- 
-           END OUTER;
- 
-      BEGIN
- 
-           T.E;
-           OUTER.E;
- 
-      END;
- 
-      RESULT;
- 
- END C97203C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97204a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97204a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97204a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- C97204A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL BE RAISED IF THE CALLED
- --     TASK HAS ALREADY COMPLETED ITS EXECUTION AT THE TIME OF THE
- --     CONDITIONAL_ENTRY_CALL.
- 
- 
- -- RM 5/28/82
- -- SPS 11/21/82
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE  C97204A  IS
- 
-      -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
- 
- BEGIN
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      TEST ("C97204A", "CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL" &
-                       " BE RAISED IF THE CALLED TASK HAS ALREADY"     &
-                       " COMPLETED ITS EXECUTION AT THE TIME OF THE"   &
-                       " CONDITIONAL_ENTRY_CALL"                       );
- 
-   
-      DECLARE
- 
- 
-           TASK TYPE  T_TYPE  IS
- 
- 
-                ENTRY  E ;
- 
-           END  T_TYPE ;
- 
- 
-           T_OBJECT1 : T_TYPE ;
- 
- 
-           TASK BODY  T_TYPE  IS
-                BUSY : BOOLEAN := FALSE ;
-           BEGIN
- 
-                NULL;
- 
-           END  T_TYPE ;
- 
- 
-      BEGIN
- 
- 
-           FOR  I  IN  1..5  LOOP
-                EXIT WHEN  T_OBJECT1'TERMINATED ;
-                DELAY 10.0 * Impdef.One_Second;
-           END LOOP;
- 
- 
-           IF NOT  T_OBJECT1'TERMINATED  THEN
-                COMMENT( "TASK NOT YET TERMINATED (AFTER 50 S.)" );
-           END IF;
- 
- 
-           BEGIN
- 
-                SELECT
-                     T_OBJECT1.E ;
-                     FAILED( "CALL WAS NOT DISOBEYED" );
-                ELSE
-                     FAILED( "'ELSE' BRANCH TAKEN INSTEAD OF TSKG_ERR" );
-                END SELECT;
- 
-                FAILED( "EXCEPTION NOT RAISED" );
- 
-           EXCEPTION
- 
-                WHEN  TASKING_ERROR  =>
-                     NULL ;
- 
-                WHEN  OTHERS  =>
-                     FAILED(  "WRONG EXCEPTION RAISED"  );
- 
-           END ;
- 
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
- 
-      RESULT;
- 
- 
- END  C97204A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97204b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97204b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97204b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97204b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- C97204B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT TASKING_ERROR IS RAISED IF THE CALLED TASK IS ABORTED
- -- BEFORE THE CONDITIONAL ENTRY CALL IS EXECUTED.
- 
- -- WRG 7/13/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C97204B IS
- 
- BEGIN
- 
-      TEST ("C97204B", "CHECK THAT TASKING_ERROR IS RAISED IF THE " &
-                       "CALLED TASK IS ABORTED BEFORE THE CONDITIONAL " &
-                       "ENTRY CALL IS EXECUTED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (I : INTEGER);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (I : INTEGER);
-                FAILED ("ENTRY CALL ACCEPTED");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED");
-           END T;
- 
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                ABORT T;
-                RETURN 1;
-           END F;
- 
-      BEGIN
- 
-           SELECT
-                T.E (F);
-                FAILED ("CONDITIONAL ENTRY CALL MADE");
-           ELSE
-                FAILED ("ELSE PART EXECUTED");
-           END SELECT;
- 
-           FAILED ("EXCEPTION NOT RAISED");
- 
-      EXCEPTION
- 
-           WHEN TASKING_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
- 
-      END;
- 
-      RESULT;
- 
- END C97204B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97205a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97205a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97205a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- C97205A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
- -- CONDITIONAL ENTRY CALL), IT IS PERFORMED.
- 
- -- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
- --         STATEMENT.
- 
- -- WRG 7/13/86
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97205A IS
- 
-      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
-      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
-      COUNT                          : POSITIVE := 1;
- 
- 
- BEGIN
- 
-      TEST ("C97205A", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
-                       "POSSIBLE (FOR A CONDITIONAL ENTRY CALL), IT " &
-                       "IS PERFORMED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (B : IN OUT BOOLEAN);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (B : IN OUT BOOLEAN) DO
-                     B := IDENT_BOOL (TRUE);
-                END E;
-           END T;
- 
-      BEGIN
- 
-           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
-                DELAY 1.0 * Impdef.One_Second;
- 
-                SELECT
-                     T.E (RENDEZVOUS_OCCURRED);
-                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
-                ELSE
-                     IF COUNT < 60 * 60 THEN
-                          COUNT := COUNT + 1;
-                     ELSE
-                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
-                                  "HOUR ELAPSED");
-                          EXIT;
-                     END IF;
-                END SELECT;
-           END LOOP;
- 
-      END;
- 
-      IF NOT RENDEZVOUS_OCCURRED THEN
-           FAILED ("RENDEZVOUS DID NOT OCCUR");
-      END IF;
- 
-      IF COUNT > 1 THEN
-           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
-      END IF;
- 
-      RESULT;
- 
- END C97205A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97205b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97205b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97205b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- C97205B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
- -- CONDITIONAL ENTRY CALL), IT IS PERFORMED.
- 
- -- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
- 
- -- WRG 7/13/86
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97205B IS
- 
-      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
-      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
-      COUNT                          : POSITIVE := 1;
- 
- 
- BEGIN
- 
-      TEST ("C97205B", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
-                       "POSSIBLE (FOR A CONDITIONAL ENTRY CALL), IT " &
-                       "IS PERFORMED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (1..3) (B : IN OUT BOOLEAN);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                SELECT
-                     ACCEPT E (2) (B : IN OUT BOOLEAN) DO
-                          B := IDENT_BOOL (TRUE);
-                     END E;
-                OR
-                     ACCEPT E (3) (B : IN OUT BOOLEAN);
-                     FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
-                END SELECT;
-           END T;
- 
-      BEGIN
- 
-           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
-                DELAY 1.0 * Impdef.One_Second;
- 
-                SELECT
-                     T.E (2) (RENDEZVOUS_OCCURRED);
-                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
-                ELSE
-                     IF COUNT < 60 * 60 THEN
-                          COUNT := COUNT + 1;
-                     ELSE
-                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
-                                  "HOUR ELAPSED");
-                          EXIT;
-                     END IF;
-                END SELECT;
-           END LOOP;
- 
-      END;
- 
-      IF NOT RENDEZVOUS_OCCURRED THEN
-           FAILED ("RENDEZVOUS DID NOT OCCUR");
-      END IF;
- 
-      IF COUNT > 1 THEN
-           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
-      END IF;
- 
-      RESULT;
- 
- END C97205B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- C97301A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
- -- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
- 
- -- CASE  A:  THE TASK TO BE CALLED HAS NOT YET BEEN ACTIVATED AS OF THE
- --           MOMENT OF CALL.
- 
- -- RJW 3/31/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97301A IS
- 
-      WAIT_TIME : CONSTANT DURATION := 10.0 * Impdef.One_Second;
-      OR_BRANCH_TAKEN : INTEGER := 3;
- 
- BEGIN
- 
-      TEST ("C97301A", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
-                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
-                       "CALLED TASK IS NOT ACTIVE" );
- 
-      ------------------------------------------------------------------
- 
-      DECLARE
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_OR_WAIT ( AUTHORIZED : IN BOOLEAN );
-           END  T;
- 
-           TASK BODY  T  IS
- 
-                PACKAGE       SECOND_ATTEMPT  IS    END  SECOND_ATTEMPT;
-                PACKAGE BODY  SECOND_ATTEMPT  IS
-                     START_TIME : TIME;
-                BEGIN
-                     START_TIME := CLOCK;
-                     SELECT
-                          DO_IT_NOW_OR_WAIT (FALSE); --CALLING OWN ENTRY.
-                     OR
-                                       -- THEREFORE THIS BRANCH
-                                       --    MUST BE CHOSEN.
-                          DELAY WAIT_TIME;
-                          IF CLOCK >= (WAIT_TIME + START_TIME) THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "INSUFFICIENT DELAY (#2)" );
-                          END IF;
-                          OR_BRANCH_TAKEN := 2 * OR_BRANCH_TAKEN;
-                          COMMENT( "OR_BRANCH  TAKEN  (#2)" );
-                     END SELECT;
-                END  SECOND_ATTEMPT;
- 
-           BEGIN
- 
-                ACCEPT DO_IT_NOW_OR_WAIT ( AUTHORIZED : IN BOOLEAN )  DO
- 
-                     IF  AUTHORIZED  THEN
-                          COMMENT( "AUTHORIZED ENTRY_CALL" );
-                     ELSE
-                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
-                     END IF;
- 
-                END DO_IT_NOW_OR_WAIT;
- 
- 
-           END  T;
- 
- 
-           PACKAGE       FIRST_ATTEMPT  IS      END  FIRST_ATTEMPT;
-           PACKAGE BODY  FIRST_ATTEMPT  IS
-                START_TIME : TIME;
-           BEGIN
-                START_TIME := CLOCK;
-                SELECT
-                     T.DO_IT_NOW_OR_WAIT (FALSE);
-                OR
-                                       -- THIS BRANCH MUST BE CHOSEN.
-                     DELAY WAIT_TIME;
-                     IF CLOCK >= (WAIT_TIME + START_TIME) THEN
-                          NULL;
-                     ELSE
-                          FAILED ( "INSUFFICIENT DELAY (#1)" );
-                     END IF;
-                     OR_BRANCH_TAKEN := 1 + OR_BRANCH_TAKEN;
-                     COMMENT( "OR_BRANCH  TAKEN  (#1)" );
-                END SELECT;
- 
-           END  FIRST_ATTEMPT;
- 
-      BEGIN
- 
-           T.DO_IT_NOW_OR_WAIT ( TRUE );   -- TO SATISFY THE SERVER'S
-                                           --     WAIT FOR SUCH A CALL.
- 
-      EXCEPTION
- 
-           WHEN  TASKING_ERROR  =>
-                FAILED( "TASKING ERROR" );
- 
-      END ;
- 
- 
-      ------------------------------------------------------------------
- 
- 
-      -- BY NOW, THE TASK IS TERMINATED  (AND THE NONLOCALS UPDATED).
- 
- 
-      CASE  OR_BRANCH_TAKEN  IS
- 
-           WHEN  3  =>
-                FAILED( "NO 'OR'; BOTH (?) RENDEZVOUS ATTEMPTED?" );
- 
-           WHEN  4  =>
-                FAILED( "'OR' #1 ONLY; RENDEZVOUS (#2) ATTEMPTED?" );
- 
-           WHEN  6  =>
-                FAILED( "'OR' #2 ONLY; RENDEZVOUS (#1) ATTEMPTED?" );
- 
-           WHEN  7  =>
-                FAILED( "WRONG ORDER FOR 'OR':  #2,#1" );
- 
-           WHEN  8  =>
-                NULL;
- 
-           WHEN  OTHERS  =>
-                FAILED( "WRONG CASE_VALUE" );
- 
-      END CASE;
- 
-      RESULT;
- 
- END  C97301A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- C97301B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
- --     AMOUNT OF TIME IF A RENDEZVOUS IS NOT POSSIBLE.
- 
- --     CASE  B:  THE QUEUE FOR THE CALLED ENTRY ALREADY CONTAINS
- --           ANOTHER  TASK WHOSE RENDEZVOUS CANNOT BE COMPLETED WITHIN
- --           THE SPECIFIED DELAY.
- 
- --HISTORY:
- --     RJW 03/31/86 CREATED ORIGINAL TEST.
- --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97301B IS
- 
-      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
- 
- BEGIN
- 
-      TEST ("C97301B", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
-                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
-                       "QUEUE FOR THE CALLED ENTRY ALREADY CONTAINS " &
-                       "ANOTHER TASK WHOSE RENDEZVOUS CANNOT BE " &
-                       "COMPLETED WITHIN THE SPECIFIED DELAY" );
- 
- 
-      DECLARE
-           WAIT_TIME  : DURATION :=  3.0 * Impdef.One_Second;
- 
-           TASK T1;
- 
-           TASK T2 IS
-                ENTRY AWAKEN_T2;
-           END T2;
- 
-           TASK T3 IS
-                ENTRY AWAKEN_T3;
-                ENTRY RELEASE_T;
-           END T3;
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_OR_WAIT (X : INTEGER);
-           END  T;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT DO_IT_NOW_OR_WAIT (X : INTEGER) DO
-                     IF X = 1 THEN
-                          T2.AWAKEN_T2;
-                          WHILE DO_IT_NOW_OR_WAIT'COUNT = 0 LOOP
-                               DELAY 1.0 * Impdef.One_Second;
-                          END LOOP;
-                          T3.AWAKEN_T3;
-                          T3.RELEASE_T;
-                     ELSE
-                          FAILED ("WRONG TASK IN RENDEZVOUS - 1");
-                     END IF;
-                END DO_IT_NOW_OR_WAIT;
-                ACCEPT DO_IT_NOW_OR_WAIT (X : INTEGER) DO
-                     IF X /= 2 THEN
-                          FAILED ("WRONG TASK IN RENDEZVOUS - 2");
-                     END IF;
-                END DO_IT_NOW_OR_WAIT;
-           END  T;
- 
-           TASK BODY T1 IS
-           BEGIN
-                T.DO_IT_NOW_OR_WAIT (1);
-           END T1;
- 
-           TASK BODY T2 IS
-           BEGIN
-                ACCEPT AWAKEN_T2;
-                T.DO_IT_NOW_OR_WAIT (2);
-           END T2;
- 
-           TASK BODY T3 IS
-                START_TIME : TIME;
-                STOP_TIME : TIME;
-           BEGIN
-                BEGIN
-                     ACCEPT AWAKEN_T3;
-                     START_TIME := CLOCK;
-                     SELECT
-                          T.DO_IT_NOW_OR_WAIT (3);
-                     OR
-                                          -- THIS BRANCH MUST BE CHOSEN.
-                          DELAY WAIT_TIME;
-                          STOP_TIME := CLOCK;
-                          IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
-                               NULL;
-                          ELSE
-                               FAILED ( "INSUFFICIENT DELAY" );
-                          END IF;
-                          OR_BRANCH_TAKEN := TRUE;
-                          COMMENT( "OR_BRANCH TAKEN" );
-                          ACCEPT RELEASE_T;
-                     END SELECT;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          FAILED ( "TASKING ERROR" );
-                END;
-                              -- END OF BLOCK CONTAINING TIMED
-                              -- ENTRY CALL.
- 
-                              -- BY NOW, THE TASK T IS EFFECTIVELY
-                              -- TERMINATED (AND THE NONLOCALS UPDATED).
- 
-                IF OR_BRANCH_TAKEN THEN
-                     NULL;
-                ELSE
-                     FAILED( "RENDEZVOUS ATTEMPTED" );
-                END IF;
-           END T3;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END C97301B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- C97301C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED 
- -- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
- 
- -- CASE  C:  AN ACCEPT STATEMENT FOR THE CALLED ENTRY HAS NOT BEEN
- --           REACHED.
- 
- -- RJW 3/31/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97301C IS
-      
-      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
-      
- BEGIN
- 
-      TEST ("C97301C", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
-                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN AN " &
-                       "ACCEPT STATEMENT FOR THE CALLED ENTRY HAS " &
-                       "NOT BEEN REACHED" );
- 
- 
-      DECLARE
-           START_TIME : TIME;
-           STOP_TIME : TIME;
-           WAIT_TIME  : DURATION :=  3.0 * Impdef.One_Second;
- 
-           TASK  T  IS
-                ENTRY NO_SPIN;
-                ENTRY DO_IT_NOW_OR_WAIT;
-           END  T;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT NO_SPIN;
-                ACCEPT DO_IT_NOW_OR_WAIT;
-           END  T;
- 
-      BEGIN
-           START_TIME := CLOCK;
-           SELECT
-                T.DO_IT_NOW_OR_WAIT;
-                FAILED("RENDEZVOUS OCCURRED");
-                ABORT T;
-           OR
-                                       -- THIS BRANCH MUST BE CHOSEN.
-                DELAY WAIT_TIME;
-                STOP_TIME := CLOCK;
-                IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INSUFFICIENT DELAY" );
-                END IF;
-                T.NO_SPIN;
-                OR_BRANCH_TAKEN := TRUE;
-                COMMENT( "OR_BRANCH TAKEN" );
-                T.DO_IT_NOW_OR_WAIT;
-           END SELECT;
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                FAILED ( "TASKING ERROR" );
-      END;
-                                      -- END OF BLOCK CONTAINING TIMED 
-                                      -- ENTRY CALL.
- 
-      -- BY NOW, TASK T IS TERMINATED (AND THE NONLOCALS UPDATED).
-           
-      IF OR_BRANCH_TAKEN THEN
-           NULL;
-      ELSE
-           FAILED( "RENDEZVOUS ATTEMPTED" );
-      END IF;
- 
-      RESULT;
- 
- END C97301C; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- C97301D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
- -- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
- 
- -- CASE  D:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
- --           DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY.
- 
- -- RJW 3/31/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97301D IS
- 
-      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
- 
- BEGIN
- 
-      TEST ("C97301D", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
-                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
-                       "BODY OF THE TASK CONTAINING THE CALLED ENTRY " &
-                       "DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR " &
-                       "THAT ENTRY" );
- 
-      DECLARE
-           START_TIME : TIME;
-           WAIT_TIME : CONSTANT DURATION := 10.0 * Impdef.One_Second;
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_OR_WAIT;
-                ENTRY  KEEP_ALIVE;
-           END  T;
- 
-           TASK BODY  T  IS
-           BEGIN
- 
-                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED.
- 
-                ACCEPT  KEEP_ALIVE;  -- TO PREVENT THIS SERVER TASK FROM
-                                      --     TERMINATING IF
-                                      --     UPON ACTIVATION
-                                      --     IT GETS TO RUN
-                                      --     AHEAD OF THE CALLER (WHICH
-                                      --     WOULD LEAD TO A SUBSEQUENT
-                                      --     TASKING_ERROR AT THE TIME
-                                      --     OF THE NO-WAIT CALL).
- 
-           END;
- 
-      BEGIN
-           START_TIME := CLOCK;
-           SELECT
-                T.DO_IT_NOW_OR_WAIT;
-           OR
-                             --  THIS BRANCH MUST BE CHOSEN.
-                DELAY WAIT_TIME;
-                IF CLOCK >= (WAIT_TIME + START_TIME) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INSUFFICIENT WAITING TIME" );
-                END IF;
-                OR_BRANCH_TAKEN := TRUE;
-                COMMENT( "OR_BRANCH  TAKEN" );
-           END SELECT;
- 
-           T.KEEP_ALIVE;
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                FAILED ( "TASKING ERROR RAISED" );
- 
-      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL.
- 
-      -- BY NOW, THE TASK IS TERMINATED.
- 
-      IF  OR_BRANCH_TAKEN  THEN
-           NULL;
-      ELSE
-           FAILED( "RENDEZVOUS ATTEMPTED?" );
-      END IF;
- 
-      RESULT;
- 
- END  C97301D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97301e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97301e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- C97301E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED 
- -- AMOUNT OF TIME IF A RENDEZVOUS IS NOT POSSIBLE.
- 
- -- CASE  E:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
- --           DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
- --           (THE ENTRY BELONGS TO AN ENTRY FAMILY; SOME FAMILY MEMBERS
- --           ARE "ACCEPTABLE", BUT NOT THE CALLED ONE.)
- 
- -- RJW 3/31/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97301E IS
-      
-      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
-      
- BEGIN
- 
-      TEST ("C97301E", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
-                       "LEAST THE SPECIFIED AMOUNT OF TIME " &
-                       "IN THE ABSENCE OF A CORRESPONDING " &
-                       "ACCEPT_STATEMENT " );
- 
-      DECLARE
-           
-           WAIT_TIME : DURATION :=  3.0 * Impdef.One_Second;
-           
-           START_TIME : TIME;
-          
-           STOP_TIME : TIME;
- 
-           SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
- 
-           KEEP_ALIVE  :  INTEGER  := 15 ;
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_OR_WAIT ( SHORT ) ;
-           END  T ;
-           
-           TASK BODY  T  IS
-           BEGIN
- 
-                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED.
-                ACCEPT  DO_IT_NOW_OR_WAIT ( IDENT_INT(15) );
- 
-                                      -- THIS ALSO PREVENTS THIS SERVER
-                                      --     TASK FROM TERMINATING IF
-                                      --     UPON ACTIVATION
-                                      --     IT GETS TO RUN    
-                                      --     AHEAD OF THE CALLER (WHICH
-                                      --     WOULD LEAD TO A SUBSEQUENT
-                                      --     TASKING_ERROR AT THE TIME 
-                                      --     OF THE NO-WAIT CALL).
- 
-           END ;
- 
- 
-      BEGIN
-           START_TIME := CLOCK;
-           SELECT
-                T.DO_IT_NOW_OR_WAIT (10) ;  -- ACCEPT_STATEMENT HAS 15.
-           OR              
-                             --   THEREFORE THIS BRANCH MUST BE CHOSEN.
-                DELAY WAIT_TIME;
-                STOP_TIME := CLOCK;
-                IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INSUFFICIENT DELAY" );
-                END IF;
-                OR_BRANCH_TAKEN := TRUE ;
-                COMMENT( "OR_BRANCH TAKEN" );
-           END SELECT;
- 
-           T.DO_IT_NOW_OR_WAIT (KEEP_ALIVE) ;
- 
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                FAILED ( "TASKING ERROR" );
- 
-      END;   -- END OF BLOCK CONTAINING THE TIMED ENTRY CALL.
- 
-      -- BY NOW, TASK T IS TERMINATED.
- 
-      IF  OR_BRANCH_TAKEN  THEN
-           NULL ;
-      ELSE
-           FAILED( "RENDEZVOUS ATTEMPTED" );
-      END IF;
- 
-      RESULT;
- 
- END  C97301E ; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97302a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97302a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97302a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- C97302A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHENEVER AN INDEX IS PRESENT IN A TIMED_ENTRY_CALL, IT
- -- IS EVALUATED BEFORE ANY PARAMETER ASSOCIATIONS ARE EVALUATED, AND 
- -- PARAMETER ASSOCIATIONS ARE EVALUATED BEFORE THE DELAY EXPRESSION.
- -- THEN A RENDEZVOUS IS ATTEMPTED.
- 
- -- RJW 3/31/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH CALENDAR; USE CALENDAR;
- PROCEDURE C97302A IS
-      
-      INDEX_COMPUTED  :  BOOLEAN  :=  FALSE;
-      PARAM_COMPUTED  :  BOOLEAN  :=  FALSE;     
-      DELAY_COMPUTED  :  BOOLEAN  :=  FALSE;
- BEGIN
- 
-      TEST ("C97302A", "CHECK THAT WHENEVER AN INDEX IS PRESENT IN " &
-                       "A TIMED_ENTRY_CALL, IT IS EVALUATED BEFORE " &
-                       "ANY PARAMETER ASSOCIATIONS ARE EVALUATED, " &
-                       "AND PARAMETER ASSOCIATIONS ARE EVALUATED " & 
-                       "BEFORE THE DELAY EXPRESSION" );
-      DECLARE
- 
-           WAIT_TIME : DURATION := 3.0 * Impdef.One_Second;
-           
-           TYPE SHORT IS RANGE 10 .. 20;
- 
-           TASK  T  IS
-                ENTRY  DO_IT_NOW_OR_WAIT
-                                       ( SHORT )
-                                       ( DID_YOU_DO_IT : IN BOOLEAN );
-                ENTRY  KEEP_ALIVE;
-           END  T;
- 
-           TASK BODY  T  IS
-           BEGIN
-                ACCEPT  KEEP_ALIVE;
-           END  T;
- 
-           FUNCTION  F1 (X : SHORT) RETURN SHORT IS
-           BEGIN
-                INDEX_COMPUTED  :=  TRUE;
-                RETURN (15);
-           END  F1;
- 
-           FUNCTION  F2 RETURN BOOLEAN  IS
-           BEGIN
-                IF INDEX_COMPUTED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INDEX NOT EVALUATED FIRST" );
-                END IF;
-                PARAM_COMPUTED  :=  TRUE;
-                RETURN (FALSE);
-           END  F2;
- 
-           FUNCTION F3 RETURN DURATION IS
-           BEGIN
-                IF PARAM_COMPUTED THEN
-                     NULL;
-                ELSE
-                     FAILED ( "PARAMETERS NOT EVALUATED BEFORE DELAY " &
-                              "EXPRESSION" );
-                END IF;
-                DELAY_COMPUTED := TRUE;
-                RETURN (WAIT_TIME);
-           END;
-      BEGIN
- 
-           SELECT
-                T.DO_IT_NOW_OR_WAIT
-                                       ( F1 (15) )
-                                       ( NOT F2 );
-                FAILED ("RENDEZVOUS OCCURRED");
-           OR
-                DELAY F3;          
-           END SELECT;
- 
-           T.KEEP_ALIVE;
- 
-      END;   -- END OF BLOCK CONTAINING THE ENTRY CALLS.
- 
-      IF  DELAY_COMPUTED  THEN
-           NULL;
-      ELSE
-           FAILED( "DELAY EXPRESSION NOT EVALUATED" );
-      END IF;
- 
-      RESULT;
- 
- END  C97302A; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97303a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97303a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97303a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97303a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C97303A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
- --     SELECTIVE_WAIT  CANNOT.
- 
- -- PART 1: PACKAGE BODY EMBEDDED IN TASK BODY.
- 
- 
- -- RM 4/06/1982
- 
- with Impdef;
- WITH REPORT;
- USE REPORT;
- PROCEDURE  C97303A  IS
- 
- 
- BEGIN
- 
- 
-      TEST ( "C97303A" , "CHECK THAT A  TIMED_ENTRY_CALL  CAN" &
-                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK  TT  IS
-                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
-           END  TT ;
- 
- 
-           TASK BODY  TT  IS
- 
-                PACKAGE  WITHIN_TASK_BODY  IS
-                     -- NOTHING HERE
-                END  WITHIN_TASK_BODY ;
- 
- 
-                PACKAGE BODY  WITHIN_TASK_BODY  IS
-                BEGIN
- 
-                     SELECT  -- NOT A SELECTIVE_WAIT
-                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
-                     OR
-                          DELAY 1.0 * Impdef.One_Second;
-                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
-                     END SELECT;
-                     
-                END  WITHIN_TASK_BODY ;
- 
- 
-           BEGIN
- 
-                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
- 
-                     IF  AUTHORIZED  THEN
-                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
-                     ELSE
-                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
-                     END IF;
- 
-                END  A ;
-    
-           END  TT ;
- 
- 
-           PACKAGE  OUTSIDE_TASK_BODY  IS
-                -- NOTHING HERE
-           END  OUTSIDE_TASK_BODY ;
- 
- 
-           PACKAGE BODY  OUTSIDE_TASK_BODY  IS
-           BEGIN
- 
-                SELECT  -- NOT A SELECTIVE_WAIT
-                     TT.A ( FALSE ) ;  -- UNBORN
-                OR 
-                     DELAY  2.0 * Impdef.One_Second;
-                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
-                END SELECT;
- 
-           END  OUTSIDE_TASK_BODY ;
- 
- 
-      BEGIN
- 
-           TT.A ( TRUE );
- 
-      EXCEPTION
- 
-           WHEN  TASKING_ERROR  =>
-                FAILED( "TASKING ERROR" );
- 
-      END  ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END  C97303A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97303b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97303b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97303b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97303b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- C97303B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
- --     SELECTIVE_WAIT  CANNOT.
- 
- -- PART 2: PROCEDURE BODY EMBEDDED IN TASK BODY.
- 
- 
- -- RM 4/12/1982
- 
- with Impdef;
- WITH REPORT;
- USE REPORT;
- PROCEDURE  C97303B  IS
- 
- 
- BEGIN
- 
- 
-      TEST ( "C97303B" , "CHECK THAT A  TIMED_ENTRY_CALL  CAN" &
-                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      DECLARE
- 
- 
-           TASK  TT  IS
-                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
-           END  TT ;
- 
- 
-           TASK BODY  TT  IS
- 
- 
-                PROCEDURE  WITHIN_TASK_BODY ;
- 
- 
-                PROCEDURE  WITHIN_TASK_BODY  IS
-                BEGIN
- 
-                     SELECT  -- NOT A SELECTIVE_WAIT
-                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
-                     OR
-                          DELAY 1.0 * Impdef.One_Second;
-                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
-                     END SELECT;
-                     
-                END  WITHIN_TASK_BODY ;
- 
- 
-           BEGIN
- 
- 
-                -- CALL THE INNER PROC. TO FORCE EXEC. OF TIMED_E_CALL
-                WITHIN_TASK_BODY ;
- 
- 
-                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
- 
-                     IF  AUTHORIZED  THEN
-                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
-                     ELSE
-                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
-                     END IF;
- 
-                END  A ;
- 
-           END  TT ;
- 
- 
-           PROCEDURE  OUTSIDE_TASK_BODY  IS
-           BEGIN
- 
-                SELECT  -- NOT A SELECTIVE_WAIT
-                     TT.A ( FALSE ) ;  -- UNBORN
-                OR   
-                     DELAY 1.0 * Impdef.One_Second;
-                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
-                END SELECT;
- 
-           END  OUTSIDE_TASK_BODY ;
- 
- 
-           PACKAGE       CREATE_OPPORTUNITY_TO_CALL           IS END;   
-           PACKAGE BODY  CREATE_OPPORTUNITY_TO_CALL  IS
-           BEGIN
-                -- CALL THE OTHER PROC. TO FORCE EXEC. OF TIMED_E_CALL
-                OUTSIDE_TASK_BODY ;
-           END  CREATE_OPPORTUNITY_TO_CALL ;
- 
- 
-      BEGIN
- 
-           TT.A ( TRUE );
- 
-      EXCEPTION
- 
-           WHEN  TASKING_ERROR  =>
-                FAILED( "TASKING ERROR" );
- 
-      END  ;
- 
-      -------------------------------------------------------------------
- 
-      RESULT ;
- 
- 
- END  C97303B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97303c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97303c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97303c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97303c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- C97303C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED ENTRY CALL CAN APPEAR IN PLACES WHERE A SELECTIVE
- -- WAIT IS NOT ALLOWED.
- 
- -- PART 3: TASK BODY NESTED WITHIN A TASK.
- 
- -- WRG 7/15/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97303C IS
- 
- BEGIN
- 
-      TEST ("C97303C", "CHECK THAT A TIMED ENTRY CALL CAN " &
-                       "APPEAR IN PLACES WHERE A SELECTIVE WAIT " &
-                       "IS NOT ALLOWED; CASE: TASK BODY NESTED " &
-                       "WITHIN A TASK");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E;
-                ENTRY SYNCH;
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT SYNCH;
-                ACCEPT SYNCH;
-                ACCEPT SYNCH;
-                ACCEPT E;
-           END T;
- 
-           TASK OUTER IS
-                ENTRY E;
-                ENTRY SYNCH;
-           END OUTER;
- 
-           TASK BODY OUTER IS
- 
-                TASK TYPE INNER;
- 
-                INNER1 : INNER;
- 
-                TASK BODY INNER IS
-                BEGIN
-                     SELECT
-                          T.E;
-                          FAILED ("TIMED ENTRY CALL ACCEPTED - " &
-                                  "INNER (1)");
-                     OR
-                          DELAY 1.0 * Impdef.One_Second;
-                          T.SYNCH;
-                     END SELECT;
- 
-                     SELECT
-                          OUTER.E;
-                          FAILED ("TIMED ENTRY CALL ACCEPTED - " &
-                                  "INNER (2)");
-                     OR
-                          DELAY 1.0 * Impdef.One_Second;
-                          OUTER.SYNCH;
-                     END SELECT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED - INNER");
-                END INNER;
- 
-                PACKAGE DUMMY IS
-                     TYPE ACC_INNER IS ACCESS INNER;
-                     INNER2 : ACC_INNER := NEW INNER;
-                END DUMMY;
- 
-           BEGIN
- 
-                SELECT
-                     T.E;
-                     FAILED ("TIMED ENTRY CALL ACCEPTED - OUTER");
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                     T.SYNCH;
-                END SELECT;
- 
-                ACCEPT SYNCH;
-                ACCEPT SYNCH;
-                ACCEPT E;
- 
-           EXCEPTION
- 
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - OUTER");
- 
-           END OUTER;
- 
-      BEGIN
- 
-           T.E;
-           OUTER.E;
- 
-      END;
- 
-      RESULT;
- 
- END C97303C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97304a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97304a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97304a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- -- C97304A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL BE RAISED IF THE CALLED
- --     TASK HAS ALREADY COMPLETED ITS EXECUTION AT THE TIME OF THE
- --     TIMED_ENTRY_CALL.
- 
- 
- -- RM 5/28/82
- -- SPS 11/21/82
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE  C97304A  IS
- 
-      -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
- 
- BEGIN
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      TEST ("C97304A", "CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL" &
-                       " BE RAISED IF THE CALLED TASK HAS ALREADY"     &
-                       " COMPLETED ITS EXECUTION AT THE TIME OF THE"   &
-                       " TIMED_ENTRY_CALL"                       );
- 
-   
-      DECLARE
- 
- 
-           TASK TYPE  T_TYPE  IS
- 
- 
-                ENTRY  E ;
- 
-           END  T_TYPE ;
- 
- 
-           T_OBJECT1 : T_TYPE ;
- 
- 
-           TASK BODY  T_TYPE  IS
-                BUSY : BOOLEAN := FALSE ;
-           BEGIN
- 
-                NULL;
- 
-           END  T_TYPE ;
- 
- 
-      BEGIN
- 
- 
-           FOR  I  IN  1..5  LOOP
-                EXIT WHEN  T_OBJECT1'TERMINATED ;
-                DELAY 10.0 * Impdef.One_Second;
-           END LOOP;
- 
- 
-           IF NOT  T_OBJECT1'TERMINATED  THEN
-                COMMENT( "TASK NOT YET TERMINATED (AFTER 50 S.)" );
-           END IF;
- 
- 
-           BEGIN
- 
-                SELECT
-                     T_OBJECT1.E ;
-                     FAILED( "CALL WAS NOT DISOBEYED" );
-                OR
-                     DELAY 1.0 * Impdef.One_Second;
-                     FAILED( "'OR' BRANCH TAKEN INSTEAD OF TSKG_ERROR" );
-                END SELECT;
- 
-                FAILED( "EXCEPTION NOT RAISED" );
- 
-           EXCEPTION
- 
-                WHEN  TASKING_ERROR  =>
-                     NULL ;
- 
-                WHEN  OTHERS  =>
-                     FAILED(  "WRONG EXCEPTION RAISED"  );
- 
-           END ;
- 
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
- 
-      RESULT;
- 
- 
- END  C97304A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97304b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97304b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97304b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97304b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- C97304B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT TASKING_ERROR IS RAISED IF THE CALLED TASK IS ABORTED
- -- BEFORE THE TIMED ENTRY CALL IS EXECUTED.
- 
- -- WRG 7/13/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97304B IS
- 
- BEGIN
- 
-      TEST ("C97304B", "CHECK THAT TASKING_ERROR IS RAISED IF THE " &
-                       "CALLED TASK IS ABORTED BEFORE THE TIMED " &
-                       "ENTRY CALL IS EXECUTED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (I : INTEGER);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (I : INTEGER);
-                FAILED ("ENTRY CALL ACCEPTED");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED");
-           END T;
- 
-           FUNCTION F RETURN INTEGER IS
-           BEGIN
-                ABORT T;
-                RETURN 1;
-           END F;
- 
-      BEGIN
- 
-           SELECT
-                T.E (F);
-                FAILED ("TIMED ENTRY CALL MADE");
-           OR
-                DELAY 1.0 * Impdef.One_Second;
-                FAILED ("DELAY ALTERNATIVE TAKEN");
-           END SELECT;
- 
-           FAILED ("EXCEPTION NOT RAISED");
- 
-      EXCEPTION
- 
-           WHEN TASKING_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
- 
-      END;
- 
-      RESULT;
- 
- END C97304B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- C97305A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
- -- TIMED ENTRY CALL), IT IS PERFORMED.
- 
- -- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
- --         STATEMENT.
- 
- -- WRG 7/13/86
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97305A IS
- 
-      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
-      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
-      COUNT                          : POSITIVE := 1;
-      ZERO                           : DURATION := 1.0;
- 
- 
- BEGIN
- 
-      TEST ("C97305A", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
-                       "POSSIBLE (FOR A TIMED ENTRY CALL), IT " &
-                       "IS PERFORMED");
- 
-      IF EQUAL (3, 3) THEN
-           ZERO := 0.0;
-      END IF;
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (B : IN OUT BOOLEAN);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT E (B : IN OUT BOOLEAN) DO
-                     B := IDENT_BOOL (TRUE);
-                END E;
-           END T;
- 
-      BEGIN
- 
-           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
-                DELAY 1.0 * Impdef.One_Second;
- 
-                SELECT
-                     T.E (RENDEZVOUS_OCCURRED);
-                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
-                OR
-                     DELAY ZERO;
-                     IF COUNT < 60 * 60 THEN
-                          COUNT := COUNT + 1;
-                     ELSE
-                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
-                                  "HOUR ELAPSED");
-                          EXIT;
-                     END IF;
-                END SELECT;
-           END LOOP;
- 
-      END;
- 
-      IF NOT RENDEZVOUS_OCCURRED THEN
-           FAILED ("RENDEZVOUS DID NOT OCCUR");
-      END IF;
- 
-      IF COUNT > 1 THEN
-           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
-      END IF;
- 
-      RESULT;
- 
- END C97305A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- C97305B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
- -- TIMED ENTRY CALL), IT IS PERFORMED.
- 
- -- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
- 
- -- WRG 7/13/86
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97305B IS
- 
-      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
-      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
-      COUNT                          : POSITIVE := 1;
-      ZERO                           : DURATION := 1.0;
- 
- 
- BEGIN
- 
-      TEST ("C97305B", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
-                       "POSSIBLE (FOR A TIMED ENTRY CALL), IT " &
-                       "IS PERFORMED");
- 
-      IF EQUAL (3, 3) THEN
-           ZERO := 0.0;
-      END IF;
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (1..3) (B : IN OUT BOOLEAN);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                SELECT
-                     ACCEPT E (2) (B : IN OUT BOOLEAN) DO
-                          B := IDENT_BOOL (TRUE);
-                     END E;
-                OR
-                     ACCEPT E (3) (B : IN OUT BOOLEAN);
-                     FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
-                END SELECT;
-           END T;
- 
-      BEGIN
- 
-           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
-                DELAY 1.0 * Impdef.One_Second;
- 
-                SELECT
-                     T.E (2) (RENDEZVOUS_OCCURRED);
-                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
-                OR
-                     DELAY ZERO;
-                     IF COUNT < 60 * 60 THEN
-                          COUNT := COUNT + 1;
-                     ELSE
-                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
-                                  "HOUR ELAPSED");
-                          EXIT;
-                     END IF;
-                END SELECT;
-           END LOOP;
- 
-      END;
- 
-      IF NOT RENDEZVOUS_OCCURRED THEN
-           FAILED ("RENDEZVOUS DID NOT OCCUR");
-      END IF;
- 
-      IF COUNT > 1 THEN
-           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
-      END IF;
- 
-      RESULT;
- 
- END C97305B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- C97305C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE RENDEZVOUS IS NOT IMMEDIATELY POSSIBLE BUT BECOMES
- -- POSSIBLE BEFORE THE DELAY EXPIRES, THE TIMED ENTRY CALL IS ACCEPTED.
- 
- -- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
- --         STATEMENT.
- 
- -- WRG 7/13/86
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97305C IS
- 
-      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
-      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
-      DELAY_IN_MINUTES               : CONSTANT POSITIVE := 30;
- 
- 
- BEGIN
- 
-      TEST ("C97305C", "CHECK THAT IF THE RENDEZVOUS IS NOT " &
-                       "IMMEDIATELY POSSIBLE BUT BECOMES POSSIBLE " &
-                       "BEFORE THE DELAY EXPIRES, THE TIMED ENTRY " &
-                       "CALL IS ACCEPTED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (B : IN OUT BOOLEAN);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                DELAY 10.0 * Impdef.One_Long_Second;
-                ACCEPT E (B : IN OUT BOOLEAN) DO
-                     B := IDENT_BOOL (TRUE);
-                END E;
-           END T;
- 
-      BEGIN
- 
-           SELECT
-                T.E (RENDEZVOUS_OCCURRED);
-                STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
-           OR
-                DELAY DELAY_IN_MINUTES * 60.0 * Impdef.One_Long_Second;
-                FAILED ("TIMED ENTRY CALL NOT ACCEPTED AFTER" &
-                        POSITIVE'IMAGE(DELAY_IN_MINUTES) &
-                        " MINUTES ELAPSED");
- 
-           END SELECT;
- 
-      END;
- 
-      IF NOT RENDEZVOUS_OCCURRED THEN
-           FAILED ("RENDEZVOUS DID NOT OCCUR");
-      END IF;
- 
-      IF NOT STATEMENTS_AFTER_CALL_EXECUTED THEN
-           FAILED ("STATEMENTS AFTER ENTRY CALL NOT EXECUTED");
-      END IF;
- 
-      RESULT;
- 
- END C97305C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97305d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97305d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C97305D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF THE RENDEZVOUS IS NOT IMMEDIATELY POSSIBLE BUT BECOMES
- -- POSSIBLE BEFORE THE DELAY EXPIRES, THE TIMED ENTRY CALL IS ACCEPTED.
- 
- -- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
- 
- -- WRG 7/13/86
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE C97305D IS
- 
-      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
-      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
-      DELAY_IN_MINUTES               : CONSTANT POSITIVE := 30;
- 
- 
- BEGIN
- 
-      TEST ("C97305D", "CHECK THAT IF THE RENDEZVOUS IS NOT " &
-                       "IMMEDIATELY POSSIBLE BUT BECOMES POSSIBLE " &
-                       "BEFORE THE DELAY EXPIRES, THE TIMED ENTRY " &
-                       "CALL IS ACCEPTED");
- 
-      DECLARE
- 
-           TASK T IS
-                ENTRY E (1..3) (B : IN OUT BOOLEAN);
-           END T;
- 
-           TASK BODY T IS
-           BEGIN
-                DELAY 10.0 * Impdef.One_Second;
- 
-                SELECT
-                     ACCEPT E (2) (B : IN OUT BOOLEAN) DO
-                          B := IDENT_BOOL (TRUE);
-                     END E;
-                OR
-                     ACCEPT E (3) (B : IN OUT BOOLEAN);
-                     FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
-                END SELECT;
-           END T;
- 
-      BEGIN
- 
-           SELECT
-                T.E (2) (RENDEZVOUS_OCCURRED);
-                STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
-           OR
-                DELAY DELAY_IN_MINUTES * 60.0 * Impdef.One_Second;
-                FAILED ("TIMED ENTRY CALL NOT ACCEPTED AFTER" &
-                        POSITIVE'IMAGE(DELAY_IN_MINUTES) &
-                        " MINUTES ELAPSED");
- 
-           END SELECT;
- 
-      END;
- 
-      IF NOT RENDEZVOUS_OCCURRED THEN
-           FAILED ("RENDEZVOUS DID NOT OCCUR");
-      END IF;
- 
-      IF NOT STATEMENTS_AFTER_CALL_EXECUTED THEN
-           FAILED ("STATEMENTS AFTER ENTRY CALL NOT EXECUTED");
-      END IF;
- 
-      RESULT;
- 
- END C97305D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97307a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97307a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c97307a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c97307a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,209 ****
- -- C97307A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS
- -- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY.
- 
- -- WRG 7/14/86
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C97307A IS
- 
- BEGIN
- 
-      TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " &
-                       "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " &
-                       "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " &
-                       "ENTRY");
- 
-      DECLARE
- 
-           DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second;
- 
-           TASK EXPIRED IS
-                ENTRY INCREMENT;
-                ENTRY READ (COUNT : OUT NATURAL);
-           END EXPIRED;
- 
-           TASK TYPE NON_TIMED_CALLER IS
-                ENTRY NAME (N : NATURAL);
-           END NON_TIMED_CALLER;
- 
-           TASK TYPE TIMED_CALLER IS
-                ENTRY NAME (N : NATURAL);
-           END TIMED_CALLER;
- 
-           CALLER1 : TIMED_CALLER;
-           CALLER2 : NON_TIMED_CALLER;
-           CALLER3 : TIMED_CALLER;
-           CALLER4 : NON_TIMED_CALLER;
-           CALLER5 : TIMED_CALLER;
- 
-           TASK T IS
-                ENTRY E (NAME : NATURAL);
-           END T;
- 
-           TASK DISPATCH IS
-                ENTRY READY;
-           END DISPATCH;
- 
-           --------------------------------------------------
- 
-           TASK BODY EXPIRED IS
-                EXPIRED_CALLS : NATURAL := 0;
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT INCREMENT DO
-                               EXPIRED_CALLS := EXPIRED_CALLS + 1;
-                          END INCREMENT;
-                     OR
-                          ACCEPT READ (COUNT : OUT NATURAL) DO
-                               COUNT := EXPIRED_CALLS;
-                          END READ;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END EXPIRED;
- 
-           --------------------------------------------------
- 
-           TASK BODY NON_TIMED_CALLER IS
-                MY_NAME : NATURAL;
-           BEGIN
-                ACCEPT NAME (N : NATURAL) DO
-                     MY_NAME := N;
-                END NAME;
- 
-                T.E (MY_NAME);
-           END NON_TIMED_CALLER;
- 
-           --------------------------------------------------
- 
-           TASK BODY TIMED_CALLER IS
-                MY_NAME : NATURAL;
-           BEGIN
-                ACCEPT NAME (N : NATURAL) DO
-                     MY_NAME := N;
-                END NAME;
- 
-                SELECT
-                     T.E (MY_NAME);
-                     FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" &
-                             NATURAL'IMAGE(MY_NAME));
-                OR
-                     DELAY DELAY_TIME;
-                     EXPIRED.INCREMENT;
-                END SELECT;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " &
-                             "CALLER" & NATURAL'IMAGE(MY_NAME));
-           END TIMED_CALLER;
- 
-           --------------------------------------------------
- 
-           TASK BODY DISPATCH IS
-           BEGIN
-                CALLER1.NAME (1);
-                ACCEPT READY;
- 
-                CALLER2.NAME (2);
-                ACCEPT READY;
- 
-                CALLER3.NAME (3);
-                ACCEPT READY;
- 
-                CALLER4.NAME (4);
-                ACCEPT READY;
- 
-                CALLER5.NAME (5);
-           END DISPATCH;
- 
-           --------------------------------------------------
- 
-           TASK BODY T IS
- 
-                DESIRED_QUEUE_LENGTH : NATURAL := 1;
-                EXPIRED_CALLS        : NATURAL;
- 
-                ACCEPTED             : ARRAY (1..5) OF NATURAL RANGE 0..5
-                                          := (OTHERS => 0);
-                ACCEPTED_INDEX       : NATURAL := 0;
- 
-           BEGIN
-                LOOP
-                     LOOP
-                          EXPIRED.READ (EXPIRED_CALLS);
-                     EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH -
-                                          EXPIRED_CALLS;
-                          DELAY 2.0 * Impdef.One_Long_Second;
-                     END LOOP;
-                EXIT WHEN DESIRED_QUEUE_LENGTH = 5;
-                     DISPATCH.READY;
-                     DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1;
-                END LOOP;
- 
-                -- AT THIS POINT, FIVE TASKS WERE QUEUED.
-                -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1,
-                -- CALLER3, AND CALLER5 EXPIRE:
- 
-                DELAY DELAY_TIME + 10.0 * Impdef.One_Long_Second;
- 
-                -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE
-                -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E,
-                -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST.
- 
-                WHILE E'COUNT > 0 LOOP
-                     ACCEPT E (NAME : NATURAL) DO
-                          ACCEPTED_INDEX := ACCEPTED_INDEX + 1;
-                          ACCEPTED (ACCEPTED_INDEX) := NAME;
-                     END E;
-                END LOOP;
- 
-                IF ACCEPTED /= (2, 4, 0, 0, 0) THEN
-                     FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " &
-                             "QUEUE");
-                     COMMENT ("ORDER ACCEPTED WAS:" &
-                              NATURAL'IMAGE (ACCEPTED (1))  & ',' &
-                              NATURAL'IMAGE (ACCEPTED (2))  & ',' &
-                              NATURAL'IMAGE (ACCEPTED (3))  & ',' &
-                              NATURAL'IMAGE (ACCEPTED (4))  & ',' &
-                              NATURAL'IMAGE (ACCEPTED (5)) );
-                END IF;
-           END T;
- 
-           --------------------------------------------------
- 
-      BEGIN
- 
-           NULL;
- 
-      END;
- 
-      RESULT;
- 
- END C97307A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- C974001.A
- --
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement
- --      is aborted if it does not complete before the triggering statement
- --      completes, where the triggering statement is a delay_relative
- --      statement and check that the sequence of statements of the triggering 
- --      alternative is executed after the abortable part is left.
- --
- -- TEST DESCRIPTION:
- --      Declare a task with an accept statement containing an asynchronous
- --      select with a delay_relative triggering statement. Parameterize
- --      the accept statement with the time to be used in the delay. Simulate a
- --      time-consuming calculation by declaring a procedure containing an
- --      infinite loop. Call this procedure in the abortable part.
- --
- --      The delay will expire before the abortable part completes, at which
- --      time the abortable part is aborted, and the sequence of statements
- --      following the triggering statement is executed.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with ImpDef;
- 
- procedure C974001 is
- 
- 
-           --========================================================--
- 
-    -- Medium length delay
-    Allotted_Time : constant Duration :=  ImpDef.Switch_To_New_Task;
- 
-    Calculation_Canceled : exception;
- 
- 
-    Count : Integer := 1234;                          
-                                                     
-    procedure Lengthy_Calculation is
-    begin
-       -- Simulate a non-converging calculation.
-       loop                                           -- Infinite loop.
-          Count := (Count + 1) mod 10;
-          delay ImpDef.Minimum_Task_Switch;           -- allow other task 
-       end loop;
-    end Lengthy_Calculation;
- 
- 
-           --========================================================--
- 
- 
-    task type Timed_Calculation is
-       entry Calculation (Time_Limit : in Duration);
-    end Timed_Calculation;
- 
- 
-    task body Timed_Calculation is
-    --
-    begin
-       loop
-          select
-             accept Calculation (Time_Limit : in Duration) do
- 
-                --                                    --
-                -- Asynchronous select is tested here --
-                --                                    --
- 
-                select
-                   delay Time_Limit;           -- Time_Limit is not up yet, so
-                                               -- Lengthy_Calculation starts.
- 
-                   raise Calculation_Canceled; -- This is executed after
-                                               -- Lengthy_Calculation aborted.
-                then abort
-                   Lengthy_Calculation;        -- Delay expires before complete,
-                                               -- so this call is aborted.
- 
-                   -- Check that the whole of the abortable part is aborted,
-                   -- not just the statement in the abortable part that was
-                   -- executing at the time
-                   Report.Failed ("Abortable part not aborted");
- 
-                end select;
- 
-                Report.Failed ("Triggering alternative sequence of " &
-                               "statements not executed");
- 
-             exception    -- New Ada 9x: handler within accept
-                when Calculation_Canceled =>
-                   if Count = 1234 then
-                      Report.Failed ("Abortable part did not execute");
-                   end if;
-             end Calculation;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in Timed_Calculation task");
-    end Timed_Calculation;
- 
- 
-           --========================================================--
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("C974001", "Asynchronous Select: Trigger is delay_relative" &
-                            " which completes before abortable part");
- 
-    declare
-       Timed : Timed_Calculation;  -- Task.
-    begin
-       Timed.Calculation (Time_Limit => Allotted_Time); -- Asynchronous select
-                                                        -- inside accept block.
-    exception
-       when Calculation_Canceled => 
-          null; -- expected behavior
-    end;
- 
-    Report.Result;
- 
- end C974001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,209 ****
- -- C974002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the sequence of statements of the triggering alternative
- --      of an asynchronous select statement is executed if the triggering
- --      statement is a delay_until statement, and the specified time has
- --      already passed. Check that the abortable part is not executed after
- --      the sequence of statements of the triggering alternative is left.
- --
- --      Check that the sequence of statements of the triggering alternative
- --      of an asynchronous select statement is not executed if the abortable
- --      part completes before the triggering statement, and the triggering
- --      statement is a delay_until statement.
- --
- -- TEST DESCRIPTION:
- --      Declare a task with an accept statement containing an asynchronous
- --      select with a delay_until triggering statement. Parameterize
- --      the accept statement with the time to be used in the delay. Simulate
- --      a quick calculation by declaring a procedure which sets a Boolean
- --      flag. Call this procedure in the abortable part.
- --
- --      Make two calls to the task entry: (1) with a time that has already
- --      expired, and (2) with a time that will not expire before the quick
- --      calculation completes.
- --
- --      For (1), the sequence of statements following the triggering statement
- --      is executed, and the abortable part never starts.
- --
- --      For (2), the abortable part completes before the triggering statement,
- --      the delay is canceled, and the sequence of statements following the
- --      triggering statement never starts.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Nov 95   SAIC    Bug fix for ACVC 2.0.1.
- --
- --!
- 
- with Report;
- with Ada.Calendar;
- with ImpDef;
- procedure C974002 is
- 
-    function "-" (Left: Ada.Calendar.Time; Right: Duration )
-                           return Ada.Calendar.Time renames Ada.Calendar."-";
-    function "+" (Left: Ada.Calendar.Time; Right: Duration ) 
-                           return Ada.Calendar.Time renames Ada.Calendar."+";
-    
-    Abortable_Part_Executed         : Boolean;
-    Triggering_Alternative_Executed : Boolean;
- 
- 
-           --========================================================--
- 
- 
-    procedure Quick_Calculation is
-    begin
-       if Report.Equal (1, 1) then
-          Abortable_Part_Executed := True;
-       end if;
-    end Quick_Calculation;
- 
- 
-           --========================================================--
- 
- 
-    task type Timed_Calculation_Task is
-       entry Calculation (Time_Out : in Ada.Calendar.Time);
-    end Timed_Calculation_Task;
- 
- 
-    task body Timed_Calculation_Task is
-    begin
-       loop
-          select
-             accept Calculation (Time_Out : in Ada.Calendar.Time) do
- 
-                --                                    --
-                -- Asynchronous select is tested here --
-                --                                    --
- 
-                select
-                   delay until Time_Out;                    -- Triggering 
-                                                            -- statement.
- 
-                   Triggering_Alternative_Executed := True; -- Triggering
-                                                            -- alternative.
-                then abort
-                   Quick_Calculation;                       -- Abortable part.
-                end select;
-             end Calculation;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others =>
-          Report.Failed ("Unexpected exception in Timed_Calculation_Task");
-    end Timed_Calculation_Task;
- 
- 
-           --========================================================--
- 
- 
-    Start_Time : constant Ada.Calendar.Time := 
-                          Ada.Calendar.Time_of (1901,1,1);
-    Minute     : constant Duration          := 60.0;
- 
- 
-           --========================================================--
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("C974002", "Asynchronous Select with Delay_Until");
-   
-    -- take care of implementations that start the clock at 1/1/01 
-    delay ImpDef.Delay_For_Time_Past;
- 
- 
-    Abortable_Part_Executed         := False;
-    Triggering_Alternative_Executed := False;
- 
-    NO_DELAY_SUBTEST:
- 
-       declare
-          -- Set Expiry to a time which has already passed
-          Expiry : constant Ada.Calendar.Time := Start_Time; 
-          Timed  : Timed_Calculation_Task;
-       begin
- 
-          -- Expiry is the time to be specified in the delay_until statement
-          -- of the asynchronous select. Since it has already passed, the
-          -- abortable part should not execute, and the sequence of statements
-          -- of the triggering alternative should be executed.
- 
-          Timed.Calculation (Time_Out => Expiry);   -- Asynchronous select
-                                                    -- inside accept block.
-          if Abortable_Part_Executed then
-             Report.Failed ("No delay: Abortable part was executed");
-          end if;
- 
-          if not Triggering_Alternative_Executed then
-             Report.Failed ("No delay: triggering alternative sequence " &
-                            "of statements was not executed");
-          end if;
-       end No_Delay_Subtest;
- 
- 
-    Abortable_Part_Executed         := False;
-    Triggering_Alternative_Executed := False;
- 
-    LONG_DELAY_SUBTEST:
- 
-       declare
- 
-          -- Quick_Calculation should finish before expiry.
-          Expiry : constant Ada.Calendar.Time := 
-                                             Ada.Calendar.Clock + Minute;
-          Timed  : Timed_Calculation_Task;
- 
-       begin
- 
-          -- Expiry is the time to be specified in the delay_until statement
-          -- of the asynchronous select. It should not pass before the abortable
-          -- part completes, at which time control should return to the caller;
-          -- the sequence of statements of the triggering alternative should
-          -- not be executed.
- 
-          Timed.Calculation (Time_Out => Expiry);  -- Asynchronous select.
- 
-          if not Abortable_Part_Executed then
-             Report.Failed ("Long delay: Abortable part was not executed");
-          end if;
- 
-          if Triggering_Alternative_Executed then
-             Report.Failed ("Long delay: triggering alternative sequence " &
-                            "of statements was executed");
-          end if;
-       end Long_Delay_Subtest;
- 
- 
-    Report.Result;
- 
- end C974002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,249 ****
- -- C974003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement
- --      is aborted if it does not complete before the triggering statement
- --      completes, where the triggering statement is a task entry call, and
- --      the entry call is queued.
- --
- --      Check that the sequence of statements of the triggering alternative
- --      is executed after the abortable part is left.
- --
- -- TEST DESCRIPTION:
- --      Declare a main procedure containing an asynchronous select with a task
- --      entry call as triggering statement. Force the entry call to be
- --      queued by having the task call a procedure, prior to the corresponding
- --      accept statement, which simulates a routine waiting for user input
- --      (with a delay). 
- --
- --      Simulate a time-consuming routine in the abortable part by calling a
- --      procedure containing an infinite loop. Meanwhile, simulate input by
- --      the user (the delay expires), which causes the task to execute the
- --      accept statement corresponding to the triggering entry call.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C974003_0 is  -- Automated teller machine abstraction.
- 
- 
-    -- Flags for testing purposes:
-    --
-    TC_Triggering_Statement_Completed : Boolean := False;
-    TC_Count                          : Integer := 1234;  -- Global to defeat
-                                                          -- optimization.
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
- 
-    Transaction_Canceled : exception;
- 
- 
-    task type ATM_Keyboard_Task is
-       entry Cancel_Pressed;
-    end ATM_Keyboard_Task;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type);
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974003_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- package body C974003_0 is
- 
- 
-    procedure Listen_For_Input (Key : out Key_Enum) is
-    begin
-       -- Model the situation where the user waits a bit for the card to
-       -- be validated, then presses cancel before it completes.
- 
-       -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
-       delay ImpDef.Minimum_Task_Switch;
- 
-       if Report.Equal (3, 3) then  -- Always true.
-          Key := Cancel;
-       end if;
-    end Listen_For_Input;
- 
- 
- 
-    -- One of these gets created as "Keyboard" for each transaction
-    --
-    task body ATM_Keyboard_Task is
-       Key_Pressed : Key_Enum := None;
-    begin
-       loop
-                                                            -- Force entry calls
-          Listen_For_Input (Key_Pressed);                   -- to be queued,
-                                                            -- then set guard to
-                                                            -- true.
-          select
-             when (Key_Pressed = Cancel) =>                 -- Guard is now
-                accept Cancel_Pressed do                    -- true, so accept
-                   TC_Triggering_Statement_Completed := True;  -- queued entry
-                end Cancel_Pressed;                         -- call.
- 
-                -- User has cancelled the transaction so we exit the
-                -- loop and allow the task to terminate
-                exit;
-          else
-             Key_Pressed := None;
-          end select;
- 
-       end loop;
-    exception
-       when others =>
-           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
-    end ATM_Keyboard_Task;
- 
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type) is
-    begin
-       Card.Number := 9999;
-       Card.PIN    := 111;
-    end Read_Card;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       -- Simulate an exceedingly long validation activity.
-       loop                                             -- Infinite loop.
-          TC_Count := (TC_Count + 1) mod Integer (Card.PIN);
-          -- Synch. point to allow transfer of control to Keyboard
-          -- task during this simulation
-          delay ImpDef.Minimum_Task_Switch;
-          exit when not Report.Equal (TC_Count, TC_Count);    -- Always false.
-       end loop;
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Triggering alternative sequence of statements " &
-                      "not executed");
-       if not TC_Triggering_Statement_Completed then
-          Report.Failed ("Triggering statement did not complete");
-       end if;
-       if TC_Count = 1234 then
-          -- Initial value is unchanged
-          Report.Failed ("Abortable part did not execute");
-       end if;
-    end Perform_Transaction;
- 
- 
- end C974003_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with C974003_0;  -- Automated teller machine abstraction.
- use  C974003_0;
- 
- procedure C974003 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin  -- Main program.
- 
-    Report.Test ("C974003", "Asynchronous Select: Trigger is queued on a " &
-                             "task entry and completes first");
- 
-    Read_Card (Card_Data);
- 
-    declare
-       -- Create the task for this transaction
-       Keyboard : C974003_0.ATM_Keyboard_Task;    
-    begin
- 
-       --                                    --
-       -- Asynchronous select is tested here --
-       --                                    --
- 
-       select
-          Keyboard.Cancel_Pressed;      -- Entry call is initially queued, so
-                                        -- abortable part starts.
- 
-          raise Transaction_Canceled;   -- This is executed after Validate_Card
-                                        -- is aborted.
-       then abort
-          Validate_Card (Card_Data);    -- Keyboard.Cancel_Pressed is accepted
-                                        -- and completes before this call
-                                        -- finishes; it is then aborted.
- 
-          -- Check that the whole of the abortable part is aborted, not
-          -- just the statement in the abortable part that was executing
-          -- at the time
-          Report.Failed ("Abortable part not aborted");
- 
-       end select;
- 
-       Perform_Transaction (Card_Data); -- Should not be reached.
-    exception
-       when Transaction_Canceled =>
-          if not TC_Triggering_Statement_Completed then
-             Report.Failed ("Triggering alternative sequence of statements " &
-                            "executed but triggering statement not complete");
-          end if;
-          if TC_Count = 1234 then
-             -- Initial value is unchanged
-             Report.Failed ("Abortable part did not execute");
-          end if;
-    end;
- 
-    Report.Result;
- 
- end C974003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,273 ****
- -- C974004.A
- --
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement
- --      is aborted if it does not complete before the triggering statement
- --      completes, where the triggering statement is a task entry call,
- --      the entry call is queued, and the entry call completes by propagating
- --      an exception and that the sequence of statements of the triggering 
- --      alternative is not executed after the abortable part is left and that
- --      the exception propagated by the entry call is re-raised immediately
- --      following the asynchronous select.
- --
- -- TEST DESCRIPTION:
- --      Declare a main procedure containing an asynchronous select with a task
- --      entry call as triggering statement. Force the entry call to be
- --      queued by having the task call a procedure, prior to the corresponding
- --      accept statement, which simulates a routine waiting for user input
- --      (with a delay). 
- --
- --      Simulate a time-consuming routine in the abortable part by calling a
- --      procedure containing an infinite loop. Meanwhile, simulate input by
- --      the user (the delay expires), which causes the task to execute the
- --      accept statement corresponding to the triggering entry call. Raise
- --      an exception in the accept statement which is not handled by the task,
- --      and which is thus propagated to the caller.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C974004_0 is  -- Automated teller machine abstraction.
- 
- 
-    -- Flags for testing purposes:
- 
-    Count                          : Integer := 1234;  -- Global to defeat
-                                                       -- optimization.
-    Propagated_From_Task : exception;
- 
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
- 
-    Transaction_Canceled : exception;
- 
- 
-    task type ATM_Keyboard_Task is
-       entry Cancel_Pressed;
-    end ATM_Keyboard_Task;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type);
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974004_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- package body C974004_0 is
- 
- 
-    procedure Listen_For_Input (Key : out Key_Enum) is
-    begin
-       -- Simulate the situation where a user waits a bit for the card to
-       -- be validated, then presses cancel before it completes.
- 
-       -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
-       delay ImpDef.Clear_Ready_Queue;
- 
-       if Report.Equal (3, 3) then  -- Always true.
-          Key := Cancel;
-       end if;
-    end Listen_For_Input;
- 
- 
-    -- One of these gets created as "Keyboard" for each transaction
-    --
-    task body ATM_Keyboard_Task is
-       Key_Pressed : Key_Enum := None;
-    begin
-       loop
-                                                -- Force entry calls to be
-          Listen_For_Input (Key_Pressed);       -- queued, then set guard to
-                                                -- true.
-          select
-             when (Key_Pressed = Cancel) =>     -- Guard is now true, so accept
-                accept Cancel_Pressed do        -- queued entry call.
-                   null;  --:::: user code for cancel
-                   -- Now simulate an unexpected exception arising in the
-                   -- user code
-                   raise Propagated_From_Task;  -- Propagate an exception.
-                   
-                end Cancel_Pressed;
- 
-                Report.Failed 
-                           ("Exception not propagated in ATM_Keyboard_Task");
-                
-                -- User has canceled the transaction so we exit the
-                -- loop and allow the task to terminate
-                exit;
-          else
-             Key_Pressed := None;
-          end select;
-       end loop;
-    exception
-       when Propagated_From_Task =>
-           null;  -- This is the expected test behavior
-       when others =>
-           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
-    end ATM_Keyboard_Task;
- 
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type) is
-    begin
-       Card.Number := 9999;
-       Card.PIN    := 111;
-    end Read_Card;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       -- Simulate an exceedingly long validation activity.
-       loop                                             -- Infinite loop.
-          Count := (Count + 1) mod Integer (Card.PIN);
-          -- Synch. point to allow transfer of control to Keyboard
-          -- task during this simulation
-          delay ImpDef.Minimum_Task_Switch;
-          exit when not Report.Equal (Count, Count);    -- Always false.
-       end loop;
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Exception not re-raised immediately following " &
-                      "asynchronous select");
-       if Count = 1234 then
-          -- Initial value is unchanged
-          Report.Failed ("Abortable part did not execute");
-       end if;
-    end Perform_Transaction;
- 
- 
- end C974004_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with C974004_0;  -- Automated teller machine abstraction.
- use  C974004_0;
- 
- procedure C974004 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin  -- Main program.
- 
-    Report.Test ("C974004", "Asynchronous Select: Trigger is queued on a " &
-                            "task entry and is completed first by an " &
-                            "exception");
- 
-    Read_Card (Card_Data);
- 
-    begin
- 
-       declare
-          -- Create the task for this transaction
-          Keyboard : C974004_0.ATM_Keyboard_Task;
-       begin
- 
-          --                                    --
-          -- Asynchronous select is tested here --
-          --                                    --
- 
-          select
-             Keyboard.Cancel_Pressed;     -- Entry call initially queued, so
-                                          -- abortable part starts.
- 
-             raise Transaction_Canceled;  -- Should not be executed.
-          then abort
-             Validate_Card (Card_Data);   -- Keyboard.Cancel_Pressed is accepted
-                                          -- and propagates an exception before
-                                          -- this call finishes; it is then
-                                          -- aborted.
- 
-             -- Check that the whole of the abortable part is aborted, not
-             -- just the statement in the abortable part that was executing
-             -- at the time
-             Report.Failed ("Abortable part not aborted");
-          end select;
-                                          -- The propagated exception is
-                                          -- re-raised here; control passes to
-                                          -- the exception handler.
- 
-          Perform_Transaction(Card_Data); -- Should not be reached.
-       exception
-          when Transaction_Canceled =>
-             Report.Failed ("Triggering alternative sequence of statements " &
-                            "executed");
-          when Propagated_From_Task =>
-             -- This is the expected test path
-             if Count = 1234 then
-                -- Initial value is unchanged
-                Report.Failed ("Abortable part did not execute");
-             end if;
-          when Tasking_Error  =>
-             Report.Failed ("Tasking_Error raised");
-          when others  =>
-             Report.Failed ("Wrong exception raised"); 
-       end;
- 
-    exception
-       when Propagated_From_Task =>
-          Report.Failed ("Correct exception raised at wrong level");
-       when  others  =>
-          Report.Failed ("Wrong exception raised at wrong level");
-    end;
- 
-    Report.Result;
- 
- end C974004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,259 ****
- -- C974005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Tasking_Error is raised at the point of an entry call
- --      which is the triggering statement of an asynchronous select, if
- --      the entry call is queued, but the task containing the entry completes
- --      before it can be accepted or canceled.
- --
- --      Check that the abortable part is aborted if it does not complete
- --      before the triggering statement completes.
- --
- --      Check that the sequence of statements of the triggering alternative
- --      is not executed.
- --
- -- TEST DESCRIPTION:
- --      Declare a main procedure containing an asynchronous select with a task
- --      entry call as triggering statement. Force the entry call to be
- --      queued by having the task call a procedure, prior to the corresponding
- --      accept statement, which simulates a routine waiting for user input
- --      (with a delay). 
- --
- --      Simulate a time-consuming routine in the abortable part by calling a
- --      procedure containing an infinite loop. Meanwhile, simulate input by
- --      the user (the delay expires) which is NOT the input expected by the
- --      guard on the accept statement. The entry remains closed, and the
- --      task completes its execution. Since the entry was not accepted before
- --      its task completed, Tasking_Error is raised at the point of the entry
- --      call.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C974005_0 is  -- Automated teller machine abstraction.
- 
- 
-    -- Flags for testing purposes:
- 
-    Count : Integer := 1234;            
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
- 
-    Transaction_Canceled : exception;
- 
- 
-    task type ATM_Keyboard_Task is
-       entry Cancel_Pressed;
-    end ATM_Keyboard_Task;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type);
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974005_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- package body C974005_0 is
- 
- 
-    procedure Listen_For_Input (Key : out Key_Enum) is
-    begin
-       -- Simulate the situation where a user waits a bit for the card to
-       -- be validated, then presses a transaction key (NOT Cancel).
- 
-       -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
-       delay ImpDef.Clear_Ready_Queue;
- 
-       if Report.Equal (3, 3) then  -- Always true.
-          Key := Deposit;           -- Cancel is NOT pressed.
-       end if;
-    end Listen_For_Input;
- 
- 
-    task body ATM_Keyboard_Task is
-       Key_Pressed : Key_Enum := None;
-    begin
- 
-       -- Note: no loop. If the user does not press Cancel, the task completes.
-       -- In this model of the keyboard monitor, the user only gets one chance
-       -- to cancel the card validation.
-                                                             -- Force entry
-          Listen_For_Input (Key_Pressed);                    -- calls to be
-                                                             -- queued, but do
-                                                             -- NOT set guard
-                                                             -- to true.
-       select
-          when (Key_Pressed = Cancel) =>                     -- Guard is false,
-             accept Cancel_Pressed do                        -- so entry call
-                Report.Failed ("Accept statement executed"); -- remains queued.
-             end Cancel_Pressed;
-       else                                                  -- Else alternative
-          Key_Pressed := None;                               -- executed, then
-       end select;                                           -- task ends.
-    exception
-       when others => 
-          Report.Failed ("Unexpected exception in ATM_Keyboard_Task"); 
-    end ATM_Keyboard_Task;
- 
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type) is
-    begin
-       Card.Number := 9999;
-       Card.PIN    := 111;
-    end Read_Card;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       -- Simulate an exceedingly long validation activity.
-       loop                                             -- Infinite loop.
-          Count := (Count + 1) mod Integer (Card.PIN);
- 
-          -- Synch Point to allow transfer of control to Keyboard task
-          -- during this simulation
-          delay ImpDef.Minimum_Task_Switch;
- 
-          exit when not Report.Equal (Count, Count);    -- Always false.
-       end loop;
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Exception not re-raised immediately following " &
-                      "asynchronous select");
-       if Count = 1234 then
-          -- Additional analysis added to aid developers
-          Report.Failed ("Abortable part did not execute");
-       end if;
-    end Perform_Transaction;
- 
- 
- end C974005_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with C974005_0;  -- Automated teller machine abstraction.
- use  C974005_0;
- 
- procedure C974005 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin  -- Main program.
- 
-    Report.Test ("C974005", "ATC: trigger is queued but task terminates" &
-                              " before call is serviced");
- 
-    Read_Card (Card_Data);
- 
-    begin
- 
-       declare
-          Keyboard : C974005_0.ATM_Keyboard_Task;
-       begin
- 
-          --                                    --
-          -- Asynchronous select is tested here --
-          --                                    --
- 
-          select
-             Keyboard.Cancel_Pressed;      -- Entry call initially queued, so
-                                           -- abortable part starts.
- 
-                                           -- Tasking_Error raised here when
-                                           -- Keyboard completes before entry
-                                           -- call can be accepted, and before
-                                           -- abortable part completes.
- 
-             raise Transaction_Canceled;   -- Should not be executed.
-          then abort
-             Validate_Card (Card_Data);    -- Keyboard task completes before
-                                           -- Keyboard.Cancel_Pressed is
-                                           -- accepted, and before this call
-                                           -- finishes. Tasking_Error is raised
-                                           -- at the point of the entry call,
-                                           -- and this call is aborted.
-             -- Check that the whole of the abortable part is aborted, not just
-             -- the statement in the abortable part that was executing at
-             -- the time
-             Report.Failed ("Abortable part not aborted");
-          end select;
-          Perform_Transaction (Card_Data); -- Should not be reached.
-       exception
-          when Transaction_Canceled =>
-             Report.Failed ("Triggering alternative sequence of statements " &
-                            "executed");
-          when Tasking_Error        =>
-             if Count = 1234 then
-                Report.Failed ("Abortable part did not execute");
-             end if;
-          when others       =>
-             Report.Failed ("Wrong exception raised");
-       end;
- 
-    exception
-       when Tasking_Error        =>
-          Report.Failed ("Correct exception raised at wrong level");
-       when others       =>
-          Report.Failed ("Wrong exception raised at wrong level");
-    end;
- 
-    Report.Result;
- 
- end C974005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,197 ****
- -- C974006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the sequence of statements of the triggering alternative
- --      of an asynchronous select statement is executed if the triggering
- --      statement is a protected entry call, and the entry is accepted
- --      immediately. Check that the corresponding entry body is executed
- --      before the sequence of statements of the triggering alternative.
- --      Check that the abortable part is not executed.
- --
- -- TEST DESCRIPTION:
- --      Declare a main procedure containing an asynchronous select with a
- --      protected entry call as triggering statement. Declare a protected
- --      procedure which sets the protected entry's barrier true. Force the
- --      entry call to be accepted immediately by calling this protected
- --      procedure prior to the asynchronous select. Since the entry call
- --      is accepted immediately, the abortable part should never start. When
- --      entry call completes, the sequence of statements of the triggering
- --      alternative should execute.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package C974006_0 is  -- Automated teller machine abstraction.
- 
- 
-    -- Flag for testing purposes:
- 
-    Entry_Body_Executed : Boolean := False;
- 
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
- 
-    Transaction_Canceled : exception;
- 
- 
-    protected type ATM_Keyboard_Protected is
-       entry Cancel_Pressed;
-       procedure Read_Key;
-    private
-       Last_Key_Pressed : Key_Enum := None;
-    end ATM_Keyboard_Protected;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type);
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974006_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C974006_0 is
- 
- 
-    protected body ATM_Keyboard_Protected is
- 
-       entry Cancel_Pressed when (Last_Key_Pressed = Cancel) is
-       begin
-          Entry_Body_Executed := True;
-       end Cancel_Pressed;
- 
-       procedure Read_Key is
-       begin
-          -- Simulate a procedure which processes user keyboard input, and
-          -- which is called by some interrupt handler.
-          Last_Key_Pressed := Cancel;
-       end Read_Key;
- 
-    end ATM_Keyboard_Protected;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type) is
-    begin
-       Card.Number := 9999;
-       Card.PIN    := 111;
-    end Read_Card;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Abortable part executed");
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Triggering alternative sequence of statements " &
-                       "not fully executed");
-    end Perform_Transaction;
- 
- 
- end C974006_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with C974006_0;  -- Automated teller machine abstraction.
- use  C974006_0;
- 
- procedure C974006 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin
- 
-    Report.Test ("C974006", "ATC: trigger is protected entry call" &
-                               " and completes first");
- 
-    Read_Card (Card_Data);
- 
-    declare
-       Keyboard : C974006_0.ATM_Keyboard_Protected;
-    begin
- 
-       -- Simulate the situation where the user hits cancel before the
-       -- validation process can start:
-       Keyboard.Read_Key;                 -- Force Keyboard.Cancel_Pressed to
-                                          -- be accepted immediately.
- 
-       --                                    --
-       -- Asynchronous select is tested here --
-       --                                    --
- 
-       select
-          Keyboard.Cancel_Pressed;        -- Entry call is accepted immediately,
-                                          -- so abortable part does NOT start.
- 
-          if not Entry_Body_Executed then -- Executes after entry completes.
-             Report.Failed ("Triggering alternative sequence of statements " &
-                            "executed before triggering statement complete");
-          end if;
- 
-          raise Transaction_Canceled;     -- Control passes to exception
-                                          -- handler.
-       then abort
-          Validate_Card (Card_Data);      -- Should not be executed.
-       end select;
-       Perform_Transaction (Card_Data);   -- Should not be reached.
-    exception
-       when Transaction_Canceled =>
-          null;
-    end;
- 
-    Report.Result;
- 
- end C974006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,205 ****
- -- C974007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the sequence of statements of the triggering alternative
- --      of an asynchronous select statement is not executed if the triggering
- --      statement is a protected entry call, and the entry is not accepted
- --      before the abortable part completes. Check that execution continues
- --      immediately following the asynchronous select.
- --
- -- TEST DESCRIPTION:
- --      Declare a main procedure containing an asynchronous select with a
- --      protected entry call as triggering statement. Declare a protected
- --      procedure which sets the protected entry's barrier true. Ensure
- --      that the entry call is never accepted by not calling the protected
- --      procedure; the barrier remains false, and the entry call from
- --      asynchronous select is queued. Since the abortable part will complete
- --      before the entry is accepted, the sequence of statements of the
- --      triggering alternative is never executed.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package C974007_0 is  -- Automated teller machine abstraction.
- 
- 
-    -- Flags for testing purposes:
-    -- 
-    Abortable_Part_Executed       : Boolean := False;
-    Perform_Transaction_Executed  : Boolean := False;
-    Triggering_Statement_Executed : Boolean := False;
- 
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
- 
-    Transaction_Canceled : exception;
- 
- 
-    protected type ATM_Keyboard_Protected is
-       entry Cancel_Pressed;
-       procedure Read_Key;
-    private
-       Last_Key_Pressed : Key_Enum := None;
-    end ATM_Keyboard_Protected;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type);
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974007_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C974007_0 is
- 
- 
-    protected body ATM_Keyboard_Protected is
- 
-       -- Barrier is false for the live of the test
-       entry Cancel_Pressed when (Last_Key_Pressed = Cancel) is  
-       begin                                                     
-       Triggering_Statement_Executed  := true;   -- Test has failed
-       -- (Note: cannot call Report.Failed in the protected entry body]
-       end Cancel_Pressed;
- 
-       procedure Read_Key is                                     -- Never
-       begin                                                     -- called.
-          -- Simulate a procedure which reads user keyboard input, and
-          -- which is called by some interrupt handler.
-          Last_Key_Pressed := Cancel;
-       end Read_Key;
- 
-    end ATM_Keyboard_Protected;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type) is
-    begin
-       Card.Number := 9999;
-       Card.PIN    := 111;
-    end Read_Card;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       Abortable_Part_Executed := True;
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Perform_Transaction_Executed := True;
-    end Perform_Transaction;
- 
- 
- end C974007_0;
- 
- 
-      --==================================================================--
- with Report;
- 
- with C974007_0;  -- Automated teller machine abstraction.
- use  C974007_0;
- 
- procedure C974007 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin
- 
-    Report.Test ("C974007", "ATC: trigger is protected entry call" &
-                               " and abortable part completes first");
- 
-    Read_Card (Card_Data);
- 
-    declare
-       Keyboard : C974007_0.ATM_Keyboard_Protected;
-    begin
- 
-       --                                    --
-       -- Asynchronous select is tested here --
-       --                                    --
- 
-       select
-          Keyboard.Cancel_Pressed;        -- Barrier is never set true, so
-                                          -- entry call is queued and never
-                                          -- accepted.
- 
-          raise Transaction_Canceled;     -- Should not be executed.
-       then abort
-          Validate_Card (Card_Data);      -- This call completes before
-                                          -- Keyboard.Cancel_Pressed can be
-                                          -- accepted.
-       end select;
-       Perform_Transaction (Card_Data);   -- Execution proceeds here after
-                                          -- Validate_Card completes.
-    exception
-       when Transaction_Canceled =>
-          Report.Failed ("Triggering alternative sequence of statements " &
-                         "executed");
-    end;
-    
-    
-    if Triggering_Statement_Executed  then
-       Report.Failed ("Triggering statement was executed");
-    end if;
- 
-    if not Abortable_Part_Executed then
-       Report.Failed ("Abortable part not executed");
-    end if;
- 
-    if not Perform_Transaction_Executed then
-       Report.Failed ("Statements following asynchronous select not " &
-                      "executed");
-    end if;
- 
-    Report.Result;
- 
- end C974007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,229 ****
- -- C974008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement
- --      is not started if the triggering statement is a task entry call, and
- --      the entry call is not queued.
- --
- --      Check that the sequence of statements of the triggering alternative
- --      is executed after the abortable part is left.
- --
- -- TEST DESCRIPTION:
- --      Declare a main procedure containing an asynchronous select with a task
- --      entry call as triggering statement.  Ensure that the task is waiting
- --      at the accept statement so the rendezvous is executed immediately (the
- --      entry call is not queued). 
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C974008_0 is  -- Automated teller machine abstraction.
- 
- 
-    -- Flags for testing purposes:
- 
-    Triggering_Statement_Completed : Boolean := False;
-    Count                          : Integer := 1234;  -- Global to defeat
-                                                       -- optimization.
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
- 
-    Transaction_Canceled : exception;
- 
- 
-    task type ATM_Keyboard_Task is
-       entry Cancel_Pressed;
-    end ATM_Keyboard_Task;
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type);
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974008_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C974008_0 is
- 
- 
-    procedure Listen_For_Input (Key : out Key_Enum) is
-    begin
-       -- Simulate the situation where the user presses the cancel key
-       -- before the card is validated
- 
-       -- press the cancel key immediately
-       Key := Cancel;
- 
-    end Listen_For_Input;
- 
- 
- 
-    -- One of these gets created as "Keyboard" for each transaction
-    --
-    task body ATM_Keyboard_Task is
-       Key_Pressed : Key_Enum := None;
-    begin
-       -- NOTE:   Normal usage for this routine would be the loop with 
-       --         the select statement included.  This particular test
-       --         requires that the task be waiting at the accept 
-       --         for the call.  To ensure that this is the case the 
-       --         extraneous commands are commented out (we leave them
-       --         in this form to show the reader the surrounds to the 
-       --         fragment of code remaining)
-  
-       -- loop
-                                          
-          Listen_For_Input (Key_Pressed); 
-                                          
-          -- select
-             -- when (Key_Pressed = Cancel) =>                 -- Guard is now
-                accept Cancel_Pressed do                    -- true, so accept
-                   Triggering_Statement_Completed := True;  -- queued entry
-                end Cancel_Pressed;                         -- call.
- 
-                -- User has cancelled the transaction so we exit the
-                -- loop and allow the task to terminate
-                -- exit;
-          -- else
-             -- Key_Pressed := None;
-          -- end select;
- 
-       -- end loop;
-    exception
-       when others =>
-           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
-    end ATM_Keyboard_Task;
- 
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type) is
-    begin
-       Card.Number := 9999;
-       Card.PIN    := 111;
-    end Read_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Triggering alternative sequence of statements " &
-                      "not executed");
-       if not Triggering_Statement_Completed then
-          Report.Failed ("Triggering statement did not complete");
-       end if;
-    end Perform_Transaction;
- 
- 
- end C974008_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with C974008_0;  -- Automated teller machine abstraction.
- use  C974008_0;
- 
- procedure C974008 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin  -- Main program.
- 
-    Report.Test ("C974008", "Asynchronous Select: Trigger is a call to a " &
-                            "waiting task entry and completes immediately");
- 
-    Read_Card (Card_Data);
- 
-    declare
-       -- Create the task for this transaction
-       Keyboard : C974008_0.ATM_Keyboard_Task;    
-    begin
- 
-       -- Ensure task is waiting at the accept
-       -- This is the time required to activate another task and allow it
-       -- to run to its first accept statement.
-       --
-       delay ImpDef.Switch_To_New_Task;
- 
-       --                                    --
-       -- Asynchronous select is tested here --
-       --                                    --
- 
-       select
-          Keyboard.Cancel_Pressed;      -- Entry call is executed immediately
- 
-          raise Transaction_Canceled;   -- This is executed after Validate_Card
-                                        -- is aborted.
-       then abort
- 
-          -- In other similar tests Validate_Card is called here.  In this 
-          -- test we just check to see if the abortable part is called at
-          -- all.  Since the triggering call is not queued the abortable 
-          -- part should not be started
-          --
-          Report.Failed ("Abortable part started");
- 
-       end select;
- 
-       Perform_Transaction (Card_Data); -- Should not be reached.
-    exception
-       when Transaction_Canceled =>
- 
-          if not Triggering_Statement_Completed then
-             Report.Failed ("Triggering alternative sequence of statements " &
-                            "executed but triggering statement not complete");
-          end if;
- 
-    end;
- 
-    Report.Result;
- 
- end C974008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,206 ****
- -- C974009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement
- --      is not started if the triggering statement is a task entry call, 
- --      the entry call is not queued and the entry call completes by 
- --      propagating an exception.
- --
- --      Check that the exception is properly propagated to the asynchronous
- --      select statement and thus the sequence of statements of the triggering
- --      alternative is not executed after the abortable part is left. 
- --
- --      Check that the exception propagated by the entry call is re-raised
- --      immediately following the asynchronous select.
- --
- -- TEST DESCRIPTION:
- --
- --      Use a small subset of the base Automated teller machine simulation
- --      which is shown in greater detail in other tests of this series.  
- --      Declare a main procedure containing an asynchronous select with a task
- --      entry call as triggering statement.  Force the task to be waiting at
- --      the accept statement so that the call is not queued and the rendezvous
- --      is executed immediately.  Simulate an unexpected exception in the
- --      rendezvous. Use stripped down versions of called procedures to  check
- --      the correct path in the test.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package C974009_0 is  -- Automated teller machine abstraction.
- 
- 
-    Propagated_From_Task : exception;
-    Transaction_Canceled : exception;
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
-    task type ATM_Keyboard_Task is
-       entry Cancel_Pressed;
-    end ATM_Keyboard_Task;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974009_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C974009_0 is
- 
- 
- 
-    -- One of these gets created as "Keyboard" for each transaction
-    --
-    task body ATM_Keyboard_Task is
-       Key_Pressed : Key_Enum := None;
-    begin
-       accept Cancel_Pressed do        -- queued entry call.
-          null;  --:::: stub, user code for cancel
-          -- Now simulate an unexpected exception arising in the
-          -- user code
-          raise Propagated_From_Task;  -- Propagate an exception.
-                   
-        end Cancel_Pressed;
- 
-        Report.Failed ("Exception not propagated in ATM_Keyboard_Task");
-                
-    exception
-       when Propagated_From_Task =>
-           null;  -- This is the expected test behavior
-       when others =>
-           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
-    end ATM_Keyboard_Task;
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Abortable part was executed");
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Exception not re-raised immediately following " &
-                      "asynchronous select");
-    end Perform_Transaction;
- 
- 
- end C974009_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with C974009_0;  -- Automated teller machine abstraction.
- use  C974009_0;
- 
- procedure C974009 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin  -- Main program.
- 
-    Report.Test ("C974009", "Asynchronous Select: Trigger is a call to a " &
-                            "task entry, is not queued and is completed " &
-                            "first by an exception");
- 
- 
-    begin
- 
-       declare
-          -- Create the task for this transaction
-          Keyboard : C974009_0.ATM_Keyboard_Task;
-       begin
- 
-          -- Ensure task is waiting a the accept so the call is not queued
-          -- This is the time required to activate another task and allow it
-          -- to run to its first accept statement
-          -- 
-          delay ImpDef.Switch_To_New_Task;
- 
-          --                                    --
-          -- Asynchronous select is tested here --
-          --                                    --
- 
-          select
-  
-             Keyboard.Cancel_Pressed;
- 
-             raise Transaction_Canceled;  -- Should not be executed.
-          then abort
-             Validate_Card (Card_Data);   -- Keyboard.Cancel_Pressed is accepted
-                                          -- and propagates an exception before
-                                          -- this call is executed
-          end select;
- 
-          -- The propagated exception is re-raised here.
-          Perform_Transaction(Card_Data); -- Should not be reached.
- 
-       exception
-          when Transaction_Canceled =>
-             Report.Failed ("Triggering alternative sequence of statements " &
-                            "executed");
-          when Propagated_From_Task =>
-             null;  -- This is the expected test path
-          when others =>
-             Report.Failed ("Wrong exception raised");
-       end;
- 
-    exception
-       when others =>
-             Report.Failed ("Unexpected exception raised");
-    end;
- 
-    Report.Result;
- 
- end C974009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,209 ****
- -- C974010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement
- --      is not started if the triggering statement is a task entry call to
- --      a task that has already terminated.
- --
- --      Check that Tasking_Error is properly propagated to the asynchronous
- --      select statement and thus the sequence of statements of the triggering
- --      alternative is not executed after the abortable part is left. 
- --
- --      Check that Tasking_Error is re-raised immediately following the 
- --      asynchronous select.
- --
- -- TEST DESCRIPTION:
- --
- --      Use a small subset of the base Automated Teller Machine simulation
- --      which is shown in greater detail in other tests of this series.  
- --      Declare a main procedure containing an asynchronous select with a task
- --      entry call as triggering statement.  Ensure that the task is
- --      terminated before the entry call.  Use stripped down versions of
- --      the  called procedures to check the correct path in the test.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package C974010_0 is  -- Automated teller machine abstraction.
- 
- 
-    Transaction_Canceled : exception;
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
-    task type ATM_Keyboard_Task is
-       entry Cancel_Pressed;
-    end ATM_Keyboard_Task;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974010_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C974010_0 is
- 
- 
- 
-    -- One of these gets created as "Keyboard" for each transaction
-    --
-    task body ATM_Keyboard_Task is
-       TC_Suicide  : exception;
-       Key_Pressed : Key_Enum := None;
-    begin
-       raise TC_Suicide;   -- Simulate early, unexpected termination
- 
-       accept Cancel_Pressed do        -- queued entry call.
-          null;  --:::: user code for cancel
-                  
-       end Cancel_Pressed;
- 
-    exception
-       when TC_Suicide =>
-          null;  -- This is the expected test behavior
-       when others =>
-           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
-    end ATM_Keyboard_Task;
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Abortable part was executed");
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       Report.Failed ("Exception not re-raised immediately following " &
-                      "asynchronous select");
-    end Perform_Transaction;
- 
- 
- end C974010_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- with ImpDef;
- 
- with C974010_0;  -- Automated teller machine abstraction.
- use  C974010_0;
- 
- procedure C974010 is
- 
-    Card_Data : ATM_Card_Type;
-    TC_Tasking_Error_Handled : Boolean := false;
- 
- begin  -- Main program.
- 
-    Report.Test ("C974010", "Asynchronous Select: Trigger is a call to a " &
-                            "task entry of a task that is already completed");
- 
- 
-    declare
-       -- Create the task for this transaction
-       Keyboard : C974010_0.ATM_Keyboard_Task;
-    begin
- 
-       -- Ensure the task is already completed before calling
-       --
-       while not Keyboard'terminated loop
-          delay ImpDef.Minimum_Task_Switch;
-       end loop;
- 
-       --                                    --
-       -- Asynchronous select is tested here --
-       --                                    --
- 
-       select
-  
-          Keyboard.Cancel_Pressed;
- 
-          raise Transaction_Canceled;  -- Should not be executed.
- 
-       then abort
- 
-          -- Since the triggering call is not queued the abortable part
-          -- should not be executed.
-          --
-          Validate_Card (Card_Data);  
- 
-       end select;
-       --
-       -- The propagated exception is re-raised here.
- 
-       Perform_Transaction(Card_Data); -- Should not be reached.
- 
-    exception
-       when Transaction_Canceled =>
-          Report.Failed ("Triggering alternative sequence of statements " &
-                         "executed");
-       when Tasking_Error =>
-          -- This is the expected test path
-          TC_Tasking_Error_Handled := true;
-       when others       =>
-          Report.Failed ("Wrong exception raised: ");
-    end;
- 
-    
-    if not TC_Tasking_Error_Handled then
-       Report.Failed ("Tasking_Error not properly propagated");
-    end if;
- 
-    Report.Result;
- 
- exception
-    when Tasking_Error =>
-         Report.Failed ("Tasking_Error propagated to wrong handler");
-         Report.Result;
- 
- 
- end C974010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,275 ****
- -- C974011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the sequence of statements of the triggering alternative
- --      of an asynchronous select statement is not executed if the triggering
- --      statement is a task entry call and the entry is not accepted
- --      before the abortable part completes. 
- --      Check that the call queued on the entry is cancelled
- --
- -- TEST DESCRIPTION:
- --      Declare a main procedure containing an asynchronous select with a task
- --      entry call as triggering statement. Force the entry call to be
- --      queued by having the task call a procedure, prior to the corresponding
- --      accept statement, which simulates (with a delay) a routine waiting
- --      for user input
- --       
- --      Once the call is known to be queued, complete the abortable part. 
- --      Check that the rendezvous (and thus the trigger) does not complete. 
- --      Then clear the barrier and check that the entry has been cancelled
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Nov 95   SAIC    Eliminated shared global variable for ACVC 2.0.1
- --
- --!
- 
- with ImpDef;
- --
- package C974011_0 is  -- Automated teller machine abstraction.
- 
- 
- 
-    type Key_Enum is (None, Cancel, Deposit, Withdraw);
- 
-    protected Key_PO is
-       procedure Set (K : Key_Enum);
-       function  Value return Key_Enum;
-    private
-       Current : Key_Enum := None;
-    end Key_PO;
- 
- 
-    -- Flags for testing purposes
-    TC_Abortable_Part_Completed : Boolean := False;
-    TC_Rendezvous_Entered       : Boolean := False;
-    TC_Delay_Time : constant duration := ImpDef.Switch_To_New_Task;
- 
- 
-    Count  : Integer := 1234;  -- Global to defeat optimization.
- 
- 
-    type Card_Number_Type is private;
-    type Card_PIN_Type    is private;
-    type ATM_Card_Type    is private;
- 
- 
-    Transaction_Canceled : exception;
- 
- 
-    task type ATM_Keyboard_Task is
-       entry Cancel_Pressed;
-    end ATM_Keyboard_Task;
- 
-    procedure Read_Card (Card : in out ATM_Card_Type);
- 
-    procedure Validate_Card (Card : in ATM_Card_Type);
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type);
- 
- private
- 
-    type Card_Number_Type is range   1 .. 9999;
-    type Card_PIN_Type    is range 100 ..  999;
- 
-    type ATM_Card_Type is record
-       Number : Card_Number_Type;
-       PIN    : Card_PIN_Type;
-    end record;
- 
- end C974011_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- package body C974011_0 is
- 
-    protected body Key_PO is
-       procedure Set (K : Key_Enum) is
-       begin
-          Current := K;
-       end Set;
- 
-       function Value return Key_Enum is
-       begin
-         return Current;
-       end Value;
-    end Key_PO;
- 
- 
-    procedure Listen_For_Input (Key : out Key_Enum) is
-    begin
-       -- Model the situation where the user does not press cancel thus
-       -- allowing validation to complete
- 
-       delay TC_Delay_Time;  -- Long enough to force queuing on
-                             -- Keyboard.Cancel_Pressed.
-     
-       Key := Key_PO.Value;
- 
-    end Listen_For_Input;
- 
- 
- 
-    -- One of these gets created as "Keyboard" for each transaction
-    --
-    task body ATM_Keyboard_Task is
-       Key_Pressed : Key_Enum;
-    begin
-       loop
-                                                            -- Force entry calls
-          Listen_For_Input (Key_Pressed);                   -- to be queued,
- 
-          select
-             when (Key_Pressed = Cancel) =>                 
-                accept Cancel_Pressed do                    
-                   TC_Rendezvous_Entered := True;
-                end Cancel_Pressed;                        
- 
-                -- User has cancelled the transaction so we exit the
-                -- loop and allow the task to terminate
-                exit;
-          else
-             delay ImpDef.Switch_To_New_Task;
-          end select;
- 
-       end loop;
-    exception
-       when others =>
-           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
-    end ATM_Keyboard_Task;
- 
- 
- 
-    procedure Read_Card (Card : in out ATM_Card_Type) is
-    begin
-       Card.Number := 9999;
-       Card.PIN    := 111;
-    end Read_Card;
- 
- 
-    procedure Validate_Card (Card : in ATM_Card_Type) is
-    begin
-       Count := (Count + 1) mod Integer (Card.PIN);
- 
-       -- Simulate a validation activity which is longer than the time
-       -- taken in Listen_For_Input but not inordinately so.
-       delay TC_Delay_Time * 2;
- 
-    end Validate_Card;
- 
- 
-    procedure Perform_Transaction (Card : in ATM_Card_Type) is
-    begin
-       if TC_Rendezvous_Entered then
-          Report.Failed ("Triggering statement completed");
-       end if;
-       if Count = 1234 then
-          -- Initial value is unchanged
-          Report.Failed ("Abortable part did not execute");
-       end if;
-       if not TC_Abortable_Part_Completed then
-          Report.Failed ("Abortable part did not complete");
-       end if;
-    end Perform_Transaction;
- 
- 
- end C974011_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with C974011_0;  -- Automated teller machine abstraction.
- use  C974011_0;
- 
- procedure C974011 is
- 
-    Card_Data : ATM_Card_Type;
- 
- begin  -- Main program.
- 
-    Report.Test ("C974011", "Asynchronous Select: Trigger is queued on a " &
-                             "task entry and the abortable part " &
-                             "completes first");
- 
-    Read_Card (Card_Data);
- 
-    declare
-       -- Create the task for this transaction
-       Keyboard : C974011_0.ATM_Keyboard_Task;    
-    begin
- 
-       --                                    --
-       -- Asynchronous select is tested here --
-       --                                    --
- 
-       select
-       
-          Keyboard.Cancel_Pressed;      -- Entry call is initially queued, so
-                                        -- abortable part starts.
-          raise Transaction_Canceled;   -- This would be executed if we
-                                        -- completed the rendezvous
-       then abort
-       
-          Validate_Card (Card_Data);
-          TC_Abortable_Part_Completed := true;
- 
-       end select;
- 
-       Perform_Transaction (Card_Data); 
- 
- 
-       -- Now clear the entry barrier to allow the rendezvous to complete
-       -- if the triggering call has not been cancelled 
-       Key_PO.Set (Cancel);
-       --
-       delay TC_Delay_Time;  -- to allow it all to take place
- 
-       if TC_Rendezvous_Entered then 
-          Report.Failed ("Triggering Call was not cancelled");
-       end if;
-       
-       abort Keyboard;    -- clean up.  (Note: the task will only exit the
-                          -- loop and terminate if the call hanging on the 
-                          -- entry is executed.)  
- 
-    exception
-       when Transaction_Canceled =>
-          Report.Failed ("Triggering alternative sequence of statements " &
-                            "executed");
-       when Others =>
-          Report.Failed ("Unexpected exception in the Main");
-    end;
- 
-    Report.Result;
-        
- end C974011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C974012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement is
- --      aborted if it does not complete before the triggering statement
- --      completes, where the triggering statement is a call on a protected
- --      entry which is queued.
- --
- -- TEST DESCRIPTION:
- --      A fraction of in-line code is simulated.  A voltage deficiency causes
- --      the routine to seek an alternate best-cost route on an electrical grid
- --      system.  
- --      
- --      An asynchronous select is used with the triggering alternative being a
- --      call to a protected entry with a barrier.  The abortable part is a
- --      routine simulating the lengthy alternate path negotiation.  The entry
- --      barrier would be cleared if the voltage deficiency is rectified before
- --      the alternate can be found thus nullifying the need for the alternate.  
- --      
- --      The test simulates a return to normal in the middle of the
- --      negotiation.  The barrier is cleared, the triggering alternative
- --      completes first and the abortable part should be aborted.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with Report;
- with ImpDef;
- 
- procedure C974012 is
- 
-    subtype Grid_Path is string(1..21);
-    subtype Deficiency is integer range 100..1_000;   -- in MWh
- 
-    New_Path         : Grid_Path;
-    Dummy_Deficiency : Deficiency := 520;   
-    Path_Available   : Boolean    := false;
- 
-    TC_Terminate_Negotiation_Executed  : Boolean := false;
-    TC_Trigger_Completed               : Boolean := false;
-    TC_Negotiation_Completed           : Boolean := false;
- 
-    protected Local_Deficit is
-       procedure Set_Good_Voltage;
-       procedure Bad_Voltage;
-       entry Terminate_Negotiation;
-    private
-       Good_Voltage   : Boolean := false;   -- barrier
-    end Local_Deficit;
- 
-    protected body Local_Deficit is
- 
-       procedure Set_Good_Voltage is
-       begin
-          Good_Voltage := true;
-       end Set_Good_Voltage;
- 
-       procedure Bad_Voltage is
-       begin
-          Good_Voltage := false;
-       end Bad_Voltage;
- 
-       -- Trigger is queued on this entry with barrier condition
-       entry Terminate_Negotiation when Good_Voltage is
-       begin
-          -- complete the triggering call thus terminating grid_path
-          -- negotiation.
-          null; --::: stub - signal main board
-          TC_Terminate_Negotiation_Executed := true;   -- show path traversal
-       end Terminate_Negotiation;
- 
-    end Local_Deficit;
- 
- 
-    -- Routine to find the most cost effective grid path for this 
-    -- particular deficiency at this particular time
-    --
-    procedure Path_Negotiation (Requirement : in  Deficiency;
-                                Best_Path   : out Grid_Path  ) is
-       
-       Dummy_Path : Grid_Path := "NYC.425_NY.227_NH.132";
-       Match : Deficiency := Report.Ident_Int (Requirement); 
-   
-    begin
-       -- 
-       null; --::: stub
-       --
-       -- Simulate a lengthy path negotiation 
-       for i in 1..5 loop
-          delay ImpDef.Minimum_Task_Switch;   
-          -- Part of the way through the negotiation simulate some external 
-          -- event returning the voltage to acceptable level 
-          if i = 3 then
-             Local_Deficit.Set_Good_Voltage;   -- clear the barrier
-          end if;
-       end loop; 
-       
-       Best_Path := Dummy_Path;
-       TC_Negotiation_Completed := true;
-    
-    end Path_Negotiation;
- 
-   
- 
- begin
- 
-    Report.Test ("C974012", "Asynchronous Select: Trigger is queued on a " &
-                            "protected entry and completes before the " &
-                            "abortable part");
- 
-    -- :::::::::   Fragment of code
-    
-    Local_Deficit.Bad_Voltage;      -- Set barrier condition
- 
-    -- For the given voltage deficiency start negotiating the best grid
-    -- path.  If voltage returns to acceptable level cancel the negotiation
-    --
-    select
-       -- Prepare to terminate the Path_Negotiation if voltage improves
-       Local_Deficit.Terminate_Negotiation;
-       TC_Trigger_Completed := true;
-    then abort
-       Path_Negotiation (Dummy_Deficiency, New_Path) ;
-       Path_Available := true;
-    end select;
-    -- :::::::::
- 
-    if not TC_Terminate_Negotiation_Executed or else not
-                                                TC_Trigger_Completed then 
-       Report.Failed ("Unexpected test path taken");
-    end if;
- 
-    if Path_Available or else TC_Negotiation_Completed then
-       Report.Failed ("Abortable part was not aborted");
-    end if;
-    Report.Result;
- 
- end C974012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- C974013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the abortable part of an asynchronous select statement
- --      is aborted if it does not complete before the triggering statement
- --      completes, where the triggering statement is a delay_until
- --      statement.
- --
- --      Check that the sequence of statements of the triggering alternative
- --      is executed after the abortable part is left.
- --
- -- TEST DESCRIPTION:
- --      Declare a task with an accept statement containing an asynchronous
- --      select with a delay_until triggering statement.  Parameterize
- --      the accept statement with the amount of time to be added to the
- --      current time to be used for the delay. Simulate a time-consuming 
- --      calculation by declaring a procedure containing an infinite loop.
- --      Call this procedure in the abortable part.
- --
- --      The delay will expire before the abortable part completes, at which
- --      time the abortable part is aborted, and the sequence of statements
- --      following the triggering statement is executed.
- --
- --      Main test logic is identical to c974001 which uses simple delay
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Nov 95   SAIC    Fixed problems for ACVC 2.0.1.
- --
- --!
- 
- with Report;
- with ImpDef;
- with Ada.Calendar;
- 
- procedure C974013 is
- 
- 
-           --========================================================--
- 
-    function "+" (Left : Ada.Calendar.Time; Right: Duration)
-                             return Ada.Calendar.Time renames Ada.Calendar."+";
- 
- 
-    Allotted_Time : constant Duration := ImpDef.Switch_To_New_Task;
-    Calculation_Canceled : exception;
- 
-    Count : Integer := 1234;                          
-    procedure Lengthy_Calculation is
-    begin
-       -- Simulate a non-converging calculation.
-       loop                                           -- Infinite loop.
-          Count := (Count + 1) mod 10;
-          exit when not Report.Equal (Count, Count);  -- Condition always false.
-          delay 0.0;                                  -- abort completion point
-       end loop;
-    end Lengthy_Calculation;
- 
- 
-           --========================================================--
- 
- 
-    task type Timed_Calculation is
-       entry Calculation (Time_Limit : in Duration);
-    end Timed_Calculation;
- 
- 
-    task body Timed_Calculation is
-       Delay_Time : Ada.Calendar.Time;
-    begin
-       loop
-          select
-             accept Calculation (Time_Limit : in Duration) do
- 
-                -- We have to construct an "until" time artificially 
-                -- as we have no control over when the test will be run
-                --
-                Delay_Time := Ada.Calendar.Clock + Time_Limit;
- 
-                --                                    --
-                -- Asynchronous select is tested here --
-                --                                    --
- 
-                select
- 
-                   delay until Delay_Time;     -- Time not reached yet, so
-                                               -- Lengthy_Calculation starts.
- 
-                   raise Calculation_Canceled; -- This is executed after
-                                               -- Lengthy_Calculation aborted.
- 
-                then abort
- 
-                   Lengthy_Calculation;        -- Delay expires before complete,
-                                               -- so this call is aborted.
-                   -- Check that the whole of the abortable part is aborted,
-                   -- not just the statement in the abortable part that was
-                   -- executing at the time
-                   Report.Failed ("Abortable part not aborted");
- 
-                end select;
- 
-                Report.Failed ("Triggering alternative sequence of " &
-                               "statements not executed");
- 
-             exception    -- New Ada 9x: handler within accept
-                when Calculation_Canceled =>
-                   if Count = 1234 then
-                      Report.Failed ("Abortable part did not execute");
-                   end if;
-             end Calculation;
-          or
-             terminate;
-          end select;
-       end loop;
-    exception
-       when others => 
-             Report.Failed ("Unexpected exception in Timed_Calculation task");
-    end Timed_Calculation;
- 
- 
-           --========================================================--
- 
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("C974013", "Asynchronous Select: Trigger is delay_until " &
-                            "which completes before abortable part");
- 
-    declare
-       Timed : Timed_Calculation;  -- Task.
-    begin
-       Timed.Calculation (Time_Limit => Allotted_Time); -- Asynchronous select
-                                                        -- inside accept block.
-    exception
-       when Calculation_Canceled => 
-          Report.Failed ("wrong exception handler used");
-    end;       
- 
-    Report.Result;
- 
- end C974013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c974014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c974014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- C974014.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the triggering alternative of an asynchronous select 
- --      statement is a delay and the abortable part completes before the delay
- --      expires then the delay is cancelled and the optional statements in the
- --      triggering part are not performed.  In particular, check the case of
- --      the ATC in non-tasking code.
- --
- -- TEST DESCRIPTION:
- --      A fraction of in-line code is simulated.  An asynchronous select
- --      is used with a triggering delay of several minutes.  The abortable
- --      part, which is simulating a very lengthy, time consuming procedure
- --      actually returns almost immediately thus ensuring that it completes
- --      first.  At the conclusion, if a substantial amount of time has passed
- --      the delay is assumed not to have been cancelled. 
- --      (based on example in LRM 9.7.4)
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- with Report;
- with Ada.Calendar;
-          
- procedure C974014 is
- 
-    function "-" (Left, Right : Ada.Calendar.Time)
-                               return Duration      renames Ada.Calendar."-";
- 
-    TC_Start_Time      : Ada.Calendar.Time := Ada.Calendar.Clock;
-    TC_Elapsed_Time    : duration;
- 
-    Maximum_Allowable_Time : duration := 300.0; -- for Calculate_Gamma_Function
- 
- begin
- 
-    Report.Test ("C974014", "ATC: When abortable part completes before " &
-                              "a triggering delay, check that the delay " &
-                              "is cancelled & optional statements " &
-                              "are not performed"); 
- 
-    declare  -- encapsulate test code
- 
-       type Gamma_Index is digits 5;   -- float precision
- 
-       -- (These two fields are assumed filled elsewhere)
-       Input_Field, Result_of_Beta : Gamma_Index;   
- 
-       -- Notify and take corrective action in the event that
-       -- the procedure Calculate_Gamma_Function does not converge.
-       --
-       procedure Non_Convergent is
-       begin
-          null;  -- stub
- 
-          Report.Failed ("Optional statements in triggering part" &
-                                     " were performed");       
-       end Non_Convergent;
- 
- 
-       --  This is a very time consuming calculation.  It is possible,
-       --  that, with certain parameters, it will not converge.  If it
-       --  runs for more than Maximum_Allowable_Time it is considered
-       --  not to be convergent and should be aborted.
-       --
-       Procedure Calculate_Gamma_Function (X, Y : Gamma_Index) is
-       begin
-          null;  -- Stub
-          --
-       end Calculate_Gamma_Function;
- 
-    begin  -- declare
- 
-       -- .....  Isolated segment of inline code
- 
-       -- Now Print Gamma Function (abort and display if not convergent)
-       --
-       select
-          delay Maximum_Allowable_Time;  -- for Calculate_Gamma_Function
-          Non_Convergent;   -- Display error and flag result as failed
- 
-       then abort
-          Calculate_Gamma_Function (Input_Field, Result_of_Beta);
-       end select;
- 
-       -- .....  End of Isolated segment of inline code
- 
-    end; -- declare
-    
-    TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;
- 
-    -- Note: We are not checking for "cancellation within a reasonable time",
-    -- we are checking for cancellation/non-cancellation of the delay.  We
-    -- use a number which, if exceeded, means that the delay was not
-    -- cancelled and has proceeded to  full term.
-    --
-    if ( TC_Elapsed_Time > Maximum_Allowable_Time/2 ) then
-       -- Test time exceeds a reasonable value.
-       Report.Failed ("Triggering delay statement was not cancelled");
-    end if;
- 
- 
-    Report.Result;
- 
- end C974014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c980001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c980001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c980001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c980001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,303 ****
- -- C980001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that when a construct is aborted the execution of an Initialize
- --      procedure as the last step of the default initialization of a
- --      controlled object is abort-deferred.
- --     
- --      Check that when a construct is aborted the execution of a Finalize
- --      procedure as part of the finalization of a controlled object is
- --      abort-deferred.
- --     
- --      Check that an assignment operation to an object with a controlled
- --      part is an abort-deferred operation.
- --
- -- TEST DESCRIPTION:
- --      The controlled operations which are being tested call a subprogram
- --      which guarantees that the enclosing operation becomes aborted.
- --
- --      Each object is created with a unique value to prevent optimizations
- --      due to the values being the same.
- --
- --      Two protected objects are utilized to warrant that the operations
- --      are delayed in their execution until such time that the abort is
- --      processed.  The object Hold_Up is used to hold the targeted
- --      operation in execution, the object Progress is used to communicate
- --      to the driver software that progress is indeed being made. 
- --
- --
- -- CHANGE HISTORY:
- --      01 MAY 95   SAIC    Initial version
- --      01 MAY 96   SAIC    Revised for 2.1
- --      11 DEC 96   SAIC    Final revision for 2.1
- --      02 DEC 97   EDS     Remove 2 calls to C980001_0.Hold_Up.Lock
- --!
- 
- ---------------------------------------------------------------- C980001_0
- 
- with Impdef;
- with Ada.Finalization;
- package C980001_0 is
- 
-   A_Little_While : constant Duration := Impdef.Switch_To_New_Task * 2.0;
-   Enough_Time_For_The_Controlled_Operation_To_Happen : constant Duration
-    := Impdef.Switch_To_New_Task * 4.0;
- 
-   function TC_Unique return Integer;
- 
-   type Sticks_In_Initialize is new Ada.Finalization.Controlled with record
-     Item: Integer := TC_Unique;
-   end record;
-   procedure Initialize( AV: in out Sticks_In_Initialize );
- 
-   type Sticks_In_Adjust is new Ada.Finalization.Controlled with record
-     Item: Integer := TC_Unique;
-   end record;
-   procedure Adjust    ( AV: in out Sticks_In_Adjust );
- 
-   type Sticks_In_Finalize is new Ada.Finalization.Controlled with record
-     Item: Integer := TC_Unique;
-   end record;
-   procedure Finalize  ( AV: in out Sticks_In_Finalize );
- 
-   Initialize_Called : Boolean := False;
-   Adjust_Called     : Boolean := False;
-   Finalize_Called   : Boolean := False;
- 
-   protected type Sticker is
-     entry Lock;
-     procedure Unlock;
-     function Is_Locked return Boolean;
-   private
-     Locked : Boolean := False;
-   end Sticker;
- 
-   Hold_Up  : Sticker;
-   Progress : Sticker;
- 
-   procedure Fail_And_Clear( Message : String );
- 
- 
- end C980001_0;
-  
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body C980001_0 is
- 
-   TC_Master_Value : Integer := 0;
- 
- 
-   function TC_Unique return Integer is  -- make all values unique.
-   begin
-     TC_Master_Value := TC_Master_Value +1;
-     return TC_Master_Value;
-   end TC_Unique;
- 
-   protected body Sticker is
- 
-     entry Lock when not Locked is
-     begin
-       Locked := True;
-     end Lock;
- 
-     procedure Unlock is
-     begin
-       Locked := False;
-     end Unlock;
- 
-     function Is_Locked return Boolean is
-     begin
-       return Locked;
-     end Is_Locked;
- 
-   end Sticker;
- 
-   procedure Initialize( AV: in out Sticks_In_Initialize ) is
-   begin
-     TCTouch.Touch('I');  -------------------------------------------------- I
-     Hold_Up.Unlock;               -- cause the select to abort
-     Initialize_Called := True;
-     AV.Item := TC_Unique;
-     TCTouch.Touch('i');  -------------------------------------------------- i
-     Progress.Unlock;              -- allows Wait_Your_Turn to continue
-   end Initialize;
- 
-   procedure Adjust    ( AV: in out Sticks_In_Adjust ) is
-   begin
-     TCTouch.Touch('A');  -------------------------------------------------- A
-     Hold_Up.Unlock;               -- cause the select to abort
-     Adjust_Called := True;
-     AV.Item := TC_Unique;
-     TCTouch.Touch('a');  -------------------------------------------------- a
-     Progress.Unlock;
-   end Adjust;
- 
-   procedure Finalize  ( AV: in out Sticks_In_Finalize ) is
-   begin
-     TCTouch.Touch('F');  -------------------------------------------------- F
-     Hold_Up.Unlock;               -- cause the select to abort
-     Finalize_Called := True;
-     AV.Item := TC_Unique;
-     TCTouch.Touch('f');  -------------------------------------------------- f
-     Progress.Unlock;
-   end Finalize;
- 
-   procedure Fail_And_Clear( Message : String ) is
-   begin
-     Report.Failed(Message);
-     Hold_Up.Unlock;
-     Progress.Unlock;
-   end Fail_And_Clear;
- 
- end C980001_0;
-  
- ---------------------------------------------------------------------------
- 
- with Report;
- with TCTouch;
- with Impdef;
- with C980001_0;
- procedure C980001 is
- 
-   procedure Check_Initialize_Conditions is
-   begin
-     if not C980001_0.Initialize_Called then
-       C980001_0.Fail_And_Clear("Initialize did not correctly complete");
-     end if;
-     TCTouch.Validate("Ii", "Initialization Sequence");
-   end Check_Initialize_Conditions;
- 
-   procedure Check_Adjust_Conditions is
-   begin
-     if not C980001_0.Adjust_Called then
-       C980001_0.Fail_And_Clear("Adjust did not correctly complete");
-     end if;
-     TCTouch.Validate("Aa", "Adjust Sequence");
-   end Check_Adjust_Conditions;
- 
-   procedure Check_Finalize_Conditions is
-   begin
-     if not C980001_0.Finalize_Called then
-       C980001_0.Fail_And_Clear("Finalize did not correctly complete");
-     end if;
-     TCTouch.Validate("FfFfFf", "Finalization Sequence",
-                      Order_Meaningful => False);
-   end Check_Finalize_Conditions;
- 
-   procedure Wait_Your_Turn is
-     Overrun : Natural := 0;
-   begin
-     while C980001_0.Progress.Is_Locked loop  -- and waits
-       delay C980001_0.A_Little_While;
-       Overrun := Overrun +1;
-       if Overrun > 10 then  
-         C980001_0.Fail_And_Clear("Overrun expired lock");
-       end if;
-     end loop;
-   end Wait_Your_Turn;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("C980001", "Check the interaction between asynchronous " &
-                           "transfer of control and controlled types" );
- 
-   C980001_0.Progress.Lock;
-   C980001_0.Hold_Up.Lock;
- 
-   select
-     C980001_0.Hold_Up.Lock;  -- Init will unlock
- 
-     Wait_Your_Turn;  -- abortable part is stuck in Initialize
-     Check_Initialize_Conditions;
- 
-   then abort
-     declare
-       Object : C980001_0.Sticks_In_Initialize;
-     begin
-       delay Impdef.Minimum_Task_Switch;
-       if Report.Ident_Int( Object.Item ) /= Object.Item then
-         Report.Failed("Optimization foil caused failure");
-       end if;
-       C980001_0.Fail_And_Clear(
-                            "Initialize test executed beyond expected region");
-     end;
-   end select;
- 
-   C980001_0.Progress.Lock;
- 
-   select
-     C980001_0.Hold_Up.Lock;  -- Adjust will unlock
- 
-     Wait_Your_Turn;  -- abortable part is stuck in Adjust
-     Check_Adjust_Conditions;
- 
-   then abort
-     declare
-       Object1 : C980001_0.Sticks_In_Adjust;
-       Object2 : C980001_0.Sticks_In_Adjust;
-     begin
-       Object1 := Object2;
-       delay Impdef.Minimum_Task_Switch;
-       if Report.Ident_Int( Object2.Item )
-          /= Report.Ident_Int( Object1.Item ) then
-         Report.Failed("Optimization foil 1 caused failure");
-       end if;
-       C980001_0.Fail_And_Clear("Adjust test executed beyond expected region");
-     end;
-   end select;
- 
-   C980001_0.Progress.Lock;
- 
-   select
-     C980001_0.Hold_Up.Lock;  -- Finalize will unlock
- 
-     Wait_Your_Turn;  -- abortable part is stuck in Finalize
-     Check_Finalize_Conditions;
- 
-   then abort
-     declare
-       Object1 : C980001_0.Sticks_In_Finalize;
-       Object2 : C980001_0.Sticks_In_Finalize;
-     begin
-       Object1 := Object2;  -- cause a finalize call
-       delay Impdef.Minimum_Task_Switch;
-       if Report.Ident_Int( Object2.Item )
-          /= Report.Ident_Int( Object1.Item ) then
-         Report.Failed("Optimization foil 2 caused failure");
-       end if;
-       C980001_0.Fail_And_Clear(
-                              "Finalize test executed beyond expected region");
-     end;
-   end select;
- 
-   Report.Result;
- 
- exception
-   when others => C980001_0.Fail_And_Clear("Exception in main");
-                  Report.Result;
- end C980001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c980002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c980002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c980002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c980002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- C980002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that aborts are deferred during protected actions.
- --
- -- TEST DESCRIPTION:
- --      This test uses an asynchronous transfer of control to attempt
- --      to abort a protected operation.  The protected operation
- --      includes several requeues to check that the requeue does not
- --      allow the abort to occur.
- --
- --
- -- CHANGE HISTORY:
- --      30 OCT 95   SAIC    ACVC 2.1
- --
- --!
- 
- with Report;
- procedure C980002 is
- 
-   Max_Checkpoints : constant := 7;
-   type Checkpoint_ID is range 1..Max_Checkpoints;
-   type Points_Array is array (Checkpoint_ID) of Boolean;
- begin
-   Report.Test ("C980002",
-                "Check that aborts are deferred during a protected action" &
-                " including requeues");
- 
-   declare -- test encapsulation
- 
-     protected Checkpoint is
-        procedure Got_Here (Id : Checkpoint_ID);
-        function Results return Points_Array;
-     private
-        Reached_Points : Points_Array := (others => False);
-     end Checkpoint;
- 
-     protected body Checkpoint is
-        procedure Got_Here (Id : Checkpoint_ID) is
-        begin
-           Reached_Points (Id) := True;
-        end Got_Here;
- 
-        function Results return Points_Array is
-        begin
-           return Reached_Points;
-        end Results;
-     end Checkpoint;
- 
- 
-     protected Start_Here is
-        entry AST_Waits_Here;
-        entry Start_PO;
-     private
-        Open : Boolean := False;
-        entry First_Stop;
-     end Start_Here;
- 
-     protected Middle_PO is
-        entry Stop_1;
-        entry Stop_2;
-     end Middle_PO;
- 
-     protected Final_PO is
-        entry Final_Stop;
-     end Final_PO;
- 
- 
-     protected body Start_Here is
-        entry AST_Waits_Here when Open is
-        begin
-           null;
-        end AST_Waits_Here;
- 
-        entry Start_PO when True is
-        begin
-           Open := True;
-           Checkpoint.Got_Here (1);
-           requeue First_Stop; 
-        end Start_PO;
- 
-        -- make sure the AST has been accepted before continuing
-        entry First_Stop when AST_Waits_Here'Count = 0 is
-        begin
-           Checkpoint.Got_Here (2);
-           requeue Middle_PO.Stop_1;
-        end First_Stop;
-     end Start_Here;
- 
-     protected body Middle_PO is
-        entry Stop_1 when True is
-        begin
-           Checkpoint.Got_Here (3);
-           requeue Stop_2;
-        end Stop_1;
- 
-        entry Stop_2 when True is
-        begin
-           Checkpoint.Got_Here (4);
-           requeue Final_PO.Final_Stop;
-        end Stop_2;
-     end Middle_PO;
- 
-     protected body Final_PO is
-        entry Final_Stop when True is
-        begin
-           Checkpoint.Got_Here (5);
-        end Final_Stop;
-     end Final_PO;
- 
- 
-   begin   -- test encapsulation
-     select
-        Start_Here.AST_Waits_Here;
-        Checkpoint.Got_Here (6);
-     then abort
-        Start_Here.Start_PO;
-        delay 0.0;  -- abort completion point
-        Checkpoint.Got_Here (7);
-     end select;
- 
-     Check_The_Results: declare
-        Chk : constant Points_Array := Checkpoint.Results;
-        Expected : constant Points_Array :=  (1..6 => True,
-                                              7    => False);
-     begin
-        for I in Checkpoint_ID loop
-           if Chk (I) /= Expected (I) then
-              Report.Failed ("checkpoint error" &
-                             Checkpoint_ID'Image (I) &
-                             " actual is " &
-                             Boolean'Image (Chk(I)));
-           end if;         
-        end loop; 
-     end Check_The_Results;
-   exception
-     when others =>
-        Report.Failed ("unexpected exception");
-   end;    -- test encapsulation
-   
-   Report.Result;
- end C980002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c980003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c980003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c980003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c980003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,294 ****
- -- C980003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- TEST OBJECTIVE:
- --      Check that aborts are deferred during the execution of an 
- --      Initialize procedure (as the last step of the default 
- --      initialization of a controlled object), during the execution 
- --      of a Finalize procedure (as part of the finalization of a 
- --      controlled object), and during an assignment operation to an
- --      object with a controlled part.
- --
- -- TEST DESCRIPTION:
- --      A controlled type is created with Initialize, Adjust, and 
- --      Finalize operations.  These operations note in a protected
- --      object when the operation starts and completes.  This change
- --      in state of the protected object will open the barrier for
- --      the entry in the protected object.
- --      The test contains declarations of objects of the controlled
- --      type.  An asynchronous select is used to attempt to abort
- --      the operations on the controlled type.  The asynchronous select
- --      makes use of the state change to the protected object to 
- --      trigger the abort.
- --
- --
- -- CHANGE HISTORY:
- --      11 Jan 96   SAIC    Initial Release for 2.1
- --       5 May 96   SAIC    Incorporated Reviewer comments.
- --      10 Oct 96   SAIC    Addressed issue where assignment statement
- --                          can be 2 assignment operations.
- --
- --!
- 
- with Ada.Finalization;
- package C980003_0 is
-     Verbose : constant Boolean := False;
- 
-     -- the following flag is set true whenever the
-     -- Initialize operation is called.
-     Init_Occurred : Boolean;
- 
-     type Is_Controlled is new Ada.Finalization.Controlled with
-          record
-              Id : Integer;
-          end record;
- 
-      procedure Initialize (Object : in out Is_Controlled);
-      procedure Finalize   (Object : in out Is_Controlled);
-      procedure Adjust     (Object : in out Is_Controlled);
- 
-      type States is (Unknown,
-                      Start_Init,   Finished_Init, 
-                      Start_Adjust, Finished_Adjust,
-                      Start_Final,  Finished_Final);
- 
-      protected State_Manager is
-         procedure Reset;
-         procedure Set (New_State : States);
-         function Current return States;
-         entry Wait_For_Change;
-      private
-         Current_State : States := Unknown;
-         Changed : Boolean := False;
-      end State_Manager;
- 
- end C980003_0;
- 
- 
- with Report;
- with ImpDef;
- package body C980003_0 is
-      protected body State_Manager is
-          procedure Reset is
-          begin
-              Current_State := Unknown;
-              Changed := False;
-          end Reset;
- 
-          procedure Set (New_State : States) is
-          begin
-              Changed := True;
-              Current_State := New_State;
-          end Set;
- 
-          function Current return States is
-          begin
-              return Current_State;
-          end Current;
- 
-          entry Wait_For_Change when Changed is
-          begin
-              Changed := False;
-          end Wait_For_Change;
-      end State_Manager;
- 
-      procedure Initialize (Object : in out Is_Controlled) is
-      begin
-         if Verbose then
-             Report.Comment ("starting initialize");
-         end if;
-         State_Manager.Set (Start_Init);
-         if Verbose then
-             Report.Comment ("in initialize");
-         end if;
-         delay ImpDef.Switch_To_New_Task;  -- tempting place for abort
-         State_Manager.Set (Finished_Init);
-         if Verbose then
-             Report.Comment ("finished initialize");
-         end if;
-         Init_Occurred := True;
-      end Initialize;
- 
-      procedure Finalize   (Object : in out Is_Controlled) is
-      begin
-         if Verbose then
-             Report.Comment ("starting finalize");
-         end if;
-         State_Manager.Set (Start_Final);
-         if Verbose then
-             Report.Comment ("in finalize");
-         end if;
-         delay ImpDef.Switch_To_New_Task; -- tempting place for abort
-         State_Manager.Set (Finished_Final);
-         if Verbose then
-             Report.Comment ("finished finalize");
-         end if;
-      end Finalize;
- 
-      procedure Adjust     (Object : in out Is_Controlled) is
-      begin
-         if Verbose then
-             Report.Comment ("starting adjust");
-         end if;
-         State_Manager.Set (Start_Adjust);
-         if Verbose then
-             Report.Comment ("in adjust");
-         end if;
-         delay ImpDef.Switch_To_New_Task; -- tempting place for abort
-         State_Manager.Set (Finished_Adjust);
-         if Verbose then
-             Report.Comment ("finished adjust");
-         end if;
-      end Adjust;
- end C980003_0;
- 
- 
- with Report;
- with ImpDef;
- with C980003_0;  use C980003_0;
- with Ada.Unchecked_Deallocation;
- procedure C980003 is
- 
-     procedure Check_State (Should_Be : States;
-                            Msg       : String) is
-         Cur : States := State_Manager.Current;
-     begin
-         if Cur /= Should_Be then
-             Report.Failed (Msg);
-             Report.Comment ("expected: " & States'Image (Should_Be) &
-                             "  found: " & States'Image (Cur));
-         elsif Verbose then
-             Report.Comment ("passed: " & Msg);
-         end if;
-     end Check_State;
- 
- begin
-  
-     Report.Test ("C980003", "Check that aborts are deferred during" &
-                             " initialization, finalization, and assignment" &
-                             " operations on controlled objects");
- 
-     Check_State (Unknown, "initial condition");
- 
-     -- check that initialization and finalization take place
-     Init_Occurred := False;
-     select
-         State_Manager.Wait_For_Change;
-     then abort
-         declare
-             My_Controlled_Obj : Is_Controlled;
-         begin
-             delay 0.0;   -- abort completion point
-             Report.Failed ("state change did not occur");
-         end; 
-     end select;
-     if not Init_Occurred then
-         Report.Failed ("Initialize did not complete");
-     end if;
-     Check_State (Finished_Final, "init/final for declared item");
- 
-     -- check adjust
-     State_Manager.Reset;
-     declare
-         Source, Dest : Is_Controlled;
-     begin
-         Check_State (Finished_Init, "adjust initial state");
-         Source.Id := 3;
-         Dest.Id := 4;
-         State_Manager.Reset;  -- so we will wait for change
-         select
-             State_Manager.Wait_For_Change;
-         then abort
-             Dest := Source;
-         end select;
- 
-         -- there are two implementation methods for the 
-         -- assignment statement:
-         --   1.  no temporary was used in the assignment statement 
-         --        thus the entire
-         --        assignment statement is abort deferred.  
-         --   2.  a temporary was used in the assignment statement so
-         --        there are two assignment operations.  An abort may
-         --        occur between the assignment operations
-         -- Various optimizations are allowed by 7.6 that can affect
-         -- how many times Adjust and Finalize are called. 
-         -- Depending upon the implementation, the state can be either
-         -- Finished_Adjust or Finished_Finalize.   If it is any other
-         -- state then the abort took place at the wrong time.
- 
-         case State_Manager.Current is
-         when Finished_Adjust =>
-             if Verbose then
-                 Report.Comment ("assignment aborted after adjust");
-             end if;
-         when Finished_Final =>
-             if Verbose then
-                 Report.Comment ("assignment aborted after finalize");
-             end if;
-         when Start_Adjust =>
-             Report.Failed ("assignment aborted in adjust");
-         when Start_Final =>
-             Report.Failed ("assignment aborted in finalize");
-         when Start_Init =>
-             Report.Failed ("assignment aborted in initialize");
-         when Finished_Init =>
-             Report.Failed ("assignment aborted after initialize");
-         when Unknown =>
-             Report.Failed ("assignment aborted in unknown state");
-         end case;
- 
- 
-         if Dest.Id /= 3 then
-             if Verbose then
-                 Report.Comment ("assignment not performed");
-             end if;
-         end if;
-     end;
- 
- 
-      -- check dynamically allocated objects
-     State_Manager.Reset;
-     declare
-         type Pointer_Type is access Is_Controlled;
-         procedure Free is new Ada.Unchecked_Deallocation (
-               Is_Controlled, Pointer_Type);
-         Ptr : Pointer_Type;
-     begin
-       -- make sure initialize is done when object is allocated
-       Ptr := new Is_Controlled;
-       Check_State (Finished_Init, "init when item allocated");
-       -- now try aborting the finalize
-       State_Manager.Reset;
-       select
-              State_Manager.Wait_For_Change;
-       then abort
-              Free (Ptr);
-       end select;
-       Check_State (Finished_Final, "finalization in dealloc");
-     end;
- 
-     Report.Result;
-  
- end C980003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c99004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c99004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c99004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c99004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,166 ****
- -- C99004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PREFIX OF 'TERMINATED AND 'CALLABLE CAN BE A
- --     FUNCTION CALL RETURNING AN OBJECT HAVING A TASK TYPE.
- 
- --     NOTE: SEE TEST C38202A FOR CHECKS INVOLVING PREFIXES WHICH ARE
- --     ACCESS TYPES DENOTING TASK TYPES OR WHICH ARE FUNCTIONS
- --     RETURNING ACCESS TYPES DENOTING TASK TYPES.
- 
- -- HISTORY:
- --     RJW 09/16/86 CREATED ORIGINAL TEST.
- --     DHH 10/15/87 CORRECTED HEADER COMMENTS.
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- PROCEDURE C99004A IS
- 
-      TYPE ENUM IS (A, B, C, D);
- 
-      EARRAY : ARRAY (ENUM) OF STRING (1 .. 17) :=
-                                         (A => "BEFORE ACTIVATION",
-                                          B => "DURING ACTIVATION",
-                                          C => "DURING EXECUTION ",
-                                          D => "AFTER TERMINATION" );
- 
-      FUNCTION CHECK (S : STRING; CALL, B1, TERM, B2 : BOOLEAN;
-                      E : ENUM) RETURN BOOLEAN IS
-      BEGIN
-           IF CALL /= B1 THEN
-                FAILED ( "INCORRECT VALUE FOR " & S & "'CALLABLE " &
-                          EARRAY (E) & " OF TASK" );
-           END IF;
- 
-           IF TERM /= B2 THEN
-                FAILED ( "INCORRECT VALUE FOR " & S & "'TERMINATED " &
-                          EARRAY (E) & " OF TASK" );
-           END IF;
- 
-           RETURN IDENT_BOOL (TRUE);
-      END CHECK;
- 
- 
- BEGIN
-      TEST ( "C99004A", "CHECK THAT THE PREFIX OF 'TERMINATED AND " &
-                        "'CALLABLE CAN BE A FUNCTION CALL RETURNING " &
-                        "AN OBJECT HAVING A TASK TYPE" );
- 
-      DECLARE
- 
-           TASK TYPE TT IS
-                ENTRY E;
-           END TT;
- 
-           PACKAGE PKG1 IS
-                T1 : TT;
-           END PKG1;
- 
-           FUNCTION F RETURN TT IS
-           BEGIN
-                RETURN PKG1.T1;
-           END F;
- 
-           PACKAGE PKG2 IS
-                A1 : BOOLEAN := CHECK ("F", F'CALLABLE, TRUE,
-                                       F'TERMINATED, FALSE, A);
-           END PKG2;
- 
-           TASK MAIN_TASK IS
-                ENTRY E (INTEGER RANGE 1 .. 2);
-           END MAIN_TASK;
- 
-           TASK BODY TT IS
-                B1 : BOOLEAN := CHECK ("F", F'CALLABLE, TRUE,
-                                       F'TERMINATED, FALSE, B);
-                C1 : BOOLEAN;
-           BEGIN
-                C1 := CHECK ("F", F'CALLABLE, TRUE,
-                             F'TERMINATED, FALSE, C);
-                MAIN_TASK.E (1);
-                MAIN_TASK.E (2);
-           END TT;
- 
-           PACKAGE BODY PKG1 IS
-           BEGIN
-                NULL;
-           END;
- 
-           TASK BODY MAIN_TASK IS
-                D1 : BOOLEAN;
-           BEGIN
-                ACCEPT E (1);
-                ABORT PKG1.T1;
-                DELAY 5.0 * Impdef.One_Long_Second;
-                D1 := CHECK ("F", F'CALLABLE, FALSE,
-                              F'TERMINATED, TRUE, D);
-           END MAIN_TASK;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE
- 
-           TASK TYPE TT IS
-                ENTRY E;
-           END TT;
- 
-           T2 : TT;
- 
-           A2 : BOOLEAN := CHECK ("T2", T2'CALLABLE, TRUE,
-                                   T2'TERMINATED, FALSE, A);
- 
-           TASK MAIN_TASK IS
-                ENTRY E (INTEGER RANGE 1 .. 2);
-           END MAIN_TASK;
- 
-           TASK BODY TT IS
-                B2 : BOOLEAN := CHECK ("T2", T2'CALLABLE, TRUE,
-                                        T2'TERMINATED, FALSE, B);
-                C2 : BOOLEAN;
-           BEGIN
-                C2 := CHECK ("T2", T2'CALLABLE, TRUE,
-                              T2'TERMINATED, FALSE, C);
-                MAIN_TASK.E (1);
-                MAIN_TASK.E (2);
-           END TT;
- 
-           TASK BODY MAIN_TASK IS
-                D2 : BOOLEAN;
-           BEGIN
-                ACCEPT E (1);
-                ABORT T2;
-                DELAY 5.0 * Impdef.One_Long_Second;
-                D2 := CHECK ("T2", T2'CALLABLE, FALSE,
-                              T2'TERMINATED, TRUE, D);
-           END MAIN_TASK;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C99004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c99005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c99005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c99005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c99005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- C99005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ATTRIBUTE 'COUNT RETURNS THE CORRECT VALUE.
- 
- -- HISTORY:
- --     DHH 03/24/88 CREATED ORIGINAL TEST.
- 
- with Impdef;
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C99005A IS
- 
- BEGIN
- 
-      TEST("C99005A", "CHECK THAT THE ATTRIBUTE 'COUNT RETURNS THE " &
-                      "CORRECT VALUE");
- 
-      DECLARE
-           TASK A IS
-           END A;
- 
-           TASK B IS
-           END B;
- 
-           TASK C IS
-           END C;
- 
-           TASK D IS
-           END D;
- 
-           TASK E IS
-           END E;
- 
-           TASK F IS
-           END F;
- 
-           TASK G IS
-           END G;
- 
-           TASK H IS
-           END H;
- 
-           TASK I IS
-           END I;
- 
-           TASK J IS
-           END J;
- 
-           TASK T IS
-                ENTRY WAIT;
-           END T;
- 
-           TASK CHOICE IS
-                ENTRY RETURN_CALL;
-                ENTRY E2;
-                ENTRY E1;
-           END CHOICE;
- 
-           TASK BODY A IS
-           BEGIN
-                CHOICE.E1;
-           END A;
- 
-           TASK BODY B IS
-           BEGIN
-                CHOICE.E1;
-           END B;
- 
-           TASK BODY C IS
-           BEGIN
-                CHOICE.E1;
-           END C;
- 
-           TASK BODY D IS
-           BEGIN
-                CHOICE.E1;
-           END D;
- 
-           TASK BODY E IS
-           BEGIN
-                CHOICE.E1;
-           END E;
- 
-           TASK BODY F IS
-           BEGIN
-                CHOICE.E2;
-           END F;
- 
-           TASK BODY G IS
-           BEGIN
-                CHOICE.E2;
-           END G;
- 
-           TASK BODY H IS
-           BEGIN
-                CHOICE.E2;
-           END H;
- 
-           TASK BODY I IS
-           BEGIN
-                CHOICE.E2;
-           END I;
- 
-           TASK BODY J IS
-           BEGIN
-                CHOICE.E2;
-           END J;
- 
-           TASK BODY T IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT WAIT DO
-                               DELAY 1.0 * Impdef.One_Second;
-                          END WAIT;
-                          CHOICE.RETURN_CALL;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END T;
- 
-           TASK BODY CHOICE IS
-           BEGIN
-                WHILE E1'COUNT + E2'COUNT < 10 LOOP
-                     T.WAIT;
-                     ACCEPT RETURN_CALL;
-                END LOOP;
- 
-                FOR I IN REVERSE 1 ..10 LOOP
-                     SELECT
-                          ACCEPT E2 DO
-                               IF (E2'COUNT + E1'COUNT + 1) /= I THEN
-                                    FAILED("'COUNT NOT RETURNING " &
-                                           "CORRECT VALUE FOR LOOP" &
-                                            INTEGER'IMAGE(I) & "VALUE " &
-                                            INTEGER'IMAGE((E2'COUNT
-                                            + E1'COUNT + 1)));
-                               END IF;
-                          END E2;
-                     OR
-                          ACCEPT E1 DO
-                               IF (E2'COUNT + E1'COUNT + 1) /= I THEN
-                                    FAILED("'COUNT NOT RETURNING " &
-                                           "CORRECT VALUE FOR LOOP" &
-                                            INTEGER'IMAGE(I) & "VALUE " &
-                                            INTEGER'IMAGE((E2'COUNT
-                                            + E1'COUNT + 1)));
-                               END IF;
-                          END E1;
-                     END SELECT;
-                END LOOP;
-            END CHOICE;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END C99005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- C9A003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ABORTING A TERMINATED TASK DOES NOT CAUSE EXCEPTIONS.
- 
- 
- -- RM 5/21/82
- -- SPS 11/21/82
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X
- 
- with Impdef;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE  C9A003A  IS
- 
-      -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
- 
- BEGIN
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      TEST ("C9A003A", "CHECK THAT  ABORTING A TERMINATED TASK" &
-                       "  DOES NOT CAUSE EXCEPTIONS"   );
- 
-   
-      DECLARE
- 
- 
-           TASK TYPE  T_TYPE  IS
- 
- 
-                ENTRY  E ;
- 
-           END  T_TYPE ;
- 
- 
-           T_OBJECT1 : T_TYPE ;
- 
- 
-           TASK BODY  T_TYPE  IS
-                BUSY : BOOLEAN := FALSE ;
-           BEGIN
- 
-                NULL;
- 
-           END  T_TYPE ;
- 
- 
-      BEGIN
- 
- 
-           IF NOT  T_OBJECT1'TERMINATED  THEN
-                DELAY  20.0 * Impdef.One_Second;
-           END IF;
- 
-           IF NOT  T_OBJECT1'TERMINATED  THEN
-                COMMENT( "TASK NOT YET TERMINATED (AFTER 20 S.)" );
-           END IF;
- 
- 
-           BEGIN
-                ABORT T_OBJECT1 ;
-           EXCEPTION
- 
-                WHEN  OTHERS  =>
-                     FAILED(  "EXCEPTION RAISED (WHEN ABORTING A" &
-                              "  TERMINATED TASK)"  );
- 
-           END ;
- 
- 
-      END ;
- 
- 
-      -------------------------------------------------------------------
- 
- 
- 
-      RESULT;
- 
- 
- END  C9A003A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- C9A004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A TASK IS ABORTED BEFORE BEING ACTIVATED, THE TASK IS
- --     TERMINATED.
- 
- 
- -- RM 5/21/82
- -- SPS 11/21/82
- -- JBG 6/3/85
- -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE  C9A004A  IS
- 
- BEGIN
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      TEST ("C9A004A", "CHECK THAT IF A TASK IS ABORTED"  &
-                       " BEFORE BEING ACTIVATED,"         &
-                       "  THE TASK IS TERMINATED"         );
- 
-   
-      DECLARE
- 
- 
-           TASK TYPE  T_TYPE  IS
- 
- 
-                ENTRY  E ;
- 
-           END  T_TYPE ;
- 
- 
-           T_OBJECT1 : T_TYPE ;
- 
- 
-           TASK BODY  T_TYPE  IS
-                BUSY : BOOLEAN := FALSE ;
-           BEGIN
- 
-                NULL;
- 
-           END  T_TYPE ;
- 
- 
-           PACKAGE  P  IS
-                X : INTEGER := 0 ;
-           END  P ;
- 
- 
-           PACKAGE BODY  P  IS
-           BEGIN
- 
-                IF      T_OBJECT1'TERMINATED  OR
-                    NOT T_OBJECT1'CALLABLE
-                THEN
-                     FAILED( "WRONG VALUES FOR ATTRIBUTES" );
-                END IF;
- 
-                ABORT  T_OBJECT1 ;  -- ELABORATED BUT NOT YET ACTIVATED.
- 
-           END  P ;
- 
- 
-      BEGIN
- 
- 
-           IF NOT  T_OBJECT1'TERMINATED  THEN
-                FAILED(  "ABORTED (BEFORE ACTIVATION) TASK"  &
-                         "  NOT TERMINATED"  );
-           END IF;
- 
-      EXCEPTION
- 
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED");
- 
-      END;
- 
-      RESULT;
- 
- END C9A004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,293 ****
- -- C9A007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK MAY ABORT A TASK IT DEPENDS ON.
- 
- 
- -- RM 5/26/82
- -- RM 7/02/82
- -- SPS 11/21/82
- -- JBG 2/27/84
- -- JBG 3/8/84
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- -- EDS 08/04/98 ENSURE THAT ABORTED TASKS HAVE TIME TO EFFECT THEIR ABORTIONS.
- 
- WITH IMPDEF;
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE  C9A007A  IS
- 
-       TASK_NOT_ABORTED : BOOLEAN := FALSE; 
-       TEST_VALID       : BOOLEAN := TRUE ; 
- 
- BEGIN
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      TEST ( "C9A007A" , "CHECK THAT A TASK MAY ABORT A TASK" &
-                         " IT DEPENDS ON"                     );
- 
-   
-      DECLARE
- 
- 
-           TASK  REGISTER  IS
- 
- 
-                ENTRY  BIRTHS_AND_DEATHS; 
- 
-                ENTRY  SYNC1; 
-                ENTRY  SYNC2; 
- 
- 
-           END  REGISTER; 
- 
- 
-           TASK BODY  REGISTER  IS
- 
- 
-                TASK TYPE  SECONDARY  IS
- 
- 
-                     ENTRY  WAIT_INDEFINITELY; 
- 
-                END  SECONDARY; 
- 
- 
-                TASK TYPE  T_TYPE1  IS
- 
- 
-                     ENTRY  E; 
- 
-                END  T_TYPE1; 
- 
- 
-                TASK TYPE  T_TYPE2  IS
- 
- 
-                     ENTRY  E; 
- 
-                END  T_TYPE2; 
- 
- 
-                T_OBJECT1 : T_TYPE1; 
-                T_OBJECT2 : T_TYPE2; 
- 
- 
-                TASK BODY  SECONDARY  IS
-                BEGIN
-                     SYNC1; 
-                     ABORT  T_OBJECT1; 
-                     DELAY 0.0; 
-                     TASK_NOT_ABORTED  :=  TRUE; 
-                END  SECONDARY; 
- 
- 
-                TASK BODY  T_TYPE1  IS
- 
-                     TYPE  ACCESS_TO_TASK  IS  ACCESS SECONDARY; 
-   
-                BEGIN
- 
- 
-                     DECLARE
-                          DEPENDENT_BY_ACCESS   :  ACCESS_TO_TASK  :=
-                                                   NEW  SECONDARY ; 
-                     BEGIN
-                          NULL;
-                     END; 
- 
- 
-                     BIRTHS_AND_DEATHS; 
-                                      -- DURING THIS SUSPENSION
-                                      --     MOST OF THE TASKS
-                                      --     ARE ABORTED   (FIRST
-                                      --     TASK #1    -- T_OBJECT1 --
-                                      --     THEN  #2 ).
- 
- 
-                     TASK_NOT_ABORTED := TRUE; 
- 
- 
-                END  T_TYPE1; 
- 
- 
-                TASK BODY  T_TYPE2  IS
- 
-                     TASK  INNER_TASK  IS
- 
- 
-                          ENTRY  WAIT_INDEFINITELY; 
- 
-                     END  INNER_TASK; 
- 
-                     TASK BODY  INNER_TASK  IS
-                     BEGIN
-                          SYNC2; 
-                          ABORT  T_OBJECT2; 
-                          DELAY 0.0; 
-                          TASK_NOT_ABORTED  :=  TRUE; 
-                     END  INNER_TASK; 
- 
-                BEGIN
- 
- 
-                     BIRTHS_AND_DEATHS; 
-                                      -- DURING THIS SUSPENSION
-                                      --     MOST OF THE TASKS
-                                      --     ARE ABORTED   (FIRST
-                                      --     TASK #1     -- T_OBJECT1 --
-                                      --     THEN  #2 ).
- 
- 
-                     TASK_NOT_ABORTED := TRUE; 
- 
- 
-                END  T_TYPE2; 
- 
- 
-           BEGIN
- 
-                DECLARE
-                     OLD_COUNT : INTEGER := 0; 
-                BEGIN
- 
- 
-                     FOR  I  IN  1..5  LOOP
-                          EXIT WHEN  BIRTHS_AND_DEATHS'COUNT = 2; 
-                          DELAY 10.0 * Impdef.One_Second;
-                     END LOOP;
- 
-                     OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 
- 
-                     IF  OLD_COUNT = 2  THEN
- 
-                          ACCEPT  SYNC1;   -- ALLOWING  ABORT#1
- 
-                          DELAY IMPDEF.CLEAR_READY_QUEUE;
- 
-                          -- CHECK THAT  #1  WAS ABORTED  -  3 WAYS:
- 
-                          BEGIN
-                               T_OBJECT1.E; 
-                               FAILED( "T_OBJECT1.E  DID NOT RAISE" &
-                                                    "  TASKING_ERROR" );
-                          EXCEPTION
- 
-                               WHEN TASKING_ERROR  =>
-                                    NULL;
- 
-                               WHEN OTHERS  =>
-                                    FAILED("OTHER EXCEPTION RAISED - 1");
- 
-                          END; 
- 
-                          IF T_OBJECT1'CALLABLE  THEN
-                               FAILED( "T_OBJECT1'CALLABLE = TRUE" );
-                          END IF;
- 
-                          IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
-                          THEN
-                               FAILED( "TASK#1 NOT REMOVED FROM QUEUE" );
-                          END IF;
- 
- 
-                          OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 
- 
- 
-                          ACCEPT  SYNC2;   -- ALLOWING  ABORT#2
-                          
-                          DELAY IMPDEF.CLEAR_READY_QUEUE;
- 
-                          -- CHECK THAT  #2  WAS ABORTED  -  3 WAYS:
- 
-                          BEGIN
-                               T_OBJECT2.E; 
-                               FAILED( "T_OBJECT2.E  DID NOT RAISE" &
-                                                    "  TASKING_ERROR" );
-                          EXCEPTION
- 
-                               WHEN TASKING_ERROR  =>
-                                    NULL;
- 
-                               WHEN OTHERS  =>
-                                    FAILED("OTHER EXCEPTION RAISED - 2");
- 
-                          END; 
- 
-                          IF T_OBJECT2'CALLABLE  THEN
-                               FAILED( "T_OBJECT2'CALLABLE = TRUE" );
-                          END IF;
- 
-                          IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
-                          THEN
-                               FAILED( "TASK#2 NOT REMOVED FROM QUEUE" );
-                          END IF;
- 
- 
-                          IF  BIRTHS_AND_DEATHS'COUNT /= 0  THEN
-                               FAILED( "SOME TASKS STILL QUEUED" );
-                          END IF;
-   
- 
-                     ELSE
- 
-                          COMMENT( "LINEUP NOT COMPLETE (AFTER 50 S.)" );
-                          TEST_VALID  :=  FALSE; 
- 
-                     END IF;
- 
- 
-                END; 
- 
- 
-                WHILE  BIRTHS_AND_DEATHS'COUNT > 0  LOOP
-                     ACCEPT  BIRTHS_AND_DEATHS; 
-                END LOOP;
- 
- 
-           END  REGISTER; 
- 
- 
-      BEGIN
- 
-           NULL;
- 
-      END; 
- 
- 
-      -------------------------------------------------------------------
- 
- 
-      IF  TEST_VALID  AND  TASK_NOT_ABORTED  THEN
-           FAILED( "SOME TASKS NOT ABORTED" );
-      END IF;
- 
- 
-      RESULT;
- 
- 
- END  C9A007A; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- C9A009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- TEST ABORT DURING RENDEZVOUS
- 
- -- CALLING TASK IN RENDEVOUS IS NAMED IN ABORT STATEMENT.
- 
- -- JEAN-PIERRE ROSEN 09 MARCH 1984
- -- JBG 6/1/84
- -- JWC 6/28/85   RENAMED FROM C9A009D-B.ADA
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C9A009A IS
- 
- BEGIN
- 
-      TEST("C9A009A", "CALLING TASK IS ABORTED DIRECTLY");
- 
-      DECLARE
-      -- T1 CALLS T2, WHICH ABORTS T1 WHILE IN RENDEVOUS
- 
-           T2_CONTINUED : BOOLEAN := FALSE;
- 
-           TASK CONTINUED IS
-                ENTRY GET (T2_CONTINUED : OUT BOOLEAN);
-                ENTRY PUT (T2_CONTINUED : IN  BOOLEAN);
-           END CONTINUED;
- 
-           TASK BODY CONTINUED IS
-                CONTINUED : BOOLEAN := FALSE;
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT GET (T2_CONTINUED : OUT BOOLEAN) DO
-                               T2_CONTINUED := CONTINUED;
-                          END GET;
-                     OR
-                          ACCEPT PUT (T2_CONTINUED : IN BOOLEAN) DO
-                               CONTINUED := T2_CONTINUED;
-                          END PUT;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END CONTINUED;
- 
-      BEGIN     -- THIS BLOCK WILL MAKE SURE T2 IS TERMINATED, AND SO,
-                -- T2_CONTINUED IS ASSIGNED A VALUE IF T2 CONTINUES
-                -- EXECUTION CORRECTLY.
- 
-           DECLARE
- 
-                TASK T1;
- 
-                TASK T2 IS
-                     ENTRY E1;
-                END T2;
- 
-                TASK BODY T1 IS
-                BEGIN
-                     T2.E1;
-                     FAILED ("T1 NOT ABORTED");
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          FAILED ("TASKING_ERROR RAISED IN T1");
-                     WHEN OTHERS =>
-                          FAILED ("OTHER EXCEPTION RAISED - T1");
-                END T1;
- 
-                TASK BODY T2 IS
-                BEGIN
-                     ACCEPT E1 DO
-                          ABORT T1;
-                          ABORT T1;
-                          ABORT T1; -- WHY NOT?
-                          IF T1'TERMINATED THEN
-                               FAILED ("T1 PREMATURELY TERMINATED");
-                          END IF;
-                     END E1;
-                     CONTINUED.PUT (T2_CONTINUED => TRUE);
-                END T2;
-           BEGIN
-                NULL;
-           END;
-      -- T2 NOW TERMINATED
-           CONTINUED.GET (T2_CONTINUED);
-           IF NOT T2_CONTINUED THEN
-                FAILED ("WHEN CALLER WAS ABORTED IN RENDEVOUS, CALLED " &
-                        "TASK DID NOT CONTINUE");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END C9A009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C9A009C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- TEST ABORT DURING RENDEZVOUS
- 
- -- THE CALLING TASK IN THE RENDEVOUS IS DEPENDENT ON THE ABORTED TASK,
- -- SO THE DEPENDENT TASK IS INDIRECTLY ABORTED WHILE IN A RENDEVOUS;
- -- NEITHER THE CALLING TASK NOR ITS MASTER CAN BE TERMINATED WHILE THE
- -- RENDEVOUS CONTINUES.
- 
- -- JEAN-PIERRE ROSEN 09 MARCH 1984
- -- JBG 6/1/84
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C9A009C IS
- 
- BEGIN 
- 
-      TEST("C9A009C", "DEPENDENT TASK IN RENDEVOUS WHEN MASTER IS " &
-                      "ABORTED");
- 
-      DECLARE
-      -- T2 CONTAINS DEPENDENT TASK T3 WHICH CALLS T1.
-      -- T1 ABORTS T2 WHILE IN RENDEVOUS WITH T3.
- 
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
- 
-           TASK BODY T1 IS
-       
-                TASK T2;
-      
-                TASK BODY T2 IS
-                     TASK T3;
-                     TASK BODY T3 IS
-                     BEGIN
-                          T1.E1;
-                          FAILED ("T3 NOT ABORTED");
-                     EXCEPTION
-                          WHEN TASKING_ERROR =>
-                               FAILED ("TASKING_ERROR IN T3");
-                          WHEN OTHERS =>
-                               FAILED ("OTHER EXCEPTION IN T3");
-                     END;
-                BEGIN     -- T3 ACTIVATED NOW
-                     NULL;
-                END T2;
-      
-           BEGIN     -- T1
-                ACCEPT E1 DO
-                     ABORT T2;
-                     ABORT T2;
-                     ABORT T2; -- WHY NOT?
-                     IF T2'TERMINATED THEN
-                          FAILED ("T2 TERMINATED PREMATURELY");
-                     END IF;
-                END E1;
-           EXCEPTION
-                WHEN TASKING_ERROR =>
-                     FAILED ("TASKING_ERROR IN T1 BECAUSE CALLING TASK "&
-                             "WAS ABORTED");
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION - T1");
-           END T1;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END C9A009C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- C9A009F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK ABORTED DURING AN ENTRY CALL IS NOT TERMINATED
- -- BEFORE THE END OF THE RENDEZVOUS.
- 
- -- JEAN-PIERRE ROSEN 16-MAR-1984
- -- JBG 6/1/84
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT,SYSTEM; 
- USE REPORT,SYSTEM;
- PROCEDURE C9A009F IS
- 
- 
-      TASK BLOCKING IS
-           ENTRY START;
-           ENTRY STOP;
-           ENTRY RESTART;
-           ENTRY NO_CALL;
-      END BLOCKING;
- 
-      TASK BODY BLOCKING IS
-      BEGIN
-           SELECT
-                ACCEPT STOP DO
-                     ACCEPT START;
-                     ACCEPT RESTART;
-                END;
-           OR TERMINATE;
-           END SELECT;
-      END;
- 
- BEGIN
- 
-      TEST("C9A009F", "ABORTED TASK NOT TERMINATED BEFORE END OF " &
-                      "RENDEVOUS");
- 
-      DECLARE         -- T1 ABORTED WHILE IN RENDEVOUS WITH BLOCKING.
- 
-           TASK T1 IS
-           END T1;                              
-           TASK BODY T1 IS
-           BEGIN
-                BLOCKING.STOP;
-                FAILED ("T1 NOT ABORTED");
-           END;
-      
-      BEGIN
-           BLOCKING.START;          -- ALLOWS T1 TO ENTER RENDEVOUS
- 
-           ABORT T1;
- 
-           IF T1'CALLABLE THEN
-                FAILED("T1 STILL CALLABLE - 1");
-           END IF;
- 
-           IF T1'TERMINATED THEN    -- T1 STILL IN RENDEVOUS
-                FAILED("T1 PREMATURELY TERMINATED - 1");
-           END IF;
- 
-           BLOCKING.RESTART;
-      END;
- 
-      RESULT;
- 
- END C9A009F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- C9A009G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A MASTER ABORTED WITH SUBTASKS IN AN ENTRY CALL BECOMES
- -- COMPLETED, BUT NOT TERMINATED, BEFORE THE END OF THE RENDEZVOUS.
- 
- -- JEAN-PIERRE ROSEN 16-MAR-1984
- -- JBG 6/1/84
- -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
- 
- WITH REPORT,SYSTEM; 
- USE REPORT,SYSTEM;
- PROCEDURE C9A009G IS
- 
- 
-      TASK BLOCKING IS
-           ENTRY START;
-           ENTRY STOP;
-           ENTRY RESTART;
-           ENTRY NO_CALL;
-      END BLOCKING;
- 
-      TASK BODY BLOCKING IS
-      BEGIN
-           SELECT
-                ACCEPT STOP DO
-                     ACCEPT START;
-                     ACCEPT RESTART;
-                END;
-           OR TERMINATE;
-           END SELECT;
-      END;
- 
- BEGIN
- 
-      TEST("C9A009G", "MASTER COMPLETED BUT NOT TERMINATED");
- 
-      DECLARE         -- T1 ABORTED WHILE DEPENDENT TASK IN RENDEVOUS 9C?
- 
-           TASK T1 IS
-                ENTRY LOCK;
-           END T1;                              
-      
-           TASK BODY T1 IS
-                TASK T2;
-      
-                TASK BODY T2 IS
-                BEGIN
-                     BLOCKING.STOP;
-                     FAILED ("T2 NOT ABORTED");
-                END;
-           BEGIN
-                BLOCKING.NO_CALL;          -- WILL DEADLOCK UNTIL ABORT
-           END T1;
-      
-      BEGIN
-           BLOCKING.START;
-           ABORT T1;
- 
-           IF T1'CALLABLE THEN
-                FAILED("T1 STILL CALLABLE - 2");
-           END IF;
- 
-           IF T1'TERMINATED THEN    -- T1'S DEPENDENT TASK, T2, STILL IN
-                                    -- RENDEVOUS 
-                FAILED("T1 PREMATURELY TERMINATED - 2");
-           END IF;
- 
-           BLOCKING.RESTART;
-      END;
- 
-      RESULT;
- 
- END C9A009G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a009h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a009h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- C9A009H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A TASK ABORTED DURING A RENDEVOUS IS NEITHER CALLABLE NOR
- -- TERMINATED BEFORE THE END OF THE RENDEVOUS.
- 
- -- J.P ROSEN, ADA PROJECT, NYU
- -- JBG 6/1/84
- 
- WITH REPORT; USE REPORT;
- PROCEDURE C9A009H IS
- BEGIN
-      TEST ("C9A009H", "TASK ABORTED IN RENDEVOUS IS NOT CALLABLE OR " &
-                       "TERMINATED");
- 
-      DECLARE
- 
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
- 
-           TASK T2 IS
-           END T2;
- 
-           TASK BODY T2 IS
-           BEGIN
-                T1.E1;
-                FAILED ("T2 NOT ABORTED");
-           EXCEPTION
-                WHEN TASKING_ERROR =>
-                     FAILED ("TASKING_ERROR RAISED IN ABORTED TASK");
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED");
-           END T2;
- 
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E1 DO
-                     ABORT T2;
-                     IF T2'CALLABLE THEN
-                          FAILED ("T2 STILL CALLABLE");
-                     END IF;
- 
-                     IF T2'TERMINATED THEN
-                          FAILED ("T2 TERMINATED");
-                     END IF;
-                END E1;
-           END T1;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- 
- END C9A009H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- C9A010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- TEST ABORT DURING RENDEZVOUS
- 
- -- ABORTING AN ABNORMAL (NOT YET TERMINATED) TASK.
- 
- -- JEAN-PIERRE ROSEN 09 MARCH 1984
- -- JBG 6/1/84
- -- JWC 6/28/85   RENAMED FROM C9A009E-B.ADA
- -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C9A010A IS
- 
- BEGIN
- 
-      TEST("C9A010A", "ABORTING AN ABNORMAL TASK");
- 
-      DECLARE
-      -- T1 CALLS T2.  WHILE IN RENDEVOUS, T2 ABORTS T1 AND WAITS FOR A
-      -- CALL FROM THE MAIN PROGRAM.  WHEN THE CALL IS ACCEPTED, THE MAIN
-      -- PROGRAM AGAIN ABORTS T1, WHICH IS NOW ABNORMAL, SINCE T1 HAS NOT
-      -- YET COMPLETED ITS RENDEVOUS WITH T2.
- 
-           TASK T1 IS
-           END T1;
- 
-           TASK T2 IS
-                ENTRY E1;
-                ENTRY E2;
-           END T2;
- 
-           TASK BODY T1 IS
-           BEGIN
-                T2.E1;
-                FAILED("T1 NOT ABORTED");
-           EXCEPTION
-                WHEN TASKING_ERROR =>
-                     FAILED ("TASKING_ERROR IN T1");
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION IN T1");
-           END T1;
- 
-           TASK BODY T2 IS
-           BEGIN
-                ACCEPT E1 DO
-                     ABORT  T1;
-                     ACCEPT E2;     -- NOTE CALLER REMAINS IN RENDEVOUS
-                     ACCEPT E2;     -- UNTIL TWO ENTRY CALLS ACCEPTED
-                END E1;
-           END T2;
-      BEGIN
-           T2.E2;    -- ONLY ACCEPTED AFTER T1 HAS BEEN ABORTED.
-           ABORT T1; -- T1 IS ABNORMAL BECAUSE IT IS STILL IN RENDEVOUS.
-           IF T1'CALLABLE THEN
-                FAILED ("T1 CALLABLE AFTER BEING ABORTED");
-           END IF;
-           IF T1'TERMINATED THEN
-                FAILED ("T1 TERMINATED ALTHOUGH IN RENDEVOUS");
-           END IF;
-           T2.E2; -- T1'S RENDEVOUS CAN NOW COMPLETE; T1 CAN TERMINATE.
-      END;
- 
-      RESULT;
- 
- END C9A010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- C9A011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A CALLED TASK IS ABORTED WHILE IN RENDEZVOUS, THEN
- --     "TASKING_ERROR" IS RAISED IN THE CALLING TASK.
- 
- -- HISTORY:
- --     DHH 03/28/88 CREATED ORIGINAL TEST.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C9A011A IS
- 
-      TASK TYPE CHOICE IS
-           ENTRY E1;
-      END CHOICE;
- 
-      T : CHOICE;
- 
-      TASK BODY CHOICE IS
-           X : INTEGER;
-      BEGIN
-           ACCEPT E1 DO
-                X := IDENT_INT(3);
-                IF EQUAL(X,X) THEN
-                     ABORT CHOICE;
-                END IF;
-           END E1;
-      END CHOICE;
- 
- BEGIN
- 
-      TEST("C9A011A", "CHECK THAT IF A CALLED TASK IS ABORTED WHILE " &
-                      "IN RENDEZVOUS, THEN ""TASKING_ERROR"" IS " &
-                      "RAISED IN THE CALLING TASK");
- 
-      T.E1;
-      FAILED("EXCEPTION NOT RAISED ON ABORT");
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN TASKING_ERROR =>
-           RESULT;
- 
-      WHEN OTHERS =>
-           FAILED("UNEXPECTED EXCEPTION RAISED ON ABORT");
-           RESULT;
- END C9A011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a011b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/c9/c9a011b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/c9/c9a011b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- C9A011B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT "TASKING_ERROR" IS RAISED BY A TIMED ENTRY CALL IF
- --     THE CALLED TASK IS ABORTED BEFORE THE DELAY EXPIRES BUT NOT
- --     WHEN THE CALL IS FIRST EXECUTED.
- 
- -- HISTORY:
- --     DHH 06/14/88 CREATED ORIGINAL TEST.
- 
- with Impdef;
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE C9A011B IS
- 
-      TASK TIMED_ENTRY IS
-           ENTRY WAIT_AROUND;
-      END TIMED_ENTRY;
- 
-      TASK OWNER IS
-           ENTRY START;
-           ENTRY SELF_ABORT;
-      END OWNER;
- 
-      TASK BODY TIMED_ENTRY IS
-      BEGIN
-           SELECT
-                OWNER.SELF_ABORT;
-           OR
-                DELAY 60.0 * Impdef.One_Second;
-           END SELECT;
-           FAILED("NO EXCEPTION RAISED");
- 
-           ACCEPT WAIT_AROUND;
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                ACCEPT WAIT_AROUND;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION RAISED");
-                ACCEPT WAIT_AROUND;
-      END TIMED_ENTRY;
- 
-      TASK BODY OWNER IS
-      BEGIN
-           ACCEPT START DO
-                WHILE SELF_ABORT'COUNT = 0 LOOP
-                     DELAY 1.0 * Impdef.One_Second;
-                END LOOP;
-           END START;
- 
-           ABORT OWNER;
- 
-           ACCEPT SELF_ABORT;
- 
-      END OWNER;
- 
- BEGIN
- 
-      TEST("C9A011B", "CHECK THAT ""TASKING_ERROR"" IS RAISED BY A " &
-                      "TIMED ENTRY CALL IF THE CALLED TASK IS " &
-                      "ABORTED BEFORE THE DELAY EXPIRES BUT NOT " &
-                      "WHEN THE CALL IS FIRST EXECUTED");
- 
-      OWNER.START;
-      DELAY 5.0 * Impdef.One_Second;
- 
-      IF TIMED_ENTRY'CALLABLE THEN
-           TIMED_ENTRY.WAIT_AROUND;
-      ELSE
-           FAILED("TASK ABORTED WHEN TASKING ERROR IS RAISED");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED("EXCEPTION RAISED OUTSIDE OF TASK");
-           RESULT;
- 
- END C9A011B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- CA1003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT MORE THAN ONE COMPLETELY INDEPENDENT COMPILATION
- -- UNIT CAN BE SUBMITTED IN A SINGLE FILE.
- 
- -- JRK 5/13/81
- -- JBG 8/25/83
- 
- PROCEDURE CA1003A_P (I : IN OUT INTEGER) IS
- BEGIN
-      I := I + 1;
- END CA1003A_P;
- 
- 
- PACKAGE CA1003A_PKG IS
-      I : INTEGER := 0;
- END CA1003A_PKG;
- 
- 
- FUNCTION CA1003A_F (I : INTEGER) RETURN INTEGER IS
- BEGIN
-      RETURN -I;
- END CA1003A_F;
- 
- 
- WITH REPORT, CA1003A_P, CA1003A_PKG, CA1003A_F;
- USE REPORT;
- 
- PROCEDURE CA1003A IS
- 
-      I : INTEGER := IDENT_INT (0);
- 
- BEGIN
-      TEST ("CA1003A", "INDEPENDENT UNITS IN A SINGLE FILE");
- 
-      CA1003A_P (I);
-      IF I /= 1 THEN
-           FAILED ("INDEPENDENT PROCEDURE NOT INVOKED");
-      END IF;
- 
-      CA1003A_PKG.I := CA1003A_PKG.I + IDENT_INT(10);
-      IF CA1003A_PKG.I /= 10 THEN
-           FAILED ("INDEPENDENT PACKAGE VARIABLE ACCESSED INCORRECTLY");
-      END IF;
- 
-      IF CA1003A_F(IDENT_INT(5)) /= -5 THEN
-           FAILED ("INDEPENDENT FUNCTION NOT INVOKED");
-      END IF;
- 
-      RESULT;
- END CA1003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CA1004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A PACKAGE DECLARATION AND BODY CAN BE
- -- SUBMITTED TOGETHER FOR COMPILATION.
- 
- -- JRK 5/12/81
- 
- 
- PACKAGE CA1004A_PKG IS
- 
-      I : INTEGER := 0;
- 
-      PROCEDURE P (I : IN OUT INTEGER);
- 
- END CA1004A_PKG;
- 
- 
- PACKAGE BODY CA1004A_PKG IS
- 
-      PROCEDURE P (I : IN OUT INTEGER) IS
-      BEGIN
-           I := I + 1;
-      END P;
- 
- BEGIN
- 
-      I := 10;
- 
- END CA1004A_PKG;
- 
- 
- WITH REPORT, CA1004A_PKG;
- USE REPORT;
- 
- PROCEDURE CA1004A IS
- 
-      I : INTEGER := IDENT_INT (0);
- 
- BEGIN
-      TEST ("CA1004A", "A PACKAGE DECLARATION AND BODY SUBMITTED " &
-            "TOGETHER");
- 
-      CA1004A_PKG.I := CA1004A_PKG.I + IDENT_INT(5);
-      IF CA1004A_PKG.I /= 15 THEN
-           FAILED ("PACKAGED VARIABLE NOT ACCESSIBLE OR " &
-                   "PACKAGE BODY NOT EXECUTED");
-      END IF;
- 
-      CA1004A_PKG.P (I);
-      IF I /= 1 THEN
-           FAILED ("PACKAGED PROCEDURE NOT EXECUTED");
-      END IF;
- 
-      RESULT;
- END CA1004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- CA1005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SUBPROGRAM DECLARATION AND BODY CAN BE
- -- SUBMITTED TOGETHER FOR COMPILATION.
- 
- -- JRK 5/14/81
- 
- 
- FUNCTION CA1005A_F (I : INTEGER) RETURN INTEGER;
- 
- 
- FUNCTION CA1005A_F (I : INTEGER) RETURN INTEGER IS
- BEGIN
-      RETURN I + 1;
- END CA1005A_F;
- 
- 
- PROCEDURE CA1005A_P (I : IN OUT INTEGER);
- 
- 
- PROCEDURE CA1005A_P (I : IN OUT INTEGER) IS
- BEGIN
-      I := -I;
- END CA1005A_P;
- 
- 
- WITH REPORT, CA1005A_F, CA1005A_P;
- USE REPORT;
- 
- PROCEDURE CA1005A IS
- 
-      I : INTEGER := IDENT_INT (7);
- 
- BEGIN
-      TEST ("CA1005A", "SUBPROGRAM DECLARATIONS AND BODIES " &
-            "SUBMITTED TOGETHER");
- 
-      IF CA1005A_F (IDENT_INT(2)) /= 3 THEN
-           FAILED ("FUNCTION NOT EXECUTED");
-      END IF;
- 
-      CA1005A_P (I);
-      IF I /= -7 THEN
-           FAILED ("PROCEDURE NOT EXECUTED");
-      END IF;
- 
-      RESULT;
- END CA1005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- CA1006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A LIBRARY UNIT AND ITS SUBUNITS CAN BE
- -- SUBMITTED TOGETHER FOR COMPILATION.
- 
- -- JRK 5/14/81
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CA1006A IS
- 
-      I : INTEGER := IDENT_INT (0);
- 
-      PACKAGE CALL_TEST IS
-      END CALL_TEST;
- 
-      PACKAGE BODY CALL_TEST IS
-      BEGIN
-           TEST ("CA1006A", "A LIBRARY UNIT AND ITS SUBUNITS " &
-                 "SUBMITTED TOGETHER");
-      END CALL_TEST;
- 
-      FUNCTION F (I : INTEGER) RETURN INTEGER IS SEPARATE;
- 
-      PACKAGE PKG IS
-           I : INTEGER := IDENT_INT (0);
-           PROCEDURE P (I : IN OUT INTEGER);
-      END PKG;
- 
-      PACKAGE BODY PKG IS SEPARATE;
- 
-      PROCEDURE P (I : IN OUT INTEGER) IS SEPARATE;
- 
- BEGIN
- 
-      IF PKG.I /= 10 THEN
-           FAILED ("PACKAGE BODY STATEMENTS NOT EXECUTED");
-      END IF;
- 
-      IF F(IDENT_INT(5)) /= -5 THEN
-           FAILED ("FUNCTION NOT ELABORATED/EXECUTED");
-      END IF;
- 
-      PKG.P (I);
-      IF I /= 3 THEN
-           FAILED ("PACKAGED PROCEDURE NOT ELABORATED/EXECUTED");
-      END IF;
- 
-      I := IDENT_INT (-20);
-      P (I);
-      IF I /= -24 THEN
-           FAILED ("PROCEDURE NOT ELABORATED/EXECUTED");
-      END IF;
- 
-      RESULT;
- END CA1006A;
- 
- 
- SEPARATE (CA1006A)
- FUNCTION F (I : INTEGER) RETURN INTEGER IS
- BEGIN
-      RETURN -I;
- END F;
- 
- 
- SEPARATE (CA1006A)
- PACKAGE BODY PKG IS
- 
-      PROCEDURE P (I : IN OUT INTEGER) IS
-      BEGIN
-           I := I + 3;
-      END P;
- 
- BEGIN
-      I := I + 10;
- END PKG;
- 
- 
- SEPARATE (CA1006A)
- PROCEDURE P (I : IN OUT INTEGER) IS
- BEGIN
-      I := I - 4;
- END P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,35 ****
- -- CA1011A0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/20/84
- -- JBG 5/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CA1011A0 (X : IN OUT INTEGER; Y : IN INTEGER := 2) IS
- BEGIN
- 
-      X := Y;
-      FAILED ("DID NOT REPLACE CA1011A0");
- 
- END CA1011A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- CA1011A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/20/84
- -- JBG 5/23/85
- 
- PROCEDURE CA1011A0 (X : IN OUT INTEGER;
-                     Y : IN INTEGER  := -1;        
-                     Z : IN INTEGER := 2) IS        
- 
- BEGIN
- 
-      X := 3;
- 
- END CA1011A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,35 ****
- -- CA1011A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/20/84
- -- JBG 5/23/85
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CA1011A2 (X : INTEGER := 1; Y : IN OUT FLOAT) IS
- BEGIN
- 
-      Y := 2.0;
-      FAILED ("DID NOT REPLACE CA1011A2");
- 
- END CA1011A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA1011A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/20/84
- -- JBG 5/23/85
- 
- PROCEDURE CA1011A2 (X : BOOLEAN := TRUE;
-                     Y : IN OUT FLOAT) IS
- BEGIN
- 
-      Y := 3.0;
- 
- END CA1011A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,35 ****
- -- CA1011A4.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/20/84
- -- JBG 5/23/85
- 
- WITH REPORT; USE REPORT;
- FUNCTION CA1011A4 RETURN INTEGER IS
- BEGIN
- 
-      FAILED ("DID NOT REPLACE CA1011A4");
-      RETURN 2;
- 
- END CA1011A4;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,33 ****
- -- CA1011A5.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/20/84
- -- JBG 5/23/85
- 
- FUNCTION CA1011A4 RETURN FLOAT IS
- BEGIN
- 
-      RETURN 3.0;
- 
- END CA1011A4;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- CA1011A6M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A SUBPROGRAM BODY IS INITIALLY COMPILED, SUBSEQUENT
- -- ATTEMPTS TO COMPILE A SUBPROGRAM BODY WITH A DIFFERENT PARAMETER AND
- -- RESULT TYPE PROFILE ARE ACCEPTED (SEE AI-00199).
- 
- -- SEPARATE FILES ARE:
- --     CA1011A0  A LIBRARY PROCEDURE (CA1011A0).
- --     CA1011A1  A LIBRARY PROCEDURE (CA1011A0).
- --     CA1011A2  A LIBRARY PROCEDURE (CA1011A2).
- --     CA1011A3  A LIBRARY PROCEDURE (CA1011A2).
- --     CA1011A4  A LIBRARY FUNCTION  (CA1011A4).
- --     CA1011A5  A LIBRARY FUNCTION  (CA1011A4).
- --     CA1011A6M THE MAIN PROCEDURE.
- 
- -- BHS 7/20/84
- -- JBG 5/23/85
- 
- WITH CA1011A0, CA1011A2, CA1011A4;
- WITH REPORT; USE REPORT;
- PROCEDURE CA1011A6M IS
- 
-      I : INTEGER := 5;
-      J : FLOAT := 4.0;
- 
- BEGIN
- 
-      TEST("CA1011A", "ATTEMPTS TO RECOMPILE A SUBPROGRAM WITH " &
-                      "NONCONFORMING PARAMETER OR RESULT TYPE "  &
-                      "PROFILES ARE ACCEPTED");
- 
-      CA1011A0(X => I);             -- EXPECT DEFAULT Y
-      IF I = 3 THEN
-           COMMENT ("SECOND DECLARATION OF CA1011A0 INVOKED CORRECTLY");
-      END IF;
- 
-      CA1011A2(Y => J);             -- USE DEFAULT X.
-      IF J = 3.0 THEN
-           COMMENT ("SECOND DECLARATION OF CA1011A2 INVOKED CORRECTLY");
-      END IF;
- 
-      I := INTEGER(CA1011A4);
-      IF I = 3 THEN
-           COMMENT ("SECOND DECLARATION OF CA1011A4 INVOKED CORRECTLY");
-      END IF;
- 
-      RESULT;
- 
- END CA1011A6M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,41 ****
- -- CA1012A0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- GENERIC PROCEDURE DECLARATION.
- -- BODY IS IN CA1012A1.DEP.
- -- INSTANTIATION IS IN CA1012A4M.DEP.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     WKB 07/20/81  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
- --                   AND CLARIFY POSSIBLE NON-APPLICABILITY.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- GENERIC
-      TYPE INDEX IS RANGE <>;
- PROCEDURE CA1012A0 (I : IN OUT INDEX);
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,45 ****
- -- CA1012A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- GENERIC PROCEDURE BODY.
- -- DECLARATION IS IN CA1012A0.DEP.
- -- INSTANTIATION IN CA1012A4M.DEP.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     WKB 07/20/81  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
- --                   IN TEST AND POSSIBLE NON-APPLICABILITY.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- PROCEDURE CA1012A0 (I : IN OUT INDEX) IS
- 
- BEGIN
- 
-      I := I + 1;
- 
- END CA1012A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,41 ****
- -- CA1012A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- GENERIC FUNCTION DECLARATION.
- -- BODY IS IN CA1012A3.DEP.
- -- INSTANTIATION IS IN CA1012A4M.DEP.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     WKB 07/20/81  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
- --                   AND POSSIBLE NON-APPLICABILITY.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- GENERIC
-      TYPE ELEMENT IS RANGE <>;
- FUNCTION CA1012A2 (J : IN ELEMENT) RETURN ELEMENT;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,45 ****
- -- CA1012A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- GENERIC FUNCTION BODY.
- -- DECLARATION IS IN CA1012AB.DEP.
- -- INSTANTIATION IS IN CA1012A4B.DEP.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     WKB 07/20/81  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
- --                   AND POSSIBLE NON-APPLICABILITY.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- FUNCTION CA1012A2 (J : IN ELEMENT) RETURN ELEMENT IS
- 
- BEGIN
- 
-      RETURN J + 1;
- 
- END CA1012A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- CA1012A4M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GENERIC SUBPROGRAM DECLARATIONS AND BODIES CAN BE
- --     COMPILED SEPARATELY.
- 
- -- SEPARATE FILES ARE:
- --   CA1012A0  A LIBRARY GENERIC PROCEDURE DECLARATION.
- --   CA1012A1  A LIBRARY GENERIC PROCEDURE BODY (CA1012A0).
- --   CA1012A2  A LIBRARY GENERIC FUNCTION DECLARATION.
- --   CA1012A3  A LIBRARY GENERIC FUNCTION BODY (CA1012A2).
- --   CA1012A4M THE MAIN PROCEDURE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
- --     THIS WAS NOT REQUIRED FOR ADA 83.
- 
- -- HISTORY:
- --     WKB 07/20/81  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED COMMENTS REGARDING NON-APPLICABILITY.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- --     RLB 09/15/99  REMOVED OBSOLETE COMMENT.
- 
- WITH REPORT, CA1012A0, CA1012A2;
- USE REPORT;
- PROCEDURE CA1012A4M IS
- 
-      N : INTEGER := 1;
- 
-      SUBTYPE S50 IS INTEGER RANGE 1..50;
- 
-      PROCEDURE P IS NEW CA1012A0 (S50);
- 
-      FUNCTION F IS NEW CA1012A2 (INTEGER);
- 
- BEGIN
-      TEST ("CA1012A", "SEPARATELY COMPILED GENERIC SUBPROGRAM " &
-                       "DECLARATIONS AND BODIES");
- 
-      P(N);
-      IF N /= 2 THEN
-           FAILED ("PROCEDURE NOT INVOKED");
-      END IF;
- 
-      N := 1;
-      IF F(N) /= 2 THEN
-           FAILED ("FUNCTION NOT INVOKED");
-      END IF;
- 
-      RESULT;
- END CA1012A4M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,37 ****
- -- CA1012B0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- 
- GENERIC
-      TYPE INDEX IS RANGE <>;
- PROCEDURE CA1012B0 (I : IN OUT INDEX);
- 
- PROCEDURE CA1012B0 (I : IN OUT INDEX) IS
- 
- BEGIN
- 
-      I := I + 1;
- 
- END CA1012B0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,37 ****
- -- CA1012B2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- 
- GENERIC
-      TYPE ELEMENT IS RANGE <>;
- FUNCTION CA1012B2 (J : IN ELEMENT) RETURN ELEMENT;
- 
- FUNCTION CA1012B2 (J : IN ELEMENT) RETURN ELEMENT IS
- 
- BEGIN
- 
-      RETURN J + 1;
- 
- END CA1012B2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- CA1012B4M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT GENERIC SUBPROGRAM DECLARATIONS AND BODIES CAN BE
- --   COMPILED SEPARATELY.
- 
- -- SEPARATE FILES ARE:
- --   CA1012B0  A LIBRARY GENERIC PROCEDURE DECLARATION AND BODY.
- --   CA1012B2  A LIBRARY GENERIC FUNCTION DECLARATION AND BODY.
- --   CA1012B4M THE MAIN PROCEDURE.
- 
- -- WKB 7/20/81
- 
- WITH REPORT, CA1012B0, CA1012B2;
- USE REPORT;
- PROCEDURE CA1012B4M IS
- 
-      N : INTEGER := 1;
- 
-      SUBTYPE S50 IS INTEGER RANGE 1..50;
- 
-      PROCEDURE P IS NEW CA1012B0 (S50);
- 
-      FUNCTION F IS NEW CA1012B2 (INTEGER);
- 
- BEGIN
-      TEST ("CA1012B", "SEPARATELY COMPILED GENERIC SUBPROGRAM " &
-                       "DECLARATIONS AND BODIES");
- 
-      P(N);
-      IF N /= 2 THEN
-           FAILED ("PROCEDURE NOT INVOKED");
-      END IF;
- 
-      N := 1;
-      IF F(N) /= 2 THEN
-           FAILED ("FUNCTION NOT INVOKED");
-      END IF;
- 
-      RESULT;
- 
- END CA1012B4M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- CA1013A0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- -- PWN 5/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- 
- GENERIC
-      TYPE ELEM IS RANGE <>;
- PACKAGE CA1013A0 IS
- 
-      I : ELEM;
- 
-      PROCEDURE REQUIRE_BODY;
- 
- END CA1013A0;
- 
- 
- PACKAGE BODY CA1013A0 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- 
- BEGIN
- 
-      I := 1;
- 
- END CA1013A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,39 ****
- -- CA1013A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- 
- 
- GENERIC
-      TYPE INDEX IS RANGE <>;
- PROCEDURE CA1013A1 (I : IN OUT INDEX);
- 
- 
- PROCEDURE CA1013A1 (I : IN OUT INDEX) IS
- 
- BEGIN
-  
-      I := I + 1;
- 
- END CA1013A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,39 ****
- -- CA1013A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- 
- 
- GENERIC
-      TYPE ITEM IS RANGE <>;
- FUNCTION CA1013A2 RETURN ITEM;
- 
- 
- FUNCTION CA1013A2 RETURN ITEM IS
- 
- BEGIN
- 
-      RETURN 2;
- 
- END CA1013A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,31 ****
- -- CA1013A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- -- SPS 10/27/82
- -- JBG 9/15/83
- 
- WITH CA1013A0; 
- PRAGMA ELABORATE (CA1013A0);
- PACKAGE CA1013A3 IS NEW CA1013A0 (INTEGER);
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,31 ****
- -- CA1013A4.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- -- SPS 10/27/82
- -- JBG 9/15/83
- 
- WITH CA1013A1;
- PRAGMA ELABORATE (CA1013A1);
- PROCEDURE CA1013A4 IS NEW CA1013A1 (INTEGER);
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,30 ****
- -- CA1013A5.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/20/81
- -- JBG 9/15/83
- 
- WITH CA1013A2;
- PRAGMA ELABORATE (CA1013A2);
- FUNCTION CA1013A5 IS NEW CA1013A2 (INTEGER);
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- CA1013A6M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A GENERIC PACKAGE OR SUBPROGRAM INSTANTIATION
- -- CAN BE SUBMITTED FOR SEPARATE COMPILATION.
- 
- -- SEPARATE FILES ARE:
- --   CA1013A0  A LIBRARY GENERIC PACKAGE.
- --   CA1013A1  A LIBRARY GENERIC PROCEDURE.
- --   CA1013A2  A LIBRARY GENERIC FUNCTION.
- --   CA1013A3  A LIBRARY GENERIC PACKAGE INSTANTIATION.
- --   CA1013A4  A LIBRARY GENERIC PROCEDURE INSTANTIATION.
- --   CA1013A5  A LIBRARY GENERIC FUNCTION INSTANTIATION.
- --   CA1013A6M THE MAIN PROCEDURE.
- 
- -- WKB 7/20/81
- -- SPS 11/5/82
- 
- WITH REPORT;
- WITH CA1013A3, CA1013A4, CA1013A5;
- USE REPORT;
- PROCEDURE CA1013A6M IS
- 
-      J : INTEGER := 1;
- 
- BEGIN
-      TEST ("CA1013A", "GENERIC INSTANTIATIONS SUBMITTED " &
-                       "FOR SEPARATE COMPILATION");
- 
-      IF CA1013A3.I /= 1 THEN
-           FAILED ("PACKAGE NOT ACCESSED");
-      END IF;
- 
-      CA1013A4 (J);
-      IF J /= 2 THEN
-           FAILED ("PROCEDURE NOT INVOKED");
-      END IF;
- 
-      IF CA1013A5 /= 2 THEN
-           FAILED ("FUNCTION NOT INVOKED");
-      END IF;
- 
-      RESULT;
- END CA1013A6M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- CA1014A0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SUBUNIT CAN BE SUBMITTED FOR COMPILATION
- -- SEPARATELY FROM ITS PARENT UNIT.
- 
- -- SEPARATE FILES ARE:
- --   CA1014A0M THE MAIN PROCEDURE.
- --   CA1014A1  A SUBUNIT PROCEDURE BODY.
- --   CA1014A2  A SUBUNIT PACKAGE BODY.
- --   CA1014A3  A SUBUNIT FUNCTION BODY.
- 
- -- JRK 5/20/81
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CA1014A0M IS
- 
-      I : INTEGER := 0;
- 
-      PACKAGE CALL_TEST IS
-      END CALL_TEST;
- 
-      PACKAGE BODY CALL_TEST IS
-      BEGIN
-           TEST ("CA1014A", "SUBUNITS SUBMITTED FOR COMPILATION " &
-                 "SEPARATELY FROM PARENT UNIT");
-      END CALL_TEST;
- 
-      PROCEDURE CA1014A1 (I : IN OUT INTEGER) IS SEPARATE;
- 
-      PACKAGE CA1014A2 IS
-           I : INTEGER := 10;
-           PROCEDURE P (I : IN OUT INTEGER);
-      END CA1014A2;
- 
-      PACKAGE BODY CA1014A2 IS SEPARATE;
- 
-      FUNCTION CA1014A3 (I : INTEGER) RETURN INTEGER IS SEPARATE;
- 
- BEGIN
- 
-      CA1014A1 (I);
-      IF I /= 1 THEN
-           FAILED ("SUBUNIT PROCEDURE NOT ELABORATED/EXECUTED");
-      END IF;
- 
-      IF CA1014A2.I /= 15 THEN
-           FAILED ("SUBUNIT PACKAGE BODY NOT ELABORATED/EXECUTED");
-      END IF;
- 
-      I := 0;
-      CA1014A2.P (I);
-      IF I /= -20 THEN
-           FAILED ("SUBUNIT PACKAGED PROCEDURE NOT ELABORATED/EXECUTED");
-      END IF;
- 
-      IF CA1014A3(50) /= -50 THEN
-           FAILED ("SUBUNIT FUNCTION NOT ELABORATED/EXECUTED");
-      END IF;
- 
-      RESULT;
- END CA1014A0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA1014A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- JRK 5/20/81
- 
- SEPARATE (CA1014A0M)
- PROCEDURE CA1014A1 (I : IN OUT INTEGER) IS
- 
- BEGIN
- 
-      I := I + 1;
- 
- END CA1014A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,39 ****
- -- CA1014A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- JRK 5/20/81
- 
- SEPARATE (CA1014A0M)
- PACKAGE BODY CA1014A2 IS
- 
-      PROCEDURE P (I : IN OUT INTEGER) IS
-      BEGIN
-           I := I - 20;
-      END P;
- 
- BEGIN
- 
-      I := I + 5;
- 
- END CA1014A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA1014A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- JRK 5/20/81
- 
- SEPARATE (CA1014A0M)
- FUNCTION CA1014A3 (I : INTEGER) RETURN INTEGER IS
- 
- BEGIN
-  
-      RETURN -I;
- 
- END CA1014A3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- CA1020E0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
- --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
- --     GENERIC UNITS TO BE INSTANTIATED AS LIBRARY UNITS.
- 
- -- HISTORY:
- --     JBG 05/28/85  CREATED ORIGINAL TEST.
- --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
- --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
- --                   DECLARED WITHOUT A BODY.
- 
- GENERIC
-      C : INTEGER;
- PROCEDURE GENPROC_CA1020E (X : OUT INTEGER);
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE GENPROC_CA1020E (X : OUT INTEGER) IS
- BEGIN
-      X := IDENT_INT(C);
- END GENPROC_CA1020E;
- 
- GENERIC
- FUNCTION GENFUNC_CA1020E RETURN INTEGER;
- 
- FUNCTION GENFUNC_CA1020E RETURN INTEGER IS
- BEGIN
-      RETURN 2;
- END GENFUNC_CA1020E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- CA1020E1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
- --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
- --     SUBPROGRAMS TO BE REPLACED BY LATER GENERIC INSTANTIATIONS.
- 
- -- HISTORY:
- --     JBG 05/28/85  CREATED ORIGINAL TEST.
- --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
- --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
- --                   DECLARED WITHOUT A BODY.
- 
- PROCEDURE CA1020E_PROC1 (X : OUT INTEGER) IS
- BEGIN
-      X := 3;
- END CA1020E_PROC1;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION CA1020E_FUNC1 RETURN INTEGER IS
- BEGIN
-      RETURN IDENT_INT(4);
- END CA1020E_FUNC1;
- 
- PROCEDURE CA1020E_PROC2 (X : OUT INTEGER);
- PROCEDURE CA1020E_PROC2 (X : OUT INTEGER) IS
- BEGIN
-      X := 3;
- END CA1020E_PROC2;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION CA1020E_FUNC2 RETURN FLOAT IS
- BEGIN
-      RETURN FLOAT(IDENT_INT(4));
- END CA1020E_FUNC2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- CA1020E2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
- --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
- --     GENERIC INSTANTIATIONS REPLACING LIBRARY UNITS CREATED IN
- --     CA1020E1.
- 
- -- HISTORY:
- --     JBG 05/28/85  CREATED ORIGINAL TEST.
- --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
- --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
- --                   DECLARED WITHOUT A BODY.
- 
- WITH GENPROC_CA1020E;
- PRAGMA ELABORATE (GENPROC_CA1020E);
- PROCEDURE CA1020E_PROC1 IS NEW GENPROC_CA1020E(1);
- 
- WITH GENFUNC_CA1020E;
- PRAGMA ELABORATE (GENFUNC_CA1020E);
- FUNCTION CA1020E_FUNC1 IS NEW GENFUNC_CA1020E;
- 
- WITH GENPROC_CA1020E;
- PRAGMA ELABORATE (GENPROC_CA1020E);
- PROCEDURE CA1020E_PROC2 IS NEW GENPROC_CA1020E(5);
- 
- WITH GENFUNC_CA1020E;
- PRAGMA ELABORATE (GENFUNC_CA1020E);
- FUNCTION CA1020E_FUNC2 IS NEW GENFUNC_CA1020E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- CA1020E3M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
- --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
- --     GENERIC UNITS TO BE INSTANTIATED AS LIBRARY UNITS.
- 
- -- SEPARATE FILES ARE:
- --     CA1020E0  -- GENERIC UNITS GENPROC_CA1020E AND GENFUNC_CA1020E.
- --     CA1020E1  -- SUBPROGRAM LIBRARY UNIT BODIES (CA1020E_PROC1,
- --                  CA1020E_FUNC1, CA1020E_PROC2, CA1020E_FUNC2).
- --     CA1020E2  -- INSTANTIATIONS REPLACING UNITS COMPILED IN CA1020E1.
- --     CA1020E3M -- MAIN PROGRAM.
- 
- -- HISTORY:
- --     JBG 05/28/85  CREATED ORIGINAL TEST.
- --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
- --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
- --                   DECLARED WITHOUT A BODY.
- 
- WITH REPORT; USE REPORT;
- WITH CA1020E_PROC1, CA1020E_FUNC1, CA1020E_PROC2, CA1020E_FUNC2;
- PROCEDURE CA1020E3M IS
-      TEMP : INTEGER := 0;
- BEGIN
-      TEST ("CA1020E", "CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE " &
-                       "REPLACED BY A GENERIC INSTANTIATION HAVING " &
-                       "THE SAME IDENTIFIER");
- 
-      CA1020E_PROC1 (TEMP);
-      IF TEMP /= IDENT_INT(1) THEN
-           FAILED ("INSTANTIATION DID NOT REPLACE PROCEDURE");
-      END IF;
- 
-      IF CA1020E_FUNC1 /= IDENT_INT(2) THEN
-           FAILED ("INSTANTIATION DID NOT REPLACE FUNCTION");
-      END IF;
- 
-      CA1020E_PROC2 (TEMP);
-      IF TEMP /= IDENT_INT(5) THEN
-           FAILED ("INSTANTIATION DID NOT REPLACE PROCEDURE");
-      END IF;
- 
-      IF CA1020E_FUNC2 /= IDENT_INT(2) THEN
-           FAILED ("INSTANTIATION DID NOT REPLACE FUNCTION");
-      END IF;
- 
-      RESULT;
- END CA1020E3M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,43 ****
- -- CA1022A0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/23/84
- 
- PACKAGE CA1022A0 IS
- 
-      I : INTEGER := 2;
-      PROCEDURE P0 (X : IN OUT INTEGER );
- 
- END CA1022A0;
- 
- PACKAGE BODY CA1022A0 IS
- 
-      PROCEDURE P0 (X : IN OUT INTEGER) IS
-      BEGIN
- 
-           X := X + 1;
- 
-      END P0;
- 
- END CA1022A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,33 ****
- -- CA1022A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/23/84
- 
- WITH CA1022A0;
- PROCEDURE CA1022A1 (Y : IN OUT INTEGER) IS
- BEGIN
- 
-      CA1022A0.P0 (Y);
- 
- END CA1022A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,33 ****
- -- CA1022A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/23/84
- 
- WITH CA1022A0;
- FUNCTION CA1022A2 (Z : INTEGER := 1) RETURN BOOLEAN IS
- BEGIN
- 
-      RETURN TRUE;
- 
- END CA1022A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- CA1022A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- RECOMPILATION OF PACKAGE CA1022A0.
- 
- -- BHS 7/23/84
- 
- PACKAGE CA1022A0 IS
- 
-      I, J : INTEGER;
-      PROCEDURE P0 (X : IN OUT INTEGER);
-      FUNCTION F RETURN INTEGER;
- 
- END CA1022A0;
- 
- PACKAGE BODY CA1022A0 IS
- 
-      PROCEDURE P0 (X : IN OUT INTEGER) IS
-      BEGIN
- 
-           X := X + 2;
- 
-      END P0;
- 
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
- 
-           RETURN 3;
- 
-      END F;
- 
- END CA1022A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- CA1022A4.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- RECOMPILATION OF PROCEDURE CA1022A1.
- 
- -- BHS 7/23/84
- 
- WITH CA1022A0;
- PROCEDURE CA1022A1 (Y : IN OUT INTEGER) IS
- BEGIN
- 
-      Y := 3;
-      CA1022A0.P0 (Y);
- 
- END CA1022A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA1022A5.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- RECOMPILATION OF FUNCTION CA1022A2 (DECL AND BODY).
- 
- -- BHS 7/23/84
- 
- FUNCTION CA1022A2 (Z : INTEGER := 1) RETURN BOOLEAN IS
- BEGIN
- 
-      RETURN Z /= 1;
- 
- END CA1022A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CA1022A6M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A SUBPROGRAM BODY IS INITIALLY COMPILED WITH A CONTEXT
- -- CLAUSE AND A UNIT NAMED IN THE CONTEXT CLAUSE IS RECOMPILED, THEN AN
- -- ATTEMPT TO COMPILE THE BODY AGAIN WILL SUCCEED IF THE CONTEXT CLAUSE
- -- IS PRESENT.
- -- CHECK THAT IF THE RECOMPILED UNIT IS NOT NEEDED IN THE SUBPROGRAM
- -- BODY, THE BODY CAN BE SUCCESSFULLY RECOMPILED WITHOUT MENTIONING THE
- -- RECOMPILED UNIT.
- 
- -- SEPARATE FILES ARE:
- --     CA1022A0  A LIBRARY PACKAGE.
- --     CA1022A1  A LIBRARY PROCEDURE.
- --     CA1022A2  A LIBRARY FUNCTION.
- --     CA1022A3  A LIBRARY PACKAGE (CA1022A0).
- --     CA1022A4  A LIBRARY PROCEDURE (CA1022A1).
- --     CA1022A5  A LIBRARY FUNCTION (CA1022A2).
- --     CA1022A6M THE MAIN PROCEDURE.
- 
- -- BHS 7/23/84
- 
- WITH CA1022A1, CA1022A2;
- WITH REPORT; USE REPORT;
- PROCEDURE CA1022A6M IS
- 
-      I : INTEGER := 1;
- 
- BEGIN
- 
-      TEST ("CA1022A", "USE OF CONTEXT CLAUSES NAMING RECOMPILED " &
-                       "UNITS WITH RECOMPILED SUBPROGRAMS");
- 
-      CA1022A1(I);
-      IF I /= 5 THEN
-           FAILED ("PROCEDURE CA1022A1 NOT INVOKED CORRECTLY");
-      END IF;
- 
-      IF CA1022A2 THEN
-           FAILED ("FUNCTION CA1022A2 NOT INVOKED CORRECTLY");
-      END IF;
- 
-      RESULT;
- 
- END CA1022A6M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,276 ****
- -- CA11001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a child unit can be used to provide an alternate view and
- --      operations on a private type in its parent package.  Check that a 
- --      child unit can be a package.  Check that a WITH of a child unit 
- --      includes an implicit WITH of its ancestor unit.  
- --
- -- TEST DESCRIPTION:
- --      Declare a private type in a package specification. Declare 
- --      subprograms for the type.
- --
- --      Add a public child to the above package.  Within the body of this
- --      package, access the private type. Declare operations to read and 
- --      write to its parent private type.
- --
- --      In the main program, "with" the child.  Declare objects of the
- --      parent private type.  Access the subprograms from both parent and
- --      child packages.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CA11001_0 is   -- Cartesian_Complex
- --  This package represents a Cartesian view of a complex number.  It contains 
- --  a private type plus subprograms to construct and decompose a complex 
- --  number.
- 
-    type Complex_Int is range 0 .. 100;
- 
-    type Complex_Type is private;
- 
-    Constant_Complex : constant Complex_Type;
- 
-    Complex_Error : exception;
- 
-    procedure Cartesian_Assign   (R, I : in     Complex_Int; 
-                                  C    :    out Complex_Type);
- 
-    function Cartesian_Real_Part (C : Complex_Type) 
-      return Complex_Int;
- 
-    function Cartesian_Imag_Part (C : Complex_Type) 
-      return Complex_Int;
- 
-    function Complex (Real, Imaginary : Complex_Int)
-      return Complex_Type;                             
- 
- private
-    type Complex_Type is                      -- Parent private type
-       record
-          Real, Imaginary : Complex_Int;
-       end record;
- 
-    Constant_Complex : constant Complex_Type := (Real => 0, Imaginary => 0);
- 
- end CA11001_0;       -- Cartesian_Complex
- 
- --=======================================================================--
- 
- package body CA11001_0 is  -- Cartesian_Complex
- 
-    procedure Cartesian_Assign (R, I : in     Complex_Int; 
-                                C    :    out Complex_Type) is
-    begin
-       C.Real      := R;
-       C.Imaginary := I;
-    end Cartesian_Assign;
-    -------------------------------------------------------------
-    function Cartesian_Real_Part (C : Complex_Type) 
-      return Complex_Int is
-    begin
-       return C.Real;
-    end Cartesian_Real_Part;
-    -------------------------------------------------------------
-    function Cartesian_Imag_Part (C : Complex_Type) 
-      return Complex_Int is
-    begin
-       return C.Imaginary;
-    end Cartesian_Imag_Part;
-    -------------------------------------------------------------
-    function Complex (Real, Imaginary : Complex_Int)
-      return Complex_Type is
-    begin
-       return (Real, Imaginary);
-    end Complex;
- 
- end CA11001_0;      -- Cartesian_Complex
- 
- --=======================================================================--
- 
- package CA11001_0.CA11001_1 is    -- Polar_Complex
- --  This public child provides a different view of the private type from its
- --  parent.  It provides a polar view by the provision of subprograms which
- --  construct and decompose a complex number.
- 
-    procedure Polar_Assign (R, Theta : in     Complex_Int; 
-                            C        :    out Complex_Type);  
-                                              -- Complex_Type is a 
-                                              -- record of CA11001_0
- 
-    function Polar_Real_Part (C: Complex_Type) return Complex_Int;           
- 
-    function Polar_Imag_Part (C: Complex_Type) return Complex_Int;
- 
-    function Equals_Const (Num : Complex_Type) return Boolean;
- 
- end CA11001_0.CA11001_1;    -- Polar_Complex
- 
- --=======================================================================--
- 
- package body CA11001_0.CA11001_1 is   -- Polar_Complex
- 
-    function Cos (Angle : Complex_Int) return Complex_Int is
-       Num : constant Complex_Int := 2;
-    begin
-       return (Angle * Num);   -- not true Cosine function
-    end Cos;
-    -------------------------------------------------------------
-    function Sine (Angle : Complex_Int) return Complex_Int is
-    begin
-       return 1;     -- not true Sine function
-    end Sine;
-    -------------------------------------------------------------
-    function Sqrt (Num : Complex_Int) 
-      return Complex_Int is
-    begin
-      return (Num);     -- not true Square root function
-    end Sqrt;
-    -------------------------------------------------------------
-    function Tan  (Angle : Complex_Int) return Complex_Int is
-    begin
-      return Angle;     -- not true Tangent function
-    end Tan;
-    -------------------------------------------------------------
-    procedure Polar_Assign (R, Theta : in     Complex_Int;  
-                            C        :    out Complex_Type) is 
-    begin
-       if R = 0 and Theta = 0 then
-          raise Complex_Error;
-       end if;
-       C.Real := R * Cos (Theta);
-       C.Imaginary := R * Sine (Theta);
-    end Polar_Assign;
-    -------------------------------------------------------------
-    function Polar_Real_Part (C: Complex_Type) return Complex_Int is
-    begin
-       return Sqrt ((Cartesian_Imag_Part (C)) ** 2 + 
-                    (Cartesian_Real_Part (C)) ** 2);
-    end Polar_Real_Part;
-    -------------------------------------------------------------
-    function Polar_Imag_Part (C: Complex_Type) return Complex_Int is
-    begin
-       return (Tan (Cartesian_Imag_Part (C) / 
-               Cartesian_Real_Part (C)));
-    end Polar_Imag_Part;
-    -------------------------------------------------------------
-    function Equals_Const (Num : Complex_Type) return Boolean is
-    begin
-       return Num.Real = Constant_Complex.Real and
-          Num.Imaginary = Constant_Complex.Imaginary;
-    end Equals_Const;
- 
- end CA11001_0.CA11001_1;     -- Polar_Complex
- 
- --=======================================================================--
- 
- with CA11001_0.CA11001_1;        -- Polar_Complex
- with Report;
- 
- procedure CA11001 is
- 
-    Complex_No  : CA11001_0.Complex_Type;    -- Complex_Type is a
-                                             -- record of CA11001_0
- 
-    Complex_5x2 : CA11001_0.Complex_Type := CA11001_0.Complex (5, 2);
- 
-    Int_2       :  CA11001_0.Complex_Int 
-                := CA11001_0.Complex_Int (Report.Ident_Int (2));
- 
- begin
- 
-    Report.Test ("CA11001", "Check that a child unit can be used " &
-                 "to provide an alternate view and operations " &
-                 "on a private type in its parent package");
- 
-    Basic_View_Subtest:
- 
-    begin
-       -- Assign using Cartesian coordinates.
-       CA11001_0.Cartesian_Assign 
-         (CA11001_0.Complex_Int (Report.Ident_Int (1)), Int_2, Complex_No);
- 
-       -- Read back in Polar coordinates.
-       -- Polar values are surrogates used in checking for correct
-       -- subprogram calls.
-       if CA11001_0."/=" (CA11001_0.CA11001_1.Polar_Real_Part (Complex_No),
-         CA11001_0.Cartesian_Real_Part (Complex_5x2)) and CA11001_0."/="
-           (CA11001_0.CA11001_1.Polar_Imag_Part (Complex_No),  
-             CA11001_0.Cartesian_Imag_Part (Complex_5x2)) then
-            Report.Failed ("Incorrect Cartesian result");
-       end if;
- 
-    end Basic_View_Subtest;
-    -------------------------------------------------------------
-    Alternate_View_Subtest:
-    begin
-       -- Assign using Polar coordinates.
-       CA11001_0.CA11001_1.Polar_Assign 
-         (Int_2, CA11001_0.Complex_Int (Report.Ident_Int (3)), Complex_No);
- 
-       -- Read back in Cartesian coordinates.
-       if CA11001_0."/=" (CA11001_0.Cartesian_Real_Part 
-         (Complex_No), CA11001_0.Complex_Int (Report.Ident_Int (12))) or 
-           CA11001_0."/=" (CA11001_0.Cartesian_Imag_Part (Complex_No), Int_2) 
-       then
-          Report.Failed ("Incorrect Polar result");
-       end if;
-    end Alternate_View_Subtest;
-    -------------------------------------------------------------
-    Other_Subtest:
-    begin
-       -- Assign using Polar coordinates.
-       CA11001_0.CA11001_1.Polar_Assign 
-         (CA11001_0.Complex_Int (Report.Ident_Int (0)), Int_2, Complex_No);
- 
-       -- Compare with Complex_Num in CA11001_0.
-       if not CA11001_0.CA11001_1.Equals_Const (Complex_No)
-         then
-          Report.Failed ("Incorrect result");
-       end if;
-    end Other_Subtest;
-    -------------------------------------------------------------
-    Exception_Subtest:
-    begin
-       -- Raised parent's exception.
-       CA11001_0.CA11001_1.Polar_Assign 
-         (CA11001_0.Complex_Int (Report.Ident_Int (0)), 
-            CA11001_0.Complex_Int (Report.Ident_Int (0)), Complex_No);
-       Report.Failed ("Exception was not raised");
-    exception
-       when CA11001_0.Complex_Error => 
-          null;
-       when others                  =>
-          Report.Failed ("Unexpected exception raised in test");
-    end Exception_Subtest;
- 
-    Report.Result;
- 
- end CA11001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,238 ****
- -- CA11002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a public child can utilize its parent unit's visible 
- --      definitions.
- --      
- -- TEST DESCRIPTION:
- --      Declare a parent package that contains the following: type, object,
- --      constant, exception, and subprograms.  Declare a public child unit
- --      that utilizes the components found in the visible part of its parent.
- --
- --      Demonstrate utilization of the following parent components in the 
- --      child package:
- --
- --                          Parent
- --          Type              X
- --          Constant          X
- --          Object            X           
- --          Subprogram        X           
- --          Exception         X           
- --
- --      This abstraction simulates a portion of a simple operating system.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CA11002_0 is                      -- Package OS.
- 
-    type File_Descriptor is new Integer;
-    type File_Mode is (Read_Only, Write_Only, Read_Write);
- 
-    Null_File    : constant File_Descriptor := 0;
-    Default_Mode : constant File_Mode       := Read_Only;
-    Active_Mode  : constant File_Mode       := Read_Write;
- 
-    type File_Type is 
-      record
-         Descriptor : File_Descriptor := Null_File;
-         Mode       : File_Mode       := Default_Mode;
-      end record;
- 
-    System_File     : File_Type;
-    File_Mode_Error : exception;
- 
-    function Next_Available_File return File_Descriptor;
- 
-    function Mode_Of_File (File : File_Type) return File_Mode;
- 
- end CA11002_0;                            -- Package OS. 
- 
-      --=================================================================--
- 
- package body CA11002_0 is                 -- Package body OS.
-    
-    File_Count : Integer := 0;
- 
-    function Next_Available_File return File_Descriptor is
-    begin
-       File_Count := File_Count + 1;
-       return (File_Descriptor(File_Count));    -- Type conversion.
-    end Next_Available_File;
-    --------------------------------------------------------------
-    function Mode_Of_File (File : File_Type) return File_Mode is
-       Mode : File_Mode := File.Mode;
-    begin
-       return (Mode);
-    end Mode_Of_File;
- 
- end CA11002_0;                            -- Package body OS.
- 
-      --=================================================================--
- 
- package CA11002_0.CA11002_1 is            -- Child package OS.Operations.
- 
-    -- Dot qualification of types, objects, etc. from parent is not required
-    -- in a child unit.
- 
-    procedure Create_File (Mode : in     File_Mode:= Active_Mode;
-                           File :    out File_Type);    
- 
- end CA11002_0.CA11002_1;                  -- Child package OS.Operations. 
- 
-      --=================================================================--
- 
- with Report;
- package body CA11002_0.CA11002_1 is       -- Child package body OS.Operations.
- 
-    function New_File_Validated (File : File_Type)        -- Ensure that a newly
-      return Boolean is                                   -- created file has
-       Result : Boolean := False;                         -- appropriate values.
-    begin                                                 
-       if (File.Descriptor > System_File.Descriptor) and  -- Parent object.
-          (File.Mode  in  File_Mode )                     -- Parent type.
-       then
-          Result := True;
-       end if;
- 
-       return (Result);
- 
-    end New_File_Validated;
-    --------------------------------------------------------------
-    procedure Create_File 
-      (Mode       : in     File_Mode := Active_Mode;     -- Parent constant.
-       File       :    out File_Type) is                 -- Parent type.
- 
-       New_File : File_Type;
- 
-    begin
-       New_File.Descriptor := Next_Available_File;       -- Parent subprogram.
-       New_File.Mode       := Mode;
- 
-       if New_File_Validated (File => New_File) then
-          File := New_File;
-       end if;
- 
-    end Create_File;
- 
- end CA11002_0.CA11002_1;                  -- Child Package body OS.Operations.
- 
-      --=================================================================--
- 
- -- Child library subprogram Convert_File_Mode specification.
- procedure CA11002_0.CA11002_2 (File     : in out File_Type;    -- Parent type. 
-                                New_Mode : in     File_Mode);   -- Parent type.
- 
- 
-      --=================================================================--
- with Report;
- 
- -- Child library subprogram Convert_File_Mode body.
- procedure CA11002_0.CA11002_2 (File     : in out File_Type;   
-                                New_Mode : in     File_Mode) is
- begin
-    if File.Mode = New_Mode then
-       raise File_Mode_Error;                               -- Parent exception.
-       Report.Failed ("Exception not raised in child unit");
-    else
-       File.Mode := New_Mode;
-    end if;
- end CA11002_0.CA11002_2;
- 
-      --=================================================================--
- 
- with Report;
- with CA11002_0.CA11002_1;          -- Child package OS.Operations.
- with CA11002_0.CA11002_2;          -- Child subprogram OS.Convert_File_Mode,
-                                    -- Implicitly with parent, OS.
- use CA11002_0;                     -- All user-defined operators directly
-                                    -- visible.
- procedure CA11002 is
- begin
- 
-    Report.Test ("CA11002", "Check that a public child can utilize its " &
-                 "parent unit's visible definitions");
- 
-    File_Creation:                   -- This processing block will demonstrate
-                                     -- use of child package subroutine that
-                                     -- takes advantage of components declared
-                                     -- in the parent package.
-    declare
-       User_File : File_Type;
-    begin
-       CA11002_0.CA11002_1.Create_File (File => User_File); -- Default mode
-                                                            -- parameter used in
-                                                            -- this call.
-       if (User_File.Descriptor = System_File.Descriptor) or
-          (User_File.Mode       = Default_Mode) 
-       then
-          Report.Failed ("Incorrect file creation");
-       end if;
- 
-    end File_Creation;
- 
-    --------------------------------------------------------------
-    File_Mode_Conversion:            -- This processing block will demonstrate
-                                     -- the occurrence of a (forced) exception
-                                     -- being raised in a child subprogram, and
-                                     -- propagated to the caller.  The exception
-                                     -- is handled, and the child subprogram
-                                     -- is called again, this time to perform
-                                     -- without error.
-    declare
-       procedure Convert_File_Mode (File : in out File_Type; 
-         New_Mode : in File_Mode) renames CA11002_0.CA11002_2; 
-       New_File : File_Type;
-    begin                               -- Raise an exception with this
-                                        -- illegal conversion operation
-                                        -- (attempt to change to current mode).
- 
-       Convert_File_Mode (File     => New_File,
-                          New_Mode => Default_Mode);
-       Report.Failed ("Exception should have been raised in child unit");
- 
-    exception
-       when File_Mode_Error =>          -- Perform the conversion again, this
-                                        -- time with a different file mode.
- 
-          Convert_File_Mode (File     => New_File,
-                             New_Mode => CA11002_0.Active_Mode);
- 
-          if New_File.Mode /= Read_Write then
-             Report.Failed ("Incorrect result from mode conversion operation");
-          end if;
- 
-       when others =>
-          Report.Failed ("Unexpected exception raised in File_Mode_Conversion");
- 
-    end File_Mode_Conversion;
- 
-    Report.Result;
- 
- end CA11002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,290 ****
- -- CA11003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a public grandchild can utilize its ancestor unit's visible 
- --      definitions.
- --
- -- TEST DESCRIPTION:
- --      Declare a public package, public child package, and public 
- --      grandchild package and library unit function.  Within the 
- --      grandchild package and function, make use of components that are 
- --      declared in the ancestor packages, both parent and grandparent.  
- --
- --      Use the following ancestral components in the grandchildren library
- --      units:
- --                       Grandparent   Parent
- --          Type              X           X
- --          Constant          X           X
- --          Object            X           X
- --          Subprogram        X           X
- --          Exception         X           X
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Dec 94   SAIC    Modified procedure Create_File
- --      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --
- --!
-    
- package CA11003_0 is      -- Package OS 
- 
-    type File_Descriptor is new Integer;
-    type File_Mode       is (Read_Only, Write_Only, Read_Write);
- 
-    Null_File       : constant File_Descriptor := 0;
-    Default_Mode    : constant File_Mode       := Read_Only;
-    File_Data_Error : exception;
- 
-    type File_Type is tagged
-      record
-         Descriptor : File_Descriptor := Null_File;
-         Mode       : File_Mode       := Read_Write;
-      end record;
- 
-    System_File : File_Type;
- 
-    function Next_Available_File return File_Descriptor;
- 
-    procedure Reclaim_File_Descriptor;
- 
- end CA11003_0;               -- Package OS 
- 
-      --=================================================================--
- 
- package body CA11003_0 is    -- Package body OS 
-    
-    File_Count : Integer := 0;
- 
-    function Next_Available_File return File_Descriptor is
-    begin
-       File_Count := File_Count + 1;
-       return (File_Descriptor(File_Count));
-    end Next_Available_File;
-    --------------------------------------------------
-    procedure Reclaim_File_Descriptor is
-    begin
-       null;                                        -- Dummy processing unit.
-    end Reclaim_File_Descriptor;
- 
- end CA11003_0;                          -- Package body OS 
- 
-      --=================================================================--
- 
- package CA11003_0.CA11003_1 is          -- Child package OS.Operations
- 
-    subtype File_Length_Type is Integer range 0 .. 1000;
-    Min_File_Size : File_Length_Type := File_Length_Type'First;
-    Max_File_Size : File_Length_Type := File_Length_Type'Last;
- 
-    File_Duplication_Error : exception;
- 
-    type Extended_File_Type is new File_Type with private;
- 
-    procedure Create_File (Mode : in     File_Mode;
-                           File :    out Extended_File_Type);    
- 
-    procedure Duplicate_File (Original  : in     Extended_File_Type;
-                              Duplicate :    out Extended_File_Type);
- 
- private
-    type Extended_File_Type is new File_Type with
-       record
-          Blocks : File_Length_Type := Min_File_Size;
-       end record;
- 
-    System_Extended_File : Extended_File_Type;
- 
- end CA11003_0.CA11003_1;                -- Child Package OS.Operations 
- 
-      --=================================================================--
- 
- package body CA11003_0.CA11003_1 is     -- Child package body OS.Operations
- 
-    procedure Create_File 
-      (Mode : in     File_Mode;
-       File :    out Extended_File_Type) is                 
-    begin
-       File.Descriptor := Next_Available_File;           -- Parent subprogram.
-       File.Mode       := Default_Mode;                  -- Parent constant.
-       File.Blocks     := Min_File_Size;
-    end Create_File;
-    --------------------------------------------------
-    procedure Duplicate_File (Original  : in     Extended_File_Type;
-                              Duplicate :    out Extended_File_Type) is
-    begin
-       Duplicate.Descriptor := Next_Available_File;      -- Parent subprogram.
-       Duplicate.Mode       := Original.Mode;
-       Duplicate.Blocks     := Original.Blocks;
-    end Duplicate_File;
- 
- end CA11003_0.CA11003_1;                   -- Child package body OS.Operations
- 
-      --=================================================================--
- 
- -- This package contains menu selectable operations for manipulating files.
- -- This abstraction builds on the capabilities available from ancestor
- -- packages.
- 
- package CA11003_0.CA11003_1.CA11003_2 is   
- 
-    procedure News (Mode : in     File_Mode;
-                    File :    out Extended_File_Type);    
- 
-    procedure Copy (Original  : in     Extended_File_Type;
-                    Duplicate :    out Extended_File_Type);
- 
-    procedure Delete   (File : in Extended_File_Type);
- 
- end CA11003_0.CA11003_1.CA11003_2;  -- Grandchild package OS.Operations.Menu
-  
-      --=================================================================--
- 
- -- Grandchild subprogram Validate 
- function  CA11003_0.CA11003_1.CA11003_3 (File : in Extended_File_Type) 
-   return Boolean;     
- 
-      --=================================================================--
- 
- -- Grandchild subprogram Validate 
- function  CA11003_0.CA11003_1.CA11003_3         
-   (File : in Extended_File_Type)                            -- Parent type.
-   return Boolean is      
- 
-    function New_File_Validated (File : Extended_File_Type) 
-        return Boolean is  
-    begin                                                
-       if (File.Descriptor > System_File.Descriptor) and     -- Grandparent
-          (File.Mode in File_Mode ) and                      -- object and type
-          not ((File.Blocks < System_Extended_File.Blocks) or       
-               (File.Blocks > Max_File_Size))                -- Parent object
-       then                                                  -- and constant.
-          return True;
-       else
-          return False;
-       end if;
-    end New_File_Validated;
-       
- begin
-    return (New_File_Validated (File)) and    
-           (File.Descriptor /= Null_File);              -- Grandparent constant.
-                                                  
- end CA11003_0.CA11003_1.CA11003_3;      -- Grandchild subprogram Validate
- 
-      --=================================================================--
- 
- with CA11003_0.CA11003_1.CA11003_3;
-                                  -- Grandchild package body OS.Operations.Menu
- package body CA11003_0.CA11003_1.CA11003_2 is  
- 
-    procedure News (Mode : in     File_Mode;
-                    File :    out Extended_File_Type) is   -- Parent type.
-    begin
-       Create_File (Mode, File);                           -- Parent subprogram.
-       if not CA11003_0.CA11003_1.CA11003_3 (File) then                       
-          raise File_Data_Error;                       -- Grandparent exception.
-       end if;
-    end News;
-    --------------------------------------------------
-    procedure Copy (Original  : in     Extended_File_Type;
-                    Duplicate :    out Extended_File_Type) is
-    begin
-       Duplicate_File (Original, Duplicate);               -- Parent subprogram.
- 
-       if Original.Descriptor = Duplicate.Descriptor then
-          raise File_Duplication_Error;                    -- Parent exception.
-       end if;
- 
-    end Copy;
-    --------------------------------------------------
-    procedure Delete (File : in Extended_File_Type) is
-    begin
-       Reclaim_File_Descriptor;                            -- Grandparent
-    end Delete;                                            -- subprogram.
- 
- end CA11003_0.CA11003_1.CA11003_2;  
- 
-      --=================================================================--
- 
- with CA11003_0.CA11003_1.CA11003_2;  -- Grandchild Pkg OS.Operations.Menu
- with CA11003_0.CA11003_1.CA11003_3;  -- Grandchild Ftn OS.Operations.Validate
- with Report;
- 
- procedure CA11003 is
- 
-    package Menu renames CA11003_0.CA11003_1.CA11003_2;
- 
- begin
- 
-    Report.Test ("CA11003", "Check that a public grandchild can utilize " &
-                 "its ancestor unit's visible definitions");
- 
-    File_Processing:         -- Validate all of the capabilities contained in 
-                             -- the Menu package by exercising them on specific 
-                             -- files.  This will demonstrate the use of child
-                             -- and grandchild functionality based on components
-                             -- that have been declared in the
-                             -- parent/grandparent package.
-    declare
- 
-       function Validate (File : CA11003_0.CA11003_1.Extended_File_Type) 
-         return Boolean renames CA11003_0.CA11003_1.CA11003_3;
- 
-       MacWrite_File,
-       Backup_Copy : CA11003_0.CA11003_1.Extended_File_Type;        
-       MacWrite_File_Mode : CA11003_0.File_Mode := CA11003_0.Read_Write;
-                                      
-    begin                                                
-                                                         
-       Menu.News (MacWrite_File_Mode, MacWrite_File);                          
- 
-       if not Validate (MacWrite_File) then
-          Report.Failed ("Incorrect initialization of files");
-       end if;
- 
-       Menu.Copy (MacWrite_File, Backup_Copy);
- 
-       if not (Validate (MacWrite_File) and 
-               Validate (Backup_Copy))
-       then
-          Report.Failed ("Incorrect duplication of files");
-       end if;
- 
-       Menu.Delete (Backup_Copy);
- 
-    exception
-       when CA11003_0.File_Data_Error =>
-           Report.Failed ("Exception raised during file validation");
-       when CA11003_0.CA11003_1.File_Duplication_Error =>
-           Report.Failed ("Exception raised during file duplication");
-       when others =>
-           Report.Failed ("Unexpected exception in test procedure");
- 
-    end File_Processing;
- 
-    Report.Result;
- 
- end CA11003; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110040.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110040.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110040.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110040.a	Thu Jan  1 00:00:00 1970
***************
*** 1,90 ****
- -- CA110040.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA110042.AM
- --
- -- TEST DESCRIPTION:
- --      See CA110042.AM
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --      => CA110040.A
- --         CA110041.A
- --         CA110042.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue; Added pragma 
- --                          Elaborate_Body.
- --
- --!
- 
- package CA110040 is                              -- Package Computer_System.
-    pragma Elaborate_Body (CA110040);
- 
-    -- Types.
-    type ID_Type                 is range 1 .. 4;
-    type System_Account_Capacity is new ID_Type;
- 
-    type Account is tagged 
-       record
-          User_ID : ID_Type;
-       end record;
- 
-    -- Constants.
-    Maximum_System_Accounts : constant System_Account_Capacity := 
-      System_Account_Capacity'Last;
- 
-    System_Administrator    : constant ID_Type := 
-      ID_Type (System_Account_Capacity'First);
- 
-    Administrator_Account   : constant Account := 
-      (User_ID => System_Administrator);
- 
-    -- Objects.
-    Total_Accounts           : System_Account_Capacity  := 1;
- 
-    -- Exceptions.
-    Illegal_Account          : exception;
-    Account_Limit_Exceeded   : exception;
- 
-    -- Subprograms.
-    function Next_Available_ID return ID_Type;
- 
- end CA110040;                                -- Package Computer_System.
- 
-      --=================================================================--
- 
- package body CA110040 is                     -- Package body Computer_System.
- 
-    function Next_Available_ID return ID_Type is
-    begin
-       Total_Accounts := Total_Accounts + 1;
-       return (ID_Type(Total_Accounts));
-    end Next_Available_ID;
- 
- end CA110040;                                -- Package body Computer_System.
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110041.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110041.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110041.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110041.a	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- CA110041.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA110042.AM
- --
- -- TEST DESCRIPTION:
- --      See CA110042.AM
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         CA110040.A
- --      => CA110041.A
- --         CA110042.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- package CA110040.CA110041 is         -- Child Package Computer_System.Manager
- 
-    type User_Account is new Account with private;
- 
-    procedure Initialize_User_Account (Acct : out User_Account);
- 
- private
- 
- -- The private portion of this spec demonstrates that components contained
- -- in the visible part of the parent are directly visible in the private 
- -- part of a public child.
- 
-    type Account_Access_Type is (None, Guest, User, System);
- 
-    type User_Account is new Account with                   -- Parent type.
-       record
-          Privilege : Account_Access_Type := None;
-       end record;
- 
-    System_Account : User_Account := 
-      (User_ID   => Administrator_Account.User_ID,          -- Parent constant.
-       Privilege => System);                                -- User_ID has been
-                                                            -- set to 1.
-    Auditor_Account : User_Account :=
-      (User_ID   => Next_Available_ID,                      -- Parent function.
-       Privilege => System);                                -- User_ID has been
-                                                            -- set to 2.
-    Total_Authorized_Accounts : System_Account_Capacity 
-      renames Total_Accounts;                               -- Parent object.
- 
-    Unauthorized_Account : exception 
-      renames Illegal_Account;                              -- Parent exception
- 
- end CA110040.CA110041;             -- Child Package Computer_System.Manager
- 
-      --=================================================================--
- 
-                                  -- Child Package body Computer_System.Manager
- package body CA110040.CA110041 is  
- 
-    function  Account_Limit_Reached  return Boolean is
-    begin
-       if Total_Authorized_Accounts = Maximum_System_Accounts then
-          return (True);
-       else
-          return (False);
-       end if;
-    end Account_Limit_Reached;
-    ---------------------------------------------------------------
-    function Valid_Account (Acct : User_Account) return Boolean is
-       Result : Boolean := False; 
-    begin
-       if (Acct.User_ID /= System_Account.User_ID) and
-          (Acct.User_ID /= Auditor_Account.User_ID) 
-       then
-          Result := True;
-       end if;
-       return (Result);
-    end Valid_Account;
-    ---------------------------------------------------------------
-    procedure Initialize_User_Account (Acct : out User_Account) is
-    begin
-       if Account_Limit_Reached then
-          raise Account_Limit_Exceeded;           
-       else                                       
-          Acct.User_ID := Next_Available_ID;
-          Acct.Privilege := User;
-       end if;
-       if not Valid_Account (Acct) then
-          raise Unauthorized_Account;
-       end if;
-    end Initialize_User_Account;
- 
- end CA110040.CA110041;          -- Child Package body Computer_System.Manager
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110042.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110042.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110042.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110042.am	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- CA110042.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the private part of a child library unit package can
- --      utilize its parent unit's visible definitions.
- --
- -- TEST DESCRIPTION:
- --      Declare a public library unit package and child package, with the
- --      child package having a private part in the specification.  Within
- --      this child private part, make use of components that are declared in
- --      the visible part of the parent.
- --
- --      Demonstrate visibility to the following parent components in the 
- --      child private part:
- --                          Parent
- --          Type              X
- --          Constant          X
- --          Object            X           
- --          Subprogram        X           
- --          Exception         X           
- --
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         CA110040.A
- --         CA110041.A
- --      => CA110042.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- with Report;
- with CA110040.CA110041;
- 
- procedure CA110042 is
- 
-       package System_Manager renames CA110040.CA110041;
-       use CA110040;
-       User1, User2, User3 : System_Manager.User_Account;
- 
- begin
- 
-    Report.Test ("CA110042", "Check that the private part of a child "     &
-                             "library unit package can utilize its "       &
-                             "parent unit's visible definitions");
- 
-    Assign_New_Accounts:            -- This code simulates the entering of new
-                                    -- user accounts into a computer system.
-                                    -- It also simulates the processing that
-                                    -- could occur when the limit on system
-                                    -- accounts has been exceeded.
- 
-                                    -- This processing block demonstrates the
-                                    -- use of child package functionality that
-                                    -- takes advantage of components declared in
-                                    -- the parent package.
-    begin
- 
-       if Total_Accounts /= 2 then
-          Report.Failed ("Incorrect number of accounts currently allocated");
-       end if;                                         -- At this point, both
-                                                       -- System_Account and
-                                                       -- Auditor_Account have
-                                                       -- been declared and
-                                                       -- initialized in package
-                                                       -- CA110040.CA110041.
- 
-       System_Manager.Initialize_User_Account (User1); -- User_ID has been
-                                                       -- set to 3.
- 
-       System_Manager.Initialize_User_Account (User2); -- User_ID has been
-                                                       -- set to 4, which
-                                                       -- is the last value
-                                                       -- defined for the
-                                                       -- CA110040.ID_Type
-                                                       -- range.
- 
-       System_Manager.Initialize_User_Account (User3); -- This final call will 
-                                                       -- result in an 
-                                                       -- Account_Limit_Exceeded
-                                                       -- exception being raised.
- 
-       Report.Failed ("Control should have transferred with exception");
- 
-    exception
- 
-       when Account_Limit_Exceeded =>
-          if (not (Administrator_Account.User_ID = ID_Type'First)) or
-            (User2.User_ID /= CA110040.ID_Type'Last)
-          then
-             Report.Failed ("Account initialization failure");
-          end if;
-       when others =>
-          Report.Failed ("Unexpected exception raised");
- 
-    end Assign_New_Accounts;
- 
-    if (User1.User_ID /= 3) or (User2.User_ID /= 4) then
-       Report.Failed ("Improper initialization of user accounts");
-    end if;
- 
-    Report.Result;
- 
- end CA110042;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110050.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110050.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110050.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110050.a	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- CA110050.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA110051.AM
- --
- -- TEST DESCRIPTION:
- --      See CA110051.AM
- --
- -- TEST FILES:
- --      The test consists of the following files:
- --
- --      => CA110050.A
- --         CA110051.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Dec 94   SAIC    Modified discriminant type 
- --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue; Added pragma 
- --                          Elaborate_Body.
- --
- --!
-   
- package CA110050_0 is                   -- Package Messages.
-    pragma Elaborate_Body (CA110050_0);
- 
-    type Descriptor is new Integer;
- 
-    Null_Descriptor_Value   : constant Descriptor := 0;
-    Null_Message_Descriptor : constant Descriptor := 0;
- 
-    type Message_Type is tagged 
-       record
-          Number : Descriptor := Null_Message_Descriptor;
-       end record;
- 
-    function Next_Available_Message return Descriptor;
- 
- end CA110050_0;                         -- Package Messages.
- 
-      --=================================================================--
- 
- package body CA110050_0 is              -- Package body Messages.
- 
-    Message_Count : Integer := 0;
- 
-    function Next_Available_Message return Descriptor is
-    begin
-       Message_Count := Message_Count + 5;
-       return (Descriptor(Message_Count));
-    end Next_Available_Message;
- 
- end CA110050_0;                         -- Package body Messages.
- 
-      --=================================================================--
- 
- package CA110050_0.CA110050_1 is        -- Child package Messages.Text
- 
-    subtype Default_Length is Natural range 0 .. 80;
- 
-    type Text_Type (Max_Length : Default_Length := 0) is
-       record
-          Length      : Default_Length := Max_Length;
-          Text_Field  : String (1 .. Max_Length);
-       end record;
- 
-    type Text_Message_Type is new Message_Type with
-       record
-          Text : Text_Type;
-       end record;
- 
-    Null_Text    : Text_Type (0);                     -- Null range for 
-                                                      -- Text_Field component.
- 
- end CA110050_0.CA110050_1;              -- Child package Messages.Text
- --
- -- No package body needed for this specification.
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110051.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110051.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca110051.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca110051.am	Thu Jan  1 00:00:00 1970
***************
*** 1,224 ****
- -- CA110051.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that entities and operations declared in a package can be used
- --      in the private part of a child of a child of the package.
- --
- -- TEST DESCRIPTION:
- --      Declare a series of library unit packages -- parent, child, and 
- --      grandchild.  The grandchild package will have a private part.
- --      From within the private part of the grandchild, make use of 
- --      components declared in the parent and grandparent packages.
- --
- -- TEST FILES:
- --      The test consists of the following files:
- --
- --         CA110050.A
- --      => CA110051.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
-                                     -- Grandchild Package Message.Text.Encoded
- package CA110050_0.CA110050_1.CA110050_2 is  
- 
-    type Coded_Message is new Text_Message_Type with private;
- 
-    procedure Send (Message : in     Coded_Message;
-                    Confirm :    out Coded_Message;
-                    Status  :    out Boolean);
- 
-    function Encode (Message : Text_Message_Type) return Coded_Message;
-    function Decode (Message : Coded_Message)     return Boolean;
-    function Test_Connection                      return Boolean;
- 
- private
- 
-    Uncoded : Descriptor renames Null_Descriptor_Value; -- Grandparent object.
- 
-    type Coded_Message is new Text_Message_Type with    -- Parent type.
-       record
-          Key       : Descriptor := Uncoded;
-          Coded_Key : Descriptor := Next_Available_Message;
-                                  -- Grandparent type, grandparent function.
-          Scrambled : Text_Type  := Null_Text;          -- Parent object.
-       end record;                                      
- 
-    Coded_Msg : Coded_Message;
- 
-    type Blank_Message is new Message_Type with         -- Grandparent type.
-       record
-          ID        : Descriptor := Next_Available_Message;
-                                  -- Grandparent type, grandparent function.
-       end record;                                      
- 
-    Test_Message     : Blank_Message;
- 
-    Confirm_String   : constant String := "OK";
-    Scrambled_String : constant String := "KO";
- 
-    Confirm_Text : Text_Type (Confirm_String'Length) :=
-      (Max_Length => Confirm_String'Length,
-       Length     => Confirm_String'Length,
-       Text_Field => Confirm_String);
- 
-    Scrambled_Text : Text_Type (Scrambled_String'Length) :=
-      (Max_Length => Scrambled_String'Length,
-       Length     => Scrambled_String'Length,
-       Text_Field => Scrambled_String);
-      
- end CA110050_0.CA110050_1.CA110050_2; -- Grandchild Pkg Message.Text.Encoded
- 
-      --=================================================================--
- 
-                                -- Grandchild Package body Message.Text.Encoded
- package body CA110050_0.CA110050_1.CA110050_2 is 
- 
-    procedure Send (Message : in     Coded_Message;
-                    Confirm :    out Coded_Message;
-                    Status  :    out Boolean) is
- 
-       Confirmation_Message : Coded_Message :=
-         (Number    => Message.Number,
-          Text      => Confirm_Text,
-          Key       => Message.Number,
-          Coded_Key => Message.Number,
-          Scrambled => Scrambled_Text);  
- 
-    begin                                          -- Dummy processing unit.
-       Confirm := Confirmation_Message;
-       if Confirm.Number /= Null_Message_Descriptor then
-          Status := True;                            
-       else
-          Status := False;
-       end if;
-    end Send;
-    -------------------------------------------------------------------------
-    function Encode (Message : Text_Message_Type)  return Coded_Message is
-    begin
-       Coded_Msg.Number       := Message.Number;
-       if Message.Text.Length > 0 then
-          Coded_Msg.Text      := Message.Text;     -- Record assignment.
-          Coded_Msg.Key       := Message.Number;   -- Same as msg number.
-          Coded_Msg.Coded_Key := Message.Number;   -- Same as msg number.
-          Coded_Msg.Scrambled := Message.Text;     -- Dummy processing.
-       end if;
-       return (Coded_Msg);
-    end Encode;
-    -------------------------------------------------------------------------
-    function Decode (Message : Coded_Message) return Boolean is
-       Decoded : Boolean := False;
-    begin                                                       
-       if (Message.Text.Length = Confirm_String'Length)        and then
-          (Message.Text.Text_Field = Confirm_String)           and then
-          (Message.Scrambled.Length = Scrambled_String'Length) and then
-          (Message.Scrambled.Text_Field = Scrambled_String)    and then
-          (Message.Coded_Key = 15)
-       then
-          Decoded := True;
-       end if;
-       return (Decoded);
-    end Decode;
-    -------------------------------------------------------------------------
-    function Test_Connection return Boolean is
-    begin
-       return Test_Message.Id = 10;
-    end Test_Connection;
- 
- end CA110050_0.CA110050_1.CA110050_2;        
-                                -- Grandchild Package body Message.Text.Encoded
-  
-      --=================================================================--
- 
- with CA110050_0.CA110050_1.CA110050_2; 
- with Report;
- 
- procedure CA110051 is
- 
-    package Message_Package renames CA110050_0.CA110050_1;
-    package Code_Package    renames CA110050_0.CA110050_1.CA110050_2; 
- 
-    Message_String : constant String := "One if by land, two if by sea";
- 
-    Message_Text   : Message_Package.Text_Type (Message_String'Length) := 
-      (Max_Length => Message_String'Length,
-       Length     => Message_String'Length,
-       Text_Field => Message_String);
- 
-    Message : Message_Package.Text_Message_Type := 
-      (Number => CA110050_0.Next_Available_Message,
-       Text   => Message_Text);
- 
-    Confirmation_Message : Code_Package.Coded_Message;
-    Verification_OK      : Boolean := False;
-    Transmission_OK      : Boolean := False;
- 
- begin
- 
- -- This test simulates the use of child library unit packages to implement
- -- a message encoding and transmission scheme.  The full capability of the
- -- encoding and transmission mechanisms are not developed here, but the 
- -- intent is to demonstrate that a grandchild library unit package with a
- -- private part will provide the framework for this type of processing.
- 
-    Report.Test ("CA110051", "Check that entities and operations declared "  &
-                             "in a package can be used in the private part " & 
-                             "of a child of a child of the package");
- 
-                             -- The following code demonstrates the use
-                             -- of functionality contained in a grandchild
-                             -- library unit.  The grandchild unit made use
-                             -- of components declared in the ancestor
-                             -- packages.
-    
-    Code_Package.Send                            -- Message object declared
-      (Message => Code_Package.Encode (Message), -- above in "encoded" by a
-       Confirm => Confirmation_Message,          -- call to grandchild pkg
-       Status  => Transmission_OK);              -- function call, reseting
-                                                 -- fields and returning a
-                                                 -- coded message to the
-                                                 -- parameter.  The confirm
-                                                 -- parameter receives an
-                                                 -- encoded message value
-                                                 -- from proc Send, which is 
-                                                 -- "decoded"/verified below.
- 
-    if not Code_Package.Test_Connection then
-       Report.Failed ("Bad initialization");
-    end if;
- 
-    Verification_OK := Code_Package.Decode (Confirmation_Message);
- 
-    if not (Transmission_OK and Verification_OK) then
-       Report.Failed ("Message transmission failure");
-    end if;
- 
-    Report.Result;
- 
- end CA110051;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,211 ****
- -- CA11006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the private part of a child library unit can utilize
- --      its parent unit's private definition.
- --
- -- TEST DESCRIPTION:
- --      Declare a package and public child package, both with private 
- --      parts.  The child package will have a private extension of a type 
- --      declared in the parent's private part.  In addition, the private 
- --      part of the child package specification will make use of some of 
- --      the components declared in the private part of the parent.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --
- --!
- 
- package CA11006_0 is      -- Package File_Package 
- 
-    type File_Descriptor is private;
-    type File_Mode       is (Read_Only, Write_Only, Read_Write);
-    type File_Type       is tagged private;
- 
-    function  Next_Available_File return File_Descriptor;
- 
- private
- 
-    type File_Measure    is range 0 .. 1000;
-    type File_Descriptor is new Integer;
- 
-    Null_File       : constant File_Descriptor := 0;
-    Default_Mode    : constant File_Mode       := Read_Write;
- 
-    type File_Type is tagged
-      record
-         Descriptor : File_Descriptor := Null_File;
-         Mode       : File_Mode       := Default_Mode;
-      end record;
- 
-    System_File : File_Type;
- 
- end CA11006_0;               -- Package File_Package  
- 
-      --=================================================================--
- 
- package body CA11006_0 is    -- Package File_Package  
-    
-    File_Count : Integer := 0;
- 
-    function Next_Available_File return File_Descriptor is
-    begin
-       File_Count := File_Count + 1;
-       return File_Descriptor (File_Count);
-    end Next_Available_File;
- 
- end CA11006_0;               -- Package File_Package   
- 
-      --=================================================================--
- 
- package CA11006_0.CA11006_1 is        -- Child package File_Package.Operations
- 
-    type File_Length_Type   is private;
-    type Extended_File_Type is new File_Type with private;
- 
-    System_Extended_File : constant Extended_File_Type;
- 
-    procedure Create_File (Mode : in     File_Mode;
-                           File :    out Extended_File_Type);    
- 
-    procedure Compress_File (Original        : in     Extended_File_Type;
-                             Compressed_File :    out Extended_File_Type);
- 
-    function  Validate (File : in Extended_File_Type) return Boolean;
- 
-    function  Validate_Compression (File : in Extended_File_Type) 
-      return Boolean;
-                                    -- These two validation functions provide
-                                    -- the capability to check the private
-                                    -- components defined in the parent and
-                                    -- child packages from within the client
-                                    -- program.
- private
- 
-    type File_Length_Type is new File_Measure;       -- Parent private type.
- 
-    Min_File_Size : File_Length_Type := File_Length_Type'First;
-    Max_File_Size : File_Length_Type := File_Length_Type'Last;
- 
-    type Extended_File_Type is new File_Type with        -- Parent type.
-       record
-          Blocks : File_Length_Type := Min_File_Size;
-       end record;
- 
-    System_Extended_File : constant Extended_File_Type :=
-      (Descriptor => System_File.Descriptor,      -- Parent private object.
-       Mode       => Read_Only,                   -- Parent enumeration literal.
-       Blocks     => Min_File_Size);
- 
- 
- end CA11006_0.CA11006_1;             -- Child Package File_Package.Operations
- 
-      --=================================================================--
- 
-                                 -- Child package body File_Package.Operations
- package body CA11006_0.CA11006_1 is  
- 
-    procedure Create_File 
-      (Mode : in     File_Mode; 
-       File :    out Extended_File_Type) is                 
-    begin
-       File.Descriptor := Next_Available_File;    -- Parent subprogram.
-       File.Mode       := Default_Mode;           -- Parent private constant.
-       File.Blocks     := Max_File_Size;
-    end Create_File;
-    ------------------------------------------------------------------------
-    procedure Compress_File (Original        : in     Extended_File_Type;
-                             Compressed_File :    out Extended_File_Type) is
-    begin
-       Compressed_File.Descriptor := Next_Available_File;      
-       Compressed_File.Mode       := Read_Only;
-       Compressed_File.Blocks     := Original.Blocks / 2;  -- Simulated file
-    end Compress_File;                                     -- compression.
-    ------------------------------------------------------------------------
-    function  Validate (File : in Extended_File_Type) return Boolean is      
-    begin
-       if ((File.Descriptor /= System_Extended_File.Descriptor) and    
-           (File.Mode = Read_Write)                             and
-           (File.Blocks = Max_File_Size))                       then
-          return True;
-       else
-          return False;
-       end if;
-    end Validate;
-    ------------------------------------------------------------------------
-    function  Validate_Compression (File : in Extended_File_Type) 
-       return Boolean is      
-    begin
-       if ((File.Descriptor /= System_File.Descriptor) and    
-           (File.Mode = Read_Only)                     and
-           (File.Blocks = Max_File_Size/2))            then
-          return True;
-       else
-          return False;
-       end if;
-    end Validate_Compression;
- 
- end CA11006_0.CA11006_1;         -- Child package body File_Package.Operations
- 
-      --=================================================================--
- 
- with CA11006_0.CA11006_1;        -- with Child package File_Package.Operations
- with Report;
- 
- procedure CA11006 is
- 
-    package File      renames CA11006_0;
-    package File_Ops  renames CA11006_0.CA11006_1;            
- 
-    Validation_File_Mode : File.File_Mode := File.Read_Only;
-    Validation_File,
-    Storage_Copy         : File_Ops.Extended_File_Type;     
- 
- begin
- 
-    Report.Test ("CA11006", "Check that the private part of a child "  &
-                            "library unit can utilize its parent "     &
-                            "unit's private definition");
- 
-    File_Ops.Create_File (Validation_File_Mode, Validation_File);
- 
-    if not File_Ops.Validate (Validation_File) then
-       Report.Failed ("Incorrect initialization of file");
-    end if;
- 
-    File_Ops.Compress_File (Validation_File, Storage_Copy);
- 
-    if not (File_Ops.Validate (Validation_File) and 
-            File_Ops.Validate_Compression (Storage_Copy))
-    then
-       Report.Failed ("Incorrect compression of file");
-    end if;
- 
-    Report.Result;
- 
- end CA11006; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,228 ****
- -- CA11007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the private part of a grandchild library unit can
- --      utilize its grandparent unit's private definition.
- --
- -- TEST DESCRIPTION:
- --      Declare a package, child package, and grandchild package, all 
- --      with private parts in their specifications.  
- --
- --      The private part of the grandchild package will make use of components
- --      that have been declared in the private part of the grandparent
- --      specification.
- --
- --      The child package demonstrates the extension of a parent file type 
- --      into an abstraction of an analog file structure. The grandchild package
- --      extends the grandparent file type into an abstraction of a digital 
- --      file structure, and provides conversion capability to/from the parent 
- --      analog file structure.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-   
- package CA11007_0 is                                -- Package File_Package 
- 
-    type File_Descriptor is private;
-    type File_Type       is tagged private;
- 
-    function  Next_Available_File return File_Descriptor;
- 
- private
- 
-    type File_Measure_Type is range 0 .. 1000;
-    type File_Descriptor   is new Integer;
- 
-    Null_Measure : constant File_Measure_Type := File_Measure_Type'First;
-    Null_File    : constant File_Descriptor   := 0;
- 
-    type File_Type is tagged
-      record
-         Descriptor : File_Descriptor := Null_File;
-      end record;
- 
- end CA11007_0;                                 -- Package File_Package  
- 
-      --=================================================================--
- 
- package body CA11007_0 is                      -- Package body File_Package  
- 
-    File_Count : Integer := 0;
- 
-    function Next_Available_File return File_Descriptor is
-    begin
-       File_Count := File_Count + 1;
-       return File_Descriptor (File_Count);
-    end Next_Available_File;
- 
- end CA11007_0;                                 -- Package body File_Package   
- 
-      --=================================================================--
- 
- package CA11007_0.CA11007_1 is                 -- Child package Analog
- 
-    type    Analog_File_Type is new File_Type with private;
- 
- private
- 
-    type Wavelength_Type is new File_Measure_Type;
- 
-    Min_Wavelength : constant Wavelength_Type := Wavelength_Type'First;
- 
-    type Analog_File_Type is new File_Type with          -- Parent type.
-       record                                           
-          Wavelength : Wavelength_Type := Min_Wavelength;
-       end record;
- 
- end CA11007_0.CA11007_1;                        -- Child package Analog
- 
-      --=================================================================--
- 
- package CA11007_0.CA11007_1.CA11007_2 is        -- Grandchild package Digital
- 
-    type    Digital_File_Type is new File_Type with private;
- 
-    procedure Recording (File : out Digital_File_Type);    
- 
-    procedure Convert (From : in     Analog_File_Type;
-                       To   :    out Digital_File_Type);
- 
-    function Validate         (File : in Digital_File_Type) return Boolean;
-    function Valid_Conversion (To : Digital_File_Type) return Boolean;
-    function Valid_Initial (From : Analog_File_Type) return Boolean;
- 
- private
- 
-    type Track_Type is new File_Measure_Type;          -- Grandparent type.
- 
-    Min_Tracks : constant Track_Type := 
-      Track_Type (Null_Measure) + Track_Type'First;    -- Grandparent private 
-    Max_Tracks : constant Track_Type :=                -- constant.
-      Track_Type (Null_Measure) + Track_Type'Last;
- 
-    type Digital_File_Type is new File_Type with       -- Grandparent type.  
-       record
-          Tracks : Track_Type := Min_Tracks;
-       end record;
- 
- end CA11007_0.CA11007_1.CA11007_2;             -- Grandchild package Digital
- 
-      --=================================================================--
- 
-                                           -- Grandchild package body Digital
- package body CA11007_0.CA11007_1.CA11007_2 is  
- 
-    procedure Recording (File : out Digital_File_Type) is
-    begin
-       File.Descriptor := Next_Available_File;    -- Assign new file descriptor.
-       File.Tracks     := Max_Tracks;             -- Change initial value.
-    end Recording;
-    --------------------------------------------------------------------------
-    procedure Convert (From : in     Analog_File_Type;
-                       To   :    out Digital_File_Type) is
-    begin
-       To.Descriptor := From.Descriptor + 100;            -- Dummy conversion.
-       To.Tracks     := Track_Type (From.Wavelength) / 2;
-    end Convert;                                     
-    --------------------------------------------------------------------------
-    function  Validate (File : in Digital_File_Type) return Boolean is
-       Result : Boolean := False;
-    begin
-       if not (File.Tracks /= Max_Tracks) then
-          Result := True;
-       end if;
-       return Result;                     
-    end Validate;
-    --------------------------------------------------------------------------
-    function Valid_Conversion (To : Digital_File_Type) return Boolean is
-    begin
-       return (To.Descriptor = 100) and (To.Tracks = (Min_Tracks / 2));
-    end Valid_Conversion;
-    --------------------------------------------------------------------------
-    function Valid_Initial (From : Analog_File_Type) return Boolean is
-    begin
-       return (From.Wavelength = Min_Wavelength);     -- Validate initial 
-    end Valid_Initial;                                -- conditions.  
- 
- end CA11007_0.CA11007_1.CA11007_2;     -- Grandchild package body Digital
- 
-      --=================================================================--
- 
- with CA11007_0.CA11007_1.CA11007_2;    -- with Grandchild package Digital
- with Report;
- 
- procedure CA11007 is
- 
-    package Analog  renames CA11007_0.CA11007_1;
-    package Digital renames CA11007_0.CA11007_1.CA11007_2;            
- 
-    Original_Digital_File,
-    Converted_Digital_File : Digital.Digital_File_Type;
- 
-    Original_Analog_File : Analog.Analog_File_Type;
- 
- begin
-    
-    -- This code demonstrates how private extensions could be utilized
-    -- in child packages to allow for recording on different media.  
-    -- The processing contained in the procedures and functions is
-    -- "dummy" processing, not intended to perform actual recording,
-    -- conversion, or validation operations, but simply to demonstrate 
-    -- this type of structural decomposition  as a possible solution to 
-    -- a user's design problem.
- 
-    Report.Test ("CA11007", "Check that the private part of a grandchild "  &
-                            "library unit can utilize its grandparent    "  &
-                            "unit's private definition");
- 
-    if not Digital.Valid_Initial (Original_Analog_File)
-    then
-       Report.Failed ("Incorrect initialization of Analog File");
-    end if;
- 
-    ---
- 
-    Digital.Convert (From => Original_Analog_File,        -- Convert file to
-                     To   => Converted_Digital_File);     -- digital format.
- 
-    if not Digital.Valid_Conversion (To => Converted_Digital_File) then
-       Report.Failed ("Incorrect conversion of analog file");
-    end if;
-              
-    ---
- 
-    Digital.Recording (Original_Digital_File);            -- Create file in
-                                                          -- digital format.
-    if not Digital.Validate (Original_Digital_File) then
-       Report.Failed ("Incorrect recording of digital file");
-    end if;
- 
-    Report.Result;
- 
- end CA11007; 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- CA11008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a private child package can use entities declared in the
- --      visible part of its parent unit.
- --      
- -- TEST DESCRIPTION:
- --      Declare a parent package containing types and objects used 
- --      by the system. Declare a private child package that uses the parent
- --      components to provide functionality to the system.  
- --
- --      The tagged file type defined in the parent has defaults for all
- --      component fields.  Prior to initialization, these values are checked
- --      to ensure a correct start condition.  The initial subprogram is
- --      called, which utilizes the functionality provided in the private
- --      child package.  This subprogram changes the fields of the file object
- --      to something other than the default values, and this process is then
- --      verified at the conclusion of the test.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-   
- package CA11008_0 is               -- Package OS.
- 
-    type File_Descriptor_Type is new Integer;
-    type File_Name_Type       is new String (1 .. 11);
-    type Permission_Type      is (None, User, System, Bypass);
-    type File_Mode_Type       is (Read_Only, Write_Only, Read_Write);
-    type File_Status_Type     is (Open, Closed);
- 
-    Default_Descriptor : constant File_Descriptor_Type := 0;
-    Default_Permission : constant Permission_Type      := None;
-    Default_Mode       : constant File_Mode_Type       := Read_Only;
-    Default_Status     : constant File_Status_Type     := Closed;
-    Default_Filename   : constant File_Name_Type       := "           ";
- 
-    Max_Files          : constant File_Descriptor_Type := 100;
-    Constant_Name      : constant File_Name_Type       := "AdaFileName";
-    File_Counter       : Integer                       := 0;
- 
-    type File_Type is tagged
-       record
-          Descriptor     : File_Descriptor_Type := Default_Descriptor;
-          Name           : File_Name_Type       := Default_Filename;
-          Acct_Access    : Permission_Type      := Default_Permission;
-          Mode           : File_Mode_Type       := Default_Mode;
-          Current_Status : File_Status_Type     := Default_Status;
-       end record;
- 
-    type File_Array_Type is array (1 .. Max_Files) of File_Type;
- 
-    File_Table : File_Array_Type;
- 
-    --
- 
-    function Get_File_Name return File_Name_Type;
- 
-    function Initialize_File return File_Descriptor_Type;
- 
- end CA11008_0;                     -- Package OS.
- 
-      --=================================================================--
- 
- -- Subprograms that perform the actual file operations are contained in a
- -- private package so that they are not accessible to any client.
- 
- private package CA11008_0.CA11008_1 is  -- Package OS.Internals
- 
-    Private_File_Counter : Integer renames File_Counter;          -- Parent 
-                                                                  -- object.
-    function Initialize 
-      (File_Name : File_Name_Type := Get_File_Name;      -- Parent function.
-       File_Mode : File_Mode_Type := Read_Write)         -- Parent literal.
-      return File_Descriptor_Type;                       -- Parent type.
- 
- end CA11008_0.CA11008_1;             -- Package OS.Internals
- 
-      --=================================================================--
- 
- package body CA11008_0.CA11008_1 is  -- Package body OS.Internals
- 
-    function Next_Available_File return File_Descriptor_Type is
-    begin
-       Private_File_Counter := Private_File_Counter + 1; 
-       return (File_Descriptor_Type(File_Counter));
-    end Next_Available_File;
-    -----------------------------------------------------------------
-    function Initialize 
-      (File_Name : File_Name_Type := Get_File_Name; -- Parent function
-       File_Mode : File_Mode_Type := Read_Write)    -- Parent literal
-      return File_Descriptor_Type is                -- Parent type
-       Number : File_Descriptor_Type;                         
-    begin
-       Number := Next_Available_File;
-       File_Table(Number).Descriptor := Number;     -- Parent object
-       File_Table(Number).Name := File_Name;        -- Default parameter value 
-       File_Table(Number).Mode := File_Mode;        -- Default parameter value
-       File_Table(Number).Acct_Access := User;
-       File_Table(Number).Current_Status := Open;
-       return (Number);
-    end Initialize;
- 
- end CA11008_0.CA11008_1;           -- Package body OS.Internals
- 
-      --=================================================================--
- 
- with CA11008_0.CA11008_1;          -- Private child package "withed" by
-                                    -- parent body.
- 
- package body CA11008_0 is          -- Package body OS
- 
-    function Get_File_Name return File_Name_Type is
-    begin
-       return (Constant_Name);   -- Of course if this was a real function, the
-    end Get_File_Name;           -- user would be asked to input a name, or
-                                 -- there would be some type of similar process.
- 
-    -- This subprogram utilizes a call to a subprogram contained in a private
-    -- child to perform the actual processing.
- 
-    function Initialize_File return File_Descriptor_Type is
-    begin
-      return (CA11008_0.CA11008_1.Initialize);    -- No parameters are needed, 
-                                                  -- since defaults have been 
-                                                  -- provided.
-    end Initialize_File;
- 
- end CA11008_0;                         -- Package body OS
- 
-      --=================================================================--
- 
- with CA11008_0;                        -- with Package OS.
- with Report;
- 
- procedure CA11008 is
- 
-    package OS renames CA11008_0;
-    use OS;
-    Ada_File_Key : File_Descriptor_Type := Default_Descriptor;
- 
- begin
- 
-    -- This test indicates one approach to file management operations.
-    -- It is not intended to demonstrate full functionality, but rather
-    -- that the use of a private child package can provide a solution
-    -- to a user situation, that being the implementation of certain functions
-    -- being provided in a child package, with the parent package body 
-    -- utilizing these implementations.
- 
-    Report.Test ("CA11008", "Check that a private child package can use "   &
-                            "entities declared in the visible part of its " &
-                            "parent unit");
- 
-    -- Check initial conditions of the first entry in the file table.
-    -- These are all default values provided in the declaration of the 
-    -- type File_Type.
- 
-    if (Ada_File_Key                 /= Default_Descriptor)  or else
-       (File_Table(1).Descriptor     /= (Default_Descriptor) or
-       (File_Table(1).Name           /= Default_Filename))   or else
-       (File_Table(1).Acct_Access    /= (Default_Permission) or
-       (File_Table(1).Mode           /= Default_Mode))       or else
-       (File_Table(1).Current_Status /= Default_Status)
-    then
-       Report.Failed ("Initial condition failure");
-    end if;
-    
-    -- Call the initialization function.  This will result in the resetting
-    -- of the fields associated with the first entry in the File_Table (this
-    -- is the first call of Initialize_File).  
-    -- No parameters are necessary for this call, due to the default values
-    -- provided in the private child package routine Initialize.
-    
-    Ada_File_Key := Initialize_File;
- 
-    -- Verify that the initial conditions of the file table component have
-    -- been properly modified by the initialization function.
- 
-    if not ((File_Table(1).Descriptor     = Ada_File_Key)         and then
-            (File_Table(1).Name           = Constant_Name) and then
-            (File_Table(1).Acct_Access    = User)              and then
-            not ((File_Table(1).Mode      = Default_Mode)      or else
-                 (File_Table(1).Current_Status = Default_Status)))
-    then
-       Report.Failed ("Initialization processing failure");
-    end if;
- 
-    Report.Result;
- 
- end CA11008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,246 ****
- -- CA11009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a private child package can use entities declared in the
- --      visible part of the parent unit of its parent unit.
- --
- -- TEST DESCRIPTION:
- --      Declare a parent package containing types and objects used by the 
- --      system.  Declare a public child package that provides a visible 
- --      interface to the system functionality.
- --      Declare a private grandchild package that uses the visible grandparent
- --      components to provide the actual functionality to the system. 
- --
- --      The public child (parent of the private grandchild) uses the 
- --      functionality of its private child (grandchild package) to provide 
- --      the visible interface to operations of the system.
- --
- --      The test itself will utilize the visible interface provided in the 
- --      public child package to demonstrate a possible structure for
- --      file management.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate_body.
- --
- --!
- 
- package CA11009_0 is               -- Package OS.
-    pragma Elaborate_Body (CA11009_0);
- 
-    type File_Descriptor_Type is new Integer;
-    type File_Name_Type       is new String (1 .. 11);
-    type Permission_Type      is (None, User, System, Bypass);
-    type File_Mode_Type       is (Read_Only, Write_Only, Read_Write);
-    type File_Status_Type     is (Open, Closed);
- 
-    Default_Descriptor : constant File_Descriptor_Type := 0;
-    Default_Permission : constant Permission_Type      := None;
-    Default_Mode       : constant File_Mode_Type       := Read_Only;
-    Default_Status     : constant File_Status_Type     := Closed;
-    Default_Filename   : constant File_Name_Type       := "           ";
- 
-    Max_Files          : constant File_Descriptor_Type := 10;
-    An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
-    File_Counter       : Integer                       := 0;
- 
-    type File_Type is tagged
-       record
-          Descriptor     : File_Descriptor_Type := Default_Descriptor;
-          Name           : File_Name_Type       := Default_Filename;
-          Acct_Access    : Permission_Type      := Default_Permission;
-          Mode           : File_Mode_Type       := Default_Mode;
-          Current_Status : File_Status_Type     := Default_Status;
-       end record;
- 
-    type File_Array_Type is array (1 .. Max_Files) of File_Type;
- 
-    File_Table : File_Array_Type;
- 
-    --
- 
-    function Get_File_Name return File_Name_Type;
- 
- end CA11009_0;                     -- Package OS.
- 
-      --=================================================================--
- 
- package body CA11009_0 is          -- Package body OS.
- 
-    function Get_File_Name return File_Name_Type is
-    begin
-       return (An_Ada_File_Name);   -- Processing would be replace by a user
-                                    -- prompt in a functioning system.
-    end Get_File_Name;           
-                                 
- end CA11009_0;                     -- Package body OS.
- 
-      --=================================================================--
- 
- package CA11009_0.CA11009_1 is     -- Child Package OS.File_Manager
- 
-    -- This package simulates a visible interface for the Operating System.
-    -- The actual processing performed by this routine is encapsulated
-    -- in the routines of private child package Internals, which is "withed"
-    -- by the body of this package.
- 
-    procedure Create_File (Mode      : in     File_Mode_Type;
-                           File_Key  :    out File_Descriptor_Type);
- 
- end CA11009_0.CA11009_1;           -- Child Package OS.File_Manager
- 
-      --=================================================================--
- 
- -- Subprogram that performs the actual file operation is contained in a
- -- private package so that it is not accessible to any client, and can be
- -- modified/extended without requiring recompilation of the clients of the
- -- parent (since this package is "withed" by the parent body only.)
- 
- 
-                                -- Grandchild Package OS.File_Manager.Internals
- private package CA11009_0.CA11009_1.CA11009_2 is  
- 
-    Initial_Permission : constant Permission_Type  := User;  -- Grandparent
-    Initial_Status     : constant File_Status_Type := Open;  -- literals.
-    Initial_Filename   : constant File_Name_Type   :=  -- Grandparent type.
-      Get_File_Name;                                   -- Grandparent function.
- 
-    function Create (Mode : File_Mode_Type)                      
-      return File_Descriptor_Type;                     -- Grandparent type.
- 
- end CA11009_0.CA11009_1.CA11009_2;   
-                           -- Grandchild Package OS.File_Manager.Internals
- 
-      --=================================================================--
- 
-                           -- Grandchild Package body OS.File_Manager.Internals
- package body CA11009_0.CA11009_1.CA11009_2 is  
- 
-    function Next_Available_File return File_Descriptor_Type is
-    begin
-       File_Counter := File_Counter + 1;              -- Grandparent object.
-       return (File_Descriptor_Type(File_Counter));
-    end Next_Available_File;
-    -------------------------------------------------------------------------
-    function Create (Mode : File_Mode_Type)           -- Grandparent literal.
-      return File_Descriptor_Type is
-       Number : File_Descriptor_Type;                 -- Grandparent type.
-    begin
-       Number := Next_Available_File;
-       File_Table(Number).Descriptor     := Number;   -- Grandparent object.
-       File_Table(Number).Name           := Initial_Filename;
-       File_Table(Number).Mode           := Mode;     -- Parameter.
-       File_Table(Number).Acct_Access    := Initial_Permission;
-       File_Table(Number).Current_Status := Initial_Status;
-       return (Number);
-    end Create;
- 
- end CA11009_0.CA11009_1.CA11009_2;  
-                           -- Grandchild Package body OS.File_Manager.Internals
- 
-      --=================================================================--
- 
-                                      -- "With" of a child package 
-                                      -- by the parent body.
- with CA11009_0.CA11009_1.CA11009_2;  -- Grandchild OS.File_Manager.Internals
- 
- package body CA11009_0.CA11009_1 is  -- Child Package body OS.File_Manager
- 
-    package Internal renames CA11009_0.CA11009_1.CA11009_2;            
- 
-    -- These subprograms utilize calls to subprograms contained in a private
-    -- sibling to perform the actual processing.
- 
-    procedure Create_File (Mode      : in     File_Mode_Type;
-                           File_Key  :    out File_Descriptor_Type) is
-    begin
-       File_Key := Internal.Create (Mode);
-    end Create_File;
- 
- end CA11009_0.CA11009_1;        -- Child Package body OS.File_Manager
- 
-      --=================================================================--
- 
- with CA11009_0.CA11009_1;       -- with Child Package OS.File_Manager
- with Report;
- 
- procedure CA11009 is
- 
-    package OS           renames CA11009_0;
-    use OS;
-    package File_Manager renames CA11009_0.CA11009_1;
- 
-    Data_Base_File_Key : File_Descriptor_Type := Default_Descriptor;
-    New_Mode           : File_Mode_Type := Read_Write;
- 
- begin
-    
-    -- This test indicates one approach to file management.
-    -- It is not intended to demonstrate full functionality, but rather
-    -- that the use of a private child package could provide a solution
-    -- to this type of situation.
- 
-    Report.Test ("CA11009", "Check that a private child package can use "   &
-                            "entities declared in the visible part of the " &
-                            "parent unit of its parent unit");
- 
-    -- Check initial conditions of the first entry in the file table.
-    -- These are all default values provided in the declaration of the 
-    -- type File_Type.                           
- 
-    if (not (Data_Base_File_Key      = Default_Descriptor)) and then
-       (((not (File_Table(1).Name    = Default_Filename))   or 
-       (File_Table(1).Descriptor     /= Default_Descriptor))  or else
-       ((File_Table(1).Acct_Access   /= Default_Permission)  or
-       (not (File_Table(1).Mode      = Default_Mode))       or
-       (File_Table(1).Current_Status /= Default_Status)))
-    then
-       Report.Failed ("Initial condition failure");
-    end if;
- 
-    -- Create/initialize file using the capability provided by the visible 
-    -- interface to the operating system, OS.File_Manager.  The actual 
-    -- processing routine is contained in the private grandchild package 
-    -- Internals, which utilize the components from the grandparent package.
- 
-    File_Manager.Create_File (New_Mode, Data_Base_File_Key);
- 
-    -- Verify that the initial conditions of the file table component have
-    -- been properly modified by the initialization function.
- 
-    if not ((File_Table(1).Descriptor          = Data_Base_File_Key)   and then
-            (File_Table(1).Name                = An_Ada_File_Name)  and then
-            (File_Table(1).Acct_Access         = User)              and then
-            not ((File_Table(1).Mode           = Default_Mode)      or else
-                 (File_Table(1).Current_Status = Default_Status)))
-    then
-       Report.Failed ("File creation failure");
-    end if;
- 
-    Report.Result;
- 
- end CA11009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,254 ****
- -- CA11010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     Check that a private child package can use entities declared in the
- --     private part of its parent unit.
- --
- -- TEST DESCRIPTION:
- --     Declare a parent package containing private types, objects,
- --     and functions used by the system. Declare a private child package that 
- --     uses the parent components to provide functionality to the system.  
- --
- --     Declare an array of files with default values for all 
- --     component fields of the files (records).  Check the initial state of
- --     a specified file for proper default values.  Perform the file "creation"
- --     (initialization), which will modify the fields of the record object.
- --     Again verify the file object to determine whether the fields have been
- --     reset properly.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
-    
- package CA11010_0 is               -- Package OS.
-  
-    type File_Descriptor_Type is private;
- 
-    Default_Descriptor  : constant File_Descriptor_Type;
- 
-    function  Initialize_File           return File_Descriptor_Type;
-    procedure Verify_Initial_Conditions (Status : out Boolean);
-    function  Final_Conditions_Valid    return Boolean;
- 
- private
- 
-    type File_Descriptor_Type    is new Integer;
-    type File_Name_Type          is new String (1 .. 11);
-    type Permission_Type         is (None, User, System);
-    type File_Mode_Type          is (Read_Only, Write_Only, Read_Write);
-    type File_Status_Type        is (Open, Closed);
- 
-    Default_Descriptor : constant File_Descriptor_Type := 0;
-    Default_Permission : constant Permission_Type      := None;
-    Default_Mode       : constant File_Mode_Type       := Read_Only;
-    Default_Status     : constant File_Status_Type     := Closed;
-    Default_Filename   : constant File_Name_Type       := "           ";
-    An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
-    Max_Files          : constant File_Descriptor_Type := 100;
- 
-    type File_Type is tagged
-       record
-          Descriptor     : File_Descriptor_Type := Default_Descriptor;
-          Name           : File_Name_Type       := Default_Filename;
-          Acct_Access    : Permission_Type      := Default_Permission;
-          Mode           : File_Mode_Type       := Default_Mode;
-          Current_Status : File_Status_Type     := Default_Status;
-       end record;
- 
-    type File_Array_Type is array (1 .. Max_Files) of File_Type;
- 
-    File_Table   : File_Array_Type;
-    File_Counter : Integer := 0;
- 
-    --
- 
-    function Get_File_Name return File_Name_Type;
- 
- end CA11010_0;                     -- Package OS.
- 
-      --=================================================================--
- 
- -- Subprograms that perform the actual file operations are contained in a
- -- private package so that they are not accessible to any client.
- 
- private package CA11010_0.CA11010_1 is  -- Package OS.Internals
- 
-    Private_File_Counter : Integer renames File_Counter; -- Parent priv. object.
- 
-    function Initialize 
-      (File_Name : File_Name_Type := Get_File_Name;  -- Parent priv. function.
-       File_Mode : File_Mode_Type := Read_Write)     -- Parent priv. literal.
-      return File_Descriptor_Type;                   -- Parent type.
- 
- end CA11010_0.CA11010_1;             -- Package OS.Internals
- 
-      --=================================================================--
- 
- package body CA11010_0.CA11010_1 is  -- Package body OS.Internals
- 
-    function Next_Available_File return File_Descriptor_Type is
-    begin
-       Private_File_Counter := Private_File_Counter + 1; 
-       return (File_Descriptor_Type(File_Counter));
-    end Next_Available_File;
-    ----------------------------------------------------------------
-    function Initialize 
-      (File_Name : File_Name_Type := Get_File_Name; -- Parent priv. function
-       File_Mode : File_Mode_Type := Read_Write)    -- Parent priv. literal
-      return File_Descriptor_Type is                -- Parent type
-       Number : File_Descriptor_Type;                         
-    begin
-       Number := Next_Available_File;
-       File_Table(Number).Descriptor := Number;     -- Parent priv. object
-       File_Table(Number).Name := File_Name;        -- Default parameter value 
-       File_Table(Number).Mode := File_Mode;        -- Default parameter value
-       File_Table(Number).Acct_Access := User;
-       File_Table(Number).Current_Status := Open;
-       return (Number);
-    end Initialize;
- 
- end CA11010_0.CA11010_1;           -- Package body OS.Internals
- 
-      --=================================================================--
- 
- with CA11010_0.CA11010_1;          -- Private child package "withed" by
-                                    -- parent body.
- 
- package body CA11010_0 is          -- Package body OS
- 
-    function Get_File_Name return File_Name_Type is
-    begin
-       return (An_Ada_File_Name); -- If this was a real function, the user 
-    end Get_File_Name;            -- would be asked to input a name, or there 
-                                  -- would be some type of similar processing.
- 
-    -- This subprogram utilizes a call to a subprogram contained in a private
-    -- child to perform the actual processing.
- 
-    function Initialize_File return File_Descriptor_Type is
-    begin
-      return (CA11010_0.CA11010_1.Initialize);    -- No parameters are needed, 
-                                                  -- since defaults have been 
-                                                  -- provided.
-    end Initialize_File;
- 
-    --
-    -- Separate subunits.
-    --
- 
-    procedure Verify_Initial_Conditions (Status : out Boolean) is separate;
- 
-    function  Final_Conditions_Valid return Boolean is separate;
- 
- end CA11010_0;                         -- Package body OS
- 
-      --=================================================================--
- 
- separate (CA11010_0)
- procedure Verify_Initial_Conditions (Status : out Boolean) is
- begin
-    Status := False;
-    if (File_Table(1).Descriptor     = Default_Descriptor) and then
-       (File_Table(1).Name           = Default_Filename)   and then
-       (File_Table(1).Acct_Access    = Default_Permission) and then
-       (File_Table(1).Mode           = Default_Mode)       and then
-       (File_Table(1).Current_Status = Default_Status)
-    then 
-       Status := True;
-    end if;
- end Verify_Initial_Conditions;
- 
-      --=================================================================--
- 
- separate (CA11010_0)
- function Final_Conditions_Valid return Boolean is 
- begin
-    if  ((File_Table(1).Descriptor         /= Default_Descriptor) and then
-         (File_Table(1).Name                = An_Ada_File_Name)   and then
-         (File_Table(1).Acct_Access         = User)               and then
-         not ((File_Table(1).Mode           = Default_Mode)       or else
-              (File_Table(1).Current_Status = Default_Status)))
-    then
-       return (True);
-    else
-       return (False);
-    end if;
- end Final_Conditions_Valid;
- 
-      --=================================================================--
- 
- with CA11010_0;                        -- with Package OS.
- with Report;
- 
- procedure CA11010 is
- 
-    package OS renames CA11010_0;
- 
-    Ada_File_Key          : OS.File_Descriptor_Type := OS.Default_Descriptor;
-    Initialization_Status : Boolean := False;
- 
- begin
- 
-    -- This test indicates one approach to a file management operation.
-    -- It is not intended to demonstrate full functionality, but rather
-    -- that the use of a private child package can provide a solution
-    -- to a user situation, that being the implementation of certain functions
-    -- being provided in a child package, with the parent package body 
-    -- utilizing these implementations.
- 
-    Report.Test ("CA11010", "Check that a private child package can use "   &
-                            "entities declared in the private part of its " &
-                            "parent unit");
- 
-    -- Check initial conditions of the first entry in the file table.
-    -- These are all default values provided in the declaration of the 
-    -- type File_Type.
- 
-    OS.Verify_Initial_Conditions (Initialization_Status);
- 
-    if not Initialization_Status then
-       Report.Failed ("Initial condition failure");
-    end if;
-    
-    -- Call the initialization function.  This will result in the resetting
-    -- of the fields associated with the first entry in the File_Table (this
-    -- is the first/only call of Initialize_File).  
-    -- No parameters are necessary for this call, due to the default values
-    -- provided in the private child package routine Initialize.
-    
-    Ada_File_Key := OS.Initialize_File;
- 
-    -- Verify that the initial conditions of the file table component have
-    -- been properly modified by the initialization function.
- 
-    if not OS.Final_Conditions_Valid then
-       Report.Failed ("Initialization processing failure");
-    end if;
- 
-    Report.Result;
- 
- end CA11010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,271 ****
- -- CA11011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a private child package can use entities declared in the
- --      private part of the parent unit of its parent unit.
- --
- -- TEST DESCRIPTION:
- --      Declare a parent package containing private types and objects
- --      used by the system.  Declare a public child package that 
- --      provides a visible interface to the system functionality.
- --      Declare a private grandchild package that uses the visible grandparent
- --      components to provide the actual functionality to the system. 
- --
- --      The public child (parent of the private grandchild) uses the 
- --      functionality of its private child (grandchild package) to provide 
- --      the visible interface to operations of the system.
- --
- --      The test itself will utilize the visible interface provided in the 
- --      public child package to demonstrate a possible solution to file 
- --      management.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CA11011_0 is               -- Package OS.
- 
-    type File_Descriptor_Type is private;
- 
-    Default_Descriptor  : constant File_Descriptor_Type;
-    First_File          : constant File_Descriptor_Type;
- 
-    procedure Verify_Initial_Conditions (Key    : in     File_Descriptor_Type;
-                                         Status :    out Boolean);
- 
-    function Final_Conditions_Valid (Key : File_Descriptor_Type) 
-      return Boolean;
- 
- 
- private
- 
-    type File_Descriptor_Type    is new Integer;
-    type File_Name_Type          is new String (1 .. 11);
-    type Permission_Type         is (None, User, System);
-    type File_Mode_Type          is (Read_Only, Write_Only, Read_Write);
-    type File_Status_Type        is (Open, Closed);
- 
-    Default_Descriptor : constant File_Descriptor_Type := 0;
-    First_File         : constant File_Descriptor_Type := 1;
-    Default_Permission : constant Permission_Type      := None;
-    Default_Mode       : constant File_Mode_Type       := Read_Only;
-    Default_Status     : constant File_Status_Type     := Closed;
-    Default_Filename   : constant File_Name_Type       := "           ";
- 
-    Init_Permission    : constant Permission_Type      := User;
-    Init_Mode          : constant File_Mode_Type       := Read_Write;
-    Init_Status        : constant File_Status_Type     := Open;
-    An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
- 
-    Max_Files          : constant File_Descriptor_Type := 10;
- 
-    type File_Type is tagged
-       record
-          Descriptor     : File_Descriptor_Type := Default_Descriptor;
-          Name           : File_Name_Type       := Default_Filename;
-          Acct_Access    : Permission_Type      := Default_Permission;
-          Mode           : File_Mode_Type       := Default_Mode;
-          Current_Status : File_Status_Type     := Default_Status;
-       end record;
- 
-    type File_Array_Type is array (1 .. Max_Files) of File_Type;
- 
-    File_Table   : File_Array_Type;
-    File_Counter : Integer := 0;
- 
-    --
- 
-    function  Get_File_Name return File_Name_Type;
- 
- end CA11011_0;                     -- Package OS.
- 
-      --=================================================================--
- 
- package body CA11011_0 is          -- Package body OS.
- 
-    function Get_File_Name return File_Name_Type is
-    begin
-       return (An_Ada_File_Name);
-    end Get_File_Name;
-    ---------------------------------------------------------------------
-    procedure Verify_Initial_Conditions (Key    : in     File_Descriptor_Type;
-                                         Status :    out Boolean) is
-    begin
-       Status := False;
-       if (File_Table(Key).Descriptor     = Default_Descriptor) and then
-          (File_Table(Key).Name           = Default_Filename)   and then
-          (File_Table(Key).Acct_Access    = Default_Permission) and then
-          (File_Table(Key).Mode           = Default_Mode)       and then
-          (File_Table(Key).Current_Status = Default_Status)
-       then 
-          Status := True;
-       end if;
-    end Verify_Initial_Conditions;
-    ---------------------------------------------------------------------
-    function Final_Conditions_Valid (Key : File_Descriptor_Type) 
-      return Boolean is
-    begin
-       if  ((File_Table(Key).Descriptor          = First_File)         and then
-            (File_Table(Key).Name                = An_Ada_File_Name)   and then
-            (File_Table(Key).Acct_Access         = Init_Permission)    and then
-            not ((File_Table(Key).Mode           = Default_Mode)       or else
-                 (File_Table(Key).Current_Status = Default_Status)))
-       then
-          return (True);
-       else
-          return (False);
-       end if;
-    end Final_Conditions_Valid;
- 
- end CA11011_0;                     -- Package body OS.
- 
-      --=================================================================--
- 
- package CA11011_0.CA11011_1 is     -- Package OS.File_Manager
- 
-    procedure Create_File (File_Key : in File_Descriptor_Type);
- 
- end CA11011_0.CA11011_1;           -- Package OS.File_Manager
- 
-      --=================================================================--
- 
- -- The Subprogram that performs the actual file operations is contained in a
- -- private package so that it is not accessible to any client.
- -- Default parameters are used in most cases in the subprogram calls, since
- -- the caller does not have visibility to these private types.
- 
-                                    -- Package OS.File_Manager.Internals
- private package CA11011_0.CA11011_1.CA11011_2 is  
- 
-    Private_File_Counter : Integer renames File_Counter;         -- Grandparent
-                                                                 -- object.
-    procedure Create 
-      (Key         : in     File_Descriptor_Type; 
-       File_Name   : in     File_Name_Type   := Get_File_Name;   -- Grandparent
-                                                                 -- prvt type,
-                                                                 -- prvt functn.
-       File_Mode   : in     File_Mode_Type   := Init_Mode;       -- Grandparent
-                                                                 -- prvt type,
-                                                                 -- prvt const.
-       File_Access : in     Permission_Type  := Init_Permission; -- Grandparent
-                                                                 -- prvt type,
-                                                                 -- prvt const.
-       File_Status : in     File_Status_Type := Init_Status);    -- Grandparent
-                                                                 -- prvt type,
-                                                                 -- prvt const.
- 
- end CA11011_0.CA11011_1.CA11011_2;   -- Package OS.File_Manager.Internals
- 
-      --=================================================================--
- 
-                                      -- Package Body OS.File_Manager.Internals
- package body CA11011_0.CA11011_1.CA11011_2 is  
- 
-    procedure Create 
-      (Key         : in     File_Descriptor_Type; 
-       File_Name   : in     File_Name_Type   := Get_File_Name;
-       File_Mode   : in     File_Mode_Type   := Init_Mode;
-       File_Access : in     Permission_Type  := Init_Permission;
-       File_Status : in     File_Status_Type := Init_Status) is
-    begin
-       Private_File_Counter := Private_File_Counter + 1;
-       File_Table(Key).Descriptor     := Key;            -- Grandparent object.
-       File_Table(Key).Name           := File_Name;            
-       File_Table(Key).Mode           := File_Mode;            
-       File_Table(Key).Acct_Access    := File_Access;            
-       File_Table(Key).Current_Status := File_Status;
-    end Create;
- 
- end CA11011_0.CA11011_1.CA11011_2;   -- Package body OS.File_Manager.Internals
- 
-      --=================================================================--
- 
- with CA11011_0.CA11011_1.CA11011_2;  -- with Child OS.File_Manager.Internals
- 
- package body CA11011_0.CA11011_1 is  -- Package body OS.File_Manager
- 
-    package Internal renames CA11011_0.CA11011_1.CA11011_2;            
- 
-    -- This subprogram utilizes a call to a subprogram contained in a private
-    -- child to perform the actual processing.
- 
-    procedure Create_File (File_Key : in File_Descriptor_Type) is
-    begin
-       Internal.Create (Key => File_Key);  -- Other parameters are defaults, 
-                                           -- since they are of private types
-                                           -- from the parent package.
-                                           -- File_Descriptor_Type is private,
-                                           -- but declared in visible part of 
-                                           -- parent spec.
-    end Create_File;
- 
- end CA11011_0.CA11011_1;        -- Package body OS.File_Manager
- 
-      --=================================================================--
- 
- with CA11011_0.CA11011_1;       -- with public Child Package OS.File_Manager
- with Report;
- 
- procedure CA11011 is
- 
-    package OS           renames CA11011_0;
-    package File_Manager renames CA11011_0.CA11011_1;
- 
-    Data_Base_File_Key : OS.File_Descriptor_Type := OS.First_File;
-    TC_Status          : Boolean := False;
- 
- begin
- 
-    -- This test indicates one approach to file management operations.
-    -- It is not intended to demonstrate full functionality, but rather
-    -- that the use of a private child package can provide a solution
-    -- to a typical user situation.
- 
-    Report.Test ("CA11011", "Check that a private child package can use "   &
-                            "entities declared in the private part of the " &
-                            "parent unit of its parent unit");
- 
-    OS.Verify_Initial_Conditions (Data_Base_File_Key, TC_Status);
- 
-    if not TC_Status then
-       Report.Failed ("Initial condition failure");
-    end if;
- 
-    -- Perform file initializations.
- 
-    File_Manager.Create_File (File_Key => Data_Base_File_Key);
- 
-    TC_Status := OS.Final_Conditions_Valid (Data_Base_File_Key);
- 
-    if not TC_Status then
-       Report.Failed ("Bad status return from Create_File");
-    end if;
- 
-    Report.Result;
- 
- end CA11011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,259 ****
- -- CA11012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a child package of a library level instantiation
- --      of a generic can be the instantiation of a child package of
- --      the generic. Check that the child instance can use its parent's
- --      declarations and operations, including a formal type of the parent. 
- --      
- -- TEST DESCRIPTION:
- --      Declare a generic package which simulates an integer complex 
- --      abstraction.  Declare a generic child package of this package 
- --      which defines additional complex operations. 
- --
- --      Instantiate the first generic package, then instantiate the child 
- --      generic package as a child unit of the first instance.  In the main
- --      program, check that the operations in both instances perform as 
- --      expected.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Dec 94   SAIC    Corrected visibility errors for literals
- --      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11012_3
- --!
- 
- generic               -- Complex number abstraction.
-    type Int_Type is range <>;
- 
- package CA11012_0 is
-  
-    -- Simulate a generic complex number support package. Complex numbers
-    -- are treated as coordinates in the Cartesian plane.
- 
-    type Complex_Type is private;
- 
-    Zero : constant Complex_Type;                      -- Real number (0,0).
- 
-    function Complex (Real, Imag : Int_Type)           -- Create a complex
-      return Complex_Type;                             -- number.
- 
-    function "-" (Right : Complex_Type)                -- Invert a complex
-      return Complex_Type;                             -- number.
- 
-    function "+" (Left, Right : Complex_Type)          -- Add two complex
-      return Complex_Type;                             -- numbers.
- 
- private
-    type Complex_Type is record
-       Real : Int_Type;
-       Imag : Int_Type;
-    end record;
- 
-    Zero : constant Complex_Type := (Real => 0, Imag => 0);
- 
- end CA11012_0;
- 
-      --==================================================================--
- 
- package body CA11012_0 is
- 
-    function Complex (Real, Imag : Int_Type) return Complex_Type is
-    begin
-       return (Real, Imag);
-    end Complex;
-    ---------------------------------------------------------------
-    function "-" (Right : Complex_Type) return Complex_Type is
-    begin
-       return (-Right.Real, -Right.Imag);
-    end "-";
-    ---------------------------------------------------------------
-    function "+" (Left, Right : Complex_Type) return Complex_Type is
-    begin
-       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
-    end "+";
- 
- end CA11012_0;
- 
-      --==================================================================--
- 
- -- Generic child of complex number package.  Child must be generic since 
- -- parent is generic. 
- 
- generic               -- Complex additional operations
- 
- package CA11012_0.CA11012_1 is
-  
-    -- More operations on complex number. This child adds a layer of
-    -- functionality to the parent generic.
- 
-    function Real_Part (Complex_No : Complex_Type)
-      return Int_Type;
- 
-    function Imag_Part (Complex_No : Complex_Type)
-      return Int_Type;
- 
-    function "*" (Factor : Int_Type; 
-                  C      : Complex_Type) return Complex_Type;
- 
-    function Vector_Magnitude (Complex_No : Complex_Type)
-      return Int_Type;
- 
- end CA11012_0.CA11012_1;
- 
-      --==================================================================--
- 
- package body CA11012_0.CA11012_1 is
- 
-    function Real_Part (Complex_No : Complex_Type) return Int_Type is
-    begin
-       return (Complex_No.Real);
-    end Real_Part;
-    ---------------------------------------------------------------
-    function Imag_Part (Complex_No : Complex_Type) return Int_Type is
-    begin
-       return (Complex_No.Imag);
-    end Imag_Part;
-    ---------------------------------------------------------------
-    function "*" (Factor : Int_Type; 
-                  C      : Complex_Type) return Complex_Type is
-       Result : Complex_Type := Zero;   -- Zero is declared in parent,
-                                        -- Complex_Number
-    begin
-       for I in 1 .. abs (Factor) loop
-          Result := Result + C;         -- Complex_Number "+"
-       end loop;
- 
-       if Factor < 0 then
-          Result := - Result;           -- Complex_Number "-"
-       end if;
- 
-       return Result;
-    end "*";
-    ---------------------------------------------------------------
-    function Vector_Magnitude (Complex_No : Complex_Type)
-      return Int_Type is                -- Not a real vector magnitude.
-    begin
-       return (Complex_No.Real + Complex_No.Imag);
-    end Vector_Magnitude;  
- 
- end CA11012_0.CA11012_1;
- 
-      --==================================================================--
- 
- package CA11012_2 is
- 
-    subtype My_Integer is integer range -100 .. 100;
- 
-    -- ... Various other types used by the application.
- 
- end CA11012_2;
- 
- -- No body for CA11012_2;
- 
-      --==================================================================--
- 
- -- Declare instances of the generic complex packages for integer type.  
- -- The instance of the child must itself be declared as a child of the 
- -- instance of the parent.
- 
- with CA11012_0;                        -- Complex number abstraction
- with CA11012_2;                        -- Package containing integer type
- pragma Elaborate (CA11012_0);
- package CA11012_3 is new CA11012_0 (Int_Type => CA11012_2.My_Integer);
- 
- with CA11012_0.CA11012_1;              -- Complex additional operations
- with CA11012_3;
- package CA11012_3.CA11012_4 is new CA11012_3.CA11012_1;
- 
-      --==================================================================--
- 
- with CA11012_2;                -- Package containing integer type
- with CA11012_3.CA11012_4;      -- Complex abstraction + additional operations
- with Report;
- 
- procedure CA11012 is
- 
-    package My_Complex_Pkg renames CA11012_3;
- 
-    package My_Complex_Operation renames CA11012_3.CA11012_4;
- 
-    use My_Complex_Pkg,                                -- All user-defined
-        My_Complex_Operation;                          -- operators directly
-                                                       -- visible.
-    Complex_One, Complex_Two : Complex_Type;
- 
- begin
- 
-    Report.Test ("CA11012", "Check that child instance can use its parent's "  &
-                            "declarations and operations, including a formal " &
-                            "type of the parent");
- 
-    Correct_Range_Test:
-    declare
-       My_Literal  : CA11012_2.My_Integer := -3;
- 
-    begin
-       Complex_One := Complex (-4, 7);          -- Operation from the generic 
-                                                -- parent package.
- 
-       Complex_Two := My_Literal * Complex_One; -- Operation from the generic 
-                                                -- child package.
- 
-       if Real_Part (Complex_Two) /= 12         -- Operation from the generic 
-         or Imag_Part (Complex_Two) /= -21      -- child package.
-           then
-              Report.Failed ("Incorrect results from complex operation");
-       end if;
- 
-    end Correct_Range_Test;
- 
-    ---------------------------------------------------------------
- 
-    Out_Of_Range_Test:
-    declare
-       My_Vector : CA11012_2.My_Integer;
- 
-    begin
-       Complex_One := Complex (70, 70);         -- Operation from the generic 
-                                                -- parent package.
-       My_Vector := Vector_Magnitude (Complex_One);         
-                      -- Operation from the generic child package.
- 
-       Report.Failed ("Exception not raised in child package");
- 
-    exception
-       when Constraint_Error =>
-         Report.Comment ("Exception is raised as expected");
- 
-       when others           =>
-         Report.Failed ("Others exception is raised");
- 
-    end Out_Of_Range_Test;
- 
-    Report.Result;
- 
- end CA11012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,201 ****
- -- CA11013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a child function of a library level instantiation
- --      of a generic can be the instantiation of a child function of
- --      the generic. Check that the child instance can use its parent's
- --      declarations and operations, including a formal subprogram of the 
- --      parent.                                                           
- --      
- -- TEST DESCRIPTION:
- --      Declare a generic package which simulates a real complex
- --      abstraction.  Declare a generic child function of this package 
- --      which builds a random complex number.  Declare a second
- --      package which defines a random complex number generator.  This
- --      package provides actual parameters for the generic parent package.
- --
- --      Instantiate the first generic package, then instantiate the child 
- --      generic function as a child unit of the first instance.  In the main
- --      program, check that the operations in both instances perform as 
- --      expected.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
- --                          clause of CA11013_3.
- --      27 Feb 97   CTA.PWB Added elaboration pragma at package CA11013_3
- --!
-   
- generic               -- Complex number abstraction.
-    type Real_Type is digits <>;
-    with function Random_Generator (Seed : Real_Type) return Real_Type;
- 
- package CA11013_0 is
-  
-    -- Simulate a generic complex number support package. Complex numbers
-    -- are treated as coordinates in the Cartesian plane.
- 
-    type Complex_Type is
-      record
-         Real : Real_Type;
-         Imag : Real_Type;
-      end record;
- 
-    function Make (Real, Imag : Real_Type)           -- Create a complex
-      return Complex_Type;                           -- number.
- 
-    procedure Components (Complex_No           : in Complex_Type;
-                          Real_Part, Imag_Part : out Real_Type);
- 
- end CA11013_0;
- 
-      --==================================================================--
- 
- package body CA11013_0 is
- 
-    function Make (Real, Imag : Real_Type) return Complex_Type is
-    begin
-       return (Real, Imag);
-    end Make;
-    -------------------------------------------------------------
-    procedure Components (Complex_No           : in Complex_Type;
-                          Real_Part, Imag_Part : out Real_Type) is
-    begin
-       Real_Part := Complex_No.Real;
-       Imag_Part := Complex_No.Imag;
-    end Components;
- 
- end CA11013_0;
- 
-      --==================================================================--
- 
- -- Generic child of complex number package.  This child adds a layer of 
- -- functionality to the parent generic.
- 
- generic               -- Random complex number operation.
- 
- function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type;
- 
-                --==============================================--
- 
- function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type is
- 
-    Random_Real_Part  :  Real_Type  := Random_Generator (Seed);
-                                       -- parent's formal subprogram
-    Random_Imag_Part  :  Real_Type  
-                      := Random_Generator (Random_Generator (Seed));
-                                       -- parent's formal subprogram
-    Random_Complex_No :  Complex_Type;
- 
- begin -- CA11013_0.CA11013_1
- 
-    Random_Complex_No := Make (Random_Real_Part, Random_Imag_Part);
-                                       -- operation from parent
-    return (Random_Complex_No); 
- 
- end CA11013_0.CA11013_1;
- 
-      --==================================================================--
- 
- package CA11013_2 is
-  
-    -- To be used as actual parameters for random number generator
-    -- in the parent package.
- 
-    type My_Float is digits 6 range -10.0 .. 100.0;
- 
-    function Random_Complex (Seed : My_float) return My_Float;
- 
- end CA11013_2;
- 
-      --==================================================================--
- 
- package body CA11013_2 is
- 
-    -- Not a real random number generator.
-    function Random_Complex (Seed : My_float) return My_Float is
-    begin
-       return (Seed + 3.0);    
-    end Random_Complex;
- 
- end CA11013_2;
- 
-      --==================================================================--
- 
- -- Declare instances of the generic complex packages for real type.  
- -- The instance of the child must itself be declared as a child of the 
- -- instance of the parent.
- 
- with CA11013_0;                       -- Complex number.
- with CA11013_2;                       -- Random number generator.
- pragma Elaborate (CA11013_0);
- package CA11013_3 is new 
-   CA11013_0 (Random_Generator => CA11013_2.Random_Complex,
-              Real_Type        => CA11013_2.My_Float);
- 
- with CA11013_0.CA11013_1;             -- Random complex number operation.
- with CA11013_3;
- pragma Elaborate (CA11013_3);
- function CA11013_3.CA11013_4 is new CA11013_3.CA11013_1;
-   
-      --==================================================================--
- 
- with Report;
- with CA11013_2;                       -- Random number generator.
- with CA11013_3.CA11013_4;             -- Complex abstraction + Random complex 
-                                       -- number operation.
- procedure CA11013 is
- 
-    package My_Complex_Pkg renames CA11013_3;
-    use type CA11013_2.My_Float;
- 
-    My_Complex                 : My_Complex_Pkg.Complex_Type;
-    My_Literal                 : CA11013_2.My_Float := 3.0;
-    My_Real_Part, My_Imag_Part : CA11013_2.My_Float;
- 
- begin
- 
-    Report.Test ("CA11013", "Check that child instance can use its parent's "  &
-                            "declarations and operations, including a formal " &
-                            "subprogram of the parent");
- 
-    My_Complex := CA11013_3.CA11013_4 (My_Literal); 
-                  -- Operation from the generic child function.
- 
-    My_Complex_Pkg.Components (My_Complex, My_Real_Part, My_Imag_Part);
-                  -- Operation from the generic parent package.
- 
-    if My_Real_Part /= 6.0           -- Operation from the generic 
-      or My_Imag_Part /= 9.0         -- parent package.
-        then
-          Report.Failed ("Incorrect results from complex operation");
-    end if;
- 
-    Report.Result;
- 
- end CA11013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,302 ****
- -- CA11014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an instantiation of a child package of a generic package
- --      can use its parent's declarations and operations, including a formal 
- --      package of the parent. 
- --
- -- TEST DESCRIPTION:
- --      Declare a list abstraction in a generic package which manages lists of
- --      elements of any discrete type. Declare a generic package which 
- --      operates on lists of elements of integer types.  Declare a generic
- --      child of this package which defines additional list operations. 
- --      Use the formal discrete type as the generic formal actual part for the
- --      parent formal package. 
- --
- --      Declare an instance of parent, then declare an instance of the child 
- --      which is itself a child the parent's instance. In the main program,
- --      check that the operations in both instances perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --      07 Sep 96   SAIC    Change formal param E to be out only.
- --      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
- --                          clauses of CA11014_0, CA11014_1, and CA11014_5.
- --      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11014_4
- --!
-   
- -- Actual package for the parent's formal.
- generic               
- 
-    type Element_Type is (<>);  -- List elems may be of any discrete types.
- 
- package CA11014_0 is              
- 
-    type Node_Type;
-    type Node_Pointer is access Node_Type;
- 
-    type Node_Type is record
-       Item : Element_Type;
-       Next : Node_Pointer := null;
-    end record;
- 
-    type List_Type is record
-       First   : Node_Pointer := null;
-       Current : Node_Pointer := null;
-       Last    : Node_Pointer := null;
-    end record;
- 
-    -- Return true if current element is last in the list.
-    function End_Of_List (L : List_Type) return boolean;
- 
-    -- Set "current" pointer to first list element.
-    procedure Reset (L : in out List_Type);
- 
- end CA11014_0;
- 
-      --==================================================================--
- 
- package body CA11014_0 is
- 
-    function End_Of_List (L : List_Type) return boolean is
-    begin
-       return (L.Current = null);
-    end End_Of_List;
-    -------------------------------------------------------
-    procedure Reset (L : in out List_Type) is
-    begin
-       L.Current := L.First;                 -- Set "current" pointer to first
-    end Reset;                               -- list element.
- 
- end CA11014_0;
- 
-      --==================================================================--
- 
- with CA11014_0;            -- Generic list abstraction.
- pragma Elaborate (CA11014_0);
- generic             
- 
-    -- Import the list abstraction defined in CA11014_0.
-    with package List_Mgr is new CA11014_0 (<>);
- 
- package CA11014_1 is    
- 
-    -- Write to current element and advance "current" pointer.
-    procedure Write_Element (L : in out List_Mgr.List_Type; 
-                             E : in     List_Mgr.Element_Type);
- 
-    -- Read from current element and advance "current" pointer.
-    procedure Read_Element (L : in out List_Mgr.List_Type; 
-                            E :    out List_Mgr.Element_Type);
- 
-    -- Add element to end of list.
-    procedure Add_Element (L : in out List_Mgr.List_Type; 
-                           E : in     List_Mgr.Element_Type);
- 
- end CA11014_1;
- 
-      --==================================================================--
- 
- package body CA11014_1 is
- 
-    procedure Write_Element (L : in out List_Mgr.List_Type; 
-                             E : in     List_Mgr.Element_Type) is
-    begin
-       L.Current.Item := E;               -- Write to current element.
-       L.Current      := L.Current.Next;  -- Advance "current" pointer.
-    end Write_Element;
-    -------------------------------------------------------
-    procedure Read_Element (L : in out List_Mgr.List_Type; 
-                            E :    out List_Mgr.Element_Type) is
-    begin
-       E         := L.Current.Item;       -- Retrieve current element.
-       L.Current := L.Current.Next;       -- Advance "current" pointer.
-    end Read_Element;
-    -------------------------------------------------------
-    procedure Add_Element (L : in out List_Mgr.List_Type; 
-                           E : in     List_Mgr.Element_Type) is
-       New_Node : List_Mgr.Node_Pointer := new List_Mgr.Node_Type'(E, null); 
-        use type List_Mgr.Node_Pointer;
-    begin
-       if L.First = null then                -- No elements in list, so add new
-          L.First := New_Node;               -- element at beginning of list.
-       else
-          L.Last.Next := New_Node;           -- Add new element at end of list.
-       end if;
-       L.Last := New_Node;                   -- Set last-in-list pointer.
-    end Add_Element;
- 
- end CA11014_1;
- 
-      --==================================================================--
- 
- -- Generic child of list operation.  This child adds a layer of 
- -- functionality to the parent generic.
- 
- generic
- 
- package CA11014_1.CA11014_2 is
- 
-    procedure Write_First_To_List (L : in out List_Mgr.List_Type);
- 
-    -- ... Various other operations used by the application.
- 
- end CA11014_1.CA11014_2;
- 
-      --==================================================================--
- 
- package body CA11014_1.CA11014_2 is
- 
-    procedure Write_First_To_List (L : in out List_Mgr.List_Type) is
-    begin
-       List_Mgr.Reset (L);    -- Parent's formal package.
- 
-       while not List_Mgr.End_Of_List (L) loop     -- Parent's formal package.
-          Write_Element (L, List_Mgr.Element_Type'First);   
-                                                   -- Parent's operation, 
-       end loop;                                   -- parent's formal.
-       
-    end Write_First_To_List;
- 
- end CA11014_1.CA11014_2;
- 
-      --==================================================================--
- 
- package CA11014_3 is
- 
-    type Points is range 0 .. 100;
- 
-    -- ... Various other types used by the application.
- 
- end CA11014_3;
- 
- 
- -- No body for CA11014_3;
- 
-      --==================================================================--
- 
- -- Declare instances of the generic list packages for the discrete type.
- -- The instance of the child must itself be declared as a child of the 
- -- instance of the parent.
- 
- with CA11014_0;               -- Generic list abstraction.
- with CA11014_3;               -- Package containing discrete type declaration.
- pragma Elaborate (CA11014_0);
- package CA11014_4 is new CA11014_0 (CA11014_3.Points);  -- Points list.
- 
- with CA11014_4;               -- Points list.
- with CA11014_1;               -- Generic list operation.
- pragma Elaborate (CA11014_1);
- package CA11014_5 is new CA11014_1 (CA11014_4);         -- Scores list.
- 
- with CA11014_1.CA11014_2;     -- Additional generic list operation,
- with CA11014_5;
- pragma Elaborate (CA11014_5);
- package CA11014_5.CA11014_6 is new CA11014_5.CA11014_2;
-                                                    -- Points list operation.
- 
-      --==================================================================--
- 
- with CA11014_1.CA11014_2;      -- Additional generic list operation,
-                                -- implicitly with list operation.
- with CA11014_3;                -- Package containing discrete type declaration.
- with CA11014_4;                -- Points list.
- with CA11014_5.CA11014_6;      -- Points list operation.
- with Report;
- 
- procedure CA11014 is
- 
-    package Lists_Of_Scores renames CA11014_4;
-    package Score_Ops renames CA11014_5;
-    package Point_Ops renames CA11014_5.CA11014_6;
- 
-    Scores : Lists_Of_Scores.List_Type;                -- List of points.
- 
-    type TC_Score_Array is array (1 .. 3) of CA11014_3.Points;
- 
-    TC_Initial_Values : constant TC_Score_Array := (10, 21, 49);
-    TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
- 
-    TC_Initial_Values_Are_Correct : boolean := false;
-    TC_Final_Values_Are_Correct   : boolean := false;
- 
-                --------------------------------------------------
- 
-    -- Initial list contains 3 scores with the values 10, 21, and 49.
-    procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
-    begin                                  
-       for I in TC_Score_Array'range loop  
-          Score_Ops.Add_Element (L, TC_Initial_Values(I));
-                    -- Operation from generic parent.
-       end loop;
-    end TC_Initialize_List;
- 
-                --------------------------------------------------
- 
-    -- Verify that all scores have been set to zero.
-    procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
-                              Expected : in     TC_Score_Array;
-                              OK       :    out boolean) is
-       Actual : TC_Score_Array;
-    begin                                  
-       Lists_of_Scores.Reset (L);       -- Operation from parent's formal.
-       for I in TC_Score_Array'range loop
-          Score_Ops.Read_Element (L, Actual(I));
-                    -- Operation from generic parent.
-       end loop;
-       OK := (Actual = Expected);
-    end TC_Verify_List;
- 
-                --------------------------------------------------
- 
- begin -- CA11014 
- 
-    Report.Test ("CA11014", "Check that an instantiation of a child package " &
-                            "of a generic package can use its parent's "      & 
-                            "declarations and operations, including a "       &
-                            "formal package of the parent");
- 
-    TC_Initialize_List (Scores);
-    TC_Verify_List (Scores, TC_Initial_Values, TC_Initial_Values_Are_Correct);
- 
-    if not TC_Initial_Values_Are_Correct then
-       Report.Failed ("List contains incorrect initial values");
-    end if;
- 
-    Point_Ops.Write_First_To_List (Scores);
-                    -- Operation from generic child package.
- 
-    TC_Verify_List (Scores, TC_Final_Values, TC_Final_Values_Are_Correct);
- 
-    if not TC_Final_Values_Are_Correct then
-       Report.Failed ("List contains incorrect final values");
-    end if;
- 
-    Report.Result;
- 
- end CA11014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,312 ****
- -- CA11015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a generic child of a non-generic package can use its 
- --      parent's declarations and operations.  Check that the instantiation
- --      of the generic child can correctly use the operations.
- --
- -- TEST DESCRIPTION:
- --      Declare a map abstraction in a package which manages basic physical
- --      maps.  Declare a generic child of this package which defines copies
- --      of maps of any discrete type, i.e., population, density, or weather.
- --
- --      In the main program, declare an instance of the child.  Check that
- --      the operations in the parent and instance of the child package 
- --      perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Simulates map of physical features, i.e., desert, forest, water, 
- -- or plains.
- 
- package CA11015_0 is              
-    type Map_Type is private;
-    subtype Latitude is integer range 1 .. 9;
-    subtype Longitude is integer range 1 .. 7;
- 
-    type Physical_Features is (Desert, Forest, Water, Plains, Unexplored);
-    type Page_Type is range 0 .. 80;
-    
-    Terra_Incognita : exception;
- 
-    -- Use geographic database to initialize the basic map.
- 
-    procedure Initialize_Basic_Map (Map  : in out Map_Type);
- 
-    function Get_Physical_Feature (Lat  : Latitude;
-                                   Long : Longitude;
-                                   Map  : Map_Type) return Physical_Features;
- 
-    function Next_Page return Page_Type;
- 
- private
-    type Map_Type is array (Latitude, Longitude) of Physical_Features;
-    Basic_Map : Map_Type;
-    Page      : Page_Type := 0;       -- Location for each copy of Map.
- 
- end CA11015_0;
- 
-      --==================================================================--
- 
- package body CA11015_0 is              
- 
-    procedure Initialize_Basic_Map (Map : in out Map_Type) is
-    -- Not a real initialization.  Real application can use geographic
-    -- database to create the basic map.
-    begin
-       for I in Latitude'first .. Latitude'last loop
-          for J in 1 .. 2 loop
-             Map (I, J) := Unexplored;
-          end loop;
-          for J in 3 .. 4 loop
-             Map (I, J) := Desert;
-          end loop;
-          for J in 5 .. 7 loop
-             Map (I, J) := Plains;
-          end loop;
-       end loop;
- 
-    end Initialize_Basic_Map;
-    ---------------------------------------------------
-    function Get_Physical_Feature (Lat  : Latitude;
-                                   Long : Longitude;
-                                   Map  : Map_Type) 
-      return Physical_Features is
-    begin
-      return (Map (Lat, Long));
-    end Get_Physical_Feature;
-    ---------------------------------------------------
-    function Next_Page return Page_Type is
-    begin
-       Page := Page + 1;
-       return (Page);
-    end Next_Page;
- 
-    ---------------------------------------------------
-    begin -- CA11015_0
-       -- Initialize a basic map.
-       Initialize_Basic_Map (Basic_Map);
- 
- end CA11015_0;
- 
-      --==================================================================--
- 
- -- Generic child package of physical map.  Instantiate this package to
- -- create map copy with a new geographic feature, i.e., population, density,
- -- or weather.
- 
- generic               
- 
-    type Generic_Feature is (<>);  -- Any geographic feature, i.e., population,
-                                   -- density, or weather that can be
-                                   -- characterized by a scalar value.
- 
- package CA11015_0.CA11015_1 is              
- 
-    type Feature_Map is private;
- 
-    function Get_Feature_Val (Lat  : Latitude;
-                              Long : Longitude;
-                              Map  : Feature_Map) return Generic_Feature;
- 
-    procedure Set_Feature_Val (Lat  : in     Latitude;
-                               Long : in     Longitude;
-                               Fea  : in     Generic_Feature;
-                               Map  : in out Feature_Map);
- 
-    function Check_Page (Map     : Feature_Map;
-                         Page_No : Page_Type) return boolean;
- 
- private
-    type Feature_Type is array (Latitude, Longitude) of Generic_Feature;
- 
-    type Feature_Map is
-      record
-         Feature : Feature_Type;
-         Page    : Page_Type := Next_Page;    -- Operation from parent.
-      end record;
- 
- end CA11015_0.CA11015_1;
- 
-      --==================================================================--
- 
- package body CA11015_0.CA11015_1 is              
- 
-    function Get_Feature_Val (Lat  : Latitude;
-                              Long : Longitude;
-                              Map  : Feature_Map) return Generic_Feature is
-    begin
-      return (Map.Feature (Lat, Long));
-    end Get_Feature_Val;
-    ---------------------------------------------------
-    procedure Set_Feature_Val (Lat  : in     Latitude;
-                               Long : in     Longitude;
-                               Fea  : in     Generic_Feature;
-                               Map  : in out Feature_Map) is
-    begin
-       if Get_Physical_Feature (Lat, Long, Basic_Map) = Unexplored  
-                                                 -- Parent's operation,
-                                                 -- Parent's private object.
-       then
-          raise Terra_Incognita;                 -- Exception from parent.
-       else
-          Map.Feature (Lat, Long) := Fea;
-       end if;
-    end Set_Feature_Val;
-    ---------------------------------------------------
-    function Check_Page (Map     : Feature_Map;
-                         Page_No : Page_Type) return boolean is
-    begin
-       return (Map.Page = Page_No);
-    end Check_Page;
- 
- end CA11015_0.CA11015_1;
- 
-      --==================================================================--
- 
- with CA11015_0.CA11015_1;              -- Generic map operation,
-                                        -- implicitly withs parent, basic map
-                                        -- application.
- with Report;
- 
- procedure CA11015 is
- 
- begin 
- 
-    Report.Test ("CA11015", "Check that an instantiation of a child package " &
-                            "of a non-generic package can use its parent's "  &
-                            "declarations and operations");
- 
- -- An application creates a population map using an integer type.
- 
-            Population_Map_Subtest:
-            declare
-               type Population_Type is range 0 .. 10_000;         
- 
-               -- Declare instance of the child generic map package for one 
-               -- particular integer type.            
- 
-               package Population is new CA11015_0.CA11015_1 (Population_Type);
- 
-               Population_Map_Latitude   : CA11015_0.Latitude := 1;  
-                                                    -- parent's type
-               Population_Map_Longitude : CA11015_0.Longitude := 5;
-                                                    -- parent's type
-               Pop_Map                   : Population.Feature_Map;
-               Pop                       : Population_Type := 1000;
- 
-            begin
-               Population.Set_Feature_Val (Population_Map_Latitude, 
-                                           Population_Map_Longitude,
-                                           Pop, 
-                                           Pop_Map);
- 
-               If not ( (Population.Get_Feature_Val (Population_Map_Latitude, 
-                 Population_Map_Longitude, Pop_Map) = Pop) or  
-                   (Population.Check_Page (Pop_Map, 1)) ) then
-                     Report.Failed ("Population map contains incorrect values");
-               end if;
- 
-            end Population_Map_Subtest;
- 
- -- An application creates a weather map using an enumeration type.
- 
-            Weather_Map_Subtest:
-            declare
-               type Weather_Type is (Hot, Cold, Mild);                    
- 
-               -- Declare instance of the child generic map package for one 
-               -- particular enumeration type.            
- 
-               package Weather_Pkg is new CA11015_0.CA11015_1 (Weather_Type);
- 
-               Weather_Map_Latitude   : CA11015_0.Latitude := 2;
-                                                    -- parent's type
-               Weather_Map_Longitude : CA11015_0.Longitude := 6;
-                                                    -- parent's type
-               Weather_Map            : Weather_Pkg.Feature_Map;
-               Weather                : Weather_Type := Mild;
- 
-            begin
-               Weather_Pkg.Set_Feature_Val (Weather_Map_Latitude, 
-                                            Weather_Map_Longitude,
-                                            Weather, 
-                                            Weather_Map);
- 
-               if ( (Weather_Pkg.Get_Feature_Val (Weather_Map_Latitude, 
-                     Weather_Map_Longitude, Weather_Map) /= Weather) or
-                 not (Weather_Pkg.Check_Page (Weather_Map, 2)) )
-               then
-                  Report.Failed ("Weather map contains incorrect values");
-               end if;
- 
-            end Weather_Map_Subtest;
- 
- -- During processing, the application may erroneously attempts to create 
- -- a density map on an unexplored area.  This would result in the raising 
- -- of an exception.
- 
-            Density_Map_Subtest:
-            declare
-               type Density_Type is (High, Medium, Low);
- 
-               -- Declare instance of the child generic map package for one 
-               -- particular enumeration type.            
- 
-               package Density_Pkg is new CA11015_0.CA11015_1 (Density_Type);
- 
-               Density_Map_Latitude   : CA11015_0.Latitude := 7;
-                                                    -- parent's type
-               Density_Map_Longitude : CA11015_0.Longitude := 2;
-                                                    -- parent's type
-               Density                : Density_Type := Low;
-               Density_Map            : Density_Pkg.Feature_Map;
- 
-            begin
-               Density_Pkg.Set_Feature_Val (Density_Map_Latitude, 
-                                            Density_Map_Longitude,
-                                            Density, 
-                                            Density_Map);
- 
-               Report.Failed ("Exception not raised in child generic package");
- 
-            exception
- 
-               when CA11015_0.Terra_Incognita =>   -- parent's exception,
-                   null;                           -- raised in child.
- 
-               when others          =>         
-                   Report.Failed ("Others exception is raised");
- 
-            end Density_Map_Subtest;
- 
-    Report.Result;
- 
- end CA11015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11016.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11016.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11016.a	Thu Jan  1 00:00:00 1970
***************
*** 1,321 ****
- -- CA11016.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a child of a non-generic package can be a private generic 
- --      package. Check that the private child instance can use its parent's
- --      declarations and operations.  Check that the body of a public child 
- --      package can instantiate its sibling private generic package.
- --
- -- TEST DESCRIPTION:
- --      Declare a map abstraction in a package which manages basic physical
- --      map[s].  Declare a private generic child of this package which can be
- --      instantiated for any display device which has display locations of 
- --      the physical map that can be characterized by any integer type, i.e., 
- --      the intensity of the display point.
- --
- --      Declare a public child of the physical map which specifies the 
- --      display device.  In the body of this child, declare an instance of 
- --      its generic sibling to display the geographic locations.
- --
- --      In the main program, check that the operations in the parent, public 
- --      child and instance of the private child package perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      17 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate.
- --
- --!
- 
- -- Simulates map of physical features, i.e., desert, forest, or water.
- 
- package CA11016_0 is              
-    type Map_Type is private;
-    subtype Latitude is integer range 1 .. 9;
-    subtype Longitude is integer range 1 .. 7;
- 
-    type Physical_Features is (Desert, Forest, Water);
-    
-    -- Use geographic database to initialize the basic map.
- 
-    procedure Initialize_Basic_Map (Map  : in out Map_Type);
- 
-    function Get_Physical_Feature (Lat  : Latitude;
-                                   Long : Longitude;
-                                   Map  : Map_Type) return Physical_Features;
- 
- private
-    type Map_Type is array (Latitude, Longitude) of Physical_Features;
-    Basic_Map : Map_Type;
- 
- end CA11016_0;
- 
-      --==================================================================--
- 
- package body CA11016_0 is              
- 
-    procedure Initialize_Basic_Map (Map : in out Map_Type) is
-    -- Not a real initialization.  Real application can use geographic
-    -- database to create the basic map.
- 
-    begin
-       for I in Latitude'first .. Latitude'last loop
-          for J in 1 .. 2 loop
-             Map (I, J) := Desert;
-          end loop;
-          for J in 3 .. 4 loop
-             Map (I, J) := Forest;
-          end loop;
-          for J in 5 .. 7 loop
-             Map (I, J) := Water;
-          end loop;
-       end loop;
- 
-    end Initialize_Basic_Map;
-    --------------------------------------------------------
-    function Get_Physical_Feature (Lat  : Latitude;
-                                   Long : Longitude;
-                                   Map  : Map_Type) 
-      return Physical_Features is
-    begin
-      return (Map (Lat, Long));
-    end Get_Physical_Feature;
-    --------------------------------------------------------
- 
-    begin
-       -- Initialize a basic map.
-       Initialize_Basic_Map (Basic_Map);
- 
- end CA11016_0;
- 
-      --==================================================================--
- 
- -- Private generic child package of physical map.  This generic package may
- -- be instantiated for any display device which has display locations 
- -- (latitude, longitude) that can be characterized by an integer value.
- -- For example, the intensity of the display point might be so characterized.
- -- It can be instantiated for any desired range of values (which would 
- -- correspond to the range accepted by the display device).
- 
- 
- private 
- 
- generic               
- 
-    type Display_Value is range <>;  -- Any display feature that is 
-                                     -- represented by an integer.
- 
- package CA11016_0.CA11016_1 is              
- 
-    function Get_Display_Value (Lat  : Latitude;
-                                Long : Longitude;
-                                Map  : Map_Type) return Display_Value;
- 
- end CA11016_0.CA11016_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CA11016_0.CA11016_1 is              
- 
-    function Get_Display_Value (Lat  : Latitude;
-                                Long : Longitude;
-                                Map  : Map_Type) 
-      return Display_Value is
-    begin
-       case Get_Physical_Feature (Lat, Long, Map) is
-                                           -- Parent's operation,
-            when Forest => return (Display_Value'first);
-                                           -- Parent's type.
-            when Desert => return (Display_Value'last);
-                                           -- Parent's type.
-            when others => return 
-                             ( (Display_Value'last - Display_Value'first) / 2 );
-                                           -- NOTE: Results are truncated.
-       end case;
- 
-    end Get_Display_Value;
- 
- end CA11016_0.CA11016_1;
- 
- 
-      --==================================================================--
- 
- -- Map display operation, public child of physical map.
- 
- package CA11016_0.CA11016_2 is              
- 
-    -- Super-duper Ultra Geographic Display Device (SDUGD) can display 
-    -- geographic locations with light intensity values ranging from 1 to 7.
- 
-    type Display_Val is range 1 .. 7;
- 
-    type Device_Color is (Brown, Blue, Green);
- 
-    type IO_Packet is
-       record
-          Lat       : Latitude;       -- Parent's type.
-          Long      : Longitude;      -- Parent's type.
-          Color     : Device_Color;
-          Intensity : Display_Val;
-       end record;
- 
-    procedure Data_For_SDUGD (Lat           : in     Latitude;
-                              Long          : in     Longitude;
-                              Output_Packet : in out IO_Packet);
- 
- end CA11016_0.CA11016_2;
- 
-      --==================================================================--
- 
- 
- with CA11016_0.CA11016_1;          -- Private generic sibling.
- pragma Elaborate (CA11016_0.CA11016_1);
- 
- package body CA11016_0.CA11016_2 is              
- 
-    -- Declare instance of the private generic sibling for 
-    -- an integer type that represents color intensity.
- 
-    package SDUGD is new CA11016_0.CA11016_1 (Display_Val);
- 
-    procedure Data_For_SDUGD (Lat           : in     Latitude;
-                              Long          : in     Longitude;
-                              Output_Packet : in out IO_Packet) is
- 
-    -- Simulates sending control information to a display device.
-    -- Control information consists of latitude, longitude, a
-    -- color, and an intensity.
- 
-    begin
-       case Get_Physical_Feature (Lat, Long, Basic_Map) is
-                                            -- Parent's operation.
-          when Water  => Output_Packet.Color     := Blue;
-                         Output_Packet.Intensity := SDUGD.Get_Display_Value 
-                                                    (Lat, Long, Basic_Map);
-                                            -- Sibling's operation.
-          when Forest => Output_Packet.Color     := Green;
-                         Output_Packet.Intensity := SDUGD.Get_Display_Value 
-                                                    (Lat, Long, Basic_Map);
-                                            -- Sibling's operation.
-          when others => Output_Packet.Color     := Brown;
-                         Output_Packet.Intensity := SDUGD.Get_Display_Value 
-                                                    (Lat, Long, Basic_Map);
-                                            -- Sibling's operation.
-        end case;
- 
-    end Data_For_SDUGD;
- 
- end CA11016_0.CA11016_2;
- 
-      --==================================================================--
- 
- with CA11016_0.CA11016_2;            -- Map display device operation,
-                                      -- implicitly withs parent, physical map
-                                      -- application.
- 
- use CA11016_0.CA11016_2;             -- Allows direct visibility to the simple
-                                      -- name of CA11016_0.CA11016_2.
- 
- with Report;
- 
- procedure CA11016 is
- 
-    TC_Packet : IO_Packet;
- 
- begin 
- 
-    Report.Test ("CA11016", "Check that body of a public child package can " &
-                            "use its sibling private generic package "       &
-                            "declarations and operations");
- 
- -- Simulate control information at coordinates 3 and 7 of the
- -- basic map for the SDUGD.
-          
-          Water_Display_Subtest:
-          begin
-             TC_Packet.Lat  := 3;
-             TC_Packet.Long := 7;
- 
-             -- Build color and light intensity of the basic map at 
-             -- latitude 3 and longitude 7.
- 
-             Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
- 
-             if ( (TC_Packet.Color     /= Blue) or
-                  (TC_Packet.Intensity /= 3) ) then
-                 Report.Failed ("Map display device contains " &
-                                "incorrect values for water subtest");
-             end if;
- 
-          end Water_Display_Subtest;
- 
- -- Simulate control information at coordinates 2 and 1 of the
- -- basic map for the SDUGD.
-          
-          Desert_Display_Subtest:
-          begin
-             TC_Packet.Lat  := 9;
-             TC_Packet.Long := 2;
- 
-             -- Build color and light intensity of the basic map at 
-             -- latitude 9 and longitude 2.
- 
-             Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
- 
-             if ( (TC_Packet.Color     /= Brown) or
-                  (TC_Packet.Intensity /= 7) ) then
-                 Report.Failed ("Map display device contains " &
-                                "incorrect values for desert subtest");
-             end if;
- 
-          end Desert_Display_Subtest;
- 
- -- Simulate control information at coordinates 8 and 4 of the
- -- basic map for the SDUGD.
-          
-          Forest_Display_Subtest:
-          begin
-             TC_Packet.Lat  := 8;
-             TC_Packet.Long := 4;
- 
-             -- Build color and light intensity of the basic map at 
-             -- latitude 8 and longitude 4.
- 
-             Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
- 
-             if ( (TC_Packet.Color     /= Green) or
-                  (TC_Packet.Intensity /= 1) ) then
-                 Report.Failed ("Map display device contains " &
-                                "incorrect values for forest subtest");
-             end if;
- 
-          end Forest_Display_Subtest;
- 
-    Report.Result;
- 
- end CA11016;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11017.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11017.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11017.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11017.a	Thu Jan  1 00:00:00 1970
***************
*** 1,246 ****
- -- CA11017.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that body of the parent package may depend on one of its own 
- --      public children.
- --
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential of adding a
- --      public child during code maintenance without distubing a large 
- --      subsystem.  After child is added to the subsystem, a maintainer
- --      decides to take advantage of the new functionality and rewrites
- --      the parent's body.
- --
- --      Declare a string abstraction in a package which manipulates string
- --      replacement. Define a parent package which provides operations for 
- --      a record type with discriminant.  Declare a public child of this 
- --      package which adds functionality to the original subsystem.  In the 
- --      parent body, call operations from the public child.
- --
- --      In the main program, check that operations in the parent and public 
- --      child perform as expected.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Simulates application which manipulates strings.
- 
- package CA11017_0 is               
- 
-    type String_Rec (The_Size : positive) is private;
- 
-    type Substring is new string;
- 
-    -- ... Various other types used by the application.
- 
-    procedure Replace (In_The_String   : in out String_Rec;
-                       At_The_Position : in     positive;
-                       With_The_String : in     String_Rec);
- 
-    -- ... Various other operations used by the application.
- 
- private
-    -- Different size for each individual record.
- 
-    type String_Rec (The_Size : positive) is
-       record
-          The_Length  : natural := 0;
-          The_Content : Substring (1 .. The_Size);
-       end record;
- 
- end CA11017_0;
- 
-      --=================================================================--
- 
- -- Public child added during code maintenance without disturbing a 
- -- large system.  This public child would add functionality to the
- -- original system.
- 
- package CA11017_0.CA11017_1 is    
- 
-    Position_Error : exception;
- 
-    function Equal_Length (Left  : in String_Rec;
-                           Right : in String_Rec) return boolean;
- 
-    function Same_Content (Left  : in String_Rec;
-                           Right : in String_Rec) return boolean;
- 
-    procedure Copy (From_The_Substring : in     Substring;
-                    To_The_String      : in out String_Rec);
- 
-    -- ... Various other operations used by the application.
- 
- end CA11017_0.CA11017_1;
- 
-      --=================================================================--
- 
- package body CA11017_0.CA11017_1 is    
- 
-    function Equal_Length (Left  : in String_Rec;
-                           Right : in String_Rec) return boolean is
-    -- Quick comparison between the lengths of the input strings.
- 
-    begin
-       return (Left.The_Length = Right.The_Length);  -- Parent's private
-                                                     -- type.
-    end Equal_Length;
-    --------------------------------------------------------------------
-    function Same_Content (Left  : in String_Rec;
-                           Right : in String_Rec) return boolean is
- 
-    begin
-       for I in 1 .. Left.The_Length loop
-          if Left.The_Content (I) = Right.The_Content (I) then
-             return true;
-          else
-             return false;
-          end if;
-       end loop;
- 
-    end Same_Content;
-    --------------------------------------------------------------------
-    procedure Copy (From_The_Substring : in     Substring;
-                    To_The_String      : in out String_Rec) is
-    begin
-       To_The_String.The_Content        -- Parent's private type.
-         (1 .. From_The_Substring'length) := From_The_Substring;
- 
-       To_The_String.The_Length         -- Parent's private type.
-                                          := From_The_Substring'length;
-    end Copy;
- 
- end CA11017_0.CA11017_1;
- 
-      --=================================================================--
- 
- --  After child is added to the subsystem, a maintainer decides
- --  to take advantage of the new functionality and rewrites the
- --  parent's body.
- 
- with CA11017_0.CA11017_1;
- 
- package body CA11017_0 is
- 
-    -- Calls functions from public child for a quick comparison of the
-    -- input strings.  If their lengths are the same, do the replacement.
- 
-    procedure Replace (In_The_String   : in out String_Rec;
-                       At_The_Position : in     positive;
-                       With_The_String : in     String_Rec) is
-       End_Position : natural := At_The_Position +
-                                 With_The_String.The_Length - 1;
- 
-    begin
-       if not CA11017_0.CA11017_1.Equal_Length  -- Public child's operation.
-         (With_The_String, In_The_String) then
-            raise CA11017_0.CA11017_1.Position_Error;                 
-                                                -- Public child's exception.
-       else 
-          In_The_String.The_Content (At_The_Position .. End_Position) :=
-            With_The_String.The_Content (1 .. With_The_String.The_Length);
-       end if;
- 
-    end Replace;
- 
- end CA11017_0;
- 
-      --=================================================================--
- 
- with Report;
- 
- with CA11017_0.CA11017_1;   -- Explicit with public child package,
-                             -- implicit with parent package (CA11017_0).
- 
- procedure CA11017 is
- 
-    package String_Pkg renames CA11017_0;
-    use String_Pkg;
- 
- begin
- 
-    Report.Test ("CA11017", "Check that body of the parent package can " &
-                 "depend on one of its own public children");
- 
- -- Both input strings have the same size. Replace the first string by the 
- -- second string.  
- 
-         Replace_Subtest:
-         declare
-            The_First_String, The_Second_String : String_Rec (16);
-                                                  -- Parent's private type.
-            The_Position                        : positive := 1;
-         begin
-            CA11017_1.Copy ("This is the time", 
-                            To_The_String => The_First_String); 
- 
-            CA11017_1.Copy ("For all good men", The_Second_String); 
- 
-            Replace (The_First_String, The_Position, The_Second_String);
-   
-            -- Compare results using function from public child since
-            -- the type is private.
- 
-            if not CA11017_1.Same_Content
-                             (The_First_String, The_Second_String) then
-               Report.Failed ("Incorrect results");
-            end if;
- 
-         end Replace_Subtest;
- 
- -- During processing, the application may erroneously attempt to replace
- -- strings of different size. This would result in the raising of an 
- -- exception.                                                       
- 
-         Exception_Subtest:
-         declare
-            The_First_String  : String_Rec (17);
-                                                  -- Parent's private type.
-            The_Second_String : String_Rec (13);
-                                                  -- Parent's private type.
-            The_Position      : positive := 2;
-         begin
-            CA11017_1.Copy (" ACVC Version 2.0", The_First_String); 
- 
-            CA11017_1.Copy (From_The_Substring => "ACVC 9X Basic", 
-                            To_The_String      => The_Second_String); 
- 
-            Replace (The_First_String, The_Position, The_Second_String);
- 
-            Report.Failed ("Exception was not raised");
- 
-         exception
-            when CA11017_1.Position_Error =>
-                   Report.Comment ("Exception is raised as expected");
- 
-         end Exception_Subtest;
- 
-    Report.Result;
- 
- end CA11017;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11018.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11018.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11018.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11018.a	Thu Jan  1 00:00:00 1970
***************
*** 1,366 ****
- -- CA11018.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that body of the parent package may depend on one of its own 
- --      public generic children.
- --
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential of adding a
- --      public generic child during code maintenance without distubing a large 
- --      subsystem.  After child is added to the subsystem, a maintainer
- --      decides to take advantage of the new functionality and rewrites
- --      the parent's body.
- --
- --      Declare a message application in a package which highlights some
- --      key words.  Declare a public generic child of this package which adds 
- --      functionality to the original subsystem.  In the parent body, 
- --      instantiate the child.
- --
- --      In the main program, check that the operations in the parent, 
- --      and instances of the public child package perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      14 Dec 94   SAIC    Modified Copy_Particularly_Designated_Pkg inst.
- --      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --
- --!
-   
- -- Simulates application which displays messages.
- 
- package CA11018_0 is               
- 
-    type Designated_Num is new Integer range 0 .. 100;
- 
-    type Particularly_Designated_Num is new Integer range 0 .. 100;
- 
-    type Message is new String;
- 
-    type Message_Rec is tagged private;
- 
-    type Designated_Msg is new Message_Rec with private;
- 
-    type Particularly_Designated_Msg is new Message_Rec with private;
- 
-    -- Analyzes message for presence of word in the secret message. If found, 
-    -- word is highlighted.
- 
-    procedure Highlight_Designated (The_Word       : in     Message;
-                                    In_The_Message : in out Designated_Msg);
-                                
- 
-    -- Analyzes message for presence of word in the secret message. If found, 
-    -- word is highlighted and do other actions.
- 
-    procedure Highlight_Particularly_Designated 
-      (The_Word       : in     Message;
-       In_The_Message : in out Particularly_Designated_Msg);
-  
- 
-    -- Begin test code declarations: -----------------------
- 
-    TC_Designated_Not_Zero : Boolean := false;
- 
-    TC_Particularly_Designated_Not_Zero : Boolean := false;
- 
-    -- The following two functions are used to check for function
-    -- calls from the public generic child.
- 
-    function TC_Designated_Success return Boolean;
- 
-    function TC_Particularly_Designated_Success return Boolean;
- 
-    -- End test code declarations. -------------------------
- 
- private
-    type Message_Rec is tagged
-       record
-          The_Length  : natural := 0;
-          The_Content : Message (1 .. 60);
-       end record;
- 
-    type Designated_Msg is new Message_Rec with null record;
-    -- ... More components in real application.
- 
-    type Particularly_Designated_Msg is new Message_Rec with null record;
-    -- ... More components in real application.
- 
- end CA11018_0;
- 
-      --=================================================================--
- 
- 
- -- Public generic child package of message display application.  Imagine that 
- -- messages of one security level are associated with a type derived from 
- -- integer.  For overall system security, messages of a different security
- -- level are associated with a different type derived from integer.  By 
- -- instantiating this package for each security level, the results of Count 
- -- applied to one kind of message cannot inadvertently be compared with the 
- -- results applied to a different kind.
- 
- generic
-    type Msg_Type is new Message_Rec with private; 
-                                               -- Derived from parent's type.
-    type Count is range <>;
- 
- package CA11018_0.CA11018_1 is    
- 
-    TC_Function_Called : Boolean := false;
- 
-    function Find_Word (Wrd : in Message;
-                        Msg : in Msg_Type) return Count;
- 
- end CA11018_0.CA11018_1;
- 
-      --=================================================================--
- 
- package body CA11018_0.CA11018_1 is    
- 
-    function Find_Word (Wrd : in Message;
-                        Msg : in Msg_Type) return Count is
- 
-       Num  : Count   := Count'first;
- 
-    -- Count how many time the word appears within the given message.
- 
-    begin
-       -- ... Error-checking code omitted for brevity.
- 
-       for I in 1 .. (Msg.The_Length - Wrd'length + 1) loop
-                                                  -- Parent's private type
-          if Msg.The_Content (I .. I + Wrd'length - 1) = Wrd
-                                                  -- Parent's private type
-            then
-               Num := Num + 1;
-          end if;
- 
-       end loop;
- 
-       TC_Function_Called := true;
- 
-       return (Num);
- 
-    end Find_Word;
- 
- end CA11018_0.CA11018_1;
- 
-      --=================================================================--
- 
- with CA11018_0.CA11018_1;   -- Public generic child.
- 
- pragma Elaborate (CA11018_0.CA11018_1);
- package body CA11018_0 is
- 
-    ----------------------------------------------------
-    -- Parent's body depends on public generic child. --
-    ----------------------------------------------------
- 
-    -- Instantiate the public child for the secret message.
- 
-    package Designated_Pkg is new CA11018_0.CA11018_1 
-      (Msg_Type => Designated_Msg, Count => Designated_Num);
- 
-    -- Instantiate the public child for the top secret message.
- 
-    package Particularly_Designated_Pkg is new CA11018_0.CA11018_1 
-      (Particularly_Designated_Msg, Particularly_Designated_Num);
- 
-    -- End instantiations. -----------------------------
- 
-    
-    function TC_Designated_Success return Boolean is
-    -- Check to see if the function in the public generic child is called.
- 
-    begin
-       return Designated_Pkg.TC_Function_Called;
-    end TC_Designated_Success;
-    --------------------------------------------------------------
-    function TC_Particularly_Designated_Success return Boolean is
-    -- Check to see if the function in the public generic child is called.
- 
-    begin
-       return Particularly_Designated_Pkg.TC_Function_Called;
-    end TC_Particularly_Designated_Success;
-    --------------------------------------------------------------
-    -- Calls functions from public child to search for a key word.  
-    -- If the word appears more than once in each message, 
-    -- highlight all of them.
- 
-    procedure Highlight_Designated (The_Word       : in     Message;
-                                    In_The_Message : in out Designated_Msg) is
- 
-    -- Not a real highlight procedure.  Real application can use graphic
-    -- device to highlight all occurrences of words.
- 
-    begin
-       --------------------------------------------------------------
-       -- Parent's body uses function from instantiation of public --
-       -- generic child.                                           --
-       --------------------------------------------------------------
- 
-       if Designated_Pkg.Find_Word          -- Child's operation.   
-         (The_Word, In_The_Message) > 0 then
- 
-           -- Highlight all occurrences in lavender.
- 
-           TC_Designated_Not_Zero := true;       
-       end if;
- 
-    end Highlight_Designated;
-    --------------------------------------------------------------
-    procedure Highlight_Particularly_Designated 
-      (The_Word       : in     Message;
-       In_The_Message : in out Particularly_Designated_Msg) is
- 
-    -- Not a real highlight procedure.  Real application can use graphic
-    -- device to highlight all occurrences of words.
- 
-    begin
-       --------------------------------------------------------------
-       -- Parent's body uses function from instantiation of public --
-       -- generic child.                                           --
-       --------------------------------------------------------------
- 
-       if Particularly_Designated_Pkg.Find_Word     -- Child's operation.   
-         (The_Word, In_The_Message) > 0 then
- 
-           -- Highlight all occurrences in chartreuse.
-           -- Do other more secret stuff.
- 
-           TC_Particularly_Designated_Not_Zero := true;       
-       end if;
- 
-    end Highlight_Particularly_Designated;
- 
- end CA11018_0;
- 
-      --=================================================================--
- 
- -- Public generic child to copy words to the messages.
- 
- generic
-    type Message_Type is new Message_Rec with private; 
-                         -- Derived from parent's type.
- 
- package CA11018_0.CA11018_2 is    
- 
-    procedure Copy (From_The_Word  : in     Message;
-                    To_The_Message : in out Message_Type);
- 
- end CA11018_0.CA11018_2;
- 
-      --=================================================================--
- 
- package body CA11018_0.CA11018_2 is    
- 
-    procedure Copy (From_The_Word  : in     Message;
-                    To_The_Message : in out Message_Type) is
- 
-    -- Copy words to the appropriate messages.
- 
-    begin
-       To_The_Message.The_Content        -- Parent's private type.
-         (1 .. From_The_Word'length) := From_The_Word;
- 
-       To_The_Message.The_Length         -- Parent's private type.
-                                     := From_The_Word'length;
-    end Copy;
- 
- end CA11018_0.CA11018_2;
- 
-      --=================================================================--
- 
- with Report;
- 
- with CA11018_0.CA11018_2;   -- Public generic child package, copy words
-                             -- to the message.
-                             -- Implicit with parent package (CA11018_0).
- 
- procedure CA11018 is
- 
-    package Message_Pkg renames CA11018_0;
- 
- begin
- 
-    Report.Test ("CA11018", "Check that body of the parent package can " &
-                 "depend on one of its own public generic children");
- 
- -- Highlight the word "Alert" from the secret message.
-  
-        Designated_Subtest:
-        declare
-           The_Message : Message_Pkg.Designated_Msg;  -- Parent's private type.
- 
-           -- Instantiate the public child to copy words to the secret message.
- 
-           package Copy_Designated_Pkg is new CA11018_0.CA11018_2 
-             (Message_Pkg.Designated_Msg);
- 
-        begin
-           Copy_Designated_Pkg.Copy ("Alert Level 1 : Alert The Guard", 
-                                 To_The_Message => The_Message);
- 
-           Message_Pkg.Highlight_Designated ("Alert", The_Message);
- 
-           if not Message_Pkg.TC_Designated_Not_Zero and 
-             Message_Pkg.TC_Designated_Success then
-                Report.Failed ("Alert should have been highlighted");
-           end if;
- 
-        end Designated_Subtest;
- 
- -- Highlight the word "Push The Alarm" from the top secret message.
- 
-        Particularly_Designated_Subtest:
-        declare
-           The_Message : Message_Pkg.Particularly_Designated_Msg ;  
-                                          -- Parent's private type.
- 
-           -- Instantiate the public child to copy words to the top secret
-           -- message.
- 
-           package Copy_Particularly_Designated_Pkg is new 
-             CA11018_0.CA11018_2 (Message_Pkg.Particularly_Designated_Msg);
- 
-        begin
-           Copy_Particularly_Designated_Pkg.Copy 
-             ("Alert Level 10 : Alert The Guard and Push The Alarm", 
-              The_Message);
- 
-           Message_Pkg.Highlight_Particularly_Designated 
-             ("Push The Alarm", The_Message);
- 
-           if not Message_Pkg.TC_Particularly_Designated_Not_Zero and 
-             Message_Pkg.TC_Particularly_Designated_Success then
-                Report.Failed ("Key words should have been highlighted");
-           end if;
- 
-        end Particularly_Designated_Subtest;
- 
-    Report.Result;
- 
- end CA11018;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11019.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11019.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11019.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11019.a	Thu Jan  1 00:00:00 1970
***************
*** 1,306 ****
- -- CA11019.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that body of the parent package may depend on one of its own
- --      private generic children.
- --
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential of adding a
- --      generic private child during code maintenance without distubing a 
- --      large subsystem.  After child is added to the subsystem, a maintainer
- --      decides to take advantage of the new functionality and rewrites
- --      the parent's body.
- --
- --      Declare a data collection abstraction in a package. Declare a private
- --      generic child of this package which provides parameterized code that
- --      have been written once and will be used three times to implement the
- --      services of the parent package. In the parent body, instantiate the 
- --      private child.  
- --
- --      In the main program, check that the operations in the parent, 
- --      and instance of the private child package perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --
- --!
-   
- package CA11019_0 is   
-      -- parent
- 
-    type Data_Record is tagged private;
-    type Data_Collection is private;
-    ---
-    ---
-    subtype Data_1 is integer range 0 .. 100;
-    procedure Add_1 (Data : Data_1; To : in out Data_Collection);  
-    function Statistical_Op_1 (Data : Data_Collection) return Data_1;
-    ---
-    subtype Data_2 is integer range -100 .. 1000;
-    procedure Add_2 (Data : Data_2; To : in out Data_Collection);
-    function Statistical_Op_2 (Data : Data_Collection) return Data_2;
-    ---
-    subtype Data_3 is integer range -10_000 .. 10_000;
-    procedure Add_3 (Data : Data_3; To : in out Data_Collection);  
-    function Statistical_Op_3 (Data : Data_Collection) return Data_3;
-    ---
- 
- private
- 
-    type Data_Ptr is access Data_Record'class;
-    subtype Sequence_Number is positive range 1 .. 512;
- 
-    type Data_Record is tagged 
-      record
-         Next  : Data_Ptr := null;
-         Seq   : Sequence_Number;
-      end record;
-    ---
-    type Data_Collection is 
-      record
-         First : Data_Ptr := null;
-         Last  : Data_Ptr := null;
-      end record;
-             
- end CA11019_0;
-  -- parent
- 
-     --=================================================================--
- 
- -- This generic package provides parameterized code that has been
- -- written once and will be used three times to implement the services
- -- of the parent package.
- 
- private
- generic   
-    type Data_Type is range <>;
- 
- package CA11019_0.CA11019_1 is    
-      -- parent.child
- 
-    type Data_Elem is new Data_Record with
-      record
-         Value : Data_Type;
-      end record;
- 
-    Next_Avail_Seq_No : Sequence_Number := 1;
- 
-    procedure Sequence (Ptr : Data_Ptr);
-     -- the child must be private for this procedure to know details of
-     -- the implementation of data collections
- 
-    procedure Add (Datum : Data_Type; To : in out Data_Collection);
- 
-    function  Op  (Data : Data_Collection) return Data_Type;
-     -- op models a complicated operation that whose code can be
-     -- used for various data types
- 
- 
- end CA11019_0.CA11019_1;
-  -- parent.child
- 
-      --=================================================================--
- 
-  
- package body CA11019_0.CA11019_1 is    
-           -- parent.child
- 
-    procedure Sequence (Ptr : Data_Ptr) is
-    begin
-       Ptr.Seq := Next_Avail_Seq_No;
-       Next_Avail_Seq_No := Next_Avail_Seq_No + 1;
-    end Sequence;
- 
-    ---------------------------------------------------------
- 
-    procedure Add (Datum : Data_Type; To : in out Data_Collection) is
-       Ptr : Data_Ptr;
-    begin
-       if To.First = null then
-          -- assign new record with data value to 
-          -- to.next <- null;
-          To.First := new Data_Elem'(Next  => null,
-                                     Value => Datum,
-                                     Seq   => 1);
-          Sequence (To.First);
-          To.Last := To.First;
-       else
-          -- chase to end of list
-          Ptr := To.First;
-          while Ptr.Next /= null loop
-             Ptr := Ptr.Next;
-          end loop;
-          -- and add element there
-          Ptr.Next := new Data_Elem'(Next  => null,
-                                     Value => Datum,
-                                     Seq   => 1);
-          Sequence (Ptr.Next);
-          To.Last := Ptr.Next;
-       end if;
- 
-    end Add;
- 
-    ---------------------------------------------------------
- 
-    function  Op  (Data : Data_Collection) return Data_Type is
-       -- for simplicity, just return the maximum of the data set
-       Max : Data_Type := Data_Elem( Data.First.all ).Value; 
-                               -- assuming non-empty collection
-       Ptr : Data_Ptr  := Data.First;
- 
-    begin
-       -- no error checking
-       while Ptr.Next /= null loop
-          if Data_Elem( Ptr.Next.all ).Value > Max then
-             Max := Data_Elem( Ptr.Next.all ).Value;
-          end if;
-          Ptr := Ptr.Next;
-       end loop;
-       return Max;
-    end Op;
- 
- end CA11019_0.CA11019_1;
-  -- parent.child
- 
-      --=================================================================--
- 
- -- parent body depends on private generic child
- with CA11019_0.CA11019_1;     -- Private generic child.
- 
- pragma Elaborate (CA11019_0.CA11019_1);
- package body CA11019_0 is
- 
-    -- instantiate the generic child with data types needed by the 
-    -- package interface services
-    package Data_1_Ops is new CA11019_1
-      (Data_Type => Data_1);
-  
-    package Data_2_Ops is new CA11019_1
-      (Data_Type => Data_2);
- 
-    package Data_3_Ops is new CA11019_1
-      (Data_Type => Data_3);
- 
-    ---------------------------------------------------------
- 
-    procedure Add_1 (Data : Data_1; To : in out Data_Collection) is
-    begin
-       -- maybe do other stuff here
-       Data_1_Ops.Add (Data, To);
-       -- and here
-    end;
- 
-    ---------------------------------------------------------
- 
-    function Statistical_Op_1 (Data : Data_Collection) return Data_1 is
-    begin
-       -- maybe use generic operation(s) in some complicated ways
-       -- (but simplified out, for the sake of testing)
-       return Data_1_Ops.Op (Data);
-    end;
- 
-    ---------------------------------------------------------
- 
-    procedure Add_2 (Data : Data_2; To : in out Data_Collection) is
-    begin
-       Data_2_Ops.Add (Data, To);
-    end;
- 
-    ---------------------------------------------------------
- 
-    function Statistical_Op_2 (Data : Data_Collection) return Data_2 is
-    begin
-       return Data_2_Ops.Op (Data);
-    end;
- 
-    ---------------------------------------------------------
- 
-    procedure Add_3 (Data : Data_3; To : in out Data_Collection) is
-    begin
-       Data_3_Ops.Add (Data, To);
-    end;
- 
-    ---------------------------------------------------------
- 
-    function Statistical_Op_3 (Data : Data_Collection) return Data_3 is
-    begin
-       return Data_3_Ops.Op (Data);
-    end;
- 
- end CA11019_0;
- 
- 
-      --=================================================--
- 
- with CA11019_0,
-   -- Main,    
-   -- Main.Child is private
-      Report;
- 
- procedure CA11019 is
- 
-    package Main renames CA11019_0;
- 
-    Col_1,
-    Col_2,
-    Col_3 : Main.Data_Collection;
- 
- begin
- 
-    Report.Test ("CA11019", "Check that body of a (non-generic) package " &
-                 "may depend on its private generic child");
- 
-    -- build a data collection
- 
-    for I in 1 .. 10 loop
-       Main.Add_1 ( Main.Data_1(I), Col_1);
-    end loop;
- 
-    if Main.Statistical_Op_1 (Col_1) /= 10 then 
-       Report.Failed ("Wrong data_1 value returned");
-    end if;
- 
-    for I in reverse 10 .. 20 loop
-       Main.Add_2 ( Main.Data_2(I * 10), Col_2);
-    end loop;
- 
-    if Main.Statistical_Op_2 (Col_2) /= 200 then 
-       Report.Failed ("Wrong data_2 value returned");
-    end if;
- 
-    for I in 0 .. 10 loop
-       Main.Add_3 ( Main.Data_3(I + 5), Col_3);
-    end loop;
- 
-    if Main.Statistical_Op_3 (Col_3) /= 15 then 
-       Report.Failed ("Wrong data_3 value returned");
-    end if;
- 
-    Report.Result;
- 
- end CA11019;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,238 ****
- -- CA11020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that body of the generic parent package can depend on one of 
- --      its own public generic children.
- --
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential of adding a
- --      public generic child during code maintenance without distubing a large 
- --      subsystem.  After child is added to the subsystem, a maintainer
- --      decides to take advantage of the new functionality and rewrites
- --      the parent's body.
- --
- --      Declare a bag abstraction in a generic package. Declare a public 
- --      generic child of this package which adds a generic procedure to the 
- --      original subsystem.  In the parent body, instantiate the public
- --      child.  Then instantiate the procedure as a child instance of the
- --      public child instance.  
- --
- --      In the main program, declare an instance of parent.  Check that the 
- --      operations in both parent and child packages perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Simulates bag application.
- 
- generic
-    type Element is private;
-    with function Image (E : Element) return String;
- 
- package CA11020_0 is
- 
-    type Bag is limited private;
- 
-    procedure Add (E : in Element; To_The_Bag : in out Bag);
- 
-    function Bag_Image (B : Bag) return string;
- 
- private
-    type Node_Type;
-    type Bag is access Node_Type;
- 
-    type Node_Type is
-       record
-          The_Element : Element;
- 
-          -- Other components in real application, i.e.,
-          -- The_Count   : positive;
- 
-          Next        : Bag;
-       end record;
- 
- end CA11020_0;
- 
-      --==================================================================--
- 
- -- More operations on Bag.
- 
- generic
- 
- -- Parameters go here.
- 
- package CA11020_0.CA11020_1 is        
- 
-    -- ... Other declarations.
- 
-    generic                            -- Generic iterator procedure.
-       with procedure Use_Element (E : in Element);
- 
-    procedure Iterate (B : in Bag);    -- Called once per element in the bag.
- 
-    -- ... Various other operations.
- 
- end CA11020_0.CA11020_1;
- 
-      --==================================================================--
- 
- package body CA11020_0.CA11020_1 is 
- 
-    procedure Iterate (B : in Bag) is
- 
-    -- Traverse each element in the bag.
- 
-       Elem : Bag := B;
- 
-    begin
-       while Elem /= null loop
-          Use_Element (Elem.The_Element);
-          Elem := Elem.Next;
-       end loop;
- 
-    end Iterate;      
- 
- end CA11020_0.CA11020_1;
- 
-      --==================================================================--
- 
- with CA11020_0.CA11020_1;    -- Public generic child package.
- 
- package body CA11020_0 is
- 
-    ----------------------------------------------------
-    -- Parent's body depends on public generic child. --
-    ----------------------------------------------------
- 
-    -- Instantiate the public child.
- 
-    package MS is new CA11020_1;  
- 
-    function Bag_Image (B : Bag) return string is
- 
-       Buffer : String (1 .. 10_000);
-       Last   : Integer := 0;
- 
-       -----------------------------------------------------
- 
-       -- Will be called by the iterator.
- 
-       procedure Append_Image (E : in Element) is  
-          Im : constant String := Image (E);
- 
-       begin  -- Append_Image
-          if Last /= 0 then        -- Insert a comma.
-             Last := Last + 1;
-             Buffer (Last) := ',';
-          end if;
- 
-          Buffer (Last + 1 .. Last + Im'Length) := Im;
-          Last := Last + Im'Length;
- 
-       end Append_Image;
- 
-       -----------------------------------------------------
- 
-       -- Instantiate procedure Iterate as a child of instance MS.
- 
-       procedure Append_All is new MS.Iterate (Use_Element => Append_Image);
- 
-    begin  -- Bag_Image
- 
-       Append_All (B);
- 
-       return Buffer (1 .. Last);
- 
-    end Bag_Image;
- 
-            -----------------------------------------------------
- 
-    procedure Add (E : in Element; To_The_Bag : in out Bag) is
- 
-       -- Not a real bag addition.
- 
-       Index : Bag := To_The_Bag;
- 
-    begin
-       -- ... Error-checking code omitted for brevity.
-     
-       if Index = null then
-          To_The_Bag := new Node_Type' (The_Element => E,
-                                        Next        => null);
-       else
-          -- Goto the end of the list.
- 
-          while Index.Next /= null loop
-             Index := Index.Next;
-          end loop;
- 
-          -- Add element to the end of the list.
- 
-          Index.Next := new Node_Type' (The_Element => E,
-                                        Next        => null);
-       end if;
- 
-    end Add;
- 
- end CA11020_0;
- 
-      --==================================================================--
- 
- with CA11020_0;               -- Bag application.
- 
- with Report;
- 
- procedure CA11020 is
- 
-     -- Instantiate the bag application for integer type and attribute
-     -- Image.
- 
-     package Bag_Of_Integers is new CA11020_0 (Integer, Integer'Image);
- 
-     My_Bag : Bag_Of_Integers.Bag;
- 
- begin 
- 
-    Report.Test ("CA11020", "Check that body of the generic parent package " &
-                 "can depend on one of its own public generic children");
- 
-    -- Add 10 consecutive integers to the bag.
- 
-    for I in 1 .. 10 loop
-       Bag_Of_Integers.Add (I, My_Bag);
-    end loop;
- 
-    if Bag_Of_Integers.Bag_Image (My_Bag) 
-       /= " 1, 2, 3, 4, 5, 6, 7, 8, 9, 10" then
-          Report.Failed ("Incorrect results");
-    end if;
- 
-    Report.Result;
- 
- end CA11020;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11021.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11021.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11021.a	Thu Jan  1 00:00:00 1970
***************
*** 1,245 ****
- -- CA11021.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that body of the generic parent package can depend on one of 
- --      its own private generic children.
- --      
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential of adding a
- --      public generic child during code maintenance without distubing a large 
- --      subsystem.  After child is added to the subsystem, a maintainer
- --      decides to take advantage of the new functionality and rewrites
- --      the parent's body.
- --
- --      Declare a generic package which declares high level operations for a
- --      complex number abstraction.  Declare a private generic child package 
- --      of this package which defines low level complex operations. In the 
- --      parent body, instantiate the private child.  Use the low level
- --      operation to complete the high level operation.
- --
- --      In the main program, instantiate the parent generic package.
- --      Check that the operations in both packages perform as expected.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic               -- Complex number abstraction.
-    type Int_Type is range <>;
- 
- package CA11021_0 is
-  
-    -- Simulate a generic complex number support package. Complex numbers
-    -- are treated as coordinates in the Cartesian plane.
- 
-    type Complex_Type is private;
- 
-    Zero : constant Complex_Type;                      -- Real number (0,0).
- 
-    function Real_Part (Complex_No : Complex_Type)
-      return Int_Type;
- 
-    function Imag_Part (Complex_No : Complex_Type)
-      return Int_Type;
- 
-    function Complex (Real, Imag : Int_Type)           
-      return Complex_Type;                             
- 
-    -- High level operation for complex number.
-    function "*" (Factor : Int_Type; 
-                  C      : Complex_Type) return Complex_Type;
- 
-    -- ... and other complicated ones.
- 
- private
-    type Complex_Type is record
-       Real : Int_Type;
-       Imag : Int_Type;
-    end record;
- 
-    Zero : constant Complex_Type := (Real => 0, Imag => 0);
- 
- end CA11021_0;
- 
-      --==================================================================--
- 
- -- Private generic child of Complex_Number.  
- 
- private
- 
- generic               
- 
- -- No parameter.
- 
- package CA11021_0.CA11021_1 is
-  
-    -- ... Other declarations.
- 
-    -- Low level operation on complex number. 
-    function "+" (Left, Right : Complex_Type)              
-      return Complex_Type;                     
- 
-    function "-" (Right : Complex_Type)                
-      return Complex_Type;                             
- 
-    -- ... Various other operations in real application.
- 
- end CA11021_0.CA11021_1;
- 
-      --==================================================================--
- 
- package body CA11021_0.CA11021_1 is
- 
-    function "+" (Left, Right : Complex_Type)              
-      return Complex_Type is
- 
-    begin
-       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
-    end "+";
- 
-                --------------------------------------------------
- 
-    function "-" (Right : Complex_Type) return Complex_Type is
-    begin
-       return (-Right.Real, -Right.Imag);
-    end "-";
- 
- end CA11021_0.CA11021_1;
- 
-      --==================================================================--
- 
- with CA11021_0.CA11021_1;    -- Private generic child package.
- 
- package body CA11021_0 is
- 
-    -----------------------------------------------------
-    -- Parent's body depends on private generic child. --
-    -----------------------------------------------------
- 
-    -- Instantiate the private child.
- 
-    package Complex_Ops is new CA11021_1;  
-    use Complex_Ops;                    -- All user-defined operators 
-                                        -- directly visible.        
- 
-                --------------------------------------------------
- 
-    function "*" (Factor : Int_Type; 
-                  C      : Complex_Type) return Complex_Type is
-       Result : Complex_Type := Zero;   
- 
-    begin
-       for I in 1 .. abs (Factor) loop
-          Result := Result + C;         -- Private generic child "+".
-       end loop;
- 
-       if Factor < 0 then
-          Result := - Result;           -- Private generic child "-".
-       end if;
- 
-       return Result;
-    end "*";
- 
-                --------------------------------------------------
- 
-    function Real_Part (Complex_No : Complex_Type) return Int_Type is
-    begin
-       return (Complex_No.Real);
-    end Real_Part;
- 
-                --------------------------------------------------
- 
-    function Imag_Part (Complex_No : Complex_Type) return Int_Type is
-    begin
-       return (Complex_No.Imag);
-    end Imag_Part;
- 
-                --------------------------------------------------
- 
-    function Complex (Real, Imag : Int_Type) return Complex_Type is
-    begin
-       return (Real, Imag);
-    end Complex;
- 
- end CA11021_0;
- 
-      --==================================================================--
- 
- with CA11021_0;                        -- Complex number abstraction.
- 
- with Report;
- 
- procedure CA11021 is
- 
-    type My_Integer is range -100 .. 100;
- 
-                --------------------------------------------------
- 
- -- Declare instance of the generic complex package for one particular 
- -- integer type.  
- 
-    package My_Complex_Pkg is new 
-      CA11021_0 (Int_Type => My_Integer);
- 
-    use My_Complex_Pkg;                 -- All user-defined operators 
-                                        -- directly visible.
- 
-                --------------------------------------------------
- 
-    Complex_One, Complex_Two : Complex_Type;
- 
-    My_Literal               : My_Integer := -3;
- 
- begin
- 
-    Report.Test ("CA11021", "Check that body of the generic parent package " &
-                 "can depend on its private generic child");
- 
-    Complex_One := Complex (11, 6);          
- 
-    Complex_Two := 5 * Complex_One; 
- 
-    if Real_Part (Complex_Two) /= 55         
-      and Imag_Part (Complex_Two) /= 30     
-         then
-            Report.Failed ("Incorrect results from complex operation");
-    end if;
- 
-    Complex_One := Complex (-4, 7);          
- 
-    Complex_Two := My_Literal * Complex_One; 
- 
-    if Real_Part (Complex_Two) /= 12         
-      and Imag_Part (Complex_Two) /= -21     
-         then
-            Report.Failed ("Incorrect results from complex operation");
-    end if;
- 
-    Report.Result;
- 
- end CA11021;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11022.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11022.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11022.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11022.a	Thu Jan  1 00:00:00 1970
***************
*** 1,242 ****
- -- CA11022.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that body of a child unit can instantiate its generic sibling.
- --      
- -- TEST DESCRIPTION:
- --      Declare a package that provides some types for the graphic 
- --      application.  Add a generic child package with a subprogram parameter
- --      to provide algorithms that can be used by different terminal types
- --      but that have to be customized to the specific terminal. Add child 
- --      packages to take advantage of the parent types and to provide a 
- --      customized operation for each of the different terminals.  The 
- --      customized operation will be passed as a generic subprogram parameter 
- --      to the child package's sibling.
- --
- --      The main program "with"s the child packages.  Check that the
- --      operations in child units perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CA11022_0 is    -- Graphic Manager
-  
-    type Row is range 1 .. 66;
-    type Column is range 1 .. 80;
-    type Radius is range 1 .. 3;
-    type Length is range 5 .. 10;
- 
-    -- Testing artifice.
-    TC_Screen : array (Row, Column) of boolean := (others => (others => false));
-    TC_Draw_Circle : boolean := false;
-    TC_Draw_Square : boolean := false;
- 
-    -- ... and other complicated ones.
- 
- end CA11022_0;
- 
- -- No bodies required for CA11022_0.
- 
-      --==================================================================--
- 
- -- Child package to provide general graphic functionalities.
- 
- generic               
- 
-    with procedure Put_Dot (X : in Column;
-                            Y : in Row);
- 
- package CA11022_0.CA11022_1 is     
- 
-    procedure Draw_Square (At_Col : in Column;
-                           At_Row : in Row;
-                           Len    : in Length);
- 
-    procedure Draw_Circle (At_Col : in Column;
-                           At_Row : in Row;
-                           Rad    : in Radius);
- 
-    -- procedure Draw_Ellipse ...
-    -- and other drawings ...
- 
- end CA11022_0.CA11022_1;
- 
-      --==================================================================--
- 
- package body CA11022_0.CA11022_1 is
- 
-    procedure Draw_Square (At_Col : in Column;
-                           At_Row : in Row;
-                           Len    : in Length) is
-    begin
-       -- use square drawing algorithm 
-       -- call
-       Put_Dot (At_Col + Column (Len), At_Row + Row(Len));
-       -- as needed in the algorithm.
-       TC_Draw_Square := true;
-    end Draw_Square;
- 
-    -------------------------------------------------------
-    procedure Draw_Circle (At_Col : in Column;
-                           At_Row : in Row;
-                           Rad    : in Radius) is
-    begin
-       -- use circle drawing algorithm 
-       -- call
-       for I in 1 .. Rad loop
-          Put_Dot (At_Col + Column(I), At_Row + Row(I));
-       end loop;
-       -- as needed in the algorithm.
-       TC_Draw_Circle := true;
-    end Draw_Circle;
- 
- end CA11022_0.CA11022_1;
- 
-      --==================================================================--
- 
- with CA11022_0.CA11022_1;                -- Generic sibling.
- 
- -- Child package to provide customized graphic functions for the
- -- VT100.
- package CA11022_0.CA11022_2 is           -- VT100 Graphic.
- 
-    X : Column := 8;
-    Y : Row    := 3;
-    R : Radius := 2;
-    L : Length := 6;
- 
-    procedure VT100_Graphic;
- 
- end CA11022_0.CA11022_2;
- 
-      --==================================================================--
- 
- package body CA11022_0.CA11022_2 is    
- 
-    procedure VT100_Graphic is
-       procedure VT100_Putdot (X : in Column;
-                               Y : in Row) is
-       begin   
-          -- Light a pixel at location (X, Y);
-          TC_Screen (Y, X) := true;
-       end VT100_Putdot;
- 
-                   ------------------------------------
- 
-       -- Declare instance of the generic sibling package to draw a circle, 
-       -- a square, or an ellipse customized for the VT100.
-       package VT100_Graphic is new CA11022_0.CA11022_1 (VT100_Putdot);
-    
-    begin  
-       VT100_Graphic.Draw_Circle (X, Y, R);
-       VT100_Graphic.Draw_Square (X, Y, L);
-    end VT100_Graphic;
- 
- end CA11022_0.CA11022_2;
- 
-      --==================================================================--
- 
- with CA11022_0.CA11022_1;                -- Generic sibling.
- 
- -- Child package to provide customized graphic functions for the
- -- IBM3270.
- package CA11022_0.CA11022_3 is           -- IBM3270 Graphic.
- 
-    X : Column := 39;
-    Y : Row    := 11;
-    R : Radius := 3;
-    L : Length := 7;
- 
-    procedure IBM3270_Graphic;
- 
- end CA11022_0.CA11022_3;
- 
-      --==================================================================--
- 
- package body CA11022_0.CA11022_3 is    
- 
-    procedure IBM3270_Graphic is
-       procedure IBM3270_Putdot (X : in Column;
-                              Y : in Row) is
-       begin   
-          -- Light a pixel at location (X + 2, Y);
-          TC_Screen (Y, X + Column(2)) := true;
-       end IBM3270_Putdot;
- 
-                   ------------------------------------
- 
-       -- Declare instance of the generic sibling package to draw a circle, 
-       -- a square, or an ellipse customized for the IBM3270.
-       package IBM3270_Graphic is new CA11022_0.CA11022_1 (IBM3270_Putdot);
-    
-    begin  
-       IBM3270_Graphic.Draw_Circle (X, Y, R);
-       IBM3270_Graphic.Draw_Square (X, Y, L);
-    end IBM3270_Graphic;
- 
- end CA11022_0.CA11022_3;
- 
-      --==================================================================--
- 
- with CA11022_0.CA11022_2;              -- VT100 Graphic, implicitly with
-                                        -- CA11022_0, Graphic Manager.
- with CA11022_0.CA11022_3;              -- IBM3270 Graphic.
- with Report;
- 
- procedure CA11022 is
- 
- begin
- 
-    Report.Test ("CA11022", "Check that body of a child unit can depend on " &
-                 "its generic sibling");
- 
-    -- Customized graphic functions for the VT100 terminal.
-    CA11022_0.CA11022_2.VT100_Graphic;
- 
-    if not CA11022_0.TC_Screen (4,9) and not CA11022_0.TC_Screen (5,10) 
-      and not CA11022_0.TC_Screen (9,14) and not CA11022_0.TC_Draw_Circle 
-        and not CA11022_0.TC_Draw_Square then
-           Report.Failed ("Wrong results for the VT100");
-    end if;
- 
-    CA11022_0.TC_Draw_Circle := false;
-    CA11022_0.TC_Draw_Square := false;
- 
-    -- Customized graphic functions for the IBM3270 terminal.
-    CA11022_0.CA11022_3.IBM3270_Graphic;
- 
-    if not CA11022_0.TC_Screen (12,42) and not CA11022_0.TC_Screen (13,43) 
-      and not CA11022_0.TC_Screen (14,44) and not CA11022_0.TC_Screen (46,18) 
-        and not CA11022_0.TC_Draw_Circle and not CA11022_0.TC_Draw_Square then
-           Report.Failed ("Wrong results for the IBM3270");
-    end if;
- 
-    Report.Result;
- 
- end CA11022;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,31 ****
- -- CA1102A0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/12/81
- 
- PACKAGE CA1102A0 IS          -- BODY IS IN CA1102A1.
- 
-      PROCEDURE P (INVOKED : IN OUT BOOLEAN);
- 
- END CA1102A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- CA1102A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/12/81
- 
- PACKAGE BODY CA1102A0 IS
- 
-      PROCEDURE P (INVOKED : IN OUT BOOLEAN) IS
-      BEGIN
-           INVOKED := TRUE;
-      END P;
- 
- BEGIN
-      NULL;
- END CA1102A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- CA1102A2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT MORE THAN ONE WITH_CLAUSE CAN APPEAR IN
- --   A CONTEXT_SPECIFICATION.
- -- CHECK THAT USE_CLAUSES CAN MENTION NAMES MADE
- --   VISIBLE BY PRECEDING WITH_CLAUSES IN THE SAME
- --   CONTEXT_SPECIFICATION.
- -- CHECK THAT CONSECUTIVE USE_CLAUSES ARE ALLOWED.
- 
- -- SEPARATE FILES ARE:
- --   CA1102A0  A LIBRARY PACKAGE DECLARATION.
- --   CA1102A1  A LIBRARY PACKAGE BODY (CA1102A0).
- --   CA1102A2M THE MAIN PROCEDURE.
- 
- -- WKB 6/12/81
- -- BHS 7/19/84
- 
- WITH CA1102A0;
- WITH REPORT; USE CA1102A0; USE REPORT;
- PROCEDURE CA1102A2M IS
- 
- 
-      INVOKED : BOOLEAN := FALSE;
- 
- BEGIN
-      TEST ("CA1102A", "MORE THAN ONE WITH_CLAUSE; ALSO, A " &
-            "USE_CLAUSE REFERING TO A PRECEDING WITH_CLAUSE " &
-            "IN THE SAME CONTEXT_SPECIFICATION");
- 
-      P (INVOKED);
-      IF NOT INVOKED THEN
-           FAILED ("COMPILATION UNIT NOT MADE VISIBLE");
-      END IF;
- 
-      RESULT;
- END CA1102A2M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1106a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- CA1106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A WITH CLAUSE FOR A PACKAGE BODY (GENERIC OR
- --     NONGENERIC) OR FOR A GENERIC SUBPROGRAM BODY CAN NAME THE
- --     CORRESPONDING SPECIFICATION, AND A USE CLAUSE CAN ALSO BE
- --     GIVEN.
- 
- -- HISTORY:
- --     JET 07/14/88  CREATED ORIGINAL TEST.
- --     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- PACKAGE CA1106A_1 IS
-      I : INTEGER := 0;
-      PROCEDURE REQUIRE_BODY;
- END CA1106A_1;
- 
- GENERIC
-      TYPE TG IS RANGE <>;
- PACKAGE CA1106A_2 IS
-      J : TG := 0;
-      PROCEDURE REQUIRE_BODY;
- END CA1106A_2;
- 
- GENERIC
-      TYPE TG IS RANGE <>;
- FUNCTION CA1106A_3 RETURN TG;
- 
- WITH REPORT; USE REPORT;
- WITH CA1106A_1; USE CA1106A_1;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY CA1106A_1 IS
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- BEGIN
-      I := IDENT_INT(1);
- END CA1106A_1;
- 
- WITH REPORT; USE REPORT;
- WITH CA1106A_2;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY CA1106A_2 IS
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- BEGIN
-      J := TG(IDENT_INT(2));
- END CA1106A_2;
- 
- WITH REPORT; USE REPORT;
- WITH CA1106A_3;
- FUNCTION CA1106A_3 RETURN TG IS
- BEGIN
-      RETURN TG(IDENT_INT(3));
- END CA1106A_3;
- 
- WITH REPORT; USE REPORT;
- WITH CA1106A_1, CA1106A_2, CA1106A_3;
- USE CA1106A_1;
- PROCEDURE CA1106A IS
- 
-      PACKAGE CA1106A_2X IS NEW CA1106A_2 (INTEGER);
-      FUNCTION CA1106A_3X IS NEW CA1106A_3 (INTEGER);
- 
-      USE CA1106A_2X;
- 
- BEGIN
-      TEST ("CA1106A", "CHECK THAT A WITH CLAUSE FOR A PACKAGE BODY " &
-                       "(GENERIC OR NONGENERIC) OR FOR A GENERIC " &
-                       "SUBPROGRAM BODY CAN NAME THE CORRESPONDING " &
-                       "SPECIFICATION, AND A USE CLAUSE CAN ALSO BE " &
-                       "GIVEN");
- 
-      IF I /= 1 THEN
-           FAILED ("INCORRECT VALUE FROM NONGENERIC PACKAGE");
-      END IF;
- 
-      IF J /= 2 THEN
-           FAILED ("INCORRECT VALUE FROM GENERIC PACKAGE");
-      END IF;
- 
-      IF CA1106A_3X /= 3 THEN
-           FAILED ("INCORRECT VALUE FROM GENERIC SUBPROGRAM");
-      END IF;
- 
-      RESULT;
- END CA1106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1108a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1108a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1108a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- CA1108A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A WITH_CLAUSE AND USE_CLAUSE GIVEN FOR A PACKAGE
- -- SPECIFICATION APPLIES TO THE BODY AND SUBUNITS OF THE BODY.
- 
- -- BHS 7/27/84
- -- JBG 5/1/85
- 
- PACKAGE OTHER_PKG IS
- 
-      I : INTEGER := 4;
-      FUNCTION F (X : INTEGER) RETURN INTEGER;
- 
- END OTHER_PKG;
- 
- PACKAGE BODY OTHER_PKG IS
- 
-      FUNCTION F (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN X + 1;
-      END F;
- 
- END OTHER_PKG;
- 
- WITH REPORT, OTHER_PKG;
- USE REPORT, OTHER_PKG;
- PRAGMA ELABORATE (OTHER_PKG);
- PACKAGE CA1108A_PKG IS
- 
-      J : INTEGER := 2;
-      PROCEDURE PROC;
-      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
- 
- END CA1108A_PKG;
- 
- PACKAGE BODY CA1108A_PKG IS
-      
-      PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
- 
-      PROCEDURE PROC IS
-           Y : INTEGER := 2;
-      BEGIN
-           Y := OTHER_PKG.I;
-           IF Y /= 4 THEN
-                FAILED ("OTHER_PKG VARIABLE NOT VISIBLE " &
-                        "IN PACKAGE BODY PROCEDURE");
-           END IF;
-      END PROC;
- 
-      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
-      BEGIN
-           SUB (X, Y);
-      END CALL_SUBS;
- 
- BEGIN  
- 
-      J := F(J);            -- J => J + 1.
-      IF J /= 3 THEN
-           FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN " &
-                   "PACKAGE BODY");
-      END IF;
- 
- END CA1108A_PKG;
- 
- 
- WITH REPORT, CA1108A_PKG;
- USE REPORT, CA1108A_PKG;
- PROCEDURE CA1108A IS
- 
-      VAR1, VAR2 : INTEGER;
- 
- BEGIN  
- 
-      TEST ("CA1108A", "WITH_ AND USE_CLAUSES GIVEN FOR A PACKAGE " &
-                       "SPEC APPLY TO THE BODY AND ITS SUBUNITS");
- 
-      PROC;
- 
-      VAR1 := 1;
-      VAR2 := 1;
-      CALL_SUBS (VAR1, VAR2);
-      IF VAR1 /= 4 THEN
-           FAILED ("OTHER_PKG VARIABLE NOT VISIBLE IN SUBUNIT");
-      END IF;
- 
-      IF VAR2 /= 6 THEN
-           FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
-                   "OF SUBUNIT");
-      END IF;
- 
-      RESULT;
- 
- END CA1108A;
- 
- 
- SEPARATE (CA1108A_PKG)
- PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
-      PROCEDURE SUB2 (Z : IN OUT INTEGER) IS SEPARATE;
- BEGIN
- 
-      X := I;
-      SUB2 (Y);
- 
- END SUB;
- 
- 
- SEPARATE (CA1108A_PKG.SUB)
- PROCEDURE SUB2 (Z : IN OUT INTEGER) IS
-      I : INTEGER := 5;
- BEGIN
- 
-      Z := OTHER_PKG.F(I);    -- Z => I + 1.
- 
- END SUB2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1108b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca1108b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca1108b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,168 ****
- -- CA1108B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF WITH_CLAUSES ARE GIVEN FOR BOTH A SPEC AND A BODY, AND
- -- THE CLAUSES NAME DIFFERENT LIBRARY UNITS, THE UNITS NAMED IN ALL THE
- -- CLAUSES ARE VISIBLE IN THE BODY AND IN SUBUNITS OF THE BODY.
- 
- -- BHS 7/31/84
- -- JBG 5/1/85
- 
- PACKAGE FIRST_PKG IS
- 
-      FUNCTION F (X : INTEGER := 1) RETURN INTEGER;
- 
- END FIRST_PKG;
- 
- PACKAGE BODY FIRST_PKG IS
- 
-      FUNCTION F (X : INTEGER := 1) RETURN INTEGER IS
-      BEGIN
-           RETURN X;
-      END F;
- 
- END FIRST_PKG;
- 
- PACKAGE LATER_PKG IS
- 
-      FUNCTION F (Y : INTEGER := 2) RETURN INTEGER;
- 
- END LATER_PKG;
- 
- PACKAGE BODY LATER_PKG IS
- 
-      FUNCTION F (Y : INTEGER := 2) RETURN INTEGER IS
-      BEGIN
-           RETURN Y + 1;
-      END F;
- 
- END LATER_PKG;
- 
- WITH REPORT, FIRST_PKG;
- USE REPORT;
- PRAGMA ELABORATE (FIRST_PKG);
- PACKAGE CA1108B_PKG IS
- 
-      I, J : INTEGER;
-      PROCEDURE PROC;
-      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
- 
- END CA1108B_PKG;
- 
- WITH LATER_PKG;
- PRAGMA ELABORATE (LATER_PKG);
- PACKAGE BODY CA1108B_PKG IS
- 
-      PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
- 
-      PROCEDURE PROC IS
-           I, J : INTEGER;
-      BEGIN
-           I := FIRST_PKG.F;
-           IF I /= 1 THEN
-                FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN " &
-                        "PACKAGE BODY PROCEDURE");
-           END IF;
-           J := LATER_PKG.F;
-           IF J /= 3 THEN
-                FAILED ("LATER_PKG FUNCITON NOT VISIBLE IN " &
-                        "PACKAGE BODY PROCEDURE");
-           END IF;
-      END PROC;
- 
-      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
-      BEGIN
-           SUB (X, Y);
-      END CALL_SUBS;
- 
- BEGIN
- 
-      I := FIRST_PKG.F;
-      IF I /= 1 THEN
-           FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
-      END IF;
-      J := LATER_PKG.F;
-      IF J /= 3 THEN
-           FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
-      END IF;
- 
- END CA1108B_PKG;
- 
- WITH REPORT, CA1108B_PKG;
- USE REPORT, CA1108B_PKG;
- PROCEDURE CA1108B IS
- 
-      VAR1, VAR2 : INTEGER;
- 
- BEGIN
- 
-      TEST ("CA1108B", "IF DIFFERENT WITH_CLAUSES GIVEN FOR PACKAGE " &
-                       "SPEC AND BODY, ALL NAMED UNITS ARE VISIBLE " &
-                       "IN THE BODY AND ITS SUBUNITS");
- 
-      PROC;
- 
-      VAR1 := 0;
-      VAR2 := 1;
-      CALL_SUBS (VAR1, VAR2);
-      IF VAR1 /= 1 THEN
-           FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
-      END IF;
- 
-      IF VAR2 /= 3 THEN
-           FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
-      END IF;
- 
-      RESULT;
- 
- END CA1108B;
- 
- 
- SEPARATE (CA1108B_PKG)
- PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
-      PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS SEPARATE;
- BEGIN
- 
-      SUB2 (Y, X);
-      IF Y /= 1 THEN
-           FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
-                   "OF SUBUNIT");
-      END IF;
-      IF X /= 3 THEN
-           FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
-                   "OF SUBUNIT");
-      END IF;
-      X := FIRST_PKG.F;
-      Y := LATER_PKG.F;
- 
- END SUB;
- 
- SEPARATE (CA1108B_PKG.SUB)
- PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS
- BEGIN
- 
-      A := FIRST_PKG.F;
-      B := LATER_PKG.F;
- 
- END SUB2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,228 ****
- -- CA11A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that type extended in a public child inherits primitive 
- --      operations from its ancestor.  
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type in a package specification. Declare two 
- --      primitive subprograms for the type (foundation code).
- --
- --      Add a public child to the above package.  Extend the root type with 
- --      a record extension in the specification.  Declare a new primitive 
- --      subprogram to write to the child extension.
- --
- --      Add a public grandchild to the above package.  Extend the extension of
- --      the parent type with a record extension in the private part of the 
- --      specification.  Declare a new primitive subprogram for this grandchild
- --      extension.
- --
- --      In the main program, "with" the grandchild.  Access the primitive
- --      operations from grandparent and parent package.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11A00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package FA11A00.CA11A01_0 is     -- Color_Widget_Pkg
- -- This public child declares an extension from its parent.  It 
- -- represents processing of widgets in a window system.  
- 
-    type Widget_Color_Enum is (Black, Green, White);
- 
-    type Color_Widget is new Widget with           -- Record extension of
-       record                                      -- parent tagged type.
-          Color : Widget_Color_Enum;
-       end record;
- 
-    -- Inherits procedure Set_Width from Widget.
-    -- Inherits procedure Set_Height from Widget.
- 
-    -- To be inherited by its derivatives.
-    procedure Set_Color (The_Widget : in out Color_Widget; 
-                         C          : in     Widget_Color_Enum);
- 
-    procedure Set_Color_Widget (The_Widget : in out Color_Widget; 
-                                The_Width  : in     Widget_Length;
-                                The_Height : in     Widget_Length; 
-                                The_Color  : in     Widget_Color_Enum);
- 
- end FA11A00.CA11A01_0;     -- Color_Widget_Pkg
- 
- --=======================================================================--
- 
- package body FA11A00.CA11A01_0 is     -- Color_Widget_Pkg
- 
-    procedure Set_Color (The_Widget : in out Color_Widget; 
-                         C          : in     Widget_Color_Enum) is
-    begin
-       The_Widget.Color := C;
-    end Set_Color;
-    ---------------------------------------------------------------
-    procedure Set_Color_Widget (The_Widget : in out Color_Widget; 
-                                The_Width  : in     Widget_Length;
-                                The_Height : in     Widget_Length; 
-                                The_Color  : in     Widget_Color_Enum) is
-    begin
-       Set_Width  (The_Widget, The_Width);   -- Inherited from parent.
-       Set_Height (The_Widget, The_Height);  -- Inherited from parent.
-       Set_Color  (The_Widget, The_Color);
-    end Set_Color_Widget;
- 
- end FA11A00.CA11A01_0;     -- Color_Widget_Pkg
- 
- --=======================================================================--
- 
- package FA11A00.CA11A01_0.CA11A01_1 is     -- Label_Widget_Pkg
- -- This public grandchild extends the extension from its parent.  It 
- -- represents processing of widgets in a window system.  
- 
-    -- Declaration used by private extension component.
-    subtype Widget_Label_Str is string (1 .. 10);
- 
-    type Label_Widget is new Color_Widget with private;  
-                             -- Record extension of parent tagged type.
- 
-    -- Inherits (inherited) procedure Set_Width from Color_Widget.
-    -- Inherits (inherited) procedure Set_Height from Color_Widget.
-    -- Inherits procedure Set_Color from Color_Widget.
-    -- Inherits procedure Set_Color_Widget from Color_Widget.
- 
-    procedure Set_Label_Widget (The_Widget : in out Label_Widget;
-                                The_Width  : in     Widget_Length;
-                                The_Height : in     Widget_Length; 
-                                The_Color  : in     Widget_Color_Enum;
-                                The_Label  : in     Widget_Label_Str);
- 
-    -- The following function is needed to verify the value of the
-    -- extension's private component.
- 
-    function Verify_Label (The_Widget : in Label_Widget;
-                           The_Label  : in Widget_Label_Str) return Boolean;
- 
- private
-    type Label_Widget is new Color_Widget with
-       record
-          Label : Widget_Label_Str;
-       end record;
- 
- end FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg
- 
- --=======================================================================--
- 
- package body FA11A00.CA11A01_0.CA11A01_1 is     -- Label_Widget_Pkg
- 
-    procedure Set_Label (The_Widget : in out Label_Widget; 
-                         L          : in     Widget_Label_Str) is
-    begin
-       The_Widget.Label := L;
-    end Set_Label;
-    --------------------------------------------------------------
-    procedure Set_Label_Widget (The_Widget : in out Label_Widget;
-                                The_Width  : in     Widget_Length;
-                                The_Height : in     Widget_Length; 
-                                The_Color  : in     Widget_Color_Enum;
-                                The_Label  : in     Widget_Label_Str) is
-    begin
-       Set_Width  (The_Widget, The_Width);   -- Twice inherited.
-       Set_Height (The_Widget, The_Height);  -- Twice inherited.
-       Set_Color  (The_Widget, The_Color);   -- Inherited from parent.
-       Set_Label  (The_Widget, The_Label); 
-    end Set_Label_Widget;
-    --------------------------------------------------------------
-    function Verify_Label (The_Widget : in Label_Widget; 
-                           The_Label  : in Widget_Label_Str) return Boolean is
-    begin
-       return (The_Widget.Label = The_Label);
-    end Verify_Label;
- 
- end FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg
- 
- --=======================================================================--
- 
- with FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg, 
-                                       -- implicitly with Widget_Pkg,
-                                       -- implicitly with Color_Widget_Pkg
- with Report;
- 
- procedure CA11A01 is
- 
-    package Widget_Pkg renames FA11A00;
-    package Color_Widget_Pkg renames FA11A00.CA11A01_0;
-    package Label_Widget_Pkg renames FA11A00.CA11A01_0.CA11A01_1;
- 
-    use Widget_Pkg;              -- All user-defined operators directly visible.
- 
-    Mail_Label     : Label_Widget_Pkg.Widget_Label_Str := "Quick_Mail";
- 
-    Default_Widget : Widget;
-    Black_Widget   : Color_Widget_Pkg.Color_Widget;
-    Mail_Widget    : Label_Widget_Pkg.Label_Widget;
- 
- begin
- 
-    Report.Test ("CA11A01", "Check that type extended in a public " &
-                 "child inherits primitive operations from its " &
-                 "ancestor");                                     
- 
-    Set_Width (Default_Widget, 9);             -- Call from parent.
-    Set_Height (Default_Widget, 10);           -- Call from parent.
- 
-    If Default_Widget.Width /= Widget_Length (Report.Ident_Int (9)) or 
-      Default_Widget.Height /= Widget_Length (Report.Ident_Int (10)) then
-         Report.Failed ("Incorrect result for Default_Widget");
-    end if;
- 
-    Color_Widget_Pkg.Set_Color_Widget 
-      (Black_Widget, 17, 18, Color_Widget_Pkg.Black);   -- Explicitly declared.
- 
-    If Black_Widget.Width /= Widget_Length (Report.Ident_Int (17)) or 
-      Black_Widget.Height /= Widget_Length (Report.Ident_Int (18)) or 
-        Color_Widget_Pkg."/=" (Black_Widget.Color, Color_Widget_Pkg.Black) then
-           Report.Failed ("Incorrect result for Black_Widget");
-    end if;
- 
-    Label_Widget_Pkg.Set_Label_Widget 
-      (Mail_Widget, 15, 21, Color_Widget_Pkg.White, 
-        "Quick_Mail");                                  -- Explicitly declared.
- 
-    If Mail_Widget.Width /= Widget_Length (Report.Ident_Int (15)) or 
-      Mail_Widget.Height /= Widget_Length (Report.Ident_Int (21)) or 
-        Color_Widget_Pkg."/=" (Mail_Widget.Color, Color_Widget_Pkg.White) or 
-          not Label_Widget_Pkg.Verify_Label (Mail_Widget, Mail_Label) then
-             Report.Failed ("Incorrect result for Mail_Widget");
-    end if;
- 
-    Report.Result;
- 
- end CA11A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- CA11A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a type extended in a client of a public child inherits 
- --      primitive operations from parent.  
- --
- -- TEST DESCRIPTION:
- --      Declare a root tagged type in a package specification. Declare two 
- --      primitive subprograms for the type (foundation code).
- --
- --      Add a public child to the above package.  Extend the root type with 
- --      a record extension in the specification.  Declare a new primitive 
- --      subprogram to write to the child extension.
- --
- --      In the main program, "with" the child.  Declare an extension of
- --      the child extension.  Access the primitive operations from both 
- --      parent and child packages.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11A00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      20 Dec 94   SAIC    Moved declaration of Label_Widget to library level
- --
- --!
- 
- package FA11A00.CA11A02_0 is     -- Color_Widget_Pkg
- -- This public child declares an extension from its parent.  It 
- -- represents processing of widgets in a window system.  
- 
-    type Widget_Color_Enum is (Black, Green, White);
- 
-    type Color_Widget is new Widget with           -- Record extension of
-       record                                      -- parent tagged type.
-          Color : Widget_Color_Enum;
-       end record;
- 
-    -- Inherits procedure Set_Width from parent.
-    -- Inherits procedure Set_Height from parent.
- 
-    -- To be inherited by its derivatives.
-    procedure Set_Color (The_Widget : in out Color_Widget; 
-                         C          : in     Widget_Color_Enum);
- 
- end FA11A00.CA11A02_0;     -- Color_Widget_Pkg
- 
- --=======================================================================--
- 
- package body FA11A00.CA11A02_0 is     -- Color_Widget_Pkg
- 
-    procedure Set_Color (The_Widget : in out Color_Widget; 
-                         C          : in     Widget_Color_Enum) is
-    begin
-       The_Widget.Color := C;
-    end Set_Color;
- 
- end FA11A00.CA11A02_0;     -- Color_Widget_Pkg
- 
- --=======================================================================--
- 
- with FA11A00.CA11A02_0;               -- Color_Widget_Pkg.
- 
- package CA11A02_1 is
- 
-    type Label_Widget (Str_Disc : Integer) is new 
-      FA11A00.CA11A02_0.Color_Widget with
-        record
-          Label : String (1 .. Str_Disc);
-        end record;
- 
-    -- Inherits (inherited) procedure Set_Width from Color_Widget.
-    -- Inherits (inherited) procedure Set_Height from Color_Widget.
-    -- Inherits procedure Set_Color from Color_Widget.
- 
- end CA11A02_1;
- 
- --=======================================================================--
- 
- with FA11A00.CA11A02_0;               -- Color_Widget_Pkg, 
-                                       -- implicitly with Widget_Pkg
- with CA11A02_1;
- 
- with Report;
- 
- procedure CA11A02 is
- 
-    package Widget_Pkg renames FA11A00;
-    package Color_Widget_Pkg renames FA11A00.CA11A02_0;
- 
-    use Widget_Pkg;              -- All user-defined operators directly visible.
- 
-    procedure Set_Label (The_Widget : in out CA11A02_1.Label_Widget; 
-                         L          : in     String) is
-    begin
-       The_Widget.Label := L;
-    end Set_Label;
-    ---------------------------------------------------------
-    procedure Set_Widget (The_Widget : in out CA11A02_1.Label_Widget;
-                          The_Width  : in     Widget_Length;
-                          The_Height : in     Widget_Length; 
-                          The_Color  : in     
-                                           Color_Widget_Pkg.Widget_Color_Enum;
-                          The_Label  : in     String) is
-    begin
-       CA11A02_1.Set_Width  (The_Widget, The_Width);    -- Twice inherited.
-       CA11A02_1.Set_Height (The_Widget, The_Height);   -- Twice inherited.
-       CA11A02_1.Set_Color (The_Widget, The_Color);     -- Inherited.
-       Set_Label  (The_Widget, The_Label);              -- Explicitly declared.
-    end Set_Widget;                                         
- 
-    White_Widget : CA11A02_1.Label_Widget (11);
- 
- begin
- 
-    Report.Test ("CA11A02", "Check that a type extended in a client of " &
-                 "a public child inherits primitive operations from parent");
- 
-    Set_Widget (White_Widget, 15, 21, Color_Widget_Pkg.White, "Alarm_Clock");  
- 
-    If White_Widget.Width /= Widget_Length (Report.Ident_Int (15)) or 
-      White_Widget.Height /= Widget_Length (Report.Ident_Int (21)) or
-        Color_Widget_Pkg."/=" (White_Widget.Color, Color_Widget_Pkg.White) or
-          White_Widget.Label /= "Alarm_Clock" then
-             Report.Failed ("Incorrect result for White_Widget");
-    end if;
- 
-    Report.Result;
- 
- end CA11A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11b01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11b01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11b01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11b01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,208 ****
- -- CA11B01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a type derived in a public child inherits primitive 
- --      operations from parent.  
- --
- -- TEST DESCRIPTION:
- --      Declare a root record type with discriminant in a package 
- --      specification. Declare a primitive subprogram for the type 
- --      (foundation code).
- --
- --      Add a public child to the above package.  Derive a new type 
- --      with constraint to the discriminant record type from the parent 
- --      package.  Declare a new primitive subprogram to write to the child 
- --      derived type.
- --
- --      Add a new public child to the above package.  This grandchild package
- --      derives a new type using the record type from the above package.  
- --      Declare a new primitive subprogram to write to the grandchild derived 
- --      type.
- --
- --      In the main program, "with" the grandchild.  Access the inherited 
- --      operations from grandparent, parent, and grandchild packages.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11B00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Child package of FA11B00.
- package FA11B00.CA11B01_0 is          -- Application_Two_Widget
- -- This public child declares a derived type from its parent.  It 
- -- represents processing of widgets in a window system.  
-                                                                
-    type App2_Widget is new App1_Widget (Maximum_Size => 5000); 
-    -- Inherits procedure Create_Widget from parent.
- 
-    -- Primitive operation of type App2_Widget.
-    -- To be inherited by its children derivatives.
-    procedure App2_Widget_Specific_Oper (The_Widget : in out App2_Widget;    
-                                         Loc        : in     Widget_Location);
- 
- end FA11B00.CA11B01_0;                -- Application_Two_Widget
- 
- --=======================================================================--
- 
- package body FA11B00.CA11B01_0 is     -- Application_Two_Widget
- 
-    procedure App2_Widget_Specific_Oper 
-      (The_Widget : in out App2_Widget;    
-       Loc        : in     Widget_Location) is
-    begin
-       The_Widget.Location := Loc;
-    end App2_Widget_Specific_Oper;
- 
- end FA11B00.CA11B01_0;                -- Application_Two_Widget
- 
- --=======================================================================--
- 
- -- Grandchild package of FA11B00, child package of FA11B00.CA11B01_0.
- package FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
- -- This public grandchild declares a derived type from its parent.  It 
- -- represents processing of widgets in a window system.  
- 
-    type App3_Widget is new App2_Widget;    -- Derived record of App2_Widget.
- 
-    -- Inherits (inherited) procedure Create_Widget from Application_One_Widget.
-    -- Inherits procedure App2_Widget_Specific_Oper from App2_Widget.
- 
-    -- Primitive operation of type App3_Widget.
-    procedure App3_Widget_Specific_Oper (The_Widget : in out App3_Widget; 
-                                         S          : in     Widget_Size);
- 
- end FA11B00.CA11B01_0.CA11B01_1;           -- Application_Three_Widget
- 
- --=======================================================================--
- 
- package body FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
- 
-    procedure App3_Widget_Specific_Oper 
-      (The_Widget : in out App3_Widget; 
-       S          : in     Widget_Size) is
-    begin
-       The_Widget.Size := S;
-    end App3_Widget_Specific_Oper;
- 
- end FA11B00.CA11B01_0.CA11B01_1;                -- Application_Three_Widget
- 
- --=======================================================================--
- 
- with FA11B00.CA11B01_0.CA11B01_1; -- Application_Three_Widget, 
-                                   -- implicitly with Application_Two_Widget,
-                                   -- implicitly with Application_Three_Widget.
- with Report;
- 
- procedure CA11B01 is
- 
-    package Application_One_Widget renames FA11B00;
-    package Application_Two_Widget renames FA11B00.CA11B01_0;
-    package Application_Three_Widget renames FA11B00.CA11B01_0.CA11B01_1;
- 
-    use Application_One_Widget;
-    use Application_Two_Widget;
-    use Application_Three_Widget;
- 
- begin
- 
-    Report.Test ("CA11B01", "Check that a type derived in a public " &
-                 "child inherits primitive operations from parent");
- 
-    Application_One_Subtest:
-    declare
-       White_Widget : App1_Widget;
- 
-    begin
-       -- perform an App1_Widget specific operation.
-       App1_Widget_Specific_Oper (C => White, L => "Line Editor    ",
-                                  The_Widget => White_Widget, I => 10);
- 
-       If White_Widget.Color /= White or
-         White_Widget.Id /= Widget_ID 
-           (Report.Ident_Int (10)) or
-             White_Widget.Label  /= "Line Editor    " then
-               Report.Failed ("Incorrect result for White_Widget");
-       end if;
- 
-    end Application_One_Subtest;
-    ---------------------------------------------------------------
-    Application_Two_Subtest:
-    declare
-       Amber_Widget : App2_Widget;
- 
-    begin
-       App1_Widget_Specific_Oper (Amber_Widget, I => 11, 
-                                  C => Amber, L => "Alarm_Clock    ");  
-                                  -- Inherited from Application_One_Widget.
-                                            
-       -- perform an App2_Widget specific operation.
-       App2_Widget_Specific_Oper (The_Widget => Amber_Widget, Loc => (380,512));
- 
-       If Amber_Widget.Color /= Amber or
-         Amber_Widget.Id /= Widget_ID (Report.Ident_Int (11)) or
-             Amber_Widget.Label  /= "Alarm_Clock    " or
-               Amber_Widget.Location /= (380,512) then
-                 Report.Failed ("Incorrect result for Amber_Widget");
-       end if;
- 
-    end Application_Two_Subtest;
-    ---------------------------------------------------------------
-    Application_Three_Subtest:
-    declare
-       Green_Widget : App3_Widget;
- 
-    begin
-       App1_Widget_Specific_Oper (Green_Widget, 100, Green, 
-                                  "Screen Editor  ");  
-                                    -- Inherited (inherited) from Basic_Widget.
- 
-       -- perform an App2_Widget specific operation.
-       App2_Widget_Specific_Oper (Loc => (1024,760), 
-                                  The_Widget => Green_Widget);
-                                     -- Inherited from App_1_Widget.
- 
-       -- perform an App3_Widget specific operation.
-       App3_Widget_Specific_Oper (Green_Widget, S => (100,100));
- 
-       If Green_Widget.Color /= Green or
-         Green_Widget.Id /= Widget_ID (Report.Ident_Int (100)) or
-           Green_Widget.Label  /= "Screen Editor  " or
-             Green_Widget.Location /= (1024,760) or
-               Green_Widget.Size /= (100,100) then
-                 Report.Failed ("Incorrect result for Green_Widget");
-       end if;
- 
-    end Application_Three_Subtest;
- 
-    Report.Result;
- 
- end CA11B01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11b02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11b02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11b02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11b02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,169 ****
- -- CA11B02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a type derived in a client of a public child inherits 
- --      primitive operations from parent.  
- --
- -- TEST DESCRIPTION:
- --      Declare a root record type with discriminant in a package 
- --      specification. Declare a primitive subprogram for the type 
- --      (foundation code).
- --
- --      Add a public child to the above package.  Derive a new type 
- --      with constraint to the discriminant record type from the parent 
- --      package.  Declare a new primitive subprogram to write to the child 
- --      derived type.
- --
- --      In the main program, "with" the child.  Derive a new type using the 
- --      record type from the child package.  Access the inherited operations 
- --      from both parent and child packages.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11B00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Child package of FA11B00.
- package FA11B00.CA11B02_0 is     -- Application_Two_Widget
- -- This public child declares a derived type from its parent.  It 
- -- represents processing of widgets in a window system.  
- 
-    -- Dimension of app2_widget is limited to 5000 pixels.
- 
-    type App2_Widget is new App1_Widget (Maximum_Size => 5000); 
-                            -- Derived record of parent type.
- 
-    -- Inherits procedure App1_Widget_Specific_Oper from parent.
- 
- 
-    -- Primitive operation of type App2_Widget.
- 
-    procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget;    
-                                        S          : in     Widget_Size);
-      
-    -- Primitive operation of type App2_Widget.
- 
-    procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget;    
-                                        Loc        : in     Widget_Location);
- 
- end FA11B00.CA11B02_0;      -- Application_Two_Widget
- 
- 
- --=======================================================================--
- 
- 
- package body FA11B00.CA11B02_0 is     -- Application_Two_Widget
- 
-    procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget;    
-                                        S          : in     Widget_Size) is
-    begin
-       The_Widget.Size := S;
-    end App2_Widget_Specific_Op1;
- 
-                --==============================================--
- 
-    procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget;    
-                                        Loc        : in     Widget_Location) is
-    begin
-       The_Widget.Location := Loc;
-    end App2_Widget_Specific_Op2;
- 
- end FA11B00.CA11B02_0;     -- Application_Two_Widget
- 
- 
- --=======================================================================--
- 
- with FA11B00.CA11B02_0;      -- Application_Two_Widget
-                              -- implicitly with Application_One_Widget.
- with Report;
- 
- procedure CA11B02 is
-                              
-    package Application_One_Widget renames FA11B00;
- 
-    package Application_Two_Widget renames FA11B00.CA11B02_0;
- 
-    use Application_One_Widget ;
-    use Application_Two_Widget ;
- 
-    type Emulator_Widget is new App2_Widget;   -- Derived record of 
-                                               -- parent type.
- 
-    White_Widget, Amber_Widget : Emulator_Widget;
- 
- 
- begin
- 
-    Report.Test ("CA11B02", "Check that a type derived in client of a " &
-                 "public child inherits primitive operations from parent");
- 
-    App1_Widget_Specific_Oper (C => White, L => "Line Editor    ",
-                               The_Widget => White_Widget, I => 10);
-                                   -- Inherited from Application_One_Widget.
-    If White_Widget.Color /= White or
-      White_Widget.Id /= Widget_ID (Report.Ident_Int (10)) or
-      White_Widget.Label  /= "Line Editor    " 
-    then
-       Report.Failed ("Incorrect result for White_Widget");
-    end if;
- 
-    -- perform an App2_Widget specific operation.
- 
-    App2_Widget_Specific_Op1 (White_Widget, S => (100, 200));
- 
-    If White_Widget.Size.X_Length /= 100 or
-      White_Widget.Size.Y_Length /= 200
-    then
-       Report.Failed ("Incorrect size for White_Widget");
-    end if;
- 
-    App1_Widget_Specific_Oper (Amber_Widget, 5, Amber, "Screen Editor  ");  
-                                   -- Inherited from Application_One_Widget.
- 
-    -- perform an App2_Widget specific operations.
- 
-    App2_Widget_Specific_Op1 (S => (1024,100), The_Widget => Amber_Widget);  
-    App2_Widget_Specific_Op2 (Amber_Widget, (1024, 760));
- 
-    If Amber_Widget.Color /= Amber or
-      Amber_Widget.Id /= Widget_ID (Report.Ident_Int (5)) or 
-      Amber_Widget.Label  /= "Screen Editor  " or
-      Amber_Widget.Size /= (1024,100) or 
-      Amber_Widget.Location.X_Location /= 1024 or
-      Amber_Widget.Location.Y_Location /= 760
-    then
-       Report.Failed ("Incorrect result for Amber_Widget");
-    end if;
- 
-    Report.Result;
- 
- end CA11B02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11c01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11c01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11c01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11c01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- CA11C01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that when primitive operations declared in a child package
- --      override operations declared in ancestor packages, a client of the
- --      child package inherits the operations correctly.
- --
- -- TEST DESCRIPTION:
- --
- --      This test builds on the foundation code file (FA11C00) that contains
- --      a parent package, child package, and grandchild package.  The parent
- --      package declares a tagged type and primitive operation.  The child
- --      package extends the type, and overrides the primitive operation. The
- --      grandchild package does the same.  
- --
- --      The test procedure "withs" the grandchild package, and receives
- --      visibility to all of its ancestor packages, types and operations.
- --      Three procedures, each with a formal parameter of a specific type are
- --      defined.  Each of these invokes a particular version of the overridden
- --      primitive operation Image.  Calls to these local procedures are made, 
- --      with objects of each of the tagged types as parameters, and the global 
- --      variable is finally examined to ensure that the correct version of 
- --      primitive operation was inherited by the client and invoked by the 
- --      call.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11C00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FA11C00_0.FA11C00_1.FA11C00_2;    -- Package Animal.Mammal.Primate
- with Report;
- 
- procedure CA11C01 is
- 
-    package Animal_Package  renames FA11C00_0;
-    package Mammal_Package  renames FA11C00_0.FA11C00_1;
-    package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2;
- 
-    Max_Animals : constant := 3;
- 
-    subtype Data_String is String (1 .. 37);
-    type Data_Base_Type is array  (1 .. Max_Animals) of Data_String;
- 
-    Zoo_Data_Base : Data_Base_Type := (others => (others => ' '));
-                                       -- Global variable.
- 
-    Salmon   : Animal_Package.Animal := (Common_Name => "Chinook Salmon      ", 
-                                         Weight      => 10);
- 
-    Platypus : Mammal_Package.Mammal := (Common_Name => "Tasmanian Platypus  ",
-                                         Weight      => 13,
-                                         Hair_Color  => Mammal_Package.Brown);
- 
-    Orangutan : Primate_Package.Primate := 
-                  (Common_Name => "Sumatran Orangutan  ",
-                   Weight      => 220,
-                   Hair_Color  => Mammal_Package.Red,
-                   Habitat     => Primate_Package.Arboreal);
- begin
- 
-    Report.Test ("CA11C01", "Check that when primitive operations declared "   &
-                            "in a child package override operations declared " &
-                            "in ancestor packages, a client of the child "     &
-                            "package inherits the operations correctly");
- 
-    declare
- 
-       use Animal_Package, Mammal_Package, Primate_Package;
- 
-       -- The function Image has been overridden in the child and grandchild
-       -- packages, but the client has inherited all versions of the function,
-       -- and can successfully use them to enter data into the database.
-       -- Each of the following procedures updates the global variable 
-       -- Zoo_Data_Base.
- 
-       procedure Enter_Animal_Data (A : Animal; I : Integer) is
-       begin
-          Zoo_Data_Base (I) := Image (A);  
-       end Enter_Animal_Data;              
- 
-       procedure Enter_Mammal_Data (M : Mammal; I : Integer) is
-       begin
-          Zoo_Data_Base (I) := Image (M);  
-       end Enter_Mammal_Data;
- 
-       procedure Enter_Primate_Data (P : Primate; I : Integer) is
-       begin
-          Zoo_Data_Base (I) := Image (P);  
-       end Enter_Primate_Data;
- 
-    begin
- 
-       -- Verify initial test conditions.
- 
-       if not (Zoo_Data_Base(1)(1..6) = "      ") 
-          or else
-              (Zoo_Data_Base(2)(1..6) /= "      ") 
-          or else
-              (Zoo_Data_Base(3)(1..6) /= "      ")
-       then
-          Report.Failed ("Initial condition failure");
-       end if;
- 
- 
-       -- Enter data from all three animals into the zoo database.
- 
-       Enter_Animal_Data  (A => Salmon,    I => 1);  -- First entry in database.
-       Enter_Mammal_Data  (M => Platypus,  I => 2);  -- Second entry.
-       Enter_Primate_Data (P => Orangutan, I => 3);  -- Third entry. 
- 
-       -- Verify the correct version of the overridden function Image was used
-       -- for entering the specific data.  
- 
-       if  Zoo_Data_Base(1)(1 .. 6) /= "Animal"
-         or else
-           Zoo_Data_Base(1)(26 .. 31) /= "Salmon"
-         then
-            Report.Failed ("Incorrect version of Image for parent type");
-       end if;
- 
-       if (Zoo_Data_Base(2)(1 .. 6) /= "Mammal") 
-         or
-           (Zoo_Data_Base(2)(28 .. 35) /= "Platypus") 
-         then
-            Report.Failed ("Incorrect version of Image for child type");
-       end if;
- 
-       if ((Zoo_Data_Base(3)(1 .. 7) /= "Primate") 
-         or 
-           (Zoo_Data_Base(3)(27 .. 35) /= "Orangutan"))
-         then
-            Report.Failed ("Incorrect version of Image for grandchild type");
-       end if;
- 
-    end;
- 
- 
-    Report.Result;
- 
- end CA11C01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11c02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11c02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11c02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11c02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- CA11C02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that primitive operations declared in a child package
- --      override operations declared in ancestor packages, and that
- --      operations on class-wide types defined in the ancestor packages 
- --      dispatch as appropriate to these overriding implementations. 
- --
- -- TEST DESCRIPTION:
- --
- --      This test builds on the foundation code file (FA11C00) that contains
- --      a parent package, child package, and grandchild package.  The parent
- --      package declares a tagged type and primitive operation.  The child
- --      package extends the type, and overrides the primitive operation. The
- --      grandchild package does the same.  
- --
- --      The test procedure "withs" the grandchild package, and receives
- --      visibility to all of its ancestor packages, types and operations.
- --      A procedure with a formal class-wide parameter is defined that will
- --      allow for dispatching calls to the overridden primitive operations,
- --      based on the specific type of the actual parameter.  The primitive
- --      operations provide a string value to update a global string array
- --      variable.  Calls to the local procedure are made, with objects of each
- --      of the tagged types as parameters, and the global variable is finally 
- --      examined to ensure that the correct version of primitive operation was 
- --      dispatched correctly.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11C00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FA11C00_0.FA11C00_1.FA11C00_2;    -- Package Animal.Mammal.Primate
- with Report;
- 
- procedure CA11C02 is
- 
-    package Animal_Package  renames FA11C00_0;
-    package Mammal_Package  renames FA11C00_0.FA11C00_1;
-    package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2;
- 
-    Max_Animals : constant := 3;
- 
-    type Data_Base_Type is array (1 .. Max_Animals) of String (1 .. 37);
- 
-    Zoo_Data_Base : Data_Base_Type := (others => (others => ' '));
-                                       -- Global variable.
- 
-    Macaw : Animal_Package.Animal   := (Common_Name => "Scarlet Macaw       ", 
-                                        Weight      => 2);
- 
-    Manatee : Mammal_Package.Mammal := (Common_Name => "Southern Manatee    ",
-                                        Weight      => 230,
-                                        Hair_Color  => Mammal_Package.Brown);
- 
-    Lemur : Primate_Package.Primate := 
-               (Common_Name => "Ring-Tailed Lemur   ",
-                Weight      => 5,
-                Hair_Color  => Mammal_Package.Black,
-                Habitat     => Primate_Package.Arboreal);
- begin
- 
-    Report.Test ("CA11C02", "Check that primitive operations declared "   &
-                            "in a child package override operations declared " &
-                            "in ancestor packages, and that operations " &
-                            "on class-wide types defined in the ancestor " &
-                            "packages dispatch as appropriate to these " &
-                            "overriding implementations");
- 
-    declare
- 
-       use Animal_Package, Mammal_Package, Primate_Package;
- 
-       -- The following procedure updates the global variable Zoo_Data_Base.
- 
-       procedure Enter_Data (A : Animal'Class; I : Integer) is
-       begin
-          Zoo_Data_Base (I) := Image (A);  
-       end Enter_Data;              
- 
-    begin
- 
-       -- Verify initial test conditions.
- 
-       if not (Zoo_Data_Base(1)(1..6) = "      ")
-          or not
-              (Zoo_Data_Base(2)(1..6) = "      ")
-          or not 
-              (Zoo_Data_Base(3)(1..6) = "      ")
-       then
-          Report.Failed ("Initial condition failure");
-       end if;
- 
- 
-       -- Enter data from all three animals into the zoo database.
- 
-       Enter_Data (Macaw, 1);                 -- First entry in database.
-       Enter_Data (A => Manatee, I => 2);     -- Second entry.
-       Enter_Data (Lemur, I => 3);            -- Third entry. 
- 
-       -- Verify the correct version of the overridden function Image was used
-       -- for entering the specific data.  
- 
-       if not (Zoo_Data_Base(1)(1 .. 6)   = "Animal") 
-         or not
-              (Zoo_Data_Base(1)(26 .. 30) = "Macaw") 
-         then
-            Report.Failed ("Incorrect version of Image for parent type");
-       end if;
- 
-       if not (Zoo_Data_Base(2)(1 .. 6)   = "Mammal"
-         and 
-           Zoo_Data_Base(2)(27 .. 33) = "Manatee") 
-         then
-            Report.Failed ("Incorrect version of Image for child type");
-       end if;
- 
-       if not ((Zoo_Data_Base(3)(1 .. 7)   = "Primate")
-         and 
-           (Zoo_Data_Base(3)(30 .. 34) = "Lemur"))
-         then
-            Report.Failed ("Incorrect version of Image for grandchild type");
-       end if;
- 
-    end;
- 
-    Report.Result;
- 
- end CA11C02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11c03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11c03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11c03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11c03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- CA11C03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that when a child unit is "withed", visibility is obtained to 
- --      all ancestor units named in the expanded name of the "withed" child
- --      unit.  Check that when the parent unit is "used", the simple name of 
- --      a "withed" child unit is made directly visible.
- --
- -- TEST DESCRIPTION:
- --      To satisfy the first part of the objective, various references are
- --      made to types and functions declared in the ancestor packages of the
- --      foundation code package hierarchy.  Since the grandchild library unit
- --      package has been "withed" by this test, the visibility of these 
- --      components demonstrates that visibility of the ancestor package names
- --      is provided when the expanded name of a child library unit is "withed". 
- --      
- --      The declare block in the test program includes a "use" clause of the
- --      parent package (FA11C00_0.FA11C00_1) of the "withed" child package.  
- --      As a result, the simple name of the child package (FA11C00_2) is
- --      directly visible.  The type and function declared in the child 
- --      package are now visible when qualified with the simple name of the
- --      "withed" package (FA11C00_2).
- --      
- --      This test simulates the formatting of data strings, based on the
- --      component fields of a "doubly-extended" tagged record type.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11C00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FA11C00_0.FA11C00_1.FA11C00_2;  -- "with" of child library package 
-                                      -- Animal.Mammal.Primate.
-                                      -- This will be used in conjunction with
-                                      -- a "use" of FA11C00_0.FA11C00_1 below 
-                                      -- to verify a portion of the objective.
- with Report;
- 
- procedure CA11C03 is
- 
-    Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' ');
-                                      -- Visibility of grandparent package.
-                                      -- The package FA11C00_0 is visible since
-                                      -- it is an ancestor that is mentioned in
-                                      -- the expanded name of its "withed"
-                                      -- grandchild package.
- 
-    Blank_Hair_Color : 
-      String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' ');
-                                      -- Visibility of parent package.
-                                      -- The package FA11C00_0.FA11C00_1 is
-                                      -- visible due to the "with" of its 
-                                      -- child package.
- 
-    subtype Data_String_Type is String (1 .. 60);
- 
-    TC_Result_String : Data_String_Type := (others => ' ');
- 
-    --
- 
-    function Format_Primate_Data (Name : String := Blank_Name_String;  
-                                  Hair : String := Blank_Hair_Color) 
-      return Data_String_Type is
- 
-       Pos                        : Integer := 1;
-       Hair_Color_Field_Separator : constant String := " Hair Color: ";
- 
-       Result_String              : Data_String_Type := (others => ' '); 
- 
-    begin
-       Result_String (Pos .. Name'Length) := Name;    -- Enter name at start
-                                                      -- of string.
-       Pos := Pos + Name'Length;                      -- Increment counter to
-                                                      -- next blank position.
-       Result_String 
-         (Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) :=
-         Hair_Color_Field_Separator & Hair;           -- Include hair color data
-                                                      -- in result string.
-       return (Result_String);                        
-    end Format_Primate_Data;
- 
- 
- begin
- 
-    Report.Test ("CA11C03", "Check that when a child unit is WITHED, "        &
-                            "visibility is obtained to all ancestor units "   &
-                            "named in the expanded name of the WITHED child " &
-                            "unit. Check that when the parent unit is USED, " &
-                            "the simple name of a WITHED child unit is made " &
-                            "directly visible" );
- 
-    declare
-       use FA11C00_0.FA11C00_1;    -- This "use" clause will allow direct 
-                                   -- visibility to the simple name of
-                                   -- package FA11C00_0.FA11C00_1.FA11C00_2,
-                                   -- since this child package was "withed" by
-                                   -- the main program.
- 
-       Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ",
-                                       Weight      => 7,
-                                       Hair_Color  => Brown,
-                                       Habitat     => FA11C00_2.Arboreal);
- 
-                                   -- Demonstrates visibility of package
-                                   -- FA11C00_0.FA11C00_1.FA11C00_2.
-                                   --
-                                   -- Type Primate referenced with the simple
-                                   -- name of package FA11C00_2 only.
-                                   --
-                                   -- Simple name of package FA11C00_2 is 
-                                   -- directly visible through "use" of parent.
- 
-    begin
- 
-       -- Verify that the Format_Primate_Data function will return a blank
-       -- filled string when no parameters are provided in the call.
- 
-       TC_Result_String := Format_Primate_Data;
- 
-       if (TC_Result_String (1 .. 20)  /= Blank_Name_String) then 
-          Report.Failed ("Incorrect initialization value from function");
-       end if;
- 
- 
-       -- Use function Format_Primate_Data to return a formatted data string.
- 
-       TC_Result_String := 
-         Format_Primate_Data 
-          (Name => FA11C00_2.Image (Tarsier),       
-                                   -- Function returns a 37 character string 
-                                   -- value.
-           Hair => Hair_Color_Type'Image(Tarsier.Hair_Color));
-                                   -- The Hair_Color_Type is referenced 
-                                   -- directly, without package
-                                   -- FA11C00_0.FA11C00_1 qualifier.
-                                   -- No qualification of Hair_Color_Type is
-                                   -- needed due to "use" clause.
- 
-                                   -- Note that the result of calling 'Image 
-                                   -- with an enumeration type argument 
-                                   -- results in an upper-case string.
-                                   -- (See conditional statement below.)
- 
-       -- Verify the results of the function call.
- 
-       if not  (TC_Result_String (1 .. 37) = 
-                 "Primate Species: East-Indian Tarsier " and then
-               TC_Result_String (38 .. 55) =
-                 " Hair Color: BROWN") then
-         Report.Failed ("Incorrect result returned from function call");
-       end if;
- 
-    end;
- 
-    Report.Result;
- 
- end CA11C03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- CA11D010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA11D013.AM
- --
- -- TEST DESCRIPTION:
- --      See CA11D013.AM
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FA11D00.A
- --      => CA11D010.A
- --         CA11D011.A
- --         CA11D012.A
- --         CA11D013.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- -- Child package of FA11D00.
- 
- package FA11D00.CA11D010 is     -- Add_Subtract_Complex
- 
-    procedure Add (Left, Right : in     Complex_Type;   -- Add two complex
-                   C           :    out Complex_Type);  -- numbers.
- 
-    function Subtract (Left, Right : Complex_Type)      -- Subtract two 
-      return Complex_Type;                              -- complex numbers.
-                                                 
-                                                        
-                                                        
- end FA11D00.CA11D010;     -- Add_Subtract_Complex
- 
- --=======================================================================--
- 
- with Report;
- 
- package body FA11D00.CA11D010 is     -- Add_Subtract_Complex
- 
-    procedure Add (Left, Right : in Complex_Type;
-                   C           :    out Complex_Type) is
-    begin
-       -- Zero is declared in parent package.
- 
-       if Left.Real < Zero.Real or else Right.Real < Zero.Real
-         or else Left.Imag < Zero.Imag or else Right.Imag < Zero.Imag then
-           raise Add_Error;     -- Reference to exception in parent package.
-           Report.Failed ("Program control not transferred by raise in " &
-                          "procedure Add");
-       else
-          C.Real := (Left.Real + Right.Real);
-          C.Imag := (Left.Imag + Right.Imag);
-       end if;
- 
-    exception
-       when Add_Error => 
-          TC_Handled_In_Child_Pkg_Proc := true;
-          C := Check_Value;           -- Reference to object in parent package.
-          raise;     -- Reraise the Add_Error exception in the subtest.
-          Report.Failed ("Exception not reraised in handler");
- 
-       when others    =>
-          Report.Failed ("Unexpected exception raised in Add");
- 
-    end Add;
-    -----------------------------------------------------------
-    function Subtract (Left, Right : Complex_Type) 
-      return Complex_Type is
-    begin
-       -- Zero is declared in parent package.
-       if Left.Real < Zero.Real or Right.Real < Zero.Real
-         or Left.Imag < Zero.Imag or Right.Imag < Zero.Imag then
-           raise Subtract_Error;    -- Reference to exception in parent package. 
-           Report.Failed ("Program control not transferred by raise in " &
-                          "function Subtract");
-       else
-          return ( Real => (Left.Real - Right.Real),
-                   Imag => (Left.Imag - Right.Imag) );
-       end if;
- 
-    exception
-       when Subtract_Error => 
-          Report.Comment ("Exception is properly handled in Subtract");
-          TC_Handled_In_Child_Pkg_Func := true;
-          return Check_Value;
- 
-       when others         =>
-          Report.Failed ("Unexpected exception raised in Subtract");
- 
-    end Subtract;
- 
- end FA11D00.CA11D010;     -- Add_Subtract_Complex
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- CA11D011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA11D013.AM
- --
- -- TEST DESCRIPTION:
- --      See CA11D013.AM
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FA11D00.A
- --         CA11D010.A
- --      => CA11D011.A
- --         CA11D012.A
- --         CA11D013.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Dec 94   SAIC    Declared child procedure specification
- --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- 
- 
- -- Child procedure of FA11D00.
- 
- procedure FA11D00.CA11D011 (Left, Right : in     Complex_Type;
-                             C           :    out Complex_Type);
- 
- --=======================================================================--
- 
- procedure FA11D00.CA11D011 (Left, Right : in     Complex_Type;
-                             C           :    out Complex_Type) is
- -- Multiply_Complex.
- 
- begin
-    -- Zero is declared in parent package.
- 
-    if Left.Real < Zero.Real or Right.Imag < Zero.Imag then
-       raise Multiply_Error;  -- Reference to exception in parent package. 
-       Report.Failed ("Program control not transferred by raise in " &
-                      "child procedure FA11D00.CA11D011");
-    else
-       C.Real := (Left.Real * Right.Real);
-       C.Imag := (Left.Imag * Right.Imag);
-    end if;
- 
-    exception
-       when others => 
-          TC_Handled_In_Child_Sub := true;
-          C := Check_Value;            -- Reference to object in parent package.
- 
- end FA11D00.CA11D011;     -- Multiply_Complex
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- CA11D012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA11D013.AM
- --
- -- TEST DESCRIPTION:
- --      See CA11D013.AM
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FA11D00.A
- --         CA11D010.A
- --         CA11D011.A
- --      => CA11D012.A
- --         CA11D013.AM
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Dec 94   SAIC    Declared child function specification
- --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- 
- -- Child function of FA11D00.
- -- Does not divide zero complex numbers.
- 
- function FA11D00.CA11D012 (Left, Right : Complex_Type)
-   return Complex_Type; 
- 
- --=======================================================================--
- 
- function FA11D00.CA11D012 (Left, Right : Complex_Type)
-   return Complex_Type is                       -- Divide_Complex
- 
- begin
-    -- Zero is declared in parent package.
- 
-    if Right.Real = Zero.Real or Right.Imag = Zero.Imag then
-       raise Divide_Error;  -- Reference to exception in parent package. 
-       Report.Failed ("Program control not transferred by raise in " &
-                      "child function FA11D00.CA11D012");
-    else
-       return ( Real => (Left.Real / Right.Real),
-                Imag => (Left.Imag / Right.Imag) );
-    end if;
- 
- end FA11D00.CA11D012;     -- Divide_Complex
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d013.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d013.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d013.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d013.am	Thu Jan  1 00:00:00 1970
***************
*** 1,256 ****
- -- CA11D013.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a child unit can raise an exception that is declared in 
- --      parent.                
- --
- -- TEST DESCRIPTION:
- --      Declare a package which defines complex number abstraction with
- --      user-defined exceptions (foundation code).
- --
- --      Add a public child package to the above package. Declare two 
- --      subprograms for the parent type.  Each of the subprograms raises a 
- --      different exception, based on the value of an input parameter.
- --
- --      Add a public child procedure to the foundation package.  This
- --      procedure raises an exception based on the value of an input 
- --      parameter.
- --
- --      Add a public child function to the foundation package.  This
- --      function raises an exception based on the value of an input 
- --      parameter.
- --
- --      In the main program, "with" the child packages, then check that
- --      the exceptions are raised and handled as expected.  Ensure that
- --      exceptions are:
- --         1) raised in the public child package and handled/reraised to
- --            be handled by the main program.
- --         2) raised and handled locally in the public child package.
- --         3) raised and handled locally by "others" in the public child 
- --            procedure.
- --         4) raised in the public child function and propagated to the
- --            main program.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FA11D00.A
- --         CA11D010.A
- --         CA11D011.A
- --         CA11D012.A
- --      => CA11D013.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FA11D00.CA11D010;               -- Add_Subtract_Complex
- with FA11D00.CA11D011;               -- Multiply_Complex
- with FA11D00.CA11D012;               -- Divide_Complex
- 
- with Report;
- 
- 
- procedure CA11D013 is
- 
-    package Complex_Pkg renames FA11D00;
-    package Add_Subtract_Complex_Pkg renames FA11D00.CA11D010;
-    use Complex_Pkg;
- 
- begin
- 
-    Report.Test ("CA11D013", "Check that a child unit can raise an " &
-                 "exception that is declared in parent");
- 
- 
-    Add_Complex_Subtest:
-    declare
-       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
-                                     Int_Type (Report.Ident_Int (7)));  
-       Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 
-                                     Int_Type (Report.Ident_Int (3)));  
-       Add_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (8)), 
-                                     Int_Type (Report.Ident_Int (10)));  
-       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-100)), 
-                                     Int_Type (Report.Ident_Int (100)));  
-       Complex_Num : Complex_Type := Zero;  
- 
-    begin
-       Add_Subtract_Complex_Pkg.Add (First, Second, Complex_Num);
- 
-       if (Complex_Num /= Add_Result) then
-          Report.Failed ("Incorrect results from addition");
-       end if;
-   
-       -- Error is raised in child package and exception 
-       -- will be handled/reraised to caller.
- 
-       Add_Subtract_Complex_Pkg.Add (First, Third, Complex_Num);
- 
-       -- Error was not raised in child package.
-       Report.Failed ("Exception was not reraised in addition");
- 
-    exception
-       when Add_Error     => 
-          if not TC_Handled_In_Child_Pkg_Proc then
-             Report.Failed ("Exception was not raised in addition");
-          else
-             TC_Handled_In_Caller := true;  -- Exception is reraised from
-                                            -- child package.
-          end if;
- 
-       when others => 
-          Report.Failed ("Unexpected exception in addition subtest"); 
-          TC_Handled_In_Caller := false;  -- Improper exception handling
-                                          -- in caller.
- 
-    end Add_Complex_Subtest;
- 
- 
-    Subtract_Complex_Subtest:
-    declare
-       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
-                                     Int_Type (Report.Ident_Int (6)));  
-       Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 
-                                     Int_Type (Report.Ident_Int (7)));  
-       Sub_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 
-                                     Int_Type (Report.Ident_Int (1)));  
-       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-200)), 
-                                     Int_Type (Report.Ident_Int (1)));  
-       Complex_Num : Complex_Type;
- 
-    begin
-       Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, First);
- 
-       if (Complex_Num /= Sub_Result) then
-          Report.Failed ("Incorrect results from subtraction");
-       end if;
-   
-       -- Error is raised and exception will be handled in child package.
-       Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, Third);
- 
-    exception
-       when Subtract_Error => 
-          Report.Failed ("Exception raised in subtraction and " &
-                         "propagated to caller");
-          TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
-                                                 -- in caller.
- 
-       when others => 
-          Report.Failed ("Unexpected exception in subtraction subtest"); 
-          TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
-                                                 -- in caller.
- 
-    end Subtract_Complex_Subtest;
- 
- 
-    Multiply_Complex_Subtest:
-    declare
-       First       : Complex_Type := Complex (Int_Type(Report.Ident_Int(3)), 
-                                     Int_Type (Report.Ident_Int (4)));  
-       Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 
-                                     Int_Type (Report.Ident_Int (3)));  
-       Mult_Result : Complex_Type := Complex(Int_Type(Report.Ident_Int(15)), 
-                                     Int_Type(Report.Ident_Int (12)));  
-       Third       : Complex_Type := Complex(Int_Type(Report.Ident_Int(10)), 
-                                     Int_Type(Report.Ident_Int (-10)));  
-       Complex_Num : Complex_Type;
- 
-    begin
-       CA11D011 (First, Second, Complex_Num);
- 
-       if (Complex_Num /= Mult_Result) then
-          Report.Failed ("Incorrect results from multiplication");
-       end if;
-   
-       -- Error is raised and exception will be handled in child package.
-      CA11D011 (First, Third, Complex_Num);
- 
-    exception
-       when Multiply_Error => 
-          Report.Failed ("Exception raised in multiplication and " &
-                         "propagated to caller");
-          TC_Handled_In_Child_Sub := false;     -- Improper exception handling
-                                                -- in caller.
- 
-       when others => 
-          Report.Failed ("Unexpected exception in multiplication subtest"); 
-          TC_Handled_In_Child_Sub := false;     -- Improper exception handling
-                                                -- in caller.
-    end Multiply_Complex_Subtest;
- 
- 
-    Divide_Complex_Subtest:
-    declare
-       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int(10)), 
-                                     Int_Type (Report.Ident_Int (15)));  
-       Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 
-                                     Int_Type (Report.Ident_Int (3)));  
-       Div_Result  : Complex_Type := Complex (Int_Type(Report.Ident_Int(2)), 
-                                     Int_Type (Report.Ident_Int (5)));  
-       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-10)), 
-                                     Int_Type (Report.Ident_Int (0)));  
-       Complex_Num : Complex_Type := Zero;
- 
-    begin
-       Complex_Num := CA11D012 (First, Second);
- 
-       if (Complex_Num /= Div_Result) then
-          Report.Failed ("Incorrect results from division");
-       end if;
-   
-       -- Error is raised in child package; exception will be
-       -- propagated to caller.
-       Complex_Num := CA11D012 (Second, Third);
- 
-       -- Error was not raised in child package.
-       Report.Failed ("Exception was not raised in division subtest ");
- 
-    exception
-       when Divide_Error => 
-          TC_Propagated_To_Caller := true;  -- Exception is propagated.
- 
-       when others => 
-          Report.Failed ("Unexpected exception in division subtest"); 
-          TC_Propagated_To_Caller := false;  -- Improper exception handling
-                                             -- in caller.
-    end Divide_Complex_Subtest;
- 
- 
-    if not (TC_Handled_In_Caller         and     -- Check to see that all 
-            TC_Handled_In_Child_Pkg_Proc and     -- exceptions were handled in
-            TC_Handled_In_Child_Pkg_Func and     -- the proper locations.
-            TC_Handled_In_Child_Sub      and     
-            TC_Propagated_To_Caller)
-    then
-       Report.Failed ("Exceptions handled in incorrect locations");
-    end if;
- 
-    Report.Result;
- 
- end CA11D013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,393 ****
- -- CA11D02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an exception declared in a package can be raised by a 
- --      child of a child package.  Check that it can be renamed in the 
- --      child of the child package and raised with the correct effect.
- --
- -- TEST DESCRIPTION:
- --      Declare a package which defines complex number abstraction with
- --      user-defined exceptions (foundation code).
- --
- --      Add a public child package to the above package. Declare two 
- --      subprograms for the parent type.  
- --
- --      Add a public grandchild package to the foundation package.  Declare
- --      subprograms to raise exceptions.
- --
- --      In the main program, "with" the grandchild package, then check that
- --      the exceptions are raised and handled as expected.  Ensure that
- --      exceptions are:
- --         1) raised in the public grandchild package and handled/reraised to
- --            be handled by the main program.
- --         2) raised and handled locally by the "others" handler in the 
- --            public grandchild package.
- --         3) raised in the public grandchild and propagated to the main 
- --            program.
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11D00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Child package of FA11D00.
- 
- package FA11D00.CA11D02_0 is     -- Basic_Complex
- 
-    function "+" (Left, Right : Complex_Type) 
-      return Complex_Type;                   -- Add two complex numbers.
- 
-    function "*" (Left, Right : Complex_Type) 
-      return Complex_Type;                   -- Multiply two complex numbers.
- 
- end FA11D00.CA11D02_0;     -- Basic_Complex
- 
- --=======================================================================--
- 
- package body FA11D00.CA11D02_0 is     -- Basic_Complex
- 
-    function "+" (Left, Right : Complex_Type) return Complex_Type is
-    begin
-       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
-    end "+";
-    --------------------------------------------------------------
-    function "*" (Left, Right : Complex_Type) return Complex_Type is
-    begin
-       return ( Real => (Left.Real * Right.Real),
-                Imag => (Left.Imag * Right.Imag) );
-    end "*";
- 
- end FA11D00.CA11D02_0;     -- Basic_Complex
- 
- --=======================================================================--
- 
- -- Child package of FA11D00.CA11D02_0.
- -- Grandchild package of FA11D00.
- 
- package FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
- 
-    Inverse_Error : exception renames Divide_Error;   -- Reference to exception 
-                                                      -- in grandparent package.
-    Array_Size    : constant := 2;
- 
-    type Complex_Array_Type is                        
-       array (1 .. Array_Size) of Complex_Type;       -- Reference to type
-                                                      -- in parent package.
- 
-    function Multiply (Left  : Complex_Array_Type;    -- Multiply two complex
-                       Right : Complex_Array_Type)    -- arrays.
-      return Complex_Array_Type;
- 
-    function Add (Left, Right : Complex_Array_Type)   -- Add two complex
-      return Complex_Array_Type;                      -- arrays.
- 
-    procedure Inverse (Right : in     Complex_Array_Type;  -- Invert a complex
-                       Left  : in out Complex_Array_Type); -- array.
-  
- end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
- 
- --=======================================================================--
- 
- with Report;
- 
- 
- package body FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
- 
-    function Multiply (Left  : Complex_Array_Type;
-                       Right : Complex_Array_Type)
-      return Complex_Array_Type is
- 
-    -- This procedure will raise an exception depending on the input
-    -- parameter.  The exception will be handled locally by the
-    -- "others" handler.
- 
-       Result : Complex_Array_Type := (others => Zero);
- 
-       subtype Vector_Size is Positive range Left'Range;
- 
-    begin  
-       if Left = Result or else Right = Result then -- Do not multiply zero.
-          raise Multiply_Error;                     -- Refence to exception in
-                                                    -- grandparent package.
-          Report.Failed ("Program control not transferred by raise");
-       else
-          for I in Vector_Size loop
-            Result(I) := ( Left(I) * Right(I) );    -- Basic_Complex."*".
-          end loop;
-       end if;
-       return (Result);
-    
-    exception
-       when others =>
-          Report.Comment ("Exception is handled by others in Multiplication");
-          TC_Handled_In_Grandchild_Pkg_Func := true;
-          return (Zero, Zero);
-       
-    end Multiply;
-    --------------------------------------------------------------
-    function Add (Left, Right : Complex_Array_Type)
-      return Complex_Array_Type is
- 
-    -- This function will raise an exception depending on the input
-    -- parameter.  The exception will be propagated and handled
-    -- by the caller.
- 
-       Result : Complex_Array_Type := (others => Zero);
- 
-       subtype Vector_Size is Positive range Left'Range;
- 
-    begin  
-       if Left = Result or Right = Result then     -- Do not add zero.
-          raise Add_Error;                         -- Refence to exception in
-                                                   -- grandparent package.
-          Report.Failed ("Program control not transferred by raise");
-       else
-          for I in Vector_Size loop                   
-            Result(I) := ( Left(I) + Right(I) );   -- Basic_Complex."+".
-          end loop;
-       end if;
-       return (Result);
-  
-    end Add;
-    --------------------------------------------------------------
-    procedure Inverse (Right : in     Complex_Array_Type;
-                       Left  : in out Complex_Array_Type) is
- 
-    -- This function will raise an exception depending on the input
-    -- parameter.  The exception will be handled/reraised to be
-    -- handled by the caller.
- 
-       Result : Complex_Array_Type := (others => Zero);
- 
-       Array_With_Zero : boolean := false;
- 
-    begin
-       for I in 1 .. Right'Length loop
-         if Right(I) = Zero then      -- Check for zero.
-           Array_With_Zero := true;
-         end if;
-       end loop;
- 
-       If Array_With_Zero then
-          raise Inverse_Error;      -- Do not inverse zero.
-          Report.Failed ("Program control not transferred by raise");
-       else
-          for I in 1 .. Array_Size loop
-            Left(I).Real := - Right(I).Real;
-            Left(I).Imag := - Right(I).Imag;
-         end loop;
-       end if;
- 
-    exception
-       when Inverse_Error  => 
-          TC_Handled_In_Grandchild_Pkg_Proc := true;
-          Left := Result;
-          raise;     -- Reraise the Inverse_Error exception in the subtest.
-          Report.Failed ("Exception not reraised in handler");
- 
-       when others => 
-          Report.Failed ("Unexpected exception in procedure Inverse");
-    end Inverse;
- 
- end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
- 
- --=======================================================================--
- 
- with FA11D00.CA11D02_0.CA11D02_1;    -- Array_Complex,
-                                      -- implicitly with Basic_Complex.
- with Report;
- 
- procedure CA11D02 is
- 
-    package Complex_Pkg renames FA11D00;
-    package Array_Complex_Pkg renames FA11D00.CA11D02_0.CA11D02_1;
- 
-    use Complex_Pkg;                            
-    use Array_Complex_Pkg;                      
- 
- begin
- 
-    Report.Test ("CA11D02", "Check that an exception declared in a package " &
-                 "can be raised by a child of a child package");
- 
-    Multiply_Complex_Subtest:
-    declare
-       Operand_1  : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (3)), 
-                       Int_Type (Report.Ident_Int (5))),
-                       Complex (Int_Type (Report.Ident_Int (2)), 
-                       Int_Type (Report.Ident_Int (8))) );
-       Operand_2  : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (1)), 
-                       Int_Type (Report.Ident_Int (2))),
-                       Complex (Int_Type (Report.Ident_Int (3)), 
-                       Int_Type (Report.Ident_Int (6))) );
-       Operand_3  : Complex_Array_Type := ( Zero, Zero);
-       Mul_Result : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (3)), 
-                       Int_Type (Report.Ident_Int (10))),
-                       Complex (Int_Type (Report.Ident_Int (6)), 
-                       Int_Type (Report.Ident_Int (48))) );
-       Complex_No : Complex_Array_Type := (others => Zero);
- 
-    begin
-       If (Multiply (Operand_1, Operand_2) /= Mul_Result) then
-          Report.Failed ("Incorrect results from multiplication");
-       end if;
- 
-       -- Error is raised and exception will be handled in grandchild package.
- 
-       Complex_No := Multiply (Operand_1, Operand_3);
- 
-       if Complex_No /= (Zero, Zero) then
-          Report.Failed ("Exception was not raised in multiplication");
-       end if;
- 
-    exception
-       when Multiply_Error     =>
-          Report.Failed ("Exception raised in multiplication and " &
-                         "propagated to caller");
-          TC_Handled_In_Grandchild_Pkg_Func := false;  
-               -- Improper exception handling in caller.
- 
-       when others => 
-          Report.Failed ("Unexpected exception in multiplication");
-          TC_Handled_In_Grandchild_Pkg_Func := false;  
-               -- Improper exception handling in caller.
- 
-    end Multiply_Complex_Subtest;
- 
- 
-    Add_Complex_Subtest:
-    declare
-       Operand_1  : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (2)), 
-                       Int_Type (Report.Ident_Int (7))),
-                       Complex (Int_Type (Report.Ident_Int (5)), 
-                       Int_Type (Report.Ident_Int (8))) );
-       Operand_2  : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (4)), 
-                       Int_Type (Report.Ident_Int (1))),
-                       Complex (Int_Type (Report.Ident_Int (2)), 
-                       Int_Type (Report.Ident_Int (3))) );
-       Operand_3  : Complex_Array_Type := ( Zero, Zero);
-       Add_Result : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (6)), 
-                       Int_Type (Report.Ident_Int (8))),
-                       Complex (Int_Type (Report.Ident_Int (7)), 
-                       Int_Type (Report.Ident_Int (11))) );
-       Complex_No : Complex_Array_Type := (others => Zero);
- 
-    begin
-       Complex_No := Add (Operand_1, Operand_2);
- 
-       If (Complex_No /= Add_Result) then
-          Report.Failed ("Incorrect results from addition");
-       end if;
- 
-       -- Error is raised in grandchild package and exception 
-       -- will be propagated to caller.
- 
-       Complex_No := Add (Operand_1, Operand_3);
- 
-       if Complex_No = Add_Result then
-          Report.Failed ("Exception was not raised in addition");
-       end if;
- 
-    exception
-       when Add_Error => 
-          TC_Propagated_To_Caller := true;  -- Exception is propagated.
- 
-       when others => 
-          Report.Failed ("Unexpected exception in addition subtest");
-          TC_Propagated_To_Caller := false;  -- Improper exception handling
-                                             -- in caller.
-    end Add_Complex_Subtest;
- 
-    Inverse_Complex_Subtest:
-    declare
-       Operand_1  : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (1)), 
-                       Int_Type (Report.Ident_Int (5))),
-                       Complex (Int_Type (Report.Ident_Int (3)), 
-                       Int_Type (Report.Ident_Int (11))) );
-       Operand_3  : Complex_Array_Type 
-                  := ( Zero, Complex (Int_Type (Report.Ident_Int (3)), 
-                       Int_Type (Report.Ident_Int (6))) );
-       Inv_Result : Complex_Array_Type 
-                  := ( Complex (Int_Type (Report.Ident_Int (-1)), 
-                       Int_Type (Report.Ident_Int (-5))),
-                       Complex (Int_Type (Report.Ident_Int (-3)), 
-                       Int_Type (Report.Ident_Int (-11))) );
-       Complex_No : Complex_Array_Type := (others => Zero);
- 
-    begin
-       Inverse (Operand_1, Complex_No);
- 
-       if (Complex_No /= Inv_Result) then
-          Report.Failed ("Incorrect results from inverse");
-       end if;
- 
-       -- Error is raised in grandchild package and exception 
-       -- will be handled/reraised to caller.
- 
-       Inverse (Operand_3, Complex_No);
- 
-       Report.Failed ("Exception was not handled in inverse");
- 
-    exception
-       when Inverse_Error => 
-          if not TC_Handled_In_Grandchild_Pkg_Proc then
-             Report.Failed ("Exception was not raised in inverse");
-          else
-             TC_Handled_In_Caller := true;  -- Exception is reraised from
-                                            -- child package.
-          end if;
- 
-       when others => 
-          Report.Failed ("Unexpected exception in inverse");
-          TC_Handled_In_Caller := false; 
-                 -- Improper exception handling in caller.
- 
-    end Inverse_Complex_Subtest;
- 
-    if not (TC_Handled_In_Caller               and   -- Check to see that all 
-            TC_Handled_In_Grandchild_Pkg_Proc  and   -- exceptions were handled
-            TC_Handled_In_Grandchild_Pkg_Func  and   -- in proper location.
-            TC_Propagated_To_Caller)        
-    then
-       Report.Failed ("Exceptions handled in incorrect locations");
-    end if;
- 
-    Report.Result;
- 
- end CA11D02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca11d03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca11d03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- -- CA11D03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an exception declared in a package can be raised by a 
- --      client of a child of the package.  Check that it can be renamed in 
- --      the client of the child of the package and raised with the correct 
- --      effect.
- --
- -- TEST DESCRIPTION:
- --      Declare a package which defines complex number abstraction with
- --      user-defined exceptions (foundation code).
- --
- --      Add a public child package to the above package. Declare two 
- --      subprograms for the parent type.  
- --
- --      In the main program, "with" the child package, then check that
- --      an exception can be raised and handled as expected.  
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --
- --         FA11D00.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Child package of FA11D00.
- package FA11D00.CA11D03_0 is     -- Basic_Complex
- 
-    function "+" (Left, Right : Complex_Type) 
-      return Complex_Type;                   -- Add two complex numbers.
- 
-    function "*" (Left, Right : Complex_Type) 
-      return Complex_Type;                   -- Multiply two complex numbers.
- 
- end FA11D00.CA11D03_0;     -- Basic_Complex
- 
- --=======================================================================--
- 
- package body FA11D00.CA11D03_0 is     -- Basic_Complex
- 
-    function "+" (Left, Right : Complex_Type) return Complex_Type is
-    begin
-       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
-    end "+";
-    --------------------------------------------------------------
-    function "*" (Left, Right : Complex_Type) return Complex_Type is
-    begin
-       return ( Real => (Left.Real * Right.Real),
-                Imag => (Left.Imag * Right.Imag) );
-    end "*";
- 
- end FA11D00.CA11D03_0;     -- Basic_Complex
- 
- --=======================================================================--
- 
- with FA11D00.CA11D03_0;    -- Basic_Complex,
-                            -- implicitly with Complex_Definition.
- with Report;
- 
- procedure CA11D03 is
- 
-    package Complex_Pkg renames FA11D00;     -- Complex_Definition_Pkg
-    package Basic_Complex_Pkg renames FA11D00.CA11D03_0;   -- Basic_Complex
- 
-    use Complex_Pkg;                            
-    use Basic_Complex_Pkg;           
-            
-    TC_Handled_In_Subtest_1,
-    TC_Handled_In_Subtest_2 : boolean := false;
- 
- begin
- 
-    Report.Test ("CA11D03", "Check that an exception declared in a package " &
-                 "can be raised by a client of a child of the package");
- 
-    Multiply_Complex_Subtest:
-    declare
-       Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
-                                    Int_Type (Report.Ident_Int (2)));  
-                                    -- Referenced to function in parent package.
-       Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (10)), 
-                                    Int_Type (Report.Ident_Int (8)));  
-       Mul_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (30)), 
-                                    Int_Type (Report.Ident_Int (16)));  
-       Complex_No : Complex_Type := Zero;  -- Zero is declared in parent package.
-    begin
-       Complex_No := Operand_1 * Operand_2;   -- Basic_Complex."*".
-       if Complex_No /= Mul_Res then
-          Report.Failed ("Incorrect results from multiplication");
-       end if;
- 
-       -- Error is raised and exception will be handled.
-       if Complex_No = Mul_Res then
-          raise Multiply_Error;             -- Reference to exception in
-       end if;                              -- parent package.
- 
-    exception
-       when Multiply_Error => 
-          TC_Handled_In_Subtest_1 := true;
-       when others => 
-          TC_Handled_In_Subtest_1 := false;  -- Improper exception handling.
- 
-    end Multiply_Complex_Subtest;
- 
-    Add_Complex_Subtest:
-    declare
-       Error_In_Client : exception renames Add_Error;  
-                         -- Reference to exception in parent package.
-       Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 
-                                    Int_Type (Report.Ident_Int (7)));  
-       Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (-4)), 
-                                    Int_Type (Report.Ident_Int (1)));  
-       Add_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (-2)), 
-                                    Int_Type (Report.Ident_Int (8)));  
-       Complex_No : Complex_Type := One;   -- One is declared in parent 
-                                           -- package.
-    begin
-       Complex_No := Operand_1 + Operand_2;   -- Basic_Complex."+".
- 
-       if Complex_No /= Add_Res then
-          Report.Failed ("Incorrect results from multiplication");
-       end if;
- 
-       -- Error is raised and exception will be handled.
-       if Complex_No = Add_Res then
-          raise Error_In_Client;
-       end if;
- 
-    exception
-       when Error_In_Client => 
-          TC_Handled_In_Subtest_2 := true;
- 
-       when others => 
-          TC_Handled_In_Subtest_2 := false;  -- Improper exception handling.
- 
-    end Add_Complex_Subtest;
- 
-    if not (TC_Handled_In_Subtest_1           and   -- Check to see that all 
-            TC_Handled_In_Subtest_2)                -- exceptions were handled
-                                                    -- in the proper location.
-    then
-       Report.Failed ("Exceptions handled in incorrect locations");
-    end if;
- 
-    Report.Result;
- 
- end CA11D03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,370 ****
- -- CA13001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a separate protected unit declared in a non-generic child 
- --      unit of a private parent have the same visibility into its parent, 
- --      its siblings, and packages on which its parent depends as is available 
- --      at the point of their declaration.
- --
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential of having all
- --      members of one family to take out a transportation.  The restriction
- --      is depend on each member to determine who can get a car, a clunker, 
- --      or a bicycle.  If no transportation is available, that member has to
- --      walk.  
- --      
- --      Declare a package with location for each family member.  Declare
- --      a public parent package.  Declare a private child package. Declare a 
- --      public grandchild of this private package.  Declare a protected unit 
- --      as a subunit in a public grandchild package.  This subunit has 
- --      visibility into it's parent body ancestor and its sibling.
- --
- --      Declare another public parent package.  The body of this package has
- --      visibility into its private sibling's descendants.
- --
- --      In the main program, "with"s the parent package.  Check that the
- --      protected subunit performs as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
- --
- --!
- 
- package CA13001_0 is                    
- 
-    type Location is (School, Work, Beach, Home);
-    type Family is (Father, Mother, Teen);
-    Destination : array (Family) of Location;
- 
-    -- Other type definitions and procedure declarations in real application.
- 
- end CA13001_0;
- 
- -- No bodies required for CA13001_0.
- 
-      --==================================================================--
- 
- -- Public parent.
- 
- package CA13001_1 is                     
- 
-    type Transportation is (Bicycle, Clunker, New_Car);
-    type Key_Type is private;
-    Walking : boolean := false;
- 
-    -- Other type definitions and procedure declarations in real application.
- 
- private
-    type Key_Type 
-      is range Transportation'pos(Bicycle) .. Transportation'pos(New_Car);
- 
- end CA13001_1;
- 
- -- No bodies required for CA13001_1.
- 
-      --==================================================================--
- 
- -- Private child. 
- 
- private package CA13001_1.CA13001_2 is       
- 
-    type Transport is
-       record
-          In_Use : boolean := false;
-       end record;
-    Vehicles : array (Transportation) of Transport;
- 
-    -- Other type definitions and procedure declarations in real application.
- 
- end CA13001_1.CA13001_2;
- 
- -- No bodies required for CA13001_1.CA13001_2.
- 
-      --==================================================================--
- 
- -- Public grandchild of a private parent.
- 
- package CA13001_1.CA13001_2.CA13001_3 is
- 
-    Flat_Tire : array (Transportation) of boolean := (others => false);
- 
-    -- Other type definitions and procedure declarations in real application.
- 
- end CA13001_1.CA13001_2.CA13001_3;
- 
- -- No bodies required for CA13001_1.CA13001_2.CA13001_3.
- 
-      --==================================================================--
- 
- -- Context clauses required for visibility needed by a separate subunit.
- 
- with CA13001_0;                           
- use  CA13001_0;
- 
- -- Public grandchild of a private parent.
- 
- package CA13001_1.CA13001_2.CA13001_4 is
- 
-    type Transit is
-       record
-          Available : boolean := false;
-       end record;
-    type Keys_Array is array (Transportation) of Transit;
-    Fuel : array (Transportation) of boolean := (others => true);
- 
-    protected Family_Transportation is
- 
-       procedure Get_Vehicle (Who : in     Family;
-                              Key :    out Key_Type);
-       procedure Return_Vehicle (Tr : in Transportation);
-       function TC_Verify (What : Transportation) return boolean;
- 
-    private
-       Keys : Keys_Array;
- 
-    end Family_Transportation;
- 
- end CA13001_1.CA13001_2.CA13001_4;
- 
-      --==================================================================--
- 
- -- Context clause required for visibility needed by a separate subunit.
- 
- with CA13001_1.CA13001_2.CA13001_3;    -- Public sibling.
- 
- package body CA13001_1.CA13001_2.CA13001_4 is
- 
-    protected body Family_Transportation is separate;
- 
- end CA13001_1.CA13001_2.CA13001_4;
- 
-      --==================================================================--
- 
- separate (CA13001_1.CA13001_2.CA13001_4)
- protected body Family_Transportation is
- 
-    procedure Get_Vehicle (Who : in     Family;
-                           Key :    out Key_Type) is
-    begin
-       case Who is
-          when Father|Mother => 
-             -- Drive new car to work
- 
-             -- Reference package with'ed by the subunit parent's body.
-             if Destination(Who) = Work then
- 
-                -- Reference type declared in the private parent of the subunit
-                -- parent's body.
-                -- Reference type declared in the visible part of the 
-                -- subunit parent's body.
-                if not Vehicles(New_Car).In_Use and Fuel(New_Car) 
- 
-                  -- Reference type declared in the public sibling of the 
-                  -- subunit parent's body.
-                  and not CA13001_1.CA13001_2.CA13001_3.Flat_Tire(New_Car) then
-                     Vehicles(New_Car).In_Use := true;
- 
-                     -- Reference type declared in the private part of the 
-                     -- protected subunit.
-                     Keys(New_Car).Available := false;
-                     Key                     := Transportation'pos(New_Car);
-                else
-                  -- Reference type declared in the grandparent of the subunit
-                  -- parent's body.
-                  Walking := true;
-                end if;
- 
-             -- Drive clunker to other destinations.
-             else
-                if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not 
-                  CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
-                     Vehicles(Clunker).In_Use := true;
-                     Keys(Clunker).Available  := false;
-                     Key                      := Transportation'pos(Clunker);
-                else
-                  Walking := true;
-                  Key     := Transportation'pos(Bicycle);
-                end if;
-             end if;
-     
-          -- Similar for Teen.
-          when Teen => 
-             if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not 
-               CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
-                  Vehicles(Clunker).In_Use := true;
-                  Keys(Clunker).Available  := false;
-                  Key                      := Transportation'pos(Clunker);
-             else
-                Walking := true;
-                Key     := Transportation'pos(Bicycle);
-             end if;
-       end case;
- 
-    end Get_Vehicle;
- 
-    ----------------------------------------------------------------
- 
-    -- Any family member can bring back the transportation with the key.
- 
-    procedure Return_Vehicle (Tr : in Transportation) is
-    begin
-       Vehicles(Tr).In_Use := false;
-       Keys(Tr).Available  := true;
-    end Return_Vehicle;
- 
-    ----------------------------------------------------------------
- 
-    function TC_Verify (What : Transportation) return boolean is
-    begin
-       return Keys(What).Available;
-    end TC_Verify;
-    
- end Family_Transportation;
- 
-      --==================================================================--
- 
- with CA13001_0;
- use  CA13001_0;
- 
- -- Public child.
- 
- package CA13001_1.CA13001_5 is
- 
-    -- In a real application, tasks could be used to demonstrate 
-    -- a family transportation scenario, i.e., each member of
-    -- a family can take a vehicle out concurrently, then return
-    -- them at the same time. For the purposes of the test, family
-    -- transportation happens sequentially.
- 
-    procedure Provide_Transportation (Who     : in     Family;
-                                      Get_Key :    out Key_Type;
-                                      Get_Veh :    out boolean);
-    procedure Return_Transportation (What   : in     Transportation;
-                                     Rt_Veh :    out boolean);
- 
- end CA13001_1.CA13001_5;
- 
-      --==================================================================--
- 
- with CA13001_1.CA13001_2.CA13001_4;   -- Public grandchild of a private parent,
-                                       -- implicitly with CA13001_1.CA13001_2.
- package body CA13001_1.CA13001_5 is
- 
-    package Transportation_Pkg renames CA13001_1.CA13001_2.CA13001_4;
-    use Transportation_Pkg;
- 
-    -- These two validation subprograms provide the capability to check the 
-    -- components defined in the private packages from within the client 
-    -- program.
- 
-    procedure Provide_Transportation (Who     : in     Family;
-                                      Get_Key :    out Key_Type;
-                                      Get_Veh :    out boolean) is
-    begin
-       -- Goto work, school, or to the beach.
-       Family_Transportation.Get_Vehicle (Who, Get_Key);
-       if not Family_Transportation.TC_Verify 
-         (Transportation'Val(Get_Key)) then
-            Get_Veh := true;
-       else
-          Get_Veh := false;
-       end if;
- 
-    end Provide_Transportation;
- 
-    ----------------------------------------------------------------
- 
-    procedure Return_Transportation (What   : in     Transportation;
-                                     Rt_Veh :    out boolean) is
-    begin
-       Family_Transportation.Return_Vehicle (What);
-       if Family_Transportation.TC_Verify(What) and 
-         not CA13001_1.CA13001_2.Vehicles(What).In_Use then
-            Rt_Veh := true;
-       else
-          Rt_Veh := false;
-       end if;
- 
-    end Return_Transportation;
- 
- end CA13001_1.CA13001_5;
- 
-      --==================================================================--
- 
- with CA13001_0;
- with CA13001_1.CA13001_5;        -- Implicitly with parent, CA13001_1.
- with Report;
- 
- procedure CA13001 is
- 
-    Mommy           : CA13001_0.Family := CA13001_0.Mother;
-    Daddy           : CA13001_0.Family := CA13001_0.Father;
-    BG              : CA13001_0.Family := CA13001_0.Teen;
-    BG_Clunker      : CA13001_1.Transportation := CA13001_1.Clunker;
-    Get_Key         : CA13001_1.Key_Type;
-    Get_Transit     : boolean := false;
-    Return_Transit  : boolean := false;
- 
- begin 
-    Report.Test ("CA13001", "Check that a protected subunit declared in " & 
-                 "a child unit of a private parent have the same visibility " &
-                 "into its parent, its parent's siblings, and packages on " &
-                 "which its parent depends");
- 
-    -- Get transportation for mother to go to work.
-    CA13001_0.Destination(CA13001_0.Mother) := CA13001_0.Work;
-    CA13001_1.CA13001_5.Provide_Transportation (Mommy, Get_Key, Get_Transit);
-    if not Get_Transit then
-       Report.Failed ("Failed to get mother transportation");
-    end if;
- 
-    -- Get transportation for teen to go to school.
-    CA13001_0.Destination(CA13001_0.Teen) := CA13001_0.School;
-    Get_Transit := false;
-    CA13001_1.CA13001_5.Provide_Transportation (BG, Get_Key, Get_Transit);
-    if not Get_Transit then
-       Report.Failed ("Failed to get teen transportation");
-    end if;
- 
-    -- Get transportation for father to go to the beach.
-    CA13001_0.Destination(CA13001_0.Father) := CA13001_0.Beach;
-    Get_Transit := false;
-    CA13001_1.CA13001_5.Provide_Transportation (Daddy, Get_Key, Get_Transit);
-    if Get_Transit and not CA13001_1.Walking then
-       Report.Failed ("Failed to make daddy to walk to the beach");
-    end if;
- 
-    -- Return the clunker.
-    CA13001_1.CA13001_5.Return_Transportation (BG_Clunker, Return_Transit);
-    if not Return_Transit then
-       Report.Failed ("Failed to get back the clunker");
-    end if;
- 
-    Report.Result;
- 
- end CA13001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,259 ****
- -- CA13002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that two library child units and/or subunits may have the same 
- --      simple names if they have distinct expanded names.
- --
- -- TEST DESCRIPTION:
- --      Declare a package that provides some primitive functionality (minimal
- --      terminal driver operations in this case).  Add child packages to 
- --      expand the functionality for different but related contexts (different
- --      terminal kinds).  Add child packages, or subunits, to the children to
- --      provide the same high level operation for each of the different 
- --      contexts (terminals).  Since the operations are the same, at the leaf
- --      level they are likely to have the same names.
- --
- --      The main program "with"s the child packages.  Check that the
- --      child units and subunits perform as expected.  
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
-    
- -- Public parent.
- package CA13002_0 is                     -- Terminal_Driver.
- 
-    type TC_Name is (First_Child, Second_Child, Third_Child, Fourth_Child);
-    type TC_Call_From is (First_Grandchild, Second_Grandchild, First_Subunit, 
-                            Second_Subunit);
-    type TC_Calls_Arr is array (TC_Name, TC_Call_From) of boolean;
-    TC_Calls : TC_Calls_Arr := (others => (others => false));
- 
-    -- In real application, Send_Control_Sequence sends keystrokes from
-    -- the terminal, i.e., space, escape, etc.
-    procedure Send_Control_Sequence (Row : in TC_Name;
-                                     Col : in TC_Call_From);
- 
- end CA13002_0;
- 
-      --==================================================================--
- 
- -- First child.
- package CA13002_0.CA13002_1 is           -- Terminal_Driver.VT100
- 
-    -- Move cursor up, down, left, or right.
-    procedure Move_Cursor (Col : in TC_Call_From);
- 
- end CA13002_0.CA13002_1;
- 
-      --==================================================================--
- 
- -- First grandchild.
- procedure CA13002_0.CA13002_1.CA13002_5; -- Terminal_Driver.VT100.Cursor_Up
- 
-      --==================================================================--
- 
- -- Second child.
- package CA13002_0.CA13002_2 is           -- Terminal_Driver.IBM3270
- 
-    procedure Move_Cursor (Col : in TC_Call_From);
- 
- end CA13002_0.CA13002_2;
- 
-      --==================================================================--
- 
- -- Second grandchild.
- procedure CA13002_0.CA13002_2.CA13002_5; -- Terminal_Driver.IBM3270.Cursor_Up
- 
-      --==================================================================--
- 
- -- Third child.
- package CA13002_0.CA13002_3 is           -- Terminal_Driver.DOS_ANSI
- 
-    procedure Move_Cursor (Col : in TC_Call_From);
- 
-    procedure CA13002_5;                  -- Terminal_Driver.DOS_ANSI.Cursor_Up
-                                          -- implementation will be as a 
-                                          -- separate subunit.
- end CA13002_0.CA13002_3;
- 
-      --==================================================================--
- 
- -- Fourth child.
- package CA13002_0.CA13002_4 is           -- Terminal_Driver.WYSE
- 
-    procedure Move_Cursor (Col : in TC_Call_From);
- 
-    procedure CA13002_5;                  -- Terminal_Driver.WYSE.Cursor_Up
-                                          -- implementation will be as a 
-                                          -- separate subunit.
- 
- end CA13002_0.CA13002_4;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.
- package body CA13002_0 is                  
- 
-    procedure Send_Control_Sequence (Row : in TC_Name;
-                                     Col : in TC_Call_From) is
-    begin
-       -- Reads a key and takes action.
-       TC_Calls (Row, Col) := true;
-    end Send_Control_Sequence;
- 
- end CA13002_0;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.VT100.
- package body CA13002_0.CA13002_1 is                     
- 
-    procedure Move_Cursor (Col : in TC_Call_From) is
-    begin
-       Send_Control_Sequence (First_Child, Col);
-    end Move_Cursor;
- 
- end CA13002_0.CA13002_1;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.VT100.Cursor_Up.
- procedure CA13002_0.CA13002_1.CA13002_5 is 
- begin
-    Move_Cursor (First_Grandchild);        -- from Terminal_Driver.VT100.
- end CA13002_0.CA13002_1.CA13002_5;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.IBM3270.
- package body CA13002_0.CA13002_2 is                     
- 
-    procedure Move_Cursor (Col : in TC_Call_From) is
-    begin
-       Send_Control_Sequence (Second_Child, Col);
-    end Move_Cursor;
- 
- end CA13002_0.CA13002_2;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.IBM3270.Cursor_Up.
- procedure CA13002_0.CA13002_2.CA13002_5 is 
- begin
-    Move_Cursor (Second_Grandchild);       -- from Terminal_Driver.IBM3270.
- end CA13002_0.CA13002_2.CA13002_5;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.DOS_ANSI.
- package body CA13002_0.CA13002_3 is                     
- 
-    procedure Move_Cursor (Col : in TC_Call_From) is
-    begin
-       Send_Control_Sequence (Third_Child, Col);
-    end Move_Cursor;
- 
-    procedure CA13002_5 is separate;
- 
- end CA13002_0.CA13002_3;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.DOS_ANSI.Cursor_Up.
- separate (CA13002_0.CA13002_3)
- procedure CA13002_5 is 
- begin
-    Move_Cursor (First_Subunit);           -- from Terminal_Driver.DOS_ANSI.
- end CA13002_5;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.WYSE.
- package body CA13002_0.CA13002_4 is                     
- 
-    procedure Move_Cursor (Col : in TC_Call_From) is
-    begin
-       Send_Control_Sequence (Fourth_Child, Col);
-    end Move_Cursor;
- 
-    procedure CA13002_5 is separate;
- 
- end CA13002_0.CA13002_4;
- 
-      --==================================================================--
- 
- -- Terminal_Driver.WYSE.Cursor_Up.
- separate (CA13002_0.CA13002_4)
- procedure CA13002_5 is 
- begin
-    Move_Cursor (Second_Subunit);          -- from Terminal_Driver.WYSE.
- end CA13002_5;
- 
-      --==================================================================--
- 
- with CA13002_0.CA13002_1.CA13002_5;     -- Terminal_Driver.VT100.Cursor_Up,
-                                         -- implicitly with parent, CA13002_0.
- with CA13002_0.CA13002_2.CA13002_5;     -- Terminal_Driver.IBM3270.Cursor_Up.
- with CA13002_0.CA13002_3;               -- Terminal_Driver.DOS_ANSI.
- with CA13002_0.CA13002_4;               -- Terminal_Driver.WYSE.
- with Report;
- use  CA13002_0;                         -- All primitive subprograms directly
-                                         -- visible.
- 
- procedure CA13002 is
-    Expected_Calls : constant CA13002_0.TC_Calls_Arr 
-                   := ((true,  false, false, false),
-                       (false, true , false, false),
-                       (false, false, true , false),
-                       (false, false, false, true ));
- begin
-    Report.Test ("CA13002", "Check that two library units and/or subunits " &
-                 "may have the same simple names if they have distinct " &
-                 "expanded names");
- 
-    -- Note that the leaves all have the same name.
-    -- Call the first grandchild.
-    CA13002_0.CA13002_1.CA13002_5;       
- 
-    -- Call the second grandchild.
-    CA13002_0.CA13002_2.CA13002_5;
- 
-    -- Call the first subunit.
-    CA13002_0.CA13002_3.CA13002_5;
- 
-    -- Call the second subunit.
-    CA13002_0.CA13002_4.CA13002_5;
- 
-    if TC_Calls /= Expected_Calls then
-       Report.Failed ("Wrong result");
-    end if;  
- 
-    Report.Result;
- 
- end CA13002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,256 ****
- -- CA13003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that separate subunits which share an ancestor may have the
- --      same name if they have different fully qualified names.  Check
- --      the case of separate subunits of separate subunits.
- --      This test is a change in semantics from Ada 83 to Ada 9X.
- --
- -- TEST DESCRIPTION:
- --      Declare a package that provides file processing operations.  Declare
- --      one separate package to do the file processing, and another to do the
- --      auditing.  These packages contain similar functions declared in 
- --      separate subunits.  Verify that the main program can call the 
- --      separate subunits with the same name.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Simulates a file processing application.  The processing package opens
- -- files, reads files, does file processing, and generates reports.
- -- The auditing package opens files, read files, and generates reports.
- 
- package CA13003_0 is       
- 
-    type File_ID is range 1 .. 100;
-    subtype File_Name is string (1 .. 10);
- 
-    TC_Open_For_Process    : boolean := false;
-    TC_Open_For_Audit      : boolean := false;
-    TC_Report_From_Process : boolean := false;
-    TC_Report_From_Audit   : boolean := false;
- 
-    type File_Rec is 
-       record
-          Name : File_Name;
-          ID   : File_ID;
-       end record;
- 
-    procedure Initialize_File_Rec (Name_In : in     File_Name;
-                                   ID_In   : in     File_ID;
-                                   File_In :    out File_Rec);
-  
-    ----------------------------------------------------------------------
- 
-    package CA13003_1 is    -- File processing
- 
-       procedure CA13003_3;                             -- Open files
-       function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
-         return File_Name;                              -- Process files
-       package CA13003_5 is                             -- Generate report
-          procedure Generate_Report;
-       end CA13003_5;
- 
-    end CA13003_1;
- 
-    ----------------------------------------------------------------------
- 
-    package CA13003_2 is    -- File auditing
- 
-       procedure CA13003_3;                             -- Open files
-       function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
-         return File_Name;                              -- Process files
-       package CA13003_5 is                             -- Generate report
-          procedure Generate_Report;
-       end CA13003_5;
- 
-    end CA13003_2;
- 
- end CA13003_0;
- 
-      --==================================================================--
- 
- package body CA13003_0 is       
- 
-    procedure Initialize_File_Rec (Name_In : in     File_Name;
-                                   ID_In   : in     File_ID;
-                                   File_In :    out File_Rec) is
-    -- Not a real initialization.  Real application can use file
-    -- database to create the file record.
-    begin
-       File_In.Name := Name_In;
-       File_In.ID   := ID_In;
-    end Initialize_File_Rec;
- 
-    package body CA13003_1 is separate;
-    package body CA13003_2 is separate;
- 
- end CA13003_0;
- 
-      --==================================================================--
- 
- separate (CA13003_0)
- package body CA13003_1 is
- 
-    procedure CA13003_3 is separate;                 -- Open files
-    function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
-      return File_Name is separate;                  -- Process files
-    package body CA13003_5 is separate;              -- Generate report
- 
- end CA13003_1;
- 
-      --==================================================================--
- 
- separate (CA13003_0.CA13003_1)
- procedure CA13003_3 is                              -- Open files
- begin
-    -- In real file processing application, open file from database, setup
-    -- data structure, etc.
-    TC_Open_For_Process := true;
- end CA13003_3;
- 
-      --==================================================================--
- 
- separate (CA13003_0.CA13003_1)
- function CA13003_4 (ID_In : File_ID;                -- Process files
-                     File_In : File_Rec) return File_Name is 
- begin
-    -- In real file processing application, process files for more information.
-    return File_In.Name;
- end CA13003_4;
- 
-      --==================================================================--
- 
- separate (CA13003_0.CA13003_1)
- package body CA13003_5 is                           -- Generate report
-    procedure Generate_Report is
-    begin
-       -- In real file processing application, generate various report from the
-       -- file database.
-       TC_Report_From_Process := true;
-    end Generate_Report;
- 
- end CA13003_5;
- 
-      --==================================================================--
- 
- separate (CA13003_0)
- package body CA13003_2 is
- 
-    procedure CA13003_3 is separate;                 -- Open files
-    function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
-      return File_Name is separate;                  -- Process files
-    package body CA13003_5 is separate;              -- Generate report
- 
- end CA13003_2;
- 
-      --==================================================================--
- 
- separate (CA13003_0.CA13003_2)
- procedure CA13003_3 is                              -- Open files
- begin
-    TC_Open_For_Audit := true;
- end CA13003_3;
- 
-      --==================================================================--
- 
- separate (CA13003_0.CA13003_2)
- function CA13003_4 (ID_In : File_ID; 
-                     File_In : File_Rec) return File_Name is 
- begin
-    return File_In.Name;
- end CA13003_4;
- 
-      --==================================================================--
- 
- separate (CA13003_0.CA13003_2)
- package body CA13003_5 is                           -- Generate report
-    procedure Generate_Report is
-    begin
-       TC_Report_From_Audit := true;
-    end Generate_Report;
- 
- end CA13003_5;
- 
-      --==================================================================--
- 
- with CA13003_0;
- with Report;
- 
- procedure CA13003 is
-    First_File_Name  : CA13003_0.File_Name := "Joe Smith ";
-    First_File_Id    : CA13003_0.File_ID   := 11;
-    Second_File_Name : CA13003_0.File_Name := "John Schep";
-    Second_File_Id   : CA13003_0.File_ID   := 47;
-    Expected_Name    : CA13003_0.File_Name := "          ";
-    Student_File     : CA13003_0.File_Rec;
-    
-    function Process_Input_Files (ID_In   : CA13003_0.File_ID; 
-                                  File_In : CA13003_0.File_Rec) return 
-      CA13003_0.File_Name renames CA13003_0.CA13003_1.CA13003_4;
- 
-    function Process_Audit_Files (ID_In   : CA13003_0.File_ID; 
-                                  File_In : CA13003_0.File_Rec) return 
-      CA13003_0.File_Name renames CA13003_0.CA13003_2.CA13003_4;
- begin
-    Report.Test ("CA13003", "Check that separate subunits which share " &
-                 "an ancestor may have the same name if they have " &
-                 "different fully qualified names");
- 
-    Student_File := (ID => First_File_Id, Name => First_File_Name);
- 
-    -- Note that all subunits have the same simple name.
-    -- Generate report from file processing.
-    CA13003_0.CA13003_1.CA13003_3;
-    Expected_Name := Process_Input_Files (First_File_Id, Student_File);
-    CA13003_0.CA13003_1.CA13003_5.Generate_Report;
- 
-    if not CA13003_0.TC_Open_For_Process or 
-      not CA13003_0.TC_Report_From_Process or 
-        Expected_Name /= First_File_Name then
-          Report.Failed ("Unexpected results in processing file");
-    end if;
- 
-    CA13003_0.Initialize_File_Rec 
-      (Second_File_Name, Second_File_Id, Student_File);
- 
-    -- Generate report from file auditing.
-    CA13003_0.CA13003_2.CA13003_3;
-    Expected_Name := Process_Audit_Files (Second_File_Id, Student_File);
-    CA13003_0.CA13003_2.CA13003_5.Generate_Report;
- 
-    if not CA13003_0.TC_Open_For_Audit or 
-      not CA13003_0.TC_Report_From_Audit or 
-        Expected_Name /= Second_File_Name then
-          Report.Failed ("Unexpected results in auditing file");
-    end if;
- 
-    Report.Result;
- 
- end CA13003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,320 ****
- -- CA13A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that subunits declared in non-generic child units of a public 
- --      parent have the same visibility into its parent, its siblings 
- --      (public and private), and packages on which its parent depends 
- --      as is available at the point of their declaration.
- --
- -- TEST DESCRIPTION:
- --      Declare an check system procedure as a subunit in a private child 
- --      package of the basic operation package (FA13A00.A).  This procedure 
- --      has visibility into its parent ancestor and its private sibling.
- --
- --      Declare an emergency procedure as a subunit in a public child package
- --      of the basic operation package (FA13A00.A).  This procedure has 
- --      visibility into its parent ancestor and its private sibling. 
- --
- --      Declare an express procedure as a subunit in a public child subprogram
- --      of the basic operation package (FA13A00.A).  This procedure has 
- --      visibility into its parent ancestor and its public sibling. 
- --
- --      In the main program, "with"s the child package and subprogram.  Check 
- --      that subunits perform as expected.  
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FA13A00.A
- --         CA13A01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Private child package of an elevator application.  This package
- -- provides maintenance operations.
- 
- private package FA13A00_1.CA13A01_4 is    -- Maintenance operation
- 
-    One_Floor : Floor_No := 1;             -- Type declared in parent.
- 
-    procedure Check_System;
- 
-    -- other type definitions and procedure declarations in real application.
- 
- end FA13A00_1.CA13A01_4;
- 
-      --==================================================================--
- 
- -- Context clauses required for visibility needed by separate subunit.
- 
- with FA13A00_0;                           -- Building Manager
- 
- with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
-                                          
- with FA13A00_1.FA13A00_3;                 -- Move Elevator
- 
- use  FA13A00_0;                           
- 
- package body FA13A00_1.CA13A01_4 is              
- 
-    procedure Check_System is separate;
- 
- end FA13A00_1.CA13A01_4;
- 
-      --==================================================================--
- 
- separate (FA13A00_1.CA13A01_4)
- 
- -- Subunit Check_System declared in Maintenance Operation.
- 
- procedure Check_System is
- begin
-    -- See if regular power is on.
- 
-    if Power /= V120 then                  -- Reference package with'ed by
-       TC_Operation := false;              -- the subunit parent's body.
-    end if;
- 
-    -- Test elevator function.
- 
-    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of
-      (Penthouse, Call_Waiting);           -- the subunit parent's body.
- 
-    if not Call_Waiting (Penthouse) then   -- Reference private part of the
-       TC_Operation := false;              -- parent of the subunit package's 
-                                           -- body.
-    end if;
- 
-    FA13A00_1.FA13A00_2.Down (One_Floor);  -- Reference private sibling of
-                                           -- the subunit parent's body.
- 
-    if Current_Floor /= Floor'pred (Penthouse) then 
-       TC_Operation := false;              -- Reference type declared in the
-    end if;                                -- parent of the subunit parent's
-                                           -- body.
- 
- end Check_System;
- 
-      --==================================================================--
- 
- -- Public child package of an elevator application.  This package provides
- -- an emergency operation.
- 
- package FA13A00_1.CA13A01_5 is            -- Emergency Operation
- 
-    -- Other type definitions in real application.
- 
-    procedure Emergency;
- 
- private
-    type Bell_Type is (Inactive, Active);
- 
- end FA13A00_1.CA13A01_5;
- 
-      --==================================================================--
- 
- -- Context clauses required for visibility needed by separate subunit.
- 
- with FA13A00_0;                           -- Building Manager
- 
- with FA13A00_1.FA13A00_3;                 -- Move Elevator
- 
- with FA13A00_1.CA13A01_4;                 -- Maintenance Operation (private)
- 
- use  FA13A00_0;
- 
- package body FA13A00_1.CA13A01_5 is              
- 
-    procedure Emergency is separate;
- 
- end FA13A00_1.CA13A01_5;
- 
-      --==================================================================--
- 
- separate (FA13A00_1.CA13A01_5)
- 
- -- Subunit Emergency declared in Maintenance Operation.
- 
- procedure Emergency is
-    Bell : Bell_Type;                      -- Reference type declared in the 
-                                           -- subunit parent's body.
- 
- begin
-    -- Calls maintenance operation.
- 
-    FA13A00_1.CA13A01_4.Check_System;      -- Reference private sibling of the
-                                           -- subunit parent 's body.
- 
-    -- Clear all calls to the elevator.
- 
-    Clear_Calls (Call_Waiting);            -- Reference subprogram declared
-                                           -- in the parent of the subunit
-                                           -- parent's body.
-    for I in Floor loop                    
-       if Call_Waiting (I) then            -- Reference private part of the
-         TC_Operation := false;            -- parent of the subunit parent's
-       end if;                             -- body.
-    end loop;
- 
-    -- Move elevator to the basement.
- 
-    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
-      (Basement, Call_Waiting);            -- subunit parent's body.
- 
-    if Current_Floor /= Basement then      -- Reference type declared in the
-       TC_Operation := false;              -- parent of the subunit parent's
-    end if;                                -- body.
- 
-    -- Shut off power.
- 
-    Power := Off;                          -- Reference package with'ed by
-                                           -- the subunit parent's body.
- 
-    -- Activate bell.
- 
-    Bell := Active;                        -- Reference type declared in the 
-                                           -- subunit parent's body. 
- 
- end Emergency;
- 
-      --==================================================================--
- 
- -- Public child subprogram of an elevator application.  This subprogram 
- -- provides an express operation.
- 
- procedure FA13A00_1.CA13A01_6;
- 
-      --==================================================================--
- 
- -- Context clauses required for visibility needed by separate subunit.
- 
- with FA13A00_0;                           -- Building Manager
- 
- with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
- 
- with FA13A00_1.FA13A00_3;                 -- Move Elevator
- 
- use  FA13A00_0;
- 
- procedure FA13A00_1.CA13A01_6 is          -- Express Operation
- 
-    -- Other type definitions in real application.
- 
-    procedure GoTo_Penthouse is separate;
- 
- begin
-    GoTo_Penthouse;
- 
- end FA13A00_1.CA13A01_6;
- 
-      --==================================================================--
- 
- separate (FA13A00_1.CA13A01_6)
- 
- -- Subunit GoTo_Penthouse declared in Express Operation.
- 
- procedure GoTo_Penthouse is
- begin
-    -- Go faster.
- 
-    Power := V240;                         -- Reference package with'ed by
-                                           -- the subunit parent's body. 
- 
-    -- Call elevator.
- 
-    Call (Penthouse, Call_Waiting);        -- Reference subprogram declared in
-                                           -- the parent of the subunit 
-                                           -- parent's body.
- 
-    if not Call_Waiting (Penthouse) then   -- Reference private part of the
-       TC_Operation := false;              -- parent of the subunit parent's
-    end if;                                -- body.
- 
-    -- Move elevator to Penthouse.
- 
-    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
-      (Penthouse, Call_Waiting);           -- subunit parent's body.
- 
-    if Current_Floor /= Penthouse then     -- Reference type declared in the
-       TC_Operation := false;              -- parent of the subunit parent's
-    end if;                                -- body.
- 
-    -- Return slowly
- 
-    while Current_Floor /= Floor1 loop     -- Reference type, subprogram 
-       FA13A00_1.FA13A00_2.Down (1);       -- declared in the parent of the
-                                           -- subunit parent's body.
-    end loop;
- 
-    if Current_Floor /= Floor1 then        -- Reference type declared in
-       TC_Operation := false;              -- the parent of the subunit
-    end if;                                -- parent's body.
- 
-    -- Back to normal.
-                                           
-    Power := V120;                         -- Reference package with'ed by
-                                           -- the subunit parent's body.
- 
- end GoTo_Penthouse;
- 
-      --==================================================================--
- 
- with FA13A00_1.CA13A01_5;                 -- Emergency Operation
-                                           -- implicitly with Basic Elevator
-                                           -- Operations
- 
- with FA13A00_1.CA13A01_6;                 -- Express Operation
- 
- with Report;
- 
- procedure CA13A01 is
- 
- begin
- 
-    Report.Test ("CA13A01", "Check that subunits declared in non-generic " &
-                 "child units of a public parent have the same visibility " &
-                 "into its parent, its parent's siblings, and packages on " &
-                 "which its parent depends");
- 
-    -- Go to Penthouse.
- 
-    FA13A00_1.CA13A01_6;
- 
-    -- Call emergency operation.
- 
-    FA13A00_1.CA13A01_5.Emergency;
- 
-    if not FA13A00_1.TC_Operation then
-       Report.Failed ("Incorrect elevator operation");
-    end if;
- 
-    Report.Result;
- 
- end CA13A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca13a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca13a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,301 ****
- -- CA13A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that subunits declared in generic child units of a public 
- --      parent have the same visibility into its parent, its siblings 
- --      (public and private), and packages on which its parent depends 
- --      as is available at the point of their declaration.
- --
- -- TEST DESCRIPTION:
- --      Declare an outside elevator button operation as a subunit in a 
- --      generic child package of the basic operation package (FA13A00.A).  
- --      This procedure has visibility into its parent ancestor and its 
- --      private sibling.
- --
- --      In the main program, instantiate the child package. Check that 
- --      subunits perform as expected.  
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FA13A00.A
- --         CA13A02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Public generic child package of an elevator application.  This package
- -- provides outside elevator button operations.
- 
- generic                           -- Instantiate once for each floor.
-    Our_Floor : in Floor;          -- Reference type declared in parent.
- 
- package FA13A00_1.CA13A02_4 is    -- Outside Elevator Button Operations
- 
-    type Light is (Up, Down, Express, Off);
- 
-    type Direction is (Up, Down, Express);
- 
-    function Call_Elevator (D : Direction) return Light;
- 
-    -- other type definitions and procedure declarations in real application.
- 
- end FA13A00_1.CA13A02_4;
- 
-      --==================================================================--
- 
- -- Context clauses required for visibility needed by separate subunit.
- 
- with FA13A00_0;                   -- Building Manager
- 
- with FA13A00_1.FA13A00_2;         -- Floor Calculation (private)
-                                          
- with FA13A00_1.FA13A00_3;         -- Move Elevator
- 
- use  FA13A00_0;                           
- 
- package body FA13A00_1.CA13A02_4 is              
- 
-    function Call_Elevator (D : Direction) return Light is separate;
- 
- end FA13A00_1.CA13A02_4;
- 
-      --==================================================================--
- 
- separate (FA13A00_1.CA13A02_4)
- 
- -- Subunit Call_Elevator declared in Outside Elevator Button Operations.
- 
- function Call_Elevator (D : Direction) return Light is
-    Elevator_Button : Light;
- 
- begin
-    -- See if power is on.
- 
-    if Power = Off then                       -- Reference package with'ed by
-       Elevator_Button := Off;                -- the subunit parent's body.
- 
-    else
-       case D is
-          when Express =>        
-             FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of
-               (Penthouse, Call_Waiting);      -- the subunit parent's body.
- 
-             Elevator_Button := Express;    
- 
-          when Up      =>        
-             if Current_Floor < Our_Floor then
-                FA13A00_1.FA13A00_2.Up         -- Reference private sibling of
-                  (Floor'pos (Our_Floor)       -- the subunit parent's body.
-                    - Floor'pos (Current_Floor));
-             else
-                FA13A00_1.FA13A00_2.Down       -- Reference private sibling of
-                  (Floor'pos (Current_Floor)   -- the subunit parent's body.
-                    - Floor'pos (Our_Floor));
-             end if;
- 
-             -- Call elevator.
- 
-             Call 
-               (Current_Floor, Call_Waiting);  -- Reference subprogram declared
-                                               -- in the parent of the subunit 
-                                               -- parent's body. 
-             Elevator_Button := Up;    
- 
-          when Down    =>        
-             if Current_Floor > Our_Floor then
-                FA13A00_1.FA13A00_2.Down       -- Reference private sibling of
-                  (Floor'pos (Current_Floor)   -- the subunit parent's body.
-                    - Floor'pos (Our_Floor));
-             else
-                FA13A00_1.FA13A00_2.Up         -- Reference private sibling of
-                  (Floor'pos (Our_Floor)       -- the subunit parent's body.
-                    - Floor'pos (Current_Floor));
-             end if;
- 
-             Elevator_Button := Down;    
- 
-             -- Call elevator.
- 
-             Call 
-               (Current_Floor, Call_Waiting);  -- Reference subprogram declared
-                                               -- in the parent of the subunit 
-                                               -- parent's body.
-       end case;
- 
-       if not Call_Waiting (Current_Floor)     -- Reference private part of the
-       then                                    -- parent of the subunit parent's
-                                               -- body.
-          TC_Operation := false;              
-       end if;
- 
-    end if;
- 
-    return Elevator_Button;
- 
- end Call_Elevator;
- 
-      --==================================================================--
- 
- with FA13A00_1.CA13A02_4;         -- Outside Elevator Button Operations
-                                   -- implicitly with Basic Elevator
-                                   -- Operations
- with Report;
- 
- procedure CA13A02 is
- 
- begin
- 
-    Report.Test ("CA13A02", "Check that subunits declared in generic child " &
-                 "units of a public parent have the same visibility into " & 
-                 "its parent, its parent's siblings, and packages on " &
-                 "which its parent depends");
- 
- -- Going from floor one to penthouse.
- 
-    Going_To_Penthouse:
-    declare
-       -- Declare instance of the child generic elevator package for penthouse.
-  
-       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
-         (FA13A00_1.Penthouse);
- 
-       use Call_Elevator_Pkg;
- 
-       Call_Button_Light : Light;
- 
-    begin
- 
-       Call_Button_Light := Call_Elevator (Express);
- 
-       if not FA13A00_1.TC_Operation or Call_Button_Light /= Express then
-          Report.Failed ("Incorrect elevator operation going to penthouse");
-       end if;
- 
-    end Going_To_Penthouse;
- 
- -- Going from penthouse to basement.
- 
-    Going_To_Basement:
-    declare
-       -- Declare instance of the child generic elevator package for basement.
-  
-       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
-         (FA13A00_1.Basement);
- 
-       use Call_Elevator_Pkg;
- 
-       Call_Button_Light : Light;
- 
-    begin
- 
-       Call_Button_Light := Call_Elevator (Down);
- 
-       if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
-          Report.Failed ("Incorrect elevator operation going to basement");
-       end if;
- 
-    end Going_To_Basement;
-   
- -- Going from basement to floor three.
- 
-    Going_To_Floor3:
-    declare
-       -- Declare instance of the child generic elevator package for floor 
-       -- three.
-  
-       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
-         (FA13A00_1.Floor3);
- 
-       use Call_Elevator_Pkg;
- 
-       Call_Button_Light : Light;
- 
-    begin
- 
-       Call_Button_Light := Call_Elevator (Up);
- 
-       if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
-          Report.Failed ("Incorrect elevator operation going to floor 3");
-       end if;
- 
-    end Going_To_Floor3;
-   
- -- Going from floor three to floor two.
- 
-    Going_To_Floor2:
-    declare
-       -- Declare instance of the child generic elevator package for floor two.
-  
-       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
-         (FA13A00_1.Floor2);
- 
-       use Call_Elevator_Pkg;
- 
-       Call_Button_Light : Light;
- 
-    begin
- 
-       Call_Button_Light := Call_Elevator (Up);
- 
-       if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
-          Report.Failed ("Incorrect elevator operation going to floor 2");
-       end if;
- 
-    end Going_To_Floor2;
-   
- -- Going to floor one.
- 
-    Going_To_Floor1:
-    declare
-       -- Declare instance of the child generic elevator package for floor one.
-  
-       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
-         (FA13A00_1.Floor1);
- 
-       use Call_Elevator_Pkg;
- 
-       Call_Button_Light : Light;
- 
-    begin
-       -- Calling elevator from floor one.
- 
-       FA13A00_1.Current_Floor := FA13A00_1.Floor1;
- 
-       Call_Button_Light := Call_Elevator (Down);
- 
-       if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
-          Report.Failed ("Incorrect elevator operation going to floor 1");
-       end if;
- 
-    end Going_To_Floor1;
- 
-    Report.Result;
- 
- end CA13A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140230.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140230.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140230.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140230.a	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- CA140230.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA140232.AM.
- --
- -- TEST DESCRIPTION:
- --      See CA140232.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> CA140230.A
- --         CA140231.A
- --         CA140232.AM
- --         CA140233.A
- --
- -- PASS/FAIL CRITERIA:
- --      See CA140232.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
- --     20 MAR 00   RLB         Removed special requirements, because there
- --                             aren't any.
- --
- --!
- 
- package CA14023_0 is
-      subtype Little_float is float digits 4 range 0.0..100.0;
-      type Data_rec is tagged record
-           Data : Little_float;
-      end record;
- end CA14023_0;
- 
- --------------------------------------------------------
- 
- generic
-      type Data_type is digits <>;
-      Floor : Data_type;
- function CA14023_1 (P1, P2 : Data_type) return Data_type;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140231.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140231.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140231.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140231.a	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- CA140231.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA140232.AM.
- --
- -- TEST DESCRIPTION:
- --      See CA140232.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA140230.A
- --      -> CA140231.A
- --         CA140232.AM
- --         CA140233.A
- --
- -- PASS/FAIL CRITERIA:
- --      See CA140232.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
- --     20 MAR 00   RLB         Removed special requirements, because there
- --                             aren't any.
- --
- --!
- 
- function CA14023_1 (P1, P2 : Data_type) return Data_type is
- begin
-      if Floor > P1 and Floor > P2 then
-           return Floor;
-      elsif P2 > P1 then
-           return P2;
-      else
-           return P1;
-      end if;
- end CA14023_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140232.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140232.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140232.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140232.am	Thu Jan  1 00:00:00 1970
***************
*** 1,139 ****
- -- CA140232.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic instantiation depends on
- --      a generic function that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic function, a generic
- --      instantiation of the generic function, and a main
- --      procedure that withs the instantiated generic
- --      function.  Then, a new version of the first generic
- --      function is compiled (in a separate file, simulating
- --      editing and modification to the unit).  The test should
- --      link the correct version of the withed function and
- --      report "PASSED" at execution time.
- --
- --      Note that compilers are required by the standard to support
- --      replacement of a generic body without recompilation of the
- --      instantation. The ARG confirmed 10.1.4(10) with AI-00077.
- --
- --      To build this test:
- --         1) Compile the file CA140230 (and include the results in the
- --            program library).
- --         2) Compile the file CA140231 (and include the results in the
- --            program library).
- --         3) Compile the file CA140232 (and include the results in the
- --            program library).
- --         4) Compile the file CA140233 (and include the results in the
- --            program library).
- --         5) Build and run an executable image.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA140230.A
- --         CA140231.A
- --      -> CA140232.AM
- --         CA140233.A
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008T baseline version
- --     29 JUN 95   SAIC        Initial version
- --     05 MAR 96   SAIC        First revision after review
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Moved CA14023_1 to a separate file.
- --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
- --     20 MAR 00   RLB         Removed special requirements, because there
- --                             aren't any.
- --
- --!
- 
- with CA14023_0;
- use CA14023_0;
- 
- generic
-      Min : Little_float := 0.0;
-      type Any_rec is new Data_rec with private;
- function CA14023_2 (R1, R2 : Any_rec) return Little_float;
- 
- --------------------------------------------------------
- 
- with CA14023_1;
- 
- function CA14023_2 (R1, R2 : Any_rec) return Little_float is
-      function Max_val is new CA14023_1 (Little_float, Min);
- begin
-      return max_val (R1.Data, R2.Data);
- end CA14023_2;
- 
- --------------------------------------------------------
- 
- package CA14023_0.CA14023_3 is
-      type New_data_rec is new Data_rec with record
-           Other_val : integer := 100;
-      end record;
- end CA14023_0.CA14023_3;
- 
- --------------------------------------------------------
- 
- with Report; use Report;
- with CA14023_2;
- with CA14023_0;
- with CA14023_0.CA14023_3;
- 
- procedure CA140232 is
- 
-      NDR1, NDR2 : CA14023_0.CA14023_3.New_data_rec;
-      Min_value : constant CA14023_0.Little_float := 0.0;
-      TC_result : CA14023_0.Little_float;
-      function Max_Data_Val is new CA14023_2 (Min_value,
-                     CA14023_0.CA14023_3.New_data_rec);
- begin
-      Test ("CA14023", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit.  " &
-                       "Check the case where a generic " &
-                       "instantiation depends on a generic " &
-                       "function that is changed");
- 
-      NDR1.Data := 2.0;
-      NDR2.Data := 5.0;
- 
-      TC_result := Max_Data_Val (NDR1, NDR2);
- 
-      if TC_result = 5.0 then
-           Failed ("Revised generic not used");
-      elsif TC_result /= 0.0 then               -- the minimum, floor
-           Failed ("Incorrect value returned"); -- value of 0.0 should
-      end if;                                   -- be returned rather
-                                                -- than the min of the
-                                                -- two actual parameters
- 
-      Result;
- end CA140232;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140233.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140233.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140233.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140233.a	Thu Jan  1 00:00:00 1970
***************
*** 1,68 ****
- -- CA140233.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA140232.AM.
- --
- -- TEST DESCRIPTION:
- --      See CA140232.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA140230.A
- --         CA140231.A
- --         CA140232.AM
- --      -> CA140233.A
- --
- -- PASS/FAIL CRITERIA:
- --      See CA140232.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008T baseline version
- --     29 JUN 95   SAIC        Initial version
- --     05 MAR 96   SAIC        First revision after review
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
- --     20 MAR 00   RLB         Removed special requirements, because there
- --                             aren't any.
- --!
- 
- -- here is the replacement body, correcting "errors" in
- -- the original
- 
- function CA14023_1 (P1, P2 : Data_type) return Data_type is
- begin
-      -- return min rather than max
-      if Floor < P1 and Floor < P2 then
-           return Floor;
-      elsif P2 < P1 then
-           return P2;
-      else
-           return P1;
-      end if;
- end CA14023_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140280.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140280.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140280.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140280.a	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CA140280.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     See CA140283.AM.
- --
- -- TEST DESCRIPTION
- --     See CA140283.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> CA140280.A
- --         CA140281.A
- --         CA140282.A
- --         CA140283.AM
- --
- -- CHANGE HISTORY:
- --     JBG 05/28/85  CREATED ORGINAL TEST.
- --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
- --                   NOT THE SAME.
- --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
- 
- GENERIC
-      C : INTEGER;
- PROCEDURE GENPROC_CA14028 (X : OUT INTEGER);
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE GENPROC_CA14028 (X : OUT INTEGER) IS
- BEGIN
-      X := IDENT_INT(C);
- END GENPROC_CA14028;
- 
- GENERIC
- FUNCTION GENFUNC_CA14028 RETURN INTEGER;
- 
- FUNCTION GENFUNC_CA14028 RETURN INTEGER IS
- BEGIN
-      RETURN 2;
- END GENFUNC_CA14028;
- 
- WITH GENPROC_CA14028;
- PRAGMA ELABORATE (GENPROC_CA14028);
- PROCEDURE CA14028_PROC1 IS NEW GENPROC_CA14028(1);
- 
- WITH GENFUNC_CA14028;
- PRAGMA ELABORATE (GENFUNC_CA14028);
- FUNCTION CA14028_FUNC2 IS NEW GENFUNC_CA14028;
- 
- WITH GENPROC_CA14028;
- PRAGMA ELABORATE (GENPROC_CA14028);
- PROCEDURE CA14028_PROC3 IS NEW GENPROC_CA14028(3);
- 
- WITH GENFUNC_CA14028;
- PRAGMA ELABORATE (GENFUNC_CA14028);
- FUNCTION CA14028_FUNC3 IS NEW GENFUNC_CA14028;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140281.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140281.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140281.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140281.a	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- CA140281.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     See CA140283.AM.
- --
- -- TEST DESCRIPTION
- --     See CA140283.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA140280.A
- --      -> CA140281.A
- --         CA140282.A
- --         CA140283.AM
- --
- -- CHANGE HISTORY:
- --     JBG 05/28/85  CREATED ORGINAL TEST.
- --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
- --                   NOT THE SAME.
- --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
- 
- PROCEDURE CA14028_PROC1 (X : OUT INTEGER) IS
- BEGIN
-      X := 3;
- END CA14028_PROC1;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION CA14028_FUNC2 RETURN INTEGER IS
- BEGIN
-      RETURN IDENT_INT(4);
- END CA14028_FUNC2;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE CA14028_PROC3 (X : OUT BOOLEAN; Y : OUT INTEGER) IS
- BEGIN
-      X := FALSE;
-      Y := IDENT_INT(6);
- END CA14028_PROC3;
- 
- FUNCTION CA14028_FUNC3 RETURN BOOLEAN IS
- BEGIN
-      RETURN FALSE;
- END CA14028_FUNC3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140282.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140282.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140282.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140282.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- CA140282.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     See CA140283.AM.
- --
- -- TEST DESCRIPTION
- --     See CA140283.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA140280.A
- --         CA140281.A
- --      -> CA140282.A
- --         CA140283.AM
- --
- -- CHANGE HISTORY:
- --     JBG 05/28/85  CREATED ORIGINAL TEST.
- --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
- --                   NOT THE SAME.
- --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
- 
- WITH GENPROC_CA14028;
- PRAGMA ELABORATE (GENPROC_CA14028);
- PROCEDURE CA14028_PROC5 IS NEW GENPROC_CA14028 (5);
- 
- WITH GENFUNC_CA14028;
- PRAGMA ELABORATE (GENFUNC_CA14028);
- FUNCTION CA14028_FUNC22 IS NEW GENFUNC_CA14028;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE CA14028_PROC3 (X : OUT INTEGER) IS
- BEGIN
-      X := IDENT_INT(4);
- END CA14028_PROC3;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- FUNCTION CA14028_FUNC3 RETURN INTEGER IS
- BEGIN
-      RETURN IDENT_INT(7);
- END CA14028_FUNC3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140283.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140283.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca140283.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca140283.am	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- CA140283.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     Check that when a subprogram body is compiled as a library unit
- --     it is not interpreted as a completion for any previous library
- --     subprogram created by generic instantiation, and it therefore
- --     declares a new library subprogram.
- --
- -- TEST DESCRIPTION
- --     A generic function and procedure plus their instantiations are
- --     created. Then, subprogram bodies which ought to replace the
- --     instantiations are compiled. Following that, additional instantiations
- --     are compiled. Finally the main subprogram is compiled.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA140280.A
- --         CA140281.A
- --         CA140282.A
- --      -> CA140283.AM
- --
- -- CHANGE HISTORY:
- --     JBG 05/28/85  CREATED ORIGINAL TEST.
- --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
- --                   NOT THE SAME.
- --     THS 09/24/90  REWORDED HEADER COMMENTS, ERROR MESSAGES, AND
- --                   CALL TO TEST. CALLED IDENT_INT CONSISTENTLY.
- --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
- 
- WITH REPORT; USE REPORT;
- WITH CA14028_PROC1, CA14028_FUNC2, CA14028_PROC5, CA14028_FUNC22,
-      CA14028_PROC3, CA14028_FUNC3;
- PROCEDURE CA140283 IS
-      TEMP : INTEGER := 0;
- BEGIN
-      TEST ("CA14028", "Check that library subprograms created by " &
-                       "generic instantiation are replaced " &
-                       "when new non-generic subprogram bodies are " &
-                       "compiled");
- 
-      CA14028_PROC1(TEMP);
-      IF TEMP /= IDENT_INT(3) THEN
-           FAILED ("CA14028_Proc1 instantiation not replaced");
-      END IF;
- 
-      IF CA14028_FUNC2 /= IDENT_INT(4) THEN
-           FAILED ("CA14028_Func2 instantiation not replaced");
-      END IF;
- 
-      CA14028_PROC5(TEMP);
-      IF TEMP /= IDENT_INT(5) THEN
-           FAILED ("New CA14028_Proc5 instantiation not correct");
-      END IF;
- 
-      IF CA14028_FUNC22 /= IDENT_INT(2) THEN
-           FAILED ("New CA14028_Func22 instantiation not correct");
-      END IF;
- 
-      CA14028_PROC3(TEMP);
-      IF TEMP /= IDENT_INT(4) THEN
-           FAILED ("CA14028_Proc3 not replaced by correct version");
-      END IF;
- 
-      IF CA14028_FUNC3 /= IDENT_INT(7) THEN
-           FAILED ("CA14028_Func3 not replaced by correct version");
-      END IF;
- 
-      RESULT;
- END CA140283;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca15003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca15003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca15003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca15003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,161 ****
- -- CA15003.A
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check the requirements of 10.1.5(4) and the modified 10.1.5(5)
- --     from Technical Corrigendum 1. (Originally discussed as AI95-00136.)
- --     Specifically:
- --     Check that program unit pragma for a generic package are accepted
- --     when given at the beginning of the package specification.
- --     Check that a program unit pragma can be given for a generic
- --     instantiation by placing the pragma immediately after the instantation.
- --
- -- TEST DESCRIPTION
- --     This test checks the cases that are *not* forbidden by the RM,
- --     and makes sure such legal cases actually work.
- --
- -- CHANGE HISTORY:
- --      29 JUN 1999   RAD   Initial Version
- --      08 JUL 1999   RLB   Cleaned up and added to test suite.
- --      27 AUG 1999   RLB   Repaired errors introduced by me.
- --
- --!
- 
- with System;
- package CA15003A is
-     pragma Pure;
- 
-     type Big_Int is range -System.Max_Int .. System.Max_Int;
-     type Big_Positive is new Big_Int range 1..Big_Int'Last;
- end CA15003A;
- 
- generic
-     type Int is new Big_Int;
- package CA15003A.Pure is
-     pragma Pure;
-     function F(X: access Int) return Int;
- end CA15003A.Pure;
- 
- with CA15003A.Pure;
- package CA15003A.Pure_Instance is new CA15003A.Pure(Int => Big_Positive);
-     pragma Pure(CA15003A.Pure_Instance);
- 
- package body CA15003A.Pure is
-     function F(X: access Int) return Int is
-     begin
-         X.all := X.all + 1;
-         return X.all;
-     end F;
- end CA15003A.Pure;
- 
- generic
- package CA15003A.Pure.Preelaborate is
-     pragma Preelaborate;
-     One: Int := 1;
-     function F(X: access Int) return Int;
- end CA15003A.Pure.Preelaborate;
- 
- package body CA15003A.Pure.Preelaborate is
-     function F(X: access Int) return Int is
-     begin
-         X.all := X.all + One;
-         return X.all;
-     end F;
- end CA15003A.Pure.Preelaborate;
- 
- with CA15003A.Pure_Instance;
- with CA15003A.Pure.Preelaborate;
- package CA15003A.Pure_Preelaborate_Instance is
-     new CA15003A.Pure_Instance.Preelaborate;
-         pragma Preelaborate(CA15003A.Pure_Preelaborate_Instance);
- 
- package CA15003A.Empty_Pure is
-     pragma Pure;
-     pragma Elaborate_Body;
- end CA15003A.Empty_Pure;
- 
- package body CA15003A.Empty_Pure is
- end CA15003A.Empty_Pure;
- 
- package CA15003A.Empty_Preelaborate is
-     pragma Preelaborate;
-     pragma Elaborate_Body;
-     One: Big_Int := 1;
- end CA15003A.Empty_Preelaborate;
- 
- package body CA15003A.Empty_Preelaborate is
-     function F(X: access Big_Int) return Big_Int is
-     begin
-         X.all := X.all + One;
-         return X.all;
-     end F;
- end CA15003A.Empty_Preelaborate;
- 
- package CA15003A.Empty_Elaborate_Body is
-     pragma Elaborate_Body;
-     Three: aliased Big_Positive := 1;
-     Two, Tres: Big_Positive'Base := 0;
- end CA15003A.Empty_Elaborate_Body;
- 
- with Report; use Report; pragma Elaborate_All(Report);
- with CA15003A.Pure_Instance;
- with CA15003A.Pure_Preelaborate_Instance;
- use CA15003A;
- package body CA15003A.Empty_Elaborate_Body is
- begin
-     if Two /= Big_Positive'Base(Ident_Int(0)) then
- 	Failed ("Two should be zero now");
-     end if;
-     if Tres /= Big_Positive'Base(Ident_Int(0)) then
- 	Failed ("Tres should be zero now");
-     end if;
-     if Two /= Tres then
- 	Failed ("Tres should be zero now");
-     end if;
-     Two := Pure_Instance.F(Three'Access);
-     Tres := Pure_Preelaborate_Instance.F(Three'Access);
-     if Two /= Big_Positive(Ident_Int(2)) then
- 	Failed ("Two should be 2 now");
-     end if;
-     if Tres /= Big_Positive(Ident_Int(3)) then
- 	Failed ("Tres should be 3 now");
-     end if;
- end CA15003A.Empty_Elaborate_Body;
- 
- with Report; use Report;
- with CA15003A.Empty_Pure;
- with CA15003A.Empty_Preelaborate;
- with CA15003A.Empty_Elaborate_Body; use CA15003A.Empty_Elaborate_Body;
- use type CA15003A.Big_Positive'Base;
- procedure CA15003 is
- begin
-     Test("CA15003", "Placement of Program Unit Pragmas in Generic Packages");
-     if Two /= 2 then
- 	Failed ("Two should be 2 now");
-     end if;
-     if Tres /= 3 then
- 	Failed ("Tres should be 3 now");
-     end if;
-     Result;
- end CA15003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca200020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca200020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca200020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca200020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- CA200020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a partition can be created even if the environment contains
- --      two units with the same name. (This is rule 10.2(19)).
- --
- -- TEST DESCRIPTION:
- --      Declare the a parent package (CA20002_0). Declare a child package
- --      (CA20002_0.CA20002_1). Declare a subunit in the parent package body
- --      (CA20002_1). Declare a main subprogram that does NOT include the
- --      child package. Insure that this partition can be created.
- --
- --      This test is intended to test the effects of program maintenance.
- --      After the programmer receives an error from creating a partition
- --      like that tested in test LA20001, the programmer may then repair
- --      the partition by eliminating the reference of the child unit. The
- --      partition should be able to be created.
- --
- --      To build this test:
- --         1) Compile the file CA200020 (and include the results in the
- --            program library).
- --         2) Compile the file CA200021 (and include the results in the
- --            program library).
- --         3) Compile the file CA200022 (and include the results in the
- --            program library).
- --         4) Build an executable image, and run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> CA200020.A
- --         CA200021.A
- --         CA200022.AM
- --
- -- CHANGE HISTORY:
- --      27 Jan 99   RLB     Initial test.
- --      20 Mar 00   RLB     Removed special requirements, because there
- --                          aren't any.
- --!
- 
- package CA20002_0 is
-    procedure Do_a_Little (A : out Integer);
- 
- end CA20002_0;
- 
- package CA20002_0.CA20002_1 is
-    My_Global : Integer;
- end CA20002_0.CA20002_1;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca200021.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca200021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca200021.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca200021.a	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CA200021.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA200020.A.
- --
- -- TEST DESCRIPTION:
- --      See CA200020.A.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA200020.A
- --      -> CA200021.A
- --         CA200022.AM
- --
- -- PASS/FAIL CRITERIA:
- --      See CA200020.A.
- --
- -- CHANGE HISTORY:
- --     27 JAN 99   RLB       Initial version.
- --     20 MAR 00   RLB       Removed special requirements, because there
- --                           aren't any.
- --
- --!
- 
- package body CA20002_0 is
- 
-    function CA20002_1 return Integer is separate; -- Has the same expanded name
-                                                   -- as the child.
-       -- Note: An implementation may produce a warning about the child
-       -- unit at this point, but it must accept the subunit declaration.
- 
-    procedure Do_a_Little (A : out Integer) is
-    begin
-       A := CA20002_1;
-    end Do_a_Little;
- 
- end CA20002_0;
- 
- with Report;
- separate (CA20002_0)
- function CA20002_1 return Integer is
- begin
-    return Report.Ident_Int(5);
- end CA20002_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca200022.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca200022.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca200022.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca200022.am	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- CA200022.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CA200020.A.
- --
- -- TEST DESCRIPTION:
- --      See CA200020.A.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         CA200020.A
- --         CA200021.A
- --      -> CA200022.AM
- --
- -- PASS/FAIL CRITERIA:
- --      See CA200020.A.
- --
- -- CHANGE HISTORY:
- --     25 JAN 99   RLB       Initial version.
- --     08 JUL 99   RLB       Repaired comments.
- --     20 MAR 00   RLB       Removed special requirements, because there
- --                           aren't any.
- --!
- 
- with Report;
- use Report;
- with CA20002_0; -- Child unit not included in the partition.
- procedure CA200022 is
-      Value : Integer := 0;
- begin
-      Test ("CA20002","Check that compiling multiple units with the same " &
-                      "name does not prevent the creation of a partition " &
-                      "using only one of the units.");
-      CA20002_0.Do_a_Little (Value);
-      if Report.Equal (Value, 5) then
-         null; -- OK.
-      else
-         Failed ("Wrong result from subunit");
-      end if;
- 
-      Result;
- end CA200022;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,40 ****
- -- CA2001H0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/25/81
- -- JBG 8/25/83
- 
- FUNCTION CA2001H0 RETURN INTEGER IS
- 
-      PACKAGE CA2001H1 IS
-           I : INTEGER := 0;
-      END CA2001H1;
- 
-      PACKAGE BODY CA2001H1 IS SEPARATE;
- 
- BEGIN
-      
-      RETURN CA2001H1.I;
- 
- END CA2001H0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,39 ****
- -- CA2001H1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/25/81
- -- JBG 8/25/83
- -- BHS 7/31/84
- 
- SEPARATE (CA2001H0)
- 
- PACKAGE BODY CA2001H1 IS
-      PROCEDURE NOT_USED IS SEPARATE;
- 
- BEGIN
- 
-      I := 1;
-      NOT_USED;
- 
- END CA2001H1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,38 ****
- -- CA2001H2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/25/81
- -- JBG 8/25/83
- 
- FUNCTION CA2001H0 RETURN INTEGER IS
- 
-      PACKAGE CA2001H1 IS
-           I : INTEGER := 2;
-      END CA2001H1;
- 
- BEGIN
- 
-      RETURN CA2001H1.I;
- 
- END CA2001H0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CA2001H3M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF A BODY_STUB IS DELETED FROM A COMPILATION UNIT,
- --   THE PREVIOUSLY EXISTING SUBUNIT CAN NO LONGER BE ACCESSED.
- 
- -- SEPARATE FILES ARE;
- --   CA2001H0  A LIBRARY FUNCTION (CA2001H0).
- --   CA2001H1  A SUBUNIT PACKAGE BODY.
- --   CA2001H2  A LIBRARY FUNCTION (CA2001H0).
- --   CA2001H3M THE MAIN PROCEDURE.
- 
- -- WKB 6/25/81
- -- JRK 6/26/81
- -- SPS 11/2/82
- -- JBG 8/25/83
- 
- 
- WITH REPORT, CA2001H0;
- USE REPORT;
- PROCEDURE CA2001H3M IS
- 
-      I : INTEGER := -1;
- 
- BEGIN
-      TEST ("CA2001H", "IF A BODY_STUB IS DELETED FROM A COMPILATION " &
-                       "UNIT, THE PREVIOUSLY EXISTING SUBUNIT CAN NO " &
-                       "LONGER BE ACCESSED");
- 
-      I := CA2001H0;
- 
-      IF I = 1 THEN
-           FAILED ("SUBUNIT ACCESSED");
-      END IF;
- 
-      IF I = 0 THEN
-           FAILED ("OLD LIBRARY UNIT ACCESSED");
-      END IF;
- 
-      IF I /= 2 THEN
-           FAILED ("NEW LIBRARY UNIT NOT ACCESSED");
-      END IF;
- 
-      RESULT;
- END CA2001H3M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,139 ****
- -- CA2002A0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SUBUNITS HAVING DIFFERENT ANCESTOR LIBRARY UNITS CAN HAVE
- -- THE SAME NAME.
- 
- -- SEPARATE FILES ARE:
- --     CA2002A0M  THE MAIN PROCEDURE, WITH SEPARATE LIBRARY 
- --                     PACKAGES (CA2002A1) AND (CA2002A2).
- --     CA2002A1   SUBUNIT BODIES FOR STUBS IN PACKAGE CA2002A1.
- --     CA2002A2   SUBUNIT BODIES FOR STUBS IN PACKAGE CA2002A2.
- 
- -- BHS 8/02/84
- 
- PACKAGE CA2002A1 IS
- 
-      PROCEDURE PROC (X : OUT INTEGER);
-      FUNCTION FUN RETURN BOOLEAN;
- 
-      PACKAGE PKG IS
-           I : INTEGER;
-           PROCEDURE PKG_PROC (XX : IN OUT INTEGER);
-      END PKG;
- 
- END CA2002A1;
- 
- PACKAGE BODY CA2002A1 IS
- 
-      PROCEDURE PROC (X : OUT INTEGER) IS SEPARATE;
-      FUNCTION FUN RETURN BOOLEAN IS SEPARATE;
-      PACKAGE BODY PKG IS SEPARATE;
- 
- END CA2002A1;
- 
- 
- PACKAGE CA2002A2 IS
- 
-      PROCEDURE PROC (Y : OUT INTEGER);
-      FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN;
- 
-      PACKAGE PKG IS
-           I : INTEGER;
-           PROCEDURE PKG_PROC (YY : IN OUT INTEGER);
-      END PKG;
- 
- END CA2002A2;
- 
- PACKAGE BODY CA2002A2 IS
- 
-      PROCEDURE PROC (Y : OUT INTEGER) IS SEPARATE;
-      FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN IS SEPARATE;
-      PACKAGE BODY PKG IS SEPARATE;
- 
- END CA2002A2;
- 
- WITH CA2002A1, CA2002A2;
- WITH REPORT; USE REPORT;
- PROCEDURE CA2002A0M IS
- BEGIN
- 
-      TEST ("CA2002A", "SUBUNITS WITH DIFFERENT ANCESTORS " &
-                       "CAN HAVE THE SAME NAME");
- 
-      DECLARE
-           VAR1 : INTEGER;
-           USE CA2002A1;
-      BEGIN
- 
-           PROC (VAR1);
-           IF VAR1 /= 1 THEN 
-                FAILED ("CA2002A1 PROCEDURE NOT INVOKED CORRECTLY");
-           END IF;
- 
-           IF NOT FUN THEN
-                FAILED ("CA2002A1 FUNCTION NOT INVOKED CORRECTLY");
-           END IF;
- 
-           IF PKG.I /= 1 THEN
-                FAILED ("CA2202A1 PKG VARIABLE NOT ACCESSED CORRECTLY");
-           END IF;
- 
-           VAR1 := 5;
-           PKG.PKG_PROC (VAR1);
-           IF VAR1 /= 4 THEN
-                FAILED ("CA2002A1 PKG SUBUNIT NOT INVOKED CORRECTLY");
-           END IF;
- 
-      END;
- 
-      DECLARE
-           VAR2 : INTEGER;
-           USE CA2002A2;
-      BEGIN
- 
-           PROC (VAR2);
-           IF VAR2 /= 2 THEN
-                FAILED ("CA2002A2 PROCEDURE NOT INVOKED CORRECTLY");
-           END IF;
- 
-           IF FUN THEN
-                FAILED ("CA2002A2 FUNCTION NOT INVOKED CORRECTLY");
-           END IF;
- 
-           IF PKG.I /= 2 THEN
-                FAILED ("CA2002A2 PKG VARIABLE NOT ACCESSED CORRECTLY");
-           END IF;
- 
-           VAR2 := 3;
-           PKG.PKG_PROC (VAR2);
-           IF VAR2 /= 4 THEN
-                FAILED ("CA2002A2 PKG SUBUNIT NOT INVOKED CORRECTLY");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END CA2002A0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- CA2002A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SUBUNIT BODIES FOR STUBS GIVEN IN PACKAGE CA2002A1 IN FILE
- -- CA2002A0M. 
- 
- -- BHS 8/02/84
- 
- SEPARATE (CA2002A1)
- PROCEDURE PROC (X : OUT INTEGER) IS
- BEGIN
-      X := 1;
- END PROC;
- 
- SEPARATE (CA2002A1)
- FUNCTION FUN RETURN BOOLEAN IS
- BEGIN
-      RETURN TRUE;
- END FUN;
- 
- SEPARATE (CA2002A1)
- PACKAGE BODY PKG IS
-      PROCEDURE PKG_PROC (XX : IN OUT INTEGER) IS SEPARATE;
- BEGIN
-      I := 1;
- END PKG;
- 
- SEPARATE (CA2002A1.PKG)
- PROCEDURE PKG_PROC (XX : IN OUT INTEGER) IS
- BEGIN
-      XX := XX - 1;
- END PKG_PROC;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- CA2002A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SUBUNIT BODIES FOR STUBS GIVEN IN PACKAGE CA2002A2 IN FILE
- -- CA2002A0M. 
- 
- -- BHS 8/02/84
- 
- SEPARATE (CA2002A2)
- PROCEDURE PROC (Y : OUT INTEGER) IS
- BEGIN
-      Y := 2;
- END PROC;
- 
- SEPARATE (CA2002A2)
- FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN IS
- BEGIN
-      RETURN Z /= 3;
- END FUN;
- 
- SEPARATE (CA2002A2)
- PACKAGE BODY PKG IS
-      PROCEDURE PKG_PROC (YY : IN OUT INTEGER) IS SEPARATE;
- BEGIN
-      I := 2;
- END PKG;
- 
- SEPARATE (CA2002A2.PKG)
- PROCEDURE PKG_PROC (YY : IN OUT INTEGER) IS
- BEGIN
-      YY := YY + 1;
- END PKG_PROC;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- CA2003A0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SUBUNIT HAS VISIBILITY OF IDENTIFIERS DECLARED
- --   PRIOR TO ITS BODY_STUB.
- 
- -- SEPARATE FILES ARE:
- --   CA2003A0M THE MAIN PROCEDURE.
- --   CA2003A1  A SUBUNIT PROCEDURE BODY.
- 
- -- WKB 6/26/81
- -- JRK 6/26/81
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2003A0M IS
- 
-      I : INTEGER := 1;
- 
-      PROCEDURE CA2003A1 IS SEPARATE;
- 
-      PACKAGE P IS
-           I : INTEGER := 2;
-      END P;
- 
- BEGIN
-      TEST ("CA2003A", "A SUBUNIT HAS VISIBILITY OF IDENTIFIERS " &
-                       "DECLARED BEFORE ITS BODY_STUB");
- 
- 
-      CA2003A1;
- 
-      RESULT;
- END CA2003A0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,35 ****
- -- CA2003A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/26/81
- 
- SEPARATE (CA2003A0M)
- PROCEDURE CA2003A1 IS
- BEGIN
- 
-      IF I /= 1 THEN
-           FAILED ("IDENTIFIER IN PARENT NOT VISIBLE");
-      END IF;
- 
- END CA2003A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- CA2004A0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A SUBUNIT HAS VISIBILITY OF IDENTIFIERS DECLARED
- --   IN ANCESTORS OTHER THAN THE PARENT.
- 
- -- SEPARATE FILES ARE:
- --   CA2004A0M THE MAIN PROCEDURE.
- --   CA2004A1  A SUBUNIT PACKAGE BODY.
- --   CA2004A2  A SUBUNIT PROCEDURE BODY.
- --   CA2004A3  A SUBUNIT PROCEDURE BODY.
- --   CA2004A4  A SUBUNIT PROCEDURE BODY.
- 
- -- WKB 6/26/81
- -- JRK 6/26/81
- -- BHS 7/31/84
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2004A0M IS
- 
-      I : INTEGER := 1;
- 
-      PACKAGE CA2004A1 IS
-           J : INTEGER := 2;
-           PROCEDURE CA2004A2;
-      END CA2004A1;
- 
-      USE CA2004A1;
-      PACKAGE BODY CA2004A1 IS SEPARATE;
-      PROCEDURE CA2004A3 IS SEPARATE;
- 
- BEGIN
-      TEST ("CA2004A", "CHECK THAT A SUBUNIT HAS VISIBILITY OF " &
-                       "IDENTIFIERS DECLARED IN ANCESTORS");
- 
- 
-      CA2004A1.
-      CA2004A2;
- 
-      CA2004A3;
- 
-      RESULT;
- END CA2004A0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA2004A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/26/81
- 
- SEPARATE (CA2004A0M)
- PACKAGE BODY CA2004A1 IS
- 
-      K : INTEGER := 3;
- 
-      PROCEDURE CA2004A2 IS SEPARATE;
- 
- END CA2004A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,43 ****
- -- CA2004A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/26/81
- 
- SEPARATE (CA2004A0M.CA2004A1)
- PROCEDURE CA2004A2 IS
- BEGIN
- 
-      IF I /= 1 THEN
-           FAILED ("IDENTIFIER NOT VISIBLE - 1");
-      END IF;
- 
-      IF J /= 2 THEN
-           FAILED ("IDENTIFIER NOT VISIBLE - 2");
-      END IF;
- 
-      IF K /= 3 THEN
-           FAILED ("IDENTIFIER NOT VISIBLE - 3");
-      END IF;
- 
- END CA2004A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,39 ****
- -- CA2004A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/31/84
- 
- SEPARATE (CA2004A0M)
- PROCEDURE CA2004A3 IS
- 
-      PROCEDURE CA2004A4 IS SEPARATE;
- 
- BEGIN
- 
-      IF I /= IDENT_INT(1) OR
-         J /= IDENT_INT(2) THEN
-           FAILED ("IDENTIFIER NOT VISIBLE - 4");
-      END IF;
- 
- END CA2004A3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- CA2004A4.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 7/31/84
- 
- SEPARATE (CA2004A0M.CA2004A3)
- PROCEDURE CA2004A4 IS
- BEGIN
- 
-      IF I /= IDENT_INT(1) OR
-         J /= IDENT_INT(2) THEN
-           FAILED ("IDENTIFIER NOT VISIBLE - 5");
-      END IF;
- 
- END CA2004A4;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CA2007A0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SUBUNIT PACKAGES ARE ELABORATED IN THE ORDER IN
- --   WHICH THEIR BODY STUBS APPEAR, NOT (NECESSARILY) IN THE
- --   ORDER IN WHICH THEY ARE COMPILED.
- 
- -- SEPARATE FILES ARE:
- --   CA2007A0M THE MAIN PROCEDURE.
- --   CA2007A1  A SUBUNIT PACKAGE BODY.
- --   CA2007A2  A SUBUNIT PACKAGE BODY.
- --   CA2007A3  A SUBUNIT PACKAGE BODY.
- 
- -- WKB 7/1/81
- -- JRK 7/1/81
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2007A0M IS
- 
-      ELAB_ORDER : STRING (1..3) := "   ";
-      NEXT : NATURAL := 1;
- 
-      PACKAGE CALL_TEST IS 
-      END CALL_TEST;
- 
-      PACKAGE BODY CALL_TEST IS
-      BEGIN
-           TEST ("CA2007A", "CHECK THAT SUBUNIT PACKAGES ARE " &
-                            "ELABORATED IN THE ORDER IN WHICH THEIR " &
-                            "BODY STUBS APPEAR");
-      END CALL_TEST;
- 
-      PACKAGE CA2007A3 IS
-      END CA2007A3;
- 
-      PACKAGE BODY CA2007A3 IS SEPARATE;
- 
-      PACKAGE CA2007A2 IS
-      END CA2007A2;
- 
-      PACKAGE BODY CA2007A2 IS SEPARATE;
- 
-      PACKAGE CA2007A1 IS
-      END CA2007A1;
- 
-      PACKAGE BODY CA2007A1 IS SEPARATE;
- 
- BEGIN
- 
-      IF ELAB_ORDER /= "321" THEN
-           FAILED ("INCORRECT ELABORATION ORDER");
-      END IF;
- 
-      RESULT;
- END CA2007A0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- CA2007A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/1/81
- 
- SEPARATE (CA2007A0M)
- 
- PACKAGE BODY CA2007A1 IS
- 
- BEGIN 
- 
-      ELAB_ORDER (NEXT) := '1';
-      NEXT := NEXT + 1;
- 
- END CA2007A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- CA2007A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/1/81
- 
- SEPARATE (CA2007A0M)
- 
- PACKAGE BODY CA2007A2 IS
- 
- BEGIN
- 
-      ELAB_ORDER (NEXT) := '2';
-      NEXT := NEXT + 1;
- 
- END CA2007A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,36 ****
- -- CA2007A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/1/81
- 
- SEPARATE (CA2007A0M)
- 
- PACKAGE BODY CA2007A3 IS
- 
- BEGIN
- 
-      ELAB_ORDER (NEXT) := '3';
-      NEXT := NEXT + 1;
- 
- END CA2007A3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- CA2008A0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT FOR AN OVERLOADED SUBPROGRAM, ONE OF THE
- --   SUBPROGRAM BODIES CAN BE SPECIFIED WITH A BODY_STUB AND
- --   COMPILED SEPARATELY.
- 
- -- SEPARATE FILES ARE:
- --   CA2008A0M THE MAIN PROCEDURE.
- --   CA2008A1  A SUBUNIT PROCEDURE BODY.
- --   CA2008A2  A SUBUNIT FUNCTION BODY.
- 
- -- WKB 6/26/81
- -- SPS 11/2/82
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2008A0M IS
- 
-      I : INTEGER := 0;
-      B : BOOLEAN := TRUE;
- 
-      PROCEDURE CA2008A1 (I : IN OUT INTEGER) IS
-      BEGIN
-           I := IDENT_INT (1);
-      END CA2008A1;
- 
-      PROCEDURE CA2008A1 (B : IN OUT BOOLEAN) IS SEPARATE;
- 
-      FUNCTION CA2008A2 RETURN INTEGER IS SEPARATE;
- 
-      FUNCTION CA2008A2 RETURN BOOLEAN IS
-      BEGIN
-           RETURN IDENT_BOOL (FALSE);
-      END CA2008A2;
- 
- BEGIN
-      TEST ("CA2008A", "CHECK THAT AN OVERLOADED SUBPROGRAM " &
-                       "CAN HAVE ONE OF ITS BODIES COMPILED SEPARATELY");
- 
-      CA2008A1 (I);
-      IF I /= 1 THEN
-           FAILED ("OVERLOADED PROCEDURE NOT INVOKED - 1");
-      END IF;
- 
-      CA2008A1 (B);
-      IF B THEN
-           FAILED ("OVERLOADED PROCEDURE NOT INVOKED - 2");
-      END IF;
- 
-      IF CA2008A2 /= 2 THEN
-           FAILED ("OVERLOADED FUNCTION NOT INVOKED - 1");
-      END IF;
- 
-      IF CA2008A2 THEN
-           FAILED ("OVERLOADED FUNCTION NOT INVOKED - 2");
-      END IF;
- 
-      RESULT;
- END CA2008A0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,35 ****
- -- CA2008A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/26/81
- 
- SEPARATE (CA2008A0M)
- 
- PROCEDURE CA2008A1 (B : IN OUT BOOLEAN) IS
- 
- BEGIN
- 
-      B := FALSE;
- 
- END CA2008A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,35 ****
- -- CA2008A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 6/26/81
- 
- SEPARATE (CA2008A0M)
- 
- FUNCTION CA2008A2 RETURN INTEGER IS
- 
- BEGIN
- 
-      RETURN 2;
- 
- END CA2008A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CA2009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A GENERIC PACKAGE SUBUNIT CAN BE SPECIFIED AND
- -- INSTANTIATED.
- 
- -- BHS 8/01/84
- -- JRK 5/24/85  CHANGED TO .ADA, SEE AI-00323.
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2009A IS
- 
-      INT1 : INTEGER := 1;
- 
-      SUBTYPE STR15 IS STRING (1..15);
-      SVAR : STR15 := "ABCDEFGHIJKLMNO";
- 
-      GENERIC 
-           TYPE ITEM IS PRIVATE;
-           CON1 : IN ITEM;
-           VAR1 : IN OUT ITEM;
-      PACKAGE PKG1 IS 
-      END PKG1;
- 
-      PACKAGE BODY PKG1 IS SEPARATE;
-      
-      PACKAGE NI_PKG1 IS NEW PKG1 (INTEGER, IDENT_INT(2), INT1);
-      PACKAGE NS_PKG1 IS NEW PKG1 (STR15, IDENT_STR("REINSTANTIATION"),
-                                   SVAR);
- 
- BEGIN
- 
-      TEST ("CA2009A", "SPECIFICATION AND INSTANTIATION " &
-                       "OF GENERIC PACKAGE SUBUNITS");
- 
-      IF INT1 /= 2 THEN
-           FAILED ("INCORRECT INSTANTIATION - INTEGER");
-      END IF;
- 
-      IF SVAR /= "REINSTANTIATION" THEN
-           FAILED ("INCORRECT INSTANTIATION - STRING");
-      END IF;
- 
- 
-      RESULT;
- 
- END CA2009A;
- 
- 
- SEPARATE (CA2009A)
- PACKAGE BODY PKG1 IS
- BEGIN
-      VAR1 := CON1;
- END PKG1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CA2009C0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A GENERIC PACKAGE SUBUNIT CAN BE SPECIFIED AND
- --     INSTANTIATED.  IN THIS TEST, THE SUBUNIT BODY IS IN A
- --     SEPARATE FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
- 
- -- SEPARATE FILES ARE:
- --     CA2009C0M  THE MAIN PROCEDURE.
- --     CA2009C1   A SUBUNIT PACKAGE BODY (PKG1).
- 
- -- HISTORY:
- --     BHS 08/01/84  CREATED ORIGINAL TEST.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- --     RLB 09/15/99  REMOVED JUNK COMMENT.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2009C0M IS
- 
-      INT1 : INTEGER := 1;
- 
-      SUBTYPE STR15 IS STRING (1..15);
-      SVAR : STR15 := "ABCDEFGHIJKLMNO";
- 
-      GENERIC
-           TYPE ITEM IS PRIVATE;
-           CON1 : IN ITEM;
-           VAR1 : IN OUT ITEM;
-      PACKAGE PKG1 IS
-      END PKG1;
- 
-      PACKAGE BODY PKG1 IS SEPARATE;
- 
-      PACKAGE NI_PKG1 IS NEW PKG1 (INTEGER, IDENT_INT(2), INT1);
-      PACKAGE NS_PKG1 IS NEW PKG1 (STR15, IDENT_STR("REINSTANTIATION"),
-                                   SVAR);
- 
- BEGIN
- 
-      TEST ("CA2009C", "SPECIFICATION AND INSTANTIATION " &
-                       "OF GENERIC PACKAGE SUBUNITS " &
-                       " -  SEPARATE FILES USED");
- 
-      IF INT1 /= 2 THEN
-           FAILED ("INCORRECT INSTANTIATION - INTEGER");
-      END IF;
- 
-      IF SVAR /= "REINSTANTIATION" THEN
-           FAILED ("INCORRECT INSTANTIATION - STRING");
-      END IF;
- 
- 
-      RESULT;
- 
- END CA2009C0M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,43 ****
- -- CA2009C1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- A GENERIC PACKAGE BODY.
- -- THE DECLARATION AND AN INSTANTIATION ARE IN CA2009C0M.DEP.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     BHS 08/09/84  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED COMMENTS TO RELATE TO OTHER TEST FILES
- --                   AND TO DESCRIBE EXPECTED COMPILER ACTION.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- SEPARATE (CA2009C0M)
- PACKAGE BODY PKG1 IS
- BEGIN
-      VAR1 := CON1;
- END PKG1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- CA2009D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A GENERIC SUBPROGRAM SUBUNIT CAN BE SPECIFIED AND
- -- INSTANTIATED.
- 
- -- BHS 8/01/84
- -- JRK 5/24/85  CHANGED TO .ADA, SEE AI-00323.
- 
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2009D IS
- 
-      INT1 : INTEGER := 1;
-      INT2 : INTEGER := 2;
- 
- 
-      GENERIC
-           TYPE ELEM IS PRIVATE;
-           PCON1 : IN ELEM;
-           PVAR1 : IN OUT ELEM;
-      PROCEDURE PROC1;
- 
- 
-      GENERIC
-           TYPE OBJ IS PRIVATE;
-           FCON1 : IN OBJ;
-           FVAR1 : IN OUT OBJ;
-      FUNCTION FUNC1 RETURN OBJ;
- 
- 
-      PROCEDURE PROC1 IS SEPARATE;
-      FUNCTION FUNC1 RETURN OBJ IS SEPARATE;
- 
- 
-      PROCEDURE NI_PROC1 IS NEW PROC1 (INTEGER, 2, INT1);
-      FUNCTION NI_FUNC1 IS NEW FUNC1 (INTEGER, 3, INT2);
- 
- 
- BEGIN
- 
-      TEST ("CA2009D", "SPECIFICATION AND INSTANTIATION " &
-                       "OF GENERIC SUBPROGRAM SUBUNITS");
- 
-      NI_PROC1;
-      IF INT1 /= 2 THEN
-           FAILED ("INCORRECT INSTANTIATION - NI_PROC1");
-      END IF;
- 
- 
-      IF NI_FUNC1 /= 3 THEN
-           FAILED ("INCORRECT INSTANTIATION - NI_FUNC1");
-      END IF;
- 
- 
-      RESULT;
- 
- END CA2009D;
- 
- 
- SEPARATE (CA2009D)
- PROCEDURE PROC1 IS
- BEGIN
-      PVAR1 := PCON1;
- END PROC1;
- 
- 
- SEPARATE (CA2009D)
- FUNCTION FUNC1 RETURN OBJ IS
- BEGIN
-      FVAR1 := FCON1;
-      RETURN FVAR1;
- END FUNC1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- CA2009F0M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A GENERIC SUBPROGRAM SUBUNIT CAN BE SPECIFIED AND
- --     INSTANTIATED.  IN THIS TEST, SOME SUBUNIT BODIES ARE
- --     IN SEPARATE FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
- 
- -- SEPARATE FILES ARE:
- --     CA2009F0M  THE MAIN PROCEDURE, WITH SUBUNIT BODIES FOR
- --                     PROC2 AND FUNC2.
- --     CA2009F1   A SUBUNIT PROCEDURE BODY (PROC1).
- --     CA2009F2   A SUBUNIT FUNCTION BODY  (FUNC1).
- 
- -- HISTORY:
- --     BHS 08/01/84  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  ADDED "SOME" TO FIRST COMMENT.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- --     RLB 09/15/99  REMOVED JUNK COMMENT.
- 
- WITH REPORT;
- USE REPORT;
- PROCEDURE CA2009F0M IS
- 
-      INT1 : INTEGER := 1;
-      INT2 : INTEGER := 2;
-      INT3 : INTEGER := 3;
-      INT4 : INTEGER := 4;
- 
- 
-      GENERIC
-           TYPE ELEM IS PRIVATE;
-           PCON1 : IN ELEM;
-           PVAR1 : IN OUT ELEM;
-      PROCEDURE PROC1;
- 
-      GENERIC
-           TYPE ELEM IS PRIVATE;
-           PCON2 : IN ELEM;
-           PVAR2 : IN OUT ELEM;
-      PROCEDURE PROC2;
- 
-      GENERIC
-           TYPE OBJ IS PRIVATE;
-           FCON1 : IN OBJ;
-           FVAR1 : IN OUT OBJ;
-      FUNCTION FUNC1 RETURN OBJ;
- 
-      GENERIC
-           TYPE OBJ IS PRIVATE;
-           FCON2 : IN OBJ;
-           FVAR2 : IN OUT OBJ;
-      FUNCTION FUNC2 RETURN OBJ;
- 
- 
-      PROCEDURE PROC1 IS SEPARATE;
-      PROCEDURE PROC2 IS SEPARATE;
-      FUNCTION FUNC1 RETURN OBJ IS SEPARATE;
-      FUNCTION FUNC2 RETURN OBJ IS SEPARATE;
- 
- 
-      PROCEDURE NI_PROC1 IS NEW PROC1 (INTEGER, 2, INT1);
-      PROCEDURE NI_PROC2 IS NEW PROC2 (INTEGER, 3, INT2);
-      FUNCTION NI_FUNC1 IS NEW FUNC1 (INTEGER, 4, INT3);
-      FUNCTION NI_FUNC2 IS NEW FUNC2 (INTEGER, 5, INT4);
- 
- 
- BEGIN
- 
-      TEST ("CA2009F", "SPECIFICATION AND INSTANTIATION " &
-                       "OF GENERIC SUBPROGRAM SUBUNITS");
- 
-      NI_PROC1;
-      IF INT1 /= 2 THEN
-           FAILED ("INCORRECT INSTANTIATION - NI_PROC1");
-      END IF;
- 
-      NI_PROC2;
-      IF INT2 /= 3 THEN
-           FAILED ("INCORRECT INSTANTIATION - NI_PROC2");
-      END IF;
- 
-      IF NI_FUNC1 /= 4 THEN
-           FAILED ("INCORRECT INSTANTIATION - NI_FUNC1");
-      END IF;
- 
-      IF NI_FUNC2 /= 5 THEN
-           FAILED ("INCORRECT INSTANTIATION - NI_FUNC2");
-      END IF;
- 
- 
-      RESULT;
- 
- END CA2009F0M;
- 
- 
- SEPARATE (CA2009F0M)
- PROCEDURE PROC2 IS
- BEGIN
-      PVAR2 := PCON2;
- END PROC2;
- 
- SEPARATE (CA2009F0M)
- FUNCTION FUNC2 RETURN OBJ IS
- BEGIN
-      FVAR2 := FCON2;
-      RETURN FVAR2;
- END FUNC2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,43 ****
- -- CA2009F1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATE GENERIC PROCEDURE BODY.
- -- SPECIFICATION, BODY STUB, AND INSTANTIATION ARE IN A2009F0M.DEP.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     BHS 08/01/84  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  MODIFIED COMMENTS TO SHOW RELATION TO OTHER FILES
- --                   AND TO CLARIFY NON-APPLICABILITY.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- SEPARATE (CA2009F0M)
- PROCEDURE PROC1 IS
- BEGIN
-      PVAR1 := PCON1;
- END PROC1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,45 ****
- -- CA2009F2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- SEPARATE GENERIC FUNCTION BODY.
- -- SPECIFICATION, BODY STUB, AND AN INSTANTIATION ARE
- -- IN CA2009F0M.DEP.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     BHS 08/01/84  CREATED ORIGINAL TEST.
- --     PWB 02/19/86  MODIFIED COMMENTS TO DESCRIBE RELATION TO OTHER
- --                   FILES AND POSSIBLE NON-APPLICABILITY.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- SEPARATE (CA2009F0M)
- FUNCTION FUNC1 RETURN OBJ IS
- BEGIN
-      FVAR1 := FCON1;
-      RETURN FVAR1;
- END FUNC1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- CA2011B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR A SUBPROGRAM DECLARATION-STUB-BODY TRIPLE, THE
- --     DECLARATION-STUB AND STUB-BODY SPECIFICATIONS CAN CONFORM, BUT
- --     THE DECLARATION-BODY SPECIFICATIONS NEED NOT.
- 
- -- HISTORY:
- --     JET 08/01/88  CREATED ORIGINAL TEST.
- 
- PACKAGE CA2011B0 IS
-      SUBTYPE T IS INTEGER RANGE -100 .. 100;
-      I : T := 0;
- END CA2011B0;
- 
- WITH CA2011B0; USE CA2011B0;
- PACKAGE CA2011B1 IS
-      PROCEDURE P1 (X : CA2011B0.T);
-      PROCEDURE P2 (X : T);
- END CA2011B1;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY CA2011B1 IS
-      PACKAGE CA2011BX RENAMES CA2011B0;
-      PROCEDURE P1 (X : T) IS SEPARATE;
-      PROCEDURE P2 (X : CA2011BX.T) IS SEPARATE;
- END CA2011B1;
- 
- SEPARATE (CA2011B1)
- PROCEDURE P1 (X : CA2011BX.T) IS
- BEGIN
-      I := IDENT_INT(X);
- END P1;
- 
- SEPARATE (CA2011B1)
- PROCEDURE P2 (X : CA2011BX.T) IS
- BEGIN
-      I := IDENT_INT(X);
- END P2;
- 
- WITH REPORT; USE REPORT;
- WITH CA2011B0, CA2011B1;
- PROCEDURE CA2011B IS
- 
-      PACKAGE P1 IS
-           SUBTYPE T IS INTEGER RANGE -100 .. 100;
-      END P1;
-      USE P1;
- 
-      FUNCTION F1 RETURN P1.T;
-      FUNCTION F2 RETURN T;
- 
-      PACKAGE P2 RENAMES P1;
- 
-      FUNCTION F1 RETURN T IS SEPARATE;
-      FUNCTION F2 RETURN P2.T IS SEPARATE;
- 
- BEGIN
-      TEST ("CA2011B", "CHECK THAT FOR A SUBPROGRAM DECLARATION-STUB-" &
-                       "BODY TRIPLE, THE DECLARATION-STUB AND STUB-" &
-                       "BODY SPECIFICATIONS CAN CONFORM, BUT THE " &
-                       "DECLARATON-BODY SPECIFICATIONS NEED NOT");
- 
-      IF F1 /= IDENT_INT(100) THEN
-           FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 1");
-      END IF;
- 
-      IF F2 /= IDENT_INT(-100) THEN
-           FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 2");
-      END IF;
- 
-      CA2011B1.P1(3);
-      IF CA2011B0.I /= IDENT_INT(3) THEN
-           FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 1");
-      END IF;
- 
-      CA2011B1.P2(4);
-      IF CA2011B0.I /= IDENT_INT(4) THEN
-           FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 2");
-      END IF;
- 
-      RESULT;
- END CA2011B;
- 
- SEPARATE (CA2011B)
- FUNCTION F1 RETURN P2.T IS
- BEGIN
-      RETURN 100;
- END F1;
- 
- SEPARATE (CA2011B)
- FUNCTION F2 RETURN P2.T IS
- BEGIN
-      RETURN -100;
- END F2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca21001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca21001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca21001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca21001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- CA21001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
- --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
- --     software and documentation contained herein.  Unlimited rights are
- --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
- --     the Government intends to confer upon all recipients unlimited rights
- --     equal to those held by the Government.  These rights include rights to
- --     use, duplicate, release or disclose the released technical data and
- --     computer software in whole or in part, in any manner and for any purpose
- --     whatsoever, and to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check the requirements of the revised 10.2.1(11) from Technical
- --     Corrigendum 1 (originally discussed as AI95-00002).
- --     A package subunit whose parent is a preelaborated subprogram need
- --     not be preelaborable.
- --
- -- TEST DESCRIPTION
- --     We create several preelaborated library procedures with
- --     non-preelaborable package body subunits.  We try various levels
- --     of nesting of package and procedure subunits.
- --
- -- CHANGE HISTORY:
- --      29 JUN 1999   RAD   Initial Version
- --      23 SEP 1999   RLB   Improved comments, renamed, issued.
- --
- --!
- 
- procedure CA21001_1(X: out Integer);
-     pragma Preelaborate(CA21001_1);
- 
- procedure CA21001_1(X: out Integer) is
-     function F return Integer is separate;
- 
-     package Sub is
-         function G(X: Integer) return Integer;
-             -- Returns X + 1.
-         Not_Preelaborable: Integer := F; -- OK, by AI-2.
-     end Sub;
- 
-     package body Sub is separate;
- 
- begin
-     X := -1;
-     X := F;
-     X := Sub.G(X);
- end CA21001_1;
- 
- separate(CA21001_1)
- package body Sub is
-     package Sub_Sub is
-         -- Empty.
-     end Sub_Sub;
-     package body Sub_Sub is separate;
- 
-     function G(X: Integer) return Integer is separate;
- begin
-     Not_Preelaborable := G(F); -- OK, by AI-2.
-     if Not_Preelaborable /= 101 then
-         raise Program_Error; -- Can't call Report.Failed, here,
-             -- because Report is not preelaborated.
-     end if;
- end Sub;
- 
- separate(CA21001_1.Sub)
- package body Sub_Sub is
- begin
-     X := X; -- OK by AI-2.
- end Sub_Sub;
- 
- separate(CA21001_1.Sub)
- function G(X: Integer) return Integer is
- 
-     package G_Sub is
-         function H(X: Integer) return Integer;
-             -- Returns X + 1.
-         Not_Preelaborable: Integer := F; -- OK, by AI-2.
-     end G_Sub;
-     package body G_Sub is separate;
- 
- begin
-     return G_Sub.H(X);
- end G;
- 
- separate(CA21001_1.Sub.G)
- package body G_Sub is
-     function H(X: Integer) return Integer is separate;
- begin
-     Not_Preelaborable := H(F); -- OK, by AI-2.
-     if Not_Preelaborable /= 101 then
-         raise Program_Error; -- Can't call Report.Failed, here,
-             -- because Report is not preelaborated.
-     end if;
- end G_Sub;
- 
- separate(CA21001_1.Sub.G.G_Sub)
- function H(X: Integer) return Integer is
- begin
-     return X + 1;
- end H;
- 
- separate(CA21001_1)
- function F return Integer is
- 
-     package F_Sub is
-         -- Empty.
-     end F_Sub;
- 
-     package body F_Sub is separate;
- begin
-     return 100;
- end F;
- 
- separate(CA21001_1.F)
- package body F_Sub is
-     True_Var: Boolean;
- begin
-     True_Var := True;
-     if True_Var then -- OK by AI-2.
-         X := X;
-     else
-         X := X + 2;
-     end if;
- end F_Sub;
- 
- with Report; use Report;
- with CA21001_1;
- procedure CA21001 is
-     X: Integer := 0;
- begin
-     Test("CA21001",
-          "Test that a package subunit whose parent is a preelaborated"
-          & " subprogram need not be preelaborable");
-     CA21001_1(X);
-     if X /= 101 then
-         Failed("Bad value for X");
-     end if;
-     Result;
- end CA21001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- CA3011A0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- A GENERIC UNIT.
- -- SUBUNITS ARE IN CA3011A1, CA3011A2, AND CA3011A3.
- -- INSTANTIATION IS IN CA3011A4M.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     RJW 09/22/86  CREATED ORIGINAL TEST.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- WITH REPORT; USE REPORT;
- 
- GENERIC
-      TYPE T IS (<>);
-      X : T;
- PROCEDURE CA3011A0 (Z : OUT T);
- 
- PROCEDURE CA3011A0 (Z : OUT T) IS
-      T1 : T;
- 
-      FUNCTION CA3011A1 RETURN T IS SEPARATE;
- 
-      PROCEDURE CA3011A2 (Y : OUT T) IS SEPARATE;
- 
-      PACKAGE CA3011A3 IS
-           FUNCTION CA3011A3F RETURN T;
-      END CA3011A3;
- 
-      PACKAGE BODY CA3011A3 IS SEPARATE;
- 
- BEGIN
-      IF CA3011A1 /= X THEN
-           FAILED ( "INCORRECT VALUE RETURNED BY FUNCTION CA3011A1" );
-      END IF;
- 
-      CA3011A2 (T1);
- 
-      IF T1 /= X THEN
-           FAILED ( "INCORRECT VALUE RETURNED BY PROCEDURE CA3011A2 " );
-      END IF;
- 
-      IF CA3011A3.CA3011A3F /= X THEN
-           FAILED ( "INCORRECT VALUE RETURNED BY FUNCTION CA3011A3F " );
-      END IF;
- 
-      Z := X;
- 
- END CA3011A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,42 ****
- -- CA3011A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- A SUBUNIT OF A GENERIC UNIT.
- -- THE GENERIC UNIT IS IN CA3011A0.
- -- INSTANTIATION IS IN CA0011A4M.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     RJW 09/22/86  CREATED ORIGINAL TEST.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- SEPARATE (CA3011A0)
- FUNCTION CA3011A1 RETURN T IS
- 
- BEGIN
-      RETURN X;
- END CA3011A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,42 ****
- -- CA3011A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- A SUBUNIT OF A GENERIC UNIT.
- -- THE GENERIC UNIT IS IN CA3011A0.
- -- INSTANTIATION IS IN CA3011A4M.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     RJW 09/22/86  CREATED ORIGINAL TEST.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- SEPARATE (CA3011A0)
- PROCEDURE CA3011A2 (Y : OUT T) IS
- 
- BEGIN
-      Y := X;
- END CA3011A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,43 ****
- -- CA3011A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- A SUBUNIT OF A GENERIC UNIT.
- -- THE GENERIC UNIT IS IN CA3011A0.
- -- INSTANTIATION IS IN CA3011A4M.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
- 
- -- HISTORY:
- --     RJW 09/22/86  CREATED ORIGINAL TEST.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- 
- SEPARATE (CA3011A0)
- PACKAGE BODY CA3011A3 IS
-      FUNCTION CA3011A3F RETURN T IS
-      BEGIN
-           RETURN X;
-      END;
- END CA3011A3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- CA3011A4M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN IMPLEMENTATION DOES NOT REQUIRE GENERIC UNIT BODIES AND
- --     SUBUNITS TO BE COMPILED TOGETHER IN THE SAME FILE.
- 
- -- SEPARATE FILES ARE:
- --     CA3011A0 - A GENERIC UNIT.
- --     CA3011A1, CA3011A2, CA3011A3 - SUBUNITS OF GENERIC UNIT.
- --     CA3011A4M - THE MAIN PROCEDURE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
- --     THIS WAS NOT REQUIRED FOR ADA 83.
- 
- -- HISTORY:
- --     RJW 09/22/86  CREATED ORIGINAL TEST.
- --     BCB 01/05/88  MODIFIED HEADER.
- --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
- --     RLB 09/15/99  REPAIRED OBJECTIVE FOR ADA 95.
- 
- WITH REPORT; USE REPORT;
- WITH CA3011A0;
- PROCEDURE CA3011A4M IS
-      I : INTEGER;
-      PROCEDURE P IS NEW CA3011A0 (INTEGER, 22);
- 
- BEGIN
-      TEST ( "CA3011A", "CHECK THAT AN IMPLEMENTATION DOES NOT REQUIRE " &
-                        "GENERIC UNIT BODIES AND SUBUNITS TO BE " &
-                        "COMPILED TOGETHER IN THE SAME FILE" );
- 
-      P (I);
-      IF I /= 22 THEN
-           FAILED ( "INCORRECT INSTANTIATION" );
-      END IF;
- 
-      RESULT;
- END CA3011A4M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,50 ****
- -- CA5003A0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- 
- PACKAGE CA5003A0 IS
- 
-      ORDER : STRING (1..5) := "     ";
- 
-      INDEX : NATURAL := 1;
- 
-      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER;
- 
- END CA5003A0;
- 
- 
- WITH REPORT;
- USE REPORT;
- PACKAGE BODY CA5003A0 IS
- 
-      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER IS
-      BEGIN
-           ORDER (INDEX) := UNIT;
-           INDEX := INDEX + 1;
-           RETURN INDEX - 1;
-      END SHOW_ELAB;
- 
- END CA5003A0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA5003A1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- 
- WITH CA5003A0;
- USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
- PACKAGE CA5003A1 IS
- 
-      A1 : INTEGER := SHOW_ELAB ('1');
- 
- END CA5003A1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA5003A2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- 
- WITH CA5003A0;
- USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
- PACKAGE CA5003A2 IS
- 
-      A2 : INTEGER := SHOW_ELAB ('2');
- 
- END CA5003A2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA5003A3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- 
- WITH CA5003A0, CA5003A2;
- USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
- PACKAGE CA5003A3 IS
- 
-      A3 : INTEGER := SHOW_ELAB ('3');
- 
- END CA5003A3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA5003A4.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- 
- WITH CA5003A0, CA5003A2;
- USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
- PACKAGE CA5003A4 IS
- 
-      A4 : INTEGER := SHOW_ELAB ('4');
- 
- END CA5003A4;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,34 ****
- -- CA5003A5.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- 
- WITH CA5003A0, CA5003A3, CA5003A4;
- USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
- PACKAGE CA5003A5 IS
- 
-      A5 : INTEGER := SHOW_ELAB ('5');
- 
- END CA5003A5;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- CA5003A6M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ELABORATION OF LIBRARY UNITS REQUIRED BY
- --   A MAIN PROGRAM IS PERFORMED CONSISTENTLY WITH THE PARTIAL
- --   ORDERING DEFINED BY THE COMPILATION ORDER RULES.
- 
- -- SEPARATE FILES ARE:
- --   CA5003A0  A LIBRARY PACKAGE.
- --   CA5003A1  A LIBRARY PACKAGE SPECIFICATION.
- --   CA5003A2  A LIBRARY PACKAGE SPECIFICATION.
- --   CA5003A3  A LIBRARY PACKAGE SPECIFICATION.
- --   CA5003A4  A LIBRARY PACKAGE SPECIFICATION.
- --   CA5003A5  A LIBRARY PACKAGE SPECIFICATION.
- --   CA5003A6M THE MAIN PROCEDURE.
- 
- -- PACKAGE A5 MUST BE ELABORATED AFTER A2, A3, AND A4.
- -- PACKAGE A3 MUST BE ELABORATED AFTER A2.
- -- PACKAGE A4 MUST BE ELABORATED AFTER A2.
- 
- -- WKB 7/22/81
- -- JBG 10/6/83
- 
- WITH REPORT, CA5003A0;
- USE REPORT, CA5003A0;
- WITH CA5003A1, CA5003A5;
- PROCEDURE CA5003A6M IS
- 
- BEGIN
- 
-      TEST ("CA5003A", "CHECK THAT ELABORATION ORDER IS CONSISTENT " &
-                       "WITH PARTIAL ORDERING REQUIREMENTS");
- 
-      COMMENT ("ACTUAL ELABORATION ORDER WAS " & ORDER);
- 
-      IF ORDER /= "12345" AND
-         ORDER /= "12435" AND
-         ORDER /= "21345" AND
-         ORDER /= "21435" AND
-         ORDER /= "23145" AND
-         ORDER /= "24135" AND
-         ORDER /= "23415" AND
-         ORDER /= "24315" AND
-         ORDER /= "23451" AND
-         ORDER /= "24351" THEN
-           FAILED ("ILLEGAL ELABORATION ORDER");
-      END IF;
- 
-      RESULT;
- END CA5003A6M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- CA5003B0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- -- BHS 8/02/84
- -- JRK 9/20/84
- 
- 
- PACKAGE CA5003B0 IS
- 
-      ORDER : STRING (1..4) := "    ";
- 
-      INDEX : NATURAL := 1;
- 
-      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER;
- 
- END CA5003B0;
- 
- 
- PACKAGE BODY CA5003B0 IS
- 
-      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER IS
-      BEGIN
-           ORDER (INDEX) := UNIT;
-           INDEX := INDEX + 1;
-           RETURN INDEX - 1;
-      END SHOW_ELAB;
- 
- END CA5003B0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,46 ****
- -- CA5003B1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- -- BHS 8/02/84
- -- JRK 9/20/84
- 
- 
- WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
- PACKAGE CA5003B1 IS
- 
-      PACKAGE CA5003B2 IS
-           PROCEDURE P1;
-      END CA5003B2;
- 
- END CA5003B1;
- 
- 
- PACKAGE BODY CA5003B1 IS
- 
-      A1 : INTEGER := SHOW_ELAB ('1');
-      PACKAGE BODY CA5003B2 IS SEPARATE;
- 
- END CA5003B1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,45 ****
- -- CA5003B2.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 8/02/84
- -- JRK 9/20/84
- 
- WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
- SEPARATE (CA5003B1)
- PACKAGE BODY CA5003B2 IS
- 
-      A2 : INTEGER := SHOW_ELAB ('2');
- 
-      PROCEDURE P1 IS
-      BEGIN
-           NULL;
-      END P1;
- 
-      PACKAGE CA5003B4 IS 
-           PROCEDURE P2;
-      END CA5003B4;
- 
-      PACKAGE BODY CA5003B4 IS SEPARATE;
- 
- END CA5003B2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,35 ****
- -- CA5003B3.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- WKB 7/22/81
- -- JBG 10/6/83
- -- BHS 8/02/84
- -- JRK 9/20/84
- 
- WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
- PACKAGE CA5003B3 IS
- 
-      A3 : INTEGER := SHOW_ELAB ('3');
- 
- END CA5003B3;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,40 ****
- -- CA5003B4.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- BHS 8/02/84
- -- JRK 9/20/84
- 
- WITH CA5003B3;                -- MUST BE ELABORATED BEFORE CA5003B1.
- WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
- SEPARATE (CA5003B1.CA5003B2)
- PACKAGE BODY CA5003B4 IS
- 
-      A4 : INTEGER := SHOW_ELAB ('4');
- 
-      PROCEDURE P2 IS
-      BEGIN
-           NULL;
-      END P2;
- 
- END CA5003B4;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- CA5003B5M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ELABORATION OF LIBRARY UNITS REQUIRED BY
- --   A MAIN PROGRAM IS PERFORMED CONSISTENTLY WITH THE PARTIAL
- --   ORDERING DEFINED BY THE COMPILATION ORDER RULES.
- -- IN PARTICULAR, CHECK THAT A LIBRARY UNIT MENTIONED IN THE
- --   WITH_CLAUSE OF A SUBUNIT IS ELABORATED PRIOR TO THE BODY OF 
- --   THE ANCESTOR UNIT.
- 
- -- SEPARATE FILES ARE:
- --   CA5003B0  A LIBRARY PACKAGE.
- --   CA5003B1  A LIBRARY PACKAGE.
- --   CA5003B2  A SUBUNIT PACKAGE BODY (_B1._B2).
- --   CA5003B3  A LIBRARY PACKAGE DECLARATION.
- --   CA5003B4  A SUBUNIT PACKAGE BODY (_B1._B2._B4).
- --   CA5003B5M THE MAIN PROCEDURE.
- 
- -- LIBRARY PACKAGES MUST BE ELABORATED IN ORDER: _B0, _B3, _B1.
- -- PARENT UNITS MUST BE ELABORATED BEFORE THEIR SUBUNITS.
- 
- -- WKB 7/22/81
- -- JBG 10/6/83
- -- BHS 8/02/84
- -- JRK 9/20/84
- 
- WITH REPORT, CA5003B0;
- USE REPORT, CA5003B0;
- WITH CA5003B1;
- PROCEDURE CA5003B5M IS
- 
- BEGIN
-      TEST ("CA5003B", "CHECK THAT UNITS IN WITH_CLAUSES OF " &
-                       "SUBUNITS ARE ELABORATED PRIOR TO THE " &
-                       "BODY OF THE ANCESTOR UNIT");
- 
-      COMMENT ("ACTUAL ELABORATION ORDER WAS " & ORDER);
- 
-      IF ORDER /= "3124" THEN
-           FAILED ("ILLEGAL ELABORATION ORDER");
-      END IF;
- 
-      RESULT;
- END CA5003B5M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- CA5004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT IF PRAGMA ELABORATE IS APPLIED TO A PACKAGE THAT DECLARES
- -- A TASK OBJECT, THE IMPLICIT PACKAGE BODY IS ELABORATED AND THE TASK
- -- IS ACTIVATED.
- 
- -- BHS 8/03/84
- -- JRK 9/20/84
- -- PWN 01/31/95  ADDED A PROCEDURE TO REQUIRE A BODY FOR ADA 9X.
- 
- 
- PACKAGE CA5004A0 IS
- 
-      TASK TYPE TSK IS
-           ENTRY E (VAR : OUT INTEGER);
-      END TSK;
- 
- END CA5004A0;
- 
- 
- PACKAGE BODY CA5004A0 IS
- 
-      TASK BODY TSK IS
-      BEGIN
-           ACCEPT E (VAR : OUT INTEGER) DO
-                VAR := 4;
-           END E;
-      END TSK;
- 
- END CA5004A0;
- 
- 
- WITH CA5004A0; USE CA5004A0; PRAGMA ELABORATE (CA5004A0);
- PACKAGE CA5004A1 IS
- 
-      T : TSK;
- 
- END CA5004A1;
- 
- 
- PACKAGE CA5004A2 IS
-      PROCEDURE REQUIRE_BODY;
- END CA5004A2;
- 
- 
- WITH REPORT; USE REPORT;
- WITH CA5004A1; USE CA5004A1;
- PRAGMA ELABORATE (CA5004A1, REPORT);
- PACKAGE BODY CA5004A2 IS
- 
-      I : INTEGER := 1;
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- BEGIN
- 
-      TEST ("CA5004A", "APPLYING PRAGMA ELABORATE TO A PACKAGE " &
-                       "DECLARING A TASK OBJECT CAUSES IMPLICIT " &
-                       "BODY ELABORATION AND TASK ACTIVATION");
- 
-      SELECT
-           T.E(I);
-           IF I /= 4 THEN
-                FAILED ("TASK NOT EXECUTED PROPERLY");
-           END IF;
-      OR
-           DELAY 10.0;
-           FAILED ("TASK NOT ACTIVATED AFTER 10 SECONDS");
-      END SELECT;
- 
- END CA5004A2;
- 
- 
- WITH CA5004A2;
- WITH REPORT; USE REPORT;
- PROCEDURE CA5004A IS
- BEGIN
- 
-      RESULT;
- 
- END CA5004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- CA5004B0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE: See CA5004B2M.ADA
- --
- -- SPECIAL INSTRUCTIONS:  See CA5004B2M.ADA
- --
- -- TEST FILES:
- --     => CA5004B0.ADA
- --        CA5004B1.ADA
- --        CA5004B2M.ADA
- 
- -- PWN 05/31/96 Split test into files without duplicate unit names.
- -- RLB 03/11/99 Split test into files so that units that will be replaced
- --              and units that won't are not in the same source file.
- 
- -------------------------------------------------------------
- 
- PACKAGE HEADER IS 
- 
-      PROCEDURE WRONG (WHY : STRING);
- 
- END HEADER;
- 
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY HEADER IS
- 
-      PROCEDURE WRONG (WHY : STRING) IS
-      BEGIN
-           FAILED ("PACKAGE WITH " & WHY & " NOT ELABORATED " &
-                   "CORRECTLY");
-      END WRONG;
- 
- BEGIN
- 
-      TEST ("CA5004B", "PRAGMA ELABORATE IS ACCEPTED AND OBEYED " &
-                       "EVEN WHEN THE BODY OF THE UNIT NAMED IS " &
-                       "MISSING OR OBSOLETE");
- 
- END HEADER;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- CA5004B1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE: See CA5004B2M.ADA
- --
- -- SPECIAL INSTRUCTIONS:  See CA5004B2M.ADA
- --
- -- TEST FILES:
- --        CA5004B0.ADA
- --     => CA5004B1.ADA
- --        CA5004B2M.ADA
- 
- -- PWN 05/31/96 Split test into files without duplicate unit names.
- -- RLB 03/11/99 Split test into files so that units that will be replaced
- --              and units that won't are not in the same source file.
- 
- ------------------------------------------------------------------
- 
- PACKAGE CA5004B0 IS
- 
-      I : INTEGER := 1;
- 
-      FUNCTION F RETURN BOOLEAN;
- 
- END CA5004B0;
- 
- 
- PACKAGE BODY CA5004B0 IS
- 
-      FUNCTION F RETURN BOOLEAN IS
-      BEGIN
-           RETURN TRUE;
-      END F;
- 
- END CA5004B0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- CA5004B2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PRAGMA ELABORATE IS ACCEPTED AND OBEYED EVEN IF THE UNIT
- --    NAMED IN THE PRAGMA DOES NOT YET HAVE A BODY IN THE LIBRARY OR IF 
- --    ITS BODY IS OBSOLETE.
- -- CHECK THAT MORE THAN ONE NAME IS ALLOWED IN A PRAGMA ELABORATE.
- --
- -- SPECIAL INSTRUCTIONS:  
- --     1. Compile CA5004B0.ADA
- --     2. Compile CA5004B1.ADA
- --     3. Compile CA5004B2M.ADA
- --     4. Bind/Link main unit CA5004B2M
- --     5. Execute the resulting file
- --
- -- TEST FILES:
- --        CA5004B0.ADA
- --        CA5004B1.ADA
- --     => CA5004B2M.ADA
- 
- -- BHS 8/03/84
- -- JRK 9/20/84
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- -- PWN 05/31/96 Split test into files without duplicate unit names.
- -- TMB 11/20/96 ADDED PROCEDURE DECL TO CA5004B0 TO INSURE IT MAKES
- --               THE OLD BODY OBSOLETE
- -- TMB 12/2/96  MADE NAME OF MAIN PROCEDURE SAME AS FILE NAME
- -- RLB 03/11/99 Split first test file in order to prevent good units
- --              from being made obsolete.
- 
- -------------------------------------------------------------
- 
- PACKAGE CA5004B0 IS          -- OLD BODY NOW OBSOLETE.
- 
-      I : INTEGER := 2;
-      B : BOOLEAN := TRUE;
- 
-      FUNCTION F RETURN BOOLEAN;
-      PROCEDURE P;
- 
- END CA5004B0;
- 
- ---------------------------------------------------------
- 
- PACKAGE CA5004B1 IS
- 
-      J : INTEGER := 3;
- 
-      PROCEDURE P (X : INTEGER);
- 
- END CA5004B1;                -- NO BODY GIVEN YET.
- 
- ----------------------------------------------------------
- 
- WITH HEADER; USE HEADER;
- WITH CA5004B0, CA5004B1;
- USE CA5004B0, CA5004B1;
- PRAGMA ELABORATE (HEADER, CA5004B0, CA5004B1);
- PACKAGE CA5004B2 IS
- 
-      K1 : INTEGER := CA5004B0.I;
-      K2 : INTEGER := CA5004B1.J;
- 
-      PROCEDURE REQUIRE_BODY;
- 
- END CA5004B2;
- 
- 
- PACKAGE BODY CA5004B2 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
- BEGIN
- 
-      IF K1 /= 4 THEN
-           WRONG ("OBSOLETE BODY");
-      END IF;
- 
-      IF K2 /= 5 THEN
-           WRONG ("NO BODY");
-      END IF;
- 
- END CA5004B2;
- 
- --------------------------------------------------
- 
- WITH REPORT, CA5004B2;
- USE REPORT, CA5004B2;
- PROCEDURE CA5004B2M IS
- BEGIN
- 
-      RESULT;
- 
- END CA5004B2M;
- 
- ----------------------------------------------------
- 
- PACKAGE BODY CA5004B0 IS
- 
-      FUNCTION F RETURN BOOLEAN IS
-      BEGIN
-           RETURN FALSE;
-      END F;
- 
-      PROCEDURE P IS
-      BEGIN
-         RETURN;
-      END P;
- 
- BEGIN
- 
-      I := 4;
- 
- END CA5004B0;
- 
- ---------------------------------------------------
- 
- PACKAGE BODY CA5004B1 IS
- 
-      PROCEDURE P (X : INTEGER) IS
-      BEGIN
-           NULL;
-      END P;
- 
- BEGIN
- 
-      J := 5;
- 
- END CA5004B1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ca/ca5006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ca/ca5006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- CA5006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A PROGRAM IS NOT REJECTED JUST BECAUSE THERE IS NO WAY TO
- -- ELABORATE SECONDARY UNITS SO PROGRAM_ERROR WILL BE AVOIDED.
- 
- -- R.WILLIAMS 9/22/86
- 
- -----------------------------------------------------------------------
- 
- PACKAGE CA5006A0 IS
-    FUNCTION P_E_RAISED RETURN BOOLEAN;
-    PROCEDURE SHOW_PE_RAISED;
- END CA5006A0;
- 
- -----------------------------------------------------------------------
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY CA5006A0 IS
-    RAISED : BOOLEAN := FALSE;
- 
-    FUNCTION P_E_RAISED RETURN BOOLEAN IS
-    BEGIN
-       RETURN RAISED;
-    END P_E_RAISED;
- 
-    PROCEDURE SHOW_PE_RAISED IS
-    BEGIN
-       RAISED := TRUE;
-    END SHOW_PE_RAISED;
- 
- BEGIN
-      TEST ( "CA5006A", "CHECK THAT A PROGRAM IS NOT REJECTED JUST " &
-                        "BECAUSE THERE IS NO WAY TO ELABORATE " &
-                        "SECONDARY UNITS SO PROGRAM_ERROR WILL BE " &
-                        "AVOIDED" );
- 
-                          
- END CA5006A0;
- 
- -----------------------------------------------------------------------
- 
- PACKAGE CA5006A1 IS
-   FUNCTION F RETURN INTEGER;
- END CA5006A1;
- 
- -----------------------------------------------------------------------
- 
- PACKAGE CA5006A2 IS
-   FUNCTION G RETURN INTEGER;
- END CA5006A2;
- 
- -----------------------------------------------------------------------
- 
- WITH REPORT; USE REPORT;
- WITH CA5006A0; USE CA5006A0;
- WITH CA5006A2; USE CA5006A2;
- PRAGMA ELABORATE(CA5006A0);
- 
- PACKAGE BODY CA5006A1 IS
-    X : INTEGER;
- 
-    FUNCTION F RETURN INTEGER IS
-    BEGIN
-       RETURN IDENT_INT(0);
-    END F;
- 
- BEGIN
-    X := G;
-    IF NOT P_E_RAISED THEN
-       FAILED ( "G CALLED" );
-    END IF;
- EXCEPTION
-    WHEN PROGRAM_ERROR =>
-       COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A1" );
-       SHOW_PE_RAISED;
-    WHEN OTHERS =>
-       FAILED ( "OTHER ERROR RAISED IN CA5006A1" );
- END CA5006A1;
- 
- -----------------------------------------------------------------------
- 
- WITH REPORT; USE REPORT;
- WITH CA5006A0; USE CA5006A0;
- WITH CA5006A1; USE CA5006A1;
- PRAGMA ELABORATE(CA5006A0);
- 
- PACKAGE BODY CA5006A2 IS
-    X : INTEGER;
- 
-    FUNCTION G RETURN INTEGER IS
-    BEGIN
-       RETURN IDENT_INT(1);
-    END G;
- 
- BEGIN
-    X := F;
-    IF NOT P_E_RAISED THEN
-       FAILED ( "F CALLED" );
-    END IF;
- EXCEPTION
-    WHEN PROGRAM_ERROR =>
-       COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A2" );
-       SHOW_PE_RAISED;
-    WHEN OTHERS =>
-       FAILED ( "OTHER ERROR RAISED IN CA5006A2" );
- END CA5006A2;
- 
- -----------------------------------------------------------------------
- 
- WITH REPORT; USE REPORT; 
- WITH CA5006A0; USE CA5006A0;
- WITH CA5006A1; 
- WITH CA5006A2; 
- 
- PROCEDURE CA5006A IS
- BEGIN
-    IF NOT P_E_RAISED THEN
-       FAILED ( "PROGRAM_ERROR NEVER RAISED" );
-    END IF;
- 
-    RESULT;
- END CA5006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb10002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb10002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb10002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb10002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- CB10002.A
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Storage_Error is raised when storage for allocated objects
- --      is exceeded.
- --
- -- TEST DESCRIPTION:
- --      This test allocates a very large data structure.
- --
- --      In order to avoid running forever on virtual memory targets, the
- --      data structure is bounded in size, and elements are larger the longer
- --      the program runs.
- --
- --      The program attempts to allocate about 8,600,000 integers, or about
- --      32 Megabytes on a typical 32-bit machine.
- --
- --      If Storage_Error is raised, the data structure is deallocated.
- --      (Otherwise, Report.Result may fail as memory is exhausted).
- 
- -- CHANGE HISTORY:
- --      30 Aug 85   JRK     Ada 83 test created.
- --      14 Sep 99   RLB     Created Ada 95 test.
- 
- 
- with Report;
- with Ada.Unchecked_Deallocation;
- procedure CB10002 is
- 
-    type Data_Space is array (Positive range <>) of Integer;
- 
-    type Element (Size : Positive);
- 
-    type Link is access Element;
- 
-    type Element (Size : Positive) is
-       record
-          Parent : Link;
-          Child  : Link;
-          Sibling: Link;
-          Data   : Data_Space (1 .. Size);
-       end record;
- 
-     procedure Free is new Ada.Unchecked_Deallocation (Element, Link);
- 
-     Holder : array (1 .. 430) of Link;
-     Last_Allocated : Natural := 0;
- 
-     procedure Allocator (Count : in Positive) is
-     begin
- 	-- Allocate various sized objects similar to what a real application
- 	-- would do.
- 	if Count in 1 .. 20 then
- 	    Holder(Count) := new Element (Report.Ident_Int(10));
- 	elsif Count in 21 .. 40 then
- 	    Holder(Count) := new Element (Report.Ident_Int(79));
- 	elsif Count in 41 .. 60 then
- 	    Holder(Count) := new Element (Report.Ident_Int(250));
- 	elsif Count in 61 .. 80 then
- 	    Holder(Count) := new Element (Report.Ident_Int(520));
- 	elsif Count in 81 .. 100 then
- 	    Holder(Count) := new Element (Report.Ident_Int(1000));
- 	elsif Count in 101 .. 120 then
- 	    Holder(Count) := new Element (Report.Ident_Int(2048));
- 	elsif Count in 121 .. 140 then
- 	    Holder(Count) := new Element (Report.Ident_Int(4200));
- 	elsif Count in 141 .. 160 then
- 	    Holder(Count) := new Element (Report.Ident_Int(7999));
- 	elsif Count in 161 .. 180 then
- 	    Holder(Count) := new Element (Report.Ident_Int(15000));
- 	else -- 181..430
- 	    Holder(Count) := new Element (Report.Ident_Int(32000));
- 	end if;
- 	Last_Allocated := Count;
-     end Allocator;
- 
- 
- begin
-    Report.Test ("CB10002", "Check that Storage_Error is raised when " &
-                            "storage for allocated objects is exceeded");
- 
-    begin
-       for I in Holder'range loop
-          Allocator (I);
-       end loop;
-       Report.Not_Applicable ("Unable to exhaust memory");
-       for I in 1 .. Last_Allocated loop
-          Free (Holder(I));
-       end loop;
-    exception
-       when Storage_Error =>
-          if Last_Allocated = 0 then
-             Report.Failed ("Unable to allocate anything");
-          else -- Clean up, so we have enough memory to report on the result.
-             for I in 1 .. Last_Allocated loop
-                Free (Holder(I));
-             end loop;
-             Report.Comment (Natural'Image(Last_Allocated) & " items allocated");
-          end if;
-       when others =>
-          Report.Failed ("Wrong exception raised by heap overflow");
-    end;
- 
-    Report.Result;
- 
- end CB10002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1001a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- CB1001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ALL PREDEFINED EXCEPTIONS MAY BE RAISED EXPLICITLY
- --    AND MAY HAVE HANDLERS WRITTEN FOR THEM.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- DCB 03/25/80
- -- JRK 11/17/80
- -- SPS 11/2/82
- -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT;
- PROCEDURE CB1001A IS
- 
-      USE REPORT;
- 
-      FLOW_COUNT : INTEGER := 0;
- 
- BEGIN
-      TEST("CB1001A", "CHECK THAT ALL PREDEFINED EXCEPTIONS MAY BE " &
-           "RAISED EXPLICITLY AND MAY HAVE HANDLERS WRITTEN FOR THEM");
- 
-      BEGIN
-           RAISE CONSTRAINT_ERROR;
-           FAILED("NO EXCEPTION RAISED WHEN CONSTRAINT_ERROR EXPECTED");
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION RAISED WHEN CONSTRAINT_ERROR " &
-                       "EXPECTED");
-      END;
- 
- 
-      BEGIN
-           RAISE PROGRAM_ERROR;
-           FAILED("NO EXCEPTION RAISED WHEN PROGRAM_ERROR EXPECTED");
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION RAISED WHEN PROGRAM_ERROR " &
-                       "EXPECTED");
-      END;
- 
-      BEGIN
-           RAISE STORAGE_ERROR;
-           FAILED("NO EXCEPTION RAISED WHEN STORAGE_ERROR EXPECTED");
- 
-      EXCEPTION
-           WHEN STORAGE_ERROR =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION RAISED WHEN STORAGE_ERROR " &
-                       "EXPECTED");
-      END;
- 
-      BEGIN
-           RAISE TASKING_ERROR;
-           FAILED("NO EXCEPTION RAISED WHEN TASKING_ERROR EXPECTED");
- 
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION RAISED WHEN TASKING_ERROR " &
-                       "EXPECTED");
-      END;
- 
-      IF FLOW_COUNT /= 4 THEN
-           FAILED("WRONG FLOW_COUNT VALUE");
-      END IF;
- 
-      RESULT;
- END CB1001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- CB1004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EXCEPTIONS DECLARED IN RECURSIVE PROCEDURES ARE NOT
- --    REPLICATED ANEW FOR EACH RECURSIVE ACTIVATION OF THE PROCEDURE.
- 
- -- DCB 03/30/80
- -- JRK 11/17/80
- -- SPS 3/23/83
- 
- WITH REPORT;
- PROCEDURE CB1004A IS
- 
-      USE REPORT;
- 
-      FLOW_COUNT : INTEGER := 0;
- 
-      PROCEDURE P1(SWITCH1 : IN INTEGER) IS
- 
-           E1 : EXCEPTION;
- 
-           PROCEDURE P2 IS
- 
-           BEGIN
-                FLOW_COUNT := FLOW_COUNT + 1;   -- 3
-                P1(2);
-                FAILED("EXCEPTION NOT PROPAGATED");
- 
-           EXCEPTION
-                WHEN E1 =>
-                     FLOW_COUNT := FLOW_COUNT + 1;   -- 6
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED");
-           END P2;
- 
-      BEGIN
-           FLOW_COUNT := FLOW_COUNT + 1;   -- 2   -- 4
-           IF SWITCH1 = 1 THEN
-                P2;
-           ELSIF SWITCH1 = 2 THEN
-                FLOW_COUNT := FLOW_COUNT + 1;   -- 5
-                RAISE E1;
-                FAILED("EXCEPTION NOT RAISED");
-           END IF;
-      END P1;
- 
- BEGIN
-      TEST("CB1004A","CHECK THAT EXCEPTIONS ARE NOT RECURSIVELY " &
-                     "REPLICATED");
- 
-      FLOW_COUNT := FLOW_COUNT + 1;   -- 1
-      P1(1);
- 
-      IF FLOW_COUNT /= 6 THEN
-           FAILED("INCORRECT FLOW_COUNT VALUE");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED("EXCEPTION HANDLED IN WRONG SCOPE");
-           RESULT;
- END CB1004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- CB1005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EXCEPTIONS DECLARED IN GENERIC PACKAGES AND PROCEDURES ARE
- -- CONSIDERED DISTINCT FOR EACH INSTANTIATION.
- 
- -- CHECK THAT AN EXCEPTION NAME DECLARED IN A GENERIC PACKAGE
- -- INSTANTIATION IN A RECURSIVE PROCEDURE DENOTES THE SAME ENTITY
- -- EVEN WHEN THE INSTANTIATION IS ELABORATED MORE THAN ONCE BECAUSE
- -- OF RECURSIVE CALLS.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- TBN  9/23/86
- -- MRM  03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CB1005A IS
- 
-      PROCEDURE PROP;
- 
-      GENERIC
-           PACKAGE PAC IS
-                EXC : EXCEPTION;
-           END PAC;
- 
-      GENERIC
-           PROCEDURE PROC (INST_AGAIN : BOOLEAN);
- 
-      PROCEDURE PROC (INST_AGAIN : BOOLEAN) IS
-           EXC : EXCEPTION;
-      BEGIN
-           IF INST_AGAIN THEN
-                BEGIN
-                     PROP;
-                     FAILED ("EXCEPTION WAS NOT PROPAGATED - 9");
-                EXCEPTION
-                     WHEN EXC =>
-                          FAILED ("EXCEPTION NOT DISTINCT - 10");
-                     WHEN PROGRAM_ERROR | STORAGE_ERROR |
-                          TASKING_ERROR | CONSTRAINT_ERROR =>
-                          FAILED ("WRONG EXCEPTION PROPAGATED - 11");
-                     WHEN OTHERS =>
-                          NULL;
-                END;
-           ELSE
-                RAISE EXC;
-           END IF;
-      END PROC;
- 
-      PROCEDURE RAISE_EXC (CALL_AGAIN : BOOLEAN) IS
-           PACKAGE PAC3 IS NEW PAC;
-      BEGIN
-           IF CALL_AGAIN THEN
-                BEGIN
-                     RAISE_EXC (FALSE);
-                     FAILED ("EXCEPTION WAS NOT PROPAGATED - 12");
-                EXCEPTION
-                     WHEN PAC3.EXC =>
-                          NULL;
-                END;
-           ELSE
-                RAISE PAC3.EXC;
-           END IF;
-      END RAISE_EXC;
- 
-      PROCEDURE PROP IS
-           PROCEDURE PROC2 IS NEW PROC;
-      BEGIN
-           PROC2 (FALSE);
-      END PROP;
- 
- BEGIN
-      TEST ("CB1005A", "CHECK THAT EXCEPTIONS DECLARED IN GENERIC " &
-                       "PACKAGES AND PROCEDURES ARE CONSIDERED " &
-                       "DISTINCT FOR EACH INSTANTIATION");
- 
-      -------------------------------------------------------------------
-      DECLARE
-           PACKAGE PAC1 IS NEW PAC;
-           PACKAGE PAC2 IS NEW PAC;
-           PAC1_EXC_FOUND : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RAISE PAC2.EXC;
-                END IF;
-                FAILED ("EXCEPTION WAS NOT RAISED - 1");
- 
-           EXCEPTION
-                WHEN PAC1.EXC =>
-                     FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 2");
-                     PAC1_EXC_FOUND := TRUE;
-           END;
-           IF NOT PAC1_EXC_FOUND THEN
-                FAILED ("EXCEPTION WAS NOT PROPAGATED - 3");
-           END IF;
- 
-      EXCEPTION
-           WHEN PAC1.EXC =>
-                FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 4");
-           WHEN PAC2.EXC =>
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RAISE PAC1.EXC;
-                     END IF;
-                     FAILED ("EXCEPTION WAS NOT RAISED - 5");
- 
-                EXCEPTION
-                     WHEN PAC2.EXC =>
-                          FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 6");
-                     WHEN PAC1.EXC =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNKNOWN EXCEPTION RAISED - 7");
-                END;
-           WHEN OTHERS =>
-                FAILED ("UNKNOWN EXCEPTION RAISED - 8");
-      END;
- 
-      -------------------------------------------------------------------
-      DECLARE
-           PROCEDURE PROC1 IS NEW PROC;
-      BEGIN
-           PROC1 (TRUE);
-      END;
- 
-      -------------------------------------------------------------------
-      BEGIN
-           RAISE_EXC (TRUE);
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTIONS ARE DISTINCT FOR RECURSION - 13");
-      END;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- END CB1005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,179 ****
- -- CB1010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT STORAGE_ERROR IS RAISED WHEN STORAGE ALLOCATED TO A TASK
- -- IS EXCEEDED.
- 
- -- PNH 8/26/85
- -- JRK 8/30/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB1010A IS
- 
-      N : INTEGER := IDENT_INT (1);
-      M : INTEGER := IDENT_INT (0);
- 
-      PROCEDURE OVERFLOW_STACK IS
-           A : ARRAY (1 .. 1000) OF INTEGER;
-      BEGIN
-           N := N + M;
-           A (N) := M;
-           IF N > M THEN  -- ALWAYS TRUE.
-                OVERFLOW_STACK;
-           END IF;
-           M := A (N);    -- TO PREVENT TAIL RECURSION OPTIMIZATION.
-      END OVERFLOW_STACK;
- 
- BEGIN
-      TEST ("CB1010A", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
-                       "STORAGE ALLOCATED TO A TASK IS EXCEEDED");
- 
-      --------------------------------------------------
- 
-      COMMENT ("CHECK TASKS THAT DO NOT HANDLE STORAGE_ERROR " &
-               "PRIOR TO RENDEZVOUS");
- 
-      DECLARE
- 
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
- 
-           TASK BODY T1 IS
-           BEGIN
-                OVERFLOW_STACK;
-                FAILED ("TASK T1 NOT TERMINATED BY STACK OVERFLOW");
-           END T1;
- 
-      BEGIN
- 
-           T1.E1;
-           FAILED ("NO EXCEPTION RAISED BY ENTRY CALL T1.E1");
- 
-      EXCEPTION
-           WHEN TASKING_ERROR =>
-                IF N /= 1 OR M /= 0 THEN
-                     FAILED ("VALUES OF VARIABLES N OR M ALTERED - 1");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY CALL OF ENTRY E1 " &
-                        "OF TERMINATED TASK T1");
-      END;
- 
-      --------------------------------------------------
- 
-      COMMENT ("CHECK TASKS THAT DO HANDLE STORAGE_ERROR PRIOR TO " &
-               "RENDEZVOUS");
- 
-      N := IDENT_INT (1);
-      M := IDENT_INT (0);
- 
-      DECLARE
- 
-           TASK T2 IS
-                ENTRY E2;
-           END T2;
- 
-           TASK BODY T2 IS
-           BEGIN
-                OVERFLOW_STACK;
-                FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW IN " &
-                        "TASK T2");
-           EXCEPTION
-                WHEN STORAGE_ERROR =>
-                     ACCEPT E2;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN TASK T2 BY " &
-                             "STACK OVERFLOW");
-           END T2;
- 
-      BEGIN
- 
-           T2.E2;
-           IF N /= 1 OR M /= 0 THEN
-                FAILED ("VALUES OF VARIABLES N OR M ALTERED - 2");
-           END IF;
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED BY ENTRY CALL T2.E2");
-                ABORT T2;
-      END;
- 
-      --------------------------------------------------
- 
-      COMMENT ("CHECK TASKS THAT DO NOT HANDLE STORAGE_ERROR " &
-               "DURING RENDEZVOUS");
- 
-      N := IDENT_INT (1);
-      M := IDENT_INT (0);
- 
-      DECLARE
- 
-           TASK T3 IS
-                ENTRY E3A;
-                ENTRY E3B;
-           END T3;
- 
-           TASK BODY T3 IS
-           BEGIN
-                ACCEPT E3A DO
-                     OVERFLOW_STACK;
-                     FAILED ("EXCEPTION NOT RAISED IN ACCEPT E3A BY " &
-                             "STACK OVERFLOW");
-                END E3A;
-                FAILED ("EXCEPTION NOT PROPOGATED CORRECTLY IN TASK T3");
-           EXCEPTION
-                WHEN STORAGE_ERROR =>
-                     ACCEPT E3B;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED IN TASK T3 BY " &
-                             "STACK OVERFLOW");
-           END T3;
- 
-      BEGIN
- 
-           T3.E3A;
-           FAILED ("NO EXCEPTION RAISED BY ENTRY CALL T3.E3A");
- 
-      EXCEPTION
-           WHEN STORAGE_ERROR =>
-                T3.E3B;
-                IF N /= 1 OR M /= 0 THEN
-                     FAILED ("VALUES OF VARIABLES N OR M ALTERED - 3");
-                END IF;
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED BY ENTRY CALL T3.E3A " &
-                        "INSTEAD OF STORAGE_ERROR");
-                ABORT T3;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY ENTRY CALL T3.E3A");
-                ABORT T3;
-      END;
- 
-      --------------------------------------------------
- 
-      RESULT;
- END CB1010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1010c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1010c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1010c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1010c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- CB1010C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT STORAGE_ERROR IS RAISED WHEN STORAGE FOR A DECLARATIVE
- -- ITEM IS INSUFFICIENT.
- 
- -- JRK 8/30/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB1010C IS
- 
-      N : INTEGER := IDENT_INT (1000);
-      M : INTEGER := IDENT_INT (0);
- 
-      PROCEDURE OVERFLOW_STACK IS
-      BEGIN
-           N := N + M;
-           DECLARE
-                A : ARRAY (1 .. N) OF INTEGER;
-           BEGIN
-                A (N) := M;
-                IF N > M THEN  -- ALWAYS TRUE.
-                     OVERFLOW_STACK;
-                END IF;
-                M := A (N);    -- TO PREVENT TAIL RECURSION OPTIMIZATION.
-           END;
-      END OVERFLOW_STACK;
- 
- BEGIN
-      TEST ("CB1010C", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
-                       "STORAGE FOR A DECLARATIVE ITEM IS INSUFFICIENT");
- 
-      BEGIN
- 
-           OVERFLOW_STACK;
-           FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW");
- 
-      EXCEPTION
-           WHEN STORAGE_ERROR =>
-                IF N /= 1000 OR M /= 0 THEN
-                     FAILED ("VALUES OF VARIABLES N OR M WERE ALTERED");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY STACK OVERFLOW");
-      END;
- 
-      RESULT;
- END CB1010C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1010d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1010d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb1010d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb1010d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- CB1010D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT STORAGE_ERROR IS RAISED WHEN STORAGE FOR THE EXECUTION OF
- -- A SUBPROGRAM IS INSUFFICIENT.
- 
- -- PNH 8/26/85
- -- JRK 8/30/85
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB1010D IS
- 
-      N : INTEGER := IDENT_INT (1);
-      M : INTEGER := IDENT_INT (0);
- 
-      PROCEDURE OVERFLOW_STACK IS
-      BEGIN
-           N := N + M;
-           IF N > M THEN       -- ALWAYS TRUE.
-                OVERFLOW_STACK;
-           END IF;
-           N := N - M;         -- TO PREVENT TAIL RECURSION OPTIMIZATION.
-      END OVERFLOW_STACK;
- 
- BEGIN
-      TEST ("CB1010D", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
-                       "STORAGE FOR THE EXECUTION OF A SUBPROGRAM " &
-                       "IS INSUFFICIENT");
- 
-      -- CHECK HANDLING OF STORAGE_ERROR IN MAIN PROGRAM.
- 
-      BEGIN
-           OVERFLOW_STACK;
-           FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW - 1");
-      EXCEPTION
-           WHEN STORAGE_ERROR =>
-                IF N /= 1 THEN
-                     FAILED ("VALUE OF VARIABLE N ALTERED - 1");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED BY STACK OVERFLOW - 1");
-      END;
- 
-      -- CHECK HANDLING OF STORAGE_ERROR IN SUBPROGRAM.
- 
-      DECLARE
- 
-           PROCEDURE P IS
-           BEGIN
-                OVERFLOW_STACK;
-                FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW - 2");
-           EXCEPTION
-                WHEN STORAGE_ERROR =>
-                     IF N /= 1 THEN
-                          FAILED ("VALUE OF VARIABLE N ALTERED - 2");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED BY STACK " &
-                             "OVERFLOW - 2");
-           END P;
- 
-      BEGIN
- 
-           N := IDENT_INT (1);
-           P;
- 
-      END;
- 
-      RESULT;
- END CB1010D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,228 ****
- -- CB20001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that exceptions can be handled in accept bodies, and that a
- --      task object that has an exception handled in an accept body is still
- --      viable for future use.
- --
- -- TEST DESCRIPTION:
- --      Declare a task that has exception handlers within an accept
- --      statement in the task body.  Declare a task object, and make entry
- --      calls with data that will cause various exceptions to be raised
- --      by the accept statement.  Ensure that the exceptions are: 
- --         1) raised and handled locally in the accept body
- --         2) raised in the accept body and handled/reraised to be handled 
- --            by the task body
- --         3) raised in the accept body and propagated to the calling 
- --            procedure. 
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- 
- package CB20001_0 is               
- 
-    Incorrect_Data,
-    Location_Error,
-    Off_Screen_Data           : exception;
- 
-    TC_Handled_In_Accept,
-    TC_Reraised_In_Accept,
-    TC_Handled_In_Task_Block,
-    TC_Handled_In_Caller      : boolean := False;
- 
-    type Location_Type is range 0 .. 2000;
- 
-    task type Submarine_Type is
-       entry Contact (Location : in Location_Type);
-    end Submarine_Type;
- 
-    Current_Position : Location_Type := 0;
- 
- end CB20001_0;
- 
- 
-      --=================================================================--
- 
- 
- package body CB20001_0 is
- 
- 
-    task body Submarine_Type is
-    begin
-       loop
- 
-          Task_Block:
-          begin
-             select
-                accept Contact (Location : in Location_Type) do
-                   if Location > 1000 then
-                      raise Off_Screen_Data;
-                   elsif (Location > 500) and (Location <= 1000) then
-                      raise Location_Error;
-                   elsif (Location > 100) and (Location <= 500) then
-                      raise Incorrect_Data;
-                   else
-                      Current_Position := Location;
-                   end if;
-                exception
-                   when Off_Screen_Data =>
-                      TC_Handled_In_Accept := True;
-                   when Location_Error =>
-                      TC_Reraised_In_Accept := True;
-                      raise;   -- Reraise the Location_Error exception
-                               -- in the task block.
-                end Contact;
-             or
-                terminate;
-             end select;
- 
-          exception
- 
-             when Off_Screen_Data =>
-                 TC_Handled_In_Accept := False;
-                 Report.Failed ("Off_Screen_Data exception " &
-                                "improperly handled in task block");
- 
-             when Location_Error =>
-                 TC_Handled_In_Task_Block := True;
-          end Task_Block;
- 
-       end loop;
- 
-    exception
- 
-       when Location_Error | Off_Screen_Data =>
-          TC_Handled_In_Accept := False;
-          TC_Handled_In_Task_Block := False;
-          Report.Failed ("Exception improperly propagated out to task body"); 
-       when others =>
-          null;
-    end Submarine_Type;
- 
- end CB20001_0;
- 
- 
-      --=================================================================--
- 
- 
- with CB20001_0;       
- with Report;
- with ImpDef;
- 
- procedure CB20001 is
- 
-    package Submarine_Tracking renames CB20001_0;
- 
-    Trident       : Submarine_Tracking.Submarine_Type;   -- Declare task
-    Sonar_Contact : Submarine_Tracking.Location_Type;
- 
-    TC_LEB_Error,
-    TC_Main_Handler_Used : Boolean := False;
- 
- begin
- 
-    Report.Test ("CB20001", "Check that exceptions can be handled " &
-                            "in accept bodies");
- 
- 
-    Off_Screen_Block:
-    begin
-       Sonar_Contact := 1500;
-       Trident.Contact (Sonar_Contact);  -- Cause Off_Screen_Data exception
-                                         -- to be raised and handled in a task 
-                                         -- accept body.
-    exception                            
-       when Submarine_Tracking.Off_Screen_Data =>
-           TC_Main_Handler_Used := True;
-           Report.Failed ("Off_Screen_Data exception improperly handled " &
-                          "in calling procedure");
-       when others =>
-           Report.Failed ("Exception handled unexpectedly in " &
-                          "Off_Screen_Block");
-    end Off_Screen_Block;
- 
- 
-    Location_Error_Block:
-    begin
-       Sonar_Contact := 700;
-       Trident.Contact (Sonar_Contact);  -- Cause Location_Error exception
-                                         -- to be raised in task accept body,
-                                         -- propogated to a task block, and
-                                         -- handled there.  Corresponding
-                                         -- exception propagated here also.
-       Report.Failed ("Expected exception not raised");
-    exception                            
-       when Submarine_Tracking.Location_Error =>
-           TC_LEB_Error := True;
-       when others =>
-           Report.Failed ("Exception handled unexpectedly in " &
-                          "Location_Error_Block");
-    end Location_Error_Block;
- 
- 
-    Incorrect_Data_Block:
-    begin
-       Sonar_Contact := 200;
-       Trident.Contact (Sonar_Contact);  -- Cause Incorrect_Data exception
-                                         -- to be raised in task accept body,
-                                         -- propogated to calling procedure.
-       Report.Failed ("Expected exception not raised");
-    exception                            
-       when Submarine_Tracking.Incorrect_Data =>
-           Submarine_Tracking.TC_Handled_In_Caller := True;
-       when others =>
-           Report.Failed ("Exception handled unexpectedly in " &
-                          "Incorrect_Data_Block");
-    end Incorrect_Data_Block;
- 
- 
-    if TC_Main_Handler_Used or
-       not (Submarine_Tracking.TC_Handled_In_Caller     and -- Check to see that
-            Submarine_Tracking.TC_Handled_In_Task_Block and -- all exceptions
-            Submarine_Tracking.TC_Handled_In_Accept     and -- were handled in
-            Submarine_Tracking.TC_Reraised_In_Accept    and -- proper locations.
-            TC_LEB_Error)       
-    then                                                    
-       Report.Failed ("Exceptions handled in incorrect locations");
-    end if;
- 
-    if Integer(Submarine_Tracking.Current_Position) /= 0 then
-       Report.Failed ("Variable incorrectly written in task processing");
-    end if;
- 
-    delay ImpDef.Minimum_Task_Switch;
-    if Trident'Callable then
-       Report.Failed ("Task didn't terminate with exception propagation");
-    end if;
- 
-    Report.Result;
- 
- end CB20001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,286 ****
- -- CB20003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that exceptions can be raised, reraised, and handled in an
- --      accessed subprogram.
- --
- --
- -- TEST DESCRIPTION:
- --      Declare a record type, with one component being an access to
- --      subprogram type.  Various subprograms are defined to fit the profile 
- --      of this access type, such that the record component can refer to 
- --      any of the subprograms.  
- --
- --      Each of the subprograms raises a different exception, based on the
- --      value of an input parameter.  Exceptions are 1) raised, handled with
- --      an others handler, reraised and propagated to main to be handled in
- --      a specific handler; 2) raised, handled in a specific handler, reraised 
- --      and propagated to the main to be handled in an others handler there,
- --      and 3) raised and propagated directly to the caller by the subprogram.
- --
- --      Boolean variables are set throughout the test to ensure that correct
- --      exception processing has occurred, and these variables are verified at
- --      the conclusion of the test.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CB20003_0 is                          -- package Push_Buttons 
- 
- 
-    Non_Default_Priority,
-    Non_Alert_Priority,
-    Non_Emergency_Priority : exception;
- 
-    Handled_With_Others,
-    Reraised_In_Subprogram,
-    Handled_In_Caller      : Boolean := False;
- 
-    subtype Priority_Type is Integer range 1 .. 10;
- 
-    Default_Priority   : Priority_Type := 1;
-    Alert_Priority     : Priority_Type := 3;
-    Emergency_Priority : Priority_Type := 5;
- 
- 
-    type Button is tagged private;                  -- Private tagged type.
- 
-    type Button_Response_Ptr is access procedure (P : in     Priority_Type;
-                                                  B : in out Button);
- 
- 
-    -- Procedures accessible with Button_Response_Ptr type.
- 
-    procedure Default_Response   (P : in     Priority_Type;
-                                  B : in out Button);
- 
-    procedure Alert_Response     (P : in     Priority_Type;
-                                  B : in out Button);
- 
-    procedure Emergency_Response (P : in     Priority_Type;
-                                  B : in out Button);
- 
- 
- 
-    procedure Push (B : in out Button;
-                    P : in     Priority_Type);
- 
-    procedure Set_Response (B : in out Button;       
-                            R : in     Button_Response_Ptr);
- 
- private
- 
-    type Button is tagged                   
-       record
-          Priority :  Priority_Type       := Default_Priority;
-          Response :  Button_Response_Ptr := Default_Response'Access;   
-       end record;
- 
- 
- end CB20003_0;                                -- package Push_Buttons
- 
- 
-      --=================================================================--
- 
- 
- with Report;
- 
- package body CB20003_0 is                     -- package Push_Buttons 
- 
- 
-    procedure Push (B : in out Button;
-                    P : in     Priority_Type) is
-    begin                                  -- Invoking subprogram designated 
-       B.Response (P, B);                  -- by access value.
-    end Push;
- 
- 
-    procedure Set_Response (B : in out Button;
-                            R : in     Button_Response_Ptr) is
-    begin
-       B.Response := R;      -- Set procedure value in record
-    end Set_Response;
- 
- 
-    procedure Default_Response (P : in     Priority_Type;
-                                B : in out Button) is
-    begin
-       if (P > Default_Priority) then
-          raise Non_Default_Priority;
-          Report.Failed ("Exception not raised in procedure body");
-       else
-          B.Priority := P;
-       end if;
-    exception
-       when others =>                    -- Catch exception with others handler
-          Handled_With_Others := True;   -- Successfully caught with "others"
-          raise;
-          Report.Failed ("Exception not reraised in handler");
-    end Default_Response;
- 
- 
- 
-    procedure Alert_Response (P : in     Priority_Type;
-                              B : in out Button) is
-    begin
-       if (P > Alert_Priority) then
-          raise Non_Alert_Priority;
-          Report.Failed ("Exception not raised in procedure body");
-       else
-          B.Priority := P;
-       end if;
-    exception
-       when Non_Alert_Priority =>
-          Reraised_In_Subprogram := True;
-          raise;                                  -- Propagate to caller.
-          Report.Failed ("Exception not reraised in procedure excpt handler");
-       when others =>
-          Report.Failed ("Incorrect exception raised/handled");
-    end Alert_Response;
- 
- 
- 
-    procedure Emergency_Response (P : in     Priority_type;
-                                  B : in out Button) is
-    begin
-       if (P > Emergency_Priority) then
-          raise Non_Emergency_Priority;
-          Report.Failed ("Exception not raised in procedure body");
-       else
-          B.Priority := P;
-       end if;
-       -- No exception handler here, exception will be propagated to caller.
-    end Emergency_Response;
- 
- 
- end CB20003_0;                                -- package Push_Buttons
- 
- 
-      --=================================================================--
- 
- 
- with Report;
- with CB20003_0;                               -- package Push_Buttons
- 
- procedure CB20003 is
-       
-    package Push_Buttons renames CB20003_0;
- 
-    Console_Button : Push_Buttons.Button;
- 
- begin
- 
-    Report.Test ("CB20003", "Check that exceptions can be raised, "  &
-                            "reraised, and handled in a subprogram " &
-                            "referenced by an access to subprogram value");
- 
- 
-    Default_Response_Processing:                 -- The exception
-                                                 -- Handled_With_Others is to 
-                                                 -- be caught with an others
-                                                 -- handler in Default_Resp.,
-                                                 -- reraised, and handled with
-                                                 -- a specific handler here.
-    begin
-    
-       Push_Buttons.Push (Console_Button,        -- Raise exception that will
-                          Report.Ident_Int(2));  -- be handled in procedure.
-    exception
-       when Push_Buttons.Non_Default_Priority =>
-          if not Push_Buttons.Handled_With_Others then   -- Not reraised in 
-                                                         -- procedure.
-             Report.Failed 
-               ("Exception not handled/reraised in procedure");
-          end if;
-       when others =>
-          Report.Failed ("Exception handled in " &
-                         " Default_Response_Processing block");
-    end Default_Response_Processing;
- 
- 
- 
-    Alert_Response_Processing:
-    begin
-    
-       Push_Buttons.Set_Response (Console_Button,
-                                  Push_Buttons.Alert_Response'access);
- 
-       Push_Buttons.Push (Console_Button,        -- Raise exception that will
-                          Report.Ident_Int(4));  -- be handled in procedure, 
-                                                 -- reraised, and propagated
-                                                 -- to caller.
-       Report.Failed ("Exception not propagated to caller " &
-                      "in Alert_Response_Processing block");
- 
-    exception                                    
-       when Push_Buttons.Non_Alert_Priority =>
-          if not Push_Buttons.Reraised_In_Subprogram then  -- Not reraised in 
-                                                           -- procedure.
-             Report.Failed ("Exception not reraised in procedure");
-          end if;
-       when others =>
-          Report.Failed ("Exception handled in " &
-                         " Alert_Response_Processing block");
-    end Alert_Response_Processing;
- 
- 
- 
-    Emergency_Response_Processing:
-    begin
-    
-       Push_Buttons.Set_Response (Console_Button,
-                                  Push_Buttons.Emergency_Response'access);
- 
-       Push_Buttons.Push (Console_Button,        -- Raise exception that will
-                          Report.Ident_Int(6));  -- be propagated directly to
-                                                 -- caller.
-       Report.Failed ("Exception not propagated to caller " &
-                      "in Emergency_Response_Processing block");
- 
-    exception                                   
-       when Push_Buttons.Non_Emergency_Priority =>
-          Push_Buttons.Handled_In_Caller := True;
-       when others =>
-          Report.Failed ("Exception handled in " &
-                         " Emergency_Response_Processing block");
-    end Emergency_Response_Processing;
- 
- 
- 
-    if not (Push_Buttons.Handled_With_Others and
-            Push_Buttons.Reraised_In_Subprogram and
-            Push_Buttons.Handled_In_Caller ) 
-    then
-       Report.Failed ("Incorrect exception handling in referenced subprograms");
-    end if;
- 
- 
-    Report.Result;
- 
- end CB20003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,203 ****
- -- CB20004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that exceptions propagate correctly from objects of 
- --      protected types. Check propagation from protected entry bodies.
- --
- -- TEST DESCRIPTION:
- --      Declare a package with a protected type, including entries and private
- --      data, simulating a bounded buffer abstraction.  In the main procedure,
- --      perform entry calls on an object of the protected type that raises
- --      exceptions.
- --      Ensure that the exceptions are: 
- --         1) raised and handled locally in the entry body
- --         2) raised in the entry body and handled/reraised to be handled 
- --            by the caller.
- --         3) raised in the entry body and propagated directly to the calling 
- --            procedure. 
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CB20004_0 is               -- Package Buffer.
- 
-    Max_Buffer_Size       : constant := 2;
- 
-    Handled_In_Body,
-    Propagated_To_Caller,
-    Handled_In_Caller     : Boolean := False;
- 
-    Data_Over_5,
-    Data_Degradation      : exception;
- 
-    type Data_Item is range 0 .. 100;
- 
-    type Item_Array_Type is array (1 .. Max_Buffer_Size) of Data_Item;
- 
-    protected type Bounded_Buffer is
-       entry Put (Item : in     Data_Item);
-       entry Get (Item :    out Data_Item);
-    private
-       Item_Array : Item_Array_Type;
-       I, J       : Integer range 1 .. Max_Buffer_Size := 1;
-       Count      : Integer range 0 .. Max_Buffer_Size := 0;
-    end Bounded_Buffer;
- 
- end CB20004_0;
- 
-      --=================================================================--
- 
- with Report;
- 
- package body CB20004_0 is               -- Package Buffer.
- 
-    protected body Bounded_Buffer is
- 
-       entry Put (Item : in Data_Item) when Count < Max_Buffer_Size is
-       begin
-          if Item > 10 then
-             Item_Array (I) := Item * 8;  -- Constraint_Error will be raised
-          elsif Item > 5 then             -- and handled in entry body.
-             raise Data_Over_5;           -- Exception  handled/reraised in
-          else                            -- entry body, propagated to caller.
-             Item_Array (I) := Item;      -- Store data item in buffer.
-             I := (I mod Max_Buffer_Size) + 1;
-             Count := Count + 1;
-          end if;
-       exception
-          when Constraint_Error =>
-             Handled_In_Body := True;
-          when Data_Over_5 =>
-             Propagated_To_Caller := True;
-             raise;    -- Propagate the exception to the caller.
-       end Put;
- 
- 
-       entry Get (Item : out Data_Item) when Count > 0 is
-       begin
-          Item := Item_Array(J);
-          J := (J mod Max_Buffer_Size) + 1;
-          Count := Count - 1;
-          if Count = 0 then
-             raise Data_Degradation;   -- Exception to propagate to caller.
-          end if;
-       end Get;
- 
-    end Bounded_Buffer;
- 
- end CB20004_0;
- 
- 
-      --=================================================================--
- 
- 
- with CB20004_0;                   -- Package Buffer.
- with Report;
- 
- procedure CB20004 is
- 
-    package Buffer renames CB20004_0;
- 
-    Data        : Buffer.Data_Item := Buffer.Data_Item'First;
-    Data_Buffer : Buffer.Bounded_Buffer;   -- an object of protected type.
- 
-    Handled_In_Caller : Boolean := False;  -- same name as boolean declared 
-                                           -- in package Buffer.
- begin
- 
-    Report.Test ("CB20004", "Check that exceptions propagate correctly " &
-                            "from objects of protected types" );
- 
-    Initial_Data_Block:
-    begin                                    -- Data causes Constraint_Error.
-       Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(51)));
- 
-    exception                                  
-       when Constraint_Error => 
-          Buffer.Handled_In_Body := False;     -- Improper exception handling
-                                               -- in entry body.
-          Report.Failed ("Exception propagated to caller " &
-                         " from Initial_Data_Block");
-       when others =>
-          Report.Failed ("Exception raised in processing and " &
-                         "propagated to caller from Initial_Data_Block");
-    end Initial_Data_Block;
- 
- 
-    Data_Entry_Block:
-    begin
-                                               -- Valid data. No exception.
-       Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(3)));  
- 
-                                               -- Data will cause exception.
-       Data_Buffer.Put (7);                    -- Call protected object entry, 
-                                               -- exception to be handled/
-                                               -- reraised in entry body.
-       Report.Failed ("Data_Over_5 Exception not raised in processing");
-    exception
-       when Buffer.Data_Over_5 =>
-          if Buffer.Propagated_To_Caller then   -- Reraised in entry body?
-             Buffer.Handled_In_Caller := True;
-          else
-             Report.Failed ("Exception not reraised in entry body");
-          end if;
-       when others =>
-          Report.Failed ("Exception raised in processing and propagated " &
-                         "to caller from Data_Entry_Block");
-    end Data_Entry_Block;
- 
- 
-    Data_Retrieval_Block:
-    begin
- 
-       Data_Buffer.Get (Data);  -- Retrieval of buffer data, buffer now empty.
-                                -- Exception will be raised in entry body, with
-                                -- propagation to caller.
-       Report.Failed ("Data_Degradation Exception not raised in processing");
-    exception
-       when Buffer.Data_Degradation =>
-          Handled_In_Caller := True;   -- Local Boolean used here.
-       when others =>
-          Report.Failed ("Exception raised in processing and propagated " &
-                         "to caller from Data_Retrieval_Block");
-    end Data_Retrieval_Block;
- 
- 
-    if not (Buffer.Handled_In_Body      and    -- Validate proper exception
-            Buffer.Propagated_To_Caller and    -- handling in entry bodies.
-            Buffer.Handled_In_Caller    and
-            Handled_In_Caller)
-    then
-       Report.Failed ("Improper exception handling by entry bodies");
-    end if;
- 
- 
-    Report.Result;
- 
- end CB20004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,210 ****
- -- CB20005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that exceptions are raised and properly handled locally in
- --      protected operations.
- --
- -- TEST DESCRIPTION:
- --      Declare a package with a protected type, including protected operation
- --      declarations and private data, simulating a counting semaphore.
- --      In the main procedure, perform calls on protected operations 
- --      of the protected object designed to induce the raising of exceptions.
- --
- --      Ensure that the exceptions are raised and handled locally in a 
- --      protected procedures and functions, and that in this case the 
- --      exceptions will not propagate to the calling unit.  Use specific 
- --      exception handlers in the protected functions.
- --
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CB20005_0 is               -- Package Semaphore.
- 
-    Handled_In_Function,
-    Handled_In_Procedure : Boolean := False;
- 
-    Resource_Overflow,
-    Resource_Underflow   : exception;
- 
-    protected type Counting_Semaphore (Max_Resources : Integer) is
-       procedure Secure;
-       function  Resource_Limit_Exceeded return Boolean;
-       procedure Release;
-    private
-       Count : Integer := Max_Resources;
-    end Counting_Semaphore;
- 
- end CB20005_0;
- 
-      --=================================================================--
- 
- with Report;
- 
- package body CB20005_0 is               -- Package Semaphore.
- 
-    protected body Counting_Semaphore is
- 
-       procedure Secure is
-       begin
-          if (Count = 0) then               -- No resources left to secure.
-             raise Resource_Underflow;      
-             Report.Failed 
-               ("Program control not transferred by raise in Secure");
-          else
-             Count := Count - 1;             -- Avail resources decremented.
-          end if;                          
-       exception
-          when Resource_Underflow =>         -- Exception handled locally in
-             Handled_In_Procedure := True;   -- this protected operation.
-          when others =>
-             Report.Failed ("Unexpected exception raised in Secure");
-       end Secure;
- 
- 
-       function Resource_Limit_Exceeded return Boolean is
-       begin
-          if (Count > Max_Resources) then   
-             raise Resource_Overflow;       -- Exception used as control flow
-                                            -- mechanism.
-             Report.Failed 
-               ("Program control not transferred by raise in " &
-                "Resource_Limit_Exceeded");
-          else                              
-             return (False);
-          end if;
-       exception
-          when Resource_Overflow =>         -- Handle its own raised
-             Handled_In_Function := True;   -- exception.
-             return (True);                 
-          when others =>
-             Report.Failed 
-               ("Unexpected exception raised in Resource_Limit_Exceeded");
-       end Resource_Limit_Exceeded;
- 
- 
-       procedure Release is
-       begin
-          Count := Count + 1;               -- Count of resources available 
-                                            -- incremented.
-          if Resource_Limit_Exceeded then   -- Call to protected operation
-             Count := Count - 1;            -- function that raises/handles
-          end if;                           -- an exception.
-       exception
-          when Resource_Overflow =>
-             Handled_In_Function := False;
-             Report.Failed ("Exception propagated to Function Release");
-          when others =>
-             Report.Failed ("Unexpected exception raised in Function Release");
-       end Release;
- 
- 
-    end Counting_Semaphore;
- 
- end CB20005_0;
- 
- 
-      --=================================================================--
- 
- 
- with CB20005_0;                           -- Package Semaphore.
- with Report;
- 
- procedure CB20005 is
- begin
- 
-    Report.Test ("CB20005", "Check that exceptions are raised and handled " &
-                            "correctly in protected operations" );
- 
-    Test_Block:
-    declare
- 
-       package Semaphore renames CB20005_0;
- 
-       Total_Resources_Available : constant := 1;
- 
-       Resources : Semaphore.Counting_Semaphore(Total_Resources_Available);
-                                           -- An object of protected type.
- 
-    begin
- 
-       Allocate_Resources:
-       declare
-          Loop_Count : Integer := Total_Resources_Available + 1;
-       begin
-          for I in 1..Loop_Count loop -- Force exception.
-             Resources.Secure;
-          end loop;
-       exception                                     
-          when Semaphore.Resource_Underflow =>
-             Semaphore.Handled_In_Procedure := False; -- Excptn not handled 
-             Report.Failed                            -- in prot. operation.
-               ("Resource_Underflow exception not handled " &
-                "in Allocate_Resources");
-          when others =>
-             Report.Failed 
-               ("Exception unexpectedly raised during resource allocation");
-       end Allocate_Resources;
- 
-    
-       Deallocate_Resources:
-       declare
-          Loop_Count : Integer := Total_Resources_Available + 1;
-       begin
-          for I in 1..Loop_Count loop -- Force excptn.
-             Resources.Release;  
-          end loop;
-       exception                                     
-          when Semaphore.Resource_Overflow =>
-             Semaphore.Handled_In_Function := False; -- Exception not handled
-                Report.Failed                        -- in prot. operation.
-                  ("Resource overflow not handled by function");
-             when others =>
-                Report.Failed 
-                  ("Exception raised during resource deallocation"); 
-       end Deallocate_Resources;
- 
- 
-       if not (Semaphore.Handled_In_Procedure and -- Incorrect excpt. handling
-               Semaphore.Handled_In_Function)     -- in protected operations.
-       then
-          Report.Failed 
-            ("Improper exception handling by protected operations");
-       end if;
- 
- 
-    exception
-       when others =>
-          Report.Failed ("Exception raised and propagated in test");
- 
-    end Test_Block;
- 
-    Report.Result;
- 
- end CB20005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,217 ****
- -- CB20006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that exceptions are raised and properly handled (including 
- --      propagation by reraise) in protected operations.
- --
- -- TEST DESCRIPTION:
- --      Declare a package with a protected type, including protected operation
- --      declarations and private data, simulating a counting semaphore.
- --      In the main procedure, perform calls on protected operations 
- --      of the protected object designed to induce the raising of exceptions.
- --
- --      The exceptions raised are to be initially handled in the protected
- --      operations, but this handling involves the reraise of the exception
- --      and the propagation of the exception to the caller.
- --
- --      Ensure that the exceptions are raised, handled / reraised successfully
- --      in protected procedures and functions.  Use "others" handlers in the
- --      protected operations.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CB20006_0 is               -- Package Semaphore.
- 
-    Reraised_In_Function,
-    Reraised_In_Procedure,
-    Handled_In_Function_Caller,
-    Handled_In_Procedure_Caller   : Boolean := False;
- 
-    Resource_Overflow,
-    Resource_Underflow            : exception;
- 
-    protected type Counting_Semaphore (Max_Resources : Integer) is
-       procedure Secure;
-       function  Resource_Limit_Exceeded return Boolean;
-       procedure Release;
-    private
-       Count : Integer := Max_Resources;
-    end Counting_Semaphore;
- 
- end CB20006_0;
- 
-      --=================================================================--
- 
- with Report;
- 
- package body CB20006_0 is                 -- Package Semaphore.
- 
-    protected body Counting_Semaphore is
- 
-       procedure Secure is
-       begin
-          if (Count = 0) then              -- No resources left to secure.
-             raise Resource_Underflow;      
-             Report.Failed 
-               ("Program control not transferred by raise in Procedure Secure");
-          else
-             Count := Count - 1;           -- Available resources decremented.
-          end if;                          
-       exception
-          when Resource_Underflow =>
-             Reraised_In_Procedure := True; 
-             raise;                        -- Exception propagated to caller.
-             Report.Failed ("Exception not propagated to caller from Secure");
-          when others =>
-             Report.Failed ("Unexpected exception raised in Secure");
-       end Secure;
- 
- 
-       function Resource_Limit_Exceeded return Boolean is
-       begin
-          if (Count > Max_Resources) then   
-             raise Resource_Overflow;      -- Exception used as control flow
-                                           -- mechanism.
-             Report.Failed 
-               ("Specific raise did not alter program control" &
-                " from Resource_Limit_Exceeded");
-          else                              
-             return (False);
-          end if;
-       exception
-          when others =>
-             Reraised_In_Function := True; 
-             raise;                         -- Exception propagated to caller.
-             Report.Failed ("Exception not propagated to caller" & 
-                            " from Resource_Limit_Exceeded");
-       end Resource_Limit_Exceeded;
- 
- 
-       procedure Release is
-       begin
-          Count := Count + 1;               -- Count of resources available 
-                                            -- incremented.
-          if Resource_Limit_Exceeded then   -- Call to protected operation
-             Count := Count - 1;            -- function that raises/reraises
-                                            -- an exception.
-             Report.Failed("Resource limit exceeded");
-          end if;                          
- 
-       exception
-          when others =>
-             raise;                         -- Reraised and propagated again.
-              Report.Failed ("Exception not reraised by procedure Release");
-       end Release;
- 
- 
-    end Counting_Semaphore;
- 
- end CB20006_0;
- 
- 
-      --=================================================================--
- 
- 
- with CB20006_0;                           -- Package Semaphore.
- with Report;
- 
- procedure CB20006 is
- begin
- 
-    Report.Test ("CB20006", "Check that exceptions are raised and " &
-                            "handled / reraised and propagated "    &
-                            "correctly by protected operations" );
- 
-    Test_Block:
-    declare
- 
-       package Semaphore renames CB20006_0;
- 
-       Total_Resources_Available : constant := 1;
- 
-       Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);
-                                              -- An object of protected type.
- 
-    begin
- 
-       Allocate_Resources:
-       declare
-          Loop_Count : Integer := Total_Resources_Available + 1;
-       begin
-          for I in 1..Loop_Count loop -- Force exception
-             Resources.Secure;
-          end loop;
-          Report.Failed 
-            ("Exception not propagated from protected operation Secure");
-       exception                                     
-          when Semaphore.Resource_Underflow =>        -- Exception propagated
-            Semaphore.Handled_In_Procedure_Caller := True;  -- from protected
-          when others =>                                    -- procedure.
-            Semaphore.Handled_In_Procedure_Caller := False;
-       end Allocate_Resources;
- 
-    
-       Deallocate_Resources:
-       declare
-          Loop_Count : Integer := Total_Resources_Available + 1;
-       begin
-          for I in 1..Loop_Count loop -- Force exception
-             Resources.Release;  
-          end loop;
-          Report.Failed 
-            ("Exception not propagated from protected operation Release");
-       exception                                     
-          when Semaphore.Resource_Overflow =>        -- Exception propagated 
-             Semaphore.Handled_In_Function_Caller := True; -- from protected
-          when others =>                                   -- function.
-             Semaphore.Handled_In_Function_Caller := False;
-       end Deallocate_Resources;
- 
- 
-       if not (Semaphore.Reraised_In_Procedure and
-               Semaphore.Reraised_In_Function  and
-               Semaphore.Handled_In_Procedure_Caller and
-               Semaphore.Handled_In_Function_Caller) 
-       then                                       -- Incorrect excpt. handling
-          Report.Failed                           -- in protected operations.
-            ("Improper exception handling/reraising by protected operations");
-       end if;
- 
-    exception
- 
-       when others =>
-          Report.Failed ("Unexpected exception " & 
-                         " raised and propagated in test");
-    end Test_Block;
- 
-    Report.Result;
- 
- 
- end CB20006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- CB20007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that exceptions are raised and can be directly propagated to
- --      the calling unit by protected operations.
- --
- -- TEST DESCRIPTION:
- --      Declare a package with a protected type, including protected operation
- --      declarations and private data, simulating a counting semaphore.
- --      In the main procedure, perform calls on protected operations 
- --      of the protected object designed to induce the raising of exceptions.
- --
- --      The exceptions raised are to be propagated directly from the protected
- --      operations to the calling unit. 
- --
- --      Ensure that the exceptions are raised and correctly propagated directly
- --      to the calling unit from protected procedures and functions.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CB20007_0 is               -- Package Semaphore.
- 
-    Handled_In_Function_Caller,
-    Handled_In_Procedure_Caller : Boolean := False;
- 
-    Resource_Overflow,
-    Resource_Underflow          : exception;
- 
-    protected type Counting_Semaphore (Max_Resources : Integer) is
-       procedure Secure;
-       function  Resource_Limit_Exceeded return Boolean;
-       procedure Release;
-    private
-       Count : Integer := Max_Resources;
-    end Counting_Semaphore;
- 
- end CB20007_0;
- 
-      --=================================================================--
- 
- with Report;
- 
- package body CB20007_0 is                  -- Package Semaphore.
- 
-    protected body Counting_Semaphore is
- 
-       procedure Secure is
-       begin
-          if (Count = 0) then               -- No resources left to secure.
-             raise Resource_Underflow;      
-             Report.Failed ("Program control not transferred by raise");
-          else
-             Count := Count - 1;            -- Available resources decremented.
-          end if;                          
-          -- No exception handlers here, direct propagation to calling unit.
-       end Secure;
- 
- 
-       function Resource_Limit_Exceeded return Boolean is
-       begin
-          if (Count > Max_Resources) then   
-             raise Resource_Overflow;       -- Exception used as control flow
-                                            -- mechanism.
-             Report.Failed ("Program control not transferred by raise");
-          else                              
-             return (False);
-          end if;
-          -- No exception handlers here, direct propagation to calling unit.
-       end Resource_Limit_Exceeded;
- 
- 
-       procedure Release is
-       begin
-          Count := Count + 1;               -- Count of resources available 
-                                            -- incremented.
-          if Resource_Limit_Exceeded then   -- Call to protected operation
-             Count := Count - 1;            -- function that raises an
-                                            -- exception.
-             Report.Failed("Resource limit exceeded");
-          end if;                           
-          -- No exception handler here for exception raised in function.
-          -- Exception will propagate directly to calling unit.
-       end Release;
- 
- 
-    end Counting_Semaphore;
- 
- end CB20007_0;
- 
- 
-      --=================================================================--
- 
- 
- with CB20007_0;                           -- Package Semaphore.
- with Report;
- 
- procedure CB20007 is
- begin
- 
-    Test_Block:
-    declare
- 
-       package Semaphore renames CB20007_0;
- 
-       Total_Resources_Available : constant := 1;
- 
-       Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);
-                                              -- An object of protected type.
- 
-    begin
- 
-       Report.Test ("CB20007", "Check that exceptions are raised and can "   &
-                               "be directly propagated to the calling unit " &
-                               "by protected operations" );
- 
-       Allocate_Resources:
-       declare
-          Loop_Count : Integer := Total_Resources_Available + 1;
-       begin                                   -- Force exception.
-          for I in 1..Loop_Count loop  
-             Resources.Secure;
-          end loop;
-          Report.Failed ("Exception not propagated from protected " &
-                         " operation in Allocate_Resources");
-       exception                                     
-          when Semaphore.Resource_Underflow =>              -- Exception prop.
-             Semaphore.Handled_In_Procedure_Caller := True; -- from protected
-                                                            -- procedure.
-          when others =>
-             Report.Failed ("Unknown exception during resource allocation");
-       end Allocate_Resources;
- 
-    
-       Deallocate_Resources:
-       declare
-          Loop_Count : Integer := Total_Resources_Available + 1;
-       begin                                   -- Force exception.
-          for I in 1..Loop_Count loop  
-             Resources.Release;  
-          end loop;
-          Report.Failed ("Exception not propagated from protected " &
-                         "operation in Deallocate_Resources");
-       exception                                     
-          when Semaphore.Resource_Overflow =>              -- Exception prop
-             Semaphore.Handled_In_Function_Caller := True; -- from protected
-                                                           -- function.
-          when others =>
-             Report.Failed ("Exception raised during resource deallocation");
-       end Deallocate_Resources;
- 
- 
-       if not (Semaphore.Handled_In_Procedure_Caller and -- Incorrect exception
-               Semaphore.Handled_In_Function_Caller)     -- handling in
-       then                                              -- protected ops.
-           Report.Failed                                 
-             ("Improper exception propagation by protected operations");
-       end if;
- 
-    exception
- 
-       when others =>
-          Report.Failed ("Unexpected exception " &
-                         " raised and propagated in test");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CB20007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,245 ****
- -- CB2004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A PREDEFINED OR A PROGRAMMER DEFINED EXCEPTION
- --    RAISED SEVERAL LEVELS INSIDE A HIERARCHY OF NESTED BLOCKS
- --    CAN BE SUCCESSFULLY HANDLED IN AN OUTER BLOCK.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- DCB 5/12/80
- -- JRK 11/17/80
- -- SPS 11/2/82
- -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT;
- PROCEDURE CB2004A IS
- 
-      USE REPORT;
- 
-      FLOW_COUNT : INTEGER := 0;
- 
-      E1, E2, E3 : EXCEPTION;
- 
- BEGIN
-      TEST("CB2004A","CHECK THAT EXCEPTIONS RAISED INSIDE NESTED " &
-           "BLOCKS CAN BE HANDLED IN OUTER BLOCKS");
- 
-      BEGIN
- 
-           -- PROGRAMMER-DEFINED EXCEPTION, SINGLE EXCEPTON_CHOICE.
- 
-           BEGIN
-                BEGIN
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE E1;
-                          FAILED("PROGRAMMER-DEFINED EXCEPTION " &
-                                 "NOT RAISED  #1");
- 
-                     EXCEPTION
-                          WHEN E2 | E3 =>
-                               FAILED("WRONG PROGRAMMER-" &
-                                      "DEFINED EXCEPTION HANDLED   #1");
-                     END;
- 
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR |
-                          PROGRAM_ERROR | STORAGE_ERROR |
-                          TASKING_ERROR | E2 | E3     =>
-                          FAILED("WRONG  " &
-                                 "EXCEPTION HANDLED   #1");
-                END;
- 
-           EXCEPTION
-                WHEN E1 =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-           END;
- 
-           -- PROGRAMMER-DEFINED EXCEPTION, MULTIPLE EXCEPTION_CHOICES.
- 
-           BEGIN
-                BEGIN
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE E2;
-                          FAILED("PROGRAMMER-DEFINED EXCEPTION " &
-                                 "NOT RAISED  #2");
- 
-                     EXCEPTION
-                          WHEN E1 | E3 =>
-                               FAILED("WRONG PROGRAMMER-" &
-                                      "DEFINED EXCEPTION HANDLED   #2");
-                     END;
- 
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR |
-                          PROGRAM_ERROR | STORAGE_ERROR |
-                          TASKING_ERROR | E1 | E3     =>
-                          FAILED("WRONG  " &
-                                 "EXCEPTION HANDLED   #2");
-                END;
- 
-           EXCEPTION
-                WHEN E3 =>
-                     FAILED("WRONG EXCEPTION HANDLED  #2A");
-                WHEN E1 | E2 | CONSTRAINT_ERROR =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-           END;
- 
-           -- PROGRAMMER-DEFINED EXCEPTION, 'OTHERS' CHOICE.
- 
-           BEGIN
-                BEGIN
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE E1;
-                          FAILED("PROGRAMMER-DEFINED EXCEPTION " &
-                                 "NOT RAISED  #3");
- 
-                     EXCEPTION
-                          WHEN E2 | E3 =>
-                               FAILED("WRONG PROGRAMMER-" &
-                                      "DEFINED EXCEPTION HANDLED   #3");
-                     END;
- 
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR |
-                          PROGRAM_ERROR | STORAGE_ERROR |
-                          TASKING_ERROR | E2 | E3   =>
-                          FAILED("WRONG " &
-                                 "EXCEPTION HANDLED   #3");
-                END;
- 
-           EXCEPTION
-                WHEN E2 | CONSTRAINT_ERROR =>
-                     FAILED("WRONG EXCEPTION HANDLED  #3A");
-                WHEN OTHERS =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-           END;
- 
-           -- PREDEFINED EXCEPTION, SINGLE EXCEPTION_CHOICE.
- 
-           BEGIN
-                BEGIN
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE CONSTRAINT_ERROR;
-                          FAILED("PREDEFINED EXCEPTION NOT RAISED  #4");
- 
-                     EXCEPTION
-                          WHEN E1 | E2 | E3 =>
-                               FAILED("WRONG " &
-                                      "EXCEPTION HANDLED   #4");
-                     END;
- 
-                EXCEPTION
-                     WHEN PROGRAM_ERROR | STORAGE_ERROR |
-                          TASKING_ERROR     =>
-                          FAILED("WRONG PREDEFINED " &
-                                 "EXCEPTION HANDLED   #4");
-                END;
- 
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-           END;
- 
-           -- PREDEFINED EXCEPTION, MULTIPLE EXCEPTION_CHOICES.
- 
-           BEGIN
-                BEGIN
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE CONSTRAINT_ERROR;
-                          FAILED("PREDEFINED EXCEPTION NOT RAISED  #5");
- 
-                     EXCEPTION
-                          WHEN E1 | E2 | E3 =>
-                               FAILED("WRONG " &
-                                      "EXCEPTION HANDLED   #5");
-                     END;
- 
-                EXCEPTION
-                     WHEN PROGRAM_ERROR | 
-                          STORAGE_ERROR | TASKING_ERROR     =>
-                          FAILED("WRONG PREDEFINED " &
-                                 "EXCEPTION HANDLED   #5");
-                END;
- 
-           EXCEPTION
-                WHEN E1 | E2 =>
-                     FAILED("WRONG EXCEPTION HANDLED  #5A");
-                WHEN CONSTRAINT_ERROR | E3 =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-           END;
- 
-           -- PREDEFINED EXCEPTION, 'OTHERS' CHOICE.
- 
-           BEGIN
-                BEGIN
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE CONSTRAINT_ERROR;
-                          FAILED("PREDEFINED EXCEPTION NOT RAISED  #6");
- 
-                     EXCEPTION
-                          WHEN E1 | E2 | E3 =>
-                               FAILED("WRONG " &
-                                      " EXCEPTION HANDLED   #6");
-                     END;
- 
-                EXCEPTION
-                     WHEN PROGRAM_ERROR | STORAGE_ERROR |
-                          TASKING_ERROR     =>
-                          FAILED("WRONG PREDEFINED " &
-                                 "EXCEPTION HANDLED   #6");
-                END;
- 
-           EXCEPTION
-                WHEN E1 =>
-                     FAILED("WRONG EXCEPTION HANDLED  #6A");
-                WHEN OTHERS =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-           END;
- 
-      EXCEPTION
-           WHEN E1 | E2 | E3 =>
-                FAILED("PROGRAMMER-DEFINED EXCEPTION HANDLED IN" &
-                       "WRONG SCOPE");
-           WHEN CONSTRAINT_ERROR =>
-                FAILED("CONSTRAINT_ERROR HANDLED IN WRONG SCOPE");
-           WHEN OTHERS =>
-                FAILED("OTHER EXCEPTIONS HANDLED IN WRONG SCOPE");
-      END;
- 
-      IF FLOW_COUNT /= 12 THEN
-           FAILED("INCORRECT FLOW_COUNT VALUE");
-      END IF;
- 
-      RESULT;
- END CB2004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CB2005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A RETURN STATEMENT CAN APPEAR IN AN EXCEPTION HANDLER
- -- AND IT CAUSES CONTROL TO LEAVE THE SUBPROGRAM, FOR BOTH
- -- FUNCTIONS AND PROCEDURES.
- 
- -- DAT 4/13/81
- -- JRK 4/24/81
- -- SPS 10/26/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB2005A IS
- 
-      I : INTEGER RANGE 0 .. 1;
- 
-      FUNCTION SETI RETURN INTEGER IS
-      BEGIN
-           I := I + 1;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 1");
-           RETURN 0;
-      EXCEPTION
-           WHEN OTHERS =>
-                RETURN I;
-                FAILED ("FUNCTION RETURN STMT DID NOT RETURN");
-                RETURN 0;
-      END SETI;
- 
-      PROCEDURE ISET IS
-      BEGIN
-           I := 2;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 2");
-           I := 0;
-      EXCEPTION
-           WHEN OTHERS => 
-                RETURN;
-                FAILED ("PROCEDURE RETURN STMT DID NOT RETURN");
-      END ISET;
- 
- BEGIN
-      TEST ("CB2005A", "RETURN IN EXCEPTION HANDLERS");
- 
-      I := 1;
-      IF SETI /= 1 THEN
-           FAILED ("WRONG VALUE RETURNED 1");
-      END IF;
- 
-      I := 1;
-      ISET;
-      IF I /= 1 THEN
-           FAILED ("WRONG VALUE RETURNED 2");
-      END IF;
- 
-      RESULT;
- END CB2005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- CB2006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT LOCAL VARIABLES AND PARAMETERS OF A SUBPROGRAM,
- -- OR PACKAGE ARE ACCESSIBLE WITHIN A HANDLER.
- 
- -- DAT 4/13/81
- -- SPS 3/23/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB2006A IS
- 
-      I : INTEGER RANGE 0 .. 1;
- 
-      PACKAGE P IS
-           V2 : INTEGER := 2;
-      END P;
- 
-      PROCEDURE PR (J : IN OUT INTEGER) IS
-           K : INTEGER := J;
-      BEGIN
-           I := K;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 1");
-      EXCEPTION
-           WHEN OTHERS =>
-                J := K + 1;
-      END PR;
- 
-      PACKAGE BODY P IS
-           L : INTEGER := 2;
-      BEGIN
-           TEST ("CB2006A", "LOCAL VARIABLES ARE ACCESSIBLE IN"
-                & " HANDLERS");
- 
-           I := 1;
-           I := I + 1;
-           FAILED ("CONSTRAINT_ERROR NOT RAISED 2");
-      EXCEPTION
-           WHEN OTHERS =>
-                PR (L);
-                IF L /= V2 + 1 THEN
-                     FAILED ("WRONG VALUE IN LOCAL VARIABLE");
-                END IF;
-      END P;
- BEGIN
- 
-      RESULT;
- END CB2006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb2007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb2007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- CB2007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXIT STATEMENT IN A HANDLER CAN TRANSFER CONTROL
- -- OUT OF A LOOP.
- 
- -- DAT 4/13/81
- --  RM 4/30/81
- -- SPS 3/23/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB2007A IS
- BEGIN
-      TEST ("CB2007A", "EXIT STATEMENTS IN EXCEPTION HANDLERS");
- 
-      DECLARE
-           FLOW_INDEX : INTEGER := 0 ;
-      BEGIN
- 
-           FOR I IN 1 .. 10 LOOP
-                BEGIN
-                     IF I = 1 THEN
-                          RAISE CONSTRAINT_ERROR;
-                     END IF;
-                     FAILED ("WRONG CONTROL FLOW 1");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR => EXIT;
-                END;
-                FAILED ("WRONG CONTROL FLOW 2");
-                EXIT;
-           END LOOP;
- 
-           FOR AAA IN 1..1 LOOP
-                FOR BBB IN 1..1 LOOP
-                     FOR I IN 1 .. 10 LOOP
-                          BEGIN
-                               IF I = 1 THEN
-                                    RAISE CONSTRAINT_ERROR;
-                               END IF;
-                               FAILED ("WRONG CONTROL FLOW A1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR => EXIT;
-                          END;
-                          FAILED ("WRONG CONTROL FLOW A2");
-                          EXIT;
-                     END LOOP;
- 
-                     FLOW_INDEX := FLOW_INDEX + 1 ;
-                END LOOP;
-           END LOOP;
- 
-           LOOP1 :
-           FOR AAA IN 1..1 LOOP
-                LOOP2 :
-                FOR BBB IN 1..1 LOOP
-                     LOOP3 :
-                     FOR I IN 1 .. 10 LOOP
-                          BEGIN
-                               IF I = 1 THEN
-                                    RAISE CONSTRAINT_ERROR;
-                               END IF;
-                               FAILED ("WRONG CONTROL FLOW B1");
-                          EXCEPTION
-                               WHEN CONSTRAINT_ERROR => EXIT LOOP2 ;
-                          END;
-                          FAILED ("WRONG CONTROL FLOW B2");
-                          EXIT LOOP2 ;
-                     END LOOP  LOOP3 ;
- 
-                     FAILED ("WRONG CONTROL FLOW B3");
-                END LOOP  LOOP2 ;
- 
-                FLOW_INDEX := FLOW_INDEX + 1 ;
-           END LOOP  LOOP1 ;
- 
-           IF  FLOW_INDEX /= 2  THEN  FAILED( "WRONG FLOW OF CONTROL" );
-           END IF;
- 
-      END ;
- 
-      RESULT;
- END CB2007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb20a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb20a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- CB20A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the name and pertinent information about a user defined
- --      exception are available to an enclosing program unit even when the 
- --      enclosing unit has no visibility into the scope where the exception
- --      is declared and raised.
- --
- -- TEST DESCRIPTION:
- --      Declare a subprogram nested within the test subprogram.  The enclosing 
- --      subprogram does not have visibility into the nested subprogram.
- --      Declare and raise an exception in the nested subprogram, and allow
- --      the exception to propagate to the enclosing scope.  Use the function
- --      Exception_Name in the enclosing subprogram to produce exception 
- --      specific information when the exception is handled in an others 
- --      handler.
- --
- -- TEST FILES:
- --
- --      This test depends on the following foundation code file:
- --         FB20A00.A
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FB20A00;             -- Package containing Function Find
- with Ada.Exceptions;
- with Report;
- 
- procedure CB20A02 is
- 
-    Seed_Number   : Integer;
-    Random_Number : Integer := 0;
- 
-      --=================================================================--
- 
-    function Random_Number_Generator (Seed : Integer) return Integer is
- 
-       Result : Integer := 0;
- 
-       HighSeedError,
-       Mid_Seed_Error,
-       L_o_w_S_e_e_d_E_r_r_o_r : exception;
- 
-    begin  -- Random_Number_Generator
- 
- 
-       if (Report.Ident_Int (Seed)    > 1000) then
-          raise HighSeedError;
-       elsif (Report.Ident_Int (Seed) >  100) then
-          raise Mid_Seed_Error;
-       elsif (Report.Ident_Int (Seed) >   10) then
-          raise L_o_w_S_e_e_d_E_r_r_o_r;
-       else
-          Seed_Number := ((Seed_Number * 417) + 231) mod 53;
-          Result := Seed_Number / 52;
-       end if;
- 
-       return Result;
- 
-    end Random_Number_Generator;
- 
-      --=================================================================--
- 
- begin
- 
-    Report.Test ("CB20A02", "Check that the name "                        &
-                            "of a user defined exception is available "   &
-                            "to an enclosing program unit even when the " &
-                            "enclosing unit has no visibility into the "  &
-                            "scope where the exception is declared and "  &
-                            "raised" );
- 
-    High_Seed:
-    begin
-       -- This seed value will result in the raising of a HighSeedError
-       -- exception.
-       Seed_Number   := 1001;
-       Random_Number := Random_Number_Generator (Seed_Number);
-       Report.Failed ("Exception not raised in High_Seed block");
-    exception
-       when Error : others =>
-          if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
-                               "HighSeedError")
-          then
-             Report.Failed ("Expected HighSeedError, but found " &
-                             Ada.Exceptions.Exception_Name (Error));
-          end if;
-    end High_Seed;
- 
- 
-    Mid_Seed:
-    begin        
-       -- This seed value will generate a Mid_Seed_Error exception.
-       Seed_Number   := 101;
-       Random_Number := Random_Number_Generator (Seed_Number);
-       Report.Failed ("Exception not raised in Mid_Seed block");
-    exception
-       when Error : others =>
-          if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
-                               "Mid_Seed_Error")
-          then
-             Report.Failed ("Expected Mid_Seed_Error, but found " &
-                             Ada.Exceptions.Exception_Name (Error));
-          end if;
-    end Mid_Seed;
- 
- 
-    Low_Seed:
-    begin
-       -- This seed value will result in the raising of a
-       -- L_o_w_S_e_e_d_E_r_r_o_r exception.
-       Seed_Number   := 11;
-       Random_Number := Random_Number_Generator (Seed_Number);
-       Report.Failed ("Exception not raised in Low_Seed block");
-    exception
-       when Error : others =>
-          if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
-                               "L_o_w_S_e_e_d_E_r_r_o_r")
-          then
-             Report.Failed ("Expected L_o_w_S_e_e_d_E_r_r_o_r but found " &
-                             Ada.Exceptions.Exception_Name (Error));
-          end if;
-    end Low_Seed;
- 
- 
-    Report.Result;
- 
- end CB20A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb3003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb3003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb3003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb3003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- CB3003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NON-SPECIFIC RAISE STATEMENT PROPAGATES THE EXCEPTION
- --    FOR FURTHER PROCESSING(HANDLING) IN ANOTHER HANDLER.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- DCB 04/01/80
- -- JRK 11/19/80
- -- SPS 11/2/82
- -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT;
- PROCEDURE CB3003A IS
- 
-      USE REPORT;
- 
-      FLOW_COUNT : INTEGER := 0;
-      E1,E2 : EXCEPTION;
- 
- BEGIN
-      TEST("CB3003A","CHECK THAT THE NON-SPECIFIC RAISE STATEMENT" &
-           " PROPAGATES THE ERROR FOR FURTHER HANDLING IN ANOTHER" &
-           " HANDLER");
- 
-      -------------------------------------------------------
- 
-      BEGIN
-           BEGIN
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                     RAISE E1;
-                     FAILED("EXCEPTION NOT RAISED (CASE 1)");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE;
-                          FAILED("EXCEPTION NOT RERAISED (CASE 1; " &
-                                 "INNER)");
-                END;
- 
-           EXCEPTION
-           -- A HANDLER SPECIFIC TO THE RAISED EXCEPTION (E1).
-                WHEN E1 =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                     RAISE;
-                     FAILED("EXCEPTION NOT RERAISED (CASE 1; OUTER)");
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED (CASE 1)");
-           END;
- 
-      EXCEPTION
-           WHEN E1 =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION PASSED (CASE 1)");
-      END;
- 
-      -------------------------------------------------------
- 
-      BEGIN
-           BEGIN
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                     RAISE E1;
-                     FAILED("EXCEPTION NOT RAISED (CASE 2)");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE;
-                          FAILED("EXCEPTION NOT RERAISED (CASE 2; " &
-                                 "INNER)");
-                END;
- 
-           EXCEPTION
-           -- A HANDLER FOR SEVERAL EXCEPTIONS INCLUDING THE ONE RAISED.
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED("WRONG EXCEPTION RAISED (CONSTRAINT_ERROR)");
-                WHEN E2 =>
-                     FAILED("WRONG EXCEPTION RAISED (E2)");
-                WHEN PROGRAM_ERROR | E1 | TASKING_ERROR =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                     RAISE;
-                     FAILED("EXCEPTION NOT RERAISED (CASE 2; OUTER)");
-                WHEN STORAGE_ERROR =>
-                     FAILED("WRONG EXCEPTION RAISED (STORAGE_ERROR)");
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED (OTHERS)");
-           END;
- 
-      EXCEPTION
-           WHEN E1 =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION PASSED (CASE 2)");
-      END;
- 
-      -------------------------------------------------------
- 
-      BEGIN
-           BEGIN
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                     RAISE E1;
-                     FAILED("EXCEPTION NOT RAISED (CASE 3)");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE;
-                          FAILED("EXCEPTION NOT RERAISED (CASE 3; " &
-                                 "INNER)");
-                END;
- 
-           EXCEPTION
-           -- A NON-SPECIFIC HANDLER.
-                WHEN CONSTRAINT_ERROR | E2 =>
-                     FAILED("WRONG EXCEPTION RAISED " &
-                            "(CONSTRAINT_ERROR | E2)");
-                WHEN OTHERS =>
-                     FLOW_COUNT := FLOW_COUNT + 1;
-                     RAISE;
-                     FAILED("EXCEPTION NOT RERAISED (CASE 3; OUTER)");
-           END;
- 
-      EXCEPTION
-           WHEN E1 =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION PASSED (CASE 3)");
-      END;
- 
-      -------------------------------------------------------
- 
-      IF FLOW_COUNT /= 12 THEN
-           FAILED("INCORRECT FLOW_COUNT VALUE");
-      END IF;
- 
-      RESULT;
- END CB3003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb3003b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb3003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb3003b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb3003b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- CB3003B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A NON-EXPLICIT RAISE STATEMENT MAY APPEAR IN A BLOCK
- -- STATEMENT WITHIN AN EXCEPTION HANDLER; IF THE BLOCK STATEMENT
- -- INCLUDES A HANDLER FOR THE CURRENT EXCEPTION, THEN THE INNER
- -- HANDLER RECEIVES CONTROL.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- L.BROWN  10/08/86
- -- MRM  03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  CB3003B  IS
- 
-      MY_ERROR : EXCEPTION;
- 
- BEGIN
-      TEST("CB3003B","A NON-EXPLICIT RAISE STATEMENT MAY APPEAR IN A "&
-                     "BLOCK STATEMENT WITHIN AN EXCEPTION HANDLER");
- 
-      BEGIN
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RAISE MY_ERROR;
-                END IF;
-                FAILED("MY_ERROR WAS NOT RAISED 1");
-           EXCEPTION
-                WHEN MY_ERROR =>
-                     BEGIN
-                          IF EQUAL(3,3) THEN
-                               RAISE;
-                          END IF;
-                          FAILED("MY_ERROR WAS NOT RAISED 2");
-                     EXCEPTION
-                          WHEN MY_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("WRONG EXCEPTION RAISED 1");
-                     END;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED 2");
-           END;
-      EXCEPTION
-           WHEN MY_ERROR =>
-                FAILED("CONTROL PASSED TO OUTER HANDLER 1");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED 1");
-      END;
- 
-      BEGIN
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RAISE MY_ERROR;
-                END IF;
-                FAILED("MY_ERROR WAS NOT RAISED 3");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR | MY_ERROR | TASKING_ERROR =>
-                     BEGIN
-                          IF EQUAL(3,3) THEN
-                               RAISE;
-                          END IF;
-                          FAILED("MY_ERROR WAS NOT RAISED 4");
-                     EXCEPTION
-                          WHEN MY_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("WRONG EXCEPTION RAISED 3");
-                     END;
-                WHEN OTHERS =>
-                     FAILED("WRONG EXCEPTION RAISED 4");
-           END;
-      EXCEPTION
-           WHEN MY_ERROR =>
-                FAILED("CONTROL PASSED TO OUTER HANDLER 2");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED 2");
-      END;
- 
-      BEGIN
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RAISE MY_ERROR;
-                END IF;
-                FAILED("MY_ERROR WAS NOT RAISED 5");
-           EXCEPTION
-                WHEN OTHERS =>
-                     BEGIN
-                          IF EQUAL(3,3) THEN
-                               RAISE;
-                          END IF;
-                          FAILED("MY_ERROR WAS NOT RAISED 6");
-                     EXCEPTION
-                          WHEN MY_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("WRONG EXCEPTION RAISED 5");
-                     END;
-           END;
-      EXCEPTION
-           WHEN MY_ERROR =>
-                FAILED("CONTROL PASSED TO OUTER HANDLER 3");
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION RAISED 3");
-      END;
- 
-      RESULT;
- 
- END CB3003B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb3004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb3004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb3004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb3004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- CB3004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN AN INNER UNIT REDECLARES AN EXCEPTION NAME
- --    THE HIDDEN DEFINITION IS STILL AVAILABLE FOR USE.
- 
- --  NOTE : WE ASSUME FUNCTIONS ACT LIKE PROCEDURES AND
- --  THAT UNITS, BLOCKS, AND PROCEDURES ACT THE SAME
- --  IN OTHER CONTEXTS (E.G. TASKS AND PACKAGES).
- 
- -- DCB 6/2/80
- -- JRK 11/19/80
- -- SPS 3/24/83
- 
- WITH REPORT;
- PROCEDURE CB3004A IS
- 
-      USE REPORT;
- 
-      E1 : EXCEPTION;
-      FLOW_COUNT : INTEGER := 0;
- 
-      PROCEDURE P1 IS
-           E1, E2 : EXCEPTION;
- 
-           PROCEDURE P2 IS
-                E1 : EXCEPTION;
-           BEGIN
-                FLOW_COUNT := FLOW_COUNT + 1;
-                RAISE E1;
-                FAILED("E1 EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN P1.E1 =>
-                     FAILED("P1.E1 EXCEPTION RAISED WHEN " &
-                            "(P2)E1 EXPECTED");
-                WHEN E1 =>
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE P1.E1;
-                          FAILED("P1.E1 EXCEPTION NOT RAISED");
-                     EXCEPTION
-                          WHEN E1 =>
-                               FAILED("(P2)E1 EXCEPTION RAISED WHEN" &
-                                      " P1.E1 EXPECTED");
-                          WHEN P1.E1 =>
-                               FLOW_COUNT := FLOW_COUNT + 1;
-                          WHEN OTHERS =>
-                               FAILED("OTHERS RAISED WHEN P1.E1 " &
-                                      "EXPECTED");
-                     END;
-                WHEN OTHERS =>
-                     FAILED("OTHERS RAISED WHEN (P2)E1 EXPECTED");
-           END P2;
- 
-           PROCEDURE P3 IS
-                CONSTRAINT_ERROR : EXCEPTION;
-           BEGIN
-                FLOW_COUNT := FLOW_COUNT + 1;
-                RAISE CONSTRAINT_ERROR;
-                FAILED("CONSTRAINT_ERROR EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN STANDARD.CONSTRAINT_ERROR =>
-                     FAILED("STANDARD.CONSTRAINT_ERROR EXCEPTION " &
-                            "RAISED WHEN " &
-                            "(P3)CONSTRAINT_ERROR EXPECTED");
-                WHEN CONSTRAINT_ERROR =>
-                     BEGIN
-                          FLOW_COUNT := FLOW_COUNT + 1;
-                          RAISE STANDARD.CONSTRAINT_ERROR;
-                          FAILED("STANDARD.CONSTRAINT_ERROR " &
-                                 "EXCEPTION NOT RAISED");
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED("(P3)CONSTRAINT_ERROR " &
-                                      "EXCEPTION RAISED WHEN " &
-                                      "STANDARD.CONSTRAINT_ERROR " &
-                                      "EXPECTED");
-                          WHEN STANDARD.CONSTRAINT_ERROR =>
-                               FLOW_COUNT := FLOW_COUNT + 1;
-                          WHEN OTHERS =>
-                                FAILED("OTHERS RAISED WHEN " &
-                                       "STANDARD.CONSTRAINT_ERROR " &
-                                       "EXPECTED");
-                     END;
-                WHEN OTHERS =>
-                     FAILED("OTHERS RAISED WHEN " &
-                            "(P3)CONSTRAINT_ERROR EXPECTED");
-           END P3;
- 
-           PROCEDURE P4 IS
-                E2 : EXCEPTION;
-           BEGIN
-                FLOW_COUNT := FLOW_COUNT + 1;
-                RAISE P1.E2;
-                FAILED("P1.E2 EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN E2 =>
-                     FAILED("(P4).E2 RAISED WHEN P1.E2 EXPECTED");
-           END P4;
- 
-      BEGIN  -- P1
-           P2;
-           P3;
-           P4;
-           FAILED("P1.E2 EXCEPTION NOT PROPAGATED FROM P4");
-      EXCEPTION
-           WHEN E2 =>
-                FLOW_COUNT := FLOW_COUNT + 1;
-           WHEN OTHERS =>
-                FAILED("EXCEPTION RAISED WHERE NONE EXPECTED");
-      END P1;
- 
- BEGIN
-      TEST("CB3004A","CHECK THAT WHEN EXCEPTION NAMES" &
-           " ARE REDECLARED THE HIDDEN DEFINITION IS STILL AVAILABLE");
- 
-      P1;
- 
-      IF FLOW_COUNT /= 8 THEN
-           FAILED("INCORRECT FLOW_COUNT VALUE");
-      END IF;
- 
-      RESULT;
- END CB3004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,339 ****
- -- CB40005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that exceptions raised in non-generic code can be handled by
- --      a procedure in a generic package.  Check that the exception identity
- --      can be properly retrieved from the generic code and used by the
- --      non-generic code.
- --
- -- TEST DESCRIPTION:
- --      This test models a possible usage paradigm for the type:
- --        Ada.Exceptions.Exception_Occurrence.
- --
- --      A generic package takes access to procedure types (allowing it to
- --      be used at any accessibility level) and defines a "fail soft"
- --      procedure that takes designators to a procedure to call, a
- --      procedure to call in the event that it fails, and a function to
- --      call to determine the next action.
- --
- --      In the event an exception occurs on the call to the first procedure,
- --      the exception is stored in a stack; along with the designator to the
- --      procedure that caused it; allowing the procedure to be called again, 
- --      or the exception to be re-raised.
- --
- --      A full implementation of such a tool would use a more robust storage
- --      mechanism, and would provide a more flexible interface.
- --
- --
- -- CHANGE HISTORY:
- --      29 MAR 96   SAIC   Initial version
- --      12 NOV 96   SAIC   Revised for 2.1 release
- --
- --!
- 
- ----------------------------------------------------------------- CB40005_0
- 
- with Ada.Exceptions;
- generic
-   type Proc_Pointer is access procedure;
-   type Func_Pointer is access function return Proc_Pointer;
- package CB40005_0 is -- Fail_Soft
- 
- 
-   procedure Fail_Soft_Call( Proc_To_Call : Proc_Pointer;
-                             Proc_To_Call_On_Exception : Proc_Pointer := null;
-                             Retry_Routine : Func_Pointer := null );
- 
-   function Top_Event_Exception return Ada.Exceptions.Exception_Occurrence;
- 
-   function Top_Event_Procedure return Proc_Pointer;
- 
-   procedure Pop_Event;
- 
-   function Event_Stack_Size return Natural;
- 
- end CB40005_0; -- Fail_Soft
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CB40005_0
- 
- with Report;
- package body CB40005_0 is
- 
-   type History_Event is record
-     Exception_Event  : Ada.Exceptions.Exception_Occurrence_Access;
-     Procedure_Called : Proc_Pointer;
-   end record;
- 
-   procedure Store_Event( Proc_Called : Proc_Pointer;
-                          Error       : Ada.Exceptions.Exception_Occurrence );
- 
-   procedure Fail_Soft_Call( Proc_To_Call : Proc_Pointer;
-                             Proc_To_Call_On_Exception : Proc_Pointer := null;
-                             Retry_Routine : Func_Pointer := null ) is
- 
-     Current_Proc_To_Call : Proc_Pointer := Proc_To_Call;
- 
-   begin
-     while Current_Proc_To_Call /= null loop
-       begin
-         Current_Proc_To_Call.all;  -- call procedure through pointer
-         Current_Proc_To_Call := null;
-       exception
-         when Capture: others =>
-           Store_Event( Current_Proc_To_Call, Capture );
-           if Proc_To_Call_On_Exception /= null then
-             Proc_To_Call_On_Exception.all;
-           end if;
-           if Retry_Routine /= null then
-             Current_Proc_To_Call := Retry_Routine.all;
-           else
-             Current_Proc_To_Call := null;
-           end if;
-       end;
-     end loop;
-   end Fail_Soft_Call;
-   
-   Stack : array(1..10) of History_Event;  -- minimal, sufficient for testing
- 
-   Stack_Top : Natural := 0;
- 
-   procedure Store_Event( Proc_Called : Proc_Pointer;
-                          Error       : Ada.Exceptions.Exception_Occurrence )
-   is
-   begin
-     Stack_Top := Stack_Top +1;
-     Stack(Stack_Top) := ( Ada.Exceptions.Save_Occurrence(Error),
-                           Proc_Called );
-   end Store_Event;
- 
-   function Top_Event_Exception return Ada.Exceptions.Exception_Occurrence is
-   begin
-     if Stack_Top > 0 then
-       return Stack(Stack_Top).Exception_Event.all;
-     else
-       return Ada.Exceptions.Null_Occurrence;
-     end if;
-   end Top_Event_Exception;
- 
-   function Top_Event_Procedure return Proc_Pointer is
-   begin
-     if Stack_Top > 0 then
-       return Stack(Stack_Top).Procedure_Called;
-     else
-       return null;
-     end if;
-   end Top_Event_Procedure;
- 
-   procedure Pop_Event is
-   begin
-     if Stack_Top > 0 then
-       Stack_Top := Stack_Top -1;
-     else
-       Report.Failed("Stack Error");
-     end if;
-   end Pop_Event;
- 
-   function Event_Stack_Size return Natural is
-   begin
-     return Stack_Top;
-   end Event_Stack_Size;
- 
- end CB40005_0;
- 
- ------------------------------------------------------------------- CB40005
- 
- with Report;
- with TCTouch;
- with CB40005_0;
- with Ada.Exceptions;
- procedure CB40005 is
- 
-   type Proc_Pointer is access procedure;
-   type Func_Pointer is access function return Proc_Pointer;
- 
-   package Fail_Soft is new CB40005_0(Proc_Pointer, Func_Pointer);
- 
-   procedure Cause_Standard_Exception;
- 
-   procedure Cause_Visible_Exception;
- 
-   procedure Cause_Invisible_Exception;
- 
-   Exception_Procedure_Pointer : Proc_Pointer;
- 
-   Visible_Exception : exception;
- 
-   procedure Action_On_Exception;
- 
-   function Retry_Procedure return Proc_Pointer;
- 
-   Raise_Error : Boolean;
- 
-   -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
-   procedure Cause_Standard_Exception is
-   begin
-     TCTouch.Touch('S');  --------------------------------------------------- S
-     if Raise_Error then
-       raise Constraint_Error;
-     end if;
-   end Cause_Standard_Exception;
- 
-   procedure Cause_Visible_Exception is
-   begin
-     TCTouch.Touch('V');  --------------------------------------------------- V
-     if Raise_Error then
-       raise Visible_Exception;
-     end if;
-   end Cause_Visible_Exception;
- 
-   procedure Cause_Invisible_Exception is
-     Invisible_Exception : exception;
-   begin
-     TCTouch.Touch('I');  --------------------------------------------------- I
-     if Raise_Error then
-       raise Invisible_Exception;
-     end if;
-   end Cause_Invisible_Exception;
- 
-   procedure Action_On_Exception is
-   begin
-     TCTouch.Touch('A');  --------------------------------------------------- A
-   end Action_On_Exception;
- 
-   function Retry_Procedure return Proc_Pointer is
-   begin
-     TCTouch.Touch('R');  --------------------------------------------------- R
-     return Action_On_Exception'Access;
-   end Retry_Procedure;
- 
-          -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CB40005", "Check that exceptions raised in non-generic " &
-                           "code can be handled by a procedure in a generic " &
-                           "package.  Check that the exception identity can " &
-                           "be properly retrieved from the generic code and " &
-                           "used by the non-generic code" );
- 
-   -- first, check that the no exception cases cause no action on the stack
-   Raise_Error := False;
- 
-   Fail_Soft.Fail_Soft_Call( Cause_Standard_Exception'Access );    -- S
- 
-   Fail_Soft.Fail_Soft_Call( Cause_Visible_Exception'Access,       -- V
-                             Action_On_Exception'Access,
-                             Retry_Procedure'Access );
- 
-   Fail_Soft.Fail_Soft_Call( Cause_Invisible_Exception'Access,     -- I
-                             null,
-                             Retry_Procedure'Access );
- 
-   TCTouch.Assert( Fail_Soft.Event_Stack_Size = 0, "Empty stack");
- 
-   TCTouch.Validate( "SVI", "Non error case check" );
- 
-   -- second, check that error cases add to the stack
-   Raise_Error := True;
- 
-   Fail_Soft.Fail_Soft_Call( Cause_Standard_Exception'Access );    -- S
- 
-   Fail_Soft.Fail_Soft_Call( Cause_Visible_Exception'Access,       -- V
-                             Action_On_Exception'Access,           -- A
-                             Retry_Procedure'Access );             -- RA
- 
-   Fail_Soft.Fail_Soft_Call( Cause_Invisible_Exception'Access,     -- I
-                             null,
-                             Retry_Procedure'Access );             -- RA
- 
-   TCTouch.Assert( Fail_Soft.Event_Stack_Size = 3, "Stack = 3");
- 
-   TCTouch.Validate( "SVARAIRA", "Error case check" );
- 
-   -- check that the exceptions and procedure were stored correctly
-   -- on the stack
-   Raise_Error := False;
- 
-   -- return procedure pointer from top of stack and call the procedure
-   -- through that pointer:
- 
-   Fail_Soft.Top_Event_Procedure.all;
- 
-   TCTouch.Validate( "I", "Invisible case unwind" );
- 
-   begin
-     Ada.Exceptions.Raise_Exception( 
-       Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
-     Report.Failed("1: Exception not raised");
-   exception
-     when Constraint_Error  => Report.Failed("1: Raised Constraint_Error");
-     when Visible_Exception => Report.Failed("1: Raised Visible_Exception");
-     when others            => null; -- expected case
-   end;
- 
-   Fail_Soft.Pop_Event;
- 
-   -- return procedure pointer from top of stack and call the procedure
-   -- through that pointer:
- 
-   Fail_Soft.Top_Event_Procedure.all;
- 
-   TCTouch.Validate( "V", "Visible case unwind" );
- 
-   begin
-     Ada.Exceptions.Raise_Exception( 
-       Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
-     Report.Failed("2: Exception not raised");
-   exception
-     when Constraint_Error  => Report.Failed("2: Raised Constraint_Error");
-     when Visible_Exception => null; -- expected case
-     when others            => Report.Failed("2: Raised Invisible_Exception");
-   end;
- 
-   Fail_Soft.Pop_Event;
- 
-   Fail_Soft.Top_Event_Procedure.all;
- 
-   TCTouch.Validate( "S", "Standard case unwind" );
- 
-   begin
-     Ada.Exceptions.Raise_Exception( 
-       Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
-     Report.Failed("3: Exception not raised");
-   exception
-     when Constraint_Error  => null; -- expected case
-     when Visible_Exception => Report.Failed("3: Raised Visible_Exception");
-     when others            => Report.Failed("3: Raised Invisible_Exception");
-   end;
- 
-   Fail_Soft.Pop_Event;
- 
-   TCTouch.Assert( Fail_Soft.Event_Stack_Size = 0, "Stack empty after pops");
- 
-   Report.Result;
- 
- end CB40005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4001a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- CB4001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ANY EXCEPTION RAISED IN THE STATEMENT SEQUENCE OF A
- -- SUBPROGRAM IS PROPAGATED TO THE CALLER OF THE SUBPROGRAM, NOT TO THE
- -- STATICALLY ENCLOSING LEXICAL ENVIRONMENT.
- 
- -- RM  05/30/80
- -- JRK 11/19/80
- -- SPS 03/28/83
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- 
- WITH REPORT;
- PROCEDURE CB4001A IS
- 
-      USE REPORT;
- 
-      E1 : EXCEPTION;
-      I9 : INTEGER RANGE 1..10 ;
-      FLOW_COUNT : INTEGER := 0 ;
- 
- BEGIN
-      TEST("CB4001A","CHECK THAT ANY EXCEPTION RAISED IN THE " &
-           "STATEMENT SEQUENCE OF A SUBPROGRAM IS " &
-           "PROPAGATED TO THE CALLER, NOT TO THE STATICALLY ENCLOSING" &
-           " LEXICAL ENVIRONMENT");
- 
-      BEGIN   --  BLOCK WITH HANDLERS; LEX. ENVIRONMT FOR ALL PROC.DEFS
- 
-           DECLARE   --  BLOCK WITH PROCEDURE DEFINITIONS
- 
-                PROCEDURE  CALLEE1 ;
-                PROCEDURE  CALLEE2 ;
-                PROCEDURE  CALLEE3 ;
-                PROCEDURE  R ;
-                PROCEDURE  S ;
- 
-                PROCEDURE  CALLER1  IS
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1 ;
-                     CALLEE1 ;
-                     FAILED("EXCEPTION NOT RAISED  (CALLER1)");
-                EXCEPTION
-                     WHEN E1 =>
-                          FLOW_COUNT := FLOW_COUNT + 1 ;
-                END ;
- 
-                PROCEDURE  CALLER2  IS
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1 ;
-                     CALLEE2 ;
-                     FAILED("EXCEPTION NOT RAISED  (CALLER2)");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          FLOW_COUNT := FLOW_COUNT + 1 ;
-                END ;
- 
-                PROCEDURE  CALLER3  IS
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1 ;
-                     CALLEE3 ;
-                     FAILED("EXCEPTION NOT RAISED  (CALLER3)");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          FLOW_COUNT := FLOW_COUNT + 1 ;
-                END ;
- 
-                PROCEDURE  CALLEE1  IS
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1 ;
-                     R ;
-                     FAILED("EXCEPTION NOT RAISED  (CALLEE1)");
-                END ;
- 
-                PROCEDURE  CALLEE2  IS
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1 ;
-                     RAISE  CONSTRAINT_ERROR ;
-                     FAILED("EXCEPTION NOT RAISED  (CALLEE2)");
-                EXCEPTION
-                     WHEN PROGRAM_ERROR =>
-                          FAILED("WRONG EXCEPTION RAISED  (CALLEE2)");
-                END ;
- 
-                PROCEDURE  CALLEE3  IS
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 1 ;
-                     I9 := IDENT_INT(20) ;
-                     FAILED("EXCEPTION NOT RAISED  (CALLEE3)");
-                END ;
- 
-                PROCEDURE  R  IS
-                     E2 : EXCEPTION;
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 10 ;
-                     S ;
-                     FAILED("EXCEPTION E1 NOT RAISED (PROC R)");
-                EXCEPTION
-                     WHEN E2 =>
-                          FAILED("WRONG EXCEPTION RAISED  (PROC R)");
-                END ;
- 
-                PROCEDURE  S  IS
-                BEGIN
-                     FLOW_COUNT := FLOW_COUNT + 10 ;
-                     RAISE  E1 ;
-                     FAILED("EXCEPTION  E1  NOT RAISED  (PROC S)");
-                END ;
- 
-           BEGIN   --  (THE BLOCK WITH PROC. DEFS)
- 
-                CALLER1;
-                CALLER2;
-                CALLER3;
- 
-           END ;   --  (THE BLOCK WITH PROC. DEFS)
- 
-      EXCEPTION
- 
-           WHEN OTHERS =>
-                FAILED("EXCEPTION PROPAGATED STATICALLY");
- 
-      END ;
- 
-      IF  FLOW_COUNT /= 29  THEN
-           FAILED("INCORRECT FLOW_COUNT VALUE");
-      END IF;
- 
-      RESULT;
- END CB4001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- CB4002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EXCEPTIONS RAISED DURING ELABORATION OF THE
- -- DECLARATIVE PART OF A SUBPROGRAM ARE PROPAGATED TO THE
- -- CALLER, FOR CONSTRAINT_ERROR CAUSED BY INITIALIZATION,
- -- AND CONSTRAINT ELABORATION, AND FOR FUNCTION EVALUATIONS
- -- RAISING  CONSTRAINT_ERROR AND A PROGRAMMER-DEFINED EXCEPTION.
- 
- -- DAT 4/13/81
- -- SPS 3/28/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB4002A IS
- BEGIN
-      TEST("CB4002A", "EXCEPTIONS IN SUBPROGRAM DECLARATIVE_PARTS"
-           & " ARE PROPAGATED TO CALLER");
- 
-      DECLARE
-           SUBTYPE I5 IS INTEGER RANGE -5 .. 5;
-      
-           E : EXCEPTION;
-      
-           FUNCTION RAISE_IT (I : I5) RETURN INTEGER IS
-                J : INTEGER RANGE 0 .. 1 := I;
-           BEGIN
-                IF I = 0 THEN
-                     RAISE CONSTRAINT_ERROR;
-                ELSIF I = 1 THEN
-                     RAISE E;
-                END IF;
-                FAILED ("EXCEPTION NOT RAISED 0");
-                RETURN J;
-           EXCEPTION
-                WHEN OTHERS =>
-                     IF I NOT IN 0 .. 1 THEN
-                          FAILED ("WRONG HANDLER 0");
-                          RETURN 0;
-                     ELSE
-                          RAISE;
-                     END IF;
-           END RAISE_IT;
-      
-           PROCEDURE P1 (P : INTEGER) IS
-                Q : INTEGER := RAISE_IT (P);
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED 1");
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRONG HANDLER 1");
-           END P1;
- 
-           PROCEDURE P2 (P : INTEGER) IS
-                Q : I5 RANGE 0 .. P := 1;
-           BEGIN
-                IF P = 0 OR P > 5 THEN
-                     FAILED ("EXCEPTION NOT RAISED 2");
-                END IF;
-           END P2;
-      
-      BEGIN
-      
-           BEGIN
-                P1(-1);
-                FAILED ("EXCEPTION NOT RAISED 2A");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-           END;
-      
-           BEGIN
-                P1(0);
-                FAILED ("EXCEPTION NOT RAISED 3");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-           END;
-      
-           BEGIN
-                P1(1);
-                FAILED ("EXCEPTION NOT RAISED 4");
-           EXCEPTION
-                WHEN E => NULL;
-           END;
-      
-           BEGIN
-                P2(0);
-                FAILED ("EXCEPTION NOT RAISED 5");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-           END;
-      
-           BEGIN
-                P2(6);
-                FAILED ("EXCEPTION NOT RAISED 6");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-           END;
-      
-      EXCEPTION
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION OR HANDLER");
-      END;
-      
-      RESULT;
- EXCEPTION
-      WHEN OTHERS => FAILED ("WRONG HANDLER FOR SURE"); RESULT;
- END CB4002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- CB4003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EXCEPTIONS RAISED DURING ELABORATION OF PACKAGE
- --     SPECIFICATIONS, OR DECLARATIVE_PARTS OF BLOCKS AND PACKAGE
- --     BODIES, ARE PROPAGATED TO THE STATIC ENVIRONMENT.  EXCEPTIONS
- --     ARE CAUSED BY INITIALIZATIONS AND FUNCTION CALLS.
- 
- -- HISTORY:
- --     DAT 04/14/81  CREATED ORIGINAL TEST.
- --     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO
- --                   PREVENT OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB4003A IS
- 
-      E : EXCEPTION;
- 
-      FUNCTION F (B : BOOLEAN) RETURN INTEGER IS
-      BEGIN
-           IF B THEN
-                RAISE E;
-           ELSE
-                RETURN 1;
-           END IF;
-      END F;
- 
- BEGIN
-      TEST ("CB4003A", "CHECK THAT EXCEPTIONS DURING ELABORATION"
-           & " OF DECLARATIVE PARTS"
-           & " IN BLOCKS, PACKAGE SPECS, AND PACKAGE BODIES ARE"
-           & " PROPAGATED TO STATIC ENCLOSING ENVIRONMENT");
- 
-      BEGIN
-           DECLARE
-                PACKAGE P1 IS
-                     I : INTEGER RANGE 1 .. 1 := 2;
-                END P1;
-           BEGIN
-                FAILED ("EXCEPTION NOT RAISED 1");
-                IF NOT EQUAL(P1.I,P1.I) THEN
-                     COMMENT ("NO EXCEPTION RAISED");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS => FAILED ("WRONG HANDLER 1");
-           END;
-           FAILED ("EXCEPTION NOT RAISED 1A");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
-      END;
- 
-      FOR L IN IDENT_INT(1) .. IDENT_INT(4) LOOP
-           BEGIN
-                DECLARE
-                     PACKAGE P2 IS
-                     PRIVATE
-                          J : INTEGER RANGE 2 .. 4 := L;
-                     END P2;
- 
-                     Q : INTEGER := F(L = 3);
- 
-                     PACKAGE BODY P2 IS
-                          K : INTEGER := F(L = 2);
- 
-                     BEGIN
-                          IF NOT (EQUAL(J,J) OR EQUAL(K,K)) THEN
-                               COMMENT("CAN'T OPTIMIZE THIS");
-                          END IF;
-                     END P2;
-                BEGIN
-                     IF L /= 4 THEN
-                          FAILED ("EXCEPTION NOT RAISED 2");
-                     END IF;
- 
-                     IF NOT EQUAL(Q,Q) THEN
-                          COMMENT("CAN'T OPTIMIZE THIS");
-                     END IF;
- 
-                     EXIT;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION HANDLER 2");
-                          EXIT;
-                END;
-                FAILED ("EXCEPTION NOT RAISED 2A");
-           EXCEPTION
-                WHEN E | CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
-           END;
-      END LOOP;
- 
-      RESULT;
- 
- END CB4003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CB4004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT VARIOUS EXCEPTIONS IN THE BODY OF A SUBPROGRAM WITH
- -- AN APPLICABLE HANDLER ARE HANDLED LOCALLY.
- 
- -- DAT 04/15/81
- -- JRK 04/24/81
- -- SPS 11/02/82
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB4004A IS
- 
-      E, F : EXCEPTION;
-      STORAGE_ERROR: EXCEPTION;
- 
-      I1 : INTEGER RANGE 1 .. 1;
- 
-      FUNCTION F1 (I : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           CASE I IS
-                WHEN 1 => RAISE E;
-                WHEN 2 => RAISE STORAGE_ERROR;
-                WHEN 3 => I1 := 4;
-                WHEN 4 => RAISE TASKING_ERROR;
-                WHEN OTHERS => NULL;
-           END CASE;
-           RETURN FALSE;
-      EXCEPTION
-           WHEN E | F => RETURN I = 1;
-           WHEN STORAGE_ERROR => RETURN I = 2;
-           WHEN PROGRAM_ERROR | CONSTRAINT_ERROR =>
-                RETURN I = 3;
-           WHEN OTHERS => RETURN I = 4;
-      END F1;
- 
- BEGIN
-      TEST ("CB4004A", "EXCEPTIONS WITH LOCAL HANDLERS ARE HANDLED"
-           & " THERE");
- 
-      BEGIN
-           FOR L IN 1 .. 4 LOOP
-                IF F1(L) /= TRUE THEN
-                     FAILED ("LOCAL EXCEPTIONS DON'T WORK");
-                     EXIT;
-                END IF;
-           END LOOP;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("WRONG HANDLER");
-      END;
- 
-      RESULT;
- END CB4004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4005a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4005a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4005a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CB4005A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT EXCEPTIONS PROPAGATED OUT OF A HANDLER ARE PROPAGATED
- -- OUTSIDE THE ENCLOSING UNIT.
- 
- -- DAT 4/15/81
- -- SPS 3/28/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB4005A IS
- 
-      E , F : EXCEPTION;
- 
-      B : BOOLEAN := FALSE;
- 
-      PROCEDURE P IS
-      BEGIN
-           RAISE E;
-      EXCEPTION
-           WHEN F => FAILED ("WRONG HANDLER 1");
-           WHEN E =>
-                IF B THEN
-                     FAILED ("WRONG HANDLER 2");
-                ELSE
-                     B := TRUE;
-                     RAISE F;
-                END IF;
-      END P;
- 
- BEGIN
-      TEST ("CB4005A", "EXCEPTIONS FROM HANDLERS ARE PROPAGATED " & 
-            "OUTSIDE");
- 
-      BEGIN
-           P;
-           FAILED ("EXCEPTION NOT PROPAGATED 1");
-      EXCEPTION
-           WHEN F => NULL;
-           WHEN OTHERS => FAILED ("WRONG HANDLER 3");
-      END;
- 
-      RESULT;
- END CB4005A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4006a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4006a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4006a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- CB4006A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EXCEPTIONS IN A BLOCK IN A HANDLER
- --     ARE HANDLED CORRECTLY.
- 
- -- HISTORY:
- --     DAT 04/15/81
- --     SPS 11/02/82
- --     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO
- --                   PREVENT OPTIMIZATION.
- --     JRL 05/28/92  CHANGED CODE IN PROGRAM_ERROR BLOCK TO
- --                   PREVENT OPTIMIZATION.
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CB4006A IS
- 
-      I1 : INTEGER RANGE 1 .. 2 := 1;
- 
-      PROCEDURE P IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                RAISE PROGRAM_ERROR;
-           END IF;
-      EXCEPTION
-           WHEN PROGRAM_ERROR =>
-                DECLARE
-                     I : INTEGER RANGE 1 .. 1 := I1;
-                BEGIN
-                     IF EQUAL(I,I) THEN
-                          I := I1 + 1;
-                     END IF ;
-                     FAILED ("EXCEPTION NOT RAISED 1");
- 
-                     IF NOT EQUAL(I,I) THEN
-                          COMMENT ("CAN'T OPTIMIZE THIS");
-                     END IF;
- 
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          IF I1 /= 1 THEN
-                               FAILED ("WRONG HANDLER 1");
-                          ELSE
-                               I1 := I1 + 1;
-                          END IF;
-                END;
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("WRONG HANDLER 3");
-      END P;
- 
- BEGIN
-      TEST ("CB4006A", "CHECK THAT EXCEPTIONS IN BLOCKS IN " &
-                       "HANDLERS WORK");
- 
-      P;
-      IF IDENT_INT(I1) /= 2 THEN
-           FAILED ("EXCEPTION NOT HANDLED CORRECTLY");
-      ELSE
-           BEGIN
-                P;
-                FAILED ("EXCEPTION NOT RAISED CORRECTLY 2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR => NULL;
-           END;
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS => FAILED ("WRONG HANDLER 2");
-           RESULT;
- 
- END CB4006A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- CB4007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE STATEMENT PART OF A PACKAGE CAN RAISE, PROPAGATE,
- --     AND HANDLE EXCEPTIONS. IF THE BODY'S HANDLERS HANDLE ALL
- --     EXCEPTIONS RAISED AND DO NOT RAISE ANY UNHANDLED EXCEPTIONS,
- --     NO EXCEPTION IS PROPAGATED.
- 
- -- HISTORY:
- --     DHH 03/28/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CB4007A IS
- BEGIN
- 
-      TEST("CB4007A", "CHECK THAT THE STATEMENT PART OF A PACKAGE " &
-                      "CAN RAISE, PROPAGATE, AND HANDLE EXCEPTIONS. " &
-                      "IF THE BODY'S HANDLERS HANDLE ALL EXCEPTIONS " &
-                      "RAISED AND DO NOT RAISE ANY UNHANDLED " &
-                      "EXCEPTIONS, NO EXCEPTION IS PROPAGATED");
-      DECLARE
- 
-           PACKAGE OUTSIDE IS
-           END OUTSIDE;
- 
-           PACKAGE BODY OUTSIDE IS
- 
-           BEGIN
-                DECLARE
-                     PACKAGE HANDLER IS
-                     END HANDLER;
- 
-                     PACKAGE BODY HANDLER IS
-                     BEGIN
-                          DECLARE
-                               PACKAGE PROPAGATE IS
-                               END PROPAGATE;
- 
-                               PACKAGE BODY PROPAGATE IS
-                               BEGIN
-                                    DECLARE
-                                         PACKAGE RISE IS
-                                         END RISE;
- 
-                                         PACKAGE BODY RISE IS
-                                         BEGIN
-                                              RAISE CONSTRAINT_ERROR;
-                                              FAILED("EXCEPTION " &
-                                                     "NOT RAISED");
-                                         END RISE;
- 
-                                    BEGIN
-                                         NULL;
-                                    END;   -- PACKAGE PROPAGATE DECLARE.
-                               EXCEPTION
-                                    WHEN CONSTRAINT_ERROR =>
-                                         RAISE CONSTRAINT_ERROR;
-                                    WHEN OTHERS =>
-                                         FAILED("UNEXPECTED EXCEPTION " &
-                                                "RAISED IN PROPAGATE " &
-                                                "PACKAGE");
-                               END PROPAGATE;
- 
-                          BEGIN
-                               NULL;
-                          END;               -- PACKAGE HANDLER DECLARE.
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                              NULL;
-                          WHEN OTHERS =>
-                               FAILED("UNEXPECTED EXCEPTION RAISED IN " &
-                                      "HANDLER PACKAGE");
-                     END HANDLER;
- 
-                BEGIN
-                     NULL;
-                END;                    -- PACKAGE OUTSIDE DECLARE.
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED IN OUTSIDE " &
-                            "PACKAGE");
-           END OUTSIDE;
-      BEGIN
-          NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED("UNEXPECTED EXCEPTION RAISED");
-           RESULT;
- END CB4007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4008a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4008a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4008a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- CB4008A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NESTED LAST WISHES EXCEPTION HANDLERS WORK 
- -- (FOR PROCEDURES).
- 
- -- DAT 4/15/81
- -- SPS 3/28/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB4008A IS
- 
-      C : INTEGER := 0;
- 
-      E : EXCEPTION;
- 
-      DEPTH : CONSTANT := 99;
- 
-      PROCEDURE F;
- 
-      PROCEDURE I IS
-      BEGIN
-           C := C + 1;
-           IF C >= DEPTH THEN
-                RAISE E;
-           END IF;
-      END I;
- 
-      PROCEDURE O IS
-      BEGIN
-           C := C - 1;
-      END O;
- 
-      PROCEDURE X IS
-           PROCEDURE X1 IS
-                PROCEDURE X2 IS
-                BEGIN
-                     F;
-                END X2;
- 
-                PROCEDURE X3 IS
-                BEGIN
-                     I;
-                     X2;
-                EXCEPTION
-                     WHEN E => O; RAISE;
-                END X3;
-           BEGIN
-                I;
-                X3;
-           EXCEPTION
-                WHEN E => O; RAISE;
-           END X1;
- 
-           PROCEDURE X1A IS
-           BEGIN
-                I;
-                X1;
-                FAILED ("INCORRECT EXECUTION SEQUENCE");
-           EXCEPTION
-                WHEN E => O; RAISE;
-           END X1A;
-      BEGIN
-           I;
-           X1A;
-      EXCEPTION
-           WHEN E => O; RAISE;
-      END X;
- 
-      PROCEDURE Y IS
-      BEGIN
-           I;
-           X;
-      EXCEPTION WHEN E => O; RAISE;
-      END Y;
- 
-      PROCEDURE F IS
-           PROCEDURE F2;
- 
-           PROCEDURE F1 IS
-           BEGIN
-                I;
-                F2;
-           EXCEPTION WHEN E => O; RAISE;
-           END F1;
- 
-           PROCEDURE F2 IS
-           BEGIN
-                I;
-                Y;
-           EXCEPTION WHEN E => O; RAISE;
-           END F2;
-      BEGIN
-           I;
-           F1;
-      EXCEPTION WHEN E => O; RAISE;
-      END F;
- 
- BEGIN
-      TEST ("CB4008A", "(PROCEDURE) LAST WISHES UNWIND PROPERLY");
- 
-      BEGIN
-           I;
-           Y;
-           FAILED ("INCORRECT EXECUTION SEQUENCE 2");
-      EXCEPTION
-           WHEN E =>
-                O;
-                IF C /= 0 THEN
-                     FAILED ("EXCEPTION HANDLER MISSED SOMEWHERE");
-                END IF;
-      END;
- 
-      RESULT;
- END CB4008A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,114 ****
- -- CB4009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A PROGRAMMER DEFINED EXCEPTION AND A REDECLARED
- -- PREDEFINED EXCEPTION MAY BE PROPAGATED OUT OF SCOPE AND BACK IN,
- -- WITH OUT-OF-SCOPE 'OTHERS' HANDLERS HANDLING THE EXCEPTION
- -- INSTEAD OF OTHER HANDLERS. SEPARATELY COMPILED UNITS ARE NOT TESTED.
- 
- -- DAT 4/15/81
- -- SPS 1/14/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CB4009A IS
- 
-      E : EXCEPTION;
- 
-      I : INTEGER := 0;
- 
-      PROCEDURE P1 (C : INTEGER);
-      PROCEDURE P2 (C : INTEGER);
-      PROCEDURE P3 (C : INTEGER);
- 
-      F : BOOLEAN := FALSE;
-      T : CONSTANT BOOLEAN := TRUE;
- 
-      PROCEDURE P1 (C : INTEGER) IS
-      BEGIN
-           P3(C);
-      EXCEPTION
-           WHEN E => F := T;
-           WHEN CONSTRAINT_ERROR => F := T;
-           WHEN OTHERS => I := I + 1; RAISE;
-      END P1;
- 
-      PROCEDURE P2 (C : INTEGER) IS
-           E : EXCEPTION;
-           CONSTRAINT_ERROR : EXCEPTION;
-      BEGIN
-           CASE C IS
-                WHEN 0 => FAILED ("WRONG CASE");
-                WHEN 1 => RAISE E;
-                WHEN -1 => RAISE CONSTRAINT_ERROR;
-                WHEN OTHERS => P1 (C - C/ABS(C));
-           END CASE;
-      EXCEPTION
-           WHEN E =>
-                I := I + 100; RAISE;
-           WHEN CONSTRAINT_ERROR =>
-                I := I + 101; RAISE;
-           WHEN OTHERS =>
-                F := T;
-      END P2;
- 
-      PROCEDURE P3 (C : INTEGER) IS
-      BEGIN
-           P2(C);
-      EXCEPTION
-           WHEN E => F := T;
-           WHEN CONSTRAINT_ERROR => F := T;
-      END P3;
- 
- BEGIN
-      TEST ("CB4009A", "EXCEPTIONS PROPAGATED OUT OF SCOPE");
- 
-      I := 0;
-      BEGIN
-           P3 (-2);
-           FAILED ("EXCEPTION NOT RAISED 1");
-      EXCEPTION
-           WHEN OTHERS => NULL;
-      END;
-      IF I /= 203 THEN
-           FAILED ("INCORRECT HANDLER SOMEWHERE 1");
-      END IF;
- 
-      I := 0;
-      BEGIN
-           P3(3);
-           FAILED ("EXCEPTION NOT RAISED 2");
-      EXCEPTION
-           WHEN OTHERS => NULL;
-      END;
-      IF I /= 302 THEN
-           FAILED ("INCORRECT HANDLER SOMEWHERE 2");
-      END IF;
- 
-      IF F = T THEN
-           FAILED ("WRONG HANDLER SOMEWHERE");
-      END IF;
- 
-      RESULT;
- END CB4009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4013a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb4013a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb4013a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- CB4013A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN UNHANDLED EXCEPTION RAISED IN A TASK BODY, BUT
- --     OUTSIDE AN ACCEPT STATEMENT, RAISES NO EXCEPTION OUTSIDE THE
- --     TASK.
- 
- -- HISTORY:
- --     DHH 03/29/88 CREATED ORIGINAL TEST.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CB4013A IS
- 
-      TASK TYPE CHOICE IS
-           ENTRY E1;
-           ENTRY STOP;
-      END CHOICE;
- 
-      T : CHOICE;
- 
-      TASK BODY CHOICE IS
-      BEGIN
-           ACCEPT E1;
-           IF EQUAL(3,3) THEN
-                RAISE CONSTRAINT_ERROR;
-           END IF;
-           ACCEPT STOP;
-      END CHOICE;
- 
- BEGIN
- 
-      TEST("CB4013A", "CHECK THAT AN UNHANDLED EXCEPTION RAISED IN " &
-                      "A TASK BODY, BUT OUTSIDE AN ACCEPT STATEMENT, " &
-                      "RAISES NO EXCEPTION OUTSIDE THE TASK");
- 
-      T.E1;
-      DELAY 1.0;
-      IF T'CALLABLE THEN
-           FAILED("TASK NOT COMPLETED ON RAISING CONSTRAINT_ERROR");
-           T.STOP;
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN TASKING_ERROR =>
-           FAILED("TASKING_ERROR RAISED OUTSIDE TASK");
-           RESULT;
- 
-      WHEN CONSTRAINT_ERROR =>
-           FAILED("CONSTRAINT_ERROR PROPAGATED OUTSIDE TASK");
-           RESULT;
- 
-      WHEN OTHERS =>
-           FAILED("UNEXPECTED EXCEPTION RAISED");
-           RESULT;
- END CB4013A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- CB40A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a user defined exception is correctly propagated out of
- --      a public child package.
- --
- -- TEST DESCRIPTION:
- --      Declare a public child package containing a procedure used to 
- --      analyze the alphanumeric content of a particular text string.
- --      The procedure contains a processing loop that continues until the
- --      range of the text string is exceeded, at which time a user defined
- --      exception is raised.  This exception propagates out of the procedure
- --      through the parent package, to the main test program.
- --
- --      Exception Type Raised:
- --        * User Defined
- --          Predefined  
- --
- --      Hierarchical Structure Employed For This Test:  
- --        * Parent Package
- --        * Public Child Package
- --          Private Child Package
- --          Public Child Subprogram
- --          Private Child Subprogram
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --         FB40A00.A
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- package FB40A00.CB40A01_0 is    -- package Text_Parser.Processing
- 
-    procedure Process_Text (Text : in String_Pointer_Type);
- 
- end FB40A00.CB40A01_0;
- 
- 
-      --=================================================================--
- 
- 
- with Report;
- 
- package body FB40A00.CB40A01_0 is
- 
-    procedure Process_Text (Text : in String_Pointer_Type) is
-       Pos : Natural := Text'First - 1;
-    begin
-       loop   -- Process string, raise exception upon completion.
-          Pos := Pos + 1;
-          if Pos > Text.all'Last then
-             raise Completed_Text_Processing; 
-          elsif (Text.all (Pos) in 'A' .. 'Z') or
-                (Text.all (Pos) in 'a' .. 'z') or
-                (Text.all (Pos) in '0' .. '9') then
-             Increment_AlphaNumeric_Count;
-          else
-             Increment_Non_AlphaNumeric_Count;
-          end if;
-       end loop;
-       -- No exception handler here, exception propagates.
-       Report.Failed ("No exception raised in child package subprogram");
-    end Process_Text;
- 
- end FB40A00.CB40A01_0;
- 
- 
-      --=================================================================--
- 
- 
- with FB40A00.CB40A01_0;
- with Report;
- 
- procedure CB40A01 is
- 
-    String_Pointer : FB40A00.String_Pointer_Type := 
-      new String'("'Twas the night before Christmas, " &
-                  "and all through the house...");
- 
- begin
- 
-    Process_Block:
-    begin
- 
-       Report.Test ("CB40A01", "Check that a user defined exception " &
-                               "is correctly propagated out of a "    &
-                               "public child package");
- 
-       FB40A00.CB40A01_0.Process_Text (String_Pointer);
- 
-       Report.Failed ("Exception should have been handled");
- 
-    exception
- 
-       when FB40A00.Completed_Text_Processing =>      -- Correct exception 
-          if FB40A00.AlphaNumeric_Count /= 48 then    -- propagation.
-             Report.Failed ("Incorrect string processing");
-          end if;
- 
-       when others =>
-          Report.Failed ("Exception handled in an others handler");
- 
-    end Process_Block;
- 
-    Report.Result;
- 
- end CB40A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- CB40A020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CB40A021.AM.
- --
- -- TEST DESCRIPTION:
- --      See CB40A021.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         FB40A00.A
- --      => CB40A020.A
- --         CB40A021.AM
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- 
- package FB40A00.CB40A020_0 is    -- package Text_Parser.Processing 
- 
-    function Count_AlphaNumerics (Text : in String) return Natural;
- 
- end FB40A00.CB40A020_0;
- 
- 
-      --=================================================================--
- 
- 
- -- Text_Parser.Processing.Process_Text 
- with Report;
- private procedure FB40A00.CB40A020_0.CB40A020_1 (Text : in String);
- 
- procedure FB40A00.CB40A020_0.CB40A020_1 (Text : in String) is
-    Pos : Natural := Text'First - 1;
- begin
-    loop   -- Process string, raise exception upon completion.
-       Pos := Pos + 1;
-       if Pos > Text'Last then
-          raise Completed_Text_Processing; 
-       elsif (Text (Pos) in 'A' .. 'Z') or
-             (Text (Pos) in 'a' .. 'z') or
-             (Text (Pos) in '0' .. '9') then
-          Increment_AlphaNumeric_Count;
-       else
-          Increment_Non_AlphaNumeric_Count;
-       end if;
-    end loop;
-    -- No exception handler here, exception propagates.
-    Report.Failed ("No exception raised in child package subprogram");
- end FB40A00.CB40A020_0.CB40A020_1;
- 
- 
-      --=================================================================--
- 
- 
- with FB40A00.CB40A020_0.CB40A020_1;   -- "with" of  private child subprogram
-                                       -- Text_Parser.Processing.Process_Text 
- package body FB40A00.CB40A020_0 is
- 
-    function Count_AlphaNumerics (Text : in String) return Natural is
-    begin
-       FB40A00.CB40A020_0.CB40A020_1 (Text);  -- Call prvt child proc.
-       return (AlphaNumeric_Count);           -- Global maintained in parent.
-       -- No exception handler here, exception propagates.
-    end Count_AlphaNumerics;
- 
- end FB40A00.CB40A020_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a021.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a021.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a021.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a021.am	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- CB40A021.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a user defined exception is correctly propagated from a
- --      private child subprogram to its parent and then to a client of the
- --      parent.
- --
- -- TEST DESCRIPTION:
- --      Declare a child package containing a function.  The body of the 
- --      function contains a call to a private child subprogram (child of
- --      the child).  The private child subprogram raises an exception
- --      defined in the root ancestor package, and it is propagated to the
- --      test program.
- --
- --      Exception Type Raised:
- --        * User Defined
- --          Predefined  
- --
- --      Hierarchical Structure Employed For This Test:  
- --        * Parent Package
- --        * Visible Child Package
- --          Private Child Package
- --          Visible Child Subprogram
- --        * Private Child Subprogram
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         FB40A00.A
- --         CB40A020.A
- --      => CB40A021.AM
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- 
- with Report;
- with FB40A00.CB40A020_0;   -- Explicit "with" of Text_Parser.Processing
-                            -- Implicit "with" of Text_Parser (FB40A00)
- 
- procedure CB40A021 is
- 
-    String_Constant : constant String := 
-      "ACVC Version 2.0 will incorporate Ada 9X feature tests."; 
- 
-    Number_Of_AlphaNumeric_Characters : Natural := 0;
- 
- begin
- 
-    Process_Block:
-    begin
- 
-       Report.Test ("CB40A021", "Check that a user defined exception " &
-                                "is correctly propagated across "      &
-                                "package and subprogram boundaries");
- 
-       Number_Of_AlphaNumeric_Characters := 
-         FB40A00.CB40A020_0.Count_AlphaNumerics (String_Constant);
- 
-       Report.Failed ("Exception should have been handled");
- 
-    exception
- 
-       when FB40A00.Completed_Text_Processing =>      -- Correct exception 
-          if FB40A00.AlphaNumeric_Count /= 45 then    -- propagation.
-             Report.Failed ("Incorrect string processing");
-          end if;
- 
-       when others =>
-          Report.Failed ("Exception handled in an others handler");
- 
-    end Process_Block;
- 
-    Report.Result;
- 
- end CB40A021;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a030.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a030.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a030.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a030.a	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- CB40A030.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See CB40A031.AM.
- --
- -- TEST DESCRIPTION:
- --      See CB40A031.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         FB40A00.A
- --      => CB40A030.A
- --         CB40A031.AM
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- 
- package FB40A00.CB40A030_0 is  -- package Text_Parser.Character_Counting
- 
-    function Count_AlphaNumerics (Text : in String) return Natural;
- 
- end FB40A00.CB40A030_0;
- 
- 
-      --=================================================================--
- 
- 
- private package  FB40A00.CB40A030_1  is    -- package Text_Parser.Processing
- 
-    procedure Process_Text (Text : in String);
- 
- end FB40A00.CB40A030_1;  
- 
- 
-      --=================================================================--
- 
- 
- package body  FB40A00.CB40A030_1  is
- 
-    procedure Process_Text (Text : in String) is
-       Loop_Count : Integer := Text'Length + 1;
-    begin
-       for Pos in 1..Loop_Count loop          -- Process string, force the 
-                                              -- raise of Constraint_Error. 
-          if (Text (Pos) in 'a'..'z') or 
-             (Text (Pos) in 'A'..'Z') or
-             (Text (Pos) in '0'..'9') then
-             Increment_AlphaNumeric_Count;
-          else
-             Increment_Non_AlphaNumeric_Count;
-          end if;
- 
-       end loop;
-       -- No exception handler here, exception propagates.
-    end Process_Text;
- 
- end FB40A00.CB40A030_1;  
- 
- 
-      --=================================================================--
- 
- 
- with FB40A00.CB40A030_1;  -- private sibling package Text_Parser.Processing;
- 
- package body FB40A00.CB40A030_0 is
- 
-    function Count_AlphaNumerics (Text : in String) return Natural is
-    begin
-       FB40A00.CB40A030_1.Process_Text (Text);     -- Call proc in prvt child
-                                                   -- package that is a
-                                                   -- sibling of this package.
-       return (AlphaNumeric_Count);
-       -- No exception handler here, exception propagates.
-    end Count_AlphaNumerics;
- 
- end FB40A00.CB40A030_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a031.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a031.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a031.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a031.am	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- CB40A031.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a predefined exception is correctly propagated from
- --      a private child package through a visible child package to a client.
- --
- -- TEST DESCRIPTION:
- --      Declare two child packages from a root package, one visible, one
- --      private.  The visible child package contains a function, whose
- --      body makes a call to a procedure contained in the private sibling
- --      package.  A predefined exception occurring in the subprogram within the
- --      private package is propagated through the visible sibling and ancestor
- --      to the test program.
- --
- --      Exception Type Raised:
- --          User Defined
- --        * Predefined  
- --
- --      Hierarchical Structure Employed For This Test:  
- --        * Parent Package
- --        * Visible Child Package
- --        * Private Child Package
- --          Visible Child Subprogram
- --          Private Child Subprogram
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         FB40A00.A
- --         CB40A030.A
- --      => CB40A031.AM
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
- --
- --!
- 
- with Report;
- with FB40A00.CB40A030_0; -- Explicit "with" of Text_Parser.Character_Counting
-                          -- Implicit "with" of Text_Parser
- 
- procedure CB40A031 is
- 
-    String_Constant : constant String := 
-      "The San Diego Padres will win the World Series in 1999."; 
- 
-    Number_Of_AlphaNumeric_Characters : Natural := 0;
- 
- begin
- 
-    Process_Block:
-    begin
- 
-       Report.Test ("CB40A031", "Check that a predefined exception " &
-                                "is correctly propagated across "    &
-                                "package boundaries");
- 
-       Number_Of_AlphaNumeric_Characters := 
-         FB40A00.CB40A030_0.Count_AlphaNumerics (String_Constant);
- 
-       Report.Failed ("Exception should have been handled");
- 
-    exception
- 
-       when Constraint_Error =>                       -- Correct exception 
-          if FB40A00.AlphaNumeric_Count /= 44 then    -- propagation.
-             Report.Failed ("Incorrect string processing");
-          end if;
- 
-       when others =>
-          Report.Failed ("Exception handled in an others handler");
- 
-    end Process_Block;
- 
-    Report.Result;
- 
- end CB40A031;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a04.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a04.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb40a04.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb40a04.a	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- CB40A04.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a predefined exception is correctly propagated out of a
- --      public child function to a client. 
- --
- -- TEST DESCRIPTION:
- --      Declare a public child subprogram.  Define the processing loop
- --      inside the subprogram to expect a string with index starting at 1.
- --      From the test procedure, call the child subprogram with a slice
- --      from the middle of a string variable.  This will cause an exception
- --      to be raised in the child and propagated to the caller.
- --
- --      Exception Type Raised:
- --          User Defined
- --        * Predefined  
- --
- --      Hierarchical Structure Employed For This Test:  
- --        * Parent Package
- --          Public Child Package
- --          Private Child Package
- --        * Public Child Subprogram
- --          Private Child Subprogram
- --
- -- TEST FILES:
- --      This test depends on the following foundation code:
- --         FB40A00.A
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- 
- -- Child subprogram Text_Parser.Count_AlphaNumerics 
- 
- function FB40A00.CB40A04_0 (Text : string) return Natural is
- begin
- 
-    for I in 1 .. Text'Last loop          -- Raise immediate Constraint_Error 
-       if (Text (I) in 'a'..'z') or       -- with String slice passed from
-          (Text (I) in 'A'..'Z') or       -- caller. (Slice'first /= 1)
-          (Text (I) in '0'..'9') then
-          Increment_AlphaNumeric_Count;
-       else
-          Increment_Non_AlphaNumeric_Count;
-       end if;
-    end loop;
- 
-    return (AlphaNumeric_Count);          -- Global in parent package.
- 
-    -- No exception handler here, exception propagates.
- 
- end FB40A00.CB40A04_0;
- 
- 
-      --=================================================================--
- 
- 
- with FB40A00.CB40A04_0; -- Explicit "with" of Text_Parser.Count_AlphaNumerics
- with Report;            -- Implicit "with" of Text_Parser.
- 
- procedure CB40A04 is
- 
-    String_Var : String (1..19) := "The quick brown fox";
- 
-    Number_Of_AlphaNumeric_Characters : Natural := 0;
- 
- begin
- 
-    Report.Test ("CB40A04", "Check that a predefined exception is " &
-                            "correctly propagated out of a public " &
-                            "child function to a client");
- 
-    Process_Block:
-    begin
- 
-       Number_Of_AlphaNumeric_Characters :=       -- Provide slice of string
-         FB40A00.CB40A04_0 (String_Var (5..10));  -- to subprogram.
-                                                            
-       Report.Failed ("Exception should have been handled");
- 
-    exception
- 
-       when Constraint_Error =>                      -- Correct exception 
-          null;                                      -- propagation.
- 
-       when others =>
-          Report.Failed ("Exception handled in an others handler");
- 
-    end Process_Block;
- 
-    Report.Result;
- 
- end CB40A04;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,213 ****
- -- CB41001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the 'Identity attribute returns the unique identity of an
- --      exception. Check that the Raise_Exception procedure can raise an 
- --      exception that is specified through the use of the 'Identity attribute,
- --      and that Reraise_Occurrence can re-raise an exception occurrence
- --      using an exception choice parameter.
- --
- -- TEST DESCRIPTION:
- --      This test uses the capability of the 'Identity attribute, which 
- --      returns the unique identity of an exception, as an Exception_Id 
- --      result.  This result is used as an input parameter to the procedure
- --      Raise_Exception.  The exception that results is handled, propagated
- --      using the Reraise_Occurrence procedure, and handled again.
- --      The above actions are performed for both a user-defined and a
- --      predefined exception.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      11 Nov 96   SAIC    ACVC 2.1: Modified Propagate_User_Exception.
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- 
- procedure CB41001 is
- 
- begin
- 
-    Report.Test ("CB41001", "Check that the 'Identity attribute returns " &
-                            "the unique identity of an exception. Check " &
-                            "that the 'Identity attribute is of type "    &
-                            "Exception_Id.  Check that the "              &
-                            "Raise_Exception procedure can raise an "     &
-                            "exception that is specified through the "    &
-                            "use of the 'Identity attribute");
-    Test_Block:
-    declare
- 
-       Check_Points : constant := 5;
- 
-       type Check_Point_Array_Type is array (1..Check_Points) of Boolean;
- 
-       -- Global array used to track the processing path through the test.
-       TC_Check_Points : Check_Point_Array_Type := (others => False);
- 
-       A_User_Defined_Exception  : Exception;
-       An_Exception_ID           : Ada.Exceptions.Exception_Id :=
-                                     Ada.Exceptions.Null_Id;
- 
-       procedure Propagate_User_Exception is
-          Hidden_Exception : Exception;
-       begin
-          -- Use the 'Identity function to store the unique identity of a
-          -- user defined exception into a variable of type Exception_Id.
- 
-          An_Exception_ID := A_User_Defined_Exception'Identity;
- 
-          -- Raise this user defined exception using the result of the 
-          -- 'Identity attribute.
- 
-          Ada.Exceptions.Raise_Exception(E => An_Exception_Id);
- 
-          Report.Failed("User defined exception not raised by " &
-                        "procedure Propagate_User_Exception");
- 
-       exception
-          when Proc_Excpt : A_User_Defined_Exception => -- Expected exception.
-             begin
- 
-                -- By raising a different exception at this point, the 
-                -- information associated with A_User_Defined_Exception must
-                -- be correctly stacked internally.
- 
-                Ada.Exceptions.Raise_Exception(Hidden_Exception'Identity);
-                Report.Failed("Hidden_Exception not raised by " &
-                              "procedure Propagate_User_Exception");
-             exception
-                when others => 
-                   TC_Check_Points(1) := True;
- 
-                   -- Reraise the original exception, which will be propagated 
-                   -- outside the scope of this procedure.
- 
-                   Ada.Exceptions.Reraise_Occurrence(Proc_Excpt);
-                   Report.Failed("User defined exception not reraised");
- 
-             end;
- 
-          when others =>
-             Report.Failed("Unexpected exception raised by " &
-                           "Procedure Propagate_User_Exception");
-       end Propagate_User_Exception;
- 
-    begin
- 
-       User_Exception_Block:
-       begin
-          -- Call procedure to raise, handle, and reraise a user defined 
-          -- exception.
-          Propagate_User_Exception;
- 
-          Report.Failed("User defined exception not propagated from " &
-                        "procedure Propagate_User_Exception");
- 
-       exception
-          when A_User_Defined_Exception => -- Expected exception.
-             TC_Check_Points(2) := True;
-          when others =>
-             Report.Failed
-               ("Unexpected exception handled in User_Exception_Block");
-       end User_Exception_Block;
- 
- 
-       Predefined_Exception_Block:
-       begin
- 
-          Inner_Block:
-          begin
- 
-             begin
-                -- Use the 'Identity attribute as an input parameter to the
-                -- Raise_Exception procedure.
- 
-                Ada.Exceptions.Raise_Exception(Constraint_Error'Identity);
-                Report.Failed("Constraint_Error not raised in Inner_Block");
- 
-             exception
-                when Excpt : Constraint_Error =>  -- Expected exception.
-                   TC_Check_Points(3) := True;
- 
-                   -- Reraise the exception.
-                   Ada.Exceptions.Reraise_Occurrence(X => Excpt);
-                   Report.Failed("Predefined exception not raised from " &
-                                 "within the exception handler - 1");
-                when others => 
-                   Report.Failed("Incorrect result from attempt to raise " &
-                                 "Constraint_Error using the 'Identity "   &
-                                 "attribute - 1");
-             end;
- 
-             Report.Failed("Constraint_Error not reraised in Inner_Block");
- 
-          exception
-             when Block_Excpt : Constraint_Error =>  -- Expected exception.
-                TC_Check_Points(4) := True;
- 
-                -- Reraise the exception in a scope where the exception
-                -- was not originally raised.
- 
-                Ada.Exceptions.Reraise_Occurrence(X => Block_Excpt);
-                Report.Failed("Predefined exception not raised from " &
-                              "within the exception handler - 2");
- 
-             when others => 
-                Report.Failed("Incorrect result from attempt to raise " &
-                              "Constraint_Error using the 'Identity "   &
-                              "attribute - 2");
-          end Inner_Block;
- 
-          Report.Failed("Exception not propagated from Inner_Block");
- 
-       exception
-          when Constraint_Error =>  -- Expected exception.
-             TC_Check_Points(5) := True;
-          when others => 
-             Report.Failed("Unexpected exception handled after second " &
-                           "reraise of Constraint_Error");
-       end Predefined_Exception_Block;
- 
- 
-       -- Verify the processing path taken through the test.
- 
-       for i in 1..Check_Points loop
-          if not TC_Check_Points(i) then
-             Report.Failed("Incorrect processing path taken through test, " &
-                           "didn't pass check point #" & Integer'Image(i));
-          end if;
-       end loop;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CB41001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,283 ****
- -- CB41002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the message string input parameter in a call to the
- --      Raise_Exception procedure is associated with the raised exception
- --      occurrence, and that the message string can be obtained using the
- --      Exception_Message function with the associated Exception_Occurrence
- --      object.  Check that Function Exception_Information is available
- --      to provide implementation-defined information about the exception
- --      occurrence.
- --
- -- TEST DESCRIPTION:
- --      This test checks that a message associated with a raised exception
- --      is propagated with the exception, and can be retrieved using the
- --      Exception_Message function.  The exception will be raised using the
- --      'Identity attribute as a parameter to the Raise_Exception procedure,
- --      and an associated message string will be provided.  The exception
- --      will be handled, and the message associated with the occurrence will
- --      be compared to the original source message (non-default).
- --
- --      The test also includes a simulated logging procedure
- --      (Check_Exception_Information) that checks that Exception_Information
- --      can be called.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      22 Jun 00   RLB     Added a check at Exception_Information can be
- --                          called.
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- 
- procedure CB41002 is
- begin
- 
-    Report.Test ("CB41002", "Check that the message string input parameter " &
-                            "in a call to the Raise_Exception procedure is " &
-                            "associated with the raised exception "          &
-                            "occurrence, and that the message string can "   &
-                            "be obtained using the Exception_Message "       &
-                            "function with the associated "                  &
-                            "Exception_Occurrence object. Also check that "  &
-                            "the Exception_Information function can be called");
- 
-    Test_Block:
-    declare
- 
-       Number_Of_Exceptions : constant := 3;
- 
-       User_Exception_1,
-       User_Exception_2,
-       User_Exception_3 : exception;
- 
-       type String_Ptr is access String;
- 
-       User_Messages : constant array (1..Number_Of_Exceptions)
-         of String_Ptr :=
-         (new String'("Msg"),
-          new String'("This message will override the default "   &
-                      "message provided by the implementation"),
-          new String'("The message can be captured by procedure"  & -- 200 chars
-                       " Exception_Message.  It is designed to b" &
-                       "e exactly 200 characters in length, sinc" &
-                       "e there is a permission  concerning the " &
-                       "truncation of a message over 200 chars. "));
- 
-       procedure Check_Exception_Information (
-                  Occur : in Ada.Exceptions.Exception_Occurrence) is
-           -- Simulates an error logging routine.
-          Info : constant String :=
-               Ada.Exceptions.Exception_Information (Occur);
-          function Is_Substring_of (Target, Search : in String) return Boolean is
-             -- Returns True if Search is a substring of Target, and False
-             -- otherwise.
-          begin
-             for I in Report.Ident_Int(Target'First) ..
-                      Target'Last - Search'Length + 1 loop
-                if Target(I .. I+Search'Length-1) = Search then
-                   return True;
-                end if;
-             end loop;
-             return False;
-          end Is_Substring_of;
-       begin
-          -- We can't display Info, as it often contains line breaks
-          -- (confusing Report), and might look much like the failure of a test
-          -- with an unhandled exception (thus confusing grading tools).
-          --
-          -- We don't particular care if the implementation advice is followed,
-          -- but we make these checks to insure that a compiler cannot optimize
-          -- away Info or the rest of this routine.
-          if not Is_Substring_of (Info,
-                        Ada.Exceptions.Exception_Name (Occur)) then
-              Report.Comment ("Exception_Information does not contain " &
-                              "Exception_Name - see 11.4.1(19)");
-          elsif not Is_Substring_of (Info,
-                        Ada.Exceptions.Exception_Message (Occur)) then
-              Report.Comment ("Exception_Information does not contain " &
-                              "Exception_Message - see 11.4.1(19)");
-          end if;
-       end Check_Exception_Information;
- 
-    begin
- 
-       for i in 1..Number_Of_Exceptions loop
-          begin
- 
-             -- Raise a user-defined exception with a specific message string.
-             case i is
-                when 1 =>
-                   Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
-                                                  User_Messages(i).all);
-                when 2 =>
-                   Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
-                                                  User_Messages(i).all);
-                when 3 =>
-                   Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
-                                                  User_Messages(i).all);
-                when others =>
-                   Report.Failed("Incorrect result from Case statement");
-             end case;
- 
-             Report.Failed
-               ("Exception not raised by procedure Exception_With_Message " &
-                "for User_Exception #" & Integer'Image(i));
- 
-          exception
-             when Excptn : others =>
- 
-                begin
-                   -- The message that is associated with the raising of each
-                   -- exception is captured here using the Exception_Message
-                   -- function.
- 
-                   if User_Messages(i).all /=
-                      Ada.Exceptions.Exception_Message(Excptn)
-                   then
-                      Report.Failed
-                        ("Message captured from exception is not the "  &
-                         "message provided when the exception was raised, " &
-                         "User_Exception #" & Integer'Image(i));
-                   end if;
- 
-                   Check_Exception_Information(Excptn);
-                end;
-          end;
-       end loop;
- 
- 
- 
-       -- Verify that the exception specific message is carried across
-       -- various boundaries:
- 
-       begin
- 
-          begin
-             Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
-                                            User_Messages(1).all);
-             Report.Failed("User_Exception_1 not raised");
-          end;
-          Report.Failed("User_Exception_1 not propagated");
-       exception
-          when Excptn : User_Exception_1 =>
- 
-             if User_Messages(1).all /=
-                Ada.Exceptions.Exception_Message(Excptn)
-             then
-                Report.Failed("User_Message_1 not found");
-             end if;
-             Check_Exception_Information(Excptn);
- 
-          when others => Report.Failed("Unexpected exception handled - 1");
-       end;
- 
- 
- 
-       begin
- 
-          begin
-             Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
-                                            User_Messages(2).all);
-             Report.Failed("User_Exception_2 not raised");
-          exception
-             when Exc : User_Exception_2 =>
- 
-                -- The exception is reraised here; message should propagate
-                -- with exception occurrence.
- 
-                Ada.Exceptions.Reraise_Occurrence(Exc);
-             when others => Report.Failed("User_Exception_2 not handled");
-          end;
-          Report.Failed("User_Exception_2 not propagated");
-       exception
-          when Excptn : User_Exception_2 =>
- 
-             if User_Messages(2).all /=
-                Ada.Exceptions.Exception_Message(Excptn)
-             then
-                Report.Failed("User_Message_2 not found");
-             end if;
-             Check_Exception_Information(Excptn);
- 
-          when others => Report.Failed("Unexpected exception handled - 2");
-       end;
- 
- 
-       -- Check exception and message propagation across task boundaries.
- 
-       declare
- 
-          task Raise_An_Exception is  -- single task
-             entry Raise_It;
-          end Raise_An_Exception;
- 
-          task body Raise_An_Exception is
-          begin
-             accept Raise_It do
-                Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
-                                               User_Messages(3).all);
-             end Raise_It;
-             Report.Failed("User_Exception_3 not raised");
-          exception
-             when Excptn : User_Exception_3 =>
-                if User_Messages(3).all /=
-                   Ada.Exceptions.Exception_Message(Excptn)
-                then
-                   Report.Failed
-                     ("User_Message_3 not returned inside task body");
-                end if;
-                Check_Exception_Information(Excptn);
-             when others =>
-                Report.Failed("Incorrect exception raised in task body");
-          end Raise_An_Exception;
- 
-       begin
-          Raise_An_Exception.Raise_It;  -- Exception will be propagated here.
-          Report.Failed("User_Exception_3 not propagated to caller");
-       exception
-          when Excptn : User_Exception_3 =>
-             if User_Messages(3).all /=
-                Ada.Exceptions.Exception_Message(Excptn)
-             then
-                Report.Failed("User_Message_3 not returned to caller of task");
-             end if;
-             Check_Exception_Information(Excptn);
-          when others =>
-             Report.Failed("Incorrect exception raised by task");
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CB41002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,358 ****
- -- CB41003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an exception occurrence can be saved into an object of
- --      type Exception_Occurrence using the procedure Save_Occurrence.
- --      Check that a saved exception occurrence can be used to reraise 
- --      another occurrence of the same exception using the procedure
- --      Reraise_Occurrence.  Check that the function Save_Occurrence will
- --      allocate a new object of type Exception_Occurrence_Access, and saves
- --      the source exception to the new object which is returned as the 
- --      function result.
- --
- -- TEST DESCRIPTION:
- --      This test verifies that an occurrence of an exception can be saved,
- --      using either of two overloaded versions of Save_Occurrence.  The
- --      procedure version of Save_Occurrence is used to save an occurrence
- --      of a user defined exception into an object of type 
- --      Exception_Occurrence.  This object is then used as an input 
- --      parameter to procedure Reraise_Occurrence, the expected exception is
- --      handled, and the exception id of the handled exception is compared
- --      to the id of the originally raised exception.
- --      The function version of Save_Occurrence returns a result of 
- --      Exception_Occurrence_Access, and is used to store the value of another
- --      occurrence of the user defined exception.  The resulting access value
- --      is dereferenced and used as an input to Reraise_Occurrence.  The
- --      resulting exception is handled, and the exception id of the handled 
- --      exception is compared to the id of the originally raised exception.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- 
- procedure CB41003 is
- 
- begin
- 
-    Report.Test ("CB41003", "Check that an exception occurrence can "   &
-                            "be saved into an object of type "          &
-                            "Exception_Occurrence using the procedure " &
-                            "Save_Occurrence");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
- 
-       User_Exception_1,
-       User_Exception_2   : Exception;
- 
-       Saved_Occurrence   : Exception_Occurrence;
-       Occurrence_Ptr     : Exception_Occurrence_Access;
- 
-       User_Message       : constant String :=   -- 200 character string.
-         "The string returned by Exception_Message may be tr" &
-         "uncated (to no less then 200 characters) by the Sa" &
-         "ve_Occurrence procedure (not the function), the Re" &
-         "raise_Occurrence proc, and the re-raise statement.";
- 
-    begin
- 
-       Raise_And_Save_Block_1 :
-       begin
- 
-          -- This nested exception structure is designed to ensure that the
-          -- appropriate exception occurrence is saved using the 
-          -- Save_Occurrence procedure.
- 
-          raise Program_Error;
-          Report.Failed("Program_Error not raised");
- 
-       exception
-          when Program_Error => 
- 
-             begin
-                -- Use the procedure Raise_Exception, along with the 'Identity
-                -- attribute to raise the first user defined exception.  Note
-                -- that a 200 character message is included in the call.
- 
-                Raise_Exception(User_Exception_1'Identity, User_Message);
-                Report.Failed("User_Exception_1 not raised");
- 
-             exception
-                when Exc : User_Exception_1 => 
- 
-                   -- This exception occurrence is saved into a variable using
-                   -- procedure Save_Occurrence.  This saved occurrence should
-                   -- not be confused with the raised occurrence of 
-                   -- Program_Error above.
- 
-                   Save_Occurrence(Target => Saved_Occurrence, Source => Exc);
- 
-                when others => 
-                   Report.Failed("Unexpected exception handled, expecting " &
-                                 "User_Exception_1");
-             end;
- 
-          when others => 
-             Report.Failed("Incorrect exception generated by raise statement");
- 
-       end Raise_And_Save_Block_1;
- 
- 
-       Reraise_And_Handle_Saved_Exception_1 :
-       begin
-          -- Reraise the exception that was saved in the previous block.
- 
-          Reraise_Occurrence(X => Saved_Occurrence);
- 
-       exception
-          when Exc : User_Exception_1 => -- Expected exception.
-             -- Check the exception id of the handled id by using the 
-             -- Exception_Identity function, and compare with the id of the
-             -- originally raised exception.
- 
-             if User_Exception_1'Identity /= Exception_Identity(Exc) then
-                Report.Failed("Exception_Ids do not match - 1");
-             end if;
- 
-             -- Check that the message associated with this exception occurrence
-             -- has not been truncated (it was originally 200 characters).
- 
-             if User_Message /= Exception_Message(Exc) then
-                Report.Failed("Exception messages do not match - 1");
-             end if;
- 
-          when others => 
-             Report.Failed
-               ("Incorrect exception raised by Reraise_Occurrence - 1");
-       end Reraise_And_Handle_Saved_Exception_1;
- 
- 
-       Raise_And_Save_Block_2 :
-       begin
- 
-          Raise_Exception(User_Exception_2'Identity, User_Message);
-          Report.Failed("User_Exception_2 not raised");
- 
-       exception
-          when Exc : User_Exception_2 => 
- 
-             -- This exception occurrence is saved into an access object 
-             -- using function Save_Occurrence.
- 
-             Occurrence_Ptr := Save_Occurrence(Source => Exc);
- 
-          when others => 
-             Report.Failed("Unexpected exception handled, expecting " &
-                           "User_Exception_2");
-       end Raise_And_Save_Block_2;
- 
- 
-       Reraise_And_Handle_Saved_Exception_2 :
-       begin
-          -- Reraise the exception that was saved in the previous block.
-          -- Dereference the access object for use as input parameter.
- 
-          Reraise_Occurrence(X => Occurrence_Ptr.all);
- 
-       exception
-          when Exc : User_Exception_2 => -- Expected exception.
-             -- Check the exception id of the handled id by using the 
-             -- Exception_Identity function, and compare with the id of the
-             -- originally raised exception.
- 
-             if User_Exception_2'Identity /= Exception_Identity(Exc) then
-                Report.Failed("Exception_Ids do not match - 2");
-             end if;
- 
-             -- Check that the message associated with this exception occurrence
-             -- has not been truncated (it was originally 200 characters).
- 
-             if User_Message /= Exception_Message(Exc) then
-                Report.Failed("Exception messages do not match - 2");
-             end if;
- 
-          when others => 
-             Report.Failed
-               ("Incorrect exception raised by Reraise_Occurrence - 2");
-        end Reraise_And_Handle_Saved_Exception_2;
- 
- 
-        -- Another example of the use of saving an exception occurrence
-        -- is demonstrated in the following block, where the ability to 
-        -- save an occurrence into a data structure, for later processing,
-        -- is modeled.
- 
-        Store_And_Handle_Block:
-        declare
-           
-           Exc_Number  : constant := 3;
-           Exception_1, 
-           Exception_2, 
-           Exception_3 : exception;
- 
-           Exception_Storage : array (1..Exc_Number) of Exception_Occurrence;
-           Messages          : array (1..Exc_Number) of String(1..9) :=
-                                 ("Message 1", "Message 2", "Message 3");
- 
-        begin
- 
-           Outer_Block:
-           begin
- 
-              Inner_Block:
-              begin
- 
-                 for i in 1..Exc_Number loop
-                    begin
- 
-                       begin
-                          -- Exceptions all raised in a deep scope.
-                          if i = 1 then
-                             Raise_Exception(Exception_1'Identity, Messages(i));
-                          elsif i = 2 then
-                             Raise_Exception(Exception_2'Identity, Messages(i));
-                          elsif i = 3 then
-                             Raise_Exception(Exception_3'Identity, Messages(i));
-                          end if;
-                          Report.Failed("Exception not raised on loop #" &
-                                        Integer'Image(i));
-                       end;
-                       Report.Failed("Exception not propagated on loop #" &
-                                     Integer'Image(i));
-                    exception
-                       when Exc : others =>
- 
-                          -- Save each occurrence into a storage array for 
-                          -- later processing.
- 
-                          Save_Occurrence(Exception_Storage(i), Exc);
-                    end;
-                 end loop;
- 
-              end Inner_Block;
-           end Outer_Block;
- 
-           -- Raise the exceptions from the stored occurrences, and handle.
- 
-           for i in 1..Exc_Number loop
-              begin
-                 Reraise_Occurrence(Exception_Storage(i));
-                 Report.Failed("No exception reraised for " &
-                               "exception #" & Integer'Image(i));
-              exception
-                 when Exc   : others =>
-                    -- The following sequence of checks ensures that the 
-                    -- correct occurrence was stored, and the associated
-                    -- exception was raised and handled in the proper order.
-                    if i = 1 then
-                       if Exception_1'Identity /= Exception_Identity(Exc) then
-                          Report.Failed("Exception_1 not raised");
-                       end if;
-                    elsif i = 2 then
-                       if Exception_2'Identity /= Exception_Identity(Exc) then
-                          Report.Failed("Exception_2 not raised");
-                       end if;
-                    elsif i = 3 then
-                       if Exception_3'Identity /= Exception_Identity(Exc) then
-                          Report.Failed("Exception_3 not raised");
-                       end if;
-                    end if;
- 
-                    if Exception_Message(Exc) /= Messages(i) then
-                       Report.Failed("Incorrect message associated with " &
-                                     "exception #" & Integer'Image(i));
-                    end if;
-              end;
-           end loop;
-        exception
-           when others => 
-             Report.Failed("Unexpected exception in Store_And_Handle_Block");
-        end Store_And_Handle_Block;
- 
- 
-       Reraise_Out_Of_Scope:
-       declare
- 
-          TC_Value      : constant := 5;
-          The_Exception : exception;
-          Saved_Exc_Occ : Exception_Occurrence;
- 
-          procedure Handle_It (Exc_Occ : in Exception_Occurrence) is
-             Must_Be_Raised : exception;
-          begin
-             if Exception_Identity(Exc_Occ) = The_Exception'Identity then
-                raise Must_Be_Raised;
-                Report.Failed("Exception Must_Be_Raised was not raised");
-             else
-                Report.Failed("Incorrect exception handled in " &
-                              "Procedure Handle_It");
-             end if;
-          end Handle_It;
- 
-       begin
- 
-          if Report.Ident_Int(5) = TC_Value then
-             raise The_Exception;
-          end if;
- 
-       exception
-          when Exc : others => 
-             Save_Occurrence (Saved_Exc_Occ, Exc);
-             begin
-                Handle_It(Saved_Exc_Occ);   -- Raise another exception, in a
-             exception                      -- different scope.
-                when others =>              -- Handle this new exception.
-                   begin
-                      Reraise_Occurrence (Saved_Exc_Occ);  -- Reraise the
-                                                           -- original excptn.
-                      Report.Failed("Saved Exception was not raised");
-                   exception                               
-                      when Exc_2 : others =>
-                         if Exception_Identity (Exc_2) /= 
-                            The_Exception'Identity 
-                         then
-                            Report.Failed
-                              ("Incorrect exception occurrence reraised");
-                         end if;
-                   end;
-             end;
-       end Reraise_Out_Of_Scope;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CB41003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb41004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb41004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,324 ****
- -- CB41004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Raise_Exception and Reraise_Occurrence have no effect in
- --      the case of Null_Id or Null_Occurrence.  Check that Exception_Message,
- --      Exception_Identity, Exception_Name, and Exception_Information raise
- --      Constraint_Error for a Null_Occurrence input parameter.
- --      Check that calling the Save_Occurrence subprograms with the
- --      Null_Occurrence input parameter saves the Null_Occurrence to the
- --      appropriate target object, and does not raise Constraint_Error.
- --      Check that Null_Id is the default initial value of type Exception_Id.
- --
- -- TEST DESCRIPTION:
- --      This test performs a series of calls to many of the subprograms
- --      defined in package Ada.Exceptions, using either Null_Id or
- --      Null_Occurrence (based on their parameter profile).  In the cases of
- --      Raise_Exception and Reraise_Occurrence, these null input values
- --      should result in no exceptions being raised, and Constraint_Error
- --      should not be raised in response to these calls.  Test failure will
- --      result if any exception is raised in these cases.
- --      For the Save_Occurrence subprograms, calling them with the
- --      Null_Occurrence input parameter does not raise Constraint_Error, but
- --      simply results in the Null_Occurrence being saved into the appropriate
- --      target (either a Exception_Occurrence out parameter, or as an
- --      Exception_Occurrence_Access value).
- --      In the cases of the other mentioned subprograms, calls performed with
- --      a Null_Occurrence input parameter must result in Constraint_Error
- --      being raised.  This exception will be handled, with test failure the
- --      result if the exception is not raised.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      08 Dec 00   RLB     Removed Exception_Identity subtest, pending
- --                          resolution of AI95-00241.
- --      29 Mar 07   RLB     Replaced Exception_Identity subtest, repaired
- --                          Raise_Exception subtest for AI95-00446.
- --!
- 
- with Report;
- with Ada.Exceptions;
- 
- procedure CB41004 is
- begin
- 
-    Report.Test ("CB41004", "Check that Null_Id and Null_Occurrence input " &
-                            "parameters have the appropriate effect when "  &
-                            "used in calls of the subprograms found in "    &
-                            "package Ada.Exceptions");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
- 
-       -- No initial values given for these two declarations; they default
-       -- to Null_Id and Null_Occurrence respectively.
-       A_Null_Exception_Id         : Ada.Exceptions.Exception_Id;
-       A_Null_Exception_Occurrence : Ada.Exceptions.Exception_Occurrence;
- 
-       TC_Flag : Boolean := False;
- 
-    begin
- 
-       -- Verify that Null_Id is the default initial value of type
-       -- Exception_Id.
- 
-       if not (A_Null_Exception_Id = Ada.Exceptions.Null_Id) then
-          Report.Failed("The default initial value of an object of type " &
-                        "Exception_Id was not Null_Id");
-       end if;
- 
- 
-       -- Verify that Raise_Exception has no effect in the case of Null_Id.
-       -- Modified by AI-446.
-       begin
-          Ada.Exceptions.Raise_Exception(A_Null_Exception_Id);
-          Report.Comment(
-            "No exception raised by procedure Raise_Exception " &
-            "when called with a Null_Id input parameter - compatible with " &
-            "original Ada95");
-       exception
-          when Constraint_Error => null; -- OK, expected exception.
-             Report.Comment(
-                "Constraint_Error exception raised by procedure Raise_Exception " &
-                "when called with a Null_Id input parameter - compatible with " &
-                "AI95-00446");
-          when others =>
-             Report.Failed(
-                "Unexpected exception raised by procedure Raise_Exception " &
-                "when called with a Null_Id input parameter");
-       end;
- 
-       TC_Flag := False;
- 
- 
-       -- Verify that Reraise_Occurrence has no effect in the case of
-       -- Null_Occurrence.
-       begin
-          Ada.Exceptions.Reraise_Occurrence(A_Null_Exception_Occurrence);
-          TC_Flag := True;
-       exception
-          when others =>
-             Report.Failed
-               ("Exception raised by procedure Reraise_Occurrence " &
-                "when called with a Null_Occurrence input parameter");
-       end;
- 
-       if not TC_Flag then
-          Report.Failed("Incorrect processing following the call to " &
-                        "Reraise_Occurrence with a Null_Occurrence "  &
-                        "input parameter");
-       end if;
- 
- 
-       -- Verify that function Exception_Message raises Constraint_Error for
-       -- a Null_Occurrence input parameter.
-       begin
-          declare
-             Msg : constant String :=
-               Ada.Exceptions.Exception_Message(A_Null_Exception_Occurrence);
-          begin
-             Report.Failed
-               ("Constraint_Error not raised by Function Exception_Message " &
-                "when called with a Null_Occurrence input parameter");
-          end;
-       exception
-          when Constraint_Error => null; -- OK, expected exception.
-          when others =>
-             Report.Failed
-               ("Unexpected exception raised by Function Exception_Message " &
-                "when called with a Null_Occurrence input parameter");
-       end;
- 
- 
-       -- Verify that function Exception_Identity raises Constraint_Error for
-       -- a Null_Occurrence input parameter.
-       -- Modified by AI-241.
-       begin
-          declare
-             Id : Ada.Exceptions.Exception_Id :=
-               Ada.Exceptions.Exception_Identity(A_Null_Exception_Occurrence);
-          begin
-             Report.Comment
-               ("No exception raised by Function Exception_Identity " &
-                "when called with a Null_Occurrence input parameter - " &
-                "compatible with AI95-00241.");
-          end;
-       exception
-          when Constraint_Error =>
-             Report.Comment
-               ("Constraint_Error raised by Function Exception_Identity " &
-                "when called with a Null_Occurrence input parameter - " &
-                "compatible with original Ada95.");
-          when others =>
-             Report.Failed
-               ("Unexpected exception raised by Function Exception_Identity " &
-                "when called with a Null_Occurrence input parameter");
-       end;
- 
- 
-       -- Verify that function Exception_Name raises Constraint_Error for
-       -- a Null_Occurrence input parameter.
-       begin
-          declare
-             Name : constant String :=
-               Ada.Exceptions.Exception_Name(A_Null_Exception_Occurrence);
-          begin
-             Report.Failed
-               ("Constraint_Error not raised by Function Exception_Name " &
-                "when called with a Null_Occurrence input parameter");
-          end;
-       exception
-          when Constraint_Error => null; -- OK, expected exception.
-          when others =>
-             Report.Failed
-               ("Unexpected exception raised by Function Exception_Null " &
-                "when called with a Null_Occurrence input parameter");
-       end;
- 
- 
-       -- Verify that function Exception_Information raises Constraint_Error
-       -- for a Null_Occurrence input parameter.
-       begin
-          declare
-             Info : constant String :=
-               Ada.Exceptions.Exception_Information
-                                (A_Null_Exception_Occurrence);
-          begin
-             Report.Failed
-               ("Constraint_Error not raised by Function "  &
-                "Exception_Information when called with a " &
-                "Null_Occurrence input parameter");
-          end;
-       exception
-          when Constraint_Error => null; -- OK, expected exception.
-          when others =>
-             Report.Failed
-               ("Unexpected exception raised by Function Exception_Null " &
-                "when called with a Null_Occurrence input parameter");
-       end;
- 
- 
-       -- Verify that calling the Save_Occurrence procedure with a
-       -- Null_Occurrence input parameter saves the Null_Occurrence to the
-       -- target object, and does not raise Constraint_Error.
-       declare
-          use Ada.Exceptions;
-          Saved_Occurrence : Exception_Occurrence;
-       begin
- 
-          -- Initialize the Saved_Occurrence variable with a value other than
-          -- Null_Occurrence (default).
-          begin
-             raise Program_Error;
-          exception
-             when Exc : others => Save_Occurrence(Saved_Occurrence, Exc);
-          end;
- 
-          -- Save a Null_Occurrence input parameter.
-          begin
-             Save_Occurrence(Target => Saved_Occurrence,
-                             Source => Ada.Exceptions.Null_Occurrence);
-          exception
-             when others =>
-                Report.Failed
-                  ("Unexpected exception raised by procedure "           &
-                   "Save_Occurrence when called with a Null_Occurrence " &
-                   "input parameter");
-          end;
- 
-          -- Verify that the occurrence that was saved above is a
-          -- Null_Occurrence value.
- 
-          begin
-             Reraise_Occurrence(Saved_Occurrence);
-          exception
-             when others =>
-                Report.Failed("Value saved from Procedure Save_Occurrence " &
-                              "resulted in an exception, i.e., was not a "  &
-                              "value of Null_Occurrence");
-          end;
- 
-       exception
-          when others =>
-             Report.Failed("Unexpected exception raised during evaluation " &
-                           "of Procedure Save_Occurrence");
-       end;
- 
- 
-       -- Verify that calling the Save_Occurrence function with a
-       -- Null_Occurrence input parameter returns the Null_Occurrence as the
-       -- function result, and does not raise Constraint_Error.
-       declare
-          Occurrence_Ptr : Ada.Exceptions.Exception_Occurrence_Access;
-       begin
-          -- Save a Null_Occurrence input parameter.
-          begin
-             Occurrence_Ptr :=
-               Ada.Exceptions.Save_Occurrence(Ada.Exceptions.Null_Occurrence);
-          exception
-             when others =>
-                Report.Failed
-                  ("Unexpected exception raised by function "            &
-                   "Save_Occurrence when called with a Null_Occurrence " &
-                   "input parameter");
-          end;
- 
-          -- Verify that the occurrence that was saved above is a
-          -- Null_Occurrence value.
- 
-          begin
-             -- Dereferenced value of type Exception_Occurrence_Access
-             -- should be a Null_Occurrence value, based on the action
-             -- of Function Save_Occurrence above.  Providing this as an
-             -- input parameter to Reraise_Exception should not result in
-             -- any exception being raised.
- 
-             Ada.Exceptions.Reraise_Occurrence(Occurrence_Ptr.all);
- 
-          exception
-             when others =>
-                Report.Failed("Value saved from Function Save_Occurrence " &
-                              "resulted in an exception, i.e., was not a "  &
-                              "value of Null_Occurrence");
-          end;
-       exception
-          when others =>
-             Report.Failed("Unexpected exception raised during evaluation " &
-                           "of Function Save_Occurrence");
-       end;
- 
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CB41004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb5001a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb5001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb5001a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb5001a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- CB5001A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXCEPTION RAISED IN A RENDEVOUS IS PROPAGATED BOTH TO
- -- THE CALLER AND TO THE CALLED TASK.
- 
- -- THIS VERSION CHECKS THAT THE EXCEPTION IS PROPAGATED THROUGH ONE
- -- LEVEL OF RENDEVOUS.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- JEAN-PIERRE ROSEN 09 MARCH 1984
- -- JBG 6/1/84
- -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CB5001A IS
- 
- BEGIN
- 
-      TEST("CB5001A", "CHECK THAT AN EXCEPTION IN A RENDEVOUS IS " &
-                      "PROPAGATED TO CALLER AND CALLED TASKS -- ONE " &
-                      "LEVEL");
- 
-      DECLARE
-           TASK T2 IS
-                ENTRY E2;
-           END T2;
-      
-           TASK BODY T2 IS
-                MY_EXCEPTION: EXCEPTION;
-           BEGIN
-                ACCEPT E2 DO 
-                     IF EQUAL (1,1) THEN
-                          RAISE MY_EXCEPTION; 
-                     END IF;
-                END E2;
-                FAILED ("T2: EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN MY_EXCEPTION => 
-                     NULL;
-                WHEN TASKING_ERROR =>
-                     FAILED ("TASKING_ERROR RAISED IN T2");
-                WHEN OTHERS =>
-                     FAILED ("T2 RECEIVED ABNORMAL EXCEPTION");
-           END T2;
-      
-      BEGIN 
-           T2.E2;
-           FAILED ("MAIN: EXCEPTION NOT RAISED");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR | PROGRAM_ERROR | STORAGE_ERROR =>
-                FAILED ("PREDEFINED ERROR RAISED IN MAIN");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED IN MAIN");
-           WHEN OTHERS => 
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CB5001A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb5001b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb5001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb5001b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb5001b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- CB5001B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN EXCEPTION RAISED IN A RENDEVOUS IS PROPAGATED BOTH TO
- -- THE CALLER AND TO THE CALLED TASK.
- 
- -- THIS VERSION CHECKS THAT THE EXCEPTION IS PROPAGATED THROUGH TWO
- -- LEVELS OF RENDEVOUS.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- JEAN-PIERRE ROSEN 09 MARCH 1984
- -- JBG 6/1/84
- -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CB5001B IS
- 
- BEGIN
- 
-      TEST("CB5001B", "CHECK THAT AN EXCEPTION IN A RENDEVOUS IS " &
-                      "PROPAGATED TO CALLER AND CALLED TASKS -- TWO " &
-                      "LEVELS");
- 
-      DECLARE
-           TASK T1 IS
-                ENTRY E1;
-           END T1;
-      
-           TASK T2 IS
-                ENTRY E2;
-           END T2;
-      
-           TASK BODY T1 IS
-           BEGIN
-                ACCEPT E1 DO 
-                     T2.E2; 
-                END E1;
-                FAILED ("T1: EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR | PROGRAM_ERROR =>
-                     FAILED ("PREDEFINED EXCEPTION RAISED IN T1");
-                WHEN TASKING_ERROR =>
-                     FAILED ("TASKING_ERROR RAISED IN T1");
-                WHEN OTHERS => 
-                     NULL;
-           END T1;
-      
-           TASK BODY T2 IS
-                MY_EXCEPTION: EXCEPTION;
-           BEGIN
-                ACCEPT E2 DO 
-                     IF EQUAL (1,1) THEN
-                          RAISE MY_EXCEPTION; 
-                     END IF;
-                END E2;
-                FAILED ("T2: EXCEPTION NOT RAISED");
-           EXCEPTION
-                WHEN MY_EXCEPTION => 
-                     NULL;
-                WHEN TASKING_ERROR =>
-                     FAILED ("TASKING_ERROR RAISED IN T2");
-                WHEN OTHERS =>
-                     FAILED ("T2 RECEIVED ABNORMAL EXCEPTION");
-           END T2;
-      
-      BEGIN 
-           T1.E1;
-           FAILED ("MAIN: EXCEPTION NOT RAISED");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR | PROGRAM_ERROR =>
-                FAILED ("PREDEFINED ERROR RAISED IN MAIN");
-           WHEN TASKING_ERROR =>
-                FAILED ("TASKING_ERROR RAISED IN MAIN");
-           WHEN OTHERS => 
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CB5001B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb5002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb5002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cb/cb5002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cb/cb5002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,168 ****
- -- CB5002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN "TASKING_ERROR" IS RAISED EXPLICITLY OR BY
- --     PROPAGATION WITHIN AN ACCEPT STATEMENT, THEN "TASKING_ERROR"
- --     IS RAISED IN BOTH THE CALLING AND THE CALLED TASK.
- 
- -- HISTORY:
- --     DHH 03/31/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CB5002A IS
- 
- BEGIN
-      TEST("CB5002A", "CHECK THAT WHEN ""TASKING_ERROR"" IS RAISED " &
-                      "EXPLICITLY OR BY PROPAGATION WITHIN AN ACCEPT " &
-                      "STATEMENT, THEN ""TASKING_ERROR"" IS RAISED " &
-                      "IN BOTH THE CALLING AND THE CALLED TASK");
- 
-      DECLARE
-           TASK CALLING_EXP IS
-                ENTRY A;
-           END CALLING_EXP;
- 
-           TASK CALLED_EXP IS
-                ENTRY B;
-                ENTRY STOP;
-           END CALLED_EXP;
- 
-           TASK CALLING_PROP IS
-                ENTRY C;
-           END CALLING_PROP;
- 
-           TASK CALLED_PROP IS
-                ENTRY D;
-                ENTRY STOP;
-           END CALLED_PROP;
- 
-           TASK PROP IS
-                ENTRY E;
-                ENTRY STOP;
-           END PROP;
- -----------------------------------------------------------------------
-           TASK BODY CALLING_EXP IS
-           BEGIN
-                ACCEPT A DO
-                     BEGIN
-                          CALLED_EXP.B;
-                          FAILED("EXCEPTION NOT RAISED IN CALLING " &
-                                 "TASK - EXPLICIT RAISE");
-                     EXCEPTION
-                          WHEN TASKING_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("WRONG EXCEPTION RAISED IN " &
-                                      "CALLING TASK - EXPLICIT RAISE");
-                     END; -- EXCEPTION
-                END A;
-           END CALLING_EXP;
- 
-           TASK BODY CALLED_EXP IS
-           BEGIN
-                BEGIN
-                     ACCEPT B DO
-                          RAISE TASKING_ERROR;
-                          FAILED("EXCEPTION NOT RAISED IN CALLED " &
-                                 "TASK - EXPLICIT RAISE");
-                     END B;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("WRONG EXCEPTION RAISED IN CALLED " &
-                                 "TASK - EXPLICIT RAISE");
-                END;  -- EXCEPTION BLOCK
- 
-                ACCEPT STOP;
-           END CALLED_EXP;
- 
- -----------------------------------------------------------------------
-           TASK BODY CALLING_PROP IS
-           BEGIN
-                ACCEPT C DO
-                     BEGIN
-                          CALLED_PROP.D;
-                          FAILED("EXCEPTION NOT RAISED IN CALLING " &
-                                 "TASK - PROPAGATED RAISE");
-                     EXCEPTION
-                          WHEN TASKING_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED("WRONG EXCEPTION RAISED IN " &
-                                      "CALLING TASK - PROPAGATED RAISE");
-                     END;  -- EXCEPTION
-                END C;
-           END CALLING_PROP;
- 
-           TASK BODY CALLED_PROP IS
-           BEGIN
-                BEGIN
-                     ACCEPT D DO
-                          PROP.E;
-                          FAILED("EXCEPTION NOT RAISED IN CALLED " &
-                                 "TASK - PROPAGATED RAISE");
-                     END D;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("WRONG EXCEPTION RAISED IN CALLED " &
-                                 "TASK - PROPAGATED RAISE");
-                END;  -- EXCEPTION BLOCK;
- 
-                ACCEPT STOP;
-           END CALLED_PROP;
- 
-           TASK BODY PROP IS
-           BEGIN
-                BEGIN
-                     ACCEPT E DO
-                          RAISE TASKING_ERROR;
-                          FAILED("EXCEPTION NOT RAISED IN PROPAGATE " &
-                                 "TASK - ACCEPT E");
-                     END E;
-                EXCEPTION
-                     WHEN TASKING_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED("WRONG EXCEPTION RAISED IN PROP. TASK");
-               END;    -- EXCEPTION BLOCK
- 
-               ACCEPT STOP;
- 
-           END PROP;
- -----------------------------------------------------------------------
-      BEGIN
-           CALLING_EXP.A;
-           CALLING_PROP.C;
-           CALLED_EXP.STOP;
-           CALLED_PROP.STOP;
-           PROP.STOP;
- 
-      END;    -- DECLARE
- 
-      RESULT;
- END CB5002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- CC1004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE ELABORATION OF A GENERIC DECLARATION
- --     DOES NOT ELABORATE THE SUBPROGRAM OR PACKAGE SPECIFICATION.
- 
- -- HISTORY:
- --     DAT 07/31/81  CREATED ORIGINAL TEST.
- --     SPS 10/18/82
- --     SPS 02/09/83
- --     JET 01/07/88  UPDATED HEADER FORMAT AND ADDED CODE TO
- --                   PREVENT OPTIMIZATION.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1004A IS
- BEGIN
-      TEST ("CC1004A", "THE SPECIFICATION PART OF A GENERIC " &
-                       "SUBPROGRAM IS NOT ELABORATED AT THE " &
-                       "ELABORATION OF THE DECLARATION");
- 
-      BEGIN
-           DECLARE
-                SUBTYPE I1 IS INTEGER RANGE 1 .. 1;
- 
-                GENERIC
-                PROCEDURE PROC (P1: I1 := IDENT_INT(2));
- 
-                PROCEDURE PROC (P1: I1 := IDENT_INT(2)) IS
-                BEGIN
-                     IF NOT EQUAL (P1,P1) THEN
-                          COMMENT ("DON'T OPTIMIZE THIS");
-                     END IF;
-                END PROC;
-           BEGIN
-                BEGIN
-                     DECLARE
-                          PROCEDURE P IS NEW PROC;
-                     BEGIN
-                          IF NOT EQUAL(3,3) THEN
-                               P(1);
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("INSTANTIATION ELABORATES SPEC");
-                END;
- 
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("DECL ELABORATED SPEC PART - 1");
-      END;
- 
-      BEGIN
-           DECLARE
-                SUBTYPE I1 IS INTEGER RANGE 1 .. 1;
- 
-                GENERIC
-                PACKAGE PKG IS
-                     X : INTEGER := I1(IDENT_INT(2));
-                END PKG;
-           BEGIN
-                BEGIN
-                     DECLARE
-                          PACKAGE P IS NEW PKG;
-                     BEGIN
-                          FAILED ("PACKAGE INSTANTIATION FAILED");
-                          IF NOT EQUAL(P.X,P.X) THEN
-                               COMMENT("DON'T OPTIMIZE THIS");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR => NULL;
-                     WHEN OTHERS => FAILED ("WRONG EXCEPTION - 2");
-                END;
- 
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("DECL ELABORATED SPEC PART - 2");
-      END;
- 
-      RESULT;
- 
- END CC1004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1005b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1005b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1005b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- CC1005B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A GENERIC UNIT'S IDENTIFIER CAN BE USED IN ITS
- --     FORMAL PART:
- --
- --     (A) AS THE SELECTOR IN AN EXPANDED NAME TO DENOTE AN ENTITY IN THE
- --         VISIBLE PART OF A PACKAGE, OR TO DENOTE AN ENTITY IMMEDIATELY
- --         ENCLOSED IN A CONSTRUCT OTHER THAN THE CONSTRUCT IMMEDIATELY
- --         ENCLOSING THE GENERIC UNIT.
- --
- --     (B) AS A SELECTOR TO DENOTE A COMPONENT OF A RECORD OBJECT,
- --         AS THE NAME OF A RECORD OR DISCRIMINANT COMPONENT IN A RECORD
- --         AGGREGATE, AND AS THE NAME OF A FORMAL PARAMETER IN A
- --         FUNCTION CALL.
- 
- -- HISTORY:
- --     BCB 08/03/88  CREATED ORIGINAL TEST.
- --     JRL 03/20/92  DELETED TEST IN BLOCK STATEMENT; CONSOLIDATED
- --                   WITH CC1005C.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1005B IS
- 
-      S : INTEGER := IDENT_INT(0);
- 
-      PACKAGE CC1005B IS
-           I : INTEGER;
-           S : INTEGER := IDENT_INT(5);
-           GENERIC
-                S : INTEGER := IDENT_INT(10);
-                V : INTEGER := STANDARD.CC1005B.S;
-                W : INTEGER := STANDARD.CC1005B.CC1005B.S;
-           FUNCTION CC1005B RETURN INTEGER;
-      END CC1005B;
- 
-      PACKAGE BODY CC1005B IS
-           FUNCTION CC1005B RETURN INTEGER IS
-           BEGIN
-                IF NOT EQUAL(V,0) THEN
-                     FAILED ("WRONG VALUE OF S USED IN ASSIGNMENT OF V");
-                END IF;
- 
-                IF NOT EQUAL(W,5) THEN
-                     FAILED ("WRONG VALUE OF S USED IN ASSIGNMENT OF W");
-                END IF;
- 
-                RETURN 0;
-           END CC1005B;
- 
-           FUNCTION NEW_CC IS NEW CC1005B;
- 
-      BEGIN
-           TEST ("CC1005B", "CHECK THAT A GENERIC UNIT'S IDENTIFIER " &
-                            "CAN BE USED IN ITS FORMAL PART: AS THE " &
-                            "SELECTOR IN AN EXPANDED NAME TO DENOTE " &
-                            "AN ENTITY IN THE VISIBLE PART OF A " &
-                            "PACKAGE, OR TO DENOTE AN ENTITY " &
-                            "IMMEDIATELY ENCLOSED IN A CONSTRUCT " &
-                            "OTHER THAN THE CONSTRUCT IMMEDIATELY " &
-                            "ENCLOSING THE GENERIC UNIT; AND AS A " &
-                            "SELECTOR TO DENOTE A COMPONENT OF A " &
-                            "RECORD OBJECT, AS THE NAME OF A RECORD " &
-                            "OR DISCRIMINANT COMPONENT IN A RECORD " &
-                            "AGGREGATE, AND AS THE NAME OF A FORMAL " &
-                            "PARAMETER IN A FUNCTION CALL");
- 
-           I := NEW_CC;
-      END CC1005B;
- 
-      FUNCTION F (P : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN P;
-      END F;
- 
- BEGIN
- 
-      BLOCK1:
-         DECLARE
-              TYPE REC IS RECORD
-                   P : INTEGER := IDENT_INT(0);
-              END RECORD;
- 
-              TYPE REC2 (P : INTEGER) IS RECORD
-                   NULL;
-              END RECORD;
- 
-              R : REC;
- 
-              J : INTEGER;
- 
-              GENERIC
-                   V : INTEGER := R.P;
-                   X : REC := (P => IDENT_INT(10));
-                   Y : REC2 := (P => IDENT_INT(15));
-                   Z : INTEGER := F(P => IDENT_INT(20));
-              FUNCTION P RETURN INTEGER;
- 
-              FUNCTION P RETURN INTEGER IS
-              BEGIN
-                   IF NOT EQUAL(V,0) THEN
-                        FAILED ("WRONG VALUE OF P USED IN ASSIGNMENT " &
-                                "OF V");
-                   END IF;
- 
-                   IF NOT EQUAL(X.P,10) THEN
-                        FAILED ("WRONG VALUE USED IN ASSIGNMENT OF X.P");
-                   END IF;
- 
-                   IF NOT EQUAL(Y.P,15) THEN
-                        FAILED ("WRONG VALUE USED IN ASSIGNMENT OF Y.P");
-                   END IF;
- 
-                   IF NOT EQUAL(Z,20) THEN
-                        FAILED ("WRONG VALUE OF P USED IN ASSIGNMENT " &
-                                "OF Z");
-                   END IF;
- 
-                   RETURN 0;
-              END P;
- 
-              FUNCTION NEW_P IS NEW P;
-         BEGIN
-              J := NEW_P;
-         END BLOCK1;
- 
-      RESULT;
- END CC1005B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1010a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1010a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1010a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CC1010A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NAMES IN A GENERIC SUBPROGRAM DECLARATION ARE
- -- STATICALLY IDENTIFIED (I.E., BOUND) AT THE POINT WHERE THE
- -- GENERIC DECLARATION TEXTUALLY OCCURS, AND ARE NOT DYNAMICALLY
- -- BOUND AT THE POINT OF INSTANTIATION.
- 
- -- ASL 8/12/81
- 
- WITH REPORT;
- PROCEDURE CC1010A IS
-      USE REPORT;
- BEGIN
-      TEST ("CC1010A","PROPER VISIBILITY OF FREE IDENTIFIERS IN " &
-            "GENERIC DECLARATIONS, BODIES AND INSTANTIATIONS");
- 
-      OUTER:
-           DECLARE
-                FREE : CONSTANT INTEGER := 5;
-           BEGIN
-                DECLARE
-                     GENERIC
-                          GFP : INTEGER := FREE;
-                     PROCEDURE P(PFP : IN INTEGER := FREE);
-           
-                     FREE : CONSTANT INTEGER := 6;
-             
-                     PROCEDURE P(PFP : IN INTEGER := OUTER.FREE) IS
-                     BEGIN
-                          IF FREE /= 6 OR GFP /= 5 OR PFP /= 5 THEN
-                               FAILED ("BINDINGS INCORRECT");
-                          END IF;
-                     END P;
-                BEGIN
-                     DECLARE
-                          FREE : CONSTANT INTEGER := 7;
-                          PROCEDURE INST IS NEW P;
-                     BEGIN
-                          INST;
-                     END;
-                END;
-           END OUTER;
-      RESULT;
- END CC1010A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1010b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1010b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1010b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1010b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- CC1010B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE NAMES IN A GENERIC PACKAGE BODY ARE STATICALLY
- -- IDENTIFIED (I.E., BOUND) AT THE POINT WHERE THE GENERIC BODY
- -- TEXTUALLY OCCURS, AND ARE NOT DYNAMICALLY BOUND AT THE POINT
- -- OF INSTANTIATION.
- 
- -- ASL 8/13/81
- 
- WITH REPORT;
- PROCEDURE CC1010B IS
- 
-      USE REPORT;
-      FREE : CONSTANT INTEGER := 5;
- BEGIN
-      TEST("CC1010B","PROPER VISIBILITY OF FREE IDENTIFIERS IN " &
-           "GENERIC PACKAGE DECLARATIONS, BODIES AND INSTANTIATIONS");
- 
-      DECLARE
-           GENERIC
-                GFP : INTEGER := FREE;
-           PACKAGE P IS
-                SPECITEM : CONSTANT INTEGER := FREE;
-           END P;
-           
-           FREE : CONSTANT INTEGER := 6;
- 
-           PACKAGE BODY P IS
-                BODYITEM : INTEGER := FREE;
-           BEGIN
-                IF GFP /= 5 OR SPECITEM /= 5 OR BODYITEM /= 6 THEN
-                     FAILED ("BINDINGS INCORRECT");
-                END IF;
-           END P;
-      BEGIN
-           DECLARE
-                FREE : CONSTANT INTEGER := 7;
-                PACKAGE INST IS NEW P;
-           BEGIN
-                NULL;
-           END;
-      END;
- 
-      RESULT;
- END CC1010B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1018a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1018a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1018a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1018a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CC1018A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A FORMAL OUT PARAMETER OF A GENERIC FORMAL SUBPROGRAM CAN 
- -- HAVE A FORMAL LIMITED TYPE AND AN ARRAY TYPE WITH LIMITED COMPONENTS.
- 
- -- AH  10/3/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC1018A IS
-      TYPE INT IS RANGE 1..10;
-      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INT;
-      INT_OBJ : INT := 4;
-      ARR_OBJ : ARR(1..5) := (2, 8, 2, 8, 2);
- 
-      GENERIC
-           TYPE GLP IS LIMITED PRIVATE;
-           TYPE GARR IS ARRAY (INTEGER RANGE <>) OF GLP;
-           LP_OBJ : IN OUT GLP;
-           GA_OBJ : IN OUT GARR;
-           WITH PROCEDURE P (X : OUT GLP; Y : OUT GARR);
-           WITH FUNCTION SAME (LEFT, RIGHT : GLP) RETURN BOOLEAN;
-      PROCEDURE GEN_PROC;
- 
-      PROCEDURE GET_VALUES (X1 : OUT INT; Y1 : OUT ARR) IS
-      BEGIN
-           X1 := 4;
-           Y1 := (2, 8, 2, 8, 2);
-      END GET_VALUES;
- 
-      FUNCTION SAME_VALUE (LEFT, RIGHT : INT) RETURN BOOLEAN IS 
-      BEGIN
-           RETURN LEFT = RIGHT;
-      END SAME_VALUE;
- 
-      PROCEDURE GEN_PROC IS
-           LP : GLP;
-           A : GARR(1..5);
-      BEGIN
-           P(LP, A);
-           IF NOT SAME(LP, LP_OBJ) THEN
-                FAILED ("LIMITED PRIVATE TYPE HAS INCORRECT VALUE");
-           END IF;
- 
-           FOR INDEX IN A'RANGE LOOP
-                IF NOT SAME(A(INDEX), GA_OBJ(INDEX)) THEN
-                     FAILED ("LIMITED PRIVATE TYPE COMPONENT " & 
-                             "HAS INCORRECT VALUE");
-                END IF;
-           END LOOP;
-      END GEN_PROC;
- 
-      PROCEDURE TEST_LP IS NEW GEN_PROC(INT, ARR, INT_OBJ, ARR_OBJ,
-                                        GET_VALUES, SAME_VALUE);
- 
- BEGIN
-      TEST ("CC1018A", "A GENERIC FORMAL SUBPROGRAM OUT PRARAMETER " & 
-                       "CAN HAVE A LIMITED TYPE");
-      TEST_LP;
- 
-      RESULT;
- END CC1018A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1104c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1104c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1104c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- CC1104C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE;
- --     CHECK THAT A GENERIC FORMAL IN OUT PARAMETER CAN HAVE A
- --     LIMITED TYPE.
- 
- -- HISTORY:
- --     BCB 08/03/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1104C IS
- 
-      TASK TYPE TSK IS
-           ENTRY E;
-      END TSK;
- 
-      VAR : INTEGER := IDENT_INT(0);
-      NEW_VAL : INTEGER := IDENT_INT(5);
- 
-      TSK_VAR : TSK;
- 
-      PACKAGE PP IS
-           TYPE LP IS LIMITED PRIVATE;
-           PROCEDURE INIT (ONE : OUT LP; TWO : INTEGER);
-           FUNCTION EQUAL (ONE : LP; TWO : INTEGER) RETURN BOOLEAN;
-      PRIVATE
-           TYPE LP IS RANGE 1 .. 100;
-      END PP;
- 
-      USE PP;
- 
-      TYPE REC IS RECORD
-           COMP : LP;
-      END RECORD;
- 
-      C : LP;
- 
-      REC_VAR : REC;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-           IN_OUT_VAR : IN OUT T;
-           IN_OUT_TSK : IN OUT TSK;
-           VAL : IN OUT T;
-           WITH PROCEDURE INIT (L : IN OUT T; R : T);
-      PROCEDURE P;
- 
-      GENERIC
-           VAL : IN OUT LP;
-      PROCEDURE Q;
- 
-      GENERIC
-           VAL : IN OUT REC;
-      PROCEDURE R;
- 
-      PACKAGE BODY PP IS
-           PROCEDURE INIT(ONE : OUT LP; TWO : INTEGER) IS
-           BEGIN
-                ONE := LP(TWO);
-           END INIT;
- 
-           FUNCTION EQUAL(ONE : LP; TWO : INTEGER) RETURN BOOLEAN IS
-           BEGIN
-                RETURN ONE = LP(TWO);
-           END EQUAL;
-      END PP;
- 
-      TASK BODY TSK IS
-      BEGIN
-           ACCEPT E;
-      END TSK;
- 
-      PROCEDURE P IS
-      BEGIN
-           INIT(IN_OUT_VAR,VAL);
-           IN_OUT_TSK.E;
-           INIT(C,50);
-      END P;
- 
-      PROCEDURE Q IS
-      BEGIN
-           INIT(VAL,75);
-           INIT(REC_VAR.COMP,50);
-      END Q;
- 
-      PROCEDURE R IS
-      BEGIN
-           INIT(VAL.COMP,75);
-      END R;
- 
-      PROCEDURE I (ONE : IN OUT INTEGER; TWO : INTEGER) IS
-      BEGIN
-           ONE := TWO;
-      END I;
- 
-      PROCEDURE NEW_P IS NEW P(INTEGER,VAR,TSK_VAR,NEW_VAL,I);
- 
-      PROCEDURE NEW_Q IS NEW Q(C);
- 
-      PROCEDURE NEW_R IS NEW R(REC_VAR);
- 
- BEGIN
-      TEST ("CC1104C", "CHECK THAT A GENERIC FORMAL IN OUT PARAMETER " &
-                       "CAN HAVE A LIMITED TYPE");
- 
-      NEW_P;
- 
-      IF NOT EQUAL(VAR,5) THEN
-           FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
-                   "GENERIC PACKAGE - 1");
-      END IF;
- 
-      NEW_Q;
- 
-      IF NOT EQUAL(C,75) THEN
-           FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
-                   "GENERIC PACKAGE - 2");
-      END IF;
- 
-      NEW_R;
- 
-      IF NOT EQUAL(REC_VAR.COMP,75) THEN
-           FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
-                   "GENERIC PACKAGE - 3");
-      END IF;
- 
-      RESULT;
- END CC1104C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1107b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1107b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1107b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1107b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CC1107B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DEFAULT EXPRESSION MAY REFER TO AN EARLIER FORMAL
- --     PARAMETER OF THE SAME GENERIC FORMAL PART.
- 
- -- HISTORY:
- --     BCB 08/03/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1107B IS
- 
-      J, I : INTEGER;
- 
-      X : INTEGER := IDENT_INT(0);
- 
-      VAL : INTEGER := IDENT_INT(10);
- 
-      GENERIC
-           X : INTEGER := IDENT_INT(5);
-           Y : INTEGER := X;
-      FUNCTION F RETURN INTEGER;
- 
-      GENERIC
-           X : INTEGER;
-           Y : INTEGER := X;
-      FUNCTION G RETURN INTEGER;
- 
-      FUNCTION F RETURN INTEGER IS
-      BEGIN
-           IF NOT EQUAL(X,Y) THEN
-                FAILED ("WRONG VALUE FROM EARLIER FORMAL PARAMETER - 1");
-           END IF;
- 
-           RETURN 0;
-      END F;
- 
-      FUNCTION G RETURN INTEGER IS
-      BEGIN
-           IF NOT EQUAL(X,Y) THEN
-                FAILED ("WRONG VALUE FROM EARLIER FORMAL PARAMETER - 2");
-           END IF;
- 
-           RETURN 0;
-      END G;
- 
-      FUNCTION NEW_F IS NEW F;
- 
-      FUNCTION NEW_G IS NEW G(VAL);
- 
- BEGIN
-      TEST ("CC1107B", "CHECK THAT A DEFAULT EXPRESSION MAY REFER " &
-                       "TO AN EARLIER FORMAL PARAMETER OF THE SAME " &
-                       "GENERIC FORMAL PART");
- 
-      J := NEW_F;
- 
-      I := NEW_G;
- 
-      RESULT;
- END CC1107B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1111a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1111a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1111a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1111a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,322 ****
- -- CC1111A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AFTER A GENERIC UNIT IS INSTANTIATED, THE SUBTYPE OF
- --     AN IN OUT OBJECT PARAMETER IS DETERMINED BY THE ACTUAL PARAMETER
- --     (TESTS INTEGER, ENUMERATION, FLOATING POINT, FIXED POINT, ARRAY,
- --     ACCESS, AND DISCRIMINATED TYPES).
- 
- -- HISTORY:
- --     BCB 03/28/88  CREATED ORIGINAL TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1111A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 0..5;
-      INTVAR : INTEGER RANGE 1..3;
- 
-      TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT);
-      SUBTYPE SUBENUM IS ENUM RANGE ONE .. FIVE;
-      ENUMVAR : ENUM RANGE TWO .. THREE;
- 
-      TYPE FLT IS DIGITS 5 RANGE -5.0 .. 5.0;
-      SUBTYPE SUBFLT IS FLT RANGE -1.0 .. 1.0;
-      FLTVAR : FLT RANGE 0.0 .. 1.0;
- 
-      TYPE FIX IS DELTA 0.5 RANGE -5.0 .. 5.0;
-      SUBTYPE SUBFIX IS FIX RANGE -1.0 .. 1.0;
-      FIXVAR : FIX RANGE 0.0 .. 1.0;
- 
-      SUBTYPE STR IS STRING (1..10);
-      STRVAR : STRING (1..5);
- 
-      TYPE REC (DISC : INTEGER := 5) IS RECORD
-           NULL;
-      END RECORD;
-      SUBTYPE SUBREC IS REC (6);
-      RECVAR : REC(5);
-      SUBRECVAR : SUBREC;
- 
-      TYPE ACCREC IS ACCESS REC;
-      SUBTYPE A1 IS ACCREC(1);
-      SUBTYPE A2 IS ACCREC(2);
-      A1VAR : A1 := NEW REC(1);
-      A2VAR : A2 := NEW REC(2);
- 
-      PACKAGE P IS
-           TYPE PRIV IS PRIVATE;
-      PRIVATE
-           TYPE PRIV IS RANGE 1 .. 100;
-           SUBTYPE SUBPRIV IS PRIV RANGE 5 .. 10;
-           PRIVVAR : PRIV RANGE 8 .. 10;
-      END P;
- 
-      PACKAGE BODY P IS
-           FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN;
- 
-           FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN IS
-           BEGIN
-                RETURN ONE = TWO;
-           END PRIVEQUAL;
- 
-           GENERIC
-                INPUT : SUBPRIV;
-                OUTPUT : IN OUT SUBPRIV;
-           PROCEDURE I;
- 
-           PROCEDURE I IS
-           BEGIN
-                OUTPUT := INPUT;
-                FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                        "PRIVATE TYPE");
-                IF PRIVEQUAL (OUTPUT, OUTPUT) THEN
-                     COMMENT ("DON'T OPTIMIZE OUTPUT");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END I;
- 
-           PROCEDURE I1 IS NEW I (5, PRIVVAR);
-           PROCEDURE I2 IS NEW I (SUBPRIV'FIRST, PRIVVAR);
- 
-      BEGIN
-           TEST ("CC1111A", "CHECK THAT AFTER A GENERIC UNIT IS " &
-                            "INSTANTIATED, THE SUBTYPE OF AN IN OUT " &
-                            "OBJECT PARAMETER IS DETERMINED BY THE " &
-                            "ACTUAL PARAMETER (TESTS INTEGER, " &
-                            "ENUMERATION, FLOATING POINT, FIXED POINT " &
-                            ", ARRAY, ACCESS, AND DISCRIMINATED TYPES)");
- 
-           I1;
-           I2;
-      END P;
- 
-      USE P;
- 
-      GENERIC
-           TYPE GP IS PRIVATE;
-      FUNCTION GEN_IDENT (X : GP) RETURN GP;
- 
-      GENERIC
-           INPUT : INT;
-           OUTPUT : IN OUT INT;
-      PROCEDURE B;
- 
-      GENERIC
-           INPUT : SUBENUM;
-           OUTPUT : IN OUT SUBENUM;
-      PROCEDURE C;
- 
-      GENERIC
-           INPUT : SUBFLT;
-           OUTPUT : IN OUT SUBFLT;
-      PROCEDURE D;
- 
-      GENERIC
-           INPUT : SUBFIX;
-           OUTPUT : IN OUT SUBFIX;
-      PROCEDURE E;
- 
-      GENERIC
-           INPUT : STR;
-           OUTPUT : IN OUT STR;
-      PROCEDURE F;
- 
-      GENERIC
-           INPUT : A1;
-           OUTPUT : IN OUT A1;
-      PROCEDURE G;
- 
-      GENERIC
-           INPUT : SUBREC;
-           OUTPUT : IN OUT SUBREC;
-      PROCEDURE H;
- 
-      GENERIC
-           TYPE GP IS PRIVATE;
-      FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN;
- 
-      FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN IS
-      BEGIN
-           RETURN ONE = TWO;
-      END GENEQUAL;
- 
-      FUNCTION GEN_IDENT (X : GP) RETURN GP IS
-      BEGIN
-                RETURN X;
-      END GEN_IDENT;
- 
-      FUNCTION INT_IDENT IS NEW GEN_IDENT (INT);
-      FUNCTION SUBENUM_IDENT IS NEW GEN_IDENT (SUBENUM);
-      FUNCTION SUBFLT_IDENT IS NEW GEN_IDENT (SUBFLT);
-      FUNCTION SUBFIX_IDENT IS NEW GEN_IDENT (SUBFIX);
- 
-      FUNCTION ENUMEQUAL IS NEW GENEQUAL (SUBENUM);
-      FUNCTION FLTEQUAL IS NEW GENEQUAL (SUBFLT);
-      FUNCTION FIXEQUAL IS NEW GENEQUAL (SUBFIX);
-      FUNCTION STREQUAL IS NEW GENEQUAL (STR);
-      FUNCTION ACCEQUAL IS NEW GENEQUAL (A2);
-      FUNCTION RECEQUAL IS NEW GENEQUAL (REC);
- 
-      PROCEDURE B IS
-      BEGIN
-           OUTPUT := INPUT;
-           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                   "INTEGER TYPE");
-           IF EQUAL (OUTPUT, OUTPUT) THEN
-                COMMENT ("DON'T OPTIMIZE OUTPUT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END B;
- 
-      PROCEDURE C IS
-      BEGIN
-           OUTPUT := INPUT;
-           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                   "ENUMERATION TYPE");
-           IF ENUMEQUAL (OUTPUT, OUTPUT) THEN
-                COMMENT ("DON'T OPTIMIZE OUTPUT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END C;
- 
-      PROCEDURE D IS
-      BEGIN
-           OUTPUT := INPUT;
-           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                   "FLOATING POINT TYPE");
-           IF FLTEQUAL (OUTPUT, OUTPUT) THEN
-                COMMENT ("DON'T OPTIMIZE OUTPUT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END D;
- 
-      PROCEDURE E IS
-      BEGIN
-           OUTPUT := INPUT;
-           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                   "FIXED POINT TYPE");
-           IF FIXEQUAL (OUTPUT, OUTPUT) THEN
-                COMMENT ("DON'T OPTIMIZE OUTPUT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END E;
- 
-      PROCEDURE F IS
-      BEGIN
-           OUTPUT := INPUT;
-           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                   "ARRAY TYPE");
-           IF STREQUAL (OUTPUT, OUTPUT) THEN
-                COMMENT ("DON'T OPTIMIZE OUTPUT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END F;
- 
-      PROCEDURE G IS
-      BEGIN
-           OUTPUT := INPUT;
-           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                   "ACCESS TYPE");
-           IF ACCEQUAL (OUTPUT, OUTPUT) THEN
-                COMMENT ("DON'T OPTIMIZE OUTPUT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END G;
- 
-      PROCEDURE H IS
-      BEGIN
-           OUTPUT := INPUT;
-           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
-                   "DISCRIMINATED RECORD TYPE");
-           IF RECEQUAL (OUTPUT, OUTPUT) THEN
-                COMMENT ("DON'T OPTIMIZE OUTPUT");
-           END IF;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END H;
- 
-      PROCEDURE B1 IS NEW B (4, INTVAR);
-      PROCEDURE C1 IS NEW C (FOUR, ENUMVAR);
-      PROCEDURE D1 IS NEW D (-1.0, FLTVAR);
-      PROCEDURE E1 IS NEW E (-1.0, FIXVAR);
-      PROCEDURE F1 IS NEW F ("9876543210", STRVAR);
-      PROCEDURE G1 IS NEW G (A1VAR, A2VAR);
-      PROCEDURE H1 IS NEW H (SUBRECVAR, RECVAR);
- 
-      PROCEDURE B2 IS NEW B (INT_IDENT(INT'FIRST), INTVAR);
-      PROCEDURE C2 IS NEW C (SUBENUM_IDENT(SUBENUM'FIRST), ENUMVAR);
-      PROCEDURE D2 IS NEW D (SUBFLT_IDENT(SUBFLT'FIRST), FLTVAR);
-      PROCEDURE E2 IS NEW E (SUBFIX_IDENT(SUBFIX'FIRST), FIXVAR);
- 
- BEGIN
- 
-      B1;
-      C1;
-      D1;
-      E1;
-      F1;
-      G1;
-      H1;
- 
-      B2;
-      C2;
-      D2;
-      E2;
- 
-      RESULT;
- END CC1111A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1204a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1204a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1204a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- CC1204A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT GENERIC FORMAL TYPES MAY HAVE A DISCRIMINANT PART,
- -- WHICH MAY BE OF A GENERIC FORMAL TYPE.
- 
- -- DAT 8/14/81
- -- SPS 5/12/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1204A IS
- BEGIN
-      TEST ("CC1204A", "DISCRIMINANT PARTS FOR GENERIC FORMAL TYPES");
- 
-      DECLARE
-           GENERIC
-                TYPE T IS ( <> );
-                TYPE I IS RANGE <> ;
-                TYPE R1 (C : BOOLEAN) IS PRIVATE;
-                TYPE R2 (C : T) IS PRIVATE;
-                TYPE R3 (C : I) IS LIMITED PRIVATE;
-                P1 : IN R1;
-                P2 : IN R2;
-                V1 : IN OUT R1;
-                V2 : IN OUT R2;
-                V3 : IN OUT R3;
-           PROCEDURE PROC;
- 
-           TYPE DD IS NEW INTEGER RANGE 1 .. 10;
-           TYPE ARR IS ARRAY (DD RANGE <>) OF CHARACTER;
-           TYPE RECD (C : DD := DD (IDENT_INT (1))) IS
-                RECORD
-                     C1 : ARR (1..C);
-                END RECORD;
- 
-           X1 : RECD;
-           X2 : RECD := (1, "Y");
- 
-           TYPE RECB (C : BOOLEAN) IS
-                RECORD
-                     V : INTEGER := 6;
-                END RECORD;
-           RB : RECB (IDENT_BOOL (TRUE));
-           RB1 : RECB (IDENT_BOOL (TRUE));
- 
-           PROCEDURE PROC IS
-           BEGIN
-                IF P1.C /= TRUE
-                   OR P2.C /= T'FIRST
-                   OR V1.C /= TRUE
-                   OR V2.C /= T'FIRST
-                   OR V3.C /= I'FIRST
-                THEN
-                     FAILED ("WRONG GENERIC PARAMETER VALUE");
-                END IF;
- 
-                V1 := P1;
-                V2 := P2;
- 
-                IF V1 /= P1
-                   OR V2 /= P2 
-                THEN
-                     FAILED ("BAD ASSIGNMENT TO GENERIC PARAMETERS");
-                END IF;
-           END PROC;
- 
-      BEGIN
-           RB1.V := IDENT_INT (1);
-           X1.C1 := "X";
- 
-           DECLARE
-      
-                PROCEDURE PR IS NEW PROC
-                     (T => DD,
-                      I => DD,
-                      R1 => RECB,
-                      R2 => RECD,
-                      R3 => RECD,
-                      P1 => RB1,
-                      P2 => X1,
-                      V1 => RB,
-                      V2 => X2,
-                      V3 => X2);
-           BEGIN
-                PR;
-                IF RB /= (TRUE, 1) OR X2.C1 /= "X" THEN
-                     FAILED ("PR NOT CALLED CORRECTLY");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END CC1204A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- CC1207B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH DISCRIMINANTS IS
- --     ALLOWED AS THE TYPE OF A SUBPROGRAM OR AN ENTRY FORMAL
- --     PARAMETER, AND AS THE TYPE OF A GENERIC FORMAL OBJECT PARAMETER,
- --     AS A GENERIC ACTUAL PARAMETER, AND IN A MEMBERSHIP TEST, IN A
- --     SUBTYPE DECLARATION, IN AN ACCESS TYPE DEFINITION, AND IN A
- --     DERIVED TYPE DEFINITION.
- 
- -- HISTORY:
- --     BCB 08/04/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1207B IS
- 
-      GENERIC
-           TYPE X (L : INTEGER) IS PRIVATE;
-      PACKAGE PACK IS
-      END PACK;
- 
- BEGIN
-      TEST ("CC1207B", "CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH " &
-                       "DISCRIMINANTS IS ALLOWED AS THE TYPE OF A " &
-                       "SUBPROGRAM OR AN ENTRY FORMAL PARAMETER, AND " &
-                       "AS THE TYPE OF A GENERIC FORMAL OBJECT " &
-                       "PARAMETER, AS A GENERIC ACTUAL PARAMETER, AND " &
-                       "IN A MEMBERSHIP TEST, IN A SUBTYPE " &
-                       "DECLARATION, IN AN ACCESS TYPE DEFINITION, " &
-                       "AND IN A DERIVED TYPE DEFINITION");
- 
-      DECLARE
-           TYPE REC (D : INTEGER := 3) IS RECORD
-                NULL;
-           END RECORD;
- 
-           GENERIC
-                TYPE R (D : INTEGER) IS PRIVATE;
-                OBJ : R;
-           PACKAGE P IS
-                PROCEDURE S (X : R);
- 
-                TASK T IS
-                     ENTRY E (Y : R);
-                END T;
- 
-                SUBTYPE SUB_R IS R;
- 
-                TYPE ACC_R IS ACCESS R;
- 
-                TYPE NEW_R IS NEW R;
- 
-                BOOL : BOOLEAN := (OBJ IN R);
- 
-                SUB_VAR : SUB_R(5);
- 
-                ACC_VAR : ACC_R := NEW R(5);
- 
-                NEW_VAR : NEW_R(5);
- 
-                PACKAGE NEW_PACK IS NEW PACK (R);
-           END P;
- 
-           REC_VAR : REC(5) := (D => 5);
- 
-           PACKAGE BODY P IS
-                PROCEDURE S (X : R) IS
-                BEGIN
-                     IF NOT EQUAL(X.D,5) THEN
-                          FAILED ("WRONG DISCRIMINANT VALUE - S");
-                     END IF;
-                END S;
- 
-                TASK BODY T IS
-                BEGIN
-                     ACCEPT E (Y : R) DO
-                          IF NOT EQUAL(Y.D,5) THEN
-                               FAILED ("WRONG DISCRIMINANT VALUE - T");
-                          END IF;
-                     END E;
-                END T;
-           BEGIN
-                IF NOT EQUAL(OBJ.D,5) THEN
-                     FAILED ("IMPROPER DISCRIMINANT VALUE");
-                END IF;
- 
-                S (OBJ);
- 
-                T.E (OBJ);
- 
-                IF NOT EQUAL(SUB_VAR.D,5) THEN
-                     FAILED ("IMPROPER DISCRIMINANT VALUE - SUBTYPE");
-                END IF;
- 
-                IF NOT EQUAL(ACC_VAR.D,5) THEN
-                     FAILED ("IMPROPER DISCRIMINANT VALUE - ACCESS");
-                END IF;
- 
-                IF NOT EQUAL(NEW_VAR.D,5) THEN
-                     FAILED ("IMPROPER DISCRIMINANT VALUE - DERIVED");
-                END IF;
- 
-                IF NOT BOOL THEN
-                     FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
-                END IF;
-           END P;
- 
-           PACKAGE NEW_P IS NEW P (REC,REC_VAR);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC1207B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- -- CC1220A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A GENERIC UNIT CAN REFER TO AN IMPLICITLY
- --     DECLARED PREDEFINED OPERATOR.
- 
- -- HISTORY:
- --     DAT 08/20/81  CREATED ORIGINAL TEST.
- --     SPS 05/03/82
- --     BCB 08/04/88  MODIFIED HEADER FORMAT AND ADDED CHECKS FOR OTHER
- --                   OPERATIONS OF A DISCRETE TYPE.
- --     RJW 03/27/90  REVISED TEST TO CHECK FOR A GENERIC FORMAL
- --                   DISCRETE TYPE.
- --     CJJ 10/14/90  ADDED CHECKS FOR RELATIONAL OPERATOR (<, <=, >, >=);
- --                   MADE FAILED MESSAGES IN PROCEDURE BODY MORE SPECIFIC.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE CC1220A IS
- 
- BEGIN
-      TEST ("CC1220A", "GENERIC UNIT CAN REFER TO IMPLICITLY " &
-            "DECLARED OPERATORS");
- 
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T IS (<>);
-                STR : STRING;
-                P1 : T := T'FIRST;
-                P2 : T := T(T'SUCC (P1));
-                P3 : T := T'(T'PRED (P2));
-                P4 : INTEGER := IDENT_INT(T'WIDTH);
-                P5 : BOOLEAN := (P1 < P2) AND (P2 > P3);
-                P6: BOOLEAN := (P1 <= P3) AND (P2 >= P1);
-                P7 : BOOLEAN := (P3 = P1);
-                P8 : T := T'BASE'FIRST;
-                P10 : T := T'LAST;
-                P11 : INTEGER := T'SIZE;
-                P12 : ADDRESS := P10'ADDRESS;
-                P13 : INTEGER := T'WIDTH;
-                P14 : INTEGER := T'POS(T'LAST);
-                P15 : T := T'VAL(1);
-                P16 : INTEGER := T'POS(P15);
-                P17 : STRING := T'IMAGE(T'BASE'LAST);
-                P18 : T := T'VALUE(P17);
-                P19 : BOOLEAN := (P15 IN T);
-                WITH FUNCTION IDENT (X : T) RETURN T;
-           PACKAGE PKG IS
-                ARR : ARRAY (1 .. 3) OF T := (P1,P2,P3);
-                B1 : BOOLEAN := P7 AND P19;
-                B2 : BOOLEAN := P5 AND P6;
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF P1 /= T(T'FIRST) THEN
-                     FAILED ("IMPROPER VALUE FOR 'FIRST - " & STR);
-                END IF;
- 
-                IF T'SUCC (P1) /= IDENT (P2) OR
-                   T'PRED (P2) /= IDENT (P1) THEN
-                     FAILED ("IMPROPER VALUE FOR 'SUCC, PRED - " & STR);
-                END IF;
- 
-                IF P10 /= T(T'LAST) THEN
-                     FAILED ("IMPROPER VALUE FOR 'LAST - " & STR);
-                END IF;
- 
-                IF NOT EQUAL(P11,T'SIZE) THEN
-                     FAILED ("IMPROPER VALUE FOR 'SIZE - " & STR);
-                END IF;
- 
-                IF NOT EQUAL(P13,T'WIDTH) THEN
-                     FAILED ("IMPROPER VALUE FOR 'WIDTH - " & STR);
-                END IF;
- 
-                IF NOT EQUAL (P16, T'POS (P15)) OR
-                   T'VAL (P16) /= T(IDENT (P15)) THEN
-                     FAILED ("IMPROPER VALUE FOR 'POS, 'VAL - " & STR);
-                END IF;
- 
-                IF T'VALUE (P17) /= T'BASE'LAST OR
-                   T'IMAGE (P18) /= T'IMAGE (T'BASE'LAST) THEN
-                     FAILED ("IMPROPER VALUE FOR 'VALUE, 'IMAGE - " &
-                              STR);
-                END IF;
-           END PKG;
- 
-      BEGIN
-           DECLARE
-                TYPE CHAR IS ('A', 'B', 'C', 'D', 'E');
- 
-                FUNCTION IDENT (C : CHAR) RETURN CHAR IS
-                BEGIN
-                     RETURN CHAR'VAL (IDENT_INT (CHAR'POS (C)));
-                END IDENT;
- 
-                PACKAGE N_CHAR IS NEW PKG (T => CHAR, STR => "CHAR",
-                                           IDENT => IDENT);
-           BEGIN
-                IF N_CHAR.ARR (1) /= IDENT ('A') OR
-                   N_CHAR.ARR (2) /= IDENT ('B') OR
-                   N_CHAR.ARR (3) /= 'A' OR
-                   N_CHAR.B1 /= TRUE OR
-                  N_CHAR.B2 /= TRUE THEN
-                     FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
-                             " IN INSTANTIATION OF N_CHAR.");
-                END IF;
-           END;
- 
-           DECLARE
-                TYPE ENUM IS (JOVIAL, ADA, FORTRAN, BASIC);
- 
-                FUNCTION IDENT (C : ENUM) RETURN ENUM IS
-                BEGIN
-                     RETURN ENUM'VAL (IDENT_INT (ENUM'POS (C)));
-                END IDENT;
- 
-                PACKAGE N_ENUM IS NEW PKG (T => ENUM, STR => "ENUM",
-                                           IDENT => IDENT);
- 
-           BEGIN
-                IF N_ENUM.ARR (1) /= IDENT (JOVIAL) OR
-                   N_ENUM.ARR (2) /= IDENT (ADA) OR
-                   N_ENUM.ARR (3) /= JOVIAL OR
-                   N_ENUM.B1 /= TRUE OR
-                   N_ENUM.B2 /= TRUE THEN
-                     FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
-                             " IN INSTANTIATION OF N_ENUM.");
-                END IF;
-           END;
- 
-           DECLARE
- 
-                PACKAGE N_INT IS NEW PKG (T => INTEGER, STR => "INTEGER",
-                                           IDENT => IDENT_INT);
-           BEGIN
-                IF N_INT.ARR (1) /= IDENT_INT (INTEGER'FIRST) OR
-                   N_INT.ARR (2) /= IDENT_INT (INTEGER'FIRST + 1) OR
-                   N_INT.ARR (3) /= INTEGER'FIRST OR
-                   N_INT.B1 /= TRUE OR
-                   N_INT.B2 /= TRUE THEN
-                     FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
-                             " IN INSTANTIATION OF N_INT.");
-                END IF;
-           END;
-      END;
-      RESULT;
- END CC1220A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- CC1221A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
- --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
- --     WITHIN THE GENERIC UNIT:  ASSIGNMENT, MEMBERSHIP, QUALIFICATION,
- --     AND EXPLICIT CONVERSION TO AND FROM OTHER INTEGER TYPES.
- 
- -- HISTORY:
- --     RJW 09/26/86  CREATED ORIGINAL TEST.
- --     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.  SPLIT TEST
- --                   INTO PARTS A, B, C, AND D.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CC1221A IS
- 
-      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
-      TYPE NEWINT IS NEW INTEGER;
-      TYPE INT IS RANGE -300 .. 300;
- 
- BEGIN
-      TEST ( "CC1221A", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
-                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
-                        "DECLARED AND ARE THEREFORE AVAILABLE " &
-                        "WITHIN THE GENERIC UNIT:  ASSIGNMENT, " &
-                        "MEMBERSHIP, QUALIFICATION, AND EXPLICIT " &
-                        "CONVERSION TO AND FROM OTHER INTEGER TYPES");
- 
-      DECLARE -- (A) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
-              --     PART I.
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-                TYPE T1 IS RANGE <>;
-                I  : T;
-                I1 : T1;
-           PROCEDURE P (J : T; STR : STRING);
- 
-           PROCEDURE P (J : T; STR : STRING) IS
-                SUBTYPE ST IS T RANGE T'VAL (-1) .. T'VAL (1);
-                K, L  : T;
- 
-                FUNCTION F (X : T) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN IDENT_BOOL (TRUE);
-                END F;
- 
-                FUNCTION F (X : T1) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN IDENT_BOOL (FALSE);
-                END F;
- 
-           BEGIN
-                K := I;
-                L := J;
-                K := L;
- 
-                IF K /= J THEN
-                     FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
-                              "WITH TYPE - " & STR);
-                END IF;
- 
-                IF I IN ST THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
-                              "TYPE  - " & STR);
-                END IF;
- 
-                IF J NOT IN ST THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
-                              "TYPE  - " & STR);
-                END IF;
- 
-                IF T'(I) /= I THEN
-                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
-                              "WITH TYPE - " & STR & " - 1" );
-                END IF;
- 
-                IF F (T'(1)) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
-                              "WITH TYPE - " & STR & " - 2" );
-                END IF;
- 
-                IF T (I1) /= I THEN
-                     FAILED ( "INCORRECT RESULTS FOR EXPLICIT " &
-                              "CONVERSION WITH TYPE - " & STR &
-                              " - 1" );
-                END IF;
- 
-                IF F (T (I1)) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR EXPLICIT  " &
-                              "CONVERSION WITH TYPE - " & STR &
-                              " - 2" );
-                END IF;
- 
-           END P;
- 
-           PROCEDURE NP1 IS NEW P (SUBINT,  SUBINT,  0, 0);
-           PROCEDURE NP2 IS NEW P (NEWINT,  NEWINT,  0, 0);
-           PROCEDURE NP3 IS NEW P (INT,     INT,     0, 0);
-           PROCEDURE NP4 IS NEW P (INTEGER, INTEGER, 0, 0);
- 
-      BEGIN
-           NP1 (2, "SUBINT");
-           NP2 (2, "NEWINT");
-           NP3 (2, "INT");
-           NP4 (2, "INTEGER");
-      END; -- (A).
- 
-      RESULT;
- END CC1221A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- CC1221B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
- --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
- --     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, 'LAST, 'WIDTH,
- --     'ADDRESS, AND 'SIZE.
- 
- -- HISTORY:
- --     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CC1221B IS
- 
-      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
-      SUBTYPE NOINT IS INTEGER RANGE 1 .. -1;
-      TYPE NEWINT IS NEW INTEGER;
-      TYPE INT IS RANGE -300 .. 300;
-      SUBTYPE SINT1 IS INT
-           RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
-      SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
-      TYPE INT2 IS RANGE 0E8 .. 1E3;
- 
- BEGIN
-      TEST ( "CC1221B", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
-                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
-                        "DECLARED AND ARE THEREFORE AVAILABLE " &
-                        "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, " &
-                        "'LAST, 'WIDTH, 'ADDRESS, AND 'SIZE");
- 
-      DECLARE -- (B) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
-              --     PART II.
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-                F, L : T;
-                W : INTEGER;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                I : INTEGER := F'SIZE;
-                T1 : T;
-                A : ADDRESS := T1'ADDRESS;
- 
-           BEGIN
-                IF T'FIRST /= F THEN
-                     FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
-                END IF;
- 
-                IF T'LAST /= L THEN
-                     FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
-                END IF;
- 
-                IF T'BASE'FIRST > T'FIRST THEN
-                     FAILED ( "INCORRECT RESULTS WITH " & STR &
-                              "'BASE'FIRST" );
-                END IF;
- 
-                IF T'BASE'LAST < T'LAST THEN
-                     FAILED ( "INCORRECT RESULTS WITH " & STR &
-                              "'BASE'LAST" );
-                END IF;
- 
-                IF T'WIDTH /= W THEN
-                     FAILED ( "INCORRECT VALUE FOR " & STR &
-                              "'WIDTH" );
-                END IF;
- 
-                IF T'BASE'WIDTH < T'WIDTH THEN
-                     FAILED ( "INCORRECT RESULTS WITH " & STR &
-                              "'BASE'WIDTH" );
-                END IF;
- 
-           END P;
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           PROCEDURE Q;
- 
-           PROCEDURE Q IS
-           BEGIN
-                IF T'FIRST /= 1 THEN
-                     FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
-                END IF;
- 
-                IF T'LAST /= -1 THEN
-                     FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
-                END IF;
- 
-                IF T'BASE'FIRST > T'FIRST THEN
-                     FAILED ( "INCORRECT RESULTS WITH " &
-                              "NOINT'BASE'FIRST" );
-                END IF;
- 
-                IF T'BASE'LAST < T'LAST THEN
-                     FAILED ( "INCORRECT RESULTS WITH " &
-                              "NOINT'BASE'LAST" );
-                END IF;
- 
-                IF T'WIDTH /= 0 THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                              "NOINT'WIDTH" );
-                END IF;
- 
-                IF T'BASE'WIDTH < T'WIDTH THEN
-                     FAILED ( "INCORRECT RESULTS WITH " &
-                              "NOINT'BASE'WIDTH" );
-                END IF;
- 
-           END Q;
- 
-           PROCEDURE P1 IS NEW P (INTEGER, INTEGER'FIRST, INTEGER'LAST,
-                                  INTEGER'WIDTH);
-           PROCEDURE P2 IS NEW P (SUBINT, -100, 100, 4);
-           PROCEDURE P3 IS NEW P (NEWINT, NEWINT'FIRST, NEWINT'LAST,
-                                  NEWINT'WIDTH);
-           PROCEDURE P4 IS NEW P (SINT1, -4, 4, 2);
-           PROCEDURE P5 IS NEW P (SINT2, 224, 255, 4);
-           PROCEDURE P6 IS NEW P (INT2 , 0, 1000, 5);
- 
-           PROCEDURE Q1 IS NEW Q (NOINT);
- 
-      BEGIN
-            P1 ( "INTEGER" );
-            P2 ( "SUBINT" );
-            P3 ( "NEWINT" );
-            P4 ( "SINT1" );
-            P5 ( "SINT2" );
-            P6 ( "INT2" );
- 
-            Q1;
- 
-      END; -- (B).
- 
-      RESULT;
- END CC1221B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,195 ****
- -- CC1221C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
- --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
- --     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'POS, 'VAL, 'PRED, 'SUCC,
- --     'IMAGE, AND 'VALUE.
- 
- -- HISTORY:
- --     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CC1221C IS
- 
-      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
-      TYPE NEWINT IS NEW INTEGER;
-      TYPE INT IS RANGE -300 .. 300;
-      SUBTYPE SINT1 IS INT
-           RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
-      TYPE INT1 IS RANGE -6 .. 6;
- 
- BEGIN
-      TEST ( "CC1221C", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
-                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
-                        "DECLARED AND ARE THEREFORE AVAILABLE " &
-                        "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'POS, " &
-                        "'VAL, 'PRED, 'SUCC, 'IMAGE, AND 'VALUE");
- 
-      DECLARE -- (C1) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
-              --      PART III.
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-                F : INTEGER;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
-                I : INTEGER;
-                Y : T;
- 
-                FUNCTION IDENT (X : T) RETURN T IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN X;
-                     ELSE
-                          RETURN T'SUCC (T'FIRST);
-                     END IF;
-                END IDENT;
- 
-           BEGIN
-                I := F;
-                FOR X IN T LOOP
-                     IF T'VAL (I) /= X THEN
-                          FAILED ( "WRONG VALUE FOR " & STR &
-                                   "'VAL OF " & INTEGER'IMAGE (I));
-                     END IF;
- 
-                     IF T'POS (X) /= I THEN
-                          FAILED ( "WRONG VALUE FOR " & STR &
-                                   "'POS OF " & T'IMAGE (X));
-                     END IF;
- 
-                     I := I + 1;
-                END LOOP;
- 
-                FOR X IN T LOOP
-                     IF T'SUCC (X) /= T'VAL (T'POS (X) + 1) THEN
-                          FAILED ( "WRONG VALUE FOR " & STR &
-                                   "'SUCC OF " & T'IMAGE (X));
-                     END IF;
- 
-                     IF T'PRED (X) /= T'VAL (T'POS (X) - 1) THEN
-                          FAILED ( "WRONG VALUE FOR " & STR &
-                                   "'PRED OF " & T'IMAGE (X));
-                     END IF;
-                END LOOP;
- 
-                BEGIN
-                     Y := T'SUCC (IDENT (T'BASE'LAST));
-                     FAILED ( "NO EXCEPTION RAISED FOR " &
-                               STR & "'SUCC (IDENT (" & STR &
-                              "'BASE'LAST))" );
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'SUCC (IDENT (" & STR &
-                                   "'BASE'LAST))" );
-                END;
- 
-                BEGIN
-                     Y := T'PRED (IDENT (T'BASE'FIRST));
-                     FAILED ( "NO EXCEPTION RAISED FOR " &
-                               STR & "'PRED (IDENT (" & STR &
-                              "'BASE'FIRST))" );
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
-                                    STR & "'PRED (IDENT (" & STR &
-                                   "'BASE'FIRST))" );
-                END;
- 
-           END P;
- 
-           PROCEDURE P1 IS NEW P (SUBINT, -100);
-           PROCEDURE P2 IS NEW P (SINT1, -4);
-           PROCEDURE P3 IS NEW P (INT1, -6);
- 
-      BEGIN
-            P1 ( "SUBINT" );
-            P2 ( "SINT" );
-            P3 ( "INT1" );
-      END; -- (C1).
- 
-      DECLARE -- (C2) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
-              --      PART IV.
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-                STR : STRING;
-           PACKAGE PKG IS END PKG;
- 
-           PACKAGE BODY PKG IS
-                PROCEDURE P (IM : STRING; VA : T) IS
-                BEGIN
-                     IF T'IMAGE (VA) /= IM THEN
-                          FAILED ( "INCORRECT RESULTS FOR " & STR &
-                                   "'IMAGE OF " &
-                                    INTEGER'IMAGE (INTEGER (VA)));
-                     END IF;
-                END P;
- 
-                PROCEDURE Q (IM : STRING; VA : T) IS
-                BEGIN
-                     IF T'VALUE (IM) /= VA THEN
-                          FAILED ( "INCORRECT RESULTS FOR " & STR &
-                                   "'VALUE OF " & IM);
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
-                                    STR &"'VALUE OF " & IM);
-                     WHEN OTHERS =>
-                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
-                                    STR &"'VALUE OF " & IM);
- 
-                END Q;
- 
-           BEGIN
-                P (" 2", 2);
-                P ("-1", -1);
- 
-                Q (" 2", 2);
-                Q ("-1", -1);
-                Q ("        2", 2);
-                Q ("-1     ", -1);
-           END PKG;
- 
-           PACKAGE PKG1 IS NEW PKG (SUBINT, "SUBINT");
-           PACKAGE PKG2 IS NEW PKG (SINT1, "SINT1");
-           PACKAGE PKG3 IS NEW PKG (INT1, "INT1");
-           PACKAGE PKG4 IS NEW PKG (NEWINT, "NEWINT");
- 
-      BEGIN
-           NULL;
-      END; -- (C2).
- 
-      RESULT;
- END CC1221C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1221d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1221d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,173 ****
- -- CC1221D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
- --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
- --     WITHIN THE GENERIC UNIT:  EXPLICIT CONVERSION TO AND FROM REAL
- --     TYPES AND IMPLICIT CONVERSION FROM INTEGER LITERALS.
- 
- -- HISTORY:
- --     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CC1221D IS
- 
-      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
-      TYPE INT IS RANGE -300 .. 300;
-      SUBTYPE SINT1 IS INT
-           RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
-      TYPE INT1 IS RANGE -6 .. 6;
- 
- BEGIN
-      TEST ( "CC1221D", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
-                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
-                        "DECLARED AND ARE THEREFORE AVAILABLE " &
-                        "WITHIN THE GENERIC UNIT:  EXPLICIT " &
-                        "CONVERSION TO AND FROM REAL TYPES AND " &
-                        "IMPLICIT CONVERSION FROM INTEGER LITERALS");
- 
-      DECLARE -- (D) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
-              --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
-              --     INTEGER LITERALS.
- 
-           GENERIC
-                TYPE T IS RANGE <>;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
- 
-                TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
-                FI0  : FIXED := 0.0;
-                FI2  : FIXED := 2.0;
-                FIN2 : FIXED := -2.0;
- 
-                FL0  : FLOAT := 0.0;
-                FL2  : FLOAT := 2.0;
-                FLN2 : FLOAT := -2.0;
- 
-                T0  : T := 0;
-                T2  : T := 2;
-                TN2 : T := -2;
- 
-                FUNCTION IDENT (X : T) RETURN T IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN X;
-                     ELSE
-                          RETURN T'FIRST;
-                     END IF;
-                END IDENT;
- 
-           BEGIN
-                IF T0 + 1 /= 1 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 1" );
-                END IF;
- 
-                IF T2 + 1 /= 3 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 2" );
-                END IF;
- 
-                IF TN2 + 1 /= -1 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 3" );
-                END IF;
- 
-                IF T (FI0) /= T0 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FIXED VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FI2) /= IDENT (T2) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FIXED VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FIN2) /= TN2 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FIXED VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FL0) /= IDENT (T0) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FL2) /= T2 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FLN2) /= IDENT (TN2) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FIXED (T0) /= FI0 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FIXED VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FIXED (IDENT (T2)) /= FI2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FIXED VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FIXED (TN2) /= FIN2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FIXED VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FLOAT (IDENT (T0)) /= FL0 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FLOAT (T2) /= FL2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FLOAT (IDENT (TN2)) /= FLN2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-           END P;
- 
-           PROCEDURE P1 IS NEW P (SUBINT);
-           PROCEDURE P2 IS NEW P (SINT1);
-           PROCEDURE P3 IS NEW P (INT1);
- 
-      BEGIN
-            P1 ( "SUBINT" );
-            P2 ( "SINT" );
-            P3 ( "INT1" );
-      END; -- (D).
- 
-      RESULT;
- END CC1221D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1222a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1222a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1222a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1222a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,290 ****
- -- CC1222A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- FOR A FORMAL FLOATING POINT TYPE, CHECK THAT THE FOLLOWING BASIC 
- -- OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
- -- WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS, 
- -- QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC TYPES, 
- -- AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL TO THE 
- -- FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DIGITS, 'MACHINE_RADIX,
- -- 'MACHINE_MANTISSA, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_ROUNDS,
- -- 'MACHINE_OVERFLOWS.
- 
- -- R.WILLIAMS 9/30/86
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- PROCEDURE CC1222A IS
- 
-      TYPE NEWFLT IS NEW FLOAT;
- 
- BEGIN
-      TEST ( "CC1222A",  "FOR A FORMAL FLOATING POINT TYPE, CHECK " &
-                         "THAT THE BASIC OPERATIONS ARE " &
-                         "IMPLICITLY DECLARED AND ARE THEREFORE " &
-                         "AVAILABLE WITHIN THE GENERIC UNIT" );
- 
-      DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND 
-              --      QUALIFICATION.
- 
-           GENERIC
-                TYPE T IS DIGITS <>;
-                TYPE T1 IS DIGITS <>;
-                F  : T;               
-                F1 : T1;
-           PROCEDURE P (F2 : T; STR : STRING);
- 
-           PROCEDURE P (F2 : T; STR : STRING) IS
-                SUBTYPE ST IS T RANGE -1.0 .. 1.0; 
-                F3, F4  : T;
- 
-                FUNCTION FUN (X : T) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN IDENT_BOOL (TRUE);
-                END FUN;
- 
-                FUNCTION FUN (X : T1) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN IDENT_BOOL (FALSE);
-                END FUN;
- 
-           BEGIN
-                F3 := F;
-                F4 := F2;
-                F3 := F4;
-        
-                IF F3 /= F2 THEN
-                     FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
-                              "WITH TYPE - " & STR);
-                END IF;
- 
-                IF F IN ST THEN
-                     NULL;
-                ELSE                                        
-                     FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
-                              "TYPE  - " & STR);
-                END IF;
- 
-                IF F2 NOT IN ST THEN
-                     NULL;
-                ELSE                                        
-                     FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
-                              "TYPE  - " & STR);
-                END IF;
-                
-                IF T'(F) /= F THEN                              
-                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
-                              "WITH TYPE - " & STR & " - 1" );
-                END IF;
- 
-                IF FUN (T'(1.0)) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
-                              "WITH TYPE - " & STR & " - 2" );
-                END IF;
- 
-           END P;
- 
-           PROCEDURE P1 IS NEW P (FLOAT,  FLOAT,  0.0, 0.0);
-           PROCEDURE P2 IS NEW P (NEWFLT, NEWFLT, 0.0, 0.0);
-      
-      BEGIN
-           P1 (2.0, "FLOAT");
-           P2 (2.0, "NEWFLT");
-      END; -- (A).         
- 
-      DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER 
-              --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM 
-              --     REAL LITERAL.
- 
-           GENERIC
-                TYPE T IS DIGITS <>;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
- 
-                TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
-                FI0  : FIXED := 0.0;
-                FI2  : FIXED := 2.0;
-                FIN2 : FIXED := -2.0; 
- 
-                I0  : INTEGER := 0;
-                I2  : INTEGER := 2;
-                IN2 : INTEGER := -2; 
- 
-                T0  : T := 0.0;
-                T2  : T := 2.0;
-                TN2 : T := -2.0; 
-                
-                FUNCTION IDENT (X : T) RETURN T IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN X;
-                     ELSE
-                          RETURN T'FIRST;
-                     END IF;
-                END IDENT;
- 
-           BEGIN
-                IF T0 + 1.0 /= 1.0 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 1" );
-                END IF;
- 
-                IF T2 + 1.0 /= 3.0 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 2" );
-                END IF;
- 
-                IF TN2 + 1.0 /= -1.0 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 3" );
-                END IF;
- 
-                IF T (FI0) /= T0 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FIXED VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FI2) /= IDENT (T2) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FIXED VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FIN2) /= TN2 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FIXED VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (I0) /= IDENT (T0) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "INTEGER VALUE 0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (I2) /= T2 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "INTEGER VALUE 2 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (IN2) /= IDENT (TN2) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "INTEGER VALUE -2 WITH TYPE " & STR);
-                END IF;
- 
-                IF FIXED (T0) /= FI0 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FIXED VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FIXED (IDENT (T2)) /= FI2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FIXED VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FIXED (TN2) /= FIN2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FIXED VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF INTEGER (IDENT (T0)) /= I0 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "INTEGER VALUE 0 WITH TYPE " & STR);
-                END IF;
- 
-                IF INTEGER (T2) /= I2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "INTEGER VALUE 2 WITH TYPE " & STR);
-                END IF;
- 
-                IF INTEGER (IDENT (TN2)) /= IN2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "INTEGER VALUE -2 WITH TYPE " & STR);
-                END IF;
- 
-           END P;
- 
-           PROCEDURE P1 IS NEW P (FLOAT);
-           PROCEDURE P2 IS NEW P (NEWFLT);
- 
-      BEGIN
-            P1 ( "FLOAT" );
-            P2 ( "NEWFLT" );
-      END; -- (B).         
- 
-      DECLARE -- (C) CHECKS FOR ATTRIBUTES.
- 
-           GENERIC
-                TYPE T IS DIGITS <>;
-                F, L : T;
-                D : INTEGER;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
- 
-                F1 : T;
-                A  : ADDRESS := F'ADDRESS;
-                S  : INTEGER := F'SIZE;
- 
-                I  : INTEGER;
-                I1 : INTEGER := T'MACHINE_RADIX;
-                I2 : INTEGER := T'MACHINE_MANTISSA;
-                I3 : INTEGER := T'MACHINE_EMAX;
-                I4 : INTEGER := T'MACHINE_EMIN;
- 
-                B1 : BOOLEAN := T'MACHINE_ROUNDS;
-                B2 : BOOLEAN := T'MACHINE_OVERFLOWS;
- 
-           BEGIN
-                IF T'DIGITS /= D THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                               STR & "'DIGITS" );
-                END IF;
- 
-                IF T'FIRST /= F THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                               STR & "'FIRST" );
-                END IF;
- 
-                IF T'LAST /= L THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                               STR & "'LAST" );
-                END IF;
- 
-           END P;
- 
-           PROCEDURE P1 IS 
-                NEW P (FLOAT, FLOAT'FIRST, FLOAT'LAST, FLOAT'DIGITS);
-           PROCEDURE P2 IS 
-                NEW P (NEWFLT, NEWFLT'FIRST, NEWFLT'LAST, 
-                       NEWFLT'DIGITS);
- 
-      BEGIN
-            P1 ( "FLOAT" );
-            P2 ( "NEWFLT" );
-      END; -- (C).         
- 
-      RESULT;
- END CC1222A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,297 ****
- -- CC1223A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A FORMAL FIXED POINT TYPE, CHECK THAT THE FOLLOWING BASIC
- --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
- --     WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS,
- --     QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC
- --     TYPES, AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL
- --     TO THE FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DELTA, 'FORE, 
- --     'AFT, 'MACHINE_ROUNDS, 'MACHINE_OVERFLOWS.
- 
- -- HISTORY:
- --     RJW 09/30/86  CREATED ORIGINAL TEST.
- --     JLH 09/25/87  REFORMATTED HEADER.
- --     RJW 08/21/89  MODIFIED CHECKS FOR 'MANTISSA AND 'AFT.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1223A IS
- 
-      TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
- 
- BEGIN
-      TEST ( "CC1223A",  "FOR A FORMAL FIXED POINT TYPE, CHECK " &
-                         "THAT THE BASIC OPERATIONS ARE " &
-                         "IMPLICITLY DECLARED AND ARE THEREFORE " &
-                         "AVAILABLE WITHIN THE GENERIC UNIT" );
- 
-      DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND
-              --      QUALIFICATION.
- 
-           GENERIC
-                TYPE T IS DELTA <>;
-                TYPE T1 IS DELTA <>;
-                F  : T;
-                F1 : T1;
-           PROCEDURE P (F2 : T; STR : STRING);
- 
-           PROCEDURE P (F2 : T; STR : STRING) IS
-                SUBTYPE ST IS T RANGE -1.0 .. 1.0;
-                F3, F4  : T;
- 
-                FUNCTION FUN (X : T) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN IDENT_BOOL (TRUE);
-                END FUN;
- 
-                FUNCTION FUN (X : T1) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN IDENT_BOOL (FALSE);
-                END FUN;
- 
-           BEGIN
-                F3 := F;
-                F4 := F2;
-                F3 := F4;
- 
-                IF F3 /= F2 THEN
-                     FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
-                              "WITH TYPE - " & STR);
-                END IF;
- 
-                IF F IN ST THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
-                              "TYPE  - " & STR);
-                END IF;
- 
-                IF F2 NOT IN ST THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
-                              "TYPE  - " & STR);
-                END IF;
- 
-                IF T'(F) /= F THEN
-                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
-                              "WITH TYPE - " & STR & " - 1" );
-                END IF;
- 
-                IF FUN (T'(1.0)) THEN
-                     NULL;
-                ELSE
-                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
-                              "WITH TYPE - " & STR & " - 2" );
-                END IF;
- 
-           END P;
- 
-           PROCEDURE P1 IS NEW P (FIXED, FIXED, 0.0, 0.0);
-           PROCEDURE P2 IS NEW P (DURATION, DURATION, 0.0, 0.0);
- 
-      BEGIN
-           P1 (2.0, "FIXED");
-           P2 (2.0, "DURATION");
-      END; -- (A).
- 
-      DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
-              --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
-              --     REAL LITERAL.
- 
-           GENERIC
-                TYPE T IS DELTA <>;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
- 
-                FL0  : FLOAT := 0.0;
-                FL2  : FLOAT := 2.0;
-                FLN2 : FLOAT := -2.0;
- 
-                I0  : INTEGER := 0;
-                I2  : INTEGER := 2;
-                IN2 : INTEGER := -2;
- 
-                T0  : T := 0.0;
-                T2  : T := 2.0;
-                TN2 : T := -2.0;
- 
-                FUNCTION IDENT (X : T) RETURN T IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN X;
-                     ELSE
-                          RETURN T'FIRST;
-                     END IF;
-                END IDENT;
- 
-           BEGIN
-                IF T0 + 1.0 /= 1.0 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 1" );
-                END IF;
- 
-                IF T2 + 1.0 /= 3.0 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 2" );
-                END IF;
- 
-                IF TN2 + 1.0 /= -1.0 THEN
-                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
-                              "CONVERSION WITH TYPE " & STR & " - 3" );
-                END IF;
- 
-                IF T (FL0) /= T0 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FL2) /= IDENT (T2) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (FLN2) /= TN2 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (I0) /= IDENT (T0) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "INTEGER VALUE 0 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (I2) /= T2 THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "INTEGER VALUE 2 WITH TYPE " & STR);
-                END IF;
- 
-                IF T (IN2) /= IDENT (TN2) THEN
-                     FAILED ( "INCORRECT CONVERSION FROM " &
-                              "INTEGER VALUE -2 WITH TYPE " & STR);
-                END IF;
- 
-                IF FLOAT (T0) /= FL0 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FLOAT (IDENT (T2)) /= FL2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF FLOAT (TN2) /= FLN2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
-                END IF;
- 
-                IF INTEGER (IDENT (T0)) /= I0 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "INTEGER VALUE 0 WITH TYPE " & STR);
-                END IF;
- 
-                IF INTEGER (T2) /= I2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "INTEGER VALUE 2 WITH TYPE " & STR);
-                END IF;
- 
-                IF INTEGER (IDENT (TN2)) /= IN2 THEN
-                     FAILED ( "INCORRECT CONVERSION TO " &
-                              "INTEGER VALUE -2 WITH TYPE " & STR);
-                END IF;
- 
-           END P;
- 
-           PROCEDURE P1 IS NEW P (FIXED);
-           PROCEDURE P2 IS NEW P (DURATION);
- 
-      BEGIN
-            P1 ( "FIXED" );
-            P2 ( "DURATION" );
-      END; -- (B).
- 
-      DECLARE -- (C) CHECKS FOR ATTRIBUTES.
- 
-           GENERIC
-                TYPE T IS DELTA <>;
-                F, L, D : T;
-           PROCEDURE P (STR : STRING);
- 
-           PROCEDURE P (STR : STRING) IS
- 
-                F1 : T;
-                A  : ADDRESS := F'ADDRESS;
-                S  : INTEGER := F'SIZE;
- 
-                I  : INTEGER;
- 
-                B1 : BOOLEAN := T'MACHINE_ROUNDS;
-                B2 : BOOLEAN := T'MACHINE_OVERFLOWS;
- 
-           BEGIN
-                IF T'DELTA /= D THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                               STR & "'DELTA" );
-                END IF;
- 
-                IF T'FIRST /= F THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                               STR & "'FIRST" );
-                END IF;
- 
-                IF T'LAST /= L THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                               STR & "'LAST" );
-                END IF;
- 
-                IF T'FORE < 2 THEN
-                     FAILED ( "INCORRECT VALUE FOR " &
-                               STR & "'FORE" );
-                END IF;
- 
-                IF T'AFT <= 0 THEN
-                     FAILED ( "INCORRECT VALUE FOR " & STR & "'AFT" );
-                END IF;
- 
-           END P;
- 
-           PROCEDURE P1 IS
-                NEW P (FIXED, FIXED'FIRST, FIXED'LAST, FIXED'DELTA);
-           PROCEDURE P2 IS
-                NEW P (DURATION, DURATION'FIRST, DURATION'LAST,
-                       DURATION'DELTA);
- 
-      BEGIN
-            P1 ( "FIXED" );
-            P2 ( "DURATION" );
-      END; -- (C).
- 
-      RESULT;
- END CC1223A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1224a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1224a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1224a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1224a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,558 ****
- -- CC1224A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR ARRAY TYPES WITH A NONLIMITED COMPONENT TYPE (OF A FORMAL
- --     AND NONFORMAL GENERIC TYPE), CHECK THAT THE FOLLOWING OPERATIONS
- --     ARE IMPLICITY DECLARED AND ARE, THEREFORE, AVAILABLE WITHIN THE
- --     GENERIC UNIT: ASSIGNMENT, THE OPERATION ASSOCIATED WITH
- --     AGGREGATE NOTATION, MEMBERSHIP TESTS, THE OPERATION ASSOCIATED
- --     WITH INDEXED COMPONENTS, QUALIFICATION, EXPLICIT CONVERSION,
- --     'SIZE, 'ADDRESS, 'FIRST, 'FIRST (N), 'LAST, 'LAST (N),
- --     'RANGE, 'RANGE (N), 'LENGTH, 'LENGTH (N).
- 
- -- HISTORY:
- --     R.WILLIAMS  10/6/86
- --     EDWARD V. BERARD  8/10/90  ADDED CHECKS FOR MULTI-DIMENSIONAL
- --                                ARRAYS
- --     LDC  10/10/90  CHANGED DECLARATIONS OF AD1 - AD6 TO PROCEDURE
- --                    CALLS OF FA1 - FA6 TO ADDRESS_CHECK AS SUGGESTED
- --                    BY THE CRG. 
- --     PWN  01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH SYSTEM ;
- WITH REPORT ;
- 
- PROCEDURE CC1224A IS
- 
-      SHORT_START : CONSTANT := -10 ;
-      SHORT_END   : CONSTANT := 10 ;
- 
-      TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
-      SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
- 
-      MEDIUM_START    : CONSTANT := 1 ;
-      MEDIUM_END      : CONSTANT := 15 ;
- 
-      TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
-      MEDIUM_LENGTH   : CONSTANT NATURAL := 
-                                 (MEDIUM_END - MEDIUM_START + 1) ;
- 
-      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                          SEP, OCT, NOV, DEC) ;
-      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-      TYPE DATE IS RECORD
-           MONTH : MONTH_TYPE ;
-           DAY   : DAY_TYPE ;
-           YEAR  : YEAR_TYPE ;
-      END RECORD ;
- 
-      TODAY : DATE := (AUG, 10, 1990) ;
- 
-      TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
-                                    MEDIUM_RANGE RANGE <>) OF DATE ;
- 
-      TYPE SECOND_TEMPLATE IS ARRAY (SHORT_RANGE, MEDIUM_RANGE) 
-                                    OF DATE ;
- 
-      FIRST_ARRAY     : FIRST_TEMPLATE (-10 .. 10, 6 .. 10) ;
-      SECOND_ARRAY    : FIRST_TEMPLATE (0 .. 7, 1 .. 15) ;
-      THIRD_ARRAY     : SECOND_TEMPLATE ;
-      FOURTH_ARRAY    : SECOND_TEMPLATE ;
- 
-      SUBTYPE SUBINT IS INTEGER RANGE REPORT.IDENT_INT (1) .. 
-                                      REPORT.IDENT_INT (6);
- 
-      TYPE ARRA IS ARRAY (SUBINT) OF SUBINT;
-      A1 : ARRA := (REPORT.IDENT_INT (1) .. REPORT.IDENT_INT (6) => 1);
-      A2 : ARRA := (A1'RANGE => 2);
- 
-      TYPE ARRB IS ARRAY (SUBINT RANGE <>) OF DATE ;
-      A3 : ARRB (1 .. 6) := 
-                (REPORT.IDENT_INT (1) .. REPORT.IDENT_INT (6) => TODAY);
- 
-      TYPE ARRC IS ARRAY (SUBINT RANGE <>, SUBINT RANGE <>) OF SUBINT;
-      A4 : CONSTANT ARRC := (1 .. 6 => (1 .. 6 => 4));
- 
-      TYPE ARRD IS ARRAY (SUBINT, SUBINT) OF SUBINT;
-      A5 : ARRD := (A4'RANGE (1) => (A4'RANGE (2) => 5));
- 
-      TYPE ARRE IS ARRAY (SUBINT) OF DATE ;
-      A6 : ARRE := (A1'RANGE => TODAY);
- 
-      FUNCTION "=" (LEFT  : IN SYSTEM.ADDRESS ;
-                    RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN
-               RENAMES SYSTEM."=" ;
- 
-      GENERIC
- 
-           TYPE T1 IS (<>);
-           TYPE T2 IS PRIVATE;
-           X2 : T2;
- 
-           TYPE FARR1 IS ARRAY (SUBINT) OF T1;
-           FA1 : FARR1;
- 
-           TYPE FARR2 IS ARRAY (SUBINT) OF SUBINT;
-           FA2 : FARR2;
- 
-           TYPE FARR3 IS ARRAY (SUBINT RANGE <>) OF T2;
-           FA3 : FARR3;
- 
-           TYPE FARR4 IS ARRAY (SUBINT RANGE <>, SUBINT RANGE <>) OF T1;
-           FA4 : FARR4;
- 
-           TYPE FARR5 IS ARRAY (SUBINT, SUBINT) OF SUBINT;
-           FA5 : FARR5;
- 
-           TYPE FARR6 IS ARRAY (T1) OF T2;
-           FA6 : FARR6;
- 
-           TYPE FARR7 IS ARRAY (T1) OF T2;
-           FA7 : FARR7;
- 
-      PROCEDURE P ;
- 
-      GENERIC
- 
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE UNCONSTRAINED_ARRAY IS ARRAY 
-                (FIRST_INDEX RANGE <>, SECOND_INDEX RANGE <>) OF DATE ;
- 
-      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
-                                FFIFS        : IN FIRST_INDEX ;
-                                FFILS        : IN FIRST_INDEX ;
-                                FSIFS        : IN SECOND_INDEX ;
-                                FSILS        : IN SECOND_INDEX ;
-                                FFLEN        : IN NATURAL ;
-                                FSLEN        : IN NATURAL ;
-                                FFIRT        : IN FIRST_INDEX ;
-                                FSIRT        : IN SECOND_INDEX ;
-                                SECOND       : IN UNCONSTRAINED_ARRAY ;
-                                SFIFS        : IN FIRST_INDEX ;
-                                SFILS        : IN FIRST_INDEX ;
-                                SSIFS        : IN SECOND_INDEX ;
-                                SSILS        : IN SECOND_INDEX ;
-                                SFLEN        : IN NATURAL ;
-                                SSLEN        : IN NATURAL ;
-                                SFIRT        : IN FIRST_INDEX ;
-                                SSIRT        : IN SECOND_INDEX ;
-                                REMARKS      : IN STRING) ;
-      GENERIC
- 
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           TYPE CONSTRAINED_ARRAY IS ARRAY 
-                (FIRST_INDEX,SECOND_INDEX) OF COMPONENT_TYPE ;
- 
-      PROCEDURE CTEST_PROCEDURE (FIRST        : IN CONSTRAINED_ARRAY ;
-                                 FFIRT        : IN FIRST_INDEX ;
-                                 FSIRT        : IN SECOND_INDEX ;
-                                 SECOND       : IN CONSTRAINED_ARRAY ;
-                                 SFIRT        : IN FIRST_INDEX ;
-                                 SSIRT        : IN SECOND_INDEX ;
-                                 REMARKS      : IN STRING) ;
- 
- 
-      PROCEDURE P IS
- 
-           IN1 : INTEGER := FA1'SIZE;
-           IN2 : INTEGER := FA2'SIZE;
-           IN3 : INTEGER := FA3'SIZE;
-           IN4 : INTEGER := FA4'SIZE;
-           IN5 : INTEGER := FA5'SIZE;
-           IN6 : INTEGER := FA6'SIZE;
- 
-           B1 : FARR1;
- 
-           B2 : FARR2;
- 
-           SUBTYPE SARR3 IS FARR3 (FA3'RANGE);
-           B3 : SARR3;
- 
-           SUBTYPE SARR4 IS FARR4 (FA4'RANGE (1), FA4'RANGE (2));
-           B4 : SARR4;
- 
-           B5 : FARR5;
- 
-           B6 : FARR6 ;
- 
-           PROCEDURE ADDRESS_CHECK(ADDRESS : SYSTEM.ADDRESS) IS
- 
-           BEGIN
-                IF REPORT.EQUAL(1, REPORT.IDENT_INT(2)) THEN
-                     REPORT.COMMENT("DON'T OPTIMIZE OUT ADDRESS_CHECK");
-                END IF;
-           END ADDRESS_CHECK;
- 
-      BEGIN  -- P
- 
-           ADDRESS_CHECK(FA1'ADDRESS);
-           ADDRESS_CHECK(FA2'ADDRESS);
-           ADDRESS_CHECK(FA3'ADDRESS);
-           ADDRESS_CHECK(FA4'ADDRESS);
-           ADDRESS_CHECK(FA5'ADDRESS);
-           ADDRESS_CHECK(FA6'ADDRESS);
- 
-           B1 := FA1;
- 
-           IF B1 /= FARR1 (FA1) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 1" );
-           END IF;
- 
-           B2 := FA2;
- 
-           IF B2 /= FARR2 (A2) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 2" );
-           END IF;
- 
-           B3 := FA3;
- 
-           IF B3 /= FARR3 (FA3) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 3" );
-           END IF;
- 
-           B4 := FA4;
- 
-           IF B4 /= FARR4 (FA4) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 4" );
-           END IF;
- 
-           B5 := FA5;
- 
-           IF B5 /= FARR5 (A5) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 5" );
-           END IF;
- 
-           B6 := FA6;
- 
-           IF B6 /= FARR6 (FA6) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 6" );
-           END IF;
- 
-           IF FA7 /= FARR7 (FA6) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 7" );
-           END IF;
- 
-           B1 := FARR1'(FA1'RANGE => T1'VAL (1));
- 
-           IF B1 (1) /= FA1 (1) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 8" );
-           END IF;
- 
-           B1 := FARR1'(1 => T1'VAL (1), 2 => T1'VAL (1), 
-                        3 .. 6 => T1'VAL (2));
- 
-           IF B1 (1) /= FA1 (1) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 9" );
-           END IF;
- 
-           B2 := FARR2'(FA2'RANGE => 2);
- 
-           IF B2 (2) /= FA2 (2) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 10" );
-           END IF;
- 
-           B3 := FARR3'(1|2|3 => X2, 4|5|6 => X2);
- 
-           IF B3 (3) /= FA3 (3) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 11" );
-           END IF;
- 
-           B4 := FARR4'(FA5'RANGE (1) => (FA5'RANGE (2) => T1'VAL (4)));
- 
-           IF B4 (4, 4) /= FA4 (4, 4) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 12" );
-           END IF;
- 
-           B5 := FARR5'(REPORT.IDENT_INT (1) .. 
-                        REPORT.IDENT_INT (6) =>  (1 .. 6 => 5));
- 
-           IF B5 (5, 5) /= FA5 (5, 5) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 13" );
-           END IF;
- 
-           B6 := FARR6'(FA6'RANGE => X2);
- 
-           IF B6 (T1'FIRST) /= FA6 (T1'FIRST) THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 14" );
-           END IF;
- 
-           IF B1 NOT IN FARR1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 15" );
-           END IF;
- 
-           IF FA2 NOT IN FARR2 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 16" );
-           END IF;
- 
-           IF FA3 NOT IN FARR3 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 17" );
-           END IF;
- 
-           IF B4 NOT IN FARR4 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 18" );
-           END IF;
- 
-           IF B5 NOT IN FARR5 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 19" );
-           END IF;
- 
-           IF FA6 NOT IN FARR6 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 20" );
-           END IF;
- 
-           IF FA1'LENGTH /= FA1'LAST - FA1'FIRST + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 27" );
-           END IF;
- 
-           IF FA2'LENGTH /= FA2'LAST - FA2'FIRST + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 28" );
-           END IF;
- 
-           IF FA3'LENGTH /= FA3'LAST - FA3'FIRST + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 29" );
-           END IF;
- 
-           IF FA4'LENGTH /= FA4'LAST - FA4'FIRST + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 30" );
-           END IF;
- 
-           IF FA4'LENGTH (2) /= FA4'LAST (2) - FA4'FIRST (2) + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 31" );
-           END IF;
- 
-           IF FA5'LENGTH /= FA5'LAST - FA5'FIRST + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 32" );
-           END IF;
- 
-           IF FA5'LENGTH (2) /= FA5'LAST (2) - FA5'FIRST (2) + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 33" );
-           END IF;
- 
-           IF FA6'LENGTH /= T1'POS (FA6'LAST) - 
-              T1'POS (FA6'FIRST) + 1 THEN
-                REPORT.FAILED ("INCORRECT RESULTS - 34" );
-           END IF;
- 
-      END P ;
- 
-      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
-                                FFIFS        : IN FIRST_INDEX ;
-                                FFILS        : IN FIRST_INDEX ;
-                                FSIFS        : IN SECOND_INDEX ;
-                                FSILS        : IN SECOND_INDEX ;
-                                FFLEN        : IN NATURAL ;
-                                FSLEN        : IN NATURAL ;
-                                FFIRT        : IN FIRST_INDEX ;
-                                FSIRT        : IN SECOND_INDEX ;
-                                SECOND       : IN UNCONSTRAINED_ARRAY ;
-                                SFIFS        : IN FIRST_INDEX ;
-                                SFILS        : IN FIRST_INDEX ;
-                                SSIFS        : IN SECOND_INDEX ;
-                                SSILS        : IN SECOND_INDEX ;
-                                SFLEN        : IN NATURAL ;
-                                SSLEN        : IN NATURAL ;
-                                SFIRT        : IN FIRST_INDEX ;
-                                SSIRT        : IN SECOND_INDEX ;
-                                REMARKS      : IN STRING) IS
- 
-      BEGIN -- TEST_PROCEDURE
- 
-           IF (FIRST'FIRST /= FFIFS) OR
-              (FIRST'FIRST (1) /= FFIFS) OR
-              (FIRST'FIRST (2) /= FSIFS) OR
-              (SECOND'FIRST /= SFIFS) OR
-              (SECOND'FIRST (1) /= SFIFS) OR
-              (SECOND'FIRST (2) /= SSIFS) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
-           END IF ;
- 
-           IF (FIRST'LAST /= FFILS) OR
-              (FIRST'LAST (1) /= FFILS) OR
-              (FIRST'LAST (2) /= FSILS) OR
-              (SECOND'LAST /= SFILS) OR
-              (SECOND'LAST (1) /= SFILS) OR
-              (SECOND'LAST (2) /= SSILS) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
-           END IF ;
- 
-           IF (FIRST'LENGTH /= FFLEN) OR
-              (FIRST'LENGTH (1) /= FFLEN) OR
-              (FIRST'LENGTH (2) /= FSLEN) OR
-              (SECOND'LENGTH /= SFLEN) OR
-              (SECOND'LENGTH (1) /= SFLEN) OR
-              (SECOND'LENGTH (2) /= SSLEN) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
-           END IF ;
- 
-           IF (FFIRT NOT IN FIRST'RANGE (1)) OR
-              (FFIRT NOT IN FIRST'RANGE) OR
-              (SFIRT NOT IN SECOND'RANGE (1)) OR
-              (SFIRT NOT IN SECOND'RANGE) OR
-              (FSIRT NOT IN FIRST'RANGE (2)) OR
-              (SSIRT NOT IN SECOND'RANGE (2)) THEN
-                REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
-                               REMARKS) ;
-           END IF ;
- 
-      END TEST_PROCEDURE ;
- 
-      PROCEDURE CTEST_PROCEDURE (FIRST        : IN CONSTRAINED_ARRAY ;
-                                 FFIRT        : IN FIRST_INDEX ;
-                                 FSIRT        : IN SECOND_INDEX ;
-                                 SECOND       : IN CONSTRAINED_ARRAY ;
-                                 SFIRT        : IN FIRST_INDEX ;
-                                 SSIRT        : IN SECOND_INDEX ;
-                                 REMARKS      : IN STRING) IS
- 
-      BEGIN -- CTEST_PROCEDURE
- 
-           IF (FIRST'FIRST /= FIRST_INDEX'FIRST) OR
-              (FIRST'FIRST (1) /= FIRST_INDEX'FIRST) OR
-              (FIRST'FIRST (2) /= SECOND_INDEX'FIRST) OR
-              (SECOND'FIRST /= FIRST_INDEX'FIRST) OR
-              (SECOND'FIRST (1) /= FIRST_INDEX'FIRST) OR
-              (SECOND'FIRST (2) /= SECOND_INDEX'FIRST) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
-           END IF ;
- 
-           IF (FIRST'LAST /= FIRST_INDEX'LAST) OR
-              (FIRST'LAST (1) /= FIRST_INDEX'LAST) OR
-              (FIRST'LAST (2) /= SECOND_INDEX'LAST) OR
-              (SECOND'LAST /= FIRST_INDEX'LAST) OR
-              (SECOND'LAST (1) /= FIRST_INDEX'LAST) OR
-              (SECOND'LAST (2) /= SECOND_INDEX'LAST) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
-           END IF ;
- 
-           IF (FIRST'LENGTH /=
-               FIRST_INDEX'POS (FIRST_INDEX'LAST)
-               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
-              (FIRST'LENGTH (1) /= 
-               FIRST_INDEX'POS (FIRST_INDEX'LAST)
-               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
-              (FIRST'LENGTH (2) /=
-               SECOND_INDEX'POS (SECOND_INDEX'LAST)
-               - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) OR
-              (SECOND'LENGTH /= 
-               FIRST_INDEX'POS (FIRST_INDEX'LAST)
-               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
-              (SECOND'LENGTH (1) /=
-               FIRST_INDEX'POS (FIRST_INDEX'LAST)
-               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
-              (SECOND'LENGTH (2) /=
-               SECOND_INDEX'POS (SECOND_INDEX'LAST)
-               - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) THEN
-                REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
-           END IF ;
- 
-           IF (FFIRT NOT IN FIRST'RANGE (1)) OR
-              (FFIRT NOT IN FIRST'RANGE) OR
-              (SFIRT NOT IN SECOND'RANGE (1)) OR
-              (SFIRT NOT IN SECOND'RANGE) OR
-              (FSIRT NOT IN FIRST'RANGE (2)) OR
-              (SSIRT NOT IN SECOND'RANGE (2)) THEN
-                 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
-                                REMARKS) ;
-           END IF ;
- 
-           IF CONSTRAINED_ARRAY'SIZE <= 0 THEN
-                REPORT.FAILED ("PROBLEMS WITH THE 'SIZE ATTRIBUTE. " &
-                               REMARKS) ;
-           END IF ;
- 
-           IF FIRST'ADDRESS = SECOND'ADDRESS THEN
-                REPORT.FAILED ("PROBLEMS WITH THE 'ADDRESS ATTRIBUTE. " &
-                               REMARKS) ;
-           END IF ;
- 
-      END CTEST_PROCEDURE ;
- 
-      PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE 
-                (FIRST_INDEX            => SHORT_RANGE,
-                 SECOND_INDEX           => MEDIUM_RANGE,
-                 UNCONSTRAINED_ARRAY    => FIRST_TEMPLATE) ;
- 
-      PROCEDURE NEW_CTEST_PROCEDURE IS NEW CTEST_PROCEDURE 
-                (FIRST_INDEX           => SHORT_RANGE,
-                 SECOND_INDEX          => MEDIUM_RANGE,
-                 COMPONENT_TYPE        => DATE,
-                 CONSTRAINED_ARRAY     => SECOND_TEMPLATE) ;
- 
-      PROCEDURE NP IS NEW P (SUBINT, DATE, TODAY, ARRA, A1, 
-                             ARRA, A2, ARRB, A3, ARRC, A4, ARRD,
-                             A5, ARRE, A6, ARRE, A6);
- 
- BEGIN  -- CC1224A
- 
-      REPORT.TEST ("CC1224A", "FOR ARRAY TYPES WITH A NONLIMITED " &
-                   "COMPONENT TYPE (OF A FORMAL AND NONFORMAL GENERIC " &
-                   "TYPE), CHECK THAT THE FOLLOWING OPERATIONS " &
-                   "ARE IMPLICITY DECLARED AND ARE, THEREFORE, " &
-                   "AVAILABLE WITHIN THE GENERIC -- UNIT: " &
-                   "ASSIGNMENT, THE OPERATION ASSOCIATED WITH " &
-                   "AGGREGATE NOTATION, MEMBERSHIP TESTS, THE " &
-                   "OPERATION ASSOCIATED WITH INDEXED " &
-                   "COMPONENTS, QUALIFICATION, EXPLICIT " &
-                   "CONVERSION, 'SIZE, 'ADDRESS, 'FIRST, " &
-                   "'FIRST (N), 'LAST, 'LAST (N), 'RANGE, " &
-                   "'RANGE (N), 'LENGTH, 'LENGTH (N)" ) ;
- 
-      NP ;
- 
-      FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
-                            FFIFS        => -10,
-                            FFILS        => 10,
-                            FSIFS        => 6,
-                            FSILS        => 10,
-                            FFLEN        => 21,
-                            FSLEN        => 5,
-                            FFIRT        => 0,
-                            FSIRT        => 8,
-                            SECOND       => SECOND_ARRAY,
-                            SFIFS        => 0,
-                            SFILS        => 7,
-                            SSIFS        => 1,
-                            SSILS        => 15,
-                            SFLEN        => 8,
-                            SSLEN        => 15,
-                            SFIRT        => 5,
-                            SSIRT        => 13,
-                            REMARKS      => "FIRST_TEST_PROCEDURE") ;
- 
-      NEW_CTEST_PROCEDURE (FIRST         => THIRD_ARRAY,
-                           FFIRT         => -5,
-                           FSIRT         => 11,
-                           SECOND        => FOURTH_ARRAY,
-                           SFIRT         => 0,
-                           SSIRT         => 14,
-                           REMARKS       => "NEW_CTEST_PROCEDURE") ;
- 
-      REPORT.RESULT ;
- 
- END CC1224A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1225a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1225a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1225a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1225a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,350 ****
- -- CC1225A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, FOR A FORMAL ACCESS TYPE, THAT ALL ALLOWABLE OPERATIONS
- --     ARE IMPLICITLY DECLARED.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY:
- --     BCB 03/29/88  CREATED ORIGINAL TEST.
- --     RDH 04/09/90  ADDED 'STORAGE_SIZE CLAUSES.  CHANGED EXTENSION TO
- --                   'TST'.
- --     LDC 09/26/90  REMOVED 'USE PACK' AFTER THE WITH SINCE IT ISN'T 
- --                   NEEDED, ADDED CHECK FOR NULL AFTER ASSIGMENT TO
- --                   NULL, ADDED CHECKS FOR OTHER RELATION OPERATORS,
- --                   CHANGED CHECK FOR 'ADDRESS TO A PROCEDURE CALL.
- --     LDC 10/13/90  CHANGED CHECK FOR 'SIZE TO ONLY CHECK FOR 
- --                   AVAILABILITY.  CHANGED CHECK FOR 'ADDRESS TO A 
- --                   MEMBERSHIP TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE CC1225A IS
- 
-      TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
-      TYPE AI IS ACCESS INTEGER;
- 
-      TYPE ACCINTEGER IS ACCESS INTEGER;
- 
-      TYPE REC IS RECORD
-           COMP : INTEGER;
-      END RECORD;
- 
-      TYPE DISCREC (DISC : INTEGER := 1) IS RECORD
-           COMPD : INTEGER;
-      END RECORD;
- 
-      TYPE AREC IS ACCESS REC;
- 
-      TYPE ADISCREC IS ACCESS DISCREC;
- 
-      TYPE ARR IS ARRAY(1..2,1..2) OF INTEGER;
- 
-      TYPE ONEDIM IS ARRAY(1..10) OF INTEGER;
- 
-      TYPE AA IS ACCESS ARR;
- 
-      TYPE AONEDIM IS ACCESS ONEDIM;
- 
-      TYPE ENUM IS (ONE, TWO, THREE);
- 
-      TASK TYPE T IS
-           ENTRY HERE(VAL : IN OUT INTEGER);
-      END T;
- 
-      TYPE ATASK IS ACCESS T;
- 
-      TYPE ANOTHERTASK IS ACCESS T;
-      FOR ANOTHERTASK'STORAGE_SIZE USE 2 * TASK_STORAGE_SIZE;
- 
-      TASK TYPE T1 IS
-           ENTRY HERE1(ENUM)(VAL1 : IN OUT INTEGER);
-      END T1;
- 
-      TYPE ATASK1 IS ACCESS T1;
- 
-      TASK BODY T IS
-      BEGIN
-           ACCEPT HERE(VAL : IN OUT INTEGER) DO
-                VAL := VAL * 2;
-           END HERE;
-      END T;
- 
-      TASK BODY T1 IS
-      BEGIN
-           SELECT
-                ACCEPT HERE1(ONE)(VAL1 : IN OUT INTEGER) DO
-                     VAL1 := VAL1 * 1;
-                END HERE1;
-           OR
-                ACCEPT HERE1(TWO)(VAL1 : IN OUT INTEGER) DO
-                     VAL1 := VAL1 * 2;
-                END HERE1;
-           OR
-                ACCEPT HERE1(THREE)(VAL1 : IN OUT INTEGER) DO
-                     VAL1 := VAL1 * 3;
-                END HERE1;
-           END SELECT;
-      END T1;
- 
-      GENERIC
-           TYPE FORM IS (<>);
-           TYPE ACCFORM IS ACCESS FORM;
-           TYPE ACC IS ACCESS INTEGER;
-           TYPE ACCREC IS ACCESS REC;
-           TYPE ACCDISCREC IS ACCESS DISCREC;
-           TYPE ACCARR IS ACCESS ARR;
-           TYPE ACCONE IS ACCESS ONEDIM;
-           TYPE ACCTASK IS ACCESS T;
-           TYPE ACCTASK1 IS ACCESS T1;
-           TYPE ANOTHERTASK1 IS ACCESS T;
-      PACKAGE P IS
-      END P;
- 
-      PACKAGE BODY P IS
-           AF : ACCFORM;
-           TYPE DER_ACC IS NEW ACC;
-           A, B : ACC;
-           DERA : DER_ACC;
-           R : ACCREC;
-           DR : ACCDISCREC;
-           C : ACCARR;
-           D, E : ACCONE;
-           F : ACCTASK;
-           G : ACCTASK1;
-           INT : INTEGER := 5;
- 
-      BEGIN
-           TEST ("CC1225A", "CHECK, FOR A FORMAL ACCESS TYPE, THAT " &
-                            "ALL ALLOWABLE OPERATIONS ARE IMPLICITLY " &
-                            "DECLARED");
- 
-           IF AF'ADDRESS NOT IN ADDRESS THEN
-                FAILED ("IMPROPER RESULT FROM AF'ADDRESS TEST");
-           END IF;
- 
-           DECLARE
-                AF_SIZE : INTEGER := ACCFORM'SIZE;
-           BEGIN
-                IF AF_SIZE NOT IN INTEGER THEN
-                     FAILED ("IMPROPER RESULT FROM AF'SIZE");
-                END IF;
-           END;
- 
-           IF ANOTHERTASK1'STORAGE_SIZE < TASK_STORAGE_SIZE THEN
-                FAILED ("IMPROPER VALUE FOR ANOTHERTASK1'STORAGE_SIZE");
-           END IF;
- 
-           B := NEW INTEGER'(25);
- 
-           A := B;
- 
-           IF A.ALL /= 25 THEN
-                FAILED ("IMPROPER VALUE FOR ASSIGNMENT OF VARIABLE " &
-                        "OF A FORMAL ACCESS TYPE FROM ANOTHER " &
-                        "VARIABLE OF A FORMAL ACCESS TYPE");
-           END IF;
- 
-           A := NEW INTEGER'(10);
- 
-           IF A.ALL /= 10 THEN
-                FAILED ("IMPROPER VALUE FOR VARIABLE OF FORMAL ACCESS " &
-                        "TYPE");
-           END IF;
- 
-           IF A NOT IN ACC THEN
-                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
-           END IF;
- 
-           B := ACC'(A);
- 
-           IF B.ALL /= 10 THEN
-                FAILED ("IMPROPER VALUE FROM QUALIFICATION");
-           END IF;
- 
-           DERA := NEW INTEGER'(10);
-           A := ACC(DERA);
- 
-           IF A.ALL /= IDENT_INT(10) THEN
-                FAILED ("IMPROPER VALUE FROM EXPLICIT CONVERSION");
-           END IF;
- 
-           IF A.ALL > IDENT_INT(10) THEN
-                FAILED ("IMPROPER VALUE USED IN LESS THAN");
-           END IF;
- 
-           IF A.ALL < IDENT_INT(10) THEN
-                FAILED ("IMPROPER VALUE USED IN GREATER THAN");
-           END IF;
- 
-           IF A.ALL >= IDENT_INT(11) THEN
-                FAILED ("IMPROPER VALUE USED IN LESS THAN OR EQUAL");
-           END IF;
- 
-           IF A.ALL <= IDENT_INT(9) THEN
-                FAILED ("IMPROPER VALUE USED IN GREATER THAN OR EQUAL");
-           END IF;
- 
-           IF NOT (A.ALL + A.ALL = IDENT_INT(20)) THEN
-                FAILED ("IMPROPER VALUE FROM ADDITION");
-           END IF;
- 
-           IF NOT (A.ALL - IDENT_INT(2) = IDENT_INT(8)) THEN
-                FAILED ("IMPROPER VALUE FROM SUBTRACTION");
-           END IF;
- 
-           IF NOT (A.ALL * IDENT_INT(3) = IDENT_INT(30)) THEN
-                FAILED ("IMPROPER VALUE FROM MULTIPLICATION");
-           END IF;
- 
-           IF NOT (A.ALL / IDENT_INT(3) = IDENT_INT(3)) THEN
-                FAILED ("IMPROPER VALUE FROM DIVISION");
-           END IF;
- 
-           IF NOT (A.ALL MOD IDENT_INT(3) = IDENT_INT(1)) THEN
-                FAILED ("IMPROPER VALUE FROM MODULO");
-           END IF;
- 
-           IF NOT (A.ALL REM IDENT_INT(7) = IDENT_INT(3)) THEN
-                FAILED ("IMPROPER VALUE FROM REMAINDER");
-           END IF;
- 
-           IF NOT (A.ALL ** IDENT_INT(2) = IDENT_INT(100)) THEN
-                FAILED ("IMPROPER VALUE FROM EXPONENTIATION");
-           END IF;
- 
-           IF NOT (+A.ALL = IDENT_INT(10)) THEN
-                FAILED ("IMPROPER VALUE FROM IDENTITY");
-           END IF;
- 
-           IF NOT (-A.ALL = IDENT_INT(-10)) THEN
-                FAILED ("IMPROPER VALUE FROM NEGATION");
-           END IF;
- 
-           A := NULL;
- 
-           IF A /= NULL THEN
-                FAILED ("IMPROPER VALUE FROM ACCESS SET TO NULL");
-           END IF;
- 
-           IF A'ADDRESS NOT IN ADDRESS THEN
-                FAILED ("IMPROPER RESULT FROM A'ADDRESS TEST");
-           END IF;
- 
- 
-           DECLARE
-                ACC_SIZE : INTEGER := ACC'SIZE;
-           BEGIN
-                IF ACC_SIZE NOT IN INTEGER THEN
-                     FAILED ("IMPROPER RESULT FROM ACC'SIZE");
-                END IF;
-           END;
- 
-           R := NEW REC'(COMP => 5);
- 
-           IF NOT EQUAL(R.COMP,5) THEN
-                FAILED ("IMPROPER VALUE FOR RECORD COMPONENT");
-           END IF;
- 
-           DR := NEW DISCREC'(DISC => 1, COMPD => 5);
- 
-           IF NOT EQUAL(DR.DISC,1) OR NOT EQUAL(DR.COMPD,5) THEN
-                FAILED ("IMPROPER VALUES FOR DISCRIMINATED RECORD " &
-                        "COMPONENTS");
-           END IF;
- 
-           C := NEW ARR'(1 => (1,2), 2 => (3,4));
- 
-           IF C(1,1) /= 1 OR C(1,2) /= 2 OR C(2,1) /= 3 OR C(2,2) /= 4
-                THEN FAILED ("IMPROPER ARRAY COMPONENT VALUES");
-           END IF;
- 
-           D := NEW ONEDIM'(1,2,3,4,5,6,7,8,9,10);
-           E := NEW ONEDIM'(10,9,8,7,6,5,4,3,2,1);
- 
-           D(1..5) := E(1..5);
- 
-           IF D(1) /= 10 OR D(2) /= 9 OR D(3) /= 8
-                OR D(4) /= 7 OR D(5) /= 6 THEN
-                FAILED ("IMPROPER RESULTS FROM SLICE ASSIGNMENT");
-           END IF;
- 
-           IF C'FIRST /= 1 OR C'FIRST(2) /= 1 THEN
-                FAILED ("IMPROPER LOWER BOUNDS FOR CONSTRAINED ARRAY");
-           END IF;
- 
-           IF C'LAST /= 2 OR C'LAST(2) /= 2 THEN
-                FAILED ("IMPROPER UPPER BOUNDS FOR CONSTRAINED ARRAY");
-           END IF;
- 
-           IF 1 NOT IN C'RANGE THEN
-                FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 1");
-           END IF;
- 
-           IF 1 NOT IN C'RANGE(2) THEN
-                FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 2");
-           END IF;
- 
-           IF C'LENGTH /= 2 THEN
-                FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
-                        "ARRAY - 1");
-           END IF;
- 
-           IF C'LENGTH(2) /= 2 THEN
-                FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
-                        "ARRAY - 2");
-           END IF;
- 
-           F := NEW T;
- 
-           F.HERE(INT);
- 
-           IF NOT EQUAL(INT,IDENT_INT(10)) THEN
-                FAILED ("IMPROPER RESULTS FROM ENTRY SELECTION");
-           END IF;
- 
-           G := NEW T1;
- 
-           G.HERE1(TWO)(INT);
- 
-           IF NOT EQUAL(INT,IDENT_INT(20)) THEN
-                FAILED ("IMPROPER RESULTS FROM FAMILY ENTRY SELECTION");
-           END IF;
- 
-           RESULT;
-      END P;
- 
-      PACKAGE PACK IS NEW P(INTEGER,ACCINTEGER,AI,AREC,ADISCREC,
-                            AA,AONEDIM,ATASK,ATASK1,ANOTHERTASK);
- 
- BEGIN
-      NULL;
- END CC1225A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1226b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1226b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1226b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1226b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,176 ****
- -- CC1226B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, FOR A FORMAL NONLIMITED PRIVATE TYPE, THAT ALL ALLOWABLE
- --     OPERATIONS ARE IMPLICITLY DECLARED.
- 
- -- HISTORY:
- --     BCB 04/04/88  CREATED ORIGINAL TEST.
- --     RJW 03/28/90  INITIALIZED PREVIOUSLY UNINITIALIZED VARIABLES.
- --     LDC 09/19/90  INITALIZED NLPVAR & NLPVAR2 TO DIFFERENT VALUES,
- --                   REMOVED USE CLAUSE.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE CC1226B IS
- 
-      TYPE DISCREC(DISC1 : INTEGER := 1;
-                   DISC2 : BOOLEAN := FALSE) IS RECORD
-           NULL;
-      END RECORD;
- 
-      GENERIC
-           TYPE NLP IS PRIVATE;
-           TYPE NLPDISC(DISC1 : INTEGER;
-                        DISC2 : BOOLEAN) IS PRIVATE;
-           WITH PROCEDURE INITIALIZE (N : OUT NLPDISC);
-           WITH FUNCTION INITIALIZE RETURN NLP;
-           WITH FUNCTION INITIALIZE_2 RETURN NLP;
-      PACKAGE P IS
-           FUNCTION IDENT(X : NLP) RETURN NLP;
-           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
-      END P;
- 
-      PACKAGE BODY P IS
-           TYPE DER_NLP IS NEW NLP;
-           NLPVAR : NLP := INITIALIZE_2;
-           NLPVAR2, NLPVAR3 : NLP := INITIALIZE;
-           DERNLP : DER_NLP := DER_NLP (INITIALIZE);
-           NDVAR : NLPDISC(DISC1 => 5, DISC2 => TRUE);
-           NLPVARADDRESS : ADDRESS;
-           NLPSIZE : INTEGER;
-           NLPBASESIZE : INTEGER;
- 
-           FUNCTION IDENT(X : NLP) RETURN NLP IS
-                Z : NLP := INITIALIZE;
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN X;
-                END IF;
-                RETURN Z;
-           END IDENT;
- 
-           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
-                I : INTEGER;
-                Z : ADDRESS := I'ADDRESS;
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN Y;
-                END IF;
-                RETURN Z;
-           END IDENT_ADR;
- 
-      BEGIN
-           TEST ("CC1226B", "CHECK, FOR A FORMAL NONLIMITED PRIVATE " &
-                            "TYPE THAT ALL ALLOWABLE OPERATIONS ARE " &
-                            "IMPLICITLY DECLARED");
- 
-           INITIALIZE (NDVAR);
- 
-           NLPVAR := NLPVAR2;
- 
-           IF NLPVAR /= NLPVAR2 THEN
-                FAILED ("IMPROPER VALUE FROM ASSIGNMENT");
-           END IF;
- 
-           IF NLPVAR NOT IN NLP THEN
-                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
-           END IF;
- 
-           NLPVAR := NLP'(NLPVAR2);
- 
-           IF NLPVAR /= NLPVAR2 THEN
-                FAILED ("IMPROPER RESULT FROM QUALIFICATION");
-           END IF;
- 
-           NLPVAR := NLP(DERNLP);
- 
-           IF NLPVAR /= IDENT(NLP(DERNLP)) THEN
-                FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION");
-           END IF;
- 
-           NLPSIZE := IDENT_INT(NLP'SIZE);
- 
-           IF NLPSIZE /= INTEGER(NLP'SIZE) THEN
-                FAILED ("IMPROPER VALUE FOR NLP'SIZE");
-           END IF;
- 
-           NLPVARADDRESS := NLPVAR'ADDRESS;
- 
-           IF NLPVAR'ADDRESS /= IDENT_ADR(NLPVARADDRESS) THEN
-                FAILED ("IMPROPER VALUE FOR NLPVAR'ADDRESS");
-           END IF;
- 
-           IF NDVAR.DISC1 /= IDENT_INT(5) THEN
-                FAILED ("IMPROPER DISCRIMINANT VALUE - 1");
-           END IF;
- 
-           IF NOT NDVAR.DISC2 THEN
-                FAILED ("IMPROPER DISCRIMINANT VALUE - 2");
-           END IF;
- 
-           IF NOT NDVAR'CONSTRAINED THEN
-                FAILED ("IMPROPER VALUE FOR NDVAR'CONSTRAINED");
-           END IF;
- 
-           NLPVAR := NLPVAR3;
- 
-           IF NOT (NLPVAR = IDENT(NLPVAR3)) THEN
-                FAILED ("IMPROPER VALUE FROM EQUALITY OPERATION");
-           END IF;
- 
-           IF NLPVAR /= IDENT(NLPVAR3) THEN
-                FAILED ("IMPROPER VALUE FROM INEQUALITY OPERATION");
-           END IF;
- 
-           RESULT;
-      END P;
- 
-      PROCEDURE INITIALIZE (I : OUT DISCREC) IS
-      BEGIN
-           I := (5, TRUE);
-      END INITIALIZE;
- 
-      FUNCTION INITIALIZE RETURN INTEGER IS
-      BEGIN
-           RETURN 5;
-      END INITIALIZE;
- 
-      FUNCTION INITIALIZE_OTHER RETURN INTEGER IS
-      BEGIN
-           RETURN 3;
-      END INITIALIZE_OTHER;
- 
-      PACKAGE PACK IS NEW P(INTEGER, 
-                            DISCREC, 
-                            INITIALIZE, 
-                            INITIALIZE, 
-                            INITIALIZE_OTHER);
- 
- BEGIN
-      NULL;
- END CC1226B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,289 ****
- -- CC1227A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, WHEN DERIVING FROM A FORMAL TYPE, THAT ALL THE PREDEFINED
- --     OPERATIONS ASSOCIATED WITH THE CLASS OF THE FORMAL TYPE ARE
- --     DECLARED FOR THE DERIVED TYPE.
- 
- -- HISTORY:
- --     BCB 04/04/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE CC1227A IS
- 
-      GENERIC
-           TYPE FORM IS RANGE <>;
-      PACKAGE P IS
-           TYPE DER_FORM IS NEW FORM;
-           FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM;
-           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
-      END P;
- 
-      PACKAGE BODY P IS
-           DER_VAR : DER_FORM;
-           DER_FORM_BASE_FIRST : DER_FORM;
-           DER_FORM_FIRST : DER_FORM;
-           DER_FORM_LAST : DER_FORM;
-           DER_FORM_SIZE : DER_FORM;
-           DER_FORM_WIDTH : DER_FORM;
-           DER_FORM_POS : DER_FORM;
-           DER_FORM_VAL : DER_FORM;
-           DER_FORM_SUCC : DER_FORM;
-           DER_FORM_PRED : DER_FORM;
-           DER_FORM_IMAGE : STRING(1..5);
-           DER_FORM_VALUE : DER_FORM;
-           DER_VAR_SIZE : DER_FORM;
-           DER_VAR_ADDRESS : ADDRESS;
-           DER_EQUAL, DER_UNEQUAL : DER_FORM;
-           DER_GREATER : DER_FORM;
-           DER_MOD, DER_REM : DER_FORM;
-           DER_ABS, DER_EXP : DER_FORM;
-           INT : INTEGER := 5;
-           FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM IS
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN X;
-                END IF;
-                RETURN 0;
-           END IDENT_DER;
-           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
-                X : DER_FORM;
-           BEGIN
-                IF EQUAL(3,3) THEN
-                     RETURN Y;
-                END IF;
-                RETURN X'ADDRESS;
-           END IDENT_ADR;
-      BEGIN
-           TEST ("CC1227A", "CHECK, WHEN DERIVING FROM A FORMAL TYPE, " &
-                            "THAT ALL THE PREDEFINED OPERATIONS " &
-                            "ASSOCIATED WITH THE CLASS OF THE FORMAL " &
-                            "TYPE ARE DECLARED FOR THE DERIVED TYPE");
- 
-           DER_VAR := IDENT_DER(1);
- 
-           IF DER_VAR /= 1 THEN
-                FAILED ("IMPROPER VALUE FROM ASSIGNMENT OPERATION");
-           END IF;
- 
-           IF DER_VAR NOT IN DER_FORM THEN
-                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
-           END IF;
- 
-           DER_VAR := DER_FORM'(2);
- 
-           IF DER_VAR /= IDENT_DER(2) THEN
-                FAILED ("IMPROPER RESULT FROM QUALIFICATION");
-           END IF;
- 
-           DER_VAR := DER_FORM(INT);
- 
-           IF DER_VAR /= IDENT_DER(5) THEN
-                FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " &
-                        "INTEGER");
-           END IF;
- 
-           DER_VAR := DER_FORM(3.0);
- 
-           IF DER_VAR /= IDENT_DER(3) THEN
-                FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " &
-                         "FLOAT");
-           END IF;
- 
-           DER_VAR := 1_000;
- 
-           IF DER_VAR /= IDENT_DER(1000) THEN
-                FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
-           END IF;
- 
-           DER_FORM_BASE_FIRST := DER_FORM'BASE'FIRST;
- 
-           DER_FORM_FIRST := DER_FORM'FIRST;
- 
-           IF DER_FORM_BASE_FIRST /= IDENT_DER(DER_FORM_FIRST) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'BASE'FIRST");
-           END IF;
- 
-           IF DER_FORM_FIRST /= IDENT_DER(DER_FORM'FIRST) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'FIRST");
-           END IF;
- 
-           DER_FORM_LAST := DER_FORM'LAST;
- 
-           IF DER_FORM_LAST /= IDENT_DER(DER_FORM'LAST) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'LAST");
-           END IF;
- 
-           DER_FORM_SIZE := DER_FORM(DER_FORM'SIZE);
- 
-           IF DER_FORM_SIZE /= IDENT_DER(DER_FORM(DER_FORM'SIZE)) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'SIZE");
-           END IF;
- 
-           DER_FORM_WIDTH := DER_FORM(DER_FORM'WIDTH);
- 
-           IF DER_FORM_WIDTH /= IDENT_DER(DER_FORM(DER_FORM'WIDTH)) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'WIDTH");
-           END IF;
- 
-           DER_FORM_POS := DER_FORM(DER_FORM'POS(DER_VAR));
- 
-           IF DER_FORM_POS /= IDENT_DER(DER_FORM(DER_FORM'POS(DER_VAR)))
-                THEN FAILED ("IMPROPER VALUE FOR DER_FORM'POS(DER_VAR)");
-           END IF;
- 
-           DER_FORM_VAL := DER_FORM'VAL(DER_VAR);
- 
-           IF DER_FORM_VAL /= IDENT_DER(DER_FORM'VAL(DER_VAR)) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'VAL(DER_VAR)");
-           END IF;
- 
-           DER_FORM_SUCC := DER_FORM'SUCC(DER_VAR);
- 
-           IF DER_FORM_SUCC /= IDENT_DER(DER_FORM'SUCC(DER_VAR)) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'SUCC(DER_VAR)");
-           END IF;
- 
-           DER_FORM_PRED := DER_FORM'PRED(DER_VAR);
- 
-           IF DER_FORM_PRED /= IDENT_DER(DER_FORM'PRED(DER_VAR)) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'PRED(DER_VAR)");
-           END IF;
- 
-           DER_FORM_IMAGE := DER_FORM'IMAGE(DER_VAR);
- 
-           IF DER_FORM_IMAGE(2..5) /= "1000" THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'IMAGE(DER_VAR)");
-           END IF;
- 
-           DER_FORM_VALUE := DER_FORM'VALUE(DER_FORM_IMAGE);
- 
-           IF DER_FORM_VALUE /= IDENT_DER(1000) THEN
-                FAILED ("IMPROPER VALUE FOR DER_FORM'VALUE" &
-                        "(DER_FORM_IMAGE)");
-           END IF;
- 
-           DER_VAR_SIZE := DER_FORM(DER_VAR'SIZE);
- 
-           IF DER_VAR_SIZE /= IDENT_DER(DER_FORM(DER_VAR'SIZE)) THEN
-                FAILED ("IMPROPER VALUE FOR DER_VAR'SIZE");
-           END IF;
- 
-           DER_VAR_ADDRESS := DER_VAR'ADDRESS;
- 
-           IF DER_VAR_ADDRESS /= IDENT_ADR(DER_VAR'ADDRESS) THEN
-                FAILED ("IMPROPER VALUE FOR DER_VAR'ADDRESS");
-           END IF;
- 
-           DER_EQUAL := IDENT_DER(1000);
- 
-           IF DER_VAR /= DER_EQUAL THEN
-                FAILED ("IMPROPER RESULT FROM INEQUALITY OPERATOR");
-           END IF;
- 
-           DER_UNEQUAL := IDENT_DER(500);
- 
-           IF DER_VAR = DER_UNEQUAL THEN
-                FAILED ("IMPROPER RESULT FROM EQUALITY OPERATOR");
-           END IF;
- 
-           IF DER_VAR < DER_UNEQUAL THEN
-                FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
-           END IF;
- 
-           IF DER_VAR <= DER_UNEQUAL THEN
-                FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
-                        "OPERATOR");
-           END IF;
- 
-           DER_GREATER := IDENT_DER(1500);
- 
-           IF DER_VAR > DER_GREATER THEN
-                FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
-           END IF;
- 
-           IF DER_VAR >= DER_GREATER THEN
-                FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
-                        "TO OPERATOR");
-           END IF;
- 
-           DER_VAR := DER_VAR + DER_EQUAL;
- 
-           IF DER_VAR /= IDENT_DER(2000) THEN
-                FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
-           END IF;
- 
-           DER_VAR := DER_VAR - DER_EQUAL;
- 
-           IF DER_VAR /= IDENT_DER(1000) THEN
-                FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
-           END IF;
- 
-           DER_VAR := DER_VAR * IDENT_DER(2);
- 
-           IF DER_VAR /= IDENT_DER(2000) THEN
-                FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
-           END IF;
- 
-           DER_VAR := DER_VAR / IDENT_DER(2);
- 
-           IF DER_VAR /= IDENT_DER(1000) THEN
-                FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
-           END IF;
- 
-           DER_MOD := DER_GREATER MOD DER_VAR;
- 
-           IF DER_MOD /= IDENT_DER(500) THEN
-                FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
-           END IF;
- 
-           DER_REM := DER_GREATER REM DER_VAR;
- 
-           IF DER_REM /= IDENT_DER(500) THEN
-                FAILED ("IMPROPER RESULT FROM REM OPERATOR");
-           END IF;
- 
-           DER_ABS := ABS(IDENT_DER(-1500));
- 
-           IF DER_ABS /= IDENT_DER(DER_GREATER) THEN
-                FAILED ("IMPROPER RESULT FROM ABS OPERATOR");
-           END IF;
- 
-           DER_EXP := IDENT_DER(2) ** IDENT_INT(2);
- 
-           IF DER_EXP /= IDENT_DER(4) THEN
-                FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
-           END IF;
- 
-           RESULT;
-      END P;
- 
-      PACKAGE PACK IS NEW P(INTEGER);
- 
- BEGIN
-      NULL;
- END CC1227A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1301a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1301a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1301a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- CC1301A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DEFAULT GENERIC SUBPROGRAM PARAMETERS WORK CORRECTLY,
- -- INCLUDING OVERLOADED AND PREDEFINED OPERATOR_SYMBOLS,
- -- AND SUBPROGRAMS HIDDEN AT THE INSTANTIATION.
- -- BOTH KINDS OF DEFAULTS ARE TESTED, FOR BOTH PROCEDURES
- -- AND FUNCTIONS.
- 
- -- DAT 8/14/81
- -- JBG 5/5/83
- -- JBG 8/3/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1301A IS
- 
-      FUNCTION "-" (R, S : INTEGER) RETURN INTEGER;
- 
-      FUNCTION NEXT (X : INTEGER) RETURN INTEGER;
- 
-      PROCEDURE BUMP (X : IN OUT INTEGER);
- 
-      GENERIC
-           WITH FUNCTION "*" (A, B : INTEGER) RETURN INTEGER IS "-";
-           WITH FUNCTION "+" (R, S: INTEGER) RETURN INTEGER IS 
-                                                        STANDARD."+";
-           WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
-           WITH FUNCTION NEXTO (Q : INTEGER) RETURN INTEGER IS NEXT ;
-           WITH PROCEDURE BUMPO (A : IN OUT INTEGER) IS BUMP;
-           WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER  IS <> ;
-           WITH PROCEDURE BUMP (Q : IN OUT INTEGER) IS <> ;
-           TYPE INTEGER IS RANGE <> ;
-           WITH FUNCTION "*" (A , B : INTEGER) RETURN INTEGER IS <> ;
-           WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
-           WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER IS <> ;
-           WITH PROCEDURE BUMP (Z : IN OUT INTEGER) IS <> ;
-      PACKAGE PKG IS
-           SUBTYPE INT IS STANDARD.INTEGER;
-           DIFF : INT := -999;
-      END PKG;
- 
-      TYPE NEWINT IS NEW INTEGER RANGE -1000 .. 1000;
- 
-      FUNCTION PLUS (Q1, Q2 : INTEGER) RETURN INTEGER RENAMES "+";
- 
-      FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN PLUS (X, PLUS (Y, -10));
-           -- (X + Y - 10)
-      END "+";
- 
-      FUNCTION "-" (R, S : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN - R + S;
-           -- (-R + S - 10)
-      END "-";
- 
-      FUNCTION NEXT (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN X + 1;
-           -- (X + 1 - 10)
-           -- (X - 9)
-      END NEXT;
- 
-      PROCEDURE BUMP (X : IN OUT INTEGER) IS
-      BEGIN
-           X := NEXT (X);
-           -- (X := X - 9)
-      END BUMP;
- 
-      PACKAGE BODY PKG IS
-           W : INTEGER;
-           WI : INT;
-      BEGIN
-           W := NEXT (INTEGER'(3) * 4 - 2);
-           -- (W := (4 ** 3 - 2) - 1)
-           -- (W := 61)
-           BUMP (W);
-           -- (W := 61 + 7)
-           -- (W := 68)
-           WI := NEXT (INT'(3) * 4 - 2 + NEXTO (0));
-           -- (3 * 4) => (3 - 4) => (-3 + 4 - 10) = -9
-           -- ((-9) - 2) => (2 + 2 - (-9) - 20) = -7
-           -- (-7 + (-9)) => -16
-           -- (WI := 7 - (-16)) => (WI := 23)
-           BUMPO (WI);
-           -- (WI := 23 - 9) (= 14)
-           BUMP (WI);
-           -- (WI := 14 - 9) (= 5)
-           DIFF := STANDARD."-" (INT(W), WI);
-           -- (DIFF := 68 - 5) (= 63)
-      END PKG;
- 
-      FUNCTION "*" (Y, X : NEWINT) RETURN NEWINT IS
-      BEGIN
-           RETURN X ** INTEGER(Y);
-           -- (X,Y) (Y ** X)
-      END "*";
- 
-      FUNCTION NEXT (Z : NEWINT) RETURN NEWINT IS
-      BEGIN
-           RETURN Z - 1;
-           -- (Z - 1)
-      END NEXT;
- 
-      PROCEDURE BUMP (ZZ : IN OUT NEWINT) IS
-      BEGIN
-           FAILED ("WRONG PROCEDURE CALLED");
-      END BUMP;
- BEGIN
-      TEST ("CC1301A", "DEFAULT GENERIC SUBPROGRAM PARAMETERS");
- 
-      DECLARE
-           PROCEDURE BUMP (QQQ : IN OUT NEWINT) IS
-           BEGIN
-                QQQ := QQQ + 7;
-                -- (QQQ + 7)
-           END BUMP;
- 
-           FUNCTION NEXT (Q7 : INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN Q7 - 17;
-                -- (-Q7 + 17 - 10)
-                -- (7 - Q7)
-           END NEXT;
- 
-           FUNCTION "-" (Q3, Q4 : INTEGER) RETURN INTEGER IS
-           BEGIN
-                RETURN -Q3 + Q4 + Q4;
-                -- (-Q3 + Q4 - 10 + Q4 - 10) = (Q4 + Q4 - Q3 - 20)
-           END "-";
- 
-           PACKAGE P1 IS NEW PKG (INTEGER => NEWINT);
- 
-      BEGIN
-           IF P1.DIFF /= 63 THEN
-                FAILED ("WRONG DEFAULT SUBPROGRAM PARAMETERS");
-           END IF;
-      END;
- 
-      RESULT;
- END CC1301A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1302a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1302a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1302a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- -- CC1302A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT GENERIC DEFAULT SUBPROGRAM PARAMETERS MAY BE ATTRIBUTES
- -- OF TYPES, INCLUDING GENERIC FORMAL TYPES IN SAME GENERIC PART,
- -- OR IN GENERIC PART OF ENCLOSING UNIT.
- 
- -- DAT 8/27/81
- -- SPS 2/9/83
- -- JBG 2/15/83
- -- JBG 4/29/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1302A IS
- BEGIN
-      TEST ("CC1302A", "GENERIC DEFAULT SUBPROGRAMS MAY BE"
-           & " FUNCTION ATTRIBUTES OF TYPES");
- 
-      DECLARE
-           GENERIC 
-                TYPE T IS ( <> );
-                T_LAST : T;
-                WITH FUNCTION SUCC (X : T) RETURN T IS T'SUCC;
-           PACKAGE PK1 IS
-           END PK1;
- 
-           SUBTYPE CH IS CHARACTER RANGE CHARACTER'FIRST .. '~';
-           SUBTYPE BL IS BOOLEAN RANGE FALSE .. FALSE;
-           SUBTYPE INT IS INTEGER RANGE -10 .. 10;
- 
-           PACKAGE BODY PK1 IS
-                GENERIC 
-                     TYPE TT IS ( <> );
-                     TT_LAST : TT;
-                     WITH FUNCTION PRED (X : TT) RETURN TT IS TT'PRED;
-                     WITH FUNCTION IM(X : T) RETURN STRING IS T'IMAGE;
-                     WITH FUNCTION VAL(X : STRING) RETURN TT IS TT'VALUE;
-                PACKAGE PK2 IS END PK2;
- 
-                PACKAGE BODY PK2 IS
-                BEGIN
- 
- -- CHECK THAT 'LAST GIVES RIGHT ANSWER
-                     IF T'LAST /= T_LAST THEN
-                          FAILED ("T'LAST INCORRECT");
-                     END IF;
- 
-                     IF TT'LAST /= TT_LAST THEN
-                          FAILED ("TT'LAST INCORRECT");
-                     END IF;
- 
- -- CHECK SUCC FUNCTION
-                     BEGIN
-                          IF T'PRED(SUCC(T'LAST)) /= T'LAST THEN
-                               FAILED ("'PRED OR SUCC GIVES WRONG " &
-                                       "RESULT");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED ("SUCC HAS CONSTRAINTS OF " &
-                                       "SUBTYPE");
-                          WHEN OTHERS =>
-                               FAILED ("SOME EXCEPTION RAISED - 1");
-                     END;
- 
- -- CHECK 'SUCC ATTRIBUTE
-                     BEGIN
-                          IF T'PRED(T'SUCC(T'LAST)) /= T'LAST THEN
-                               FAILED ("'PRED OR 'SUCC GIVES WRONG " &
-                                       "RESULT");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED ("'PRED OR 'SUCC HAS CONSTRAINTS "&
-                                       "OF SUBTYPE");
-                          WHEN OTHERS =>
-                               FAILED ("SOME EXCEPTION RAISED - 2");
-                     END;
- 
- -- CHECK VAL ATTRIBUTE
-                     BEGIN
-                          IF T'VAL(T'POS(T'SUCC(T'LAST))) /=
-                             T'VAL(T'POS(T'LAST)+1) THEN
-                               FAILED ("VAL OR POS ATTRIBUTE HAS " &
-                                       "INCONSISTENT RESULTS");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED ("VAL OR POS ATTRIBUTE HAS " &
-                                       "CONSTRAINTS OF SUBTYPE");
-                          WHEN OTHERS =>
-                               FAILED ("SOME EXCEPTION RAISED - 4");
-                     END;
- 
- -- CHECK VAL FUNCTION
-                     BEGIN
-                          IF TT'VAL(TT'POS(TT'SUCC(TT'LAST))) /= 
-                             TT'VAL(TT'POS(TT'LAST)+1) THEN
-                               FAILED ("VAL FUNCTION GIVES INCORRECT " &
-                                       "RESULTS");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED ("VAL FUNCTION HAS CONSTRAINTS " &
-                                       "OF SUBTYPE");
-                          WHEN OTHERS =>
-                               FAILED ("SOME EXCEPTION RAISED - 6");
-                     END;
- 
- -- CHECK IM FUNCTION
-                     BEGIN
-                          IF T'IMAGE(T'SUCC(T'LAST)) /= 
-                               IM   (T'SUCC(T'LAST)) THEN
-                               FAILED ("IM FUNCTION GIVES INCORRECT " &
-                                       "RESULTS");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED ("IM FUNCTION HAS CONSTRAINTS " &
-                                       "OF SUBTYPE");
-                          WHEN OTHERS =>
-                               FAILED ("SOME EXCEPTION RAISED - 7");
-                     END;
- 
- -- CHECK PRED FUNCTION
-                     BEGIN
-                          IF PRED(TT'SUCC(TT'LAST)) /= TT'LAST THEN
-                               FAILED ("PRED FUNCTION GIVES INCORRECT " &
-                                       "RESULTS");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               FAILED ("PRED FUNCTION HAS CONSTRAINTS " &
-                                       "OF SUBTYPE");
-                          WHEN OTHERS =>
-                               FAILED ("SOME EXCEPTION RAISED - 8");
-                     END;
- 
-                END PK2;
- 
-                PACKAGE PK3 IS NEW PK2 (T, T'LAST);
-           END PK1;
- 
-           PACKAGE PKG1 IS NEW PK1 (CH, CH'LAST);
-           PACKAGE PKG2 IS NEW PK1 (BL, BL'LAST);
-           PACKAGE PKG3 IS NEW PK1 (INT, INT'LAST);
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC1302A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1304a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1304a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1304a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- CC1304A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT GENERIC FORMAL SUBPROGRAMS MAY HAVE A PARAMETER
- -- OF A GENERIC FORMAL TYPE, AND MAY RETURN A GENERIC FORMAL
- -- TYPE.
- 
- -- DAT 8/27/81
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1304A IS
- BEGIN
-      TEST ("CC1304A", "GENERIC FORMAL SUBPROGRAMS MAY HAVE PARAMETERS"
-           & " OF (AND RETURN) A FORMAL TYPE");
- 
-      DECLARE
-           GENERIC
-                TYPE T IS ( <> );
-                WITH FUNCTION S (P : T) RETURN T;
-                WITH PROCEDURE P (P : T);
-           PROCEDURE PR (PARM : T);
- 
-           PROCEDURE PR (PARM: T) IS
-           BEGIN
-                P(P=>S(P=>PARM));
-           END PR;
-      BEGIN
-           DECLARE
-                C : CHARACTER := 'A';
-                B : BOOLEAN := FALSE;
-                I : INTEGER := 5;
-                TYPE ENUM IS (E1, E2, E3);
-                E : ENUM := E2;
- 
-                FUNCTION FC (P : CHARACTER) RETURN CHARACTER IS
-                BEGIN
-                     RETURN 'B';
-                END FC;
- 
-                FUNCTION FB (P : BOOLEAN) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN NOT P;
-                END FB;
-      
-                FUNCTION FI (P : INTEGER) RETURN INTEGER IS
-                BEGIN
-                     RETURN P + 1;
-                END FI;
- 
-                FUNCTION FE (P : ENUM) RETURN ENUM IS
-                BEGIN
-                     RETURN ENUM'SUCC (P);
-                END FE;
- 
-                PROCEDURE  PC (P : CHARACTER) IS
-                BEGIN
-                     C := P;
-                END PC;
- 
-                PROCEDURE PB (P : BOOLEAN) IS
-                BEGIN
-                     B := P;
-                END PB;
- 
-                PROCEDURE PI (P : INTEGER) IS
-                BEGIN
-                    I := P;
-                END PI;
-  
-                PROCEDURE PE (P : ENUM) IS
-                BEGIN
-                     E := P;
-                END PE;
- 
-                PACKAGE PKG2 IS
-                     PROCEDURE P1 IS NEW PR (CHARACTER, FC, PC);
-                     PROCEDURE P2 IS NEW PR (BOOLEAN, FB, PB);
-                     PROCEDURE P3 IS NEW PR (INTEGER, FI, PI);
-                     PROCEDURE P4 IS NEW PR (ENUM, FE, PE);
-                END PKG2;
- 
-                PACKAGE BODY PKG2 IS
-                BEGIN
-                     P1 (C);
-                     P2 (B);
-                     P3 (I);
-                     P4 (E);
-                END  PKG2;
-           BEGIN
-                IF C /= 'B'
-                OR B /= TRUE
-                OR I /= 6
-                OR E /= E3 THEN
-                     FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES");
-                END IF;
-           END;
-      END;
-      
-      RESULT;
- END CC1304A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1304b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1304b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1304b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1304b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,166 ****
- -- CC1304B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GENERIC FORMAL SUBPROGRAMS MAY HAVE A PARAMETER
- --     OF A GENERIC FORMAL TYPE, AND MAY RETURN A GENERIC FORMAL
- --     TYPE.  CHECK MODES IN OUT AND OUT.
- 
- -- HISTORY:
- --     BCB 08/04/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1304B IS
- 
- BEGIN
-      TEST ("CC1304B", "GENERIC FORMAL SUBPROGRAMS MAY HAVE A " &
-                       "PARAMETER OF A GENERIC FORMAL TYPE, AND MAY  " &
-                       "RETURN A GENERIC FORMAL TYPE.  CHECK MODES IN " &
-                       "OUT AND OUT");
- 
-      DECLARE
-           GENERIC
-                TYPE T IS ( <> );
-                WITH PROCEDURE S (P : OUT T);
-                WITH PROCEDURE P (P : IN OUT T);
-                WITH FUNCTION L RETURN T;
-           PROCEDURE PR (PARM1, PARM2, PARM3 : IN OUT T);
- 
-           PROCEDURE PR (PARM1, PARM2, PARM3 : IN OUT T) IS
-           BEGIN
-                S (P => PARM1);
-                P (P => PARM2);
-                PARM3 := L;
-           END PR;
-      BEGIN
-           DECLARE
-                C : CHARACTER := 'A';
-                C1 : CHARACTER := 'Y';
-                C2 : CHARACTER := 'I';
-                B : BOOLEAN := FALSE;
-                B1 : BOOLEAN := TRUE;
-                B2 : BOOLEAN := FALSE;
-                I : INTEGER := 5;
-                I1 : INTEGER := 10;
-                I2 : INTEGER := 0;
-                TYPE ENUM IS (E1, E2, E3);
-                F : ENUM := E2;
-                F1 : ENUM := E1;
-                F2 : ENUM := E2;
- 
-                PROCEDURE FC (P : OUT CHARACTER) IS
-                BEGIN
-                     P := 'B';
-                END FC;
- 
-                PROCEDURE FB (P : OUT BOOLEAN) IS
-                BEGIN
-                     P := NOT B;
-                END FB;
- 
-                PROCEDURE FI (P : OUT INTEGER) IS
-                BEGIN
-                     P :=  I + 1;
-                END FI;
- 
-                PROCEDURE FE (P : OUT ENUM) IS
-                BEGIN
-                     P := ENUM'SUCC (F);
-                END FE;
- 
-                PROCEDURE  PC (P : IN OUT CHARACTER) IS
-                BEGIN
-                     P := 'Z';
-                END PC;
- 
-                PROCEDURE PB (P : IN OUT BOOLEAN) IS
-                BEGIN
-                     P := NOT B1;
-                END PB;
- 
-                PROCEDURE PI (P : IN OUT INTEGER) IS
-                BEGIN
-                    P := I1 + 1;
-                END PI;
- 
-                PROCEDURE PE (P : IN OUT ENUM) IS
-                BEGIN
-                     P := ENUM'SUCC (F1);
-                END PE;
- 
-                FUNCTION LC RETURN CHARACTER IS
-                BEGIN
-                     RETURN 'J';
-                END LC;
- 
-                FUNCTION LB RETURN BOOLEAN IS
-                BEGIN
-                     RETURN TRUE;
-                END LB;
- 
-                FUNCTION LI RETURN INTEGER IS
-                BEGIN
-                     RETURN IDENT_INT(5);
-                END LI;
- 
-                FUNCTION LE RETURN ENUM IS
-                BEGIN
-                     RETURN ENUM'SUCC(F2);
-                END LE;
- 
-                PACKAGE PKG2 IS
-                     PROCEDURE P1 IS NEW PR (CHARACTER, FC, PC, LC);
-                     PROCEDURE P2 IS NEW PR (BOOLEAN, FB, PB, LB);
-                     PROCEDURE P3 IS NEW PR (INTEGER, FI, PI, LI);
-                     PROCEDURE P4 IS NEW PR (ENUM, FE, PE, LE);
-                END PKG2;
- 
-                PACKAGE BODY PKG2 IS
-                BEGIN
-                     P1 (C,C1,C2);
-                     P2 (B,B1,B2);
-                     P3 (I,I1,I2);
-                     P4 (F,F1,F2);
-                END  PKG2;
-           BEGIN
-                IF C /= 'B' OR B /= TRUE OR I /= 6 OR F /= E3 THEN
-                     FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES - " &
-                             "MODE OUT");
-                END IF;
- 
-                IF C1 /= 'Z' OR B1 /= FALSE OR I1 /= 11 OR F1 /= E2 THEN
-                     FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES - " &
-                             "MODE IN OUT");
-                END IF;
- 
-                IF C2 /= 'J' OR B2 /= TRUE OR I2 /= 5 OR F2 /= E3 THEN
-                     FAILED ("GENERIC FORMAL SUBPROGRAMS RETURNING A " &
-                             "GENERIC FORMAL TYPE");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END CC1304B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1307a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1307a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1307a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1307a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- CC1307A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SUBPROGRAM PARAMETERS MAY HAVE AN OPERATOR_SYMBOL DEFAULT,
- -- WHICH LOOKS THE SAME AS A DEFAULT STRING PARAMETER.
- 
- -- DAT 9/8/81
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1307A IS
- BEGIN
-      TEST ("CC1307A", "GENERIC SUBPROGRAM AND STRING DEFAULT PARAMETERS"
-           & " MAY LOOK THE SAME");
- 
-      DECLARE
-           GENERIC
-                WITH FUNCTION CAT (X, Y : STRING) RETURN STRING
-                     IS "&";
-                S : STRING := "&";
-           PACKAGE PK IS
-                VAL : CONSTANT STRING := CAT (S, S);
-           END PK;
- 
-           PACKAGE PK1 IS NEW PK;
-      BEGIN
-           IF PK1.VAL /= "&&" THEN
-                FAILED ("INCORRECT GENERIC INSTANTIATION WITH DEFAULTS");
-           END IF;
-      END;
- 
-      RESULT;
- END CC1307A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1307b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1307b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1307b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1307b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- CC1307B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION LITERAL (BOTH AN IDENTIFIER AND A
- --     CHARACTER LITERAL) MAY BE USED AS A DEFAULT SUBPROGRAM NAME
- --     AND AS A DEFAULT INITIAL VALUE FOR AN OBJECT PARAMETER.
- 
- -- HISTORY:
- --     BCB 08/09/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1307B IS
- 
-      TYPE ENUM IS (R, 'S', R1);
- 
- BEGIN
-      TEST ("CC1307B", "CHECK THAT AN ENUMERATION LITERAL (BOTH AN " &
-                       "IDENTIFIER AND A CHARACTER LITERAL) MAY BE " &
-                       "USED AS A DEFAULT SUBPROGRAM NAME AND AS A " &
-                       "DEFAULT INITIAL VALUE FOR AN OBJECT PARAMETER");
- 
-      DECLARE
-           GENERIC
-                WITH FUNCTION J RETURN ENUM IS R;
-                WITH FUNCTION K RETURN ENUM IS 'S';
-                OBJ1 : ENUM := R;
-                OBJ2 : ENUM := 'S';
-           PACKAGE P IS
-           END P;
- 
-           PACKAGE BODY P IS
-                VAR1, VAR2 : ENUM := R1;
-           BEGIN
-                VAR1 := J;
- 
-                IF VAR1 /= R THEN
-                     FAILED ("WRONG VALUE FOR DEFAULT SUBPROGRAM " &
-                             "NAME - IDENTIFIER");
-                END IF;
- 
-                VAR2 := K;
- 
-                IF VAR2 /= 'S' THEN
-                     FAILED ("WRONG VALUE FOR DEFAULT SUBPROGRAM " &
-                             "NAME - CHARACTER LITERAL");
-                END IF;
- 
-                IF OBJ1 /= R THEN
-                     FAILED ("WRONG VALUE FOR OBJECT PARAMETER - " &
-                             "IDENTIFIER");
-                END IF;
- 
-                IF OBJ2 /= 'S' THEN
-                     FAILED ("WRONG VALUE FOR OBJECT PARAMETER - " &
-                             "CHARACTER LITERAL");
-                END IF;
-           END P;
- 
-           PACKAGE NEW_P IS NEW P;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC1307B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1308a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1308a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1308a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1308a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- CC1308A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FORMAL SUBPROGRAM PARAMETERS MAY OVERLOAD EACH OTHER
- --     AND OTHER VISIBLE SUBPROGRAMS AND ENUMERATION LITERALS WITHIN AND
- --     OUTSIDE OF THE GENERIC UNIT.
- 
- -- HISTORY:
- --     DAT 09/08/81  CREATED ORIGINAL TEST.
- --     SPS 10/26/82
- --     SPS 02/09/83
- --     BCB 08/09/88  REPLACED THE OLD TEST WITH A VERSION BASED ON
- --                   AIG 6.6/T2.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1308A IS
- 
-      TYPE ENUM IS (F1,F2,F3,F4,F5,F6,F7);
- 
-      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN 2*X;
-      END F1;
- 
-      PROCEDURE F1 (X : IN OUT INTEGER) IS
-      BEGIN
-           X := 3*X;
-      END F1;
- 
-      PROCEDURE F2 (Y : IN OUT INTEGER; Z : IN OUT BOOLEAN) IS
-      BEGIN
-           Y := 2*Y;
-           Z := NOT Z;
-      END F2;
- 
-      PROCEDURE F2 (Y : IN OUT INTEGER) IS
-      BEGIN
-           Y := 3*Y;
-      END F2;
- 
-      PROCEDURE F3 (B : BOOLEAN := FALSE; A : IN OUT INTEGER) IS
-      BEGIN
-           A := 2*A;
-      END F3;
- 
-      PROCEDURE F3 (A : IN OUT INTEGER) IS
-      BEGIN
-           A := 3*A;
-      END F3;
- 
-      PROCEDURE F4 (C : IN OUT INTEGER) IS
-      BEGIN
-           C := 2*C;
-      END F4;
- 
-      PROCEDURE F4 (C : IN OUT BOOLEAN) IS
-      BEGIN
-           C := NOT C;
-      END F4;
- 
-      PROCEDURE F5 (D : IN OUT INTEGER; E : IN OUT BOOLEAN) IS
-      BEGIN
-           D := 2*D;
-           E := NOT E;
-      END F5;
- 
-      PROCEDURE F5 (E : IN OUT BOOLEAN; D : IN OUT INTEGER) IS
-      BEGIN
-           E := NOT E;
-           D := 3*D;
-      END F5;
- 
-      FUNCTION F6 (G : INTEGER) RETURN INTEGER IS
-      BEGIN
-           RETURN 2*G;
-      END F6;
- 
-      FUNCTION F6 (G : INTEGER) RETURN BOOLEAN IS
-      BEGIN
-           RETURN TRUE;
-      END F6;
- 
-      FUNCTION F7 RETURN INTEGER IS
-      BEGIN
-           RETURN 25;
-      END F7;
- 
-      FUNCTION F7 RETURN BOOLEAN IS
-      BEGIN
-           RETURN FALSE;
-      END F7;
- 
- BEGIN
-      TEST ("CC1308A", "CHECK THAT FORMAL SUBPROGRAM PARAMETERS MAY " &
-                       "OVERLOAD EACH OTHER AND OTHER VISIBLE " &
-                       "SUBPROGRAMS AND ENUMERATION LITERALS WITHIN " &
-                       "AND OUTSIDE OF THE GENERIC UNIT");
- 
-      DECLARE
-           GENERIC
-                WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER;
-                WITH PROCEDURE F1 (X : IN OUT INTEGER);
- 
-                WITH PROCEDURE F2 (Y : IN OUT INTEGER;
-                                   Z : IN OUT BOOLEAN);
-                WITH PROCEDURE F2 (Y : IN OUT INTEGER);
- 
-                WITH PROCEDURE F3 (B : BOOLEAN := FALSE;
-                                   A : IN OUT INTEGER);
-                WITH PROCEDURE F3 (A : IN OUT INTEGER);
- 
-                WITH PROCEDURE F4 (C : IN OUT INTEGER);
-                WITH PROCEDURE F4 (C : IN OUT BOOLEAN);
- 
-                WITH PROCEDURE F5 (D : IN OUT INTEGER;
-                                   E : IN OUT BOOLEAN);
-                WITH PROCEDURE F5 (E : IN OUT BOOLEAN;
-                                   D : IN OUT INTEGER);
- 
-                WITH FUNCTION F6 (G : INTEGER) RETURN INTEGER;
-                WITH FUNCTION F6 (G : INTEGER) RETURN BOOLEAN;
- 
-                WITH FUNCTION F7 RETURN INTEGER;
-                WITH FUNCTION F7 RETURN BOOLEAN;
-           PACKAGE P IS
-                TYPE EN IS (F1,F2,F3,F4,F5,F6,F7);
-           END P;
- 
-           PACKAGE BODY P IS
-                X1, X2, Y1, Y2, A1, A2, C1, D1, D2, G1
-                   : INTEGER := IDENT_INT(5);
- 
-                VAL : INTEGER := IDENT_INT(0);
- 
-                Z1, B1, C2, E1, E2, BOOL : BOOLEAN := IDENT_BOOL(FALSE);
-           BEGIN
-                VAL := F1(X1);
- 
-                IF NOT EQUAL(VAL,10) THEN
-                     FAILED ("CASE 1 - WRONG VALUE RETURNED FROM " &
-                             "FUNCTION");
-                END IF;
- 
-                F1(X2);
- 
-                IF NOT EQUAL(X2,15) THEN
-                     FAILED ("CASE 1 - WRONG VALUE ASSIGNED INSIDE " &
-                             "PROCEDURE");
-                END IF;
- 
-                F2(Y1,Z1);
- 
-                IF NOT EQUAL(Y1,10) OR Z1 /= TRUE THEN
-                     FAILED ("CASE 2 - WRONG VALUES ASSIGNED INSIDE " &
-                             "PROCEDURE");
-                END IF;
- 
-                F2(Y2);
- 
-                IF NOT EQUAL(Y2,15) THEN
-                     FAILED ("CASE 2 - WRONG VALUE ASSIGNED INSIDE " &
-                             "PROCEDURE");
-                END IF;
- 
-                F3(B1,A1);
- 
-                IF NOT EQUAL(A1,10) OR B1 /= FALSE THEN
-                     FAILED ("CASE 3 - WRONG VALUES ASSIGNED INSIDE " &
-                             "PROCEDURE");
-                END IF;
- 
-                F3(A2);
- 
-                IF NOT EQUAL(A2,15) THEN
-                     FAILED ("CASE 3 - WRONG VALUE ASSIGNED INSIDE " &
-                             "PROCEDURE");
-                END IF;
- 
-                F4(C1);
- 
-                IF NOT EQUAL(C1,10) THEN
-                     FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
-                             "PROCEDURE - BASE TYPE INTEGER");
-                END IF;
- 
-                F4(C2);
- 
-                IF C2 /= TRUE THEN
-                     FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
-                             "PROCEDURE - BASE TYPE BOOLEAN");
-                END IF;
- 
-                F5(D1,E1);
- 
-                IF NOT EQUAL(D1,10) OR E1 /= TRUE THEN
-                     FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
-                             "PROCEDURE - ORDER WAS INTEGER, BOOLEAN");
-                END IF;
- 
-                F5(E2,D2);
- 
-                IF E2 /= TRUE OR NOT EQUAL(D2,15) THEN
-                     FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
-                             "PROCEDURE - ORDER WAS BOOLEAN, INTEGER");
-                END IF;
- 
-                VAL := F6(G1);
- 
-                IF NOT EQUAL(VAL,10) THEN
-                     FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
-                             "FUNCTION - TYPE INTEGER");
-                END IF;
- 
-                BOOL := F6(G1);
- 
-                IF BOOL /= TRUE THEN
-                     FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
-                             "FUNCTION - TYPE BOOLEAN");
-                END IF;
- 
-                VAL := F7;
- 
-                IF NOT EQUAL(VAL,25) THEN
-                     FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
-                             "PARAMETERLESS FUNCTION - TYPE INTEGER");
-                END IF;
- 
-                BOOL := F7;
- 
-                IF BOOL /= FALSE THEN
-                     FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
-                             "PARAMETERLESS FUNCTION - TYPE BOOLEAN");
-                END IF;
-           END P;
- 
-           PACKAGE NEW_P IS NEW P (F1, F1, F2, F2, F3, F3,
-                                   F4, F4, F5, F5, F6, F6, F7, F7);
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC1308A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1310a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1310a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1310a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1310a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- CC1310A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DEFAULT GENERIC SUBPROGRAM PARAMETERS MAY BE ENTRIES.
- 
- -- DAT 9/8/81
- -- SPS 2/7/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1310A IS
- BEGIN
-      TEST ("CC1310A", "DEFAULT GENERIC SUBPROGRAM PARAMETERS MAY BE"
-           & " ENTRIES");
- 
-      DECLARE
-           TASK T IS
-                ENTRY ENT1;
-                ENTRY ENT2 (I : IN INTEGER);
-           END T;
- 
-           PROCEDURE P1 RENAMES T.ENT1;
-           
-           PROCEDURE P4 (I : IN INTEGER) RENAMES T.ENT2;
- 
-           INT : INTEGER := 0;
- 
-           TASK BODY T IS
-           BEGIN
-                ACCEPT ENT1;
-                ACCEPT ENT2 (I : IN INTEGER) DO
-                     INT := INT + I;
-                END ENT2;
-                ACCEPT ENT2 (I : IN INTEGER) DO
-                     INT := INT + I;
-                END ENT2;
-                ACCEPT ENT1;
-           END T;
- 
-      BEGIN
-           DECLARE
-                GENERIC 
-                     WITH PROCEDURE P1 IS <> ;
-                     WITH PROCEDURE P2 IS T.ENT1;
-                     WITH PROCEDURE P3 (I : IN INTEGER) IS T.ENT2;
-                     WITH PROCEDURE P4 (I : IN INTEGER) IS <> ;
-                PACKAGE PKG IS END PKG;
- 
-                PACKAGE BODY PKG IS
-                BEGIN
-                     P1;
-                     P4 (3);
-                     P3 (6);
-                     P2;
-                END PKG;
- 
-                PACKAGE PP IS NEW PKG;
- 
-           BEGIN
-                IF INT /= 9 THEN
-                     FAILED ("ENTRIES AS DEFAULT GENERIC PARAMETERS");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END CC1310A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1311a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1311a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1311a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1311a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,480 ****
- -- CC1311A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --     CHECK THAT THE DEFAULT EXPRESSIONS OF THE PARAMETERS OF A FORMAL
- --     SUBPROGRAM ARE USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE
- --     ACTUAL SUBPROGRAM PARAMETER.
- 
- -- HISTORY:
- --     RJW 06/05/86  CREATED ORIGINAL TEST.
- --     VCL 08/18/87  CHANGED A COUPLE OF STATIC DEFAULT EXPRESSIONS FOR
- --                   FORMAL SUBPROGRAM PARAMETERS TO DYNAMIC 
- --                   EXPRESSIONS VIA THE USE OF THE IDENTITY FUNCTION.
- --     EDWARD V. BERARD 08/13/90  
- --                   ADDED CHECKS FOR MULTI-DIMENSIONAL ARRAYS.
- 
- WITH REPORT ;
- 
- PROCEDURE CC1311A IS
- 
-      TYPE NUMBERS IS (ZERO, ONE ,TWO);
- 
-      SHORT_START : CONSTANT := -100 ;
-      SHORT_END   : CONSTANT := 100 ;
-      TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
-     
-      SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
-     
-      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                          SEP, OCT, NOV, DEC) ;
-                         
-      SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
-     
-      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-      TYPE DATE IS RECORD
-           MONTH : MONTH_TYPE ;
-           DAY   : DAY_TYPE ;
-           YEAR  : YEAR_TYPE ;
-      END RECORD ;
-     
-      TODAY         : DATE := (MONTH => AUG,
-                               DAY   => 8,
-                               YEAR  => 1990) ;
-                             
-      FIRST_DATE     : DATE := (DAY   => 6,
-                                MONTH => JUN,
-                                YEAR  => 1967) ;
-      
-      SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
-                             
-      TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
-                                       FIRST_HALF,
-                                       FIRST_FIVE) OF DATE ;
-                             
-      GENERIC
-     
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE THIRD_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           DEFAULT_VALUE : IN COMPONENT_TYPE ;
-           TYPE CUBE IS ARRAY (FIRST_INDEX, 
-                               SECOND_INDEX,
-                               THIRD_INDEX) OF COMPONENT_TYPE ;
-           WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
-                                                 (CUBE'RANGE (2) =>
-                                                 (CUBE'RANGE (3) =>
-                                                      DEFAULT_VALUE))))
-                         RETURN CUBE ;
-                         
-      PROCEDURE PROC_WITH_3D_FUNC ;
-     
-      PROCEDURE PROC_WITH_3D_FUNC IS
-     
-      BEGIN  -- PROC_WITH_3D_FUNC
-     
-           IF FUN /= CUBE'(CUBE'RANGE =>
-                          (CUBE'RANGE (2) =>
-                          (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
-                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
-                               "ARRAY, FUNCTION, AND PROCEDURE.") ;
-           END IF ;
-         
-      END PROC_WITH_3D_FUNC ;
-     
-      GENERIC
-     
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE THIRD_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           DEFAULT_VALUE : IN COMPONENT_TYPE ;
-           TYPE CUBE IS ARRAY (FIRST_INDEX, 
-                               SECOND_INDEX,
-                               THIRD_INDEX) OF COMPONENT_TYPE ;
-           WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
-                                                 (CUBE'RANGE (2) =>
-                                                 (CUBE'RANGE (3) =>
-                                                      DEFAULT_VALUE))))
-                         RETURN CUBE ;
-                         
-      PACKAGE PKG_WITH_3D_FUNC IS
-      END PKG_WITH_3D_FUNC ;
-     
-      PACKAGE BODY PKG_WITH_3D_FUNC IS
-      BEGIN  -- PKG_WITH_3D_FUNC
- 
-           REPORT.TEST("CC1311A","CHECK THAT THE DEFAULT EXPRESSIONS " &
-                       "OF THE PARAMETERS OF A FORMAL SUBPROGRAM ARE " &
-                       "USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE " &
-                       "ACTUAL SUBPROGRAM PARAMETER" ) ;
-     
-           IF FUN /= CUBE'(CUBE'RANGE =>
-                          (CUBE'RANGE (2) =>
-                          (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
-                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
-                               "ARRAY, FUNCTION, AND PACKAGE.") ;
-           END IF ;
-         
-      END PKG_WITH_3D_FUNC ;
-     
-      GENERIC
-     
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE THIRD_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           DEFAULT_VALUE : IN COMPONENT_TYPE ;
-           TYPE CUBE IS ARRAY (FIRST_INDEX, 
-                               SECOND_INDEX,
-                               THIRD_INDEX) OF COMPONENT_TYPE ;
-           WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
-                                                 (CUBE'RANGE (2) =>
-                                                 (CUBE'RANGE (3) =>
-                                                      DEFAULT_VALUE))))
-                         RETURN CUBE ;
-                         
-      FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN ;
-     
-      FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN IS
-      BEGIN  -- FUNC_WITH_3D_FUNC
-      
-           RETURN FUN = CUBE'(CUBE'RANGE =>
-                             (CUBE'RANGE (2) =>
-                             (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
-                        
-      END FUNC_WITH_3D_FUNC ;
-     
-      GENERIC
-     
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE THIRD_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           DEFAULT_VALUE : IN COMPONENT_TYPE ;
-           TYPE CUBE IS ARRAY (FIRST_INDEX, 
-                               SECOND_INDEX,
-                               THIRD_INDEX) OF COMPONENT_TYPE ;
-           WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
-                                                     (CUBE'RANGE (2) =>
-                                                     (CUBE'RANGE (3) =>
-                                                      DEFAULT_VALUE))) ;
-                                OUTPUT : OUT CUBE) ;
-                         
-      PROCEDURE PROC_WITH_3D_PROC ;
-     
-      PROCEDURE PROC_WITH_3D_PROC IS
-     
-           RESULTS : CUBE ;
-         
-      BEGIN  -- PROC_WITH_3D_PROC
-     
-           PROC (OUTPUT => RESULTS) ;
-         
-           IF RESULTS /= CUBE'(CUBE'RANGE =>
-                              (CUBE'RANGE (2) =>
-                              (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
-                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
-                               "ARRAY, PROCEDURE, AND PROCEDURE.") ;
-           END IF ;
-         
-      END PROC_WITH_3D_PROC ;
- 
-      GENERIC
-     
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE THIRD_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           DEFAULT_VALUE : IN COMPONENT_TYPE ;
-           TYPE CUBE IS ARRAY (FIRST_INDEX, 
-                               SECOND_INDEX,
-                               THIRD_INDEX) OF COMPONENT_TYPE ;
-           WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
-                                                     (CUBE'RANGE (2) =>
-                                                     (CUBE'RANGE (3) =>
-                                                      DEFAULT_VALUE))) ;
-                                OUTPUT : OUT CUBE) ;
-                         
-      PACKAGE PKG_WITH_3D_PROC IS
-      END PKG_WITH_3D_PROC ;
-     
-      PACKAGE BODY PKG_WITH_3D_PROC IS
-     
-           RESULTS : CUBE ;
-         
-      BEGIN  -- PKG_WITH_3D_PROC
-     
-           PROC (OUTPUT => RESULTS) ;
-         
-           IF RESULTS /= CUBE'(CUBE'RANGE =>
-                              (CUBE'RANGE (2) =>
-                              (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
-                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
-                               "ARRAY, PROCEDURE, AND PACKAGE.") ;
-           END IF ;
-         
-      END PKG_WITH_3D_PROC ;
-     
-      GENERIC
-     
-           TYPE FIRST_INDEX IS (<>) ;
-           TYPE SECOND_INDEX IS (<>) ;
-           TYPE THIRD_INDEX IS (<>) ;
-           TYPE COMPONENT_TYPE IS PRIVATE ;
-           DEFAULT_VALUE : IN COMPONENT_TYPE ;
-           TYPE CUBE IS ARRAY (FIRST_INDEX, 
-                               SECOND_INDEX,
-                               THIRD_INDEX) OF COMPONENT_TYPE ;
-           WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
-                                                     (CUBE'RANGE (2) =>
-                                                     (CUBE'RANGE (3) =>
-                                                      DEFAULT_VALUE))) ;
-                                OUTPUT : OUT CUBE) ;
-                         
-      FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN ;
-     
-      FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN IS
-     
-           RESULTS : CUBE ;
-         
-      BEGIN  -- FUNC_WITH_3D_PROC
-     
-           PROC (OUTPUT => RESULTS) ;
-           RETURN RESULTS = CUBE'(CUBE'RANGE =>
-                                 (CUBE'RANGE (2) =>
-                                 (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
-                          
-      END FUNC_WITH_3D_PROC ;
-     
-      GENERIC
-           TYPE T IS (<>);
-           WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
-      FUNCTION FUNC1 RETURN BOOLEAN;
- 
-      FUNCTION FUNC1 RETURN BOOLEAN IS
-      BEGIN  -- FUNC1
-          RETURN F = T'VAL (0);
-      END FUNC1;
- 
-      GENERIC
-           TYPE T IS (<>);
-           WITH FUNCTION F (X : T := T'VAL (REPORT.IDENT_INT(0)))
-                         RETURN T;
-      PACKAGE PKG1 IS END PKG1;
- 
-      PACKAGE BODY PKG1 IS
-      BEGIN  -- PKG1
-           IF F /= T'VAL (0) THEN
-                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
-                               "FUNCTION 'F' AND PACKAGE 'PKG1'" );
-           END IF;
-      END PKG1;
-      GENERIC
-           TYPE T IS (<>);
-           WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
-      PROCEDURE PROC1;
- 
-      PROCEDURE PROC1 IS
-      BEGIN  -- PROC1
-           IF F /= T'VAL (0) THEN
-                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
-                               "FUNCTION 'F' AND PROCEDURE 'PROC1'" );
-           END IF;
-      END PROC1;
- 
-      GENERIC
-           TYPE T IS (<>);
-           WITH PROCEDURE P (RESULTS : OUT T ; 
-                             X       : T := T'VAL (0)) ;
-      FUNCTION FUNC2 RETURN BOOLEAN;
- 
-      FUNCTION FUNC2 RETURN BOOLEAN IS
-           RESULTS : T;
-      BEGIN  -- FUNC2
-           P (RESULTS);
-           RETURN RESULTS = T'VAL (0);
-      END FUNC2;
- 
-      GENERIC
-           TYPE T IS (<>);
-           WITH PROCEDURE P (RESULTS : OUT T;
-                             X       : T := T'VAL(REPORT.IDENT_INT(0)));
-      PACKAGE PKG2 IS END PKG2 ;
- 
-      PACKAGE BODY PKG2 IS
-           RESULTS : T;
-      BEGIN  -- PKG2
-           P (RESULTS);
-           IF RESULTS /= T'VAL (0) THEN
-                 REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
-                                "PROCEDURE 'P' AND PACKAGE 'PKG2'" );
-           END IF;
-      END PKG2;
- 
-      GENERIC
-           TYPE T IS (<>);
-           WITH PROCEDURE P (RESULTS :OUT T; X : T := T'VAL (0));
-      PROCEDURE PROC2;
- 
-      PROCEDURE PROC2 IS
-           RESULTS : T;
-      BEGIN  -- PROC2
-           P (RESULTS);
-           IF RESULTS /= T'VAL (0) THEN
-                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
-                              "PROCEDURE 'P' AND PROCEDURE 'PROC2'" );
-           END IF;
-      END PROC2;
- 
-      FUNCTION F1 (A : NUMBERS := ONE) RETURN NUMBERS IS
-      BEGIN  -- F1
-           RETURN A;
-      END;
- 
-      PROCEDURE P2 (OUTVAR : OUT NUMBERS; INVAR : NUMBERS := TWO) IS
-      BEGIN  -- P2
-           OUTVAR := INVAR;
-      END;
- 
-      FUNCTION TD_FUNC (FIRST : IN THREE_DIMENSIONAL :=
-                                        (THREE_DIMENSIONAL'RANGE =>
-                                        (THREE_DIMENSIONAL'RANGE (2) =>
-                                        (THREE_DIMENSIONAL'RANGE (3) =>
-                                             FIRST_DATE))))
-               RETURN THREE_DIMENSIONAL IS 
-                 
-      BEGIN  -- TD_FUNC
-     
-           RETURN FIRST ;
-         
-      END TD_FUNC ;
-     
-      PROCEDURE TD_PROC (INPUT  : IN  THREE_DIMENSIONAL := 
-                                         (THREE_DIMENSIONAL'RANGE =>
-                                         (THREE_DIMENSIONAL'RANGE (2) =>
-                                         (THREE_DIMENSIONAL'RANGE (3) =>
-                                              FIRST_DATE))) ;
-                         OUTPUT : OUT THREE_DIMENSIONAL) IS
-      BEGIN  -- TD_PROC
-     
-           OUTPUT := INPUT ;
-         
-      END TD_PROC ;
-     
-      PROCEDURE NEW_PROC_WITH_3D_FUNC IS NEW 
-           PROC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
-                              SECOND_INDEX   => FIRST_HALF,
-                              THIRD_INDEX    => FIRST_FIVE,
-                              COMPONENT_TYPE => DATE,
-                              DEFAULT_VALUE  => TODAY,
-                              CUBE           => THREE_DIMENSIONAL,
-                              FUN            => TD_FUNC) ;
- 
-      PACKAGE NEW_PKG_WITH_3D_FUNC IS NEW 
-           PKG_WITH_3D_FUNC (FIRST_INDEX     => REALLY_SHORT,
-                             SECOND_INDEX    => FIRST_HALF,
-                             THIRD_INDEX     => FIRST_FIVE,
-                             COMPONENT_TYPE  => DATE,
-                             DEFAULT_VALUE   => TODAY,
-                             CUBE            => THREE_DIMENSIONAL,
-                             FUN             => TD_FUNC) ;
- 
-       FUNCTION NEW_FUNC_WITH_3D_FUNC IS NEW 
-           FUNC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
-                              SECOND_INDEX   => FIRST_HALF,
-                              THIRD_INDEX    => FIRST_FIVE,
-                              COMPONENT_TYPE => DATE,
-                              DEFAULT_VALUE  => TODAY,
-                              CUBE           => THREE_DIMENSIONAL,
-                              FUN            => TD_FUNC) ;
- 
-      PROCEDURE NEW_PROC_WITH_3D_PROC IS NEW 
-           PROC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
-                              SECOND_INDEX   => FIRST_HALF,
-                              THIRD_INDEX    => FIRST_FIVE,
-                              COMPONENT_TYPE => DATE,
-                              DEFAULT_VALUE  => TODAY,
-                              CUBE           => THREE_DIMENSIONAL,
-                              PROC           => TD_PROC) ;
- 
-      PACKAGE NEW_PKG_WITH_3D_PROC IS NEW 
-           PKG_WITH_3D_PROC (FIRST_INDEX     => REALLY_SHORT,
-                             SECOND_INDEX   => FIRST_HALF,
-                             THIRD_INDEX    => FIRST_FIVE,
-                             COMPONENT_TYPE => DATE,
-                             DEFAULT_VALUE  => TODAY,
-                             CUBE           => THREE_DIMENSIONAL,
-                             PROC           => TD_PROC) ;
- 
-      FUNCTION NEW_FUNC_WITH_3D_PROC IS NEW 
-           FUNC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
-                              SECOND_INDEX   => FIRST_HALF,
-                              THIRD_INDEX    => FIRST_FIVE,
-                              COMPONENT_TYPE => DATE,
-                              DEFAULT_VALUE  => TODAY,
-                              CUBE           => THREE_DIMENSIONAL,
-                              PROC           => TD_PROC) ;
- 
-      FUNCTION  NFUNC1 IS NEW FUNC1 (NUMBERS, F1);
-      PACKAGE   NPKG1  IS NEW PKG1  (NUMBERS, F1);
-      PROCEDURE NPROC1 IS NEW PROC1 (NUMBERS, F1);
- 
-      FUNCTION  NFUNC2 IS NEW FUNC2 (NUMBERS, P2);
-      PACKAGE   NPKG2  IS NEW PKG2  (NUMBERS, P2);
-      PROCEDURE NPROC2 IS NEW PROC2 (NUMBERS, P2);
- 
- BEGIN  -- CC1311A
- 
-      IF NOT NFUNC1 THEN
-           REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
-                          "WITH FUNCTION 'NFUNC1'" ) ;
-      END IF ;
- 
-      IF NOT NFUNC2 THEN
-           REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
-                          "WITH FUNCTION 'NFUNC2'" ) ;
-      END IF ;
- 
-      NPROC1 ;
-      NPROC2 ;
-     
-      NEW_PROC_WITH_3D_FUNC ;
-     
-      IF NOT NEW_FUNC_WITH_3D_FUNC THEN
-           REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
-                          "FUNCTION, AND FUNCTION.") ;
-      END IF ;
-     
-      NEW_PROC_WITH_3D_PROC ;
-     
-      IF NOT NEW_FUNC_WITH_3D_PROC THEN
-           REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
-                          "FUNCTION, AND PROCEDURE.") ;
-      END IF ;
-         
-      REPORT.RESULT ;
- 
- END CC1311A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1311b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1311b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc1311b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc1311b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,332 ****
- -- CC1311B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF PARAMETERS OF DEFAULT AND FORMAL SUBPROGRAMS HAVE
- --     THE SAME TYPE BUT NOT THE SAME SUBTYPE, THE PARAMETER SUBTYPES OF
- --     THE SUBPROGRAM DENOTED BY THE DEFAULT ARE USED INSTEAD OF
- --     SUBTYPES SPECIFIED IN THE FORMAL SUBPROGRAM DECLARATION.
- 
- -- HISTORY:
- --     RJW 06/11/86 CREATED ORIGINAL TEST.
- --     DHH 10/20/86 CORRECTED RANGE ERRORS.
- --     PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
- --     PWN 10/27/95 REMOVED CHECKS AGAINST ARRAY SLIDING RULES THAT
- --                  HAVE BEEN RELAXED.
- --     PWN 10/25/96 RESTORED CHECKS WITH NEW ADA 95 EXPECTED RESULTS.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC1311B IS
- 
- BEGIN
-      TEST ("CC1311B", "CHECK THAT IF PARAMETERS OF DEFAULT AND " &
-                       "FORMAL SUBPROGRAMS HAVE THE SAME TYPE BUT " &
-                       "NOT THE SAME SUBTYPE, THE PARAMETER SUBTYPES " &
-                       "OF THE SUBPROGRAM DENOTED BY THE DEFAULT ARE " &
-                       "USED INSTEAD OF SUBTYPES SPECIFIED IN THE " &
-                       "FORMAL SUBPROGRAM DECLARATION" );
- 
-      DECLARE
-           TYPE NUMBERS IS (ZERO, ONE ,TWO);
-           SUBTYPE ZERO_TWO IS NUMBERS;
-           SUBTYPE ZERO_ONE IS NUMBERS RANGE ZERO .. ONE;
- 
-           FUNCTION FSUB (X : ZERO_ONE) RETURN ZERO_ONE IS
-           BEGIN
-                RETURN NUMBERS'VAL (IDENT_INT (NUMBERS'POS (ONE)));
-           END FSUB;
- 
-           GENERIC
-                WITH FUNCTION F (X : ZERO_TWO := TWO) RETURN ZERO_TWO
-                     IS FSUB;
-           FUNCTION FUNC  RETURN ZERO_TWO;
- 
-           FUNCTION FUNC RETURN ZERO_TWO IS
-           BEGIN
-                RETURN F;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     RETURN ZERO;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
-                              "NFUNC1" );
-                     RETURN ZERO;
-           END FUNC;
- 
-           FUNCTION NFUNC1 IS NEW FUNC;
- 
-      BEGIN
-           IF NFUNC1 = ONE THEN
-                FAILED ( "NO EXCEPTION RAISED WITH NFUNC1" );
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE GENDER IS (MALE, FEMALE);
- 
-           TYPE PERSON (SEX : GENDER) IS
-                RECORD
-                    CASE SEX IS
-                          WHEN MALE =>
-                               BEARDED : BOOLEAN;
-                          WHEN FEMALE =>
-                               CHILDREN : INTEGER;
-                     END CASE;
-                END RECORD;
- 
-           SUBTYPE MAN IS PERSON (SEX => MALE);
-           SUBTYPE TESTWRITER IS PERSON (FEMALE);
- 
-           ROSA : TESTWRITER := (FEMALE, 4);
- 
-           FUNCTION F (X : MAN) RETURN PERSON IS
-                TOM : PERSON (MALE) := (MALE, FALSE);
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RETURN X;
-                ELSE
-                     RETURN TOM;
-                END IF;
-           END F;
- 
-           GENERIC
-                TYPE T IS PRIVATE;
-                X1 : T;
-                WITH FUNCTION F (X : T) RETURN T IS <> ;
-           PACKAGE PKG IS END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                IF F(X1) = X1 THEN
-                     FAILED ( "NO EXCEPTION RAISED WITH " &
-                              "FUNCTION 'F' AND PACKAGE " &
-                              "'PKG' - 1" );
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED WITH " &
-                              "FUNCTION 'F' AND PACKAGE " &
-                              "'PKG' - 2" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
-                              "FUNCTION 'F' AND PACKAGE 'PKG'" );
-           END PKG;
- 
-           PACKAGE NPKG IS NEW PKG (TESTWRITER, ROSA);
- 
-      BEGIN
-           COMMENT ( "PACKAGE BODY ELABORATED - 1" );
-      END;
- 
-      DECLARE
-           TYPE VECTOR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           SUBTYPE SUBV1 IS VECTOR (1 .. 5);
-           SUBTYPE SUBV2 IS VECTOR (2 .. 6);
- 
-           V1 : SUBV1 := (1, 2, 3, 4, 5);
- 
-           FUNCTION FSUB (Y : SUBV2) RETURN VECTOR IS
-                Z : SUBV2;
-           BEGIN
-                FOR I IN Y'RANGE LOOP
-                     Z (I) := IDENT_INT (Y (I));
-                END LOOP;
-                RETURN Z;
-           END;
- 
-           GENERIC
-            WITH FUNCTION F (X : SUBV1 := V1) RETURN SUBV1 IS FSUB;
-           PROCEDURE PROC;
- 
-           PROCEDURE PROC IS
-           BEGIN
-                IF F = V1 THEN
-                     COMMENT ( "NO EXCEPTION RAISED WITH " &
-                               "FUNCTION 'F' AND PROCEDURE " &
-                               "'PROC' - 1" );
-                ELSE
-                     COMMENT ( "NO EXCEPTION RAISED WITH " &
-                               "FUNCTION 'F' AND PROCEDURE " &
-                               "'PROC' - 2" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
-                              "FUNCTION 'F' AND PROCEDURE " &
-                              "'PROC'" );
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
-                              "FUNCTION 'F' AND PROCEDURE " &
-                              "'PROC'" );
-           END PROC;
- 
-           PROCEDURE NPROC IS NEW PROC;
-      BEGIN
-           NPROC;
-      END;
- 
-      DECLARE
- 
-           TYPE ACC IS ACCESS STRING;
- 
-           SUBTYPE INDEX1 IS INTEGER RANGE 1 .. 5;
-           SUBTYPE INDEX2 IS INTEGER RANGE 2 .. 6;
- 
-           SUBTYPE ACC1 IS ACC (INDEX1);
-           SUBTYPE ACC2 IS ACC (INDEX2);
- 
-           AC2 : ACC2 := NEW STRING'(2 .. 6 => 'A');
-           AC  : ACC;
- 
-           PROCEDURE P (RESULTS : OUT ACC1; X : ACC1) IS
-           BEGIN
-                RESULTS := NULL;
-           END P;
- 
-           GENERIC
-            WITH PROCEDURE P1 (RESULTS : OUT ACC2; X : ACC2 := AC2)
-                     IS P;
-           FUNCTION FUNC RETURN ACC;
- 
-           FUNCTION FUNC RETURN ACC IS
-                RESULTS : ACC;
-           BEGIN
-                P1 (RESULTS);
-                RETURN RESULTS;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     RETURN NEW STRING'("ABCDE");
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
-                              "NFUNC2" );
-                     RETURN NULL;
-           END FUNC;
- 
-           FUNCTION NFUNC2 IS NEW FUNC;
- 
-      BEGIN
-           AC := NFUNC2;
-           IF AC = NULL OR ELSE AC.ALL /= "ABCDE" THEN
-             FAILED ( "NO OR WRONG EXCEPTION RAISED WITH NFUNC2" );
-           END IF;
-      END;
- 
-      DECLARE
-           SUBTYPE FLOAT1 IS FLOAT RANGE -1.0 .. 0.0;
-           SUBTYPE FLOAT2 IS FLOAT RANGE  0.0 .. 1.0;
- 
-           PROCEDURE PSUB (RESULTS : OUT FLOAT2; X : FLOAT2) IS
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RESULTS := X;
-                ELSE
-                     RESULTS := 0.0;
-                END IF;
-           END PSUB;
- 
-           GENERIC
-                WITH PROCEDURE P (RESULTS : OUT FLOAT1;
-                                  X : FLOAT1 := -0.0625) IS PSUB;
-           PACKAGE PKG IS END PKG;
- 
-           PACKAGE BODY PKG IS
-                RESULTS : FLOAT1;
-           BEGIN
-                P (RESULTS);
-                IF RESULTS = 1.0 THEN
-                     FAILED ( "NO EXCEPTION RAISED WITH " &
-                              "PROCEDURE 'P' AND PACKAGE " &
-                              "'PKG' - 1" );
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED WITH " &
-                              "PROCEDURE 'P' AND PACKAGE " &
-                              "'PKG' - 2" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
-                              "PROCEDURE 'P' AND PACKAGE 'PKG'" );
-           END PKG;
- 
-           PACKAGE NPKG IS NEW PKG;
-      BEGIN
-           COMMENT ( "PACKAGE BODY ELABORATED - 2" );
-      END;
- 
-      DECLARE
-           TYPE FIXED IS DELTA 0.125 RANGE -1.0 .. 1.0;
-           SUBTYPE FIXED1 IS FIXED RANGE -0.5 .. 0.0;
-           SUBTYPE FIXED2 IS FIXED RANGE  0.0 .. 0.5;
- 
-           PROCEDURE P (RESULTS : OUT FIXED1; X : FIXED1) IS
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RESULTS := X;
-                ELSE
-                     RESULTS := X;
-                END IF;
-           END P;
- 
-           GENERIC
-                TYPE F IS DELTA <>;
-                F1 : F;
-                WITH PROCEDURE P (RESULTS : OUT F; X : F) IS <> ;
-           PROCEDURE PROC;
- 
-           PROCEDURE PROC IS
-                RESULTS : F;
-           BEGIN
-                P (RESULTS, F1);
-                IF RESULTS = 0.0 THEN
-                     FAILED ( "NO EXCEPTION RAISED WITH " &
-                              "PROCEDURE 'P' AND PROCEDURE " &
-                              "'PROC' - 1" );
-                ELSE
-                     FAILED ( "NO EXCEPTION RAISED WITH " &
-                              "PROCEDURE 'P' AND PROCEDURE " &
-                              "'PROC' - 2" );
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
-                              "PROCEDURE 'P' AND PROCEDURE " &
-                              "'PROC'" );
-           END PROC;
- 
-           PROCEDURE NPROC IS NEW PROC (FIXED2, 0.125);
- 
-      BEGIN
-           NPROC;
-      END;
- 
-      RESULT;
- 
- END CC1311B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc2002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc2002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc2002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc2002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CC2002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE ELABORATION OF A GENERIC BODY HAS NO EFFECT OTHER
- -- THAN TO ESTABLISH THE TEMPLATE BODY TO BE USED FOR THE
- -- CORRESPONDING INSTANTIATIONS.
- 
- -- ASL 09/02/81
- -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
- -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC2002A IS
- 
-      GLOBAL : INTEGER := 0;
-      Q : INTEGER RANGE 1..1 := 1;
- BEGIN
-      TEST ("CC2002A","NO SIDE EFFECTS OF ELABORATION OF GENERIC BODY");
- 
-      BEGIN
-           DECLARE
-                GENERIC
-                     PACKAGE P IS
-                     END P;
- 
-                GENERIC PROCEDURE PROC;
- 
-                     PROCEDURE PROC IS
-                          C : CONSTANT INTEGER RANGE 1 .. 1 := 2;
-                     BEGIN
-                          RAISE PROGRAM_ERROR;
-                     END PROC;
- 
-                     PACKAGE BODY P IS
-                          C : CONSTANT BOOLEAN := 
-                               BOOLEAN'SUCC(IDENT_BOOL(TRUE));
-                     BEGIN
-                          GLOBAL := 1;
-                          Q := Q + 1;
-                     END P;
-           BEGIN
-                NULL;
-           END;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED DURING ELABORATION OF " &
-                        "GENERIC BODY");
-      END;
- 
-      IF GLOBAL /= 0 THEN
-           FAILED ("VALUE OF GLOBAL VARIABLE CHANGED BY ELABORATION " &
-                   "OF GENERIC BODY");
-      END IF;
- 
-      RESULT;
- END CC2002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc30001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc30001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc30001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc30001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,219 ****
- -- CC30001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if a non-overriding primitive subprogram is declared for
- --      a type derived from a formal derived tagged type, the copy of that
- --      subprogram in an instance can override a subprogram inherited from the
- --      actual type.
- --
- -- TEST DESCRIPTION:
- --      User writes program to handle both mail messages and system messages.
- --
- --      Mail messages are created by instantiating a generic "mail" package
- --      with a root message type. System messages are created by
- --      instantiating the generic with a system message type derived from the
- --      root in a separate package. The system message type has a primitive
- --      subprogram called Send.
- --
- --      Inside the generic, a "mail" type is derived from the generic formal
- --      derived type, and a "Send" operation is declared.
- --
- --      Declare a root tagged type T. Declare a generic package with a formal
- --      derived type using the root tagged type as ancestor. In the generic,
- --      derive a type from the formal derived type and declare a primitive
- --      subprogram for it. In a separate package, declare a derivative DT of
- --      the root tagged type T and declare a primitive subprogram which is
- --      type conformant with (and hence, overridable for) the primitive
- --      declared in the generic. Instantiate the generic for DT. Make both
- --      dispatching and non-dispatching calls to the primitive subprogram. In
- --      both cases the version of the subprogram in the instance should be
- --      called (since it overrides the implementation inherited from the
- --      actual).
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      13 Apr 95   SAIC    Replaced call involving instance for root tagged
- --                          type with a dispatching call involving instance
- --                          for derived type. Updated commentary. Moved
- --                          instantiations (and related commentary) to
- --                          library-level to avoid accessibility violation.
- --                          Commented out instantiation for root tagged type.
- --      27 Feb 97   PWB.CTA Added elaboration pragma.
- --!
- 
- package CC30001_0 is  -- Root message type.
- 
-    type Msg_Type is tagged record
-       Text         : String (1 .. 20);
-       Message_Sent : Boolean;
-    end record;
- 
- end CC30001_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC30001_0;  -- Root message type.
- generic          -- Generic "mail" package.
-    type Message is new CC30001_0.Msg_Type with private;
- package CC30001_1 is
- 
-    type Mail_Type is new Message with record   -- Derived from formal type.
-       To : String (1 .. 8);
-    end record;
- 
-    procedure Send (M : in out Mail_Type);      -- For this test, this version
-                                                -- of Send should be called in
-    -- ... Other operations.                    -- all cases.
- 
- end CC30001_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC30001_1 is
- 
-    procedure Send (M : in out Mail_Type) is
-    begin
-       -- ... Code to send message omitted for brevity.
-       M.Message_Sent := True;
-    end Send;
- 
- end CC30001_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC30001_0;       -- Root message type.
- package CC30001_2 is  -- System message type and operations.
- 
-    type Signal_Type is (Note, Warning, Error);
- 
-    type Sys_Message is new CC30001_0.Msg_Type with record   -- Derived from
-       Signal : Signal_Type := Warning;                      -- root type.
-    end record;
- 
-    procedure Send (Item : in out Sys_Message); -- For this test, this version
-                                                -- of Send should never be
-    -- ... Other operations.                    -- called (it will have been
-                                                -- overridden).
- end CC30001_2;
- 
- 
-      --==================================================================--
- 
- 
- package body CC30001_2 is
- 
-    procedure Send (Item : in out Sys_Message) is
-    begin
-       -- ... Code to send message omitted for brevity.
-       Item.Message_Sent := False;  -- Ensure this procedure gives a different
-    end Send;                       -- result than CC30001_1.Send.
- 
- end CC30001_2;
- 
- 
-      --==================================================================--
- 
- 
- -- User first sets up support for mail messages by instantiating the
- -- generic mail package for the root message type. An operation "Send" is
- -- declared for the mail message type in the instance.
- --
- -- with CC30001_0;  -- Root message type.
- -- with CC30001_1;  -- Generic "mail" package.
- -- package Mail_Messages is new CC30001_1 (CC30001_0.Msg_Type);
- 
- 
-      --==================================================================--
- 
- 
- -- Next, the user sets up support for system messages by instantiating the
- -- generic mail package with the system message type. An operation "Send"
- -- is declared for the "system" mail message type in the instance. This
- -- operation overrides the "Send" operation inherited from the system
- -- message type actual (a situation the user may not have intended).
- 
- with CC30001_1;  -- Generic "mail" package.
- with CC30001_2;  -- System message type and operations.
- pragma Elaborate (CC30001_1);
- package CC30001_3 is new CC30001_1 (CC30001_2.Sys_Message);
- 
- 
-      --==================================================================--
- 
- with CC30001_2;  -- System message type and operations.
- with CC30001_3;  -- Instance with mail type and operations.
- 
- with Report;
- procedure CC30001 is
- 
-    package System_Messages renames CC30001_3;
- 
- 
-    Sys_Msg1 : System_Messages.Mail_Type := (Text   => "System shutting down",
-                                             Signal => CC30001_2.Warning,
-                                             To     => "AllUsers",
-                                             Message_Sent => False);
- 
-    Sys_Msg2 : System_Messages.Mail_Type'Class := Sys_Msg1;
- 
- 
-    use System_Messages, CC30001_2;                 -- All versions of "Send"
-                                                    -- directly visible.
- 
- begin
- 
-    Report.Test ("CC30001", "Check that if a non-overriding primitive "     &
-                 "subprogram is declared for a type derived from a formal " &
-                 "derived tagged type, the copy of that subprogram in an "  &
-                 "instance can override a subprogram inherited from the "   &
-                 "actual type");
- 
- 
-    Send (Sys_Msg1);   -- Calls version declared in instance (version declared
-                       -- in CC30001_2 has been overridden).
- 
-    if not Sys_Msg1.Message_Sent then
-       Report.Failed ("Non-dispatching call: instance operation not called");
-    end if;
- 
- 
-    Send (Sys_Msg2);   -- Calls version declared in instance (version declared
-                       -- in CC30001_2 has been overridden).
- 
-    if not Sys_Msg2.Message_Sent then
-       Report.Failed ("Dispatching call: instance operation not called");
-    end if;
- 
- 
-    Report.Result;
- end CC30001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc30002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc30002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc30002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc30002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,349 ****
- -- CC30002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an explicit declaration in the private part of an instance
- --      does not override an implicit declaration in the instance, unless the
- --	corresponding explicit declaration in the generic overrides a
- --      corresponding implicit declaration in the generic. Check for primitive
- --      subprograms of tagged types.
- --
- -- TEST DESCRIPTION:
- --      Consider the following:
- --
- --         type Ancestor is tagged null record;
- --         procedure R (X: in Ancestor);
- --
- --         generic
- --            type Formal is new Ancestor with private;
- --         package G is
- --            type T is new Formal with null record;
- --            -- Implicit procedure R (X: in T);
- --            procedure P (X: in T);  -- (1)
- --         private
- --            procedure Q (X: in T);  -- (2)
- --            procedure R (X: in T);  -- (3) Overrides implicit R in generic.
- --         end G;
- --
- --         type Actual is new Ancestor with null record;
- --         procedure P (X: in Actual);
- --         procedure Q (X: in Actual);
- --         procedure R (X: in Actual);
- --
- --         package Instance is new G (Formal => Actual);
- --
- --      In the instance, the copy of P at (1) overrides Actual's P, since it
- --      is declared in the visible part of the instance. The copy of Q at (2)
- --      does not override anything. The copy of R at (3) overrides Actual's
- --      R, even though it is declared in the private part, because within
- --      the generic the explicit declaration of R overrides an implicit
- --      declaration.
- --
- --      Thus, for calls involving a parameter with tag T:
- --         - Calls to P will execute the body declared for T.
- --         - Calls to Q from within Instance will execute the body declared
- --           for T.
- --         - Calls to Q from outside Instance will execute the body declared
- --           for Actual.
- --         - Calls to R will execute the body declared for T.
- --
- --      Verify this behavior for both dispatching and nondispatching calls to
- --      Q and R. 
- --
- --
- -- CHANGE HISTORY:
- --      24 Feb 95   SAIC    Initial prerelease version.
- --
- --!
- 
- package CC30002_0 is
- 
-    type TC_Body_Kind is (Body_Of_Ancestor, Body_In_Instance,
-                          Body_Of_Actual,   Initial_Value);
- 
-    type Camera is tagged record
-       -- ... Camera components.
-       TC_Focus_Called   : TC_Body_Kind := Initial_Value;
-       TC_Shutter_Called : TC_Body_Kind := Initial_Value;
-    end record;
- 
-    procedure Focus (C: in out Camera);
- 
-    -- ...Other operations.
- 
- end CC30002_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC30002_0 is
- 
-    procedure Focus (C: in out Camera) is
-    begin
-       -- Artificial for testing purposes.
-       C.TC_Focus_Called := Body_Of_Ancestor;
-    end Focus;
- 
- end CC30002_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC30002_0;
- use  CC30002_0;
- generic
-    type Camera_Type is new CC30002_0.Camera with private;
- package CC30002_1 is
- 
-    type Speed_Camera is new Camera_Type with record
-       Diag_Code: Positive;
-       -- ...Other components.
-    end record;
- 
-    -- Implicit procedure Focus (C: in out Speed_Camera) declared in generic.
-    procedure Self_Test_NonDisp (C: in out Speed_Camera);
-    procedure Self_Test_Disp    (C: in out Speed_Camera'Class);
- 
- private
- 
-    -- The following explicit declaration of Set_Shutter_Speed does NOT override
-    -- a corresponding implicit declaration in the generic. Therefore, its copy
-    -- does NOT override the implicit declaration (inherited from the actual)
-    -- in the instance.
- 
-    procedure Set_Shutter_Speed (C: in out Speed_Camera);
- 
-    -- The following explicit declaration of Focus DOES override a
-    -- corresponding implicit declaration (inherited from the parent) in the
-    -- generic. Therefore, its copy overrides the implicit declaration
-    -- (inherited from the actual) in the instance.
- 
-    procedure Focus (C: in out Speed_Camera);  -- Overrides implicit Focus
-                                               -- in generic.
- end CC30002_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC30002_1 is
- 
-    procedure Self_Test_NonDisp (C: in out Speed_Camera) is
-    begin
-       -- Nondispatching calls:
-       Focus (C);
-       Set_Shutter_Speed (C);
-    end Self_Test_NonDisp;
- 
-    procedure Self_Test_Disp (C: in out Speed_Camera'Class) is
-    begin
-       -- Dispatching calls:
-       Focus (C);
-       Set_Shutter_Speed (C);
-    end Self_Test_Disp;
- 
-    procedure Set_Shutter_Speed (C: in out Speed_Camera) is
-    begin
-       -- Artificial for testing purposes.
-       C.TC_Shutter_Called := Body_In_Instance;
-    end Set_Shutter_Speed;
- 
-    procedure Focus (C: in out Speed_Camera) is
-    begin
-       -- Artificial for testing purposes.
-       C.TC_Focus_Called := Body_In_Instance;
-    end Focus;
- 
- end CC30002_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC30002_0;
- package CC30002_2 is
- 
-    type Aperture_Camera is new CC30002_0.Camera with record
-       FStop: Natural;
-       -- ...Other components.
-    end record;
- 
-    procedure Set_Shutter_Speed (C: in out Aperture_Camera);
-    procedure Focus (C: in out Aperture_Camera);
- 
- end CC30002_2;
- 
- 
-      --==================================================================--
- 
- 
- package body CC30002_2 is
- 
-    procedure Set_Shutter_Speed (C: in out Aperture_Camera) is
-       use CC30002_0;
-    begin
-       -- Artificial for testing purposes.
-       C.TC_Shutter_Called := Body_Of_Actual;
-    end Set_Shutter_Speed;
- 
-    procedure Focus (C: in out Aperture_Camera) is
-       use CC30002_0;
-    begin
-       -- Artificial for testing purposes.
-       C.TC_Focus_Called := Body_Of_Actual;
-    end Focus;
- 
- end CC30002_2;
- 
- 
-      --==================================================================--
- 
- 
- -- Instance declaration.
- 
- with CC30002_1;
- with CC30002_2;
- package CC30002_3 is new CC30002_1 (Camera_Type => CC30002_2.Aperture_Camera);
- 
- 
-      --==================================================================--
- 
- 
- with CC30002_0;
- with CC30002_1;
- with CC30002_2;
- with CC30002_3; -- Instance.
- 
- with Report;
- procedure CC30002 is
- 
-    package Speed_Cameras renames CC30002_3;
- 
-    use CC30002_0;
- 
-    TC_Camera1: Speed_Cameras.Speed_Camera;
-    TC_Camera2: Speed_Cameras.Speed_Camera'Class := TC_Camera1;
-    TC_Camera3: Speed_Cameras.Speed_Camera;
-    TC_Camera4: Speed_Cameras.Speed_Camera;
- 
- begin
-    Report.Test ("CC30002", "Check that an explicit declaration in the "      &
-                 "private part of an instance does not override an implicit " &
-                 "declaration in the instance, unless the corresponding "     &
-                 "explicit declaration in the generic overrides a "           &
-                 "corresponding implicit declaration in the generic. Check "  &
-                 "for primitive subprograms of tagged types");
- 
- --
- -- Check non-dispatching calls outside instance:
- --
- 
-    -- Non-overriding primitive operation:
- 
-    Speed_Cameras.Set_Shutter_Speed (TC_Camera1);
-    if TC_Camera1.TC_Shutter_Called /= Body_Of_Actual then
-       Report.Failed ("Wrong body executed: non-dispatching call to " &
-                      "Set_Shutter_Speed outside instance");
-    end if;
- 
- 
-    -- Overriding primitive operation:
- 
-    Speed_Cameras.Focus (TC_Camera1);
-    if TC_Camera1.TC_Focus_Called /= Body_In_Instance then
-       Report.Failed ("Wrong body executed: non-dispatching call to " &
-                      "Focus outside instance");
-    end if;
- 
- 
- --
- -- Check dispatching calls outside instance:
- --
- 
-    -- Non-overriding primitive operation:
- 
-    Speed_Cameras.Set_Shutter_Speed (TC_Camera2);
-    if TC_Camera2.TC_Shutter_Called /= Body_Of_Actual then
-       Report.Failed ("Wrong body executed: dispatching call to " &
-                      "Set_Shutter_Speed outside instance");
-    end if;
- 
- 
-    -- Overriding primitive operation:
- 
-    Speed_Cameras.Focus (TC_Camera2);
-    if TC_Camera2.TC_Focus_Called /= Body_In_Instance then
-       Report.Failed ("Wrong body executed: dispatching call to " &
-                      "Focus outside instance");
-    end if;
- 
- 
- 
- --
- -- Check non-dispatching calls within instance:
- --
- 
-    Speed_Cameras.Self_Test_NonDisp (TC_Camera3);
- 
-    -- Non-overriding primitive operation:
- 
-    if TC_Camera3.TC_Shutter_Called /= Body_In_Instance then
-       Report.Failed ("Wrong body executed: non-dispatching call to " &
-                      "Set_Shutter_Speed inside instance");
-    end if;
- 
-    -- Overriding primitive operation:
- 
-    if TC_Camera3.TC_Focus_Called /= Body_In_Instance then
-       Report.Failed ("Wrong body executed: non-dispatching call to " &
-                      "Focus inside instance");
-    end if;
- 
- 
- 
- --
- -- Check dispatching calls within instance:
- --
- 
-    Speed_Cameras.Self_Test_Disp (TC_Camera4);
- 
-    -- Non-overriding primitive operation:
- 
-    if TC_Camera4.TC_Shutter_Called /= Body_In_Instance then
-       Report.Failed ("Wrong body executed: dispatching call to " &
-                      "Set_Shutter_Speed inside instance");
-    end if;
- 
-    -- Overriding primitive operation:
- 
-    if TC_Camera4.TC_Focus_Called /= Body_In_Instance then
-       Report.Failed ("Wrong body executed: dispatching call to " &
-                      "Focus inside instance");
-    end if;
- 
-    Report.Result;
- end CC30002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- CC3004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT ACTUAL PARAMETERS IN A NAMED GENERIC ACTUAL PARAMETER 
- -- ASSOCIATION MAY BE OUT OF ORDER, AND ARE ASSOCIATED WITH THE 
- -- CORRECT FORMALS.
- 
- -- DAT 9/16/81 
- -- SPS 10/26/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3004A IS 
- BEGIN
-      TEST ("CC3004A", "ORDER OF NAMED GENERIC ACTUAL PARAMETERS");
- 
-      DECLARE
-           GENERIC
-                A,B : INTEGER;
-                C : INTEGER;
-                D : INTEGER;
-           PACKAGE P1 IS END P1;
- 
-           TYPE AI IS ACCESS INTEGER;
- 
-           GENERIC
-                TYPE D IS ( <> );
-                VD : D;
-                TYPE AD IS ACCESS D;
-                VA : AD;
-           PACKAGE P2 IS END P2;
- 
-           X : AI := NEW INTEGER '(IDENT_INT(23));
-           Y : AI := NEW INTEGER '(IDENT_INT(77));
- 
-           PACKAGE BODY P1 IS
-           BEGIN
-                IF A /= IDENT_INT(4)  OR
-                   B /= IDENT_INT(12) OR
-                   C /= IDENT_INT(11) OR
-                   D /= IDENT_INT(-33)
-                THEN
-                     FAILED ("WRONG GENERIC PARAMETER ASSOCIATIONS");
-                END IF;
-           END P1;
- 
-           PACKAGE BODY P2 IS
-           BEGIN
-                IF VA.ALL /= VD THEN 
-                     FAILED ("WRONG GENERIC PARM ASSOCIATIONS 2");
-                END IF;
-           END P2;
- 
-           PACKAGE N1 IS NEW P1 (C => 11, A => 4, D => -33, B => 12);
- 
-           PACKAGE N2 IS NEW P2 (VA => X, AD => AI, D => INTEGER, 
-                                 VD => 23);
- 
-           PACKAGE N3 IS NEW P2 (INTEGER, 77, VA => Y, AD => AI);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC3004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3007a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3007a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3007a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- CC3007A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NAMES IN A GENERIC DECLARATIONS ARE STATICALLY BOUND.
- 
- -- DAT 9/18/81
- -- SPS 2/7/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3007A IS
- BEGIN
-      TEST ("CC3007A", "NAMES IN GENERICS ARE STATICALLY BOUND");
- 
-      DECLARE
-           I : INTEGER := 1;
-           EX : EXCEPTION;
-           IA : INTEGER := I'SIZE;
- 
-           FUNCTION F (X : INTEGER) RETURN INTEGER;
- 
-           PACKAGE P IS
-                Q : INTEGER := 1;
-           END P;
- 
-           GENERIC
-                J : IN OUT INTEGER;
-                WITH FUNCTION FP (X : INTEGER) RETURN INTEGER IS F;
-           PACKAGE GP IS
-                V1 : INTEGER := F(I);
-                V2 : INTEGER := FP(I);
-           END GP;
- 
-           GENERIC
-                TYPE T IS RANGE <> ;
-                WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER IS F;
-                INP : IN T := T (I'SIZE);
-           FUNCTION F1 (X : T) RETURN T;
- 
-           FUNCTION F1 (X : T) RETURN T IS
-           BEGIN
-                IF INP /= T(IA) THEN
-                     FAILED ("INCORRECT GENERIC BINDING 2");
-                END IF;
-                I := I + 1;
-                RETURN 2 * T (F1 (F (INTEGER (X) + I + P.Q)));
-           END F1;
- 
-           PACKAGE BODY GP IS
-                PACKAGE P IS
-                     Q : INTEGER := I + 1;
-                END P;
-                I : INTEGER := 1000;
-                FUNCTION F IS NEW F1 (INTEGER);
-                FUNCTION F2 IS NEW F1 (INTEGER);
-           BEGIN
-                P.Q := F2 (J + P.Q + V1 + 2 * V2);
-                J := P.Q;
-                RAISE EX;
-           END GP;
- 
-           FUNCTION F (X : INTEGER) RETURN INTEGER IS
-           BEGIN
-                I := I + 2;
-                RETURN X + I;
-           END;
-      BEGIN
-           DECLARE
-                I : INTEGER := 1000;
-                EX : EXCEPTION;
-                FUNCTION F IS NEW F1 (INTEGER);
-                V : INTEGER := F (3);
-           BEGIN
-                BEGIN
-                     DECLARE
-                          PACKAGE P IS NEW GP (V);
-                     BEGIN
-                          FAILED ("EX NOT RAISED");
-                     END;
-                EXCEPTION
-                     WHEN EX =>
-                          FAILED ("WRONG EXCEPTION RAISED");
-                     WHEN OTHERS =>
-                          IF V /= 266 THEN
-                               FAILED ("WRONG BINDING IN GENERICS");
-                          END IF;
-                          RAISE;
-                END;
- 
-           END;
-      EXCEPTION
-           WHEN EX => NULL;
-           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
-      END;
- 
-      RESULT;
- END CC3007A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,397 ****
- -- CC3007B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  CHECK THAT THE NAMES IN A GENERIC INSTANTIATION ARE STATICALLY
- --  IDENTIFIED (I.E., BOUND) AT THE TEXTUAL POINT OF THE INSTANTIA-
- --  TION, AND ARE BOUND BEFORE BEING "SUBSTITUTED" FOR THE COR-
- --  RESPONDING GENERIC FORMAL PARAMETERS IN THE SPECIFICATION AND
- --  BODY TEMPLATES.
- --
- --  SEE AI-00365/05-BI-WJ.
- 
- -- HISTORY:
- --      EDWARD V. BERARD, 15 AUGUST 1990
- --      DAS   08 OCT 90   CHANGED INSTANTIATIONS TO USE VARIABLES
- --                        M1 AND M2 IN THE FIRST_BLOCK INSTANTIA-
- --                        TION AND TO ASSIGN THIRD_DATE AND
- --                        FOURTH_DATE VALUES BEFORE AND AFTER THE
- --                        SECOND_BLOCK INSTANTIATION.
- 
- WITH REPORT;
- 
- PROCEDURE CC3007B IS
- 
-      INCREMENTED_VALUE : NATURAL := 0;
- 
-      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                          SEP, OCT, NOV, DEC);
-      TYPE DAY_TYPE IS RANGE 1 .. 31;
-      TYPE YEAR_TYPE IS RANGE 1904 .. 2050;
-      TYPE DATE IS RECORD
-           MONTH : MONTH_TYPE;
-           DAY   : DAY_TYPE;
-           YEAR  : YEAR_TYPE;
-      END RECORD;
- 
-      TYPE DATE_ACCESS IS ACCESS DATE;
- 
-      TODAY           : DATE := (MONTH => AUG,
-                                 DAY   => 8,
-                                 YEAR  => 1990);
- 
-      CHRISTMAS       : DATE := (MONTH => DEC,
-                                 DAY   => 25,
-                                 YEAR  => 1948);
- 
-      WALL_DATE       : DATE := (MONTH => NOV,
-                                 DAY   => 9,
-                                 YEAR  => 1989);
- 
-      BIRTH_DATE     : DATE := (MONTH => OCT,
-                                DAY   => 3,
-                                YEAR  => 1949);
- 
-      FIRST_DUE_DATE : DATE := (MONTH => JAN,
-                                DAY   => 23,
-                                YEAR  => 1990);
- 
-      LAST_DUE_DATE  : DATE := (MONTH => DEC,
-                                DAY   => 20,
-                                YEAR  => 1990);
- 
-      THIS_MONTH    : MONTH_TYPE := AUG;
- 
-      STORED_RECORD : DATE := TODAY;
- 
-      STORED_INDEX  : MONTH_TYPE := AUG;
- 
-      FIRST_DATE   : DATE_ACCESS := NEW DATE'(WALL_DATE);
-      SECOND_DATE  : DATE_ACCESS := FIRST_DATE;
- 
-      THIRD_DATE     : DATE_ACCESS := NEW DATE'(BIRTH_DATE);
-      FOURTH_DATE  : DATE_ACCESS := NEW DATE'(CHRISTMAS);
- 
-      TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE;
-      REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
-                                   (MAR, 23, 1990), (APR, 23, 1990),
-                                   (MAY, 23, 1990), (JUN, 22, 1990),
-                                   (JUL, 23, 1990), (AUG, 23, 1990),
-                                   (SEP, 24, 1990), (OCT, 23, 1990),
-                                   (NOV, 23, 1990), (DEC, 20, 1990));
- 
-      GENERIC
- 
-           NATURALLY     : IN NATURAL;
-           FIRST_RECORD  : IN OUT DATE;
-           SECOND_RECORD : IN OUT DATE;
-           TYPE RECORD_POINTER IS ACCESS DATE;
-           POINTER : IN OUT RECORD_POINTER;
-           TYPE ARRAY_TYPE IS ARRAY (MONTH_TYPE) OF DATE;
-           THIS_ARRAY           : IN OUT ARRAY_TYPE;
-           FIRST_ARRAY_ELEMENT  : IN OUT DATE;
-           SECOND_ARRAY_ELEMENT : IN OUT DATE;
-           INDEX_ELEMENT        : IN OUT MONTH_TYPE;
-           POINTER_TEST         : IN OUT DATE;
-           ANOTHER_POINTER_TEST : IN OUT DATE;
- 
-      PACKAGE TEST_ACTUAL_PARAMETERS IS
- 
-           PROCEDURE EVALUATE_FUNCTION;
-           PROCEDURE CHECK_RECORDS;
-           PROCEDURE CHECK_ACCESS;
-           PROCEDURE CHECK_ARRAY;
-           PROCEDURE CHECK_ARRAY_ELEMENTS;
-           PROCEDURE CHECK_SCALAR;
-           PROCEDURE CHECK_POINTERS;
- 
-      END TEST_ACTUAL_PARAMETERS;
- 
-      PACKAGE BODY TEST_ACTUAL_PARAMETERS IS
- 
-           PROCEDURE EVALUATE_FUNCTION IS
-           BEGIN  -- EVALUATE_FUNCTION
- 
-                IF (INCREMENTED_VALUE = 0) OR 
-                   (NATURALLY /= INCREMENTED_VALUE) THEN
-                     REPORT.FAILED ("PROBLEMS EVALUATING FUNCTION " &
-                                    "PARAMETER.");
-                END IF;
- 
-           END EVALUATE_FUNCTION;
- 
-           PROCEDURE CHECK_RECORDS IS
- 
-                STORE : DATE;
- 
-           BEGIN  -- CHECK_RECORDS
- 
-                IF STORED_RECORD /= FIRST_RECORD THEN
-                     REPORT.FAILED ("PROBLEM WITH RECORD TYPES");
-                ELSE
-                     STORED_RECORD := SECOND_RECORD;
-                     STORE := FIRST_RECORD;
-                     FIRST_RECORD := SECOND_RECORD;
-                     SECOND_RECORD := STORE;
-                END IF;
- 
-           END CHECK_RECORDS;
- 
-           PROCEDURE CHECK_ACCESS IS
-           BEGIN  -- CHECK_ACCESS
- 
-                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
-                THEN
-                     IF POINTER.ALL /= DATE'(WALL_DATE) THEN
-                          REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
-                                         "- 1");
-                     ELSE
-                          POINTER.ALL := DATE'(BIRTH_DATE);
-                     END IF;
-                ELSE
-                     IF POINTER.ALL /= DATE'(BIRTH_DATE) THEN
-                          REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
-                                         "- 2");
-                     ELSE
-                          POINTER.ALL := DATE'(WALL_DATE);
-                     END IF;
-                END IF;
- 
-           END CHECK_ACCESS;
- 
-           PROCEDURE CHECK_ARRAY IS
- 
-                STORE : DATE;
- 
-           BEGIN  -- CHECK_ARRAY
- 
-                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
-                THEN
-                     IF THIS_ARRAY (THIS_ARRAY'FIRST) /= FIRST_DUE_DATE
-                     THEN
-                          REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 1");
-                     ELSE
-                          THIS_ARRAY (THIS_ARRAY'FIRST) := LAST_DUE_DATE;
-                          THIS_ARRAY (THIS_ARRAY'LAST) := FIRST_DUE_DATE;
-                     END IF;
-                ELSE
-                     IF THIS_ARRAY (THIS_ARRAY'FIRST) /= LAST_DUE_DATE
-                     THEN
-                          REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 2");
-                     ELSE
-                          THIS_ARRAY (THIS_ARRAY'FIRST) :=
-                                                   FIRST_DUE_DATE;
-                          THIS_ARRAY (THIS_ARRAY'LAST)  := LAST_DUE_DATE;
-                     END IF;
-                END IF;
- 
-           END CHECK_ARRAY;
- 
-           PROCEDURE CHECK_ARRAY_ELEMENTS IS
- 
-                STORE : DATE;
- 
-           BEGIN  -- CHECK_ARRAY_ELEMENTS
- 
-                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
-                THEN
-                     IF (FIRST_ARRAY_ELEMENT.MONTH /= MAY) OR
-                        (SECOND_ARRAY_ELEMENT.DAY /= 22) THEN
-                          REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
-                                         "- 1");
-                     ELSE
-                          STORE := FIRST_ARRAY_ELEMENT;
-                          FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
-                          SECOND_ARRAY_ELEMENT := STORE;
-                     END IF;
-                ELSE
-                     IF (FIRST_ARRAY_ELEMENT.MONTH /= JUN) OR
-                        (SECOND_ARRAY_ELEMENT.DAY /= 23) THEN
-                          REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
-                                         "- 2");
-                     ELSE
-                          STORE := FIRST_ARRAY_ELEMENT;
-                          FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
-                          SECOND_ARRAY_ELEMENT := STORE;
-                     END IF;
-                END IF;
- 
-           END CHECK_ARRAY_ELEMENTS;
- 
-           PROCEDURE CHECK_SCALAR IS
-           BEGIN  -- CHECK_SCALAR
- 
-                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
-                THEN
-                     IF INDEX_ELEMENT /= STORED_INDEX THEN
-                          REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 1");
-                     ELSE
-                          INDEX_ELEMENT :=
-                                    MONTH_TYPE'SUCC(INDEX_ELEMENT);
-                          STORED_INDEX := INDEX_ELEMENT;
-                     END IF;
-                ELSE
-                     IF INDEX_ELEMENT /= STORED_INDEX THEN
-                          REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 2");
-                     ELSE
-                          INDEX_ELEMENT :=
-                               MONTH_TYPE'PRED (INDEX_ELEMENT);
-                          STORED_INDEX := INDEX_ELEMENT;
-                     END IF;
-                END IF;
- 
-           END CHECK_SCALAR;
- 
-           PROCEDURE CHECK_POINTERS IS
- 
-                STORE : DATE;
- 
-           BEGIN  -- CHECK_POINTERS
- 
-                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
-                THEN
-                     IF (POINTER_TEST /= DATE'(OCT, 3, 1949)) OR
-                        (ANOTHER_POINTER_TEST /= DATE'(DEC, 25, 1948))
-                     THEN
-                          REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
-                                         "- 1");
-                     ELSE
-                          STORE := POINTER_TEST;
-                          POINTER_TEST := ANOTHER_POINTER_TEST;
-                          ANOTHER_POINTER_TEST := STORE;
-                     END IF;
-                ELSE
-                     IF (POINTER_TEST /= DATE'(DEC, 25, 1948)) OR
-                        (ANOTHER_POINTER_TEST /= DATE'(OCT, 3, 1949))
-                     THEN
-                          REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
-                                         "- 2");
-                     ELSE
-                          STORE := POINTER_TEST;
-                          POINTER_TEST := ANOTHER_POINTER_TEST;
-                          ANOTHER_POINTER_TEST := STORE;
-                     END IF;
-                END IF;
- 
-           END CHECK_POINTERS;
- 
-      END TEST_ACTUAL_PARAMETERS;
- 
-      FUNCTION INC RETURN NATURAL IS
-      BEGIN  -- INC
-           INCREMENTED_VALUE := NATURAL'SUCC (INCREMENTED_VALUE);
-           RETURN INCREMENTED_VALUE;
-      END INC;
- 
- BEGIN  -- CC3007B
- 
-      REPORT.TEST ("CC3007B", "CHECK THAT THE NAMES IN A GENERIC " &
-                   "INSTANTIATION ARE STAICALLY IDENTIFIED (I.E., " &
-                   "BOUND) AT THE TEXTUAL POINT OF THE INSTANTIATION" &
-                   ", AND ARE BOUND BEFORE BEING SUBSTITUTED FOR " &
-                   "THE CORRESPONDING GENERIC FORMAL PARAMETERS IN " &
-                   "THE SPECIFICATION AND BODY TEMPLATES.  " &
-                   "SEE AI-00365/05-BI-WJ.");
- 
-      FIRST_BLOCK:
- 
-      DECLARE
- 
-           M1 : MONTH_TYPE := MAY;
-           M2 : MONTH_TYPE := JUN;
- 
-           PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
-                NEW TEST_ACTUAL_PARAMETERS (
-                     NATURALLY              => INC,
-                     FIRST_RECORD           => TODAY,
-                     SECOND_RECORD          => CHRISTMAS,
-                     RECORD_POINTER         => DATE_ACCESS,
-                     POINTER                => SECOND_DATE,
-                     ARRAY_TYPE             => DUE_DATES,
-                     THIS_ARRAY             => REPORT_DATES,
-                     FIRST_ARRAY_ELEMENT    => REPORT_DATES (M1),
-                     SECOND_ARRAY_ELEMENT   => REPORT_DATES (M2),
-                     INDEX_ELEMENT          => THIS_MONTH,
-                     POINTER_TEST           => THIRD_DATE.ALL,
-                     ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
- 
-      BEGIN  -- FIRST_BLOCK
- 
-           REPORT.COMMENT ("ENTERING FIRST BLOCK");
-           NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
-           M1 := SEP;
-           M2 := OCT;
-           -- NEW_TEST_ACTUAL_PARAMETERS SHOULD USE THE PREVIOUS
-           -- VALUES OF MAY AND JUN.
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
- 
-      END FIRST_BLOCK;
- 
-      SECOND_BLOCK:
- 
-      DECLARE
- 
-           SAVE_THIRD_DATE  : DATE_ACCESS := THIRD_DATE;
-           SAVE_FOURTH_DATE : DATE_ACCESS := FOURTH_DATE;
- 
-           PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
-                NEW TEST_ACTUAL_PARAMETERS (
-                     NATURALLY              => INC,
-                     FIRST_RECORD           => TODAY,
-                     SECOND_RECORD          => CHRISTMAS,
-                     RECORD_POINTER         => DATE_ACCESS,
-                     POINTER                => SECOND_DATE,
-                     ARRAY_TYPE             => DUE_DATES,
-                     THIS_ARRAY             => REPORT_DATES,
-                     FIRST_ARRAY_ELEMENT    => REPORT_DATES (MAY),
-                     SECOND_ARRAY_ELEMENT   => REPORT_DATES (JUN),
-                     INDEX_ELEMENT          => THIS_MONTH,
-                     POINTER_TEST           => THIRD_DATE.ALL,
-                     ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
- 
-      BEGIN  -- SECOND_BLOCK
- 
-           REPORT.COMMENT ("ENTERING SECOND BLOCK");
-           NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
- 
-           THIRD_DATE := NEW DATE'(JUL, 13, 1951);
-           FOURTH_DATE := NEW DATE'(JUL, 4, 1976);
-           NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
-           THIRD_DATE := SAVE_THIRD_DATE;
-           FOURTH_DATE := SAVE_FOURTH_DATE;
- 
-      END SECOND_BLOCK;
- 
-      REPORT.RESULT;
- 
- END CC3007B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,131 ****
- -- CC3011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT SUBPROGRAMS THAT WOULD HAVE THE SAME SPECIFICATION
- -- AFTER GENERIC INSTANTIATION MAY BE DECLARED IN THE SAME
- -- DECLARATIVE PART, AND THAT CALLS WITHIN THE INSTANTIATED UNIT ARE
- -- UNAMBIGUOUS.  CHECK THAT CALLS FROM OUTSIDE THE UNIT ARE UNAMBIGUOUS
- -- IF FORMAL PARAMETER NAMES ARE USED OR IF ONLY ONE OF THE EQUIVALENT
- -- PROGRAMS APPEARS IN THE VISIBLE PART OF THE PACKAGE.
- 
- -- DAT 9/18/81
- -- SPS 10/19/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3011A IS
- BEGIN
-      TEST ("CC3011A", "CHECK SUBPROGRAMS IN GENERIC PACKAGES WITH SAME"
-           & " SPECIFICATION AFTER GENERIC PARAMETER SUBSTITUTION");
- 
-      DECLARE
-           C : INTEGER := 0;
- 
-           GENERIC
-                TYPE S IS ( <> );
-                TYPE T IS PRIVATE;
-                TYPE U IS RANGE <> ;
-                VT : T;
-           PACKAGE PKG IS
-                PROCEDURE P1 (X : S);
-           PRIVATE
-                PROCEDURE P1 (X : T);
-                VS : S := S'FIRST;
-                VU : U := U'FIRST;
-           END PKG;
- 
-           GENERIC
-                TYPE S IS (<>);
-                TYPE T IS RANGE <>;
-           PACKAGE PP IS
-                PROCEDURE P1 (D: S);
-                PROCEDURE P1 (X: T);
-           END PP;
- 
-           PACKAGE BODY PKG IS
-                PROCEDURE P1 (X : S) IS 
-                BEGIN
-                     C := C + 1;
-                END P1;
-                PROCEDURE P1 (X : T) IS
-                BEGIN
-                     C := C + 2;
-                END P1;
-                PROCEDURE P1 (X : U) IS
-                BEGIN
-                     C := C + 4;
-                END P1;
-           BEGIN
-                C := 0;
-                P1 (VS);
-                IF C /= IDENT_INT (1) THEN
-                     FAILED ("WRONG P1 CALLED -S");
-                END IF;
-                C := 0;
-                P1 (VT);
-                IF C /= IDENT_INT (2) THEN
-                     FAILED ("WRONG P1 CALLED -T");
-                END IF;
-                C := 0;
-                P1 (VU);
-                IF C /= IDENT_INT (4) THEN
-                     FAILED ("WRONG P1 CALLED -U");
-                END IF;
-                C := 0;
-           END PKG;
- 
-           PACKAGE BODY PP IS
-                PROCEDURE P1 (D: S) IS
-                BEGIN
-                     C := C + 3;
-                END P1;
-                PROCEDURE P1 (X: T) IS
-                BEGIN
-                     C := C + 5;
-                END P1;
-           BEGIN
-                NULL;
-           END PP;
- 
-           PACKAGE NP IS NEW PKG (INTEGER, INTEGER, INTEGER, 7);
-           PACKAGE NPP IS NEW PP (INTEGER, INTEGER);
-      BEGIN
-           NP.P1 (4);
-           IF C /= IDENT_INT (1) THEN
-                FAILED ("INCORRECT OVERLOADING ON FORMAL TYPES");
-           END IF;
-           C := 0;
-           NPP.P1 (D => 3);
-           IF C /= IDENT_INT (3) THEN
-                FAILED ("INCORRECT CALL TO P1 WITH D PARAMETER");
-           END IF;
-           C := 0;
-           NPP.P1 (X => 7);
-           IF C /= IDENT_INT (5) THEN
-                FAILED ("INCORRECT CALL TO P1 WITH X PARAMETER");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3011d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3011d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3011d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3011d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CC3011D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC PACKAGE INSTANTIATION CONTAINS DECLARATIONS
- -- OF SUBPROGRAMS WITH THE SAME SPECIFICATIONS, THE CALLS TO THE
- -- SUBPROGRAMS ARE NOT AMBIGIOUS WITHIN THE GENERIC BODY.
- 
- -- SPS 5/7/82
- -- SPS 2/7/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3011D IS
- BEGIN
-      TEST ("CC3011D", "SUBPROGRAMS WITH SAME SPECIFICATIONS NOT"
-           & " AMBIGIOUS WITHIN GENERIC BODY");
- 
-      DECLARE
-           TYPE FLAG IS (PRT,PRS);
-           XX : FLAG;
- 
-           GENERIC
-                TYPE S IS PRIVATE;
-                TYPE T IS PRIVATE;
-                V1 : S;
-                V2 : T;
-           PACKAGE P1 IS
-                PROCEDURE PR(X : S);
-                PROCEDURE PR(X : T);
-           END P1;
- 
-           PACKAGE BODY P1 IS
-                PROCEDURE PR (X : S) IS
-                BEGIN
-                     XX := PRS;
-                END;
- 
-                PROCEDURE PR (X : T ) IS
-                BEGIN
-                     XX := PRT;
-                END;
- 
-           BEGIN
-                XX := PRT;
-                PR (V1);
-                IF XX /= PRS THEN
-                     FAILED ("WRONG BINDING FOR PR WITH TYPE S");
-                END IF;
-                XX := PRS;
-                PR (V2);
-                IF XX /= PRT THEN
-                     FAILED ("WRONG BINDING FOR PR WITH TYPE T");
-                END IF;
-           END P1;
- 
-           PACKAGE PAK IS NEW P1 (INTEGER, INTEGER, 1, 2);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC3011D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3012a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3012a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3012a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,247 ****
- -- CC3012A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT GENERIC INSTANCES MAY BE OVERLOADED.
- 
- -- CHECK THAT THEY MAY OVERLOAD PREVIOUSLY DECLARED SUBPROGRAMS AND
- -- ENUMERATION LITERALS.
- 
- -- DAT 9/16/81
- -- SPS 10/19/82
- -- SPS 2/8/83
- -- PWN 11/30/94 REMOVED PART OF TEST INVALID FOR ADA 9X.
- 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3012A IS
- BEGIN
-      TEST ("CC3012A", "CHECK THAT GENERIC INSTANCES MAY OVERLOAD " &
-                       "OTHER IDENTIFIERS");
- 
-      DECLARE
-           GENERIC 
-                TYPE T IS ( <> );
-                V : IN T;
-           PROCEDURE GP (X : IN OUT T);
- 
-           GENERIC 
-                TYPE T IS ( <> );
-           FUNCTION LESS (X, Y : T) RETURN BOOLEAN;
- 
-           GENERIC
-                TYPE T IS ( <> );
-           FUNCTION PLUS (X, Y : T) RETURN T;
- 
-           GENERIC
-                TYPE T IS PRIVATE;
-                Z : T;
-           FUNCTION F1  RETURN T;
- 
-           TYPE DC IS NEW CHARACTER RANGE IDENT_CHAR ('A') .. 'Z';
-           TYPE DI IS NEW INTEGER;
-           TYPE ENUM IS (E1, E2, E3, E4);
- 
-           VC : CHARACTER := 'A';
-           VI : INTEGER := 5;
-           VB : BOOLEAN := TRUE;
-           VE : ENUM := E2;
- 
-           TYPE DENUM IS NEW ENUM RANGE E2 .. ENUM'LAST;
- 
-           VDE : DENUM := E4;
-           VDC : DC := 'A';
-           VDI : DI := 7;
- 
-           PROCEDURE GP (X : IN OUT T) IS
-           BEGIN
-                X := V;
-           END GP;
- 
-           FUNCTION LESS (X, Y : T) RETURN BOOLEAN IS
-           BEGIN
-                RETURN FALSE;
-           END LESS;
- 
-           FUNCTION PLUS (X, Y : T) RETURN T IS
-           BEGIN
-                RETURN T'FIRST;
-           END PLUS;
- 
-           FUNCTION F1 RETURN T IS
-           BEGIN
-                RETURN Z;
-           END F1;
- 
-           FUNCTION E5 RETURN INTEGER IS
-           BEGIN
-                RETURN 1;
-           END E5;
- 
-           PACKAGE PKG IS
-           
-                PROCEDURE P IS NEW GP (CHARACTER, 'Q');
-                PROCEDURE P IS NEW GP (INTEGER, -14);
-                PROCEDURE P IS NEW GP (BOOLEAN, FALSE);
-                PROCEDURE P IS NEW GP (ENUM, E4);
-                PROCEDURE P IS NEW GP (DC, 'W');
-                PROCEDURE P IS NEW GP (DI, -33);
-                PROCEDURE P IS NEW GP (DENUM, E2);
-      
-                FUNCTION "<" IS NEW LESS (CHARACTER);
-                FUNCTION "<" IS NEW LESS (INTEGER);
-                FUNCTION "<" IS NEW LESS (BOOLEAN);
-                FUNCTION "<" IS NEW LESS (ENUM);
-                FUNCTION "<" IS NEW LESS (DC);
-                FUNCTION "<" IS NEW LESS (DI);
-                -- NOT FOR DENUM.
-      
-                FUNCTION "+" IS NEW PLUS (CHARACTER);
-                FUNCTION "+" IS NEW PLUS (INTEGER);
-                FUNCTION "+" IS NEW PLUS (BOOLEAN);
-                FUNCTION "+" IS NEW PLUS (ENUM);
-                FUNCTION "+" IS NEW PLUS (DC);
-                -- NOT FOR DI.
-                FUNCTION "+" IS NEW PLUS (DENUM);
- 
-                FUNCTION E2 IS NEW F1 (BOOLEAN, FALSE);
-                FUNCTION E5 IS NEW F1 (DC, 'M');
- 
-           END PKG;
- 
-           PACKAGE BODY PKG IS
-           BEGIN
-                P (VC);
-                P (VI);
-                P (VB);
-                P (VE);
-                P (X => VDE);
-                P (X => VDC);
-                P (X => VDI);
- 
-                IF VC /= 'Q' THEN
-                     FAILED ("OVERLOADED PROCEDURE - 1");
-                END IF;
- 
-                IF VI /= -14 THEN
-                     FAILED ("OVERLOADED PROCEDURE - 2");
-                END IF;
- 
-                IF VB /= FALSE THEN
-                     FAILED ("OVERLOADED PROCEDURE - 3");
-                END IF;
- 
-                IF VE /= E4 THEN
-                     FAILED ("OVERLOADED PROCEDURE - 4");
-                END IF;
- 
-                IF VDE /= E2 THEN
-                     FAILED ("OVERLOADED PROCEDURE - 5");
-                END IF;
- 
-                IF VDC /= 'W' THEN
-                     FAILED ("OVERLOADED PROCEDURE - 6");
-                END IF;
- 
-                IF VDI /= -33 THEN
-                     FAILED ("OVERLOADED PROCEDURE - 7");
-                END IF;
- 
-                IF VC  < ASCII.DEL THEN
-                     FAILED ("OVERLOADED LESS THAN - 1");
-                END IF;
- 
-                IF VI < 1E3 THEN
-                     FAILED ("OVERLOADED LESS THAN - 2");
-                END IF;
- 
-                IF FALSE < TRUE THEN
-                     FAILED ("OVERLOADED LESS THAN - 3");
-                END IF;
- 
-                IF E1 < VE THEN
-                     FAILED ("OVERLOADED LESS THAN - 4");
-                END IF;
- 
-                IF VDC < 'Z' THEN
-                     FAILED ("OVERLOADED LESS THAN - 5");
-                END IF;
- 
-                IF VDI < 0 THEN
-                     FAILED ("OVERLOADED LESS THAN - 6");
-                END IF;
- 
- 
-                IF -14 + 5 /= -9 THEN
-                     FAILED ("OVERLOADED PLUS - 2");
-                END IF;
- 
-                IF VI + 5 /= INTEGER'FIRST THEN
-                     FAILED ("OVERLOADED PLUS - 3");
-                END IF;
- 
-                IF VB + TRUE /= FALSE THEN
-                     FAILED ("OVERLOADED PLUS - 4");
-                END IF;
- 
-                IF VE + E2 /= E1 THEN
-                     FAILED ("OVERLOADED PLUS - 5");
-                END IF;
- 
-                IF DENUM'(E3) + E2 /= E2 THEN
-                     FAILED ("OVERLOADED PLUS - 6");
-                END IF;
- 
-                IF  VDC + 'B' /= 'A' THEN
-                     FAILED ("OVERLOADED PLUS - 7");
-                END IF;
- 
-                IF VDI + 14 /= -19 THEN       -- -33 + 14
-                     FAILED ("OVERLOADED PLUS - 8");
-                END IF;
- 
-                VI := E5;
-                VDC := E5;
-                VE := E2;
-                VB := E2;
-                IF VI /= 1 OR
-                   VDC /= 'M' OR
-                   VE /= ENUM'VAL(IDENT_INT(1)) OR
-                   VB /= FALSE THEN
-                     FAILED ("OVERLOADING OF ENUMERATION LITERALS " &
-                             "AND PREDEFINED SUBPROGRAMS");
-                END IF;
-           END PKG;
-      BEGIN
-           DECLARE
-                USE PKG;
-           BEGIN
-                IF NOT (VI + 5 < 11) THEN
-                FAILED ("INCORRECT VISIBILITY OF GENERIC OVERLOADING");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END CC3012A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3015a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3015a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3015a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3015a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- CC3015A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC PACKAGE INSTANTIATION IS ELABORATED, 
- -- STATEMENTS IN ITS PACKAGE BODY ARE EXECUTED AND EXPRESSIONS
- -- REQUIRING EVALUATION ARE EVALUATED (E.G., DEFAULTS FOR OBJECT
- -- DECLARATIONS ARE EVALUATED).
- 
- -- RJW 6/11/86
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3015A IS
-      BOOL1, BOOL2 : BOOLEAN := FALSE;          
-           
-      TYPE ENUM IS (BEFORE, AFTER);
- 
-      FUNCTION F (I : INTEGER) RETURN INTEGER IS
-      BEGIN
-           BOOL2 := TRUE;
-           RETURN I;
-      END;
-           
-      FUNCTION CHECK (E : ENUM) RETURN CHARACTER IS
-      BEGIN
-           IF E = BEFORE THEN
-                IF BOOL1 THEN
-                     FAILED ( "STATEMENT EXECUTED BEFORE " &
-                              "INSTANTIATION" );
-                END IF;
-                IF BOOL2 THEN
-                     FAILED ( "DEFAULT EXPRESSION EVALUATED " &
-                              "BEFORE INSTANTIATION" );
-                END IF;
-           ELSE
-                IF BOOL1 THEN
-                     NULL;
-                ELSE
-                     FAILED ( "STATEMENT NOT EXECUTED AT " &
-                              "INSTANTIATION" );
-                END IF;
-                IF BOOL2 THEN
-                     NULL;
-                ELSE
-                     FAILED ( "DEFAULT EXPRESSION NOT EVALUATED " &
-                              "AT INSTANTIATION" );
-                END IF;
-           END IF;
-           RETURN 'A';
-       END;
- 
-      GENERIC 
-           TYPE INT IS RANGE <>;
-      PACKAGE PKG IS END PKG;
- 
-      PACKAGE BODY PKG IS
-           I : INT := INT'VAL (F(0));
-      BEGIN
-           BOOL1 := TRUE;
-      END;
-                          
- BEGIN
-      TEST ("CC3015A", "CHECK THAT WHEN A GENERIC PACKAGE " & 
-                       "INSTANTIATION IS ELABORATED, STATEMENTS " & 
-                       "IN ITS PACKAGE BODY ARE EXECUTED AND " &
-                       "EXPRESSIONS REQUIRING EVALUATION ARE " &
-                       "EVALUATED (E.G., DEFAULTS FOR OBJECT " &
-                       "DECLARATIONS ARE EVALUATED)" );
-      
- 
-      DECLARE
-           A : CHARACTER := CHECK (BEFORE);
- 
-           PACKAGE NPKG IS NEW PKG (INTEGER);
-      
-           B : CHARACTER := CHECK (AFTER);
- 
-      BEGIN
-           NULL;
-      END;          
- 
-      RESULT;
- END CC3015A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,396 ****
- -- CC3016B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  CHECK THAT AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
- --  PACKAGE. CHECK THAT THE DECLARATIVE ITEMS IN AN INSTANTIATION
- --  OF A GENERIC PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER
- --  DECLARED.    
- 
- -- HISTORY:
- --         EDWARD V. BERARD, 8 AUGUST 1990
- 
- WITH REPORT ;
- 
- PROCEDURE CC3016B IS
-      
-     WHEN_ELABORATED : NATURAL := 0 ;
-     
-     TYPE REAL IS DIGITS 6 ;
-     REAL_VALUE : REAL := 3.14159 ;
-     
-     TRUE_VALUE : BOOLEAN := TRUE ;
-     
-     CHARACTER_VALUE : CHARACTER := 'Z' ;
-           
-     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                         SEP, OCT, NOV, DEC) ;
-     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-     TYPE DATE IS RECORD
-       MONTH : MONTH_TYPE ;
-       DAY   : DAY_TYPE ;
-       YEAR  : YEAR_TYPE ;
-     END RECORD ;
-           
-     TYPE DATE_ACCESS IS ACCESS DATE ;
- 
-     THIS_MONTH   : MONTH_TYPE := AUG ;
-     THIS_YEAR     : YEAR_TYPE := 1990 ;
- 
-     TODAY         : DATE := (MONTH => AUG,
-                                DAY   => 8,
-                               YEAR  => 1990) ;
- 
-     FIRST_DATE   : DATE_ACCESS  := NEW DATE'(DAY   => 6,
-                                              MONTH => JUN,
-                                              YEAR  => 1967) ;
-     
-     TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE ;
-     REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
-                                  (MAR, 23, 1990), (APR, 23, 1990),
-                                  (MAY, 23, 1990), (JUN, 22, 1990),
-                                  (JUL, 23, 1990), (AUG, 23, 1990),
-                                  (SEP, 24, 1990), (OCT, 23, 1990),
-                                  (NOV, 23, 1990), (DEC, 20, 1990)) ;
-                                  
-     TYPE LIST_INDEX IS RANGE 1 .. 16 ;
-     TYPE LIST IS ARRAY (LIST_INDEX) OF NATURAL ;
-     ORDER_LIST : LIST := (OTHERS => 0) ;
- 
-     GENERIC
-     
-         TYPE RETURN_TYPE IS PRIVATE ;
-         RETURN_VALUE : IN OUT RETURN_TYPE ;
-         POSITION      : IN       NATURAL ;
-         OFFSET        : IN       NATURAL ;
-         WHEN_ELAB     : IN OUT NATURAL ;
-         TYPE INDEX IS RANGE <> ;
-         TYPE LIST IS ARRAY (INDEX) OF NATURAL ;
-         ORDER_LIST      : IN OUT LIST ;
-     
-     FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE ;
-     
-     FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE IS
-     
-     BEGIN -- NAME
-         
-         IF (VALUE = POSITION) THEN
-           WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;
-           ORDER_LIST (INDEX (POSITION)) := WHEN_ELAB ;
-           RETURN RETURN_VALUE ;
-         ELSIF (VALUE = (POSITION + OFFSET)) THEN
-           WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;
-           ORDER_LIST (INDEX (POSITION + OFFSET)) := WHEN_ELAB ;
-           RETURN RETURN_VALUE ;
-         END IF ;
-     
-     END NAME ;
-     
-     GENERIC
-     
-         TYPE FIRST_TYPE IS PRIVATE ;
-         WITH FUNCTION FIRST (POSITION : IN NATURAL) 
-                             RETURN FIRST_TYPE ;
-         FIRST_VALUE : IN NATURAL ;
-         TYPE SECOND_TYPE IS PRIVATE ;
-         WITH FUNCTION SECOND (POSITION : IN NATURAL) 
-                             RETURN SECOND_TYPE ;
-         SECOND_VALUE : IN NATURAL ;
-         TYPE THIRD_TYPE IS PRIVATE ;
-         WITH FUNCTION THIRD (POSITION : IN NATURAL) 
-                             RETURN THIRD_TYPE ;
-         THIRD_VALUE : IN NATURAL ;
-         TYPE FOURTH_TYPE IS PRIVATE ;
-         WITH FUNCTION FOURTH (POSITION : IN NATURAL) 
-                             RETURN FOURTH_TYPE ;
-         FOURTH_VALUE : IN NATURAL ;
-         TYPE FIFTH_TYPE IS PRIVATE ;
-         WITH FUNCTION FIFTH (POSITION : IN NATURAL) 
-                             RETURN FIFTH_TYPE ;
-         FIFTH_VALUE : IN NATURAL ;
-         TYPE SIXTH_TYPE IS PRIVATE ;
-         WITH FUNCTION SIXTH (POSITION : IN NATURAL) 
-                             RETURN SIXTH_TYPE ;
-         SIXTH_VALUE : IN NATURAL ;
-         TYPE SEVENTH_TYPE IS PRIVATE ;
-         WITH FUNCTION SEVENTH (POSITION : IN NATURAL) 
-                             RETURN SEVENTH_TYPE ;
-         SEVENTH_VALUE : IN NATURAL ;
-         TYPE EIGHTH_TYPE IS PRIVATE ;
-         WITH FUNCTION EIGHTH (POSITION : IN NATURAL) 
-                             RETURN EIGHTH_TYPE ;
-         EIGHTH_VALUE : IN NATURAL ;
-         TYPE NINTH_TYPE IS PRIVATE ;
-         WITH FUNCTION NINTH (POSITION : IN NATURAL) 
-                             RETURN NINTH_TYPE ;
-         NINTH_VALUE : IN NATURAL ;
-         TYPE TENTH_TYPE IS PRIVATE ;
-         WITH FUNCTION TENTH (POSITION : IN NATURAL) 
-                             RETURN TENTH_TYPE ;
-         TENTH_VALUE : IN NATURAL ;
-         TYPE ELEVENTH_TYPE IS PRIVATE ;
-         WITH FUNCTION ELEVENTH (POSITION : IN NATURAL) 
-                             RETURN ELEVENTH_TYPE ;
-         ELEVENTH_VALUE : IN NATURAL ;
-         TYPE TWELFTH_TYPE IS PRIVATE ;
-         WITH FUNCTION TWELFTH (POSITION : IN NATURAL) 
-                             RETURN TWELFTH_TYPE ;
-         TWELFTH_VALUE : IN NATURAL ;
-         TYPE THIRTEENTH_TYPE IS PRIVATE ;
-         WITH FUNCTION THIRTEENTH (POSITION : IN NATURAL) 
-                             RETURN THIRTEENTH_TYPE ;
-         THIRTEENTH_VALUE : IN NATURAL ;
-         TYPE FOURTEENTH_TYPE IS PRIVATE ;
-         WITH FUNCTION FOURTEENTH (POSITION : IN NATURAL) 
-                             RETURN FOURTEENTH_TYPE ;
-         FOURTEENTH_VALUE : IN NATURAL ;
-         TYPE FIFTEENTH_TYPE IS PRIVATE ;
-         WITH FUNCTION FIFTEENTH (POSITION : IN NATURAL) 
-                             RETURN FIFTEENTH_TYPE ;
-         FIFTEENTH_VALUE : IN NATURAL ;
-         TYPE SIXTEENTH_TYPE IS PRIVATE ;
-         WITH FUNCTION SIXTEENTH (POSITION : IN NATURAL) 
-                             RETURN SIXTEENTH_TYPE ;
-         SIXTEENTH_VALUE : IN NATURAL ;
-         
-     PACKAGE ORDER_PACKAGE IS
-     
-         A : FIRST_TYPE      := FIRST (FIRST_VALUE) ;
-         B : SECOND_TYPE     := SECOND (SECOND_VALUE) ;
-         C : THIRD_TYPE      := THIRD (THIRD_VALUE) ;
-         D : FOURTH_TYPE     := FOURTH (FOURTH_VALUE) ;
-         E : FIFTH_TYPE      := FIFTH (FIFTH_VALUE) ;
-         F : SIXTH_TYPE      := SIXTH (SIXTH_VALUE) ;
-         G : SEVENTH_TYPE    := SEVENTH (SEVENTH_VALUE) ;
-         H : EIGHTH_TYPE     := EIGHTH (EIGHTH_VALUE) ;
-         I : NINTH_TYPE      := NINTH (NINTH_VALUE) ;
-         J : TENTH_TYPE      := TENTH (TENTH_VALUE) ;
-         K : ELEVENTH_TYPE   := ELEVENTH (ELEVENTH_VALUE) ;
-         L : TWELFTH_TYPE    := TWELFTH (TWELFTH_VALUE) ;
-         M : THIRTEENTH_TYPE := THIRTEENTH (THIRTEENTH_VALUE) ;
-         N : FOURTEENTH_TYPE := FOURTEENTH (FOURTEENTH_VALUE) ;
-         O : FIFTEENTH_TYPE  := FIFTEENTH (FIFTEENTH_VALUE) ;
-         P : SIXTEENTH_TYPE  := SIXTEENTH (SIXTEENTH_VALUE) ;
-         
-     END ORDER_PACKAGE ;
-     
- 
-     FUNCTION BOOL IS NEW NAME (RETURN_TYPE  => BOOLEAN,
-                                RETURN_VALUE => TRUE_VALUE,
-                                POSITION     => 1,
-                                OFFSET       => 8,
-                                WHEN_ELAB    => WHEN_ELABORATED,
-                                INDEX        => LIST_INDEX,
-                                LIST         => LIST,
-                                ORDER_LIST   => ORDER_LIST) ;
-                                
-     FUNCTION INT IS NEW NAME (RETURN_TYPE   => YEAR_TYPE,
-                               RETURN_VALUE  => THIS_YEAR,
-                               POSITION      => 2,
-                               OFFSET        => 8,
-                               WHEN_ELAB     => WHEN_ELABORATED,
-                               INDEX         => LIST_INDEX,
-                               LIST          => LIST,
-                               ORDER_LIST    => ORDER_LIST) ;
-                                
-     FUNCTION FLOAT IS NEW NAME (RETURN_TYPE  => REAL,
-                                 RETURN_VALUE => REAL_VALUE,
-                                 POSITION     => 3,
-                                 OFFSET       => 8,
-                                 WHEN_ELAB    => WHEN_ELABORATED,
-                                 INDEX        => LIST_INDEX,
-                                 LIST         => LIST,
-                                 ORDER_LIST   => ORDER_LIST) ;
-                                
-     FUNCTION CHAR IS NEW NAME (RETURN_TYPE  => CHARACTER,
-                                RETURN_VALUE => CHARACTER_VALUE,
-                                POSITION     => 4,
-                                OFFSET       => 8,
-                                WHEN_ELAB    => WHEN_ELABORATED,
-                                INDEX        => LIST_INDEX,
-                                LIST         => LIST,
-                                ORDER_LIST   => ORDER_LIST) ;
-                                
-     FUNCTION ENUM IS NEW NAME (RETURN_TYPE  => MONTH_TYPE,
-                                RETURN_VALUE => THIS_MONTH,
-                                POSITION     => 5,
-                                OFFSET       => 8,
-                                WHEN_ELAB    => WHEN_ELABORATED,
-                                INDEX        => LIST_INDEX,
-                                LIST         => LIST,
-                                ORDER_LIST   => ORDER_LIST) ;
-                                
-     FUNCTION ARRY IS NEW NAME (RETURN_TYPE  => DUE_DATES,
-                                RETURN_VALUE => REPORT_DATES,
-                                POSITION     => 6,
-                                OFFSET       => 8,
-                                WHEN_ELAB    => WHEN_ELABORATED,
-                                INDEX        => LIST_INDEX,
-                                LIST         => LIST,
-                                ORDER_LIST   => ORDER_LIST) ;
-                                
- 
-     FUNCTION RCRD IS NEW NAME (RETURN_TYPE  => DATE,
-                                RETURN_VALUE => TODAY,
-                                POSITION     => 7,
-                                OFFSET       => 8,
-                                WHEN_ELAB    => WHEN_ELABORATED,
-                                INDEX        => LIST_INDEX,
-                                LIST         => LIST,
-                                ORDER_LIST   => ORDER_LIST) ;
-                                
- 
-     FUNCTION ACSS IS NEW NAME (RETURN_TYPE  => DATE_ACCESS,
-                                RETURN_VALUE => FIRST_DATE,
-                                POSITION     => 8,
-                                OFFSET       => 8,
-                                WHEN_ELAB    => WHEN_ELABORATED,
-                                INDEX        => LIST_INDEX,
-                                LIST         => LIST,
-                                ORDER_LIST   => ORDER_LIST) ;
-                                
-     PACKAGE ELABORATION_ORDER IS NEW ORDER_PACKAGE
-         (FIRST_TYPE            => BOOLEAN,
-          FIRST                 => BOOL,
-          FIRST_VALUE           => 1,
-          THIRD_TYPE            => REAL,
-          THIRD                 => FLOAT,
-          THIRD_VALUE           => 3,
-          SECOND_TYPE           => YEAR_TYPE,    -- ORDERING OF PARAMETERS
-          SECOND                => INT,          -- IS DELIBERATE. 
-          SECOND_VALUE          => 2,
-          FOURTH_TYPE           => CHARACTER,
-          FOURTH                => CHAR,
-          FOURTH_VALUE          => 4,
-          FIFTH_TYPE            => MONTH_TYPE,
-          FIFTH                 => ENUM,
-          FIFTH_VALUE           => 5,
-          SIXTH_TYPE            => DUE_DATES,
-          SIXTH                 => ARRY,
-          SIXTH_VALUE           => 6,
-          SEVENTH_TYPE          => DATE,
-          SEVENTH               => RCRD,
-          SEVENTH_VALUE         => 7,
-          EIGHTH_TYPE           => DATE_ACCESS,
-          EIGHTH                => ACSS,
-          EIGHTH_VALUE          => 8,
-          NINTH_TYPE            => BOOLEAN,
-          NINTH                 => BOOL,
-          NINTH_VALUE           => 9,
-          TENTH_TYPE            => YEAR_TYPE,
-          TENTH                 => INT,
-          TENTH_VALUE           => 10,
-          ELEVENTH_TYPE         => REAL,
-          ELEVENTH              => FLOAT,
-          ELEVENTH_VALUE        => 11,
-          TWELFTH_TYPE          => CHARACTER,
-          TWELFTH               => CHAR,
-          TWELFTH_VALUE         => 12,
-          THIRTEENTH_TYPE       => MONTH_TYPE,
-          THIRTEENTH            => ENUM,
-          THIRTEENTH_VALUE      => 13,
-          FOURTEENTH_TYPE       => DUE_DATES,
-          FOURTEENTH            => ARRY,
-          FOURTEENTH_VALUE      => 14,
-          FIFTEENTH_TYPE        => DATE,
-          FIFTEENTH             => RCRD,
-          FIFTEENTH_VALUE       => 15,
-          SIXTEENTH_TYPE        => DATE_ACCESS,
-          SIXTEENTH             => ACSS,
-          SIXTEENTH_VALUE       => 16) ;
- 
- BEGIN
-      REPORT.TEST("CC3016B", "CHECK THAT AN INSTANCE OF A GENERIC " &
-                  "PACKAGE MUST DECLARE A PACKAGE. CHECK THAT THE " &
-                  "DECLARATIVE ITEMS IN AN INSTANTIATION OF A GENERIC " &
-                  "PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER " &
-                  "DECLARED.");
- 
-      IF ORDER_LIST(1) /= REPORT.IDENT_INT(1) THEN
-           REPORT.FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(2) /= REPORT.IDENT_INT(2) THEN
-           REPORT.FAILED("INTEGER TYPE 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(3) /= REPORT.IDENT_INT(3) THEN
-           REPORT.FAILED("REAL 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(4) /= REPORT.IDENT_INT(4) THEN
-           REPORT.FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(5) /= REPORT.IDENT_INT(5) THEN
-           REPORT.FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(6) /= REPORT.IDENT_INT(6) THEN
-           REPORT.FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(7) /= REPORT.IDENT_INT(7) THEN
-           REPORT.FAILED("RECORD 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(8) /= REPORT.IDENT_INT(8) THEN
-           REPORT.FAILED("ACCESS 1 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(9) /= REPORT.IDENT_INT(9) THEN
-           REPORT.FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(10) /= REPORT.IDENT_INT(10) THEN
-           REPORT.FAILED("INTEGER TYPE 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(11) /= REPORT.IDENT_INT(11) THEN
-           REPORT.FAILED("REAL 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(12) /= REPORT.IDENT_INT(12) THEN
-           REPORT.FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(13) /= REPORT.IDENT_INT(13) THEN
-           REPORT.FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(14) /= REPORT.IDENT_INT(14) THEN
-           REPORT.FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(15) /= REPORT.IDENT_INT(15) THEN
-           REPORT.FAILED("RECORD 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      IF ORDER_LIST(16) /= REPORT.IDENT_INT(16) THEN
-           REPORT.FAILED("ACCESS 2 ELABORATED OUT OF ORDER");
-      END IF;
- 
-      REPORT.RESULT ;
-      
- END CC3016B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- CC3016C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  CHECK THAT AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
- --  PACKAGE. CHECK THAT THE STATEMENTS IN AN INSTANTIATED GENERIC
- --  PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE
- --  DECLARATIONS (IN SPEC AND IN BODY).
- 
- -- HISTORY:
- --         EDWARD V. BERARD, 8 AUGUST 1990
- 
- WITH REPORT;
- 
- PROCEDURE  CC3016C  IS
- 
-     GENERIC
-     
-         TYPE SOME_TYPE IS PRIVATE ;
-         FIRST_INITIAL_VALUE  : IN SOME_TYPE ;
-         SECOND_INITIAL_VALUE : IN SOME_TYPE ;
-         WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
-                                RESULT : OUT SOME_TYPE) ;
-         WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
-                                       RESULT : OUT SOME_TYPE) ;
-         WITH PROCEDURE THIRD_CHANGE (FIRST  : IN SOME_TYPE ;
-                                      RESULT : OUT SOME_TYPE) ;
-         FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
-         SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
-         THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
-         FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
-         FIFTH_EXPECTED_RESULT     : IN SOME_TYPE ;
-         SIXTH_EXPECTED_RESULT     : IN SOME_TYPE ;
-     
-     PACKAGE OUTER IS
- 
-         VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
-         
-         FUNCTION INNER_VARIABLE RETURN SOME_TYPE ;
- 
-         GENERIC
-         
-             INITIAL_VALUE : IN SOME_TYPE ;
-             WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
-                                    RESULT : OUT SOME_TYPE) ;
-             WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
-                                           RESULT : OUT SOME_TYPE) ;
-             FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
-             SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
-             THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
-             FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
-                     
-         PACKAGE INNER  IS
-             VARIABLE : SOME_TYPE := INITIAL_VALUE ;
-         END INNER ;
-         
-     END OUTER ;
- 
- 
-     PACKAGE BODY OUTER IS
- 
-         ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
-         
-         PACKAGE BODY  INNER  IS
-             ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ;
-         BEGIN  -- INNER
- 
-             CHANGE (FIRST  => VARIABLE,
-                     RESULT => VARIABLE) ;
-             CHANGE (FIRST  => ANOTHER_VARIABLE,
-                     RESULT => ANOTHER_VARIABLE) ;
-             OUTER.SECOND_CHANGE (FIRST  => OUTER.VARIABLE,
-                                  RESULT => OUTER.VARIABLE) ;
-             OUTER.CHANGE (FIRST  => OUTER.ANOTHER_VARIABLE,
-                           RESULT => OUTER.ANOTHER_VARIABLE) ;
- 
-             IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR
-                (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR
-                (OUTER.VARIABLE 
-                        /= THIRD_EXPECTED_RESULT) OR
-                (OUTER.ANOTHER_VARIABLE 
-                        /= FOURTH_EXPECTED_RESULT) THEN
-                     REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ;
-             END IF;
- 
-         END INNER ;
- 
-         PACKAGE NEW_INNER IS NEW INNER 
-             (INITIAL_VALUE          => SECOND_INITIAL_VALUE,
-              CHANGE                 => CHANGE,
-              SECOND_CHANGE          => THIRD_CHANGE,
-              FIRST_EXPECTED_RESULT  => FIRST_EXPECTED_RESULT,
-              SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT,
-              THIRD_EXPECTED_RESULT  => THIRD_EXPECTED_RESULT,
-              FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ;
-              
-         FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS
-         BEGIN
-             RETURN NEW_INNER.VARIABLE ;            
-         END INNER_VARIABLE ;
- 
-     BEGIN  -- OUTER
-     
-         SECOND_CHANGE (FIRST  => VARIABLE,
-                        RESULT => VARIABLE) ;
-         SECOND_CHANGE (FIRST  => ANOTHER_VARIABLE,
-                        RESULT => ANOTHER_VARIABLE) ;
-                        
-         IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR
-            (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR
-            (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN
-             REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ;
-         END IF;
- 
-     END OUTER ;
-     
-     PROCEDURE DOUBLE (THIS_VALUE          : IN  INTEGER;
-                       GIVING_THIS_RESULT  : OUT INTEGER) IS
-     BEGIN -- DOUBLE
-         GIVING_THIS_RESULT := 2 * THIS_VALUE ;
-     END DOUBLE ;
-     
-     PROCEDURE ADD_20 (TO_THIS_VALUE      : IN  INTEGER;
-                       GIVING_THIS_RESULT : OUT INTEGER) IS
-     BEGIN -- ADD_20
-         GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ;
-     END ADD_20 ;
-     
-     PROCEDURE TIMES_FIVE (THIS_VALUE          : IN  INTEGER;
-                           GIVING_THIS_RESULT  : OUT INTEGER) IS
-     BEGIN -- TIMES_FIVE
-         GIVING_THIS_RESULT := 5 * THIS_VALUE ;
-     END TIMES_FIVE ;    
-     
- BEGIN -- CC3016C
- 
-     REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " &
-                  "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " &
-                  "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " &
-                  "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ;
-                    
-     LOCAL_BLOCK:
-     
-     DECLARE
-     
-         PACKAGE NEW_OUTER IS NEW OUTER
-             (SOME_TYPE                 => INTEGER,
-             FIRST_INITIAL_VALUE        => 7,
-             SECOND_INITIAL_VALUE       => 11,
-             CHANGE                     => DOUBLE,
-             SECOND_CHANGE              => ADD_20,
-             THIRD_CHANGE               => TIMES_FIVE,
-             FIRST_EXPECTED_RESULT      => 22, 
-             SECOND_EXPECTED_RESULT     => 22,
-             THIRD_EXPECTED_RESULT      => 27,
-             FOURTH_EXPECTED_RESULT     => 14,
-             FIFTH_EXPECTED_RESULT      => 47,
-             SIXTH_EXPECTED_RESULT      => 34) ;
- 
-     BEGIN  -- LOCAL_BLOCK    
-     
-         IF (NEW_OUTER.VARIABLE /= 47) OR
-            (NEW_OUTER.INNER_VARIABLE /= 22) THEN
-             REPORT.FAILED("ASSIGNED VALUES INCORRECT - " &
-                           "BODY OF MAIN PROGRAM") ;
-         END IF;
-         
-     END LOCAL_BLOCK ;
- 
-     REPORT.RESULT;
- 
- END CC3016C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- CC3016F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- 
- -- OBJECTIVE:
- --   CHECK THAT AN INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
- --   OF A PACKAGE.
- 
- --   CHECK THAT IF THE PARENT TYPE IN A DERIVED TYPE DEFINITION IS
- --   A GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE DERIVED
- --   TYPE IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE
- --   FORMAL TYPE.  THE OPERATIONS DECLARED FOR DERIVED TYPE IN THE
- --   INSTANCE ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL
- --   PARAMETER.  SEE AI-00398.
- 
- -- HISTORY:
- --   DAS  8 OCT 90   INITIAL VERSION.
- --   JRL 02/19/93  ADDED USE CLAUSES FOR INSTANCES TO ENSURE DIRECT
- --                 OPERATOR VISIBILITY. CHANGED NT4'LAST TO P4.NT4'LAST
- --                 IN ASSIGNMENT STATEMENT FOR P4.X IN EXAMPLE_4.
- --                 CORRECTED ABE ERRORS IN EXAMPLE_2 AND EXAMPLE_3.
- --                 CHANGED R3."+" FROM MULTIPLICATION TO SUBTRACTION TO
- --                 AVOID CONSTRAINT_ERROR.
- 
- WITH REPORT;
- 
- PROCEDURE CC3016F IS
- BEGIN
-      REPORT.TEST ("CC3016F", "CHECK THAT IF THE PARENT TYPE IN A " &
-                              "DERIVED TYPE DEFINITION IS A GENERIC " &
-                              "FORMAL TYPE, THE OPERATIONS DECLARED " &
-                              "FOR THE DERIVED TYPE IN THE TEMPLATE " &
-                              "ARE DETERMINED BY THE DECLARATION OF " &
-                              "THE FORMAL TYPE, AND THAT THE " &
-                              "OPERATIONS DECLARED FOR THE DERIVED " &
-                              "TYPE IN THE INSTANCE ARE DETERMINED BY " &
-                              "THE ACTUAL TYPE DENOTED BY THE FORMAL " &
-                              "PARAMETER (AI-00398)");
- EXAMPLE_2:
-      DECLARE
-           GENERIC
-                TYPE PRIV IS PRIVATE;
-           PACKAGE GP2 IS
-                TYPE NT2 IS NEW PRIV;
-           END GP2;
- 
-           PACKAGE R2 IS
-                TYPE T2 IS RANGE 1..10;
-                FUNCTION F RETURN T2;
-           END R2;
- 
-           PACKAGE P2 IS NEW GP2 (PRIV => R2.T2);
-           USE P2;
- 
-           XX1 : P2.NT2;
-           XX2 : P2.NT2;
-           XX3 : P2.NT2;
- 
-           PACKAGE BODY R2 IS
-                FUNCTION F RETURN T2 IS
-                BEGIN
-                     RETURN T2'LAST;
-                END F;
-           END R2;
-      BEGIN
-           XX1 := 5;                   -- IMPLICIT CONVERSION FROM
-                                       -- UNIVERSAL INTEGER TO P2.NT2
-                                       -- IN P2.
-           XX2 := XX1 + XX1;           -- PREDEFINED "+" DECLARED FOR
-                                       -- P2.NT2.
-           XX3 := P2.F;                -- FUNCTION F DERIVED WITH THE
-                                       -- INSTANCE.
- 
-      END EXAMPLE_2;
- 
- EXAMPLE_3:
-      DECLARE
-           GENERIC
-                TYPE T3 IS RANGE <>;
-           PACKAGE GP3 IS
-                TYPE NT3 IS NEW T3;
-                X : NT3 := 5;
-                Y : NT3 := X + 3;      -- USES PREDEFINED "+" EVEN IN
-                                       -- INSTANCES
-           END GP3;
- 
-           PACKAGE R3 IS
-                TYPE S IS RANGE 1..10;
-                FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S;
-           END R3;
- 
-           PACKAGE P3 IS NEW GP3 ( T3 => R3.S );
-           USE P3;
- 
-           Z : P3.NT3;
- 
-           PACKAGE BODY R3 IS
-                FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S IS
-                BEGIN  -- IMPLEMENT AS SUBTRACTION, NOT ADDITION
-                     RETURN LEFT - RIGHT;
-                END "+";
-           END R3;
-      BEGIN
-           Z := P3.X + 3;     -- USES REDEFINED "+"
- 
-           IF ( P3.Y /= P3.NT3'(8) ) THEN
-                REPORT.FAILED ("PREDEFINED ""+"" NOT USED TO COMPUTE " &
-                              "P3.Y");
-           END IF;
- 
-           IF (Z /= P3.NT3'(2) ) THEN
-                REPORT.FAILED ("REDEFINED ""+"" NOT USED TO COMPUTE Z");
-           END IF;
-      END EXAMPLE_3;
- 
- EXAMPLE_4:
-      DECLARE
-           GENERIC
-                TYPE T4 IS LIMITED PRIVATE;
-           PACKAGE GP4 IS
-                TYPE NT4 IS NEW T4;
-                X : NT4;
-           END GP4;
- 
-           PACKAGE P4 IS NEW GP4 (BOOLEAN);
-           USE P4;
- 
-      BEGIN
-           P4.X := P4.NT4'LAST;
-           IF ( P4.X  OR (NOT P4.X) ) THEN
-                REPORT.COMMENT ("P4.X CORRECTLY HAS A BOOLEAN TYPE");
-           END IF;
-      END EXAMPLE_4;
- 
- EXAMPLE_5:
-      DECLARE
-           GENERIC
-                TYPE T5 (D : POSITIVE) IS PRIVATE;
-           PACKAGE GP5 IS
-                TYPE NT5 IS NEW T5;
-                X : NT5 (D => 5);
-                Y : POSITIVE := X.D;  -- REFERS TO DISCRIMINANT OF NT5
-           END GP5;
- 
-           TYPE REC (A : POSITIVE) IS
-                RECORD
-                     D : POSITIVE := 7;
-                END RECORD;
-           PACKAGE P5 IS NEW GP5 (T5 => REC);
-                -- P5.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
-                -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
-                -- T5 WHICH DENOTES REC.
- 
-           W1 : POSITIVE := P5.X.D;     -- VALUE IS 7
-           W2 : POSITIVE := P5.X.A;     -- VALUE IS 5
-           W3 : POSITIVE := P5.Y;       -- VALUE IS 5;
-      BEGIN
-           IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR  (W3 /= 5 ) ) THEN
-                REPORT.FAILED ("INCORRECT COMPONENT SELECTION");
-           END IF;
-      END EXAMPLE_5;
- 
-      REPORT.RESULT;
- 
- END CC3016F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3016i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3016i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- CC3016I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --   CHECK THAT AN INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
- --   OF A PACKAGE.
- 
- --   CHECK THAT IF THE DESIGNATED TYPE OF AN ACCESS TYPE IS A GENERIC
- --   FORMAL TYPE, OR IS A TYPE DERIVED DIRECTLY OR INDIRECTLY FROM A
- --   GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE ACCESS TYPE
- --   IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE FORMAL
- --   TYPE.  THE OPERATIONS DECLARED FOR ACCESS TYPE IN THE INSTANCE
- --   ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL PARAMETER.
- --   SEE AI-00398.
- 
- -- HISTORY:
- --   DAS  8 OCT 90   INITIAL VERSION.
- 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3016I IS
- BEGIN
-      TEST("CC3016I", "CHECK THAT AN INSTANTIATED PACKAGE HAS THE " &
-           "PROPERTIES REQUIRED OF A PACKAGE.");
- 
- EXAMPLE_5A:
-      DECLARE
-           GENERIC
-                TYPE T5A (D : POSITIVE) IS PRIVATE;
-           PACKAGE GP5A IS
-                TYPE NT5A IS NEW T5A;
-                X : NT5A (D => 5);
-                Y : POSITIVE := X.D;  -- REFERS TO DISCRIMINANT OF NT5A
-           END GP5A;
- 
-           TYPE REC (A : POSITIVE) IS
-                RECORD
-                     D : POSITIVE := 7;
-                END RECORD;
-           PACKAGE P5A IS NEW GP5A (T5A => REC);
-                -- P5A.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
-                -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
-                -- T5A WHICH DENOTES REC.
- 
-           W1 : POSITIVE := P5A.X.D;    -- VALUE IS 7
-           W2 : POSITIVE := P5A.X.A;    -- VALUE IS 5
-           W3 : POSITIVE := P5A.Y;      -- VALUE IS 5;
-      BEGIN
-           IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR  (W3 /= 5 ) ) THEN
-                FAILED ("INCORRECT COMPONENT SELECTION - ACCESS");
-           END IF;
-      END EXAMPLE_5A;
- 
-      RESULT;
-  
- END CC3016I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,470 ****
- -- CC3017B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
- -- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
- -- DECLARE A FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT RAISED
- -- IF THE DEFAULT VALUE FOR A FORMAL PARAMETER DOES NOT SATISFY
- -- THE CONSTRAINTS OF THE SUBTYPE_INDICATION WHEN THE     
- -- DECLARATION IS ELABORATED, ONLY WHEN THE DEFAULT IS USED.   
- 
- --   SUBTESTS ARE:
- --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
- --            INITIALIZED WITH A STATIC AGGREGATE.
- --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
- --            INITIALIZED WITH A STATIC VALUE.
- --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
- --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
- --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
- --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
- --            WITH A STATIC AGGREGATE.
- --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
- --            INITIALIZED WITH A STATIC AGGREGATE.
- 
- -- EDWARD V. BERARD, 7 AUGUST 1990
- 
- WITH REPORT;
- 
- PROCEDURE CC3017B IS
- 
- BEGIN
- 
-      REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " &
-                   "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
-                   "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
-                   "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " &
-                   "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " &
-                   "CONSTRAINTS ON A FORMAL PARAMETER");
- 
-      --------------------------------------------------
- 
-      NONSTAT_ARRAY_PARMS:
-      
-      DECLARE
-      
- --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
- --            INITIALIZED WITH A STATIC AGGREGATE.
- 
-           TYPE NUMBER IS RANGE 1 .. 100 ;
-           
-           GENERIC
-           
-             TYPE INTEGER_TYPE IS RANGE <> ;
-             LOWER : IN INTEGER_TYPE ;
-             UPPER : IN INTEGER_TYPE ;
-           
-           PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
-                         SECOND : IN INTEGER_TYPE) ;
- 
-           PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
-                         SECOND : IN INTEGER_TYPE) IS
-                         
-                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST,
-                                  INTEGER_TYPE RANGE LOWER .. SECOND)
-                                          OF INTEGER_TYPE;
- 
-                PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER)))
-                     IS
-                BEGIN
-                     REPORT.FAILED ("BODY OF PA1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          REPORT.FAILED ("EXCEPTION RAISED IN PA1");
-                END PA1;
- 
-           BEGIN  -- PA
-                PA1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1");
-           END PA;
-           
-           PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER,
-                                       LOWER        => 1,
-                                       UPPER        => 50) ;
- 
-      BEGIN   -- NONSTAT_ARRAY_PARMS
-      
-           NEW_PA (FIRST  => NUMBER (25),
-                   SECOND => NUMBER (75));
-           
-      EXCEPTION
-           WHEN OTHERS =>
-                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA");
-                
-      END NONSTAT_ARRAY_PARMS ;   
-      
-      --------------------------------------------------
- 
-      SCALAR_NON_STATIC:
-      
-      DECLARE
-      
- --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
- --            INITIALIZED WITH A STATIC VALUE.
- 
-           TYPE NUMBER IS RANGE 1 .. 100 ;
-           
-           GENERIC
-           
-             TYPE INTEGER_TYPE IS RANGE <> ;
-             STATIC_VALUE : IN INTEGER_TYPE ;
-           
-           PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
-                         UPPER  : IN INTEGER_TYPE) ;
- 
-           PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
-                         UPPER  : IN INTEGER_TYPE) IS
- 
-                SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ;
- 
-                PROCEDURE PB1 (I : INT := STATIC_VALUE) IS
-                BEGIN  -- PB1
-                     REPORT.FAILED ("BODY OF PB1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          REPORT.FAILED ("EXCEPTION RAISED IN PB1");
-                END PB1;
- 
-           BEGIN  -- PB
-                PB1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1");
-           END PB;
- 
-           PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER,
-                                       STATIC_VALUE => 20) ;
- 
-      BEGIN   -- SCALAR_NON_STATIC
-           
-           NEW_PB (LOWER  => NUMBER (25),
-                   UPPER  => NUMBER (75));
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB");
-      END SCALAR_NON_STATIC ; 
- 
-      --------------------------------------------------
- 
-      REC_NON_STAT_COMPS:
-      
-      DECLARE
-      
- --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
- --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
- 
-           TYPE NUMBER IS RANGE 1 .. 100 ;
-           
-           GENERIC
-           
-             TYPE INTEGER_TYPE IS RANGE <> ;
-             F_STATIC_VALUE : IN INTEGER_TYPE ;
-             S_STATIC_VALUE : IN INTEGER_TYPE ;
-             T_STATIC_VALUE : IN INTEGER_TYPE ;
-             L_STATIC_VALUE : IN INTEGER_TYPE ;
-           
-           PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
-                         UPPER  : IN INTEGER_TYPE) ;
- 
-           PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
-                         UPPER  : IN INTEGER_TYPE) IS
-                         
-                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
-                        RANGE LOWER .. UPPER ;
-                TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
-                      SUBINTEGER_TYPE ;
-                TYPE REC IS
-                     RECORD
-                          FIRST  : SUBINTEGER_TYPE ;
-                          SECOND : AR1 ;
-                     END RECORD;
- 
-                PROCEDURE PC1 (R : REC := (F_STATIC_VALUE,
-                                          (S_STATIC_VALUE,
-                                           T_STATIC_VALUE,
-                                           L_STATIC_VALUE))) IS
-                BEGIN  -- PC1
-                     REPORT.FAILED ("BODY OF PC1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          REPORT.FAILED ("EXCEPTION RAISED IN PC1");
-                END PC1;
- 
-           BEGIN  -- PC
-                PC1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1");
-           END PC;
-          
-           PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER,
-                                       F_STATIC_VALUE => 15,
-                                       S_STATIC_VALUE => 19,
-                                       T_STATIC_VALUE => 85,
-                                       L_STATIC_VALUE => 99) ;
- 
-      BEGIN   -- REC_NON_STAT_COMPS
-           NEW_PC (LOWER => 20,
-                   UPPER => 80);
-      EXCEPTION
-           WHEN OTHERS =>
-                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC");
-      END REC_NON_STAT_COMPS ;
- 
-      --------------------------------------------------
- 
-      FIRST_STATIC_ARRAY:
- 
-      DECLARE
-      
- --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
- --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
- --            WITH A STATIC AGGREGATE.
- 
-           TYPE NUMBER IS RANGE 1 .. 100 ;
-           
-           GENERIC
-           
-             TYPE INTEGER_TYPE IS RANGE <> ;
-             F_STATIC_VALUE : IN INTEGER_TYPE ;
-             S_STATIC_VALUE : IN INTEGER_TYPE ;
-             T_STATIC_VALUE : IN INTEGER_TYPE ;
-             L_STATIC_VALUE : IN INTEGER_TYPE ;
-             A_STATIC_VALUE : IN INTEGER_TYPE ;
-             B_STATIC_VALUE : IN INTEGER_TYPE ;
-             C_STATIC_VALUE : IN INTEGER_TYPE ;
-             D_STATIC_VALUE : IN INTEGER_TYPE ;
-           
-           PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
-                          UPPER  : IN INTEGER_TYPE) ;
- 
-           PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
-                          UPPER  : IN INTEGER_TYPE) IS
-                          
-                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
-                        RANGE LOWER .. UPPER ;
- 
-                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
-                                        F_STATIC_VALUE .. S_STATIC_VALUE,
-                                  INTEGER_TYPE RANGE
-                                        T_STATIC_VALUE .. L_STATIC_VALUE)
-                        OF SUBINTEGER_TYPE ;
- 
-                PROCEDURE P1D1 (A : A1 :=
-                            ((A_STATIC_VALUE, B_STATIC_VALUE),
-                            (C_STATIC_VALUE, D_STATIC_VALUE))) IS
-                BEGIN  -- P1D1
-                     REPORT.FAILED ("BODY OF P1D1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          REPORT.FAILED ("EXCEPTION RAISED IN P1D1");
-                END P1D1;
- 
-           BEGIN  -- P1D
-                P1D1 ;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1");
-           END P1D;
-           
-           PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER,
-                                         F_STATIC_VALUE => 21,
-                                         S_STATIC_VALUE => 37,
-                                         T_STATIC_VALUE => 67,
-                                         L_STATIC_VALUE => 79,
-                                         A_STATIC_VALUE => 11,
-                                         B_STATIC_VALUE => 88,
-                                         C_STATIC_VALUE => 87,
-                                         D_STATIC_VALUE => 13) ;
- 
-      BEGIN  -- FIRST_STATIC_ARRAY
-           NEW_P1D (LOWER => 10,
-                      UPPER => 90);
-      EXCEPTION
-           WHEN OTHERS =>
-                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D");
-      END FIRST_STATIC_ARRAY ;
- 
-      --------------------------------------------------
- 
-      SECOND_STATIC_ARRAY:
-      
-      DECLARE
-      
- --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
- --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
- --            WITH A STATIC AGGREGATE.
- 
-           TYPE NUMBER IS RANGE 1 .. 100 ;
-           
-           GENERIC
-           
-             TYPE INTEGER_TYPE IS RANGE <> ;
-             F_STATIC_VALUE : IN INTEGER_TYPE ;
-             S_STATIC_VALUE : IN INTEGER_TYPE ;
-             T_STATIC_VALUE : IN INTEGER_TYPE ;
-             L_STATIC_VALUE : IN INTEGER_TYPE ;
-             A_STATIC_VALUE : IN INTEGER_TYPE ;
-             B_STATIC_VALUE : IN INTEGER_TYPE ;
-           
-           PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
-                          UPPER  : IN INTEGER_TYPE) ;
- 
-           PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
-                          UPPER  : IN INTEGER_TYPE) IS
-                          
-                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
-                        RANGE LOWER .. UPPER ;
- 
-                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
-                                        F_STATIC_VALUE .. S_STATIC_VALUE,
-                                  INTEGER_TYPE RANGE
-                                        T_STATIC_VALUE .. L_STATIC_VALUE)
-                        OF SUBINTEGER_TYPE ;
- 
-                PROCEDURE P2D1 (A : A1 :=
-                                    (F_STATIC_VALUE .. S_STATIC_VALUE =>
-                                    (A_STATIC_VALUE, B_STATIC_VALUE))) IS
-                BEGIN  -- P2D1
-                     REPORT.FAILED ("BODY OF P2D1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          REPORT.FAILED ("EXCEPTION RAISED IN P2D1");
-                END P2D1;
- 
-           BEGIN  -- P2D
-                P2D1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1");
-           END P2D;
-           
-           PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER,
-                                         F_STATIC_VALUE => 21,
-                                         S_STATIC_VALUE => 37,
-                                         T_STATIC_VALUE => 67,
-                                         L_STATIC_VALUE => 79,
-                                         A_STATIC_VALUE => 7,
-                                         B_STATIC_VALUE => 93) ;
- 
-      BEGIN  -- SECOND_STATIC_ARRAY
-           NEW_P2D (LOWER => 5,
-                    UPPER => 95);
-      EXCEPTION
-           WHEN OTHERS =>
-                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D");
-      END SECOND_STATIC_ARRAY ;
- 
-      --------------------------------------------------
- 
-      REC_NON_STATIC_CONS:
-      
-      DECLARE
-      
- --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
- --            INITIALIZED WITH A STATIC AGGREGATE.
- 
-           TYPE NUMBER IS RANGE 1 .. 100 ;
-           
-           GENERIC
-           
-             TYPE INTEGER_TYPE IS RANGE <> ;
-             F_STATIC_VALUE : IN INTEGER_TYPE ;
-             S_STATIC_VALUE : IN INTEGER_TYPE ;
-             T_STATIC_VALUE : IN INTEGER_TYPE ;
-             L_STATIC_VALUE : IN INTEGER_TYPE ;
-             D_STATIC_VALUE : IN INTEGER_TYPE ;
-           
-           PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
-                         UPPER  : IN INTEGER_TYPE) ;
- 
-           PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
-                         UPPER  : IN INTEGER_TYPE) IS
-                         
-                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
-                        RANGE LOWER .. UPPER ;
-                TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
-                      SUBINTEGER_TYPE ;
-                     
-                TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS
-                     RECORD
-                          FIRST  : SUBINTEGER_TYPE ;
-                          SECOND : AR1 ;
-                     END RECORD ;
- 
-                SUBTYPE REC4 IS REC (LOWER) ;
- 
-                PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE,
-                                            F_STATIC_VALUE,
-                                           (S_STATIC_VALUE,
-                                            T_STATIC_VALUE,
-                                            L_STATIC_VALUE))) IS
-                BEGIN  -- PE1
-                     REPORT.FAILED ("BODY OF PE1 EXECUTED");
-                EXCEPTION
-                     WHEN OTHERS =>
-                          REPORT.FAILED ("EXCEPTION RAISED IN PE1");
-                END PE1;
- 
-           BEGIN  -- PE
-                PE1;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1");
-           END PE;
- 
-           PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER,
-                                       F_STATIC_VALUE => 37,
-                                       S_STATIC_VALUE => 21,
-                                       T_STATIC_VALUE => 67,
-                                       L_STATIC_VALUE => 79,
-                                       D_STATIC_VALUE => 44) ;
- 
-      BEGIN  -- REC_NON_STATIC_CONS
-           NEW_PE  (LOWER => 2,
-                    UPPER => 99);
-      EXCEPTION
-           WHEN OTHERS =>
-                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE");
-      END REC_NON_STATIC_CONS ;
- 
-      --------------------------------------------------
- 
-      REPORT.RESULT;
- 
- END CC3017B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,336 ****
- -- CC3017C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
- --     PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
- --     DECLARE A FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS
- --     ARE COPIED.
- --
- --     SUBTESTS ARE:
- --         (A) SCALAR PARAMETERS TO PROCEDURES.
- --         (B) SCALAR PARAMETERS TO FUNCTIONS.
- --         (C) ACCESS PARAMETERS TO PROCEDURES.
- --         (D) ACCESS PARAMETERS TO FUNCTIONS.
- 
- -- HISTORY:
- --     EDWARD V. BERARD, 7 AUGUST 1990
- --     CJJ 10/16/90  ADJUSTED LINES THAT WERE TOO LONG; REFORMATTED
- --                   HEADER TO CONFORM TO ACVC STANDARDS.
- --
- 
- WITH REPORT;
- PROCEDURE CC3017C IS
- 
- BEGIN
-      REPORT.TEST ("CC3017C", "CHECK THAT AN INSTANCE OF A GENERIC " &
-                   "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
-                   "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
-                   "FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS " &
-                   "ARE COPIED");
- 
-      --------------------------------------------------
- 
-      SCALAR_TO_PROCS:
-      
-      DECLARE
- 
- --        (A) SCALAR PARAMETERS TO PROCEDURES.
- 
-           TYPE NUMBER IS RANGE 0 .. 120 ;
-           VALUE : NUMBER ;
-           E     : EXCEPTION ;
- 
-           GENERIC
-           
-             TYPE SCALAR_ITEM IS RANGE <> ;
-             
-           PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
-                        P_OUT     : OUT SCALAR_ITEM ;
-                        P_IN_OUT : IN OUT SCALAR_ITEM) ;
-                        
-           PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
-                        P_OUT     : OUT SCALAR_ITEM ;
-                        P_IN_OUT : IN OUT SCALAR_ITEM) IS
- 
-                STORE  : SCALAR_ITEM ;
- 
-           BEGIN  -- P
- 
-                STORE := P_IN;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
- 
-                P_OUT := 10;
-                IF (P_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO SCALAR OUT " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
-                END IF;
- 
-                P_IN_OUT := P_IN_OUT + 100;
-                IF (P_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
-                END IF;
- 
-                VALUE := VALUE + 1;
-                IF (P_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                END IF;
- 
-                RAISE E;  -- CHECK EXCEPTION HANDLING.
-           END P;
-           
-           PROCEDURE NEW_P IS NEW P (SCALAR_ITEM => NUMBER) ;
- 
-      BEGIN  -- SCALAR_TO_PROCS
-           VALUE := 0;   -- INITIALIZE VALUE SO VARIOUS CASES CAN BE DETECTED.
-           
-           NEW_P (P_IN     => VALUE,
-                  P_OUT    => VALUE,
-                  P_IN_OUT => VALUE);
-           
-           REPORT.FAILED ("EXCEPTION NOT RAISED - SCALARS TO PROCEDURES");
-      EXCEPTION
-           WHEN E =>
-                IF (VALUE /= 1) THEN
-                     CASE VALUE IS
-                          WHEN 11  =>
-                               REPORT.FAILED ("OUT ACTUAL SCALAR " &
-                                              "PARAMETER CHANGED GLOBAL VALUE");
-                          WHEN 101 =>
-                               REPORT.FAILED ("IN OUT ACTUAL SCALAR " &
-                                              "PARAMETER CHANGED GLOBAL VALUE");
-                          WHEN 111 =>
-                               REPORT.FAILED ("OUT AND IN OUT ACTUAL " &
-                                              "SCALAR PARAMETERS CHANGED " &
-                                              "GLOBAL VALUE");
-                          WHEN OTHERS =>
-                               REPORT.FAILED ("UNDETERMINED CHANGE TO " &
-                                              "GLOBAL VALUE");
-                     END CASE;
-                END IF;
-           WHEN OTHERS =>
-               REPORT.FAILED ("WRONG EXCEPTION RAISED - SCALARS TO PROCEDURES");
-      END SCALAR_TO_PROCS ;
- 
-      --------------------------------------------------
- 
-      SCALAR_TO_FUNCS:
-      
-      DECLARE
- 
- --        (B) SCALAR PARAMETERS TO FUNCTIONS.
- 
-           TYPE NUMBER IS RANGE 0 .. 101 ;
-           FIRST  : NUMBER ;
-           SECOND : NUMBER ;
- 
-           GENERIC
-           
-               TYPE ITEM IS RANGE <> ;
-             
-           FUNCTION F (F_IN : IN ITEM) RETURN ITEM ;
-           
-           FUNCTION F (F_IN : IN ITEM) RETURN ITEM IS
- 
-                STORE  : ITEM := F_IN;
- 
-           BEGIN  -- F
- 
-                FIRST := FIRST + 1;
-                IF (F_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL FUNCTION " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                END IF;
- 
-                RETURN (100);
-           END F;
-           
-           FUNCTION NEW_F IS NEW F (ITEM => NUMBER) ;
- 
-      BEGIN  -- SCALAR_TO_FUNCS
-           FIRST  := 100 ;
-           SECOND := NEW_F (FIRST) ;
-      END SCALAR_TO_FUNCS ;
- 
-      --------------------------------------------------
- 
-      ACCESS_TO_PROCS:
-      
-      DECLARE
- 
- --        (C) ACCESS PARAMETERS TO PROCEDURES.
- 
-           TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                                SEP, OCT, NOV, DEC) ;
-           TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-           TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-           TYPE DATE IS RECORD
-               MONTH : MONTH_TYPE ;
-               DAY   : DAY_TYPE ;
-               YEAR  : YEAR_TYPE ;
-           END RECORD ;
-           
-           TYPE DATE_ACCESS IS ACCESS DATE ;
-           DATE_POINTER : DATE_ACCESS ;
-           
-           E    : EXCEPTION;
-           
-           GENERIC
-           
-             TYPE ITEM IS PRIVATE ;
-             TYPE ACCESS_ITEM IS ACCESS ITEM ;
- 
-           PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;  
-                        P_OUT    : OUT    ACCESS_ITEM ;
-                        P_IN_OUT : IN OUT ACCESS_ITEM) ;
- 
-           PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;  
-                        P_OUT    : OUT    ACCESS_ITEM ;
-                        P_IN_OUT : IN OUT ACCESS_ITEM) IS
- 
-                STORE  : ACCESS_ITEM ;
- 
-           BEGIN  -- P
- 
-                STORE := P_IN ;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
- 
-                DATE_POINTER := NEW DATE'(YEAR  => 1990,
-                                          DAY   => 7,
-                                          MONTH => AUG) ;
-                IF (P_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
-                END IF;
- 
-                P_OUT := NEW ITEM ;
-                IF (P_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO ACCESS OUT " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
-                END IF;
- 
-                P_IN_OUT :=  NEW ITEM ;
-                IF (P_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                END IF;
- 
-                RAISE E;  -- CHECK EXCEPTION HANDLING.
-           END P ;
-           
-           PROCEDURE NEW_P IS NEW P (ITEM         => DATE,
-                                     ACCESS_ITEM  => DATE_ACCESS) ;
- 
-      BEGIN  -- ACCESS_TO_PROCS
-           DATE_POINTER := NEW DATE'(MONTH => DEC,
-                                     DAY   => 25,
-                                     YEAR  => 2000) ;
-                                     
-           NEW_P (P_IN       => DATE_POINTER,
-                    P_OUT    => DATE_POINTER,
-                    P_IN_OUT => DATE_POINTER) ;
-                  
-           REPORT.FAILED ("EXCEPTION NOT RAISED - ACCESS TO PROCEDURES");
-      EXCEPTION
-           WHEN E =>
-                IF (DATE_POINTER.ALL /= (AUG, 7, 1990)) THEN
-                     REPORT.FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
-                                    "PARAMETER VALUE CHANGED DESPITE " &
-                                    "RAISED EXCEPTION");
-                END IF;
-           WHEN OTHERS =>
-                REPORT.FAILED ("WRONG EXCEPTION RAISED - ACCESS TO PROCEDURES");
-      END ACCESS_TO_PROCS ;
- 
-      --------------------------------------------------
- 
-      ACCESS_TO_FUNCS:
-      
-      DECLARE
-      
- --        (D) ACCESS PARAMETERS TO FUNCTIONS.
- 
-           TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                                SEP, OCT, NOV, DEC) ;
-           TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-           TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-           TYPE DATE IS RECORD
-             MONTH : MONTH_TYPE ;
-             DAY   : DAY_TYPE ;
-             YEAR  : YEAR_TYPE ;
-           END RECORD ;
-           
-           TYPE DATE_ACCESS IS ACCESS DATE ;
-           DATE_POINTER : DATE_ACCESS ;
-           NEXT_DATE    : DATE_ACCESS ;
- 
-           GENERIC
-           
-             TYPE ITEM IS PRIVATE ;
-             TYPE ACCESS_ITEM IS ACCESS ITEM ;
- 
-           FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM ;
- 
-           FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM IS
- 
-                STORE  : ACCESS_ITEM := F_IN ;
- 
-           BEGIN  -- F
- 
-                DATE_POINTER := NEW DATE'(YEAR  => 1990,
-                                             DAY   => 7,
-                                          MONTH => AUG) ;
-                IF (F_IN /= STORE) THEN
-                     REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL FUNCTION " &
-                                    "PARAMETER CHANGES THE VALUE OF " &
-                                    "INPUT PARAMETER");
-                END IF;
- 
-                RETURN (NULL);
-           END F ;
-           
-           FUNCTION NEW_F IS NEW F (ITEM        => DATE,
-                                    ACCESS_ITEM => DATE_ACCESS) ;
- 
-      BEGIN  -- ACCESS_TO_FUNCS
-           DATE_POINTER := NULL ;
-           NEXT_DATE    := NEW_F(F_IN => DATE_POINTER) ;
-      END ACCESS_TO_FUNCS ;
- 
-      --------------------------------------------------
- 
-      REPORT.RESULT;
- 
- END CC3017C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,173 ****
- -- CC3019A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT INSTANTIATIONS OF NESTED GENERIC UNITS ARE PROCESSED
- -- CORRECTLY.
- 
- -- JBG 11/6/85
- 
- GENERIC
-      TYPE ELEMENT_TYPE IS PRIVATE;
- PACKAGE CC3019A_QUEUES IS
- 
-      TYPE QUEUE_TYPE IS PRIVATE;
- 
-      PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
-                     VALUE : ELEMENT_TYPE);
- 
-      GENERIC
-           WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
-      PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE);
- 
- PRIVATE
- 
-      TYPE CONTENTS_TYPE IS ARRAY (1..3) OF ELEMENT_TYPE;
-      TYPE QUEUE_TYPE IS
-           RECORD
-                CONTENTS : CONTENTS_TYPE;
-                SIZE     : NATURAL := 0;
-           END RECORD;
- 
- END CC3019A_QUEUES;
- 
- PACKAGE BODY CC3019A_QUEUES IS
- 
-      PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
-                     VALUE : ELEMENT_TYPE) IS
-      BEGIN
-           TO_Q.SIZE := TO_Q.SIZE + 1;
-           TO_Q.CONTENTS(TO_Q.SIZE) := VALUE;
-      END ADD;
- 
- --   GENERIC
- --        WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
-      PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE) IS
-      BEGIN
-           FOR I IN TO_Q.CONTENTS'FIRST .. TO_Q.SIZE LOOP
-                APPLY (TO_Q.CONTENTS(I));
-           END LOOP;
-      END ITERATOR;
- 
- END CC3019A_QUEUES;
- 
- WITH REPORT; USE REPORT;
- WITH CC3019A_QUEUES;
- PROCEDURE CC3019A IS
- 
-      SUBTYPE STR6 IS STRING (1..6);
- 
-      TYPE STR6_ARR IS ARRAY (1..3) OF STR6;
-      STR6_VALS : STR6_ARR := ("111111", "222222",
-                                IDENT_STR("333333"));
-      CUR_STR_INDEX : NATURAL := 1;
- 
-      TYPE INT_ARR IS ARRAY (1..3) OF INTEGER;
-      INT_VALS : INT_ARR := (-1, 3, IDENT_INT(3));
-      CUR_INT_INDEX : NATURAL := 1;
- 
- -- THIS PROCEDURE IS CALLED ONCE FOR EACH ELEMENT OF THE QUEUE
- --
-      PROCEDURE CHECK_STR (VAL : STR6) IS
-      BEGIN
-           IF VAL /= STR6_VALS(CUR_STR_INDEX) THEN
-                FAILED ("STR6 ITERATOR FOR INDEX =" &
-                        INTEGER'IMAGE(CUR_STR_INDEX) & " WITH VALUE " &
-                        """" & VAL & """");
-           END IF;
-           CUR_STR_INDEX := CUR_STR_INDEX + 1;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("STR6 - CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("STR6 - UNEXPECTED EXCEPTION");
-      END CHECK_STR;
- 
-      PROCEDURE CHECK_INT (VAL : INTEGER) IS
-      BEGIN
-           IF VAL /= INT_VALS(CUR_INT_INDEX) THEN
-                FAILED ("INTEGER ITERATOR FOR INDEX =" &
-                        INTEGER'IMAGE(CUR_INT_INDEX) & " WITH VALUE " &
-                        """" & INTEGER'IMAGE(VAL) & """");
-           END IF;
-           CUR_INT_INDEX := CUR_INT_INDEX + 1;
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("INTEGER - CONSTRAINT_ERROR RAISED");
-           WHEN OTHERS =>
-                FAILED ("INTEGER - UNEXPECTED EXCEPTION");
-      END CHECK_INT;
- 
-      PACKAGE STR6_QUEUE IS NEW CC3019A_QUEUES (STR6);
-      USE STR6_QUEUE;
- 
-      PACKAGE INT_QUEUE IS NEW CC3019A_QUEUES (INTEGER);
-      USE INT_QUEUE;
- 
- BEGIN
- 
-      TEST ("CC3019A", "CHECK NESTED GENERICS - ITERATORS");
- 
-      DECLARE
-           Q1 : STR6_QUEUE.QUEUE_TYPE;
- 
-           PROCEDURE CHK_STR IS NEW STR6_QUEUE.ITERATOR (CHECK_STR);
- 
-      BEGIN
- 
-           ADD (Q1, "111111");
-           ADD (Q1, "222222");
-           ADD (Q1, "333333");
- 
-           CUR_STR_INDEX := 1;
-           CHK_STR (Q1);
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - Q1");
-      END;
- 
- -- REPEAT FOR INTEGERS
- 
-      DECLARE
-           Q2 : INT_QUEUE.QUEUE_TYPE;
- 
-           PROCEDURE CHK_INT IS NEW INT_QUEUE.ITERATOR (CHECK_INT);
- 
-      BEGIN
- 
-           ADD (Q2, -1);
-           ADD (Q2, 3);
-           ADD (Q2, 3);
- 
-           CUR_INT_INDEX := 1;
-           CHK_INT (Q2);
- 
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION - Q2");
-      END;
- 
-      RESULT;
- 
- END CC3019A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- CC3019B0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
- --  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
- --
- -- HISTORY:
- --         EDWARD V. BERARD, 31 AUGUST 1990
- 
- GENERIC
-      
-      TYPE ELEMENT IS LIMITED PRIVATE ;
-           
-      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
-                             DESTINATION   : IN OUT ELEMENT) ;
-                                 
-      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
-                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
-                                        
- PACKAGE CC3019B0_LIST_CLASS IS
-      
-      TYPE LIST IS LIMITED PRIVATE ;
-           
-      OVERFLOW    : EXCEPTION ;
-      UNDERFLOW    : EXCEPTION ;
-           
-      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
-                        TO_THIS_LIST        : IN OUT LIST) ;
-                        
-      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
-                        FROM_THIS_LIST    : IN OUT LIST) ;
-                            
-      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
-                        TO_THIS_LIST        : IN OUT LIST) ;
-                            
-      PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
-                                
-      GENERIC
-           
-           WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
-                                   CONTINUE        : OUT BOOLEAN) ;
-                                          
-      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
-                                
-      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
-           RETURN NATURAL ;
-           
-      FUNCTION "=" (LEFT  : IN LIST ;
-                    RIGHT : IN LIST) RETURN BOOLEAN ;
-                
- PRIVATE
-      
-      TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
-           
-      TYPE LIST IS RECORD
-           LENGTH        : NATURAL := 0 ;
-           ACTUAL_LIST   : LIST_TABLE ;
-      END RECORD ;
-           
- END CC3019B0_LIST_CLASS ;
-      
- PACKAGE BODY CC3019B0_LIST_CLASS IS
-      
-      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
-                        TO_THIS_LIST        : IN OUT LIST) IS
-                            
-      BEGIN  -- ADD
-           
-           IF TO_THIS_LIST.LENGTH >= 10 THEN
-                RAISE OVERFLOW ;
-           ELSE
-                TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
-                ASSIGN (
-                     SOURCE      => THIS_ELEMENT,
-                     DESTINATION =>
-                         TO_THIS_LIST.ACTUAL_LIST (TO_THIS_LIST.LENGTH));
-           END IF ;
-           
-      END ADD ;
-                             
-      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
-                        FROM_THIS_LIST    : IN OUT LIST) IS
-                                
-      BEGIN  -- DELETE
-           
-           IF FROM_THIS_LIST.LENGTH <= 0 THEN
-                RAISE UNDERFLOW ;
-           ELSE
-                ASSIGN (
-                     SOURCE      => 
-                       FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
-                     DESTINATION => THIS_ELEMENT) ;
-                FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
-           END IF ;
-           
-      END DELETE ;
-                             
-      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
-                            TO_THIS_LIST        : IN OUT LIST) IS
-                                
-      BEGIN  -- COPY
-           
-           TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
-           FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
-                ASSIGN (
-                     SOURCE      => THIS_LIST.ACTUAL_LIST (INDEX),
-                     DESTINATION => TO_THIS_LIST.ACTUAL_LIST (INDEX)) ;
-           END LOOP ;
-                
-      END COPY ;
-      
-      PROCEDURE CLEAR  (THIS_LIST          : IN OUT LIST) IS
-      
-      BEGIN  -- CLEAR
-      
-           THIS_LIST.LENGTH := 0 ;
-           
-      END CLEAR ;
-                                
-      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) IS
-           
-           CONTINUE : BOOLEAN := TRUE ;
-           FINISHED : NATURAL := 0 ;
-                
-      BEGIN  -- ITERATE
-           
-           WHILE (CONTINUE = TRUE) AND (FINISHED < OVER_THIS_LIST.LENGTH)
-                LOOP
-                     FINISHED := FINISHED + 1 ;
-                     PROCESS (THIS_ELEMENT =>
-                                  OVER_THIS_LIST.ACTUAL_LIST (FINISHED),
-                               CONTINUE     => CONTINUE) ;
-                END LOOP ;
-                     
-      END ITERATE ;
-                
-      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
-           RETURN NATURAL IS
-           
-      BEGIN  -- NUMBER_OF_ELEMENTS
-           
-           RETURN IN_THIS_LIST.LENGTH ;
-                
-      END NUMBER_OF_ELEMENTS ;
-           
-      FUNCTION "=" (LEFT  : IN LIST ;
-                    RIGHT : IN LIST) RETURN BOOLEAN IS
-                       
-           RESULT : BOOLEAN := TRUE ;
-           INDEX  : NATURAL := 0 ;
-           
-      BEGIN  -- "="
-      
-           IF LEFT.LENGTH /= RIGHT.LENGTH THEN
-                RESULT := FALSE ;
-           ELSE
-                WHILE (INDEX < LEFT.LENGTH) AND RESULT LOOP
-                     INDEX := INDEX + 1 ;
-                     IF LEFT.ACTUAL_LIST (INDEX) /=
-                        RIGHT.ACTUAL_LIST (INDEX) THEN
-                          RESULT := FALSE ;
-                     END IF ;
-                END LOOP ;
-           END IF ;
-           
-           RETURN RESULT ;
-           
-      END "=" ;
-                
- END CC3019B0_LIST_CLASS ;          
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- -- CC3019B1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
- --  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED
- --  BY THE MAIN PROCEDURE, I.E., CC3019B2M.ADA.
- --
- -- *** THIS FILE MUST BE COMPILED AFTER CC3019B0.ADA HAS BEEN
- -- *** COMPILED.
- --
- -- HISTORY:
- --         EDWARD V. BERARD, 31 AUGUST 1990
- 
- WITH CC3019B0_LIST_CLASS ;
- 
- GENERIC
-      
-      TYPE ELEMENT IS LIMITED PRIVATE ;
-           
-      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
-                             DESTINATION   : IN OUT ELEMENT) ;
-                                
-      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
-                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
-                                       
- PACKAGE CC3019B1_STACK_CLASS IS
-      
-      TYPE STACK IS LIMITED PRIVATE ;
-           
-      OVERFLOW    : EXCEPTION ;
-      UNDERFLOW   : EXCEPTION ;
-           
-      PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
-                      ON_TO_THIS_STACK    : IN OUT STACK) ;
-                         
-      PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
-                      OFF_THIS_STACK      : IN OUT STACK) ;
-                             
-      PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
-                       TO_THIS_STACK    : IN OUT STACK) ;
-                          
-      PROCEDURE CLEAR (THIS_STACK       : IN OUT STACK) ;
-      
-      GENERIC
-           
-           WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
-                                   CONTINUE        : OUT BOOLEAN) ;
-                                         
-      PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) ;
-                               
-      FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
-           RETURN NATURAL ;
-           
-      FUNCTION "=" (LEFT  : IN STACK ;
-                    RIGHT : IN STACK) RETURN BOOLEAN ;
-                
- PRIVATE
- 
-      PACKAGE NEW_LIST_CLASS IS
-           NEW CC3019B0_LIST_CLASS (ELEMENT => ELEMENT,
-                                    ASSIGN  => ASSIGN,
-                                    "="     => "=") ;
-                                                       
-      TYPE STACK IS NEW NEW_LIST_CLASS.LIST ;
-           
- END CC3019B1_STACK_CLASS ;
-      
- PACKAGE BODY CC3019B1_STACK_CLASS IS
-      
-      PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
-                      ON_TO_THIS_STACK    : IN OUT STACK) IS
-                             
-      BEGIN  -- PUSH
-           
-           NEW_LIST_CLASS.ADD (
-                THIS_ELEMENT    => THIS_ELEMENT,
-                TO_THIS_LIST    =>
-                     NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ;
-                                     
-      EXCEPTION
-      
-           WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ;
-                                     
-      END PUSH ;
-                             
-      PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
-                      OFF_THIS_STACK      : IN OUT STACK) IS
-                             
-      BEGIN  -- POP
-           
-           NEW_LIST_CLASS.DELETE (
-                THIS_ELEMENT      => THIS_ELEMENT,
-                FROM_THIS_LIST    =>
-                          NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ;
-                                        
-      EXCEPTION
-      
-           WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ;
-                                     
-      END POP ;
-                             
-      PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
-                       TO_THIS_STACK    : IN OUT STACK) IS
-                              
-      BEGIN  -- COPY
-           
-           NEW_LIST_CLASS.COPY (
-                THIS_LIST    => NEW_LIST_CLASS.LIST (THIS_STACK),
-                TO_THIS_LIST => NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ;
-                
-      END COPY ;
-      
-      PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) IS
-      
-      BEGIN  -- CLEAR
-      
-           NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ;
-           
-      END CLEAR ;
-      
-      PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) IS
-      
-           PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE
-                (PROCESS => PROCESS) ;
-                
-      BEGIN  -- ITERATE
-      
-           STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ;
-           
-      END ITERATE ;
- 
-      FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
-           RETURN NATURAL IS
-                
-      BEGIN  -- NUMBER_OF_ELEMENTS
-           
-           RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS
-                (IN_THIS_LIST => NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ;
-                     
-      END NUMBER_OF_ELEMENTS ;
-           
-      FUNCTION "=" (LEFT  : IN STACK ;
-                    RIGHT : IN STACK) RETURN BOOLEAN IS
-      
-      BEGIN  -- "="
-      
-           RETURN NEW_LIST_CLASS."=" (
-                LEFT  => NEW_LIST_CLASS.LIST (LEFT),
-                RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ;
-                                        
-      END "=" ;
-                
- END CC3019B1_STACK_CLASS ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,300 ****
- -- CC3019B2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G.,
- --  TO SUPPORT ITERATORS. THIS TEST SPECIFICALLY CHECKS THAT A
- --  NESTING LEVEL OF 2 IS SUPPORTED FOR GENERICS.
- --
- --  *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE
- --  *** SOURCE CODE IN FILES CC3019B0.ADA AND CC3019B1.ADA HAVE
- --  *** BEEN COMPILED.
- --
- -- HISTORY:
- --         EDWARD V. BERARD, 31 AUGUST 1990
- 
- WITH REPORT ;
- WITH CC3019B1_STACK_CLASS ;
- 
- PROCEDURE CC3019B2M IS
- 
-      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                          SEP, OCT, NOV, DEC) ;
-      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-      TYPE DATE IS RECORD
-           MONTH : MONTH_TYPE ;
-           DAY   : DAY_TYPE ;
-           YEAR  : YEAR_TYPE ;
-      END RECORD ;
-      
-      STORE_DATE     : DATE ;
- 
-      TODAY        : DATE := (MONTH => AUG,
-                              DAY   => 31,
-                              YEAR  => 1990) ;
-                                     
-      FIRST_DATE   : DATE := (MONTH => JUN,
-                              DAY   => 4,
-                              YEAR  => 1967) ;
-                                     
-      BIRTH_DATE   : DATE := (MONTH => OCT,
-                              DAY   => 3,
-                              YEAR  => 1949) ;
-                                     
-      WALL_DATE    : DATE := (MONTH => NOV,
-                              DAY   => 9,
-                              YEAR  => 1989) ;
-                                     
-      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
-                        TO_THIS_DATE              : IN OUT DATE) ;
-                               
-      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
-                         RIGHT : IN DATE) RETURN BOOLEAN ;
- 
-      PACKAGE DATE_STACK IS
-           NEW CC3019B1_STACK_CLASS (ELEMENT => DATE,
-                                     ASSIGN  => ASSIGN,
-                                     "="     => IS_EQUAL) ;
-                                                    
-      FIRST_DATE_STACK    : DATE_STACK.STACK ;
-      SECOND_DATE_STACK   : DATE_STACK.STACK ;
-      THIRD_DATE_STACK    : DATE_STACK.STACK ;
-      
-      FUNCTION "=" (LEFT  : IN DATE_STACK.STACK ;
-                    RIGHT : IN DATE_STACK.STACK) RETURN BOOLEAN
-                    RENAMES DATE_STACK."=" ;
-                               
-      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
-                        TO_THIS_DATE              : IN OUT DATE) IS
-                               
-      BEGIN -- ASSIGN
-           
-           TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
-                 
-      END ASSIGN ;
-                                             
-      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
-                         RIGHT : IN DATE) RETURN BOOLEAN IS
-                          
-      BEGIN -- IS_EQUAL
-      
-           RETURN (LEFT.MONTH = RIGHT.MONTH) AND
-                  (LEFT.DAY = RIGHT.DAY) AND
-                  (LEFT.YEAR = RIGHT.YEAR) ;
-           
-      END IS_EQUAL ;
- 
- BEGIN  -- CC3019B2M
- 
-      REPORT.TEST ("CC3019B2M",
-                   "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " &
-                   "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " &
-                   "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF " &
-                   "2 IS SUPPORTED FOR GENERICS.") ;
-                         
-      DATE_STACK.CLEAR (THIS_STACK => FIRST_DATE_STACK) ;
-      IF DATE_STACK.NUMBER_OF_ELEMENTS 
-         (ON_THIS_STACK => FIRST_DATE_STACK) /= 0 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
-      END IF ;
-      
-      DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
-                       ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
-      IF DATE_STACK.NUMBER_OF_ELEMENTS 
-         (ON_THIS_STACK => FIRST_DATE_STACK) /= 1 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
-      END IF ;
-      
-      DATE_STACK.PUSH (THIS_ELEMENT     => FIRST_DATE,
-                       ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
-      IF DATE_STACK.NUMBER_OF_ELEMENTS 
-         (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
-      END IF ;
-      
-      DATE_STACK.PUSH (THIS_ELEMENT     => BIRTH_DATE,
-                       ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
-      IF DATE_STACK.NUMBER_OF_ELEMENTS 
-         (ON_THIS_STACK => FIRST_DATE_STACK) /= 3 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
-      END IF ;
-      
-      DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
-                            OFF_THIS_STACK => FIRST_DATE_STACK) ;
-      IF DATE_STACK.NUMBER_OF_ELEMENTS 
-         (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
-      END IF ;
-      
-      IF STORE_DATE /= BIRTH_DATE THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE REMOVED FROM STACK - 1") ;
-      END IF ;
-      
-      DATE_STACK.CLEAR (THIS_STACK => SECOND_DATE_STACK) ;
-      IF DATE_STACK.NUMBER_OF_ELEMENTS 
-         (ON_THIS_STACK => SECOND_DATE_STACK) /= 0 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
-      END IF ;
-           
-      DATE_STACK.COPY (THIS_STACK    => FIRST_DATE_STACK,
-                       TO_THIS_STACK => SECOND_DATE_STACK) ;
-                              
-      IF FIRST_DATE_STACK /= SECOND_DATE_STACK THEN
-           REPORT.FAILED (
-                "PROBLEMS WITH COPY OR TEST FOR EQUALITY") ;
-      END IF ;
-      
-      DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
-                      OFF_THIS_STACK => SECOND_DATE_STACK) ;
-      DATE_STACK.PUSH (THIS_ELEMENT     => WALL_DATE,
-                       ON_TO_THIS_STACK => SECOND_DATE_STACK) ;
-      IF FIRST_DATE_STACK = SECOND_DATE_STACK THEN
-           REPORT.FAILED (
-                "PROBLEMS WITH POP OR TEST FOR EQUALITY") ;
-      END IF ;
-      
-      UNDERFLOW_EXCEPTION_TEST:
-      
-      BEGIN  -- UNDERFLOW_EXCEPTION_TEST
-      
-           DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
-           DATE_STACK.POP (THIS_ELEMENT      => STORE_DATE,
-                           OFF_THIS_STACK    => THIRD_DATE_STACK) ;
-           REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;
-      
-      EXCEPTION
-      
-           WHEN DATE_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
-                                                -- RAISED
-           WHEN OTHERS =>
-                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
-                               "UNDERFLOW EXCEPTION TEST") ;
-                                               
-      END UNDERFLOW_EXCEPTION_TEST ;
-      
-      OVERFLOW_EXCEPTION_TEST:
-      
-      BEGIN  -- OVERFLOW_EXCEPTION_TEST
-      
-           DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
-           FOR INDEX IN 1 .. 10 LOOP
-                DATE_STACK.PUSH ( THIS_ELEMENT     => TODAY,
-                                  ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
-           END LOOP ;
-           
-           DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
-                            ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
-           REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;
-      
-      EXCEPTION
-      
-           WHEN DATE_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
-                                               -- RAISED
-           WHEN OTHERS =>
-                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
-                               "OVERFLOW EXCEPTION TEST") ;
-                                               
-      END OVERFLOW_EXCEPTION_TEST ;
- 
-      LOCAL_BLOCK:
-      
-      DECLARE
-      
-           TYPE DATE_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF DATE ;
-      
-           FIRST_DATE_TABLE : DATE_TABLE ;
-      
-           TABLE_INDEX : POSITIVE := 1 ;
-      
-           PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
-                                 CONTINUE  : OUT BOOLEAN) ;
-                                       
-           PROCEDURE STORE_DATES (THIS_DATE : IN DATE ;
-                                  CONTINUE  : OUT BOOLEAN) ;
-                                       
-           PROCEDURE SHOW_DATE_ITERATE IS NEW 
-                DATE_STACK.ITERATE (PROCESS => SHOW_DATES) ;
-                                 
-           PROCEDURE STORE_DATE_ITERATE IS NEW 
-                DATE_STACK.ITERATE (PROCESS => STORE_DATES) ;
-                                 
-           PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
-                                 CONTINUE  : OUT BOOLEAN) IS
-           BEGIN  -- SHOW_DATES
-           
-                 REPORT.COMMENT ("THE MONTH IS " &
-                            MONTH_TYPE'IMAGE (THIS_DATE.MONTH)) ;
-                 REPORT.COMMENT ("THE DAY IS " &
-                            DAY_TYPE'IMAGE (THIS_DATE.DAY)) ;
-                 REPORT.COMMENT ("THE YEAR IS " &
-                            YEAR_TYPE'IMAGE (THIS_DATE.YEAR)) ;
-                 
-                 CONTINUE := TRUE ;
-                            
-           END SHOW_DATES ;
-           
-           PROCEDURE STORE_DATES (THIS_DATE : IN  DATE ;
-                                        CONTINUE  : OUT BOOLEAN) IS
-           BEGIN  -- STORE_DATES
-           
-                 FIRST_DATE_TABLE (TABLE_INDEX) := THIS_DATE ;
-                 TABLE_INDEX := TABLE_INDEX + 1 ;
-                 
-                 CONTINUE := TRUE ;
-                 
-           END STORE_DATES ;
-           
-      BEGIN  -- LOCAL_BLOCK
-      
-           REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
-           SHOW_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
- 
-           REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
-           SHOW_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
- 
-           STORE_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
-           IF (FIRST_DATE_TABLE (1) /= TODAY) OR
-                (FIRST_DATE_TABLE (2) /= FIRST_DATE) THEN
-                      REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
-           END IF ;
-           
-           TABLE_INDEX := 1 ;
-           STORE_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
-           IF (FIRST_DATE_TABLE (1) /= TODAY) OR
-                (FIRST_DATE_TABLE (2) /= WALL_DATE) THEN
-                      REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
-           END IF ;
-           
-      END LOCAL_BLOCK ;
-      
-      REPORT.RESULT ;
-      
- END CC3019B2M ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- CC3019C0.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE
- --   THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
- --   NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
- --
- -- HISTORY:
- --         EDWARD V. BERARD, 31 AUGUST 1990
- 
- GENERIC
- 
-      TYPE ELEMENT IS LIMITED PRIVATE ;
- 
-      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
-                             DESTINATION   : IN OUT ELEMENT) ;
- 
-      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
-                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
- 
- PACKAGE CC3019C0_LIST_CLASS IS
- 
-      TYPE LIST IS LIMITED PRIVATE ;
- 
-      OVERFLOW    : EXCEPTION ;
-      UNDERFLOW   : EXCEPTION ;
- 
-      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
-                        TO_THIS_LIST        : IN OUT LIST) ;
- 
-      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
-                        FROM_THIS_LIST    : IN OUT LIST) ;
- 
-      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
-                        TO_THIS_LIST        : IN OUT LIST) ;
- 
-      PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
- 
-      GENERIC
- 
-           WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
-                                   CONTINUE        : OUT BOOLEAN) ;
- 
-      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
- 
-      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
-           RETURN NATURAL ;
- 
-      FUNCTION "=" (LEFT  : IN LIST ;
-                    RIGHT : IN LIST) RETURN BOOLEAN ;
- 
- PRIVATE
- 
-      TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
- 
-      TYPE LIST IS RECORD
-           LENGTH        : NATURAL := 0 ;
-           ACTUAL_LIST   : LIST_TABLE ;
-      END RECORD ;
- 
- END CC3019C0_LIST_CLASS ;
- 
- PACKAGE BODY CC3019C0_LIST_CLASS IS
- 
-      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
-                        TO_THIS_LIST        : IN OUT LIST) IS
- 
-      BEGIN  -- ADD
- 
-           IF TO_THIS_LIST.LENGTH >= 10 THEN
-                RAISE OVERFLOW ;
-           ELSE
-                TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
-                ASSIGN (
-                     SOURCE      => THIS_ELEMENT,
-                     DESTINATION =>
-                          TO_THIS_LIST.ACTUAL_LIST(TO_THIS_LIST.LENGTH));
-           END IF ;
- 
-      END ADD ;
- 
-      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
-                        FROM_THIS_LIST    : IN OUT LIST) IS
- 
-      BEGIN  -- DELETE
- 
-           IF FROM_THIS_LIST.LENGTH <= 0 THEN
-                RAISE UNDERFLOW ;
-           ELSE
-                ASSIGN (
-                     SOURCE      =>
-                       FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
-                     DESTINATION => THIS_ELEMENT) ;
-                FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
-           END IF ;
- 
-      END DELETE ;
- 
-      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
-                        TO_THIS_LIST        : IN OUT LIST) IS
- 
-      BEGIN  -- COPY
- 
-           TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
-           FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
-                ASSIGN (SOURCE      => THIS_LIST.ACTUAL_LIST (INDEX),
-                        DESTINATION => TO_THIS_LIST.ACTUAL_LIST (INDEX));
-           END LOOP ;
- 
-      END COPY ;
- 
-      PROCEDURE CLEAR  (THIS_LIST         : IN OUT LIST) IS
- 
-      BEGIN  -- CLEAR
- 
-           THIS_LIST.LENGTH := 0 ;
- 
-      END CLEAR ;
- 
-      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) IS
- 
-           CONTINUE : BOOLEAN := TRUE ;
-           FINISHED : NATURAL := 0 ;
- 
-      BEGIN  -- ITERATE
- 
-           WHILE (CONTINUE = TRUE) AND (FINISHED < OVER_THIS_LIST.LENGTH)
-                LOOP
-                     FINISHED := FINISHED + 1 ;
-                     PROCESS (THIS_ELEMENT =>
-                                 OVER_THIS_LIST.ACTUAL_LIST (FINISHED),
-                              CONTINUE     => CONTINUE) ;
-                END LOOP ;
- 
-      END ITERATE ;
- 
-      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
-           RETURN NATURAL IS
- 
-      BEGIN  -- NUMBER_OF_ELEMENTS
- 
-           RETURN IN_THIS_LIST.LENGTH ;
- 
-      END NUMBER_OF_ELEMENTS ;
- 
-      FUNCTION "=" (LEFT  : IN LIST ;
-                    RIGHT : IN LIST) RETURN BOOLEAN IS
- 
-           RESULT : BOOLEAN := TRUE ;
-           INDEX  : NATURAL := 0 ;
- 
-      BEGIN  -- "="
- 
-           IF LEFT.LENGTH /= RIGHT.LENGTH THEN
-                RESULT := FALSE ;
-           ELSE
-                WHILE (INDEX < LEFT.LENGTH) AND RESULT LOOP
-                     INDEX := INDEX + 1 ;
-                     IF LEFT.ACTUAL_LIST (INDEX) /=
-                        RIGHT.ACTUAL_LIST (INDEX) THEN
-                         RESULT := FALSE ;
-                     END IF ;
-                END LOOP ;
-           END IF ;
- 
-           RETURN RESULT ;
- 
-      END "=" ;
- 
- END CC3019C0_LIST_CLASS ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,331 ****
- -- CC3019C1.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --  THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
- --  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED
- --  BY MAIN PROCEDURE CC3019C2M.ADA.
- --
- -- HISTORY:
- --         EDWARD V. BERARD, 31 AUGUST 1990
- 
- WITH CC3019C0_LIST_CLASS ;
- 
- GENERIC
- 
-      TYPE ELEMENT IS LIMITED PRIVATE ;
- 
-      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
-                             DESTINATION   : IN OUT ELEMENT) ;
- 
-      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
-                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
- 
- PACKAGE CC3019C1_NESTED_GENERICS IS
- 
-      TYPE NESTED_GENERICS_TYPE IS LIMITED PRIVATE ;
- 
-      PROCEDURE COPY (SOURCE        : IN OUT NESTED_GENERICS_TYPE ;
-                      DESTINATION   : IN OUT NESTED_GENERICS_TYPE) ;
- 
-      PROCEDURE SET_ELEMENT
-                     (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
-                      TO_THIS_ELEMENT     : IN OUT ELEMENT) ;
- 
-      PROCEDURE SET_NUMBER
-                     (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
-                      TO_THIS_NUMBER      : IN NATURAL) ;
- 
-      FUNCTION "=" (LEFT  : IN NESTED_GENERICS_TYPE ;
-                    RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN ;
- 
-      FUNCTION ELEMENT_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
-           RETURN ELEMENT ;
- 
-      FUNCTION NUMBER_OF  (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
-           RETURN NATURAL ;
- 
-      GENERIC
- 
-           TYPE ELEMENT IS LIMITED PRIVATE ;
- 
-           WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
-                                  DESTINATION   : IN OUT ELEMENT) ;
- 
-      PACKAGE GENERIC_TASK IS
- 
-           TASK TYPE PROTECTED_AREA IS
- 
-                     ENTRY STORE (ITEM    : IN OUT ELEMENT) ;
-                     ENTRY GET   (ITEM    : IN OUT ELEMENT) ;
- 
-           END PROTECTED_AREA ;
- 
-      END GENERIC_TASK ;
- 
-      GENERIC
- 
-           TYPE ELEMENT IS LIMITED PRIVATE ;
- 
-           WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
-                                  DESTINATION   : IN OUT ELEMENT) ;
- 
-           WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
-                              RIGHT : IN ELEMENT) RETURN BOOLEAN ;
- 
-      PACKAGE STACK_CLASS IS
- 
-           TYPE STACK IS LIMITED PRIVATE ;
- 
-           OVERFLOW    : EXCEPTION ;
-           UNDERFLOW   : EXCEPTION ;
- 
-           PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
-                           ON_TO_THIS_STACK    : IN OUT STACK) ;
- 
-           PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
-                           OFF_THIS_STACK      : IN OUT STACK) ;
- 
-           PROCEDURE COPY  (THIS_STACK        : IN OUT STACK ;
-                            TO_THIS_STACK    : IN OUT STACK) ;
- 
-           PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) ;
- 
-           GENERIC
- 
-                WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
-                                        CONTINUE        : OUT BOOLEAN) ;
- 
-           PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) ;
- 
-           FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
-                     RETURN NATURAL ;
- 
-           FUNCTION "=" (LEFT  : IN STACK ;
-                         RIGHT : IN STACK) RETURN BOOLEAN ;
- 
-      PRIVATE
- 
-           PACKAGE NEW_LIST_CLASS IS NEW
-                CC3019C0_LIST_CLASS (ELEMENT => ELEMENT,
-                                     ASSIGN  => ASSIGN,
-                                     "="     => "=") ;
- 
-           TYPE STACK IS NEW NEW_LIST_CLASS.LIST ;
- 
-      END STACK_CLASS ;
- 
- PRIVATE
- 
-      TYPE NESTED_GENERICS_TYPE IS RECORD
-           FIRST    : ELEMENT ;
-           SECOND   : NATURAL ;
-      END RECORD ;
- 
- END CC3019C1_NESTED_GENERICS ;
- 
- PACKAGE BODY CC3019C1_NESTED_GENERICS IS
- 
-      PROCEDURE COPY (SOURCE        : IN OUT NESTED_GENERICS_TYPE ;
-                      DESTINATION   : IN OUT NESTED_GENERICS_TYPE) IS
- 
-      BEGIN  -- COPY
- 
-           ASSIGN (SOURCE        => SOURCE.FIRST,
-                   DESTINATION   => DESTINATION.FIRST) ;
- 
-           DESTINATION.SECOND := SOURCE.SECOND ;
- 
-      END COPY ;
- 
-      PROCEDURE SET_ELEMENT
-           (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
-           TO_THIS_ELEMENT     : IN OUT ELEMENT) IS
- 
-      BEGIN  -- SET_ELEMENT
- 
-           ASSIGN (SOURCE        => TO_THIS_ELEMENT,
-                   DESTINATION   => FOR_THIS_NGT_OBJECT.FIRST) ;
- 
-      END SET_ELEMENT ;
- 
-      PROCEDURE SET_NUMBER
-           (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
-           TO_THIS_NUMBER      : IN NATURAL) IS
- 
-      BEGIN  -- SET_NUMBER
- 
-           FOR_THIS_NGT_OBJECT.SECOND := TO_THIS_NUMBER ;
- 
-      END SET_NUMBER ;
- 
-      FUNCTION "=" (LEFT  : IN NESTED_GENERICS_TYPE ;
-                    RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN IS
- 
-      BEGIN  -- "="
- 
-           IF (LEFT.FIRST = RIGHT.FIRST) AND
-              (LEFT.SECOND = RIGHT.SECOND) THEN
-                        RETURN TRUE ;
-           ELSE
-                     RETURN FALSE ;
-           END IF ;
- 
-      END "=" ;
- 
-      FUNCTION ELEMENT_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
-           RETURN ELEMENT IS
- 
-      BEGIN  -- ELEMENT_OF
- 
-           RETURN THIS_NGT_OBJECT.FIRST ;
- 
-      END ELEMENT_OF ;
- 
-      FUNCTION NUMBER_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
-           RETURN NATURAL IS
- 
-      BEGIN  -- NUMBER_OF
- 
-           RETURN THIS_NGT_OBJECT.SECOND ;
- 
-      END NUMBER_OF ;
- 
-      PACKAGE BODY GENERIC_TASK IS
- 
-           TASK BODY PROTECTED_AREA IS
- 
-                LOCAL_STORE : ELEMENT ;
- 
-           BEGIN  -- PROTECTED_AREA
- 
-                LOOP
-                     SELECT
-                          ACCEPT STORE (ITEM    : IN OUT ELEMENT) DO
-                               ASSIGN (SOURCE        => ITEM,
-                                       DESTINATION   => LOCAL_STORE) ;
-                          END STORE ;
-                     OR
-                          ACCEPT GET   (ITEM    : IN OUT ELEMENT) DO
-                               ASSIGN (SOURCE        => LOCAL_STORE,
-                                       DESTINATION   => ITEM) ;
-                          END GET ;
-                     OR
-                          TERMINATE ;
-                     END SELECT ;
-                END LOOP ;
- 
-           END PROTECTED_AREA ;
- 
-      END GENERIC_TASK ;
- 
-      PACKAGE BODY STACK_CLASS IS
- 
-           PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
-                           ON_TO_THIS_STACK    : IN OUT STACK) IS
- 
-           BEGIN  -- PUSH
- 
-               NEW_LIST_CLASS.ADD (
-                     THIS_ELEMENT    => THIS_ELEMENT,
-                     TO_THIS_LIST    =>
-                          NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ;
- 
-           EXCEPTION
- 
-               WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ;
- 
-           END PUSH ;
- 
-           PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
-                           OFF_THIS_STACK      : IN OUT STACK) IS
- 
-           BEGIN  -- POP
- 
-                NEW_LIST_CLASS.DELETE (
-                     THIS_ELEMENT     => THIS_ELEMENT,
-                     FROM_THIS_LIST   =>
-                         NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ;
- 
-           EXCEPTION
- 
-                     WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ;
- 
-           END POP ;
- 
-           PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
-                            TO_THIS_STACK    : IN OUT STACK) IS
- 
-           BEGIN  -- COPY
- 
-               NEW_LIST_CLASS.COPY (
-                     THIS_LIST    => NEW_LIST_CLASS.LIST (THIS_STACK),
-                     TO_THIS_LIST =>
-                          NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ;
- 
-           END COPY ;
- 
-           PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) IS
- 
-           BEGIN  -- CLEAR
- 
-                NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ;
- 
-           END CLEAR ;
- 
-           PROCEDURE ITERATE (OVER_THIS_STACK  : IN STACK) IS
- 
-                PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE
-                                         (PROCESS => PROCESS) ;
- 
-           BEGIN  -- ITERATE
- 
-                STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ;
- 
-           END ITERATE ;
- 
-           FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
-                     RETURN NATURAL IS
- 
-           BEGIN  -- NUMBER_OF_ELEMENTS
- 
-                RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS
-                     (IN_THIS_LIST =>
-                          NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ;
- 
-           END NUMBER_OF_ELEMENTS ;
- 
-           FUNCTION "=" (LEFT  : IN STACK ;
-                         RIGHT : IN STACK) RETURN BOOLEAN IS
- 
-           BEGIN  -- "="
- 
-                RETURN NEW_LIST_CLASS."=" (
-                     LEFT  => NEW_LIST_CLASS.LIST (LEFT),
-                    RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ;
- 
-           END "=" ;
- 
-      END STACK_CLASS ;
- 
- END CC3019C1_NESTED_GENERICS ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,457 ****
- -- CC3019C2M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --   CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G.
- --   TO SUPPORT ITERATORS.
- 
- --  THIS TEST SPECIFICALLY CHECKS THAT A
- --  NESTING LEVEL OF 3 IS SUPPORTED FOR GENERICS:
- --       INSTANTIATE CC3019C1_NESTED_GENERICS IN THE MAIN
- --       PROCEDURE, THE INSTANTIATION OF CC3019C0_LIST_CLASS
- --       IN GENERIC PACKAGE CC3019C1_NESTED_GENERICS, AND
- --       THE INSTANTIATION OF NEW_LIST_CLASS.ITERATE IN
- --       PROCEDURE ITERATE IN PACKAGE BODY STACK_CLASS.
- --
- --  *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE
- --  *** SOURCE CODE IN FILES CC3019C0.ADA AND CC3019C1.ADA HAVE
- --  *** BEEN COMPILED.
- --
- -- HISTORY:
- --         EDWARD V. BERARD, 31 AUGUST 1990
- 
- WITH REPORT ;
- WITH CC3019C1_NESTED_GENERICS ;
- 
- PROCEDURE CC3019C2M IS
- 
-      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                          SEP, OCT, NOV, DEC) ;
-      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-      TYPE DATE IS RECORD
-           MONTH : MONTH_TYPE ;
-           DAY   : DAY_TYPE ;
-           YEAR  : YEAR_TYPE ;
-      END RECORD ;
- 
-      STORE_DATE   : DATE ;
- 
-      TODAY        : DATE := (MONTH => AUG,
-                              DAY   => 31,
-                              YEAR  => 1990) ;
- 
-      FIRST_DATE   : DATE := (MONTH => JUN,
-                              DAY   => 4,
-                              YEAR  => 1967) ;
- 
-      BIRTH_DATE   : DATE := (MONTH => OCT,
-                              DAY   => 3,
-                              YEAR  => 1949) ;
- 
-      WALL_DATE    : DATE := (MONTH => NOV,
-                              DAY   => 9,
-                              YEAR  => 1989) ;
- 
-      TYPE SEX IS (MALE, FEMALE) ;
- 
-      TYPE PERSON IS RECORD
-           BIRTH_DATE : DATE ;
-           GENDER     : SEX ;
-           NAME       : STRING (1 .. 10) ;
-      END RECORD ;
- 
-      FIRST_PERSON  : PERSON ;
-      SECOND_PERSON : PERSON ;
- 
-      MYSELF      : PERSON := (BIRTH_DATE => BIRTH_DATE,
-                               GENDER     => MALE,
-                               NAME        => "ED        ") ;
- 
-      FRIEND      : PERSON := (BIRTH_DATE => DATE'(DEC, 27, 1949),
-                               GENDER     => MALE,
-                               NAME        => "DENNIS    ") ;
- 
-      FATHER      : PERSON := (BIRTH_DATE => DATE'(JUL, 5, 1925),
-                               GENDER     => MALE,
-                               NAME        => "EDWARD    ") ;
- 
-      DAUGHTER    : PERSON := (BIRTH_DATE => DATE'(DEC, 10, 1980),
-                               GENDER     => FEMALE,
-                               NAME       => "CHRISSY   ") ;
- 
-      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
-                        TO_THIS_DATE              : IN OUT DATE) ;
- 
-      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
-                         RIGHT : IN DATE) RETURN BOOLEAN ;
- 
-      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON  : IN OUT PERSON ;
-                        TO_THIS_PERSON            : IN OUT PERSON) ;
- 
-      FUNCTION IS_EQUAL (LEFT  : IN PERSON ;
-                         RIGHT : IN PERSON) RETURN BOOLEAN ;
- 
- --  INSTANTIATE OUTER GENERIC PACKAGE
- 
-      PACKAGE NEW_NESTED_GENERICS IS NEW
-           CC3019C1_NESTED_GENERICS (ELEMENT => DATE,
-                                     ASSIGN  => ASSIGN,
-                                     "="     => IS_EQUAL) ;
- 
-      FIRST_NNG  : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
-      SECOND_NNG : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
- 
-      FUNCTION "=" (LEFT  : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
-                    RIGHT : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE)
-                    RETURN BOOLEAN RENAMES NEW_NESTED_GENERICS."=" ;
- 
- --  INSTANTIATE NESTED TASK PACKAGE
- 
-      PACKAGE NEW_GENERIC_TASK IS NEW
-           NEW_NESTED_GENERICS.GENERIC_TASK (ELEMENT => PERSON,
-                                             ASSIGN  => ASSIGN) ;
- 
-      FIRST_GENERIC_TASK  : NEW_GENERIC_TASK.PROTECTED_AREA ;
-      SECOND_GENERIC_TASK : NEW_GENERIC_TASK.PROTECTED_AREA ;
- 
- --  INSTANTIATE NESTED STACK PACKAGE
- 
-      PACKAGE PERSON_STACK IS NEW
-           NEW_NESTED_GENERICS.STACK_CLASS (ELEMENT => PERSON,
-                                            ASSIGN  => ASSIGN,
-                                            "="     => IS_EQUAL) ;
- 
-      FIRST_PERSON_STACK  : PERSON_STACK.STACK ;
-      SECOND_PERSON_STACK : PERSON_STACK.STACK ;
-      THIRD_PERSON_STACK  : PERSON_STACK.STACK ;
- 
-      FUNCTION "=" (LEFT  : IN PERSON_STACK.STACK ;
-                    RIGHT : IN PERSON_STACK.STACK) RETURN BOOLEAN
-               RENAMES PERSON_STACK."=" ;
- 
-      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
-                        TO_THIS_DATE              : IN OUT DATE) IS
- 
-      BEGIN -- ASSIGN
- 
-           TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
- 
-      END ASSIGN ;
- 
-      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
-                         RIGHT : IN DATE) RETURN BOOLEAN IS
- 
-      BEGIN -- IS_EQUAL
- 
-           IF (LEFT.MONTH = RIGHT.MONTH) AND (LEFT.DAY = RIGHT.DAY)
-              AND (LEFT.YEAR = RIGHT.YEAR) THEN
-                RETURN TRUE ;
-           ELSE
-                RETURN FALSE ;
-           END IF ;
- 
-      END IS_EQUAL ;
- 
-      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON  : IN OUT PERSON ;
-                        TO_THIS_PERSON            : IN OUT PERSON) IS
- 
-      BEGIN -- ASSIGN
- 
-           TO_THIS_PERSON := THE_VALUE_OF_THIS_PERSON ;
- 
-      END ASSIGN ;
- 
-      FUNCTION IS_EQUAL (LEFT  : IN PERSON ;
-                         RIGHT : IN PERSON) RETURN BOOLEAN IS
- 
-      BEGIN -- IS_EQUAL
- 
-           IF (LEFT.BIRTH_DATE = RIGHT.BIRTH_DATE) AND
-              (LEFT.GENDER = RIGHT.GENDER) AND
-              (LEFT.NAME = RIGHT.NAME) THEN
-                RETURN TRUE ;
-           ELSE
-                RETURN FALSE ;
-           END IF ;
- 
-      END IS_EQUAL ;
- 
- BEGIN  -- CC3019C2M
- 
-      REPORT.TEST ("CC3019C2M",
-                   "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " &
-                   "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " &
-                   "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF 3 " &
-                   "IS SUPPORTED FOR GENERICS.") ;
- 
- -- CHECK THE OUTERMOST GENERIC (NEW_NESTED_GENERICS)
- 
-      NEW_NESTED_GENERICS.SET_ELEMENT (
-           FOR_THIS_NGT_OBJECT => FIRST_NNG,
-           TO_THIS_ELEMENT     => TODAY) ;
-      NEW_NESTED_GENERICS.SET_NUMBER (
-           FOR_THIS_NGT_OBJECT => FIRST_NNG,
-           TO_THIS_NUMBER      => 1) ;
- 
-      NEW_NESTED_GENERICS.SET_ELEMENT (
-           FOR_THIS_NGT_OBJECT => SECOND_NNG,
-           TO_THIS_ELEMENT     => FIRST_DATE) ;
-      NEW_NESTED_GENERICS.SET_NUMBER  (
-           FOR_THIS_NGT_OBJECT => SECOND_NNG,
-           TO_THIS_NUMBER      => 2) ;
- 
-      IF FIRST_NNG = SECOND_NNG THEN
-           REPORT.FAILED ("PROBLEMS WITH TESTING EQUALITY FOR " &
-                          "OUTERMOST GENERIC") ;
-      END IF ;
- 
-      IF (NEW_NESTED_GENERICS.ELEMENT_OF (THIS_NGT_OBJECT => FIRST_NNG)
-              /= TODAY) OR
-         (NEW_NESTED_GENERICS.ELEMENT_OF (
-                 THIS_NGT_OBJECT => SECOND_NNG)
-              /= FIRST_DATE) THEN
-              REPORT.FAILED ("PROBLEMS WITH EXTRACTING ELEMENTS IN " &
-                             "OUTERMOST GENERIC") ;
-      END IF ;
- 
-      IF (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => FIRST_NNG)
-              /= 1) OR
-         (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => SECOND_NNG)
-              /= 2) THEN
-              REPORT.FAILED ("PROBLEMS WITH EXTRACTING NUMBERS IN " &
-                              "OUTERMOST GENERIC") ;
-      END IF ;
- 
-      NEW_NESTED_GENERICS.COPY (SOURCE        => FIRST_NNG,
-                                DESTINATION    => SECOND_NNG) ;
- 
-      IF FIRST_NNG /= SECOND_NNG THEN
-           REPORT.FAILED ("PROBLEMS WITH COPYING OR TESTING EQUALITY " &
-                          "IN OUTERMOST GENERIC") ;
-      END IF ;
- 
- -- CHECK THE FIRST NESTED GENERIC (GENERIC_TASK)
- 
-      FIRST_GENERIC_TASK.STORE  (ITEM => MYSELF) ;
-      SECOND_GENERIC_TASK.STORE (ITEM => FRIEND) ;
- 
-      FIRST_GENERIC_TASK.GET  (ITEM => FIRST_PERSON) ;
-      SECOND_GENERIC_TASK.GET (ITEM => SECOND_PERSON) ;
- 
-      IF (FIRST_PERSON /= MYSELF) OR (SECOND_PERSON /= FRIEND) THEN
-           REPORT.FAILED ("PROBLEMS WITH NESTED TASK GENERIC") ;
-      END IF ;
- 
- -- CHECK THE SECOND NESTED GENERIC (STACK_CLASS)
- 
-      PERSON_STACK.CLEAR (THIS_STACK => FIRST_PERSON_STACK) ;
-      IF PERSON_STACK.NUMBER_OF_ELEMENTS
-         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 0 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
-      END IF ;
- 
-      PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
-                             ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
-      IF PERSON_STACK.NUMBER_OF_ELEMENTS
-         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 1 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
-      END IF ;
- 
-      PERSON_STACK.PUSH (THIS_ELEMENT     => FRIEND,
-                             ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
-      IF PERSON_STACK.NUMBER_OF_ELEMENTS
-         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
-      END IF ;
- 
-      PERSON_STACK.PUSH (THIS_ELEMENT     => FATHER,
-                             ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
-      IF PERSON_STACK.NUMBER_OF_ELEMENTS
-         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 3 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
-      END IF ;
- 
-      PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
-                            OFF_THIS_STACK => FIRST_PERSON_STACK) ;
-      IF PERSON_STACK.NUMBER_OF_ELEMENTS
-         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
-      END IF ;
- 
-      IF FIRST_PERSON /= FATHER THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE REMOVED FROM STACK - 1") ;
-      END IF ;
- 
-      PERSON_STACK.CLEAR (THIS_STACK => SECOND_PERSON_STACK) ;
-      IF PERSON_STACK.NUMBER_OF_ELEMENTS
-         (ON_THIS_STACK => SECOND_PERSON_STACK) /= 0 THEN
-           REPORT.FAILED (
-                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
-      END IF ;
- 
-      PERSON_STACK.COPY (THIS_STACK    => FIRST_PERSON_STACK,
-                             TO_THIS_STACK => SECOND_PERSON_STACK) ;
- 
-      IF FIRST_PERSON_STACK /= SECOND_PERSON_STACK THEN
-           REPORT.FAILED (
-                "PROBLEMS WITH COPY OR TEST FOR EQUALITY (STACK)") ;
-      END IF ;
- 
-      PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
-                        OFF_THIS_STACK => SECOND_PERSON_STACK) ;
-      PERSON_STACK.PUSH (THIS_ELEMENT     => DAUGHTER,
-                         ON_TO_THIS_STACK => SECOND_PERSON_STACK) ;
-      IF FIRST_PERSON_STACK = SECOND_PERSON_STACK THEN
-           REPORT.FAILED (
-                "PROBLEMS WITH POP OR TEST FOR EQUALITY (STACK)") ;
-      END IF ;
- 
-      UNDERFLOW_EXCEPTION_TEST:
- 
-      BEGIN  -- UNDERFLOW_EXCEPTION_TEST
- 
-           PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
-           PERSON_STACK.POP (THIS_ELEMENT    => FIRST_PERSON,
-                             OFF_THIS_STACK  => THIRD_PERSON_STACK) ;
-           REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;
- 
-      EXCEPTION
- 
-           WHEN PERSON_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
-                                                  -- RAISED
-           WHEN OTHERS =>
-                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
-                               "UNDERFLOW EXCEPTION TEST") ;
- 
-      END UNDERFLOW_EXCEPTION_TEST ;
- 
-      OVERFLOW_EXCEPTION_TEST:
- 
-      BEGIN  -- OVERFLOW_EXCEPTION_TEST
- 
-           PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
-           FOR INDEX IN 1 .. 10 LOOP
-                PERSON_STACK.PUSH (
-                     THIS_ELEMENT     => MYSELF,
-                     ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
-           END LOOP ;
- 
-           PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
-                              ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
-           REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;
- 
-      EXCEPTION
- 
-           WHEN PERSON_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
-                                                 -- RAISED
-           WHEN OTHERS =>
-                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
-                               "OVERFLOW EXCEPTION TEST") ;
- 
-      END OVERFLOW_EXCEPTION_TEST ;
- 
-      LOCAL_BLOCK:
- 
-      DECLARE
- 
-           TYPE PERSON_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF PERSON;
- 
-           FIRST_PERSON_TABLE : PERSON_TABLE ;
- 
-           TABLE_INDEX : POSITIVE := 1 ;
- 
-           PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
-                                    CONTINUE    : OUT BOOLEAN) ;
- 
-           PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
-                                  CONTINUE     : OUT BOOLEAN) ;
- 
-           PROCEDURE GATHER_PERSON_ITERATE IS NEW
-                PERSON_STACK.ITERATE (PROCESS => GATHER_PEOPLE) ;
- 
-           PROCEDURE SHOW_PERSON_ITERATE IS NEW
-                PERSON_STACK.ITERATE (PROCESS => SHOW_PEOPLE) ;
- 
-           PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
-                                    CONTINUE    : OUT BOOLEAN) IS
-           BEGIN  -- GATHER_PEOPLE
- 
-                FIRST_PERSON_TABLE (TABLE_INDEX) := THIS_PERSON ;
-                TABLE_INDEX := TABLE_INDEX + 1 ;
- 
-                CONTINUE := TRUE ;
- 
-           END GATHER_PEOPLE ;
- 
-           PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
-                                  CONTINUE     : OUT BOOLEAN) IS
- 
-           BEGIN  -- SHOW_PEOPLE
- 
-                REPORT.COMMENT ("THE BIRTH MONTH IS " &
-                     MONTH_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.MONTH)) ;
-                REPORT.COMMENT ("THE BIRTH DAY IS " &
-                     DAY_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.DAY)) ;
-                REPORT.COMMENT ("THE BIRTH YEAR IS " &
-                     YEAR_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.YEAR)) ;
-                REPORT.COMMENT ("THE GENDER IS " &
-                     SEX'IMAGE (THIS_PERSON.GENDER)) ;
-                REPORT.COMMENT ("THE NAME IS " & THIS_PERSON.NAME) ;
- 
-                CONTINUE := TRUE ;
- 
-           END SHOW_PEOPLE ;
- 
-      BEGIN  -- LOCAL_BLOCK
- 
-           REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
-           SHOW_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK) ;
- 
-           REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
-           SHOW_PERSON_ITERATE (OVER_THIS_STACK => SECOND_PERSON_STACK) ;
- 
-           GATHER_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK);
-           IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
-              (FIRST_PERSON_TABLE (2) /= FRIEND) THEN
-                REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
-           END IF ;
- 
-           TABLE_INDEX := 1 ;
-           GATHER_PERSON_ITERATE(OVER_THIS_STACK => SECOND_PERSON_STACK);
-           IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
-              (FIRST_PERSON_TABLE (2) /= DAUGHTER) THEN
-                REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
-           END IF ;
- 
-      END LOCAL_BLOCK ;
- 
-      REPORT.RESULT ;
- 
- END CC3019C2M ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,207 ****
- -- CC3106B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --     CHECK THAT THE FORMAL PARAMETER DENOTES THE ACTUAL
- --     IN AN INSTANTIATION.
- 
- -- HISTORY:
- --     LDC 06/20/88  CREATED ORIGINAL TEST
- --     EDWARD V. BERARD, 10 AUGUST 1990  ADDED CHECKS FOR MULTI-
- --                                       DIMENSIONAL ARRAYS
- 
- WITH REPORT ;
- 
- PROCEDURE CC3106B IS
- 
- BEGIN  -- CC3106B
- 
-     REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &
-                 "THE ACTUAL IN AN INSTANTIATION");
- 
-     LOCAL_BLOCK:
-     
-     DECLARE
-     
-         SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;
-         TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;
-         PRAGMA PACK(PCK_BOL) ;
-           
-         SHORT_START : CONSTANT := -100 ;
-         SHORT_END   : CONSTANT := 100 ;
-         TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
-     
-         SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
-     
-         TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                             SEP, OCT, NOV, DEC) ;
-                         
-         SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
-     
-         TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-         TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-         TYPE DATE IS RECORD
-             MONTH : MONTH_TYPE ;
-             DAY   : DAY_TYPE ;
-             YEAR  : YEAR_TYPE ;
-         END RECORD ;
-     
-         TODAY         : DATE := (MONTH => AUG,
-                                  DAY   => 8,
-                                  YEAR  => 1990) ;
-                             
-         FIRST_DATE    : DATE := (DAY   => 6,
-                                  MONTH => JUN,
-                                  YEAR  => 1967) ;
-                             
-         WALL_DATE     : DATE := (MONTH => NOV,
-                                  DAY   => 9,
-                                  YEAR  => 1989) ;
-                             
-         SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
-                             
-         TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
-                                          FIRST_HALF,
-                                          FIRST_FIVE) OF DATE ;
-                                      
-         TD_ARRAY : THREE_DIMENSIONAL := (THREE_DIMENSIONAL'RANGE =>
-                                         (THREE_DIMENSIONAL'RANGE (2) =>
-                                         (THREE_DIMENSIONAL'RANGE (3) =>
-                                           TODAY))) ;
- 
-         TASK TYPE TSK IS
-             ENTRY ENT_1;
-             ENTRY ENT_2;
-             ENTRY ENT_3;
-         END TSK;
- 
-         GENERIC
-           
-             TYPE GEN_TYPE IS (<>);
-             GEN_BOLARR         : IN OUT PCK_BOL;
-             GEN_TYP            : IN OUT GEN_TYPE;
-             GEN_TSK            : IN OUT TSK;
-             TEST_VALUE         : IN DATE ;
-             TEST_CUBE          : IN OUT THREE_DIMENSIONAL ;
- 
-         PACKAGE P IS
-                PROCEDURE GEN_PROC1 ;
-                PROCEDURE GEN_PROC2 ;
-                PROCEDURE GEN_PROC3 ;
-                PROCEDURE ARRAY_TEST ;
-         END P;
- 
-         ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);
-         SI         : SM_INT := 0 ;
-         T          : TSK;
- 
-         PACKAGE BODY P IS
-         
-             PROCEDURE GEN_PROC1 IS
-             BEGIN  -- GEN_PROC1
-                 GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);
-                 GEN_TYP := GEN_TYPE'VAL(4);
-                 IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)
-                    THEN
-                     REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
-                                   "INSTANTIATED VALUES");
-                 END IF;
-             END GEN_PROC1;
- 
-             PROCEDURE GEN_PROC2 IS
-             BEGIN  -- GEN_PROC2
-                 IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR
-                       GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN
-                     REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
-                                   "VALUES ASSIGNED IN THE MAIN " &
-                                   "PROCEDURE");
-                 END IF;
-                 GEN_BOLARR(18) := TRUE;
-                 GEN_TYP := GEN_TYPE'VAL(9);
-             END GEN_PROC2;
- 
-             PROCEDURE GEN_PROC3 IS
-             BEGIN  -- GEN_PROC3
-                 GEN_TSK.ENT_2;
-             END GEN_PROC3 ;
-                
-             PROCEDURE ARRAY_TEST IS            
-             BEGIN  -- ARRAY_TEST
-                
-                 TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;
-                            
-                 IF (TD_ARRAY (0, JUN, 'C')  /= TEST_VALUE) OR
-                       (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN
-                     REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &
-                                    "DIFFERENT THAN THE VALUES ASSIGNED " &
-                                    "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;
-                 END IF ;
-                 
-             END ARRAY_TEST ;
-             
-         END P ;
- 
-         TASK BODY TSK IS
-         BEGIN  -- TSK
-             ACCEPT ENT_1 DO
-                 REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");
-             END;
-             ACCEPT ENT_2 DO
-                 REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");
-             END;
-             ACCEPT ENT_3 DO
-                 REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");
-             END;
-         END TSK;
- 
-         PACKAGE INSTA1 IS NEW P (GEN_TYPE       => SM_INT,
-                                  GEN_BOLARR     => ACT_BOLARR,
-                                  GEN_TYP        => SI,
-                                  GEN_TSK        => T,
-                                  TEST_VALUE     => FIRST_DATE,
-                                  TEST_CUBE      => TD_ARRAY) ;
-                              
-     BEGIN  -- LOCAL_BLOCK
-     
-         INSTA1.GEN_PROC1;
-         ACT_BOLARR(9) := TRUE;
-         SI := 2;
-         INSTA1.GEN_PROC2;
-         IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR
-               SI /= REPORT.IDENT_INT(9) THEN
-             REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &
-                           "ASSIGNED IN THE GENERIC PROCEDURE");
-         END IF;
- 
-         T.ENT_1;
-         INSTA1.GEN_PROC3;
-         T.ENT_3;
-           
-         TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;
-         INSTA1.ARRAY_TEST ;
- 
-      END LOCAL_BLOCK;
- 
-      REPORT.RESULT;
- 
- END CC3106B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3120a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3120a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3120a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3120a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,180 ****
- -- CC3120A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT GENERIC IN PARAMETERS ARE ALWAYS COPIED, AND THAT
- -- GENERIC IN OUT PARAMETERS ARE ALWAYS RENAMED.
- 
- -- DAT 8/10/81
- -- SPS 10/21/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3120A IS
- BEGIN
-      TEST ("CC3120A", "GENERIC IN PARMS ARE COPIED, GENERIC IN OUT"
-           & " PARMS ARE RENAMED");
- 
-      DECLARE
-           S1, S2 : INTEGER;
-           A1, A2, A3 : STRING (1 .. IDENT_INT (3));
- 
-           TYPE REC IS RECORD
-                C1, C2 : INTEGER := 1;
-           END RECORD;
- 
-           R1, R2 : REC;
- 
-           PACKAGE P IS
-                TYPE PRIV IS PRIVATE;
-                PROCEDURE SET_PRIV (P : IN OUT PRIV);
-           PRIVATE
-                TYPE PRIV IS NEW REC;
-           END P;
-           USE P;
- 
-           P1, P2 : PRIV;
-           EX : EXCEPTION;
- 
-           GENERIC
-                TYPE T IS PRIVATE;
-                P1 : IN OUT T;
-                P2 : IN T;
-           PROCEDURE GP;
- 
-           B_ARR : ARRAY (1..10) OF BOOLEAN;
- 
-           PACKAGE BODY P IS
-                PROCEDURE SET_PRIV (P : IN OUT PRIV) IS
-                BEGIN
-                     P.C1 := 3;
-                END SET_PRIV;
-           END P;
- 
-           PROCEDURE GP IS
-           BEGIN
-                IF P1 = P2 THEN
-                     FAILED ("PARAMETER SCREW_UP SOMEWHERE");
-                END IF;
-                P1 := P2;
-                IF P1 /= P2 THEN
-                     FAILED ("ASSIGNMENT SCREW_UP SOMEWHERE");
-                END IF;
-                RAISE EX;
-                FAILED ("RAISE STATEMENT DOESN'T WORK");
-           END GP;
-      BEGIN
-           S1 := 4;
-           S2 := 5;
-           A1 := "XYZ";
-           A2 := "ABC";
-           A3 := "DEF";
-           R1.C1 := 4;
-           R2.C1 := 5;
-           B_ARR := (1|3|5|7|9 => TRUE, 2|4|6|8|10 => FALSE);
-           SET_PRIV (P2);
- 
-           IF S1 = S2
-           OR A1 = A3
-           OR R1 = R2
-           OR P1 = P2 THEN
-                FAILED ("WRONG ASSIGNMENT");
-           END IF;
-           BEGIN
-                DECLARE
-                     PROCEDURE PR IS NEW GP (INTEGER, S1, S2);
-                BEGIN
-                     S2 := S1;
-                     PR;       -- OLD S2 ASSIGNED TO S1, SO S1 /= S2 NOW
-                     FAILED ("EX NOT RAISED 1");
-                EXCEPTION
-                     WHEN EX => NULL;
-                END;
- 
-                DECLARE
-                     SUBTYPE STR_1_3 IS STRING (IDENT_INT (1)..3);
-                     PROCEDURE PR IS NEW GP (STR_1_3, A1, A3);
-                BEGIN
-                     A3 := A1;
-                     PR;
-                     FAILED ("EX NOT RAISED 2");
-                EXCEPTION
-                     WHEN EX => NULL;
-                END;
- 
-                DECLARE
-                     PROCEDURE PR IS NEW GP (REC, R1, R2);
-                BEGIN
-                     R2 := R1;
-                     PR;
-                     FAILED ("EX NOT RAISED 3");
-                EXCEPTION
-                     WHEN EX => NULL;
-                END;
- 
-                DECLARE
-                     PROCEDURE PR IS NEW GP (PRIV, P1, P2);
-                BEGIN
-                     P2 := P1;
-                     PR;
-                     FAILED ("EX NOT RAISED 4");
-                EXCEPTION
-                     WHEN EX => NULL;
-                END;
-                DECLARE
-                     PROCEDURE PR IS NEW GP (CHARACTER,
-                                             A3(IDENT_INT(2)),
-                                             A3(IDENT_INT(3)));
-                BEGIN
-                     A3(3) := A3(2);
-                     PR;
-                     FAILED ("EX NOT RAISED 5");
-                EXCEPTION
-                     WHEN EX => NULL;
-                END;
- 
-                DECLARE
-                     PROCEDURE PR IS NEW GP (BOOLEAN,
-                                             B_ARR(IDENT_INT(2)),
-                                             B_ARR(IDENT_INT(3)));
-                BEGIN
-                     B_ARR(3) := B_ARR(2);
-                     PR;
-                     FAILED ("EX NOT RAISED 6");
-                EXCEPTION
-                     WHEN EX => NULL;
-                END;
-           END;
- 
-           IF S1 = S2
-           OR A1 = A2
-           OR R1 = R2
-           OR P1 = P2
-           OR A3(2) = A3(3) 
-           OR B_ARR(2) = B_ARR(3) THEN
-                FAILED ("ASSIGNMENT FAILED 2");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3120A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3120b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3120b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3120b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3120b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- CC3120B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT TASKS ARE NOT COPIED AS GENERIC IN OUT PARMS.
- 
- -- DAT 8/27/81
- -- SPS 4/6/82
- -- JBG 3/23/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3120B IS
- BEGIN
-      TEST ("CC3120B", "TASKS ARE NOT COPIED AS GENERIC PARAMETERS");
- 
-      DECLARE
-           PACKAGE P IS
-                TYPE T IS LIMITED PRIVATE;
-                PROCEDURE UPDT (TPARM: IN T; I : IN OUT INTEGER);
-           PRIVATE
-                TASK TYPE T1 IS
-                     ENTRY GET (I : OUT INTEGER);
-                     ENTRY PUT (I : IN INTEGER);
-                END T1;
-                TYPE T IS RECORD
-                     C : T1;
-                END RECORD;
-           END P;
-           USE P;
-           TT : T;
-           GENERIC
-                TYPE T IS LIMITED PRIVATE;
-                T1 : IN OUT T;
-                WITH PROCEDURE UPDT (TPARM : IN T; I: IN OUT INTEGER)
-                     IS <> ;
-           PROCEDURE PR;
- 
-           PROCEDURE PR IS
-                I : INTEGER;
-           BEGIN
-                I := 5;
-                                         -- PR.I
-                                         -- UPDT.I      UPDT.T1.I
-                                         --   5            4
-                UPDT (T1, I); 
-                                         --   4            5
-                IF I /= 4 THEN
-                     FAILED ("BAD VALUE 1");
-                END IF;
-                I := 6;
-                                         --   6            5
-                UPDT (T1, I);
-                                         --   5            6
-                IF I /= 5 THEN
-                     FAILED ("BAD VALUE 3");
-                END IF;
-                RAISE TASKING_ERROR;
-                FAILED ("INCORRECT RAISE STATEMENT");
-           END PR;
- 
-           PACKAGE BODY P IS
-                PROCEDURE UPDT (TPARM : IN T; I : IN OUT INTEGER) IS
-                     V : INTEGER := I;
-                     -- UPDT.I => V
-                     -- T1.I => UPDT.I
-                     -- V => T1.I
-                BEGIN
-                     TPARM.C.GET (I);
-                     TPARM.C.PUT (V);
-                END UPDT;
- 
-                TASK BODY T1 IS
-                     I : INTEGER;
-                BEGIN
-                     I := 1;
-                     LOOP
-                          SELECT
-                               ACCEPT GET (I : OUT INTEGER) DO
-                                    I := T1.I;
-                               END GET;
-                          OR
-                               ACCEPT PUT (I : IN INTEGER) DO
-                                    T1.I := I;
-                               END PUT;
-                          OR
-                               TERMINATE;
-                          END SELECT;
-                     END LOOP;
-                END T1;
-           END P;
-      BEGIN
-           DECLARE
-                X : INTEGER := 2;
-                PROCEDURE PPP IS NEW PR (T, TT);
-           BEGIN
-                                         -- X
-                                         -- UPDT.I      UPDT.T1.I
-                                         --   2            1
-                UPDT (TT, X);
-                                         --   1            2
-                X := X + 3;
-                                         --   4            2
-                UPDT (TT, X);
-                                         --   2            4
-                IF X /= 2 THEN 
-                     FAILED ("WRONG VALUE FOR X");
-                END IF;
-                BEGIN
-                     PPP;
-                     FAILED ("PPP NOT CALLED");
-                EXCEPTION
-                     WHEN TASKING_ERROR => NULL;
-                END;
-                X := 12;
-                                         --   12           6
-                UPDT (TT, X);
-                                         --   6            12
-                IF X /= 6 THEN
-                     FAILED ("WRONG FINAL VALUE IN TASK");
-                END IF;
-           END;
-      END;
- 
-      RESULT;
- END CC3120B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3121a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3121a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3121a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3121a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- CC3121A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN UNCONSTRAINED FORMAL GENERIC PARAMETER OF MODE "IN"
- -- HAVING AN ARRAY TYPE OR A TYPE WITH DISCRIMINANTS HAS THE CONSTRAINTS
- -- OF THE ACTUAL PARAMETER.
- 
- -- TBN  9/29/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3121A IS
- 
-      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
- 
-      TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
- 
-      TYPE REC1 (D : INT) IS
-           RECORD
-                VAR1 : INTEGER := 1;
-           END RECORD;
- 
-      TYPE REC2 (D : INT := 2) IS
-           RECORD
-                A : ARRAY1 (D .. IDENT_INT(4));
-                B : REC1 (D);
-                C : INTEGER := 1;
-           END RECORD;
- 
-      TYPE ARRAY2 IS ARRAY (INT RANGE <>) OF REC2;
- 
- BEGIN
-      TEST ("CC3121A", "CHECK THAT AN UNCONSTRAINED FORMAL GENERIC " &
-                       "PARAMETER OF MODE 'IN' HAVING AN ARRAY TYPE " &
-                       "OR A TYPE WITH DISCRIMINANTS HAS THE " &
-                       "CONSTRAINTS OF THE ACTUAL PARAMETER");
- 
-      DECLARE
-           OBJ_ARA1 : ARRAY1 (IDENT_INT(2) .. 5);
- 
-           GENERIC
-                VAR : ARRAY1;
-           PROCEDURE PROC;
- 
-           PROCEDURE PROC IS
-           BEGIN
-                IF VAR'FIRST /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FOR VAR'FIRST");
-                END IF;
-                IF VAR'LAST /= IDENT_INT(5) THEN
-                     FAILED ("INCORRECT RESULTS FOR VAR'LAST");
-                END IF;
-           END PROC;
- 
-           PROCEDURE PROC1 IS NEW PROC (OBJ_ARA1);
-      BEGIN
-           PROC1;
-      END;
- 
-      -------------------------------------------------------------------
-      DECLARE
-           OBJ_REC2 : REC2;
- 
-           GENERIC
-                VAR : REC2;
-           FUNCTION FUNC RETURN INTEGER;
- 
-           FUNCTION FUNC RETURN INTEGER IS
-           BEGIN
-                IF VAR.D /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.D");
-                END IF;
-                IF VAR.A'FIRST /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.A'FIRST");
-                END IF;
-                IF VAR.A'LAST /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.A'LAST");
-                END IF;
-                IF VAR.B.D /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.B.D");
-                END IF;
-                RETURN IDENT_INT(1);
-           END FUNC;
- 
-           FUNCTION FUNC1 IS NEW FUNC (OBJ_REC2);
- 
-      BEGIN
-           IF FUNC1 /= IDENT_INT(1) THEN
-                FAILED ("INCORRECT RESULTS FROM FUNC1 CALL");
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      DECLARE
-           OBJ_ARA2 : ARRAY2 (IDENT_INT(6) .. 8);
- 
-           GENERIC
-                VAR : ARRAY2;
-           PROCEDURE PROC;
- 
-           PROCEDURE PROC IS
-           BEGIN
-                IF VAR'FIRST /= IDENT_INT(6) THEN
-                     FAILED ("INCORRECT RESULTS FOR VAR'FIRST");
-                END IF;
-                IF VAR'LAST /= IDENT_INT(8) THEN
-                     FAILED ("INCORRECT RESULTS FOR VAR'LAST");
-                END IF;
-                IF VAR(6).D /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR(6).D");
-                END IF;
-                IF VAR(6).A'FIRST /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR(6).A'FIRST");
-                END IF;
-                IF VAR(6).A'LAST /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR(6).A'LAST");
-                END IF;
-                IF VAR(6).B.D /= IDENT_INT(2) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR(6).B.D");
-                END IF;
-           END PROC;
- 
-           PROCEDURE PROC2 IS NEW PROC (OBJ_ARA2);
-      BEGIN
-           PROC2;
-      END;
- 
-      -------------------------------------------------------------------
-      DECLARE
-           OBJ_REC3 : REC2 (3);
- 
-           GENERIC
-                VAR : REC2;
-           PACKAGE PAC IS
-                PAC_VAR : INTEGER := 1;
-           END PAC;
- 
-           PACKAGE BODY PAC IS
-           BEGIN
-                IF VAR.D /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.D");
-                END IF;
-                IF VAR.A'FIRST /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.A'FIRST");
-                END IF;
-                IF VAR.A'LAST /= IDENT_INT(4) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.A'LAST");
-                END IF;
-                IF VAR.B.D /= IDENT_INT(3) THEN
-                     FAILED ("INCORRECT RESULTS FROM VAR.B.D");
-                END IF;
-           END PAC;
- 
-           PACKAGE PAC1 IS NEW PAC (OBJ_REC3);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      -------------------------------------------------------------------
- 
-      RESULT;
- END CC3121A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3123a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3123a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3123a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3123a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- CC3123A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN PARAMETERS ARE ONLY
- -- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS.
- 
- -- TBN  12/01/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3123A IS
- 
- BEGIN
-      TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " &
-                       "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " &
-                       "NO ACTUAL PARAMETERS");
-      DECLARE
-           TYPE ENUM IS (I, II, III);
-           OBJ_INT : INTEGER := 1;
-           OBJ_ENUM : ENUM := I;
- 
-           GENERIC
-                GEN_INT : IN INTEGER := IDENT_INT(2);
-                GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE);
-                GEN_ENUM : IN ENUM := II;
-           PACKAGE P IS
-                PAC_INT : INTEGER := GEN_INT;
-                PAC_BOOL : BOOLEAN := GEN_BOOL;
-                PAC_ENUM : ENUM := GEN_ENUM;
-           END P;
- 
-           PACKAGE P1 IS NEW P;
-           PACKAGE P2 IS
-                NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM);
-           PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE));
-      BEGIN
-           IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN
-                FAILED ("DEFAULT VALUES WERE NOT EVALUATED");
-           END IF;
-           IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN
-                FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
-                        "- 1");
-           END IF;
-           IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR
-                P3.PAC_ENUM /= II THEN
-                FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
-                        "- 2");
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      DECLARE
-           OBJ_INT1 : INTEGER := 3;
- 
-           FUNCTION FUNC (X : INTEGER) RETURN INTEGER;
- 
-           GENERIC
-                GEN_INT1 : IN INTEGER := FUNC (1);
-                GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1);
-           PROCEDURE PROC;
- 
-           PROCEDURE PROC IS
-                PROC_INT1 : INTEGER := GEN_INT1;
-                PROC_INT2 : INTEGER := GEN_INT2;
-           BEGIN
-                IF PROC_INT1 /= 3 THEN
-                     FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
-                             "CORRECTLY - 3");
-                END IF;
-                IF PROC_INT2 /= 4 THEN
-                     FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
-                             "CORRECTLY - 4");
-                END IF;
-           END PROC;
- 
-           FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF X /= IDENT_INT(4) THEN
-                     FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
-                             "CORRECTLY - 5");
-                END IF;
-                RETURN IDENT_INT(X);
-           END FUNC;
- 
-           PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1);
- 
-      BEGIN
-           NEW_PROC;
-      END;
- 
-      -------------------------------------------------------------------
-      DECLARE
-           TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
-           TYPE REC IS
-                RECORD
-                     ANS : BOOLEAN;
-                     ARA : ARA_TYP;
-                END RECORD;
-           TYPE ARA_REC IS ARRAY (1 .. 5) OF REC;
- 
-           FUNCTION F (X : INTEGER) RETURN INTEGER;
- 
-           OBJ_REC : REC := (FALSE, (3, 4));
-           OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4)));
- 
-           GENERIC
-                GEN_OBJ1 : IN ARA_TYP := (F(1), 2);
-                GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1);
-                GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2)));
-           FUNCTION FUNC RETURN INTEGER;
- 
-           FUNCTION FUNC RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT(1);
-           END FUNC;
- 
-           FUNCTION F (X : INTEGER) RETURN INTEGER IS
-           BEGIN
-                FAILED ("DEFAULT VALUES WERE EVALUATED - 1");
-                RETURN IDENT_INT(X);
-           END F;
- 
-           FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA);
- 
-      BEGIN
-           IF NOT EQUAL (NEW_FUNC, 1) THEN
-                FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1");
-           END IF;
-      END;
- 
-      -------------------------------------------------------------------
-      DECLARE
-           SUBTYPE INT IS INTEGER RANGE 1 .. 5;
-           TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
-           TYPE COLOR IS (RED, WHITE);
-           TYPE CON_REC (D : INT) IS
-                RECORD
-                     A : COLOR;
-                     B : ARA_TYP;
-                END RECORD;
-           TYPE UNCON_OR_CON_REC (D : INT := 2) IS
-                RECORD
-                     A : COLOR;
-                     B : ARA_TYP;
-                END RECORD;
-           FUNCTION F (X : COLOR) RETURN COLOR;
- 
-           OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4));
-           OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4));
-           OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4));
- 
-           GENERIC
-                GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2));
-                GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2));
-                GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON;
-           FUNCTION FUNC RETURN INTEGER;
- 
-           FUNCTION FUNC RETURN INTEGER IS
-           BEGIN
-                RETURN IDENT_INT(1);
-           END FUNC;
- 
-           FUNCTION F (X : COLOR) RETURN COLOR IS
-           BEGIN
-                FAILED ("DEFAULT VALUES WERE EVALUATED - 2");
-                RETURN WHITE;
-           END F;
- 
-           FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2);
- 
-      BEGIN
-           IF NOT EQUAL (NEW_FUNC, 1) THEN
-                FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3123A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- CC3125A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE OF A 
- -- GENERIC IN PARAMETER DOES NOT SATISFY ITS SUBTYPE CONSTRAINT.
- 
- -- THIS TEST CHECKS PARAMETERS OF A NON-GENERIC TYPE.
- 
- -- DAT 8/10/81
- -- SPS 4/14/82
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3125A IS
- 
- BEGIN
-      TEST ("CC3125A","GENERIC PARAMETER DEFAULTS OF " &
-                      "NON-GENERIC TYPE EVALUATED AND CHECKED WHEN " &
-                      "DECLARATION IS INSTANTIATED AND DEFAULT USED");
- 
-      FOR I IN 1 .. 3 LOOP
-           COMMENT ("LOOP ITERATION");
-           BEGIN
- 
-                DECLARE
-                     SUBTYPE T IS INTEGER RANGE 1 .. IDENT_INT(1);
-                     SUBTYPE I_1_2 IS INTEGER RANGE
-                          IDENT_INT (1) .. IDENT_INT (2);
- 
-                     GENERIC
-                          P,Q : T := I_1_2'(I);
-                     PACKAGE PKG IS 
-                          R: T := P;
-                     END PKG;
- 
-                BEGIN
- 
-                     BEGIN
-                          DECLARE
-                               PACKAGE P1 IS NEW PKG;
-                          BEGIN
-                               IF I = IDENT_INT(1) THEN
-                                    IF P1.R /= IDENT_INT(1) 
-                                    THEN FAILED ("BAD INITIAL"&
-                                         " VALUE");
-                                    END IF;
-                               ELSIF I = 2 THEN
-                                    FAILED ("SUBTYPE NOT CHECKED AT " &
-                                            "INSTANTIATION");
-                               ELSE
-                                    FAILED ("DEFAULT NOT EVALUATED AT " &
-                                            "INSTANTIATION");
-                               END IF;
-                          EXCEPTION
-                               WHEN OTHERS => FAILED ("WRONG HANDLER");
-                          END;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               CASE I IS
-                                    WHEN 1 =>
-                                         FAILED ("INCORRECT EXCEPTION");
-                                    WHEN 2 =>
-                                         COMMENT ("CONSTRAINT CHECKED" &
-                                              " ON INSTANTIATION");
-                                    WHEN 3 =>
-                                         COMMENT ("DEFAULT EVALUATED " &
-                                              "ON INSTANTIATION");
-                               END CASE;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     CASE I IS
-                          WHEN 1 =>
-                               FAILED ("NO EXCEPTION SHOULD BE RAISED");
-                          WHEN 2 =>
-                               FAILED ("DEFAULT CHECKED AGAINST " &
-                                       "SUBTYPE AT DECLARATION");
-                          WHEN 3 =>
-                               FAILED ("DEFAULT EVALUATED AT " &
-                                       "DECLARATION");
-                     END CASE;
-           END;
-      END LOOP;
- 
-      RESULT;
- END CC3125A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- CC3125B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A GENERIC IN PARAMETER
- -- HAVING AN ENUMERATION TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
- -- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
- 
- -- TBN  12/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3125B IS
- 
-      TYPE COLOR IS (GREEN, RED, WHITE, BLUE, ORANGE, PINK);
-      SUBTYPE FLAG IS COLOR RANGE RED .. BLUE;
- 
-      FUNCTION IDENT_COL (X : COLOR) RETURN COLOR IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           END IF;
-           RETURN GREEN;
-      END IDENT_COL;
- 
- BEGIN
-      TEST ("CC3125B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
-                       "GENERIC IN PARAMETER HAVING AN ENUMERATION " &
-                       "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
-                       "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
-                       "FORMAL PARAMETER");
-      DECLARE
-           GENERIC
-                GEN_COL : IN FLAG;
-           PACKAGE P IS
-                PAC_COL : FLAG := GEN_COL;
-           END P;
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE P1 IS NEW P(IDENT_COL(RED));
-                BEGIN
-                     IF P1.PAC_COL /= IDENT_COL(RED) THEN
-                          FAILED ("INCORRECT VALUE PASSED - 1");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE P2 IS NEW P(IDENT_COL(GREEN));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE P3 IS NEW P(IDENT_COL(PINK));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-           END;
-      END;
-      -------------------------------------------------------------------
- 
-      DECLARE
-           GENERIC
-                TYPE GEN_TYP IS (<>);
-                GEN_COL : IN GEN_TYP;
-           PACKAGE Q IS
-                PAC_COL : GEN_TYP := GEN_COL;
-           END Q;
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE Q1 IS NEW Q(FLAG, IDENT_COL(BLUE));
-                BEGIN
-                     IF Q1.PAC_COL /= IDENT_COL(BLUE) THEN
-                          FAILED ("INCORRECT VALUE PASSED - 4");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE Q2 IS NEW Q(FLAG, IDENT_COL(GREEN));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE Q3 IS NEW Q(FLAG, IDENT_COL(PINK));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-           END;
-      END;
- 
-      RESULT;
- END CC3125B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- CC3125C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A GENERIC IN PARAMETER
- -- HAVING A FLOATING POINT TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
- -- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
- 
- -- TBN  12/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3125C IS
- 
-      TYPE FLT IS DIGITS 5 RANGE -10.0 .. 10.0;
-      SUBTYPE FLO IS FLT RANGE -5.0 .. 5.0;
- 
-      FUNCTION IDENT_FLT (X : FLT) RETURN FLT IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           END IF;
-           RETURN 0.0;
-      END IDENT_FLT;
- 
- BEGIN
-      TEST ("CC3125C", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
-                       "GENERIC IN PARAMETER HAVING A FLOATING POINT " &
-                       "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
-                       "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
-                       "FORMAL PARAMETER");
-      DECLARE
-           GENERIC
-                GEN_FLO : IN FLO;
-           PACKAGE P IS
-                PAC_FLO : FLT := GEN_FLO;
-           END P;
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE P1 IS NEW P(IDENT_FLT(-5.0));
-                BEGIN
-                     IF P1.PAC_FLO /= IDENT_FLT(-5.0) THEN
-                          FAILED ("INCORRECT VALUE PASSED - 1");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE P2 IS NEW P(IDENT_FLT(-5.1));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE P3 IS NEW P(IDENT_FLT(5.1));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-           END;
-      END;
-      -------------------------------------------------------------------
- 
-      DECLARE
-           GENERIC
-                TYPE GEN_TYP IS DIGITS <>;
-                GEN_FLO : IN GEN_TYP;
-           PACKAGE Q IS
-                PAC_FLO : GEN_TYP := GEN_FLO;
-           END Q;
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE Q1 IS NEW Q(FLO, IDENT_FLT(5.0));
-                BEGIN
-                     IF Q1.PAC_FLO /= IDENT_FLT(5.0) THEN
-                          FAILED ("INCORRECT VALUE PASSED - 4");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE Q2 IS NEW Q(FLO, IDENT_FLT(-5.1));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE Q3 IS NEW Q(FLO, IDENT_FLT(5.1));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-           END;
-      END;
- 
-      RESULT;
- END CC3125C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3125d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3125d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- CC3125D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A GENERIC IN PARAMETER
- -- HAVING A FIXED POINT TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
- -- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
- 
- -- TBN  12/15/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3125D IS
- 
-      TYPE FIXED IS DELTA 0.125 RANGE -10.0 .. 10.0;
-      SUBTYPE FIX IS FIXED RANGE -5.0 .. 5.0;
- 
-      FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           END IF;
-           RETURN 0.0;
-      END IDENT_FIX;
- 
- BEGIN
-      TEST ("CC3125D", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
-                       "GENERIC IN PARAMETER HAVING A FIXED POINT " &
-                       "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
-                       "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
-                       "FORMAL PARAMETER");
-      DECLARE
-           GENERIC
-                GEN_FIX : IN FIX;
-           PACKAGE P IS
-                PAC_FIX : FIXED := GEN_FIX;
-           END P;
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE P1 IS NEW P(IDENT_FIX(-5.0));
-                BEGIN
-                     IF P1.PAC_FIX /= IDENT_FIX(-5.0) THEN
-                          FAILED ("INCORRECT VALUE PASSED - 1");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE P2 IS NEW P(IDENT_FIX(-5.2));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE P3 IS NEW P(IDENT_FIX(5.2));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 3");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-           END;
-      END;
-      -------------------------------------------------------------------
- 
-      DECLARE
-           GENERIC
-                TYPE GEN_TYP IS DELTA <>;
-                GEN_FIX : IN GEN_TYP;
-           PACKAGE Q IS
-                PAC_FIX : GEN_TYP := GEN_FIX;
-           END Q;
-      BEGIN
-           BEGIN
-                DECLARE
-                     PACKAGE Q1 IS NEW Q(FIX, IDENT_FIX(5.0));
-                BEGIN
-                     IF Q1.PAC_FIX /= IDENT_FIX(5.0) THEN
-                          FAILED ("INCORRECT VALUE PASSED - 4");
-                     END IF;
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 4");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE Q2 IS NEW Q(FIX, IDENT_FIX(-5.2));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 5");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
-           END;
- 
-           BEGIN
-                DECLARE
-                     PACKAGE Q3 IS NEW Q(FIX, IDENT_FIX(5.2));
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED - 6");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
-           END;
-      END;
- 
-      RESULT;
- END CC3125D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3126a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3126a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3126a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3126a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- CC3126A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL
- --     PARAMETER DOES NOT HAVE THE SAME NUMBER OF COMPONENTS
- --     (PER DIMENSION) AS THE FORMAL PARAMETER. ALSO THAT FOR NULL
- --     ARRAYS NO ERROR IS RAISED.
- 
- -- HISTORY:
- --     LB  12/02/86
- --     DWC 08/11/87  CHANGED HEADING FORMAT.
- --     RJW 10/26/89  INITIALIZED VARIABLE H.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  CC3126A  IS
- 
- BEGIN
-      TEST ("CC3126A","GENERIC ACTUAL PARAMETER MUST HAVE THE SAME "&
-                      "NUMBER OF COMPONENTS (PER DIMENSION) AS THE "&
-                      "GENERIC FORMAL PARMETER");
-      BEGIN
-           DECLARE
-                TYPE ARRY1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-                SUBTYPE ARR IS ARRY1 (1 .. 10);
- 
-                GENERIC
-                     GARR : IN ARR;
-                PACKAGE P IS
-                     NARR : ARR := GARR;
-                END P;
- 
-           BEGIN
-                BEGIN
-                     DECLARE
-                          X : ARRY1 (2 .. 11) := (2 .. 11 => 0);
-                          PACKAGE Q IS NEW P(X);
-                     BEGIN
-                          Q.NARR(2) := 1;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED 1");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
-                          PACKAGE R IS NEW P(S);
-                     BEGIN
-                          FAILED ("EXCEPTION NOT RAISED 2");
-                          R.NARR(1) := IDENT_INT(R.NARR(1));
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED 2");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          G : ARRY1 (1 .. 9) := (1 .. 9 => 0);
-                          PACKAGE K IS NEW P(G);
-                     BEGIN
-                          FAILED ("EXCEPTION NOT RAISED 3");
-                          IF EQUAL(3,3) THEN
-                               K.NARR(1) := IDENT_INT(K.NARR(1));
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED 3");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
-                          PACKAGE F IS NEW P(S(2 .. 11));
-                     BEGIN
-                          F.NARR(2) := IDENT_INT(F.NARR(2));
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED 4");
-                END;
-           END;
- 
-           DECLARE
-                SUBTYPE STR IS STRING(1 .. 20);
- 
-                GENERIC
-                     GVAR : IN STR;
-                PACKAGE M IS
-                     NVAR : STR := GVAR;
-                END M;
- 
-           BEGIN
-                BEGIN
-                     DECLARE
-                          L : STRING (2 .. 15);
-                          PACKAGE U IS NEW M(L);
-                     BEGIN
-                          FAILED ("EXCEPTION NOT RAISED 5");
-                          U.NVAR(2) := IDENT_CHAR(U.NVAR(2));
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED 5");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          H : STRING (1 .. 20) := (OTHERS => 'R');
-                          PACKAGE J IS NEW M(H);
-                     BEGIN
-                          IF EQUAL(3,3) THEN
-                               J.NVAR(2) := IDENT_CHAR(J.NVAR(2));
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED 6");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED STRINGS");
-           END;
- 
-           DECLARE
-                TYPE NARRY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-                SUBTYPE SNARRY IS NARRY (2 .. 0);
- 
-                GENERIC
-                     RD : IN SNARRY;
-                PACKAGE JA IS
-                     CD : SNARRY := RD;
-                END JA;
-           BEGIN
-                BEGIN
-                     DECLARE
-                          AD : NARRY(1 .. 0);
-                          PACKAGE PA IS NEW JA(AD);
-                     BEGIN
-                          IF NOT EQUAL(0,PA.CD'LAST) THEN
-                               FAILED ("PARAMETER ATTRIBUTE INCORRECT");
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED 7");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR ARRAYS "&
-                             "WITH NULL RANGES");
-           END;
-      END;
- 
-      RESULT;
- 
- END CC3126A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3127a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3127a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3127a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3127a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,143 ****
- -- CC3127A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A CONSTRAINED IN FORMAL PARAMETER HAVING A RECORD OR PRIVATE
- --     TYPE WITH DISCRIMINANTS, CHECK THAT CONSTRAINT_ERROR IS RAISED
- --     IF AND ONLY IF CORRESPONDING DISCRIMINANTS OF THE ACTUAL AND
- --     FORMAL PARAMETER DO NOT HAVE THE SAME VALUES.
- 
- -- HISTORY:
- --     LB   12/04/86  CREATED ORIGINAL TEST.
- --     VCL  08/19/87  CORRECTED THE FORMAT OF THIS HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE  CC3127A  IS
- 
-      TYPE INT IS RANGE 1 .. 20;
- 
- BEGIN
-      TEST ("CC3127A","CORRESPONDING DISCRIMINANTS OF THE GENERIC "&
-                      "ACTUAL PARAMETER AND THE GENERIC FORMAL "&
-                      "PARAMETER MUST HAVE THE SAME VALUES.");
-      BEGIN
-           DECLARE
-                TYPE REC (A : INT) IS
-                     RECORD
-                          RINT : POSITIVE := 2;
-                     END RECORD;
-                SUBTYPE CON_REC IS REC(4);
- 
-                GENERIC
-                     GREC : IN CON_REC;
-                PACKAGE PA IS
-                     NREC : CON_REC := GREC;
-                END PA;
-           BEGIN
-                BEGIN
-                     DECLARE
-                          RVAR : REC(3);
-                          PACKAGE AB IS NEW PA(RVAR);
-                     BEGIN
-                          FAILED ("EXCEPTION NOT RAISED 1");
-                          AB.NREC.RINT := IDENT_INT(AB.NREC.RINT);
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED 1");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          SVAR : REC(4);
-                          PACKAGE CD IS NEW PA(SVAR);
-                     BEGIN
-                          IF EQUAL(3,3) THEN
-                               CD.NREC.RINT := IDENT_INT(CD.NREC.RINT);
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED 2");
-                END;
-           END;
- 
-           DECLARE
-                PACKAGE EF IS
-                     TYPE PRI_REC (G : INT) IS PRIVATE;
-                PRIVATE
-                     TYPE PRI_REC (G : INT) IS
-                          RECORD
-                               PINT : POSITIVE := 2;
-                          END RECORD;
-                END EF;
-                SUBTYPE CPRI_REC IS EF.PRI_REC(4);
- 
-                GENERIC
-                     GEN_REC : IN CPRI_REC;
-                PACKAGE GH IS
-                     NGEN_REC : CPRI_REC := GEN_REC;
-                END GH;
- 
-           BEGIN
-                BEGIN
-                     DECLARE
-                          PVAR : EF.PRI_REC(4);
-                          PACKAGE LM IS NEW GH(PVAR);
-                     BEGIN
-                          IF EQUAL(3,3) THEN
-                               LM.NGEN_REC := LM.NGEN_REC;
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED 3");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          PTVAR : EF.PRI_REC(5);
-                          PACKAGE PAC IS NEW GH(PTVAR);
-                     BEGIN
-                          FAILED ("EXCEPTION NOT RAISED 4");
-                          IF EQUAL(3,5) THEN
-                             COMMENT ("DISCRIMINANT OF PAC.NGEN_REC IS "&
-                                        INT'IMAGE(PAC.NGEN_REC.G));
-                          END IF;
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED 4");
-                END;
-           END;
-      END;
- 
-      RESULT;
- 
- END CC3127A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3128a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3128a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3128a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3128a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,358 ****
- -- CC3128A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR A CONSTRAINED IN FORMAL PARAMETER HAVING AN ACCESS TYPE,
- --     CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL PARAMETER IS NOT
- --     NULL AND THE OBJECT DESIGNATED BY THE ACTUAL PARAMETER DOES NOT SATISFY
- --     THE FORMAL PARAMETER'S CONSTRAINTS.
- 
- -- HISTORY:
- --     RJW 10/28/88  CREATED ORIGINAL TEST.
- --     JRL 02/28/96  Removed cases where the designated subtypes of the formal
- --                   and actual do not statically match. Corrected commentary.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3128A IS
- 
- BEGIN
-      TEST ("CC3128A", "FOR A CONSTRAINED IN FORMAL PARAMETER HAVING " &
-                       "AN ACCESS TYPE, CONSTRAINT_ERROR IS RAISED " &
-                       "IF AND ONLY IF THE ACTUAL PARAMETER IS NOT " &
-                       "NULL AND THE OBJECT DESIGNATED BY THE ACTUAL " &
-                       "PARAMETER DOES NOT SATISFY FORMAL PARAMETER'S " &
-                       "CONSTRAINTS");
- 
-      DECLARE
-           TYPE REC (D : INTEGER := 10) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACCREC IS ACCESS REC;
- 
-           SUBTYPE LINK IS ACCREC (5);
- 
-           GENERIC
-                LINK1 : LINK;
-           FUNCTION F (I : INTEGER) RETURN INTEGER;
- 
-           FUNCTION F (I : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF I /= 5 THEN
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
-                             "TO CALL TO FUNCTION F - 1");
-                END IF;
-                IF NOT EQUAL (I, 5) AND THEN
-                   NOT EQUAL (LINK1.D, LINK1.D) THEN
-                     COMMENT ("DISREGARD");
-                END IF;
-                RETURN I + 1;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 1");
-                RETURN I + 1;
-           END F;
- 
-           GENERIC
-                TYPE PRIV (D : INTEGER) IS PRIVATE;
-                PRIV1 : PRIV;
-           PACKAGE GEN IS
-                TYPE ACCPRIV IS ACCESS PRIV;
-                SUBTYPE LINK IS ACCPRIV (5);
-                GENERIC
-                     LINK1 : LINK;
-                     I : IN OUT INTEGER;
-                PACKAGE P IS END P;
-           END GEN;
- 
-           PACKAGE BODY GEN IS
-                PACKAGE BODY P IS
-                BEGIN
-                     IF I /= 5 THEN
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
-                                  "TO PACKAGE BODY P - 1");
-                     END IF;
-                     IF NOT EQUAL (I, 5) AND THEN
-                        NOT EQUAL (LINK1.D, LINK1.D) THEN
-                          COMMENT ("DISREGARD");
-                     END IF;
-                     I := I + 1;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED WITHIN " &
-                                  "PACKAGE P - 1");
-                     I := I + 1;
-                END P;
- 
-           BEGIN
-                BEGIN
-                     DECLARE
-                          AR10 : ACCPRIV;
-                          I : INTEGER := IDENT_INT (5);
-                          PACKAGE P1 IS NEW P (AR10, I);
-                     BEGIN
-                          IF I /= 6 THEN
-                               FAILED ("INCORRECT RESULT - " &
-                                       "PACKAGE P1");
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED TOO LATE - " &
-                                       "PACKAGE P1 - 1");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
-                                  "OF PACKAGE P1 WITH NULL ACCESS " &
-                                  "VALUE");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          AR10 : ACCPRIV := NEW PRIV'(PRIV1);
-                          I : INTEGER := IDENT_INT (0);
-                          PACKAGE P1 IS NEW P (AR10, I);
-                     BEGIN
-                          FAILED ("NO EXCEPTION RAISED BY " &
-                                  "INSTANTIATION OF PACKAGE P1");
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED TOO LATE - " &
-                                       "PACKAGE P1 - 2");
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED AT " &
-                                  "INSTANTIATION OF PACKAGE P1");
-                END;
-           END GEN;
- 
-           PACKAGE NEWGEN IS NEW GEN (REC, (D => 10));
- 
-      BEGIN
-           BEGIN
-                DECLARE
-                     I : INTEGER := IDENT_INT (5);
-                     AR10 : ACCREC;
-                     FUNCTION F1 IS NEW F (AR10);
-                BEGIN
-                     I := F1 (I);
-                     IF I /= 6 THEN
-                          FAILED ("INCORRECT RESULT RETURNED BY " &
-                                  "FUNCTION F1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED AT CALL TO " &
-                                  "FUNCTION F1 - 1");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
-                             "FUNCTION F1 WITH NULL ACCESS VALUE");
-           END;
- 
-           BEGIN
-                DECLARE
-                     I : INTEGER := IDENT_INT (0);
-                     AR10 : ACCREC := NEW REC'(D => 10);
-                     FUNCTION F1 IS NEW F (AR10);
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
-                             "OF FUNCTION F1");
-                     I := F1 (I);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED AT CALL TO " &
-                                  "FUNCTION F1 - 2");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED AT " &
-                             "INSTANTIATION OF FUNCTION F1");
-           END;
-      END;
- 
-      DECLARE
-           TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
- 
-           TYPE ACCARR IS ACCESS ARR;
- 
-           SUBTYPE LINK IS ACCARR (1 .. 5);
- 
-           GENERIC
-                LINK1 : LINK;
-           FUNCTION F (I : INTEGER) RETURN INTEGER;
- 
-           FUNCTION F (I : INTEGER) RETURN INTEGER IS
-           BEGIN
-                IF I /= 5 THEN
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
-                             "TO CALL TO FUNCTION F - 2");
-                END IF;
-                IF NOT EQUAL (I, 5) AND THEN
-                   NOT EQUAL (LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
-                   THEN
-                     COMMENT ("DISREGARD");
-                END IF;
-                RETURN I + 1;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 2");
-                RETURN I + 1;
-           END F;
- 
-           GENERIC
-                TYPE GENARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
-           PACKAGE GEN IS
-                TYPE ACCGENARR IS ACCESS GENARR;
-                SUBTYPE LINK IS ACCGENARR (1 .. 5);
-                GENERIC
-                     LINK1 : LINK;
-                     I : IN OUT INTEGER;
-                PACKAGE P IS END P;
-           END GEN;
- 
-           PACKAGE BODY GEN IS
-                PACKAGE BODY P IS
-                BEGIN
-                     IF I /= 5 THEN
-                          FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
-                                  "TO PACKAGE BODY P - 2");
-                     END IF;
-                     IF NOT EQUAL (I, 5) AND THEN
-                        NOT
-                        EQUAL(LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
-                        THEN
-                          COMMENT ("DISREGARD");
-                     END IF;
-                     I := I + 1;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED WITHIN " &
-                                  "PACKAGE P - 2");
-                     I := I + 1;
-                END P;
- 
-           BEGIN
-                BEGIN
-                     DECLARE
-                          AR26 : ACCGENARR (2 .. 6);
-                          I : INTEGER := IDENT_INT (5);
-                          PACKAGE P2 IS NEW P (AR26, I);
-                     BEGIN
-                          IF I /= 6 THEN
-                               FAILED ("INCORRECT RESULT - " &
-                                       "PACKAGE P2");
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED TOO LATE - " &
-                                       "PACKAGE P2 - 1");
-                     END;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
-                                  "OF PACKAGE P2 WITH NULL ACCESS " &
-                                  "VALUE");
-                END;
- 
-                BEGIN
-                     DECLARE
-                          AR26 : ACCGENARR
-                                 (IDENT_INT (2) .. IDENT_INT (6)) :=
-                                 NEW GENARR'(1,2,3,4,5);
-                          I : INTEGER := IDENT_INT (0);
-                          PACKAGE P2 IS NEW P (AR26, I);
-                     BEGIN
-                          FAILED ("NO EXCEPTION RAISED BY " &
-                                  "INSTANTIATION OF PACKAGE P2");
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED TOO LATE - " &
-                                       "PACKAGE P2 - 2");
-                     END;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED AT " &
-                                  "INSTANTIATION OF PACKAGE P2");
-                END;
-           END GEN;
- 
-           PACKAGE NEWGEN IS NEW GEN (ARR);
- 
-      BEGIN
-           BEGIN
-                DECLARE
-                     I : INTEGER := IDENT_INT (5);
-                     AR26 : ACCARR (IDENT_INT (2) .. IDENT_INT (6));
-                     FUNCTION F2 IS NEW F (AR26);
-                BEGIN
-                     I := F2 (I);
-                     IF I /= 6 THEN
-                          FAILED ("INCORRECT RESULT RETURNED BY " &
-                                  "FUNCTION F2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED AT CALL TO " &
-                                  "FUNCTION F2 - 1");
-                END;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
-                             "FUNCTION F2 WITH NULL ACCESS VALUE");
-           END;
- 
-           BEGIN
-                DECLARE
-                     I : INTEGER := IDENT_INT (0);
-                     AR26 : ACCARR (2 .. 6) := NEW ARR'(1,2,3,4,5);
-                     FUNCTION F2 IS NEW F (AR26);
-                BEGIN
-                     FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
-                             "OF FUNCTION F2");
-                     I := F2 (I);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED AT CALL TO " &
-                                  "FUNCTION F2 - 2");
-                END;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED AT " &
-                             "INSTANTIATION OF FUNCTION F2");
-           END;
-      END;
-      RESULT;
- END CC3128A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3203a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3203a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3203a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- CC3203A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC FORMAL LIMITED/NON LIMITED PRIVATE TYPE HAS
- -- DISCRIMINANTS, THE ACTUAL PARAMETER CAN HAVE DEFAULT DISCRIMINANT
- -- VALUES.
- 
- -- SPS 7/9/82
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CC3203A IS
- BEGIN
-      TEST ("CC3203A", "CHECK DEFAULT VALUES FOR LIMITED/" &
-            "NON LIMITED GENERIC FORMAL PRIVATE TYPES");
-      DECLARE
-           SD : INTEGER := IDENT_INT(0);
- 
-           FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER;
- 
-           TYPE REC (D : INTEGER := 3) IS
-                RECORD NULL; END RECORD;
- 
-           TYPE RC(C : INTEGER := INIT_RC (1)) IS
-                RECORD NULL; END RECORD;
- 
-           GENERIC
-                TYPE PV(X : INTEGER) IS PRIVATE;
-                TYPE LP(X : INTEGER) IS LIMITED PRIVATE;
-           PACKAGE PACK IS
-                SUBTYPE NPV IS PV;
-                SUBTYPE NLP IS LP;
-           END PACK;
- 
-           FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER IS
-                BEGIN
-                     SD := SD + X;
-                     RETURN SD;
-           END INIT_RC;
- 
-           PACKAGE P1 IS NEW PACK (REC, RC);
- 
-           PACKAGE P2 IS
-                P1VP : P1.NPV;
-                P1VL : P1.NLP;
-                P1VL2 : P1.NLP;
-           END P2;
-           USE P2;
-      BEGIN
- 
-           IF P1VP.D /= IDENT_INT(3) THEN
-                FAILED ("DEFAULT DISCRIMINANT VALUE WRONG");
-           END IF;
- 
-           IF P1VL.C /= 1 THEN
-                FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT");
-           END IF;
- 
-           IF P1VL2.C /= IDENT_INT(2) THEN
-                FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT " &
-                        "WHEN NEEDED");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END CC3203A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3207b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3207b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3207b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- CC3207B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INSTANTIATION IS LEGAL IF A FORMAL
- --     PARAMETER HAVING A LIMITED PRIVATE TYPE WITHOUT
- --     A DISCRIMINANT IS USED TO DECLARE AN ACCESS
- --     TYPE IN A BLOCK THAT CONTAINS A SELECTIVE WAIT
- --     WITH A TERMINATE ALTERNATIVE, AND ACTUAL
- --     PARAMETER'S BASE IS A TASK TYPE OR TYPE WITH A
- --     SUBCOMPONENT OF A TASK TYPE.
- 
- -- HISTORY:
- --     LDC  06/24/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CC3207B IS
- BEGIN
-      TEST("CC3207B","CHECK THAT INSTANTIATION IS LEGAL IF A "     &
-                     "FORMAL PARAMETER HAVING A LIMITED PRIVATE "  &
-                     "TYPE WITHOUT A DISCRIMINANT IS USED TO "     &
-                     "DECLARE AN ACCESS TYPE IN A BLOCK THAT "     &
-                     "CONTAINS A SELECTIVE WAIT WITH A TERMINATE " &
-                     "ALTERNATIVE, AND ACTUAL PARAMETER'S BASE "   &
-                     "A TASK TYPE OR TYPE WITH A SUBCOMPONENT OF " &
-                     "A TASK TYPE. ");
- 
-      DECLARE
-           TASK TYPE TT IS
-                ENTRY E;
-           END TT;
- 
-           TYPE TT_ARR IS ARRAY (1..2) OF TT;
- 
-           TYPE TT_REC IS RECORD
-                COMP : TT_ARR;
-           END RECORD;
- 
-           GENERIC
-                TYPE T IS LIMITED PRIVATE;
-           PACKAGE GEN IS
-                TASK TSK IS
-                     ENTRY ENT(A : OUT INTEGER);
-                END TSK;
-           END GEN;
- 
-           INT : INTEGER;
- 
-           TASK BODY TT IS
-           BEGIN
-                SELECT
-                     ACCEPT E;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END TT;
- 
-           PACKAGE BODY GEN IS
-                TASK BODY TSK IS
-                BEGIN
-                     DECLARE
-                          TYPE ACC_T IS ACCESS T;
-                          TA : ACC_T := NEW T;
-                     BEGIN
-                          SELECT
-                               ACCEPT ENT(A : OUT INTEGER) DO
-                                    A := IDENT_INT(7);
-                               END;
-                          OR
-                               TERMINATE;
-                          END SELECT;
-                     END;
-                END TSK;
-           END GEN;
- 
-           PACKAGE GEN_TSK     IS NEW GEN(TT);
-           PACKAGE GEN_TSK_SUB IS NEW GEN(TT_REC);
- 
-      BEGIN
-           GEN_TSK.TSK.ENT(INT);
- 
-           IF INT /= IDENT_INT(7) THEN
-                FAILED("THE WRONG VALUE WAS RETURNED BY THE TASK");
-           END IF;
- 
-           INT := 0;
-           GEN_TSK_SUB.TSK.ENT(INT);
- 
-           IF INT /= IDENT_INT(7) THEN
-                FAILED("THE WRONG VALUE WAS RETURNED BY THE TASK, " &
-                       "WITH ACTUAL PARAMETER'S BASE IS A SUB" &
-                       "COMPONENT OF A TASK TYPE");
-           END IF;
-           RESULT;
-      END;
- END CC3207B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3220a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3220a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3220a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3220a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- CC3220A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
- -- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
- -- OPERATIONS OF THE ACTUAL TYPE.
- 
- -- TBN  10/08/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3220A IS
- 
-      GENERIC
-           TYPE T IS (<>);
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
- BEGIN
-      TEST ("CC3220A", "CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS " &
-                       "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE
-           OBJ_INT : INTEGER := 1;
- 
-           PACKAGE P1 IS NEW P (INTEGER);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1);
-           IF PAC_VAR /= OBJ_INT THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_INT := PAC_VAR + OBJ_INT;
-           IF OBJ_INT <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := PAC_VAR * OBJ_INT;
-           IF PAC_VAR NOT IN INTEGER THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_INT NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_NEWT := 1;
-           OBJ_NEWT := OBJ_NEWT + 1;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           IF NEW_T'SUCC(2) /= 3 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
-           OBJ_ENU : ENUM := RED;
- 
-           PACKAGE P2 IS NEW P (ENUM);
-           USE P2;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(RED);
-           IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           IF PAC_VAR NOT IN ENUM THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF OBJ_ENU NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-           IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
-                FAILED ("INCORRECT RESULTS - 11");
-           END IF;
-           OBJ_ENU := SUB_T'SUCC(PAC_VAR);
-           IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
-                FAILED ("INCORRECT RESULTS - 12");
-           END IF;
-           OBJ_NEWT := BLUE;
-           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 13");
-           END IF;
-           IF NEW_T'WIDTH /= 6 THEN
-                FAILED ("INCORRECT RESULTS - 14");
-           END IF;
-      END;
- 
-      DECLARE
-           OBJ_CHR : CHARACTER := 'A';
- 
-           PACKAGE P3 IS NEW P (CHARACTER);
-           USE P3;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-           ARA_NEWT : ARRAY (1 .. 5) OF NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'('A');
-           IF (PAC_VAR < OBJ_CHR) OR (PAC_VAR > OBJ_CHR) THEN
-                FAILED ("INCORRECT RESULTS - 15");
-           END IF;
-           IF PAC_VAR NOT IN CHARACTER THEN
-                FAILED ("INCORRECT RESULTS - 16");
-           END IF;
-           IF OBJ_CHR NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 17");
-           END IF;
-           IF CHARACTER'VAL(0) /= SUB_T'VAL(0) THEN
-                FAILED ("INCORRECT RESULTS - 18");
-           END IF;
-           OBJ_CHR := SUB_T'SUCC(PAC_VAR);
-           IF SUB_T'POS('A') /= 65 AND THEN OBJ_CHR /= 'A' THEN
-                FAILED ("INCORRECT RESULTS - 19");
-           END IF;
-           OBJ_NEWT := 'C';
-           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 20");
-           END IF;
-           IF NEW_T'IMAGE('A') /= "'A'" THEN
-                FAILED ("INCORRECT RESULTS - 21");
-           END IF;
-           ARA_NEWT := "HELLO";
-           IF (NEW_T'('H') & NEW_T'('I')) /= "HI" THEN
-                FAILED ("INCORRECT RESULTS - 22");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3220A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3221a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3221a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3221a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3221a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- CC3221A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT AN INTEGER FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
- -- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
- -- OPERATIONS OF THE ACTUAL TYPE.
- 
- -- TBN  10/09/86
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3221A IS
- 
-      GENERIC
-           TYPE T IS RANGE <>;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
- BEGIN
-      TEST ("CC3221A", "CHECK THAT AN INTEGER FORMAL TYPE DENOTES ITS " &
-                       "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE
-           TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
- 
-           OBJ_INT : INTEGER := 1;
-           OBJ_FLO : FLOAT := 1.0;
-           OBJ_FIX : FIXED := 1.0;
- 
-           PACKAGE P1 IS NEW P (INTEGER);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1);
-           IF PAC_VAR /= OBJ_INT THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_INT := PAC_VAR + OBJ_INT;
-           IF OBJ_INT <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := PAC_VAR * OBJ_INT;
-           IF PAC_VAR NOT IN INTEGER THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_INT NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           PAC_VAR := 1;
-           OBJ_FIX := PAC_VAR * OBJ_FIX;
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           OBJ_INT := 1;
-           OBJ_FIX := OBJ_FIX / OBJ_INT;
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           OBJ_INT := OBJ_INT ** PAC_VAR;
-           IF OBJ_INT /= 1 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_FLO := OBJ_FLO ** PAC_VAR;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           OBJ_NEWT := 1;
-           OBJ_NEWT := OBJ_NEWT - 1;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-           IF NEW_T'SUCC(2) /= 3 THEN
-                FAILED ("INCORRECT RESULTS - 11");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3221A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3222a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3222a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3222a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3222a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- CC3222A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FLOATING POINT FORMAL TYPE DENOTES ITS ACTUAL
- --     PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH
- --     CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
- 
- -- HISTORY:
- --     TBN 10/09/86  CREATED ORIGINAL TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3222A IS
- 
-      TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 10.0;
- 
-      GENERIC
-           TYPE T IS DIGITS <>;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      FUNCTION IDENT_FLO (X : FLOAT) RETURN FLOAT IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           ELSE
-                RETURN (0.0);
-           END IF;
-      END IDENT_FLO;
- 
- BEGIN
-      TEST ("CC3222A", "CHECK THAT A FLOATING POINT FORMAL TYPE " &
-                       "DENOTES ITS ACTUAL PARAMETER, AND OPERATIONS " &
-                       "OF THE FORMAL TYPE ARE IDENTIFIED WITH " &
-                       "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE
-           OBJ_INT : INTEGER := 1;
-           OBJ_FLO : FLOAT := 1.0;
- 
-           PACKAGE P1 IS NEW P (FLOAT);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1.0);
-           IF PAC_VAR /= OBJ_FLO THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
-           IF OBJ_FLO <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := PAC_VAR * OBJ_FLO;
-           IF PAC_VAR NOT IN FLOAT THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_FLO NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           PAC_VAR := 1.0;
-           OBJ_FLO := 1.0;
-           OBJ_FLO := PAC_VAR * OBJ_FLO;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_FLO := 1.0;
-           OBJ_FLO := OBJ_FLO / OBJ_FLO;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           PAC_VAR := 1.0;
-           OBJ_FLO := PAC_VAR ** OBJ_INT;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           IF SUB_T'DIGITS /= 5 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_NEWT := 1.0;
-           OBJ_NEWT := OBJ_NEWT - 1.0;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF NEW_T'DIGITS /= 5 THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3222A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3223a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3223a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3223a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3223a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,114 ****
- -- CC3223A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FIXED POINT FORMAL TYPE DENOTES ITS ACTUAL
- --     PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED
- --     WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
- 
- -- HISTORY:
- --     TBN 10/09/86  CREATED ORIGINAL TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3223A IS
- 
-      TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
- 
-      GENERIC
-           TYPE T IS DELTA <>;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           ELSE
-                RETURN (0.0);
-           END IF;
-      END IDENT_FIX;
- 
- BEGIN
-      TEST ("CC3223A", "CHECK THAT A FIXED POINT FORMAL TYPE DENOTES " &
-                       "ITS ACTUAL PARAMETER, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE
-           OBJ_INT : INTEGER := 1;
-           OBJ_FIX : FIXED := 1.0;
- 
-           PACKAGE P1 IS NEW P (FIXED);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1.0);
-           IF PAC_VAR /= OBJ_FIX THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
-           IF OBJ_FIX <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := OBJ_INT * OBJ_FIX;
-           IF PAC_VAR NOT IN FIXED THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_FIX NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           IF SUB_T'DELTA /= 0.125 THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_NEWT := 1.0;
-           OBJ_NEWT := OBJ_NEWT - 1.0;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           IF NEW_T'DELTA /= 0.125 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           OBJ_NEWT := NEW_T'SMALL + 1.0;
-           OBJ_FIX := 1.0;
-           OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_FIX := 1.0;
-           OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF FIXED'SMALL /= NEW_T'SMALL THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3223A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3224a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3224a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3224a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3224a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,313 ****
- -- CC3224A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --     CHECK THAT A FORMAL ARRAY TYPE DENOTES ITS ACTUAL
- --     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE
- --     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
- 
- -- HISTORY:
- --     DHH 09/19/88  CREATED ORIGINAL TEST.
- --     EDWARD V. BERARD, 14 AUGUST 1990  ADDED CHECKS FOR MULTI-
- --                                       DIMENSIONAL ARRAYS
- --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
- 
- WITH REPORT ;
- 
- PROCEDURE CC3224A IS
- 
-     SUBTYPE INT IS INTEGER RANGE 1 .. 3;
-     TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
-     TYPE B_ARR IS ARRAY(1 .. 3) OF BOOLEAN;
- 
-     Q : ARR;
-     R : B_ARR;
-      
-     GENERIC
-         TYPE T IS ARRAY(INT) OF INTEGER;
-     PACKAGE P IS
-         SUBTYPE SUB_T IS T;
-         X : SUB_T := (1, 2, 3);
-     END P;
- 
-     GENERIC
-         TYPE T IS ARRAY(INT) OF BOOLEAN;
-     PACKAGE BOOL IS
-         SUBTYPE SUB_T IS T;
-     END BOOL;
-      
-     SHORT_START : CONSTANT := -100 ;
-     SHORT_END   : CONSTANT := 100 ;
-     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
-     
-     SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
-     
-     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
-                         SEP, OCT, NOV, DEC) ;
-                         
-     SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
-     
-     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
-     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
-     TYPE DATE IS RECORD
-       MONTH : MONTH_TYPE ;
-       DAY   : DAY_TYPE ;
-       YEAR  : YEAR_TYPE ;
-     END RECORD ;
-     
-     TODAY         : DATE := (MONTH => AUG,
-                              DAY   => 8,
-                              YEAR  => 1990) ;
-                             
-     FIRST_DATE    : DATE := (DAY   => 6,
-                              MONTH => JUN,
-                              YEAR  => 1967) ;
-                             
-     WALL_DATE     : DATE := (MONTH => NOV,
-                              DAY   => 9,
-                              YEAR  => 1989) ;
-                             
-     SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
-                             
-     TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
-                                      FIRST_HALF,
-                                      FIRST_FIVE) OF DATE ;
-                                      
-     TD_ARRAY        : THREE_DIMENSIONAL ;
-     SECOND_TD_ARRAY : THREE_DIMENSIONAL ;
-                                      
-     GENERIC
-     
-         TYPE CUBE IS ARRAY (REALLY_SHORT,
-                             FIRST_HALF,
-                             FIRST_FIVE) OF DATE ;
-                             
-     PACKAGE TD_ARRAY_PACKAGE IS
-     
-         SUBTYPE SUB_CUBE IS CUBE ;
-         TEST_3D_ARRAY : SUB_CUBE := (THREE_DIMENSIONAL'RANGE =>
-                                     (THREE_DIMENSIONAL'RANGE (2) =>
-                                     (THREE_DIMENSIONAL'RANGE (3) =>
-                                      TODAY))) ;
-                                      
-     END TD_ARRAY_PACKAGE ;
- 
- 
- BEGIN  -- CC3224A
- 
-     REPORT.TEST ("CC3224A", "CHECK THAT A FORMAL ARRAY TYPE DENOTES " &
-                  "ITS ACTUAL PARAMETER, AND THAT OPERATIONS OF " &
-                  "THE FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &
-                  "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
- 
-     ONE_DIMENSIONAL:
-      
-     DECLARE
- 
-         PACKAGE P1 IS NEW P (ARR);
- 
-         TYPE NEW_T IS NEW P1.SUB_T;
-         OBJ_NEWT : NEW_T;
-           
-     BEGIN  -- ONE_DIMENSIONAL
-      
-         IF NEW_T'FIRST /= ARR'FIRST THEN
-             REPORT.FAILED("'FIRST ATTRIBUTE REPORT.FAILED");
-         END IF;
-           
-         IF NEW_T'LAST /= ARR'LAST THEN
-             REPORT.FAILED("'LAST ATTRIBUTE REPORT.FAILED");
-         END IF;
-           
-         IF NEW_T'FIRST(1) /= ARR'FIRST(1) THEN
-             REPORT.FAILED("'FIRST(N) ATTRIBUTE REPORT.FAILED");
-         END IF;
-           
-         IF NOT (NEW_T'LAST(1) = ARR'LAST(1)) THEN
-             REPORT.FAILED("'LAST(N) ATTRIBUTE REPORT.FAILED");
-         END IF;
-           
-         IF 2 NOT IN NEW_T'RANGE THEN
-             REPORT.FAILED("'RANGE ATTRIBUTE REPORT.FAILED");
-         END IF;
-           
-         IF 3 NOT IN NEW_T'RANGE(1) THEN
-             REPORT.FAILED("'RANGE(N) ATTRIBUTE REPORT.FAILED");
-         END IF;
-           
-         IF NEW_T'LENGTH /= ARR'LENGTH THEN
-             REPORT.FAILED("'LENGTH ATTRIBUTE REPORT.FAILED");
-         END IF;
-           
-         IF NEW_T'LENGTH(1) /= ARR'LENGTH(1) THEN
-             REPORT.FAILED("'LENGTH(N) ATTRIBUTE REPORT.FAILED");
-          END IF;
-            
-         OBJ_NEWT := (1, 2, 3);
-         IF REPORT.IDENT_INT(3) /= OBJ_NEWT(3) THEN
-             REPORT.FAILED("ASSIGNMENT REPORT.FAILED");
-         END IF;
- 
-         IF NEW_T'(1, 2, 3) NOT IN NEW_T THEN
-             REPORT.FAILED("QUALIFIED EXPRESSION REPORT.FAILED");
-         END IF;
- 
-         Q := (1, 2, 3);
-         IF NEW_T(Q) /= OBJ_NEWT THEN
-             REPORT.FAILED("EXPLICIT CONVERSION REPORT.FAILED");
-         END IF;
-         
-         IF Q(1) /= OBJ_NEWT(1) THEN
-             REPORT.FAILED("INDEXING REPORT.FAILED");
-         END IF;
-         
-         IF (1, 2) /= OBJ_NEWT(1 .. 2) THEN
-             REPORT.FAILED("SLICE REPORT.FAILED");
-         END IF;
-         
-         IF (1, 2) & OBJ_NEWT(3) /= NEW_T(Q)THEN
-             REPORT.FAILED("CATENATION REPORT.FAILED");
-         END IF;
-         
-         IF NOT (P1.X IN ARR) THEN
-             REPORT.FAILED ("FORMAL DOES NOT DENOTE ACTUAL");
-         END IF;
-           
-     END ONE_DIMENSIONAL ;
- 
-     BOOLEAN_ONE_DIMENSIONAL:
-      
-     DECLARE
- 
-         PACKAGE B1 IS NEW BOOL (B_ARR);
- 
-         TYPE NEW_T IS NEW B1.SUB_T;
-         OBJ_NEWT : NEW_T;
-           
-     BEGIN  -- BOOLEAN_ONE_DIMENSIONAL
- 
-         OBJ_NEWT := (TRUE, TRUE, TRUE);
-         R := (TRUE, TRUE, TRUE);
- 
-         IF (NEW_T'((TRUE, TRUE, TRUE)) XOR OBJ_NEWT) /=
-            NEW_T'((FALSE, FALSE, FALSE)) THEN
-             REPORT.FAILED("XOR REPORT.FAILED - BOOLEAN") ;
-         END IF;
-         
-         IF (NEW_T'((FALSE, FALSE, TRUE)) AND OBJ_NEWT) /=
-            NEW_T'((FALSE, FALSE, TRUE)) THEN
-             REPORT.FAILED("AND REPORT.FAILED - BOOLEAN") ;
-         END IF;
-         
-         IF (NEW_T'((FALSE, FALSE, FALSE)) OR OBJ_NEWT) /=
-            NEW_T'((TRUE, TRUE, TRUE)) THEN
-             REPORT.FAILED("OR REPORT.FAILED - BOOLEAN") ;
-         END IF ;
-           
-     END BOOLEAN_ONE_DIMENSIONAL ;
-      
-     THREE_DIMENSIONAL_TEST:
-      
-     DECLARE
-      
-          PACKAGE TD IS NEW TD_ARRAY_PACKAGE (CUBE => THREE_DIMENSIONAL) ;
-         
-         TYPE NEW_CUBE IS NEW TD.SUB_CUBE ;
-         NEW_CUBE_OBJECT : NEW_CUBE ;
-         
-     BEGIN  -- THREE_DIMENSIONAL_TEST
-     
-         IF (NEW_CUBE'FIRST /= THREE_DIMENSIONAL'FIRST) OR
-            (NEW_CUBE'FIRST (1) /= THREE_DIMENSIONAL'FIRST) OR
-            (NEW_CUBE'FIRST (2) /= THREE_DIMENSIONAL'FIRST (2)) OR
-            (NEW_CUBE'FIRST (3) /= THREE_DIMENSIONAL'FIRST (3)) THEN
-             REPORT.FAILED ("PROBLEMS WITH 'FIRST FOR MULTI-" &
-                            "DIMENSIONAL ARRAYS.") ;
-         END IF ;
-         
-         IF (NEW_CUBE'LAST /= THREE_DIMENSIONAL'LAST) OR
-            (NEW_CUBE'LAST (1) /= THREE_DIMENSIONAL'LAST) OR
-            (NEW_CUBE'LAST (2) /= THREE_DIMENSIONAL'LAST (2)) OR
-            (NEW_CUBE'LAST (3) /= THREE_DIMENSIONAL'LAST (3)) THEN
-             REPORT.FAILED ("PROBLEMS WITH 'LAST FOR MULTI-" &
-                            "DIMENSIONAL ARRAYS.") ;
-         END IF ;
-         
-         IF (-5 NOT IN NEW_CUBE'RANGE) OR
-            (-3 NOT IN NEW_CUBE'RANGE (1)) OR
-            (FEB NOT IN NEW_CUBE'RANGE (2)) OR
-            ('C' NOT IN NEW_CUBE'RANGE (3)) THEN
-             REPORT.FAILED ("PROBLEMS WITH 'RANGE FOR MULTI-" &
-                            "DIMENSIONAL ARRAYS.") ;
-         END IF ;
-         
-         IF (NEW_CUBE'LENGTH /= THREE_DIMENSIONAL'LENGTH) OR
-            (NEW_CUBE'LENGTH (1) /= THREE_DIMENSIONAL'LENGTH) OR
-            (NEW_CUBE'LENGTH (2) /= THREE_DIMENSIONAL'LENGTH (2)) OR
-            (NEW_CUBE'LENGTH (3) /= THREE_DIMENSIONAL'LENGTH (3)) THEN
-             REPORT.FAILED ("PROBLEMS WITH 'LENGTH FOR MULTI-" &
-                            "DIMENSIONAL ARRAYS.") ;
-         END IF ;
-         
-         NEW_CUBE_OBJECT := (NEW_CUBE'RANGE =>
-                            (NEW_CUBE'RANGE (2) =>
-                            (NEW_CUBE'RANGE (3) =>
-                             FIRST_DATE))) ;
-         IF FIRST_DATE /= NEW_CUBE_OBJECT (-3, MAR, 'D') THEN
-             REPORT.FAILED ("ASSIGNMENT FOR MULTI-DIMENSIONAL " &
-                            "ARRAYS FAILED.") ;
-         END IF ;
-         
-         IF NEW_CUBE'(NEW_CUBE'RANGE =>
-                     (NEW_CUBE'RANGE (2) =>
-                     (NEW_CUBE'RANGE (3) =>
-                      WALL_DATE))) NOT IN NEW_CUBE THEN
-             REPORT.FAILED ("QUALIFIED EXPRESSION FOR MULTI-" &
-                            "DIMENSIONAL ARRAYS FAILED.") ;
-         END IF ;
-         
-         SECOND_TD_ARRAY := (NEW_CUBE'RANGE =>
-                            (NEW_CUBE'RANGE (2) =>
-                            (NEW_CUBE'RANGE (3) =>
-                             FIRST_DATE))) ;
-         IF NEW_CUBE (SECOND_TD_ARRAY) /= NEW_CUBE_OBJECT THEN
-             REPORT.FAILED ("EXPLICIT CONVERSION FOR MULTI-" &
-                            "DIMENSIONAL ARRAYS FAILED.") ;
-         END IF ;
-         
-         IF SECOND_TD_ARRAY (-2, FEB, 'B')
-             /= NEW_CUBE_OBJECT (-2, FEB, 'B') THEN
-             REPORT.FAILED ("INDEXING FOR MULTI-" &
-                            "DIMENSIONAL ARRAYS FAILED.") ;
-         END IF ;
-         
-         IF NOT (TD.TEST_3D_ARRAY IN THREE_DIMENSIONAL) THEN
-             REPORT.FAILED ("FORMAL MULTI-DIMENSIONAL ARRAY " &
-                            "DOES NOT DENOTE ACTUAL.") ;
-         END IF ;
-         
-     END THREE_DIMENSIONAL_TEST ;
-     
-     REPORT.RESULT ;
-      
- END CC3224A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3225a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3225a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3225a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3225a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- CC3225A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FORMAL ACCESS TYPE DENOTES ITS ACTUAL
- --     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE
- --     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
- 
- -- HISTORY:
- --     DHH 10/21/88  CREATED ORIGINAL TEST.
- --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3225A IS
- 
-      GENERIC
-           TYPE NODE IS PRIVATE;
-           TYPE T IS ACCESS NODE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : SUB_T;
-      END P;
- 
- BEGIN
-      TEST ("CC3225A", "CHECK THAT A FORMAL ACCESS TYPE DENOTES ITS " &
-                       "ACTUAL PARAMETER, AND THAT OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &
-                       "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE
-           SUBTYPE INT IS INTEGER RANGE 1 .. 3;
-           TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
-           TYPE ACC_ARR IS ACCESS ARR;
- 
-           Q : ACC_ARR := NEW ARR;
- 
-           PACKAGE P1 IS NEW P (ARR, ACC_ARR);
-           USE P1;
- 
-      BEGIN
-           PAC_VAR := NEW ARR'(1, 2, 3);
-           IF PAC_VAR'FIRST /= Q'FIRST THEN
-                FAILED("'FIRST ATTRIBUTE FAILED");
-           END IF;
-           IF PAC_VAR'LAST /= Q'LAST THEN
-                FAILED("'LAST ATTRIBUTE FAILED");
-           END IF;
-           IF PAC_VAR'FIRST(1) /= Q'FIRST(1) THEN
-                FAILED("'FIRST(N) ATTRIBUTE FAILED");
-           END IF;
-           IF NOT (PAC_VAR'LAST(1) = Q'LAST(1)) THEN
-                FAILED("'LAST(N) ATTRIBUTE FAILED");
-           END IF;
-           IF 2 NOT IN PAC_VAR'RANGE THEN
-                FAILED("'RANGE ATTRIBUTE FAILED");
-           END IF;
-           IF 3 NOT IN PAC_VAR'RANGE(1) THEN
-                FAILED("'RANGE(N) ATTRIBUTE FAILED");
-           END IF;
-           IF PAC_VAR'LENGTH /= Q'LENGTH THEN
-                FAILED("'LENGTH ATTRIBUTE FAILED");
-           END IF;
-           IF PAC_VAR'LENGTH(1) /= Q'LENGTH(1) THEN
-                FAILED("'LENGTH(N) ATTRIBUTE FAILED");
-            END IF;
- 
-           PAC_VAR.ALL := (1, 2, 3);
-           IF IDENT_INT(3) /= PAC_VAR(3) THEN
-                FAILED("ASSIGNMENT FAILED");
-           END IF;
- 
-           IF SUB_T'(PAC_VAR) NOT IN SUB_T THEN
-                FAILED("QUALIFIED EXPRESSION FAILED");
-           END IF;
- 
-           Q.ALL := PAC_VAR.ALL;
-           IF SUB_T(Q) = PAC_VAR THEN
-                FAILED("EXPLICIT CONVERSION FAILED");
-           END IF;
-           IF Q(1) /= PAC_VAR(1) THEN
-                FAILED("INDEXING FAILED");
-           END IF;
-           IF (1, 2) /= PAC_VAR(1 .. 2) THEN
-                FAILED("SLICE FAILED");
-           END IF;
-           IF (1, 2) & PAC_VAR(3) /= PAC_VAR.ALL THEN
-                FAILED("CATENATION FAILED");
-           END IF;
-      END;
- 
-      DECLARE
-           TASK TYPE TSK IS
-                ENTRY ONE;
-           END TSK;
- 
-           GENERIC
-                TYPE T IS ACCESS TSK;
-           PACKAGE P IS
-                SUBTYPE SUB_T IS T;
-                PAC_VAR : SUB_T;
-           END P;
- 
-           TYPE ACC_TSK IS ACCESS TSK;
- 
-           PACKAGE P1 IS NEW P(ACC_TSK);
-           USE P1;
- 
-           GLOBAL : INTEGER := 5;
- 
-           TASK BODY TSK IS
-           BEGIN
-                ACCEPT ONE DO
-                     GLOBAL := 1;
-                END ONE;
-           END;
-      BEGIN
-           PAC_VAR := NEW TSK;
-           PAC_VAR.ONE;
-           IF GLOBAL /= 1 THEN
-                FAILED("TASK ENTRY SELECTION FAILED");
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE REC IS
-                RECORD
-                     I : INTEGER;
-                     B : BOOLEAN;
-                END RECORD;
- 
-           TYPE ACC_REC IS ACCESS REC;
- 
-           PACKAGE P1 IS NEW P (REC, ACC_REC);
-           USE P1;
- 
-      BEGIN
-           PAC_VAR := NEW REC'(4, (PAC_VAR IN ACC_REC));
-           IF PAC_VAR.I /= IDENT_INT(4) AND NOT PAC_VAR.B THEN
-                FAILED("RECORD COMPONENT SELECTION FAILED");
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE REC(B : BOOLEAN := FALSE) IS
-                RECORD
-                     NULL;
-                END RECORD;
- 
-           TYPE ACC_REC IS ACCESS REC;
- 
-           PACKAGE P1 IS NEW P (REC, ACC_REC);
-           USE P1;
- 
-      BEGIN
-           PAC_VAR := NEW REC'(B => PAC_VAR IN ACC_REC);
-           IF NOT PAC_VAR.B THEN
-                FAILED("DISCRIMINANT SELECTION FAILED");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3225A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3230a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3230a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3230a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3230a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- CC3230A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
- --      ACTUAL PARAMETER AN ENUMERATION TYPE, AND OPERATIONS OF THE
- --      FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE
- --      ACTUAL TYPE.
- 
- -- HISTORY:
- --      TBN 09/14/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3230A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PACKAGE LP IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END LP;
- 
- BEGIN
-      TEST ("CC3230A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
-                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
-                       "ENUMERATION TYPE, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE
-           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
-           OBJ_ENU : ENUM := RED;
- 
-           PACKAGE P2 IS NEW P (ENUM);
-           USE P2;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(RED);
-           IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           IF PAC_VAR NOT IN ENUM THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           IF OBJ_ENU NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           OBJ_ENU := SUB_T'SUCC(PAC_VAR);
-           IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_NEWT := BLUE;
-           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           IF NEW_T'WIDTH /= 6 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
-           OBJ_ENU : ENUM := RED;
- 
-           PACKAGE P2 IS NEW LP (ENUM);
-           USE P2;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(RED);
-           IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           IF PAC_VAR NOT IN ENUM THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF OBJ_ENU NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-           IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
-                FAILED ("INCORRECT RESULTS - 11");
-           END IF;
-           OBJ_ENU := SUB_T'SUCC(PAC_VAR);
-           IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
-                FAILED ("INCORRECT RESULTS - 12");
-           END IF;
-           OBJ_NEWT := BLUE;
-           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 13");
-           END IF;
-           IF NEW_T'WIDTH /= 6 THEN
-                FAILED ("INCORRECT RESULTS - 14");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3230A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3231a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3231a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3231a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3231a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,177 ****
- -- CC3231A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
- --      ACTUAL PARAMETER AN INTEGER TYPE, AND OPERATIONS OF THE FORMAL
- --      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
- --      TYPE.
- 
- -- HISTORY:
- --      TBN 09/14/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3231A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PACKAGE LP IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END LP;
- 
- BEGIN
-      TEST ("CC3231A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
-                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
-                       "INTEGER TYPE, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE  -- PRIVATE TYPE.
-           TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
- 
-           OBJ_INT : INTEGER := 1;
-           OBJ_FLO : FLOAT := 1.0;
-           OBJ_FIX : FIXED := 1.0;
- 
-           PACKAGE P1 IS NEW P (INTEGER);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1);
-           IF PAC_VAR /= OBJ_INT THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_INT := PAC_VAR + OBJ_INT;
-           IF OBJ_INT <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := PAC_VAR * OBJ_INT;
-           IF PAC_VAR NOT IN INTEGER THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_INT NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           PAC_VAR := 1;
-           OBJ_FIX := PAC_VAR * OBJ_FIX;
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           OBJ_INT := 1;
-           OBJ_FIX := OBJ_FIX / OBJ_INT;
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           OBJ_INT := OBJ_INT ** PAC_VAR;
-           IF OBJ_INT /= 1 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_FLO := OBJ_FLO ** PAC_VAR;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           OBJ_NEWT := 1;
-           OBJ_NEWT := OBJ_NEWT - 1;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-           IF NEW_T'SUCC(2) /= 3 THEN
-                FAILED ("INCORRECT RESULTS - 11");
-           END IF;
-      END;
- 
-      DECLARE  -- LIMITED PRIVATE TYPE.
-           TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
- 
-           OBJ_INT : INTEGER := 1;
-           OBJ_FLO : FLOAT := 1.0;
-           OBJ_FIX : FIXED := 1.0;
- 
-           PACKAGE P1 IS NEW LP (INTEGER);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1);
-           IF PAC_VAR /= OBJ_INT THEN
-                FAILED ("INCORRECT RESULTS - 12");
-           END IF;
-           OBJ_INT := PAC_VAR + OBJ_INT;
-           IF OBJ_INT <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 13");
-           END IF;
-           PAC_VAR := PAC_VAR * OBJ_INT;
-           IF PAC_VAR NOT IN INTEGER THEN
-                FAILED ("INCORRECT RESULTS - 14");
-           END IF;
-           IF OBJ_INT NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 15");
-           END IF;
-           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
-                FAILED ("INCORRECT RESULTS - 16");
-           END IF;
-           PAC_VAR := 1;
-           OBJ_FIX := PAC_VAR * OBJ_FIX;
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 17");
-           END IF;
-           OBJ_INT := 1;
-           OBJ_FIX := OBJ_FIX / OBJ_INT;
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 18");
-           END IF;
-           OBJ_INT := OBJ_INT ** PAC_VAR;
-           IF OBJ_INT /= 1 THEN
-                FAILED ("INCORRECT RESULTS - 19");
-           END IF;
-           OBJ_FLO := OBJ_FLO ** PAC_VAR;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 20");
-           END IF;
-           OBJ_NEWT := 1;
-           OBJ_NEWT := OBJ_NEWT - 1;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 21");
-           END IF;
-           IF NEW_T'SUCC(2) /= 3 THEN
-                FAILED ("INCORRECT RESULTS - 22");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3231A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3232a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3232a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3232a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3232a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,179 ****
- -- CC3232A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
- --     ACTUAL PARAMETER A FLOATING POINT TYPE, AND OPERATIONS OF THE
- --     FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE
- --     ACTUAL TYPE.
- 
- -- HISTORY:
- --     TBN 09/15/88  CREATED ORIGINAL TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3232A IS
- 
-      TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 10.0;
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PACKAGE LP IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END LP;
- 
-      FUNCTION IDENT_FLO (X : FLOAT) RETURN FLOAT IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           ELSE
-                RETURN (0.0);
-           END IF;
-      END IDENT_FLO;
- 
- BEGIN
-      TEST ("CC3232A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
-                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER A " &
-                       "FLOATING POINT TYPE, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE  -- PRIVATE TYPE.
-           OBJ_INT : INTEGER := 1;
-           OBJ_FLO : FLOAT := 1.0;
- 
-           PACKAGE P1 IS NEW P (FLOAT);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1.0);
-           IF PAC_VAR /= OBJ_FLO THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
-           IF OBJ_FLO <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := PAC_VAR * OBJ_FLO;
-           IF PAC_VAR NOT IN FLOAT THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_FLO NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           PAC_VAR := 1.0;
-           OBJ_FLO := 1.0;
-           OBJ_FLO := PAC_VAR * OBJ_FLO;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_FLO := 1.0;
-           OBJ_FLO := OBJ_FLO / OBJ_FLO;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           PAC_VAR := 1.0;
-           OBJ_FLO := PAC_VAR ** OBJ_INT;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           IF SUB_T'DIGITS /= 5 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_NEWT := 1.0;
-           OBJ_NEWT := OBJ_NEWT - 1.0;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF NEW_T'DIGITS /= 5 THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      DECLARE  -- LIMITED PRIVATE TYPE.
-           OBJ_INT : INTEGER := 1;
-           OBJ_FLO : FLOAT := 1.0;
- 
-           PACKAGE P1 IS NEW LP (FLOAT);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1.0);
-           IF PAC_VAR /= OBJ_FLO THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
-           IF OBJ_FLO <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := PAC_VAR * OBJ_FLO;
-           IF PAC_VAR NOT IN FLOAT THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_FLO NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           PAC_VAR := 1.0;
-           OBJ_FLO := 1.0;
-           OBJ_FLO := PAC_VAR * OBJ_FLO;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_FLO := 1.0;
-           OBJ_FLO := OBJ_FLO / OBJ_FLO;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           PAC_VAR := 1.0;
-           OBJ_FLO := PAC_VAR ** OBJ_INT;
-           IF OBJ_FLO /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           IF SUB_T'DIGITS /= 5 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_NEWT := 1.0;
-           OBJ_NEWT := OBJ_NEWT - 1.0;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF NEW_T'DIGITS /= 5 THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3232A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3233a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3233a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3233a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3233a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,175 ****
- -- CC3233A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
- --     ACTUAL PARAMETER, A FIXED POINT TYPE AND OPERATIONS OF THE FORMAL
- --     TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
- --     TYPE.
- 
- -- HISTORY:
- --     TBN 09/15/88  CREATED ORIGINAL TEST.
- --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3233A IS
- 
-      TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PACKAGE LP IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END LP;
- 
-      FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN X;
-           ELSE
-                RETURN (0.0);
-           END IF;
-      END IDENT_FIX;
- 
- BEGIN
-      TEST ("CC3233A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
-                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, A " &
-                       "FIXED POINT TYPE AND OPERATIONS OF THE FORMAL " &
-                       "TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE  -- PRIVATE TYPE.
-           OBJ_INT : INTEGER := 1;
-           OBJ_FIX : FIXED := 1.0;
- 
-           PACKAGE P1 IS NEW P (FIXED);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1.0);
-           IF PAC_VAR /= OBJ_FIX THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
-           IF OBJ_FIX <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := OBJ_INT * OBJ_FIX;
-           IF PAC_VAR NOT IN FIXED THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_FIX NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           IF SUB_T'DELTA /= 0.125 THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_NEWT := 1.0;
-           OBJ_NEWT := OBJ_NEWT - 1.0;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           IF NEW_T'DELTA /= 0.125 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           OBJ_NEWT := NEW_T'SMALL + 1.0;
-           OBJ_FIX := 1.0;
-           OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_FIX := 1.0;
-           OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF FIXED'SMALL /= NEW_T'SMALL THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      DECLARE  -- LIMITED PRIVATE TYPE.
-           OBJ_INT : INTEGER := 1;
-           OBJ_FIX : FIXED := 1.0;
- 
-           PACKAGE P1 IS NEW LP (FIXED);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1.0);
-           IF PAC_VAR /= OBJ_FIX THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
-           IF OBJ_FIX <= PAC_VAR THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR := OBJ_INT * OBJ_FIX;
-           IF PAC_VAR NOT IN FIXED THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_FIX NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           IF SUB_T'DELTA /= 0.125 THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_NEWT := 1.0;
-           OBJ_NEWT := OBJ_NEWT - 1.0;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           IF NEW_T'DELTA /= 0.125 THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           OBJ_NEWT := NEW_T'SMALL + 1.0;
-           OBJ_FIX := 1.0;
-           OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_FIX := 1.0;
-           OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
-           IF OBJ_FIX /= 1.0 THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF FIXED'SMALL /= NEW_T'SMALL THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3233A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3234a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3234a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3234a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3234a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- CC3234A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
- --      ACTUAL PARAMETER AN ARRAY TYPE, AND OPERATIONS OF THE FORMAL
- --      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
- --      TYPE.
- 
- -- HISTORY:
- --      TBN 09/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3234A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PACKAGE LP IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END LP;
- 
- BEGIN
-      TEST ("CC3234A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
-                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
-                       "ARRAY TYPE, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE  -- PRIVATE TYPE.
-           TYPE ARRAY_TYPE IS ARRAY (1..10) OF INTEGER;
- 
-           OBJ_ARR : ARRAY_TYPE := (OTHERS => 1);
- 
-           PACKAGE P1 IS NEW P (ARRAY_TYPE);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
-           IF PAC_VAR /= OBJ_ARR THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           OBJ_ARR(1) := PAC_VAR(2) + OBJ_ARR(1);
-           IF OBJ_ARR(1) <= PAC_VAR(1) THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           PAC_VAR(1) := PAC_VAR(1) * OBJ_ARR(3);
-           IF PAC_VAR NOT IN ARRAY_TYPE THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF OBJ_ARR NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           IF ARRAY_TYPE'FIRST /= SUB_T'FIRST THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-           OBJ_ARR(1..5) := PAC_VAR(6..10);
-           IF OBJ_ARR(1..5) /= (1, 1, 1, 1, 1) THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           PAC_VAR := (1, 1, 1, 1, 1, 2, 2, 2, 2, 2);
-           OBJ_NEWT := (1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
-           OBJ_NEWT := NEW_T(PAC_VAR);
-           IF OBJ_NEWT(3..7) /= (1, 1, 1, 2, 2) THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-      END;
- 
-      DECLARE  -- LIMITED PRIVATE TYPE.
-           TYPE ARRAY_TYPE IS ARRAY (1..10) OF INTEGER;
- 
-           OBJ_ARR : ARRAY_TYPE := (OTHERS => 1);
- 
-           PACKAGE P1 IS NEW LP (ARRAY_TYPE);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := SUB_T'(1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
-           IF PAC_VAR /= OBJ_ARR THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           OBJ_ARR(1) := PAC_VAR(2) + OBJ_ARR(1);
-           IF OBJ_ARR(1) <= PAC_VAR(1) THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-           PAC_VAR(1) := PAC_VAR(1) * OBJ_ARR(3);
-           IF PAC_VAR NOT IN ARRAY_TYPE THEN
-                FAILED ("INCORRECT RESULTS - 11");
-           END IF;
-           IF OBJ_ARR NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 12");
-           END IF;
-           IF ARRAY_TYPE'FIRST /= SUB_T'FIRST THEN
-                FAILED ("INCORRECT RESULTS - 13");
-           END IF;
-           OBJ_ARR(1..5) := PAC_VAR(6..10);
-           IF OBJ_ARR(1..5) /= (1, 1, 1, 1, 1) THEN
-                FAILED ("INCORRECT RESULTS - 14");
-           END IF;
-           PAC_VAR := (1, 1, 1, 1, 1, 2, 2, 2, 2, 2);
-           OBJ_NEWT := (1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
-           OBJ_NEWT := NEW_T(PAC_VAR);
-           IF OBJ_NEWT(3..7) /= (1, 1, 1, 2, 2) THEN
-                FAILED ("INCORRECT RESULTS - 15");
-           END IF;
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 16");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3234A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3235a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3235a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3235a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3235a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- CC3235A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
- --      ACTUAL PARAMETER AN ACCESS TYPE, AND OPERATIONS OF THE FORMAL
- --      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
- --      TYPE.
- 
- -- HISTORY:
- --      TBN 09/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3235A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PACKAGE LP IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END LP;
- 
- BEGIN
-      TEST ("CC3235A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
-                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
-                       "ACCESS TYPE, AND OPERATIONS OF THE " &
-                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
-                       "OPERATIONS OF THE ACTUAL TYPE");
- 
-      DECLARE  -- PRIVATE TYPE.
-           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
- 
-           TYPE ACCESS_TYPE IS ACCESS ENUM;
- 
-           OBJ_ACC : ACCESS_TYPE := NEW ENUM'(RED);
- 
-           PACKAGE P1 IS NEW P (ACCESS_TYPE);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := NEW ENUM'(RED);
-           IF (PAC_VAR.ALL < OBJ_ACC.ALL) OR
-              (PAC_VAR.ALL > OBJ_ACC.ALL) THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           IF PAC_VAR NOT IN ACCESS_TYPE THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           IF OBJ_ACC NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           OBJ_ACC := NEW ENUM'(ENUM'SUCC(PAC_VAR.ALL));
-           IF OBJ_ACC.ALL /= YELLOW THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-           OBJ_NEWT := NEW ENUM'(BLUE);
-           OBJ_NEWT := NEW ENUM'(ENUM'PRED(OBJ_NEWT.ALL));
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 5");
-           END IF;
-      END;
- 
-      DECLARE  -- LIMITED PRIVATE TYPE.
-           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
- 
-           TYPE ACCESS_TYPE IS ACCESS ENUM;
- 
-           OBJ_ACC : ACCESS_TYPE := NEW ENUM'(RED);
- 
-           PACKAGE P1 IS NEW LP (ACCESS_TYPE);
-           USE P1;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T;
-      BEGIN
-           PAC_VAR := NEW ENUM'(RED);
-           IF (PAC_VAR.ALL < OBJ_ACC.ALL) OR
-              (PAC_VAR.ALL > OBJ_ACC.ALL) THEN
-                FAILED ("INCORRECT RESULTS - 6");
-           END IF;
-           IF PAC_VAR NOT IN ACCESS_TYPE THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           IF OBJ_ACC NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           OBJ_ACC := NEW ENUM'(ENUM'SUCC(PAC_VAR.ALL));
-           IF OBJ_ACC.ALL /= YELLOW THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           OBJ_NEWT := NEW ENUM'(BLUE);
-           OBJ_NEWT := NEW ENUM'(ENUM'PRED(OBJ_NEWT.ALL));
-           IF OBJ_NEWT NOT IN NEW_T THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3235A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3236a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3236a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3236a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3236a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CC3236A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT A FORMAL PRIVATE AND LIMITED PRIVATE TYPE DENOTES ITS
- --      ACTUAL PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE
- --      IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE
- --      WHEN THE ACTUAL PARAMETER IS A TYPE WITH DISCRIMINANTS.
- 
- -- HISTORY:
- --      DHH 10/24/88 CREATED ORIGINAL TEST.
- --      PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3236A IS
- 
-      GENERIC
-           TYPE T IS PRIVATE;
-      PACKAGE P IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END P;
- 
-      GENERIC
-           TYPE T IS LIMITED PRIVATE;
-      PACKAGE LP IS
-           SUBTYPE SUB_T IS T;
-           PAC_VAR : T;
-      END LP;
- 
- BEGIN
-      TEST ("CC3236A", "CHECK THAT A FORMAL PRIVATE OR LIMITED " &
-                       "PRIVATE TYPE DENOTES ITS ACTUAL PARAMETER AND " &
-                       "OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED " &
-                       "WITH CORRESPONDING OPERATIONS OF THE ACTUAL " &
-                       "TYPE, WHEN THE ACTUAL PARAMETER IS A TYPE " &
-                       "WITH DISCRIMINANTS");
- 
-      DECLARE
-           TYPE REC(X : INTEGER := 5) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           OBJ_REC : REC(4);
- 
-           PACKAGE P2 IS NEW P (REC);
-           USE P2;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T(4);
-      BEGIN
-           PAC_VAR := SUB_T'((X => 4));
-           IF PAC_VAR /= OBJ_REC THEN
-                FAILED ("INCORRECT RESULTS - 1");
-           END IF;
-           IF PAC_VAR NOT IN REC THEN
-                FAILED ("INCORRECT RESULTS - 2");
-           END IF;
-           IF OBJ_REC NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 3");
-           END IF;
-           IF PAC_VAR.X /= OBJ_NEWT.X THEN
-                FAILED ("INCORRECT RESULTS - 4");
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE REC(X : INTEGER := 5) IS
-                RECORD
-                     NULL;
-                END RECORD;
-           OBJ_REC : REC(4);
- 
-           PACKAGE P2 IS NEW LP (REC);
-           USE P2;
- 
-           TYPE NEW_T IS NEW SUB_T;
-           OBJ_NEWT : NEW_T(4);
-      BEGIN
-           PAC_VAR := SUB_T'(X => 4);
-           IF PAC_VAR /= OBJ_REC THEN
-                FAILED ("INCORRECT RESULTS - 7");
-           END IF;
-           IF PAC_VAR NOT IN REC THEN
-                FAILED ("INCORRECT RESULTS - 8");
-           END IF;
-           IF OBJ_REC NOT IN SUB_T THEN
-                FAILED ("INCORRECT RESULTS - 9");
-           END IF;
-           IF PAC_VAR.X /= OBJ_NEWT.X THEN
-                FAILED ("INCORRECT RESULTS - 10");
-           END IF;
-      END;
- 
-      RESULT;
- END CC3236A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3240a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3240a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3240a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3240a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- CC3240A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT A FORMAL PRIVATE AND LIMITED PRIVATE TYPE DENOTES ITS
- --      ACTUAL PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE
- --      IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE
- --      WHEN THE FORMAL TYPE IS A TYPE WITH DISCRIMINANTS.
- 
- -- HISTORY:
- --      RJW 10/13/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3240A IS
- 
- BEGIN
-      TEST ("CC3240A", "CHECK THAT A FORMAL PRIVATE OR LIMITED " &
-                       "PRIVATE TYPE DENOTES ITS ACTUAL PARAMETER AND " &
-                       "OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED " &
-                       "WITH CORRESPONDING OPERATIONS OF THE ACTUAL " &
-                       "TYPE, WHEN THE FORMAL TYPE IS A TYPE " &
-                       "WITH DISCRIMINANTS");
- 
-      DECLARE
- 
-           GENERIC
-                TYPE T(A : INTEGER) IS PRIVATE;
-           PACKAGE P IS
-                SUBTYPE S IS T;
-                TX : T(5);
-           END P;
- 
-           TYPE REC (L : INTEGER) IS
-                RECORD
-                     A : INTEGER;
-                END RECORD;
- 
-           PACKAGE P1 IS NEW P (REC);
-           USE P1;
- 
-      BEGIN
-           TX := (L => 5, A => 7);
-           IF NOT (TX IN REC) THEN
-                FAILED ("MEMBERSHIP TEST - PRIVATE");
-           END IF;
- 
-           IF TX.A /= 7 OR TX.L /= 5 THEN
-                FAILED ("SELECTED COMPONENTS - PRIVATE");
-           END IF;
- 
-           IF S(TX) /= REC(TX) THEN
-                FAILED ("EXPLICIT CONVERSION - PRIVATE");
-           END IF;
- 
-           IF NOT TX'CONSTRAINED THEN
-                FAILED ("'CONSTRAINED - PRIVATE");
-           END IF;
-      END;
- 
-      DECLARE
-           TYPE REC(L : INTEGER) IS
-                RECORD
-                     A : INTEGER;
-                END RECORD;
- 
-           GENERIC
-                TYPE T(A : INTEGER) IS LIMITED PRIVATE;
-                TX : IN OUT T;
-           PACKAGE LP IS
-                SUBTYPE S IS T;
-           END LP;
- 
-           R : REC (5) := (5, 7);
- 
-           PACKAGE BODY LP IS
-           BEGIN
-                IF (TX IN S) /= (R IN REC) THEN
-                     FAILED ("MEMBERSHIP TEST - LIMITED PRIVATE");
-                END IF;
- 
-                IF TX.A /= 5 THEN
-                     FAILED ("SELECTED COMPONENTS - LIMITED PRIVATE");
-                END IF;
- 
-                IF (S(TX) IN S) /= (REC(R) IN REC) THEN
-                     FAILED ("EXPLICIT CONVERSION - LIMITED PRIVATE");
-                END IF;
- 
-                IF NOT TX'CONSTRAINED THEN
-                     FAILED ("'CONSTRAINED - LIMITED PRIVATE");
-                END IF;
-           END LP;
- 
-           PACKAGE P1 IS NEW LP (REC, R);
-           USE P1;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC3240A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- CC3305A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
- -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
- 
- -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY (<>).
- 
- -- SPS 7/15/82
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CC3305A IS
- BEGIN
- 
-      TEST ("CC3305A", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
-            "TYPES OF THE FORM (<>)");
- 
-      DECLARE
-           TYPE COLOR IS (RED, BLUE, YELLOW, ORANGE, GREEN, PURPLE);
-           SUBTYPE P_COLOR IS COLOR RANGE BLUE .. ORANGE;
-           SUBTYPE INT IS INTEGER RANGE 1 .. 3;
-           SUBTYPE ATOC IS CHARACTER RANGE CHARACTER'VAL(1) .. 
-                CHARACTER'VAL(3);
- 
-           GENERIC
-                TYPE GFT IS (<>);
-           PACKAGE PK IS END PK;
- 
-           PACKAGE BODY PK IS
-           BEGIN
-                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
-                     COMMENT ("START OF ITERATION");
-                     DECLARE
-                          VAR : GFT;
-                     BEGIN
-                          VAR := GFT'VAL (I);
-                          IF I = 0 OR I = 4 THEN
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               IF I /= 0 AND I /= 4 THEN
-                                    FAILED ("CONSTRAINT_ERROR RAISED " &
-                                       "INAPPROPRIATELY");
-                               END IF;
-                     END;
-                END LOOP;
-           END PK;
- 
-      BEGIN
-           COMMENT ("INSTANTIATION WITH P_COLOR");
-           DECLARE
-                PACKAGE NPC IS NEW PK (P_COLOR);
-           BEGIN
-                NULL;
-           END;
- 
-           COMMENT ("INSTANTIATION WITH INT");
- 
-           DECLARE
-                PACKAGE NPI IS NEW PK (INT);
-           BEGIN
-                NULL;
-           END;
- 
-           COMMENT ("INSTANTIATION WITH ATOC");
- 
-           DECLARE
-                PACKAGE NPA IS NEW PK (ATOC);
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
-      END;
- 
-      RESULT;
- END CC3305A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CC3305B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
- -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
- 
- -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY RANGE <>.
- 
- -- SPS 7/15/82
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CC3305B IS
- BEGIN
- 
-      TEST ("CC3305B", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
-            "TYPES OF THE FORM RANGE <>");
- 
-      DECLARE
-           SUBTYPE INT IS INTEGER RANGE 1 .. 3;
- 
-           GENERIC
-                TYPE GFT IS RANGE <>;
-           PACKAGE PK IS END PK;
- 
-           PACKAGE BODY PK IS
-           BEGIN
-                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
-                     COMMENT ("START OF ITERATION");
-                     DECLARE
-                          VAR : GFT;
-                     BEGIN
-                          VAR := GFT(I);
-                          IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               IF I /= IDENT_INT(0) AND
-                                  I /= IDENT_INT(4) THEN
-                                    FAILED ("CONSTRAINT_ERROR RAISED " &
-                                       "INAPPROPRIATELY");
-                               END IF;
-                     END;
-                END LOOP;
-           END PK;
- 
-      BEGIN
- 
-           DECLARE
-                PACKAGE NPI IS NEW PK (INT);
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
-      END;
- 
-      RESULT;
- END CC3305B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CC3305C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
- -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
- 
- -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY DIGITS <>.
- 
- -- SPS 7/15/82
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CC3305C IS
- BEGIN
- 
-      TEST ("CC3305C", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
-            "TYPES OF THE FORM DIGITS <>");
- 
-      DECLARE
-           SUBTYPE FL IS FLOAT RANGE 1.0 .. 3.0;
- 
-           GENERIC
-                TYPE GFT IS DIGITS <>;
-           PACKAGE PK IS END PK;
- 
-           PACKAGE BODY PK IS
-           BEGIN
-                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
-                     COMMENT ("START OF ITERATION");
-                     DECLARE
-                          VAR : GFT;
-                     BEGIN
-                          VAR := GFT (I);
-                          IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               IF I /= IDENT_INT(0) AND 
-                                  I /= IDENT_INT(4) THEN
-                                    FAILED ("CONSTRAINT_ERROR RAISED " &
-                                       "INAPPROPRIATELY");
-                               END IF;
-                     END;
-                END LOOP;
-           END PK;
- 
-      BEGIN
- 
-           DECLARE
-                PACKAGE NP IS NEW PK (FL);
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
-      END;
- 
-      RESULT;
- END CC3305C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3305d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3305d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CC3305D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
- -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
- 
- -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY DELTA <>.
- 
- -- SPS 7/15/82
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CC3305D IS
- BEGIN
- 
-      TEST ("CC3305D", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
-            "TYPES OF THE FORM DELTA <>");
- 
-      DECLARE
-           TYPE FX IS DELTA 0.1 RANGE 1.0 .. 3.0;
- 
-           GENERIC
-                TYPE GFT IS DELTA <>;
-           PACKAGE PK IS END PK;
- 
-           PACKAGE BODY PK IS
-           BEGIN
-                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
-                     COMMENT ("START OF ITERATION");
-                     DECLARE
-                          VAR : GFT;
-                     BEGIN
-                          VAR := GFT (I);
-                          IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
-                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
-                          END IF;
-                     EXCEPTION
-                          WHEN CONSTRAINT_ERROR =>
-                               IF I /= IDENT_INT(0) AND
-                                  I /= IDENT_INT(4) THEN
-                                    FAILED ("CONSTRAINT_ERROR RAISED " &
-                                       "INAPPROPRIATELY");
-                               END IF;
-                     END;
-                END LOOP;
-           END PK;
- 
-      BEGIN
- 
-           DECLARE
-                PACKAGE NP IS NEW PK (FX);
-           BEGIN
-                NULL;
-           END;
- 
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
-      END;
- 
-      RESULT;
- END CC3305D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,251 ****
- -- CC3601A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL
- -- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN
- -- CC3601C).
- 
- -- R.WILLIAMS 10/9/86
- -- JRL        11/15/95 Added unknown discriminant part to all formal
- --                     private types.
- 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3601A IS
- 
-      GENERIC
-           TYPE T (<>) IS PRIVATE;
-           V, V1 : T;
-           KIND : STRING;
-           WITH FUNCTION F1 (X : IN T) RETURN T;
-      PACKAGE GP1 IS
-           R : BOOLEAN := F1 (V) = V1;
-      END GP1;
- 
-      PACKAGE BODY GP1 IS
-      BEGIN
-           IF NOT (IDENT_BOOL(R)) THEN
-                FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND);
-           END IF;
-      END GP1;
- 
-      GENERIC
-           TYPE T (<>) IS PRIVATE;
-           V, V1, V2 : IN T;
-           KIND : STRING;
-           WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T;
-      PACKAGE GP2 IS
-           R : BOOLEAN := V /= F1 (V1, V2);
-      END GP2;
- 
-      PACKAGE BODY GP2 IS
-      BEGIN
-           IF IDENT_BOOL (R) THEN
-                FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND);
-           END IF;
-      END GP2;
- 
-      
-      GENERIC
-           TYPE T1 (<>) IS PRIVATE;
-           TYPE T2 (<>) IS PRIVATE;
-           V1 : T1;
-           V2 : T2;
-           KIND : STRING;
-           WITH FUNCTION F1 (X : IN T1) RETURN T2;
-      PACKAGE GP3 IS
-           R : BOOLEAN := F1 (V1) = V2;
-      END GP3;
- 
-      PACKAGE BODY GP3 IS
-      BEGIN
-           IF NOT (IDENT_BOOL(R)) THEN
-                FAILED ( "INCORRECT VALUE FOR OP - " & KIND);
-           END IF;
-      END GP3;
- 
- BEGIN
-      TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " &
-                        "PASSED AS ACTUAL GENERIC SUBPROGRAM " &
-                        "PARAMETERS" );
- 
- 
-      BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS
-            -- ACTUAL PARAMETERS.
- 
-           FOR I1 IN BOOLEAN LOOP
- 
-                FOR I2 IN BOOLEAN LOOP
-                     COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " &
-                               "B2 = " & BOOLEAN'IMAGE (I2) );
-                     DECLARE
-                          B1 : BOOLEAN := IDENT_BOOL (I1);
-                          B2 : BOOLEAN := IDENT_BOOL (I2);
- 
-                          PACKAGE P1 IS 
-                               NEW GP1 (BOOLEAN, NOT B2, B2, 
-                                        """NOT"" - 1", "NOT");
-                          PACKAGE P2 IS 
-                               NEW GP2 (BOOLEAN, B1 OR B2, B1, B2, 
-                                        "OR", "OR");
-                          PACKAGE P3 IS  
-                               NEW GP2 (BOOLEAN, B1 AND B2, B2, B1, 
-                                        "AND", "AND");
-                          PACKAGE P4 IS 
-                               NEW GP2 (BOOLEAN, B1 /= B2, B1, B2, 
-                                        "XOR", "XOR");
-                          PACKAGE P5 IS  
-                               NEW GP2 (BOOLEAN, B1 < B2, B1, B2, 
-                                        "<", "<");
-                          PACKAGE P6 IS 
-                               NEW GP2 (BOOLEAN, B1 <= B2, B1, B2, 
-                                        "<=", "<=");
-                          PACKAGE P7 IS  
-                               NEW GP2 (BOOLEAN, B1 > B2, B1, B2, 
-                                        ">", ">");
-                          PACKAGE P8 IS  
-                               NEW GP2 (BOOLEAN, B1 >= B2, B1, B2, 
-                                        ">=", ">=");
- 
-                          TYPE AB IS ARRAY (BOOLEAN RANGE <> ) 
-                               OF BOOLEAN;
-                          AB1 : AB (BOOLEAN) := (B1, B2);
-                          AB2 : AB (BOOLEAN) := (B2, B1);
-                          T : AB (B1 .. B2) := (B1 .. B2 => TRUE);
-                          F : AB (B1 .. B2) := (B1 .. B2 => FALSE);
-                          VB1 : AB (B1 .. B1) := (B1 => B2);
-                          VB2 : AB (B2 .. B2) := (B2 => B1);
- 
-                          PACKAGE P9 IS 
-                               NEW GP1 (AB, AB1, NOT AB1, 
-                                        """NOT"" - 2", "NOT");
-                          PACKAGE P10 IS 
-                               NEW GP1 (AB, T, F, 
-                                        """NOT"" - 3", "NOT");
-                          PACKAGE P11 IS 
-                               NEW GP1 (AB, VB2, (B2 => NOT B1), 
-                                        """NOT"" - 4", "NOT");
-                          PACKAGE P12 IS 
-                               NEW GP2 (AB, AB1 AND AB2, AB1, AB2, 
-                                        "AND", "AND");
-                     BEGIN
-                          NULL;
-                     END;
-                END LOOP;
-           END LOOP;
-      END;
- 
-      DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**", 
-              -- AND "ABS".
-           
-           PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+");
- 
-           PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+");
- 
-           PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3",
-                                  "+");
-           PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-");
- 
-           PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-");
- 
-           PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3", 
-                                  "-");
-           PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+");
- 
-           PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2", 
-                                  "+");
-           PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3",
-                                  "+");
-           PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1",
-                                   "-" );
-           PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0, 
-                                   """-"" - 2", "-");
-           PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3",
-                                   "-");
- 
-           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2;
-           TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER;
-           VSTR : STR (0 .. 1) := "AB";
- 
-           PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) & 
-                                       VSTR (1 .. 1),
-                                       VSTR (0 .. 0),  
-                                       VSTR (1 .. 1), """&"" - 1", "&");
- 
-           PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) & 
-                                       VSTR (0 .. 0),
-                                       VSTR (1 .. 1),  
-                                       VSTR (0 .. 0), """&"" - 2", "&");
-                                         
-           PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*");
- 
-           PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2",
-                                   "*");
-           PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/");
- 
-           PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2",
-                                   "/");
-           PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM");
- 
-           PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD");
-           
-           PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS");
- 
-           PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2", 
-                                   "ABS");
- 
-           PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3", 
-                                   "ABS");
- 
-           PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1", 
-                                   "**");
- 
-           PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2",
-                                   "**");
- 
-      BEGIN
-           NULL;
-      END;
- 
-      DECLARE -- CHECKS WITH ATTRIBUTES.
-           
-           TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI);
- 
-           PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC", 
-                                  WEEKDAY'SUCC);
- 
-           PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED", 
-                                  WEEKDAY'PRED);
-           
-           PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR", 
-                                  "WEEKDAY'IMAGE", WEEKDAY'IMAGE);
- 
-           PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI, 
-                                  "WEEKDAY'VALUE", WEEKDAY'VALUE);
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC3601A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3601c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3601c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3601c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3601c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- CC3601C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT "/=" MAY BE PASSED AS A GENERIC ACTUAL FUNCTION
- -- PARAMETER.
- 
- -- DAT 10/6/81
- -- SPS 10/27/82
- -- JRK 2/9/83
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3601C IS
- BEGIN
-      TEST ("CC3601C", "/= AS GENERIC ACTUAL PARAMETER");
- 
-      DECLARE
-           PACKAGE PK IS
-                TYPE LP IS LIMITED PRIVATE;
-                FUNCTION "=" (X, Y : LP) RETURN BOOLEAN;-- RETURNS FALSE.
-                TYPE INT IS NEW INTEGER;
-           PRIVATE
-                TASK TYPE LP;
-           END PK;
-           USE PK;
- 
-           V1, V2 : LP;
- 
-           TYPE REC IS RECORD
-                C : LP;
-           END RECORD;
- 
-           R1, R2 : REC;
- 
-           TYPE INT IS NEW INTEGER;
- 
-           B1 : BOOLEAN := TRUE;
-           B2 : BOOLEAN := TRUE;
-           INTEGER_3 : INTEGER := 3;
-           INTEGER_4 : INTEGER := 4;
-           INT_3     : INT := 3;
-           INT_4     : INT := 4;
-           INT_5     : INT := 5;
-           PK_INT_M1 : PK.INT := -1;
-           PK_INT_M2 : PK.INT := -2;
-           PK_INT_1  : PK.INT := 1;
-           PK_INT_2  : PK.INT := 2;
-           PK_INT_3  : PK.INT := 3;
- 
-           FUNCTION "=" (Q, R : LP) RETURN BOOLEAN;-- RETURNS TRUE.
- 
-           GENERIC
-                TYPE T IS LIMITED PRIVATE;
-                V1, V2 : IN OUT T;
-                WITH FUNCTION NE (ZA : IN T; ZB : T) RETURN BOOLEAN;
-                VALUE : IN BOOLEAN; -- SHOULD BE VALUE OF NE(V1,V2).
-                STR : STRING;
-           PACKAGE GP IS END GP;
- 
-           FUNCTION "=" (Q, R : IN REC) RETURN BOOLEAN;
- 
-           FUNCTION NE (Q : INT; R : IN INT) RETURN BOOLEAN
-                RENAMES "/=";
- 
-           FUNCTION NE (Q : PK.INT; R : IN PK.INT) RETURN BOOLEAN
-                RENAMES "/=";
- 
-           PACKAGE BODY GP IS
-           BEGIN
-                IF IDENT_BOOL(VALUE) /= NE (V1, V2) THEN
-                     FAILED ("WRONG /= ACTUAL GENERIC PARAMETER "
-                     & STR);
-                END IF;
-           END GP;
- 
-           FUNCTION "=" (Q, R : IN REC) RETURN BOOLEAN IS
-           BEGIN
-                RETURN FALSE;
-           END "=";
- 
-           FUNCTION "=" (Q, R : LP) RETURN BOOLEAN IS
-           BEGIN
-                RETURN TRUE;
-           END "=";
- 
-           PACKAGE BODY PK IS
-                FUNCTION "=" (X, Y : LP) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN R1 = R1;     -- FALSE.
-                END "=";
-                TASK BODY LP IS BEGIN NULL; END;
-           END PK;
- 
-           PACKAGE P1 IS NEW GP (LP, V1, V2, "/=", FALSE, "1");
- 
-           FUNCTION "NOT" (X : BOOLEAN) RETURN BOOLEAN IS
-           BEGIN RETURN X; END "NOT"; -- ENSURES USE OF PREDEFINED "NOT"
- 
-           PACKAGE P2 IS NEW GP (LP,      V1, V2, "/=", FALSE, "2");
-           PACKAGE P3 IS NEW GP (LP, V1, V2, PK."/=", TRUE, "3");
-           PACKAGE P4 IS NEW GP (PK.LP, V1, V2, "/=", FALSE, "4");
-           PACKAGE P5 IS NEW GP (PK.LP, V1, V2, PK."/=", TRUE, "5");
-           PACKAGE P6 IS NEW GP (REC, R1, R2, "/=", TRUE, "6");
-           PACKAGE P7 IS NEW GP (INTEGER, INTEGER_3, INTEGER_4, "/=",
-                                 TRUE, "7");
-           PACKAGE P8 IS NEW GP (BOOLEAN, B1, B2, "/=", FALSE,"8");
-           PACKAGE P9 IS NEW GP (INT, INT_3, INT_5, "/=", TRUE, "9");
-           PACKAGE P10 IS NEW GP (INT, INT_3, INT_3, "/=", FALSE, "10");
-           PACKAGE P11 IS NEW GP (INT, INT_3, INT_4, NE, TRUE, "11");
-           PACKAGE P12 IS NEW GP (INT, INT_3, INT_3, NE, FALSE, "12");
-           PACKAGE P13 IS NEW GP (PK.INT, PK_INT_3, PK_INT_3, NE,
-                                  FALSE, "13");
-           PACKAGE P14 IS NEW GP (PK.INT, PK_INT_M1, PK_INT_M2, NE, 
-                                  TRUE,  "14");
-           PACKAGE P15 IS NEW GP (PK.INT, PK_INT_1, PK_INT_1, "/=",
-                                  FALSE, "15");
-           PACKAGE P16 IS NEW GP (PK.INT, PK_INT_1, PK_INT_2, "/=",
-                                  TRUE,  "16");
-           PACKAGE P17 IS NEW GP (PK.INT, PK_INT_1, PK_INT_1, PK."/=",
-                                  FALSE, "17");
-           PACKAGE P18 IS NEW GP (PK.INT, PK_INT_1, PK_INT_2, PK."/=",
-                                  TRUE,  "18");
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CC3601C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- CC3602A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ENTRIES MAY BE PASSED AS GENERIC SUBPROGRAM
- --     PARAMETERS.
- 
- -- HISTORY:
- --     DAT 9/25/81     CREATED ORIGINAL TEST.
- --     LDC 10/6/88     REVISED; CHECKED THAT DEFAULT NAME CAN BE
- --                     IDENTIFIED WITH ENTRY.
- 
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3602A IS
-      COUNTER : INTEGER := 0;
- BEGIN
-      TEST ("CC3602A", "ENTRIES AS GENERIC SUBPROGRAM PARAMETERS");
- 
-      DECLARE
-           TASK TSK IS
-                ENTRY ENT;
-           END TSK;
- 
-           GENERIC
-                WITH PROCEDURE P;
-           PROCEDURE GP;
- 
-           GENERIC
-                WITH PROCEDURE P;
-           PACKAGE PK IS END PK;
- 
- 
-           PROCEDURE E1 RENAMES TSK.ENT;
- 
-           GENERIC
-                WITH PROCEDURE P IS TSK.ENT;
-           PROCEDURE GP_DEF1;
- 
-           GENERIC
-                WITH PROCEDURE P IS E1;
-           PROCEDURE GP_DEF2;
- 
-           GENERIC
-                WITH PROCEDURE P IS TSK.ENT;
-           PACKAGE PK_DEF1 IS END PK_DEF1;
- 
-           GENERIC
-                WITH PROCEDURE P IS E1;
-           PACKAGE PK_DEF2 IS END PK_DEF2;
- 
-           PROCEDURE GP IS
-           BEGIN
-                P;
-           END GP;
- 
-           PACKAGE BODY PK IS
-           BEGIN
-                P;
-           END PK;
- 
- 
-           PROCEDURE GP_DEF1 IS
-           BEGIN
-                P;
-           END GP_DEF1;
- 
-           PROCEDURE GP_DEF2 IS
-           BEGIN
-                P;
-           END GP_DEF2;
- 
-           PACKAGE BODY PK_DEF1 IS
-           BEGIN
-                P;
-           END PK_DEF1;
- 
-           PACKAGE BODY PK_DEF2 IS
-           BEGIN
-                P;
-           END PK_DEF2;
- 
-           TASK BODY TSK IS
-           BEGIN
-                LOOP
-                     SELECT
-                          ACCEPT ENT DO
-                               COUNTER := COUNTER + 1;
-                          END ENT;
-                     OR
-                          TERMINATE;
-                     END SELECT;
-                END LOOP;
-           END TSK;
- 
-      BEGIN
-           DECLARE
-                PROCEDURE P1 IS NEW GP (TSK.ENT);
-                PROCEDURE E RENAMES TSK.ENT;
-                PROCEDURE P2 IS NEW GP (E);
-                PACKAGE PK1 IS NEW PK (TSK.ENT);
-                PACKAGE PK2 IS NEW PK (E);
- 
-                PROCEDURE P3 IS NEW GP_DEF1;
-                PROCEDURE P4 IS NEW GP_DEF2;
-                PACKAGE PK3 IS NEW PK_DEF1;
-                PACKAGE PK4 IS NEW PK_DEF2;
-           BEGIN
-                P1;
-                P2;
-                TSK.ENT;
-                E;
-                P3;
-                P4;
-           END;
-           TSK.ENT;
-      END;
- 
-      IF COUNTER /= 11 THEN
-           FAILED ("INCORRECT CALL OF ENTRY AS GENERIC PARAMETER");
-      END IF;
- 
-      RESULT;
- END CC3602A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3603a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3603a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3603a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3603a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- CC3603A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ENUMERATION LITERALS (BOTH IDENTIFIERS AND CHARACTER
- --     LITERALS) MAY BE PASSED AS ACTUALS CORRESPONDING TO GENERIC
- --     FORMAL SUBPROGRAMS.
- 
- -- HISTORY:
- --     RJW 06/11/86  CREATED ORIGINAL TEST.
- --     VCL 08/18/87  CHANGED THE SECOND ACTUAL GENERIC PARAMETER IN THE
- --                   INSTANTIATION OF PROCEDURE NP3 TO
- --                   'IDENT_CHAR('X')'.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3603A IS
- 
- BEGIN
-      TEST ("CC3603A", "CHECK THAT ENUMERATION LITERALS (BOTH " &
-                       "IDENTIFIERS AND CHARACTER LITERALS) MAY " &
-                       "BE PASSED AS ACTUALS CORRESPONDING TO " &
-                       "GENERIC FORMAL SUBPROGRAMS" );
- 
-      DECLARE
- 
-           TYPE ENUM1 IS ('A', 'B');
-           TYPE ENUM2 IS (C, D);
- 
-           GENERIC
-                TYPE E IS (<>);
-                E1 : E;
-                WITH FUNCTION F RETURN E;
-           PROCEDURE P;
- 
-           PROCEDURE P IS
-           BEGIN
-                IF F /= E1 THEN
-                     FAILED ( "WRONG VALUE FOR " & E'IMAGE (E1) &
-                              " AS ACTUAL PARAMETER" );
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED INSIDE OF P WITH " &
-                               E'IMAGE (E1) &
-                              " AS ACTUAL PARAMETER" );
-           END P;
- 
-           PROCEDURE NP1 IS NEW P (ENUM1, 'A', 'A');
-           PROCEDURE NP2 IS NEW P (ENUM2, D, D);
-           PROCEDURE NP3 IS NEW P (CHARACTER, IDENT_CHAR('X'), 'X');
-      BEGIN
-           BEGIN
-                NP1;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED WHEN NP1 CALLED" );
-           END;
- 
-           BEGIN
-                NP2;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED WHEN NP2 CALLED" );
-           END;
- 
-           BEGIN
-                NP3;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ( "EXCEPTION RAISED WHEN NP3 CALLED" );
-           END;
-      END;
-      RESULT;
- 
- END CC3603A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,381 ****
- -- CC3605A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SOME DIFFERENCES BETWEEN THE FORMAL AND THE
- --     ACTUAL SUBPROGRAMS DO NOT INVALIDATE A MATCH.
- --          1)  CHECK DIFFERENT PARAMETER NAMES.
- --          2)  CHECK DIFFERENT PARAMETER CONSTRAINTS.
- --          3)  CHECK ONE PARAMETER CONSTRAINED AND THE OTHER
- --               UNCONSTRAINED (WITH ARRAY, RECORD, ACCESS, AND
- --               PRIVATE TYPES).
- --          4)  CHECK PRESENCE OR ABSENCE OF AN EXPLICIT "IN" MODE
- --               INDICATOR.
- --          5)  DIFFERENT TYPE MARKS USED TO SPECIFY THE TYPE OF
- --               PARAMETERS.
- 
- -- HISTORY:
- --     LDC 10/04/88  CREATED ORIGINAL TEST.
- 
- PACKAGE CC3605A_PACK IS
- 
-      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
- 
-      TYPE PRI_TYPE (SIZE : INT) IS PRIVATE;
- 
-      SUBTYPE PRI_CONST IS PRI_TYPE (2);
- 
- PRIVATE
- 
-      TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
- 
-      TYPE PRI_TYPE (SIZE : INT) IS
-           RECORD
-                SUB_A : ARR_TYPE (1 .. SIZE);
-           END RECORD;
- 
- END CC3605A_PACK;
- 
- 
- WITH REPORT;
- USE  REPORT;
- WITH CC3605A_PACK;
- USE  CC3605A_PACK;
- 
- PROCEDURE CC3605A IS
- 
-      SUBTYPE ZERO_TO_TEN IS INTEGER
-           RANGE IDENT_INT (0) .. IDENT_INT (10);
- 
-      SUBTYPE ONE_TO_FIVE IS INTEGER
-           RANGE IDENT_INT (1) .. IDENT_INT (5);
- 
-      SUBPRG_ACT : BOOLEAN := FALSE;
- BEGIN
-      TEST
-           ("CC3605A", "CHECK THAT SOME DIFFERENCES BETWEEN THE " &
-                       "FORMAL AND THE ACTUAL PARAMETERS DO NOT " &
-                       "INVALIDATE A MATCH");
- 
- ----------------------------------------------------------------------
- -- DIFFERENT PARAMETER NAMES
- ----------------------------------------------------------------------
- 
-      DECLARE
- 
-           PROCEDURE ACT_PROC (DIFF_NAME_PARM : ONE_TO_FIVE) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM : ONE_TO_FIVE);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (ONE_TO_FIVE'FIRST);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED
-                     ("DIFFERENT PARAMETER NAMES MADE MATCH INVALID");
-           END IF;
-      END;
- 
- ----------------------------------------------------------------------
- -- DIFFERENT PARAMETER CONSTRAINTS
- ----------------------------------------------------------------------
- 
-      DECLARE
- 
-           PROCEDURE ACT_PROC (PARM : ONE_TO_FIVE) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM : ZERO_TO_TEN);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (ONE_TO_FIVE'FIRST);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           SUBPRG_ACT := FALSE;
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED
-                     ("DIFFERENT PARAMETER CONSTRAINTS MADE MATCH " &
-                      "INVALID");
-           END IF;
-      END;
- 
- ----------------------------------------------------------------------
- -- ONE PARAMETER CONSTRAINED (ARRAY)
- ----------------------------------------------------------------------
- 
-      DECLARE
- 
-           TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
- 
-           SUBTYPE ARR_CONST IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
-                ONE_TO_FIVE'LAST);
- 
-           PASSED_PARM : ARR_CONST := (OTHERS => TRUE);
- 
-           PROCEDURE ACT_PROC (PARM : ARR_CONST) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM : ARR_TYPE);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (PASSED_PARM);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           SUBPRG_ACT := FALSE;
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED
-                     ("ONE ARRAY PARAMETER CONSTRAINED MADE MATCH " &
-                      "INVALID");
-           END IF;
-      END;
- 
- ----------------------------------------------------------------------
- -- ONE PARAMETER CONSTRAINED (RECORDS)
- ----------------------------------------------------------------------
- 
-      DECLARE
- 
-           TYPE REC_TYPE (BOL : BOOLEAN) IS
-                RECORD
-                     SUB_A : INTEGER;
-                     CASE BOL IS
-                          WHEN TRUE =>
-                               DSCR_A : INTEGER;
- 
-                          WHEN FALSE =>
-                               DSCR_B : BOOLEAN;
- 
-                     END CASE;
-                END RECORD;
- 
-           SUBTYPE REC_CONST IS REC_TYPE (TRUE);
- 
-           PASSED_PARM : REC_CONST := (TRUE, 1, 2);
- 
-           PROCEDURE ACT_PROC (PARM : REC_CONST) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM : REC_TYPE);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (PASSED_PARM);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           SUBPRG_ACT := FALSE;
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED
-                     ("ONE RECORD PARAMETER CONSTRAINED MADE MATCH " &
-                      "INVALID");
-           END IF;
-      END;
- 
- ----------------------------------------------------------------------
- -- ONE PARAMETER CONSTRAINED (ACCESS)
- ----------------------------------------------------------------------
- 
-      DECLARE
- 
-           TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
- 
-           SUBTYPE ARR_CONST     IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
-                ONE_TO_FIVE'LAST);
- 
-           TYPE ARR_ACC_TYPE IS ACCESS ARR_TYPE;
- 
-           SUBTYPE ARR_ACC_CONST IS ARR_ACC_TYPE (1 .. 3);
- 
-           PASSED_PARM : ARR_ACC_TYPE := NULL;
- 
-           PROCEDURE ACT_PROC (PARM : ARR_ACC_CONST) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM : ARR_ACC_TYPE);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (PASSED_PARM);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           SUBPRG_ACT := FALSE;
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED
-                     ("ONE ACCESS PARAMETER CONSTRAINED MADE MATCH " &
-                      "INVALID");
-           END IF;
-      END;
- 
- ----------------------------------------------------------------------
- -- ONE PARAMETER CONSTRAINED (PRIVATE)
- ----------------------------------------------------------------------
- 
-      DECLARE
-           PASSED_PARM : PRI_CONST;
- 
-           PROCEDURE ACT_PROC (PARM : PRI_CONST) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM : PRI_TYPE);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (PASSED_PARM);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           SUBPRG_ACT := FALSE;
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED
-                     ("ONE PRIVATE PARAMETER CONSTRAINED MADE MATCH " &
-                      "INVALID");
-           END IF;
-      END;
- 
- ----------------------------------------------------------------------
- -- PRESENCE (OR ABSENCE) OF AN EXPLICIT "IN" MODE
- ----------------------------------------------------------------------
- 
-      DECLARE
- 
-           PROCEDURE ACT_PROC (PARM : INTEGER) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM : IN INTEGER);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (1);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           SUBPRG_ACT := FALSE;
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED
-                      ("PRESENCE OF AN EXPLICIT 'IN' MODE MADE MATCH " &
-                      "INVALID");
-           END IF;
-      END;
- 
- ----------------------------------------------------------------------
- -- DIFFERENT TYPE MARKS
- ----------------------------------------------------------------------
- 
-      DECLARE
- 
-           SUBTYPE MARK_1_TYPE IS INTEGER;
- 
-           SUBTYPE MARK_2_TYPE IS INTEGER;
- 
-           PROCEDURE ACT_PROC (PARM1 : IN MARK_1_TYPE) IS
-           BEGIN
-                SUBPRG_ACT := TRUE;
-           END ACT_PROC;
- 
-           GENERIC
- 
-                WITH PROCEDURE PASSED_PROC (PARM2 : MARK_2_TYPE);
- 
-           PROCEDURE GEN_PROC;
- 
-           PROCEDURE GEN_PROC IS
-           BEGIN
-                PASSED_PROC (1);
-           END GEN_PROC;
- 
-           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
-      BEGIN
-           SUBPRG_ACT := FALSE;
-           INST_PROC;
-           IF NOT SUBPRG_ACT THEN
-                FAILED ("DIFFERENT TYPE MARKS MADE MATCH INVALID");
-           END IF;
-      END;
-      RESULT;
- END CC3605A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3606a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3606a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3606a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3606a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- CC3606A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE DEFAULT EXPRESSIONS OF A FORMAL SUBPROGRAM'S
- --     FORMAL PARAMETERS ARE USED WHEN THE FORMAL SUBPROGRAM IS
- --     CALLED IN THE INSTANTIATED UNIT (RATHER THAN ANY DEFAULT
- --     ASSOCIATED WITH ACTUAL SUBPROGRAM'S PARAMETERS).
- 
- -- HISTORY:
- --     BCB 09/29/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3606A IS
- 
-      X : BOOLEAN;
-      Y : BOOLEAN;
- 
-      FUNCTION FUNC (A : INTEGER := 35) RETURN BOOLEAN IS
-      BEGIN
-           RETURN (A = 7);
-      END FUNC;
- 
-      PROCEDURE PROC (B : INTEGER := 35) IS
-      BEGIN
-           IF B /= 7 THEN
-                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
-                        "PROCEDURE NOT USED - 1");
-           END IF;
-      END PROC;
- 
-      FUNCTION FUNC1 (C : INTEGER := 35) RETURN BOOLEAN IS
-      BEGIN
-           RETURN (C = 7);
-      END FUNC1;
- 
-      PROCEDURE PROC3 (D : INTEGER := 35) IS
-      BEGIN
-           IF D /= 7 THEN
-                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
-                        "PROCEDURE NOT USED - 2");
-           END IF;
-      END PROC3;
- 
-      GENERIC
-           WITH FUNCTION FUNC (A : INTEGER := 7) RETURN BOOLEAN;
-      FUNCTION GENFUNC RETURN BOOLEAN;
- 
-      FUNCTION GENFUNC RETURN BOOLEAN IS
-      BEGIN
-           IF NOT FUNC THEN
-                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
-                        "FUNCTION NOT USED - 1");
-           END IF;
-           RETURN TRUE;
-      END GENFUNC;
- 
-      GENERIC
-           WITH PROCEDURE PROC (B : INTEGER := 7);
-      PACKAGE PKG IS
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           PROC;
-      END PKG;
- 
-      GENERIC
-           WITH FUNCTION FUNC1 (C : INTEGER := 7) RETURN BOOLEAN;
-      PROCEDURE PROC2;
- 
-      PROCEDURE PROC2 IS
-      BEGIN
-           IF NOT FUNC1 THEN
-                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
-                        "FUNCTION NOT USED - 2");
-           END IF;
-      END PROC2;
- 
-      GENERIC
-           WITH PROCEDURE PROC3 (D : INTEGER := 7) IS <>;
-      FUNCTION GENFUNC1 RETURN BOOLEAN;
- 
-      FUNCTION GENFUNC1 RETURN BOOLEAN IS
-      BEGIN
-           PROC3;
-           RETURN TRUE;
-      END GENFUNC1;
- 
-      FUNCTION NEWFUNC IS NEW GENFUNC(FUNC);
- 
-      PACKAGE PACK IS NEW PKG(PROC);
- 
-      PROCEDURE PROC4 IS NEW PROC2(FUNC1);
- 
-      FUNCTION NEWFUNC1 IS NEW GENFUNC1;
- 
- BEGIN
- 
-      TEST ("CC3606A", "CHECK THAT THE DEFAULT EXPRESSIONS OF A " &
-                       "FORMAL SUBPROGRAM'S FORMAL PARAMETERS ARE " &
-                       "USED WHEN THE FORMAL SUBPROGRAM IS CALLED IN " &
-                       "THE INSTANTIATED UNIT (RATHER THAN ANY " &
-                       "DEFAULT ASSOCIATED WITH ACTUAL SUBPROGRAM'S " &
-                       "PARAMETERS)");
- 
-      X := NEWFUNC;
-      Y := NEWFUNC1;
-      PROC4;
- 
-      RESULT;
- END CC3606A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3606b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3606b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3606b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3606b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- CC3606B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT ANY CONSTRAINTS SPECIFIED FOR THE ACTUAL
- --     SUBPROGRAM'S PARAMETERS ARE USED IN PLACE OF THOSE
- --     ASSOCIATED WITH THE FORMAL SUBPROGRAM'S PARAMETERS
- --     (INCLUDING PARAMETERS SPECIFIED WITH A FORMAL GENERIC TYPE).
- 
- -- HISTORY:
- --     LDC  06/30/88 CREATED ORIGINAL TEST.
- --     PWN  05/31/96 Corrected spelling problems.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CC3606B IS
- 
-      SUBTYPE ONE_TO_TEN IS
-           INTEGER RANGE IDENT_INT (1) .. IDENT_INT (10);
-      SUBTYPE ONE_TO_FIVE IS
-           INTEGER RANGE IDENT_INT (1) .. IDENT_INT (5);
- 
- BEGIN
-      TEST ( "CC3606B", "CHECK THAT ANY CONSTRAINTS SPECIFIED FOR " &
-                        "THE ACTUAL SUBPROGRAM'S PARAMETERS ARE USED " &
-                        "IN PLACE OF THOSE ASSOCIATED WITH THE " &
-                        "FORMAL SUBPROGRAM'S PARAMETERS (INCLUDING " &
-                        "PARAMETERS SPECIFIED WITH A FORMAL GENERIC " &
-                        "TYPE)");
-      DECLARE
-           GENERIC
-                BRIAN : IN OUT INTEGER;
-                WITH PROCEDURE PASSED_PROC(LYNN :IN OUT ONE_TO_TEN);
-           PACKAGE GEN IS
-           END GEN;
- 
-           DOUG : INTEGER := 10;
- 
-           PACKAGE BODY GEN IS
-           BEGIN
-                PASSED_PROC(BRIAN);
-                FAILED("WRONG CONSTRAINTS FOR ACTUAL PARAMETER IN GEN");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("OTHER EXCEPTION WAS RAISED FOR ACTUAL " &
-                            "PARAMETER");
-           END GEN;
- 
-           PROCEDURE PROC(JODIE : IN OUT ONE_TO_FIVE) IS
-                JOHN : ONE_TO_TEN;
-           BEGIN
-                JOHN := IDENT_INT(JODIE);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
-           END PROC;
- 
-           PACKAGE GEN_PCK IS NEW GEN( DOUG, PROC);
- 
-      BEGIN
-           NULL;
-      END;
-      DECLARE
-           TYPE ENUM IS (DAYTON, BEAVERCREEK, CENTERVILLE, ENGLEWOOD,
-                         FAIRBORN, HUBER_HEIGHTS, KETTERING, MIAMISBURG,
-                         OAKWOOD, RIVERSIDE, TROTWOOD, WEST_CARROLLTON,
-                         VANDALIA);
-           SUBTYPE SUB_ENUM IS ENUM RANGE  CENTERVILLE..FAIRBORN;
- 
-           GENERIC
-                TYPE T_TYPE IS (<>);
-                BRIAN : T_TYPE;
-                WITH FUNCTION PASSED_FUNC(LYNN : T_TYPE)
-                     RETURN T_TYPE;
- 
-           PACKAGE GEN_TWO IS
-           END GEN_TWO;
- 
-           DOUG : ENUM := ENUM'FIRST;
- 
-           PACKAGE BODY GEN_TWO IS
- 
-           DAVE : T_TYPE;
- 
-           BEGIN
-                DAVE := PASSED_FUNC(BRIAN);
-                FAILED("WRONG CONSTRAINTS FOR ACTUAL PARAMETER IN " &
-                       "GEN_TWO");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("OTHER EXCEPTION WAS " &
-                            "RAISED FOR ACTUAL " &
-                            "PARAMETER");
-           END GEN_TWO;
- 
-           FUNCTION FUNC(JODIE : SUB_ENUM) RETURN SUB_ENUM IS
-           BEGIN
-                RETURN ENUM'VAL(IDENT_INT(ENUM'POS(JODIE)));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
-           END FUNC;
- 
-           PACKAGE GEN_PCK_TWO IS NEW GEN_TWO( ENUM, DOUG, FUNC);
- 
-      BEGIN
-           RESULT;
-      END;
- END CC3606B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3607b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3607b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc3607b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc3607b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- CC3607B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A DEFAULT SUBPROGRAM IS SPECIFIED WITH A BOX, A
- --     SUBPROGRAM DIRECTLY VISIBLE AT THE POINT OF INSTANTIATION
- --     IS USED.
- 
- -- HISTORY:
- --     LDC 08/23/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CC3607B IS
- 
- BEGIN
-      TEST ("CC3607B", "CHECK THAT WHEN A DEFAULT SUBPROGRAM IS " &
-                       "SPECIFIED WITH A BOX, A SUBPROGRAM DIRECTLY " &
-                       "VISIBLE AT THE POINT OF INSTANTIATION IS USED");
-      DECLARE
-           PACKAGE PROC_PACK IS
-                PROCEDURE PROC;
- 
-                GENERIC
-                     WITH PROCEDURE PROC IS <>;
-                PACKAGE GEN_PACK IS
-                     PROCEDURE DO_PROC;
-                END GEN_PACK;
-           END PROC_PACK;
-           USE PROC_PACK;
- 
-           PACKAGE BODY PROC_PACK IS
-                PROCEDURE PROC IS
-                BEGIN
-                     FAILED("WRONG SUBPROGRAM WAS USED");
-                END PROC;
- 
-                PACKAGE BODY GEN_PACK IS
-                     PROCEDURE DO_PROC IS
-                     BEGIN
-                          PROC;
-                     END DO_PROC;
-                END GEN_PACK;
-           END PROC_PACK;
- 
-           PROCEDURE PROC IS
-           BEGIN
-                COMMENT ("SUBPROGRAM VISIBLE AT INSTANTIATION WAS " &
-                         "USED");
-           END PROC;
- 
-           PACKAGE NEW_PACK IS NEW GEN_PACK;
- 
-      BEGIN
-           NEW_PACK.DO_PROC;
-      END;
- 
-      RESULT;
- END CC3607B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc40001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc40001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc40001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc40001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,403 ****
- -- CC40001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that adjust is called on the value of a constant object created
- --      by the evaluation of a generic association for a formal object of
- --      mode in.
- --
- --      Check that those values are also subsequently finalized.
- --
- -- TEST DESCRIPTION:
- --      Create a backdrop of a controlled type sufficient to check that the
- --      correct operations get called at appropriate times.  Create a generic
- --      unit that takes a formal parameter of a formal type.  Create instances
- --      of this generic using various "levels" of the controlled type.  Check
- --      the same case for a generic child unit.
- --
- --      The cases tested are where the type of the formal object is:
- --        a visible classwide type  : CC40001_2
- --        a formal private type     : CC40001_3
- --        a formal tagged type      : CC40001_4
- --
- --      To more fully take advantage of the features of the language, and
- --      present a test which is "user oriented" this test utilizes multiple
- --      aspects of the language in combination.  Using Ada.Strings.Unbounded
- --      in combination with Ada.Finalization and Ada.Calendar to build layers
- --      of an object oriented system will likely be very common in actual
- --      practice.  A common paradigm in the language will also be the use of
- --      a parent package defining "basic" tagged types, and child packages
- --      will expand on those types via derivation.  The model used in this
- --      test is a simple type containing a character identity (used in the
- --      identity).  The next level of type add a timestamp.  Further levels
- --      might add location information, etc. however for the purposes of this
- --      test we stop at the second layer, as it is sufficient to test the
- --      stated objective.
- --
- --
- -- CHANGE HISTORY:
- --      06 FEB 96   SAIC   Initial version
- --      30 APR 96   SAIC   Added finalization checks for 2.1
- --      13 FEB 97   PWB.CTA  Moved global objects into bodies, after Initialize
- --                         body is elaborated; counted finalizations correctly.
- --!
- 
- ----------------------------------------------------------------- CC40001_0
- 
- with Ada.Finalization;
- with Ada.Strings.Unbounded;
- package CC40001_0 is
- 
-   type States is ( Erroneous, Defaulted, Initialized, Reset, Adjusted );
- 
-   type Simple_Object(ID: Character) is
-     new Ada.Finalization.Controlled with
-       record
-         TC_Current_State : States := Defaulted;
-         Name : Ada.Strings.Unbounded.Unbounded_String;
-       end record;
- 
-   procedure User_Operation( COB: in out Simple_Object; Name : String );
-   procedure Initialize( COB: in out Simple_Object );
-   procedure Adjust    ( COB: in out Simple_Object );
-   procedure Finalize  ( COB: in out Simple_Object );
- 
-   Finalization_Count : Natural;
- 
- end CC40001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body CC40001_0 is
- 
-   procedure User_Operation( COB: in out Simple_Object; Name : String ) is
-   begin
-     COB.Name := Ada.Strings.Unbounded.To_Unbounded_String(Name);
-   end User_Operation;
- 
-   procedure Initialize( COB: in out Simple_Object ) is
-   begin
-     COB.TC_Current_State := Initialized;
-   end Initialize;
- 
-   procedure Adjust    ( COB: in out Simple_Object ) is
-   begin
-     COB.TC_Current_State := Adjusted;
-     TCTouch.Touch('A');  -------------------------------------------------- A
-     TCTouch.Touch(COB.ID); ------------------------------------------------ ID
-     -- note that the calls to touch will not be directly validated, it is
-     -- expected that some number > 0 of calls will be made to this procedure,
-     -- the subtests then clear (Flush) the Touch buffer and perform actions
-     -- where an incorrect implementation might call this procedure.  Such a
-     -- call will fail on the attempt to "Validate" the null string.
-   end Adjust;
- 
-   procedure Finalize  ( COB: in out Simple_Object ) is
-   begin
-     COB.TC_Current_State := Erroneous;
-     Finalization_Count := Finalization_Count +1;
-   end Finalize;
- 
-   TC_Global_Object : Simple_Object('G');
- 
- end CC40001_0;
- 
- ----------------------------------------------------------------- CC40001_1
- 
- with Ada.Calendar;
- package CC40001_0.CC40001_1 is
- 
-   type Object_In_Time(ID: Character) is
-     new Simple_Object(ID) with
-       record
-         Birth : Ada.Calendar.Time;
-         Activity : Ada.Calendar.Time;
-       end record;
- 
-   procedure User_Operation( COB: in out Object_In_Time;
-                            Name: String );
- 
-   procedure Initialize( COB: in out Object_In_Time );
-   procedure Adjust    ( COB: in out Object_In_Time );
-   procedure Finalize  ( COB: in out Object_In_Time );
- 
- end CC40001_0.CC40001_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body CC40001_0.CC40001_1 is
- 
-   procedure Initialize( COB: in out Object_In_Time ) is
-   begin
-     COB.TC_Current_State := Initialized;
-     COB.Birth := Ada.Calendar.Clock;
-   end Initialize;
- 
-   procedure Adjust    ( COB: in out Object_In_Time ) is
-   begin
-     COB.TC_Current_State := Adjusted;
-     TCTouch.Touch('a');    ------------------------------------------------ a
-     TCTouch.Touch(COB.ID); ------------------------------------------------ ID
-   end Adjust;
- 
-   procedure Finalize  ( COB: in out Object_In_Time ) is
-   begin
-     COB.TC_Current_State := Erroneous;
-     Finalization_Count := Finalization_Count +1;
-   end Finalize;
- 
-   procedure User_Operation( COB: in out Object_In_Time;
-                            Name: String ) is
-   begin
-     CC40001_0.User_Operation( Simple_Object(COB), Name );
-     COB.Activity := Ada.Calendar.Clock;
-     COB.TC_Current_State := Reset;
-   end User_Operation;
- 
-   TC_Time_Object  : Object_In_Time('g');
- 
- end CC40001_0.CC40001_1;
- 
- ----------------------------------------------------------------- CC40001_2
- 
- generic
-   TC_Check_Object : in CC40001_0.Simple_Object'Class;
- package CC40001_0.CC40001_2 is
-   procedure TC_Verify_State;
- end CC40001_0.CC40001_2;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body CC40001_0.CC40001_2 is
- 
-   procedure TC_Verify_State is
-   begin
-     if TC_Check_Object.TC_Current_State /= Adjusted then
-       Report.Failed( "CC40001_2 : Formal Object not adjusted" );
-     end if;
-   end TC_Verify_State;
- 
- end CC40001_0.CC40001_2;
- 
- ----------------------------------------------------------------- CC40001_3
- 
- generic
-   type Formal_Private(<>) is private;
-   TC_Check_Object : in Formal_Private;
-   with function Bad_Status( O: Formal_Private ) return Boolean;
- package CC40001_0.CC40001_3 is
-   procedure TC_Verify_State;
- end CC40001_0.CC40001_3;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body CC40001_0.CC40001_3 is
- 
-   procedure TC_Verify_State is
-   begin
-     if Bad_Status( TC_Check_Object ) then
-       Report.Failed( "CC40001_3 : Formal Object not adjusted" );
-     end if;
-   end TC_Verify_State;
- 
- end CC40001_0.CC40001_3;
- 
- ----------------------------------------------------------------- CC40001_4
- 
- generic
-   type Formal_Tagged_Private(<>) is tagged private; 
-   TC_Check_Object : in Formal_Tagged_Private;
-   with function Bad_Status( O: Formal_Tagged_Private ) return Boolean;
- package CC40001_0.CC40001_4 is
-   procedure TC_Verify_State;
- end CC40001_0.CC40001_4;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body CC40001_0.CC40001_4 is
- 
-   procedure TC_Verify_State is
-   begin
-     if Bad_Status( TC_Check_Object ) then
-       Report.Failed( "CC40001_4 : Formal Object not adjusted" );
-     end if;
-   end TC_Verify_State;
- 
- end CC40001_0.CC40001_4;
- 
- ------------------------------------------------------------------- CC40001
- 
- with Report;
- with TCTouch;
- with CC40001_0.CC40001_1;
- with CC40001_0.CC40001_2;
- with CC40001_0.CC40001_3;
- with CC40001_0.CC40001_4;
- procedure CC40001 is
- 
-   function Not_Adjusted( CO : CC40001_0.Simple_Object )
-     return Boolean is
-      use type CC40001_0.States;
-   begin
-     return CO.TC_Current_State /= CC40001_0.Adjusted;
-   end Not_Adjusted;
- 
-   function Not_Adjusted( CO : CC40001_0.CC40001_1.Object_In_Time )
-     return Boolean is
-      use type CC40001_0.States;
-   begin
-     return CO.TC_Current_State /= CC40001_0.Adjusted;
-   end Not_Adjusted;
- 
-    -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 1
- 
-   procedure Subtest_1 is
-     Object_0 : CC40001_0.Simple_Object('T');
-     Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
- 
-     package Subtest_1_1 is
-       new CC40001_0.CC40001_2( Object_0 ); -- classwide generic formal object
- 
-     package Subtest_1_2 is
-       new CC40001_0.CC40001_2( Object_1 ); -- classwide generic formal object
-   begin
-     TCTouch.Flush;  -- clear out all "A" and "T" entries, no further calls
-                     -- to Touch should occur before the call to Validate
- 
-     -- set the objects TC_Current_State to "Reset"
-     CC40001_0.User_Operation( Object_0, "Subtest 1" );
-     CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 1" );
- 
-     -- check that the objects TC_Current_State is "Adjusted"
-     Subtest_1_1.TC_Verify_State;
-     Subtest_1_2.TC_Verify_State;
- 
-     TCTouch.Validate( "", "No actions should occur here, subtest 1" );
- 
-   end Subtest_1;
- 
-    -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 2
- 
-   procedure Subtest_2 is
-     Object_0 : CC40001_0.Simple_Object('T');
-     Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
- 
-     package Subtest_2_1 is -- generic formal object is discriminated private
-       new CC40001_0.CC40001_3( CC40001_0.Simple_Object,
-                                Object_0,
-                                Not_Adjusted );
- 
-     package Subtest_2_2 is -- generic formal object is discriminated private
-       new CC40001_0.CC40001_3( CC40001_0.CC40001_1.Object_In_Time,
-                                Object_1,
-                                Not_Adjusted );
- 
-   begin
-     TCTouch.Flush;  -- clear out all "A" and "T" entries
- 
-     -- set the objects state to "Reset"
-     CC40001_0.User_Operation( Object_0, "Subtest 2" );
-     CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 2" );
- 
-     Subtest_2_1.TC_Verify_State;
-     Subtest_2_2.TC_Verify_State;
- 
-     TCTouch.Validate( "", "No actions should occur here, subtest 2" );
- 
-   end Subtest_2;
- 
-    -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 3
- 
-   procedure Subtest_3 is
-     Object_0 : CC40001_0.Simple_Object('T');
-     Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
- 
-     package Subtest_3_1 is -- generic formal object is discriminated tagged
-       new CC40001_0.CC40001_4( CC40001_0.Simple_Object,
-                                Object_0,
-                                Not_Adjusted );
- 
-     package Subtest_3_2 is -- generic formal object is discriminated tagged
-       new CC40001_0.CC40001_4( CC40001_0.CC40001_1.Object_In_Time,
-                                Object_1,
-                                Not_Adjusted );
-   begin
-     TCTouch.Flush;  -- clear out all "A" and "T" entries
- 
-     -- set the objects state to "Reset"
-     CC40001_0.User_Operation( Object_0, "Subtest 3" );
-     CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 3" );
- 
-     Subtest_3_1.TC_Verify_State;
-     Subtest_3_2.TC_Verify_State;
- 
-     TCTouch.Validate( "", "No actions should occur here, subtest 3" );
- 
-   end Subtest_3;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CC40001", "Check that adjust and finalize are called on " &
-                           "the constant object created by the " &
-                           "evaluation of a generic association for a " &
-                           "formal object of mode in" );
- 
-   -- check that the created constant objects are properly adjusted
-   -- and subsequently finalized
- 
-   CC40001_0.Finalization_Count := 0;
- 
-   Subtest_1;
- 
-   if CC40001_0.Finalization_Count < 4 then
-     Report.Failed("Insufficient Finalizations for Subtest 1");
-   end if;
- 
-   CC40001_0.Finalization_Count := 0;
- 
-   Subtest_2;
- 
-   if CC40001_0.Finalization_Count < 4 then
-     Report.Failed("Insufficient Finalizations for Subtest 2");
-   end if;
- 
-   CC40001_0.Finalization_Count := 0;
- 
-   Subtest_3;
- 
-   if CC40001_0.Finalization_Count < 4 then
-     Report.Failed("Insufficient Finalizations for Subtest 3");
-   end if;
- 
-   Report.Result;
- 
- end CC40001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc50001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc50001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc50001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc50001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,257 ****
- -- CC50001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, in an instance, each implicit declaration of a predefined
- --      operator of a formal tagged private type declares a view of the
- --      corresponding predefined operator of the actual type (even if the
- --      operator has been overridden for the actual type). Check that the
- --      body executed is determined by the type and tag of the operands.
- --
- -- TEST DESCRIPTION:
- --      The formal tagged private type has an unknown discriminant part, and
- --      is thus indefinite. This allows both definite and indefinite types
- --      to be passed as actuals. For tagged types, definite implies
- --      nondiscriminated, and indefinite implies discriminated (with known
- --      or unknown discriminants).
- --
- --      Only nonlimited tagged types are tested, since equality operators
- --      are not predefined for limited types. 
- --
- --      A tagged type is passed as an actual to a generic formal tagged
- --      private type. The tagged type overrides the predefined equality
- --      operator. A subprogram within the generic calls the equality operator
- --      of the formal type. In an instance, the equality operator denotes
- --      a view of the predefined operator of the actual type, but the
- --      call dispatches to the body of the overriding operator.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected expected result on
- --                          calls to "=" within the instance. Modified
- --                          commentary.
- --
- --!
- 
- package CC50001_0 is
- 
-    type Count_Type is tagged record                     -- Nondiscriminated
-       Count : Integer := 0;                             -- tagged type.
-    end record;
- 
-    function "="(Left, Right : Count_Type)               -- User-defined
-      return Boolean;                                    -- equality operator.
- 
- 
-    subtype Str_Len is Natural range 0 .. 100;
-    subtype Stu_ID  is String (1 .. 5);
-    subtype Dept_ID is String (1 .. 4);
-    subtype Emp_ID  is String (1 .. 9);
-    type    Status   is (Student, Faculty, Staff);
- 
-    type Person_Type (Stat : Status;                     -- Discriminated
-                      NameLen, AddrLen : Str_Len) is     -- tagged type.
-      tagged record                                 
-       Name    : String (1 .. NameLen);
-       Address : String (1 .. AddrLen);
-       case Stat is
-          when Student =>
-             Student_ID  : Stu_ID;
-          when Faculty =>
-             Department  : Dept_ID;
-          when Staff   =>
-             Employee_ID : Emp_ID;
-       end case;
-    end record;
- 
-    function "="(Left, Right : Person_Type)              -- User-defined
-      return Boolean;                                    -- equality operator.
- 
- 
-    -- Testing entities: ------------------------------------------------
- 
-    TC_Count_Item     : constant Count_Type  := (Count => 111);
- 
-    TC_Person_Item    : constant Person_Type :=
-      (Faculty, 18, 17, "Eccles, John Scott", "Popham House, Lee", "0931");
- 
-    ---------------------------------------------------------------------
- 
- 
- end CC50001_0;
- 
- 
-      --===================================================================--
- 
- 
- package body CC50001_0 is
- 
-    function "="(Left, Right : Count_Type) return Boolean is
-    begin
-       return False;   -- Return FALSE even if Left = Right.
-    end "=";
- 
- 
-    function "="(Left, Right : Person_Type) return Boolean is
-    begin
-       return False;   -- Return FALSE even if Left = Right.
-    end "=";
- 
- end CC50001_0;
- 
- 
-      --===================================================================--
- 
- 
- with CC50001_0;  -- Tagged (actual) type declarations.
- generic        -- Generic stack abstraction.
- 
-    type Item (<>) is tagged private;            -- Formal tagged private type.
- 
- package CC50001_1 is
- 
-    -- Simulate a generic stack abstraction. In a real application, the
-    -- second operand of Push might be of type Stack, and type Stack
-    -- would have at least one component (pointing to the top stack item).
- 
-    type Stack is private;
- 
-    procedure Push (I : in Item; TC_Check : out Boolean);
- 
-    -- ... Other stack operations.
- 
- private
- 
-    -- ... Stack and ancillary type declarations.
- 
-    type Stack is record                       -- Artificial.
-       null;
-    end record;
- 
- end CC50001_1;
- 
- 
-      --===================================================================--
- 
- 
- package body CC50001_1 is
- 
-    -- For the sake of brevity, the implementation of Push is completely
-    -- artificial; the goal is to model a call of the equality operator within
-    -- the generic.
-    --
-    -- A real application might implement Push such that it does not add new
-    -- items to the stack if they are identical to the top item; in that
-    -- case, the equality operator would be called as part of an "if"
-    -- condition.
- 
-    procedure Push (I : in Item; TC_Check : out Boolean) is
-    begin
-       TC_Check := not (I = I);              -- Call user-defined "="; should
-                                             -- return FALSE. Negation of
-                                             -- result makes TC_Check TRUE.
-    end Push;
- 
- end CC50001_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC50001_0;  -- Tagged (actual) type declarations.
- with CC50001_1;  -- Generic stack abstraction.
- 
- use  CC50001_0;  -- Overloaded "=" directly visible.
- 
- with Report;
- procedure CC50001 is
- 
-    package Count_Stacks  is new CC50001_1 (CC50001_0.Count_Type);
-    package Person_Stacks is new CC50001_1 (CC50001_0.Person_Type);
- 
-    User_Defined_Op_Called : Boolean;
- 
- begin
-    Report.Test ("CC50001", "Check that, in an instance, each implicit "     &
-                 "declaration of a primitive subprogram of a formal tagged " &
-                 "private type declares a view of the corresponding "        &
-                 "predefined operator of the actual type (even if the "      &
-                 "operator has been overridden or hidden for the actual type)");
- 
- --
- -- Test which "=" is called inside generic:
- --
- 
-    User_Defined_Op_Called := False;
- 
-    Count_Stacks.Push (CC50001_0.TC_Count_Item,
-                       User_Defined_Op_Called);
- 
- 
-    if not User_Defined_Op_Called then
-       Report.Failed ("User-defined ""="" not called inside generic for Count");
-    end if;
- 
- 
-    User_Defined_Op_Called := False;
- 
-    Person_Stacks.Push (CC50001_0.TC_Person_Item,
-                        User_Defined_Op_Called);
- 
-    if not User_Defined_Op_Called then
-       Report.Failed ("User-defined ""="" not called inside generic " &
-                      "for Person");
-    end if;
- 
- 
- --
- -- Test which "=" is called outside generic:
- --
- 
-    User_Defined_Op_Called := False;
- 
-    User_Defined_Op_Called :=
-      not (CC50001_0.TC_Count_Item = CC50001_0.TC_Count_Item);
- 
-    if not User_Defined_Op_Called then
-       Report.Failed ("User-defined ""="" not called outside generic "&
-                      "for Count");
-    end if;
- 
- 
-    User_Defined_Op_Called := False;
- 
-    User_Defined_Op_Called :=
-      not (CC50001_0.TC_Person_Item = CC50001_0.TC_Person_Item);
- 
-    if not User_Defined_Op_Called then
-       Report.Failed ("User-defined ""="" not called outside generic "&
-                      "for Person");
-    end if;
- 
- 
-    Report.Result;
- end CC50001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc50a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc50a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc50a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc50a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,313 ****
- -- CC50A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a formal parameter of a library-level generic unit may be
- --      a formal tagged private type. Check that a nonlimited tagged type may
- --      be passed as an actual. Check that if the formal type is indefinite,
- --      both indefinite and definite types may be passed as actuals.
- --
- -- TEST DESCRIPTION:
- --      The generic package declares a formal tagged private type (this can
- --      be considered the parent "mixin" class). This type is extended in
- --      the generic to provide support for stacks of items of any nonlimited
- --      tagged type. Stacks are modeled as singly linked lists, with the list
- --      nodes being objects of the extended type.
- --
- --      A generic testing procedure pushes items onto a stack, and pops them
- --      back off, verifying the state of the stack at various points along the
- --      way. The push and pop routines exercise functionality important to
- --      tagged types, such as type conversion toward the root of the derivation
- --      class and extension aggregates.
- --
- --      The formal tagged private type has an unknown discriminant part, and
- --      is thus indefinite. This allows both definite and indefinite types
- --      to be passed as actuals. For tagged types, definite implies
- --      nondiscriminated, and indefinite implies discriminated (with known
- --      or unknown discriminants). 
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         FC50A00.A
- --      -> CC50A01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Nov 95   SAIC    ACVC 2.0.1 fixes: Moved instantiations of
- --                          BC50A01_0 to library level.
- --      11 Aug 96   SAIC    ACVC 2.1: Updated prologue. Added pragma
- --                          Elaborate to context clauses for CC50A01_2 & _3.
- --
- --!
- 
- with FC50A00;  -- Tagged (actual) type declarations.
- generic        -- Generic stack abstraction.
- 
-    type Item (<>) is tagged private;            -- Formal tagged private type.
-    TC_Default_Value : Item;                     -- Needed in View_Top (see
-                                                 -- below).
- package CC50A01_0 is
- 
-    type Stack is private;
- 
- -- Note that because the actual type corresponding to Item may be
- -- unconstrained, the functions of removing the top item from the stack and
- -- returning the value of the top item of the stack have been separated into
- -- Pop and View_Top, respectively. This is necessary because otherwise the
- -- returned value would have to be an out parameter of Pop, which would
- -- require the user (in the unconstrained case) to create an uninitialized
- -- unconstrained object to serve as the actual, which is illegal.
- 
-    procedure Push     (I : in Item; S : in out Stack);
-    procedure Pop      (S : in out Stack);
-    function  View_Top (S : Stack) return Item;
- 
-    function Size_Of (S : Stack) return Natural;
- 
- private
- 
-    type Stack_Item;
-    type Stack_Ptr is access Stack_Item;
- 
-    type Stack_Item is new Item with record      -- Extends formal type.
-       Next : Stack_Ptr := null;
-    end record;
- 
-    type Stack is record
-       Top  : Stack_Ptr := null;
-       Size : Natural   := 0;
-    end record;
- 
- end CC50A01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC50A01_0 is
- 
-    -- Link NewItem in at the top of the stack (the extension aggregate within
-    -- the allocator initializes the inherited portion of NewItem to equal I,
-    -- and NewItem.Next to point to what S.Top points to).
- 
-    procedure Push (I : in Item; S : in out Stack) is
-       NewItem : Stack_Ptr;
-    begin
-       NewItem := new Stack_Item'(I with S.Top);     -- Extension aggregate.
-       S.Top   := NewItem;
-       S.Size  := S.Size + 1;
-    end Push;
- 
- 
-    -- Remove item from top of stack. This procedure only updates the state of
-    -- the stack; it does not return the value of the popped item. Hence, in
-    -- order to accomplish a "true" pop, both View_Top and Pop must be called
-    -- consecutively.
-    --
-    -- If the stack is empty, the Pop is ignored (for simplicity; in a true
-    -- application this might be treated as an error condition).
- 
-    procedure Pop (S : in out Stack) is
-    begin
-       if S.Top = null then                          -- Stack is empty.
-          null;
-          -- Raise exception.
-       else
-          S.Top  := S.Top.Next;
-          S.Size := S.Size - 1;
-          -- Deallocate discarded node.
-       end if;
-    end Pop;
- 
- 
-    -- Return the value of the top item on the stack. This procedure only
-    -- returns the value; it does not remove the top item from the stack.
-    -- Hence, in order to accomplish a "true" pop, both View_Top and Pop must
-    -- be called consecutively.
-    --
-    -- Since items on the stack are of a type (Stack_Item) derived from Item,
-    -- which is a (tagged) private type, type conversion toward the root is the
-    -- only way to get a value of type Item for return to the caller.
-    --
-    -- If the stack is empty, View_Top returns a pre-specified default value.
-    -- (In a true application, an exception might be raised instead).
- 
-    function View_Top (S : Stack) return Item is
-    begin
-       if S.Top = null then                          -- Stack is empty.
-          return TC_Default_Value;                   -- Testing artifice.
-          -- Raise exception.
-       else
-          return Item(S.Top.all);                    -- Type conversion.
-       end if;
-    end View_Top;
- 
- 
-    function Size_Of (S : Stack) return Natural is
-    begin
-       return (S.Size);
-    end Size_Of;
- 
- 
- end CC50A01_0;
- 
- 
-      --==================================================================--
- 
- 
- -- The formal package Stacker below is needed to gain access to the
- -- appropriate version of the "generic" type Stack. It is provided with an
- -- explicit actual part in order to restrict the packages that can be passed
- -- as actuals to those which have been instantiated with the same actuals
- -- which this generic procedure has been instantiated with.
- 
- with CC50A01_0;  -- Generic stack abstraction.
- generic
-    type Item_Type (<>) is tagged private;       -- Formal tagged private type.
-    Default : Item_Type;
-    with package Stacker is new CC50A01_0 (Item_Type, Default);
- procedure CC50A01_1 (S : in out Stacker.Stack; I : in Item_Type);
- 
- 
-      --==================================================================--
- 
- --
- -- This generic procedure performs all of the testing of the
- -- stack abstraction.
- --
- 
- with Report;
- procedure CC50A01_1 (S : in out Stacker.Stack; I : in Item_Type) is
- begin
-    Stacker.Push (I, S);                    -- Push onto empty stack.
-    Stacker.Push (I, S);                    -- Push onto nonempty stack.
- 
-    if Stacker.Size_Of (S) /= 2 then
-       Report.Failed ("   Wrong stack size after 2 Pushes");
-    end if;
- 
-    -- Calls to View_Top must initialize a declared object of type Item_Type
-    -- because the type may be unconstrained.
- 
-    declare
-       Buffer1 : Item_Type := Stacker.View_Top (S);
-    begin
-       Stacker.Pop (S);                     -- Pop item off nonempty stack.
-       if Buffer1 /= I then
-          Report.Failed ("   Wrong stack item value after 1st Pop");
-       end if;
-    end;
- 
-    declare
-       Buffer2 : Item_Type := Stacker.View_Top (S);
-    begin
-       Stacker.Pop (S);                     -- Pop last item off stack.
-       if Buffer2 /= I then
-          Report.Failed ("   Wrong stack item value after 2nd Pop");
-       end if;
-    end;
- 
-    if Stacker.Size_Of (S) /= 0 then
-       Report.Failed ("   Wrong stack size after 2 Pops");
-    end if;
- 
-    declare
-       Buffer3 : Item_Type := Stacker.View_Top (S);
-    begin
-       if Buffer3 /= Default then
-          Report.Failed ("   Wrong result after Pop of empty stack");
-       end if;
-       Stacker.Pop (S);                     -- Pop off empty stack.
-    end;
- 
- end CC50A01_1;
- 
- 
-      --==================================================================--
- 
- 
- with FC50A00;
- 
- with CC50A01_0;
- pragma Elaborate (CC50A01_0);
- 
- package CC50A01_2 is new CC50A01_0 (FC50A00.Count_Type,
-                                     FC50A00.TC_Default_Count);
- 
- 
-      --==================================================================--
- 
- 
- with FC50A00;
- 
- with CC50A01_0;
- pragma Elaborate (CC50A01_0);
- 
- package CC50A01_3 is new CC50A01_0 (FC50A00.Person_Type,
-                                     FC50A00.TC_Default_Person);
- 
- 
-      --==================================================================--
- 
- 
- with FC50A00;   -- Tagged (actual) type declarations.
- with CC50A01_0; -- Generic stack abstraction.
- with CC50A01_1; -- Generic stack testing procedure.
- with CC50A01_2;
- with CC50A01_3;
- 
- with Report;
- procedure CC50A01 is
- 
-    package Count_Stacks  renames CC50A01_2;
-    package Person_Stacks renames CC50A01_3;
- 
- 
-    procedure TC_Count_Test is new CC50A01_1 (FC50A00.Count_Type,
-                                              FC50A00.TC_Default_Count,
-                                              Count_Stacks);
-    Count_Stack : Count_Stacks.Stack;
- 
-  
-    procedure TC_Person_Test is new CC50A01_1 (FC50A00.Person_Type,
-                                               FC50A00.TC_Default_Person,
-                                               Person_Stacks);
-    Person_Stack : Person_Stacks.Stack;
- 
- begin
-    Report.Test ("CC50A01", "Check that a formal parameter of a " &
-                 "library-level generic unit may be a formal tagged " &
-                 "private type");
- 
-    Report.Comment ("Testing definite tagged type..");
-    TC_Count_Test  (Count_Stack,  FC50A00.TC_Count_Item);
- 
-    Report.Comment ("Testing indefinite tagged type..");
-    TC_Person_Test (Person_Stack, FC50A00.TC_Person_Item);
- 
-    Report.Result;
- end CC50A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc50a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc50a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc50a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc50a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,227 ****
- -- CC50A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a nonlimited tagged type may be passed as an actual to a
- --      formal (non-tagged) private type. Check that if the formal type has
- --      an unknown discriminant part, a class-wide type may also be passed as
- --      an actual.
- --
- -- TEST DESCRIPTION:
- --      A generic package declares a formal private type and defines a
- --      stack abstraction. Stacks are modeled as singly linked lists of
- --      pointers to elements. Pointers are used because the elements may
- --      be unconstrained.
- --
- --      A generic testing procedure pushes an item onto a stack, then views
- --      the item on top of the stack.
- --
- --      The formal private type has an unknown discriminant part, and
- --      is thus indefinite. This allows both definite and indefinite types
- --      (including class-wide types) to be passed as actuals. For tagged types,
- --      definite implies nondiscriminated, and indefinite implies discriminated
- --      (with known/unknown discriminants). 
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC50A00.A
- --      -> CC50A02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed use of formal package
- --                          exception name in exception choice.
- --
- --!
- 
- generic        -- Generic stack abstraction.
-    type Item (<>) is private;                   -- Formal private type.
- package CC50A02_0 is
- 
-    type Stack is private;
- 
-    procedure Push     (I : in Item; S : in out Stack);
-    function  View_Top (S : Stack) return Item;
- 
-    -- ...Other stack operations...
- 
-    Stack_Empty : exception;
- 
- private
- 
-    type Item_Ptr is access Item;
- 
-    type Stack_Item;
-    type Stack_Ptr is access Stack_Item;
- 
-    type Stack_Item is record
-       Item : Item_Ptr;
-       Next : Stack_Ptr;
-    end record;
- 
-    type Stack is record
-       Top  : Stack_Ptr := null;
-       Size : Natural   := 0;
-    end record;
- 
- end CC50A02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC50A02_0 is
- 
-    -- Link NewItem in at the top of the stack.
- 
-    procedure Push (I : in Item; S : in out Stack) is
-       NewItem : Item_Ptr  := new Item'(I);
-       Element : Stack_Ptr := new Stack_Item'(Item => NewItem, Next => S.Top);
-    begin
-       S.Top   := Element;
-       S.Size  := S.Size + 1;
-    end Push;
- 
- 
-    -- Return (copy) of top item on stack. Do NOT remove from stack.
- 
-    function View_Top (S : Stack) return Item is
-    begin
-       if S.Top = null then
-          raise Stack_Empty;
-       else
-          return S.Top.Item.all;
-       end if;
-    end View_Top;
- 
- end CC50A02_0;
- 
- 
-      --==================================================================--
- 
- 
- -- The formal package Stacker below is needed to gain access to the
- -- appropriate version of the "generic" type Stack. It is provided with an
- -- explicit actual part in order to restrict the packages that can be passed
- -- as actuals to those which have been instantiated with the same actuals
- -- which this generic procedure has been instantiated with.
- 
- with CC50A02_0;  -- Generic stack abstraction.
- generic
-    type Item_Type (<>) is private;       -- Formal private type.
-    with package Stacker is new CC50A02_0 (Item_Type);
- procedure CC50A02_1 (S : in out Stacker.Stack; I : in Item_Type);
- 
- 
-      --==================================================================--
- 
- --
- -- This generic procedure performs all of the testing of the
- -- stack abstraction.
- --
- 
- with Report;
- procedure CC50A02_1 (S : in out Stacker.Stack; I : in Item_Type) is
- begin
-    Stacker.Push (I, S);                    -- Push onto empty stack.
- 
-    -- Calls to View_Top must initialize a declared object of type Item_Type
-    -- because the type may be unconstrained.
- 
-    declare
-       Buffer : Item_Type := Stacker.View_Top (S);
-    begin
-       if Buffer /= I then
-          Report.Failed ("   Expected item not on stack");
-       end if;
-    exception
-       when Constraint_Error =>
-          Report.Failed ("   Unexpected error: Tags of pushed and popped " &
-                         "items don't match");
-    end;
- 
- 
- exception
-    when others =>
-       Report.Failed ("   Unexpected error: Item not pushed onto stack");
- end CC50A02_1;
- 
- 
-      --==================================================================--
- 
- 
- with FC50A00;   -- Tagged (actual) type declarations.
- with CC50A02_0; -- Generic stack abstraction.
- with CC50A02_1; -- Generic stack testing procedure.
- 
- with Report;
- procedure CC50A02 is
- 
-    --
-    -- Pass a nondiscriminated tagged actual:
-    --
- 
-    package   Count_Stacks  is new CC50A02_0 (FC50A00.Count_Type);
-    procedure TC_Count_Test is new CC50A02_1 (FC50A00.Count_Type,
-                                              Count_Stacks);
-    Count_Stack : Count_Stacks.Stack;
- 
- 
-    --
-    -- Pass a discriminated tagged actual:
-    --
-  
-    package   Person_Stacks  is new CC50A02_0 (FC50A00.Person_Type);
-    procedure TC_Person_Test is new CC50A02_1 (FC50A00.Person_Type,
-                                               Person_Stacks);
-    Person_Stack : Person_Stacks.Stack;
- 
- 
-    --
-    -- Pass a class-wide actual:
-    --
-  
-    package   People_Stacks  is new CC50A02_0 (FC50A00.Person_Type'Class);
-    procedure TC_People_Test is new CC50A02_1 (FC50A00.Person_Type'Class,
-                                               People_Stacks);
-    People_Stack : People_Stacks.Stack;
- 
- begin
-    Report.Test ("CC50A02", "Check that tagged actuals may be passed " &
-                 "to a formal (nontagged) private type");
- 
-    Report.Comment ("Testing definite tagged type..");
-    TC_Count_Test  (Count_Stack,  FC50A00.TC_Count_Item);
- 
-    Report.Comment ("Testing indefinite tagged type..");
-    TC_Person_Test (Person_Stack, FC50A00.TC_Person_Item);
- 
-    Report.Comment ("Testing class-wide type..");
-    TC_People_Test (People_Stack, FC50A00.TC_VIPerson_Item);
- 
-    Report.Result;
- end CC50A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,186 ****
- -- CC51001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a formal parameter of a generic package may be a formal
- --      derived type. Check that the formal derived type may have an unknown
- --      discriminant part. Check that the ancestor type in a formal derived
- --      type definition may be a tagged type, and that the actual parameter
- --      may be a descendant of the ancestor type. Check that the formal derived
- --      type belongs to the derivation class rooted at the ancestor type;
- --      specifically, that components of the ancestor type may be referenced
- --      within the generic. Check that if a formal derived subtype is
- --      indefinite then the actual may be either definite or indefinite.
- --
- -- TEST DESCRIPTION:
- --      Define a class of tagged types with a definite root type. Extend the
- --      root type with a discriminated component. Since discriminants of
- --      tagged types may not have defaults, the type is indefinite.
- --
- --      Extend the extension with a second discriminated component, but with
- --      a new discriminant part. Declare a generic package with a formal
- --      derived type using the root type of the class as ancestor, and an
- --      unknown discriminant part. Declare an operation in the generic which
- --      accesses the common component of types in the class.
- --
- --      In the main program, instantiate the generic with each type in the
- --      class and verify that the operation correctly accesses the common
- --      component.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CC51001_0 is  -- Root type for message class.
- 
-    subtype Msg_String is String (1 .. 20);
- 
-    type Msg_Type is tagged record                          -- Root type of
-       Text : Msg_String := (others => ' ');                -- class (definite).
-    end record;
- 
- end CC51001_0;
- 
- 
- -- No body for CC51001_0.
- 
- 
-      --==================================================================--
- 
- 
- with CC51001_0;       -- Root type for message class.
- package CC51001_1 is  -- Extensions to message class.
- 
-    subtype Source_Length is Natural range 0 .. 10;
- 
-    type From_Msg_Type (SLen : Source_Length) is            -- Direct derivative
-      new CC51001_0.Msg_Type with record                    -- of root type
-       From : String (1 .. SLen);                           -- (indefinite).
-    end record;
- 
-    subtype Dest_Length is Natural range 0 .. 10;
- 
- 
- 
-    type To_From_Msg_Type (DLen : Dest_Length) is           -- Indirect
-      new From_Msg_Type (SLen => 10) with record            -- derivative of
-       To : String (1 .. DLen);                             -- root type
-    end record;                                             -- (indefinite).
- 
- end CC51001_1;
- 
- 
- -- No body for CC51001_1.
- 
- 
-      --==================================================================--
- 
- 
- with CC51001_0;       -- Root type for message class.
- generic               -- I/O operations for message class.
-    type Message_Type (<>) is new CC51001_0.Msg_Type with private;
- package CC51001_2 is
- 
-    -- This subprogram contains an artificial result for testing purposes:
-    -- the function returns the text of the message to the caller as a string.
- 
-    function Print_Message (M : in Message_Type) return String;
- 
-    -- ... Other operations.
- 
- end CC51001_2;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51001_2 is
- 
-    -- The implementations of the operations below are purely artificial; the
-    -- validity of their implementations in the context of the abstraction is
-    -- irrelevant to the feature being tested.
- 
-    function Print_Message (M : in Message_Type) return String is
-    begin
-       return M.Text;
-    end Print_Message;
- 
- end CC51001_2;
- 
- 
-      --==================================================================--
- 
- 
- with CC51001_0;  -- Root type for message class.
- with CC51001_1;  -- Extensions to message class.
- with CC51001_2;  -- I/O operations for message class.
- 
- with Report;
- procedure CC51001 is
- 
-    -- Instantiate for various types in the class:
- 
-    package Msgs   is new CC51001_2 (CC51001_0.Msg_Type);         -- Definite.
-    package FMsgs  is new CC51001_2 (CC51001_1.From_Msg_Type);    -- Indefinite.
-    package TFMsgs is new CC51001_2 (CC51001_1.To_From_Msg_Type); -- Indefinite.
- 
- 
- 
-    Msg   : CC51001_0.Msg_Type         := (Text => "This is message #001");
-    FMsg  : CC51001_1.From_Msg_Type    := (Text => "This is message #002",
-                                           SLen => 2,
-                                           From => "Me");
-    TFMsg : CC51001_1.To_From_Msg_Type := (Text => "This is message #003",
-                                           From => "You       ",
-                                           DLen => 4,
-                                           To   => "Them");
- 
-    Expected_Msg   : constant String := "This is message #001";
-    Expected_FMsg  : constant String := "This is message #002";
-    Expected_TFMsg : constant String := "This is message #003";
- 
- begin
-    Report.Test ("CC51001", "Check that the formal derived type may have " &
-                 "an unknown discriminant part. Check that the ancestor " &
-                 "type in a formal derived type definition may be a " &
-                 "tagged type, and that the actual parameter may be any " &
-                 "definite or indefinite descendant of the ancestor type");
- 
-    if (Msgs.Print_Message (Msg) /= Expected_Msg) then
-       Report.Failed ("Wrong result for definite root type");
-    end if;
- 
-    if (FMsgs.Print_Message (FMsg) /= Expected_FMsg) then
-       Report.Failed ("Wrong result for direct indefinite derivative");
-    end if;
- 
-    if (TFMsgs.Print_Message (TFMsg) /= Expected_TFMsg) then
-       Report.Failed ("Wrong result for Indirect indefinite derivative");
-    end if;
- 
-    Report.Result;
- end CC51001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- CC51002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for formal derived tagged types, the formal parameter
- --      names and default expressions for a primitive subprogram in an
- --      instance are determined by the primitive subprogram of the ancestor
- --      type, but that the primitive subprogram body executed is that of the
- --      actual type.
- --
- -- TEST DESCRIPTION:
- --      Define a root tagged type in a library-level package and give it a
- --      primitive subprogram. Provide a default expression for a non-tagged
- --      parameter of the subprogram. Declare a library-level generic subprogram
- --      with a formal derived type using the root type as ancestor. Call
- --      the primitive subprogram of the root type using named association for
- --      the tagged parameter, and provide no actual for the defaulted
- --      parameter. Extend the root type in a second package and override the
- --      root type's subprogram with one which has different parameter names
- --      and no default expression for the non-tagged parameter. Instantiate
- --      the generic subprogram for each of the tagged types in the class and
- --      call the instances.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CC51002_0 is  -- Root message type and operations.
- 
-    type Recipients is (None, Root, Sysop, Local, Remote);
- 
-    type Msg_Type is tagged record                             -- Root type of
-       Text : String (1 .. 10);                                -- class.
-    end record;
- 
-    function Send (Msg : in Msg_Type;                          -- Primitive
-                   To  : Recipients := Local) return Boolean;  -- subprogram.
- 
-    -- ...Other message operations.
- 
- end CC51002_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51002_0 is
- 
-    -- The implementation of Send is purely artificial; the validity of
-    -- its implementation in the context of the abstraction is irrelevant to
-    -- the feature being tested.
- 
-    function Send (Msg : in Msg_Type;
-                   To  : Recipients := Local) return Boolean is
-    begin
-       return (Msg.Text = "Greetings!" and To = Local);
-    end Send;
- 
- end CC51002_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC51002_0;  -- Root message type and operations.
- generic          -- Message class function.
-    type Msg_Block is new CC51002_0.Msg_Type with private;
- function CC51002_1 (M : in Msg_Block) return Boolean;
- 
- 
-      --==================================================================--
- 
- 
- function CC51002_1 (M : in Msg_Block) return Boolean is
-    Okay : Boolean := False;
- begin
- 
-    -- The call to Send below uses the ancestor type's parameter name, which
-    -- should be legal even if the actual subprogram called does not have a
-    -- parameter of that name. Furthermore, it uses the ancestor type's default
-    -- expression for the second parameter, which should be legal even if the
-    -- the actual subprogram called has no such default expression.
- 
-    Okay := Send (Msg => M);
-    -- ...Other processing.
-    return Okay;
- 
- end CC51002_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC51002_0;       -- Root message type and operations.
- package CC51002_2 is  -- Extended message type and operations.
- 
-    type Sender_Type is (Inside, Outside);
- 
-    type Who_Msg_Type is new CC51002_0.Msg_Type with record   -- Derivative of
-       From : Sender_Type;                                    -- root type of
-    end record;                                               -- class.
- 
- 
-    -- Note: this overriding version of Send has different parameter names
-    -- from the root type's function. It also has no default expression.
- 
-    function Send (M : Who_Msg_Type;                          -- Overrides
-                   R : CC51002_0.Recipients) return Boolean;  -- root type's
-                                                              -- operation.
-    -- ...Other extended message operations.
- 
- end CC51002_2;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51002_2 is
- 
-    -- The implementation of Send is purely artificial; the validity of
-    -- its implementation in the context of the abstraction is irrelevant to
-    -- the feature being tested.
- 
-    function Send (M : Who_Msg_Type; R : CC51002_0.Recipients) return Boolean is
-       use type CC51002_0.Recipients;
-    begin
-       return (M.Text = "Willkommen"     and
-               M.From = Outside          and
-               R      = CC51002_0.Local);
-    end Send;
- 
- end CC51002_2;
- 
- 
-      --==================================================================--
- 
- 
- with CC51002_0;  -- Root message type and operations.
- with CC51002_1;  -- Message class function.
- with CC51002_2;  -- Extended message type and operations.
- 
- with Report;
- procedure CC51002 is
- 
-    function Send_Msg  is new CC51002_1 (CC51002_0.Msg_Type);
-    function Send_WMsg is new CC51002_1 (CC51002_2.Who_Msg_Type);
- 
-    Mess  : CC51002_0.Msg_Type     := (Text => "Greetings!");
-    WMess : CC51002_2.Who_Msg_Type := (Text => "Willkommen",
-                                       From => CC51002_2.Outside);
- 
-    TC_Okay_MStatus  : Boolean := False;
-    TC_Okay_WMStatus : Boolean := False;
- 
- begin
-    Report.Test ("CC51002", "Check that, for formal derived tagged types, " &
-                 "the formal parameter names and default expressions for "  &
-                 "a primitive subprogram in an instance are determined by " &
-                 "the primitive subprogram of the ancestor type, but that " &
-                 "the primitive subprogram body executed is that of the"    &
-                 "actual type");
- 
-    TC_Okay_MStatus := Send_Msg (Mess);
-    if not TC_Okay_MStatus then
-       Report.Failed ("Wrong result from call to root type's operation");
-    end if;
- 
-    TC_Okay_WMStatus := Send_WMsg (WMess);
-    if not TC_Okay_WMStatus then
-       Report.Failed ("Wrong result from call to derived type's operation");
-    end if;
- 
-    Report.Result;
- end CC51002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,187 ****
- -- CC51003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the ancestor type of a formal derived type is a composite
- --      type that is not an array type, the formal type inherits components,
- --      including discriminants, from the ancestor type.
- --
- --      Check for the case where the ancestor type is a record type, and the
- --      formal derived type is declared in a generic subprogram.
- --
- -- TEST DESCRIPTION:
- --      Define a discriminated record type in a package. Declare a
- --      library-level generic subprogram with a formal derived type using the
- --      record type as ancestor. Give the generic subprogram an in out
- --      parameter of the formal derived type. Inside the generic, use the
- --      discriminant component and modify the remaining components of the
- --      record parameter. In the main program, declare record objects with two
- --      different discriminant values. Derive an indefinite type from the
- --      record type with a new discriminant part. Instantiate the generic
- --      subprogram for the root record subtype and the derived subtype. Call
- --      the root subtype instance with actual parameters having the two
- --      discriminant values. Also call the derived subtype instance with
- --      an appropriate actual.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      03 Jan 95   SAIC    Removed unknown discriminant part from formal
- --                          derived type.
- --      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed constrained subtype
- --                          instantiation and associated declarations.
- --                          Modified commentary.
- --
- --!
- 
- 
- -- Simulate a fragment of a matrix manipulation application.
- 
- package CC51003_0 is  -- Matrix types.
- 
-    type Matrix is array (Natural range <>, Natural range <>) of Integer;
- 
-    type Square (Side : Natural) is record
-       Mat : Matrix (1 .. Side, 1 .. Side);
-    end record;
- 
-    type Double_Square (Number : Natural) is record
-       Left  : Square (Number);
-       Right : Square (Number);
-    end record;
- 
- end CC51003_0;
- 
- 
- -- No body for CC51003_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC51003_0;  -- Matrix types.
- generic          -- Generic double-matrix "clear" operation.
-    type Dbl_Square is new CC51003_0.Double_Square;            -- Indefinite
- procedure CC51003_1 (Dbl : in out Dbl_Square);                -- formal.
- 
- 
-      --==================================================================--
- 
- 
- procedure CC51003_1 (Dbl : in out Dbl_Square) is
- begin
-    for I in 1 .. Dbl.Number loop     -- Discriminants inherited from ancestor
-       for J in 1 .. Dbl.Number loop  -- type (should work even for derived type
-                                      -- declaring new discriminant part).
-          Dbl.Left.Mat (I, J)  := 0;  -- Other components inherited from
-          Dbl.Right.Mat (I, J) := 0;  -- ancestor type.
- 
-       end loop;
-    end loop;
- end CC51003_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC51003_0;  -- Matrix types.
- with CC51003_1;  -- Generic double-matrix "clear" operation.
- 
- with Report;
- procedure CC51003 is
- 
-    use CC51003_0;  -- "/=" operator directly visible for Double_Square.
- 
-    -- Matrices of root type:
- 
-    Mat_2x2      : Square(Side => 2)           := (Side => 2,
-                                                   Mat  => ( (1, 2), (3, 4) ));
-    Dbl_Mat_2x2  : Double_Square(Number => 2)  := (2, Mat_2x2, Mat_2x2);
- 
- 
-    Zero_2x2     : constant Square(2)        := (2, Mat => ( (0, 0), (0, 0) ));
-    Expected_2x2 : constant Double_Square(2) := (Number => 2,
-                                                 others => Zero_2x2);
- 
- 
- 
-    Mat_3x3      : Square(Side => 3) := (Side => 3,
-                                         Mat  => (1      => (1, 4, 9),
-                                                  others => (1      => 5,
-                                                             others => 7)));
-    Dbl_Mat_3x3  : Double_Square(3)  := (Number => 3, others => Mat_3x3);
- 
- 
-    Zero_3x3     : constant Square(3) := (3, Mat => (others => (0,0,0)));
-    Expected_3x3 : constant Double_Square(Number => 3) :=
-                                         (3, Zero_3x3, Zero_3x3);
- 
- 
-    -- Derived type with new discriminant part (which constrains parent):
- 
-    type New_Dbl_Sq (Num : Natural) is new Double_Square(Num);
- 
-    New_Dbl_2x2      : New_Dbl_Sq (Num => 2) := (2, Mat_2x2, Mat_2x2);
-    Expected_New_2x2 : constant New_Dbl_Sq   := (Num => 2, others => Zero_2x2);
- 
- 
- 
-    -- Instantiations:
- 
-    procedure Clr_Dbl is new CC51003_1 (Double_Square);
-    procedure Clr_New_Dbl is new CC51003_1 (New_Dbl_Sq);
- 
- 
- begin
-    Report.Test ("CC51003", "Check that a formal derived record type " &
-                            "inherits components, including discriminants, " &
-                            "from its ancestor type");
- 
-    -- Simulate use of matrix manipulation operations.
- 
-    Clr_Dbl (Dbl_Mat_2x2);
- 
-    if (Dbl_Mat_2x2 /= Expected_2x2) then
-       Report.Failed ("Wrong result for root type (2x2 matrix)");
-    end if;
- 
- 
-    Clr_Dbl (Dbl_Mat_3x3);
- 
-    if (Dbl_Mat_3x3 /= Expected_3x3) then
-       Report.Failed ("Wrong result for root type (3x3 matrix)");
-    end if;
- 
- 
-    Clr_New_Dbl (New_Dbl_2x2);
- 
-    if (New_Dbl_2x2 /= Expected_New_2x2) then
-       Report.Failed ("Wrong result for derived type (2x2 matrix)");
-    end if;
- 
- 
-    Report.Result;
- 
- end CC51003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,181 ****
- -- CC51004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if the ancestor type of a formal derived type is a composite
- --      type that is not an array type, the formal type inherits components,
- --      including discriminants, from the ancestor type.
- --
- --      Check for the case where the ancestor type is a tagged type, and the
- --      formal derived type is declared in a generic subprogram.
- --
- -- TEST DESCRIPTION:
- --      Define a discriminated tagged type in a package. Declare a
- --      library-level generic subprogram with a formal derived type using the
- --      tagged type as ancestor. Give the generic subprogram an in out
- --      parameter of the formal derived type. Inside the generic, use the
- --      discriminant component and modify the remaining components of the
- --      tagged parameter. In the main program, declare tagged record objects
- --      with two different discriminant values. Derive an indefinite type from
- --      the tagged type with a new discriminant part. Instantiate the
- --      generic subprogram for the root tagged subtype and the derived subtype.
- --      Call the root subtype instance with actual parameters having the two
- --      discriminant values. Also call the derived subtype instance with an
- --      appropriate actual.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      05 Jan 94   SAIC    Removed unknown discriminant part from formal
- --                          derived type. Moved declaration of type
- --                          New_Dbl_Sq from main subprogram to CC51004_0.
- --      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed constrained subtype
- --                          instantiation and associated declarations.
- --                          Modified commentary.
- --
- --!
- 
- -- Simulate a fragment of a matrix manipulation application.
- 
- package CC51004_0 is  -- Matrix types.
- 
-    type Matrix is array (Natural range <>, Natural range <>) of Integer;
- 
-    type Square (Side : Natural) is record
-       Mat : Matrix (1 .. Side, 1 .. Side);
-    end record;
- 
-    type Sq_Type (Num1 : Natural) is tagged record
-       One : Square (Num1);
-    end record;
- 
-    -- Extended type with new discriminant part (which constrains parent):
- 
-    type New_Dbl_Sq (Num2 : Natural) is new Sq_Type(Num2) with record
-       Two : Square (Num2);
-    end record;
- 
- end CC51004_0;
- 
- 
- -- No body for CC51004_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC51004_0;  -- Matrix types.
- generic          -- Generic matrix "clear" operation.
-    type Squares is new CC51004_0.Sq_Type with private;       -- Indefinite
- procedure CC51004_1 (Sq : in out Squares);                   -- formal.
- 
- 
-      --==================================================================--
- 
- 
- procedure CC51004_1 (Sq : in out Squares) is
- begin
-    for I in 1 .. Sq.Num1 loop        -- Discriminants inherited from ancestor
-       for J in 1 .. Sq.Num1 loop     -- type (should work even for derived type
-                                      -- declaring new discriminant part).
-          Sq.One.Mat (I, J) := 0;     -- Other components inherited from
-                                      -- ancestor type.
-       end loop;
-    end loop;
- end CC51004_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC51004_0;  -- Matrix types.
- with CC51004_1;  -- Generic double-matrix "clear" operation.
- 
- with Report;
- procedure CC51004 is
- 
-    use CC51004_0;  -- "/=" operator directly visible for Sq_Type.
- 
-    -- Matrices of root type:
- 
-    Mat_2x2      : Square(Side => 2)  := (Side => 2, Mat => ( (1, 2), (3, 4) ));
-    One_Mat_2x2  : Sq_Type(Num1 => 2) := (2, Mat_2x2);
- 
-    Zero_2x2     : constant Square(2)  := (2, Mat => ( (0, 0), (0, 0) ));
-    Expected_2x2 : constant Sq_Type(2) := (Num1 => 2, One => Zero_2x2);
- 
- 
-    Mat_3x3      : Square(Side => 3) := (Side => 3,
-                                         Mat  => (1      => (5, 2, 7),
-                                                  others => (1      => 4,
-                                                             others => 9)));
-    One_Mat_3x3  : Sq_Type(3)        := (Num1 => 3, One => Mat_3x3);
- 
-    Zero_3x3     : constant Square(3)        := (3, Mat => (others => (0,0,0)));
-    Expected_3x3 : constant Sq_Type(Num1 => 3) := (3, Zero_3x3);
- 
- 
-    New_Dbl_2x2      : New_Dbl_Sq(Num2 => 2) := (2, others => Mat_2x2);
-    Expected_New_2x2 : constant New_Dbl_Sq := (2, Zero_2x2, Mat_2x2);
- 
- 
- 
-    -- Instantiations:
- 
-    procedure Clr_Mat is new CC51004_1 (Sq_Type);
-    procedure Clr_New_Dbl is new CC51004_1 (New_Dbl_Sq);
- 
- 
- begin
-    Report.Test ("CC51004", "Check that a formal derived tagged type " &
-                            "inherits components, including discriminants, " &
-                            "from its ancestor type");
- 
-    -- Simulate use of matrix manipulation operations.
- 
- 
-    Clr_Mat (One_Mat_2x2);
- 
-    if (One_Mat_2x2 /= Expected_2x2) then
-       Report.Failed ("Wrong result root type (2x2 matrix)");
-    end if;
- 
- 
-    Clr_Mat (One_Mat_3x3);
- 
-    if (One_Mat_3x3 /= Expected_3x3) then
-       Report.Failed ("Wrong result root type (3x3 matrix)");
-    end if;
- 
- 
-    Clr_New_Dbl (New_Dbl_2x2);
- 
-    if (New_Dbl_2x2 /= Expected_New_2x2) then
-       Report.Failed ("Wrong result extended type (2x2 matrix)");
-    end if;
- 
- 
-    Report.Result;
- end CC51004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,224 ****
- -- CC51006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, in an instance, each implicit declaration of a primitive
- --      subprogram of a formal (nontagged) derived type declares a view of
- --      the corresponding primitive subprogram of the ancestor type, even if
- --      the subprogram has been overridden for the actual type. Check that for
- --      a formal derived type with no discriminant part, if the ancestor
- --      subtype is an unconstrained scalar subtype then the actual may be
- --      either constrained or unconstrained.
- --
- -- TEST DESCRIPTION:
- --      The formal derived type has no discriminant part, but the ancestor
- --      subtype is unconstrained, making the formal type unconstrained. Since
- --      the ancestor subtype is a scalar subtype (not an access or composite
- --      subtype), the actual may be either constrained or unconstrained.
- --
- --      Declare a root type of a class as an unconstrained scalar (use floating
- --      point). Declare a primitive subprogram of the root type. Declare a
- --      generic package which has a formal derived type with the scalar root
- --      type as ancestor. Inside the generic, declare an operation which calls
- --      the ancestor type's primitive subprogram. Derive both constrained and
- --      unconstrained types from the root type and override the primitive
- --      subprogram for each. Declare a constrained subtype of the unconstrained
- --      derivative. Instantiate the generic package for the derived types and
- --      the subtype and call the "generic" operation for each one. Confirm that
- --      in all cases the root type's implementation of the primitive
- --      subprogram is called.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- package CC51006_0 is  -- Weight class.
- 
-    type Weight_Type is digits 3;         -- Root type of class (unconstrained).
- 
-    function Weight_To_String (Wt : Weight_Type) return String;
- 
-    -- ... Other operations.
- 
- end CC51006_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51006_0 is
- 
-    -- The implementations of the operations below are purely artificial; the
-    -- validity of their implementations in the context of the abstraction is
-    -- irrelevant to the feature being tested.
- 
-    function Weight_To_String (Wt : Weight_Type) return String is
-    begin
-       if Wt > 0.0 then         -- Always true for this test.
-          return ("Root type's implementation called");
-       else
-          return ("Unexpected result                ");
-       end if;
-    end Weight_To_String;
- 
- end CC51006_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC51006_0;  -- Weight class.
- generic          -- Generic weight operations. 
-    type Weight is new CC51006_0.Weight_Type;
- package CC51006_1 is
- 
-    procedure Output_Weight (Wt : in Weight; TC_Return : out String);
- 
-    -- ... Other operations.
- 
- end CC51006_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51006_1 is
- 
- 
-    -- The implementation of this procedure is purely artificial, and contains
-    -- an artificial parameter for testing purposes: the procedure returns the
-    -- weight string to the caller.
- 
-    procedure Output_Weight (Wt : in Weight; TC_Return : out String) is
-    begin
-       TC_Return := Weight_To_String (Wt);   -- Should always call root type's
-    end Output_Weight;                       -- implementation.
- 
- 
- end CC51006_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC51006_0;       -- Weight class.
- use  CC51006_0;
- package CC51006_2 is  -- Extensions to weight class.
- 
-    type Grams is new Weight_Type;                         -- Unconstrained
-                                                           -- derivative.
- 
-    function Weight_To_String (Wt : Grams) return String;  -- Overrides root
-                                                           -- type's operation.
- 
-    subtype Milligrams is Grams                            -- Constrained
-      range 0.0 .. 0.999;                                  -- subtype (of der.).
- 
-    type Pounds is new Weight_Type                         -- Constrained
-      range 0.0 .. 500.0;                                  -- derivative.
- 
-    function Weight_To_String (Wt : Pounds) return String; -- Overrides root
-                                                           -- type's operation.
- 
- end CC51006_2;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51006_2 is
- 
-    -- The implementations of the operations below are purely artificial; the
-    -- validity of their implementations in the context of the abstraction is
-    -- irrelevant to the feature being tested.
- 
-    function Weight_To_String (Wt : Grams) return String is
-    begin
-       return ("GRAMS: Should never be called    ");
-    end Weight_To_String;
- 
- 
-    function Weight_To_String (Wt : Pounds) return String is
-    begin
-       return ("POUNDS: Should never be called   ");
-    end Weight_To_String;
- 
- end CC51006_2;
- 
- 
-      --==================================================================--
- 
- 
- with CC51006_1; -- Generic weight operations.
- with CC51006_2; -- Extensions to weight class.
- 
- with Report;
- procedure CC51006 is
- 
-    package Metric_Wts_G  is new CC51006_1 (CC51006_2.Grams);      -- Unconstr.
-    package Metric_Wts_MG is new CC51006_1 (CC51006_2.Milligrams); -- Constr.
-    package US_Wts        is new CC51006_1 (CC51006_2.Pounds);     -- Constr.
- 
-    Gms : CC51006_2.Grams      := 113.451;
-    Mgm : CC51006_2.Milligrams := 0.549;
-    Lbs : CC51006_2.Pounds     := 24.52;
- 
- 
-    subtype TC_Buffers is String (1 .. 33);
- 
-    TC_Expected : constant TC_Buffers := "Root type's implementation called";
-    TC_Buffer   :          TC_Buffers;
- 
- begin
-    Report.Test ("CC51006", "Check that, in an instance, each implicit "  &
-                 "declaration of a primitive subprogram of a formal "     &
-                 "(nontagged) type declares a view of the corresponding " &
-                 "primitive subprogram of the ancestor type");
- 
- 
-    Metric_Wts_G.Output_Weight (Gms, TC_Buffer);
- 
-    if TC_Buffer /= TC_Expected then
-       Report.Failed ("Root operation not called for unconstrained derivative");
-    end if;
- 
- 
-    Metric_Wts_MG.Output_Weight (Mgm, TC_Buffer);
- 
-    if TC_Buffer /= TC_Expected then
-       Report.Failed ("Root operation not called for constrained subtype");
-    end if;
- 
- 
-    US_Wts.Output_Weight (Lbs, TC_Buffer);
- 
-    if TC_Buffer /= TC_Expected then
-       Report.Failed ("Root operation not called for constrained derivative");
-    end if;
- 
-    Report.Result;
- end CC51006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,305 ****
- -- CC51007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a generic formal derived tagged type is a private extension.
- --      Specifically, check that, for a generic formal derived type whose
- --      ancestor type has abstract primitive subprograms, neither the formal
- --      derived type nor its descendants need be abstract. Check that objects
- --      and components of the formal derived type and its nonabstract
- --      descendants may be declared and allocated, as may nonabstract
- --      functions returning these types, and that aggregates of nonabstract
- --      descendants of the formal derived type are legal. Check that calls to
- --      the abstract primitive subprograms of the ancestor dispatch to the 
- --      bodies corresponding to the tag of the actual parameters.
- --
- -- TEST DESCRIPTION:
- --      Although the ancestor type is abstract and has abstract primitive
- --      subprograms, these subprograms, when inherited by a formal nonabstract
- --      derived type, are not abstract, since the formal derived type is a
- --      nonabstract private extension.  
- --
- --      Thus, derivatives of the formal derived type need not be abstract,
- --      and both the formal derived type and its derivatives are considered
- --      nonabstract types.
- --
- --      This test verifies that the restrictions placed on abstract types do
- --      not apply to the formal derived type or its derivatives. Specifically,
- --      objects of, components of, allocators of, and nonabstract functions
- --      returning the formal derived type or its derivatives are legal. In
- --      addition, the test verifies that a call within the instance to a
- --      primitive subprogram of the (abstract) ancestor type dispatches to
- --      the body corresponding to the tag of the actual parameter.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      23 Dec 94   SAIC    Deleted illegal extension aggregate.  Corrected
- --                          dispatching call. Editorial changes to commentary.
- --      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Moved instantiation of CC51007_3
- --                          to library level.
- --      11 Aug 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
- --                          clauses of CC51007_1 and CC51007_4.
- --
- --!
- 
- package CC51007_0 is
- 
-    Max_Length : constant := 10;
-    type Text is new String(1 .. Max_Length);
- 
-    type Alert is abstract tagged record              -- Root type of class
-       Message : Text := (others => '*');             -- (abstract).
-    end record;
- 
-    procedure Handle (A: in out Alert) is abstract;   -- Abstract dispatching
-                                                      -- operation.
- 
- end CC51007_0;
- 
- -- No body for CC51007_0;
- 
- 
-      --===================================================================--
- 
- 
- with CC51007_0;
- 
- with Ada.Calendar;
- pragma Elaborate (Ada.Calendar);
- 
- package CC51007_1 is
- 
-    type Low_Alert is new CC51007_0.Alert with record
-       Time_Of_Arrival : Ada.Calendar.Time := Ada.Calendar.Time_Of (1901, 8, 1);
-    end record;
- 
-    procedure Handle (A: in out Low_Alert);           -- Overrides parent's
-                                                      -- implementation.
-    Low : Low_Alert;
- 
- end CC51007_1;
- 
- 
-      --===================================================================--
- 
- 
- package body CC51007_1 is
- 
-    procedure Handle (A: in out Low_Alert) is         -- Artificial for
-    begin                                             -- testing.
-       A.Time_Of_Arrival := Ada.Calendar.Time_Of (1984, 1, 1);
-       A.Message := "Low Alert!";
-    end Handle;
- 
- end CC51007_1;
- 
- 
-      --===================================================================--
- 
- 
- with CC51007_1;
- package CC51007_2 is
- 
-    type Person is (OOD, CO, CinC);
- 
-    type Medium_Alert is new CC51007_1.Low_Alert with record
-       Action_Officer : Person := OOD;
-    end record;
- 
-    procedure Handle (A: in out Medium_Alert);        -- Overrides parent's
-                                                      -- implementation.
-    Med : Medium_Alert;
- 
- end CC51007_2;
- 
- 
-      --===================================================================--
- 
- 
- with Ada.Calendar;
- package body CC51007_2 is
- 
-    procedure Handle (A: in out Medium_Alert) is      -- Artificial for
-    begin                                             -- testing.
-       A.Action_Officer := CO;
-       A.Time_Of_Arrival := Ada.Calendar.Time_Of (2001, 1, 1);
-       A.Message := "Med Alert!";
-    end Handle;
- 
- end CC51007_2;
- 
- 
-      --===================================================================--
- 
- 
- with CC51007_0;
- generic
-    type Alert_Type is new CC51007_0.Alert with private;
-    Initial_State : in Alert_Type;
- package CC51007_3 is
- 
-    function Clear_Message (A: Alert_Type)                -- Function returning
-      return Alert_Type;                                  -- formal type.
- 
- 
-    Max_Note : Natural := 10;
-    type Note is new String (1 .. Max_Note);
- 
-    type Extended_Alert is new Alert_Type with record
-       Addendum : Note := (others => '*');
-    end record;
- 
-    -- In instance, inherits version of Handle from
-    -- actual corresponding to formal type.
- 
-    function Annotate_Alert (A: in Alert_Type'Class)      -- Function returning
-      return Extended_Alert;                              -- derived type.
- 
- 
-    Init_Ext_Alert : constant Extended_Alert     :=       -- Object declaration.
-      (Initial_State with Addendum => "----------");      -- Aggregate.
- 
- 
-    type Alert_Type_Ptr is access constant Alert_Type;
-    type Ext_Alert_Ptr  is access          Extended_Alert;
- 
-    Init_Alert_Ptr     : Alert_Type_Ptr := 
-      new Alert_Type'(Initial_State);                        -- Allocator.
- 
-    Init_Ext_Alert_Ptr : Ext_Alert_Ptr  :=
-      new Extended_Alert'(Init_Ext_Alert);                -- Allocator.
- 
- 
-    type Alert_Pair is record
-       A  : Alert_Type;                                   -- Component.
-       EA : Extended_Alert;                               -- Component.
-    end record;
- 
- end CC51007_3;
- 
- 
-      --===================================================================--
- 
- 
- package body CC51007_3 is
- 
-    function Clear_Message (A: Alert_Type) return Alert_Type is
-       Temp : Alert_Type := A;                       -- Object declaration.
-    begin
-       Temp.Message := (others => '-');
-       return Temp;
-    end Clear_Message;
- 
-    function Annotate_Alert (A: in Alert_Type'Class) return Extended_Alert is
-       Temp : Alert_Type'Class := A;
-    begin
-       Handle (Temp);                                -- Dispatching call to
-                                                     -- operation of ancestor.
-       return (Alert_Type(Temp) with Addendum => "No comment");
-    end Annotate_Alert;
- 
- end CC51007_3;
- 
- 
-      --===================================================================--
- 
- 
- with CC51007_1;
- 
- with CC51007_3;
- pragma Elaborate (CC51007_3);
- 
- package CC51007_4 is new CC51007_3 (CC51007_1.Low_Alert, CC51007_1.Low);
- 
- 
-      --===================================================================--
- 
- 
- with CC51007_1;
- with CC51007_2;
- with CC51007_3;
- with CC51007_4;
- 
- with Ada.Calendar;
- with Report;
- procedure CC51007 is
- 
-    package Alert_Support renames CC51007_4;
- 
-    Ext : Alert_Support.Extended_Alert;
- 
-    TC_Result       : Alert_Support.Extended_Alert;
- 
-    TC_Low_Expected : constant Alert_Support.Extended_Alert :=
-                        (Time_Of_Arrival => Ada.Calendar.Time_Of (1984, 1, 1),
-                         Message         => "Low Alert!",
-                         Addendum        => "No comment");
- 
-    TC_Med_Expected : constant Alert_Support.Extended_Alert :=
-                        (Time_Of_Arrival => Ada.Calendar.Time_Of (2001, 1, 1),
-                         Message         => "Med Alert!",
-                         Addendum        => "No comment");
- 
-    TC_Ext_Expected : constant Alert_Support.Extended_Alert := TC_Low_Expected;
- 
- 
-    use type Alert_Support.Extended_Alert;
- 
- begin
-    Report.Test ("CC51007", "Check that, for a generic formal derived type "  &
-                 "whose ancestor type has abstract primitive subprograms, "   &
-                 "neither the formal derived type nor its descendants need "  &
-                 "be abstract, and that objects of, components of, "          &
-                 "allocators of, aggregates of, and nonabstract functions "   &
-                 "returning these types are legal. Check that calls to the "  &
-                 "abstract primitive subprograms of the ancestor dispatch "   &
-                 "to the bodies corresponding to the tag of the actual "      &
-                 "parameters");
- 
- 
-    TC_Result := Alert_Support.Annotate_Alert (CC51007_1.Low);  -- Dispatching
-                                                                -- call.
-    if TC_Result /= TC_Low_Expected then
-       Report.Failed ("Wrong results from dispatching call (Low_Alert)");
-    end if;
- 
- 
-    TC_Result := Alert_Support.Annotate_Alert (CC51007_2.Med);  -- Dispatching
-                                                                -- call.
-    if TC_Result /= TC_Med_Expected then
-       Report.Failed ("Wrong results from dispatching call (Medium_Alert)");
-    end if;
- 
- 
-    TC_Result := Alert_Support.Annotate_Alert (Ext);   -- Results in dispatching
-                                                       -- call.
-    if TC_Result /= TC_Ext_Expected then
-       Report.Failed ("Wrong results from dispatching call (Extended_Alert)");
-    end if;
- 
- 
-    Report.Result;
- end CC51007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- CC51008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that operations are inherited for a formal derived type whose
- --    ancestor is also a formal type as described in the corrigendum.
- --    (Defect Report 8652/0038, as reflected in Technical Corrigendum 1,
- --    RM95 12.5.1(21/1)).
- --
- -- CHANGE HISTORY:
- --    29 Jan 2001   PHL   Initial version.
- --    30 Apr 2002   RLB   Readied for release.
- --
- --!
- package CC51008_0 is
- 
-     type R0 is
- 	record
- 	    C : Float;
- 	end record;
- 
-     procedure S (X : R0);
- 
- end CC51008_0;
- 
- with Report;
- use Report;
- package body CC51008_0 is
-     procedure S (X : R0) is
-     begin
- 	Comment ("CC51008_0.S called");
-     end S;
- end CC51008_0;
- 
- with CC51008_0;
- generic
-     type F1 is new CC51008_0.R0;
-     type F2 is new F1;
- package CC51008_1 is
-     procedure G (O1 : F1; O2 : F2);
- end CC51008_1;
- 
- package body CC51008_1 is
-     procedure G (O1 : F1; O2 : F2) is
-     begin
- 	S (O1);
- 	S (O2);
-     end G;
- end CC51008_1;
- 
- with CC51008_0;
- package CC51008_2 is
-     type R2 is new CC51008_0.R0;
-     procedure S (X : out R2);
- end CC51008_2;
- 
- with Report;
- use Report;
- package body CC51008_2 is
-     procedure S (X : out R2) is
-     begin
- 	Failed ("CC51008_2.S called");
-     end S;
- end CC51008_2;
- 
- with CC51008_2;
- package CC51008_3 is
-     type R3 is new CC51008_2.R2;
-     procedure S (X : R3);
- end CC51008_3;
- 
- with Report;
- use Report;
- package body CC51008_3 is
-     procedure S (X : R3) is
-     begin
- 	Failed ("CC51008_3.S called");
-     end S;
- end CC51008_3;
- 
- with CC51008_1;
- with CC51008_2;
- with CC51008_3;
- with Report;
- use Report;
- procedure CC51008 is
- 
-     package Inst is new CC51008_1 (CC51008_2.R2,
- 				   CC51008_3.R3);
- 
-     X2 : constant CC51008_2.R2 := (C => 2.0);
-     X3 : constant CC51008_3.R3 := (C => 3.0);
- 
- begin
-     Test ("CC51008",
- 	  "Check that operations are inherited for a formal derived " &
- 	     "type whose ancestor is also a formal type as described in " &
- 	     "RM95 12.5.1(21/1)");
-     Inst.G (X2, X3);
-     Result;
- end CC51008;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,193 ****
- -- CC51A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, in an instance, each implicit declaration of a user-defined
- --      subprogram of a formal derived record type declares a view of the
- --      corresponding primitive subprogram of the ancestor, even if the
- --      primitive subprogram has been overridden for the actual type.
- --
- -- TEST DESCRIPTION:
- --      Declare a "fraction" type abstraction in a package (foundation code).
- --      Declare a "fraction" I/O routine in a generic package with a formal
- --      derived type whose ancestor type is the fraction type declared in
- --      the first package. Within the I/O routine, call other operations of
- --      ancestor type. Derive from the root fraction type in another package
- --      and override one of the operations called in the generic I/O routine.
- --      Derive from the derivative of the root fraction type. Instantiate
- --      the generic package for each of the three types and call the I/O
- --      routine.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC51A00.A
- --         CC51A01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FC51A00;         -- Fraction type abstraction.
- generic               -- Fraction I/O support.
-    type Fraction is new FC51A00.Fraction_Type;     -- Formal derived type of a
- package CC51A01_0 is                               -- (private) record type.
- 
-    -- Simulate writing a fraction to standard output. In a real application,
-    -- this subprogram might be a procedure which uses Text_IO routines. For
-    -- the purposes of the test, the "output" is returned to the caller as a
-    -- string.
-    function Put (Item : in Fraction) return String;
- 
-    -- ... Other I/O operations for fractions.
- 
- end CC51A01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51A01_0 is
- 
-    function Put (Item : in Fraction) return String is
-       Num : constant String :=              -- Fraction's primitive subprograms
-         Integer'Image (Numerator (Item));   -- are inherited from its parent
-       Den : constant String :=              -- (FC51A00.Fraction_Type) and NOT
-         Integer'Image (Denominator (Item)); -- from the actual type.
-    begin
-       return (Num & '/' & Den);
-    end Put;
- 
- end CC51A01_0;
- 
- 
-      --==================================================================--
- 
- 
- with FC51A00;         -- Fraction type abstraction.
- package CC51A01_1 is
- 
-    -- Derive directly from the root type of the class and override one of the
-    -- primitive subprograms.
- 
-    type Pos_Fraction is new FC51A00.Fraction_Type;     -- Derived directly from
-                                                        -- root type of class.
-    -- Inherits "/" from root type.
-    -- Inherits "-" from root type.
-    -- Inherits Numerator from root type.
-    -- Inherits Denominator from root type.
- 
-    -- Return absolute value of numerator as integer.
-    function Numerator (Frac : Pos_Fraction)            -- Overrides parent's
-      return Integer;                                   -- operation.
- 
- end CC51A01_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51A01_1 is
- 
-    -- This body should never be called.
-    --
-    -- The test sends the function Numerator a fraction with a negative
-    -- numerator, and expects this negative numerator to be returned. This
-    -- version of the function returns the absolute value of the numerator.
-    -- Thus, a call to this version is detectable by examining the sign
-    -- of the return value.
- 
-    function Numerator (Frac : Pos_Fraction) return Integer is
-       Converted_Frac : FC51A00.Fraction_Type := FC51A00.Fraction_Type (Frac);
-       Orig_Numerator : Integer := FC51A00.Numerator (Converted_Frac);
-    begin
-       return abs (Orig_Numerator);
-    end Numerator;
- 
- end CC51A01_1;
- 
- 
-      --==================================================================--
- 
- 
- with FC51A00;     -- Fraction type abstraction.
- with CC51A01_0;   -- Fraction I/O support.
- with CC51A01_1;   -- Positive fraction type abstraction.
- 
- with Report;
- procedure CC51A01 is
- 
-    type Distance is new CC51A01_1.Pos_Fraction;    -- Derived indirectly from
-                                                    -- root type of class.
-    -- Inherits "/" indirectly from root type.
-    -- Inherits "-" indirectly from root type.
-    -- Inherits Numerator directly from parent type.
-    -- Inherits Denominator indirectly from root type.
- 
-    use FC51A00, CC51A01_1;                         -- All primitive subprograms
-                                                    -- directly visible.
- 
-    package Fraction_IO     is new CC51A01_0 (Fraction_Type);
-    package Pos_Fraction_IO is new CC51A01_0 (Pos_Fraction);
-    package Distance_IO     is new CC51A01_0 (Distance);
- 
-    -- For each of the instances above, the subprogram "Put" should produce
-    -- the same result. That is, the primitive subprograms called by Put
-    -- should in all cases be those of the type Fraction_Type, which is the
-    -- ancestor type for the formal derived type in the generic unit. In
-    -- particular, for Pos_Fraction_IO and Distance_IO, the versions of
-    -- Numerator called should NOT be those of the actual types, which override
-    -- Fraction_Type's version.
- 
-    TC_Expected_Result : constant String := "-3/ 16";
- 
-    TC_Root_Type_Of_Class  : Fraction_Type := -3/16;
-    TC_Direct_Derivative   : Pos_Fraction  := -3/16;
-    TC_Indirect_Derivative : Distance      := -3/16;
- 
- begin
-    Report.Test ("CC51A01", "Check that, in an instance, each implicit "     &
-                 "declaration of a user-defined subprogram of a formal "     &
-                 "derived record type declares a view of the corresponding " &
-                 "primitive subprogram of the ancestor, even if the "        &
-                 "primitive subprogram has been overridden for the actual "  &
-                 "type");
- 
-    if (Fraction_IO.Put (TC_Root_Type_Of_Class) /= TC_Expected_Result) then
-       Report.Failed ("Wrong result for root type");
-    end if;
- 
-    if (Pos_Fraction_IO.Put (TC_Direct_Derivative) /= TC_Expected_Result) then
-       Report.Failed ("Wrong result for direct derivative");
-    end if;
- 
-    if (Distance_IO.Put (TC_Indirect_Derivative) /= TC_Expected_Result) then
-       Report.Failed ("Wrong result for INdirect derivative");
-    end if;
- 
-    Report.Result;
- end CC51A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51b03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51b03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51b03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51b03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,258 ****
- -- CC51B03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the attribute S'Definite, where S is an indefinite formal
- --      private or derived type, returns true if the actual corresponding to
- --      S is definite, and returns false otherwise.
- --
- -- TEST DESCRIPTION:
- --      A definite subtype is any subtype which is not indefinite. An
- --      indefinite subtype is either:
- --         a) An unconstrained array subtype.
- --         b) A subtype with unknown discriminants (this includes class-wide
- --            types).
- --         c) A subtype with unconstrained discriminants without defaults.
- --
- --      The possible forms of indefinite formal subtype are as follows:
- --
- --         Formal derived types:
- --          X - Ancestor is an unconstrained array type
- --          * - Ancestor is a discriminated record type without defaults
- --          X - Ancestor is a discriminated tagged type
- --          * - Ancestor type has unknown discriminants
- --            - Formal type has an unknown discriminant part
- --          * - Formal type has a known discriminant part
- --
- --         Formal private types:
- --            - Formal type has an unknown discriminant part
- --          * - Formal type has a known discriminant part
- --
- --      The formal subtypes preceded by an 'X' above are not covered, because
- --      other rules prevent a definite subtype from being passed as an actual.
- --      The formal subtypes preceded by an '*' above are not covered, because
- --      'Definite is less likely to be used for these formals.
- --
- --      The following kinds of actuals are passed to various of the formal
- --      types listed above:
- --
- --            - Undiscriminated type
- --            - Type with defaulted discriminants
- --            - Type with undefaulted discriminants
- --            - Class-wide type
- --
- --      A typical usage of S'Definite might be algorithm selection in a
- --      generic I/O package, e.g., the use of fixed-length or variable-length
- --      records depending on whether the actual is definite or indefinite.
- --      In such situations, S'Definite would appear in if conditions or other
- --      contexts requiring a boolean expression. This test checks S'Definite
- --      in such usage contexts but, for brevity, omits any surrounding
- --      usage code.
- --      
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC51B00.A
- --      -> CC51B03.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FC51B00;  -- Indefinite subtype declarations.
- package CC51B03_0 is
- 
-    --
-    -- Formal private type cases:
-    --
- 
-    generic
-       type Formal (<>) is private;              -- Formal has unknown
-    package PrivateFormalUnknownDiscriminants is -- discriminant part.
-       function Is_Definite return Boolean;
-    end PrivateFormalUnknownDiscriminants;
- 
- 
-    --
-    -- Formal derived type cases:
-    --
- 
-    generic
-       type Formal (<>) is new FC51B00.Vector    -- Formal has an unknown disc.
-         with private;                           -- part; ancestor is tagged.
-    package TaggedAncestorUnknownDiscriminants is
-       function Is_Definite return Boolean;
-    end TaggedAncestorUnknownDiscriminants;
- 
- 
- end CC51B03_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51B03_0 is
- 
-    package body PrivateFormalUnknownDiscriminants is
-       function Is_Definite return Boolean is
-       begin
-          if Formal'Definite then                -- Attribute used in "if"
-             -- ...Execute algorithm #1...       -- condition inside subprogram.
-             return True;
-          else
-             -- ...Execute algorithm #2...
-             return False;
-          end if;
-       end Is_Definite;
-    end PrivateFormalUnknownDiscriminants;
- 
- 
-    package body TaggedAncestorUnknownDiscriminants is
-       function Is_Definite return Boolean is
-       begin
-          return Formal'Definite;                -- Attribute used in return
-       end Is_Definite;                          -- statement inside subprogram.
-    end TaggedAncestorUnknownDiscriminants;
- 
- 
- end CC51B03_0;
- 
- 
-      --==================================================================--
- 
- 
- with FC51B00;
- package CC51B03_1 is
- 
-    subtype Spin_Type is Natural range 0 .. 3;
- 
-    type Extended_Vector (Spin : Spin_Type) is   -- Tagged type with
-      new FC51B00.Vector with null record;       -- discriminant (indefinite).
-       
- 
- end CC51B03_1;
- 
- 
-      --==================================================================--
- 
- 
- with FC51B00;   -- Indefinite subtype declarations.
- with CC51B03_0; -- Generic package declarations.
- with CC51B03_1;
- 
- with Report;
- procedure CC51B03 is
- 
-    --
-    -- Instances for formal private type with unknown discriminants:
-    --
- 
-    package PrivateFormal_UndiscriminatedTaggedActual is new
-      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector);
- 
-    package PrivateFormal_ClassWideActual is new
-      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector'Class);
- 
-    package PrivateFormal_DiscriminatedTaggedActual is new
-      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square_Pair);
- 
-    package PrivateFormal_DiscriminatedUndefaultedRecordActual is new
-      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square);
- 
- 
-    subtype Length is Natural range 0 .. 20;
-    type Message (Len : Length := 0) is record   -- Record type with defaulted
-       Text : String (1 .. Len);                 -- discriminant (definite).
-    end record;
-       
-    package PrivateFormal_DiscriminatedDefaultedRecordActual is new
-      CC51B03_0.PrivateFormalUnknownDiscriminants (Message);
- 
- 
-    --
-    -- Instances for formal derived tagged type with unknown discriminants:
-    --
- 
-    package DerivedFormal_UndiscriminatedTaggedActual is new
-      CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector);
- 
-    package DerivedFormal_ClassWideActual is new
-      CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector'Class);
- 
-    package DerivedFormal_DiscriminatedTaggedActual is new
-      CC51B03_0.TaggedAncestorUnknownDiscriminants (CC51B03_1.Extended_Vector);
- 
- 
- begin
-    Report.Test ("CC51B03", "Check that S'Definite returns true if the " &
-                 "actual corresponding to S is definite, and false otherwise");
- 
- 
-    if not PrivateFormal_UndiscriminatedTaggedActual.Is_Definite then
-       Report.Failed ("Formal private/unknown discriminants: wrong " &
-                      "result for undiscriminated tagged actual");
-    end if;  
- 
-    if PrivateFormal_ClassWideActual.Is_Definite then
-       Report.Failed ("Formal private/unknown discriminants: wrong " &
-                      "result for class-wide actual");
-    end if;  
- 
-    if PrivateFormal_DiscriminatedTaggedActual.Is_Definite then
-       Report.Failed ("Formal private/unknown discriminants: wrong " &
-                      "result for discriminated tagged actual");
-    end if;  
- 
-    if PrivateFormal_DiscriminatedUndefaultedRecordActual.Is_Definite then
-       Report.Failed ("Formal private/unknown discriminants: wrong result " &
-                      "for record actual with undefaulted discriminants");
-    end if;  
- 
-    if not PrivateFormal_DiscriminatedDefaultedRecordActual.Is_Definite then
-       Report.Failed ("Formal private/unknown discriminants: wrong result " &
-                      "for record actual with defaulted discriminants");
-    end if;  
- 
- 
-    if not DerivedFormal_UndiscriminatedTaggedActual.Is_Definite then
-       Report.Failed ("Formal derived/unknown discriminants: wrong result " &
-                      "for undiscriminated tagged actual");
-    end if;  
- 
-    if DerivedFormal_ClassWideActual.Is_Definite then
-       Report.Failed ("Formal derived/unknown discriminants: wrong result " &
-                      "for class-wide actual");
-    end if;  
- 
-    if DerivedFormal_DiscriminatedTaggedActual.Is_Definite then
-       Report.Failed ("Formal derived/unknown discriminants: wrong result " &
-                      "for discriminated tagged actual");
-    end if;  
- 
- 
-    Report.Result;
- end CC51B03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51d01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51d01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51d01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51d01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,262 ****
- -- CC51D01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, in an instance, each implicit declaration of a user-defined
- --      subprogram of a formal private extension declares a view of the
- --      corresponding primitive subprogram of the ancestor, and that if the
- --      tag in a call is statically determined to be that of the formal type,
- --      the body executed will be that corresponding to the actual type.
- --
- --      Check subprograms declared within a generic formal package. Check for
- --      the case where the actual type passed to the formal private extension
- --      is a specific tagged type. Check for several types in the same class.
- --
- --
- -- TEST DESCRIPTION:
- --      Declare a list abstraction in a generic package which manages lists of
- --      elements of any nonlimited type (foundation code). Declare a package
- --      which declares a tagged type and a type derived from it. Declare an
- --      operation for the root tagged type and override it for the derived
- --      type. Derive a type from this derived type, but do not override the
- --      operation. Declare a generic subprogram which operates on lists of
- --      elements of tagged types. Provide the generic subprogram with two
- --      formal parameters: (1) a formal derived tagged type which represents a
- --      list element type, and (2) a generic formal package with the list
- --      abstraction package as template. Use the formal derived type as the
- --      generic formal actual part for the formal package. Within the generic
- --      subprogram, call the operation of the root tagged type. In the main
- --      program, instantiate the generic list package and the generic
- --      subprogram with the root tagged type and each derivative, then call
- --      each instance with an object of the appropriate type.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC51D00.A
- --      -> CC51D01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      04 Jan 95   SAIC    Moved declaration of type Ranked_ID_Type from
- --                          main subprogram to package CC51D01_0. Removed
- --                          case passing class-wide actual to instance.
- --                          Updated test description and modified comments.
- --
- --!
- 
- package CC51D01_0 is -- This package simulates support for a personnel
-                      -- database.
- 
-    type SSN_Type is new String (1 .. 9);
- 
-    type Blind_ID_Type is tagged record                   -- Root type of
-       SSN : SSN_Type;                                    -- class.
-       -- ... Other components.
-    end record;
- 
-    procedure Update_ID (Item : in out Blind_ID_Type);    -- Parent operation.
- 
-    -- ... Other operations.
- 
- 
-    type Name_Type is new String (1 .. 9);
- 
-    type Named_ID_Type is new Blind_ID_Type with record   -- Direct derivative
-       Name : Name_Type := "Doe      ";                   -- of root type.
-       -- ... Other components.
-    end record;
- 
-    -- Inherits Update_ID from parent.
- 
-    procedure Update_ID (Item : in out Named_ID_Type);    -- Overrides parent's
-                                                          -- implementation.
- 
- 
-    type Ranked_ID_Type is new Named_ID_Type with record
-       Level : Integer := 0;                              -- Indirect derivative
-       -- ... Other components.                           -- of root type.
-    end record;
- 
-    -- Inherits Update_ID from parent.
- 
- end CC51D01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51D01_0 is
- 
-    -- The implementations of Update_ID are purely artificial; the validity of
-    -- their implementations in the context of the abstraction is irrelevant to
-    -- the feature being tested.
- 
-    procedure Update_ID (Item : in out Blind_ID_Type) is
-    begin
-       Item.SSN := "111223333";
-    end Update_ID;
- 
- 
-    procedure Update_ID (Item : in out Named_ID_Type) is
-    begin
-       Item.SSN := "444556666";
-       -- ... Other stuff.
-    end Update_ID;
- 
- end CC51D01_0;
- 
- 
-      --==================================================================--
- 
- 
- --                           --
- -- Formal package used here. --
- --                           --
- 
- with FC51D00;    -- Generic list abstraction.
- with CC51D01_0;  -- Tagged type declarations.
- generic          -- This procedure simulates a generic operation for types
-                  -- in the class rooted at Blind_ID_Type.
-    type Elem_Type is new CC51D01_0.Blind_ID_Type with private;
-    with package List_Mgr is new FC51D00 (Elem_Type);
- procedure CC51D01_1 (L : in out List_Mgr.List_Type; E : in Elem_Type);
- 
- 
-      --==================================================================--
- 
- 
- -- The implementation of CC51D01_1 is purely artificial; the validity
- -- of its implementation in the context of the abstraction is irrelevant
- -- to the feature being tested.
- --
- -- The expected behavior here is as follows: for each actual type corresponding
- -- to Elem_Type, the call to Update_ID should invoke the actual type's
- -- implementation, which updates the object's SSN field. Write_Element then
- -- adds the object to the list.
- 
- procedure CC51D01_1 (L : in out List_Mgr.List_Type; E : in Elem_Type) is
-    Element : Elem_Type := E;   -- Can't update IN parameter.
- begin
-    Update_ID (Element);                    -- Executes actual type's version.
-    List_Mgr.Write_Element (1, L, Element); -- Executes actual type's version.
- end CC51D01_1;
- 
- 
-      --==================================================================--
- 
- 
- with FC51D00;    -- Generic list abstraction.
- with CC51D01_0;  -- Tagged type declarations.
- with CC51D01_1;  -- Generic operation.
- 
- with Report;
- procedure CC51D01 is
- 
-    use CC51D01_0;                                        -- All types & ops
-                                                          -- directly visible.
- 
-    -- Begin test code declarations: -----------------------
- 
-    TC_Expected_1 : Blind_ID_Type       := (SSN => "111223333");
-    TC_Expected_2 : Named_ID_Type       := ("444556666", "Doe      ");
-    TC_Expected_3 : Ranked_ID_Type      := ("444556666", "Doe      ", 0);
- 
-    TC_Initial_1  : Blind_ID_Type       := (SSN => "777889999");
-    TC_Initial_2  : Named_ID_Type       := ("777889999", "Doe      ");
-    TC_Initial_3  : Ranked_ID_Type      := ("777889999", "Doe      ", 0);
- 
-    -- End test code declarations. -------------------------
- 
- 
-    -- Begin instantiations and list declarations: ---------
- 
-    -- At this point in an application, the generic list package would be
-    -- instantiated for one of the visible tagged types. Next, the generic
-    -- subprogram would be instantiated for the same tagged type and the
-    -- preceding list package instance.
-    --
-    -- In order to cover all the important cases, this test instantiates several
-    -- packages and subprograms (probably more than would typically appear
-    -- in user code).
- 
-    -- Support for lists of blind IDs:
- 
-    package Blind_Lists is new FC51D00 (Blind_ID_Type);
-    procedure Update_and_Write is new CC51D01_1 (Blind_ID_Type, Blind_Lists);
-    Blind_List : Blind_Lists.List_Type;
- 
- 
-    -- Support for lists of named IDs:
- 
-    package Named_Lists is new FC51D00 (Named_ID_Type);
-    procedure Update_and_Write is new                     -- Overloads subprog
-      CC51D01_1 (Elem_Type => Named_ID_Type,              -- for Blind_ID_Type.
-                 List_Mgr  => Named_Lists);
-    Named_List : Named_Lists.List_Type;
- 
- 
-    -- Support for lists of ranked IDs:
- 
-    package Ranked_Lists is new FC51D00 (Ranked_ID_Type);
-    procedure Update_and_Write is new                     -- Overloads.
-      CC51D01_1 (Elem_Type => Ranked_ID_Type,
-                 List_Mgr  => Ranked_Lists);
-    Ranked_List : Ranked_Lists.List_Type;
- 
-    -- End instantiations and list declarations. -----------
- 
- 
- begin
-    Report.Test ("CC51D01", "Formal private extension, specific tagged "   &
-                 "type actual: body of primitive subprogram executed is "  &
-                 "that of actual type. Check for subprograms declared in " &
-                 "a formal package");
- 
- 
-    Update_and_Write (Blind_List, TC_Initial_1);
- 
-    if (Blind_Lists.View_Element (1, Blind_List) /= TC_Expected_1) then
-       Report.Failed ("Wrong result for root tagged type");
-    end if;
- 
- 
-    Update_and_Write (Named_List, TC_Initial_2);
- 
-    if (Named_Lists.View_Element (1, Named_List) /= TC_Expected_2) then
-       Report.Failed ("Wrong result for type derived directly from root");
-    end if;
- 
- 
-    Update_and_Write (Ranked_List, TC_Initial_3);
- 
-    if (Ranked_Lists.View_Element (1, Ranked_List) /= TC_Expected_3) then
-       Report.Failed ("Wrong result for type derived indirectly from root");
-    end if;
- 
- 
-    Report.Result;
- end CC51D01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51d02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51d02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc51d02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc51d02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,244 ****
- -- CC51D02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, in an instance, each implicit declaration of a user-defined
- --      subprogram of a formal private extension declares a view of the
- --      corresponding primitive subprogram of the ancestor, and that if the
- --      tag in a call is statically determined to be that of the formal type,
- --      the body executed will be that corresponding to the actual type.
- --
- --      Check subprograms declared within a generic formal package. Check for
- --      the case where the actual type passed to the formal private extension
- --      is a class-wide type. Check for several types in the same class.
- --
- --
- -- TEST DESCRIPTION:
- --      Declare a list abstraction in a generic package which manages lists of
- --      elements of any nonlimited type (foundation code). Declare a package
- --      which declares a tagged type and a derivative. Declare an operation
- --      for the root tagged type and override it for the derivative. Declare
- --      a generic subprogram which operates on lists of elements of tagged
- --      types. Provide the generic subprogram with two formal parameters: (1)
- --      a formal derived tagged type which represents a list element type, and
- --      (2) a generic formal package with the list abstraction package as
- --      template. Use the formal derived type as the generic formal actual
- --      part for the formal package. Within the generic subprogram, call the
- --      operation of the root tagged type. In the main program, instantiate
- --      the generic list package and the generic subprogram with the class-wide
- --      type for the root tagged type.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC51D00.A
- --      -> CC51D02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      05 Jan 95   SAIC    Changed types of TC_Expected_1 and TC_Expected_2
- --                          from specific to class-wide. Eliminated (illegal)
- --                          assignment step prior to comparison of
- --                          TC_Expected_X with item on stack.
- --
- --!
- 
- package CC51D02_0 is -- This package simulates support for a personnel
-                      -- database.
- 
-    type SSN_Type is new String (1 .. 9);
- 
-    type Blind_ID_Type is tagged record                   -- Root type of
-       SSN : SSN_Type;                                    -- class.
-       -- ... Other components.
-    end record;
- 
-    procedure Update_ID (Item : in out Blind_ID_Type);    -- Parent operation.
- 
-    -- ... Other operations.
- 
- 
-    type Name_Type is new String (1 .. 9);
- 
-    type Named_ID_Type is new Blind_ID_Type with record   -- Direct derivative
-       Name : Name_Type := "Doe      ";                   -- of root type.
-       -- ... Other components.
-    end record;
- 
-    -- Inherits Update_ID from parent.
- 
-    procedure Update_ID (Item : in out Named_ID_Type);    -- Overrides parent's
-                                                          -- implementation.
- 
- end CC51D02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC51D02_0 is
- 
-    -- The implementations of Update_ID are purely artificial; the validity of
-    -- their implementations in the context of the abstraction is irrelevant to
-    -- the feature being tested.
- 
-    procedure Update_ID (Item : in out Blind_ID_Type) is
-    begin
-       Item.SSN := "111223333";
-    end Update_ID;
- 
- 
-    procedure Update_ID (Item : in out Named_ID_Type) is
-    begin
-       Item.SSN := "444556666";
-       -- ... Other stuff.
-    end Update_ID;
- 
- end CC51D02_0;
- 
- 
-      --==================================================================--
- 
- 
- --                           --
- -- Formal package used here. --
- --                           --
- 
- with FC51D00;    -- Generic list abstraction.
- with CC51D02_0;  -- Tagged type declarations.
- generic          -- This procedure simulates a generic operation for types
-                  -- in the class rooted at Blind_ID_Type.
-    type Elem_Type (<>) is new CC51D02_0.Blind_ID_Type with private;
-    with package List_Mgr is new FC51D00 (Elem_Type);
- procedure CC51D02_1 (L : in out List_Mgr.List_Type; E : in Elem_Type);
- 
- 
-      --==================================================================--
- 
- 
- -- The implementation of CC51D02_1 is purely artificial; the validity
- -- of its implementation in the context of the abstraction is irrelevant
- -- to the feature being tested.
- --
- -- The expected behavior here is as follows: for each actual type corresponding
- -- to Elem_Type, the call to Update_ID should invoke the actual type's
- -- implementation (based on the tag of the actual), which updates the object's
- -- SSN field. Write_Element then adds the object to the list.
- 
- procedure CC51D02_1 (L : in out List_Mgr.List_Type; E : in Elem_Type) is
-    Element : Elem_Type := E;   -- Can't update IN parameter.
-                                -- Initialization of unconstrained variable.
- begin
-    Update_ID (Element);                    -- Executes actual type's version
-                                            -- (for this test, this will be a
-                                            -- dispatching call).
-    List_Mgr.Write_Element (1, L, Element); -- Executes actual type's version
-                                            -- (for this test, this will be a
-                                            -- class-wide operation).
- end CC51D02_1;
- 
- 
-      --==================================================================--
- 
- 
- with FC51D00;    -- Generic list abstraction.
- with CC51D02_0;  -- Tagged type declarations.
- with CC51D02_1;  -- Generic operation.
- 
- with Report;
- procedure CC51D02 is
- 
-    use CC51D02_0;                                        -- All types & ops
-                                                          -- directly visible.
- 
-    -- Begin test code declarations: -----------------------
- 
-    TC_Expected_1 : Blind_ID_Type'Class :=
-                    Blind_ID_Type'(SSN => "111223333");
-    TC_Expected_2 : Blind_ID_Type'Class :=
-                    Named_ID_Type'("444556666", "Doe      ");
- 
- 
-    TC_Initial_1  : Blind_ID_Type       := (SSN => "777889999");
-    TC_Initial_2  : Named_ID_Type       := ("777889999", "Doe      ");
-    TC_Initial_3  : Blind_ID_Type'Class := TC_Initial_2;
- 
-    -- End test code declarations. -------------------------
- 
- 
-    package ID_Class_Lists is new FC51D00 (Blind_ID_Type'Class);
- 
-    procedure Update_and_Write is new CC51D02_1 (Blind_ID_Type'Class,
-                                                 ID_Class_Lists);
- 
-    Blind_List  : ID_Class_Lists.List_Type;
-    Named_List  : ID_Class_Lists.List_Type;
-    Maimed_List : ID_Class_Lists.List_Type;
- 
- 
- begin
-    Report.Test ("CC51D02", "Formal private extension, class-wide actual: " &
-                 "body of primitive subprogram executed is that of actual " &
-                 "type. Check for subprograms declared in formal package");
- 
- 
-    Update_and_Write (Blind_List, TC_Initial_1);    -- Test root type actual.
- 
-    if (ID_Class_Lists.View_Element (1, Blind_List) not in Blind_ID_Type) then
-       Report.Failed ("Result for root type actual is not in proper class");
-    elsif (ID_Class_Lists.View_Element (1, Blind_List) /= TC_Expected_1) then
-       Report.Failed ("Wrong result for root type actual");
-    end if;
- 
- 
-    Update_and_Write (Named_List, TC_Initial_2);    -- Test derived type actual.
- 
-    if (ID_Class_Lists.View_Element (1, Named_List) not in Named_ID_Type) then
-       Report.Failed ("Result for derived type actual is not in proper class");
-    elsif (ID_Class_Lists.View_Element (1, Named_List)/= TC_Expected_2) then
-       Report.Failed ("Wrong result for derived type actual");
-    end if;
- 
- 
-    -- In the subtest below, an object of a class-wide type (TC_Initial_3) is
-    -- passed to Update_and_Write. It has been initialized with an object of
-    -- type Named_ID_Type, so the result should be identical to
-    -- that of the Named_ID_Type subtest (namely TC_Expected_2). Note that
-    -- a new list of Named IDs is used (Maimed_List). This is to assure test
-    -- validity, since Named_List has already been updated by a previous
-    -- subtest.
- 
-    Update_and_Write (Maimed_List, TC_Initial_3);   -- Test class-wide actual.
- 
-    if (ID_Class_Lists.View_Element (1, Maimed_List) not in Named_ID_Type) then
-       Report.Failed ("Result for class-wide actual is not in proper class");
-    elsif (ID_Class_Lists.View_Element (1, Maimed_List) /= TC_Expected_2) then
-       Report.Failed ("Wrong result for class-wide actual");
-    end if;
- 
- 
-    Report.Result;
- end CC51D02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- CC54001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a general access-to-constant type may be passed as an
- --      actual to a generic formal access-to-constant type.
- --
- -- TEST DESCRIPTION:
- --      The generic implements a stack of access objects as an array. The
- --      designated type of the formal access type is itself a formal private
- --      type declared in the same generic formal part.
- --      
- --      The generic is instantiated with an unconstrained subtype of String,
- --      which results in a stack which can accommodate strings of varying
- --      lengths (ragged array). Furthermore, the access objects to be pushed
- --      onto the stack are created both statically and dynamically, utilizing
- --      allocators and the 'Access attribute.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
- --                          preceding CC54001_1.
- --
- --!
- 
- generic
-    Size : in Positive;
-    type Element_Type (<>) is private;
-    type Element_Ptr       is access constant Element_Type;
- package CC54001_0 is -- Generic stack of pointers.
- 
-    type Stack_Type is private;
- 
-    procedure Push (Stack    : in out Stack_Type;
-                    Elem_Ptr : in     Element_Ptr);
- 
-    procedure Pop  (Stack    : in out Stack_Type;
-                    Elem_Ptr :    out Element_Ptr);
- 
-    -- ... Other operations.
- 
- private
- 
-    subtype Index is Positive range 1 .. (Size + 1);
-    type Stack_Type is array (Index) of Element_Ptr;  -- Last element unused.
- 
-    Top : Index := 1;
- 
- end CC54001_0;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54001_0 is
- 
-    procedure Push (Stack    : in out Stack_Type;
-                    Elem_Ptr : in     Element_Ptr) is
-    begin
-       Stack(Top) := Elem_Ptr;
-       Top := Top + 1;  -- Artificial: no Constraint_Error protection.
-    end Push;
- 
- 
-    procedure Pop (Stack    : in out Stack_Type;
-                   Elem_Ptr :    out Element_Ptr) is
-    begin
-       Top := Top - 1;  -- Artificial: no Constraint_Error protection.
-       Elem_Ptr := Stack(Top);
-    end Pop;
- 
- end CC54001_0;
- 
- 
-      --===================================================================--
- 
- 
- with CC54001_0;      -- Generic stack of pointers.
- pragma Elaborate (CC54001_0);
- 
- package CC54001_1 is
- 
-    subtype Message     is String;
-    type    Message_Ptr is access constant Message;
- 
-    Message_Count : constant := 4;
- 
-    Message_0 : aliased constant Message := "Hello";
-    Message_1 : aliased constant Message := "Doctor";
-    Message_2 : aliased constant Message := "Name";
-    Message_3 : aliased constant Message := "Continue";
- 
- 
-    package Stack_of_Messages is new CC54001_0
-      (Element_Type => Message,
-       Element_Ptr  => Message_Ptr,
-       Size         => Message_Count);
- 
-    Message_Stack : Stack_Of_Messages.Stack_Type;
- 
- 
-    procedure Create_Message_Stack;
- 
- end CC54001_1;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54001_1 is
- 
-    procedure Create_Message_Stack is
-       -- Push access objects onto stack. Note that some are statically
-       -- allocated, and some are dynamically allocated (using an aliased
-       -- object to initialize).
-    begin
-       Stack_Of_Messages.Push (Message_Stack, Message_0'Access); -- Static.
-       Stack_Of_Messages.Push (Message_Stack,
-                               new Message'(Message_1));         -- Dynamic.
-       Stack_Of_Messages.Push (Message_Stack, Message_2'Access); -- Static.
-       Stack_Of_Messages.Push (Message_Stack,                    -- Dynamic.
-                               new Message'(Message_3));
-    end Create_Message_Stack;
- 
- end CC54001_1;
- 
- 
-      --===================================================================--
- 
- 
- with CC54001_1;
- 
- with Report;
- procedure CC54001 is
- 
-    package Messages renames CC54001_1.Stack_Of_Messages;
- 
-    Msg0, Msg1, Msg2, Msg3 : CC54001_1.Message_Ptr;
- 
- begin
-    Report.Test ("CC54001", "Check that a general access-to-constant type "   &
-                            "may be passed as an actual to a generic formal " &
-                            "access-to-constant type");
- 
-    CC54001_1.Create_Message_Stack;
- 
-    Messages.Pop (CC54001_1.Message_Stack, Msg3);  -- Pop items off stack in the
-    Messages.Pop (CC54001_1.Message_Stack, Msg2);  -- reverse order that they
-    Messages.Pop (CC54001_1.Message_Stack, Msg1);  -- were pushed.
-    Messages.Pop (CC54001_1.Message_Stack, Msg0);
- 
-    if Msg0.all /= CC54001_1.Message_0 or else
-       Msg1.all /= CC54001_1.Message_1 or else
-       Msg2.all /= CC54001_1.Message_2 or else
-       Msg3.all /= CC54001_1.Message_3
-    then
-       Report.Failed ("Items popped off of stack do not match those pushed");
-    end if;
- 
-    Report.Result;
- end CC54001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,223 ****
- -- CC54002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a general access-to-variable type may be passed as an
- --      actual to a generic formal general access-to-variable type. Check that
- --      designated objects may be read and updated through the access value.
- --
- -- TEST DESCRIPTION:
- --      The generic implements a List of access objects as an array, which
- --      is itself a component of a record. The designated type of the formal
- --      access type is a formal private type declared in the same generic
- --      formal part.
- --
- --      The access objects to be placed in the List are created both
- --      statically and dynamically, utilizing allocators and the 'Access
- --      attribute.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
- --                          preceding CC54002_1.
- --
- --!
- 
- generic
-    Size : in Positive;
-    type Element_Type (<>) is private;
-    type Element_Ptr       is access all Element_Type;
- package CC54002_0 is -- Generic list of pointers.
- 
-    subtype Index is Positive range 1 .. (Size + 1);
- 
-    type List_Array is array (Index) of Element_Ptr;
- 
-    type List_Type is record
-       Elements : List_Array;
-       Next     : Index := 1;    -- Next available "slot" in list.
-    end record;
- 
- 
-    procedure Put (List     : in out List_Type;
-                   Elem_Ptr : in     Element_Ptr;
-                   Location : in     Index);
- 
-    procedure Get (List     : in out List_Type;
-                   Elem_Ptr :    out Element_Ptr;
-                   Location : in     Index);
- 
-    -- ... Other operations.
- 
- end CC54002_0;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54002_0 is
- 
-    procedure Put (List     : in out List_Type;
-                   Elem_Ptr : in     Element_Ptr;
-                   Location : in     Index) is
-    begin
-       List.Elements(Location) := Elem_Ptr;
-    end Put;
- 
- 
-    procedure Get (List     : in out List_Type;
-                   Elem_Ptr :    out Element_Ptr;
-                   Location : in     Index) is
-    begin  -- Artificial: no provision for getting "empty" element.
-       Elem_Ptr := List.Elements(Location);
-    end Get;
- 
- end CC54002_0;
- 
- 
-      --===================================================================--
- 
- 
- with CC54002_0;      -- Generic List of pointers.
- pragma Elaborate (CC54002_0);
- 
- package CC54002_1 is
- 
-    subtype Lengths is Natural range 0 .. 50;
- 
-    type Subscriber (NLen, ALen: Lengths := 50) is record
-       Name    : String(1 .. NLen);
-       Address : String(1 .. ALen);
-       -- ... Other components.
-    end record;
- 
-    type Subscriber_Ptr is access all Subscriber;         -- General access-to-
-                                                          -- variable type.
- 
-    package District_Subscription_Lists is new CC54002_0
-      (Element_Type => Subscriber,
-       Element_Ptr  => Subscriber_Ptr,
-       Size         => 100);
- 
-    District_01_Subscribers : District_Subscription_Lists.List_Type;
- 
- 
-    New_Subscriber_01 : aliased CC54002_1.Subscriber :=
-      (12, 23, "Brown, Silas", "King's Pyland, Dartmoor");
- 
-    New_Subscriber_02 : aliased CC54002_1.Subscriber :=
-      (16, 23, "Hatherly, Victor", "16A Victoria St. London");
- 
- end CC54002_1;
- 
- -- No body for CC54002_1.
- 
- 
-      --===================================================================--
- 
- 
- with CC54002_1;
- 
- with Report;
- procedure CC54002 is
- 
-    Mod_Subscriber_01 : constant CC54002_1.Subscriber :=
-      (12, 23, "Brown, Silas", "Mapleton, Dartmoor     ");
- 
-    TC_Actual_01, TC_Actual_02 : CC54002_1.Subscriber_Ptr;
- 
- 
-    use type CC54002_1.Subscriber;  -- "/=" directly visible.
- 
- begin
-    Report.Test ("CC54002", "Check that a general access-to-variable type "   &
-                            "may be passed as an actual to a generic formal " &
-                            "access-to-variable type");
- 
- 
-    -- Add elements to the list:
- 
-    CC54002_1.District_Subscription_Lists.Put    -- Element created statically.
-      (List     => CC54002_1.District_01_Subscribers,
-       Elem_Ptr => CC54002_1.New_Subscriber_01'Access,
-       Location => 1);
- 
-    CC54002_1.District_Subscription_Lists.Put    -- Element created dynamically.
-      (List     => CC54002_1.District_01_Subscribers,
-       Elem_Ptr => new CC54002_1.Subscriber'(CC54002_1.New_Subscriber_02),
-       Location => 2);
- 
- 
-    -- Manipulation of the objects on the list is performed below directly
-    -- through the access objects. Although such manipulation is artificial
-    -- from the perspective of this usage model, it is not artificial in
-    -- general and is necessary in order to test the objective.
- 
- 
-    -- Modify the first list element through the access object:
- 
-    CC54002_1.District_01_Subscribers.Elements(1).Address :=      -- Update
-       "Mapleton, Dartmoor     ";      -- Implicit dereference.   -- through the
-                                                                  -- access
-                                                                  -- object.
-    -- Retrieve elements of the list:
- 
-    CC54002_1.District_Subscription_Lists.Get
-      (CC54002_1.District_01_Subscribers,
-       TC_Actual_01,
-       1);
- 
-    CC54002_1.District_Subscription_Lists.Get
-      (CC54002_1.District_01_Subscribers,
-       TC_Actual_02,
-       2);
- 
-    -- Verify list contents in two ways: 1st verify the directly-dereferenced
-    -- access objects against the dereferenced access objects returned by Get;
-    -- 2nd verify them against objects the expected values:
- 
-                                                                  -- Read
-                                                                  -- through the
-                                                                  -- access
-                                                                  -- objects.
- 
-    if CC54002_1.District_01_Subscribers.Elements(1).all /= TC_Actual_01.all
-       or else
-       CC54002_1.District_01_Subscribers.Elements(2).all /= TC_Actual_02.all
-    then
-       Report.Failed ("Wrong results returned by Get");
-    
-    elsif CC54002_1.District_01_Subscribers.Elements(1).all /=
-            Mod_Subscriber_01
-          or
-          CC54002_1.District_01_Subscribers.Elements(2).all /=
-            CC54002_1.New_Subscriber_02
-    then
-       Report.Failed ("List elements do not have expected values");
-    end if;
- 
-    Report.Result;
- end CC54002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- CC54003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a general access-to-subprogram type may be passed as an
- --      actual to a generic formal access-to-subprogram type. Check that
- --      designated subprograms may be called by dereferencing the access
- --      values.
- --
- -- TEST DESCRIPTION:
- --      The generic implements a stack of access-to-subprogram objects as an
- --      array. The profile of the access-to-subprogram formal corresponds to
- --      a function which accepts a parameter of some type and returns an
- --      object of the same type.
- --      
- --      For this test, the functions for which access values will be pushed
- --      onto the stack accept a parameter of type access-to-string, lengthen
- --      the pointed-to string, then return an access object pointing to this
- --      lengthened string.
- --      
- --      The instance declares a function Execute_Stack which executes each
- --      subprogram on the stack in sequence. This function accepts some initial
- --      access-to-string, then returns an access object pointing to the
- --      lengthened string resulting from the execution of the stacked
- --      subprograms. Access-to-string objects are used rather than strings
- --      themselves because the initial string "grows" during each iteration.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
- --                          preceding CC54003_2.
- --
- --!
- 
- generic
- 
-    Size : in Positive;
- 
-    type Item_Type (<>) is private;
-    type Item_Ptr is access Item_Type;
- 
-    type Function_Ptr is access function (Item : Item_Ptr) 
-      return Item_Ptr;
- 
- package CC54003_0 is -- Generic stack of pointers.
- 
-    type Stack_Type is private;
- 
-    procedure Push (Stack    : in out Stack_Type;
-                    Func_Ptr : in     Function_Ptr);
- 
-    function Execute_Stack (Stack         : Stack_Type;
-                            Initial_Input : Item_Ptr) return Item_Ptr;
- 
-    -- ... Other operations.
- 
- private
- 
-    subtype Index is Positive range 1 .. (Size + 1);
-    type Stack_Type is array (Index) of Function_Ptr;       -- Last slot unused.
- 
-    Top : Index := 1;                  -- Top refers to the next available slot.
- 
- end CC54003_0;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54003_0 is
- 
-    procedure Push (Stack    : in out Stack_Type;
-                    Func_Ptr : in     Function_Ptr) is
-    begin
-       Stack(Top) := Func_Ptr;
-       Top := Top + 1;     -- Artificial: no Constraint_Error protection.
-    end Push;
- 
- 
-    -- Call each subprogram on the stack in sequence. For the first call, pass
-    -- Initial_Input. For succeeding calls, pass the result of the previous
-    -- call.
- 
-    function Execute_Stack (Stack         : Stack_Type;
-                            Initial_Input : Item_Ptr) return Item_Ptr is
-       Result : Item_Ptr := Initial_Input;
-    begin
-       for I in reverse Index'First .. (Top - 1) loop    -- Artificial: no C_E
-          Result := Stack(I)(Result);                    -- protection.
-       end loop;
-       return Result;
-    end Execute_Stack;
- 
- end CC54003_0;
- 
- 
-      --===================================================================--
- 
- 
- package CC54003_1 is
- 
-    subtype Message     is String;
-    type    Message_Ptr is access Message;
- 
-    function Add_Prefix (Msg_Ptr : Message_Ptr) return Message_Ptr;
-    function Add_Suffix (Msg_Ptr : Message_Ptr) return Message_Ptr;
- 
-    -- ...Other operations.
- 
- end CC54003_1;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54003_1 is
- 
-    function Add_Prefix (Msg_Ptr : Message_Ptr) return Message_Ptr is
-       Sender  : constant String := "Dummy: ";    -- Artificial; in a real
-                                                  -- application Sender might
-       New_Msg : Message := Sender & Msg_Ptr.all; -- be a call to a function.
-    begin
-       return new Message'(New_Msg);
-    end Add_Prefix;
- 
- 
-    function Add_Suffix (Msg_Ptr : Message_Ptr) return Message_Ptr is
-       Time : constant String := " (12:03pm)";    -- Artificial; in a real
-                                                  -- application Time might be a
-       New_Msg : Message := Msg_Ptr.all & Time;   -- be a call to a function.
-    begin
-       return new Message'(New_Msg);
-    end Add_Suffix;
- 
- end CC54003_1;
- 
- 
-      --===================================================================--
- 
- 
- with CC54003_0;      -- Generic stack of pointers.
- pragma Elaborate (CC54003_0);
- 
- with CC54003_1;      -- Message abstraction.
- 
- package CC54003_2 is
- 
-    type Operation_Ptr is access function (Msg_Ptr : CC54003_1.Message_Ptr)
-      return CC54003_1.Message_Ptr;
- 
-    Maximum_Ops : constant := 4;         -- Arbitrary.
- 
-    package Stack_of_Ops is new CC54003_0
-      (Item_Type    => CC54003_1.Message,
-       Item_Ptr     => CC54003_1.Message_Ptr,
-       Function_Ptr => Operation_Ptr,
-       Size         => Maximum_Ops);
- 
-    Operation_Stack : Stack_Of_Ops.Stack_Type;
- 
- 
-    procedure Create_Operation_Stack;
- 
- end CC54003_2;
- 
-      --===================================================================--
- 
- 
- package body CC54003_2 is
- 
-    procedure Create_Operation_Stack is
-    begin
-       Stack_Of_Ops.Push (Operation_Stack, CC54003_1.Add_Prefix'Access);
-       Stack_Of_Ops.Push (Operation_Stack, CC54003_1.Add_Suffix'Access);
-    end Create_Operation_Stack;
- 
- end CC54003_2;
- 
- 
-      --===================================================================--
- 
- 
- with CC54003_1;  -- Message abstraction.
- with CC54003_2;  -- Message-operation stack.
- 
- with Report;
- procedure CC54003 is
- 
-    package Msg_Ops renames CC54003_2.Stack_Of_Ops;
- 
-    Msg      : CC54003_1.Message_Ptr := new CC54003_1.Message'("Hello there");
-    Expected : CC54003_1.Message     := "Dummy: Hello there (12:03pm)";
- 
- begin
-    Report.Test ("CC54003", "Check that a general access-to-subprogram type " &
-                            "may be passed as an actual to a generic formal " &
-                            "access-to-subprogram type");
- 
-    CC54003_2.Create_Operation_Stack;
- 
-    declare
-       Actual : CC54003_1.Message_Ptr := 
-         Msg_Ops.Execute_Stack (CC54003_2.Operation_Stack, Msg);
-    begin
-       if Actual.all /= Expected then
-          Report.Failed ("Wrong result from dereferenced subprogram execution");
-       end if;
-    end;
- 
-    Report.Result;
- end CC54003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc54004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc54004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,295 ****
- -- CC54004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the designated type of a generic formal pool-specific
- --      access type may be class-wide. Check that calls to primitive
- --      subprograms in the instance dispatch to the appropriate bodies when
- --      the controlling operand is a dereference of an object of the access-
- --      to-class-wide type.
- --
- -- TEST DESCRIPTION:
- --      A hierarchy of types is declared in two packages. The root type of
- --      the class is declared as abstract in a separate package. It possesses
- --      an abstract primitive subprogram Handle. A concrete type extends the
- --      root type in a second package with a component of an enumeration type.
- --      A second type extends this extension in the same package. Both
- --      derivatives override the root type's primitive subprogram with a
- --      non-abstract subprogram.
- --
- --      The generic implements a heterogeneous stack of access-to-class-wide
- --      objects in the root type's class. A subprogram declared in the
- --      generic calls Handle using dereferences of each of the class-wide
- --      objects on the stack as operand. Each call to Handle should dispatch
- --      to the appropriate body based on the tag of the operand. The
- --      overriding versions of Handle each set the component of the type to
- --      a different value. The value of the component is checked to verify
- --      that the calls dispatched correctly.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
- --                          preceding CC54004_3.
- --
- --!
- 
- package CC54004_0 is
- 
-    -- The types and operations defined here are artificial. The component
-    -- TC_Code is the only component required for testing purposes.
- 
-    type TC_Code_Type is (None, Low, Medium);
- 
-    type Alert is abstract tagged record              -- Abstract type.
-       TC_Code : TC_Code_Type;    -- Testing flag.
-    end record;
- 
-    procedure Handle (A : in out Alert);              -- Non-abstract primitive
-                                                      -- subprogram.
-    -- ...Other operations.
- 
-    type Alert_Ptr is access Alert'Class;             -- Access-to-class-wide
-                                                      -- type.
- end CC54004_0;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54004_0 is
- 
-    procedure Handle (A : in out Alert) is
-    begin
-       A.TC_Code := None;
-    end Handle;
- 
- end CC54004_0;
- 
- 
-      --===================================================================--
- 
- 
- with CC54004_0;
- use  CC54004_0;
- package CC54004_1 is
- 
-    type Low_Alert is new CC54004_0.Alert with record
-       C1 : String (1 .. 5) := "Dummy";
-       -- ...Other components.
-    end record;
- 
-    procedure Handle (A : in out Low_Alert);          -- Overrides parent's
-                                                      -- operations.
-    --...Other operations.
- 
- 
-    type Medium_Alert is new Low_Alert with record
-       C : Integer := 6;
-       -- ...Other components.
-    end record;
- 
-    procedure Handle (A : in out Medium_Alert);       -- Overrides parent's
-                                                      -- operations.
-    --...Other operations.
- 
- end CC54004_1;
- 
- 
-      --===================================================================--
- 
- package body CC54004_1 is
- 
-    procedure Handle (A : in out Low_Alert) is
-    begin
-       A.TC_Code := Low;
-    end Handle;
- 
-    procedure Handle (A : in out Medium_Alert) is
-    begin
-       A.TC_Code := Medium;
-    end Handle;
- 
- end CC54004_1;
- 
- 
-      --===================================================================--
- 
- 
- with CC54004_0;
- generic
-    type Element_Type is abstract new CC54004_0.Alert with private;
-    type Element_Ptr  is access Element_Type'Class;
- package CC54004_2 is
- 
-    type Stack_Type is private;
- 
-    procedure Push (Stack     : in out Stack_Type;
-                    Elem_Ptr  : in     Element_Ptr);
- 
-    procedure Pop  (Stack     : in out Stack_Type;
-                    Elem_Ptr  :    out Element_Ptr);
- 
-    procedure Process_Stack (Stack : in out Stack_Type);
- 
-    -- ... Other operations.
- 
- private
- 
-    subtype Index is Positive range 1 .. 5;
-    type Stack_Type is array (Index) of Element_Ptr;
- 
-    Top : Index := 1;
- 
- end CC54004_2;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54004_2 is
- 
-    procedure Push (Stack    : in out Stack_Type;
-                    Elem_Ptr : in     Element_Ptr) is
-    begin
-       Stack(Top) := Elem_Ptr;
-       Top := Top + 1;     -- Artificial: no Constraint_Error protection.
-    end Push;
- 
- 
-    procedure Pop  (Stack     : in out Stack_Type;
-                    Elem_Ptr  :    out Element_Ptr)is
-    begin
-       Top := Top - 1;     -- Artificial: no Constraint_Error protection.
-       Elem_Ptr := Stack(Top);
-    end Pop;
- 
- 
-    -- Call Handle for each element on the stack. Since the dereferenced access
-    -- object is of a class-wide type, all calls to Handle are dispatching. The
-    -- version of Handle called will be that declared for the type
-    -- corresponding to the tag of the operand.
- 
-    procedure Process_Stack (Stack  : in out Stack_Type) is
-    begin -- Artificial: no Constraint_Error protection.
-       for I in reverse Index'First .. (Top - 1) loop
-          Handle (Stack(I).all);            -- Call dispatches based on
-       end loop;                            -- tag of operand.
-    end Process_Stack;
- 
- end CC54004_2;
- 
- 
-      --===================================================================--
- 
- 
- with CC54004_0;
- with CC54004_1;
- with CC54004_2;
- pragma Elaborate (CC54004_2);
- 
- package CC54004_3 is
- 
-    package Alert_Stacks is new CC54004_2 (Element_Type => CC54004_0.Alert,
-                                           Element_Ptr  => CC54004_0.Alert_Ptr);
- 
-    -- All overriding versions of Handle visible at the point of instantiation.
- 
-    Alert_List  : Alert_Stacks.Stack_Type;
- 
-    procedure TC_Create_Alert_Stack;
- 
- end CC54004_3;
- 
- 
-      --===================================================================--
- 
- 
- package body CC54004_3 is
- 
-    procedure TC_Create_Alert_Stack is
-    begin
-       Alert_Stacks.Push (Alert_List, new CC54004_1.Low_Alert);
-       Alert_Stacks.Push (Alert_List, new CC54004_1.Medium_Alert);
-    end TC_Create_Alert_Stack;
- 
- end CC54004_3;
- 
- 
-      --===================================================================--
- 
- 
- with CC54004_0;
- with CC54004_1;
- with CC54004_3;
- 
- with Report;
- procedure CC54004 is
-    TC_Low_Ptr, TC_Med_Ptr : CC54004_0.Alert_Ptr;
-    TC_Low_Actual          : CC54004_1.Low_Alert;
-    TC_Med_Actual          : CC54004_1.Medium_Alert;
- 
-    use type CC54004_0.TC_Code_Type;
- begin
-    Report.Test ("CC54004", "Check that the designated type of a generic " &
-                 "formal pool-specific access type may be class-wide");
- 
- 
-    -- Create stack of elements:
- 
-    CC54004_3.TC_Create_Alert_Stack;
- 
- 
-    -- Commence dispatching operations on stack elements:
- 
-    CC54004_3.Alert_Stacks.Process_Stack (CC54004_3.Alert_List);
- 
- 
-    -- Pop "handled" alerts off stack:
- 
-    CC54004_3.Alert_Stacks.Pop (CC54004_3.Alert_List, TC_Med_Ptr);
-    CC54004_3.Alert_Stacks.Pop (CC54004_3.Alert_List, TC_Low_Ptr);
- 
- 
-    -- Verify results:
- 
-    if TC_Low_Ptr.all not in CC54004_1.Low_Alert    or else
-       TC_Med_Ptr.all not in CC54004_1.Medium_Alert
-    then
-       Report.Failed ("Class-wide objects do not have expected tags");
- 
-    -- The explicit dereference of the "Pop"ed pointers results in views of
-    -- the designated objects, the nominal subtypes of which are class-wide.
-    -- In order to be able to reference the component TC_Code, these views
-    -- must be converted to a specific type possessing that component.
- 
-    elsif CC54004_1.Low_Alert(TC_Low_Ptr.all).TC_Code    /= CC54004_0.Low    or
-          CC54004_1.Medium_Alert(TC_Med_Ptr.all).TC_Code /= CC54004_0.Medium
-    then
-       Report.Failed ("Calls did not dispatch to expected operations");
-    end if;
- 
-    Report.Result;
- end CC54004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,309 ****
- -- CC70001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the template for a generic formal package may be a child
- --      package, and that a child instance which is an instance of the
- --      template may be passed as an actual to the formal package. Check that
- --      the visible part of the generic formal package includes the first list
- --      of basic declarative items of the package specification.
- --
- -- TEST DESCRIPTION:
- --      Declare a list abstraction in a generic package which manages lists of
- --      elements of any nonlimited type. Declare a generic child package of
- --      this package which defines additional list operations. Declare a
- --      generic subprogram which operates on lists of elements of discrete
- --      types. Provide the generic subprogram with three formal parameters:
- --      (1) a formal discrete type which represents a list element type, (2)
- --      a generic formal package with the parent list generic as template, and
- --      (3) a generic formal package with the child list generic as template.
- --      Use the formal discrete type as the generic formal actual part for the
- --      parent formal package. In the main program, declare an instance of
- --      parent, then declare an instance of the child which is itself a child
- --      the parent's instance. Pass these instances as actuals to the generic
- --      subprogram instance.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected syntax of formal
- --                          package declaration.
- --      27 Feb 97   PWB.CTA Added an elaboration pragma.
- --!
- 
- generic             
-    type Element_Type is private;  -- List elems may be of any nonlimited type.
- package CC70001_0 is              -- List abstraction.
- 
-    type List_Type is limited private;
- 
- 
-    -- Return true if current element is last in the list.
-    function End_Of_List (L : List_Type) return Boolean;
- 
-    -- Set "current" pointer to first list element.
-    procedure Reset (L : in out List_Type);
- 
- private
- 
-    type Node_Type;
-    type Node_Pointer is access Node_Type;
- 
-    type Node_Type is record
-       Item : Element_Type;
-       Next : Node_Pointer;
-    end record;
- 
-    type List_Type is record
-       First   : Node_Pointer;
-       Current : Node_Pointer;
-       Last    : Node_Pointer;
-    end record;
- 
- end CC70001_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70001_0 is
- 
-    function End_Of_List (L : List_Type) return Boolean is
-    begin
-       return (L.Current = null);
-    end End_Of_List;
- 
- 
-    procedure Reset (L : in out List_Type) is
-    begin
-       L.Current := L.First;                 -- Set "current" pointer to first
-    end Reset;                               -- list element.
- 
- end CC70001_0;
- 
- 
-      --==================================================================--
- 
- 
- -- Child must be generic since parent is generic. A formal parameter for
- -- "element type" can not be provided here, because then the type of list
- -- element assumed by these new operations would be different from that
- -- defined by the list type declared in the parent.
- 
- generic             
- package CC70001_0.CC70001_1 is    -- Additional list operations.
- 
-    -- Read from current element and advance "current" pointer.
-    procedure Read_Element (L : in out List_Type; E : out Element_Type);
- 
-    -- Write to current element and advance "current" pointer.
-    procedure Write_Element (L : in out List_Type; E : in Element_Type);
- 
-    -- Add element to end of list.
-    procedure Add_Element (L : in out List_Type; E : in Element_Type);
- 
- end CC70001_0.CC70001_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70001_0.CC70001_1 is
- 
-    procedure Read_Element (L : in out List_Type; E : out Element_Type) is
-    begin
-       -- ... Error-checking code omitted for brevity.
-       E         := L.Current.Item;       -- Retrieve current element.
-       L.Current := L.Current.Next;       -- Advance "current" pointer.
-    end Read_Element;
- 
- 
-    procedure Write_Element (L : in out List_Type; E : in Element_Type) is
-    begin
-       -- ... Error-checking code omitted for brevity.
-       L.Current.Item := E;               -- Write to current element.
-       L.Current      := L.Current.Next;  -- Advance "current" pointer.
-    end Write_Element;
- 
- 
-    procedure Add_Element (L : in out List_Type; E : in Element_Type) is
-       New_Node : Node_Pointer := new Node_Type'(E, null); 
-    begin
-       if L.First = null then             -- No elements in list, so add new
-          L.First := New_Node;            -- element at beginning of list.
-       else
-          L.Last.Next := New_Node;        -- Add new element at end of list.
-       end if;
-       L.Last := New_Node;                -- Set last-in-list pointer.
-    end Add_Element;
- 
- end CC70001_0.CC70001_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC70001_0.CC70001_1;  -- Generic list abstraction + additional operations.
- generic
- 
-    -- Import the list abstraction defined in CC70001_0, as well as the
-    -- additional operations defined in CC70001_0.CC70001_1. Declare a formal
-    -- discrete type. Restrict this generic procedure to operate only on lists
-    -- of discrete elements by passing the formal discrete type as an actual
-    -- parameter to the formal (parent) package.
- 
-    type Elem_Type is (<>);                  -- Discrete types only.
-    with package List_Mgr is new CC70001_0 (Elem_Type);
-    with package List_Ops is new List_Mgr.CC70001_1 (<>);
- 
- procedure CC70001_2 (L : in out List_Mgr.List_Type);
- 
- 
-      --==================================================================--
- 
- 
- procedure CC70001_2 (L : in out List_Mgr.List_Type) is
- begin
-    List_Mgr.Reset (L);
-    while not List_Mgr.End_Of_List (L) loop
-       List_Ops.Write_Element (L, Elem_Type'First);
-    end loop;
- end CC70001_2;
- 
- 
-      --==================================================================--
- 
- 
- package CC70001_3 is
- 
-    type Points is range 0 .. 10;
- 
-    -- ... Various other types used by the application.
- 
- end CC70001_3;
- 
- 
- -- No body for CC70001_3;
- 
- 
-      --==================================================================--
- 
- 
- -- Declare instances of the generic list packages for the discrete type.
- -- In order to establish that the type passed as an actual to the parent
- -- generic (CC70001_0) is the one utilized by the child generic (CC70001_1),
- -- the instance of the child must itself be declared as a child of the
- -- instance of the parent. Since only library units may have or be children,
- -- both instances must be library units.
- 
- with CC70001_0;            -- Generic list abstraction.
- with CC70001_3;            -- Package containing discrete type declaration.
- pragma Elaborate (CC70001_0);
- package CC70001_4 is new CC70001_0 (CC70001_3.Points);
- 
- with CC70001_0.CC70001_1;  -- Generic extension to list abstraction.
- with CC70001_4;
- package CC70001_4.CC70001_5 is new CC70001_4.CC70001_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC70001_2;            -- Generic "zeroing" op for lists of discrete types.
- with CC70001_3;            -- Types for application.
- with CC70001_4.CC70001_5;  -- Discrete list abstraction + additional ops.
- 
- with Report;
- procedure CC70001 is
- 
-    package Lists_Of_Scores renames CC70001_4;
-    package Score_Ops       renames CC70001_4.CC70001_5;
- 
-    Scores : Lists_Of_Scores.List_Type;                -- List of points.
- 
-    procedure Reset_All_Scores is new CC70001_2        -- Operation on lists of
-      (Elem_Type => CC70001_3.Points,                  -- points.
-       List_Mgr  => Lists_Of_Scores,
-       List_Ops  => Score_Ops);
- 
- 
-    -- Begin test code declarations: -----------------------
- 
-    type TC_Score_Array is array (1 .. 3) of CC70001_3.Points;
- 
-    TC_Initial_Values : constant TC_Score_Array := (2, 4, 6);
-    TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
- 
-    TC_Correct_Initial_Values : Boolean := False;
-    TC_Correct_Final_Values   : Boolean := False;
- 
- 
-    procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
-    begin                                  -- Initial list contains 3 scores
-       for I in TC_Score_Array'Range loop  -- with the values 2, 4, and 6.
-          Score_Ops.Add_Element (L, TC_Initial_Values(I));
-       end loop;
-    end TC_Initialize_List;
- 
- 
-    procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
-                              Expected : in     TC_Score_Array;
-                              OK       :    out Boolean) is
-       Actual : TC_Score_Array;
-    begin                                  -- Verify that all scores have been
-       Lists_of_Scores.Reset (L);          -- set to zero.
-       for I in TC_Score_Array'Range loop
-          Score_Ops.Read_Element (L, Actual(I));
-       end loop;
-       OK := (Actual = Expected);
-    end TC_Verify_List;
- 
-    -- End test code declarations. -------------------------
- 
- 
- begin
-    Report.Test ("CC70001", "Check that the template for a generic formal "   &
-                 "package may be a child package, and that a child instance " &
-                 "which is an instance of the template may be passed as an "  &
-                 "actual to the formal package. Check that the visible part " &
-                 "of the generic formal package includes the first list of "  &
-                 "basic declarative items of the package specification");
- 
-    TC_Initialize_List (Scores);
-    TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
- 
-    if not TC_Correct_Initial_Values then
-       Report.Failed ("List contains incorrect initial values");
-    end if;
- 
-    Reset_All_Scores (Scores);
-    TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
- 
-    if not TC_Correct_Final_Values then
-       Report.Failed ("List contains incorrect final values");
-    end if;
- 
-    Report.Result;
- end CC70001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,241 ****
- -- CC70002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a formal package actual part may specify actual parameters
- --      for a generic formal package. Check that these actual parameters may
- --      be formal types, formal objects, and formal subprograms. Check that
- --      the visible part of the generic formal package includes the first list
- --      of basic declarative items of the package specification, and that if
- --      the formal package actual part is (<>), it also includes the generic
- --      formal part of the template for the formal package.
- --
- -- TEST DESCRIPTION:
- --      Declare a generic package which defines a "signature" for mathematical
- --      groups. Declare a second generic package which defines a
- --      two-dimensional matrix abstraction. Declare a third generic package
- --      which provides mathematical group operations for two-dimensional
- --      matrices. Provide this third generic with two formal parameters: (1)
- --      a generic formal package with the second generic as template and a
- --      (<>) actual part, and (2) a generic formal package with the first
- --      generic as template and an actual part that takes a formal type,
- --      object, and subprogram from the first formal package as actuals.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic              -- Mathematical group signature.
- 
-    type Group_Type is private;
- 
-    Identity : in Group_Type;
- 
-    with function Operation (Left, Right : Group_Type) return Group_Type;
- -- with function Inverse... (omitted for brevity).
- 
- package CC70002_0 is
- 
-    function Power (Left : Group_Type; Right : Integer) return Group_Type;
- 
-    -- ... Other group operations.
- 
- end CC70002_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70002_0 is
- 
-    -- The implementation of Power is purely artificial; the validity of its
-    -- implementation in the context of the abstraction is irrelevant to the
-    -- feature being tested.
- 
-    function Power (Left : Group_Type; Right : Integer) return Group_Type is
-       Result : Group_Type := Identity;
-    begin
-       Result := Operation (Result, Left);  -- All this really does is add
-       return Result;                       -- one to each matrix element.
-    end Power;
- 
- end CC70002_0;
- 
- 
-      --==================================================================--
- 
- 
- generic          -- 2D matrix abstraction.
-    type Element_Type is range <>;
- 
-    type Abscissa is range <>;
-    type Ordinate is range <>;
- 
-    type Matrix_2D is array (Abscissa, Ordinate) of Element_Type;
- package CC70002_1 is
- 
-    Add_Ident : constant Matrix_2D := (Abscissa => (others => 1));
-                                                           -- Artificial for
-                                                           -- testing purposes.
-    -- ... Other identity matrices.
- 
- 
-    function "+" (A, B : Matrix_2D) return Matrix_2D;
- 
-    -- ... Other operations.
- 
- end CC70002_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70002_1 is
- 
-    function "+" (A, B : Matrix_2D) return Matrix_2D is
-       C : Matrix_2D;
-    begin
-       for I in Abscissa loop
-          for J in Ordinate loop
-             C(I,J) := A(I,J) + B(I,J);
-          end loop;
-       end loop;
-       return C;
-    end "+";
- 
- end CC70002_1;
- 
- 
-      --==================================================================--
- 
- 
- with CC70002_0;  -- Mathematical group signature.
- with CC70002_1;  -- 2D matrix abstraction.
- 
- generic          -- Mathematical 2D matrix addition group.
- 
-    with package Matrix_Ops is new CC70002_1 (<>);
- 
-    -- Although the restriction of the formal package below to signatures
-    -- describing addition groups, and then only for 2D matrices, is rather
-    -- artificial in the context of this "application," the passing of types,
-    -- objects, and subprograms as actuals to a formal package is not.
- 
-    with package Math_Sig is new CC70002_0
-      (Group_Type => Matrix_Ops.Matrix_2D,
-       Identity   => Matrix_Ops.Add_Ident,
-       Operation  => Matrix_Ops."+");
- 
- package CC70002_2 is
- 
-    -- Add two matrices that are to be multiplied by coefficients:
-    -- [ ] = CA*[ ] + CB*[ ].
- 
-    function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
-                                             CA : Integer;
-                                             B  : Matrix_Ops.Matrix_2D;
-                                             CB : Integer)
-      return Matrix_Ops.Matrix_2D;
- 
-    -- ...Other operations.
- 
- end CC70002_2;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70002_2 is
- 
-    function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
-                                             CA : Integer;
-                                             B  : Matrix_Ops.Matrix_2D;
-                                             CB : Integer)
-      return Matrix_Ops.Matrix_2D is
-       Left, Right : Matrix_Ops.Matrix_2D;
-    begin
-       Left  := Math_Sig.Power (A, CA);      -- Multiply 1st array by its coeff.
-       Right := Math_Sig.Power (B, CB);      -- Multiply 2nd array by its coeff.
-       return (Matrix_Ops."+" (Left, Right));-- Add these two arrays.
-    end Add_Matrices_With_Coefficients;
- 
- end CC70002_2;
- 
- 
-      --==================================================================--
- 
- 
- with CC70002_0;  -- Mathematical group signature.
- with CC70002_1;  -- 2D matrix abstraction.
- with CC70002_2;  -- Mathematical 2D matrix addition group.
- 
- with Report;
- procedure CC70002 is
- 
-    subtype Cell_Type     is Positive range 1 .. 3;
-    subtype Category_Type is Positive range 1 .. 2;
- 
-    type Data_Points is new Natural range 0 .. 100;
- 
-    type Table_Type is array (Cell_Type, Category_Type) of Data_Points;
- 
-    package Data_Table_Support is new CC70002_1 (Data_Points,
-                                                 Cell_Type,
-                                                 Category_Type,
-                                                 Table_Type);
- 
-    package Data_Table_Addition_Group is new CC70002_0
-      (Group_Type => Table_Type,
-       Identity   => Data_Table_Support.Add_Ident,
-       Operation  => Data_Table_Support."+");
- 
-    package Table_Add_Ops is new CC70002_2
-      (Data_Table_Support, Data_Table_Addition_Group);
- 
- 
-    Scores_Table : Table_Type := ( (  12,   0),
-                                   (  21,  33),
-                                   (  49,   9) );
-    Expected     : Table_Type := ( (  26,   2),
-                                   (  44,  68),
-                                   ( 100,  20) );
- 
- begin
-    Report.Test ("CC70002", "Check that a generic formal package actual " &
-                 "part may specify formal objects, formal subprograms, " &
-                 "and formal types");
- 
-    Scores_Table := Table_Add_Ops.Add_Matrices_With_Coefficients
-                      (Scores_Table, 2,
-                       Scores_Table, 1);
- 
-    if (Scores_Table /= Expected) then
-       Report.Failed ("Incorrect result for multi-dimensional array");
-    end if;
- 
-    Report.Result;
- end CC70002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,212 ****
- -- CC70003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the actual passed to a formal package may be a formal
- --      access-to-subprogram type. Check that the visible part of the generic
- --      formal package includes the first list of basic declarative items of
- --      the package specification.
- --
- -- TEST DESCRIPTION:
- --      Declare a list abstraction in a generic package which manages lists of
- --      elements of any nonlimited type (foundation code). Declare a generic
- --      package which supports the execution of lists of operations. Provide
- --      the generic package with two formal parameters: (1) a formal access-
- --      to-function type, and (2) a generic formal package with the list
- --      abstraction package as template. Within a procedure declared in the
- --      list-execution package, utilize information about the profile of
- --      the functions in the list. Declare a package which declares functions
- --      matching the profile of the formal access-to-subprogram type. In the
- --      main program, create a list of pointers to the functions declared in
- --      the package, instantiate the list abstraction and list-execution
- --      packages, and use the list-execution procedure to call each of the
- --      functions in the list in sequence.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic
-    type Element_Type is private;
- package CC70003_0 is  -- This package simulates a generic list abstraction.
- 
-    -- The definition of List_Type below is purely artificial; its validity
-    -- in the context of the abstraction is irrelevant to the feature being
-    -- tested.
- 
-    type Element_Ptr is access Element_Type;
- 
-    subtype List_Size is Natural range 1 .. 2;
-    type List_Type is array (List_Size) of Element_Ptr;
- 
-    function  View_Element (I : List_Size; L : List_Type) return Element_Type;
- 
-    procedure Write_Element (I : in     List_Size;
-                             L : in out List_Type;
-                             E : in     Element_Type);
- 
-    -- ... Other list operations for Element_Type.
- 
- end CC70003_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70003_0 is
- 
-    -- The implementations of the operations below are purely artificial; the
-    -- validity of their implementations in the context of the abstraction is
-    -- irrelevant to the feature being tested.
- 
-    function View_Element (I : List_Size; L : List_Type) return Element_Type is
-    begin
-       return L(I).all;
-    end View_Element;
- 
- 
-    procedure Write_Element (I : in     List_Size;
-                             L : in out List_Type;
-                             E : in     Element_Type) is
-    begin
-       L(I) := new Element_Type'(E);
-    end Write_Element;
- 
- end CC70003_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC70003_0;    -- Generic list abstraction.
- generic
-    type Elem_Type is access function (F : Float) return Float;
-    with package List_Mgr is new CC70003_0 (Elem_Type);
- package CC70003_1 is  -- This package simulates support for executing lists
-                       -- of operations.
- 
-    procedure Execute_List (L : List_Mgr.List_Type; F : in out Float);
- 
-    -- ... Other operations.
- 
- end CC70003_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70003_1 is
- 
-    procedure Execute_List (L : List_Mgr.List_Type; F : in out Float) is
-    begin
-       for I in L'Range loop
-          F := List_Mgr.View_Element(I, L)(F);   -- Execute next operation in
-       end loop;                                 -- list with current value of
-    end Execute_List;                            -- F as operand.
- 
- 
- end CC70003_1;
- 
- 
-      --==================================================================--
- 
- 
- package CC70003_2 is
- 
-    function Sine (F : Float) return Float;
-    function Exp  (F : Float) return Float;
- 
-    -- ... Other math functions.
- 
- end CC70003_2;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70003_2 is
- 
-    -- The implementations of the functions below are purely artificial; the
-    -- validity of their implementations in the context of the abstraction is
-    -- irrelevant to the feature being tested.
- 
-    function Sine (F : Float) return Float is
-    begin
-       return (-0.15);
-    end Sine;
- 
-    function Exp (F : Float) return Float is
-    begin
-       if (F = 0.0) then
-          return (-0.69);
-       else
-          return (2.0);  -- This branch should be taken.
-       end if;
-    end Exp;
- 
- end CC70003_2;
- 
- 
-      --==================================================================--
- 
- 
- with CC70003_0;    -- Generic list abstraction.
- with CC70003_1;  -- Generic operation-list abstraction.
- with CC70003_2;  -- Math library.
- 
- with Report;
- procedure CC70003 is
- 
-    type Math_Op is access function (F : Float) return Float;
- 
-    package Math_Op_Lists        is new CC70003_0 (Math_Op);
-    package Math_Op_List_Support is new CC70003_1 (Math_Op, Math_Op_Lists);
- 
-    Sin_Ptr : Math_Op := CC70003_2.Sine'Access;
-    Exp_Ptr : Math_Op := CC70003_2.Exp'Access;
- 
-    Op_List : Math_Op_Lists.List_Type;
- 
-    Operand  : Float := 0.0;
-    Expected : Float := 2.0;
- 
- 
- begin
-    Report.Test ("CC70003", "Check that the actual passed to a formal " &
-                 "package may be a formal access-to-subprogram type");
- 
-    Math_Op_Lists.Write_Element (1, Op_List, Sin_Ptr);
-    Math_Op_Lists.Write_Element (2, Op_List, Exp_Ptr);
- 
-    Math_Op_List_Support.Execute_List (Op_List, Operand);
- 
-    if (Operand /= Expected) then
-       Report.Failed ("Incorrect results from indirect function calls");
-    end if;
- 
-    Report.Result;
- end CC70003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,208 ****
- -- CC70A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the visible part of a generic formal package includes the
- --      first list of basic declarative items of the package specification.
- --      Check for a generic package which declares a formal package with (<>)
- --      as its actual part.
- --
- -- TEST DESCRIPTION:
- --      The "first list of basic declarative items" of a package specification
- --      is the visible part of the package. Thus, the declarations in the
- --      visible part of the actual instance corresponding to a formal
- --      package are available in the generic which declares the formal package.
- --       
- --      Declare a generic package which simulates a complex integer abstraction
- --      (foundation code).
- --
- --      Declare a second, library-level generic package which utilizes the
- --      first generic package as a generic formal package (with a (<>)
- --      actual_part). In the second generic package, declare objects, types,
- --      and operations in terms of the objects, types, and operations declared
- --      in the first generic package.
- --
- --      In the main program, instantiate the first generic package, then
- --      instantiate the second generic package and pass the first instance
- --      to it as a generic actual parameter. Check that the operations in
- --      the second instance perform as expected.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FC70A00;         -- Generic complex integer operations.
- 
- generic               -- Generic complex matrix operations.
-    with package Complex_Package is new FC70A00 (<>);
- package CC70A01_0 is
- 
-    type Complex_Matrix_Type is                        -- 1st index is matrix
-       array (Positive range <>, Positive range <>)    -- row, 2nd is column.
-         of Complex_Package.Complex_Type;              
-    Dimension_Mismatch : exception;
- 
- 
-    function Identity_Matrix (Size : Positive)         -- Create identity matrix
-      return Complex_Matrix_Type;                      -- of specified size.
- 
-    function "*" (Left  : Complex_Matrix_Type;         -- Multiply two complex
-                  Right : Complex_Matrix_Type)         -- matrices.
-      return Complex_Matrix_Type;
- 
- end CC70A01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70A01_0 is  -- Generic complex matrix operations.
- 
-    use Complex_Package;
- 
-                --==============================================--
- 
-    function Inner_Product (Left, Right : Complex_Matrix_Type;
-                            Row, Column : Positive)    -- Compute inner product
-      return Complex_Package.Complex_Type is           -- for matrix-multiply.
- 
-       Result : Complex_Type := Zero;                  
-       subtype Vector_Size is Positive range Left'Range(2);
- 
-    begin  -- Inner_Product.
-       for I in Vector_Size loop
-          Result := Result +                           -- Complex_Package."+".
-                    (Left(Row, I) * Right(I, Column)); -- Complex_Package."*".
-       end loop;
-       return (Result);
-    end Inner_Product;
- 
-                --==============================================--
- 
-    function Identity_Matrix (Size : Positive) return Complex_Matrix_Type is
-       Result : Complex_Matrix_Type (1 .. Size, 1 .. Size) :=
-                (others => (others => Zero));          -- Zeroes everywhere...
-    begin
-       for I in 1 .. Size loop
-          Result (I, I) := One;                        -- Ones on the diagonal.
-       end loop;
-       return (Result);
-    end Identity_Matrix;
- 
-                --==============================================--
- 
-    function "*" (Left  : Complex_Matrix_Type; Right : Complex_Matrix_Type)
-      return Complex_Matrix_Type is
- 
-       subtype Rows    is Positive range Left'Range(1);
-       subtype Columns is Positive range Right'Range(2);
- 
-       Result : Complex_Matrix_Type(Rows, Columns);
-    begin
-       if Left'Length(2) /= Right'Length(1) then       -- # columns of Left must
-                                                       -- match # rows of Right.
-          raise Dimension_Mismatch;                    
-       else
-          for I in Rows loop
-             for J in Columns loop
-                 Result(I, J) := Inner_Product (Left, Right, I, J);
-             end loop;
-          end loop;
-          return (Result);
-       end if;
-    end "*";
- 
- end CC70A01_0;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with FC70A00;    -- Generic complex integer operations.
- with CC70A01_0;  -- Generic complex matrix operations.
- 
- procedure CC70A01 is
- 
-    type My_Integer is range -100 .. 100;
- 
-    package My_Complex_Package is new FC70A00   (My_Integer);
-    package My_Matrix_Package  is new CC70A01_0 (My_Complex_Package);
- 
-    use My_Complex_Package,                                -- All user-defined
-        My_Matrix_Package;                                 -- operators directly
-                                                           -- visible.
- 
-    subtype Matrix_2x2 is Complex_Matrix_Type (1 .. 2, 1 .. 2);
-    subtype Matrix_2x3 is Complex_Matrix_Type (1 .. 2, 1 .. 3);
- 
-    function C (Real, Imag : My_Integer) return Complex_Type renames Complex;
- 
- begin  -- Main program.
- 
-    Report.Test ("CC70A01", "Check that the visible part of a generic " &
-                 "formal package includes the first list of basic " &
-                 "declarative items of the package specification. Check " &
-                 "for a generic package where formal package has (<>) " &
-                 "actual part");
- 
-    declare
-       Identity_2x2 : Matrix_2x2 := Identity_Matrix (Size => 2);
-       Operand_2x3  : Matrix_2x3 := ( ( C(1, 2), C(3, 6), C(5, 1) ),
-                                      ( C(0, 3), C(7, 9), C(3, 4) ) );
-       Result_2x3   : Matrix_2x3 := ( others => ( others => Zero ) );
-    begin
- 
-       begin -- Block #1.
-          Result_2x3 := Identity_2x2 * Operand_2x3; -- Should return
-                                                    -- Operand_2x3.
-          if (Result_2x3 /= Operand_2x3) then
-             Report.Failed ("Incorrect results from matrix multiplication");
-          end if;
-       exception
-          when others =>
-             Report.Failed ("Unexpected exception raised - Block #1");
-       end;  -- Block #1.
- 
- 
-       begin -- Block #2.
-          Result_2x3 := Operand_2x3 * Identity_2x2;  -- Can't multiply 2x3
-                                                     -- by 2x2.
-          Report.Failed ("Exception Dimension_Mismatch not raised");
-       exception
-          when Dimension_Mismatch =>
-             null;
-          when others             =>
-             Report.Failed ("Unexpected exception raised - Block #2");
-       end;  -- Block #2.
- 
-    end;
- 
-    Report.Result;
- 
- end CC70A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,193 ****
- -- CC70A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the visible part of a generic formal package includes the
- --      first list of basic declarative items of the package specification.
- --      Check for a generic subprogram which declares a formal package with
- --      (<>) as its actual part.
- --
- -- TEST DESCRIPTION:
- --      The "first list of basic declarative items" of a package specification
- --      is the visible part of the package. Thus, the declarations in the
- --      visible part of the actual instance corresponding to a formal
- --      package are available in the generic which declares the formal package.
- --       
- --      Declare a generic package which simulates a complex integer abstraction
- --      (foundation code).
- --
- --      Declare a second generic package which defines a "signature" for
- --      mathematical groups. Declare a generic function within a package
- --      which utilizes the second generic package as a generic formal package
- --      (with a (<>) actual_part).
- --
- --      In the main program, instantiate the first generic package, then
- --      instantiate the second generic package with objects, types, and
- --      operations declared in the first instance.
- --
- --      Instantiate the generic function and pass the second instance
- --      to it as a generic actual parameter. Check that the instance of the
- --      generic function performs as expected.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic               -- Mathematical group signature.
- 
-    type Group_Type is private;
- 
-    Identity : in Group_Type;
- 
-    with function Operation (Left, Right : Group_Type) return Group_Type;
-    with function Inverse   (Right : Group_Type)       return Group_Type;
- 
- package CC70A02_0 is end;
- 
- -- No body for CC70A02_0.
- 
- 
-      --==================================================================--
- 
- 
- with CC70A02_0;       -- Mathematical group signature.
- 
- package CC70A02_1 is  -- Mathematical group operations.
- 
-    --                                  --
-    -- Generic formal package used here --
-    --                                  --
- 
-    generic            -- Powers for mathematical groups.
-       with package Group is new CC70A02_0 (<>);
-    function Power (Left : Group.Group_Type; Right : Integer)
-      return Group.Group_Type;
- 
- 
- end CC70A02_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70A02_1 is  -- Mathematical group operations.
- 
- 
- 
-    function Power (Left : Group.Group_Type; Right : Integer)
-      return Group.Group_Type is
-       Result : Group.Group_Type := Group.Identity;
-    begin
-       for I in 1 .. abs(Right) loop                 -- Repeat group operations
-          Result := Group.Operation (Result, Left);  -- the specified number of
-       end loop;                                     -- times.
- 
-       if Right < 0 then                             -- If specified power is
-          return Group.Inverse (Result);             -- negative, return the
-       else                                          -- inverse of the result.
-          return Result;                             -- If it is zero, return
-       end if;                                       -- the identity.
-    end Power;
- 
- 
- end CC70A02_1;
- 
- 
-      --==================================================================--
- 
- 
- with Report;
- 
- with FC70A00;    -- Complex integer abstraction.
- with CC70A02_0;  -- Mathematical group signature.
- with CC70A02_1;  -- Mathematical group operations.
- 
- procedure CC70A02 is
- 
-    -- Declare an instance of complex integers:
- 
-    type My_Integer is range -100 .. 100;
-    package Complex_Integers is new FC70A00 (My_Integer);
- 
- 
-    -- Define an addition group for complex integers:
- 
-    package Complex_Addition_Group is new CC70A02_0
-      (Group_Type => Complex_Integers.Complex_Type,  -- For complex integers...
-       Identity   => Complex_Integers.Zero,          -- Additive identity.
-       Operation  => Complex_Integers."+",           -- Additive operation.
-       Inverse    => Complex_Integers."-");          -- Additive inverse.
- 
-    function Complex_Multiplication is new           -- Multiplication of a
-      CC70A02_1.Power(Complex_Addition_Group);       -- complex integer by a
-                                                     -- constant.
- 
- 
-    -- Define a multiplication group for complex integers:
- 
-    package Complex_Multiplication_Group is new CC70A02_0
-      (Group_Type => Complex_Integers.Complex_Type,  -- For complex integers...
-       Identity   => Complex_Integers.One,           -- Multiplicative identity.
-       Operation  => Complex_Integers."*",           -- Multiplicative oper.
-       Inverse    => Complex_Integers.Reciprocal);   -- Multiplicative inverse.
- 
-    function Complex_Exponentiation is new           -- Exponentiation of a
-      CC70A02_1.Power(Complex_Multiplication_Group); -- complex integer by a
-                                                     -- constant.
- 
-    use Complex_Integers;
- 
- 
- begin  -- Main program.
- 
-    Report.Test ("CC70A02", "Check that the visible part of a generic " &
-                 "formal package includes the first list of basic " &
-                 "declarative items of the package specification. Check " &
-                 "for a generic subprogram where formal package has (<>) " &
-                 "actual part");
- 
-    declare
-       Mult_Operand         : constant Complex_Type := Complex ( -4,  9);
-       Exp_Operand          : constant Complex_Type := Complex (  0, -7);
- 
-       Expected_Mult_Result : constant Complex_Type := Complex ( 28, -63);
-       Expected_Exp_Result  : constant Complex_Type := Complex (-49,   0);
-    begin
- 
-       if Complex_Multiplication (Mult_Operand, -7) /= Expected_Mult_Result then
-          Report.Failed ("Incorrect results from complex multiplication");
-       end if;
- 
-       if Complex_Exponentiation (Exp_Operand, 2) /= Expected_Exp_Result then
-          Report.Failed ("Incorrect results from complex exponentiation");
-       end if;
- 
-    end;
- 
-    Report.Result;
- 
- end CC70A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70b01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70b01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70b01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70b01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,170 ****
- -- CC70B01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a formal package actual part may specify actual parameters
- --      for a generic formal package. Check that a use clause in the generic
- --      formal part provides direct visibility of declarations within the
- --      generic formal package. Check that the scope of such a use clause
- --      extends to the generic subprogram body. Check that the visible part of
- --      the generic formal package includes the first list of basic
- --      declarative items of the package specification.
- --
- --      Check the case where the formal package is declared in a generic
- --      subprogram.
- --
- -- TEST DESCRIPTION:
- --      Declare a list abstraction in a generic package which manages lists of
- --      elements of any nonlimited type (foundation code). Declare a generic
- --      subprogram which operates on lists of elements of discrete types.
- --      Provide the generic subprogram with two formal parameters: (1) a
- --      formal discrete type which represents a list element type, and (2) a
- --      generic formal package with the list abstraction package as template.
- --      Use the formal discrete type as the generic formal actual part for the
- --      formal package. Include a use clause for the formal package in the
- --      generic subprogram formal part.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC70B00.A
- --         CC70B01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- -- Declare a generic subprogram which performs an operation on lists of
- -- discrete objects.
- 
- with FC70B00;  -- Generic list abstraction.
- generic
- 
-    -- Import the list abstraction defined in FC70B00. To ensure that only
-    -- list abstraction instances defining lists of *discrete* elements will be
-    -- accepted as actuals to this generic, declare a formal discrete type and
-    -- pass it as an actual parameter to the formal package.
-    --
-    -- Only instances declared for the same discrete type as that used to
-    -- instantiate this generic subprogram will be accepted.
- 
-    type Elem_Type is (<>);                  -- Discrete types only.
-    with package List_Mgr is new FC70B00 (Elem_Type);
- 
-    use List_Mgr;                            -- Use clause for formal package.
- 
- procedure CC70B01_0 (L : in out List_Type); -- List_Mgr.List_Type directly
-                                             -- visible.
- 
- 
-      --==================================================================--
- 
- 
- procedure CC70B01_0 (L : in out List_Type) is  -- Declarations in List_Mgr
- begin                                          -- still directly visible.
-    Reset (L);
-    while not End_Of_List (L) loop
-       Write_Element (L, Elem_Type'First);      -- This statement assumes
-    end loop;                                   -- Elem_Type is discrete.
- end CC70B01_0;
- 
- 
-      --==================================================================--
- 
- 
- with FC70B00;    -- Generic list abstraction.
- with CC70B01_0;  -- Generic "zeroing" operation for lists of discrete types.
- 
- with Report;
- procedure CC70B01 is
- 
-    type Points is range 0 .. 10;                    -- Discrete type.
-    package Lists_of_Scores is new FC70B00 (Points); -- List-of-points
-                                                     -- abstraction.
-    Scores : Lists_of_Scores.List_Type;              -- List of points.
- 
-    procedure Reset_All_Scores is new                -- Operation on lists of
-      CC70B01_0 (Points, Lists_of_Scores);           -- points.
- 
- 
-    -- Begin test code declarations: -----------------------
- 
-    type TC_Score_Array is array (1 .. 3) of Points;
- 
-    TC_Initial_Values : constant TC_Score_Array := (2, 4, 6);
-    TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
- 
-    TC_Correct_Initial_Values : Boolean := False;
-    TC_Correct_Final_Values   : Boolean := False;
- 
- 
-    procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
-    begin                                  -- Initial list contains 3 scores
-       for I in TC_Score_Array'Range loop  -- with the values 2, 4, and 6.
-          Lists_of_Scores.Add_Element (L, TC_Initial_Values(I));
-       end loop;
-    end TC_Initialize_List;
- 
- 
-    procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
-                              Expected : in     TC_Score_Array;
-                              OK       :    out Boolean) is
-       Actual : TC_Score_Array;
-    begin                                  -- Verify that all scores have been
-       Lists_of_Scores.Reset (L);          -- set to zero.
-       for I in TC_Score_Array'Range loop
-          Lists_of_Scores.Read_Element (L, Actual(I));
-       end loop;
-       OK := (Actual = Expected);
-    end TC_Verify_List;
- 
-    -- End test code declarations. -------------------------
- 
- 
- begin
-    Report.Test ("CC70B01", "Check that a library-level generic subprogram "   &
-                 "may have a formal package as a formal parameter, and that "  &
-                 "the generic formal actual part may specify explicit actual " &
-                 "parameters. Check that a use clause is legal in the "        &
-                 "generic formal part");
- 
-    TC_Initialize_List (Scores);
-    TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
- 
-    if not TC_Correct_Initial_Values then
-       Report.Failed ("List contains incorrect initial values");
-    end if;
- 
-    Reset_All_Scores (Scores);
-    TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
- 
-    if not TC_Correct_Final_Values then
-       Report.Failed ("List contains incorrect final values");
-    end if;
- 
-    Report.Result;
- end CC70B01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70b02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70b02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70b02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70b02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,222 ****
- -- CC70B02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a formal package actual part may specify actual parameters
- --      for a generic formal package. Check that such an actual parameter may
- --      be a formal parameter of a previously declared formal package
- --      (with a (<>) actual part). Check that a use clause in the generic
- --      formal part provides direct visibility of declarations within the
- --      generic formal package, including formal parameters (if the formal
- --      package has a (<>) actual part). Check that the scope of such a use
- --      clause extends to the generic subprogram body. Check that the visible
- --      part of the generic formal package includes the first list of basic
- --      declarative items of the package specification.
- --
- --      Check the case where the formal package is declared in a generic
- --      package.
- --
- -- TEST DESCRIPTION:
- --      Declare a list abstraction in a generic package which manages lists of
- --      elements of any nonlimited type (foundation code). Declare a second
- --      generic package which declares operations on discrete types. Declare
- --      a third generic package which combines the abstractions of the first
- --      two generics and declares operations on lists of elements of discrete
- --      types. Provide the third generic package with two formal parameters:
- --      (1) a generic formal package with the discrete operation package as
- --      template, and (2) a generic formal package with the list abstraction
- --      package as template. Use the formal discrete type of the discrete
- --      operations generic as the generic formal actual part for the second
- --      formal package. Include a use clause for the first formal package in
- --      the third generic package formal part.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC70B00.A
- --         CC70B02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- generic
-    type Discrete_Type is (<>);  -- Discrete types only.
- package CC70B02_0 is            -- Discrete type operations.
- 
-    procedure Double (Object : in out Discrete_Type);
- 
-    -- ... Other operations on discrete objects.
- 
- end CC70B02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70B02_0 is
- 
-    procedure Double (Object : in out Discrete_Type) is
-       Doubled_Position : Integer := Discrete_Type'Pos (Object) * 2;
-    begin
-       -- ... Error-checking code omitted for brevity.
-       Object := Discrete_Type'Val (Doubled_Position);
-    end Double;
- 
- end CC70B02_0;
- 
- 
-      --==================================================================--
- 
- 
- with CC70B02_0;                  -- Discrete type operations.
- with FC70B00;                    -- List abstraction.
- generic
- 
-    -- Import both the discrete-operation and list abstractions. To ensure that
-    -- only list abstraction instances defining lists of *discrete* elements
-    -- will be accepted as actuals to this generic, pass the formal discrete
-    -- type from the discrete-operation abstraction as an actual parameter to
-    -- the list-abstraction formal package.
-    --
-    -- Only list instances declared for the same discrete type as that used
-    -- to instantiate the discrete-operation package will be accepted.
- 
-    with package Discrete_Ops is new CC70B02_0 (<>);
- 
-    use Discrete_Ops;             -- Discrete_Ops directly visible.
- 
-    with package List_Mgr is new FC70B00 (Discrete_Type);  -- Discrete_Type is
-                                                           -- formal parameter
-                                                           -- of template for
-                                                           -- Discrete_Ops.
- package CC70B02_1 is             -- Discrete list operations.
- 
-    procedure Double_List (L : in out List_Mgr.List_Type);
- 
-    -- ... Other operations on lists of discrete objects.
- 
- end CC70B02_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70B02_1 is
- 
-    procedure Double_List (L : in out List_Mgr.List_Type) is
-       Element : Discrete_Type;  -- Formal part of Discrete_Ops template
-    begin                        -- is directly visible here.
-       List_Mgr.Reset (L);
-       while not List_Mgr.End_Of_List (L) loop
-          List_Mgr.View_Element (L, Element);
-          Double (Element);
-          List_Mgr.Write_Element (L, Element);
-       end loop;
-    end Double_List;
- 
- end CC70B02_1;
- 
- 
-      --==================================================================--
- 
- 
- with FC70B00;    -- Generic list abstraction.
- with CC70B02_0;  -- Generic discrete type operations.
- with CC70B02_1;  -- Generic discrete list operations.
- 
- with Report;
- procedure CC70B02 is
- 
-    type Points is range 0 .. 100;                   -- Discrete type.
- 
-    package Points_Ops is new CC70B02_0 (Points);    -- Points-type operations.
-    package Lists_of_Points is new FC70B00 (Points); -- Points lists.
-    package Points_List_Ops is new                   -- Points-list operations.
-      CC70B02_1 (Points_Ops, Lists_Of_Points);
-       
-    Scores : Lists_of_Points.List_Type;              -- List of points.
- 
- 
-    -- Begin test code declarations: -----------------------
- 
-    type TC_Score_Array is array (1 .. 3) of Points;
- 
-    TC_Initial_Values : constant TC_Score_Array := (23, 15,  0);
-    TC_Final_Values   : constant TC_Score_Array := (46, 30,  0);
- 
-    TC_Correct_Initial_Values : Boolean := False;
-    TC_Correct_Final_Values   : Boolean := False;
- 
- 
-    procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
-    begin                                  -- Initial list contains 3 scores
-       for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
-          Lists_Of_Points.Add_Element (L, TC_Initial_Values(I));
-       end loop;
-    end TC_Initialize_List;
- 
- 
-    procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
-                              Expected : in     TC_Score_Array;
-                              OK       :    out Boolean) is
-       Actual : TC_Score_Array;
-    begin                                  -- Verify that all scores have been
-       Lists_Of_Points.Reset (L);          -- set to zero.
-       for I in TC_Score_Array'Range loop
-          Lists_Of_Points.Read_Element (L, Actual(I));
-       end loop;
-       OK := (Actual = Expected);
-    end TC_Verify_List;
- 
-    -- End test code declarations. -------------------------
- 
- 
- begin
-    Report.Test ("CC70B02", "Check that a library-level generic package "      &
-                 "may have a formal package as a formal parameter, and that "  &
-                 "the generic formal actual part may specify explicit actual " &
-                 "parameters (including a formal parameter of a previously "   &
-                 "declared formal package). Check that a use clause is legal " &
-                 "in the generic formal part");
- 
-    TC_Initialize_List (Scores);
-    TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
- 
-    if not TC_Correct_Initial_Values then
-       Report.Failed ("List contains incorrect initial values");
-    end if;
- 
-    Points_List_Ops.Double_List (Scores);
-    TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
- 
-    if not TC_Correct_Final_Values then
-       Report.Failed ("List contains incorrect final values");
-    end if;
- 
-    Report.Result;
- end CC70B02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70c01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70c01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70c01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70c01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,187 ****
- -- CC70C01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a generic formal package is an instance. Specifically,
- --      check that a generic formal package may be passed as an actual
- --      parameter in an instantiation of a generic package. Check that the
- --      visible part of the generic formal package includes the first list of
- --      basic declarative items of the package specification.
- --
- -- TEST DESCRIPTION:
- --      A generic formal package is a package, and is an instance.
- --
- --      Declare a list type in a generic package for lists of elements of any
- --      nonlimited type (foundation code). Declare a second generic package
- --      which declares operations for the list type, and parameterize it with
- --      a generic formal package with the list-type package as template
- --      (foundation code). Declare a third generic package which declares
- --      additional operations for the list type, and parameterize it just like
- --      the second generic package. Declare an instance of the second generic
- --      in the spec of the third generic, passing the formal package as the
- --      actual.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC70C00.A
- --         CC70C01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FC70C00_0;                -- List abstraction.
- with FC70C00_1;                -- Basic list operations.
- generic
-    with package Lists is new FC70C00_0 (<>);
- package CC70C01_0 is           -- Additional list operations.
- 
-    -- Instantiate a generic package (FC70C00_1) with a generic formal package
-    -- (Lists). This ensures that the package passed as an actual corresponding
-    -- to Lists is the same one passed as an actual to FC70C00_1. Thus, all list
-    -- operations from both FC70C00_1 and this package operate on lists of the
-    -- same element type.
- 
-    package Basic_List_Ops is new FC70C00_1 (Lists);
- 
- 
-    End_of_List_Reached : exception;
- 
- 
-    -- Read from current element and advance "current" pointer.
-    procedure Read_Element (L : in out Lists.List_Type;
-                            E :    out Lists.Element_Type);
- 
-    -- Add element to end of list.
-    procedure Add_Element (L : in out Lists.List_Type;
-                           E : in     Lists.Element_Type);
- 
- end CC70C01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70C01_0 is
- 
-    procedure Read_Element (L : in out Lists.List_Type;
-                            E :    out Lists.Element_Type) is
-    begin
-       if Basic_List_Ops.End_Of_List (L) then  -- Use of op from the previous
-          raise End_Of_List_Reached;           -- generic package.
-       else
-          E         := L.Current.Item;         -- Retrieve current element.
-          L.Current := L.Current.Next;         -- Advance "current" pointer.
-       end if;
-    end Read_Element;
- 
- 
-    procedure Add_Element (L : in out Lists.List_Type;
-                           E : in     Lists.Element_Type) is
-       New_Node : Lists.Node_Pointer := new Lists.Node_Type'(E, null); 
-       use type Lists.Node_Pointer;
-    begin
-       if L.First = null then                -- No elements in list, so add new
-          L.First := New_Node;               -- element at beginning of list.
-       else
-          L.Last.Next := New_Node;           -- Add new element at end of list.
-       end if;
-       L.Last := New_Node;                   -- Set last-in-list pointer.
-    end Add_Element;
- 
- 
- end CC70C01_0;
- 
- 
-      --==================================================================--
- 
- 
- with FC70C00_0;  -- Generic list abstraction.
- with CC70C01_0;  -- Additional generic list operations.
- 
- with Report;
- procedure CC70C01 is
- 
-    type Points is range 0 .. 100;                     -- Discrete type.
- 
-    package Lists_of_Points is new FC70C00_0 (Points); -- Points lists.
- 
-    package Points_List_Ops is new                     -- Points-list ops.
-      CC70C01_0 (Lists_Of_Points);
-       
-    Scores : Lists_of_Points.List_Type;                -- List of points.
- 
- 
-    -- Begin test code declarations: -----------------------
- 
-    type TC_Score_Array is array (1 .. 3) of Points;
- 
-    TC_List_Values : constant TC_Score_Array := (23, 15,  0);
- 
-    TC_Correct_List_Values : Boolean := False;
- 
- 
-    procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
-    begin                                  -- Initial list contains 3 scores
-       for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
-          Points_List_Ops.Add_Element (L, TC_List_Values(I));
-       end loop;
-    end TC_Initialize_List;
- 
- 
-    procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
-                              Expected : in     TC_Score_Array;
-                              OK       :    out Boolean) is
-       Actual : TC_Score_Array;
-    begin
-       Points_List_Ops.Basic_List_Ops.Reset (L);
-       for I in TC_Score_Array'Range loop
-          Points_List_Ops.Read_Element (L, Actual(I));
-       end loop;
-       OK := (Actual = Expected);
-    end TC_Verify_List;
- 
-    -- End test code declarations. -------------------------
- 
- 
- begin
- 
-    Report.Test ("CC70C01", "Check that a generic formal package may be " &
-                 "passed as an actual in an instantiation of a generic " &
-                 "package");
- 
-    TC_Initialize_List (Scores);
-    TC_Verify_List (Scores, TC_List_Values, TC_Correct_List_Values);
- 
-    if not TC_Correct_List_Values then
-       Report.Failed ("List contains incorrect values");
-    end if;
- 
-    Report.Result;
- 
- end CC70C01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70c02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70c02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cc/cc70c02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cc/cc70c02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- CC70C02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a generic formal package is an instance. Specifically,
- --      check that a generic formal package may be passed as an actual
- --      parameter to another generic formal package. Check that the
- --      visible part of the generic formal package includes the first list of
- --      basic declarative items of the package specification.
- --
- -- TEST DESCRIPTION:
- --      A generic formal package is a package, and is an instance.
- --
- --      Declare a list type in a generic package for lists of elements of any
- --      nonlimited type (foundation code). Declare a second generic package
- --      which declares operations for the list type, and parameterize it with
- --      a generic formal package with the list-type package as template
- --      (foundation code). Declare a third generic package which declares
- --      additional operations for the list type, and parameterize it with two
- --      generic formal packages, one with the list-type package as template,
- --      the other with the second generic package as template. Use the first
- --      formal package as the generic formal actual part for the second formal
- --      package.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FC70C00.A
- --         CC70C02.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FC70C00_0;                -- List abstraction.
- with FC70C00_1;                -- Basic list operations.
- generic
- 
-    -- Import both the list-type abstraction defined in FC70C00_0 and the basic
-    -- list operations defined in FC70C00_1. To ensure that only basic operation
-    -- instances for lists of the same element type as that used to instantiate
-    -- the list type are accepted as actuals to this generic, pass the list-type
-    -- formal package as an actual parameter to the list-operation formal
-    -- package.
- 
-    with package Lists          is new FC70C00_0 (<>);
-    with package Basic_List_Ops is new FC70C00_1 (Lists);
- package CC70C02_0 is           -- Additional list operations.
- 
-    End_of_List_Reached : exception;
- 
- 
-    -- Read from current element and advance "current" pointer.
-    procedure Read_Element (L : in out Lists.List_Type;
-                            E :    out Lists.Element_Type);
- 
-    -- Add element to end of list.
-    procedure Add_Element (L : in out Lists.List_Type;
-                           E : in     Lists.Element_Type);
- 
- end CC70C02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CC70C02_0 is
- 
-    procedure Read_Element (L : in out Lists.List_Type;
-                            E :    out Lists.Element_Type) is
-    begin
-       if Basic_List_Ops.End_Of_List (L) then  -- Use of op from the previous
-          raise End_Of_List_Reached;           -- generic package.
-       else
-          E         := L.Current.Item;         -- Retrieve current element.
-          L.Current := L.Current.Next;         -- Advance "current" pointer.
-       end if;
-    end Read_Element;
- 
- 
-    procedure Add_Element (L : in out Lists.List_Type;
-                           E : in     Lists.Element_Type) is
-       New_Node : Lists.Node_Pointer := new Lists.Node_Type'(E, null); 
-       use type Lists.Node_Pointer;
-    begin
-       if L.First = null then                -- No elements in list, so add new
-          L.First := New_Node;               -- element at beginning of list.
-       else
-          L.Last.Next := New_Node;           -- Add new element at end of list.
-       end if;
-       L.Last := New_Node;                   -- Set last-in-list pointer.
-    end Add_Element;
- 
- 
- end CC70C02_0;
- 
- 
-      --==================================================================--
- 
- 
- with FC70C00_0;  -- Generic list type abstraction.
- with FC70C00_1;  -- Generic list operations.
- with CC70C02_0;  -- Additional generic list operations.
- 
- with Report;
- procedure CC70C02 is
- 
-    type Points is range 0 .. 100;                     -- Discrete type.
- 
-    package Lists_of_Points is new FC70C00_0 (Points); -- Points lists.
- 
-    package Basic_Point_Ops is new                     -- Basic points-list ops.
-      FC70C00_1 (Lists_Of_Points);
- 
-    package Points_List_Ops is new                     -- More points-list ops.
-      CC70C02_0 (Lists          => Lists_Of_Points,
-                 Basic_List_Ops => Basic_Point_Ops);
- 
-    Scores : Lists_of_Points.List_Type;                -- List of points.
- 
- 
-    -- Begin test code declarations: -----------------------
- 
-    type TC_Score_Array is array (1 .. 3) of Points;
- 
-    TC_List_Values : constant TC_Score_Array := (23, 15,  0);
- 
-    TC_Correct_List_Values : Boolean := False;
- 
- 
-    procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
-    begin                                  -- Initial list contains 3 scores
-       for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
-          Points_List_Ops.Add_Element (L, TC_List_Values(I));
-       end loop;
-    end TC_Initialize_List;
- 
- 
-    procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
-                              Expected : in     TC_Score_Array;
-                              OK       :    out Boolean) is
-       Actual : TC_Score_Array;
-    begin
-       Basic_Point_Ops.Reset (L);
-       for I in TC_Score_Array'Range loop
-          Points_List_Ops.Read_Element (L, Actual(I));
-       end loop;
-       OK := (Actual = Expected);
-    end TC_Verify_List;
- 
-    -- End test code declarations. -------------------------
- 
- 
- begin
- 
-    Report.Test ("CC70C02", "Check that a generic formal package may be " &
-                 "passed as an actual to another formal package");
- 
-    TC_Initialize_List (Scores);
-    TC_Verify_List (Scores, TC_List_Values, TC_Correct_List_Values);
- 
-    if not TC_Correct_List_Values then
-       Report.Failed ("List contains incorrect values");
-    end if;
- 
-    Report.Result;
- 
- end CC70C02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd10001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd10001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd10001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd10001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,300 ****
- -- CD10001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that representation items may contain nonstatic expressions
- --      in the case that each expression in  the representation item is a
- --      name that statically denotes a constant declared before the entity.
- --
- --
- -- TEST DESCRIPTION:
- --      For each of the specific items in the objective, this test checks
- --      an example of each of the categories of representation specification
- --      that are applicable to that objective, to wit:
- --        address clause ....................... Expressions need not be static
- --        alignment clause ..................... Expressions must be static
- --        bit order clause ..................... Not tested
- --        component size clause ................ Expressions must be static
- --        enumeration representation clause .... Expressions must be static
- --        external tag clause .................. Expressions must be static
- --        Import, Export and Convention pragmas  Not tested
- --        input clause ......................... Not tested
- --        output clause ........................ Not tested
- --        Pack pragma .......................... Not tested
- --        read clause .......................... Not tested
- --        record representation clause ......... Expressions must be static
- --        size clause .......................... Expressions must be static
- --        small clause ......................... Expressions must be static
- --        storage pool clause .................. Not tested
- --        storage size clause .................. Expressions must be static
- --        write clause ......................... Not tested
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute.
- --
- --      For implementations not validating against Annex C:
- --        if this test compiles without error messages at compilation,
- --        it must bind and execute.
- --
- -- PASS/FAIL CRITERIA:
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute, report PASSED, and complete normally,
- --        otherwise the test FAILS
- --
- --      For implementations not validating against Annex C:
- --        PASSING behavior is:
- --          this test executes, reports PASSED, and completes normally
- --        or
- --          this test executes and reports NOT_APPLICABLE
- --        or
- --          this test produces at least one error message at compilation, and
- --          the error message is associated with one of the items marked:
- --             -- N/A => ERROR.
- --
- --      All other behaviors are FAILING.
- --
- 
- -- CHANGE HISTORY:
- --      11 JUL 95   SAIC  Initial version
- --      10 MAR 97   PWB.CTA Made Nonstatic_Entity nonstatic; changed
- --                        Tenths'Small from 1.0/32.0 to 1.0/10.0,
- --                        as expected by the later check; improved
- --                        internal documentation.
- --      16 FEB 98   EDS   Modified test documentation.
- --      24 NOV 98   RLB   Changed Tenths'Small to 1.0/32.0, as this is
- --                        necessary so that all implementations can
- --                        process this test. (3.5.9(21) means non-binary
- --                        smalls are optional.)
- --      11 MAR 99   RLB   Merged versions. Most EDS changes removed (as
- --                        they made the test less applicable than the ACAA
- --                        version).
- --!
- 
- ----------------------------------------------------------------- CD10001_0
- 
- with System;
- with System.Storage_Elements;
- with Impdef;
- with SPPRT13;
- package CD10001_0 is
- 
-   -- a few types and objects to work with.
- 
-   type Int is range -2048 .. 2047;
-   My_Int : Int := 1024;
- 
-   type Enumeration is (First, Second, Third, Fourth, Fifth);
- 
-   -- a few names that statically denote constants:
- 
-   Nonstatic_Entity : constant System.Address :=                  -- Non-static
-      System.Storage_Elements."+" 
-        ( SPPRT13.Variable_Address, 
-          System.Storage_Elements.Storage_Offset'(0) );
- 
-   Tag_String : constant String := Impdef.External_Tag_Value;     -- Static
-   -- Check to ensure that Tag_String is static
-   Tag_String_Length : constant := Tag_String'Length;
- 
-   A_Reasonable_Size_Value : constant := System.Storage_Unit;     -- Static
-  
-   Zero  : constant := 0;                                         -- Static
-   One   : constant := 1;                                         -- Static
-   Two   : constant := 2;                                         -- Static
-   Three : constant := 3;                                         -- Static
-   Four  : constant := 4;                                         -- Static
-   Five  : constant := 5;                                         -- Static
- 
-   K : constant Int := My_Int;                                    -- Non-Static
- 
- --      Check that representation items containing nonstatic expressions are
- --      supported in the case that the representation item is a name that
- --      statically denotes a constant declared before the entity.
- --
- --        address clause
- --        Expression must be static - RM 13.3(12)
- 
-   Object_Address : Enumeration;
-     for Object_Address'Address use Nonstatic_Entity;          -- N/A => ERROR.
- 
- --        alignment clause
- --        Expression must be static - RM 13.3(25)
- 
-   Object_Alignment : Enumeration;
-     for Object_Alignment'Alignment use One;                   -- N/A => ERROR.
-   
- --        bit order clause
- -- no interesting test can be specified
- 
- --        component size clause
- --        Expression must be static - RM 13.3(69)
- 
-   type Array_With_Components is array(1..10) of Enumeration;
-     for Array_With_Components'Component_Size
-       use A_Reasonable_Size_Value;                            -- N/A => ERROR.
- 
- --        enumeration representation clause
- --        Expressions must be static - RM 13.4(6)
- 
-   type Enumeration_1 is (First, Second, Third);
-   for Enumeration_1 use (First => One, Second => Two, Third => Three);
- 
- --        external tag clause
- --        Expression must be static - RM 13.3(75)
- 
-   type Some_Tagged_Type is tagged null record;
-     for Some_Tagged_Type'External_Tag use Tag_String;         -- N/A => ERROR.
- 
- --        Import, Export and Convention pragmas
- -- no interesting test can be specified
- 
- --        input clause
- -- no interesting test can be specified
- 
- --        output clause
- -- no interesting test can be specified
- 
- --        Pack pragma
- -- no interesting test can be specified
- 
- --        read clause
- -- no interesting test can be specified
- 
- --        record representation clause
- --        Expressions must be static - RM 13.3(10)
- 
-   type Record_To_Layout is record
-     Bit_0 : Boolean;
-     Bit_1 : Boolean;
-   end record;
-     for Record_To_Layout use record                           -- N/A => ERROR.
-       Bit_0 at Zero range Zero..Zero;                         -- N/A => ERROR.
-       Bit_1 at Zero range Four..Four;                         -- N/A => ERROR.
-     end record;                                               -- N/A => ERROR.
- 
- --        size clause
- --        Expression must be static - RM 13.3(41)
- 
-   Object_Size : Enumeration;
-     for Object_Size'Size use A_Reasonable_Size_Value;         -- N/A => ERROR.
- 
- --        small clause
- --        Expression must be static - RM 3.5.10(2)
- 
-   type Tenths is delta 0.1 range 0.0..10.0;
-     for Tenths'Small use 1.0 / (Two ** Five);                 -- N/A => ERROR.
- 
- --        storage pool clause
- --        Not tested
- 
- --        storage size clause
- --        Expression may be non-static - RM 13.11(15)
-   type Reference is access Record_To_Layout;
-     for Reference'Storage_Size use Four * K;                  -- N/A => ERROR.
- 
- 
- --        write clause
- -- no interesting test can be specified
- 
-   procedure TC_Check_Values;
- 
- end CD10001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body CD10001_0 is
- 
-   use type System.Address;
- 
-   procedure Assert( Truth : Boolean; Message: String ) is
-   begin
-     if not Truth then
-       TCTouch.Implementation_Check( Message );
-     end if;
-   end Assert;
- 
-   procedure TC_Check_Values is
-     Record_Object : Record_To_Layout;
-   begin
- 
-     Assert(Object_Address'Address = Nonstatic_Entity,
-            "Object not at specified address");
- 
-     Assert(Object_Alignment'Alignment >= One,
-            "Object not at specified alignment");
- 
-     Assert(Array_With_Components'Component_Size = A_Reasonable_Size_Value,
-            "Array Components not specified size");
- 
- -- I don't see how to reliably check this one:
- --
- --  type Enumeration_1 is (First, Second, Third);
- --  for Enumeration_1 use (First => One, Second => Two, Third => Three);
- 
-     Assert(Some_Tagged_Type'External_Tag = Tag_String,
-            "External_Tag not specified value");
-     Assert(Record_Object.Bit_0'First_Bit = Zero,
-           "Record object First_Bit not zero");
- 
-     Assert(Record_Object.Bit_1'Last_Bit = Four,
-           "Record object Last_Bit not four");
- 
-     Assert(Object_Size'Size = A_Reasonable_Size_Value,
-            "Object size not specified value");
- 
-     Assert(Tenths'Small = 1.0 / Two ** Five,
-            "Tenths small not specified value");
- 
-     Assert(Reference'Storage_Size = 4096, -- Four * K,
-            "Reference storage size not specified value");
- 
-   end TC_Check_Values;
- 
- end CD10001_0;
- 
- ------------------------------------------------------------------- CD10001
- 
- with Report;
- with CD10001_0;
- 
- procedure CD10001 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD10001", "Check that representation items containing " &
-                           "nonstatic expressions are supported in the " &
-                           "case that the representation item is a name " &
-                           "that statically denotes a constant declared " &
-                           "before the entity" );
- 
-   CD10001_0.TC_Check_Values;
- 
-   Report.Result;
- 
- end CD10001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd10002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd10002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd10002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd10002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,1198 ****
- -- CD10002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that operational items are allowed in some contexts where
- --    representation items are not:
- --
- --       1 - Check that the name of an incompletely defined type can be used
- --           when specifying an operational item. (RM95/TC1 7.3(5)).
- --
- --       2 - Check that operational items can be specified for a descendant of
- --           a generic formal untagged type. (RM95/TC1 13.1(10)).
- --
- --       3 - Check that operational items can be specified for a derived
- --           untagged type even if the parent type is a by-reference type or
- --           has user-defined primitive subprograms. (RM95/TC1 13.1(11/1)).
- --
- --    (Defect Report 8652/0009, as reflected in Technical Corrigendum 1).
- --
- -- CHANGE HISTORY:
- --    19 JAN 2001   PHL   Initial version.
- --     3 DEC 2001   RLB   Reformatted for ACATS.
- --     3 OCT 2002   RLB   Corrected incorrect type derivations.
- --
- --!
- with Ada.Streams;
- use Ada.Streams;
- package CD10002_0 is
- 
-     type Kinds is (Read, Write, Input, Output);
-     type Counts is array (Kinds) of Natural;
- 
-     generic
-         type T is private;
-     package Nonlimited_Stream_Ops is
- 
-         procedure Write (Stream : access Root_Stream_Type'Class; Item : T);
-         function Input (Stream : access Root_Stream_Type'Class) return T;
-         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T);
-         procedure Output (Stream : access Root_Stream_Type'Class; Item : T);
- 
-         function Get_Counts return Counts;
- 
-     end Nonlimited_Stream_Ops;
- 
-     generic
-         type T (<>) is limited private; -- Should be self-initializing.
-         C : in out T;
-     package Limited_Stream_Ops is
- 
-         procedure Write (Stream : access Root_Stream_Type'Class; Item : T);
-         function Input (Stream : access Root_Stream_Type'Class) return T;
-         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T);
-         procedure Output (Stream : access Root_Stream_Type'Class; Item : T);
- 
-         function Get_Counts return Counts;
- 
-     end Limited_Stream_Ops;
- 
- end CD10002_0;
- 
- 
- package body CD10002_0 is
- 
-     package body Nonlimited_Stream_Ops is
-         Cnts : Counts := (others => 0);
-         X : T; -- Initialized by Write/Output.
- 
-         procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
-         begin
-             X := Item;
-             Cnts (Write) := Cnts (Write) + 1;
-         end Write;
- 
-         function Input (Stream : access Root_Stream_Type'Class) return T is
-         begin
-             Cnts (Input) := Cnts (Input) + 1;
-             return X;
-         end Input;
- 
-         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
-         begin
-             Cnts (Read) := Cnts (Read) + 1;
-             Item := X;
-         end Read;
- 
-         procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
-         begin
-             X := Item;
-             Cnts (Output) := Cnts (Output) + 1;
-         end Output;
- 
-         function Get_Counts return Counts is
-         begin
-             return Cnts;
-         end Get_Counts;
- 
-     end Nonlimited_Stream_Ops;
- 
-     package body Limited_Stream_Ops is
-         Cnts : Counts := (others => 0);
- 
-         procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
-         begin
-             Cnts (Write) := Cnts (Write) + 1;
-         end Write;
- 
-         function Input (Stream : access Root_Stream_Type'Class) return T is
-         begin
-             Cnts (Input) := Cnts (Input) + 1;
-             return C;
-         end Input;
- 
-         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
-         begin
-             Cnts (Read) := Cnts (Read) + 1;
-         end Read;
- 
-         procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
-         begin
-             Cnts (Output) := Cnts (Output) + 1;
-         end Output;
- 
-         function Get_Counts return Counts is
-         begin
-             return Cnts;
-         end Get_Counts;
- 
-     end Limited_Stream_Ops;
- 
- end CD10002_0;
- 
- 
- with Ada.Streams;
- use Ada.Streams;
- package CD10002_1 is
- 
-     type Dummy_Stream is new Root_Stream_Type with null record;
-     procedure Read (Stream : in out Dummy_Stream;
-                     Item : out Stream_Element_Array;
-                     Last : out Stream_Element_Offset);
-     procedure Write (Stream : in out Dummy_Stream;
-                      Item : Stream_Element_Array);
- 
- end CD10002_1;
- 
- 
- with Report;
- use Report;
- package body CD10002_1 is
- 
-     procedure Read (Stream : in out Dummy_Stream;
-                     Item : out Stream_Element_Array;
-                     Last : out Stream_Element_Offset) is
-     begin
-         Failed ("Unexpected call to the Read operation of Dummy_Stream");
-     end Read;
- 
-     procedure Write (Stream : in out Dummy_Stream;
-                      Item : Stream_Element_Array) is
-     begin
-         Failed ("Unexpected call to the Write operation of Dummy_Stream");
-     end Write;
- 
- end CD10002_1;
- 
- 
- with Ada.Streams;
- use Ada.Streams;
- with CD10002_0;
- package CD10002_Deriv is
- 
-     -- Parent has user-defined subprograms.
- 
-     type T1 is new Boolean;
-     function Is_Odd (X : Integer) return T1;
- 
-     type T2 is
-         record
-             F : Float;
-         end record;
-     procedure Print (X : T2);
- 
-     type T3 is array (Boolean) of Duration;
-     function "+" (L, R : T3) return T3;
- 
-     -- Parent is by-reference.  No need to check the case where the parent
-     -- is tagged, because the defect report only deals with untagged types.
- 
-     task type T4 is
-     end T4;
- 
-     protected type T5 is
-     end T5;
- 
-     type T6 (D : access Integer := new Integer'(2)) is limited null record;
- 
-     type T7 is array (Character) of T6;
- 
-     package P is
-         type T8 is limited private;
-     private
-         type T8 is new T5;
-     end P;
- 
-     type Nt1 is new T1;
-     type Nt2 is new T2;
-     type Nt3 is new T3;
-     type Nt4 is new T4;
-     type Nt5 is new T5;
-     type Nt6 is new T6;
-     type Nt7 is new T7;
-     type Nt8 is new P.T8;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt1'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt2;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt3;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt4;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt5;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt6;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt7;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt8;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8);
- 
-     for Nt1'Write use Write;
-     for Nt1'Read use Read;
-     for Nt1'Output use Output;
-     for Nt1'Input use Input;
- 
-     for Nt2'Write use Write;
-     for Nt2'Read use Read;
-     for Nt2'Output use Output;
-     for Nt2'Input use Input;
- 
-     for Nt3'Write use Write;
-     for Nt3'Read use Read;
-     for Nt3'Output use Output;
-     for Nt3'Input use Input;
- 
-     for Nt4'Write use Write;
-     for Nt4'Read use Read;
-     for Nt4'Output use Output;
-     for Nt4'Input use Input;
- 
-     for Nt5'Write use Write;
-     for Nt5'Read use Read;
-     for Nt5'Output use Output;
-     for Nt5'Input use Input;
- 
-     for Nt6'Write use Write;
-     for Nt6'Read use Read;
-     for Nt6'Output use Output;
-     for Nt6'Input use Input;
- 
-     for Nt7'Write use Write;
-     for Nt7'Read use Read;
-     for Nt7'Output use Output;
-     for Nt7'Input use Input;
- 
-     for Nt8'Write use Write;
-     for Nt8'Read use Read;
-     for Nt8'Output use Output;
-     for Nt8'Input use Input;
- 
-     -- All these variables are self-initializing.
-     C4 : Nt4;
-     C5 : Nt5;
-     C6 : Nt6;
-     C7 : Nt7;
-     C8 : Nt8;
- 
-     package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base);
-     package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2);
-     package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3);
-     package Nt4_Ops is new CD10002_0.Limited_Stream_Ops (Nt4, C4);
-     package Nt5_Ops is new CD10002_0.Limited_Stream_Ops (Nt5, C5);
-     package Nt6_Ops is new CD10002_0.Limited_Stream_Ops (Nt6, C6);
-     package Nt7_Ops is new CD10002_0.Limited_Stream_Ops (Nt7, C7);
-     package Nt8_Ops is new CD10002_0.Limited_Stream_Ops (Nt8, C8);
- 
- end CD10002_Deriv;
- 
- 
- package body CD10002_Deriv is
- 
-     function Is_Odd (X : Integer) return T1 is
-     begin
-         return True;
-     end Is_Odd;
-     procedure Print (X : T2) is
-     begin
-         null;
-     end Print;
-     function "+" (L, R : T3) return T3 is
-     begin
-         return (False => L (False) + R (True), True => L (True) + R (False));
-     end "+";
-     task body T4 is
-     begin
-         null;
-     end T4;
-     protected body T5 is
-     end T5;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
-        renames Nt1_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base
-        renames Nt1_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base)
-        renames Nt1_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
-        renames Nt1_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2)
-        renames Nt2_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt2
-        renames Nt2_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2)
-        renames Nt2_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2)
-        renames Nt2_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3)
-        renames Nt3_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt3
-        renames Nt3_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3)
-        renames Nt3_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3)
-        renames Nt3_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4)
-        renames Nt4_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt4
-        renames Nt4_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4)
-        renames Nt4_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4)
-        renames Nt4_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5)
-        renames Nt5_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt5
-        renames Nt5_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5)
-        renames Nt5_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5)
-        renames Nt5_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6)
-        renames Nt6_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt6
-        renames Nt6_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6)
-        renames Nt6_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6)
-        renames Nt6_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7)
-        renames Nt7_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt7
-        renames Nt7_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7)
-        renames Nt7_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7)
-        renames Nt7_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8)
-        renames Nt8_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt8
-        renames Nt8_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8)
-        renames Nt8_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8)
-        renames Nt8_Ops.Output;
- 
- end CD10002_Deriv;
- 
- 
- with Ada.Streams;
- use Ada.Streams;
- with CD10002_0;
- generic
-     type T1 is (<>);
-     type T2 is range <>;
-     type T3 is mod <>;
-     type T4 is digits <>;
-     type T5 is delta <>;
-     type T6 is delta <> digits <>;
-     type T7 is access T3;
-     type T8 is new Boolean;
-     type T9 is private;
-     type T10 (<>) is limited private; -- Should be self-initializing.
-     C10 : in out T10;
-     type T11 is array (T1) of T2;
- package CD10002_Gen is
- 
-     -- Direct descendants.
-     type Nt1 is new T1;
-     type Nt2 is new T2;
-     type Nt3 is new T3;
-     type Nt4 is new T4;
-     type Nt5 is new T5;
-     type Nt6 is new T6;
-     type Nt7 is new T7;
-     type Nt8 is new T8;
-     type Nt9 is new T9;
-     type Nt10 is new T10;
-     type Nt11 is new T11;
- 
-     -- Indirect descendants (only pick two, a limited one and a non-limited
-     -- one).
-     type Nt12 is new Nt10;
-     type Nt13 is new Nt11;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt1'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt2'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt3'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt4'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt5'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt6'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt7;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base;
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Nt8'Base);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt9;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt10;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt11;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt12;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13);
-     function Input (Stream : access Root_Stream_Type'Class) return Nt13;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13);
- 
-     for Nt1'Write use Write;
-     for Nt1'Read use Read;
-     for Nt1'Output use Output;
-     for Nt1'Input use Input;
- 
-     for Nt2'Write use Write;
-     for Nt2'Read use Read;
-     for Nt2'Output use Output;
-     for Nt2'Input use Input;
- 
-     for Nt3'Write use Write;
-     for Nt3'Read use Read;
-     for Nt3'Output use Output;
-     for Nt3'Input use Input;
- 
-     for Nt4'Write use Write;
-     for Nt4'Read use Read;
-     for Nt4'Output use Output;
-     for Nt4'Input use Input;
- 
-     for Nt5'Write use Write;
-     for Nt5'Read use Read;
-     for Nt5'Output use Output;
-     for Nt5'Input use Input;
- 
-     for Nt6'Write use Write;
-     for Nt6'Read use Read;
-     for Nt6'Output use Output;
-     for Nt6'Input use Input;
- 
-     for Nt7'Write use Write;
-     for Nt7'Read use Read;
-     for Nt7'Output use Output;
-     for Nt7'Input use Input;
- 
-     for Nt8'Write use Write;
-     for Nt8'Read use Read;
-     for Nt8'Output use Output;
-     for Nt8'Input use Input;
- 
-     for Nt9'Write use Write;
-     for Nt9'Read use Read;
-     for Nt9'Output use Output;
-     for Nt9'Input use Input;
- 
-     for Nt10'Write use Write;
-     for Nt10'Read use Read;
-     for Nt10'Output use Output;
-     for Nt10'Input use Input;
- 
-     for Nt11'Write use Write;
-     for Nt11'Read use Read;
-     for Nt11'Output use Output;
-     for Nt11'Input use Input;
- 
-     for Nt12'Write use Write;
-     for Nt12'Read use Read;
-     for Nt12'Output use Output;
-     for Nt12'Input use Input;
- 
-     for Nt13'Write use Write;
-     for Nt13'Read use Read;
-     for Nt13'Output use Output;
-     for Nt13'Input use Input;
- 
-     type Null_Record is null record;
- 
-     package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base);
-     package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2'Base);
-     package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3'Base);
-     package Nt4_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt4'Base);
-     package Nt5_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt5'Base);
-     package Nt6_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt6'Base);
-     package Nt7_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt7);
-     package Nt8_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt8'Base);
-     package Nt9_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt9);
-     package Nt11_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt11);
-     package Nt13_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt13);
- 
-     function Get_Nt10_Counts return CD10002_0.Counts;
-     function Get_Nt12_Counts return CD10002_0.Counts;
- 
- end CD10002_Gen;
- 
- 
- package body CD10002_Gen is
- 
-     use CD10002_0;
- 
-     Nt10_Cnts : Counts := (others => 0);
-     Nt12_Cnts : Counts := (others => 0);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
-        renames Nt1_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base
-        renames Nt1_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base)
-        renames Nt1_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
-        renames Nt1_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base)
-        renames Nt2_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base
-        renames Nt2_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2'Base)
-        renames Nt2_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base)
-        renames Nt2_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base)
-        renames Nt3_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base
-        renames Nt3_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3'Base)
-        renames Nt3_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base)
-        renames Nt3_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base)
-        renames Nt4_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base
-        renames Nt4_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4'Base)
-        renames Nt4_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base)
-        renames Nt4_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base)
-        renames Nt5_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base
-        renames Nt5_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5'Base)
-        renames Nt5_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base)
-        renames Nt5_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base)
-        renames Nt6_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base
-        renames Nt6_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6'Base)
-        renames Nt6_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base)
-        renames Nt6_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7)
-        renames Nt7_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt7
-        renames Nt7_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7)
-        renames Nt7_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7)
-        renames Nt7_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base)
-        renames Nt8_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base
-        renames Nt8_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8'Base)
-        renames Nt8_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base)
-        renames Nt8_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9)
-        renames Nt9_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt9
-        renames Nt9_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9)
-        renames Nt9_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9)
-        renames Nt9_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10) is
-     begin
-         Nt10_Cnts (Write) := Nt10_Cnts (Write) + 1;
-     end Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt10 is
-     begin
-         Nt10_Cnts (Input) := Nt10_Cnts (Input) + 1;
-         return Nt10 (C10);
-     end Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10) is
-     begin
-         Nt10_Cnts (Read) := Nt10_Cnts (Read) + 1;
-     end Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10) is
-     begin
-         Nt10_Cnts (Output) := Nt10_Cnts (Output) + 1;
-     end Output;
-     function Get_Nt10_Counts return CD10002_0.Counts is
-     begin
-         return Nt10_Cnts;
-     end Get_Nt10_Counts;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11)
-        renames Nt11_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt11
-        renames Nt11_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11)
-        renames Nt11_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11)
-        renames Nt11_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12) is
-     begin
-         Nt12_Cnts (Write) := Nt12_Cnts (Write) + 1;
-     end Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt12 is
-     begin
-         Nt12_Cnts (Input) := Nt12_Cnts (Input) + 1;
-         return Nt12 (C10);
-     end Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12) is
-     begin
-         Nt12_Cnts (Read) := Nt12_Cnts (Read) + 1;
-     end Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12) is
-     begin
-         Nt12_Cnts (Output) := Nt12_Cnts (Output) + 1;
-     end Output;
-     function Get_Nt12_Counts return CD10002_0.Counts is
-     begin
-         return Nt12_Cnts;
-     end Get_Nt12_Counts;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13)
-        renames Nt13_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Nt13
-        renames Nt13_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13)
-        renames Nt13_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13)
-        renames Nt13_Ops.Output;
- 
- end CD10002_Gen;
- 
- 
- with Ada.Streams;
- use Ada.Streams;
- with CD10002_0;
- package CD10002_Priv is
- 
-     External_Tag_1 : constant String := "Isaac Newton";
-     External_Tag_2 : constant String := "Albert Einstein";
- 
-     type T1 is tagged private;
-     type T2 is tagged
-         record
-             C : T1;
-         end record;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : T1);
-     function Input (Stream : access Root_Stream_Type'Class) return T1;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : T1);
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : T2);
-     function Input (Stream : access Root_Stream_Type'Class) return T2;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2);
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : T2);
- 
-     for T1'Write use Write;
-     for T1'Input use Input;
- 
-     for T2'Read use Read;
-     for T2'Output use Output;
-     for T2'External_Tag use External_Tag_2;
- 
-     function Get_T1_Counts return CD10002_0.Counts;
-     function Get_T2_Counts return CD10002_0.Counts;
- 
- private
- 
-     for T1'Read use Read;
-     for T1'Output use Output;
-     for T1'External_Tag use External_Tag_1;
- 
-     for T2'Write use Write;
-     for T2'Input use Input;
- 
-     type T1 is tagged null record;
- 
-     package T1_Ops is new CD10002_0.Nonlimited_Stream_Ops (T1);
-     package T2_Ops is new CD10002_0.Nonlimited_Stream_Ops (T2);
- 
- end CD10002_Priv;
- 
- 
- package body CD10002_Priv is
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : T1)
-        renames T1_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return T1
-        renames T1_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1)
-        renames T1_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : T1)
-        renames T1_Ops.Output;
- 
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : T2)
-        renames T2_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return T2
-        renames T2_Ops.Input;
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2)
-        renames T2_Ops.Read;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : T2)
-        renames T2_Ops.Output;
- 
-     function Get_T1_Counts return CD10002_0.Counts renames T1_Ops.Get_Counts;
-     function Get_T2_Counts return CD10002_0.Counts renames T2_Ops.Get_Counts;
- end CD10002_Priv;
- 
- 
- with Ada.Streams;
- use Ada.Streams;
- with Report;
- use Report;
- with System;
- with CD10002_0;
- with CD10002_1;
- with CD10002_Deriv;
- with CD10002_Gen;
- with CD10002_Priv;
- procedure CD10002 is
- 
-     package Deriv renames CD10002_Deriv;
-     generic package Gen renames CD10002_Gen;
-     package Priv renames CD10002_Priv;
- 
-     type Stream_Ops is (Read, Write, Input, Output);
-     type Counts is array (Stream_Ops) of Natural;
- 
-     S : aliased CD10002_1.Dummy_Stream;
- 
- begin
-     Test ("CD10002",
-           "Check that operational items are allowed in some contexts " &
-              "where representation items are not");
- 
-     Test_Priv:
-         declare
-             X1 : Priv.T1;
-             X2 : Priv.T2;
-             use CD10002_0;
-         begin
-             Comment
-                ("Check that the name of an incompletely defined type can be " &
-                 "used when specifying an operational item");
- 
-             -- Partial view of a private type.
-             Priv.T1'Write (S'Access, X1);
-             Priv.T1'Read (S'Access, X1);
-             Priv.T1'Output (S'Access, X1);
-             X1 := Priv.T1'Input (S'Access);
- 
-             if Priv.Get_T1_Counts /= (1, 1, 1, 1) then
-                 Failed ("Incorrect calls to the stream attributes for Priv.T1");
-             elsif Priv.T1'External_Tag /= Priv.External_Tag_1 then
-                 Failed ("Incorrect external tag for Priv.T1");
-             end if;
- 
-             -- Incompletely defined but not private.
-             Priv.T2'Write (S'Access, X2);
-             Priv.T2'Read (S'Access, X2);
-             Priv.T2'Output (S'Access, X2);
-             X2 := Priv.T2'Input (S'Access);
- 
-             if Priv.Get_T2_Counts /= (1, 1, 1, 1) then
-                 Failed ("Incorrect calls to the stream attributes for Priv.T2");
-             elsif Priv.T2'External_Tag /= Priv.External_Tag_2 then
-                 Failed ("Incorrect external tag for Priv.T2");
-             end if;
- 
-         end Test_Priv;
- 
-     Test_Gen:
-         declare
- 
-             type Modular is mod System.Max_Binary_Modulus;
-             type Decimal is delta 1.0 digits 1;
-             type Access_Modular is access Modular;
-             type R9 is null record;
-             type R10 (D : access Integer) is limited null record;
-             type Arr is array (Character) of Integer;
- 
-             C10 : R10 (new Integer'(19));
- 
-             package Inst is new Gen (T1 => Character,
-                                      T2 => Integer,
-                                      T3 => Modular,
-                                      T4 => Float,
-                                      T5 => Duration,
-                                      T6 => Decimal,
-                                      T7 => Access_Modular,
-                                      T8 => Boolean,
-                                      T9 => R9,
-                                      T10 => R10,
-                                      C10 => C10,
-                                      T11 => Arr);
- 
-             X1 : Inst.Nt1 := 'a';
-             X2 : Inst.Nt2 := 0;
-             X3 : Inst.Nt3 := 0;
-             X4 : Inst.Nt4 := 0.0;
-             X5 : Inst.Nt5 := 0.0;
-             X6 : Inst.Nt6 := 0.0;
-             X7 : Inst.Nt7 := null;
-             X8 : Inst.Nt8 := Inst.False;
-             X9 : Inst.Nt9 := (null record);
-             X10 : Inst.Nt10 (D => new Integer'(5));
-             Y10 : Integer;
-             X11 : Inst.Nt11 := (others => 0);
-             X12 : Inst.Nt12 (D => new Integer'(7));
-             Y12 : Integer;
-             X13 : Inst.Nt13 := (others => 0);
-             use CD10002_0;
-         begin
-             Comment ("Check that operational items can be specified for a " &
-                      "descendant of a generic formal untagged type");
- 
-             Inst.Nt1'Write (S'Access, X1);
-             Inst.Nt1'Read (S'Access, X1);
-             Inst.Nt1'Output (S'Access, X1);
-             X1 := Inst.Nt1'Input (S'Access);
- 
-             if Inst.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt1");
-             end if;
- 
-             Inst.Nt2'Write (S'Access, X2);
-             Inst.Nt2'Read (S'Access, X2);
-             Inst.Nt2'Output (S'Access, X2);
-             X2 := Inst.Nt2'Input (S'Access);
- 
-             if Inst.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt2");
-             end if;
- 
-             Inst.Nt3'Write (S'Access, X3);
-             Inst.Nt3'Read (S'Access, X3);
-             Inst.Nt3'Output (S'Access, X3);
-             X3 := Inst.Nt3'Input (S'Access);
- 
-             if Inst.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt3");
-             end if;
- 
-             Inst.Nt4'Write (S'Access, X4);
-             Inst.Nt4'Read (S'Access, X4);
-             Inst.Nt4'Output (S'Access, X4);
-             X4 := Inst.Nt4'Input (S'Access);
- 
-             if Inst.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt4");
-             end if;
- 
-             Inst.Nt5'Write (S'Access, X5);
-             Inst.Nt5'Read (S'Access, X5);
-             Inst.Nt5'Output (S'Access, X5);
-             X5 := Inst.Nt5'Input (S'Access);
- 
-             if Inst.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt5");
-             end if;
- 
-             Inst.Nt6'Write (S'Access, X6);
-             Inst.Nt6'Read (S'Access, X6);
-             Inst.Nt6'Output (S'Access, X6);
-             X6 := Inst.Nt6'Input (S'Access);
- 
-             if Inst.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt6");
-             end if;
- 
-             Inst.Nt7'Write (S'Access, X7);
-             Inst.Nt7'Read (S'Access, X7);
-             Inst.Nt7'Output (S'Access, X7);
-             X7 := Inst.Nt7'Input (S'Access);
- 
-             if Inst.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt7");
-             end if;
- 
-             Inst.Nt8'Write (S'Access, X8);
-             Inst.Nt8'Read (S'Access, X8);
-             Inst.Nt8'Output (S'Access, X8);
-             X8 := Inst.Nt8'Input (S'Access);
- 
-             if Inst.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt8");
-             end if;
- 
-             Inst.Nt9'Write (S'Access, X9);
-             Inst.Nt9'Read (S'Access, X9);
-             Inst.Nt9'Output (S'Access, X9);
-             X9 := Inst.Nt9'Input (S'Access);
- 
-             if Inst.Nt9_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt9");
-             end if;
- 
-             Inst.Nt10'Write (S'Access, X10);
-             Inst.Nt10'Read (S'Access, X10);
-             Inst.Nt10'Output (S'Access, X10);
-             Y10 := Inst.Nt10'Input (S'Access).D.all;
- 
-             if Inst.Get_Nt10_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt10");
-             end if;
- 
-             Inst.Nt11'Write (S'Access, X11);
-             Inst.Nt11'Read (S'Access, X11);
-             Inst.Nt11'Output (S'Access, X11);
-             X11 := Inst.Nt11'Input (S'Access);
- 
-             if Inst.Nt11_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt11");
-             end if;
- 
-             Inst.Nt12'Write (S'Access, X12);
-             Inst.Nt12'Read (S'Access, X12);
-             Inst.Nt12'Output (S'Access, X12);
-             Y12 := Inst.Nt12'Input (S'Access).D.all;
- 
-             if Inst.Get_Nt12_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt12");
-             end if;
- 
-             Inst.Nt13'Write (S'Access, X13);
-             Inst.Nt13'Read (S'Access, X13);
-             Inst.Nt13'Output (S'Access, X13);
-             X13 := Inst.Nt13'Input (S'Access);
- 
-             if Inst.Nt13_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Inst.Nt13");
-             end if;
-         end Test_Gen;
- 
-     Test_Deriv:
-         declare
-             X1 : Deriv.Nt1 := Deriv.False;
-             X2 : Deriv.Nt2 := (others => 0.0);
-             X3 : Deriv.Nt3 := (others => 0.0);
-             X4 : Deriv.Nt4;
-             Y4 : Boolean;
-             X5 : Deriv.Nt5;
-             Y5 : System.Address;
-             X6 : Deriv.Nt6;
-             Y6 : Integer;
-             X7 : Deriv.Nt7;
-             Y7 : Integer;
-             X8 : Deriv.Nt8;
-             Y8 : Integer;
-             use CD10002_0;
-         begin
-             Comment ("Check that operational items can be specified for a " &
-                      "derived untagged type even if the parent type is a " &
-                      "by-reference type, or has user-defined primitive " &
-                      "subprograms");
- 
-             Deriv.Nt1'Write (S'Access, X1);
-             Deriv.Nt1'Read (S'Access, X1);
-             Deriv.Nt1'Output (S'Access, X1);
-             X1 := Deriv.Nt1'Input (S'Access);
- 
-             if Deriv.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt1");
-             end if;
- 
-             Deriv.Nt2'Write (S'Access, X2);
-             Deriv.Nt2'Read (S'Access, X2);
-             Deriv.Nt2'Output (S'Access, X2);
-             X2 := Deriv.Nt2'Input (S'Access);
- 
-             if Deriv.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt2");
-             end if;
- 
-             Deriv.Nt3'Write (S'Access, X3);
-             Deriv.Nt3'Read (S'Access, X3);
-             Deriv.Nt3'Output (S'Access, X3);
-             X3 := Deriv.Nt3'Input (S'Access);
- 
-             if Deriv.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt3");
-             end if;
- 
-             Deriv.Nt4'Write (S'Access, X4);
-             Deriv.Nt4'Read (S'Access, X4);
-             Deriv.Nt4'Output (S'Access, X4);
-             Y4 := Deriv.Nt4'Input (S'Access)'Terminated;
- 
-             if Deriv.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt4");
-             end if;
- 
-             Deriv.Nt5'Write (S'Access, X5);
-             Deriv.Nt5'Read (S'Access, X5);
-             Deriv.Nt5'Output (S'Access, X5);
-             Y5 := Deriv.Nt5'Input (S'Access)'Address;
- 
-             if Deriv.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt5");
-             end if;
- 
-             Deriv.Nt6'Write (S'Access, X6);
-             Deriv.Nt6'Read (S'Access, X6);
-             Deriv.Nt6'Output (S'Access, X6);
-             Y6 := Deriv.Nt6'Input (S'Access).D.all;
- 
-             if Deriv.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt6");
-             end if;
- 
-             Deriv.Nt7'Write (S'Access, X7);
-             Deriv.Nt7'Read (S'Access, X7);
-             Deriv.Nt7'Output (S'Access, X7);
-             Y7 := Deriv.Nt7'Input (S'Access) ('a').D.all;
- 
-             if Deriv.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt7");
-             end if;
- 
-             Deriv.Nt8'Write (S'Access, X8);
-             Deriv.Nt8'Read (S'Access, X8);
-             Deriv.Nt8'Output (S'Access, X8);
-             Y8 := Deriv.Nt8'Input (S'Access)'Size;
- 
-             if Deriv.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then
-                 Failed
-                    ("Incorrect calls to the stream attributes for Deriv.Nt8");
-             end if;
-         end Test_Deriv;
- 
-     Result;
- end CD10002;
- 
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- CD1009A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE FOR AN INTEGER TYPE DECLARED IN
- --     THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL  09/18/87 CREATED ORIGINAL TEST.
- --     DHH  03/31/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND ADDED
- --                   CHECK FOR REPRESENTATION CLAUSES, AND CHANGED
- --                   SPECIFIED_SIZE TO 5.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD1009A IS
- BEGIN
-      TEST ("CD1009A", "A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A PACKAGE FOR AN INTEGER " &
-                       "TYPE DECLARED IN THE VISIBLE PART OF THE " &
-                       "SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := 5;
- 
-                TYPE CHECK_TYPE_1 IS RANGE -8 .. 7;
-                FOR CHECK_TYPE_1'SIZE USE SPECIFIED_SIZE;
-                TYPE PACK_ARY IS ARRAY(1 .. 6) OF CHECK_TYPE_1;
-                PRAGMA PACK (PACK_ARY);
-                OBJ1 : PACK_ARY := (OTHERS => -7);
- 
-                TYPE CHECK_TYPE_2 IS RANGE -8 .. 7;
-           PRIVATE
-                FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
-                OBJ2 : CHECK_TYPE_2 := -7;
-                PROCEDURE CHECK1 IS NEW LENGTH_CHECK (CHECK_TYPE_1);
-                PROCEDURE CHECK2 IS NEW LENGTH_CHECK (CHECK_TYPE_2);
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                CHECK1 (OBJ1(IDENT_INT(1)), 5, "CHECK_TYPE_1");
-                CHECK2 (OBJ2, 5, "CHECK_TYPE_2");
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE");
-           END IF;
- 
-           IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- CD1009B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE FOR AN ENUMERATION TYPE DECLARED
- --     IN THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL 10/07/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009B IS
- BEGIN
-      TEST ("CD1009B", "A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A PACKAGE FOR AN " &
-                       "ENUMERATION TYPE DECLARED IN THE VISIBLE " &
-                       "PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
- 
-                TYPE CHECK_TYPE_1 IS (A0, A1, A2, A3);
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
- 
-                TYPE CHECK_TYPE_2 IS (A0, A1, A2, A3);
-           PRIVATE
-                FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
-           X : CHECK_TYPE_1 := A0;
-           Y : CHECK_TYPE_2 := A2;
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT'SIZE IS TOO SMALL --" &
-                        CHECK_TYPE_1'IMAGE(X));
-           END IF;
- 
-           IF Y'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT'SIZE IS TOO SMALL --" &
-                        CHECK_TYPE_2'IMAGE(Y));
-           END IF;
- 
-      END;
- 
-      RESULT;
- END CD1009B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CD1009D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE FOR A FIXED POINT TYPE DECLARED IN
- --     THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL 10/07/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009D IS
- BEGIN
-      TEST ("CD1009D", "A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A PACKAGE FOR A " &
-                       "FIXED POINT TYPE DECLARED IN THE VISIBLE " &
-                       "PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                TYPE SPECIFIED IS DELTA 2.0 ** (-4) RANGE 0.0 .. 10.0;
- 
-                SPECIFIED_SIZE : CONSTANT := SPECIFIED'SIZE;
- 
-                TYPE CHECK_TYPE_1 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
- 
-                TYPE CHECK_TYPE_2 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
-           PRIVATE
-                FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
- 
-           X: CHECK_TYPE_1 := 0.5;
-           Y: CHECK_TYPE_2 := 0.5;
- 
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE IS TOO SMALL -- " &
-                        "VALUE IS" & INTEGER'IMAGE ( INTEGER(X) ) );
-           END IF;
- 
-           IF Y'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE IS TOO SMALL -- " &
-                        "VALUE IS" & INTEGER'IMAGE ( INTEGER(Y) ) );
-           END IF;
- 
-      END;
- 
-      RESULT;
- END CD1009D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- CD1009E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' SPECIFICATION MAY BE GIVEN IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE FOR A ONE-DIMENSIONAL ARRAY TYPE
- --     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL  10/07/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009E IS
- BEGIN
-      TEST ("CD1009E", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A PACKAGE FOR A " &
-                       "ONE-DIMENSIONAL ARRAY TYPE DECLARED IN THE " &
-                       "VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 5;
- 
-                TYPE CHECK_TYPE_1 IS ARRAY (1 ..5) OF INTEGER;
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
-                X : CHECK_TYPE_1 := (OTHERS => IDENT_INT(1));
- 
-                TYPE CHECK_TYPE_2 IS ARRAY (1 ..5) OF INTEGER;
-           PRIVATE
-                FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
- 
-                Y : CHECK_TYPE_2 := (OTHERS => IDENT_INT(5));
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
-                        "FIRST VALUE IS"  &
-                        INTEGER'IMAGE( X( IDENT_INT(1) ) ) );
-           END IF;
- 
-           IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
-           END IF;
- 
-           IF Y'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_2.  " &
-                        "FIRST VALUE IS"  &
-                        INTEGER'IMAGE( Y( IDENT_INT(1) ) ) );
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CD1009F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' SPECIFICATION MAY BE GIVEN IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE FOR A TWO-DIMENSIONAL ARRAY TYPE
- --     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL  10/07/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009F IS
- BEGIN
-      TEST ("CD1009F", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A PACKAGE FOR A " &
-                       "TWO-DIMENSIONAL ARRAY TYPE DECLARED IN THE " &
-                       "VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 25;
- 
-                TYPE CHECK_TYPE_1 IS ARRAY (1 .. 5, 1 .. 5) OF INTEGER;
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
-                X : CHECK_TYPE_1 := ( OTHERS =>
-                                      ( OTHERS => IDENT_INT(1) ) );
- 
-                TYPE CHECK_TYPE_2 IS ARRAY (1 .. 5, 1 .. 5) OF INTEGER;
-           PRIVATE
-                FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
- 
-                Y : CHECK_TYPE_2 := ( OTHERS =>
-                                      ( OTHERS => IDENT_INT(5) ) );
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
-                        "REPRESENTATIVE VALUE IS"  &
-                        INTEGER'IMAGE( X( IDENT_INT(1), IDENT_INT(2) ) ) );
-           END IF;
- 
-           IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
-           END IF;
- 
-           IF Y'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_2.  " &
-                        INTEGER'IMAGE( Y( IDENT_INT(1), IDENT_INT(2) ) ) );
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- CD1009G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' SPECIFICATION MAY BE GIVEN IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE FOR A RECORD TYPE DECLARED IN
- --     THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL  10/07/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009G IS
- BEGIN
-      TEST ("CD1009G", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A PACKAGE FOR A " &
-                       "RECORD TYPE DECLARED IN THE " &
-                       "VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE;
- 
-                TYPE CHECK_TYPE_1 IS
-                     RECORD
-                          I : INTEGER;
-                     END RECORD;
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
-                X : CHECK_TYPE_1 := ( I => IDENT_INT (1) );
- 
-                TYPE CHECK_TYPE_2 IS
-                     RECORD
-                          I : INTEGER;
-                     END RECORD;
-           PRIVATE
-                FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
- 
-                Y : CHECK_TYPE_2 := ( I => IDENT_INT (5) );
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
-                        "VALUE IS"  & INTEGER'IMAGE( IDENT_INT( X.I) ) );
-           END IF;
- 
-           IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
-           END IF;
- 
-           IF Y'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_2.  " &
-                        "VALUE IS"  & INTEGER'IMAGE( IDENT_INT(Y.I) ) );
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- CD1009H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' SPECIFICATION MAY BE GIVEN IN THE PRIVATE
- --     PART OF A PACKAGE FOR A PRIVATE TYPE DECLARED IN THE VISIBLE
- --     PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL  09/18/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009H IS
- BEGIN
-      TEST ("CD1009H", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "PRIVATE PART OF A PACKAGE FOR A PRIVATE " &
-                       "TYPE DECLARED IN THE VISIBLE PART OF THE " &
-                       "SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
- 
-                TYPE CHECK_TYPE_1 IS PRIVATE;
-                C1 : CONSTANT CHECK_TYPE_1;
-                FUNCTION IMAGE ( A : CHECK_TYPE_1 ) RETURN STRING;
-           PRIVATE
-                TYPE CHECK_TYPE_1 IS RANGE 0 .. 7;
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
-                C1 : CONSTANT CHECK_TYPE_1 := CHECK_TYPE_1(IDENT_INT(1));
-           END PACK;
- 
-           USE PACK;
-           X : CHECK_TYPE_1 := C1;
- 
-           PACKAGE BODY PACK IS
-                FUNCTION IMAGE ( A : CHECK_TYPE_1 ) RETURN STRING IS
-                BEGIN
-                     RETURN INTEGER'IMAGE ( INTEGER (A) );
-                END IMAGE;
-          END PACK;
- 
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
-                        "VALUE IS"  & IMAGE(X));
-           END IF;
- 
-      END;
- 
-      RESULT;
- END CD1009H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- CD1009I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE
- --     PART OF A PACKAGE FOR A LIMITED-PRIVATE TYPE DECLARED IN THE
- --     VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL  09/18/87 CREATED ORIGINAL TEST.
- --     DHH  03/30/89 CHANGED SPECIFIED_SIZE TO 5, ADDED CHECK FOR
- --                   REPRESENTATION CLAUSES AND CHANGED THE TEST
- --                   EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD1009I IS
- BEGIN
-      TEST ("CD1009I", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "PRIVATE PART OF A PACKAGE FOR A LIMITED-" &
-                       "PRIVATE TYPE DECLARED IN THE VISIBLE PART " &
-                       "OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := 5;
- 
-                TYPE CHECK_TYPE_1 IS LIMITED PRIVATE;
-           PRIVATE
-                TYPE CHECK_TYPE_1 IS RANGE -8 .. 7;
-                FOR CHECK_TYPE_1'SIZE USE SPECIFIED_SIZE;
-                OBJ_CHECK : CHECK_TYPE_1 := -7;
-                PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE_1);
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                CHECK_1 (OBJ_CHECK, 5, "CHECK_TYPE_1");
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CD1009J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
- --     VISIBLE OR PRIVATE PART OF A PACKAGE FOR AN ACCESS TYPE
- --     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL 10/07/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009J IS
- BEGIN
-      TEST ("CD1009J", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "VISIBLE OR PRIVATE PART OF A PACKAGE FOR AN " &
-                       "ACCESS TYPE DECLARED IN THE VISIBLE PART OF " &
-                       "THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 10;
- 
-                TYPE CHECK_TYPE_1 IS ACCESS INTEGER;
-                FOR CHECK_TYPE_1'STORAGE_SIZE
-                               USE SPECIFIED_SIZE;
- 
-                TYPE CHECK_TYPE_2 IS ACCESS INTEGER;
-           PRIVATE
-                FOR CHECK_TYPE_2'STORAGE_SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
-           END IF;
- 
-           IF CHECK_TYPE_2'STORAGE_SIZE < SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_2'STORAGE_SIZE IS TOO SMALL");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009k.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009k.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009k.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009k.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- CD1009K.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
- --     VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TASK TYPE DECLARED IN
- --     THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY:
- --     VCL  10/08/87 CREATED ORIGINAL TEST.
- --     DHH  03/30/89 CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
- --                   EXTENSION FROM '.DEP' TO '.TST'.
- --     TMB  02/29/96 EFFECT OF SETTING 'STORAGE_SIZE IS IMPLEMENTATION 
- --                   DEPENDENT.
- --                   ONLY GUARANTEE WHEN EXAMINING 'STORAGE_SIZE IS THAT
- --                   IT IS NOT NEGATIVE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009K IS
- BEGIN
-      TEST ("CD1009K", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "VISIBLE OR PRIVATE PART OF A PACKAGE FOR A " &
-                       "TASK TYPE DECLARED IN THE VISIBLE PART OF " &
-                       "THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
-                TASK TYPE CHECK_TYPE_1 IS
-                END CHECK_TYPE_1;
- 
-                FOR CHECK_TYPE_1'STORAGE_SIZE
-                               USE SPECIFIED_SIZE;
- 
-                TASK TYPE CHECK_TYPE_2 IS
-                END CHECK_TYPE_2;
- 
-           PRIVATE
-                FOR CHECK_TYPE_2'STORAGE_SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                TASK BODY CHECK_TYPE_1 IS
-                     I : INTEGER;
-                BEGIN
-                     NULL;
-                END CHECK_TYPE_1;
- 
-                TASK BODY CHECK_TYPE_2 IS
-                     I : INTEGER;
-                BEGIN
-                     NULL;
-                END CHECK_TYPE_2;
- 
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'STORAGE_SIZE < 0 THEN
-                FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
-           END IF;
- 
-           IF CHECK_TYPE_2'STORAGE_SIZE < 0 THEN
-                FAILED ("CHECK_TYPE_2'STORAGE_SIZE IS TOO SMALL");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- CD1009L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SMALL' CLAUSE MAY BE GIVEN IN THE VISIBLE OR
- --     PRIVATE PART OF A PACKAGE FOR A FIXED POINT TYPE DECLARED
- --     IN THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL 10/08/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CHANGED
- --                    COMMENT FROM FLOATING POINT TO FIXED POINT.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009L IS
- BEGIN
-      TEST ("CD1009L", "A 'SMALL' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A PACKAGE FOR A " &
-                       "FIXED POINT TYPE DECLARED IN THE VISIBLE " &
-                       "PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                TYPE SPECIFIED IS DELTA 2.0 ** (-2) RANGE 0.0 .. 1.0;
- 
-                SPECIFIED_SMALL : CONSTANT := SPECIFIED'SMALL;
- 
-                TYPE CHECK_TYPE_1 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
-                FOR CHECK_TYPE_1'SMALL
-                               USE SPECIFIED_SMALL;
- 
-                TYPE CHECK_TYPE_2 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
-           PRIVATE
-                FOR CHECK_TYPE_2'SMALL USE SPECIFIED_SMALL;
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'SMALL /= SPECIFIED_SMALL THEN
-                FAILED ("INCORRECT RESULTS FOR CHECK_TYPE_1'SMALL");
-           END IF;
- 
-           IF CHECK_TYPE_2'SMALL /= SPECIFIED_SMALL THEN
-                FAILED ("INCORRECT RESULTS FOR CHECK_TYPE_2'SMALL");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- CD1009M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE MAY BE GIVEN IN
- --     THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR AN ENUMERATION
- --     TYPE DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL  10/08/87  CREATED ORIGINAL TEST.
- --     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                       -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD1009M IS
- BEGIN
-      TEST ("CD1009M", "AN ENUMERATION REPRESENTATION CLAUSE MAY BE " &
-                       "GIVEN IN THE VISIBLE OR PRIVATE PART OF A " &
-                       "PACKAGE FOR AN ENUMERATION TYPE DECLARED IN " &
-                       "THE VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                TYPE CHECK_TYPE_1 IS (A0, A2, A4, A8);
-                FOR CHECK_TYPE_1 USE (A0 => 0,
-                                      A2 => 1,
-                                      A4 => 2,
-                                      A8 => 3);
- 
-                TYPE CHECK_TYPE_2 IS (A0, A2, A4, A8);
-                TYPE INT1 IS RANGE 0 .. 3;
-                FOR INT1'SIZE USE CHECK_TYPE_1'SIZE;
- 
-                TYPE INT2 IS RANGE 2 .. 8;
- 
-           PRIVATE
-                FOR CHECK_TYPE_2 USE (A0 => 2,
-                                      A2 => 4,
-                                      A4 => 6,
-                                      A8 => 8);
-                FOR INT2'SIZE USE CHECK_TYPE_2'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(CHECK_TYPE_1, INT1);
-                PROCEDURE CHECK_2 IS NEW ENUM_CHECK(CHECK_TYPE_2, INT2);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                CHECK_1 (A4, 2, "CHECK_TYPE_1");
-                CHECK_2 (A8, 8, "CHECK_TYPE_2");
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD1009M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009n.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- CD1009N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE MAY BE GIVEN
- --     IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A RECORD TYPE
- --     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL 10/08/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
- --                    CHECKS FOR FAILURE.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009N IS
- BEGIN
-      TEST ("CD1009N", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
-                       "IN THE VISIBLE OR PRIVATE PART OF A PACKAGE " &
-                       "FOR A RECORD TYPE DECLARED IN THE " &
-                       "VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                UNITS_PER_INTEGER : CONSTANT :=
-                     (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                     SYSTEM.STORAGE_UNIT;
- 
-                TYPE CHECK_TYPE_1 IS
-                     RECORD
-                          I1 : INTEGER RANGE 0 .. 255;
-                          B1 : BOOLEAN;
-                          B2 : BOOLEAN;
-                          I2 : INTEGER RANGE 0 .. 15;
-                     END RECORD;
-                FOR CHECK_TYPE_1 USE
-                     RECORD
-                          I1 AT 0 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                          B1 AT 1 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          B2 AT 2 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          I2 AT 3 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                     END RECORD;
- 
-                TYPE CHECK_TYPE_2 IS
-                     RECORD
-                          I1 : INTEGER RANGE 0 .. 255;
-                          B1 : BOOLEAN;
-                          B2 : BOOLEAN;
-                          I2 : INTEGER RANGE 0 .. 15;
-                     END RECORD;
- 
-           PRIVATE
-                FOR CHECK_TYPE_2 USE
-                          RECORD
-                          I1 AT 0 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                          B1 AT 1 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          B2 AT 2 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          I2 AT 3 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                          END RECORD;
-           END PACK;
- 
-           USE PACK;
- 
-           R1 : CHECK_TYPE_1;
- 
-           R2 : CHECK_TYPE_2;
-      BEGIN
-           IF R1.I1'FIRST_BIT /= 0 OR
-                     R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
-                     R1.I1'POSITION /= 0 THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
-           END IF;
- 
-           IF R1.B1'FIRST_BIT /= 0 OR
-                     R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                     R1.B1'POSITION /= 1 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
-           END IF;
- 
-           IF R1.B2'FIRST_BIT /= 0 OR
-                     R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                     R1.B2'POSITION /= 2 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
-           END IF;
- 
-           IF R1.I2'FIRST_BIT /= 0 OR
-                     R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
-                     R1.I2'POSITION /= 3 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
-           END IF;
- 
- 
-           IF R2.I1'FIRST_BIT /= 0 OR
-                     R2.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
-                     R2.I1'POSITION /= 0 THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R2.I1");
-           END IF;
- 
-           IF R2.B1'FIRST_BIT /= 0 OR
-                     R2.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                     R2.B1'POSITION /= 1 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R2.B1");
-           END IF;
- 
-           IF R2.B2'FIRST_BIT /= 0 OR
-                     R2.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                     R2.B2'POSITION /= 2 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R2.B2");
-           END IF;
- 
-           IF R2.I2'FIRST_BIT /= 0 OR
-                     R2.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
-                     R2.I2'POSITION /= 3 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R2.I2");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- CD1009O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE PART
- --     OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL DECLARATION
- --     IS AN INTEGER TYPE, DECLARED IN THE VISIBLE PART OF THE SAME
- --     PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL  10/08/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009O IS
- BEGIN
-      TEST ("CD1009O", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE " &
-                       "PART OF A PACKAGE FOR AN INCOMPLETE TYPE, " &
-                       "WHOSE FULL DECLARATION IS AN INTEGER " &
-                       "TYPE, DECLARED IN THE VISIBLE PART OF THE " &
-                       "SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
- 
-                TYPE CHECK_TYPE_1;
-                TYPE ACC IS ACCESS CHECK_TYPE_1;
- 
-                TYPE CHECK_TYPE_1 IS RANGE 0 .. 7;
- 
-           PRIVATE
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
- 
-           X : CHECK_TYPE_1 := CHECK_TYPE_1 (IDENT_INT(1));
- 
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
-                        "VALUE IS"  & CHECK_TYPE_1'IMAGE(X));
-           END IF;
- 
-      END;
- 
-      RESULT;
- END CD1009O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009p.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CD1009P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE PART
- --     OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL DECLARATION
- --     IS AN ENUMERATION TYPE, DECLARED IN THE VISIBLE PART OF THE SAME
- --     PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL  10/09/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009P IS
- BEGIN
-      TEST ("CD1009P", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
-                       "PART OF A PACKAGE FOR AN INCOMPLETE TYPE, " &
-                       "WHOSE FULL DECLARATION IS AN ENUMERATION " &
-                       "TYPE, DECLARED IN THE VISIBLE PART OF THE " &
-                       "SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE;
- 
-                TYPE CHECK_TYPE_1;
-                TYPE ACC IS ACCESS CHECK_TYPE_1;
- 
-                TYPE CHECK_TYPE_1 IS (A0, A1, A2, A3);
- 
-           PRIVATE
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'SIZE > SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS TOO LARGE");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009q.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- CD1009Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'SIZE' SPECIFICATION MAY BE GIVEN IN THE PRIVATE
- --     PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL DECLARATION
- --     IS A FIXED POINT TYPE, DECLARED IN THE VISIBLE PART OF THE SAME
- --     PACKAGE.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL  10/21/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009Q IS
- BEGIN
-      TEST ("CD1009Q", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "PRIVATE PART OF A PACKAGE FOR A AN " &
-                       "INCOMPLETE TYPE, WHOSE FULL DECLARATION IS A " &
-                       "FIXED POINT TYPE, DECLARED IN THE VISIBLE " &
-                       "PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                TYPE SPECIFIED IS DELTA 2.0 ** (-4) RANGE 0.0 .. 10.0;
- 
-                SPECIFIED_SIZE : CONSTANT := SPECIFIED'SIZE;
- 
-                TYPE CHECK_TYPE_1;
-                TYPE ACC IS ACCESS CHECK_TYPE_1;
- 
-                TYPE CHECK_TYPE_1 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 2.0;
-           PRIVATE
-                FOR CHECK_TYPE_1'SIZE
-                               USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
- 
-           X : CHECK_TYPE_1 := CHECK_TYPE_1 ( IDENT_INT (1) );
-      BEGIN
-           IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
-           END IF;
- 
-           IF X'SIZE < SPECIFIED_SIZE THEN
-                FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
-                        "VALUE IS"  & INTEGER'IMAGE ( INTEGER(X) ) );
-           END IF;
- 
-      END;
- 
-      RESULT;
- END CD1009Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009r.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- CD1009R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
- --     PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL
- --     DECLARATION IS AN ACCESS TYPE, DECLARED IN THE VISIBLE PART OF
- --     THE SAME PACKAGE.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL 10/21/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009R IS
- BEGIN
-      TEST ("CD1009R", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE " &
-                       "TYPE, WHOSE FULL TYPE DECLARATION IS AN " &
-                       "ACCESS TYPE, DECLARED IN THE VISIBLE PART OF " &
-                       "THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 10;
- 
-                TYPE CHECK_TYPE_1;
-                TYPE ACC IS ACCESS CHECK_TYPE_1;
- 
-                TYPE CHECK_TYPE_1 IS ACCESS INTEGER;
-           PRIVATE
-                FOR CHECK_TYPE_1'STORAGE_SIZE
-                               USE SPECIFIED_SIZE;
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009s.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009s.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009s.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- CD1009S.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE
- --     PART OF A PACKAGE FOR A PRIVATE TYPE, WHOSE FULL TYPE
- --     DECLARATION IS AN ACCESS TYPE, DECLARED IN THE VISIBLE PART
- --     OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     VCL 10/09/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009S IS
- BEGIN
-      TEST ("CD1009S", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "PRIVATE PART OF A PACKAGE FOR A PRIVATE TYPE, " &
-                       "WHOSE FULL TYPE DECLARATION IS AN ACCESS " &
-                       "TYPE, DECLARED IN THE VISIBLE PART OF THE " &
-                       "SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 10;
- 
-                TYPE CHECK_TYPE_1 IS PRIVATE;
- 
-                PROCEDURE P;
-           PRIVATE
-                TYPE CHECK_TYPE_1 IS ACCESS INTEGER;
-                FOR CHECK_TYPE_1'STORAGE_SIZE
-                               USE SPECIFIED_SIZE;
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                PROCEDURE P IS
-                BEGIN
-                     IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
-                          FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO " &
-                                  "SMALL");
-                     END IF;
-                END P;
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           P;
-      END;
- 
-      RESULT;
- END CD1009S;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009t.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009t.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009t.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009t.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CD1009T.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
- --     PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL
- --     TYPE DECLARATION IS A TASK TYPE, DECLARED IN THE VISIBLE
- --     PART OF THE SAME PACKAGE.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY:
- --     VCL  10/21/87  CREATED ORIGINAL TEST.
- --     DHH  03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
- --                    EXTENSION FROM '.DEP' TO '.TST'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009T IS
- BEGIN
-      TEST ("CD1009T", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE  " &
-                       "TYPE, WHOSE FULL TYPE DECLARATION IS A " &
-                       "TASK TYPE, DECLARED IN THE VISIBLE PART OF " &
-                       "THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
-                TYPE CHECK_TYPE_1;
-                TYPE ACC IS ACCESS CHECK_TYPE_1;
- 
-                TASK TYPE CHECK_TYPE_1 IS END CHECK_TYPE_1;
-           PRIVATE
-                FOR CHECK_TYPE_1'STORAGE_SIZE
-                               USE SPECIFIED_SIZE;
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                TASK BODY CHECK_TYPE_1 IS
-                     I : INTEGER;
-                BEGIN
-                     NULL;
-                END CHECK_TYPE_1;
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
-                FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009T;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009u.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009u.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009u.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009u.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CD1009U.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE
- --     PART OF A PACKAGE FOR A LIMITED PRIVATE TYPE, WHOSE FULL TYPE
- --     DECLARATION IS A TASK TYPE, DECLARED IN THE VISIBLE PART OF THE
- --     SAME PACKAGE.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY:
- --     VCL  10/09/87  CREATED ORIGINAL TEST.
- --     DHH  03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
- --                    EXTENSION FROM '.DEP' TO '.TST'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009U IS
- BEGIN
-      TEST ("CD1009U", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
-                       "PRIVATE PART OF A PACKAGE FOR A LIMITED " &
-                       "PRIVATE TYPE, WHOSE FULL TYPE DECLARATION IS " &
-                       "A TASK TYPE, DECLARED IN THE VISIBLE PART OF " &
-                       "THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
-                TYPE CHECK_TYPE_1 IS LIMITED PRIVATE;
- 
-                PROCEDURE P;
-           PRIVATE
-                TASK TYPE CHECK_TYPE_1 IS
-                END CHECK_TYPE_1;
- 
-                FOR CHECK_TYPE_1'STORAGE_SIZE USE SPECIFIED_SIZE;
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                PROCEDURE P IS
-                BEGIN
-                     IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
-                          FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO " &
-                                  "SMALL");
-                     END IF;
-                END P;
- 
-                TASK BODY CHECK_TYPE_1 IS
-                     I : INTEGER;
-                BEGIN
-                     NULL;
-                END CHECK_TYPE_1;
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           P;
-      END;
- 
-      RESULT;
- END CD1009U;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009v.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009v.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009v.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CD1009V.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE MAY BE GIVEN IN
- --     THE PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE
- --     FULL TYPE DECLARATION IS AN ENUMERATION TYPE DECLARED IN THE
- --     VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL  10/21/87  CREATED ORIGINAL TEST.
- --     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                        -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD1009V IS
- BEGIN
-      TEST ("CD1009V", "AN ENUMERATION REPRESENTATION CLAUSE MAY BE " &
-                       "GIVEN IN THE PRIVATE PART OF A " &
-                       "PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL " &
-                       "TYPE DECLARATION IS AN ENUMERATION TYPE, " &
-                       "DECLARED IN THE VISIBLE PART OF THE SAME " &
-                       "PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                TYPE CHECK_TYPE_1;
-                TYPE ACC IS ACCESS CHECK_TYPE_1;
- 
-                TYPE CHECK_TYPE_1 IS (A0, A2, A4, A8);
-           PRIVATE
- 
-                FOR CHECK_TYPE_1 USE (A0 => 9,
-                                      A2 => 13,
-                                      A4 => 15,
-                                      A8 => 18);
-                TYPE INT1 IS RANGE 9 .. 18;
-                FOR INT1'SIZE USE CHECK_TYPE_1'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(CHECK_TYPE_1, INT1);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                CHECK_1 (A2, 13, "CHECK_TYPE_1");
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD1009V;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009w.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009w.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009w.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009w.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- CD1009W.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE MAY BE GIVEN IN
- --     THE PRIVATE PART OF A PACKAGE FOR A PRIVATE TYPE, WHOSE FULL
- --     TYPE DECLARATION IS AN ENUMERATION TYPE, DECLARED IN THE
- --     VISIBLE PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL  10/09/87  CREATED ORIGINAL TEST.
- --     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSE.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD1009W IS
- BEGIN
-      TEST ("CD1009W", "AN ENUMERATION REPRESENTATION CLAUSE MAY BE " &
-                       "GIVEN IN THE PRIVATE PART OF A PACKAGE FOR " &
-                       "A PRIVATE TYPE, WHOSE FULL TYPE DECLARATION " &
-                       "IS AN ENUMERATION TYPE, DECLARED IN " &
-                       "THE VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                TYPE CHECK_TYPE_1 IS PRIVATE;
-           PRIVATE
-                TYPE CHECK_TYPE_1 IS (A0, A2, A4, A8);
-                FOR CHECK_TYPE_1 USE (A0 => 0,
-                                      A2 => 2,
-                                      A4 => 4,
-                                      A8 => 16);
-                TYPE INT1 IS RANGE 0 .. 16;
-                FOR INT1'SIZE USE CHECK_TYPE_1'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(CHECK_TYPE_1, INT1);
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                CHECK_1 (A8, 16, "CHECK_TYPE_1");
-           END PACK;
- 
-           USE PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD1009W;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009x.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009x.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009x.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- CD1009X.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE MAY BE GIVEN
- --     IN THE PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE
- --     FULL TYPE DECLARATION IS A RECORD TYPE DECLARED IN THE VISIBLE
- --     PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL 10/21/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
- --                    CHECKS FOR FAILURE.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009X IS
- BEGIN
-      TEST ("CD1009X", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
-                       "IN THE PRIVATE PART OF A PACKAGE FOR AN " &
-                       "INCOMPLETE TYPE, WHOSE FULL TYPE DECLARATION " &
-                       "IS A RECORD TYPE DECLARED IN THE " &
-                       "VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                UNITS_PER_INTEGER : CONSTANT :=
-                     (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                     SYSTEM.STORAGE_UNIT;
- 
-                TYPE CHECK_TYPE_1;
-                TYPE ACC IS ACCESS CHECK_TYPE_1;
- 
-                TYPE CHECK_TYPE_1 IS
-                     RECORD
-                          I1 : INTEGER RANGE 0 .. 255;
-                          B1 : BOOLEAN;
-                          B2 : BOOLEAN;
-                          I2 : INTEGER RANGE 0 .. 15;
-                     END RECORD;
-           PRIVATE
-                FOR CHECK_TYPE_1 USE
-                     RECORD
-                          I1 AT 0 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                          B1 AT 1 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          B2 AT 2 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          I2 AT 3 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                     END RECORD;
-           END PACK;
- 
-           USE PACK;
- 
-           R1 : CHECK_TYPE_1;
-      BEGIN
-           IF R1.I1'FIRST_BIT /= 0 OR
-                     R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
-                     R1.I1'POSITION /= 0 THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
-           END IF;
- 
-           IF R1.B1'FIRST_BIT /= 0 OR
-                     R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                     R1.B1'POSITION /= 1 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
-           END IF;
- 
-           IF R1.B2'FIRST_BIT /= 0 OR
-                     R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                     R1.B2'POSITION /= 2 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
-           END IF;
- 
-           IF R1.I2'FIRST_BIT /= 0 OR
-                     R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
-                     R1.I2'POSITION /= 3 * UNITS_PER_INTEGER THEN
-                FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
-           END IF;
-      END;
- 
-      RESULT;
- END CD1009X;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009y.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009y.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009y.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009y.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- CD1009Y.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE MAY BE GIVEN IN THE
- --     PRIVATE PART OF A PACKAGE FOR A PRIVATE TYPE, WHOSE FULL TYPE
- --     DECLARATION IS A RECORD TYPE, DECLARED IN THE VISIBLE PART
- --     OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL 10/09/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
- --                    CHECKS FOR FAILURE.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009Y IS
- BEGIN
-      TEST ("CD1009Y", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
-                       "IN THE PRIVATE PART OF A PACKAGE FOR A " &
-                       "PRIVATE TYPE, WHOSE FULL TYPE DECLARATION IS " &
-                       "A RECORD TYPE DECLARED IN THE " &
-                       "VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                UNITS_PER_INTEGER : CONSTANT :=
-                     (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                     SYSTEM.STORAGE_UNIT;
- 
-                TYPE CHECK_TYPE_1 IS PRIVATE;
- 
-                PROCEDURE P;
-           PRIVATE
-                TYPE CHECK_TYPE_1 IS
-                     RECORD
-                          I1 : INTEGER RANGE 0 .. 255;
-                          B1 : BOOLEAN;
-                          B2 : BOOLEAN;
-                          I2 : INTEGER RANGE 0 .. 15;
-                     END RECORD;
-                FOR CHECK_TYPE_1 USE
-                     RECORD
-                          I1 AT 0 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                          B1 AT 1 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          B2 AT 2 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          I2 AT 3 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                     END RECORD;
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                PROCEDURE P IS
-                     R1 : CHECK_TYPE_1;
-                BEGIN
-                     IF R1.I1'FIRST_BIT /= 0 OR
-                               R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
-                               R1.I1'POSITION /= 0 THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
-                     END IF;
- 
-                     IF R1.B1'FIRST_BIT /= 0 OR
-                               R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                               R1.B1'POSITION /= 1 * UNITS_PER_INTEGER
-                                    THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
-                     END IF;
- 
-                     IF R1.B2'FIRST_BIT /= 0 OR
-                               R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                               R1.B2'POSITION /= 2 * UNITS_PER_INTEGER
-                                    THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
-                     END IF;
- 
-                     IF R1.I2'FIRST_BIT /= 0 OR
-                               R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
-                               R1.I2'POSITION /= 3 * UNITS_PER_INTEGER
-                                    THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
-                     END IF;
-                END P;
-           END PACK;
- 
-           USE PACK;
- 
-      BEGIN
-           P;
-      END;
- 
-      RESULT;
- END CD1009Y;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009z.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009z.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1009z.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1009z.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- CD1009Z.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE MAY BE GIVEN IN THE
- --     PRIVATE PART OF A PACKAGE FOR A LIMITED-PRIVATE TYPE, WHOSE
- --     FULL TYPE DECLARATION IS A RECORD TYPE, DECLARED IN THE VISIBLE
- --     PART OF THE SAME PACKAGE.
- 
- -- HISTORY:
- --     VCL 10/09/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
- --                    CHECKS FOR FAILURE.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD1009Z IS
- BEGIN
-      TEST ("CD1009Z", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
-                       "IN THE PRIVATE PART OF A PACKAGE FOR A " &
-                       "LIMITED PRIVATE TYPE, WHOSE FULL TYPE " &
-                       "DECLARATION IS A RECORD TYPE DECLARED IN THE " &
-                       "VISIBLE PART OF THE SAME PACKAGE");
-      DECLARE
-           PACKAGE PACK IS
-                UNITS_PER_INTEGER : CONSTANT :=
-                     (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                     SYSTEM.STORAGE_UNIT;
- 
-                TYPE CHECK_TYPE_1 IS LIMITED PRIVATE;
- 
-                PROCEDURE P;
-           PRIVATE
-                TYPE CHECK_TYPE_1 IS
-                     RECORD
-                          I1 : INTEGER RANGE 0 .. 255;
-                          B1 : BOOLEAN;
-                          B2 : BOOLEAN;
-                          I2 : INTEGER RANGE 0 .. 15;
-                     END RECORD;
-                FOR CHECK_TYPE_1 USE
-                     RECORD
-                          I1 AT 0 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                          B1 AT 1 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          B2 AT 2 * UNITS_PER_INTEGER
-                               RANGE 0 .. BOOLEAN'SIZE - 1;
-                          I2 AT 3 * UNITS_PER_INTEGER
-                               RANGE 0 .. INTEGER'SIZE - 1;
-                     END RECORD;
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                PROCEDURE P IS
-                     R1 : CHECK_TYPE_1;
-                BEGIN
-                     IF R1.I1'FIRST_BIT /= 0 OR
-                               R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
-                               R1.I1'POSITION /= 0 THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
-                     END IF;
- 
-                     IF R1.B1'FIRST_BIT /= 0 OR
-                               R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                               R1.B1'POSITION /= 1 * UNITS_PER_INTEGER
-                                    THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
-                     END IF;
- 
-                     IF R1.B2'FIRST_BIT /= 0 OR
-                               R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
-                               R1.B2'POSITION /= 2 * UNITS_PER_INTEGER
-                                    THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
-                     END IF;
- 
-                     IF R1.I2'FIRST_BIT /= 0 OR
-                               R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
-                               R1.I2'POSITION /= 3 * UNITS_PER_INTEGER
-                                    THEN
-                          FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
-                     END IF;
-                END P;
-           END PACK;
- 
-           USE PACK;
- 
-      BEGIN
-           P;
-      END;
- 
-      RESULT;
- END CD1009Z;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CD1C03A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE SIZE OF A DERIVED TYPE IS INHERITED FROM THE
- --     PARENT IF THE SIZE OF THE PARENT WAS DETERMINED BY A SIZE
- --     CLAUSE.
- 
- -- HISTORY:
- --     JET  09/16/87 CREATED ORIGINAL TEST.
- --     DHH  03/30/89 CHANGED SPECIFIED_SIZE TO 5, ADDED CHECK ON
- --                   REPRESENTATION CLAUSES, AND CHANGED THE TEST
- --                   EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                     -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD1C03A IS
- 
-      SPECIFIED_SIZE : CONSTANT := 5;
- 
-      TYPE PARENT_TYPE IS RANGE -8 .. 7;
- 
-      FOR PARENT_TYPE'SIZE USE SPECIFIED_SIZE;
-      PT : PARENT_TYPE := -7;
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      DT : DERIVED_TYPE := -7;
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (DERIVED_TYPE);
-      PROCEDURE CHECK_2 IS NEW LENGTH_CHECK (PARENT_TYPE);
- 
- BEGIN
- 
-      TEST("CD1C03A", "CHECK THAT THE SIZE OF A DERIVED TYPE IS " &
-                      "INHERITED FROM THE PARENT IF THE SIZE OF " &
-                      "THE PARENT WAS DETERMINED BY A SIZE CLAUSE");
- 
-      IF PARENT_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("PARENT_TYPE'SIZE /= " &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(PARENT_TYPE'SIZE));
-      END IF;
- 
-      IF DERIVED_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DERIVED_TYPE'SIZE /= " &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_TYPE'SIZE));
-      END IF;
- 
-      IF DT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DT'SIZE SHOULD NOT BE LESS THAN" &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DT'SIZE));
-      END IF;
- 
-      CHECK_1 (DT, 5, "DERIVED_TYPE");
-      CHECK_2 (PT, 5, "PARENT_TYPE");
-      RESULT;
- 
- END CD1C03A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- CD1C03B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE SIZE OF A DERIVED TYPE IS INHERITED FROM THE
- --     PARENT IF THE SIZE OF THE PARENT WAS DETERMINED BY A PRAGMA
- --     PACK.
- 
- -- HISTORY:
- --     JET 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 03/27/89  MODIFIED COMPARISON OF OBJECT SIZE TO PARENT SIZE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1C03B IS
- 
-      TYPE ENUM IS (E1, E2, E3);
- 
-      TYPE NORMAL_TYPE IS ARRAY (1 .. 100) OF ENUM;
- 
-      TYPE PARENT_TYPE IS ARRAY (1 .. 100) OF ENUM;
-      PRAGMA PACK (PARENT_TYPE);
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
-      X : DERIVED_TYPE := (OTHERS => ENUM'FIRST);
- 
- BEGIN
- 
-      TEST("CD1C03B", "CHECK THAT THE SIZE OF A DERIVED TYPE IS " &
-                      "INHERITED FROM THE PARENT IF THE SIZE OF " &
-                      "THE PARENT WAS DETERMINED BY A PRAGMA PACK");
- 
-      IF PARENT_TYPE'SIZE = IDENT_INT (NORMAL_TYPE'SIZE) THEN
-           COMMENT ("PRAGMA PACK HAD NO EFFECT ON THE SIZE OF " &
-                    "PARENT_TYPE, WHICH IS" &
-                    INTEGER'IMAGE(PARENT_TYPE'SIZE));
-      ELSIF PARENT_TYPE'SIZE > IDENT_INT (NORMAL_TYPE'SIZE) THEN
-           FAILED ("PARENT_TYPE'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(NORMAL_TYPE'SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(PARENT_TYPE'SIZE));
-      END IF;
- 
-      IF DERIVED_TYPE'SIZE > IDENT_INT (PARENT_TYPE'SIZE) THEN
-           FAILED ("DERIVED_TYPE'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(PARENT_TYPE'SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_TYPE'SIZE));
-      END IF;
- 
-      IF X'SIZE < DERIVED_TYPE'SIZE THEN
-           FAILED ("OBJECT SIZE TOO LARGE.  FIRST VALUE IS " &
-                   ENUM'IMAGE ( X(1) ) );
-      END IF;
- 
-      RESULT;
- 
- END CD1C03B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- CD1C03C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE COLLECTION SIZE OF A DERIVED TYPE IS
- --     INHERITED FROM THE PARENT IF THE COLLECTION SIZE OF
- --     THE PARENT WAS DETERMINED BY A COLLECTION SIZE CLAUSE.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     JET 09/16/87  CREATED ORIGINAL TEST.
- --     RJW 02/10/88  RENAMED FROM CD1C03C.TST.  REMOVED MACRO -
- --                   ACC_SIZE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1C03C IS
- 
-      SPECIFIED_SIZE : CONSTANT := 512;
- 
-      TYPE PARENT_TYPE IS ACCESS STRING;
- 
-      FOR PARENT_TYPE'STORAGE_SIZE USE SPECIFIED_SIZE;
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
- BEGIN
- 
-      TEST("CD1C03C", "CHECK THAT THE COLLECTION  SIZE OF A " &
-                      "DERIVED TYPE IS INHERITED FROM THE PARENT " &
-                      "IF THE COLLECTION SIZE OF THE PARENT WAS " &
-                      "DETERMINED BY A COLLECTION SIZE CLAUSE");
- 
-      IF PARENT_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("PARENT_TYPE'STORAGE_SIZE SHOULD NOT BE " &
-                   "LESS THAN SPECIFIED_SIZE.  " &
-                   "ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(PARENT_TYPE'SIZE));
-      END IF;
- 
-      IF DERIVED_TYPE'STORAGE_SIZE /=
-                          IDENT_INT (PARENT_TYPE'STORAGE_SIZE) THEN
-           FAILED ("DERIVED_TYPE'STORAGE_SIZE SHOULD BE " &
-                   "EQUAL TO PARENT_TYPE'STORAGE_SIZE.  " &
-                   "ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_TYPE'STORAGE_SIZE));
-      END IF;
- 
-      RESULT;
- 
- END CD1C03C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- CD1C03E.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE STORAGE SIZE OF A DERIVED TASK TYPE IS
- --     INHERITED FROM THE PARENT IF THE STORAGE SIZE OF THE
- --     PARENT WAS DETERMINED BY A TASK STORAGE SIZE CLAUSE.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY:
- --     JET 09/16/87  CREATED ORIGINAL TEST.
- --     DHH 03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
- --                   EXTENSION FROM '.DEP' TO '.TST'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1C03E IS
- 
-      SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
-      TASK TYPE PARENT_TYPE IS
-           ENTRY E;
-      END PARENT_TYPE;
- 
-      FOR PARENT_TYPE'STORAGE_SIZE USE SPECIFIED_SIZE;
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      TASK BODY PARENT_TYPE IS
-      BEGIN
-           ACCEPT E DO
-                COMMENT ("ENTRY E ACCEPTED");
-           END E;
-      END PARENT_TYPE;
- 
- BEGIN
- 
-      TEST("CD1C03E", "CHECK THAT THE STORAGE SIZE OF A DERIVED " &
-                      "TASK TYPE IS INHERITED FROM THE PARENT IF " &
-                      "THE STORAGE SIZE OF THE PARENT WAS " &
-                      "DETERMINED BY A TASK STORAGE SIZE CLAUSE");
- 
-      IF PARENT_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("PARENT_TYPE'STORAGE_SIZE SHOULD NOT BE LESS THAN" &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(PARENT_TYPE'STORAGE_SIZE));
-      END IF;
- 
-      IF DERIVED_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DERIVED_TYPE'STORAGE_SIZE SHOULD NOT BE LESS THAN " &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_TYPE'STORAGE_SIZE));
-      END IF;
- 
-      RESULT;
- 
- END CD1C03E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CD1C03F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE VALUE OF 'SMALL FOR A DERIVED FIXED POINT TYPE
- --     IS INHERITED FROM THE PARENT IF THE VALUE OF 'SMALL FOR THE
- --     PARENT WAS DETERMINED BY A 'SMALL SPECIFICATION CLAUSE.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     JET 09/17/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1C03F IS
- 
-      SPECIFIED_SMALL : CONSTANT := 0.25;
- 
-      TYPE FLT IS NEW FLOAT;
- 
-      TYPE PARENT_TYPE IS DELTA 1.0 RANGE 0.0 .. 100.0;
- 
-      FOR PARENT_TYPE'SMALL USE SPECIFIED_SMALL;
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      FUNCTION IDENT_FLT (F : FLT) RETURN FLT IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN F;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END;
- 
- BEGIN
- 
-      TEST("CD1C03F", "CHECK THAT THE VALUE OF 'SMALL FOR A " &
-                      "DERIVED FIXED POINT TYPE IS INHERITED " &
-                      "FROM THE PARENT IF THE VALUE OF 'SMALL " &
-                      "FOR THE PARENT WAS DETERMINED BY A 'SMALL " &
-                      "SPECIFICATION CLAUSE");
- 
-      IF PARENT_TYPE'SMALL /= IDENT_FLT (SPECIFIED_SMALL) THEN
-           FAILED ("PARENT_TYPE'SMALL SHOULD BE EQUAL TO " &
-                   "THE SPECIFIED VALUE");
-      END IF;
- 
-      IF DERIVED_TYPE'SMALL /= IDENT_FLT (SPECIFIED_SMALL) THEN
-           FAILED ("DERIVED_TYPE'SMALL SHOULD BE EQUAL TO " &
-                   "THE SPECIFIED VALUE");
-      END IF;
- 
-      RESULT;
- 
- END CD1C03F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- CD1C03G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE SIZE OF A DERIVED ENUMERATION TYPE IS
- --     INHERITED FROM THE PARENT IF THE SIZE OF THE PARENT WAS
- --     DETERMINED BY AN ENUMERATION REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     JET 09/17/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1C03G IS
- 
-      TYPE NORMAL_TYPE IS (RED, BLUE, GREEN, YELLOW);
- 
-      TYPE PARENT_TYPE IS (RED, BLUE, GREEN, YELLOW);
- 
-      FOR PARENT_TYPE USE
-           (RED => 256, BLUE => 257, GREEN => 258, YELLOW => 259);
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
- BEGIN
- 
-      TEST("CD1C03G", "CHECK THAT THE SIZE OF A DERIVED ENUMERATION " &
-                      "TYPE IS INHERITED FROM THE PARENT IF THE " &
-                      "SIZE OF THE PARENT WAS DETERMINED BY AN " &
-                      "ENUMERATION REPRESENTATION CLAUSE");
- 
-      IF PARENT_TYPE'SIZE = IDENT_INT (NORMAL_TYPE'SIZE) THEN
-           COMMENT ("PARENT_TYPE'SIZE WAS NOT AFFECTED BY THE " &
-                    "REPRESENTATION CLAUSE");
-      END IF;
- 
-      IF DERIVED_TYPE'SIZE /= IDENT_INT (PARENT_TYPE'SIZE) THEN
-           FAILED ("DERIVED_TYPE'SIZE WAS NOT INHERITED FROM " &
-                   "PARENT_TYPE");
-      END IF;
- 
-      RESULT;
- 
- END CD1C03G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- CD1C03H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE RECORD SIZE AND THE COMPONENT POSITIONS AND
- --     SIZES OF A DERIVED RECORD TYPE ARE INHERITED FROM THE
- --     PARENT IF THOSE ASPECTS OF THE PARENT WERE DETERMINED BY A
- --     RECORD REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     JET 09/17/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE CD1C03H IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-           (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-           SYSTEM.STORAGE_UNIT;
- 
-      TYPE E_TYPE IS (RED, BLUE, GREEN);
- 
-      TYPE PARENT_TYPE IS
-           RECORD
-                I : INTEGER RANGE 0 .. 127 := 127;
-                C : CHARACTER := 'S';
-                B : BOOLEAN := FALSE;
-                E : E_TYPE := BLUE;
-           END RECORD;
- 
-      FOR PARENT_TYPE USE
-           RECORD
-                C AT 0 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
-                B AT 1 * UNITS_PER_INTEGER RANGE 0 .. BOOLEAN'SIZE - 1;
-                I AT 2 * UNITS_PER_INTEGER RANGE 0 .. INTEGER'SIZE/2 - 1;
-                E AT 3 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
-           END RECORD;
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      P_REC : PARENT_TYPE;
-      REC   : DERIVED_TYPE;
- 
- BEGIN
- 
-      TEST("CD1C03H", "CHECK THAT THE RECORD SIZE AND THE COMPONENT " &
-                      "POSITIONS AND SIZES OF A DERIVED RECORD " &
-                      "TYPE ARE INHERITED FROM THE PARENT IF THOSE " &
-                      "ASPECTS OF THE PARENT WERE DETERMINED BY " &
-                      "A RECORD REPRESENTATION CLAUSE");
- 
-      IF DERIVED_TYPE'SIZE /= IDENT_INT (PARENT_TYPE'SIZE) THEN
-           FAILED ("DERIVED_TYPE'SIZE WAS NOT INHERITED FROM " &
-                   "PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'SIZE /= P_REC.I'SIZE OR
-         REC.C'SIZE /= P_REC.C'SIZE OR
-         REC.B'SIZE /= P_REC.B'SIZE OR
-         REC.E'SIZE /= P_REC.E'SIZE THEN
-           FAILED ("THE SIZES OF DERIVED_TYPE ELEMENTS WERE NOT " &
-                   "INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      REC := (12, 'T', TRUE, RED);
- 
-      IF (REC.I /= 12) OR (REC.C /= 'T') OR
-         (NOT REC.B) OR (REC.E /= RED) THEN
-           FAILED ("THE VALUES OF DERIVED_TYPE COMPONENTS WERE " &
-                   "INCORRECT");
-      END IF;
- 
-      IF REC.I'POSITION /= P_REC.I'POSITION OR
-         REC.C'POSITION /= P_REC.C'POSITION OR
-         REC.B'POSITION /= P_REC.B'POSITION OR
-         REC.E'POSITION /= P_REC.E'POSITION THEN
-           FAILED ("THE POSITIONS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "NOT INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'FIRST_BIT /= P_REC.I'FIRST_BIT OR
-         REC.C'FIRST_BIT /= P_REC.C'FIRST_BIT OR
-         REC.B'FIRST_BIT /= P_REC.B'FIRST_BIT OR
-         REC.E'FIRST_BIT /= P_REC.E'FIRST_BIT THEN
-           FAILED ("THE FIRST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "NOT INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'LAST_BIT /= P_REC.I'LAST_BIT OR
-         REC.C'LAST_BIT /= P_REC.C'LAST_BIT OR
-         REC.B'LAST_BIT /= P_REC.B'LAST_BIT OR
-         REC.E'LAST_BIT /= P_REC.E'LAST_BIT THEN
-           FAILED ("THE LAST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "NOT INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      RESULT;
- 
- END CD1C03H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- CD1C03I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE RECORD SIZE AND THE COMPONENT POSITIONS AND
- --     SIZES OF A DERIVED RECORD TYPE ARE INHERITED FROM THE
- --     PARENT IF THOSE ASPECTS OF THE PARENT WERE DETERMINED BY THE
- --     PRAGMA PACK.
- 
- -- HISTORY:
- --     JET 09/17/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD1C03I IS
- 
-      TYPE E_TYPE IS (RED, BLUE, GREEN);
- 
-      TYPE PARENT_TYPE IS
-           RECORD
-                B1: BOOLEAN := TRUE;
-                I : INTEGER RANGE 0 .. 127 := 127;
-                C : CHARACTER := 'S';
-                B2: BOOLEAN := FALSE;
-                E : E_TYPE := BLUE;
-           END RECORD;
- 
-      PRAGMA PACK (PARENT_TYPE);
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      P_REC : PARENT_TYPE;
-      REC   : DERIVED_TYPE;
- 
- BEGIN
- 
-      TEST("CD1C03I", "CHECK THAT THE RECORD SIZE AND THE COMPONENT " &
-                      "POSITIONS AND SIZES OF A DERIVED RECORD " &
-                      "TYPE ARE INHERITED FROM THE PARENT IF THOSE " &
-                      "ASPECTS OF THE PARENT WERE DETERMINED BY " &
-                      "THE PRAGMA PACK");
- 
-      IF DERIVED_TYPE'SIZE /= PARENT_TYPE'SIZE THEN
-           FAILED ("DERIVED_TYPE'SIZE WAS NOT INHERITED FROM " &
-                   "PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'SIZE /= P_REC.I'SIZE OR
-         REC.C'SIZE /= P_REC.C'SIZE OR
-         REC.B1'SIZE /= P_REC.B1'SIZE OR
-         REC.B2'SIZE /= P_REC.B2'SIZE OR
-         REC.E'SIZE /= P_REC.E'SIZE THEN
-           FAILED ("THE SIZES OF DERIVED_TYPE ELEMENTS WERE NOT " &
-                   "INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      REC := (FALSE, 12, 'T', TRUE, RED);
- 
-      IF (REC.I /= 12) OR (REC.C /= 'T') OR
-          REC.B1 OR (NOT REC.B2) OR (REC.E /= RED) THEN
-           FAILED ("THE VALUES OF DERIVED_TYPE COMPONENTS WERE " &
-                   "INCORRECT");
-      END IF;
- 
-      IF REC.I'POSITION /= P_REC.I'POSITION OR
-         REC.C'POSITION /= P_REC.C'POSITION OR
-         REC.B1'POSITION /= P_REC.B1'POSITION OR
-         REC.B2'POSITION /= P_REC.B2'POSITION OR
-         REC.E'POSITION /= P_REC.E'POSITION THEN
-           FAILED ("THE POSITIONS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "NOT INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'FIRST_BIT /= P_REC.I'FIRST_BIT OR
-         REC.C'FIRST_BIT /= P_REC.C'FIRST_BIT OR
-         REC.B1'FIRST_BIT /= P_REC.B1'FIRST_BIT OR
-         REC.B2'FIRST_BIT /= P_REC.B2'FIRST_BIT OR
-         REC.E'FIRST_BIT /= P_REC.E'FIRST_BIT THEN
-           FAILED ("THE FIRST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "NOT INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'LAST_BIT /= P_REC.I'LAST_BIT OR
-         REC.C'LAST_BIT /= P_REC.C'LAST_BIT OR
-         REC.B1'LAST_BIT /= P_REC.B1'LAST_BIT OR
-         REC.B2'LAST_BIT /= P_REC.B2'LAST_BIT OR
-         REC.E'LAST_BIT /= P_REC.E'LAST_BIT THEN
-           FAILED ("THE LAST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "NOT INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      RESULT;
- 
- END CD1C03I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- CD1C04A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SIZE CLAUSE CAN BE GIVEN FOR A DERIVED TYPE, A
- --     DERIVED PRIVATE TYPE, AND A DERIVED LIMITED PRIVATE TYPE EVEN
- --     IF THE SIZE IS INHERITED FROM THE PARENT, AND THAT THE SIZE
- --     CLAUSES FOR THE DERIVED TYPES OVERRIDE THE PARENTS'.
- 
- -- HISTORY:
- --     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
- --                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     JET 09/16/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1C04A IS
- 
-      SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
- 
-      TYPE PARENT_TYPE IS RANGE 0 .. 100;
- 
-      FOR PARENT_TYPE'SIZE USE INTEGER'SIZE;
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      FOR DERIVED_TYPE'SIZE USE SPECIFIED_SIZE;
- 
-      PACKAGE P IS
-           TYPE PRIVATE_PARENT IS PRIVATE;
-           TYPE LIM_PRIV_PARENT IS LIMITED PRIVATE;
-      PRIVATE
-           TYPE PRIVATE_PARENT IS RANGE 0 .. 100;
-           FOR PRIVATE_PARENT'SIZE USE INTEGER'SIZE;
-           TYPE LIM_PRIV_PARENT IS RANGE 0 .. 100;
-           FOR LIM_PRIV_PARENT'SIZE USE INTEGER'SIZE;
-      END P;
- 
-      USE P;
- 
-      TYPE DERIVED_PRIVATE_TYPE IS NEW PRIVATE_PARENT;
- 
-      FOR DERIVED_PRIVATE_TYPE'SIZE USE SPECIFIED_SIZE;
- 
-      TYPE DERIVED_LIM_PRIV_TYPE IS NEW LIM_PRIV_PARENT;
- 
-      FOR DERIVED_LIM_PRIV_TYPE'SIZE USE SPECIFIED_SIZE;
- 
-      DT : DERIVED_TYPE := 100;
-      DPT : DERIVED_PRIVATE_TYPE;
-      DLPT : DERIVED_LIM_PRIV_TYPE;
- 
- BEGIN
- 
-      TEST("CD1C04A", "CHECK THAT A SIZE CLAUSE CAN BE GIVEN FOR " &
-                      "A DERIVED TYPE, A DERIVED PRIVATE TYPE, AND " &
-                      "A DERIVED LIMITED PRIVATE TYPE EVEN IF THE " &
-                      "SIZE IS INHERITED FROM THE PARENT, AND THAT " &
-                      "THE SIZE CLAUSES FOR THE DERIVED TYPES " &
-                      "OVERRIDE THE PARENTS'");
- 
-      IF PARENT_TYPE'SIZE /= IDENT_INT (INTEGER'SIZE) THEN
-           FAILED ("PARENT_TYPE'SIZE SHOULD BE " &
-                   INTEGER'IMAGE(INTEGER'SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(PARENT_TYPE'SIZE));
-      END IF;
- 
-      IF DERIVED_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DERIVED_TYPE'SIZE SHOULD BE " &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_TYPE'SIZE));
-      END IF;
- 
-      IF DT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DT'SIZE SHOULD NOT BE LESS THAN" &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DT'SIZE));
-      END IF;
- 
-      IF PRIVATE_PARENT'SIZE < IDENT_INT (INTEGER'SIZE) THEN
-           FAILED ("PRIVATE_PARENT'SIZE SHOULD NOT BE LESS THAN" &
-                   INTEGER'IMAGE(INTEGER'SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(PRIVATE_PARENT'SIZE));
-      END IF;
- 
-      IF DERIVED_PRIVATE_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DERIVED_PRIVATE_TYPE'SIZE SHOULD BE " &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_PRIVATE_TYPE'SIZE));
-      END IF;
- 
-      IF DPT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DPT'SIZE SHOULD NOT BE LESS THAN" &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DPT'SIZE));
-      END IF;
- 
-      IF LIM_PRIV_PARENT'SIZE /= IDENT_INT (INTEGER'SIZE) THEN
-           FAILED ("LIM_PRIV_PARENT'SIZE SHOULD BE" &
-                   INTEGER'IMAGE(INTEGER'SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(LIM_PRIV_PARENT'SIZE));
-      END IF;
- 
-      IF DERIVED_LIM_PRIV_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DERIVED_LIM_PRIV_TYPE'SIZE SHOULD BE " &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_LIM_PRIV_TYPE'SIZE));
-      END IF;
- 
-      IF DLPT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("DLPT'SIZE SHOULD NOT BE LESS THAN" &
-                   INTEGER'IMAGE(SPECIFIED_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DLPT'SIZE));
-      END IF;
- 
-      RESULT;
- 
- END CD1C04A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- CD1C04D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE CAN BE GIVEN
- --     FOR A DERIVED ENUMERATION TYPE EVEN IF THE REPRESENTATION IS
- --     INHERITED FROM THE PARENT, AND THAT THE CLAUSE FOR THE DERIVED
- --     TYPE OVERRIDES THAT OF THE PARENT.
- 
- -- HISTORY:
- --     JET 09/21/87  CREATED ORIGINAL TEST.
- --     DHH 03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                   '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSE.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD1C04D IS
- 
-      TYPE NORMAL_TYPE IS (RED, BLUE, GREEN, YELLOW);
- 
-      TYPE PARENT_TYPE IS (RED, BLUE, GREEN, YELLOW);
- 
-      FOR PARENT_TYPE USE
-           (RED => 256, BLUE => 257, GREEN => 258, YELLOW => 259);
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      FOR DERIVED_TYPE USE
-           (RED => 16, BLUE => 17, GREEN => 18, YELLOW => 19);
- 
-      TYPE INT1 IS RANGE 16 .. 19;
-      FOR INT1'SIZE USE DERIVED_TYPE'SIZE;
- 
-      PROCEDURE CHECK_1 IS NEW ENUM_CHECK(DERIVED_TYPE, INT1);
- 
- BEGIN
- 
-      TEST("CD1C04D", "CHECK THAT AN ENUMERATION REPRESENTATION " &
-                      "CLAUSE CAN BE GIVEN FOR A DERIVED ENUMERATION " &
-                      "TYPE EVEN IF THE REPRESENTATION IS INHERITED " &
-                      "FROM THE PARENT, AND THAT THE CLAUSE FOR THE " &
-                      "DERIVED TYPE OVERRIDES THAT OF THE PARENT");
- 
-      IF PARENT_TYPE'SIZE = IDENT_INT (NORMAL_TYPE'SIZE) THEN
-           COMMENT ("PARENT_TYPE'SIZE WAS NOT AFFECTED BY THE " &
-                    "REPRESENTATION CLAUSE");
-      END IF;
- 
-      IF DERIVED_TYPE'SIZE >= IDENT_INT (PARENT_TYPE'SIZE) THEN
-           COMMENT ("THE SPECIFICATION OF SMALLER VALUES FOR THE " &
-                    "REPRESENTATION OF DERIVED_TYPE DID NOT " &
-                    "REDUCE THE SIZE OF DERIVED_TYPE");
-      END IF;
- 
-      CHECK_1 (DERIVED_TYPE'(GREEN), 18, "DERIVED_TYPE");
- 
-      RESULT;
- 
- END CD1C04D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- CD1C04E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
- --     A DERIVED RECORD TYPE EVEN IF THE REPRESENTATION IS INHERITED
- --     FROM THE PARENT, AND THAT THE REPRESENTATION CLAUSE FOR THE
- --     DERIVED TYPE OVERRIDES THAT OF THE PARENT TYPE.
- 
- -- HISTORY:
- --     PWB 03/25/89  DELETED CHECKS OF COMPONENT'SIZE; CHANGED
- --         EXTENSION FROM '.ADA' TO '.DEP'.
- --     JET 09/21/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM; USE SYSTEM;
- 
- PROCEDURE CD1C04E IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-           (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-           SYSTEM.STORAGE_UNIT;
- 
-      TYPE E_TYPE IS (RED, BLUE, GREEN);
- 
-      TYPE PARENT_TYPE IS
-           RECORD
-                I : INTEGER RANGE 0 .. 127 := 127;
-                C : CHARACTER := 'S';
-                B : BOOLEAN := FALSE;
-                E : E_TYPE := BLUE;
-           END RECORD;
- 
-      FOR PARENT_TYPE USE
-           RECORD
-                C AT 0 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
-                B AT 1 * UNITS_PER_INTEGER RANGE 0 .. BOOLEAN'SIZE - 1;
-                I AT 2 * UNITS_PER_INTEGER RANGE 0 .. INTEGER'SIZE/2 - 1;
-                E AT 3 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
-           END RECORD;
- 
-      TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
- 
-      FOR DERIVED_TYPE USE
-           RECORD
-                C AT 1 * UNITS_PER_INTEGER RANGE 1 .. CHARACTER'SIZE + 1;
-                B AT 3 * UNITS_PER_INTEGER RANGE 1 .. BOOLEAN'SIZE + 1;
-                I AT 5 * UNITS_PER_INTEGER RANGE 1 .. INTEGER'SIZE/2 + 1;
-                E AT 7 * UNITS_PER_INTEGER RANGE 1 .. CHARACTER'SIZE + 1;
-           END RECORD;
- 
-      P_REC : PARENT_TYPE;
-      REC   : DERIVED_TYPE;
- 
- BEGIN
- 
-      TEST("CD1C04E", "CHECK THAT A RECORD REPRESENTATION CLAUSE " &
-                      "CAN BE GIVEN FOR A DERIVED RECORD TYPE EVEN " &
-                      "IF THE REPRESENTATION IS INHERITED FROM " &
-                      "THE PARENT, AND THAT THE REPRESENTATION " &
-                      "CLAUSE FOR THE DERIVED TYPE OVERRIDES THAT " &
-                      "OF THE PARENT TYPE");
- 
-      IF DERIVED_TYPE'SIZE = IDENT_INT (PARENT_TYPE'SIZE) THEN
-           FAILED ("DERIVED_TYPE'SIZE WAS INHERITED FROM " &
-                   "PARENT_TYPE");
-      END IF;
- 
-      REC := (12, 'T', TRUE, RED);
- 
-      IF (REC.I /= 12) OR (REC.C /= 'T') OR
-         (NOT REC.B) OR (REC.E /= RED) THEN
-           FAILED ("THE VALUES OF DERIVED_TYPE COMPONENTS WERE " &
-                   "INCORRECT");
-      END IF;
- 
-      IF REC.I'POSITION = P_REC.I'POSITION OR
-         REC.C'POSITION = P_REC.C'POSITION OR
-         REC.B'POSITION = P_REC.B'POSITION OR
-         REC.E'POSITION = P_REC.E'POSITION THEN
-           FAILED ("THE POSITIONS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'FIRST_BIT = P_REC.I'FIRST_BIT OR
-         REC.C'FIRST_BIT = P_REC.C'FIRST_BIT OR
-         REC.B'FIRST_BIT = P_REC.B'FIRST_BIT OR
-         REC.E'FIRST_BIT = P_REC.E'FIRST_BIT THEN
-           FAILED ("THE FIRST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      IF REC.I'LAST_BIT = P_REC.I'LAST_BIT OR
-         REC.C'LAST_BIT = P_REC.C'LAST_BIT OR
-         REC.B'LAST_BIT = P_REC.B'LAST_BIT OR
-         REC.E'LAST_BIT = P_REC.E'LAST_BIT THEN
-           FAILED ("THE LAST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
-                   "INHERITED FROM PARENT_TYPE");
-      END IF;
- 
-      RESULT;
- 
- END CD1C04E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,100 ****
- -- CD1C06A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE EXPRESSION IN A TASK STORAGE SIZE CLAUSE
- --     IS NOT EVALUATED AGAIN WHEN A DERIVED TYPE INHERITS THE
- --     STORAGE SIZE OF THE PARENT.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY:
- --     JET 09/21/87  CREATED ORIGINAL TEST.
- --     DHH 03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
- --                   EXTENSION FROM '.DEP' TO '.TST'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD1C06A IS
- 
-      I : INTEGER := 0;
- 
-      SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
-      FUNCTION COUNT_SIZE RETURN INTEGER IS
-      BEGIN
-           I := I + 1;
-           RETURN SPECIFIED_SIZE * I;
-      END;
- 
- BEGIN
- 
-      TEST("CD1C06A", "CHECK THAT THE EXPRESSION IN A TASK STORAGE " &
-                      "SIZE CLAUSE IS NOT EVALUATED AGAIN WHEN A " &
-                      "DERIVED TYPE INHERITS THE STORAGE SIZE OF " &
-                      "THE PARENT");
- 
-      DECLARE
- 
-           TASK TYPE PARENT IS
-                ENTRY E;
-           END PARENT;
- 
-           FOR PARENT'STORAGE_SIZE USE COUNT_SIZE;
- 
-           TYPE DERIVED_TYPE IS NEW PARENT;
- 
-           TASK BODY PARENT IS
-           BEGIN
-                ACCEPT E DO
-                     COMMENT ("ENTRY E ACCEPTED");
-                END E;
-           END PARENT;
- 
-      BEGIN
-           IF PARENT'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-                FAILED ("PARENT'STORAGE_SIZE SHOULD NOT BE " &
-                        "LESS THAN" & INTEGER'IMAGE (SPECIFIED_SIZE) &
-                        ".  ACTUAL SIZE IS" &
-                        INTEGER'IMAGE(PARENT'STORAGE_SIZE));
-           END IF;
- 
-           IF DERIVED_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-                FAILED ("DERIVED_TYPE'STORAGE_SIZE SHOULD NOT BE " &
-                        "LESS THAN" & INTEGER'IMAGE(SPECIFIED_SIZE) &
-                        ".  ACTUAL SIZE IS" &
-                        INTEGER'IMAGE(DERIVED_TYPE'STORAGE_SIZE));
-           END IF;
- 
-           IF I > IDENT_INT (1) THEN
-                FAILED ("THE EXPRESSION FOR THE STORAGE SIZE " &
-                        "SPECIFICATION WAS EVALUATED MORE THAN ONCE");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END CD1C06A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd20001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd20001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd20001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd20001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,275 ****
- -- CD20001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that for packed records the components are packed as tightly
- --      as possible subject to the Size of the component subtypes.
- --      Specifically check that Boolean objects are packed one to a bit.
- --
- --      Check that the Component_Size for a packed array type is less than
- --      or equal to the smallest of those factors of the word size that are
- --      greater than or equal to the Size of the component subtype.
- --      
- -- TEST DESCRIPTION:
- --      This test defines and packs several types, and checks that the sizes
- --      of the resulting objects is as expected.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as
- --        inapplicable.  Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      08 MAY 96   SAIC   Strengthened for 2.1
- --      29 JAN 98   EDS    Deleted check that Component_Size is really a
- --                         factor of Word_Size.
- --!
- 
- ----------------------------------------------------------------- CD20001_0
- 
- with System;
- package CD20001_0 is
- 
-   type Wordlong_Bool_Array is array(1..System.Word_Size) of Boolean;
-     pragma Pack(Wordlong_Bool_Array);                         -- ANX-C RQMT
- 
-   type Def_Rep_Components is range 0..2**(System.Storage_Unit-2);
- 
-   type Spec_Rep_Components is range 0..2**(System.Storage_Unit-2);
-     for Spec_Rep_Components'Size use System.Storage_Unit;     -- ANX-C RQMT
- 
-   type Packed_Array_Def_Components is array(1..32) of Def_Rep_Components;
-     pragma Pack(Packed_Array_Def_Components);                 -- ANX-C RQMT
- 
-   type Packed_Array_Spec_Components is array(1..32) of Spec_Rep_Components;
-     pragma Pack(Packed_Array_Spec_Components);                -- ANX-C RQMT
- 
-   procedure TC_Check_Values;
- 
- end CD20001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body CD20001_0 is
- 
-   procedure TC_Check_Values is
-     My_Word      : Wordlong_Bool_Array := (others => False);
- 
-     Cited_Unit   : Spec_Rep_Components := 0;
- 
-     Packed_Array : Packed_Array_Def_Components := (others => 0);
- 
-     Cited_Packed : Packed_Array_Spec_Components := (others => 0);
- 
-   begin
-     TCTouch.Assert( My_Word'Size = System.Word_Size,
-        "pragma Pack on array of Booleans does not pack one Boolean per bit" );
- 
-     TCTouch.Assert( My_Word'Component_Size = 1,
-                     "size of Boolean array component not 1 bit");
- 
-     TCTouch.Assert( Cited_Unit'Size = System.Storage_Unit,
-                     "Object specified to be Storage_Unit bits not " &
-                     "Storage_Unit bits in size");
- 
-     TCTouch.Assert( Packed_Array'Component_Size <= System.Storage_Unit,
-                     "Packed array component expected to be less than or " &
-                     "equal to Storage_Unit bits in size is greater than " &
-                     "Storage_Unit bits in size");
- 
-     TCTouch.Assert( Cited_Packed'Component_Size = System.Storage_Unit,
-                     "Array component specified to be Storage_Unit " &
-                     "bits not Storage_Unit bits in size");
- 
-   end TC_Check_Values;
- 
- end CD20001_0;
- 
- ----------------------------------------------------------------- CD20001_1
- 
- with System;
- package CD20001_1 is
- 
-   type Bits_2  is range 0..2**2-1;
-     for Bits_2'Size use 2;                                    -- ANX-C RQMT
- 
-   type Bits_3  is range 0..2**3-1;
-     for Bits_3'Size use 3;                                    -- ANX-C RQMT
- 
-   type Bits_7  is range 0..2**7-1;
-     for Bits_7'Size use 7;                                    -- ANX-C RQMT
- 
-   type Bits_8  is range 0..2**8-1;
-     for Bits_8'Size use 8;                                    -- ANX-C RQMT
- 
-   type Bits_9  is range 0..2**9-1;
-     for Bits_9'Size use 9;                                    -- ANX-C RQMT
- 
-   type Bits_15 is range 0..2**15-1;
-     for Bits_15'Size use 15;                                  -- ANX-C RQMT
- 
-   type Pact_Aray_2  is array(0..31) of Bits_2;
-     pragma Pack( Pact_Aray_2 );                               -- ANX-C RQMT
- 
-   type Pact_Aray_3  is array(0..31) of Bits_3;
-     pragma Pack( Pact_Aray_3 );                               -- ANX-C RQMT
- 
-   type Pact_Aray_7  is array(0..31) of Bits_7;
-     pragma Pack( Pact_Aray_7 );                               -- ANX-C RQMT
- 
-   type Pact_Aray_8  is array(0..31) of Bits_8;
-     pragma Pack( Pact_Aray_8 );                               -- ANX-C RQMT
- 
-   type Pact_Aray_9  is array(0..31) of Bits_9;
-     pragma Pack( Pact_Aray_9 );                               -- ANX-C RQMT
- 
-   type Pact_Aray_15 is array(0..31) of Bits_15;
-     pragma Pack( Pact_Aray_15 );                              -- ANX-C RQMT
- 
- 
-   procedure TC_Check_Values;
- 
- end CD20001_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with TCTouch;
- package body CD20001_1 is
- 
-    function Next_Factor ( Value : Positive ) return Integer is
-    -- Returns the factor of Word_Size that is next larger than Value.
-    -- If Value is greater than Word_Size, then returns Word_Size.
-      Test   : Integer := Value;
-      Found  : Boolean := False;
-   begin  -- Next_Factor
-      while not Found and Test <= System.Word_Size loop
-        if System.Word_Size mod Test = 0 then
-           Found := True;
-        else
-           Test := Test + 1;
-        end if;
-      end loop;
-      if Found then
-         return Test;
-      else
-         return System.Word_Size;
-      end if;
-   end Next_Factor;
- 
-   procedure TC_Check_Values is
-   begin
-   
-     if Pact_Aray_2'Component_Size > Next_Factor ( Bits_2'Size ) then
-        Report.Failed
-           ( "2 bit element Packed Array'Component_Size too big" );
-     end if;
- 
-     TCTouch.Assert( Pact_Aray_2'Component_Size <= Pact_Aray_2'Size,
-                     "2 bit Component_Size greater than array size" );
- 
-     if Pact_Aray_3'Component_Size > Next_Factor ( Bits_3'Size ) then
-        Report.Failed
-           ( "3 bit element Packed Array'Component_Size too big" );
-     end if;
- 
-     TCTouch.Assert( Pact_Aray_3'Component_Size <= Pact_Aray_3'Size,
-                     "3 bit Component_Size greater than array size" );
- 
-     if Pact_Aray_7'Component_Size > Next_Factor ( Bits_7'Size ) then
-        Report.Failed
-           ( "7 bit element Packed Array'Component_Size too big" );
-     end if;
- 
-     TCTouch.Assert( Pact_Aray_7'Component_Size <= Pact_Aray_7'Size,
-                     "7 bit Component_Size greater than array size" );
- 
-     if Pact_Aray_8'Component_Size > Next_Factor ( Bits_8'Size ) then
-        Report.Failed
-           ( "8 bit element Packed Array'Component_Size too big" );
-     end if;
- 
-     TCTouch.Assert( Pact_Aray_8'Component_Size <= Pact_Aray_8'Size,
-                     "8 bit Component_Size greater than array size" );
- 
-     if System.Word_Size > 8 then
- 
-       if Pact_Aray_9'Component_Size > Next_Factor ( Bits_9'Size ) then
-          Report.Failed
-             ( "9 bit element Packed Array'Component_Size too big" );
-       end if;
- 
-       TCTouch.Assert( Pact_Aray_9'Component_Size <= Pact_Aray_9'Size,
-                     "9 bit Component_Size greater than array size" );
- 
-       if Pact_Aray_15'Component_Size > Next_Factor ( Bits_15'Size ) then
-          Report.Failed
-             ( "15 bit element Packed Array'Component_Size too big" );
-       end if;
- 
-       TCTouch.Assert( Pact_Aray_15'Component_Size <= Pact_Aray_15'Size,
-                     "15 bit Component_Size greater than array size" );
- 
-     end if;
- 
-   end TC_Check_Values;
- 
- end CD20001_1;
- 
- ------------------------------------------------------------------- CD20001
- 
- with Report;
- with CD20001_0;
- with CD20001_1;
- 
- procedure CD20001 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD20001", "Check that packed records are packed as tightly " &
-                           "as possible.  Check that Boolean objects are " &
-                           "packed one to a bit. " &
-                           "Check that the Component_Size for a packed " &
-                           "array type is the value which is less than or " &
-                           "equal to the Size of the component type, " &
-                           "rounded up to the nearest factor of word_size" );
-    
-   CD20001_0.TC_Check_Values;
- 
-   CD20001_1.TC_Check_Values;
- 
-   Report.Result;
- 
- end CD20001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- CD2A21A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
- --     ENUMERATION TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 07/28/87 CREATED ORIGINAL TEST.
- --     DHH 04/17/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
- --                  REPRESENTATION CLAUSE.
- --     JRL 03/26/92 ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                    -- CONTAINS A CALLED TO 'FAILED'.
- PROCEDURE CD2A21A IS
- 
-      BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
- 
-      TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
- 
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
-      C0 : CHECK_TYPE := ZERO;
-      C1 : CHECK_TYPE := ONE;
-      C2 : CHECK_TYPE := TWO;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
- 
-      TYPE REC_TYPE IS RECORD
-           COMP0 : CHECK_TYPE := ZERO;
-           COMP1 : CHECK_TYPE := ONE;
-           COMP2 : CHECK_TYPE := TWO;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
- 
-      FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN CH;
-           ELSE
-                RETURN ONE;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
-                      CIO1, CIO2 : IN OUT CHECK_TYPE;
-                      CO2        :    OUT CHECK_TYPE) IS
-      BEGIN
-           IF NOT ((CI0 <  IDENT (ONE))                          AND
-                   (IDENT (CI2)  > IDENT (CIO1))                 AND
-                   (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
-                        "- 1");
-           END IF;
- 
-           IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
-              CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
-              CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
-           END IF;
- 
-           IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
-              CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
-           END IF;
- 
-           IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
-              CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
-              CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
-           END IF;
- 
-           CO2 := TWO;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A21A", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
-                       "GIVEN FOR AN ENUMERATION TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
-                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      PROC (ZERO, TWO, C1, C2, C2);
-      CHECK_1 (TWO, INTEGER'SIZE/2, "CHECK_TYPE");
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR C0'SIZE");
-      END IF;
- 
-      IF NOT ((IDENT (C1) IN C1 .. C2)       AND
-              (C0 NOT IN IDENT (ONE) .. C2)) THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
-         CHECK_TYPE'VAL (1) /= IDENT (C1) OR
-         CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
-         CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
-         CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
-         CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
-      END IF;
- 
-      IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
-      END IF;
- 
-      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
-              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
-              (CHARRAY (1) <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHARRAY (2)))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
-              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
-      END IF;
- 
-      IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
-      END IF;
- 
-      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
-              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
-              (CHREC.COMP1 <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHREC.COMP2))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
-              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
-      END IF;
- 
-      RESULT;
- END CD2A21A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- CD2A21C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SIZE SPECIFICATION CAN BE GIVEN FOR AN ENUMERATION
- --     TYPE:
- --          IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
- --            DECLARED IN THE VISIBLE PART;
- --          FOR A DERIVED ENUMERATION TYPE;
- --          FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
- --            AN ENUMERATION TYPE.
- 
- -- HISTORY:
- --     PWB 06/17/87  CREATED ORIGINAL TEST.
- --     DHH 04/17/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
- --                   REPRESENTATION CLAUSE.
- --     JRL 03/26/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A21C IS
- 
-      TYPE BASIC_ENUM IS (A, B, C, D, E);
-      SPECIFIED_SIZE : CONSTANT := BASIC_ENUM'SIZE;
- 
-      MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
- 
-      TYPE DERIVED_ENUM IS NEW BASIC_ENUM;
-      FOR DERIVED_ENUM'SIZE USE SPECIFIED_SIZE;
- 
-      PACKAGE P IS
-           TYPE ENUM_IN_P IS (A1, B1, C1, D1, E1, F1, G1);
-           FOR ENUM_IN_P'SIZE USE SPECIFIED_SIZE;
-           TYPE PRIVATE_ENUM IS PRIVATE;
-           TYPE ALT_ENUM_IN_P IS (A2, B2, C2, D2, E2, F2, G2);
-      PRIVATE
-           TYPE PRIVATE_ENUM IS (A3, B3, C3, D3, E3, F3, G3);
-           FOR ALT_ENUM_IN_P'SIZE USE SPECIFIED_SIZE;
-      END P;
- 
-      TYPE DERIVED_PRIVATE_ENUM IS NEW P.PRIVATE_ENUM;
-      FOR DERIVED_PRIVATE_ENUM'SIZE USE SPECIFIED_SIZE;
- 
-      USE P;
- 
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (DERIVED_ENUM);
-      PROCEDURE CHECK_2 IS NEW LENGTH_CHECK (ENUM_IN_P);
-      PROCEDURE CHECK_3 IS NEW LENGTH_CHECK (ALT_ENUM_IN_P);
- 
- BEGIN
- 
-      TEST("CD2A21C", "CHECK THAT 'SIZE SPECIFICATIONS CAN BE GIVEN " &
-                      "IN THE VISIBLE OR PRIVATE PART OF A PACKAGE " &
-                      "FOR ENUMERATION TYPES DECLARED IN THE VISIBLE " &
-                      "PART, AND FOR DERIVED ENUMERATION " &
-                      "TYPES AND DERIVED PRIVATE TYPES WHOSE FULL " &
-                      "DECLARATIONS ARE AS ENUMERATION TYPES");
- 
-      CHECK_1 (C,  SPECIFIED_SIZE, "DERIVED_ENUM");
-      CHECK_2 (C1, SPECIFIED_SIZE, "ENUM_IN_P");
-      CHECK_3 (C2, SPECIFIED_SIZE, "ALT_ENUM_IN_P");
- 
-      IF DERIVED_ENUM'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("DERIVED_ENUM'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_ENUM'SIZE));
-      END IF;
- 
-      IF ENUM_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("ENUM_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(ENUM_IN_P'SIZE));
-      END IF;
- 
-      IF ALT_ENUM_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("ALT_ENUM_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(ALT_ENUM_IN_P'SIZE));
-      END IF;
- 
-      IF DERIVED_PRIVATE_ENUM'SIZE /= MINIMUM_SIZE THEN
- 
-           FAILED ("DERIVED_PRIVATE_ENUM'SIZE SHOULD NOT BE GREATER " &
-                   "THAN " & INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_PRIVATE_ENUM'SIZE));
-      END IF;
- 
-      RESULT;
- 
- END CD2A21C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- CD2A21E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
- --     ENUMERATION TYPE, THEN SUCH A TYPE CAN
- --     BE PASSED AS AN ACTUAL PARAMETER TO A GENERIC PROCEDURE.
- 
- -- HISTORY:
- --     JET 08/18/87 CREATED ORIGINAL TEST.
- --     DHH 04/17/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
- --                  REPRESENTATION CLAUSE.
- --     BCB 03/05/90 ADDED CALL TO LENGTH_CHECK TO VERIFY THAT THE SIZE
- --                  SPECIFICATION IS OBEYED.
- --     LDC 10/03/90 ADDED CASES FOR >=, /=, ASSIGNMENT, QUALIFICATION, 
- --                  AND EXPLICIT CONVERSION.
- --     JRL 03/26/92 ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A21E IS
- 
-      TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
-      BASIC_SIZE : CONSTANT := INTEGER'SIZE / 2;
- 
-      FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
- 
- BEGIN
-      TEST ("CD2A21E", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
-                       "GIVEN FOR AN ENUMERATION TYPE, " &
-                       "THEN SUCH A TYPE CAN BE " &
-                       "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " &
-                       "PROCEDURE");
- 
-      DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS (<>);
-           PROCEDURE GENPROC (C0, C1, C2: GPARM);
- 
-           PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
- 
-                SUBTYPE CHECK_TYPE IS GPARM;
- 
-                C3 : GPARM;
- 
-                CHECKVAR : CHECK_TYPE;
- 
-                PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
- 
-                FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN CH;
-                     ELSE
-                          RETURN C1;
-                     END IF;
-                END IDENT;
- 
-           BEGIN -- GENPROC.
- 
-                CHECKVAR := IDENT (C0);
- 
-                CHECK_1 (CHECKVAR, CHECK_TYPE'SIZE, "CHECK_TYPE");
- 
-                IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-                END IF;
- 
-                IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR C0'SIZE");
-                END IF;
- 
-                IF NOT ((IDENT (C1) IN C1 .. C2)       AND
-                        (IDENT(C0) NOT IN IDENT (C1) .. C2)) THEN
-                     FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                             "OPERATORS");
-                END IF;
- 
-                IF CHECK_TYPE'LAST /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
-                END IF;
- 
-                IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
-                   CHECK_TYPE'VAL (1) /= IDENT (C1) OR
-                   CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL");
-                END IF;
- 
-                IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
-                   CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
-                END IF;
- 
-                IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
-                   CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
-                   CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE");
-                END IF;
- 
-                CHECKVAR := CHECK_TYPE'VALUE ("ONE");
-                C3 := GPARM(CHECKVAR);
-                IF C3 /= IDENT(C1) THEN 
-                     FAILED ("INCORRECT VALUE FOR CONVERSION");
-                END IF;
- 
-                CHECK_1 (IDENT(C0), BASIC_SIZE, "CHECK_ENUM");
- 
- 
-                IF CHECK_TYPE'(C2) /= IDENT(C2) THEN 
-                     FAILED ("INCORRECT VALUE FOR QUALIFICATION");
-                END IF;
- 
-                C3 := CHECK_TYPE'VALUE ("TWO");
-                IF C3 /= IDENT(C2) THEN 
-                     FAILED ("INCORRECT VALUE FOR ASSIGNMENT");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
- 
-      BEGIN
- 
-           NEWPROC (ZERO, ONE, TWO);
- 
-      END;
- 
-      RESULT;
- 
- END CD2A21E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,213 ****
- -- CD2A22A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- 
- --     CHECK THAT IF A SIZE SPECIFICATION INDICATING THE SMALLEST SIZE
- --     APPROPRIATE FOR A SIGNED REPRESENTATION IS GIVEN FOR AN
- --     ENUMERATION TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 07/28/87 CREATED ORIGINAL TEST.
- --     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A22A IS
- 
-      BASIC_SIZE : CONSTANT := 3;
- 
-      TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
- 
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
-      C0 : CHECK_TYPE := ZERO;
-      C1 : CHECK_TYPE := ONE;
-      C2 : CHECK_TYPE := TWO;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
- 
-      TYPE REC_TYPE IS RECORD
-           COMP0 : CHECK_TYPE := ZERO;
-           COMP1 : CHECK_TYPE := ONE;
-           COMP2 : CHECK_TYPE := TWO;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN CH;
-           ELSE
-                RETURN ONE;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
-                      CIO1, CIO2 : IN OUT CHECK_TYPE;
-                      CO2        :    OUT CHECK_TYPE) IS
-      BEGIN
-           IF NOT ((CI0 <  IDENT (ONE))                          AND
-                   (IDENT (CI2)  > IDENT (CIO1))                 AND
-                   (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
-                        "- 1");
-           END IF;
- 
-           IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
-              CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
-              CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
-           END IF;
- 
-           IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
-              CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
-           END IF;
- 
-           IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
-              CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
-              CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
-           END IF;
- 
-           CO2 := TWO;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A22A", "CHECK THAT IF A SIZE SPECIFICATION " &
-                       "INDICATING THE SMALLEST SIZE APPROPRIATE " &
-                       "FOR A SIGNED REPRESENTATION IS GIVEN " &
-                       "FOR AN ENUMERATION TYPE, THEN OPERATIONS " &
-                       "ON VALUES OF SUCH A TYPE ARE NOT AFFECTED " &
-                       "BY THE REPRESENTATION CLAUSE");
- 
-      PROC (ZERO, TWO, C1, C2, C2);
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR C0'SIZE");
-      END IF;
- 
-      IF NOT ((IDENT (C1) IN C1 .. C2)       AND
-              (C0 NOT IN IDENT (ONE) .. C2)) THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
-         CHECK_TYPE'VAL (1) /= IDENT (C1) OR
-         CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
-         CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
-         CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
-         CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
-      END IF;
- 
-      IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
-      END IF;
- 
-      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
-              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
-              (CHARRAY (1) <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHARRAY (2)))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
-              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
-      END IF;
- 
-      IF CHREC.COMP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMP1'SIZE");
-      END IF;
- 
-      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
-              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
-              (CHREC.COMP1 <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHREC.COMP2))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
-              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
-      END IF;
- 
-      RESULT;
- END CD2A22A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- CD2A22E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- 
- --     CHECK THAT IF A SIZE CLAUSE SPECIFYING THE SMALLEST SIZE
- --     APPROPRIATE FOR AN UNSIGNED REPRESENTATION IS GIVEN FOR AN
- --     ENUMERATION TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     JET 08/12/87 CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A22E IS
- 
-      BASIC_SIZE : CONSTANT := 2;
- 
-      TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
- 
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
-      C0 : CHECK_TYPE := ZERO;
-      C1 : CHECK_TYPE := ONE;
-      C2 : CHECK_TYPE := TWO;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
- 
-      TYPE REC_TYPE IS RECORD
-           COMP0 : CHECK_TYPE := ZERO;
-           COMP1 : CHECK_TYPE := ONE;
-           COMP2 : CHECK_TYPE := TWO;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN CH;
-           ELSE
-                RETURN ONE;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
-                      CIO1, CIO2 : IN OUT CHECK_TYPE;
-                      CO2        :    OUT CHECK_TYPE) IS
-      BEGIN
-           IF CIO1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                FAILED ("INCORRECT VALUE FOR CIO1'SIZE");
-           END IF;
- 
-           IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2)    AND
-                   (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " &
-                        "- 1");
-           END IF;
- 
-           IF CHECK_TYPE'VAL (0) /= IDENT (CI0)  OR
-              CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR
-              CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1");
-           END IF;
- 
-           IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0)  OR
-              CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1");
-           END IF;
- 
-           IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0)   OR
-              CHECK_TYPE'VALUE ("ONE")  /=  IDENT (CIO1) OR
-              CHECK_TYPE'VALUE ("TWO")  /=  IDENT (CIO2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1");
-           END IF;
- 
-           CO2 := TWO;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A22E", "CHECK THAT IF A SIZE CLAUSE " &
-                       "SPECIFYING THE SMALLEST SIZE APPROPRIATE " &
-                       "FOR AN UNSIGNED REPRESENTATION IS GIVEN " &
-                       "FOR AN ENUMERATION TYPE, THEN OPERATIONS " &
-                       "ON VALUES OF SUCH A TYPE ARE NOT AFFECTED " &
-                       "BY THE REPRESENTATION CLAUSE");
- 
-      PROC (ZERO, TWO, C1, C2, C2);
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR C0'SIZE");
-      END IF;
- 
-      IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
-              (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
-      END IF;
- 
-      IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
-         CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
-      END IF;
- 
-      IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
-      END IF;
- 
-      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
-              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
-              (CHARRAY (1) <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHARRAY (2)))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
-              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
-      END IF;
- 
-      IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
-      END IF;
- 
-      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
-              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
-              (CHREC.COMP1 <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHREC.COMP2))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
-              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
-      END IF;
- 
-      RESULT;
- END CD2A22E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- CD2A22I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A SIZE CLAUSE SPECIFIES THE SMALLEST APPROPRIATE
- --     SIZE FOR A SIGNED REPRESENTATION FOR AN ENUMERATION TYPE,
- --     THEN THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN AN
- --     INSTANTIATION.
- 
- -- HISTORY:
- --     JET 08/13/87 CREATED ORIGINAL TEST.
- --     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A22I IS
- 
-      TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
-      BASIC_SIZE : CONSTANT := 3;
- 
-      FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
- 
- BEGIN
-      TEST ("CD2A22I", "CHECK THAT IF A SIZE CLAUSE SPECIFIES THE " &
-                       "SMALLEST APPROPRIATE SIZE FOR A SIGNED " &
-                       "REPRESENTATION FOR AN ENUMERATION TYPE, THEN " &
-                       "THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN " &
-                       "AN INSTANTIATION");
- 
- 
-      DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS (<>);
-           PROCEDURE GENPROC (C0, C1, C2: GPARM);
- 
-           PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
- 
-                SUBTYPE CHECK_TYPE IS GPARM;
- 
-                FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN CH;
-                     ELSE
-                          RETURN C1;
-                     END IF;
-                END IDENT;
- 
-           BEGIN -- GENPROC.
- 
-                IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-                END IF;
- 
-                IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR C0'SIZE");
-                END IF;
- 
-                IF NOT ((IDENT (C1) IN C1 .. C2)       AND
-                        (C0 NOT IN IDENT (C1) .. C2)) THEN
-                     FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                             "OPERATORS");
-                END IF;
- 
-                IF CHECK_TYPE'LAST /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
-                END IF;
- 
-                IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
-                   CHECK_TYPE'VAL (1) /= IDENT (C1) OR
-                   CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL");
-                END IF;
- 
-                IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
-                   CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
-                END IF;
- 
-                IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
-                   CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
-                   CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
- 
-      BEGIN
- 
-           NEWPROC (ZERO, ONE, TWO);
- 
-      END;
- 
-      RESULT;
- 
- END CD2A22I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- CD2A22J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
- --     ENUMERATION TYPE, THEN SUCH A TYPE OF THE SMALLEST APPROPRIATE
- --     UNSIGNED SIZE CAN BE PASSED AS AN ACTUAL PARAMETER TO A GENERIC
- --     PROCEDURE.
- 
- -- HISTORY:
- --     JET 08/13/87 CREATED ORIGINAL TEST.
- --     DHH 04/17/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
- --                  REPRESENTATION CLAUSE.
- --     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A22J IS
- 
-      TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
-      BASIC_SIZE : CONSTANT := 2;
- 
-      FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
- 
- BEGIN
-      TEST ("CD2A22J", "CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN " &
-                       "FOR AN ENUMERATION TYPE, THEN SUCH A TYPE OF " &
-                       "THE SMALLEST APPROPRIATE UNSIGNED SIZE CAN BE " &
-                       "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " &
-                       "PROCEDURE");
- 
-      DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS (<>);
-           PROCEDURE GENPROC (C0, C1, C2: GPARM);
- 
-           PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
- 
-                SUBTYPE CHECK_TYPE IS GPARM;
- 
-                FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN CH;
-                     ELSE
-                          RETURN C1;
-                     END IF;
-                END IDENT;
- 
-                PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
- 
-           BEGIN -- GENPROC.
-                CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
- 
-                IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-                END IF;
- 
-                IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR C0'SIZE");
-                END IF;
- 
-                IF NOT ((C0 <  IDENT (C1)) AND
-                        (IDENT (C2)  > IDENT (C1)) AND
-                        (C1 <= IDENT (C1)) AND (IDENT (C2) = C2)) THEN
-                     FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                             "OPERATORS");
-                END IF;
- 
-                IF CHECK_TYPE'FIRST /= IDENT (C0) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
-                END IF;
- 
-                IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
-                   CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
-                   CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS");
-                END IF;
- 
-                IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
-                   CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC");
-                END IF;
- 
-                IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
-                   CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
-                   CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
- 
-      BEGIN
- 
-           NEWPROC (ZERO, ONE, TWO);
- 
-      END;
- 
-      RESULT;
- END CD2A22J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,221 ****
- -- CD2A23A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION AND AN ENUMERATION
- --     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
- --     THEN OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT AFFECTED
- --     BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 07/28/87 CREATED ORIGINAL TEST.
- --     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
- --                  REPRESENTATION CLAUSE.
- --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
- 
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A23A IS
- 
-      BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
- 
-      TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
- 
-      FOR CHECK_TYPE USE (ZERO => 3, ONE => 4, TWO => 5);
- 
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
-      C0 : CHECK_TYPE := ZERO;
-      C1 : CHECK_TYPE := ONE;
-      C2 : CHECK_TYPE := TWO;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
- 
-      TYPE REC_TYPE IS RECORD
-           COMP0 : CHECK_TYPE := ZERO;
-           COMP1 : CHECK_TYPE := ONE;
-           COMP2 : CHECK_TYPE := TWO;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN CH;
-           ELSE
-                RETURN ONE;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
- 
-      PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
-                      CIO1, CIO2 : IN OUT CHECK_TYPE;
-                      CO2        :    OUT CHECK_TYPE) IS
-      BEGIN
-           IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2)    AND
-                   (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " &
-                        "- 1");
-           END IF;
- 
-           IF CHECK_TYPE'VAL (0) /= IDENT (CI0)  OR
-              CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR
-              CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1");
-           END IF;
- 
-           IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0)  OR
-              CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1");
-           END IF;
- 
-           IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0)   OR
-              CHECK_TYPE'VALUE ("ONE")  /=  IDENT (CIO1) OR
-              CHECK_TYPE'VALUE ("TWO")  /=  IDENT (CIO2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1");
-           END IF;
- 
-           CO2 := TWO;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A23A", "CHECK THAT WHEN A SIZE SPECIFICATION AND " &
-                       "AN ENUMERATION REPRESENTATION CLAUSE ARE " &
-                       "GIVEN FOR AN ENUMERATION TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
-                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
-      PROC (ZERO, TWO, C1, C2, C2);
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR C0'SIZE");
-      END IF;
- 
-      IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
-              (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
-      END IF;
- 
-      IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
-         CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
-      END IF;
- 
-      IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
-      END IF;
- 
-      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
-              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
-              (CHARRAY (1) <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHARRAY (2)))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
-              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
-      END IF;
- 
-      IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
-      END IF;
- 
-      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
-              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
-              (CHREC.COMP1 <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHREC.COMP2))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
-              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
-      END IF;
- 
- 
-      RESULT;
- 
- END CD2A23A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- CD2A23E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION AND AN ENUMERATION
- --     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
- --     THEN SUCH A TYPE CAN BE PASSED AS AN ACTUAL PARAMETER TO A
- --     GENERIC PROCEDURE.
- 
- -- HISTORY:
- --     JET 08/18/87 CREATED ORIGINAL TEST.
- --     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
- --                  REPRESENTATION CLAUSE.
- --     BCB 03/05/90 ADDED CALL TO LENGTH_CHECK TO VERIFY THAT THE SIZE
- --                  SPECIFICATION IS OBEYED.
- --     LDC 10/03/90 ADDED EXCEPTION HANDER FOR CHECK OF 'SUCC, 'PRED,
- --                  ADDED CASES FOR >=, /=, ASSIGNMENT, QUALIFICATION, 
- --                  AND EXPLICIT CONVERSION.
- --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
- 
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A23E IS
- 
-      TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
-      BASIC_SIZE : CONSTANT := 8;
- 
-      FOR BASIC_ENUM USE (ZERO => 3, ONE => 4, TWO => 5);
-      FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
- 
- BEGIN
-      TEST ("CD2A23E", "CHECK THAT WHEN A SIZE SPECIFICATION AND AN " &
-                       "ENUMERATION REPRESENTATION CLAUSE ARE " &
-                       "GIVEN FOR AN ENUMERATION TYPE, " &
-                       "THEN SUCH A TYPE CAN BE " &
-                       "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " &
-                       "PROCEDURE");
- 
-      DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS (<>);
-           PROCEDURE GENPROC (C0, C1, C2: GPARM);
- 
-           PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
- 
-                SUBTYPE CHECK_TYPE IS GPARM;
- 
-                C3 : GPARM;
- 
-                CHECKVAR : CHECK_TYPE;
- 
-                FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN CH;
-                     ELSE
-                          RETURN C1;
-                     END IF;
-                END IDENT;
- 
-                PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
- 
- 
-           BEGIN -- GENPROC.
- 
-                CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
- 
-                CHECKVAR := IDENT (C0);
- 
-                CHECK_1 (CHECKVAR, CHECK_TYPE'SIZE, "CHECK_TYPE");
- 
-                IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-                END IF;
- 
-                IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR C0'SIZE");
-                END IF;
- 
-                IF NOT ((IDENT(C0) <  IDENT (C1)) AND
-                        (IDENT(C2) >  IDENT (C1)) AND
-                        (IDENT(C1) <= IDENT (C1)) AND 
-                        (IDENT(C2) =  IDENT (C2))) THEN
-                     FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                             "OPERATORS");
-                END IF;
- 
-                IF CHECK_TYPE'FIRST /= IDENT (C0) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
-                END IF;
- 
-                IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
-                   CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
-                   CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS");
-                END IF;
- 
-                IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
-                   CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC");
-                END IF;
- 
-                BEGIN
-                     IF CHECK_TYPE'SUCC (IDENT(C2)) /= IDENT (C1) THEN
-                          FAILED ("CONSTRAINT ERROR NOT RAISED FOR " &
-                                  "CHECK_TYPE'SUCC");
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          IF 3 /= IDENT_INT(3) THEN
-                               COMMENT ("DON'T OPTIMIZE EXCEPTION -1");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED FOR " &
-                                  "CHECK_TYPE'SUCC");
-                END;
- 
-                BEGIN
-                     IF CHECK_TYPE'PRED(IDENT(C0)) /= IDENT (C1) THEN
-                         FAILED ("CONSTRAINT ERROR NOT RAISED FOR " &
-                                  "CHECK_TYPE'PRED");
-                     END IF;
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          IF 3 /= IDENT_INT(3) THEN
-                               COMMENT ("DON'T OPTIMIZE EXCEPTION -2");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED FOR " &
-                                  "CHECK_TYPE'PRED");
-                END;
- 
-                IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
-                   CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
-                END IF;
- 
-                IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
-                   CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
-                   CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE");
-                END IF;
- 
-                CHECKVAR := CHECK_TYPE'VALUE ("ONE");
-                C3 := GPARM(CHECKVAR);
-                IF C3 /= IDENT(C1) THEN 
-                     FAILED ("INCORRECT VALUE FOR CONVERSION");
-                END IF;
- 
-                CHECK_1 (IDENT(C0), BASIC_SIZE, "CHECK_ENUM");
- 
- 
-                IF CHECK_TYPE'(C2) /= IDENT(C2) THEN 
-                     FAILED ("INCORRECT VALUE FOR QUALIFICATION");
-                END IF;
- 
-                C3 := CHECK_TYPE'VALUE ("TWO");
-                IF C3 /= IDENT(C2) THEN 
-                     FAILED ("INCORRECT VALUE FOR ASSIGNMENT");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
- 
-      BEGIN
- 
-           NEWPROC (ZERO, ONE, TWO);
- 
-      END;
- 
-      RESULT;
- 
- END CD2A23E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,226 ****
- -- CD2A24A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION AND AN ENUMERATION
- --     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
- --     THEN OPERATIONS ON VALUES OF SUCH A TYPE WITH THE SMALLEST
- --     APPROPRIATE SIGNED SIZE ARE NOT AFFECTED BY THE
- --     REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     JET 08/19/87 CREATED ORIGINAL TEST.
- --     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
- --                  REPRESENTATION CLAUSE.
- --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A24A IS
- 
-      BASIC_SIZE : CONSTANT := 4;
- 
-      TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
- 
-      FOR CHECK_TYPE USE (ZERO => 3, ONE => 4, TWO => 5);
- 
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
-      C0 : CHECK_TYPE := ZERO;
-      C1 : CHECK_TYPE := ONE;
-      C2 : CHECK_TYPE := TWO;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
- 
-      TYPE REC_TYPE IS RECORD
-           COMP0 : CHECK_TYPE := ZERO;
-           COMP1 : CHECK_TYPE := ONE;
-           COMP2 : CHECK_TYPE := TWO;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN CH;
-           ELSE
-                RETURN ONE;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
- 
-      PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
-                      CIO1, CIO2 : IN OUT CHECK_TYPE;
-                      CO2        :    OUT CHECK_TYPE) IS
-      BEGIN
-           IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2)    AND
-                   (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " &
-                        "- 1");
-           END IF;
- 
-           IF CHECK_TYPE'VAL (0) /= IDENT (CI0)  OR
-              CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR
-              CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1");
-           END IF;
- 
-           IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0)  OR
-              CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1");
-           END IF;
- 
-           IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0)   OR
-              CHECK_TYPE'VALUE ("ONE")  /=  IDENT (CIO1) OR
-              CHECK_TYPE'VALUE ("TWO")  /=  IDENT (CIO2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1");
-           END IF;
- 
-           CO2 := TWO;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A24A", "CHECK THAT WHEN A SIZE SPECIFICATION AND " &
-                       "AN ENUMERATION REPRESENTATION CLAUSE ARE " &
-                       "GIVEN FOR AN ENUMERATION TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE WITH " &
-                       "THE SMALLEST APPROPRIATE SIGNED SIZE ARE " &
-                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
-      PROC (ZERO, TWO, C1, C2, C2);
- 
-      IF C1 /= ONE OR C2 /= TWO THEN
-           FAILED ("INCORRECT VALUE RETURNED BY PROCEDURE");
-      END IF;
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR C0'SIZE");
-      END IF;
- 
-      IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
-              (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
-      END IF;
- 
-      IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
-         CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
-      END IF;
- 
-      IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
-      END IF;
- 
-      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
-              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
-              (CHARRAY (1) <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHARRAY (2)))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
-              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
-         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
-      END IF;
- 
-      IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
-      END IF;
- 
-      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
-              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
-              (CHREC.COMP1 <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHREC.COMP2))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
-              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
-      END IF;
- 
- 
-      RESULT;
- 
- END CD2A24A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,220 ****
- -- CD2A24E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A SIZE CLAUSE AND AN ENUMERATION
- --     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
- --     AND THE SMALLEST SIZE APPROPRIATE FOR AN UNSIGNED REPRESENTATION
- --     IS SPECIFIED, THEN OPERATIONS ON THE TYPE ARE NOT AFFECTED.
- 
- -- HISTORY:
- --     JET 08/19/87 CREATED ORIGINAL TEST.
- --     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A24E IS
- 
-      BASIC_SIZE : CONSTANT := 3;
- 
-      TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
- 
-      FOR CHECK_TYPE USE (ZERO => 3, ONE => 4,
-                          TWO => 5);
- 
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
-      C0 : CHECK_TYPE := ZERO;
-      C1 : CHECK_TYPE := ONE;
-      C2 : CHECK_TYPE := TWO;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
- 
-      TYPE REC_TYPE IS RECORD
-           COMP0 : CHECK_TYPE := ZERO;
-           COMP1 : CHECK_TYPE := ONE;
-           COMP2 : CHECK_TYPE := TWO;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN CH;
-           ELSE
-                RETURN ONE;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
-                      CIO1, CIO2 : IN OUT CHECK_TYPE;
-                      CO2        :    OUT CHECK_TYPE) IS
-      BEGIN
-           IF NOT ((CI0 <  IDENT (ONE))                          AND
-                   (IDENT (CI2)  > IDENT (CIO1))                 AND
-                   (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
-                        "- 1");
-           END IF;
- 
-           IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
-              CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
-              CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
-           END IF;
- 
-           IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
-              CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
-           END IF;
- 
-           IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
-              CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
-              CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
-           END IF;
- 
- 
-           CO2 := TWO;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A24E", "CHECK THAT IF A SIZE CLAUSE AND AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
-                       "ENUMERATION TYPE, AND THE SMALLEST SIZE " &
-                       "APPROPRIATE FOR AN UNSIGNED REPRESENTATION " &
-                       "IS SPECIFIED, THEN OPERATIONS ON THE TYPE " &
-                       "ARE NOT AFFECTED");
- 
-      PROC (ZERO, TWO, C1, C2, C2);
- 
-      IF C1 /= ONE OR C2 /= TWO THEN
-           FAILED ("INCORRECT VALUE RETURNED BY PROCEDURE");
-      END IF;
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR C0'SIZE");
-      END IF;
- 
-      IF NOT ((IDENT (C1) IN C1 .. C2)       AND
-              (C0 NOT IN IDENT (ONE) .. C2)) THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
-         CHECK_TYPE'VAL (1) /= IDENT (C1) OR
-         CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
-         CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
-         CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
-         CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
-      END IF;
- 
-      IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
-      END IF;
- 
-      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
-              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
-              (CHARRAY (1) <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHARRAY (2)))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
-              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
-         CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
-         CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
-      END IF;
- 
-      IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
-         CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
-      END IF;
- 
-      IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
-         CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
-         CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
-      END IF;
- 
-      IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
-      END IF;
- 
-      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
-              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
-              (CHREC.COMP1 <= IDENT (ONE))                 AND
-              (IDENT (TWO) = CHREC.COMP2))                 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
-              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
-      END IF;
- 
-      IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
-      END IF;
- 
-      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
-         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
-         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
-      END IF;
- 
-      RESULT;
- END CD2A24E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- CD2A24I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE SMALLEST APPROPRIATE
- --     SIZE FOR A SIGNED REPRESENTATION) AND AN ENUMERATION
- --     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
- --     THEN THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN AN
- --     INSTANTIATION.
- 
- -- HISTORY:
- --     JET 08/19/87 CREATED ORIGINAL TEST.
- --     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES. 
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A24I IS
- 
-      TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
-      BASIC_SIZE : CONSTANT := 4;
- 
-      FOR BASIC_ENUM USE (ZERO => 3, ONE => 4,
-                          TWO => 5);
- 
-      FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
- 
- BEGIN
-      TEST ("CD2A24I", "CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE " &
-                       "SMALLEST APPROPRIATE SIZE FOR A SIGNED " &
-                       "REPRESENTATION) AND AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
-                       "ENUMERATION TYPE, THEN THE TYPE CAN BE USED " &
-                       "AS AN ACTUAL PARAMETER IN AN INSTANTIATION");
- 
- 
-      DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS (<>);
-           PROCEDURE GENPROC (C0, C1, C2: GPARM);
- 
-           PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
- 
-                SUBTYPE CHECK_TYPE IS GPARM;
- 
-                FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN CH;
-                     ELSE
-                          RETURN C1;
-                     END IF;
-                END IDENT;
- 
-           BEGIN -- GENPROC.
- 
-                IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-                END IF;
- 
-                IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR C0'SIZE");
-                END IF;
- 
-                IF NOT ((C0 <  IDENT (C1)) AND
-                        (IDENT (C2)  > IDENT (C1)) AND
-                        (C1 <= IDENT (C1)) AND (IDENT (C2) = C2)) THEN
-                     FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                             "OPERATORS");
-                END IF;
- 
-                IF CHECK_TYPE'FIRST /= IDENT (C0) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
-                END IF;
- 
-                IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
-                   CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
-                   CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS");
-                END IF;
- 
-                IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
-                   CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC");
-                END IF;
- 
-                IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
-                   CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
-                   CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
- 
-      BEGIN
- 
-           NEWPROC (ZERO, ONE, TWO);
- 
-      END;
- 
-      RESULT;
- 
- END CD2A24I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- CD2A24J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE SMALLEST APPROPRIATE
- --     SIZE FOR AN UNSIGNED REPRESENTATION) AND AN ENUMERATION
- --     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
- --     THEN THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN AN
- --     INSTANTIATION.
- 
- -- HISTORY:
- --     JET 08/19/87 CREATED ORIGINAL TEST.
- --     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A24J IS
- 
-      TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
-      BASIC_SIZE : CONSTANT := 3;
- 
-      FOR BASIC_ENUM USE (ZERO => 3, ONE => 4,
-                          TWO => 5);
-      FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
- 
- BEGIN
-      TEST ("CD2A24J", "CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE " &
-                       "SMALLEST APPROPRIATE SIZE FOR AN UNSIGNED " &
-                       "REPRESENTATION) AND AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
-                       "ENUMERATION TYPE, THEN THE TYPE CAN BE USED " &
-                       "AS AN ACTUAL PARAMETER IN AN INSTANTIATION");
- 
- 
-      DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS (<>);
-           PROCEDURE GENPROC (C0, C1, C2: GPARM);
- 
-           PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
- 
-                SUBTYPE CHECK_TYPE IS GPARM;
- 
-                FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN CH;
-                     ELSE
-                          RETURN C1;
-                     END IF;
-                END IDENT;
- 
-           BEGIN -- GENPROC.
- 
-                IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-                END IF;
- 
-                IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR C0'SIZE");
-                END IF;
- 
-                IF NOT ((IDENT (C1) IN C1 .. C2)       AND
-                        (C0 NOT IN IDENT (C1) .. C2)) THEN
-                     FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                             "OPERATORS");
-                END IF;
- 
-                IF CHECK_TYPE'LAST /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
-                END IF;
- 
-                IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
-                   CHECK_TYPE'VAL (1) /= IDENT (C1) OR
-                   CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL");
-                END IF;
- 
-                IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
-                   CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
-                END IF;
- 
-                IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
-                   CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
-                   CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
-                     FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
- 
-      BEGIN
- 
-           NEWPROC (ZERO, ONE, TWO);
- 
-      END;
- 
-      RESULT;
- 
- END CD2A24J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- CD2A31A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
- --     INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     JET 08/06/87  CREATED ORIGINAL TEST.
- --     DHH 04/06/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 9, AND ADDED REPRESENTAION
- --                   CLAUSE CHECK.
- --     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT;  USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A31A IS
- 
-      BASIC_SIZE : CONSTANT := 9;
- 
-      TYPE INT IS RANGE -100 .. 100;
- 
-      FOR INT'SIZE USE BASIC_SIZE;
- 
-      I1 : INT := -100;
-      I2 : INT :=    0;
-      I3 : INT :=  100;
- 
-      TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE -1 .. 1) OF INT;
-      INTARRAY : ARRAY_TYPE := (-100, 0, 100);
- 
-      TYPE REC_TYPE IS RECORD
-           COMPN : INT := -100;
-           COMPZ : INT :=    0;
-           COMPP : INT :=  100;
-      END RECORD;
- 
-      IREC : REC_TYPE;
- 
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (INT);
- 
-      FUNCTION IDENT (I : INT) RETURN INT IS
-      BEGIN
-           IF EQUAL (0,0) THEN
-                RETURN I;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (PIN,  PIP  :        INT;
-                      PIOZ, PIOP : IN OUT INT;
-                      POP        :    OUT INT) IS
- 
-      BEGIN
-           IF PIN'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                FAILED ("INCORRECT VALUE FOR PIN'SIZE");
-           END IF;
- 
-           IF NOT ((PIN < IDENT (0))             AND
-                   (IDENT (PIP) > IDENT (PIOZ))  AND
-                   (PIOZ <= IDENT (1))           AND
-                   (IDENT (100) = PIP))          THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                        "OPERATORS - 1");
-           END IF;
- 
-           IF NOT (((PIN + PIP)   = PIOZ)       AND
-                   ((PIP - PIOZ)  = PIOP)       AND
-                   ((PIOP * PIOZ) = PIOZ)       AND
-                   ((PIOZ / PIN)  = PIOZ)       AND
-                   ((PIN ** 1)    = PIN)        AND
-                   ((PIN REM 9)   = IDENT (-1)) AND
-                   ((PIP MOD 9)   = IDENT (1))) THEN
-                FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                        "OPERATORS - 1");
-           END IF;
- 
-           IF INT'VAL (-100) /= IDENT (PIN)  OR
-              INT'VAL (0)    /= IDENT (PIOZ) OR
-              INT'VAL (100)  /= IDENT (PIOP) THEN
-                FAILED ("INCORRECT VALUE FOR INT'VAL - 1");
-           END IF;
- 
-           IF INT'PRED (PIOZ) /= IDENT (-1) OR
-              INT'PRED (PIP)  /= IDENT (99) THEN
-                FAILED ("INCORRECT VALUE FOR INT'PRED - 1");
-           END IF;
- 
-           IF INT'VALUE ("-100") /= IDENT (PIN)  OR
-              INT'VALUE ("0")    /= IDENT (PIOZ) OR
-              INT'VALUE ("100")  /= IDENT (PIOP) THEN
-                FAILED ("INCORRECT VALUE FOR INT'VALUE - 1");
-           END IF;
- 
-           POP := 100;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A31A", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
-                       "GIVEN FOR AN INTEGER TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
-                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      CHECK_1 (I1, 9, "INT");
-      PROC (-100, 100, I2, I3, I3);
- 
-      IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR INT'SIZE");
-      END IF;
- 
-      IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR I1'SIZE");
-      END IF;
- 
-      FOR I IN IDENT (I1) .. IDENT (I3) LOOP
-           IF NOT (I IN I1 .. I3) OR
-              (I NOT IN IDENT(-100) .. IDENT(100)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 2");
-           END IF;
-      END LOOP;
- 
-      IF NOT ((+I1 = I1)     AND
-              (-I3 = I1)      AND
-              (ABS I1 = I3)) THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
-                   "OPERATORS - 2");
-      END IF;
- 
-      IF INT'FIRST /= IDENT (-100) THEN
-           FAILED ("INCORRECT VALUE FOR INT'FIRST - 2");
-      END IF;
- 
-      IF INT'POS (I1) /= IDENT_INT (-100) OR
-         INT'POS (I2) /= IDENT_INT (   0) OR
-         INT'POS (I3) /= IDENT_INT ( 100) THEN
-           FAILED ("INCORRECT VALUE FOR INT'POS - 2");
-      END IF;
- 
-      IF INT'SUCC (I1) /= IDENT (-99) OR
-         INT'SUCC (I2) /= IDENT (1)   THEN
-           FAILED ("INCORRECT VALUE FOR INT'SUCC - 2");
-      END IF;
- 
-      IF INT'IMAGE (I1) /= IDENT_STR ("-100") OR
-         INT'IMAGE (I2) /= IDENT_STR (" 0")    OR
-         INT'IMAGE (I3) /= IDENT_STR (" 100")  THEN
-           FAILED ("INCORRECT VALUE FOR INT'IMAGE - 2");
-      END IF;
- 
-      IF INTARRAY(0)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR INTARRAY(0)'SIZE");
-      END IF;
- 
-      IF NOT ((INTARRAY(-1) < IDENT (0))                       AND
-              (IDENT (INTARRAY (1)) > IDENT (INTARRAY(0)))     AND
-              (INTARRAY(0) <= IDENT (0))                       AND
-              (IDENT (100) = INTARRAY (1)))                    THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      FOR I IN IDENT (INTARRAY(-1)) .. IDENT (INTARRAY(1)) LOOP
-           IF NOT (I IN INTARRAY(-1) .. INTARRAY(1)) OR
-              (I NOT IN IDENT(-100) .. IDENT(100)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 3");
-           END IF;
-      END LOOP;
- 
-      IF NOT (((INTARRAY(-1) + INTARRAY( 1)) = INTARRAY( 0)) AND
-              ((INTARRAY( 0) - INTARRAY( 1)) = INTARRAY(-1)) AND
-              ((INTARRAY( 1) * INTARRAY( 0)) = INTARRAY( 0)) AND
-              ((INTARRAY( 0) / INTARRAY(-1)) = INTARRAY( 0)) AND
-              ((INTARRAY(-1) ** 1)           = INTARRAY(-1)) AND
-              ((INTARRAY(-1) REM 9)          = IDENT (-1))   AND
-              ((INTARRAY( 1) MOD 9)          = IDENT ( 1)))  THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      IF INT'POS (INTARRAY (-1)) /= IDENT_INT (-100) OR
-         INT'POS (INTARRAY ( 0)) /= IDENT_INT (   0) OR
-         INT'POS (INTARRAY ( 1)) /= IDENT_INT ( 100) THEN
-           FAILED ("INCORRECT VALUE FOR INT'POS - 3");
-      END IF;
- 
-      IF INT'SUCC (INTARRAY (-1)) /= IDENT (-99) OR
-         INT'SUCC (INTARRAY ( 0)) /= IDENT (1)   THEN
-           FAILED ("INCORRECT VALUE FOR INT'SUCC - 3");
-      END IF;
- 
-      IF INT'IMAGE (INTARRAY (-1)) /= IDENT_STR ("-100") OR
-         INT'IMAGE (INTARRAY ( 0)) /= IDENT_STR (" 0")    OR
-         INT'IMAGE (INTARRAY ( 1)) /= IDENT_STR (" 100")  THEN
-           FAILED ("INCORRECT VALUE FOR INT'IMAGE - 3");
-      END IF;
- 
-      IF IREC.COMPP'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR IREC.COMPP'SIZE");
-      END IF;
- 
-      IF NOT ((IREC.COMPN < IDENT (0))                      AND
-              (IDENT (IREC.COMPP) > IDENT (IREC.COMPZ))     AND
-              (IREC.COMPZ <= IDENT (0))                     AND
-              (IDENT (100) = IREC.COMPP))                   THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      FOR I IN IDENT (IREC.COMPN) .. IDENT (IREC.COMPP) LOOP
-           IF NOT (I IN IREC.COMPN .. IREC.COMPP) OR
-              (I NOT IN IDENT(-100) .. IDENT(100)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 4");
-           END IF;
-      END LOOP;
- 
-      IF NOT ((+IREC.COMPN = IREC.COMPN)     AND
-              (-IREC.COMPP = IREC.COMPN)     AND
-              (ABS IREC.COMPN = IREC.COMPP)) THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      IF INT'VAL (-100) /= IDENT (IREC.COMPN) OR
-         INT'VAL (   0) /= IDENT (IREC.COMPZ) OR
-         INT'VAL ( 100) /= IDENT (IREC.COMPP) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VAL - 4");
-      END IF;
- 
-      IF INT'PRED (IREC.COMPZ) /= IDENT (-1) OR
-         INT'PRED (IREC.COMPP) /= IDENT (99) THEN
-           FAILED ("INCORRECT VALUE FOR INT'PRED - 4");
-      END IF;
- 
-      IF INT'VALUE ("-100") /= IDENT (IREC.COMPN) OR
-         INT'VALUE (   "0") /= IDENT (IREC.COMPZ) OR
-         INT'VALUE ( "100") /= IDENT (IREC.COMPP) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VALUE - 4");
-      END IF;
- 
-      RESULT;
- END CD2A31A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- CD2A31C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER 'SIZE SPECIFICATIONS CAN BE GIVEN:
- --        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
- --          DECLARED IN THE VISIBLE PART;
- --        FOR A DERIVED INTEGER TYPE;
- --        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
- --          AN INTEGER TYPE;
- --        FOR AN INTEGER TYPE IN A GENERIC UNIT.
- 
- -- HISTORY:
- --     PWB 06/17/87  CREATED ORIGINAL TEST.
- --     DHH 04/06/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 9, AND ADDED REPRESENTAION
- --                   CLAUSE CHECK AND INCLUDED TEST FOR INTEGER IN A
- --                   GENERIC UNIT.
- --     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
- --     DTN 06/17/92  REMOVED THE LENGTH CLAUSE FOR TYPE PRIVATE_INT.
- 
- WITH REPORT; USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A31C IS
- 
-      TYPE BASIC_INT IS RANGE -60 .. 80;
-      SPECIFIED_SIZE : CONSTANT := 9;
- 
-      TYPE DERIVED_INT IS NEW BASIC_INT;
-      FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
- 
-      PACKAGE P IS
-           TYPE INT_IN_P IS RANGE -125 .. 125;
-           FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
-           TYPE PRIVATE_INT IS PRIVATE;
-           TYPE ALT_INT_IN_P IS RANGE -125 .. 125;
-      PRIVATE
-           TYPE PRIVATE_INT IS RANGE -125 .. 125;
-           FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
-      END P;
- 
-      USE P;
-      TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
-      FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
-      MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
- 
- -- SIZE SPECIFICATION GIVEN IN A GENERIC PROCEDURE.
- 
-      GENERIC
-      PROCEDURE GENPROC;
- 
-      PROCEDURE GENPROC IS
-           TYPE CHECK_INT IS RANGE -125 .. 125;
-           FOR CHECK_INT'SIZE USE SPECIFIED_SIZE;
- 
-           PROCEDURE CHECK_4 IS NEW LENGTH_CHECK (CHECK_INT);
- 
-      BEGIN
- 
-           IF CHECK_INT'SIZE /= MINIMUM_SIZE THEN
-                FAILED ("GENERIC CHECK_INT'SIZE IS INCORRECT");
-           END IF;
-           CHECK_4 (-60, 9, "GENERIC CHECK_INT");
- 
-      END GENPROC;
- 
-      PROCEDURE NEWPROC IS NEW GENPROC;
- 
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (DERIVED_INT);
-      PROCEDURE CHECK_2 IS NEW LENGTH_CHECK (INT_IN_P);
-      PROCEDURE CHECK_3 IS NEW LENGTH_CHECK (ALT_INT_IN_P);
- 
- BEGIN
- 
-      TEST("CD2A31C", "CHECK THAT 'SIZE SPECIFICATIONS CAN BE GIVEN IN " &
-                      "VISIBLE OR PRIVATE PART OF PACKAGE FOR INTEGER " &
-                      "TYPE DECLARED IN VISIBLE PART, AND FOR " &
-                      "DERIVED INTEGER TYPES " &
-                      "AND DERIVED PRIVATE TYPES WHOSE FULL DECLARATIONS " &
-                      "ARE AS INTEGER TYPES");
- 
-      CHECK_1 (-60, 9, "DERIVED_INT");
-      CHECK_2 (-60, 9, "INT_IN_P");
-      CHECK_3 (-60, 9, "ALT_INT_IN_P");
- 
-      NEWPROC;
- 
-      IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("DERIVED_INT'SIZE INCORRECT");
-      END IF;
- 
-      IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("INT_IN_P'SIZE INCORRECT");
-      END IF;
- 
-      IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("ALT_INT_IN_P'SIZE INCORRECT");
-      END IF;
- 
-      IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("DERIVED_PRIVATE_INT'SIZE INCORRECT");
-      END IF;
- 
-      RESULT;
- 
- END CD2A31C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,139 ****
- -- CD2A31E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
- --     INTEGER TYPE, THEN SUCH A TYPE CAN BE PASSED AS AN ACTUAL
- --     PARAMETER TO GENERIC PROCEDURES.
- 
- -- HISTORY:
- --     JET 08/12/87  CREATED ORIGINAL TEST.
- --     BCB 10/18/88  MODIFIED HEADER AND ENTERED IN ACVC.
- --     DHH 04/06/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 9, AND CHANGED 'SIZE CLAUSE
- --                   CHECKS.
- --     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD2A31E IS
- 
-      TYPE BASIC_INT IS RANGE -100 .. 100;
-      BASIC_SIZE : CONSTANT := 9;
- 
-      FOR BASIC_INT'SIZE USE BASIC_SIZE;
- 
- BEGIN
- 
-      TEST ("CD2A31E", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
-                       "GIVEN FOR AN INTEGER TYPE, THEN SUCH A TYPE " &
-                       "CAN BE PASSED AS AN ACTUAL PARAMETER TO " &
-                       "GENERIC PACKAGES AND PROCEDURES");
- 
-      DECLARE -- TYPE DECLARATION WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS RANGE <>;
-           PROCEDURE GENPROC;
- 
-           PROCEDURE GENPROC IS
- 
-           SUBTYPE INT IS GPARM;
- 
-           I1 : INT := -100;
-           I2 : INT :=    0;
-           I3 : INT :=  100;
- 
-           FUNCTION IDENT (I : INT) RETURN INT IS
-           BEGIN
-                IF EQUAL (0,0) THEN
-                     RETURN I;
-                ELSE
-                     RETURN 0;
-                END IF;
-           END IDENT;
- 
-           BEGIN -- GENPROC.
- 
-                IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'SIZE");
-                END IF;
- 
-                IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR I1'SIZE");
-                END IF;
- 
-                IF NOT ((I1 < IDENT (0))           AND
-                        (IDENT (I3) > IDENT (I2))  AND
-                        (I2 <= IDENT (0))          AND
-                        (IDENT (100) = I3))        THEN
-                     FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                             "OPERATORS");
-                END IF;
- 
-                IF NOT (((I1 + I3)  = I2)         AND
-                        ((I2 - I3)  = I1)         AND
-                        ((I3 * I2)  = I2)         AND
-                        ((I2 / I1)  = I2)         AND
-                        ((I1 ** 1)  = I1)         AND
-                        ((I1 REM 9) = IDENT (-1)) AND
-                        ((I3 MOD 9) = IDENT (1))) THEN
-                     FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                             "OPERATORS");
-                END IF;
- 
-                IF INT'LAST /= IDENT (100) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'LAST");
-                END IF;
- 
-                IF INT'VAL (-100) /= IDENT (I1) OR
-                   INT'VAL (0)    /= IDENT (I2) OR
-                   INT'VAL (100)  /= IDENT (I3) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'VAL");
-                END IF;
- 
-                IF INT'PRED (I2) /= IDENT (-1) OR
-                   INT'PRED (I3) /= IDENT (99) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'PRED");
-                END IF;
- 
-                IF INT'VALUE ("-100") /= IDENT (I1) OR
-                   INT'VALUE (" 0")   /= IDENT (I2) OR
-                   INT'VALUE (" 100") /= IDENT (I3) THEN
-                          FAILED ("INCORRECT VALUE FOR INT'VALUE");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_INT);
- 
-      BEGIN
- 
-           NEWPROC;
- 
-      END;
- 
-      RESULT;
- 
- END CD2A31E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,272 ****
- -- CD2A32A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
- --     INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     WITH THE SMALLEST APPROPRIATE SIGNED SIZE ARE NOT
- --     AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     JET 08/12/87  CREATED ORIGINAL TEST.
- --     DHH 04/10/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
- --                   CHECKS AND ADDED REPRESENTAION CLAUSE CHECK.
- --     RJW 03/28/90  REMOVED ERRONEOUS REFERENCES TO LENGTH_CHECK.
- --     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT;  USE REPORT;
- WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD2A32A IS
- 
-      BASIC_SIZE : CONSTANT := 7;
- 
-      TYPE INT IS RANGE -63 .. 63;
- 
-      FOR INT'SIZE USE BASIC_SIZE;
- 
-      I1 : INT := -63;
-      I2 : INT :=    0;
-      I3 : INT :=  63;
- 
-      TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE -1 .. 1) OF INT;
-      PRAGMA PACK (ARRAY_TYPE);
-      INTARRAY : ARRAY_TYPE := (-63, 0, 63);
- 
-      TYPE REC_TYPE IS RECORD
-           COMPN : INT := -63;
-           COMPZ : INT :=    0;
-           COMPP : INT :=  63;
-      END RECORD;
-      PRAGMA PACK (REC_TYPE);
- 
-      IREC : REC_TYPE;
- 
-      FUNCTION IDENT (I : INT) RETURN INT IS
-      BEGIN
-           IF EQUAL (0,0) THEN
-                RETURN I;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (INT);
- 
- 
-      PROCEDURE PROC (PIN,  PIP  :        INT;
-                      PIOZ, PIOP : IN OUT INT;
-                      POP        :    OUT INT) IS
- 
-      BEGIN
-           IF PIN'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                FAILED ("INCORRECT VALUE FOR PIN'SIZE");
-           END IF;
- 
-           FOR P1 IN IDENT (PIN) .. IDENT (PIOP) LOOP
-                IF NOT (P1 IN PIN .. PIP) OR
-                   (P1 NOT IN IDENT(-63) .. IDENT(63)) THEN
-                     FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 1");
-                END IF;
-           END LOOP;
- 
-           IF NOT ((+PIP = PIOP)     AND
-                   (-PIN = PIP)      AND
-                   (ABS PIN = PIOP)) THEN
-                FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
-                        "OPERATORS - 1");
-           END IF;
- 
-           IF INT'VAL (-63) /= IDENT (PIN)  OR
-              INT'VAL (0)    /= IDENT (PIOZ) OR
-              INT'VAL (63)  /= IDENT (PIOP) THEN
-                FAILED ("INCORRECT VALUE FOR INT'VAL - 1");
-           END IF;
- 
-           IF INT'PRED (PIOZ) /= IDENT (-1) OR
-              INT'PRED (PIP)  /= IDENT (62) THEN
-                FAILED ("INCORRECT VALUE FOR INT'PRED - 1");
-           END IF;
- 
-           IF INT'VALUE ("-63") /= IDENT (PIN)  OR
-              INT'VALUE ("0")    /= IDENT (PIOZ) OR
-              INT'VALUE ("63")  /= IDENT (PIOP) THEN
-                FAILED ("INCORRECT VALUE FOR INT'VALUE - 1");
-           END IF;
- 
-           POP := 63;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A32A", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
-                       "GIVEN FOR AN INTEGER TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE WITH " &
-                       "THE SMALLEST APPROPRIATE SIGNED SIZE ARE " &
-                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      CHECK_1 (I1, 7, "INT");
- 
-      PROC (-63, 63, I2, I3, I3);
- 
-      IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR INT'SIZE");
-      END IF;
- 
-      IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR I1'SIZE");
-      END IF;
- 
-      IF NOT ((I1 < IDENT (0))              AND
-              (IDENT (I3) > IDENT (I2))     AND
-              (I2 <= IDENT (0))             AND
-              (IDENT (63) = I3))           THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
-      END IF;
- 
-      IF NOT (((I1 + I3)   = I2)         AND
-              ((I2 - I3)   = I1)         AND
-              ((I3 * I2)   = I2)         AND
-              ((I2 / I1)   = I2)         AND
-              ((I1 ** 1)   = I1)         AND
-              ((I1 REM 10) = IDENT (-3)) AND
-              ((I3 MOD 10) = IDENT (3))) THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                   "OPERATORS - 2");
-      END IF;
- 
-      IF INT'FIRST /= IDENT (-63) THEN
-           FAILED ("INCORRECT VALUE FOR INT'FIRST - 2");
-      END IF;
- 
-      IF INT'POS (I1) /= IDENT_INT (-63) OR
-         INT'POS (I2) /= IDENT_INT (   0) OR
-         INT'POS (I3) /= IDENT_INT ( 63) THEN
-           FAILED ("INCORRECT VALUE FOR INT'POS - 2");
-      END IF;
- 
-      IF INT'SUCC (I1) /= IDENT (-62) OR
-         INT'SUCC (I2) /= IDENT (1)   THEN
-           FAILED ("INCORRECT VALUE FOR INT'SUCC - 2");
-      END IF;
- 
-      IF INT'IMAGE (I1) /= IDENT_STR ("-63") OR
-         INT'IMAGE (I2) /= IDENT_STR (" 0")    OR
-         INT'IMAGE (I3) /= IDENT_STR (" 63")  THEN
-           FAILED ("INCORRECT VALUE FOR INT'IMAGE - 2");
-      END IF;
- 
-      IF INTARRAY(0)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR INTARRAY(0)'SIZE");
-      END IF;
- 
-      IF NOT ((INTARRAY(-1) < IDENT (0))                       AND
-              (IDENT (INTARRAY (1)) > IDENT (INTARRAY(0)))     AND
-              (INTARRAY(0) <= IDENT (0))                       AND
-              (IDENT (63) = INTARRAY (1)))                    THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      FOR I IN IDENT (INTARRAY(-1)) .. IDENT (INTARRAY(1)) LOOP
-           IF NOT (I IN INTARRAY(-1) .. INTARRAY(1)) OR
-              (I NOT IN IDENT(-63) .. IDENT(63)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 3");
-           END IF;
-      END LOOP;
- 
-      IF NOT ((+INTARRAY(-1) = INTARRAY(-1))     AND
-              (-INTARRAY( 1) = INTARRAY(-1))     AND
-              (ABS INTARRAY(-1) = INTARRAY(1)))  THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      IF INT'VAL (-63) /= IDENT (INTARRAY (-1)) OR
-         INT'VAL (   0) /= IDENT (INTARRAY ( 0)) OR
-         INT'VAL ( 63) /= IDENT (INTARRAY ( 1)) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VAL - 3");
-      END IF;
- 
-      IF INT'PRED (INTARRAY (0)) /= IDENT (-1) OR
-         INT'PRED (INTARRAY (1)) /= IDENT (62) THEN
-           FAILED ("INCORRECT VALUE FOR INT'PRED - 3");
-      END IF;
- 
-      IF INT'VALUE ("-63") /= IDENT (INTARRAY (-1)) OR
-         INT'VALUE ("0")    /= IDENT (INTARRAY ( 0)) OR
-         INT'VALUE ("63")  /= IDENT (INTARRAY ( 1)) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VALUE - 3");
-      END IF;
- 
-      IF IREC.COMPP'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR IREC.COMPP'SIZE");
-      END IF;
- 
-      IF NOT ((IREC.COMPN < IDENT (0))                      AND
-              (IDENT (IREC.COMPP) > IDENT (IREC.COMPZ))     AND
-              (IREC.COMPZ <= IDENT (0))                     AND
-              (IDENT (63) = IREC.COMPP))                   THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      FOR I IN IDENT (IREC.COMPN) .. IDENT (IREC.COMPP) LOOP
-           IF NOT (I IN IREC.COMPN .. IREC.COMPP) OR
-              (I NOT IN IDENT(-63) .. IDENT(63)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 4");
-           END IF;
-      END LOOP;
- 
-      IF NOT (((IREC.COMPN + IREC.COMPP) = IREC.COMPZ)  AND
-              ((IREC.COMPZ - IREC.COMPP) = IREC.COMPN)  AND
-              ((IREC.COMPP * IREC.COMPZ) = IREC.COMPZ)  AND
-              ((IREC.COMPZ / IREC.COMPN) = IREC.COMPZ)  AND
-              ((IREC.COMPN ** 1)         = IREC.COMPN)  AND
-              ((IREC.COMPN REM 10)       = IDENT (-3))  AND
-              ((IREC.COMPP MOD 10)       = IDENT ( 3))) THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      IF INT'POS (IREC.COMPN) /= IDENT_INT (-63) OR
-         INT'POS (IREC.COMPZ) /= IDENT_INT (   0) OR
-         INT'POS (IREC.COMPP) /= IDENT_INT ( 63) THEN
-           FAILED ("INCORRECT VALUE FOR INT'POS - 4");
-      END IF;
- 
-      IF INT'SUCC (IREC.COMPN) /= IDENT (-62) OR
-         INT'SUCC (IREC.COMPZ) /= IDENT (  1) THEN
-           FAILED ("INCORRECT VALUE FOR INT'SUCC - 4");
-      END IF;
- 
-      IF INT'IMAGE (IREC.COMPN) /= IDENT_STR ("-63") OR
-         INT'IMAGE (IREC.COMPZ) /= IDENT_STR (" 0")    OR
-         INT'IMAGE (IREC.COMPP) /= IDENT_STR (" 63")  THEN
-           FAILED ("INCORRECT VALUE FOR INT'IMAGE - 4");
-      END IF;
- 
-      RESULT;
- END CD2A32A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- CD2A32C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SIZE SPECIFICATION FOR AN INTEGER TYPE OF THE
- --     SMALLEST APPROPRIATE SIGNED SIZE CAN BE GIVEN:
- --        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
- --          DECLARED IN THE VISIBLE PART;
- --        FOR A DERIVED INTEGER TYPE;
- --        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
- --          AN INTEGER TYPE;
- --        FOR AN INTEGER TYPE IN A GENERIC UNIT.
- 
- -- HISTORY:
- --     JET 08/12/87  CREATED ORIGINAL TEST.
- --     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
- --                   CHECKS, ADDED REPRESENTAION CLAUSE CHECK, AND
- --                   ADDED CHECK ON INTEGER IN A GENERIC UNIT.
- --     BCB 10/03/90  CHANGED FAILED MESSAGES FROM "SHOULD NOT BE GREATER
- --                   THAN" TO "MUST BE EQUAL TO".
- --     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A32C IS
- 
-      TYPE BASIC_INT IS RANGE -63 .. 63;
-      SPECIFIED_SIZE : CONSTANT := 7;
- 
-      TYPE DERIVED_INT IS NEW BASIC_INT;
-      FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
- 
-      PACKAGE P IS
-           TYPE INT_IN_P IS RANGE -63 .. 63;
-           FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
-           TYPE PRIVATE_INT IS PRIVATE;
-           TYPE ALT_INT_IN_P IS RANGE -63 .. 63;
-      PRIVATE
-           TYPE PRIVATE_INT IS RANGE -63 .. 63;
-           FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
-      END P;
- 
-      USE P;
- 
-      GENERIC
-      PACKAGE GENPACK IS
-           TYPE GEN_CHECK_INT IS RANGE -63 .. 63;
-           FOR GEN_CHECK_INT'SIZE USE SPECIFIED_SIZE;
-      END GENPACK;
- 
-      PACKAGE NEWPACK IS NEW GENPACK;
- 
-      USE NEWPACK;
-      TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
-      FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
- 
-      MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
- 
- BEGIN
- 
-      TEST("CD2A32C", "CHECK THAT A SIZE SPECIFICATION " &
-                      "FOR AN INTEGER TYPE OF THE SMALLEST " &
-                      "APPROPRIATE SIGNED SIZE CAN BE GIVEN: IN THE " &
-                      "VISIBLE OR PRIVATE PART OF A PACKAGE FOR A " &
-                      "TYPE DECLARED IN THE VISIBLE PART; FOR A " &
-                      "DERIVED INTEGER TYPE; FOR A DERIVED PRIVATE " &
-                      "TYPE WHOSE FULL DECLARATION IS AS AN INTEGER " &
-                      "TYPE; FOR AN INTEGER TYPE IN A GENERIC UNIT");
- 
-      IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("DERIVED_INT'SIZE MUST BE EQUAL TO" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_INT'SIZE));
-      END IF;
- 
-      IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("INT_IN_P'SIZE MUST BE EQUAL TO" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(INT_IN_P'SIZE));
-      END IF;
- 
-      IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("ALT_INT_IN_P'SIZE MUST BE EQUAL TO" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(ALT_INT_IN_P'SIZE));
-      END IF;
- 
-      IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("DERIVED_PRIVATE_INT'SIZE MUST BE EQUAL TO " &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_PRIVATE_INT'SIZE));
-      END IF;
- 
-      IF GEN_CHECK_INT'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("GEN_CHECK_INT'SIZE MUST BE EQUAL TO" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(GEN_CHECK_INT'SIZE));
-      END IF;
- 
-      RESULT;
- 
- END CD2A32C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,263 ****
- -- CD2A32E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
- --     INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     WITH THE SMALLEST APPROPRIATE UNSIGNED SIZE ARE NOT
- --     AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     JET 08/12/87  CREATED ORIGINAL TEST.
- --     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON
- --                   'SIZE CHECKS.
- --     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE CD2A32E IS
- 
-      BASIC_SIZE : CONSTANT := 7;
- 
-      TYPE INT IS RANGE 0 .. 126;
- 
-      FOR INT'SIZE USE BASIC_SIZE;
- 
-      I0 : INT :=   0;
-      I1 : INT :=  63;
-      I2 : INT := 126;
- 
-      TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE 0 .. 2) OF INT;
-      INTARRAY : ARRAY_TYPE := (0, 63, 126);
- 
-      TYPE REC_TYPE IS RECORD
-           COMP0 : INT :=   0;
-           COMP1 : INT := 63;
-           COMP2 : INT := 126;
-      END RECORD;
- 
-      IREC : REC_TYPE;
- 
-      FUNCTION IDENT (I : INT) RETURN INT IS
-      BEGIN
-           IF EQUAL (0,0) THEN
-                RETURN I;
-           ELSE
-                RETURN 0;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (PI0,  PI2  :        INT;
-                      PIO1, PIO2 : IN OUT INT;
-                      PO2        :    OUT INT) IS
- 
-      BEGIN
-           IF PI0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                FAILED ("INCORRECT VALUE FOR PI0'SIZE");
-           END IF;
- 
-           IF NOT ((PI0 < IDENT (1))             AND
-                   (IDENT (PI2) > IDENT (PIO1))  AND
-                   (PIO1 <= IDENT (63))         AND
-                   (IDENT (126) = PI2))          THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                        "OPERATORS - 1");
-           END IF;
- 
-           IF NOT (((PI0 + PI2)   = PIO2)        AND
-                   ((PI2 - PIO1)  = PIO1)        AND
-                   ((PIO1 * IDENT (2)) = PI2)    AND
-                   ((PIO2 / PIO1) = IDENT (2))   AND
-                   ((PIO1 ** 1)   = IDENT (63))  AND
-                   ((PIO2 REM 10)  = IDENT (6))  AND
-                   ((PIO1 MOD 10)  = IDENT (3))) THEN
-                FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                        "OPERATORS - 1");
-           END IF;
- 
-           IF INT'POS (PI0)  /= IDENT_INT (0)   OR
-              INT'POS (PIO1) /= IDENT_INT (63) OR
-              INT'POS (PI2)  /= IDENT_INT (126) THEN
-                FAILED ("INCORRECT VALUE FOR INT'POS - 1");
-           END IF;
- 
-           IF INT'SUCC (PI0)  /= IDENT (1)   OR
-              INT'SUCC (PIO1) /= IDENT (64) THEN
-                FAILED ("INCORRECT VALUE FOR INT'SUCC - 1");
-           END IF;
- 
-           IF INT'IMAGE (PI0)  /= IDENT_STR (" 0")   OR
-              INT'IMAGE (PIO1) /= IDENT_STR (" 63") OR
-              INT'IMAGE (PI2)  /= IDENT_STR (" 126") THEN
-                FAILED ("INCORRECT VALUE FOR INT'IMAGE - 1");
-           END IF;
- 
-           PO2 := 126;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A32E", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
-                       "GIVEN FOR AN INTEGER TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE WITH " &
-                       "THE SMALLEST APPROPRIATE UNSIGNED SIZE ARE " &
-                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      PROC (0, 126, I1, I2, I2);
- 
-      IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR INT'SIZE");
-      END IF;
- 
-      IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR I1'SIZE");
-      END IF;
- 
-      FOR I IN IDENT (I0) .. IDENT (I2) LOOP
-           IF NOT (I IN I0 .. I2) OR
-              (I NOT IN IDENT(0) .. IDENT(126)) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 2");
-           END IF;
-      END LOOP;
- 
-      IF NOT ((+I2 = I2)     AND
-              (-I1 = -63)   AND
-              (ABS I2 = I2)) THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
-                   "OPERATORS - 2");
-      END IF;
- 
-      IF INT'VAL (0)   /= IDENT (I0) OR
-         INT'VAL (63) /= IDENT (I1) OR
-         INT'VAL (126) /= IDENT (I2) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VAL - 2");
-      END IF;
- 
-      IF INT'PRED (I1) /= IDENT (62)  OR
-         INT'PRED (I2) /= IDENT (125) THEN
-           FAILED ("INCORRECT VALUE FOR INT'PRED - 2");
-      END IF;
- 
-      IF INT'VALUE ("0")   /= IDENT (I0) OR
-         INT'VALUE ("63") /= IDENT (I1) OR
-         INT'VALUE ("126") /= IDENT (I2) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VALUE - 2");
-      END IF;
- 
-      IF INTARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR INTARRAY(1)'SIZE");
-      END IF;
- 
-      IF NOT ((INTARRAY(0) < IDENT (1))                   AND
-              (IDENT (INTARRAY(2)) > IDENT (INTARRAY(1))) AND
-              (INTARRAY(1) <= IDENT (63))                AND
-              (IDENT (126) = INTARRAY(2)))                THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      FOR I IN IDENT (INTARRAY(0)) .. IDENT (INTARRAY(2)) LOOP
-           IF NOT (I IN INTARRAY(0) .. INTARRAY(2)) OR
-              (I NOT IN IDENT(0) .. IDENT(126))     THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 3");
-           END IF;
-      END LOOP;
- 
-      IF NOT (((INTARRAY(0) + INTARRAY(2))  = INTARRAY(2)) AND
-              ((INTARRAY(2) - INTARRAY(1))  = INTARRAY(1)) AND
-              ((INTARRAY(1) * IDENT (2))    = INTARRAY(2)) AND
-              ((INTARRAY(2) / INTARRAY(1))  = IDENT (2))   AND
-              ((INTARRAY(1) ** 1)           = IDENT (63))  AND
-              ((INTARRAY(2) REM 10)         = IDENT (6))   AND
-              ((INTARRAY(1) MOD 10)         = IDENT (3)))  THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      IF INT'POS (INTARRAY(0)) /= IDENT_INT (0)   OR
-         INT'POS (INTARRAY(1)) /= IDENT_INT (63) OR
-         INT'POS (INTARRAY(2)) /= IDENT_INT (126) THEN
-           FAILED ("INCORRECT VALUE FOR INT'POS - 3");
-      END IF;
- 
-      IF INT'SUCC (INTARRAY(0)) /= IDENT (1)   OR
-         INT'SUCC (INTARRAY(1)) /= IDENT (64) THEN
-           FAILED ("INCORRECT VALUE FOR INT'SUCC - 3");
-      END IF;
- 
-      IF INT'IMAGE (INTARRAY(0)) /= IDENT_STR (" 0")   OR
-         INT'IMAGE (INTARRAY(1)) /= IDENT_STR (" 63") OR
-         INT'IMAGE (INTARRAY(2)) /= IDENT_STR (" 126") THEN
-           FAILED ("INCORRECT VALUE FOR INT'IMAGE - 3");
-      END IF;
- 
-      IF IREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR IREC.COMP2'SIZE");
-      END IF;
- 
-      IF NOT ((IREC.COMP0 < IDENT (1))                  AND
-              (IDENT (IREC.COMP2) > IDENT (IREC.COMP1)) AND
-              (IREC.COMP1 <= IDENT (63))               AND
-              (IDENT (126) = IREC.COMP2))               THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      FOR I IN IDENT (IREC.COMP0) .. IDENT (IREC.COMP2) LOOP
-           IF NOT (I IN IREC.COMP0 .. IREC.COMP2) OR
-              (I NOT IN IDENT(0) .. IDENT(126))   THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 4");
-           END IF;
-      END LOOP;
- 
-      IF NOT ((+IREC.COMP2 = IREC.COMP2)     AND
-              (-IREC.COMP1 = -63)           AND
-              (ABS IREC.COMP2 = IREC.COMP2)) THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      IF INT'VAL (0)   /= IDENT (IREC.COMP0) OR
-         INT'VAL (63) /= IDENT (IREC.COMP1) OR
-         INT'VAL (126) /= IDENT (IREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VAL - 4");
-      END IF;
- 
-      IF INT'PRED (IREC.COMP1) /= IDENT (62)  OR
-         INT'PRED (IREC.COMP2) /= IDENT (125) THEN
-           FAILED ("INCORRECT VALUE FOR INT'PRED - 4");
-      END IF;
- 
-      IF INT'VALUE ("0")   /= IDENT (IREC.COMP0) OR
-         INT'VALUE ("63") /= IDENT (IREC.COMP1) OR
-         INT'VALUE ("126") /= IDENT (IREC.COMP2) THEN
-           FAILED ("INCORRECT VALUE FOR INT'VALUE - 4");
-      END IF;
- 
-      RESULT;
- 
- END CD2A32E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,131 ****
- -- CD2A32G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SIZE SPECIFICATION FOR AN INTEGER
- --     TYPE OF THE SMALLEST APPROPRIATE UNSIGNED SIZE CAN BE GIVEN:
- --        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
- --          DECLARED IN THE VISIBLE PART;
- --        FOR A DERIVED INTEGER TYPE;
- --        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
- --          AN INTEGER TYPE;
- --        FOR AN INTEGER TYPE GIVEN IN A GENERIC UNIT.
- 
- -- HISTORY:
- --     JET 08/12/87  CREATED ORIGINAL TEST.
- --     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
- --                   CHECKS, AND ADDED CHECK FOR 'SIZE IN A GENERIC
- --                   UNIT.
- --     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A32G IS
- 
-      TYPE BASIC_INT IS RANGE 0 .. 126;
-      SPECIFIED_SIZE : CONSTANT := 7;
- 
-      TYPE DERIVED_INT IS NEW BASIC_INT;
-      FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
- 
-      PACKAGE P IS
-           TYPE INT_IN_P IS RANGE 0 .. 126;
-           FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
-           TYPE PRIVATE_INT IS PRIVATE;
-           TYPE ALT_INT_IN_P IS RANGE 0 .. 126;
-      PRIVATE
-           TYPE PRIVATE_INT IS RANGE 0 .. 126;
-           FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
-      END P;
- 
-      USE P;
- 
-      TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
-      FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
- 
-      MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
- 
-      GENERIC
-      PROCEDURE GENPROC;
- 
-      PROCEDURE GENPROC IS
-           TYPE GEN_CHECK_INT IS RANGE 0 .. 126;
-           FOR GEN_CHECK_INT'SIZE USE SPECIFIED_SIZE;
- 
-      BEGIN
- 
-           IF GEN_CHECK_INT'SIZE /= MINIMUM_SIZE THEN
-                FAILED ("GEN_CHECK_INT'SIZE SHOULD NOT BE GREATER " &
-                        "THAN" & INTEGER'IMAGE(MINIMUM_SIZE) &
-                        ".  ACTUAL SIZE IS" &
-                        INTEGER'IMAGE(GEN_CHECK_INT'SIZE));
-           END IF;
-      END GENPROC;
- 
-      PROCEDURE NEWPROC IS NEW GENPROC;
- 
- BEGIN
- 
-      TEST("CD2A32G", "CHECK THAT SIZE SPECIFICATIONS OF THE SMALLEST " &
-                      "APPROPRIATE UNSIGNED SIZE CAN BE GIVEN " &
-                      "IN THE VISIBLE OR PRIVATE PART OF PACKAGE FOR " &
-                      "AN INTEGER TYPE DECLARED IN VISIBLE PART, " &
-                      "FOR DERIVED INTEGER " &
-                      "TYPES AND DERIVED PRIVATE TYPES WHOSE FULL " &
-                      "DECLARATION IS AS AN INTEGER TYPE AND FOR AN " &
-                      "INTEGER TYPE GIVEN IN A GENERIC UNIT");
- 
-      IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("DERIVED_INT'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_INT'SIZE));
-      END IF;
- 
-      IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("INT_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(INT_IN_P'SIZE));
-      END IF;
- 
-      IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("ALT_INT_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
-                   INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(ALT_INT_IN_P'SIZE));
-      END IF;
- 
-      IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("DERIVED_PRIVATE_INT'SIZE SHOULD NOT BE GREATER " &
-                   "THAN" & INTEGER'IMAGE(MINIMUM_SIZE) &
-                   ".  ACTUAL SIZE IS" &
-                   INTEGER'IMAGE(DERIVED_PRIVATE_INT'SIZE));
-      END IF;
- 
-      NEWPROC;
- 
-      RESULT;
- 
- END CD2A32G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- CD2A32I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION OF THE SMALLEST APPROPRIATE
- --     SIGNED SIZE IS GIVEN FOR AN INTEGER TYPE, THE TYPE CAN
- --     BE PASSED AS AN ACTUAL PARAMETER TO GENERIC PROCEDURES.
- 
- -- HISTORY:
- --     JET 08/12/87  CREATED ORIGINAL TEST.
- --     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON
- --                   'SIZE CHECKS.
- --     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT;  USE REPORT;
- PROCEDURE CD2A32I IS
- 
-      TYPE BASIC_INT IS RANGE -63 .. 63;
-      BASIC_SIZE : CONSTANT := 7;
- 
-      FOR BASIC_INT'SIZE USE BASIC_SIZE;
- 
- BEGIN
- 
-      TEST ("CD2A32I", "CHECK THAT WHEN A SIZE SPECIFICATION " &
-                       "OF THE SMALLEST APPROPRIATE SIGNED SIZE " &
-                       "IS GIVEN FOR AN INTEGER TYPE, " &
-                       "THE TYPE " &
-                       "CAN BE PASSED AS AN ACTUAL PARAMETER TO " &
-                       "GENERIC PROCEDURES");
- 
-      DECLARE -- TYPE DECLARATION WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS RANGE <>;
-           PROCEDURE GENPROC;
- 
-           PROCEDURE GENPROC IS
- 
-           SUBTYPE INT IS GPARM;
- 
-           I1 : INT := -63;
-           I2 : INT :=    0;
-           I3 : INT :=  63;
- 
-           FUNCTION IDENT (I : INT) RETURN INT IS
-           BEGIN
-                IF EQUAL (0,0) THEN
-                     RETURN I;
-                ELSE
-                     RETURN 0;
-                END IF;
-           END IDENT;
- 
-           BEGIN -- GENPROC.
- 
-                IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'SIZE");
-                END IF;
- 
-                IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR I1'SIZE");
-                END IF;
- 
-                FOR I IN IDENT (I1) .. IDENT (I3) LOOP
-                     IF NOT (I IN I1 .. I3) OR
-                        (I NOT IN IDENT(-63) .. IDENT(63)) THEN
-                          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                                  "OPERATORS");
-                     END IF;
-                END LOOP;
- 
-                IF NOT ((+I1 = I1)     AND
-                        (-I3 = I1)     AND
-                        (ABS I1 = I3)) THEN
-                     FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
-                             "OPERATORS");
-                END IF;
- 
-                IF INT'LAST /= IDENT (63) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'LAST");
-                END IF;
- 
-                IF INT'VAL (-63) /= IDENT (I1) OR
-                   INT'VAL (0)    /= IDENT (I2) OR
-                   INT'VAL (63)  /= IDENT (I3) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'VAL");
-                END IF;
- 
-                IF INT'PRED (I2) /= IDENT (-1) OR
-                   INT'PRED (I3) /= IDENT (62) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'PRED");
-                END IF;
- 
-                IF INT'VALUE ("-63") /= IDENT (I1) OR
-                   INT'VALUE (" 0")   /= IDENT (I2) OR
-                   INT'VALUE (" 63") /= IDENT (I3) THEN
-                          FAILED ("INCORRECT VALUE FOR INT'VALUE");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_INT);
- 
-      BEGIN
- 
-           NEWPROC;
- 
-      END;
- 
-      RESULT;
- 
- END CD2A32I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- CD2A32J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION OF THE SMALLEST APPROPRIATE
- --     UNSIGNED SIZE IS GIVEN FOR AN INTEGER TYPE, THE TYPE CAN BE
- --     PASSED AS AN ACTUAL PARAMETER TO GENERIC PROCEDURES.
- 
- -- HISTORY:
- --     JET 08/12/87  CREATED ORIGINAL TEST.
- --     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON
- --                   'SIZE CHECKS.
- --     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD2A32J IS
- 
-      TYPE BASIC_INT IS RANGE 0 .. 126;
-      BASIC_SIZE : CONSTANT := 7;
- 
-      FOR BASIC_INT'SIZE USE BASIC_SIZE;
- 
- BEGIN
- 
-      TEST ("CD2A32J", "CHECK THAT WHEN A SIZE SPECIFICATION " &
-                       "OF THE SMALLEST APPROPRIATE UNSIGNED SIZE " &
-                       "IS GIVEN FOR AN INTEGER TYPE, THE TYPE " &
-                       "CAN BE PASSED AS AN ACTUAL PARAMETER TO " &
-                       "GENERIC PROCEDURES");
- 
-      DECLARE -- TYPE DECLARATION WITHIN GENERIC PROCEDURE.
- 
-           GENERIC
-                TYPE GPARM IS RANGE <>;
-           PROCEDURE GENPROC;
- 
-           PROCEDURE GENPROC IS
- 
-           SUBTYPE INT IS GPARM;
- 
-           I0 : INT :=   0;
-           I1 : INT :=  63;
-           I2 : INT := 126;
- 
-           FUNCTION IDENT (I : INT) RETURN INT IS
-           BEGIN
-                IF EQUAL (0,0) THEN
-                     RETURN I;
-                ELSE
-                     RETURN 0;
-                END IF;
-           END IDENT;
- 
-           BEGIN -- GENPROC.
- 
-                IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'SIZE");
-                END IF;
- 
-                IF I0'SIZE < IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR I0'SIZE");
-                END IF;
- 
-                IF NOT ((I0 < IDENT (1))          AND
-                        (IDENT (I2) > IDENT (I1)) AND
-                        (I1 <= IDENT (63))       AND
-                        (IDENT (126) = I2))       THEN
-                     FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                             "OPERATORS");
-                END IF;
- 
-                IF NOT (((I0 + I2)  = I2)          AND
-                        ((I2 - I1)  = I1)          AND
-                        ((I1 * IDENT (2)) = I2)    AND
-                        ((I2 / I1)  = IDENT (2))   AND
-                        ((I1 ** 1)  = IDENT (63)) AND
-                        ((I2 REM 10) = IDENT (6))   AND
-                        ((I1 MOD 10) = IDENT (3)))  THEN
-                     FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
-                             "OPERATORS");
-                END IF;
- 
-                IF INT'POS (I0) /= IDENT_INT (0)   OR
-                   INT'POS (I1) /= IDENT_INT (63) OR
-                   INT'POS (I2) /= IDENT_INT (126) THEN
-                     FAILED ("INCORRECT VALUE FOR INT'POS");
-                END IF;
- 
-                IF INT'SUCC (I0) /= IDENT (1)   OR
-                   INT'SUCC (I1) /= IDENT (64)  THEN
-                     FAILED ("INCORRECT VALUE FOR INT'SUCC");
-                END IF;
- 
-                IF INT'IMAGE (I0) /= IDENT_STR (" 0")   OR
-                   INT'IMAGE (I1) /= IDENT_STR (" 63") OR
-                   INT'IMAGE (I2) /= IDENT_STR (" 126") THEN
-                     FAILED ("INCORRECT VALUE FOR INT'IMAGE");
-                END IF;
- 
-           END GENPROC;
- 
-           PROCEDURE NEWPROC IS NEW GENPROC (BASIC_INT);
- 
-      BEGIN
- 
-           NEWPROC;
- 
-      END;
- 
-      RESULT;
- 
- END CD2A32J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,193 ****
- -- CD2A51A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR A
- --     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 08/12/87  CREATED ORIGINAL TEST.
- --     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
- --                   SO THAT IT IS NOT A POWER OF TWO.
- --     WMC 03/31/92  ELIMINATED TEST REDUNDANCIES.
- --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A51A IS
- 
-      BASIC_SIZE : CONSTANT := 9;
- 
-      TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
- 
-      TYPE CHECK_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
- 
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
-      CNEG1 : CHECK_TYPE := -3.5;
-      CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
-      CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
-      CPOS2 : CHECK_TYPE :=  3.5;
-      CZERO : CHECK_TYPE;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE :=
-           (-3.5, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 3.5);
- 
-      TYPE REC_TYPE IS RECORD
-           COMPN1 : CHECK_TYPE := -3.5;
-           COMPN2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
-           COMPP1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
-           COMPP2 : CHECK_TYPE :=  3.5;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN FX;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (N1_IN, P1_IN      :        CHECK_TYPE;
-                      N2_INOUT,P2_INOUT : IN OUT CHECK_TYPE;
-                      CZOUT             :    OUT CHECK_TYPE) IS
-      BEGIN
- 
-           IF +IDENT (N2_INOUT) NOT IN -0.375 .. -0.3125 OR
-              IDENT (-P1_IN) NOT IN -0.6875 .. -0.625 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "UNARY ADDING OPERATORS - 1");
-           END IF;
- 
-           IF ABS IDENT (N2_INOUT) NOT IN 0.3125 .. 0.375 OR
-              IDENT (ABS P1_IN) NOT IN 0.625 .. 0.6875 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "ABSOLUTE VALUE OPERATORS - 1");
-           END IF;
- 
-           CZOUT := 0.0;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A51A", "CHECK THAT WHEN A SIZE SPECICFICATION IS " &
-                       "GIVEN FOR A FIXED POINT TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
-                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
- 
-      IF IDENT (CZERO) /= 0.0 THEN
-           FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
-      END IF;
- 
-      IF CHECK_TYPE'LAST < IDENT (3.9375) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
-      END IF;
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF CHECK_TYPE'AFT /= BASIC_TYPE'AFT THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'AFT");
-      END IF;
- 
-      IF CNEG1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
-      END IF;
- 
-      IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
-         CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE (CNEG1 * IDENT (CPOS1)) NOT IN -2.4375 .. -2.1875 OR
-         CHECK_TYPE (IDENT (CNEG2) / CPOS2) NOT IN
-                -0.125 .. -0.0625 THEN
-           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 2");
-      END IF;
- 
-      IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
-             CNEG2 IN -0.25 .. 0.0 OR
-             IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                   "OPERATORS - 2");
-      END IF;
- 
-      IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
-      END IF;
- 
-      IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
-         IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 3");
-      END IF;
- 
-      IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
-         IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
-           FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
-             CHARRAY (1) IN -0.25 .. 0.0 OR
-             IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      IF CHREC.COMPP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMPP1'SIZE");
-      END IF;
- 
-      IF IDENT (CHREC.COMPN1) + CHREC.COMPP1 NOT IN
-              -2.875 .. -2.8125 OR
-         CHREC.COMPP2  - IDENT (CHREC.COMPP1) NOT IN
-              2.8125 .. 2.875 THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE (CHREC.COMPN1 * IDENT (CHREC.COMPP1)) NOT IN
-           -2.4375 .. -2.1875 OR
-         CHECK_TYPE (IDENT (CHREC.COMPN2) / CHREC.COMPP2) NOT IN
-           -0.125 .. -0.0625 THEN
-           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 4");
-      END IF;
- 
-      IF IDENT (CHREC.COMPP1) NOT IN 0.625 .. 0.6875 OR
-             CHREC.COMPN2 IN -0.25 .. 0.0 OR
-             IDENT (CHREC.COMPN2) IN -1.0 .. -0.4375 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      RESULT;
- 
- END CD2A51A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,217 ****
- -- CD2A53A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS ARE GIVEN FOR A
- --     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE ARE
- --     NOT AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C)
- --          and which support decimal small values:
- --          The test must compile, bind, execute, report PASSED, and
- --          complete normally.
- --
- --      For other implementations:
- --          This test may produce at least one error message at compilation,
- --          and the error message is associated with one of the items marked:
- --             -- N/A => ERROR.
- --          The test will be recorded as Not_Applicable.
- --          Otherwise, the test must execute and report PASSED.
- --
- --      All other behaviors are FAILING.
- --
- -- HISTORY:
- --     BCB 08/24/87  CREATED ORIGINAL TEST.
- --     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
- --                   OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
- --                   SO THAT IT IS NOT A POWER OF TWO.
- --     WMC 04/01/92  ELIMINATED TEST REDUNDANCIES.
- --     RLB 11/24/98  Added Ada 95 applicability criteria.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A53A IS
-      BASIC_SIZE : CONSTANT := 15;
-      BASIC_SMALL : CONSTANT := 0.01;
- 
-      ZERO  : CONSTANT :=  0.0;
- 
-      TYPE CHECK_TYPE IS DELTA 1.0 RANGE -4.0 .. 4.0;
- 
-      FOR CHECK_TYPE'SMALL USE BASIC_SMALL;   -- N/A => ERROR.
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;     -- N/A => ERROR.
- 
-      CNEG1 : CHECK_TYPE := -2.7;
-      CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
-      CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
-      CPOS2 : CHECK_TYPE :=  2.7;
-      CZERO : CHECK_TYPE;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE :=
-           (-2.7, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 2.7);
- 
-      TYPE REC_TYPE IS RECORD
-           COMPF : CHECK_TYPE := -2.7;
-           COMPN : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
-           COMPP : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
-           COMPL : CHECK_TYPE :=  2.7;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN FX;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (CN1IN, CP1IN      :        CHECK_TYPE;
-                      CN2INOUT,CP2INOUT : IN OUT CHECK_TYPE;
-                      CZOUT             :    OUT CHECK_TYPE) IS
-      BEGIN
- 
-           IF IDENT (CN1IN) + CP1IN NOT IN -2.04 .. -2.03 OR
-              CP2INOUT  - IDENT (CP1IN) NOT IN 2.03 .. 2.04 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "BINARY ADDING OPERATORS - 1");
-           END IF;
- 
-           IF CHECK_TYPE (CN1IN * IDENT (CP1IN)) NOT IN
-              -1.81 .. -1.78 OR
-              CHECK_TYPE (IDENT (CN2INOUT) / CP2INOUT) NOT IN
-              -0.13 .. -0.12 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "MULTIPLYING OPERATORS - 1");
-           END IF;
- 
-           IF IDENT (CP1IN) NOT IN 0.66 .. 0.670 OR
-                  CN2INOUT IN -0.32 .. 0.0 OR
-                  IDENT (CN2INOUT) IN -1.0 .. -0.35 THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                        "OPERATORS - 1");
-           END IF;
- 
-           CZOUT := 0.0;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2A53A", "CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS " &
-                       "ARE GIVEN FOR A FIXED POINT TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT " &
-                       "AFFECTED BY THE REPRESENTATION CLAUSE");
- 
-      PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
- 
-      IF CNEG1'SIZE < IDENT_INT(BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
-      END IF;
- 
-      IF IDENT (CZERO) /= ZERO THEN
-           FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
-      END IF;
- 
-      IF CHECK_TYPE'FIRST > IDENT (-3.99) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
-      END IF;
- 
-      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
-      END IF;
- 
-      IF CHECK_TYPE'SMALL /= BASIC_SMALL THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SMALL");
-      END IF;
- 
-      IF CHECK_TYPE'FORE /= 2 THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FORE");
-      END IF;
- 
-      IF +IDENT (CNEG2) NOT IN -0.34 .. -0.33 OR
-         IDENT (-CPOS1) NOT IN -0.67 .. -0.66 THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 2");
-      END IF;
- 
-      IF ABS IDENT (CNEG2) NOT IN 0.33 .. 0.34 OR
-         IDENT (ABS CPOS1) NOT IN 0.66 .. 0.670 THEN
-           FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
-                   "OPERATORS - 2");
-      END IF;
- 
-      IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
-      END IF;
- 
-      IF IDENT (CHARRAY (0)) + CHARRAY (2) NOT IN
-              -2.04 .. -2.03 OR
-         CHARRAY (3)  - IDENT (CHARRAY (2)) NOT IN
-              2.03 .. 2.04 THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE (CHARRAY (0) * IDENT (CHARRAY (2))) NOT IN
-           -1.81 .. -1.78 OR
-         CHECK_TYPE (IDENT (CHARRAY (1)) / CHARRAY (3)) NOT IN
-           -0.13 .. -0.12 THEN
-           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 3");
-      END IF;
- 
-      IF IDENT (CHARRAY (2)) NOT IN 0.66 .. 0.670 OR
-             CHARRAY (1) IN -0.32 .. 0.0 OR
-             IDENT (CHARRAY (1)) IN -1.0 .. -0.35 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      IF CHREC.COMPP'SIZE < IDENT_INT (BASIC_SIZE) THEN
-           FAILED ("INCORRECT VALUE FOR CHREC.COMPP'SIZE");
-      END IF;
- 
-      IF +IDENT (CHREC.COMPN) NOT IN -0.34 .. -0.33 OR
-         IDENT (-CHREC.COMPP) NOT IN -0.67 .. -0.66 THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 4");
-      END IF;
- 
-      IF ABS IDENT (CHREC.COMPN) NOT IN 0.33 .. 0.34 OR
-         IDENT (ABS CHREC.COMPP) NOT IN 0.66 .. 0.670 THEN
-           FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      IF IDENT (CHREC.COMPP) NOT IN 0.66 .. 0.670 OR
-             CHREC.COMPN IN -0.32 .. 0.0 OR
-             IDENT (CHREC.COMPN) IN -1.0 .. -0.35 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      RESULT;
- 
- END CD2A53A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,235 ****
- -- CD2A53E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS ARE GIVEN FOR A
- --     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
- --     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE WHEN THE TYPE
- --     IS PASSED AS A GENERIC ACTUAL PARAMETER.
- 
- -- HISTORY:
- --     BCB 08/24/87  CREATED ORIGINAL TEST.
- --     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND CHANGED
- --                   OPERATORS ON 'SIZE TESTS.
- --     WMC 04/01/92  ELIMINATED TEST REDUNDANCIES.
- --     MRM 07/16/92  FIX ALIGNMENT OF BLOCK BODY
- --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A53E IS
- 
-      BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
-      BASIC_SMALL : CONSTANT := 2.0 ** (-4);
-      B : BOOLEAN;
- 
-      TYPE CHECK_TYPE IS DELTA 1.0 RANGE -4.0 .. 4.0;
-      FOR CHECK_TYPE'SMALL USE BASIC_SMALL;
-      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
- 
- BEGIN
- 
-      TEST ("CD2A53E", "CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS " &
-                       "ARE GIVEN FOR A FIXED POINT TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT " &
-                       "AFFECTED BY THE REPRESENTATION CLAUSE WHEN " &
-                       "THE TYPE IS PASSED AS A GENERIC ACTUAL " &
-                       "PARAMETER");
- 
-      DECLARE
- 
-           GENERIC
- 
-                TYPE FIXED_ELEMENT IS DELTA <>;
- 
-           FUNCTION FUNC RETURN BOOLEAN;
- 
-           FUNCTION FUNC RETURN BOOLEAN IS
- 
-                ZERO  : CONSTANT :=  0.0;
- 
-                TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
- 
-                CNEG1 : FIXED_ELEMENT := -3.5;
-                CNEG2 : FIXED_ELEMENT := FIXED_ELEMENT (-1.0/3.0);
-                CPOS1 : FIXED_ELEMENT := FIXED_ELEMENT (4.0/6.0);
-                CPOS2 : FIXED_ELEMENT :=  3.5;
-                CZERO : FIXED_ELEMENT;
- 
-                TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF FIXED_ELEMENT;
-                CHARRAY : ARRAY_TYPE :=
-                    (-3.5, FIXED_ELEMENT (-1.0/3.0), FIXED_ELEMENT
-                     (4.0/6.0), 3.5);
- 
-                TYPE REC_TYPE IS RECORD
-                     COMPF : FIXED_ELEMENT := -3.5;
-                     COMPN : FIXED_ELEMENT := FIXED_ELEMENT (-1.0/3.0);
-                     COMPP : FIXED_ELEMENT := FIXED_ELEMENT (4.0/6.0);
-                     COMPL : FIXED_ELEMENT :=  3.5;
-                END RECORD;
- 
-                CHREC : REC_TYPE;
- 
-                FUNCTION IDENT (FX : FIXED_ELEMENT) RETURN
-                     FIXED_ELEMENT IS
-                BEGIN
-                     IF EQUAL (3, 3) THEN
-                          RETURN FX;
-                     ELSE
-                          RETURN 0.0;
-                     END IF;
-                END IDENT;
- 
-                PROCEDURE PROC (CN1IN, CP1IN      :        FIXED_ELEMENT;
-                                CN2INOUT,CP2INOUT : IN OUT FIXED_ELEMENT;
-                                CZOUT             :    OUT FIXED_ELEMENT)
-                                IS
-                BEGIN
- 
-                     IF +IDENT (CN2INOUT) NOT IN -0.375 .. -0.3125 OR
-                         IDENT (-CP1IN) NOT IN -0.6875 .. -0.625 THEN
-                         FAILED ("INCORRECT RESULTS FOR " &
-                                 "UNARY ADDING OPERATORS - 1");
-                     END IF;
- 
-                     IF ABS IDENT (CN2INOUT) NOT IN 0.3125 .. 0.375 OR
-                          IDENT (ABS CP1IN) NOT IN 0.625 .. 0.6875 THEN
-                          FAILED ("INCORRECT RESULTS FOR " &
-                                  "ABSOLUTE VALUE OPERATORS - 1");
-                     END IF;
- 
-                     CZOUT := 0.0;
- 
-                END PROC;
- 
-           BEGIN -- FUNC
- 
-                PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
- 
-                IF IDENT (CZERO) /= ZERO THEN
-                     FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
-                END IF;
- 
-                IF FIXED_ELEMENT'LAST < IDENT (3.9375) THEN
-                     FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'LAST");
-                END IF;
- 
-                IF FIXED_ELEMENT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'SIZE");
-                END IF;
- 
-                IF FIXED_ELEMENT'SMALL /= BASIC_SMALL THEN
-                     FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'SMALL");
-                END IF;
- 
-                IF FIXED_ELEMENT'AFT /= 1 THEN
-                     FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'AFT");
-                END IF;
- 
-                IF CNEG1'SIZE < IDENT_INT(BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
-                END IF;
- 
-                IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
-                    CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
-                     FAILED ("INCORRECT RESULTS FOR BINARY ADDING " &
-                             "OPERATORS - 2");
-                END IF;
- 
-                IF FIXED_ELEMENT (CNEG1 * IDENT (CPOS1)) NOT IN
-                     -2.4375 .. -2.1875 OR
-                   FIXED_ELEMENT (IDENT (CNEG2) / CPOS2) NOT IN
-                     -0.125 .. -0.0625 THEN
-                     FAILED ("INCORRECT RESULTS FOR MULTIPLYING " &
-                             "OPERATORS - 2");
-                END IF;
- 
-                IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
-                       CNEG2 IN -0.25 .. 0.0 OR
-                       IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
-                     FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                             "OPERATORS - 2");
-                END IF;
- 
-                IF CHARRAY(1)'SIZE < IDENT_INT(BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
-                END IF;
- 
-                IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
-                     IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
-                     FAILED ("INCORRECT RESULTS FOR UNARY ADDING " &
-                             "OPERATORS - 3");
-                END IF;
- 
-                IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
-                   IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
-                     FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
-                             "OPERATORS - 3");
-                END IF;
- 
-                IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
-                       CHARRAY (1) IN -0.25 .. 0.0 OR
-                       IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
-                     FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                             "OPERATORS - 3");
-                END IF;
- 
-                IF CHREC.COMPP'SIZE < IDENT_INT(BASIC_SIZE) THEN
-                     FAILED ("INCORRECT VALUE FOR CHREC.COMPP'SIZE");
-                END IF;
- 
-                IF IDENT (CHREC.COMPF) + CHREC.COMPP NOT IN
-                      -2.875 .. -2.8125 OR
-                     CHREC.COMPL  - IDENT (CHREC.COMPP) NOT IN
-                      2.8125 .. 2.875 THEN
-                     FAILED ("INCORRECT RESULTS FOR BINARY ADDING " &
-                                "OPERATORS - 4");
-                END IF;
- 
-                IF FIXED_ELEMENT (CHREC.COMPF * IDENT (CHREC.COMPP))
-                     NOT IN -2.4375 .. -2.1875 OR
-                   FIXED_ELEMENT (IDENT (CHREC.COMPN) / CHREC.COMPL)
-                     NOT IN -0.125 .. -0.0625 THEN
-                     FAILED ("INCORRECT RESULTS FOR MULTIPLYING " &
-                             "OPERATORS - 4");
-                END IF;
- 
-                IF IDENT (CHREC.COMPP) NOT IN 0.625 .. 0.6875 OR
-                       CHREC.COMPN IN -0.25 .. 0.0 OR
-                       IDENT (CHREC.COMPN) IN -1.0 .. -0.4375 THEN
-                     FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
-                             "OPERATORS - 4");
-                END IF;
- 
-                RETURN TRUE;
- 
-           END FUNC;
- 
-           FUNCTION NEWFUNC IS NEW FUNC(CHECK_TYPE);
-      BEGIN
-           B := NEWFUNC;
-      END;
- 
-      RESULT;
- 
- END CD2A53E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- CD2A83C.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SIZE AND COLLECTION SIZE SPECIFICATIONS
- --     FOR AN ACCESS TYPE CAN BE GIVEN IN THE VISIBLE OR
- --     PRIVATE PART OF A PACKAGE FOR A TYPE DECLARED IN
- --     THE VISIBLE PART.
- 
- -- HISTORY:
- --     JET 09/01/87  CREATED ORIGINAL TEST.
- --     DHH 04/11/89  CHANGED OPERATOR ON 'SIZE CHECKS AND REMOVED
- --                   APPLICABILITY CRITERIA.
- 
- --     $ACC_SIZE IS THE SIZE IN BITS FOR AN ACCESS VARIABLE WHOSE
- --     DESIGNATED TYPE IS A STRING TYPE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A83C IS
- 
-      SPECIFIED_SIZE : CONSTANT := $ACC_SIZE;
-      COLL_SIZE : CONSTANT := 256;
- 
-      TYPE CHECK_ACC IS ACCESS STRING;
- 
-      FOR CHECK_ACC'STORAGE_SIZE USE COLL_SIZE;
- 
-      FOR CHECK_ACC'SIZE USE SPECIFIED_SIZE;
- 
-      PACKAGE P IS
-           TYPE ACC_IN_P IS ACCESS STRING;
-           FOR ACC_IN_P'STORAGE_SIZE USE COLL_SIZE;
-           FOR ACC_IN_P'SIZE USE SPECIFIED_SIZE;
-           TYPE PRIVATE_ACC IS PRIVATE;
-           TYPE ALT_ACC_IN_P IS ACCESS STRING;
-      PRIVATE
-           TYPE PRIVATE_ACC IS ACCESS STRING;
-           FOR ALT_ACC_IN_P'STORAGE_SIZE USE COLL_SIZE;
-           FOR ALT_ACC_IN_P'SIZE USE SPECIFIED_SIZE;
-      END P;
- 
-      USE P;
- 
-      MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
- 
- BEGIN
- 
-      TEST("CD2A83C", "CHECK THAT WHEN SIZE AND COLLECTION SIZE " &
-                      "SPECIFICATIONS FOR AN ACCESS TYPE, " &
-                      "CAN BE GIVEN IN " &
-                      "THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR " &
-                      "A TYPE DECLARED IN THE VISIBLE PART");
- 
-      IF CHECK_ACC'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("CHECK_ACC'SIZE /= SPECIFIED_SIZE");
-      END IF;
- 
-      IF CHECK_ACC'STORAGE_SIZE < COLL_SIZE THEN
-           FAILED ("CHECK_ACC'STORAGE_SIZE TOO SMALL");
-      END IF;
- 
-      IF ACC_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("ACC_IN_P'SIZE /= SPECIFIED_SIZE");
-      END IF;
- 
-      IF ACC_IN_P'STORAGE_SIZE < COLL_SIZE THEN
-           FAILED ("ACC_IN_P'STORAGE_SIZE TOO SMALL");
-      END IF;
- 
-      IF ALT_ACC_IN_P'SIZE /= MINIMUM_SIZE THEN
-           FAILED ("ALT_ACC_IN_P'SIZE /= SPECIFIED_SIZE");
-      END IF;
- 
-      IF ALT_ACC_IN_P'STORAGE_SIZE < COLL_SIZE THEN
-           FAILED ("ALT_ACC_IN_P'STORAGE_SIZE TOO SMALL");
-      END IF;
- 
-      RESULT;
- 
- END CD2A83C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- CD2A91C.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SIZE SPECIFICATION FOR A TASK TYPE CAN BE GIVEN IN
- --     THE VISIBLE OR PRIVATE PART OF A PACKAGE.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_SIZE IS THE NUMBER OF BITS NEEDED BY THE IMPLEMENTATION TO
- --     HOLD ANY POSSIBLE OBJECT OF THE TASK TYPE "BASIC_TYPE".
- 
- -- HISTORY:
- --     BCB 09/08/87  CREATED ORIGINAL TEST.
- --     RJW 05/12/89  MODIFIED CHECKS INVOLVING 'SIZE ATTRIBUTE.
- --                   REMOVED APPLICABILTY CRITERIA.
- --     DTN 11/20/91  DELETED SUBPARTS (B and C).
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2A91C IS
- 
-      BASIC_SIZE : CONSTANT := $TASK_SIZE;
- 
-      VAL : INTEGER := 1;
- 
-      TASK TYPE BASIC_TYPE IS
-           ENTRY HERE(NUM : IN OUT INTEGER);
-      END BASIC_TYPE;
- 
-      FOR BASIC_TYPE'SIZE USE BASIC_SIZE;
- 
-      BASIC_TASK : BASIC_TYPE;
- 
-      PACKAGE P IS
-           TASK TYPE TASK_IN_P IS
-                ENTRY HERE(NUM : IN OUT INTEGER);
-           END TASK_IN_P;
-           FOR TASK_IN_P'SIZE USE BASIC_SIZE;
-           TASK TYPE ALT_TASK_IN_P IS
-                ENTRY HERE(NUM : IN OUT INTEGER);
-           END ALT_TASK_IN_P;
-      PRIVATE
-           FOR ALT_TASK_IN_P'SIZE USE BASIC_SIZE;
-      END P;
- 
-      USE P;
- 
-      ALT_TASK : ALT_TASK_IN_P;
-      IN_TASK : TASK_IN_P;
- 
-      TASK BODY BASIC_TYPE IS
-      BEGIN
-           SELECT
-                ACCEPT HERE(NUM : IN OUT INTEGER) DO
-                      NUM := 0;
-                END HERE;
-           OR
-                TERMINATE;
-           END SELECT;
-      END BASIC_TYPE;
- 
-      PACKAGE BODY P IS
-           TASK BODY TASK_IN_P IS
-           BEGIN
-                SELECT
-                     ACCEPT HERE(NUM : IN OUT INTEGER) DO
-                           NUM := 0;
-                     END HERE;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END TASK_IN_P;
-           TASK BODY ALT_TASK_IN_P IS
-           BEGIN
-                SELECT
-                     ACCEPT HERE(NUM : IN OUT INTEGER) DO
-                           NUM := 0;
-                     END HERE;
-                OR
-                     TERMINATE;
-                END SELECT;
-           END ALT_TASK_IN_P;
-      END P;
- 
- BEGIN
-      TEST ("CD2A91C", "CHECK THAT A SIZE SPECIFICATION FOR A TASK " &
-                       "TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE " &
-                       "PART OF A PACKAGE");
- 
-      BASIC_TASK.HERE(VAL);
- 
-      IF VAL /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT RESULTS FROM ENTRY CALL - 1");
-      END IF;
- 
-      VAL := 1;
- 
-      ALT_TASK.HERE(VAL);
-  
-      IF VAL /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT RESULTS FROM ENTRY CALL - 2");
-      END IF;
-  
-      VAL := 1;
- 
-      IN_TASK.HERE(VAL);
- 
-      IF VAL /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT RESULTS FROM ENTRY CALL - 3");
-      END IF;
- 
- 
-      RESULT;
- END CD2A91C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,214 ****
- -- CD2B11A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A COLLECTION SIZE SPECIFICATION CAN BE GIVEN FOR AN
- --     ACCESS TYPE, THEN OPERATIONS ON VALUES OF THE ACCESS TYPE ARE NOT
- --     AFFECTED.
- 
- -- HISTORY:
- --     BCB 11/01/88  CREATED ORIGINAL TEST.
- --     RJW 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
- --                   ADDED CHECK FOR UNCHECKED_DEALLOCATION.
- 
- WITH REPORT;  USE REPORT;
- WITH SYSTEM;
- WITH UNCHECKED_DEALLOCATION;
- PROCEDURE CD2B11A IS
- 
-      BASIC_SIZE : CONSTANT := 1024;
- 
-      TYPE MAINTYPE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-      TYPE ACC_TYPE IS ACCESS MAINTYPE;
-      SUBTYPE ACC_RANGE IS ACC_TYPE (1 .. 3);
- 
-      FOR ACC_TYPE'STORAGE_SIZE USE BASIC_SIZE;
- 
-      TYPE RECORD_TYPE IS RECORD
-           COMP : ACC_TYPE;
-      END RECORD;
- 
-      CHECK_TYPE1 : ACC_TYPE;
-      CHECK_TYPE2 : ACC_TYPE;
-      CHECK_TYPE3 : ACC_TYPE(1..3);
- 
-      CHECK_ARRAY : ARRAY (1..2) OF ACC_TYPE;
- 
-      CHECK_RECORD1 : RECORD_TYPE;
-      CHECK_RECORD2 : RECORD_TYPE;
- 
-      CHECK_PARAM1 : ACC_TYPE;
-      CHECK_PARAM2 : ACC_TYPE;
- 
-      CHECK_NULL : ACC_TYPE := NULL;
- 
-      PROCEDURE PROC (ACC1,ACC2 : IN OUT ACC_TYPE) IS
- 
-      BEGIN
- 
-           IF (ACC1.ALL /= ACC2.ALL) THEN
-                FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS " &
-                        "- 1");
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                ACC2 := ACC1;
-           END IF;
- 
-           IF ACC2 /= ACC1 THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
-                        "-1");
-           END IF;
- 
-           IF (ACC1 IN ACC_RANGE) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 1");
-           END IF;
- 
-      END PROC;
- 
- BEGIN
- 
-      TEST ("CD2B11A", "CHECK THAT IF A COLLECTION SIZE SPECIFICATION " &
-                       "CAN BE GIVEN FOR AN ACCESS TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF THE ACCESS TYPE ARE " &
-                       "NOT AFFECTED");
- 
-      CHECK_PARAM1 := NEW MAINTYPE'(25,35,45);
-      CHECK_PARAM2 := NEW MAINTYPE'(25,35,45);
- 
-      PROC (CHECK_PARAM1,CHECK_PARAM2);
- 
-      IF ACC_TYPE'STORAGE_SIZE < BASIC_SIZE THEN
-           FAILED ("INCORRECT VALUE FOR ACCESS TYPE STORAGE_SIZE");
-      END IF;
- 
-      CHECK_TYPE1 := NEW MAINTYPE'(25,35,45);
-      CHECK_TYPE2 := NEW MAINTYPE'(25,35,45);
-      CHECK_TYPE3 := NEW MAINTYPE'(1 => 1,2 => 2,3 => 3);
- 
-      CHECK_ARRAY (1) := NEW MAINTYPE'(25,35,45);
-      CHECK_ARRAY (2) := NEW MAINTYPE'(25,35,45);
- 
-      CHECK_RECORD1.COMP := NEW MAINTYPE'(25,35,45);
-      CHECK_RECORD2.COMP := NEW MAINTYPE'(25,35,45);
- 
-      IF (CHECK_TYPE1.ALL /= CHECK_TYPE2.ALL) THEN
-           FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 2");
-      END IF;
- 
-      IF EQUAL (3,3) THEN
-           CHECK_TYPE2 := CHECK_TYPE1;
-      END IF;
- 
-      IF CHECK_TYPE2 /= CHECK_TYPE1 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
-      END IF;
- 
-      IF (CHECK_TYPE1 IN ACC_RANGE) THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 2");
-      END IF;
- 
-      IF (CHECK_ARRAY (1).ALL /= CHECK_ARRAY (2).ALL) THEN
-           FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 3");
-      END IF;
- 
-      IF EQUAL (3,3) THEN
-           CHECK_ARRAY (2) := CHECK_ARRAY (1);
-      END IF;
- 
-      IF CHECK_ARRAY (2) /= CHECK_ARRAY (1) THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
-      END IF;
- 
-      IF (CHECK_ARRAY (1) IN ACC_RANGE) THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 3");
-      END IF;
- 
-      IF (CHECK_RECORD1.COMP.ALL /= CHECK_RECORD2.COMP.ALL) THEN
-           FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 4");
-      END IF;
- 
-      IF EQUAL (3,3) THEN
-           CHECK_RECORD2 := CHECK_RECORD1;
-      END IF;
- 
-      IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
-      END IF;
- 
-      IF (CHECK_RECORD1.COMP IN ACC_RANGE) THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 4");
-      END IF;
- 
-      IF CHECK_TYPE3'FIRST /= IDENT_INT (1) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'FIRST");
-      END IF;
- 
-      IF CHECK_TYPE3'LAST /= IDENT_INT (3) THEN
-           FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'LAST");
-      END IF;
- 
-      DECLARE
-           TYPE ACC_CHAR IS ACCESS CHARACTER;
-           FOR ACC_CHAR'STORAGE_SIZE USE 128;
- 
-           LIMIT : INTEGER :=
-            (ACC_CHAR'STORAGE_SIZE * SYSTEM.STORAGE_UNIT)/CHARACTER'SIZE;
- 
-           ACC_ARRAY : ARRAY (1 .. LIMIT + 1) OF ACC_CHAR;
-           PLACE : INTEGER;
- 
-           PROCEDURE FREE IS
-                NEW UNCHECKED_DEALLOCATION (CHARACTER, ACC_CHAR);
-      BEGIN
-           FOR I IN ACC_ARRAY'RANGE LOOP
-                ACC_ARRAY (IDENT_INT (I)) :=
-                     NEW CHARACTER'
-                          (IDENT_CHAR ((CHARACTER'VAL (I MOD 128))));
-                PLACE := I;
-           END LOOP;
-           FAILED ("NO EXCEPTION RAISED WHEN COLLECTION SIZE EXCEEDED");
-      EXCEPTION
-           WHEN STORAGE_ERROR =>
-                BEGIN
-                     FOR I IN 1 .. PLACE LOOP
-                          IF I MOD 2 = 0 THEN
-                               FREE (ACC_ARRAY (IDENT_INT (I)));
-                          END IF;
-                     END LOOP;
- 
-                     FOR I IN 1 .. PLACE LOOP
-                          IF I MOD 2 = 1 AND THEN
-                             IDENT_CHAR (ACC_ARRAY (I).ALL) /=
-                             CHARACTER'VAL (I MOD IDENT_INT (128)) THEN
-                               FAILED ("INCORRECT VALUE IN ARRAY");
-                          END IF;
-                     END LOOP;
-                END;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED");
-      END;
- 
-      RESULT;
- END CD2B11A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- CD2B11B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A COLLECTION SIZE IS SPECIFIED FOR AN
- --     ACCESS TYPE IN A GENERIC UNIT, THEN OPERATIONS ON VALUES OF THE
- --     ACCESS TYPE ARE NOT AFFECTED.
- 
- -- HISTORY:
- --     BCB 09/23/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD2B11B IS
- 
-      BASIC_SIZE : CONSTANT := 1024;
-      B : BOOLEAN;
- 
- BEGIN
- 
-      TEST ("CD2B11B", "CHECK THAT IF A COLLECTION SIZE IS SPECIFIED " &
-                       "FOR AN ACCESS TYPE, THEN " &
-                       "OPERATIONS ON VALUES OF THE ACCESS TYPE ARE " &
-                       "NOT AFFECTED");
- 
-      DECLARE
- 
-           GENERIC
-           FUNCTION FUNC RETURN BOOLEAN;
- 
-           FUNCTION FUNC RETURN BOOLEAN IS
- 
-                TYPE MAINTYPE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
-                TYPE ACC_TYPE IS ACCESS MAINTYPE;
-                SUBTYPE ACC_RANGE IS ACC_TYPE (1 .. 3);
- 
-                FOR ACC_TYPE'STORAGE_SIZE
-                     USE BASIC_SIZE;
- 
-                TYPE RECORD_TYPE IS RECORD
-                     COMP : ACC_TYPE;
-                END RECORD;
- 
-                CHECK_TYPE1 : ACC_TYPE;
-                CHECK_TYPE2 : ACC_TYPE;
-                CHECK_TYPE3 : ACC_TYPE(1..3);
- 
-                CHECK_ARRAY : ARRAY (1..3) OF ACC_TYPE;
- 
-                CHECK_RECORD1 : RECORD_TYPE;
-                CHECK_RECORD2 : RECORD_TYPE;
- 
-                CHECK_PARAM1 : ACC_TYPE;
-                CHECK_PARAM2 : ACC_TYPE;
- 
-                CHECK_NULL : ACC_TYPE := NULL;
- 
-                PROCEDURE PROC (ACC1,ACC2 : IN OUT ACC_TYPE) IS
- 
-                BEGIN
- 
-                     IF (ACC1.ALL /= ACC2.ALL) THEN
-                          FAILED ("INCORRECT VALUES FOR DESIGNATED " &
-                                  "OBJECTS - 1");
-                     END IF;
- 
-                     IF EQUAL (3,3) THEN
-                          ACC2 := ACC1;
-                     END IF;
- 
-                     IF ACC2 /= ACC1 THEN
-                          FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
-                                  "OPERATORS - 1");
-                     END IF;
- 
-                     IF (ACC1 IN ACC_RANGE) THEN
-                          FAILED ("INCORRECT RESULTS FOR " &
-                                  "MEMBERSHIP TEST - 1");
-                     END IF;
- 
-                END PROC;
- 
-      BEGIN -- FUNC.
- 
-           CHECK_PARAM1 := NEW MAINTYPE'(25,35,45);
-           CHECK_PARAM2 := NEW MAINTYPE'(25,35,45);
- 
-           PROC (CHECK_PARAM1,CHECK_PARAM2);
- 
-           IF ACC_TYPE'STORAGE_SIZE < BASIC_SIZE THEN
-                FAILED ("INCORRECT VALUE FOR ACCESS TYPE STORAGE_SIZE");
-           END IF;
- 
-           CHECK_TYPE1 := NEW MAINTYPE'(25,35,45);
-           CHECK_TYPE2 := NEW MAINTYPE'(25,35,45);
-           CHECK_TYPE3 := NEW MAINTYPE'(1 => 1,2 => 2,3 => 3);
- 
-           CHECK_ARRAY (1) := NEW MAINTYPE'(25,35,45);
-           CHECK_ARRAY (2) := NEW MAINTYPE'(25,35,45);
- 
-           CHECK_RECORD1.COMP := NEW MAINTYPE'(25,35,45);
-           CHECK_RECORD2.COMP := NEW MAINTYPE'(25,35,45);
- 
-           IF (CHECK_TYPE1.ALL /= CHECK_TYPE2.ALL) THEN
-                FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 2");
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                CHECK_TYPE2 := CHECK_TYPE1;
-           END IF;
- 
-           IF CHECK_TYPE2 /= CHECK_TYPE1 THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
-                        "- 2");
-           END IF;
- 
-           IF (CHECK_TYPE1 IN ACC_RANGE) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 2");
-           END IF;
- 
-           IF (CHECK_ARRAY (1).ALL /= CHECK_ARRAY (2).ALL) THEN
-                FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 3");
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                CHECK_ARRAY (2) := CHECK_ARRAY (1);
-           END IF;
- 
-           IF CHECK_ARRAY (2) /= CHECK_ARRAY (1) THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
-                        "- 3");
-           END IF;
- 
-           IF (CHECK_ARRAY (1) IN ACC_RANGE) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 3");
-           END IF;
- 
-           IF (CHECK_RECORD1.COMP.ALL /= CHECK_RECORD2.COMP.ALL) THEN
-                FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 4");
-           END IF;
- 
-           IF EQUAL (3,3) THEN
-                CHECK_RECORD2 := CHECK_RECORD1;
-           END IF;
- 
-           IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
-                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
-                        "- 4");
-           END IF;
- 
-           IF (CHECK_RECORD1.COMP IN ACC_RANGE) THEN
-                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 4");
-           END IF;
- 
-           IF CHECK_TYPE3'FIRST /= IDENT_INT (1) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'FIRST");
-           END IF;
- 
-           IF CHECK_TYPE3'LAST /= IDENT_INT (3) THEN
-                FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'LAST");
-           END IF;
- 
-           RETURN TRUE;
- 
-      END FUNC;
- 
-      FUNCTION NEWFUNC IS NEW FUNC;
- 
-      BEGIN
-           B := NEWFUNC;
-      END;
- 
-      RESULT;
- END CD2B11B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- CD2B11D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE EXPRESSION IN A COLLECTION SIZE CLAUSE
- --     FOR AN ACCESS TYPE NEED NOT BE STATIC.
- 
- -- HISTORY:
- --     BCB 09/23/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD2B11D IS
- 
-      TYPE CHECK_TYPE IS ACCESS INTEGER;
-      FOR CHECK_TYPE'STORAGE_SIZE USE 256;
- 
-      TYPE ACC_TYPE IS ACCESS INTEGER;
-      FOR ACC_TYPE'STORAGE_SIZE USE IDENT_INT (256);
- 
- BEGIN
- 
-      TEST ("CD2B11D", "CHECK THAT THE EXPRESSION IN A COLLECTION " &
-                       "SIZE SPECIFICATION FOR AN ACCESS TYPE "&
-                       "NEED NOT BE STATIC");
- 
-      IF ACC_TYPE'STORAGE_SIZE < IDENT_INT (256) THEN
-           FAILED ("INCORRECT VALUE FOR STORAGE_SIZE");
-      END IF;
- 
-      RESULT;
- END CD2B11D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CD2B11E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE EXPRESSION IN A COLLECTION SIZE CLAUSE
- --     FOR AN ACCESS TYPE IN A GENERIC UNIT NEED NOT BE STATIC.
- 
- -- HISTORY:
- --     BCB 09/23/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD2B11E IS
- 
-      B : BOOLEAN;
- 
- BEGIN
- 
-      TEST ("CD2B11E", "CHECK THAT THE EXPRESSION IN A COLLECTION " &
-                       "SIZE CLAUSE FOR AN ACCESS TYPE IN A " &
-                       "GENERIC UNIT NEED NOT BE STATIC");
- 
-      DECLARE
- 
-           GENERIC
-           FUNCTION FUNC RETURN BOOLEAN;
- 
-           FUNCTION FUNC RETURN BOOLEAN IS
- 
-                TYPE TEST_TYPE IS ACCESS INTEGER;
-                FOR TEST_TYPE'STORAGE_SIZE USE 256;
- 
-                TYPE ACC_TYPE IS ACCESS INTEGER;
-                FOR ACC_TYPE'STORAGE_SIZE
-                                 USE IDENT_INT (256);
- 
-           BEGIN -- FUNC.
- 
-                IF ACC_TYPE'STORAGE_SIZE < IDENT_INT (256) THEN
-                     FAILED ("INCORRECT VALUE FOR STORAGE_SIZE");
-                END IF;
- 
-                RETURN TRUE;
- 
-           END FUNC;
- 
-      FUNCTION NEWFUNC IS NEW FUNC;
- 
-      BEGIN
-           B := NEWFUNC;
-      END;
- 
-      RESULT;
- END CD2B11E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- CD2B11F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A COLLECTION SIZE SPECIFICATION IS GIVEN FOR AN
- --     ACCESS TYPE WHOSE DESIGNATED TYPE IS A DISCRIMINATED RECORD, THEN
- --     OPERATIONS ON VALUES OF THE ACCESS TYPE ARE NOT AFFECTED.
- 
- -- HISTORY:
- --     BCB 09/29/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD2B11F IS
- 
-      BASIC_SIZE : CONSTANT := 1024;
- 
-      TYPE RECORD_TYPE(DISC : INTEGER := 100) IS RECORD
-           COMP1 : INTEGER;
-           COMP2 : INTEGER;
-           COMP3 : INTEGER;
-      END RECORD;
- 
-      TYPE ACC_RECORD IS ACCESS RECORD_TYPE;
-      FOR ACC_RECORD'STORAGE_SIZE USE BASIC_SIZE;
- 
-      CHECK_RECORD1 : ACC_RECORD;
-      CHECK_RECORD2 : ACC_RECORD;
- 
- BEGIN
- 
-      TEST ("CD2B11F", "CHECK THAT IF A COLLECTION SIZE SPECIFICATION " &
-                       "IS GIVEN FOR AN ACCESS TYPE WHOSE " &
-                       "DESIGNATED TYPE IS A DISCRIMINATED RECORD, " &
-                       "THEN OPERATIONS ON VALUES OF THE ACCESS TYPE " &
-                       "ARE NOT AFFECTED");
- 
-      CHECK_RECORD1 := NEW RECORD_TYPE;
-      CHECK_RECORD1.COMP1 := 25;
-      CHECK_RECORD1.COMP2 := 25;
-      CHECK_RECORD1.COMP3 := 150;
- 
-      IF ACC_RECORD'STORAGE_SIZE < BASIC_SIZE THEN
-           FAILED ("INCORRECT VALUE FOR RECORD TYPE ACCESS " &
-                   "STORAGE_SIZE");
-      END IF;
- 
-      IF CHECK_RECORD1.DISC /= IDENT_INT (100) THEN
-           FAILED ("INCORRECT VALUE FOR RECORD DISCRIMINANT");
-      END IF;
- 
-      IF ((CHECK_RECORD1.COMP1 /= CHECK_RECORD1.COMP2) OR
-              (CHECK_RECORD1.COMP1 = CHECK_RECORD1.COMP3)) THEN
-           FAILED ("INCORRECT VALUE FOR RECORD COMPONENT");
-      END IF;
- 
-      IF EQUAL (3,3) THEN
-           CHECK_RECORD2 := CHECK_RECORD1;
-      END IF;
- 
-      IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
-           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATOR");
-      END IF;
- 
-      RESULT;
- END CD2B11F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- CD2B15C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IF THE COLLECTION SIZE IS LARGE ENOUGH TO HOLD SOME
- --     VALUES OF THE DESIGNATED TYPE, CHECK THAT "STORAGE_ERROR"
- --     IS RAISED BY AN ALLOCATOR WHEN INSUFFICIENT STORAGE IS
- --     AVAILABLE.
- 
- -- HISTORY:
- --     DHH 09/23/87 CREATED ORIGINAL TEST.
- --     PMW 09/19/88 MODIFIED WITHDRAWN TEST.
- --     THS 03/21/90 CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND
- --                  COMPLETELY REVISED THE TEST TO PREVENT OPTIMIZATION.
- --     LDC 09/20/90 REMOVED UNUSED VARIABLE, CHANGED FAIL CALLS TO 
- --                  COMMENT FOR 'STORAGE_SIZE /= TO SPECIFIED SIZE,
- --                  MOVED LOOP FOR CHECK VALUES TO EXCEPTION HANDLER.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE CD2B15C IS
- 
-      SPECIFIED_SIZE : CONSTANT := 1000;
- 
-      TYPE CHECK_TYPE IS ACCESS INTEGER;
-      FOR CHECK_TYPE'STORAGE_SIZE USE SPECIFIED_SIZE;
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-          (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) / SYSTEM.STORAGE_UNIT;
- 
-      TYPE ACC_ARRAY_TYPE IS ARRAY
-          (INTEGER RANGE 1 .. (CHECK_TYPE'STORAGE_SIZE /
-           UNITS_PER_INTEGER) + 1) OF CHECK_TYPE;
-      ACC_ARRAY : ACC_ARRAY_TYPE;
- 
-      PLACE_I_STOPPED : INTEGER := 0;
- 
- BEGIN
- 
-      TEST ("CD2B15C", "IF THE COLLECTION SIZE IS LARGE " &
-                       "ENOUGH TO HOLD SOME VALUES OF " &
-                       "THE DESIGNATED TYPE, CHECK THAT " &
-                       "STORAGE_ERROR IS RAISED BY AN " &
-                       "ALLOCATOR WHEN INSUFFICIENT STORAGE " &
-                       "IS AVAILABLE");
- 
-      IF CHECK_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
-           FAILED ("CHECK_TYPE'STORAGE_SIZE IS LESS THEN THE VALUE " &
-                   "SPECIFIED IN THE REPRESENTATION CLAUSE");
- 
-      ELSIF CHECK_TYPE'STORAGE_SIZE > 2 * IDENT_INT (SPECIFIED_SIZE) THEN
-           COMMENT ("VALUE FOR CHECK_TYPE'STORAGE_SIZE IS MORE THEN " &
-                    "TWICE THE SPECIFIED VALUE IN THE REPRESENTATION " &
-                    "CLAUSE");
-      END IF;
- 
-      BEGIN
- 
-           FOR I IN ACC_ARRAY'RANGE LOOP
-                ACC_ARRAY (I) := NEW INTEGER'(IDENT_INT (I));
-                PLACE_I_STOPPED := I;
-           END LOOP;
- 
-           FAILED ("NO EXCEPTION RAISED WHEN RESERVED SPACE " &
-                   "EXCEEDED");
- 
-      EXCEPTION
-           WHEN STORAGE_ERROR =>
-                FOR I IN 1 .. PLACE_I_STOPPED LOOP
-                     IF ACC_ARRAY (I).ALL /= IDENT_INT (I) THEN
-                         FAILED ("INCORRECT VALUE FOR ACC_ARRAY (" &
-                                 INTEGER'IMAGE (I) & ")");
-                     END IF;
-                END LOOP;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED WHEN RESERVED SPACE " &
-                        "EXCEEDED");
-      END;
- 
-      RESULT;
- 
- END CD2B15C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- CD2B16A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IF A COLLECTION SIZE CLAUSE IS GIVEN FOR A PARENT ACCESS TYPE,
- --     THEN THE DERIVED TYPE HAS THE SAME COLLECTION SIZE, WHETHER THE
- --     DERIVED TYPE IS DECLARED BEFORE OR AFTER THE PARENT COLLECTION
- --     SIZE SPECIFICATION.
- 
- -- HISTORY:
- --     DHH 09/29/87 CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD2B16A IS
- BEGIN
-      TEST ("CD2B16A", "IF A COLLECTION SIZE IS GIVEN FOR A " &
-                       "PARENT ACCESS TYPE, THEN THE DERIVED TYPE HAS " &
-                       "THE SAME COLLECTION SIZE, WHETHER THE " &
-                       "DERIVED TYPE IS DECLARED BEFORE OR AFTER " &
-                       "THE PARENT COLLECTION SIZE SPECIFICATION");
- 
-           DECLARE
- 
-                COLLECTION_SIZE : CONSTANT :=128;
-                TYPE V IS ARRAY(1..4) OF INTEGER;
- 
-                TYPE CELL IS
-                     RECORD
-                          VALUE : V;
-                     END RECORD;
- 
-                TYPE LINK IS ACCESS CELL;
-                TYPE NEWLINK1 IS NEW LINK;
- 
-                FOR LINK'STORAGE_SIZE USE
-                                      COLLECTION_SIZE;
- 
-                TYPE NEWLINK2 IS NEW LINK;
- 
-           BEGIN    -- ACTIVE DECLARE
- 
-                IF LINK'STORAGE_SIZE < COLLECTION_SIZE THEN
-                     FAILED("STORAGE_SIZE SMALLER THAN STORAGE_SIZE " &
-                            "SPECIFIED WAS ALLOCATED");
-                END IF;
- 
-                IF LINK'STORAGE_SIZE /= NEWLINK1'STORAGE_SIZE THEN
-                     FAILED("STORAGE_SIZE OF THE FIRST DERIVED TYPE" &
-                            "IS NOT THE SAME SIZE AS THAT OF THE " &
-                            "PARENT");
-                END IF;
- 
-                IF LINK'STORAGE_SIZE /= NEWLINK2'STORAGE_SIZE THEN
-                     FAILED("STORAGE_SIZE OF THE SECOND DERIVED TYPE" &
-                            "IS NOT THE SAME SIZE AS THAT OF THE " &
-                            "PARENT");
-                END IF;
- 
-           END;    --ACTIVE DECLARE
- 
-      RESULT;
- END CD2B16A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- --CD2C11A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IF A TASK STORAGE SIZE SPECIFICATION IS GIVEN FOR A TASK
- --     TYPE, THEN OPERATIONS ON VALUES OF THE TASK TYPE ARE NOT
- --     AFFECTED.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY
- --     DHH 09/24/87  CREATED ORIGINAL TEST.
- --     RJW 07/06/88  REVISED THE TEST TO REMOVE UNINITIALIZED 'IN OUT'
- --                   PARAMETER.  CHANGED EXTENSION TO 'TST'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2C11A IS
- 
-     TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
- 
- BEGIN
- 
-      TEST ("CD2C11A", "IF A TASK STORAGE SIZE SPECIFICATION IS " &
-                       "GIVEN FOR A TASK TYPE, THEN OPERATIONS " &
-                       "ON VALUES OF THE TASK TYPE ARE NOT AFFECTED");
- 
-      DECLARE
-           PACKAGE PACK IS
- 
-                TYPE FLT IS DIGITS 1;
- 
-                TASK TYPE TTYPE IS
-                     ENTRY ADD(J :IN INTEGER; K : IN OUT INTEGER);
-                     ENTRY MULT(Y : IN FLT; Z : IN OUT FLT);
-                END TTYPE;
- 
- 
-                M : INTEGER := 81;
-                N : INTEGER := 0;
-                V,W : FLT RANGE 1.0..512.0 := 2.0;
- 
-                FOR TTYPE'STORAGE_SIZE USE TASK_STORAGE_SIZE;
- 
-                T : TTYPE;
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-                FUNCTION IDENT_FLT(FT : FLT) RETURN FLT IS
-                BEGIN
-                     IF EQUAL(5,5) THEN
-                          RETURN FT;
-                     ELSE
-                          RETURN 0.0;
-                     END IF;
-                END IDENT_FLT;
- 
-                TASK BODY TTYPE IS
-                     ITEMP : INTEGER := 0;
-                     FTEMP : FLT := 0.0;
-                BEGIN
-                     ACCEPT ADD(J :IN INTEGER; K : IN OUT INTEGER) DO
-                          ITEMP := J;
-                          IF EQUAL(3,3) THEN
-                               K := ITEMP;
-                          ELSE
-                               K := 0;
-                          END IF;
-                     END ADD;
-                     ACCEPT MULT(Y : IN FLT; Z : IN OUT FLT) DO
-                          FTEMP := Y;
-                          IF EQUAL(3,3) THEN
-                               Z := FTEMP;
-                          ELSE
-                               Z := 0.0;
-                          END IF;
-                     END MULT;
-                END TTYPE;
- 
-                PROCEDURE TEST_TASK(G : IN TTYPE;
-                                  S : IN  FLT; T : IN OUT FLT) IS
-                     R : FLT := 4.0;
-                BEGIN
-                     IF NOT (G'CALLABLE) OR G'TERMINATED THEN
-                          FAILED("TASK INSIDE PROCEDURE IS SHOWING " &
-                                 "WRONG VALUE FOR 'CALLABLE OR " &
-                                 "'TERMINATED");
-                     END IF;
-                     G.MULT(S,T);
-                END TEST_TASK;
- 
-           BEGIN
- 
-                IF TTYPE'STORAGE_SIZE < IDENT_INT(TASK_STORAGE_SIZE) THEN
-                     FAILED("ACTUAL 'STORAGE_SIZE USED IS SMALLER " &
-                            "THAN SIZE REQUESTED");
-                END IF;
- 
-                T.ADD(M,N);
- 
-                IF M /= IDENT_INT(N) THEN
-                     FAILED("TASK CALL PARAMETERS NOT EQUAL");
-                END IF;
- 
-                V := IDENT_FLT(13.0);
-                TEST_TASK(T,V,W);
-                IF V /= IDENT_FLT(W)  THEN
-                     FAILED("TASK AS PARAMETER FAILED");
-                END IF;
- 
-           END PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD2C11A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- --CD2C11D.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE EXPRESSION IN A TASK STORAGE SIZE CLAUSE NEED
- --     NOT BE STATIC.
- 
- -- MACRO SUBSTITUTION:
- --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
- --     THE ACTIVATION OF A TASK.
- 
- -- HISTORY
- --     DHH 09/29/87 CREATED ORIGINAL TEST
- --     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.TST'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD2C11D IS
- 
- BEGIN
- 
-      TEST ("CD2C11D","THE EXPRESSION IN A TASK STORAGE SIZE CLAUSE " &
-                      "NEED NOT BE STATIC");
- 
-      DECLARE
- 
-           STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
-           PACKAGE PACK IS
-                TASK TYPE CHECK_TYPE;
- 
-                FOR CHECK_TYPE'STORAGE_SIZE USE
-                                       STORAGE_SIZE;
-                TASK TYPE TTYPE IS
-                     ENTRY ADD(J :IN INTEGER; K : IN OUT INTEGER);
-                END TTYPE;
- 
-                FOR TTYPE'STORAGE_SIZE USE IDENT_INT(STORAGE_SIZE);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
- 
-                TASK BODY TTYPE IS
-                BEGIN
-                     ACCEPT ADD(J :IN INTEGER; K : IN OUT INTEGER);
-                END TTYPE;
- 
-                TASK BODY CHECK_TYPE IS
-                BEGIN
-                     NULL;
-                END CHECK_TYPE;
- 
-           BEGIN
- 
-                IF TTYPE'STORAGE_SIZE < IDENT_INT(STORAGE_SIZE) THEN
-                     FAILED("STORAGE_SIZE SPECIFIED IS " &
-                            "GREATER THAN MEMORY ALLOCATED");
-                END IF;
- 
-           END PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD2C11D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,214 ****
- -- CD2D11A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IF A SMALL SPECIFICATION IS GIVEN FOR A
- --     FIXED POINT TYPE, THEN ARITHMETIC OPERATIONS ON VALUES OF THE
- --     TYPE ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     BCB 09/01/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD2D11A IS
- 
-      BASIC_SMALL : CONSTANT := 2.0 ** (-4);
- 
-      TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
- 
-      TYPE CHECK_TYPE IS DELTA 1.0 RANGE -4.0 .. 4.0;
- 
-      FOR CHECK_TYPE'SMALL USE BASIC_SMALL;
- 
-      CNEG1 : CHECK_TYPE := -3.5;
-      CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
-      CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
-      CPOS2 : CHECK_TYPE :=  3.5;
-      CZERO : CHECK_TYPE;
- 
-      TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
-      CHARRAY : ARRAY_TYPE :=
-           (-3.5, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 3.5);
- 
-      TYPE REC_TYPE IS RECORD
-           COMPN1 : CHECK_TYPE := -3.5;
-           COMPN2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
-           COMPP1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
-           COMPP2 : CHECK_TYPE :=  3.5;
-      END RECORD;
- 
-      CHREC : REC_TYPE;
- 
-      FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN FX;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT;
- 
-      PROCEDURE PROC (N1_IN, P1_IN      :        CHECK_TYPE;
-                      N2_INOUT,P2_INOUT : IN OUT CHECK_TYPE;
-                      CZOUT             :    OUT CHECK_TYPE) IS
-      BEGIN
- 
-           IF IDENT (N1_IN) + P1_IN NOT IN
-                   -2.875 .. -2.8125 OR
-              P2_INOUT  - IDENT (P1_IN) NOT IN
-                   2.8125 .. 2.875 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "BINARY ADDING OPERATORS - 1");
-           END IF;
- 
-           IF +IDENT (N2_INOUT) NOT IN -0.375 .. -0.3125 OR
-              IDENT (-P1_IN) NOT IN -0.6875 .. -0.625 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "UNARY ADDING OPERATORS - 1");
-           END IF;
- 
-           IF CHECK_TYPE (N1_IN * IDENT (P1_IN)) NOT IN
-                -2.4375 .. -2.1875 OR
-              CHECK_TYPE (IDENT (N2_INOUT) / P2_INOUT) NOT IN
-                -0.125 .. -0.0625 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "MULTIPLYING OPERATORS - 1");
-           END IF;
- 
-           IF ABS IDENT (N2_INOUT) NOT IN 0.3125 .. 0.375 OR
-              IDENT (ABS P1_IN) NOT IN 0.625 .. 0.6875 THEN
-                FAILED ("INCORRECT RESULTS FOR " &
-                        "ABSOLUTE VALUE OPERATORS - 1");
-           END IF;
- 
-           CZOUT := 0.0;
- 
-      END PROC;
- 
- BEGIN
-      TEST ("CD2D11A", "CHECK THAT IF A SMALL SPECIFICATION IS " &
-                       "GIVEN FOR AN FIXED POINT TYPE, THEN " &
-                       "ARITHMETIC OPERATIONS ON VALUES OF THE " &
-                       "TYPE ARE NOT AFFECTED BY THE REPRESENTATION " &
-                       "CLAUSE");
- 
-      PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
- 
-      IF IDENT (CZERO) /= 0.0 THEN
-           FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
-      END IF;
- 
-      IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
-         CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 2");
-      END IF;
- 
-      IF +IDENT (CNEG2) NOT IN -0.375 .. -0.3125 OR
-         IDENT (-CPOS1) NOT IN -0.6875 .. -0.625 THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 2");
-      END IF;
- 
-      IF CHECK_TYPE (CNEG1 * IDENT (CPOS1)) NOT IN -2.4375 .. -2.1875 OR
-         CHECK_TYPE (IDENT (CNEG2) / CPOS2) NOT IN
-                -0.125 .. -0.0625 THEN
-           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 2");
-      END IF;
- 
-      IF ABS IDENT (CNEG2) NOT IN 0.3125 .. 0.375 OR
-         IDENT (ABS CPOS1) NOT IN 0.625 .. 0.6875 THEN
-           FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
-                   "OPERATORS - 2");
-      END IF;
- 
-      IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
-             CNEG2 IN -0.25 .. 0.0 OR
-             IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
-      END IF;
- 
-      IF IDENT (CHARRAY (0)) + CHARRAY (2) NOT IN
-              -2.875 .. -2.8125 OR
-         CHARRAY (3)  - IDENT (CHARRAY (2)) NOT IN
-              2.8125 .. 2.875 THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 3");
-      END IF;
- 
-      IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
-         IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 3");
-      END IF;
- 
-      IF CHECK_TYPE (CHARRAY (0) * IDENT (CHARRAY (2))) NOT IN
-           -2.4375 .. -2.1875 OR
-         CHECK_TYPE (IDENT (CHARRAY (1)) / CHARRAY (3)) NOT IN
-           -0.125 .. -0.0625 THEN
-           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 3");
-      END IF;
- 
-      IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
-         IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
-           FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
-                   "OPERATORS - 3");
-      END IF;
- 
-      IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
-             CHARRAY (1) IN -0.25 .. 0.0 OR
-             IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
-      END IF;
- 
-      IF IDENT (CHREC.COMPN1) + CHREC.COMPP1 NOT IN
-              -2.875 .. -2.8125 OR
-         CHREC.COMPP2  - IDENT (CHREC.COMPP1) NOT IN
-              2.8125 .. 2.875 THEN
-           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 4");
-      END IF;
- 
-      IF +IDENT (CHREC.COMPN2) NOT IN -0.375 .. -0.3125 OR
-         IDENT (-CHREC.COMPP1) NOT IN -0.6875 .. -0.625 THEN
-           FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 4");
-      END IF;
- 
-      IF CHECK_TYPE (CHREC.COMPN1 * IDENT (CHREC.COMPP1)) NOT IN
-           -2.4375 .. -2.1875 OR
-         CHECK_TYPE (IDENT (CHREC.COMPN2) / CHREC.COMPP2) NOT IN
-           -0.125 .. -0.0625 THEN
-           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 4");
-      END IF;
- 
-      IF ABS IDENT (CHREC.COMPN2) NOT IN 0.3125 .. 0.375 OR
-         IDENT (ABS CHREC.COMPP1) NOT IN 0.625 .. 0.6875 THEN
-           FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
-                   "OPERATORS - 4");
-      END IF;
- 
-      IF IDENT (CHREC.COMPP1) NOT IN 0.625 .. 0.6875 OR
-            CHREC.COMPN2 IN -0.25 .. 0.0 OR
-            IDENT (CHREC.COMPN2) IN -1.0 .. -0.4375 THEN
-           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
-      END IF;
- 
-      RESULT;
- END CD2D11A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CD2D13A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SMALL CLAUSE CAN BE GIVEN IN THE VISIBLE
- --     OR PRIVATE PART OF A PACKAGE FOR A FIXED POINT TYPE DECLARED
- --     IN THE VISIBLE PART.
- 
- -- HISTORY:
- --     BCB 09/01/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; WITH TEXT_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE CD2D13A IS
- 
-      SPECIFIED_SMALL : CONSTANT := 2.0 ** (-4);
- 
-      PACKAGE P IS
-           TYPE FIXED_IN_P IS DELTA 1.0 RANGE -4.0 .. 4.0;
-           FOR FIXED_IN_P'SMALL USE SPECIFIED_SMALL;
-           TYPE ALT_FIXED_IN_P IS DELTA 1.0 RANGE -4.0 .. 4.0;
-      PRIVATE
-           FOR ALT_FIXED_IN_P'SMALL USE SPECIFIED_SMALL;
-      END P;
- 
-      USE P;
- 
- BEGIN
- 
-      TEST("CD2D13A", "A SMALL CLAUSE CAN BE GIVEN IN THE VISIBLE " &
-                      "OR PRIVATE PART OF A PACKAGE FOR A FIXED " &
-                      "POINT TYPE DECLARED IN THE VISIBLE PART");
- 
-      IF FIXED_IN_P'SMALL /= SPECIFIED_SMALL THEN
-           FAILED ("INCORRECT VALUE FOR FIXED_IN_P'SMALL");
-      END IF;
- 
-      IF ALT_FIXED_IN_P'SMALL /= SPECIFIED_SMALL THEN
-           FAILED ("INCORRECT VALUE FOR ALT_FIXED_IN_P'SMALL");
-      END IF;
- 
-      RESULT;
- 
- END CD2D13A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,284 ****
- -- CD30001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that X'Address produces a useful result when X is an aliased
- --      object.
- --      Check that X'Address produces a useful result when X is an object of
- --      a by-reference type.
- --      Check that X'Address produces a useful result when X is an entity
- --      whose Address has been specified.
- --
- --      Check that aliased objects and subcomponents are allocated on storage
- --      element boundaries.  Check that objects and subcomponents of by
- --      reference types are allocated on storage element boundaries.
- --
- --      Check that for an array X, X'Address points at the first component
- --      of the array, and not at the array bounds.
- --   
- -- TEST DESCRIPTION:
- --      This test defines a data structure (an array of records) where each
- --      aspect of the data structure is aliased.  The test checks 'Address
- --      for each "layer" of aliased objects.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      08 MAY 96   SAIC   Reinforced for 2.1
- --      16 FEB 98   EDS    Modified documentation
- --!
- 
- ----------------------------------------------------------------- CD30001_0
- 
- with SPPRT13;
- package CD30001_0 is
- 
-   --    Check that X'Address produces a useful result when X is an aliased
-   --    object.
-   --    Check that X'Address produces a useful result when X is an object of
-   --    a by-reference type.
-   --    Check that X'Address produces a useful result when X is an entity
-   --    whose Address has been specified.
-   --    (using the new form of "for X'Address use ...")
-   --
-   --    Check that aliased objects and subcomponents are allocated on storage
-   --    element boundaries.  Check that objects and subcomponents of by
-   --    reference types are allocated on storage element boundaries.
- 
-   type Simple_Enum_Type is (Just, A, Little, Bit);
- 
-   type Data is record
-     Aliased_Comp_1 : aliased Simple_Enum_Type;
-     Aliased_Comp_2 : aliased Simple_Enum_Type;
-   end record;
- 
-   type Array_W_Aliased_Comps is array(1..2) of aliased Data;
- 
-   Aliased_Object  : aliased Array_W_Aliased_Comps;
- 
-   Specific_Object : aliased Array_W_Aliased_Comps;
-   for Specific_Object'Address use SPPRT13.Variable_Address2;  -- ANX-C RQMT.
- 
-   procedure TC_Check_Aliased_Addresses;
- 
-   procedure TC_Check_Specific_Addresses;
- 
-   procedure TC_Check_By_Reference_Types;
- 
- end CD30001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with System.Storage_Elements;
- with System.Address_To_Access_Conversions;
- package body CD30001_0 is
- 
-   package Simple_Enum_Type_Ref_Conv is
-     new System.Address_To_Access_Conversions(Simple_Enum_Type);
- 
-   package Data_Ref_Conv is new System.Address_To_Access_Conversions(Data);
- 
-   package Array_W_Aliased_Comps_Ref_Conv is
-     new System.Address_To_Access_Conversions(Array_W_Aliased_Comps);
- 
-   use type System.Address;
-   use type System.Storage_Elements.Integer_Address;
-   use type System.Storage_Elements.Storage_Offset;
- 
-   procedure TC_Check_Aliased_Addresses is
-     use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
-     use type Data_Ref_Conv.Object_Pointer;
-     use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
- 
-   begin
- 
-     -- Check the object Aliased_Object
- 
-     if Aliased_Object'Address not in System.Address then
-       Report.Failed("Aliased_Object'Address not an address");
-     end if;
- 
-     if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(Aliased_Object'Address)
-        /= Aliased_Object'Unchecked_Access then                   
-       Report.Failed
-                   ("'Unchecked_Access does not match expected address value");
-     end if;
- 
-     -- Check the element Aliased_Object(1)
- 
-     if Data_Ref_Conv.To_Address( Aliased_Object(1)'Access )
-        /= Aliased_Object(1)'Address then
-       Report.Failed
-              ("Array element 'Access does not match expected address value");
-     end if;
- 
-     -- Check that Array'Address points at the first component...   
- 
-     if Array_W_Aliased_Comps_Ref_Conv.To_Address( Aliased_Object'Access )
-        /= Aliased_Object(1)'Address then
-       Report.Failed
-         ("Address of array object does not equal address of first component");
-     end if;
- 
-     -- Check the components of Aliased_Object(2)
- 
-     if Simple_Enum_Type_Ref_Conv.To_Address(
-                           Aliased_Object(2).Aliased_Comp_1'Unchecked_Access)
-        not in System.Address then
-       Report.Failed("Component 2 'Unchecked_Access not a valid address");
-     end if;
- 
-     if Aliased_Object(2).Aliased_Comp_2'Address not in System.Address then
-       Report.Failed("Component 2 not located at a valid address ");
-     end if;
- 
-   end TC_Check_Aliased_Addresses;
- 
-   procedure TC_Check_Specific_Addresses is
-     use type System.Address;
-     use type System.Storage_Elements.Integer_Address;
-     use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
-     use type Data_Ref_Conv.Object_Pointer;
-     use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
-   begin
- 
-     -- Check the object Specific_Object
- 
-     if System.Storage_Elements.To_Integer(Specific_Object'Address)
-        /= System.Storage_Elements.To_Integer(SPPRT13.Variable_Address2) then
-       Report.Failed
-         ("Specific_Object not at address specified in representation clause");
-     end if;
- 
-     if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(SPPRT13.Variable_Address2)
-        /= Specific_Object'Unchecked_Access then
-       Report.Failed("Specific_Object'Unchecked_Access not expected value");
-     end if;
- 
-     -- Check the element Specific_Object(1)
- 
-     if Data_Ref_Conv.To_Address( Specific_Object(1)'Access )
-        /= Specific_Object(1)'Address then
-       Report.Failed
-         ("Specific Array element 'Access does not correspond to the "
-          & "elements 'Address");
-     end if;
- 
-     -- Check that Array'Address points at the first component...
- 
-     if Array_W_Aliased_Comps_Ref_Conv.To_Address( Specific_Object'Access )
-        /= Specific_Object(1)'Address then
-       Report.Failed
-         ("Address of array object does not equal address of first component");
-     end if;
- 
-     -- Check the components of Specific_Object(2)
- 
-     if Simple_Enum_Type_Ref_Conv.To_Address(
-                                     Specific_Object(1).Aliased_Comp_1'Access)
-                                                     not in System.Address then
-       Report.Failed("Access value of first record component for object at " &
-                     "specific address not a valid address");
-     end if;
- 
-     if Specific_Object(2).Aliased_Comp_2'Address not in System.Address then
-       Report.Failed("Second record component for object at specific " &
-                     "address not located at a valid address");
-     end if;
- 
-   end TC_Check_Specific_Addresses;
- 
- --      Check that X'Address produces a useful result when X is an object of
- --      a by-reference type.
- 
-     type Tagged_But_Not_Exciting is tagged record
-       A_Bit_Of_Data : Boolean;
-     end record;
- 
-     Tagged_Object : Tagged_But_Not_Exciting;
- 
-   procedure Muck_With_Addresses( It : in out Tagged_But_Not_Exciting;
-                                  Its_Address : in System.Address ) is
-   begin
-     if It'Address /= Its_Address then
-       Report.Failed("Address of object passed by reference does not " &
-                     "match address of object passed" );
-     end if;
-   end Muck_With_Addresses;
- 
-   procedure TC_Check_By_Reference_Types is 
-   begin
-     Muck_With_Addresses( Tagged_Object, Tagged_Object'Address );
-   end TC_Check_By_Reference_Types;
- 
- end CD30001_0;
- 
- ------------------------------------------------------------------- CD30001
- 
- with Report;
- with CD30001_0;
- procedure CD30001 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD30001",
-                "Check that X'Address produces a useful result when X is " &
-                "an aliased object, or an entity whose Address has been " &
-                "specified" );
-    
- --      Check that X'Address produces a useful result when X is an aliased
- --      object.
- --
- --      Check that aliased objects and subcomponents are allocated on storage
- --      element boundaries.  Check that objects and subcomponents of by
- --      reference types are allocated on storage element boundaries.
- 
-   CD30001_0.TC_Check_Aliased_Addresses;
- 
- --      Check that X'Address produces a useful result when X is an entity
- --      whose Address has been specified.
- 
-   CD30001_0.TC_Check_Specific_Addresses;
- 
- --      Check that X'Address produces a useful result when X is an object of
- --      a by-reference type.
- 
-   CD30001_0.TC_Check_By_Reference_Types;
- 
-   Report.Result;
- 
- end CD30001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,207 ****
- -- CD30002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the implementation supports Alignments for subtypes and
- --      objects specified as factors and multiples of the number of storage
- --      elements per word, unless those values cannot be loaded and stored.
- --      Check that the largest alignment returned by default is supported.
- --
- --      Check that the implementation supports Alignments supported by the
- --      target linker for stand-alone library-level objects of statically
- --      constrained subtypes.
- --
- -- TEST DESCRIPTION:
- --      This test defines several types and objects, specifying various
- --      alignments for them (as factors and multiples of the number of
- --      storage elements per word).  It then checks the alignments by
- --      declaring some objects, and checking that the integer values of
- --      their addresses is mod the specified alignment.  This will not
- --      prevent false passes where the lucky compiler gets it right by
- --      chance, but will catch compilers that specifically do not obey
- --      the alignment clauses.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      09 MAY 96   SAIC   Strengthened for 2.1
- --      26 FEB 97   PWB.CTA Allowed for unexpected word sizes
- --      16 FEB 98   EDS    Modified documentation.
- --      26 SEP 98   RLB    Fixed value on line 130 so check and dec. match.
- --      30 OCT 98   RLB    Split Multiple_Alignment and revised the
- --                         calculation to work on all targets.
- --      18 JAN 99   RLB    Repaired again to work on targets where word size
- --                         equals storage unit.
- --!
- 
- ----------------------------------------------------------------- CD30002_0
- 
- with Impdef;
- with System.Storage_Elements;
- package CD30002_0 is
- 
-   S_Units_per_Word : constant := System.Word_Size/System.Storage_Unit;
- 	-- Must be 1 or greater.
- 
-   Multiple_Type_Alignment : constant :=
-       Integer'Min ( Impdef.Max_Default_Alignment,
-                     2 * S_Units_per_Word );
-       -- Calculate a reasonable alignment, but not larger than the
-       -- implementation is required to support.
- 
-   Multiple_Object_Alignment : constant :=
-       Integer'Min ( Impdef.Max_Linker_Alignment,
-                     2 * S_Units_per_Word );
-       -- Calculate a reasonable object alignment, but not larger than
-       -- the implementation is required to support.
- 
-   Small_Alignment : constant :=
-       Integer'Max ( S_Units_per_Word / 2, 1);
-       -- Calculate a reasonable small alignment, but not less than 1.
-       -- (If S_Units_per_Word = 1, 1/2 => 0 which causes problems
-       -- verifying alignment.)
- 
-   subtype Storage_Element is System.Storage_Elements.Storage_Element;
- 
-   type Some_Stuff is array(1..S_Units_Per_Word) of Storage_Element;
-     for Some_Stuff'Alignment
-       use Impdef.Max_Default_Alignment;                       -- ANX-C RQMT.
- 
-   Library_Level_Object : Some_Stuff;
-     for Library_Level_Object'Alignment
-       use Impdef.Max_Linker_Alignment;                        -- ANX-C RQMT.
- 
-   type Quarter is mod 4; -- two bits
-     for Quarter'Alignment use Small_Alignment;                -- ANX-C RQMT.
- 
-   type Half is mod 16; -- nibble
-     for Half'Alignment use Multiple_Type_Alignment;                -- ANX-C RQMT.
-   
-   type O_Some_Stuff is array(1..S_Units_Per_Word) of Storage_Element;
-   
-   type O_Quarter is mod 4; -- two bits
- 
-   type O_Half is mod 16; -- nibble
- 
- end CD30002_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- -- there is no package body CD30002_0
- 
- ------------------------------------------------------------------- CD30002
- 
- with Report;
- with Impdef;
- with CD30002_0;
- with System.Storage_Elements;
- procedure CD30002 is
- 
-   My_Stuff   : CD30002_0.Some_Stuff;
-     -- Impdef.Max_Default_Alignment
- 
-   My_Quarter : CD30002_0.Quarter;
-     -- CD30002_0.S_Units_per_Word / 2
- 
-   My_Half    : CD30002_0.Half;
-     -- CD30002_0.S_Units_per_Word * 2
- 
-   Stuff_Object   : CD30002_0.O_Some_Stuff;
-     for Stuff_Object'Alignment
-       use Impdef.Max_Default_Alignment;                       -- ANX-C RQMT.
- 
-   Quarter_Object : CD30002_0.O_Quarter;
-     for Quarter_Object'Alignment
-         use CD30002_0.Small_Alignment;                        -- ANX-C RQMT.
- 
-   Half_Object    : CD30002_0.O_Half;
-     for Half_Object'Alignment
-         use CD30002_0.Multiple_Object_Alignment;              -- ANX-C RQMT.
- 
-   subtype IntAdd is System.Storage_Elements.Integer_Address;
-     use type System.Storage_Elements.Integer_Address;
- 
-   function A2I(Value: System.Address) return IntAdd renames
-     System.Storage_Elements.To_Integer;
- 
-   NAC : constant String := " not aligned correctly";
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD30002", "Check that the implementation supports " &
-                           "Alignments for subtypes and objects specified " &
-                           "as factors and multiples of the number of " &
-                           "storage elements per word, unless those values " &
-                           "cannot be loaded and stored. Check that the " &
-                           "largest alignment returned by default is " &
-                           "supported. Check that the implementation " &
-                           "supports Alignments supported by the target " &
-                           "linker for stand-alone library-level objects " &
-                           "of statically constrained subtypes" );
- 
-   if A2I(CD30002_0.Library_Level_Object'Address)
-      mod Impdef.Max_Linker_Alignment /= 0 then
-     Report.Failed("Library_Level_Object" & NAC);
-   end if;
- 
-   if A2I(My_Stuff'Address) mod Impdef.Max_Default_Alignment /= 0 then
-     Report.Failed("Max alignment subtype" & NAC);
-   end if;
- 
-   if A2I(My_Quarter'Address) mod (CD30002_0.Small_Alignment) /= 0 then
-     Report.Failed("Factor of words subtype" & NAC);
-   end if;
- 
-   if A2I(My_Half'Address) mod (CD30002_0.Multiple_Type_Alignment) /= 0 then
-     Report.Failed("Multiple of words subtype" & NAC);
-   end if;
- 
-   if A2I(Stuff_Object'Address) mod Impdef.Max_Default_Alignment /= 0 then
-     Report.Failed("Stuff alignment object" & NAC);
-   end if;
- 
-   if A2I(Quarter_Object'Address) 
-        mod (CD30002_0.Small_Alignment) /= 0 then
-     Report.Failed("Factor of words object" & NAC);
-   end if;
- 
-   if A2I(Half_Object'Address) mod (CD30002_0.Multiple_Object_Alignment) /= 0 then
-     Report.Failed("Multiple of words object" & NAC);
-   end if;
- 
-   Report.Result;
- 
- end CD30002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,227 ****
- -- CD30003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a Size clause for an object is supported if the specified
- --      size is at least as large as the subtype's size, and correspond to a
- --      size in storage elements that is a multiple of the object's (non-zero)
- --      Alignment. RM 13.3(43)
- --
- -- TEST DESCRIPTION:
- --      This test defines several types and then asserts specific sizes for
- --      the, it then checks that the size set is reported back.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      08 MAY 96   SAIC   Corrected and strengthened for 2.1
- --      14 FEB 97   PWB.CTA Changed 'Size specifications to multiples
- --                         of System.Storage_Unit; restricted 'Size spec
- --                         for enumeration object to max integer size.
- --      16 FEB 98   EDS    Modify Documentation.
- --      25 JAN 99   RLB    Repaired to properly set and check sizes.
- --      29 JAN 99   RLB    Added Pack pragma needed for some implementations.
- --                         Corrected to support a Storage_Unit size < 8.
- --!
- 
- ------------------------------------------------------------------- CD30003
- 
- with Report;
- with System;
- procedure CD30003 is
- 
-   ---------------------------------------------------------------------------
-   -- types and subtypes
-   ---------------------------------------------------------------------------
- 
-   type Bit is mod 2**1;
-   for Bit'Size use 1;                                         -- ANX-C RQMT.
- 
-   type Byte is mod 2**8;
-   for Byte'Size use 8;                                        -- ANX-C RQMT.
- 
-   type Smallword is mod 2**8;
-   for Smallword'size use 16;                                  -- ANX-C RQMT.
- 
-   type Byte_Array is array(1..4) of Byte;
-   pragma Pack(Byte_Array);                                    -- ANX-C RQMT.
-   -- size should be 32
- 
-   type Smallword_Array is array(1..4) of Smallword;
-   pragma Pack(Smallword_Array); -- Required if Storage_Unit > 16. -- ANX-C RQMT.
- 
-   -- Use to calulate maximum required size:
-   type Max_Modular is mod System.Max_Binary_Modulus;
-   type Max_Integer is range System.Min_Int .. System.Max_Int;
-   Enum_Size : constant := Integer'Min (32,
-       Integer'Min (Max_Modular'Size, Max_Integer'Size));
-   type Transmission_Data is ( Empty, Input, Output, IO, Control );
-   for Transmission_Data'Size use Enum_Size;                   -- ANX-C RQMT.
- 
-   -- Sizes to try:
- 
-   -- The basic sizes are based on a "normal" Storage_Unit = 8 implementation.
-   -- We then use formulas to insure that the specified sizes meet the
-   -- the minimum level of support and AI-0051.
- 
-   Modular_Single_Size : constant := Integer'Min (((8 + (System.Storage_Unit-1))
-      /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
-      -- Calulate an appropriate, legal, and required to be supported size to
-      -- try, which is the size of Byte. Note that object sizes must be
-      -- a multiple of the storage unit for the compiler.
- 
-   Modular_Double_Size : constant := Integer'Min (((16 + (System.Storage_Unit-1))
-      /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
- 
-   Modular_Quad_Size : constant := Integer'Min (((32 + (System.Storage_Unit-1))
-      /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
- 
-   Array_Quad_Size : constant := ((4 * 8 + (System.Storage_Unit-1))
-      /System.Storage_Unit)*System.Storage_Unit;
- 
-   Array_Octo_Size : constant := ((4 * 16 + (System.Storage_Unit-1))
-      /System.Storage_Unit)*System.Storage_Unit;
- 
-   Rounded_Enum_Size : constant := ((Enum_Size + (System.Storage_Unit-1))
-      /System.Storage_Unit)*System.Storage_Unit;
- 
-   Enum_Quad_Size : constant := Integer'Min (((32 + (System.Storage_Unit-1))
-      /System.Storage_Unit)*System.Storage_Unit,
-      Integer'Min (Max_Modular'Size, Max_Integer'Size));
- 
- 
-   ---------------------------------------------------------------------------
-   -- objects
-   ---------------------------------------------------------------------------
- 
-   Bit_8 : Bit :=0;
-   for Bit_8'Size use System.Storage_Unit;                     -- ANX-C RQMT.
- 
-   Bit_G : Bit :=0;
-   for Bit_G'Size use Modular_Double_Size;                     -- ANX-C RQMT.
- 
-   Byte_8 : Byte :=0;
-   for Byte_8'Size use Modular_Single_Size;                    -- ANX-C RQMT.
- 
-   Byte_G : Byte :=0;
-   for Byte_G'Size use Modular_Double_Size;                    -- ANX-C RQMT.
- 
-   Smallword_1 : Smallword :=0;
-   for Smallword_1'Size use Modular_Double_Size;               -- ANX-C RQMT.
- 
-   Smallword_2 : Smallword :=0;
-   for Smallword_2'Size use Modular_Quad_Size;                 -- ANX-C RQMT.
- 
-   Byte_Array_1 : Byte_Array := (others=>0);
-   for Byte_Array_1'Size use Array_Quad_Size;                  -- ANX-C RQMT.
- 
-   Smallword_Array_1 : Smallword_Array := (others=>0);
-   for Smallword_Array_1'Size use Array_Octo_Size;             -- ANX-C RQMT.
- 
-   Transmission_Data_1 : aliased Transmission_Data := Empty;
- 
-   Transmission_Data_2 : Transmission_Data := Control;
-   for Transmission_Data_2'Size use Enum_Quad_Size;            -- ANX-C RQMT.
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD30003", "Check that Size clauses are supported for " &
-                           "values at least as large as the subtypes " &
-                           "size, and correspond to a size in storage " &
-                           "elements that is a multiple of the objects " &
-                           "(non-zero) Alignment" );
-    
-   if Bit_8'Size /= System.Storage_Unit then
-     Report.Failed("Expected Bit_8'Size =" & Integer'Image(System.Storage_Unit)
-                       & " , actually =" & Integer'Image(Bit_8'Size));
-   end if;
- 
-   if Bit_G'Size /= Modular_Double_Size then
-     Report.Failed("Expected Bit_G'Size =" & Integer'Image(Modular_Double_Size)
-                       & " , actually =" & Integer'Image(Bit_G'Size));
-   end if;
- 
-   if Byte_8'Size /= Modular_Single_Size then
-     Report.Failed("Expected Byte_8'Size =" & Integer'Image(Modular_Single_Size)
-                       & " , actually =" & Integer'Image(Byte_8'Size));
-   end if;
- 
-   if Byte_G'Size /= Modular_Double_Size then
-     Report.Failed("Expected Bit_G'Size =" & Integer'Image(Modular_Double_Size)
-                       & " , actually =" & Integer'Image(Byte_G'Size));
-   end if;
- 
-   if Smallword_1'Size /= Modular_Double_Size then
-     Report.Failed("Expected Smallword_1'Size =" &
-                       Integer'Image(Modular_Double_Size) &
-                       ", actually =" & Integer'Image(Smallword_1'Size));
-   end if;
- 
-   if Smallword_2'Size /= Modular_Quad_Size then
-     Report.Failed("Expected Smallword_2'Size =" &
-                       Integer'Image(Modular_Quad_Size) &
-                       ", actually =" & Integer'Image(Smallword_2'Size));
-   end if;
- 
-   if Byte_Array_1'Size /= Array_Quad_Size then
-     Report.Failed("Expected Byte_Array_1'Size =" &
-                       Integer'Image(Array_Quad_Size) &
-                       ", actually =" & Integer'Image(Byte_Array_1'Size));
-   end if;
- 
-   if Smallword_Array_1'Size /= Array_Octo_Size then
-     Report.Failed(
-       "Expected Smallword_Array_1'Size =" &
-                       Integer'Image(Array_Octo_Size) &
-                       ", actually =" & Integer'Image(Smallword_Array_1'Size));
-   end if;
- 
-   if Transmission_Data_1'Size /= Enum_Size and then
-      Transmission_Data_1'Size /= Rounded_Enum_Size then
-     Report.Failed(
-       "Expected Transmission_Data_1'Size =" & Integer'Image(Rounded_Enum_Size) &
-                       ", actually =" & Integer'Image(Transmission_Data_1'Size));
-   end if;
- 
-   if Transmission_Data_2'Size /= Enum_Quad_Size then
-     Report.Failed(
-       "Expected Transmission_Data_2'Size =" & Integer'Image(Enum_Quad_Size) &
-                       ", actually =" & Integer'Image(Transmission_Data_2'Size));
-   end if;
- 
-   Report.Result;
- 
- end CD30003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- CD30004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --
- --
- --      Check that the unspecified Size of static discrete
- --      subtypes is the number of bits needed to represent each value
- --      belonging to the subtype using an unbiased representation, where
- --      space for a sign bit is provided only in the event the subtype
- --      contains negative values.  Check that for first subtypes specified
- --      Sizes are supported reflecting this representation. [ARM 95 13.3(55)].
- --
- -- TEST DESCRIPTION:
- --      This test defines a few types that should have distinctly recognizable
- --      sizes.  A packed record which should result in very specific bits
- --      sizes for it's components is used to check the first part of the
- --      objective. The second part of the objective is checked by giving
- --	sizes for a similar set of types.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      06 MAY 96   SAIC   Revised for 2.1
- --      26 FEB 97   PWB.CTA Added pragma Pack for type Check_Record
- --      16 FEB 98   EDS    Modified Documentation.
- --      06 JUL 99   RLB    Repaired comments, removed junk test cases.
- --                         Added test cases to test that appropriate Size
- --                         clauses are allowed.
- 
- --!
- ----------------------------------------------------------------- CD30004_0
- 
- package CD30004_0 is
- 
- --      Check that the unspecified Size of static discrete and fixed point
- --      subtypes are the number of bits needed to represent each value
- --      belonging to the subtype using an unbiased representation, where
- --      space for a sign bit is provided only in the event the subtype
- --      contains negative values.  Check that for first subtypes specified
- --      Sizes are supported reflecting this representation.
- 
-   type Bits_2 is ( Zeroth_Bit, Fiercest_Bit, Secants_Bit, Threadless_Bit );
- 
-   type Bits_3 is range 0..2**3-1;
- 
-   type Bits_5 is range -2**4+1..2**4-1;  -- allow for 1's comp
- 
-   type Bits_14 is mod 2**14;
- 
-   type Check_Record is
-   record
-     B14 : Bits_14;
-     B2  : Bits_2;
-     B3  : Bits_3;
-     B5  : Bits_5;
-     C   : Character;
-   end record;
-   pragma Pack ( Check_Record );
- 
-   procedure TC_Check_Values;
-   procedure TC_Check_Specified_Sizes;
- 
- end CD30004_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- with Report;
- with Impdef;
- package body CD30004_0 is
- 
-   procedure TC_Check_Values is
-   begin
- 
-     if Bits_2'Size /= 2 then
-       if Impdef.Validating_Annex_C then
-          Report.Failed("Bits_2'Size not 2 bits");
-       else -- Recommended levels of support are not binding.
-          Report.Comment("Bits_2'Size not 2 bits");
-       end if;
-     end if;
- 
-     if Bits_14'Size /= 14 then
-       if Impdef.Validating_Annex_C then
-          Report.Failed("Bits_14'Size not 14 bits");
-       else
-          Report.Comment("Bits_14'Size not 14 bits");
-       end if;
-     end if;
- 
-     if Bits_3'Size /= 3 then
-       if Impdef.Validating_Annex_C then
-          Report.Failed("Bits_3'Size not 3 bits");
-       else
-          Report.Comment("Bits_3'Size not 3 bits");
-       end if;
-     end if;
- 
-     if Bits_5'Size /= 5 then
-       if Impdef.Validating_Annex_C then
-          Report.Failed("Bits_5'Size not 5 bits");
-       else
-          Report.Comment("Bits_5'Size not 5 bits");
-       end if;
-     end if;
- 
-     if Character'Size /= 8 then
-       Report.Failed("Character'Size not 8 bits");
-     end if;
- 
-     if Wide_Character'Size /= 16 then
-       Report.Failed("Wide_Character'Size not 16 bits");
-     end if;
- 
-   end TC_Check_Values;
- 
-   type Spec_Bits_2 is ( Zeroth_Bit, Fiercest_Bit, Secants_Bit, Threadless_Bit );
-   for Spec_Bits_2'Size use 2;                            -- ANX-C RQMT.
- 
-   type Spec_Bits_3 is range 0..2**3-1;
-   for Spec_Bits_3'Size use 3;                            -- ANX-C RQMT.
- 
-   type Spec_Bits_5 is range -2**4+1..2**4-1;  -- allow for 1's comp
-   for Spec_Bits_5'Size use 5;                            -- ANX-C RQMT.
- 
-   type Spec_Bits_14 is mod 2**14;
-   for Spec_Bits_14'Size use 14;                          -- ANX-C RQMT.
- 
-   type Spec_Record is new Check_Record;
-   for Spec_Record'Size use 64;                           -- ANX-C RQMT.
- 
-   procedure TC_Check_Specified_Sizes is
- 
-   begin
- 
-     if Spec_Record'Size /= 64 then
-       Report.Failed("Spec_Record'Size not 64 bits");
-     end if;
- 
-     if Spec_Bits_2'Size /= 2 then
-       Report.Failed("Spec_Bits_2'Size not 2 bits");
-     end if;
- 
-     if Spec_Bits_14'Size /= 14 then
-       Report.Failed("Spec_Bits_14'Size not 14 bits");
-     end if;
- 
-     if Spec_Bits_3'Size /= 3 then
-       Report.Failed("Spec_Bits_3'Size not 3 bits");
-     end if;
- 
-     if Spec_Bits_5'Size /= 5 then
-       Report.Failed("Spec_Bits_5'Size not 5 bits");
-     end if;
- 
-   end TC_Check_Specified_Sizes;
- 
- end CD30004_0;
- 
- ------------------------------------------------------------------- CD30004
- 
- with Report;
- with CD30004_0;
- 
- procedure CD30004 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD30004", "Check that the unspecified Size of static " &
-                "discrete and fixed point subtypes is the number of bits " &
-                "needed to represent each value belonging to the subtype " &
-                "using an unbiased representation, where space for a sign " &
-                "bit is provided only in the event the subtype contains " &
-                "negative values.  Check that for first subtypes " &
-                "specified Sizes are supported reflecting this " &
-                "representation.");
- 
-   CD30004_0.TC_Check_Values;
- 
-   CD30004_0.TC_Check_Specified_Sizes;
- 
-   Report.Result;
- 
- end CD30004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd300050.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd300050.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd300050.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd300050.am	Thu Jan  1 00:00:00 1970
***************
*** 1,154 ****
- -- CD30005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Address clauses are supported for imported subprograms.
- --
- -- TEST DESCRIPTION:
- --      This test imports a simple C function and specifies it's location.
- --
- --      The implementation may choose to implement
- --      Impdef.CD30005_1_Foreign_Address so as to dynamically call a C
- --      function that returns the appropriate address for the external
- --      function identified by Impdef.CD30005_1_External_Name.
- --
- -- TEST FILES:
- --         CD300050.AM
- --         CD300051.C  -- the C function:  (included below for reference)
- --
- -- SPECIAL REQUIREMENTS:
- --      The file CD300051.C must be compiled with a C compiler.
- --      Implementation dialects of C may require alteration of the C program
- --      syntax.  The program is included here for reference:
- --
- --            int _cd30005_1( Value )
- --            {
- --               /* int Value */
- --
- --               return Value + 1;
- --            }
- --
- --      Implementations may require special linkage commands to include the
- --      C code.
- --
- -- APPLICABILITY CRITERIA:
- --    This test is not applicable to implementations not providing an interface
- --    to C language units.  OTHERWISE:
- --
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      30 APR 96   SAIC   Added commentary for 2.1
- --      09 MAY 96   SAIC   Changed reporting for 2.1
- --      04 NOV 96   SAIC   Added use type System.Address
- --      16 FEB 98   EDS    Modified documentation.
- --      29 JUN 98   EDS    Modified main program name.
- --!
- 
- ----------------------------------------------------------------- CD30005_0
- 
- with Impdef;
- package CD30005_0 is
- 
- --      Check that Address clauses are supported for imported subprograms.
- 
-   type External_Func_Ref is access function(N:Integer) return Integer;
-     pragma Convention( C, External_Func_Ref );
- 
- 
-   function CD30005_1( I: Integer ) return Integer;
- 
-     pragma Import( C, CD30005_1,
-                    Impdef.CD30005_1_External_Name );          -- N/A => ERROR.
- 
-       for CD30005_1'Address use
-         Impdef.CD30005_1_Foreign_Address;                     -- ANX-C RQMT.
- 
-   procedure TC_Check_Imports;
- 
- end CD30005_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- with System.Storage_Elements;
- with System.Address_To_Access_Conversions;
- package body CD30005_0 is
- 
-   use type System.Address;
- 
-   procedure TC_Check_Imports is
-     S   : External_Func_Ref := CD30005_1'Access;
-     I,K : Integer := 99;
-   begin
- 
-     K := S.all(I);
-     if K /= 100 then
-       Report.Failed("C program returned" & Integer'Image(K));
-     end if;
- 
-     I := CD30005_1( I );
-     if I /= 100 then
-       Report.Failed("C program returned" & Integer'Image(I));
-     end if;
- 
-     if CD30005_1'Address /= Impdef.CD30005_1_Foreign_Address then
-       Report.Failed("Address not that specified");
-     end if;
- 
-   end TC_Check_Imports;
- 
- end CD30005_0;
- 
- ------------------------------------------------------------------- CD300050
- 
- with Report;
- with CD30005_0;
- 
- procedure CD300050 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD30005",
-                "Check that Address clauses are supported for imported " &
-                "subprograms" );
-    
- --      Check that Address clauses are supported for imported subprograms.
- 
-   CD30005_0.TC_Check_Imports;
- 
-   Report.Result;
- 
- end CD300050;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd300051.c gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd300051.c
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd300051.c	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd300051.c	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- /*
- -- CD30051.C                                                            
- --                                                                       
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --                                                                       
- -- FUNCTION NAME: _cd3005_1
- --                                                                       
- -- FUNCTION DESCRIPTION:                                                 
- --      This C function returns the sum of its parameter and 1 through
- --      the function name.  The parameter is unchanged.
- --
- -- INPUTS:
- --      This function requires that one parameter, of type int, be passed 
- --      to it.
- --
- -- PROCESSING:
- --      The function will calculate the sum of its parameter and 1
- --      and return this value as the function result through the function
- --      name.
- --
- -- OUTPUTS:                        
- --      The sum of the parameter and 1 is returned through function name. 
- --                                                                       
- -- CHANGE HISTORY:                                                       
- --      12 Oct 95   SAIC    Initial prerelease version.                  
- --      14 Feb 97   PWB.CTA Created this file from code appearing in
- --                          CD30005.A (as comments).
- --!
- */
-             int _cd30005_1(int Value )
-             {
-                 /* int Value */
- 
-                return Value + 1;
-             }
-                                                                          
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- CD30011.A
- 
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --
- --                                     Notice
- --
- --     The ACAA has created and maintains the Ada Conformity Assessment Test
- --     Suite for the purpose of conformity assessments conducted in accordance
- --     with the International Standard ISO/IEC 18009 - Ada: Conformity
- --     assessment of a language processor. This test suite should not be used
- --     to make claims of conformance unless used in accordance with
- --     ISO/IEC 18009 and any applicable ACAA procedures.
- --
- --*
- -- OBJECTIVE:
- --     Check that a size specification can be given by an attribute definition
- --     clause for an enumeration type:
- --        * in the visible or private part of a package for a type declared
- --          in the visible part;
- --        * for a derived enumeration type;
- --        * for a derived private type whose full declaration is an
- --          enumeration type.
- --
- -- TEST DESCRIPTION:
- --     This test was created from legacy tests CD1009B and CD2A31C. The
- --     objective of CD1009B was also an objective of CD2A31C; the tests
- --     were merged to eliminate duplication and add appropriate applicability
- --     criteria.
- --
- -- APPLICABILITY CRITERIA:
- --     All implementations must attempt to compile this test.
- --
- --     For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --     or implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as
- --        inapplicable. Otherwise, the test must execute and report PASSED.
- --
- -- CHANGE HISTORY:
- --      17 Jun 87  PWB  Created original test CD2A21C.
- --      07 Oct 87  VCL  Created original test CD1009B.
- --      17 Apr 89  DHH  Changed extension from '.DEP' TO '.ADA', changed
- --                      operators on 'Size tests, and added check on
- --                      representation clause.
- --      26 Mar 92  JRL  Removed testing of nonobjective types.
- --      29 Mar 17  RLB  Created test from CD2A21C and CD1009B; reformatted
- --                      to "modern" standards, added applicability criteria.
- 
- with Report; use Report;
- with Length_Check;                      -- CONTAINS A CALL TO 'Failed'.
- procedure CD30011 is
- 
-    type Basic_Enum is (A, B, C, D, E);
-    Specified_Size : constant := Basic_Enum'Size;
- 
-    Minimum_Size : Integer := Report.Ident_Int (Specified_Size);
- 
-    type Derived_Enum is new Basic_Enum;
-    for Derived_Enum'Size use Specified_Size;                  -- ANX-C RQMT.
- 
-    package P is
-       type Enum_in_P is (A1, B1, C1, D1, E1, F1, G1);
-       for Enum_in_P'Size use Specified_Size;                  -- ANX-C RQMT.
-       type private_Enum is private;
-       type Alt_Enum_in_P is (A2, B2, C2, D2, E2, F2, G2);
-    private
-       type private_Enum is (A3, B3, C3, D3, E3, F3, G3);
-       for Alt_Enum_in_P'Size use Specified_Size;              -- ANX-C RQMT.
-    end P;
- 
-    type Derived_Private_Enum is new P.Private_Enum;
-    for Derived_Private_Enum'Size use Specified_Size;          -- ANX-C RQMT.
- 
-    use P;
- 
-    procedure Check_1 is new Length_Check (Derived_Enum);
-    procedure Check_2 is new Length_Check (Enum_in_P);
-    procedure Check_3 is new Length_Check (Alt_Enum_in_P);
- 
-    X : Enum_in_P := A1;
-    Y : Alt_Enum_in_P := A2;
- 
- begin
- 
-    Report.Test ("CD30011", "Check that 'Size attribute definition clauses " &
-                            "can be given in the visible or private part " &
-                            "of a package for enumeration types declared " &
-                            "declared in the visible part, and for derived " &
-                            "enumeration types and derived private types " &
-                            "whose full declarations are as enumeration types");
- 
-    Check_1 (C,  Specified_Size, "Derived_Enum");
-    Check_2 (C1, Specified_Size, "Enum_in_P");
-    Check_3 (C2, Specified_Size, "Alt_Enum_in_P");
- 
-    if Derived_Enum'Size /= Minimum_Size then
-       Failed ("Derived_Enum'Size should not be greater than" &
-               Integer'Image (Minimum_Size) & ". Actual Size is" &
-               Integer'Image (Derived_Enum'Size));
-    end if;
- 
-    if Enum_in_P'Size /= Minimum_Size then
-       Failed ("Enum_in_P'Size should not be greater than" &
-               Integer'Image (Minimum_Size) & ". Actual Size is" &
-               Integer'Image (Enum_in_P'Size));
-    end if;
- 
-    if Alt_Enum_in_P'Size /= Minimum_Size then
-       Failed ("Alt_Enum_in_P'Size should not be greater than" &
-               Integer'Image (Minimum_Size) & ". Actual Size is" &
-               Integer'Image (Alt_Enum_in_P'Size));
-    end if;
- 
-    if Derived_Private_Enum'Size /= Minimum_Size then
- 
-       Failed ("Derived_Private_Enum'Size should not be greater " &
-               "than " & Integer'Image (Minimum_Size) & ". Actual Size is" &
-               Integer'Image (Derived_Private_Enum'Size));
-    end if;
- 
-    if X'Size < Specified_Size then
-       Failed ("Object'Size is too small --" &
-               Enum_in_P'Image (X));
-    end if;
- 
-    if Y'Size < Specified_Size then
-       Failed ("Object'Size is too small --" &
-               Alt_Enum_in_P'Image (Y));
-    end if;
- 
-    Report.Result;
- 
- end CD30011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd30012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd30012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,173 ****
- -- CD30012.A
- 
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --
- --                                     Notice
- --
- --     The ACAA has created and maintains the Ada Conformity Assessment Test
- --     Suite for the purpose of conformity assessments conducted in accordance
- --     with the International Standard ISO/IEC 18009 - Ada: Conformity
- --     assessment of a language processor. This test suite should not be used
- --     to make claims of conformance unless used in accordance with
- --     ISO/IEC 18009 and any applicable ACAA procedures.
- --
- --*
- -- OBJECTIVE:
- --     Check that a size specification can be given by an attribute definition
- --     clause for an integer type:
- --        * in the visible or private part of a package for a type declared
- --          in the visible part;
- --        * for a derived integer type;
- --        * for a derived private type whose full declaration is an
- --          integer type.
- --
- -- TEST DESCRIPTION:
- --     This test was created from legacy tests CD1009B and CD2A31C. The
- --     objective of CD1009B was also an objective of CD30012; the tests
- --     were merged to eliminate duplication and add appropriate applicability
- --     criteria.
- --
- -- APPLICABILITY CRITERIA:
- --     All implementations must attempt to compile this test.
- --
- --     For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --     or implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as
- --        inapplicable. Otherwise, the test must execute and report PASSED.
- --
- -- CHANGE HISTORY:
- --      17 Jun 87  PWB  Created original test CD2A31C.
- --      09 Sep 87  VCL  Created original test CD1009A.
- --      06 Apr 89  DHH  Changed extension from '.DEP' TO '.ADA', changed
- --                      size clause value to 9, and added representation
- --                      clause check and included test for for integer in a
- --                      generic unit.
- --      27 Mar 92  JRL  Removed testing of nonobjective types.
- --      17 Jun 92  DTN  Removed the length clause for type Private_Int.
- --      29 Mar 17  RLB  Created test from CD2A31C and CD1009A; reformatted
- --                      to "modern" standards, added applicability criteria,
- --                      removed nonobjective packed array.
- 
- with Report; use Report;
- with Length_Check;                      -- Contains a call to 'Failed'.
- procedure CD30012 is
- 
-    type Basic_Int is range -60 .. 80;
-    Specified_Size : constant := 9;
- 
-    type Derived_Int is new Basic_Int;
-    for Derived_Int'Size use Specified_Size;                   -- ANX-C RQMT.
- 
-    package P is
-       type Int_in_P is range -125 .. 125;
-       for Int_in_P'Size use Specified_Size;                   -- ANX-C RQMT.
-       type Private_Int is private;
-       type Alt_Int_in_P is range -125 .. 125;
-    private
-       type Private_Int is range -125 .. 125;
-       for Alt_Int_in_P'Size use Specified_Size;               -- ANX-C RQMT.
-    end P;
- 
-    use P;
-    type Derived_Private_Int is new Private_Int;
-    for Derived_Private_Int'Size use Specified_Size;           -- ANX-C RQMT.
-    Minimum_Size : Integer := Report.Ident_Int (Specified_Size);
- 
-    -- Size specification given in a generic procedure:
- 
-    generic
-    procedure Genproc;
- 
-    procedure Genproc is
-       type Check_Int is range -125 .. 125;
-       for Check_Int'Size use Specified_Size;                  -- ANX-C RQMT.
- 
-       procedure Check_4 is new Length_Check (Check_Int);
- 
-    begin
- 
-       if Check_Int'Size /= Minimum_Size then
-          Failed ("Generic Check_Int'Size is incorrect");
-       end if;
-       Check_4 (-60, 9, "generic Check_Int");
- 
-    end Genproc;
- 
-    procedure Newproc is new Genproc;
- 
-    procedure Check_1 is new Length_Check (Derived_Int);
-    procedure Check_2 is new Length_Check (Int_in_P);
-    procedure Check_3 is new Length_Check (Alt_Int_in_P);
- 
-    Obj1 : Int_in_P := 92;
-    Obj2 : Alt_Int_in_P := 52;
- 
- begin
- 
-    Report.Test ("CD30012", "Check that 'Size attribute definition clauses " &
-                            "can be given in the visible or private part " &
-                            "of a package for integer types declared " &
-                            "declared in the visible part, and for derived " &
-                            "integer types and derived private types " &
-                            "whose full declarations are as integer types");
- 
-    Check_1 (-60, 9, "Derived_Int");
-    Check_2 (-60, 9, "Int_in_P");
-    Check_3 (-60, 9, "Alt_Int_in_P");
-    Check_2 (Obj1, 9, "Int_in_P");
-    Check_3 (Obj2, 9, "Alt_Int_in_P");
- 
-    Newproc;
- 
-    if Derived_Int'Size /= Minimum_Size then
-         Failed ("Derived_Int'Size incorrect");
-    end if;
- 
-    if Int_in_P'Size /= Minimum_Size then
-         Failed ("Int_in_P'Size incorrect");
-    end if;
- 
-    if Alt_Int_in_P'Size /= Minimum_Size then
-         Failed ("Alt_Int_in_P'Size incorrect");
-    end if;
- 
-    if Derived_Private_Int'Size /= Minimum_Size then
-         Failed ("Derived_Private_Int'Size incorrect");
-    end if;
- 
-    if Obj1'Size < Specified_Size then
-       Failed ("Object'Size is too small --" &
-               Int_in_P'Image (Obj1));
-    end if;
- 
-    if Obj2'Size < Specified_Size then
-       Failed ("Object'Size is too small --" &
-               Alt_Int_in_P'Image (Obj2));
-    end if;
- 
-    Report.Result;
- 
- end CD30012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- CD3014A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION TYPE WITH A REPRESENTATION CLAUSE CAN
- --     BE USED CORRECTLY IN ORDERING RELATIONS, INDEXING ARRAYS, AND IN
- --     GENERIC INSTANTIATIONS.
- 
- -- HISTORY
- --     DHH 09/30/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     BCB 03/07/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
- --                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
- --                   REVISED CHECK FOR ARRAY INDEXING.
- --     THS 09/18/90  REVISED WORDING IN HEADER AND MODIFIED FAILED ERROR
- --                   MESSAGE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD3014A IS
- 
- BEGIN
- 
-      TEST ("CD3014A", "CHECK THAT AN ENUMERATION TYPE WITH A " &
-                       "REPRESENTATION CLAUSE CAN BE USED CORRECTLY " &
-                       "IN ORDERING RELATIONS, INDEXING ARRAYS, AND " &
-                       "IN GENERIC INSTANTIATIONS");
- 
-      DECLARE
-           PACKAGE PACK IS
- 
-                TYPE HUE IS (RED,BLUE,YELLOW,'R','B','Y');
- 
-                FOR HUE USE (RED => 8, BLUE => 9,
-                             YELLOW => 10, 'R' => 11,
-                             'B' => 12, 'Y' => 13);
- 
-                TYPE BASE IS ARRAY(HUE) OF INTEGER;
-                COLOR,BASIC : HUE;
-                BARRAY : BASE;
- 
-                TYPE HUE1 IS ('Y','B','R',YELLOW,BLUE,RED);
- 
-                FOR HUE1 USE ('Y' => 10, 'B' => 14, 'R' => 16,
-                              YELLOW => 19, BLUE => 41, RED => 46);
- 
-                TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
-                COLOR1,BASIC1 : HUE1;
-                BARRAY1 : BASE1;
- 
-                GENERIC
-                     TYPE ENUM IS (<>);
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
- 
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
-                     T : ENUM;
-                BEGIN
-                     T := X;
-                     X := Y;
-                     Y := T;
-                END CHANGE;
- 
-                PROCEDURE PROC IS NEW CHANGE(HUE);
-                PROCEDURE PROC1 IS NEW CHANGE(HUE1);
- 
-           BEGIN
-                BASIC := RED;
-                COLOR := HUE'SUCC(BASIC);
-                BASIC1 := RED;
-                COLOR1 := HUE1'PRED(BASIC1);
-                IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
-                   COLOR > 'B') OR
-                   NOT (COLOR1 < BASIC1 AND BASIC1 >= 'R' AND
-                   'Y' <= COLOR1 AND COLOR1 > 'B') THEN
-                     FAILED("ORDERING RELATIONS ARE INCORRECT");
-                END IF;
- 
-                PROC(BASIC,COLOR);
-                PROC1(BASIC1,COLOR1);
- 
-                IF COLOR /= RED OR COLOR1 /= RED THEN
-                     FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
-                            "GENERIC UNIT NOT CORRECT AFTER CALL");
-                END IF;
- 
-                BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
-                    BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
-                    BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
-                   NOT (BARRAY1 (RED) = 6 AND BARRAY1 (BLUE) = 5 AND
-                    BARRAY1 (YELLOW) = 4 AND BARRAY1 ('R') = 3 AND
-                    BARRAY1 ('B') = 2 AND BARRAY1 ('Y') = 1)
-                   THEN
-                     FAILED("INDEXING ARRAY FAILURE");
-                END IF;
- 
-           END PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3014A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- CD3014C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE CAN BE GIVEN IN
- --     THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE DECLARED IN
- --     THE VISIBLE PART.
- 
- -- HISTORY
- --     DHH 09/30/87 CREATED ORIGINAL TEST
- --     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA',CHANGED
- --                   FROM 'A' TEST TO 'C' TEST AND ADDED CHECK FOR
- --                   REPRESENTATION CLAUSE.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;        -- CONTAINS CALL TO 'FAILED'
- PROCEDURE CD3014C IS
- 
- BEGIN
- 
-      TEST ("CD3014C", "CHECK THAT AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE CAN BE GIVEN IN THE " &
-                       "VISIBLE OR PRIVATE PART OF A PACKAGE FOR " &
-                       "A TYPE DECLARED IN THE VISIBLE PART");
- 
-      DECLARE
-           PACKAGE PACK IS
- 
-                TYPE HUE IS (RED,BLUE,YELLOW);
-                TYPE NEWHUE IS (RED,BLUE,YELLOW);
- 
-                FOR HUE USE
-                          (RED => 8, BLUE => 16,
-                                       YELLOW => 32);
-                A : HUE := BLUE;
-           PRIVATE
- 
-                FOR NEWHUE USE (RED => 8, BLUE => 16, YELLOW => 32);
- 
-                B : NEWHUE := RED;
- 
-                TYPE INT_HUE IS RANGE 8 .. 32;
-                FOR INT_HUE'SIZE USE HUE'SIZE;
- 
-                TYPE INT_NEW IS RANGE 8 .. 32;
-                FOR INT_NEW'SIZE USE NEWHUE'SIZE;
- 
-                PROCEDURE CHECK_HUE IS NEW ENUM_CHECK(HUE, INT_HUE);
-                PROCEDURE CHECK_NEW IS NEW ENUM_CHECK(NEWHUE, INT_NEW);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                CHECK_HUE (RED, 8, "HUE");
-                CHECK_NEW (YELLOW, 32, "NEWHUE");
-           END PACK;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3014C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- CD3014D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION TYPE WITH A REPRESENTATION CLAUSE IN A
- --     GENERIC UNIT CAN BE USED CORRECTLY IN ORDERING RELATIONS,
- --     INDEXING ARRAYS, AND IN GENERIC INSTANTIATIONS.
- 
- -- HISTORY
- --     DHH 09/30/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     BCB 03/07/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
- --                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
- --                   REVISED CHECK FOR ARRAY INDEXING.
- --     THS 09/18/90  REVISED WORDING IN HEADER AND MODIFIED FAILED ERROR
- --                   MESSAGE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD3014D IS
- 
- BEGIN
- 
-      TEST ("CD3014D", "CHECK THAT AN ENUMERATION TYPE WITH A " &
-                       "REPRESENTATION CLAUSE IN A GENERIC UNIT CAN " &
-                       "BE USED CORRECTLY IN ORDERING RELATIONS, " &
-                       "INDEXING ARRAYS, AND IN GENERIC INSTANTIATIONS");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
- 
-                TYPE HUE IS (RED,BLUE,YELLOW,'R','B','Y');
- 
-                FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
-                             'R' => 11, 'B' => 12, 'Y' => 13);
- 
-                TYPE HUE1 IS ('Y','B','R',YELLOW,BLUE,RED);
- 
-                FOR HUE1 USE ('Y' => 10, 'B' => 14, 'R' => 16,
-                              YELLOW => 19, BLUE => 41, RED => 46);
- 
-                TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
-                COLOR1,BASIC1 : HUE1;
-                BARRAY1 : BASE1;
- 
-                TYPE BASE IS ARRAY(HUE) OF INTEGER;
-                COLOR,BASIC : HUE;
-                BARRAY : BASE;
- 
-                GENERIC
-                     TYPE ENUM IS (<>);
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM);
- 
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
- 
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
-                     T : ENUM;
-                BEGIN
-                     T := X;
-                     X := Y;
-                     Y := T;
-                END CHANGE;
- 
-                PROCEDURE PROC IS NEW CHANGE(HUE);
-                PROCEDURE PROC1 IS NEW CHANGE(HUE1);
- 
-           BEGIN
-                BASIC := RED;
-                COLOR := HUE'SUCC(BASIC);
-                BASIC1 := RED;
-                COLOR1 := HUE1'PRED(BASIC1);
-                IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
-                   COLOR > 'B') OR
-                   NOT (COLOR1 < BASIC1 AND BASIC1 >= 'R' AND
-                   'Y' <= COLOR1 AND COLOR1 > 'B') THEN
-                     FAILED("ORDERING RELATIONS ARE INCORRECT");
-                END IF;
- 
-                PROC(BASIC,COLOR);
-                PROC1(BASIC1,COLOR1);
- 
-                IF COLOR /= RED OR COLOR1 /= RED THEN
-                     FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
-                            "GENERIC UNIT NOT CORRECT AFTER CALL");
-                END IF;
- 
-                BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
-                    BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
-                    BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
-                   NOT (BARRAY1 (RED) = 6 AND BARRAY1 (BLUE) = 5 AND
-                    BARRAY1 (YELLOW) = 4 AND BARRAY1 ('R') = 3 AND
-                    BARRAY1 ('B') = 2 AND BARRAY1 ('Y') = 1)
-                   THEN
-                     FAILED("INDEXING ARRAY FAILURE");
-                END IF;
- 
-           END GENPACK;
- 
-           PACKAGE P IS NEW GENPACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3014D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3014f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3014f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- CD3014F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE CAN BE GIVEN
- --     IN THE VISIBLE OR PRIVATE PART OF A GENERIC PACKAGE FOR A
- --     TYPE DECLARED IN THE VISIBLE PART.
- 
- -- HISTORY
- --     DHH 09/30/87  CREATED ORIGINAL TEST
- --     DHH 03/29/89  CHANGED FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                   '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
- --     RJW 09/18/89  REMOVED THE COMMENT "-- N/A => ERROR.".
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD3014F IS
- 
- BEGIN
- 
-      TEST ("CD3014F", "CHECK THAT AN ENUMERATION REPRESENTATION " &
-                       "CLAUSE CAN BE GIVEN IN THE VISIBLE " &
-                       "OR PRIVATE PART OF A GENERIC PACKAGE FOR " &
-                       "A TYPE DECLARED IN THE VISIBLE PART");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
- 
-                TYPE HUE IS (RED,BLUE,YELLOW,'R','B','Y');
-                TYPE NEWHUE IS (RED,BLUE,YELLOW,'R','B','Y');
- 
-                FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
-                    'R' => 11, 'B' => 12, 'Y' => 13);
-                A : HUE := BLUE;
- 
-                TYPE INT1 IS RANGE 8 .. 13;
-                FOR INT1'SIZE USE HUE'SIZE;
- 
-           PRIVATE
- 
-                FOR NEWHUE USE (RED => 2, BLUE => 4, YELLOW => 6,
-                    'R' => 8, 'B' => 10, 'Y' => 12);
- 
-                B : NEWHUE := RED;
-                TYPE INT2 IS RANGE 2 .. 12;
-                FOR INT2'SIZE USE NEWHUE'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
-                PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
-           BEGIN
-                CHECK_1 ('B', 12, "HUE");
-                CHECK_2 ('B', 10, "NEWHUE");
-           END GENPACK;
- 
-           PACKAGE P IS NEW GENPACK;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3014F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- CD3015A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED ENUMERATION TYPE CAN BE USED CORRECTLY IN
- --     ORDERING RELATIONS, INDEXING ARRAYS, AND IN GENERIC
- --     INSTANTIATIONS, WHEN THERE IS NO ENUMERATION CLAUSE FOR THE
- --     PARENT.
- 
- -- HISTORY
- --     DHH 09/30/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     BCB 03/08/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
- --                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
- --                   REVISED CHECK FOR ARRAY INDEXING.
- --     THS 09/18/90  REVISED WORDING IN HEADER COMMENT AND FIXED FAILURE
- --                   ERROR MESSAGE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD3015A IS
- 
- BEGIN
- 
-      TEST ("CD3015A", "CHECK THAT A DERIVED ENUMERATION TYPE CAN BE " &
-                       "USED CORRECTLY IN ORDERING RELATIONS, " &
-                       "INDEXING ARRAYS, AND IN GENERIC " &
-                       "INSTANTIATIONS, WHEN THERE IS NO ENUMERATION " &
-                       "CLAUSE FOR THE PARENT");
- 
-      DECLARE
-           PACKAGE PACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
- 
-                TYPE HUE IS NEW MAIN;
-                FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
-                             'R' => 11, 'B' => 12, 'Y' => 13);
- 
-                TYPE BASE IS ARRAY(HUE) OF INTEGER;
-                COLOR,BASIC : HUE;
-                BARRAY : BASE;
- 
-                TYPE HUE1 IS NEW MAIN;
-                FOR HUE1 USE (RED => 10, BLUE => 14, YELLOW => 16,
-                             'R' => 19, 'B' => 41, 'Y' => 46);
- 
-                TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
-                COLOR1,BASIC1 : HUE1;
-                BARRAY1 : BASE1;
- 
-                GENERIC
-                     TYPE ENUM IS (<>);
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
- 
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
-                     T : ENUM;
-                BEGIN
-                     T := X;
-                     X := Y;
-                     Y := T;
-                END CHANGE;
- 
-                PROCEDURE PROC IS NEW CHANGE(HUE);
-                PROCEDURE PROC1 IS NEW CHANGE(HUE1);
- 
-           BEGIN
-                BASIC := RED;
-                COLOR := HUE'SUCC(BASIC);
-                BASIC1 := RED;
-                COLOR1 := HUE1'SUCC(BASIC1);
-                IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
-                   COLOR > 'B') OR
-                   NOT (COLOR1 >= BASIC1 AND BASIC1 < 'R' AND
-                   'Y' > COLOR1 AND COLOR1 <= 'B') THEN
-                     FAILED("ORDERING RELATIONS ARE INCORRECT");
-                END IF;
- 
-                PROC(BASIC,COLOR);
-                PROC1(BASIC1,COLOR1);
- 
-                IF COLOR /= RED OR COLOR1 /= RED THEN
-                     FAILED("VALUES IN PARAMETERS TO INSTANCE OF " &
-                            "GENERIC UNIT NOT CORRECT AFTER CALL");
-                END IF;
- 
-                BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
-                    BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
-                    BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
-                   NOT (BARRAY1 (RED) = 1 AND BARRAY1 (BLUE) = 2 AND
-                    BARRAY1 (YELLOW) = 3 AND BARRAY1 ('R') = 4 AND
-                    BARRAY1 ('B') = 5 AND BARRAY1 ('Y') = 6)
-                   THEN
-                     FAILED("INDEXING ARRAY FAILURE");
-                END IF;
- 
-           END PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- CD3015C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE FOR A DERIVED
- --     TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A PACKAGE
- --     FOR A DERIVED TYPE DECLARED IN THE VISIBLE PART, WHERE NO
- --     ENUMERATION CLAUSE HAS BEEN GIVEN FOR THE PARENT.
- 
- -- HISTORY
- --     DHH  10/01/87  CREATED ORIGINAL TEST
- --     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD3015C IS
- 
- BEGIN
- 
-      TEST ("CD3015C", "CHECK THAT AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE FOR A DERIVED TYPE CAN " &
-                       "BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A " &
-                       "PACKAGE FOR A DERIVED TYPE DECLARED IN THE " &
-                       "VISIBLE PART, WHERE NO ENUMERATION CLAUSE HAS " &
-                       "BEEN GIVEN FOR THE PARENT");
- 
-      DECLARE
-           PACKAGE PACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW);
- 
-                TYPE HUE IS NEW MAIN;
-                TYPE NEWHUE IS NEW MAIN;
- 
-                FOR HUE USE (RED => 1, BLUE => 16, YELLOW => 32);
-           PRIVATE
-                FOR NEWHUE USE (RED => 16, BLUE => 17, YELLOW => 18);
- 
-                TYPE INT1 IS RANGE 1 .. 32;
-                FOR INT1'SIZE USE HUE'SIZE;
- 
-                TYPE INT2 IS RANGE 16 .. 18;
-                FOR INT2'SIZE USE NEWHUE'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
-                PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
-           END PACK;
- 
-           PACKAGE BODY PACK IS
- 
-           BEGIN
-                CHECK_1 (RED, 1, "HUE");
-                CHECK_2 (YELLOW, 18, "NEWHUE");
-           END PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- CD3015E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN THERE IS NO ENUMERATION CLAUSE FOR THE PARENT
- --     TYPE IN A GENERIC UNIT, THE DERIVED TYPE CAN BE USED CORRECTLY
- --     IN ORDERING RELATIONS, INDEXING ARRAYS, AND IN GENERIC
- --     INSTANTIATIONS.
- 
- -- HISTORY
- --     DHH 10/05/87 CREATED ORIGINAL TEST
- --     DHH 03/30/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND ADDED
- --                  CHECK FOR REPRESENTATION CLAUSE.
- --     RJW 03/20/90 MODIFIED CHECK FOR ARRAY INDEXING.
- --     THS 09/18/90 REVISED WORDING ON FAILURE ERROR MESSAGE.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                        -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD3015E IS
- 
- BEGIN
- 
-      TEST ("CD3015E", "CHECK THAT WHEN THERE " &
-                       "IS NO ENUMERATION CLAUSE FOR THE PARENT " &
-                       "TYPE IN A GENERIC UNIT, THE " &
-                       "DERIVED TYPE CAN BE USED CORRECTLY IN " &
-                       "ORDERING RELATIONS, INDEXING ARRAYS, AND IN " &
-                       "GENERIC INSTANTIATIONS");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
- 
-                TYPE HUE IS NEW MAIN;
-                FOR HUE USE
-                          (RED => 1, BLUE => 6,
-                                YELLOW => 11, 'R' => 16,
-                                'B' => 22, 'Y' => 30);
- 
-                TYPE BASE IS ARRAY(HUE) OF INTEGER;
-                COLOR,BASIC : HUE;
-                BARRAY : BASE;
-                T : INTEGER := 1;
- 
-                TYPE INT1 IS RANGE 1 .. 30;
-                FOR INT1'SIZE USE HUE'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
- 
-                GENERIC
-                     TYPE ENUM IS (<>);
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM);
- 
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
- 
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
-                     T : ENUM;
-                BEGIN
-                     T := X;
-                     X := Y;
-                     Y := T;
-                END CHANGE;
- 
-                PROCEDURE PROC IS NEW CHANGE(HUE);
- 
-           BEGIN
-                BASIC := RED;
-                COLOR := HUE'SUCC(BASIC);
-                IF (COLOR < BASIC OR
-                         BASIC >= 'R' OR
-                         'Y' <= COLOR OR
-                         COLOR > 'B') THEN
-                     FAILED("ORDERING RELATIONS ARE INCORRECT");
-                END IF;
- 
-                PROC(BASIC,COLOR);
- 
-                IF COLOR /= RED THEN
-                     FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
-                            "GENERIC UNIT NOT CORRECT AFTER CALL");
-                END IF;
- 
-                FOR I IN HUE LOOP
-                     BARRAY(I) := IDENT_INT(T);
-                     T := T + 1;
-                END LOOP;
- 
-                IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
-                    BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
-                    BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) THEN
-                     FAILED("INDEXING ARRAY FAILURE");
-                END IF;
- 
-                CHECK_1 (YELLOW, 11, "HUE");
- 
-           END GENPACK;
- 
-           PACKAGE P IS NEW GENPACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- CD3015F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE FOR A DERIVED
- --     TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A GENERIC
- --     PACKAGE FOR A DERIVED TYPE DECLARED IN THE VISIBLE PART, WHERE
- --     NO ENUMERATION CLAUSE HAS BEEN GIVEN FOR THE PARENT.
- 
- -- HISTORY
- --     DHH 10/01/87 CREATED ORIGINAL TEST
- --     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA',CHANGED
- --                   FROM 'A' TEST TO 'C' TEST AND ADDED CHECK FOR
- --                   REPRESENTATION CLAUSE.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;            -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD3015F IS
- 
- BEGIN
- 
-      TEST ("CD3015F", "CHECK THAT AN " &
-                       "ENUMERATION REPRESENTATION CLAUSE FOR A " &
-                       "DERIVED TYPE CAN BE GIVEN IN THE VISIBLE OR " &
-                       "PRIVATE PART OF A GENERIC PACKAGE FOR A " &
-                       "DERIVED TYPE DECLARED IN THE VISIBLE PART, " &
-                       "WHERE NO ENUMERATION CLAUSE HAS BEEN GIVEN " &
-                       "FOR THE PARENT");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
- 
-                TYPE HUE IS NEW MAIN;
-                TYPE NEWHUE IS NEW MAIN;
- 
-                FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
-                      'R' => 11, 'B' => 12, 'Y' => 13);
- 
-           PRIVATE
-                FOR NEWHUE USE (RED => 8, BLUE => 9, YELLOW => 10,
-                      'R' => 11, 'B' => 12, 'Y' => 13);
- 
-                TYPE INT_HUE IS RANGE 8 .. 13;
-                FOR INT_HUE'SIZE USE HUE'SIZE;
- 
-                TYPE INT_NEW IS RANGE 8 .. 13;
-                FOR INT_NEW'SIZE USE NEWHUE'SIZE;
- 
-                PROCEDURE CHECK_HUE IS NEW ENUM_CHECK(HUE, INT_HUE);
-                PROCEDURE CHECK_NEW IS NEW ENUM_CHECK(NEWHUE, INT_NEW);
- 
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
- 
-           BEGIN
-                CHECK_HUE (RED, 8, "HUE");
-                CHECK_HUE ('R', 11, "NEWHUE");
-           END GENPACK;
- 
-           PACKAGE P IS NEW GENPACK;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- CD3015G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED ENUMERATION TYPE WITH A REPRESENTATION
- --     CLAUSE CAN BE USED CORRECTLY IN ORDERING RELATIONS, INDEXING
- --     ARRAYS, AND IN GENERIC INSTANTIATIONS WHEN THERE IS AN
- --     ENUMERATION CLAUSE FOR THE PARENT.
- 
- -- HISTORY
- --     DHH 09/30/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     BCB 03/08/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
- --                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
- --                   REVISED CHECK FOR ARRAY INDEXING.
- --     THS 09/18/90  REVISED WORDING IN HEADER COMMENT AND FIXED FAILURE
- --                   ERROR MESSAGE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD3015G IS
- 
- BEGIN
- 
-      TEST ("CD3015G", "CHECK THAT A DERIVED ENUMERATION TYPE WITH A " &
-                       "REPRESENTATION CLAUSE CAN BE USED CORRECTLY " &
-                       "IN ORDERING RELATIONS, INDEXING ARRAYS, AND " &
-                       "IN GENERIC INSTANTIATIONS WHEN THERE IS AN " &
-                       "ENUMERATION CLAUSE FOR THE PARENT");
- 
-      DECLARE
-           PACKAGE PACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
- 
-                FOR MAIN USE (RED => 1, BLUE => 2, YELLOW => 3, 'R' => 4,
-                              'B' => 5, 'Y' => 6);
- 
-                TYPE HUE IS NEW MAIN;
-                FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
-                             'R' => 11, 'B' => 12, 'Y' => 13);
- 
-                TYPE HUE1 IS NEW MAIN;
-                FOR HUE1 USE (RED => 10, BLUE => 14, YELLOW => 16,
-                             'R' => 19, 'B' => 41, 'Y' => 46);
- 
-                TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
-                COLOR1,BASIC1 : HUE1;
-                BARRAY1 : BASE1;
- 
-                TYPE BASE IS ARRAY(HUE) OF INTEGER;
-                COLOR,BASIC : HUE;
-                BARRAY : BASE;
- 
-                GENERIC
-                     TYPE ENUM IS (<>);
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
- 
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
-                     T : ENUM;
-                BEGIN
-                     T := X;
-                     X := Y;
-                     Y := T;
-                END CHANGE;
- 
-                PROCEDURE PROC IS NEW CHANGE(HUE);
-                PROCEDURE PROC1 IS NEW CHANGE(HUE1);
- 
-           BEGIN
-                BASIC := RED;
-                COLOR := HUE'SUCC(BASIC);
-                BASIC1 := RED;
-                COLOR1 := HUE1'SUCC(BASIC1);
-                IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
-                   COLOR > 'B') OR
-                   NOT (COLOR1 >= BASIC1 AND BASIC1 < 'R' AND
-                   'Y' > COLOR1 AND COLOR1 <= 'B') THEN
-                     FAILED("ORDERING RELATIONS ARE INCORRECT");
-                END IF;
- 
-                PROC(BASIC,COLOR);
-                PROC1(BASIC1,COLOR1);
- 
-                IF COLOR /= RED OR COLOR1 /= RED THEN
-                     FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
-                            "GENERIC UNIT NOT CORRECT AFTER CALL");
-                END IF;
- 
-                BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
-                    BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
-                    BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
-                   NOT (BARRAY1 (RED) = 1 AND BARRAY1 (BLUE) = 2 AND
-                    BARRAY1 (YELLOW) = 3 AND BARRAY1 ('R') = 4 AND
-                    BARRAY1 ('B') = 5 AND BARRAY1 ('Y') = 6)
-                   THEN
-                     FAILED("INDEXING ARRAY FAILURE");
-                END IF;
- 
-           END PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- CD3015H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION REPRESENTATION CLAUSE FOR A DERIVED
- --     TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A PACKAGE
- --     FOR A DERIVED TYPE DECLARED IN THE VISIBLE PART, WHERE AN
- --     ENUMERATION CLAUSE HAS BEEN GIVEN FOR THE PARENT.
- 
- -- HISTORY
- --     DHH  10/01/87  CREATED ORIGINAL TEST
- --     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD3015H IS
- 
- BEGIN
- 
-      TEST ("CD3015H", "CHECK THAT AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE FOR A DERIVED TYPE CAN " &
-                       "BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A " &
-                       "PACKAGE FOR A DERIVED TYPE DECLARED IN THE " &
-                       "VISIBLE PART, WHERE AN ENUMERATION CLAUSE HAS " &
-                       "BEEN GIVEN FOR THE PARENT");
- 
-      DECLARE
-           PACKAGE PACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW);
-                FOR MAIN USE (RED => 1, BLUE => 2, YELLOW => 3);
- 
-                TYPE HUE IS NEW MAIN;
-                TYPE NEWHUE IS NEW MAIN;
- 
-                FOR HUE USE
-                          (RED => 8, BLUE => 9, YELLOW => 10);
- 
-           PRIVATE
- 
-                FOR NEWHUE USE (RED => 6, BLUE => 11, YELLOW => 18);
- 
-                TYPE INT1 IS RANGE 8 .. 10;
-                FOR INT1'SIZE USE HUE'SIZE;
- 
-                TYPE INT2 IS RANGE 6 .. 18;
-                FOR INT2'SIZE USE NEWHUE'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
-                PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
- 
-           END PACK;
- 
-           PACKAGE BODY PACK IS
-           BEGIN
-                CHECK_1 (RED, 8, "HUE");
-                CHECK_2 (YELLOW, 18, "NEWHUE");
-           END PACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- CD3015I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A DERIVED ENUMERATION TYPE WITH A REPRESENTATION
- --     CLAUSE IN A GENERIC UNIT CAN BE USED CORRECTLY IN ORDERING
- --     RELATIONS, INDEXING ARRAYS, AND IN GENERIC INSTANTIATIONS WHEN
- --     THERE IS AN ENUMERATION CLAUSE FOR THE PARENT.
- 
- -- HISTORY
- --     DHH 09/30/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     BCB 03/08/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
- --                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
- --                   REVISED CHECK FOR ARRAY INDEXING.
- --     THS 09/18/90  REVISED WORDING IN HEADER COMMENT AND FIXED FAILURE
- --                   ERROR MESSAGE.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD3015I IS
- 
- BEGIN
- 
-      TEST ("CD3015I", "CHECK THAT A DERIVED ENUMERATION TYPE WITH A " &
-                       "REPRESENTATION CLAUSE IN A GENERIC UNIT CAN " &
-                       "BE USED CORRECTLY IN ORDERING RELATIONS, " &
-                       "INDEXING ARRAYS, AND IN GENERIC " &
-                       "INSTANTIATIONS WHEN THERE IS AN ENUMERATION " &
-                       "CLAUSE FOR THE PARENT");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
-                FOR MAIN USE
-                          (RED => 1, BLUE => 2,
-                                YELLOW => 3, 'R' => 4,
-                                'B' => 5, 'Y' => 6);
- 
-                TYPE HUE IS NEW MAIN;
-                FOR HUE USE
-                          (RED => 8, BLUE => 9,
-                                YELLOW => 10, 'R' => 11,
-                                'B' => 12, 'Y' => 13);
- 
-                TYPE BASE IS ARRAY(HUE) OF INTEGER;
-                COLOR,BASIC : HUE;
-                BARRAY : BASE;
- 
-                TYPE HUE1 IS NEW MAIN;
-                FOR HUE1 USE (RED => 10, BLUE => 14, YELLOW => 16,
-                             'R' => 19, 'B' => 41, 'Y' => 46);
- 
-                TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
-                COLOR1,BASIC1 : HUE1;
-                BARRAY1 : BASE1;
- 
-                GENERIC
-                     TYPE ENUM IS (<>);
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM);
- 
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
- 
-                PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
-                     T : ENUM;
-                BEGIN
-                     T := X;
-                     X := Y;
-                     Y := T;
-                END CHANGE;
- 
-                PROCEDURE PROC IS NEW CHANGE(HUE);
-                PROCEDURE PROC1 IS NEW CHANGE(HUE1);
- 
-           BEGIN
-                BASIC := RED;
-                COLOR := HUE'SUCC(BASIC);
-                BASIC1 := RED;
-                COLOR1 := HUE1'SUCC(BASIC1);
-                IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
-                   COLOR > 'B') OR
-                   NOT (COLOR1 >= BASIC1 AND BASIC1 < 'R' AND
-                   'Y' > COLOR1 AND COLOR1 <= 'B') THEN
-                     FAILED("ORDERING RELATIONS ARE INCORRECT");
-                END IF;
- 
-                PROC(BASIC,COLOR);
-                PROC1(BASIC1,COLOR1);
- 
-                IF COLOR /= RED OR COLOR1 /= RED THEN
-                     FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
-                            "GENERIC UNIT NOT CORRECT AFTER CALL");
-                END IF;
- 
-                BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
-                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
- 
-                IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
-                    BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
-                    BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
-                   NOT (BARRAY1 (RED) = 1 AND BARRAY1 (BLUE) = 2 AND
-                    BARRAY1 (YELLOW) = 3 AND BARRAY1 ('R') = 4 AND
-                    BARRAY1 ('B') = 5 AND BARRAY1 ('Y') = 6)
-                   THEN
-                     FAILED("INDEXING ARRAY FAILURE");
-                END IF;
- 
-           END GENPACK;
- 
-           PACKAGE P IS NEW GENPACK;
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3015k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3015k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- CD3015K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ENUMERATION
- --     REPRESENTATION CLAUSE FOR A DERIVED TYPE CAN BE GIVEN IN THE
- --     VISIBLE OR PRIVATE PART OF A GENERIC PACKAGE FOR A DERIVED TYPE
- --     DECLARED IN THE VISIBLE PART, WHERE AN ENUMERATION CLAUSE
- --     HAS BEEN GIVEN FOR THE PARENT.
- 
- -- HISTORY
- --     DHH  10/01/87  CREATED ORIGINAL TEST
- --     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
- --                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
- 
- WITH REPORT; USE REPORT;
- WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
- PROCEDURE CD3015K IS
- 
- BEGIN
- 
-      TEST ("CD3015K", "CHECK THAT AN ENUMERATION REPRESENTATION " &
-                       "CLAUSE FOR A DERIVED TYPE CAN BE GIVEN IN " &
-                       "THE VISIBLE OR PRIVATE PART OF A GENERIC " &
-                       "PACKAGE FOR A DERIVED TYPE DECLARED IN " &
-                       "THE VISIBLE PART, WHERE AN ENUMERATION " &
-                       "CLAUSE HAS BEEN GIVEN FOR THE PARENT");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
- 
-                TYPE MAIN IS (RED,BLUE,YELLOW);
-                FOR MAIN USE (RED => 1, BLUE => 2, YELLOW => 3);
- 
-                TYPE HUE IS NEW MAIN;
-                TYPE NEWHUE IS NEW MAIN;
- 
-                FOR HUE USE (RED => 8, BLUE => 11, YELLOW => 12);
- 
-           PRIVATE
- 
-                FOR NEWHUE USE (RED => 6, BLUE => 12, YELLOW => 18);
- 
-                TYPE INT1 IS RANGE 8 .. 12;
-                FOR INT1'SIZE USE HUE'SIZE;
- 
-                TYPE INT2 IS RANGE 6 .. 18;
-                FOR INT2'SIZE USE NEWHUE'SIZE;
- 
-                PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
-                PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
- 
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
- 
-           BEGIN
-                CHECK_1 (RED, 8, "HUE");
-                CHECK_2 (YELLOW, 18, "NEWHUE");
-           END GENPACK;
- 
-           PACKAGE P IS NEW GENPACK;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD3015K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3021a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3021a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd3021a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd3021a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CD3021A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE AGGREGATE IN AN ENUMERATION REPRESENTATION CLAUSE
- --     IS NOT AMBIGUOUS EVEN IF THERE ARE SEVERAL ONE-DIMENSIONAL ARRAY
- --     TYPES WITH THE ENUMERATION TYPE AS THE INDEX SUBTYPE.
- 
- -- HISTORY:
- --     BCB 09/30/87  CREATED ORIGINAL TEST.
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
- --                    CHECKS FOR FAILURE.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD3021A IS
- 
-      TYPE ENUM IS (A,B,C);
- 
-      TYPE ARR1 IS ARRAY(ENUM) OF INTEGER;
-      TYPE ARR2 IS ARRAY(ENUM) OF INTEGER;
-      TYPE ARR3 IS ARRAY(ENUM) OF INTEGER;
- 
-      FOR ENUM USE (A => 1,B => 2,C => 3);
- 
-      A1 : ARR1 := (A => 5,B => 6,C => 13);
-      A2 : ARR2 := (A => 1,B => 2,C => 3);
-      A3 : ARR3 := (A => 0,B => 1,C => 2);
- 
- BEGIN
- 
-      TEST ("CD3021A", "CHECK THAT THE AGGREGATE IN AN ENUMERATION " &
-                       "REPRESENTATION CLAUSE IS NOT AMBIGUOUS EVEN " &
-                       "IF THERE ARE SEVERAL ONE-DIMENSIONAL ARRAY " &
-                       "TYPES WITH THE ENUMERATION TYPE AS THE INDEX " &
-                       "SUBTYPE");
- 
-      IF (A1 /= (IDENT_INT (5), IDENT_INT (6), IDENT_INT (13))) OR
-           (A2 /= (IDENT_INT (1), IDENT_INT (2), IDENT_INT (3))) OR
-           (A3 /= (IDENT_INT (0), IDENT_INT (1), IDENT_INT (2))) THEN
-           FAILED ("INCORRECT VALUES FOR ARRAYS");
-      END IF;
- 
-      RESULT;
- END CD3021A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd33001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd33001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd33001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd33001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,139 ****
- -- CD33001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Component_Sizes that are a factor of the word
- --      size are supported.
- --
- --      Check that for such Component_Sizes arrays contain no gaps between
- --      components.
- --
- -- TEST DESCRIPTION:
- --      This test defines three array types and specifies their layouts
- --      using representation specifications for the 'Component_Size and
- --      pragma Packs for each.  It then checks that the implied assumptions
- --      about the resulting layout actually can be made.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      07 MAY 96   SAIC   Revised for 2.1
- --      24 AUG 96   SAIC   Additional 2.1 revisions
- --      17 FEB 97   PWB.CTA  Corrected prefix of 'Component_Size to name
- --                           array object instead of array subtype
- --      16 FEB 98   EDS    Modified documentation.
- --!
- 
- ----------------------------------------------------------------- CD33001_0
- 
- with System;
- package CD33001_0 is
- 
-   S_Units_per_Word : constant := System.Word_Size/System.Storage_Unit;
- 
-   type Nibble is mod 2**4;
- 
-   type Byte is mod 2**8;
- 
-   type Half_Stuff is array(Natural range <>) of Nibble;
-     for Half_Stuff'Component_Size
-       use System.Word_Size / 2;   -- factor                   -- ANX-C RQMT.
-   pragma Pack(Half_Stuff);                                    -- ANX-C RQMT.
- 
-   type Word_Stuff is array(Natural range <>) of Byte;
-     for Word_Stuff'Component_Size
-       use System.Word_Size;                                   -- ANX-C RQMT.
- 
-   type Address_Calculator is record
-     Item_1 : Nibble;
-     Item_2 : Nibble;
-   end record;
- 
-   for Address_Calculator use record
-     Item_1 at 0 range 0..3;
-     Item_2 at 1 range 0..3;
-   end record;
- 
-   -- given that Item_1 is specified to be at 'Position = 0 and
-   --            Item_2 is specified to be at 'Position = 1
-   -- by definition (13.5.2(2)) abs(Item_2'Address - Item_1'Address) = 1
- 
- end CD33001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- -- there is no package body CD33001_0
- 
- ------------------------------------------------------------------- CD33001
- 
- with Report;
- with System.Storage_Elements;
- with CD33001_0;
- procedure CD33001 is
- 
-   use type System.Storage_Elements.Storage_Offset;
- 
-   A_Half   : CD33001_0.Half_Stuff(0..15);
- 
-   A_Word   : CD33001_0.Word_Stuff(0..15);
-  
-   procedure Unexpected( Message : String; Wanted, Got: Integer ) is
-   begin
-     Report.Failed( Message & " Wanted:"
-                    & Integer'Image(Wanted) & " Got:" & Integer'Image(Got) );
-   end Unexpected;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD33001", "Check that Component_Sizes that are factor of " &
-                           "the word size are supported.  Check that for " &
-                           "such Component_Sizes arrays contain no gaps " &
-                           "between components" );
- 
-   if A_Half'Size /= A_Half'Component_Size * 16 then
-     Unexpected("Half word Size",
-                CD33001_0.Half_Stuff'Component_Size * 16,
-                A_Half'Size );
-   end if;
- 
-   if A_Word(1)'Size /= System.Word_Size then
-     Unexpected("Word Size", System.Word_Size, A_Word(1)'Size );
-   end if;
- 
- 
-   Report.Result;
- 
- end CD33001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd33002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd33002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd33002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd33002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- CD33002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Component_Sizes that are multiples of the word
- --      size are supported.
- --
- --      Check that for such Component_Sizes arrays contain no gaps between
- --      components.
- --
- -- TEST DESCRIPTION:
- --      This test defines three array types and specifies their layouts
- --      using representation specifications for the 'Component_Size and
- --      pragma Packs for each.  It then checks that the implied assumptions
- --      about the resulting layout actually can be made.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      07 MAY 96   SAIC   Revised for 2.1
- --      24 AUG 96   SAIC   Additional 2.1 revisions
- --      16 FEB 98   EDS    Modify documentation.
- --!
- 
- ----------------------------------------------------------------- CD33002_0
- 
- with System;
- package CD33002_0 is
- 
-   S_Units_per_Word : constant := System.Word_Size/System.Storage_Unit;
- 
-   type Nibble is mod 2**4;
- 
-   type Byte is mod 2**8;
- 
-   type Word_Stuff is array(Natural range <>) of Byte;
-     for Word_Stuff'Component_Size
-       use System.Word_Size;                                   -- ANX-C RQMT.
-       pragma Pack(Word_Stuff);                                -- ANX-C RQMT.
- 
-   type Double_Stuff is array(Natural range <>) of Byte;
-     for Double_Stuff'Component_Size
-       use System.Word_Size * 2;     -- multiple               -- ANX-C RQMT.
- 
-   type Address_Calculator is record
-     Item_1 : Nibble;
-     Item_2 : Nibble;
-   end record;
- 
-   for Address_Calculator use record
-     Item_1 at 0 range 0..3;
-     Item_2 at 1 range 0..3;
-   end record;
- 
-   -- by definition (13.5.2(2)) abs(Item_2'Address - Item_1'Address) = 1
-   -- it therefore follows that:
-   --     Address_Calculator'Size = 2 * Addressable_Unit'Size
- 
- end CD33002_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- -- there is no package body CD33002_0
- 
- ------------------------------------------------------------------- CD33002
- 
- with Report;
- with TCTouch;
- with System.Storage_Elements;
- with CD33002_0;
- procedure CD33002 is
- 
-   use type System.Storage_Elements.Storage_Offset;
- 
-   A_Word   : CD33002_0.Word_Stuff(0..15);
-  
-   A_Double : CD33002_0.Double_Stuff(0..15);
- 
-   procedure Unexpected( Message : String; Wanted, Got: Integer ) is
-   begin
-     Report.Failed ( Message & " Wanted:"
-                     & Integer'Image(Wanted) & " Got:" & Integer'Image(Got) );
-   end Unexpected;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD33002", "Check that Component_Sizes that are multiples "
-                         & "of the word size are supported. Check that for "
-                         & "such Component_Sizes arrays contain no gaps "
-                         & "between components" );
- 
-   if A_Word'Size /= CD33002_0.Word_Stuff'Component_Size * 16 then
-     Unexpected("Word Size",
-                 CD33002_0.Word_Stuff'Component_Size * 16,
-                 A_Word'Size );
-   end if;
- 
-   if A_Double'Size /= CD33002_0.Double_Stuff'Component_Size * 16 then
-     Unexpected("Double word Size",
-                 CD33002_0.Double_Stuff'Component_Size * 16,
-                 A_Double'Size );
-   end if;
- 
- 
-   Report.Result;
- 
- end CD33002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd40001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd40001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd40001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd40001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,181 ****
- -- CD40001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Enumeration_Representation_Clauses are supported for
- --      codes in the range System.Min_Int..System.Max_Int.
- --
- -- TEST DESCRIPTION:
- --      This test defines several types, and checks that the range of the 
- --      enumeration clause is as expected.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      07 MAY 96   SAIC   Revised for 2.1
- --      16 FEB 98   EDS    Modified Documentation.
- --!
- 
- with System;
- with Ada.Unchecked_Conversion;
- package CD40001_0 is
- 
-   type Press_The_Bounds is ( Negative_Large, Positive_Large );
- 
-   for Press_The_Bounds use
-       ( Negative_Large => System.Min_Int,                     -- ANX-C RQMT.
-         Positive_Large => System.Max_Int );                   -- ANX-C RQMT.
- 
-   type Add_The_Bounds is 
-     ( Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
- 
-   for Add_The_Bounds use
-       ( Monday    => System.Min_Int,                          -- ANX-C RQMT.
-         Tuesday   => System.Min_Int + 1,                      -- ANX-C RQMT.
-         Wednesday => System.Min_Int + 2,                      -- ANX-C RQMT.
-         Thursday  => System.Min_Int + 3,                      -- ANX-C RQMT.
-         Friday    => System.Min_Int + 4,                      -- ANX-C RQMT.
-         Saturday  => System.Min_Int + 5 );                    -- ANX-C RQMT.
- 
-   type Minus_The_Bounds is ( Jan, Feb, Mar, Apr);
- 
-   for Minus_The_Bounds use
-       ( Apr => System.Max_Int,                                -- ANX-C RQMT.
-         Mar => System.Max_Int - 1,                            -- ANX-C RQMT.
-         Feb => System.Max_Int - 2,                            -- ANX-C RQMT.
-         Jan => System.Max_Int - 3 );                          -- ANX-C RQMT.
- 
-   type TC_Integer is range System.Min_Int..System.Max_Int;
- 
-   procedure TC_Check_Press; 
- 
-   procedure TC_Check_Add; 
- 
-   procedure TC_Check_Minus; 
- 
-   function TC_Compare_Press is new Ada.Unchecked_Conversion 
-     (Press_The_Bounds, TC_Integer);
- 
-   function TC_Compare_Add is new Ada.Unchecked_Conversion 
-     (Add_The_Bounds, TC_Integer);
- 
-   function TC_Compare_Minus is new Ada.Unchecked_Conversion 
-     (Minus_The_Bounds, TC_Integer);
- 
- end CD40001_0;
- 
-      --==================================================================--
- 
- with Report;
- package body CD40001_0 is
- 
-   procedure TC_Check_Press is
-     My_Press_First : Press_The_Bounds := Negative_Large;
-     My_Press_Last  : Press_The_Bounds := Positive_Large;
-   begin
-     if TC_Compare_Press (My_Press_First) /= System.Min_Int or
-        TC_Compare_Press (My_Press_Last)  /= System.Max_Int 
-     then
-       Report.Failed 
-         ("Expected enumeration size of System.Min_Int and System.Max_Int " &
-          "not available for this implementation");
-     end if;
-   end TC_Check_Press;
- 
-   ---------------------------------------------------------------------------
-   procedure TC_Check_Add is
-     My_Monday    : Add_The_Bounds := Monday;
-     My_Tuesday   : Add_The_Bounds := Tuesday; 
-     My_Wednesday : Add_The_Bounds := Wednesday; 
-     My_Thursday  : Add_The_Bounds := Thursday;
-     My_Friday    : Add_The_Bounds := Friday;
-     My_Saturday  : Add_The_Bounds := Saturday; 
-   begin
-     if TC_Compare_Add (My_Monday)    /= (System.Min_Int)     or
-        TC_Compare_Add (My_Thursday)  /= (System.Min_Int + 3) or
-        TC_Compare_Add (My_Wednesday) /= (System.Min_Int + 2) or
-        TC_Compare_Add (My_Tuesday)   /= (System.Min_Int + 1) or
-        TC_Compare_Add (My_Saturday)  /= (System.Min_Int + 5) or
-        TC_Compare_Add (My_Friday)    /= (System.Min_Int + 4)   
-     then
-       Report.Failed
-         ("Expected enumeration size of System.Min_Int, System.Min_Int + 1 " &
-          "through System.Min_Int + 5 not available for this implementation");
-     end if;
-   end TC_Check_Add;
- 
-   ---------------------------------------------------------------------------
-   procedure TC_Check_Minus is
-     My_Jan : Minus_The_Bounds := Jan;
-     My_Feb : Minus_The_Bounds := Feb; 
-     My_Mar : Minus_The_Bounds := Mar; 
-     My_Apr : Minus_The_Bounds := Apr;
-   begin
-     if TC_Compare_Minus (My_Jan) /= (System.Max_Int - 3) or
-        TC_Compare_Minus (My_Feb) /= (System.Max_Int - 2) or
-        TC_Compare_Minus (My_Mar) /= (System.Max_Int - 1) or
-        TC_Compare_Minus (My_Apr) /= (System.Max_Int)
-     then
-       Report.Failed
-         ("Expected enumeration size of System.Max_Int, System.Max_Int - 1 " &
-          "through System.Max_Int - 3 not available for this implementation");
-     end if;
-   end TC_Check_Minus;
- 
- end CD40001_0;
- 
-      --==================================================================--
- 
- with Report;
- with CD40001_0;
- 
- procedure CD40001 is
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD40001", "Check that Enumeration_Representation_Clauses " &
-                           "are supported for codes in the range " &
-                           "System.Min_Int..System.Max_Int" );
-    
-   CD40001_0.TC_Check_Press;
- 
-   CD40001_0.TC_Check_Add;
- 
-   CD40001_0.TC_Check_Minus;
- 
-   Report.Result;
- 
- end CD40001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4031a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4031a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4031a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4031a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,95 ****
- -- CD4031A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN A RECORD REPRESENTATION CLAUSE IS GIVEN FOR A
- --     VARIANT RECORD TYPE, THEN COMPONENTS BELONGING TO DIFFERENT
- --     VARIANTS CAN BE GIVEN OVERLAPPING STORAGE.
- 
- -- HISTORY:
- --     PWB 07/22/87  CREATED ORIGINAL TEST.
- --     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND
- --                   ADDED CHECK FOR REPRESENTATION CLAUSE.
- --     RJW 06/12/90  REMOVED REFERENCES TO LENGTH_CHECK.  REVISED
- --                   COMMENTS.
- --     JRL 10/13/96  Adjusted ranges in type definitions to allow 1's
- --                   complement machines to represent all values in
- --                   the specified number of bits.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD4031A IS
- 
-      TYPE DISCRIMINAN IS RANGE -1 .. 1;
-      TYPE INT IS RANGE -3 .. 3;
-      TYPE LARGE_INT IS RANGE -7 .. 7;
- 
-      TYPE TEST_CLAUSE (DISC : DISCRIMINAN := 0) IS
-           RECORD
-                CASE DISC IS
-                     WHEN 0 =>
-                          INTEGER_COMP : LARGE_INT;
-                     WHEN OTHERS  =>
-                          CH_COMP_1 : INT;
-                          CH_COMP_2 : INT;
-                END CASE;
-           END RECORD;
- 
-      FOR TEST_CLAUSE USE
-           RECORD
-                DISC AT 0
-                            RANGE 0 .. 1;
-                INTEGER_COMP AT 0
-                            RANGE 2 .. 5;
-                CH_COMP_1 AT 0
-                            RANGE 2 .. 4;
-                CH_COMP_2 AT 0
-                            RANGE 5 .. 7;
-           END RECORD;
- 
-      TYPE TEST_CL1 IS NEW TEST_CLAUSE(DISC => 0);
-      TYPE TEST_CL2 IS NEW TEST_CLAUSE(DISC => 1);
-      TEST_RECORD : TEST_CL1;
-      TEST_RECORD1 : TEST_CL2;
- 
-      INTEGER_COMP_FIRST,
-      CH_COMP_1_FIRST : INTEGER;
- 
- BEGIN
-      TEST ("CD4031A", "IN RECORD REPRESENTATION CLAUSES " &
-                       "FOR VARIANT RECORD TYPES, " &
-                       "COMPONENTS OF DIFFERENT VARIANTS " &
-                       "CAN BE GIVEN OVERLAPPING STORAGE");
- 
-      TEST_RECORD := (0, -7);
-      INTEGER_COMP_FIRST := TEST_RECORD.INTEGER_COMP'FIRST_BIT;
- 
-      TEST_RECORD1 := (1, -3, -3);
-      CH_COMP_1_FIRST := TEST_RECORD1.CH_COMP_1'FIRST_BIT;
- 
-      IF INTEGER_COMP_FIRST /= CH_COMP_1_FIRST THEN
-           FAILED ("COMPONENTS DO NOT BEGIN AT SAME POINT");
-      END IF;
- 
-      RESULT;
- END CD4031A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4041a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4041a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4041a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4041a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- CD4041A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ALIGNMENT CLAUSE CAN BE GIVEN FOR A RECORD
- --     REPRESENTATION CLAUSE.
- 
- -- HISTORY:
- --     RJW 08/25/87  CREATED ORIGINAL TEST.
- --     DHH 03/30/89  CHANGED MOD 4 TO A MACRO VALUE AND CHANGED
- --                   EXTENSION FROM '.DEP' TO '.TST'.
- 
- -- MACRO SUBSTITUTION:
- --     $ALIGNMENT IS THE VALUE USED TO ALIGN A RECORD ON A BOUNDARY
- --     DEFINED BY THE IMPLEMENTATION.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE CD4041A IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-                       (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                       SYSTEM.STORAGE_UNIT;
- 
-      TYPE CHECK_CLAUSE IS RECORD
-           INT_COMP    : INTEGER;
-           CHAR_COMP   : CHARACTER;
-      END RECORD;
- 
-      FOR CHECK_CLAUSE USE
-           RECORD AT MOD $ALIGNMENT;
-                INT_COMP AT 0
-                            RANGE 0..INTEGER'SIZE - 1;
-                CHAR_COMP AT 1*UNITS_PER_INTEGER
-                            RANGE 0..CHARACTER'SIZE - 1;
-           END RECORD;
- 
-      CHECK_RECORD : CHECK_CLAUSE := (1, 'A');
- 
- BEGIN
-      TEST ("CD4041A", "CHECK THAT AN ALIGNMENT CLAUSE CAN BE " &
-                       "GIVEN FOR A RECORD REPRESENTATION CLAUSE");
- 
-      IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'LAST_BIT /= INTEGER'SIZE - 1 THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'POSITION /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
-                IDENT_INT (CHARACTER'SIZE - 1) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'POSITION /=
-                IDENT_INT (UNITS_PER_INTEGER) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
-      END IF;
- 
-      RESULT;
- END CD4041A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- CD4051A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
- --     DERIVED TYPES WHOSE PARENT TYPES ARE RECORD TYPES WITHOUT
- --     DISCRIMINANTS.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     RJW 08/25/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE CD4051A IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-                       (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                       SYSTEM.STORAGE_UNIT;
- 
-      TYPE BASIC_CLAUSE IS RECORD
-           INT_COMP    : INTEGER;
-           CHAR_COMP   : CHARACTER;
-      END RECORD;
- 
-      TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE;
- 
-      FOR CHECK_CLAUSE USE
-           RECORD
-                INT_COMP AT 0
-                            RANGE 0..INTEGER'SIZE - 1;
-                CHAR_COMP AT 1*UNITS_PER_INTEGER
-                            RANGE 0..CHARACTER'SIZE - 1;
-           END RECORD;
- 
-      CHECK_RECORD : CHECK_CLAUSE := (1, 'A');
- 
- BEGIN
-      TEST ("CD4051A", "CHECK THAT A RECORD REPRESENTATION " &
-                       "CLAUSE CAN BE GIVEN FOR A DERIVED TYPE " &
-                       "WHOSE PARENT TYPE IS IS A RECORD TYPE " &
-                       "WITHOUT DISCRIMINANTS");
- 
-      IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'LAST_BIT /= INTEGER'SIZE - 1 THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'POSITION /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
-                IDENT_INT (CHARACTER'SIZE - 1) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'POSITION /=
-                IDENT_INT (UNITS_PER_INTEGER) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
-      END IF;
- 
-      RESULT;
- END CD4051A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- CD4051B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE WHICH CHANGES THE
- --     ORDER OF THE COMPONENT STORAGE CAN BE GIVEN FOR A DERIVED TYPE
- --     WHOSE PARENT TYPE IS A RECORD WITHOUT A DISCRIMINANT.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     RJW 08/25/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE CD4051B IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-                       (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                       SYSTEM.STORAGE_UNIT;
- 
-      TYPE BASIC_CLAUSE IS RECORD
-           INT_COMP    : INTEGER;
-           CHAR_COMP   : CHARACTER;
-      END RECORD;
- 
-      TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE;
- 
-      FOR CHECK_CLAUSE USE
-           RECORD
-                INT_COMP AT 1*UNITS_PER_INTEGER
-                            RANGE 0..INTEGER'SIZE - 1;
-                CHAR_COMP AT 0
-                            RANGE 0..CHARACTER'SIZE - 1;
-           END RECORD;
- 
-      CHECK_RECORD : CHECK_CLAUSE := (1, 'A');
- 
- BEGIN
-      TEST ("CD4051B", "CHECK THAT A RECORD REPRESENTATION " &
-                       "CLAUSE WHICH CHANGES THE ORDER OF COMPONENT " &
-                       "STORAGE CAN BE GIVEN FOR A DERIVED TYPE " &
-                       "WHOSE PARENT TYPE IS IS A RECORD TYPE " &
-                       "WITHOUT DISCRIMINANTS");
- 
-      IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'LAST_BIT /= INTEGER'SIZE - 1 THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'POSITION /=
-                IDENT_INT (UNITS_PER_INTEGER) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
-                IDENT_INT (CHARACTER'SIZE - 1) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'POSITION /=
-                IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
-      END IF;
- 
-      RESULT;
- END CD4051B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- CD4051C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
- --     A DERIVED TYPE WHOSE PARENT TYPE IS A RECORD WITH A
- --     DISCRIMINANT.
- 
- -- HISTORY:
- --     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
- --     RJW 08/25/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE CD4051C IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-                       (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
-                       SYSTEM.STORAGE_UNIT;
- 
-      TYPE BASIC_CLAUSE (DISC : BOOLEAN) IS RECORD
-           INT_COMP    : INTEGER;
-           CHAR_COMP   : CHARACTER;
-      END RECORD;
- 
-      TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE;
- 
-      FOR CHECK_CLAUSE USE
-           RECORD
-                DISC AT 0
-                            RANGE 0..BOOLEAN'SIZE - 1;
-                INT_COMP AT 1*UNITS_PER_INTEGER
-                            RANGE 0..INTEGER'SIZE - 1;
-                CHAR_COMP AT 2*UNITS_PER_INTEGER
-                            RANGE 0..CHARACTER'SIZE - 1;
-           END RECORD;
- 
-      CHECK_RECORD : CHECK_CLAUSE (TRUE) := (TRUE, 1, 'A');
- 
- BEGIN
-      TEST ("CD4051C", "CHECK THAT A RECORD REPRESENTATION " &
-                       "CLAUSE CAN BE GIVEN FOR A DERIVED TYPE " &
-                       "WHOSE PARENT TYPE IS IS A RECORD TYPE " &
-                       "WITH DISCRIMINANTS");
- 
-      IF CHECK_RECORD.DISC'FIRST_BIT /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF DISC");
-      END IF;
- 
-      IF CHECK_RECORD.DISC'LAST_BIT /= BOOLEAN'SIZE - 1 THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF DISC");
-      END IF;
- 
-      IF CHECK_RECORD.DISC'POSITION /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF DISC");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'LAST_BIT /=
-                IDENT_INT (INTEGER'SIZE - 1) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.INT_COMP'POSITION /=
-                IDENT_INT (UNITS_PER_INTEGER) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
-                IDENT_INT (CHARACTER'SIZE - 1) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CHAR_COMP'POSITION /=
-                IDENT_INT (2 * UNITS_PER_INTEGER) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
-      END IF;
- 
-      RESULT;
- END CD4051C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd4051d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd4051d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- CD4051D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
- --     A DERIVED SUBTYPE WHOSE PARENT TYPE IS A RECORD TYPE WITH
- --     VARIANTS AND THE REPRESENTATION CLAUSE MENTIONS COMPONENTS THAT
- --     DO NOT EXIST IN THE DERIVED SUBTYPE.
- 
- -- HISTORY:
- --     RJW 08/25/87  CREATED ORIGINAL TEST.
- --     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND
- --                   ADDED CHECK FOR REPRESENTATION CLAUSE.
- --     RJW 10/26/89  REMOVED REFERENCES TO LENGTH_CHECK.
- --     THS 09/18/90  MADE CALLS TO IDENT_INT TO DEFEAT OPTIMIZATION.
- --     JRL 10/13/96  Adjusted ranges in type definitions to allow 1's
- --                   complement machines to represent all values in
- --                   the specified number of bits.
- 
- WITH REPORT; USE REPORT;
- WITH SYSTEM;
- PROCEDURE CD4051D IS
- 
-      TYPE INT IS RANGE -3 .. 3;
-      TYPE LARGE_INT IS RANGE -7 .. 7;
- 
-      TYPE BASIC_CLAUSE (DISC : BOOLEAN) IS RECORD
-           BOOL_COMP   : BOOLEAN;
-           CASE DISC IS
-                WHEN FALSE =>
-                     INT_COMP  : LARGE_INT;
-                WHEN TRUE  =>
-                     CH_COMP_1 : INT;
-                     CH_COMP_2 : INT;
-           END CASE;
-      END RECORD;
- 
-      TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE (TRUE);
- 
-      FOR CHECK_CLAUSE USE
-           RECORD
-                DISC AT 0
-                            RANGE 0 .. 0;
-                BOOL_COMP AT 0
-                            RANGE 1 .. 1;
-                INT_COMP AT 0
-                            RANGE 2 .. 5;
-                CH_COMP_1 AT 0
-                            RANGE 2 .. 4;
-                CH_COMP_2 AT 0
-                            RANGE 5 .. 7;
-           END RECORD;
- 
-      CHECK_RECORD : CHECK_CLAUSE := (TRUE, TRUE, -2, -2);
- 
- BEGIN
-      TEST ("CD4051D", "CHECK THAT A RECORD REPRESENTATION " &
-                       "CLAUSE CAN BE GIVEN FOR A DERIVED TYPE " &
-                       "WHOSE PARENT TYPE IS A RECORD TYPE " &
-                       "WITH VARIANTS AND WHERE THE RECORD " &
-                       "REPRESENTATION CLAUSE MENTIONS COMPONENTS " &
-                       "THAT DO NOT EXIST IN THE DERIVED SUBTYPE");
- 
-      IF CHECK_RECORD.DISC'FIRST_BIT /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF DISC");
-      END IF;
- 
-      IF CHECK_RECORD.DISC'LAST_BIT /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF DISC");
-      END IF;
- 
-      IF CHECK_RECORD.DISC'POSITION /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF DISC");
-      END IF;
- 
-      IF CHECK_RECORD.BOOL_COMP'FIRST_BIT /= IDENT_INT (1) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF BOOL_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.BOOL_COMP'LAST_BIT /= IDENT_INT (1) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF BOOL_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.BOOL_COMP'POSITION /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF BOOL_COMP");
-      END IF;
- 
-      IF CHECK_RECORD.CH_COMP_1'FIRST_BIT /= IDENT_INT (2) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CH_COMP_1");
-      END IF;
- 
-      IF CHECK_RECORD.CH_COMP_1'LAST_BIT /= IDENT_INT (4) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF CH_COMP_1");
-      END IF;
- 
-      IF CHECK_RECORD.CH_COMP_1'POSITION /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF CH_COMP_1");
-      END IF;
- 
-      IF CHECK_RECORD.CH_COMP_2'FIRST_BIT /= IDENT_INT (5) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CH_COMP_2");
-      END IF;
- 
-      IF CHECK_RECORD.CH_COMP_2'LAST_BIT /= IDENT_INT (7) THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF CH_COMP_2");
-      END IF;
- 
-      IF CHECK_RECORD.CH_COMP_2'POSITION /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF CH_COMP_2");
-      END IF;
- 
-      RESULT;
- END CD4051D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- CD5003A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN FOR
- --     A PACKAGE BODY CONTAINING AN ADDRESS CLAUSE AS LONG AS A 'WITH'
- --     CLAUSE IS GIVEN FOR THE SPECIFICATION.
- 
- -- HISTORY:
- --     RJW 10/13/88  CREATED ORIGINAL TEST.
- --     BCB 04/18/89  CHANGED EXTENSION TO '.ADA'.  REMOVED APPLICABILITY
- --                   CRITERIA AND N/A ERROR MESSAGES.
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- WITH SYSTEM;
- PACKAGE CD5003A_PKG2 IS 
-      PROCEDURE REQUIRE_BODY;
- END CD5003A_PKG2;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY CD5003A_PKG2 IS
-      TEST_VAR : INTEGER;
-      FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-      USE SYSTEM;
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- BEGIN
-      TEST ("CD5003A", "CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' " &
-                       "NEED NOT BE GIVEN FOR A PACKAGE BODY " &
-                       "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
-                       "'WITH' CLAUSE IS GIVEN FOR THE SPECIFICATION");
- 
-      TEST_VAR := IDENT_INT (3);
- 
-      IF TEST_VAR /= 3 THEN
-           FAILED ("INCORRECT VALUE FOR TEST_VAR");
-      END IF;
- 
-      IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-      END IF;
- 
- END CD5003A_PKG2;
- 
- WITH REPORT; USE REPORT;
- WITH CD5003A_PKG2; USE CD5003A_PKG2;
- WITH SPPRT13;
- PROCEDURE CD5003A IS
- BEGIN
- 
-     RESULT;
- END CD5003A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CD5003B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN FOR
- --     A PROCEDURE BODY CONTAINING AN ADDRESS CLAUSE AS LONG AS A 'WITH'
- --     CLAUSE IS GIVEN FOR THE PROCEDURE SPECIFICATION.
- 
- -- HISTORY:
- --     VCL 09/04/87  CREATED ORIGINAL TEST.
- --     RJW 10/13/88  INITIALIZED THE VARIABLE "CHECK_VAR".
- --     BCB 04/18/89  CHANGED EXTENSION TO '.ADA'.  REMOVED APPLICABILITY
- --                   CRITERIA AND N/A ERROR MESSAGES.
- 
- WITH SYSTEM;
- PROCEDURE CD5003B;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- PROCEDURE CD5003B IS
-      TYPE ENUM IS (A0, A1, A2, A3, A4, A5);
- 
-      TEST_VAR : ENUM := A0;
-      FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-      USE SYSTEM;
- 
-      FUNCTION IDENT_ENUM (P : ENUM) RETURN ENUM IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN P;
-           ELSE
-                RETURN A0;
-           END IF;
-      END IDENT_ENUM;
- 
- BEGIN
-      TEST ("CD5003B", "CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' " &
-                       "NEED NOT BE GIVEN FOR A PROCEDURE BODY " &
-                       "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
-                       "'WITH' CLAUSE IS GIVEN FOR THE PROCEDURE " &
-                       "SPECIFICATION");
- 
-      TEST_VAR := IDENT_ENUM (A3);
- 
-      IF TEST_VAR /= A3 THEN
-           FAILED ("INCORRECT VALUE FOR TEST_VAR");
-      END IF;
- 
-      IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-      END IF;
- 
-     RESULT;
- END CD5003B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- CD5003C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
- --     FOR A PACKAGE BODY SUBUNIT CONTAINING AN ADDRESS CLAUSE AS
- --     LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING THE
- --     PACKAGE SPECIFICATION.
- 
- -- HISTORY:
- --     VCL  09/04/87  CREATED ORIGINAL TEST.
- --     PWB  05/12/89  CHANGED TO ".ADA" TEST.
- 
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE CD5003C IS
-      PACKAGE CD5003C_PACK2 IS END CD5003C_PACK2;
- 
-      PACKAGE BODY CD5003C_PACK2 IS SEPARATE;
- 
-      USE CD5003C_PACK2;
- BEGIN
-     RESULT;
- END CD5003C;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- SEPARATE (CD5003C)
- PACKAGE BODY CD5003C_PACK2 IS
-      TYPE ATYPE IS ARRAY (1 .. 10) OF INTEGER;
- 
-      TEST_VAR : ATYPE := (OTHERS => 0);
-      FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-      USE SYSTEM;
- 
-      FUNCTION IDENT (P : ATYPE) RETURN ATYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN P;
-           ELSE
-                RETURN (OTHERS => 0);
-           END IF;
-      END IDENT;
- BEGIN
-      TEST ("CD5003C", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
-                       "BE GIVEN FOR A PACKAGE BODY SUBUNIT " &
-                       "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
-                       "'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
-                       "CONTAINING THE PACKAGE SPECIFICATION");
- 
- 
-      TEST_VAR := IDENT (ATYPE'(OTHERS => 3));
- 
-      IF TEST_VAR /= ATYPE'(OTHERS => 3) THEN
-           FAILED ("INCORRECT VALUE FOR TEST_VAR");
-      END IF;
- 
-      IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-      END IF;
- END CD5003C_PACK2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- CD5003D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
- --     FOR A PROCEDURE BODY SUBUNIT CONTAINING AN ADDRESS CLAUSE AS
- --     LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING
- --     THE PROCEDURE SPECIFICATION.
- 
- -- HISTORY:
- --     VCL  09/08/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- PACKAGE CD5003D_PACK2 IS
-      PROCEDURE CD5003D_PROC2;
- END CD5003D_PACK2;
- 
- WITH SYSTEM;
- PACKAGE BODY CD5003D_PACK2 IS
-      PROCEDURE CD5003D_PROC2 IS SEPARATE;
- END CD5003D_PACK2;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- SEPARATE (CD5003D_PACK2)
- PROCEDURE CD5003D_PROC2 IS
-      TYPE FIXD IS DELTA 0.1 RANGE -10.0 .. 10.0;
- 
-      TEST_VAR : FIXD := 0.0;
-      FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-      USE SYSTEM;
- 
-      FUNCTION IDENT_FIXD (P : FIXD) RETURN FIXD IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN P;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT_FIXD;
- BEGIN
-      TEST ("CD5003D", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE " &
-                       "GIVEN FOR A PROCEDURE BODY SUBUNIT " &
-                       "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
-                       "'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
-                       "CONTAINING THE PROCEDURE SPECIFICATION");
- 
-      TEST_VAR := IDENT_FIXD (3.3);
- 
-      IF TEST_VAR /= 3.3 THEN
-           FAILED ("INCORRECT VALUE FOR TEST_VAR");
-      END IF;
- 
-      IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-      END IF;
- 
-     RESULT;
- END CD5003D_PROC2;
- 
- WITH CD5003D_PACK2; USE CD5003D_PACK2;
- PROCEDURE CD5003D IS
- BEGIN
-      CD5003D_PROC2;
- END CD5003D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CD5003E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
- --     FOR A TASK BODY SUBUNIT CONTAINING AN ADDRESS CLAUSE AS LONG
- --     AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING THE TASK
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     VCL  09/08/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- 
- WITH SYSTEM;
- PROCEDURE CD5003E IS
-      TASK TASK2 IS
-           ENTRY TST;
-      END TASK2;
-      TASK BODY TASK2 IS SEPARATE;
- BEGIN
-      TASK2.TST;
- END CD5003E;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- SEPARATE (CD5003E)
- TASK BODY TASK2 IS
-      TEST_VAR : INTEGER := 0;
-      FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-      USE SYSTEM;
- 
- BEGIN
-      ACCEPT TST DO
-           TEST ("CD5003E", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
-                            "BE GIVEN FOR A TASK BODY SUBUNIT " &
-                            "CONTAINING AN ADDRESS CLAUSE AS LONG " &
-                            "AS A 'WITH' CLAUSE IS GIVEN FOR THE " &
-                            "UNIT CONTAINING THE TASK SPECIFICATION");
- 
-           TEST_VAR := IDENT_INT (3);
- 
-           IF TEST_VAR /= 3 THEN
-                FAILED ("INCORRECT VALUE FOR TEST_VAR");
-           END IF;
- 
-           IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-           END IF;
- 
-          RESULT;
-      END TST;
- END TASK2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- CD5003F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
- --     FOR A GENERIC PACKAGE BODY CONTAINING AN ADDRESS CLAUSE
- --     AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE GENERIC PACKAGE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     VCL  09/09/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- WITH SYSTEM;
- GENERIC
- PACKAGE CD5003F_PACK2 IS 
-      PROCEDURE REQUIRE_BODY;
- END CD5003F_PACK2;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY CD5003F_PACK2 IS
-      TYPE ATYPE IS ARRAY (1 .. 10) OF INTEGER;
- 
-      TEST_VAR : ATYPE := (OTHERS => 0);
-      FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-      USE SYSTEM;
- 
-      FUNCTION IDENT (P : ATYPE) RETURN ATYPE IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN P;
-           ELSE
-                RETURN (OTHERS => 0);
-           END IF;
-      END IDENT;
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- BEGIN
-      TEST ("CD5003F", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
-                       "BE GIVEN FOR A GENERIC PACKAGE BODY " &
-                       "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
-                       "'WITH' CLAUSE IS GIVEN FOR THE GENERIC " &
-                       "PACKAGE SPECIFICATION");
- 
-      TEST_VAR := IDENT (ATYPE'(OTHERS => 3));
- 
-      IF TEST_VAR /= ATYPE'(OTHERS => 3) THEN
-           FAILED ("INCORRECT VALUE FOR TEST_VAR");
-      END IF;
- 
-      IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-      END IF;
- END CD5003F_PACK2;
- 
- WITH CD5003F_PACK2;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE CD5003F IS
-      PACKAGE CD5003F_PACK3 IS NEW CD5003F_PACK2;
- BEGIN
-     RESULT;
- END CD5003F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- CD5003G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
- --     FOR A GENERIC PROCEDURE BODY CONTAINING AN ADDRESS CLAUSE
- --     AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING
- --     THE GENERIC PROCEDURE SPECIFICATION.
- 
- -- HISTORY:
- --     VCL  09/09/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM;
- PACKAGE CD5003G_PACK2 IS
-      GENERIC
-      PROCEDURE CD5003G_PROC2;
- END CD5003G_PACK2;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- PACKAGE BODY CD5003G_PACK2 IS
-      PROCEDURE CD5003G_PROC2 IS
-           TYPE FIXD IS DELTA 0.1 RANGE -10.0 .. 10.0;
- 
-           TEST_VAR : FIXD := 0.0;
-           FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-           USE SYSTEM;
- 
-           FUNCTION IDENT_FIXD (P : FIXD) RETURN FIXD IS
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     RETURN P;
-                ELSE
-                     RETURN 0.0;
-                END IF;
-           END IDENT_FIXD;
-      BEGIN
-           TEST ("CD5003G", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
-                            "BE GIVEN FOR A GENERIC PROCEDURE BODY " &
-                            "CONTAINING AN ADDRESS CLAUSE AS LONG AS " &
-                            "A 'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
-                            "CONTAINING THE GENERIC PROCEDURE " &
-                            "SPECIFICATION");
- 
-           TEST_VAR := IDENT_FIXD (3.3);
- 
-           IF TEST_VAR /= 3.3 THEN
-                FAILED ("INCORRECT VALUE FOR TEST_VAR");
-           END IF;
- 
-           IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-           END IF;
- 
-          RESULT;
-      END CD5003G_PROC2;
- END CD5003G_PACK2;
- 
- 
- WITH CD5003G_PACK2; USE CD5003G_PACK2;
- PROCEDURE CD5003G IS
-      PROCEDURE PROC3 IS NEW CD5003G_PROC2;
- BEGIN
-      PROC3;
- END CD5003G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- CD5003H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
- --     FOR A GENERIC PACKAGE BODY SUBUNIT CONTAINING AN ADDRESS
- --     CLAUSE AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT
- --     CONTAINING THE GENERIC PACKAGE SPECIFICATION.
- 
- -- HISTORY:
- --     VCL  09/09/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- WITH SYSTEM;
- PACKAGE CD5003H_PACK3 IS
- 
-      PROCEDURE REQUIRE_BODY;
- 
-      GENERIC
-      PACKAGE PACK4 IS END PACK4;
- END CD5003H_PACK3;
- 
- PACKAGE BODY CD5003H_PACK3 IS
- 
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-        NULL;
-      END;
- 
-      PACKAGE BODY PACK4 IS SEPARATE;
- END CD5003H_PACK3;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- SEPARATE (CD5003H_PACK3)
- PACKAGE BODY PACK4 IS
-      TEST_VAR : INTEGER := 0;
-      FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
-      USE SYSTEM;
- BEGIN
-      TEST ("CD5003H", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE " &
-                       "GIVEN FOR A GENERIC PACKAGE BODY SUBUNIT " &
-                       "CONTAINING AN ADDRESS CLAUSE AS LONG AS " &
-                       "A 'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
-                       "CONTAINING THE GENERIC PACKAGE SPECIFICATION.");
- 
-      TEST_VAR := IDENT_INT (3);
- 
-      IF TEST_VAR /= 3 THEN
-           FAILED ("INCORRECT VALUE FOR TEST_VAR");
-      END IF;
- 
-      IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-      END IF;
- END PACK4;
- 
- WITH CD5003H_PACK3; USE CD5003H_PACK3;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE CD5003H IS
-      PACKAGE PACK5 IS NEW PACK4;
- BEGIN
-     RESULT;
- END CD5003H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5003i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5003i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- CD5003I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
- --     FOR A GENERIC PROCEDURE BODY SUBUNIT CONTAINING AN ADDRESS
- --     CLAUSE AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT
- --     CONTAINING THE GENERIC PROCEDURE SPECIFICATION.
- 
- -- HISTORY:
- --     VCL  09/09/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- PACKAGE CD5003I_PACK3 IS
-      GENERIC
-      PROCEDURE PROC2;
- END CD5003I_PACK3;
- 
- WITH SYSTEM;
- PACKAGE BODY CD5003I_PACK3 IS
-      PROCEDURE PROC2 IS SEPARATE;
- END CD5003I_PACK3;
- 
- WITH SPPRT13;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (SPPRT13);
- PRAGMA ELABORATE (REPORT);
- SEPARATE (CD5003I_PACK3)
- PROCEDURE PROC2 IS
-      TYPE FIXD IS DELTA 0.1 RANGE -10.0 .. 10.0;
- 
-      TEST_VAR : FIXD;
-      FOR TEST_VAR
-                USE AT SPPRT13.VARIABLE_ADDRESS;
- 
-      USE SYSTEM;
- 
-      FUNCTION IDENT (P : FIXD) RETURN FIXD IS
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                RETURN P;
-           ELSE
-                RETURN 0.0;
-           END IF;
-      END IDENT;
- BEGIN
-      TEST ("CD5003I", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE " &
-                       "GIVEN FOR A GENERIC PROCEDURE BODY SUBUNIT " &
-                       "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
-                       "'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
-                       "CONTAINING THE GENERIC PROCEDURE SPECIFICATION");
- 
-      TEST_VAR := IDENT (3.3);
- 
-      IF TEST_VAR /= 3.3 THEN
-           FAILED ("INCORRECT VALUE FOR TEST_VAR");
-      END IF;
- 
-      IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
-      END IF;
- 
-      RESULT;
- END PROC2;
- 
- WITH CD5003I_PACK3; USE CD5003I_PACK3;
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PROCEDURE CD5003I IS
-      PROCEDURE PROC3 IS NEW PROC2;
- BEGIN
-      PROC3;
- END CD5003I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- CD5011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
- --     ENUMERATION TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
- 
- -- HISTORY:
- --     PWB 08/06/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- PROCEDURE CD5011A IS
- 
-      TYPE ENUM IS (RED, BLUE, 'R', 'B');
- 
-      PROCEDURE MIX IS
-           HUE : ENUM := RED;
-           FOR HUE USE
-                AT SPPRT13.VARIABLE_ADDRESS;
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                HUE := BLUE;
-           END IF;
-           IF HUE /= BLUE THEN
-                FAILED ("WRONG VALUE FOR VARIABLE IN PROCEDURE");
-           END IF;
-           IF HUE'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("WRONG ADDRESS FOR VARIABLE IN PROCEDURE");
-           END IF;
-      END MIX;
- 
-      FUNCTION FIX RETURN BOOLEAN IS
-           LETTER : ENUM := 'R';
-           FOR LETTER USE AT
-                     SPPRT13.VARIABLE_ADDRESS;
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                LETTER := 'B';
-           END IF;
-           IF LETTER /= ENUM'LAST THEN
-                FAILED ("WRONG VALUE FOR VARIABLE IN FUNCTION");
-           END IF;
-           IF LETTER'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("WRONG ADDRESS FOR VARIABLE IN FUNCTION");
-           END IF;
-           RETURN EQUAL(3,3);
-      END FIX;
- 
- BEGIN
- 
-      TEST ("CD5011A", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF AN ENUMERATION " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "SUBPROGRAM.");
- 
-      IF NOT FIX THEN
-           FAILED ("FUNCTION FIX YIELDS WRONG VALUE");
-      END IF;
- 
-      MIX;
-      RESULT;
- 
- END CD5011A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- CD5011C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF
- --     AN INTEGER TYPE IN THE DECLARATIVE PART OF A PACKAGE BODY.
- 
- -- HISTORY:
- --     JET 09/11/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011C IS
- 
-      PACKAGE CD5011C_PACKAGE IS
-      END CD5011C_PACKAGE;
- 
-      PACKAGE BODY CD5011C_PACKAGE IS
- 
-           INT : INTEGER := 0;
-           FOR INT USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           TEST ("CD5011C", "AN ADDRESS CLAUSE CAN BE " &
-                            "GIVEN FOR A VARIABLE OF AN INTEGER " &
-                            "TYPE IN THE DECLARATIVE PART OF A " &
-                            "PACKAGE BODY");
- 
-           IF EQUAL (3, 3) THEN
-                INT := 5;
-           END IF;
-           IF INT /= IDENT_INT (5) THEN
-                FAILED ("WRONG VALUE FOR VARIABLE IN PACKAGE");
-           END IF;
-           IF INT'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("WRONG ADDRESS FOR VARIABLE IN PACKAGE");
-           END IF;
-      END;
- 
- BEGIN
- 
-      RESULT;
- 
- END CD5011C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- CD5011E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
- --     FLOATING POINT TYPE IN THE DECLARATIVE PART OF A BLOCK
- --     STATEMENT.
- 
- -- HISTORY:
- --     JET 09/11/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011E IS
- 
- BEGIN
- 
-      TEST ("CD5011E", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF A FLOATING POINT " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "BLOCK STATEMENT");
- 
-      DECLARE
- 
-           FP : FLOAT := 3.0;
-           FOR FP USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                FP := 2.0;
-           END IF;
- 
-           IF FP /= 2.0 THEN
-                FAILED ("WRONG VALUE FOR VARIABLE IN BLOCK");
-           END IF;
- 
-           IF FP'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("WRONG ADDRESS FOR VARIABLE IN BLOCK");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END CD5011E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- CD5011G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
- --     FIXED POINT TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
- 
- -- HISTORY:
- --     JET 09/11/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011G IS
- 
-      TYPE FIX_TYPE IS DELTA 0.125 RANGE 0.0 .. 10.0;
- 
-      PROCEDURE CD5011G_PROC IS
- 
-           FP : FIX_TYPE := 2.0;
-           FOR FP USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                FP := 3.0;
-           END IF;
- 
-           IF FP /= 3.0 THEN
-                FAILED ("INCORRECT VALUE FOR VARIABLE IN PROCEDURE");
-           END IF;
- 
-           IF FP'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR VARIABLE IN PROCEDURE");
-           END IF;
- 
-      END CD5011G_PROC;
- 
- BEGIN
-      TEST ("CD5011G", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF A FIXED POINT " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "SUBPROGRAM");
- 
-      CD5011G_PROC;
- 
-      RESULT;
- 
- END CD5011G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- CD5011I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF
- --     AN ARRAY TYPE IN THE DECLARATIVE PART OF A PACKAGE BODY.
- 
- -- HISTORY:
- --     JET 09/11/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011I IS
- 
-      PACKAGE CD5011I_PACKAGE IS
-      END CD5011I_PACKAGE;
- 
-      PACKAGE BODY CD5011I_PACKAGE IS
- 
-           INT : ARRAY (1 .. 10) OF INTEGER;
-           FOR INT USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           TEST ("CD5011I", "AN ADDRESS CLAUSE CAN BE " &
-                            "GIVEN FOR A VARIABLE OF AN ARRAY " &
-                            "TYPE IN THE DECLARATIVE PART OF A " &
-                            "PACKAGE BODY");
- 
-           FOR I IN INT'RANGE LOOP
-                INT (I) := IDENT_INT (I);
-           END LOOP;
- 
-           FOR I IN INT'RANGE LOOP
-                IF INT (I) /= I THEN
-                     FAILED ("WRONG VALUE FOR ELEMENT" &
-                             INTEGER'IMAGE (I));
-                END IF;
-           END LOOP;
- 
-           IF INT'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("WRONG ADDRESS FOR VARIABLE IN PACKAGE");
-           END IF;
-      END;
- 
- BEGIN
- 
-      RESULT;
- 
- END CD5011I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- CD5011K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
- --     RECORD TYPE IN THE DECLARATIVE PART OF A BLOCK STATEMENT.
- 
- -- HISTORY:
- --     JET 09/15/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011K IS
- 
- BEGIN
- 
-      TEST ("CD5011K", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF A RECORD " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "BLOCK STATEMENT");
- 
-      DECLARE
- 
-           TYPE REC_TYPE IS RECORD
-                I : INTEGER := 12;
-                B : BOOLEAN := TRUE;
-           END RECORD;
- 
-           REC : REC_TYPE;
-           FOR REC USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                REC.I := 17;
-                REC.B := FALSE;
-           END IF;
- 
-           IF REC.I /= 17 OR REC.B THEN
-                FAILED ("WRONG VALUE FOR VARIABLE IN BLOCK");
-           END IF;
- 
-           IF REC'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("WRONG ADDRESS FOR VARIABLE IN BLOCK");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END CD5011K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- CD5011M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF
- --     AN ACCESS TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
- 
- -- HISTORY:
- --     JET 09/15/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011M IS
- 
-      TYPE ACC_TYPE IS ACCESS STRING;
- 
-      PROCEDURE CD5011M_PROC IS
- 
-           ACC : ACC_TYPE := NEW STRING'("THE QUICK BROWN FOX");
-           FOR ACC USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           IF EQUAL (3, 3) THEN
-                ACC := NEW STRING'("THE LAZY DOG");
-           END IF;
- 
-           IF ACC.ALL /= IDENT_STR ("THE LAZY DOG") THEN
-                FAILED ("INCORRECT VALUE FOR VARIABLE IN PROCEDURE");
-           END IF;
- 
-           IF ACC'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR VARIABLE IN PROCEDURE");
-           END IF;
- 
-      END CD5011M_PROC;
- 
- BEGIN
-      TEST ("CD5011M", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF AN ACCESS " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "SUBPROGRAM");
- 
-      CD5011M_PROC;
- 
-      RESULT;
- 
- END CD5011M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011q.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- CD5011Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
- --     PRIVATE TYPE IN THE DECLARATIVE PART OF A BLOCK STATEMENT.
- 
- -- HISTORY:
- --     JET 09/15/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011Q IS
- 
-      PACKAGE P IS
-           TYPE PRIV_TYPE IS PRIVATE;
-           FUNCTION INT_TO_PRIV (I : INTEGER) RETURN PRIV_TYPE;
-           FUNCTION EQUAL (P : PRIV_TYPE; I : INTEGER) RETURN BOOLEAN;
-      PRIVATE
-           TYPE PRIV_TYPE IS NEW INTEGER;
-      END P;
- 
-      PACKAGE BODY P IS
- 
-           FUNCTION INT_TO_PRIV (I : INTEGER) RETURN PRIV_TYPE IS
-                BEGIN
-                     RETURN PRIV_TYPE(I);
-                END;
- 
-           FUNCTION EQUAL (P : PRIV_TYPE; I : INTEGER) RETURN BOOLEAN IS
-                BEGIN
-                     RETURN (P = PRIV_TYPE(I));
-                END;
- 
-      END P;
- 
-      USE P;
- 
- BEGIN
- 
-      TEST ("CD5011Q", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF A PRIVATE " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "BLOCK STATEMENT");
- 
-      DECLARE
- 
-           PRIV : PRIV_TYPE := INT_TO_PRIV (12);
-           FOR PRIV USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           PRIV := INT_TO_PRIV (17);
- 
-           IF NOT EQUAL (PRIV, IDENT_INT (17)) THEN
-                FAILED ("INCORRECT VALUE FOR VARIABLE OF PRIVATE TYPE");
-           END IF;
- 
-           IF PRIV'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR VARIABLE OF " &
-                        "PRIVATE TYPE");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END CD5011Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011s.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5011s.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5011s.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- CD5011S.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
- --     LIMITED PRIVATE TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
- 
- -- HISTORY:
- --     JET 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- 
- PROCEDURE CD5011S IS
- 
-      PACKAGE P IS
-           TYPE LIMP_TYPE IS LIMITED PRIVATE;
-           PROCEDURE TEST_LIMP (LIMP : IN OUT LIMP_TYPE);
-      PRIVATE
-           TYPE LIMP_TYPE IS ARRAY (1 .. 10) OF INTEGER;
-      END P;
- 
-      PACKAGE BODY P IS
-           PROCEDURE TEST_LIMP (LIMP : IN OUT LIMP_TYPE) IS
-           BEGIN
-                FOR I IN LIMP'RANGE LOOP
-                     LIMP (I) := IDENT_INT (I);
-                END LOOP;
- 
-                FOR I IN LIMP'RANGE LOOP
-                     IF LIMP (I) /= I THEN
-                          FAILED ("INCORRECT VALUE FOR ELEMENT" &
-                                  INTEGER'IMAGE (I));
-                     END IF;
-                END LOOP;
-           END TEST_LIMP;
-      END P;
- 
-      USE P;
- 
-      PROCEDURE CD5011S_PROC IS
- 
-           LIMP : LIMP_TYPE;
-           FOR LIMP USE
-                AT SPPRT13.VARIABLE_ADDRESS;
- 
-      BEGIN
-           TEST_LIMP (LIMP);
- 
-           IF LIMP'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                FAILED ("WRONG ADDRESS FOR VARIABLE OF A LIMITED " &
-                        "PRIVATE TYPE");
-           END IF;
-      END;
- 
- BEGIN
-      TEST ("CD5011S", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF A LIMITED " &
-                       "PRIVATE TYPE IN THE DECLARATIVE PART " &
-                       "OF A SUBPROGRAM");
- 
-      CD5011S_PROC;
- 
-      RESULT;
- 
- END CD5011S;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- CD5012A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
- --     ENUMERATION TYPE IN THE DECLARATIVE PART OF A GENERIC SUBPROGRAM.
- 
- -- HISTORY:
- --     DHH 09/15/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- PROCEDURE CD5012A IS
- 
- BEGIN
- 
-      TEST ("CD5012A", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF AN ENUMERATION " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "GENERIC SUBPROGRAM");
- 
-      DECLARE
-           TYPE NON_CHAR IS (RED, BLUE, GREEN);
- 
-           COLOR : NON_CHAR;
-           TEST_VAR : ADDRESS := COLOR'ADDRESS;
- 
-           GENERIC
-           PROCEDURE GENPROC;
- 
-           PROCEDURE GENPROC IS
- 
-                HUE : NON_CHAR := GREEN;
-                FOR HUE USE AT
-                         SPPRT13.VARIABLE_ADDRESS;
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     HUE := RED;
-                END IF;
-                IF HUE /= RED THEN
-                     FAILED ("WRONG VALUE FOR VARIABLE IN " &
-                             "GENERIC PROCEDURE");
-                END IF;
-                IF HUE'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                     FAILED ("WRONG ADDRESS FOR VARIABLE " &
-                             "IN GENERIC PROCEDURE");
-                END IF;
-           END GENPROC;
- 
-           PROCEDURE PROC IS NEW GENPROC;
-      BEGIN
-           PROC;
-      END;
-      RESULT;
- END CD5012A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CD5012B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
- --     INTEGER TYPE IN THE DECLARATIVE PART OF A GENERIC PACKAGE BODY.
- 
- -- HISTORY:
- --     DHH 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- PROCEDURE CD5012B IS
- 
- BEGIN
- 
-      TEST ("CD5012B", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF AN INTEGER " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "GENERIC PACKAGE BODY");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
- 
-                INT2 : INTEGER :=2;
- 
-                FOR INT2 USE AT
-                       SPPRT13.VARIABLE_ADDRESS;
- 
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     INT2 := 1;
-                END IF;
-                IF INT2 /= 1 THEN
-                     FAILED ("WRONG VALUE FOR VARIABLE IN " &
-                             "A GENERIC PACKAGE BODY");
-                END IF;
-                IF INT2'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                     FAILED ("WRONG ADDRESS FOR VARIABLE " &
-                             "IN A GENERIC PACKAGE BODY");
-                END IF;
-           END GENPACK;
- 
-           PACKAGE PACK IS NEW GENPACK;
-      BEGIN
-           NULL;
-      END;
-      RESULT;
- END CD5012B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CD5012E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
- --     FIXED POINT TYPE IN THE DECLARATIVE PART OF A GENERIC SUBPROGRAM.
- 
- -- HISTORY:
- --     DHH 09/15/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- PROCEDURE CD5012E IS
- 
- BEGIN
- 
-      TEST ("CD5012E", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF A FIXED POINT " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "GENERIC SUBPROGRAM");
- 
-      DECLARE
- 
-           GENERIC
-           PROCEDURE GENPROC;
- 
-           PROCEDURE GENPROC IS
- 
-                TYPE FIXED IS DELTA 2.0**(-4) RANGE -10.0..10.0;
- 
-                TESTFIX : FIXED := 0.0;
-                FOR TESTFIX USE AT SPPRT13.VARIABLE_ADDRESS;
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     TESTFIX := 1.0;
-                END IF;
-                IF TESTFIX /= 1.0 THEN
-                     FAILED ("WRONG VALUE FOR VARIABLE IN " &
-                                  "A GENERIC PROCEDURE");
-                END IF;
-                IF TESTFIX'ADDRESS /=
-                         SPPRT13.VARIABLE_ADDRESS THEN
-                     FAILED ("WRONG ADDRESS FOR VARIABLE " &
-                                    "IN A GENERIC PROCEDURE");
-                END IF;
-           END GENPROC;
- 
-           PROCEDURE PROC IS NEW GENPROC;
-      BEGIN
-           PROC;
-      END;
-      RESULT;
- END CD5012E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- CD5012F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
- --     ARRAY TYPE IN THE DECLARATIVE PART OF A GENERIC
- --     PACKAGE BODY.
- 
- -- HISTORY:
- --     DHH 09/17/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- PROCEDURE CD5012F IS
- 
- BEGIN
- 
-      TEST ("CD5012F", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF AN ARRAY " &
-                       "TYPE IN THE DECLARATIVE " &
-                       "PART OF A GENERIC PACKAGE BODY");
- 
-      DECLARE
- 
-           GENERIC
-           PACKAGE GENPACK IS
- 
-           END GENPACK;
- 
-           PACKAGE BODY GENPACK IS
-                ARRAY_VAR : ARRAY (0..4) OF INTEGER := (0,1,2,3,4);
- 
-                FOR ARRAY_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
- 
- 
-           BEGIN
-                IF EQUAL (3, 3) THEN
-                     ARRAY_VAR := (4,3,2,1,0);
-                END IF;
-                IF ARRAY_VAR /= (4,3,2,1,0) THEN
-                     FAILED ("WRONG VALUE FOR VARIABLE IN " &
-                             "A GENERIC PACKAGE BODY");
-                END IF;
-                IF ARRAY_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                     FAILED ("WRONG ADDRESS FOR VARIABLE " &
-                             "IN A GENERIC PACKAGE BODY");
-                END IF;
-           END GENPACK;
- 
-           PACKAGE PACK IS NEW GENPACK;
-      BEGIN
-           NULL;
-      END;
-      RESULT;
- END CD5012F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- CD5012I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
- --     ACCESS TYPE IN THE DECLARATIVE PART OF A GENERIC SUBPROGRAM.
- 
- -- HISTORY:
- --     DHH 09/17/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- PROCEDURE CD5012I IS
- 
- BEGIN
- 
-      TEST ("CD5012I", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF AN ACCESS " &
-                       "TYPE IN THE DECLARATIVE PART OF A " &
-                       "GENERIC SUBPROGRAM");
- 
-      DECLARE
- 
-           GENERIC
-           PROCEDURE GENPROC;
- 
-           PROCEDURE GENPROC IS
- 
-                TYPE CELL;
-                TYPE POINTER IS ACCESS CELL;
-                TYPE CELL IS
-                     RECORD
-                          VALUE : INTEGER;
-                          NEXT : POINTER;
-                     END RECORD;
- 
-                C,PTR : POINTER := NULL;
- 
-                FOR PTR USE AT
-                       SPPRT13.VARIABLE_ADDRESS;
-           BEGIN
-                PTR := NEW CELL'(0,NULL);
-                C := PTR;
- 
-                IF EQUAL (3, 3) THEN
-                     PTR.VALUE := 1;
-                     PTR.NEXT := C;
-                END IF;
-                IF PTR.ALL /= (1,C) THEN
-                     FAILED ("WRONG VALUE FOR VARIABLE IN " &
-                             "A GENERIC PROCEDURE");
-                END IF;
-                IF PTR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                     FAILED ("WRONG ADDRESS FOR VARIABLE " &
-                             "IN A GENERIC PROCEDURE");
-                END IF;
-           END GENPROC;
- 
-           PROCEDURE PROC IS NEW GENPROC;
-      BEGIN
-           PROC;
-      END;
-      RESULT;
- END CD5012I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5012m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5012m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- CD5012M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
- --     LIMITED PRIVATE TYPE IN THE DECLARATIVE PART OF A GENERIC
- --     SUBPROGRAM.
- 
- -- HISTORY:
- --     DHH 09/15/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH REPORT; USE REPORT;
- WITH SPPRT13;
- PROCEDURE CD5012M IS
- 
- BEGIN
- 
-      TEST ("CD5012M", "AN ADDRESS CLAUSE CAN BE " &
-                       "GIVEN FOR A VARIABLE OF A LIMITED " &
-                       "PRIVATE TYPE IN THE DECLARATIVE " &
-                       "PART OF A GENERIC SUBPROGRAM");
- 
-      DECLARE
- 
-           PACKAGE P IS
-                TYPE FIXED IS LIMITED PRIVATE;
- 
-           PRIVATE
-                TYPE FIXED IS DELTA 2.0**(-4) RANGE -10.0..10.0;
-           END P;
- 
-           USE P;
- 
-           GENERIC
-           PROCEDURE GENPROC;
- 
-           PROCEDURE GENPROC IS
- 
-                TESTFIX : FIXED;
- 
-                FOR TESTFIX USE AT
-                  SPPRT13.VARIABLE_ADDRESS;
-           BEGIN
-                IF TESTFIX'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
-                     FAILED ("WRONG ADDRESS FOR LIMITED PRIVATE " &
-                             "TYPE VARIABLE IN GENERIC PROCEDURE");
-                END IF;
-           END GENPROC;
- 
-      PROCEDURE PROC IS NEW GENPROC;
-      BEGIN
-           PROC;
-      END;
-      RESULT;
- END CD5012M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- CD5013A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN ENUMERATION TYPE,
- --     WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013A IS
- 
-      TYPE ENUM_TYPE IS (ONE,TWO,THREE,FOUR,FIVE,SIX);
- 
-      PACKAGE PACK IS
-           CHECK_TYPE : ENUM_TYPE;
-           FOR CHECK_TYPE USE AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      USE PACK;
- 
- BEGIN
- 
-      TEST ("CD5013A", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
-                       "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
-                       "FOR A VARIABLE OF AN ENUMERATION TYPE, WHERE " &
-                       "THE VARIABLE IS DECLARED IN THE VISIBLE PART " &
-                       "OF THE SPECIFICATION");
- 
-      CHECK_TYPE := ONE;
-      IF EQUAL(3,3) THEN
-           CHECK_TYPE := THREE;
-      END IF;
- 
-      IF CHECK_TYPE /= THREE THEN
-           FAILED ("INCORRECT VALUE FOR ENUMERATION VARIABLE");
-      END IF;
- 
-      IF CHECK_TYPE'ADDRESS /= VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR ENUMERATION VARIABLE");
-      END IF;
- 
-      RESULT;
- END CD5013A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- CD5013C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN INTEGER TYPE, WHERE
- --     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013C IS
- 
-      TYPE INT_TYPE IS RANGE INTEGER'FIRST .. INTEGER'LAST;
- 
-      PACKAGE PACK IS
-           CHECK_VAR : INT_TYPE;
-      PRIVATE
-           FOR CHECK_VAR USE AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      USE PACK;
- 
- BEGIN
- 
-      TEST ("CD5013C", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
-                       "THE PRIVATE PART OF A PACKAGE SPECIFICATION " &
-                       "FOR A VARIABLE OF AN INTEGER TYPE, WHERE THE " &
-                       "VARIABLE IS DECLARED IN THE VISIBLE PART OF " &
-                       "THE SPECIFICATION");
- 
-      CHECK_VAR := 100;
-      IF EQUAL(3,3) THEN
-           CHECK_VAR := 10;
-      END IF;
- 
-      IF CHECK_VAR /= 10 THEN
-           FAILED ("INCORRECT VALUE FOR INTEGER VARIABLE");
-      END IF;
- 
-      IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR INTEGER VARIABLE");
-      END IF;
- 
-      RESULT;
- END CD5013C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- CD5013E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF A FLOATING POINT TYPE,
- --     WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013E IS
- 
-      TYPE FLT_TYPE IS DIGITS 5 RANGE -1.0 .. 1.0;
- 
-      PACKAGE PACK IS
-           CHECK_VAR : FLT_TYPE;
-           FOR CHECK_VAR USE AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      USE PACK;
- 
- BEGIN
- 
-      TEST ("CD5013E", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
-                       "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
-                       "FOR A VARIABLE OF A FLOATING POINT TYPE, " &
-                       "WHERE THE VARIABLE IS DECLARED IN THE VISIBLE " &
-                       "PART OF THE SPECIFICATION");
- 
-      CHECK_VAR := 0.5;
-      IF EQUAL(3,3) THEN
-           CHECK_VAR := 0.0;
-      END IF;
- 
-      IF CHECK_VAR /= 0.0 THEN
-           FAILED ("INCORRECT VALUE FOR FLOATING POINT VARIABLE");
-      END IF;
- 
-      IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR FLOATING POINT VARIABLE");
-      END IF;
- 
-      RESULT;
- END CD5013E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- CD5013G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF A FIXED POINT TYPE,
- --     WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013G IS
- 
-      TYPE FIX_TYPE IS DELTA 0.5 RANGE -7.5 .. 7.5;
- 
-      PACKAGE PACK IS
-           CHECK_VAR : FIX_TYPE;
-      PRIVATE
-           FOR CHECK_VAR USE
-                AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      USE PACK;
- 
- BEGIN
- 
-      TEST ("CD5013G", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
-                       "THE PRIVATE PART OF A PACKAGE SPECIFICATION " &
-                       "FOR A VARIABLE OF A FIXED POINT TYPE, " &
-                       "WHERE THE VARIABLE IS DECLARED IN THE VISIBLE " &
-                       "PART OF THE SPECIFICATION");
- 
-      CHECK_VAR := 1.5;
-      IF EQUAL(3,3) THEN
-           CHECK_VAR := 5.0;
-      END IF;
- 
-      IF CHECK_VAR /= 5.0 THEN
-           FAILED ("INCORRECT VALUE FOR FIXED POINT VARIABLE");
-      END IF;
- 
-      IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR FIXED POINT VARIABLE");
-      END IF;
- 
-      RESULT;
- END CD5013G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- CD5013I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN ARRAY TYPE, WHERE
- --     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013I IS
- 
-      TYPE ARR_TYPE IS ARRAY(1..5) OF INTEGER;
- 
-      PACKAGE PACK IS
-           CHECK_VAR : ARR_TYPE;
-           FOR CHECK_VAR USE
-                AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      USE PACK;
- 
- BEGIN
- 
-      TEST ("CD5013I", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
-                       "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
-                       "FOR A VARIABLE OF AN ARRAY TYPE, WHERE THE " &
-                       "VARIABLE IS DECLARED IN THE VISIBLE PART OF " &
-                       "THE SPECIFICATION");
- 
-      CHECK_VAR := (1,2,3,4,5);
-      IF EQUAL(3,3) THEN
-           CHECK_VAR := (5,4,3,2,1);
-      END IF;
- 
-      IF CHECK_VAR /= (5,4,3,2,1) THEN
-           FAILED ("INCORRECT VALUE FOR ARRAY VARIABLE");
-      END IF;
- 
-      IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR ARRAY VARIABLE");
-      END IF;
- 
-      RESULT;
- END CD5013I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,78 ****
- -- CD5013K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF A RECORD TYPE, WHERE
- --     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013K IS
- 
-      TYPE REC_TYPE IS RECORD
-           BOOL : BOOLEAN;
-           INT  : INTEGER;
-      END RECORD;
- 
-      PACKAGE PACK IS
-           CHECK_VAR : REC_TYPE;
-      PRIVATE
-           FOR CHECK_VAR USE
-                AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      PACKAGE BODY PACK IS
-      BEGIN
-           TEST ("CD5013K", "AN ADDRESS CLAUSE CAN BE GIVEN " &
-                            "IN THE PRIVATE PART OF A PACKAGE " &
-                            "SPECIFICATION FOR A VARIABLE OF A RECORD " &
-                            "TYPE, WHERE THE VARIABLE IS DECLARED IN " &
-                            "THE VISIBLE PART OF THE SPECIFICATION");
- 
-           CHECK_VAR := (TRUE, IDENT_INT(5));
-           IF EQUAL(3,3) THEN
-                CHECK_VAR := (FALSE, IDENT_INT(10));
-           END IF;
- 
-           IF CHECK_VAR /= (FALSE, IDENT_INT (10)) THEN
-                FAILED ("INCORRECT VALUE FOR RECORD VARIABLE");
-           END IF;
- 
-           IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR RECORD VARIABLE");
-           END IF;
-      END PACK;
- 
- BEGIN
- 
-      RESULT;
- END CD5013K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,73 ****
- -- CD5013M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN ACCESS TYPE, WHERE
- --     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013M IS
- 
-      TYPE ACC_TYPE IS ACCESS INTEGER;
- 
-      PACKAGE PACK IS
-           CHECK_VAR : ACC_TYPE;
-           FOR CHECK_VAR USE
-                AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      USE PACK;
- 
- BEGIN
- 
-      TEST ("CD5013M", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
-                       "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
-                       "FOR A VARIABLE OF AN ACCESS TYPE, WHERE THE " &
-                       "VARIABLE IS DECLARED IN THE VISIBLE PART OF " &
-                       "THE SPECIFICATION");
- 
-      CHECK_VAR := NEW INTEGER'(100);
-      IF EQUAL(3,3) THEN
-           CHECK_VAR := NEW INTEGER'(25);
-      END IF;
- 
-      IF CHECK_VAR.ALL /= 25 THEN
-           FAILED ("INCORRECT VALUE FOR ACCESS VARIABLE");
-      END IF;
- 
-      IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
-           FAILED ("INCORRECT ADDRESS FOR ACCESS VARIABLE");
-      END IF;
- 
-      RESULT;
- END CD5013M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5013o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5013o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CD5013O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
- --     A PACKAGE SPECIFICATION FOR A VARIABLE OF A PRIVATE TYPE, WHERE
- --     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 09/16/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH REPORT;  USE REPORT;
- WITH SPPRT13; USE SPPRT13;
- WITH SYSTEM;  USE SYSTEM;
- 
- PROCEDURE CD5013O IS
- 
-      PACKAGE P1 IS
-      END P1;
- 
-      PACKAGE PACK IS
-           TYPE F IS PRIVATE;
-      PRIVATE
-           TYPE F IS NEW INTEGER;
-           CHECK_VAR : F;
-           FOR CHECK_VAR USE AT VARIABLE_ADDRESS;
-      END PACK;
- 
-      USE PACK;
- 
-      PACKAGE BODY P1 IS
-      BEGIN
-           TEST ("CD5013O", "AN ADDRESS CLAUSE CAN BE GIVEN" &
-                            " IN THE PRIVATE PART OF A PACKAGE " &
-                            "SPECIFICATION FOR A VARIABLE OF A " &
-                            "PRIVATE TYPE, WHERE THE VARIABLE IS " &
-                            "DECLARED IN THE VISIBLE PART OF THE " &
-                            "SPECIFICATION");
-      END P1;
- 
-      PACKAGE BODY PACK IS
-      BEGIN
-           CHECK_VAR := 100;
-           IF EQUAL(3,3) THEN
-                CHECK_VAR := 25;
-           END IF;
- 
-           IF CHECK_VAR /= 25 THEN
-                FAILED ("INCORRECT VALUE FOR PRIVATE VARIABLE");
-           END IF;
- 
-           IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR PRIVATE VARIABLE");
-           END IF;
-      END PACK;
- 
- BEGIN
- 
-      RESULT;
- END CD5013O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CD5014A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN
- --     ENUMERATION TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE
- --     PART OF THE SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 07/24/87  CREATED ORIGINAL TEST.
- --     BCB 09/30/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014A IS
- 
- BEGIN
- 
-      TEST ("CD5014A", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF AN " &
-                       "ENUMERATION TYPE, WHERE THE VARIABLE IS " &
-                       "DECLARED IN THE VISIBLE PART OF THE " &
-                       "SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE ENUM_TYPE IS (RED,BLUE,GREEN);
-           ENUM_OBJ1 : ENUM_TYPE := RED;
-           FOR ENUM_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                ENUM_OBJ1 := BLUE;
-           END IF;
- 
-           IF ENUM_OBJ1 /= BLUE THEN
-                FAILED ("INCORRECT VALUE FOR ENUMERATION VARIABLE");
-           END IF;
- 
-           IF ENUM_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR ENUMERATION VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CD5014C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN INTEGER
- --     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 07/24/87  CREATED ORIGINAL TEST.
- --     BCB 09/30/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014C IS
- 
- BEGIN
- 
-      TEST ("CD5014C", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF AN INTEGER " &
-                       "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
-                       "VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE INTEGER_TYPE IS RANGE 0 .. 100;
-           INTEGER_OBJ1 : INTEGER_TYPE := 50;
-      PRIVATE
-           FOR INTEGER_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                INTEGER_OBJ1 := 7;
-           END IF;
- 
-           IF INTEGER_OBJ1 /= 7 THEN
-                FAILED ("INCORRECT VALUE FOR INTEGER VARIABLE");
-           END IF;
- 
-           IF INTEGER_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR INTEGER VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CD5014E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FLOATING
- --     POINT TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
- --     OF THE SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 08/19/87  CREATED ORIGINAL TEST.
- --     BCB 09/30/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014E IS
- 
- BEGIN
- 
-      TEST ("CD5014E", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A FLOATING " &
-                       "POINT TYPE, WHERE THE VARIABLE IS DECLARED " &
-                       "IN THE VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE FLOAT_TYPE IS DIGITS SYSTEM.MAX_DIGITS
-                RANGE 0.0 .. 100.0;
-           FLOAT_OBJ1 : FLOAT_TYPE := 50.0;
-           FOR FLOAT_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FLOAT_OBJ1 := 5.0;
-           END IF;
- 
-           IF FLOAT_OBJ1 /= 5.0 THEN
-                FAILED ("INCORRECT VALUE FOR FLOATING POINT VARIABLE");
-           END IF;
- 
-           IF FLOAT_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR FLOATING POINT VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CD5014G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FIXED
- --     POINT TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF
- --     THE SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 07/24/87  CREATED ORIGINAL TEST.
- --     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014G IS
- 
- BEGIN
- 
-      TEST ("CD5014G", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A FIXED " &
-                       "POINT TYPE, WHERE THE VARIABLE IS DECLARED " &
-                       "IN THE VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE FIXED_TYPE IS DELTA 0.5 RANGE 0.0 .. 100.0;
-           FIXED_OBJ1 : FIXED_TYPE := 50.0;
-      PRIVATE
-           FOR FIXED_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FIXED_OBJ1 := 5.0;
-           END IF;
- 
-           IF FIXED_OBJ1 /= 5.0 THEN
-                FAILED ("INCORRECT VALUE FOR FIXED POINT VARIABLE");
-           END IF;
- 
-           IF FIXED_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR FIXED POINT VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CD5014I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN ARRAY
- --     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 07/24/87  CREATED ORIGINAL TEST.
- --     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014I IS
- 
- BEGIN
- 
-      TEST ("CD5014I", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF AN ARRAY " &
-                       "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
-                       "VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE ARR_TYPE IS ARRAY (1..2) OF INTEGER;
-           ARR_OBJ1 : ARR_TYPE := (5,10);
-           FOR ARR_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                ARR_OBJ1 := (13,21);
-           END IF;
- 
-           IF ARR_OBJ1 /= (13,21) THEN
-                FAILED ("INCORRECT VALUE FOR ARRAY VARIABLE");
-           END IF;
- 
-           IF ARR_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR ARRAY VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- CD5014K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A RECORD
- --     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 07/24/87  CREATED ORIGINAL TEST.
- --     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014K IS
- 
- BEGIN
- 
-      TEST ("CD5014K", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A RECORD " &
-                       "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
-                       "VISIBLE PART OF THE SPECIFICATION");
- 
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE REC_TYPE IS RECORD
-                VAL : INTEGER;
-           END RECORD;
-           REC_OBJ1 : REC_TYPE := (VAL => 10);
-      PRIVATE
-           FOR REC_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                REC_OBJ1.VAL := 100;
-           END IF;
- 
-           IF REC_OBJ1.VAL /= 100 THEN
-                FAILED ("INCORRECT VALUE FOR RECORD VARIABLE COMPONENT");
-           END IF;
- 
-           IF REC_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR RECORD VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- CD5014M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN ACCESS
- --     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF
- --     THE SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 07/24/87  CREATED ORIGINAL TEST.
- --     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014M IS
- 
- BEGIN
- 
-      TEST ("CD5014M", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF AN ACCESS " &
-                       "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
-                       "VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE ACCESS_TYPE;
-           TYPE POINTER_TYPE IS ACCESS ACCESS_TYPE;
-           TYPE ACCESS_TYPE IS RECORD
-                VAL1 : INTEGER;
-                NEXT : POINTER_TYPE;
-           END RECORD;
-           POINTER_OBJ1 : POINTER_TYPE := NEW ACCESS_TYPE'(0,NULL);
-           FOR POINTER_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                POINTER_OBJ1 := NEW ACCESS_TYPE'(10,NULL);
-           END IF;
- 
-           IF POINTER_OBJ1.ALL /= (10,NULL) THEN
-                FAILED ("INCORRECT VALUE FOR ACCESS VARIABLE");
-           END IF;
- 
-           IF POINTER_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR ACCESS VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- CD5014O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A PRIVATE
- --     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
- --     SPECIFICATION.
- 
- 
- -- HISTORY:
- --     CDJ 07/24/87  CREATED ORIGINAL TEST.
- --     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- --     MCH 04/03/90  ADDED INSTANTIATION.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014O IS
- 
- BEGIN
- 
-      TEST ("CD5014O", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A PRIVATE " &
-                       "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
-                       "VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-      PACKAGE PKG IS
-           TYPE PRIVATE_TYPE IS PRIVATE;
-      PRIVATE
-           TYPE PRIVATE_TYPE IS RANGE 1 .. 20;
-           PRIVATE_OBJ1 : PRIVATE_TYPE := 5;
-           FOR PRIVATE_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                PRIVATE_OBJ1 := 9;
-           END IF;
- 
-           IF PRIVATE_OBJ1 /= 9 THEN
-                FAILED ("INCORRECT VALUE FOR PRIVATE VARIABLE");
-           END IF;
- 
-           IF PRIVATE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR PRIVATE VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE INSTANTIATE IS NEW PKG;
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014t.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014t.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014t.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014t.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- -- CD5014T.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
- --     DISCRETE TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
- --     OF THE SPECIFICATION.
- 
- 
- -- HISTORY:
- --     BCB 10/08/87  CREATED ORIGINAL TEST.
- 
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014T IS
- 
- BEGIN
- 
-      TEST ("CD5014T", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
-                       "DISCRETE TYPE, WHERE THE VARIABLE IS DECLARED " &
-                       "IN THE VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-           TYPE FORM_DISCRETE_TYPE IS (<>);
-      PACKAGE PKG IS
-           FORM_DISCRETE_OBJ1 : FORM_DISCRETE_TYPE :=
-                FORM_DISCRETE_TYPE'FIRST;
-      PRIVATE
-           FOR FORM_DISCRETE_OBJ1 USE
-                AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
- 
-           IF EQUAL(3,3) THEN
-                FORM_DISCRETE_OBJ1 := FORM_DISCRETE_TYPE'LAST;
-           END IF;
- 
-           IF FORM_DISCRETE_OBJ1 /= FORM_DISCRETE_TYPE'LAST THEN
-                FAILED ("INCORRECT VALUE FOR FORMAL DISCRETE VARIABLE");
-           END IF;
- 
-           IF FORM_DISCRETE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR FORMAL DISCRETE " &
-                        "VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE PACK IS NEW PKG(FORM_DISCRETE_TYPE => INTEGER);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014T;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014v.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014v.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014v.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CD5014V.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
- --     FIXED TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
- --     OF THE SPECIFICATION.
- 
- 
- -- HISTORY:
- --     BCB 10/08/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014V IS
- 
- BEGIN
- 
-      TEST ("CD5014V", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
-                       "FIXED TYPE, WHERE THE VARIABLE IS DECLARED " &
-                       "IN THE VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
-           TYPE FIX IS DELTA 0.5 RANGE -30.00 .. 30.00;
- 
-      GENERIC
-           TYPE FORM_FIXED_TYPE IS DELTA <>;
-      PACKAGE PKG IS
-           FORM_FIXED_OBJ1 : FORM_FIXED_TYPE := 5.0;
-           FOR FORM_FIXED_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF EQUAL(3,3) THEN
-                FORM_FIXED_OBJ1 := 20.0;
-           END IF;
- 
-           IF FORM_FIXED_OBJ1 /= 20.0 THEN
-                FAILED ("INCORRECT VALUE FOR FORMAL FIXED VARIABLE");
-           END IF;
- 
-           IF FORM_FIXED_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR FORMAL FIXED " &
-                        "VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE PACK IS NEW PKG(FORM_FIXED_TYPE => FIX);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014V;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014x.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014x.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014x.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- CD5014X.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
- --     ARRAY TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
- --     OF THE SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 10/08/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CD5014X IS
- 
- BEGIN
- 
-      TEST ("CD5014X", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
-                       "ARRAY TYPE, WHERE THE VARIABLE IS DECLARED " &
-                       "IN THE VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-           TYPE COLOR IS (RED,BLUE,GREEN);
-           TYPE COLOR_TABLE IS ARRAY (COLOR) OF INTEGER;
- 
-      GENERIC
-           TYPE INDEX IS (<>);
-           TYPE FORM_ARRAY_TYPE IS ARRAY (INDEX) OF INTEGER;
-      PACKAGE PKG IS
-           FORM_ARRAY_OBJ1 : FORM_ARRAY_TYPE := (1,2,3);
-      PRIVATE
-           FOR FORM_ARRAY_OBJ1 USE AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
- 
-           IF EQUAL(3,3) THEN
-                FORM_ARRAY_OBJ1 := (10,20,30);
-           END IF;
- 
-           IF FORM_ARRAY_OBJ1 /= (10,20,30) THEN
-                FAILED ("INCORRECT VALUE FOR FORMAL ARRAY VARIABLE");
-           END IF;
- 
-           IF FORM_ARRAY_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR FORMAL ARRAY " &
-                        "VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE PACK IS NEW PKG(INDEX => COLOR,
-                              FORM_ARRAY_TYPE => COLOR_TABLE);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014X;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014y.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014y.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014y.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014y.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- CD5014Y.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
- --     PRIVATE TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
- --     OF THE SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 10/08/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014Y IS
- 
- BEGIN
- 
-      TEST ("CD5014Y", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
-                       "PRIVATE TYPE, WHERE THE VARIABLE IS DECLARED " &
-                       "IN THE VISIBLE PART OF THE SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-           TYPE FORM_PRIVATE_TYPE IS PRIVATE;
-      PACKAGE PKG IS
-           FORM_PRIVATE_OBJ1 : FORM_PRIVATE_TYPE;
-           FOR FORM_PRIVATE_OBJ1 USE
-                AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF FORM_PRIVATE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR FORMAL PRIVATE " &
-                        "VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE PACK IS NEW PKG(FORM_PRIVATE_TYPE => INTEGER);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014Y;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014z.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014z.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd5014z.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd5014z.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CD5014Z.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
- --     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
- --     LIMITED PRIVATE TYPE, WHERE THE VARIABLE IS DECLARED IN THE
- --     VISIBLE PART OF THE SPECIFICATION.
- 
- -- HISTORY:
- --     BCB 10/08/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM; USE SYSTEM;
- WITH SPPRT13; USE SPPRT13;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CD5014Z IS
- 
- BEGIN
- 
-      TEST ("CD5014Z", " AN ADDRESS CLAUSE CAN BE GIVEN " &
-                       "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
-                       "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
-                       "LIMITED PRIVATE TYPE, WHERE THE VARIABLE IS " &
-                       "DECLARED IN THE VISIBLE PART OF THE " &
-                       "SPECIFICATION");
- 
-      DECLARE
- 
-      GENERIC
-           TYPE FORM_LIM_PRIVATE_TYPE IS LIMITED PRIVATE;
-      PACKAGE PKG IS
-           FORM_LIM_PRIVATE_OBJ1 : FORM_LIM_PRIVATE_TYPE;
-      PRIVATE
-           FOR FORM_LIM_PRIVATE_OBJ1 USE
-                AT VARIABLE_ADDRESS;
-      END PKG;
- 
-      PACKAGE BODY PKG IS
-      BEGIN
-           IF FORM_LIM_PRIVATE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
-                FAILED ("INCORRECT ADDRESS FOR FORMAL LIMITED PRIVATE " &
-                        "VARIABLE");
-           END IF;
-      END PKG;
- 
-      PACKAGE PACK IS NEW PKG(FORM_LIM_PRIVATE_TYPE => INTEGER);
- 
-      BEGIN
-           NULL;
-      END;
- 
-      RESULT;
- END CD5014Z;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd70001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd70001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd70001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd70001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,201 ****
- --
- -- CD70001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that package System includes Max_Base_Digits, Address,
- --      Null_Address, Word_Size, functions "<", "<=", ">", ">=", "="
- --      (with Address parameters and Boolean results), Bit_Order,
- --      Default_Bit_Order, Any_Priority, Interrupt_Priority,
- --      and Default_Priority.
- --
- --      Check that package System.Storage_Elements includes all required
- --      types and operations.
- --
- -- TEST DESCRIPTION:
- --      The test checks for the existence of the names additional
- --      to package system above those names tested for in 9Xbasic.
- --
- --      This test checks that the semantics provided in Storage_Elements
- --      are present and operate marginally within expectations (to the best
- --      extent possible in a portable implementation independent fashion).
- --
- --
- -- CHANGE HISTORY:
- --      09 MAY 95   SAIC   Initial version
- --      27 JAN 96   SAIC   Revised for 2.1; Allow negative address delta
- --
- --!
- 
- with Report;
- with Ada.Text_IO;
- with System.Storage_Elements;
- with System.Address_To_Access_Conversions;
- procedure CD70001 is
-   use System;
- 
-   procedure CD70 is
- 
-     type Int_Max is range Min_Int .. Max_Int;
- 
-     My_Int : Int_Max := System.Max_Base_Digits + System.Word_Size;
- 
-     An_Address : Address;
-     An_Other_Address : Address := An_Address'Address;
- 
-   begin  -- 7.0
- 
- 
-       if Default_Bit_Order not in High_Order_First..Low_Order_First then
-          Report.Failed ("Default_Bit_Order invalid");
-       end if;
- 
-       if Bit_Order'Pos(High_Order_First) /= 0 then
-          Report.Failed ("Bit_Order'Pos(High_Order_First) /= 0");
-       end if;
- 
-       if Bit_Order'Pos(Low_Order_First) /= 1 then
-          Report.Failed ("Bit_Order'Pos(Low_Order_First) /= 1");
-       end if;
- 
-       An_Address := My_Int'Address;
- 
-       if An_Address = Null_Address then
-         Report.Failed ("Null_Address matched a real address");
-       end if;
- 
- 
-       if An_Address'Address /= An_Other_Address then
-         Report.Failed("Value set at elaboration not equal to itself");
-       end if;
- 
-       if An_Address'Address > An_Other_Address 
-          and An_Address'Address < An_Other_Address then
-         Report.Failed("Address is both greater and less!");
-       end if;
- 
-       if not (An_Address'Address >= An_Other_Address 
-          and An_Address'Address <= An_Other_Address) then
-         Report.Failed("Address comparisons wrong");
-       end if;
- 
- 
-       if Priority'First /= Any_Priority'First then
-         Report.Failed ("Priority'First /= Any_Priority'First");
-       end if;
- 
-       if Interrupt_Priority'First /= Priority'Last+1 then
-         Report.Failed ("Interrupt_Priority'First /= Priority'Last+1");
-       end if;
- 
-       if Interrupt_Priority'Last /= Any_Priority'Last then
-         Report.Failed ("Interrupt_Priority'Last /= Any_Priority'Last");
-       end if;
- 
-       if Default_Priority /= ((Priority'First + Priority'Last)/2) then
-         Report.Failed ("Default_Priority wrong value");
-       end if;
- 
-   end CD70;
- 
-   procedure CD71 is
-     use System.Storage_Elements;
- 
-     Storehouse_1 : Storage_Array(0..127);
-     Storehouse_2 : Storage_Array(0..127);
- 
-     House_Offset : Storage_Offset;
- 
-   begin  -- 7.1
- 
- 
-       if Storage_Count'First /= 0 then
-         Report.Failed ("Storage_Count'First /= 0");
-       end if;
- 
-       if Storage_Count'Last /= Storage_Offset'Last then
-         Report.Failed ("Storage_Count'Last /= Storage_Offset'Last");
-       end if;
- 
- 
-       if Storage_Element'Size /= Storage_Unit then
-         Report.Failed ("Storage_Element'Size /= Storage_Unit");
-       end if;
- 
-       if Storage_Array'Component_Size /= Storage_Unit then
-         Report.Failed ("Storage_Array'Element_Size /= Storage_Unit");
-       end if;
- 
-       if Storage_Element'Last+1 /= 0 then
-         Report.Failed ("Storage_Element not modular");
-       end if;
- 
- 
-       -- "+", "-"( Address, Storage_Offset) and inverse
- 
-       House_Offset := Storehouse_2'Address - Storehouse_1'Address;
-       -- Address - Address = Offset
-       -- Note that House_Offset may be a negative value
- 
-       if House_Offset + Storehouse_1'Address /= Storehouse_2'Address then
-       -- Offset + Address = Address
-         Report.Failed ("Storage arithmetic non-linear O+A");
-       end if;
- 
-       if Storehouse_1'Address + House_Offset /= Storehouse_2'Address then
-       -- Address + Offset = Address
-         Report.Failed ("Storage arithmetic non-linear A+O");
-       end if;
- 
-       if Storehouse_2'Address - House_Offset /= Storehouse_1'Address then
-       -- Address - Offset = Address
-         Report.Failed ("Storage arithmetic non-linear A-O");
-       end if;
- 
-       if (Storehouse_2'Address mod abs(House_Offset) > abs(House_Offset)) then
-       -- "mod"( Address, Storage_Offset)
-         Report.Failed("Mod arithmetic");
-       end if;
- 
- 
-       if Storehouse_1'Address
-          /= To_Address(To_Integer(Storehouse_1'Address)) then
-         Report.Failed("To_Address, To_Integer not symmetric");
-       end if;
- 
-   end CD71;
- 
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("CD70001", "Check package System" );
- 
-    CD70;
- 
-    CD71;
- 
-   Report.Result;
- 
- end CD70001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- CD7002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A VARIABLE OF TYPE ADDRESS CAN BE DECLARED IN A UNIT
- --     WHICH HAS A WITH CLAUSE NAMING SYSTEM.
- 
- -- HISTORY:
- --     DHH 08/31/88  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD7002A IS
- 
-      I : INTEGER;
- 
-      OBJECT : SYSTEM.ADDRESS := I'ADDRESS;
- 
-      SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS;
- 
- BEGIN
-      TEST ("CD7002A", "CHECK THAT A VARIABLE OF TYPE ADDRESS CAN BE " &
-                       "DECLARED IN A UNIT WHICH HAS A WITH CLAUSE " &
-                       "NAMING SYSTEM");
- 
-      IF NOT IDENT_BOOL(OBJECT IN MY_ADDRESS) THEN
-           FAILED("INCORRECT RESULT");
-      END IF;
- 
-      RESULT;
- END CD7002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7007b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7007b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7007b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- CD7007B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE SUBTYPE 'PRIORITY' IS DECLARED WITHIN THE PACKAGE
- --     SYSTEM AND IT IS A SUBTYPE OF 'INTEGER'.
- 
- -- HISTORY:
- --     VCL  09/16/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT; USE REPORT;
- PROCEDURE CD7007B IS
- BEGIN
-      TEST ("CD7007B", "THE SUBTYPE 'PRIORITY' IS DECLARED WITHIN " &
-                       "THE PACKAGE SYSTEM AND IT IS A SUBTYPE OF " &
-                       "'INTEGER'");
- 
-      DECLARE
-           CHECK_VAR : SYSTEM.PRIORITY;
-      BEGIN
-           IF SYSTEM.PRIORITY'FIRST NOT IN
-                               INTEGER'FIRST .. INTEGER'LAST AND
-                     SYSTEM.PRIORITY'LAST NOT IN
-                               INTEGER'FIRST .. INTEGER'LAST THEN
-                FAILED ("'SYSTEM.PRIORITY' IS NOT AN INTEGER SUBTYPE");
-           END IF;
-      END;
- 
-      RESULT;
- END CD7007B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- CD7101D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM,
- --     INTEGER'FIRST >= MIN_INT AND INTEGER'LAST <= MAX_INT.
- 
- -- HISTORY:
- --     JET 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD7101D IS
- 
- BEGIN
- 
-      TEST ("CD7101D", "CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE " &
-                       "SYSTEM, INTEGER'FIRST >= MIN_INT AND INTEGER'" &
-                       "LAST <= MAX_INT");
- 
-      IF INTEGER'POS (INTEGER'FIRST) < SYSTEM.MIN_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
-      END IF;
- 
-      IF INTEGER'POS (INTEGER'LAST) > SYSTEM.MAX_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
-      END IF;
- 
-      RESULT;
- 
- END CD7101D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101e.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101e.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101e.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101e.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- CD7101E.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM,
- --     SHORT_INTEGER'FIRST >= MIN_INT AND SHORT_INTEGER'LAST <= MAX_INT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO THOSE IMPLEMENTATIONS THAT
- --     SUPPORT THE SHORT_INTEGER DATA TYPE.
- 
- --     IF THE SHORT_INTEGER TYPE IS NOT SUPPORTED THEN THE
- --     DECLARATION OF "TEST_VAR" MUST BE REJECTED.
- 
- -- HISTORY:
- --     JET 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD7101E IS
- 
-      TEST_VAR : SHORT_INTEGER := 0;          -- N/A => ERROR.
- 
- BEGIN
- 
-      TEST ("CD7101E", "CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE " &
-                       "SYSTEM, SHORT_INTEGER'FIRST >= MIN_INT AND " &
-                       "SHORT_INTEGER'LAST <= MAX_INT");
- 
-      IF SHORT_INTEGER'POS (SHORT_INTEGER'FIRST) < SYSTEM.MIN_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
-      END IF;
- 
-      IF SHORT_INTEGER'POS (SHORT_INTEGER'LAST) > SYSTEM.MAX_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
-      END IF;
- 
-      RESULT;
- 
- END CD7101E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101f.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101f.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101f.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101f.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- CD7101F.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM,
- --     LONG_INTEGER'FIRST >= MIN_INT AND LONG_INTEGER'LAST <= MAX_INT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
- --     THE LONG_INTEGER DATA TYPE.
- 
- --     IF THE LONG_INTEGER TYPE IS NOT SUPPORTED, THEN THE
- --     DECLARATION OF "TEST_VAR" MUST BE REJECTED.
- 
- -- HISTORY:
- --     JET 09/10/87  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD7101F IS
- 
-      TEST_VAR : LONG_INTEGER := 0;          -- N/A => ERROR.
- 
- BEGIN
- 
-      TEST ("CD7101F", "CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE " &
-                       "SYSTEM, LONG_INTEGER'FIRST >= MIN_INT AND " &
-                       "LONG_INTEGER'LAST <= MAX_INT");
- 
-      IF LONG_INTEGER'POS (LONG_INTEGER'FIRST) < SYSTEM.MIN_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
-           END IF;
- 
-      IF LONG_INTEGER'POS (LONG_INTEGER'LAST) > SYSTEM.MAX_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
-      END IF;
- 
-      RESULT;
- 
- END CD7101F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101g.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101g.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7101g.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7101g.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- CD7101G.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM AND
- --     A PREDEFINED INTEGER TYPE I OTHER THAN INTEGER, SHORT_INTEGER,
- --     AND LONG_INTEGER, I'FIRST >= MIN_INT AND I'LAST <= MAX_INT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT HAVE
- --     A PREDEFINED INTEGER TYPE OTHER THAN INTEGER, SHORT_INTEGER,
- --     AND LONG_INTEGER.
- 
- --     IF NO SUCH TYPE EXISTS, THEN THE DECLARATION OF TEST_VAR
- --     MUST BE REJECTED.
- 
- -- HISTORY:
- --     JET 09/10/87  CREATED ORIGINAL TEST.
- 
- --     $NAME IS THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN
- --     INTEGER, SHORT_INTEGER, AND LONG_INTEGER, IF ANY SUCH TYPE
- --     EXISTS.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD7101G IS
- 
-      TEST_VAR : $NAME := 0;                    -- N/A => ERROR.
- 
- BEGIN
- 
-      TEST ("CD7101G", "CHECK THAT FOR MIN_INT AND MAX_INT IN " &
-                       "PACKAGE SYSTEM AND A PREDEFINED INTEGER " &
-                       "TYPE I OTHER THAN INTEGER, SHORT_INTEGER, " &
-                       "AND LONG_INTEGER, I'FIRST >= MIN_INT AND " &
-                       "I'LAST <= MAX_INT");
- 
-      IF $NAME'POS ($NAME'FIRST) < SYSTEM.MIN_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
-      END IF;
- 
-      IF $NAME'POS ($NAME'LAST) > SYSTEM.MAX_INT THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
-      END IF;
- 
-      RESULT;
- 
- END CD7101G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7103d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7103d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7103d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7103d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- CD7103D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE CONSTANT FINE_DELTA = 2.0 ** (- MAX_MANTISSA).
- 
- -- HISTORY:
- --     BCB 09/10/87  CREATED ORIGINAL TEST.
- 
- --     DTN 11/21/91  DELETED SUBPART (A).  CHANGED EXTENSION FROM '.TST' TO 
- --                   '.ADA'.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD7103D IS
- 
-      MANTISSA_VAL : CONSTANT := 2.0 ** (-SYSTEM.MAX_MANTISSA);
- 
- BEGIN
- 
-      TEST ("CD7103D", "CHECK THAT THE CONSTANT FINE_DELTA " &
-                       "= 2.0 ** (- MAX_MANTISSA)");
- 
-      IF SYSTEM.FINE_DELTA /= MANTISSA_VAL THEN
-           FAILED ("INCORRECT VALUE FOR SYSTEM.FINE_DELTA");
-      END IF;
- 
-      RESULT;
- 
- END CD7103D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7202a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7202a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7202a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- CD7202A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     THE 'ADDRESS ATTRIBUTE CAN BE USED IN A COMPILATION UNIT EVEN IF
- --     A WITH CLAUSE FOR PACKAGE SYSTEM DOES NOT APPLY TO THE UNIT.
- 
- -- HISTORY:
- --     DHH 08/31/88  CREATED ORIGINAL TEST.
- 
- WITH SYSTEM;
- PACKAGE CD7202A_SYS IS
-      SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS;
- END CD7202A_SYS;
- 
- WITH CD7202A_SYS;
- WITH REPORT; USE REPORT;
- PROCEDURE CD7202A IS
- 
-      INT : INTEGER := 2;
- 
-      BOOL : BOOLEAN := (INT'ADDRESS IN CD7202A_SYS.MY_ADDRESS);
- 
- BEGIN
-      TEST ("CD7202A", "THE 'ADDRESS ATTRIBUTE CAN BE USED IN A" &
-                       " COMPILATION UNIT EVEN IF A WITH CLAUSE FOR " &
-                       "PACKAGE SYSTEM DOES NOT APPLY TO THE UNIT");
- 
-      IF NOT IDENT_BOOL(BOOL) THEN
-           FAILED("ADDRESS ATTRIBUTE INCORRECT");
-      END IF;
- 
-      RESULT;
- END CD7202A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7204b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7204b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7204b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7204b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,88 ****
- -- CD7204B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PREFIX OF THE 'POSITION, 'LAST_BIT, AND 'FIRST_BIT
- --     ATTRIBUTES CAN DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES
- --     RETURN APPROPRIATE VALUES WHEN A RECORD REPRESENTATION CLAUSE IS
- --     NOT PRESENT.
- 
- -- HISTORY:
- --     BCB 09/14/87  CREATED ORIGINAL TEST.
- --     RJW 02/08/88  REVISED SO THAT TEST PASSES IF BOOLEAN'SIZE = 1.
- --     RJW 05/31/90  CORRECTED COMPARISONS INVOLVING SIZES.
- --     LDC 10/04/90  ADDED CHECK FOR 'POSITION.
- 
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD7204B IS
- 
-      TYPE BASIC_REC IS RECORD
-           CHECK_INT : INTEGER := 5;
-           CHECK_BOOL : BOOLEAN := TRUE;
-      END RECORD;
- 
-      CHECK_REC : BASIC_REC;
- 
- BEGIN
- 
-      TEST ("CD7204B", "CHECK THAT THE PREFIX OF THE 'POSITION, " &
-                       "'LAST_BIT, AND 'FIRST_BIT ATTRIBUTES CAN " &
-                       "DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES " &
-                       "RETURN APPROPRIATE VALUES WHEN A RECORD " &
-                       "REPRESENTATION CLAUSE IS NOT PRESENT");
- 
-      IF CHECK_REC.CHECK_INT'FIRST_BIT >= CHECK_REC.CHECK_INT'LAST_BIT
-           THEN FAILED ("INCORRECT VALUES FOR FIRST_BIT OR LAST_BIT " &
-                        "OF CHECK_INT");
-      END IF;
- 
-      IF (CHECK_REC.CHECK_INT'LAST_BIT - CHECK_REC.CHECK_INT'FIRST_BIT
-           + 1) < INTEGER'SIZE THEN
-           FAILED ("INCORRECT SIZE FOR CHECK_INT");
-      END IF;
- 
-      IF CHECK_REC.CHECK_BOOL'POSITION <= CHECK_REC.CHECK_INT'POSITION
-           THEN FAILED ("INCORRECT VALUE FOR 'POSITION OF CHECK_INT " &
-                        "OR CHECK_BOOL");
-      END IF;
- 
-      IF CHECK_REC.CHECK_INT'POSITION >= CHECK_REC.CHECK_BOOL'POSITION
-           THEN FAILED ("INCORRECT VALUE FOR 'POSITION OF CHECK_INT " &
-                        "OR CHECK_BOOL - 2");
-      END IF;
- 
-      IF CHECK_REC.CHECK_BOOL'FIRST_BIT > CHECK_REC.CHECK_BOOL'LAST_BIT
-           THEN FAILED ("INCORRECT VALUE FOR FIRST_BIT OR LAST_BIT " &
-                        "OF CHECK_BOOL");
-      END IF;
- 
-      IF (CHECK_REC.CHECK_BOOL'LAST_BIT - CHECK_REC.CHECK_BOOL'FIRST_BIT
-           + 1) < BOOLEAN'SIZE THEN
-           FAILED ("INCORRECT SIZE FOR CHECK_BOOL");
-      END IF;
- 
-      RESULT;
- 
- END CD7204B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7204c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7204c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7204c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7204c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- CD7204C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PREFIX OF THE 'POSITION, 'LAST_BIT, AND 'FIRST_BIT
- --     ATTRIBUTES CAN DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES
- --     RETURN APPROPRIATE VALUES WHEN A RECORD REPRESENTATION CLAUSE
- --     IS GIVEN.
- 
- -- HISTORY:
- --     BCB 09/14/87  CREATED ORIGINAL TEST.
- --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
- 
- WITH SYSTEM;
- WITH REPORT;  USE REPORT;
- 
- PROCEDURE CD7204C IS
- 
-      UNITS_PER_INTEGER : CONSTANT :=
-           (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1)/SYSTEM.STORAGE_UNIT;
- 
-      TYPE BASIC_REC IS RECORD
-           CHECK_INT : INTEGER;
-           CHECK_CHAR : CHARACTER;
-      END RECORD;
- 
-      FOR BASIC_REC USE
-           RECORD
-                CHECK_INT AT 0 RANGE 0..INTEGER'SIZE - 1;
-                CHECK_CHAR AT 1*UNITS_PER_INTEGER
-                           RANGE 0..CHARACTER'SIZE - 1;
-           END RECORD;
- 
-      CHECK_REC : BASIC_REC;
- 
- BEGIN
- 
-      TEST ("CD7204C", "THE PREFIX OF THE 'POSITION, " &
-                       "'LAST_BIT, AND 'FIRST_BIT ATTRIBUTES CAN " &
-                       "DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES " &
-                       "RETURN APPROPRIATE VALUES WHEN A RECORD " &
-                       "REPRESENTATION CLAUSE IS GIVEN");
- 
-      IF CHECK_REC.CHECK_INT'POSITION /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR POSITION OF CHECK_INT");
-      END IF;
- 
-      IF CHECK_REC.CHECK_INT'FIRST_BIT /= IDENT_INT (0) THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHECK_INT");
-      END IF;
- 
-      IF CHECK_REC.CHECK_INT'LAST_BIT /= INTEGER'SIZE - 1 THEN
-           FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHECK_INT");
-      END IF;
- 
-      IF CHECK_REC.CHECK_CHAR'POSITION /= IDENT_INT (UNITS_PER_INTEGER)
-           THEN FAILED ("INCORRECT VALUE FOR POSITION OF CHECK_CHAR");
-      END IF;
- 
-      IF CHECK_REC.CHECK_CHAR'FIRST_BIT /= 0 THEN
-           FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHECK_CHAR");
-      END IF;
- 
-      IF CHECK_REC.CHECK_CHAR'LAST_BIT /= IDENT_INT (CHARACTER'SIZE - 1)
-           THEN FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHECK_CHAR");
-      END IF;
- 
-      RESULT;
- 
- END CD7204C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd72a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd72a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd72a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd72a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- --
- -- CD72A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the package System.Address_To_Access_Conversions may be
- --      instantiated for various simple types.
- --
- --      Check that To_Pointer and To_Address are inverse operations.
- --
- --      Check that To_Pointer(X'Address) equals X'Unchecked_Access for an
- --      X that allows Unchecked_Access.
- --
- --      Check that To_Pointer(Null_Address) returns null.
- --
- -- TEST DESCRIPTION:
- --      This test checks that the semantics provided in
- --      Address_To_Access_Conversions are present and operate
- --      within expectations (to the best extent possible in a portable
- --      implementation independent fashion).
- --
- --      The functions Address_To_Hex and Hex_To_Address test the invertability
- --      of the To_Integer and To_Address functions, along with a great deal
- --      of optimizer chaff and protection from the fact that type
- --      Storage_Elements.Integer_Address may be either a modular or a signed
- --      integer type.
- --
- --      This test has some interesting usage paradigms in that users
- --      occasionally want to store address information in a transportable
- --      fashion, and often resort to some textual representation of values.  
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- -- CHANGE HISTORY:
- --      13 JUL 95   SAIC   Initial version (CD72001)
- --      08 FEB 96   SAIC   Revised (split) version for 2.1
- --      07 MAY 96   SAIC   Additional subtest added for 2.1
- --      16 FEB 98   EDS    Modified documentation.
- --!
- 
- with Report;
- with Impdef;
- with FD72A00;
- with System.Storage_Elements;
- with System.Address_To_Access_Conversions;
- procedure CD72A01 is
-   use System;
-   use FD72A00;
- 
-   package Number_ATAC is
-       new System.Address_To_Access_Conversions(Number); -- ANX-C RQMT
- 
-   use type Number_ATAC.Object_Pointer;
- 
-   type Data is record
-     One, Two: aliased Number;
-   end record;
- 
-   package Data_ATAC is
-       new System.Address_To_Access_Conversions(Data);   -- ANX-C RQMT
- 
-   use type Data_ATAC.Object_Pointer;
- 
-   type Test_Cases is ( Addr_Type, Record_Type );
- 
-   type Naive_Dynamic_String is access String;
- 
-   type String_Store is array(Test_Cases) of Naive_Dynamic_String;
- 
-   The_Strings : String_Store;
- 
-   -- create several aliased objects with distinct values
- 
-   My_Number : aliased Number := Number'First;
-   My_Data   : aliased Data   := (Number'First,Number'Last);
- 
-    use type System.Storage_Elements.Integer_Address;
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("CD72A01", "Check package " &
-                             "System.Address_To_Access_Conversions " &
-                             "for simple types" );
-   
-     -- take several pointer objects, convert them to addresses, and store
-     -- the address as a hexadecimal representation for later reconversion
- 
-     The_Strings(Addr_Type) := new String'(
-       Address_To_Hex(Number_ATAC.To_Address(My_Number'Access)) );
- 
-     The_Strings(Record_Type) := new String'(
-       Address_To_Hex(Data_ATAC.To_Address(My_Data'Access)) );
- 
-     -- now, reconvert the hexadecimal address values back to pointers,
-     -- and check that the dereferenced pointer still designates the
-     -- value placed at that location.  The use of the intermediate
-     -- string representation should foil even the cleverest of optimizers
- 
-     if Number_ATAC.To_Pointer(
-                              Hex_To_Address(The_Strings(Addr_Type))).all
-        /= Number'First then
-       Report.Failed("Number reconversion");
-     end if;
- 
-     if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type))).all
-        /= (Number'First,Number'Last) then
-       Report.Failed("Data reconversion");
-     end if;
- 
-     -- check that the resulting values are equal to the 'Unchecked_Access
-     -- of the value
- 
-     if Number_ATAC.To_Pointer(
-                              Hex_To_Address(The_Strings(Addr_Type)))
-        /= My_Number'Unchecked_Access then
-       Report.Failed("Number Unchecked_Access");
-     end if;
- 
-     if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type)))
-        /= My_Data'Unchecked_Access then
-       Report.Failed("Data Unchecked_Access");
-     end if;
- 
-    if Number_ATAC.To_Pointer(System.Null_Address) /= null then
-      Report.Failed("To_Pointer(Null_Address) /= null");
-    end if;
- 
-    if Number_ATAC.To_Address(null) /= System.Null_Address then
-      Report.Failed("To_Address(null) /= Null_Address");
-    end if;
- 
-    Report.Result;
- 
- end CD72A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd72a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd72a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd72a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd72a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,225 ****
- -- CD72A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the package System.Address_To_Access_Conversions may be
- --      instantiated for various composite types.
- --
- --      Check that To_Pointer and To_Address are inverse operations.
- --
- --      Check that To_Pointer(X'Address) equals X'Unchecked_Access for an
- --      X that allows Unchecked_Access.
- --
- --      Check that To_Pointer(Null_Address) returns null.
- --
- -- TEST DESCRIPTION:
- --      This test is identical to CD72A01 with the exception that it tests
- --      the composite types where CD72A01 tests "simple" types.
- --
- --      This test checks that the semantics provided in
- --      Address_To_Access_Conversions are present and operate
- --      within expectations (to the best extent possible in a portable
- --      implementation independent fashion).
- --
- --      The functions Address_To_Hex and Hex_To_Address test the invertability
- --      of the To_Integer and To_Address functions, along with a great deal
- --      of optimizer chaff and protection from the fact that type
- --      Storage_Elements.Integer_Address may be either a modular or a signed
- --      integer type.
- --
- --      This test has some interesting usage paradigms in that users
- --      occasionally want to store address information in a transportable
- --      fashion, and often resort to some textual representation of values.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      13 JUL 95   SAIC   Initial version (CD72001)
- --      08 FEB 96   SAIC   Split from CD72001 by reviewer request for 2.1
- --      12 NOV 96   SAIC   Corrected typo in RM ref
- --      16 FEB 98   EDS    Modified documentation.
- --      22 JAN 02   RLB    Corrected test description.
- --!
- 
- with Report;
- with Impdef;
- with FD72A00;
- with System.Storage_Elements;
- with System.Address_To_Access_Conversions;
- procedure CD72A02 is
-   use System;
-   use FD72A00;
- 
-    type Tagged_Record is tagged record
-       Value : Natural;
-     end record;
- 
-     package Class_ATAC is
-       new System.Address_To_Access_Conversions(Tagged_Record'Class);
-                                                         -- ANX-C RQMT
- 
-   use type Class_ATAC.Object_Pointer;
- 
-     task type TC_Task_Type is
-       entry E;
-       entry F;
-     end TC_Task_Type;
- 
-     package Task_ATAC is
-             new System.Address_To_Access_Conversions(TC_Task_Type);
-                                                         -- ANX-C RQMT
- 
-   use type Task_ATAC.Object_Pointer;
- 
-     task body TC_Task_Type is
-     begin
-       select
-         accept E;
-       or
-         accept F;
-           Report.Failed("Task rendezvoused on wrong path");
-       end select;
-     end TC_Task_Type;
- 
-     protected type TC_Protec is
-       procedure E;
-       procedure F;
-     private
-       Visited : Boolean := False;
-     end TC_Protec;
- 
-     package Protected_ATAC is
-             new System.Address_To_Access_Conversions(TC_Protec);
-                                                         -- ANX-C RQMT
- 
-   use type Protected_ATAC.Object_Pointer;
- 
-     protected body TC_Protec is
-       procedure E is
-       begin
-         Visited := True;
-       end E;
-       procedure F is
-       begin
-         if not Visited then
-           Report.Failed("Protected Object took wrong path");
-         end if;
-       end F;
-     end TC_Protec;
- 
-     type Test_Cases is ( Tagged_Type, Task_Type,  Protected_Type );
- 
-     type Naive_Dynamic_String is access String;
- 
-     type String_Store is array(Test_Cases) of Naive_Dynamic_String;
- 
-     The_Strings : String_Store;
- 
-     -- create several aliased objects with distinct values
- 
-     My_Rec  : aliased Tagged_Record := (Value => Natural'Last);
-     My_Task : aliased TC_Task_Type;
-     My_Prot : aliased TC_Protec;
- 
-     use type System.Storage_Elements.Integer_Address;
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("CD72A02", "Check package " &
-                             "System.Address_To_Access_Conversions " &
-                             "for composite types" );
- 
-     -- take several pointer objects, convert them to addresses, and store
-     -- the address as a hexadecimal representation for later reconversion
- 
-     The_Strings(Tagged_Type) := new String'(
-       Address_To_Hex(Class_ATAC.To_Address(My_Rec'Access)) );
- 
-     The_Strings(Task_Type) := new String'(
-       Address_To_Hex(Task_ATAC.To_Address(My_Task'Access)) );
- 
-     The_Strings(Protected_Type) := new String'(
-       Address_To_Hex(Protected_ATAC.To_Address(My_Prot'Access)) );
- 
-     -- now, reconvert the hexadecimal address values back to pointers,
-     -- and check that the dereferenced pointer still designates the
-     -- value placed at that location.  The use of the intermediate
-     -- string representation should foil even the cleverest of optimizers
- 
-     if Tagged_Record(Class_ATAC.To_Pointer(
-                               Hex_To_Address(The_Strings(Tagged_Type))).all)
-        /= Tagged_Record'(Value => Natural'Last) then
-       Report.Failed("Tagged_Record reconversion");
-     end if;
- 
-     Task_ATAC.To_Pointer(Hex_To_Address(The_Strings(Task_Type))).E;
- 
-     begin
-       select        -- allow for task to have completed.
-         My_Task.F;  -- should not happen, will call Report.Fail in task
-       else
-         null;       -- expected case, "Report.Pass;"
-       end select;
-     exception
-       when Tasking_Error => null;  -- task terminated, which is OK
-     end;
- 
-     Protected_ATAC.To_Pointer(
-                            Hex_To_Address(The_Strings(Protected_Type))).E;
-     My_Prot.F;    -- checks that call to E occurred
- 
- 
-     -- check that the resulting values are equal to the 'Unchecked_Access
-     -- of the value
- 
-     if Class_ATAC.To_Pointer(Hex_To_Address(The_Strings(Tagged_Type)))
-        /= My_Rec'Unchecked_Access then
-       Report.Failed("Tagged_Record Unchecked_Access");
-     end if;
- 
-     if Task_ATAC.To_Pointer(Hex_To_Address(The_Strings(Task_Type)))
-        /= My_Task'Unchecked_Access then
-       Report.Failed("Task Unchecked_Access");
-     end if;
- 
-     if Protected_ATAC.To_Pointer(
-                            Hex_To_Address(The_Strings(Protected_Type)))
-        /= My_Prot'Unchecked_Access then
-       Report.Failed("Protected Unchecked_Access");
-     end if;
- 
-   Report.Result;
- 
- end CD72A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7305a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd7305a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd7305a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- CD7305A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK, FOR DIGITS 5, THAT MACHINE_RADIX, MACHINE_MANTISSA,
- --     MACHINE_EMAX, AND MACHINE_EMIN HAVE THE CORRECT VALUES.
- 
- -- HISTORY:
- --     DHH 09/15/88  CREATED ORIGINAL TEST.
- --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE CD7305A IS
- 
-      TYPE T IS DIGITS 5;
- 
-      B : BOOLEAN := FALSE;
- 
- BEGIN
-      TEST ("CD7305A", "CHECK, FOR DIGITS 5, THAT MACHINE_RADIX, " &
-                       "MACHINE_MANTISSA, MACHINE_EMAX, AND " &
-                       "MACHINE_EMIN HAVE THE CORRECT VALUES");
- 
- 
-      IF T'MACHINE_RADIX < 2 OR
-         T'BASE'MACHINE_RADIX /= T'MACHINE_RADIX THEN
-           FAILED ("INCORRECT 'MACHINE_RADIX");
-      END IF;
- 
-      RESULT;
- END CD7305A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd90001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd90001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd90001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd90001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,234 ****
- -- CD90001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Unchecked_Conversion is supported and is reversible in
- --      the cases where:
- --        Source'Size = Target'Size
- --        Source'Alignment = Target'Alignment
- --        Source and Target are both represented contiguously
- --        Bit pattern in Source is a meaningful value of Target type
- --
- -- TEST DESCRIPTION:
- --      This test declares an enumeration type with a representation
- --      specification that should fit neatly into an 8 bit object; and a
- --      modular type that should also be able to fit easily into 8 bits;
- --      uses size representation clauses on both of them for 8 bit
- --      representations.  It then defines two instances of
- --      Unchecked_Conversion; to convert both ways between the types.
- --      Using several distinctive values, it checks that the conversions
- --      are performed, and reversible.
- --      As a second case, the above is performed with an integer type and
- --      a packed array of booleans.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      22 JUL 95   SAIC   Initial version
- --      07 MAY 96   SAIC   Changed Boolean to Character for 2.1
- --      27 JUL 96   SAIC   Allowed for partial N/A to be PASS
- --      14 FEB 97   PWB.CTA  Corrected "=" to "/=" in alignment check.
- --      16 FEB 98   EDS    Modified documentation.
- --      21 DEC 05   RLB    Corrected "=" to "/=" in other alignment check.
- --!
- 
- ----------------------------------------------------------------- CD90001_0
- 
- with Report;
- with Unchecked_Conversion;
- package CD90001_0 is
- 
-   -- Case 1 : Modular <=> Enumeration
- 
-   type Eight_Bits is mod 2**8;
-     for Eight_Bits'Size use 8;
- 
-   type User_Enums is ( One, Two, Four, Eight,
-                        Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
-     for User_Enums'Size use 8;
- 
-     for User_Enums use
-                     ( One              =>   1,                -- ANX-C RQMT.
-                       Two              =>   2,                -- ANX-C RQMT.
-                       Four             =>   4,                -- ANX-C RQMT.
-                       Eight            =>   8,                -- ANX-C RQMT.
-                       Sixteen          =>  16,                -- ANX-C RQMT.
-                       Thirty_Two       =>  32,                -- ANX-C RQMT.
-                       Sixty_Four       =>  64,                -- ANX-C RQMT.
-                       One_Twenty_Eight => 128 );              -- ANX-C RQMT.
- 
-   function EB_2_UE is new Unchecked_Conversion( Eight_Bits, User_Enums );
- 
-   function UE_2_EB is new Unchecked_Conversion( User_Enums, Eight_Bits );
- 
-   procedure TC_Check_Case_1;
- 
-   -- Case 2 : Integer <=> Packed Character array
- 
-   type Signed_16 is range -2**15+1 .. 2**15-1;
-   -- +1, -1 allows for both 1's and 2's comp
- 
-   type Bits_16 is array(0..1) of Character;
-   pragma Pack(Bits_16);                                       -- ANX-C RQMT.
- 
-   function S16_2_B16 is new Unchecked_Conversion( Signed_16, Bits_16 );
- 
-   function B16_2_S16 is new Unchecked_Conversion( Bits_16, Signed_16 );
- 
-   procedure TC_Check_Case_2;
- 
- end CD90001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body CD90001_0 is
- 
-   Check_List : constant array(1..8) of Eight_Bits
-              := ( 1, 2, 4, 8, 16, 32, 64, 128 );
- 
-   Check_Enum : constant array(1..8) of User_Enums
-              := ( One, Two, Four, Eight,
-                   Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
- 
-   procedure TC_Check_Case_1 is
-     Mod_Value : Eight_Bits;
-     Enum_Val  : User_Enums;
-   begin
-     for I in Check_List'Range loop
- 
-       if EB_2_UE(Check_List(I)) /= Check_Enum(I) then
-         Report.Failed("EB => UE conversion failed");
-       end if;
- 
-       if Check_List(I)          /= UE_2_EB(Check_Enum(I)) then
-         Report.Failed ("EU => EB conversion failed");
-       end if;
- 
-     end loop;
-   end TC_Check_Case_1;
- 
-   procedure TC_Check_Case_2 is
-     S: Signed_16;
-     T,U: Signed_16;
-     B: Bits_16;
-     C,D: Bits_16;  -- allow for byte swapping
-   begin
-          --FDEC_BA98_7654_3210
-     S := 2#0011_0000_0111_0111#;
-     B := S16_2_B16( S );
-     C := ( Character'Val(2#0011_0000#), Character'Val(2#0111_0111#) );
-     D := ( Character'Val(2#0111_0111#), Character'Val(2#0011_0000#) );
- 
-     if (B /= C) and (B /= D) then
-       Report.Failed("Int => Chararray conversion failed");
-     end if;
- 
-     B := ( Character'Val(2#0011_1100#), Character'Val(2#0101_0101#) );
-     S := B16_2_S16( B );
-     T := 2#0011_1100_0101_0101#;
-     U := 2#0101_0101_0011_1100#;
- 
-     if (S /= T) and (S /= U) then
-       Report.Failed("Chararray => Int conversion failed");
-     end if;
- 
-   end TC_Check_Case_2;
- 
- end CD90001_0;
- 
- ------------------------------------------------------------------- CD90001
- 
- with Report;
- with CD90001_0;
- 
- procedure CD90001 is
- 
-   Eight_NA   : Boolean := False;
-   Sixteen_NA : Boolean := False;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD90001", "Check that Unchecked_Conversion is supported " &
-                           "and is reversible in appropriate cases" );
-   Eight_Bit_Case:
-   begin
-     if CD90001_0.User_Enums'Size /= CD90001_0.Eight_Bits'Size then
-       Report.Comment("The sizes of the 8 bit types used in this test "
-                             & "do not match" );
-       Eight_NA := True;
-     elsif CD90001_0.User_Enums'Alignment /= CD90001_0.Eight_Bits'Alignment then
-       Report.Comment("The alignments of the 8 bit types used in this "
-                             & "test do not match" );
-       Eight_NA := True;
-     else
-       CD90001_0.TC_Check_Case_1;
-     end if;
- 
-   exception
-     when Constraint_Error =>
-            Report.Failed("Constraint_Error raised in 8 bit case");
-     when others           =>
-            Report.Failed("Unexpected exception raised in 8 bit case");
-   end Eight_Bit_Case;
- 
-   Sixteen_Bit_Case:
-   begin
-     if CD90001_0.Signed_16'Size /= CD90001_0.Bits_16'Size then
-       Report.Comment("The sizes of the 16 bit types used in this test "
-                             & "do not match" );
-       Sixteen_NA := True;
-     elsif CD90001_0.Signed_16'Alignment /= CD90001_0.Bits_16'Alignment then
-       Report.Comment("The alignments of the 16 bit types used in this "
-                             & "test do not match" );
-       Sixteen_NA := True;
-     else
-       CD90001_0.TC_Check_Case_2;
-     end if;
- 
-   exception
-     when Constraint_Error =>
-            Report.Failed("Constraint_Error raised in 16 bit case");
-     when others           =>
-            Report.Failed("Unexpected exception raised in 16 bit case");
-   end Sixteen_Bit_Case;
- 
-   if Eight_NA and Sixteen_NA then
-     Report.Not_Applicable("No cases in this test apply");
-   end if;
- 
-   Report.Result;
- 
- end CD90001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd92001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd92001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cd92001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cd92001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,229 ****
- -- CD92001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that if X denotes a scalar object, X'Valid
- --      yields true if an only if the object denoted by X is normal and
- --      has a valid representation.
- --
- -- TEST DESCRIPTION:
- --      Using Unchecked_Conversion, Image and Value attributes, combined
- --      with string manipulation, cause valid and invalid values to be
- --      stored in various objects.  Check their validity with the
- --      attribute 'Valid.  Invalid objects are created in a loop which
- --      performs a simplistic check to ensure that the values being used
- --      are indeed not valid, then assigns the value using an instance of
- --      Unchecked_Conversion.  The creation of the tables of valid values
- --      is trivial.
- --
- -- APPLICABILITY CRITERIA:
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Systems Programming Annex (C):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex C:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- N/A => ERROR", in which case it may be graded as
- --        inapplicable. Otherwise, the test must execute and report PASSED.
- --
- --
- -- CHANGE HISTORY:
- --      10 MAY 95   SAIC    Initial version
- --      07 MAY 96   SAIC    Changed U_C to Ada.U_C for 2.1
- --      05 JAN 99   RLB     Added Component_Size clauses to compensate
- --                          for the fact that there is no required size
- --                          for either the enumeration or modular components.
- --!
- 
- with Report;
- with Ada.Unchecked_Conversion;
- with System;
- procedure CD92001 is
- 
-   type Sparse_Enumerated is
-        ( Help, Home, Page_Up, Del, EndK,
-          Page_Down, Up, Left, Down, Right );
- 
-   for Sparse_Enumerated use ( Help      =>    2,
-                               Home      =>    4,
-                               Page_Up   =>    8,
-                               Del       =>   16,
-                               EndK      =>   32,
-                               Page_Down =>   64,
-                               Up        =>  128,
-                               Left      =>  256,
-                               Down      =>  512,
-                               Right     => 1024 );
- 
-   type Mod_10 is mod 10;
- 
-   type Default_Enumerated is ( Zero,  One, Two,   Three, Four,
-                                Five,  Six, Seven, Eight, Nine,
-                                Clear, '=', '/',   '*',   '-',
-                                '+',   Enter );
-     for Default_Enumerated'Size use 8;
- 
-   Default_Enumerated_Count : constant := 17;
- 
-   type Mod_By_Enum_Items is mod Default_Enumerated_Count;
- 
-   type Mod_Same_Size_As_Sparse_Enum is mod 2**12;
-                                         -- Sparse_Enumerated 'Size;
- 
-   type Mod_Same_Size_As_Def_Enum is mod 2**8;
-                                      -- Default_Enumerated'Size;
- 
-   subtype Test_Width is Positive range 1..100;
- 
-   -- Note: There is no required relationship between 'Size and 'Component_Size,
-   -- so we must use component_size clauses here.
-   -- We use the following expressions to insure that the component size is a
-   -- multiple of the Storage_Unit.
-   Sparse_Component_Size : constant := ((Sparse_Enumerated'Size / System.Storage_Unit) +
-         Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) *
-         System.Storage_Unit;
-   Default_Component_Size : constant := ((Default_Enumerated'Size / System.Storage_Unit) +
-         Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) *
-         System.Storage_Unit;
- 
-   type Sparse_Enum_Table is array(Test_Width) of Sparse_Enumerated;
-   for Sparse_Enum_Table'Component_Size use Sparse_Component_Size;  -- N/A => ERROR.
-   type Def_Enum_Table is array(Test_Width) of Default_Enumerated;
-   for Def_Enum_Table'Component_Size use Default_Component_Size;  -- N/A => ERROR.
- 
-   type Sparse_Mod_Table  is
-        array(Test_Width) of Mod_Same_Size_As_Sparse_Enum;
-   for Sparse_Mod_Table'Component_Size use Sparse_Component_Size;  -- N/A => ERROR.
- 
-   type Default_Mod_Table is
-        array(Test_Width) of Mod_Same_Size_As_Def_Enum;
-   for Default_Mod_Table'Component_Size use Default_Component_Size;  -- N/A => ERROR.
- 
-   function UC_Sparse_Mod_Enum is
-     new Ada.Unchecked_Conversion( Sparse_Mod_Table, Sparse_Enum_Table );
- 
-   function UC_Def_Mod_Enum is
-     new Ada.Unchecked_Conversion( Default_Mod_Table, Def_Enum_Table );
- 
-   Valid_Sparse_Values : Sparse_Enum_Table;
-   Valid_Def_Values    : Def_Enum_Table;
- 
-   Sample_Enum_Value_Table : Sparse_Mod_Table;
-   Sample_Def_Value_Table  : Default_Mod_Table;
- 
- 
-   -- fill the Valid tables with valid values for conversion
-   procedure Fill_Valid is
-     K : Mod_10 := 0;
-     P : Mod_By_Enum_Items := 0;
-   begin
-     for I in Test_Width loop
-       Valid_Sparse_Values(I) := Sparse_Enumerated'Val( K );
-       Valid_Def_Values(I)    := Default_Enumerated'Val( Integer(P) );
-       K := K +1;
-       P := P +1;
-     end loop;
-   end Fill_Valid;
- 
-   -- fill the Sample tables with invalid values for conversion
-   procedure Fill_Invalid is
-     K : Mod_Same_Size_As_Sparse_Enum := 1;
-     P : Mod_Same_Size_As_Def_Enum    := 1;
-   begin
-     for I in Test_Width loop
-       K := K +13;
-       if K mod 2 = 0 then  -- oops, that would be a valid value
-         K := K +1;
-       end if;
-       if P = Mod_Same_Size_As_Def_Enum'Last
-          or P < Default_Enumerated_Count then -- that would be valid
-         P := Default_Enumerated_Count + 1;
-       else
-         P := P +1;
-       end if;
-       Sample_Enum_Value_Table(I) := K;
-       Sample_Def_Value_Table(I)  := P;
-     end loop;
- 
-     Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table);
-     Valid_Def_Values    := UC_Def_Mod_Enum(Sample_Def_Value_Table);
- 
-   end Fill_Invalid;
- 
-   -- fill the tables with second set of valid values for conversion
-   procedure Refill_Valid is
-     K : Mod_10 := 0;
-     P : Mod_By_Enum_Items := 0;
- 
-     Table : Array(Mod_10) of Mod_Same_Size_As_Sparse_Enum
-           := ( 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024 );
- 
-   begin
-     for I in Test_Width loop
-       Sample_Enum_Value_Table(I) := Table(K);
-       Sample_Def_Value_Table(I)  := Mod_Same_Size_As_Def_Enum(P);
-       K := K +1;
-       P := P +1;
-     end loop;
-     Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table);
-     Valid_Def_Values    := UC_Def_Mod_Enum(Sample_Def_Value_Table);
-   end Refill_Valid;
- 
-   procedure Validate(Expect_Valid: Boolean) is
-   begin  -- here's where we actually use the tested attribute
- 
-     for K in Test_Width loop
-       if Valid_Sparse_Values(K)'Valid /= Expect_Valid then
-         Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid)
-                     & " for Sparse item " & Integer'Image(K) );
-       end if;
-     end loop;
- 
-     for P in Test_Width loop
-       if Valid_Def_Values(P)'Valid /= Expect_Valid then
-         Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid)
-                     & " for Default item " & Integer'Image(P) );
-       end if;
-     end loop;
- 
-   end Validate;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CD92001", "Check object attribute: X'Valid" );
-    
-   Fill_Valid;
-   Validate(True);
- 
-   Fill_Invalid;
-   Validate(False);
- 
-   Refill_Valid;
-   Validate(True);
- 
-   Report.Result;
- 
- end CD92001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- CDA201A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNCHECKED_CONVERSION CAN BE INSTANTIATED FOR
- --     CONVERSION BETWEEN INTEGER AND BOOLEAN ARRAY TYPES.
- 
- -- HISTORY:
- --     JET 09/12/88  CREATED ORIGINAL TEST.
- --     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
- 
- WITH REPORT; USE REPORT;
- WITH UNCHECKED_CONVERSION;
- PROCEDURE CDA201A IS
- 
-      TYPE BOOL_ARR IS ARRAY (1..INTEGER'SIZE) OF BOOLEAN;
-      PRAGMA PACK (BOOL_ARR);
- 
-      I : INTEGER;
-      B : BOOL_ARR;
- 
-      FUNCTION INT_TO_BOOL IS NEW
-                                UNCHECKED_CONVERSION (INTEGER, BOOL_ARR);
- 
-      FUNCTION BOOL_TO_INT IS NEW UNCHECKED_CONVERSION(BOOL_ARR,INTEGER);
- 
- BEGIN
-      TEST ("CDA201A", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
-                       "INSTANTIATED FOR CONVERSION BETWEEN " &
-                       "INTEGER AND BOOLEAN ARRAY TYPES");
- 
-      I := BOOL_TO_INT((1..INTEGER'SIZE => IDENT_BOOL(TRUE)));
- 
-      IF INT_TO_BOOL(IDENT_INT(I)) /= (1..INTEGER'SIZE => TRUE) THEN
-           FAILED("INCORRECT RESULT FROM ARRAY-INTEGER-ARRAY");
-      END IF;
- 
-      B := INT_TO_BOOL(IDENT_INT(-1));
- 
-      FOR J IN B'RANGE LOOP
-           B(J) := IDENT_BOOL(B(J));
-      END LOOP;
- 
-      IF BOOL_TO_INT(B) /= -1 THEN
-           FAILED("INCORRECT RESULT FROM INTEGER-ARRAY-INTEGER");
-      END IF;
- 
-      RESULT;
- END CDA201A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- CDA201B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNCHECKED_CONVERSION CAN BE INSTANTIATED FOR
- --     CONVERSION BETWEEN FLOAT AND BOOLEAN ARRAY TYPES.
- 
- -- HISTORY:
- --     JET 09/12/88  CREATED ORIGINAL TEST.
- --     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
- --     GJD 11/15/95  REMOVED USE OF OBSOLETE ADA 83 ATTRIBUTE (LARGE).
- 
- WITH REPORT; USE REPORT;
- WITH UNCHECKED_CONVERSION;
- PROCEDURE CDA201B IS
- 
-      TYPE BOOL_ARR IS ARRAY (1..FLOAT'SIZE) OF BOOLEAN;
-      PRAGMA PACK (BOOL_ARR);
- 
-      B : BOOL_ARR;
- 
-      FUNCTION FLT_TO_BOOL IS NEW UNCHECKED_CONVERSION(FLOAT, BOOL_ARR);
- 
-      FUNCTION BOOL_TO_FLT IS NEW UNCHECKED_CONVERSION(BOOL_ARR, FLOAT);
- 
- BEGIN
-      TEST ("CDA201B", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
-                       "INSTANTIATED FOR CONVERSION BETWEEN " &
-                       "FLOAT AND BOOLEAN ARRAY TYPES");
- 
-      B := FLT_TO_BOOL(FLOAT'LAST + FLOAT(IDENT_INT(0)));
- 
-      FOR J IN B'RANGE LOOP
-           B(J) := B(J+IDENT_INT(0));
-      END LOOP;
- 
-      IF BOOL_TO_FLT(B) /= FLOAT'LAST THEN
-           FAILED("INCORRECT RESULT FROM FLOAT-ARRAY-FLOAT");
-      END IF;
- 
-      RESULT;
- END CDA201B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CDA201C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNCHECKED_CONVERSION CAN BE INSTANTIATED FOR
- --     CONVERSION BETWEEN CONSTRAINED ARRAY AND RECORD TYPES.
- 
- -- HISTORY:
- --     JET 09/12/88  CREATED ORIGINAL TEST.
- --     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
- 
- WITH REPORT; USE REPORT;
- WITH UNCHECKED_CONVERSION;
- PROCEDURE CDA201C IS
- 
-      TYPE INT IS NEW INTEGER;
- 
-      TYPE ARR IS ARRAY (1..2) OF INTEGER;
-      TYPE ARR2 IS ARRAY (ARR'RANGE) OF INT;
- 
-      TYPE REC IS RECORD
-           D : INTEGER;
-           I : INTEGER;
-      END RECORD;
- 
-      TYPE REC2 IS RECORD
-           D : INT;
-           I : INT;
-      END RECORD;
- 
-      A : ARR2;
-      R : REC2;
- 
-      FUNCTION ARR_CONV IS NEW UNCHECKED_CONVERSION(ARR, ARR2);
-      FUNCTION REC_CONV IS NEW UNCHECKED_CONVERSION(REC, REC2);
- 
- BEGIN
-      TEST ("CDA201C", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
-                       "INSTANTIATED FOR CONVERSION BETWEEN " &
-                       "CONSTRAINED ARRAY AND RECORD TYPES");
- 
-      A := ARR_CONV(ARR'(ARR'RANGE => IDENT_INT(-1)));
- 
-      IF A /= ARR2'(ARR'RANGE => -1) THEN
-           FAILED("INCORRECT RESULT FROM ARRAY CONVERSION");
-      END IF;
- 
-      R := REC_CONV(REC'(D | I => IDENT_INT(1)));
- 
-      IF R /= REC2'(D => 1, I => 1) THEN
-           FAILED("INCORRECT RESULT FROM RECORD CONVERSION");
-      END IF;
- 
-      RESULT;
- END CDA201C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cda201e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cda201e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- CDA201E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNCHECKED_CONVERSION CAN BE INSTANTIATED FOR THE
- --     CONVERSION OF AN ENUMERATION TYPE WITH A REPRESENTATION CLAUSE TO
- --     INTEGER.
- 
- -- HISTORY:
- --     JET 09/23/88  CREATED ORIGINAL TEST.
- --     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
- --     RJW 02/28/90  ADDED SIZE CLAUSE FOR TYPE STOOGE.
- --     LDC 09/20/90  ADDED CHECK FOR CONVERSION FROM INT TO STOOGE,
- --                   ADDED COMMENT WHEN SIZES AREN'T EQUAL.
- 
- WITH REPORT; USE REPORT;
- WITH UNCHECKED_CONVERSION;
- PROCEDURE CDA201E IS
- 
-      TYPE STOOGE IS (CURLY, MOE, LARRY);
-      FOR STOOGE USE (CURLY => -5, MOE => 13, LARRY => 127);
-      FOR STOOGE'SIZE USE 8;
- 
-      TYPE INT IS RANGE -128 .. 127;
-      FOR INT'SIZE USE 8;
- 
-      I    : INT := 0;
-      NAME : STOOGE := CURLY;
- 
-      FUNCTION E_TO_I IS NEW UNCHECKED_CONVERSION(STOOGE, INT);
-      FUNCTION I_TO_E IS NEW UNCHECKED_CONVERSION(INT, STOOGE);
- 
-      FUNCTION ID(E : STOOGE) RETURN STOOGE IS
-      BEGIN
-           RETURN STOOGE'VAL(STOOGE'POS(E) + IDENT_INT(0));
-      END ID;
- 
-      FUNCTION ID_INT (X : INT) RETURN INT IS
-           A : INTEGER := IDENT_INT(3);
-      BEGIN
-           IF EQUAL (A, IDENT_INT(3)) THEN    -- ALWAYS EQUAL.
-                RETURN X;                     -- ALWAYS EXECUTED.
-           END IF;
-           RETURN 0;                          -- NEVER EXECUTED.
-      END ID_INT;
- 
- BEGIN
-      TEST ("CDA201E", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
-                       "INSTANTIATED FOR THE CONVERSION OF AN " &
-                       "ENUMERATION TYPE WITH A REPRESENTATION " &
-                       "CLAUSE TO INTEGER");
- 
-      IF I'SIZE /= NAME'SIZE THEN
-           COMMENT( "UNCHECKED_CONVERSION MIGHT BE INSTANTIATED WITH " &
-                    "DIFFERNT SIZES");
-      END IF;
- 
-      BEGIN
-           I := E_TO_I(ID(CURLY));
-           IF I /= -5 THEN
-                FAILED ("INCORRECT VALUE OF CURLY: " & INT'IMAGE(I));
-           END IF;
- 
-           I := E_TO_I(ID(MOE));
-           IF I /= 13 THEN
-                FAILED ("INCORRECT VALUE OF MOE: " & INT'IMAGE(I));
-           END IF;
- 
-           I := E_TO_I(ID(LARRY));
-           IF I /= 127 THEN
-                FAILED ("INCORRECT VALUE OF LARRY: " & INT'IMAGE(I));
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED BY CONVERSION");
-      END;
- 
-      BEGIN     -- 2
-           NAME := I_TO_E(ID_INT(-5));
-           IF NAME /= CURLY THEN
-                FAILED ("INCORRECT VALUE OF -5 : " & STOOGE'IMAGE(NAME));
-           END IF;
- 
-           NAME := I_TO_E(ID_INT(13));
-           IF NAME /= MOE THEN
-                FAILED ("INCORRECT VALUE OF 13: " & STOOGE'IMAGE(NAME));
-           END IF;
- 
-           NAME := I_TO_E(ID_INT(127));
-           IF NAME /= LARRY THEN
-                FAILED ("INCORRECT VALUE OF 127: " & STOOGE'IMAGE(NAME));
-           END IF;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED BY CONVERSION - 2");
-      END;
- 
-      RESULT;
- END CDA201E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdb0a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdb0a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdb0a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdb0a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,305 ****
- -- CDB0A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a storage pool may be user_determined, and that storage
- --      is allocated by calling Allocate.
- --
- --      Check that a storage.pool may be specified using 'Storage_Pool
- --      and that S'Storage_Pool denotes the storage pool of the type S.
- --
- -- TEST DESCRIPTION:
- --      The package System.Storage_Pools is exercised by two very similar
- --      packages which define a tree type and exercise it in a simple manner.
- --      One package uses a user defined pool.  The other package uses a
- --      storage pool assigned by the implementation; Storage_Size is
- --      specified for this pool.
- --      The dispatching procedures Allocate and Deallocate are tested as an
- --      intentional side effect of the tree packages.
- --
- --      For completeness, the actions of the tree packages are checked for
- --      correct operation.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FDB0A00.A   (foundation code)
- --         CDB0A01.A
- --
- --
- -- CHANGE HISTORY:
- --      02 JUN 95   SAIC   Initial version
- --      07 MAY 96   SAIC   Removed ambiguity with CDB0A02
- --      13 FEB 97   PWB.CTA Corrected lexically ordered string literal
- --!
- 
- ---------------------------------------------------------------- CDB0A01_1
- 
- ---------------------------------------------------------- FDB0A00.Pool1
- 
- package FDB0A00.Pool1 is
-   User_Pool : Stack_Heap( 5_000 );
- end FDB0A00.Pool1;
- 
- ---------------------------------------------------------- FDB0A00.Comparator
- 
- with System.Storage_Pools;
- package FDB0A00.Comparator is
- 
-   function "="( A,B : System.Storage_Pools.Root_Storage_Pool'Class )
-            return Boolean;
- 
- end FDB0A00.Comparator;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- package body FDB0A00.Comparator is
- 
-   function "="( A,B : System.Storage_Pools.Root_Storage_Pool'Class )
-            return Boolean is
-     use type System.Address;
-   begin
-     return A'Address = B'Address;
-   end "=";
- 
- end FDB0A00.Comparator;
- 
- ---------------------------------------------------------------- CDB0A01_2
- 
- with FDB0A00.Pool1;
- package CDB0A01_2 is
- 
-   type Cell;
-   type User_Pool_Tree is access Cell;
- 
-   for User_Pool_Tree'Storage_Pool use FDB0A00.Pool1.User_Pool;
- 
-   type Cell is record
-     Data : Character;
-     Left,Right : User_Pool_Tree;
-   end record;
- 
-   procedure Insert( Item: Character; On_Tree : in out User_Pool_Tree );
- 
-   procedure Traverse( The_Tree : User_Pool_Tree );
- 
-   procedure Defoliate( The_Tree : in out User_Pool_Tree );
- 
- end CDB0A01_2;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- with Unchecked_Deallocation;
- package body CDB0A01_2 is
-   procedure Deallocate is new Unchecked_Deallocation(Cell,User_Pool_Tree);
- 
-   -- Sort: zeros on the left, ones on the right...
-   procedure Insert( Item: Character; On_Tree : in out User_Pool_Tree ) is
-   begin
-     if On_Tree = null then
-       On_Tree := new Cell'(Item,null,null); 
-     elsif Item > On_Tree.Data then
-       Insert(Item,On_Tree.Right);
-     else
-       Insert(Item,On_Tree.Left);  
-     end if;
-   end Insert;
- 
-   procedure Traverse( The_Tree : User_Pool_Tree ) is
-   begin
-     if The_Tree = null then
-       null;  -- how very symmetrical
-     else
-       Traverse(The_Tree.Left);
-       TCTouch.Touch(The_Tree.Data);
-       Traverse(The_Tree.Right);
-     end if;
-   end Traverse;
- 
-   procedure Defoliate( The_Tree : in out User_Pool_Tree ) is
-   begin
- 
-     if The_Tree.Left /= null then
-       Defoliate(The_Tree.Left);
-     end if;
- 
-     if The_Tree.Right /= null then
-       Defoliate(The_Tree.Right);
-     end if;
- 
-     Deallocate(The_Tree);
- 
-   end Defoliate;
- 
- end CDB0A01_2;
- 
- ---------------------------------------------------------------- CDB0A01_3
- 
- with FDB0A00.Pool1;
- package CDB0A01_3 is
- 
-   type Cell;
-   type System_Pool_Tree is access Cell;
- 
-   for System_Pool_Tree'Storage_Size use 2000;
- 
-   -- assumptions: Cell is <= 20 storage_units
-   --              Tree building exercise requires O(15) cells
-   --              2000 > 20 * 15 by a generous margin
- 
-   type Cell is record
-     Data: Character;
-     Left,Right : System_Pool_Tree;
-   end record;
- 
-   procedure Insert( Item: Character; On_Tree : in out System_Pool_Tree );
- 
-   procedure Traverse( The_Tree : System_Pool_Tree );
- 
-   procedure Defoliate( The_Tree : in out System_Pool_Tree );
- 
- end CDB0A01_3;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- with Unchecked_Deallocation;
- package body CDB0A01_3 is
-   procedure Deallocate is new Unchecked_Deallocation(Cell,System_Pool_Tree);
- 
-   -- Sort: zeros on the left, ones on the right...
-   procedure Insert( Item: Character; On_Tree : in out System_Pool_Tree ) is
-   begin
-     if On_Tree = null then
-       On_Tree := new Cell'(Item,null,null);
-     elsif Item > On_Tree.Data then
-       Insert(Item,On_Tree.Right);
-     else
-       Insert(Item,On_Tree.Left);  
-     end if;
-   end Insert;
- 
-   procedure Traverse( The_Tree : System_Pool_Tree ) is
-   begin
-     if The_Tree = null then
-       null;  -- how very symmetrical
-     else
-       Traverse(The_Tree.Left);
-       TCTouch.Touch(The_Tree.Data);
-       Traverse(The_Tree.Right);
-     end if;
-   end Traverse;
- 
-   procedure Defoliate( The_Tree : in out System_Pool_Tree ) is
-   begin
- 
-     if The_Tree.Left /= null then
-       Defoliate(The_Tree.Left);
-     end if;
- 
-     if The_Tree.Right /= null then
-       Defoliate(The_Tree.Right);
-     end if;
- 
-     Deallocate(The_Tree);
- 
-   end Defoliate;
- 
- end CDB0A01_3;
- 
- ------------------------------------------------------------------ CDB0A01
- 
- with Report;
- with TCTouch;
- with FDB0A00.Comparator;
- with FDB0A00.Pool1;
- with CDB0A01_2;
- with CDB0A01_3;
- 
- procedure CDB0A01 is
- 
-   Banyan : CDB0A01_2.User_Pool_Tree;
-   Torrey : CDB0A01_3.System_Pool_Tree;
- 
-   use type CDB0A01_2.User_Pool_Tree;
-   use type CDB0A01_3.System_Pool_Tree;
- 
-   Countess     : constant String := "Ada Augusta Lovelace";
-   Cenosstu     : constant String := "  AALaaacdeeglostuuv";
-   Insertion    : constant String := "AAAAAAAAAAAAAAAAAAAA";
-   Deallocation : constant String := "DDDDDDDDDDDDDDDDDDDD";
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("CDB0A01", "Check that a storage pool may be " &
-                            "user_determined, and that storage is " &
-                            "allocated by calling Allocate.  Check that " &
-                            "a storage.pool may be specified using " &
-                            "'Storage_Pool and that S'Storage_Pool denotes " &
-                            "the storage pool of the type S" );
- 
- --      Check that S'Storage_Pool denotes the storage pool for the type S.
- 
-   TCTouch.Assert(
-      FDB0A00.Comparator."="(FDB0A00.Pool1.User_Pool,
-                             CDB0A01_2.User_Pool_Tree'Storage_Pool ),
-      "'Storage_Pool not correct for CDB0A01_2.User_Pool_Tree");
- 
-   TCTouch.Assert_Not(
-      FDB0A00.Comparator."="(FDB0A00.Pool1.User_Pool,
-                             CDB0A01_3.System_Pool_Tree'Storage_Pool ),
-      "'Storage_Pool not correct for CDB0A01_3.System_Pool_Tree");
- 
- --      Check that storage is allocated by calling Allocate.
- 
-   for Count in Countess'Range loop
-     CDB0A01_2.Insert( Countess(Count), Banyan );
-   end loop;
-   TCTouch.Validate(Insertion, "Allocate calls via CDB0A01_2" ); 
- 
-   for Count in Countess'Range loop
-     CDB0A01_3.Insert( Countess(Count), Torrey );
-   end loop;
-   TCTouch.Validate("", "Allocate calls via CDB0A01_3" ); 
- 
-   CDB0A01_2.Traverse(Banyan);
-   TCTouch.Validate(Cenosstu, "Traversal of Banyan" );
- 
-   CDB0A01_3.Traverse(Torrey);
-   TCTouch.Validate(Cenosstu, "Traversal of Torrey" );
- 
-   CDB0A01_2.Defoliate(Banyan);
-   TCTouch.Validate(Deallocation, "Deforestation of Banyan" );
-   TCTouch.Assert(Banyan = null, "Banyan Deallocation result not null");
- 
-   CDB0A01_3.Defoliate(Torrey);
-   TCTouch.Validate("", "Deforestation of Torrey" );
-   TCTouch.Assert(Torrey = null, "Torrey Deallocation result not null");
- 
-   Report.Result;
- 
- end CDB0A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdb0a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdb0a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdb0a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdb0a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,329 ****
- -- CDB0A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that several access types can share the same pool.
- --
- --      Check that any exception propagated by Allocate is
- --      propagated by the allocator.
- --
- --      Check that for an access type S, S'Max_Size_In_Storage_Elements
- --      denotes the maximum values for Size_In_Storage_Elements that will
- --      be requested via Allocate.
- --
- -- TEST DESCRIPTION:
- --      After checking correct operation of the tree packages, the limits of
- --      the storage pools (first the shared user defined storage pool, then
- --      the system storage pool) are intentionally exceeded.  The test checks
- --      that the correct exception is raised.
- --
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FDB0A00.A   (foundation code)
- --         CDB0A02.A
- --
- --
- -- CHANGE HISTORY:
- --      10 AUG 95   SAIC   Initial version
- --      07 MAY 96   SAIC   Disambiguated for 2.1
- --      13 FEB 97   PWB.CTA  Reduced minimum allowable
- --                           Max_Size_In_Storage_Units, for implementations
- --                           with larger storage units
- --      25 JAN 01   RLB    Removed dubious checks on Max_Size_In_Storage_Units;
- --                         tightened important one.
- 
- --!
- 
- ---------------------------------------------------------- FDB0A00.Pool2
- 
- package FDB0A00.Pool2 is
-   Pond : Stack_Heap( 5_000 );
- end FDB0A00.Pool2;
- 
- ---------------------------------------------------------------- CDB0A02_2
- 
- with FDB0A00.Pool2;
- package CDB0A02_2 is
- 
-   type Small_Cell;
-   type Small_Tree is access Small_Cell;
- 
-   for Small_Tree'Storage_Pool use FDB0A00.Pool2.Pond;  -- first usage
- 
-   type Small_Cell is record
-     Data: Character;
-     Left,Right : Small_Tree;
-   end record;
- 
-   procedure Insert( Item: Character; On_Tree : in out Small_Tree );
- 
-   procedure Traverse( The_Tree : Small_Tree );
- 
-   procedure Defoliate( The_Tree : in out Small_Tree );
- 
-   procedure TC_Exceed_Pool;
- 
-   Pool_Max_Elements : constant := 6000;
-                       -- to guarantee overflow in TC_Exceed_Pool
- 
- end CDB0A02_2;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- with Report;
- with Unchecked_Deallocation;
- package body CDB0A02_2 is
-   procedure Deallocate is new Unchecked_Deallocation(Small_Cell,Small_Tree);
- 
-   -- Sort: zeros on the left, ones on the right...
-   procedure Insert( Item: Character; On_Tree : in out Small_Tree ) is
-   begin
-     if On_Tree = null then
-       On_Tree := new Small_Cell'(Item,null,null);
-     elsif Item > On_Tree.Data then
-       Insert(Item,On_Tree.Right);
-     else
-       Insert(Item,On_Tree.Left);
-     end if;
-   end Insert;
- 
-   procedure Traverse( The_Tree : Small_Tree ) is
-   begin
-     if The_Tree = null then
-       null;  -- how very symmetrical
-     else
-       Traverse(The_Tree.Left);
-       TCTouch.Touch(The_Tree.Data);
-       Traverse(The_Tree.Right);
-     end if;
-   end Traverse;
- 
-   procedure Defoliate( The_Tree : in out Small_Tree ) is
-   begin
- 
-     if The_Tree.Left /= null then
-       Defoliate(The_Tree.Left);
-     end if;
- 
-     if The_Tree.Right /= null then
-       Defoliate(The_Tree.Right);
-     end if;
- 
-     Deallocate(The_Tree);
- 
-   end Defoliate;
- 
-   procedure TC_Exceed_Pool is
-     Wild_Branch : Small_Tree;
-   begin
-     for Ever in 1..Pool_Max_Elements loop
-        Wild_Branch := new Small_Cell'('a', Wild_Branch, Wild_Branch);
-        TCTouch.Validate("A","Allocating element for overflow");
-     end loop;
-     Report.Failed(" Pool_Overflow not raised on exceeding user pool size");
-   exception
-     when FDB0A00.Pool_Overflow => null; -- anticipated case
-     when others =>
-       Report.Failed("wrong exception raised in user Exceed_Pool");
-   end TC_Exceed_Pool;
- 
- end CDB0A02_2;
- 
- ---------------------------------------------------------------- CDB0A02_3
- 
- -- This package is essentially identical to CDB0A02_2, except that the size
- -- of a cell is significantly larger.  This is used to check that different
- -- access types may share a single pool
- 
- with FDB0A00.Pool2;
- package CDB0A02_3 is
- 
-   type Large_Cell;
-   type Large_Tree is access Large_Cell;
- 
-   for Large_Tree'Storage_Pool use FDB0A00.Pool2.Pond;  -- second usage
- 
-   type Large_Cell is record
-     Data: Character;
-     Extra_Data : String(1..2);
-     Left,Right : Large_Tree;
-   end record;
- 
-   procedure Insert( Item: Character; On_Tree : in out Large_Tree );
- 
-   procedure Traverse( The_Tree : Large_Tree );
- 
-   procedure Defoliate( The_Tree : in out Large_Tree );
- 
- end CDB0A02_3;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with TCTouch;
- with Unchecked_Deallocation;
- package body CDB0A02_3 is
-   procedure Deallocate is new Unchecked_Deallocation(Large_Cell,Large_Tree);
- 
-   -- Sort: zeros on the left, ones on the right...
-   procedure Insert( Item: Character; On_Tree : in out Large_Tree ) is
-   begin
-     if On_Tree = null then
-       On_Tree := new Large_Cell'(Item,(Item,Item),null,null);
-     elsif Item > On_Tree.Data then
-       Insert(Item,On_Tree.Right);
-     else
-       Insert(Item,On_Tree.Left);
-     end if;
-   end Insert;
- 
-   procedure Traverse( The_Tree : Large_Tree ) is
-   begin
-     if The_Tree = null then
-       null;  -- how very symmetrical
-     else
-       Traverse(The_Tree.Left);
-       TCTouch.Touch(The_Tree.Data);
-       Traverse(The_Tree.Right);
-     end if;
-   end Traverse;
- 
-   procedure Defoliate( The_Tree : in out Large_Tree ) is
-   begin
- 
-     if The_Tree.Left /= null then
-       Defoliate(The_Tree.Left);
-     end if;
- 
-     if The_Tree.Right /= null then
-       Defoliate(The_Tree.Right);
-     end if;
- 
-     Deallocate(The_Tree);
- 
-  end Defoliate;
- 
- end CDB0A02_3;
- 
- ------------------------------------------------------------------ CDB0A02
- 
- with Report;
- with TCTouch;
- with System.Storage_Elements;
- with CDB0A02_2;
- with CDB0A02_3;
- with FDB0A00;
- 
- procedure CDB0A02 is
- 
-   Banyan : CDB0A02_2.Small_Tree;
-   Torrey : CDB0A02_3.Large_Tree;
- 
-   use type CDB0A02_2.Small_Tree;
-   use type CDB0A02_3.Large_Tree;
- 
-   Countess1    : constant String := "Ada ";
-   Countess2    : constant String := "Augusta ";
-   Countess3    : constant String := "Lovelace";
-   Cenosstu     : constant String := "  AALaaacdeeglostuuv";
-   Insertion    : constant String := "AAAAAAAAAAAAAAAAAAAA"
-                                   & "AAAAAAAAAAAAAAAAAAAA";
-   Deallocation : constant String := "DDDDDDDDDDDDDDDDDDDD";
- 
- begin  -- Main test procedure.
- 
-    Report.Test ("CDB0A02", "Check that several access types can share " &
-                            "the same pool.  Check that any exception " &
-                            "propagated by Allocate is propagated by the " &
-                            "allocator.  Check that for an access type S, " &
-                            "S'Max_Size_In_Storage_Elements denotes the " &
-                            "maximum values for Size_In_Storage_Elements " &
-                            "that will be requested via Allocate" );
- 
-   -- Check that access types can share the same pool.
- 
-   for Count in Countess1'Range loop
-     CDB0A02_2.Insert( Countess1(Count), Banyan );
-   end loop;
- 
-   for Count in Countess1'Range loop
-     CDB0A02_3.Insert( Countess1(Count), Torrey );
-   end loop;
- 
-   for Count in Countess2'Range loop
-     CDB0A02_2.Insert( Countess2(Count), Banyan );
-   end loop;
- 
-   for Count in Countess2'Range loop
-     CDB0A02_3.Insert( Countess2(Count), Torrey );
-   end loop;
- 
-   for Count in Countess3'Range loop
-     CDB0A02_2.Insert( Countess3(Count), Banyan );
-   end loop;
- 
-   for Count in Countess3'Range loop
-     CDB0A02_3.Insert( Countess3(Count), Torrey );
-   end loop;
- 
-   TCTouch.Validate(Insertion, "Allocate calls via CDB0A02_2" );
- 
- 
-   CDB0A02_2.Traverse(Banyan);
-   TCTouch.Validate(Cenosstu, "Traversal of Banyan" );
- 
-   CDB0A02_3.Traverse(Torrey);
-   TCTouch.Validate(Cenosstu, "Traversal of Torrey" );
- 
-   CDB0A02_2.Defoliate(Banyan);
-   TCTouch.Validate(Deallocation, "Deforestation of Banyan" );
-   TCTouch.Assert(Banyan = null, "Banyan Deallocation result not null");
- 
-   CDB0A02_3.Defoliate(Torrey);
-   TCTouch.Validate(Deallocation, "Deforestation of Torrey" );
-   TCTouch.Assert(Torrey = null, "Torrey Deallocation result not null");
- 
-   -- Check that for an access type S, S'Max_Size_In_Storage_Elements
-   -- denotes the maximum values for Size_In_Storage_Elements that will
-   -- be requested via Allocate. (Of course, all we can do is check that
-   -- whatever was requested of Allocate did not exceed the values of the
-   -- attributes.)
- 
-   TCTouch.Assert( FDB0A00.TC_Largest_Request in 1 ..
-                   System.Storage_Elements.Storage_Count'Max (
-                     CDB0A02_2.Small_Cell'Max_Size_In_Storage_Elements,
-                     CDB0A02_3.Large_Cell'Max_Size_In_Storage_Elements),
-                   "An object of excessive size was allocated.  Size: "
-    & System.Storage_Elements.Storage_Count'Image(FDB0A00.TC_Largest_Request));
- 
-   -- Check that an exception raised in Allocate is propagated by the allocator.
- 
-   CDB0A02_2.TC_Exceed_Pool;
- 
-   Report.Result;
- 
- end CDB0A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd1001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd1001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd1001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd1001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- CDD1001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that components of Stream_Element_Array are aliased.  (Defect
- --    Report 8652/0044).
- --
- -- APPLICABILITY CRITERIA:
- --    All implementations must attempt to compile this test.
- --
- --    For implementations for which Stream_Element'Size is a multiple of
- --    System.Storage_Unit, this test must execute.
- --
- --    For other implementations, if this test compiles without error messages
- --    at compilation, it must bind and execute.
- --
- -- PASS/FAIL CRITERIA:
- --    For implementations for which Stream_Element'Size is a multiple of
- --      System.Storage_Unit, this test must execute, report PASSED, and
- --      complete normally, otherwise the test FAILS.
- --
- --    For other implementations:
- --      PASSING behavior is:
- --        this test executes, reports PASSED, and completes normally
- --      or
- --        this test produces at least one error message at compilation, and
- --        the error message is associated with one of the items marked:
- --           -- N/A => ERROR.
- --
- --      All other behaviors are FAILING.
- --
- --
- -- CHANGE HISTORY:
- --    12 FEB 2001   PHL   Initial version
- --    15 MAR 2001   RLB   Readied for release.
- 
- --!
- with Ada.Streams;
- use Ada.Streams;
- with Report;
- use Report;
- procedure CDD1001 is
- 
-     type Acc is access all Stream_Element;
- 
-     A : Stream_Element_Array
- 	   (Stream_Element_Offset (Ident_Int (1)) ..
- 	       Stream_Element_Offset (Ident_Int (10)));
-     B : array (A'Range) of Acc;
- begin
-     Test ("CDD1001",
- 	  "Check that components of Stream_Element_Array are aliased");
- 
-     for I in A'Range loop
- 	A (I) := Stream_Element (Ident_Int (Integer (I)) * Ident_Int (3));
-     end loop;
- 
-     for I in B'Range loop
- 	B (I) := A (I)'Access;                                -- N/A => ERROR.
-     end loop;
- 
-     for I in B'Range loop
- 	if B (I).all /= Stream_Element
- 			   (Ident_Int (Integer (I)) * Ident_Int (3)) then
- 	    Failed ("Unable to build access values designating elements " &
- 		    "of a Stream_Element_Array");
- 	end if;
-     end loop;
- 
-     Result;
- end CDD1001;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,203 ****
- -- CDD2001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that the default implementation of Read and Input raise End_Error
- --    if the end of stream is reached before the reading of a value is
- --    completed.  (Defect Report 8652/0045,
- --    Technical Corrigendum 13.13.2(35.1/1)).
- --
- -- CHANGE HISTORY:
- --    12 FEB 2001   PHL   Initial version.
- --    29 JUN 2001   RLB   Reformatted for ACATS.
- --
- --!
- 
- with Ada.Streams;
- use Ada.Streams;
- package CDD2001_0 is
- 
-     type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
- 	record
- 	    First : Stream_Element_Offset := 1;
- 	    Last : Stream_Element_Offset := 0;
- 	    Contents : Stream_Element_Array (1 .. Size);
- 	end record;
- 
-     procedure Clear (Stream : in out My_Stream);
- 
-     procedure Read (Stream : in out My_Stream;
- 		    Item : out Stream_Element_Array;
- 		    Last : out Stream_Element_Offset);
- 
-     procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
- 
- end CDD2001_0;
- 
- package body CDD2001_0 is
- 
-     procedure Clear (Stream : in out My_Stream) is
-     begin
- 	Stream.First := 1;
- 	Stream.Last := 0;
-     end Clear;
- 
-     procedure Read (Stream : in out My_Stream;
- 		    Item : out Stream_Element_Array;
- 		    Last : out Stream_Element_Offset) is
-     begin
- 	if Item'Length >= Stream.Last - Stream.First + 1 then
- 	    Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
- 	       Stream.Contents (Stream.First .. Stream.Last);
- 	    Last := Item'First + Stream.Last - Stream.First;
- 	    Stream.First := Stream.Last + 1;
- 	else
- 	    Item := Stream.Contents (Stream.First ..
- 					Stream.First + Item'Length - 1);
- 	    Last := Item'Last;
- 	    Stream.First := Stream.First + Item'Length;
- 	end if;
-     end Read;
- 
-     procedure Write (Stream : in out My_Stream;
- 		     Item : in Stream_Element_Array) is
-     begin
- 	Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
- 	Stream.Last := Stream.Last + Item'Length;
-     end Write;
- 
- end CDD2001_0;
- 
- with Ada.Exceptions;
- use Ada.Exceptions;
- with CDD2001_0;
- use CDD2001_0;
- with Io_Exceptions;
- use Io_Exceptions;
- with Report;
- use Report;
- procedure CDD2001 is
- 
-     subtype Int is Integer range -20 .. 20;
- 
-     type R (D : Int) is
- 	record
- 	    C1 : Character := Ident_Char ('a');
- 	    case D is
- 		when 0 .. 20 =>
- 		    C2 : String (1 .. D) := (others => Ident_Char ('b'));
- 		when others =>
- 		    C3, C4 : Float := Float (-D);
- 	    end case;
- 	end record;
- 
-     S : aliased My_Stream (200);
- 
- begin
-     Test
-        ("CDD2001",
- 	   "Check that the default implementation of Read and Input " &
- 	   "raise End_Error if the end of stream is reached before the " &
-            "reading of a value is completed");
- 
-     Read:
- 	declare
- 	    X : R (Ident_Int (13));
- 	begin
- 	    Clear (S);
- 
- 	    -- A complete object.
- 	    R'Write (S'Access, X);
- 	    X.C1 := Ident_Char ('A');
- 	    X.C2 := (others => Ident_Char ('B'));
- 	    R'Read (S'Access, X);
- 	    if X.C1 /= Ident_Char ('a') or X.C2 /=
- 					      (1 .. 13 => Ident_Char ('b')) then
- 		Failed ("Read did not produce the expected result");
- 	    end if;
- 
- 	    Clear (S);
- 
- 	    -- Not enough data.
- 	    Character'Write (S'Access, 'a');
- 	    String'Write (S'Access, "bbb");
- 
- 	    begin
- 		R'Read (S'Access, X);
- 		Failed
- 		   ("No exception raised when the end of stream is reached " &
- 		    "before the reading of a value is completed - 1");
- 	    exception
- 		when End_Error =>
- 		    null;
- 		when E: others =>
- 		    Failed ("Wrong Exception " & Exception_Name (E) &
- 			    " - " & Exception_Information (E) &
- 			    " - " & Exception_Message (E) & " - 1");
- 	    end;
- 
- 	end Read;
- 
-     Input:
- 	declare
- 	    X : R (Ident_Int (-11));
- 	begin
- 	    Clear (S);
- 
- 	    -- A complete object.
- 	    R'Output (S'Access, X);
- 	    X.C1 := Ident_Char ('A');
- 	    X.C3 := 4.0;
- 	    X.C4 := 5.0;
- 	    X := R'Input (S'Access);
- 	    if X.C1 /= Ident_Char ('a') or X.C3 /= 11.0 or X.C4 /= 11.0 then
- 		Failed ("Input did not produce the expected result");
- 	    end if;
- 
- 	    Clear (S);
- 
- 	    -- Not enough data.
- 	    Integer'Output (S'Access, Ident_Int (-11)); -- The discriminant
- 	    Character'Output (S'Access, 'a');
- 	    Float'Output (S'Access, 11.0);
- 
- 	    begin
- 		X := R'Input (S'Access);
- 		Failed
- 		   ("No exception raised when the end of stream is reached " &
- 		    "before the reading of a value is completed - 2");
- 	    exception
- 		when End_Error =>
- 		    null;
- 		when E: others =>
- 		    Failed ("Wrong exception " & Exception_Name (E) &
- 			    " - " & Exception_Message (E) & " - 2");
- 	    end;
- 
- 	end Input;
- 
-     Result;
- end CDD2001;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,379 ****
- -- CDD2A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that the Read and Write attributes for a type extension are created
- --    from the parent type's attribute (which may be user-defined) and those
- --    for the extension components.  Also check that the default Input and
- --    Output attributes are used for a type extension, even if the parent
- --    type's attribute is user-defined.  (Defect Report 8652/0040,
- --     as reflected in Technical Corrigendum 1, penultimate sentence of
- --     13.13.2(9/1) and 13.13.2(25/1)).
- --
- -- CHANGE HISTORY:
- --    30 JUL 2001   PHL   Initial version.
- --     5 DEC 2001   RLB   Reformatted for ACATS.
- --
- --!
- with Ada.Streams;
- use Ada.Streams;
- with FDD2A00;
- use FDD2A00;
- with Report;
- use Report;
- procedure CDD2A01 is
- 
-     Input_Output_Error : exception;
- 
-     type Int is range 1 .. 1000;
-     type Str is array (Int range <>) of Character;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Int'Base);
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Int'Base;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);
- 
-     for Int'Read use Read;
-     for Int'Write use Write;
-     for Int'Input use Input;
-     for Int'Output use Output;
- 
- 
-     type Parent (D1, D2 : Int; B : Boolean) is tagged
-         record
-             S : Str (D1 .. D2);
-             case B is
-                 when False =>
-                     C1 : Integer;
-                 when True =>
-                     C2 : Float;
-             end case;
-         end record;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);
-     function Input (Stream : access Root_Stream_Type'Class) return Parent;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);
- 
-     for Parent'Read use Read;
-     for Parent'Write use Write;
-     for Parent'Input use Input;
-     for Parent'Output use Output;
- 
- 
-     procedure Actual_Read
-                  (Stream : access Root_Stream_Type'Class; Item : out Int) is
-     begin
-         Integer'Read (Stream, Integer (Item));
-     end Actual_Read;
- 
-     procedure Actual_Write
-                  (Stream : access Root_Stream_Type'Class; Item : Int) is
-     begin
-         Integer'Write (Stream, Integer (Item));
-     end Actual_Write;
- 
-     function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is
-     begin
-         return Int (Integer'Input (Stream));
-     end Actual_Input;
- 
-     procedure Actual_Output
-                  (Stream : access Root_Stream_Type'Class; Item : Int) is
-     begin
-         Integer'Output (Stream, Integer (Item));
-     end Actual_Output;
- 
- 
-     procedure Actual_Read
-                  (Stream : access Root_Stream_Type'Class; Item : out Parent) is
-     begin
-         case Item.B is
-             when False =>
-                 Item.C1 := 7;
-             when True =>
-                 Float'Read (Stream, Item.C2);
-         end case;
-         Str'Read (Stream, Item.S);
-     end Actual_Read;
- 
-     procedure Actual_Write
-                  (Stream : access Root_Stream_Type'Class; Item : Parent) is
-     begin
-         case Item.B is
-             when False =>
-                 null; -- Don't write C1
-             when True =>
-                 Float'Write (Stream, Item.C2);
-         end case;
-         Str'Write (Stream, Item.S);
-     end Actual_Write;
- 
-     function Actual_Input
-                 (Stream : access Root_Stream_Type'Class) return Parent is
-         X : Parent (1, 1, True);
-     begin
-         raise Input_Output_Error;
-         return X;
-     end Actual_Input;
- 
-     procedure Actual_Output
-                  (Stream : access Root_Stream_Type'Class; Item : Parent) is
-     begin
-         raise Input_Output_Error;
-     end Actual_Output;
- 
-     package Int_Ops is new Counting_Stream_Ops (T => Int'Base,
-                                                 Actual_Write => Actual_Write,
-                                                 Actual_Input => Actual_Input,
-                                                 Actual_Read => Actual_Read,
-                                                 Actual_Output => Actual_Output);
- 
-     package Parent_Ops is
-        new Counting_Stream_Ops (T => Parent,
-                                 Actual_Write => Actual_Write,
-                                 Actual_Input => Actual_Input,
-                                 Actual_Read => Actual_Read,
-                                 Actual_Output => Actual_Output);
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)
-        renames Int_Ops.Read;
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)
-        renames Int_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Int'Base
-        renames Int_Ops.Input;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)
-        renames Int_Ops.Output;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)
-        renames Parent_Ops.Read;
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)
-        renames Parent_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Parent
-        renames Parent_Ops.Input;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)
-        renames Parent_Ops.Output;
- 
-     type Derived1 is new Parent with
-         record
-             C3 : Int;
-         end record;
- 
-     type Derived2 (D : Int) is new Parent (D1 => D,
-                                            D2 => D,
-                                            B => False) with
-         record
-             C3 : Int;
-         end record;
- 
- begin
-     Test ("CDD2A01",
-           "Check that the Read and Write attributes for a type " &
-              "extension are created from the parent type's " &
-              "attribute (which may be user-defined) and those for the " &
-              "extension components; also check that the default input " &
-              "and output attributes are used for a type extension, even " &
-              "if the parent type's attribute is user-defined");
- 
-     Test1:
-         declare
-             S : aliased My_Stream (1000);
-             X1 : Derived1 (D1 => Int (Ident_Int (2)),
-                            D2 => Int (Ident_Int (5)),
-                            B => Ident_Bool (True));
-             Y1 : Derived1 := (D1 => 3,
-                               D2 => 6,
-                               B => False,
-                               S => Str (Ident_Str ("3456")),
-                               C1 => Ident_Int (100),
-                               C3 => Int (Ident_Int (88)));
-             X2 : Derived1 (D1 => Int (Ident_Int (2)),
-                            D2 => Int (Ident_Int (5)),
-                            B => Ident_Bool (True));
-         begin
-             X1.S := Str (Ident_Str ("bcde"));
-             X1.C2 := Float (Ident_Int (4));
-             X1.C3 := Int (Ident_Int (99));
- 
-             Derived1'Write (S'Access, X1);
-             if Int_Ops.Get_Counts /=
-                (Read => 0, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Error writing extension components - 1");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 0, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Didn't call parent type's Write - 1");
-             end if;
- 
-             Derived1'Read (S'Access, X2);
-             if Int_Ops.Get_Counts /=
-                (Read => 1, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Error reading extension components - 1");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 1, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Read - 1");
-             end if;
- 
-             if X2 /= (D1 => 2,
-                       D2 => 5,
-                       B => True,
-                       S => Str (Ident_Str ("bcde")),
-                       C2 => Float (Ident_Int (4)),
-                       C3 => Int (Ident_Int (99))) then
-                 Failed
-                    ("Inherited Read and Write are not inverses of each other - 1");
-             end if;
- 
-             begin
-                 Derived1'Output (S'Access, Y1);
-                 if Int_Ops.Get_Counts /=
-                    (Read => 1, Write => 4, Input => 0, Output => 0) then
-                     Failed ("Error writing extension components - 2");
-                 end if;
-                 if Parent_Ops.Get_Counts /=
-                    (Read => 1, Write => 2, Input => 0, Output => 0) then
-                     Failed ("Didn't call inherited Write - 2");
-                 end if;
-             exception
-                 when Input_Output_Error =>
-                     Failed ("Did call inherited Output - 2");
-             end;
- 
-             begin
-                 declare
-                     Y2 : Derived1 := Derived1'Input (S'Access);
-                 begin
-                     if Int_Ops.Get_Counts /=
-                        (Read => 4, Write => 4, Input => 0, Output => 0) then
-                         Failed ("Error reading extension components - 2");
-                     end if;
-                     if Parent_Ops.Get_Counts /=
-                        (Read => 2, Write => 2, Input => 0, Output => 0) then
-                         Failed ("Didn't call inherited Read - 2");
-                     end if;
-                     if Y2 /= (D1 => 3,
-                               D2 => 6,
-                               B => False,
-                               S => Str (Ident_Str ("3456")),
-                               C1 => Ident_Int (7),
-                               C3 => Int (Ident_Int (88))) then
-                         Failed
-                            ("Input and Output are not inverses of each other - 2");
-                     end if;
-                 end;
-             exception
-                 when Input_Output_Error =>
-                     Failed ("Did call inherited Input - 2");
-             end;
- 
-         end Test1;
- 
-     Test2:
-         declare
-             S : aliased My_Stream (1000);
-             X1 : Derived2 (D => Int (Ident_Int (7)));
-             Y1 : Derived2 := (D => 8,
-                               S => Str (Ident_Str ("8")),
-                               C1 => Ident_Int (200),
-                               C3 => Int (Ident_Int (77)));
-             X2 : Derived2 (D => Int (Ident_Int (7)));
-         begin
-             X1.S := Str (Ident_Str ("g"));
-             X1.C1 := Ident_Int (4);
-             X1.C3 := Int (Ident_Int (666));
- 
-             Derived2'Write (S'Access, X1);
-             if Int_Ops.Get_Counts /=
-                (Read => 4, Write => 5, Input => 0, Output => 0) then
-                 Failed ("Error writing extension components - 3");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 2, Write => 3, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Write - 3");
-             end if;
- 
-             Derived2'Read (S'Access, X2);
-             if Int_Ops.Get_Counts /=
-                (Read => 5, Write => 5, Input => 0, Output => 0) then
-                 Failed ("Error reading extension components - 3");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 3, Write => 3, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Read - 3");
-             end if;
- 
-             if X2 /= (D => 7,
-                       S => Str (Ident_Str ("g")),
-                       C1 => Ident_Int (7),
-                       C3 => Int (Ident_Int (666))) then
-                 Failed ("Read and Write are not inverses of each other - 3");
-             end if;
- 
-             begin
-                 Derived2'Output (S'Access, Y1);
-                 if Int_Ops.Get_Counts /=
-                    (Read => 5, Write => 7, Input => 0, Output => 0) then
-                     Failed ("Error writing extension components - 4");
-                 end if;
-                 if Parent_Ops.Get_Counts /=
-                    (Read => 3, Write => 4, Input => 0, Output => 0) then
-                     Failed ("Didn't call inherited Write - 4");
-                 end if;
-             exception
-                 when Input_Output_Error =>
-                     Failed ("Did call inherited Output - 4");
-             end;
- 
-             begin
-                 declare
-                     Y2 : Derived2 := Derived2'Input (S'Access);
-                 begin
-                     if Int_Ops.Get_Counts /=
-                        (Read => 7, Write => 7, Input => 0, Output => 0) then
-                         Failed ("Error reading extension components - 4");
-                     end if;
-                     if Parent_Ops.Get_Counts /=
-                        (Read => 4, Write => 4, Input => 0, Output => 0) then
-                         Failed ("Didn't call inherited Read - 4");
-                     end if;
-                     if Y2 /= (D => 8,
-                               S => Str (Ident_Str ("8")),
-                               C1 => Ident_Int (7),
-                               C3 => Int (Ident_Int (77))) then
-                         Failed
-                            ("Input and Output are not inverses of each other - 4");
-                     end if;
-                 end;
-             exception
-                 when Input_Output_Error =>
-                     Failed ("Did call inherited Input - 4");
-             end;
- 
-         end Test2;
- 
-     Result;
- end CDD2A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,345 ****
- -- CDD2A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that the Read, Write, Input, and Output attributes are inherited
- --    for untagged derived types.  (Defect Report 8652/0040,
- --     as reflected in Technical Corrigendum 1, 13.13.2(8.1/1) and
- --     13.13.2(25/1)).
- --
- -- CHANGE HISTORY:
- --    30 JUL 2001   PHL   Initial version.
- --     5 DEC 2001   RLB   Reformatted for ACATS.
- --
- --!
- with Ada.Streams;
- use Ada.Streams;
- with FDD2A00;
- use FDD2A00;
- with Report;
- use Report;
- procedure CDD2A02 is
- 
-     type Int is range 1 .. 10;
-     type Str is array (Int range <>) of Character;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Int'Base);
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Int'Base;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);
- 
-     for Int'Read use Read;
-     for Int'Write use Write;
-     for Int'Input use Input;
-     for Int'Output use Output;
- 
- 
-     type Parent (D1, D2 : Int; B : Boolean) is
-         record
-             S : Str (D1 .. D2);
-             case B is
-                 when False =>
-                     C1 : Integer;
-                 when True =>
-                     C2 : Float;
-             end case;
-         end record;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);
-     function Input (Stream : access Root_Stream_Type'Class) return Parent;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);
- 
-     for Parent'Read use Read;
-     for Parent'Write use Write;
-     for Parent'Input use Input;
-     for Parent'Output use Output;
- 
- 
-     procedure Actual_Read
-                  (Stream : access Root_Stream_Type'Class; Item : out Int) is
-     begin
-         Integer'Read (Stream, Integer (Item));
-     end Actual_Read;
- 
-     procedure Actual_Write
-                  (Stream : access Root_Stream_Type'Class; Item : Int) is
-     begin
-         Integer'Write (Stream, Integer (Item));
-     end Actual_Write;
- 
-     function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is
-     begin
-         return Int (Integer'Input (Stream));
-     end Actual_Input;
- 
-     procedure Actual_Output
-                  (Stream : access Root_Stream_Type'Class; Item : Int) is
-     begin
-         Integer'Output (Stream, Integer (Item));
-     end Actual_Output;
- 
- 
-     procedure Actual_Read
-                  (Stream : access Root_Stream_Type'Class; Item : out Parent) is
-     begin
-         case Item.B is
-             when False =>
-                 Item.C1 := 7;
-             when True =>
-                 Float'Read (Stream, Item.C2);
-         end case;
-         Str'Read (Stream, Item.S);
-     end Actual_Read;
- 
-     procedure Actual_Write
-                  (Stream : access Root_Stream_Type'Class; Item : Parent) is
-     begin
-         case Item.B is
-             when False =>
-                 null; -- Don't write C1
-             when True =>
-                 Float'Write (Stream, Item.C2);
-         end case;
-         Str'Write (Stream, Item.S);
-     end Actual_Write;
- 
-     function Actual_Input
-                 (Stream : access Root_Stream_Type'Class) return Parent is
-         D1, D2 : Int;
-         B : Boolean;
-     begin
-         Int'Read (Stream, D2);
-         Boolean'Read (Stream, B);
-         Int'Read (Stream, D1);
- 
-         declare
-             Item : Parent (D1 => D1, D2 => D2, B => B);
-         begin
-             Parent'Read (Stream, Item);
-             return Item;
-         end;
- 
-     end Actual_Input;
- 
-     procedure Actual_Output
-                  (Stream : access Root_Stream_Type'Class; Item : Parent) is
-     begin
-         Int'Write (Stream, Item.D2);
-         Boolean'Write (Stream, Item.B);
-         Int'Write (Stream, Item.D1);
-         Parent'Write (Stream, Item);
-     end Actual_Output;
- 
-     package Int_Ops is new Counting_Stream_Ops (T => Int'Base,
-                                                 Actual_Write => Actual_Write,
-                                                 Actual_Input => Actual_Input,
-                                                 Actual_Read => Actual_Read,
-                                                 Actual_Output => Actual_Output);
- 
-     package Parent_Ops is
-        new Counting_Stream_Ops (T => Parent,
-                                 Actual_Write => Actual_Write,
-                                 Actual_Input => Actual_Input,
-                                 Actual_Read => Actual_Read,
-                                 Actual_Output => Actual_Output);
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)
-        renames Int_Ops.Read;
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)
-        renames Int_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Int'Base
-        renames Int_Ops.Input;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)
-        renames Int_Ops.Output;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)
-        renames Parent_Ops.Read;
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)
-        renames Parent_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Parent
-        renames Parent_Ops.Input;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)
-        renames Parent_Ops.Output;
- 
- begin
-     Test ("CDD2A02", "Check that the Read, Write, Input, and Output " &
-                      "attributes are inherited for untagged derived types");
- 
-     Test1:
-         declare
-             type Derived1 is new Parent;
-             S : aliased My_Stream (1000);
-             X1 : Derived1 (D1 => Int (Ident_Int (2)),
-                            D2 => Int (Ident_Int (5)), B => Ident_Bool (True));
-             Y1 : Derived1 := (D1 => 3,
-                               D2 => 6,
-                               B => False,
-                               S => Str (Ident_Str ("3456")),
-                               C1 => Ident_Int (100));
-             X2 : Derived1 (D1 => Int (Ident_Int (2)),
-                            D2 => Int (Ident_Int (5)), B => Ident_Bool (True));
-         begin
-             X1.S := Str (Ident_Str ("bcde"));
-             X1.C2 := Float (Ident_Int (4));
- 
-             Derived1'Write (S'Access, X1);
-             if Int_Ops.Get_Counts /=
-                (Read => 0, Write => 0, Input => 0, Output => 0) then
-                 Failed ("Error writing discriminants - 1");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 0, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Write - 1");
-             end if;
- 
-             Derived1'Read (S'Access, X2);
-             if Int_Ops.Get_Counts /=
-                (Read => 0, Write => 0, Input => 0, Output => 0) then
-                 Failed ("Error reading discriminants - 1");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 1, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Read - 1");
-             end if;
- 
-             if X2 /= (D1 => 2,
-                       D2 => 5,
-                       B => True,
-                       S => Str (Ident_Str ("bcde")),
-                       C2 => Float (Ident_Int (4))) then
-                 Failed
-                    ("Inherited Read and Write are not inverses of each other - 1");
-             end if;
- 
-             Derived1'Output (S'Access, Y1);
-             if Int_Ops.Get_Counts /=
-                (Read => 0, Write => 2, Input => 0, Output => 0) then
-                 Failed ("Error writing discriminants - 2");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 1, Write => 2, Input => 0, Output => 1) then
-                 Failed ("Didn't call inherited Output - 2");
-             end if;
- 
-             declare
-                 Y2 : Derived1 := Derived1'Input (S'Access);
-             begin
-                 if Int_Ops.Get_Counts /=
-                    (Read => 2, Write => 2, Input => 0, Output => 0) then
-                     Failed ("Error reading discriminants - 2");
-                 end if;
-                 if Parent_Ops.Get_Counts /=
-                    (Read => 2, Write => 2, Input => 1, Output => 1) then
-                     Failed ("Didn't call inherited Input - 2");
-                 end if;
- 
-                 if Y2 /= (D1 => 3,
-                           D2 => 6,
-                           B => False,
-                           S => Str (Ident_Str ("3456")),
-                           C1 => Ident_Int (7)) then
-                     Failed
-                        ("Inherited Input and Output are not inverses of each other - 2");
-                 end if;
-             end;
-         end Test1;
- 
-     Test2:
-         declare
-             type Derived2 (D : Int) is new Parent (D1 => D,
-                                                    D2 => D,
-                                                    B => False);
-             S : aliased My_Stream (1000);
-             X1 : Derived2 (D => Int (Ident_Int (7)));
-             Y1 : Derived2 := (D => 8,
-                               S => Str (Ident_Str ("8")),
-                               C1 => Ident_Int (200));
-             X2 : Derived2 (D => Int (Ident_Int (7)));
-         begin
-             X1.S := Str (Ident_Str ("g"));
-             X1.C1 := Ident_Int (4);
- 
-             Derived2'Write (S'Access, X1);
-             if Int_Ops.Get_Counts /=
-                (Read => 2, Write => 2, Input => 0, Output => 0) then
-                 Failed ("Error writing discriminants - 3");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 2, Write => 3, Input => 1, Output => 1) then
-                 Failed ("Didn't call inherited Write - 3");
-             end if;
- 
-             Derived2'Read (S'Access, X2);
-             if Int_Ops.Get_Counts /=
-                (Read => 2, Write => 2, Input => 0, Output => 0) then
-                 Failed ("Error reading discriminants - 3");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 3, Write => 3, Input => 1, Output => 1) then
-                 Failed ("Didn't call inherited Read - 3");
-             end if;
- 
-             if X2 /= (D => 7,
-                       S => Str (Ident_Str ("g")),
-                       C1 => Ident_Int (7)) then
-                 Failed
-                    ("Inherited Read and Write are not inverses of each other - 3");
-             end if;
- 
-             Derived2'Output (S'Access, Y1);
-             if Int_Ops.Get_Counts /=
-                (Read => 2, Write => 4, Input => 0, Output => 0) then
-                 Failed ("Error writing discriminants - 4");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 3, Write => 4, Input => 1, Output => 2) then
-                 Failed ("Didn't call inherited Output - 4");
-             end if;
- 
-             declare
-                 Y2 : Derived2 := Derived2'Input (S'Access);
-             begin
-                 if Int_Ops.Get_Counts /=
-                    (Read => 4, Write => 4, Input => 0, Output => 0) then
-                     Failed ("Error reading discriminants - 4");
-                 end if;
-                 if Parent_Ops.Get_Counts /=
-                    (Read => 4, Write => 4, Input => 2, Output => 2) then
-                     Failed ("Didn't call inherited Input - 4");
-                 end if;
- 
-                 if Y2 /= (D => 8,
-                           S => Str (Ident_Str ("8")),
-                           C1 => Ident_Int (7)) then
-                     Failed
-                        ("Inherited Input and Output are not inverses of each other - 4");
-                 end if;
-             end;
-         end Test2;
- 
-     Result;
- end CDD2A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2a03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cdd2a03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cdd2a03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,325 ****
- -- CDD2A03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that the default Read and Write attributes for a limited type
- --    extension are created from the parent type's attribute (which may be
- --    user-defined) and those for the extension components, if the extension
- --    components are non-limited or have user-defined attributes.  Check that
- --    such limited type extension attributes are callable (Defect Report
- --    8652/0040, as reflected in Technical Corrigendum 1, penultimate sentence
- --     of 13.13.2(9/1) and 13.13.2(36/1)).
- --
- -- CHANGE HISTORY:
- --     1 AUG 2001   PHL   Initial version.
- --     3 DEC 2001   RLB   Reformatted for ACATS.
- --
- --!
- with Ada.Streams;
- use Ada.Streams;
- with FDD2A00;
- use FDD2A00;
- with Report;
- use Report;
- procedure CDD2A03 is
- 
-     Input_Output_Error : exception;
- 
-     type Int is range 1 .. 1000;
-     type Str is array (Int range <>) of Character;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class;
-                     Item : out Int'Base);
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);
-     function Input (Stream : access Root_Stream_Type'Class) return Int'Base;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);
- 
-     for Int'Read use Read;
-     for Int'Write use Write;
-     for Int'Input use Input;
-     for Int'Output use Output;
- 
- 
-     type Lim is limited
-         record
-             C : Int;
-         end record;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Lim);
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Lim);
-     function Input (Stream : access Root_Stream_Type'Class) return Lim;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Lim);
- 
-     for Lim'Read use Read;
-     for Lim'Write use Write;
-     for Lim'Input use Input;
-     for Lim'Output use Output;
- 
- 
-     type Parent (D1, D2 : Int; B : Boolean) is tagged limited
-         record
-             S : Str (D1 .. D2);
-             case B is
-                 when False =>
-                     C1 : Integer;
-                 when True =>
-                     C2 : Float;
-             end case;
-         end record;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);
-     function Input (Stream : access Root_Stream_Type'Class) return Parent;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);
- 
-     for Parent'Read use Read;
-     for Parent'Write use Write;
-     for Parent'Input use Input;
-     for Parent'Output use Output;
- 
- 
-     procedure Actual_Read
-                  (Stream : access Root_Stream_Type'Class; Item : out Int) is
-     begin
-         Integer'Read (Stream, Integer (Item));
-     end Actual_Read;
- 
-     procedure Actual_Write
-                  (Stream : access Root_Stream_Type'Class; Item : Int) is
-     begin
-         Integer'Write (Stream, Integer (Item));
-     end Actual_Write;
- 
-     function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is
-     begin
-         return Int (Integer'Input (Stream));
-     end Actual_Input;
- 
-     procedure Actual_Output
-                  (Stream : access Root_Stream_Type'Class; Item : Int) is
-     begin
-         Integer'Output (Stream, Integer (Item));
-     end Actual_Output;
- 
- 
-     procedure Actual_Read
-                  (Stream : access Root_Stream_Type'Class; Item : out Lim) is
-     begin
-         Integer'Read (Stream, Integer (Item.C));
-     end Actual_Read;
- 
-     procedure Actual_Write
-                  (Stream : access Root_Stream_Type'Class; Item : Lim) is
-     begin
-         Integer'Write (Stream, Integer (Item.C));
-     end Actual_Write;
- 
-     function Actual_Input (Stream : access Root_Stream_Type'Class) return Lim is
-         Result : Lim;
-     begin
-         Result.C := Int (Integer'Input (Stream));
-         return Result;
-     end Actual_Input;
- 
-     procedure Actual_Output
-                  (Stream : access Root_Stream_Type'Class; Item : Lim) is
-     begin
-         Integer'Output (Stream, Integer (Item.C));
-     end Actual_Output;
- 
- 
-     procedure Actual_Read
-                  (Stream : access Root_Stream_Type'Class; Item : out Parent) is
-     begin
-         case Item.B is
-             when False =>
-                 Item.C1 := 7;
-             when True =>
-                 Float'Read (Stream, Item.C2);
-         end case;
-         Str'Read (Stream, Item.S);
-     end Actual_Read;
- 
-     procedure Actual_Write
-                  (Stream : access Root_Stream_Type'Class; Item : Parent) is
-     begin
-         case Item.B is
-             when False =>
-                 null; -- Don't write C1
-             when True =>
-                 Float'Write (Stream, Item.C2);
-         end case;
-         Str'Write (Stream, Item.S);
-     end Actual_Write;
- 
-     function Actual_Input
-                 (Stream : access Root_Stream_Type'Class) return Parent is
-         X : Parent (1, 1, True);
-     begin
-         raise Input_Output_Error;
-         return X;
-     end Actual_Input;
- 
-     procedure Actual_Output
-                  (Stream : access Root_Stream_Type'Class; Item : Parent) is
-     begin
-         raise Input_Output_Error;
-     end Actual_Output;
- 
-     package Int_Ops is new Counting_Stream_Ops (T => Int'Base,
-                                                 Actual_Write => Actual_Write,
-                                                 Actual_Input => Actual_Input,
-                                                 Actual_Read => Actual_Read,
-                                                 Actual_Output => Actual_Output);
- 
-     package Lim_Ops is new Counting_Stream_Ops (T => Lim,
-                                                 Actual_Write => Actual_Write,
-                                                 Actual_Input => Actual_Input,
-                                                 Actual_Read => Actual_Read,
-                                                 Actual_Output => Actual_Output);
- 
-     package Parent_Ops is
-        new Counting_Stream_Ops (T => Parent,
-                                 Actual_Write => Actual_Write,
-                                 Actual_Input => Actual_Input,
-                                 Actual_Read => Actual_Read,
-                                 Actual_Output => Actual_Output);
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)
-        renames Int_Ops.Read;
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)
-        renames Int_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Int'Base
-        renames Int_Ops.Input;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)
-        renames Int_Ops.Output;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Lim)
-        renames Lim_Ops.Read;
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Lim)
-        renames Lim_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Lim
-        renames Lim_Ops.Input;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Lim)
-        renames Lim_Ops.Output;
- 
-     procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)
-        renames Parent_Ops.Read;
-     procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)
-        renames Parent_Ops.Write;
-     function Input (Stream : access Root_Stream_Type'Class) return Parent
-        renames Parent_Ops.Input;
-     procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)
-        renames Parent_Ops.Output;
- 
-     type Derived1 is new Parent with
-         record
-             C3 : Int;
-         end record;
- 
-     type Derived2 (D : Int) is new Parent (D1 => D,
-                                            D2 => D,
-                                            B => False) with
-         record
-             C3 : Lim;
-         end record;
- 
- begin
-     Test ("CDD2A03",
-           "Check that the default Read and Write attributes for a limited " &
-              "type extension are created from the parent type's " &
-              "attribute (which may be user-defined) and those for the " &
-              "extension components, if the extension components are " &
-              "non-limited or have user-defined attributes; check that such " &
-              "limited type extension attributes are callable");
- 
-     Test1:
-         declare
-             S : aliased My_Stream (1000);
-             X1 : Derived1 (D1 => Int (Ident_Int (2)),
-                            D2 => Int (Ident_Int (5)),
-                            B => Ident_Bool (True));
-             X2 : Derived1 (D1 => Int (Ident_Int (2)),
-                            D2 => Int (Ident_Int (5)),
-                            B => Ident_Bool (True));
-         begin
-             X1.S := Str (Ident_Str ("bcde"));
-             X1.C2 := Float (Ident_Int (4));
-             X1.C3 := Int (Ident_Int (99));
- 
-             Derived1'Write (S'Access, X1);
-             if Int_Ops.Get_Counts /=
-                (Read => 0, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Error writing extension components - 1");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 0, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Didn't call parent type's Write - 1");
-             end if;
- 
-             Derived1'Read (S'Access, X2);
-             if Int_Ops.Get_Counts /=
-                (Read => 1, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Error reading extension components - 1");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 1, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Read - 1");
-             end if;
-         end Test1;
- 
-     Test2:
-         declare
-             S : aliased My_Stream (1000);
-             X1 : Derived2 (D => Int (Ident_Int (7)));
-             X2 : Derived2 (D => Int (Ident_Int (7)));
-         begin
-             X1.S := Str (Ident_Str ("g"));
-             X1.C1 := Ident_Int (4);
-             X1.C3.C := Int (Ident_Int (666));
- 
-             Derived2'Write (S'Access, X1);
-             if Lim_Ops.Get_Counts /=
-                (Read => 0, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Error writing extension components - 2");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 1, Write => 2, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Write - 2");
-             end if;
- 
-             Derived2'Read (S'Access, X2);
-             if Lim_Ops.Get_Counts /=
-                (Read => 1, Write => 1, Input => 0, Output => 0) then
-                 Failed ("Error reading extension components - 2");
-             end if;
-             if Parent_Ops.Get_Counts /=
-                (Read => 2, Write => 2, Input => 0, Output => 0) then
-                 Failed ("Didn't call inherited Read - 2");
-             end if;
-         end Test2;
- 
-     Result;
- end CDD2A03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cde0001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cde0001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cd/cde0001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cd/cde0001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,324 ****
- -- CDE0001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the following names can be used in the declaration of a
- --      generic formal parameter (object, array type, or access type) without 
- --      causing freezing of the named type:
- --        (1) The name of a private type,
- --        (2) A name that denotes a subtype of a private type, and
- --        (3) A name that denotes a composite type with a subcomponent of a
- --           private type (or subtype).
- --      Check for untagged and tagged types.
- --
- -- TEST DESCRIPTION:
- --      This transition test defines private and limited private types,
- --      subtypes of these private types, records and arrays of both types and
- --      subtypes, a tagged type and a private extension.
- --      This test creates examples where the above types are used in the 
- --      definition of several generic formal type parameters (object, array 
- --      type, or access type) in both visible and private parts.  These 
- --      visible and private generic packages are instantiated in the body of 
- --      the public child and the private child, respectively.  
- --      The main program utilizes the functions declared in the public child
- --      to verify results of the instantiations.
- --
- --      Inspired by B74103F.ADA.
- --
- --
- -- CHANGE HISTORY:
- --      12 Mar 96   SAIC    Initial version for ACVC 2.1.
- --      05 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate for CDE0001.
- --      21 Nov 98   RLB     Added pragma Elaborate for CDE0001 to CDE0001_3.
- --!
- 
- package CDE0001_0 is
- 
-    subtype Small_Int is Integer range 1 .. 2;
- 
-    type Private_Type    is private;
-    type Limited_Private is limited private;
- 
-    subtype Private_Subtype         is Private_Type;
-    subtype Limited_Private_Subtype is Limited_Private;
- 
-    type Array_Of_LP_Subtype is array (1..2) of Limited_Private_Subtype;
- 
-    type Rec_Of_Limited_Private is
-      record
-         C1 : Limited_Private;
-      end record;
- 
-    type Rec_Of_Private_SubType is 
-      record
-         C1 : Private_SubType;
-      end record;
- 
-    type Tag_Type is tagged
-      record
-         C1 : Small_Int;
-      end record;
- 
-    type New_TagType is new Tag_Type with private;
- 
-    generic               
- 
-       Formal_Obj01 : in out Private_Type;              -- Formal objects defined
-       Formal_Obj02 : in out Limited_Private;           -- by names of private 
-       Formal_Obj03 : in out Private_Subtype;           -- types, names that
-       Formal_Obj04 : in out Limited_Private_Subtype;   -- denotes subtypes of 
-       Formal_Obj05 : in out New_TagType;               -- the private types.
- 
-    package CDE0001_1 is
-       procedure Assign_Objects;
- 
-    end CDE0001_1;
-    
- private
- 
-    generic               
-       -- Formal array types of a private type, a composite type with a 
-       -- subcomponent of a private type.
- 
-       type Formal_Arr01 is array (Small_Int) of Private_Type;
-       type Formal_Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
- 
-       -- Formal access types of composite types with a subcomponent of 
-       -- a private subtype.
- 
-       type Formal_Acc01 is access Rec_Of_Private_Subtype;
-       type Formal_Acc02 is access Array_Of_LP_Subtype;
- 
-    package CDE0001_2 is
- 
-       procedure Assign_Arrays (P1 : out Formal_Arr01;
-                                P2 : out Formal_Arr02);
- 
-       procedure Assign_Access (P1 : out Formal_Acc01;
-                                P2 : out Formal_Acc02);
- 
-    end CDE0001_2;
- 
-    ----------------------------------------------------------
-    type Private_Type    is range 1 .. 10;
-    type Limited_Private is (Eh, Bee, Sea, Dee);
-    type New_TagType     is new Tag_Type with 
-      record
-         C2 : Private_Type;
-      end record;
- 
- end CDE0001_0;
- 
-      --==================================================================--
- 
- package body CDE0001_0 is
- 
-    package body CDE0001_1 is
- 
-       procedure Assign_Objects is
-       begin
-          Formal_Obj01 := Private_Type'First;
-          Formal_Obj02 := Limited_Private'Last;
-          Formal_Obj03 := Private_Subtype'Last;
-          Formal_Obj04 := Limited_Private_Subtype'First;
-          Formal_Obj05 := New_TagType'(C1 => 2, C2 => Private_Type'Last);
- 
-       end Assign_Objects;
- 
-    end CDE0001_1;
- 
-    --===========================================================--
- 
-    package body CDE0001_2 is
- 
-       procedure Assign_Arrays (P1 : out Formal_Arr01;
-                                P2 : out Formal_Arr02) is
-       begin
-          P1(1)    := Private_Type'Pred(Private_Type'Last);
-          P1(2)    := Private_Type'Succ(Private_Type'First);
-          P2(1).C1 := Limited_Private'Succ(Limited_Private'First);
-          P2(2).C1 := Limited_Private'Pred(Limited_Private'Last);
- 
-       end Assign_Arrays;
- 
-       -----------------------------------------------------------------
-       procedure Assign_Access (P1 : out Formal_Acc01;
-                                P2 : out Formal_Acc02) is
-       begin
-          P1 := new Rec_Of_Private_Subtype'(C1 => Private_Subtype'Last);
-          P2 := new Array_Of_LP_Subtype'(Eh, Dee);
- 
-       end Assign_Access;
- 
-    end CDE0001_2;
- 
- end CDE0001_0;
- 
-      --==================================================================--
- 
- -- The following private child package instantiates its parent private generic
- -- package. 
- 
- with CDE0001_0;
- pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated.
- private 
- package CDE0001_0.CDE0001_3 is
- 
-    type Arr01 is array (Small_Int) of Private_Type;
-    type Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
-    type Acc01 is access Rec_Of_Private_Subtype;
-    type Acc02 is access Array_Of_LP_Subtype;
- 
-    package Formal_Types_Pck is new CDE0001_2 (Arr01, Arr02, Acc01, Acc02);
-    
-    Arr01_Obj : Arr01;
-    Arr02_Obj : Arr02;
-    Acc01_Obj : Acc01;
-    Acc02_Obj : Acc02;
- 
- end CDE0001_0.CDE0001_3;
- 
-      --==================================================================--
- 
- package CDE0001_0.CDE0001_4 is
- 
-    -- The following functions check the private types defined in the parent
-    -- and the private child package from within the client program.
- 
-    function Verify_Objects return Boolean;
- 
-    function Verify_Arrays return Boolean;
- 
-    function Verify_Access return Boolean;
- 
- end CDE0001_0.CDE0001_4;
- 
-      --==================================================================--
- 
- with CDE0001_0.CDE0001_3;            -- private sibling.
- 
- pragma Elaborate (CDE0001_0.CDE0001_3);
- 
- package body CDE0001_0.CDE0001_4 is
- 
-    Obj1 : Private_Type            := 2;   
-    Obj2 : Limited_Private         := Bee;
-    Obj3 : Private_Subtype         := 3;    
-    Obj4 : Limited_Private_Subtype := Sea;
-    Obj5 : New_TagType             := (1, 5);
- 
-    -- Instantiate the generic package declared in the visible part of
-    -- the parent.
-  
-    package Formal_Obj_Pck is new CDE0001_1 (Obj1, Obj2, Obj3, Obj4, Obj5);
- 
-    ---------------------------------------------------
-    function Verify_Objects return Boolean is
-       Result : Boolean := False;
-    begin
-       if Obj1    = 1    and 
-          Obj2    = Dee  and 
-          Obj3    = 10   and 
-          Obj4    = Eh   and 
-          Obj5.C1 = 2    and
-          Obj5.C2 = 10   then
-            Result := True;
-       end if;
- 
-       return Result;
- 
-    end Verify_Objects;
- 
-    ---------------------------------------------------
-    function Verify_Arrays return Boolean is
-       Result : Boolean := False;
-    begin
-       if CDE0001_0.CDE0001_3.Arr01_Obj(1)    = 9     and 
-          CDE0001_0.CDE0001_3.Arr01_Obj(2)    = 2     and 
-          CDE0001_0.CDE0001_3.Arr02_Obj(1).C1 = Bee   and 
-          CDE0001_0.CDE0001_3.Arr02_Obj(2).C1 = Sea   then
-            Result := True;
-       end if;
- 
-       return Result;
- 
-    end Verify_Arrays;
- 
-    ---------------------------------------------------
-    function Verify_Access return Boolean is
-       Result : Boolean := False;
-    begin
-       if CDE0001_0.CDE0001_3.Acc01_Obj.C1  = 10   and 
-          CDE0001_0.CDE0001_3.Acc02_Obj(1)  = Eh   and
-          CDE0001_0.CDE0001_3.Acc02_Obj(2)  = Dee  then
-             Result := True;
-       end if;
- 
-       return Result;
- 
-    end Verify_Access;
- 
- begin
- 
-    Formal_Obj_Pck.Assign_Objects;
- 
-    CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Arrays 
-      (CDE0001_0.CDE0001_3.Arr01_Obj, CDE0001_0.CDE0001_3.Arr02_Obj);
-    CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Access 
-      (CDE0001_0.CDE0001_3.Acc01_Obj, CDE0001_0.CDE0001_3.Acc02_Obj);
- 
- end CDE0001_0.CDE0001_4;
- 
-      --==================================================================--
- 
- with Report;
- with CDE0001_0.CDE0001_4;
- 
- procedure CDE0001 is
- 
- begin
- 
-    Report.Test ("CDE0001", "Check that the name of the private type, a "  &
-                 "name that denotes a subtype of the private type, or a "  &
-                 "name that denotes a composite type with a subcomponent " &
-                 "of a private type can be used in the declaration of a "  &
-                 "generic formal type parameter without causing freezing " &
-                 "of the named type");
- 
-    if not CDE0001_0.CDE0001_4.Verify_Objects then
-       Report.Failed ("Wrong values for formal objects");
-    end if;
- 
-    if not CDE0001_0.CDE0001_4.Verify_Arrays then
-       Report.Failed ("Wrong values for formal array types");
-    end if;
- 
-    if not CDE0001_0.CDE0001_4.Verify_Access then
-       Report.Failed ("Wrong values for formal access types");
-    end if;
- 
-    Report.Result;
- 
- end CDE0001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- CE2102A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
- --     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE SEQUENTIAL_IO.
- 
- --          A) OPENED FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     DLD 08/10/82
- --     JBG 02/22/84
- --     SPW 07/29/87  SPLIT CASE FOR UNOPENED FILES INTO CE2102L.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102A IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
-      USE SEQ_IO;
-      TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE2102A", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
-                       "PERFORMING ILLEGAL OPERATIONS ON OPENED FILES " &
-                       "OF TYPE SEQUENTIAL_IO");
- 
-      BEGIN
-           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
- 
- -- CHECK THAT OPEN STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY OPEN
- 
-           BEGIN
-                OPEN (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
-                        "ALREADY OPEN - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 1");
-           END;
- 
-           BEGIN
-                OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
-                        "ALREADY OPEN - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 2");
-           END;
- 
- -- CHECK THAT CREATE STATEMENT RAISES EXCEPTION WHEN FILE
- -- IS ALREADY OPEN
- 
-           BEGIN
-                CREATE (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
-                        "FILE IS USED IN A CREATE - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 1");
-           END;
- 
-           BEGIN
-                CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
-                        "FILE IS USED IN A CREATE - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
-           END;
- 
- --DELETE TEST FILE
- 
-           BEGIN
-                DELETE (TEST_FILE_ONE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("DELETION OF EXTERNAL FILE APPEARS NOT " &
-                              "TO BE SUPPORTED");
- 
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                             "FOR DELETE");
-           END;
- 
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED FOR CREATE " &
-                                "WITH OUT_FILE MODE");
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED FOR CREATE " &
-                                "WITH OUT_FILE MODE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR CREATE");
-      END;
- 
-      RESULT;
- END CE2102A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- CE2102B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
- --     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE DIRECT_IO.
- 
- --          A) OPENED FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO THOSE  IMPLEMENTATIONS WHICH
- --     SUPPORT CREATE WITH OUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     DLD 08/10/82
- --     SPS 11/03/82
- --     JBG 02/22/84
- --     SPW 08/13/87  SPLIT CASE FOR UNOPENED FILES INTO CE2102M.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102B IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
-      USE DIR_IO;
-      TEST_FILE_ONE : DIR_IO.FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE2102B", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
-                       "PERFORMING ILLEGAL OPERATIONS ON FILES " &
-                       "OF TYPE DIRECT_IO");
- 
-      BEGIN
-           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
- 
- -- CHECK THAT OPEN STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY OPEN
- 
-           BEGIN
-                OPEN (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
-                        "ALREADY OPEN - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 1");
-           END;
- 
-           BEGIN
-                OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
-                        "ALREADY OPEN - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 2");
-           END;
- 
-           BEGIN
-                OPEN (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
-                        "ALREADY OPEN - 3");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 3");
-           END;
- 
- -- CHECK THAT CREATE STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY
- -- OPEN
- 
-           BEGIN
-                CREATE (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
-                        "FILE IS USED IN A CREATE - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 1");
-           END;
- 
-           BEGIN
-                CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
-                        "FILE IS USED IN A CREATE - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
-           END;
- 
-           BEGIN
-                CREATE (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
-                        "FILE IS USED IN A CREATE - 3");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 3");
-           END;
- 
- --DELETE TEST FILE
- 
-           BEGIN
-                DELETE (TEST_FILE_ONE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("DELETION OF EXTERNAL FILE APPEARS NOT " &
-                              "TO BE SUPPORTED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR DELETE");
-           END;
- 
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED FOR CREATE " &
-                                "WITH OUT_FILE MODE");
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED FOR CREATE " &
-                                "WITH OUT_FILE MODE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR CREATE");
-      END;
- 
-      RESULT;
- 
- END CE2102B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- CE2102C.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NAME_ERROR IS RAISED WHEN THE NAME STRING DOES NOT
- --     IDENTIFY AN EXTERNAL FILE FOR AN OPEN OR CREATE OPERATION FOR
- --     SEQUENTIAL_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE FOR SEQUENTIAL TEMPORARY FILES.
- 
- -- HISTORY:
- --     SPS  08/26/82
- --     JBG  02/22/84  CHANGED TO .ADA TEST.
- --     JRK  11/30/84  CHANGED TO .TST TEST.
- --     TBN  02/12/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2102H-B.TST.
- --     SPW  08/25/87  CORRECTED EXCEPTION HANDLING.
- --     BCB  09/28/88  ADDED EXCEPTION HANDLERS FOR DELETE STATEMENTS.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102C IS
- 
-      NAME1 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME1";
-                -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
-                -- CONTAINS INVALID CHARACTERS OR IS TOO LONG.
- 
-      NAME2 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME2";
-                -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
-                -- CONTAINS A WILD CARD CHARACTER OR IS TOO LONG.
- 
- BEGIN
- 
-      TEST ("CE2102C", "CHECK THAT NAME_ERROR IS RAISED BY OPEN AND " &
-                       "CREATE WHEN NAME DOES NOT IDENTIFY AN " &
-                       "EXTERNAL FILE FOR SEQUENTIAL_IO");
- 
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
- 
- -- CHECK WHETHER CREATE RAISES USE_ERROR
- 
-           BEGIN
-                CREATE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("TEMPORARY SEQUENTIAL FILES WITH " &
-                                     "OUT_FILE MODE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE");
-                     RAISE INCOMPLETE;
-           END;
-           CLOSE (FILE1);
- 
-           BEGIN
-                CREATE(FILE1, OUT_FILE, NAME1);
-                FAILED ("NAME_ERROR NOT RAISED - CREATE SEQ 1");
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED - CREATE SEQ 1");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CREATE SEQ 1");
-           END;
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, NAME2);
-                FAILED("NAME_ERROR NOT RAISED - CREATE SEQ 2");
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED - CREATE SEQ 2");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CREATE SEQ 2");
-           END;
- 
- -- CHECK WHETHER OPEN RAISES NAME_ERROR IN THE CASE OF A LEGAL FILE
- -- NAME BUT A NON-EXISTENT FILE.
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                FAILED("NAME_ERROR NOT RAISED - OPEN SEQ");
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED - OPEN SEQ");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - OPEN SEQ");
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE2102C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- CE2102D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
- --     IMPLEMENTATION FOR SEQUENTIAL_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT IN_FILE FOR CREATE FOR SEQUENTIAL_IO.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102D IS
- BEGIN
- 
-      TEST ("CE2102D", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF CREATE FOR SEQUENTIAL_IO");
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-      BEGIN
-           CREATE (FILE1, IN_FILE);
-           CLOSE (FILE1);
-           NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-      END;
- 
-      RESULT;
- 
- END CE2102D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CE2102E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
- --     IMPLEMENTATION FOR SEQUENTIAL_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OUT_FILE FOR CREATE FOR SEQUENTIAL_IO.
- 
- -- HISTORY:
- --     SPS 08/26/82
- --     JBG 06/04/84
- --     EG  05/08/85
- --     TBN 07/23/87  COMPLETELY REVISED TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102E IS
- BEGIN
- 
-      TEST ("CE2102E", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF CREATE FOR SEQUENTIAL_IO");
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-      BEGIN
-           CREATE (FILE1, OUT_FILE);
-           CLOSE (FILE1);
-           NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-      END;
- 
-      RESULT;
- 
- END CE2102E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- CE2102F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
- --     INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY
- --     THE IMPLEMENTATION FOR DIRECT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT INOUT_FILE FOR CREATE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     SPS 08/26/82
- --     JBG 06/04/84
- --     TBN 07/23/87  COMPLETELY REVISED TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102F IS
- BEGIN
- 
-      TEST ("CE2102F", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "INOUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF CREATE FOR DIRECT_IO");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-      BEGIN
-           CREATE (FILE1, INOUT_FILE);
-           CLOSE (FILE1);
-           NOT_APPLICABLE ("CREATE WITH MODE INOUT_FILE ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-      END;
- 
-      RESULT;
- 
- END CE2102F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- CE2102G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
- --     SUPPORT RESET FOR SEQUENTIAL_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     SPS 08/27/82
- --     JBG 06/04/84
- --     TBN 02/12/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2102K.ADA.
- --     TBN 09/15/87  COMPLETELY REVISED TEST.
- 
- WITH SEQUENTIAL_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE CE2102G IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
-      TEST ("CE2102G", "CHECK THAT USE_ERROR IS RAISED IF AN " &
-                       "IMPLEMENTATION DOES NOT SUPPORT RESET FOR " &
-                       "SEQUENTIAL_IO");
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-           INT1 : INTEGER := IDENT_INT(1);
-           INT2 : INTEGER := 2;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
-                                     "SEQUENTIAL FILE WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
-                                     "SEQUENTIAL FILE WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, INT2);
-           BEGIN
-                RESET (FILE1, IN_FILE);
-                COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS ALLOWED");
-                BEGIN
-                     READ (FILE1, INT1);
-                     IF INT1 /= IDENT_INT(2) THEN
-                          FAILED ("RESETTING FROM OUT_FILE TO IN_FILE " &
-                                  "AFFECTED DATA");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
-                                  "READING FROM FILE");
-                END;
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS NOT " &
-                              "ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM OUT_FILE TO IN_FILE");
-           END;
- 
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
-                                     "SEQUENTIAL FILE WITH IN_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                RESET (FILE1, OUT_FILE);
-                COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS NOT " &
-                              "ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM IN_FILE TO OUT_FILE");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE2102G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,136 ****
- -- CE2102H.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NAME_ERROR IS RAISED WHEN THE NAME STRING DOES NOT
- --     IDENTIFY AN EXTERNAL FILE FOR AN OPEN OR CREATE OPERATION FOR
- --     DIRECT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH INOUT_FILE MODE FOR TEMPORARY DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 02/12/86
- --     SPW 08/26/87  CORRECTED EXCEPTION HANDLING.
- --     BCB 09/28/88  ADDED EXCEPTION HANDLERS FOR DELETE STATEMENTS.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102H IS
- 
-      NAME1 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME1";
-                -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
-                -- CONTAINS INVALID CHARACTERS OR IS TOO LONG.
- 
-      NAME2 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME2";
-                -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
-                -- CONTAINS A WILD CARD CHARACTER OR IS TOO LONG.
- 
- BEGIN
- 
-      TEST ("CE2102H", "CHECK THAT NAME_ERROR IS RAISED BY OPEN AND " &
-                       "CREATE WHEN NAME DOES NOT IDENTIFY AN " &
-                       "EXTERNAL FILE FOR DIRECT_IO");
- 
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
- 
- -- CHECK WHETHER CREATE RAISES USE_ERROR
- 
-           BEGIN
-                CREATE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("TEMPORARY DIRECT FILES WITH " &
-                                     "INOUT_FILE MODE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE");
-                     RAISE INCOMPLETE;
-           END;
-           CLOSE (FILE1);
- 
-           BEGIN
-                CREATE(FILE1, OUT_FILE, NAME1);
-                FAILED ("NAME_ERROR NOT RAISED - CREATE DIR 1");
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED - CREATE DIR 1");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 1");
-           END;
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, NAME2);
-                FAILED("NAME_ERROR NOT RAISED - CREATE DIR 2");
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED - CREATE DIR 2");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 2");
-           END;
- 
- -- CHECK WHETHER OPEN RAISES NAME_ERROR IN THE CASE OF A LEGAL FILE NAME
- -- BUT A NON-EXISTENT FILE.
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                FAILED("NAME_ERROR NOT RAISED - OPEN DIR");
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED - OPEN DIR");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - OPEN DIR");
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE2102H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- CE2102I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY
- --     THE IMPLEMENTATION FOR DIRECT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT IN_FILE FOR CREATE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102I IS
- BEGIN
- 
-      TEST ("CE2102I", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF CREATE FOR DIRECT_IO");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-      BEGIN
-           CREATE (FILE1, IN_FILE);
-           CLOSE (FILE1);
-           NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-      END;
- 
-      RESULT;
- 
- END CE2102I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- CE2102J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY
- --     THE IMPLEMENTATION FOR DIRECT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OUT_FILE FOR CREATE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     SPS 08/26/82
- --     JBG 06/04/84
- --     EG  05/08/85
- --     TBN 07/23/87  COMPLETELY REVISED TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102J IS
- BEGIN
- 
-      TEST ("CE2102J", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF CREATE FOR DIRECT_IO");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-      BEGIN
-           CREATE (FILE1, OUT_FILE);
-           CLOSE (FILE1);
-           NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-      END;
- 
-      RESULT;
- 
- END CE2102J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,248 ****
- -- CE2102K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
- --     SUPPORT RESET FOR DIRECT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 02/12/86  CREATED ORIGINAL TEST.
- --     TBN 09/15/87  COMPLETELY REVISED TEST.
- 
- WITH DIRECT_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE CE2102K IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
-      TEST ("CE2102K", "CHECK THAT USE_ERROR IS RAISED IF AN " &
-                       "IMPLEMENTATION DOES NOT SUPPORT RESET FOR " &
-                       "DIRECT_IO");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INT1 : INTEGER := IDENT_INT(1);
-           INT2 : INTEGER := 2;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
-                                     "DIRECT FILE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
-                                     "DIRECT FILE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, INT2);
- 
-      -- RESETTING FROM OUT_FILE TO IN_FILE.
- 
-           BEGIN
-                RESET (FILE1, IN_FILE);
-                COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS ALLOWED");
-                BEGIN
-                     READ (FILE1, INT1);
-                     IF INT1 /= IDENT_INT(2) THEN
-                          FAILED ("RESETTING FROM OUT_FILE TO IN_FILE " &
-                                  "AFFECTED DATA");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
-                                  "READING FROM FILE - 1");
-                END;
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS NOT " &
-                              "ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM OUT_FILE TO IN_FILE");
-           END;
- 
-           CLOSE (FILE1);
- 
-      -- RESETTING FROM OUT_FILE TO INOUT_FILE.
- 
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           WRITE (FILE1, INT2);
-           BEGIN
-                RESET (FILE1, INOUT_FILE);
-                COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS ALLOWED");
-                BEGIN
-                     READ (FILE1, INT1);
-                     IF INT1 /= IDENT_INT(2) THEN
-                          FAILED ("RESETTING FROM OUT_FILE TO " &
-                                  "INOUT_FILE AFFECTED DATA");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
-                                  "READING FROM FILE - 2");
-                END;
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS " &
-                              "NOT ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM OUT_FILE TO INOUT_FILE");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      -- RESETTING FROM IN_FILE TO OUT_FILE.
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
-                                     "DIRECT FILE WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                RESET (FILE1, OUT_FILE);
-                COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS NOT " &
-                              "ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM IN_FILE TO OUT_FILE");
-           END;
- 
-           CLOSE (FILE1);
- 
-      -- RESETTING FROM IN_FILE TO INOUT_FILE.
- 
-           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
- 
-           BEGIN
-                RESET (FILE1, INOUT_FILE);
-                COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS ALLOWED");
-                BEGIN
-                     READ (FILE1, INT1);
-                     IF INT1 /= IDENT_INT(2) THEN
-                          FAILED ("RESETTING FROM IN_FILE TO " &
-                                  "INOUT_FILE AFFECTED DATA");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
-                                  "READING FROM FILE - 3");
-                END;
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS " &
-                              "NOT ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM IN_FILE TO INOUT_FILE");
-           END;
- 
-           CLOSE (FILE1);
- 
-      -- RESETTING FROM INOUT_FILE TO IN_FILE.
- 
-           BEGIN
-                OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
-                                     "DIRECT FILE WITH INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                RESET (FILE1, IN_FILE);
-                COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS ALLOWED");
-                BEGIN
-                     READ (FILE1, INT1);
-                     IF INT1 /= IDENT_INT(2) THEN
-                          FAILED ("RESETTING FROM INOUT_FILE TO " &
-                                  "IN_FILE AFFECTED DATA");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
-                                  "READING FROM FILE - 2");
-                END;
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS " &
-                              "NOT ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM INOUT_FILE TO IN_FILE");
-           END;
- 
-           CLOSE (FILE1);
- 
-      -- RESETTING FROM INOUT_FILE TO OUT_FILE.
- 
-           OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
- 
-           BEGIN
-                RESET (FILE1, OUT_FILE);
-                COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS " &
-                              "NOT ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
-                             "RESETTING FROM INOUT_FILE TO OUT_FILE");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE2102K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- CE2102L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
- --     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE SEQUENTIAL_IO.
- 
- --          B) UNOPENED FILES
- 
- -- HISTORY:
- --     SPW 07/29/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102L IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
-      USE SEQ_IO;
- 
-      TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
-      STR : STRING (1 .. 10);
-      FL_MODE : SEQ_IO.FILE_MODE ;
- 
- BEGIN
- 
-      TEST ("CE2102L", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
-                       "PERFORMING ILLEGAL OPERATIONS ON UNOPENED " &
-                       "FILES OF TYPE SEQUENTIAL_IO");
- 
- -- CHECK TO SEE THAT PROPER EXCEPTIONS ARE RAISED WHEN
- -- PERFORMING OPERATIONS ON AN UNOPENED FILE
- 
- -- CLOSE AN UNOPENED FILE
- 
-      BEGIN
-           CLOSE (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
-                   "FILE IS USED IN A CLOSE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON CLOSE");
-      END;
- 
- -- DELETE AN UNOPENED FILE
- 
-      BEGIN
-           DELETE (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
-                   "FILE IS USED IN A DELETE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON DELETE");
-      END;
- 
- -- RESET UNOPENED FILE
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
-                   "FILE IS USED IN A RESET");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON RESET");
-      END;
- 
-      BEGIN
-           RESET (TEST_FILE_ONE, IN_FILE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED FILE " &
-                   "IS USED IN A RESET WITH MODE PARAMETER");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON RESET " &
-                        "WITH MODE");
-      END;
- 
- -- ATTEMPT TO DETERMINE MODE OF UNOPENED FILE
- 
-      BEGIN
-           FL_MODE := MODE (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED " &
-                   "FILE IS USED IN A MODE OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON MODE");
-      END;
- 
- -- ATTEMPT TO DETERMINE NAME OF UNOPENED FILE
- 
-      BEGIN
-           STR := NAME (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED " &
-                   "FILE IS USED IN A NAME OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON NAME");
-      END;
- 
- --ATTEMPT TO DETERMINE FORM OF UNOPENED FILE
- 
-      BEGIN
-           STR := FORM (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
-                   "FILE IS USED IN A FORM OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON FORM");
-      END;
- 
-      RESULT;
- 
- END CE2102L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- CE2102M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
- --     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE DIRECT_IO.
- 
- --          B) UNOPENED FILES
- 
- -- HISTORY:
- --     SPW 02/24/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102M IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
-      USE DIR_IO;
- 
-      TEST_FILE_ONE : DIR_IO.FILE_TYPE;
-      STR : STRING (1 .. 10);
-      FL_MODE : DIR_IO.FILE_MODE ;
- 
- BEGIN
- 
-      TEST ("CE2102M", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
-                       "PERFORMING ILLEGAL OPERATIONS ON UNOPENED " &
-                       "FILES OF TYPE DIRECT_IO");
- 
- -- CHECK TO SEE THAT PROPER EXCEPTIONS ARE RAISED WHEN
- -- PERFORMING OPERATIONS ON AN UNOPENED FILE
- 
- -- CLOSE AN UNOPENED FILE
- 
-      BEGIN
-           CLOSE (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
-                   "IS USED IN A CLOSE OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON CLOSE");
-      END;
- 
- -- DELETE AN UNOPENED FILE
- 
-      BEGIN
-           DELETE (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
-                   "IS USED IN A DELETE OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON DELETE");
-      END;
- 
- -- RESET UNOPENED FILE
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
-                   "IS USED IN A RESET");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON RESET");
-      END;
- 
-      BEGIN
-           RESET (TEST_FILE_ONE, IN_FILE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
-                   "IS USED IN A RESET WITH MODE PARAMETER");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON RESET WITH " &
-                        "MODE PARAMETER");
-      END;
- 
- -- ATTEMPT TO DETERMINE MODE OF UNOPENED FILE
- 
-      BEGIN
-           FL_MODE := MODE (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
-                   "IS USED IN A MODE OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON MODE");
-      END;
- 
- -- ATTEMPT TO DETERMINE NAME OF UNOPENED FILE
- 
-      BEGIN
-           STR := NAME (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
-                   "IS USED IN A NAME OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON NAME");
-      END;
- 
- --ATTEMPT TO DETERMINE FORM OF UNOPENED FILE
- 
-      BEGIN
-           STR := FORM (TEST_FILE_ONE);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
-                   "IS USED IN A FORM OPERATION");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON FORM");
-      END;
- 
-      RESULT;
- END CE2102M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2102N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
- --     IMPLEMENTATION FOR SEQUENTIAL_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OPEN WITH IN_FILE MODE FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102N IS
- BEGIN
- 
-      TEST ("CE2102N", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF OPEN FOR SEQUENTIAL FILES");
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-           END;
- 
-           IF IS_OPEN (FILE1) THEN
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CE2102O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR RESET BY THE
- --     IMPLEMENTATION FOR SEQUENTIAL FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT RESET WITH IN_FILE MODE FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102O IS
- BEGIN
- 
-      TEST ("CE2102O", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
-                       "A FILE OF MODE IN_FILE, WHEN IN_FILE MODE IS " &
-                       "NOT SUPPORTED FOR RESET BY THE IMPLEMENTATION " &
-                       "FOR SEQUENTIAL FILES");
- 
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                BEGIN
-                     OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT " &
-                                          "SUPPORTED");
-                          RAISE INCOMPLETE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                          RAISE INCOMPLETE;
-                END;
- 
-                BEGIN
-                     RESET (FILE1);
-                     NOT_APPLICABLE ("RESET FOR IN_FILE MODE IS " &
-                                     "SUPPORTED");
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                                  "RESET");
-                END;
-           EXCEPTION
-                WHEN INCOMPLETE =>
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2102P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
- --     IMPLEMENTATION FOR SEQUENTIAL_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OPEN WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102P IS
- BEGIN
- 
-      TEST ("CE2102P", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF OPEN FOR SEQUENTIAL FILES");
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-                NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-           END;
- 
-           IF IS_OPEN (FILE1) THEN
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- CE2102Q.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR RESET BY THE
- --     IMPLEMENTATION FOR SEQUENTIAL FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT RESET WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2102Q IS
- BEGIN
- 
-      TEST ("CE2102Q", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
-                       "A FILE OF MODE OUT_FILE, WHEN OUT_FILE MODE " &
-                       "IS NOT SUPPORTED FOR RESET BY THE " &
-                       "IMPLEMENTATION FOR SEQUENTIAL FILES");
- 
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
- 
-           BEGIN
-                RESET (FILE1);
-                NOT_APPLICABLE ("RESET FOR OUT_FILE MODE IS SUPPORTED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102Q;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2102R.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
- --     INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
- --     IMPLEMENTATION FOR DIRECT FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OPEN WITH INOUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102R IS
- BEGIN
- 
-      TEST ("CE2102R", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "INOUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF OPEN FOR DIRECT FILES");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-                NOT_APPLICABLE ("OPEN FOR INOUT_FILE MODE ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-           END;
- 
-           IF IS_OPEN (FILE1) THEN
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102R;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2102S.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
- --     INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR RESET BY
- --     THE IMPLEMENTATION FOR DIRECT FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT RESET WITH INOUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102S IS
- BEGIN
- 
-      TEST ("CE2102S", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
-                       "A FILE OF MODE INOUT_FILE, WHEN INOUT_FILE " &
-                       "MODE IS NOT SUPPORTED FOR RESET BY THE " &
-                       "IMPLEMENTATION FOR DIRECT FILES");
- 
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
- 
-           BEGIN
-                RESET (FILE1);
-                NOT_APPLICABLE ("RESET FOR INOUT_FILE MODE IS " &
-                                "SUPPORTED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102S;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2102T.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
- --     IMPLEMENTATION FOR DIRECT FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OPEN WITH IN_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102T IS
- BEGIN
- 
-      TEST ("CE2102T", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF OPEN FOR DIRECT FILES");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-           END;
- 
-           IF IS_OPEN (FILE1) THEN
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102T;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CE2102U.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR RESET BY
- --     THE IMPLEMENTATION FOR DIRECT FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT RESET WITH IN_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102U IS
- BEGIN
- 
-      TEST ("CE2102U", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
-                       "A FILE OF MODE IN_FILE, WHEN IN_FILE " &
-                       "MODE IS NOT SUPPORTED FOR RESET BY THE " &
-                       "IMPLEMENTATION FOR DIRECT FILES");
- 
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                BEGIN
-                     OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN WITH IN_FILE MODE " &
-                                          "NOT SUPPORTED");
-                          RAISE INCOMPLETE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                          RAISE INCOMPLETE;
-                END;
- 
-                BEGIN
-                     RESET (FILE1);
-                     NOT_APPLICABLE ("RESET FOR IN_FILE MODE IS " &
-                                     "SUPPORTED");
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                                  "RESET");
-                END;
-           EXCEPTION
-                WHEN INCOMPLETE =>
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102U;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2102V.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
- --     IMPLEMENTATION FOR DIRECT FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OPEN WITH OUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102V IS
- BEGIN
- 
-      TEST ("CE2102V", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF OPEN FOR DIRECT FILES");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "INOUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-                NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-           END;
- 
-           IF IS_OPEN (FILE1) THEN
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102V;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2102W.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR RESET BY
- --     THE IMPLEMENTATION FOR DIRECT FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT RESET WITH OUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2102W IS
- BEGIN
- 
-      TEST ("CE2102W", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
-                       "A FILE OF MODE OUT_FILE, WHEN OUT_FILE " &
-                       "MODE IS NOT SUPPORTED FOR RESET BY THE " &
-                       "IMPLEMENTATION FOR DIRECT FILES");
- 
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           VAR1 : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, VAR1);
- 
-           BEGIN
-                RESET (FILE1);
-                NOT_APPLICABLE ("RESET FOR OUT_FILE MODE IS " &
-                                "SUPPORTED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2102W;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,85 ****
- -- CE2102X.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
- --     SUPPORT DELETION OF AN EXTERNAL SEQUENTIAL FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF A SEQUENTIAL FILE WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     TBN 09/15/87  CREATED ORIGINAL TEST.
- 
- WITH SEQUENTIAL_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE CE2102X IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
-      TEST ("CE2102X", "CHECK THAT USE_ERROR IS RAISED IF AN " &
-                       "IMPLEMENTATION DOES NOT SUPPORT DELETION " &
-                       "OF AN EXTERNAL SEQUENTIAL FILE");
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ;
-           FILE1 : FILE_TYPE;
-           INT1 : INTEGER := IDENT_INT(1);
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
-                                     "SEQUENTIAL FILE WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
-                                     "SEQUENTIAL FILE WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, INT1);
-           BEGIN
-                DELETE (FILE1);
-                COMMENT ("DELETION OF AN EXTERNAL SEQUENTIAL FILE IS " &
-                         "ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("DELETION OF AN EXTERNAL SEQUENTIAL " &
-                              "FILE IS NOT ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
-                             "DELETING AN EXTERNAL FILE");
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE2102X;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CE2102Y.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
- --     SUPPORT DELETION OF AN EXTERNAL DIRECT FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF A DIRECT FILE WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     TBN 09/15/87  CREATED ORIGINAL TEST.
- 
- WITH DIRECT_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE CE2102Y IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
-      TEST ("CE2102Y", "CHECK THAT USE_ERROR IS RAISED IF AN " &
-                       "IMPLEMENTATION DOES NOT SUPPORT DELETION " &
-                       "OF AN EXTERNAL DIRECT FILE");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-           USE DIR;
-           FILE1 : FILE_TYPE;
-           INT1 : INTEGER := IDENT_INT(1);
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
-                                     "DIRECT FILE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
-                                     "DIRECT FILE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE1, INT1);
-           BEGIN
-                DELETE (FILE1);
-                COMMENT ("DELETION OF AN EXTERNAL DIRECT FILE IS " &
-                         "ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT ("DELETION OF AN EXTERNAL DIRECT " &
-                              "FILE IS NOT ALLOWED");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
-                             "DELETING AN EXTERNAL FILE");
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE2102Y;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- CE2103A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
- --     TYPE SEQUENTIAL_IO.
- 
- --          A) UNOPENED FILES
- 
- -- HISTORY:
- --     DLD 08/10/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  06/03/85
- --     SPW 08/10/87  SPLIT CASE FOR OPENED FILES INTO CE2103C.ADA.
- --     PWB 03/07/97  ADDED CHECK FOR FILE SUPPORT.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2103A IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(CHARACTER);
-           USE SEQ_IO;
- 
-      TEST_FILE_ZERO : SEQ_IO.FILE_TYPE;
-      TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
-      TEST_FILE_TWO : SEQ_IO.FILE_TYPE;
-      TEST_FILE_THREE : SEQ_IO.FILE_TYPE;
-      TEST_FILE_FOUR : SEQ_IO.FILE_TYPE;
-      VAL : BOOLEAN;
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2103A", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
-                       "VALUES FOR UNOPENED FILES OF TYPE " &
-                       "SEQUENTIAL_IO");
- 
- -- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS SEQUENTIAL FILES AT ALL
- 
-      BEGIN
-           SEQ_IO.CREATE ( TEST_FILE_ZERO,
-                           SEQ_IO.OUT_FILE,
-                           REPORT.LEGAL_FILE_NAME );
-      EXCEPTION
-           WHEN SEQ_IO.USE_ERROR | SEQ_IO.NAME_ERROR =>
-                REPORT.NOT_APPLICABLE
-                     ( "SEQUENTIAL FILES NOT SUPPORTED -- CREATE OUT-FILE" );
-                RAISE INCOMPLETE;
-      END;
-      SEQ_IO.DELETE ( TEST_FILE_ZERO );
- 
- -- WHEN FILE IS DECLARED BUT NOT OPEN
- 
-      BEGIN
-           VAL := TRUE;
-           VAL := IS_OPEN (TEST_FILE_ONE);
-           IF VAL = TRUE THEN
-                FAILED ("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE");
-           END IF;
-      END;
- 
- -- FOLLOWING UNSUCCESSFUL CREATE
- 
-      BEGIN
-           VAL := TRUE;
-           CREATE (TEST_FILE_TWO, OUT_FILE,
-                   "$ILLEGAL_EXTERNAL_FILE_NAME1");
-           FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                VAL := IS_OPEN (TEST_FILE_TWO);
-                IF VAL = TRUE THEN
-                     FAILED ("IS_OPEN GIVES TRUE AFTER AN " &
-                             "UNSUCCESSFUL CREATE");
-                END IF;
-      END;
- 
- -- FOLLOWING UNSUCCESSFUL OPEN
- 
-      BEGIN
-           VAL := TRUE;
-           OPEN (TEST_FILE_THREE, IN_FILE,
-                 "$ILLEGAL_EXTERNAL_FILE_NAME1");
-           FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL OPEN");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                VAL := IS_OPEN (TEST_FILE_THREE);
-                IF VAL = TRUE THEN
-                     FAILED ("IS_OPEN GIVES TRUE - UNSUCCESSFUL OPEN");
-                END IF;
-      END;
- 
- -- FOLLOWING CLOSING FILE THAT IS NOT OPEN
- 
-      BEGIN
-           VAL := TRUE;
-           CLOSE (TEST_FILE_FOUR);
-           FAILED ("STATUS ERROR NOT RAISED WHEN " &
-                   "ATTEMPTING TO CLOSE AN UNOPENED FILE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                VAL := IS_OPEN (TEST_FILE_FOUR);
-                IF VAL = TRUE THEN
-                     FAILED ("IS_OPEN GIVES TRUE AFTER ATTEMPTING " &
-                             "TO CLOSE AN UNOPENED FILE");
-                END IF;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           NULL;
-           REPORT.RESULT;
-      WHEN OTHERS =>
-           REPORT.FAILED ( "UNEXPECTED EXCEPTION" );
-           REPORT.RESULT;
- END CE2103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- CE2103B.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
- --     TYPE DIRECT_IO.
- 
- --          A) UNOPENED FILES
- 
- -- HISTORY:
- --     DLD 08/10/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  06/03/85
- --     SPW 08/13/87  SPLIT CASE FOR OPEN FILES INTO CE2103D.ADA.
- --     PWB 03/07/97  ADDED CHECK FOR FILE SUPPORT.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2103B IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO(CHARACTER);
-           USE DIR_IO;
- 
-      TEST_FILE_ZERO : DIR_IO.FILE_TYPE;
-      TEST_FILE_ONE : DIR_IO.FILE_TYPE;
-      TEST_FILE_TWO : DIR_IO.FILE_TYPE;
-      TEST_FILE_THREE : DIR_IO.FILE_TYPE;
-      TEST_FILE_FOUR : DIR_IO.FILE_TYPE;
-      VAL : BOOLEAN;
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2103B", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
-                       "VALUES FOR UNOPENED FILES OF TYPE DIRECT_IO");
- 
- -- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS DIRECT FILES AT ALL
- 
-      BEGIN
-           DIR_IO.CREATE ( TEST_FILE_ZERO,
-                           DIR_IO.OUT_FILE,
-                           REPORT.LEGAL_FILE_NAME );
-      EXCEPTION
-           WHEN DIR_IO.USE_ERROR | DIR_IO.NAME_ERROR =>
-                REPORT.NOT_APPLICABLE
-                     ( "DIRECT FILES NOT SUPPORTED -- CREATE OUT-FILE" );
-                RAISE INCOMPLETE;
-      END;
-      DIR_IO.DELETE ( TEST_FILE_ZERO );
- 
- -- WHEN FILE IS DECLARED BUT NOT OPEN
- 
-      BEGIN
-           VAL := TRUE;
-           VAL := IS_OPEN (TEST_FILE_ONE);
-           IF VAL = TRUE THEN
-                FAILED ("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE");
-           END IF;
-      END;
- 
- -- FOLLOWING UNSUCCESSFUL CREATE
- 
-      BEGIN
-           VAL := TRUE;
-           CREATE (TEST_FILE_TWO, OUT_FILE,
-                   "$ILLEGAL_EXTERNAL_FILE_NAME1");
-           FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                VAL := IS_OPEN (TEST_FILE_TWO);
-                IF VAL = TRUE THEN
-                     FAILED ("IS_OPEN GIVES TRUE AFTER AN " &
-                             "UNSUCCESSFUL CREATE");
-                END IF;
-      END;
- 
- -- FOLLOWING UNSUCCESSFUL OPEN
- 
-      BEGIN
-           VAL := TRUE;
-           OPEN (TEST_FILE_THREE, IN_FILE,
-                 "$ILLEGAL_EXTERNAL_FILE_NAME2");
-           FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL OPEN");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                VAL := IS_OPEN (TEST_FILE_THREE);
-                IF VAL = TRUE THEN
-                     FAILED ("IS_OPEN GIVES TRUE - UNSUCCESSFUL OPEN");
-                END IF;
-      END;
- 
- -- FOLLOWING CLOSING FILE THAT IS NOT OPEN
- 
-      BEGIN
-           VAL := TRUE;
-           CLOSE (TEST_FILE_FOUR);
-           FAILED ("STATUS ERROR NOT RAISED WHEN ATTEMPTING " &
-                   "CLOSE AN UNOPENED FILE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                VAL := IS_OPEN (TEST_FILE_FOUR);
-                IF VAL = TRUE THEN
-                     FAILED ("IS_OPEN GIVES TRUE AFTER ATTEMPTING " &
-                             "TO CLOSE AN UNOPENED FILE");
-                END IF;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           NULL;
-           REPORT.RESULT;
-      WHEN OTHERS =>
-           REPORT.FAILED ( "UNEXPECTED EXCEPTION" );
-           REPORT.RESULT;
- END CE2103B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- CE2103C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
- --     TYPE SEQUENTIAL_IO.
- 
- --          B) OPENED FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     SPW 08/10/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2103C IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(CHARACTER);
-      USE SEQ_IO;
-      INCOMPLETE : EXCEPTION;
-      TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
-      VAL : BOOLEAN;
- 
- BEGIN
- 
-      TEST ("CE2103C", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
-                       "VALUES FOR FILES OF TYPE SEQUENTIAL_IO");
- 
- -- FOLLOWING A CREATE
- 
-      VAL := FALSE;
- 
-      BEGIN
-           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
- 
-      IF VAL = FALSE THEN
-           FAILED ("IS_OPEN RETURNS FALSE AFTER CREATE");
-      END IF;
- 
- -- FOLLOWING CLOSE
- 
-      VAL := TRUE;
-      CLOSE (TEST_FILE_ONE);
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = TRUE THEN
-           FAILED ("IS_OPEN RETURNS TRUE AFTER CLOSE");
-      END IF;
- 
- -- FOLLOWING OPEN
- 
-      VAL := FALSE;
- 
-      BEGIN
-           OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
-                     FAILED ("IS_OPEN GIVES TRUE ON " &
-                             "UNSUCESSFUL OPEN");
-                END IF;
-                RAISE INCOMPLETE;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = FALSE THEN
-           FAILED ("IS_OPEN RETURNS FALSE AFTER OPEN");
-      END IF;
- 
- -- AFTER RESET
- 
-      VAL := FALSE;
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = FALSE THEN
-           FAILED ("IS_OPEN RETURNS FALSE AFTER RESET");
-      END IF;
- 
- -- AFTER DELETE
- 
-      VAL := TRUE;
- 
-      BEGIN
-           DELETE (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
-                     FAILED ("IS_OPEN GIVES TRUE ON UNSUCCESSFUL " &
-                             "DELETE");
-                END IF;
-                RAISE INCOMPLETE;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = TRUE THEN
-           FAILED ("IS_OPEN RETURNS TRUE AFTER DELETE");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
- 
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2103C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- CE2103D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
- --     TYPE DIRECT_IO.
- 
- --          B) OPENED FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTAIONS WHICH SUPPORT
- --     CREATION OF EXTERNAL FILES FOR DIRECT FILES.
- 
- -- HISTORY:
- --     SPW 08/13/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2103D IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO(CHARACTER);
-      USE DIR_IO;
-      INCOMPLETE : EXCEPTION;
-      TEST_FILE_ONE : DIR_IO.FILE_TYPE;
-      VAL : BOOLEAN;
- 
- BEGIN
- 
-      TEST ("CE2103D", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
-                       "VALUES FOR FILES OF TYPE DIRECT_IO");
- 
- -- FOLLOWING A CREATE
- 
-      VAL := FALSE;
- 
-      BEGIN
-           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = FALSE THEN
-           FAILED ("IS_OPEN RETURNS FALSE AFTER CREATE");
-      END IF;
- 
- -- FOLLOWING CLOSE
- 
-      VAL := TRUE;
-      CLOSE (TEST_FILE_ONE);
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = TRUE THEN
-           FAILED ("IS_OPEN RETURNS TRUE AFTER CLOSE");
-      END IF;
- 
- -- FOLLOWING OPEN
- 
-      VAL := FALSE;
- 
-      BEGIN
-           OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
-                     FAILED ("IS_OPEN GIVES TRUE ON " &
-                             "UNSUCCESSFUL OPEN");
-                END IF;
-                RAISE INCOMPLETE;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = FALSE THEN
-           FAILED ("IS_OPEN RETURNS FALSE AFTER OPEN");
-      END IF;
- 
- -- AFTER RESET
- 
-      VAL := FALSE;
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = FALSE THEN
-           FAILED ("IS_OPEN RETURNS FALSE AFTER RESET");
-      END IF;
- 
- -- AFTER DELETE
- 
-      VAL := TRUE;
- 
-      BEGIN
-           DELETE (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
-                     FAILED ("IS_OPEN GIVES TRUE ON UNSUCCESSFUL " &
-                             "DELETE");
-                END IF;
-                RAISE INCOMPLETE;
-      END;
- 
-      VAL := IS_OPEN (TEST_FILE_ONE);
-      IF VAL = TRUE THEN
-           FAILED ("IS_OPEN RETURNS TRUE AFTER DELETE");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
- 
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2103D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- CE2104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FILE CAN BE CLOSED AND THEN RE-OPENED.
- 
- --          A) SEQUENTIAL FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
- --     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
- 
- -- HISTORY:
- --     DLD 08/11/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  06/03/85
- --     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
- --                   HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2104A IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
-      USE SEQ_IO;
- 
-      SEQ_FILE : SEQ_IO.FILE_TYPE;
-      VAR : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2104A", "CHECK THAT A FILE CAN BE CLOSED " &
-                       "AND THEN RE-OPENED");
- 
- -- INITIALIZE TEST FILE
- 
-      BEGIN
-           CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                RAISE INCOMPLETE;
- 
-      END;
- 
-      WRITE (SEQ_FILE, 17);
-      CLOSE (SEQ_FILE);
- 
- -- RE-OPEN SEQUENTIAL TEST FILE
- 
-      BEGIN
-           OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      READ (SEQ_FILE, VAR);
-      IF VAR /= 17 THEN
-           FAILED ("WRONG DATA RETURNED FROM READ - " &
-                   "SEQUENTIAL");
-      END IF;
- 
- -- DELETE TEST FILE
- 
-      BEGIN
- 
-           DELETE (SEQ_FILE);
- 
-      EXCEPTION
- 
-           WHEN USE_ERROR =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
- 
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- CE2104B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NAME RETURNED BY NAME CAN BE USED IN A
- --     SUBSEQUENT OPEN.
- 
- --          A) SEQUENTIAL FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
- --     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
- 
- -- HISTORY:
- --     DLD 08/11/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/31/85
- --     TBN 11/04/86  ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED IS
- --                   CALLED FOR OPEN OR CREATE.
- --     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
- --                   HANDLING.
- 
- WITH SEQUENTIAL_IO;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CE2104B IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
-      USE SEQ_IO;
-      TYPE ACC_STR IS ACCESS STRING;
- 
-      SEQ_FILE_ONE : SEQ_IO.FILE_TYPE;
-      SEQ_FILE_TWO : SEQ_IO.FILE_TYPE;
-      SEQ_FILE_NAME : ACC_STR;
-      VAR : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2104B", "CHECK THAT THE NAME RETURNED BY NAME " &
-                       "CAN BE USED IN A SUBSEQUENT OPEN");
- 
- -- CREATE TEST FILE
- 
-      BEGIN
-           CREATE(SEQ_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      WRITE (SEQ_FILE_ONE, 14);
-      SEQ_FILE_NAME := NEW STRING'(NAME(SEQ_FILE_ONE));
-      CLOSE (SEQ_FILE_ONE);
- 
- -- ATTEMPT TO RE-OPEN SEQUENTIAL TEST FILE USING RETURNED NAME VALUE
- 
-      BEGIN
-           OPEN (SEQ_FILE_TWO, IN_FILE, SEQ_FILE_NAME.ALL);
-      EXCEPTION
-           WHEN SEQ_IO.USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN SEQ_IO.NAME_ERROR =>
-                FAILED ("STRING NOT ACCEPTED AS NAME FOR FILE - SEQ");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("FILE NOT RE-OPENED - SEQ");
-                RAISE INCOMPLETE;
-      END;
- 
-      READ (SEQ_FILE_TWO, VAR);
-      IF VAR /= 14 THEN
-           FAILED ("WRONG DATA RETURNED FROM READ -SEQ");
-      END IF;
- 
- -- DELETE TEST FILE
- 
-      BEGIN
-           DELETE (SEQ_FILE_TWO);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                COMMENT ("DELETION OF EXTERNAL FILE IS NOT SUPPORTED");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
- 
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2104B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- CE2104C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FILE CAN BE CLOSED AND THEN RE-OPENED.
- 
- --          B) DIRECT FILES
- 
- -- APPLICABLILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
- --     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
- 
- -- HISTORY:
- --     DLD 08/11/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  06/03/85
- --     PWB 02/10/86  CORRECTED REPORTED TEST NAME; CHANGED DATA FILE
- --                   NAME TO "Y2104C" TO MATCH TEST NAME.
- --     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
- --                   HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2104C IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
-      USE DIR_IO;
- 
-      DIR_FILE : DIR_IO.FILE_TYPE;
-      VAR : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2104C", "CHECK THAT A FILE CAN BE CLOSED " &
-                       "AND THEN RE-OPENED");
- 
- -- INITIALIZE TEST FILE
- 
-      BEGIN
-           CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                RAISE INCOMPLETE;
- 
-      END;
- 
-      WRITE (DIR_FILE, 28);
-      CLOSE (DIR_FILE);
- 
- -- RE-OPEN DIRECT TEST FILE
- 
-      BEGIN
-           OPEN (DIR_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      READ (DIR_FILE, VAR);
-      IF VAR /= 28 THEN
-           FAILED ("WRONG DATA RETURNED FROM READ - DIRECT");
-      END IF;
- 
- -- DELETE TEST FILE
- 
-      BEGIN
-           DELETE (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
- 
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2104C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- CE2104D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NAME RETURNED BY NAME CAN BE USED IN A
- --     SUBSEQUENT OPEN.
- 
- --          B) DIRECT FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
- --     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
- 
- -- HISTORY:
- --     DLD 08/11/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/31/85
- --     TBN 11/04/86  ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED IS
- --                   CALLED FOR OPEN OR CREATE.
- --     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
- --                   HANDLING.
- 
- WITH DIRECT_IO;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CE2104D IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
-      USE DIR_IO;
-      TYPE ACC_STR IS ACCESS STRING;
- 
-      DIR_FILE_ONE : DIR_IO.FILE_TYPE;
-      DIR_FILE_TWO : DIR_IO.FILE_TYPE;
-      DIR_FILE_NAME : ACC_STR;
-      VAR : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2104D", "CHECK THAT THE NAME RETURNED BY NAME " &
-                       "CAN BE USED IN A SUBSEQUENT OPEN");
- 
- -- CREATE TEST FILE
- 
-      BEGIN
-           CREATE (DIR_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      WRITE (DIR_FILE_ONE, 3);
-      DIR_FILE_NAME := NEW STRING'(NAME(DIR_FILE_ONE));
-      CLOSE (DIR_FILE_ONE);
- 
- -- ATTEMPT TO RE-OPEN DIRECT TEST FILE USING RETURNED NAME VALUE
- 
-      BEGIN
-           OPEN (DIR_FILE_TWO, IN_FILE, DIR_FILE_NAME.ALL);
-      EXCEPTION
-           WHEN DIR_IO.USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN DIR_IO.NAME_ERROR =>
-                FAILED ("STRING NOT ACCEPTED AS NAME FOR FILE - DIR");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("FILE NOT RE-OPENED - DIR");
-                RAISE INCOMPLETE;
- 
-      END;
- 
-      READ (DIR_FILE_TWO, VAR);
-      IF VAR /= 3 THEN
-           FAILED ("WRONG DATA RETURNED FROM READ - DIR");
-      END IF;
- 
- -- DELETE TEST FILE
- 
-      BEGIN
-           DELETE (DIR_FILE_TWO);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                COMMENT ("DELETION OF EXTERNAL FILE IS NOT SUPPORTED");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
- 
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2104D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- CE2106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE
- --     NAME OF THE FILE CAN BE USED IN A CREATE OPERATION.
- 
- --          A) SEQUENTIAL FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION WITH OUT_FILE MODE FOR SEQUENTIAL FILES AND
- --     DELETION OF EXTERNAL FILES.
- 
- -- HISTORY:
- --     SPS 08/25/82
- --     SPS 11/09/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 02/12/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2106B.ADA.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     SPW 08/07/87  INSERTED ALLOWABLE EXCEPTION USE_ERROR ON
- --                   DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2106A IS
- 
- BEGIN
- 
-      TEST ("CE2106A", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " &
-                       "AFTER AN EXTERNAL FILE WITH SAME NAME HAS " &
-                       "BEEN DELETED FOR SEQUENTIAL_IO");
- 
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ;
-           FL1 : FILE_TYPE;
-           FL2 : FILE_TYPE;
-           T_FAILED : BOOLEAN := FALSE;
-           D_FILE : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     T_FAILED := TRUE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     T_FAILED := TRUE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
-                             "CREATE");
-                     T_FAILED := TRUE;
-           END;
- 
-           IF NOT T_FAILED THEN
-                BEGIN
-                     DELETE (FL1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("DELETION OF EXTERNAL FILE " &
-                                          "IS NOT SUPPORTED");
-                          T_FAILED := TRUE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                                  "DELETE");
-                          T_FAILED := TRUE;
-                END;
-           END IF;
- 
-           IF NOT T_FAILED THEN
-                BEGIN
-                     CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME);
-                     D_FILE := TRUE;
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR FOR RECREATE - SEQ");
-                     WHEN OTHERS =>
-                          FAILED ("UNABLE TO RECREATE FILE AFTER " &
-                                  "DELETION - SEQ");
-                END;
- 
-                IF D_FILE THEN
-                     BEGIN
-                          DELETE (FL2);
-                     EXCEPTION
-                          WHEN USE_ERROR =>
-                               FAILED ("USE_ERROR FOR DELETE - SEQ");
-                     END;
-                END IF;
-           END IF;
-      END;
- 
-      RESULT;
- 
- END CE2106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- CE2106B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE
- --     NAME OF THE FILE CAN BE USED IN A CREATE OPERATION.
- 
- --          B) DIRECT FILES
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION WITH OUT_FILE MODE FOR DIRECT FILES AND
- --     DELETION OF EXTERNAL FILES.
- 
- -- HISTORY:
- --     TBN 02/12/86
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     SPW 08/07/87  INSERTED ALLOWABLE EXCEPTION USE_ERROR ON
- --                   DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2106B IS
- BEGIN
- 
-      TEST ("CE2106B", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " &
-                       "AFTER AN EXTERNAL FILE WITH SAME NAME HAS " &
-                       "BEEN DELETED FOR DIRECT_IO");
- 
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-           USE DIR;
-           FL1 : FILE_TYPE;
-           FL2 : FILE_TYPE;
-           T_FAILED : BOOLEAN := FALSE;
-           D_FILE : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; DIRECT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     T_FAILED := TRUE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; DIRECT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     T_FAILED := TRUE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED; DIRECT " &
-                             "CREATE");
-                     T_FAILED := TRUE;
-           END;
- 
-           IF NOT T_FAILED THEN
-                BEGIN
-                     DELETE (FL1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("DELETION OF EXTERNAL FILE " &
-                                          "IS NOT SUPPORTED");
-                          T_FAILED := TRUE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                                  "DELETE");
-                          T_FAILED := TRUE;
-                END;
-           END IF;
- 
-           IF NOT T_FAILED THEN
-                BEGIN
-                     CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME);
-                     D_FILE := TRUE;
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR FOR RECREATE - DIR");
-                     WHEN OTHERS =>
-                          FAILED ("UNABLE TO RECREATE FILE AFTER " &
-                                  "DELETION - DIR");
-                END;
- 
-                IF D_FILE THEN
-                     BEGIN
-                          DELETE (FL2);
-                     EXCEPTION
-                          WHEN USE_ERROR =>
-                               FAILED ("USE_ERROR WHILE DELETING DIR " &
-                                       "FILE");
-                     END;
-                END IF;
-           END IF;
-      END;
- 
-      RESULT;
- 
- END CE2106B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CE2108E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL SEQUENTIAL FILE SPECIFIED BY A NON-NULL
- --     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
- --     PROGRAM.
- 
- --     THIS TEST CREATES A SEQUENTIAL FILE;  CE2108F.ADA READS IT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF AN EXTERNAL SEQUENTIAL FILE WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     TBN 07/16/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2108E IS
- 
-      PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-      INCOMPLETE : EXCEPTION;
-      FILE_NAME : SEQ.FILE_TYPE;
-      PREVENT_EMPTY_FILE : NATURAL := 5;
- 
- BEGIN
- 
-      TEST ("CE2108E" , "CHECK THAT AN EXTERNAL SEQUENTIAL FILE " &
-                        "SPECIFIED BY A NON-NULL STRING NAME IS " &
-                        "ACCESSIBLE AFTER THE COMPLETION OF THE MAIN " &
-                        "PROGRAM");
-      BEGIN
-           BEGIN
-                SEQ.CREATE (FILE_NAME, SEQ.OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN SEQ.USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN SEQ.NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "SEQUENTIAL CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SEQ.WRITE (FILE_NAME, PREVENT_EMPTY_FILE);
-           SEQ.CLOSE (FILE_NAME);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2108E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- CE2108F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL SEQUENTIAL FILE SPECIFIED BY A NON-NULL
- --     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
- --     PROGRAM.
- 
- --     THIS TEST CHECKS THE CREATION OF A SEQUENTIAL FILE WHICH WAS
- --     CREATED BY CE2108E.ADA.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     TBN 07/16/87  CREATED ORIGINAL TESTED.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2108F IS
- 
-      PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-      USE SEQ;
-      INCOMPLETE : EXCEPTION;
-      CHECK_SUPPORT, FILE_NAME : FILE_TYPE;
-      PREVENT_EMPTY_FILE : NATURAL := 0;
- 
- BEGIN
-      TEST ("CE2108F", "CHECK THAT AN EXTERNAL SEQUENTIAL FILE " &
-                       "SPECIFIED BY A NON-NULL STRING NAME IS " &
-                       "ACCESSIBLE AFTER THE COMPLETION OF THE MAIN " &
-                       "PROGRAM");
- 
-      -- TEST FOR SEQUENTIAL FILE SUPPORT.
- 
-      BEGIN
-           CREATE (CHECK_SUPPORT, OUT_FILE, LEGAL_FILE_NAME);
-           BEGIN
-                DELETE (CHECK_SUPPORT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON DELETE");
-           END;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " &
-                                "CREATE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " &
-                                "CREATE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                        "SEQUENTIAL CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      -- BEGIN TEST OBJECTIVE.
- 
-      BEGIN
-           OPEN (FILE_NAME, IN_FILE, LEGAL_FILE_NAME(1, "CE2108E"));
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN FOR " &
-                                "SEQUENTIAL FILE WITH IN_FILE " &
-                                "MODE");
-                RAISE INCOMPLETE;
-      END;
-      READ (FILE_NAME, PREVENT_EMPTY_FILE);
-      IF PREVENT_EMPTY_FILE /= 5 THEN
-           FAILED ("OPENED WRONG FILE OR DATA ERROR");
-      END IF;
-      BEGIN
-           DELETE (FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " &
-                         "EXTERNAL FILE");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE2108F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- CE2108G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED BY A NON-NULL
- --     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
- --     PROGRAM.
- 
- --     THIS TEST CREATES A DIRECT FILE;  CE2108H.ADA READS IT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF AN EXTERNAL DIRECT FILE.
- 
- -- HISTORY:
- --     TBN 07/16/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2108G IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      INCOMPLETE : EXCEPTION;
-      FILE_NAME : DIR.FILE_TYPE;
-      PREVENT_EMPTY_FILE : NATURAL := 5;
- 
- BEGIN
- 
-      TEST ("CE2108G", "CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED " &
-                       "BY A NON-NULL STRING NAME IS ACCESSIBLE AFTER " &
-                       "THE COMPLETION OF THE MAIN PROGRAM");
-      BEGIN
-           BEGIN
-                DIR.CREATE (FILE_NAME, DIR.OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN DIR.USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON DIRECT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN DIR.NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON DIRECT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "DIRECT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           DIR.WRITE (FILE_NAME, PREVENT_EMPTY_FILE);
-           DIR.CLOSE (FILE_NAME);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2108G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- CE2108H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED BY A NON-NULL
- --     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
- --     PROGRAM.
- 
- --     THIS TEST CHECKS THE CREATION OF A DIRECT FILE WHICH WAS
- --     CREATED BY CE2108G.ADA.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 07/16/87  CREATED ORIGINAL TESTED.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2108H IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      INCOMPLETE : EXCEPTION;
-      CHECK_SUPPORT, FILE_NAME : FILE_TYPE;
-      PREVENT_EMPTY_FILE : NATURAL := 0;
- 
- BEGIN
-      TEST ("CE2108H", "CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED " &
-                       "BY A NON-NULL STRING NAME IS ACCESSIBLE AFTER " &
-                       "THE COMPLETION OF THE MAIN PROGRAM");
- 
-      -- TEST FOR DIRECT FILE SUPPORT.
- 
-      BEGIN
-           CREATE (CHECK_SUPPORT, OUT_FILE, LEGAL_FILE_NAME);
-           BEGIN
-                DELETE (CHECK_SUPPORT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON DIRECT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON DIRECT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON DIRECT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      -- BEGIN TEST OBJECTIVE.
- 
-      BEGIN
-           OPEN (FILE_NAME, IN_FILE, LEGAL_FILE_NAME(1, "CE2108G"));
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      READ (FILE_NAME, PREVENT_EMPTY_FILE);
-      IF PREVENT_EMPTY_FILE /= 5 THEN
-           FAILED ("OPENED WRONG FILE OR DATA ERROR");
-      END IF;
-      BEGIN
-           DELETE (FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " &
-                         "EXTERNAL FILE");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE2108H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,83 ****
- -- CE2109A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR
- --     SEQUENTIAL_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     ABW 08/13/82
- --     SPS 11/09/82
- --     JBG 11/11/83
- --     TBN 02/13/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2109B.ADA AND
- --                   TEXT_IO INTO CE2109C.ADA.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/12/87  CHANGED NOT_APPLICABLE MESSAGE, REMOVED
- --                   NAME_ERROR, AND CLOSED THE FILE.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2109A IS
- 
-      INCOMPLETE : EXCEPTION;
-      PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-      USE SEQ;
-      FILE2 : SEQ.FILE_TYPE;
- 
- BEGIN
- 
-      TEST( "CE2109A", "CHECK DEFAULT MODE IN CREATE FOR SEQ_IO");
- 
-      BEGIN
-           CREATE (FILE2);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                "OUT_FILE MODE NOT SUPPORTED");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
-                        "CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF MODE (FILE2) /= OUT_FILE THEN
-           FAILED( "MODE INCORRECTLY SET FOR SEQUENTIAL_IO" );
-      END IF;
- 
-      CLOSE (FILE2);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2109A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,80 ****
- -- CE2109B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR
- --     DIRECT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH INOUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 02/13/86
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/12/87  CHANGED NOT_APPLICABLE MESSAGE, REMOVED
- --                   NAME_ERROR, AND CLOSED THE FILE.
- --     LDC 05/26/88  CHANGED APPLICABILITY COMMENT FROM OUT_FILE TO
- --                   INOUT_FILE.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2109B IS
- 
-      INCOMPLETE : EXCEPTION;
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      FILE3 : DIR.FILE_TYPE;
- 
- BEGIN
- 
-      TEST( "CE2109B", "CHECK DEFAULT MODE IN CREATE FOR DIRECT_IO");
- 
-      BEGIN
-           CREATE (FILE3);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("CREATE OF DIRECT FILE WITH " &
-                                "INOUT_FILE MODE NOT SUPPORTED");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; DIRECT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF MODE (FILE3) /= INOUT_FILE THEN
-           FAILED( "MODE INCORRECTLY SET FOR DIRECT_IO" );
-      END IF;
- 
-      CLOSE (FILE3);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2109B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CE2109C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR
- --     TEXT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE FOR TEXT FILES.
- 
- -- HISTORY:
- --     TBN 02/13/86
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/12/87  CHANGED NOT_APPLICABLE MESSAGE, REMOVED
- --                   NAME_ERROR, AND CLOSED THE FILE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE2109C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE1 : TEXT_IO.FILE_TYPE;
- 
- BEGIN
- 
-      TEST( "CE2109C", "CHECK DEFAULT MODE IN CREATE FOR TEXT_IO");
- 
-      BEGIN
-           CREATE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("CREATE OF TEXT FILE WITH OUT_FILE" &
-                                "MODE NOT SUPPORTED");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF MODE (FILE1) /= OUT_FILE THEN
-           FAILED( "MODE INCORRECTLY SET FOR TEXT_IO" );
-      END IF;
- 
-      CLOSE (FILE1);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2109C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- CE2110A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL FILE CEASES TO EXIST AFTER A SUCCESSFUL
- --     DELETE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION AND DELETION OF SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     SPS 08/25/82
- --     SPS 11/09/82
- --     JBG 04/01/83
- --     EG  05/31/85
- --     JLH 07/21/87  ADDED A CALL TO NOT_APPLICABLE, IF EXCEPTION
- --                   USE_ERROR IS RAISED BY DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2110A IS
- BEGIN
- 
-      TEST ("CE2110A", "CHECK THAT THE EXTERNAL FILE CEASES TO EXIST " &
-                       "AFTER A SUCCESSFUL DELETE");
- 
-      DECLARE
-           PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ;
-           FL1, FL2 : FILE_TYPE;
-           VAR1 : INTEGER := 5;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
-           BEGIN
-                CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                WRITE (FL1, VAR1);     -- THIS WRITES TO THE FILE IF IT
-           EXCEPTION                   -- CAN, NOT NECESSARY FOR THE
-                WHEN OTHERS =>         -- OBJECTIVE.
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FL1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("DELETION OF EXTERNAL FILES NOT " &
-                                     "SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                OPEN (FL2, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("EXTERNAL FILE STILL EXISTS AFTER " &
-                        "A SUCCESSFUL DELETION - SEQ");
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2110A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- CE2110C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL FILE CEASES TO EXIST AFTER A SUCCESSFUL
- --     DELETE.
- 
- -- APPLICABILITY CRITERIA:
- --    THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --    CREATION AND DELETION OF DIRECT FILES.
- 
- -- HISTORY:
- --     SPS 08/25/82
- --     SPS 11/09/82
- --     JBG 04/01/83
- --     EG  05/31/85
- --     JLH 07/21/87  ADDED A CALL TO NOT_APPLICABLE IF EXCEPTION
- --                   USE_ERROR IS RAISED ON DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2110C IS
- BEGIN
- 
-      TEST ("CE2110C", "CHECK THAT THE EXTERNAL FILE CEASES TO EXIST " &
-                       "AFTER A SUCCESSFUL DELETE");
- 
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-           USE DIR;
-           FL1, FL2 : FILE_TYPE;
-           VAR1 : INTEGER := 5;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
-           BEGIN
-                CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXCEPTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                WRITE (FL1, VAR1);     -- THIS WRITES TO THE FILE IF IT
-           EXCEPTION                   -- CAN, NOT NECESSARY FOR THE
-                WHEN OTHERS =>         -- OBJECTIVE.
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FL1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("DELETION OF EXTERNAL FILE NOT " &
-                                     "SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                OPEN (FL2, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("EXTERNAL FILE STILL EXISTS AFTER " &
-                        "A SUCCESSFUL DELETION - DIR");
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2110C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,131 ****
- -- CE2111A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FILE REMAINS OPEN AFTER A RESET.
- 
- --     THIS OBJECTIVE IS BEING INTERPRETED AS : CHECK THAT A FILE
- --     REMAINS OPEN AFTER AN ATTEMPT TO RESET.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     DLD 08/13/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/28/85
- --     JLH 07/22/87  REWROTE TEST ALGORITHM.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2111A IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
-           USE SEQ_IO;
- 
-      SEQ_FILE : SEQ_IO.FILE_TYPE;
-      VAR1 : INTEGER := 5;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2111A", "CHECK THAT THE FILE REMAINS OPEN AFTER A RESET");
- 
- -- CREATE SEQUENTIAL TEST FILE
- 
-      BEGIN
-           CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
-           WRITE (SEQ_FILE, VAR1);
-           CLOSE (SEQ_FILE);
-      EXCEPTION
-           WHEN USE_ERROR | NAME_ERROR =>
-                NOT_APPLICABLE ("SEQUENTIAL FILES NOT SUPPORTED");
-                RAISE INCOMPLETE;
-      END;
- 
- -- OPEN FILE
- 
-      BEGIN
-           OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT SUPPORTED " &
-                                "FOR SEQ_IO");
-                RAISE INCOMPLETE;
-      END;
- 
- -- RESET FILE
- 
-      BEGIN
-           RESET(SEQ_FILE);
-      EXCEPTION
-           WHEN USE_ERROR  =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (SEQ_FILE) THEN
-           CLOSE (SEQ_FILE);
-      ELSE
-           FAILED ("RESET FOR IN_FILE, CLOSED FILE");
-      END IF;
- 
- -- RE-OPEN AS OUT_FILE AND REPEAT TEST
- 
-      BEGIN
-           OPEN (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " &
-                                "SUPPORTED FOR SEQ_IO");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (SEQ_FILE);
-      EXCEPTION
-           WHEN USE_ERROR  =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (SEQ_FILE) THEN
-           BEGIN
-                DELETE (SEQ_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
-      ELSE
-           FAILED ("RESET FOR OUT_FILE, CLOSED FILE");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2111A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,183 ****
- -- CE2111B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUCCESSFUL RESET POSITIONS THE INDEX CORRECTLY
- --     TO THE START OF THE FILE FOR DIRECT IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     RESET FOR DIRECT FILES.
- 
- -- HISTORY:
- --     DLD 08/13/82
- --     JBG 03/24/83
- --     EG  05/29/85
- --     JLH 07/23/87  ADDED CHECKS FOR USE_ERROR WHEN FILE IS RESET.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2111B IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-           USE DIR_IO;
-      TEST_FILE_ONE : DIR_IO.FILE_TYPE;
-      DATUM : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2111B", "CHECK THAT SUCCESSFUL RESETS POSITION THE " &
-                       "INDEX CORRECTLY");
- 
- -- CREATE AND INITIALIZE TEST FILE
- 
-      BEGIN
-           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      WRITE (TEST_FILE_ONE, 5);
-      WRITE (TEST_FILE_ONE, 6);
-      WRITE (TEST_FILE_ONE, 7);
-      WRITE (TEST_FILE_ONE, 8);
- 
- -- CHECK THAT RESET POSITIONS INDEX CORRECTLY FOR OUT_FILE
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-           IF INDEX (TEST_FILE_ONE) /= 1 THEN
-                FAILED ("RESET INCORRECTLY POSITIONED FILE FOR " &
-                        "OUT_FILE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR OUT_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- WRITE MORE DATA
- 
-      WRITE (TEST_FILE_ONE, 2);
-      CLOSE (TEST_FILE_ONE);
- 
- -- NOW CHECK TO SEE THAT RESET WORKED FOR OUT_FILE
- 
-      BEGIN
-           OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("DIR_IO NOT SUPPORTED FOR IN_FILE OPEN");
-                RAISE INCOMPLETE;
-      END;
-      READ (TEST_FILE_ONE, DATUM);
-      IF DATUM /= 2 THEN
-           FAILED ("RESET FAILED FOR OUT_FILE");
-      END IF;
- 
- -- POSITION POINTER APPROPRIATELY FOR IN_FILE RESET
- 
-      READ (TEST_FILE_ONE, DATUM);
- 
- -- RESET IN_FILE
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-           IF INDEX (TEST_FILE_ONE) /= 1 THEN
-                FAILED ("RESET INCORRECTLY POSITIONED FILE " &
-                        "FOR IN_FILE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR IN_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- VALIDATE IN_FILE RESET
- 
-      READ (TEST_FILE_ONE, DATUM);
-      IF DATUM /= 2 THEN
-           FAILED ("RESET FAILED FOR IN_FILE");
-      END IF;
- 
- -- VALIDATE RESET FOR IN_OUT FILE
- 
-      CLOSE (TEST_FILE_ONE);
-      BEGIN
-           OPEN (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("DIR_IO NOT SUPPORTED FOR INOUT_FILE " &
-                                "OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
- -- WRITE NEW DATA
- 
-      WRITE (TEST_FILE_ONE, 3);
- 
- -- RESET INOUT_FILE
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-           IF INDEX (TEST_FILE_ONE) /= 1 THEN
-                FAILED ("RESET INCORRECTLY POSITIONED FILE " &
-                        "FOR INOUT_FILE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR INOUT_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- VALIDATE RESET
- 
-      READ (TEST_FILE_ONE, DATUM);
-      IF DATUM /= 3 THEN
-           FAILED ("RESET FAILED FOR INOUT_FILE");
-      END IF;
- 
- -- DELETE TEST FILE
- 
-      BEGIN
-           DELETE (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2111B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- CE2111C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUPPLIED MODE PARAMETER IN A RESET CHANGES
- --     THE MODE OF A GIVEN FILE.  IF NO PARAMETER IS SUPPLIED
- --     THE MODE REMAINS THE SAME.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     RESET FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     DLD 08/16/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/29/85
- --     JLH 07/23/87  ADDED CHECKS FOR USE_ERROR WHEN FILE IS RESET.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2111C IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_IO;
-      SEQ_FILE : SEQ_IO.FILE_TYPE;
-      SEQ_MODE : SEQ_IO.FILE_MODE;
-      INCOMPLETE : EXCEPTION;
-      VAR1 : INTEGER := 5;
- 
- BEGIN
- 
-      TEST ("CE2111C", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " &
-                       "THE MODE OF THE GIVEN FILE APPROPRIATELY");
- 
- -- CREATE SEQUENTIAL TEST FILE
- 
-      BEGIN
-           CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
-           WRITE (SEQ_FILE, VAR1);
-           CLOSE (SEQ_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("SEQUENTIAL FILES WITH IN_FILE MODE " &
-                                "NOT SUPPORTED");
-                RAISE INCOMPLETE;
-      END;
- 
- -- RESET TO DEFAULT
- 
-      BEGIN
-           SEQ_MODE := OUT_FILE;
-           RESET (SEQ_FILE);
-           SEQ_MODE := MODE (SEQ_FILE);
-           IF SEQ_MODE /= IN_FILE THEN
-                FAILED ("DEFAULT RESET CHANGED MODE - SEQ");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR SEQ IN_FILE " &
-                                "MODE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- RESET TO OUT_FILE
- 
-      BEGIN
-           SEQ_MODE := IN_FILE;
-           RESET (SEQ_FILE, OUT_FILE);
-           SEQ_MODE := MODE (SEQ_FILE);
-           IF SEQ_MODE /= OUT_FILE THEN
-                FAILED ("RESET TO OUT_FILE FAILED - SEQ");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET FROM IN_FILE TO OUT_FILE MODE " &
-                                "NOT SUPPORTED FOR SEQ FILES");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           DELETE (SEQ_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2111C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- CE2111E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FILE REMAINS OPEN AFTER A RESET.
- 
- --     THIS OBJECTIVE IS BEING INTERPRETED AS : CHECK THAT A FILE
- --     REMAINS OPEN AFTER AN ATTEMPT TO RESET.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     DLD 08/13/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/28/85
- --     JLH 07/23/87  REWROTE TEST ALGORITHM.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2111E IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-           USE DIR_IO;
- 
-      DIR_FILE : DIR_IO.FILE_TYPE;
-      VAR1 : INTEGER := 5;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2111E", "CHECK THAT THE FILE REMAINS OPEN AFTER A RESET");
- 
- -- CREATE DIRECT TEST FILE
- 
-      BEGIN
-           CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
-           WRITE (DIR_FILE, VAR1);
-           CLOSE (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR | NAME_ERROR =>
-                NOT_APPLICABLE ("DIRECT FILES NOT SUPPORTED");
-                RAISE INCOMPLETE;
-      END;
- 
- -- OPEN FILE
- 
-      BEGIN
-           OPEN (DIR_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT SUPPORTED " &
-                                "FOR DIR_IO");
-                RAISE INCOMPLETE;
-      END;
- 
- -- RESET FILE
- 
-      BEGIN
-           RESET (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (DIR_FILE) THEN
-           CLOSE (DIR_FILE);
-      ELSE
-           FAILED ("RESET FOR IN_FILE, CLOSED FILE");
-      END IF;
- 
- 
- -- RE-OPEN AS OUT_FILE AND REPEAT TEST
- 
-      BEGIN
-           OPEN (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " &
-                                "SUPPORTED FOR DIR_IO");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (DIR_FILE) THEN
-           CLOSE (DIR_FILE);
-      ELSE
-           FAILED ("RESET FOR OUT_FILE, CLOSED FILE");
-      END IF;
- 
- -- RE-OPEN AS IN_OUT FILE AND REPEAT TEST
- 
-      BEGIN
-           OPEN (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("OPEN WITH IN_OUT FILE MODE NOT " &
-                                "SUPPORTED FOR DIR_IO");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (DIR_FILE) THEN
-           BEGIN
-                DELETE (DIR_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
-      ELSE
-           FAILED ("RESET FOR INOUT_FILE, CLOSED FILE");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2111E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- CE2111F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUCCESSFUL RESET POSITIONS THE FILE CORRECTLY
- --     TO THE START OF THE FILE FOR SEQUENTIAL IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     RESET FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     JLH 08/03/87 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2111F IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_IO;
-      TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
-      DATUM : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE2111F", "CHECK THAT SUCCESSFUL RESET POSITIONS THE " &
-                       "FILE CORRECTLY");
- 
- -- CREATE AND INITIALIZE TEST FILE
- 
-      BEGIN
-           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      WRITE (TEST_FILE_ONE, 5);
-      WRITE (TEST_FILE_ONE, 6);
- 
- -- CHECK THAT RESET POSITIONS INDEX CORRECTLY FOR OUT_FILE
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR OUT_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- WRITE MORE DATA
- 
-      WRITE (TEST_FILE_ONE, 2);
-      CLOSE (TEST_FILE_ONE);
- 
- -- NOW CHECK TO SEE THAT RESET WORKED FOR OUT_FILE
- 
-      BEGIN
-           OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("SEQ_IO NOT SUPPORTED FOR IN_FILE OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
-      READ (TEST_FILE_ONE, DATUM);
- 
-      IF DATUM /= 2 THEN
-           FAILED ("RESET INCORRECTLY POSITIONED FILE FOR OUT_FILE");
-      END IF;
- 
- 
- -- RESET IN_FILE
- 
-      BEGIN
-           RESET (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR IN_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- VALIDATE IN_FILE RESET
- 
-      READ (TEST_FILE_ONE, DATUM);
- 
-      IF DATUM /= 2 THEN
-           FAILED ("RESET INCORRECTLY POSITIONED FILE FOR IN_FILE");
-      END IF;
- 
- -- DELETE TEST FILE
- 
-      BEGIN
-           DELETE (TEST_FILE_ONE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2111F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- CE2111G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUPPLIED MODE PARAMETER IN A RESET CHANGES
- --     THE MODE OF A GIVEN FILE.  IF NO PARAMETER IS SUPPLIED
- --     THE MODE REMAINS THE SAME.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     RESET FOR DIRECT FILES.
- 
- -- HISTORY:
- --     DLD 08/16/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/29/85
- --     TBN 11/04/86  ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED
- --                   IS CALLED FOR OPEN OR CREATE.
- --     JLH 07/24/87  ADDED CHECKS FOR USE_ERR0R WHEN FILE IS RESET.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2111G IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-           USE DIR_IO;
-      DIR_FILE : DIR_IO.FILE_TYPE;
-      DIR_MODE : DIR_IO.FILE_MODE;
-      INCOMPLETE : EXCEPTION;
-      VAR1 : INTEGER := 5;
- 
- BEGIN
- 
-      TEST ("CE2111G", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " &
-                       "THE MODE OF THE GIVEN FILE APPROPRIATELY");
- 
- -- CREATE DIRECT TEST FILE
- 
-      BEGIN
-           CREATE (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME);
-           WRITE (DIR_FILE, VAR1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- RESET TO DEFAULT
- 
-      BEGIN
-           DIR_MODE := OUT_FILE;
-           RESET (DIR_FILE);
-           DIR_MODE := MODE (DIR_FILE);
-           IF DIR_MODE /= INOUT_FILE THEN
-                FAILED ("DEFAULT RESET CHANGED MODE - DIR");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR DIR " &
-                                "INOUT_FILES");
-      END;
- 
- -- RESET TO OUT_FILE
- 
-      BEGIN
-           DIR_MODE := IN_FILE;
-           RESET (DIR_FILE, OUT_FILE);
-           DIR_MODE := MODE (DIR_FILE);
-           IF DIR_MODE /= OUT_FILE THEN
-                FAILED ("RESET TO OUT_FILE FAILED - DIR");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET FROM INOUT_FILE TO OUT_FILE " &
-                                "NOT SUPPORTED FOR DIR FILES");
-      END;
- 
- -- RESET TO IN_FILE
- 
-      BEGIN
-           DIR_MODE := OUT_FILE;
-           RESET (DIR_FILE, IN_FILE);
-           DIR_MODE := MODE (DIR_FILE);
-           IF DIR_MODE /= IN_FILE THEN
-                FAILED ("RESET TO IN_FILE FAILED - DIR");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE NOT " &
-                                "SUPPORTED FOR DIR IN_FILE");
-      END;
- 
- -- RESET TO INOUT_FILE
- 
-      BEGIN
-           DIR_MODE := OUT_FILE;
-           RESET (DIR_FILE, INOUT_FILE);
-           DIR_MODE := MODE (DIR_FILE);
-           IF DIR_MODE /= INOUT_FILE THEN
-                FAILED ("RESET TO INOUT_FILE FAILED - DIR");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET FROM IN_FILE TO INOUT_FILE NOT " &
-                                "SUPPORTED FOR DIR INOUT_FILES");
-      END;
- 
-      BEGIN
-           DELETE (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2111G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- CE2111I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A SUPPLIED MODE PARAMETER IN A RESET CHANGES
- --     THE MODE OF A GIVEN FILE.  IF NO PARAMETER IS SUPPLIED
- --     THE MODE REMAINS THE SAME.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     RESET FOR SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     JLH 07/23/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2111I IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_IO;
-      SEQ_FILE : SEQ_IO.FILE_TYPE;
-      SEQ_MODE : SEQ_IO.FILE_MODE;
-      INCOMPLETE : EXCEPTION;
-      VAR1 : INTEGER := 5;
- 
- BEGIN
- 
-      TEST("CE2111I", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " &
-                      "THE MODE OF THE GIVEN FILE APPROPRIATELY");
- 
- -- CREATE SEQUENTIAL TEST FILE
- 
-      BEGIN
-           CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
-           WRITE (SEQ_FILE, VAR1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- RESET TO DEFAULT
- 
-      BEGIN
-           SEQ_MODE := IN_FILE;
-           RESET (SEQ_FILE);
-           SEQ_MODE := MODE (SEQ_FILE);
-           IF SEQ_MODE /= OUT_FILE THEN
-                FAILED ("DEFAULT RESET CHANGED MODE - SEQ");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET NOT SUPPORTED FOR SEQ OUT_FILE " &
-                                "MODE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- RESET TO IN_FILE
- 
-      BEGIN
-           SEQ_MODE := OUT_FILE;
-           RESET (SEQ_FILE, IN_FILE);
-           SEQ_MODE := MODE (SEQ_FILE);
-           IF SEQ_MODE /= IN_FILE THEN
-                FAILED ("RESET TO IN_FILE FAILED - SEQ");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE MODE " &
-                                "NOT SUPPORTED FOR SEQ FILES");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           DELETE (SEQ_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2111I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- CE2201A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT_TYPE STRING.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     ABW 08/16/82
- --     SPS 11/09/82
- --     JBG 01/05/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 07/28/87  REMOVED DEPENDENCE ON SUPPORT OF RESET.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201A IS
- 
- BEGIN
- 
-      TEST ("CE2201A", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - STRING TYPE");
- 
-      DECLARE
-           SUBTYPE STRNG IS STRING (1..12);
-           PACKAGE SEQ_STR IS NEW SEQUENTIAL_IO (STRNG);
-           USE SEQ_STR;
-           FILE_STR : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           STR : STRNG := "TEXT OF FILE";
-           ITEM_STR : STRNG;
-      BEGIN
-           BEGIN
-                CREATE (FILE_STR, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_STR, STR);
-           CLOSE (FILE_STR);
- 
-           BEGIN
-                OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_STR) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR TYPE STRING");
-           END IF;
- 
-           READ (FILE => FILE_STR, ITEM => ITEM_STR);
- 
-           IF ITEM_STR /= STRNG (IDENT_STR("TEXT OF FILE")) THEN
-                FAILED ("READ WRONG VALUE - STRING");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_STR) THEN
-                FAILED ("END OF FILE NOT TRUE - STRING");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_STR);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- CE2201B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED ARRAY.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED ARRAY.
- 
- -- HISTORY:
- --     ABW 08/17/82
- --     SPS 09/15/82
- --     SPS 11/09/82
- --     JBG 05/02/83
- --     EG  05/08/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 07/28/87  REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED
- --                   AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY
- --                   FILES.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201B IS
- 
- BEGIN
- 
-      TEST ("CE2201B", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - CONSTRAINED ARRAY");
- 
-      DECLARE
-           TYPE ARR_CN IS ARRAY (1..5) OF BOOLEAN;
-           PACKAGE SEQ_ARR_CN IS NEW SEQUENTIAL_IO (ARR_CN);
-           USE SEQ_ARR_CN;
-           FILE_ARR_CN : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           ARR1 : ARR_CN := (TRUE,TRUE,FALSE,TRUE,TRUE);
-           ITEM_ARR1 : ARR_CN;
-      BEGIN
-           BEGIN
-                CREATE (FILE_ARR_CN, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_ARR_CN, ARR1);
-           CLOSE (FILE_ARR_CN);
- 
-           BEGIN
-                OPEN (FILE_ARR_CN, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_ARR_CN) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR " &
-                        "CONSTRAINED ARRAY");
-           END IF;
- 
-           READ (FILE_ARR_CN, ITEM_ARR1);
- 
-           IF ITEM_ARR1 /= ARR1 THEN
-                FAILED ("READ WRONG VALUE - CONSTRAINED ARRAY");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_ARR_CN) THEN
-                FAILED ("END OF FILE NOT TRUE - CONSTRAINED ARRAY");
-           END IF;
- 
-           BEGIN
-                DELETE  (FILE_ARR_CN);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- CE2201C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT_TYPE FLOAT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     ABW 08/17/82
- --     SPS 11/10/82
- --     JBG 20/22/84  CHANGED TO .ADA TEST.
- --     EG  05/16/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/03/87  REMOVED DEPENDENCE OF RESET AND CREATED AN EXTERNAL
- --                   FILE RATHER THAN A TEMPORARY FILE.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201C IS
- BEGIN
- 
-      TEST ("CE2201C", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - FLOAT");
- 
-      DECLARE
-           PACKAGE SEQ_FLT IS NEW SEQUENTIAL_IO (FLOAT);
-           USE SEQ_FLT;
-           FILE_FLT : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           FLT : FLOAT := 65.0;
-           ITEM_FLT : FLOAT;
-      BEGIN
-           BEGIN
-                CREATE (FILE_FLT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_FLT, FLT);
-           CLOSE (FILE_FLT);
- 
-           BEGIN
-                OPEN (FILE_FLT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_FLT) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR FLOATING POINT");
-           END IF;
- 
-           READ (FILE_FLT, ITEM_FLT);
- 
-           IF ITEM_FLT /= 65.0 THEN
-                FAILED ("READ WRONG VALUE - FLOAT");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_FLT) THEN
-                FAILED ("END OF FILE NOT TRUE - FLOAT");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_FLT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE2201C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- CE2201D.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK WHETHER READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT_TYPE UNCONSTRAINED ARRAY.
- 
- --     IF I/O IS NOT SUPPORTED, THEN CREATE AND OPEN CAN RAISE USE_ERROR
- --     OR NAME_ERROR. SEE (AI-00332).
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS NON-APPLICABLE IF THE INSTANTIATION OF SEQUENTIAL_IO
- --     WITH UNCONSTRAINED ARRAY TYPE, ARR_UNCN, IS NOT SUPPORTED.
- 
- --     IF THE INSTANTIATION OF SEQUENTIAL_IO IS NOT SUPPORTED THEN
- --     THE INSTANTIATION MUST BE REJECTED.
- 
- -- HISTORY:
- --     ABW  8/17/82
- --     SPS 9/15/82
- --     SPS 11/9/82
- --     JBG 1/6/83
- --     JBG 6/4/84
- --     TBN 11/01/85     RENAMED FROM CE2201D.DEP AND MODIFIED COMMENTS.
- --     TBN 11/04/86     REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                      RESULT WHEN FILES ARE NOT SUPPORTED.
- --     THS 03/30/90     RENAMED FROM EE2201D.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201D IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
- 
-      TEST ("CE2201D" , "CHECK WHETHER READ, WRITE, AND END_OF_FILE " &
-                        "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " &
-                        "UNCONSTRAINED ARRAY TYPES");
- 
-      DECLARE
-           SUBTYPE ONE_TEN IS INTEGER RANGE 1..10;
-           TYPE ARR_UNCN IS ARRAY (ONE_TEN RANGE <>) OF INTEGER;
-           PACKAGE SEQ_ARR_UNCN
-                IS NEW SEQUENTIAL_IO (ARR_UNCN); -- N/A => ERROR.
-           USE SEQ_ARR_UNCN;
-           FILE_ARR_UNCN : FILE_TYPE;
-           ARR2 : ARR_UNCN (1..6) := (1,3,5,7,9,0);
-           ITEM_ARR2 : ARR_UNCN (1..6);
-      BEGIN
-           BEGIN
-                CREATE (FILE_ARR_UNCN);
- 
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " &
-                                     "CREATE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " &
-                                     "CREATE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                WRITE (FILE_ARR_UNCN,ARR2);
-                WRITE (FILE_ARR_UNCN, (0, -2));
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRITE FOR UNCONSTRAINED ARRAY");
-           END;
- 
-           RESET (FILE_ARR_UNCN,IN_FILE);
- 
-           IF END_OF_FILE (FILE_ARR_UNCN) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR " &
-                        "UNCONSTRAINED ARRAY");
-           END IF;
- 
-           BEGIN
-                READ (FILE_ARR_UNCN,ITEM_ARR2);
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("READ FOR UNCONSTRAINED ARRAY");
-           END;
- 
-           IF ITEM_ARR2 /= (1,3,5,7,9,0) THEN
-                FAILED ("READ WRONG VALUE - 1");
-           END IF;
- 
-           BEGIN
-                READ (FILE_ARR_UNCN, ITEM_ARR2(3..4));
- 
-                IF ITEM_ARR2 /= (1,3,0,-2,9,0) THEN
-                     FAILED ("READ WRONG VALUE - 2");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION FOR SECOND ARRAY READ");
-           END;
- 
-           IF NOT END_OF_FILE(FILE_ARR_UNCN) THEN
-                FAILED ("NOT AT END OF FILE");
-           END IF;
- 
-           CLOSE (FILE_ARR_UNCN);
- 
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED BY RESET");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2201D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep	Thu Jan  1 00:00:00 1970
***************
*** 1,155 ****
- -- CE2201E.DEP
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK WHETHER READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH VARIANT RECORDS WITH NON-DEFAULT
- --     DISCRIMINANTS.
- 
- --     IF I/O IS NOT SUPPORTED, THEN CREATE AND OPEN CAN RAISE USE_ERROR
- --     OR NAME_ERROR. SEE (AI-00332).
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS NON-APPLICABLE IF THE INSTANTIATION OF
- --     SEQUENTIAL_IO WITH VARIANT RECORDS HAVING NO DEFAULT
- --     DISCRIMINANT VALUES IS REJECTED.
- 
- -- HISTORY:
- --     JBG 1/6/83
- --     JBG 5/2/83
- --     TBN 11/18/85     RENAMED FROM CE2201E.DEP AND MODIFIED COMMENTS.
- --                      SPLIT DEFAULT DISCRIMINANT CASE INTO
- --                      CE2201G.ADA.
- --     TBN 11/04/86     REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                      RESULT WHEN FILES ARE NOT SUPPORTED.
- --     THS 03/30/90     RENAMED FROM EE2201E.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201E IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2201E", "CHECK WHETHER READ, WRITE, AND END_OF_FILE " &
-                       "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " &
-                       "UNCONSTRAINED VARIANT RECORD TYPES WITH " &
-                       "NON-DEFAULT DISCRIMINANTS.");
- 
-      DECLARE
-           TYPE VAR_REC (DISCR : BOOLEAN) IS
-                RECORD
-                     CASE DISCR IS
-                          WHEN TRUE =>
-                               A : INTEGER;
-                          WHEN FALSE =>
-                               B : STRING (1..20);
-                     END CASE;
-                END RECORD;
- 
-           PACKAGE SEQ_VAR_REC
-                IS NEW SEQUENTIAL_IO (VAR_REC);  -- N/A => ERROR.
-           USE SEQ_VAR_REC;
- 
-           FILE_VAR_REC : FILE_TYPE;
-           ITEM_TRUE  : VAR_REC(TRUE);
-           ITEM_FALSE : VAR_REC(FALSE);
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE_VAR_REC);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " &
-                                     "CREATE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " &
-                                     "CREATE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                WRITE (FILE_VAR_REC, (TRUE, -6));
-                WRITE (FILE_VAR_REC, (FALSE, (1..20 => 'C')));
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("WRITE FOR RECORD WITH DISCRIMINANT");
-           END;
- 
-           BEGIN
-                RESET (FILE_VAR_REC,IN_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR FOR RESET");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_VAR_REC) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" &
-                        "WITH DISCRIMINANT");
-           END IF;
- 
-           BEGIN
-                READ (FILE_VAR_REC,ITEM_TRUE);
- 
-                IF ITEM_TRUE /= (TRUE, IDENT_INT(-6)) THEN
-                     FAILED ("READ WRONG VALUE - 1");
-                END IF;
- 
-                IF END_OF_FILE (FILE_VAR_REC) THEN
-                     FAILED ("PREMATURE END OF FILE");
-                END IF;
- 
-                READ (FILE_VAR_REC, ITEM_FALSE);
- 
-                IF ITEM_FALSE /= (FALSE, (1..IDENT_INT(20) => 'C')) THEN
-                     FAILED ("READ WRONG VALUE - 2");
-                END IF;
- 
-                IF NOT END_OF_FILE(FILE_VAR_REC) THEN
-                     FAILED ("NOT AT END OF FILE");
-                END IF;
- 
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("READ FOR VARIANT RECORD");
-           END;
- 
-           CLOSE (FILE_VAR_REC);
- 
-      END;
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2201E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- CE2201F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --      SEQUENTIAL FILES WITH PRIVATE ELEMENT_TYPES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES WITH PRIVATE ELEMENT_TYPES.
- 
- -- HISTORY:
- --     ABW 08/17/82
- --     SPS 09/15/82
- --     SPS 11/09/82
- --     JBG 01/06/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/03/87  REMOVED DEPENDENCE OF RESET AND CREATED EXTERNAL
- --                   FILES RATHER THAN TEMPORARY FILES.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201F IS
- 
-      PACKAGE PKG IS
-           TYPE PRIV IS PRIVATE;
-           FUNCTION MAKE_PRIV (X : INTEGER) RETURN PRIV;
-      PRIVATE
-           TYPE PRIV IS NEW INTEGER;
-      END PKG;
-      USE PKG;
- 
-      PACKAGE BODY PKG IS
-           FUNCTION MAKE_PRIV (X : INTEGER) RETURN PRIV IS
-           BEGIN
-                RETURN PRIV(X);
-           END;
-      END PKG;
- 
- BEGIN
- 
-      TEST ("CE2201F", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES FOR PRIVATE TYPES");
- 
-      DECLARE
-           PACKAGE SEQ_PRV IS NEW SEQUENTIAL_IO (PRIV);
-           USE SEQ_PRV;
-           PRV, ITEM_PRV : PRIV;
-           FILE_PRV : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
-           BEGIN
-                CREATE (FILE_PRV, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PRV := MAKE_PRIV(IDENT_INT(26));
- 
-           WRITE (FILE_PRV, PRV);
-           CLOSE (FILE_PRV);
- 
-           BEGIN
-                OPEN (FILE_PRV, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_PRV) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR PRIVATE TYPE");
-           END IF;
- 
-           READ (FILE_PRV, ITEM_PRV);
- 
-           IF ITEM_PRV /= MAKE_PRIV (26) THEN
-                FAILED ("READ WRONG VALUE");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_PRV) THEN
-                FAILED ("NOT AT END OF FILE");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_PRV);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- CE2201G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED
- --      FOR SEQUENTIAL FILES WITH VARIANT RECORDS WITH DEFAULT
- --      DISCRIMINANTS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     TBN 05/15/86
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/03/87  REMOVED DEPENDENCE OF RESET AND CREATED EXTERNAL
- --                   FILES RATHER THAN TEMPORARY FILES.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201G IS
- 
- BEGIN
- 
-      TEST ("CE2201G", "CHECK THAT READ, WRITE, AND END_OF_FILE " &
-                       "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " &
-                       "UNCONSTRAINED VARIANT RECORD TYPES WITH " &
-                       "DEFAULT DISCRIMINANTS.");
- 
-      DECLARE
-           TYPE VAR_REC (DISCR : BOOLEAN := TRUE) IS
-                RECORD
-                     CASE DISCR IS
-                          WHEN TRUE =>
-                               A : INTEGER;
-                          WHEN FALSE =>
-                               B : STRING (1..20);
-                     END CASE;
-                END RECORD;
- 
-           PACKAGE SEQ_VAR_REC IS NEW SEQUENTIAL_IO (VAR_REC);
-           USE SEQ_VAR_REC;
- 
-           FILE_VAR_REC : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           ITEM_TRUE : VAR_REC(TRUE);     -- CONSTRAINED
-           ITEM      : VAR_REC;           -- UNCONSTRAINED
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE_VAR_REC, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_VAR_REC, (TRUE, -5));
-           WRITE (FILE_VAR_REC, (FALSE, (1..20 => 'B')));
-           CLOSE (FILE_VAR_REC);
- 
-           BEGIN
-                OPEN (FILE_VAR_REC, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_VAR_REC) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" &
-                        "WITH DISCRIMINANT");
-           END IF;
- 
-           BEGIN
-                READ (FILE_VAR_REC, ITEM_TRUE);
- 
-                IF ITEM_TRUE /= (TRUE, IDENT_INT(-5)) THEN
-                     FAILED ("READ WRONG VALUE - 1");
-                END IF;
- 
-                IF END_OF_FILE (FILE_VAR_REC) THEN
-                     FAILED ("PREMATURE END OF FILE");
-                END IF;
- 
-                READ (FILE_VAR_REC, ITEM);
- 
-                IF ITEM /= (FALSE, (1..IDENT_INT(20) => 'B')) THEN
-                     FAILED ("READ WRONG VALUE - 2");
-                END IF;
- 
-                IF NOT END_OF_FILE(FILE_VAR_REC) THEN
-                     FAILED ("NOT AT END OF FILE");
-                END IF;
- 
-           END;
- 
-           BEGIN
-                DELETE (FILE_VAR_REC);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE2201G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- CE2201H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT TYPE INTEGER.
- 
- -- APPLICABILITY:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES WITH ELEMENT TYPE INTEGER.
- 
- -- HISTORY:
- --     JLH 07/28/87 CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201H IS
- 
- BEGIN
- 
-      TEST ("CE2201H" , "CHECK THAT READ, WRITE, AND " &
-                        "END_OF_FILE ARE SUPPORTED FOR " &
-                        "SEQUENTIAL FILES - INTEGER TYPE");
- 
-      DECLARE
-           PACKAGE SEQ_INT IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_INT;
-           FILE_INT : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           INT : INTEGER := IDENT_INT (33);
-           ITEM_INT : INTEGER;
-      BEGIN
-           BEGIN
-                CREATE (FILE_INT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_INT, INT);
-           CLOSE (FILE_INT);
- 
-           BEGIN
-                OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_INT) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR TYPE INTEGER");
-           END IF;
- 
-           READ (FILE_INT, ITEM_INT);
- 
-           IF ITEM_INT /= IDENT_INT(33) THEN
-                FAILED ("READ WRONG VALUE - INTEGER");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_INT) THEN
-                FAILED ("END OF FILE NOT TRUE - INTEGER");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_INT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- CE2201I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT TYPE BOOLEAN.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     JLH 07/28/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201I IS
- 
- BEGIN
- 
-      TEST ("CE2201I", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - BOOLEAN TYPE");
- 
-      DECLARE
-           PACKAGE SEQ_BOOL IS NEW SEQUENTIAL_IO (BOOLEAN);
-           USE SEQ_BOOL;
-           FILE_BOOL : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           BOOL : BOOLEAN := IDENT_BOOL (TRUE);
-           ITEM_BOOL : BOOLEAN;
-      BEGIN
-           BEGIN
-                CREATE (FILE_BOOL, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_BOOL, BOOL);
-           CLOSE (FILE_BOOL);
- 
-           BEGIN
-                OPEN (FILE_BOOL, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_BOOL) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR TYPE BOOLEAN");
-           END IF;
- 
-           READ (FILE_BOOL, BOOL);
- 
-           IF BOOL /= IDENT_BOOL (TRUE) THEN
-                FAILED ("READ WRONG VALUE - BOOLEAN");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_BOOL) THEN
-                FAILED ("END OF FILE NOT TRUE - BOOLEAN");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_BOOL);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- CE2201J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT TYPE ENUMERATION.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     JLH 07/28/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201J IS
- 
- BEGIN
- 
-      TEST ("CE2201J", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - ENUMERATION TYPE");
- 
-      DECLARE
-           TYPE ENUMERATION IS (ONE, TWO, '4');
-           PACKAGE SEQ_ENUM IS NEW SEQUENTIAL_IO (ENUMERATION);
-           USE SEQ_ENUM;
-           FILE_ENUM : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           ENUM : ENUMERATION := ('4');
-           ITEM_ENUM : ENUMERATION;
-      BEGIN
-           BEGIN
-                CREATE (FILE_ENUM, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_ENUM, ENUM);
-           CLOSE (FILE_ENUM);
- 
-           BEGIN
-                OPEN (FILE_ENUM, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_ENUM) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR TYPE ENUMERATION");
-           END IF;
- 
-           READ (FILE_ENUM, ITEM_ENUM);
- 
-           IF ITEM_ENUM /= '4' THEN
-                FAILED ("READ WRONG VALUE - ENUMERATION");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_ENUM) THEN
-                FAILED ("END OF FILE NOT TRUE - ENUMERATION");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_ENUM);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- CE2201K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT TYPE ACCESS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     JLH 07/28/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201K IS
- 
- BEGIN
- 
-      TEST ("CE2201K", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - ACCESS TYPE");
- 
-      DECLARE
-           TYPE ACC_INT IS ACCESS INTEGER;
-           PACKAGE SEQ_ACC IS NEW SEQUENTIAL_IO (ACC_INT);
-           USE SEQ_ACC;
-           FILE_ACC : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           ACC : ACC_INT := NEW INTEGER'(33);
-           ITEM_ACC : ACC_INT;
-      BEGIN
-           BEGIN
-                CREATE (FILE_ACC, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_ACC, ACC);
-           CLOSE (FILE_ACC);
- 
-           BEGIN
-                OPEN (FILE_ACC, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_ACC) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR TYPE ACCESS");
-           END IF;
- 
-           READ (FILE_ACC, ITEM_ACC);
- 
-           IF NOT END_OF_FILE (FILE_ACC) THEN
-                FAILED ("END OF FILE NOT TRUE - ACCESS");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_ACC);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- CE2201L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT TYPE FIXED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     JLH 08/03/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201L IS
- BEGIN
- 
-      TEST ("CE2201L", "CHECK THAT READ, WRITE, AND END_OF_FILE " &
-                       "ARE SUPPORTED FOR SEQUENTIAL FILES - FIXED");
- 
-      DECLARE
-           TYPE FIX IS DELTA 0.5 RANGE -10.0 .. 255.0;
-           PACKAGE SEQ_FIX IS NEW SEQUENTIAL_IO (FIX);
-           USE SEQ_FIX;
-           FILE_FIX : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           FX : FIX := -8.5;
-           ITEM_FIX : FIX;
-      BEGIN
-           BEGIN
-                CREATE (FILE_FIX, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_FIX, FX);
-           CLOSE (FILE_FIX);
- 
-           BEGIN
-                OPEN (FILE_FIX, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_FIX) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR FIXED POINT");
-           END IF;
- 
-           READ (FILE_FIX, ITEM_FIX);
- 
-           IF NOT END_OF_FILE (FILE_FIX) THEN
-                FAILED ("END OF FILE NOT TRUE - FIXED");
-           END IF;
- 
-           IF ITEM_FIX /= -8.5 THEN
-                FAILED ("READ WRONG VALUE - STRING");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_FIX);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- -- CE2201M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED
- --     FOR SEQUENTIAL FILES WITH ELEMENT_TYPE RECORD WITHOUT
- --     DISCRIMINANTS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT SEQUENTIAL FILES WITH ELEMENT_TYPE RECORD WITHOUT
- --     DISCRIMINANTS.
- 
- -- HISTORY:
- --     ABW 08/17/82
- --     SPS 09/15/82
- --     SPS 11/09/82
- --     JBG 05/02/83
- --     EG  05/08/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 07/28/87  REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED
- --                   AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY
- --                   FILES.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201M IS
- 
- BEGIN
- 
-      TEST ("CE2201M", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - RECORD WITHOUT " &
-                       "DISCRIMINANTS");
- 
-      DECLARE
-           TYPE REC IS
-                RECORD
-                     ONE : INTEGER;
-                     TWO : INTEGER;
-                END RECORD;
-           PACKAGE SEQ_REC IS NEW SEQUENTIAL_IO (REC);
-           USE SEQ_REC;
-           FILE_REC : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           REC1 : REC := (ONE=>18, TWO=>36);
-           ITEM_REC1 : REC;
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE_REC, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_REC, REC1);
-           CLOSE (FILE_REC);
- 
-           BEGIN
-                OPEN (FILE_REC, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_REC) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR TYPE RECORD");
-           END IF;
- 
-           READ (FILE_REC, ITEM_REC1);
- 
-           IF ITEM_REC1 /= (18, IDENT_INT(36)) THEN
-                FAILED ("READ WRONG VALUE - RECORD");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_REC) THEN
-                FAILED ("END OF FILE NOT TRUE - RECORD");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_REC);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- -- CE2201N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
- --     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED RECORD TYPES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED RECORD TYPES.
- 
- -- HISTORY:
- --     ABW 08/17/82
- --     SPS 09/15/82
- --     SPS 11/09/82
- --     JBG 05/02/83
- --     EG  05/08/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 07/28/87  REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED
- --                   AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY
- --                   FILES.
- 
- WITH REPORT;
- USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2201N IS
- 
- BEGIN
- 
-      TEST ("CE2201N", "CHECK THAT READ, WRITE, AND " &
-                       "END_OF_FILE ARE SUPPORTED FOR " &
-                       "SEQUENTIAL FILES - CONSTRAINED RECORDS");
- 
-      DECLARE
-           TYPE REC_DEF (DISCR : INTEGER := 18) IS
-                RECORD
-                     ONE : INTEGER := 1;
-                     TWO : INTEGER := 2;
-                     THREE : INTEGER := 17;
-                     FOUR : INTEGER := 2;
-                END RECORD;
-           SUBTYPE REC_DEF_2 IS REC_DEF(2);
-           PACKAGE SEQ_REC_DEF IS NEW SEQUENTIAL_IO (REC_DEF_2);
-           USE SEQ_REC_DEF;
-           FILE_REC_DEF : FILE_TYPE;
-           INCOMPLETE : EXCEPTION;
-           REC3 : REC_DEF(2);
-           ITEM_REC3 : REC_DEF(2);
-      BEGIN
-           BEGIN
-                CREATE (FILE_REC_DEF, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
-                                     "MODE OUT_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE_REC_DEF, REC3);
-           CLOSE (FILE_REC_DEF);
- 
-           BEGIN
-                OPEN (FILE_REC_DEF, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
-                                     "MODE IN_FILE NOT SUPPORTED");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF END_OF_FILE (FILE_REC_DEF) THEN
-                FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" &
-                        "WITH DEFAULT");
-           END IF;
- 
-           READ (FILE_REC_DEF, ITEM_REC3);
- 
-           IF ITEM_REC3 /= (2, IDENT_INT(1),2,17,2) THEN
-                FAILED ("READ WRONG VALUE - RECORD WITH DEFAULT");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE_REC_DEF) THEN
-                FAILED ("END OF FILE NOT TRUE - RECORD WITH DEFAULT");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE_REC_DEF);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2201N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,143 ****
- -- CE2202A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, AND END_OF_FILE RAISE STATUS_ERROR
- --     WHEN APPLIED TO A NON-OPEN SEQUENTIAL FILE.  USE_ERROR IS
- --     NOT PERMITTED.
- 
- -- HISTORY:
- --     ABW 08/17/82
- --     SPS 09/13/82
- --     SPS 11/09/82
- --     EG  11/26/84
- --     EG  05/16/85
- --     GMT 07/24/87  REPLACED CALL TO REPORT.COMMENT WITH "NULL;".
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2202A IS
- 
-      PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
-      USE SEQ;
-      FILE1, FILE2 : FILE_TYPE;
-      CNST : CONSTANT INTEGER := 101;
-      IVAL : INTEGER;
-      BOOL : BOOLEAN;
- 
- BEGIN
-      TEST ("CE2202A","CHECK THAT READ, WRITE, AND "    &
-                      "END_OF_FILE RAISE STATUS_ERROR " &
-                      "WHEN APPLIED TO A NON-OPEN "     &
-                      "SEQUENTIAL FILE");
-      BEGIN
-           BEGIN
-                WRITE (FILE1,CNST);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN WRITE APPLIED " &
-                        "TO NON-EXISTENT FILE");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED WHEN WRITE " &
-                             "APPLIED TO NON-EXISTENT FILE");
-           END;
- 
-           BEGIN
-                READ (FILE1,IVAL);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN READ APPLIED " &
-                        "TO NON-EXISTENT FILE");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED WHEN READ " &
-                             "APPLIED TO NON-EXISTENT FILE");
-           END;
- 
-           BEGIN
-                BOOL := END_OF_FILE (FILE1);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN END_OF_FILE " &
-                        "APPLIED TO NON-EXISTENT FILE");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED WHEN END_OF_FILE " &
-                             "APPLIED TO NON-EXISTENT FILE");
-           END;
-      END;
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE2);
-                CLOSE (FILE2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL; -- IF FILE2 CANNOT BE CREATED THEN WE WILL
-                           -- BE REPEATING EARLIER TESTS, BUT THAT'S OK.
-           END;
- 
-           BEGIN
-                WRITE (FILE2,CNST);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN WRITE APPLIED " &
-                        "TO FILE2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED WHEN WRITE " &
-                             "APPLIED TO FILE2");
-           END;
- 
-           BEGIN
-                READ (FILE2,IVAL);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN READ APPLIED " &
-                        "TO FILE2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED WHEN READ " &
-                             "APPLIED TO FILE2");
-           END;
- 
-           BEGIN
-                BOOL := END_OF_FILE (FILE2);
-                FAILED ("STATUS_ERROR NOT RAISED WHEN END_OF_FILE " &
-                        "APPLIED TO FILE2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED WHEN END_OF_FILE " &
-                             "APPLIED TO FILE2");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END CE2202A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- CE2203A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR SEQUENTIAL_IO, WRITE RAISES THE EXCEPTION
- --     USE_ERROR IF THE CAPACITY OF THE EXTERNAL FILE IS EXCEEDED.
- --     THIS TEST ONLY CHECKS THAT THE IMPLEMENTATION SUPPORTS AN
- --     EXTERNAL FILE CAPACITY OF 4096 CHARACTERS OR LESS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.  ALSO, THE IMPLEMENTATION MUST BE ABLE TO
- --     RESTRICT THE CAPACITY OF AN EXTERNAL FILE.
- 
- --     $FORM_STRING2 IS DEFINED SUCH THAT THE CAPACITY OF THE FILE IS
- --     RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION
- --     CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL
- --     "CANNOT_RESTRICT_FILE_CAPACITY".
- 
- -- HISTORY:
- --     JLH 07/12/88  CREATED ORIGINAL TEST.
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2203A IS
- 
-      SUBTYPE STR512 IS STRING (1 .. 512);
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (STR512);
-           USE SEQ_IO;
- 
-      FILE : FILE_TYPE;
-      ITEM : STR512 := (1 .. 512 => 'A');
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2203A", "CHECK FOR SEQUENTIAL_IO THAT WRITE RAISES " &
-                       "USE_ERROR IF THE CAPACITY OF THE EXTERNAL " &
-                       "FILE IS EXCEEDED");
- 
-      BEGIN
- 
-           IF
- $FORM_STRING2
-                = STRING'("CANNOT_RESTRICT_FILE_CAPACITY") THEN
-                NOT_APPLICABLE ("IMPLEMENTATION CANNOT RESTRICT FILE " &
-                                "CAPACITY");
-                RAISE INCOMPLETE;
-           ELSE
-                BEGIN
-                     CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME,
- 
- $FORM_STRING2
- );
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                          "WITH MODE OUT_FILE");
-                          RAISE INCOMPLETE;
-                     WHEN NAME_ERROR =>
-                          NOT_APPLICABLE ("NAME_ERROR RAISED ON " &
-                                          "CREATE WITH MODE OUT_FILE");
-                          RAISE INCOMPLETE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                                  "CREATE");
-                          RAISE INCOMPLETE;
-                END;
-           END IF;
- 
-           BEGIN
-                FOR I IN 1 .. 9 LOOP
-                     WRITE (FILE, ITEM);
-                END LOOP;
-                FAILED ("USE_ERROR NOT RAISED WHEN THE CAPACITY " &
-                        "OF THE EXTERNAL FILE IS EXCEEDED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE2203A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CE2204A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WRITE IS FORBIDDEN FOR SEQUENTIAL FILES OF
- --     MODE IN_FILE.
- 
- --          A)  CHECK NON-TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     DLD 08/17/82
- --     SPS 08/24/82
- --     SPS 11/09/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST.
- --     JBG 03/30/84
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 07/27/87  SPLIT THIS TEST BY MOVING THE CODE FOR CHECKING
- --                   TEMPORARY FILES INTO CE2204C.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2204A IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
-      TEST ("CE2204A", "CHECK THAT MODE_ERROR IS RAISED BY WRITE " &
-                       "WHEN THE MODE IS IN_FILE AND THE FILE " &
-                       "IS A NON-TEMPORARY FILE");
-      DECLARE
-           PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_IO;
-           SEQ_FILE : FILE_TYPE;
-           VAR1     : INTEGER := 5;
-      BEGIN
-           BEGIN
-                CREATE (SEQ_FILE, OUT_FILE,
-                        LEGAL_FILE_NAME (1, "CE2204A"));
-                WRITE (SEQ_FILE, VAR1);
-                CLOSE (SEQ_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; " &
-                                     "SEQUENTIAL CREATE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; " &
-                                     "SEQUENTIAL CREATE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED; " &
-                             "SEQUENTIAL CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                OPEN (SEQ_FILE, IN_FILE,
-                      LEGAL_FILE_NAME (1, "CE2204A"));
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR  RAISED ON THE " &
-                                     "OPENING OF A SEQUENTIAL " &
-                                     "NON-TEMPORARY FILE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                WRITE (SEQ_FILE, 3);
-                FAILED ("MODE_ERROR NOT RAISED - NAMED FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - NAMED FILE");
-           END;
- 
-           BEGIN
-                DELETE (SEQ_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2204A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- CE2204B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ AND END_OF_FILE ARE FORBIDDEN FOR SEQUENTIAL
- --     FILES OF MODE OUT_FILE.
- 
- --          A) CHECK NON-TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --      THE CREATION OF SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     DLD 08/17/82
- --     SPS 08/24/82
- --     SPS 110/9/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 07/24/87  SPLIT THIS TEST BY MOVING THE CODE FOR CHECKING
- --                   TEMPORARY FILES INTO CE2204D.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2204B IS
- BEGIN
-      TEST ("CE2204B", "FOR A NON-TEMPORARY SEQUENTIAL FILE, CHECK " &
-                       "THAT MODE_ERROR IS RAISED BY READ AND " &
-                       "END_OF_FILE WHEN THE MODE IS OUT_FILE");
-      DECLARE
-           PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_IO;
-           SEQ_FILE   : FILE_TYPE;
-           X          : INTEGER;
-           B          : BOOLEAN;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
-           BEGIN
-                CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 3");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (SEQ_FILE, 5);
- 
-           BEGIN                    -- THIS IS ONLY
-                RESET (SEQ_FILE);   -- AN ATTEMPT
-           EXCEPTION                -- TO RESET,
-                WHEN USE_ERROR =>   -- IF RESET
-                     NULL;          -- N/A THEN
-           END;                     -- TEST IS
-                                    -- NOT AFFECTED.
-           BEGIN
-                READ (SEQ_FILE, X);
-                FAILED ("MODE_ERROR NOT RAISED ON READ - 4");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON READ - 5");
-           END;
- 
-           BEGIN
-                B := END_OF_FILE (SEQ_FILE);
-                FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 6");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - END_OF_FILE - 7");
-           END;
- 
-           BEGIN
-                DELETE (SEQ_FILE);
-           EXCEPTION
-                WHEN  USE_ERROR =>
-                      NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2204B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- CE2204C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WRITE IS FORBIDDEN FOR SEQUENTIAL FILES OF
- --     MODE IN_FILE.
- 
- --          B)  CHECK TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEMPORARY SEQUENTIAL FILES AND THE RESETTING FROM OUT_FILE
- --     TO IN_FILE.
- 
- -- HISTORY:
- --     GMT 07/27/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2204C IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
-      TEST ("CE2204C", "CHECK THAT MODE_ERROR IS RAISED BY WRITE " &
-                       "WHEN THE MODE IS INFILE AND THE FILE IS " &
-                       "A TEMPORARY FILE");
-      DECLARE
-           PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_IO;
-           FT   : FILE_TYPE;
-           VAR1 : INTEGER  := 5;
-      BEGIN
-           BEGIN
-                CREATE (FT, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FT, VAR1);
- 
-           BEGIN
-                RESET (FT, IN_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON RESET - 2");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                WRITE(FT, 3);
-                FAILED ("MODE_ERROR NOT RAISED ON WRITE - 3");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON WRITE - 4");
-           END;
- 
-           CLOSE (FT);
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2204C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- CE2204D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ AND END_OF_FILE ARE FORBIDDEN FOR SEQUENTIAL
- --     FILES OF MODE OUT_FILE.
- 
- --          B) CHECK TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --      THE CREATION OF TEMPORARY SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     GMT 07/24/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2204D  IS
- BEGIN
-      TEST ("CE2204D", "FOR A TEMPORARY SEQUENTIAL FILE, CHECK THAT " &
-                       "MODE_ERROR IS RAISED BY READ AND END_OF_FILE " &
-                       "WHEN THE MODE IS OUT_FILE");
-      DECLARE
-           PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-           USE SEQ_IO;
-           FT         : FILE_TYPE;
-           X          : INTEGER;
-           B          : BOOLEAN;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
-           BEGIN
-                CREATE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FT, 5);
- 
-           BEGIN                    -- THIS IS ONLY
-                RESET (FT);         -- AN ATTEMPT
-           EXCEPTION                -- TO RESET,
-                WHEN USE_ERROR =>   -- IF RESET
-                     NULL;          -- N/A THEN
-           END;                     -- TEST IS
-                                    -- NOT AFFECTED.
- 
-           BEGIN
-                READ (FT, X);
-                FAILED ("MODE_ERROR NOT RAISED ON READ - 3");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON READ - 4");
-           END;
- 
-           BEGIN
-                B := END_OF_FILE (FT);
-                FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 5");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - END_OF_FILE - 6");
-           END;
- 
-           CLOSE (FT);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2204D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- CE2205A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK WHETHER  READ  FOR A SEQUENTIAL FILE RAISES  DATA_ERROR OR
- --     CONSTRAINT_ERROR WHEN AN ELEMENT IS READ THAT IS OUTSIDE THE
- --     RANGE OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE INSTANTIATED
- --     TYPE, AND CHECK THAT READING CAN CONTINUE AFTER THE EXCEPTION
- --     HAS BEEN HANDLED.
- 
- --          A) CHECK ENUMERATION TYPE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     SPS 09/28/82
- --     JBG 06/04/84
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 07/24/87  RENAMED FROM CE2210A.ADA AND REMOVED THE USE OF
- --                   RESET.
- --     PWB 05/18/89  DELETED CALL TO FAILED WHEN NO EXCEPTION RAISED.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2205A IS
- BEGIN
- 
-      TEST ("CE2205A", "CHECK WHETHER READ FOR A SEQUENTIAL FILE " &
-                       "RAISES  DATA_ERROR OR CONSTRAINT_ERROR WHEN " &
-                       "AN ELEMENT IS READ THAT IS OUTSIDE THE RANGE " &
-                       "OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE " &
-                       "INSTANTIATED TYPE, AND CHECK THAT READING CAN " &
-                       "CONTINUE AFTER THE EXCEPTION HAS BEEN HANDLED");
-      DECLARE
-           PACKAGE  SEQ  IS NEW  SEQUENTIAL_IO (CHARACTER);
-           USE SEQ;
-           FT : FILE_TYPE;
-           SUBTYPE CH IS CHARACTER  RANGE 'A' .. 'D';
-           X : CH;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " &
-                                     "CREATE WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " &
-                                     "CREATE WITH OUT_FILE MODE - 2");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "SEQUENTIAL CREATE - 3");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FT, 'A');
-           WRITE (FT, 'M');
-           WRITE (FT, 'B');
-           WRITE (FT, 'C');
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN  (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN WITH IN_FILE MODE IS NOT " &
-                                     "SUPPORTED - 4");
-                RAISE INCOMPLETE;
-           END;
- 
-           -- BEGIN TEST
- 
-           READ (FT, X);
-           IF X /= 'A' THEN
-                FAILED ("INCORRECT VALUE FOR READ - 5");
-           END IF;
- 
-           BEGIN
-                READ (FT, X);
-                COMMENT ("NO EXCEPTION RAISED FOR READ WITH ELEMENT " &
-                        "OUT OF RANGE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR RAISED FOR SCALAR "  &
-                              "TYPES - 7");
-                WHEN DATA_ERROR =>
-                     COMMENT ("DATA_ERROR RAISED FOR SCALAR TYPES - 8");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 9");
-           END;
- 
-           BEGIN
-                READ (FT, X);
-                IF X /= 'B' THEN
-                     FAILED ("INCORRECT VALUE FOR READ - 10");
-                END IF;
- 
-                READ (FT, X);
-                IF X /= 'C' THEN
-                     FAILED ("INCORRECT VALUE FOR READ - 11");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNABLE TO CONTINUE READING - 12");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2205A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- CE2206A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ FOR A SEQUENTIAL FILE RAISES END_ERROR WHEN
- --     THERE ARE NO MORE ELEMENTS THAT CAN BE READ FROM THE GIVEN
- --     FILE.  ALSO CHECK THAT END_OF_FILE CORRECTLY DETECTS THE END
- --     OF A SEQUENTIAL FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     JLH 08/22/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH SEQUENTIAL_IO;
- 
- PROCEDURE CE2206A IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (CHARACTER);
-      USE SEQ_IO;
- 
-      FILE : FILE_TYPE;
-      ITEM : CHARACTER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2206A", "CHECK THAT READ FOR A SEQUENTIAL FILE RAISES " &
-                       "END_ERROR WHEN THERE ARE NO MORE ELEMENTS " &
-                       "THAT CAN BE READ FROM THE GIVEN FILE.  ALSO " &
-                       "CHECK THAT END_OF_FILE CORRECTLY DETECTS THE " &
-                       "END OF A SEQUENTIAL FILE");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           WRITE (FILE, 'A');
-           WRITE (FILE, 'B');
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                     "MODE IN_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                     RAISE INCOMPLETE;
-           END;
- 
-           READ (FILE, ITEM);
-           IF ITEM /= 'A' THEN
-                FAILED ("INCORRECT VALUE READ");
-           END IF;
- 
-           IF END_OF_FILE (FILE) THEN
-                FAILED ("END_OF_FILE NOT DETECTED CORRECTLY - 1");
-           END IF;
- 
-           READ (FILE, ITEM);
- 
-           IF NOT END_OF_FILE (FILE) THEN
-                FAILED ("END_OF_FILE NOT DETECTED CORRECTLY - 2");
-           END IF;
- 
-           BEGIN
-                READ (FILE, ITEM);
-                FAILED ("END_ERROR NOT RAISED FOR READ");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON READ");
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE2206A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,185 ****
- -- CE2208B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DATA CAN BE OVERWRITTEN IN THE SEQUENTIAL FILE AND THE
- --     CORRECT VALUES CAN LATER BE READ.  ALSO CHECK THAT OVERWRITING
- --     TRUNCATES THE FILE TO THE LAST ELEMENT WRITTEN.
- 
- -- APPLICABILITY CRITERIA:
- --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --      THE CREATING AND OPENING OF SEQUENTIAL FILES.
- 
- -- HISTORY:
- --     TBN  09/30/86  CREATED ORIGINAL TEST.
- --     GMT  07/24/87  ADDED CHECKS FOR USE_ERROR AND REMOVED SOME CODE.
- --     BCB  10/03/90  CHANGED CODE TO CHECK THAT OVERWRITING TRUNCATES
- --                    INSTEAD OF WHETHER IT TRUNCATES.
- 
- WITH SEQUENTIAL_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE CE2208B IS
- 
-      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
-      USE SEQ_IO;
- 
-      FILE1      : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE2208B",
-            "CHECK THAT DATA CAN BE OVERWRITTEN IN THE SEQUENTIAL " &
-            "FILE AND THE CORRECT VALUES CAN LATER BE READ.  ALSO " &
-            "CHECK THAT OVERWRITING TRUNCATES THE FILE." );
- 
-      -- INITIALIZE TEST FILE
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED DURING CREATE");
-                RAISE INCOMPLETE;
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED DURING CREATE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNKNOWN EXCEPTION RAISED DURING CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           FOR I IN 1 .. 25 LOOP
-                WRITE (FILE1, I);
-           END LOOP;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING WRITE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           CLOSE (FILE1);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING CLOSE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ( "OPEN WITH  OUT_FILE  MODE NOT "  &
-                                 "SUPPORTED FOR SEQUENTIAL FILES" );
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED DURING OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           FOR I IN 26 .. 36 LOOP
-                WRITE (FILE1, I);
-           END LOOP;
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING OVERWRITE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           CLOSE (FILE1);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING 2ND CLOSE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ( "OPEN WITH  IN_FILE  MODE NOT "   &
-                                 "SUPPORTED FOR SEQUENTIAL FILES" );
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("EXCEPTION RAISED DURING SECOND OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
-      DECLARE
-           END_REACHED : BOOLEAN := FALSE;
-           COUNT : INTEGER := 26;
-           NUM : INTEGER;
-      BEGIN
-           WHILE COUNT <= 36 AND NOT END_REACHED LOOP
-                BEGIN
-                     READ (FILE1, NUM);
-                     IF NUM /= COUNT THEN
-                          FAILED ("INCORRECT RESULTS READ FROM FILE " &
-                                  INTEGER'IMAGE (NUM));
-                     END IF;
-                     COUNT := COUNT + 1;
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          END_REACHED := TRUE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
-                                  "READING - 1");
-                          RAISE INCOMPLETE;
-                END;
-           END LOOP;
-           IF COUNT <= 36 THEN
-                FAILED ("FILE WAS INCOMPLETE");
-                RAISE INCOMPLETE;
-           ELSE
-                BEGIN
-                     READ (FILE1, NUM);
-                     FAILED ("END_ERROR NOT RAISED BY ATTEMPT TO READ");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                                  "DURING READING - 2");
-                          RAISE INCOMPLETE;
-                END;
-           END IF;
-      END;
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2208B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,357 ****
- -- CE2401A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
- --     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE AND
- --     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPES
- --     STRING, CHARACTER, AND INTEGER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT DIRECT FILES.
- 
- -- HISTORY:
- --     ABW 08/16/82
- --     SPS 09/15/82
- --     SPS 11/09/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST.
- --     EG  05/16/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 07/31/87  ISOLATED EXCEPTIONS.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401A IS
-      END_SUBTEST : EXCEPTION;
- BEGIN
- 
-      TEST ("CE2401A" , "CHECK THAT READ, WRITE, SET_INDEX " &
-                        "INDEX, SIZE AND END_OF_FILE ARE " &
-                        "SUPPORTED FOR DIRECT FILES");
- 
-      DECLARE
-           SUBTYPE STR_TYPE IS STRING (1..12);
-           PACKAGE DIR_STR IS NEW DIRECT_IO (STR_TYPE);
-           USE DIR_STR;
-           FILE_STR : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE_STR, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - STRING");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - STRING");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                STR : STR_TYPE := "TEXT OF FILE";
-                ITEM_STR : STR_TYPE;
-                ONE_STR : POSITIVE_COUNT := 1;
-                TWO_STR : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE_STR,STR);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "STRING - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_STR,STR,TWO_STR);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "STRING - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_STR) /= TWO_STR THEN
-                          FAILED ("SIZE FOR TYPE STRING");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE_STR) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR STRING");
-                     END IF;
-                     SET_INDEX (FILE_STR,ONE_STR);
-                     IF INDEX (FILE_STR) /= ONE_STR THEN
-                          FAILED ("WRONG INDEX VALUE FOR STRING");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_STR);
- 
-                BEGIN
-                     OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED - 1");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_STR,ITEM_STR);
-                     IF ITEM_STR /= STR THEN
-                          FAILED ("INCORRECT STRING VALUE READ - 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR STRING");
-                END;
- 
-                BEGIN
-                     READ (FILE_STR,ITEM_STR,ONE_STR);
-                     IF ITEM_STR /= STR THEN
-                          FAILED ("INCORRECT STRING VALUE READ - 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR STRING");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE_STR);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      DECLARE
-           PACKAGE DIR_CHR IS NEW DIRECT_IO (CHARACTER);
-           USE DIR_CHR;
-           FILE_CHR : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE_CHR, INOUT_FILE, LEGAL_FILE_NAME(2));
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - CHARACTER");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - CHARACTER");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                CHR : CHARACTER := 'C';
-                ITEM_CHR : CHARACTER;
-                ONE_CHR : POSITIVE_COUNT := 1;
-                TWO_CHR : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE_CHR,CHR);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "CHARACTER - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_CHR,CHR,TWO_CHR);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "CHARACTER - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_CHR) /= TWO_CHR THEN
-                          FAILED ("SIZE FOR TYPE CHARACTER");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE_CHR) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
-                                  "CHARACTER");
-                     END IF;
-                     SET_INDEX (FILE_CHR,ONE_CHR);
-                     IF INDEX (FILE_CHR) /= ONE_CHR THEN
-                          FAILED ("WRONG INDEX VALUE FOR TYPE " &
-                                  "CHARACTER");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_CHR);
- 
-                BEGIN
-                     OPEN (FILE_CHR, IN_FILE, LEGAL_FILE_NAME(2));
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED - 2");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_CHR,ITEM_CHR);
-                     IF ITEM_CHR /= CHR THEN
-                          FAILED ("INCORRECT CHR VALUE READ - 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR " &
-                                  "TYPE CHARACTER");
-                END;
- 
-                BEGIN
-                     READ (FILE_CHR,ITEM_CHR,ONE_CHR);
-                     IF ITEM_CHR /= CHR THEN
-                          FAILED ("INCORRECT CHR VALUE READ - 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR " &
-                                  "TYPE CHARACTER");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE_CHR);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      DECLARE
-           PACKAGE DIR_INT IS NEW DIRECT_IO (INTEGER);
-           USE DIR_INT;
-           FILE_INT : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE_INT, INOUT_FILE, LEGAL_FILE_NAME(3));
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - INTEGER");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - INTEGER");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                INT : INTEGER := IDENT_INT (33);
-                ITEM_INT : INTEGER;
-                ONE_INT : POSITIVE_COUNT := 1;
-                TWO_INT : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE_INT,INT);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "INTEGER - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_INT,INT,TWO_INT);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "INTEGER - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_INT) /= TWO_INT THEN
-                          FAILED ("SIZE FOR TYPE INTEGER");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE_INT) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
-                                  "INTEGER");
-                     END IF;
-                     SET_INDEX (FILE_INT, ONE_INT);
-                     IF INDEX (FILE_INT) /= ONE_INT THEN
-                          FAILED ("WRONG INDEX VALUE FOR TYPE INTEGER");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_INT);
- 
-                BEGIN
-                     OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME(3));
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED - 3");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_INT,ITEM_INT);
-                     IF ITEM_INT /= INT THEN
-                          FAILED ("INCORRECT INT VALUE READ - 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR " &
-                                  "TYPE INTEGER");
-                END;
- 
-                BEGIN
-                     READ (FILE_INT,ITEM_INT,ONE_INT);
-                     IF ITEM_INT /= INT THEN
-                          FAILED ("INCORRECT INT VALUE READ - 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR " &
-                                  "TYPE INTEGER");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE_INT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,347 ****
- -- CE2401B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
- --     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
- --     END_OF_FILE FOR DIRECT FILES WITH ELEMENT_TYPES BOOLEAN,
- --     ACCESS, AND ENUMERATED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     ABW 08/18/82
- --     SPS 09/15/82
- --     SPS 11/09/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST.
- --     EG  05/16/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/07/87  ISOLATED EXCEPTIONS.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401B IS
-      END_SUBTEST : EXCEPTION;
- BEGIN
- 
-      TEST ("CE2401B", "CHECK READ, WRITE, SET_INDEX " &
-                       "INDEX, SIZE, AND END_OF_FILE FOR " &
-                       "DIRECT FILES FOR BOOLEAN, ACCESS " &
-                       "AND ENUMERATION TYPES");
-      DECLARE
-           PACKAGE DIR_BOOL IS NEW DIRECT_IO (BOOLEAN);
-           USE DIR_BOOL;
-           FILE_BOOL : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE_BOOL, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - BOOLEAN");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - BOOLEAN");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                BOOL : BOOLEAN := IDENT_BOOL (TRUE);
-                ITEM_BOOL : BOOLEAN;
-                ONE_BOOL : POSITIVE_COUNT := 1;
-                TWO_BOOL : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE_BOOL,BOOL);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "BOOLEAN - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_BOOL,BOOL,TWO_BOOL);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "BOOLEAN - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_BOOL) /= TWO_BOOL THEN
-                          FAILED ("SIZE FOR TYPE BOOLEAN");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE_BOOL) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR " &
-                                  "BOOLEAN");
-                     END IF;
-                     SET_INDEX (FILE_BOOL,ONE_BOOL);
-                     IF INDEX (FILE_BOOL) /= ONE_BOOL THEN
-                          FAILED ("WRONG INDEX VALUE FOR TYPE BOOLEAN");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_BOOL);
- 
-                BEGIN
-                     OPEN (FILE_BOOL, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED - 1");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_BOOL,ITEM_BOOL);
-                     IF ITEM_BOOL /= BOOL THEN
-                          FAILED ("INCORRECT BOOLEAN VALUE READ - 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR " &
-                                  "TYPE BOOLEAN");
-                END;
- 
-                BEGIN
-                     READ (FILE_BOOL,ITEM_BOOL,ONE_BOOL);
-                     IF ITEM_BOOL /= BOOL THEN
-                          FAILED ("INCORRECT BOOLEAN VALUE READ - 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR BOOLEAN");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE_BOOL);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      DECLARE
-           TYPE ENUMERATED IS (ONE,TWO,THREE);
-           PACKAGE DIR_ENUM IS NEW DIRECT_IO (ENUMERATED);
-           USE DIR_ENUM;
-           FILE_ENUM : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE_ENUM, INOUT_FILE, LEGAL_FILE_NAME(2));
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - ENUMERATED");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - ENUMERATED");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                ENUM : ENUMERATED := (THREE);
-                ITEM_ENUM : ENUMERATED;
-                ONE_ENUM : POSITIVE_COUNT := 1;
-                TWO_ENUM : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE_ENUM,ENUM);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "ENUMERATED - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_ENUM,ENUM,TWO_ENUM);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "ENUMERATED - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_ENUM) /= TWO_ENUM THEN
-                          FAILED ("SIZE FOR TYPE ENUMERATED");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE_ENUM) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
-                                  "ENUMERATED");
-                     END IF;
-                     SET_INDEX (FILE_ENUM,ONE_ENUM);
-                     IF INDEX (FILE_ENUM) /= ONE_ENUM THEN
-                          FAILED ("WRONG INDEX VALUE FOR TYPE " &
-                                  "ENUMERATED");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_ENUM);
- 
-                BEGIN
-                     OPEN (FILE_ENUM, IN_FILE, LEGAL_FILE_NAME(2));
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED - 2");
-                     RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_ENUM,ITEM_ENUM);
-                     IF ITEM_ENUM /= ENUM THEN
-                          FAILED ("INCORRECT ENUM VALUE READ - 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR ENUMERATED");
-                END;
- 
-                BEGIN
-                     READ (FILE_ENUM,ITEM_ENUM,ONE_ENUM);
-                     IF ITEM_ENUM /= ENUM THEN
-                          FAILED ("INCORRECT ENUM VALUE READ - 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR " &
-                                  "TYPE ENUMERATED");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE_ENUM);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      DECLARE
-           TYPE ACC_INT IS ACCESS INTEGER;
-           PACKAGE DIR_ACC IS NEW DIRECT_IO (ACC_INT);
-           USE DIR_ACC;
-           FILE_ACC : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE_ACC, INOUT_FILE, LEGAL_FILE_NAME(3));
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - ACCESS");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                ACC : ACC_INT := NEW INTEGER'(33);
-                ITEM_ACC : ACC_INT;
-                ONE_ACC : POSITIVE_COUNT := 1;
-                TWO_ACC : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE_ACC,ACC);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "ACCESS - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_ACC,ACC,TWO_ACC);
- 
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "ACCESS - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_ACC) /= TWO_ACC THEN
-                          FAILED ("SIZE FOR TYPE ACCESS");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE_ACC) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR ACCESS");
-                     END IF;
-                     SET_INDEX (FILE_ACC,ONE_ACC);
-                     IF INDEX (FILE_ACC) /= ONE_ACC THEN
-                          FAILED ("WRONG INDEX VALUE FOR TYPE ACCESS");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_ACC);
- 
-                BEGIN
-                     OPEN (FILE_ACC, IN_FILE, LEGAL_FILE_NAME(3));
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE NOT " &
-                                          "SUPPORTED - 3");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_ACC,ITEM_ACC);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR ACCESS");
-                END;
- 
-                BEGIN
-                     READ (FILE_ACC,ITEM_ACC,ONE_ACC);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR ACCESS");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE_ACC);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,268 ****
- -- CE2401C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
- --     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
- --     END_OF_FILE ARE IMPLEMENTED FOR DIRECT FILES WITH
- --     ELEMENT_TYPE CONSTRAINED ARRAY, AND RECORD WITHOUT DISCRIMINANTS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     ABW 08/18/82
- --     SPS 09/20/82
- --     SPS 11/09/82
- --     JBG 05/02/83
- --     JRK 03/26/84
- --     EG  05/16/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/10/87  ISOLATED EXCEPTIONS.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401C IS
-      END_SUBTEST: EXCEPTION;
- BEGIN
- 
-      TEST ("CE2401C" , "CHECK READ, WRITE, SET_INDEX " &
-                        "INDEX, SIZE, AND END_OF_FILE FOR " &
-                        "DIRECT FILES FOR CONSTRAINED ARRAY TYPES, " &
-                        "AND RECORD TYPES WITHOUT DISCRIMINANTS");
- 
-      DECLARE
-           TYPE ARR_CN IS ARRAY (1..5) OF BOOLEAN;
-           PACKAGE DIR_ARR_CN IS NEW DIRECT_IO (ARR_CN);
-           USE DIR_ARR_CN;
-           FILE : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - CONSTRAINED ARRAY");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - CONSTRAINED ARRAY");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                ARR : ARR_CN := (TRUE,TRUE,FALSE,TRUE,TRUE);
-                ITEM : ARR_CN;
-                ONE : POSITIVE_COUNT := 1;
-                TWO : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE,ARR);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "CONTRAINED ARRAY - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE,ARR,TWO);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "CONSTRAINED ARRAY - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE) /= TWO THEN
-                          FAILED ("SIZE FOR TYPE CONSTRAINED ARRAY");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
-                                  "CONSTRAINED ARRAY");
-                     END IF;
-                     SET_INDEX (FILE,ONE);
-                     IF INDEX (FILE) /= ONE THEN
-                          FAILED ("WRONG INDEX VALUE FOR TYPE " &
-                                  "CONSTRAINED ARRAY");
-                     END IF;
-                END;
- 
-                CLOSE (FILE);
- 
-                BEGIN
-                     OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED - 1");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE,ITEM);
-                     IF ITEM /= ARR THEN
-                          FAILED ("INCORRECT ARRAY VALUES READ " &
-                                  "- 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR " &
-                                  "TYPE CONSTRAINED ARRAY");
-                END;
- 
-                BEGIN
-                     READ (FILE,ITEM,ONE);
-                     IF ITEM /= ARR THEN
-                          FAILED ("INCORRECT ARRAY VALUES READ " &
-                                  "- 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR " &
-                                  "TYPE CONSTRAINED ARRAY");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      DECLARE
-           TYPE REC IS
-                RECORD
-                     ONE : INTEGER;
-                     TWO : INTEGER;
-           END RECORD;
-           PACKAGE DIR_REC IS NEW DIRECT_IO (REC);
-           USE DIR_REC;
-           FILE : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME(2));
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - RECORD");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON CREATE - " &
-                             "RECORD");
-           END;
- 
-           DECLARE
-                REC1 : REC := REC'(ONE=>18,TWO=>36);
-                ITEM : REC;
-                ONE : POSITIVE_COUNT := 1;
-                TWO : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE,REC1);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR - " &
-                                  "RECORD - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE,REC1,TWO);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR - " &
-                                  "RECORD - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE) /= TWO THEN
-                          FAILED ("SIZE FOR TYPE RECORD");
-                     END IF;
-                     IF NOT END_OF_FILE (FILE) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR RECORD");
-                     END IF;
-                     SET_INDEX (FILE,ONE);
-                     IF INDEX (FILE) /= ONE THEN
-                          FAILED ("WRONG INDEX VALUE FOR TYPE RECORD");
-                     END IF;
-                END;
- 
-                CLOSE (FILE);
- 
-                BEGIN
-                     OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED - 2");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE,ITEM);
-                     IF ITEM /= REC1 THEN
-                          FAILED ("INCORRECT RECORD VALUES READ " &
-                                  "- 1");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR RECORD");
-                END;
- 
-                BEGIN
-                     READ (FILE,ITEM,ONE);
-                     IF ITEM /= REC1 THEN
-                          FAILED ("INCORRECT RECORD VALUES READ " &
-                                  "- 2");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR " &
-                                  "TYPE RECORD");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,172 ****
- -- CE2401E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
- --     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
- --     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE
- --     FLOATING POINT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY FOR IMPLEMENTATIONS WHICH SUPPORT CREATION OF
- --     DIRECT FILES WITH INOUT_FILE MODE AND OPENING OF DIRECT FILES
- --     WITH IN_FILE MODE.
- 
- -- HISTORY:
- --     ABW 08/18/82
- --     SPS 09/15/82
- --     SPS 11/11/82
- --     JBG 05/02/83
- --     EG  11/19/85  HANDLE IMPLEMENTATIONS WITH
- --                   POSITIVE_COUNT'LAST=1.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/10/87  ISOLATED EXCEPTIONS. SPLIT FIXED POINT TESTS
- --                   INTO CE2401I.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401E IS
- 
-      END_SUBTEST : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2401E", "CHECK THAT READ, WRITE, SET_INDEX, " &
-                        "INDEX, SIZE, AND END_OF_FILE ARE " &
-                        "SUPPORTED FOR DIRECT FILES WITH " &
-                        "ELEMENT_TYPE FLOAT");
- 
-      DECLARE
- 
-           PACKAGE DIR_FLT IS NEW DIRECT_IO (FLOAT);
-           USE DIR_FLT;
-           FILE_FLT : FILE_TYPE;
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE_FLT, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - FLOAT");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - FLOAT");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                FLT : FLOAT := 65.0;
-                ITEM_FLT : FLOAT;
-                ONE_FLT : POSITIVE_COUNT := 1;
-                TWO_FLT : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE_FLT, FLT);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "FLOATING POINT - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_FLT, FLT, TWO_FLT);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "FLOATING POINT - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_FLT) /= TWO_FLT THEN
-                          FAILED ("SIZE FOR FLOATING POINT");
-                     END IF;
- 
-                     IF NOT END_OF_FILE (FILE_FLT) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR " &
-                                  "FLOATING POINT");
-                     END IF;
- 
-                     SET_INDEX (FILE_FLT, ONE_FLT);
-                     IF INDEX (FILE_FLT) /= ONE_FLT THEN
-                          FAILED ("WRONG INDEX VALUE FOR " &
-                                  "FLOATING POINT");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_FLT);
- 
-                BEGIN
-                     OPEN (FILE_FLT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE " &
-                                          "MODE NOT SUPPORTED");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_FLT, ITEM_FLT);
-                     IF ITEM_FLT /= FLT THEN
-                          FAILED ("WRONG VALUE READ FOR " &
-                                  "FLOATING POINT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR " &
-                                  "TYPE FLOATING POINT");
-                END;
- 
-                BEGIN
-                     READ (FILE_FLT, ITEM_FLT, ONE_FLT);
-                     IF ITEM_FLT /= FLT THEN
-                          FAILED ("WRONG VALUE READ WITH INDEX FOR " &
-                                  "FLOATING POINT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR " &
-                                  "TYPE FLOATING POINT");
-                END;
- 
-                BEGIN
-                     DELETE (FILE_FLT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
- 
-      RESULT;
- 
- END CE2401E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,200 ****
- -- CE2401F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
- --     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
- --     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE
- --     PRIVATE.
- 
- -- APPLICABILITY CRITERIA:
- --
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     ABW 08/18/82
- --     SPS 09/15/82
- --     SPS 11/09/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST
- --     EG  11/19/85  CORRECT SO TEST CAN HANDLE IMPLEMENTATION WITH
- --                   POSITIVE_COUNT'LAST=1; COVER POSSIBILITY OF CREATE
- --                   RAISING USE_ERROR; ENSURE RESET DOESN'T RAISE
- --                   EXCEPTION IF CREATE FAILS; CHECK THAT WE CAN READ
- --                   DATA THAT HAS BEEN WRITTEN.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/11/87  ISOLATED EXCEPTIONS.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401F IS
- 
-      END_SUBTEST : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2401F", "CHECK THAT READ, WRITE, SET_INDEX, " &
-                        "INDEX, SIZE, AND END_OF_FILE ARE " &
-                        "SUPPORTED FOR DIRECT FILES WITH " &
-                        "ELEMENT_TYPE PRIVATE");
- 
-      DECLARE
- 
-           PACKAGE PKG IS
-                TYPE PRIV IS PRIVATE;
-                FUNCTION ASSIGN RETURN PRIV;
-           PRIVATE
-                TYPE PRIV IS NEW INTEGER;
-           END PKG;
- 
-           USE PKG;
- 
-           PACKAGE DIR_PRV IS NEW DIRECT_IO (PRIV);
-           USE DIR_PRV;
-           FILE_PRV : FILE_TYPE;
- 
-           PACKAGE BODY PKG IS
-                FUNCTION ASSIGN RETURN PRIV IS
-                BEGIN
-                     RETURN (16);
-                END;
-           BEGIN
-                NULL;
-           END PKG;
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE_PRV, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - PRIVATE");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - PRIVATE");
-                     RAISE END_SUBTEST;
-           END;
- 
-           BEGIN
- 
-                DECLARE
- 
-                     PRV, ITEM_PRV : PRIV;
-                     ONE_PRV : POSITIVE_COUNT := 1;
-                     TWO_PRV : POSITIVE_COUNT := 2;
- 
-                BEGIN
- 
-                     PRV := ASSIGN;
- 
-                     BEGIN
-                          WRITE (FILE_PRV, PRV);
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                       "PRIVATE - 1");
-                     END;
- 
-                     BEGIN
-                          WRITE (FILE_PRV, PRV, TWO_PRV);
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                       "PRIVATE - 2");
-                     END;
- 
-                     BEGIN
-                          IF SIZE (FILE_PRV) /= TWO_PRV THEN
-                               FAILED ("SIZE FOR TYPE PRIVATE");
-                          END IF;
-                          IF NOT END_OF_FILE (FILE_PRV) THEN
-                               FAILED ("WRONG END_OF_FILE VALUE FOR " &
-                                       "PRIVATE TYPE");
-                          END IF;
- 
-                          SET_INDEX (FILE_PRV, ONE_PRV);
- 
-                          IF INDEX (FILE_PRV) /= ONE_PRV THEN
-                               FAILED ("WRONG INDEX VALUE FOR PRIVATE " &
-                                       "TYPE");
-                          END IF;
-                     END;
- 
-                     CLOSE (FILE_PRV);
- 
-                     BEGIN
-                          OPEN (FILE_PRV, IN_FILE, LEGAL_FILE_NAME);
-                     EXCEPTION
-                          WHEN USE_ERROR =>
-                               NOT_APPLICABLE ("OPEN FOR IN_FILE NOT " &
-                                        "SUPPORTED");
-                               RAISE END_SUBTEST;
-                     END;
- 
-                     BEGIN
-                          READ (FILE_PRV, ITEM_PRV);
-                          IF ITEM_PRV /= PRV THEN
-                               FAILED ("INCORRECT PRIVATE TYPE VALUE " &
-                                       "READ - 1");
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("READ WITHOUT FROM FOR " &
-                                       "PRIVATE TYPE");
-                     END;
- 
-                     BEGIN
-                          READ (FILE_PRV, ITEM_PRV, ONE_PRV);
-                          IF ITEM_PRV /= PRV THEN
-                               FAILED ("INCORRECT PRIVATE TYPE VALUE " &
-                                       "READ - 2");
-                          END IF;
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("READ WITH FROM FOR " &
-                                       "PRIVATE TYPE");
-                     END;
-                END;
- 
-                BEGIN
-                     DELETE (FILE_PRV);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
- 
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,168 ****
- -- CE2401H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, SET_INDEX, INDEX, SIZE, AND
- --     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH
- --     ELEMENT_TYPE UNCONSTRAINED RECORDS WITH DEFAULT DISCRIMINANTS.
- 
- --     THIS INSTANTIATION IS ALWAYS LEGAL BY AI-00037.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 05/15/86
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/10/87  ISOLATED EXCEPTIONS.
- 
- WITH REPORT;
- USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401H IS
- 
-      END_SUBTEST : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2401H", "CHECK THAT READ, WRITE, SET_INDEX, INDEX, " &
-                        "SIZE, AND END_OF_FILE ARE SUPPORTED FOR " &
-                        "DIRECT FILES WITH ELEMENT_TYPE UNCONSTRAINED " &
-                        "RECORDS WITH DEFAULT DISCRIMINANTS");
- 
-      DECLARE
-           TYPE REC_DEF (DISCR : INTEGER := 1) IS
-                RECORD
-                     ONE : INTEGER := DISCR;
-                     TWO : INTEGER := 3;
-                     THREE : INTEGER := 5;
-                     FOUR : INTEGER := 7;
-                END RECORD;
-           PACKAGE DIR_REC_DEF IS NEW DIRECT_IO (REC_DEF);
-           USE DIR_REC_DEF;
-           FILE1 : FILE_TYPE;
-           REC : REC_DEF;
-           ITEM : REC_DEF;
-           ONE : POSITIVE_COUNT := 1;
-           TWO : POSITIVE_COUNT := 2;
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR  =>
-                     NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " &
-                                     "NOT SUPPORTED FOR " &
-                                     "UNCONSTRAINED RECORDS WITH " &
-                                     "DEFAULT DISCRIMINATES");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON DIRECT " &
-                             "CREATE");
-                     RAISE END_SUBTEST;
-           END;
- 
-           BEGIN
-                WRITE (FILE1, REC);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                             "RECORD WITH DEFAULT - 1");
-           END;
- 
-           BEGIN
-                WRITE (FILE1, REC, TWO);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                             "RECORD WITH DEFAULT - 2");
-           END;
- 
-           BEGIN
-                IF SIZE (FILE1) /= TWO THEN
-                     FAILED ("SIZE FOR RECORD WITH DEFAULT");
-                END IF;
-                IF NOT END_OF_FILE (FILE1) THEN
-                     FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
-                             "RECORD WITH DEFAULT");
-                END IF;
-                SET_INDEX (FILE1, ONE);
-                IF INDEX (FILE1) /= ONE THEN
-                     FAILED ("WRONG INDEX VALUE FOR RECORD" &
-                             "WITH DEFAULT");
-                END IF;
-           END;
- 
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("OPEN FOR IN_FILE NOT SUPPORTED");
-                     RAISE END_SUBTEST;
-           END;
- 
-           BEGIN
-                READ (FILE1, ITEM);
-                IF ITEM /= (1,1,3,5,7) THEN
-                     FAILED ("WRONG VALUE READ");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("READ WITHOUT FROM FOR " &
-                             "TYPE RECORD WITH DEFAULT");
-           END;
- 
-           BEGIN
-                ITEM := (OTHERS => 0);
-                READ (FILE1, ITEM, ONE);
-                IF ITEM /= (1,1,3,5,7) THEN
-                     FAILED ("WRONG VALUE READ");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("READ WITH FROM FOR " &
-                             "TYPE RECORD WITH DEFAULT");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- CE2401I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
- --     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
- --     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE
- --     FIXED POINT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY FOR IMPLEMENTATIONS WHICH SUPPORT CREATION OF
- --     DIRECT FILES WITH INOUT_FILE MODE AND OPENING OF DIRECT FILES
- --     WITH IN_FILE MODE.
- 
- -- HISTORY:
- --     DWC 08/10/87  CREATED ORIGINAL VERSION.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401I IS
- 
-      END_SUBTEST : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2401I", "CHECK THAT READ, WRITE, SET_INDEX, " &
-                        "INDEX, SIZE, AND END_OF_FILE ARE " &
-                        "SUPPORTED FOR DIRECT FILES WITH " &
-                        "ELEMENT_TYPE FIXED");
- 
-      DECLARE
- 
-           TYPE FIX_TYPE IS DELTA 0.5 RANGE 0.0 .. 255.0;
-           PACKAGE DIR_FIX IS NEW DIRECT_IO (FIX_TYPE);
-           USE DIR_FIX;
-           FILE_FIX : FILE_TYPE;
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE_FIX, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
-                                     "ON CREATE - FIXED POINT");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE - FIXED POINT");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                FIX : FIX_TYPE := 16.0;
-                ITEM_FIX : FIX_TYPE;
-                ONE_FIX : POSITIVE_COUNT := 1;
-                TWO_FIX : POSITIVE_COUNT := 2;
- 
-           BEGIN
-                BEGIN
-                     WRITE (FILE_FIX, FIX);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "FIXED POINT - 1");
-                END;
- 
-                BEGIN
-                     WRITE (FILE_FIX, FIX, TWO_FIX);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
-                                  "FIXED POINT - 2");
-                END;
- 
-                BEGIN
-                     IF SIZE (FILE_FIX) /= TWO_FIX THEN
-                          FAILED ("SIZE FOR TYPE FIXED POINT");
-                     END IF;
- 
-                     IF NOT END_OF_FILE (FILE_FIX) THEN
-                          FAILED ("WRONG END_OF_FILE VALUE FOR " &
-                                  "FIXED POINT");
-                     END IF;
- 
-                     SET_INDEX (FILE_FIX, ONE_FIX);
- 
-                     IF INDEX (FILE_FIX) /= ONE_FIX THEN
-                          FAILED ("WRONG INDEX VALUE FOR FIXED " &
-                                  "POINT");
-                     END IF;
-                END;
- 
-                CLOSE (FILE_FIX);
- 
-                BEGIN
-                     OPEN (FILE_FIX, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
-                                          "NOT SUPPORTED");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE_FIX, ITEM_FIX);
-                     IF ITEM_FIX /= FIX THEN
-                         FAILED ("WRONG VALUE READ FOR FIXED POINT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITHOUT FROM FOR FIXED " &
-                                  "POINT");
-                END;
- 
-                BEGIN
-                     READ (FILE_FIX, ITEM_FIX, ONE_FIX);
-                     IF ITEM_FIX /= FIX THEN
-                         FAILED ("WRONG VALUE READ WITH INDEX " &
-                                 "FOR FIXED POINT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ WITH FROM FOR FIXED POINT");
-                END;
- 
-                BEGIN
-                     DELETE (FILE_FIX);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,176 ****
- -- CE2401J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DATA WRITTEN INTO A DIRECT FILE CAN BE READ
- --     CORRECTLY.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     DWC 08/12/87  CREATE ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401J IS
-      END_SUBTEST: EXCEPTION;
- BEGIN
- 
-      TEST ("CE2401J" , "CHECK THAT DATA WRITTEN INTO A DIRECT FILE " &
-                        "CAN BE READ CORRECTLY");
- 
-      DECLARE
-           PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-           USE DIR_IO;
-           FILE : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE WITH INOUT FILE NOT " &
-                                     "SUPPORTED");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                OUT_ITEM1 : INTEGER := 10;
-                OUT_ITEM2 : INTEGER := 21;
-                OUT_ITEM3 : INTEGER := 32;
-                IN_ITEM   : INTEGER;
-                ONE   : POSITIVE_COUNT := 1;
-                THREE : POSITIVE_COUNT := 3;
-                FIVE  : POSITIVE_COUNT := 5;
-           BEGIN
-                BEGIN
-                     WRITE (FILE, OUT_ITEM1, ONE);
-                     WRITE (FILE, OUT_ITEM2, THREE);
-                     BEGIN
-                          READ (FILE, IN_ITEM, ONE);
-                          IF OUT_ITEM1 /= IN_ITEM THEN
-                               FAILED ("INCORRECT INTEGER VALUE " &
-                                       "READ - 1");
-                          END IF;
-                     END;
-                     WRITE (FILE, OUT_ITEM3, FIVE);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, THREE);
-                     IF OUT_ITEM2 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 2");
-                     END IF;
-                END;
- 
-                BEGIN
-                     RESET (FILE);
-                     READ (FILE, IN_ITEM);
-                     IF OUT_ITEM1 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 3");
-                     END IF;
-                EXCEPTION
-                     WHEN USE_ERROR => NULL;
-                END;
- 
-                CLOSE (FILE);
- 
-                BEGIN
-                     OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM);
-                     IF OUT_ITEM1 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 4");
-                          RAISE END_SUBTEST;
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ IN IN_FILE MODE - 1");
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, ONE);
-                     IF OUT_ITEM1 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 5");
-                          RAISE END_SUBTEST;
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ IN IN_FILE MODE - 2");
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, FIVE);
-                     IF OUT_ITEM3 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 6");
-                          RAISE END_SUBTEST;
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ IN IN_FILE MODE - 3");
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, THREE);
-                     IF OUT_ITEM2 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 7");
-                          RAISE END_SUBTEST;
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("READ IN IN_FILE MODE - 4");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- CE2401K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DATA CAN BE OVERWRITTEN IN THE DIRECT FILE AND
- --     THE CORRECT VALUES CAN LATER BE READ.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF INOUT_FILE MODE AND OPENING OF OUT_FILE MODE FOR
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     DWC 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401K IS
-      END_SUBTEST: EXCEPTION;
- BEGIN
- 
-      TEST ("CE2401K" , "CHECK THAT DATA CAN BE OVERWRITTEN IN " &
-                        "THE DIRECT FILE AND THE CORRECT VALUES " &
-                        "CAN LATER BE READ.");
- 
-      DECLARE
-           PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-           USE DIR_IO;
-           FILE : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " &
-                                     "NOT SUPPORTED");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                OUT_ITEM1 : INTEGER := 10;
-                OUT_ITEM2 : INTEGER := 21;
-                IN_ITEM   : INTEGER;
-                ONE : POSITIVE_COUNT := 1;
-                TWO : POSITIVE_COUNT := 2;
-           BEGIN
-                BEGIN
-                     WRITE (FILE, OUT_ITEM1, ONE);
-                     WRITE (FILE, OUT_ITEM2, TWO);
-                     WRITE (FILE, OUT_ITEM2, ONE);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE " &
-                                  "IN INOUT_FILE MODE");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, ONE);
-                     IF OUT_ITEM2 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 1");
-                          RAISE END_SUBTEST;
-                     END IF;
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, TWO);
-                     IF OUT_ITEM2 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 2");
-                          RAISE END_SUBTEST;
-                     END IF;
-                END;
- 
-                CLOSE (FILE);
- 
-                BEGIN
-                     OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     WRITE (FILE, OUT_ITEM1, ONE);
-                     WRITE (FILE, OUT_ITEM2, TWO);
-                     WRITE (FILE, OUT_ITEM1, TWO);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE " &
-                                  "IN OUT_FILE MODE");
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     RESET (FILE, IN_FILE);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          RAISE END_SUBTEST;
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, ONE);
-                     IF OUT_ITEM1 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 3");
-                          RAISE END_SUBTEST;
-                     END IF;
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          FAILED ("READ IN IN_FILE MODE - 1");
-                END;
- 
-                BEGIN
-                     READ (FILE, IN_ITEM, TWO);
-                     IF OUT_ITEM1 /= IN_ITEM THEN
-                          FAILED ("INCORRECT INTEGER VALUE READ - 4");
-                          RAISE END_SUBTEST;
-                     END IF;
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          FAILED ("READ IN IN_FILE MODE - 2");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- CE2401L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT REWRITING AN ELEMENT DOES NOT CHANGE THE SIZE OF
- --     THE FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH INOUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     DWC 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2401L IS
-      END_SUBTEST: EXCEPTION;
- BEGIN
- 
-      TEST ("CE2401L" , "CHECK THAT REWRITING AN ELEMENT DOES NOT " &
-                        "CHANGE THE SIZE OF THE FILE");
- 
-      DECLARE
-           PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-           USE DIR_IO;
-           FILE : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " &
-                                     "NOT SUPPORTED");
-                     RAISE END_SUBTEST;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED ON " &
-                             "CREATE");
-                     RAISE END_SUBTEST;
-           END;
- 
-           DECLARE
-                OUT_ITEM1 : INTEGER := 10;
-                OUT_ITEM2 : INTEGER := 21;
-                OUT_ITEM4 : INTEGER := 43;
-                IN_ITEM   : INTEGER;
-                ONE  : POSITIVE_COUNT := 1;
-                TWO  : POSITIVE_COUNT := 2;
-                FOUR : POSITIVE_COUNT := 4;
-                OLD_FILE_SIZE : POSITIVE_COUNT;
-           BEGIN
-                BEGIN
-                     WRITE (FILE, OUT_ITEM1, ONE);
-                     WRITE (FILE, OUT_ITEM4, FOUR);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED ON WRITE " &
-                                  "IN INOUT_FILE MODE");
-                          RAISE END_SUBTEST;
-                END;
- 
-                OLD_FILE_SIZE := SIZE (FILE);
- 
-                WRITE (FILE, OUT_ITEM1, ONE);
-                WRITE (FILE, OUT_ITEM4, FOUR);
- 
-                IF OLD_FILE_SIZE /= SIZE (FILE) THEN
-                     FAILED ("FILE SIZE CHANGED DURING REWRITE - 1");
-                     RAISE END_SUBTEST;
-                END IF;
- 
-                WRITE (FILE, OUT_ITEM1, ONE);
-                WRITE (FILE, OUT_ITEM2, TWO);
-                WRITE (FILE, OUT_ITEM4, FOUR);
- 
-                OLD_FILE_SIZE := SIZE (FILE);
- 
-                WRITE (FILE, OUT_ITEM1, FOUR);
- 
-                IF OLD_FILE_SIZE /= SIZE (FILE) THEN
-                     FAILED ("FILE SIZE CHANGED DURING REWRITE - 2");
-                     RAISE END_SUBTEST;
-                END IF;
-           EXCEPTION
-                WHEN END_SUBTEST =>
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN END_SUBTEST =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2401L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,161 ****
- -- CE2402A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ, WRITE, INDEX, SET_INDEX, SIZE, AND
- --     END_OF_FILE RAISE STATUS_ERROR WHEN APPLIED TO A NON-OPEN
- --     DIRECT FILE.  USE_ERROR IS NOT PERMITTED.
- 
- -- HISTORY:
- --     ABW 08/17/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     JBG 08/30/83
- --     EG  11/26/84
- --     EG  06/04/85
- --     GMT 08/03/87  CLARIFIED SOME OF THE FAILED MESSAGES, AND
- --                   REMOVED THE EXCEPTION FOR CONSTRAINT_ERROR.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2402A IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      FILE1   : FILE_TYPE;
-      CNST    : CONSTANT INTEGER := 101;
-      IVAL    : INTEGER;
-      BOOL    : BOOLEAN;
-      X_COUNT : COUNT;
-      P_COUNT : POSITIVE_COUNT;
- 
- BEGIN
-      TEST ("CE2402A","CHECK THAT READ, WRITE, INDEX, "   &
-                      "SET_INDEX, SIZE, AND END_OF_FILE " &
-                      "RAISE STATUS_ERROR WHEN APPLIED "  &
-                      "A NON-OPEN DIRECT FILE");
-      BEGIN
-           WRITE (FILE1, CNST);
-           FAILED ("STATUS_ERROR WAS NOT RAISED ON WRITE - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED ON WRITE - 2");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON WRITE - 3");
-      END;
- 
-      BEGIN
-           X_COUNT := SIZE (FILE1);
-           FAILED ("STATUS_ERROR NOT RAISED ON SIZE - 4");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED ON SIZE - 5");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON SIZE - 6");
-      END;
- 
-      BEGIN
-           BOOL := END_OF_FILE (FILE1);
-           FAILED ("STATUS_ERROR WAS NOT RAISED ON END_OF_FILE - 7");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED ON END_OF_FILE - 8");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON END_OF_FILE - 9");
-      END;
- 
-      BEGIN
-           P_COUNT := INDEX (FILE1);
-           FAILED ("STATUS_ERROR WAS NOT RAISED ON INDEX - 10");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED ON INDEX - 11");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON INDEX - 12");
-      END;
- 
-      BEGIN
-           READ (FILE1, IVAL);
-           FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 13");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED ON READ - 14");
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON READ - 15");
-      END;
- 
-      DECLARE
-           ONE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
-      BEGIN
-           BEGIN
-                WRITE (FILE1, CNST, ONE);
-                FAILED ("STATUS_ERROR NOT RAISED ON WRITE - 16");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED ON WRITE - 17");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON WRITE - 18");
-           END;
- 
-           BEGIN
-                SET_INDEX (FILE1,ONE);
-                FAILED ("STATUS_ERROR NOT RAISED ON SET_INDEX - 19");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED ON SET_INDEX - 20");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON SET_INDEX - 21");
-           END;
- 
-           BEGIN
-                READ (FILE1, IVAL, ONE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 22");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED ON READ - 23");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON READ - 24");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE2402A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- CE2403A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR DIRECT_IO, WRITE RAISES THE EXCEPTION
- --     USE_ERROR IF THE CAPACITY OF THE EXTERNAL FILE IS EXCEEDED.
- --     THIS TEST ONLY CHECKS THAT THE IMPLEMENTATION SUPPORTS AN
- --     EXTERNAL FILE CAPACITY OF 4096 CHARACTERS OR LESS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT FILES.  ALSO, THE IMPLEMENTATION MUST BE ABLE TO
- --     RESTRICT THE CAPACITY OF AN EXTERNAL FILE.
- 
- --     $FORM_STRING2 IS DEFINED SUCH THAT THE CAPACITY OF THE FILE IS
- --     RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION
- --     CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL
- --     "CANNOT_RESTRICT_FILE_CAPACITY".
- 
- -- HISTORY:
- --     JLH 07/12/88  CREATED ORIGINAL TEST.
- -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2403A IS
- 
-      SUBTYPE STR512 IS STRING (1 .. 512);
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (STR512);
-           USE DIR_IO;
- 
-      FILE : FILE_TYPE;
-      ITEM : STR512 := (1 .. 512 => 'A');
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2403A", "CHECK FOR DIRECT_IO THAT WRITE RAISES " &
-                       "USE_ERROR IF THE CAPACITY OF THE EXTERNAL " &
-                       "FILE IS EXCEEDED");
- 
-      BEGIN
- 
-           IF
- $FORM_STRING2
-                = STRING'("CANNOT_RESTRICT_FILE_CAPACITY") THEN
-                NOT_APPLICABLE ("IMPLEMENTATION CANNOT RESTRICT FILE " &
-                                "CAPACITY");
-                RAISE INCOMPLETE;
-           ELSE
-                BEGIN
-                     CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME,
- 
- $FORM_STRING2
- );
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                          "WITH MODE OUT_FILE");
-                          RAISE INCOMPLETE;
-                     WHEN NAME_ERROR =>
-                          NOT_APPLICABLE ("NAME_ERROR RAISED ON " &
-                                          "CREATE WITH MODE OUT_FILE");
-                          RAISE INCOMPLETE;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                                  "CREATE");
-                          RAISE INCOMPLETE;
-                END;
-           END IF;
- 
-           BEGIN
-                FOR I IN 1 .. 9 LOOP
-                     WRITE (FILE, ITEM);
-                END LOOP;
-                FAILED ("USE_ERROR NOT RAISED WHEN THE CAPACITY " &
-                        "OF THE EXTERNAL FILE IS EXCEEDED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE2403A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- CE2404A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ RAISES MODE_ERROR WHEN THE CURRENT MODE IS
- --     OUT_FILE.
- 
- --          A)  CHECK NON-TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF DIRECT FILES WITH MODE OUT_FILE.
- 
- -- HISTORY:
- --     DLD 08/17/82
- --     SPS 11/09/82
- --     SPS 11/22/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST.
- --     EG  05/16/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 08/03/87  MOVED THE TEMP-FILE CASE TO CE2404B.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2404A IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-      USE DIR_IO;
-      DIR_FILE_1 : FILE_TYPE;
-      I          : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE2404A", "CHECK THAT READ RAISES MODE_ERROR WHEN THE " &
-                       "CURRENT MODE IS OUT_FILE AND THE FILE IS " &
-                       "A NON-TEMPORARY FILE");
-      BEGIN
- 
-           CREATE (DIR_FILE_1, OUT_FILE, LEGAL_FILE_NAME);
- 
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 3");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           READ (DIR_FILE_1, I);
-           FAILED ("MODE_ERROR NOT RAISED ON READ - 4");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON READ - 5");
-      END;
- 
-      BEGIN
-           DELETE (DIR_FILE_1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2404A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- CE2404B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ RAISES MODE_ERROR WHEN THE CURRENT MODE IS
- --     OUT_FILE.
- 
- --          B)  CHECK TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF DIRECT FILES WITH MODE OUT_FILE.
- 
- -- HISTORY:
- --     GMT 08/03/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2404B IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
-      USE DIR_IO;
-      DIR_FILE_2 : FILE_TYPE;
-      I          : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE2404B", "CHECK THAT READ RAISES MODE_ERROR WHEN THE " &
-                       "CURRENT MODE IS OUT_FILE AND THE FILE IS " &
-                       "A TEMPORARY FILE");
-      BEGIN
-           CREATE (DIR_FILE_2, OUT_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 2");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           READ(DIR_FILE_2, I);
-           FAILED("MODE_ERROR NOT RAISED ON READ - 3");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED("WRONG EXCEPTION RAISED ON READ - 4");
-      END;
- 
-      CLOSE (DIR_FILE_2);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2404B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- CE2405B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT READ RAISES END_ERROR WHEN THE CURRENT READ POSITION
- --     IS GREATER THAN THE END POSITION.  ALSO CHECK THAT END_OF_FILE
- --     CORRECTLY DETECTS THE END OF A DIRECT FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION WITH INOUT_FILE MODE AND OPENING OF IN_FILE MODE.
- 
- -- HISTORY:
- --     SPS 09/28/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST
- --     EG  05/16/85
- --     GMT 08/03/87  ADDED CODE TO CHECK THAT END_OF_FILE WORKS, AND
- --                   ADDED CODE TO PREVENT SOME EXCEPTION PROPAGATION.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2405B IS
- BEGIN
-      TEST ("CE2405B", "CHECK THAT END_ERROR IS RAISED BY READ AT THE " &
-                       "END OF A FILE AND THAT END_OF_FILE CORRECTLY " &
-                       "DETECTS THE END OF A DIRECT_IO FILE");
-      DECLARE
-           PACKAGE DIR IS NEW DIRECT_IO (CHARACTER);
-           USE DIR;
-           FT         : FILE_TYPE;
-           CH         : CHARACTER;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
- 
-           -- CREATE AND INITIALIZE FILE
- 
-           BEGIN
-                CREATE (FT, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR | NAME_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR WAS " &
-                                     "RAISED ON CREATE - 1");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
- 
-                WRITE (FT, 'C');
-                WRITE (FT, 'X');
- 
-                -- BEGIN TEST
- 
-                IF NOT END_OF_FILE (FT) THEN
-                     FAILED ("END_OF_FILE RETURNED INCORRECT " &
-                             "BOOLEAN VALUE - 3");
-                END IF;
- 
-                BEGIN
-                     READ (FT, CH);
-                     FAILED ("END_ERROR NOT RAISED ON READ - 4");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED ON READ - 5");
-                END;
- 
-                WRITE (FT,'E');
- 
-                BEGIN
-                     READ (FT, CH);
-                     FAILED ("END_ERROR NOT RAISED ON READ - 6");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED ON READ - 7");
-                END;
- 
-           END;
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN - 8");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 9");
-                     RAISE INCOMPLETE;
-           END;
- 
-           DECLARE
-                COUNT_NBR_OF_READS : NATURAL := 0;
-                EXPECTED_COUNT     : CONSTANT := 3;
-           BEGIN
-                LOOP
-                     IF END_OF_FILE (FT) THEN
-                          EXIT;
-                     ELSE
-                          READ (FT, CH);
-                          COUNT_NBR_OF_READS := COUNT_NBR_OF_READS + 1;
-                     END IF;
-                END LOOP;
- 
-                IF COUNT_NBR_OF_READS /= EXPECTED_COUNT THEN
-                       FAILED ("THE BAD VALUE FOR COUNT_NBR_OF_READS " &
-                               "IS " &
-                                NATURAL'IMAGE (COUNT_NBR_OF_READS) );
-                END IF;
- 
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
- 
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE2405B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,199 ****
- -- CE2406A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR A DIRECT ACCESS FILE, CHECK THAT AFTER A READ, THE CURRENT
- --     READ POSITION IS INCREMENTED BY ONE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT_IO FILES.
- 
- -- HISTORY:
- --     ABW 08/20/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     JBG 02/22/84  CHANGE TO .ADA TEST.
- --     EG  05/16/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 08/05/87  REMOVED DEPENDENCE ON RESET AND ADDED CHECK FOR
- --                   USE_ERROR ON DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2406A IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      FILE1                : FILE_TYPE;
-      INT                  : INTEGER := IDENT_INT (18);
-      BOOL                 : BOOLEAN := IDENT_BOOL (TRUE);
-      INT_ITEM1, INT_ITEM2 : INTEGER;
-      INCOMPLETE           : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2406A", "CHECK THAT READ POSITION IS INCREMENTED " &
-                       "BY ONE AFTER A READ");
- 
-      -- CREATE AND INITIALIZE FILE1
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN NAME_ERROR | USE_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR | USE_ERROR RAISED " &
-                                     "ON CREATE - 1");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                WRITE (FILE1, INT);
-                WRITE (FILE1, 26);
-                WRITE (FILE1, 12);
-                WRITE (FILE1, 19);
-                WRITE (FILE1, INT);
-                WRITE (FILE1, 3);
- 
-                -- BEGIN TEST
- 
-                CLOSE (FILE1);
-                BEGIN
-                     OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON" &
-                                          "OPEN - 3");
-                          RAISE INCOMPLETE;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED ON " &
-                                          "OPEN - 4");
-                          RAISE INCOMPLETE;
-                END;
- 
- 
-                IF INDEX(FILE1) /= POSITIVE_COUNT (IDENT_INT(1)) THEN
-                     FAILED ("INITIAL INDEX VALUE INCORRECT - 5");
-                ELSE
-                     READ (FILE1, INT_ITEM1);
-                     IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
-                          FAILED ("INDEX VALUE NOT INCREMENTED - 6");
-                     ELSE
-                          IF INT_ITEM1 /= IDENT_INT(18) THEN
-                               FAILED ("READ INCORRECT VALUE - 7");
-                          END IF;
-                          READ (FILE1, INT_ITEM1, 4);
-                          IF INDEX(FILE1) /=
-                             POSITIVE_COUNT (IDENT_INT(5)) THEN
-                              FAILED ("INDEX VALUE NOT INCREMENTED " &
-                                      "WHEN TO IS SPECIFIED - 8");
-                          ELSE
-                               IF INT_ITEM1 /= IDENT_INT(19) THEN
-                                    FAILED ("READ INCORRECT VALUE - 9");
-                               END IF;
-                               READ (FILE1, INT_ITEM1);
-                               IF INDEX(FILE1) /=
-                                  POSITIVE_COUNT(IDENT_INT(6)) THEN
-                                    FAILED ("INDEX VALUE NOT " &
-                                            "INCREMENTED WHEN " &
-                                            "LAST - 10");
-                               ELSIF INT_ITEM1 /= IDENT_INT(18) THEN
-                                    FAILED ("READ INCORRECT " &
-                                            "IN_FILE VALUE - 11");
-                               END IF;
-                          END IF;
-                     END IF;
-                END IF;
- 
-                CLOSE (FILE1);
-                BEGIN
-                     OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON " &
-                                          "OPEN - 12");
-                          RAISE INCOMPLETE;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED ON " &
-                                          "OPEN - 13");
-                          RAISE INCOMPLETE;
-                END;
- 
-                IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN
-                     FAILED ("INITIAL INDEX VALUE INCORRECT - 14");
-                ELSE
-                     READ (FILE1, INT_ITEM2);
-                     IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
-                          FAILED ("INDEX VALUE NOT INCREMENTED - 15");
-                     ELSE
-                          IF INT_ITEM2 /= IDENT_INT(18) THEN
-                               FAILED ("READ INCORRECT VALUE - 16");
-                          END IF;
-                          READ (FILE1, INT_ITEM2, 4);
-                          IF INDEX (FILE1) /=
-                             POSITIVE_COUNT(IDENT_INT(5)) THEN
-                              FAILED ("INDEX VALUE NOT INCREMENTED " &
-                                      "WHEN TO IS SPECIFIED - 17");
-                          ELSE
-                               IF INT_ITEM2 /= IDENT_INT(19) THEN
-                                    FAILED ("INCORRECT VALUE - 18");
-                               END IF;
-                               READ (FILE1, INT_ITEM2);
-                               IF INDEX(FILE1) /=
-                                  POSITIVE_COUNT(IDENT_INT(6)) THEN
-                                    FAILED ("INDEX VALUE NOT " &
-                                            "INCREMENTED WHEN " &
-                                            "LAST - INOUT_FILE - 19");
-                               ELSIF INT_ITEM2 /= IDENT_INT(18) THEN
-                                    FAILED ("READ INCORRECT " &
-                                            "INOUT_FILE VALUE - 20");
-                               END IF;
-                          END IF;
-                     END IF;
-                END IF;
- 
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
- 
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE2406A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- CE2407A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WRITE RAISES MODE_ERROR WHEN THE CURRENT MODE
- --     IS IN_FILE.
- 
- --          1) CHECK NON-TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE AND OPEN WITH IN_FILE MODE FOR DIRECT
- --     FILES.
- 
- -- HISTORY:
- --     ABW 08/20/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 08/06/86  REMOVED THE DEPENDENCE ON RESET AND MOVED THE CHECK
- --                   FOR TEMPORARY FILES INTO CE2407B.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2407A IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      INCOMPLETE : EXCEPTION;
-      FILE1      : FILE_TYPE;
-      INT        : INTEGER := IDENT_INT (18);
- 
- BEGIN
-      TEST ("CE2407A", "CHECK THAT WRITE RAISES MODE_ERROR WHEN THE " &
-                       "CURRENT MODE IS IN_FILE AND THE FILE IS " &
-                       "A NON-TEMPORARY FILE");
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 3");
-                RAISE INCOMPLETE;
-      END;
- 
-      WRITE (FILE1, INT);
-      CLOSE (FILE1);
- 
-      BEGIN
-           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE("USE_ERROR RAISED ON OPEN - 4");
-                RAISE INCOMPLETE;
-      END;
- 
- 
- 
-      BEGIN
-           WRITE (FILE1,INT);
-           FAILED ("MODE_ERROR NOT RAISED ON WRITE - 5");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED ON WRITE - 6");
-      END;
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2407A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- CE2407B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WRITE RAISES MODE_ERROR WHEN THE CURRENT MODE
- --     IS IN_FILE.
- 
- --          2) CHECK TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE AND RESET FROM OUT_FILE MODE TO
- --     IN_FILE MODE.
- 
- -- HISTORY:
- --     GMT 08/06/86  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2407B IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      INCOMPLETE : EXCEPTION;
-      FILE2      : FILE_TYPE;
-      INT        : INTEGER := IDENT_INT (18);
- 
- BEGIN
-      TEST ("CE2407B", "CHECK THAT WRITE RAISES MODE_ERROR WHEN THE " &
-                       "CURRENT MODE IS IN_FILE AND THE FILE IS " &
-                       "A TEMPORARY FILE");
-      BEGIN
-           CREATE (FILE2, OUT_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 2");
-                RAISE INCOMPLETE;
-      END;
- 
-      WRITE (FILE2, INT);
- 
-      BEGIN
-           RESET (FILE2, IN_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE("USE_ERROR RAISED ON RESET - 3");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           WRITE (FILE2, INT);
-           FAILED ("MODE_ERROR NOT RAISED ON WRITE - 4");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED ON WRITE - 5");
-      END;
- 
-      CLOSE (FILE2);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2407B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- CE2408A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE TO
- --     PARAMETER IS GREATER THAN THE END POSITION.
- 
- --          1) FILE MODE IS OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF DIRECT FILES WITH MODE OUT_FILE.
- 
- -- HISTORY:
- --     DLD 08/19/82
- --     SPS 11/09/82
- --     EG  05/16/85
- --     GMT 08/05/87  ADDED A CHECK FOR USE_ERROR ON DELETE AND REMOVED
- --                   THE OTHERS EXCEPTION AT THE BOTTOM OF THE FILE.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2408A IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-      USE DIR_IO;
- 
-      DIR_FILE   : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2408A", "FOR FILES OF MODE OUT_FILE, CHECK THAT " &
-                       "WRITE DOES NOT CAUSE AN EXCEPTION  WHEN THE " &
-                       """TO"" PARAMETER IS GREATER THAN THE END " &
-                       "POSITION");
- 
-      -- CREATE TEST FILE
- 
-      BEGIN
-           CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH MODE " &
-                                "OUT_FILE FOR DIR_IO - 1");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "MODE OUT_FILE FOR DIR_IO - 2");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE WITH " &
-                        "MODE OUT_FILE FOR DIR_IO - 3");
-                RAISE INCOMPLETE;
-      END;
- 
-      -- FILL UP FILE
- 
-      WRITE (DIR_FILE, 3);
-      WRITE (DIR_FILE, 4);
-      WRITE (DIR_FILE, 5);
-      WRITE (DIR_FILE, 6);
- 
-      -- WRITE WHERE TO IS LARGER THAN END OF FILE
- 
-      BEGIN
-           WRITE (DIR_FILE, 9, 7);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("WRITE RAISED EXCEPTION WHEN TO " &
-                        "PARAMETER WAS BEYOND END - 4");
-      END;
- 
-      BEGIN
-           SET_INDEX (DIR_FILE, 11);
-           WRITE (DIR_FILE, 10);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("SET_INDEX/WRITE RAISED EXCEPTION WHEN TO " &
-                        "PARAMETER EXCEEDS THE END POSITION - 5");
-      END;
- 
-      -- DELETE TEST FILE
- 
-      BEGIN
-           DELETE (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2408A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- CE2408B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE TO
- --     PARAMETER IS GREATER THAN THE END POSITION.
- 
- --          2) FILE MODE IS INOUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF DIRECT FILES WITH MODE INOUT_FILE.
- 
- -- HISTORY:
- --     GMT 08/05/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2408B IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-      USE DIR_IO;
- 
-      DIR_FILE   : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE2408B", "FOR FILES OF MODE INOUT_FILE, CHECK THAT " &
-                       "WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE " &
-                       """TO"" PARAMETER IS GREATER THAN THE END " &
-                       "POSITION");
-      BEGIN
-           CREATE (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "MODE INOUT_FILE FOR DIR_IO - 1");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "MODE INOUT_FILE FOR DIR_IO - 2");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE WITH " &
-                        "MODE INOUT_FILE FOR DIR_IO - 3");
-                RAISE INCOMPLETE;
-      END;
- 
-      -- FILL UP FILE
- 
-      WRITE (DIR_FILE, 3);
-      WRITE (DIR_FILE, 4);
-      WRITE (DIR_FILE, 5);
-      WRITE (DIR_FILE, 6);
- 
-      -- WRITE WHERE TO IS LARGER THAN END OF FILE
- 
-      BEGIN
-           WRITE (DIR_FILE, 9, 7);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("WRITE RAISED EXCEPTION WHEN TO " &
-                        "PARAMETER WAS BEYOND END - 4");
-      END;
- 
-      BEGIN
-           SET_INDEX (DIR_FILE, 11);
-           WRITE (DIR_FILE, 10);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("SET_INDEX/WRITE RAISED EXCEPTION WHEN TO " &
-                        "PARAMETER EXCEEDS THE END POSITION - 5");
-      END;
- 
-      -- DELETE TEST FILE
- 
-      BEGIN
-           DELETE (DIR_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2408B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,113 ****
- -- CE2409A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DIRECT ACCESS FILES, CHECK THAT A WRITE TO A POSITION
- --     GREATER THAN THE CURRENT END POSITION CAUSES THE WRITE
- --     POSITION AND THE FILE SIZE TO BE INCREMENTED.
- 
- --          1) CHECK FILES OF MODE INOUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH INOUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     ABW 08/27/82
- --     SPS 11/09/82
- --     SPS 03/18/83
- --     EG  05/16/85
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 08/05/87  REVISED EXCEPTION HANDLING, ADDED CHECK FOR WRITE
- --                   USING TO, AND MOVED OUT_FILE CASE TO CE2409B.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2409A IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      FILE1      : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2409A", "CHECK THAT WRITE POSITION AND " &
-                       "SIZE ARE INCREMENTED CORRECTLY FOR " &
-                       "DIR FILES OF MODE INOUT_FILE");
- 
-      BEGIN
-           CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR | NAME_ERROR =>
-                NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE NOT " &
-                                "SUPPORTED FOR DIR FILES - 1");
-                RAISE INCOMPLETE;
-      END;
- 
-      DECLARE
-           INT      : INTEGER := IDENT_INT (18);
-           TWO_C    : COUNT := COUNT (IDENT_INT(2));
-           THREE_PC : POSITIVE_COUNT
-                            := POSITIVE_COUNT (IDENT_INT(3));
-           FIVE_C   : COUNT := COUNT (IDENT_INT(5));
-           FIVE_PC  : POSITIVE_COUNT
-                            := POSITIVE_COUNT (IDENT_INT(5));
-           SIX_PC  : POSITIVE_COUNT
-                            := POSITIVE_COUNT (IDENT_INT(6));
-      BEGIN
-           WRITE (FILE1, INT);
-           WRITE (FILE1, INT);
-           IF INDEX (FILE1) /= THREE_PC THEN
-                FAILED ("INCORRECT INDEX VALUE - 1");
-           END IF;
-           IF SIZE (FILE1) /= TWO_C THEN
-                FAILED ("INCORRECT SIZE VALUE - 2");
-           END IF;
- 
-           WRITE (FILE1, INT, FIVE_PC);
-           IF INDEX (FILE1) /= SIX_PC THEN
-                FAILED ("INCORRECT INDEX VALUE - 3");
-           END IF;
-           IF SIZE (FILE1) /= FIVE_C THEN
-                FAILED ("INCORRECT SIZE VALUE - 4");
-           END IF;
-      END;
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT ;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2409A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE2409B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR DIRECT ACCESS FILES, CHECK THAT A WRITE TO A POSITION
- --     GREATER THAN THE CURRENT END POSITION CAUSES THE WRITE
- --     POSITION AND THE FILE SIZE TO BE INCREMENTED.
- 
- --          2) CHECK FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH MODE OUT_FILE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     GMT 08/05/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2409B IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      FILE1      : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2409B", "CHECK THAT WRITE POSITION AND " &
-                       "SIZE ARE INCREMENTED APPROPRIATELY");
-      BEGIN
-           CREATE (FILE1, OUT_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE NOT " &
-                                "SUPPORTED FOR DIR FILES - 1");
-                RAISE INCOMPLETE;
-      END;
- 
-      DECLARE
-           INT      : INTEGER := IDENT_INT (18);
-           TWO_C    : COUNT := COUNT (IDENT_INT(2));
-           THREE_C  : COUNT := COUNT (IDENT_INT(3));
-           THREE_PC : POSITIVE_COUNT
-                            := POSITIVE_COUNT (IDENT_INT(3));
-           FOUR_PC  : POSITIVE_COUNT
-                            := POSITIVE_COUNT (IDENT_INT(4));
-      BEGIN
-           WRITE (FILE1, INT);
-           WRITE (FILE1, INT);
-           IF INDEX (FILE1) /= THREE_PC THEN
-                FAILED ("INCORRECT VALUE FOR INDEX - 2");
-           END IF;
-           IF SIZE (FILE1) /= TWO_C THEN
-                FAILED ("INCORRECT VALUE FOR SIZE - 3");
-           END IF;
- 
-           WRITE (FILE1, INT);
-           IF INDEX (FILE1) /= FOUR_PC THEN
-                FAILED ("INCORRECT VALUE FOR INDEX - 4");
-           END IF;
-           IF SIZE (FILE1) /= THREE_C THEN
-                FAILED ("INCORRECT VALUE FOR SIZE - 5");
-           END IF;
- 
-      END;
- 
-      CLOSE (FILE1);
- 
-      RESULT ;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2409B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- -- CE2410A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN THE CURRENT
- --     MODE IS OUT_FILE.
- 
- --          1) CHECK NON-TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     ABW 08/20/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     EG  11/02/84
- --     EG  05/16/85
- --     GMT 08/05/87  REVISED EXCEPTION HANDLING AND MOVED THE CASE FOR
- --                   TEMPORARY FILES INTO CE2410B.ADA.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2410A IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      FILE1       : FILE_TYPE;
-      INT         : INTEGER := IDENT_INT (18);
-      BOOL        : BOOLEAN;
-      INCOMPLETE  : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2410A", "CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN " &
-                       "THE CURRENT MODE IS OUT_FILE AND THE FILE IS " &
-                       "A NON-TEMPORARY FILE.");
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR | NAME_ERROR =>
-                NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE NOT " &
-                                "SUPPORTED FOR DIRECT FILES - 1");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           BOOL := END_OF_FILE (FILE1);
-           FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 2");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON " &
-                        "END_OF_FILE - 3");
-      END;
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT ;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2410A ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CE2410B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN THE CURRENT
- --     MODE IS OUT_FILE.
- 
- --          2) CHECK TEMPORARY FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE FOR DIRECT FILES.
- 
- -- HISTORY:
- --     GMT 08/05/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH DIRECT_IO;
- 
- PROCEDURE CE2410B IS
- 
-      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
-      USE DIR;
-      FILE1       : FILE_TYPE;
-      INT         : INTEGER := IDENT_INT (18);
-      BOOL        : BOOLEAN;
-      INCOMPLETE  : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE2410B", "CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN " &
-                       "THE CURRENT MODE IS OUT_FILE AND THE FILE IS " &
-                       "A TEMPORARY FILE.");
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE NOT " &
-                                "SUPPORTED FOR DIRECT FILES - 1");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           BOOL := END_OF_FILE (FILE1);
-           FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 2");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED ON " &
-                        "END_OF_FILE - 3");
-      END;
- 
-      CLOSE (FILE1);
- 
-      RESULT ;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE2410B ;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,207 ****
- -- CE2411A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INDEX RETURNS THE CORRECT INDEX POSITION AND THAT
- --     SET_INDEX CORRECTLY SETS THE INDEX POSITION IN A DIRECT FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     DIRECT FILES.
- 
- -- HISTORY:
- --     TBN 10/01/86
- --     JLH 08/07/87  REVISED EXTERNAL FILE NAME, REMOVED CHECK FOR
- --                   NAME_ERROR ON OPEN CALLS, AND REMOVED
- --                   UNNECESSARY CODE.
- 
- WITH DIRECT_IO;
- WITH REPORT; USE REPORT;
- PROCEDURE CE2411A IS
- 
-      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
-      USE DIR_IO;
- 
-      FILE1 : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE2411A", "CHECK THAT INDEX RETURNS THE CORRECT INDEX " &
-                       "POSITION AND THAT SET_INDEX CORRECTLY SETS " &
-                       "THE INDEX POSITION IN A DIRECT FILE");
- 
- 
-      -- INITIALIZE TEST FILE
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED DURING CREATE " &
-                                "WITH OUT_FILE MODE FOR DIR_IO");
-                RAISE INCOMPLETE;
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED DURING CREATE " &
-                                "WITH OUT_FILE MODE FOR DIR_IO");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNKNOWN EXCEPTION RAISED DURING CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           IF INDEX (FILE1) /= 1 THEN
-                FAILED ("STARTING INDEX POSITION IS INCORRECT - 1");
-                RAISE INCOMPLETE;
-           END IF;
-           FOR I IN 1 .. 10 LOOP
-                WRITE (FILE1, I);
-           END LOOP;
-           IF INDEX (FILE1) /= 11 THEN
-                FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 2");
-           END IF;
-           WRITE (FILE1, 20, 20);
-           IF INDEX (FILE1) /= 21 THEN
-                FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 3");
-           END IF;
-           SET_INDEX (FILE1, 11);
-           IF INDEX (FILE1) /= 11 THEN
-                FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - 4");
-           END IF;
-           WRITE (FILE1, 11);
-           IF INDEX (FILE1) /= 12 THEN
-                FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 5");
-           END IF;
-      END;
- 
-      CLOSE (FILE1);
- 
-      BEGIN
-           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED DURING OPEN INFILE " &
-                                "FOR DIR_IO");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNKNOWN EXCEPTION RAISED DURING OPEN INFILE");
-                RAISE INCOMPLETE;
-      END;
- 
-      DECLARE
-           NUM : INTEGER;
-      BEGIN
-           IF INDEX (FILE1) /= 1 THEN
-                FAILED ("STARTING INDEX POSITION IS INCORRECT - 7");
-                RAISE INCOMPLETE;
-           END IF;
-           FOR I IN 1 .. 10 LOOP
-                READ (FILE1, NUM);
-                IF NUM /= I THEN
-                     FAILED ("FILE CONTAINS INCORRECT DATA - 8");
-                END IF;
-                IF INDEX (FILE1) /= POSITIVE_COUNT(I + 1) THEN
-                     FAILED ("INDEX DOES NOT RETURN THE CORRECT " &
-                             "POSITION - 9");
-                END IF;
-           END LOOP;
-           SET_INDEX (FILE1, 20);
-           IF INDEX (FILE1) /= 20 THEN
-                FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
-                        "10");
-           END IF;
-           READ (FILE1, NUM, 20);
-           IF NUM /= 20 THEN
-                FAILED ("FILE CONTAINS INCORRECT DATA - 11");
-           END IF;
-           IF INDEX (FILE1) /= 21 THEN
-                FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 12");
-           END IF;
-           SET_INDEX (FILE1, 1);
-           IF INDEX (FILE1) /= 1 THEN
-                FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
-                        "13");
-           END IF;
-      END;
- 
-      CLOSE (FILE1);
- 
-      BEGIN
-           OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED DURING OPEN " &
-                                "INOUT_FILE FOR DIR_IO");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNKNOWN EXCEPTION RAISED DURING OPEN INOUT");
-                RAISE INCOMPLETE;
-      END;
- 
-      DECLARE
-           NUM : INTEGER;
-      BEGIN
-           IF INDEX (FILE1) /= 1 THEN
-                FAILED ("STARTING INDEX POSITION IS INCORRECT - 15");
-                RAISE INCOMPLETE;
-           END IF;
-           FOR I IN 1 .. 10 LOOP
-                READ (FILE1, NUM);
-                IF NUM /= I THEN
-                     FAILED ("FILE CONTAINS INCORRECT DATA - 16");
-                END IF;
-                IF INDEX (FILE1) /= POSITIVE_COUNT(I + 1) THEN
-                     FAILED ("INDEX DOES NOT RETURN THE CORRECT " &
-                             "POSITION - 17");
-                END IF;
-           END LOOP;
-           SET_INDEX (FILE1, 20);
-           IF INDEX (FILE1) /= 20 THEN
-                FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
-                        "18");
-           END IF;
-           WRITE (FILE1, 12, 12);
-           IF INDEX (FILE1) /= 13 THEN
-                FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 19");
-           END IF;
-           SET_INDEX (FILE1, 1);
-           IF INDEX (FILE1) /= 1 THEN
-                FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
-                        "20");
-           END IF;
-      END;
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE2411A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CE3002B.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT COUNT IS A VISIBLE TYPE, THAT COUNT'FIRST IS 0,
- --     THAT POSITIVE_COUNT IS A SUBTYPE OF COUNT, THAT
- --     POSITIVE_COUNT'FIRST IS 1, THAT POSITIVE_COUNT'LAST
- --     EQUALS COUNT'LAST, AND COUNT'LAST HAS A SPECIFIED
- --     IMPLEMENTATION-DEPENDENT VALUE.
- 
- -- HISTORY:
- --     SPS 09/30/82
- --     SPS 11/09/82
- --     JBG 03/16/83
- --     JLH 08/07/87  REVISED VALUES USED IN COUNT AND POSITIVE_COUNT
- --                   TO THE INTEGER VALUE 1.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3002B IS
- BEGIN
- 
-      TEST ("CE3002B", "CHECK THAT COUNT IS VISIBLE, COUNT'FIRST IS " &
-                       "0, POSITIVE_COUNT IS A SUBTYPE OF COUNT, " &
-                       "POSITIVE_COUNT'FIRST IS 1, POSITIVE_COUNT'" &
-                       "LAST EQUALS COUNT'LAST, AND COUNT'LAST " &
-                       "HAS A SPECIFIED VALUE");
- 
-      DECLARE
-           X : COUNT;
-           A : POSITIVE_COUNT;
-      BEGIN
-           IF COUNT'FIRST /= COUNT(IDENT_INT (0)) THEN
-                FAILED ("COUNT'FIRST NOT 0; IS" &
-                        COUNT'IMAGE(COUNT'FIRST));
-           END IF;
- 
-           IF POSITIVE_COUNT'FIRST /= POSITIVE_COUNT (IDENT_INT (1)) THEN
-                FAILED ("POSITIVE_COUNT'FIRST NOT 1; IS" &
-                        COUNT'IMAGE(POSITIVE_COUNT'FIRST));
-           END IF;
- 
-           IF POSITIVE_COUNT'LAST /= COUNT'LAST THEN
-                FAILED ("POSITIVE_COUNT'LAST NOT EQUAL COUNT'LAST");
-           END IF;
- 
-           IF COUNT'LAST /= $COUNT_LAST THEN
-                FAILED ("COUNT'LAST NOT $COUNT_LAST; IS" &
-                        COUNT'IMAGE(COUNT'LAST));
-           END IF;
- 
-           X := POSITIVE_COUNT (IDENT_INT (1));
-           A := X;
-           A := COUNT (IDENT_INT (1));
-           X := A;
-      END;
- 
-      RESULT;
- 
- END CE3002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- CE3002C.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIELD IS A SUBTYPE OF INTEGER, FIELD'FIRST = 0, AND
- --     FIELD'LAST HAS A SPECIFIED IMPLEMENTATION-DEPENDENT VALUE.
- 
- -- HISTORY:
- --     SPS 09/30/82
- --     SPS 11/09/82
- --     JBG 03/16/83
- --     JLH 08/07/87  REVISED VALUES USED IN INTEGER AND FIELD TO THE
- --                   INTEGER VALUE 1.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3002C IS
- BEGIN
- 
-      TEST ("CE3002C", "CHECK THAT FIELD IS A SUBTYPE OF INTEGER AND " &
-                       "FIELD'FIRST = 0");
- 
-      DECLARE
-           A : INTEGER;
-           B : FIELD;
-      BEGIN
-           IF FIELD'FIRST /= IDENT_INT (0) THEN
-                FAILED ("FIELD'FIRST NOT 0; IS" &
-                        FIELD'IMAGE(FIELD'FIRST));
-           END IF;
- 
-           IF FIELD'LAST /= $FIELD_LAST THEN
-                FAILED ("FIELD'LAST NOT $FIELD_LAST; IS" &
-                        FIELD'IMAGE(FIELD'LAST));
-           END IF;
- 
-           A := IDENT_INT (1);
-           B := A;
-           B := IDENT_INT (1);
-           A := B;
-      END;
- 
-      RESULT;
- 
- END CE3002C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- CE3002D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT NUMBER_BASE IS A SUBTYPE OF INTEGER, WITH
- -- NUMBER_BASE'FIRST EQUAL 2 AND NUMBER_BASE'LAST EQUAL 16.
- 
- -- SPS 10/1/82
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3002D IS
- BEGIN
- 
-      TEST ("CE3002D", "CHECK THAT NUMBER_BASE IS A SUBTYPE " &
-                       "OF INTEGER WITH NUMBER_BASE'FIRST = 2 " &
-                       "AND NUMBER_BASE'LAST = 16");
- 
-      DECLARE
-           X : INTEGER;
-           Y : NUMBER_BASE;
-      BEGIN
-           IF NUMBER_BASE'FIRST /= IDENT_INT (2) THEN
-                FAILED ("NUMBER_BASE'FIRST NOT 2");
-           END IF;
- 
-           IF NUMBER_BASE'LAST /= IDENT_INT (16) THEN
-                FAILED ("NUMBER_BASE'LAST NOT 16");
-           END IF;
- 
-           X := IDENT_INT (3);
-           Y := X;
-           Y := IDENT_INT (8);
-           X := Y;
-      END;
- 
- RESULT;
- END CE3002D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- CE3002F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT UNBOUNDED HAS TYPE COUNT AND VALUE ZERO.
- 
- -- SPS 10/1/82
- -- SPS 11/9/82
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3002F IS
- BEGIN
- 
-      TEST ("CE3002F", "CHECK THAT UNBOUNDED HAS TYPE COUNT AND " &
-                       "VALUE ZERO");
- 
-      DECLARE
-           Z : COUNT := 0;
-      BEGIN
-           IF UNBOUNDED /= COUNT(IDENT_INT(0)) THEN
-                FAILED ("UNBOUNDED NOT 0");
-           END IF;
- 
-           IF UNBOUNDED /= Z THEN
-                FAILED ("UNBOUNDED NOT COUNT");
-           END IF;
-      END;
- 
-      RESULT;
- 
- END CE3002F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,151 ****
- -- CE3102A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT STATUS_ERROR IS RAISED BY CREATE AND OPEN
- --     IF THE GIVEN TEXT FILES ARE ALREADY OPEN.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH MODE OUT_FILE FOR TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/24/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     JBG 07/25/83
- --     JLH 08/07/87  COMPLETE REVISION OF TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3102A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3102A" , "CHECK THAT STATUS_ERROR IS RAISED " &
-                        "APPROPRIATELY FOR TEXT FILES");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 1");
-      END;
- 
-      BEGIN
-           CREATE (FILE, IN_FILE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 2");
-      END;
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 3");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 3");
-      END;
- 
-      BEGIN
-           OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 1");
-      END;
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 2");
-      END;
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME (2, "CE3102A"));
-           FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 3");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 3");
-      END;
- 
-      BEGIN
-           CREATE (FILE, IN_FILE, LEGAL_FILE_NAME (2, "CE3102A"));
-           FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 4");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 4");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3102A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,184 ****
- -- CE3102B.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FOR TEXT FILES NAME_ERROR IS RAISED BY CREATE AND
- --     OPEN IF THE GIVEN NAME STRING DOES NOT ALLOW THE IDENTIFICATION
- --     OF AN EXTERNAL FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE FOR TEXT_IO.
- 
- -- HISTORY:
- --     ABW 08/24/82
- --     JBG 03/16/83
- --     EG  05/30/85
- --     JLH 08/12/87  REMOVED UNNECESSARY CODE, ADDED NEW CASES FOR OPEN,
- --                   AND REMOVED DEPENDENCE ON DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3102B IS
- 
-      FILE1, FILE2 : FILE_TYPE;
-      FILE_NAME_OK : BOOLEAN := FALSE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3102B", "CHECK THAT NAME_ERROR IS RAISED " &
-                       "APPROPRIATELY");
- 
-      -- CHECK THAT A LEGAL FILE NAME IS OK SO TEST IS VALID
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                "OF ASSUMED VALID FILE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                "OF ASSUMED VALID FILE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           DELETE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("FILE STILL EXISTS AFTER DELETE");
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                             "IN_FILE MODE");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT OPEN");
-           END;
- 
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      -- PERFORM VARIOUS CHECKS
- 
-      BEGIN
-           OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2));
-           FAILED ("NO EXCEPTION FOR NON-EXISTENT FILE - IN_FILE");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR OPEN OF " &
-                        "NON-EXISTENT FILE - IN_FILE");
-      END;
- 
-      BEGIN
-           OPEN (FILE2, OUT_FILE, LEGAL_FILE_NAME(3));
-           FAILED ("NO EXCEPTION FOR NON-EXISTENT FILE - OUT_FILE");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR OPEN FOR " &
-                        "NON-EXISTENT FILE - OUT_FILE");
-      END;
- 
-      BEGIN
-           CREATE (FILE1, NAME => "$ILLEGAL_EXTERNAL_FILE_NAME1");
-           FAILED ("NO EXCEPTION RAISED FOR " &
-                   "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE");
-           WHEN NAME_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE");
-      END;
- 
-      BEGIN
-           CREATE (FILE2, NAME => "$ILLEGAL_EXTERNAL_FILE_NAME2");
-           FAILED ("NO EXCEPTION RAISED FOR " &
-                   "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE");
-           WHEN NAME_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE");
-      END;
- 
-      BEGIN
-           OPEN (FILE2, IN_FILE,
-                 NAME => "$ILLEGAL_EXTERNAL_FILE_NAME1");
-           FAILED ("NO EXCEPTION RAISED FOR " &
-                   "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                FAILED ("USE ERROR RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN");
-           WHEN NAME_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN");
-      END;
- 
-      BEGIN
-           OPEN (FILE1, IN_FILE,
-                 NAME => "$ILLEGAL_EXTERNAL_FILE_NAME2");
-           FAILED ("NO EXCEPTION RAISED FOR " &
-                   "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN");
-           WHEN NAME_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR " &
-                        "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
- 
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3102B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- CE3102D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT STATUS_ERROR IS RAISED BY CLOSE, DELETE, RESET, MODE,
- --     NAME, AND FORM IF THE GIVEN TEXT FILES ARE NOT OPEN.
- 
- -- HISTORY:
- --     JLH 08/10/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3102D IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      FT : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3102D" , "CHECK THAT STATUS_ERROR IS RAISED " &
-                        "APPROPRIATELY FOR TEXT FILES");
- 
-      BEGIN
-           CREATE (FT);
-           CLOSE (FT);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR CREATE");
-      END;
- 
-      BEGIN
-           RESET (FT);
-           FAILED ("STATUS_ERROR NOT RAISED FOR RESET");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR RESET OF CLOSED FILE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR RESET");
-      END;
- 
-      BEGIN
-           DECLARE
-                MD : FILE_MODE := MODE (FT);
-           BEGIN
-                FAILED ("STATUS_ERROR NOT RAISED FOR MODE");
-           END;
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR MODE OF CLOSED FILE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR MODE");
-      END;
- 
-      BEGIN
-           DECLARE
-                NM : CONSTANT STRING := NAME (FT);
-           BEGIN
-                FAILED ("STATUS_ERROR NOT RAISED FOR NAME");
-           END;
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR NAME OF CLOSED FILE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR NAME");
-      END;
- 
-      BEGIN
-           DECLARE
-                FM : CONSTANT STRING := FORM (FT);
-           BEGIN
-                FAILED ("STATUS_ERROR NOT RAISED FOR FORM");
-           END;
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR FORM OF CLOSED FILE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR FORM");
-      END;
- 
-      BEGIN
-           CLOSE (FT);
-           FAILED ("STATUS_ERROR NOT RAISED FOR CLOSE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED WHEN CLOSING CLOSED FILE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR CLOSE");
-      END;
- 
-      BEGIN
-           DELETE (FT);
-           FAILED ("STATUS_ERROR NOT RAISED FOR DELETE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN USE_ERROR =>
-                FAILED ("USE_ERROR RAISED FOR DELETE OF CLOSED FILE");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR DELETE");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3102D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- CE3102E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
- --     IMPLEMENTATION FOR TEXT FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT IN_FILE MODE WITH CREATE FOR TEXT FILES.
- 
- -- HISTORY:
- --     JLH 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3102E IS
- 
-      FILE1 : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3102E", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF CREATE FOR TEXT FILES");
- 
-      BEGIN
-           CREATE (FILE1, IN_FILE);
-           CLOSE (FILE1);
-           NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-      END;
- 
-      RESULT;
- 
- END CE3102E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- CE3102F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN AN EXTERNAL FILE
- --     CANNOT BE RESET.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES, BUT DO NOT SUPPORT RESET OF EXTERNAL FILES.
- 
- -- HISTORY:
- --     JLH 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3102F IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3102F", "CHECK THAT USE_ERROR IS RAISED WHEN AN " &
-                       "EXTERNAL FILE CANNOT BE RESET");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE);
-           NOT_APPLICABLE ("RESET FOR OUT_FILE MODE ALLOWED - 1");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 1");
-      END;
- 
-      PUT (FILE, "HELLO");
- 
-      BEGIN
-           RESET (FILE, IN_FILE);
-           NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE MODE " &
-                           "ALLOWED - 1");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RASIED FOR RESET - 2");
-      END;
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("TEXT_IO NOT SUPPORTED FOR IN_FILE " &
-                                "OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE);
-           NOT_APPLICABLE ("RESET FOR IN_FILE MODE ALLOWED - 2");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 3");
-      END;
- 
-      BEGIN
-           RESET (FILE, OUT_FILE);
-           NOT_APPLICABLE ("RESET FROM IN_FILE TO OUT_FILE MODE " &
-                           "ALLOWED - 2");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 4");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3102F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,84 ****
- -- CE3102G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN AN EXTERNAL FILE
- --     CANNOT BE DELETED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES, BUT DO NOT SUPPORT DELETION OF EXTERNAL FILES.
- 
- -- HISTORY:
- --     JLH 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3102G IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      VAR1 : CHARACTER := 'A';
- 
- BEGIN
- 
-      TEST ("CE3102G" , "CHECK THAT USE_ERROR IS RAISED WHEN AN " &
-                        "EXTERNAL FILE CANNOT BE DELETED");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                NOT_APPLICABLE ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, VAR1);
- 
-      BEGIN
-           DELETE (FILE);
-           NOT_APPLICABLE ("DELETION OF EXTERNAL FILES ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR DELETE");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3102G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,116 ****
- -- CE3102H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT MODE_ERROR IS RAISED WHEN ATTEMPTING TO CHANGE
- --     THE MODE OF A FILE SERVING AS THE CURRENT DEFAULT INPUT
- --     OR DEFAULT OUTPUT FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3102H IS
- 
-      FILE1 : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
-      ITEM : CHARACTER := 'A';
- 
- BEGIN
- 
-      TEST ("CE3102H", "CHECK THAT MODE_ERROR IS RAISED WHEN " &
-                       "ATTEMPTING TO CHANGE THE MODE OF A FILE " &
-                       "SERVING AS THE CURRENT DEFAULT INPUT OR " &
-                       "DEFAULT OUTPUT FILE");
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_OUTPUT (FILE1);
- 
-      BEGIN
-           RESET (FILE1, IN_FILE);
-           FAILED ("MODE_ERROR NOT RAISED FOR RESET");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET");
-      END;
- 
-      SET_OUTPUT (STANDARD_OUTPUT);
- 
-      PUT (FILE1, ITEM);
-      CLOSE (FILE1);
- 
-      BEGIN
-           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_INPUT (FILE1);
- 
-      BEGIN
-           RESET (FILE1, OUT_FILE);
-           FAILED ("MODE_ERROR NOT RAISED FOR RESET");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET");
-      END;
- 
-      SET_INPUT (STANDARD_INPUT);
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3102H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- CE3102I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
- --     IMPLEMENTATION FOR TEXT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OUT_FILE FOR CREATE FOR TEXT_IO.
- 
- -- HISTORY:
- --     JLH 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3102I IS
- 
-      FILE1 : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3102I", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF CREATE FOR TEXT_IO");
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE);
-           CLOSE (FILE1);
-           NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED");
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-      END;
- 
-      RESULT;
- 
- END CE3102I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE3102J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
- --     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
- --     IMPLEMENTATION FOR TEXT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT IN_FILE MODE FOR OPEN FOR TEXT_IO.
- 
- -- HISTORY:
- --     JLH 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3102J IS
- 
-      FILE1 : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
-      RAISED_USE_ERROR : BOOLEAN := FALSE;
-      VAR1 : CHARACTER := 'A';
- 
- BEGIN
- 
-      TEST ("CE3102J", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF OPEN FOR TEXT_IO");
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-           END;
- 
-           IF IS_OPEN (FILE1) THEN
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3102J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- CE3102K.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
- --     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
- --     IMPLEMENTATION FOR TEXT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
- --     SUPPORT OUT_FILE MODE FOR OPEN FOR TEXT_IO.
- 
- -- HISTORY:
- --     JLH 08/12/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3102K IS
- 
-      FILE1 : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
-      RAISED_USE_ERROR : BOOLEAN := FALSE;
-      VAR1 : CHARACTER := 'A';
- 
- BEGIN
- 
-      TEST ("CE3102K", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
-                       "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
-                       "OF OPEN FOR TEXT_IO");
-      BEGIN
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE1, VAR1);
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-                NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED");
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-           END;
- 
-           IF IS_OPEN (FILE1) THEN
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3102K;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,216 ****
- -- CE3103A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE PAGE AND LINE LENGTH OF TEXT FILES ARE ZERO
- --     AFTER A CREATE, OPEN, OR RESET TO OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILE.
- 
- -- HISTORY:
- --     ABW 08/24/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     SPS 01/18/83
- --     EG  11/02/84
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/13/87  REVISED TEST TO INCLUDE CASES TO RESET THE FILE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3103A IS
- 
-      SUBTEST : EXCEPTION;
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      ZERO : CONSTANT COUNT := COUNT(IDENT_INT(0));
-      TWO  : CONSTANT COUNT := COUNT (IDENT_INT(2));
-      FIVE : CONSTANT COUNT := COUNT (IDENT_INT(5));
- 
- BEGIN
- 
-      TEST ("CE3103A" , "CHECK THAT PAGE AND LINE LENGTH " &
-                        "ARE SET TO ZERO AFTER CREATE, " &
-                        "OPEN, OR RESET");
- 
- BEGIN
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF LINE_LENGTH (FILE) /= ZERO THEN
-           FAILED ("LINE_LENGTH FOR CREATE IS NOT ZERO");
-      END IF;
-      IF PAGE_LENGTH (FILE) /= ZERO THEN
-           FAILED ("PAGE_LENGTH FOR CREATE IS NOT ZERO");
-      END IF;
- 
-      SET_LINE_LENGTH (FILE, TWO);
-      SET_PAGE_LENGTH (FILE, FIVE);
- 
-      PUT_LINE (FILE, "HI");
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF LINE_LENGTH (FILE) /= ZERO THEN
-           FAILED ("LINE_LENGTH FOR OPEN IS NOT ZERO");
-      END IF;
-      IF PAGE_LENGTH (FILE) /= ZERO THEN
-           FAILED ("PAGE_LENGTH FOR OPEN IS NOT ZERO");
-      END IF;
- 
-      SET_LINE_LENGTH (FILE, TWO);
-      SET_PAGE_LENGTH (FILE, TWO);
- 
-      PUT_LINE (FILE, "HI");
- 
-      BEGIN
-           BEGIN
-                RESET (FILE, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     RAISE SUBTEST;
-           END;
- 
-           IF LINE_LENGTH (FILE) /= ZERO THEN
-                FAILED ("LINE_LENGTH FOR RESET TO OUT_FILE IS NOT " &
-                        "ZERO - 1");
-           END IF;
-           IF PAGE_LENGTH (FILE) /= ZERO THEN
-                FAILED ("PAGE_LENGTH FOR RESET TO OUT_FILE IS NOT " &
-                        "ZERO - 1");
-           END IF;
-      EXCEPTION
-           WHEN SUBTEST =>
-                NULL;
-      END;
- 
-      SET_LINE_LENGTH (FILE, FIVE);
-      SET_PAGE_LENGTH (FILE, FIVE);
- 
-      PUT_LINE (FILE, "HELLO");
- 
-      IF LINE_LENGTH (FILE) /= 5 THEN
-           FAILED ("LINE_LENGTH FOR RESET IN OUT_FILE, PLUS HELLO " &
-                   "IS NOT FIVE");
-      END IF;
-      IF PAGE_LENGTH (FILE) /= 5 THEN
-           FAILED ("PAGE_LENGTH FOR RESET IN OUT_FILE, PLUS HELLO " &
-                   "IS NOT FIVE");
-      END IF;
- 
-      BEGIN
-           BEGIN
-                RESET (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     RAISE SUBTEST;
-           END;
- 
-           IF LINE_LENGTH (FILE) /= ZERO THEN
-                FAILED ("LINE_LENGTH FOR RESET IS NOT ZERO");
-           END IF;
-           IF PAGE_LENGTH (FILE) /= ZERO THEN
-                FAILED ("PAGE_LENGTH FOR RESET IS NOT ZERO");
-           END IF;
-      EXCEPTION
-           WHEN SUBTEST =>
-                NULL;
-      END;
- 
-      SET_LINE_LENGTH (FILE, FIVE);
-      SET_PAGE_LENGTH (FILE, FIVE);
- 
-      PUT_LINE (FILE, "HELLO");
- 
-      IF LINE_LENGTH (FILE) /= 5 THEN
-           FAILED ("LINE_LENGTH FOR RESET PLUS HELLO");
-      END IF;
-      IF PAGE_LENGTH (FILE) /= 5 THEN
-           FAILED ("PAGE_LENGTH FOR RESET PLUS HELLO");
-      END IF;
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE, OUT_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                RAISE INCOMPLETE;
-      END;
- 
-      IF LINE_LENGTH (FILE) /= ZERO THEN
-           FAILED ("LINE_LENGTH FOR RESET TO OUT_FILE IS NOT ZERO - 2");
-      END IF;
-      IF PAGE_LENGTH (FILE) /= ZERO THEN
-           FAILED ("PAGE_LENGTH FOR RESET TO OUT_FILE IS NOT ZERO - 2");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           NULL;
- END;
- 
- RESULT;
- 
- END CE3103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,231 ****
- -- CE3104A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE CURRENT COLUMN, LINE, AND PAGE NUMBERS OF
- --     TEXT FILES ARE SET TO ONE AFTER A CREATE, OPEN, OR RESET.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/24/82
- --     SPS 09/16/82
- --     SPS 11/09/82
- --     JBG 03/16/83
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/13/87  CHANGED FAILED MESSAGES AND ADDED SUBTEST
- --                   EXCEPTION.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3104A IS
- 
-      INCOMPLETE, SUBTEST : EXCEPTION;
-      FILE, FT : FILE_TYPE;
-      ONE      : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
-      CHAR     : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3104A" , "CHECK THAT COLUMN, LINE, AND " &
-                        "PAGE NUMBERS ARE ONE AFTER A " &
-                        "CREATE, OPEN, OR RESET");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE " &
-                        "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF COL (FILE) /= ONE THEN
-           FAILED ("INCORRECT RESULTS FROM COLUMN AFTER CREATE");
-      END IF;
-      IF LINE (FILE) /= ONE THEN
-           FAILED ("INCORRECT RESULTS FROM LINE AFTER CREATE");
-      END IF;
-      IF PAGE (FILE) /= ONE THEN
-           FAILED ("INCORRECT RESULTS FROM PAGE AFTER CREATE");
-      END IF;
- 
-      NEW_PAGE (FILE);
-      NEW_LINE (FILE);
-      PUT (FILE, "STRING");
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     RAISE SUBTEST;
-           END;
- 
-           IF COL (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM COLUMN AFTER " &
-                        "OPEN - IN_FILE");
-           END IF;
-           IF LINE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM LINE AFTER " &
-                        "OPEN - IN_FILE");
-           END IF;
-           IF PAGE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM PAGE AFTER " &
-                        "OPEN - IN_FILE");
-           END IF;
- 
-           GET (FILE, CHAR);   -- SETS PAGE, LINE, AND COL /= 1
- 
-           BEGIN
-                RESET (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     CLOSE (FILE);
-                     RAISE SUBTEST;
-           END;
- 
-           IF COL (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM COLUMN AFTER RESET");
-           END IF;
-           IF LINE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM LINE AFTER RESET");
-           END IF;
-           IF PAGE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM PAGE AFTER RESET");
-           END IF;
- 
-           GET (FILE, CHAR);   -- CHANGES LINE, PAGE, COL; STILL IN_FILE
- 
-           BEGIN
-                RESET (FILE,OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     CLOSE (FILE);
-                     RAISE SUBTEST;
-           END;
- 
-           IF COL (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM COLUMN AFTER RESET " &
-                        "TO OUT_FILE");
-           END IF;
-           IF LINE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM LINE AFTER RESET " &
-                        "TO OUT_FILE");
-           END IF;
-           IF PAGE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM PAGE AFTER RESET " &
-                        "TO OUT_FILE");
-           END IF;
- 
-           CLOSE (FILE);
- 
-      EXCEPTION
-           WHEN SUBTEST =>
-                NULL;
-      END;
- 
-      BEGIN
-           BEGIN
-                OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     RAISE SUBTEST;
-           END;
- 
-           IF COL (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM COLUMN AFTER OPEN " &
-                        "TO OUT_FILE");
-           END IF;
-           IF LINE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM LINE AFTER OPEN " &
-                        "TO OUT_FILE");
-           END IF;
-           IF PAGE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM PAGE AFTER OPEN " &
-                        "TO OUT_FILE");
-           END IF;
- 
-      EXCEPTION
-           WHEN SUBTEST =>
-                NULL;
-      END;
- 
-      BEGIN
-           BEGIN
-                CREATE (FT, IN_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     RAISE SUBTEST;
-           END;
- 
-           IF COL (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM COLUMN AFTER CREATE " &
-                        "IN IN_FILE");
-           END IF;
-           IF LINE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM LINE AFTER CREATE " &
-                        "IN IN_FILE");
-           END IF;
-           IF PAGE (FILE) /= ONE THEN
-                FAILED ("INCORRECT RESULTS FROM PAGE AFTER CREATE " &
-                        "IN IN_FILE");
-           END IF;
- 
-           CLOSE (FT);
- 
-      EXCEPTION
-           WHEN SUBTEST =>
-                NULL;
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE3104A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,120 ****
- -- CE3104B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FILE REMAINS OPEN AFTER A RESET.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     DWC 08/13/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3104B IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE   : FILE_TYPE;
-      ITEM1  : STRING (1..5) := "STUFF";
- 
- BEGIN
- 
-      TEST ("CE3104B", "CHECK THAT THE FILE REMAINS OPEN AFTER " &
-                       "A RESET");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           PUT_LINE (FILE, ITEM1);
-           CLOSE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR | NAME_ERROR =>
-                NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE " &
-                                "NOT SUPPORTED");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
-                        "FILE I/O");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT " &
-                                "SUPPORTED");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (FILE) THEN
-           CLOSE (FILE);
-      ELSE
-           FAILED ("RESET FOR IN_FILE, CLOSED FILE");
-      END IF;
- 
-      BEGIN
-           OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " &
-                                "SUPPORTED");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      IF IS_OPEN (FILE) THEN
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
-      ELSE
-           FAILED ("RESET FOR OUT_FILE CLOSED FILE");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE3104B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CE3104C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE MODE PARAMETER IN RESET CHANGES THE MODE OF A
- --     GIVEN FILE, AND IF NO MODE IS SUPPLIED, THE MODE IS LEFT AS IT
- --     WAS BEFORE THE RESET.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     RESET FOR TEXT FILES.
- 
- -- HISTORY:
- --     DWC 08/17/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3104C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE   : FILE_TYPE;
-      ITEM1  : STRING (1..5) := "STUFF";
-      ITEM2  : STRING (1..5);
-      LENGTH : NATURAL;
- 
- BEGIN
- 
-      TEST ("CE3104C", "CHECK THAT THE FILE REMAINS OPEN AFTER " &
-                       "A RESET");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           PUT_LINE (FILE, ITEM1);
-      EXCEPTION
-           WHEN USE_ERROR | NAME_ERROR =>
-                NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE NOT " &
-                                "SUPPORTED");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
-                        "FILE I/O");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE);
-           IF MODE (FILE) /= OUT_FILE THEN
-                FAILED ("RESET CHANGED MODE OF OUT_FILE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET FOR OUT_FILE MODE NOT " &
-                                "SUPPORTED FOR TEXT FILES");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE, IN_FILE);
-           IF MODE (FILE) /= IN_FILE THEN
-                FAILED ("RESET MODE TO IN_FILE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE " &
-                                "NOT SUPPORTED FOR TEXT FILES");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           RESET (FILE);
-           IF MODE (FILE) /= IN_FILE THEN
-                FAILED ("RESET CHANGED MODE OF IN_FILE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("RESET OF IN_FILE MODE NOT SUPPORTED " &
-                                "FOR TEXT FILES");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE3104C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,226 ****
- -- CE3106A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CLOSING A FILE HAS THE FOLLOWING EFFECT:
- --          1) IF THERE IS NO LINE TERMINATOR, A LINE TERMINATOR, PAGE
- --             TERMINATOR, AND FILE TERMINATOR ARE WRITTEN AT THE END
- --             OF THE FILE.
- --          2) IF THERE IS A LINE TERMINATOR BUT NO PAGE TERMINATOR, A
- --             PAGE TERMINATOR AND A FILE TERMINATOR ARE WRITTEN.
- --          3) IF THERE IS A PAGE TERMINATOR, A FILE TERMINATOR IS
- --             WRITTEN.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/08/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3106A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE1, FILE2, FILE3 : FILE_TYPE;
-      ITEM : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3106A", "CHECK THAT CLOSING A FILE HAS THE CORRECT " &
-                       "EFFECT ON THE FILE CONCERNING LINE, PAGE, " &
-                       "AND FILE TERMINATORS");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE" &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE1, 'A');
-           NEW_LINE (FILE1);
-           PUT (FILE1, 'B');
- 
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH MODE IN_FILE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE1, ITEM);
- 
-           IF LINE (FILE1) /= 1 THEN
-                FAILED ("INCORRECT LINE NUMBER - 1");
-           END IF;
- 
-           GET (FILE1, ITEM);
-           IF ITEM /= 'B' THEN
-                FAILED ("INCORRECT VALUE READ - 1");
-           END IF;
- 
-           IF LINE (FILE1) /= 2 THEN
-                FAILED ("INCORRECT LINE NUMBER - 2");
-           END IF;
- 
-           IF NOT END_OF_LINE (FILE1) THEN
-                FAILED ("LINE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS CLOSED");
-           END IF;
- 
-           IF NOT END_OF_PAGE (FILE1) THEN
-                FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS CLOSED");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE1) THEN
-                FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS CLOSED");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2));
-           PUT (FILE2, 'A');
-           NEW_LINE (FILE2);
-           PUT (FILE2, 'B');
-           NEW_PAGE (FILE2);
-           PUT (FILE2, 'C');
-           NEW_LINE (FILE2);
- 
-           CLOSE (FILE2);
- 
-           OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           GET (FILE2, ITEM);
- 
-           GET (FILE2, ITEM);
-           IF ITEM /= 'B' THEN
-                FAILED ("INCORRECT VALUE READ - 2");
-           END IF;
- 
-           IF LINE (FILE2) /= 2 THEN
-                FAILED ("INCORRECT LINE NUMBER - 3");
-           END IF;
- 
-           GET (FILE2, ITEM);
- 
-           IF LINE (FILE2) /= 1 THEN
-                FAILED ("INCORRECT LINE NUMBER - 4");
-           END IF;
- 
-           IF PAGE (FILE2) /= 2 THEN
-                FAILED ("INCORRECT PAGE NUMBER - 1");
-           END IF;
- 
-           IF NOT END_OF_PAGE (FILE2) THEN
-                FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS CLOSED - 2");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE2) THEN
-                FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS CLOSED - 2");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           CREATE (FILE3, OUT_FILE, LEGAL_FILE_NAME(3));
-           PUT (FILE3, 'A');
-           NEW_PAGE (FILE3);
-           PUT (FILE3, 'B');
-           NEW_PAGE (FILE3);
-           NEW_LINE (FILE3);
-           PUT (FILE3, 'C');
-           NEW_PAGE (FILE3);
- 
-           CLOSE (FILE3);
- 
-           OPEN (FILE3, IN_FILE, LEGAL_FILE_NAME(3));
- 
-           GET (FILE3, ITEM);
- 
-           GET (FILE3, ITEM);
-           IF ITEM /= 'B' THEN
-                FAILED ("INCORRECT VALUE READ - 3");
-           END IF;
- 
-           GET (FILE3, ITEM);
- 
-           IF LINE (FILE3) /= 2 THEN
-                FAILED ("INCORRECT LINE NUMBER - 5");
-           END IF;
- 
-           IF PAGE (FILE3) /= 3 THEN
-                FAILED ("INCORRECT PAGE NUMBER - 2");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE3) THEN
-                FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS CLOSED - 3");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE3);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3106A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,220 ****
- -- CE3106B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT RESETTING AN OUT_FILE TO AN IN_FILE HAS THE FOLLOWING
- --     EFFECT:
- --          1) IF THERE IS NO LINE TERMINATOR, A LINE TERMINATOR, PAGE
- --             TERMINATOR, AND FILE TERMINATOR ARE WRITTEN AT THE END
- --             OF THE FILE.
- --          2) IF THERE IS A LINE TERMINATOR BUT NO PAGE TERMINATOR, A
- --             PAGE TERMINATOR AND A FILE TERMINATOR ARE WRITTEN.
- --          3) IF THERE IS A PAGE TERMINATOR, A FILE TERMINATOR IS
- --             WRITTEN.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/08/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3106B IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE1, FILE2, FILE3 : FILE_TYPE;
-      ITEM : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3106B", "CHECK THAT RESETTING AN OUT_FILE TO AN " &
-                       "IN_FILE HAS THE CORRECT EFFECT ON THE " &
-                       "FILE CONCERNING LINE, PAGE, AND FILE " &
-                       "TERMINATORS");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE" &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE1, 'A');
-           NEW_LINE (FILE1);
-           PUT (FILE1, 'B');
- 
-           BEGIN
-                RESET (FILE1, IN_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON FILE RESET " &
-                                     "FROM OUT_FILE TO IN_FILE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE1, ITEM);
- 
-           IF LINE (FILE1) /= 1 THEN
-                FAILED ("INCORRECT LINE NUMBER - 1");
-           END IF;
- 
-           GET (FILE1, ITEM);
-           IF ITEM /= 'B' THEN
-                FAILED ("INCORRECT VALUE READ - 1");
-           END IF;
- 
-           IF LINE (FILE1) /= 2 THEN
-                FAILED ("INCORRECT LINE NUMBER - 2");
-           END IF;
- 
-           IF NOT END_OF_LINE (FILE1) THEN
-                FAILED ("LINE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS RESET");
-           END IF;
- 
-           IF NOT END_OF_PAGE (FILE1) THEN
-                FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS RESET");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE1) THEN
-                FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS RESET");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2));
-           PUT (FILE2, 'A');
-           NEW_LINE (FILE2);
-           PUT (FILE2, 'B');
-           NEW_PAGE (FILE2);
-           PUT (FILE2, 'C');
-           NEW_LINE (FILE2);
- 
-           RESET (FILE2, IN_FILE);
- 
-           GET (FILE2, ITEM);
-           GET (FILE2, ITEM);
- 
-           IF LINE (FILE2) /= 2 THEN
-                FAILED ("INCORRECT LINE NUMBER - 3");
-           END IF;
- 
-           GET (FILE2, ITEM);
-           IF ITEM /= 'C' THEN
-                FAILED ("INCORRECT VALUE READ - 2");
-           END IF;
- 
-           IF LINE(FILE2) /= 1 THEN
-                FAILED ("INCORRECT LINE NUMBER - 4");
-           END IF;
- 
-           IF PAGE(FILE2) /= 2 THEN
-                FAILED ("INCORRECT PAGE NUMBER - 1");
-           END IF;
- 
-           IF NOT END_OF_PAGE (FILE2) THEN
-                FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS RESET - 2");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE2) THEN
-                FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS RESET - 2");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           CREATE (FILE3, OUT_FILE, LEGAL_FILE_NAME(3));
-           PUT (FILE3, 'A');
-           NEW_PAGE (FILE3);
-           PUT (FILE3, 'B');
-           NEW_PAGE (FILE3);
-           NEW_LINE (FILE3);
-           PUT (FILE3, 'C');
-           NEW_PAGE (FILE3);
- 
-           RESET (FILE3, IN_FILE);
- 
-           GET (FILE3, ITEM);
-           IF ITEM /= 'A' THEN
-                FAILED ("INCORRECT VALUE READ - 3");
-           END IF;
- 
-           GET (FILE3, ITEM);
-           GET (FILE3, ITEM);
- 
-           IF LINE(FILE3) /= 2 THEN
-                FAILED ("INCORRECT LINE NUMBER - 5");
-           END IF;
- 
-           IF PAGE(FILE3) /= 3 THEN
-                FAILED ("INCORRECT PAGE NUMBER - 2");
-           END IF;
- 
-           IF NOT END_OF_FILE (FILE3) THEN
-                FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
-                        "IS RESET - 3");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE3);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3106B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- CE3107A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
- --     TYPE TEXT_IO.
- 
- -- HISTORY:
- --     DLD 08/10/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/29/85
- --     DWC 08/17/87  SPLIT OUT CASES WHICH DEPEND ON A TEXT FILE
- --                   BEING CREATED OR SUCCESSFULLY OPENED.  PLACED
- --                   CASES INTO CE3107B.ADA.
- --     PWB 03/07/97  ADDED CHECK FOR FILE SUPPORT.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3107A IS
- 
-      TEST_FILE_ZERO : FILE_TYPE;
-      TEST_FILE_ONE : FILE_TYPE;
-      TEST_FILE_TWO : FILE_TYPE;
-      TEST_FILE_THREE : FILE_TYPE;
-      VAL : BOOLEAN;
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST("CE3107A", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
-                      "VALUES FOR UNOPENED FILES OF TYPE TEXT_IO");
- 
- -- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS TEXT FILES AT ALL
- 
-      BEGIN
-           TEXT_IO.CREATE ( TEST_FILE_ZERO,
-                           TEXT_IO.OUT_FILE,
-                           REPORT.LEGAL_FILE_NAME );
-      EXCEPTION
-           WHEN TEXT_IO.USE_ERROR | TEXT_IO.NAME_ERROR =>
-                REPORT.NOT_APPLICABLE
-                     ( "TEXT FILES NOT SUPPORTED -- CREATE OUT-FILE" );
-                RAISE INCOMPLETE;
-      END;
-      TEXT_IO.DELETE ( TEST_FILE_ZERO );
- 
- -- WHEN FILE IS DECLARED BUT NOT OPEN
- 
-      VAL := TRUE;
-      VAL := IS_OPEN(TEST_FILE_ONE);
-      IF VAL = TRUE THEN
-           FAILED("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE");
-      END IF;
- 
- -- FOLLOWING UNSUCCESSFUL CREATE
- 
-      BEGIN
-           VAL := TRUE;
-           CREATE(TEST_FILE_TWO, OUT_FILE,
-                  "$ILLEGAL_EXTERNAL_FILE_NAME1");
-           FAILED("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                VAL := IS_OPEN(TEST_FILE_TWO);
-                IF VAL = TRUE THEN
-                     FAILED("IS_OPEN GIVES TRUE AFTER AN " &
-                            "UNSUCCESSFUL CREATE");
-                END IF;
-      END;
- 
- -- FOLLOWING UNSUCCESSFUL OPEN
- 
-      BEGIN
-           VAL := FALSE;
-           OPEN(TEST_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
-           FAILED("NAME_ERROR NOT RAISED - " &
-                  "UNSUCCESSFUL OPEN");
-      EXCEPTION
-           WHEN NAME_ERROR =>
-                VAL := IS_OPEN(TEST_FILE_TWO);
-                IF VAL = TRUE THEN
-                     FAILED("IS_OPEN GIVES TRUE - " &
-                            "UNSUCCESSFUL OPEN");
-                END IF;
-      END;
- 
- -- CLOSE FILE WHILE NOT OPEN
- 
-      BEGIN
-           VAL := TRUE;
-           CLOSE(TEST_FILE_THREE);  -- STATUS ERROR
-           FAILED("STATUS_ERROR NOT RAISED - UNSUCCESSFUL CLOSE");
-      EXCEPTION
-           WHEN OTHERS =>
-                VAL := IS_OPEN(TEST_FILE_THREE);
-                IF VAL = TRUE THEN
-                     FAILED("IS_OPEN GIVES TRUE - UNSUCCESSFUL  " &
-                            "CLOSE");
-                END IF;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           NULL;
-           REPORT.RESULT;
-      WHEN OTHERS =>
-           REPORT.FAILED ( "UNEXPECTED EXCEPTION" );
-           REPORT.RESULT;
- END CE3107A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- CE3107B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
- --     TYPE TEXT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION WITH OUT_FILE MODE FOR TEXT FILES.
- 
- -- HISTORY:
- --     DWC 08/17/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3107B IS
- 
-      TEST_FILE_ONE : FILE_TYPE;
-      TEST_FILE_TWO : FILE_TYPE;
-      VAL : BOOLEAN;
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST("CE3107B", "CHECK THAT IS_OPEN RETURNS THE " &
-                      "PROPER VALUES FOR FILES OF TYPE TEXT_IO");
- 
- -- FOLLOWING A CREATE
- 
-      BEGIN
-           VAL := FALSE;
-           CREATE(TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-           VAL := IS_OPEN(TEST_FILE_ONE);
-           IF VAL = FALSE THEN
-                FAILED("IS_OPEN RETURNS FALSE AFTER CREATE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- FOLLOWING CLOSE
- 
-      VAL := TRUE;
-      IF IS_OPEN(TEST_FILE_ONE) = TRUE THEN
-           CLOSE(TEST_FILE_ONE);
-      END IF;
-      VAL := IS_OPEN(TEST_FILE_ONE);
-      IF VAL = TRUE THEN
-           FAILED("IS_OPEN RETURNS TRUE AFTER CLOSE");
-      END IF;
- 
- -- FOLLOWING OPEN
- 
-      BEGIN
-           VAL := FALSE;
-           BEGIN
-                OPEN (TEST_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     IF IS_OPEN (TEST_FILE_TWO) /= FALSE THEN
-                          FAILED ("FILE OPEN AFTER USE_ERROR " &
-                                  "DURING OPEN");
-                     END IF;
-                     RAISE INCOMPLETE;
-           END;
-           VAL := IS_OPEN(TEST_FILE_TWO);
-           IF VAL = FALSE THEN
-                FAILED("IS_OPEN RETURNS FALSE AFTER OPEN");
-           END IF;
- 
- -- AFTER RESET
- 
-           BEGIN
-                VAL := FALSE;
-                RESET(TEST_FILE_TWO);
-                VAL := IS_OPEN(TEST_FILE_TWO);
-                IF VAL = FALSE THEN
-                     FAILED("IS_OPEN RETURNS FALSE AFTER RESET");
-                END IF;
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT("IMPLEMENTATION DOES NOT SUPPORT RESET");
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
- -- AFTER DELETE
- 
-      BEGIN
-           VAL := TRUE;
-           DELETE(TEST_FILE_TWO);
-           VAL := IS_OPEN(TEST_FILE_TWO);
-           IF VAL = TRUE THEN
-                FAILED("IS_OPEN RETURNS TRUE AFTER DELETE");
-           END IF;
-      EXCEPTION
-           WHEN USE_ERROR =>
-                IF IS_OPEN (TEST_FILE_TWO) /= FALSE THEN
-                     FAILED ("FILE OPEN AFTER USE_ERROR " &
-                             "DURING DELETE");
-                END IF;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3107B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- CE3108A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A FILE CAN BE CLOSED AND THEN RE-OPENED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     DLD 08/11/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/16/85
- --     GMT 08/17/87  REMOVED UNNECESSARY CODE AND ADDED A CHECK FOR
- --                   USE_ERROR ON DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3108A IS
- 
-      TXT_FILE   : FILE_TYPE;
-      VAR        : STRING (1..2);
-      LAST       : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3108A", "CHECK THAT A FILE CAN BE CLOSED " &
-                       "AND THEN RE-OPENED");
- 
-      -- INITIALIZE TEST FILES
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (TXT_FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (TXT_FILE, "17");
-                CLOSE (TXT_FILE);
- 
-                -- RE-OPEN TEXT TEST FILE
- 
-                BEGIN
-                     OPEN (TXT_FILE, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (TXT_FILE, VAR);
-                IF VAR /= "17" THEN
-                     FAILED ("WRONG DATA RETURNED FROM READ -TEXT");
-                END IF;
- 
-                -- DELETE TEST FILES
- 
-                BEGIN
-                     DELETE (TXT_FILE);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3108A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- CE3108B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE NAME RETURNED BY THE NAME FUNCTION CAN BE USED
- --     IN A SUBSEQUENT OPEN.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     DLD 08/11/82
- --     SPS 11/09/82
- --     JBG 03/24/83
- --     EG  05/16/85
- --     GMT 08/17/87  REMOVED UNNECESSARY CODE AND ADDED A CHECK FOR
- --                   USE_ERROR ON DELETE.
- 
- WITH TEXT_IO; USE TEXT_IO;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CE3108B IS
- 
-      TYPE ACC_STR IS ACCESS STRING;
- 
-      TXT_FILE      : FILE_TYPE;
-      TXT_FILE_NAME : ACC_STR;
-      DIR_FILE_NAME : ACC_STR;
-      VAR           : STRING(1..2);
-      LAST          : INTEGER;
-      INCOMPLETE    : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3108B", "CHECK THAT THE NAME RETURNED BY THE NAME-" &
-                       "FUNCTION CAN BE USED IN A SUBSEQUENT OPEN");
- 
-      -- CREATE TEST FILES
- 
-      BEGIN
-           BEGIN
-                CREATE (TXT_FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 1");
-                     RAISE INCOMPLETE;
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 2");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (TXT_FILE, "14");
-                TXT_FILE_NAME := NEW STRING'(NAME (TXT_FILE));
-                CLOSE (TXT_FILE);
- 
-                -- ATTEMPT TO RE-OPEN TEXT TEST FILE USING RETURNED NAME
-                -- VALUE
- 
-                BEGIN
-                     OPEN (TXT_FILE, IN_FILE, TXT_FILE_NAME.ALL);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR ON RE-OPEN - 3");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (TXT_FILE, VAR);
-                IF VAR /= "14" THEN
-                     FAILED ("WRONG DATA RETURNED FROM READ - 4");
-                END IF;
- 
-                -- CLOSE AND DELETE TEST FILES
- 
-                BEGIN
-                     DELETE (TXT_FILE);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3108B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- CE3110A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE
- --     NAME OF THE FILE CAN BE USED IN A CREATE OPERATION.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION AND DELETION OF TEXT FILES.
- 
- -- HISTORY:
- --     SPS 08/25/82
- --     SPS 11/09/82
- --     JBG 06/04/84
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/18/87  CORRECTED EXCEPTION FORMAT.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3110A IS
- BEGIN
- 
-      TEST ("CE3110A", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " &
-                       "AFTER AN EXTERNAL FILE WITH SAME NAME HAS BEEN" &
-                       " DELETED");
-      DECLARE
-           FL1 : FILE_TYPE;
-           FL2 : FILE_TYPE;
-           T_FAILED : BOOLEAN := FALSE;
-           D_FILE : BOOLEAN := FALSE;
-      BEGIN
-           BEGIN
-                CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     T_FAILED := TRUE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     T_FAILED := TRUE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT " &
-                             "CREATE WITH OUT_FILE MODE");
-                     T_FAILED := TRUE;
-           END;
- 
-           IF NOT T_FAILED THEN
-                BEGIN
-                     DELETE (FL1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("DELETION OF EXTERNAL " &
-                                          "FILES NOT SUPPORTED");
-                          T_FAILED := TRUE;
-                END;
-           END IF;
- 
-           IF NOT T_FAILED THEN
-                BEGIN
-                     CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME);
-                     D_FILE := TRUE;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("UNABLE TO RECREATE FILE AFTER " &
-                                  "DELETION - TEXT");
-                END;
-                IF D_FILE THEN
-                     BEGIN
-                          DELETE (FL2);
-                     EXCEPTION
-                          WHEN OTHERS =>
-                               FAILED ("DELETE SHOULD STILL BE " &
-                                       "SUPPORTED");
-                     END;
-                END IF;
-           END IF;
-      END;
- 
-      RESULT;
- 
- END CE3110A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,81 ****
- -- CE3112C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED BY A NON-NULL
- --     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
- --     PROGRAM.
- 
- --     THIS TEST CREATES A TEXT FILE WHICH CE3112D.ADA WILL READ.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF AN EXTERNAL TEXT FILE WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     GMT 08/13/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO;
- 
- PROCEDURE CE3112C IS
- 
-      INCOMPLETE         : EXCEPTION;
-      FILE_NAME          : TEXT_IO.FILE_TYPE;
-      PREVENT_EMPTY_FILE : STRING (1..5) := "HELLO";
- 
- BEGIN
-      TEST ("CE3112C" , "CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED " &
-                        "BY A NON-NULL STRING NAME IS ACCESSIBLE " &
-                        "AFTER THE COMPLETION OF THE MAIN PROGRAM");
-      BEGIN
-           BEGIN
-                TEXT_IO.CREATE (FILE_NAME, TEXT_IO.OUT_FILE,
-                                LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN TEXT_IO.USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-                WHEN TEXT_IO.NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE - 2");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE - 3");
-                     RAISE INCOMPLETE;
-           END;
- 
-           TEXT_IO.PUT (FILE_NAME, PREVENT_EMPTY_FILE);
-           TEXT_IO.CLOSE (FILE_NAME);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3112C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- CE3112D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED BY A NON-NULL STRING
- --     NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN PROGRAM.
- 
- --     THIS TEST CHECKS THE CREATION OF A TEXT FILE X3112C, WHICH WAS
- --     CREATED BY CE3112C.ADA.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     GMT 08/13/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO;
- 
- PROCEDURE CE3112D IS
- 
-      INCOMPLETE               : EXCEPTION;
-      CHECK_SUPPORT, FILE_NAME : TEXT_IO.FILE_TYPE;
-      PREVENT_EMPTY_FILE       : STRING (1..5);
- 
- BEGIN
-      TEST ("CE3112D", "CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED BY " &
-                       "A NON-NULL STRING NAME IS ACCESSIBLE AFTER " &
-                       "THE COMPLETION OF THE MAIN PROGRAM");
- 
-      -- TEST FOR TEXT FILE SUPPORT.
- 
-      BEGIN
-           TEXT_IO.CREATE (CHECK_SUPPORT, TEXT_IO.OUT_FILE,
-                           LEGAL_FILE_NAME);
-           BEGIN
-                TEXT_IO.DELETE (CHECK_SUPPORT);
-           EXCEPTION
-                WHEN TEXT_IO.USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "DELETE - 1");
-           END;
-      EXCEPTION
-           WHEN TEXT_IO.USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE - 2");
-                RAISE INCOMPLETE;
-           WHEN TEXT_IO.NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE  - 3");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                        "CREATE - 4");
-                RAISE INCOMPLETE;
-      END;
- 
-      -- BEGIN TEST OBJECTIVE.
- 
-      BEGIN
-           TEXT_IO.OPEN (FILE_NAME, TEXT_IO.IN_FILE,
-                         LEGAL_FILE_NAME (1, "CE3112C"));
-      EXCEPTION
-           WHEN TEXT_IO.USE_ERROR =>
-                NOT_APPLICABLE("USE_ERROR RAISED ON OPEN FOR TEXT " &
-                               "FILE WITH IN_FILE MODE - 5");
-                RAISE INCOMPLETE;
-      END;
- 
-      TEXT_IO.GET (FILE_NAME, PREVENT_EMPTY_FILE);
- 
-      IF PREVENT_EMPTY_FILE /= "HELLO" THEN
-           FAILED ("OPENED WRONG FILE OR DATA ERROR - 6");
-      END IF;
-      BEGIN
-           TEXT_IO.DELETE (FILE_NAME);
-      EXCEPTION
-           WHEN TEXT_IO.USE_ERROR =>
-                COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " &
-                         "EXTERNAL FILE - 7");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE3112D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- CE3114A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AN EXTERNAL TEXT FILE CEASES TO EXIST AFTER
- --     A SUCCESSFUL DELETE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION AND DELETION OF TEXT FILES.
- 
- -- HISTORY:
- --     SPS 08/25/82
- --     SPS 11/09/82
- --     JBG 04/01/83
- --     EG  05/16/85
- --     GMT 08/25/87  COMPLETELY REVISED.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3114A IS
- BEGIN
- 
-      TEST ("CE3114A", "CHECK THAT AN EXTERNAL TEXT FILE CEASES TO " &
-                       "EXIST AFTER A SUCCESSFUL DELETE");
- 
-      DECLARE
-           FL1, FL2   : FILE_TYPE;
-           VAR1       : CHARACTER := 'A';
-           INCOMPLETE : EXCEPTION;
-      BEGIN
-           BEGIN
-                CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE - 2");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "CREATE - 3");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (FL1, VAR1);   -- THIS PUTS TO THE FILE IF
-           EXCEPTION               -- IT CAN, NOT NECESSARY FOR
-                WHEN OTHERS =>     -- THE OBJECTIVE.
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FL1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("DELETION OF EXTERNAL TEXT FILES " &
-                                     "IS NOT SUPPORTED - 4");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                OPEN (FL2, IN_FILE, LEGAL_FILE_NAME);
-                FAILED ("EXTERNAL TEXT FILE STILL EXISTS AFTER " &
-                        "A SUCCESSFUL DELETION - 5");
-           EXCEPTION
-                WHEN NAME_ERROR =>
-                     NULL;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3114A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,232 ****
- -- CE3115A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT RESETTING ONE OF A MULTIPLE OF INTERNAL FILES
- --     ASSOCIATED WITH THE SAME EXTERNAL FILE HAS NO EFFECT ON ANY
- --     OF THE OTHER INTERNAL FILES.
- 
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST APPLIES ONLY TO IMPLEMENTATIONS WHICH SUPPORT MULTIPLE
- --     INTERNAL FILES ASSOCIATED WITH THE SAME EXTERNAL FILE AND
- --     RESETTING OF THESE MULTIPLE INTERNAL FILES FOR TEXT FILES.
- 
- -- HISTORY:
- --     DLD 08/16/82
- --     SPS 11/09/82
- --     JBG 06/04/84
- --     EG  11/19/85  MADE TEST INAPPLICABLE IF CREATE USE_ERROR.
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE RESULT WHEN
- --                   FILES NOT SUPPORTED.
- --     GMT 08/25/87  COMPLETELY REVISED.
- --     EDS 12/01/97  ADD NAME_ERROR HANDLER TO OUTPUT NOT_APPLICABLE RESULT.
- --     RLB 09/29/98  MADE MODIFICATION TO AVOID BUFFERING PROBLEMS.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3115A IS
- 
- BEGIN
- 
-      TEST ("CE3115A", "CHECK THAT RESETTING ONE OF A MULTIPLE OF " &
-                       "INTERNAL FILES ASSOCIATED WITH THE SAME " &
-                       "EXTERNAL FILE HAS NO EFFECT ON ANY OF THE " &
-                       "OTHER INTERNAL FILES");
- 
-      DECLARE
-           TXT_FILE_ONE : TEXT_IO.FILE_TYPE;
-           TXT_FILE_TWO : TEXT_IO.FILE_TYPE;
- 
-           CH           : CHARACTER := 'A';
- 
-           INCOMPLETE   : EXCEPTION;
- 
-           PROCEDURE TXT_CLEANUP IS
-                FILE1_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_ONE);
-                FILE2_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_TWO);
-           BEGIN
-                IF FILE1_OPEN AND FILE2_OPEN THEN
-                     CLOSE (TXT_FILE_TWO);
-                     DELETE (TXT_FILE_ONE);
-                ELSIF FILE1_OPEN THEN
-                     DELETE (TXT_FILE_ONE);
-                ELSIF FILE2_OPEN THEN
-                     DELETE (TXT_FILE_TWO);
-                END IF;
-           EXCEPTION
-                WHEN TEXT_IO.USE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED " &
-                             "IN CLEANUP - 1");
-           END TXT_CLEANUP;
- 
-      BEGIN
- 
-           BEGIN -- CREATE FIRST FILE
- 
-                CREATE (TXT_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
-                PUT (TXT_FILE_ONE, CH);
- 
-           EXCEPTION
-                WHEN TEXT_IO.USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; CREATE OF " &
-                                     "EXTERNAL FILENAME IS NOT " &
-                                     "SUPPORTED - 2");
-                     RAISE INCOMPLETE;
-                WHEN TEXT_IO.NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; CREATE OF " &
-                                     "EXTERNAL FILENAME IS NOT " &
-                                     "SUPPORTED - 3");
-                     RAISE INCOMPLETE;
- 
-           END; -- CREATE FIRST FILE
- 
-           BEGIN -- OPEN SECOND FILE
- 
-                OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
- 
-           EXCEPTION
- 
-                WHEN TEXT_IO.USE_ERROR =>
-                     NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " &
-                                     "SUPPORTED WHEN ONE IS MODE " &
-                                     "OUT_FILE AND THE OTHER IS MODE " &
-                                     "IN_FILE - 4" &
-                                     " - USE_ERROR RAISED ");
-                     TXT_CLEANUP;
-                     RAISE INCOMPLETE;
- 
-                WHEN TEXT_IO.NAME_ERROR =>
-                     NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " &
-                                     "SUPPORTED WHEN ONE IS MODE " &
-                                     "OUT_FILE AND THE OTHER IS MODE " &
-                                     "IN_FILE - 4" &
-                                     " - NAME_ERROR RAISED ");
-                     TXT_CLEANUP;
-                     RAISE INCOMPLETE;
- 
-           END; -- OPEN SECOND FILE
-           FLUSH (TXT_FILE_ONE); -- AVOID BUFFERING PROBLEMS.
- 
-           CH := 'B';
-           GET (TXT_FILE_TWO, CH);
-           IF CH /= 'A' THEN
-                FAILED ("INCORRECT VALUE FOR GET - 5");
-           END IF;
- 
-           BEGIN -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING
- 
-                RESET (TXT_FILE_ONE);
-                IF MODE (TXT_FILE_ONE) /= OUT_FILE THEN
-                     FAILED ("FILE WAS NOT RESET - 6");
-                END IF;
-                IF MODE (TXT_FILE_TWO) /= IN_FILE THEN
-                     FAILED ("RESETTING OF ONE INTERNAL FILE " &
-                             "AFFECTED THE OTHER INTERNAL FILE - 7");
-                END IF;
- 
-           EXCEPTION
- 
-                WHEN TEXT_IO.USE_ERROR =>
-                     NOT_APPLICABLE ("RESETTING OF EXTERNAL FILE FOR " &
-                                     "OUT_FILE MODE IS " &
-                                     " NOT SUPPORTED - 8");
-                     TXT_CLEANUP;
-                     RAISE INCOMPLETE;
- 
-           END; -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING
- 
-           -- PERFORM SOME I/O ON THE FIRST FILE
- 
-           PUT (TXT_FILE_ONE, 'C');
-           PUT (TXT_FILE_ONE, 'D');
-           PUT (TXT_FILE_ONE, 'E');
-           CLOSE (TXT_FILE_ONE);
- 
-           BEGIN
-                OPEN (TXT_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("MULTIPLE INTERNAL FILES NOT " &
-                                     "SUPPORTED WHEN BOTH FILES HAVE " &
-                                     "IN_FILE MODE - 9");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (TXT_FILE_ONE, CH);
-           GET (TXT_FILE_ONE, CH);
- 
-           BEGIN -- INITIALIZE SECOND FILE AND PERFORM SOME I/O
- 
-                CLOSE (TXT_FILE_TWO);
-                OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
- 
-           EXCEPTION
- 
-                WHEN TEXT_IO.USE_ERROR =>
-                     FAILED ("MULTIPLE INTERNAL FILES SHOULD STILL " &
-                             "BE ALLOWED - 10");
-                     TXT_CLEANUP;
-                     RAISE INCOMPLETE;
- 
-           END; -- INITIALIZE SECOND FILE AND PERFORM SOME I/O
- 
-           BEGIN -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE
- 
-                GET (TXT_FILE_TWO, CH);
-                IF CH /= 'C' THEN
-                     FAILED ("INCORRECT VALUE FOR GET OPERATION - 11");
-                END IF;
- 
-                RESET (TXT_FILE_ONE);
-                GET (TXT_FILE_TWO, CH);
-                IF CH /= 'D' THEN
-                     FAILED ("RESETTING INDEX OF ONE TEXT FILE " &
-                             "RESETS THE OTHER ASSOCIATED FILE - 12");
-                END IF;
- 
-           EXCEPTION
- 
-                WHEN TEXT_IO.USE_ERROR =>
-                     FAILED ("RESETTING SHOULD STILL BE SUPPORTED - 13");
-                     TXT_CLEANUP;
-                     RAISE INCOMPLETE;
- 
-           END; -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE
- 
-           TXT_CLEANUP;
- 
-      EXCEPTION
- 
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3115A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- CE3201A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT THE STANDARD INPUT AND OUTPUT FILES EXIST
- -- AND ARE OPEN.
- 
- -- ABW  8/25/82
- -- SPS 9/16/82
- -- SPS 12/14/82
- -- JBG 3/17/83
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3201A IS
-      CH : CHARACTER;
- BEGIN
- 
-      TEST ("CE3201A", "CHECK THAT STANDARD INPUT AND " &
-                       "OUTPUT EXIST AND ARE OPEN");
- 
-      IF NOT IS_OPEN (STANDARD_INPUT) THEN
-           FAILED ("STANDARD_INPUT NOT OPEN - IS_OPEN");
-      END IF;
- 
-      IF NOT IS_OPEN (STANDARD_OUTPUT) THEN
-           FAILED ("STANDARD_OUTPUT NOT OPEN - IS_OPEN");
-      END IF;
- 
-      BEGIN
-           PUT ('X');
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("STANDARD_OUTPUT NOT AVAILABLE - " &
-                        "PUT DEFAULT");
-      END;
- 
-      BEGIN
-           PUT (STANDARD_OUTPUT, 'D');
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("STANDARD_OUTPUT NOT AVAILABLE - " &
-                        "PUT");
-      END;
- 
-      RESULT;
- 
- END CE3201A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- CE3202A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT CURRENT_INPUT AND CURRENT_OUTPUT INITIALLY
- -- CORRESPOND TO STANDARD FILES.
- 
- -- ABW  8/25/82
- -- SPS  11/9/82
- -- JBG  3/17/83
- -- JBG 5/8/84
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3202A IS
- 
- 
- BEGIN
- 
-      TEST ("CE3202A", "CHECK THAT CURRENT_INPUT AND " &
-                       "CURRENT_OUTPUT INITIALLY " &
-                       "CORRESPOND TO STANDARD FILES");
- 
-      IF NAME (CURRENT_INPUT) /= NAME (STANDARD_INPUT) THEN
-           FAILED ("CURRENT_INPUT INCORRECT - NAME");
-      END IF;
- 
-      IF NAME (CURRENT_OUTPUT) /= NAME (STANDARD_OUTPUT) THEN
-           FAILED ("CURRENT_OUTPUT INCORRECT - NAME");
-      END IF;
- 
-      RESULT;
- 
- END CE3202A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- CE3206A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_INPUT AND SET_OUTPUT RAISE STATUS_ERROR WHEN
- --     CALLED WITH A FILE PARAMETER DENOTING A CLOSED FILE.
- 
- -- HISTORY:
- --     ABW 08/31/82
- --     SPS 10/01/82
- --     SPS 11/09/82
- --     JLH 08/18/87  ADDED NEW CASES FOR SET_INPUT AND SET_OUTPUT.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3206A IS
- 
-      FILE_IN, FILE1 : FILE_TYPE;
-      ITEM : CHARACTER := 'A';
- 
- BEGIN
- 
-      TEST ("CE3206A", "CHECK THAT SET_INPUT AND SET_OUTPUT " &
-                       "RAISE STATUS_ERROR WHEN CALLED WITH A " &
-                       "FILE PARAMETER DENOTING A CLOSED FILE");
- 
-      BEGIN
-           SET_INPUT (FILE_IN);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_INPUT - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT - 1");
-      END;
- 
-      BEGIN
-           SET_OUTPUT (FILE_IN);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_OUTPUT - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT - 1");
-      END;
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE);
-           PUT (FILE1, ITEM);
-           CLOSE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      BEGIN
-           SET_INPUT (FILE1);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_INPUT - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT - 2");
-      END;
- 
-      BEGIN
-           SET_OUTPUT (FILE1);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_OUTPUT - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT - 2");
-      END;
- 
- 
-      RESULT;
- 
- END CE3206A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- CE3207A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT MODE_ERROR IS RAISED IF THE PARAMETER TO SET_INPUT HAS
- --     MODE OUT_FILE OR THE PARAMETER TO SET_OUTPUT HAS MODE IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/07/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3207A IS
- 
-      FILE1, FILE2 : FILE_TYPE;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3207A", "CHECK THAT MODE_ERROR IS RAISED IF THE " &
-                       "PARAMETER TO SET_INPUT HAS MODE OUT_FILE " &
-                       "OR THE PARAMETER TO SET_OUTPUT HAS MODE " &
-                       "IN_FILE");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                SET_INPUT (FILE1);
-                FAILED ("MODE_ERROR NOT RAISED FOR SET_INPUT WITH " &
-                        "MODE OUT_FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT");
-           END;
- 
-           CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME);
- 
-           PUT (FILE2, "OUTPUT STRING");
-           CLOSE (FILE2);
-           OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME);
- 
-           BEGIN
-                SET_OUTPUT (FILE2);
-                FAILED ("MODE_ERROR NOT RAISED FOR SET_OUTPUT WITH " &
-                        "MODE IN_FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT");
-           END;
- 
-           BEGIN
-                DELETE (FILE2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3207A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,176 ****
- -- CE3301A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN THE LINE AND PAGE LENGTH ARE NONZERO, LINE AND
- --     PAGE TERMINATORS ARE OUTPUT AT THE APPROPRIATE POINTS.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/22/82
- --     SPS 11/15/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/27/87  COMPLETELY REVISED TEST.
- --     LDC 05/26/88  ADDED "FILE" PARAMETERS.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3301A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      TWO : CONSTANT COUNT := COUNT(IDENT_INT(2));
-      TEN : CONSTANT COUNT := COUNT(IDENT_INT(10));
-      THREE : CONSTANT COUNT := COUNT(IDENT_INT(3));
-      ITEM1 : STRING (1..10);
-      ITEM2 : STRING (1..2);
- 
- BEGIN
- 
-      TEST ("CE3301A", "CHECK THAT WHEN THE LINE AND PAGE LENGTH ARE " &
-                       "NONZERO, LINE AND PAGE TERMINATORS ARE " &
-                       "OUTPUT AT THE APPROPRIATE POINTS");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF LINE_LENGTH (FILE) /= UNBOUNDED THEN
-           FAILED ("LINE LENGTH NOT INITIALLY UNBOUNDED");
-      END IF;
- 
-      IF PAGE_LENGTH (FILE) /= UNBOUNDED THEN
-           FAILED ("PAGE LENGTH NOT INITIALLY UNBOUNDED");
-      END IF;
- 
-      SET_LINE_LENGTH (FILE,TEN);
-      SET_PAGE_LENGTH (FILE,TWO);
- 
-      FOR I IN 1 .. 30 LOOP
-           PUT (FILE,'C');
-      END LOOP;
- 
-      IF PAGE (FILE) /= 2 AND LINE (FILE) /= 1 THEN
-           FAILED ("LINE AND PAGE LENGTHS WERE NOT BOUND " &
-                   "CORRECTLY");
-      END IF;
- 
-      SET_LINE_LENGTH (FILE, TWO);
-      SET_PAGE_LENGTH (FILE, THREE);
-      PUT (FILE, "DDDDDDD");
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      GET (FILE, ITEM1);
- 
-      IF NOT (END_OF_LINE (FILE)) THEN
-           FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
-      END IF;
- 
-      IF END_OF_PAGE (FILE) THEN
-           FAILED ("PAGE TERMINATOR OUTPUT AT INAPPROPRIATE POINT");
-      END IF;
- 
-      GET (FILE, ITEM1);
- 
-      IF ITEM1 /= "CCCCCCCCCC" THEN
-           FAILED ("INCORRECT VALUE READ");
-      END IF;
- 
-      IF NOT (END_OF_LINE(FILE)) THEN
-           FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
-      END IF;
- 
-      IF NOT (END_OF_PAGE(FILE)) THEN
-           FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR");
-      END IF;
- 
-      GET (FILE, ITEM1);
-      GET (FILE, ITEM2);
- 
-      IF ITEM2 /= "DD" THEN
-           FAILED ("INCORRECT VALUE READ");
-      END IF;
- 
-      IF NOT (END_OF_LINE(FILE)) THEN
-           FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
-      END IF;
- 
-      IF END_OF_PAGE (FILE) THEN
-           FAILED ("PAGE TERMINATOR OUTPUT AT INAPPROPRIATE POINT");
-      END IF;
- 
-      GET (FILE, ITEM2);
- 
-      IF ITEM2 /= "DD" THEN
-           FAILED ("INCORRECT VALUE READ");
-      END IF;
- 
-      IF NOT (END_OF_LINE(FILE)) THEN
-           FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
-      END IF;
- 
-      IF NOT (END_OF_PAGE(FILE)) THEN
-           FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3301A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- CE3302A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_LINE_LENGTH, SET_PAGE_LENGTH, LINE_LENGTH, AND
- --     PAGE_LENGTH RAISE MODE_ERROR WHEN APPLIED TO A FILE OF MODE
- --     IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/16/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/19/87  CREATED AN EXTERNAL FILE WITH A NAME, REMOVED
- --                   DEPENDENCE ON RESET, AND ADDED CODE TO DELETE
- --                   EXTERNAL FILE.
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3302A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      FIVE : COUNT := COUNT(IDENT_INT(5));
-      VAR1 : COUNT;
-      ITEM : CHARACTER := 'A';
- 
- BEGIN
-      TEST ("CE3302A", "CHECK THAT SET_LINE_LENGTH, SET_PAGE_LENGTH, " &
-                       "LINE_LENGTH, AND PAGE_LENGTH RAISE MODE_ERROR " &
-                       "WHEN APPLIED TO A FILE OF MODE IN_FILE");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT FILE CREATE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT FILE CREATE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, ITEM);
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT FILE OPEN");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           SET_LINE_LENGTH (FILE, FIVE);
-           FAILED ("MODE_ERROR NOT RAISED - SET_LINE_LENGTH");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - SET_LINE_LENGTH");
-      END;
- 
-      BEGIN
-           SET_PAGE_LENGTH (FILE, FIVE);
-           FAILED ("MODE_ERROR NOT RAISED - SET_PAGE_LENGTH");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - SET_PAGE_LENGTH");
-      END;
- 
-      BEGIN
-           VAR1 := LINE_LENGTH (FILE);
-           FAILED ("MODE_ERROR NOT RAISED - LINE_LENGTH");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - LINE_LENGTH");
-      END;
- 
-      BEGIN
-           VAR1 := PAGE_LENGTH (FILE);
-           FAILED ("MODE_ERROR NOT RAISED - PAGE_LENGTH");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - PAGE_LENGTH");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3302A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- CE3303A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_LINE_LENGTH, SET_PAGE_LENGTH, LINE_LENGTH, AND
- --     PAGE_LENGTH RAISE STATUS_ERROR WHEN APPLIED TO A CLOSED FILE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/16/82
- --     JLH 08/19/87  ADDED AN ATTEMPT TO CREATE AN EXTERNAL FILE;
- --                   ADDED CHECKS TO THE SAME FOUR CASES WHICH EXIST
- --                   IN TEST AGAINST ATTEMPTED CREATE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3303A IS
- 
-      FILE : FILE_TYPE;
-      FIVE : COUNT := COUNT(IDENT_INT(5));
-      C : COUNT;
-      ITEM : CHARACTER := 'A';
- 
- BEGIN
- 
-      TEST ("CE3303A" , "CHECK THAT SET_LINE_LENGTH, " &
-                        "SET_PAGE_LENGTH, LINE_LENGTH, AND " &
-                        "PAGE_LENGTH RAISE STATUS_ERROR " &
-                        "WHEN APPLIED TO A CLOSED FILE");
- 
- -- FILE NONEXISTANT
- 
-      BEGIN
-           SET_LINE_LENGTH (FILE, FIVE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " &
-                        "- 1");
-      END;
- 
-      BEGIN
-           SET_PAGE_LENGTH (FILE, FIVE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " &
-                        "- 1");
-      END;
- 
-      BEGIN
-           C := LINE_LENGTH (FILE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 1");
-      END;
- 
-      BEGIN
-           C := PAGE_LENGTH (FILE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 1");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 1");
-      END;
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE);
-           PUT (FILE, ITEM);
-           CLOSE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      BEGIN
-           SET_LINE_LENGTH (FILE, FIVE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " &
-                        "- 2");
-      END;
- 
-      BEGIN
-           SET_PAGE_LENGTH (FILE, FIVE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " &
-                        "- 2");
-      END;
- 
-      BEGIN
-           C := LINE_LENGTH (FILE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 2");
-      END;
- 
-      BEGIN
-           C := PAGE_LENGTH (FILE);
-           FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 2");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 2");
-      END;
- 
-      RESULT;
- 
- END CE3303A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst	Thu Jan  1 00:00:00 1970
***************
*** 1,204 ****
- -- CE3304A.TST
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT USE_ERROR IS RAISED BY A CALL TO SET_LINE_LENGTH
- --     OR TO SET_PAGE_LENGTH WHEN THE SPECIFIED VALUE IS INAPPROPRIATE
- --     FOR THE EXTERNAL FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS THAT SATISFY THE
- --     FOLLOWING CONDITIONS:
- --       1) TEXT FILES ARE SUPPORTED
- --       2) EITHER BY DEFAULT OR BY USE OF THE "FORM" PARAMETER TO
- --          THE CREATE PROCEDURE, A TEXT FILE CAN BE CREATED FOR
- --          WHICH AT LEAST ONE OF THE FOLLOWING CONDITIONS HOLDS:
- --           A)  THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
- --               AN APPROPRIATE LINE-LENGTH FOR THE FILE,
- --             OR
- --           B)  THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
- --               AN APPROPRIATE PAGE-LENGTH FOR THE FILE.
- 
- -- MACRO SUBSTITUTIONS:
- --     FOR THE MACRO SYMBOL "$FORM_STRING," SUBSTITUTE A STRING LITERAL
- --     SPECIFIYING THAT THE EXTERNAL FILE MEETS BOTH OF THE CONDITIONS
- --     (A) AND (B) ABOVE.  IF IT IS NOT POSSIBLE TO SATISFY BOTH
- --     CONDITIONS, THEN SUBSTITUTE A STRING LITERAL SPECIFYING THAT THE
- --     EXTERNAL FILE SATISFIES ONE OF THE CONDITIONS.  IF IT IS NOT
- --     POSSIBLE TO SATISFY EITHER CONDITION, THEN SUBSTITUE THE NULL
- --     STRING ("").
- --     FOR THE MACRO SYMBOL "$INAPPROPRIATE_LINE_LENGTH," SUBSTITUTE
- --     A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH
- --     FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
- --     FOR THE MACRO SYMBOL "$INAPPROPRIATE_PAGE_LENGTH," SUBSTITUTE
- --     A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH
- --     FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
- 
- -- HISTORY:
- --     PWB 07/07/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3304A IS
- 
-      FILE1,
-      FILE2,
-      FILE3 : FILE_TYPE;
- 
-      LINE_LENGTH_SHOULD_WORK,
-      PAGE_LENGTH_SHOULD_WORK : BOOLEAN;
- 
-      INCOMPLETE : EXCEPTION;
- 
-      TEST_VALUE : COUNT;
- 
- BEGIN
- 
-      TEST ("CE3304A", "CHECK THAT USE_ERROR IS RAISED IF A CALL TO " &
-                       "SET_LINE_LENGTH OR SET_PAGE_LENGTH SPECIFIES " &
-                       "A VALUE THAT IS INAPPROPRIATE FOR THE " &
-                       "EXTERNAL FILE");
- 
-      BEGIN     -- CHECK WHETHER TEXT FILES ARE SUPPORTED.
- 
-           CREATE(FILE1, OUT_FILE, LEGAL_FILE_NAME(1),
-                  FORM => $FORM_STRING);
-           PUT_LINE(FILE1, "AAA");
-           CLOSE(FILE1);
- 
-      EXCEPTION
- 
-           WHEN USE_ERROR | NAME_ERROR =>
-                NOT_APPLICABLE ("CREATION OF TEXT FILES NOT SUPPORTED");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED AT INITIAL CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN  -- CHECK INAPPROPRIATE LINE LENGTH.
- 
-           BEGIN   -- IS THERE AN INAPPROPRIATE VALUE?
-                TEST_VALUE :=
-                          COUNT(IDENT_INT($INAPPROPRIATE_LINE_LENGTH));
-                IF NOT EQUAL (INTEGER(TEST_VALUE),
-                              INTEGER(TEST_VALUE)) THEN
-                     COMMENT ("OPTIMIZATION DEFEATED" &
-                               COUNT'IMAGE(TEST_VALUE));
-                END IF;
-                LINE_LENGTH_SHOULD_WORK := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     LINE_LENGTH_SHOULD_WORK := FALSE;
-                     COMMENT("THERE IS NO INAPPROPRIATE LINE LENGTH");
-           END;
- 
-           IF LINE_LENGTH_SHOULD_WORK THEN
-                BEGIN
-                     CREATE(FILE2, OUT_FILE, LEGAL_FILE_NAME(2),
-                            FORM => $FORM_STRING);
-                     SET_LINE_LENGTH(FILE2, $INAPPROPRIATE_LINE_LENGTH);
-                     FAILED("NO EXCEPTION FOR INAPPROPRIATE LINE " &
-                            "LENGTH");
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          IF NOT IS_OPEN(FILE2) THEN
-                               FAILED ("FILE NOT OPENED -- LINE LENGTH");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED FOR " &
-                                  "INAPPROPRIATE LINE LENGTH");
-                END;
-           END IF;
-      END;
- 
- -----------------------------------------------------------------------
- 
-      BEGIN  -- CHECK INAPPROPRIATE PAGE LENGTH.
- 
-           BEGIN   -- IS THERE AN INAPPROPRIATE VALUE?
-                TEST_VALUE :=
-                          COUNT(IDENT_INT($INAPPROPRIATE_PAGE_LENGTH));
-                IF NOT EQUAL (INTEGER(TEST_VALUE),
-                              INTEGER(TEST_VALUE)) THEN
-                     COMMENT ("OPTIMIZATION DEFEATED" &
-                              COUNT'IMAGE(TEST_VALUE));
-                END IF;
-                PAGE_LENGTH_SHOULD_WORK := TRUE;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     PAGE_LENGTH_SHOULD_WORK := FALSE;
-                     COMMENT("THERE IS NO INAPPROPRIATE PAGE LENGTH");
-           END;
- 
-           IF PAGE_LENGTH_SHOULD_WORK THEN
-                BEGIN
-                     CREATE(FILE3, OUT_FILE, LEGAL_FILE_NAME(3),
-                            FORM => $FORM_STRING);
-                     SET_PAGE_LENGTH(FILE3, $INAPPROPRIATE_PAGE_LENGTH);
-                     FAILED("NO EXCEPTION FOR INAPPROPRIATE PAGE " &
-                            "LENGTH");
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          IF NOT IS_OPEN(FILE3) THEN
-                               FAILED ("FILE NOT OPENED -- PAGE LENGTH");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED FOR " &
-                                  "INAPPROPRIATE PAGE LENGTH");
-                END;
-           END IF;
-      END;
- 
-      IF NOT (PAGE_LENGTH_SHOULD_WORK OR LINE_LENGTH_SHOULD_WORK) THEN
-           NOT_APPLICABLE("NO INAPPROPRIATE VALUES FOR EITHER LINE " &
-                          "LENGTH OR PAGE LENGTH");
-      END IF;
- 
-      BEGIN     -- CLEAN UP FILES.
- 
-           IF IS_OPEN(FILE1) THEN
-                CLOSE(FILE1);
-           END IF;
- 
-           IF IS_OPEN(FILE2) THEN
-                CLOSE(FILE2);
-           END IF;
- 
-           IF IS_OPEN(FILE3) THEN
-                CLOSE(FILE3);
-           END IF;
- 
-      EXCEPTION
-           WHEN USE_ERROR =>
-                COMMENT("FILES NOT DELETED");
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE3304A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- CE3305A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE LINE AND PAGE LENGTHS MAY BE ALTERED DYNAMICALLY
- --     SEVERAL TIMES.  CHECK THAT WHEN RESET TO ZERO, THE LENGTHS ARE
- --     UNBOUNDED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES WITH UNBOUNDED LINE LENGTH.
- 
- -- HISTORY:
- --     SPS 09/28/82
- --     EG  05/22/85
- --     DWC 08/18/87  ADDED CHECK_FILE WITHOUT A'S.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3305A IS
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3305A", "CHECK THAT LINE AND PAGE LENGTHS MAY BE " &
-                       "ALTERED DYNAMICALLY");
- 
-      DECLARE
-           FT : FILE_TYPE;
- 
-           PROCEDURE PUT_CHARS (CNT: INTEGER; CH: CHARACTER) IS
-           BEGIN
-                FOR I IN 1 .. CNT LOOP
-                     PUT (FT, CH);
-                END LOOP;
-           END PUT_CHARS;
- 
-      BEGIN
- 
-           BEGIN
-                CREATE(FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FT, 10);
-           SET_PAGE_LENGTH (FT, 5);
- 
-           PUT_CHARS (150, 'X');         -- 15 LINES
- 
-           BEGIN
-                SET_LINE_LENGTH (FT, 5);
-                SET_PAGE_LENGTH (FT, 10);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH");
-           END;
- 
-           PUT_CHARS (50, 'B');               -- 10 LINES
- 
-           BEGIN
-                SET_LINE_LENGTH (FT, 25);
-                SET_PAGE_LENGTH (FT,4);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH - 2");
-           END;
- 
-           PUT_CHARS (310, 'K');              -- 12 LINES, 10 CHARACTERS
- 
- --  THIS CAN RAISE USE_ERROR IF AN IMPLEMENTATION REQUIRES A BOUNDED
- --  LINE LENGTH FOR AN EXTERNAL FILE.
- 
-           BEGIN
-                BEGIN
-                     SET_LINE_LENGTH (FT, UNBOUNDED);
-                     SET_PAGE_LENGTH (FT, UNBOUNDED);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("BOUNDED LINE LENGTH " &
-                                          "REQUIRED");
-                          RAISE INCOMPLETE;
-                END;
- 
-                PUT_CHARS (100, 'A');              -- ONE LINE
- 
-                CHECK_FILE (FT,"XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#@" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#@" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "XXXXXXXXXX#" &
-                               "BBBBB#" &
-                               "BBBBB#" &
-                               "BBBBB#" &
-                               "BBBBB#" &
-                               "BBBBB#@" &
-                               "BBBBB#" &
-                               "BBBBB#" &
-                               "BBBBB#" &
-                               "BBBBB#" &
-                               "BBBBBKKKKKKKKKKKKKKKKKKKK#@" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#@" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#@" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#"&
-                               "KKKKKKKKKKKKKKKKKKKKKKKKK#"&
-                               "KKKKKKKKKKKKKKKAAAAAAAAAAA" &
-                               "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
-                               "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
-                               "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
-                               "AAAAAAAAAAA#@%");
- 
-           EXCEPTION
-                WHEN INCOMPLETE =>
-                     NULL;
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3305A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,82 ****
- -- CE3306A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE VALUE OF 'TO' IS
- --     NEGATIVE OR GREATER THAN COUNT'LAST WHEN COUNT'LAST IS LESS THAN
- --     COUNT'BASE'LAST.
- 
- -- HISTORY:
- --     JET 08/17/88  CREATED ORIGINAL TEST.
- --     PWN 10/27/95  REMOVED CONSTRAINT CHECK THAT NOW HAPPENS AT
- --                   COMPILE TIME.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- PROCEDURE CE3306A IS
- 
- BEGIN
-      TEST ("CE3306A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE " &
-                       "VALUE OF 'TO' IS NEGATIVE OR GREATER THAN " &
-                       "COUNT'LAST WHEN COUNT'LAST IS LESS THAN " &
-                       "COUNT'BASE'LAST");
- 
-      BEGIN
-           SET_LINE_LENGTH(-1);
-           FAILED("NO EXCEPTION FOR SET_LINE_LENGTH(-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION FOR SET_LINE_LENGTH(-1)");
-      END;
- 
-      BEGIN
-           SET_PAGE_LENGTH(COUNT(IDENT_INT(-1)));
-           FAILED("NO EXCEPTION FOR SET_PAGE_LENGTH(-1)");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED("UNEXPECTED EXCEPTION FOR SET_PAGE_LENGTH(-1)");
-      END;
- 
-      IF COUNT'LAST < COUNT'BASE'LAST THEN
-           BEGIN
-                SET_LINE_LENGTH(COUNT'LAST + COUNT(IDENT_INT(1)));
-                FAILED("NO EXCEPTION FOR SET_LINE_LENGTH(COUNT'LAST+1)");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION FOR SET_LINE_LENGTH" &
-                            "(COUNT'LAST+1)");
-           END;
- 
-      ELSE
-           COMMENT("COUNT'LAST IS EQUAL TO COUNT'BASE'LAST");
-      END IF;
- 
-      RESULT;
- END CE3306A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,105 ****
- -- CE3401A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FORMAL PARAMETERS OF EACH COLUMN, LINE, AND
- --     PAGE OPERATION ARE NAMED CORRECTLY.
- 
- -- HISTORY:
- --     JET 08/17/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- PROCEDURE CE3401A IS
- 
-      FIN, FOUT : FILE_TYPE;
-      B : BOOLEAN;
-      C : COUNT;
-      FILE_OK : BOOLEAN := FALSE;
- 
- BEGIN
-      TEST ("CE3401A", "CHECK THAT THE FORMAL PARAMETERS OF EACH " &
-                       "COLUMN, LINE, AND PAGE OPERATION ARE NAMED " &
-                       "CORRECTLY");
- 
-      BEGIN
-           CREATE(FOUT, OUT_FILE, LEGAL_FILE_NAME);
-           FILE_OK := TRUE;
-      EXCEPTION
-           WHEN OTHERS =>
-                NOT_APPLICABLE("OUTPUT FILE COULD NOT BE CREATED");
-      END;
- 
-      IF FILE_OK THEN
-           NEW_LINE(FILE => FOUT, SPACING => 1);
-           NEW_PAGE(FILE => FOUT);
-           SET_COL(FILE => FOUT, TO => 1);
-           SET_LINE(FILE => FOUT, TO => 1);
-           C := COL(FILE => FOUT);
-           C := LINE(FILE => FOUT);
-           C := PAGE(FILE => FOUT);
- 
-           NEW_PAGE(FOUT);
- 
-           BEGIN
-                CLOSE(FOUT);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("OUTPUT FILE COULD NOT BE CLOSED");
-                     FILE_OK := FALSE;
-           END;
-      END IF;
- 
-      IF FILE_OK THEN
-           BEGIN
-                OPEN(FIN, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("INPUT FILE COULD NOT BE OPENED");
-                     FILE_OK := FALSE;
-           END;
-      END IF;
- 
-      IF FILE_OK THEN
-           SKIP_LINE(FILE => FIN, SPACING => 1);
-           SKIP_PAGE(FILE => FIN);
-           B := END_OF_LINE(FILE => FIN);
-           B := END_OF_PAGE(FILE => FIN);
-           B := END_OF_FILE(FILE => FIN);
- 
-           BEGIN
-                DELETE(FIN);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT("FILE COULD NOT BE DELETED");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED ERROR AT DELETION");
-           END;
-      END IF;
- 
-      RESULT;
- EXCEPTION
-      WHEN OTHERS =>
-           FAILED("UNEXPECTED EXCEPTION RAISED");
- END CE3401A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CE3402A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_LINE RAISES MODE_ERROR WHEN THE FILE MODE
- --     IS IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/16/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/19/87  ADDED ATTEMPT TO DELETE THE FILE AND REPLACED
- --                   RESET WITH CLOSE AND OPEN.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3402A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE1 : FILE_TYPE;
-      SPAC : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
- 
- BEGIN
- 
-      TEST ("CE3402A" , "CHECK THAT NEW_LINE RAISES MODE_ERROR " &
-                        "WHEN THE FILE MODE IS IN_FILE");
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           PUT_LINE (FILE1, "STUFF");
-           CLOSE (FILE1);
-           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED FOR OPEN " &
-                                "WITH IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           NEW_LINE (FILE1,SPAC);
-           FAILED ("MODE_ERROR NOT RAISED FOR IN_FILE");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR IN_FILE");
-      END;
- 
-      BEGIN
-           NEW_LINE (STANDARD_INPUT,SPAC);
-           FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_INPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED FOR STANDARD_INPUT");
-      END;
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3402A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- CE3402C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_LINE INCREMENTS THE CURRENT PAGE BY ONE AND
- --     SETS THE CURRENT LINE NUMBER TO ONE WHEN THE PAGE LENGTH IS
- --     BOUNDED AND THE LINE NUMBER WOULD HAVE EXCEEDED THE
- --     MAXIMUM PAGE LENGTH.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 09/01/82
- --     SPS 11/30/82
- --     SPS 01/24/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/19/87  ADDED ORIGINAL_LINE_LENGTH AND
- --                   ORIGINAL_PAGE_LENGTH VARIABLES AND CLOSED FILE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3402C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
-      TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
-      THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
-      CHAR : CHARACTER := ('C');
-      ITEM_CHAR : CHARACTER;
-      ORIGINAL_LINE_LENGTH : COUNT := LINE_LENGTH;
-      ORIGINAL_PAGE_LENGTH : COUNT := PAGE_LENGTH;
- 
- BEGIN
- 
-      TEST ("CE3402C" , "CHECK END_OF_PAGE BEHAVIOR OF NEW_LINE");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_LINE_LENGTH (FILE,THREE);
-      SET_PAGE_LENGTH (FILE,TWO);
- 
-      FOR I IN 1..6
-      LOOP
-           PUT (FILE,CHAR);
-      END LOOP;
- 
-      NEW_LINE (FILE);
- 
-      IF PAGE (FILE) /= TWO THEN
-           FAILED ("PAGE NOT INCREMENTED BY ONE");
-      END IF;
- 
-      IF LINE (FILE) /= ONE THEN
-           FAILED ("LINE NOT SET TO ONE");
-      END IF;
- 
-      NEW_LINE (FILE, 7);
-      IF PAGE (FILE) /= POSITIVE_COUNT(IDENT_INT (5)) THEN
-           FAILED ("MULTIPLE PAGES NOT CREATED BY NEW_LINE");
-      END IF;
- 
-      SET_LINE_LENGTH (FILE, ORIGINAL_LINE_LENGTH);
-      SET_PAGE_LENGTH (FILE, ORIGINAL_PAGE_LENGTH);
-      CHECK_FILE (FILE, "CCC#CCC#@##@##@##@#@%");
- 
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3402C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,92 ****
- -- CE3402D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_LINE SETS THE CURRENT COLUMN NUMBER TO ONE,
- --     AND NEW_LINE OUTPUTS LINE TERMINATORS WHEN THE SPACING IS
- --     GREATER THAN ONE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATE WITH OUT_FILE MODE FOR TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/19/87  CHANGED FAILED MESSAGE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3402D IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
-      SPAC3 : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
-      FOUR : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4));
- 
- BEGIN
- 
-      TEST ("CE3402D",  "CHECK THAT NEW_LINE SETS THE CURRENT " &
-                        "COLUMN NUMBER TO ONE, AND NEW_LINE OUTPUTS " &
-                        "TERMINATORS WHEN THE SPACING IS " &
-                        "GREATER THAN ONE");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..5 LOOP
-           PUT (FILE, 'X');
-      END LOOP;
- 
-      NEW_LINE (FILE, SPAC3);
-      IF LINE (FILE) /= FOUR THEN
-           FAILED ("NEW_LINE DID NOT OUTPUT LINE TERMINATORS");
-      END IF;
- 
-      IF COL (FILE) /= ONE THEN
-           FAILED ("COLUMN NOT SET TO ONE");
-      END IF;
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3402D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- CE3402E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_LINE RAISES CONSTRAINT_ERROR IF SPACING IS
- --     ZERO, OR NEGATIVE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/16/82
- --     JBG 08/30/83
- --     DWC 08/19/87  ADDED COUNT'LAST CASE.
- --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3402E IS
- 
-      FILE : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3402E" , "CHECK THAT NEW_LINE RAISES CONSTRAINT_ERROR " &
-                        "IF SPACING IS ZERO, OR NEGATIVE");
- 
-      BEGIN
-           NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(0)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR ZERO");
-      END;
- 
-      BEGIN
-           NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(-2)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR NEGATIVE NUMBER");
-      END;
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      BEGIN
-           NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(0)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR ZERO");
-      END;
- 
-      BEGIN
-           NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(-2)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR NEGATIVE NUMBER");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3402E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- CE3403A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_LINE CAN ONLY BE APPLIED TO FILES OF MODE
- --     IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT CREATION OF TEMPORARY FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/16/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/04/87  REVISED EXCEPTION HANDLERS AND ADDED A CASE
- --                   FOR STANDARD_OUTPUT.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3403A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      SPAC : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
- 
- BEGIN
- 
-      TEST ("CE3403A" , "CHECK THAT SKIP_LINE CAN ONLY BE " &
-                        "APPLIED TO FILES OF MODE IN_FILE");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE OF " &
-                                "TEMPORARY FILE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           SKIP_LINE (FILE,SPAC);
-           FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR OUT_FILE");
-      END;
- 
-      BEGIN
-           SKIP_LINE (CURRENT_OUTPUT,SPAC);
-           FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                        "CURRENT_OUTPUT");
-      END;
- 
-      BEGIN
-           SKIP_LINE (STANDARD_OUTPUT,SPAC);
-           FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                        "STANDARD_OUTPUT");
-      END;
- 
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3403A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- CE3403B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE SPACING PARAMETER OF SKIP_LINE IS OPTIONAL,
- --     AND THAT THE DEFAULT VALUE IS ONE.
- --     CHECK THAT THE FILE PARAMETER IS ALSO OPTIONAL, AND THAT THE
- --     FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 12/14/82
- --     JBG 1/17/83
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/04/87  REVISED EXCEPTION HANDLERS, REMOVED
- --                   DEPENDENCIES ON RESET, AND ADDED AN ATTEMPT
- --                   TO DELETE FILE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3403B IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      SPAC, TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
-      A    : INTEGER := CHARACTER'POS('A');
-      CH   : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3403B" , "CHECK DEFAULT SPACING AND FILE " &
-                        "OF SKIP_LINE");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1 .. 3 LOOP          -- CREATES "BBB#CC#D##F#@%"
-           FOR J IN 1 .. 4-I LOOP
-                PUT (FILE, CHARACTER'VAL(A + I));
-           END LOOP;
-           NEW_LINE (FILE);
-      END LOOP;
-      NEW_LINE (FILE);
-      PUT (FILE, 'F');
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                "FOR IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      GET (FILE, CH);
-      IF CH /= CHARACTER'VAL (A + 1) THEN
-           FAILED ("LINE CONTENT WRONG - 1");
-      END IF;
- 
-      SKIP_LINE (FILE);
- 
-      IF LINE (FILE) /= TWO THEN
-           FAILED ("SPACING DEFAULT NOT ONE");
-      END IF;
- 
-      GET (FILE, CH);
-      IF CH /= CHARACTER'VAL (A + 2) THEN
-           FAILED ("LINE CONTENT WRONG - 2");
-      END IF;
- 
-      SET_INPUT (FILE);
-      SKIP_LINE (FILE);
- 
-      IF LINE (FILE) /= 3 THEN
-           FAILED ("SKIP_LINE DOES NOT OPERATE CORRECTLY ON " &
-                   "DEFAULT FILE");
-      END IF;
- 
-      GET (FILE, CH);
-      IF CH /= CHARACTER'VAL (A + 3) THEN
-           FAILED ("LINE CONTENT WRONG - 3");
-      END IF;
- 
-      SKIP_LINE;
- 
-      IF LINE (FILE) /= 4 THEN
-           FAILED ("LINE COUNT NOT 4; WAS " & COUNT'IMAGE(LINE(FILE)));
-      END IF;
- 
-      GET (FILE, CH);
-      IF CH /= 'F' THEN
-           FAILED ("NOT RIGHT LINE");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3403B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- CE3403C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_LINE SETS THE CURRENT COLUMN NUMBER TO ONE,
- --     AND THAT IT IS PERFORMED SPACING TIMES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/08/87  REVISED EXCEPTION HANDLING, REMOVED
- --                   DEPENDENCE ON RESET, AND ADDED NEW CASES.
- --     GJD 11/15/95  FIXED ADA 95 INCOMPATIBLE USE OF CHARACTER LITERALS.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3403C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
-      SPAC3 : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
-      FOUR : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4));
-      CH: CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3403C" , "CHECK THAT SKIP_LINE SETS THE CURRENT " &
-                        "COLUMN NUMBER TO ONE, AND THAT IT IS " &
-                        "PERFORMED SPACING TIMES");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN CHARACTER RANGE 'A' .. 'E' LOOP
-           FOR J IN 1 .. 3 LOOP
-                PUT (FILE, I);
-           END LOOP;
-           NEW_LINE (FILE);
-      END LOOP;
- 
-      CLOSE (FILE);
- 
-      BEGIN
-            OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                "FOR IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF COL (FILE) /= ONE THEN
-           FAILED ("COLUMN NOT SET TO ONE");
-      END IF;
- 
-      GET (FILE, CH);
- 
-      IF CH /= 'A' THEN
-           FAILED ("INCORRECT VALUE READ - 1");
-      END IF;
- 
-      SKIP_LINE (FILE,SPAC3);
-      GET (FILE, CH);
- 
-      IF CH /= 'D' THEN
-           FAILED ("INCORRECT VALUE READ - 2");
-      END IF;
- 
-      IF LINE (FILE) /= FOUR THEN
-           FAILED ("NOT PERFORMED SPACING TIMES");
-      END IF;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3403C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,99 ****
- -- CE3403D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_LINE RAISES CONSTRAINT_ERROR IF SPACING IS
- --     ZERO OR NEGATIVE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/16/82
- --     SPS 11/11/82
- --     DWC 09/09/87  ADDED CASE FOR COUNT'LAST.
- --     KAS 11/27/95  REMOVED CASES FOR COUNT'LAST
- --     TMB 11/19/96  FIXED OBJECTIVE
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3403D IS
- 
-      FILE : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3403D" , "CHECK THAT SKIP_LINE RAISES " &
-                        "CONSTRAINT_ERROR IF SPACING IS ZERO, " &
-                        "OR NEGATIVE" );
-      BEGIN
-           SKIP_LINE (FILE, POSITIVE_COUNT(IDENT_INT(0)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO");
-      END;
- 
-      BEGIN
-           SKIP_LINE (FILE, POSITIVE_COUNT(IDENT_INT(-2)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                        "NEGATIVE NUMBER");
-      END;
- 
- 
-      BEGIN
-           SKIP_LINE (POSITIVE_COUNT(IDENT_INT(0)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO - DEFAULT");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO " &
-                        "- DEFAULT");
-      END;
- 
-      BEGIN
-           SKIP_LINE (POSITIVE_COUNT(IDENT_INT(-6)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUM " &
-                   "- DEFAULT");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED NEGATIVE NUM " &
-                        "- DEFAULT");
-      END;
- 
- 
-      RESULT;
- 
- END CE3403D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- CE3403E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_LINE INCREMENTS THE CURRENT LINE NUMBER BY ONE
- --     AND SETS THE CURRENT COLUMN NUMBER TO ONE IF THE LINE TERMINATOR
- --     IS NOT FOLLOWED BY A PAGE TERMINATOR, AND THAT IT SETS BOTH THE
- --     LINE AND COLUMN NUMBERS TO ONE AND INCREMENTS THE CURRENT PAGE
- --     NUMBER BY ONE IF THE LINE TERMINATOR IS FOLLOWED BY A PAGE
- --     TERMINATOR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/20/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/09/87  REVISED TEST TO USE A FILE NAME, REMOVED
- --                   DEPENDENCE ON RESET, AND ATTEMPTED TO
- --                   DELETE THE FILE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3403E IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      ONE  : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
-      TWO  : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
-      CHAR : CHARACTER := ('C');
- 
- BEGIN
- 
-      TEST ("CE3403E" , "CHECK THAT SKIP_LINE SETS COLUMN, " &
-                        "LINE, AND PAGE NUMBERS CORRECTLY");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, CHAR);
-      NEW_LINE (FILE);
-      PUT (FILE, CHAR);
-      NEW_PAGE (FILE);
-      PUT (FILE, CHAR);
- 
-       CLOSE (FILE);
- 
-      BEGIN
-            OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                "WITH IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF (LINE (FILE) /= ONE) OR (PAGE (FILE) /= ONE) THEN
-           FAILED ("INCORRECT LINE AND PAGE NUMBERS");
-      ELSE
- 
- -- LINE TERMINATOR NOT FOLLOWED BY PAGE TERMINATOR
- 
-           GET (FILE, CHAR);
- 
-           IF CHAR /= 'C' THEN
-                FAILED ("INCORRECT VALUE READ - 1");
-           END IF;
- 
-           SKIP_LINE (FILE);
-           IF LINE (FILE) /= TWO THEN
-                FAILED ("FIRST SUBTEST - LINE NOT INCREMENTED");
-           END IF;
-           IF COL (FILE) /= ONE THEN
-                FAILED ("FIRST SUBTEST - COLUMN NOT SET TO ONE");
-           END IF;
- 
- -- LINE TERMINATOR FOLLOWED BY PAGE TERMINATOR
- 
-           GET (FILE, CHAR);
- 
-           IF CHAR /= 'C' THEN
-                FAILED ("INCORRECT VALUE READ - 2");
-           END IF;
- 
-           SKIP_LINE (FILE);
-           IF LINE (FILE) /= ONE THEN
-                FAILED ("SECOND SUBTEST - LINE NOT SET TO ONE");
-           END IF;
-           IF COL (FILE) /= ONE THEN
-                FAILED ("SECOND SUBTEST - COLUMN NOT SET TO ONE");
-           END IF;
-           IF PAGE (FILE) /= TWO THEN
-                FAILED ("SECOND SUBTEST - PAGE NOT INCREMENTED");
-           END IF;
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3403E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,156 ****
- -- CE3403F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_LINE RAISES END_ERROR IF AN ATTEMPT IS
- --     MADE TO SKIP A FILE TERMINATOR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 11/11/82
- --     SPS 12/14/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/09/87  REVISED TEST TO USE A FILE NAME, REMOVED
- --                   DEPENDENCE ON RESET, AND ADDED ATTEMPT TO
- --                   DELETE THE FILE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3403F IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      CHAR : CHARACTER := ('C');
-      ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT (1));
-      TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT (2));
- 
- BEGIN
-      TEST ("CE3403F" , "CHECK THAT SKIP_LINE RAISES END_ERROR " &
-                        "IF AN ATTEMPT IS MADE TO SKIP A FILE " &
-                        "TERMINATOR");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..3
-      LOOP
-           PUT (FILE,CHAR);
-      END LOOP;
- 
-       CLOSE (FILE);
- 
-      BEGIN
-            OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                "FOR IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           GET (FILE, CHAR);
-           IF CHAR /= 'C' THEN
-                FAILED ("INCORRECT VALUE READ");
-           END IF;
- 
-           SKIP_LINE (FILE);
-           SKIP_LINE (FILE);
-           FAILED ("END_ERROR NOT RAISED - 1");
-      EXCEPTION
-           WHEN END_ERROR =>
- 
-                IF COL (FILE) /= ONE THEN
-                     FAILED ("COL NOT RESET CORRECTLY");
-                END IF;
- 
-                IF NOT END_OF_FILE (FILE) THEN
-                     FAILED ("NOT POSITIONED AT END OF FILE");
-                END IF;
- 
-                IF PAGE (FILE) /= TWO THEN
-                     FAILED ("PAGE NOT INCREMENTED");
-                END IF;
- 
-                IF LINE (FILE) /= ONE THEN
-                     FAILED ("LINE NOT RESET CORRECTLY");
-                END IF;
- 
-                IF NOT END_OF_LINE (FILE) THEN
-                     FAILED ("EOL FALSE AT FILE TERMINATOR");
-                END IF;
- 
-                IF NOT END_OF_PAGE (FILE) THEN
-                     FAILED ("EOP FALSE AT FILE TERMINATOR");
-                END IF;
- 
-                BEGIN
-                     SKIP_LINE (FILE);
-                     FAILED ("END_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
-                END;
- 
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3403F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,94 ****
- -- CE3404A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_LINE RAISES MODE_ERROR WHEN APPLIED TO
- --     AN OUT_FILE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/17/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 29/28/87  COMPLETELY REVISED.
- 
- WITH REPORT;  USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3404A IS
- 
-      MY_FILE : FILE_TYPE;
-      BOOL    : BOOLEAN;
- 
- BEGIN
- 
-      TEST ("CE3404A", "CHECK THAT END_OF_LINE RAISES MODE_ERROR " &
-                       "WHEN APPLIED TO AN OUT_FILE");
- 
-      BEGIN
-           BOOL := END_OF_FILE (CURRENT_OUTPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT - 1");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                        "CURRENT_OUTPUT - 2");
-      END;
- 
-      BEGIN
-           BOOL := END_OF_FILE (STANDARD_OUTPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT - 3");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                        "STANDARD_OUTPUT - 4");
-      END;
- 
-      BEGIN
-           CREATE (MY_FILE);
-           BEGIN
-                BOOL := END_OF_FILE (MY_FILE);
-                FAILED ("MODE_ERROR NOT RAISED FOR MY_FILE - 5");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                             "MY_FILE - 6");
- 
-           END;
- 
-           CLOSE (MY_FILE);
- 
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3404A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- CE3404B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_LINE OPERATES ON THE CURRENT DEFAULT INPUT FILE
- --     IF NO FILE IS SPECIFIED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW  08/26/82
- --     SPS  09/17/82
- --     SPS  11/11/82
- --     TBN  11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                    RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT  09/22/87  CREATED A NON-TEMP FILE, REMOVED DEPENDENCE ON
- --                    RESET, AND CHECKED THE VALUE OF THE CHAR READ.
- 
- WITH REPORT;  USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3404B IS
- 
-      INCOMPLETE : EXCEPTION;
-      MY_FILE    : FILE_TYPE;
-      LOOP_COUNT : INTEGER := 0;
-      BOOL       : BOOLEAN;
-      CHAR       : CHARACTER := ('C');
- 
- BEGIN
- 
-      TEST ("CE3404B", "CHECK THAT END_OF_LINE OPERATES ON THE " &
-                       "CURRENT DEFAULT INPUT FILE IF NO FILE " &
-                       "IS SPECIFIED");
- 
- --   CREATE AND INITIALIZE THE FILE
- 
-      BEGIN
-           CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE - 1");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE - 2");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE - 3");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..3 LOOP
-           PUT (MY_FILE,CHAR);
-      END LOOP;
-      NEW_LINE (MY_FILE);
-      PUT (MY_FILE,CHAR);
- 
-      CLOSE (MY_FILE);
- 
-      BEGIN
-           OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE ERROR RAISED ON ATTEMPT TO " &
-                                "RE-OPEN WITH MODE OF IN_FILE - 4");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_INPUT (MY_FILE);
- 
- --   START THE TEST
- 
-      LOOP
-           GET (CHAR);
-           IF CHAR /= 'C' THEN
-                FAILED ("CHAR READ FROM FILE HAS WRONG VALUE - 5");
-                RAISE INCOMPLETE;
-           END IF;
-      EXIT WHEN END_OF_LINE;
-           LOOP_COUNT := LOOP_COUNT + 1;
-           IF LOOP_COUNT > IDENT_INT (3) THEN
-                FAILED ("END_OF_LINE ON DEFAULT INCORRECT - 6");
-                EXIT;
-           END IF;
-      END LOOP;
- 
-      GET (CHAR);
-      IF CHAR /= 'C' THEN
-           FAILED ("FINAL CHAR READ FROM FILE HAS WRONG VALUE - 7");
-      END IF;
- 
-      BEGIN
-           DELETE (MY_FILE);
-      EXCEPTION
-           WHEN OTHERS =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3404B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,165 ****
- -- CE3404C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_LINE RETURNS THE CORRECT VALUE WHEN POSITIONED
- --     AT THE BEGINNING AND THE END OF A LINE, AND WHEN POSITIONED JUST
- --     BEFORE THE FILE TERMINATOR.
- 
- --          CASE 1)  BOUNDED LINE LENGTH
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/17/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     GMT 09/22/87  REMOVED DEPENDENCE ON RESET AND MOVED THE CHECK
- --                   FOR UNBOUNDED LINE_LENGTH TO CE3404D.ADA.
- 
- WITH REPORT;  USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3404C IS
-      INCOMPLETE     : EXCEPTION;
-      MY_FILE        : FILE_TYPE;
-      ITEM_CHAR      : CHARACTER;
-      CHAR           : CHARACTER := ('C');
-      TEN            : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(10));
-      BLANK_COUNTER  : NATURAL := 0;
- 
- BEGIN
- 
-      TEST ("CE3404C", "CHECK THAT END_OF_LINE RETURNS THE CORRECT " &
-                       "VALUE WHEN POSITIONED AT THE BEGINNING " &
-                       "AND THE END OF A LINE, AND WHEN POSITIONED " &
-                       "JUST BEFORE THE FILE TERMINATOR");
- 
- --   CREATE AND INITIALIZE TEST FILE WITH BOUNDED LINE LENGTH
- 
-      BEGIN
-           CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_LINE_LENGTH (MY_FILE,TEN);
- 
-      FOR I IN 1..5 LOOP
-           PUT (MY_FILE, CHAR);
-      END LOOP;
-      NEW_LINE (MY_FILE);
-      PUT (MY_FILE, 'B');
- 
-      CLOSE (MY_FILE);
- 
-      BEGIN
-           OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
- --   BEGIN THE TEST
- 
-      IF END_OF_LINE (MY_FILE) THEN
-           FAILED ("END_OF_LINE: INCORRECT VALUE AT FIRST POSITION - 5");
-      END IF;
- 
-      IF COL (MY_FILE) /= 1 THEN
-           FAILED ("EOL MODIFIED COL NUMBER - 6");
-      END IF;
- 
-      FOR I IN 1..4 LOOP
-           GET (MY_FILE,ITEM_CHAR);
-      END LOOP;
- 
-      IF END_OF_LINE (MY_FILE) THEN
-           FAILED ("END_OF_LINE: INCORRECT VALUE AT FIFTH POSITION - 7");
-      END IF;
- 
-      GET (MY_FILE,ITEM_CHAR);
- 
-      WHILE NOT END_OF_LINE (MY_FILE) LOOP
-           GET (MY_FILE, ITEM_CHAR);
-           IF ITEM_CHAR = ' ' THEN
-                BLANK_COUNTER := BLANK_COUNTER + 1;
-           ELSE
-                FAILED ("STRING WAS PADDED WITH SOMETHING OTHER THAN " &
-                        "BLANKS - 8");
-           END IF;
-      END LOOP;
- 
-      IF BLANK_COUNTER > 5 THEN
-           FAILED ("TOO MANY BLANKS WERE USED FOR PADDING - 9");
-      END IF;
- 
-      IF LINE (MY_FILE) /= 1 THEN
-           FAILED ("EOL SKIPPED LINE TERMINATOR - 10");
-      END IF;
- 
-      IF NOT END_OF_LINE (MY_FILE) THEN
-           FAILED ("EOL SKIPPED LINE TERMINATOR - 11");
-      END IF;
- 
-      SKIP_PAGE (MY_FILE);
- 
-      IF PAGE (MY_FILE) /= 2 THEN
-           FAILED ("INCORRECT PAGE NUMBER");
-      END IF;
- 
-      IF NOT END_OF_LINE (MY_FILE) THEN
-           FAILED ("INCORRECT VALUE WHEN POSITIONED JUST BEFORE FILE " &
-                   "TERMINATOR");
-      END IF;
- 
-      BEGIN
-           DELETE (MY_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3404C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- CE3404D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_LINE RETURNS THE CORRECT VALUE WHEN POSITIONED
- --     AT THE BEGINNING AND THE END OF A LINE, AND WHEN POSITIONED JUST
- --     BEFORE THE FILE TERMINATOR.
- 
- --          CASE 2)  UNBOUNDED LINE LENGTH
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     GMT  09/22/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;  USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3404D IS
-      INCOMPLETE     : EXCEPTION;
-      MY_FILE        : FILE_TYPE;
-      ITEM_CHAR      : CHARACTER;
-      CHAR           : CHARACTER := ('C');
-      TEN            : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(10));
-      BLANK_COUNTER  : NATURAL := 0;
- 
- BEGIN
- 
-      TEST ("CE3404D", "CHECK THAT END_OF_LINE RETURNS THE CORRECT " &
-                       "VALUE WHEN POSITIONED AT THE BEGINNING AND " &
-                       "THE END OF A LINE, AND WHEN POSITIONED JUST " &
-                       "BEFORE THE FILE TERMINATOR");
- 
- --   CREATE AND INITIALIZE TEST FILE WITH BOUNDED LINE LENGTH
- 
-      BEGIN
-           CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..5 LOOP
-           PUT (MY_FILE, CHAR);
-      END LOOP;
-      NEW_LINE (MY_FILE);
-      PUT (MY_FILE, 'B');
- 
-      CLOSE (MY_FILE);
- 
-      BEGIN
-           OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
- --   BEGIN THE TEST
- 
-      IF END_OF_LINE (MY_FILE) THEN
-           FAILED ("END_OF_LINE: INCORRECT VALUE AT FIRST POSITION - 5");
-      END IF;
- 
-      IF COL (MY_FILE) /= 1 THEN
-           FAILED ("EOL MODIFIED COL NUMBER - 6");
-      END IF;
- 
-      FOR I IN 1..4 LOOP
-           GET (MY_FILE,ITEM_CHAR);
-      END LOOP;
- 
-      IF END_OF_LINE (MY_FILE) THEN
-           FAILED ("END_OF_LINE: INCORRECT VALUE AT FIFTH POSITION - 7");
-      END IF;
- 
-      GET (MY_FILE,ITEM_CHAR);
- 
-      WHILE NOT END_OF_LINE (MY_FILE) LOOP
-           GET (MY_FILE, ITEM_CHAR);
-           IF ITEM_CHAR = ' ' THEN
-                FAILED ("STRING WAS PADDED WITH SOMETHING OTHER THAN " &
-                        "BLANKS - 8");
-           END IF;
-      END LOOP;
- 
-      IF LINE (MY_FILE) /= 1 THEN
-           FAILED ("EOL SKIPPED LINE TERMINATOR - 10");
-      END IF;
- 
-      IF NOT END_OF_LINE (MY_FILE) THEN
-           FAILED ("EOL SKIPPED LINE TERMINATOR - 11");
-      END IF;
- 
-      SKIP_PAGE (MY_FILE);
- 
-      IF PAGE (MY_FILE) /= 2 THEN
-           FAILED ("INCORRECT PAGE NUMBER");
-      END IF;
- 
-      IF NOT END_OF_LINE (MY_FILE) THEN
-           FAILED ("INCORRECT VALUE WHEN POSITIONED JUST BEFORE " &
-                   "TERMINATOR");
-      END IF;
- 
-      BEGIN
-           DELETE (MY_FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3404D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- CE3405A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_PAGE OUTPUTS A LINE TERMINATOR FOLLOWED BY A PAGE
- --     TERMINATOR IF THE CURRENT LINE IS NOT AT COLUMN 1 OR IF THE
- --     CURRENT PAGE IS AT LINE 1;  IF THE CURRENT LINE IS AT COLUMN 1,
- --     OUTPUTS A PAGE TERMINATOR ONLY.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     ABW 09/02/82
- --     JBG 01/18/83
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/23/87  ADDED A CASE WHICH CALLS NEW_LINE AND NEW_PAGE
- --                   CONSECUTIVELY AND SEPARATED CASES INTO DIFFERENT
- --                   IF STATEMENTS.  ADDED CHECK FOR USE_ERROR ON
- --                   DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3405A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE  : FILE_TYPE;
-      ONE   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
-      TWO   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
-      THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
-      FOUR  : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4));
-      CHAR  : CHARACTER := ('C');
- 
- BEGIN
- 
-      TEST ("CE3405A", "CHECK THAT NEW_PAGE OUTPUTS A LINE TERMINATOR " &
-                       "FOLLOWED BY A PAGE TERMINATOR IF THE CURRENT " &
-                       "LINE IS NOT AT COLUMN 1 OR IF THE CURRENT " &
-                       "PAGE IS AT LINE 1;  IF THE CURRENT LINE IS AT " &
-                       "COLUMN 1, OUTPUTS A PAGE TERMINATOR ONLY");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      NEW_PAGE (FILE);
-      NEW_PAGE (FILE);                   -- CURRENT PAGE TERMINATED
-      IF PAGE (FILE) /= THREE THEN
-           FAILED ("INITIAL PAGE COUNT INCORRECT");
-      END IF;
- 
-      SET_LINE_LENGTH (FILE,THREE);
-      PUT (FILE,CHAR);
-      NEW_LINE (FILE);
- 
-      IF LINE (FILE) /= TWO THEN
-           FAILED ("INCORRECT LINE NUMBER - 1");
-      END IF;
- 
-      IF PAGE (FILE) /= THREE THEN
-           FAILED ("INCORRECT PAGE NUMBER - 2");
-      END IF;
- 
-      NEW_PAGE (FILE);             -- CURRENT LINE TERMINATED (B)
-      IF LINE (FILE) /= ONE THEN
-           FAILED ("LINE NUMBER NOT INCREMENTED");
-      END IF;
-      IF PAGE (FILE) /= FOUR THEN
-           FAILED ("PAGE NUMBER NOT INCREMENTED");
-      END IF;
-      PUT (FILE, IDENT_CHAR('E'));  -- CURRENT LINE NOT TERM (C)
-      NEW_PAGE (FILE);
-      NEW_LINE (FILE);
-      NEW_PAGE (FILE);
- 
-      CHECK_FILE (FILE, "#@#@C#@E#@#@%");
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3405A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,126 ****
- -- CE3405C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_PAGE RAISES MODE_ERROR IF THE FILE SPECIFIED
- --     HAS MODE IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/23/87  CREATED AN EXTERNAL FILE, REMOVED DEPENDENCE ON
- --                   RESET, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3405C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3405C", "CHECK THAT NEW_PAGE RAISES MODE_ERROR IF THE " &
-                       "FILE SPECIFIED HAS MODE IN_FILE");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, "STUFF");
- 
-      CLOSE (FILE);
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                "WITH IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           NEW_PAGE (FILE);
-           FAILED ("MODE_ERROR NOT RAISED FOR IN_FILE");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR IN_FILE");
-      END;
- 
-      BEGIN
-           NEW_PAGE (STANDARD_INPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_INPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_INPUT");
-      END;
- 
-      BEGIN
-           NEW_PAGE (CURRENT_INPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_INPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_INPUT");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3405C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,114 ****
- -- CE3405D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_PAGE INCREMENTS THE CURRENT PAGE NUMBER AND
- --     SETS THE CURRENT COLUMN AND LINE NUMBERS TO ONE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 08/28/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/23/87  CORRECTED EXCEPTION HANDLING AND ADDED CASES FOR
- --                   CONSECUTIVE NEW_LINE AND NEW_PAGE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3405D IS
-      INCOMPLETE : EXCEPTION;
- BEGIN
- 
-      TEST ("CE3405D", "CHECK THAT NEW_PAGE INCREMENTS PAGE COUNT " &
-                       "AND SETS COLUMN AND LINE TO ONE");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           CH : CHARACTER;
-           PG_NUM : POSITIVE_COUNT;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "FOR TEMP FILE WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "STRING");
-           NEW_LINE (FT);
-           PUT (FT, 'X');
-           PG_NUM := PAGE (FT);
- 
-           NEW_PAGE (FT);
- 
-           IF COL(FT) /= 1 THEN
-                FAILED ("COLUMN NUMBER NOT RESET - OUTPUT - 1");
-           END IF;
-           IF LINE (FT) /= 1 THEN
-                FAILED ("LINE NUMBER NOT RESET - OUTPUT - 1");
-           END IF;
-           IF PAGE (FT) /= PG_NUM + 1 THEN
-                FAILED ("PAGE NUMBER NOT INCREMENTED - OUTPUT - 1");
-           END IF;
- 
-           PUT (FT, "MORE STUFF");
-           NEW_LINE (FT);
-           NEW_PAGE (FT);
- 
-           IF COL(FT) /= 1 THEN
-                FAILED ("COLUMN NUMBER NOT RESET - OUTPUT - 2");
-           END IF;
-           IF LINE (FT) /= 1 THEN
-                FAILED ("LINE NUMBER NOT RESET - OUTPUT - 2");
-           END IF;
-           IF PAGE (FT) /= PG_NUM + 2 THEN
-                FAILED ("PAGE NUMBER NOT INCREMENTED - OUTPUT - 2");
-           END IF;
- 
-           CHECK_FILE (FT, "STRING#X#@MORE STUFF#@%");
- 
-           CLOSE (FT);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3405D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- CE3406A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_PAGE READS AND DISCARDS CHARACTERS AND LINE
- --     TERMINATORS UNTIL A PAGE TERMINATOR IS READ, ADDS ONE TO THE
- --     CURRENT PAGE NUMBER, AND SETS THE CURRENT COLUMN NUMBER AND LINE
- --     NUMBER TO ONE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/17/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/24/87  CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE
- --                   ON RESET, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3406A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      CHAR_X : CHARACTER := ('X');
-      ITEM_CHAR : CHARACTER;
-      ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
-      TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
-      THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
- 
- BEGIN
- 
-      TEST ("CE3406A", "CHECK THAT SKIP_LINE READS AND " &
-                       "SETS PAGE AND COLUMN CORRECTLY");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, "CDE");
-      NEW_LINE (FILE);
-      PUT (FILE, "FGHI");
-      NEW_LINE (FILE);
-      PUT (FILE, "JK");
-      NEW_PAGE (FILE);
-      NEW_PAGE (FILE);
-      PUT (FILE,CHAR_X);
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF (LINE (FILE) /= ONE) THEN
-           FAILED ("LINE NUMBER NOT EQUAL TO ONE");
-      END IF;
- 
-      IF (PAGE (FILE) /= ONE) THEN
-           FAILED ("PAGE NUMBER NOT EQUAL TO ONE");
-      END IF;
- 
-      GET (FILE, ITEM_CHAR);
- 
-      IF ITEM_CHAR /= 'C' THEN
-           FAILED ("INCORRECT VALUE READ FROM FILE - 1");
-      END IF;
- 
-      SKIP_PAGE (FILE);
- 
-      IF COL (FILE) /= ONE THEN
-           FAILED ("COLUMN NOT SET TO ONE - 1");
-      END IF;
- 
-      IF LINE (FILE) /= ONE THEN
-           FAILED ("LINE NOT SET TO ONE - 1");
-      END IF;
- 
-      IF PAGE (FILE) /= TWO THEN
-           FAILED ("PAGE NOT SET TO TWO");
-      END IF;
- 
-      SKIP_PAGE (FILE);
- 
-      IF COL (FILE) /= ONE THEN
-           FAILED ("COLUMN NOT SET TO ONE - 2");
-      END IF;
- 
-      IF LINE (FILE) /= ONE THEN
-           FAILED ("LINE NOT SET TO ONE - 2");
-      END IF;
- 
-      IF PAGE (FILE) /= THREE THEN
-           FAILED ("PAGE NOT SET TO THREE");
-      END IF;
- 
-      GET (FILE, ITEM_CHAR);
-      IF ITEM_CHAR /= 'X' THEN
-           FAILED ("INCORRECT VALUE READ FROM FILE - 2");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3406A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- CE3406B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_PAGE CAN ONLY BE APPLIED TO FILES OF MODE
- --     IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILE CREATE WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/24/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3406B IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3406B", "CHECK THAT SKIP_PAGE CAN ONLY BE " &
-                       "APPLIED TO FILES OF MODE IN_FILE");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                "FOR TEMPORARY FILE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           SKIP_PAGE (FILE);
-           FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR OUT_FILE");
-      END;
- 
-      BEGIN
-           SKIP_PAGE (STANDARD_OUTPUT);
-           FAILED ("MODE_ERROR RAISED FOR STANDARD_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_OUTPUT");
-      END;
- 
-      BEGIN
-           SKIP_PAGE (CURRENT_OUTPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_OUTPUT");
-      END;
- 
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3406B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,148 ****
- -- CE3406C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_PAGE RAISES END_ERROR WHEN THE FILE IS POSITIONED
- --     BEFORE THE FILE TERMINATOR BUT NOT WHEN THE FILE IS POSITIONED
- --     BEFORE THE FINAL PAGE TERMINATOR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/17/82
- --     JBG 01/24/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/24/87  CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE
- --                   ON RESET, AND CHECKED CHARACTER READ IN.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3406C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      CHAR : CHARACTER := ('C');
-      ITEM_CHAR : CHARACTER;
-      TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
- 
- BEGIN
- 
-      TEST ("CE3406C", "CHECK THAT SKIP_PAGE RAISES END_ERROR WHEN " &
-                       "THE FILE IS POSITIONED BEFORE THE FILE " &
-                       "TERMINATOR BUT NOT WHEN THE FILE IS " &
-                       "POSITIONED BEFORE THE FINAL PAGE TERMINATOR");
- 
- -- CREATE AND INITIALIZE FILE
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..2 LOOP
-           FOR I IN 1..3 LOOP
-                PUT (FILE,CHAR);
-           END LOOP;
-           NEW_LINE (FILE);
-      END LOOP;
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- START TEST
- 
- -- TEST SKIP_PAGE BEFORE FINAL PAGE TERMINATOR
- 
-      WHILE NOT END_OF_PAGE (FILE) LOOP
-           GET (FILE, ITEM_CHAR);
-           IF ITEM_CHAR /= 'C' THEN
-                FAILED ("INCORRECT VALUE READ FROM FILE");
-           END IF;
-      END LOOP;
- 
-      BEGIN
-           SKIP_PAGE (FILE);
-      EXCEPTION
-           WHEN END_ERROR =>
-                FAILED ("RAISED END_ERROR BEFORE FINAL PAGE " &
-                        "TERMINATOR - 1");
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 1");
-      END;
- 
-      IF PAGE (FILE) /= TWO THEN
-           FAILED ("PAGE NOT SET TO TWO");
-      END IF;
- 
- -- TEST SKIP_PAGE BEFORE FILE TERMINATOR
-      BEGIN
-           SKIP_PAGE (FILE);
-           FAILED ("END_ERROR NOT RAISED");
-      EXCEPTION
-           WHEN END_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED - 2");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3406C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- CE3406D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SKIP_PAGE OPERATES ON THE CURRENT DEFAULT INPUT
- --     FILE WHEN NO FILE IS SPECIFIED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     JBG 01/26/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/24/87  CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE
- --                   ON RESET, AND CHECKED CHARACTER READ IN.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3406D IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      ITEM_CHAR : CHARACTER;
-      TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
-      THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
- 
- BEGIN
- 
-      TEST ("CE3406D", "CHECK THAT SKIP_PAGE OPERATES ON THE CURRENT " &
-                       "DEFAULT INPUT FILE WHEN NO FILE IS SPECIFIED");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, "ABC");
-      NEW_PAGE (FILE);
-      PUT (FILE, "DEF");
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_INPUT (FILE);
- 
-      SKIP_PAGE;
- 
-      GET (FILE, ITEM_CHAR);
-      IF ITEM_CHAR /= 'D' THEN
-           FAILED ("INCORRECT VALUE READ FROM FILE");
-      END IF;
- 
-      IF PAGE (CURRENT_INPUT) /= TWO THEN
-           FAILED ("SKIP_PAGE NOT APPLIED TO CURRENT_INPUT");
-      END IF;
- 
-      SKIP_PAGE (FILE);
- 
-      IF PAGE (CURRENT_INPUT) /= THREE THEN
-           FAILED ("SKIP_PAGE NOT APPLIED TO CURRENT_INPUT");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3406D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- CE3407A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_PAGE RETURNS THE CORRECT VALUE WHEN POSITIONED
- --     AT THE BEGINNING AND AT THE END OF THE PAGE, AND BEFORE A FILE
- --     TERMINATOR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/22/82
- --     JBG 01/26/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/28/87  REMOVED UNNECESSARY CODE, REMOVED DEPENDENCE
- --                   ON RESET AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3407A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE1 : FILE_TYPE;
-      CHAR  : CHARACTER := ('C');
-      ITEM_CHAR : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3407A", "CHECK THAT END_OF_PAGE RETURNS " &
-                       "THE CORRECT VALUE");
- 
- -- CREATE & INITIALIZE OUTPUT FILE
- 
-      BEGIN
-           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..6 LOOP
-           PUT (FILE1, CHAR);
-      END LOOP;
- 
-      CLOSE (FILE1);
- 
-      BEGIN
-           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF END_OF_PAGE (FILE1) THEN
-           FAILED ("INCORRECT VALUE AT FIRST POSITION - 1");
-      END IF;
- 
-      IF END_OF_PAGE (FILE1) THEN
-           FAILED ("INCORRECT VALUE AT FIRST POSITION - 2");
-      END IF;
- 
- -- TEST WHEN POSITIONED BEFORE LAST CHARACTER IN FILE
- 
-      FOR I IN 1..5 LOOP
-           GET (FILE1, ITEM_CHAR);
-      END LOOP;
- 
-      IF END_OF_PAGE (FILE1) THEN
-           FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER");
-      END IF;
- 
- -- TEST WHEN AT END OF FILE
- 
-      GET (FILE1, ITEM_CHAR);
-      IF NOT END_OF_PAGE (FILE1) THEN
-           FAILED ("INCORRECT VALUE AT LAST POSITION");
-      END IF;
- 
-      SKIP_PAGE (FILE1);
- 
-      IF NOT END_OF_PAGE (FILE1) THEN
-           FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 1");
-      END IF;
- 
-      IF NOT END_OF_PAGE (FILE1) THEN
-           FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 2");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE1);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3407A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- CE3407B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_PAGE CAN ONLY BE APPLIED TO FILES OF MODE
- --     IN_FILE, THAT MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/22/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/28/87  CORRECTED EXCEPTION HANDLING AND ADDED CASE
- --                   FOR CURRENT_OUTPUT.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3407B IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      BOOL : BOOLEAN;
- 
- BEGIN
- 
-      TEST ("CE3407B", "CHECK THAT END_OF_PAGE RAISES MODE_ERROR " &
-                       "FOR FILES OF MODE OUT_FILE");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
-                                "TEMPORARY FILE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           BOOL := END_OF_PAGE (FILE);
-           FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR OUT_FILE");
-      END;
- 
-      BEGIN
-           BOOL := END_OF_PAGE (STANDARD_OUTPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_OUTPUT");
-      END;
- 
-      BEGIN
-           BOOL := END_OF_PAGE (CURRENT_OUTPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_OUTPUT");
-      END;
- 
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3407B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- CE3407C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FILE PARAMETER OF END_OF_PAGE IS OPTIONAL, AND
- --     THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT
- --     FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/28/87  REMOVED DEPENDENCE ON RESET, ADDED MORE CASES FOR
- --                   END_OF_PAGE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3407C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE_IN : FILE_TYPE;
-      CHAR : CHARACTER := 'C';
-      ITEM_CHAR : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3407C", "CHECK THAT THE FILE PARAMETER OF END_OF_PAGE " &
-                       "IS OPTIONAL, AND THAT THE FUNCTION IS THEN " &
-                       "APPLIED TO THE CURRENT DEFAULT INPUT FILE");
- 
-      BEGIN
-           CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..3 LOOP
-           PUT (FILE_IN, CHAR);
-      END LOOP;
-      NEW_PAGE (FILE_IN);
-      PUT (FILE_IN, 'D');
- 
-      CLOSE (FILE_IN);
- 
-      BEGIN
-           OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_INPUT (FILE_IN);
- 
-      IF END_OF_PAGE THEN
-           FAILED ("INCORRECT VALUE AT FIRST POSITION");
-      END IF;
- 
-      IF END_OF_PAGE /= END_OF_PAGE (FILE_IN) THEN
-           FAILED ("END OF PAGE DOES NOT OPERATE WITH DEFAULT FILE");
-      END IF;
- 
-      GET (ITEM_CHAR);
-      GET (ITEM_CHAR);
-      GET (ITEM_CHAR);
- 
-      IF END_OF_PAGE /= TRUE THEN
-           FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR");
-      END IF;
- 
-      IF END_OF_PAGE /= END_OF_PAGE (FILE_IN) THEN
-           FAILED ("END_OF_PAGE WITHOUT PARAMETER DOES " &
-                   "NOT OPERATE ON THE DEFAULT INPUT FILE");
-      END IF;
- 
-      GET (ITEM_CHAR);
- 
-      IF NOT (END_OF_PAGE) THEN
-           FAILED ("INCORRECT VALUE AT LAST POSITION");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE_IN);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3407C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- CE3408A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_FILE RETURNS TRUE ONLY IF POSITIONED BEFORE THE
- --     FINAL PAGE TERMINATOR OR BEFORE THE FILE TERMINATOR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     JBG 01/26/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3408A IS
- 
-      INCOMPLETE : EXCEPTION;
-      COUNT      : INTEGER := 0;
-      FILE       : FILE_TYPE;
-      CHAR       : CHARACTER := ('C');
-      ITEM_CHAR  : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3408A", "CHECK THAT END_OF_FILE RETURNS " &
-                       "THE CORRECT VALUE");
- 
- -- CREATE & INITIALIZE OUTPUT FILE.
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..6 LOOP
-           PUT (FILE, CHAR);
-      END LOOP;
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
- -- TEST WHEN POSITIONED TO BEGINNING OF FILE.
- 
-      IF END_OF_FILE (FILE) THEN
-           FAILED ("INCORRECT VALUE AT FIRST POSITION - 1");
-      END IF;
- 
-      IF END_OF_FILE (FILE) THEN
-           FAILED ("INCORRECT VALUE AT FIRST POSITION - 2");
-      END IF;
- 
- -- TEST WHEN POSITIONED BEFORE LAST CHARACTER IN FILE.
- 
-      FOR I IN 1..5 LOOP
-           GET (FILE, ITEM_CHAR);
-      END LOOP;
- 
-      IF END_OF_FILE (FILE) THEN
-           FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER");
-      END IF;
- 
- -- TEST WHEN AT END OF FILE.
- 
-      GET (FILE, ITEM_CHAR);
-      IF NOT END_OF_FILE (FILE) THEN
-           FAILED ("INCORRECT VALUE AT LAST POSITION");
-      END IF;
- 
-      SKIP_PAGE (FILE);
- 
-      IF NOT END_OF_FILE (FILE) THEN
-           FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 1");
-      END IF;
- 
-      IF NOT END_OF_FILE (FILE) THEN
-           FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 2");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3408A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- CE3408B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_OF_FILE CAN ONLY BE APPLIED TO FILES OF MODE
- --     IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/20/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  CORRECTED EXCEPTION HANDLING, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3408B IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      BOOL : BOOLEAN;
- 
- BEGIN
- 
-      TEST ("CE3408B", "CHECK THAT END_OF_FILE CAN ONLY BE " &
-                       "APPLIED TO FILES OF MODE IN_FILE");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
-                                "TEMPORARY FILE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           BOOL := END_OF_FILE (FILE);
-           FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR OUT_FILE");
-      END;
- 
-      BEGIN
-           BOOL := END_OF_FILE (STANDARD_OUTPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                        "STANDARD_OUTPUT");
-      END;
- 
-      BEGIN
-           BOOL := END_OF_FILE (CURRENT_OUTPUT);
-           FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
-      EXCEPTION
-           WHEN MODE_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
-                        "CURRENT_OUTPUT");
-      END;
- 
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3408B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- CE3408C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FILE PARAMETER OF END_OF_FILE IS OPTIONAL, AND
- --     THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT
- --     FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3408C IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE_IN : FILE_TYPE;
-      CHAR : CHARACTER := 'A';
-      ITEM_CHAR : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3408C", "CHECK THAT THE FILE PARAMETER OF END_OF_FILE " &
-                       "IS OPTIONAL, AND THAT THE FUNCTION IS THEN " &
-                       "APPLIED TO THE CURRENT DEFAULT INPUT FILE");
- 
- 
- -- CREATE TEST FILE
- 
-      BEGIN
-           CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN 1..3 LOOP
-           PUT (FILE_IN, CHAR);
-      END LOOP;
-      NEW_PAGE (FILE_IN);
- 
-      PUT (FILE_IN, CHAR);
- 
-      CLOSE (FILE_IN);
- 
-      BEGIN
-           OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "MODE IN_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_INPUT (FILE_IN);
-      IF END_OF_FILE THEN
-           FAILED ("INCORRECT VALUE AT FIRST POSITION");
-      END IF;
- 
-      IF END_OF_FILE /= END_OF_FILE (FILE_IN) THEN
-           FAILED ("END OF FILE DOES NOT OPERATE WITH DEFAULT FILE");
-      END IF;
- 
-      WHILE NOT END_OF_PAGE (FILE_IN)
-      LOOP
-           GET (ITEM_CHAR);
-      END LOOP;
- 
-      IF END_OF_FILE THEN
-           FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER");
-      END IF;
- 
-      IF END_OF_FILE /= END_OF_FILE (FILE_IN) THEN
-           FAILED ("END_OF_FILE WITHOUT PARAMETER DOES " &
-                   "NOT OPERATE ON THE DEFAULT INPUT FILE");
-      END IF;
- 
-      GET (ITEM_CHAR);
- 
-      IF NOT (END_OF_FILE) THEN
-           FAILED ("INCORRECT VALUE AT LAST POSITION");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE_IN);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3408C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- CE3409A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_COL RAISES LAYOUT_ERROR IF THE LINE LENGTH IS
- --     BOUNDED AND THE GIVEN COLUMN POSITION EXCEEDS THE LINE LENGTH
- --     FOR FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  CORRECTD EXCEPTION HANDLING AND ADDED NEW CASES
- --                   FOR OBJECTIVE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3409A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE  : FILE_TYPE;
-      THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3));
-      FOUR  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
-      FIVE  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(5));
- 
- BEGIN
- 
-      TEST ("CE3409A", "CHECK THAT SET_COL RAISES " &
-                       "LAYOUT_ERROR APPROPRIATELY");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
-                                "TEMPORARY FILE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_LINE_LENGTH (FILE, THREE);
- 
-      BEGIN
-           SET_COL (FILE, FOUR);
-           FAILED ("LAYOUT_ERROR NOT RAISED ON SET_COL - 1");
-      EXCEPTION
-           WHEN LAYOUT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL - 1");
-      END;
- 
-      IF COL (FILE) /= 1 THEN
-           FAILED ("COLUMN LENGTH NOT INITIALLY ONE");
-      END IF;
- 
-      PUT (FILE, 'A');
-      PUT (FILE, 'B');
-      PUT (FILE, 'C');
- 
-      SET_LINE_LENGTH (FILE, FOUR);
- 
-      BEGIN
-           SET_COL (FILE, FIVE);
-           FAILED ("LAYOUT_ERROR NOT RAISED ON SET_COL - 2");
-      EXCEPTION
-           WHEN LAYOUT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL - 2");
-      END;
- 
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3409A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- CE3409B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_COL RAISES CONSTRAINT_ERROR IF THE GIVEN
- --     COLUMN NUMBER IS ZERO, OR NEGATIVE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/22/82
- --     JBG 01/27/83
- --     JLH 08/31/87  CORRECTED EXCEPTION HANDLING, REMOVED UNNECESSARY
- --                   CODE, AND ADDED CASE FOR COUNT'LAST.
- --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
- 
- WITH REPORT ;
- USE REPORT ;
- WITH TEXT_IO ;
- USE TEXT_IO ;
- 
- PROCEDURE CE3409B IS
-      FILE : FILE_TYPE;
- BEGIN
- 
-      TEST ("CE3409B", "CHECK THAT SET_COL RAISES CONSTRAINT_ERROR " &
-                       "IF THE GIVEN COLUMN NUMBER IS ZERO, OR NEGATIVE.");
- 
-      BEGIN
-           SET_COL (FILE, POSITIVE_COUNT(IDENT_INT(0)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN STATUS_ERROR =>
-                FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO");
-      END;
- 
-      BEGIN
-           SET_COL (FILE, POSITIVE_COUNT(IDENT_INT(-2)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN STATUS_ERROR =>
-                FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR NEGATIVE " &
-                        "NUMBER");
-      END;
- 
-      RESULT;
- 
- END CE3409B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,188 ****
- -- CE3409C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_COL SETS THE CURRENT COLUMN NUMBER TO THE VALUE
- --     SPECIFIED BY TO FOR FILES OF MODES IN_FILE AND OUT_FILE.
- --     CHECK THAT IT HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS
- --     EQUAL TO THE CURRENT COLUMN NUMBER FOR BOTH IN_FILE AND OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/20/82
- --     JBG 01/27/83
- --     SPS 02/18/83
- --     EG  05/22/85
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3409C IS
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE3409C", "CHECK THAT SET_COL SETS THE CURRENT COLUMN " &
-                       "NUMBER TO THE VALUE SPECIFIED BY TO FOR FILES " &
-                       "OF MODES IN_FILE AND OUT_FILE.  CHECK THAT IT " &
-                       "HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS " &
-                       "EQUAL TO THE CURRENT COLUMN NUMBER FOR BOTH " &
-                       "IN_FILE AND OUT_FILE");
- 
-      DECLARE
-           FILE : FILE_TYPE;
-           CHAR : CHARACTER := ('C');
-           ITEM_CHAR : CHARACTER;
-           ONE  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
-           TWO  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
-           FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_PAGE_LENGTH (FILE, TWO);
-           SET_COL (FILE, FOUR);
-           IF COL (FILE) /= FOUR THEN
-                FAILED ("FOR OUT_FILE COLUMN NOT FOUR");
-           ELSE
-                PUT (FILE, 'C');
-                SET_COL (FILE, 5);
-                IF COL (FILE) /= FOUR+1 OR LINE (FILE) /= ONE THEN
-                     FAILED ("FOR OUT_FILE COLUMN UNNECESSARILY " &
-                             "CHANGED FROM FOUR");
-                ELSE
-                     SET_COL (FILE, 8);
-                     PUT (FILE, "DE");
-                     SET_COL (FILE, TWO+1);
-                     IF COL (FILE) /= TWO+ONE OR LINE (FILE) /= TWO THEN
-                          FAILED ("FOR OUT_FILE COLUMN NOT TWO");
-                     END IF;
-                     PUT (FILE, 'B');
-                     SET_COL (FILE, TWO);
- 
-                     IF PAGE (FILE) /= TWO THEN
-                          FAILED ("PAGE TERMINATOR NOT OUTPUT");
-                     END IF;
- 
-                     IF LINE (FILE) /= ONE THEN
-                          FAILED ("LINE TERMINATOR NOT OUTPUT");
-                     END IF;
- 
-                     IF COL (FILE) /= TWO THEN
-                          FAILED ("COL NOT TWO; IS" &
-                                  COUNT'IMAGE(COL(FILE)));
-                     END IF;
- 
-                     PUT (FILE, 'X');
-                END IF;
-           END IF;
- 
-           CHECK_FILE (FILE, "   C   DE#  B#@ X#@%");
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH MODE IN_FILE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_COL (FILE, FOUR);
-           IF COL (FILE) /= FOUR THEN
-                FAILED ("FOR IN_FILE COLUMN NOT FOUR");
-           ELSE
-                GET (FILE, ITEM_CHAR);
-                IF ITEM_CHAR /= 'C' THEN
-                     FAILED ("SET_COL FOR READ; ACTUALLY READ '" &
-                             ITEM_CHAR & "'");
-                END IF;
- 
-                SET_COL (FILE, 5);
-                IF COL (FILE) /= FOUR+1 OR LINE (FILE) /= ONE THEN
-                     FAILED ("FOR IN_FILE COLUMN UNNECESSARILY " &
-                             "CHANGED FROM FOUR");
-                ELSE
-                     SET_COL (FILE, 9);
-                     GET (FILE, ITEM_CHAR);
-                     IF ITEM_CHAR /= 'E' THEN
-                          FAILED ("SET_COL FOR READ 2; ACTUALLY READ '" &
-                                  ITEM_CHAR & "'");
-                     END IF;
- 
-                     SET_COL (FILE, 3);
-                     GET (FILE, ITEM_CHAR);
-                     IF ITEM_CHAR /= 'B' THEN
-                          FAILED ("SET_COL FOR READ 3; ACTUALLY READ '" &
-                                  ITEM_CHAR & "'");
-                     END IF;
- 
-                     IF COL (FILE) /= 4 OR LINE (FILE) /= TWO THEN
-                          FAILED ("FOR IN_FILE COLUMN NOT TWO");
-                     END IF;
-                END IF;
-           END IF;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3409C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- CE3409D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR FILES OF MODE IN_FILE, SET_COL READS UNTIL A
- --     LINE FOUND HAVING A CHARACTER AT THE SPECIFIED COLUMN, SKIPPING
- --     LINE AND PAGE TERMINATORS AS NECESSARY.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JBG 01/27/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  REMOVED DEPENDENCE ON REST, REMOVED UNNECESSARY
- --                   CODE, CHECKED FOR USE_ERROR ON DELETE, AND ADDED
- --                   NEW CASES FOR SET_COL.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3409D IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
-      ITEM_CHAR : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3409D", "CHECK THAT SET_COL SKIPS LINE AND PAGE " &
-                       "TERMINATORS WHEN NECESSARY");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, "ABC");
-      NEW_LINE (FILE);
-      PUT (FILE, "DEFGHI");
-      NEW_PAGE (FILE);
-      PUT (FILE, "XYZ");
-      NEW_PAGE (FILE);
-      PUT (FILE, "IJKL");
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "MODE IN_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_COL (FILE, FOUR);
-      GET (FILE, ITEM_CHAR);
- 
-      IF ITEM_CHAR = ' ' THEN
-           BEGIN
-                COMMENT ("FILE PADS LINES WITH SPACES");
- 
-                SET_COL (FILE, FOUR);
-                GET (FILE, ITEM_CHAR);
-                IF ITEM_CHAR /= 'G' THEN
-                     FAILED ("INCORRECT VALUE FROM SET_COL - 1");
-                END IF;
- 
-                SET_COL (FILE, FOUR);
-                GET (FILE, ITEM_CHAR);
-                IF ITEM_CHAR /= ' ' THEN
-                     FAILED ("LINES SHOULD STILL BE PADDED WITH BLANKS");
-                END IF;
-           END;
- 
-      ELSIF ITEM_CHAR /= 'G' THEN
-           FAILED ("SET_COL DOESN'T SKIP LINE MARKS; " &
-                   "ACTUALLY READ '" & ITEM_CHAR & "'");
-      ELSE
-           BEGIN
-                SET_COL (FILE, FOUR);
-                GET (FILE, ITEM_CHAR);
- 
-                IF ITEM_CHAR /= 'L' THEN
-                     FAILED ("SET_COL DOESN'T SKIP PAGE MARKS; " &
-                             "ACTUALLY READ '" & ITEM_CHAR & "'");
-                END IF;
-           END;
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3409D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,115 ****
- -- CE3409E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_COL RAISES END_ERROR IF NO LINE BEFORE THE END OF
- --     THE FILE IS LONG ENOUGH.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/20/82
- --     JBG 01/27/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3409E IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      CHAR : CHARACTER := ('C');
-      ITEM_CHAR : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3409E", "CHECK THAT SET_COL RAISES END_ERROR " &
-                       "WHEN IT ATTEMPTS TO READ THE FILE TERMINATOR");
- 
- -- CREATE & INITIALIZE FILE
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, "ABCD");
-      NEW_LINE (FILE);
-      PUT (FILE, "DEF");
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           SET_COL (FILE, 513);
-           FAILED ("END ERROR NOT RAISED ON SET_COL");
-      EXCEPTION
-           WHEN END_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3409E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- CE3410A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_LINE RAISES LAYOUT_ERROR IF THE PAGE LENGTH IS
- --     BOUNDED AND THE GIVEN LINE POSITION EXCEEDS THE PAGE LENGTH
- --     FOR FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3410A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE  : FILE_TYPE;
-      THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3));
-      FOUR  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
- 
- BEGIN
- 
-      TEST ("CE3410A", "CHECK THAT SET_LINE RAISES " &
-                       "LAYOUT_ERROR APPROPRIATELY");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
-                                "TEMPORARY FILE WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_PAGE_LENGTH (FILE, THREE);
- 
-      BEGIN
-           SET_LINE (FILE, FOUR);
-           FAILED ("LAYOUT ERROR NOT RAISED FOR SET_LINE");
-      EXCEPTION
-           WHEN LAYOUT_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR SET_LINE");
-      END;
- 
-      CLOSE (FILE);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3410A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,77 ****
- -- CE3410B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_LINE RAISES CONSTRAINT_ERROR IF THE GIVEN
- --     LINE NUMBER IS ZERO, OR NEGATIVE.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/22/82
- --     JBG 01/27/83
- --     JLH 08/31/87  ADDED CASE FOR COUNT'LAST.
- --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3410B IS
- 
-      FILE : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3410B", "CHECK THAT SET_LINE RAISES CONSTRAINT_ERROR " &
-                       "IF THE GIVEN LINE NUMBER IS ZERO, OR NEGATIVE");
- 
-      BEGIN
-           SET_LINE (FILE, POSITIVE_COUNT(IDENT_INT(0)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN STATUS_ERROR =>
-                FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 1");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO");
-      END;
- 
-      BEGIN
-           SET_LINE (FILE, POSITIVE_COUNT(IDENT_INT(-2)));
-           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
-      EXCEPTION
-           WHEN CONSTRAINT_ERROR =>
-                NULL;
-           WHEN STATUS_ERROR =>
-                FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 2");
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED FOR NEGATIVE " &
-                        "NUMBER");
-      END;
- 
-      RESULT;
- 
- END CE3410B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,205 ****
- -- CE3410C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_LINE SETS THE CURRENT LINE NUMBER TO THE VALUE
- --     SPECIFIED BY TO FOR FILES OF MODES IN_FILE AND OUT_FILE.
- --     CHECK THAT IT HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS
- --     EQUAL TO THE CURRENT LINE NUMBER FOR BOTH IN_FILE AND OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/20/82
- --     JBG 01/27/83
- --     EG  05/22/85
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/01/87  REMOVED DEPENDENCE ON RESET, ADDED MORE TEST
- --                   CASES, AND CHECKED FOR USE_ERROR ON DELETE.
- --     JRL 02/29/96  Added File parameter to call to Set_Page_Length.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3410C IS
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE3410C", "CHECK THAT SET_LINE SETS LINE " &
-                       "NUMBER CORRECTLY");
- 
-      DECLARE
-           FILE : FILE_TYPE;
-           CHAR : CHARACTER := ('C');
-           ITEM_CHAR : CHARACTER;
-           ONE   : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
-           TWO   : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
-           THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3));
-           FOUR  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE (FILE, FOUR);
-           IF LINE (FILE) /= FOUR THEN
-                FAILED ("FOR OUT_FILE LINE NOT FOUR");
-           ELSE
-                PUT (FILE, 'C');
-                NEW_LINE (FILE);
-                SET_LINE (FILE, 5);
-                IF LINE (FILE) /= FOUR+1 THEN
-                     FAILED ("FOR OUT_FILE LINE UNNECESSARILY " &
-                             "CHANGED FROM FOUR");
-                ELSE
-                     SET_LINE (FILE, 8);
-                     PUT (FILE, "DE");
-                     SET_LINE (FILE, TWO+1);
-                     IF LINE (FILE) /= TWO+ONE THEN
-                          FAILED ("FOR OUT_FILE LINE NOT THREE");
-                     END IF;
- 
-                     SET_LINE (FILE, TWO);
- 
-                     IF PAGE (FILE) /= ONE+TWO THEN
-                          FAILED ("PAGE TERMINATOR NOT OUTPUT - 2");
-                     END IF;
- 
-                     IF LINE (FILE) /= TWO THEN
-                          FAILED ("LINE NOT TWO; IS" &
-                                  COUNT'IMAGE(LINE(FILE)));
-                     END IF;
- 
-                     SET_PAGE_LENGTH (FILE, TWO);
-                     PUT (FILE, 'X');
-                     SET_LINE (FILE, TWO);
-                     PUT (FILE, 'Y');
- 
-                     IF LINE (FILE) /= TWO THEN
-                          FAILED ("LINE NOT TWO; IS " &
-                                  COUNT'IMAGE(LINE(FILE)));
-                     END IF;
- 
-                     IF PAGE (FILE) /= THREE THEN
-                          FAILED ("PAGE NOT THREE; IS " &
-                                  COUNT'IMAGE(PAGE(FILE)));
-                     END IF;
- 
-                END IF;
-           END IF;
- 
-           CHECK_FILE (FILE, "###C####DE#@##@#XY#@%");
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED FOR TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE (FILE, FOUR);
-           IF LINE (FILE) /= FOUR THEN
-                FAILED ("FOR IN_FILE LINE NOT FOUR");
-           ELSE
-                GET (FILE, ITEM_CHAR);
-                IF ITEM_CHAR /= 'C' THEN
-                     FAILED ("SET_LINE FOR READ; ACTUALLY READ '" &
-                             ITEM_CHAR & "'");
-                END IF;
- 
-                SKIP_LINE (FILE);
-                SET_LINE (FILE, 5);
-                IF LINE (FILE) /= FOUR+1 OR PAGE (FILE) /= ONE THEN
-                     FAILED ("INCORRECT LINE OR PAGE");
-                ELSE
-                     SET_LINE (FILE, 8);
-                     GET (FILE, ITEM_CHAR);
-                     IF ITEM_CHAR /= 'D' THEN
-                          FAILED ("SET_LINE FOR READ 2; ACTUALLY READ '"&
-                                  ITEM_CHAR & "'");
-                     END IF;
- 
-                     SET_LINE (FILE, TWO);
-                     IF PAGE (FILE) /= TWO THEN
-                          FAILED ("FOR IN_FILE PAGE NOT TWO");
-                     END IF;
- 
-                     SET_LINE (FILE, TWO);
-                     IF PAGE (FILE) /= TWO OR LINE (FILE) /= TWO THEN
-                          FAILED ("FOR IN_FILE PAGE NOT 2");
-                     END IF;
- 
-                     SKIP_LINE (FILE);
-                     SET_LINE (FILE, TWO);
- 
-                     GET (FILE, ITEM_CHAR);
- 
-                     IF ITEM_CHAR /= 'X' THEN
-                          FAILED ("SET_LINE FOR READ 3; ACTUALLY READ '"&
-                                  ITEM_CHAR & "'");
-                     END IF;
- 
-                END IF;
-           END IF;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3410C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- CE3410D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT, FOR FILES OF MODE IN_FILE, SET_LINE READS UNTIL A
- --     PAGE IS FOUND HAVING A LINE AT THE SPECIFIED POSITION, SKIPPING
- --     LINE AND PAGE TERMINATORS AS NECESSARY.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JBG 01/27/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/01/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
- --                   USE_ERROR ON DELETE.
- --     GJD 11/15/95  FIXED ADA 95 INCOMPATIBLE USE OF CHARACTER LITERALS.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3410D IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
-      ITEM_CHAR : CHARACTER;
- 
- BEGIN
- 
-      TEST ("CE3410D", "CHECK THAT SET_LINE SKIPS PAGE " &
-                       "TERMINATORS WHEN NECESSARY");
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      FOR I IN CHARACTER RANGE 'A'..'C' LOOP
-           PUT (FILE, I);
-           NEW_LINE (FILE);
-      END LOOP;
- 
-      NEW_PAGE (FILE);
- 
-      FOR I IN CHARACTER RANGE 'D'..'H'   -- 5 LINES
-      LOOP
-           PUT (FILE, I);
-           NEW_LINE (FILE);
-      END LOOP;
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_LINE (FILE, FOUR);
-      GET (FILE, ITEM_CHAR);
- 
-      IF ITEM_CHAR /= 'G' THEN
-           FAILED ("SET_LINE DOESN'T SKIP PAGE MARKS; " &
-                   "ACTUALLY READ '" & ITEM_CHAR & "'");
-      END IF;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                     NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3410D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- CE3410E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_LINE RAISES END_ERROR IF NO PAGE BEFORE THE END
- --     OF THE FILE IS LONG ENOUGH.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/20/82
- --     JBG 01/27/83
- --     JBG 08/30/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/02/87  REMOVED DEPENDENCE ON RESET, ADDED NEW CASES FOR
- --                   OBJECTIVE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3410E IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE : FILE_TYPE;
-      CHAR : CHARACTER := ('C');
-      ITEM_CHAR : CHARACTER;
-      FIVE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(5));
- 
- BEGIN
- 
-      TEST ("CE3410E", "CHECK THAT SET_LINE RAISES END_ERROR " &
-                       "WHEN IT ATTEMPTS TO READ THE FILE TERMINATOR");
- 
- -- CREATE & INITIALIZE FILE
- 
-      BEGIN
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH MODE OUT_FILE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE, "ABCD");
-      NEW_LINE (FILE);
-      PUT (FILE, "DEF");
-      NEW_LINE (FILE, 3);
-      NEW_PAGE (FILE);
-      PUT_LINE (FILE, "HELLO");
-      NEW_PAGE (FILE);
-      PUT_LINE (FILE, "GH");
-      PUT_LINE (FILE, "IJK");
-      PUT_LINE (FILE, "HI");
-      PUT_LINE (FILE, "TESTING");
- 
-      CLOSE (FILE);
- 
-      BEGIN
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "MODE IN_FILE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           SET_LINE (FILE,FIVE);
-           FAILED ("END ERROR NOT RAISED ON SET_LINE");
-      EXCEPTION
-           WHEN END_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_LINE");
-      END;
- 
-      BEGIN
-           DELETE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3410E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- CE3411A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT COL RETURNS THE VALUE OF THE CURRENT COLUMN NUMBER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/29/82
- --     JBG 08/30/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/02/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
- --                   USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3411A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3411A", "CHECK THAT COL RETURNS THE VALUE OF THE " &
-                       "CURRENT COLUMN NUMBER");
- 
-      DECLARE
-           FT        : FILE_TYPE;
-           X         : CHARACTER;
-           NUM_CHARS : POSITIVE_COUNT;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "OUTPUT STRING");
-           IF COL (FT) /= 14 THEN
-                FAILED ("COL INCORRECT AFTER PUT; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           NEW_LINE (FT);
-           IF COL (FT) /= 1 THEN
-                FAILED ("COL INCORRECT AFTER NEW_LINE; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           PUT (FT, "MORE OUTPUT");
-           NEW_PAGE (FT);
-           IF COL (FT) /= 1 THEN
-                FAILED ("COL INCORRECT AFTER NEW_PAGE; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           PUT (FT, "FINAL");
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF COL (FT) /= 1 THEN
-                FAILED ("COL INCORRECT AFTER REOPEN; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           FOR I IN 1 .. 4 LOOP
-                GET (FT, X);
-           END LOOP;
-           IF COL (FT) /= 5 THEN
-                FAILED ("COL INCORRECT AFTER GET; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           NUM_CHARS := COL(FT);
-           WHILE NOT END_OF_LINE(FT) LOOP
-                GET (FT, X);
-                NUM_CHARS := NUM_CHARS + 1;
-           END LOOP;
- 
-           IF COL(FT) /= NUM_CHARS THEN
-                FAILED ("COL INCORRECT BEFORE END OF LINE; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           SKIP_LINE (FT);
-           IF COL(FT) /= 1 THEN
-                FAILED ("COL INCORRECT AFTER SKIP_LINE; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           SET_COL (FT, 2);
-           IF COL (FT) /= 2 THEN
-                FAILED ("COL INCORRECT AFTER SET_COL; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           SKIP_PAGE (FT);
-           IF COL(FT) /= 1 THEN
-                FAILED ("COL INCORRECT AFTER SKIP_PAGE; IS" &
-                        COUNT'IMAGE(COL(FT)));
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- END CE3411A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,146 ****
- -- CE3411C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT COL OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN
- --     NO FILE IS SPECIFIED.  CHECK THAT COL CAN OPERATE ON FILES OF
- --     MODES IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT
- --     INPUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/29/82
- --     JBG 01/31/83
- --     JBG 08/30/83
- --     JLH 09/02/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3411C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3411C", "CHECK THAT COL OPERATES ON DEFAULT IN_FILE AND "&
-                       "OUT_FILE FILES");
- 
-      DECLARE
-           F1, F2 : FILE_TYPE;
-           C : POSITIVE_COUNT;
-           X : CHARACTER;
-      BEGIN
-           IF COL /= COL (STANDARD_OUTPUT) THEN
-                FAILED ("COL DEFAULT NOT STANDARD_OUTPUT");
-           END IF;
- 
-           IF COL /= COL (STANDARD_INPUT) THEN
-                FAILED ("COL DEFAULT NOT STANDARD_INPUT");
-           END IF;
- 
-           IF COL /= COL (CURRENT_INPUT) THEN
-                FAILED ("COL DEFAULT NOT CURRENT_INPUT");
-           END IF;
- 
-           IF COL /= COL (CURRENT_OUTPUT) THEN
-                FAILED ("COL DEFAULT NOT CURRENT_OUTPUT");
-           END IF;
- 
-           BEGIN
-                CREATE (F1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (F2, OUT_FILE);
- 
-           SET_OUTPUT (F2);
- 
-           PUT (F1, "STRING");
-           IF COL (F1) /= 7 THEN
-                FAILED ("COL INCORRECT SUBTEST 1");
-           END IF;
- 
-           PUT (F2, "OUTPUT STRING");
-           IF COL /= COL(F2) AND COL(F2) /= 14 THEN
-                FAILED ("COL INCORRECT SUBTEST 2; WAS " &
-                        COUNT'IMAGE(COL) & " VS. " &
-                        COUNT'IMAGE(COL(F2)));
-           END IF;
- 
-           CLOSE (F1);
- 
-           BEGIN
-                OPEN (F1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_INPUT (F1);
- 
-           GET (F1, X);
-           GET (F1, X);
-           GET (F1, X);
- 
-           IF X /= 'R' THEN
-                FAILED ("INCORRECT VALUE READ");
-           END IF;
- 
-           IF COL (CURRENT_INPUT) /= 4 AND COL /= 4 THEN
-                FAILED ("COL INCORRECT SUBTEST 3");
-           END IF;
- 
-           BEGIN
-                DELETE (F1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           CLOSE (F2);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3411C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,149 ****
- -- CE3412A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT LINE RETURNS THE VALUE OF THE CURRENT LINE NUMBER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/29/82
- --     JBG 08/30/83
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/02/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
- --                   USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3412A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3412A", "CHECK LINE RETURNS LINE NUMBER");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           X : CHARACTER;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF LINE (FT) /= 1 THEN
-                FAILED ("CURRENT LINE NUMBER NOT INITIALLY ONE");
-           END IF;
- 
-           FOR I IN 1 .. 3 LOOP
-                PUT (FT, "OUTPUT STRING");
-                NEW_LINE (FT);
-           END LOOP;
-           IF LINE (FT) /= 4 THEN
-                FAILED ("LINE INCORRECT AFTER PUT; IS" &
-                        COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           NEW_PAGE (FT);
-           IF LINE (FT) /= 1 THEN
-                FAILED ("LINE INCORRECT AFTER NEW_PAGE; IS" &
-                        COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           FOR I IN 1 .. 5 LOOP
-                PUT (FT, "MORE OUTPUT");
-                NEW_LINE(FT);
-           END LOOP;
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF LINE (FT) /= 1 THEN
-                FAILED ("LINE INCORRECT AFTER RESET; IS" &
-                        COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           FOR I IN 1 .. 2 LOOP
-                SKIP_LINE (FT);
-           END LOOP;
-           IF LINE (FT) /= 3 THEN
-                FAILED ("LINE INCORRECT AFTER SKIP_LINE; IS" &
-                        COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           SET_LINE (FT, 2);
-           IF LINE (FT) /= 2 THEN
-                FAILED ("LINE INCORRECT AFTER SET_LINE; IS" &
-                        COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           SKIP_PAGE (FT);
-           IF LINE (FT) /= 1 THEN
-                FAILED ("LINE INCORRECT AFTER SKIP_PAGE; IS" &
-                        COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3412A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- CE3413A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PAGE RETURNS THE VALUE OF THE CURRENT PAGE NUMBER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/29/82
- --     JBG 08/30/83
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/04/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
- --                   USE_ERROR ON DELETE.
- 
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3413A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3413A", "CHECK THAT PAGE RETURNS THE CORRECT PAGE " &
-                       "NUMBER");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           X : CHARACTER;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF PAGE (FT) /= 1 THEN
-                FAILED ("CURRENT PAGE NOT INITIALLY ONE");
-           END IF;
- 
-           FOR I IN 1 .. 6 LOOP
-                PUT (FT, "OUTPUT STRING");
-                NEW_PAGE (FT);
-           END LOOP;
-           IF PAGE (FT) /= 7 THEN
-                FAILED ("PAGE INCORRECT AFTER PUT; IS" &
-                        COUNT'IMAGE(PAGE(FT)));
-           END IF;
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF PAGE (FT) /= 1 THEN
-                FAILED ("PAGE INCORRECT AFTER OPEN IS" &
-                        COUNT'IMAGE(PAGE(FT)));
-           END IF;
- 
-           FOR I IN 1 .. 4 LOOP
-                SKIP_PAGE (FT);
-           END LOOP;
-           IF PAGE (FT) /= 5 THEN
-                FAILED ("PAGE INCORRECT AFTER SKIP_PAGE; IS" &
-                        COUNT'IMAGE(PAGE(FT)));
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3413A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- CE3413B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PAGE RAISES LAYOUT_ERROR WHEN THE VALUE OF THE
- --     PAGE NUMBER EXCEEDS COUNT'LAST.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- HISTORY:
- --     JLH 07/27/88  CREATED ORIGINAL TEST.
- --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- 
- PROCEDURE CE3413B IS
- 
-      FILE : FILE_TYPE;
-      INCOMPLETE, INAPPLICABLE : EXCEPTION;
-      ITEM : STRING(1..3) := "ABC";
-      LST : NATURAL;
- 
- BEGIN
- 
-      TEST ("CE3413B", "CHECK THAT PAGE RAISES LAYOUT_ERROR WHEN THE " &
-                       "VALUE OF THE PAGE NUMBER EXCEEDS COUNT'LAST");
- 
-      BEGIN
- 
-           IF COUNT'LAST > 150000 THEN
-                RAISE INAPPLICABLE;
-           END IF;
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           FOR I IN 1 .. COUNT'LAST-1 LOOP
-                NEW_PAGE (FILE);
-           END LOOP;
- 
-           PUT (FILE, ITEM);
- 
-           NEW_PAGE (FILE);
-           PUT (FILE, "DEF");
- 
-           BEGIN
-                IF PAGE(FILE) <= POSITIVE_COUNT(COUNT'LAST) THEN
-                     FAILED ("PAGE NUMBER INCORRECT AFTER PAGE SET - 1");
-                END IF;
-                FAILED ("LAYOUT_ERROR NOT RAISED FOR PAGE - 1");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT_ERROR RAISED FOR PAGE - 1");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR PAGE - 1");
-           END;
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           FOR I IN 1 .. COUNT'LAST-1 LOOP
-                SKIP_PAGE (FILE);
-           END LOOP;
- 
-           IF PAGE(FILE) /= COUNT'LAST THEN
-                FAILED ("INCORRECT PAGE NUMBER");
-           END IF;
- 
-           GET_LINE (FILE, ITEM, LST);
-           IF ITEM /= "ABC" THEN
-                FAILED ("INCORRECT VALUE READ");
-           END IF;
- 
-           SKIP_PAGE (FILE);
- 
-           BEGIN
-                IF PAGE(FILE) <= POSITIVE_COUNT(COUNT'LAST) THEN
-                     FAILED ("PAGE NUMBER INCORRECT AFTER PAGE SET - 2");
-                END IF;
-                FAILED ("LAYOUT_ERROR NOT RAISED FOR PAGE - 2");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT_ERROR RAISED FOR PAGE - 2");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR PAGE - 2");
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-           WHEN INAPPLICABLE =>
-                NOT_APPLICABLE ("THE VALUE OF COUNT'LAST IS GREATER " &
-                                "THAN 150000.  THE CHECKING OF THIS " &
-                                "OBJECTIVE IS IMPRACTICAL");
- 
-      END;
- 
-      RESULT;
- 
- END CE3413B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- CE3413C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PAGE OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN
- --     NO FILE IS SPECIFIED.  CHECK THAT PAGE CAN OPERATE ON FILES OF
- --     MODES IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT
- --     INPUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/29/82
- --     JBG 08/30/83
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/04/87  REMOVED DEPENDENCE ON RESET, CORRECTED EXCEPTION
- --                   HANDLING, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3413C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3413C", "CHECK THAT PAGE OPERATES ON DEFAULT IN_FILE " &
-                       "AND OUT_FILE FILES");
- 
-      DECLARE
-           F1, F2 : FILE_TYPE;
-           C : POSITIVE_COUNT;
-           X : CHARACTER;
-      BEGIN
- 
-           BEGIN
-                CREATE (F1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                CREATE (F2, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "FOR TEMPORARY FILES WITH " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_OUTPUT (F2);
- 
-           IF PAGE (F2) /= 1 AND PAGE (STANDARD_OUTPUT) /= 1 THEN
-                FAILED ("PAGE INCORRECT SUBTEST - 1");
-           END IF;
- 
-           FOR I IN 1 .. 3 LOOP
-                PUT (F1, "STRING");
-                NEW_PAGE (F1);
-           END LOOP;
- 
-           IF PAGE (F1) /= 4 THEN
-                FAILED ("PAGE INCORRECT SUBTEST - 2");
-           END IF;
- 
-           SET_LINE_LENGTH (F2, 3);
-           SET_PAGE_LENGTH (F2, 1);
-           PUT ("OUTPUT STRING");
-           IF PAGE /= PAGE(F2) THEN
-                FAILED ("PAGE INCORRECT SUBTEST - 3");
-           END IF;
- 
-           CLOSE (F1);
- 
-           BEGIN
-                OPEN (F1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_INPUT (F1);
- 
-           IF PAGE (F1) /= 1 THEN
-                FAILED ("PAGE INCORRECT SUBTEST - 4");
-           END IF;
- 
-           SKIP_PAGE(F1);
-           SKIP_PAGE(F1);
-           IF PAGE (F1) /= PAGE (CURRENT_INPUT) THEN
-                FAILED ("PAGE INCORRECT SUBTEST - 5");
-           END IF;
- 
-           BEGIN
-                DELETE (F1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           CLOSE (F2);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3413C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,204 ****
- -- CE3414A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT STATUS_ERROR IS RAISED WHEN NEW_LINE, SKIP_LINE,
- --     END_OF_LINE, NEW_PAGE, SKIP_PAGE, END_OF_PAGE, END_OF_FILE,
- --     SET_COL, SET_LINE, COL, LINE, AND PAGE ARE CALLED AND THE FILE
- --     IS NOT OPEN.
- 
- -- HISTORY:
- --     BCB 10/27/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3414A IS
- 
-      FILE : FILE_TYPE;
- 
-      INCOMPLETE : EXCEPTION;
- 
-      X : POSITIVE_COUNT;
- 
- BEGIN
-      TEST ("CE3414A", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
-                       "NEW_LINE, SKIP_LINE, END_OF_LINE, NEW_PAGE, " &
-                       "SKIP_PAGE, END_OF_PAGE, END_OF_FILE, SET_COL, " &
-                       "SET_LINE, COL, LINE, AND PAGE ARE CALLED AND " &
-                       "THE FILE IS NOT OPEN");
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, 'A');
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                NEW_LINE (FILE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                SKIP_LINE (FILE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                IF NOT END_OF_LINE (FILE) THEN
-                     NULL;
-                END IF;
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 3");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 3");
-           END;
- 
-           BEGIN
-                NEW_PAGE (FILE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 4");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 4");
-           END;
- 
-           BEGIN
-                SKIP_PAGE (FILE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 5");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 5");
-           END;
- 
-           BEGIN
-                IF NOT END_OF_PAGE (FILE) THEN
-                     NULL;
-                END IF;
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 6");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 6");
-           END;
- 
-           BEGIN
-                IF NOT END_OF_FILE (FILE) THEN
-                     NULL;
-                END IF;
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 7");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 7");
-           END;
- 
-           BEGIN
-                SET_COL (FILE, 2);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 8");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 8");
-           END;
- 
-           BEGIN
-                SET_LINE (FILE, 2);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 9");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 9");
-           END;
- 
-           BEGIN
-                X := COL (FILE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 10");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 10");
-           END;
- 
-           BEGIN
-                X := LINE (FILE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 11");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 11");
-           END;
- 
-           BEGIN
-                X := PAGE (FILE);
-                FAILED ("STATUS_ERROR WAS NOT RAISED - 12");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 12");
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE3414A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,187 ****
- -- CE3601A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET (FOR STRINGS AND CHARACTERS), PUT (FOR STRINGS AND
- --     CHARACTERS), GET_LINE, AND PUT_LINE RAISE STATUS_ERROR WHEN
- --     CALLED WITH AN UNOPEN FILE PARAMETER.  ALSO CHECK NAMES OF FORMAL
- --     PARAMETERS.
- 
- -- HISTORY:
- --     SPS 08/27/82
- --     VKG 02/15/83
- --     JBG 03/30/83
- --     JLH 09/04/87  ADDED CASE WHICH ATTEMPTS TO CREATE FILE AND THEN
- --                   RETESTED OBJECTIVE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3601A IS
- 
- BEGIN
- 
-      TEST ("CE3601A", "STATUS_ERROR RAISED BY GET, PUT, GET_LINE, " &
-                       "PUT_LINE WHEN FILE IS NOT OPEN");
- 
-      DECLARE
-           FILE1, FILE2 : FILE_TYPE;
-           CH: CHARACTER := '%';
-           LST: NATURAL;
-           ST: STRING (1 .. 10);
-           LN : STRING (1 .. 80);
-      BEGIN
-           BEGIN
-                GET (FILE => FILE1, ITEM => CH);
-                FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER");
-           END;
- 
-           BEGIN
-                GET (FILE => FILE1, ITEM => ST);
-                FAILED ("STATUS_ERROR NOT RAISED - GET STRING");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET STRING");
-           END;
- 
-           BEGIN
-                GET_LINE (FILE => FILE1, ITEM => LN, LAST => LST);
-                FAILED ("STATUS_ERROR NOT RAISED - GET_LINE");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET_LINE");
-           END;
- 
-           BEGIN
-                PUT (FILE => FILE1, ITEM => CH);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER");
-           END;
- 
-           BEGIN
-                PUT (FILE => FILE1, ITEM => ST);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT STRING");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT STRING");
-           END;
- 
-           BEGIN
-                PUT_LINE (FILE => FILE1, ITEM => LN);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT_LINE");
-           END;
- 
-           BEGIN
-                CREATE (FILE2, OUT_FILE);   -- THIS IS ONLY AN ATTEMPT TO
-                CLOSE (FILE2);              -- CREATE A FILE. OK, WHETHER
-           EXCEPTION                        -- SUCCESSFUL OR NOT.
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           BEGIN
-                GET (FILE => FILE2, ITEM => CH);
-                FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER");
-           END;
- 
-           BEGIN
-                GET (FILE => FILE2, ITEM => ST);
-                FAILED ("STATUS_ERROR NOT RAISED - GET STRING");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET STRING");
-           END;
- 
-           BEGIN
-                GET_LINE (FILE => FILE2, ITEM => LN, LAST => LST);
-                FAILED ("STATUS_ERROR NOT RAISED - GET_LINE");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET_LINE");
-           END;
- 
-           BEGIN
-                PUT (FILE => FILE2, ITEM => CH);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER");
-           END;
- 
-           BEGIN
-                PUT (FILE => FILE2, ITEM => ST);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT STRING");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT STRING");
-           END;
- 
-           BEGIN
-                PUT_LINE (FILE => FILE2, ITEM => LN);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT_LINE");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END CE3601A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,189 ****
- -- CE3602A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR CHARACTERS AND STRINGS ALLOW A STRING TO SPAN
- --     OVER MORE THAN ONE LINE, SKIPPING INTERVENING LINE AND PAGE
- --     TERMINATORS.  ALSO CHECK THAT GET ACCEPTS A NULL STRING ACTUAL
- --     PARAMETER AND A STRING SLICE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 08/30/82
- --     VKG 01/26/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/04/87  REMOVED DEPENDENCE ON RESET, CORRECTED EXCEPTION
- --                   HANDLING, AND ADDED NEW CASES FOR OBJECTIVE.
- 
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3602A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3602A", "CHECK THAT GET FOR CHARACTERS AND STRINGS " &
-                       "ALLOWS A STRING TO SPAN OVER MORE THAN ONE " &
-                       "LINE, SKIPPING INTERVENING LINE AND PAGE " &
-                       "TERMINATORS.  ALSO CHECK THAT GET ACCEPTS " &
-                       "A NULL STRING ACTUAL PARAMETER AND A STRING " &
-                       "SLICE");
- 
-      DECLARE
-           FILE1 : FILE_TYPE;
-           ST : STRING (1 .. 40);
-           STR: STRING (1 .. 100);
-           NST: STRING (1 .. 0);
-           ORIGINAL_LINE_LENGTH : COUNT;
- 
- -- READ_CHARS RETURNS A STRING OF N CHARACTERS FROM A GIVEN FILE.
- 
-           FUNCTION READ_CHARS (FILE : FILE_TYPE;
-                                N    : NATURAL )
-                                RETURN STRING IS
-           C: CHARACTER;
-           BEGIN
-                IF N = 0 THEN RETURN "";
-                ELSE
-                     GET (FILE,C);
-                     RETURN C&READ_CHARS (FILE,N-1);
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("ERROR ON READ_CHARS");
-           END READ_CHARS;
- 
- 
-      BEGIN
- 
- -- CREATE AND INITIALIZE TEST DATA FILE
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           ORIGINAL_LINE_LENGTH := LINE_LENGTH;
- 
- -- LINE_LENGTH SET IN CASE IMPLEMENTATION REQUIRES BOUNDED LENGTH LINES
- 
-           SET_LINE_LENGTH (16);
-           PUT (FILE1, "THIS LINE SHALL ");
-           SET_LINE_LENGTH (10);
-           PUT (FILE1, "SPAN OVER ");
-           SET_LINE_LENGTH (14);
-           PUT (FILE1, "SEVERAL LINES.");
-           CLOSE (FILE1);
-           SET_LINE_LENGTH (ORIGINAL_LINE_LENGTH);
- 
- 
- -- BEGIN TEST
- 
-           BEGIN
- 
-                BEGIN
-                     OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
-                                          "OPEN WITH IN_FILE MODE - 1");
-                          RAISE INCOMPLETE;
-                END;
- 
-                STR(1..40) := READ_CHARS (FILE1, 40);
-                CLOSE (FILE1);
- 
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
- 
-                GET (FILE1, ST);
-                IF STR(1..40) /= ST THEN
-                     FAILED ("GET FOR STRING INCORRECT");
-                END IF;
- 
-                IF STR(1..40) /= "THIS LINE SHALL SPAN OVER SEVERAL " &
-                                 "LINES." THEN
-                     FAILED ("INCORRECT VALUE READ");
-                END IF;
- 
- -- GET NULL STRING
- 
-                CLOSE (FILE1);
- 
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
- 
-                BEGIN
-                     GET (FILE1, NST);
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED (" GET FAILED ON NULL STRING");
-                END;
- 
- -- GET NULL SLICE
- 
-                BEGIN
-                     GET (FILE1, STR (10 .. 1));
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("GET FAILED ON A NULL SLICE");
-                END;
- 
-                BEGIN
-                     DELETE (FILE1);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
- 
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3602A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- CE3602B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET (FOR CHARACTER AND STRINGS) PROPERLY SETS THE
- --     PAGE, LINE, AND COLUMN NUMBERS AFTER EACH OPERATION.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 08/30/82
- --     SPS 12/17/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/04/87  REMOVED DEPENDENCE ON UNBOUNDED LINE LENGTH AND
- --                   CORRECTED EXCEPTION HANDLING.
- --     BCB 11/13/87  GAVE SET_LINE_LENGTH PROCEDURE THE FILE VARIABLE
- --                   AS A PARAMETER.  REMOVED LINE WHICH SAVED AND
- --                   RESTORED THE LINE LENGTH.
- 
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3602B IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3602B", "CHECK THAT GET PROPERLY SETS PAGE, LINE, AND " &
-                       "COLUMN NUMBERS");
- 
-      DECLARE
-           FILE1 : FILE_TYPE;
-           LINE1 : CONSTANT STRING := "LINE ONE OF TEST DATA FILE";
-           LINE2 : CONSTANT STRING := "LINE TWO";
-           LINE3 : CONSTANT STRING := "LINE THREE";
-           CN, LN : POSITIVE_COUNT;
-           CH : CHARACTER;
-           ST: STRING (1 .. 5);
-           ORIGINAL_LINE_LENGTH : COUNT;
- 
-      BEGIN
- 
- -- CREATE AND INITIALIZE TEST DATA FILE
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           ORIGINAL_LINE_LENGTH := LINE_LENGTH;
-           SET_LINE_LENGTH (FILE1, LINE1'LENGTH);
- 
-           PUT (FILE1, LINE1);
-           SET_LINE_LENGTH (FILE1, LINE2'LENGTH);
-           PUT (FILE1, LINE2);
-           NEW_LINE (FILE1, 2);
-           NEW_PAGE (FILE1);
-           SET_LINE_LENGTH (FILE1, LINE3'LENGTH);
-           PUT (FILE1, LINE3);
-           CLOSE (FILE1);
- 
- -- BEGIN TEST
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           IF COL (FILE1) /= 1 THEN
-                FAILED ("COLUMN NUMBER NOT INITIALLY ONE");
-           END IF;
- 
-           IF LINE (FILE1) /= 1 THEN
-                FAILED ("LINE NUMBER NOT INITIALLY ONE");
-           END IF;
- 
-           IF PAGE (FILE1) /= 1 THEN
-                FAILED ("PAGE NUMBER NOT INITIALLY ONE");
-           END IF;
- 
- -- TEST COLUMN NUMBER FOR CHARACTER
- 
-           GET (FILE1, CH);
-           IF CH /= 'L' THEN
-                FAILED ("CHARACTER NOT EQUAL TO L - 1");
-           END IF;
-           CN := COL (FILE1);
-           IF CN /= 2 THEN
-                FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
-                        "- GET CHARACTER.  COL NUMBER IS" &
-                        COUNT'IMAGE(CN));
-           END IF;
- 
- -- TEST COLUMN NUMBER FOR STRING
- 
-           GET (FILE1, ST);
-           CN := COL (FILE1);
-           IF CN /= 7 THEN
-                FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
-                        "- GET STRING.  COL NUMBER IS" &
-                        COUNT'IMAGE(CN));
-           END IF;
- 
- -- POSITION CURRENT INDEX TO END OF LINE
- 
-           WHILE NOT END_OF_LINE (FILE1) LOOP
-                GET (FILE1, CH);
-           END LOOP;
- 
-           IF CH /= 'E' THEN
-                FAILED ("CHARACTER NOT EQUAL TO E");
-           END IF;
- 
- -- TEST LINE NUMBER FOR CHARACTER
- 
-           GET(FILE1, CH);
-           IF CH /= 'L' THEN
-                FAILED ("CHARACTER NOT EQUAL TO L - 2");
-           END IF;
-           LN := LINE (FILE1);
-           IF LN /= 2 THEN
-                FAILED ("LINE NUMBER NOT SET CORRECTLY " &
-                        "- GET CHARACTER.  LINE NUMBER IS" &
-                        COUNT'IMAGE(LN));
-           END IF;
-           IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN
-                FAILED ("PAGE NUMBER NOT CORRECT - 1.  PAGE IS" &
-                        COUNT'IMAGE(PAGE(FILE1)));
-           END IF;
- 
- -- TEST LINE NUMBER FOR STRING
- 
-           WHILE NOT END_OF_LINE (FILE1) LOOP
-                GET (FILE1, CH);
-           END LOOP;
-           GET (FILE1, ST);
-           IF ST /= "LINE " THEN
-                FAILED ("INCORRECT VALUE READ - ST");
-           END IF;
-           LN := LINE (FILE1);
-           CN := COL (FILE1);
-           IF CN /= 6 THEN
-                FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
-                        "- GET STRING.  COL NUMBER IS" &
-                        COUNT'IMAGE(CN));
-           END IF;
-           IF LN /= 1 THEN
-                FAILED ("LINE NUMBER NOT SET CORRECTLY " &
-                        "- GET STRING.  LINE NUMBER IS" &
-                        COUNT'IMAGE(LN));
-           END IF;
-           IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
-                FAILED ("PAGE NUMBER NOT CORRECT - 2.  PAGE IS" &
-                        COUNT'IMAGE(PAGE(FILE1)));
-           END IF;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3602B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,202 ****
- -- CE3602C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET RAISES MODE_ERROR FOR FILES OF MODE OUT_FILE.
- 
- -- APPLICABILITY CRITEIRA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 08/31/82
- --     SPS 12/17/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND CHECKED FOR
- --                   USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3602C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3602C", "CHECK THAT MODE_ERROR IS RAISED BY GET FOR " &
-                       "FILES OF MODE OUT_FILE");
- 
-      DECLARE
-           FILE1, FILE2 : FILE_TYPE;
-           CH : CHARACTER;
-           ST : STRING (1 .. 5);
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "FOR TEMPORARY FILE WITH " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE - 2");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                GET (FILE1, CH);
-                FAILED ("MODE_ERROR NOT RAISED - GET CHAR UN-NAMED " &
-                        "FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
-                             "UN-NAMED FILE");
-           END;
- 
-           BEGIN
-                GET (FILE2, CH);
-                FAILED ("MODE_ERROR NOT RAISED - GET CHAR NAMED FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
-                             "NAMED FILE");
-           END;
- 
-           BEGIN
-                GET (STANDARD_OUTPUT, CH);
-                FAILED ("MODE_ERROR NOT RAISED - GET CHAR " &
-                        "STANDARD_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
-                             "STANDARD_OUTPUT");
-           END;
- 
-           BEGIN
-                GET (CURRENT_OUTPUT, CH);
-                FAILED ("MODE_ERROR NOT RAISED - GET CHAR " &
-                        "CURRENT_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
-                             "CURRENT_OUTPUT");
-           END;
- 
-           BEGIN
-                GET (FILE1, ST);
-                FAILED ("MODE_ERROR NOT RAISED - GET STRING UN-NAMED " &
-                        "FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
-                             "UN-NAMED FILE");
-           END;
- 
-           BEGIN
-                GET (FILE2, ST);
-                FAILED ("MODE_ERROR NOT RAISED - GET STRING NAMED FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
-                             "NAMED FILE");
-           END;
- 
-           BEGIN
-                GET (STANDARD_OUTPUT, ST);
-                FAILED ("MODE_ERROR NOT RAISED - GET STRING " &
-                        "STANDARD_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
-                             "STANDARD_OUTPUT");
-           END;
- 
-           BEGIN
-                GET (CURRENT_OUTPUT, ST);
-                FAILED ("MODE_ERROR NOT RAISED - GET STRING " &
-                        "CURRENT_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
-                             "CURRENT_OUTPUT");
-           END;
- 
-           CLOSE (FILE1);
- 
-           BEGIN
-                DELETE (FILE2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3602C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,150 ****
- -- CE3602D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FILES ARE OF MODE IN_FILE AND THAT WHEN NO FILE IS
- --     SPECIFIED THAT CURRENT DEFAULT INPUT FILE IS USED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/06/82
- --     SPS 12/17/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3602D IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3602D", "CHECK THAT GET FOR STRINGS AND CHARACTERS " &
-                       "OPERATES ON IN_FILE FILES");
- 
-      DECLARE
-           FT , FILE : FILE_TYPE;
-           X : CHARACTER;
-           ST: STRING (1 .. 3);
-      BEGIN
- 
- -- CREATE AND INITIALIZE FILES
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "ABCE");
-           NEW_LINE (FT);
-           PUT (FT, "EFGHIJKLM");
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           PUT (FILE, "STRING");
-           NEW_LINE (FILE);
-           PUT (FILE, "END OF OUTPUT");
- 
-           CLOSE (FILE);
- 
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           SET_INPUT (FILE);
- 
- -- BEGIN TEST
- 
-           GET (FT, X);
-           IF X /= IDENT_CHAR ('A') THEN
-                FAILED ("CHARACTER FROM FILE INCORRECT, WAS '" &
-                        X & "'");
-           END IF;
- 
-           GET (FT, ST);
-           IF ST /= "BCE" THEN
-                FAILED ("STRING FROM FILE INCORRECT; WAS """ &
-                        ST & """");
-           END IF;
- 
-           GET (X);
-           IF X /= IDENT_CHAR ('S') THEN
-                FAILED ("CHARACTER FROM DEFAULT INCORRECT; WAS '" &
-                        X & "'");
-           END IF;
- 
-           GET (ST);
-           IF ST /= "TRI" THEN
-                FAILED ("STRING FROM DEFAULT INCORRECT; WAS """ &
-                        ST & """");
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3602D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,217 ****
- -- CE3603A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_ERROR IS NOT RAISED BY:
- --       GET FOR CHARACTERS UNTIL ONLY LINE AND PAGE TERMINATORS REMAIN;
- --       GET FROM STRING UNTIL FEWER CHARACTERS THAN NEEDED REMAIN;
- --       GET_LINE UNTIL THE FINAL PAGE TERMINATOR HAS BEEN SKIPPED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 08/31/82
- --     JBG 12/23/82
- --     EG  05/22/85
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND REMOVED
- --                   DEPENDENCE ON RESET.
- 
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3603A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3603A", "CHECK THAT END_ERROR IS RAISED BY GET AFTER " &
-                       "THE LAST CHARACTER IN THE FILE HAS BEEN READ");
- 
-      DECLARE
-           FILE1 : FILE_TYPE;
-           OLDCH, CH : CHARACTER;
-           ST        : STRING (1..10) := (1..10 => '.');
-           COUNT     : NATURAL;
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT" &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE1, "LINE ONE");
-           NEW_LINE (FILE1);
-           PUT (FILE1, "LINE TWO");
-           NEW_LINE (FILE1, 3);
-           NEW_PAGE (FILE1);
-           NEW_PAGE (FILE1);
-           CLOSE (FILE1);
- 
-           BEGIN
- 
-                BEGIN
-                     OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                SKIP_LINE (FILE1);
-                GET (FILE1, ST(1..7));
-                IF ST(1..7) /= "LINE TW" THEN
-                     FAILED ("NOT POSITIONED RIGHT - GET CHAR");
-                END IF;
- 
- -- COUNT NUMBER OF CHARACTERS IN FIRST LINE (TO ALLOW FOR TRAILING
- --     BLANKS)
- 
-                COUNT := 0;
-                WHILE NOT END_OF_LINE(FILE1)
-                LOOP
-                     GET (FILE1, CH);
-                     OLDCH := CH;
-                     COUNT := COUNT + 1;
-                END LOOP;
- 
-                BEGIN
-                     GET (FILE1, CH);
-                     FAILED ("END_ERROR NOT RAISED - GET " &
-                             "CHARACTER");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          IF CH /= OLDCH THEN
-                               FAILED ("CH MODIFIED ON END_" &
-                                       "ERROR");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED " &
-                                  "- GET CHARACTER");
-                END;
- 
-                CLOSE (FILE1);
- 
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
- 
-                SKIP_LINE (FILE1);
-                GET (FILE1, ST(1..7));
-                IF ST(1..7) /= "LINE TW" THEN
-                     FAILED ("WRONG LINE 2. ACTUALLY READ '" & ST(1..7) &
-                             "'");
-                END IF;
- 
-                BEGIN
-                     GET (FILE1, ST(8..8+COUNT));
-                     FAILED ("END_ERROR NOT RAISED - GET " &
-                             "STRING");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          IF ST(1..7) /= "LINE TW" THEN
-                               FAILED ("ST MODIFIED ON END_ERROR");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED " &
-                                  "- GET STRING");
-                END;
- 
-                CLOSE (FILE1);
- 
-           END;
- 
-           DECLARE
-                LAST : NATURAL;
-           BEGIN
- 
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
- 
-                SKIP_LINE (FILE1);
-                GET_LINE (FILE1, ST, LAST);
-                IF LAST < 8 THEN
-                     FAILED ("LAST < 8.  LAST IS" & INTEGER'IMAGE(LAST));
-                ELSIF ST(1..8) /= "LINE TWO" THEN
-                     FAILED ("GET_LINE FAILED. ACTUALLY READ '" &
-                             ST(1..8) & "'");
-                END IF;
- 
-                SKIP_PAGE (FILE1);
-                SKIP_PAGE (FILE1);
- 
-                BEGIN
-                     GET_LINE (FILE1, ST(1..1), LAST);
-                     FAILED ("END_ERROR NOT RAISED - GET_LINE - 1");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          IF LAST /= 8 THEN
-                               FAILED ("LAST MODIFIED BY GET_LINE " &
-                                       "ON END_ERROR.  LAST IS" &
-                                       INTEGER'IMAGE(LAST));
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION - GET_LINE - 1");
-                END;
- 
-                BEGIN     -- NULL ITEM ARGUMENT
-                     GET_LINE (FILE1, ST(1..0), LAST);
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          FAILED ("GET_LINE ATTEMPTED TO READ INTO A " &
-                                  "NULL STRING");
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION - GET_LINE - 2");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3603A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- -- CE3604A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET_LINE MAY BE CALLED TO RETURN AN ENTIRE LINE.  ALSO
- --     CHECK THAT GET_LINE MAY BE CALLED TO RETURN THE REMAINDER OF A
- --     PARTLY READ LINE.  ALSO CHECK THAT GET_LINE RETURNS IN THE
- --     PARAMETER LAST, THE INDEX VALUE OF THE LAST CHARACTER READ.
- --     WHEN NO CHARACTERS ARE READ, LAST IS ONE LESS THAN ITEM'S LOWER
- --     BOUND.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 09/25/87  COMPLETELY REVISED TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3604A IS
- 
- BEGIN
- 
-      TEST ("CE3604A", "CHECK THAT GET_LINE READS LINES APPROPRIATELY " &
-                       "AND CHECK THAT LAST RETURNS THE CORRECT INDEX " &
-                       "VALUE");
- 
-      DECLARE
-           FILE : FILE_TYPE;
-           STR : STRING (1 .. 25);
-           LAST : NATURAL;
-           ITEM1 : STRING (2 .. 6);
-           ITEM2 : STRING (3 .. 6);
-           CH : CHARACTER;
-           INCOMPLETE : EXCEPTION;
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, "FIRST LINE OF INPUT");
-           NEW_LINE (FILE);
-           PUT (FILE, "SECOND LINE OF INPUT");
-           NEW_LINE (FILE);
-           PUT (FILE, "THIRD LINE OF INPUT");
-           NEW_LINE (FILE);
-           NEW_LINE (FILE);
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET_LINE (FILE, STR, LAST);
- 
-           BEGIN
-                IF STR(1..LAST) /= "FIRST LINE OF INPUT" THEN
-                     FAILED ("GET_LINE - RETURN OF ENTIRE LINE");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT_ERROR RAISED AFTER " &
-                             "GET_LINE - 1");
-           END;
- 
-           GET (FILE, ITEM1);
-           GET_LINE (FILE, STR, LAST);
- 
-           BEGIN
-                IF STR(1..LAST) /= "D LINE OF INPUT" THEN
-                     FAILED ("GET_LINE - REMAINDER OF PARTLY READ LINE");
-                END IF;
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT_ERROR RAISED AFTER " &
-                             "GET_LINE - 2");
-           END;
- 
-           GET_LINE (FILE, ITEM1, LAST);
-           IF LAST /= 6 THEN
-                FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 1");
-           END IF;
- 
-           WHILE NOT END_OF_LINE (FILE) LOOP
-                GET (FILE, CH);
-           END LOOP;
- 
-           GET_LINE (FILE, ITEM1, LAST);
-           IF LAST /= 1 THEN
-                FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 2");
-           END IF;
- 
-           IF NOT END_OF_LINE (FILE) THEN
-                FAILED ("END_OF_LINE NOT TRUE");
-           END IF;
- 
-           GET_LINE (FILE, ITEM2, LAST);
-           IF LAST /= 2 THEN
-                FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 3");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3604A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- CE3604B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET_LINE DOES NOT DO A SKIP_LINE AND NO CHARACTERS ARE
- --     READ WHEN THE INPUT IS AT THEN END OF A LINE AND THE STRING
- --     PARAMETER IS A NULL STRING.  ALSO CHECK THAT GET_LINE DOES NOT
- --     SKIP THE LINE TERMINATOR AFTER READING ALL THE CHARACTERS INTO
- --     A STRING WHICH IS EXACTLY EQUAL TO THE NUMBER OF CHARACTERS
- --     REMAINING ON THAT LINE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 10/13/87  CREATED ORIGINAL TEST.
- 
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3604B IS
- 
- BEGIN
- 
-      TEST ("CE3604B", "CHECK THAT GET_LINE READS LINES APPROPRIATELY");
- 
-      DECLARE
-           INCOMPLETE : EXCEPTION;
-           FILE : FILE_TYPE;
-           ITEM1 : STRING (1 .. 19);
-           ITEM2 : STRING (1 .. 20);
-           NULL_ITEM : STRING (2 .. 1);
-           LAST : NATURAL;
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
- 
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
-                             "CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, "FIRST LINE OF INPUT");
-           NEW_LINE (FILE);
-           PUT (FILE, "SECOND LINE OF INPUT");
-           NEW_LINE (FILE);
-           PUT (FILE, "THIRD LINE OF INPUT");
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE, ITEM1);
-           IF ITEM1 /= "FIRST LINE OF INPUT" THEN
-                FAILED ("INCORRECT VALUE FOR GET");
-           END IF;
- 
-           GET_LINE (FILE, NULL_ITEM, LAST);
- 
-           IF LINE (FILE) /= 1 THEN
-                FAILED ("INCORRECT LINE NUMBER AFTER GET_LINE - 1");
-           END IF;
- 
-           IF COL (FILE) /= 20 THEN
-                FAILED ("INCORRECT COLUMN NUMBER AFTER GET_LINE - 1");
-           END IF;
- 
-           SKIP_LINE (FILE);
-           GET_LINE (FILE, ITEM2, LAST);
-           IF ITEM2 /= "SECOND LINE OF INPUT" THEN
-                FAILED ("INCORRECT VALUE FOR GET_LINE");
-           END IF;
- 
-           IF LINE (FILE) /= 2 THEN
-                FAILED ("INCORRECT LINE NUMBER AFTER GET_LINE - 2");
-           END IF;
- 
-           IF COL (FILE) /= 21 THEN
-                FAILED ("INCORRECT COLUMN NUMBER AFTER GET_LINE - 2");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3604B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- CE3605A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT FOR CHARACTER AND STRING PARAMETERS DOES NOT
- --     UPDATE THE LINE NUMBER WHEN THE LINE LENGTH IS UNBOUNDED,
- --     ONLY THE COLUMN NUMBER.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     SPS 09/02/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND ADDED CHECKS
- --                   FOR COLUMN NUMBER.
- --     RJW 03/28/90  REVISED NUMERIC LITERALS USED IN LOOPS.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3605A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3605A", "CHECK THAT PUT FOR CHARACTER AND STRING " &
-                       "PARAMETERS DOES NOT UPDATE THE LINE NUMBER " &
-                       "WHEN THE LINE LENGTH IS UNBOUNDED, ONLY THE " &
-                       "COLUMN NUMBER");
- 
-      DECLARE
-           FILE1 : FILE_TYPE;
-           LN : POSITIVE_COUNT := 1;
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "FOR TEMPORARY FILES WITH " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           LN := LINE (FILE1);
- 
-           IF LN /= 1 THEN
-                FAILED ("CURRENT LINE NUMBER NOT INITIALLY ONE");
-           END IF;
- 
-           IF COL (FILE1) /= 1 THEN
-                FAILED ("CURRENT COLUMN NUMBER NOT INITIALLY ONE");
-           END IF;
- 
-           FOR I IN 1 .. IDENT_INT(240) LOOP
-                PUT(FILE1, 'A');
-           END LOOP;
-           IF LINE (FILE1) /= LN THEN
-                FAILED ("PUT ALTERED LINE NUMBER - CHARACTER");
-           END IF;
- 
-           IF COL(FILE1) /= 241 THEN
-                FAILED ("COLUMN NUMBER NOT UPDATED CORRECTLY - 1");
-           END IF;
- 
-           NEW_LINE(FILE1);
-           LN := LINE (FILE1);
- 
-           FOR I IN 1 .. IDENT_INT(40) LOOP
-                PUT (FILE1, "STRING");
-           END LOOP;
-           IF LN /= LINE (FILE1) THEN
-                FAILED ("PUT ALTERED LINE NUMBER - STRING");
-           END IF;
- 
-           IF COL(FILE1) /= 241 THEN
-                FAILED ("COLUMN NUMBER NOT UPDATED CORRECTLY - 2");
-           END IF;
- 
-           CLOSE (FILE1);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3605A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- CE3605B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE;
- --     CHECK THAT PUT OUTPUTS A LINE TERMINATOR, RESETS THE COLUMN
- --     NUMBER AND INCREMENTS THE LINE NUMBER WHEN THE LINE LENGTH IS
- --     BOUNDED AND THE COLUMN NUMBER EQUALS THE LINE LENGTH WHEN PUT
- --     IS CALLED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/02/82
- --     JBG 12/28/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  GAVE FILE A NAME AND REMOVED CODE WHICH RESETS
- --                   THE FILE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- PROCEDURE CE3605B IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3605B", "CHECK THAT PUT PROPERLY MAINTAINS THE " &
-                       "LINE NUMBER AND COLUMN NUMBER WHEN THE " &
-                       "LINE LENGTH IS BOUNDED");
- 
-      DECLARE
-           FILE1 : FILE_TYPE;
-           LN_CNT : POSITIVE_COUNT;
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FILE1, 5);
-           LN_CNT := LINE (FILE1);
- 
-           FOR I IN 1 .. 5 LOOP
-                PUT (FILE1, 'X');
-           END LOOP;
- 
-           IF COL(FILE1) /= 6 THEN
-                FAILED ("COLUMN NUMBER NOT INCREMENTED - PUT; " &
-                        "VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
-           END IF;
- 
-           IF LINE(FILE1) /= LN_CNT THEN
-                FAILED ("LINE COUNT MODIFIED - PUT CHARACTER; " &
-                        "VALUE WAS" & COUNT'IMAGE(LINE(FILE1)));
-           END IF;
- 
-           PUT (FILE1, 'X');
-           IF COL(FILE1) /= 2 THEN
-                FAILED ("COLUMN NUMBER NOT RESET - PUT CHARACTER; " &
-                        "VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
-           END IF;
- 
-           IF LINE(FILE1) /= LN_CNT + 1 THEN
-                FAILED("LINE NUMBER NOT INCREMENTED - PUT CHARACTER; " &
-                        "VALUE WAS" & COUNT'IMAGE(LINE(FILE1)));
-           END IF;
- 
-           NEW_LINE (FILE1);
- 
-           SET_LINE_LENGTH (FILE1, 4);
-           LN_CNT := LINE (FILE1);
- 
-           PUT (FILE1, "XXXX");
- 
-           IF COL(FILE1) /= 5 THEN
-                FAILED ("COLUMN NUMBER NOT INCREMENTED - PUT STRING; " &
-                        "VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
-           END IF;
- 
-           IF LINE (FILE1) /= LN_CNT THEN
-                FAILED ("LINE NUMBER INCREMENTED - PUT STRING; " &
-                        "VALUE WAS" & COUNT'IMAGE(LINE (FILE1)));
-           END IF;
- 
-           PUT (FILE1, "STR");
- 
-           IF COL(FILE1) /= 4 THEN
-                FAILED ("COLUMN NUMBER NOT SET CORRECTLY - PUT" &
-                        "STRING; VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
-           END IF;
- 
-           IF LINE (FILE1) /= LN_CNT + 1 THEN
-                FAILED ("LINE NUMBER NOT INCREMENTED - PUT STRING; " &
-                        "VALUE WAS" & COUNT'IMAGE(LINE (FILE1)));
-           END IF;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3605B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- CE3605C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT RAISES MODE_ERROR FOR FILES OF MODE IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/02/82
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3605C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3605C", "MODE_ERROR RAISED BY PUT FOR IN_FILES");
- 
-      DECLARE
-           FILE1 : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE1, 'A');
-           CLOSE (FILE1);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
-                                     "OPEN FOR IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (FILE1, 'A');
-                FAILED ("MODE_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                PUT (STANDARD_INPUT, 'A');
-                FAILED ("MODE_ERROR NOT RAISED - 2");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                PUT (CURRENT_INPUT, 'A');
-                FAILED ("MODE_ERROR NOT RAISED - 3");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 3");
-           END;
- 
-           BEGIN
-                PUT (FILE1, "STRING");
-                FAILED ("MODE_ERROR NOT RAISED - 4");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 4");
-           END;
- 
-           BEGIN
-                PUT (STANDARD_INPUT, "STRING");
-                FAILED ("MODE_ERROR NOT RAISED - 5");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 5");
-           END;
- 
-           BEGIN
-                PUT (CURRENT_INPUT, "STRING");
-                FAILED ("MODE_ERROR NOT RAISED - 6");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 6");
-           END;
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3605C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- CE3605D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT DOES NOT RAISE LAYOUT_ERROR WHEN THE NUMBER OF
- --     CHARACTERS TO BE OUTPUT EXCEEDS THE LINE LENGTH.
- --     CHECK THAT PUT HAS THE EFFECT OF NEW_LINE (AS WELL AS
- --     OUTPUTTING THE ITEM) WHEN THE NUMBER OF CHARACTERS TO BE OUTPUT
- --     OVERFLOWS A BOUNDED LINE LENGTH.
- --     CHECK THAT PUT WITH A NULL STRING PERFORMS NO OPERATION.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/02/82
- --     JBG 12/28/82
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- PROCEDURE CE3605D IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3605D", "CHECK THAT LAYOUT_ERROR IS NOT RAISED BY PUT " &
-                       "FOR STRING");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           LC : POSITIVE_COUNT;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
-                             "TEXT CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FT, 5);
- 
-           BEGIN
-                PUT (FT, "STRING");
- 
-                IF LINE(FT) /= 2 THEN
-                     FAILED ("LINE COUNT WAS" & COUNT'IMAGE(LINE(FT)) &
-                             " INSTEAD OF 2");
-                END IF;
- 
-                IF COL(FT) /= 2 THEN
-                     FAILED ("COLUMN COUNT WAS" & COUNT'IMAGE(COL(FT)) &
-                             " INSTEAD OF 2");
-                END IF;
- 
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED - 1");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
- 
-           END;
- 
-           PUT (FT, "NEW");
- 
-           IF LINE(FT) /= 2 THEN
-                FAILED ("LINE COUNT WRONG - 2; WAS" &
-                        COUNT'IMAGE(LINE(FT)) &
-                        " INSTEAD OF 2");
-           END IF;
- 
-           IF COL(FT) /= 5 THEN
-                FAILED ("COL COUNT WRONG - 2; WAS" &
-                        COUNT'IMAGE(COL(FT)) &
-                        " INSTEAD OF 5");
-           END IF;
- 
-           BEGIN
-                PUT (FT, "STR");
-                IF LINE (FT) /= 3 THEN
-                     FAILED ("PUT STRING WHEN IN MIDDLE OF " &
-                             "LINE DOES NOT HAVE EFFECT OF " &
-                             "NEW_LINE; LINE COUNT IS" &
-                             COUNT'IMAGE(LINE(FT)));
-                END IF;
- 
-                IF COL(FT) /= 3 THEN
-                     FAILED ("COL COUNT WRONG - 3; WAS" &
-                             COUNT'IMAGE(COL(FT)) &
-                             " INSTEAD OF 3");
-                END IF;
- 
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED - 2");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
-           END;
- 
-           PUT (FT, "ING");
- 
-           IF LINE(FT) /= 3 THEN
-                FAILED ("LINE COUNT WRONG - 3; WAS" &
-                        COUNT'IMAGE(LINE(FT)) &
-                        " INSTEAD OF 3");
-           END IF;
- 
-           IF COL(FT) /= 6 THEN
-                FAILED ("COL COUNT WRONG - 3;  WAS" &
-                        COUNT'IMAGE(COL(FT)) &
-                        " INSTEAD OF 6");
-           END IF;
- 
-           BEGIN
-                PUT (FT, "");
- 
-                IF LINE(FT) /= 3 THEN
-                     FAILED ("LINE COUNT WRONG - 3; WAS" &
-                             COUNT'IMAGE(LINE(FT)) &
-                             " INSTEAD OF 3");
-                END IF;
- 
-                IF COL(FT) /= 6 THEN
-                     FAILED ("COL COUNT WRONG - 3;  WAS" &
-                             COUNT'IMAGE(COL(FT)) &
-                             " INSTEAD OF 6");
-                END IF;
- 
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED - 3");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
-           END;
- 
-           CHECK_FILE (FT,
-                       "STRIN#" &
-                       "GNEWS#" &
-                       "TRING#@%");
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3605D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- CE3605E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT CAN BE CALLED WITH CHARACTER AND STRING
- --     PARAMETERS.  CHECK THAT FILES OF MODE OUT_FILE ARE USED AND
- --     THAT WHEN NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE
- --     IS USED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     SPS 10/06/82
- --     JBG 12/28/82
- --     VKG 02/15/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/08/87  REMOVED UNNECESSARY CODE AND CHECKED FOR
- --                   USE_ERROR ON DELETE.
- 
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- PROCEDURE CE3605E IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3605E", "CHECK THAT PUT FOR STRINGS AND CHARACTERS " &
-                       "OPERATES ON OUT_FILE FILES");
- 
-      DECLARE
-           FT , FILE : FILE_TYPE;
-           X : CHARACTER;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "FOR TEMPORARY FILE WITH " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FILE);
- 
-           SET_OUTPUT (FILE);
- 
-           PUT (FT, 'O');
- 
-           PUT (FT, "UTPUT STRING");
- 
-           PUT ('X');
- 
-           PUT ("UTPUT STRING");
- 
- -- CHECK OUTPUT
- 
-           SET_OUTPUT (STANDARD_OUTPUT);
-           COMMENT ("CHECKING FT");
-           CHECK_FILE (FT, "OUTPUT STRING#@%");
-           COMMENT ("CHECKING FILE");
-           CHECK_FILE (FILE, "XUTPUT STRING#@%");
- 
-           CLOSE (FT);
-           CLOSE (FILE);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3605E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,91 ****
- -- CE3606A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT_LINE WILL OUTPUT A LINE TERMINATOR WHEN THE
- --     STRING PARAMETER IS NULL.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEMPORARY TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/02/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/09/87  REMOVED UNNECESSARY CODE AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- PROCEDURE CE3606A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3606A", "PUT_LINE PUTS LINE TERMINATOR WHEN STRING " &
-                       "IS NULL");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           NS1 : STRING (1 .. 0);
-           NS2 : STRING (3 .. 1);
-           LC : POSITIVE_COUNT := 1;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "FOR TEMP FILES WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT_LINE (FT, NS1);
-           IF LINE (FT) /= LC + 1 THEN
-                FAILED ("PUT_LINE OF NULL STRING 1; LINE " &
-                        "COUNT WAS" & COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           PUT_LINE (FT, NS2);
-           IF LINE (FT) /= LC + 2 THEN
-                FAILED ("PUT_LINE OF NULL STRING 2; LINE " &
-                        "COUNT WAS" & COUNT'IMAGE(LINE(FT)));
-           END IF;
- 
-           CHECK_FILE (FT, "##@%");
- 
-           CLOSE (FT);
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3606A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,97 ****
- -- CE3606B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT_LINE WILL OUTPUT A LINE ON MORE THAN ONE LINE
- --     WHEN THE LINE LENGTH IS BOUNDED, IF THE STRING IS GREATER
- --     THAN THE LINE LENGTH.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEMPORARY TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/02/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/09/87  REMOVED UNNECESSARY CODE AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- PROCEDURE CE3606B IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3606B", "CHECK THAT PUT_LINE WILL OUTPUT A LINE " &
-                       "ON MORE THAN ONE LINE WHEN THE LINE " &
-                       "LENGTH IS BOUNDED, IF THE STRING IS " &
-                       "GREATER THAN THE LINE LENGTH");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           LONG_LINE : CONSTANT STRING := "THIS LINE IS A LONG " &
-                "LINE WHICH WHEN OUTPUT SHOULD SPAN OVER SEVERAL " &
-                "LINES IN THE OUTPUT FILE";
-      BEGIN
- 
-           BEGIN
-                CREATE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "FOR TEMP FILES WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FT, 10);
- 
-           PUT_LINE (FT, LONG_LINE);
-           PUT_LINE (FT, "AA");
- 
-           CHECK_FILE (FT, "THIS LINE #" &
-                           "IS A LONG #" &
-                           "LINE WHICH#" &
-                           " WHEN OUTP#" &
-                           "UT SHOULD #" &
-                           "SPAN OVER #" &
-                           "SEVERAL LI#" &
-                           "NES IN THE#" &
-                           " OUTPUT FI#" &
-                           "LE#" &
-                           "AA#@%");
- 
-           CLOSE (FT);
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3606B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- CE3701A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET AND PUT OF INTEGER_IO RAISE STATUS_ERROR IF
- --     THE FILE IS NOT OPEN.
- 
- -- HISTORY:
- --     ABW 08/27/82
- --     JBG 08/30/83
- --     DWC 09/09/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
- --                   HANDLING, AND ATTEMPTED TO CREATE A FILE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3701A IS
- 
-      PACKAGE INT_IO IS NEW INTEGER_IO (INTEGER);
-      USE INT_IO;
-      FILE : FILE_TYPE;
-      INT_ITEM : INTEGER := 7;
- 
- BEGIN
- 
-      TEST ("CE3701A", "CHECK THAT GET AND PUT RAISE " &
-                        "STATUS_ERROR IF THE FILE " &
-                        "IS NOT OPEN");
- 
-      BEGIN
-           PUT (FILE, IDENT_INT(8));
-           FAILED ("STATUS_ERROR NOT RAISED WHEN PUT APPLIED " &
-                   "TO A NON-EXISTENT FILE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED WHEN PUT " &
-                        "APPLIED TO A NON-EXISTENT FILE");
-      END;
- 
-      BEGIN
-           GET (FILE, INT_ITEM);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN GET APPLIED " &
-                   "TO A NON-EXISTENT FILE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED WHEN GET " &
-                        "APPLIED TO A NON-EXISTENT FILE");
-      END;
- 
-      BEGIN
-           CREATE (FILE);     -- THIS IS JUST AN ATTEMPT TO CREATE
-           CLOSE (FILE);      -- A FILE.  WHETHER THIS IS SUCCESSFUL
-      EXCEPTION               -- OR NOT HAS NO EFFECT ON TEST
-           WHEN USE_ERROR =>  -- OBJECTIVE.
-                NULL;
-      END;
- 
-      BEGIN
-           PUT (FILE, IDENT_INT(8));
-           FAILED ("STATUS_ERROR NOT RAISED WHEN PUT APPLIED " &
-                   "TO AN UNOPENED FILE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED WHEN PUT " &
-                        "APPLIED TO AN UNOPENED FILE");
-      END;
- 
-      BEGIN
-           GET (FILE, INT_ITEM);
-           FAILED ("STATUS_ERROR NOT RAISED WHEN GET APPLIED " &
-                   "TO AN UNOPENED FILE");
-      EXCEPTION
-           WHEN STATUS_ERROR =>
-                NULL;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED WHEN GET " &
-                        "APPLIED TO AN UNOPENED FILE");
-      END;
- 
-      RESULT;
- 
- END CE3701A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- CE3704A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- HISTORY:
- --     CHECK THAT GET FOR INTEGER_IO CAN OPERATE ON ANY FILE OF MODE
- --     IN_FILE AND THAT IF NO FILE IS SPECIFIED THE CURRENT DEFAULT
- --     INPUT FILE IS USED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/01/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/09/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
- --                   HANDLING, AND REMOVED DEPENDENCE ON RESET.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3704A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3704A", "CHECK THAT GET FOR INTEGER_IO CAN OPERATE " &
-                       "ON ANY FILE OF MODE IN_FILE AND THAT IF " &
-                       "NO FILE IS SPECIFIED THE CURRENT DEFAULT " &
-                       "INPUT FILE IS USED");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           FT2: FILE_TYPE;
-           TYPE NI IS NEW INTEGER RANGE 1 .. 700;
-           X : NI;
-           PACKAGE IIO IS NEW INTEGER_IO (NI);
-           USE IIO;
-      BEGIN
- 
- -- CREATE AND INITIALIZE DATA FILES
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, '3');
-           PUT (FT, '6');
-           PUT (FT, '9');
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           PUT (FT2, '6');
-           PUT (FT2, '2');
-           PUT (FT2, '4');
- 
-           CLOSE (FT2);
-           OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           SET_INPUT (FT2);
- 
-           GET (FT, X);
- 
-           IF X /= 369 THEN
-                FAILED ("GET RETURNED WRONG VALUE; VALUE WAS" &
-                        NI'IMAGE(X));
-           END IF;
- 
-           GET (X);
- 
-           IF X /= 624 THEN
-                FAILED ("GET FOR DEFAULT WAS WRONG; VALUE WAS" &
-                        NI'IMAGE(X));
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-                DELETE (FT2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3704A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- CE3704B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO GET RAISES MODE_ERROR FOR FILES OF MODE
- --     OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/04/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/09/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3704B IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3704B", "CHECK THAT INTEGER_IO GET RAISES " &
-                       "MODE_ERROR FOR FILES OF MODE OUT_FILE");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE INT IS NEW INTEGER RANGE 1 .. 10;
-           PACKAGE IIO IS NEW INTEGER_IO (INT);
-           USE IIO;
-           X : INT := 10;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE);
-                PUT (FT, '3');
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "FOR TEMP FILE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("MODE_ERROR NOT RAISED - FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FILE");
-           END;
- 
-           BEGIN
-                GET (STANDARD_OUTPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - STANDARD_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - STANDARD_OUTPUT");
-           END;
- 
-           BEGIN
-                GET (CURRENT_OUTPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - CURRENT_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CURRENT_OUTPUT");
-           END;
- 
-           CLOSE (FT);
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3704B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,176 ****
- -- CE3704C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO GET RAISES CONSTRAINT_ERROR IF THE
- --     WIDTH PARAMETER IS NEGATIVE, IF THE WIDTH PARAMETER IS
- --     GREATER THAN FIELD'LAST WHEN FIELD'LAST IS LESS THAN
- --     INTEGER'LAST, OR THE VALUE READ IS OUT OF THE RANGE OF
- --     THE ITEM PARAMETER BUT WITHIN THE RANGE OF INSTANTIATED
- --     TYPE.
- 
- -- HISTORY:
- --     SPS 10/04/82
- --     DWC 09/09/87  ADDED CASES FOR WIDTH BEING GREATER THAN
- --                   FIELD'LAST AND THE VALUE BEING READ IS OUT
- --                   OF ITEM'S RANGE BUT WITHIN INSTANTIATED
- --                   RANGE.
- --     JRL 06/07/96  Added call to Ident_Int in expressions involving
- --                   Field'Last, to make the expressions non-static and
- --                   prevent compile-time rejection.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3704C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3704C", "CHECK THAT INTEGER_IO GET RAISES " &
-                       "CONSTRAINT_ERROR IF THE WIDTH PARAMETER " &
-                       "IS NEGATIVE, IF THE WIDTH PARAMETER IS " &
-                       "GREATER THAN FIELD'LAST WHEN FIELD'LAST IS " &
-                       "LESS THAN INTEGER'LAST, OR THE VALUE READ " &
-                       "IS OUT OF THE RANGE OF THE ITEM PARAMETER " &
-                       "BUT WITHIN THE RANGE OF INSTANTIATED TYPE");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE INT IS NEW INTEGER RANGE 1 .. 10;
-           PACKAGE IIO IS NEW INTEGER_IO (INT);
-           X : INT RANGE 1 .. 5;
-           USE IIO;
-      BEGIN
- 
-           BEGIN
-                GET (FT, X, IDENT_INT(-1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("RAISED STATUS_ERROR");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FILE");
-           END;
- 
-           BEGIN
-                GET (X, IDENT_INT(-6));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - DEFAULT");
-           END;
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, 1);
-           NEW_LINE (FT);
-           PUT (FT, 8);
-           NEW_LINE (FT);
-           PUT (FT, 2);
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR FOR OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                GET (FT, X, IDENT_INT(-1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                        "NEGATIVE WIDTH WITH EXTERNAL FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - " &
-                             "NEGATIVE WIDTH WITH EXTERNAL FILE");
-           END;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                        "OUT OF RANGE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - " &
-                             "OUT OF RANGE");
-           END;
- 
-           SKIP_LINE (FT);
- 
-           IF FIELD'LAST < INTEGER'LAST THEN
-                BEGIN
-                     GET (FT, X, FIELD'LAST + Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                             "FIELD'LAST + 1 WIDTH WITH " &
-                             "EXTERNAL FILE");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIELD'LAST + 1 WIDTH WITH " &
-                                  "EXTERNAL FILE");
-                END;
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE3704C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,169 ****
- -- CE3704D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO GET READS AT MOST WIDTH CHARACTERS
- --     OR UP TO THE NEXT TERMINATOR; INCLUDING LEADING BLANKS
- --     AND HORIZONTAL TABULATION CHARACTERS, WHEN WIDTH IS
- --     NONZERO.
- 
- --     CHECK THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS
- --     ENCOUNTERED AND THAT DATA_ERROR IS RAISED IF THE DATA
- --     READ IS INVALID.
- 
- -- APPLICABILITY CRITERIA:
- 
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/04/82
- --     VKG 01/12/83
- --     SPS 02/08/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/09/87  ADDED CASES FOR TABS, REMOVED UNNECESSARY
- --                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3704D IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3704D", "CHECK THAT INTEGER_IO GET READS AT MOST " &
-                       "WIDTH CHARACTERS OR UP TO THE NEXT " &
-                       "TERMINATOR; INCLUDING LEADING BLANKS AND " &
-                       "HORIZONTAL TABULATION CHARACTERS, WHEN WIDTH " &
-                       "IS NONZERO");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           X : INTEGER;
-           PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-           USE IIO;
-      BEGIN
- 
- -- CREATE AND INITIALIZE FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "  123");
-           NEW_LINE (FT);
-           PUT (FT, "-5678");
-           NEW_LINE (FT);
-           PUT (FT, "  ");
-           NEW_PAGE (FT);
-           PUT (FT, ASCII.HT & "9");
-           NEW_PAGE (FT);
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
- -- BEGIN TEST
- 
-           GET (FT, X, 5);
-           IF X /= IDENT_INT (123) THEN
-                FAILED ("WIDTH CHARACTERS NOT READ - 1");
-           ELSE
-                BEGIN
-                     GET (FT, X, 2);
-                     FAILED ("DATA_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED -1");
-                END;
-                SKIP_LINE (FT);
-                GET (FT, X, 6);
-                IF X /= IDENT_INT (-5678) THEN
-                     FAILED ("GET WITH WIDTH " &
-                             "INCORRECT - 2");
-                ELSE
-                     BEGIN
-                          GET (FT, X, 2);
-                          FAILED ("DATA_ERROR NOT RAISED - 2");
-                     EXCEPTION
-                          WHEN DATA_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - 2");
-                     END;
-                     SKIP_LINE(FT);
-                     BEGIN
-                          GET (FT, X, 2);
-                          FAILED ("DATA_ERROR NOT RAISED - 3");
-                     EXCEPTION
-                          WHEN DATA_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED - 3");
-                     END;
-                     SKIP_LINE(FT);
-                     GET (FT, X, 2);
-                     IF X /= IDENT_INT (9) THEN
-                          FAILED ("GET WITH WIDTH " &
-                                  "INCORRECT - 3");
-                     END IF;
-                END IF;
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3704D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,143 ****
- -- CE3704E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO GET RAISES DATA_ERROR WHEN THE LEXICAL
- --     ELEMENT IS NOT OF THE INTEGER TYPE EXPECTED.  CHECK THAT ITEM
- --     IS UNAFFECTED AND READING CAN CONTINUE AFTER THE EXCEPTION
- --     HAS BEEN HANDLED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/04/82
- --     VKG 01/14/83
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/10/87  REMOVED UNNECCESSARY CODE, CORRECTED EXCEPTION
- --                   HANDLING, AND CHECKED FOR USE_ERROR ON DELETE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3704E IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3704E", "CHECK THAT INTEGER_IO GET RAISES DATA_ERROR " &
-                       "WHEN THE LEXICAL ELEMENT IS NOT OF THE " &
-                       "INTEGER TYPE EXPECTED.  CHECK THAT ITEM " &
-                       "IS UNAFFECTED AND READING CAN CONTINUE AFTER " &
-                       "THE EXCEPTION HAS BEEN HANDLED");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE INT IS NEW INTEGER RANGE 10 .. 20;
-           PACKAGE IIO IS NEW INTEGER_IO (INT);
-           USE IIO;
-           X : INT := 16;
-      BEGIN
- 
- -- CREATE AND INITIALIZE FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, " 101 12");
-           CLOSE(FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                GET (FT, X, 2);
-                FAILED ("DATA_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     IF X /= 16 THEN
-                          FAILED ("ITEM AFFECTED BY GET WHEN DATA" &
-                                  "_ERROR IS RAISED");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                GET (FT, X, 3);
-                FAILED ("DATA_ERROR NOT RAISED - 2");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     IF X /= 16 THEN
-                          FAILED ("ITEM AFFECTED BY GET WHEN DATA" &
-                                  "_ERROR IS RAISED");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                GET (FT, X, 2);
-                IF X /= 12 THEN
-                     FAILED ("READING NOT CONTINUED CORRECTLY " &
-                             "AFTER EXCEPTION");
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("GET OF CORRECT DATA RAISED EXCEPTION");
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3704E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,365 ****
- -- CE3704F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO GET DOES NOT ALLOW EMBEDDED BLANKS OR
- --     CONSECUTIVE UNDERSCORES TO BE INPUT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/04/82
- --     VKG 01/14/83
- --     CPP 07/30/84
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/10/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
- --                   HANDLING, AND ADDED MORE CHECKS OF THE VALUES
- --                   OF CHARACTERS READ.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3704F IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3704F", "INTEGER_IO GET DOES NOT ALLOW EMBEDDED " &
-                       "BLANKS OR CONSECUTIVE UNDERSCORES");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           X : INTEGER;
-           PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-           USE IIO;
-           CH : CHARACTER;
-           P : POSITIVE;
-      BEGIN
- 
- -- CREATE AND INITIALIZE FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "12_345");
-           NEW_LINE (FT);
-           PUT (FT, "12 345");
-           NEW_LINE (FT);
-           PUT (FT, "1__345");
-           NEW_LINE (FT);
-           PUT (FT, "-56");
-           NEW_LINE (FT);
-           PUT (FT, "10E0");
-           NEW_LINE (FT);
-           PUT (FT, "10E-2X");
-           NEW_LINE (FT);
-           PUT (FT, "4E1__2");
-           NEW_LINE (FT);
-           PUT (FT, "1 0#99#");
-           NEW_LINE (FT);
-           PUT (FT, "1__0#99#");
-           NEW_LINE (FT);
-           PUT (FT, "10#9_9#");
-           NEW_LINE (FT);
-           PUT (FT, "10#9__9#");
-           NEW_LINE (FT);
-           PUT (FT, "10#9 9#");
-           NEW_LINE (FT);
-           PUT (FT, "16#E#E1");
-           NEW_LINE (FT);
-           PUT (FT, "2#110#E1_1");
-           NEW_LINE (FT);
-           PUT (FT, "2#110#E1__1");
-           CLOSE(FT);
- 
- -- BEGIN TEST
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; " &
-                                     "TEXT OPEN WITH IN_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FT, X);
-           IF X /= 12345 THEN
-                FAILED ("GET WITH UNDERSCORE INCORRECT - (1)");
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X, 6);
-                FAILED ("DATA_ERROR NOT RAISED - (2)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (2)");
-           END;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("DATA_ERROR NOT RAISED - (3)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (3)");
-           END;
- 
-           IF END_OF_LINE (FT) THEN
-                FAILED ("GET STOPPED AT END OF LINE - (3)");
-           ELSE
-                GET (FT, CH);
-                IF CH /= '_' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(3): CHAR IS " & CH);
-                END IF;
-                GET (FT, CH);
-                IF CH /= '3' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(3.5): CHAR IS " & CH);
-                END IF;
-           END IF;
- 
-           SKIP_LINE (FT);
-           GET (FT, X);
-           IF X /= (-56) THEN
-                FAILED ("GET WITH GOOD CASE INCORRECT - (4)");
-           END IF;
- 
-           SKIP_LINE (FT);
-           GET (FT, X, 4);
-           IF X /= 10 THEN
-                FAILED ("GET WITH ZERO EXPONENT INCORRECT - (5)");
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("DATA_ERROR NOT RAISED - (6)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (6)");
-           END;
- 
-           IF END_OF_LINE (FT) THEN
-                FAILED ("GET STOPPED AT END OF LINE - (6)");
-           ELSE
-                GET (FT, CH);
-                IF CH /= 'X' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(6): CHAR IS " & CH);
-                END IF;
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("DATA_ERROR NOT RAISED - (7)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (7)");
-           END;
- 
-           IF END_OF_LINE (FT) THEN
-                FAILED ("GET STOPPED AT END OF LINE - (7)");
-           ELSE
-                GET (FT, CH);
-                IF CH /= '_' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(7): CHAR IS " & CH);
-                END IF;
-                GET (FT, CH);
-                IF CH /= '2' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(7.5): CHAR IS " & CH);
-                END IF;
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X, 7);
-                FAILED ("DATA_ERROR NOT RAISED - (8)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (8)");
-           END;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("DATA_ERROR NOT RAISED - (9)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (9)");
-           END;
- 
-           IF END_OF_LINE (FT) THEN
-                FAILED ("GET STOPPED AT END OF LINE - (9)");
-           ELSE
-                GET (FT, CH);
-                IF CH /= '_' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION " &
-                             "- (9): CHAR IS " & CH);
-                END IF;
-                GET (FT, CH);
-                IF CH /= '0' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION " &
-                             "- (9.5): CHAR IS " & CH);
-                END IF;
-           END IF;
- 
-           SKIP_LINE (FT);
-           GET (FT, X);
-           IF X /= 99 THEN
-                FAILED ("GET WITH UNDERSCORE IN " &
-                        "BASED LITERAL INCORRECT - (10)");
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("DATA_ERROR NOT RAISED - (11)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (11)");
-           END;
- 
-           IF END_OF_LINE (FT) THEN
-                FAILED ("GET STOPPED AT END OF LINE - (11)");
-           ELSE
-                GET (FT, CH);
-                IF CH /= '_' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(11): CHAR IS " & CH);
-                END IF;
-                GET (FT, CH);
-                IF CH /= '9' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(11.5): CHAR IS " & CH);
-                END IF;
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X, 6);
-                FAILED ("DATA_ERROR NOT RAISED - (12)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (12)");
-           END;
- 
-           SKIP_LINE (FT);
-           GET (FT, X, 7);
-           IF X /= 224 THEN
-                FAILED ("GET WITH GOOD CASE OF " &
-                        "BASED LITERAL INCORRECT - (13)");
-           END IF;
- 
-           SKIP_LINE (FT);
-           GET (FT, X, 10);
-           IF X /= (6 * 2 ** 11) THEN
-                FAILED ("GET WITH UNDERSCORE IN EXPONENT" &
-                        "OF BASED LITERAL INCORRECT - (14)");
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("DATA_ERROR NOT RAISED - (15)");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - (15)");
-           END;
- 
-           IF END_OF_LINE (FT) THEN
-                FAILED ("GET STOPPED AT END OF LINE - (15)");
-           ELSE
-                GET (FT, CH);
-                IF CH /= '_' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(15): CHAR IS " & CH);
-                END IF;
-                GET (FT, CH);
-                IF CH /= '1' THEN
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(15.5): CHAR IS " & CH);
-                END IF;
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3704F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- CE3704M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR INTEGER_IO RAISES DATA_ERROR WHEN
- --     THE INPUT CONTAINS
- --
- --     (1)  INTEGER_IO DECIMAL POINT
- --     (2)  INTEGER_IO LEADING OR TRAILING UNDERSCORES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     VKG 02/10/83
- --     CPP 07/30/84
- --     EG  05/22/85
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  REMOVED UNNECESSARY CODE, CORRECTED
- --                   EXCEPTION HANDLING, AND ADDED CASES WHICH
- --                   CHECK GET AT THE END_OF_FILE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3704M IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3704M", "CHECK THAT DATA_ERROR IS RAISED FOR " &
-                       "INTEGER_IO WHEN A DECIMAL POINT, OR " &
-                       "LEADING OR TRAILING UNDERSCORES " &
-                       "ARE DETECTED");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           CH : CHARACTER;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "3.14152");
-           NEW_LINE (FT);
-           PUT (FT, "2.15");
-           NEW_LINE (FT);
-           PUT (FT, "_312");
-           NEW_LINE (FT);
-           PUT (FT, "-312_");
- 
-           CLOSE (FT);
- 
-           DECLARE
-                PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
-                USE INT_IO;
-                X : INTEGER := 402;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                BEGIN
-                     GET (FT, X, 3);
-                     FAILED ("DATA_ERROR NOT RAISED - (1)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - (1)");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - (1)");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= '4' THEN
-                          FAILED ("GET STOPPED AT WRONG " &
-                                  "POSITION - (1): CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     IF X /= 2 THEN
-                          FAILED ("WRONG VALUE READ - (2)");
-                     END IF;
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          FAILED ("DATA_ERROR RAISED - (2)");
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - (2)");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - (2)");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= '.' THEN
-                          FAILED ("GET STOPPED AT WRONG " &
-                                  "POSITION - (2): CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - (3)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - (3)");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - (3)");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= '_' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- (3): CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - (4)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED - (4)");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     FAILED ("END_OF_LINE NOT TRUE AFTER (4)");
-                END IF;
- 
-                BEGIN
-                     DELETE (FT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3704M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,229 ****
- -- CE3704N.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR INTEGER_IO RAISES DATA_ERROR WHEN:
- --     (A) BASE LESS THAN 2 OR GREATER THAN 16
- --     (B) THE LETTERS IN BASE ARE OUT OF THE BASE RANGE
- --     (C) THERE IS NO CLOSING '#' SIGN FOR A BASED LITERAL
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     VKG 02/10/83
- --     SPS 03/16/83
- --     CPP 07/30/84
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  REMOVED UNNECESSARY CODE, CORRECTED
- --                   EXCEPTION HANDLING, AND CHECKED FOR
- --                   USE_ERROR ON DELETE.
- 
- WITH TEXT_IO; USE TEXT_IO;
- WITH REPORT ; USE REPORT ;
- 
- PROCEDURE CE3704N IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE3704N" ,"CHECK THAT DATA_ERROR IS RAISED WHEN " &
-                       "A BASED LITERAL DOES NOT HAVE ITS BASE " &
-                       "IN THE RANGE 2 .. 16, DIGIT IS OUTSIDE " &
-                       "THE BASE RANGE, OR THERE IS NO CLOSING " &
-                       "'#' SIGN");
- 
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "1#0000#");
-           NEW_LINE (FT);
-           PUT (FT, "A#234567#");
-           NEW_LINE (FT);
-           PUT (FT, "17#123#1");
-           NEW_LINE (FT);
-           PUT (FT, "5#1253#2");
-           NEW_LINE (FT);
-           PUT (FT, "8#123");
-           CLOSE (FT);
- 
-           DECLARE
-                PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
-                USE INT_IO;
-                X : INTEGER := 1003;
-                CH : CHARACTER;
-           BEGIN
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - (1)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1003 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - (1)");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     GET (FT, CH);
-                     FAILED ("GET STOPPED AT WRONG POSITION - " &
-                             "(1): CHAR IS " & CH);
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - (2)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1003 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - (2)");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - (2)");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - (2)");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= 'A' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- (2): CHAR IS " & CH);
-                          END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - (2A)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1003 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - (2A)");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - (2A)");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     GET (FT, CH);
-                     IF CH /= '1' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- (2A): CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - (3)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1003 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - (3)");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - (3)");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     GET (FT, CH);
-                     IF CH /= '2' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION - " &
-                                  "(3): CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - (4)");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1003 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - (4)");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - (4)");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     GET (FT, CH);
-                     IF CH /= ' ' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- (4): CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3704N;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,161 ****
- -- CE3704O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET WILL RAISE DATA_ERROR IF THE USE OF # AND :
- --     IN BASED LITERALS IS MIXED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     VKG 02/10/83
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  REMOVED UNNECESSARY CODE AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH TEXT_IO; USE TEXT_IO;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CE3704O IS
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE3704O", "CHECK THAT MIXED USE OF # AND : " &
-                       "IN BASED LITERALS WILL RAISE DATA_ERROR");
- 
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
- 
-           PUT_LINE (FT, "8#77#E+1");
-           PUT_LINE (FT, "2:110:");
-           PUT (FT, "2#11:");
-           NEW_LINE (FT);
-           PUT (FT, "4:223#");
-           NEW_LINE (FT);
-           CLOSE (FT);
- 
- 
-           DECLARE
-                PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
-                USE INT_IO;
-                X : INTEGER := 100;
-                CH : CHARACTER;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X);
-                IF X /= 8#77#E+1 THEN
-                     FAILED ("INCORRECT VALUE - 1");
-                END IF;
- 
-                GET (FT, X);
-                IF X /= 2#110# THEN
-                     FAILED ("INCORRECT VALUE - 2");
-                END IF;
- 
-                BEGIN
-                     X := 100;
-                     GET (FT,X);
-                     FAILED ("DATA_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 100 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 1");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     GET (FT, CH);
-                     IF CH /= ':' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION - 1");
-                     END IF;
-                END IF;
- 
-                BEGIN
-                     X := 100;
-                     GET (FT,X);
-                     FAILED ("DATA_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 100 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 2");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 2");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     GET (FT, CH);
-                          IF CH /='#' THEN
-                               FAILED ("GET STOPPED AT WRONG " &
-                                       "POSITION - 1");
-                          END IF;
-                END IF;
- 
-                BEGIN
-                     DELETE (FT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
-      RESULT;
- 
- END CE3704O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- CE3705A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     FOR GET FROM A FILE, CHECK THAT IF ONLY THE FILE TERMINATOR
- --     REMAINS TO BE READ, THEN ANY CALL TO GET FOR AN INTEGER (EVEN
- --     WITH WIDTH = 0) RAISES END_ERROR.
- 
- -- HISTORY:
- --     BCB 10/28/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3705A IS
- 
-      FILE : FILE_TYPE;
- 
-      INCOMPLETE : EXCEPTION;
- 
-      I : INTEGER;
- 
-      PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER); USE INT_IO;
- 
- BEGIN
-      TEST ("CE3705A", "FOR GET FROM A FILE, CHECK THAT IF ONLY THE " &
-                       "FILE TERMINATOR REMAINS TO BE READ, THEN ANY " &
-                       "CALL TO GET FOR AN INTEGER (EVEN WITH WIDTH = " &
-                       "0) RAISES END_ERROR");
- 
-      BEGIN
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, 3);
- 
-           CLOSE (FILE);
- 
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
- 
-           GET (FILE, I);
- 
-           BEGIN
-                GET (FILE, I);
-                FAILED ("END_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                GET (FILE, I, WIDTH => 0);
-                FAILED ("END_ERROR NOT RAISED - 2");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("OTHER EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE3705A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- CE3705B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     IF WIDTH IS ZERO, CHECK THAT END_ERROR IS RAISED IF THE ONLY
- --     REMAINING CHARACTERS IN THE FILE CONSIST OF LINE TERMINATORS,
- --     PAGE TERMINATORS, SPACES, AND HORIZONTAL TABULATION CHARACTERS.
- --     AFTER END_ERROR IS RAISED, THE FILE SHOULD BE POSITIONED BEFORE
- --     THE FILE TERMINATOR AND END_OF_FILE SHOULD BE TRUE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3705B IS
- 
-      PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-      USE IIO;
- 
-      FILE : FILE_TYPE;
-      ITEM : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3705B", "IF WIDTH IS ZERO, CHECK THAT END_ERROR IS " &
-                       "RAISED IF THE ONLY REMAINING CHARACTERS IN " &
-                       "THE FILE CONSIST OF LINE TERMINATORS, PAGE " &
-                       "TERMINATORS, SPACES, AND HORIZONTAL TAB " &
-                       "CHARACTERS. AFTER END_ERROR IS RAISED, THE " &
-                       "FILE SHOULD BE POSITIONED BEFORE THE FILE " &
-                       "TERMINATOR AND END_OF_FILE SHOULD BE TRUE");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, 2);
-           NEW_LINE (FILE);
-           PUT (FILE, 3);
-           NEW_LINE (FILE);
-           NEW_PAGE (FILE);
-           PUT (FILE, ASCII.HT);
-           NEW_LINE (FILE);
-           NEW_LINE (FILE);
-           NEW_PAGE (FILE);
-           PUT (FILE, ' ');
-           PUT (FILE, ASCII.HT);
-           PUT (FILE, ' ');
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                     "MODE IN_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE, ITEM);
-           IF ITEM /= 2 THEN
-                FAILED ("INCORRECT VALUE READ - 1");
-           END IF;
- 
-           GET (FILE, ITEM);
-           IF ITEM /= 3 THEN
-                FAILED ("INCORRECT VALUE READ - 2");
-           END IF;
- 
-           BEGIN
-                GET (FILE, ITEM, WIDTH => 0);
-                FAILED ("END_ERROR NOT RAISED FOR GET");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
-           END;
- 
-           IF NOT END_OF_FILE(FILE) THEN
-                FAILED ("END_OF_FILE NOT TRUE AFTER RAISING EXCEPTION");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3705B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- CE3705C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE LAST CHARACTER IN A FILE MAY BE READ WITHOUT
- --     RAISING END_ERROR, AND THAT AFTER THE LAST CHARACTER OF THE
- --     FILE HAS BEEN READ, ANY ATTEMPT TO READ FURTHER CHARACTERS
- --     WILL RAISE END_ERROR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/18/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3705C IS
- 
-      PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-      USE IIO;
- 
-      FILE : FILE_TYPE;
-      ITEM : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3705C", "CHECK THAT THE LAST CHARACTER IN A FILE MAY " &
-                       "BE READ WITHOUT RAISING END_ERROR, AND THAT " &
-                       "AFTER THE LAST CHARACTER OF THE FILE HAS BEEN " &
-                       "READ, ANY ATTEMPT TO READ FURTHER CHARACTERS " &
-                       "WILL RAISE END_ERROR");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
- 
-           PUT (FILE, 2);
-           PUT (FILE, 3);
-           NEW_LINE (FILE);
-           NEW_PAGE (FILE);
-           PUT (FILE, 5);
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                     "MODE IN_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE, ITEM);
-           GET (FILE, ITEM);
- 
-           BEGIN
-                GET (FILE, ITEM);
-                IF ITEM /= 5 THEN
-                     FAILED ("INCORRECT VALUE READ");
-                END IF;
-                BEGIN
-                     GET (FILE, ITEM);
-                     FAILED ("END_ERROR NOT RAISED AFTER LAST " &
-                             "CHARACTER OF FILE HAS BEEN READ");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
-                END;
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("END_ERROR RAISED WHEN READING LAST " &
-                             "CHARACTER OF FILE");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON GET - 2");
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3705C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- CE3705D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DATA_ERROR, NOT END_ERROR, IS RAISED WHEN WIDTH > 0,
- --     FEWER THAN WIDTH CHARACTERS REMAIN IN THE FILE, A BASED LITERAL
- --     IS BEING READ, AND THE CLOSING # OR : HAS NOT YET BEEN FOUND.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/19/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3705D IS
- 
-      PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-      USE IIO;
- 
-      FILE : FILE_TYPE;
-      ITEM : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3705D", "CHECK THAT DATA_ERROR, NOT END_ERROR, IS " &
-                       "RAISED WHEN WIDTH > 0, FEWER THAN WIDTH " &
-                       "CHARACTERS REMAIN IN THE FILE, A BASED " &
-                       "LITERAL IS BEING READ, AND THE CLOSING # " &
-                       "OR : HAS NOT YET BEEN FOUND");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, "2#1111_1111#");
-           NEW_LINE (FILE);
-           PUT (FILE, "16#FFF");
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN " &
-                                     "WITH MODE IN_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE, ITEM);
-           IF ITEM /= 255 THEN
-                FAILED ("INCORRECT VALUE READ");
-           END IF;
- 
-           BEGIN
-                GET (FILE, ITEM, WIDTH => 7);
-                FAILED ("DATA_ERROR NOT RAISED");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("END_ERROR INSTEAD OF DATA_ERROR RAISED");
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3705D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- CE3705E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DATA_ERROR, NOT END_ERROR, IS RAISED WHEN FEWER THAN
- --     WIDTH CHARACTERS REMAIN IN THE FILE, AND THE REMAINING CHARACTERS
- --     SATISFY THE SYNTAX FOR A REAL LITERAL.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/20/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3705E IS
- 
-      PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-      USE IIO;
- 
-      FILE : FILE_TYPE;
-      ITEM : INTEGER;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3705E", "CHECK THAT DATA_ERROR, NOT END_ERROR, IS " &
-                       "RAISED WHEN FEWER THAN WIDTH CHARACTERS " &
-                       "REMAIN IN THE FILE, AND THE REMAINING " &
-                       "CHARACTERS SATISFY THE SYNTAX FOR A REAL " &
-                       "LITERAL");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, "16#FFF#");
-           NEW_LINE (FILE);
-           PUT (FILE, "3.14159_26");
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN " &
-                                     "WITH MODE IN_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE, ITEM);
-           IF ITEM /= 4095 THEN
-                FAILED ("INCORRECT VALUE READ");
-           END IF;
- 
-           BEGIN
-                GET (FILE, ITEM, WIDTH => 11);
-                FAILED ("DATA_ERROR NOT RAISED");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("END_ERROR INSTEAD OF DATA_ERROR RAISED");
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
-           END;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3705E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,164 ****
- -- CE3706C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO PUT RAISES CONSTRAINT_ERROR IF:
- --        A) THE BASE IS OUTSIDE THE RANGE 2..16.
- --        B) THE VALUE OF WIDTH IS NEGATIVE OR GREATER THAN FIELD'LAST,
- --           WHEN FIELD'LAST < INTEGER'LAST.
- --        C) THE VALUE OF ITEM IS OUTSIDE THE RANGE OF THE INSTANTIATED
- --           TYPE.
- 
- -- HISTORY:
- --     SPS 10/05/82
- --     JBG 08/30/83
- --     JLH 09/10/87  ADDED CASES FOR THE VALUE OF THE WIDTH BEING LESS
- --                   THAN ZERO AND GREATER THAN FIELD'LAST AND CASES FOR
- --                   THE VALUE OF ITEM OUTSIDE THE RANGE OF THE
- --                   INSTANTIATED TYPE.
- --     JRL 06/07/96  Added call to Ident_Int in expressions involving
- --                   Field'Last, to make the expressions non-static and
- --                   prevent compile-time rejection.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3706C IS
- BEGIN
- 
-      TEST ("CE3706C", "CHECK THAT INTEGER_IO PUT RAISES CONSTRAINT " &
-                       "ERROR APPROPRIATELY");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE INT IS NEW INTEGER RANGE 1 .. 10;
-           PACKAGE IIO IS NEW INTEGER_IO (INT);
-           USE IIO;
-           ST : STRING (1 .. 10);
-      BEGIN
- 
-           BEGIN
-                PUT (FT, 2, 6, 1);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE - 1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FILE - 1");
-           END;
- 
-           BEGIN
-                PUT (3, 4, 17);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT - 1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - DEFAULT - 1");
-           END;
- 
-           BEGIN
-                PUT (TO => ST, ITEM => 4, BASE => -3);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - STRING - 1");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - STRING - 1");
-           END;
- 
-           BEGIN
-                PUT (ST, 5, 17);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - STRING - 2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - STRING - 2");
-           END;
- 
-           BEGIN
-                PUT (FT, 5, -1);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE - 2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FILE - 2");
-           END;
- 
-           BEGIN
-                PUT (7, -3);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT - " &
-                        "2");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - DEFAULT - 2");
-           END;
- 
-           IF FIELD'LAST < INTEGER'LAST THEN
-                BEGIN
-                     PUT (7, FIELD'LAST+Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED FOR WIDTH " &
-                             "GREATER THAN FIELD'LAST");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED FOR WIDTH " &
-                                  "GREATER THAN FIELD'LAST");
-                END;
- 
-           END IF;
- 
-           BEGIN
-                PUT (FT, 11);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
-                        "RANGE - FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
-                             "RANGE - FILE");
-           END;
- 
-           BEGIN
-                PUT (11);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
-                        "RANGE - DEFAULT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
-                             "RANGE - DEFAULT");
-           END;
- 
-      END;
- 
-      RESULT;
- END CE3706C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,127 ****
- -- CE3706D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO PUT RAISES MODE_ERROR FOR FILES OF MODE
- --     IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/05/82
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/10/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, AND CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3706D IS
- 
- BEGIN
- 
-      TEST ("CE3706D", "CHECK THAT INTEGER_IO PUT RAISES MODE_ERROR " &
-                       "FOR FILES OF MODE IN_FILE");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE INT IS NEW INTEGER RANGE 1 .. 30;
-           PACKAGE IIO IS NEW INTEGER_IO (INT);
-           USE IIO;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
- 
-           BEGIN
-                PUT (STANDARD_INPUT, 26);
-                FAILED ("MODE_ERROR NOT RAISED - STANDARD_INPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - STANDARD_INPUT");
-           END;
- 
-           BEGIN
-                PUT (CURRENT_INPUT, 26);
-                FAILED ("MODE_ERROR NOT RAISED - CURRENT_INPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CURRENT_INPUT");
-           END;
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, 'A');
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (FT, 26);
-                FAILED ("MODE_ERROR NOT RAISED - FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FILE");
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3706D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,119 ****
- -- CE3706F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO PUT RAISES LAYOUT_ERROR WHEN THE NUMBER OF
- --     CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.  CHECK
- --     THAT IT IS NOT RAISED WHEN THE NUMBER OF CHARACTERS TO BE OUTPUT
- --     ADDED TO THE CURRENT COLUMN NUMBER EXCEEDS THE MAXIMUM LINE
- --     LENGTH.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- HISTORY:
- --     SPS 10/05/82
- --     VKG 01/14/83
- --     SPS 02/18/83
- --     JBG 08/30/83
- --     EG  05/22/85
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/10/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
- --                   HANDLING, AND ADDED CASE USING WIDTH OF FIVE.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3706F IS
- 
- BEGIN
- 
-      TEST ("CE3706F", "CHECK THAT LAYOUT_ERROR IS RAISED CORRECTLY");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-           USE IIO;
-           INCOMPLETE : EXCEPTION;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "FOR TEMPORARY FILE WITH " &
-                                     "OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FT, 4);
- 
-           BEGIN
-                PUT (FT, 32_000, WIDTH => 0);
-                FAILED ("LAYOUT_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                PUT (FT, 32_000, WIDTH => 5);
-                FAILED ("LAYOUT_ERROR NOT RAISED - 2");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2");
-           END;
- 
-           PUT (FT, 123, WIDTH => 0);  -- "123"
- 
-           BEGIN
-                PUT (FT, 457, WIDTH => 0);  -- "123#457"
-                IF LINE (FT) /= 2 THEN
-                     FAILED ("OUTPUT INCORRECT");
-                END IF;
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED INCORRECTLY");
-           END;
- 
-           CHECK_FILE (FT, "123#457#@%");
- 
-           CLOSE (FT);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3706F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- CE3706G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO PUT USES THE MINIMUM FIELD REQUIRED IF
- --     WIDTH IS TOO SMALL AND THE LINE LENGTH IS SUFFICIENTLY LARGE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/05/82
- --     JLH 09/17/87  COMPLETELY REVISED TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3706G IS
- 
- BEGIN
- 
-      TEST ("CE3706G", "CHECK THAT INTEGER_IO PUT USES THE MINIMUM " &
-                       "FIELD REQUIRED IF WIDTH IS TOO SMALL AND THE " &
-                       "LINE LENGTH IS SUFFICIENTLY LARGE");
- 
-      DECLARE
-           FILE : FILE_TYPE;
-           PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-           USE IIO;
-           INCOMPLETE : EXCEPTION;
-           NUM : INTEGER := 12345;
-           CH : CHARACTER;
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, NUM, WIDTH => 3);
-           TEXT_IO.PUT (FILE, ' ');
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE, NUM);
-           GET (FILE, CH);
-           IF CH /= ' ' AND COL(FILE) /= 7 THEN
-                FAILED ("INTEGER_IO PUT DOES NOT USE MINIMUM FIELD " &
-                        "REQUIRED WHEN WIDTH IS TOO SMALL");
-           END IF;
- 
-           IF NUM /= 12345 THEN
-                FAILED ("INCORREC VALUE READ");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3706G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,130 ****
- -- CE3707A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO GET CAN READ A VALUE FROM A STRING.  CHECK
- --     THAT IT TREATS THE END OF THE STRING AS A FILE TERMINATOR.  CHECK
- --     THAT LAST CONTAINS THE INDEX VALUE OF THE LAST CHARACTER READ
- --     FROM THE STRING.
- 
- -- HISTORY:
- --     SPS 10/05/82
- --     VKG 01/13/83
- --     JLH 09/11/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3707A IS
- 
-      PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-      USE IIO;
-      X : INTEGER;
-      L : POSITIVE;
-      STR : STRING(1..6) := "123456" ;
- 
- BEGIN
- 
-      TEST ("CE3707A", "CHECK THAT INTEGER_IO GET OPERATES CORRECTLY " &
-                       "ON STRINGS");
- 
- -- LEFT JUSTIFIED STRING NON NULL
- 
-      GET ("2362  ", X, L);
-      IF X /= 2362 THEN
-           FAILED ("VALUE FROM STRING INCORRECT - 1");
-      END IF;
- 
-      IF L /= 4 THEN
-           FAILED ("VALUE OF LAST INCORRECT - 1");
-      END IF;
- 
- -- STRING LITERAL WITH BLANKS
- 
-      BEGIN
-           GET ("  ", X, L);
-           FAILED ("END_ERROR NOT RAISED - 2");
-      EXCEPTION
-           WHEN END_ERROR =>
-                IF L /= 4 THEN
-                     FAILED ("AFTER END ERROR VALUE OF LAST " &
-                             "INCORRECT - 2");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("WRONG EXCEPTION RAISED - 2");
-      END;
- 
- -- NULL STRING
- 
-      BEGIN
-           GET ("", X, L);
-           FAILED (" END_ERROR NOT RAISED - 3");
-      EXCEPTION
-           WHEN END_ERROR =>
-                IF L /= 4 THEN
-                     FAILED ("AFTER END_ERROR VALUE OF LAST " &
-                             "INCORRECT - 3");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("SOME EXCEPTION RAISED - 3");
-      END;
- 
- -- NULL SLICE
- 
-      BEGIN
-           GET(STR(5..IDENT_INT(2)), X, L);
-           FAILED ("END_ERROR NOT RAISED - 4");
-      EXCEPTION
-           WHEN END_ERROR =>
-                IF L /= 4 THEN
-                     FAILED ("AFTER END_ERROR VALUE OF LAST " &
-                             "INCORRECT - 4");
-                END IF;
-           WHEN OTHERS =>
-                FAILED ("SOME EXCEPTION RAISED - 4");
-      END;
- 
- -- NON-NULL SLICE
- 
-      GET (STR(2..3), X, L);
-      IF X /= 23 THEN
-            FAILED ("INTEGER VALUE INCORRECT - 5");
-      END IF;
-      IF L /= 3 THEN
-           FAILED ("LAST INCORRECT FOR SLICE - 5");
-      END IF;
- 
- -- RIGHT JUSTIFIED NEGATIVE NUMBER
- 
-      GET("   -2345",X,L);
-      IF X /= -2345 THEN
-           FAILED ("INTEGER VALUE INCORRECT - 6");
-      END IF;
-      IF L /= 8 THEN
-           FAILED ("LAST INCORRECT FOR NEGATIVE NUMBER - 6");
-      END IF;
- 
-      RESULT;
- 
- END CE3707A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- CE3708A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT INTEGER_IO PUT RAISES LAYOUT_ERROR WHEN THE MINIMUM
- --     WIDTH REQUIRED FOR THE OUTPUT VALUE IS GREATER THAN THE LENGTH
- --     OF THE STRING.  ALSO CHECK THAT INTEGER_IO PUT PADS THE OUTPUT
- --     ON THE LEFT WITH SPACES IF THE LENGTH OF THE STRING IS GREATER
- --     THAN THE MINIMUM WIDTH REQUIRED.
- 
- -- HISTORY:
- --     SPS 10/05/82
- --     CPP 07/30/84
- --     JLH 09/11/87  ADDED CASES FOR PADDING OF OUTPUT STRING.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3708A IS
- BEGIN
- 
-      TEST ("CE3708A", "CHECK THAT INTEGER_IO PUT RAISES LAYOUT_ERROR " &
-                       "WHEN THE MINIMUM WIDTH REQUIRED FOR THE " &
-                       "OUTPUT VALUE IS GREATER THAN THE LENGTH OF " &
-                       "THE STRING.  ALSO CHECK THAT INTEGER_IO PUT " &
-                       "PADS THE OUTPUT ON THE LEFT WITH SPACES IF " &
-                       "THE LENGTH OF THE STRING IS GREATER THAN THE " &
-                       "MINIMUM WIDTH REQUIRED.");
- 
-      DECLARE
-           PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
-           USE IIO;
-           ST1 : STRING (1 .. 4);
-           ST2 : STRING (1 .. 4);
-           ST : STRING (1 .. 4) := "6382";
-      BEGIN
-           PUT (ST1, IDENT_INT(6382));
-           IF ST1 /= ST THEN
-                FAILED ("PUT TO STRING INCORRECT");
-           END IF;
- 
-           BEGIN
-                PUT (ST2, IDENT_INT(12345));
-                FAILED ("LAYOUT_ERROR NOT RAISED");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END;
- 
-           PUT (ST1, IDENT_INT(123));
-           IF ST1 /= " 123" THEN
-                FAILED ("PUT DID NOT PAD WITH BLANKS - 1");
-           END IF;
- 
-           PUT (ST2, IDENT_INT(-2));
-           IF ST2 /= "  -2" THEN
-                FAILED ("PUT DID NOT PAD WITH BLANKS - 2");
-           END IF;
- 
-      END;
- 
-      RESULT;
- 
- END CE3708A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,112 ****
- -- CE3801A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EACH FLOAT_IO OPERATION RAISES STATUS_ERROR WHEN
- --     CALLED WITH A FILE PARAMETER DESIGNATING AN UN-OPEN FILE.
- 
- -- HISTORY:
- --     SPS 09/07/82
- --     SPS 12/22/82
- --     DWC 09/11/87  CORRECTED EXCEPTION HANDLING AND REVISED IFS
- --                   TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF
- --                   WHAT IS EXPECTED.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3801A IS
- BEGIN
- 
-      TEST ("CE3801A", "CHECK THAT EACH FLOAT_IO AND FIXED_IO " &
-                       "OPERATION RAISES STATUS_ERROR WHEN CALLED " &
-                       "WITH A FILE PARAMETER DESIGNATING AN " &
-                       "UN-OPEN FILE");
- 
-      DECLARE
-           TYPE FLT IS NEW FLOAT RANGE 1.0 .. 10.0;
-           PACKAGE FLT_IO IS NEW FLOAT_IO (FLT);
-           USE FLT_IO;
-           X : FLT := FLT'FIRST;
-           FT : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - GET FLOAT_IO - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET " &
-                             "FLOAT_IO - 1");
-           END;
- 
-           BEGIN
-                PUT (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT FLOAT_IO - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT " &
-                             "FLOAT_IO - 1");
-           END;
- 
-           BEGIN
-                CREATE (FT, OUT_FILE);    -- THIS IS JUST AN ATTEMPT
-                CLOSE (FT);               -- TO CREATE A FILE.
-           EXCEPTION                      -- OBJECTIVE MET EITHER WAY.
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - GET FLOAT_IO - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET " &
-                             "FLOAT_IO - 2");
-           END;
- 
-           BEGIN
-                PUT (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT FLOAT_IO - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT " &
-                             "FLOAT_IO - 2");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE3801A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- CE3801B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT EACH FIXED_IO OPERATION RAISES STATUS_ERROR
- --     WHEN CALLED WITH A FILE PARAMETER DESIGNATING AN UN-OPEN FILE.
- 
- -- HISTORY:
- --     DWC 09/11/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3801B IS
- BEGIN
- 
-      TEST ("CE3801B", "CHECK THAT EACH FIXED_IO " &
-                       "OPERATION RAISES STATUS_ERROR WHEN CALLED " &
-                       "WITH A FILE PARAMETER DESIGNATING AN " &
-                       "UN-OPEN FILE");
- 
-      DECLARE
-           TYPE FIX IS DELTA 0.1 RANGE 1.0 .. 10.0;
-           PACKAGE FIX_IO IS NEW FIXED_IO (FIX);
-           USE FIX_IO;
-           X : FIX := FIX'LAST;
-           FT : FILE_TYPE;
- 
-      BEGIN
-           BEGIN
-                GET (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET " &
-                             "FIXED_IO - 1");
-           END;
- 
-           BEGIN
-                PUT (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT " &
-                             "FIXED_IO - 1");
-           END;
- 
-           BEGIN
-                CREATE (FT, OUT_FILE);   -- THIS IS JUST AN ATTEMPT TO
-                CLOSE (FT);              -- CREATE A FILE.  OBJECTIVE
-           EXCEPTION                     -- IS MET EITHER WAY.
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET " &
-                             "FIXED_IO - 2");
-           END;
- 
-           BEGIN
-                PUT (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT " &
-                             "FIXED_IO - 2");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE3801B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- CE3804A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR FLOAT_IO READS A PLUS OR MINUS SIGN
- --     IF PRESENT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/07/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  CORRECTED EXCEPTION HANDLING AND REVISED IFS
- --                   TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF WHAT
- --                   IS EXPECTED.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804A", "CHECK THAT GET FOR FLOAT_IO READS A PLUS OR " &
-                       "MINUS SIGN IF PRESENT");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE FL IS NEW FLOAT RANGE -3.0 .. 3.0;
-           X : FL;
-           ST1 : CONSTANT STRING := IDENT_STR ("-3.0");
-           ST2 : CONSTANT STRING := IDENT_STR ("+2.0");
-           ST3 : CONSTANT STRING := IDENT_STR ("1.0");
-      BEGIN
- 
- -- CREATE AND INITIALIZE DATA FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, ST1);
-           NEW_LINE(FT);
-           PUT (FT, ST2);
-           NEW_LINE(FT);
-           PUT (FT, ST3);
-           NEW_LINE(FT);
-           CLOSE (FT);
- 
- -- BEGIN TEST
- 
-           DECLARE
-                PACKAGE FL_IO IS NEW FLOAT_IO (FL);
-                USE FL_IO;
-                LST : POSITIVE;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X);
-                IF X = 3.0 THEN
-                     FAILED ("MINUS SIGN NOT READ - 1");
-                ELSIF X /= -3.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 1");
-                END IF;
- 
-                GET (FT, X);
-                IF X = -2.0 THEN
-                     FAILED ("PLUS SIGN NOT READ - 2");
-                ELSIF X /= +2.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 2");
-                END IF;
- 
-                GET (FT, X);
-                IF X /= 1.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 3");
-                END IF;
- 
-                GET (ST1, X, LST);
-                IF X = 3.0 THEN
-                     FAILED ("MINUS SIGN NOT READ - 4");
-                ELSIF X /= -3.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 4");
-                END IF;
- 
-                GET (ST2, X, LST);
-                IF X = -2.0 THEN
-                     FAILED ("PLUS SIGN NOT READ - 5");
-                ELSIF X /= +2.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 5");
-                END IF;
- 
-                GET (ST3, X, LST);
-                IF X /= 1.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 6");
-                END IF;
- 
-                BEGIN
-                     DELETE (FT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- -- CE3804B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR FIXED_IO READS A PLUS OR MINUS SIGN IF
- --     PRESENT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/07/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  CORRECTED EXCEPTION HANDLING AND REVISED IFS
- --                   TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF
- --                   WHAT IS EXPECTED.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804B IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804B", "CHECK THAT GET FOR FIXED_IO READS A PLUS OR " &
-                       "MINUS SIGN IF PRESENT");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE FIX IS DELTA 0.01 RANGE -3.0 .. 3.0;
-           X : FIX;
-           ST1 : CONSTANT STRING := IDENT_STR("-3.0");
-           ST2 : CONSTANT STRING := IDENT_STR("+2.0");
-           ST3 : CONSTANT STRING := IDENT_STR("1.0");
-      BEGIN
- 
- -- CREATE AND INITIALIZE DATA FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, ST1);
-           NEW_LINE(FT);
-           PUT (FT, ST2);
-           NEW_LINE(FT);
-           PUT (FT, ST3);
-           NEW_LINE(FT);
-           CLOSE (FT);
- 
-           DECLARE
-                PACKAGE FIX_IO IS NEW FIXED_IO (FIX);
-                USE FIX_IO;
-                LST : POSITIVE;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X);
-                IF X /= -3.0 THEN
-                     FAILED ("MINUS SIGN NOT READ - 1");
-                END IF;
- 
-                GET (FT, X);
-                IF X /= +2.0 THEN
-                     FAILED ("PLUS SIGN NOT READ - 2");
-                END IF;
- 
-                GET (FT, X);
-                IF X /= 1.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 3");
-                END IF;
- 
-                GET (ST1, X, LST);
-                IF X /= -3.0 THEN
-                     FAILED ("MINUS SIGN NOT READ - 4");
-                END IF;
- 
-                GET (ST2, X, LST);
-                IF X /= +2.0 THEN
-                     FAILED ("PLUS SIGN NOT READ - 5");
-                END IF;
- 
-                GET (ST3, X, LST);
-                IF X /= 1.0 THEN
-                     FAILED ("INCORRECT VALUE READ - 6");
-                END IF;
- 
-                BEGIN
-                     DELETE (FT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- CE3804C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- HISTORY:
- --     CHECK THAT GET FOR FLOAT_IO RAISES MODE_ERROR WHEN THE
- --     MODE IS NOT IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/07/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  SPLIT CASE FOR FIXED_IO INTO CE3804O.ADA
- --                   AND CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804C", "CHECK THAT GET FOR FLOAT_IO RAISES " &
-                       "MODE_ERROR WHEN THE MODE IS NOT IN_FILE");
- 
-      DECLARE
-           FT2 : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT2, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "FOR TEMP FILES WITH OUT_FILE " &
-                                     "MODE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           DECLARE
-                PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT);
-                USE FL_IO;
-                X : FLOAT;
-           BEGIN
- 
-                BEGIN
-                     GET (FT2, X);
-                     FAILED ("MODE_ERROR NOT RAISED - FLOAT " &
-                             "UN-NAMED FILE");
-                EXCEPTION
-                     WHEN MODE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FLOAT UN-NAMED FILE");
-                END;
- 
-                BEGIN
-                     GET (STANDARD_OUTPUT, X);
-                     FAILED ("MODE_ERROR NOT RAISED - FLOAT " &
-                             "STANDARD_OUTPUT");
-                EXCEPTION
-                     WHEN MODE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FLOAT STANDARD_OUTPUT");
-                END;
- 
-                BEGIN
-                     GET (CURRENT_OUTPUT, X);
-                     FAILED ("MODE_ERROR NOT RAISED - FLOAT " &
-                             "CURRENT_OUTPUT");
-                EXCEPTION
-                     WHEN MODE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FLOAT CURRENT_OUTPUT");
-                END;
- 
-           END;
- 
-           CLOSE (FT2);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,153 ****
- -- CE3804D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO GET RAISES DATA_ERROR WHEN THE DATA
- --     READ IS OUT-OF-RANGE.  CHECK THAT ITEM IS LEFT UNAFFECTED
- --     AND THAT READING MAY CONTINUE AFTER THE EXCEPTION HAS
- --     BEEN HANDLED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/07/82
- --     SPS 02/10/83
- --     JBG 08/30/83
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  REMOVED UNNECESSARY CODE AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804D IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804D", "FLOAT_IO GET RAISES DATA_ERROR FOR " &
-                       "OUT-OF-RANGE DATA");
- 
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
- 
- -- CREATE AND INITIALIZE TEST FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "1.25");
-           NEW_LINE (FT);
-           PUT (FT, "-7.5");
-           NEW_LINE (FT);
-           PUT (FT, "3.5");
-           NEW_LINE (FT);
-           PUT (FT, "2.5");
-           NEW_LINE (FT);
-           CLOSE (FT);
- 
- -- BEGIN TEST
- 
-           DECLARE
-                TYPE FL IS NEW FLOAT RANGE 1.0 .. 3.0;
-                PACKAGE FL_IO IS NEW FLOAT_IO (FL);
-                X : FL;
-                USE FL_IO;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1.25 THEN
-                               FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
-                                       "IS RAISED - 1");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 1");
-                END;
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1.25 THEN
-                               FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
-                                       "IS RAISED - 2");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 2");
-                END;
- 
-                GET (FT, X);
-                IF X /= 2.5 THEN
-                     FAILED ("READING NOT CONTINUED CORRECTLY " &
-                             "AFTER DATA_ERROR");
-                END IF;
- 
-                BEGIN
-                     DELETE (FT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,154 ****
- -- CE3804E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO GET RAISES DATA_ERROR WHEN THE DATA READ IS
- --     OUT-OF-RANGE CHECK THAT ITEM IS LEFT UNAFFECTED AND THAT
- --     READING MAY CONTINUE AFTER THE EXCEPTION HAS BEEN HANDLED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/07/82
- --     SPS 02/10/83
- --     JBG 08/30/83
- --     EG  11/02/84
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/11/87  REMOVED UNNECESSARY CODE AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804E IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804E", "FIXED_IO GET RAISES DATA_ERROR FOR " &
-                       "OUT-OF-RANGE DATA");
- 
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
- 
- -- CREATE AND INITIALIZE TEST FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "1.25");
-           NEW_LINE (FT);
-           PUT (FT, "-7.5");
-           NEW_LINE (FT);
-           PUT (FT, "3.5");
-           NEW_LINE (FT);
-           PUT (FT, "2.5");
-           NEW_LINE (FT);
-           CLOSE (FT);
- 
- -- BEGIN TEST
- 
-           DECLARE
-                TYPE FX IS DELTA 0.001 RANGE 1.0 .. 3.0;
-                PACKAGE FX_IO IS NEW FIXED_IO (FX);
-                X : FX;
-                USE FX_IO;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X, 0);
- 
-                BEGIN
-                     GET (FT, X, 0);
-                     FAILED ("DATA_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1.25 THEN
-                               FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
-                                       "IS RAISED - 1");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 1");
-                END;
- 
-                BEGIN
-                     GET (FT, X, 0);
-                     FAILED ("DATA_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1.25 THEN
-                               FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
-                                       "IS RAISED - 2");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 2");
-                END;
- 
-                GET (FT, X, 0);
-                IF X /= 2.5 THEN
-                     FAILED ("READING NOT CONTINUED CORRECTLY " &
-                             "AFTER DATA_ERROR");
-                END IF;
- 
-                BEGIN
-                     DELETE (FT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
- 
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,206 ****
- -- CE3804F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO GET RAISES CONSTRAINT_ERROR WHEN THE VALUE
- --     SUPPLIED BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN FIELD'LAST
- --     WHEN FIELD'LAST IS LESS THAN INTEGER'LAST, OR THE VALUE READ IS
- --     OUT OF RANGE OF THE ITEM PARAMETER, BUT WITHIN THE RANGE OF THE
- --     SUBTYPE USED TO INSTANTIATE FLOAT_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/07/82
- --     JBG 08/30/83
- --     DWC 09/11/87  SPLIT CASE FOR FIXED_IO INTO CE3804P.ADA AND
- --                   CORRECTED EXCEPTION HANDLING.
- --     JRL 06/07/96  Added call to Ident_Int in expressions involving
- --                   Field'Last, to make the expressions non-static and
- --                   prevent compile-time rejection.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804F IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804F", "CHECK THAT FLOAT_IO GET RAISES " &
-                       "CONSTRAINT_ERROR WHEN THE VALUE SUPPLIED " &
-                       "BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN " &
-                       "FIELD'LAST WHEN FIELD'LAST IS LESS THAN " &
-                       "INTEGER'LAST, OR THE VALUE READ IS OUT OF " &
-                       "RANGE OF THE ITEM PARAMETER, BUT WITHIN THE " &
-                       "RANGE OF THE SUBTYPE USED TO INSTANTIATE " &
-                       "FLOAT_IO.");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE FLT IS NEW FLOAT RANGE 1.0 .. 10.0;
-           PACKAGE FL_IO IS NEW FLOAT_IO (FLT);
-           USE FL_IO;
-           X : FLT RANGE 1.0 .. 5.0;
- 
-      BEGIN
-           BEGIN
-                GET (FT, X, IDENT_INT(-3));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE " &
-                        "WIDTH");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR FOR NEGATIVE WIDTH");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR NEGATIVE " &
-                             "WIDTH");
-           END;
- 
-           IF FIELD'LAST < INTEGER'LAST THEN
-                BEGIN
-                     GET (X, FIELD'LAST + Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                             "FIELD'LAST + 1 WIDTH - DEFAULT");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIELD'LAST + 1 WIDTH - DEFAULT");
-                END;
-           END IF;
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "1.0");
-           NEW_LINE (FT);
-           PUT (FT, "8.0");
-           NEW_LINE (FT);
-           PUT (FT, "2.0");
-           NEW_LINE (FT);
-           PUT (FT, "3.0");
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "FOR IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FT, X);
-           IF X /= 1.0 THEN
-                FAILED ("WRONG VALUE READ WITH EXTERNAL FILE");
-           END IF;
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                        "VALUE OUT OF RANGE WITH EXTERNAL FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - " &
-                             "VALUE OUT OF RANGE WITH EXTERNAL FILE");
-           END;
- 
-           BEGIN
-                GET (FT, X, IDENT_INT(-1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                        "NEGATIVE WIDTH WITH EXTERNAL FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - " &
-                             "NEGATIVE WIDTH WITH EXTERNAL FILE");
-           END;
- 
-           SKIP_LINE (FT);
- 
-           IF FIELD'LAST < INTEGER'LAST THEN
-                BEGIN
-                     GET (FT, X, FIELD'LAST + Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                             "FIELD'LAST + 1 WIDTH WITH " &
-                             "EXTERNAL FILE");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIELD'LAST + 1 WIDTH WITH " &
-                                  "EXTERNAL FILE");
-                END;
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X, 3);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT_ERROR RAISED - " &
-                             "OUT OF RANGE WITH EXTERNAL FILE");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - " &
-                             "OUT OF RANGE WITH EXTERNAL FILE");
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- END CE3804F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- CE3804G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO GET WHEN SUPPLIED WITH A WIDTH PARAMETER
- --     GREATER THAN ZERO READS ONLY THAT MANY CHARACTERS.  ALSO CHECK
- --     THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS ENCOUNTERED AND
- --     THAT DATA_ERROR IS RAISED WHEN THE DATA IS INVALID.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/08/82
- --     SPS 12/14/82
- --     VKG 01/13/83
- --     SPS 02/08/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/14/87  SPLIT CASE FOR FIXED_IO INTO CE3804H.ADA AND
- --                   CORRECTED EXCEPTION HANDLING.
- --     LDC 06/01/88  CHANGED TEST VALUE FROM "3.525" TO "3.625".
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804G IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804G", "CHECK THAT FLOAT_IO GET WHEN SUPPLIED WITH " &
-                       "A WIDTH PARAMETER GREATER THAN ZERO READS " &
-                       "ONLY THAT MANY CHARACTERS.  ALSO CHECK THAT " &
-                       "INPUT TERMINATES WHEN A LINE TERMINATOR IS " &
-                       "ENCOUNTERED AND THAT DATA_ERROR IS RAISED " &
-                       "WHEN THE DATA IS INVALID.");
- 
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT(FT, "3.259.5 8.52");
-           NEW_LINE (FT);
-           PUT (FT, "  ");
-           NEW_LINE (FT);
-           PUT (FT, ASCII.HT & "9.0");
-           NEW_LINE (FT);
-           PUT (FT, "-3.625");
-           NEW_LINE (FT);
-           CLOSE (FT);
- 
- -- BEGIN TEST
- 
-           DECLARE
-                TYPE FL IS DIGITS 4;
-                PACKAGE FL_IO IS NEW FLOAT_IO (FL);
-                USE FL_IO;
-                X : FL;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT" &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X, 4);
-                IF X /= 3.25 THEN
-                     FAILED ("WIDTH CHARACTERS NOT READ - FLOAT");
-                ELSE
-                     GET (FT, X, 3);
-                     IF X /= 9.5 THEN
-                          FAILED ("WIDTH CHARACTERS NOT READ - " &
-                                  "FLOAT 2");
-                     ELSE
-                          GET (FT, X, 4);
-                          IF X /= 8.5 THEN
-                               FAILED ("DIDN'T COUNT LEADING BLANKS " &
-                                       "- FLOAT");
-                          ELSE
-                               SKIP_LINE(FT);
-                               BEGIN
-                                    GET (FT, X, 2);
-                                    FAILED ("DATA_ERROR NOT RAISED - " &
-                                            "FLOAT");
-                               EXCEPTION
-                                    WHEN DATA_ERROR =>
-                                         NULL;
-                                    WHEN OTHERS =>
-                                         FAILED ("WRONG EXCEPTION RAISED"
-                                              & " - FLOAT");
-                               END;
-                               SKIP_LINE(FT);
-                               GET (FT, X, 4);
-                               IF X /= 9.0 THEN
-                                    FAILED ("GET WITH WIDTH " &
-                                            "INCORRECT - 3");
-                               END IF;
- 
-                               SKIP_LINE (FT);
-                               GET (FT, X, 7);
-                               IF X /= -3.625 THEN
-                                    FAILED ("WIDTH CHARACTERS NOT " &
-                                            "READ - FLOAT 3");
-                               END IF;
-                          END IF;
-                     END IF;
-                END IF;
- 
-                BEGIN
-                    DELETE (FT);
-                EXCEPTION
-                    WHEN USE_ERROR =>
-                         NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,161 ****
- -- CE3804H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO GET WHEN SUPPLIED WITH A WIDTH PARAMETER
- --     GREATER THAN ZERO READS ONLY THAT MANY CHARACTERS.  ALSO CHECK
- --     THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS ENCOUNTERED AND
- --     THAT DATA_ERROR IS RAISED WHEN THE DATA IS INVALID.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     DWC 09/14/87  CREATED ORIGINAL TEST.
- --     RJW 08/17/89  CHANGED THE VALUE '-3.525' TO '-3.625'.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804H IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804H", "CHECK THAT FIXED_IO GET WHEN SUPPLIED WITH " &
-                       "A WIDTH PARAMETER GREATER THAN ZERO READS " &
-                       "ONLY THAT MANY CHARACTERS.  ALSO CHECK THAT " &
-                       "INPUT TERMINATES WHEN A LINE TERMINATOR IS " &
-                       "ENCOUNTERED AND THAT DATA_ERROR IS RAISED " &
-                       "WHEN THE DATA IS INVALID");
- 
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT(FT, "3.259.5 8.52");
-           NEW_LINE (FT);
-           PUT (FT, "  ");
-           NEW_LINE (FT);
-           PUT (FT, ASCII.HT & "9.0");
-           NEW_LINE (FT);
-           PUT (FT, "-3.625");
-           NEW_LINE (FT);
- 
-           CLOSE (FT);
- 
- -- BEGIN TEST
- 
-           DECLARE
-                TYPE FIXED IS DELTA 0.001 RANGE -100.0 .. 100.0;
-                PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
-                USE FX_IO;
-                X : FIXED;
- 
-           BEGIN
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT" &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X, 4);
-                IF X /= 3.25 THEN
-                     FAILED ("WIDTH CHARACTERS NOT READ - FIXED - 1");
-                ELSE
-                     GET (FT, X, 3);
-                     IF X /= 9.5 THEN
-                          FAILED ("WIDTH CHARACTERS NOT READ - " &
-                                  "FIXED 2");
-                     ELSE
-                          GET (FT, X, 4);
-                          IF X /= 8.5 THEN
-                               FAILED ("DIDN'T COUNT LEADING BLANKS " &
-                                       "- FIXED");
-                          ELSE
-                               SKIP_LINE(FT);
-                               BEGIN
-                                    GET (FT, X, 2);
-                                    FAILED ("DATA_ERROR NOT RAISED - " &
-                                            "FIXED");
-                               EXCEPTION
-                                    WHEN DATA_ERROR =>
-                                         NULL;
-                                    WHEN OTHERS =>
-                                         FAILED ("WRONG EXCEPTION RAISED"
-                                              & " - FIXED");
-                               END;
- 
-                               SKIP_LINE(FT);
-                               GET (FT, X, 4);
-                               IF X /= 9.0 THEN
-                                    FAILED ("GET WITH WIDTH " &
-                                            "INCORRECT");
-                               END IF;
- 
-                               SKIP_LINE (FT);
-                               GET (FT, X, 7);
-                               IF X /= -3.625 THEN
-                                    FAILED ("WIDTH CHARACTERS NOT " &
-                                            "READ");
-                               END IF;
-                          END IF;
-                     END IF;
-                END IF;
- 
-                BEGIN
-                    DELETE (FT);
-                EXCEPTION
-                    WHEN USE_ERROR =>
-                         NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- CE3804I.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO GET OPERATES ON IN_FILE FILE AND WHEN
- --     NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/06/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/14/87  SPLIT CASE FOR FIXED_IO INTO CE3804J.ADA AND
- --                   CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804I IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804I", "CHECK THAT FLOAT_IO GET OPERATES ON " &
-                       "IN_FILE FILE AND WHEN NO FILE IS " &
-                       "SPECIFIED THE CURRENT DEFAULT INPUT " &
-                       "FILE IS USED.");
- 
-      DECLARE
-           FT1, FT2 : FILE_TYPE;
-      BEGIN
- 
- -- CREATE AND INITIALIZE FILES
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           PUT (FT1, "1.0");
-           NEW_LINE (FT1);
- 
-           CLOSE (FT1);
- 
-           BEGIN
-                OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "FOR IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT2, "2.0");
-           NEW_LINE (FT2);
- 
-           CLOSE (FT2);
-           OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           SET_INPUT (FT2);
- 
-           DECLARE
-                TYPE FL IS NEW FLOAT;
-                PACKAGE FLIO IS NEW FLOAT_IO (FL);
-                USE FLIO;
-                X : FL;
-           BEGIN
-                BEGIN
-                     GET (FT1, X);
-                     IF X /= 1.0 THEN
-                          FAILED ("FLOAT FILE VALUE INCORRECT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED - FILE FLOAT");
-                END;
- 
-                BEGIN
-                     GET (X);
-                     IF X /= 2.0 THEN
-                          FAILED ("FLOAT DEFAULT VALUE INCORRECT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED - DEFAULT FLOAT");
-                END;
-           END;
- 
-           BEGIN
-               DELETE (FT1);
-               DELETE (FT2);
-           EXCEPTION
-               WHEN USE_ERROR =>
-                    NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804I;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,137 ****
- -- CE3804J.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO GET OPERATES ON IN_FILE FILE AND WHEN
- --     NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     DWC 09/14/87  CREATED ORIGINAL TEST.
- --     JRL 02/28/96  Changed upper bound of type FX from 1000.0 to 250.0.
- --                   Corrected TEST string.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804J IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804J", "CHECK THAT FIXED_IO GET OPERATES ON " &
-                       "IN_FILE FILE AND WHEN NO FILE IS " &
-                       "SPECIFIED THE CURRENT DEFAULT INPUT " &
-                       "FILE IS USED");
- 
-      DECLARE
-           FT1, FT2 : FILE_TYPE;
-      BEGIN
- 
- -- CREATE AND INITIALIZE FILES
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           PUT (FT1, "1.0");
-           NEW_LINE (FT1);
- 
-           CLOSE (FT1);
- 
-           BEGIN
-                OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "FOR IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT2, "2.0");
-           NEW_LINE (FT2);
- 
-           CLOSE (FT2);
-           OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           SET_INPUT (FT2);
- 
-           DECLARE
-                TYPE FX IS DELTA 0.0001 RANGE 1.0 .. 250.0;
-                PACKAGE FXIO IS NEW FIXED_IO (FX);
-                USE FXIO;
-                X : FX;
-           BEGIN
-                BEGIN
-                     GET (FT1, X);
-                     IF X /= 1.0 THEN
-                          FAILED ("FIXED FILE VALUE INCORRECT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED - FILE FIXED");
-                END;
- 
-                BEGIN
-                     GET (X);
-                     IF X /= 2.0 THEN
-                          FAILED ("FIXED DEFAULT VALUE INCORRECT");
-                     END IF;
-                EXCEPTION
-                     WHEN OTHERS =>
-                          FAILED ("EXCEPTION RAISED - DEFAULT FIXED");
-                END;
-           END;
- 
-           BEGIN
-                DELETE (FT1);
-                DELETE (FT2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804J;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,157 ****
- -- CE3804M.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET WILL RAISE DATA_ERROR IF THE USE OF # AND :
- --     IN BASED LITERALS IS MIXED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     VKG 02/07/83
- --     JBG 03/30/84
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/14/87  SPLIT CASE FOR FIXED_IO INTO CE3804N.ADA AND
- --                   CORRECTED EXCEPTION HANDLING.
- 
- WITH TEXT_IO; USE TEXT_IO;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CE3804M IS
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE3804M", "CHECK THAT FLOAT_IO GET WILL RAISE " &
-                       "DATA_ERROR IF THE USE OF # AND : IN " &
-                       "BASED LITERALS IS MIXED");
- 
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
- 
-           PUT_LINE (FT, "2#1.1#E+2");   -- 2#1.1#E+2
-           PUT_LINE (FT, "8:1.1:E-2");   -- 8:1.1:E-2
-           PUT (FT, "2#1.1:E+1");        -- 2#1.1:E+1
-           NEW_LINE (FT);
-           PUT (FT, "4:2.23#E+2");       -- 4:2.23#E+2
-           NEW_LINE (FT);
-           PUT (FT, "2#1.0#E+1");        -- 2#1.0#E+1
-           NEW_LINE (FT);
-           CLOSE (FT);
- 
-           DECLARE
-                PACKAGE FL_IO IS NEW FLOAT_IO(FLOAT);
-                USE FL_IO;
-                X : FLOAT := 1.00E+10;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                GET (FT, X);
-                IF X /= 2#1.1#E+2 THEN
-                     FAILED ("DID NOT GET RIGHT VALUE - 1");
-                END IF;
- 
-                GET (FT, X);
-                IF X /= 8#1.1#E-2 THEN
-                     FAILED ("DID NOT GET RIGHT VALUE - 2");
-                END IF;
- 
-                BEGIN
-                     X := 1.0E+10;
-                     GET (FT,X);
-                     FAILED ("DATA_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1.00E+10 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 1");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 1");
-                END;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT,X);
-                     FAILED ("DATA_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= 1.00E+10 THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 2");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 2");
-                END;
- 
-                SKIP_LINE (FT);
- 
-                GET (FT, X);
-                IF X /= 2#1.0#E+1 THEN
-                     FAILED ("DID NOT GET RIGHT VALUE - 3");
-                END IF;
- 
-                BEGIN
-                     DELETE (FT);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NULL;
-                END;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804M;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- CE3804O.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- HISTORY:
- --     CHECK THAT GET FOR FIXED_IO RAISES MODE_ERROR WHEN THE
- --     MODE IS NOT IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     DWC 09/14/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804O IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804O", "CHECK THAT GET FOR FIXED_IO RAISES " &
-                       "MODE_ERROR WHEN THE MODE IS NOT IN_FILE");
- 
-      DECLARE
-           FT: FILE_TYPE;
-      BEGIN
-           BEGIN
-                CREATE (FT, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                     "CREATE FOR TEMP FILES " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           DECLARE
-                TYPE FIXED IS DELTA 0.25 RANGE 1.0 .. 3.0;
-                PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
-                USE FX_IO;
-                X : FIXED;
-           BEGIN
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("MODE_ERROR NOT RAISED - FIXED " &
-                             "UN-NAMED FILE");
-                EXCEPTION
-                     WHEN MODE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIXED UN-NAMED FILE");
-                END;
- 
-                BEGIN
-                     GET (STANDARD_OUTPUT, X);
-                     FAILED ("MODE_ERROR NOT RAISED - FIXED " &
-                             "STANDARD_OUTPUT");
-                EXCEPTION
-                     WHEN MODE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIXED STANDARD_OUTPUT");
-                END;
- 
-                BEGIN
-                     GET (CURRENT_OUTPUT, X);
-                     FAILED ("MODE_ERROR NOT RAISED - FIXED " &
-                             "CURRENT_OUTPUT");
-                EXCEPTION
-                     WHEN MODE_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIXED CURRENT_OUTPUT");
-                END;
- 
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804O;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,206 ****
- -- CE3804P.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO GET RAISES CONSTRAINT_ERROR WHEN THE VALUE
- --     SUPPLIED BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN FIELD'LAST
- --     WHEN FIELD'LAST IS LESS THAN INTEGER'LAST, OR THE VALUE READ IS
- --     OUT OF RANGE OF THE ITEM PARAMETER, BUT WITHIN THE RANGE OF THE
- --     SUBTYPE USED TO INSTANTIATE FIXED_IO.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     DWC 09/15/87  CREATED ORIGINAL TEST.
- --     JRL 06/07/96  Added call to Ident_Int in expressions involving
- --                   Field'Last, to make the expressions non-static and
- --                   prevent compile-time rejection. Corrected typo.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3804P IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3804P", "CHECK THAT FLOAT_IO GET RAISES " &
-                       "CONSTRAINT_ERROR WHEN THE VALUE SUPPLIED " &
-                       "BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN " &
-                       "FIELD'LAST WHEN FIELD'LAST IS LESS THAN " &
-                       "INTEGER'LAST, OR THE VALUE READ IS OUT OF " &
-                       "RANGE OF THE ITEM PARAMETER, BUT WITHIN THE " &
-                       "RANGE OF THE SUBTYPE USED TO INSTANTIATE " &
-                       "FLOAT_IO.");
- 
-      DECLARE
-           TYPE FIXED IS DELTA 0.25 RANGE 0.0 .. 10.0;
-           FT : FILE_TYPE;
-           PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
-           USE FX_IO;
-           X : FIXED RANGE 0.0 .. 5.0;
- 
-      BEGIN
-           BEGIN
-                GET (FT, X, IDENT_INT(-3));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE " &
-                        "WIDTH");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR FOR NEGATIVE WIDTH");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR NEGATIVE " &
-                             "WIDTH");
-           END;
- 
-           IF FIELD'LAST < INTEGER'LAST THEN
-                BEGIN
-                     GET (X, FIELD'LAST + Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                             "FIELD'LAST + 1 WIDTH - DEFAULT");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIELD'LAST + 1 WIDTH - DEFAULT");
-                END;
-           END IF;
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "1.0");
-           NEW_LINE (FT);
-           PUT (FT, "8.0");
-           NEW_LINE (FT);
-           PUT (FT, "2.0");
-           NEW_LINE (FT);
-           PUT (FT, "3.0");
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FT, X);
-           IF X /= 1.0 THEN
-                FAILED ("WRONG VALUE READ WITH EXTERNAL FILE");
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X, 3);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                        "OUT OF RANGE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - " &
-                             "OUT OF RANGE");
-           END;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X, IDENT_INT(-1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                        "NEGATIVE WIDTH WITH EXTERNAL FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - " &
-                             "NEGATIVE WIDTH WITH EXTERNAL FILE");
-           END;
- 
-           IF FIELD'LAST < INTEGER'LAST THEN
-                BEGIN
-                     GET (FT, X, FIELD'LAST + Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
-                             "FIELD'LAST + 1 WIDTH WITH " &
-                             "EXTERNAL FILE");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - " &
-                                  "FIELD'LAST + 1 WIDTH WITH " &
-                                  "EXTERNAL FILE");
-                END;
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           BEGIN
-                GET (FT, X, 3);
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     FAILED ("CONSTRAINT_ERROR RAISED; VALID WIDTH " &
-                             "WITH EXTERNAL FILE");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED; VALID WIDTH " &
-                             "WITH EXTERNAL FILE");
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3804P;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,162 ****
- -- CE3805A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO GET MAY READ THE LAST CHARACTER IN THE FILE
- --     WITHOUT RAISNG END_ERROR AND THAT SUBSEQUENT READING WILL RAISE
- --     END_ERROR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATAIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/08/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/15/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
- --                   HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3805A IS
- 
- BEGIN
- 
-      TEST ("CE3805A", "CHECK THAT FLOAT_IO GET MAY READ THE LAST " &
-                       "CHARACTER IN THE FILE WITHOUT RAISING " &
-                       "END_ERROR AND THAT SUBSEQUENT READING WILL " &
-                       "RAISE END_ERROR");
- 
-      DECLARE
-           FT1, FT2 : FILE_TYPE;
-           PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT);
-           X : FLOAT;
-           USE FL_IO;
-           INCOMPLETE : EXCEPTION;
- 
-      BEGIN
- 
- -- CREATE AND INITIALIZE TEST FILES
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           PUT (FT1, "2.25");
-           CLOSE (FT1);
- 
-           PUT (FT2, "2.50");
-           NEW_LINE (FT2, 3);
-           NEW_PAGE (FT2);
-           NEW_LINE (FT2, 3);
-           CLOSE (FT2);
- 
- -- BEGIN TEST
- 
-           BEGIN
-                OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
-                                     "OPEN WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           BEGIN
-                GET (FT1, X);
-                IF X /= 2.25 THEN
-                     FAILED ("INCORRECT VALUE READ");
-                END IF;
-                BEGIN
-                     GET (FT1, X);
-                     FAILED ("END_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN  OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 1");
-                END;
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("END_ERROR RAISED PREMATURELY - 1");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED - 1");
-           END;
- 
-           BEGIN
-                GET (FT2, X);
-                IF X /= 2.50 THEN
-                     FAILED ("INCORRECT VALUE READ");
-                END IF;
-                BEGIN
-                     GET (FT2, X);
-                     FAILED ("END_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN  OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("END_ERROR RAISED PREMATURELY - 2");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED - 2");
-           END;
- 
-           BEGIN
-                DELETE (FT1);
-                DELETE (FT2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3805A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,163 ****
- -- CE3805B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO GET MAY READ THE LAST CHARACTER IN THE FILE
- --     WITHOUT RAISING END_ERROR AND THAT SUBSEQUENT READING WILL RAISE
- --     END_ERROR.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/08/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/15/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
- --                   HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3805B IS
- 
- BEGIN
- 
-      TEST ("CE3805B", "CHECK THAT FIXED_IO GET MAY READ THE LAST "&
-                       "CHARACTER IN THE FILE WITHOUT RAISING " &
-                       "END_ERROR AND THAT SUBSEQUENT READING WILL " &
-                       "RAISE END_ERROR");
- 
-      DECLARE
-           FT1, FT2 : FILE_TYPE;
-           TYPE FIXED IS DELTA 0.02 RANGE 0.0 .. 50.0;
-           PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
-           X : FIXED;
-           USE FX_IO;
-           INCOMPLETE : EXCEPTION;
- 
-      BEGIN
- 
- -- CREATE AND INITIALIZE TEST FILES
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           PUT (FT1, "2.25");
-           CLOSE (FT1);
- 
-           PUT (FT2, "2.50");
-           NEW_LINE (FT2, 3);
-           NEW_PAGE (FT2);
-           NEW_LINE (FT2, 3);
-           CLOSE (FT2);
- 
- -- BEGIN TEST
- 
-           BEGIN
-                OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "FOR IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           BEGIN
-                GET (FT1, X);
-                IF X /= 2.25 THEN
-                     FAILED ("INCORRECT VALUE READ");
-                END IF;
-                BEGIN
-                     GET (FT1, X);
-                     FAILED ("END_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN  OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 1");
-                END;
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("END_ERROR RAISED PREMATURELY - 1");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED - 1");
-           END;
- 
-           BEGIN
-                GET (FT2, X);
-                IF X /= 2.50 THEN
-                     FAILED ("INCORRECT VALUE READ");
-                END IF;
-                BEGIN
-                     GET (FT2, X);
-                     FAILED ("END_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN END_ERROR =>
-                          NULL;
-                     WHEN  OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 2");
-                END;
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("END_ERROR RAISED PREMATURELY - 2");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED ERROR RAISED - 2");
-           END;
- 
-           BEGIN
-                DELETE (FT1);
-                DELETE (FT2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3805B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- CE3806A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT FOR FLOAT_IO RAISES MODE_ERROR FOR FILES OF
- --     MODE IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 09/10/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/11/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3806A IS
- 
- BEGIN
- 
-      TEST ("CE3806A", "CHECK THAT PUT FOR FLOAT_IO RAISES MODE_ERROR " &
-                       "FOR FILES OF MODE IN_FILE");
- 
-      DECLARE
-           FT1 : FILE_TYPE;
-           PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT);
-           USE FL_IO;
-           INCOMPLETE : EXCEPTION;
-           X : FLOAT := -34.267/19.2;
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT1, 'A');
-           CLOSE (FT1);
- 
-           BEGIN
-                OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (FT1, X);
-                FAILED ("MODE_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                PUT (STANDARD_INPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - 2");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                PUT (CURRENT_INPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - 3");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 3");
-           END;
- 
-           BEGIN
-                DELETE (FT1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3806A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,124 ****
- -- CE3806B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT FOR FIXED_IO RAISES MODE_ERROR FOR FILES OF
- --     MODE IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 09/11/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3806B IS
- 
- BEGIN
-      TEST ("CE3806B", "CHECK THAT PUT FOR FIXED_IO RAISES MODE_ERROR " &
-                       "FOR FILES OF MODE IN_FILE");
- 
-      DECLARE
-           FT1 : FILE_TYPE;
-           TYPE FIXED IS DELTA 0.01 RANGE 0.0 .. 1.0;
-           PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
-           USE FX_IO;
-           INCOMPLETE : EXCEPTION;
-           X : FIXED := 0.2;
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT1, 'A');
-           CLOSE (FT1);
- 
-           BEGIN
-                OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (FT1, X);
-                FAILED ("MODE_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                PUT (STANDARD_INPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - 2");
-            EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2");
-           END;
- 
-           BEGIN
-                PUT (CURRENT_INPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - 3");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 3");
-           END;
- 
-           BEGIN
-                DELETE (FT1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3806B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,197 ****
- -- CE3806C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT FOR FLOAT_IO RAISES CONSTRAINT_ERROR WHEN THE
- --     VALUES SUPPLIED BY FORE, AFT, OR EXP ARE NEGATIVE OR GREATER
- --     THAN FIELD'LAST WHEN FIELD'LAST < FIELD'BASE'LAST.  ALSO CHECK
- --     THAT PUT FOR FLOAT_IO RAISES CONSTRAINT_ERROR WHEN THE VALUE OF
- --     ITEM IS OUTSIDE THE RANGE OF THE TYPE USED TO INSTANTIATE
- --     FLOAT_IO.
- 
- -- HISTORY:
- --     SPS 09/10/82
- --     JBG 08/30/83
- --     JLH 09/14/87  ADDED CASES FOR COMPLETE OBJECTIVE.
- --     KAS 11/24/95  DELETED DIGITS CONSTRAINT FROM SUBTYPE
- --                   CHANGED STATIC EXPRESSIONS INVOLVING 'LAST
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3806C IS
- 
-      FIELD_LAST : TEXT_IO.FIELD := TEXT_IO.FIELD'LAST;
- 
- BEGIN
- 
-      TEST ("CE3806C", "CHECK THAT PUT FOR FLOAT_IO RAISES " &
-                       "CONSTRAINT_ERROR APPROPRIATELY");
- 
-      DECLARE
-           TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 2.0;
-           SUBTYPE MY_FLOAT IS FLOAT RANGE 0.0 .. 1.0;
-           PACKAGE NFL_IO IS NEW FLOAT_IO (MY_FLOAT);
-           USE NFL_IO;
-           FT : FILE_TYPE;
-           Y : FLOAT := 1.8;
-           X : MY_FLOAT := 26.3 / 26.792;
- 
-      BEGIN
-           BEGIN
-                PUT (FT, X, FORE => IDENT_INT(-6));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE FORE " &
-                        "FLOAT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 1");
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 1");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - NEGATIVE FORE " &
-                             "FLOAT");
-           END;
- 
-           BEGIN
-                PUT (FT, X, AFT => IDENT_INT(-2));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE AFT " &
-                        "FLOAT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 2");
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 2");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - NEGATIVE AFT " &
-                             "FLOAT");
-           END;
- 
-           BEGIN
-                PUT (FT, X, EXP => IDENT_INT(-1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE EXP " &
-                        "FLOAT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 3");
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 3");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - NEGATIVE EXP " &
-                             "FLOAT");
-           END;
- 
-           IF FIELD_LAST < FIELD'BASE'LAST THEN
- 
-                BEGIN
-                     PUT (FT, X, FORE => IDENT_INT(FIELD_LAST+1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - FORE FLOAT");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN STATUS_ERROR =>
-                          FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 4");
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 4");
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - FORE FLOAT");
-                END;
- 
-                BEGIN
-                     PUT (FT, X, AFT => IDENT_INT(FIELD_LAST+1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - AFT FLOAT");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN STATUS_ERROR =>
-                          FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 5");
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 5");
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - AFT FLOAT");
-                END;
- 
-                BEGIN
-                     PUT (FT, X, EXP => IDENT_INT(FIELD_LAST+1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - EXP FLOAT");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN STATUS_ERROR =>
-                          FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 6");
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 6");
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - EXP FLOAT");
-                END;
-            END IF;
- 
-            BEGIN
-                PUT (FT, Y);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
-                        "RANGE - FILE");
-            EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
-                             "RANGE - FILE");
-           END;
- 
-           BEGIN
-                PUT (Y);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
-                        "RANGE - DEFAULT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
-                             "RANGE - DEFAULT");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END CE3806C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,129 ****
- -- CE3806D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO PUT OPERATES ON FILES OF MODE OUT_FILE AND
- --     IF NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE IS USED.
- 
- --- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/06/82
- --     VKG 02/15/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/14/87  REMOVED DEPENDENCE ON RESET AND CORRECT EXCEPTION
- --                   HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3806D IS
- 
- BEGIN
- 
-      TEST ("CE3806D", "CHECK THAT FLOAT_IO OPERATES ON FILES OF MODE " &
-                       "OUT_FILE AND IF NO FILE IS SPECIFIED THE " &
-                       "CURRENT DEFAULT OUTPUT FILE IS USED");
- 
-      DECLARE
-           FT1, FT2 : FILE_TYPE;
-           TYPE FL IS DIGITS 3;
-           PACKAGE FLIO IS NEW FLOAT_IO (FL);
-           USE FLIO;
-           INCOMPLETE : EXCEPTION;
-           X : FL := -1.5;
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           SET_OUTPUT (FT2);
- 
-           BEGIN
-                PUT (FT1, X);
-                PUT (X + 1.0);
-                CLOSE (FT1);
- 
-                BEGIN
-                     OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                SET_OUTPUT (STANDARD_OUTPUT);
- 
-                CLOSE (FT2);
-                OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-                X := 0.0;
-                GET (FT1, X);
-                IF X /= -1.5 THEN
-                     FAILED ("VALUE INCORRECT - FLOAT FROM FILE");
-                END IF;
-                X := 0.0;
-                GET (FT2, X);
-                IF X /= -0.5 THEN
-                     FAILED (" VVALUE INCORRECT - FLOAT FROM DEFAULT");
-                END IF;
-           END;
- 
-           BEGIN
-                DELETE (FT1);
-                DELETE (FT2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3806D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- -- CE3806E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO PUT RAISE LAYOUT_ERROR WHEN THE NUMBER
- --     OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.
- --     CHECK THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED,
- --     WHEN THE NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO
- --     THE CURRENT COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/07/82
- --     SPS 12/14/82
- --     VKG 01/13/83
- --     SPS 02/18/83
- --     JBG 08/30/83
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 09/14/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3806E IS
- 
- BEGIN
- 
-      TEST ("CE3806E", "CHECK THAT FLOAT_IO PUT RAISES " &
-                       "LAYOUT_ERROR CORRECTLY");
- 
-      DECLARE
-           TYPE FL IS DIGITS 3 RANGE 100.0 .. 200.0;
-           PACKAGE FLIO IS NEW FLOAT_IO (FL);
-           USE FLIO;
-           X : FL := 126.0;
-           Y : FL := 134.0;
-           Z : FL := 120.0;
-           INCOMPLETE : EXCEPTION;
-           FT : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FT, 8);
- 
-           BEGIN
-                PUT (FT, X);        -- " 1.26E+02"
-                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT");
- 
-           END;
- 
-           BEGIN
-                PUT (FT, Y, FORE => 1); -- "1.34E+02"
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED SECOND PUT " &
-                             "- FLOAT");
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED SECOND PUT - FLOAT");
-           END;
- 
-           BEGIN
-                PUT (FT,Z, FORE => 1, AFT => 0); -- "1.2E+02"
-                IF LINE (FT) /= 2 THEN
-                     FAILED ("NEW_LINE NOT CALLED - FLOAT");
-                END IF;
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED THIRD " &
-                             "PUT - FLOAT");
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED THIRD PUT - FLOAT");
-           END;
- 
-           SET_LINE_LENGTH ( FT,7);
- 
-           BEGIN
-                PUT (FT, "X");
-                PUT (FT, Y, FORE => 1, AFT => 2,
-                     EXP => 1);          -- 1.34E+2
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED - 3 FLOAT");
-           END;
- 
-           BEGIN
-                PUT (FT, "Z");
-                PUT (FT, Z, FORE => 1);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT 2");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED - 3 FLOAT");
-           END;
- 
-           CHECK_FILE (FT, "1.34E+02#1.2E+02#X#1.34E+2#Z#@%");
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3806E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,194 ****
- -- CE3806F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT FOR FIXED_IO RAISES CONSTRAINT_ERROR WHEN THE
- --     VALUES SUPPLIED BY FORE, AFT, OR EXP ARE NEGATIVE OR GREATER
- --     THAN FIELD'LAST WHEN FIELD'LAST < FIELD'BASE'LAST.  ALSO CHECK
- --     THAT PUT FOR FIXED_IO RAISES CONSTRAINT_ERROR WHEN THE VALUE
- --     OF ITEM IS OUTSIDE THE RANGE OF THE TYPE USED TO INSTANTIATE
- --     FIXED_IO.
- 
- -- HISTORY:
- --     JLH 09/15/87  CREATED ORIGINAL TEST.
- --     JRL 06/07/96  Added call to Ident_Int in expressions involving
- --                   Field'Last, to make the expressions non-static and
- --                   prevent compile-time rejection.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3806F IS
- 
- BEGIN
- 
-      TEST ("CE3806F", "CHECK THAT PUT FOR FIXED_IO RAISES " &
-                       "CONSTRAINT_ERROR APPROPRIATELY");
- 
-      DECLARE
-           TYPE FIXED IS DELTA 0.01 RANGE 1.0 .. 2.0;
-           SUBTYPE MY_FIXED IS FIXED DELTA 0.01 RANGE 1.0 .. 1.5;
-           PACKAGE NFX_IO IS NEW FIXED_IO (MY_FIXED);
-           USE NFX_IO;
-           FT : FILE_TYPE;
-           Y : FIXED := 1.8;
-           X : MY_FIXED := 1.3;
- 
-      BEGIN
- 
-           BEGIN
-                PUT (FT, X, FORE => IDENT_INT(-6));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE FORE " &
-                        "FIXED");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 1");
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 1");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - NEGATIVE FORE " &
-                             "FIXED");
-           END;
- 
-           BEGIN
-                PUT (FT, X, AFT => IDENT_INT(-2));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE AFT " &
-                        "FIXED");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 2");
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 2");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - NEGATIVE AFT " &
-                             "FIXED");
-           END;
- 
-           BEGIN
-                PUT (FT, X, EXP => IDENT_INT(-1));
-                FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE EXP " &
-                        "FIXED");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 3");
-                WHEN USE_ERROR =>
-                     FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                             "CONSTRAINT_ERROR - 3");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - NEGATIVE EXP " &
-                             "FIXED");
-           END;
- 
-           IF FIELD'LAST < FIELD'BASE'LAST THEN
- 
-                BEGIN
-                     PUT (FT, X, FORE => IDENT_INT(FIELD'LAST+Ident_Int(1)));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - FORE FIXED");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN STATUS_ERROR =>
-                          FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 4");
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 4");
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - FORE FIXED");
-                END;
- 
-                BEGIN
-                     PUT (FT, X, AFT => IDENT_INT(FIELD'LAST+Ident_Int(1)));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - AFT FIXED");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN STATUS_ERROR =>
-                          FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 5");
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 5");
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - AFT FIXED");
-                END;
- 
-                BEGIN
-                     PUT (FT, X, EXP => IDENT_INT(FIELD'LAST+Ident_Int(1)));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED - EXP FIXED");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN STATUS_ERROR =>
-                          FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 6");
-                     WHEN USE_ERROR =>
-                          FAILED ("USE_ERROR RAISED INSTEAD OF " &
-                                  "CONSTRAINT_ERROR - 6");
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - EXP FIXED");
-                END;
- 
-           END IF;
- 
-           BEGIN
-                PUT (FT, Y);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
-                        "RANGE - FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
-                             "RANGE - FILE");
-           END;
- 
-           BEGIN
-                PUT (Y);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
-                        "RANGE - DEFAULT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
-                             "RANGE - DEFAULT");
-           END;
- 
-      END;
- 
-      RESULT;
- 
- END CE3806F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,125 ****
- -- CE3806G.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO PUT OPERATES ON FILES OF MODE OUT_FILE AND
- --     IF NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE IS USED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 09/13/87  CREATED ORIGINAL TEST.
- --     BCB 10/03/90  ADDED THE STATEMENT "RAISE INCOMPLETE;" TO
- --                   NAME_ERROR EXCEPTION HANDLER.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3806G IS
- 
- BEGIN
- 
-      TEST ("CE3806G", "CHECK THAT FIXED_IO PUT OPERATES ON FILES " &
-                       "OF MODE OUT_FILE AND IF NO FILE IS SPECIFIED " &
-                       "THE CURRENT DEFAULT OUTPUT FILE IS USED");
- 
-      DECLARE
-           FT1, FT2 : FILE_TYPE;
-           TYPE FX IS DELTA 0.5 RANGE -10.0 .. 10.0;
-           PACKAGE FXIO IS NEW FIXED_IO (FX);
-           USE FXIO;
-           INCOMPLETE : EXCEPTION;
-           X : FX := -1.5;
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           SET_OUTPUT (FT2);
- 
-           BEGIN
-                PUT (FT1, X);
-                PUT (X + 1.0);
- 
-                CLOSE (FT1);
- 
-                BEGIN
-                     OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                SET_OUTPUT (STANDARD_OUTPUT);
- 
-                CLOSE (FT2);
- 
-                OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
- 
-                X := 0.0;
-                GET (FT1, X);
-                IF X /= -1.5 THEN
-                     FAILED ("VALUE INCORRECT - FIXED FROM FILE");
-                END IF;
-                X := 0.0;
-                GET (FT2, X);
-                IF X /= -0.5 THEN
-                     FAILED ("VALUE INCORRECT - FIXED FROM DEFAULT");
-                END IF;
-           END;
- 
-           BEGIN
-                DELETE (FT1);
-                DELETE (FT2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3806G;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- CE3806H.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO PUT RAISES LAYOUT_ERROR WHEN THE NUMBER OF
- --     CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.  CHECK
- --     THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED, WHEN THE
- --     NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO THE CURRENT
- --     COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 09/15/87  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3806H IS
- 
- BEGIN
- 
-      TEST ("CE3806H", "CHECK THAT FIXED_IO PUT RAISES " &
-                       "LAYOUT_ERROR CORRECTLY");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE FX IS DELTA 0.01 RANGE -200.0 .. 200.0;
-           PACKAGE FXIO IS NEW FIXED_IO (FX);
-           USE FXIO;
-           INCOMPLETE : EXCEPTION;
-           X : FX := 126.5;
-           Y : FX := -134.0;
-           Z : FX := 120.0;
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FT, 4);
- 
-           BEGIN
-                PUT (FT, X, FORE => 3, AFT => 1);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FIXED");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED");
-           END;
- 
-           SET_LINE_LENGTH (FT,7);
- 
-           BEGIN
-                PUT (FT, Y, FORE => 3, AFT => 2);
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED SECOND PUT - " &
-                             "FIXED");
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED SECOND PUT - " &
-                             "FIXED");
-           END;
- 
-           BEGIN
-                PUT (FT,Z, FORE => 4, AFT => 2);
-                IF LINE (FT) /= 2 THEN
-                     FAILED ("NEW_LINE NOT CALLED - FIXED");
-                END IF;
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED THIRD PUT - " &
-                             "FIXED");
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED THIRD PUT - FIXED");
-           END;
- 
-           BEGIN
-                PUT (FT, "Y");
-                PUT (FT, Z, FORE => 3, AFT => 0);
-                NEW_LINE (FT);
-                PUT (FT, "Z");
-                PUT (FT, Y, FORE => 3, AFT => 2);
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED LAST PUT - " &
-                             "FIXED");
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED LAST PUT - FIXED ");
-           END;
- 
-           CHECK_FILE (FT, "-134.00# 120.00#Y120.0#Z#-134.00#@%");
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
- 
-      END;
- 
-      RESULT;
- 
- END CE3806H;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,239 ****
- -- CE3809A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT I/O GET CAN READ A VALUE FROM A STRING.
- --     CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING
- --     OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION
- --     CHARACTERS.  CHECK THAT LAST CONTAINS THE INDEX OF THE LAST
- --     CHARACTER READ FROM THE STRING.
- 
- -- HISTORY:
- --     SPS 10/07/82
- --     SPS 12/14/82
- --     JBG 12/21/82
- --     DWC 09/15/87  ADDED CASE TO INCLUDE ONLY TABS IN STRING AND
- --                   CHECKED THAT END_ERROR IS RAISED.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3809A IS
- BEGIN
- 
-      TEST ("CE3809A", "CHECK THAT FLOAT_IO GET " &
-                       "OPERATES CORRECTLY ON STRINGS");
- 
-      DECLARE
-           TYPE FL IS DIGITS 4;
-           PACKAGE FLIO IS NEW FLOAT_IO (FL);
-           USE FLIO;
-           X : FL;
-           STR : STRING (1..10) := "   10.25  ";
-           L : POSITIVE;
-      BEGIN
- 
- -- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT
-           BEGIN
-                GET ("896.5  ", X, L);
-                IF X /= 896.5 THEN
-                     FAILED ("FLOAT VALUE FROM STRING INCORRECT");
-                END IF;
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FLOAT - 1");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 1");
-           END;
- 
-           IF L /= IDENT_INT (5) THEN
-                FAILED ("VALUE OF LAST INCORRECT - FLOAT - 1.  LAST IS" &
-                        INTEGER'IMAGE(L));
-           END IF;
- 
- -- STRING LITERAL WITH BLANKS
-           BEGIN
-                GET ("   ", X, L);
-                FAILED ("END_ERROR NOT RAISED - FLOAT - 2");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= 5 THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 2.  LAST IS" &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FLOAT - 2");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2");
-           END;
- 
- -- NULL STRING LITERAL
-           BEGIN
-                GET ("", X, L);
-                FAILED ("END_ERROR NOT RAISED - FLOAT - 3");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= 5 THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 3.  LAST IS" &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FLOAT - 3");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3");
-           END;
- 
- -- NULL SLICE
-           BEGIN
-                GET (STR(5..IDENT_INT(2)), X, L);
-                FAILED ("END_ERROR NOT RAISED - FLOAT - 4");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= 5 THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 4.  LAST IS" &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FLOAT - 4");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4");
-           END;
- 
- -- SLICE WITH BLANKS
-           BEGIN
-                GET (STR(IDENT_INT(9)..10), X, L);
-                FAILED ("END_ERROR NOT RAISED - FLOAT - 5");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= IDENT_INT(5) THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 5.  LAST IS" &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FLOAT - 5");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5");
-           END;
- 
- -- NON-NULL SLICE
-           BEGIN
-                GET (STR(2..IDENT_INT(8)), X, L);
-                IF X /= 10.25 THEN
-                     FAILED ("FLOAT VALUE INCORRECT - 6");
-                END IF;
-                IF L /= 8 THEN
-                     FAILED ("LAST INCORRECT FOR SLICE - 6.  LAST IS" &
-                             INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 6");
-           END;
- 
- -- LEFT-JUSTIFIED, POSITIVE EXPONENT
-           BEGIN
-                GET ("1.34E+02", X, L);
-                IF X /= 134.0 THEN
-                     FAILED ("FLOAT WITH EXP FROM STRING INCORRECT - 7");
-                END IF;
- 
-                IF L /= 8 THEN
-                     FAILED ("VALUE OF LAST INCORRECT - FLOAT - 7.  " &
-                             "LAST IS" & INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_EROR RAISED - FLOAT - 7");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 7");
-           END;
- 
- -- RIGHT-JUSTIFIED, NEGATIVE EXPONENT
-           BEGIN
-                GET (" 25.0E-2", X, L);
-                IF X /= 0.25 THEN
-                     FAILED ("NEG EXPONENT INCORRECT - 8");
-                END IF;
-                IF L /= 8 THEN
-                     FAILED ("LAST INCORRECT - 8.  LAST IS" &
-                             INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 8");
-           END;
- 
- -- RIGHT-JUSTIFIED, NEGATIVE
-           GET ("  -1.50", X, L);
-           IF X /= -1.5 THEN
-                FAILED ("FLOAT IN RIGHT JUSTIFIED STRING INCORRECT - 9");
-           END IF;
-           IF L /= 7 THEN
-                FAILED ("LAST INCORRECT - 9.  LAST IS" &
-                        INTEGER'IMAGE(L));
-           END IF;
- 
- -- HORIZONTAL TAB WITH BLANKS
-           BEGIN
-                GET (" " & ASCII.HT & "2.3E+2", X, L);
-                IF X /= 230.0 THEN
-                     FAILED ("FLOAT WITH TAB IN STRING INCORRECT - 10");
-                END IF;
-                IF L /= 8 THEN
-                     FAILED ("LAST INCORRECT FOR TAB - 10.  LAST IS" &
-                             INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED FOR STRING WITH " &
-                             "TAB - 10");
-           END;
- 
- -- HORIZONTAL TABS ONLY
-           BEGIN
-                GET (ASCII.HT & ASCII.HT, X, L);
-                FAILED ("END_ERROR NOT RAISED - FLOAT - 11");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= IDENT_INT(8) THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 11.  LAST IS" &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FLOAT - 11");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 11");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE3809A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,239 ****
- -- CE3809B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- HISTORY:
- --     CHECK THAT FIXED I/O GET CAN READ A VALUE FROM A STRING.
- --     CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING
- --     OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION
- --     CHARACTERS.  CHECK THAT LAST CONTAINS THE INDEX OF THE LAST
- --     CHARACTER READ FROM THE STRING.
- 
- -- HISTORY:
- --     SPS 10/07/82
- --     SPS 12/14/82
- --     JBG 12/21/82
- --     DWC 09/15/87  ADDED CASE TO INCLUDE ONLY TABS IN STRING AND
- --                   CHECKED THAT END_ERROR IS RAISED.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3809B IS
- BEGIN
- 
-      TEST ("CE3809B", "CHECK THAT FIXED_IO GET " &
-                       "OPERATES CORRECTLY ON STRINGS");
- 
-      DECLARE
-           TYPE FX IS DELTA 0.001 RANGE -2.0 .. 1000.0;
-           PACKAGE FXIO IS NEW FIXED_IO (FX);
-           USE FXIO;
-           X : FX;
-           L : POSITIVE;
-           STR : STRING (1..10) := "   10.25  ";
-      BEGIN
- 
- -- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT
-           BEGIN
-                GET ("896.5  ", X, L);
-                IF X /= 896.5 THEN
-                     FAILED ("FIXED VALUE FROM STRING INCORRECT");
-                END IF;
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FIXED - 1");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 1");
-           END;
- 
-           IF L /= IDENT_INT (5) THEN
-                FAILED ("VALUE OF LAST INCORRECT - FIXED - 1.  " &
-                        "LAST IS" & INTEGER'IMAGE(L));
-           END IF;
- 
- -- STRING LITERAL WITH BLANKS
-           BEGIN
-                GET ("   ", X, L);
-                FAILED ("END_ERROR NOT RAISED - FIXED - 2");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= 5 THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 2.  LAST IS"  &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FIXED - 2");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 2");
-           END;
- 
- -- NULL STRING LITERAL
-           BEGIN
-                GET ("", X, L);
-                FAILED ("END_ERROR NOT RAISED - FIXED - 3");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= 5 THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 3.  LAST IS"  &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FIXED - 3");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 3");
-           END;
- 
- -- NULL SLICE
-           BEGIN
-                GET (STR(5..IDENT_INT(2)), X, L);
-                FAILED ("END_ERROR NOT RAISED - FIXED - 4");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= 5 THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 4.  LAST IS"  &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FIXED - 4");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 4");
-           END;
- 
- -- SLICE WITH BLANKS
-           BEGIN
-                GET (STR(IDENT_INT(9)..10), X, L);
-                FAILED ("END_ERROR NOT RAISED - FIXED - 5");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= IDENT_INT(5) THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 5.  LAST IS"  &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FIXED - 5");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 5");
-           END;
- 
- -- NON-NULL SLICE
-           BEGIN
-                GET (STR(2..IDENT_INT(8)), X, L);
-                IF X /= 10.25 THEN
-                     FAILED ("FIXED VALUE INCORRECT - 6");
-                END IF;
-                IF L /= 8 THEN
-                     FAILED ("LAST INCORRECT FOR SLICE - 6.  " &
-                             "LAST IS" & INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 6");
-           END;
- 
- -- LEFT-JUSTIFIED, POSITIVE EXPONENT
-           BEGIN
-                GET ("1.34E+02", X, L);
-                IF X /= 134.0 THEN
-                     FAILED ("FIXED WITH EXP FROM STRING INCORRECT - 7");
-                END IF;
- 
-                IF L /= 8 THEN
-                     FAILED ("VALUE OF LAST INCORRECT - FIXED - 7.  " &
-                             "LAST IS" & INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_EROR RAISED - FIXED - 7");
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 7");
-           END;
- 
- -- RIGHT-JUSTIFIED, NEGATIVE EXPONENT
-           BEGIN
-                GET (" 25.0E-2", X, L);
-                IF X /= 0.25 THEN
-                     FAILED ("NEG EXPONENT INCORRECT - 8");
-                END IF;
-                IF L /= 8 THEN
-                     FAILED ("LAST INCORRECT - 8.  " &
-                             "LAST IS" & INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION RAISED - 8");
-           END;
- 
- -- RIGHT-JUSTIFIED, NEGATIVE
-           GET ("  -1.50", X, L);
-           IF X /= -1.5 THEN
-                FAILED ("FIXED IN RIGHT JUSTIFIED STRING INCORRECT - 9");
-           END IF;
-           IF L /= 7 THEN
-                FAILED ("LAST INCORRECT - 9.  " &
-                        "LAST IS" & INTEGER'IMAGE(L));
-           END IF;
- 
- -- HORIZONTAL TAB WITH BLANK
-           BEGIN
-                GET (" " & ASCII.HT & "2.3E+2", X, L);
-                IF X /= 230.0 THEN
-                     FAILED ("FIXED WITH TAB IN STRING INCORRECT - 10");
-                END IF;
-                IF L /= 8 THEN
-                     FAILED ("LAST INCORRECT FOR TAB - 10.  " &
-                             "LAST IS" & INTEGER'IMAGE(L));
-                END IF;
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");
-                WHEN OTHERS =>
-                     FAILED ("EXCEPTION FOR STRING WITH TAB - 10");
-           END;
- 
- -- HORIZONTAL TABS ONLY
- 
-           BEGIN
-                GET (ASCII.HT & ASCII.HT, X, L);
-                FAILED ("END_ERROR NOT RAISED - FIXED - 11");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= IDENT_INT(8) THEN
-                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
-                                  "INCORRECT - 11.  LAST IS"  &
-                                  INTEGER'IMAGE(L));
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED - FIXED - 11");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 11");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE3809B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,114 ****
- -- CE3810A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FLOAT_IO PUT CAN OPERATE ON STRINGS.  ALSO CHECK THAT
- --     LAYOUT_ERROR IS RAISED WHEN THE STRING IS INSUFFICIENTLY LONG.
- 
- -- HISTORY:
- --     SPS 10/07/82
- --     VKG 01/20/83
- --     SPS 02/18/83
- --     DWC 09/15/87  SPLIT CASE FOR FIXED_IO INTO CE3810B.ADA AND
- --                   ADDED CASED FOR AFT AND EXP TO RAISE LAYOUT_ERROR.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3810A IS
- BEGIN
- 
-      TEST ("CE3810A", "CHECK THAT FLOAT_IO PUT " &
-                       "OPERATES ON STRINGS CORRECTLY");
- 
-      DECLARE
-           TYPE FL IS DIGITS 4;
-           PACKAGE FLIO IS NEW FLOAT_IO (FL);
-           USE FLIO;
-           ST  : STRING (1 .. 2 + (FL'DIGITS-1) + 3 + 2);
-           ST1 : STRING (1 .. 10) := " 2.345E+02";
-           ST2 : STRING (1 .. 2);
-      BEGIN
-           PUT (ST, 234.5);
-           IF ST /= ST1 THEN
-                FAILED ("PUT FLOAT TO STRING INCORRECT; OUTPUT WAS """ &
-                         ST & """");
-           END IF;
- 
-           BEGIN
-                PUT (ST(1 .. 8), 234.5);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 1");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 1");
-           END;
- 
-           BEGIN
-                PUT (ST, 2.3, 9, 0);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 2");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2");
-           END;
- 
-           BEGIN
-                PUT (ST2, 2.0, 0, 0);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 3");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3");
-           END;
- 
-           BEGIN
-                PUT (ST, 2.345, 6, 2);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 4");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4");
-           END;
- 
-           BEGIN
-                PUT (ST, 2.0, 0, 7);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 5");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE3810A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,122 ****
- -- CE3810B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT FIXED_IO PUT CAN OPERATE ON STRINGS.  ALSO CHECK THAT
- --     LAYOUT_ERROR IS RAISED WHEN THE STRING IS INSUFFICIENTLY LONG.
- 
- -- HISTORY:
- --     DWC 09/15/87  CREATE ORIGINAL TEST.
- --     JRL 02/28/96  Changed upper bound of type FX from 1000.0 to 250.0.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3810B IS
- BEGIN
- 
-      TEST ("CE3810B", "CHECK THAT FIXED_IO PUT CAN OPERATE ON " &
-                       "STRINGS.  ALSO CHECK THAT LAYOUT_ERROR IS " &
-                       "RAISED WHEN THE STRING IS INSUFFICIENTLY LONG");
- 
-      DECLARE
-           TYPE FX IS DELTA 0.0001 RANGE 0.0 .. 250.0;
-           PACKAGE FXIO IS NEW FIXED_IO (FX);
-           USE FXIO;
-           ST1 : CONSTANT STRING  := "  234.5000";
-           ST : STRING (ST1'RANGE);
-           ST2 : STRING (1 .. 2);
- 
-      BEGIN
-           BEGIN
-                PUT (ST, 234.5);
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     FAILED ("LAYOUT_ERROR RAISED ON PUT" &
-                             "TO STRING - FIXED");
-                WHEN OTHERS =>
-                     FAILED ("SOME EXCEPTION RAISED ON PUT" &
-                             "TO STRING -FIXED");
-           END;
- 
-           IF ST /= ST1 THEN
-                FAILED ("PUT FIXED TO STRING INCORRECT; OUTPUT " &
-                        "WAS """ & ST & """");
-           END IF;
- 
-           BEGIN
-                PUT (ST (1..7), 234.5000);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 1");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 1");
-           END;
- 
-           BEGIN
-                PUT (ST, 2.3, 9, 0);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 2");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 2");
-           END;
- 
-           BEGIN
-                PUT (ST2, 2.0, 0, 0);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 3");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 3");
-           END;
- 
-           BEGIN
-                PUT (ST, 2.345, 6, 2);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 4");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 4");
-           END;
- 
-           BEGIN
-                PUT (ST, 2.0, 0, 7);
-                FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 5");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 5");
-           END;
-      END;
- 
-      RESULT;
- END CE3810B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- CE3815A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATIONS IN GENERIC PACKAGE FLOAT_IO ALL HAVE
- --     THE CORRECT PARAMETER NAMES.
- 
- -- HISTORY:
- --     JET 10/28/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- PROCEDURE CE3815A IS
- 
-      STR : STRING(1..20) := (OTHERS => ' ');
-      FIN, FOUT : FILE_TYPE;
-      F : FLOAT;
-      L : POSITIVE;
-      FILE_OK : BOOLEAN := FALSE;
- 
-      PACKAGE FIO IS NEW FLOAT_IO(FLOAT);
-      USE FIO;
- 
- BEGIN
-      TEST ("CE3815A", "CHECK THAT THE OPERATIONS IN GENERIC PACKAGE " &
-                       "FLOAT_IO ALL HAVE THE CORRECT PARAMETER NAMES");
- 
-      PUT (TO => STR, ITEM => 1.0, AFT => 3, EXP => 3);
-      GET (FROM => STR, ITEM => F, LAST => L);
- 
-      BEGIN
-           CREATE(FOUT, OUT_FILE, LEGAL_FILE_NAME);
-           FILE_OK := TRUE;
-      EXCEPTION
-           WHEN OTHERS =>
-                COMMENT("OUTPUT FILE COULD NOT BE CREATED");
-      END;
- 
-      IF FILE_OK THEN
-           BEGIN
-                PUT (FILE => FOUT, ITEM => 1.0, FORE => 3, AFT => 3,
-                     EXP => 3);
-                NEW_LINE(FOUT);
- 
-                CLOSE(FOUT);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("OUTPUT FILE COULD NOT BE WRITTEN");
-                     FILE_OK := FALSE;
-           END;
-      END IF;
- 
-      IF FILE_OK THEN
-           BEGIN
-                OPEN(FIN, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("INPUT FILE COULD NOT BE OPENED");
-                     FILE_OK := FALSE;
-           END;
-      END IF;
- 
-      IF FILE_OK THEN
-           BEGIN
-                GET (FILE => FIN, ITEM => F, WIDTH => 10);
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED ("DATA COULD NOT BE READ FROM FILE");
-           END;
- 
-           BEGIN
-                DELETE(FIN);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     COMMENT("FILE COULD NOT BE DELETED");
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED ERROR AT DELETION");
-           END;
-      END IF;
- 
-      RESULT;
- END CE3815A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- CE3901A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET AND PUT FOR ENUMERATED TYPES RAISE STATUS ERROR
- --     IF THE FILE IS NOT OPEN.
- 
- -- HISTORY:
- --     SPS 10/07/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     DWC 09/16/87  ADDED AN ATTEMPT TO CREATE A FILE AND THEN
- --                   RETESTED OBJECTIVE.
- --     BCB 10/03/90  ADDED NAME_ERROR AS A CHOICE TO THE EXCEPTION
- --                   HANDLER FOR CREATE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3901A IS
- BEGIN
- 
-      TEST ("CE3901A", "CHECK THAT GET AND PUT FOR ENUMERATED TYPES " &
-                       "RAISE STATUS ERROR IF THE FILE IS NOT OPEN.");
- 
-      DECLARE
-           TYPE COLOR IS (RED, BLUE, GREEN, ORANGE, YELLOW);
-           FT : FILE_TYPE;
-           PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-           USE COLOR_IO;
-           X : COLOR;
-      BEGIN
-           BEGIN
-                PUT (FT, RED);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT - 1");
-           END;
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - GET - 1");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET - 1");
-           END;
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);  -- THIS IS JUST
-                CLOSE (FT);                   -- AN ATTEMPT TO CREATE A
-           EXCEPTION                          -- FILE.  OBJECTIVE IS MET
-                WHEN USE_ERROR                -- EITHER WAY.
-                   | NAME_ERROR =>  NULL;
-           END;
- 
-           BEGIN
-                PUT (FT, RED);
-                FAILED ("STATUS_ERROR NOT RAISED - PUT - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - PUT - 2");
-           END;
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("STATUS_ERROR NOT RAISED - GET - 2");
-           EXCEPTION
-                WHEN STATUS_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - GET - 2");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE3901A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CE3902B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE OPERATIONS IN GENERIC PACKAGE ENUMERATION_IO
- --     ALL HAVE THE CORRECT PARAMETER NAMES.
- 
- -- HISTORY:
- --     JLH 08/25/88  CREATED ORIGINAL TEST.
- --     RJW 02/28/90  ADDED CODE TO PREVENT MODE_ERROR FROM BEING RAISED.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3902B IS
- 
-      TYPE COLOR IS (RED, BLUE, GREEN);
-      PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-      USE COLOR_IO;
- 
-      FILE1 : FILE_TYPE;
-      CRAYON : COLOR := RED;
-      INDEX : POSITIVE;
-      NUM : FIELD := 5;
-      COLOR_STRING : STRING (1..5);
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3902B", "CHECK THAT THE OPERATIONS IN GENERIC PACKAGE " &
-                       "ENUMERATION_IO ALL HAVE THE CORRECT PARAMETER " &
-                       "NAMES");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_OUTPUT (FILE1);
- 
-           PUT (FILE => FILE1, ITEM => CRAYON, WIDTH => NUM,
-                SET => UPPER_CASE);
- 
-           PUT (ITEM => GREEN, WIDTH => 5, SET => LOWER_CASE);
- 
-           PUT (TO => COLOR_STRING, ITEM => BLUE, SET => UPPER_CASE);
- 
-           CLOSE (FILE1);
- 
-           SET_OUTPUT (STANDARD_OUTPUT);
- 
-           BEGIN
-                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                     "MODE IN_FILE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_INPUT (FILE1);
- 
-           GET (FILE => FILE1, ITEM => CRAYON);
- 
-           GET (ITEM => CRAYON);
- 
-           GET (FROM => COLOR_STRING, ITEM => CRAYON, LAST => INDEX);
- 
-           BEGIN
-                DELETE (FILE1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3902B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,117 ****
- -- CE3904A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE LAST NONBLANK CHARACTER IN A FILE MAY BE READ BY
- --     'GET' IN ENUMERATION_IO WITHOUT RAISING END_ERROR, AND THAT AFTER
- --     THE LAST CHARACTER OF THE FILE HAS BEEN READ, ANY ATTEMPT TO READ
- --     FURTHER CHARACTERS WILL RAISE END_ERROR.
- 
- -- HISTORY:
- --     JET 08/19/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT, TEXT_IO;  USE REPORT, TEXT_IO;
- PROCEDURE CE3904A IS
- 
-      TYPE ENUM IS (THE, QUICK, BROWN, X);
-      E : ENUM;
- 
-      PACKAGE EIO IS NEW ENUMERATION_IO(ENUM);
-      USE EIO;
- 
-      F : FILE_TYPE;
- 
-      FILE_OK : BOOLEAN := FALSE;
- 
- BEGIN
-      TEST ("CE3904A", "CHECK THAT THE LAST NONBLANK CHARACTER IN A " &
-                       "FILE MAY BE READ BY 'GET' IN ENUMERATION_IO " &
-                       "WITHOUT RAISING END_ERROR, AND THAT AFTER THE " &
-                       "LAST CHARACTER OF THE FILE HAS BEEN READ, ANY " &
-                       "ATTEMPT TO READ FURTHER CHARACTERS WILL RAISE " &
-                       "END_ERROR");
- 
-      BEGIN
-           CREATE(F, OUT_FILE, LEGAL_FILE_NAME);
-           FILE_OK := TRUE;
-      EXCEPTION
-           WHEN OTHERS =>
-                NOT_APPLICABLE("DATA FILE COULD NOT BE OPENED FOR " &
-                               "WRITING");
-      END;
- 
-      IF FILE_OK THEN
-           BEGIN
-                PUT(F, THE); NEW_LINE(F);
-                PUT(F, QUICK); NEW_LINE(F);
-                PUT(F, BROWN); NEW_LINE(F);
-                PUT(F, X); NEW_LINE(F);
-                CLOSE(F);
-           EXCEPTION
-                WHEN OTHERS =>
-                     NOT_APPLICABLE("DATA FILE COULD NOT BE WRITTEN");
-                     FILE_OK := FALSE;
-           END;
-      END IF;
- 
-      IF FILE_OK THEN
-           BEGIN
-                OPEN(F, IN_FILE, LEGAL_FILE_NAME);
-                FOR I IN 0..3 LOOP
-                     GET(F, E);
-                     IF E /= ENUM'VAL(I) THEN
-                          FAILED("INCORRECT VALUE READ -" &
-                                 INTEGER'IMAGE(I));
-                     END IF;
-                END LOOP;
-           EXCEPTION
-                WHEN OTHERS =>
-                     FAILED("UNEXPECTED EXCEPTION RAISED BEFORE END " &
-                            "OF FILE");
-                     FILE_OK := FALSE;
-           END;
-      END IF;
- 
-      IF FILE_OK THEN
-           BEGIN
-                GET(F, E);
-                FAILED("NO EXCEPTION RAISED AFTER END OF FILE");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED("INCORRECT EXCEPTION RAISED AFTER END OF " &
-                            "FILE");
-           END;
- 
-           BEGIN
-                DELETE(F);
-           EXCEPTION
-                WHEN OTHERS =>
-                     COMMENT("DATA FILE COULD NOT BE DELETED");
-           END;
-      END IF;
- 
-      RESULT;
- END CE3904A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,142 ****
- -- CE3904B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT END_ERROR IS RAISED BY GET WITH AN ENUMERATION TYPE
- --     WHEN THE ONLY REMAINING CHARACTERS IN THE FILE ARE SPACES,
- --     HORIZONTAL TABULATION CHARACTERS, LINE TERMINATORS, AND PAGE
- --     TERMINATORS.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     JLH 07/15/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE CE3904B IS
- 
-      TYPE COLOR IS (RED, BLUE, GREEN);
-      PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-      USE COLOR_IO;
- 
-      FILE : FILE_TYPE;
-      ITEM : COLOR;
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3904B", "CHECK THAT END_ERROR IS RAISED BY GET WITH " &
-                       "AN ENUMERATION TYPE WHEN THE ONLY REMAINING " &
-                       "CHARACTERS IN THE FILE ARE SPACES, HORIZONTAL " &
-                       "TABULATION CHARACTERS, LINE TERMINATORS, AND " &
-                       "PAGE TERMINATORS");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FILE, RED);
-           NEW_LINE (FILE);
-           NEW_LINE (FILE);
-           NEW_PAGE (FILE);
-           PUT (FILE, ASCII.HT);
-           PUT (FILE, GREEN);
-           NEW_LINE (FILE);
-           NEW_LINE (FILE);
-           NEW_PAGE (FILE);
-           PUT (FILE, ' ');
-           PUT (FILE, ASCII.HT);
-           PUT (FILE, ' ');
- 
-           CLOSE (FILE);
- 
-           BEGIN
-                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                     "MODE IN_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FILE, ITEM);
-           IF ITEM /= RED THEN
-                FAILED ("INCORRECT VALUE READ - 1");
-           END IF;
- 
-           GET (FILE, ITEM);
-           IF ITEM /= GREEN THEN
-                FAILED ("INCORRECT VALUE READ - 2");
-           END IF;
- 
-           BEGIN
-                GET (FILE, ITEM);
-                FAILED ("END_ERROR NOT RAISED FOR GET");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
-           END;
- 
-           IF NOT END_OF_FILE (FILE) THEN
-                FAILED ("END_OF_FILE NOT TRUE AFTER RAISING EXCEPTION");
-           END IF;
- 
-           BEGIN
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3904B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,145 ****
- -- CE3905A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR ENUMERATION TYPES OPERATES ON FILE OF MODE
- --     IN_FILE AND THAT WHEN NO FILE IS SPECIFIED IT OPERATES ON THE
- --     CURRENT DEFAULT INPUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/07/82
- --     SPS 12/22/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/16/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3905A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3905A", "CHECK THAT GET FOR ENUMERATION TYPES " &
-                       "OPERATES ON FILE OF MODE IN_FILE AND THAT " &
-                       "WHEN NO FILE IS SPECIFIED IT OPERATES ON " &
-                       "THE CURRENT DEFAULT INPUT_FILE");
- 
-      DECLARE
-           TYPE DAY IS (MONDAY, TUESDAY, WEDNESDAY, THURSDAY, FRIDAY);
-           PACKAGE DAY_IO IS NEW ENUMERATION_IO (DAY);
-           FT : FILE_TYPE;
-           FILE : FILE_TYPE;
-           USE DAY_IO;
-           X : DAY;
-      BEGIN
- 
- -- CREATE AND INITIALIZE DATA FILES.
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "WEDNESDAY");
-           NEW_LINE (FT);
-           PUT (FT, "FRIDAY");
- 
-           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME(2));
- 
-           PUT (FILE, "TUESDAY");
-           NEW_LINE (FILE);
-           PUT (FILE, "THURSDAY");
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "FOR IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CLOSE (FILE);
-           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
- 
-           SET_INPUT (FILE);
- 
- -- BEGIN TEST
- 
-           GET (FT, X);
-           IF X /= WEDNESDAY THEN
-                FAILED ("VALUE FROM FILE INCORRECT");
-           END IF;
- 
-           GET (X);
-           IF X /= TUESDAY THEN
-                FAILED ("VALUE FROM DEFAULT INCORRECT");
-           END IF;
- 
-           GET (FT, X);
-           IF X /= FRIDAY THEN
-                FAILED ("VALUE FROM FILE INCORRECT");
-           END IF;
- 
-           GET (FILE, X);
-           IF X /= THURSDAY THEN
-                FAILED ("VALUE FROM DEFAULT INCORRECT");
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-                DELETE (FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3905A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- CE3905B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR ENUMERATION TYPES RAISE MODE_ERROR WHEN THE
- --     MODE OF THE FILE SPECIFIED IS OUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT CREATE FOR TEMP FILES WITH OUT_FILE.
- 
- -- HISTORY:
- --     SPS 10/07/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/16/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3905B IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3905B", "CHECK THAT ENUMERATION_IO GET RAISES " &
-                       "MODE_ERROR WHEN THE MODE OF THE FILE IS " &
-                       "OUT_FILE");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE COLOR IS (RED, BLUE, GREEN, YELLOW);
-           X : COLOR;
-           PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-           USE COLOR_IO;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "FOR TEMP FILES WITH OUT_FILE " &
-                                     "MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                GET (FT, X);
-                FAILED ("MODE_ERROR NOT RAISED - FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FILE");
-           END;
- 
-           BEGIN
-                GET (STANDARD_OUTPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - STANDARD_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - STANDARD_OUTPUT");
-           END;
- 
-           BEGIN
-                GET (CURRENT_OUTPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - CURRENT_OUTPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CURRENT_OUTPUT");
-           END;
- 
-           CLOSE (FT);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3905B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,202 ****
- -- CE3905C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR ENUMERATION TYPES RAISES DATA_ERROR WHEN THE
- --     ELEMENT RETRIEVED IS NOT OF THE TYPE EXPECTED OR IS OUT OF THE
- --     RANGE OF A SUBTYPE.  ALSO CHECK THAT CONSTRAINT_ERROR IS RAISED
- --     IF THE VALUE READ IS OUT OF RANGE OF THE ITEM PARAMETER, BUT
- --     WITHIN THE RANGE OF THE INSTANTIATED TYPE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/08/82
- --     SPS 12/14/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/16/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3905C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3905C", "CHECK THAT GET FOR ENUMERATION TYPES RAISES " &
-                       "DATA_ERROR WHEN THE ELEMENT RETRIEVED IS NOT " &
-                       "OF THE TYPE EXPECTED OR IS OUT OF THE RANGE " &
-                       "OF A SUBTYPE.  ALSO CHECK THAT " &
-                       "CONSTRAINT_ERROR IS RAISED IF THE VALUE READ " &
-                       "IS OUT OF RANGE OF THE ITEM PARAMETER, BUT " &
-                       "WITHIN THE RANGE OF THE INSTANTIATED TYPE");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE COLOR IS (RED, BLUE, YELLOW, WHITE, ORANGE, GREEN,
-                          PURPLE, BLACK);
-           SUBTYPE P_COLOR IS COLOR RANGE RED .. YELLOW;
-           CRAYON : COLOR := BLACK;
-           PAINT : P_COLOR := BLUE;
-           ST : STRING (1 .. 2);
-           PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-           USE COLOR_IO;
-      BEGIN
- 
- -- CREATE AND INITIALIZE DATA FILE
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "BROWN");
-           NEW_LINE (FT);
-           PUT (FT, "ORANGE");
-           NEW_LINE (FT);
-           PUT (FT, "GREEN");
-           NEW_LINE (FT);
-           PUT (FT, "WHITE");
-           NEW_LINE (FT);
-           PUT (FT, "WHI");
-           NEW_LINE (FT);
-           PUT (FT, "TE");
-           NEW_LINE (FT);
-           PUT (FT, "RED");
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; OPEN WITH " &
-                              "IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
- -- START TEST
- 
-           BEGIN
-                GET (FT, CRAYON);                  -- BROWN
-                FAILED ("DATA_ERROR NOT RAISED - 1");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     IF CRAYON /= BLACK THEN
-                          FAILED ("ITEM CRAYON AFFECTED - 1");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 1");
-           END;
- 
-           BEGIN
-                GET (FT, PAINT);                   -- ORANGE
-                FAILED ("CONSTRAINT_ERROR NOT RAISED");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     IF PAINT /= BLUE THEN
-                          FAILED ("ITEM PAINT AFFECTED - 2");
-                     END IF;
-                WHEN DATA_ERROR =>
-                     FAILED ("DATA_ERROR RAISED FOR ITEM SUBTYPE");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 2");
-           END;
- 
-           DECLARE
-                PACKAGE P_COLOR_IO IS NEW ENUMERATION_IO (P_COLOR);
-                USE P_COLOR_IO;
-           BEGIN
-                BEGIN
-                     P_COLOR_IO.GET (FT, PAINT);   -- GREEN
-                     FAILED ("DATA_ERROR NOT RAISED - 3");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF PAINT /= BLUE THEN
-                               FAILED ("ITEM PAINT AFFECTED - 3");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 3");
-                END;
- 
-                BEGIN
-                     P_COLOR_IO.GET (FT, PAINT);   -- WHITE
-                     FAILED ("DATA_ERROR NOT RAISED - 3A");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 3A");
-                END;
-           END;
- 
-           BEGIN
-                GET (FT, CRAYON);                  -- WHI
-                FAILED ("DATA_ERROR NOT RAISED - 4");
-           EXCEPTION
-                WHEN DATA_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 4");
-           END;
- 
-           GET (FT, ST);                 -- TE
- 
-           GET (FT, CRAYON);                  -- RED
-           IF CRAYON /= RED THEN
-                FAILED ("READING NOT CONTINUED CORRECTLY AFTER" &
-                        "DATA_ERROR EXCEPTION");
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3905C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,311 ****
- -- CE3905L.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT DATA_ERROR IS RAISED, BY GET, WHEN THE INPUT CONTAINS
- --
- --     1. EMBEDDED BLANKS.
- --     2. SINGLY QUOTED CHARACTER LITERALS.
- --     3. IDENTIFIERS BEGINNING WITH NON LETTERS.
- --     4. IDENTIFIERS CONTAINING SPECIAL CHARACTERS.
- --     5. CONSECUTIVE UNDERSCORES.
- --     6. LEADING OR TRAILING UNDERSCORES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     VKG 02/14/83
- --     SPS 03/16/83
- --     CPP 07/30/84
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/16/87  REMOVED UNNECESSARY CODE AND CORRECTED
- --                   EXCEPTION HANDLING.
- 
- WITH TEXT_IO; USE TEXT_IO;
- WITH REPORT; USE REPORT;
- 
- PROCEDURE CE3905L IS
- 
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
-      TEST ("CE3905L", "CHECK GET FOR ENUMERATION_IO " &
-                       "WITH LEXICAL ERRORS");
-      DECLARE
-           FT : FILE_TYPE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, "RED ISH");
-           NEW_LINE (FT);
-           PUT (FT, "'A ");
-           NEW_LINE (FT);
-           PUT (FT, "2REDISH");
-           NEW_LINE (FT);
-           PUT (FT, "BLUE$%ISH");
-           NEW_LINE (FT);
-           PUT (FT, "RED__ISH");
-           NEW_LINE (FT);
-           PUT (FT, "_YELLOWISH");
-           NEW_LINE (FT);
-           PUT  (FT, "GREENISH_");
-           NEW_LINE (FT);
- 
-           CLOSE (FT);
- 
-           DECLARE
-                TYPE COLOUR IS
-                     ( GREYISH,
-                       REDISH ,
-                       BLUEISH,
-                       YELLOWISH,
-                       GREENISH, 'A');
-                PACKAGE COLOUR_IO IS NEW ENUMERATION_IO(COLOUR);
-                USE COLOUR_IO;
-                X : COLOUR := GREYISH;
-                CH : CHARACTER;
-           BEGIN
- 
-                BEGIN
-                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-                EXCEPTION
-                     WHEN USE_ERROR =>
-                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                          "OPEN WITH IN_FILE MODE");
-                          RAISE INCOMPLETE;
-                END;
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 1");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= GREYISH THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 1");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 1");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - 1");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= ' ' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- 1: CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 2");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= GREYISH THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 2");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 2");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - 2");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= ' ' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- 2: CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 3");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= GREYISH THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 3");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 3");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - 3");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= '2' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- 3: CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 4");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= GREYISH THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 4");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 4");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - 4");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= '$' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- 4: CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 5");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= GREYISH THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 5");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 5");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - 5");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= '_' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- 5: CHAR IS " & CH);
-                     ELSE
-                          GET (FT, CH);
-                          IF CH /= 'I' THEN
-                               FAILED ("ERROR READING DATA - 5");
-                          END IF;
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 6");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= GREYISH THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 6");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 6");
-                END;
- 
-                IF END_OF_LINE (FT) THEN
-                     FAILED ("GET STOPPED AT END OF LINE - 6");
-                ELSE
-                     GET (FT, CH);
-                     IF CH /= '_' THEN
-                          FAILED ("GET STOPPED AT WRONG POSITION " &
-                                  "- 6: CHAR IS " & CH);
-                     END IF;
-                END IF;
- 
-                SKIP_LINE (FT);
- 
-                BEGIN
-                     GET (FT, X);
-                     FAILED ("DATA_ERROR NOT RAISED - 7");
-                EXCEPTION
-                     WHEN DATA_ERROR =>
-                          IF X /= GREYISH THEN
-                               FAILED ("ACTUAL PARAMETER TO GET " &
-                                       "AFFECTED ON DATA_ERROR - 7");
-                          END IF;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED - 7");
-                END;
- 
-                IF NOT END_OF_LINE (FT) THEN
-                     BEGIN
-                          GET (FT, X);
-                          FAILED ("GET STOPPED AT WRONG  POSITION " &
-                                  "- 7");
-                     EXCEPTION
-                          WHEN END_ERROR =>
-                               NULL;
-                          WHEN OTHERS =>
-                               FAILED ("WRONG EXCEPTION RAISED FOR " &
-                                       "EMPTY FILE - 7");
-                     END;
-                END IF;
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3905L;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- CE3906A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT FOR ENUMERATION TYPES CAN OPERATE ON FILES OF
- --     MODE OUT_FILE AND THAT WHEN NO FILE PARAMETER IS SPECIFIED
- --     THE CURRENT DEFAULT OUTPUT FILE IS USED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEMPORARY TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/08/82
- --     SPS 01/03/83
- --     SPS 02/18/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/17/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
- --                   HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3906A IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3906A", "CHECK THAT PUT FOR ENUMERATION TYPES CAN " &
-                       "OPERATE ON FILES OF MODE OUT_FILE AND THAT " &
-                       "WHEN NO FILE PARAMETER IS SPECIFIED THE " &
-                       "CURRENT DEFAULT OUTPUT FILE IS USED. CHECK " &
-                       "THAT ENUMERATION_IO PUT OPERATES ON OUT_FILE " &
-                       "FILES");
- 
-      DECLARE
-           FT1, FT2 : FILE_TYPE;
-           TYPE COLOR IS (ROSE, VANILLA, CHARCOAL, CHOCOLATE);
-           CRAYON : COLOR := ROSE;
-           PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-           USE COLOR_IO;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT1, OUT_FILE);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "FOR TEMP FILES WITH OUT_FILE " &
-                                     "MODE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FT2, OUT_FILE);
- 
-           SET_OUTPUT (FT2);
- 
-           PUT (FT1, CRAYON);
-           NEW_LINE (FT1);
-           PUT (FT1, CHOCOLATE);
- 
-           CRAYON := CHARCOAL;
- 
-           PUT (CRAYON);
-           NEW_LINE;
-           PUT (VANILLA);
- 
- -- CHECK OUTPUT
- 
-           SET_OUTPUT (STANDARD_OUTPUT);
-           COMMENT ("CHECKING FT1");
-           CHECK_FILE (FT1, "ROSE#CHOCOLATE#@%");
- 
-           COMMENT ("CHECKING FT2");
-           CHECK_FILE (FT2, "CHARCOAL#VANILLA#@%");
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3906A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,133 ****
- -- CE3906B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT PUT FOR ENUMERATION TYPES RAISES MODE_ERROR WHEN
- --     APPLIED TO FILES OF MODE IN_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/08/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/17/87  REMOVED DEPENDENCY ON RESET AND CORRECTED
- --                   EXCEPTION HANDLERS.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3906B IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3906B", "CHECK THAT PUT FOR ENUMERATION TYPES RAISES " &
-                       "MODE_ERROR WHEN APPLIED TO FILES OF MODE " &
-                       "IN_FILE");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE FLOWER IS (ROSE, DAISY, SNAPDRAGON, VIOLET, CARNATION);
-           PACKAGE FLOWER_IO IS NEW ENUMERATION_IO (FLOWER);
-           USE FLOWER_IO;
-           X : FLOWER := DAISY;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           PUT (FT, X);
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           BEGIN
-                PUT (FT, X);
-                FAILED ("MODE_ERROR NOT RAISED - FILE");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - FILE");
-           END;
- 
-           BEGIN
-                PUT (STANDARD_INPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - STANDARD_INPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - STANDARD_INPUT");
-           END;
- 
-           BEGIN
-                PUT (CURRENT_INPUT, X);
-                FAILED ("MODE_ERROR NOT RAISED - CURRENT_INPUT");
-           EXCEPTION
-                WHEN MODE_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - CURRENT_INPUT");
-           END;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3906B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,177 ****
- -- CE3906C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --      CHECK THAT PUT FOR ENUMERATION TYPES OUTPUTS THE ENUMERATION
- --      LITERAL WITH NO TRAILING OR PRECEDING BLANKS WHEN WIDTH IS
- --      NOT SPECIFIED OR IS SPECIFIED TO BE LESS THAN OR EQUAL TO THE
- --      LENGTH OF THE STRING.  CHECK THAT WHEN WIDTH IS SPECIFIED TO
- --      BE GREATER THAN THE LENGTH OF THE STRING, TRAILING BLANKS ARE
- --      OUTPUT.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/08/82
- --     SPS 01/03/83
- --     VKG 01/07/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST.
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/18/87  REMOVED CALL TO CHECKFILE.  CLOSED AND REOPENED
- --                   FILE AND CHECKED CONTENTS OF FILE USING
- --                   ENUMERATION_IO GETS.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3906C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3906C", "CHECK THAT ENUMERATION_IO PUT OUTPUTS " &
-                       "ENUMERATION LITERALS CORRECTLY WITH AND " &
-                       "WITHOUT WIDTH PARAMETERS");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE MOOD IS (ANGRY, HAPPY, BORED, SAD);
-           X : MOOD := BORED;
-           PACKAGE MOOD_IO IS NEW ENUMERATION_IO (MOOD);
-           CH : CHARACTER;
-           USE MOOD_IO;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           DEFAULT_WIDTH := FIELD(IDENT_INT(5));
- 
-           IF DEFAULT_WIDTH /= FIELD(IDENT_INT(5)) THEN
-                FAILED ("DEFAULT_WIDTH NOT SET CORRECTLY");
-           END IF;
- 
-           PUT (FT, X, 3);                             -- BORED
-           X := HAPPY;
-           NEW_LINE(FT);
-           PUT (FILE => FT, ITEM => X, WIDTH => 5);    -- HAPPY
-           NEW_LINE (FT);
-           PUT (FT, SAD, 5);                           -- SAD
-           DEFAULT_WIDTH := FIELD(IDENT_INT(6));
-           PUT (FT, X);                                -- HAPPY
-           PUT (FT, SAD, 3);                           -- SAD
-           NEW_LINE(FT);
-           DEFAULT_WIDTH := FIELD(IDENT_INT(2));
-           PUT (FT, SAD);                              -- SAD
- 
-           CLOSE (FT);
- 
-           BEGIN
-                OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN FOR " &
-                                     "IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           GET (FT, X);
-           IF X /= BORED THEN
-                FAILED ("BORED NOT READ CORRECTLY");
-           END IF;
- 
-           GET (FT, X);
-           IF X /= HAPPY THEN
-                FAILED ("HAPPY NOT READ CORRECTLY - 1");
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           GET (FT, X);
-           IF X /= SAD THEN
-                FAILED ("SAD NOT READ CORRECTLY - 1");
-           END IF;
- 
-           GET (FT, CH);
-           IF CH /= ' ' THEN
-                FAILED ("BLANKS NOT POSITIONED CORRECTLY - 1");
-           END IF;
- 
-           GET (FT, CH);
-           IF CH /= ' ' THEN
-                FAILED ("BLANKS NOT POSITIONED CORRECTLY - 2");
-           END IF;
- 
-           GET (FT, X);
-           IF X /= HAPPY THEN
-                FAILED ("HAPPY NOT READ CORRECTLY - 2");
-           END IF;
- 
-           GET (FT, CH);
-           IF CH /= ' ' THEN
-                FAILED ("BLANKS NOT POSITIONED CORRECTLY - 3");
-           END IF;
- 
-           GET (FT, X);
-           IF X /= SAD THEN
-                FAILED ("SAD NOT READ CORRECTLY - 2");
-           END IF;
- 
-           SKIP_LINE (FT);
- 
-           GET (FT, X);
-           IF X /= SAD THEN
-                FAILED ("SAD NOT READ CORRECTLY - 3");
-           END IF;
- 
-           BEGIN
-                DELETE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3906C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,152 ****
- -- CE3906D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY PUT FOR ENUMERATION
- --     TYPES WHEN THE VALUE OF WIDTH IS NEGATIVE, WHEN WIDTH IS
- --     GREATER THAN FIELD'LAST, OR WHEN THE VALUE OF ITEM IS OUTSIDE
- --     THE RANGE OF THE SUBTYPE USED TO INSTANTIATE ENUMERATION_IO.
- 
- -- HISTORY:
- --     SPS 10/08/82
- --     DWC 09/17/87  ADDED CASES FOR CONSTRAINT_ERROR.
- --     JRL 06/07/96  Added call to Ident_Int in expressions involving
- --                   Field'Last, to make the expressions non-static and
- --                   prevent compile-time rejection.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3906D IS
- BEGIN
- 
-      TEST ("CE3906D", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY PUT " &
-                       "FOR ENUMERATION TYPES WHEN THE VALUE OF " &
-                       "WIDTH IS NEGATIVE, WHEN WIDTH IS GREATER " &
-                       "THAN FIELD'LAST, OR WHEN THE VALUE OF ITEM " &
-                       "IS OUTSIDE THE RANGE OF THE SUBTYPE USED TO " &
-                       "INSTANTIATE ENUMERATION_IO");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE DAY IS (SUNDAY, MONDAY, TUESDAY, WEDNESDAY,
-                        THURSDAY, FRIDAY, SATURDAY);
-           TODAY : DAY := FRIDAY;
-           SUBTYPE WEEKDAY IS DAY RANGE MONDAY .. FRIDAY;
-           PACKAGE DAY_IO IS NEW ENUMERATION_IO (WEEKDAY);
-           USE DAY_IO;
-      BEGIN
- 
-           BEGIN
-                PUT (FT, TODAY, -1);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED; NEGATIVE " &
-                        "WIDTH - FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("RAISED STATUS_ERROR");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED; NEGATIVE " &
-                             "WIDTH - FILE");
-           END;
- 
-           IF FIELD'LAST < INTEGER'LAST THEN
-                BEGIN
-                     PUT (FT, TODAY, FIELD'LAST + Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED; WIDTH " &
-                             "GREATER THAN FIELD'LAST + 1- FILE");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED; WIDTH " &
-                                  "GREATER THAN FIELD'LAST + 1 - FILE");
-                END;
- 
-                BEGIN
-                     PUT (TODAY, FIELD'LAST + Ident_Int(1));
-                     FAILED ("CONSTRAINT_ERROR NOT RAISED; WIDTH " &
-                             "GREATER THAN FIELD'LAST + 1 - DEFAULT");
-                EXCEPTION
-                     WHEN CONSTRAINT_ERROR =>
-                          NULL;
-                     WHEN OTHERS =>
-                          FAILED ("WRONG EXCEPTION RAISED; WIDTH " &
-                                  "GREATER THAN FIELD'LAST + 1 " &
-                                  "- DEFAULT");
-           END;
- 
-           END IF;
- 
-           TODAY := SATURDAY;
- 
-           BEGIN
-                PUT (FT, TODAY);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED; ITEM VALUE " &
-                        "OUT OF RANGE - FILE");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED; ITEM VALUE " &
-                             "OUT OF RANGE - FILE");
-           END;
- 
-           TODAY := FRIDAY;
- 
-           BEGIN
-                PUT (TODAY, -3);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED; NEGATIVE " &
-                        "WIDTH - DEFAULT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN STATUS_ERROR =>
-                     FAILED ("RAISED STATUS_ERROR");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED; NEGATIVE " &
-                             "WIDTH - DEFAULT");
-           END;
- 
-           TODAY := SATURDAY;
- 
-           BEGIN
-                PUT (TODAY);
-                FAILED ("CONSTRAINT_ERROR NOT RAISED; ITEM VALUE " &
-                        "OUT OF RANGE - DEFAULT");
-           EXCEPTION
-                WHEN CONSTRAINT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED; ITEM VALUE " &
-                             "OUT OF RANGE - DEFAULT");
-           END;
-      END;
- 
-      RESULT;
- 
- END CE3906D;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,109 ****
- -- CE3906E.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- HISTORY:
- --     CHECK THAT PUT FOR ENUMERATION TYPES RAISES LAYOUT_ERROR WHEN
- --     THE NUMBER OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE
- --     LENGTH. CHECK THAT LAYOUT_ERROR IS NOT RAISED WHEN THE NUMBER
- --     OF CHARACTERS TO BE OUTPUT DOES NOT EXCEED THE MAXIMUM LINE
- --     LENGTH, BUT WHEN ADDED TO THE CURRENT COLUMN NUMBER, THE TOTAL
- --     EXCEEDS THE MAXIMUM LINE LENGTH.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMETATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     SPS 10/11/82
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/18/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3906E IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("CE3906E", "CHECK THAT ENUMERATION_IO PUT RAISES " &
-                       "LAYOUT_ERROR CORRECTLY");
- 
-      DECLARE
-           FT : FILE_TYPE;
-           TYPE COLOR IS (RED, BLU, YELLOW, ORANGE, RD);
-           PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-           USE COLOR_IO;
-           CRAYON : COLOR := ORANGE;
-      BEGIN
- 
-           BEGIN
-                CREATE (FT);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                     "CREATE FOR TEMP FILES WITH " &
-                                     "OUT_FILE MODE - 1");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_LINE_LENGTH (FT, 5);
- 
-           BEGIN
-                PUT (FT, CRAYON);
-                FAILED("LAYOUT_ERROR NOT RAISED");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END;
- 
-           PUT (FT, RED);
- 
-           PUT (FT, BLU);
-           IF LINE (FT) /= 2 THEN
-                FAILED ("PUT DID NOT CAUSE NEW_LINE EFFECT");
-           END IF;
- 
-           PUT (FT, RD);
- 
-           CHECK_FILE (FT, "RED#" &
-                           "BLURD#@%");
- 
-           CLOSE (FT);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END CE3906E;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- CE3906F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE SET PARAMETER AFFECTS THE CASE OF IDENTIFIERS,
- --     BUT NOT CHARACTER LITERALS.  CHECK THAT CHARACTER LITERALS ARE
- --     ENCLOSED IN APOSTROPHES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
- --     SUPPORT TEXT FILES.
- 
- -- HISTORY:
- --     JBG 12/30/82
- --     VKG 01/12/83
- --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 09/18/87  CORRECTED EXCEPTION HANDLING.
- 
- WITH TEXT_IO; USE TEXT_IO;
- WITH REPORT; USE REPORT;
- WITH CHECK_FILE;
- 
- PROCEDURE CE3906F IS
- 
-      TYPE ENUM IS (REDISH,GREENISH,YELLOWISH);
-      PACKAGE ENUM_IO IS NEW ENUMERATION_IO(ENUM);
-      PACKAGE CHAR_IO IS NEW ENUMERATION_IO(CHARACTER);
-      USE ENUM_IO; USE CHAR_IO;
-      INCOMPLETE : EXCEPTION;
-      FT : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CE3906F", "CHECK THE CASE OF ENUMERATION IO OUTPUT");
- 
-      BEGIN
-           CREATE (FT);
-       EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
-                                "CREATE FOR TEMP FILE WITH " &
-                                "OUT_FILE MODE - 1");
-                RAISE INCOMPLETE;
-      END;
- 
-      IF ENUM_IO.DEFAULT_WIDTH /= 0 THEN
-           FAILED ("INITIAL DEFAULT WIDTH INCORRECT");
-      END IF;
- 
-      IF CHAR_IO.DEFAULT_SETTING /= UPPER_CASE THEN
-           FAILED ("INITIAL DEFAULT_SETTING INCORRECT");
-      END IF;
- 
-      PUT (FT, 'A', SET => LOWER_CASE);
-      NEW_LINE (FT);
-      PUT (FT, 'a', SET => LOWER_CASE);
-      NEW_LINE (FT);
-      PUT (FT, REDISH, SET => LOWER_CASE);
-      NEW_LINE (FT);
-      ENUM_IO.DEFAULT_SETTING := LOWER_CASE;
-      CHAR_IO.PUT (FT, 'C');
-      NEW_LINE  (FT);
-      CHAR_IO.PUT (FT, 'b');
-      NEW_LINE (FT);
-      PUT (FT, REDISH);
-      NEW_LINE (FT);
-      PUT (FT, GREENISH, SET => LOWER_CASE);
-      NEW_LINE (FT);
-      PUT (FT, YELLOWISH, SET => UPPER_CASE);
- 
-      CHECK_FILE (FT, "'A'#'a'#redish#'C'#'b'#redish#greenish#"
-                    & "YELLOWISH#@%");
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END CE3906F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- CE3907A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK THAT PUT FOR ENUMERATION TYPES CAN BE APPLIED TO A STRING.
- -- CHECK THAT IT RAISES LAYOUT_ERROR WHEN THE ENUMERATION LITERAL TO BE
- -- PLACED IN THE STRING IS LONGER THAN THE STRING.
- 
- -- SPS 10/11/82
- -- JBG 2/22/84  CHANGED TO .ADA TEST 
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3907A IS
- BEGIN
- 
-      TEST ("CE3907A", "CHECK THAT ENUMERATION_IO PUT OPERATES ON " &
-                       "STRINGS CORRECTLY");
- 
-      DECLARE
-           TYPE COLOR IS (RED, BLUE, GREEN);
-           ST : STRING (1..4);
-           PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
-           USE COLOR_IO;
-           CRAYON : COLOR := GREEN;
-      BEGIN
-           PUT (ST, RED);
-           IF ST /= "RED " THEN
-                FAILED ("PUT TO STRING, LENGTH LESS THAN STRING " &
-                        "INCORRECT");
-           END IF;
- 
-           PUT (ST, BLUE);
-           IF ST /= "BLUE" THEN
-                FAILED ("PUT TO STRING, LENGTH EQUAL TO STRING " &
-                        "INCORRECT");
-           END IF;
- 
-           BEGIN
-                PUT (ST, CRAYON);
-                FAILED ("LAYOUT_ERROR NOT RAISED");
-           EXCEPTION
-                WHEN LAYOUT_ERROR =>
-                     NULL;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED");
-           END;
- 
-      END;
- 
-      RESULT;
- END CE3907A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- CE3908A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT GET FOR ENUMERATION TYPES CAN OPERATE ON STRINGS.
- --     CHECK THAT IT RAISES END_ERROR WHEN THE STRING IS NULL OR
- --     EMPTY.  CHECK THAT LAST CONTAINS THE INDEX VALUE OF THE LAST
- --     CHARACTER READ FROM THE STRING.
- 
- -- HISTORY:
- --     SPS 10/11/82
- --     VKG 01/06/83
- --     JBG 02/22/84  CHANGED TO .ADA TEST
- --     DWC 09/18/87  ADDED CASES WHICH CONTAIN TABS WITH AND WITHOUT
- --                   ENUMERATION LITERALS.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE CE3908A IS
- BEGIN
- 
-      TEST ("CE3908A", "CHECK THAT GET FOR ENUMERATION TYPES CAN " &
-                       "OPERATE ON STRINGS.  CHECK THAT IT RAISES " &
-                       "END_ERROR WHEN THE STRING IS NULL OR EMPTY.  " &
-                       "CHECK THAT LAST CONTAINS THE INDEX VALUE OF " &
-                       "THE LAST CHARACTER READ FROM THE STRING");
- 
-      DECLARE
-           TYPE FRUIT IS (APPLE, PEAR, ORANGE, STRAWBERRY);
-           DESSERT : FRUIT;
-           PACKAGE FRUIT_IO IS NEW ENUMERATION_IO (FRUIT);
-           USE FRUIT_IO;
-           L : POSITIVE;
-      BEGIN
-           GET ("APPLE  ", DESSERT, L);
-           IF DESSERT /= APPLE THEN
-                FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 1");
-           END IF;
- 
-           IF L /= IDENT_INT (5) THEN
-                FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 1");
-           END IF;
- 
-           GET ("APPLE", DESSERT, L);
-           IF DESSERT /= APPLE THEN
-                FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 2");
-           END IF;
- 
-           IF L /= IDENT_INT (5) THEN
-                FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 2");
-           END IF;
- 
-           BEGIN
-                GET (ASCII.HT & "APPLE", DESSERT, L);
-                IF DESSERT /= APPLE THEN
-                     FAILED ("ENUMERATION VALUE FROM STRING " &
-                             "INCORRECT - 3");
-                END IF;
-                IF L /= IDENT_INT(6) THEN
-                     FAILED ("LAST CONTAINS INCORRECT VALUE AFTER " &
-                             "GET - 3");
-                END IF;
-           EXCEPTION
-                WHEN END_ERROR =>
-                     FAILED ("GET DID NOT SKIP LEADING TABS");
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 3");
-           END;
- 
- -- NULL STRING LITERAL.
- 
-           BEGIN
-                GET ("", DESSERT, L);
-                FAILED ("END_ERROR NOT RAISED - 4");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= IDENT_INT(6) THEN
-                          FAILED ("LAST CONTAINS INCORRECT VALUE " &
-                                  "AFTER GET - 4");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 4");
-           END;
- 
-           BEGIN
-                GET (ASCII.HT & "", DESSERT, L);
-                FAILED ("END_ERROR NOT RAISED - 5");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= IDENT_INT(6) THEN
-                          FAILED ("LAST CONTAINS INCORRECT VALUE " &
-                                  "AFTER GET - 5");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 5");
-           END;
- 
- -- STRING LITERAL WITH BLANKS.
- 
-           BEGIN
-                GET("     ", DESSERT, L);
-                FAILED ("END ERROR NOT RAISED - 6");
-           EXCEPTION
-                WHEN END_ERROR =>
-                     IF L /= IDENT_INT(6) THEN
-                          FAILED ("LAST CONTAINS INCORRECT VALUE " &
-                                  "AFTER GET - 6");
-                     END IF;
-                WHEN OTHERS =>
-                     FAILED ("WRONG EXCEPTION RAISED - 6");
-           END;
- 
-      END;
- 
-      RESULT;
- END CE3908A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,507 ****
- -- CXA3001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the character classification functions defined in 
- --      package Ada.Characters.Handling produce correct results when provided 
- --      constant arguments from package Ada.Characters.Latin_1.
- --
- -- TEST DESCRIPTION:
- --      This test checks the character classification functions of package
- --      Ada.Characters.Handling.  In the evaluation of each function, loops
- --      are constructed to examine the function with as many values of type
- --      Character (Ada.Characters.Latin_1 constants) as possible in an 
- --      amount of code that is about equal to the amount of code required
- --      to examine the function with a few representative input values and
- --      endpoint values.
- --      The usage paradigm being demonstrated by this test is that of the
- --      functions being used to assign to boolean variables, as well as
- --      serving as boolean conditions.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      29 Apr 95   SAIC    Fixed subtest checking Is_Graphic function.
- --
- --!
- 
- with Ada.Characters.Latin_1;
- with Ada.Characters.Handling;
- with Report;
- 
- procedure CXA3001 is
- 
- begin
- 
-    Report.Test ("CXA3001", "Check that the character classification "      &
-                            "functions defined in package "                 &
-                            "Ada.Characters.Handling produce "              &
-                            "correct results when provided constant "       &
-                            "arguments from package Ada.Characters.Latin_1");
- 
-    Test_Block:
-    declare
- 
-       package AC  renames Ada.Characters;
-       package ACH renames Ada.Characters.Handling;
- 
-       TC_Boolean : Boolean := False;
- 
-    begin 
- 
-       -- Over the next six statements/blocks of code, evaluate functions 
-       -- Is_Control and Is_Graphic with control character and non-control 
-       -- character values.
- 
-       for i in Character'Pos(AC.Latin_1.NUL) .. 
-                Character'Pos(AC.Latin_1.US)  loop
-          if not ACH.Is_Control(Character'Val(i)) then
-             Report.Failed ("Incorrect result from function Is_Control - 1");
-          end if;
-          if ACH.Is_Graphic(Character'Val(i)) then
-             Report.Failed ("Incorrect result from function Is_Graphic - 1");
-          end if;
-       end loop;
- 
- 
-       for i in Character'Pos(AC.Latin_1.Space) ..
-                Character'Pos(AC.Latin_1.Tilde) loop
-          if not ACH.Is_Graphic(Character'Val(i)) then    
-             Report.Failed ("Incorrect result from function Is_Graphic - 2");
-          end if;
-          if ACH.Is_Control(Character'Val(i)) then
-             Report.Failed ("Incorrect result from function Is_Control - 2");
-          end if;
-       end loop;
- 
- 
-       for i in Character'Pos(AC.Latin_1.Reserved_128) .. 
-                Character'Pos(AC.Latin_1.APC)  loop
-          if not ACH.Is_Control(Character'Val(i)) then
-             Report.Failed ("Incorrect result from function Is_Control - 3");
-          end if;
-          TC_Boolean := ACH.Is_Graphic(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect result from function Is_Graphic - 3");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.No_Break_Space) ..
-                Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
-          TC_Boolean := ACH.Is_Control(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect result from function Is_Control - 4");
-             TC_Boolean := False;
-          end if;
-          if not ACH.Is_Graphic(Character'Val(i)) then
-             Report.Failed ("Incorrect result from function Is_Graphic - 4");
-          end if;
-       end loop;
- 
-       -- Check renamed constants.
- 
-       if not (ACH.Is_Control(AC.Latin_1.IS4) and
-               ACH.Is_Control(AC.Latin_1.IS3) and 
-               ACH.Is_Control(AC.Latin_1.IS2) and 
-               ACH.Is_Control(AC.Latin_1.IS1))       or
-          (ACH.Is_Control(AC.Latin_1.NBSP)           or
-           ACH.Is_Control(AC.Latin_1.Paragraph_Sign) or
-           ACH.Is_Control(AC.Latin_1.Minus_Sign)     or
-           ACH.Is_Control(AC.Latin_1.Ring_Above))
-       then
-          Report.Failed ("Incorrect result from function Is_Control - 5");
-       end if;
- 
-       if (ACH.Is_Graphic(AC.Latin_1.IS4)  or
-           ACH.Is_Graphic(AC.Latin_1.IS3)  or
-           ACH.Is_Graphic(AC.Latin_1.IS2)  or
-           ACH.Is_Graphic(AC.Latin_1.IS1)) or
-          not (ACH.Is_Graphic(AC.Latin_1.NBSP)           and
-               ACH.Is_Graphic(AC.Latin_1.Paragraph_Sign) and
-               ACH.Is_Graphic(AC.Latin_1.Minus_Sign)     and
-               ACH.Is_Graphic(AC.Latin_1.Ring_Above))
-       then
-          Report.Failed ("Incorrect result from function Is_Graphic - 5");
-       end if;
- 
- 
-       -- Evaluate function Is_Letter with letter/non-letter inputs.
-       
-       for i in Character'Pos('A') .. Character'Pos('Z') loop
-          if not ACH.Is_Letter(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Letter result - 1");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_A) .. 
-                Character'Pos(AC.Latin_1.LC_Z) loop
-          if not ACH.Is_Letter(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Letter result - 2");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.UC_A_Grave) .. 
-                Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop
-          if not ACH.Is_Letter(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Letter result - 3");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) .. 
-                Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop
-          if not ACH.Is_Letter(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Letter result - 4");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) .. 
-                Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
-          if not ACH.Is_Letter(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Letter result - 5");
-          end if;
-       end loop;
- 
-       -- Check for rejection of non-letters.
-       for i in Character'Pos(AC.Latin_1.NUL) .. 
-                Character'Pos(AC.Latin_1.Commercial_At) loop
-          if ACH.Is_Letter(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Letter result - 6");
-          end if;
-       end loop;
- 
- 
-       -- Evaluate function Is_Lower with lower case/non-lower case inputs.
- 
-       for i in Character'Pos(AC.Latin_1.LC_A) .. 
-                Character'Pos(AC.Latin_1.LC_Z) loop
-          if not ACH.Is_Lower(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Lower result - 1");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_A_Grave) .. 
-                Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop
-          if not ACH.Is_Lower(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Lower result - 2");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) .. 
-                Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
-          if not ACH.Is_Lower(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Lower result - 3");
-          end if;
-       end loop;
- 
-       if ACH.Is_Lower('A')                         or
-          ACH.Is_Lower(AC.Latin_1.UC_Icelandic_Eth) or
-          ACH.Is_Lower(AC.Latin_1.Number_Sign)      or
-          ACH.Is_Lower(AC.Latin_1.Cedilla)          or
-          ACH.Is_Lower(AC.Latin_1.SYN)              or
-          ACH.Is_Lower(AC.Latin_1.ESA) 
-       then
-          Report.Failed ("Incorrect Is_Lower result - 4");
-       end if;
- 
- 
-       -- Evaluate function Is_Upper with upper case/non-upper case inputs.
- 
-       for i in Character'Pos('A') .. Character'Pos('Z') loop
-          if not ACH.Is_Upper(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Upper result - 1");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.UC_A_Grave) .. 
-                Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop
-          if not ACH.Is_Upper(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Upper result - 2");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) .. 
-                Character'Pos(AC.Latin_1.UC_Icelandic_Thorn) loop
-          if not ACH.Is_Upper(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Upper result - 3");
-          end if;
-       end loop;
- 
-       if ACH.Is_Upper('8')                    or
-          ACH.Is_Upper(AC.Latin_1.LC_A_Ring  ) or
-          ACH.Is_Upper(AC.Latin_1.Dollar_Sign) or
-          ACH.Is_Upper(AC.Latin_1.Broken_Bar)  or
-          ACH.Is_Upper(AC.Latin_1.ETB)         or
-          ACH.Is_Upper(AC.Latin_1.VTS) 
-       then
-          Report.Failed ("Incorrect Is_Upper result - 4");
-       end if;
- 
- 
-       for i in Character'Pos('a') .. Character'Pos('z') loop
-          if ACH.Is_Upper(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Upper result - 5");
-          end if;
-       end loop;
- 
- 
-       -- Evaluate function Is_Basic with basic/non-basic inputs.
-       -- (Note: Basic letters are those without diacritical marks.)
- 
-       for i in Character'Pos('A') .. Character'Pos('Z') loop
-          if not ACH.Is_Basic(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Basic result - 1");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_A) .. 
-                Character'Pos(AC.Latin_1.LC_Z) loop
-          if not ACH.Is_Basic(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Basic result - 2");
-          end if;
-       end loop;
- 
- 
-       if not (ACH.Is_Basic(AC.Latin_1.UC_AE_Diphthong)     and  
-               ACH.Is_Basic(AC.Latin_1.LC_AE_Diphthong)     and
-               ACH.Is_Basic(AC.Latin_1.LC_German_Sharp_S)   and
-               ACH.Is_Basic(AC.Latin_1.LC_Icelandic_Eth)    and
-               ACH.Is_Basic(AC.Latin_1.LC_Icelandic_Thorn)  and
-               ACH.Is_Basic(AC.Latin_1.UC_Icelandic_Eth)    and
-               ACH.Is_Basic(AC.Latin_1.UC_Icelandic_Thorn))
-       then
-          Report.Failed ("Incorrect Is_Basic result - 3");
-       end if;
- 
-       -- Check for rejection of non-basics.
-       if ACH.Is_Basic(AC.Latin_1.UC_A_Tilde) or
-          ACH.Is_Basic(AC.Latin_1.LC_A_Grave) or
-          ACH.Is_Basic(AC.Latin_1.Ampersand)  or
-          ACH.Is_Basic(AC.Latin_1.Yen_Sign)   or
-          ACH.Is_Basic(AC.Latin_1.NAK)        or
-          ACH.Is_Basic(AC.Latin_1.SS2) 
-       then
-          Report.Failed ("Incorrect Is_Basic result - 4");
-       end if;
- 
- 
- 
-       for i in Character'Pos(AC.Latin_1.NUL) .. 
-                Character'Pos(AC.Latin_1.Commercial_At) loop
-          if ACH.Is_Basic(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Basic result - 5");
-          end if;
-       end loop;
- 
- 
-       -- Evaluate functions Is_Digit and Is_Decimal_Digit (a rename of
-       -- Is_Digit) with decimal digit/non-digit inputs.
- 
- 
-       if not (ACH.Is_Digit('0')          and
-               ACH.Is_Decimal_Digit('9')) or
-          ACH.Is_Digit ('a')              or     -- Hex digits.
-          ACH.Is_Decimal_Digit ('f')      or
-          ACH.Is_Decimal_Digit ('A')      or
-          ACH.Is_Digit ('F')
-       then
-          Report.Failed ("Incorrect Is_Digit/Is_Decimal_Digit result - 1");
-       end if;
- 
-       if ACH.Is_Digit         (AC.Latin_1.Full_Stop)         or
-          ACH.Is_Decimal_Digit (AC.Latin_1.Dollar_Sign)       or
-          ACH.Is_Digit         (AC.Latin_1.Number_Sign)       or
-          ACH.Is_Decimal_Digit (AC.Latin_1.Left_Parenthesis)  or
-          ACH.Is_Digit         (AC.Latin_1.Right_Parenthesis) 
-       then
-          Report.Failed ("Incorrect Is_Digit/Is_Decimal_Digit result - 2");
-       end if;
- 
- 
-       -- Evaluate functions Is_Hexadecimal_Digit with hexadecimal digit and 
-       -- non-hexadecimal digit inputs.
- 
-       for i in Character'Pos('0') .. Character'Pos('9') loop
-          if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 1");
-          end if;
-       end loop;
- 
-       for i in Character'Pos('A') .. Character'Pos('F') loop
-          if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 2");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_A) .. 
-                Character'Pos(AC.Latin_1.LC_F) loop
-          if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 3");
-          end if;
-       end loop;
- 
- 
-       if ACH.Is_Hexadecimal_Digit (AC.Latin_1.Minus_Sign)        or
-          ACH.Is_Hexadecimal_Digit (AC.Latin_1.Hyphen)            or
-          ACH.Is_Hexadecimal_Digit (AC.Latin_1.LC_G)              or
-          ACH.Is_Hexadecimal_Digit (AC.Latin_1.LC_Z)              or
-          ACH.Is_Hexadecimal_Digit ('G')                          or
-          ACH.Is_Hexadecimal_Digit (AC.Latin_1.Cent_Sign)         or
-          ACH.Is_Hexadecimal_Digit (AC.Latin_1.Pound_Sign)
-       then
-          Report.Failed ("Incorrect Is_HexaDecimal_Digit result - 4");
-       end if;
- 
- 
-       -- Evaluate functions Is_Alphanumeric and Is_Special with 
-       -- letters, digits, and non-alphanumeric inputs.
- 
-       for i in Character'Pos(AC.Latin_1.NUL) .. 
-                Character'Pos(AC.Latin_1.US)  loop
-          if ACH.Is_Alphanumeric(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 1");
-          end if;
-          TC_Boolean := ACH.Is_Special(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Special result - 1");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.Reserved_128) .. 
-                Character'Pos(AC.Latin_1.APC)  loop
-          TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 2");
-             TC_Boolean := False;
-          end if;
-          if ACH.Is_Special(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Special result - 2");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.Space) ..
-                Character'Pos(AC.Latin_1.Solidus) loop
-          TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 3");
-             TC_Boolean := False;
-          end if;
-          if not ACH.Is_Special(Character'Val(i)) then  
-             Report.Failed ("Incorrect Is_Special result - 3");
-          end if;
-       end loop;
- 
-       for i in Character'Pos('A') .. Character'Pos('Z') loop
-          if not ACH.Is_Alphanumeric(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 4");
-          end if;
-          TC_Boolean := ACH.Is_Special(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Special result - 4");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
-       for i in Character'Pos('0') .. Character'Pos('9') loop
-          if not ACH.Is_Alphanumeric(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 5");
-          end if;
-          TC_Boolean := ACH.Is_Special(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Special result - 5");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_A) ..
-                Character'Pos(AC.Latin_1.LC_Z) loop
-          if not ACH.Is_Alphanumeric(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 6");
-          end if;
-          TC_Boolean := ACH.Is_Special(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Special result - 6");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.No_Break_Space) ..
-                Character'Pos(AC.Latin_1.Inverted_Question) loop
-          TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 7");
-             TC_Boolean := False;
-          end if;
-          if not ACH.Is_Special(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Special result - 7");
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.UC_A_Grave) ..
-                Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop
-          if not ACH.Is_Alphanumeric(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 8");
-          end if;
-          TC_Boolean := ACH.Is_Special(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Special result - 8");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) ..
-                Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop
-          if not ACH.Is_Alphanumeric(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 9");
-          end if;
-          TC_Boolean := ACH.Is_Special(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Special result - 9");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
-       for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) ..
-                Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
-          if not ACH.Is_Alphanumeric(Character'Val(i)) then
-             Report.Failed ("Incorrect Is_Alphanumeric result - 10");
-          end if;
-          TC_Boolean := ACH.Is_Special(Character'Val(i)); 
-          if TC_Boolean then
-             Report.Failed ("Incorrect Is_Special result - 10");
-             TC_Boolean := False;
-          end if;
-       end loop;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised during processing");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA3001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,318 ****
- -- CXA3002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the conversion functions for Characters and Strings
- --      defined in package Ada.Characters.Handling provide correct results
- --      when given character/string input parameters.
- --
- -- TEST DESCRIPTION:
- --      This test checks the output of the To_Lower, To_Upper, and
- --      To_Basic functions for both Characters and Strings.  Each function
- --      is called with input parameters that are within the appropriate
- --      range of values, and also with values outside the specified 
- --      range (i.e., lower case 'a' to To_Lower).  The functions are also
- --      used in combination with one another, with the result of one function
- --      providing the actual input parameter value to another.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      22 Dec 94   SAIC    Corrected evaluations of Functions In Combination.
- --
- --!
- 
- with Ada.Characters.Latin_1;
- with Ada.Characters.Handling;
- with Report;
- 
- procedure CXA3002 is
- 
-    package AC  renames Ada.Characters;
-    package ACH renames Ada.Characters.Handling;
- 
- begin
- 
-    Report.Test ("CXA3002", "Check that the conversion functions for "   &
-                            "Characters and Strings defined in package " &
-                            "Ada.Characters.Handling provide correct "   &
-                            "results when given character/string input " &
-                            "parameters");
- 
- 
-    Character_Block:
-    declare
-       Offset : constant Integer := Character'Pos('a') - Character'Pos('A');
-    begin 
- 
-       -- Function To_Lower for Characters
- 
-       if ACH.To_Lower('A') /= 'a' or  ACH.To_Lower('Z') /= 'z' then
-          Report.Failed ("Incorrect operation of function To_Lower - 1");
-       end if;
- 
- 
-       for i in Character'Pos('A') .. Character'Pos('Z') loop
-          if ACH.To_Lower(Character'Val(i)) /= Character'Val(i + Offset) then
-             Report.Failed ("Incorrect operation of function To_Lower - 2");
-          end if;
-       end loop;
- 
- 
-       if (ACH.To_Lower(AC.Latin_1.UC_A_Grave)         /= 
-           AC.Latin_1.LC_A_Grave)                     or
-          (ACH.To_Lower(AC.Latin_1.UC_Icelandic_Thorn) /=
-           AC.Latin_1.LC_Icelandic_Thorn)
-       then
-          Report.Failed ("Incorrect operation of function To_Lower - 3");
-       end if;
- 
- 
-       if ACH.To_Lower('c')                 /= 'c'                 or  
-          ACH.To_Lower('w')                 /= 'w'                 or
-          ACH.To_Lower(AC.Latin_1.CR)       /= AC.Latin_1.CR       or
-          ACH.To_Lower(AC.Latin_1.LF)       /= AC.Latin_1.LF       or
-          ACH.To_Lower(AC.Latin_1.Comma)    /= AC.Latin_1.Comma    or
-          ACH.To_Lower(AC.Latin_1.Question) /= AC.Latin_1.Question or
-          ACH.To_Lower('0')                 /= '0'                 or
-          ACH.To_Lower('9')                 /= '9'                
-       then
-          Report.Failed ("Incorrect operation of function To_Lower - 4");
-       end if;
- 
-     
-       --- Function To_Upper for Characters
-       
- 
-       if not (ACH.To_Upper('b') = 'B') and (ACH.To_Upper('y') = 'Y') then
-          Report.Failed ("Incorrect operation of function To_Upper - 1");
-       end if;
- 
- 
-       for i in Character'Pos(AC.Latin_1.LC_A) .. 
-                Character'Pos(AC.Latin_1.LC_Z) loop
-          if ACH.To_Upper(Character'Val(i)) /= Character'Val(i - Offset) then
-             Report.Failed ("Incorrect operation of function To_Upper - 2");
-          end if;
-       end loop;
- 
- 
-       if (ACH.To_Upper(AC.Latin_1.LC_U_Diaeresis) /= 
-           AC.Latin_1.UC_U_Diaeresis)                 or
-          (ACH.To_Upper(AC.Latin_1.LC_A_Ring)      /=
-           AC.Latin_1.UC_A_Ring) 
-       then
-          Report.Failed ("Incorrect operation of function To_Upper - 3");
-       end if;
-      
- 
-       if not (ACH.To_Upper('F') = 'F'                       and 
-               ACH.To_Upper('U') = 'U'                       and
-               ACH.To_Upper(AC.Latin_1.LC_German_Sharp_S) =
-                 AC.Latin_1.LC_German_Sharp_S                and
-               ACH.To_Upper(AC.Latin_1.LC_Y_Diaeresis) =
-                 AC.Latin_1.LC_Y_Diaeresis) 
-       then
-          Report.Failed ("Incorrect operation of function To_Upper - 4");
-       end if;
- 
- 
-       --- Function To_Basic for Characters
-       
- 
-       if ACH.To_Basic(AC.Latin_1.LC_A_Circumflex) /=       
-          ACH.To_Basic(AC.Latin_1.LC_A_Tilde)         or       
-          ACH.To_Basic(AC.Latin_1.LC_E_Grave)      /=       
-          ACH.To_Basic(AC.Latin_1.LC_E_Acute)         or      
-          ACH.To_Basic(AC.Latin_1.LC_I_Circumflex) /=       
-          ACH.To_Basic(AC.Latin_1.LC_I_Diaeresis)     or          
-          ACH.To_Basic(AC.Latin_1.UC_O_Tilde)      /=       
-          ACH.To_Basic(AC.Latin_1.UC_O_Acute)         or      
-          ACH.To_Basic(AC.Latin_1.UC_U_Grave)      /=       
-          ACH.To_Basic(AC.Latin_1.UC_U_Acute)         or      
-          ACH.To_Basic(AC.Latin_1.LC_Y_Acute)      /=       
-          ACH.To_Basic(AC.Latin_1.LC_Y_Diaeresis)
-       then
-          Report.Failed ("Incorrect operation of function To_Basic - 1");
-       end if;
- 
- 
-       if ACH.To_Basic('Y') /= 'Y'                   or 
-          ACH.To_Basic(AC.Latin_1.LC_E_Acute) /= 'e' or
-          ACH.To_Basic('6') /= '6'                   or
-          ACH.To_Basic(AC.Latin_1.LC_R) /= 'r' 
-       then
-          Report.Failed ("Incorrect operation of function To_Basic - 2");
-       end if;
-  
- 
-       -- Using Functions (for Characters) in Combination
- 
- 
-       if (ACH.To_Upper(ACH.To_Lower('A')) /= 'A' ) or
-          (ACH.To_Upper(ACH.To_Lower(AC.Latin_1.UC_A_Acute)) /=
-           AC.Latin_1.UC_A_Acute )
-       then 
-          Report.Failed("Incorrect operation of functions in combination - 1");
-       end if;
- 
- 
-       if ACH.To_Basic(ACH.To_Lower(ACH.To_Upper(AC.Latin_1.LC_U_Grave))) /= 
-          'u'
-       then
-          Report.Failed("Incorrect operation of functions in combination - 2");
-       end if;
-        
- 
-       if ACH.To_Lower (ACH.To_Basic 
-                          (ACH.To_Upper(AC.Latin_1.LC_O_Diaeresis))) /= 'o'
-       then
-          Report.Failed("Incorrect operation of functions in combination - 3");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Character_Block");
-    end Character_Block;
- 
- 
-    String_Block:
-    declare
- 
-       LC_String : constant String := "az" & 
-                                       AC.Latin_1.LC_A_Grave &
-                                       AC.Latin_1.LC_C_Cedilla;
- 
-       UC_String : constant String := "AZ" & 
-                                       AC.Latin_1.UC_A_Grave &
-                                       AC.Latin_1.UC_C_Cedilla;
- 
-       LC_Basic_String    : constant String := "aei" & 'o' & 'u';
- 
-       LC_NonBasic_String : constant String := AC.Latin_1.LC_A_Diaeresis  &
-                                               AC.Latin_1.LC_E_Circumflex &
-                                               AC.Latin_1.LC_I_Acute      &
-                                               AC.Latin_1.LC_O_Tilde      &
-                                               AC.Latin_1.LC_U_Grave;
- 
-       UC_Basic_String    : constant String := "AEIOU";
- 
-       UC_NonBasic_String : constant String := AC.Latin_1.UC_A_Tilde      &
-                                               AC.Latin_1.UC_E_Acute      &
-                                               AC.Latin_1.UC_I_Grave      &
-                                               AC.Latin_1.UC_O_Diaeresis  &
-                                               AC.Latin_1.UC_U_Circumflex;
- 
-       LC_Special_String  : constant String := "ab"                         &
-                                               AC.Latin_1.LC_German_Sharp_S &
-                                               AC.Latin_1.LC_Y_Diaeresis;
- 
-       UC_Special_String  : constant String := "AB"                         &
-                                               AC.Latin_1.LC_German_Sharp_S &
-                                               AC.Latin_1.LC_Y_Diaeresis;
- 
-    begin
- 
-       -- Function To_Lower for Strings
-       
- 
-       if ACH.To_Lower (UC_String) /= LC_String  or
-          ACH.To_Lower (LC_String) /= LC_String  
-       then
-          Report.Failed ("Incorrect result from To_Lower for strings - 1");
-       end if;
- 
- 
-       if ACH.To_Lower (UC_Basic_String) /= LC_Basic_String then
-          Report.Failed ("Incorrect result from To_Lower for strings - 2");
-       end if;
- 
- 
-       -- Function To_Upper for Strings
-       
- 
-       if not (ACH.To_Upper (LC_String) = UC_String) then
-          Report.Failed ("Incorrect result from To_Upper for strings - 1");
-       end if;
- 
- 
-       if ACH.To_Upper (LC_Basic_String) /= UC_Basic_String or
-          ACH.To_Upper (UC_String)       /= UC_String
-       then
-          Report.Failed ("Incorrect result from To_Upper for strings - 2");
-       end if;
- 
- 
-       if ACH.To_Upper (LC_Special_String) /= UC_Special_String then
-          Report.Failed ("Incorrect result from To_Upper for strings - 3");
-       end if;
-       
- 
- 
-       -- Function To_Basic for Strings
-       
- 
-       if (ACH.To_Basic (LC_String) /= "azac") or
-          (ACH.To_Basic (UC_String) /= "AZAC")
-       then
-          Report.Failed ("Incorrect result from To_Basic for Strings - 1");
-       end if;
- 
- 
-       if ACH.To_Basic (LC_NonBasic_String) /= LC_Basic_String then
-          Report.Failed ("Incorrect result from To_Basic for Strings - 2");
-       end if;
- 
- 
-       if ACH.To_Basic (UC_NonBasic_String) /= UC_Basic_String then
-          Report.Failed ("Incorrect result from To_Basic for Strings - 3");
-       end if;
- 
- 
-       -- Using Functions (for Strings) in Combination
- 
- 
-       if ACH.To_Upper(ACH.To_Lower(UC_Basic_String)) /= UC_Basic_String or
-          ACH.To_Lower(ACH.To_Upper(LC_Basic_String)) /= LC_Basic_String
-       then
-          Report.Failed ("Incorrect operation of functions in combination - 4");
-       end if;
- 
- 
-       if (ACH.To_Basic(ACH.To_Lower(UC_NonBasic_String)) /= LC_Basic_String) or
-          (ACH.To_Basic(ACH.To_Upper(LC_NonBasic_String)) /= UC_Basic_String)
-       then
-          Report.Failed ("Incorrect operation of functions in combination - 5");
-       end if;
-         
- 
-    exception
-       when others => Report.Failed ("Exception raised in String_Block");
-    end String_Block;
- 
- 
-    Report.Result;
- 
- end CXA3002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,243 ****
- -- CXA3003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions defined in package Ada.Characters.Handling
- --      for use in classifying and converting characters between the ISO 646
- --      and type Character sets produce the correct results with both
- --      Character and String input values.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to exercise the classification and conversion
- --      functions (between Character and ISO_646 types) found in package 
- --      Ada.Characters.Handling.  Two subprograms are defined, a procedure for
- --      characters, a function for strings, that will utilize these functions
- --      to validate and change characters in variables.  In the procedure, if
- --      a character argument is found to be outside the subtype ISO_646, this 
- --      character is evaluated to determine whether it is also a letter.  
- --      If it is a letter, the character is converted to a basic character and 
- --      returned.  If it is not a letter, the character is exchanged with an 
- --      asterisk.  In the case of the function subprogram designed for strings, 
- --      if a character component of a string argument is outside the subtype
- --      ISO_646, that character is substituted with an asterisk.
- --      
- --      Arguments for the defined subprograms consist of ISO_646 characters,
- --      non-ISO_646 characters, strings with only ISO_646 characters, and
- --      strings with non-ISO_646 characters. The character and string values 
- --      are then validated to determine that the expected results were 
- --      obtained.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      29 Apr 95   SAIC    Modified identifier string lengths.
- --      31 Oct 95   SAIC    Update and repair for ACVC 2.0.1.
- --
- --!
- 
- with Ada.Characters.Latin_1;
- with Ada.Characters.Handling;
- with Report;
- 
- procedure CXA3003 is
- 
- begin
- 
-    Report.Test ("CXA3003", "Check that the functions defined in package " &
-                            "Ada.Characters.Handling for use in "          &
-                            "classifying and converting characters "       &
-                            "between the ISO 646 and type Character sets " &
-                            "produce the correct results with both "       &
-                            "Character and String input values" );
- 
-    Test_Block:
-    declare
- 
-       -- ISO_646 Characters
- 
-       Char_1,
-       TC_Char_1  : Character := Ada.Characters.Latin_1.NUL;    -- Control Char
-       Char_2,
-       TC_Char_2  : Character := Ada.Characters.Latin_1.Colon;  -- Graphic Char
-       Char_3,
-       TC_Char_3  : Character := '4';
-       Char_4,
-       TC_Char_4  : Character := 'Z';
-       Char_5,
-       TC_Char_5  : Character := Ada.Characters.Latin_1.LC_W;   -- w
- 
-       New_ISO_646_Char : Character := '*';
- 
- 
-       -- Non-ISO_646 Characters
- 
-       Char_Array : array (6..10) of Character := 
-                                        (Ada.Characters.Latin_1.SSA,
-                                         Ada.Characters.Latin_1.Cent_Sign,
-                                         Ada.Characters.Latin_1.Cedilla,
-                                         Ada.Characters.Latin_1.UC_A_Ring,
-                                         Ada.Characters.Latin_1.LC_A_Ring);
- 
-       TC_Char : constant Character := '*';
- 
-       -- ISO_646 Strings
- 
-       Str_1, 
-       TC_Str_1 : String (1..5) := "ABCDE";
- 
-       Str_2,
-       TC_Str_2 : String (1..5) := "#$%^&";
- 
- 
-       -- Non-ISO_646 Strings
- 
-       Str_3    : String (1..8) := "$123.45" & 
-                                   Ada.Characters.Latin_1.Cent_Sign;
-       TC_Str_3 : String (1..8) := "$123.45*";
- 
-       Str_4    : String (1..7) := "abc" & 
-                                   Ada.Characters.Latin_1.Cedilla &
-                                   "efg";
-       TC_Str_4 : String (1..7) := "abc*efg";
- 
-       Str_5    : String (1..3) := Ada.Characters.Latin_1.LC_E_Grave & 
-                                   Ada.Characters.Latin_1.LC_T       &
-                                   Ada.Characters.Latin_1.LC_E_Acute;
-       TC_Str_5 : String (1..3) := "*t*";
- 
-       ---
- 
-       procedure Validate_Character (Char : in out Character) is
-          -- If parameter Char is an ISO_646 character, Char will be returned,
-          -- otherwise the following constant will be returned.
-          Star : constant Ada.Characters.Handling.ISO_646 := 
-            Ada.Characters.Latin_1.Asterisk;                    
-       begin
-          if Ada.Characters.Handling.Is_ISO_646(Char) then
-             -- Check that the Is_ISO_646 function provide a correct result.
-             if Character'Pos(Char) > 127 then
-                Report.Failed("Is_ISO_646 returns a false positive result");
-             end if;
-          else
-             if Character'Pos(Char) < 128 then
-                Report.Failed("Is_ISO_646 returns a false negative result");
-             end if;
-          end if;
-          -- Cross-check Is_ISO_646 with To_ISO_646.  '*' will be returned
-          -- if Char is not in the ISO_646 set.
-          Char := Ada.Characters.Handling.To_ISO_646(Char, Star);
-       exception
-          when others => Report.Failed ("Exception in Validate_Character");
-       end Validate_Character;
- 
-       ---
- 
-       function Validate_String (Str : String) return String is
-          New_ISO_646_Char : constant Ada.Characters.Handling.ISO_646 := 
-            Ada.Characters.Latin_1.Asterisk;                    
-       begin
-          -- Checking that the string contains non-ISO_646 characters at this
-          -- point is not strictly necessary, since the function To_ISO_646
-          -- will perform that check as part of its processing, and would 
-          -- return the original string if no modification were necessary.  
-          -- However, this format allows for the testing of both functions.
- 
-          if not Ada.Characters.Handling.Is_ISO_646(Str) then
-             return Ada.Characters.Handling.To_ISO_646
-                      (Item => Str, Substitute => New_ISO_646_Char);
-          else
-             return Str;
-          end if;
-       exception
-          when others => Report.Failed ("Exception in Validate_String");
-                         return Str;
-       end Validate_String;
- 
- 
-    begin
- 
-       -- Check each character in turn, and if the character does not belong
-       -- to the ISO_646 subset of type Character, replace it with an
-       -- asterisk.  If the character is a member of the subset, the character
-       -- should be returned unchanged.
- 
-       Validate_Character (Char_1);
-       Validate_Character (Char_2);
-       Validate_Character (Char_3);
-       Validate_Character (Char_4);
-       Validate_Character (Char_5);
- 
-       if Char_1 /= TC_Char_1 or Char_2 /= TC_Char_2 or
-          Char_3 /= TC_Char_3 or Char_4 /= TC_Char_4 or
-          Char_5 /= TC_Char_5
-       then
-          Report.Failed ("Incorrect ISO_646 character substitution");
-       end if;
- 
-       -- Non-ISO_646 characters
- 
-       for i in 6..10 loop
-          Validate_Character (Char_Array(i));
-       end loop;
- 
-       for i in 6..10 loop
-          if Char_Array(i) /= TC_Char then
-             Report.Failed ("Character position " & Integer'Image(i) &
-                            " not replaced correctly");
-          end if;
-       end loop;
- 
- 
- 
-       -- Check each string, and if the string contains characters that do not
-       -- belong to the ISO_646 subset of type Character, replace that character
-       -- in the string with an asterisk.  If the string is comprised of only
-       -- ISO_646 characters, the string should be returned unchanged.
- 
- 
-       Str_1 := Validate_String (Str_1);
-       Str_2 := Validate_String (Str_2);
-       Str_3 := Validate_String (Str_3);
-       Str_4 := Validate_String (Str_4);
-       Str_5 := Validate_String (Str_5);
- 
- 
-       if Str_1 /= TC_Str_1 or
-          Str_2 /= TC_Str_2 or
-          Str_3 /= TC_Str_3 or
-          Str_4 /= TC_Str_4 or
-          Str_5 /= TC_Str_5
-       then
-          Report.Failed ("Incorrect ISO_646 character substitution in string");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA3003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa3004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa3004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,235 ****
- -- CXA3004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions defined in package Ada.Characters.Handling
- --      for classification of and conversion between Wide_Character and
- --      Character values produce correct results when given the appropriate
- --      Character and String inputs.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates the functions defined in package 
- --      Ada.Characters.Handling which provide for the classification of and 
- --      conversion between Wide_Characters and Characters, in character 
- --      variables and strings.
- --      Each of the functions is provided with input values that are of the 
- --      appropriate range. The results of the function processing are 
- --      subsequently evaluated.
- --      
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all implementations using the Latin_1 set as the
- --      definition of Character.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      27 Dec 94   SAIC    Corrected variable names.
- --
- --!
- 
- with Report;
- with Ada.Characters.Handling;
- 
- procedure CXA3004 is
- begin
- 
-    Report.Test ("CXA3004", "Check that the functions defined in package "  &
-                            "Ada.Characters.Handling for classification "   &
-                            "of and conversion between Wide_Character and " &
-                            "Character values produce correct results "     &
-                            "when given the appropriate Character "         &
-                            "and String inputs");
- 
-    Test_Block:
-    declare
- 
-       package ACH renames Ada.Characters.Handling;
- 
-       Char_End      : Integer        := 255;
-       WC_Start      : Integer        := 256;
-       Sub_Char      : Character      := '*';
- 
-       Blank         : Character      := ' ';
-       First_Char    : Character      := Character'First;
-       Last_Char     : Character      := Character'Last;
-       F_Char        : Character      := 'F';
- 
- 
-       First_Wide_Char        : Wide_Character := Wide_Character'First;
-       Last_Non_Wide_Char     : Wide_Character := Wide_Character'Val(Char_End);
-       First_Unique_Wide_Char : Wide_Character := Wide_Character'Val(WC_Start);
-       Last_Wide_Char         : Wide_Character := Wide_Character'Last;
- 
-       A_String      : String (1..3)      := First_Char & 'X' & Last_Char;
-       A_Wide_String : Wide_String (1..3) := First_Wide_Char            & 
-                                             ACH.To_Wide_Character('X') & 
-                                             ACH.To_Wide_Character(Last_Char);
- 
-       Unique_Wide_String : Wide_String (1..2) := First_Unique_Wide_Char &
-                                                  Last_Wide_Char;
- 
-       Mixed_Wide_String  : Wide_String (1..6) := ACH.To_Wide_Character('A') & 
-                                                  First_Wide_Char            &
-                                                  Last_Non_Wide_Char         & 
-                                                  First_Unique_Wide_Char     & 
-                                                  Last_Wide_Char             &
-                                                  ACH.To_Wide_Character('Z');
- 
- 
-       Basic_Char         : Character          := 'A';
-       Basic_Wide_Char    : Wide_Character     := 'A';
-       Basic_String       : String (1..6)      := "ABCXYZ";
-       Basic_Wide_String  : Wide_String (1..6) := "ABCXYZ";
- 
-    begin
- 
- 
-       -- Function Is_Character
- 
- 
-       if not ACH.Is_Character(First_Wide_Char) then
-          Report.Failed ("Incorrect result from Is_Character - 1");
-       end if;
- 
- 
-       if ACH.Is_Character(First_Unique_Wide_Char) or        
-          ACH.Is_Character(Last_Wide_Char)
-       then
-          Report.Failed ("Incorrect result from Is_Character - 2");
-       end if;
-        
- 
-       -- Function Is_String
- 
- 
-       if not ACH.Is_String(A_Wide_String) then
-          Report.Failed ("Incorrect result from Is_String - 1");
-       end if;
- 
- 
-       if ACH.Is_String(Unique_Wide_String) or
-          ACH.Is_String(Mixed_Wide_String)
-       then
-          Report.Failed ("Incorrect result from Is_String - 2");
-       end if;
-       
- 
-       -- Function To_Character
- 
- 
-       -- Use default substitution character in call of To_Character.
- 
-       if ACH.To_Character(First_Wide_Char)    /= First_Char or 
-          ACH.To_Character(Last_Non_Wide_Char) /= Last_Char
-       then
-          Report.Failed ("Incorrect result from To_Character - 1");
-       end if;
- 
- 
-       -- Provide a substitution character for use with To_Character.
- 
-       if ACH.To_Character(First_Unique_Wide_Char, Blank)    /= Blank    or
-          ACH.To_Character(First_Unique_Wide_Char, Sub_Char) /= Sub_Char or
-          ACH.To_Character(Last_Wide_Char)                   /= ' '  -- default
-       then
-          Report.Failed ("Incorrect result from To_Character - 2");
-       end if;
- 
- 
-       -- Function To_String
- 
- 
-       if ACH.To_String(A_Wide_String) /=  A_String then
-          Report.Failed ("Incorrect result from To_String - 1");
-       end if;
- 
-      
-       if ACH.To_String(Unique_Wide_String, Sub_Char) /= "**" then
-          Report.Failed ("Incorrect result from To_String - 2");
-       end if;
- 
- 
- 
-       if ACH.To_String(Mixed_Wide_String,  Sub_Char) /= 
-          ('A' & First_Char & Last_Char & "**" & 'Z')   or
-          ACH.To_String(Mixed_Wide_String,  Sub_Char) /= 
-          (ACH.To_Character(Mixed_Wide_String(1), Sub_Char) &
-           ACH.To_Character(Mixed_Wide_String(2), Sub_Char) &
-           ACH.To_Character(Mixed_Wide_String(3), Sub_Char) &
-           ACH.To_Character(Mixed_Wide_String(4), Sub_Char) &
-           ACH.To_Character(Mixed_Wide_String(5), Sub_Char) &
-           ACH.To_Character(Mixed_Wide_String(6), Sub_Char)) 
-       then
-          Report.Failed ("Incorrect result from To_String - 3");
-       end if;
- 
- 
-       -- Function To_Wide_Character
- 
- 
-       if ACH.To_Wide_Character(Basic_Char) /= Basic_Wide_Char then
-          Report.Failed ("Incorrect result from To_Wide_Character");
-       end if;
- 
-     
-       -- Function To_Wide_String
- 
- 
-       if not (ACH.To_Wide_String(Basic_String) = Basic_Wide_String) then
-          Report.Failed ("Incorrect result from To_Wide_String");
-       end if;
- 
- 
-       -- Functions Used In Combination
- 
-       if not ACH.Is_Character (ACH.To_Wide_Character (
-         ACH.To_Character(First_Wide_Char))) 
-       then
-          Report.Failed ("Incorrect result from functions in combination - 1");
-       end if;
- 
- 
-       if not ACH.Is_String(ACH.To_Wide_String(ACH.To_String(A_Wide_String)))
-       then
-          Report.Failed ("Incorrect result from functions in combination - 2");
-       end if;
- 
- 
-       if ACH.To_String(ACH.To_Wide_Character('A')    &
-                        ACH.To_Wide_Character(F_Char) &
-                        ACH.To_Wide_Character('Z'))     /=  "AFZ"
-       then
-          Report.Failed ("Incorrect result from functions in combination - 3");
-       end if;
-          
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA3004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,230 ****
- -- CXA4001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the types, operations, and other entities defined within
- --      the package Ada.Strings.Maps are available and/or produce correct
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates the availability and function of the types and
- --      operations defined in package Ada.Strings.Maps.  It demonstrates the
- --      use of these types and functions as they would be used in common
- --      programming practice.
- --      Character set creation, assignment, and comparison are evaluated
- --      in this test.  Each of the functions provided in package
- --      Ada.Strings.Maps is utilized in creating or manipulating set objects,
- --      and the function results are evaluated for correctness.
- --      Character sequences are examined using the functions provided for 
- --      manipulating objects of this type.  Likewise, character maps are
- --      created, and their contents evaluated.  Exception raising conditions
- --      from the function To_Mapping are also created.
- --      Note: Throughout this test, the set logical operators are printed in
- --      capital letters to enhance their visibility.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Strings.Maps;
- with Report;
- 
- procedure CXA4001 is
- 
-    use Ada.Strings;
-    use type Maps.Character_Set;
-   
- begin
- 
-    Report.Test ("CXA4001", "Check that the types, operations, and other "   &
-                            "entities defined within the package "           &
-                            "Ada.Strings.Maps are available and/or produce " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       MidPoint_Letter  : constant := 13;
-       Last_Letter      : constant := 26;
- 
-       Vowels           : constant Maps.Character_Sequence := "aeiou";
-       Quasi_Vowel      : constant Character := 'y';
- 
-       Alphabet         :  Maps.Character_Sequence (1..Last_Letter);
-       Half_Alphabet    :  Maps.Character_Sequence (1..MidPoint_Letter);
-       Inverse_Alphabet :  Maps.Character_Sequence (1..Last_Letter);
- 
-       Alphabet_Set,
-       Consonant_Set,
-       Vowel_Set,
-       Full_Vowel_Set,
-       First_Half_Set,
-       Second_Half_Set  : Maps.Character_Set;
- 
-    begin
- 
-       -- Load the alphabet string for use in creating sets.
- 
- 
-       for i in 0..12 loop
-          Half_Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
-       end loop;
- 
-       for i in 0..25 loop
-          Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
-       end loop;
- 
- 
-       -- Initialize a series of Character_Set objects.
-       
-       Alphabet_Set    := Maps.To_Set(Alphabet);
-       Vowel_Set       := Maps.To_Set(Vowels);
-       Full_Vowel_Set  := Vowel_Set   OR  Maps.To_Set(Quasi_Vowel);
-       Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
- 
-       First_Half_Set  := Maps.To_Set(Half_Alphabet);
-       Second_Half_Set := Alphabet_Set  XOR  First_Half_Set;
- 
- 
-       -- Evaluation of Set objects, operators, and functions.
- 
-       if Alphabet_Set /= (Vowel_Set OR Consonant_Set) then
-          Report.Failed("Incorrect set combinations using OR operator");
-       end if;
- 
- 
-       for i in 1..5 loop
-          if not Maps.Is_In(Vowels(i), Vowel_Set)    or
-             not Maps.Is_In(Vowels(i), Alphabet_Set) or
-             Maps.Is_In(Vowels(i), Consonant_Set) 
-          then
-             Report.Failed("Incorrect function Is_In use with set " &
-                           "combinations - " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-       if Maps.Is_Subset(Vowel_Set, First_Half_Set)    or
-          Maps."<="(Vowel_Set, Second_Half_Set)        or
-          not Maps.Is_Subset(Vowel_Set, Alphabet_Set)
-       then
-          Report.Failed("Incorrect set evaluation using Is_Subset function");
-       end if;
- 
-      
-       if not (Full_Vowel_Set = Maps.To_Set("aeiouy")) then
-          Report.Failed("Incorrect result for ""="" set operator");
-       end if;
- 
- 
-       if not ((Vowel_Set AND First_Half_Set) OR 
-               (Full_Vowel_Set AND Second_Half_Set)) = Full_Vowel_Set then
-          Report.Failed
-            ("Incorrect result for AND, OR, or ""="" set operators");
-       end if;
- 
- 
-       if (Alphabet_Set AND Maps.Null_Set) /= Maps.Null_Set  or
-          (Alphabet_Set OR  Maps.Null_Set) /= Alphabet_Set
-       then
-          Report.Failed("Incorrect result for AND or OR set operators");
-       end if;
- 
- 
-       Vowel_Set := Full_Vowel_Set;
-       Vowel_Set := Vowel_Set AND (NOT Maps.To_Set(Quasi_Vowel));
-       
-       if not (Vowels = Maps.To_Sequence(Vowel_Set)) then
-          Report.Failed("Incorrect Set to Sequence translation");
-       end if;
- 
-       
-       for i in 1..26 loop
-          Inverse_Alphabet(i) := Alphabet(27-i);
-       end loop;
- 
-       declare
-          Inverse_Map : Maps.Character_Mapping :=
-                          Maps.To_Mapping(Alphabet, Inverse_Alphabet);
-       begin
-          if Maps.Value(Maps.Identity, 'b') /= Maps.Value(Inverse_Map,'y') 
-          then
-             Report.Failed("Incorrect Inverse mapping");
-          end if;
-       end;
- 
- 
-       -- Check that Translation_Error is raised when a character is
-       -- repeated in the parameter "From" string.
-       declare
-          Bad_Map : Maps.Character_Mapping;
-       begin
-          Bad_Map := Maps.To_Mapping(From => "aa", To => "yz");
-          Report.Failed("Exception not raised with repeated character");
- 
-          if Report.Equal (Character'Pos('y'),
-                           Character'Pos(Maps.Value(Bad_Map, 'a'))) then
-             -- Use the map to avoid optimization.
-             Report.Comment ("Shouldn't get here.");
-          end if;
-       exception
-          when Translation_Error => null;  -- OK
-          when others            => 
-             Report.Failed("Incorrect exception raised in To_Mapping with " &
-                           "a repeated character");
-       end;
- 
- 
-       -- Check that Translation_Error is raised when the parameters of the
-       -- function To_Mapping are of unequal lengths.
-       declare
-          Bad_Map : Maps.Character_Mapping;
-       begin
-          Bad_Map := Maps.To_Mapping("abc", "yz");
-          Report.Failed("Exception not raised with unequal parameter lengths");
- 
-          if Report.Equal (Character'Pos('y'),
-                           Character'Pos(Maps.Value(Bad_Map, 'a'))) then
-             -- Use the map to avoid optimization.
-             Report.Comment ("Shouldn't get here.");
-          end if;
-       exception
-          when Translation_Error => null;  -- OK
-          when others            => 
-             Report.Failed("Incorrect exception raised in To_Mapping with " &
-                           "unequal parameter lengths");
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,182 ****
- -- CXA4002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Fixed are
- --      available, and that they produce correct results.  Specifically, 
- --      check the subprograms Index, "*" (string constructor function), 
- --      Count, Trim, and Replace_Slice.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates how certain Fixed string functions are used
- --      to eliminate specific substrings from portions of text.  A procedure
- --      is defined that will take as parameters a source string along with
- --      a substring that is to be completely removed from the source string.
- --      The source string is parsed using the Index function, and any substring
- --      slices are replaced in the source string by a series of X's (based on
- --      the length of the substring.)  
- --      Three lines of text are provided to this procedure, and the resulting
- --      substitutions are compared with expected results to validate the 
- --      string processing.
- --      A global accumulator is updated with the number of occurrences of the
- --      substring in the source string.  
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Strings;
- with Ada.Strings.Fixed;
- with Ada.Strings.Maps;
- with Report;
- 
- procedure CXA4002 is
- 
- begin
- 
-    Report.Test ("CXA4002", "Check that the subprograms defined in package "  &
-                            "Ada.Strings.Fixed are available, and that "      &
-                            "they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       TC_Total : Natural := 0;
-       Number_Of_Lines : constant := 3;
- 
-       type Restricted_Words_Array_Type is array (1..10) of String (1..10);
- 
-       Restricted_Words : Restricted_Words_Array_Type := 
-                            ("   platoon", " marines  ", "  Marines ",
-                             "north     ", "south     ", "      east", 
-                             "  beach   ", "   airport", "airfield  ", 
-                             "     road ");
- 
-       subtype Line_Of_Text_Type is String(1..25);
-       type    Page_Of_Text_Type is array (1..Number_Of_Lines) 
-         of Line_Of_Text_Type;
- 
-       Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
-                                         "moved south on the south ",
-                                         "road to the airfield.    ");
- 
-       TC_Revised_Line_1 : constant String := "The XXXXXXX of XXXXXXX   ";
-       TC_Revised_Line_2 : constant String := "moved XXXXX on the XXXXX ";
-       TC_Revised_Line_3 : constant String := "XXXX to the XXXXXXXX.    ";
- 
-       ---
- 
-       procedure Censor (Source_String  : in out String;
-                         Pattern_String : in     String) is
-                         
-          -- Create a replacement string that is the same length as the
-          -- pattern string being removed.
-          Replacement : constant String :=                              -- "*"
-                          Ada.Strings.Fixed."*"(Pattern_String'Length, 'X');
- 
-          Going       : Ada.Strings.Direction := Ada.Strings.Forward;
-          Map         : constant Ada.Strings.Maps.Character_Mapping :=
-                          Ada.Strings.Maps.Identity;
-          Start_Pos,
-          Index       : Natural := Source_String'First;
- 
- 
-       begin  -- Censor
- 
-          -- Accumulate count of total replacement operations.
- 
-          TC_Total := TC_Total +                                     -- Count
-                        Ada.Strings.Fixed.Count (Source  => Source_String,
-                                                 Pattern => Pattern_String,
-                                                 Mapping => Map);
-          loop
- 
-             Index := Ada.Strings.Fixed.Index                        -- Index
-                        (Source_String(Start_Pos..Source_String'Last),
-                         Pattern_String, 
-                         Going, 
-                         Map);
- 
-             exit when Index = 0;   -- No matches, exit loop.
- 
-             -- if a match was found, modify the substring.
-             Ada.Strings.Fixed.Replace_Slice                   -- Replace_Slice
-                                 (Source_String,
-                                  Index,
-                                  Index + Pattern_String'Length - 1,
-                                  Replacement);
-             Start_Pos := Index + Pattern_String'Length;
- 
-          end loop;
- 
-       end Censor;
- 
- 
-    begin
- 
-       -- Invoke Censor subprogram to cleanse text.
-       -- Loop through each line of text, and check for the presence of each
-       -- restricted word.
-       -- Use the Trim function to eliminate leading or trailing blanks from
-       -- the restricted word parameters.
- 
-       for Line in 1..Number_Of_Lines loop
-          for Word in Restricted_Words'Range loop
-              Censor (Text_Page(Line), 
-                      Ada.Strings.Fixed.Trim(Restricted_Words(Word),   -- Trim
-                                             Ada.Strings.Both));
-          end loop;
-       end loop;
- 
- 
-       -- Validate results.
- 
-       if TC_Total /= 6 then
-          Report.Failed ("Incorrect number of substitutions performed");
-       end if;
- 
-       if Text_Page(1) /= TC_Revised_Line_1 then
-          Report.Failed ("Incorrect substitutions on Line 1");
-       end if;
- 
-       if Text_Page(2) /= TC_Revised_Line_2 then
-          Report.Failed ("Incorrect substitutions on Line 2");
-       end if;
- 
-       if Text_Page(3) /= TC_Revised_Line_3 then
-          Report.Failed ("Incorrect substitutions on Line 3");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,326 ****
- -- CXA4003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Fixed are
- --      available, and that they produce correct results.  Specifically, 
- --      check the subprograms Index, Index_Non_Blank, Head, Tail, Translate, 
- --      Find_Token, Move, Overwrite, and Replace_Slice.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates how certain fixed string operations could be
- --      used in string information processing.  A procedure is defined that
- --      will extract portions of a 50 character string that correspond to
- --      certain data items (i.e., name, address, state, zip code). These
- --      parsed items will then be added to the appropriate fields of data
- --      base elements.  These data base elements are then compared for
- --      accuracy against a similar set of predefined data base elements.
- --
- --      A variety of fixed string processing subprograms are used in this
- --      test.  Each parsing operation uses a different combination
- --      of the available subprograms to accomplish the same goal, therefore
- --      continuity of approach to string parsing is not seen in this test.
- --      However, a wide variety of possible approaches are demonstrated, while
- --      exercising a large number of the total predefined subprograms of
- --      package Ada.Strings.Fixed.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Strings.Fixed;
- with Ada.Strings.Maps;
- with Report;
- 
- procedure CXA4003 is
- 
- begin
- 
-    Report.Test ("CXA4003", "Check that the subprograms defined in package "  &
-                            "Ada.Strings.Fixed are available, and that they " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       Number_Of_Info_Strings : constant Natural := 3;
-       DB_Size                : constant Natural := Number_Of_Info_Strings;
-       Count                  : Natural          := 0;
-       Finished_Processing    : Boolean          := False;
-       Blank_String           : constant String  := " ";
- 
-       subtype Info_String_Type         is String (1..50);
-       type    Info_String_Storage_Type is 
-         array (1..Number_Of_Info_Strings) of Info_String_Type;
- 
- 
-       subtype Name_Type                is String (1..10);
-       subtype Street_Number_Type       is String (1..5);
-       subtype Street_Name_Type         is String (1..10);
-       subtype City_Type                is String (1..10);
-       subtype State_Type               is String (1..2);
-       subtype Zip_Code_Type            is String (1..5);
- 
-       type Data_Base_Element_Type is
-          record
-             Name          : Name_Type          := (others => ' ');
-             Street_Number : Street_Number_Type := (others => ' ');
-             Street_Name   : Street_Name_Type   := (others => ' ');
-             City          : City_Type          := (others => ' ');
-             State         : State_Type         := (others => ' ');
-             Zip_Code      : Zip_Code_Type      := (others => ' ');
-          end record;
- 
-       type Data_Base_Type is array (1..DB_Size) of Data_Base_Element_Type;
- 
-       Data_Base : Data_Base_Type;
- 
-       ---
- 
-       Info_String_1 : Info_String_Type := 
-         "Joe_Jones 123   Sixth_St   San_Diego    CA   98765"; 
- 
-       Info_String_2 : Info_String_Type := 
-         "Sam_Smith 56789  S._Seventh   Carlsbad  CA   92177";
- 
-       Info_String_3 : Info_String_Type := 
-         "Jane_Brown 1219   Info_Lane  Tuscon     AZ   85643";
- 
- 
-       Info_Strings : Info_String_Storage_Type := (1 => Info_String_1,
-                                                   2 => Info_String_2,
-                                                   3 => Info_String_3);
- 
- 
- 
-       TC_DB_Element_1 : Data_Base_Element_Type := 
-         ("Joe Jones ", "123  ", "Sixth St  ", "San Diego ", "CA", "98765");
- 
-       TC_DB_Element_2 : Data_Base_Element_Type := 
-         ("Sam Smith ", "56789", "S. Seventh", "Carlsbad  ", "CA", "92177");
- 
-       TC_DB_Element_3 : Data_Base_Element_Type := 
-         ("Jane Brown", "1219 ", "Info Lane ", "Tuscon    ", "AZ", "85643");
- 
-       TC_Data_Base : Data_Base_Type := (TC_DB_Element_1,
-                                         TC_DB_Element_2,
-                                         TC_DB_Element_3);
- 
-       ---
- 
- 
-       procedure Store_Information 
-          (Info_String : in     Info_String_Type;
-           DB_Record   : in out Data_Base_Element_Type) is
- 
-          package AS renames Ada.Strings;
-          use type AS.Maps.Character_Set;
- 
-          UnderScore  : AS.Maps.Character_Sequence := "_";
-          Blank       : AS.Maps.Character_Sequence := " ";
- 
-          Start,
-          Stop  : Natural := 0;
- 
-          Underscore_to_Blank_Map : constant AS.Maps.Character_Mapping := 
-                             AS.Maps.To_Mapping(From => UnderScore, 
-                                                To   => Blank);
- 
-          Numeric_Set    : constant AS.Maps.Character_Set :=
-                             AS.Maps.To_Set("0123456789");
- 
-          Cal            : constant AS.Maps.Character_Sequence := "CA";
-          California_Set : constant AS.Maps.Character_Set := 
-                             AS.Maps.To_Set(Cal);
-          Arizona_Set    : constant AS.Maps.Character_Set := 
-                             AS.Maps.To_Set("AZ");
-          Nevada_Set     : constant AS.Maps.Character_Set := 
-                             AS.Maps.To_Set("NV");
- 
-       begin
- 
-          -- Find the starting position of the name field (first non-blank),
-          -- then, from that position, find the end of the name field (first
-          -- blank).
- 
-          Start := AS.Fixed.Index_Non_Blank(Info_String); 
-          Stop  := AS.Fixed.Index (Info_String(Start..Info_String'Length),
-                                   AS.Maps.To_Set(' '),
-                                   AS.Inside,
-                                   AS.Forward) - 1 ;
- 
-          -- Store the name field in the data base element field for "Name".
- 
-          DB_Record.Name := AS.Fixed.Head(Info_String(1..Stop), 
-                                          DB_Record.Name'Length);
- 
-          -- Replace any underscore characters in the name field
-          -- that were used to separate first/middle/last names.
- 
-          AS.Fixed.Translate (DB_Record.Name, Underscore_to_Blank_Map);
- 
-          
-          -- Continue the extraction process; now find the position of
-          -- the street number in the string.
- 
-          Start := Stop + 1;
- 
-          AS.Fixed.Find_Token(Info_String(Start..Info_String'Length),
-                              Numeric_Set,
-                              AS.Inside,
-                              Start,
-                              Stop);
- 
-          -- Store the street number field in the appropriate data base 
-          -- element.
-          -- No modification of the default parameters of procedure Move
-          -- is required.
- 
-          AS.Fixed.Move(Source => Info_String(Start..Stop),
-                        Target => DB_Record.Street_Number);
- 
- 
-          -- Continue the extraction process; find the street name in the
-          -- info string.  Skip blanks to the start of the street name, then
-          -- search for the index of the next blank character in the string.
- 
-          Start :=
-            AS.Fixed.Index_Non_Blank(Info_String(Stop+1..Info_String'Length)); 
- 
-          Stop := 
-            AS.Fixed.Index(Info_String(Start..Info_String'Length),
-                           Blank_String) - 1; 
- 
-          -- Store the street name in the appropriate data base element field.
- 
-          AS.Fixed.Overwrite(DB_Record.Street_Name, 
-                             1, 
-                             Info_String(Start..Stop));
-                            
-          -- Replace any underscore characters in the street name field
-          -- that were used as word separation.
- 
-          DB_Record.Street_Name := AS.Fixed.Translate(DB_Record.Street_Name, 
-                                                      Underscore_to_Blank_Map);
- 
- 
-          -- Continue the extraction; remove the city name from the string.
- 
-          Start :=
-            AS.Fixed.Index_Non_Blank(Info_String(Stop+1..Info_String'Length)); 
- 
-          Stop := 
-            AS.Fixed.Index(Info_String(Start..Info_String'Length), 
-                           Blank_String) - 1; 
- 
-          -- Store the city name field in the appropriate data base element.
- 
-          AS.Fixed.Replace_Slice(DB_Record.City, 
-                                 1,
-                                 DB_Record.City'Length,
-                                 Info_String(Start..Stop));
-                            
-          -- Replace any underscore characters in the city name field
-          -- that were used as word separation.
- 
-          AS.Fixed.Translate (DB_Record.City, Underscore_to_Blank_Map);
- 
- 
-          -- Continue the extraction; remove the state identifier from the 
-          -- info string.
- 
-          Start := Stop + 1;
- 
-          AS.Fixed.Find_Token(Info_String(Start..Info_String'Length),
-                              AS.Maps."OR"(California_Set,
-                                AS.Maps."OR"(Nevada_Set, Arizona_Set)),
-                              AS.Inside,
-                              Start,
-                              Stop);
- 
-          -- Store the state indicator into the data base element.
- 
-          AS.Fixed.Move(Source  => Info_String(Start..Stop),
-                        Target  => DB_Record.State,
-                        Drop    => Ada.Strings.Right,
-                        Justify => Ada.Strings.Left,
-                        Pad     => AS.Space);
- 
- 
-          -- Continue the extraction process; remove the final data item in 
-          -- the info string, the zip code, and place it into the 
-          -- corresponding data base element.
- 
-          DB_Record.Zip_Code := AS.Fixed.Tail(Info_String, 
-                                              DB_Record.Zip_Code'Length);
- 
-       exception 
-          when AS.Length_Error      =>
-             Report.Failed ("Length_Error raised in procedure");
-          when AS.Pattern_Error     =>
-             Report.Failed ("Pattern_Error raised in procedure");
-          when AS.Translation_Error =>
-             Report.Failed ("Translation_Error raised in procedure");
-          when others            =>
-             Report.Failed ("Exception raised in procedure");
-       end Store_Information;
- 
- 
-    begin
- 
-       -- Loop thru the information strings, extract the name and address
-       -- information, place this info into elements of the data base.
- 
-       while not Finished_Processing loop
- 
-          Count := Count + 1;
- 
-          Store_Information (Info_Strings(Count), Data_Base(Count));
- 
-          Finished_Processing := (Count = Number_Of_Info_Strings);
- 
-       end loop;
- 
- 
-       -- Verify that the string processing was successful.
- 
-       for i in 1..DB_Size loop
-          if Data_Base(i) /= TC_Data_Base(i) then
-             Report.Failed 
-               ("Data processing error on record " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,431 ****
- -- CXA4004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Fixed are
- --      available, and that they produce correct results. Specifically, check 
- --      the subprograms Count, Find_Token, Index, Index_Non_Blank, and Move.
- --      
- -- TEST DESCRIPTION:
- --      This test, when combined with tests CXA4002,3, and 5 will provide 
- --      thorough coverage of the functionality found in Ada.Strings.Fixed.  
- --      This test contains many small, specific test cases, situations that 
- --      although common in user environments, are often difficult to generate 
- --      in large numbers in a application-based test.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 95   SAIC    Corrected subtest for Move, Drop=Right.
- --
- --!
- 
- with Report;
- with Ada.Strings;
- with Ada.Strings.Fixed;
- with Ada.Strings.Maps;
- 
- procedure CXA4004 is
- begin
- 
-    Report.Test("CXA4004", "Check that the subprograms defined in "    &
-                           "package Ada.Strings.Fixed are available, " &
-                           "and that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ASF  renames Ada.Strings.Fixed;
-       package Maps renames Ada.Strings.Maps;
- 
-       Result_String  : String(1..10) := (others => Ada.Strings.Space);
- 
-       Source_String1 : String(1..5)  := "abcde";        -- odd length string
-       Source_String2 : String(1..6)  := "abcdef";       -- even length string
-       Source_String3 : String(1..12) := "abcdefghijkl";   
-       Source_String4 : String(1..12) := "abcdefghij  "; -- last two ch pad
-       Source_String5 : String(1..12) := "  cdefghijkl"; -- first two ch pad
-       Source_String6 : String(1..12) := "abcdefabcdef";   
-                                                                               
-       Location       : Natural := 0;
-       Slice_Start    : Positive;
-       Slice_End,
-       Slice_Count    : Natural := 0;
- 
-       CD_Set         : Maps.Character_Set := Maps.To_Set("cd");  
-       ABCD_Set       : Maps.Character_Set := Maps.To_Set("abcd");
-       A_to_F_Set     : Maps.Character_Set := Maps.To_Set("abcdef");
-                   
-       CD_to_XY_Map   : Maps.Character_Mapping :=
-                          Maps.To_Mapping(From => "cd",  To => "xy");
- 
-    begin
- 
-       -- Procedure Move
- 
-       -- Evaluate the Procedure Move with various combinations of
-       -- parameters.
- 
-       -- Justify = Left (default case)
-      
-       ASF.Move(Source => Source_String1,       -- "abcde"
-                Target => Result_String);
-       
-       if Result_String /= "abcde     " then
-          Report.Failed("Incorrect result from Move with Justify = Left");
-       end if;
-  
-       -- Justify = Right
-  
-       ASF.Move(Source  => Source_String2,      -- "abcdef"
-                Target  => Result_String,
-                Drop    => Ada.Strings.Error,
-                Justify => Ada.Strings.Right);
- 
-       if Result_String /= "    abcdef" then
-          Report.Failed("Incorrect result from Move with Justify = Right");
-       end if;
- 
-       -- Justify = Center (two cases, odd and even pad lengths)
-  
-       ASF.Move(Source_String1,                 -- "abcde"
-                Result_String,
-                Ada.Strings.Error,
-                Ada.Strings.Center,
-                'x');                           -- non-default padding.
- 
-       if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
-          Report.Failed("Incorrect result from Move with Justify = Center-1");
-       end if;
- 
-       ASF.Move(Source_String2,                 -- "abcdef"
-                Result_String,
-                Ada.Strings.Error,
-                Ada.Strings.Center);
- 
-       if Result_String /= "  abcdef  " then  -- Equal padding added on L/R.
-          Report.Failed("Incorrect result from Move with Justify = Center-2");
-       end if;
- 
-       -- When the source string is longer than the target string, several
-       -- cases can be examined, with the results depending on the value of
-       -- the Drop parameter.
- 
-       -- Drop = Left
- 
-       ASF.Move(Source => Source_String3,       -- "abcdefghijkl"
-                Target => Result_String,
-                Drop   => Ada.Strings.Left);
- 
-       if Result_String /= "cdefghijkl" then
-          Report.Failed("Incorrect result from Move with Drop = Left");
-       end if;
- 
-       -- Drop = Right
-      
-       ASF.Move(Source_String3, Result_String, Ada.Strings.Right);
- 
-       if Result_String /= "abcdefghij" then
-          Report.Failed("Incorrect result from Move with Drop = Right");
-       end if;
- 
-       -- Drop = Error
-       -- The effect in this case depends on the value of the justify
-       -- parameter, and on whether any characters in Source other than 
-       -- Pad would fail to be copied.
- 
-       -- Drop = Error, Justify = Left, right overflow characters are pad.
- 
-       ASF.Move(Source  => Source_String4,      -- "abcdefghij  "
-                Target  => Result_String,
-                Drop    => Ada.Strings.Error,
-                Justify => Ada.Strings.Left);
- 
-       if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
-           Report.Failed("Incorrect result from Move with Drop = Error - 1");
-       end if;
- 
-       -- Drop = Error, Justify = Right, left overflow characters are pad.
- 
-       ASF.Move(Source_String5,                 -- "  cdefghijkl"
-                Result_String, 
-                Ada.Strings.Error, 
-                Ada.Strings.Right);
- 
-       if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
-          Report.Failed("Incorrect result from Move with Drop = Error - 2");
-       end if;
- 
-       -- In other cases of Drop=Error, Length_Error is propagated, such as:
- 
-       begin
- 
-          ASF.Move(Source_String3,     -- 12 characters, no Pad.
-                   Result_String,      -- 10 characters
-                   Ada.Strings.Error,  
-                   Ada.Strings.Left);  
- 
-          Report.Failed("Length_Error not raised by Move - 1");
- 
-       exception
-          when Ada.Strings.Length_Error => null;   -- OK
-          when others => 
-             Report.Failed("Incorrect exception raised by Move - 1");
-       end;
- 
- 
- 
-       -- Function Index
-       -- (Other usage examples of this function found in CXA4002-3.)
-       -- Check when the pattern is not found in the source.
- 
-       if ASF.Index("abcdef", "gh")       /= 0 or
-          ASF.Index("abcde",  "abcdef")   /= 0 or  -- pattern > source
-          ASF.Index("xyz", 
-                    "abcde", 
-                    Ada.Strings.Backward) /= 0 or
-          ASF.Index("",      "ab")        /= 0 or  -- null source string.
-          ASF.Index("abcde", "  ")        /= 0     -- blank pattern.
-       then
-          Report.Failed("Incorrect result from Index, no pattern match");
-       end if;
- 
-       -- Check that Pattern_Error is raised when the pattern is the 
-       -- null string.
-       begin
-          Location := ASF.Index(Source_String6,    -- "abcdefabcdef"
-                                "",                -- null pattern string.
-                                Ada.Strings.Forward);
-          Report.Failed("Pattern_Error not raised by Index");
-       exception
-          when Ada.Strings.Pattern_Error => null;  -- OK, expected exception.
-          when others                    =>
-            Report.Failed("Incorrect exception raised by Index, null pattern");
-       end;
- 
-       -- Use the search direction "backward" to locate the particular
-       -- pattern within the source string.
- 
-       Location := ASF.Index(Source_String6,         -- "abcdefabcdef"
-                             "de",                   -- slice 4..5, 10..11
-                             Ada.Strings.Backward);  -- search from right end.
- 
-       if Location /= 10  then
-          Report.Failed("Incorrect result from Index going Backward");
-       end if;
- 
-       -- Using the version of Index testing character set membership, 
-       -- check combinations of forward/backward, inside/outside parameter
-       -- configurations.
- 
-       if ASF.Index(Source => Source_String1,      -- "abcde"
-                    Set    => CD_Set,
-                    Test   => Ada.Strings.Inside,
-                    Going  => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3.
-          ASF.Index(Source_String6,                -- "abcdefabcdef"
-                    CD_Set,
-                    Ada.Strings.Outside,
-                    Ada.Strings.Backward)  /=  12  or   -- 'f' at position 12
-          ASF.Index(Source_String6,                -- "abcdefabcdef"
-                    CD_Set,
-                    Ada.Strings.Inside,
-                    Ada.Strings.Backward)  /=   10  or  -- 'd' at position 10
-          ASF.Index("cdcdcdcdacdcdcdcd",               
-                    CD_Set,
-                    Ada.Strings.Outside,
-                    Ada.Strings.Forward)   /=    9      -- 'a' at position 9
-       then
-          Report.Failed("Incorrect result from function Index for sets - 1");
-       end if;
- 
-       -- Additional interesting uses/combinations using Index for sets.
- 
-       if ASF.Index("cd",                               -- same size, str-set
-                    CD_Set,
-                    Ada.Strings.Inside,
-                    Ada.Strings.Forward)   /=    1  or  -- 'c' at position 1
-          ASF.Index("abcd",                             -- same size, str-set,
-                    Maps.To_Set("efgh"),                -- different contents.
-                    Ada.Strings.Outside,                
-                    Ada.Strings.Forward)   /=    1  or
-          ASF.Index("abccd",                            -- set > string
-                    Maps.To_Set("acegik"),
-                    Ada.Strings.Inside,
-                    Ada.Strings.Backward)  /=    4  or  -- 'c' at position 4
-          ASF.Index("abcde",
-                    Maps.Null_Set)         /=    0  or
-          ASF.Index("",                                 -- Null string.
-                    CD_Set)                /=    0  or
-          ASF.Index("abc ab",                           -- blank included
-                    Maps.To_Set("e "),                  -- in string and set.
-                    Ada.Strings.Inside,
-                    Ada.Strings.Backward)  /=    4      -- blank in string.
-       then
-          Report.Failed("Incorrect result from function Index for sets - 2");
-       end if;
- 
- 
- 
-       -- Function Index_Non_Blank.                      
-       -- (Other usage examples of this function found in CXA4002-3.)
-                                                          
- 
-       if ASF.Index_Non_Blank(Source => Source_String4,  -- "abcdefghij  "
-                              Going  => Ada.Strings.Backward)  /= 10  or
-          ASF.Index_Non_Blank("abc def ghi jkl  ",
-                              Ada.Strings.Backward)            /= 15  or
-          ASF.Index_Non_Blank("  abcdef")                      /=  3  or
-          ASF.Index_Non_Blank("        ")                      /=  0
-       then
-           Report.Failed("Incorrect result from Index_Non_Blank");
-       end if;
- 
- 
- 
-       -- Function Count
-       -- (Other usage examples of this function found in CXA4002-3.)
- 
-       if ASF.Count("abababa",   "aba")            /=  2  or
-          ASF.Count("abababa",   "ab" )            /=  3  or
-          ASF.Count("babababa",  "ab")             /=  3  or
-          ASF.Count("abaabaaba", "aba")            /=  3  or
-          ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy")  /=  1  or
-          ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x")   /= 20
-       then
-          Report.Failed("Incorrect result from Function Count");
-       end if;
- 
-       -- Determine the number of slices of Source that when mapped to a 
-       -- non-identity map, match the pattern string.
- 
-       Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef"
-                                "xy",
-                                CD_to_XY_Map);  -- maps 'c' to 'x', 'd' to 'y'
- 
-       if Slice_Count /= 2 then  -- two slices "xy" in "mapped" Source_String6
-          Report.Failed("Incorrect result from Count with non-identity map");
-       end if;
- 
-       -- If the pattern supplied to Function Count is the null string, then
-       -- Pattern_Error is propagated.
- 
-       declare
-          The_Null_String : constant String := "";
-       begin
-          Slice_Count := ASF.Count(Source_String6, The_Null_String);
-          Report.Failed("Pattern_Error not raised by Function Count");
-       exception
-          when Ada.Strings.Pattern_Error => null;   -- OK
-          when others =>
-            Report.Failed("Incorrect exception from Count with null pattern");
-       end;
- 
- 
-       -- Function Count returning the number of characters in a particular
-       -- set that are found in source string.
- 
-       if ASF.Count(Source_String6, CD_Set) /= 4 then  -- 2 'c' and 'd' chars.
-          Report.Failed("Incorrect result from Count with set");
-       end if;
- 
- 
-  
-       -- Function Find_Token.                            
-       -- (Other usage examples of this function found in CXA4002-3.)
- 
-       ASF.Find_Token(Source  => Source_String6,      -- First slice with no 
-                      Set     => ABCD_Set,            -- 'a', 'b', 'c', or 'd'
-                      Test    => Ada.Strings.Outside, -- is "ef" at 5..6.
-                      First   => Slice_Start,
-                      Last    => Slice_End);
- 
-       if Slice_Start /= 5  or Slice_End /= 6 then
-          Report.Failed("Incorrect result from Find_Token - 1");
-       end if;
- 
-       -- If no appropriate slice is contained by the source string, then the 
-       -- value returned in Last is zero, and the value in First is 
-       -- Source'First.
- 
-       ASF.Find_Token(Source_String6,      -- "abcdefabcdef"
-                      A_to_F_Set,          -- Set of characters 'a' thru 'f'.
-                      Ada.Strings.Outside, -- No characters outside this set.
-                      Slice_Start,
-                      Slice_End);
-       
-       if Slice_Start /= Source_String6'First  or Slice_End /= 0 then
-          Report.Failed("Incorrect result from Find_Token - 2");
-       end if;
- 
-       -- Additional testing of Find_Token.
- 
-       ASF.Find_Token("eabcdabcddcab", 
-                      ABCD_Set, 
-                      Ada.Strings.Inside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 2  or Slice_End /= 13 then
-          Report.Failed("Incorrect result from Find_Token - 3");
-       end if;
- 
-       ASF.Find_Token("efghijklabcdabcd",
-                      ABCD_Set,
-                      Ada.Strings.Outside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 1  or Slice_End /= 8 then
-          Report.Failed("Incorrect result from Find_Token - 4");
-       end if;
- 
-       ASF.Find_Token("abcdefgabcdabcd",
-                      ABCD_Set,
-                      Ada.Strings.Outside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 5  or Slice_End /= 7 then
-          Report.Failed("Incorrect result from Find_Token - 5");
-       end if;
- 
-       ASF.Find_Token("abcdcbabcdcba",
-                      ABCD_Set,
-                      Ada.Strings.Inside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 1  or Slice_End /= 13 then
-          Report.Failed("Incorrect result from Find_Token - 6");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,683 ****
- -- CXA4005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Fixed are
- --      available, and that they produce correct results.  Specifically,
- --      check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice,
- --      Tail, Trim, and "*".
- --
- -- TEST DESCRIPTION:
- --      This test, when combined with tests CXA4002-4 will provide coverage
- --      of the functionality found in Ada.Strings.Fixed.
- --      This test contains many small, specific test cases, situations that
- --      although common in user environments, are often difficult to generate
- --      in large numbers in a application-based test.  They represent
- --      individual usage paradigms in-the-small.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      11 Apr 95   SAIC    Corrected acceptance conditions of certain
- --                          subtests.
- --	06 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1.
- --      22 Feb 01   PHL     Check that the lower bound of the result is 1.
- --      13 Mar 01   RLB     Fixed a couple of ACATS style violations;
- --                          removed pointless checks of procedures.
- --                          Added checks of other functions. These changes
- --                          were made to test Defect Report 8652/0049, as
- --                          reflected in Technical Corrigendum 1.
- --
- --!
- 
- with Report;
- with Ada.Strings;
- with Ada.Strings.Fixed;
- with Ada.Strings.Maps;
- 
- procedure CXA4005 is
- 
-     type TC_Name_Holder is access String;
-     Name : TC_Name_Holder;
- 
-     function TC_Check (S : String) return String is
-     begin
-         if S'First /= 1 then
-             Report.Failed ("Lower bound of result of function " & Name.all &
-                            " is" & Integer'Image (S'First));
-         end if;
-         return S;
-     end TC_Check;
- 
-     procedure TC_Set_Name (N : String) is
-     begin
-         Name := new String'(N);
-     end TC_Set_Name;
- 
- begin
- 
-    Report.Test("CXA4005", "Check that the subprograms defined in "    &
-                           "package Ada.Strings.Fixed are available, " &
-                           "and that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ASF  renames Ada.Strings.Fixed;
-       package Maps renames Ada.Strings.Maps;
- 
-       Result_String,
-       Delete_String,
-       Insert_String,
-       Trim_String,
-       Overwrite_String  : String(1..10) := (others => Ada.Strings.Space);
- 
-       Source_String1    : String(1..5)  := "abcde";     -- odd length string
-       Source_String2    : String(1..6)  := "abcdef";    -- even length string
-       Source_String3    : String(1..12) := "abcdefghijkl";
-       Source_String4    : String(1..12) := "abcdefghij  "; -- last two ch pad
-       Source_String5    : String(1..12) := "  cdefghijkl"; -- first two ch pad
-       Source_String6    : String(1..12) := "abcdefabcdef";
- 
-       Location     : Natural := 0;
-       Slice_Start  : Positive;
-       Slice_End,
-       Slice_Count  : Natural := 0;
- 
-       CD_Set       : Maps.Character_Set := Maps.To_Set("cd");
-       X_Set        : Maps.Character_Set := Maps.To_Set('x');
-       ABCD_Set     : Maps.Character_Set := Maps.To_Set("abcd");
-       A_to_F_Set   : Maps.Character_Set := Maps.To_Set("abcdef");
- 
-       CD_to_XY_Map : Maps.Character_Mapping :=
-                                  Maps.To_Mapping(From => "cd",  To => "xy");
- 
-    begin
- 
-       -- Procedure Replace_Slice
-       -- The functionality of this procedure
-       -- is similar to procedure Move, and
-       -- is tested here in the same manner, evaluated
-       -- with various combinations of parameters.
- 
-       -- Index_Error propagation when Low > Source'Last + 1
- 
-       begin
-          ASF.Replace_Slice(Result_String,
-                            Result_String'Last + 2, -- should raise exception
-                            Result_String'Last,
-                            "xxxxxxx");
-          Report.Failed("Index_Error not raised by Replace_Slice - 1");
-       exception
-          when Ada.Strings.Index_Error => null; -- OK, expected exception.
-          when others                  =>
-             Report.Failed("Incorrect exception from Replace_Slice - 1");
-       end;
- 
-       -- Index_Error propagation when High < Source'First - 1
- 
-       begin
-          ASF.Replace_Slice(Result_String(5..10),
-                            5,
-                            3, -- should raise exception since < 'First - 1.
-                            "xxxxxxx");
-          Report.Failed("Index_Error not raised by Replace_Slice - 2");
-       exception
-          when Ada.Strings.Index_Error => null; -- OK, expected exception.
-          when others                  =>
-             Report.Failed("Incorrect exception from Replace_Slice - 2");
-       end;
- 
-       -- Justify = Left (default case)
- 
-       Result_String := "XXXXXXXXXX";
- 
-       ASF.Replace_Slice(Source => Result_String,
-                         Low    =>  1,
-                         High   => 10,
-                         By     => Source_String1);   -- "abcde"
- 
-       if Result_String /= "abcde     " then
-          Report.Failed("Incorrect result from Replace_Slice - Justify = Left");
-       end if;
- 
-       -- Justify = Right
- 
-       ASF.Replace_Slice(Source  => Result_String,
-                         Low     => 1,
-                         High    => Result_String'Last,
-                         By      => Source_String2,      -- "abcdef"
-                         Drop    => Ada.Strings.Error,
-                         Justify => Ada.Strings.Right);
- 
-       if Result_String /= "    abcdef" then
-          Report.Failed("Incorrect result from Replace_Slice - Justify=Right");
-       end if;
- 
-       -- Justify = Center (two cases, odd and even pad lengths)
- 
-       ASF.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String1,      -- "abcde"
-                         Ada.Strings.Error,
-                         Ada.Strings.Center,
-                         'x');                -- non-default padding.
- 
-       if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
-          Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1");
-       end if;
- 
-       ASF.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String2,        -- "abcdef"
-                         Ada.Strings.Error,
-                         Ada.Strings.Center);
- 
-       if Result_String /= "  abcdef  " then    -- Equal padding added on L/R.
-          Report.Failed("Incorrect result from Replace_Slice with " &
-                        "Justify = Center - 2");
-       end if;
- 
-       -- When the source string is longer than the target string, several
-       -- cases can be examined, with the results depending on the value of
-       -- the Drop parameter.
- 
-       -- Drop = Left
- 
-       ASF.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String3,            -- "abcdefghijkl"
-                         Drop => Ada.Strings.Left);
- 
-       if Result_String /= "cdefghijkl" then
-          Report.Failed("Incorrect result from Replace_Slice - Drop=Left");
-       end if;
- 
-       -- Drop = Right
- 
-       ASF.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String3,        -- "abcdefghijkl"
-                         Ada.Strings.Right);
- 
-       if Result_String /= "abcdefghij" then
-          Report.Failed("Incorrect result, Replace_Slice with Drop=Right");
-       end if;
- 
-       -- Drop = Error
- 
-       -- The effect in this case depends on the value of the justify
-       -- parameter, and on whether any characters in Source other than
-       -- Pad would fail to be copied.
- 
-       -- Drop = Error, Justify = Left, right overflow characters are pad.
- 
-       ASF.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String4,               -- "abcdefghij  "
-                         Drop    => Ada.Strings.Error,
-                         Justify => Ada.Strings.Left);
- 
-       if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
-           Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1");
-       end if;
- 
-       -- Drop = Error, Justify = Right, left overflow characters are pad.
- 
-       ASF.Replace_Slice(Source   => Result_String,
-                         Low      => 1,
-                         High     => Result_String'Last,
-                         By       => Source_String5,     -- "  cdefghijkl"
-                         Drop     => Ada.Strings.Error,
-                         Justify  => Ada.Strings.Right);
- 
-       if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
-          Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2");
-       end if;
- 
-       -- In other cases of Drop=Error, Length_Error is propagated, such as:
- 
-       begin
- 
-          ASF.Replace_Slice(Source   => Result_String,
-                            Low      => 1,
-                            High     => Result_String'Last,
-                            By       => Source_String3,    -- "abcdefghijkl"
-                            Drop     => Ada.Strings.Error);
- 
-           Report.Failed("Length_Error not raised by Replace_Slice - 1");
- 
-       exception
-          when Ada.Strings.Length_Error => null;   -- OK
-          when others =>
-             Report.Failed("Incorrect exception from Replace_Slice - 3");
-       end;
- 
- 
-       -- Function Replace_Slice
- 
-       TC_Set_Name ("Replace_Slice");
- 
-       if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x"))
-                                            /= "abxde"  or -- High = Low
-          TC_Check (ASF.Replace_Slice("abc",   2, 3, "xyz")) /= "axyz"   or
-          TC_Check (ASF.Replace_Slice("abcd",  4, 1, "xy"))
-                                            /= "abcxyd" or -- High < Low
-          TC_Check (ASF.Replace_Slice("abc",   2, 3, "x"))   /= "ax"     or
-          TC_Check (ASF.Replace_Slice("a",     1, 1, "z"))   /= "z"
-       then
-          Report.Failed("Incorrect result from Function Replace_Slice - 1");
-       end if;
- 
-       if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z"))
-                                            /= "abcdz" or  -- By length 1
-          TC_Check (ASF.Replace_Slice("abc",   1, 3, "xyz"))
-                                            /= "xyz"   or  -- High > Low
-          TC_Check (ASF.Replace_Slice("abc",   3, 2, "xy"))
-                                            /= "abxyc" or  -- insert
-          TC_Check (ASF.Replace_Slice("a",     1, 1, "xyz")) /= "xyz"
-       then
-          Report.Failed("Incorrect result from Function Replace_Slice - 2");
-       end if;
- 
- 
- 
-       -- Function Insert.
- 
-       TC_Set_Name ("Insert");
- 
-       declare
-          New_String : constant String :=
-            TC_Check (
-               ASF.Insert(Source   => Source_String1(2..5),    -- "bcde"
-                          Before   => 3,
-                          New_Item => Source_String2));         -- "abcdef"
-       begin
-          if New_String /= "babcdefcde" then
-             Report.Failed("Incorrect result from Function Insert - 1");
-          end if;
-       end;
- 
-       if TC_Check (ASF.Insert("a",   1, "z")) /= "za"   or
-          TC_Check (ASF.Insert("abc", 3, ""))  /= "abc"  or
-          TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc"
-       then
-          Report.Failed("Incorrect result from Function Insert - 2");
-       end if;
- 
-       begin
-          if TC_Check (ASF.Insert(Source   => Source_String1(2..5), -- "bcde"
-                          Before   => Report.Ident_Int(7),
-                          New_Item => Source_String2))         -- "abcdef"
-                 /= "babcdefcde" then
-             Report.Failed("Index_Error not raised by Insert - 3A");
-          else
-             Report.Failed("Index_Error not raised by Insert - 3B");
-          end if;
-       exception
-          when Ada.Strings.Index_Error => null; -- OK, expected exception.
-          when others                  =>
-             Report.Failed("Incorrect exception from Insert - 3");
-       end;
- 
- 
-       -- Procedure Insert
- 
-       -- Drop = Right
- 
-       ASF.Insert(Source   => Insert_String,
-                  Before   => 6,
-                  New_Item => Source_String2,       -- "abcdef"
-                  Drop     => Ada.Strings.Right);
- 
-       if Insert_String /= "     abcde" then  -- last char of New_Item dropped.
-          Report.Failed("Incorrect result from Insert with Drop = Right");
-       end if;
- 
-       -- Drop = Left
- 
-       ASF.Insert(Source   => Insert_String,     -- 10 char string
-                  Before   => 2,                 -- 9 chars, 2..10 available
-                  New_Item => Source_String3,    -- 12 characters long.
-                  Drop     => Ada.Strings.Left); -- truncate from Left.
- 
-       if Insert_String /= "l    abcde" then     -- 10 chars, leading blank.
-           Report.Failed("Incorrect result from Insert with Drop=Left");
-       end if;
- 
-       -- Drop = Error
- 
-       begin
-          ASF.Insert(Source   => Result_String,       -- 10 chars
-                     Before   => Result_String'Last,
-                     New_Item => "abcdefghijk",
-                     Drop     => Ada.Strings.Error);
-          Report.Failed("Exception not raised by Procedure Insert");
-       exception
-          when Ada.Strings.Length_Error => null; -- OK, expected exception
-          when others                   =>
-            Report.Failed("Incorrect exception raised by Procedure Insert");
-       end;
- 
- 
- 
-       -- Function Overwrite
- 
-       TC_Set_Name ("Overwrite");
- 
-       Overwrite_String := TC_Check (
-           ASF.Overwrite(Result_String,  -- 10 chars
-                         1,              -- starting at pos=1
-                         Source_String3(1..10)));
- 
-       if Overwrite_String /= Source_String3(1..10) then
-          Report.Failed("Incorrect result from Function Overwrite - 1");
-       end if;
- 
- 
-       if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or
-          TC_Check (ASF.Overwrite("a",      1, "xyz"))
-                                            /= "xyz"    or  -- chars appended
-          TC_Check (ASF.Overwrite("abc",    3, "   "))
-                                            /= "ab   "  or  -- blanks appended
-          TC_Check (ASF.Overwrite("abcde",  1, "z"  )) /= "zbcde"
-       then
-          Report.Failed("Incorrect result from Function Overwrite - 2");
-       end if;
- 
- 
- 
-       -- Procedure Overwrite, with truncation.
- 
-       ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
-                     Position => 1,
-                     New_Item => Source_String3,      -- 12 characters.
-                     Drop     => Ada.Strings.Left);
- 
-       if Overwrite_String /= "cdefghijkl" then
-          Report.Failed("Incorrect result from Overwrite with Drop=Left");
-       end if;
- 
-       -- The default drop value is Right, used here.
- 
-       ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
-                     Position => 1,
-                     New_Item => Source_String3);     -- 12 characters.
- 
-       if Overwrite_String /= "abcdefghij" then
-          Report.Failed("Incorrect result from Overwrite with Drop=Right");
-       end if;
- 
-       -- Drop = Error
- 
-       begin
-          ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
-                        Position => 1,
-                        New_Item => Source_String3,      -- 12 characters.
-                        Drop     => Ada.Strings.Error);
-          Report.Failed("Exception not raised by Procedure Overwrite");
-       exception
-          when Ada.Strings.Length_Error => null; -- OK, expected exception.
-          when others                   =>
-             Report.Failed
-               ("Incorrect exception raised by Procedure Overwrite");
-       end;
- 
-       Overwrite_String := "ababababab";
-       ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z");
-       ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z");
-       ASF.Overwrite(Overwrite_String, 5, "zz");
- 
-       if Overwrite_String /= "zbabzzabaz" then
-          Report.Failed("Incorrect result from Procedure Overwrite");
-       end if;
- 
- 
- 
-       -- Function Delete
- 
-       TC_Set_Name ("Delete");
- 
-       declare
-          New_String1 : constant String :=    -- This returns a 4 char string.
-            TC_Check (ASF.Delete(Source  => Source_String3,
-                                 From    => 3,
-                                 Through => 10));
-          New_String2 : constant String :=    -- This returns Source.
-            TC_Check (ASF.Delete(Source_String3, 10, 3));
-       begin
-            if New_String1 /= "abkl"  or
-               New_String2 /= Source_String3
-            then
-                Report.Failed("Incorrect result from Function Delete - 1");
-            end if;
-       end;
- 
-       if TC_Check (ASF.Delete("a",   1, 1))
-                               /= ""    or     -- Source length = 1
-          TC_Check (ASF.Delete("abc", 1, 2))
-                               /= "c"   or     -- From = Source'First
-          TC_Check (ASF.Delete("abc", 3, 3))
-                               /= "ab"  or     -- From = Source'Last
-          TC_Check (ASF.Delete("abc", 3, 1))
-                               /= "abc"        -- From > Through
-       then
-          Report.Failed("Incorrect result from Function Delete - 2");
-       end if;
- 
- 
- 
-       -- Procedure Delete
- 
-       -- Justify = Left
- 
-       Delete_String := Source_String3(1..10);  -- Initialize to "abcdefghij"
- 
-       ASF.Delete(Source  => Delete_String,
-                  From    => 6,
-                  Through => Delete_String'Last,
-                  Justify => Ada.Strings.Left,
-                  Pad     => 'x');              -- pad with char 'x'
- 
-       if Delete_String /= "abcdexxxxx" then
-           Report.Failed("Incorrect result from Delete - Justify = Left");
-       end if;
- 
-       -- Justify = Right
- 
-       ASF.Delete(Source  => Delete_String,      -- Remove x"s from end and
-                  From    => 6,                  -- shift right.
-                  Through => Delete_String'Last,
-                  Justify => Ada.Strings.Right,
-                  Pad     => 'x');               -- pad with char 'x' on left.
- 
-       if Delete_String /= "xxxxxabcde" then
-           Report.Failed("Incorrect result from Delete - Justify = Right");
-       end if;
- 
-       -- Justify = Center
- 
-       ASF.Delete(Source  => Delete_String,
-                  From    => 1,
-                  Through => 5,
-                  Justify => Ada.Strings.Center,
-                  Pad     => 'z');
- 
-       if Delete_String /= "zzabcdezzz" then  -- extra pad char on right side.
-           Report.Failed("Incorrect result from Delete - Justify = Center");
-       end if;
- 
- 
- 
-       -- Function Trim
-       -- Use non-identity character sets to perform the trim operation.
- 
-       TC_Set_Name ("Trim");
- 
-       Trim_String := "cdabcdefcd";
- 
-       -- Remove the "cd" from each end of the string.  This will not effect
-       -- the "cd" slice at 5..6.
- 
-       declare
-          New_String : constant String :=
-            TC_Check (ASF.Trim(Source => Trim_String,
-                               Left => CD_Set, Right => CD_Set));
-       begin
-          if New_String /= Source_String2 then    -- string "abcdef"
-             Report.Failed("Incorrect result from Trim with character sets");
-          end if;
-       end;
- 
-       if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set))
-              /= "abcdef" then
-          Report.Failed("Incorrect result from Trim with Null sets");
-       end if;
- 
-       if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then
-          Report.Failed("Incorrect result from Trim, string removal");
-       end if;
- 
- 
-       -- Procedure Trim
- 
-       -- Justify = Right
- 
-       ASF.Trim(Source  => Trim_String,
-                Left    => CD_Set,
-                Right   => CD_Set,
-                Justify => Ada.Strings.Right,
-                Pad     => 'x');
- 
-       if Trim_String /= "xxxxabcdef" then
-          Report.Failed("Incorrect result from Trim with Justify = Right");
-       end if;
- 
-       -- Justify = Left
- 
-       ASF.Trim(Source  => Trim_String,
-                Left    => X_Set,
-                Right   => Maps.Null_Set,
-                Justify => Ada.Strings.Left,
-                Pad     => Ada.Strings.Space);
- 
-       if Trim_String /= "abcdef    " then  -- Padded with 4 blanks on right.
-          Report.Failed("Incorrect result from Trim with Justify = Left");
-       end if;
- 
-       -- Justify = Center
- 
-       ASF.Trim(Source  => Trim_String,
-                Left    => ABCD_Set,
-                Right   => CD_Set,
-                Justify => Ada.Strings.Center,
-                Pad     => 'x');
- 
-       if Trim_String /= "xxef    xx" then  -- Padded with 2 pad chars on L/R
-          Report.Failed("Incorrect result from Trim with Justify = Center");
-       end if;
- 
- 
- 
-       -- Function Head, demonstrating use of padding.
- 
-       TC_Set_Name ("Head");
- 
-       -- Use the characters of Source_String1 ("abcde") and pad the
-       -- last five characters of Result_String with 'x' characters.
- 
- 
-       Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x'));
- 
-       if Result_String /= "abcdexxxxx" then
-          Report.Failed("Incorrect result from Function Head with padding");
-       end if;
- 
-       if TC_Check (ASF.Head("  ab  ", 2))        /= "  "     or
-          TC_Check (ASF.Head("a", 6, 'A'))        /= "aAAAAA" or
-          TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc"    or
-          TC_Check (ASF.Head(ASF.Head("abc  ", 7, 'x'), 10, 'X'))
-                    /= "abc  xxXXX"
-       then
-          Report.Failed("Incorrect result from Function Head");
-       end if;
- 
- 
- 
-       -- Function Tail, demonstrating use of padding.
- 
-       TC_Set_Name ("Tail");
- 
-       -- Use the characters of Source_String1 ("abcde") and pad the
-       -- first five characters of Result_String with 'x' characters.
- 
-       Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x'));
- 
-       if Result_String /= "xxxxxabcde" then
-          Report.Failed("Incorrect result from Function Tail with padding");
-       end if;
- 
-       if TC_Check (ASF.Tail("abcde  ", 5))
-                             /= "cde  "    or  -- blanks, back
-          TC_Check (ASF.Tail("  abc ",  8, ' '))
-                             /= "    abc " or  -- blanks, front/back
-          TC_Check (ASF.Tail("",        5, 'Z'))
-                             /= "ZZZZZ"    or  -- pad characters only
-          TC_Check (ASF.Tail("abc",     0))
-                             /= ""         or  -- null result
-          TC_Check (ASF.Tail("abcdefgh", 3))
-                             /= "fgh"      or
-          TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'),
-                   10,
-                   'X'))              /= "XXXXx abc "
-       then
-          Report.Failed("Incorrect result from Function Tail");
-       end if;
- 
- 
-       -- Function "*"  - with (Natural, String) parameters
- 
-       TC_Set_Name ("""*""");
- 
-       if TC_Check (ASF."*"(3, Source_String1))       /= "abcdeabcdeabcde"  or
-          TC_Check (ASF."*"(2, Source_String2))       /= Source_String6     or
-          TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab"         or
-          TC_Check (ASF."*"(0, Source_String1))       /= ""
-       then
-          Report.Failed("Incorrect result from Function ""*"" with strings");
-       end if;
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,319 ****
- -- CXA4006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Bounded are
- --      available, and that they produce correct results. Specifically, check 
- --      the subprograms Length, Slice, "&", To_Bounded_String, Append, Index, 
- --      To_String, Replace_Slice, Trim, Overwrite, Delete, Insert, and 
- --      Translate.
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of a variety of the string functions
- --      found in the package Ada.Strings.Bounded, simulating the operations
- --      found in a text processing package.  
- --      With bounded strings, the length of each "line" of text can vary up
- --      to the instantiated maximum, allowing one to view a page of text as
- --      a series of expandable lines.  This provides flexibility in text
- --      formatting of individual lines (strings).
- --      Several subprograms are defined, all of which attempt to take advantage
- --      of as many different bounded string utilities as possible.  Often, 
- --      an operation that is being performed in a subprogram using a certain
- --      bounded string utility could more efficiently be performed using a
- --      a different utility.  However, in the interest of including as broad
- --      coverage as possible, a mixture of utilities is invoked in this test.
- --      A simulated page of text is provided as a parameter to the test 
- --      defined subprograms, and the appropriate processing performed.  The
- --      processed page of text is then compared to a predefined "finished"
- --      page, and test passage/failure is based on the results of this 
- --      comparison.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Strings;
- with Ada.Strings.Bounded;
- with Ada.Strings.Maps;
- with Report;
- 
- procedure CXA4006 is
- 
- begin
- 
-    Report.Test ("CXA4006", "Check that the subprograms defined in package "  &
-                            "Ada.Strings.Bounded are available, and that "    &
-                            "they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       Characters_Per_Line : constant Positive := 40;
-       Lines_Per_Page      : constant Natural  :=  4;
- 
-       package BS_40 is new 
-         Ada.Strings.Bounded.Generic_Bounded_Length(Characters_Per_Line);
-       use type BS_40.Bounded_String;
- 
-       type Page_Type is array (1..Lines_Per_Page) of BS_40.Bounded_String;
- 
-       -- Note: Misspellings below are intentional.
- 
-       Line1 : BS_40.Bounded_String := 
-         BS_40.To_Bounded_String("ada is a progrraming language designed");
-       Line2 : BS_40.Bounded_String := 
-         BS_40.To_Bounded_String("to support the construction of long-");
-       Line3 : BS_40.Bounded_String := 
-         BS_40.To_Bounded_String("lived, highly reliabel software ");
-       Line4 : BS_40.Bounded_String := 
-         BS_40.To_Bounded_String("systems");
- 
-       Page  : Page_Type := (1 => Line1, 2 => Line2, 3 => Line3, 4 => Line4);
- 
-       Finished_Page : Page_Type :=  
-         (BS_40.To_Bounded_String("Ada is a programming language designed"),
-          BS_40.To_Bounded_String("to support the construction of long-"),
-          BS_40.To_Bounded_String("lived, HIGHLY RELIABLE software systems."),
-          BS_40.To_Bounded_String(""));
- 
-       ---
- 
-       procedure Compress (Page : in out Page_Type) is
-          Clear_Line : Natural := Lines_Per_Page;
-       begin
-          -- If two consecutive lines on the page are together less than the
-          -- maximum line length, then append those two lines, move up all
-          -- lower lines on the page, and blank out the last line.
-          for i in 1..Lines_Per_Page - 1 loop
-             if BS_40.Length(Page(i)) + BS_40.Length(Page(i+1)) <=
-                BS_40.Max_Length
-             then
-                Page(i) := BS_40."&"(Page(i), 
-                                     Page(i+1));       -- "&" (bounded, bounded)
- 
-                for j in i+1..Lines_Per_Page - 1 loop
-                   Page(j) := 
-                     BS_40.To_Bounded_String
-                       (BS_40.Slice(Page(j+1), 
-                                    1, 
-                                    BS_40.Length(Page(j+1))));
-                   Clear_Line := j + 1;
-                end loop;
-                Page(Clear_Line) := BS_40.Null_Bounded_String;
-             end if;
-          end loop;
-       end Compress;
- 
-       ---
- 
-       procedure Format (Page : in out Page_Type) is
-          Sm_Ada   : BS_40.Bounded_String := BS_40.To_Bounded_String("ada");
-          Cap_Ada  : constant String      := "Ada";
-          Char_Pos : Natural := 0;
-          Finished : Boolean := False;
-          Line     : Natural := Page_Type'Last;
-       begin
- 
-          -- Add a period to the end of the last line.
-          while Line >= Page_Type'First and not Finished loop
-             if Page(Line) /= BS_40.Null_Bounded_String      and
-                BS_40.Length(Page(Line)) <= BS_40.Max_Length
-             then
-                Page(Line) := BS_40.Append(Page(Line), '.');
-                Finished := True;
-             end if;
-             Line := Line - 1;
-          end loop;
- 
-          -- Replace all occurrences of "ada" with "Ada".
-          for Line in Page_Type'First .. Page_Type'Last loop
-             Finished := False;
-             while not Finished loop
-                Char_Pos := BS_40.Index(Source  => Page(Line),
-                                        Pattern => BS_40.To_String(Sm_Ada),
-                                        Going   => Ada.Strings.Backward);
-                -- A zero is returned by function Index if no occurrences of
-                -- the pattern string are found.
-                Finished := (Char_Pos = 0);
-                if not Finished then
-                   BS_40.Replace_Slice
-                     (Source => Page(Line),
-                      Low    => Char_Pos,
-                      High   => Char_Pos + BS_40.Length(Sm_Ada) - 1,
-                      By     => Cap_Ada);
-                end if;
-             end loop;   -- while loop
-          end loop;      -- for loop
- 
-       end Format;
- 
-       ---
- 
-       procedure Spell_Check (Page : in out Page_Type) is
-          type Spelling_Type is (Incorrect, Correct);
-          type Word_Array_Type is array (Spelling_Type) 
-            of BS_40.Bounded_String;
-          type Dictionary_Type is array (1..2) of Word_Array_Type;
- 
-          -- Note that the "words" in the dictionary will require various
-          -- amounts of Trimming prior to their use in the string functions.
-          Dictionary : Dictionary_Type := 
-                       (1 => (BS_40.To_Bounded_String("  reliabel          "),  
-                              BS_40.To_Bounded_String("       reliable   ")),
-                        2 => (BS_40.To_Bounded_String("  progrraming  "),
-                              BS_40.To_Bounded_String(" programming ")));
- 
-          Pos      : Natural := Natural'First;
-          Finished : Boolean := False;
- 
-       begin
- 
-          for Line in Page_Type'Range loop
- 
-             -- Search for the first incorrectly spelled word in the Dictionary,
-             -- if it is found, replace it with the correctly spelled word,
-             -- using the Overwrite function.
- 
-             while not Finished loop
-                Pos := 
-                  BS_40.Index(Page(Line),
-                              BS_40.To_String(
-                                BS_40.Trim(Dictionary(1)(Incorrect),
-                                           Ada.Strings.Both)),
-                              Ada.Strings.Forward);
-                Finished := (Pos = 0);
-                if not Finished then
-                   Page(Line) := 
-                     BS_40.Overwrite(Page(Line),
-                                     Pos,
-                                     BS_40.To_String
-                                       (BS_40.Trim(Dictionary(1)(Correct),
-                                                   Ada.Strings.Both)));
-                end if;
-             end loop;
- 
-             Finished := False;
- 
-             -- Search for the second incorrectly spelled word in the
-             -- Dictionary, if it is found, replace it with the correctly 
-             -- spelled word, using the Delete procedure and Insert function.
- 
-             while not Finished loop
-                Pos := 
-                  BS_40.Index(Page(Line),
-                              BS_40.To_String(
-                                BS_40.Trim(Dictionary(2)(Incorrect),
-                                           Ada.Strings.Both)),
-                              Ada.Strings.Forward);
- 
-                Finished := (Pos = 0);
- 
-                if not Finished then
-                   BS_40.Delete
-                     (Page(Line),
-                      Pos,
-                      Pos + BS_40.To_String
-                              (BS_40.Trim(Dictionary(2)(Incorrect),
-                                          Ada.Strings.Both))'Length-1);
-                   Page(Line) := 
-                     BS_40.Insert(Page(Line),
-                                  Pos,
-                                  BS_40.To_String
-                                       (BS_40.Trim(Dictionary(2)(Correct),
-                                                   Ada.Strings.Both)));
-                end if;
-             end loop;
- 
-             Finished := False;
- 
-          end loop;
-       end Spell_Check;
- 
-       ---
- 
-       procedure Bold (Page : in out Page_Type) is
-          Key_Word     : constant String := "highly reliable";
-          Bold_Mapping : constant Ada.Strings.Maps.Character_Mapping :=
-            Ada.Strings.Maps.To_Mapping(From => " abcdefghijklmnopqrstuvwxyz",
-                                        To   => " ABCDEFGHIJKLMNOPQRSTUVWXYZ");
-          Pos      : Natural := Natural'First;
-          Finished : Boolean := False;
-       begin
-          -- This procedure is designed to change the case of the phrase
-          -- "highly reliable" into upper case (a type of "Bolding").
-          -- All instances of the phrase on all lines of the page will be
-          -- modified.
- 
-          for Line in Page_Type'First .. Page_Type'Last loop
-             while not Finished loop
-                Pos := BS_40.Index(Page(Line), Key_Word);
-                Finished := (Pos = 0);
-                if not Finished then
- 
-                   BS_40.Overwrite
-                          (Page(Line),
-                           Pos,
-                           BS_40.To_String
-                             (BS_40.Translate
-                                (BS_40.To_Bounded_String
-                                    (BS_40.Slice(Page(Line),
-                                                 Pos,  
-                                                 Pos + Key_Word'Length - 1)),
-                                 Bold_Mapping)));
- 
-                end if;
-             end loop;
-             Finished := False;
-          end loop;
-       end Bold;
- 
- 
-    begin
- 
-       Compress(Page);
-       Format(Page); 
-       Spell_Check(Page);
-       Bold(Page);
- 
-       for i in 1..Lines_Per_Page loop
-          if BS_40.To_String(Page(i)) /= BS_40.To_String(Finished_Page(i)) or
-             BS_40.Length(Page(i))    /= BS_40.Length(Finished_Page(i))
-          then
-             Report.Failed("Incorrect modification of Page, Line " &
-                            Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,334 ****
- -- CXA4007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Bounded are
- --      available, and that they produce correct results. Specifically, check 
- --      the subprograms Append, Count, Element, Find_Token, Head, 
- --      Index_Non_Blank, Replace_Element, Replicate, Tail, To_Bounded_String, 
- --      "&", ">", "<", ">=", "<=", and "*".
- --      
- -- TEST DESCRIPTION:
- --      This test, when taken in conjunction with tests CXA400[6,8,9], will 
- --      constitute a test of all the functionality contained in package
- --      Ada.Strings.Bounded.  This test uses a variety of the
- --      subprograms defined in the bounded string package in ways typical
- --      of common usage.  Different combinations of available subprograms
- --      are used to accomplish similar bounded string processing goals.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      22 Dec 94   SAIC    Changed obsolete constant to Ada.Strings.Space.
- --
- --!
- 
- with Ada.Strings;
- with Ada.Strings.Bounded;
- with Ada.Strings.Maps;
- with Report;
- 
- procedure CXA4007 is
- 
- begin
- 
-    Report.Test ("CXA4007", "Check that the subprograms defined in package " &
-                            "Ada.Strings.Bounded are available, and that "   &
-                            "they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
-       use type BS80.Bounded_String;
- 
-       Part1 : constant String     := "Rum";
-       Part2 : Character           := 'p';
-       Part3 : BS80.Bounded_String := BS80.To_Bounded_String("el");
-       Part4 : Character           := 's';
-       Part5 : BS80.Bounded_String := BS80.To_Bounded_String("tilt");
-       Part6 : String(1..3)        := "ski";
- 
-       Full_Catenate_String,
-       Full_Append_String,  
-       Constructed_String,   
-       Drop_String,
-       Replicated_String,     
-       Token_String         : BS80.Bounded_String;
- 
-       CharA : Character := 'A';          
-       CharB : Character := 'B';
-       CharC : Character := 'C';   
-       CharD : Character := 'D';
-       CharE : Character := 'E';
-       CharF : Character := 'F';
- 
-       ABStr : String(1..15) := "AAAAABBBBBBBBBB";
-       StrB  : String(1..2)  := "BB";
-       StrE  : String(1..2)  := "EE";
- 
- 
-    begin
- 
-       -- Evaluation of the overloaded forms of the "&" operator defined
-       -- for instantiations of Bounded Strings.
- 
-       Full_Catenate_String := 
-         BS80."&"(Part2,                            -- Char & Bnd Str
-                  BS80."&"(Part3,                   -- Bnd Str & Bnd Str
-                           BS80."&"(Part4,          -- Char & Bnd Str
-                                    BS80."&"(Part5, -- Bnd Str & Bnd Str
-                                            BS80.To_Bounded_String(Part6)))));  
-                                                  
-       Full_Catenate_String := 
-         Part1 &  Full_Catenate_String;             -- Str & Bnd Str
-       Full_Catenate_String := 
-         Full_Catenate_String & 'n';                -- Bnd Str & Char
- 
- 
-       -- Evaluation of the overloaded forms of function Append.
- 
-       Full_Append_String := 
-         BS80.Append(Part2,                                      -- Char,Bnd
-                BS80.Append(Part3,                               -- Bnd, Bnd
-                       BS80.Append(Part4,                        -- Char,Bnd
-                              BS80.Append(BS80.To_String(Part5), -- Str,Bnd
-                                          BS80.To_Bounded_String(Part6)))));
- 
-       Full_Append_String := 
-         BS80.Append(BS80.To_Bounded_String(Part1),            -- Bnd , Str
-                     BS80.To_String(Full_Append_String));
- 
-       Full_Append_String := 
-         BS80.Append(Left  => Full_Append_String, 
-                     Right => 'n');                            -- Bnd, Char
- 
- 
-       -- Validate the resulting bounded strings.
- 
-       if Full_Catenate_String < Full_Append_String or
-          Full_Catenate_String > Full_Append_String or
-          not (Full_Catenate_String  = Full_Append_String and
-               Full_Catenate_String <= Full_Append_String and
-               Full_Catenate_String >= Full_Append_String)
-       then
-          Report.Failed("Incorrect results from bounded string catenation" &
-                        " and comparison");
-       end if;
- 
- 
-       -- Evaluate the overloaded forms of the Constructor function "*" and 
-       -- the Replicate function.
- 
-       Constructed_String := 
-         (2 * CharA) &                           -- "AA"
-         (2 * StrB)  &                           -- "AABBBB"
-         (3 * BS80."*"(2, CharC)) &              -- "AABBBBCCCCCC"
-         BS80.Replicate(3, 
-                    BS80.Replicate(2, CharD)) &  -- "AABBBBCCCCCCDDDDDD"
-         BS80.Replicate(2, StrE) &               -- "AABBBBCCCCCCDDDDDDEEEE"
-         BS80.Replicate(2, CharF);               -- "AABBBBCCCCCCDDDDDDEEEEFF"
- 
- 
-       -- Use of Function Replicate that involves dropping characters.  The
-       -- attempt to replicate the 15 character string six times will exceed
-       -- the 80 character bound of the string.  Therefore, the result should
-       -- be the catenation of 5 copies of the 15 character string, followed
-       -- by 5 'A' characters (the first five characters of the 6th
-       -- replication) with the remaining characters of the 6th replication 
-       -- dropped.
- 
-       Drop_String := 
-          BS80.Replicate(Count => 6,                   
-                         Item  => ABStr,              -- "AAAAABBBBBBBBBB"
-                         Drop  => Ada.Strings.Right); 
- 
-       if BS80.Element(Drop_String, 1)  /= 'A' or
-          BS80.Element(Drop_String, 6)  /= 'B' or
-          BS80.Element(Drop_String, 76) /= 'A' or
-          BS80.Element(Drop_String, 80) /= 'A' 
-       then
-          Report.Failed("Incorrect result from Replicate with Drop");
-       end if;
- 
- 
-       -- Use function Index_Non_Blank in the evaluation of the
-       -- Constructed_String.
- 
-       if BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Forward)  /=
-          BS80.To_String(Constructed_String)'First                         or
-          BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Backward) /=
-          BS80.Length(Constructed_String)
-       then
-          Report.Failed("Incorrect results from constructor functions");
-       end if;
- 
- 
- 
-       declare
- 
-          -- Define character set objects for use with the Count function.
-          -- Constructed_String = "AABBBBCCCCCCDDDDDDEEEEFF" from above.
- 
-          A_Set : Ada.Strings.Maps.Character_Set :=
-                  Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,1));
-          B_Set : Ada.Strings.Maps.Character_Set :=
-                  Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,3));
-          C_Set : Ada.Strings.Maps.Character_Set :=
-                  Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,7));
-          D_Set : Ada.Strings.Maps.Character_Set :=
-                  Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,13));
-          E_Set : Ada.Strings.Maps.Character_Set :=
-                  Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,19));
-          F_Set : Ada.Strings.Maps.Character_Set :=
-                  Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,23));
- 
- 
-          Start : Positive;
-          Stop  : Natural  := 0;
- 
-       begin
- 
-          -- Evaluate the results from function Count by comparing the number
-          -- of A's to the number of F's, B's to E's, and C's to D's in the
-          -- Constructed_String.  
-          -- There should be an equal number of each of the characters that 
-          -- are being compared (i.e., 2 A's and F's, 4 B's and E's, etc)
- 
-          if BS80.Count(Constructed_String, A_Set)      /= 
-             BS80.Count(Constructed_String, F_Set)        or
-             BS80.Count(Constructed_String, B_Set)      /= 
-             BS80.Count(Constructed_String, E_Set)        or
-             not (BS80.Count(Constructed_String, C_Set)  =  
-                  BS80.Count(Constructed_String, D_Set))  
-          then
-             Report.Failed("Incorrect result from function Count");
-          end if;
- 
- 
-          -- Evaluate the functions Head, Tail, and Find_Token.
-          -- Create the Token_String from the Constructed_String above.
- 
-          Token_String := 
-            BS80.Tail(BS80.Head(Constructed_String,  3), 2) &     -- "AB" &
-            BS80.Head(BS80.Tail(Constructed_String, 13), 2) &     -- "CD" &
-            BS80.Head(BS80.Tail(Constructed_String,  3), 2);      -- "EF"
- 
-          if Token_String /= BS80.To_Bounded_String("ABCDEF") then
-             Report.Failed("Incorrect result from Catenation of Token_String");
-          end if;
- 
- 
-          -- Find the starting/ending position of the first A in the 
-          -- Token_String (both should be 1, only one A appears in string).
-          -- The Function Head uses the default pad character to return a
-          -- bounded string longer than its input parameter bounded string.
- 
-          BS80.Find_Token(BS80.Head(Token_String, 10),  -- Default pad.
-                          A_Set,
-                          Ada.Strings.Inside,
-                          Start,
-                          Stop);
- 
-          if Start /= 1 and Stop /= 1 then
-             Report.Failed("Incorrect result from Find_Token - 1");
-          end if;
- 
- 
-          -- Find the starting/ending position of the first non-AB slice in
-          -- the "head" five characters of Token_String (slice CDE at 
-          -- positions 3-5)
- 
-          BS80.Find_Token(BS80.Head(Token_String, 5),            -- "ABCDE"
-                          Ada.Strings.Maps."OR"(A_Set, B_Set),   -- Set (AB)
-                          Ada.Strings.Outside,
-                          Start,
-                          Stop);
- 
-          if Start /= 3 and Stop /= 5 then
-             Report.Failed("Incorrect result from Find_Token - 2");
-          end if;
- 
- 
-          -- Find the starting/ending position of the first CD slice in
-          -- the "tail" eight characters (including two pad characters) 
-          -- of Token_String (slice CD at positions 5-6 of the tail 
-          -- portion specified)
- 
-          BS80.Find_Token(BS80.Tail(Token_String, 8, 
-                                    Ada.Strings.Space),         -- "  ABCDEF"
-                          Ada.Strings.Maps."OR"(C_Set, D_Set),  -- Set (CD)
-                          Ada.Strings.Inside,
-                          Start,
-                          Stop);
- 
-          if Start /= 5 and Stop /= 6 then
-             Report.Failed("Incorrect result from Find_Token - 3");
-          end if;
- 
- 
-          -- Evaluate the Replace_Element procedure.
- 
-          -- Token_String = "ABCDEF"
- 
-          BS80.Replace_Element(Token_String, 3, BS80.Element(Token_String,4));
- 
-          -- Token_String = "ABDDEF"
- 
-          BS80.Replace_Element(Source => Token_String,
-                               Index  => 2,
-                               By     => BS80.Element(Token_String, 5));
- 
-          -- Token_String = "AEDDEF"
- 
-          BS80.Replace_Element(Token_String, 
-                               1, 
-                               BS80.Element(BS80.Tail(Token_String, 2), 2));
- 
-          -- Token_String = "FEDDEF"
-          -- Evaluate this result.
- 
-          if BS80.Element(Token_String, BS80.To_String(Token_String)'First) /=
-             BS80.Element(Token_String, BS80.To_String(Token_String)'Last)  or
-             BS80.Count(Token_String, D_Set)                                /=
-             BS80.Count(Token_String, E_Set)                                or
-             BS80.Index_Non_Blank(BS80.Head(Token_String,6))                /=
-             BS80.Index_Non_Blank(BS80.Tail(Token_String,6))                or
-             BS80.Head(Token_String, 1)                                     /=
-             BS80.Tail(Token_String, 1)
-          then
-             Report.Failed("Incorrect result from operations in combination");
-          end if;
- 
-       end;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,662 ****
- -- CXA4008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Bounded are
- --      available, and that they produce correct results, especially under
- --      conditions where truncation of the result is required.  Specifically, 
- --      check the subprograms Append, Count with non-Identity maps, Index with 
- --      non-Identity maps, Index with Set parameters, Insert (function and
- --      procedure), Replace_Slice (function and procedure), To_Bounded_String, 
- --      and Translate.
- --
- -- TEST DESCRIPTION:
- --      This test, in conjunction with tests CXA4006, CXA4007, and CXA4009, 
- --      will provide coverage of the most common usages of the functionality
- --      found in the Ada.Strings.Bounded package.  It deals in large part
- --      with truncation effects and options.  This test contains many small, 
- --      specific test cases, situations that are often difficult to generate 
- --      in large numbers in an application-based test.  These cases represent 
- --      specific usage paradigms in-the-small.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 95   SAIC    Corrected acceptance condition of subtest for
- --                          Function Append with Truncation = Left.
- --      31 Oct 95   SAIC    Update and repair for ACVC 2.0.1.
- --
- --!
- 
- with Report;
- with Ada.Strings.Maps.Constants;
- with Ada.Strings.Bounded;
- with Ada.Strings.Maps;
- 
- procedure CXA4008 is
- 
- begin
- 
-    Report.Test("CXA4008", "Check that the subprograms defined in "      &
-                           "package Ada.Strings.Bounded are available, " &
-                           "and that they produce correct results, "     &
-                           "especially under conditions where "          &
-                           "truncation of the result is required");
- 
-    Test_Block:
-    declare
- 
-       package AS   renames Ada.Strings;
-       package ASB  renames Ada.Strings.Bounded;
-       package ASC  renames Ada.Strings.Maps.Constants;
-       package Maps renames Ada.Strings.Maps;
- 
-       package B10 is new ASB.Generic_Bounded_Length(Max => 10);
-       use type B10.Bounded_String;
- 
-       Result_String : B10.Bounded_String;
-       Test_String   : B10.Bounded_String;
-       AtoE_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("abcde");
-       FtoJ_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("fghij");
-       AtoJ_Bnd_Str  : B10.Bounded_String := 
-                         B10.To_Bounded_String("abcdefghij");
- 
-       Location     : Natural := 0;
-       Total_Count  : Natural := 0;
- 
-       CD_Set       : Maps.Character_Set := Maps.To_Set("cd"); 
- 
-       AB_to_YZ_Map : Maps.Character_Mapping :=
-                        Maps.To_Mapping(From =>  "ab",  To => "yz");
- 
-       CD_to_XY_Map : Maps.Character_Mapping :=
-                        Maps.To_Mapping(From =>  "cd",  To => "xy");
- 
- 
-    begin
-       -- Function To_Bounded_String with Truncation
-       -- Evaluate the function Append with parameters that will 
-       -- cause the truncation of the result.
- 
-       -- Drop = Error (default case, Length_Error will be raised)
- 
-       begin
-          Test_String := 
-            B10.To_Bounded_String("Much too long for this bounded string");
-          Report.Failed("Length Error not raised by To_Bounded_String");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          =>
-            Report.Failed("Incorrect exception raised by To_Bounded_String");
-       end;
- 
-       -- Drop = Left 
- 
-       Test_String := B10.To_Bounded_String(Source => "abcdefghijklmn",
-                                            Drop   => Ada.Strings.Left);
- 
-       if Test_String /= B10.To_Bounded_String("efghijklmn") then
-          Report.Failed
-            ("Incorrect result from To_Bounded_String, Drop = Left");
-       end if;
- 
-       -- Drop = Right 
- 
-       Test_String := B10.To_Bounded_String(Source => "abcdefghijklmn",
-                                            Drop   => Ada.Strings.Right);
- 
-       if not(Test_String = AtoJ_Bnd_Str) then
-          Report.Failed
-            ("Incorrect result from To_Bounded_String, Drop = Right");
-       end if;
- 
- 
- 
- 
-       -- Function Append with Truncation
-       -- Evaluate the function Append with parameters that will 
-       -- cause the truncation of the result.
- 
-       -- Drop = Error (default case, Length_Error will be raised)
- 
-       begin
-          -- Append (Bnd Str, Bnd Str);
-          Result_String := 
-            B10.Append(B10.To_Bounded_String("abcde"),
-                       B10.To_Bounded_String("fghijk")); -- 11 char
-          Report.Failed("Length_Error not raised by Append - 1");
-       exception
-          when AS.Length_Error => null;   -- OK, correct exception raised.
-          when others          =>
-             Report.Failed("Incorrect exception raised by Append - 1");
-       end;
- 
-       begin
-          -- Append (Str, Bnd Str);
-          Result_String := B10.Append(B10.To_String(AtoE_Bnd_Str),
-                                      B10.To_Bounded_String("fghijk"),
-                                      AS.Error); 
-          Report.Failed("Length_Error not raised by Append - 2");
-       exception
-          when AS.Length_Error => null;   -- OK, correct exception raised.
-          when others          =>
-             Report.Failed("Incorrect exception raised by Append - 2");
-       end;
- 
-       begin
-          -- Append (Bnd Str, Char);
-          Result_String := 
-            B10.Append(B10.To_Bounded_String("abcdefghij"), 'k');
-          Report.Failed("Length_Error not raised by Append - 3");
-       exception
-          when AS.Length_Error => null;   -- OK, correct exception raised.
-          when others          =>
-             Report.Failed("Incorrect exception raised by Append - 3");
-       end;
- 
-       -- Drop = Left 
- 
-       -- Append (Bnd Str, Bnd Str)
-       Result_String := B10.Append(B10.To_Bounded_String("abcdefgh"), -- 8 chs
-                                   B10.To_Bounded_String("ijklmn"),   -- 6 chs
-                                   Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_String("efghijklmn") then -- 10 chars
-          Report.Failed("Incorrect truncation performed by Append - 4");
-       end if;
- 
-       -- Append (Bnd Str, Str)
-       Result_String := 
-         B10.Append(B10.To_Bounded_String("abcdefghij"), 
-                    "xyz",
-                    Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_String("defghijxyz") then
-          Report.Failed("Incorrect truncation performed by Append - 5");
-       end if;
- 
-       -- Append (Char, Bnd Str)
- 
-       Result_String := B10.Append('A', 
-                                   B10.To_Bounded_String("abcdefghij"),
-                                   Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_String("abcdefghij") then
-          Report.Failed("Incorrect truncation performed by Append - 6");
-       end if;
- 
-       -- Drop = Right 
- 
-       -- Append (Bnd Str, Bnd Str)
-       Result_String := B10.Append(FtoJ_Bnd_Str, 
-                                   AtoJ_Bnd_Str,
-                                   Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_String("fghijabcde") then
-          Report.Failed("Incorrect truncation performed by Append - 7");
-       end if;
- 
-       -- Append (Str, Bnd Str)
-       Result_String := B10.Append(B10.To_String(AtoE_Bnd_Str), 
-                                   AtoJ_Bnd_Str,
-                                   Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_String("abcdeabcde") then
-          Report.Failed("Incorrect truncation performed by Append - 8");
-       end if;
- 
-       -- Append (Char, Bnd Str)
-       Result_String := B10.Append('A', AtoJ_Bnd_Str, Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_String("Aabcdefghi") then
-          Report.Failed("Incorrect truncation performed by Append - 9");
-       end if;
- 
- 
-       -- Function Index with non-Identity map.
-       -- Evaluate the function Index with a non-identity map 
-       -- parameter which will cause mapping of the source parameter 
-       -- prior to the evaluation of the index position search.
- 
-       Location := B10.Index(Source  => AtoJ_Bnd_Str,   -- "abcdefghij"
-                             Pattern => "xy",
-                             Going   => Ada.Strings.Forward,
-                             Mapping => CD_to_XY_Map);  -- change "cd" to "xy"
- 
-       if Location /= 3 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 1");
-       end if;
- 
-       Location := B10.Index(B10.To_Bounded_String("AND IF MAN"),
-                             "an",
-                             Ada.Strings.Backward,
-                             ASC.Lower_Case_Map); 
- 
-       if Location /= 9 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 2");
-       end if;
- 
-       Location := B10.Index(Source  => B10.To_Bounded_String("The the"),
-                             Pattern => "the",
-                             Going   => Ada.Strings.Forward,
-                             Mapping => ASC.Lower_Case_Map); 
- 
-       if Location /= 1 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 3");
-       end if;
- 
- 
-       if B10.Index(B10.To_Bounded_String("abcd"),        -- Pattern = Source
-                    "abcd")                       /= 1 or
-          B10.Index(B10.To_Bounded_String("abc"),         -- Pattern < Source
-                    "abcd")                       /= 0 or
-          B10.Index(B10.Null_Bounded_String,              -- Source = Null
-                    "abc")                        /= 0 
-       then
-          Report.Failed("Incorrect result from Index with string patterns");
-       end if;
- 
- 
-       -- Function Index (for Sets).
-       -- This version of Index uses Sets as the basis of the search.
- 
-       -- Test = Inside, Going = Forward  (Default case).
-       Location := 
-         B10.Index(Source => B10.To_Bounded_String("abcdeabcde"),
-                   Set    => CD_Set,  -- set containing 'c' and 'd'
-                   Test   => Ada.Strings.Inside,
-                   Going  => Ada.Strings.Forward);
- 
-       if not (Location = 3) then     -- position of first 'c' in source.
-          Report.Failed("Incorrect result from Index using Sets - 1");
-       end if;
- 
-       -- Test = Inside, Going = Backward.
-       Location := 
-         B10.Index(Source => B10."&"(AtoE_Bnd_Str, AtoE_Bnd_Str), 
-                   Set    => CD_Set,  -- set containing 'c' and 'd'
-                   Test   => Ada.Strings.Inside,
-                   Going  => Ada.Strings.Backward);
- 
-       if not (Location = 9) then   -- position of last 'd' in source.
-          Report.Failed("Incorrect result from Index using Sets - 2");
-       end if;
- 
-       -- Test = Outside, Going = Forward.
-       Location := B10.Index(B10.To_Bounded_String("deddacd"),  
-                             CD_Set,
-                             Test  => Ada.Strings.Outside,
-                             Going => Ada.Strings.Forward);
- 
-       if Location /= 2  then  -- position of 'e' in source.
-          Report.Failed("Incorrect result from Index using Sets - 3");
-       end if;
- 
-       -- Test = Outside, Going = Backward.
-       Location := B10.Index(B10.To_Bounded_String("deddacd"),
-                             CD_Set,
-                             Ada.Strings.Outside,
-                             Ada.Strings.Backward);
- 
-       if Location /= 5 then                      -- correct position of 'a'.
-          Report.Failed("Incorrect result from Index using Sets - 4");
-       end if;
- 
-       if B10.Index(B10.To_Bounded_String("cd"),        -- Source = Set
-                    CD_Set)                     /= 1 or
-          B10.Index(B10.To_Bounded_String("c"),         -- Source < Set
-                    CD_Set)                     /= 1 or
-          B10.Index(B10.Null_Bounded_String,            -- Source = Null
-                    CD_Set)                     /= 0 or
-          B10.Index(AtoE_Bnd_Str,                       -- "abcde"
-                    Maps.Null_Set)              /= 0 or -- Null set
-          B10.Index(AtoE_Bnd_Str,
-                    Maps.To_Set('x'))           /= 0    -- No match.
-       then
-          Report.Failed("Incorrect result from Index using Sets - 5");
-       end if;
- 
- 
-       -- Function Count with non-Identity mapping.
-       -- Evaluate the function Count with a non-identity map 
-       -- parameter which will cause mapping of the source parameter 
-       -- prior to the evaluation of the number of matching patterns.
- 
-       Total_Count := 
-         B10.Count(Source  => B10.To_Bounded_String("abbabaabab"),
-                   Pattern => "yz",
-                   Mapping => AB_to_YZ_Map);
- 
-       if Total_Count /= 4 then                                                 
-          Report.Failed
-            ("Incorrect result from function Count, non-Identity map - 1");
-       end if;
- 
-       -- And a few with identity maps as well.
- 
-       if B10.Count(B10.To_Bounded_String("ABABABABAB"),
-                    "ABA",
-                    Maps.Identity)                       /= 2 or
-          B10.Count(B10.To_Bounded_String("ADCBADABCD"),
-                    "AB",
-                    Maps.To_Mapping("CD", "AB"))         /= 5 or
-          B10.Count(B10.To_Bounded_String("aaaaaaaaaa"),
-                    "aaa")                               /= 3 or
-          B10.Count(B10.To_Bounded_String("XX"),         -- Source < Pattern
-                    "XXX",
-                    Maps.Identity)                       /= 0 or
-          B10.Count(AtoE_Bnd_Str,                        -- Source = Pattern
-                    "abcde")                             /= 1 or
-          B10.Count(B10.Null_Bounded_String,             -- Source = Null
-                    " ")                                 /= 0
-       then
-          Report.Failed
-            ("Incorrect result from function Count, w,w/o mapping");
-       end if;
-                                          
- 
-       -- Procedure Translate
- 
-       -- Partial mapping of source.
- 
-       Test_String := B10.To_Bounded_String("abcdeabcab");
- 
-       B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
- 
-       if Test_String /= B10.To_Bounded_String("yzcdeyzcyz") then
-          Report.Failed("Incorrect result from procedure Translate - 1");
-       end if;
- 
-       -- Total mapping of source.
- 
-       Test_String := B10.To_Bounded_String("abbaaababb");
- 
-       B10.Translate(Source => Test_String, Mapping => ASC.Upper_Case_Map);
- 
-       if Test_String /= B10.To_Bounded_String("ABBAAABABB") then
-          Report.Failed("Incorrect result from procedure Translate - 2");
-       end if;
- 
-       -- No mapping of source.
- 
-       Test_String := B10.To_Bounded_String("xyzsypcc");
- 
-       B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
- 
-       if Test_String /= B10.To_Bounded_String("xyzsypcc") then
-          Report.Failed("Incorrect result from procedure Translate - 3");
-       end if;
- 
-       -- Map > 2 characters, partial mapping.
- 
-       Test_String := B10.To_Bounded_String("have faith");
- 
-       B10.Translate(Test_String, 
-                     Maps.To_Mapping("aeiou", "AEIOU"));
- 
-       if Test_String /= B10.To_Bounded_String("hAvE fAIth") then
-          Report.Failed("Incorrect result from procedure Translate - 4");
-       end if;
- 
- 
-       -- Function Replace_Slice
-       -- Evaluate function Replace_Slice with 
-       -- a variety of Truncation options.
- 
-       -- Drop = Error (Default)
- 
-       begin
-          Test_String   := AtoJ_Bnd_Str;
-          Result_String := 
-            B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
-                              Low    => 3,
-                              High   => 5,            -- 3-5, 3 chars.
-                              By     => "xxxxxx");    -- more than 3.
-          Report.Failed("Length_Error not raised by Function Replace_Slice");
-       exception
-          when AS.Length_Error => null;   -- Correct exception raised.
-          when others          =>
-             Report.Failed
-               ("Incorrect exception raised by Function Replace_Slice");
-       end;
- 
-       -- Drop = Left                                                          
- 
-       Result_String := 
-         B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
-                           Low    =>  7,
-                           High   => 10,           -- 7-10, 4 chars.
-                           By     => "xxxxxx",     --  6 chars.
-                           Drop   => Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_String("cdefxxxxxx") then -- drop a,b
-          Report.Failed
-            ("Incorrect result from Function Replace Slice, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := 
-         B10.Replace_Slice(Source => Test_String, -- "abcdefghij"
-                           Low    =>  2,
-                           High   =>  5,          -- 2-5, 4 chars.
-                           By     => "xxxxxx",    --  6 chars.
-                           Drop   => Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_String("axxxxxxfgh") then -- drop i,j
-          Report.Failed
-            ("Incorrect result from Function Replace Slice, Drop = Right");
-       end if;
- 
-       -- Low = High = Source'Last, "By" length = 1.
- 
-       if B10.Replace_Slice(AtoE_Bnd_Str,
-                            B10.To_String(AtoE_Bnd_Str)'Last,
-                            B10.To_String(AtoE_Bnd_Str)'Last,
-                            "X",
-                            Ada.Strings.Error)  /=
-          B10.To_Bounded_String("abcdX")
-       then
-          Report.Failed("Incorrect result from Function Replace_Slice");
-       end if;
- 
- 
- 
-       -- Procedure Replace_Slice
-       -- Evaluate procedure Replace_Slice with 
-       -- a variety of Truncation options.
- 
-       -- Drop = Error (Default)
- 
-       begin
-          Test_String := AtoJ_Bnd_Str;
-          B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
-                            Low    => 3,
-                            High   => 5,            -- 3-5, 3 chars.
-                            By     => "xxxxxx");    -- more than 3.
-          Report.Failed("Length_Error not raised by Procedure Replace_Slice");
-       exception
-          when AS.Length_Error => null;   -- Correct exception raised.
-          when others          =>
-             Report.Failed
-               ("Incorrect exception raised by Procedure Replace_Slice");
-       end;
- 
-       -- Drop = Left                                                          
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
-                         Low    =>  7,
-                         High   =>  9,           -- 7-9, 3 chars.
-                         By     => "xxxxx",      --  5 chars.
-                         Drop   => Ada.Strings.Left);
- 
-       if Test_String /= B10.To_Bounded_String("cdefxxxxxj") then -- drop a,b
-          Report.Failed
-            ("Incorrect result from Procedure Replace Slice, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
-                         Low    =>  1,
-                         High   =>  3,           -- 1-3, 3chars.
-                         By     => "xxxx",       --  4 chars.
-                         Drop   => Ada.Strings.Right);
- 
-       if Test_String /= B10.To_Bounded_String("xxxxdefghi") then  -- drop j
-          Report.Failed
-            ("Incorrect result from Procedure Replace Slice, Drop = Right");
-       end if;
- 
-       -- High = Source'First, Low > High (Insert before Low).
- 
-       Test_String := AtoE_Bnd_Str;
-       B10.Replace_Slice(Source => Test_String,  -- "abcde"
-                         Low    => B10.To_String(Test_String)'Last,
-                         High   => B10.To_String(Test_String)'First,
-                         By     => "XXXX",       --  4 chars.
-                         Drop   => Ada.Strings.Right);
- 
-       if Test_String /= B10.To_Bounded_String("abcdXXXXe") then 
-          Report.Failed
-            ("Incorrect result from Procedure Replace Slice");
-       end if;
- 
- 
- 
-       -- Function Insert with Truncation
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := 
-            B10.Insert(Source   => AtoJ_Bnd_Str,    -- "abcdefghij"
-                       Before   => 2,
-                       New_Item => "xyz");
-          Report.Failed("Length_Error not raised by Function Insert");
-       exception
-          when AS.Length_Error => null;  -- Correct exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Function Insert");
-       end;
- 
-       -- Drop = Left
- 
-       Result_String :=
-         B10.Insert(Source   => AtoJ_Bnd_Str,      -- "abcdefghij"
-                    Before   => 5,
-                    New_Item => "xyz",             -- 3 additional chars.
-                    Drop     => Ada.Strings.Left);
- 
-       if B10.To_String(Result_String) /= "dxyzefghij" then   -- drop a, b, c
-          Report.Failed("Incorrect result from Function Insert, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := 
-         B10.Insert(Source   => B10.To_Bounded_String("abcdef"),
-                    Before   => 2,
-                    New_Item => "vwxyz",             -- 5 additional chars.
-                    Drop     => Ada.Strings.Right);
- 
-       if B10.To_String(Result_String) /= "avwxyzbcde" then     -- drop f.
-          Report.Failed("Incorrect result from Function Insert, Drop = Right");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Insert(B10.To_Bounded_String("a"), 1, " B") /=   
-          B10.To_Bounded_String(" Ba")                       or
-          B10.Insert(B10.Null_Bounded_String, 1, "abcde") /=
-          AtoE_Bnd_Str                                       or
-          B10.Insert(B10.To_Bounded_String("ab"), 2, "")  /=
-          B10.To_Bounded_String("ab")
-       then
-          Report.Failed("Incorrect result from Function Insert");
-       end if;
- 
- 
-       -- Procedure Insert
- 
-       -- Drop = Error (Default).
-       begin
-          Test_String := AtoJ_Bnd_Str;
-          B10.Insert(Source   => Test_String,    -- "abcdefghij"
-                     Before   => 9,
-                     New_Item => "wxyz",
-                     Drop     => Ada.Strings.Error);
-          Report.Failed("Length_Error not raised by Procedure Insert");
-       exception
-          when AS.Length_Error => null;  -- Correct exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Procedure Insert");
-       end;
- 
-       -- Drop = Left
-       
-       Test_String := AtoJ_Bnd_Str;
-       B10.Insert(Source   => Test_String,             -- "abcdefghij"
-                  Before   => B10.Length(Test_String), -- before last char
-                  New_Item => "xyz",                   -- 3 additional chars.
-                  Drop     => Ada.Strings.Left);
- 
-       if B10.To_String(Test_String) /= "defghixyzj" then     -- drop a, b, c
-          Report.Failed("Incorrect result from Procedure Insert, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Insert(Source   => Test_String,
-                  Before   => 4,
-                  New_Item => "yz",             -- 2 additional chars.
-                  Drop     => Ada.Strings.Right);
- 
-       if B10.To_String(Test_String) /= "abcyzdefgh" then     -- drop i,j
-          Report.Failed
-            ("Incorrect result from Procedure Insert, Drop = Right");
-       end if;
- 
-       -- Before = Source'First, New_Item length = 1.
- 
-       Test_String := B10.To_Bounded_String(" abc ");
-       B10.Insert(Test_String, 
-                  B10.To_String(Test_String)'First,
-                  "Z");
- 
-       if Test_String /= B10.To_Bounded_String("Z abc ") then
-          Report.Failed("Incorrect result from Procedure Insert");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in  Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,619 ****
- -- CXA4009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Bounded are
- --      available, and that they produce correct results, especially under
- --      conditions where truncation of the result is required.  Specifically, 
- --      check the subprograms Overwrite (function and procedure), Delete,
- --      Function Trim (blanks), Trim (Set characters, function and procedure),
- --      Head, Tail, and Replicate (characters and strings).
- --
- -- TEST DESCRIPTION:
- --      This test, in conjunction with tests CXA4006, CXA4007, and CXA4008, 
- --      will provide coverage of the most common usages of the functionality
- --      found in the Ada.Strings.Bounded package.  It deals in large part
- --      with truncation effects and options.  This test contains many small, 
- --      specific test cases, situations that are often difficult to generate 
- --      in large numbers in an application-based test.  These cases represent 
- --      specific usage paradigms in-the-small.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 95   SAIC    Corrected errors in Procedure Overwrite subtests.
- --      01 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1.
- --
- --!
- 
- with Report;
- with Ada.Strings.Bounded;
- with Ada.Strings.Maps;
- 
- procedure CXA4009 is
- 
- begin
- 
-    Report.Test("CXA4009", "Check that the subprograms defined in "      &
-                           "package Ada.Strings.Bounded are available, " &
-                           "and that they produce correct results, "     &
-                           "especially under conditions where "          &
-                           "truncation of the result is required");
- 
-    Test_Block:
-    declare
- 
-       package AS   renames Ada.Strings;
-       package ASB  renames Ada.Strings.Bounded;
-       package Maps renames Ada.Strings.Maps;
- 
-       package B10 is new ASB.Generic_Bounded_Length(Max => 10);
-       use type B10.Bounded_String;
- 
-       Result_String : B10.Bounded_String;
-       Test_String   : B10.Bounded_String;
-       AtoE_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("abcde");
-       FtoJ_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("fghij");
-       AtoJ_Bnd_Str  : B10.Bounded_String := 
-                         B10.To_Bounded_String("abcdefghij");
- 
-       Location     : Natural := 0;
-       Total_Count  : Natural := 0;
- 
-       CD_Set       : Maps.Character_Set := Maps.To_Set("cd"); 
-       XY_Set       : Maps.Character_Set := Maps.To_Set("xy"); 
- 
- 
-    begin
- 
-       -- Function Overwrite with Truncation                 
-       -- Drop = Error (Default).
- 
-       begin
-          Test_String   := AtoJ_Bnd_Str;
-          Result_String := 
-            B10.Overwrite(Source   => Test_String, -- "abcdefghij"
-                          Position => 9,
-                          New_Item => "xyz",
-                          Drop     => AS.Error);
-          Report.Failed("Exception not raised by Function Overwrite");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed("Incorrect exception raised by Function Overwrite");
-       end;
- 
-       -- Drop = Left
-  
-       Result_String :=
-         B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
-                       Position => B10.Length(Test_String), -- 10
-                       New_Item => "xyz",
-                       Drop     => Ada.Strings.Left);
- 
-       if B10.To_String(Result_String) /= "cdefghixyz" then   -- drop a,b
-          Report.Failed
-            ("Incorrect result from Function Overwrite, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := B10.Overwrite(Test_String,  -- "abcdefghij"
-                                      3,
-                                      "xxxyyyzzz",
-                                      Ada.Strings.Right);
- 
-       if B10.To_String(Result_String) /= "abxxxyyyzz" then -- one 'z' dropped
-          Report.Failed
-            ("Incorrect result from Function Overwrite, Drop = Right");
-       end if;
- 
-       -- Additional cases of function Overwrite.
- 
-       if B10.Overwrite(B10.To_Bounded_String("a"),      -- Source length = 1
-                        1,
-                        "  abc  ")                 /= 
-          B10.To_Bounded_String("  abc  ")            or
-          B10.Overwrite(B10.Null_Bounded_String,         -- Null source
-                        1, 
-                        "abcdefghij")              /=
-          AtoJ_Bnd_Str                                or
-          B10.Overwrite(AtoE_Bnd_Str, 
-                        B10.To_String(AtoE_Bnd_Str)'First,
-                        " ")                       /=      -- New_Item = 1
-          B10.To_Bounded_String(" bcde")
-       then
-          Report.Failed("Incorrect result from Function Overwrite");
-       end if;
- 
- 
- 
-       -- Procedure Overwrite                                 
-       -- Correct usage, no truncation.
- 
-       Test_String := AtoE_Bnd_Str;   -- "abcde"
-       B10.Overwrite(Test_String, 2, "xyz");
- 
-       if Test_String /= B10.To_Bounded_String("axyze") then
-          Report.Failed("Incorrect result from Procedure Overwrite - 1");
-       end if;
- 
-       Test_String := B10.To_Bounded_String("abc");
-       B10.Overwrite(Test_String, 2, "");   -- New_Item is null string.
- 
-       if Test_String /= B10.To_Bounded_String("abc") then
-          Report.Failed("Incorrect result from Procedure Overwrite - 2");
-       end if;
- 
-       -- Drop = Error (Default).
- 
-       begin
-          Test_String   := AtoJ_Bnd_Str;
-          B10.Overwrite(Source   => Test_String, -- "abcdefghij"
-                        Position => 8,
-                        New_Item => "uvwxyz");
-          Report.Failed("Exception not raised by Procedure Overwrite");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed("Incorrect exception raised by Procedure Overwrite");
-       end;
- 
-       -- Drop = Left
-  
-       Test_String   := AtoJ_Bnd_Str;
-       B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
-                     Position => B10.Length(Test_String) - 2, -- 8
-                     New_Item => "uvwxyz",
-                     Drop     => Ada.Strings.Left);
- 
-       if B10.To_String(Test_String) /= "defguvwxyz" then   -- drop a-c
-          Report.Failed
-            ("Incorrect result from Procedure Overwrite, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Test_String   := AtoJ_Bnd_Str;
-       B10.Overwrite(Test_String,  -- "abcdefghij"
-                     3,
-                     "xxxyyyzzz",
-                     Ada.Strings.Right);
- 
-       if B10.To_String(Test_String) /= "abxxxyyyzz" then -- one 'z' dropped
-          Report.Failed
-            ("Incorrect result from Procedure Overwrite, Drop = Right");
-       end if;
- 
- 
- 
-       -- Function Delete                                     
- 
-       if B10.Delete(Source  => AtoJ_Bnd_Str,   -- "abcdefghij"
-                     From    => 3,
-                     Through => 8)                               /=
-          B10."&"(B10.Head(AtoJ_Bnd_Str, 2), 
-                  B10.Tail(AtoJ_Bnd_Str, 2))                         or
-          B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str))  /=
-          AtoE_Bnd_Str                                               or
-          B10.Delete(AtoJ_Bnd_Str, 1, 5)                         /= 
-          FtoJ_Bnd_Str                                               or
-          B10.Delete(AtoE_Bnd_Str, 4, 5)                         /=
-          B10.Delete(AtoJ_Bnd_Str, 4, B10.Length(AtoJ_Bnd_Str)) 
-       then
-          Report.Failed("Incorrect result from Function Delete - 1");
-       end if;
- 
-       if B10.Delete(B10.To_Bounded_String("a"), 1, 1)  /= 
-          B10.Null_Bounded_String                           or
-          B10.Delete(AtoE_Bnd_Str, 
-                     5, 
-                     B10.To_String(AtoE_Bnd_Str)'First) /=
-          AtoE_Bnd_Str                                      or
-          B10.Delete(AtoE_Bnd_Str,
-                     B10.To_String(AtoE_Bnd_Str)'Last,
-                     B10.To_String(AtoE_Bnd_Str)'Last)  /=
-          B10.To_Bounded_String("abcd")
-       then
-          Report.Failed("Incorrect result from Function Delete - 2");
-       end if;
-       
- 
- 
-       -- Function Trim                                       
- 
-       declare
- 
-          Text : B10.Bounded_String := B10.To_Bounded_String("Text");
-          type Bnd_Array_Type is array (1..5) of B10.Bounded_String;
-          Bnd_Array : Bnd_Array_Type :=
-            (B10.To_Bounded_String("  Text"),
-             B10.To_Bounded_String("Text    "),
-             B10.To_Bounded_String("   Text   "),
-             B10.To_Bounded_String("Text  Text"),   -- Ensure no inter-string
-             B10.To_Bounded_String(" Text Text"));  -- trimming of blanks.
- 
-       begin
- 
-          for i in Bnd_Array_Type'Range loop
-             case i is
-                when 4 =>
-                   if B10.Trim(Bnd_Array(i), AS.Both) /= 
-                      Bnd_Array(i) then  -- no change
-                      Report.Failed("Incorrect result from Function Trim - 4");
-                   end if;
-                when 5 =>
-                   if B10.Trim(Bnd_Array(i), AS.Both) /= 
-                      B10."&"(Text, B10."&"(' ', Text)) then
-                      Report.Failed("Incorrect result from Function Trim - 5");
-                   end if;
-                when others =>
-                   if B10.Trim(Bnd_Array(i), AS.Both) /= Text then
-                      Report.Failed("Incorrect result from Function Trim - " &
-                                     Integer'Image(i));
-                   end if;
-             end case;
-          end loop;
- 
-       end;
- 
- 
- 
-       -- Function Trim using Sets                            
- 
-       -- Trim characters in sets from both sides of the bounded string.
-       if B10.Trim(Source => B10.To_Bounded_String("ddabbaxx"),
-                   Left   => CD_Set,
-                   Right  => XY_Set)  /=
-          B10.To_Bounded_String("abba")
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Left & Right side - 1");
-       end if;
- 
-       -- Ensure that the characters in the set provided as the actual to
-       -- parameter Right are not trimmed from the left side of the bounded
-       -- string; likewise for the opposite side.  Only "cd" trimmed from left
-       -- side, and only "xy" trimmed from right side.
- 
-       if B10.Trim(B10.To_Bounded_String("cdxyabcdxy"), CD_Set, XY_Set) /=
-          B10.To_Bounded_String("xyabcd")
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Left & Right side - 2");
-       end if;
- 
-       -- Ensure that characters contained in the sets are not trimmed from
-       -- the "interior" of the bounded string, just the appropriate ends.
- 
-       if B10.Trim(B10.To_Bounded_String("cdabdxabxy"), CD_Set, XY_Set) /=
-          B10.To_Bounded_String("abdxab")
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Left & Right side - 3");
-       end if;
- 
-       -- Trim characters in set from right side only.  No change to Left side.
- 
-       if B10.Trim(B10.To_Bounded_String("abxyzddcd"), XY_Set, CD_Set) /=
-          B10.To_Bounded_String("abxyz")
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Right side");
-       end if;
- 
-       -- Trim no characters on either side of the bounded string.
- 
-       Result_String := B10.Trim(AtoJ_Bnd_Str, CD_Set, XY_Set);
-       if Result_String /= AtoJ_Bnd_Str then
-          Report.Failed("Incorrect result from Fn Trim - Sets, Neither side");
-       end if;
- 
-       if B10.Trim(AtoE_Bnd_Str, Maps.Null_Set, Maps.Null_Set) /=
-          AtoE_Bnd_Str                                            or
-          B10.Trim(B10.To_Bounded_String("dcddcxyyxx"),
-                   CD_Set,
-                   XY_Set)                                     /=
-          B10.Null_Bounded_String
-       then
-          Report.Failed("Incorrect result from Function Trim");
-       end if;
- 
- 
- 
-       -- Procedure Trim using Sets                           
- 
-       -- Trim characters in sets from both sides of the bounded string.
- 
-       Test_String := B10.To_Bounded_String("dcabbayx");
-       B10.Trim(Source => Test_String,
-                Left   => CD_Set,
-                Right  => XY_Set);
- 
-       if Test_String /= B10.To_Bounded_String("abba") then
-          Report.Failed
-            ("Incorrect result from Proc Trim - Sets, Left & Right side - 1");
-       end if;
- 
-       -- Ensure that the characters in the set provided as the actual to
-       -- parameter Right are not trimmed from the left side of the bounded
-       -- string; likewise for the opposite side.  Only "cd" trimmed from left
-       -- side, and only "xy" trimmed from right side.
- 
-       Test_String := B10.To_Bounded_String("cdxyabcdxy");
-       B10.Trim(Test_String, CD_Set, XY_Set);
- 
-       if Test_String /= B10.To_Bounded_String("xyabcd") then
-          Report.Failed
-            ("Incorrect result from Proc Trim - Sets, Left & Right side - 2");
-       end if;
- 
-       -- Ensure that characters contained in the sets are not trimmed from
-       -- the "interior" of the bounded string, just the appropriate ends.
- 
-       Test_String := B10.To_Bounded_String("cdabdxabxy");
-       B10.Trim(Test_String, CD_Set, XY_Set);
- 
-       if not (Test_String = B10.To_Bounded_String("abdxab")) then
-          Report.Failed
-            ("Incorrect result from Proc Trim - Sets, Left & Right side - 3");
-       end if;
- 
-       -- Trim characters in set from Left side only.  No change to Right side.
- 
-       Test_String := B10.To_Bounded_String("cccdabxyz");
-       B10.Trim(Test_String, CD_Set, XY_Set);
- 
-       if Test_String /= B10.To_Bounded_String("abxyz") then
-          Report.Failed
-            ("Incorrect result from Proc Trim for Sets, Left side only");
-       end if;
- 
-       -- Trim no characters on either side of the bounded string.
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Trim(Test_String, CD_Set, CD_Set);
- 
-       if Test_String /= AtoJ_Bnd_Str then
-          Report.Failed("Incorrect result from Proc Trim-Sets, Neither side");
-       end if;
- 
- 
- 
-       -- Function Head with Truncation                       
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := B10.Head(Source => AtoJ_Bnd_Str,   -- max length
-                                    Count  => B10.Length(AtoJ_Bnd_Str) + 1,
-                                    Pad    => 'X');
-          Report.Failed("Length_Error not raised by Function Head");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Function Head");
-       end;
- 
-       -- Drop = Left
- 
-       -- Pad characters (5) are appended to the right end of the string 
-       -- (which is initially at its maximum length), then the first five
-       -- characters of the intermediate result are dropped to conform to
-       -- the maximum size limit of the bounded string (10).
- 
-       Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHIJ"),
-                                 15,
-                                 'x',
-                                 Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_String("FGHIJxxxxx") then
-          Report.Failed("Incorrect result from Function Head, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       -- Pad characters (6) are appended to the left end of the string 
-       -- (which is initially at one less than its maximum length), then the 
-       -- last five characters of the intermediate result are dropped 
-       -- (which in this case are the pad characters) to conform to the 
-       -- maximum size limit of the bounded string (10).
- 
-       Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHI"),
-                                 15,
-                                 'x',
-                                 Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_String("ABCDEFGHIx") then
-          Report.Failed("Incorrect result from Function Head, Drop = Right");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Head(B10.Null_Bounded_String, 5) /=
-          B10.To_Bounded_String("     ")          or
-          B10.Head(AtoE_Bnd_Str,
-                   B10.Length(AtoE_Bnd_Str))   /=
-          AtoE_Bnd_Str
-       then
-          Report.Failed("Incorrect result from Function Head");
-       end if;
- 
- 
- 
-       -- Function Tail with Truncation                       
-       -- Drop = Error (Default Case)
- 
-       begin
-          Result_String := B10.Tail(Source => AtoJ_Bnd_Str,   -- max length
-                                    Count  => B10.Length(AtoJ_Bnd_Str) + 1,
-                                    Pad    => Ada.Strings.Space,
-                                    Drop   => Ada.Strings.Error);
-          Report.Failed("Length_Error not raised by Function Tail");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Function Tail");
-       end;
- 
-       -- Drop = Left
- 
-       -- Pad characters (5) are appended to the left end of the string 
-       -- (which is initially at two less than its maximum length), then 
-       -- the first three characters of the intermediate result (in this 
-       -- case, 3 pad characters) are dropped.
- 
-       Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGH"), -- 8 ch
-                                 13,
-                                 'x',
-                                 Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_String("xxABCDEFGH") then
-          Report.Failed("Incorrect result from Function Tail, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       -- Pad characters (3) are appended to the left end of the string 
-       -- (which is initially at its maximum length), then the last three
-       -- characters of the intermediate result are dropped.
- 
-       Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGHIJ"),
-                                 13,
-                                 'x',
-                                 Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_String("xxxABCDEFG") then
-          Report.Failed("Incorrect result from Function Tail, Drop = Right");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Tail(B10.Null_Bounded_String, 3, ' ')    /=
-          B10.To_Bounded_String("   ")                    or
-          B10.Tail(AtoE_Bnd_Str, 
-                   B10.To_String(AtoE_Bnd_Str)'First)  /=
-          B10.To_Bounded_String("e")                      
-       then
-          Report.Failed("Incorrect result from Function Tail");
-       end if;
- 
- 
- 
-       -- Function Replicate (#, Char) with Truncation        
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := B10.Replicate(Count => B10.Max_Length + 5,
-                                         Item  => 'A',
-                                         Drop  => AS.Error);
-          Report.Failed
-            ("Length_Error not raised by Replicate for characters");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed
-              ("Incorrect exception raised by Replicate for characters");
-       end;
- 
-       -- Drop = Left, Right
-       -- Since this version of Replicate uses character parameters, the 
-       -- result after truncation from left or right will appear the same.
-       -- The result will be a 10 character bounded string, composed of 10
-       -- "Item" characters.
- 
-       if B10.Replicate(Count => 20, Item => 'A', Drop => Ada.Strings.Left) /=
-          B10.Replicate(15, 'A', Ada.Strings.Right)
-       then
-          Report.Failed("Incorrect result from Replicate for characters - 1");
-       end if;
- 
-       -- Blank-filled 10 character bounded strings.
- 
-       if B10.Replicate(B10.Max_Length + 1, ' ', Drop => Ada.Strings.Left) /=
-          B10.Replicate(B10.Max_Length, Ada.Strings.Space)
-       then
-          Report.Failed("Incorrect result from Replicate for characters - 2");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Replicate(0, 'a')  /= B10.Null_Bounded_String    or
-          B10.Replicate(1, 'a')  /= B10.To_Bounded_String("a")    
-       then
-          Report.Failed("Incorrect result from Replicate for characters - 3");
-       end if;
- 
- 
- 
-       -- Function Replicate (#, String) with Truncation      
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := B10.Replicate(Count => 5,  -- result would be 15.
-                                         Item  => "abc");
-          Report.Failed
-            ("Length_Error not raised by Replicate for strings");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed
-              ("Incorrect exception raised by Replicate for strings");
-       end;
- 
-       -- Drop = Left
- 
-       Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_String("cdabcdabcd") then
-          Report.Failed
-            ("Incorrect result from Replicate for strings, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_String("abcdabcdab") then
-          Report.Failed
-            ("Incorrect result from Replicate for strings, Drop = Right");
-       end if;
- 
-       -- Additional cases.
-       
-       if B10.Replicate(10, "X")  /= B10.To_Bounded_String("XXXXXXXXXX") or
-          B10.Replicate(10, "")   /= B10.Null_Bounded_String             or
-          B10.Replicate( 0, "ab") /= B10.Null_Bounded_String
-       then
-          Report.Failed("Incorrect result from Replicate for strings");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in  Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,275 ****
- -- CXA4010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Unbounded
- --      are available, and that they produce correct results. Specifically, 
- --      check the subprograms To_String, To_Unbounded_String, Insert, "&", 
- --      "*", Length, Slice, Replace_Slice, Overwrite, Index, Index_Non_Blank,
- --      Head, Tail, and "=", "<=", ">=".
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of many of the subprograms defined
- --      in package Ada.Strings.Unbounded for use with unbounded strings.
- --      The test simulates how unbounded strings could be used
- --      to simulate paragraphs of text.  Modifications could be easily be
- --      performed using the provided subprograms (although in this test, the
- --      main modification performed was the addition of more text to the
- --      string).  One would not have to worry about the formatting of the 
- --      paragraph until it was finished and correct in content.  Then, once
- --      all required editing is complete, the unbounded strings can be divided
- --      up into the appropriate lengths based on particular formatting
- --      requirements.  The test then compares the formatted text product
- --      with a predefined "finished product".  
- --      
- --      This test uses a large number of the subprograms provided
- --      by package Ada.Strings.Unbounded.  Often, the processing involved
- --      could have been performed more efficiently using a minimum number
- --      of the subprograms, in conjunction with loops, etc.  However, for
- --      testing purposes, and in the interest of minimizing the number of
- --      tests developed, subprogram variety and feature mixing was stressed.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with Ada.Strings.Maps;
- with Ada.Strings.Unbounded;
- 
- procedure CXA4010 is
- begin
- 
-    Report.Test ("CXA4010", "Check that the subprograms defined in "        &
-                            "package Ada.Strings.Unbounded are available, " &
-                            "and that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ASUnb renames Ada.Strings.Unbounded;
-       use type ASUnb.Unbounded_String;
-       use Ada.Strings;
- 
-       Pamphlet_Paragraph_Count : constant :=  2;
-       Lines                    : constant :=  4;
-       Line_Length              : constant := 40;
- 
-       type Document_Type is array (Positive range <>) 
-         of ASUnb.Unbounded_String;
- 
-       type Camera_Ready_Copy_Type is array (1..Lines) 
-         of String (1..Line_Length);
- 
-       Pamphlet            : Document_Type (1..Pamphlet_Paragraph_Count);
- 
-       Camera_Ready_Copy   : Camera_Ready_Copy_Type := 
-                               (others => (others => Ada.Strings.Space));
- 
-       TC_Finished_Product : Camera_Ready_Copy_Type :=
-                           ( 1 => "Ada is a programming language designed  ",
-                             2 => "to support long-lived, reliable software",
-                             3 => " systems.                               ",
-                             4 => "Go with Ada!                            ");
- 
-       -----
- 
- 
-       procedure Enter_Text_Into_Document (Document : in out Document_Type) is
-       begin
- 
-          -- Fill in both "paragraphs" of the document.  Each unbounded string
-          -- functions as an individual paragraph, containing an unspecified
-          -- number of characters.
-          -- Use a variety of different unbounded string subprograms to load 
-          -- the data.
- 
-          Document(1) := ASUnb.To_Unbounded_String("Ada is a language");
- 
-          -- Insert the word "programming" prior to "language".
-          Document(1) := 
-            ASUnb.Insert(Document(1), 
-                         ASUnb.Index(Document(1),
-                                     "language"),
-                         ASUnb.To_String("progra" &           -- Str &
-                                         ASUnb."*"(2,'m') &   -- Unbd & 
-                                         "ing "));            -- Str
- 
- 
-          -- Overwrite the word "language" with "language" + additional text.
-          Document(1) :=
-            ASUnb.Overwrite(Document(1),
-                            ASUnb.Index(Document(1),
-                                        ASUnb.To_String(
-                                          ASUnb.Tail(Document(1), 8, ' ')),
-                                        Ada.Strings.Backward),
-                            "language designed to support long-lifed");
- 
- 
-          -- Replace the word "lifed" with "lived".
-          Document(1) :=
-            ASUnb.Replace_Slice(Document(1),
-                                ASUnb.Index(Document(1), "lifed"),
-                                ASUnb.Length(Document(1)),
-                                "lived");
- 
- 
-          -- Overwrite the word "lived" with "lived" + additional text.
-          Document(1) :=
-            ASUnb.Overwrite(Document(1),
-                            ASUnb.Index(Document(1),
-                                        ASUnb.To_String(
-                                          ASUnb.Tail(Document(1), 5, ' ')),
-                                        Ada.Strings.Backward),
-                                "lived, reliable software systems.");
-                               
-                               
-          -- Use several of the overloaded versions of "&" to form this
-          -- unbounded string.
- 
-          Document(2) := 'G' &                               
-                         ASUnb.To_Unbounded_String("o ") & 
-                         ASUnb.To_Unbounded_String("with") &
-                         ' ' & 
-                         "Ada!";
- 
-       end Enter_Text_Into_Document;
- 
- 
-       -----
- 
- 
-       procedure Create_Camera_Ready_Copy 
-                   (Document    : in     Document_Type;
-                    Camera_Copy :    out Camera_Ready_Copy_Type) is
-       begin
-          -- Break the unbounded strings into fixed lengths.
- 
-          -- Search the first unbounded string for portions of text that
-          -- are less than or equal to the length of a string in the 
-          -- Camera_Ready_Copy_Type object.  
- 
-          Camera_Copy(1) :=                 -- Take characters 1-39,
-            ASUnb.Slice(Document(1),        -- and append a blank space.
-                        1,
-                        ASUnb.Index(ASUnb.To_Unbounded_String(
-                                       ASUnb.Slice(Document(1),
-                                                   1,
-                                                   Line_Length)),
-                                    Ada.Strings.Maps.To_Set(' '),
-                                    Ada.Strings.Inside,
-                                    Ada.Strings.Backward)) & ' ';
- 
-          Camera_Copy(2) :=                 -- Take characters 40-79.
-            ASUnb.Slice(Document(1),
-                        40,
-                        (ASUnb.Index_Non_Blank          -- Should return 79
-                           (ASUnb.To_Unbounded_String
-                              (ASUnb.Slice(Document(1), -- Slice (40..79)
-                                          40,
-                                          79)),
-                            Ada.Strings.Backward) + 39)); -- Increment since
-                                                          -- this slice starts
-                                                          -- at 40.
- 
-          Camera_Copy(3)(1..9) := ASUnb.Slice(Document(1), -- Characters 80-88
-                                              80,
-                                              ASUnb.Length(Document(1))); 
-                                 
- 
-          -- Break the second unbounded string into the appropriate length.
-          -- It is only twelve characters in length, so the entire unbounded
-          -- string will be placed on one string of the output object.
- 
-          Camera_Copy(4)(1..ASUnb.Length(Document(2))) :=
-            ASUnb.To_String(ASUnb.Head(Document(2),
-                                       ASUnb.Length(Document(2))));
- 
-       end Create_Camera_Ready_Copy;
- 
- 
-       -----
- 
- 
-       function Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type) 
-         return Boolean is
-       begin
- 
-          -- Evaluate strings for equality, using the operators defined in
-          -- package Ada.Strings.Unbounded.  The less than/greater than or
-          -- equal comparisons should evaluate to "equals => True".
- 
-          if ASUnb.To_Unbounded_String(Draft(1))   =       -- "="(Unb,Unb)
-             ASUnb.To_Unbounded_String(Master(1))   and    
-             ASUnb.To_Unbounded_String(Draft(2))  <=       -- "<="(Unb,Unb)
-             ASUnb.To_Unbounded_String(Master(2))   and
-             ASUnb.To_Unbounded_String(Draft(3))  >=       -- ">="(Unb,Unb)
-             ASUnb.To_Unbounded_String(Master(3))   and
-             ASUnb.To_Unbounded_String(Draft(4))   =       -- "="(Unb,Unb)
-             ASUnb.To_Unbounded_String(Master(4))
-          then
-             return True;
-          else
-             return False;
-          end if;
- 
-       end Valid_Proofread;
- 
- 
-       -----
- 
- 
-    begin
- 
-       -- Enter text into the unbounded string paragraphs of the document.
- 
-       Enter_Text_Into_Document (Pamphlet);
- 
- 
-       -- Reformat the unbounded strings into fixed string format.
- 
-       Create_Camera_Ready_Copy (Document    => Pamphlet,
-                                 Camera_Copy => Camera_Ready_Copy);
- 
- 
-       -- Verify the conversion process.
- 
-       if not Valid_Proofread (Draft  => Camera_Ready_Copy,
-                               Master => TC_Finished_Product)
-       then
-          Report.Failed ("Incorrect string processing result");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,376 ****
- -- CXA4011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Unbounded
- --      are available, and that they produce correct results. Specifically, 
- --      check the subprograms To_Unbounded_String, "&", ">", "<", Element, 
- --      Replace_Element, Count, Find_Token, Translate, Trim, Delete, and
- --      "*".
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of many of the subprograms defined
- --      in package Ada.Strings.Unbounded for use with unbounded strings.
- --      The test simulates how unbounded strings could be processed in a
- --      user environment, using the subprograms provided in this package.
- --
- --      This test uses a variety of the subprograms defined in the unbounded 
- --      string package in ways typical of common usage, with different 
- --      combinations of available subprograms being used to accomplish 
- --      similar unbounded string processing goals.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      27 Feb 95   SAIC    Test description modification.
- --      01 Nov 95   SAIC    Update and repair for ACVC 2.0.1.
- --
- --!
- 
- with Report;
- with Ada.Strings.Maps;
- with Ada.Strings.Unbounded;
- 
- procedure CXA4011 is
- begin
- 
-    Report.Test ("CXA4011", "Check that the subprograms defined in "        &
-                            "package Ada.Strings.Unbounded are available, " &
-                            "and that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ASUnb renames Ada.Strings.Unbounded;
-       use Ada.Strings;
-       use type Maps.Character_Set;
-       use type ASUnb.Unbounded_String;
- 
-       Cad_String        : ASUnb.Unbounded_String := 
-                             ASUnb.To_Unbounded_String("cad");
- 
-       Complete_String   : ASUnb.Unbounded_String := 
-                             ASUnb.To_Unbounded_String("Incomplete") &
-                             Ada.Strings.Space &
-                             ASUnb.To_Unbounded_String("String");
- 
-       Incomplete_String  : ASUnb.Unbounded_String :=
-                              ASUnb.To_Unbounded_String("ncomplete Strin");
- 
-       Incorrect_Spelling : ASUnb.Unbounded_String :=
-                              ASUnb.To_Unbounded_String("Guob Dai");
- 
-       Magic_String       : ASUnb.Unbounded_String :=
-                              ASUnb.To_Unbounded_String("abracadabra");
- 
-       Incantation        : ASUnb.Unbounded_String := Magic_String;
- 
- 
-       A_Small_G : Character := 'g';
-       A_Small_D : Character := 'd';
- 
-       ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd");
-       B_Set    : Maps.Character_Set := Maps.To_Set('b');
-       AB_Set   : Maps.Character_Set := Maps."OR"(Maps.To_Set('a'), B_Set);
- 
-       Code_Map         : Maps.Character_Mapping := 
-                            Maps.To_Mapping(From => "abcd", To => "wxyz");
-       Reverse_Code_Map : Maps.Character_Mapping :=
-                            Maps.To_Mapping(From => "wxyz", To => "abcd");
-       Non_Existent_Map : Maps.Character_Mapping :=
-                            Maps.To_Mapping(From => "jkl",  To => "mno");
- 
- 
-       Token_Start      : Positive;
-       Token_End        : Natural := 0;
-       Matching_Letters : Natural := 0;
- 
- 
-    begin
- 
-       -- "&"
- 
-       -- Prepend an 'I' and append a 'g' to the string.
-       Incomplete_String := ASUnb."&"('I', Incomplete_String);  -- Char & Unb
-       Incomplete_String := ASUnb."&"(Incomplete_String, 
-                                      A_Small_G);               -- Unb & Char
- 
-       if Incomplete_String  < Complete_String  or
-          Incomplete_String  > Complete_String  or
-          Incomplete_String /= Complete_String
-       then
-          Report.Failed("Incorrect result from use of ""&"" operator");
-       end if;
- 
- 
-       -- Element
- 
-       -- Last element of the unbounded string should be a 'g'.
-       if ASUnb.Element(Incomplete_String, ASUnb.Length(Incomplete_String)) /=
-          A_Small_G
-       then
-          Report.Failed("Incorrect result from use of Function Element - 1");
-       end if;
- 
-       if ASUnb.Element(Incomplete_String, 2)                 /=
-          ASUnb.Element(ASUnb.Tail(Incomplete_String, 2), 1)     or
-          ASUnb.Element(ASUnb.Head(Incomplete_String, 4), 2)  /=
-          ASUnb.Element(ASUnb.To_Unbounded_String("wnqz"), 2)
-       then
-          Report.Failed("Incorrect result from use of Function Element - 2");
-       end if;
-     
- 
-       -- Replace_Element
- 
-       -- The unbounded string Incorrect_Spelling starts as "Guob Dai", and
-       -- is transformed by the following three procedure calls to "Good Day".
- 
-       ASUnb.Replace_Element(Incorrect_Spelling, 2, 'o');
- 
-       ASUnb.Replace_Element(Incorrect_Spelling, 
-                             ASUnb.Index(Incorrect_Spelling, B_Set),
-                             A_Small_D);
- 
-       ASUnb.Replace_Element(Source => Incorrect_Spelling,
-                             Index  => ASUnb.Length(Incorrect_Spelling),
-                             By     => 'y');
- 
-       if Incorrect_Spelling /= ASUnb.To_Unbounded_String("Good Day") then
-          Report.Failed("Incorrect result from Procedure Replace_Element");
-       end if;
- 
- 
-       -- Count
- 
-       -- Determine the number of characters in the unbounded string that
-       -- are contained in the set.
- 
-       Matching_Letters := ASUnb.Count(Source => Magic_String,
-                                       Set    => ABCD_Set);
- 
-       if Matching_Letters /= 9 then
-          Report.Failed
-             ("Incorrect result from Function Count with Set parameter");
-       end if;
- 
-       -- Determine the number of occurrences of the following pattern strings
-       -- in the unbounded string Magic_String.
- 
-       if ASUnb.Count(Magic_String, "ab") /=
-          (ASUnb.Count(Magic_String, "ac") + ASUnb.Count(Magic_String, "ad")) or
-          ASUnb.Count(Magic_String, "ab") /= 2
-       then
-          Report.Failed
-             ("Incorrect result from Function Count with String parameter");
-       end if;
- 
- 
-       -- Find_Token
- 
-       ASUnb.Find_Token(Magic_String,      -- Find location of first "ab".
-                        AB_Set,            -- Should be (1..2).
-                        Ada.Strings.Inside,
-                        Token_Start,
-                        Token_End);
- 
-       if Natural(Token_Start) /= ASUnb.To_String(Magic_String)'First  or
-          Token_End            /= ASUnb.Index(Magic_String, B_Set)
-       then 
-          Report.Failed("Incorrect result from Procedure Find_Token - 1");
-       end if;
- 
- 
-       ASUnb.Find_Token(Source => Magic_String, -- Find location of char 'r'
-                        Set    => ABCD_Set,     -- in string, should be (3..3)
-                        Test   => Ada.Strings.Outside,
-                        First  => Token_Start,
-                        Last   => Token_End);
- 
-       if Natural(Token_Start) /= 3 or
-          Token_End            /= 3 then
-          Report.Failed("Incorrect result from Procedure Find_Token - 2");
-       end if;
- 
- 
-       ASUnb.Find_Token(Magic_String,           -- No 'g' is in the string, so
-                        Maps.To_Set(A_Small_G), -- the result parameters should
-                        Ada.Strings.Inside,     -- be First = Source'First and
-                        First => Token_Start,   -- Last = 0.
-                        Last  => Token_End);
- 
-       if Token_Start /= ASUnb.To_String(Magic_String)'First  or
-          Token_End   /= 0
-       then
-          Report.Failed("Incorrect result from Procedure Find_Token - 3");
-       end if;
-  
- 
-       -- Translate
- 
-       -- Use a mapping ("abcd" -> "wxyz") to transform the contents of 
-       -- the unbounded string.
-       -- Magic_String = "abracadabra"
- 
-       Incantation := ASUnb.Translate(Magic_String, Code_Map); 
- 
-       if Incantation /= ASUnb.To_Unbounded_String("wxrwywzwxrw") then
-          Report.Failed("Incorrect result from Function Translate");
-       end if;
- 
-       -- Use the inverse mapping of the one above to return the "translated"
-       -- unbounded string to its original form.
- 
-       ASUnb.Translate(Incantation, Reverse_Code_Map);
- 
-       -- The map contained in the following call to Translate contains one
-       -- element, and this element is not found in the unbounded string, so
-       -- this call to Translate should have no effect on the unbounded string.
- 
-       if Incantation /= ASUnb.Translate(Magic_String, Non_Existent_Map) then
-          Report.Failed("Incorrect result from Procedure Translate");
-       end if;
- 
-     
-       -- Trim
- 
-       Trim_Block:
-       declare
- 
-          XYZ_Set     : Maps.Character_Set := Maps.To_Set("xyz");
-          PQR_Set     : Maps.Character_Set := Maps.To_Set("pqr");
- 
-          Pad         : constant ASUnb.Unbounded_String := 
-                                   ASUnb.To_Unbounded_String("Pad");
- 
-          The_New_Ada : constant ASUnb.Unbounded_String :=
-                                   ASUnb.To_Unbounded_String("Ada9X");
- 
-          Space_Array : array (1..4) of ASUnb.Unbounded_String :=
-                          (ASUnb.To_Unbounded_String("  Pad    "),
-                           ASUnb.To_Unbounded_String("Pad   "),
-                           ASUnb.To_Unbounded_String("     Pad"),
-                           Pad);
- 
-          String_Array : array (1..5) of ASUnb.Unbounded_String := 
-                           (ASUnb.To_Unbounded_String("xyzxAda9Xpqr"),
-                            ASUnb.To_Unbounded_String("Ada9Xqqrp"),
-                            ASUnb.To_Unbounded_String("zxyxAda9Xqpqr"),
-                            ASUnb.To_Unbounded_String("xxxyAda9X"),
-                            The_New_Ada);
-            
-       begin
- 
-          -- Examine the version of Trim that removes blanks from
-          -- the left and/or right of a string.
- 
-          for i in 1..4 loop
-             if ASUnb.Trim(Space_Array(i), Ada.Strings.Both) /= Pad then
-                Report.Failed("Incorrect result from Trim for spaces - " &
-                              Integer'Image(i));
-             end if;
-          end loop;   
- 
-          -- Examine the version of Trim that removes set characters from
-          -- the left and right of a string.
- 
-          for i in 1..5 loop
-             if ASUnb.Trim(String_Array(i),
-                           Left   => XYZ_Set,
-                           Right  => PQR_Set) /= The_New_Ada then
-                Report.Failed
-                  ("Incorrect result from Trim for set characters - " &
-                   Integer'Image(i));
-             end if;
-          end loop;   
- 
-       end Trim_Block;
- 
- 
-       -- Delete
- 
-       -- Use the Delete function to remove the first four and last four
-       -- characters from the string.
- 
-       if ASUnb.Delete(Source  => ASUnb.Delete(Magic_String,
-                                               8,
-                                               ASUnb.Length(Magic_String)),
-                       From    => ASUnb.To_String(Magic_String)'First,
-                       Through => 4)   /= 
-          Cad_String
-       then
-          Report.Failed("Incorrect results from Function Delete");
-       end if;
- 
- 
-       -- Constructors ("*")
- 
-       Constructor_Block:
-       declare
-       
-          SOS      : ASUnb.Unbounded_String;
- 
-          Dot      : constant ASUnb.Unbounded_String := 
-                                ASUnb.To_Unbounded_String("Dot_");
-          Dash     : constant String := "Dash_";
- 
-          Distress : ASUnb.Unbounded_String := 
-                       ASUnb.To_Unbounded_String("Dot_Dot_Dot_")    &
-                       ASUnb.To_Unbounded_String("Dash_Dash_Dash_") &
-                       ASUnb.To_Unbounded_String("Dot_Dot_Dot");
-                       
-          Repeat        : constant Natural   := 3;
-          Separator     : constant Character := '_';
- 
-          Separator_Set : Maps.Character_Set := Maps.To_Set(Separator);
- 
-       begin
- 
-          -- Use the following constructor forms to construct the string
-          -- "Dot_Dot_Dot_Dash_Dash_Dash_Dot_Dot_Dot".  Note that the 
-          -- trailing underscore in the string is removed in the call to 
-          -- Trim in the If statement condition.
- 
-          SOS := ASUnb."*"(Repeat, Dot);        -- "*"(#, Unb Str)
- 
-          SOS := SOS                     &
-                 ASUnb."*"(Repeat, Dash) &      -- "*"(#, Str)
-                 ASUnb."*"(Repeat, Dot);        -- "*"(#, Unb Str)
- 
-          if ASUnb.Trim(SOS, Maps.Null_Set, Separator_Set) /= Distress then
-             Report.Failed("Incorrect results from Function ""*""");
-          end if;
- 
-       end Constructor_Block;
-       
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,305 ****
- -- CXA4012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the types, operations, and other entities defined within
- --      the package Ada.Strings.Wide_Maps are available and produce correct
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates the availability and function of the types and
- --      operations defined in package Ada.Strings.Wide_Maps.  It demonstrates
- --      the use of these types and functions as they would be used in common
- --      programming practice.
- --      Wide_Character set creation, assignment, and comparison are evaluated
- --      in this test.  Each of the functions provided in package
- --      Ada.Strings.Wide_Maps is utilized in creating or manipulating set
- --      objects, and the function results are evaluated for correctness.
- --      Wide_Character sequences are examined using the functions provided for 
- --      manipulating objects of this type.  Likewise, Wide_Character maps are
- --      created, and their contents evaluated.  Exception raising conditions
- --      from the function To_Mapping are also created.
- --      Note: Throughout this test, the set logical operators are printed in
- --      capital letters to enhance their visibility.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      01 Nov 95   SAIC    Update and repair for ACVC 2.0.1.
- -- 
- --!
- 
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Maps;
- 
- package CXA40120 is
- 
-    function Equiv (Ch : Character) return Wide_Character;
-    function Equiv (Str : String) 
-      return Ada.Strings.Wide_Maps.Wide_Character_Sequence;
-    function X_Map(From : Wide_Character) return Wide_Character;
- 
- end CXA40120;
- 
- package body CXA40120 is
- 
-    -- The following two functions are used to translate character and string
-    -- values to "Wide" values.  They will be applied to certain Wide_Map
-    -- subprogram parameters to simulate the use of Wide_Characters and 
-    -- Wide_Character_Sequences in actual practice.
-    -- Note: These functions do not actually return "equivalent" wide
-    --       characters to their character inputs, just "non-character"
-    --       wide characters.
- 
-    function Equiv (Ch : Character) return Wide_Character is
-       C : Character := Ch;
-    begin
-       if Ch = ' ' then
-          return Ada.Characters.Handling.To_Wide_Character(C);
-       else
-          return Wide_Character'Val(Character'Pos(Ch) + 
-                 Character'Pos(Character'Last) + 1);
-       end if;
-    end Equiv;
- 
-    function Equiv (Str : String) 
-      return Ada.Strings.Wide_Maps.Wide_Character_Sequence is
-       use Ada.Strings;
-       WS : Wide_Maps.Wide_Character_Sequence(Str'First..Str'Last);
-    begin
-       for i in Str'First..Str'Last loop
-          WS(i) := Equiv(Str(i));
-       end loop;
-       return WS;
-    end Equiv;
- 
-    function X_Map(From : Wide_Character) return Wide_Character is
-    begin
-       return Equiv('X');
-    end X_Map;
- 
- end CXA40120;
- 
- 
- 
- with CXA40120;
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Maps;
- with Report;
- 
- procedure CXA4012 is
- 
-    use CXA40120;
-    use Ada.Strings;
- 
- begin
- 
-    Report.Test ("CXA4012", "Check that the types, operations, and other " &
-                            "entities defined within the package "         &
-                            "Ada.Strings.Wide_Maps are available and "     &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use type Wide_Maps.Wide_Character_Set;
-   
-       MidPoint_Letter  : constant := 13;
-       Last_Letter      : constant := 26;
- 
-       Vowels           : constant Wide_Maps.Wide_Character_Sequence := 
-                            Equiv("aeiou");
-       Quasi_Vowel      : constant Wide_Character := Equiv('y');
- 
-       Alphabet         : Wide_Maps.Wide_Character_Sequence(1..Last_Letter);
-       Half_Alphabet    : Wide_Maps.Wide_Character_Sequence(1..MidPoint_Letter);
-       Inverse_Alphabet : Wide_Maps.Wide_Character_Sequence(1..Last_Letter);
- 
-       Alphabet_Set,
-       Consonant_Set,
-       Vowel_Set,
-       Full_Vowel_Set,
-       First_Half_Set,
-       Second_Half_Set : Wide_Maps.Wide_Character_Set := Wide_Maps.Null_Set;
- 
-    begin
- 
-       -- Load the alphabet string for use in creating sets.
- 
-       for i in 0..MidPoint_Letter-1 loop
-          Half_Alphabet(i+1) := 
-            Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i);
-       end loop;
- 
-       for i in 0..Last_Letter-1 loop
-          Alphabet(i+1) := 
-            Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i);
-       end loop;
- 
- 
-       -- Initialize a series of Wide_Character_Set objects.
-       
-       Alphabet_Set    := Wide_Maps.To_Set(Alphabet);
-       Vowel_Set       := Wide_Maps.To_Set(Vowels);
-       Full_Vowel_Set  := Vowel_Set   OR  Wide_Maps.To_Set(Quasi_Vowel);
-       Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
- 
-       First_Half_Set  := Wide_Maps.To_Set(Half_Alphabet);
-       Second_Half_Set := Alphabet_Set  XOR  First_Half_Set;
- 
- 
-       -- Evaluation of Set objects, operators, and functions.
- 
-       if Alphabet_Set /= (Vowel_Set OR Consonant_Set) then
-          Report.Failed("Incorrect set combinations using OR operator");
-       end if;
- 
- 
-       for i in Vowels'First .. Vowels'Last loop
-          if not Wide_Maps.Is_In(Vowels(i), Vowel_Set)    or
-             not Wide_Maps.Is_In(Vowels(i), Alphabet_Set) or
-             Wide_Maps.Is_In(Vowels(i), Consonant_Set) 
-          then
-             Report.Failed("Incorrect function Is_In use with set " &
-                           "combinations - " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-       if Wide_Maps.Is_Subset(Vowel_Set, First_Half_Set)    or
-          Wide_Maps."<="(Vowel_Set, Second_Half_Set)        or
-          not Wide_Maps.Is_Subset(Vowel_Set, Alphabet_Set)
-       then
-          Report.Failed
-            ("Incorrect set evaluation using Is_Subset function");
-       end if;
- 
-      
-       if not (Full_Vowel_Set = Wide_Maps.To_Set(Equiv("aeiouy"))) then
-          Report.Failed("Incorrect result for ""="" set operator");
-       end if;
- 
- 
-       if not ((Vowel_Set AND First_Half_Set) OR 
-               (Full_Vowel_Set AND Second_Half_Set)) = Full_Vowel_Set then
-          Report.Failed
-            ("Incorrect result for AND, OR, or ""="" set operators");
-       end if;
- 
- 
-       if (Alphabet_Set AND Wide_Maps.Null_Set) /= Wide_Maps.Null_Set  or
-          (Alphabet_Set OR  Wide_Maps.Null_Set) /= Alphabet_Set
-       then
-          Report.Failed("Incorrect result for AND or OR set operators");
-       end if;
- 
- 
-       Vowel_Set := Full_Vowel_Set;
-       Vowel_Set := Vowel_Set AND (NOT Wide_Maps.To_Set(Quasi_Vowel));
-       
-       if not (Vowels = Wide_Maps.To_Sequence(Vowel_Set)) then
-          Report.Failed("Incorrect Set to Sequence translation");
-       end if;
- 
-       
-       for i in 0..Last_Letter-1 loop
-          Inverse_Alphabet(i+1) := Alphabet(Last_Letter-i);
-       end loop;
- 
- 
-       -- Wide_Character_Mapping
- 
-       declare
-          Inverse_Map : Wide_Maps.Wide_Character_Mapping :=
-                          Wide_Maps.To_Mapping(Alphabet, Inverse_Alphabet);
-       begin
-          if Wide_Maps.Value(Wide_Maps.Identity, Equiv('b')) /= 
-             Wide_Maps.Value(Inverse_Map, Equiv('y'))       
-          then
-             Report.Failed("Incorrect Inverse mapping");
-          end if;
-       end;
- 
- 
-       -- Check that Translation_Error is raised when a character is
-       -- repeated in the parameter "From" string.
-       declare
-          Bad_Map : Wide_Maps.Wide_Character_Mapping;
-       begin
-          Bad_Map := Wide_Maps.To_Mapping(From => Equiv("aa"), 
-                                          To   => Equiv("yz"));
-          Report.Failed("Exception not raised with repeated character");
-       exception
-          when Translation_Error => null;  -- OK
-          when others            => 
-             Report.Failed("Incorrect exception raised in To_Mapping with " &
-                           "a repeated character");
-       end;
- 
- 
-       -- Check that Translation_Error is raised when the parameters of the
-       -- function To_Mapping are of unequal lengths.
-       declare
-          Bad_Map : Wide_Maps.Wide_Character_Mapping;
-       begin
-          Bad_Map := Wide_Maps.To_Mapping(Equiv("abc"), Equiv("yz"));
-          Report.Failed
-            ("Exception not raised with unequal parameter lengths");
-       exception
-          when Translation_Error => null;  -- OK
-          when others            => 
-             Report.Failed("Incorrect exception raised in To_Mapping with " &
-                           "unequal parameter lengths");
-       end;
- 
- 
-       -- Check that the access-to-subprogram type is defined and available.
-       -- This provides for one Wide_Character mapping capability only.
-       -- The actual mapping functionality will be tested in conjunction with
-       -- the tests of subprograms defined for Wide_String handling.
- 
-       declare
- 
-          X_Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function := 
-                        X_Map'Access;
- 
-       begin
-          if X_Map_Ptr(Equiv('A')) /=    -- both return 'X'
-             X_Map_Ptr.all(Equiv('Q')) 
-          then  
-             Report.Failed
-               ("Incorrect result using access-to-subprogram values");
-          end if;
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,203 ****
- -- CXA4013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Wide_Fixed
- --      are available, and that they produce correct results.  Specifically,
- --      check the subprograms Index, "*" (Wide_String constructor function),
- --      Count, Trim, and Replace_Slice.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates how certain Wide_Fixed string functions
- --      are used to eliminate specific substrings from portions of text.  
- --      A procedure is defined that will take as parameters a source 
- --      Wide_String along with a substring that is to be completely removed
- --      from the source string.  The source Wide_String is parsed using the
- --      Index function, and any substring slices are replaced in the source
- --      Wide_String by a series of X's (based on the length of the substring.)  
- --      Three lines of text are provided to this procedure, and the resulting
- --      substitutions are compared with expected results to validate the 
- --      string processing.
- --      A global accumulator is updated with the number of occurrences of the
- --      substring in the source string.  
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Strings;
- with Ada.Strings.Wide_Fixed;
- with Ada.Strings.Wide_Maps;
- with Report;
- 
- procedure CXA4013 is
- 
- begin
- 
-    Report.Test ("CXA4013", "Check that the subprograms defined in package "  &
-                            "Ada.Strings.Wide_Fixed are available, and that " &
-                            "they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       TC_Total        : Natural  := 0;
-       Number_Of_Lines : constant := 3;
-       WC              : Wide_Character := 
-                           Wide_Character'Val(Character'Pos('X')            + 
-                                              Character'Pos(Character'Last) + 
-                                              1 );
- 
-       subtype WS is Wide_String (1..25);
- 
-       type Restricted_Words_Array_Type is 
-         array (1..10) of Wide_String (1..10);
- 
-       Restricted_Words : Restricted_Words_Array_Type := 
-                            ("   platoon", " marines  ", "  Marines ",
-                             "north     ", "south     ", "      east", 
-                             "  beach   ", "   airport", "airfield  ", 
-                             "     road ");
- 
-       type Page_Of_Text_Type is array (1..Number_Of_Lines) of WS;
- 
-       Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
-                                         "moved south on the south ",
-                                         "road to the airfield.    ");
- 
-       TC_Revised_Line_1 : constant Wide_String := "The XXXXXXX of XXXXXXX   ";
-       TC_Revised_Line_2 : constant Wide_String := "moved XXXXX on the XXXXX ";
-       TC_Revised_Line_3 : constant Wide_String := "XXXX to the XXXXXXXX.    ";
- 
- 
-       function Equivalent (Left : WS;  Right : Wide_String) 
-         return Boolean is
-       begin
-          for i in WS'range loop
-             if Left(i) /= Right(i) then
-                if Left(i) /= WC   or  Right(i) /= 'X' then
-                   return False;
-                end if;
-             end if;
-          end loop;
-          return True;
-       end Equivalent;
- 
-       ---
- 
-       procedure Censor (Source_String  : in out Wide_String;
-                         Pattern_String : in     Wide_String) is
-                         
-          use Ada.Strings.Wide_Fixed; -- allows infix notation of "*" below.
- 
-          -- Create a replacement string that is the same length as the
-          -- pattern string being removed.  Use the infix notation of the 
-          -- wide string constructor function.
- 
-          Replacement : constant Wide_String :=                       
-                          Pattern_String'Length * WC;                 -- "*"
- 
-          Going     : Ada.Strings.Direction := Ada.Strings.Forward;   
-          Start_Pos,
-          Index     : Natural := Source_String'First;
- 
-       begin  -- Censor
- 
-          -- Accumulate count of total replacement operations.
- 
-          TC_Total := TC_Total +                                     
-                       Ada.Strings.Wide_Fixed.Count                  -- Count
-                         (Source  => Source_String,
-                          Pattern => Pattern_String,
-                          Mapping => Ada.Strings.Wide_Maps.Identity);
-          loop
- 
-             Index := Ada.Strings.Wide_Fixed.Index                   -- Index
-                        (Source_String(Start_Pos..Source_String'Last),
-                         Pattern_String, 
-                         Going, 
-                         Ada.Strings.Wide_Maps.Identity);
- 
-             exit when Index = 0;   -- No matches, exit loop.
- 
-             -- if a match was found, modify the substring.
-             Ada.Strings.Wide_Fixed.Replace_Slice              -- Replace_Slice
-                                      (Source_String,
-                                       Index,
-                                       Index + Pattern_String'Length - 1,
-                                       Replacement);
-             Start_Pos := Index + Pattern_String'Length;
- 
-          end loop;
- 
-       end Censor;
- 
- 
-    begin
- 
-       -- Invoke Censor subprogram to cleanse text.
-       -- Loop through each line of text, and check for the presence of each
-       -- restricted word.
-       -- Use the Trim function to eliminate leading or trailing blanks from
-       -- the restricted word parameters.
- 
-       for Line in 1..Number_Of_Lines loop
-          for Word in Restricted_Words'Range loop
-              Censor (Text_Page(Line),                                 -- Trim
-                      Ada.Strings.Wide_Fixed.Trim(Restricted_Words(Word),
-                                                  Ada.Strings.Both));
-          end loop;
-       end loop;
- 
- 
-       -- Validate results.
- 
-       if TC_Total /= 6 then
-          Report.Failed ("Incorrect number of substitutions performed");
-       end if;
- 
-       if not Equivalent (Text_Page(1), TC_Revised_Line_1) then
-          Report.Failed ("Incorrect substitutions on Line 1");
-       end if;
- 
-       if not Equivalent (Text_Page(2), TC_Revised_Line_2) then
-          Report.Failed ("Incorrect substitutions on Line 2");
-       end if;
- 
-       if not Equivalent (Text_Page(3), TC_Revised_Line_3) then
-          Report.Failed ("Incorrect substitutions on Line 3");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,359 ****
- -- CXA4014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Wide_Fixed
- --      are available, and that they produce correct results.  Specifically, 
- --      check the subprograms Find_Token, Head, Index, Index_Non_Blank, Move,
- --      Overwrite, and Replace_Slice, Tail, and Translate. 
- --      Use the access-to-subprogram mapping version of Translate (function
- --      and procedure).
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates how certain wide fixed string operations could
- --      be used in wide string information processing.  A procedure is defined
- --      that will extract portions of a 50 character string that correspond to
- --      certain data items (i.e., name, address, state, zip code). These
- --      parsed items will then be added to the appropriate fields of data
- --      base elements.  These data base elements are then compared for
- --      accuracy against a similar set of predefined data base
- --      elements.
- --      A variety of wide fixed string processing subprograms are used in this
- --      test.  Each parsing operation attempts to use a different combination
- --      of the available subprograms to accomplish the same goal, therefore
- --      continuity of approach to wide string parsing is not seen in this
- --      test.
- --      However, a wide variety of possible approaches are demonstrated, while
- --      exercising a large number of the total predefined subprograms of
- --      package Ada.Strings.Wide_Fixed.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 Nov 95   SAIC    Update and repair for ACVC 2.0.1.
- --
- --!
- 
- package CXA40140 is
- 
-    UnderScore  : Wide_Character := '_';
-    Blank       : Wide_Character := ' ';
- 
-    -- Function providing a mapping to a blank Wide_Character.
-    function US_to_Blank_Map (From : Wide_Character) return Wide_Character;
- 
- end CXA40140;
- 
- package body CXA40140 is
- 
-    function US_to_Blank_Map (From : Wide_Character) return Wide_Character is
-    begin
-       if From = UnderScore then
-          return Blank;
-       else
-          return From;
-       end if;
-    end US_to_Blank_Map;
- 
- end CXA40140;
- 
- 
- with CXA40140;
- with Ada.Strings.Wide_Fixed;
- with Ada.Strings.Wide_Maps;
- with Report;
- 
- procedure CXA4014 is
-    use CXA40140;
- begin
- 
-    Report.Test ("CXA4014", "Check that the subprograms defined in package "  &
-                            "Ada.Strings.Wide_Fixed are available, and that " &
-                            "they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       Number_Of_Info_Strings : constant Natural := 3;
-       DB_Size                : constant Natural := Number_Of_Info_Strings;
-       Count                  : Natural          := 0;
-       Finished_Processing    : Boolean          := False;
-       Blank_Wide_String      : constant Wide_String  := " ";
- 
-       subtype Info_Wide_String_Type         is Wide_String (1..50);
-       type    Info_Wide_String_Storage_Type is 
-                 array (1..Number_Of_Info_Strings) of Info_Wide_String_Type;
- 
- 
-       subtype Name_Type                is Wide_String (1..10);
-       subtype Street_Number_Type       is Wide_String (1..5);
-       subtype Street_Name_Type         is Wide_String (1..10);
-       subtype City_Type                is Wide_String (1..10);
-       subtype State_Type               is Wide_String (1..2);
-       subtype Zip_Code_Type            is Wide_String (1..5);
- 
-       type Data_Base_Element_Type is
-          record
-             Name          : Name_Type          := (others => ' ');
-             Street_Number : Street_Number_Type := (others => ' ');
-             Street_Name   : Street_Name_Type   := (others => ' ');
-             City          : City_Type          := (others => ' ');
-             State         : State_Type         := (others => ' ');
-             Zip_Code      : Zip_Code_Type      := (others => ' ');
-          end record;
- 
-       type Data_Base_Type is array (1..DB_Size) of Data_Base_Element_Type;
- 
-       Data_Base : Data_Base_Type;
- 
-       ---
- 
-       Info_String_1 : Info_Wide_String_Type := 
-         "Joe_Jones 123   Sixth_St   San_Diego    CA   98765"; 
- 
-       Info_String_2 : Info_Wide_String_Type := 
-         "Sam_Smith 56789  S._Seventh   Carlsbad  CA   92177";
- 
-       Info_String_3 : Info_Wide_String_Type := 
-         "Jane_Brown 1219   Info_Lane  Tuscon     AZ   85643";
- 
- 
-       Info_Strings : Info_Wide_String_Storage_Type :=
-                        (1 => Info_String_1,
-                         2 => Info_String_2,
-                         3 => Info_String_3);
- 
- 
- 
-       TC_DB_Element_1 : Data_Base_Element_Type := 
-         ("Joe Jones ", "123  ", "Sixth St  ", "San Diego ", "CA", "98765");
- 
-       TC_DB_Element_2 : Data_Base_Element_Type := 
-         ("Sam Smith ", "56789", "S. Seventh", "Carlsbad  ", "CA", "92177");
- 
-       TC_DB_Element_3 : Data_Base_Element_Type := 
-         ("Jane Brown", "1219 ", "Info Lane ", "Tuscon    ", "AZ", "85643");
- 
-       TC_Data_Base : Data_Base_Type := (TC_DB_Element_1,
-                                         TC_DB_Element_2,
-                                         TC_DB_Element_3);
- 
-       ---
- 
- 
-       procedure Store_Information 
-          (Info_String : in     Info_Wide_String_Type;
-           DB_Record   : in out Data_Base_Element_Type) is
- 
-          package  AS renames Ada.Strings;
-          use type AS.Wide_Maps.Wide_Character_Set;
- 
-          Start,
-          Stop        : Natural := 0;
- 
-          Numeric_Set    : constant AS.Wide_Maps.Wide_Character_Set :=
-                             AS.Wide_Maps.To_Set("0123456789");
- 
-          Cal            : constant 
-                             AS.Wide_Maps.Wide_Character_Sequence := "CA";
-          California_Set : constant AS.Wide_Maps.Wide_Character_Set := 
-                             AS.Wide_Maps.To_Set(Cal);
-          Arizona_Set    : constant AS.Wide_Maps.Wide_Character_Set := 
-                             AS.Wide_Maps.To_Set("AZ");
-          Nevada_Set     : constant AS.Wide_Maps.Wide_Character_Set := 
-                             AS.Wide_Maps.To_Set("NV");
- 
-          Blank_Ftn_Ptr : AS.Wide_Maps.Wide_Character_Mapping_Function :=
-                            US_to_Blank_Map'Access;
- 
-       begin
- 
-          -- Find the starting position of the name field (first non-blank),
-          -- then, from that position, find the end of the name field (first
-          -- blank).
- 
-          Start := AS.Wide_Fixed.Index_Non_Blank(Info_String); 
-          Stop  := AS.Wide_Fixed.Index (Info_String(Start..Info_String'Length),
-                                        AS.Wide_Maps.To_Set(Blank),
-                                        AS.Inside,
-                                        AS.Forward) - 1 ;
- 
-          -- Store the name field in the data base element field for "Name".
- 
-          DB_Record.Name := AS.Wide_Fixed.Head(Info_String(1..Stop), 
-                                          DB_Record.Name'Length);
- 
-          -- Replace any underscore characters in the name field
-          -- that were used to separate first/middle/last names.
-          -- Use the overloaded version of Translate that takes an
-          -- access-to-subprogram value.
- 
-          AS.Wide_Fixed.Translate (DB_Record.Name, Blank_Ftn_Ptr);
- 
-          
-          -- Continue the extraction process; now find the position of
-          -- the street number in the string.
- 
-          Start := Stop + 1;
- 
-          AS.Wide_Fixed.Find_Token(Info_String(Start..Info_String'Length),
-                                   Numeric_Set,
-                                   AS.Inside,
-                                   Start,
-                                   Stop);
- 
-          -- Store the street number field in the appropriate data base 
-          -- element.
-          -- No modification of the default parameters of procedure Move
-          -- is required.
- 
-          AS.Wide_Fixed.Move(Source => Info_String(Start..Stop),
-                             Target => DB_Record.Street_Number);
- 
- 
-          -- Continue the extraction process; find the street name in the
-          -- info string.  Skip blanks to the start of the street name, then
-          -- search for the index of the next blank character in the string.
- 
-          Start := AS.Wide_Fixed.Index_Non_Blank
-                                   (Info_String(Stop+1..Info_String'Length)); 
- 
-          Stop := 
-            AS.Wide_Fixed.Index(Info_String(Start..Info_String'Length),
-                                Blank_Wide_String) - 1; 
- 
-          -- Store the street name in the appropriate data base element field.
- 
-          AS.Wide_Fixed.Overwrite(DB_Record.Street_Name, 
-                                  1, 
-                                  Info_String(Start..Stop));
-                            
-          -- Replace any underscore characters in the street name field
-          -- that were used as word separation with blanks.  Again, use the 
-          -- access-to-subprogram value to provide the mapping.
-          
-          DB_Record.Street_Name := 
-            AS.Wide_Fixed.Translate(DB_Record.Street_Name, 
-                                    Blank_Ftn_Ptr);
- 
- 
-          -- Continue the extraction; remove the city name from the string.
- 
-          Start := AS.Wide_Fixed.Index_Non_Blank
-                                   (Info_String(Stop+1..Info_String'Length)); 
- 
-          Stop := 
-            AS.Wide_Fixed.Index(Info_String(Start..Info_String'Length), 
-                                Blank_Wide_String) - 1; 
- 
-          -- Store the city name field in the appropriate data base element.
- 
-          AS.Wide_Fixed.Replace_Slice(DB_Record.City, 
-                                      1,
-                                      DB_Record.City'Length,
-                                      Info_String(Start..Stop));
-                            
-          -- Replace any underscore characters in the city name field
-          -- that were used as word separation.
-          
-          AS.Wide_Fixed.Translate (DB_Record.City, 
-                                   Blank_Ftn_Ptr);
- 
- 
-          -- Continue the extraction; remove the state identifier from the 
-          -- info string.
- 
-          Start := Stop + 1;
- 
-          AS.Wide_Fixed.Find_Token(Info_String(Start..Info_String'Length),
-                                   AS.Wide_Maps."OR"(California_Set,
-                                     AS.Wide_Maps."OR"(Nevada_Set,
-                                                       Arizona_Set)),
-                                   AS.Inside,
-                                   Start,
-                                   Stop);
- 
-          -- Store the state indicator into the data base element.
- 
-          AS.Wide_Fixed.Move(Source  => Info_String(Start..Stop),
-                             Target  => DB_Record.State,
-                             Drop    => Ada.Strings.Right,
-                             Justify => Ada.Strings.Left,
-                             Pad     => AS.Wide_Space);
- 
- 
-          -- Continue the extraction process; remove the final data item in 
-          -- the info string, the zip code, and place it into the 
-          -- corresponding data base element.
- 
-          DB_Record.Zip_Code := 
-            AS.Wide_Fixed.Tail(Info_String, DB_Record.Zip_Code'Length);
- 
-       exception 
-          when AS.Length_Error      =>
-             Report.Failed ("Length_Error raised in procedure");
-          when AS.Pattern_Error     =>
-             Report.Failed ("Pattern_Error raised in procedure");
-          when AS.Translation_Error =>
-             Report.Failed ("Translation_Error raised in procedure");
-          when others            =>
-             Report.Failed ("Exception raised in procedure");
-       end Store_Information;
- 
- 
-    begin
- 
-       -- Loop thru the information strings, extract the name and address
-       -- information, place this info into elements of the data base.
- 
-       while not Finished_Processing loop
- 
-          Count := Count + 1;
- 
-          Store_Information (Info_Strings(Count), Data_Base(Count));
- 
-          Finished_Processing := (Count = Number_Of_Info_Strings);
- 
-       end loop;
- 
- 
-       -- Verify that the string processing was successful.
- 
-       for i in 1..DB_Size loop
-          if Data_Base(i) /= TC_Data_Base(i) then
-             Report.Failed 
-               ("Data processing error on record " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,580 ****
- -- CXA4015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Wide_Fixed
- --      are available, and that they produce correct results.  Specifically, 
- --      check the subprograms Count, Find_Token, Index, Index_Non_Blank, and
- --      Move.
- --      
- -- TEST DESCRIPTION:
- --      This test, when combined with tests CXA4013,14,16 will provide 
- --      coverage of the functionality found in Ada.Strings.Wide_Fixed.  
- --      This test contains many small, specific test cases, situations that 
- --      although common in user environments, are often difficult to generate 
- --      in large numbers in a application-based test.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      02 Nov 95   SAIC    Corrected various accesssibility problems and
- --                          expected result strings for ACVC 2.0.1.
- --
- --!
- 
- package CXA40150 is
- 
-    -- Wide Character mapping function defined for use with specific 
-    -- versions of functions Index and Count.
- 
-    function AK_to_ZQ_Mapping (From : Wide_Character) return Wide_Character;
- 
- end CXA40150;
- 
- package body CXA40150 is
- 
-    function AK_to_ZQ_Mapping (From : Wide_Character) 
-      return Wide_Character is
-    begin
-       if From = 'a' then
-          return 'z';
-       elsif From = 'k' then
-          return 'q';
-       else
-          return From;
-       end if;
-    end AK_to_ZQ_Mapping;
- 
- end CXA40150;
- 
- 
- with CXA40150;
- with Report;
- with Ada.Strings;
- with Ada.Strings.Wide_Fixed;
- with Ada.Strings.Wide_Maps;
- 
- procedure CXA4015 is
- begin
- 
-    Report.Test("CXA4015", "Check that the subprograms defined in "         &
-                           "package Ada.Strings.Wide_Fixed are available, " &
-                           "and that they produce correct results");
- 
- 
-    Test_Block:
-    declare
- 
-       use CXA40150;
- 
-       package ASF  renames Ada.Strings.Wide_Fixed;
-       package Maps renames Ada.Strings.Wide_Maps;
- 
-       Result_String  : Wide_String(1..10) := 
-                           (others => Ada.Strings.Wide_Space);
- 
-       Source_String1 : Wide_String(1..5)  := "abcde";  -- odd len Wide_String
-       Source_String2 : Wide_String(1..6)  := "abcdef"; -- even len Wide_String
-       Source_String3 : Wide_String(1..12) := "abcdefghijkl";   
-       Source_String4 : Wide_String(1..12) := "abcdefghij  "; -- last 2 ch pad
-       Source_String5 : Wide_String(1..12) := "  cdefghijkl"; -- first 2 ch pad
-       Source_String6 : Wide_String(1..12) := "abcdefabcdef";   
-       
-       Location       : Natural := 0;
-       Slice_Start    : Positive;
-       Slice_End,
-       Slice_Count    : Natural := 0;
- 
-       CD_Set         : Maps.Wide_Character_Set := Maps.To_Set("cd");  
-       ABCD_Set       : Maps.Wide_Character_Set := Maps.To_Set("abcd");
-       A_to_F_Set     : Maps.Wide_Character_Set := Maps.To_Set("abcdef");
-                   
-       CD_to_XY_Map   : Maps.Wide_Character_Mapping :=
-                          Maps.To_Mapping(From => "cd",  To => "xy");
- 
- 
-       -- Access-to-Subprogram object defined for use with specific versions of 
-       -- functions Index and Count.
-       
-       Map_Ptr : Maps.Wide_Character_Mapping_Function := 
-                   AK_to_ZQ_Mapping'Access;
- 
- 
-    begin
- 
- 
-       -- Procedure Move
-       -- Evaluate the Procedure Move with various combinations of
-       -- parameters.
- 
-       -- Justify = Left (default case)
- 
-       ASF.Move(Source => Source_String1,       -- "abcde"
-                Target => Result_String);
-       
-       if Result_String /= "abcde     " then
-          Report.Failed("Incorrect result from Move with Justify = Left");
-       end if;
-  
-       -- Justify = Right
-  
-       ASF.Move(Source  => Source_String2,      -- "abcdef"
-                Target  => Result_String,
-                Drop    => Ada.Strings.Error,
-                Justify => Ada.Strings.Right);
- 
-       if Result_String /= "    abcdef" then
-          Report.Failed("Incorrect result from Move with Justify = Right");
-       end if;
- 
-       -- Justify = Center (two cases, odd and even pad lengths)
-  
-       ASF.Move(Source_String1,                 -- "abcde"
-                Result_String,
-                Ada.Strings.Error,
-                Ada.Strings.Center,
-                'x');                           -- non-default padding.
- 
-       if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
-          Report.Failed("Incorrect result from Move with Justify = Center-1");
-       end if;
- 
-       ASF.Move(Source_String2,                 -- "abcdef"
-                Result_String,
-                Ada.Strings.Error,
-                Ada.Strings.Center);
- 
-       if Result_String /= "  abcdef  " then  -- Equal padding added on L/R.
-          Report.Failed("Incorrect result from Move with Justify = Center-2");
-       end if;
- 
-       -- When the source Wide_String is longer than the target Wide_String,
-       -- several cases can be examined, with the results depending on the 
-       -- value of the Drop parameter.
- 
-       -- Drop = Left
- 
-       ASF.Move(Source => Source_String3,       -- "abcdefghijkl"
-                Target => Result_String,
-                Drop   => Ada.Strings.Left);
- 
-       if Result_String /= "cdefghijkl" then
-          Report.Failed("Incorrect result from Move with Drop = Left");
-       end if;
- 
-       -- Drop = Right
-      
-       ASF.Move(Source_String3, Result_String, Ada.Strings.Right);
- 
-       if Result_String /= "abcdefghij" then
-          Report.Failed("Incorrect result from Move with Drop = Right");
-       end if;
- 
-       -- Drop = Error
-       -- The effect in this case depends on the value of the justify
-       -- parameter, and on whether any characters in Source other than 
-       -- Pad would fail to be copied.
- 
-       -- Drop = Error, Justify = Left, right overflow characters are pad.
- 
-       ASF.Move(Source  => Source_String4,      -- "abcdefghij  "
-                Target  => Result_String,
-                Drop    => Ada.Strings.Error,
-                Justify => Ada.Strings.Left);
- 
-       if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
-           Report.Failed("Incorrect result from Move with Drop = Error - 1");
-       end if;
- 
-       -- Drop = Error, Justify = Right, left overflow characters are pad.
- 
-       ASF.Move(Source_String5,                 -- "  cdefghijkl"
-                Result_String, 
-                Ada.Strings.Error, 
-                Ada.Strings.Right);
- 
-       if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
-          Report.Failed("Incorrect result from Move with Drop = Error - 2");
-       end if;
- 
-       -- In other cases of Drop=Error, Length_Error is propagated, such as:
- 
-       begin
- 
-          ASF.Move(Source_String3,     -- 12 characters, no Pad.
-                   Result_String,      -- 10 characters
-                   Ada.Strings.Error,  
-                   Ada.Strings.Left);  
- 
-          Report.Failed("Length_Error not raised by Move - 1");
- 
-       exception
-          when Ada.Strings.Length_Error => null;   -- OK
-          when others => 
-             Report.Failed("Incorrect exception raised by Move - 1");
-       end;
- 
- 
- 
-       -- Function Index
-       -- (Other usage examples of this function found in CXA4013-14.)
-       -- Check when the pattern is not found in the source.
- 
-       if ASF.Index("abcdef", "gh")       /= 0 or
-          ASF.Index("abcde",  "abcdef")   /= 0 or  -- pattern > source
-          ASF.Index("xyz", 
-                    "abcde", 
-                    Ada.Strings.Backward) /= 0 or
-          ASF.Index("",      "ab")        /= 0 or  -- null source Wide_String.
-          ASF.Index("abcde", "  ")        /= 0     -- blank pattern.
-       then
-          Report.Failed("Incorrect result from Index, no pattern match");
-       end if;
- 
-       -- Check that Pattern_Error is raised when the pattern is the 
-       -- null Wide_String.
-       begin
-          Location := ASF.Index(Source_String6,    -- "abcdefabcdef"
-                                "",                -- null pattern Wide_String.
-                                Ada.Strings.Forward);
-          Report.Failed("Pattern_Error not raised by Index");
-       exception
-          when Ada.Strings.Pattern_Error => null;  -- OK, expected exception.
-          when others                    =>
-            Report.Failed("Incorrect exception raised by Index, null pattern");
-       end;
- 
-       -- Use the search direction "backward" to locate the particular
-       -- pattern within the source Wide_String.
- 
-       Location := ASF.Index(Source_String6,         -- "abcdefabcdef"
-                             "de",                   -- slice 4..5, 10..11
-                             Ada.Strings.Backward);  -- search from right end.
- 
-       if Location /= 10  then
-          Report.Failed("Incorrect result from Index going Backward");
-       end if;
- 
- 
- 
-       -- Function Index
-       -- Use the version of Index that takes a Wide_Character_Mapping_Function
-       -- parameter.
-       -- Use the search directions Forward and Backward to locate the 
-       -- particular pattern wide string within the source wide string.
-       
-       Location := ASF.Index("akzqefakzqef",
-                             "qzq",                  -- slice 8..10
-                             Ada.Strings.Backward,
-                             Map_Ptr);      -- perform 'a' to 'z', 'k' to 'q'
-                                            -- translation. 
-       if Location /= 8  then
-          Report.Failed
-            ("Incorrect result from Index w/map ptr going Backward");
-       end if;
- 
-       Location := ASF.Index("ddkkddakcdakdefcadckdfzaaqd",
-                             "zq",                  -- slice 7..8
-                             Ada.Strings.Forward,
-                             Map_Ptr);      -- perform 'a' to 'z', 'k' to 'q'
-                                            -- translation. 
-       if Location /= 7  then
-          Report.Failed
-            ("Incorrect result from Index w/map ptr going Forward");
-       end if;
- 
- 
-       if ASF.Index("aakkzq", "zq",   Ada.Strings.Forward,  Map_Ptr) /= 2 or
-          ASF.Index("qzedka", "qz",   Ada.Strings.Backward, Map_Ptr) /= 5 or
-          ASF.Index("zazaza", "zzzz", Ada.Strings.Backward, Map_Ptr) /= 3 or
-          ASF.Index("kka",    "qqz",  Ada.Strings.Forward,  Map_Ptr) /= 1
-       then
-          Report.Failed("Incorrect result from Index w/map ptr");
-       end if;
- 
- 
-       -- Check when the pattern wide string is not found in the source.
- 
-       if ASF.Index("akzqef", "kzq",    Ada.Strings.Forward,  Map_Ptr) /= 0 or
-          ASF.Index("abcde",  "abcdef", Ada.Strings.Backward, Map_Ptr) /= 0 or
-          ASF.Index("xyz",    "akzde",  Ada.Strings.Backward, Map_Ptr) /= 0 or
-          ASF.Index("",       "zq",     Ada.Strings.Forward,  Map_Ptr) /= 0 or
-          ASF.Index("akcde",  "  ",     Ada.Strings.Backward, Map_Ptr) /= 0
-       then
-          Report.Failed
-            ("Incorrect result from Index w/map ptr, no pattern match");
-       end if;
- 
-       -- Check that Pattern_Error is raised when the pattern is a 
-       -- null Wide_String.
-       begin
-          Location := ASF.Index("akzqefakqzef",
-                                "",                -- null pattern Wide_String.
-                                Ada.Strings.Forward,
-                                Map_Ptr);
-          Report.Failed("Pattern_Error not raised by Index w/map ptr");
-       exception
-          when Ada.Strings.Pattern_Error => null;  -- OK, expected exception.
-          when others                    =>
-            Report.Failed
-              ("Incorrect exception raised by Index w/map ptr, null pattern");
-       end;
- 
- 
- 
-       -- Function Index
-       -- Using the version of Index testing wide character set membership, 
-       -- check combinations of forward/backward, inside/outside parameter
-       -- configurations.
- 
-       if ASF.Index(Source => Source_String1,              -- "abcde"
-                    Set    => CD_Set,
-                    Test   => Ada.Strings.Inside,
-                    Going  => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3.
-          ASF.Index(Source_String6,                        -- "abcdefabcdef"
-                    CD_Set,
-                    Ada.Strings.Outside,
-                    Ada.Strings.Backward)  /=  12  or   -- 'f' at position 12
-          ASF.Index(Source_String6,                     -- "abcdefabcdef"
-                    CD_Set,
-                    Ada.Strings.Inside,
-                    Ada.Strings.Backward)  /=   10  or  -- 'd' at position 10
-          ASF.Index("cdcdcdcdacdcdcdcd",               
-                    CD_Set,
-                    Ada.Strings.Outside,
-                    Ada.Strings.Forward)   /=    9      -- 'a' at position 9
-       then
-          Report.Failed("Incorrect result from function Index for sets - 1");
-       end if;
- 
-       -- Additional interesting uses/combinations using Index for sets.
- 
-       if ASF.Index("cd",                               -- same size, str-set
-                    CD_Set,
-                    Ada.Strings.Inside,
-                    Ada.Strings.Forward)   /=    1  or  -- 'c' at position 1
-          ASF.Index("abcd",                             -- same size, str-set,
-                    Maps.To_Set("efgh"),                -- different contents.
-                    Ada.Strings.Outside,                
-                    Ada.Strings.Forward)   /=    1  or
-          ASF.Index("abccd",                            -- set > Wide_String
-                    Maps.To_Set("acegik"),
-                    Ada.Strings.Inside,
-                    Ada.Strings.Backward)  /=    4  or  -- 'c' at position 4
-          ASF.Index("abcde",
-                    Maps.Null_Set)         /=    0  or
-          ASF.Index("",                                 -- Null string.
-                    CD_Set)                /=    0  or
-          ASF.Index("abc ab",                           -- blank included
-                    Maps.To_Set("e "),                  -- in Wide_String and
-                    Ada.Strings.Inside,                 -- set.
-                    Ada.Strings.Backward)  /=    4      -- blank in Wide_Str.
-       then
-          Report.Failed("Incorrect result from function Index for sets - 2");
-       end if;
- 
- 
- 
-       -- Function Index_Non_Blank.
-       -- (Other usage examples of this function found in CXA4013-14.)
-                                                          
- 
-       if ASF.Index_Non_Blank(Source => Source_String4,  -- "abcdefghij  "
-                              Going  => Ada.Strings.Backward)  /= 10  or
-          ASF.Index_Non_Blank("abc def ghi jkl  ",
-                              Ada.Strings.Backward)            /= 15  or
-          ASF.Index_Non_Blank("  abcdef")                      /=  3  or
-          ASF.Index_Non_Blank("        ")                      /=  0
-       then
-           Report.Failed("Incorrect result from Index_Non_Blank");
-       end if;
- 
- 
- 
-       -- Function Count
-       -- (Other usage examples of this function found in CXA4013-14.)
- 
-       if ASF.Count("abababa",   "aba")            /=  2  or
-          ASF.Count("abababa",   "ab" )            /=  3  or
-          ASF.Count("babababa",  "ab")             /=  3  or
-          ASF.Count("abaabaaba", "aba")            /=  3  or
-          ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy")  /=  1  or
-          ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x")   /= 20
-       then
-          Report.Failed("Incorrect result from Function Count");
-       end if;
- 
-       -- Determine the number of slices of Source that when mapped to a 
-       -- non-identity map, match the pattern Wide_String.
- 
-       Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef"
-                                "xy",
-                                CD_to_XY_Map);  -- maps 'c' to 'x', 'd' to 'y'
- 
-       if Slice_Count /= 2 then  -- two slices "xy" in "mapped" Source_String6
-          Report.Failed("Incorrect result from Count with non-identity map");
-       end if;
- 
-       -- If the pattern supplied to Function Count is the null Wide_String,
-       -- then Pattern_Error is propagated.
-       declare
-          The_Null_Wide_String : constant Wide_String := "";
-       begin
-          Slice_Count := ASF.Count(Source_String6, The_Null_Wide_String);
-          Report.Failed("Pattern_Error not raised by Function Count");
-       exception
-          when Ada.Strings.Pattern_Error => null;   -- OK
-          when others =>
-            Report.Failed("Incorrect exception from Count with null pattern");
-       end;
- 
- 
- 
- 
-       -- Function Count
-       -- Use the version of Count that takes a Wide_Character_Mapping_Function
-       -- value as the basis of its source mapping.
-       
-       if ASF.Count("akakaka",      "zqz", Map_Ptr)          /=  2  or
-          ASF.Count("akakaka",      "qz",  Map_Ptr)          /=  3  or
-          ASF.Count("kakakaka",     "q",   Map_Ptr)          /=  4  or
-          ASF.Count("zzqaakzaqzzk", "zzq", Map_Ptr)          /=  4  or
-          ASF.Count("   ",          "z",   Map_Ptr)          /=  0  or
-          ASF.Count("",             "qz",  Map_Ptr)          /=  0  or
-          ASF.Count("abbababab",    "zq",  Map_Ptr)          /=  0  or
-          ASF.Count("aaaaaaaaaaaaaaaaaakk", "zqq", Map_Ptr)  /=  1  or
-          ASF.Count("azaazaazzzaaaaazzzza", "z",   Map_Ptr)  /= 20  
-       then
-          Report.Failed("Incorrect result from Function Count w/map ptr");
-       end if;
- 
-       -- If the pattern supplied to Function Count is a null Wide_String,
-       -- then Pattern_Error is propagated.
-       declare
-          The_Null_Wide_String : constant Wide_String := "";
-       begin
-          Slice_Count := ASF.Count(Source_String6, 
-                                   The_Null_Wide_String, 
-                                   Map_Ptr);
-          Report.Failed
-            ("Pattern_Error not raised by Function Count w/map ptr");
-       exception
-          when Ada.Strings.Pattern_Error => null;   -- OK
-          when others =>
-            Report.Failed
-              ("Incorrect exception from Count w/map ptr, null pattern");
-       end;
- 
- 
- 
- 
-       -- Function Count returning the number of characters in a particular
-       -- set that are found in source Wide_String.
- 
-       if ASF.Count(Source_String6, CD_Set) /=  4 or  -- 2 'c' and 'd' chars.
-          ASF.Count("cddaccdaccdd", CD_Set) /= 10
-       then
-          Report.Failed("Incorrect result from Count with set");
-       end if;
- 
- 
-  
-       -- Function Find_Token.
-       -- (Other usage examples of this function found in CXA4013-14.)
- 
-       ASF.Find_Token(Source  => Source_String6,      -- First slice with no 
-                      Set     => ABCD_Set,            -- 'a', 'b', 'c', or 'd'
-                      Test    => Ada.Strings.Outside, -- is "ef" at 5..6.
-                      First   => Slice_Start,
-                      Last    => Slice_End);
- 
-       if Slice_Start /= 5  or Slice_End /= 6 then
-          Report.Failed("Incorrect result from Find_Token - 1");
-       end if;
- 
-       -- If no appropriate slice is contained by the source Wide_String,
-       -- then the value returned in Last is zero, and the value in First is 
-       -- Source'First.
- 
-       ASF.Find_Token(Source_String6,      -- "abcdefabcdef"
-                      A_to_F_Set,          -- Set of characters 'a' thru 'f'.
-                      Ada.Strings.Outside, -- No characters outside this set.
-                      Slice_Start,
-                      Slice_End);
-       
-       if Slice_Start /= Source_String6'First  or Slice_End /= 0 then
-          Report.Failed("Incorrect result from Find_Token - 2");
-       end if;
- 
-       -- Additional testing of Find_Token.
- 
-       ASF.Find_Token("eabcdabcddcab", 
-                      ABCD_Set, 
-                      Ada.Strings.Inside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 2  or Slice_End /= 13 then
-          Report.Failed("Incorrect result from Find_Token - 3");
-       end if;
- 
-       ASF.Find_Token("efghijklabcdabcd",
-                      ABCD_Set,
-                      Ada.Strings.Outside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 1  or Slice_End /= 8 then
-          Report.Failed("Incorrect result from Find_Token - 4");
-       end if;
- 
-       ASF.Find_Token("abcdefgabcdabcd",
-                      ABCD_Set,
-                      Ada.Strings.Outside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 5  or Slice_End /= 7 then
-          Report.Failed("Incorrect result from Find_Token - 5");
-       end if;
- 
-       ASF.Find_Token("abcdcbabcdcba",
-                      ABCD_Set,
-                      Ada.Strings.Inside,
-                      Slice_Start,
-                      Slice_End);
- 
-       if Slice_Start /= 1  or Slice_End /= 13 then
-          Report.Failed("Incorrect result from Find_Token - 6");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a	Thu Jan  1 00:00:00 1970
***************
*** 1,685 ****
- -- CXA4016.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Wide_Fixed
- --      are available, and that they produce correct results.  Specifically,
- --      check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice,
- --      Tail, Trim, and "*".
- --
- -- TEST DESCRIPTION:
- --      This test, when combined with tests CXA4013-15 will provide
- --      coverage of the functionality found in package Ada.Strings.Wide_Fixed.
- --      This test contains many small, specific test cases, situations that
- --      although common in user environments, are often difficult to generate
- --      in large numbers in a application-based test.  They represent
- --      individual usage paradigms in-the-small.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      10 Apr 94   SAIC    Modified comments in a subtest failure message.
- --      06 Nov 95   SAIC    Corrected subtest results for ACVC 2.0.1
- --      14 Mar 01   RLB     Added checks that the lower bound is 1, similar
- --                          to CXA4005. These changes were made to test
- --                          Defect Report 8652/0049, as reflected in
- --                          Technical Corrigendum 1.
- --
- --!
- 
- with Report;
- with Ada.Strings;
- with Ada.Strings.Wide_Fixed;
- with Ada.Strings.Wide_Maps;
- 
- procedure CXA4016 is
- 
-     type TC_Name_Holder is access String;
-     Name : TC_Name_Holder;
- 
-     function TC_Check (S : Wide_String) return Wide_String is
-     begin
-         if S'First /= 1 then
-             Report.Failed ("Lower bound of result of function " & Name.all &
-                            " is" & Integer'Image (S'First));
-         end if;
-         return S;
-     end TC_Check;
- 
-     procedure TC_Set_Name (N : String) is
-     begin
-         Name := new String'(N);
-     end TC_Set_Name;
- 
- begin
- 
-    Report.Test("CXA4016", "Check that the subprograms defined in "         &
-                           "package Ada.Strings.Wide_Fixed are available, " &
-                           "and that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ASW       renames Ada.Strings.Wide_Fixed;
-       package Wide_Maps renames Ada.Strings.Wide_Maps;
- 
-       Result_String,
-       Delete_String,
-       Insert_String,
-       Trim_String,
-       Overwrite_String  : Wide_String(1..10) :=
-                             (others => Ada.Strings.Wide_Space);
-       Replace_String    : Wide_String(10..30) :=
-                             (others => Ada.Strings.Wide_Space);
- 
-       Source_String1 : Wide_String(1..5)  := "abcde";     -- odd len wd str
-       Source_String2 : Wide_String(1..6)  := "abcdef";    -- even len wd str
-       Source_String3 : Wide_String(1..12) := "abcdefghijkl";
-       Source_String4 : Wide_String(1..12) := "abcdefghij  "; -- last two ch pad
-       Source_String5 : Wide_String(1..12) := "  cdefghijkl"; -- first two ch pad
-       Source_String6 : Wide_String(1..12) := "abcdefabcdef";
- 
-       Location     : Natural := 0;
-       Slice_Start  : Positive;
-       Slice_End,
-       Slice_Count  : Natural := 0;
- 
-       CD_Set       : Wide_Maps.Wide_Character_Set :=
-                        Wide_Maps.To_Set("cd");
-       X_Set        : Wide_Maps.Wide_Character_Set :=
-                        Wide_Maps.To_Set('x');
-       ABCD_Set     : Wide_Maps.Wide_Character_Set :=
-                        Wide_Maps.To_Set("abcd");
-       A_to_F_Set   : Wide_Maps.Wide_Character_Set :=
-                        Wide_Maps.To_Set("abcdef");
- 
-       CD_to_XY_Map : Wide_Maps.Wide_Character_Mapping :=
-                        Wide_Maps.To_Mapping(From => "cd",  To => "xy");
- 
-    begin
- 
-       -- Procedure Replace_Slice
-       -- The functionality of this procedure is similar to procedure Move,
-       -- and is tested here in the same manner, evaluated with various
-       -- combinations of parameters.
- 
-       -- Index_Error propagation when Low > Source'Last + 1
- 
-       begin
-          ASW.Replace_Slice(Result_String,
-                            Result_String'Last + 2, -- should raise exception
-                            Result_String'Last,
-                            "xxxxxxx");
-          Report.Failed("Index_Error not raised by Replace_Slice - 1");
-       exception
-          when Ada.Strings.Index_Error => null; -- OK, expected exception.
-          when others                  =>
-             Report.Failed("Incorrect exception from Replace_Slice - 1");
-       end;
- 
-       -- Index_Error propagation when High < Source'First - 1
- 
-       begin
-          ASW.Replace_Slice(Replace_String(20..30),
-                            Replace_String'First,
-                            Replace_String'First - 2, -- should raise exception
-                            "xxxxxxx");
-          Report.Failed("Index_Error not raised by Replace_Slice - 2");
-       exception
-          when Ada.Strings.Index_Error => null; -- OK, expected exception.
-          when others                  =>
-             Report.Failed("Incorrect exception from Replace_Slice - 2");
-       end;
- 
-       -- Justify = Left (default case)
- 
-       Result_String := "XXXXXXXXXX";
- 
-       ASW.Replace_Slice(Source => Result_String,
-                         Low    =>  1,
-                         High   => 10,
-                         By     => Source_String1);   -- "abcde"
- 
-       if Result_String /= "abcde     " then
-          Report.Failed("Incorrect result from Replace_Slice - Justify = Left");
-       end if;
- 
-       -- Justify = Right
- 
-       ASW.Replace_Slice(Source  => Result_String,
-                         Low     => 1,
-                         High    => Result_String'Last,
-                         By      => Source_String2,      -- "abcdef"
-                         Drop    => Ada.Strings.Error,
-                         Justify => Ada.Strings.Right);
- 
-       if Result_String /= "    abcdef" then
-          Report.Failed("Incorrect result from Replace_Slice - Justify=Right");
-       end if;
- 
-       -- Justify = Center (two cases, odd and even pad lengths)
- 
-       ASW.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String1,      -- "abcde"
-                         Ada.Strings.Error,
-                         Ada.Strings.Center,
-                         'x');                -- non-default padding.
- 
-       if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
-          Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1");
-       end if;
- 
-       ASW.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String2,        -- "abcdef"
-                         Ada.Strings.Error,
-                         Ada.Strings.Center);
- 
-       if Result_String /= "  abcdef  " then    -- Equal padding added on L/R.
-          Report.Failed("Incorrect result from Replace_Slice with " &
-                        "Justify = Center - 2");
-       end if;
- 
-       -- When the source string is longer than the target string, several
-       -- cases can be examined, with the results depending on the value of
-       -- the Drop parameter.
- 
-       -- Drop = Left
- 
-       ASW.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String3,            -- "abcdefghijkl"
-                         Drop => Ada.Strings.Left);
- 
-       if Result_String /= "cdefghijkl" then
-          Report.Failed("Incorrect result from Replace_Slice - Drop=Left");
-       end if;
- 
-       -- Drop = Right
- 
-       ASW.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String3,        -- "abcdefghijkl"
-                         Ada.Strings.Right);
- 
-       if Result_String /= "abcdefghij" then
-          Report.Failed("Incorrect result, Replace_Slice with Drop=Right");
-       end if;
- 
-       -- Drop = Error
- 
-       -- The effect in this case depends on the value of the justify
-       -- parameter, and on whether any characters in Source other than
-       -- Pad would fail to be copied.
- 
-       -- Drop = Error, Justify = Left, right overflow characters are pad.
- 
-       ASW.Replace_Slice(Result_String,
-                         1,
-                         Result_String'Last,
-                         Source_String4,               -- "abcdefghij  "
-                         Drop    => Ada.Strings.Error,
-                         Justify => Ada.Strings.Left);
- 
-       if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
-           Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1");
-       end if;
- 
-       -- Drop = Error, Justify = Right, left overflow characters are pad.
- 
-       ASW.Replace_Slice(Source   => Result_String,
-                         Low      => 1,
-                         High     => Result_String'Last,
-                         By       => Source_String5,     -- "  cdefghijkl"
-                         Drop     => Ada.Strings.Error,
-                         Justify  => Ada.Strings.Right);
- 
-       if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
-          Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2");
-       end if;
- 
-       -- In other cases of Drop=Error, Length_Error is propagated, such as:
- 
-       begin
- 
-          ASW.Replace_Slice(Source   => Result_String,
-                            Low      => 1,
-                            High     => Result_String'Last,
-                            By       => Source_String3,    -- "abcdefghijkl"
-                            Drop     => Ada.Strings.Error);
- 
-           Report.Failed("Length_Error not raised by Replace_Slice - 1");
- 
-       exception
-          when Ada.Strings.Length_Error => null;   -- OK
-          when others =>
-             Report.Failed("Incorrect exception from Replace_Slice - 3");
-       end;
- 
- 
-       -- Function Replace_Slice
- 
-       TC_Set_Name ("Replace_Slice");
- 
-       if TC_Check (ASW.Replace_Slice("abcde", 3, 3, "x"))
-                                            /= "abxde"  or -- High = Low
-          TC_Check (ASW.Replace_Slice("abc",   2, 3, "xyz")) /= "axyz"   or
-          TC_Check (ASW.Replace_Slice("abcd",  4, 1, "xy"))
-                                            /= "abcxyd" or -- High < Low
-          TC_Check (ASW.Replace_Slice("abc",   2, 3, "x"))   /= "ax"     or
-          TC_Check (ASW.Replace_Slice("a",     1, 1, "z"))   /= "z"
-       then
-          Report.Failed("Incorrect result from Function Replace_Slice - 1");
-       end if;
- 
-       if TC_Check (ASW.Replace_Slice("abcde", 5, 5, "z"))
-                                            /= "abcdz" or  -- By length 1
-          TC_Check (ASW.Replace_Slice("abc",   1, 3, "xyz"))
-                                            /= "xyz"   or  -- High > Low
-          TC_Check (ASW.Replace_Slice("abc",   3, 2, "xy"))
-                                            /= "abxyc" or  -- insert
-          TC_Check (ASW.Replace_Slice("a",     1, 1, "xyz")) /= "xyz"
-       then
-          Report.Failed("Incorrect result from Function Replace_Slice - 2");
-       end if;
- 
- 
- 
-       -- Function Insert.
- 
-       TC_Set_Name ("Insert");
- 
-       declare
-          New_String : constant Wide_String :=
-            TC_Check (
-               ASW.Insert(Source   => Source_String1(2..5),    -- "bcde"
-                          Before   => 2,
-                          New_Item => Source_String2));         -- "abcdef"
-       begin
-          if New_String /= "abcdefbcde" then
-             Report.Failed("Incorrect result from Function Insert - 1");
-          end if;
-       end;
- 
-       if TC_Check (ASW.Insert("a",   1, "z")) /= "za"   or
-          TC_Check (ASW.Insert("abc", 3, ""))  /= "abc"  or
-          TC_Check (ASW.Insert("abc", 4, "z")) /= "abcz"
-       then
-          Report.Failed("Incorrect result from Function Insert - 2");
-       end if;
- 
-       begin
-          if TC_Check (ASW.Insert(Source   => Source_String1(2..5), -- "bcde"
-                          Before   => Report.Ident_Int(7),
-                          New_Item => Source_String2))         -- "abcdef"
-                 /= "babcdefcde" then
-             Report.Failed("Index_Error not raised by Insert - 3A");
-          else
-             Report.Failed("Index_Error not raised by Insert - 3B");
-          end if;
-       exception
-          when Ada.Strings.Index_Error => null; -- OK, expected exception.
-          when others                  =>
-             Report.Failed("Incorrect exception from Insert - 3");
-       end;
- 
- 
-       -- Procedure Insert
- 
-       -- Drop = Right
- 
-       ASW.Insert(Source   => Insert_String,
-                  Before   => 6,
-                  New_Item => Source_String2,       -- "abcdef"
-                  Drop     => Ada.Strings.Right);
- 
-       if Insert_String /= "     abcde" then  -- last char of New_Item dropped.
-          Report.Failed("Incorrect result from Insert with Drop = Right");
-       end if;
- 
-       -- Drop = Left
- 
-       ASW.Insert(Source   => Insert_String,     -- 10 char string
-                  Before   => 2,                 -- 9 chars, 2..10 available
-                  New_Item => Source_String3,    -- 12 characters long.
-                  Drop     => Ada.Strings.Left); -- truncate from Left.
- 
-       if Insert_String /= "l    abcde" then     -- 10 chars, leading blank.
-           Report.Failed("Incorrect result from Insert with Drop=Left");
-       end if;
- 
-       -- Drop = Error
- 
-       begin
-          ASW.Insert(Source   => Result_String,       -- 10 chars
-                     Before   => Result_String'Last,
-                     New_Item => "abcdefghijk",
-                     Drop     => Ada.Strings.Error);
-          Report.Failed("Exception not raised by Procedure Insert");
-       exception
-          when Ada.Strings.Length_Error => null; -- OK, expected exception
-          when others                   =>
-            Report.Failed("Incorrect exception raised by Procedure Insert");
-       end;
- 
- 
- 
-       -- Function Overwrite
- 
-       TC_Set_Name ("Overwrite");
- 
-       Overwrite_String := TC_Check (
-           ASW.Overwrite(Result_String,  -- 10 chars
-                         1,              -- starting at pos=1
-                         Source_String3(1..10)));
- 
-       if Overwrite_String /= Source_String3(1..10) then
-          Report.Failed("Incorrect result from Function Overwrite - 1");
-       end if;
- 
- 
-       if TC_Check (ASW.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or
-          TC_Check (ASW.Overwrite("a",      1, "xyz"))
-                                            /= "xyz"    or  -- chars appended
-          TC_Check (ASW.Overwrite("abc",    3, "   "))
-                                            /= "ab   "  or  -- blanks appended
-          TC_Check (ASW.Overwrite("abcde",  1, "z"  )) /= "zbcde"
-       then
-          Report.Failed("Incorrect result from Function Overwrite - 2");
-       end if;
- 
- 
- 
-       -- Procedure Overwrite, with truncation.
- 
-       ASW.Overwrite(Source   => Overwrite_String,    -- 10 characters.
-                     Position => 1,
-                     New_Item => Source_String3,      -- 12 characters.
-                     Drop     => Ada.Strings.Left);
- 
-       if Overwrite_String /= "cdefghijkl" then
-          Report.Failed("Incorrect result from Overwrite with Drop=Left");
-       end if;
- 
-       -- The default drop value is Right, used here.
- 
-       ASW.Overwrite(Source   => Overwrite_String,    -- 10 characters.
-                     Position => 1,
-                     New_Item => Source_String3);     -- 12 characters.
- 
-       if Overwrite_String /= "abcdefghij" then
-          Report.Failed("Incorrect result from Overwrite with Drop=Right");
-       end if;
- 
-       -- Drop = Error
- 
-       begin
-          ASW.Overwrite(Source   => Overwrite_String,    -- 10 characters.
-                        Position => 1,
-                        New_Item => Source_String3,      -- 12 characters.
-                        Drop     => Ada.Strings.Error);
-          Report.Failed("Exception not raised by Procedure Overwrite");
-       exception
-          when Ada.Strings.Length_Error => null; -- OK, expected exception.
-          when others                   =>
-             Report.Failed
-               ("Incorrect exception raised by Procedure Overwrite");
-       end;
- 
-       Overwrite_String := "ababababab";
-       ASW.Overwrite(Overwrite_String, Overwrite_String'Last, "z");
-       ASW.Overwrite(Overwrite_String, Overwrite_String'First,"z");
-       ASW.Overwrite(Overwrite_String, 5, "zz");
- 
-       if Overwrite_String /= "zbabzzabaz" then
-          Report.Failed("Incorrect result from Procedure Overwrite");
-       end if;
- 
- 
- 
-       -- Function Delete
- 
-       TC_Set_Name ("Delete");
- 
-       declare
-          New_String1 : constant Wide_String :=  -- Returns a 4 char wide str.
-            TC_Check (ASW.Delete(Source  => Source_String3,
-                                 From    => 3,
-                                 Through => 10));
-          New_String2 : constant Wide_String :=    -- This returns Source.
-            TC_Check (ASW.Delete(Source_String3, 10, 3));
-       begin
-            if New_String1 /= "abkl"  or
-               New_String2 /= Source_String3
-            then
-                Report.Failed("Incorrect result from Function Delete - 1");
-            end if;
-       end;
- 
-       if TC_Check (ASW.Delete("a",   1, 1))
-                               /= ""    or     -- Source length = 1
-          TC_Check (ASW.Delete("abc", 1, 2))
-                               /= "c"   or     -- From = Source'First
-          TC_Check (ASW.Delete("abc", 3, 3))
-                               /= "ab"  or     -- From = Source'Last
-          TC_Check (ASW.Delete("abc", 3, 1))
-                               /= "abc"        -- From > Through
-       then
-          Report.Failed("Incorrect result from Function Delete - 2");
-       end if;
- 
- 
- 
-       -- Procedure Delete
- 
-       -- Justify = Left
- 
-       Delete_String := Source_String3(1..10);  -- Initialize to "abcdefghij"
- 
-       ASW.Delete(Source  => Delete_String,
-                  From    => 6,
-                  Through => Delete_String'Last,
-                  Justify => Ada.Strings.Left,
-                  Pad     => 'x');              -- pad with char 'x'
- 
-       if Delete_String /= "abcdexxxxx" then
-           Report.Failed("Incorrect result from Delete - Justify = Left");
-       end if;
- 
-       -- Justify = Right
- 
-       ASW.Delete(Source  => Delete_String,      -- Remove x"s from end and
-                  From    => 6,                  -- shift right.
-                  Through => Delete_String'Last,
-                  Justify => Ada.Strings.Right,
-                  Pad     => 'x');               -- pad with char 'x' on left.
- 
-       if Delete_String /= "xxxxxabcde" then
-           Report.Failed("Incorrect result from Delete - Justify = Right");
-       end if;
- 
-       -- Justify = Center
- 
-       ASW.Delete(Source  => Delete_String,
-                  From    => 1,
-                  Through => 5,
-                  Justify => Ada.Strings.Center,
-                  Pad     => 'z');
- 
-       if Delete_String /= "zzabcdezzz" then  -- extra pad char on right side.
-           Report.Failed("Incorrect result from Delete - Justify = Center");
-       end if;
- 
- 
- 
-       -- Function Trim
-       -- Use non-identity character sets to perform the trim operation.
- 
-       TC_Set_Name ("Trim");
- 
-       Trim_String := "cdabcdefcd";
- 
-       -- Remove the "cd" from each end of the string.  This will not effect
-       -- the "cd" slice at 5..6.
- 
-       declare
-          New_String : constant Wide_String :=
-            TC_Check (ASW.Trim(Source => Trim_String,
-                               Left => CD_Set, Right => CD_Set));
-       begin
-          if New_String /= Source_String2 then    -- string "abcdef"
-             Report.Failed
-               ("Incorrect result from Trim with wide character sets");
-          end if;
-       end;
- 
-       if TC_Check (ASW.Trim("abcdef", Wide_Maps.Null_Set, Wide_Maps.Null_Set))
-              /= "abcdef" then
-          Report.Failed("Incorrect result from Trim with Null sets");
-       end if;
- 
-       if TC_Check (ASW.Trim("cdxx", CD_Set, X_Set)) /= "" then
-          Report.Failed("Incorrect result from Trim, wide string removal");
-       end if;
- 
- 
-       -- Procedure Trim
- 
-       -- Justify = Right
- 
-       ASW.Trim(Source  => Trim_String,
-                Left    => CD_Set,
-                Right   => CD_Set,
-                Justify => Ada.Strings.Right,
-                Pad     => 'x');
- 
-       if Trim_String /= "xxxxabcdef" then
-          Report.Failed("Incorrect result from Trim with Justify = Right");
-       end if;
- 
-       -- Justify = Left
- 
-       ASW.Trim(Source  => Trim_String,
-                Left    => X_Set,
-                Right   => Wide_Maps.Null_Set,
-                Justify => Ada.Strings.Left,
-                Pad     => ' ');
- 
-       if Trim_String /= "abcdef    " then  -- Padded with 4 blanks on right.
-          Report.Failed("Incorrect result from Trim with Justify = Left");
-       end if;
- 
-       -- Justify = Center
- 
-       ASW.Trim(Source  => Trim_String,
-                Left    => ABCD_Set,
-                Right   => CD_Set,
-                Justify => Ada.Strings.Center,
-                Pad     => 'x');
- 
-       if Trim_String /= "xxef    xx" then  -- Padded with 4 pad chars on L/R
-          Report.Failed("Incorrect result from Trim with Justify = Center");
-       end if;
- 
- 
- 
-       -- Function Head, testing use of padding.
- 
-       TC_Set_Name ("Head");
- 
-       -- Use the wide characters of Source_String1 ("abcde") and pad the
-       -- last five wide characters of Result_String with 'x' wide characters.
- 
-       Result_String := TC_CHeck (ASW.Head(Source_String1, 10, 'x'));
- 
-       if Result_String /= "abcdexxxxx" then
-          Report.Failed("Incorrect result from Function Head with padding");
-       end if;
- 
-       if TC_Check (ASW.Head("  ab  ", 2))        /= "  "     or
-          TC_Check (ASW.Head("a", 6, 'A'))        /= "aAAAAA" or
-          TC_Check (ASW.Head(ASW.Head("abc  ", 7, 'x'), 10, 'X'))
-                    /= "abc  xxXXX"
-       then
-          Report.Failed("Incorrect result from Function Head");
-       end if;
- 
- 
- 
-       -- Function Tail, testing use of padding.
- 
-       TC_Set_Name ("Tail");
- 
-       -- Use the wide characters of Source_String1 ("abcde") and pad the
-       -- first five wide characters of Result_String with 'x' wide characters.
- 
-       Result_String := TC_Check (ASW.Tail(Source_String1, 10, 'x'));
- 
-       if Result_String /= "xxxxxabcde" then
-          Report.Failed("Incorrect result from Function Tail with padding");
-       end if;
- 
-       if TC_Check (ASW.Tail("abcde  ", 5))
-                             /= "cde  "    or  -- blanks, back
-          TC_Check (ASW.Tail("  abc ",  8, ' '))
-                             /= "    abc " or  -- blanks, front/back
-          TC_Check (ASW.Tail("",        5, 'Z'))
-                             /= "ZZZZZ"    or  -- pad characters only
-          TC_Check (ASW.Tail("abc",     0))
-                             /= ""         or  -- null result
-          TC_Check (ASW.Tail(ASW.Tail(" abc ", 6, 'x'),
-                   10,
-                   'X'))     /= "XXXXx abc "
-       then
-          Report.Failed("Incorrect result from Function Tail");
-       end if;
- 
- 
- 
-       -- Function "*"  - with (Natural, Wide_String) parameters
- 
-       TC_Set_Name ("""*""");
- 
-       if TC_Check (ASW."*"(3, Source_String1))       /= "abcdeabcdeabcde"  or
-          TC_Check (ASW."*"(2, Source_String2))       /= Source_String6     or
-          TC_Check (ASW."*"(4, Source_String1(1..2))) /= "abababab"         or
-          TC_Check (ASW."*"(0, Source_String1))       /= ""
-       then
-          Report.Failed
-            ("Incorrect result from Function ""*"" with wide strings");
-       end if;
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4016;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a	Thu Jan  1 00:00:00 1970
***************
*** 1,337 ****
- -- CXA4017.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Wide_Bounded
- --      are available, and that they produce correct results.  Specifically,
- --      check the subprograms Append, Delete, Index, Insert , Length, 
- --      Overwrite, Replace_Slice, Slice, "&", To_Bounded_Wide_String, 
- --      To_Wide_String, Translate, and Trim.
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of a variety of the Wide_String 
- --      functions found in the package Ada.Strings.Wide_Bounded, simulating
- --      the operations found in a text processing environment.  
- --      With bounded wide strings, the length of each "line" of text can vary 
- --      up to the instantiated maximum, allowing one to view a page of text as
- --      a series of expandable lines.  This provides flexibility in text
- --      formatting of individual lines (wide strings).
- --      Several subprograms are defined, all of which attempt to take 
- --      advantage of as many different bounded wide string utilities as 
- --      possible.  Often, an operation that is being performed in a subprogram
- --      using a certain bounded wide string utility could more efficiently be 
- --      performed using a different utility.  However, in the interest of 
- --      including as broad coverage as possible, a mixture of utilities is
- --      invoked in this test.  
- --      A simulated page of text is provided as a parameter to the test 
- --      defined subprograms, and the appropriate processing performed.  The
- --      processed page of text is then compared to a predefined "finished"
- --      page, and test passage/failure is based on the results of this 
- --      comparison.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      06 Nov 95   SAIC    Corrected initialization error for ACVC 2.0.1.
- --
- --!
- 
- with Ada.Strings;
- with Ada.Strings.Wide_Bounded;
- with Ada.Strings.Wide_Maps;
- with Report;
- 
- procedure CXA4017 is
- 
- begin
- 
-    Report.Test ("CXA4017", "Check that the subprograms defined in package "  &
-                            "Ada.Strings.Wide_Bounded are available, and "    &
-                            "that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       Characters_Per_Line : constant Positive := 40;
-       Lines_Per_Page      : constant Natural  :=  4;
- 
- 
-       package BS_40 is new 
-         Ada.Strings.Wide_Bounded.Generic_Bounded_Length(Characters_Per_Line);
- 
-       use type BS_40.Bounded_Wide_String;
- 
-       type Page_Type is array (1..Lines_Per_Page) of 
-         BS_40.Bounded_Wide_String;
- 
-       -- Note: Misspellings below are intentional.
- 
-       Line1 : BS_40.Bounded_Wide_String := 
-         BS_40.To_Bounded_Wide_String
-                 ("ada is a progrraming language designed");
-       Line2 : BS_40.Bounded_Wide_String := 
-         BS_40.To_Bounded_Wide_String("to support the construction of long-");
-       Line3 : BS_40.Bounded_Wide_String := 
-         BS_40.To_Bounded_Wide_String("lived, highly reliabel software ");
-       Line4 : BS_40.Bounded_Wide_String := 
-         BS_40.To_Bounded_Wide_String("systems");
- 
-       Page  : Page_Type := (1 => Line1, 2 => Line2, 3 => Line3, 4 => Line4);
- 
-       Finished_Page : Page_Type :=  
-         (BS_40.To_Bounded_Wide_String
-                  ("Ada is a programming language designed"),
-          BS_40.To_Bounded_Wide_String("to support the construction of long-"),
-          BS_40.To_Bounded_Wide_String
-                  ("lived, HIGHLY RELIABLE software systems."),
-          BS_40.To_Bounded_Wide_String(""));
- 
-       ---
- 
-       procedure Compress (Page : in out Page_Type) is
-          Clear_Line : Natural := Lines_Per_Page;
-       begin
-          -- If two consecutive lines on the page are together less than the
-          -- maximum line length, then append those two lines, move up all
-          -- lower lines on the page, and blank out the last line.
-          -- This algorithm works one time through the page, does not perform
-          -- repetitive compression, and is designed for use with this test
-          -- program only.
-          for i in 1..Lines_Per_Page - 1 loop
-             if BS_40.Length(Page(i)) + BS_40.Length(Page(i+1)) <=
-                BS_40.Max_Length
-             then
-                Page(i) := BS_40."&"(Page(i), 
-                                     Page(i+1));     -- "&" (wd bnd, wd bnd)
- 
-                for j in i+1..Lines_Per_Page - 1 loop
-                   Page(j) := 
-                     BS_40.To_Bounded_Wide_String
-                       (BS_40.Slice(Page(j+1), 
-                                    1, 
-                                    BS_40.Length(Page(j+1))));
-                   Clear_Line := j + 1;
-                end loop;
-                Page(Clear_Line) := BS_40.Null_Bounded_Wide_String;
-             end if;
-          end loop;
-       end Compress;
- 
-       ---
- 
-       procedure Format (Page : in out Page_Type) is
-          Sm_Ada   : BS_40.Bounded_Wide_String := 
-                       BS_40.To_Bounded_Wide_String("ada");
-          Cap_Ada  : constant Wide_String := "Ada";
-          Char_Pos : Natural := 0;
-          Finished : Boolean := False;
-          Line     : Natural := Page_Type'Last;
-       begin
- 
-          -- Add a period to the end of the last line.
-          while Line >= Page_Type'First and not Finished loop
-             if Page(Line) /= BS_40.Null_Bounded_Wide_String  and
-                BS_40.Length(Page(Line)) <= BS_40.Max_Length
-             then
-                Page(Line) := BS_40.Append(Page(Line), '.');
-                Finished := True;
-             end if;
-             Line := Line - 1;
-          end loop;
- 
-          -- Replace all occurrences of "ada" with "Ada".
-          for Line in Page_Type'First .. Page_Type'Last loop
-             Finished := False;
-             while not Finished loop
-                Char_Pos := 
-                  BS_40.Index (Source  => Page(Line),
-                               Pattern => BS_40.To_Wide_String(Sm_Ada),
-                               Going   => Ada.Strings.Backward);
-                -- A zero is returned by function Index if no occurrences of
-                -- the pattern wide string are found.
-                Finished := (Char_Pos = 0);
-                if not Finished then
-                   BS_40.Replace_Slice
-                           (Source => Page(Line),
-                            Low    => Char_Pos,
-                            High   => Char_Pos + BS_40.Length(Sm_Ada) - 1,
-                            By     => Cap_Ada);
-                end if;
-             end loop;   -- while loop
-          end loop;      -- for loop
- 
-       end Format;
- 
-       ---
- 
-       procedure Spell_Check (Page : in out Page_Type) is
-          type Spelling_Type is (Incorrect, Correct);
-          type Word_Array_Type is array (Spelling_Type) 
-            of BS_40.Bounded_Wide_String;
-          type Dictionary_Type is array (1..2) of Word_Array_Type;
- 
-          -- Note that the "words" in the dictionary will require various
-          -- amounts of Trimming prior to their use in the bounded wide string
-          -- functions.
-          Dictionary : Dictionary_Type := 
-            (1 => (BS_40.To_Bounded_Wide_String("  reliabel          "),  
-                   BS_40.To_Bounded_Wide_String("       reliable   ")),
-             2 => (BS_40.To_Bounded_Wide_String("  progrraming  "),
-                   BS_40.To_Bounded_Wide_String(" programming ")));
- 
-          Pos      : Natural := Natural'First;
-          Finished : Boolean := False;
- 
-       begin
- 
-          for Line in Page_Type'Range loop
- 
-             -- Search for the first incorrectly spelled word in the 
-             -- Dictionary, if it is found, replace it with the correctly 
-             -- spelled word, using the Overwrite function.
- 
-             while not Finished loop
-                Pos := 
-                  BS_40.Index(Page(Line),
-                              BS_40.To_Wide_String
-                                (BS_40.Trim(Dictionary(1)(Incorrect),
-                                            Ada.Strings.Both)),
-                              Ada.Strings.Forward);
-                Finished := (Pos = 0);
-                if not Finished then
-                   Page(Line) := 
-                     BS_40.Overwrite(Page(Line),
-                                     Pos,
-                                     BS_40.To_Wide_String
-                                       (BS_40.Trim(Dictionary(1)(Correct),
-                                                   Ada.Strings.Both)));
-                end if;
-             end loop;
- 
-             Finished := False;
- 
-             -- Search for the second incorrectly spelled word in the
-             -- Dictionary, if it is found, replace it with the correctly 
-             -- spelled word, using the Delete procedure and Insert function.
- 
-             while not Finished loop
-                Pos := 
-                  BS_40.Index(Page(Line),
-                              BS_40.To_Wide_String(
-                                BS_40.Trim(Dictionary(2)(Incorrect),
-                                           Ada.Strings.Both)),
-                              Ada.Strings.Forward);
- 
-                Finished := (Pos = 0);
- 
-                if not Finished then
-                   BS_40.Delete
-                     (Page(Line),
-                      Pos,
-                      Pos + BS_40.To_Wide_String
-                              (BS_40.Trim(Dictionary(2)(Incorrect),
-                                          Ada.Strings.Both))'Length-1);
-                   Page(Line) := 
-                     BS_40.Insert(Page(Line),
-                                  Pos,
-                                  BS_40.To_Wide_String
-                                    (BS_40.Trim(Dictionary(2)(Correct),
-                                                Ada.Strings.Both)));
-                end if;
-             end loop;
- 
-             Finished := False;
- 
-          end loop;
-       end Spell_Check;
- 
-       ---
- 
-       procedure Bold (Page : in out Page_Type) is
-          Key_Word     : constant Wide_String := "highly reliable";
-          Bold_Mapping : constant 
-            Ada.Strings.Wide_Maps.Wide_Character_Mapping :=
-              Ada.Strings.Wide_Maps.To_Mapping
-                (From => " abcdefghijklmnopqrstuvwxyz",
-                 To   => " ABCDEFGHIJKLMNOPQRSTUVWXYZ");
-          Pos      : Natural := Natural'First;
-          Finished : Boolean := False;
-       begin
-          -- This procedure is designed to change the case of the phrase
-          -- "highly reliable" into upper case (a type of "Bolding").
-          -- All instances of the phrase on all lines of the page will be
-          -- modified.
- 
-          for Line in Page_Type'First .. Page_Type'Last loop
-             while not Finished loop
-                Pos := BS_40.Index(Page(Line), Key_Word);
-                Finished := (Pos = 0);
-                if not Finished then
- 
-                   BS_40.Overwrite
-                          (Page(Line),
-                           Pos,
-                           BS_40.To_Wide_String
-                             (BS_40.Translate
-                                (BS_40.To_Bounded_Wide_String
-                                    (BS_40.Slice(Page(Line),
-                                                 Pos,  
-                                                 Pos + Key_Word'Length - 1)),
-                                 Bold_Mapping)));
- 
-                end if;
-             end loop;
-             Finished := False;
-          end loop;
-       end Bold;
- 
- 
-    begin
- 
-       Compress(Page);
-       Format(Page); 
-       Spell_Check(Page);
-       Bold(Page);
- 
-       for i in 1..Lines_Per_Page loop
-          if BS_40.To_Wide_String(Page(i))          /= 
-             BS_40.To_Wide_String(Finished_Page(i))    or
-             BS_40.Length(Page(i))                  /= 
-             BS_40.Length(Finished_Page(i))            
-          then
-             Report.Failed("Incorrect modification of Page, Line " &
-                            Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4017;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a	Thu Jan  1 00:00:00 1970
***************
*** 1,379 ****
- -- CXA4018.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package 
- --      Ada.Strings.Wide_Bounded are available, and that they produce 
- --      correct results. Specifically, check the subprograms Append, 
- --      Count, Element, Find_Token, Head, Index_Non_Blank, Replace_Element, 
- --      Replicate, Tail, To_Bounded_Wide_String, "&", ">", "<", ">=", "<=", 
- --      and "*".
- --      
- -- TEST DESCRIPTION:
- --      This test, when taken in conjunction with test CXA40[17,19,20], will 
- --      constitute a test of all the functionality contained in package
- --      Ada.Strings.Wide_Bounded.  This test uses a variety of the
- --      subprograms defined in the wide bounded string package in ways typical
- --      of common usage.  Different combinations of available subprograms
- --      are used to accomplish similar wide bounded string processing goals.
- --
- --      
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      22 Dec 94   SAIC    Changed obsolete constant to Strings.Wide_Space.
- --      06 Nov 95   SAIC    Corrected evaluation string used in Head/Tail
- --                          subtests for ACVC 2.0.1.
- --
- --!
- 
- with Ada.Strings;
- with Ada.Strings.Wide_Bounded;
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Maps;
- with Report;
- 
- procedure CXA4018 is
- 
-    -- The following two functions are used to translate character and string
-    -- values to "Wide" values.  They will be applied to all the Wide_Bounded
-    -- subprogram parameters to simulate the use of Wide_Characters and 
-    -- Wide_Strings in actual practice. Blanks are translated to Wide_Character
-    -- blanks and all other characters are translated into Wide_Characters with
-    -- position values 256 greater than their (narrow) character position
-    -- values.
- 
-    function Translate (Ch : Character) return Wide_Character is
-       C : Character := Ch;
-    begin
-       if Ch = ' ' then
-          return Ada.Characters.Handling.To_Wide_Character(C);
-       else
-          return Wide_Character'Val(Character'Pos(Ch) + 
-                                    Character'Pos(Character'Last) + 1);
-       end if;
-    end Translate;
- 
-    function Translate (Str : String) return Wide_String is
-       WS : Wide_String(Str'First..Str'Last);
-    begin
-       for i in Str'First..Str'Last loop
-          WS(i) := Translate(Str(i));
-       end loop;
-       return WS;
-    end Translate;
- 
- 
- begin
- 
-    Report.Test ("CXA4018", "Check that the subprograms defined in package " &
-                            "Ada.Strings.Wide_Bounded are available, and "   &
-                            "that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
-       use type BS80.Bounded_Wide_String;
- 
-       Part1 : constant Wide_String     := Translate("Rum");
-       Part2 : Wide_Character           := Translate('p');
-       Part3 : BS80.Bounded_Wide_String := 
-                 BS80.To_Bounded_Wide_String(Translate("el"));
-       Part4 : Wide_Character           := Translate('s');
-       Part5 : BS80.Bounded_Wide_String := 
-                 BS80.To_Bounded_Wide_String(Translate("tilt"));
-       Part6 : Wide_String(1..3)        := Translate("ski");
- 
-       Full_Catenate_String,
-       Full_Append_String,  
-       Constructed_String,   
-       Drop_String,
-       Replicated_String,     
-       Token_String         : BS80.Bounded_Wide_String;
- 
-       CharA : Wide_Character := Translate('A');
-       CharB : Wide_Character := Translate('B');
-       CharC : Wide_Character := Translate('C');
-       CharD : Wide_Character := Translate('D');
-       CharE : Wide_Character := Translate('E');
-       CharF : Wide_Character := Translate('F');
- 
-       ABStr : Wide_String(1..15) := Translate("AAAAABBBBBBBBBB");
-       StrB  : Wide_String(1..2)  := Translate("BB");
-       StrE  : Wide_String(1..2)  := Translate("EE");
- 
- 
-    begin
- 
-       -- Evaluation of the overloaded forms of the "&" operator.
- 
-       Full_Catenate_String := 
-         BS80."&"(Part2,                            -- WChar & Bnd WStr
-                  BS80."&"(Part3,                   -- Bnd WStr & Bnd WStr
-                           BS80."&"(Part4,          -- WChar & Bnd WStr
-                                    BS80."&"(Part5, -- Bnd WStr & Bnd WStr
-                                             BS80.To_Bounded_Wide_String
-                                               (Part6)))));  
-                                                  
-       Full_Catenate_String := 
-         BS80."&"(Part1, Full_Catenate_String);     -- WStr & Bnd WStr
-       Full_Catenate_String := 
-         BS80."&"(Left  => Full_Catenate_String, 
-                  Right => Translate('n'));         -- Bnd WStr & WChar
- 
- 
-       -- Evaluation of the overloaded forms of function Append.
- 
-       Full_Append_String := 
-         BS80.Append(Part2,                               -- WChar,Bnd WStr
-           BS80.Append(Part3,                             -- Bnd WStr, Bnd WStr
-             BS80.Append(Part4,                           -- WChar,Bnd WStr
-               BS80.Append(BS80.To_Wide_String(Part5),    -- WStr,Bnd WStr
-                 BS80.To_Bounded_Wide_String(Part6)))));
- 
-       Full_Append_String := 
-         BS80.Append(BS80.To_Bounded_Wide_String(Part1),  -- Bnd WStr, WStr
-                     BS80.To_Wide_String(Full_Append_String));
- 
-       Full_Append_String := 
-         BS80.Append(Left  => Full_Append_String, 
-                     Right => Translate('n'));             -- Bnd WStr, WChar
- 
- 
-       -- Validate the resulting bounded wide strings.
- 
-       if BS80."<"(Full_Catenate_String, Full_Append_String) or
-          BS80.">"(Full_Catenate_String, Full_Append_String) or
-          not (Full_Catenate_String  = Full_Append_String and
-               BS80."<="(Full_Catenate_String, Full_Append_String) and
-               BS80.">="(Full_Catenate_String, Full_Append_String))
-       then
-          Report.Failed
-            ("Incorrect results from bounded wide string catenation" &
-             " and comparison");
-       end if;
- 
- 
-       -- Evaluate the overloaded forms of the Constructor function "*" and 
-       -- the Replicate function.
- 
-       Constructed_String := 
-         BS80."*"(2,CharA) &                     -- "AA"
-         BS80."*"(2,StrB) &                      -- "AABBBB"
-         BS80."*"(3, BS80."*"(2, CharC)) &       -- "AABBBBCCCCCC"
-         BS80.Replicate(3, 
-                    BS80.Replicate(2, CharD)) &  -- "AABBBBCCCCCCDDDDDD"
-         BS80.Replicate(2, StrE) &               -- "AABBBBCCCCCCDDDDDDEEEE"
-         BS80.Replicate(2, CharF);               -- "AABBBBCCCCCCDDDDDDEEEEFF"
- 
- 
-       -- Use of Function Replicate that involves dropping wide characters.
-       -- The attempt to replicate the 15 character wide string six times will
-       -- exceed the 80 wide character bound of the wide string.  Therefore, 
-       -- the result should be the catenation of 5 copies of the 15 character 
-       -- wide string, followed by 5 'A' wide characters (the first five wide 
-       -- characters of the 6th replication) with the remaining wide 
-       -- characters of the 6th replication dropped.
- 
-       Drop_String := 
-          BS80.Replicate(Count => 6,                   
-                         Item  => ABStr,              -- "AAAAABBBBBBBBBB"
-                         Drop  => Ada.Strings.Right); 
- 
-       if BS80.Element(Drop_String, 1)  /= Translate('A') or
-          BS80.Element(Drop_String, 6)  /= Translate('B') or
-          BS80.Element(Drop_String, 76) /= Translate('A') or
-          BS80.Element(Drop_String, 80) /= Translate('A') 
-       then
-          Report.Failed("Incorrect result from Replicate with Drop");
-       end if;
- 
- 
-       -- Use function Index_Non_Blank in the evaluation of the
-       -- Constructed_String.
- 
-       if BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Forward)  /=
-          BS80.To_Wide_String(Constructed_String)'First                    or
-          BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Backward) /=
-          BS80.Length(Constructed_String)
-       then
-          Report.Failed("Incorrect results from constructor functions");
-       end if;
- 
- 
- 
-       declare
- 
-          -- Define wide character set objects for use with the Count function.
-          -- Constructed_String = "AABBBBCCCCCCDDDDDDEEEEFF" from above.
- 
-          A_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
-                  Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
-                                                            1));
-          B_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
-                  Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
-                                                            3));
-          C_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
-                  Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
-                                                            7));
-          D_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
-                  Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
-                                                            13));
-          E_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
-                  Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
-                                                            19));
-          F_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
-                  Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
-                                                            23));
-          Start : Positive;
-          Stop  : Natural  := 0;
- 
-       begin
- 
-          -- Evaluate the results from function Count by comparing the number
-          -- of A's to the number of F's, B's to E's, and C's to D's in the
-          -- Constructed_String.  
-          -- There should be an equal number of each of the wide characters that 
-          -- are being compared (i.e., 2 A's and F's, 4 B's and E's, etc)
- 
-          if BS80.Count(Constructed_String, A_Set)      /= 
-             BS80.Count(Constructed_String, F_Set)        or
-             BS80.Count(Constructed_String, B_Set)      /= 
-             BS80.Count(Constructed_String, E_Set)        or
-             not (BS80.Count(Constructed_String, C_Set)  =  
-                  BS80.Count(Constructed_String, D_Set))  
-          then
-             Report.Failed("Incorrect result from function Count");
-          end if;
- 
- 
-          -- Evaluate the functions Head, Tail, and Find_Token.
-          -- Create the Token_String from the Constructed_String above.
- 
-          Token_String := 
-            BS80.Tail(BS80.Head(Constructed_String,  3), 2) &     -- "AB" &
-            BS80.Head(BS80.Tail(Constructed_String, 13), 2) &     -- "CD" &
-            BS80.Head(BS80.Tail(Constructed_String,  3), 2);      -- "EF"
- 
-          if Token_String /= 
-             BS80.To_Bounded_Wide_String(Translate("ABCDEF")) then
-             Report.Failed("Incorrect result from Catenation of Token_String");
-          end if;
- 
- 
-          -- Find the starting/ending position of the first A in the 
-          -- Token_String (both should be 1, only one A appears in string).
-          -- The Function Head uses the default pad character to return a
-          -- bounded wide string longer than its input parameter bounded 
-          -- wide string.
- 
-          BS80.Find_Token(BS80.Head(Token_String, 10),  -- Default pad.
-                          A_Set,
-                          Ada.Strings.Inside,
-                          Start,
-                          Stop);
- 
-          if Start /= 1 and Stop /= 1 then
-             Report.Failed("Incorrect result from Find_Token - 1");
-          end if;
- 
- 
-          -- Find the starting/ending position of the first non-AB slice in
-          -- the "head" five wide characters of Token_String (slice CDE at 
-          -- positions 3-5)
- 
-          BS80.Find_Token(BS80.Head(Token_String, 5),               -- "ABCDE"
-                          Ada.Strings.Wide_Maps."OR"(A_Set, B_Set), -- Set (AB)
-                          Ada.Strings.Outside,
-                          Start,
-                          Stop);
- 
-          if Start /= 3 and Stop /= 5 then
-             Report.Failed("Incorrect result from Find_Token - 2");
-          end if;
- 
- 
-          -- Find the starting/ending position of the first CD slice in
-          -- the "tail" eight wide characters (including two pad wide 
-          -- characters) of Token_String (slice CD at positions 5-6 of 
-          -- the tail portion specified)
- 
-          BS80.Find_Token(BS80.Tail(Token_String, 8, 
-                                    Ada.Strings.Wide_Space), 
-                          Ada.Strings.Wide_Maps."OR"(C_Set, D_Set),
-                          Ada.Strings.Inside,
-                          Start,
-                          Stop);
- 
-          if Start /= 5 and Stop /= 6 then
-             Report.Failed("Incorrect result from Find_Token - 3");
-          end if;
- 
- 
-          -- Evaluate the Replace_Element function.
- 
-          -- Token_String = "ABCDEF"
- 
-          BS80.Replace_Element(Token_String, 3, BS80.Element(Token_String,4));
- 
-          -- Token_String = "ABDDEF"
- 
-          BS80.Replace_Element(Source => Token_String,
-                               Index  => 2,
-                               By     => BS80.Element(Token_String, 5));
- 
-          -- Token_String = "AEDDEF"
- 
-          BS80.Replace_Element(Token_String, 
-                               1, 
-                               BS80.Element(BS80.Tail(Token_String, 2), 2));
- 
-          -- Token_String = "FEDDEF"
-          -- Evaluate this result.
- 
-          if BS80.Element(Token_String, 
-                          BS80.To_Wide_String(Token_String)'First)  /=
-             BS80.Element(Token_String, 
-                          BS80.To_Wide_String(Token_String)'Last)     or
-             BS80.Count(Token_String, D_Set)                        /=
-             BS80.Count(Token_String, E_Set)                          or
-             BS80.Index_Non_Blank(BS80.Head(Token_String,6))        /=
-             BS80.Index_Non_Blank(BS80.Tail(Token_String,6))          or
-             BS80.Head(Token_String, 1)                             /=
-             BS80.Tail(Token_String, 1)
-          then
-             Report.Failed("Incorrect result from operations in combination");
-          end if;
- 
-       end;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4018;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a	Thu Jan  1 00:00:00 1970
***************
*** 1,1027 ****
- -- CXA4019.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Wide_Bounded
- --      are available, and that they produce correct results, especially 
- --      under conditions where truncation of the result is required.  
- --      Specifically, check the subprograms Append, Count with non-Identity
- --      maps, Index with non-Identity maps, Index with Set parameters, 
- --      Insert (function and procedure), Replace_Slice (function and 
- --      procedure), To_Bounded_Wide_String, and Translate (function and 
- --      procedure).
- --
- -- TEST DESCRIPTION:
- --      This test, in conjunction with tests CXA4017, CXA4018, and CXA4020, 
- --      will provide coverage of the most common usages of the functionality
- --      found in the Ada.Strings.Wide_Bounded package.  It deals in large part
- --      with truncation effects and options.  This test contains many small, 
- --      specific test cases, situations that are often difficult to generate 
- --      in large numbers in an application-based test.  These cases represent 
- --      specific usage paradigms in-the-small.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      06 Nov 95   SAIC    Corrected expected result string in subtest for
- --                          ACVC 2.0.1.
- --                          Moved function Dog_to_Cat_Mapping to library
- --                          level to correct accessibility problem in test.
- --      22 Aug 96   SAIC    Corrected three subtests identified in reviewer
- --                          comments.
- --      17 Feb 97   PWB.CTA Corrected result strings for Translate and Insert
- --
- --!
- 
- package CXA40190 is
- 
-    -- Wide Character mapping function defined for use with specific 
-    -- versions of functions Index and Count.
- 
-    function Dog_to_Cat_Mapping (From : Wide_Character) 
-         return Wide_Character;
- 
- end CXA40190;
- 
- package body CXA40190 is
- 
-    -- Translates "dog" to "cat".
-    function Dog_to_Cat_Mapping (From : Wide_Character) 
-      return Wide_Character is
-    begin
-       if From = 'd' then
-          return 'c';
-       elsif From = 'o' then
-          return 'a';
-       elsif From = 'g' then
-          return 't';
-       else
-          return From;
-       end if;
-    end Dog_to_Cat_Mapping;
- 
- end CXA40190;
- 
- 
- with CXA40190;
- with Report;
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Bounded;
- with Ada.Strings.Wide_Maps;
- with Ada.Strings.Wide_Maps.Wide_Constants;
- 
- procedure CXA4019 is
- 
-    -- The following two functions are used to translate character and string 
-    -- values to "Wide" values.  They will be applied to all the Wide_Bounded
-    -- subprogram parameters to simulate the use of Wide_Characters and 
-    -- Wide_Strings in actual practice.
- 
-    function Equiv (Ch : Character) return Wide_Character is
-       C : Character := Ch;
-    begin
-       if Ch = ' ' then
-          return Ada.Characters.Handling.To_Wide_Character(C);
-       else
-          return Wide_Character'Val(Character'Pos(Ch) + 
-                 Character'Pos(Character'Last) + 1);
-       end if;
-    end Equiv;
- 
- 
-    function Equiv (Str : String) return Wide_String is
-       WS : Wide_String(Str'First..Str'Last);
-    begin
-       for i in Str'First..Str'Last loop
-          WS(i) := Equiv(Str(i));
-       end loop;
-       return WS;
-    end Equiv;
- 
- begin
- 
-    Report.Test("CXA4019", "Check that the subprograms defined in "      &
-                           "package Ada.Strings.Wide_Bounded are "       &
-                           "available, and that they produce correct "   &
-                           "results, especially under conditions where " &
-                           "truncation of the result is required");
- 
-    Test_Block:
-    declare
- 
-       use CXA40190;
- 
-       package AS   renames Ada.Strings;
-       package ASB  renames Ada.Strings.Wide_Bounded;
-       package ASWC renames Ada.Strings.Wide_Maps.Wide_Constants;
-       package Maps renames Ada.Strings.Wide_Maps;
- 
-       package B10 is new ASB.Generic_Bounded_Length(Max => 10);
-       use type B10.Bounded_Wide_String;
- 
-       Result_String : B10.Bounded_Wide_String;
-       Test_String   : B10.Bounded_Wide_String;
-       AtoE_Bnd_Str  : B10.Bounded_Wide_String := 
-                         B10.To_Bounded_Wide_String(Equiv("abcde"));
-       FtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
-                         B10.To_Bounded_Wide_String(Equiv("fghij"));
-       AtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
-                         B10.To_Bounded_Wide_String(Equiv("abcdefghij"));
- 
-       Location     : Natural := 0;
-       Total_Count  : Natural := 0;
- 
-       CD_Set       : Maps.Wide_Character_Set := Maps.To_Set("cd"); 
-       Wide_CD_Set  : Maps.Wide_Character_Set := Maps.To_Set(Equiv("cd")); 
- 
-       AB_to_YZ_Map : Maps.Wide_Character_Mapping :=
-                      Maps.To_Mapping(From => "ab", To => "yz");
- 
-       Wide_AB_to_YZ_Map : Maps.Wide_Character_Mapping :=
-                           Maps.To_Mapping(From => Equiv("ab"),  
-                                           To   => Equiv("yz"));
- 
-       CD_to_XY_Map : Maps.Wide_Character_Mapping :=
-                        Maps.To_Mapping(From => "cd", To => "xy");
- 
-       Wide_CD_to_XY_Map : Maps.Wide_Character_Mapping :=
-                           Maps.To_Mapping(From => Equiv("cd"),  
-                                           To   => Equiv("xy"));
- 
- 
-       -- Access-to-Subprogram object defined for use with specific versions of 
-       -- functions Index, Count Translate, and procedure Translate.
- 
-       Map_Ptr : Maps.Wide_Character_Mapping_Function := 
-                   Dog_to_Cat_Mapping'Access;
- 
- 
- 
-    begin
- 
-       -- Function To_Bounded_Wide_String with Truncation 
-       -- Evaluate the function Append with parameters that will 
-       -- cause the truncation of the result.
- 
-       -- Drop = Error (default case, Length_Error will be raised)
- 
-       begin
-          Test_String := 
-            B10.To_Bounded_Wide_String
-              (Equiv("Much too long for this bounded wide string"));
-          Report.Failed("Length Error not raised by To_Bounded_Wide_String");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          =>
-            Report.Failed
-             ("Incorrect exception raised by To_Bounded_Wide_String");
-       end;
- 
-       -- Drop = Left 
- 
-       Test_String := 
-         B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"),
-                                    Drop   => Ada.Strings.Left);
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Equiv("efghijklmn")) then
-          Report.Failed
-            ("Incorrect result from To_Bounded_Wide_String, Drop = Left");
-       end if;
- 
-       -- Drop = Right 
- 
-       Test_String := 
-         B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"),
-                                    Drop   => Ada.Strings.Right);
- 
-       if not(Test_String = AtoJ_Bnd_Str) then
-          Report.Failed
-            ("Incorrect result from To_Bounded_Wide_String, Drop = Right");
-       end if;
- 
- 
- 
- 
-       -- Function Append with Truncation 
-       -- Evaluate the function Append with parameters that will 
-       -- cause the truncation of the result.
- 
-       -- Drop = Error (default case, Length_Error will be raised)
- 
-       begin
-          -- Append (Bnd Str, Bnd Str);
-          Result_String := 
-            B10.Append(B10.To_Bounded_Wide_String(Equiv("abcde")),
-                       B10.To_Bounded_Wide_String(Equiv("fghijk"))); -- 11 char
-          Report.Failed("Length_Error not raised by Append - 1");
-       exception
-          when AS.Length_Error => null;   -- OK, correct exception raised.
-          when others          =>
-             Report.Failed("Incorrect exception raised by Append - 1");
-       end;
- 
-       begin
-          -- Append (Str, Bnd Str);
-          Result_String := 
-            B10.Append(B10.To_Wide_String(AtoE_Bnd_Str),
-                       B10.To_Bounded_Wide_String(Equiv("fghijk")), 
-                       AS.Error); 
-          Report.Failed("Length_Error not raised by Append - 2");
-       exception
-          when AS.Length_Error => null;   -- OK, correct exception raised.
-          when others          =>
-             Report.Failed("Incorrect exception raised by Append - 2");
-       end;
- 
-       begin
-          -- Append (Bnd Str, Char);
-          Result_String := 
-            B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), 'k');
-          Report.Failed("Length_Error not raised by Append - 3");
-       exception
-          when AS.Length_Error => null;   -- OK, correct exception raised.
-          when others          =>
-             Report.Failed("Incorrect exception raised by Append - 3");
-       end;
- 
-       -- Drop = Left 
- 
-       -- Append (Bnd Str, Bnd Str)
-       Result_String := 
-         B10.Append(B10.To_Bounded_Wide_String(Equiv("abcdefgh")), -- 8 chs
-                    B10.To_Bounded_Wide_String(Equiv("ijklmn")),   -- 6 chs
-                    Ada.Strings.Left);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Equiv("efghijklmn"))  -- 10 chars
-       then
-          Report.Failed("Incorrect truncation performed by Append - 4");
-       end if;
- 
-       -- Append (Bnd Str, Str)
-       Result_String := 
-         B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), 
-                    "xyz",
-                    Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_Wide_String("defghijxyz") then
-          Report.Failed("Incorrect truncation performed by Append - 5");
-       end if;
- 
-       -- Append (Char, Bnd Str)
- 
-       Result_String := 
-         B10.Append(Equiv('A'), 
-                    B10.To_Bounded_Wide_String(Equiv("abcdefghij")),
-                    Ada.Strings.Left);
- 
-       if Result_String /= B10.To_Bounded_Wide_String(Equiv("abcdefghij")) 
-       then
-          Report.Failed("Incorrect truncation performed by Append - 6");
-       end if;
- 
-       -- Drop = Right 
- 
-       -- Append (Bnd Str, Bnd Str)
-       Result_String := B10.Append(FtoJ_Bnd_Str, 
-                                   AtoJ_Bnd_Str,
-                                   Ada.Strings.Right);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Equiv("fghijabcde")) 
-       then
-          Report.Failed("Incorrect truncation performed by Append - 7");
-       end if;
- 
-       -- Append (Str, Bnd Str)
-       Result_String := B10.Append(B10.To_Wide_String(AtoE_Bnd_Str), 
-                                   AtoJ_Bnd_Str,
-                                   Ada.Strings.Right);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Equiv("abcdeabcde")) 
-       then
-          Report.Failed("Incorrect truncation performed by Append - 8");
-       end if;
- 
-       -- Append (Char, Bnd Str)
-       Result_String := B10.Append(Equiv('A'), AtoJ_Bnd_Str, Ada.Strings.Right);
- 
-       if Result_String /= B10.To_Bounded_Wide_String(Equiv("Aabcdefghi")) then
-          Report.Failed("Incorrect truncation performed by Append - 9");
-       end if;
- 
- 
- 
-       -- Function Index with non-Identity map. 
-       -- Evaluate the function Index with a non-identity map 
-       -- parameter which will cause mapping of the source parameter 
-       -- prior to the evaluation of the index position search.
- 
-       Location := 
-         B10.Index(Source  => B10.To_Bounded_Wide_String("foxy fox 2"),
-                   Pattern => "FOX",
-                   Going   => Ada.Strings.Backward,
-                   Mapping => ASWC.Upper_Case_Map);
- 
-       if Location /= 6 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 1");
-       end if;
- 
-       Location := 
-         B10.Index(B10.To_Bounded_Wide_String("THE QUICK "),
-                   "quick",
-                   Ada.Strings.Forward,
-                   Ada.Strings.Wide_Maps.Wide_Constants.Lower_Case_Map);
- 
-       if Location /= 5 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 2");
-       end if;
- 
-       Location := B10.Index(Source  => B10.To_Bounded_Wide_String("The the"),
-                             Pattern => "the",
-                             Going   => Ada.Strings.Forward,
-                             Mapping => ASWC.Lower_Case_Map); 
- 
-       if Location /= 1 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 3");
-       end if;
- 
- 
- 
-       if B10.Index(B10.To_Bounded_Wide_String("abcd"),   -- Pattern = Source
-                    "abcd")                       /= 1 or
-          B10.Index(B10.To_Bounded_Wide_String("abc"),    -- Pattern < Source
-                    "abcd")                       /= 0 or
-          B10.Index(B10.Null_Bounded_Wide_String,         -- Source = Null
-                    "abc")                        /= 0 
-       then
-          Report.Failed("Incorrect result from Index with string patterns");
-       end if;
- 
- 
- 
-       -- Function Index with access-to-subprogram mapping value. 
-       -- Evaluate the function Index with a wide character mapping function
-       -- object that performs the mapping operation.
- 
-       Location := B10.Index(Source  => B10.To_Bounded_Wide_String("My dog"),
-                             Pattern => "cat",
-                             Going   => Ada.Strings.Forward,
-                             Mapping => Map_Ptr);  -- change "dog" to "cat"
- 
-       if Location /= 4 then
-          Report.Failed("Incorrect result from Index, w/map ptr - 1");
-       end if;
- 
-       Location := B10.Index(B10.To_Bounded_Wide_String("cat or dog"),
-                             "cat",
-                             Ada.Strings.Backward,
-                             Map_Ptr);   
- 
-       if Location /= 8 then
-          Report.Failed("Incorrect result from Index, w/map ptr - 2");
-       end if;
- 
-       if B10.Index(B10.To_Bounded_Wide_String("dog"),   -- Pattern = Source
-                    "cat",
-                    Ada.Strings.Forward,
-                    Map_Ptr)                            /= 1 or
-          B10.Index(B10.To_Bounded_Wide_String("dog"),    -- Pattern < Source
-                    "cats",
-                    Ada.Strings.Backward,
-                    Map_Ptr)                            /= 0 or
-          B10.Index(B10.Null_Bounded_Wide_String,         -- Source = Null
-                    "cat",
-                    Ada.Strings.Forward,
-                    Map_Ptr)                            /= 0 or
-          B10.Index(B10.To_Bounded_Wide_String("hot dog"),
-                    "dog",
-                    Ada.Strings.Backward,
-                    Map_Ptr)                            /= 0 or
-          B10.Index(B10.To_Bounded_Wide_String(" cat dog "),
-                    " cat",
-                    Ada.Strings.Backward,
-                    Map_Ptr)                           /= 5 or
-          B10.Index(B10.To_Bounded_Wide_String("dog CatDog"),
-                    "cat",
-                    Ada.Strings.Backward,
-                    Map_Ptr)                           /= 1 or
-          B10.Index(B10.To_Bounded_Wide_String("CatandDog"),
-                    "cat",
-                    Ada.Strings.Forward,
-                    Map_Ptr)                           /= 0 or
-          B10.Index(B10.To_Bounded_Wide_String("dddd"),
-                    "ccccc",
-                    Ada.Strings.Backward,
-                    Map_Ptr)                           /= 0
-       then
-          Report.Failed("Incorrect result from Index w/map ptr - 3");
-       end if;
- 
- 
- 
-       -- Function Index (for Sets).           
-       -- This version of Index uses Sets as the basis of the search.
- 
-       -- Test = Inside, Going = Forward  (Default case).
-       Location := 
-         B10.Index(Source => B10.To_Bounded_Wide_String(Equiv("abcdeabcde")),
-                   Set    => Wide_CD_Set, 
-                   Test   => Ada.Strings.Inside,
-                   Going  => Ada.Strings.Forward);
- 
-       if not (Location = 3) then -- position of first 'c' equivalent in source.
-          Report.Failed("Incorrect result from Index using Sets - 1");
-       end if;
- 
-       -- Test = Inside, Going = Backward.
-       Location := 
-         B10.Index(Source => B10."&"(AtoE_Bnd_Str, AtoE_Bnd_Str), 
-                   Set    => Wide_CD_Set, 
-                   Test   => Ada.Strings.Inside,
-                   Going  => Ada.Strings.Backward);
- 
-       if not (Location = 9) then   -- position of last 'd' in source.
-          Report.Failed("Incorrect result from Index using Sets - 2");
-       end if;
- 
-       -- Test = Outside, Going = Forward.
-       Location := B10.Index(B10.To_Bounded_Wide_String("deddacd"),  
-                             CD_Set,
-                             Test  => Ada.Strings.Outside,
-                             Going => Ada.Strings.Forward);
- 
-       if Location /= 2  then  -- position of 'e' in source.
-          Report.Failed("Incorrect result from Index using Sets - 3");
-       end if;
- 
-       -- Test = Outside, Going = Backward.
-       Location := B10.Index(B10.To_Bounded_Wide_String(Equiv("deddacd")),
-                             Wide_CD_Set,
-                             Ada.Strings.Outside,
-                             Ada.Strings.Backward);
- 
-       if Location /= 5 then    -- position of 'a', correct.
-          Report.Failed("Incorrect result from Index using Sets - 4");
-       end if;
- 
-       if B10.Index(B10.To_Bounded_Wide_String("cd"),   -- Source = Set
-                    CD_Set)                     /= 1 or
-          B10.Index(B10.To_Bounded_Wide_String("c"),    -- Source < Set
-                    CD_Set)                     /= 1 or
-          B10.Index(B10.Null_Bounded_Wide_String,       -- Source = Null
-                    Wide_CD_Set)                /= 0 or
-          B10.Index(AtoE_Bnd_Str,
-                    Maps.To_Set('x'))           /= 0    -- No match.
-       then
-          Report.Failed("Incorrect result from Index using Sets - 5");
-       end if;
- 
- 
- 
-       -- Function Count with non-Identity mapping. 
-       -- Evaluate the function Count with a non-identity map 
-       -- parameter which will cause mapping of the source parameter 
-       -- prior to the evaluation of the number of matching patterns.
- 
-       Total_Count := 
-         B10.Count(Source  => B10.To_Bounded_Wide_String("THE THE TH"),
-                   Pattern => "th",
-                   Mapping => ASWC.Lower_Case_Map);
- 
-       if Total_Count /= 3 then    
-          Report.Failed
-            ("Incorrect result from function Count, non-Identity map - 1");
-       end if;
- 
-       -- And a few with identity maps as well.
- 
-       if B10.Count(B10.To_Bounded_Wide_String(Equiv("ABABABABAB")),
-                    Equiv("ABA"),
-                    Maps.Identity)                       /= 2 or
-          B10.Count(B10.To_Bounded_Wide_String("ADCBADABCD"),
-                    "AB",
-                    Maps.To_Mapping("CD", "AB"))         /= 5 or
-          B10.Count(B10.To_Bounded_Wide_String(Equiv("aaaaaaaaaa")),
-                    Equiv("aaa"))                        /= 3 or
-          B10.Count(B10.To_Bounded_Wide_String(Equiv("XX")),
-                    Equiv("XXX"),
-                    Maps.Identity)                       /= 0 or
-          B10.Count(AtoE_Bnd_Str,                        -- Source = Pattern
-                    Equiv("abcde"))                      /= 1 or
-          B10.Count(B10.Null_Bounded_Wide_String,        -- Source = Null
-                    " ")                                 /= 0
-       then
-          Report.Failed
-            ("Incorrect result from function Count, w,w/o mapping");
-       end if;
-                                          
- 
- 
- 
- 
-       -- Function Count with access-to-subprogram mapping. 
-       -- Evaluate the version function Count that uses an access-to-subprogram
-       -- map parameter.
- 
-       Total_Count := 
-         B10.Count(Source  => B10.To_Bounded_Wide_String("dogdogdo"),
-                   Pattern => "ca",
-                   Mapping => Map_Ptr);
- 
-       if Total_Count /= 3 then    
-          Report.Failed
-            ("Incorrect result from function Count, w/map ptr - 1");
-       end if;
- 
- 
-       if B10.Count(B10.To_Bounded_Wide_String("DdOoGgod"),
-                    "c",
-                    Map_Ptr)                                 /= 2 or
-          B10.Count(B10.To_Bounded_Wide_String("dododododo"),
-                    "do",
-                    Map_Ptr)                                 /= 0 or
-          B10.Count(B10.To_Bounded_Wide_String("Dog or dog"),
-                    "cat",
-                    Map_Ptr)                                 /= 1 or
-          B10.Count(B10.To_Bounded_Wide_String("dddddddddd"),
-                    "ccccc",
-                    Map_Ptr)                                 /= 2 or
-          B10.Count(B10.To_Bounded_Wide_String("do"),    -- Source < Pattern
-                    "cat",
-                    Map_Ptr)                                 /= 0 or
-          B10.Count(B10.To_Bounded_Wide_String(" dog "), -- Source = Pattern
-                    " cat ",
-                    Map_Ptr)                                 /= 1 or
-          B10.Count(B10.Null_Bounded_Wide_String,        -- Source = Null
-                    " ",
-                    Map_Ptr)                                 /= 0
-       then
-          Report.Failed
-            ("Incorrect result from function Count, w/map ptr - 2");
-       end if;
- 
- 
- 
- 
-       -- Procedure Translate   
- 
-       -- Partial mapping of source.
- 
-       Test_String := B10.To_Bounded_Wide_String("abcdeabcab");
- 
-       B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
- 
-       if Test_String /= B10.To_Bounded_Wide_String("yzcdeyzcyz") then
-          Report.Failed("Incorrect result from procedure Translate - 1");
-       end if;
- 
-       -- Total mapping of source.
- 
-       Test_String := B10.To_Bounded_Wide_String("abbaaababb");
- 
-       B10.Translate(Source => Test_String, Mapping => ASWC.Upper_Case_Map);
- 
-       if Test_String /= B10.To_Bounded_Wide_String("ABBAAABABB") then
-          Report.Failed("Incorrect result from procedure Translate - 2");
-       end if;
- 
-       -- No mapping of source.
- 
-       Test_String := B10.To_Bounded_Wide_String(Equiv("xyzsypcc"));
- 
-       B10.Translate(Source => Test_String, Mapping => Wide_AB_to_YZ_Map);
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Equiv("xyzsypcc")) then
-          Report.Failed("Incorrect result from procedure Translate - 3");
-       end if;
- 
-       -- Map > 2 characters, partial mapping.
- 
-       Test_String := B10.To_Bounded_Wide_String("opabcdelmn");
- 
-       B10.Translate(Test_String, 
-                     Maps.To_Mapping("abcde", "lmnop"));
- 
-       if Test_String /= B10.To_Bounded_Wide_String("oplmnoplmn") then
-          Report.Failed("Incorrect result from procedure Translate - 4");
-       end if;
- 
- 
- 
- 
-       -- Procedure Translate with access-to-subprogram mapping.
-       -- Use the version of Procedure Translate that takes an
-       -- access-to-subprogram parameter to perform the Source mapping.
- 
-       -- Partial mapping of source.
- 
-       Test_String := B10.To_Bounded_Wide_String("dogeatdog");
- 
-       B10.Translate(Source => Test_String, Mapping => Map_Ptr);
- 
-       if Test_String /= B10.To_Bounded_Wide_String("cateatcat") then
-          Report.Failed
-            ("Incorrect result from procedure Translate w/map ptr - 1");
-       end if;
- 
-       Test_String := B10.To_Bounded_Wide_String("odogcatlmn");
- 
-       B10.Translate(Test_String, Map_Ptr);
- 
-       if Test_String /= B10.To_Bounded_Wide_String("acatcatlmn") then
-          Report.Failed
-            ("Incorrect result from procedure Translate w/map ptr - 2");
-       end if;
- 
- 
-       -- Total mapping of source.
- 
-       Test_String := B10.To_Bounded_Wide_String("gggooooddd");
- 
-       B10.Translate(Source => Test_String, Mapping => Map_Ptr);
- 
-       if Test_String /= B10.To_Bounded_Wide_String("tttaaaaccc") then
-          Report.Failed
-            ("Incorrect result from procedure Translate w/map ptr- 3");
-       end if;
- 
-       -- No mapping of source.
- 
-       Test_String := B10.To_Bounded_Wide_String(" DOG cat ");
- 
-       B10.Translate(Source => Test_String, Mapping => Map_Ptr);
- 
-       if Test_String /= B10.To_Bounded_Wide_String(" DOG cat ") then
-          Report.Failed
-            ("Incorrect result from procedure Translate w/map ptr - 4");
-       end if;
- 
-       Test_String := B10.Null_Bounded_Wide_String;
- 
-       B10.Translate(Source => Test_String, Mapping => Map_Ptr);
- 
-       if Test_String /= B10.To_Bounded_Wide_String("") then
-          Report.Failed
-            ("Incorrect result from procedure Translate w/map ptr - 5");
-       end if;
- 
- 
- 
- 
-       -- Function Translate with access-to-subprogram mapping.
-       -- Use the version of Function Translate that takes an
-       -- access-to-subprogram parameter to perform the Source mapping.
- 
-       -- Partial mapping of source.
- 
-       if B10.Translate(Source  => B10.To_Bounded_Wide_String("cateatdog"),
-                        Mapping => Map_Ptr) /= 
-          B10.To_Bounded_Wide_String("cateatcat") 
-       then
-          Report.Failed
-            ("Incorrect result from function Translate w/map ptr - 1");
-       end if;
- 
-       if B10.Translate(B10.To_Bounded_Wide_String("cadogtac"),
-                        Map_Ptr) /= 
-          B10.To_Bounded_Wide_String("cacattac") 
-       then
-          Report.Failed
-            ("Incorrect result from function Translate w/map ptr - 2");
-       end if;
- 
-       -- Total mapping of source.
- 
-       if B10.Translate(Source  => B10.To_Bounded_Wide_String("dogodggdo"),
-                        Mapping => Map_Ptr) /= 
-          B10.To_Bounded_Wide_String("catacttca") 
-       then
-          Report.Failed
-            ("Incorrect result from function Translate w/map ptr- 3");
-       end if;
- 
-       -- No mapping of source.
- 
-       if B10.Translate(Source  => B10.To_Bounded_Wide_String(" DOG cat "),
-                        Mapping => Map_Ptr) /= 
-          B10.To_Bounded_Wide_String(" DOG cat ") 
-       then
-          Report.Failed
-            ("Incorrect result from function Translate w/map ptr - 4");
-       end if;
- 
-       if B10.Translate(B10.To_Bounded_Wide_String("d "), Map_Ptr)         /=
-          B10.To_Bounded_Wide_String("c ")                                   or
-          B10.Translate(B10.To_Bounded_Wide_String("  god"), Map_Ptr)      /=
-          B10.To_Bounded_Wide_String("  tac")                                or
-          B10.Translate(B10.To_Bounded_Wide_String("d o g D og"), Map_Ptr) /=
-          B10.To_Bounded_Wide_String("c a t D at")                           or
-          B10.Translate(B10.To_Bounded_Wide_String("   "), Map_Ptr)        /=
-          B10.To_Bounded_Wide_String("   ")                                  or
-          B10.Translate(B10.To_Bounded_Wide_String("dddddddddd"), Map_Ptr) /=
-          B10.To_Bounded_Wide_String("cccccccccc") 
-       then
-          Report.Failed
-            ("Incorrect result from function Translate w/map ptr - 5");
-       end if;
- 
-       if B10.Translate(Source  => B10.Null_Bounded_Wide_String,
-                        Mapping => Map_Ptr) /= 
-          B10.To_Bounded_Wide_String("") 
-       then
-          Report.Failed
-            ("Incorrect result from function Translate w/map ptr - 6");
-       end if;
- 
- 
- 
- 
-       -- Function Replace_Slice    
-       -- Evaluate function Replace_Slice with 
-       -- a variety of Truncation options.
- 
-       -- Drop = Error (Default)
- 
-       begin
-          Test_String   := AtoJ_Bnd_Str;
-          Result_String := 
-            B10.Replace_Slice(Source => Test_String, 
-                              Low    => 3,
-                              High   => 5,                   -- 3-5, 3 chars.
-                              By     => Equiv("xxxxxx"));    -- more than 3.
-          Report.Failed("Length_Error not raised by Function Replace_Slice");
-       exception
-          when AS.Length_Error => null;   -- Correct exception raised.
-          when others          =>
-             Report.Failed
-               ("Incorrect exception raised by Function Replace_Slice");
-       end;
- 
-       -- Drop = Left                                                          
- 
-       Result_String := 
-         B10.Replace_Slice(Source => Test_String, 
-                           Low    =>  7,
-                           High   => 10,                  -- 7-10, 4 chars.
-                           By     => Equiv("xxxxxx"),     --  6 chars.
-                           Drop   => Ada.Strings.Left);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Equiv("cdefxxxxxx")) -- drop a,b
-       then
-          Report.Failed
-            ("Incorrect result from Function Replace Slice, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := 
-         B10.Replace_Slice(Source => Test_String,
-                           Low    =>  2,
-                           High   =>  5,                 -- 2-5, 4 chars.
-                           By     => Equiv("xxxxxx"),    --  6 chars.
-                           Drop   => Ada.Strings.Right);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Equiv("axxxxxxfgh")) -- drop i,j
-       then
-          Report.Failed
-            ("Incorrect result from Function Replace Slice, Drop = Right");
-       end if;
- 
-       -- Low = High = Source'Last, "By" length = 1.
- 
-       if B10.Replace_Slice(AtoE_Bnd_Str,
-                            B10.To_Wide_String(AtoE_Bnd_Str)'Last,
-                            B10.To_Wide_String(AtoE_Bnd_Str)'Last,
-                            Equiv("X"),
-                            Ada.Strings.Error)  /=
-          B10.To_Bounded_Wide_String(Equiv("abcdX"))
-       then
-          Report.Failed("Incorrect result from Function Replace_Slice");
-       end if;
- 
-       -- Index_Error raised when High < Source'First - 1.
-       begin
-          Test_String := 
-            B10.Replace_Slice(AtoE_Bnd_Str, 
-                              B10.To_Wide_String(AtoE_Bnd_Str)'First,
-                              B10.To_Wide_String(AtoE_Bnd_Str)'First - 2,
-                              Equiv("hijklm"));
-          Report.Failed("Index_Error not raised by Function Replace_Slice");
-       exception
-          when AS.Index_Error   => null;  -- OK, expected exception
-          when Constraint_Error => null;  -- Also OK, since RM is not clear
-          when others           =>
-             Report.Failed
-               ("Incorrect exception raised by Function Replace_Slice");
-       end;
- 
- 
- 
-       -- Procedure Replace_Slice  
-       -- Evaluate procedure Replace_Slice with 
-       -- a variety of Truncation options.
- 
-       -- Drop = Error (Default)
- 
-       begin
-          Test_String := AtoJ_Bnd_Str;
-          B10.Replace_Slice(Source => Test_String, 
-                            Low    => 3,
-                            High   => 5,                   -- 3-5, 3 chars.
-                            By     => Equiv("xxxxxx"));    -- more than 3.
-          Report.Failed("Length_Error not raised by Procedure Replace_Slice");
-       exception
-          when AS.Length_Error => null;   -- Correct exception raised.
-          when others          =>
-             Report.Failed
-               ("Incorrect exception raised by Procedure Replace_Slice");
-       end;
- 
-       -- Drop = Left                                                          
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Replace_Slice(Source => Test_String, 
-                         Low    =>  7,
-                         High   =>  9,                  -- 7-9, 3 chars.
-                         By     => Equiv("xxxxx"),      --  5 chars.
-                         Drop   => Ada.Strings.Left);
- 
-       if Test_String /= 
-          B10.To_Bounded_Wide_String(Equiv("cdefxxxxxj")) -- drop a,b
-       then
-          Report.Failed
-            ("Incorrect result from Procedure Replace Slice, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Replace_Slice(Source => Test_String, 
-                         Low    =>  1,
-                         High   =>  3,                  -- 1-3, 3chars.
-                         By     => Equiv("xxxx"),       --  4 chars.
-                         Drop   => Ada.Strings.Right);
- 
-       if Test_String /= 
-          B10.To_Bounded_Wide_String(Equiv("xxxxdefghi"))  -- drop j
-       then
-          Report.Failed
-            ("Incorrect result from Procedure Replace Slice, Drop = Right");
-       end if;
- 
-       -- High = Source'First, Low > High (Insert before Low).
- 
-       Test_String := AtoE_Bnd_Str;
-       B10.Replace_Slice(Source => Test_String, 
-                         Low    => B10.To_Wide_String(Test_String)'Last,
-                         High   => B10.To_Wide_String(Test_String)'First,
-                         By     => Equiv("XXXX"),       --  4 chars.
-                         Drop   => Ada.Strings.Right);
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Equiv("abcdXXXXe")) then 
-          Report.Failed
-            ("Incorrect result from Procedure Replace Slice");
-       end if;
- 
- 
- 
- 
-       -- Function Insert with Truncation 
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := 
-            B10.Insert(Source   => AtoJ_Bnd_Str,    -- "abcdefghij"
-                       Before   => 2,
-                       New_Item => Equiv("xyz"));
-          Report.Failed("Length_Error not raised by Function Insert");
-       exception
-          when AS.Length_Error => null;  -- Correct exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Function Insert");
-       end;
- 
-       -- Drop = Left
- 
-       Result_String :=
-         B10.Insert(Source   => AtoJ_Bnd_Str,      -- "abcdefghij"
-                    Before   => 5,
-                    New_Item => Equiv("xyz"),      -- 3 additional chars.
-                    Drop     => Ada.Strings.Left);
- 
-       if B10.To_Wide_String(Result_String) /= Equiv("dxyzefghij") then 
-          Report.Failed("Incorrect result from Function Insert, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := 
-         B10.Insert(Source   => B10.To_Bounded_Wide_String("abcdef"),
-                    Before   => 2,
-                    New_Item => "vwxyz",             -- 5 additional chars.
-                    Drop     => Ada.Strings.Right);
- 
-       if B10.To_Wide_String(Result_String) /= "avwxyzbcde" then     -- drop f.
-          Report.Failed("Incorrect result from Function Insert, Drop = Right");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Insert(B10.To_Bounded_Wide_String("a"), 1, " B")        /=   
-          B10.To_Bounded_Wide_String(" Ba")                              or
-          B10.Insert(B10.Null_Bounded_Wide_String, 1, Equiv("abcde")) /=
-          AtoE_Bnd_Str                                                   or
-          B10.Insert(B10.To_Bounded_Wide_String("ab"), 2, "")         /=
-          B10.To_Bounded_Wide_String("ab")
-       then
-          Report.Failed("Incorrect result from Function Insert");
-       end if;
- 
- 
- 
-       -- Procedure Insert 
- 
-       -- Drop = Error (Default).
-       begin
-          Test_String := AtoJ_Bnd_Str;
-          B10.Insert(Source   => Test_String,   
-                     Before   => 9,
-                     New_Item => Equiv("wxyz"),
-                     Drop     => Ada.Strings.Error);
-          Report.Failed("Length_Error not raised by Procedure Insert");
-       exception
-          when AS.Length_Error => null;  -- Correct exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Procedure Insert");
-       end;
- 
-       -- Drop = Left
-       
-       Test_String := AtoJ_Bnd_Str;
-       B10.Insert(Source   => Test_String,            
-                  Before   => B10.Length(Test_String), -- before last char
-                  New_Item => Equiv("xyz"),            -- 3 additional chars.
-                  Drop     => Ada.Strings.Left);
- 
-       if B10.To_Wide_String(Test_String) /= Equiv("defghixyzj") then 
-          Report.Failed("Incorrect result from Procedure Insert, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Insert(Source   => Test_String,
-                  Before   => 4,
-                  New_Item => Equiv("yz"),             -- 2 additional chars.
-                  Drop     => Ada.Strings.Right);
- 
-       if B10.To_Wide_String(Test_String) /= Equiv("abcyzdefgh") then   
-          Report.Failed
-            ("Incorrect result from Procedure Insert, Drop = Right");
-       end if;
- 
-       -- Before = Source'First, New_Item length = 1.
- 
-       Test_String := B10.To_Bounded_Wide_String(" abc ");
-       B10.Insert(Test_String, 
-                  B10.To_Wide_String(Test_String)'First,
-                  "Z");
- 
-       if Test_String /= B10.To_Bounded_Wide_String("Z abc ") then
-          Report.Failed("Incorrect result from Procedure Insert");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in  Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4019;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,688 ****
- -- CXA4020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Wide_Bounded
- --      are available, and that they produce correct results, especially under
- --      conditions where truncation of the result is required.  Specifically, 
- --      check the subprograms Overwrite (function and procedure), Delete,
- --      Function Trim (blanks), Trim (Set wide characters, function and
- --      procedure), Head, Tail, and Replicate (wide characters and wide 
- --      strings).
- --
- -- TEST DESCRIPTION:
- --      This test, in conjunction with tests CXA4017, CXA4018, CXA4019, 
- --      will provide coverage of the most common usages of the functionality
- --      found in the Ada.Strings.Wide_Bounded package.  It deals in large part
- --      with truncation effects and options.  This test contains many small, 
- --      specific test cases, situations that are often difficult to generate 
- --      in large numbers in an application-based test.  These cases represent 
- --      specific usage paradigms in-the-small.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      22 Dec 94   SAIC    Changed obsolete constant to Strings.Wide_Space.
- --      13 Apr 95   SAIC    Corrected certain subtest acceptance conditions.
- --
- --!
- 
- with Report;
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Bounded;
- with Ada.Strings.Wide_Maps;
- 
- procedure CXA4020 is
- 
-    -- The following two functions are used to translate character and string
-    -- values to "Wide" values.  They will be applied to all the Wide_Bounded
-    -- subprogram parameters to simulate the use of Wide_Characters and 
-    -- Wide_Strings in actual practice. Blanks are translated to Wide_Character
-    -- blanks and all other characters are translated into Wide_Characters with
-    -- position values 256 greater than their (narrow) character position
-    -- values.
- 
-    function Translate (Ch : Character) return Wide_Character is
-       C : Character := Ch;
-    begin
-       if Ch = ' ' then
-          return Ada.Characters.Handling.To_Wide_Character(C);
-       else
-          return Wide_Character'Val(Character'Pos(Ch) + 
-                 Character'Pos(Character'Last) + 1);
-       end if;
-    end Translate;
- 
- 
-    function Translate (Str : String) return Wide_String is
-       WS : Wide_String(Str'First..Str'Last);
-    begin
-       for i in Str'First..Str'Last loop
-          WS(i) := Translate(Str(i));
-       end loop;
-       return WS;
-    end Translate;
- 
- 
- begin
- 
-    Report.Test("CXA4020", "Check that the subprograms defined in "      &
-                           "package Ada.Strings.Wide_Bounded are "       &
-                           "available, and that they produce correct "   &
-                           "results, especially under conditions where " &
-                           "truncation of the result is required");
- 
-    Test_Block:
-    declare
- 
-       package AS   renames Ada.Strings;
-       package ASW  renames Ada.Strings.Wide_Bounded;
-       package Maps renames Ada.Strings.Wide_Maps;
- 
-       package B10 is new ASW.Generic_Bounded_Length(Max => 10);
-       use type B10.Bounded_Wide_String;
- 
-       Result_String : B10.Bounded_Wide_String;
-       Test_String   : B10.Bounded_Wide_String;
-       AtoE_Bnd_Str  : B10.Bounded_Wide_String := 
-                         B10.To_Bounded_Wide_String(Translate("abcde"));
-       FtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
-                         B10.To_Bounded_Wide_String(Translate("fghij"));
-       AtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
-                         B10.To_Bounded_Wide_String(Translate("abcdefghij"));
- 
-       Location     : Natural := 0;
-       Total_Count  : Natural := 0;
- 
-       CD_Set       : Maps.Wide_Character_Set := Maps.To_Set(Translate("cd")); 
-       XY_Set       : Maps.Wide_Character_Set := Maps.To_Set(Translate("xy")); 
- 
- 
-    begin
- 
-       -- Function Overwrite with Truncation                  
-       -- Drop = Error (Default).
- 
-       begin
-          Test_String   := AtoJ_Bnd_Str;
-          Result_String := 
-            B10.Overwrite(Source   => Test_String, -- "abcdefghij"
-                          Position => 9,
-                          New_Item => Translate("xyz"),
-                          Drop     => AS.Error);
-          Report.Failed("Exception not raised by Function Overwrite");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed("Incorrect exception raised by Function Overwrite");
-       end;
- 
-       -- Drop = Left
-  
-       Result_String :=
-         B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
-                       Position => B10.Length(Test_String), -- 10
-                       New_Item => Translate("xyz"),
-                       Drop     => Ada.Strings.Left);
- 
-       if B10.To_Wide_String(Result_String) /= 
-          Translate("cdefghixyz") then   -- drop a,b
-          Report.Failed
-            ("Incorrect result from Function Overwrite, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := B10.Overwrite(Test_String,  -- "abcdefghij"
-                                      3,
-                                      Translate("xxxyyyzzz"),
-                                      Ada.Strings.Right);
- 
-       if B10.To_Wide_String(Result_String) /= 
-          Translate("abxxxyyyzz") 
-       then
-          Report.Failed
-            ("Incorrect result from Function Overwrite, Drop = Right");
-       end if;
- 
-       -- Additional cases of function Overwrite.
- 
-       if B10.Overwrite(B10.To_Bounded_Wide_String(Translate("a")),      
-                        1,                                 -- Source length = 1
-                        Translate("  abc  "))              /= 
-          B10.To_Bounded_Wide_String(Translate("  abc  "))       or
-          B10.Overwrite(B10.Null_Bounded_Wide_String,      -- Null source
-                        1, 
-                        Translate("abcdefghij"))           /=
-          AtoJ_Bnd_Str                                or
-          B10.Overwrite(AtoE_Bnd_Str, 
-                        B10.To_Wide_String(AtoE_Bnd_Str)'First,
-                        Translate(" "))                    /=  -- New_Item = 1
-          B10.To_Bounded_Wide_String(Translate(" bcde"))
-       then
-          Report.Failed("Incorrect result from Function Overwrite");
-       end if;
- 
- 
- 
-       -- Procedure Overwrite                                 
-       -- Correct usage, no truncation.
- 
-       Test_String := AtoE_Bnd_Str;   -- "abcde"
-       B10.Overwrite(Test_String, 2, Translate("xyz"));
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Translate("axyze")) then
-          Report.Failed("Incorrect result from Procedure Overwrite - 1");
-       end if;
- 
-       Test_String := B10.To_Bounded_Wide_String(Translate("abc"));
-       B10.Overwrite(Test_String, 2, "");   -- New_Item is null string.
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Translate("abc")) then
-          Report.Failed("Incorrect result from Procedure Overwrite - 2");
-       end if;
- 
-       -- Drop = Error (Default).
- 
-       begin
-          Test_String   := AtoJ_Bnd_Str;
-          B10.Overwrite(Source   => Test_String, -- "abcdefghij"
-                        Position => 8,
-                        New_Item => Translate("uvwxyz"));
-          Report.Failed("Exception not raised by Procedure Overwrite");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed("Incorrect exception raised by Procedure Overwrite");
-       end;
- 
-       -- Drop = Left
-  
-       Test_String   := AtoJ_Bnd_Str;
-       B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
-                     Position => B10.Length(Test_String) - 2, -- 8
-                     New_Item => Translate("uvwxyz"),
-                     Drop     => Ada.Strings.Left);
- 
-       if B10.To_Wide_String(Test_String) /= 
-          Translate("defguvwxyz")
-       then  
-          Report.Failed
-            ("Incorrect result from Procedure Overwrite, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Test_String   := AtoJ_Bnd_Str;
-       B10.Overwrite(Test_String,  -- "abcdefghij"
-                     3,
-                     Translate("xxxyyyzzz"),
-                     Ada.Strings.Right);
- 
-       if B10.To_Wide_String(Test_String) /= Translate("abxxxyyyzz") then
-          Report.Failed                                         
-            ("Incorrect result from Procedure Overwrite, Drop = Right");
-       end if;
- 
- 
- 
-       -- Function Delete                                     
- 
-       if B10.Delete(Source  => AtoJ_Bnd_Str,   -- "abcdefghij"
-                     From    => 3,
-                     Through => 8)                               /=
-          B10."&"(B10.Head(AtoJ_Bnd_Str, 2), 
-                  B10.Tail(AtoJ_Bnd_Str, 2))                         or
-          B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str))  /=
-          AtoE_Bnd_Str                                               or
-          B10.Delete(AtoJ_Bnd_Str, 1, 5)                         /= 
-          FtoJ_Bnd_Str                                               
-       then
-          Report.Failed("Incorrect result from Function Delete - 1");
-       end if;
- 
-       if B10.Delete(B10.To_Bounded_Wide_String(Translate("a")), 1, 1)  /= 
-          B10.Null_Bounded_Wide_String                                    or
-          B10.Delete(AtoE_Bnd_Str, 
-                     5, 
-                     B10.To_Wide_String(AtoE_Bnd_Str)'First) /=
-          AtoE_Bnd_Str                                           or
-          B10.Delete(AtoE_Bnd_Str,
-                     B10.To_Wide_String(AtoE_Bnd_Str)'Last,
-                     B10.To_Wide_String(AtoE_Bnd_Str)'Last)  /=
-          B10.To_Bounded_Wide_String(Translate("abcd"))
-       then
-          Report.Failed("Incorrect result from Function Delete - 2");
-       end if;
-       
- 
- 
-       -- Function Trim
- 
-       declare
- 
-          Text : B10.Bounded_Wide_String := 
-                   B10.To_Bounded_Wide_String(Translate("Text"));
-          type Bnd_Array_Type is array (1..5) of B10.Bounded_Wide_String;
-          Bnd_Array : Bnd_Array_Type :=
-            (B10.To_Bounded_Wide_String(Translate("  Text")),
-             B10.To_Bounded_Wide_String(Translate("Text    ")),
-             B10.To_Bounded_Wide_String(Translate("   Text   ")),
-             B10.To_Bounded_Wide_String(Translate("Text  Text")),
-             B10.To_Bounded_Wide_String(Translate(" Text Text")));
- 
-       begin
- 
-          for i in Bnd_Array_Type'Range loop
-             case i is
-                when 4 =>
-                   if B10.Trim(Bnd_Array(i), AS.Both) /= 
-                      Bnd_Array(i) then  -- no change
-                      Report.Failed("Incorrect result from Function Trim - 4");
-                   end if;
-                when 5 =>
-                   if B10.Trim(Bnd_Array(i), AS.Both) /= 
-                      B10."&"(Text, B10."&"(Translate(' '), Text)) 
-                   then
-                      Report.Failed("Incorrect result from Function Trim - 5");
-                   end if;
-                when others =>
-                   if B10.Trim(Bnd_Array(i), AS.Both) /= Text then
-                      Report.Failed("Incorrect result from Function Trim - " &
-                                     Integer'Image(i));
-                   end if;
-             end case;
-          end loop;
- 
-       end;
- 
- 
- 
-       -- Function Trim using Sets                            
- 
-       -- Trim characters in sets from both sides of the bounded wide string.
-       if B10.Trim(Source => B10.To_Bounded_Wide_String(Translate("ddabbaxx")),
-                   Left   => CD_Set,
-                   Right  => XY_Set)  /=
-          B10.To_Bounded_Wide_String(Translate("abba"))
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Left & Right side - 1");
-       end if;
- 
-       -- Ensure that the characters in the set provided as the actual to
-       -- parameter Right are not trimmed from the left side of the bounded
-       -- wide string; likewise for the opposite side.  Only "cd" trimmed 
-       -- from left side, and only "xy" trimmed from right side.
- 
-       if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdxyabcdxy")), 
-                   CD_Set, 
-                   XY_Set) /=
-          B10.To_Bounded_Wide_String(Translate("xyabcd"))
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Left & Right side - 2");
-       end if;
- 
-       -- Ensure that characters contained in the sets are not trimmed from
-       -- the "interior" of the bounded wide string, just the appropriate ends.
- 
-       if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdabdxabxy")), 
-                   CD_Set, 
-                   XY_Set) /=
-          B10.To_Bounded_Wide_String(Translate("abdxab"))
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Left & Right side - 3");
-       end if;
- 
-       -- Trim characters in set from right side only.  No change to Left side.
- 
-       if B10.Trim(B10.To_Bounded_Wide_String(Translate("abxyzddcd")), 
-                   XY_Set, 
-                   CD_Set) /=
-          B10.To_Bounded_Wide_String(Translate("abxyz"))
-       then
-          Report.Failed
-            ("Incorrect result from Fn Trim - Sets, Right side");
-       end if;
- 
-       -- Trim no characters on either side of the bounded string.
- 
-       Result_String := B10.Trim(AtoJ_Bnd_Str, CD_Set, XY_Set);
-       if Result_String /= AtoJ_Bnd_Str then
-          Report.Failed("Incorrect result from Fn Trim - Sets, Neither side");
-       end if;
- 
-       if B10.Trim(AtoE_Bnd_Str, Maps.Null_Set, Maps.Null_Set) /=
-          AtoE_Bnd_Str                                            or
-          B10.Trim(B10.To_Bounded_Wide_String(Translate("dcddcxyyxx")),
-                   CD_Set,
-                   XY_Set)                                     /=
-          B10.Null_Bounded_Wide_String
-       then
-          Report.Failed("Incorrect result from Function Trim");
-       end if;
- 
- 
- 
-       -- Procedure Trim using Sets                           
- 
-       -- Trim characters in sets from both sides of the bounded wide string.
- 
-       Test_String := B10.To_Bounded_Wide_String(Translate("dcabbayx"));
-       B10.Trim(Source => Test_String,
-                Left   => CD_Set,
-                Right  => XY_Set);
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Translate("abba")) then
-          Report.Failed
-            ("Incorrect result from Proc Trim - Sets, Left & Right side - 1");
-       end if;
- 
-       -- Ensure that the characters in the set provided as the actual to
-       -- parameter Right are not trimmed from the left side of the bounded
-       -- wide string; likewise for the opposite side.  Only "cd" trimmed 
-       -- from left side, and only "xy" trimmed from right side.
- 
-       Test_String := B10.To_Bounded_Wide_String(Translate("cdxyabcdxy"));
-       B10.Trim(Test_String, CD_Set, XY_Set);
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Translate("xyabcd")) then
-          Report.Failed
-            ("Incorrect result from Proc Trim - Sets, Left & Right side - 2");
-       end if;
- 
-       -- Ensure that characters contained in the sets are not trimmed from
-       -- the "interior" of the bounded wide string, just the appropriate ends.
- 
-       Test_String := B10.To_Bounded_Wide_String(Translate("cdabdxabxy"));
-       B10.Trim(Test_String, CD_Set, XY_Set);
- 
-       if not 
-         (Test_String = B10.To_Bounded_Wide_String(Translate("abdxab"))) then
-          Report.Failed
-            ("Incorrect result from Proc Trim - Sets, Left & Right side - 3");
-       end if;
- 
-       -- Trim characters in set from Left side only.  No change to Right side.
- 
-       Test_String := B10.To_Bounded_Wide_String(Translate("cccdabxyz"));
-       B10.Trim(Test_String, CD_Set, XY_Set);
- 
-       if Test_String /= B10.To_Bounded_Wide_String(Translate("abxyz")) then
-          Report.Failed
-            ("Incorrect result from Proc Trim for Sets, Left side only");
-       end if;
- 
-       -- Trim no characters on either side of the bounded wide string.
- 
-       Test_String := AtoJ_Bnd_Str;
-       B10.Trim(Test_String, CD_Set, CD_Set);
- 
-       if Test_String /= AtoJ_Bnd_Str then
-          Report.Failed("Incorrect result from Proc Trim-Sets, Neither side");
-       end if;
- 
- 
- 
-       -- Function Head with Truncation                       
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := B10.Head(Source => AtoJ_Bnd_Str,   -- max length
-                                    Count  => B10.Length(AtoJ_Bnd_Str) + 1,
-                                    Pad    => Translate('X'));
-          Report.Failed("Length_Error not raised by Function Head");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Function Head");
-       end;
- 
-       -- Drop = Left
- 
-       -- Pad characters (5) are appended to the right end of the bounded
-       -- wide string (which is initially at its maximum length), then the 
-       -- first five characters of the intermediate result are dropped to 
-       -- conform to the maximum size limit of the bounded wide string (10).
- 
-       Result_String := 
-         B10.Head(B10.To_Bounded_Wide_String(Translate("ABCDEFGHIJ")),
-                  15,
-                  Translate('x'),
-                  Ada.Strings.Left);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Translate("FGHIJxxxxx"))
-       then
-          Report.Failed("Incorrect result from Function Head, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       -- Pad characters (6) are appended to the left end of the bounded
-       -- wide string (which is initially at one less than its maximum length), 
-       -- then the last five characters of the intermediate result are dropped 
-       -- (which in this case are the pad characters) to conform to the 
-       -- maximum size limit of the bounded wide string (10).
- 
-       Result_String := 
-         B10.Head(B10.To_Bounded_Wide_String(Translate("ABCDEFGHI")),
-                  15,
-                  Translate('x'),
-                  Ada.Strings.Right);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Translate("ABCDEFGHIx")) 
-       then
-          Report.Failed("Incorrect result from Function Head, Drop = Right");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Head(B10.Null_Bounded_Wide_String, 5, Translate('a')) /=
-          B10.To_Bounded_Wide_String(Translate("aaaaa"))          or
-          B10.Head(AtoE_Bnd_Str,
-                   B10.Length(AtoE_Bnd_Str))   /=
-          AtoE_Bnd_Str
-       then
-          Report.Failed("Incorrect result from Function Head");
-       end if;
- 
- 
- 
-       -- Function Tail with Truncation                       
-       -- Drop = Error (Default Case)
- 
-       begin
-          Result_String := B10.Tail(Source => AtoJ_Bnd_Str,   -- max length
-                                    Count  => B10.Length(AtoJ_Bnd_Str) + 1,
-                                    Pad    => Ada.Strings.Wide_Space,
-                                    Drop   => Ada.Strings.Error);
-          Report.Failed("Length_Error not raised by Function Tail");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-             Report.Failed("Incorrect exception raised by Function Tail");
-       end;
- 
-       -- Drop = Left
- 
-       -- Pad characters (5) are appended to the left end of the bounded wide
-       -- string (which is initially at two less than its maximum length), 
-       -- then the first three characters of the intermediate result (in this 
-       -- case, 3 pad characters) are dropped.
- 
-       Result_String := 
-         B10.Tail(B10.To_Bounded_Wide_String(Translate("ABCDEFGH")),
-                  13,
-                  Translate('x'),
-                  Ada.Strings.Left);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Translate("xxABCDEFGH")) 
-       then
-          Report.Failed("Incorrect result from Function Tail, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       -- Pad characters (3) are appended to the left end of the bounded wide 
-       -- string (which is initially at its maximum length), then the last
-       -- three characters of the intermediate result are dropped.
- 
-       Result_String := 
-         B10.Tail(B10.To_Bounded_Wide_String(Translate("ABCDEFGHIJ")),
-                  13,
-                  Translate('x'),
-                  Ada.Strings.Right);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Translate("xxxABCDEFG"))
-       then
-          Report.Failed("Incorrect result from Function Tail, Drop = Right");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Tail(B10.Null_Bounded_Wide_String, 3, Translate(' ')) /=
-          B10.To_Bounded_Wide_String(Translate("   "))                or
-          B10.Tail(AtoE_Bnd_Str, 
-                   B10.To_Wide_String(AtoE_Bnd_Str)'First)  /=
-          B10.To_Bounded_Wide_String(Translate("e"))
-       then
-          Report.Failed("Incorrect result from Function Tail");
-       end if;
- 
- 
- 
-       -- Function Replicate (#, Char) with Truncation        
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := B10.Replicate(Count => B10.Max_Length + 5,
-                                         Item  => Translate('A'),
-                                         Drop  => AS.Error);
-          Report.Failed
-            ("Length_Error not raised by Replicate for characters");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed
-              ("Incorrect exception raised by Replicate for characters");
-       end;
- 
-       -- Drop = Left, Right
-       -- Since this version of Replicate uses wide character parameters, the 
-       -- result after truncation from left or right will appear the same.
-       -- The result will be a 10 character bounded wide string, composed of
-       -- 10 "Item" wide characters.
- 
-       if B10.Replicate(Count => 20, 
-                        Item => Translate('A'), 
-                        Drop => Ada.Strings.Left) /=
-          B10.Replicate(15, Translate('A'), Ada.Strings.Right)
-       then
-          Report.Failed("Incorrect result from Replicate for characters - 1");
-       end if;
- 
-       -- Blank-filled, 10 character bounded wide strings.
- 
-       if B10.Replicate(B10.Max_Length + 1, 
-                        Translate(' '), 
-                        Drop => Ada.Strings.Left) /=
-          B10.Replicate(B10.Max_Length, Ada.Strings.Wide_Space)
-       then
-          Report.Failed("Incorrect result from Replicate for characters - 2");
-       end if;
- 
-       -- Additional cases.
- 
-       if B10.Replicate(0, Translate('a')) /= B10.Null_Bounded_Wide_String or
-          B10.Replicate(1, Translate('a')) /= 
-          B10.To_Bounded_Wide_String(Translate("a"))
-       then
-          Report.Failed("Incorrect result from Replicate for characters - 3");
-       end if;
- 
- 
- 
-       -- Function Replicate (#, String) with Truncation      
-       -- Drop = Error (Default).
- 
-       begin
-          Result_String := B10.Replicate(Count => 5,  -- result would be 15.
-                                         Item  => Translate("abc"));
-          Report.Failed
-            ("Length_Error not raised by Replicate for wide strings");
-       exception
-          when AS.Length_Error => null;  -- Expected exception raised.
-          when others          => 
-            Report.Failed
-              ("Incorrect exception raised by Replicate for wide strings");
-       end;
- 
-       -- Drop = Left
- 
-       Result_String := B10.Replicate(3, Translate("abcd"), Ada.Strings.Left);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Translate("cdabcdabcd"))
-       then
-          Report.Failed
-            ("Incorrect result from Replicate for wide strings, Drop = Left");
-       end if;
- 
-       -- Drop = Right
- 
-       Result_String := B10.Replicate(3, Translate("abcd"), Ada.Strings.Right);
- 
-       if Result_String /= 
-          B10.To_Bounded_Wide_String(Translate("abcdabcdab")) then
-          Report.Failed
-            ("Incorrect result from Replicate for wide strings, Drop = Right");
-       end if;
- 
-       -- Additional cases.
-       
-       if B10.Replicate(5, Translate("X"))    /= 
-          B10.To_Bounded_Wide_String(Translate("XXXXX"))   or
-          B10.Replicate(10, "")               /= 
-          B10.Null_Bounded_Wide_String                     or
-          B10.Replicate(0, Translate("ab"))   /= 
-          B10.Null_Bounded_Wide_String
-       then
-          Report.Failed("Incorrect result from Replicate for wide strings");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4020;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a	Thu Jan  1 00:00:00 1970
***************
*** 1,311 ****
- -- CXA4021.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package 
- --      Ada.Strings.Wide_Unbounded are available, and that they produce 
- --      correct results. Specifically, check the subprograms Head, Index, 
- --      Index_Non_Blank, Insert, Length, Overwrite, Replace_Slice, Slice, 
- --      Tail, To_Wide_String, To_Unbounded_Wide_String, "*", "&", 
- --      and "=", "<=", ">=".
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of many of the subprograms defined
- --      in package Ada.Strings.Wide_Unbounded for use with unbounded wide
- --      strings.
- --      The test attempts to simulate how unbounded wide strings could be used
- --      to simulate paragraphs of text.  Modifications could be easily be
- --      performed using the provided subprograms (although in this test, the
- --      main modification performed was the addition of more text to the
- --      string).  One would not have to worry about the formatting of the 
- --      paragraph until it was finished and correct in content.  Then, once
- --      all required editing is complete, the unbounded strings can be divided
- --      up into the appropriate lengths based on particular formatting
- --      requirements.  The test then compares the formatted text product
- --      with a predefined "finished product".  
- --      
- --      This test attempts to use a large number of the subprograms provided
- --      by package Ada.Strings.Wide_Unbounded.  Often, the processing involved
- --      could have been performed more efficiently using a minimum number
- --      of the subprograms, in conjunction with loops, etc.  However, for
- --      testing purposes, and in the interest of minimizing the number of
- --      tests developed, subprogram variety and feature mixing was stressed.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Report;
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Maps;
- with Ada.Strings.Wide_Unbounded;
- 
- procedure CXA4021 is
- 
-    -- The following two functions are used to translate character and string
-    -- values to "Wide" values.  They will be applied to all the Wide_Bounded
-    -- subprogram character and string parameters to simulate the use of non-
-    -- character Wide_Characters and Wide_Strings in actual practice.
-    -- Note: These functions do not actually return "equivalent" wide
-    --       characters to their character inputs, just "non-character"
-    --       wide characters.
- 
-    function Equiv (Ch : Character) return Wide_Character is
-       C : Character := Ch;
-    begin
-       if Ch = ' ' then
-          return Ada.Characters.Handling.To_Wide_Character(C);
-       else
-          return Wide_Character'Val(Character'Pos(Ch) + 
-                 Character'Pos(Character'Last) + 1);
-       end if;
-    end Equiv;
- 
- 
-    function Equiv (Str : String) return Wide_String is
-       WS : Wide_String(Str'First..Str'Last);
-    begin
-       for i in Str'First..Str'Last loop
-          WS(i) := Equiv(Str(i));
-       end loop;
-       return WS;
-    end Equiv;
- 
- begin
- 
-    Report.Test ("CXA4021", "Check that the subprograms defined in "     &
-                            "package Ada.Strings.Wide_Unbounded are "    &
-                            "available, and that they produce correct "  &
-                            "results");
- 
-    Test_Block:
-    declare
- 
-       package ASW renames Ada.Strings.Wide_Unbounded;
-       use type ASW.Unbounded_Wide_String;
-       use Ada.Strings;
- 
-       Pamphlet_Paragraph_Count : constant :=  2;
-       Lines                    : constant :=  4;
-       Line_Length              : constant := 40;
- 
-       type Document_Type is array (Positive range <>) 
-         of ASW.Unbounded_Wide_String;
- 
-       type Camera_Ready_Copy_Type is array (1..Lines) 
-         of Wide_String (1..Line_Length);
- 
-       Pamphlet            : Document_Type (1..Pamphlet_Paragraph_Count);
- 
-       Camera_Ready_Copy   : Camera_Ready_Copy_Type := 
-                               (others => (others => Ada.Strings.Wide_Space));
- 
-       TC_Finished_Product : Camera_Ready_Copy_Type :=
-                    ( 1 => Equiv("Ada is a programming language designed  "),
-                      2 => Equiv("to support long-lived, reliable software"),
-                      3 => Equiv(" systems.                               "),
-                      4 => Equiv("Go with Ada!                            "));
- 
-       -----
- 
- 
-       procedure Enter_Text_Into_Document (Document : in out Document_Type) is
-       begin
- 
-          -- Fill in both "paragraphs" of the document.  Each unbounded wide 
-          -- string functions as an individual paragraph, containing an 
-          -- unspecified number of characters.
-          -- Use a variety of different unbounded wide string subprograms to
-          -- load the data.
- 
-          Document(1) := 
-            ASW.To_Unbounded_Wide_String(Equiv("Ada is a language"));
- 
-          -- Insert the word "programming" prior to "language".
-          Document(1) := 
-            ASW.Insert(Document(1), 
-                       ASW.Index(Document(1),
-                                 Equiv("language")),
-                       ASW.To_Wide_String(Equiv("progra") &       -- Wd Str &
-                                          ASW."*"(2,Equiv('m')) & -- Wd Unbd &
-                                          Equiv("ing ")));        -- Wd Str
- 
- 
-          -- Overwrite the word "language" with "language" + additional text.
-          Document(1) :=
-            ASW.Overwrite(Document(1),
-                          ASW.Index(Document(1),
-                                    ASW.To_Wide_String(
-                                      ASW.Tail(Document(1), 8, Equiv(' '))),
-                                    Ada.Strings.Backward),
-                          Equiv("language designed to support long-lifed"));
- 
- 
-          -- Replace the word "lifed" with "lived".
-          Document(1) :=
-            ASW.Replace_Slice(Document(1),
-                              ASW.Index(Document(1), Equiv("lifed")),
-                              ASW.Length(Document(1)),
-                              Equiv("lived"));
- 
- 
-          -- Overwrite the word "lived" with "lived" + additional text.
-          Document(1) :=
-            ASW.Overwrite(Document(1),
-                          ASW.Index(Document(1),
-                                    ASW.To_Wide_String
-                                      (ASW.Tail(Document(1), 5, Equiv(' '))),
-                                    Ada.Strings.Backward),
-                          Equiv("lived, reliable software systems."));
-                               
-                               
-          -- Use several of the overloaded versions of "&" to form this
-          -- unbounded wide string.
- 
-          Document(2) := Equiv('G')                                  & 
-                         ASW.To_Unbounded_Wide_String(Equiv("o "))   & 
-                         ASW.To_Unbounded_Wide_String(Equiv("with")) &
-                         Equiv(' ')                                  & 
-                         Equiv("Ada!");
- 
-       end Enter_Text_Into_Document;
- 
- 
-       -----
- 
- 
-       procedure Create_Camera_Ready_Copy 
-                   (Document    : in     Document_Type;
-                    Camera_Copy :    out Camera_Ready_Copy_Type) is
-       begin
-          -- Break the unbounded wide strings into fixed lengths.
- 
-          -- Search the first unbounded wide string for portions of text that
-          -- are less than or equal to the length of a wide string in the 
-          -- Camera_Ready_Copy_Type object.  
- 
-          Camera_Copy(1) :=               -- Take characters 1-39,
-            ASW.Slice(Document(1),        -- and append a blank space.
-                      1,
-                      ASW.Index(ASW.To_Unbounded_Wide_String
-                                  (ASW.Slice(Document(1),
-                                             1,
-                                             Line_Length)),
-                                Ada.Strings.Wide_Maps.To_Set(Equiv(' ')),
-                                Ada.Strings.Inside,
-                                Ada.Strings.Backward)) & Equiv(' ');
- 
-          Camera_Copy(2) :=                 -- Take characters 40-79.
-            ASW.Slice(Document(1),
-                      40,
-                      (ASW.Index_Non_Blank              -- Should return 79
-                         (ASW.To_Unbounded_Wide_String
-                            (ASW.Slice(Document(1),     -- Slice (40..79)
-                                       40,
-                                       79)),
-                          Ada.Strings.Backward) + 39)); -- Increment since
-                                                        -- this slice starts
-                                                        -- at 40.
- 
-          Camera_Copy(3)(1..9) := ASW.Slice(Document(1), -- Characters 80-88
-                                            80,
-                                            ASW.Length(Document(1))); 
-                                 
- 
-          -- Break the second unbounded wide string into the appropriate
-          -- length.  It is only twelve characters in length, so the entire 
-          -- unbounded wide string will be placed on one string of the output 
-          -- object.
- 
-          Camera_Copy(4)(1..ASW.Length(Document(2))) :=
-            ASW.To_Wide_String(ASW.Head(Document(2),
-                                        ASW.Length(Document(2))));
- 
-       end Create_Camera_Ready_Copy;
- 
- 
-       -----
- 
- 
-       function Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type) 
-         return Boolean is
-       begin
- 
-          -- Evaluate wide strings for equality, using the operators defined
-          -- in package Ada.Strings.Wide_Unbounded.  The less than/greater 
-          -- than or equal comparisons should evaluate to "equals => True".
- 
-          if ASW.To_Unbounded_Wide_String(Draft(1))   =     -- "="(WUnb,WUnb)
-             ASW.To_Unbounded_Wide_String(Master(1))   and  
-             ASW.To_Unbounded_Wide_String(Draft(2))  <=     -- "<="(WUnb,WUnb)
-             ASW.To_Unbounded_Wide_String(Master(2))   and
-             ASW.To_Unbounded_Wide_String(Draft(3))  >=     -- ">="(WUnb,WUnb)
-             ASW.To_Unbounded_Wide_String(Master(3))   and
-             ASW.To_Unbounded_Wide_String(Draft(4))   =     -- "="(WUnb,WUnb)
-             ASW.To_Unbounded_Wide_String(Master(4))
-          then
-             return True;
-          else
-             return False;
-          end if;
- 
-       end Valid_Proofread;
- 
- 
-       -----
- 
- 
-    begin
- 
-       -- Enter text into the unbounded wide string paragraphs of the document.
- 
-       Enter_Text_Into_Document (Pamphlet);
- 
- 
-       -- Reformat the unbounded wide strings into fixed wide string format.
- 
-       Create_Camera_Ready_Copy (Document    => Pamphlet,
-                                 Camera_Copy => Camera_Ready_Copy);
- 
- 
-       -- Verify the conversion process.
- 
-       if not Valid_Proofread (Draft  => Camera_Ready_Copy,
-                               Master => TC_Finished_Product)
-       then
-          Report.Failed ("Incorrect unbounded wide string processing result");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4021;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a	Thu Jan  1 00:00:00 1970
***************
*** 1,531 ****
- -- CXA4022.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package 
- --      Ada.Strings.Wide_Unbounded are available, and that they produce 
- --      correct results. Specifically, check the subprograms Count, Element,
- --      Index, Replace_Element, To_Unbounded_Wide_String, and "&", ">", "<".
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of many of the subprograms defined
- --      in package Ada.Strings.Wide_Unbounded for use with unbounded wide 
- --      strings.  The test simulates how unbounded wide strings 
- --      will be processed in a user environment, using the subprograms 
- --      provided in this package.
- --
- --      Taken in conjunction with tests CXA4021 and CXA4023, this test will 
- --      constitute a test of the functionality contained in package
- --      Ada.Strings.Wide Unbounded.  This test uses a variety
- --      of the subprograms defined in the unbounded wide string package
- --      in ways typical of common usage, with different combinations of
- --      available subprograms being used to accomplish similar 
- --      unbounded wide string processing goals.
- --      
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      08 Nov 95   SAIC    Corrected accessibility level, type visibility,
- --                          and subtest acceptance criteria problems for 
- --                          ACVC 2.0.1
- --
- --!
- 
- with Ada.Characters.Handling;
- with Ada.Strings;
- 
- package CXA40220 is
- 
-    -- The following two functions are used to translate character and string
-    -- values to "Wide" values.  They will be applied to all the Wide_Bounded
-    -- subprogram character and string parameters to simulate the use of non-
-    -- character Wide_Characters and Wide_Strings in actual practice.
-    -- Note: These functions do not actually return "equivalent" wide
-    --       characters to their character inputs, just "non-character"
-    --       wide characters.
- 
-    function Equiv (Ch : Character) return Wide_Character;
- 
-    function Equiv (Str : String) return Wide_String;
- 
- 
-    -- Functions and access-to-subprogram value used to supply mapping
-    -- capability to the appropriate versions of Count, Index, and 
-    -- Translate.
- 
-    function AB_to_US_Mapping_Function (From : Wide_Character) 
-      return Wide_Character;
- 
-    function AB_to_Blank_Mapping_Function (From : Wide_Character) 
-      return Wide_Character;
- 
- end CXA40220;
- 
- package body CXA40220 is
- 
-    function Equiv (Ch : Character) return Wide_Character is
-       C : Character := Ch;
-    begin
-       if Ch = ' ' then
-          return Ada.Characters.Handling.To_Wide_Character(C);
-       else
-          return Wide_Character'Val(Character'Pos(Ch) + 
-                 Character'Pos(Character'Last) + 1);
-       end if;
-    end Equiv;
- 
- 
-    function Equiv (Str : String) return Wide_String is
-       WS : Wide_String(Str'First..Str'Last);
-    begin
-       for i in Str'First..Str'Last loop
-          WS(i) := Equiv(Str(i));
-       end loop;
-       return WS;
-    end Equiv;
- 
- 
-    function AB_to_US_Mapping_Function (From : Wide_Character) 
-      return Wide_Character is
-       UnderScore : constant Wide_Character := Equiv('_');
-    begin
-       if From = Equiv('a')  or  From = Equiv('b')  then
-          return UnderScore;
-       else
-          return From;
-       end if;
-    end AB_to_US_Mapping_Function;
- 
- 
-    function AB_to_Blank_Mapping_Function (From : Wide_Character) 
-      return Wide_Character is
-    begin
-       if From = Equiv('a')  or  From = Equiv('b') then
-          return Ada.Strings.Wide_Space;
-       else
-          return From;
-       end if;
-    end AB_to_Blank_Mapping_Function;
- 
- end CXA40220;
- 
- 
- with CXA40220;
- with Report;
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Maps;
- with Ada.Strings.Wide_Unbounded;
- 
- procedure CXA4022 is
- begin
- 
-    Report.Test ("CXA4022", "Check that the subprograms defined in "    &
-                            "package Ada.Strings.Wide_Unbounded are "   &
-                            "available, and that they produce correct " &
-                            "results");
- 
-    Test_Block:
-    declare
- 
-       use CXA40220;
- 
-       package ASW renames Ada.Strings.Wide_Unbounded;
-       use Ada.Strings;
-       use type Wide_Maps.Wide_Character_Set;
-       use type ASW.Unbounded_Wide_String;
- 
-       Test_String       : ASW.Unbounded_Wide_String;
-       AtoE_Str          : ASW.Unbounded_Wide_String :=
-                             ASW.To_Unbounded_Wide_String(Equiv("abcde"));
- 
-       Complete_String   : ASW.Unbounded_Wide_String := 
-             ASW."&"(ASW.To_Unbounded_Wide_String(Equiv("Incomplete")),
-                     ASW."&"(Ada.Strings.Wide_Space,
-                             ASW.To_Unbounded_Wide_String(Equiv("String"))));
- 
-       Incomplete_String  : ASW.Unbounded_Wide_String :=
-                              ASW.To_Unbounded_Wide_String
-                                (Equiv("ncomplete Strin"));
- 
-       Incorrect_Spelling : ASW.Unbounded_Wide_String :=
-                              ASW.To_Unbounded_Wide_String(Equiv("Guob Dai"));
- 
-       Magic_String       : ASW.Unbounded_Wide_String :=
-            ASW.To_Unbounded_Wide_String(Equiv("abracadabra"));
- 
-       Incantation        : ASW.Unbounded_Wide_String := Magic_String;
- 
- 
-       A_Small_G    : Wide_Character := Equiv('g');
-       A_Small_D    : Wide_Character := Equiv('d');
- 
-       ABCD_Set     : Wide_Maps.Wide_Character_Set := 
-                        Wide_Maps.To_Set(Equiv("abcd"));
-       B_Set        : Wide_Maps.Wide_Character_Set := 
-                        Wide_Maps.To_Set(Equiv('b'));
-       CD_Set       : Wide_Maps.Wide_Character_Set := 
-                        Wide_Maps.To_Set(Equiv("cd"));
- 
-       CD_to_XY_Map : Wide_Maps.Wide_Character_Mapping := 
-                        Wide_Maps.To_Mapping(From => Equiv("cd"), 
-                                             To   => Equiv("xy"));
-       AB_to_YZ_Map : Wide_Maps.Wide_Character_Mapping := 
-                        Wide_Maps.To_Mapping(Equiv("ab"), Equiv("yz"));
- 
- 
-       Matching_Letters : Natural := 0;
-       Location,
-       Total_Count      : Natural := 0;
- 
- 
-       Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
-                   AB_to_US_Mapping_Function'Access;
- 
- 
-    begin
- 
- 
-       -- Function "&"
- 
-       -- Prepend an 'I' and append a 'g' to the wide string.
-       Incomplete_String := ASW."&"(Equiv('I'), 
-                                    Incomplete_String);       -- Ch & W Unb
-       Incomplete_String := ASW."&"(Incomplete_String, 
-                                    A_Small_G);               -- W Unb & Ch
- 
-       if ASW."<"(Incomplete_String, Complete_String)  or
-          ASW.">"(Incomplete_String, Complete_String)  or
-          Incomplete_String /= Complete_String
-       then
-          Report.Failed("Incorrect result from use of ""&"" operator");
-       end if;
- 
- 
- 
-       -- Function Element
- 
-       -- Last element of the unbounded wide string should be a 'g'.
-       if ASW.Element(Incomplete_String, ASW.Length(Incomplete_String)) /=
-          A_Small_G
-       then
-          Report.Failed("Incorrect result from use of Function Element - 1");
-       end if;
- 
-       if ASW.Element(Incomplete_String, 2)                 /=
-          ASW.Element(ASW.Tail(Incomplete_String, 2), 1)       or
-          ASW.Element(ASW.Head(Incomplete_String, 4), 2)    /=
-          ASW.Element(ASW.To_Unbounded_Wide_String(Equiv("wnqz")), 2)
-       then
-          Report.Failed("Incorrect result from use of Function Element - 2");
-       end if;
-     
- 
- 
-       -- Procedure Replace_Element
- 
-       -- The unbounded wide string Incorrect_Spelling starts as "Guob Dai",
-       -- and is transformed by the following three procedure calls to
-       -- "Good Day".
- 
-       ASW.Replace_Element(Incorrect_Spelling, 2, Equiv('o'));
- 
-       ASW.Replace_Element(Incorrect_Spelling, 
-                           ASW.Index(Incorrect_Spelling, B_Set),
-                           A_Small_D);
- 
-       ASW.Replace_Element(Source => Incorrect_Spelling,
-                           Index  => ASW.Length(Incorrect_Spelling),
-                           By     => Equiv('y'));
- 
-       if Incorrect_Spelling /= 
-          ASW.To_Unbounded_Wide_String(Equiv("Good Day")) 
-       then
-          Report.Failed("Incorrect result from Procedure Replace_Element");
-       end if;
- 
- 
- 
-       -- Function Index with non-Identity map.               
-       -- Evaluate the function Index with a non-identity map 
-       -- parameter which will cause mapping of the source parameter 
-       -- prior to the evaluation of the index position search.
- 
-       Location := ASW.Index(Source  => ASW.To_Unbounded_Wide_String
-                                          (Equiv("abcdefghij")),
-                             Pattern => Equiv("xy"),
-                             Going   => Ada.Strings.Forward,
-                             Mapping => CD_to_XY_Map);  -- change "cd" to "xy"
- 
-       if Location /= 3 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 1");
-       end if;
- 
-       Location := ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcdabcdab")),
-                             Equiv("yz"),
-                             Ada.Strings.Backward,
-                             AB_to_YZ_Map);    -- change all "ab" to "yz"
- 
-       if Location /= 9 then
-          Report.Failed("Incorrect result from Index, non-Identity map - 2");
-       end if;
- 
-       -- A couple with identity maps (default) as well.
- 
-       if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcd")), -- Pat = Src
-                    Equiv("abcd"))                       /= 1 or
-          ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abc")),  -- Pat < Src
-                    Equiv("abcd"))                       /= 0 or
-          ASW.Index(ASW.Null_Unbounded_Wide_String,       -- Src = Null
-                    Equiv("abc"))                        /= 0 
-       then
-          Report.Failed
-            ("Incorrect result from Index with wide string patterns");
-       end if;
- 
- 
- 
-       -- Function Index (for Sets).                         
-       -- This version of Index uses Sets as the basis of the search.
- 
-       -- Test = Inside, Going = Forward  (Default case).
-       Location := 
-         ASW.Index(Source => ASW.To_Unbounded_Wide_String(Equiv("abcdeabcde")),
-                   Set    => CD_Set);  -- set containing 'c' and 'd'
- 
-       if not (Location = 3) then     -- position of first 'c' in source.
-          Report.Failed("Incorrect result from Index using Sets - 1");
-       end if;
- 
-       -- Test = Inside, Going = Backward.
-       Location := 
-         ASW.Index(Source => ASW."&"(AtoE_Str, AtoE_Str), 
-                   Set    => CD_Set,  -- set containing 'c' and 'd'
-                   Test   => Ada.Strings.Inside,
-                   Going  => Ada.Strings.Backward);
- 
-       if not (Location = 9) then   -- position of last 'd' in source.
-          Report.Failed("Incorrect result from Index using Sets - 2");
-       end if;
- 
-       -- Test = Outside, Going = Forward, Backward
-       if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")),  
-                    Wide_Maps.To_Set(Equiv("xydcgf")),
-                    Test  => Ada.Strings.Outside,
-                    Going => Ada.Strings.Forward) /= 2 or
-          ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")),  
-                    Wide_Maps.To_Set(Equiv("xydcgf")),
-                    Test  => Ada.Strings.Outside,
-                    Going => Ada.Strings.Backward) /= 5 or
-          ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")),
-                    CD_Set,
-                    Ada.Strings.Outside,
-                    Ada.Strings.Backward) /= 5
-       then
-          Report.Failed("Incorrect result from Index using Sets - 3");
-       end if;
- 
-       -- Default direction (forward) and mapping (identity).
- 
-       if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("cd")), -- Source = Set
-                    CD_Set)                     /= 1 or
-          ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("c")), -- Source < Set
-                    CD_Set)                     /= 1 or 
-          ASW.Index(ASW.Null_Unbounded_Wide_String,           -- Source = Null
-                    CD_Set)                     /= 0 or
-          ASW.Index(AtoE_Str,                             
-                    Wide_Maps.Null_Set)         /= 0 or       -- Null set
-          ASW.Index(AtoE_Str,
-                    Wide_Maps.To_Set(Equiv('x')))      /= 0   -- No match.
-       then
-          Report.Failed("Incorrect result from Index using Sets - 4");
-       end if;
- 
- 
- 
-       -- Function Index using access-to-subprogram mapping.
-       -- Evaluate the function Index with an access value that supplies the
-       -- mapping function for this version of Index.
- 
-       Map_Ptr := AB_to_US_Mapping_Function'Access;
- 
-       Location := ASW.Index(Source  => ASW.To_Unbounded_Wide_String
-                                          (Equiv("xAxabbxax xaax _cx")),
-                             Pattern => Equiv("_x"),
-                             Going   => Ada.Strings.Forward,
-                             Mapping => Map_Ptr);  -- change 'a'or 'b' to '_'
- 
-       if Location /= 6 then   -- location of "bx" substring
-          Report.Failed("Incorrect result from Index, access value map - 1");
-       end if;
- 
-       Map_Ptr := AB_to_Blank_Mapping_Function'Access;
- 
-       Location := ASW.Index(ASW.To_Unbounded_Wide_String
-                               (Equiv("ccacdcbbcdacc")),
-                             Equiv("cd "),
-                             Ada.Strings.Backward,
-                             Map_Ptr);      -- change 'a' or 'b' to ' '
- 
-       if Location /= 9 then
-          Report.Failed("Incorrect result from Index, access value map - 2");
-       end if;
- 
-       if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcd")),
-                    Equiv("  cd"),                           
-                    Ada.Strings.Forward,
-                    Map_Ptr)            /= 1 or
-          ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abc")), 
-                    Equiv("  c "),                               -- No match
-                    Ada.Strings.Backward,
-                    Map_Ptr)            /= 0
-       then
-          Report.Failed("Incorrect result from Index, access value map - 3");
-       end if;
- 
- 
- 
-       -- Function Count
- 
-       -- Determine the number of characters in the unbounded wide string that
-       -- are contained in the set.
- 
-       Matching_Letters := ASW.Count(Source => Magic_String,
-                                     Set    => ABCD_Set);
- 
-       if Matching_Letters /= 9 then
-          Report.Failed
-             ("Incorrect result from Function Count with Set parameter");
-       end if;
- 
-       -- Determine the number of occurrences of the following pattern wide
-       -- strings in the unbounded wide string Magic_String.
- 
-       if  ASW.Count(Magic_String, Equiv("ab"))   /=
-           (ASW.Count(Magic_String, Equiv("ac")) + 
-            ASW.Count(Magic_String, Equiv("ad")))  or
-           ASW.Count(Magic_String, Equiv("ab"))   /= 2
-       then
-          Report.Failed
-             ("Incorrect result from Function Count, wide string parameter");
-       end if;
- 
- 
- 
-       -- Function Count with non-Identity mapping.           
-       -- Evaluate the function Count with a non-identity map 
-       -- parameter which will cause mapping of the source parameter 
-       -- prior to the evaluation of the number of matching patterns.
- 
-       Total_Count := 
-         ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("abbabbabbabba")),
-                   Pattern => Equiv("yz"),
-                   Mapping => AB_to_YZ_Map);
- 
-       if Total_Count /= 4 then                                                 
-          Report.Failed
-            ("Incorrect result from function Count, non-Identity map - 1");
-       end if;
- 
-       if  ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("ADCBADABCD")),
-                     Equiv("AB"),
-                     Wide_Maps.To_Mapping(Equiv("CD"), Equiv("AB")))  /= 5 or
-           ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("dcccddcdccdddccccd")),
-                     Equiv("xxy"),
-                     CD_to_XY_Map)                                    /= 3
-       then
-          Report.Failed
-            ("Incorrect result from function Count, non-Identity map - 2");
-       end if;
- 
-       -- And a few with identity Wide_Maps as well.
- 
-       if ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("ABABABABAB")),
-                    Equiv("ABA"),  
-                    Wide_Maps.Identity)                /= 2 or
-          ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("aaaaaaaaaa")),
-                    Equiv("aaa"))                      /= 3 or
-          ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("XX")),    -- Src < Pat
-                    Equiv("XXX"),
-                    Wide_Maps.Identity)                /= 0 or
-          ASW.Count(AtoE_Str,                              -- Source = Pattern
-                    Equiv("abcde"))                 /= 1 or
-          ASW.Count(ASW.Null_Unbounded_Wide_String,        -- Source = Null
-                    Equiv(" "))                     /= 0
-       then
-          Report.Failed
-            ("Incorrect result from function Count, w,w/o mapping");
-       end if;
- 
- 
- 
-       -- Function Count using access-to-subprogram mapping.           
-       -- Evaluate the function Count with an access value specifying the 
-       -- mapping that is going to occur to Source.
- 
-       Map_Ptr := AB_to_US_Mapping_Function'Access;
- 
-       Total_Count := 
-         ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("abcbacbadbaAbbB")),
-                   Pattern => Equiv("__"),
-                   Mapping => Map_Ptr);  -- change 'a' and 'b' to '_'
- 
-       if Total_Count /= 5 then                                                 
-          Report.Failed
-            ("Incorrect result from function Count, access value map - 1");
-       end if;
- 
-       Map_Ptr := AB_to_Blank_Mapping_Function'Access;
- 
-       if ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("cccaccBcbcaccacAc")),
-                    Equiv("c c"),  
-                    Map_Ptr)                /= 3 or
-          ASW.Count(ASW.To_Unbounded_Wide_String
-                     (Equiv("aBBAAABaBBBBAaBABBABaBBbBB")),
-                    Equiv(" BB"),
-                    Map_Ptr)                /= 4 or
-          ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("aaaaaaaaaa")),
-                    Equiv("   "),
-                    Map_Ptr)                /= 3 or
-          ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("XX")),  -- Src < Pat
-                    Equiv("XX "),
-                    Map_Ptr)                /= 0 or
-          ASW.Count(AtoE_Str,               -- Source'Length = Pattern'Length
-                    Equiv("  cde"),
-                    Map_Ptr)                /= 1
-       then
-          Report.Failed
-            ("Incorrect result from function Count, access value map - 3");
-       end if;
- 
-       
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4022;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a	Thu Jan  1 00:00:00 1970
***************
*** 1,585 ****
- -- CXA4023.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package 
- --      Ada.Strings.Wide_Unbounded are available, and that they produce 
- --      correct results. Specifically, check the subprograms Delete, 
- --      Find_Token, Translate, Trim, and "*".
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of many of the subprograms defined
- --      in package Ada.Strings.Wide_Unbounded for use with unbounded wide 
- --      strings.  The test simulates how unbounded wide strings 
- --      will be processed in a user environment, using the subprograms 
- --      provided in this package.
- --
- --      This test, when taken in conjunction with tests CXA4021-22, will 
- --      constitute a test of the functionality contained in package
- --      Ada.Strings.Wide_Unbounded.  This test uses a variety
- --      of the subprograms defined in the unbounded wide string package
- --      in ways typical of common usage, with different combinations of
- --      available subprograms being used to accomplish similar 
- --      unbounded wide string processing goals.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      08 Nov 95   SAIC    Corrected accessibility level and type 
- --                          visibility problems for ACVC 2.0.1.
- --
- --!
- 
- with Ada.Characters.Handling;
- with Ada.Strings;
- 
- package CXA40230 is
- 
-    -- The following two functions are used to translate character and string
-    -- values to non-character "Wide" values.  They will be applied to all the
-    -- Wide_Bounded subprogram character and string parameters to simulate the
-    -- use of Wide_Characters and Wide_Strings in actual practice.
-    -- Note: These functions do not actually return "equivalent" wide
-    --       characters to their character inputs, just "non-character"
-    --       wide characters.
- 
-    function Equiv (Ch : Character) return Wide_Character;
- 
-    function Equiv (Str : String) return Wide_String;
- 
-    -- Functions and access-to-subprogram object used to supply mapping
-    -- capability to the appropriate versions of Translate.
- 
-    function AB_to_US_Mapping_Function (From : Wide_Character) 
-      return Wide_Character;
- 
-    function AB_to_Blank_Mapping_Function (From : Wide_Character) 
-      return Wide_Character;
- 
- end CXA40230;
- 
- 
- package body CXA40230 is
- 
-    function Equiv (Ch : Character) return Wide_Character is
-       C : Character := Ch;
-    begin
-       if Ch = ' ' then
-          return Ada.Characters.Handling.To_Wide_Character(C);
-       else
-          return Wide_Character'Val(Character'Pos(Ch) + 
-                 Character'Pos(Character'Last) + 1);
-       end if;
-    end Equiv;
- 
- 
-    function Equiv (Str : String) return Wide_String is
-       WS : Wide_String(Str'First..Str'Last);
-    begin
-       for i in Str'First..Str'Last loop
-          WS(i) := Equiv(Str(i));
-       end loop;
-       return WS;
-    end Equiv;
- 
- 
-    function AB_to_US_Mapping_Function (From : Wide_Character) 
-      return Wide_Character is
-       UnderScore : constant Wide_Character := Equiv('_');
-    begin
-       if From = Equiv('a')  or  From = Equiv('b')  then
-          return UnderScore;
-       else
-          return From;
-       end if;
-    end AB_to_US_Mapping_Function;
- 
- 
-    function AB_to_Blank_Mapping_Function (From : Wide_Character) 
-      return Wide_Character is
-    begin
-       if From = Equiv('a')  or  From = Equiv('b') then
-          return Ada.Strings.Wide_Space;
-       else
-          return From;
-       end if;
-    end AB_to_Blank_Mapping_Function;
- 
- end CXA40230;
- 
- 
- with CXA40230;
- with Report;
- with Ada.Characters.Handling;
- with Ada.Strings.Wide_Maps;
- with Ada.Strings.Wide_Unbounded;
- 
- procedure CXA4023 is
- begin
- 
-    Report.Test ("CXA4023", "Check that the subprograms defined in "    &
-                            "package Ada.Strings.Wide_Unbounded are "   &
-                            "available, and that they produce correct " &
-                            "results");
- 
-    Test_Block:
-    declare
- 
-       use CXA40230;
- 
-       package ASW renames Ada.Strings.Wide_Unbounded;
-       use Ada.Strings;
-       use type Wide_Maps.Wide_Character_Set;
-       use type ASW.Unbounded_Wide_String;
- 
-       Test_String   : ASW.Unbounded_Wide_String;
-       AtoE_Str      : ASW.Unbounded_Wide_String :=
-                         ASW.To_Unbounded_Wide_String(Equiv("abcde"));
- 
-       Cad_String    : ASW.Unbounded_Wide_String := 
-                         ASW.To_Unbounded_Wide_String(Equiv("cad"));
- 
-       Magic_String  : ASW.Unbounded_Wide_String := 
-                         ASW.To_Unbounded_Wide_String(Equiv("abracadabra"));
- 
-       Incantation   : ASW.Unbounded_Wide_String := Magic_String;
- 
- 
-       A_Small_G : Wide_Character := Equiv('g');
-       
-       ABCD_Set  : Wide_Maps.Wide_Character_Set := 
-                     Wide_Maps.To_Set(Equiv("abcd"));
-       B_Set     : Wide_Maps.Wide_Character_Set := 
-                     Wide_Maps.To_Set(Equiv('b'));
-       AB_Set    : Wide_Maps.Wide_Character_Set := 
-                     Wide_Maps."OR"(Wide_Maps.To_Set(Equiv('a')), B_Set);
- 
- 
-       AB_to_YZ_Map     : Wide_Maps.Wide_Character_Mapping := 
-                            Wide_Maps.To_Mapping(From => Equiv("ab"), 
-                                                 To   => Equiv("yz"));
-       Code_Map         : Wide_Maps.Wide_Character_Mapping := 
-                            Wide_Maps.To_Mapping(Equiv("abcd"), Equiv("wxyz"));
-       Reverse_Code_Map : Wide_Maps.Wide_Character_Mapping :=
-                            Wide_Maps.To_Mapping(Equiv("wxyz"), Equiv("abcd"));
-       Non_Existent_Map : Wide_Maps.Wide_Character_Mapping :=
-                            Wide_Maps.To_Mapping(Equiv("jkl"), Equiv("mno"));
- 
- 
-       Token_Start      : Positive;
-       Token_End        : Natural := 0;
- 
-       Map_Ptr  : Wide_Maps.Wide_Character_Mapping_Function :=
-                    AB_to_US_Mapping_Function'Access;
- 
- 
-    begin
- 
-       -- Find_Token
- 
-       ASW.Find_Token(Magic_String,      -- Find location of first "ab" equiv.
-                      AB_Set,            -- Should be (1..2).
-                      Ada.Strings.Inside,
-                      Token_Start,
-                      Token_End);
- 
-       if Natural(Token_Start) /= ASW.To_Wide_String(Magic_String)'First  or
-          Token_End            /= ASW.Index(Magic_String, B_Set)          or
-          Token_End            /= 2
-       then 
-          Report.Failed("Incorrect result from Procedure Find_Token - 1");
-       end if;
- 
- 
-       ASW.Find_Token(Source => Magic_String, -- Find location of char 'r'equiv
-                      Set    => ABCD_Set,     -- in wide str, should be (3..3)
-                      Test   => Ada.Strings.Outside,
-                      First  => Token_Start,
-                      Last   => Token_End);
- 
-       if Natural(Token_Start) /= 3  or  Token_End /= 3 then
-          Report.Failed("Incorrect result from Procedure Find_Token - 2");
-       end if;
- 
- 
-       ASW.Find_Token(Magic_String,                -- No 'g' "equivalent in 
-                      Wide_Maps.To_Set(A_Small_G), -- the wide str, so the
-                      Ada.Strings.Inside,          -- result params should be 
-                      First => Token_Start,        -- First = Source'First and
-                      Last  => Token_End);         -- Last = 0.
- 
- 
-       if Token_Start /= ASW.To_Wide_String(Magic_String)'First  or
-          Token_End   /= 0
-       then
-          Report.Failed("Incorrect result from Procedure Find_Token - 3");
-       end if;
-  
- 
-       ASW.Find_Token(ASW.To_Unbounded_Wide_String(Equiv("abpqpqrttrcpqr")),
-                      Wide_Maps.To_Set(Equiv("trpq")),
-                      Ada.Strings.Inside,
-                      Token_Start,
-                      Token_End);
- 
-       if Token_Start /= 3 or
-          Token_End   /= 10
-       then
-          Report.Failed("Incorrect result from Procedure Find_Token - 4");
-       end if;
- 
-       ASW.Find_Token(ASW.To_Unbounded_Wide_String(Equiv("abpqpqrttrcpqr")),
-                      Wide_Maps.To_Set(Equiv("abpq")),
-                      Ada.Strings.Outside,
-                      Token_Start,
-                      Token_End);
- 
-       if Token_Start /= 7 or
-          Token_End   /= 11
-       then
-          Report.Failed("Incorrect result from Procedure Find_Token - 5");
-       end if;
- 
- 
- 
-       -- Translate
- 
-       -- Use a mapping ("abcd" -> "wxyz") to transform the contents of 
-       -- the unbounded wide string.
-       -- Magic_String = "abracadabra"
- 
-       Incantation := ASW.Translate(Magic_String, Code_Map); 
- 
-       if Incantation /= 
-          ASW.To_Unbounded_Wide_String(Equiv("wxrwywzwxrw")) 
-       then
-          Report.Failed("Incorrect result from Function Translate - 1");
-       end if;
- 
-       -- (Note: See below for additional testing of Function Translate)
- 
-       -- Use the inverse mapping of the one above to return the "translated"
-       -- unbounded wide string to its original form.
- 
-       ASW.Translate(Incantation, Reverse_Code_Map);
- 
-       -- The map contained in the following call to Translate contains three
-       -- elements, and these elements are not found in the unbounded wide
-       -- string, so this call to Translate should have no effect on it.
- 
-       if Incantation /= ASW.Translate(Magic_String, Non_Existent_Map) then
-          Report.Failed("Incorrect result from Procedure Translate - 1");
-       end if;
- 
-       -- Partial mapping of source.
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("abcdeabcab"));
- 
-       ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
- 
-       if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("yzcdeyzcyz")) then
-          Report.Failed("Incorrect result from Procedure Translate - 2");
-       end if;
- 
-       -- Total mapping of source.
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("abbaaababb"));
- 
-       ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
- 
-       if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("yzzyyyzyzz")) then
-          Report.Failed("Incorrect result from Procedure Translate - 3");
-       end if;
- 
-       -- No mapping of source.
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc"));
- 
-       ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
- 
-       if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc")) then
-          Report.Failed("Incorrect result from Procedure Translate - 4");
-       end if;
- 
-       -- Map > 2 characters, partial mapping.
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("opabcdelmn"));
- 
-       ASW.Translate(Test_String, 
-                     Wide_Maps.To_Mapping(Equiv("abcde"), Equiv("lmnop")));
- 
-       if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("oplmnoplmn")) then
-          Report.Failed("Incorrect result from Procedure Translate - 5");
-       end if;
- 
- 
- 
-       -- Various degrees of mapping of source (full, partial, none) used 
-       -- with Function Translate.
- 
-       if ASW.Translate(
-                ASW.To_Unbounded_Wide_String(Equiv("abcdeabcabbbaaacaa")), 
-                        AB_to_YZ_Map)                               /= 
-          ASW.To_Unbounded_Wide_String(Equiv("yzcdeyzcyzzzyyycyy"))   or
- 
-          ASW.Translate(
-                ASW.To_Unbounded_Wide_String(Equiv("abbaaababbaaaaba")), 
-                        AB_to_YZ_Map)                               /= 
-          ASW.To_Unbounded_Wide_String(Equiv("yzzyyyzyzzyyyyzy"))     or
- 
-          ASW.Translate(ASW.To_Unbounded_Wide_String(Equiv("cABcABBAc")),
-                        Mapping => AB_to_YZ_Map)                    /= 
-          ASW.To_Unbounded_Wide_String(Equiv("cABcABBAc"))            or
- 
-          ASW.Translate(ASW.To_Unbounded_Wide_String("opabcdelmnddeaccabec"),
-                        Wide_Maps.To_Mapping("abcde", "lmnop"))     /=
-          ASW.To_Unbounded_Wide_String("oplmnoplmnooplnnlmpn") 
-       then
-          Report.Failed("Incorrect result from Function Translate - 2");
-       end if;
- 
- 
- 
-       -- Procedure Translate using access-to-subprogram mapping.
-       -- Partial mapping of source.
- 
-       Map_Ptr := AB_to_Blank_Mapping_Function'Access;
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("abABaABbaBAbba"));
- 
-       ASW.Translate(Source  => Test_String, -- change equivalent of 'a' and
-                     Mapping => Map_Ptr);    -- 'b' to ' '
- 
-       if Test_String /= 
-          ASW.To_Unbounded_Wide_String(Equiv("  AB AB  BA   ")) 
-       then
-          Report.Failed
-            ("Incorrect result from Proc Translate, w/ access value map - 1");
-       end if;
- 
-       -- Total mapping of source to blanks.
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("abbbab"));
- 
-       ASW.Translate(Source  => Test_String, 
-                     Mapping => Map_Ptr);
- 
-       if Test_String /= 
-          ASW.To_Unbounded_Wide_String(Equiv("      ")) 
-       then
-          Report.Failed
-            ("Incorrect result from Proc Translate, w/ access value map - 2");
-       end if;
- 
-       -- No mapping of source.
- 
-       Map_Ptr := AB_to_US_Mapping_Function'Access;
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc"));
- 
-       ASW.Translate(Source  => Test_String, 
-                     Mapping => Map_Ptr);
- 
-       if Test_String /= 
-          ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc"))   -- no change
-       then
-          Report.Failed
-            ("Incorrect result from Proc Translate, w/ access value map - 3");
-       end if;
- 
- 
-       -- Function Translate using access-to-subprogram mapping value.
- 
-       Map_Ptr  := AB_to_Blank_Mapping_Function'Access;
- 
-       Test_String := ASW.To_Unbounded_Wide_String(Equiv("abAbBBAabbacD"));
- 
-       if ASW.Translate(ASW.Translate(Test_String, Map_Ptr), Map_Ptr)  /=
-          ASW.To_Unbounded_Wide_String(Equiv("  A BBA    cD")) 
-       then
-          Report.Failed
-            ("Incorrect result from Function Translate, access value map - 1");
-       end if;
- 
-       if ASW.Translate(Source  => ASW.To_Unbounded_Wide_String(Equiv("a")), 
-                        Mapping => Map_Ptr)                            /= 
-          ASW.To_Unbounded_Wide_String(Equiv(" "))                       or
-          ASW.Translate(ASW.To_Unbounded_Wide_String
-                          (Equiv(" aa Aa A AAaaa a   aA")),
-                        Map_Ptr)                                       /=
-          ASW.To_Unbounded_Wide_String(Equiv("    A  A AA         A"))   or
-          ASW.Translate(Source  => ASW.To_Unbounded_Wide_String(Equiv("a ")), 
-                        Mapping => Map_Ptr)                            /= 
-          ASW.To_Unbounded_Wide_String(Equiv("  "))                      or
-          ASW.Translate(Source  => ASW.To_Unbounded_Wide_String(Equiv("xyz")),
-                        Mapping => Map_Ptr)                            /= 
-          ASW.To_Unbounded_Wide_String(Equiv("xyz"))
-       then
-          Report.Failed
-            ("Incorrect result from Function Translate, access value map - 2");
-       end if;
- 
- 
- 
-       -- Trim
- 
-       Trim_Block:
-       declare
- 
-          XYZ_Set     : Wide_Maps.Wide_Character_Set :=
-                          Wide_Maps.To_Set(Equiv("xyz"));
-          PQR_Set     : Wide_Maps.Wide_Character_Set := 
-                          Wide_Maps.To_Set(Equiv("pqr"));
- 
-          Pad         : constant ASW.Unbounded_Wide_String := 
-                                  ASW.To_Unbounded_Wide_String(Equiv("Pad"));
- 
-          The_New_Ada : constant ASW.Unbounded_Wide_String :=
-                                  ASW.To_Unbounded_Wide_String(Equiv("Ada9X"));
- 
-          Space_Array : array (1..4) of ASW.Unbounded_Wide_String :=
-                          (ASW.To_Unbounded_Wide_String(Equiv("  Pad    ")),
-                           ASW.To_Unbounded_Wide_String(Equiv("Pad   ")),
-                           ASW.To_Unbounded_Wide_String(Equiv("     Pad")),
-                           Pad);
- 
-          String_Array : array (1..5) of ASW.Unbounded_Wide_String := 
-                         (ASW.To_Unbounded_Wide_String(Equiv("xyzxAda9Xpqr")),
-                          ASW.To_Unbounded_Wide_String(Equiv("Ada9Xqqrp")),
-                          ASW.To_Unbounded_Wide_String(Equiv("zxyxAda9Xqpqr")),
-                          ASW.To_Unbounded_Wide_String(Equiv("xxxyAda9X")),
-                          The_New_Ada);
-            
-       begin
- 
-          -- Examine the version of Trim that removes blanks from
-          -- the left and/or right of a wide string.
- 
-          for i in 1..4 loop
-             if ASW.Trim(Space_Array(i), Ada.Strings.Both) /= Pad then
-                Report.Failed("Incorrect result from Trim for spaces - " &
-                              Integer'Image(i));
-             end if;
-          end loop;   
- 
-          -- Examine the version of Trim that removes set characters from
-          -- the left and right of a wide string.
- 
-          for i in 1..5 loop
-             if ASW.Trim(String_Array(i),
-                         Left   => XYZ_Set,
-                         Right  => PQR_Set) /= The_New_Ada then
-                Report.Failed
-                  ("Incorrect result from Trim for set characters - " &
-                   Integer'Image(i));
-             end if;
-          end loop;   
- 
-          -- No trimming.
- 
-          if ASW.Trim(
-               ASW.To_Unbounded_Wide_String(Equiv("prqqprAda9Xyzzxyzzyz")),
-                      XYZ_Set,
-                      PQR_Set)  /=
-             ASW.To_Unbounded_Wide_String(Equiv("prqqprAda9Xyzzxyzzyz"))
-          then
-             Report.Failed
-               ("Incorrect result from Trim for set, no trimming");
-          end if;
- 
-       end Trim_Block;
- 
- 
- 
-       -- Delete
- 
-       -- Use the Delete function to remove the first four and last four
-       -- characters from the wide string.
- 
-       if ASW.Delete(Source  => ASW.Delete(Magic_String,
-                                           8,
-                                           ASW.Length(Magic_String)),
-                     From    => ASW.To_Wide_String(Magic_String)'First,
-                     Through => 4)   /= 
-          Cad_String
-       then
-          Report.Failed("Incorrect results from Function Delete");
-       end if;
- 
- 
- 
-       -- Constructors ("*")
- 
-       Constructor_Block:
-       declare
-       
-          SOS      : ASW.Unbounded_Wide_String;
- 
-          Dot      : constant ASW.Unbounded_Wide_String := 
-                                ASW.To_Unbounded_Wide_String(Equiv("Dot_"));
-          Dash     : constant Wide_String := Equiv("Dash_");
- 
-          Distress : ASW.Unbounded_Wide_String := 
-                       ASW."&"(ASW.To_Unbounded_Wide_String
-                                 (Equiv("Dot_Dot_Dot_")),
-                               ASW."&"(ASW.To_Unbounded_Wide_String
-                                         (Equiv("Dash_Dash_Dash_")), 
-                                       ASW.To_Unbounded_Wide_String
-                                         (Equiv("Dot_Dot_Dot"))));
-                       
-          Repeat        : constant Natural        := 3;
-          Separator     : constant Wide_Character := Equiv('_');
- 
-          Separator_Set : Wide_Maps.Wide_Character_Set := 
-                            Wide_Maps.To_Set(Separator);
- 
-       begin
- 
-          -- Use the following constructor forms to construct the wide string
-          -- "Dot_Dot_Dot_Dash_Dash_Dash_Dot_Dot_Dot".  Note that the 
-          -- trailing underscore in the wide string is removed in the call to 
-          -- Trim in the If statement condition.
- 
-          SOS := ASW."*"(Repeat, Dot);                   -- "*"(#, W Unb Str)
- 
-          SOS := ASW."&"(SOS,
-                         ASW."&"(ASW."*"(Repeat, Dash),  -- "*"(#, W Str)
-                                 ASW."*"(Repeat, Dot))); -- "*"(#, W Unb Str)
- 
-          if ASW.Trim(SOS, Wide_Maps.Null_Set, Separator_Set) /= Distress then
-             Report.Failed("Incorrect results from Function ""*""");
-          end if;
- 
-       end Constructor_Block;
-       
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4023;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a	Thu Jan  1 00:00:00 1970
***************
*** 1,350 ****
- -- CXA4024.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function "-", To_Ranges, To_Domain, and To_Range are
- --      available in the package Ada.Strings.Maps, and that they produce
- --      correct results based on the Character_Set/Character_Mapping input
- --      provided.
- --
- -- TEST DESCRIPTION:
- --      This test examines the operation of four functions from within the
- --      Ada.Strings.Maps package.  A variety of Character_Sequence, 
- --      Character_Set, and Character_Mapping objects are created and 
- --      initialized for use with these functions.  In each subtest of
- --      function operation, specific inputs are provided to the functions as
- --      input parameters, and the results are evaluated against expected
- --      values.  Wherever appropriate, additional characteristics of the
- --      function results are verified against the prescribed result
- --      characteristics.
- --
- --       
- -- CHANGE HISTORY:
- --      03 Feb 95   SAIC    Initial prerelease version
- --      10 Mar 95   SAIC    Incorporated reviewer comments.
- --      15 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      05 Oct 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- with Ada.Strings.Maps;
- with Ada.Strings.Maps.Constants;
- with Ada.Characters.Latin_1;
- with Report;
- 
- procedure CXA4024 is
- 
- begin
- 
-    Report.Test ("CXA4024", "Check that the function ""-"", To_Ranges, " &
-                            "To_Domain, and To_Range are available in "  &
-                            "the package Ada.Strings.Maps, and that "    &
-                            "they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Strings, Ada.Strings.Maps;
-       use type Maps.Character_Set;  -- To allow logical set operator 
-                                     -- infix notation.
-       package ACL1 renames Ada.Characters.Latin_1;
-   
-       MidPoint_Letter  : constant := 13;
-       Last_Letter      : constant := 26;
- 
-       Vowels           : constant Maps.Character_Sequence := "aeiou";
-       Quasi_Vowel      : constant Character := 'y';
- 
-       Alphabet         : Maps.Character_Sequence (1..Last_Letter);
-       Half_Alphabet    : Maps.Character_Sequence (1..MidPoint_Letter);
- 
-       Alphabet_Set,
-       Consonant_Set,
-       Vowel_Set,
-       First_Half_Set,
-       Second_Half_Set  : Maps.Character_Set;
- 
- 
-    begin
- 
-       -- Load the alphabet strings for use in creating sets.
-       for i in 0..12 loop
-          Half_Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
-       end loop;
- 
-       for i in 0..25 loop
-          Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
-       end loop;
- 
-       -- Initialize a series of Character_Set objects.
-       
-       Alphabet_Set    := Maps.To_Set(Alphabet);
-       Vowel_Set       := Maps.To_Set(Vowels);
-       Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
-       First_Half_Set  := Maps.To_Set(Half_Alphabet);
-       Second_Half_Set := Alphabet_Set  XOR  First_Half_Set;
- 
- 
- 
-       -- Evaluation of Set operator "-".
- 
-       if Consonant_Set  /= "-"(Alphabet_Set, Vowel_Set)       or
-          Vowel_Set      /= (Alphabet_Set - Consonant_Set)     or
-          Alphabet_Set   /= Alphabet_Set - Maps.Null_Set       or
-          First_Half_Set /= "-"(Alphabet_Set, Second_Half_Set) or
-          (Alphabet_Set - Vowel_Set) /= "AND"(Alphabet_Set, "NOT"(Vowel_Set)) 
-       then
-          Report.Failed("Incorrect result from ""-"" operator for sets");
-       end if;
- 
- 
- 
-       -- Evaluation of Function "To_Ranges".
- 
-       declare
- 
-          use type Maps.Character_Range;
-          use type Maps.Character_Ranges;
- 
-          Set_A_to_C   : Maps.Character_Set   := Maps.To_Set("ABC");
-          Set_J        : Maps.Character_Set   := Maps.To_Set("J");
-          Set_M_to_P   : Maps.Character_Set   := Maps.To_Set("MNOP");
-          Set_X_to_Z   : Maps.Character_Set   := Maps.To_Set("XYZ");
-          Set_Of_Five  : Maps.Character_Set   := Set_A_to_C OR  -- Union of the
-                                                 Set_M_to_P OR  -- five sets.
-                                                 Set_X_to_Z OR
-                                                 Set_J      OR
-                                                 Maps.Null_Set;
- 
-          TC_Range_A_to_C : Maps.Character_Range := (Low => 'A', High => 'C');
-          TC_Range_J      : Maps.Character_Range := ('J', 'J');
-          TC_Range_M_to_P : Maps.Character_Range := ('M', 'P');
-          TC_Range_X_to_Z : Maps.Character_Range := (Low => 'X', High => 'Z');
- 
-          TC_Ranges       : Maps.Character_Ranges (1..4) :=
-                              (1 => TC_Range_A_to_C, 
-                               2 => TC_Range_J,
-                               3 => TC_Range_M_to_P, 
-                               4 => TC_Range_X_to_Z);
- 
-       begin
- 
-          -- Based on input of a set containing four separate "spans" of
-          -- character sequences, Function To_Ranges is required to produce
-          -- the shortest array of contiguous ranges of Character values in
-          -- the input set, in increasing order of Low.
- 
-          declare
- 
-             -- This Character_Ranges constant should consist of array
-             -- components, each component being a Character_Range from Low
-             -- to High containing the appropriate characters.
- 
-             Ranges_Result   : constant Maps.Character_Ranges :=
-                                 Maps.To_Ranges(Set => Set_Of_Five);
-          begin
- 
-             -- Check the structure and components of the Character_Ranges 
-             -- constant.
- 
-             if Ranges_Result(1)      /= TC_Range_A_to_C   or
-                Ranges_Result(1).Low  /= TC_Ranges(1).Low  or
-                Ranges_Result(2)      /= TC_Range_J        or
-                Ranges_Result(2).High /= TC_Ranges(2).High or
-                Ranges_Result(3)      /= TC_Range_M_to_P   or
-                Ranges_Result(3).Low  /= TC_Ranges(3).Low  or   
-                Ranges_Result(3).High /= TC_Ranges(3).High or  
-                Ranges_Result(4)      /= TC_Range_X_To_Z   or
-                Ranges_Result(4).Low  /= TC_Ranges(4).Low  or   
-                Ranges_Result(4).High /= TC_Ranges(4).High
-             then
-                Report.Failed ("Incorrect structure or components in " &
-                               "Character_Ranges constant");
-             end if;
-             
-          exception
-             when others => 
-               Report.Failed("Exception raised using the Function To_Ranges " &
-                             "to initialize a Character_Ranges constant");
-          end;
-       end;
- 
- 
- 
-       -- Evaluation of Functions To_Domain and To_Range.
- 
-       declare
- 
-          Null_Sequence          : constant Maps.Character_Sequence := "";
- 
-          TC_Upper_Case_Sequence : constant Maps.Character_Sequence :=
-                                     "ZYXWVUTSRQPONMABCDEFGHIJKL";
-          TC_Lower_Case_Sequence : constant Maps.Character_Sequence :=
-                                     "zyxwvutsrqponmabcdefghijkl";
-          TC_Unordered_Sequence  : Maps.Character_Sequence(1..6) := 
-                                     "BxACzy";
- 
-          TC_Upper_to_Lower_Map  : Maps.Character_Mapping :=
-                                     Maps.To_Mapping(TC_Upper_Case_Sequence,
-                                                     TC_Lower_Case_Sequence);
- 
-          TC_Lower_to_Upper_Map  : Maps.Character_Mapping :=
-                                     Maps.To_Mapping(TC_Lower_Case_Sequence,
-                                                     TC_Upper_Case_Sequence);
- 
-          TC_Unordered_Map       : Maps.Character_Mapping :=
-                                     Maps.To_Mapping(TC_Unordered_Sequence, 
-                                                     "ikglja");
-       begin
- 
-          declare
- 
-             TC_Domain_1 : constant Maps.Character_Sequence := 
-                               Maps.To_Domain(TC_Upper_to_Lower_Map);
-                               
-             TC_Domain_2 : constant Maps.Character_Sequence := 
-                               Maps.To_Domain(TC_Lower_to_Upper_Map);
- 
-             TC_Domain_3 : Maps.Character_Sequence(1..6);
- 
-             TC_Range_1  : constant Maps.Character_Sequence :=
-                               Maps.To_Range(TC_Upper_to_Lower_Map);
- 
-             TC_Range_2  : constant Maps.Character_Sequence :=
-                               Maps.To_Range(TC_Lower_to_Upper_Map);
- 
-             TC_Range_3  : Maps.Character_Sequence(1..6);
- 
-          begin
- 
-             -- Function To_Domain returns the shortest Character_Sequence
-             -- value such that each character not in the result maps to
-             -- itself, and all characters in the result are in ascending 
-             -- order.
- 
-             TC_Domain_3 := Maps.To_Domain(TC_Unordered_Map);
- 
-             -- Check contents of result of To_Domain, must be in ascending
-             -- order.
- 
-             if TC_Domain_1 /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
-                Report.Failed("Incorrect result from To_Domain with " &
-                              "TC_Upper_to_Lower_Map as input");
-             end if;
- 
-             if TC_Domain_2 /= "abcdefghijklmnopqrstuvwxyz" then
-                Report.Failed("Incorrect result from To_Domain with " &
-                              "TC_Lower_to_Upper_Map as input");
-             end if;
- 
-             if TC_Domain_3 /= "ABCxyz" then        
-                Report.Failed("Incorrect result from To_Domain with " &
-                              "an unordered mapping as input");
-             end if;
- 
- 
-             -- The lower bound on the returned Character_Sequence value
-             -- from To_Domain must be 1.
- 
-             if TC_Domain_1'First /= 1 or 
-                TC_Domain_2'First /= 1 or
-                TC_Domain_3'First /= 1
-             then
-                Report.Failed("Incorrect lower bound returned from To_Domain");
-             end if;
- 
- 
-             -- Check contents of result of To_Range.
- 
-             TC_Range_3 := Maps.To_Range(TC_Unordered_Map);
- 
-             if TC_Range_1 /= "abcdefghijklmnopqrstuvwxyz" then
-                Report.Failed("Incorrect result from To_Range with " &
-                              "TC_Upper_to_Lower_Map as input");
-             end if;
- 
-             if TC_Range_2 /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
-                Report.Failed("Incorrect result from To_Range with " &
-                              "TC_Lower_to_Upper_Map as input");
-             end if;
- 
-             if TC_Range_3 /= "gilkaj" then          
-                Report.Failed("Incorrect result from To_Range with " &
-                              "an unordered mapping as input");
-             end if;
- 
- 
-             -- The lower bound on the returned Character_Sequence value
-             -- must be 1.
- 
-             if TC_Range_1'First /= 1 or 
-                TC_Range_2'First /= 1 or
-                TC_Range_3'First /= 1
-             then
-                Report.Failed("Incorrect lower bound returned from To_Range");
-             end if;
- 
- 
-             -- The upper bound on the returned Character_Sequence value
-             -- must be Map'Length.
- 
-             if TC_Range_1'Last /= TC_Lower_Case_Sequence'Length or
-                TC_Range_2'Last /= TC_Upper_Case_Sequence'Length or
-                TC_Range_3'Last /= TC_Unordered_Sequence'Length 
-             then
-                Report.Failed("Incorrect upper bound returned from To_Range");
-             end if;
- 
-          end;
- 
-          -- Both function To_Domain and To_Range return the null string 
-          -- when provided the Identity character map as an input parameter.
- 
-          if Maps.To_Domain(Maps.Identity) /= Null_Sequence then
-             Report.Failed("Function To_Domain did not return the null " &
-                           "string when provided the Identity map as "   &
-                           "input");
-          end if;
- 
-          if Maps.To_Range(Maps.Identity) /= Null_Sequence then
-             Report.Failed("Function To_Range did not return the null " &
-                           "string when provided the Identity map as "  &
-                           "input");
-          end if;
- 
-       exception
-          when others => 
-            Report.Failed("Exception raised during the evaluation of " &
-                          "Function To_Domain and To_Range");
-       end;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4024;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a	Thu Jan  1 00:00:00 1970
***************
*** 1,376 ****
- -- CXA4025.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functionality found in packages Ada.Strings.Wide_Maps,
- --      Ada.Strings.Wide_Fixed, and Ada.Strings.Wide_Maps.Wide_Constants
- --      is available and produces correct results.
- --
- -- TEST DESCRIPTION:
- --      This test validates the subprograms found in the various Wide_Map
- --      and Wide_String packages.  It is based on the tests CXA4024 and
- --      CXA4026, which are tests for the complementary "non-wide" packages.
- --      
- --      The functions found in CXA4025_0 provide mapping capability, when
- --      used in conjunction with Wide_Character_Mapping_Function objects.
- --
- --       
- -- CHANGE HISTORY:
- --      23 Jun 95   SAIC    Initial prerelease version.
- --      15 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- package CXA4025_0 is
-    -- Functions used to supply mapping capability.
-    function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
-    function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
- end CXA4025_0;
- 
- with Ada.Characters.Handling;
- package body CXA4025_0 is
-       -- Function Map_To_Lower_Case will return the lower case form of 
-       -- Wide_Characters in the range 'A'..'Z' only, and return the input
-       -- wide_character otherwise.
- 
-       function Map_To_Lower_Case (From : Wide_Character) 
-          return Wide_Character is
-       begin
-          return Ada.Characters.Handling.To_Wide_Character(
-                   Ada.Characters.Handling.To_Lower(
-                     Ada.Characters.Handling.To_Character(From)));
-       end Map_To_Lower_Case;
- 
-       -- Function Map_To_Upper_Case will return the upper case form of 
-       -- Wide_Characters in the range 'a'..'z', or whose position is in one
-       -- of the ranges 223..246 or 248..255, provided the wide_character has
-       -- an upper case form.               
- 
-       function Map_To_Upper_Case (From : Wide_Character) 
-         return Wide_Character is
-       begin
-          return Ada.Characters.Handling.To_Wide_Character(
-                   Ada.Characters.Handling.To_Upper(
-                     Ada.Characters.Handling.To_Character(From)));
-       end Map_To_Upper_Case;
- 
- end CXA4025_0;
- 
- 
- with CXA4025_0;
- with Report;
- with Ada.Characters.Handling;
- with Ada.Characters.Latin_1;
- with Ada.Exceptions;
- with Ada.Strings;
- with Ada.Strings.Wide_Maps;
- with Ada.Strings.Wide_Maps.Wide_Constants;
- with Ada.Strings.Wide_Fixed;
- 
- procedure CXA4025 is
- begin
-    Report.Test ("CXA4025",
-                 "Check that subprograms defined in packages "       &
-                 "Ada.Strings.Wide_Maps and Ada.Strings.Wide_Fixed " &
-                 "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ACL1 renames Ada.Characters.Latin_1;
- 
-       use Ada.Characters, Ada.Strings;
-       use Ada.Exceptions;
-       use type Wide_Maps.Wide_Character_Set; 
- 
-       subtype LC_Characters is Wide_Character range 'a'..'z';
- 
-       Last_Letter    : constant := 26;
-       Vowels         : constant Wide_Maps.Wide_Character_Sequence := "aeiou";
-       TC_String      : constant Wide_String := "A Standard String";
- 
-       Alphabet       : Wide_Maps.Wide_Character_Sequence (1..Last_Letter);
-       Alphabet_Set,
-       Consonant_Set,
-       Vowel_Set      : Wide_Maps.Wide_Character_Set;
- 
-       String_20      : Wide_String(1..20)    := "ABCDEFGHIJKLMNOPQRST";
-       String_40      : Wide_String(1..40)    := "abcdefghijklmnopqrst" & 
-                                                 String_20;
-       String_80      : Wide_String(1..80)    := String_40 & String_40;
-       TC_String_5    : Wide_String(1..5)     := "ABCDE";
- 
-       -- The following strings are used in examination of the Translation
-       -- subprograms.
-       New_Character_String : Wide_String(1..12) :=
-         Handling.To_Wide_String( 
-           ACL1.LC_A_Grave          & ACL1.LC_A_Ring  & ACL1.LC_AE_Diphthong &
-           ACL1.LC_C_Cedilla        & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
-           ACL1.LC_Icelandic_Eth    & ACL1.LC_N_Tilde & 
-           ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn & 
-           ACL1.LC_German_Sharp_S   & ACL1.LC_Y_Diaeresis);  
- 
-       -- Note that there is no upper case version of the last two
-       -- characters from above.
-  
-       TC_New_Character_String : Wide_String(1..12) :=
-         Handling.To_Wide_String(
-           ACL1.UC_A_Grave          & ACL1.UC_A_Ring  & ACL1.UC_AE_Diphthong &
-           ACL1.UC_C_Cedilla        & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
-           ACL1.UC_Icelandic_Eth    & ACL1.UC_N_Tilde &
-           ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn &  
-           ACL1.LC_German_Sharp_S   & ACL1.LC_Y_Diaeresis);  
- 
-       -- Access objects that will be provided as parameters to the 
-       -- subprograms.
-       Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
-                                 CXA4025_0.Map_To_Lower_Case'Access;
-       Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
-                                 CXA4025_0.Map_To_Upper_Case'Access;
- 
-    begin
- 
-       -- 
-       -- Testing of functionality found in Package Ada.Strings.Wide_Maps.
-       -- 
- 
-       -- Load the alphabet strings for use in creating sets.
-       for i in 0..25 loop
-          Alphabet(i+1) := Wide_Character'Val(Wide_Character'Pos('a')+i);
-       end loop;
- 
-       -- Initialize a series of Character_Set objects.
-       Alphabet_Set    := Wide_Maps.To_Set(Alphabet);
-       Vowel_Set       := Wide_Maps.To_Set(Vowels);
-       Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
- 
-       -- Evaluation of Set operator "-".
-       if 
-          (Alphabet_Set - Consonant_Set) /=
-                                   "AND"(Alphabet_Set, "NOT"(Consonant_Set)) or
-          (Alphabet_Set - Vowel_Set) /= "AND"(Alphabet_Set, "NOT"(Vowel_Set)) 
-       then
-          Report.Failed("Incorrect result from ""-"" operator for sets");
-       end if;
- 
-       -- Evaluation of Functions To_Domain and To_Range.
-       declare
-          Null_Sequence  : constant Wide_Maps.Wide_Character_Sequence := "";
-          TC_UC_Sequence : constant Wide_Maps.Wide_Character_Sequence :=
-                                      "ZYXWVUTSRQPONMABCDEFGHIJKL";
-          TC_LC_Sequence : constant Wide_Maps.Wide_Character_Sequence :=
-                                      "zyxwvutsrqponmabcdefghijkl";
-          TC_Upper_to_Lower_Map  : Wide_Maps.Wide_Character_Mapping :=
-                                     Wide_Maps.To_Mapping(TC_UC_Sequence,
-                                                          TC_LC_Sequence);
-          TC_Lower_to_Upper_Map  : Wide_Maps.Wide_Character_Mapping :=
-                                     Wide_Maps.To_Mapping(TC_LC_Sequence,
-                                                          TC_UC_Sequence);
-       begin
-          declare
-             TC_Domain : constant Wide_Maps.Wide_Character_Sequence := 
-                              Wide_Maps.To_Domain(TC_Upper_to_Lower_Map);
-             TC_Range  : constant Wide_Maps.Wide_Character_Sequence :=
-                              Wide_Maps.To_Range(TC_Lower_to_Upper_Map);
-          begin
-             -- Function To_Domain returns the shortest Wide_Character_Sequence
-             -- value such that each wide character not in the result maps to
-             -- itself, and all wide characters in the result are in ascending 
-             -- order.
-             if TC_Domain /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
-                Report.Failed("Incorrect result from To_Domain with " &
-                              "TC_Upper_to_Lower_Map as input");
-             end if;
- 
-             -- The lower bound on the returned Wide_Character_Sequence value
-             -- from To_Domain must be 1.
-             if TC_Domain'First /= 1 then
-                Report.Failed("Incorrect lower bound returned from To_Domain");
-             end if;
- 
-             -- Check contents of result of To_Range.
-             if TC_Range /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
-                Report.Failed("Incorrect result from To_Range with " &
-                              "TC_Lower_to_Upper_Map as input");
-             end if;
- 
-             -- The lower bound on the returned Character_Sequence value
-             -- must be 1.
-             if TC_Range'First /= 1 then
-                Report.Failed("Incorrect lower bound returned from To_Range");
-             end if;
- 
-             if TC_Range'Last /= TC_LC_Sequence'Length then
-                Report.Failed("Incorrect upper bound returned from To_Range");
-             end if;
-          end;
- 
-          -- Both function To_Domain and To_Range return the null string 
-          -- when provided the Identity character map as an input parameter.
-          if Wide_Maps.To_Domain(Wide_Maps.Identity) /= Null_Sequence or
-             Wide_Maps.To_Range(Wide_Maps.Identity)  /= Null_Sequence 
-          then
-             Report.Failed("Null sequence not returned from To_Domain or " &
-                           "To_Range when provided the Identity map as input");
-          end if;
-       exception
-          when others => 
-            Report.Failed("Exception raised during the evaluation of " &
-                          "Function To_Domain and To_Range");
-       end;
- 
-       -- Testing of functionality found in Package Ada.Strings.Wide_Fixed.
-       -- 
-       -- Function Index, Forward direction search.
- 
-       if Wide_Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
-                           "MIXED CASE STRING",
-                           Ada.Strings.Forward,
-                           Map_To_Upper_Case_Ptr)               /= 12 or
-          Wide_Fixed.Index("STRING WITH NO MATCHING PATTERNS",
-                           "WITH",
-                           Ada.Strings.Forward,
-                           Map_To_Lower_Case_Ptr)               /= 0  
-       then
-          Report.Failed("Incorrect results from Function Index, going "    &
-                        "in Forward direction, using a Character Mapping " &
-                        "Function parameter");
-       end if;
- 
-       -- Function Index, Backward direction search.
-       if Wide_Fixed.Index("Case of a Mixed Case String", 
-                           "case", 
-                           Ada.Strings.Backward,
-                           Map_To_Lower_Case_Ptr)               /= 17   or
-          Wide_Fixed.Index("WOULD MATCH BUT FOR THE CASE",
-                           "WOULD MATCH BUT FOR THE CASE",
-                           Ada.Strings.Backward,
-                           Map_To_Lower_Case_Ptr)               /= 0
-       then
-          Report.Failed("Incorrect results from Function Index, going "     &
-                        "in Backward direction, using a Character Mapping " &
-                        "Function parameter");
-       end if;
- 
-       -- Function Count.
-       if Wide_Fixed.Count("ABABABA", "ABA",   Map_To_Upper_Case_Ptr) /= 2 or
-          Wide_Fixed.Count("",        "match", Map_To_Lower_Case_Ptr) /= 0
-       then
-          Report.Failed("Incorrect results from Function Count, using " &
-                        "a Character Mapping Function parameter");
-       end if;
- 
-       -- Function Translate.
-       if Wide_Fixed.Translate(Source  => "A Sample Mixed Case String",
-                               Mapping => Map_To_Lower_Case_Ptr) /= 
-          "a sample mixed case string"                             or
-          Wide_Fixed.Translate(New_Character_String,
-                               Map_To_Upper_Case_Ptr)            /=
-          TC_New_Character_String
-       then
-          Report.Failed("Incorrect results from Function Translate, using " &
-                        "a Wide_Character Mapping Function parameter");
-       end if;
- 
-       -- Procedure Translate.
-       declare
-          use Ada.Strings.Wide_Fixed;
-          Str : Wide_String(1..19) := "A Mixed Case String";
-       begin
-          Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr);
-          if Str /= "a mixed case string" then
-             Report.Failed("Incorrect result from Procedure Translate - 1");
-          end if;
- 
-          Translate(New_Character_String, Map_To_Upper_Case_Ptr);
-          if New_Character_String /= TC_New_Character_String then
-             Report.Failed("Incorrect result from Procedure Translate - 2");
-          end if;
-       end;
- 
-       -- Procedure Trim.
-       declare
-          use Ada.Strings.Wide_Fixed;
-          Trim_String : Wide_String(1..30) := "    A string of characters    ";
-       begin
-          Trim(Trim_String, Ada.Strings.Left, Ada.Strings.Right, 'x');
-          if Trim_String /= "xxxxA string of characters    " then
-             Report.Failed("Incorrect result from Procedure Trim, trim " &
-                           "side = left, justify = right, pad = x");
-          end if;
- 
-          Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);
-          if Trim_String /= "  xxxxA string of characters  " then
-             Report.Failed("Incorrect result from Procedure Trim, trim " &
-                           "side = right, justify = center, default pad");
-          end if;
-       end;
- 
-       -- Procedure Head.
-       declare
-          Fixed_String : Wide_String(1..20) := "A sample test string";
-       begin
-          Wide_Fixed.Head(Source => Fixed_String, Count => 14, 
-                          Justify => Ada.Strings.Center, Pad => '$');
-          if Fixed_String /= "$$$A sample test $$$" then
-             Report.Failed("Incorrect result from Procedure Head, " &
-                           "justify = center, pad = $");
-          end if;
- 
-          Wide_Fixed.Head(Fixed_String, 11, Ada.Strings.Right);
-          if Fixed_String /= "         $$$A sample" then
-             Report.Failed("Incorrect result from Procedure Head, " &
-                           "justify = right, default pad");
-          end if;
-       end;
- 
-       -- Procedure Tail.
-       declare
-          use Ada.Strings.Wide_Fixed;
-          Tail_String : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST";
-       begin
-          -- Default left justify.
-          Tail(Source => Tail_String, Count => 10, Pad => '-'); 
-          if Tail_String /= "KLMNOPQRST----------" then
-             Report.Failed("Incorrect result from Procedure Tail, " &
-                           "default justify, pad = -");
-          end if;
- 
-          Tail(Tail_String, 6, Ada.Strings.Center, 'a');
-          if Tail_String /= "aaaaaaa------aaaaaaa" then
-             Report.Failed("Incorrect result from Procedure Tail, " &
-                           "justify = center, pad = a");
-          end if;
-       end;
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4025;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a	Thu Jan  1 00:00:00 1970
***************
*** 1,526 ****
- -- CXA4026.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Ada.Strings.Fixed procedures Head, Tail, and Trim, as well 
- --      as the versions of subprograms Translate (procedure and function), 
- --      Index, and Count, available in the package which use a 
- --      Maps.Character_Mapping_Function input parameter, produce correct 
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test examines the operation of several subprograms contained in
- --      the Ada.Strings.Fixed package.  
- --      This includes procedure versions of Head, Tail, and Trim, as well as
- --      four subprograms that use a Character_Mapping_Function as a parameter 
- --      to provide the mapping capability.
- --      
- --      Two functions are defined to provide the mapping.  Access values 
- --      are defined to refer to these functions.  One of the functions will
- --      map upper case characters in the range 'A'..'Z' to their lower case
- --      counterparts, while the other function will map lower case characters
- --      ('a'..'z', or a character whose position is in one of the ranges 
- --      223..246 or 248..255, provided the character has an upper case form)
- --      to their upper case form.
- --      
- --      Function Index uses the mapping function access value to map the input
- --      string prior to searching for the appropriate index value to return.
- --      Function Count uses the mapping function access value to map the input
- --      string prior to counting the occurrences of the pattern string.
- --      Both the Procedure and Function version of Translate use the mapping
- --      function access value to perform the translation.
- --
- --      Results of all subprograms are compared with expected results.
- --      
- --       
- -- CHANGE HISTORY:
- --      10 Feb 95   SAIC    Initial prerelease version
- --      21 Apr 95   SAIC    Modified definition of string variable Str_2.
- --
- --!
- 
- 
- package CXA4026_0 is
- 
-    -- Function Map_To_Lower_Case will return the lower case form of 
-    -- Characters in the range 'A'..'Z' only, and return the input
-    -- character otherwise.
- 
-    function Map_To_Lower_Case (From : Character) return Character;
- 
- 
-    -- Function Map_To_Upper_Case will return the upper case form of 
-    -- Characters in the range 'a'..'z', or whose position is in one
-    -- of the ranges 223..246 or 248..255, provided the character has
-    -- an upper case form.               
- 
-    function Map_To_Upper_Case (From : Character) return Character;
- 
- end CXA4026_0;
- 
- 
- with Ada.Characters.Handling;
- package body CXA4026_0 is
- 
-    function Map_To_Lower_Case (From : Character) return Character is
-    begin
-       if From in 'A'..'Z' then
-          return Character'Val(Character'Pos(From) -
-                              (Character'Pos('A') - Character'Pos('a')));
-       else
-          return From;
-       end if;
-    end Map_To_Lower_Case;
- 
-    function Map_To_Upper_Case (From : Character) return Character is
-    begin
-       return Ada.Characters.Handling.To_Upper(From);
-    end Map_To_Upper_Case;
- 
- end CXA4026_0;
- 
- 
- with CXA4026_0;
- with Ada.Strings.Fixed;
- with Ada.Strings.Maps;
- with Ada.Characters.Handling;
- with Ada.Characters.Latin_1;
- with Report;
- 
- procedure CXA4026 is
- 
- begin
- 
-    Report.Test ("CXA4026", "Check that procedures Trim, Head, and Tail, " &
-                            "as well as the versions of subprograms "      &
-                            "Translate, Index, and Count, which use the "  &
-                            "Character_Mapping_Function input parameter,"  &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Strings, CXA4026_0;
- 
-       -- The following strings are used in examination of the Translation
-       -- subprograms.
- 
-       New_Character_String : String(1..10) :=
-                                Ada.Characters.Latin_1.LC_A_Grave          &
-                                Ada.Characters.Latin_1.LC_A_Ring           &
-                                Ada.Characters.Latin_1.LC_AE_Diphthong     &
-                                Ada.Characters.Latin_1.LC_C_Cedilla        &
-                                Ada.Characters.Latin_1.LC_E_Acute          &
-                                Ada.Characters.Latin_1.LC_I_Circumflex     &
-                                Ada.Characters.Latin_1.LC_Icelandic_Eth    &
-                                Ada.Characters.Latin_1.LC_N_Tilde          &
-                                Ada.Characters.Latin_1.LC_O_Oblique_Stroke &
-                                Ada.Characters.Latin_1.LC_Icelandic_Thorn;  
-  
- 
-       TC_New_Character_String : String(1..10) :=
-                                Ada.Characters.Latin_1.UC_A_Grave          &
-                                Ada.Characters.Latin_1.UC_A_Ring           &
-                                Ada.Characters.Latin_1.UC_AE_Diphthong     &
-                                Ada.Characters.Latin_1.UC_C_Cedilla        &
-                                Ada.Characters.Latin_1.UC_E_Acute          &
-                                Ada.Characters.Latin_1.UC_I_Circumflex     &
-                                Ada.Characters.Latin_1.UC_Icelandic_Eth    &
-                                Ada.Characters.Latin_1.UC_N_Tilde          &
-                                Ada.Characters.Latin_1.UC_O_Oblique_Stroke &
-                                Ada.Characters.Latin_1.UC_Icelandic_Thorn;  
- 
- 
-       -- Functions used to supply mapping capability.
- 
- 
-       -- Access objects that will be provided as parameters to the 
-       -- subprograms.
- 
-       Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
-                                 Map_To_Lower_Case'Access;
- 
-       Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
-                                 Map_To_Upper_Case'Access;
- 
- 
-    begin
- 
-       -- Function Index, Forward direction search.
-       -- Note: Several of the following cases use the default value
-       --       Forward for the Going parameter.
- 
-       if Fixed.Index(Source => "The library package Strings.Fixed",
-                      Pattern => "fix",
-                      Going   => Ada.Strings.Forward,
-                      Mapping => Map_To_Lower_Case_Ptr)    /= 29   or
-          Fixed.Index("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN",
-                      "ain",
-                      Mapping => Map_To_Lower_Case_Ptr)    /= 6    or
-          Fixed.Index("maximum number",
-                      "um",
-                      Ada.Strings.Forward,
-                      Map_To_Lower_Case_Ptr)               /= 6    or
-          Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
-                      "MIXED CASE STRING",
-                      Ada.Strings.Forward,
-                      Map_To_Upper_Case_Ptr)               /= 12   or
-          Fixed.Index("STRING WITH NO MATCHING PATTERNS",
-                      "WITH",
-                      Ada.Strings.Forward,
-                      Map_To_Lower_Case_Ptr)               /= 0    or
-          Fixed.Index("THIS STRING IS IN UPPER CASE",
-                      "IS",
-                      Ada.Strings.Forward,
-                      Map_To_Upper_Case_Ptr)               /= 3    or
-          Fixed.Index("",  -- Null string.
-                      "is",
-                      Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
-          Fixed.Index("AAABBBaaabbb",
-                      "aabb",
-                      Mapping => Map_To_Lower_Case_Ptr)    /= 2
-       then
-          Report.Failed("Incorrect results from Function Index, going "    &
-                        "in Forward direction, using a Character Mapping " &
-                        "Function parameter");
-       end if;
- 
- 
- 
-       -- Function Index, Backward direction search.
- 
-       if Fixed.Index("Case of a Mixed Case String", 
-                      "case", 
-                      Ada.Strings.Backward,
-                      Map_To_Lower_Case_Ptr)               /= 17   or
-          Fixed.Index("Case of a Mixed Case String", 
-                      "CASE", 
-                      Ada.Strings.Backward,
-                      Map_To_Upper_Case_Ptr)               /= 17   or
-          Fixed.Index("rain, Rain, and more RAIN",
-                      "rain",
-                      Ada.Strings.Backward,
-                      Map_To_Lower_Case_Ptr)               /= 22   or
-          Fixed.Index("RIGHT place, right time",
-                      "RIGHT",
-                      Ada.Strings.Backward,
-                      Map_To_Upper_Case_Ptr)               /= 14   or
-          Fixed.Index("WOULD MATCH BUT FOR THE CASE",
-                      "WOULD MATCH BUT FOR THE CASE",
-                      Ada.Strings.Backward,
-                      Map_To_Lower_Case_Ptr)               /= 0
-       then
-          Report.Failed("Incorrect results from Function Index, going "     &
-                        "in Backward direction, using a Character Mapping " &
-                        "Function parameter");
-       end if;
- 
- 
- 
-       -- Function Index, Pattern_Error if Pattern = Null_String
- 
-       declare
-          use Ada.Strings.Fixed;
-          Null_Pattern_String : constant String := "";
-          TC_Natural          : Natural         := 1000;
-       begin
-          TC_Natural := Index("A Valid String", 
-                              Null_Pattern_String,
-                              Ada.Strings.Forward,
-                              Map_To_Lower_Case_Ptr);
-          Report.Failed("Pattern_Error not raised by Function Index when " &
-                        "given a null pattern string");
-       exception
-          when Pattern_Error => null;   -- OK, expected exception.
-          when others        =>
-             Report.Failed("Incorrect exception raised by Function Index " &
-                           "using a Character Mapping Function parameter " &
-                           "when given a null pattern string");
-       end;
- 
- 
- 
-       -- Function Count.
- 
-       if Fixed.Count(Source  => "ABABABA",        
-                      Pattern => "aba",
-                      Mapping => Map_To_Lower_Case_Ptr)        /=  2   or
-          Fixed.Count("ABABABA", "ABA", Map_To_Lower_Case_Ptr) /=  0   or
-          Fixed.Count("This IS a MISmatched issue",
-                      "is",
-                      Map_To_Lower_Case_Ptr)                   /=  4   or
-          Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /=  2   or
-          Fixed.Count("This IS a MISmatched issue",
-                      "is",
-                      Map_To_Upper_Case_Ptr)                   /=  0   or
-          Fixed.Count("She sells sea shells by the sea shore",
-                      "s",
-                      Map_To_Lower_Case_Ptr)                   /=  8   or
-          Fixed.Count("",                       -- Null string.
-                      "match",
-                      Map_To_Upper_Case_Ptr)                   /=  0
-       then
-          Report.Failed("Incorrect results from Function Count, using " &
-                        "a Character Mapping Function parameter");
-       end if;
- 
- 
- 
-       -- Function Count, Pattern_Error if Pattern = Null_String
- 
-       declare
-          use Ada.Strings.Fixed;
-          Null_Pattern_String : constant String := "";
-          TC_Natural          : Natural         := 1000;
-       begin
-          TC_Natural := Count("A Valid String", 
-                              Null_Pattern_String,
-                              Map_To_Lower_Case_Ptr);
-          Report.Failed("Pattern_Error not raised by Function Count using " &
-                        "a Character Mapping Function parameter when "      &
-                        "given a null pattern string");
-       exception
-          when Pattern_Error => null;   -- OK, expected exception.
-          when others        =>
-             Report.Failed("Incorrect exception raised by Function Count " &
-                           "using a Character Mapping Function parameter " &
-                           "when given a null pattern string");
-       end;
- 
- 
- 
-       -- Function Translate.
- 
-       if Fixed.Translate(Source  => "A Sample Mixed Case String",
-                          Mapping => Map_To_Lower_Case_Ptr) /= 
-          "a sample mixed case string"                         or
- 
-          Fixed.Translate("ALL LOWER CASE",
-                          Map_To_Lower_Case_Ptr)            /= 
-          "all lower case"                                     or
- 
-          Fixed.Translate("end with lower case",
-                          Map_To_Lower_Case_Ptr)            /= 
-          "end with lower case"                                or
- 
-          Fixed.Translate("", Map_To_Lower_Case_Ptr)        /=
-          ""                                                   or
- 
-          Fixed.Translate("start with lower case",
-                          Map_To_Upper_Case_Ptr)            /= 
-          "START WITH LOWER CASE"                              or
- 
-          Fixed.Translate("ALL UPPER CASE STRING",
-                          Map_To_Upper_Case_Ptr)            /=
-          "ALL UPPER CASE STRING"                              or
- 
-          Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs",
-                          Map_To_Upper_Case_Ptr)            /=
-          "LOTS OF MIXED CASE CHARACTERS"                      or
- 
-          Fixed.Translate("", Map_To_Upper_Case_Ptr)        /=
-          ""                                                   or
- 
-          Fixed.Translate(New_Character_String,
-                          Map_To_Upper_Case_Ptr)            /=
-          TC_New_Character_String
-       then
-          Report.Failed("Incorrect results from Function Translate, using " &
-                        "a Character Mapping Function parameter");
-       end if;
- 
- 
- 
-       -- Procedure Translate.
- 
-       declare
- 
-          use Ada.Strings.Fixed;
- 
-          Str_1    : String(1..24)   := "AN ALL UPPER CASE STRING";
-          Str_2    : String(1..19)   := "A Mixed Case String";
-          Str_3    : String(1..32)   := "a string with lower case letters";
-          TC_Str_1 : constant String := Str_1;
-          TC_Str_3 : constant String := Str_3;
- 
-       begin
- 
-          Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
- 
-          if Str_1 /= "an all upper case string" then
-             Report.Failed("Incorrect result from Procedure Translate - 1");
-          end if;
- 
-          Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
- 
-          if Str_1 /= TC_Str_1 then
-             Report.Failed("Incorrect result from Procedure Translate - 2");
-          end if;
- 
-          Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr);
- 
-          if Str_2 /= "a mixed case string" then
-             Report.Failed("Incorrect result from Procedure Translate - 3");
-          end if;
- 
-          Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr);
- 
-          if Str_2 /= "A MIXED CASE STRING" then
-             Report.Failed("Incorrect result from Procedure Translate - 4");
-          end if;
- 
-          Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr);
- 
-          if Str_3 /= TC_Str_3 then
-             Report.Failed("Incorrect result from Procedure Translate - 5");
-          end if;
- 
-          Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr);
- 
-          if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then
-             Report.Failed("Incorrect result from Procedure Translate - 6");
-          end if;
- 
-          Translate(New_Character_String, Map_To_Upper_Case_Ptr);
- 
-          if New_Character_String /= TC_New_Character_String then
-             Report.Failed("Incorrect result from Procedure Translate - 6");
-          end if;
- 
-       end;
- 
- 
-       -- Procedure Trim.
- 
-       declare
-          Use Ada.Strings.Fixed;
-          Trim_String : String(1..30) := "    A string of characters    ";
-       begin
- 
-          Trim(Source  => Trim_String,
-               Side    => Ada.Strings.Left,
-               Justify => Ada.Strings.Right,
-               Pad     => 'x');
-          
-          if Trim_String /= "xxxxA string of characters    " then
-             Report.Failed("Incorrect result from Procedure Trim, trim " &
-                           "side = left, justify = right, pad = x");
-          end if;
- 
-          Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);
- 
-          if Trim_String /= "  xxxxA string of characters  " then
-             Report.Failed("Incorrect result from Procedure Trim, trim " &
-                           "side = right, justify = center, default pad");
-          end if;
- 
-          Trim(Trim_String, Ada.Strings.Both, Pad => '*');
- 
-          if Trim_String /= "xxxxA string of characters****" then
-             Report.Failed("Incorrect result from Procedure Trim, trim " &
-                           "side = both, default justify, pad = *");
-          end if;
- 
-       end;
- 
- 
-       -- Procedure Head.
- 
-       declare
-          Fixed_String : String(1..20) := "A sample test string";
-       begin
- 
-          Fixed.Head(Source  => Fixed_String,
-                     Count   => 14,
-                     Justify => Ada.Strings.Center,
-                     Pad     => '$');
- 
-          if Fixed_String /= "$$$A sample test $$$" then
-             Report.Failed("Incorrect result from Procedure Head, " &
-                           "justify = center, pad = $");
-          end if;
- 
-          Fixed.Head(Fixed_String, 11, Ada.Strings.Right);
- 
-          if Fixed_String /= "         $$$A sample" then
-             Report.Failed("Incorrect result from Procedure Head, " &
-                           "justify = right, default pad");
-          end if;
- 
-          Fixed.Head(Fixed_String, 9, Pad => '*');
-  
-          if Fixed_String /= "         ***********" then
-             Report.Failed("Incorrect result from Procedure Head, " &
-                           "default justify, pad = *");
-          end if;
- 
-       end;
- 
- 
-       -- Procedure Tail.
- 
-       declare
-          Use Ada.Strings.Fixed;
-          Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
-       begin
- 
-          Tail(Source => Tail_String, Count => 10, Pad => '-');
- 
-          if Tail_String /= "KLMNOPQRST----------" then
-             Report.Failed("Incorrect result from Procedure Tail, " &
-                           "default justify, pad = -");
-          end if;
- 
-          Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a');
- 
-          if Tail_String /= "aaaaaaa------aaaaaaa" then
-             Report.Failed("Incorrect result from Procedure Tail, " &
-                           "justify = center, pad = a");
-          end if;
- 
-          Tail(Tail_String, 1, Ada.Strings.Right);
- 
-          if Tail_String /= "                   a" then
-             Report.Failed("Incorrect result from Procedure Tail, " &
-                           "justify = right, default pad");
-          end if;
- 
-          Tail(Tail_String, 19, Ada.Strings.Right, 'A');
- 
-          if Tail_String /= "A                  a" then
-             Report.Failed("Incorrect result from Procedure Tail, " &
-                           "justify = right, pad = A");
-          end if;
- 
-       end;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
- 
-    Report.Result;
- 
- end CXA4026;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a	Thu Jan  1 00:00:00 1970
***************
*** 1,342 ****
- -- CXA4027.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that versions of Ada.Strings.Bounded subprograms Translate,
- --      (procedure and function), Index, and Count, which use the 
- --      Maps.Character_Mapping_Function input parameter, produce correct 
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test examines the operation of several subprograms from within 
- --      the Ada.Strings.Bounded package that use the 
- --      Character_Mapping_Function mapping parameter to provide a mapping
- --      capability.
- --      
- --      Two functions are defined to provide the mapping.  Access values 
- --      are defined to refer to these functions.  One of the functions will
- --      map upper case characters in the range 'A'..'Z' to their lower case
- --      counterparts, while the other function will map lower case characters
- --      ('a'..'z', or a character whose position is in one of the ranges 
- --      223..246 or 248..255, provided the character has an upper case form)
- --      to their upper case form.
- --      
- --      Function Index uses the mapping function access value to map the input
- --      string prior to searching for the appropriate index value to return.
- --      Function Count uses the mapping function access value to map the input
- --      string prior to counting the occurrences of the pattern string.
- --      Both the Procedure and Function version of Translate use the mapping
- --      function access value to perform the translation.
- --
- --      
- -- CHANGE HISTORY:
- --      16 FEB 95   SAIC    Initial prerelease version
- --      17 Jul 95   SAIC    Incorporated reviewer comments.  Replaced two 
- --                          internally declared functions with two library
- --                          level functions to eliminate accessibility
- --                          problems.
- --
- --!
- 
- 
- -- Function CXA4027_0 will return the lower case form of 
- -- the character input if it is in upper case, and return the input
- -- character otherwise.
- 
- with Ada.Characters.Handling;
- function CXA4027_0 (From : Character) return Character;
- 
- function CXA4027_0 (From : Character) return Character is
- begin
-    return Ada.Characters.Handling.To_Lower(From);
- end CXA4027_0;
- 
- 
- 
- -- Function CXA4027_1 will return the upper case form of 
- -- Characters in the range 'a'..'z', or whose position is in one
- -- of the ranges 223..246 or 248..255, provided the character has
- -- an upper case form.
- 
- with Ada.Characters.Handling;
- function CXA4027_1 (From : Character) return Character;
- 
- function CXA4027_1 (From : Character) return Character is
- begin
-    return Ada.Characters.Handling.To_Upper(From);
- end CXA4027_1;
- 
- 
- with CXA4027_0, CXA4027_1;
- with Ada.Strings.Bounded;
- with Ada.Strings.Maps;
- with Ada.Characters.Handling;
- with Report;
- 
- procedure CXA4027 is
- begin
- 
-    Report.Test ("CXA4027", "Check that Ada.Strings.Bounded subprograms "  &
-                            "Translate, Index, and Count, which use the "  &
-                            "Character_Mapping_Function input parameter, " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Strings;
- 
-       -- Functions used to supply mapping capability.
- 
-       function Map_To_Lower_Case (From : Character) return Character 
-         renames CXA4027_0; 
- 
-       function Map_To_Upper_Case (From : Character) return Character
-         renames CXA4027_1; 
- 
-       Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
-                                 Map_To_Lower_Case'Access;
- 
-       Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
-                                 Map_To_Upper_Case'Access;
- 
- 
-       -- Instantiations of Bounded String generic package.
- 
-       package BS1  is new Ada.Strings.Bounded.Generic_Bounded_Length(1);
-       package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);
-       package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);
-       package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
- 
-       use type BS1.Bounded_String,  BS20.Bounded_String, 
-                BS40.Bounded_String, BS80.Bounded_String;
- 
-       String_1   : String(1..1)  := "A";
-       String_20  : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
-       String_40  : String(1..40) := "abcdefghijklmnopqrst" & String_20;
-       String_80  : String(1..80) := String_40 & String_40;
- 
-       BString_1  : BS1.Bounded_String  := BS1.Null_Bounded_String;
-       BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;
-       BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;
-       BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;
- 
- 
-    begin
- 
-       -- Function Index.
- 
-       if BS40.Index(BS40.To_Bounded_String("Package Strings.Bounded"),
-                     Pattern => "s.b",
-                     Going   => Ada.Strings.Forward,
-                     Mapping => Map_To_Lower_Case_Ptr)     /= 15  or
-          BS80.Index(BS80.To_Bounded_String("STRING TRANSLATIONS SUBPROGRAMS"),
-                     "tr",
-                     Mapping => Map_To_Lower_Case_Ptr)     /= 2   or
-          BS20.Index(BS20.To_Bounded_String("maximum number"),
-                     "um",
-                     Ada.Strings.Backward,
-                     Map_To_Lower_Case_Ptr)                /= 10  or
-          BS80.Index(BS80.To_Bounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
-                     "MIXED CASE STRING",
-                     Ada.Strings.Forward,
-                     Map_To_Upper_Case_Ptr)                /= 12  or
-          BS40.Index(BS40.To_Bounded_String("STRING WITH NO MATCHING PATTERN"),
-                     "WITH",
-                     Ada.Strings.Backward,
-                     Map_To_Lower_Case_Ptr)                /= 0   or
-          BS80.Index(BS80.To_Bounded_String("THIS STRING IS IN UPPER CASE"),
-                     "I",
-                     Ada.Strings.Backward,
-                     Map_To_Upper_Case_Ptr)                /= 16  or
-          BS1.Index(BS1.Null_Bounded_String,
-                    "i",
-                    Mapping => Map_To_Lower_Case_Ptr)      /= 0   or
-          BS40.Index(BS40.To_Bounded_String("AAABBBaaabbb"),
-                     "aabb",
-                     Mapping => Map_To_Lower_Case_Ptr)     /= 2   or
-          BS80.Index(BS80.To_Bounded_String("WOULD MATCH BUT FOR THE CASE"),
-                     "WOULD MATCH BUT FOR THE CASE",
-                     Ada.Strings.Backward,
-                     Map_To_Lower_Case_Ptr)                /= 0
-       then
-          Report.Failed("Incorrect results from Function Index, using a " &
-                        "Character Mapping Function parameter");
-       end if;
- 
- 
-       -- Function Index, Pattern_Error if Pattern = Null_String
- 
-       declare
-          use BS20;
-          TC_Natural : Natural := 1000;
-       begin
-          TC_Natural := Index(To_Bounded_String("A Valid String"), 
-                              "",
-                              Ada.Strings.Forward,
-                              Map_To_Lower_Case_Ptr);
-          Report.Failed("Pattern_Error not raised by Function Index when " &
-                        "given a null pattern string");
-       exception
-          when Pattern_Error => null;   -- OK, expected exception.
-          when others        =>
-             Report.Failed("Incorrect exception raised by Function Index " &
-                           "using a Character_Mapping_Function parameter " &
-                           "when given a null pattern string");
-       end;
- 
- 
-       -- Function Count.
- 
-       if BS20.Count(BS20.To_Bounded_String("ABABABA"), 
-                     Pattern => "aba",
-                     Mapping => Map_To_Lower_Case_Ptr)        /=  2   or
-          BS20.Count(BS20.To_Bounded_String("ABABABA"),
-                     "ABA", 
-                     Map_To_Lower_Case_Ptr)                   /=  0   or
-          BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
-                     "is",
-                     Map_To_Lower_Case_Ptr)                   /=  4   or
-          BS80.Count(BS80.To_Bounded_String("ABABABA"), 
-                     "ABA", 
-                     Map_To_Upper_Case_Ptr)                   /=  2   or
-          BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
-                     "is",
-                     Map_To_Upper_Case_Ptr)                   /=  0   or
-          BS80.Count(BS80.To_Bounded_String
-                            ("Peter Piper and his Pickled Peppers"),
-                     "p",
-                     Map_To_Lower_Case_Ptr)                   /=  7   or
-          BS20.Count(BS20.To_Bounded_String("She sells sea shells"),
-                     "s",
-                     Map_To_Upper_Case_Ptr)                   /=  0   or
-          BS80.Count(BS80.To_Bounded_String("No matches what-so-ever"),
-                     "matches",
-                     Map_To_Upper_Case_Ptr)                   /=  0
-       then
-          Report.Failed("Incorrect results from Function Count, using " &
-                        "a Character_Mapping_Function parameter");
-       end if;
- 
- 
-       -- Function Count, Pattern_Error if Pattern = Null_String
- 
-       declare
-          use BS80;
-          TC_Natural : Natural := 1000;
-       begin
-          TC_Natural := Count(To_Bounded_String("A Valid String"), 
-                              "",
-                              Map_To_Lower_Case_Ptr);
-          Report.Failed("Pattern_Error not raised by Function Count using " &
-                        "a Character_Mapping_Function parameter when "      &
-                        "given a null pattern string");
-       exception
-          when Pattern_Error => null;   -- OK, expected exception.
-          when others        =>
-             Report.Failed("Incorrect exception raised by Function Count " &
-                           "using a Character_Mapping_Function parameter " &
-                           "when given a null pattern string");
-       end;
- 
- 
-       -- Function Translate.
- 
-       if BS40.Translate(BS40.To_Bounded_String("A Mixed Case String"),
-                         Mapping => Map_To_Lower_Case_Ptr) /= 
-          BS40.To_Bounded_String("a mixed case string")      or
- 
-          BS20."/="(BS20.Translate(BS20.To_Bounded_String("ALL LOWER CASE"),
-                                   Map_To_Lower_Case_Ptr),
-                    "all lower case")                        or
- 
-          BS20."/="("end with lower case",
-                    BS20.Translate(
-                      BS20.To_Bounded_String("end with lower case"),
-                      Map_To_Lower_Case_Ptr))                or
- 
-          BS1.Translate(BS1.Null_Bounded_String, 
-                        Map_To_Lower_Case_Ptr)             /=
-          BS1.Null_Bounded_String                            or
- 
-          BS80."/="(BS80.Translate(BS80.To_Bounded_String
-                           ("start with lower case, end with upper case"),
-                         Map_To_Upper_Case_Ptr),
-                    "START WITH LOWER CASE, END WITH UPPER CASE") or
- 
-          BS40.Translate(BS40.To_Bounded_String("ALL UPPER CASE STRING"),
-                         Map_To_Upper_Case_Ptr)            /=
-          BS40.To_Bounded_String("ALL UPPER CASE STRING")    or
- 
-          BS80."/="(BS80.Translate(BS80.To_Bounded_String
-                           ("LoTs Of MiXeD CaSe ChArAcTeRs In ThE StRiNg"),
-                           Map_To_Upper_Case_Ptr),
-                    "LOTS OF MIXED CASE CHARACTERS IN THE STRING")
- 
-       then
-          Report.Failed("Incorrect results from Function Translate, using " &
-                        "a Character_Mapping_Function parameter");
-       end if;
- 
- 
-       -- Procedure Translate.
- 
-       BString_1 := BS1.To_Bounded_String("A");
- 
-       BS1.Translate(Source => BString_1, Mapping => Map_To_Lower_Case_Ptr);
- 
-       if not BS1."="(BString_1, "a") then    -- "=" for Bounded_String, String
-          Report.Failed("Incorrect result from Procedure Translate - 1");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String(String_20);
-       BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
- 
-       if BString_20 /= BS20.To_Bounded_String("abcdefghijklmnopqrst") then
-          Report.Failed("Incorrect result from Procedure Translate - 2");
-       end if;
- 
-       BString_40 := BS40.To_Bounded_String("String needing highlighting");
-       BS40.Translate(BString_40, Map_To_Upper_Case_Ptr);
- 
-       if not (BString_40 = "STRING NEEDING HIGHLIGHTING") then
-          Report.Failed("Incorrect result from Procedure Translate - 3");
-       end if;
- 
-       BString_80 := BS80.Null_Bounded_String;
-       BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
- 
-       if not (BString_80 = BS80.Null_Bounded_String) then
-          Report.Failed("Incorrect result from Procedure Translate - 4");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4027;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a	Thu Jan  1 00:00:00 1970
***************
*** 1,331 ****
- -- CXA4028.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Ada.Strings.Bounded procedures Append, Head, Tail, and 
- --      Trim, and relational operator functions "=", ">", ">=", "<", "<=" 
- --      with parameter combinations of type String and Bounded_String, 
- --      produce correct results.
- --
- -- TEST DESCRIPTION:
- --      This test examines the operation of several subprograms from within 
- --      the Ada.Strings.Bounded package.  Four different instantiations of
- --      Ada.Strings.Bounded.Generic_Bounded_Length provide packages defined
- --      to manipulate bounded strings of lengths 1, 20, 40, and 80.
- --      Examples of the above mentioned procedures and relational operators
- --      from each of these instantiations are tested, with results compared
- --      against expected output.
- --      
- --      Testing of the function versions of many of the subprograms tested
- --      here is performed in tests CXA4006-CXA4009.
- --      
- --       
- -- CHANGE HISTORY:
- --      16 Feb 95   SAIC    Initial prerelease version
- --      10 Mar 95   SAIC    Incorporated reviewer comments.
- --      15 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- with Ada.Exceptions;
- with Ada.Strings.Bounded;
- with Report;
- 
- procedure CXA4028 is
- 
- begin
- 
-    Report.Test ("CXA4028", "Check that Ada.Strings.Bounded procedures "    &
-                            "Append, Head, Tail, and Trim, and relational " &
-                            "operator functions =, >, >=, <, <= with "      &
-                            "parameter combinations of type String and "    &
-                            "Bounded_String, produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Ada.Strings;
- 
-       -- Instantiations of Bounded String generic package.
- 
-       package BS1  is new Ada.Strings.Bounded.Generic_Bounded_Length(1);
-       package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);
-       package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);
-       package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
- 
-       use type BS1.Bounded_String,  BS20.Bounded_String, 
-                BS40.Bounded_String, BS80.Bounded_String;
- 
-       String_1   : String(1..1)  := "A";
-       String_20  : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
-       String_40  : String(1..40) := "abcdefghijklmnopqrst" & String_20;
-       String_80  : String(1..80) := String_40 & String_40;
- 
-       BString_1  : BS1.Bounded_String  := BS1.Null_Bounded_String;
-       BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;
-       BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;
-       BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;
- 
-    begin
- 
-       -- Procedure Append.
- 
-       declare
-          use BS1, BS20;
-       begin
-          Append(Source => BString_1, New_Item => To_Bounded_String("A"));
-          Append(BString_1, "B", Ada.Strings.Left);
-          Append(BString_1, 'C', Drop => Ada.Strings.Right); -- Drop appended
-                                                             -- character.
-          if BString_1 /= To_Bounded_String("B") then
-             Report.Failed("Incorrect results from BS1 versions of " &
-                           "procedure Append");
-          end if;
- 
-          Append(BString_20, 'T');                      -- Character.
-          Append(BString_20, "his string");             -- String.
-          Append(BString_20, 
-                 To_Bounded_String(" is complete."),    -- Bounded string.
-                 Drop => Ada.Strings.Right);            -- Drop 4 characters.
- 
-          if BString_20 /= To_Bounded_String("This string is compl") then
-             Report.Failed("Incorrect results from BS20 versions of " &
-                           "procedure Append");
-          end if;
-       end;
- 
- 
-       -- Operator "=".
- 
-       BString_40 := BS40.To_Bounded_String(String_40);
-       BString_80 := BS80.To_Bounded_String(
-                            BS40.To_String(BString_40) &
-                            BS40.To_String(BString_40));
- 
-       if not (BString_40 = String_40 and         -- (Bounded_String, String)
-               BS80."="(String_80, BString_80))   -- (String, Bounded_String)
-       then
-          Report.Failed("Incorrect results from function ""="" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
- 
-       -- Operator "<". 
- 
-       BString_1  := BS1.To_Bounded_String("cat",         -- string "c" only.
-                                           Drop => Ada.Strings.Right);
-       BString_20 := BS20.To_Bounded_String("Santa Claus");
- 
-       if BString_1 < "C"        or               -- (Bounded_String, String)
-          BS1."<"(BString_1,"c") or               -- (Bounded_String, String)
-          "x"  < BString_1       or               -- (String, Bounded_String)
-          BString_20 < "Santa "  or               -- (Bounded_String, String)
-          "Santa and his Elves" < BString_20      -- (String, Bounded_String)
-       then
-          Report.Failed("Incorrect results from function ""<"" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
- 
-       -- Operator "<=". 
- 
-       BString_20 := BS20.To_Bounded_String("Sample string");
- 
-       if BString_20          <= "Sample strin"  or -- (Bounded_String, String)
-          "sample string"     <= BString_20      or -- (String, Bounded_String)
-          not("Sample string" <= BString_20)        -- (String, Bounded_String)
-       then
-          Report.Failed("Incorrect results from function ""<="" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
- 
-       -- Operator ">". 
- 
-       BString_40 := BS40.To_Bounded_String("A MUCH LONGER SAMPLE STRING.");
- 
-       if BString_40 > "A much longer sample string"     or  -- (Bnd_Str, Str)
-          String_20  > BS40.To_Bounded_String(String_40) or  -- (Str, Bnd_Str)
-          BS40.To_Bounded_String("ABCDEFGH") > "abcdefgh"    -- (Str, Bnd_Str)
-       then
-          Report.Failed("Incorrect results from function "">"" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
- 
-       -- Operator ">=". 
- 
-       BString_80 := BS80.To_Bounded_String(String_80);
- 
-       if not (BString_80 >= String_80  and 
-               BS80.To_Bounded_String("Programming") >= "PROGRAMMING" and
-               "test" >= BS80.To_Bounded_String("tess"))
-       then
-          Report.Failed("Incorrect results from function "">="" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
- 
-       -- Procedure Trim
- 
-       BString_20 := BS20.To_Bounded_String("      Left Spaces  ");
-       BS20.Trim(Source => BString_20, 
-                 Side   => Ada.Strings.Left);
- 
-       if "Left Spaces  " /= BString_20 then
-          Report.Failed("Incorrect results from Procedure Trim with " &
-                        "Side = Left");
-       end if;
- 
-       BString_40 := BS40.To_Bounded_String("    Right Spaces    ");
-       BS40.Trim(BString_40, Side => Ada.Strings.Right);
- 
-       if BString_40 /= "    Right Spaces" then
-          Report.Failed("Incorrect results from Procedure Trim with " &
-                        "Side = Right");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String("   Both Sides      ");
-       BS20.Trim(BString_20, Ada.Strings.Both);
- 
-       if BString_20 /= BS20.To_Bounded_String("Both Sides") then
-          Report.Failed("Incorrect results from Procedure Trim with " &
-                        "Side = Both");
-       end if;
- 
-       BString_80 := BS80.To_Bounded_String("Centered    Spaces");
-       BS80.Trim(BString_80, Ada.Strings.Both);
- 
-       if BString_80 /= BS80.To_Bounded_String("Centered    Spaces") then
-          Report.Failed("Incorrect results from Procedure Trim with " &
-                        "no blank spaces on the ends of the string");
-       end if;
- 
- 
-       -- Procedure Head
- 
-       BString_40 := BS40.To_Bounded_String("Test String");
-       BS40.Head(Source => BString_40,
-                 Count  => 4);                       -- Count < Source'Length
- 
-       if BString_40 /= BS40.To_Bounded_String("Test") then
-          Report.Failed("Incorrect results from Procedure Head with " &
-                        "the Count parameter less than Source'Length");
-       end if;
- 
-       BString_1 := BS1.To_Bounded_String("X");
-       BS1.Head(BString_1, BS1.Length(BString_1));   -- Count = Source'Length
- 
-       if BString_1 /= "X" then
-          Report.Failed("Incorrect results from Procedure Head with " &
-                        "the Count parameter equal to Source'Length");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String("Sample string");
-       BS20.Head(BString_20, 
-                 Count => BS20.Max_Length,           -- Count > Source'Length
-                 Pad => '*');
- 
-       if BString_20 /= BS20.To_Bounded_String("Sample string*******") then
-          Report.Failed("Incorrect results from Procedure Head with "    &
-                        "the Count parameter greater than Source'Length");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String("Twenty Characters 20");
-       BS20.Head(BString_20, 22, Pad => '*', Drop => Ada.Strings.Left);
- 
-       if BString_20 /= "enty Characters 20**" then
-          Report.Failed("Incorrect results from Procedure Head with "      &
-                        "the Count parameter greater than Source'Length, " &
-                        "and the Drop parameter = Left");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String("Short String");
-       BS20.Head(BString_20, 23, '-', Ada.Strings.Right);
- 
-       if ("Short String--------") /= BString_20 then
-          Report.Failed("Incorrect results from Procedure Head with " &
-                        "the Count parameter greater than Source'Length, " &
-                        "and the Drop parameter = Right");
-       end if;
- 
- 
-       -- Procedure Tail
- 
-       BString_40 := BS40.To_Bounded_String("Test String");
-       BS40.Tail(Source => BString_40,
-                 Count  => 6);                       -- Count < Source'Length
- 
-       if BString_40 /= BS40.To_Bounded_String("String") then
-          Report.Failed("Incorrect results from Procedure Tail with " &
-                        "the Count parameter less than Source'Length");
-       end if;
- 
-       BString_1 := BS1.To_Bounded_String("X");
-       BS1.Tail(BString_1, BS1.Length(BString_1));   -- Count = Source'Length
- 
-       if BString_1 /= "X" then
-          Report.Failed("Incorrect results from Procedure Tail with " &
-                        "the Count parameter equal to Source'Length");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String("Sample string");
-       BS20.Tail(BString_20, 
-                 Count => BS20.Max_Length,           -- Count > Source'Length
-                 Pad => '*');
- 
-       if BString_20 /= BS20.To_Bounded_String("*******Sample string") then
-          Report.Failed("Incorrect results from Procedure Tail with "    &
-                        "the Count parameter greater than Source'Length");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String("Twenty Characters");  -- Len = 17
-       BS20.Tail(BString_20, 22, Pad => '*', Drop => Ada.Strings.Left);
- 
-       if BString_20 /= "***Twenty Characters" then
-          Report.Failed("Incorrect results from Procedure Tail with "      &
-                        "the Count parameter greater than Source'Length, " &
-                        "and the Drop parameter = Left");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_String("Maximum Length Chars");
-       BS20.Tail(BString_20, 23, '-', Ada.Strings.Right);
- 
-       if ("---Maximum Length Ch") /= BString_20 then
-          Report.Failed("Incorrect results from Procedure Tail with " &
-                        "the Count parameter greater than Source'Length, " &
-                        "and the Drop parameter = Right");
-       end if;
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4028;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a	Thu Jan  1 00:00:00 1970
***************
*** 1,333 ****
- -- CXA4029.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functionality found in packages Ada.Strings.Wide_Maps,
- --      Ada.Strings.Wide_Bounded, and Ada.Strings.Wide_Maps.Wide_Constants 
- --      is available and produces correct results.
- --
- -- TEST DESCRIPTION:
- --      This test tests the subprograms found in the 
- --      Ada.Strings.Wide_Bounded package.  It is based on the tests
- --      CXA4027-28, which are tests for the complementary "non-wide" 
- --      packages.
- --      
- --      The functions found in CXA4029_0 provide mapping capability, when
- --      used in conjunction with Wide_Character_Mapping_Function objects.
- --
- --       
- -- CHANGE HISTORY:
- --      23 Jun 95   SAIC    Initial prerelease version.
- --      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- package CXA4029_0 is
-    -- Functions used to supply mapping capability.
-    function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
-    function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
- end CXA4029_0;
- 
- with Ada.Characters.Handling;
- package body CXA4029_0 is
-       -- Function Map_To_Lower_Case will return the lower case form of 
-       -- Wide_Characters in the range 'A'..'Z' only, and return the input
-       -- wide_character otherwise.
- 
-       function Map_To_Lower_Case (From : Wide_Character) 
-          return Wide_Character is
-       begin
-          return Ada.Characters.Handling.To_Wide_Character(
-                   Ada.Characters.Handling.To_Lower(
-                     Ada.Characters.Handling.To_Character(From)));
-       end Map_To_Lower_Case;
- 
-       -- Function Map_To_Upper_Case will return the upper case form of 
-       -- Wide_Characters in the range 'a'..'z', or whose position is in one
-       -- of the ranges 223..246 or 248..255, provided the wide_character has
-       -- an upper case form.               
- 
-       function Map_To_Upper_Case (From : Wide_Character) 
-         return Wide_Character is
-       begin
-          return Ada.Characters.Handling.To_Wide_Character(
-                   Ada.Characters.Handling.To_Upper(
-                     Ada.Characters.Handling.To_Character(From)));
-       end Map_To_Upper_Case;
- 
- end CXA4029_0;
- 
- 
- with CXA4029_0;
- with Report;
- with Ada.Characters.Handling;
- with Ada.Characters.Latin_1;
- with Ada.Strings;
- with Ada.Strings.Wide_Maps;
- with Ada.Strings.Wide_Maps.Wide_Constants;
- with Ada.Strings.Wide_Fixed;
- with Ada.Strings.Wide_Bounded;
- 
- procedure CXA4029 is
- begin
-    Report.Test ("CXA4029",
-                 "Check that subprograms defined in package " &
-                 "Ada.Strings.Wide_Bounded produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ACL1 renames Ada.Characters.Latin_1;
-       package BS1  is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(1);
-       package BS20 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(20);
-       package BS40 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(40);
-       package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
- 
-       subtype LC_Characters is Wide_Character range 'a'..'z';
- 
-       use Ada.Characters, Ada.Strings;
-       use type Wide_Maps.Wide_Character_Set; 
-       use type BS1.Bounded_Wide_String,  BS20.Bounded_Wide_String, 
-                BS40.Bounded_Wide_String, BS80.Bounded_Wide_String;
- 
-       TC_String      : constant Wide_String := "A Standard String";
- 
-       BString_1      : BS1.Bounded_Wide_String  :=
-                               BS1.Null_Bounded_Wide_String;
-       BString_20     : BS20.Bounded_Wide_String := 
-                               BS20.Null_Bounded_Wide_String;
-       BString_40     : BS40.Bounded_Wide_String := 
-                               BS40.Null_Bounded_Wide_String;
-       BString_80     : BS80.Bounded_Wide_String := 
-                               BS80.Null_Bounded_Wide_String;
-       String_20      : Wide_String(1..20)    := "ABCDEFGHIJKLMNOPQRST";
-       String_40      : Wide_String(1..40)    := "abcdefghijklmnopqrst" & 
-                                                 String_20;
-       String_80      : Wide_String(1..80)    := String_40 & String_40;
-       TC_String_5    : Wide_String(1..5)     := "ABCDE";
- 
-       -- The following strings are used in examination of the Translation
-       -- subprograms.
-       New_Character_String : Wide_String(1..10) :=
-         Handling.To_Wide_String( 
-           ACL1.LC_A_Grave          & ACL1.LC_A_Ring  & ACL1.LC_AE_Diphthong &
-           ACL1.LC_C_Cedilla        & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
-           ACL1.LC_Icelandic_Eth    & ACL1.LC_N_Tilde & 
-           ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn);  
-  
-       TC_New_Character_String : Wide_String(1..10) :=
-         Handling.To_Wide_String(
-           ACL1.UC_A_Grave          & ACL1.UC_A_Ring  & ACL1.UC_AE_Diphthong &
-           ACL1.UC_C_Cedilla        & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
-           ACL1.UC_Icelandic_Eth    & ACL1.UC_N_Tilde &
-           ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn);  
- 
-       -- Access objects that will be provided as parameters to the 
-       -- subprograms.
-       Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
-                                 CXA4029_0.Map_To_Lower_Case'Access;
-       Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
-                                 CXA4029_0.Map_To_Upper_Case'Access;
- 
-    begin
- 
-       -- Testing of functionality found in Package Ada.Strings.Wide_Bounded.
-       -- 
-       -- Function Index.
- 
-       if BS80.Index(BS80.To_Bounded_Wide_String("CoMpLeTeLy MiXeD CaSe"),
-                     "MIXED CASE",
-                     Ada.Strings.Forward,
-                     Map_To_Upper_Case_Ptr)                /= 12  or
-          BS1.Index(BS1.Null_Bounded_Wide_String,
-                    "i",
-                    Mapping => Map_To_Lower_Case_Ptr)      /= 0   
-       then
-          Report.Failed("Incorrect results from BND Function Index, going " &
-                        "in Forward direction, using a Character Mapping "  &
-                        "Function parameter");
-       end if;
- 
-       -- Function Count.
-       if BS40.Count(BS40.To_Bounded_Wide_String("This IS a MISmatched issue"),
-                     "is",
-                     Map_To_Lower_Case_Ptr)                   /=  4   or
-          BS80.Count(BS80.To_Bounded_Wide_String("ABABABA"), 
-                     "ABA", 
-                     Map_To_Upper_Case_Ptr)                   /=  2 
-       then
-          Report.Failed("Incorrect results from BND Function Count, using " &
-                        "a Character_Mapping_Function parameter");
-       end if;
- 
-       -- Function Translate.
-       if BS40.Translate(BS40.To_Bounded_Wide_String("A Mixed Case String"),
-                         Mapping => Map_To_Lower_Case_Ptr)   /= 
-          BS40.To_Bounded_Wide_String("a mixed case string")   or
-          BS20."/="("end with lower case",
-                    BS20.Translate(
-                      BS20.To_Bounded_Wide_String("end with lower case"),
-                      Map_To_Lower_Case_Ptr))                  
-       then
-          Report.Failed("Incorrect results from BND Function Translate, " &
-                        "using a Character_Mapping_Function parameter");
-       end if;
- 
-       -- Procedure Translate.
-       BString_20 := BS20.To_Bounded_Wide_String(String_20);
-       BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
-       if BString_20 /= BS20.To_Bounded_Wide_String("abcdefghijklmnopqrst") 
-       then
-          Report.Failed("Incorrect result from BND Procedure Translate - 1");
-       end if;
- 
-       BString_80 := BS80.Null_Bounded_Wide_String;
-       BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
-       if not (BString_80 = BS80.Null_Bounded_Wide_String) then
-          Report.Failed("Incorrect result from BND Procedure Translate - 2");
-       end if;
- 
-       -- Procedure Append.
-       declare
-          use BS20;
-       begin
-          BString_20 := BS20.Null_Bounded_Wide_String;
-          Append(BString_20, 'T');                     
-          Append(BString_20, "his string");            
-          Append(BString_20, 
-                 To_Bounded_Wide_String(" is complete."),
-                 Drop => Ada.Strings.Right);            -- Drop 4 characters.
-          if BString_20 /= To_Bounded_Wide_String("This string is compl") then
-             Report.Failed("Incorrect results from BS20 versions of " &
-                           "procedure Append");
-          end if;
-       exception
-          when others => Report.Failed("Exception raised in block checking " &
-                                       "BND Procedure Append");
-       end;
- 
-       -- Operator "=".
-       BString_40 := BS40.To_Bounded_Wide_String(String_40);
-       BString_80 := BS80.To_Bounded_Wide_String(
-                            BS40.To_Wide_String(BString_40) & 
-                            BS40.To_Wide_String(BString_40));
-       if not (BString_40 = String_40 and        
-               BS80."="(String_80, BString_80)) then
-          Report.Failed("Incorrect results from BND Function ""="" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
-       -- Operator "<". 
-       BString_1  := BS1.To_Bounded_Wide_String("cat",
-                                                Drop => Ada.Strings.Right);
-       BString_20 := BS20.To_Bounded_Wide_String("Santa Claus");
-       if BString_1 < "C"                or              
-          BS1."<"(BString_1,"c")         or              
-          BS1."<"("x", BString_1)        or              
-          BS20."<"(BString_20,"Santa ")  or              
-          BS20."<"("Santa and his Elves", BString_20)     
-       then
-          Report.Failed("Incorrect results from BND Function ""<"" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
-       -- Operator "<=". 
-       BString_20 := BS20.To_Bounded_Wide_String("Sample string");
-       if BS20."<="(BString_20,"Sample strin")  or
-          not(BS20."<="("Sample string",BString_20))       
-       then
-          Report.Failed("Incorrect results from BND Function ""<="" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
-       -- Operator ">". 
-       BString_40 := BS40.To_Bounded_Wide_String(
-                            "A MUCH LONGER SAMPLE STRING.");
-       if BString_40 > "A much longer sample string"          or 
-          BS40.To_Bounded_Wide_String("ABCDEFGH") > "abcdefgh"   
-       then
-          Report.Failed("Incorrect results from BND Function "">"" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
-       -- Operator ">=". 
-       BString_80 := BS80.To_Bounded_Wide_String(String_80);
-       if not (BString_80 >= String_80  and 
-               BS80.To_Bounded_Wide_String("Programming") >= "PROGRAMMING" and
-               BS80.">="("test", BS80.To_Bounded_Wide_String("tess")))
-       then
-          Report.Failed("Incorrect results from BND Function "">="" with " &
-                        "string - bounded string parameter combinations");
-       end if;
- 
-       -- Procedure Trim
-       BString_20 := BS20.To_Bounded_Wide_String("   Both Sides      ");
-       BS20.Trim(BString_20, Ada.Strings.Both);
-       if BString_20 /= BS20.To_Bounded_Wide_String("Both Sides") then
-          Report.Failed("Incorrect results from BND Procedure Trim with " &
-                        "Side = Both");
-       end if;
- 
-       -- Procedure Head
-       BString_40 := BS40.To_Bounded_Wide_String("Test String");
-       BS40.Head(Source => BString_40,
-                 Count  => 4);                       -- Count < Source'Length
-       if BString_40 /= BS40.To_Bounded_Wide_String("Test") then
-          Report.Failed("Incorrect results from BND Procedure Head with " &
-                        "the Count parameter less than Source'Length");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_Wide_String("Short String");
-       BS20.Head(BString_20, 23, '-', Ada.Strings.Right);
-       if BS20.To_Bounded_Wide_String("Short String--------") /= BString_20 then
-          Report.Failed("Incorrect results from BND Procedure Head with "  &
-                        "the Count parameter greater than Source'Length, " &
-                        "and the Drop parameter = Right");
-       end if;
- 
-       -- Procedure Tail
-       BString_40 := BS40.To_Bounded_Wide_String("Test String");
-       BS40.Tail(Source => BString_40,
-                 Count  => 6);                       
-       if BString_40 /= BS40.To_Bounded_Wide_String("String") then
-          Report.Failed("Incorrect results from BND Procedure Tail with " &
-                        "the Count parameter less than Source'Length");
-       end if;
- 
-       BString_20 := BS20.To_Bounded_Wide_String("Maximum Length Chars");
-       BS20.Tail(BString_20, 23, '-', Ada.Strings.Right);
-       if BS20.To_Bounded_Wide_String("---Maximum Length Ch") /= BString_20 then
-          Report.Failed("Incorrect results from BND Procedure Tail with "  &
-                        "the Count parameter greater than Source'Length, " &
-                        "and the Drop parameter = Right");
-       end if;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4029;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a	Thu Jan  1 00:00:00 1970
***************
*** 1,414 ****
- -- CXA4030.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Ada.Strings.Unbounded versions of subprograms Translate 
- --      (procedure and function), Index, and Count, which use a 
- --      Maps.Character_Mapping_Function input parameter, produce correct 
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test examines the operation of the four subprograms contained
- --      in the Ada.Strings.Unbounded package that use a
- --      Character_Mapping_Function parameter to provide the mapping 
- --      capability.
- --      Two Character_Mapping_Function objects are defined that reference
- --      subprograms contained in the Ada.Characters.Handling package;
- --      To_Lower will return the lower-case form of the character provided
- --      as the input parameter, To_Upper will return the upper-case form
- --      of the character input parameter (provided there is an upper-case
- --      form).
- --      In several instances in this test, the character handling functions 
- --      are referenced directly in the parameter list of the subprograms
- --      under test, demonstrating another form of expected common usage.
- --      
- --      Results of all subprograms are compared with expected results.
- --      
- --      This test, when taken in conjunction with tests CXA4010, CXA4011,
- --      CXA4031, and CXA4032 will constitute a test of all the functionality 
- --      contained in package Ada.Strings.Unbounded.  This test uses a variety 
- --      of the subprograms defined in the unbounded string package in ways 
- --      typical of common usage.
- --      
- --       
- -- CHANGE HISTORY:
- --      21 Feb 95   SAIC    Initial prerelease version
- --      21 Apr 95   SAIC    Modified header commentary.
- --
- --!
- 
- with Ada.Strings.Unbounded;
- with Ada.Strings.Maps;
- with Ada.Characters.Handling;
- with Ada.Characters.Latin_1;
- with Report;
- 
- procedure CXA4030 is
- 
- begin
- 
-    Report.Test ("CXA4030", "Check that Ada.Strings.Unbounded versions " &
-                            "of subprograms Translate (procedure and "   &
-                            "function), Index, and Count, which use a "  &
-                            "Maps.Character_Mapping_Function input "     &
-                            "parameter, produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package Unb renames Ada.Strings.Unbounded;
-       use type Unb.Unbounded_String;
-       use Ada.Strings;
-       use Ada.Characters;
- 
- 
-       -- The following strings are used in examination of the Translation
-       -- subprograms.
- 
-       New_Character_String : Unb.Unbounded_String :=
-                                Unb.To_Unbounded_String(
-                                  Latin_1.LC_A_Grave          &
-                                  Latin_1.LC_A_Ring           &
-                                  Latin_1.LC_AE_Diphthong     &
-                                  Latin_1.LC_C_Cedilla        &
-                                  Latin_1.LC_E_Acute          &
-                                  Latin_1.LC_I_Circumflex     &
-                                  Latin_1.LC_Icelandic_Eth    &
-                                  Latin_1.LC_N_Tilde          &
-                                  Latin_1.LC_O_Oblique_Stroke &
-                                  Latin_1.LC_Icelandic_Thorn);  
-  
- 
-       TC_New_Character_String : Unb.Unbounded_String :=
-                                   Unb.To_Unbounded_String(
-                                     Latin_1.UC_A_Grave          &
-                                     Latin_1.UC_A_Ring           &
-                                     Latin_1.UC_AE_Diphthong     &
-                                     Latin_1.UC_C_Cedilla        &
-                                     Latin_1.UC_E_Acute          &
-                                     Latin_1.UC_I_Circumflex     &
-                                     Latin_1.UC_Icelandic_Eth    &
-                                     Latin_1.UC_N_Tilde          &
-                                     Latin_1.UC_O_Oblique_Stroke &
-                                     Latin_1.UC_Icelandic_Thorn);  
-                      
- 
-       -- In this test, access objects are defined to refer to two functions
-       -- from the Ada.Characters.Handling package.  These access objects 
-       -- will be provided as parameters to the subprograms under test.
-       -- Note: There will be several examples in this test of these character 
-       --       handling functions being referenced directly within the 
-       --       parameter list of the subprograms under test.
- 
-       Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
-                                 Handling.To_Lower'Access;
- 
-       Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
-                                 Handling.To_Upper'Access;
- 
-    begin
- 
-       -- Function Index, Forward direction search.
-       -- Note: Several of the following cases use the default value
-       --       Forward for the Going parameter.
- 
-       if Unb.Index(Source => Unb.To_Unbounded_String(
-                                "The library package Strings.Unbounded"),
-                    Pattern => "unb",
-                    Going   => Ada.Strings.Forward,
-                    Mapping => Map_To_Lower_Case_Ptr)    /= 29   or
- 
-          Unb.Index(Unb.To_Unbounded_String(
-                      "THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN"),
-                    "ain",
-                    Mapping => Map_To_Lower_Case_Ptr)    /= 6    or
- 
-          Unb.Index(Unb.To_Unbounded_String("maximum number"),
-                    "um",
-                    Ada.Strings.Forward,
-                    Handling.To_Lower'Access)            /= 6    or
- 
-          Unb.Index(Unb.To_Unbounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
-                    "MIXED CASE STRING",
-                    Ada.Strings.Forward,
-                    Map_To_Upper_Case_Ptr)               /= 12   or
- 
-          Unb.Index(Unb.To_Unbounded_String(
-                      "STRING WITH NO MATCHING PATTERNS"),
-                    "WITH",
-                    Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
- 
-          Unb.Index(Unb.To_Unbounded_String("THIS STRING IS IN UPPER CASE"),
-                    "IS",
-                    Ada.Strings.Forward,
-                    Handling.To_Upper'Access)            /= 3    or
- 
-          Unb.Index(Unb.Null_Unbounded_String,
-                    "is",
-                    Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
- 
-          Unb.Index(Unb.To_Unbounded_String("AAABBBaaabbb"),
-                    "aabb",
-                    Mapping => Handling.To_Lower'Access) /= 2
-       then
-          Report.Failed("Incorrect results from Function Index, going "    &
-                        "in Forward direction, using a Character Mapping " &
-                        "Function parameter");
-       end if;
- 
- 
- 
-       -- Function Index, Backward direction search.
- 
-       if Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"), 
-                    "case", 
-                    Ada.Strings.Backward,
-                    Map_To_Lower_Case_Ptr)               /= 17   or
- 
-          Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"), 
-                    "CASE", 
-                    Ada.Strings.Backward,
-                    Mapping => Map_To_Upper_Case_Ptr)    /= 17   or
- 
-          Unb.Index(Unb.To_Unbounded_String("rain, Rain, and more RAIN"),
-                    "rain",
-                    Ada.Strings.Backward,
-                    Handling.To_Lower'Access)            /= 22   or
- 
-          Unb.Index(Unb.To_Unbounded_String("RIGHT place, right time"),
-                    "RIGHT",
-                    Ada.Strings.Backward,
-                    Handling.To_Upper'Access)            /= 14   or
- 
-          Unb.Index(Unb.To_Unbounded_String("WOULD MATCH BUT FOR THE CASE"),
-                    "WOULD MATCH BUT FOR THE CASE",
-                    Going   => Ada.Strings.Backward,
-                    Mapping => Map_To_Lower_Case_Ptr)    /= 0
-       then
-          Report.Failed("Incorrect results from Function Index, going "     &
-                        "in Backward direction, using a Character Mapping " &
-                        "Function parameter");
-       end if;
- 
- 
- 
-       -- Function Index, Pattern_Error if Pattern = Null_String
- 
-       declare
-          use Unbounded;
-          Null_String : constant String := "";
-          TC_Natural  : Natural         := 1000;
-       begin
-          TC_Natural := Index(To_Unbounded_String("A Valid Unbounded String"), 
-                              Null_String,
-                              Going   => Ada.Strings.Forward,
-                              Mapping => Handling.To_Lower'Access);
-          Report.Failed("Pattern_Error not raised by Function Index when " &
-                        "given a null pattern string");
-       exception
-          when Pattern_Error => null;   -- OK, expected exception.
-          when others        =>
-             Report.Failed("Incorrect exception raised by Function Index " &
-                           "using a Character Mapping Function parameter " &
-                           "when given a null pattern string");
-       end;
- 
- 
- 
-       -- Function Count.
- 
-       if Unb.Count(Source  => Unb.To_Unbounded_String("ABABABA"),       
-                    Pattern => "aba",
-                    Mapping => Map_To_Lower_Case_Ptr)   /=  2   or
- 
-          Unb.Count(Unb.To_Unbounded_String("ABABABA"), 
-                    "ABA", 
-                    Mapping => Map_To_Lower_Case_Ptr)   /=  0   or
- 
-          Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"),
-                    "is",
-                    Handling.To_Lower'Access)           /=  4   or
- 
-          Unb.Count(Unb.To_Unbounded_String("ABABABA"), 
-                    "ABA", 
-                    Map_To_Upper_Case_Ptr)              /=  2   or
- 
-          Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"),
-                    "is",
-                    Mapping => Map_To_Upper_Case_Ptr)   /=  0   or
- 
-          Unb.Count(Unb.To_Unbounded_String(
-                      "She sells sea shells by the sea shore"),
-                    "s",
-                    Handling.To_Lower'Access)           /=  8   or
- 
-          Unb.Count(Unb.Null_Unbounded_String,      
-                    "match",
-                    Map_To_Upper_Case_Ptr)              /=  0
-       then
-          Report.Failed("Incorrect results from Function Count, using " &
-                        "a Character Mapping Function parameter");
-       end if;
- 
- 
- 
-       -- Function Count, Pattern_Error if Pattern = Null_String
- 
-       declare
-          use Ada.Strings.Unbounded;
-          Null_Pattern_String : constant String := "";
-          TC_Natural          : Natural         := 1000;
-       begin
-          TC_Natural := Count(To_Unbounded_String("A Valid String"), 
-                              Null_Pattern_String,
-                              Map_To_Lower_Case_Ptr);
-          Report.Failed("Pattern_Error not raised by Function Count using " &
-                        "a Character Mapping Function parameter when "      &
-                        "given a null pattern string");
-       exception
-          when Pattern_Error => null;   -- OK, expected exception.
-          when others        =>
-             Report.Failed("Incorrect exception raised by Function Count " &
-                           "using a Character Mapping Function parameter " &
-                           "when given a null pattern string");
-       end;
- 
- 
- 
-       -- Function Translate.
- 
-       if Unb.Translate(Source  => Unb.To_Unbounded_String(
-                                     "A Sample Mixed Case String"),
-                        Mapping => Map_To_Lower_Case_Ptr)           /= 
-          Unb.To_Unbounded_String("a sample mixed case string")       or
- 
-          Unb.Translate(Unb.To_Unbounded_String("ALL LOWER CASE"),
-                        Handling.To_Lower'Access)                   /= 
-          Unb.To_Unbounded_String("all lower case")                   or
- 
-          Unb.Translate(Unb.To_Unbounded_String("end with lower case"),
-                        Map_To_Lower_Case_Ptr)                      /= 
-          Unb.To_Unbounded_String("end with lower case")              or
- 
-          Unb.Translate(Unb.Null_Unbounded_String,
-                        Handling.To_Lower'Access)                   /=
-          Unb.Null_Unbounded_String                                   or
- 
-          Unb.Translate(Unb.To_Unbounded_String("start with lower case"),
-                        Map_To_Upper_Case_Ptr)                      /= 
-          Unb.To_Unbounded_String("START WITH LOWER CASE")            or
- 
-          Unb.Translate(Unb.To_Unbounded_String("ALL UPPER CASE STRING"),
-                        Handling.To_Upper'Access)                   /=
-          Unb.To_Unbounded_String("ALL UPPER CASE STRING")            or
- 
-          Unb.Translate(Unb.To_Unbounded_String(
-                          "LoTs Of MiXeD CaSe ChArAcTeRs"),
-                        Map_To_Upper_Case_Ptr)                      /=
-          Unb.To_Unbounded_String("LOTS OF MIXED CASE CHARACTERS")    or
- 
-          Unb.Translate(New_Character_String, 
-                        Handling.To_Upper'Access)                   /=
-          TC_New_Character_String
- 
-       then
-          Report.Failed("Incorrect results from Function Translate, using " &
-                        "a Character Mapping Function parameter");
-       end if;
- 
- 
- 
-       -- Procedure Translate.
- 
-       declare
- 
-          use Ada.Strings.Unbounded;
-          use Ada.Characters.Handling;
- 
-          Str_1    : Unbounded_String := 
-                       To_Unbounded_String("AN ALL UPPER CASE STRING");
-          Str_2    : Unbounded_String := 
-                       To_Unbounded_String("A Mixed Case String");
-          Str_3    : Unbounded_String := 
-                       To_Unbounded_String("a string with lower case letters");
-          TC_Str_1 : constant Unbounded_String := Str_1;
-          TC_Str_3 : constant Unbounded_String := Str_3;
- 
-       begin
- 
-          Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
- 
-          if Str_1 /= To_Unbounded_String("an all upper case string") then
-             Report.Failed("Incorrect result from Procedure Translate - 1");
-          end if;
- 
-          Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
- 
-          if Str_1 /= TC_Str_1 then
-             Report.Failed("Incorrect result from Procedure Translate - 2");
-          end if;
- 
-          Translate(Str_2, Mapping => Map_To_Lower_Case_Ptr);
- 
-          if Str_2 /= To_Unbounded_String("a mixed case string") then
-             Report.Failed("Incorrect result from Procedure Translate - 3");
-          end if;
- 
-          Translate(Str_2, Mapping => To_Upper'Access);
- 
-          if Str_2 /= To_Unbounded_String("A MIXED CASE STRING") then
-             Report.Failed("Incorrect result from Procedure Translate - 4");
-          end if;
- 
-          Translate(Str_3, To_Lower'Access);
- 
-          if Str_3 /= TC_Str_3 then
-             Report.Failed("Incorrect result from Procedure Translate - 5");
-          end if;
- 
-          Translate(Str_3, To_Upper'Access);
- 
-          if Str_3 /= 
-             To_Unbounded_String("A STRING WITH LOWER CASE LETTERS")
-          then
-             Report.Failed("Incorrect result from Procedure Translate - 6");
-          end if;
- 
-          Translate(New_Character_String, Map_To_Upper_Case_Ptr);
- 
-          if New_Character_String /= TC_New_Character_String then
-             Report.Failed("Incorrect result from Procedure Translate - 6");
-          end if;
- 
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4030;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a	Thu Jan  1 00:00:00 1970
***************
*** 1,291 ****
- -- CXA4031.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Strings.Unbounded
- --      are available, and that they produce correct results. Specifically, 
- --      check the functions To_Unbounded_String (version with Length
- --      parameter), "=", "<", "<=", ">", ">=" (all with String-Unbounded
- --      String parameter mix), as well as three versions of Procedure Append.
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of many of the subprograms defined
- --      in package Ada.Strings.Unbounded for use with unbounded strings.
- --      The test simulates how unbounded strings could be processed in a
- --      user environment, using the subprograms provided in this package.
- --
- --      This test, when taken in conjunction with tests CXA4010, CXA4011,
- --      CXA4030, and CXA4032 will constitute a test of all the functionality 
- --      contained in package Ada.Strings.Unbounded.  This test uses a variety 
- --      of the subprograms defined in the unbounded string package in ways 
- --      typical of common usage.
- --      
- --       
- -- CHANGE HISTORY:
- --      27 Feb 95   SAIC    Initial prerelease version.
- --      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Ada.Strings.Maps;
- with Ada.Strings.Unbounded;
- 
- procedure CXA4031 is
- begin
- 
-    Report.Test ("CXA4031", "Check that the subprograms defined in "        &
-                            "package Ada.Strings.Unbounded are available, " &
-                            "and that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package Unb renames Ada.Strings.Unbounded;
-       use Unb;
-       use Ada.Exceptions;
-  
-       subtype LC_Characters is Character range 'a'..'z';
- 
-       Null_String       : constant String := "";
-       TC_String         : constant String := "A Standard String";
- 
-       TC_Unb_String,
-       TC_New_Unb_String : Unb.Unbounded_String := Unb.Null_Unbounded_String;
- 
-    begin
- 
-       -- Function To_Unbounded_String (version with Length parameter)
-       -- returns an unbounded string that represents an uninitialized String
-       -- whose length is Length.
-       -- Note: Unbounded_String length can vary conceptually between 0 and
-       --       Natural'Last.
- 
-       if Unb.Length(Unb.To_Unbounded_String(Length => 10)) /= 10 or
-          Unb.Length(Unb.To_Unbounded_String(1))            /=  1 or
-          Unb.Length(Unb.To_Unbounded_String(0))            /=  0 or
-          Unb.Length(Unb."&"(Unb.To_Unbounded_String(Length => 10),
-                     Unb."&"(Unb.To_Unbounded_String(1),
-                             Unb.To_Unbounded_String(0) ))) /= 10+1+0
-       then
-          Report.Failed
-            ("Incorrect results from Function To_Unbounded_String with " &
-             "Length parameter");
-       end if;
- 
- 
-       -- Procedure Append (Unbounded - Unbounded)
-       -- Note: For each of the Append procedures, the resulting string 
-       --       represented by the Source parameter is given by the 
-       --       concatenation of the original value of Source and the value 
-       --       of New_Item.
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Sample string of length L");
-       TC_New_Unb_String := Unb.To_Unbounded_String(" and then some");
- 
-       Unb.Append(Source => TC_Unb_String, New_Item => TC_New_Unb_String);
-       
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_String("Sample string of length L and then some")
-       then
-          Report.Failed("Incorrect results from Procedure Append with " &
-                        "unbounded string parameters - 1");
-       end if;
- 
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Sample string of length L");
-       TC_New_Unb_String := Unb.Null_Unbounded_String;
- 
-       Unb.Append(TC_Unb_String, TC_New_Unb_String);
-       
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_String("Sample string of length L")
-       then
-          Report.Failed("Incorrect results from Procedure Append with " &
-                        "unbounded string parameters - 2");
-       end if;
- 
- 
-       TC_Unb_String := Unb.Null_Unbounded_String;
- 
-       Unb.Append(TC_Unb_String,
-                  Unb.To_Unbounded_String("New Unbounded String"));
-       
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_String("New Unbounded String")
-       then
-          Report.Failed("Incorrect results from Procedure Append with " &
-                        "unbounded string parameters - 3");
-       end if;
- 
-       
-       -- Procedure Append (Unbounded - String)
- 
-       TC_Unb_String := Unb.To_Unbounded_String("An Unbounded String and ");
- 
-       Unb.Append(Source => TC_Unb_String, New_Item => TC_String);
-       
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_String("An Unbounded String and A Standard String")
-       then
-          Report.Failed("Incorrect results from Procedure Append with " &
-                        "an unbounded string parameter and a string "   &
-                        "parameter - 1");
-       end if;
- 
- 
-       TC_Unb_String := Unb.To_Unbounded_String("An Unbounded String");
- 
-       Unb.Append(TC_Unb_String, New_Item => Null_String);
-       
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_String("An Unbounded String")
-       then
-          Report.Failed("Incorrect results from Procedure Append with " &
-                        "an unbounded string parameter and a string "   &
-                        "parameter - 2");
-       end if;
- 
- 
-       TC_Unb_String := Unb.Null_Unbounded_String;
- 
-       Unb.Append(TC_Unb_String, TC_String);
-       
-       if TC_Unb_String /= Unb.To_Unbounded_String("A Standard String") then
-          Report.Failed("Incorrect results from Procedure Append with " &
-                        "an unbounded string parameter and a string "   &
-                        "parameter - 3");
-       end if;
- 
- 
-       -- Procedure Append (Unbounded - Character)
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Lower Case = ");
- 
-       for i in LC_Characters'Range loop
-          Unb.Append(Source => TC_Unb_String, New_Item => LC_Characters(i));
-       end loop;
- 
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_String("Lower Case = abcdefghijklmnopqrstuvwxyz")
-       then
-          Report.Failed("Incorrect results from Procedure Append with "  &
-                        "an unbounded string parameter and a character " &
-                        "parameter - 1");
-       end if;        
- 
-       
-       TC_Unb_String := Unb.Null_Unbounded_String;
- 
-       Unb.Append(TC_Unb_String, New_Item => 'a');
-       
-       if TC_Unb_String /= Unb.To_Unbounded_String("a") then
-          Report.Failed("Incorrect results from Procedure Append with "  &
-                        "an unbounded string parameter and a character " &
-                        "parameter - 2");
-       end if;        
- 
- 
-       -- Function "="
- 
-       TC_Unb_String := Unb.To_Unbounded_String(TC_String);
- 
-       if not (TC_Unb_String = TC_String)                 or  -- (Unb_Str, Str)
-          not Unb."="("A Standard String", TC_Unb_String) or  -- (Str, Unb_Str)
-          not ((Unb.Null_Unbounded_String = "") and           -- (Unb_Str, Str)
-               ("Test String" =                               -- (Str, Unb_Str)
-                Unb.To_Unbounded_String("Test String")))
-       then
-          Report.Failed("Incorrect results from function ""="" with " &
-                        "string - unbounded string parameter combinations");
-       end if;
- 
- 
-       -- Function "<"
- 
-       if not ("Extra Space" < Unb.To_Unbounded_String("Extra Space ") and
-               Unb.To_Unbounded_String("tess") < "test"                and
-               Unb.To_Unbounded_String("best") < "test")                or
-          Unb.Null_Unbounded_String            < Null_String            or
-          " leading blank"  < Unb.To_Unbounded_String(" leading blank") or
-          "ending blank "   < Unb.To_Unbounded_String("ending blank ")  
-       then
-          Report.Failed("Incorrect results from function ""<"" with " &
-                        "string - unbounded string parameter combinations");
-       end if;
- 
- 
-       -- Function "<="
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Sample string");
- 
-       if TC_Unb_String                 <= "Sample strin" or  -- (Unb_Str, Str)
-          "sample string"               <= TC_Unb_String  or  -- (Str, Unb_Str)
-          not(Unb.Null_Unbounded_String <= "")            or  -- (Unb_Str, Str)
-          not("Sample string"           <= TC_Unb_String)     -- (Str, Unb_Str)
-       then
-          Report.Failed("Incorrect results from function ""<="" with " &
-                        "string - unbounded string parameter combinations");
-       end if;
- 
- 
-       -- Function ">"
- 
-       TC_Unb_String := Unb.To_Unbounded_String("A MUCH LONGER STRING");
- 
-       if not ("A much longer string" > TC_Unb_String                  and 
-               Unb.To_Unbounded_String(TC_String) > "A Standard Strin" and
-               "abcdefgh" > Unb.To_Unbounded_String("ABCDEFGH"))        or
-          Unb.Null_Unbounded_String > Null_String    
-       then
-          Report.Failed("Incorrect results from function "">"" with " &
-                        "string - unbounded string parameter combinations");
-       end if;
- 
- 
-       -- Function ">=" 
- 
-       TC_Unb_String := Unb.To_Unbounded_String(TC_String);
- 
-       if not (TC_Unb_String >= TC_String                       and 
-               Null_String   >= Unb.Null_Unbounded_String       and
-               "test"        >= Unb.To_Unbounded_String("tess") and  
-               Unb.To_Unbounded_String("Programming") >= "PROGRAMMING")
-       then
-          Report.Failed("Incorrect results from function "">="" with " &
-                        "string - unbounded string parameter combinations");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4031;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a	Thu Jan  1 00:00:00 1970
***************
*** 1,457 ****
- -- CXA4032.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that procedures defined in package Ada.Strings.Unbounded
- --      are available, and that they produce correct results. Specifically, 
- --      check the procedures Replace_Slice, Insert, Overwrite, Delete,
- --      Trim (2 versions), Head, and Tail.
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of many of the procedures defined
- --      in package Ada.Strings.Unbounded for use with unbounded strings.
- --      The test simulates how unbounded strings could be processed in a
- --      user environment, using the procedures provided in this package.
- --
- --      This test, when taken in conjunction with tests CXA4010, CXA4011,
- --      CXA4030, and CXA4031 will constitute a test of all the functionality 
- --      contained in package Ada.Strings.Unbounded.  This test uses a variety 
- --      of the procedures defined in the unbounded string package in ways 
- --      typical of common usage.
- --      
- --       
- -- CHANGE HISTORY:
- --      02 Mar 95   SAIC    Initial prerelease version.
- --
- --!
- 
- with Report;
- with Ada.Strings;
- with Ada.Strings.Maps;
- with Ada.Strings.Maps.Constants;
- with Ada.Strings.Unbounded;
- 
- procedure CXA4032 is
- begin
- 
-    Report.Test ("CXA4032", "Check that the subprograms defined in "        &
-                            "package Ada.Strings.Unbounded are available, " &
-                            "and that they produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package Unb renames Ada.Strings.Unbounded;
-       use Unb;
-       use Ada.Strings;
- 
-       TC_Null_String : constant String := "";
-       TC_String_5    : String(1..5)    := "ABCDE";
- 
-       TC_Unb_String  : Unb.Unbounded_String := 
-                          Unb.To_Unbounded_String("Test String");
- 
-    begin
- 
-       -- Procedure Replace_Slice
- 
-       begin                                           -- Low > Source'Last+1
-          Unb.Replace_Slice(Source => TC_Unb_String, 
-                            Low    => Unb.Length(TC_Unb_String) + 2,
-                            High   => Unb.Length(TC_Unb_String),
-                            By     => TC_String_5);
-          Report.Failed("Index_Error not raised by Replace_Slice when Low " &
-                        "> Source'Last+1");
-       exception
-          when Index_Error => null;  -- OK, expected exception.
-          when others      =>
-             Report.Failed("Unexpected exception raised by Replace_Slice" &
-                           "when Low > Source'Last+1");
-       end;
- 
-       -- High >= Low
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Replace_Slice(TC_Unb_String, 5, 5, TC_String_5);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("TestABCDEString") then
-          Report.Failed("Incorrect results from Replace_Slice - 1");
-       end if;
- 
-       Unb.Replace_Slice(TC_Unb_String, 1, 4, TC_String_5);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("ABCDEABCDEString") then
-          Report.Failed("Incorrect results from Replace_Slice - 2");
-       end if;
- 
-       Unb.Replace_Slice(TC_Unb_String, 
-                         11, 
-                         Unb.Length(TC_Unb_String),
-                         TC_Null_String);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("ABCDEABCDE") then
-          Report.Failed("Incorrect results from Replace_Slice - 3");
-       end if;
- 
-       -- High < Low   
- 
-       Unb.Replace_Slice(TC_Unb_String, Low => 4, High => 1, By => "xxx");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("ABCxxxDEABCDE") then
-          Report.Failed("Incorrect results from Replace_Slice - 4");
-       end if;
- 
-       Unb.Replace_Slice(TC_Unb_String, Low => 1, High => 0, By => "yyy");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("yyyABCxxxDEABCDE") then
-          Report.Failed("Incorrect results from Replace_Slice - 5");
-       end if;
- 
-       Unb.Replace_Slice(TC_Unb_String, 
-                         Unb.Length(TC_Unb_String) + 1, 
-                         Unb.Length(TC_Unb_String), 
-                         By => "zzz");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("yyyABCxxxDEABCDEzzz") then
-          Report.Failed("Incorrect results from Replace_Slice - 6");
-       end if;
- 
- 
-       -- Procedure Insert
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       begin                  -- Before not in Source'First..Source'Last + 1
-          Unb.Insert(Source   => TC_Unb_String,
-                     Before   => Unb.Length(TC_Unb_String) + 2,
-                     New_Item => TC_String_5);
-          Report.Failed("Index_Error not raised by Insert when Before " &
-                        "not in the range Source'First..Source'Last+1");
-       exception
-          when Index_Error => null;  -- OK, expected exception.
-          when others      =>
-             Report.Failed
-               ("Unexpected exception raised by Insert when Before not in " &
-                "the range Source'First..Source'Last+1");
-       end;
- 
-       Unb.Insert(TC_Unb_String, 1, "**");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("**Test String") then
-          Report.Failed("Incorrect results from Insert - 1");
-       end if;
- 
-       Unb.Insert(TC_Unb_String, Unb.Length(TC_Unb_String)+1, "**");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("**Test String**") then
-          Report.Failed("Incorrect results from Insert - 2");
-       end if;
- 
-       Unb.Insert(TC_Unb_String, 8, "---");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("**Test ---String**") then
-          Report.Failed("Incorrect results from Insert - 3");
-       end if;
- 
-       Unb.Insert(TC_Unb_String, 3, TC_Null_String);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("**Test ---String**") then
-          Report.Failed("Incorrect results from Insert - 4");
-       end if;
- 
- 
-       -- Procedure Overwrite
- 
-       begin                -- Position not in Source'First..Source'Last + 1
-          Unb.Overwrite(Source   => TC_Unb_String,
-                        Position => Unb.Length(TC_Unb_String) + 2,
-                        New_Item => TC_String_5);
-          Report.Failed("Index_Error not raised by Overwrite when Position " &
-                        "not in the range Source'First..Source'Last+1");
-       exception
-          when Index_Error => null;  -- OK, expected exception.
-          when others      =>
-             Report.Failed
-               ("Unexpected exception raised by Overwrite when Position not " &
-                "in the range Source'First..Source'Last+1");
-       end;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Overwrite(Source   => TC_Unb_String,
-                     Position => 1,
-                     New_Item => "XXXX");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String") then
-          Report.Failed("Incorrect results from Overwrite - 1");
-       end if;
- 
-       Unb.Overwrite(TC_Unb_String, Unb.Length(TC_Unb_String)+1, "**");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String**") then
-          Report.Failed("Incorrect results from Overwrite - 2");
-       end if;
- 
-       Unb.Overwrite(TC_Unb_String, 3, TC_Null_String);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String**") then
-          Report.Failed("Incorrect results from Overwrite - 3");
-       end if;
- 
-       Unb.Overwrite(TC_Unb_String, 1, "abcdefghijklmn");
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("abcdefghijklmn") then
-          Report.Failed("Incorrect results from Overwrite - 4");
-       end if;
- 
- 
-       -- Procedure Delete
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       -- From > Through  (No change to Source)
- 
-       Unb.Delete(Source  => TC_Unb_String, 
-                  From    => Unb.Length(TC_Unb_String),
-                  Through => Unb.Length(TC_Unb_String)-1);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
-          Report.Failed("Incorrect results from Delete - 1");
-       end if;
- 
-       Unb.Delete(TC_Unb_String, 1, 0);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
-          Report.Failed("Incorrect results from Delete - 2");
-       end if;
- 
-       -- From <= Through
- 
-       Unb.Delete(TC_Unb_String, 1, 5);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("String") then
-          Report.Failed("Incorrect results from Delete - 3");
-       end if;
- 
-       Unb.Delete(TC_Unb_String, 3, 3);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Sting") then
-          Report.Failed("Incorrect results from Delete - 4");
-       end if;
- 
- 
-       -- Procedure Trim 
- 
-       TC_Unb_String := Unb.To_Unbounded_String("No Spaces");
- 
-       Unb.Trim(Source => TC_Unb_String, Side => Ada.Strings.Both);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("No Spaces") then
-          Report.Failed("Incorrect results from Trim - 1");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("   Leading Spaces   ");
- 
-       Unb.Trim(TC_Unb_String, Ada.Strings.Left);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Leading Spaces   ") then
-          Report.Failed("Incorrect results from Trim - 2");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("   Ending Spaces   ");
- 
-       Unb.Trim(TC_Unb_String, Ada.Strings.Right);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("   Ending Spaces") then
-          Report.Failed("Incorrect results from Trim - 3");
-       end if;
- 
-       TC_Unb_String := 
-         Unb.To_Unbounded_String("    Spaces   on  both  ends     ");
- 
-       Unb.Trim(TC_Unb_String, Ada.Strings.Both);
- 
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_String("Spaces   on  both  ends") 
-       then
-          Report.Failed("Incorrect results from Trim - 4");
-       end if;
- 
- 
-       -- Procedure Trim (with Character Set parameters)
- 
-       TC_Unb_String := Unb.To_Unbounded_String("lowerCASEletters");
- 
-       Unb.Trim(Source => TC_Unb_String,
-                Left   => Ada.Strings.Maps.Constants.Lower_Set,
-                Right  => Ada.Strings.Maps.Constants.Lower_Set);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("CASE") then
-          Report.Failed("Incorrect results from Trim with Sets - 1");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("lowerCASEletters");
- 
-       Unb.Trim(TC_Unb_String, 
-                Ada.Strings.Maps.Constants.Upper_Set,
-                Ada.Strings.Maps.Constants.Upper_Set);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("lowerCASEletters") then
-          Report.Failed("Incorrect results from Trim with Sets - 2");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("012abcdefghGFEDCBA789ab");
- 
-       Unb.Trim(TC_Unb_String,
-                Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set,
-                Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set);
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("ghG") then
-          Report.Failed("Incorrect results from Trim with Sets - 3");
-       end if;
- 
- 
-       -- Procedure Head
- 
-       -- Count <= Source'Length
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Head(Source => TC_Unb_String,
-                Count  => 0,
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.Null_Unbounded_String then
-          Report.Failed("Incorrect results from Head - 1");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Head(Source => TC_Unb_String,
-                Count  => 4,
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Test") then
-          Report.Failed("Incorrect results from Head - 2");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Head(Source => TC_Unb_String,
-                Count  => Unb.Length(TC_Unb_String),
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
-          Report.Failed("Incorrect results from Head - 3");
-       end if;
- 
-       -- Count > Source'Length
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Head(Source => TC_Unb_String,
-                Count  => Unb.Length(TC_Unb_String) + 4,
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Test String****") then
-          Report.Failed("Incorrect results from Head - 4");
-       end if;
- 
-       TC_Unb_String := Unb.Null_Unbounded_String;
- 
-       Unb.Head(Source => TC_Unb_String,
-                Count  => Unb.Length(TC_Unb_String) + 3,
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("***") then
-          Report.Failed("Incorrect results from Head - 5");
-       end if;
- 
- 
-       -- Procedure Tail
- 
-       -- Count <= Source'Length
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Tail(Source => TC_Unb_String,
-                Count  => 0,
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.Null_Unbounded_String then
-          Report.Failed("Incorrect results from Tail - 1");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Tail(Source => TC_Unb_String,
-                Count  => 6,
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("String") then
-          Report.Failed("Incorrect results from Tail - 2");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Tail(Source => TC_Unb_String,
-                Count  => Unb.Length(TC_Unb_String),
-                Pad    => '*');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
-          Report.Failed("Incorrect results from Tail - 3");
-       end if;
- 
-       -- Count > Source'Length
- 
-       TC_Unb_String := Unb.To_Unbounded_String("Test String");
- 
-       Unb.Tail(Source => TC_Unb_String,
-                Count  => Unb.Length(TC_Unb_String) + 5,
-                Pad    => 'x');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("xxxxxTest String") then
-          Report.Failed("Incorrect results from Tail - 4");
-       end if;
- 
-       TC_Unb_String := Unb.Null_Unbounded_String;
- 
-       Unb.Tail(Source => TC_Unb_String,
-                Count  => Unb.Length(TC_Unb_String) + 3,
-                Pad    => 'X');
- 
-       if TC_Unb_String /= Unb.To_Unbounded_String("XXX") then
-          Report.Failed("Incorrect results from Tail - 5");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4032;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a	Thu Jan  1 00:00:00 1970
***************
*** 1,405 ****
- -- CXA4033.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functionality found in packages Ada.Strings.Wide_Maps,
- --      Ada.Strings.Wide_Unbounded, and Ada.Strings.Wide_Maps.Wide_Constants 
- --      is available and produces correct results.
- --
- -- TEST DESCRIPTION:
- --      This test tests the subprograms found in the
- --      Ada.Strings.Wide_Unbounded package.  It is based on the tests 
- --      CXA4030-32, which are tests for the complementary "non-wide" 
- --      packages.
- --      
- --      The functions found in CXA4033_0 provide mapping capability, when
- --      used in conjunction with Wide_Character_Mapping_Function objects.
- --
- --       
- -- CHANGE HISTORY:
- --      23 Jun 95   SAIC    Initial prerelease version.
- --      24 Feb 97   PWB.CTA Removed attempt to create wide string of length
- --                          Natural'Last
- --!
- 
- package CXA4033_0 is
-    -- Functions used to supply mapping capability.
-    function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
-    function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
- end CXA4033_0;
- 
- with Ada.Characters.Handling;
- package body CXA4033_0 is
-       -- Function Map_To_Lower_Case will return the lower case form of 
-       -- Wide_Characters in the range 'A'..'Z' only, and return the input
-       -- wide_character otherwise.
- 
-       function Map_To_Lower_Case (From : Wide_Character) 
-          return Wide_Character is
-       begin
-          return Ada.Characters.Handling.To_Wide_Character(
-                   Ada.Characters.Handling.To_Lower(
-                     Ada.Characters.Handling.To_Character(From)));
-       end Map_To_Lower_Case;
- 
-       -- Function Map_To_Upper_Case will return the upper case form of 
-       -- Wide_Characters in the range 'a'..'z', or whose position is in one
-       -- of the ranges 223..246 or 248..255, provided the wide_character has
-       -- an upper case form.               
- 
-       function Map_To_Upper_Case (From : Wide_Character) 
-         return Wide_Character is
-       begin
-          return Ada.Characters.Handling.To_Wide_Character(
-                   Ada.Characters.Handling.To_Upper(
-                     Ada.Characters.Handling.To_Character(From)));
-       end Map_To_Upper_Case;
- 
- end CXA4033_0;
- 
- 
- with CXA4033_0;
- with Report;
- with Ada.Characters.Handling;
- with Ada.Characters.Latin_1;
- with Ada.Strings;
- with Ada.Strings.Wide_Maps;
- with Ada.Strings.Wide_Maps.Wide_Constants;
- with Ada.Strings.Wide_Fixed;
- with Ada.Strings.Wide_Unbounded;
- 
- procedure CXA4033 is
- begin
-    Report.Test ("CXA4033", 
-                 "Check that subprograms defined in the package " &
-                 "Ada.Strings.Wide_Unbounded produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ACL1 renames Ada.Characters.Latin_1;
-       package Unb  renames Ada.Strings.Wide_Unbounded;
- 
-       subtype LC_Characters is Wide_Character range 'a'..'z';
- 
-       use Ada.Characters, Ada.Strings, Unb;
-       use type Wide_Maps.Wide_Character_Set; 
- 
-       TC_String      : constant Wide_String := "A Standard String";
- 
-       String_20      : Wide_String(1..20)    := "ABCDEFGHIJKLMNOPQRST";
-       String_40      : Wide_String(1..40)    := "abcdefghijklmnopqrst" & 
-                                                 String_20;
-       String_80      : Wide_String(1..80)    := String_40 & String_40;
-       TC_String_5    : Wide_String(1..5)     := "ABCDE";
-       TC_Unb_String  : Unbounded_Wide_String := Null_Unbounded_Wide_String;
- 
-       -- The following strings are used in examination of the Translation
-       -- subprograms.
-       New_Character_String : Wide_String(1..10) :=
-         Handling.To_Wide_String( 
-           ACL1.LC_A_Grave          & ACL1.LC_A_Ring  & ACL1.LC_AE_Diphthong &
-           ACL1.LC_C_Cedilla        & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
-           ACL1.LC_Icelandic_Eth    & ACL1.LC_N_Tilde & 
-           ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn);  
-  
-       TC_New_Character_String : Wide_String(1..10) :=
-         Handling.To_Wide_String(
-           ACL1.UC_A_Grave          & ACL1.UC_A_Ring  & ACL1.UC_AE_Diphthong &
-           ACL1.UC_C_Cedilla        & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
-           ACL1.UC_Icelandic_Eth    & ACL1.UC_N_Tilde &
-           ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn);  
- 
-       New_UB_Character_String : Unbounded_Wide_String :=
-                          To_Unbounded_Wide_String(New_Character_String);
- 
-       TC_New_UB_Character_String : Unbounded_Wide_String :=
-                          To_Unbounded_Wide_String(TC_New_Character_String);
-                      
-       -- Access objects that will be provided as parameters to the 
-       -- subprograms.
-       Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
-                                 CXA4033_0.Map_To_Lower_Case'Access;
-       Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
-                                 CXA4033_0.Map_To_Upper_Case'Access;
- 
-    begin
- 
-       -- Testing functionality found in Package Ada.Strings.Wide_Unbounded.
-       -- 
-       -- Function Index.
- 
-       if Index(To_Unbounded_Wide_String("AAABBBaaabbb"),
-                "aabb",
-                Mapping => Map_To_Lower_Case_Ptr)                   /=  2 or
-          Index(To_Unbounded_Wide_String("Case of a Mixed Case String"), 
-                "case", 
-                Ada.Strings.Backward,
-                Map_To_Lower_Case_Ptr)                              /= 17 
-       then
-          Report.Failed("Incorrect results from Function Index, " &
-                        "using a Wide Character Mapping Function parameter");
-       end if;
- 
-       -- Function Count.
-       if Count(Source  => To_Unbounded_Wide_String("ABABABA"),       
-                Pattern => "aba",
-                Mapping => Map_To_Lower_Case_Ptr)                      /= 2 or
-          Count(Null_Unbounded_Wide_String, "mat", Map_To_Upper_Case_Ptr) /= 0
-       then
-          Report.Failed("Incorrect results from Function Count, using " &
-                        "a Character Mapping Function parameter");
-       end if;
- 
-       -- Function Translate.
-       if Translate(To_Unbounded_Wide_String("A Sample Mixed Case String"),
-                    Mapping => Map_To_Lower_Case_Ptr)               /= 
-          To_Unbounded_Wide_String("a sample mixed case string")      or
-          Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr) /= 
-          TC_New_UB_Character_String
-       then
-          Report.Failed("Incorrect results from Function Translate, " &
-                        "using a Character Mapping Function parameter");
-       end if;
- 
-       -- Procedure Translate.
-       declare
-          use Ada.Characters.Handling;
-          Str : Unbounded_Wide_String := 
-                  To_Unbounded_Wide_String("AN ALL UPPER CASE STRING");
-       begin
-          Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr);
-          if Str /= To_Unbounded_Wide_String("an all upper case string") then
-             Report.Failed("Incorrect result from Procedure Translate 1");
-          end if;
- 
-          Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr);
-          if New_UB_Character_String /= TC_New_UB_Character_String then
-             Report.Failed("Incorrect result from Procedure Translate 2");
-          end if;
-       end;
- 
-       -- Function To_Unbounded_Wide_String (version with Length parameter)
-       if Length(To_Unbounded_Wide_String(Length => 10)) /= 10 or
-          Length(To_Unbounded_Wide_String(0))            /=  0 or
-          Length( To_Unbounded_Wide_String(10) &
-                  To_Unbounded_Wide_String(1) &
-                  To_Unbounded_Wide_String(0) ) /= 10 + 1 + 0
-       then
-          Report.Failed
-            ("Incorrect results from Function To_Unbounded_Wide_String " &
-             "with Length parameter");
-       end if;
- 
-       -- Procedure Append (Wide_Unbounded - Wide_Unbounded)
-       TC_Unb_String := Null_Unbounded_Wide_String;
-       Append(TC_Unb_String, To_Unbounded_Wide_String("New Unbounded String"));
-       if TC_Unb_String /= To_Unbounded_Wide_String("New Unbounded String")
-       then
-          Report.Failed("Incorrect results from Procedure Append with " &
-                        "unbounded wide string parameters");
-       end if;
- 
-       
-       -- Procedure Append (Wide_Unbounded - Wide_String)
-       TC_Unb_String := To_Unbounded_Wide_String("An Unbounded String and ");
-       Append(Source => TC_Unb_String, New_Item => TC_String);
-       if TC_Unb_String /= 
-          To_Unbounded_Wide_String("An Unbounded String and A Standard String")
-       then
-          Report.Failed("Incorrect results from Procedure Append with "  &
-                        "an unbounded wide string parameter and a wide " &
-                        "string parameter");
-       end if;
- 
-       -- Procedure Append (Wide_Unbounded - Wide_Character)
-       TC_Unb_String := To_Unbounded_Wide_String("Lower Case = ");
-       for i in LC_Characters'Range loop
-          Append(Source => TC_Unb_String, New_Item => LC_Characters(i));
-       end loop;
-       if TC_Unb_String /= 
-          Unb.To_Unbounded_Wide_String
-            ("Lower Case = abcdefghijklmnopqrstuvwxyz")
-       then
-          Report.Failed("Incorrect results from Procedure Append with "  &
-                        "an unbounded wide string parameter and a wide " &
-                        "character parameter");
-       end if;        
- 
-       -- Function "="
-       TC_Unb_String := To_Unbounded_Wide_String(TC_String);
-       if not (TC_Unb_String = TC_String)             or 
-          not "="("A Standard String", TC_Unb_String) or 
-          not ((Null_Unbounded_Wide_String = "") and          
-               ("Test String" = To_Unbounded_Wide_String("Test String")))
-       then
-          Report.Failed("Incorrect results from Function ""="" with " &
-                        "wide_string - unbounded wide string parameters");
-       end if;
- 
-       -- Function "<"
-       if not ("Extra Space" < To_Unbounded_Wide_String("Extra Space ") and
-               To_Unbounded_Wide_String("tess") < "test"                and
-               To_Unbounded_Wide_String("best") < "test")                
-       then
-          Report.Failed("Incorrect results from Function ""<"" with " &
-                        "wide string - unbounded wide string parameters");
-       end if;
- 
-       -- Function "<="
-       TC_Unb_String := To_Unbounded_Wide_String("Sample string");
-       if TC_Unb_String                  <= "Sample strin" or 
-          not("Sample string"            <= TC_Unb_String)
-       then
-          Report.Failed("Incorrect results from Function ""<="" with " &
-                        "wide string - unbounded wide string parameters");
-       end if;
- 
-       -- Function ">"
-       TC_Unb_String := To_Unbounded_Wide_String("A MUCH LONGER STRING");
-       if not ("A much longer string" > TC_Unb_String                   and 
-               To_Unbounded_Wide_String(TC_String) > "A Standard Strin" and
-               "abcdefgh" > To_Unbounded_Wide_String("ABCDEFGH"))        
-       then
-          Report.Failed("Incorrect results from Function "">"" with " &
-                        "wide string - unbounded wide string parameters");
-       end if;
- 
-       -- Function ">=" 
-       TC_Unb_String := To_Unbounded_Wide_String(TC_String);
-       if not (TC_Unb_String >= TC_String                        and 
-               "test"        >= To_Unbounded_Wide_String("tess") and  
-               To_Unbounded_Wide_String("Programming") >= "PROGRAMMING")
-       then
-          Report.Failed("Incorrect results from Function "">="" with " &
-                        "wide string - unbounded wide string parameters");
-       end if;
- 
-       -- Procedure Replace_Slice
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Replace_Slice(TC_Unb_String, 5, 5, TC_String_5);
-       if TC_Unb_String /= To_Unbounded_Wide_String("TestABCDEString") then
-          Report.Failed("Incorrect results from Replace_Slice - 1");
-       end if;
- 
-       Replace_Slice(TC_Unb_String, 1, 4, TC_String_5);
-       if TC_Unb_String /= To_Unbounded_Wide_String("ABCDEABCDEString") then
-          Report.Failed("Incorrect results from Replace_Slice - 2");
-       end if;
- 
-       -- Procedure Insert
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Insert(TC_Unb_String, 1, "**");
-       if TC_Unb_String /= To_Unbounded_Wide_String("**Test String") then
-          Report.Failed("Incorrect results from Procedure Insert - 1");
-       end if;
- 
-       Insert(TC_Unb_String, Length(TC_Unb_String)+1, "**");
-       if TC_Unb_String /= To_Unbounded_Wide_String("**Test String**") then
-          Report.Failed("Incorrect results from Procedure Insert - 2");
-       end if;
- 
-       -- Procedure Overwrite
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Overwrite(TC_Unb_String, 1, New_Item => "XXXX");
-       if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String") then
-          Report.Failed("Incorrect results from Procedure Overwrite - 1");
-       end if;
- 
-       Overwrite(TC_Unb_String, Length(TC_Unb_String)+1, "**");
-       if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String**") then
-          Report.Failed("Incorrect results from Procedure Overwrite - 2");
-       end if;
- 
-       -- Procedure Delete
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Delete(TC_Unb_String, 1, 0);
-       if TC_Unb_String /= To_Unbounded_Wide_String("Test String") then
-          Report.Failed("Incorrect results from Procedure Delete - 1");
-       end if;
- 
-       Delete(TC_Unb_String, 1, 5);
-       if TC_Unb_String /= To_Unbounded_Wide_String("String") then
-          Report.Failed("Incorrect results from Procedure Delete - 2");
-       end if;
- 
-       -- Procedure Trim 
-       TC_Unb_String := To_Unbounded_Wide_String("   Leading Spaces   ");
-       Trim(TC_Unb_String, Ada.Strings.Left);
-       if TC_Unb_String /= To_Unbounded_Wide_String("Leading Spaces   ") then
-          Report.Failed("Incorrect results from Procedure Trim - 1");
-       end if;
- 
-       TC_Unb_String := 
-         To_Unbounded_Wide_String("    Spaces   on  both  ends     ");
-       Trim(TC_Unb_String, Ada.Strings.Both);
-       if TC_Unb_String /= 
-          To_Unbounded_Wide_String("Spaces   on  both  ends") 
-       then
-          Report.Failed("Incorrect results from Procedure Trim - 2");
-       end if;
- 
-       -- Procedure Trim (with Wide_Character_Set parameters)
-       TC_Unb_String := To_Unbounded_Wide_String("012abcdefghGFEDCBA789ab");
-       Trim(TC_Unb_String,
-            Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set,
-            Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set);
-       if TC_Unb_String /= To_Unbounded_Wide_String("ghG") then
-          Report.Failed("Incorrect results from Procedure Trim with Sets");
-       end if;
- 
-       -- Procedure Head
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Head(Source => TC_Unb_String, Count => 0, Pad => '*');
-       if TC_Unb_String /= Null_Unbounded_Wide_String then
-          Report.Failed("Incorrect results from Procedure Head - 1");
-       end if;
- 
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Head(Source => TC_Unb_String, Count => 4, Pad => '*');
-       if TC_Unb_String /= To_Unbounded_Wide_String("Test") then
-          Report.Failed("Incorrect results from Procedure Head - 2");
-       end if;
- 
-       -- Procedure Tail
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Tail(Source => TC_Unb_String, Count  => 0, Pad => '*');
-       if TC_Unb_String /= Null_Unbounded_Wide_String then
-          Report.Failed("Incorrect results from Procedure Tail - 1");
-       end if;
- 
-       TC_Unb_String := To_Unbounded_Wide_String("Test String");
-       Tail(TC_Unb_String, Length(TC_Unb_String) + 5, 'x');
-       if TC_Unb_String /= To_Unbounded_Wide_String("xxxxxTest String") then
-          Report.Failed("Incorrect results from Procedure Tail - 2");
-       end if;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA4033;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a	Thu Jan  1 00:00:00 1970
***************
*** 1,281 ****
- -- CXA4034.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that Ada.Strings.Bounded.Slice raises Index_Error if
- --    High > Length (Source) or Low > Length (Source) + 1.
- --    (Defect Report 8652/0049).
- --
- --    Check that Ada.Strings.Wide_Bounded.Slice raises Index_Error if
- --    High > Length (Source) or Low > Length (Source) + 1.
- --
- -- CHANGE HISTORY:
- --    12 FEB 2001   PHL   Initial version
- --    14 MAR 2001   RLB   Added Wide_Bounded subtest.
- --
- --!
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Ada.Strings.Bounded;
- with Ada.Strings.Wide_Bounded;
- use Ada.Strings;
- with Report;
- use Report;
- procedure CXA4034 is
- 
-     package Bs is new Ada.Strings.Bounded.Generic_Bounded_Length (40);
- 
-     package WBs is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length (32);
- 
-     Source : String (Ident_Int (1) .. Ident_Int (30));
- 
-     Wide_Source : Wide_String (Ident_Int (1) .. Ident_Int (24));
- 
-     X : Bs.Bounded_String;
- 
-     WX : WBs.Bounded_Wide_String;
- 
- begin
-     Test ("CXA4034",
-           "Check that Slice raises Index_Error if either Low or High is " &
-              "greater than the Length(Source) for Ada.Strings.Bounded and " &
-              "Ada.Strings.Wide_Bounded");
- 
-     -- Fill Source with "ABC..."
-     for I in Source'Range loop
-         Source (I) := Ident_Char (Character'Val (I +
-                         Character'Pos ('A') - Source'First));
-     end loop;
-     -- and W with "ABC..."
-     for I in Wide_Source'Range loop
-         Wide_Source (I) := Ident_Wide_Char (Wide_Character'Val (I +
-                          Wide_Character'Pos ('A') - Wide_Source'First));
-     end loop;
- 
-     X := Bs.To_Bounded_String (Source);
- 
-     begin
-         declare
-             S : constant String :=
-                Bs.Slice (X, Low => Ident_Int (28), High => Ident_Int (41));
-         begin
-             Failed ("No exception raised by Slice - 1");
-             if S = Source then
-                 Comment ("Don't optimize S");
-             end if;
-         end;
-     exception
-         when Index_Error =>
-             null; -- Expected exception.
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 1");
-     end;
- 
-     begin
-         declare
-             S : constant String :=
-                Bs.Slice (X, Low => Ident_Int (8), High => Ident_Int (31));
-         begin
-             Failed ("No exception raised by Slice - 2");
-             if S = Source then
-                 Comment ("Don't optimize S");
-             end if;
-         end;
-     exception
-         when Index_Error =>
-             null; -- Expected exception.
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 2");
-     end;
- 
-     begin
-         declare
-             S : constant String :=
-                Bs.Slice (X, Low => Ident_Int (15), High => Ident_Int (30));
-         begin
-             if S /= Source(15..30) then
-                 Failed ("Wrong result - 3");
-             end if;
-         end;
-     exception
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 3");
-     end;
- 
-     begin
-         declare
-             S : constant String :=
-                Bs.Slice (X, Low => Ident_Int (42), High => Ident_Int (28));
-         begin
-             Failed ("No exception raised by Slice - 4");
-             if S = Source then
-                 Comment ("Don't optimize S");
-             end if;
-         end;
-     exception
-         when Index_Error =>
-             null; -- Expected exception.
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 4");
-     end;
- 
-     begin
-         declare
-             S : constant String :=
-                Bs.Slice (X, Low => Ident_Int (31), High => Ident_Int (28));
-         begin
-             if S /= "" then
-                 Failed ("Wrong result - 5");
-             end if;
-         end;
-     exception
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 5");
-     end;
- 
-     begin
-         declare
-             S : constant String :=
-                Bs.Slice (X, Low => Ident_Int (30), High => Ident_Int (30));
-         begin
-             if S /= Source(30..30) then
-                 Failed ("Wrong result - 6");
-             end if;
-         end;
-     exception
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 6");
-     end;
- 
-     WX := WBs.To_Bounded_Wide_String (Wide_Source);
- 
-     begin
-         declare
-             W : constant Wide_String :=
-                WBs.Slice (WX, Low => Ident_Int (21), High => Ident_Int (33));
-         begin
-             Failed ("No exception raised by Slice - 7");
-             if W = Wide_Source then
-                 Comment ("Don't optimize W");
-             end if;
-         end;
-     exception
-         when Index_Error =>
-             null; -- Expected exception.
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 7");
-     end;
- 
-     begin
-         declare
-             W : constant Wide_String :=
-                WBs.Slice (WX, Low => Ident_Int (8), High => Ident_Int (25));
-         begin
-             Failed ("No exception raised by Slice - 8");
-             if W = Wide_Source then
-                 Comment ("Don't optimize W");
-             end if;
-         end;
-     exception
-         when Index_Error =>
-             null; -- Expected exception.
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 8");
-     end;
- 
-     begin
-         declare
-             W : constant Wide_String :=
-                WBs.Slice (WX, Low => Ident_Int (15), High => Ident_Int (24));
-         begin
-             if W /= Wide_Source(15..24) then
-                 Failed ("Wrong result - 8");
-             end if;
-         end;
-     exception
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 9");
-     end;
- 
-     begin
-         declare
-             W : constant Wide_String :=
-                WBs.Slice (WX, Low => Ident_Int (36), High => Ident_Int (20));
-         begin
-             Failed ("No exception raised by Slice - 10");
-             if W = Wide_Source then
-                 Comment ("Don't optimize W");
-             end if;
-         end;
-     exception
-         when Index_Error =>
-             null; -- Expected exception.
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 10");
-     end;
- 
-     begin
-         declare
-             W : constant Wide_String :=
-                WBs.Slice (WX, Low => Ident_Int (25), High => Ident_Int (21));
-         begin
-             if W /= "" then
-                 Failed ("Wrong result - 11");
-             end if;
-         end;
-     exception
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 11");
-     end;
- 
-     begin
-         declare
-             W : constant Wide_String :=
-                WBs.Slice (WX, Low => Ident_Int (24), High => Ident_Int (24));
-         begin
-             if W /= Wide_Source(24..24) then
-                 Failed ("Wrong result - 12");
-             end if;
-         end;
-     exception
-         when E: others =>
-             Failed ("Exception raised - " & Exception_Name (E) &
-                     " - " & Exception_Message (E) & " - 12");
-     end;
- 
-     Result;
- end CXA4034;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,471 ****
- -- CXA5011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for both Float_Random and Discrete_Random packages,
- --      the following are true:
- --      1) two objects of type Generator are initialized to the same state.
- --      2) when the Function Reset is used to reset two generators
- --         to different time-dependent states, the resulting random values
- --         from each generator are different.
- --      3) when the Function Reset uses the same integer initiator
- --         to reset two generators to the same state, the resulting random
- --         values from each generator are identical.
- --      4) when the Function Reset uses different integer initiator
- --         values to reset two generators, the resulting random numbers are
- --         different.
- --
- -- TEST DESCRIPTION:
- --      This test evaluates components of the Ada.Numerics.Float_Random and
- --      Ada.Numerics.Discrete_Random packages.
- --      This test checks to see that objects of type Generator are initialized
- --      to the same state. In addition, the functionality of Function Reset is
- --      validated.
- --      For each of the objectives above, evaluation of the various generators
- --      is performed using each of the following techniques. When the states of
- --      two generators are to be compared, each state is saved, then
- --      transformed to a bounded-string variable.  The bounded-strings can
- --      then be compared for equality.  In this case, matching bounded-strings
- --      are evidence that the states of two generators are the same.
- --      In addition, two generators are compared by evaluating a series of
- --      random numbers they produce.  A matching series of random numbers
- --      implies that the generators were in the same state prior to producing
- --      the numbers.
- --
- --
- -- CHANGE HISTORY:
- --      20 Apr 95   SAIC    Initial prerelease version.
- --      07 Jul 95   SAIC    Incorporated reviewer comments/suggestions.
- --      22 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      17 Aug 96   SAIC    Deleted Subtest #2.
- --      09 Feb 01   RLB     Repaired to work on implementations with a 16-bit
- --                          Integer.
- 
- --!
- 
- with Ada.Exceptions;
- with Ada.Numerics.Float_Random;
- with Ada.Numerics.Discrete_Random;
- with Ada.Strings.Bounded;
- with ImpDef;
- with Report;
- 
- procedure CXA5011 is
- begin
- 
-    Report.Test ("CXA5011", "Check the effect of Function Reset on the " &
-                            "state of random number generators");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Ada.Numerics;
-       use Ada.Strings.Bounded;
- 
-       -- Declare an modular subtype, and use it to instantiate the discrete
-       -- random number generator generic package.
- 
-       type    Discrete_Range   is mod 2**(Integer'Size-1);
-       package Discrete_Package is new Discrete_Random(Discrete_Range);
- 
-       -- Declaration of random number generator objects.
- 
-       Discrete_Generator_1,
-       Discrete_Generator_2  : Discrete_Package.Generator;
-       Float_Generator_1,
-       Float_Generator_2     : Float_Random.Generator;
- 
-       -- Declaration of bounded string packages instantiated with the
-       -- value of Max_Image_Width constant from each random number generator
-       -- package, and bounded string variables used to hold the image of
-       -- random number generator states.
- 
-       package Discrete_String_Pack is
-         new Generic_Bounded_Length(Discrete_Package.Max_Image_Width);
- 
-       package Float_String_Pack is
-         new Generic_Bounded_Length(Float_Random.Max_Image_Width);
- 
-       use Discrete_String_Pack, Float_String_Pack;
- 
-       TC_Seed                  : Integer;
-       TC_Max_Loop_Count        : constant Natural := 1000;
-       Allowed_Matches          : constant Natural := 2;
-       --
-       -- In a sequence of TC_Max_Loop_Count random numbers that should
-       -- not match, some may match by chance.  Up to Allowed_Matches
-       -- numbers may match before the test is considered to fail.
-       --
- 
- 
-       procedure Check_Float_State (Gen_1, Gen_2 : Float_Random.Generator;
-                                    Sub_Test     : Integer;
-                                    States_Should_Match : Boolean) is
- 
-          use type Float_Random.State;
- 
-          State_1,
-          State_2         : Float_Random.State;
- 
-          State_String_1,
-          State_String_2  : Float_String_Pack.Bounded_String :=
-                              Float_String_Pack.Null_Bounded_String;
-       begin
- 
-          Float_Random.Save(Gen => Gen_1, To_State => State_1);
-          Float_Random.Save(Gen_2, State_2);
- 
-          State_String_1 :=
-            Float_String_Pack.To_Bounded_String(Source =>
-              Float_Random.Image(Of_State => State_1));
- 
-          State_String_2 :=
-            Float_String_Pack.To_Bounded_String(Float_Random.Image(State_2));
- 
-          case States_Should_Match is
-             when True  =>
-                if State_1 /= State_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test)    &
-                                 "   State values from Float generators " &
-                                 "are not the same");
-                end if;
-                if State_String_1 /= State_String_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test)     &
-                                 "   State strings from Float generators " &
-                                 "are not the same");
-                end if;
-             when False =>
-                if State_1 = State_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test)    &
-                                 "   State values from Float generators " &
-                                 "are the same");
-                end if;
-                if State_String_1 = State_String_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test)     &
-                                 "   State strings from Float generators " &
-                                 "are the same");
-                end if;
-          end case;
-       end Check_Float_State;
- 
- 
- 
-       procedure Check_Discrete_State (Gen_1,
-                                       Gen_2    : Discrete_Package.Generator;
-                                       Sub_Test : Integer;
-                                       States_Should_Match : Boolean) is
- 
-          use type Discrete_Package.State;
- 
-          State_1, State_2  : Discrete_Package.State;
- 
-          State_String_1,
-          State_String_2    : Discrete_String_Pack.Bounded_String :=
-                                Discrete_String_Pack.Null_Bounded_String;
-       begin
- 
-          Discrete_Package.Save(Gen      => Gen_1,
-                                To_State => State_1);
-          Discrete_Package.Save(Gen_2, To_State => State_2);
- 
-          State_String_1 :=
-            Discrete_String_Pack.To_Bounded_String(Source =>
-              Discrete_Package.Image(Of_State => State_1));
- 
-          State_String_2 :=
-            Discrete_String_Pack.To_Bounded_String(Source =>
-              Discrete_Package.Image(Of_State => State_2));
- 
-          case States_Should_Match is
-             when True  =>
-                if State_1 /= State_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
-                                 "   State values from Discrete "      &
-                                 "generators are not the same");
-                end if;
-                if State_String_1 /= State_String_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
-                                 "   State strings from Discrete "     &
-                                 "generators are not the same");
-                end if;
-             when False =>
-                if State_1 = State_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
-                                 "   State values from Discrete "      &
-                                 "generators are the same");
-                end if;
-                if State_String_1 = State_String_2 then
-                   Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
-                                 "   State strings from Discrete "     &
-                                 "generators are the same");
-                end if;
-          end case;
-       end Check_Discrete_State;
- 
- 
- 
-       procedure Check_Float_Values (Gen_1, Gen_2 : Float_Random.Generator;
-                                     Sub_Test     : Integer;
-                                     Values_Should_Match : Boolean) is
-          Matches         : Natural := 0;
-          Check_Failed    : Boolean := False;
-       begin
-          case Values_Should_Match is
-             when True  =>
-                for i in 1..TC_Max_Loop_Count loop
-                   if Float_Random.Random(Gen_1) /= Float_Random.Random(Gen_2)
-                   then
-                      Check_Failed := True;
-                      exit;
-                   end if;
-                end loop;
-                if Check_Failed then
-                   Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
-                                 "   Random numbers from Float generators " &
-                                 "Failed check");
-                end if;
-             when False =>
-                for i in 1..TC_Max_Loop_Count loop
-                   if Float_Random.Random(Gen_1) = Float_Random.Random(Gen_2)
-                   then
-                      Matches := Matches + 1;
-                   end if;
-                end loop;
-          end case;
- 
-          if (Values_Should_Match and Check_Failed) or
-             (not Values_Should_Match and Matches > Allowed_Matches)
-          then
-             Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
-                           "   Random numbers from Float generators " &
-                           "Failed check");
-          end if;
- 
-       end Check_Float_Values;
- 
- 
- 
-       procedure Check_Discrete_Values (Gen_1,
-                                        Gen_2    : Discrete_Package.Generator;
-                                        Sub_Test : Integer;
-                                        Values_Should_Match : Boolean) is
-          Matches         : Natural := 0;
-          Check_Failed    : Boolean := False;
-       begin
-          case Values_Should_Match is
-             when True  =>
-                for i in 1..TC_Max_Loop_Count loop
-                   if Discrete_Package.Random(Gen_1) /=
-                      Discrete_Package.Random(Gen_2)
-                   then
-                      Check_Failed := True;
-                      exit;
-                   end if;
-                end loop;
-             when False =>
-                for i in 1..TC_Max_Loop_Count loop
-                   if Discrete_Package.Random(Gen_1) =
-                      Discrete_Package.Random(Gen_2)
-                   then
-                      Matches := Matches + 1;
-                   end if;
-                end loop;
-          end case;
- 
-          if (Values_Should_Match and Check_Failed) or
-             (not Values_Should_Match and Matches > Allowed_Matches)
-          then
-             Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
-                           "   Random numbers from Discrete generators " &
-                           "Failed check");
-          end if;
- 
-       end Check_Discrete_Values;
- 
- 
- 
-    begin
- 
-       Sub_Test_1:
-          -- Check that two objects of type Generator are initialized to the
-          -- same state.
-       begin
- 
-          -- Since the discrete and float random generators are in the initial
-          -- state, using Procedure Save to save the states of the generator
-          -- objects, and transforming these states into strings using
-          -- Function Image, should yield identical strings.
- 
-          Check_Discrete_State (Discrete_Generator_1,
-                                Discrete_Generator_2,
-                                Sub_Test => 1,
-                                States_Should_Match => True);
- 
-          Check_Float_State (Float_Generator_1,
-                             Float_Generator_2,
-                             Sub_Test => 1,
-                             States_Should_Match => True);
- 
-          -- Since the two random generator objects are in their initial
-          -- state, the values produced from each (upon calls to Random)
-          -- should be identical.
- 
-          Check_Discrete_Values (Discrete_Generator_1,
-                                 Discrete_Generator_2,
-                                 Sub_Test => 1,
-                                 Values_Should_Match => True);
- 
-          Check_Float_Values (Float_Generator_1,
-                              Float_Generator_2,
-                              Sub_Test => 1,
-                              Values_Should_Match => True);
- 
-       end Sub_Test_1;
- 
- 
- 
-       Sub_Test_3:
-          -- Check that when the Function Reset uses the same integer
-          -- initiator to reset two generators to the same state, the
-          -- resulting random values and the state from each generator
-          -- are identical.
-       declare
-          use Discrete_Package, Float_Random;
-       begin
- 
-          -- Reset the generators to the same states, using the version of
-          -- Function Reset with both generator parameter and initiator
-          -- specified.
- 
-          TC_Seed := Integer(Random(Discrete_Generator_1));
-          Reset(Gen => Discrete_Generator_1, Initiator => TC_Seed);
-          Reset(Discrete_Generator_2, Initiator => TC_Seed);
-          Reset(Float_Generator_1, TC_Seed);
-          Reset(Float_Generator_2, TC_Seed);
- 
-          -- Since the random generators have been reset to identical states,
-          -- bounded string images of these states should yield identical
-          -- strings.
- 
-          Check_Discrete_State (Discrete_Generator_1,
-                                Discrete_Generator_2,
-                                Sub_Test => 3,
-                                States_Should_Match => True);
- 
-          Check_Float_State (Float_Generator_1,
-                             Float_Generator_2,
-                             Sub_Test => 3,
-                             States_Should_Match => True);
- 
-          -- Since the random generators have been reset to identical states,
-          -- the values produced from each (upon calls to Random) should
-          -- be identical.
- 
-          Check_Discrete_Values (Discrete_Generator_1,
-                                 Discrete_Generator_2,
-                                 Sub_Test => 3,
-                                 Values_Should_Match => True);
- 
-          Check_Float_Values (Float_Generator_1,
-                              Float_Generator_2,
-                              Sub_Test => 3,
-                              Values_Should_Match => True);
- 
-       end Sub_Test_3;
- 
- 
- 
-       Sub_Test_4:
-          -- Check that when the Function Reset uses different integer
-          -- initiator values to reset two generators, the resulting random
-          -- numbers and states are different.
-       begin
- 
-          -- Reset the generators to different states.
- 
-          TC_Seed :=
-            Integer(Discrete_Package.Random(Discrete_Generator_1));
- 
-          Discrete_Package.Reset(Gen       => Discrete_Generator_1,
-                                 Initiator => TC_Seed);
- 
-          -- Set the seed value to a different value for the second call
-          -- to Reset.
-          -- Note: A second call to Random could be made, as above, but that
-          --       would not ensure that the resulting seed value was
-          --       different from the first.
- 
-          if TC_Seed /= Integer'Last then
-             TC_Seed := TC_Seed + 1;
-          else
-             TC_Seed := TC_Seed - 1;
-          end if;
- 
-          Discrete_Package.Reset(Gen       => Discrete_Generator_2,
-                                 Initiator => TC_Seed);
- 
-          Float_Random.Reset(Float_Generator_1, 16#FF#);             -- 255
-          Float_Random.Reset(Float_Generator_2, 2#1110_0000#);       -- 224
- 
-          -- Since the two float random generators are in different
-          -- states, the bounded string images depicting their states should
-          -- differ.
- 
-          Check_Discrete_State (Discrete_Generator_1,
-                                Discrete_Generator_2,
-                                Sub_Test => 4,
-                                States_Should_Match => False);
- 
-          Check_Float_State (Float_Generator_1,
-                             Float_Generator_2,
-                             Sub_Test => 4,
-                             States_Should_Match => False);
- 
-          -- Since the two discrete random generator objects were reset
-          -- to different states, the values produced from each (upon calls
-          -- to Random) should differ.
- 
-          Check_Discrete_Values (Discrete_Generator_1,
-                                 Discrete_Generator_2,
-                                 Sub_Test => 4,
-                                 Values_Should_Match => False);
- 
-          Check_Float_Values (Float_Generator_1,
-                              Float_Generator_2,
-                              Sub_Test => 4,
-                              Values_Should_Match => False);
- 
-       end Sub_Test_4;
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,536 ****
- -- CXA5012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that, for both Float_Random and Discrete_Random packages,
- --      the following are true:
- --      1) the procedures Save and Reset can be used to save the
- --         specific state of a random number generator, and then restore
- --         the specific state to the generator following some intermediate
- --         generator activity.
- --      2) the Function Image can be used to obtain a string
- --         representation of the state of a generator; and that the
- --         Function Value will transform a string representation of the
- --         state of a random number generator into the actual state object.
- --      3) a call to Function Value, with a string value that is
- --         not the image of any generator state, is a bounded error. This
- --         error either raises Constraint_Error or Program_Error, or is
- --         accepted. (See Technical Corrigendum 1).
- --
- -- TEST DESCRIPTION:
- --      This test evaluates components of the Ada.Numerics.Float_Random and
- --      Ada.Numerics.Discrete_Random packages.
- --      The first objective block of this test uses Procedure Save to
- --      save the particular state of a random number generator.  The random
- --      number generator then generates a series of random numbers.  The
- --      saved state variable is then used to reset (using Procedure Reset)
- --      the generator back to the state it was in at the point of the call
- --      to Save.  Random values are then generated from this restored
- --      generator, and compared with expected values.
- --      The second objective block of this test uses Function Image to
- --      provide a string representation of a state code.  This string is
- --      then transformed back to a state code value, and used to reset a
- --      random number generator to the saved state.  Random values are
- --      likewise generated from this restored generator, and compared with
- --      expected values.
- --
- --
- -- CHANGE HISTORY:
- --      25 Apr 95   SAIC    Initial prerelease version.
- --      17 Jul 95   SAIC    Incorporated reviewer comments.
- --      17 Dec 97   EDS     Change subtype upper limit from 100_000 to 10_000.
- --      16 Sep 99   RLB     Updated objective 3 for Technical Corrigendum 1
- --                          changes.
- 
- --!
- 
- with Ada.Numerics.Float_Random;
- with Ada.Numerics.Discrete_Random;
- with Ada.Strings.Bounded;
- with ImpDef;
- with Report;
- 
- procedure CXA5012 is
- 
- begin
- 
-    Report.Test ("CXA5012", "Check the effect of Procedures Save and " &
-                            "Reset, and Functions Image and Value "    &
-                            "from the Ada.Numerics.Discrete_Random "   &
-                            "and Float_Random packages");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics, Ada.Strings.Bounded;
- 
-       -- Declare an integer subtype and an enumeration subtype, and use them
-       -- to instantiate the discrete random number generator generic package.
- 
-       subtype Discrete_Range is Integer range 1..10_000;
-       type    Suit_Of_Cards  is (Ace, One, Two, Three, Four, Five, Six,
-                                  Seven, Eight, Nine, Ten, Jack, Queen, King);
-       package Discrete_Pack is new Discrete_Random(Discrete_Range);
-       package Card_Pack     is new Discrete_Random(Suit_Of_Cards);
- 
-       -- Declaration of random number generator objects.
- 
-       DGen_1, DGen_2 : Discrete_Pack.Generator;
-       EGen_1, EGen_2 : Card_Pack.Generator;
-       FGen_1, FGen_2 : Float_Random.Generator;
- 
-       -- Variables declared to hold random numbers over the inclusive range
-       -- of their corresponding type.
- 
-       DVal_1, DVal_2 : Discrete_Range;
-       EVal_1, EVal_2 : Suit_Of_Cards;
-       FVal_1, FVal_2 : Float_Random.Uniformly_Distributed;
- 
-       -- Declaration of State variables used to hold the state of the
-       -- random number generators.
- 
-       DState_1, DState_2 : Discrete_Pack.State;
-       EState_1, EState_2 : Card_Pack.State;
-       FState_1, FState_2 : Float_Random.State;
- 
-       -- Declaration of bounded string packages instantiated with the
-       -- value of Max_Image_Width constant, and bounded string variables
-       -- used to hold the image of random number generator states.
- 
-       package DString_Pack is
-         new Generic_Bounded_Length(Discrete_Pack.Max_Image_Width);
-       package EString_Pack is
-         new Generic_Bounded_Length(Card_Pack.Max_Image_Width);
-       package FString_Pack is
-         new Generic_Bounded_Length(Float_Random.Max_Image_Width);
- 
-       use DString_Pack, EString_Pack, FString_Pack;
- 
-       DString_1, DString_2 : DString_Pack.Bounded_String :=
-                                DString_Pack.Null_Bounded_String;
-       EString_1, EString_2 : EString_Pack.Bounded_String :=
-                                EString_Pack.Null_Bounded_String;
-       FString_1, FString_2 : FString_Pack.Bounded_String :=
-                                FString_Pack.Null_Bounded_String;
- 
-       -- Test variables.
- 
-       TC_Count                  : Natural;
-       TC_Discrete_Check_Failed,
-       TC_Enum_Check_Failed,
-       TC_Float_Check_Failed     : Boolean := False;
-       TC_Seed                   : Integer;
- 
-    begin
- 
-       Objective_1:
-          -- Check that the procedures Save and Reset can be used to save the
-          -- specific state of a random number generator, and then restore the
-          -- specific state to the generator following some intermediate
-          -- generator activity.
-       declare
- 
-          First_Row     : constant :=   1;
-          Second_Row    : constant :=   2;
-          TC_Max_Values : constant := 100;
- 
-          TC_Discrete_Array : array (First_Row..Second_Row, 1..TC_Max_Values)
-                                of Discrete_Range;
-          TC_Enum_Array     : array (First_Row..Second_Row, 1..TC_Max_Values)
-                                of Suit_Of_Cards;
-          TC_Float_Array    : array (First_Row..Second_Row, 1..TC_Max_Values)
-                                of Float_Random.Uniformly_Distributed;
-       begin
- 
-          -- The state of the random number generators are saved to state
-          -- variables using the procedure Save.
- 
-          Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1);
-          Card_Pack.Save    (Gen => EGen_1, To_State => EState_1);
-          Float_Random.Save (Gen => FGen_1, To_State => FState_1);
- 
-          -- Random number generators are used to fill the first half of the
-          -- first row of the arrays with randomly generated values.
- 
-          for i in 1..TC_Max_Values/2 loop
-             TC_Discrete_Array(First_Row, i) := Discrete_Pack.Random(DGen_1);
-             TC_Enum_Array(First_Row, i)     := Card_Pack.Random(EGen_1);
-             TC_Float_Array(First_Row, i)    := Float_Random.Random(FGen_1);
-          end loop;
- 
-          -- The random number generators are reset to the states saved in the
-          -- state variables, using the procedure Reset.
- 
-          Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1);
-          Card_Pack.Reset    (Gen => EGen_1, From_State => EState_1);
-          Float_Random.Reset (Gen => FGen_1, From_State => FState_1);
- 
-          -- The same random number generators are used to fill the first half
-          -- of the second row of the arrays with randomly generated values.
- 
-          for i in 1..TC_Max_Values/2 loop
-             TC_Discrete_Array(Second_Row, i) := Discrete_Pack.Random(DGen_1);
-             TC_Enum_Array(Second_Row, i)     := Card_Pack.Random(EGen_1);
-             TC_Float_Array(Second_Row, i)    := Float_Random.Random(FGen_1);
-          end loop;
- 
-          -- Run the random number generators many times (not using results).
- 
-          for i in Discrete_Range'Range loop
-              DVal_1 := Discrete_Pack.Random(DGen_1);
-              EVal_1 := Card_Pack.Random(EGen_1);
-              FVal_1 := Float_Random.Random(FGen_1);
-          end loop;
- 
-          -- The states of the random number generators are saved to state
-          -- variables using the procedure Save.
- 
-          Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1);
-          Card_Pack.Save(Gen => EGen_1, To_State => EState_1);
-          Float_Random.Save (Gen => FGen_1, To_State => FState_1);
- 
-          -- The last half of the first row of the arrays are filled with
-          -- values generated from the same random number generators.
- 
-          for i in (TC_Max_Values/2 + 1)..TC_Max_Values loop
-             TC_Discrete_Array(First_Row, i) := Discrete_Pack.Random(DGen_1);
-             TC_Enum_Array(First_Row, i)     := Card_Pack.Random(EGen_1);
-             TC_Float_Array(First_Row, i)    := Float_Random.Random(FGen_1);
-          end loop;
- 
-          -- The random number generators are reset to the states saved in the
-          -- state variables, using the procedure Reset.
- 
-          Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1);
-          Card_Pack.Reset(Gen => EGen_1, From_State => EState_1);
-          Float_Random.Reset (Gen => FGen_1, From_State => FState_1);
- 
-          -- The last half of the second row of the arrays are filled with
-          -- values generated from the same random number generator.
-          -- These values should exactly mirror the values in the last half
-          -- of the first row of the arrays that had been previously generated.
- 
-          for i in (TC_Max_Values/2 + 1)..TC_Max_Values loop
-             TC_Discrete_Array(Second_Row, i) := Discrete_Pack.Random(DGen_1);
-             TC_Enum_Array(Second_Row, i)     := Card_Pack.Random(EGen_1);
-             TC_Float_Array(Second_Row, i)    := Float_Random.Random(FGen_1);
-          end loop;
- 
-          -- Check that the values in the two rows of the arrays are identical.
- 
-          for i in 1..TC_Max_Values loop
-             if TC_Discrete_Array(First_Row,i) /=
-                TC_Discrete_Array(Second_Row,i)
-             then
-                TC_Discrete_Check_Failed := True;
-                exit;
-             end if;
-          end loop;
- 
-          for i in 1..TC_Max_Values loop
-             if TC_Enum_Array(First_Row,i) /= TC_Enum_Array(Second_Row,i) then
-                TC_Enum_Check_Failed := True;
-                exit;
-             end if;
-          end loop;
- 
-          for i in 1..TC_Max_Values loop
-             if TC_Float_Array(First_Row,i) /= TC_Float_Array(Second_Row,i)
-             then
-                TC_Float_Check_Failed := True;
-                exit;
-             end if;
-          end loop;
- 
-          if TC_Discrete_Check_Failed then
-             Report.Failed("Discrete random values generated following use " &
-                           "of procedures Save and Reset were not the same");
-             TC_Discrete_Check_Failed := False;
-          end if;
- 
-          if TC_Enum_Check_Failed then
-             Report.Failed("Enumeration random values generated following " &
-                           "use of procedures Save and Reset were not the " &
-                           "same");
-             TC_Enum_Check_Failed := False;
-          end if;
- 
-          if TC_Float_Check_Failed then
-             Report.Failed("Float random values generated following use " &
-                           "of procedures Save and Reset were not the same");
-             TC_Float_Check_Failed := False;
-          end if;
- 
-       end Objective_1;
- 
- 
- 
-       Objective_2:
-          -- Check that the Function Image can be used to obtain a string
-          -- representation of the state of a generator.
-          -- Check that the Function Value will transform a string
-          -- representation of the state of a random number generator
-          -- into the actual state object.
-       begin
- 
-          -- Use two discrete and float random number generators to generate
-          -- a series of values (so that the generators are no longer in their
-          -- initial states, and they have generated the same number of
-          -- random values).
- 
-          TC_Seed := Integer(Discrete_Pack.Random(DGen_1));
-          Discrete_Pack.Reset(DGen_1, TC_Seed);
-          Discrete_Pack.Reset(DGen_2, TC_Seed);
-          Card_Pack.Reset    (EGen_1, TC_Seed);
-          Card_Pack.Reset    (EGen_2, TC_Seed);
-          Float_Random.Reset (FGen_1,  TC_Seed);
-          Float_Random.Reset (FGen_2,  TC_Seed);
- 
-          for i in 1..1000 loop
-             DVal_1 := Discrete_Pack.Random(DGen_1);
-             DVal_2 := Discrete_Pack.Random(DGen_2);
-             EVal_1 := Card_Pack.Random(EGen_1);
-             EVal_2 := Card_Pack.Random(EGen_2);
-             FVal_1 := Float_Random.Random(FGen_1);
-             FVal_2 := Float_Random.Random(FGen_2);
-          end loop;
- 
-          -- Use the Procedure Save to save the states of the generators
-          -- to state variables.
- 
-          Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1);
-          Discrete_Pack.Save(DGen_2, To_State => DState_2);
-          Card_Pack.Save    (Gen => EGen_1, To_State => EState_1);
-          Card_Pack.Save    (EGen_2, To_State => EState_2);
-          Float_Random.Save (FGen_1, To_State => FState_1);
-          Float_Random.Save (FGen_2, FState_2);
- 
-          -- Use the Function Image to produce a representation of the state
-          -- codes as (bounded) string objects.
- 
-          DString_1 := DString_Pack.To_Bounded_String(
-                         Discrete_Pack.Image(Of_State => DState_1));
-          DString_2 := DString_Pack.To_Bounded_String(
-                         Discrete_Pack.Image(DState_2));
-          EString_1 := EString_Pack.To_Bounded_String(
-                         Card_Pack.Image(Of_State => EState_1));
-          EString_2 := EString_Pack.To_Bounded_String(
-                         Card_Pack.Image(EState_2));
-          FString_1 := FString_Pack.To_Bounded_String(
-                         Float_Random.Image(Of_State => FState_1));
-          FString_2 := FString_Pack.To_Bounded_String(
-                         Float_Random.Image(FState_2));
- 
-          -- Compare the bounded string objects for equality.
- 
-          if DString_1 /= DString_2 then
-             Report.Failed("String values returned from Function Image " &
-                           "depict different states of Discrete generators");
-          end if;
-          if EString_1 /= EString_2 then
-             Report.Failed("String values returned from Function Image " &
-                           "depict different states of Enumeration "     &
-                           "generators");
-          end if;
-          if FString_1 /= FString_2 then
-             Report.Failed("String values returned from Function Image " &
-                           "depict different states of Float generators");
-          end if;
- 
-          -- The string representation of a state code is transformed back
-          -- to a state code variable using the Function Value.
- 
-          DState_1 := Discrete_Pack.Value(Coded_State =>
-                                           DString_Pack.To_String(DString_1));
-          EState_1 := Card_Pack.Value(EString_Pack.To_String(EString_1));
-          FState_1 := Float_Random.Value(FString_Pack.To_String(FString_1));
- 
-          -- One of the (pair of each type of ) generators is used to generate
-          -- a series of random values, getting them "out of synch" with the
-          -- specific generation sequence of the other generators.
- 
-          for i in 1..100 loop
-             DVal_1 := Discrete_Pack.Random(DGen_1);
-             EVal_1 := Card_Pack.Random(EGen_1);
-             FVal_1 := Float_Random.Random (FGen_1);
-          end loop;
- 
-          -- The "out of synch" generators are reset to the previous state they
-          -- had when their states were saved, and they should now have the same
-          -- states as the generators that did not generate the values above.
- 
-          Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1);
-          Card_Pack.Reset    (Gen => EGen_1, From_State => EState_1);
-          Float_Random.Reset (Gen => FGen_1, From_State => FState_1);
- 
-          -- All generators should now be in the same state, so the
-          -- random values they produce should be the same.
- 
-          for i in 1..1000 loop
-             if Discrete_Pack.Random(DGen_1) /= Discrete_Pack.Random(DGen_2)
-             then
-                TC_Discrete_Check_Failed := True;
-                exit;
-             end if;
-          end loop;
- 
-          for i in 1..1000 loop
-             if Card_Pack.Random(EGen_1) /= Card_Pack.Random(EGen_2) then
-                TC_Enum_Check_Failed := True;
-                exit;
-             end if;
-          end loop;
- 
-          for i in 1..1000 loop
-             if Float_Random.Random(FGen_1) /= Float_Random.Random(FGen_2)
-             then
-                TC_Float_Check_Failed := True;
-                exit;
-             end if;
-          end loop;
- 
-          if TC_Discrete_Check_Failed then
-             Report.Failed("Random values generated following use of "     &
-                           "procedures Image and Value were not the same " &
-                           "for Discrete generator");
-          end if;
-          if TC_Enum_Check_Failed then
-             Report.Failed("Random values generated following use of "     &
-                           "procedures Image and Value were not the same " &
-                           "for Enumeration generator");
-          end if;
-          if TC_Float_Check_Failed then
-             Report.Failed("Random values generated following use of "     &
-                           "procedures Image and Value were not the same " &
-                           "for Float generator");
-          end if;
- 
-       end Objective_2;
- 
- 
- 
-       Objective_3:
-          -- Check that a call to Function Value, with a string value that is
-          -- not the image of any generator state, is a bounded error. This
-          -- error either raises Constraint_Error or Program_Error, or is
-          -- accepted. (See Technical Corrigendum 1).
-       declare
-          Not_A_State : constant String := ImpDef.Non_State_String;
-       begin
- 
-          begin
-             DState_1 := Discrete_Pack.Value(Not_A_State);
-             if Not_A_State /= "**NONE**" then
-                Report.Failed("Exception not raised by Function " &
-                              "Ada.Numerics.Discrete_Random.Value when " &
-                              "provided a string input that does not "   &
-                              "represent the state of a random number "  &
-                              "generator");
-             else
-                Report.Comment("All strings represent states for Function " &
-                              "Ada.Numerics.Discrete_Random.Value");
-             end if;
-             Discrete_Pack.Reset(DGen_1, DState_1);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-                Report.Comment("Constraint_Error raised by Function " &
-                              "Ada.Numerics.Discrete_Random.Value when " &
-                              "provided a string input that does not "   &
-                              "represent the state of a random number "  &
-                              "generator");
-             when Program_Error => -- OK, expected exception.
-                Report.Comment("Program_Error raised by Function " &
-                              "Ada.Numerics.Discrete_Random.Value when " &
-                              "provided a string input that does not "   &
-                              "represent the state of a random number "  &
-                              "generator");
-             when others =>
-                Report.Failed("Unexpected exception raised by Function " &
-                              "Ada.Numerics.Discrete_Random.Value when " &
-                              "provided a string input that does not "   &
-                              "represent the state of a random number "  &
-                              "generator");
-          end;
- 
-          begin
-             EState_1 := Card_Pack.Value(Not_A_State);
-             if Not_A_State /= "**NONE**" then
-                Report.Failed("Exception not raised by Function " &
-                              "Ada.Numerics.Discrete_Random.Value when " &
-                              "provided a string input that does not "   &
-                              "represent the state of an enumeration "   &
-                              "random number generator");
-             else
-                Report.Comment("All strings represent states for Function " &
-                              "Ada.Numerics.Discrete_Random.Value");
-             end if;
-             Card_Pack.Reset(EGen_1, EState_1);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when Program_Error => null; -- OK, expected exception.
-             when others =>
-                Report.Failed("Unexpected exception raised by Function " &
-                              "Ada.Numerics.Discrete_Random.Value when " &
-                              "provided a string input that does not "   &
-                              "represent the state of an enumeration "   &
-                              "random number generator");
-          end;
- 
-          begin
-             FState_1 := Float_Random.Value(Not_A_State);
-             if Not_A_State /= "**NONE**" then
-                Report.Failed("Exception not raised by an "      &
-                              "instantiated version of "                &
-                              "Ada.Numerics.Float_Random.Value when "   &
-                              "provided a string input that does not "  &
-                              "represent the state of a random number " &
-                              "generator");
-             else
-                Report.Comment("All strings represent states for Function " &
-                              "Ada.Numerics.Float_Random.Value");
-             end if;
-             Float_Random.Reset(FGen_1, FState_1);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when Program_Error => null; -- OK, expected exception.
-             when others =>
-                Report.Failed("Unexpected exception raised by an "      &
-                              "instantiated version of "                &
-                              "Ada.Numerics.Float_Random.Value when "   &
-                              "provided a string input that does not "  &
-                              "represent the state of a random number " &
-                              "generator");
-          end;
- 
-       end Objective_3;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,326 ****
- -- CXA5013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a discrete random number generator will yield each value
- --      in its result subtype in a finite number of calls, provided that
- --      the number of such values does not exceed 2**15.
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates certain capabilities of the random number 
- --      generator packages in Ada.Numerics.  A generic subprogram is
- --      defined that will be instantiated to produce a total of two test
- --      subprograms.
- --      The area examined by this test is the production of random values 
- --      over a discrete range.  A generic procedure is instantiated with
- --      an instance of the Discrete_Random package, once for an integer type,
- --      and once for an enumeration type.  The test procedure performs a 
- --      test run, generating a specific number of random numbers over the 
- --      range of the type.  If this run did not generate each of the values
- --      in the type range, an asynchronous select statement is invoked.  This
- --      select statement has a trigger statement delay for a specific 
- --      (implementation defined) amount of time during which additional test
- --      runs will be performed.  
- --      At the end of each run in this test, an evaluation is made to 
- --      determine if each value in the range of possible values have been 
- --      generated.  At the conclusion of the runs, or if the specified test
- --      delay time expires, the test is concluded with  a status value
- --      returned from the test procedure.  An implementation is given three
- --      completely separate opportunities to run the test successfully, and 
- --      if at the conclusion of all of these tests no successful result has 
- --      been returned, the test is considered failed.
- --      
- --       
- -- CHANGE HISTORY:
- --      27 Apr 95   SAIC    Initial prerelease version.
- --
- --!
- 
- with Ada.Numerics.Discrete_Random;
- with ImpDef;
- with Report;
- 
- procedure CXA5013 is
- 
- begin
- 
-    Report.Test ("CXA5013", "Check that a discrete random number generator " &
-                            "will yield each value in its result subtype "   &
-                            "in a finite number of calls");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
- 
-       -- The following constant designed into the test creates a high 
-       -- probability that a random series of numbers will satisfy the 
-       -- requirements. Occasionally, even a random series of numbers 
-       -- will fail.  In such a case, the test will reset the random 
-       -- number generator and rerun the test conditions.  This constant
-       -- determines how many times the random number generator will be
-       -- reset before any individual test run is failed.
- 
-       TC_Max_Random_Test_Runs       : constant :=    3;
- 
-       -- The following constant will ensure that multiple attempts of the
-       -- complete set of tests are performed in the event of a failure of 
-       -- a set of test runs.
- 
-       TC_Finite_Number_Of_Tests : constant :=    3;
- 
- 
-       TC_Test_Run               : Integer  :=    0;
-       TC_Success                : Boolean  := False;
-       TC_Trials_Per_Test        : Integer  := 1500;
- 
-       type Enum_Type         is (One, Two, Three, Four, Five, Six, Seven);
-       type Discrete_Type     is range 1..100;
- 
- 
-       package Enum_Pack      is new Discrete_Random(Enum_Type);
-       package Discrete_Pack  is 
-         new Discrete_Random(Result_Subtype => Discrete_Type);
- 
- 
- 
-       --
-       -- Definition of generic Random_Test procedure, which will be 
-       -- instantiated for both an integer type and an enumeration type.
-       --
- 
-       generic
-          with package Gen_Pack is new Ada.Numerics.Discrete_Random (<>);
-       procedure Random_Test (Trials_Per_Test : in     Integer;
-                              Success         :    out Boolean); 
- 
- 
-       procedure Random_Test (Trials_Per_Test : in     Integer;
-                              Success         :    out Boolean) is
-          Total_Runs               : Integer  := 0;
-          Total_Trials             : Integer  := 0;
-          Total_Attempts_This_Test : Integer  := 0;
-          Random_Array             : array (Gen_Pack.Result_Subtype) 
-                                       of Boolean := (others => False);
-          Gen                      : Gen_Pack.Generator;
- 
-          function All_Values_Present return Boolean is
-             Result : Boolean := True;
-          begin
-             for i in Gen_Pack.Result_Subtype'Range loop
-                if not Random_Array(i) then 
-                   Result := False; 
-                   exit;
-                end if;
-             end loop;
-             return Result;
-          end All_Values_Present;
- 
-       begin
- 
-          Success := False;     -- Initialized to failure prior to test.
-          Gen_Pack.Reset(Gen);  -- Perform a time-dependent reset.
- 
-          -- Guarantee that a specific minimum number of trials are performed
-          -- prior to the timer being set.
- 
-          for i in 1..Trials_Per_Test loop
-             -- Set array element to True when a particular array
-             -- index is generated by the random number generator.
-             Random_Array(Gen_Pack.Random(Gen)) := True;
-          end loop;
- 
-          if All_Values_Present then
- 
-             Success := True;  -- Test was successful, exit procedure with no
-                               -- further testing performed.
-          else
- 
-             -- Initial test above was unsuccessful, so set a timer and perform
-             -- additional trials to determine if all values in the discrete
-             -- range will be produced.
- 
-             select
- 
-                -- This asynchronous select has a triggering statement which
-                -- is a delay statement, set to an implementation defined 
-                -- number of seconds for any particular test to execute.  
-                -- The point here is to allow the implementation to decide 
-                -- how long to run this test in order to generate an 
-                -- appropriate (i.e., correct) sample from the Random Number
-                -- Generator.
- 
-                delay ImpDef.Delay_Per_Random_Test;  -- Delay per test.
- 
-                -- If, after expiration of delay, the random number generator
-                -- has generated all values within the range at least once,
-                -- then the result is success; otherwise, a comment is output
-                -- to indicate that the random number generator was 
-                -- unsuccessful in this series of test runs.
- 
-                if All_Values_Present then
-                   Success := True;
-                else
-                   Total_Attempts_This_Test := 
-                     Total_Runs * Trials_Per_Test + Total_Trials;
-                   Report.Comment
-                     ("Not all numbers within the Range were produced in " &
-                      Integer'Image(
-                        Integer(ImpDef.Delay_Per_Random_Test*1000.0))      &
-                      " milliseconds or in "                               &
-                      Integer'Image(Total_Attempts_This_Test)              &
-                      " trials during this test");
-                end if;
- 
-             then abort
- 
-                -- After setting the triggering statement above, the execution
-                -- of this abortable part is begun.
-                -- This loop continues until either a) every value has been
-                -- produced or b) the triggering statement times out.
- 
-                Total_Runs := 1;
- 
-                Test_Loop:  -- This loop continues until a test run is
-                loop        -- successful, the test run limit has been reached, 
-                            -- or the triggering statement times-out above.
- 
-                   Total_Trials := 0;
- 
-                   for i in 1..Trials_Per_Test loop
-                      Total_Trials := i; -- Used above if triggering statement
-                                         -- completes prior to test completion.
- 
-                      -- Set array element to True when a particular array
-                      -- index is generated by the random number generator.
- 
-                      Random_Array(Gen_Pack.Random(Gen)) := True;
- 
-                   end loop;
- 
-                   -- At the conclusion of a complete series of trials, the
-                   -- following evaluation is performed to determine whether
-                   -- the test run was successful, or whether an additional
-                   -- test run should be re-attempted.
- 
-                   if All_Values_Present then
-                      Success := True;
-                      exit Test_Loop;
-                   elsif Total_Runs = TC_Max_Random_Test_Runs then
-                      Report.Comment
-                        ("Not all numbers in the Range were produced in " &
-                         Integer'Image(Total_Runs*Trials_Per_Test) &
-                         " individual trials during this test");
-                      exit Test_Loop;
-                   else
-                      Total_Runs := Total_Runs + 1;
-                   end if;
- 
-                end loop Test_Loop;
-             end select;
-          end if;
-       end Random_Test;
- 
- 
- 
-       -- Instantiation of test procedures.
- 
-       procedure Discrete_Random_Test    is new Random_Test(Discrete_Pack);
-       procedure Enumeration_Random_Test is new Random_Test(Enum_Pack);
- 
- 
-    begin
- 
-       -- Make a series of test runs, checking to ensure that discrete 
-       -- random number generators produce each value in their result subtype
-       -- within a finite number of calls.  In each case, if the first test
-       -- is not successful, another attempt is made, after a time-dependent
-       -- reset, up to a total of 3 runs.  This allows an implementation 
-       -- multiple opportunities to pass the test successfully.
-       -- Note: The odds of getting all 100 integer values in 1500 trials are
-       --       greater than 99.997 percent, confirmed by Monte Carlo 
-       --       simulation.
- 
- 
- 
-       -- Run the Random_Test for an integer discrete random number generator.
- 
-       TC_Test_Run := 0;
-       TC_Success  := False;
-       while TC_Test_Run < TC_Finite_Number_Of_Tests and 
-             not TC_Success 
-       loop
-          TC_Test_Run := TC_Test_Run + 1;            -- Increment test counter.
-          Discrete_Random_Test (TC_Trials_Per_Test,  -- Perform test.
-                                TC_Success); 
-          -- Increment the number of trials that will be performed
-          -- in the next test by 50%.
-          TC_Trials_Per_Test := TC_Trials_Per_Test + TC_Trials_Per_Test/2 ;
-       end loop;
- 
-       if not TC_Success then
-          Report.Failed("Random_Test was run " & Integer'Image(TC_Test_Run) &
-                        " times, but a successful result was not recorded " &
-                        "from any run using the integer discrete random "   &
-                        "number generator");
-       end if;
- 
- 
- 
-       -- Run the Random_Test for an enumeration type random number generator.
- 
-       -- Note: The odds of getting all seven enumeration values in 100 
-       --       trials are greater than 99.997 percent, confirmed by Monte
-       --       Carlo simulation.
- 
-       TC_Test_Run        := 0;
-       TC_Trials_Per_Test := 100;
-       TC_Success         := False;
-       while TC_Test_Run < TC_Finite_Number_Of_Tests and 
-             not TC_Success 
-       loop
-          TC_Test_Run := TC_Test_Run + 1;
-          Enumeration_Random_Test (TC_Trials_Per_Test,
-                                   TC_Success); 
-          -- Increment the number of trials that will be performed
-          -- in the next test by 50%.
-          TC_Trials_Per_Test := TC_Trials_Per_Test + TC_Trials_Per_Test/2 ;
-       end loop;
- 
-       if not TC_Success then
-          Report.Failed("Random_Test was run " & Integer'Image(TC_Test_Run) &
-                        " times, but a successful result was not recorded " &
-                        "from any run using the enumeration random number " &
-                        "generator");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,342 ****
- -- CXA5015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the following representation-oriented attributes are 
- --      available and that the produce correct results: 
- --      'Denorm, 'Signed_Zeros, 'Exponent 'Fraction, 'Compose, 'Scaling, 
- --      'Floor, 'Ceiling, 'Rounding, 'Unbiased_Rounding, 'Truncation, 
- --      'Remainder, 'Adjacent, 'Copy_Sign, 'Leading_Part, 'Machine, and 
- --      'Model_Small.
- --      
- -- TEST DESCRIPTION:
- --      This test checks whether certain attributes of floating point types
- --      are available from an implementation.  Where attribute correctness 
- --      can be verified in a straight forward manner, the appropriate checks 
- --      are included here.  However, this test is not intended to ensure the 
- --      correctness of the results returned from all of the attributes 
- --      examined in this test; that process will occur in the tests of the 
- --      Numerics_Annex. 
- --      
- --       
- -- CHANGE HISTORY:
- --      26 Jun 95   SAIC    Initial prerelease version.
- --      29 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      01 DEC 97   EDS     Fix value for checking the S'Adjacent attribute
- --!
- 
- with Report;
- 
- procedure CXA5015 is
- 
-    subtype Float_Subtype   is Float range -10.0..10.0;
-    type    Derived_Float_1 is digits  8;
-    type    Derived_Float_2 is new Derived_Float_1 range -10.0..10.0E10;
- 
-    use type Float, Float_Subtype, Derived_Float_1, Derived_Float_2;
- 
-    TC_Boolean   : Boolean;
-    TC_Float     : Float;
-    TC_SFloat    : Float_Subtype;
-    TC_DFloat_1  : Derived_Float_1;
-    TC_DFloat_2  : Derived_Float_2;
-    TC_Tolerance : Float := 0.001;
- 
-    function Not_Equal (Actual_Result, Expected_Result, Tolerance : Float)
-      return Boolean is
-    begin
-       return abs(Actual_Result - Expected_Result) > Tolerance;
-    end Not_Equal;
- 
- 
- begin
- 
-    Report.Test ("CXA5015", "Check that certain representation-oriented " &
-                            "attributes are available and that they "     &
-                            "produce correct results");
- 
-    -- New Representation-Oriented Attributes.
-    --
-    -- Check the S'Denorm attribute.
- 
-    TC_Boolean := Float'Denorm;
-    TC_Boolean := Float_Subtype'Denorm;
-    TC_Boolean := Derived_Float_1'Denorm;
-    TC_Boolean := Derived_Float_2'Denorm;
- 
- 
-    -- Check the S'Signed_Zeroes attribute.
- 
-    TC_Boolean := Float'Signed_Zeros;
-    TC_Boolean := Float_Subtype'Signed_Zeros;
-    TC_Boolean := Derived_Float_1'Signed_Zeros;
-    TC_Boolean := Derived_Float_2'Signed_Zeros;
- 
- 
-    -- New Primitive Function Attributes.
-    --
-    -- Check the S'Exponent attribute.
- 
-    TC_Float    := 0.5;
-    TC_SFloat   := 0.99;
-    TC_DFloat_1 := 2.45;
-    TC_DFloat_2 := 2.65;
- 
-    if Float'Exponent(TC_Float) > Float_Subtype'Exponent(TC_SFloat) or
-       Float'Exponent(TC_Float) > 2
-    then
-       Report.Failed("Incorrect result from the 'Exponent attribute");
-    end if;
- 
- 
-    -- Check the S'Fraction attribute.
- 
-    if Not_Equal 
-         (Float'Fraction(TC_Float), 
-          TC_Float * Float(Float'Machine_Radix)**(-Float'Exponent(TC_Float)),
-          TC_Tolerance)
-    then
-       Report.Failed("Incorrect result from the 'Fraction attribute - 1");
-    end if;
- 
-    if Float'Fraction(TC_Float) < 
-       (1.0/Float(Float'Machine_Radix)) - TC_Tolerance  or
-       Float'Fraction(TC_Float) >= 1.0 - TC_Tolerance    
-    then
-       Report.Failed("Incorrect result from the 'Fraction attribute - 2");
-    end if;
- 
- 
-    -- Check the S'Compose attribute.
- 
-    if Not_Equal 
-        (Float'Compose(TC_Float, 3),
-         TC_Float * Float(Float'Machine_Radix)**(3-Float'Exponent(TC_Float)),
-         TC_Tolerance)
-    then
-       Report.Failed("Incorrect result from the 'Compose attribute");
-    end if;
- 
- 
-    -- Check the S'Scaling attribute.
- 
-    if Not_Equal 
-         (Float'Scaling(TC_Float, 2),
-          TC_Float * Float(Float'Machine_Radix)**2,
-          TC_Tolerance)
-    then
-       Report.Failed("Incorrect result from the 'Scaling attribute");
-    end if;
- 
- 
-    -- Check the S'Floor attribute.
- 
-    TC_Float    :=  0.99;
-    TC_SFloat   :=  1.00;
-    TC_DFloat_1 :=  2.50;
-    TC_DFloat_2 := -2.50;
- 
-    if Float'Floor(TC_Float)               /=  0.0  or
-       Float_Subtype'Floor(TC_SFloat)      /=  1.0  or
-       Derived_Float_1'Floor(TC_DFloat_1)  /=  2.0  or
-       Derived_Float_2'Floor(TC_DFloat_2)  /= -3.0
-    then
-       Report.Failed("Incorrect result from the 'Floor attribute");
-    end if;
- 
- 
-    -- Check the S'Ceiling attribute.
- 
-    TC_Float    :=  0.99;
-    TC_SFloat   :=  1.00;
-    TC_DFloat_1 :=  2.50;
-    TC_DFloat_2 := -2.99;
- 
-    if Float'Ceiling(TC_Float)               /=  1.0  or
-       Float_Subtype'Ceiling(TC_SFloat)      /=  1.0  or
-       Derived_Float_1'Ceiling(TC_DFloat_1)  /=  3.0  or
-       Derived_Float_2'Ceiling(TC_DFloat_2)  /= -2.0
-    then
-       Report.Failed("Incorrect result from the 'Ceiling attribute");
-    end if;
- 
- 
-    -- Check the S'Rounding attribute.
- 
-    TC_Float    :=  0.49;
-    TC_SFloat   :=  1.00;
-    TC_DFloat_1 :=  2.50;
-    TC_DFloat_2 := -2.50;
- 
-    if Float'Rounding(TC_Float)               /=  0.0  or
-       Float_Subtype'Rounding(TC_SFloat)      /=  1.0  or
-       Derived_Float_1'Rounding(TC_DFloat_1)  /=  3.0  or
-       Derived_Float_2'Rounding(TC_DFloat_2)  /= -3.0
-    then
-       Report.Failed("Incorrect result from the 'Rounding attribute");
-    end if;
- 
- 
-    -- Check the S'Unbiased_Rounding attribute.
- 
-    TC_Float    :=  0.50;
-    TC_SFloat   :=  1.50;
-    TC_DFloat_1 :=  2.50;
-    TC_DFloat_2 := -2.50;
- 
-    if Float'Unbiased_Rounding(TC_Float)               /=  0.0  or
-       Float_Subtype'Unbiased_Rounding(TC_SFloat)      /=  2.0  or
-       Derived_Float_1'Unbiased_Rounding(TC_DFloat_1)  /=  2.0  or
-       Derived_Float_2'Unbiased_Rounding(TC_DFloat_2)  /= -2.0
-    then
-       Report.Failed("Incorrect result from the 'Unbiased_Rounding " &
-                     "attribute");
-    end if;
- 
- 
-    -- Check the S'Truncation attribute.
- 
-    TC_Float    := -0.99;
-    TC_SFloat   :=  1.50;
-    TC_DFloat_1 :=  2.99;
-    TC_DFloat_2 := -2.50;
- 
-    if Float'Truncation(TC_Float)               /=  0.0  or
-       Float_Subtype'Truncation(TC_SFloat)      /=  1.0  or
-       Derived_Float_1'Truncation(TC_DFloat_1)  /=  2.0  or
-       Derived_Float_2'Truncation(TC_DFloat_2)  /= -2.0
-    then
-       Report.Failed("Incorrect result from the 'Truncation attribute");
-    end if;
- 
- 
-    -- Check the S'Remainder attribute.
- 
-    TC_Float    :=  9.0;
-    TC_SFloat   :=  7.5;
-    TC_DFloat_1 :=  5.0;
-    TC_DFloat_2 :=  8.0;
- 
-    if Float'Remainder(TC_Float, 2.0)                /=  1.0  or
-       Float_Subtype'Remainder(TC_SFloat, 3.0)       /=  1.5  or
-       Derived_Float_1'Remainder(TC_DFloat_1, 2.0)   /=  1.0  or
-       Derived_Float_2'Remainder(TC_DFloat_2, 4.0)   /=  0.0
-    then
-       Report.Failed("Incorrect result from the 'Remainder attribute");
-    end if;
- 
- 
-    -- Check the S'Adjacent attribute.
- 
-    TC_Float    :=  4.0;
-    TC_SFloat   := -1.0;
- 
-    if Float'Adjacent(TC_Float, TC_Float)           /=  TC_Float  or
-       Float_Subtype'Adjacent(TC_SFloat, -1.0)      /=  TC_SFloat 
-    then
-       Report.Failed("Incorrect result from the 'Adjacent attribute");
-    end if;
- 
- 
-    -- Check the S'Copy_Sign attribute.
- 
-    TC_Float    :=  0.0;
-    TC_SFloat   := -1.0;
-    TC_DFloat_1 :=  5.0;
-    TC_DFloat_2 := -2.5;
- 
-    if Float'Copy_Sign(TC_Float, -2.0)               /=  0.0  or
-       Float_Subtype'Copy_Sign(TC_SFloat, 4.0)       /=  1.0  or
-       Derived_Float_1'Copy_Sign(TC_DFloat_1, -2.0)  /= -5.0  or
-       Derived_Float_2'Copy_Sign(TC_DFloat_2, -2.0)  /= -2.5
-    then
-       Report.Failed("Incorrect result from the 'Copy_Sign attribute");
-    end if;
- 
- 
-    -- Check the S'Leading_Part attribute.
- 
-    TC_Float    :=  0.0;
-    TC_SFloat   := -1.0;
-    TC_DFloat_1 :=  5.88;
-    TC_DFloat_2 := -2.52;
- 
-    -- Leading part obtained in the variables.
-    TC_Float    :=  Float'Leading_Part(TC_Float, 2);
-    TC_SFloat   :=  Float_Subtype'Leading_Part(TC_SFloat, 2);
-    TC_DFloat_1 :=  Derived_Float_1'Leading_Part(TC_DFloat_1, 2);
-    TC_DFloat_2 :=  Derived_Float_2'Leading_Part(TC_DFloat_2, 2);
- 
-    -- Checking for the leading part of the variables at this point should
-    -- produce the same values.
-    if Float'Leading_Part(TC_Float, 2)              /= TC_Float    or
-       Float_Subtype'Leading_Part(TC_SFloat, 2)     /= TC_SFloat   or
-       Derived_Float_1'Leading_Part(TC_DFloat_1, 2) /= TC_DFloat_1 or
-       Derived_Float_2'Leading_Part(TC_DFloat_2, 2) /= TC_DFloat_2
-    then
-       Report.Failed("Incorrect result from the 'Leading_Part attribute");
-    end if;
- 
- 
-    -- Check the S'Machine attribute.
- 
-    TC_Float    :=  0.0;
-    TC_SFloat   := -1.0;
-    TC_DFloat_1 :=  5.88;
-    TC_DFloat_2 := -2.52;
- 
-    -- Closest machine number obtained in the variables.
-    TC_Float    :=  Float'Machine(TC_Float);
-    TC_SFloat   :=  Float_Subtype'Machine(TC_SFloat);
-    TC_DFloat_1 :=  Derived_Float_1'Machine(TC_DFloat_1);
-    TC_DFloat_2 :=  Derived_Float_2'Machine(TC_DFloat_2);
- 
-    -- Checking for the closest machine number to each of the variables at 
-    -- this point should produce the same values.
-    if Float'Machine(TC_Float)              /= TC_Float    or
-       Float_Subtype'Machine(TC_SFloat)     /= TC_SFloat   or
-       Derived_Float_1'Machine(TC_DFloat_1) /= TC_DFloat_1 or
-       Derived_Float_2'Machine(TC_DFloat_2) /= TC_DFloat_2
-    then
-       Report.Failed("Incorrect result from the 'Machine attribute");
-    end if;
- 
- 
-    -- New Model-Oriented Attributes.
-    --
-    -- Check the S'Model_Small attribute.
- 
-    if Not_Equal 
-         (Float'Model_Small,
-          Float(Float'Machine_Radix)**(Float'Model_Emin-1),
-          TC_Tolerance)
-    then
-       Report.Failed("Incorrect result from the 'Model_Small attribute");
-    end if;
- 
- 
-    Report.Result;
- 
- end CXA5015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,338 ****
- -- CXA5A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions Sin and Sinh provide correct results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Sin and Sinh resulting from
- --      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
- --      with a type derived from type Float, as well as the preinstantiated 
- --      version of this package for type Float.
- --      Prescribed results, as well as instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A01.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Mar 95   SAIC    Initial prerelease version.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      26 Jun 98   EDS     Protected exception tests by first testing
- --                          for 'Machine_Overflows
- --!
- 
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A01 is
- begin
- 
-    Report.Test ("CXA5A01", "Check that the functions Sin and Sinh provide " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       The_Result       : Float;
-       New_Float_Result : New_Float;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Sin Function, both instantiated and pre-instantiated
-       -- version.
-       
-       -- Check that no exception occurs on computing the Sin with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Sin (New_Float(FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Sin with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Sin (FXA5A00.Minus_Large);
-          Dont_Optimize_Float(The_Result, 2);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Sin with large " &
-                          "negative value");
-       end;
- 
- 
-       -- Test of Sin for prescribed result at zero.
- 
-       if GEF.Sin (0.0) /= 0.0 or
-           EF.Sin (0.0) /= 0.0
-       then
-          Report.Failed("Incorrect value returned from Sin(0.0)");
-       end if;
- 
- 
-       -- Test of Sin with expected result value between 0.0 and 1.0.
- 
-       if not (GEF.Sin (Ada.Numerics.Pi/4.0) < 1.0)                    or
-          not ( EF.Sin (Ada.Numerics.Pi/4.0) < 1.0)                    or
-          not FXA5A00.Result_Within_Range(GEF.Sin(0.35), 0.343, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Sin(1.18), 0.924, 0.001)
-       then
-          Report.Failed("Incorrect value returned from Sin function when " &
-                        "the expected result is between 0.0 and 1.0");
-       end if;
- 
- 
-       -- Test of Sin with expected result value between -1.0 and 0.0.
- 
-       if not (GEF.Sin (-Ada.Numerics.Pi/4.0) > -1.0)                    or
-          not ( EF.Sin (-Ada.Numerics.Pi/4.0) > -1.0)                    or
-          not FXA5A00.Result_Within_Range(GEF.Sin(-0.24), -0.238, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Sin(-1.00), -0.841, 0.001)
-       then
-          Report.Failed("Incorrect value returned from Sin function when " &
-                        "the expected result is between -1.0 and 0.0");
-       end if;
- 
- 
-       -- Testing of the Sin function with Cycle parameter.
-  
-       -- Check that Argument_Error is raised when the value of the Cycle
-       -- parameter is zero.
- 
-       begin 
-          New_Float_Result := GEF.Sin (X => 1.0, Cycle => 0.0);
-          Report.Failed("Argument_Error not raised by GEF.Sin function " &
-                        "when the Cycle parameter is zero");
-          Dont_Optimize_New_Float(New_Float_Result, 3);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by GEF.Sin function " &
-                           "when the Cycle parameter is zero");
-       end;
- 
-       begin 
-          The_Result := EF.Sin (X => 0.34, Cycle => 0.0);
-          Report.Failed("Argument_Error not raised by EF.Sin function when " &
-                        "the Cycle parameter is zero");
-          Dont_Optimize_Float(The_Result, 4);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by EF.Sin function " &
-                           "when the Cycle parameter is zero");
-       end;
- 
-       -- Check that Argument_Error is raised when the value of the Cycle
-       -- parameter is negative.
- 
-       begin 
-          New_Float_Result := GEF.Sin (X => 0.45, Cycle => -1.0);
-          Report.Failed("Argument_Error not raised by GEF.Sin function " &
-                        "when the Cycle parameter is negative");
-          Dont_Optimize_New_Float(New_Float_Result, 5);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by GEF.Sin function " &
-                           "when the Cycle parameter is negative");
-       end;
- 
-       begin 
-          The_Result := EF.Sin (X => 0.10, Cycle => -4.0);
-          Report.Failed("Argument_Error not raised by EF.Sin function when " &
-                        "the Cycle parameter is negative");
-          Dont_Optimize_Float(The_Result, 6);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by EF.Sin function " &
-                           "when the Cycle parameter is negative");
-       end;
- 
- 
-       -- Check that no exception occurs on computing the Sin with very
-       -- large (positive and negative) input values and Cycle parameter.
- 
-       begin 
-          New_Float_Result := GEF.Sin (New_Float(FXA5A00.Large), 360.0);
-          Dont_Optimize_New_Float(New_Float_Result, 7);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Sin with large " &
-                          "positive value and Cycle parameter");
-       end;
- 
-       begin 
-          The_Result := EF.Sin (FXA5A00.Minus_Large, 720.0);
-          Dont_Optimize_Float(The_Result, 8);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Sin with large " &
-                          "negative value and Cycle parameter");
-       end;
- 
- 
-       -- Test of Sin with Cycle parameter for prescribed result at zero.
- 
-       if GEF.Sin (0.0, 360.0) /= 0.0 or
-           EF.Sin (0.0, 180.0) /= 0.0
-       then
-          Report.Failed("Incorrect value returned from Sin function with " &
-                        "cycle parameter for a zero input parameter value");
-       end if;
- 
- 
-       -- Tests of Sin function with Cycle parameter for prescribed results.
- 
-       if GEF.Sin(0.0,   360.0) /=  0.0 or 
-           EF.Sin(180.0, 360.0) /=  0.0 or
-          GEF.Sin(90.0,  360.0) /=  1.0 or 
-           EF.Sin(450.0, 360.0) /=  1.0 or 
-          GEF.Sin(270.0, 360.0) /= -1.0 or 
-           EF.Sin(630.0, 360.0) /= -1.0    
-       then
-          Report.Failed("Incorrect result from the Sin function with " &
-                        "various cycle values for prescribed results");
-       end if;
- 
- 
-       -- Testing of Sinh Function, both instantiated and pre-instantiated
-       -- version.
-       
-       -- Test for Constraint_Error on parameter with large positive magnitude.
- 
-       begin
- 
-          if New_Float'Machine_Overflows then
-             New_Float_Result := GEF.Sinh (New_Float(FXA5A00.Large));
-             Report.Failed("Constraint_Error not raised when the GEF.Sinh " &
-                           "function is provided a parameter with a large " &
-                           "positive value");
-             Dont_Optimize_New_Float(New_Float_Result, 9);
-          end if;
- 
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Constraint_Error not raised when the GEF.Sinh " &
-                           "function is provided a parameter with a large " &
-                           "positive value");
-       end;
- 
-       -- Test for Constraint_Error on parameter with large negative magnitude.
- 
-       begin 
- 
-          if Float'Machine_Overflows then
-             The_Result := EF.Sinh (FXA5A00.Minus_Large);
-             Report.Failed("Constraint_Error not raised when the EF.Sinh " &
-                           "function is provided a parameter with a "      &
-                           "large negative value");
-             Dont_Optimize_Float(The_Result, 10);
-          end if;
- 
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Constraint_Error not raised when the EF.Sinh " &
-                           "function is provided a parameter with a "      &
-                           "large negative value");
-       end;
- 
- 
-       -- Test that no exception occurs when the Sinh function is provided a
-       -- very small positive or negative value.
- 
-       begin 
-          New_Float_Result := GEF.Sinh (New_Float(FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 11);
-       exception
-          when others =>
-             Report.Failed("Unexpected exception on GEF.Sinh with a very" &
-                           "small positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Sinh (-FXA5A00.Small);
-          Dont_Optimize_Float(The_Result, 12);
-       exception
-          when others =>
-             Report.Failed("Unexpected exception on EF.Sinh with a very" &
-                           "small negative value");
-       end;
- 
- 
-       -- Test for prescribed 0.0 result of Function Sinh with 0.0 parameter.
- 
-       if GEF.Sinh (0.0) /= 0.0 or
-           EF.Sinh (0.0) /= 0.0
-       then
-          Report.Failed("Incorrect value returned from Sinh(0.0)");
-       end if;
- 
- 
-       -- Test of Sinh function with various input parameters.
- 
-       if not FXA5A00.Result_Within_Range(GEF.Sinh(0.01),  0.010, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Sinh(0.61),  0.649, 0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Sinh(1.70),  2.65,  0.01) or
-          not FXA5A00.Result_Within_Range( EF.Sinh(3.15), 11.65,  0.01) 
-       then 
-          Report.Failed("Incorrect result returned from Sinh function " &
-                        "with various input parameters");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,328 ****
- -- CXA5A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions Cos and Cosh provide correct results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Cos and Cosh resulting from
- --      the instantiation of the Ada.Numerics.Generic_Elementary_Functions
- --      with type derived from type Float, as well as the pre-instantiated 
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A02.A
- --
- --
- -- CHANGE HISTORY:
- --      09 Mar 95   SAIC    Initial prerelease version.
- --      03 Apr 95   SAIC    Removed reference to derived type.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      28 Feb 97   PWB.CTA Removed checks specifying Cycle => 2.0 * Pi
- --      26 Jun 98   EDS     Protected exception checks by first testing
- --                          for 'Machine_Overflows.  Removed code deleted
- --                          by comment.
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks have been deleted.
- --!
- 
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A02 is
- begin
- 
-    Report.Test ("CXA5A02", "Check that the functions Cos and Cosh provide " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       The_Result       : Float;
-       New_Float_Result : New_Float;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Cos Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that no exception occurs on computing the Cos with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Cos (New_Float(FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Cos with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Cos (FXA5A00.Minus_Large);
-          Dont_Optimize_Float(The_Result, 2);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Cos with large " &
-                          "negative value");
-       end;
- 
- 
-       -- Test of Cos for prescribed result at zero.
- 
-       if GEF.Cos (0.0) /= 1.0 or
-           EF.Cos (0.0) /= 1.0
-       then
-          Report.Failed("Incorrect value returned from Cos(0.0)");
-       end if;
- 
- 
-       -- Test of Cos with expected result value between 1.0 and -1.0.
- 
-       if not (Result_Within_Range( EF.Cos(Ada.Numerics.Pi/3.0),
-                                           0.500, 
-                                           0.001)                       and
-               Result_Within_Range(GEF.Cos(0.6166), 0.816, 0.001)       and
-               Result_Within_Range(GEF.Cos(0.1949), 0.981, 0.001)       and
-               Result_Within_Range( EF.Cos(Ada.Numerics.Pi/2.0),
-                                           0.00,
-                                           0.001)                       and
-               Result_Within_Range( EF.Cos(2.0*Ada.Numerics.Pi/3.0),
-                                           -0.500,
-                                           0.001)                       and
-               Result_Within_Range(GEF.Cos(New_Float(Ada.Numerics.Pi)),
-                                           -1.00,
-                                            0.001))
-       then
-          Report.Failed("Incorrect value returned from Cos function when " &
-                        "the expected result is between 1.0 and -1.0");
-       end if;
- 
- 
-       -- Testing of the Cos function with Cycle parameter.
- 
-       -- Check that Argument_Error is raised when the value of the Cycle
-       -- parameter is zero.
- 
-       begin 
-          New_Float_Result := GEF.Cos (X => 1.0, Cycle => 0.0);
-          Report.Failed("Argument_Error not raised by GEF.Cos function " &
-                        "when the Cycle parameter is zero");
-          Dont_Optimize_New_Float(New_Float_Result, 3);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by GEF.cos function " &
-                           "when the Cycle parameter is zero");
-       end;
- 
-       begin 
-          The_Result := EF.Cos (X => 0.55, Cycle => 0.0);
-          Report.Failed("Argument_Error not raised by EF.Cos function when " &
-                        "the Cycle parameter is zero");
-          Dont_Optimize_Float(The_Result, 4);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by EF.Cos function " &
-                           "when the Cycle parameter is zero");
-       end;
- 
-       -- Check that Argument_Error is raised when the value of the Cycle
-       -- parameter is negative.
- 
-       begin 
-          New_Float_Result := GEF.Cos (X => 0.45, Cycle => -2.0*Pi);
-          Report.Failed("Argument_Error not raised by GEF.Cos function " &
-                        "when the Cycle parameter is negative");
-          Dont_Optimize_New_Float(New_Float_Result, 5);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by GEF.Cos function " &
-                           "when the Cycle parameter is negative");
-       end;
- 
-       begin 
-          The_Result := EF.Cos (X => 0.10, Cycle => -Pi/2.0);
-          Report.Failed("Argument_Error not raised by EF.Cos function when " &
-                        "the Cycle parameter is negative");
-          Dont_Optimize_Float(The_Result, 6);
-       exception
-          when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by EF.Cos function " &
-                           "when the Cycle parameter is negative");
-       end;
- 
-       -- Test of Cos with Cycle parameter for prescribed result at zero.
- 
-       if GEF.Cos (0.0, 360.0) /= 1.0 or
-           EF.Cos (0.0, 360.0) /= 1.0
-       then
-          Report.Failed("Incorrect value returned from Cos function with " &
-                        "cycle parameter for a zero input parameter value");
-       end if;
- 
- 
-       -- Tests of Cos function with specified Cycle, using various input
-       -- parameter values for prescribed results.
- 
-       if GEF.Cos(0.0,   360.0) /=  1.0 or 
-           EF.Cos(360.0, 360.0) /=  1.0 or 
-          GEF.Cos(90.0,  360.0) /=  0.0 or 
-           EF.Cos(270.0, 360.0) /=  0.0 or 
-          GEF.Cos(180.0, 360.0) /= -1.0 or 
-           EF.Cos(540.0, 360.0) /= -1.0    
-       then
-          Report.Failed("Incorrect result from the Cos function with " &
-                        "specified cycle for prescribed results");
-       end if;
- 
- 
- 
-       -- Testing of Cosh Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Test for Constraint_Error on parameter with large positive magnitude.
- 
-       begin
- 
-          if New_Float'Machine_Overflows then
- 
-             New_Float_Result := GEF.Cosh (New_Float(FXA5A00.Large));
-             Report.Failed("Constraint_Error not raised when the GEF.Cosh " &
-                           "function is provided a parameter with a large " &
-                           "positive value");
-             Dont_Optimize_New_Float(New_Float_Result, 9);
-          end if;
- 
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Constraint_Error not raised when the GEF.Cosh " &
-                           "function is provided a parameter with a large " &
-                           "positive value");
-       end;
- 
-       -- Test for Constraint_Error on parameter with large negative magnitude.
- 
-       begin
- 
-          if Float'Machine_Overflows then
-             The_Result := EF.Cosh (FXA5A00.Minus_Large);
-             Report.Failed("Constraint_Error not raised when the EF.Cosh " &
-                           "function is provided a parameter with a "      &
-                           "large negative value");
-             Dont_Optimize_Float(The_Result, 10);
-          end if;
- 
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Constraint_Error not raised when the EF.Cosh " &
-                           "function is provided a parameter with a "      &
-                           "large negative value");
-       end;
- 
- 
-       -- Test that no exception occurs when the Cosh function is provided a
-       -- very small positive or negative value.
- 
-       begin 
-          New_Float_Result := GEF.Cosh (New_Float(FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 11);
-       exception
-          when others =>
-             Report.Failed("Unexpected exception on GEF.Cosh with a very" &
-                           "small positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Cosh (-FXA5A00.Small);
-          Dont_Optimize_Float(The_Result, 12);
-       exception
-          when others =>
-             Report.Failed("Unexpected exception on EF.Cosh with a very" &
-                           "small negative value");
-       end;
- 
- 
-       -- Test for prescribed 1.0 result of Function Cosh with 0.0 parameter.
- 
-       if GEF.Cosh (0.0) /= 1.0 or
-           EF.Cosh (0.0) /= 1.0
-       then
-          Report.Failed("Incorrect value returned from Cosh(0.0)");
-       end if;
- 
- 
-       -- Test of Cosh function with various input parameters.
- 
-       if not FXA5A00.Result_Within_Range(GEF.Cosh(0.24), 1.029, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Cosh(0.59), 1.179, 0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Cosh(1.06), 1.616, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Cosh(1.50), 2.352, 0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Cosh(1.84), 3.228, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Cosh(3.40), 14.99, 0.01) 
-       then
-          Report.Failed("Incorrect result from Cosh function with " &
-                        "various input parameters");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,426 ****
- -- CXA5A03.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions Tan, Tanh, and Arctanh provide correct 
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Tan, Tanh, and Arctanh 
- --      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
- --      with a type derived from type Float, as well as the preinstantiated 
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A03.A
- --
- --
- -- CHANGE HISTORY:
- --      14 Mar 95   SAIC    Initial prerelease version.
- --      06 Apr 95   SAIC    Corrected errors in context clause references
- --                          and usage of Cycle parameter.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      29 Jun 98   EDS     Protected exception tests by first testing
- --                          for 'Machine_Overflows
- --
- --!
- 
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A03 is
- begin
- 
-    Report.Test ("CXA5A03", "Check that the functions Tan, Tanh, and " &
-                            "Arctanh provide correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       The_Result       : Float;
-       New_Float_Result : New_Float;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Tan Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that no exception occurs on computing the Tan with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Tan with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Tan (FXA5A00.Minus_Large);
-          Dont_Optimize_Float(The_Result, 2);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Tan with large " &
-                          "negative value");
-       end;
- 
- 
-       -- Check that no exception occurs on computing the Tan with very
-       -- small (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Tan (New_Float(FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 3);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Tan with small " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Tan (-FXA5A00.Small);
-          Dont_Optimize_Float(The_Result, 4);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Tan with small " &
-                          "negative value");
-       end;
- 
- 
-       -- Check prescribed result from Tan function.  When the parameter X 
-       -- has the value zero, the Tan function yields a result of zero.
- 
-       if GEF.Tan(0.0) /= 0.0 or
-           EF.Tan(0.0) /= 0.0 
-       then
-          Report.Failed("Incorrect result from Tan function with zero " &
-                        "value input parameter");
-       end if;
- 
-  
-       -- Check the results of the Tan function with various input parameters.
- 
-       if not (Result_Within_Range(GEF.Tan(0.7854), 1.0,   0.001)  and
-               Result_Within_Range(GEF.Tan(0.8436), 1.124, 0.001)  and
-               Result_Within_Range( EF.Tan(Pi),     0.0,   0.001)  and
-               Result_Within_Range( EF.Tan(-Pi),    0.0,   0.001)  and 
-               Result_Within_Range(GEF.Tan(0.5381), 0.597, 0.001)  and
-               Result_Within_Range( EF.Tan(0.1978), 0.200, 0.001))
-       then
-          Report.Failed("Incorrect result from Tan function with various " &
-                        "input parameters");
-       end if;
- 
-  
-       -- Testing of Tan function with cycle parameter.
- 
-       -- Check that Constraint_Error is raised by the Tan function with 
-       -- specified cycle, when the value of the parameter X is an odd
-       -- multiple of the quarter cycle.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Tan(270.0, 360.0);                  
-             Report.Failed("Constraint_Error not raised by GEF.Tan on odd " &
-                           "multiple of the quarter cycle");
-             Dont_Optimize_New_Float(New_Float_Result, 5);
-          exception
-             when Constraint_Error => null; -- OK, expected exception.
-             when others =>
-             Report.Failed("Unexpected exception raised by GEF.Tan on odd " &
-                           "multiple of the quarter cycle");
-          end;
-       end if;
- 
-       -- Check that the exception Numerics.Argument_Error is raised, when
-       -- the value of the parameter Cycle is zero or negative.
- 
-       begin
-          New_Float_Result := GEF.Tan(X => 1.0, Cycle => -360.0);
-          Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " &
-                        "parameter has negative value");
-          Dont_Optimize_New_Float(New_Float_Result, 6);
-       exception
-          when Argument_Error => null; -- OK, expected exception.
-          when others =>
-          Report.Failed("Unexpected exception raised by GEF.Tan when Cycle " &
-                        "parameter has negative value");
-       end;
- 
-       begin
-          The_Result := EF.Tan(1.0, Cycle => 0.0);                 
-          Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " &
-                        "parameter has a zero value");
-          Dont_Optimize_Float(The_Result, 7);
-       exception
-          when Argument_Error => null; -- OK, expected exception.
-          when others =>
-          Report.Failed("Unexpected exception raised by EF.Tan when Cycle " &
-                        "parameter has a zero value");
-       end;
- 
- 
-       -- Check that no exception occurs on computing the Tan with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large), 360.0);
-          Dont_Optimize_New_Float(New_Float_Result, 8);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Tan with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Tan (FXA5A00.Minus_Large, Cycle => 360.0);
-          Dont_Optimize_Float(The_Result, 9);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Tan with large " &
-                          "negative value");
-       end;
- 
- 
-       -- Check prescribed result from Tan function with Cycle parameter.  
- 
-       if GEF.Tan(0.0, 360.0)          /= 0.0 or
-           EF.Tan(0.0, Cycle => 360.0) /= 0.0 
-       then
-          Report.Failed("Incorrect result from Tan function with cycle " &
-                        "parameter, using a zero value input parameter");
-       end if;
- 
- 
-       -- Check the Tan function, with specified Cycle parameter, with a 
-       -- variety of input parameters.
- 
-       if not Result_Within_Range(GEF.Tan(30.0,  360.0),  0.577, 0.001) or 
-          not Result_Within_Range( EF.Tan(57.0,  360.0),  1.540, 0.001) or 
-          not Result_Within_Range(GEF.Tan(115.0, 360.0), -2.145, 0.001) or 
-          not Result_Within_Range( EF.Tan(299.0, 360.0), -1.804, 0.001) or 
-          not Result_Within_Range(GEF.Tan(390.0, 360.0),  0.577, 0.001) or 
-          not Result_Within_Range( EF.Tan(520.0, 360.0), -0.364, 0.001)
-       then
-          Report.Failed("Incorrect result from the Tan function with "   &
-                        "cycle parameter, with various input parameter " &
-                        "values");
-       end if;
- 
-       
- 
-       -- Testing of Tanh Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that no exception occurs on computing the Tan with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Tanh (New_Float(FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 10);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Tanh with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Tanh (FXA5A00.Minus_Large);
-          Dont_Optimize_Float(The_Result, 11);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Tanh with large " &
-                          "negative value");
-       end;
- 
- 
-       -- Check for prescribed result of Tanh with zero value input parameter.   
- 
-       if GEF.Tanh (0.0) /= 0.0 or
-           EF.Tanh (0.0) /= 0.0
-       then 
-          Report.Failed("Incorrect result from Tanh with zero parameter");
-       end if;
- 
- 
-       -- Check the results of the Tanh function with various input 
-       -- parameters.
- 
-       if not (FXA5A00.Result_Within_Range(GEF.Tanh(2.99),   0.995, 0.001)  and
-               FXA5A00.Result_Within_Range(GEF.Tanh(0.130),  0.129, 0.001)  and
-               FXA5A00.Result_Within_Range( EF.Tanh(Pi),     0.996, 0.001)  and
-               FXA5A00.Result_Within_Range( EF.Tanh(-Pi),   -0.996, 0.001)  and
-               FXA5A00.Result_Within_Range(GEF.Tanh(0.60),   0.537, 0.001)  and
-               FXA5A00.Result_Within_Range( EF.Tanh(1.04),   0.778, 0.001)  and
-               FXA5A00.Result_Within_Range(GEF.Tanh(1.55),   0.914, 0.001)  and
-               FXA5A00.Result_Within_Range( EF.Tanh(-2.14), -0.973, 0.001))
-       then
-          Report.Failed("Incorrect result from Tanh function with various " &
-                        "input parameters");
-       end if;
- 
-  
- 
-       -- Testing of Arctanh Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Constraint_Error is raised by the Arctanh function
-       -- when the absolute value of the parameter X is one.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Arctanh(X =>  1.0);
-             Report.Failed("Constraint_Error not raised by Function Arctanh " &
-                           "when provided a parameter value of 1.0");
-             Dont_Optimize_New_Float(New_Float_Result, 12);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by Function Arctanh "
-                              & "when provided a parameter value of 1.0");
-          end;
-       end if;
- 
-       if Float'Machine_Overflows = True then
-          begin
-             The_Result := EF.Arctanh(-1.0);
-             Report.Failed("Constraint_Error not raised by Function Arctanh " &
-                           "when provided a parameter value of -1.0");
-             Dont_Optimize_Float(The_Result, 13);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by Function Arctanh "
-                              & "when provided a parameter value of -1.0");
-          end;
-       end if;
- 
-       -- Check that Function Arctanh raises Argument_Error when the absolute
-       -- value of the parameter X exceeds one.
- 
-       begin
-          New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.One_Plus_Delta));
-          Report.Failed("Argument_Error not raised by Function Arctanh " &
-                        "when provided a parameter value greater than 1.0");
-          Dont_Optimize_New_Float(New_Float_Result, 14);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Unexpected exception raised by Function Arctanh " &
-                           "when provided a parameter value greater than 1.0");
-       end;
- 
-  
-       begin
-          The_Result := EF.Arctanh(FXA5A00.Minus_One_Minus_Delta);
-          Report.Failed("Argument_Error not raised by Function Arctanh " &
-                        "when provided a parameter value less than -1.0");
-          Dont_Optimize_Float(The_Result, 15);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Unexpected exception raised by Function Arctanh " &
-                           "when provided a parameter value less than -1.0");
-       end;
- 
- 
-       begin
-          New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.Large));
-          Report.Failed("Argument_Error not raised by Function Arctanh " &
-                        "when provided a large positive parameter value");
-          Dont_Optimize_New_Float(New_Float_Result, 16);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Unexpected exception raised by Function Arctanh " &
-                           "when provided a large positive parameter value");
-       end;
- 
-  
-       begin
-          The_Result := EF.Arctanh(FXA5A00.Minus_Large);
-          Report.Failed("Argument_Error not raised by Function Arctanh " &
-                        "when provided a large negative parameter value");
-          Dont_Optimize_Float(The_Result, 17);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Unexpected exception raised by Function Arctanh " &
-                           "when provided a large negative parameter value");
-       end;
- 
- 
-       -- Prescribed results for Function Arctanh with zero input value.
- 
-       if GEF.Arctanh(0.0) /= 0.0 or
-           EF.Arctanh(0.0) /= 0.0
-       then
-          Report.Failed("Incorrect result from Function Arctanh with a " &
-                        "parameter value of zero");
-       end if;
- 
-  
-       -- Check the results of the Arctanh function with various input 
-       -- parameters.
- 
-       if not (Result_Within_Range(GEF.Arctanh(0.15), 0.151, 0.001)  and
-               Result_Within_Range( EF.Arctanh(0.44), 0.472, 0.001)  and
-               Result_Within_Range(GEF.Arctanh(0.81), 1.127, 0.001)  and
-               Result_Within_Range( EF.Arctanh(0.99), 2.647, 0.001))
-       then
-          Report.Failed("Incorrect result from Arctanh function with " &
-                        "various input parameters");
-       end if;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a	Thu Jan  1 00:00:00 1970
***************
*** 1,434 ****
- -- CXA5A04.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions Cot, Coth, and Arccoth provide correct 
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Cot, Coth, and Arccoth 
- --      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
- --      with a type derived from type Float, as well as the preinstantiated 
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A04.A
- --
- --
- -- CHANGE HISTORY:
- --      15 Mar 95   SAIC    Initial prerelease version.
- --      07 Apr 95   SAIC    Corrected errors in context clause reference, 
- --                          added trigonometric relationship checks.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      28 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
- --      29 Jun 98   EDS     Protected exception tests by first testing
- --                          for 'Machine_Overflows
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- with Ada.Exceptions;
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A04 is
- begin
- 
-    Report.Test ("CXA5A04", "Check that the functions Cot, Coth, and " &
-                            "Arccoth provide correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       The_Result       : Float;
-       New_Float_Result : New_Float;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Cot Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Constraint_Error is raised with the Cot function is
-       -- given a parameter input value of 0.0.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Cot (0.0);
-             Report.Failed("Constraint_Error not raised by Function Cot " &
-                           "when provided a zero input parameter value");
-             Dont_Optimize_New_Float(New_Float_Result, 1);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           => 
-             Report.Failed("Unexpected exception raised by Function Cot " &
-                           "when provided a zero input parameter value");
-          end;
-       end if;
- 
-       -- Check that no exception occurs on computing the Cot with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Cot (New_Float(FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 2);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on GEF.Cot with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Cot (FXA5A00.Minus_Large);
-          Dont_Optimize_Float(The_Result, 3);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Cot with large " &
-                          "negative value");
-       end;
- 
- 
-       -- Check the results of the Cot function with various input parameters.
- 
-       if not (FXA5A00.Result_Within_Range(GEF.Cot(Pi/4.0),     1.0, 0.001) and
-               FXA5A00.Result_Within_Range( EF.Cot(Pi/2.0),     0.0, 0.001) and
-               FXA5A00.Result_Within_Range(GEF.Cot(3.0*Pi/4.0),-1.0, 0.001) and
-               FXA5A00.Result_Within_Range( EF.Cot(3.0*Pi/2.0), 0.0, 0.001))
-       then
-          Report.Failed("Incorrect result from Cot function with various " &
-                        "input parameters");
-       end if;
- 
-  
-       -- Check the results of the Cot function against the results of 
-       -- various trigonometric relationships.
- 
-       if not FXA5A00.Result_Within_Range(GEF.Cot(New_Float(Pi/4.0)),
-                                          1.0/EF.Tan(Pi/4.0),
-                                          0.001)           or
-          not FXA5A00.Result_Within_Range(EF.Cot(Pi/4.0),
-                                          EF.Cos(Pi/4.0)/EF.Sin(Pi/4.0),
-                                          0.001) or
-          not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(Pi/4.0)),
-                                          Pi/4.0,
-                                          0.001) 
-       then
-          Report.Failed("Incorrect result from Cot function with respect " &
-                        "to various trigonometric relationship expected "  &
-                        "results");
-       end if;
- 
- 
-       -- Testing of Cot with Cycle parameter.
- 
-       -- Check that Argument_Error is raised by the Cot function when the
-       -- value of the Cycle parameter is zero or negative.
- 
-       begin
-          New_Float_Result := GEF.Cot (1.0, Cycle => 0.0);
-          Report.Failed("Argument_Error not raised by the Cot Function " &
-                        "with a specified cycle value of 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 4);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed
-               ("Unexpected exception raised by the Cot Function with " &
-                "a specified cycle value of 0.0");
-       end;
- 
-       begin
-          The_Result := EF.Cot (X => 1.0, Cycle => -360.0);
-          Report.Failed("Argument_Error not raised by the Cot Function " &
-                        "with a specified cycle value of -360.0");
-          Dont_Optimize_Float(The_Result, 5);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed
-               ("Unexpected exception raised by the Cot Function with " &
-                "a specified cycle value of -360.0");
-       end;
- 
- 
-       -- Check that Constraint_Error is raised by the Cot Function with
-       -- specified cycle, when the value of the parameter X is 0.0.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Cot (0.0, 360.0);
-             Report.Failed("Constraint_Error not raised by Function Cot "   &
-                           "with specified cycle, when value of parameter " &
-                           "X is 0.0");
-             Dont_Optimize_New_Float(New_Float_Result, 6);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by Function Cot "   &
-                              "with specified cycle, when value of parameter " &
-                              "X is 0.0");
-          end;
-       end if;
- 
-       -- Check that Constraint_Error is raised by the Cot Function with
-       -- specified cycle, when the value of the parameter X is a multiple
-       -- of the half cycle.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Cot (180.0, 360.0);
-             Report.Failed("Constraint_Error not raised by Function Cot "   &
-                           "with specified cycle, when value of parameter " &
-                           "X is a multiple of the half cycle (180.0, 360.0)");
-             Dont_Optimize_New_Float(New_Float_Result, 7);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by Function Cot "   &
-                              "with specified cycle, when value of parameter " &
-                              "X is a multiple of the half cycle" & 
-                              " (180.0, 360.0)");
-          end;
-       end if;
- 
-       if Float'Machine_Overflows = True then
-          begin
-             The_Result := EF.Cot (540.0, 360.0);
-             Report.Failed("Constraint_Error not raised by Function Cot "   &
-                           "with specified cycle, when value of parameter " &
-                           "X is a multiple of the half cycle (540.0, 360.0)");
-             Dont_Optimize_Float(The_Result, 8);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by Function Cot "   &
-                              "with specified cycle, when value of parameter " &
-                              "X is a multiple of the half cycle (540.0, 360.0)");
-          end;
-       end if;      
-       
- --pwb-math      -- Check that no exception occurs on computing the Cot with very
- --pwb-math      -- large (positive and negative) input values.
- --pwb-math
- --pwb-math      begin 
- --pwb-math         New_Float_Result := GEF.Cot (New_Float(FXA5A00.Large), 2.0*Pi);
- --pwb-math         Dont_Optimize_New_Float(New_Float_Result, 9);
- --pwb-math      exception
- --pwb-math         when others =>
- --pwb-math           Report.Failed("Unexpected exception on GEF.Cot with large " &
- --pwb-math                         "positive value");
- --pwb-math      end;
- --pwb-math
- --pwb-math      begin 
- --pwb-math         The_Result := EF.Cot (FXA5A00.Minus_Large, Cycle => 2.0*Pi);
- --pwb-math         Dont_Optimize_Float(The_Result, 10);
- --pwb-math      exception
- --pwb-math         when others =>
- --pwb-math           Report.Failed("Unexpected exception on EF.Cot with large " &
- --pwb-math                         "negative value");
- --pwb-math      end;
- --pwb-math
- --pwb-math
- --pwb-math      -- Check prescribed result from Cot function with Cycle parameter.  
- --pwb-math
- --pwb-math      if not FXA5A00.Result_Within_Range
- --pwb-math               (GEF.Cot(New_Float(FXA5A00.Half_Pi), 2.0*Pi), 0.0, 0.001) or
- --pwb-math         not FXA5A00.Result_Within_Range
- --pwb-math               (EF.Cot(3.0*Pi/2.0, Cycle => 2.0*Pi), 0.0, 0.001)
- --pwb-math      then
- --pwb-math         Report.Failed("Incorrect result from Cot function with cycle " &
- --pwb-math                       "parameter, using a multiple of Pi/2 as the "    &
- --pwb-math                       "input parameter");
- --pwb-math      end if;
- 
- 
-       -- Testing of Coth Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that no exception occurs on computing the Coth with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          The_Result := EF.Coth (FXA5A00.Large);
-          if The_Result > 1.0 then
-             Report.Failed("Result of Coth function with large positive " &
-                           "value greater than 1.0");
-          end if;
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Coth with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Coth (FXA5A00.Minus_Large);
-          if The_Result < -1.0 then
-             Report.Failed("Result of Coth function with large negative " &
-                           "value less than -1.0");
-          end if;
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on EF.Coth with large " &
-                          "negative value");
-       end;
- 
- 
-       -- Check that Constraint_Error is raised by the Coth function, when
-       -- the value of the parameter X is 0.0.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Coth (X => 0.0);
-             Report.Failed("Constraint_Error not raised by the Coth function " &
-                           "when the value of parameter X is 0.0");
-             Dont_Optimize_New_Float(New_Float_Result, 11);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by the Coth " &
-                              "function when the value of parameter X is 0.0");
-          end;
-       end if;
- 
- 
-       -- Testing of Arccoth Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Constraint_Error is raised by the Arccoth function
-       -- when the absolute value of the parameter X is 1.0.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Arccoth (X => 1.0);
-             Report.Failed("Constraint_Error not raised by the Arccoth " &
-                           "function when the value of parameter X is 1.0");
-             Dont_Optimize_New_Float(New_Float_Result, 12);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by the Arccoth " &
-                              "function when the value of parameter X is 1.0");
-          end;
-       end if;
-       
-       if Float'Machine_Overflows = True then
-          begin
-             The_Result := EF.Arccoth (-1.0);
-             Report.Failed("Constraint_Error not raised by the Arccoth " &
-                           "function when the value of parameter X is -1.0");
-             Dont_Optimize_Float(The_Result, 13);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by the Arccoth " &
-                              "function when the value of parameter X is -1.0");
-          end;
-       end if;
- 
-       -- Check that Argument_Error is raised by the Arccoth function when
-       -- the absolute value of the parameter X is less than 1.0.
- 
-       begin
-          New_Float_Result := GEF.Arccoth (X => New_Float(One_Minus_Delta));
-          Report.Failed("Argument_Error not raised by the Arccoth " &
-                        "function with parameter value less than 1.0");
-          Dont_Optimize_New_Float(New_Float_Result, 14);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccoth " &
-                           "function with parameter value less than 1.0");
-       end;
- 
-       begin
-          The_Result := EF.Arccoth (X => FXA5A00.Minus_One_Plus_Delta);
-          Report.Failed("Argument_Error not raised by the Arccoth function " &
-                        "with parameter value between 0.0 and -1.0");
-          Dont_Optimize_Float(The_Result, 15);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccoth " &
-                           "function with parameter value between 0.0 "  &
-                           "and -1.0");
-       end;
- 
- 
-       -- Check the results of the Arccoth function with various input 
-       -- parameters.
- 
-       if not (Result_Within_Range(GEF.Arccoth(1.01), 2.652, 0.01)  and
-               Result_Within_Range( EF.Arccoth(1.25), 1.099, 0.01)  and
-               Result_Within_Range(GEF.Arccoth(1.56), 0.760, 0.001) and
-               Result_Within_Range( EF.Arccoth(1.97), 0.560, 0.001) and
-               Result_Within_Range(GEF.Arccoth(2.40), 0.444, 0.001) and
-               Result_Within_Range( EF.Arccoth(4.30), 0.237, 0.001) and
-               Result_Within_Range(GEF.Arccoth(5.80), 0.174, 0.001) and
-               Result_Within_Range( EF.Arccoth(7.00), 0.144, 0.001))
-       then
-          Report.Failed("Incorrect result from Arccoth function with various " &
-                        "input parameters");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A04;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a	Thu Jan  1 00:00:00 1970
***************
*** 1,338 ****
- -- CXA5A05.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions Arcsin and Arcsinh provide correct 
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Arcsin and Arcsinh 
- --      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
- --      with a type derived from type Float, as well as the preinstantiated 
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A05.A
- --
- --
- -- CHANGE HISTORY:
- --      20 Mar 95   SAIC    Initial prerelease version.
- --      06 Apr 95   SAIC    Corrected errors in context clause reference and
- --                          use of Cycle parameter.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      28 Feb 97   PWB.CTA Removed checks with explict Cycle => 2.0*Pi
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A05 is
- begin
- 
-    Report.Test ("CXA5A05", "Check that the functions Arcsin and Arcsinh " &
-                            "provide correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       The_Result       : Float;
-       New_Float_Result : New_Float;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Function Arcsin, both instantiated and pre-instantiated
-       -- versions.
- 
-       -- Check that Argument_Error is raised by the Arcsin function when
-       -- the absolute value of the parameter X is greater than 1.0.
- 
-       begin
-          New_Float_Result := GEF.Arcsin(New_Float(FXA5A00.One_Plus_Delta));
-          Report.Failed("Argument_Error not raised by Arcsin function " &
-                        "when provided a parameter value larger than 1.0");
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by Arcsin function " &
-                           "when provided a parameter value larger than 1.0");
-       end;
- 
-       begin
-          The_Result := EF.Arcsin(FXA5A00.Minus_Large);
-          Report.Failed("Argument_Error not raised by Arcsin function " &
-                        "when provided a large negative parameter value");
-          Dont_Optimize_Float(The_Result, 2);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by Arcsin function " &
-                           "when provided a large negative parameter value");
-       end;
- 
- 
-       -- Check the prescribed result of function Arcsin with parameter 0.0.
- 
-       if GEF.Arcsin(X => 0.0) /= 0.0 or
-           EF.Arcsin(0.0)      /= 0.0
-       then
-          Report.Failed("Incorrect result from Function Arcsin when the " &
-                        "value of the parameter X is 0.0");
-       end if;
- 
- 
-       -- Check the results of the Arcsin function with various input 
-       -- parameters.
- 
-       if not Result_Within_Range(GEF.Arcsin(1.0),    1.571, 0.001) or
-          not Result_Within_Range( EF.Arcsin(0.62),   0.669, 0.001) or
-          not Result_Within_Range(GEF.Arcsin(0.01),   0.010, 0.001) or
-          not Result_Within_Range( EF.Arcsin(-0.29), -0.294, 0.001) or
-          not Result_Within_Range(GEF.Arcsin(-0.50), -0.524, 0.001) or
-          not Result_Within_Range( EF.Arcsin(-1.0),  -1.571, 0.001)
-       then
-          Report.Failed("Incorrect result from Function Arcsin with " &
-                        "various input parameters");
-       end if;
- 
- 
-       -- Testing of Function Arcsin with specified Cycle parameter.
- 
- --pwb-math      -- Check that Argument_Error is raised by the Arcsin function with 
- --pwb-math      -- specified cycle, whenever the absolute value of the parameter X 
- --pwb-math      -- is greater than 1.0.
- --pwb-math
- --pwb-math      begin
- --pwb-math         New_Float_Result := GEF.Arcsin(New_Float(FXA5A00.Large), 2.0*Pi);
- --pwb-math         Report.Failed("Argument_Error not raised by Function Arcsin " &
- --pwb-math                       "with specified cycle, when provided a large "  &
- --pwb-math                       "positive input parameter");
- --pwb-math         Dont_Optimize_New_Float(New_Float_Result, 3);
- --pwb-math      exception
- --pwb-math         when Argument_Error => null;  -- OK, expected exception.
- --pwb-math         when others         =>
- --pwb-math            Report.Failed("Unexpected exception raised by Function Arcsin " &
- --pwb-math                          "with specified cycle, when provided a large "    &
- --pwb-math                          "positive input parameter");
- --pwb-math      end;
- --pwb-math
- --pwb-math      begin
- --pwb-math         The_Result := EF.Arcsin(FXA5A00.Minus_One_Minus_Delta, 2.0*Pi);
- --pwb-math         Report.Failed("Argument_Error not raised by Function Arcsin " &
- --pwb-math                       "with specified cycle, when provided an input " &
- --pwb-math                       "parameter less than -1.0");
- --pwb-math         Dont_Optimize_Float(The_Result, 4);
- --pwb-math      exception
- --pwb-math         when Argument_Error => null;  -- OK, expected exception.
- --pwb-math         when others         =>
- --pwb-math            Report.Failed("Unexpected exception raised by Function Arcsin " &
- --pwb-math                          "with specified cycle, when provided an input "   &
- --pwb-math                          "parameter less than -1.0");
- --pwb-math      end;
- --pwb-math
-       -- Check that Argument_Error is raised by the Arcsin function with 
-       -- specified cycle, whenever the Cycle parameter is zero or negative.
- 
-       begin
-          New_Float_Result := GEF.Arcsin(2.0, 0.0);
-          Report.Failed("Argument_Error not raised by Function Arcsin " &
-                        "with specified cycle of 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 5);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by Function Arcsin " &
-                           "with specified cycle of 0.0");
-       end;
- 
-       begin
-          The_Result := EF.Arcsin(2.0, -2.0*Pi);
-          Report.Failed("Argument_Error not raised by Function Arcsin " &
-                        "with specified negative cycle parameter");
-          Dont_Optimize_Float(The_Result, 6);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by Function Arcsin " &
-                           "with specified negative cycle parameter");
-       end;
- 
- 
- --pwb-math      -- Check the prescribed result of function Arcsin with specified Cycle
- --pwb-math      -- parameter, when the value of parameter X is 0.0.
- --pwb-math
- --pwb-math      if GEF.Arcsin(X => 0.0, Cycle => 2.0*Pi) /= 0.0 or
- --pwb-math          EF.Arcsin(0.0, 2.0*Pi)               /= 0.0
- --pwb-math      then
- --pwb-math         Report.Failed("Incorrect result from Function Arcsin with " &
- --pwb-math                       "specified Cycle parameter, when the value "  &
- --pwb-math                       "of parameter X is 0.0");
- --pwb-math      end if;
- --pwb-math
- --pwb-math
- --pwb-math      -- Test of the Arcsin function with specified Cycle parameter with 
- --pwb-math      -- various input parameters.
- --pwb-math
- --pwb-math      if not FXA5A00.Result_Within_Range(GEF.Arcsin( 0.01, 2.0*Pi),  
- --pwb-math                                         0.010,
- --pwb-math                                         0.001)                    or
- --pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin( 0.14, 2.0*Pi),  
- --pwb-math                                         0.141,
- --pwb-math                                         0.001)                    or
- --pwb-math         not FXA5A00.Result_Within_Range(GEF.Arcsin( 0.37, 2.0*Pi),  
- --pwb-math                                         0.379,
- --pwb-math                                         0.001)                    or
- --pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin( 0.55, 2.0*Pi),  
- --pwb-math                                         0.582,
- --pwb-math                                         0.001)                    or
- --pwb-math         not FXA5A00.Result_Within_Range(GEF.Arcsin(-0.22, 2.0*Pi), 
- --pwb-math                                         -0.222,
- --pwb-math                                         0.001)                    or
- --pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin(-0.99, 2.0*Pi), 
- --pwb-math                                         -1.43,
- --pwb-math                                          0.01)                    or
- --pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin(1.0, 360.0), 
- --pwb-math                                         90.0,
- --pwb-math                                         0.1)                      or
- --pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin(1.0, 100.0), 
- --pwb-math                                         25.0,
- --pwb-math                                         0.1)
- --pwb-math      then
- --pwb-math         Report.Failed("Incorrect result from Arcsin with specified " &
- --pwb-math                       "cycle parameter with various input parameters");
- --pwb-math      end if;
- 
-       -- Testing of Arcsinh Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that no exception occurs on computing the Arcsinh with very
-       -- large (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Arcsinh(New_Float(FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 7);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on Arcsinh with large " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Arcsinh(FXA5A00.Minus_Large);
-          Dont_Optimize_Float(The_Result, 8);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on Arcsinh with large " &
-                          "negative value");
-       end;
- 
-  
-       -- Check that no exception occurs on computing the Arcsinh with very
-       -- small (positive and negative) input values.
- 
-       begin 
-          New_Float_Result := GEF.Arcsinh(New_Float(FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 9);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on Arcsinh with small " &
-                          "positive value");
-       end;
- 
-       begin 
-          The_Result := EF.Arcsinh(-FXA5A00.Small);
-          Dont_Optimize_Float(The_Result, 10);
-       exception
-          when others =>
-            Report.Failed("Unexpected exception on Arcsinh with small " &
-                          "negative value");
-       end;
- 
-  
-       -- Check function Arcsinh for prescribed result with parameter 0.0.
- 
-       if GEF.Arcsinh(X => 0.0) /= 0.0 or
-           EF.Arcsinh(X => 0.0) /= 0.0
-       then
-          Report.Failed("Incorrect result from Function Arcsinh when " &
-                        "provided a 0.0 input parameter");
-       end if;
- 
-  
-       -- Check the results of the Arcsinh function with various input 
-       -- parameters.
- 
-       if not Result_Within_Range(GEF.Arcsinh(0.15),  0.149, 0.001) or
-          not Result_Within_Range( EF.Arcsinh(0.82),  0.748, 0.001) or
-          not Result_Within_Range(GEF.Arcsinh(1.44),  1.161, 0.001) or
-          not Result_Within_Range(GEF.Arcsinh(6.70),  2.601, 0.001) or
-          not Result_Within_Range( EF.Arcsinh(Pi),    1.862, 0.001) or
-          not Result_Within_Range( EF.Arcsinh(-Pi),  -1.862, 0.001) or
-          not Result_Within_Range(GEF.Arcsinh(-1.0), -0.881, 0.001) or
-          not Result_Within_Range( EF.Arcsinh(-5.5), -2.406, 0.001)
-       then
-          Report.Failed("Incorrect result from Function Arcsin with " &
-                        "various input parameters");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A05;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a	Thu Jan  1 00:00:00 1970
***************
*** 1,334 ****
- -- CXA5A06.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions Arccos and Arccosh provide correct 
- --      results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Arccos and Arccosh 
- --      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
- --      with a type derived from type Float, as well as the preinstantiated 
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A06.A
- --
- --
- -- CHANGE HISTORY:
- --      27 Mar 95   SAIC    Initial prerelease version.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      28 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A06 is
- begin
- 
-    Report.Test ("CXA5A06", "Check that the functions Arccos and Arccosh " &
-                            "provide correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       The_Result       : Float;
-       New_Float_Result : New_Float;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Arccos Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Argument_Error is raised by the Arccos function when the
-       -- absolute value of the input parameter is greater than 1.0.
- 
-       begin
-          New_Float_Result := GEF.Arccos(New_Float(FXA5A00.One_Plus_Delta));
-          Report.Failed("Argument_Error not raised by the Arccos function " &
-                        "when the input parameter is greater than 1.0");
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccos "    &
-                           "function when the input parameter is greater " &
-                           "than 1.0");
-       end;
- 
-       begin
-          The_Result := EF.Arccos(-FXA5A00.Large);
-          Report.Failed("Argument_Error not raised by the Arccos function " &
-                        "when the input parameter is a large negative value");
-          Dont_Optimize_Float(The_Result, 2);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccos " &
-                           "function when the input parameter is a "    &
-                           "large negative value");
-       end;
- 
- 
-       -- Check the prescribed results of the Arccos function.
- 
-       if GEF.Arccos(X => 1.0) /= 0.0 or
-           EF.Arccos(1.0)      /= 0.0
-       then
-          Report.Failed("Incorrect result returned by the Arccos function " &
-                        "when provided a parameter value of 0.0");
-       end if;
- 
- 
-       -- Check the results of the Arccos function with various input 
-       -- parameters.
-  
-       if not Result_Within_Range(GEF.Arccos(0.77),  0.692,  0.001) or
-          not Result_Within_Range( EF.Arccos(0.37),  1.19,   0.01)  or
-          not Result_Within_Range(GEF.Arccos(0.0),   Pi/2.0, 0.01)  or
-          not Result_Within_Range( EF.Arccos(-0.11), 1.68,   0.01)  or
-          not Result_Within_Range(GEF.Arccos(-0.67), 2.31,   0.01)  or
-          not Result_Within_Range( EF.Arccos(-0.94), 2.79,   0.01)  or
-          not Result_Within_Range(GEF.Arccos(-1.0),  Pi,     0.01) 
-       then
-          Report.Failed("Incorrect result returned from the Arccos " &
-                        "function when provided a variety of input " &
-                        "parameters");
-       end if;
- 
- 
-       -- Testing of the Arccos function with specified Cycle parameter.
- 
-       -- Check that Argument_Error is raised by the Arccos function, with
-       -- specified Cycle parameter, when the absolute value of the input
-       -- parameter is greater than 1.0.
- 
-       begin
- --pwb-math: Next line: Changed 2.0*Pi to 360.0
-          New_Float_Result := GEF.Arccos(New_Float(Large), Cycle => 360.0);
-          Report.Failed("Argument_Error not raised by the Arccos function " &
-                        "with specified Cycle parameter, when the input "   &
-                        "parameter is a large positive value");
-          Dont_Optimize_New_Float(New_Float_Result, 3);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccos "     &
-                           "function with specified Cycle parameter, when " &
-                           "the input parameter is a large positive value");
-       end;
- 
-       begin
- --pwb-math: Next line: Changed 2.0*Pi to 360.0
-          The_Result := EF.Arccos(FXA5A00.Minus_One_Minus_Delta, 360.0);
-          Report.Failed("Argument_Error not raised by the Arccos function " &
-                        "with specified Cycle parameter, when the input "   &
-                        "parameter is less than -1.0");
-          Dont_Optimize_Float(The_Result, 4);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccos " &
-                           "function with specified Cycle parameter, "  &
-                           "when the input parameter is less than -1.0");
-       end;
- 
- 
-       -- Check that Argument_Error is raised by the Arccos function with
-       -- specified cycle when the value of the Cycle parameter is zero or
-       -- negative.
- 
-       begin
-          New_Float_Result := GEF.Arccos(X => 1.0, Cycle => 0.0 );
-          Report.Failed("Argument_Error not raised by the Arccos function " &
-                        "with specified Cycle parameter, when the Cycle "   &
-                        "parameter is 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 5);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccos "     &
-                           "function with specified Cycle parameter, when " &
-                           "the Cycle parameter is 0.0");
-       end;
- 
-       begin
-          The_Result := EF.Arccos(1.0, Cycle => -2.0*Pi);
-          Report.Failed("Argument_Error not raised by the Arccos function " &
-                        "with specified Cycle parameter, when the Cycle "   &
-                        "parameter is negative");
-          Dont_Optimize_Float(The_Result, 6);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccos "     &
-                           "function with specified Cycle parameter, when " &
-                           "the Cycle parameter is negative");
-       end;
- 
-       
-       -- Check the prescribed result of the Arccos function with specified
-       -- Cycle parameter.
- 
- --pwb-math: Next two lines: Changed 2.0*Pi to 360.0
-       if GEF.Arccos(X => 1.0, Cycle => 360.0) /= 0.0 or
-           EF.Arccos(1.0, 360.0)               /= 0.0
-       then 
-          Report.Failed("Incorrect result from the Arccos function with " &
-                        "specified Cycle parameter, when the input "      &
-                        "parameter value is 1.0");
-       end if;
- 
- 
-       -- Check the results of the Arccos function, with specified Cycle
-       -- parameter, with various input parameters.
-  
-       if --pwb-math not Result_Within_Range(GEF.Arccos( 0.04, 2.0*Pi), 1.53, 0.01) or
- --pwb-math         not Result_Within_Range( EF.Arccos( 0.14, 2.0*Pi), 1.43, 0.01) or
- --pwb-math         not Result_Within_Range(GEF.Arccos( 0.57, 2.0*Pi), 0.96, 0.01) or
- --pwb-math         not Result_Within_Range( EF.Arccos( 0.99, 2.0*Pi), 0.14, 0.01) or
-          not Result_Within_Range(GEF.Arccos(-1.0, 360.0), 180.0,  0.1)  or
-          not Result_Within_Range(GEF.Arccos(-1.0, 100.0),  50.0,  0.1)  or
-          not Result_Within_Range(GEF.Arccos( 0.0, 360.0),  90.0,  0.1)  or
-          not Result_Within_Range(GEF.Arccos( 0.0, 100.0),  25.0,  0.1)
-       then
-          Report.Failed("Incorrect result returned from the Arccos " &
-                        "function with specified Cycle parameter, "  &
-                        "when provided a variety of input parameters");
-       end if;
- 
- 
- 
-       -- Testing of Arccosh Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Argument_Error is raised by the Arccosh function when
-       -- the value of the parameter X is less than 1.0.
- 
-       begin 
-          New_Float_Result := GEF.Arccosh(New_Float(FXA5A00.One_Minus_Delta));
-          Report.Failed("Argument_Error not raised by the Arccosh function " &
-                        "when the parameter value is less than 1.0");
-          Dont_Optimize_New_Float(New_Float_Result, 7);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccosh " &
-                           "function when given a parameter value less " &
-                           "than 1.0");
-       end;
-                     
-       begin 
-          The_Result := EF.Arccosh(0.0);
-          Report.Failed("Argument_Error not raised by the Arccosh function " &
-                        "when the parameter value is 0.0");
-          Dont_Optimize_Float(The_Result, 8);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccosh " &
-                           "function when given a parameter value of 0.0");
-       end;
-                     
-       begin 
-          New_Float_Result := GEF.Arccosh(New_Float(-FXA5A00.Large));
-          Report.Failed("Argument_Error not raised by the Arccosh function " &
-                        "when the large negative parameter value");
-          Dont_Optimize_New_Float(New_Float_Result, 9);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Arccosh "     &
-                           "function when given a large negative parameter " & 
-                           "value");
-       end;
-                     
- 
-       -- Check the prescribed results of the Arccosh function.
- 
-       if GEF.Arccosh(X => 1.0) /= 0.0 or
-           EF.Arccosh(1.0)      /= 0.0
-       then
-          Report.Failed("Incorrect result returned by the Arccosh " &
-                        "function when provided a parameter value of 0.0");
-       end if;
- 
- 
-       -- Check the results of the Arccosh function with various input 
-       -- parameters.
-  
-       if not Result_Within_Range(GEF.Arccosh(1.03), 0.244, 0.001) or
-          not Result_Within_Range( EF.Arccosh(1.28), 0.732, 0.001) or
-          not Result_Within_Range(GEF.Arccosh(1.50), 0.962, 0.001) or
-          not Result_Within_Range( EF.Arccosh(1.77), 1.17,  0.01)  or
-          not Result_Within_Range(GEF.Arccosh(2.00), 1.32,  0.01)  or
-          not Result_Within_Range( EF.Arccosh(4.30), 2.14,  0.01)  or
-          not Result_Within_Range(GEF.Arccosh(6.90), 2.62,  0.01) 
-       then
-          Report.Failed("Incorrect result returned from the Arccosh " &
-                        "function when provided a variety of input "  &
-                        "parameters");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A06;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a	Thu Jan  1 00:00:00 1970
***************
*** 1,413 ****
- -- CXA5A07.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function Arctan provides correct results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Arctan resulting from the 
- --      instantiation of the Ada.Numerics.Generic_Elementary_Functions with 
- --      a type derived from type Float, as well as the preinstantiated 
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A07.A
- --
- --
- -- CHANGE HISTORY:
- --      04 Apr 95   SAIC    Initial prerelease version.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      28 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A07 is
- begin
- 
-    Report.Test ("CXA5A07", "Check that the Arctan function provides " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       Float_Result     : Float;
-       New_Float_Result : New_Float;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Arctan Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Argument_Error is raised by the Arctan function when
-       -- provided parameter values of 0.0, 0.0.
- 
-       begin
-          New_Float_Result := GEF.Arctan(Y => 0.0, X => 0.0);
-          Report.Failed("Argument_Error not raised when the Arctan " &
-                        "function is provided input of 0.0, 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arctan " &
-                           "function when provided 0.0, 0.0 input parameters");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arctan function when
-       -- provided a large positive or negative Y parameter value, when 
-       -- using the default value for parameter X.
- 
-       begin
-          Float_Result := EF.Arctan(Y => FXA5A00.Large);
-          Dont_Optimize_Float(Float_Result, 2);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided a large positive Y parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arctan(Y => New_Float(-FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 3);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided a large negative Y parameter value");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arctan function when
-       -- provided a small positive or negative Y parameter value, when
-       -- using the default value for parameter X.
- 
-       begin
-          Float_Result := EF.Arctan(Y => FXA5A00.Small);
-          Dont_Optimize_Float(Float_Result, 4);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided a small positive Y parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arctan(Y => New_Float(-FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 5);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided a small negative Y parameter value");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arctan function when
-       -- provided combinations of large and small positive or negative 
-       -- parameter values for both Y and X input parameters. 
- 
-       begin
-          Float_Result := EF.Arctan(Y => FXA5A00.Large, X => FXA5A00.Large);
-          Dont_Optimize_Float(Float_Result, 6);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided large positive X and Y parameter values");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arctan(New_Float(-FXA5A00.Large), 
-                                         X => New_Float(FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 7);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided a large negative Y parameter value "  &
-                           "and a small positive X parameter value");
-       end;
- 
- 
-       begin
-          Float_Result := EF.Arctan(Y => FXA5A00.Small, X => FXA5A00.Large);
-          Dont_Optimize_Float(Float_Result, 8);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided a small positive Y parameter value "  &
-                           "and a large positive X parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arctan(New_Float(-FXA5A00.Small), 
-                                         New_Float(-FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 9);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function is " &
-                           "provided a small negative Y parameter value "  &
-                           "and a large negative parameter value");
-       end;
- 
- 
-       -- Check that when the Arctan function is provided a Y parameter value
-       -- of 0.0 and a positive X parameter input value, the prescribed result
-       -- of zero is returned.
- 
-       if GEF.Arctan(Y => 0.0)                     /= 0.0 or -- Default X value
-           EF.Arctan(Y => 0.0, X => FXA5A00.Large) /= 0.0 or
- --pwb-math: Next line: changed 2.0*Pi to 360.0
-          GEF.Arctan(0.0, 360.0)                  /= 0.0 or
-           EF.Arctan(0.0, FXA5A00.Small)           /= 0.0
-       then 
-          Report.Failed("Incorrect results from the Arctan function when " &
-                        "provided a Y parameter value of 0.0 and various " &
-                        "positive X parameter values");
-       end if;
- 
- 
-       -- Check that the Arctan function provides correct results when provided
-       -- a variety of Y parameter values.  
- 
-       if not FXA5A00.Result_Within_Range(EF.Arctan(Pi),    1.26,  0.01)  or
-          not FXA5A00.Result_Within_Range(EF.Arctan(-Pi),  -1.26,  0.01)  or
-          not FXA5A00.Result_Within_Range(GEF.Arctan(1.0),  0.785, 0.001) or
-          not FXA5A00.Result_Within_Range(EF.Arctan(-1.0), -0.785, 0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Arctan(0.25), 0.245, 0.001) or
-          not FXA5A00.Result_Within_Range(EF.Arctan(0.92),  0.744, 0.001) 
-       then
-          Report.Failed("Incorrect results from the Arctan function when " &
-                        "provided a variety of Y parameter values");
-       end if;
- 
- 
- 
-       -- Check the results of the Arctan function with specified cycle
-       -- parameter.
- 
-       -- Check that the Arctan function with specified Cycle parameter 
-       -- raises Argument_Error when the value of the Cycle parameter is zero
-       -- or negative.
- 
-       begin
-          Float_Result := EF.Arctan(Y => Pi, Cycle => 0.0);  -- Default X value
-          Report.Failed("Argument_Error not raised by the Arctan function " &
-                        "with default X parameter value, when the Cycle "   &
-                        "parameter is 0.0");
-          Dont_Optimize_Float(Float_Result, 10);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arctan "      &
-                           "function with default X parameter value, when " &
-                           "provided a 0.0 cycle parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arctan(Y => Pi, X => 1.0, Cycle => 0.0);
-          Report.Failed("Argument_Error not raised by the Arctan function " &
-                        "when the Cycle parameter is 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 11);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arctan "     &
-                           "function when provided a 0.0 cycle parameter " &
-                           "value");
-       end;
- 
-       begin
-          Float_Result := EF.Arctan(Y => Pi, Cycle => -360.0); 
-          Report.Failed("Argument_Error not raised by the Arctan function " &
-                        "with a default X parameter value, when the Cycle " &
-                        "parameter is -360.0");
-          Dont_Optimize_Float(Float_Result, 12);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arctan "        &
-                           "function with a default X parameter value, when " & 
-                           "provided a -360.0 cycle parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arctan(Y => Pi, X => 1.0, Cycle => -Pi);
-          Report.Failed("Argument_Error not raised by the Arctan function " &
-                        "when the Cycle parameter is -Pi");
-          Dont_Optimize_New_Float(New_Float_Result, 13);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arctan "     &
-                           "function when provided a -Pi cycle parameter " &
-                           "value");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arctan function with 
-       -- specified Cycle parameter, when provided large and small positive
-       -- or negative parameter values for both Y and X input parameters. 
- 
-       begin
-          Float_Result := EF.Arctan(Y     => -FXA5A00.Large, 
-                                    X     => -FXA5A00.Large,
- --pwb-math: Next line: changed 2.0*Pi to 360.0
-                                    Cycle => 360.0);
-          Dont_Optimize_Float(Float_Result, 14);
-       exception
-          when others =>  
-             Report.Failed("Exception raised when the Arctan function with " &
-                           "specified Cycle parameter, when provided large " & 
-                           "negative X and Y parameter values");
-       end;
- 
- 
-       begin
-          New_Float_Result := GEF.Arctan(New_Float(FXA5A00.Large), 
-                                         X     => New_Float(-FXA5A00.Small),
- --pwb-math: Next line: changed 2.0*Pi to 360.0
-                                         Cycle => 360.0);
-          Dont_Optimize_New_Float(New_Float_Result, 15);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function with "  &
-                           "specified Cycle parameter, when provided large "  & 
-                           "positive Y parameter value and a small negative " &
-                           "X parameter value");
-       end;
- 
- 
-       begin
-          Float_Result := EF.Arctan(Y     => -FXA5A00.Small, 
-                                    X     => -FXA5A00.Large,
- --pwb-math: Next line: changed 2.0*Pi to 360.0
-                                    Cycle => 360.0);
-          Dont_Optimize_Float(Float_Result, 16);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function with "  &
-                           "specified Cycle parameter, when provided large "  & 
-                           "negative Y parameter value and a large negative " &
-                           "X parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arctan(New_Float(FXA5A00.Small), 
-                                         New_Float(FXA5A00.Large), 
- --pwb-math: Next line: changed 2.0*Pi to 360.0
-                                         360.0);
-          Dont_Optimize_New_Float(New_Float_Result, 17);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arctan function with " &
-                           "specified Cycle parameter, when provided a "     & 
-                           "small negative Y parameter value and a large "   &
-                           "positive X parameter value");
-       end;
- 
- 
-       -- Check that the Arctan function with specified Cycle parameter 
-       -- provides correct results when provided a variety of Y parameter
-       -- input values.
- 
- --pwb-math      if not FXA5A00.Result_Within_Range(EF.Arctan(Pi,    Cycle => 2.0*Pi),
- --pwb-math                                         1.26, 
- --pwb-math                                         0.01)                            or
- --pwb-math         not FXA5A00.Result_Within_Range(EF.Arctan(-Pi,   Cycle => 2.0*Pi),
- --pwb-math                                         -1.26,
- --pwb-math                                         0.01)                            or
- --pwb-math         not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 2.0*Pi),
- --pwb-math                                         0.785,
- --pwb-math                                         0.001)                           or
- --pwb-math         not FXA5A00.Result_Within_Range(EF.Arctan(-1.0,  Cycle => 2.0*Pi),
- --pwb-math                                         -0.785, 
- --pwb-math                                         0.001)                           or
- --pwb-math         not FXA5A00.Result_Within_Range(GEF.Arctan(0.16, Cycle => 2.0*Pi),
- --pwb-math                                         0.159,
- --pwb-math                                         0.001)                           or
- --pwb-math         not FXA5A00.Result_Within_Range(EF.Arctan(1.0,   Cycle => 360.0),
- --pwb-math                                         45.0,
- --pwb-math                                         0.1)                             or
- --pwb-math         not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 100.0),
- --pwb-math                                         12.5,
- --pwb-math                                         0.1) 
- 
- --pwb-math  Next 12 lines are replacements for 21 commented lines above
-       if not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 2.0*180.0),
-                                          45.0,
-                                          0.001)                           or
-          not FXA5A00.Result_Within_Range(EF.Arctan(-1.0,  Cycle => 2.0*180.0),
-                                          -45.0, 
-                                          0.001)                           or
-          not FXA5A00.Result_Within_Range(EF.Arctan(1.0,   Cycle => 360.0),
-                                          45.0,
-                                          0.1)                             or
-          not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 100.0),
-                                          12.5,
-                                          0.1) 
-       then
-          Report.Failed("Incorrect results from the Arctan function with "   &
-                        "specified Cycle parameter when provided a variety " &
-                        "of Y parameter values");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A07;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a	Thu Jan  1 00:00:00 1970
***************
*** 1,474 ****
- -- CXA5A08.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function Arccot provides correct results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Arccot resulting from the 
- --      instantiation of the Ada.Numerics.Generic_Elementary_Functions 
- --      with a type derived from type Float, as well as the preinstantiated 
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A08.A
- --
- --
- -- CHANGE HISTORY:
- --      06 Apr 95   SAIC    Initial prerelease version.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      28 Feb 97   CTA.PWB Removed checks with explicit Cycle => 2.0*Pi
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- with Ada.Exceptions;
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A08 is
- begin
- 
-    Report.Test ("CXA5A08", "Check that the Arccot function provides " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       Float_Result      : Float;
-       Angle             : Float;
-       New_Float_Result  : New_Float;
-       New_Float_Angle   : New_Float;
-       Incorrect_Inverse : Boolean := False;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Arccot Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Argument_Error is raised by the Arccot function when
-       -- provided parameter values of 0.0, 0.0.
- 
-       begin
-          New_Float_Result := GEF.Arccot(X => 0.0, Y => 0.0);
-          Report.Failed("Argument_Error not raised when the Arccot " &
-                        "function is provided input of 0.0, 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arccot " &
-                           "function when provided 0.0, 0.0 input parameters");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arccot function when
-       -- provided a large positive or negative X parameter value, when 
-       -- using the default value for parameter Y.
- 
-       begin
-          Float_Result := EF.Arccot(X => FXA5A00.Large);
-          Dont_Optimize_Float(Float_Result, 2);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided a large positive X parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arccot(X => New_Float(-FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 3);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided a large negative X parameter value");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arccot function when
-       -- provided a small positive or negative X parameter value, when
-       -- using the default value for parameter Y.
- 
-       begin
-          Float_Result := EF.Arccot(X => FXA5A00.Small);
-          Dont_Optimize_Float(Float_Result, 4);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided a small positive X parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arccot(X => New_Float(-FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 5);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided a small negative X parameter value");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arccot function when
-       -- provided combinations of large and small positive or negative 
-       -- parameter values for both X and Y input parameters. 
- 
-       begin
-          Float_Result := EF.Arccot(X => FXA5A00.Large, Y => FXA5A00.Large);
-          Dont_Optimize_Float(Float_Result, 6);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided large positive X and Y parameter values");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arccot(New_Float(-FXA5A00.Large), 
-                                         Y => New_Float(FXA5A00.Small));
-          Dont_Optimize_New_Float(New_Float_Result, 7);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided a large negative X parameter value "  &
-                           "and a small positive Y parameter value");
-       end;
- 
- 
-       begin
-          Float_Result := EF.Arccot(X => FXA5A00.Small, Y => FXA5A00.Large);
-          Dont_Optimize_Float(Float_Result, 8);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided a small positive X parameter value "  &
-                           "and a large positive Y parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arccot(New_Float(-FXA5A00.Small), 
-                                         New_Float(-FXA5A00.Large));
-          Dont_Optimize_New_Float(New_Float_Result, 9);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function is " &
-                           "provided a small negative X parameter value "  &
-                           "and a large negative Y parameter value");
-       end;
- 
- 
-       -- Check that when the Arccot function is provided a Y parameter value
-       -- of 0.0 and a positive X parameter input value, the prescribed result
-       -- of zero is returned.
- 
-       if  EF.Arccot(X => FXA5A00.Large, Y => 0.0)                 /= 0.0 or
-          GEF.Arccot(2.0*Pi, Y => 0.0)                             /= 0.0 or
-           EF.Arccot(FXA5A00.Small, 0.0)                           /= 0.0 or
-           EF.Arccot(X => FXA5A00.Large, Y => 0.0, Cycle => 360.0) /= 0.0 or
-          GEF.Arccot(2.0*Pi, Y => 0.0, Cycle => 360.0)             /= 0.0 or
-           EF.Arccot(FXA5A00.Small, 0.0, Cycle => 360.0)           /= 0.0
-       then 
-          Report.Failed("Incorrect results from the Arccot function when " &
-                        "provided a Y parameter value of 0.0 and various " &
-                        "positive X parameter values");
-       end if;
- 
- 
-       -- Check that the Arccot function provides correct results when
-       -- provided a variety of X parameter values.  
- 
-       if not Result_Within_Range( EF.Arccot( 1.0), Pi/4.0, 0.001)     or
-          not Result_Within_Range(GEF.Arccot( 0.0), Pi/2.0, 0.001)     or
-          not Result_Within_Range( EF.Arccot(-1.0), 3.0*Pi/4.0, 0.001) 
-       then
-          Report.Failed("Incorrect results from the Arccot function when " &
-                        "provided a variety of Y parameter values");
-       end if;
- 
- 
-       -- Check the results of the Arccot function with specified cycle
-       -- parameter.
- 
-       -- Check that the Arccot function with specified Cycle parameter 
-       -- raises Argument_Error when the value of the Cycle parameter is zero
-       -- or negative.
- 
-       begin
-          Float_Result := EF.Arccot(X => Pi, Cycle => 0.0);  -- Default Y value
-          Report.Failed("Argument_Error not raised by the Arccot function " &
-                        "with default Y parameter value, when the Cycle "   &
-                        "parameter is 0.0");
-          Dont_Optimize_Float(Float_Result, 10);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arccot "      &
-                           "function with default Y parameter value, when " &
-                           "provided a 0.0 cycle parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arccot(X => Pi, Y => 1.0, Cycle => 0.0);
-          Report.Failed("Argument_Error not raised by the Arccot function " &
-                        "when the Cycle parameter is 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 11);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arccot "     &
-                           "function when provided a 0.0 cycle parameter " &
-                           "value");
-       end;
- 
-       begin
-          Float_Result := EF.Arccot(X => Pi, Cycle => -360.0); 
-          Report.Failed("Argument_Error not raised by the Arccot function " &
-                        "with a default Y parameter value, when the Cycle " &
-                        "parameter is -360.0");
-          Dont_Optimize_Float(Float_Result, 12);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arccot "        &
-                           "function with a default Y parameter value, when " & 
-                           "provided a -360.0 cycle parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arccot(X => Pi, Y => 1.0, Cycle => -Pi);
-          Report.Failed("Argument_Error not raised by the Arccot function " &
-                        "when the Cycle parameter is -Pi");
-          Dont_Optimize_New_Float(New_Float_Result, 13);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Incorrect exception raised by the Arccot "     &
-                           "function when provided a -Pi cycle parameter " &
-                           "value");
-       end;
- 
- 
-       -- Check that no exception is raised by the Arccot function with 
-       -- specified Cycle parameter, when provided large and small positive
-       -- or negative parameter values for both X and Y input parameters. 
- 
-       begin
-          Float_Result := EF.Arccot(X     => -FXA5A00.Large, 
-                                    Y     => -FXA5A00.Large,
- --pwb-math  Next line: changed 2.0*Pi to 360.0
-                                    Cycle => 360.0);
-          Dont_Optimize_Float(Float_Result, 14);
-       exception
-          when others =>  
-             Report.Failed("Exception raised when the Arccot function with " &
-                           "specified Cycle parameter, when provided large " & 
-                           "negative X and Y parameter values");
-       end;
- 
- 
-       begin
-          New_Float_Result := GEF.Arccot(New_Float(FXA5A00.Large), 
-                                         Y     => New_Float(-FXA5A00.Small),
- --pwb-math  Next line: changed 2.0*Pi to 360.0
-                                         Cycle => 360.0);
-          Dont_Optimize_New_Float(New_Float_Result, 15);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function with "  &
-                           "specified Cycle parameter, when provided large "  & 
-                           "positive X parameter value and a small negative " &
-                           "Y parameter value");
-       end;
- 
- 
-       begin
-          Float_Result := EF.Arccot(X     => -FXA5A00.Small, 
-                                    Y     => -FXA5A00.Large,
- --pwb-math  Next line: changed 2.0*Pi to 360.0
-                                    Cycle => 360.0);
-          Dont_Optimize_Float(Float_Result, 16);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function with "  &
-                           "specified Cycle parameter, when provided small "  & 
-                           "negative X parameter value and a large negative " &
-                           "Y parameter value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Arccot(New_Float(FXA5A00.Small), 
-                                         New_Float(FXA5A00.Large), 
- --pwb-math  Next line: changed 2.0*Pi to 360.0
-                                         360.0);
-          Dont_Optimize_New_Float(New_Float_Result, 17);
-       exception
-          when others => 
-             Report.Failed("Exception raised when the Arccot function with " &
-                           "specified Cycle parameter, when provided a "     & 
-                           "small positive X parameter value and a large "   &
-                           "positive Y parameter value");
-       end;
- 
- 
-       -- Check that the Arccot function with specified Cycle parameter 
-       -- provides correct results when provided a variety of X parameter
-       -- input values.
- 
-       if not FXA5A00.Result_Within_Range(GEF.Arccot( 0.0, Cycle => 360.0),
-                                          90.0, 
-                                          0.001) or
-          not FXA5A00.Result_Within_Range(EF.Arccot( 0.0, Cycle => 100.0),
-                                          25.0,
-                                          0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Arccot( 1.0, Cycle => 360.0),
-                                          45.0,
-                                          0.001) or
-          not FXA5A00.Result_Within_Range(EF.Arccot( 1.0, Cycle => 100.0),
-                                          12.5,
-                                          0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Arccot(-1.0, Cycle => 360.0),
-                                          135.0,
-                                          0.001) or
-          not FXA5A00.Result_Within_Range(EF.Arccot(-1.0, Cycle => 100.0),
-                                          37.5,
-                                          0.001)
-       then
-          Report.Failed("Incorrect results from the Arccot function with "   &
-                        "specified Cycle parameter when provided a variety " &
-                        "of X parameter values");
-       end if;
- 
- 
-       if not FXA5A00.Result_Within_Range(EF.Arccot(0.2425355, 0.9701420),
-                                          EF.Arccot(0.25),
-                                          0.01) or
-          not FXA5A00.Result_Within_Range(EF.Arccot(0.3162277, 0.9486831),
-                                          Ef.Arccot(0.33),
-                                          0.01)
-       then
-          Report.Failed("Incorrect results from the Arccot function with " &
-                        "comparison to other Arccot function results");
-       end if;
- 
- 
-       if not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(0.4472135,
-                                                           0.8944270)),
-                                          0.5,
-                                          0.01) or
-          not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(0.9987380, 
-                                                           0.0499369)),
-                                          20.0,
-                                          0.1)
-       then
-          Report.Failed("Incorrect results from the Arccot function when " &
-                        "used as argument to Cot function");
-       end if;
- 
- 
-       -- Check that inverse function results are correct.
-       -- Default Cycle test.
- 
-       Angle := 0.001;
-       while Angle < Pi and not Incorrect_Inverse loop
-          if not Result_Within_Range(EF.Arccot(EF.Cot(Angle)), Angle, 0.001)
-          then
-             Incorrect_Inverse := True;
-          end if;
-          Angle := Angle + 0.001;
-       end loop;
- 
-       if Incorrect_Inverse then
-          Report.Failed("Incorrect results returned from the Inverse "    &
-                        "comparison of Cot and Arccot using the default " &
-                        "cycle value");
-          Incorrect_Inverse := False;
-       end if;
- 
-       -- Non-Default Cycle test.
- 
-       New_Float_Angle := 0.01;
-       while New_Float_Angle < 180.0 and not Incorrect_Inverse loop
-          if not Result_Within_Range(EF.Arccot(EF.Cot(Float(New_Float_Angle), 
-                                                      Cycle => 360.0), 
-                                               Cycle => 360.0),
-                                     Float(New_Float_Angle),
-                                     0.01)  or
-             not Result_Within_Range(GEF.Arccot(
-                                        New_Float(GEF.Cot(New_Float_Angle, 
-                                                          Cycle => 360.0)), 
-                                        Cycle => 360.0),
-                                     Float(New_Float_Angle),
-                                     0.01)  
-          then
-             Incorrect_Inverse := True;
-          end if;
-          New_Float_Angle := New_Float_Angle + 0.01;
-       end loop;
- 
-       if Incorrect_Inverse then
-          Report.Failed("Incorrect results returned from the Inverse "    &
-                        "comparison of Cot and Arccot using non-default " &
-                        "cycle value");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A08;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a	Thu Jan  1 00:00:00 1970
***************
*** 1,400 ****
- -- CXA5A09.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function Log provides correct results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the version of Log resulting from the 
- --      instantiation of the Ada.Numerics.Generic_Elementary_Functions with 
- --      with a type derived from type Float,as well as the preinstantiated
- --      version of this package for type Float.
- --      Prescribed results, including instances prescribed to raise 
- --      exceptions, are examined in the test cases.  In addition, 
- --      certain evaluations are performed where the actual function result 
- --      is compared with the expected result (within an epsilon range of 
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A09.A
- --
- --
- -- CHANGE HISTORY:
- --      11 Apr 95   SAIC    Initial prerelease version.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      29 Jun 98   EDS     Protected exception tests by first testing
- --                          for 'Machine_Overflows
- --
- --!
- 
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A09 is
- begin
- 
-    Report.Test ("CXA5A09", "Check that the Log function provides " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Numerics;
-       use FXA5A00;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       Arg,
-       Float_Result     : Float     := 0.0;
-       New_Float_Result : New_Float := 0.0;
- 
-       Incorrect_Inverse,
-       Incorrect_Inverse_Base_2,
-       Incorrect_Inverse_Base_8,
-       Incorrect_Inverse_Base_10,
-       Incorrect_Inverse_Base_16  : Boolean   := False;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of Log Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Argument_Error is raised when the parameter X is negative.
- 
-       begin
-          New_Float_Result := GEF.Log(X => -1.0);
-          Report.Failed("Argument_Error not raised by the Log function " &
-                        "when the input parameter is negative");
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when Argument_Error => null; -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Log function " &
-                           "when the input parameter is negative");
-       end;
- 
-       begin
-          Float_Result := EF.Log(X => -FXA5A00.Large);
-          Report.Failed("Argument_Error not raised by the Log function " &
-                        "when the input parameter is negative");
-          Dont_Optimize_Float(Float_Result, 2);
-       exception
-          when Argument_Error => null; -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the Log function " &
-                           "when the input parameter is negative");
-       end;
- 
- 
-       -- Check that Constraint_Error is raised when the Log function is 
-       -- provided an input parameter of zero.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Log(X => 0.0);
-             Report.Failed("Constraint_Error not raised by the Log function " &
-                           "when the input parameter is zero");
-             Dont_Optimize_New_Float(New_Float_Result, 3);
-          exception
-             when Constraint_Error => null; -- OK, expected exception.
-             when others         =>
-                Report.Failed("Unexpected exception raised by the Log function "
-                              & "when the input parameter is zero");
-          end;
-       end if;
-       
- 
-       -- Check for the reference manual prescribed results of the Log function.
- 
-       if GEF.Log(X => 1.0) /= 0.0 or
-           EF.Log(X => 1.0) /= 0.0
-       then
-          Report.Failed("Incorrect result from Function Log when provided " &
-                        "an input parameter value of 1.0");
-       end if;
- 
- 
-       -- Check that the Log function provides correct results when provided
-       -- a variety of input parameters.
- 
-       if not FXA5A00.Result_Within_Range(GEF.Log(0.015),   -4.20,  0.01)  or
-          not FXA5A00.Result_Within_Range(GEF.Log(0.592),   -0.524, 0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Log(0.997),   -0.003, 0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Log(1.341),    0.293, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Log(2.826),    1.04,  0.01)  or
-          not FXA5A00.Result_Within_Range( EF.Log(10.052),   2.31,  0.01)  or
-          not FXA5A00.Result_Within_Range( EF.Log(2569.143), 7.85,  0.01)
-       then
-          Report.Failed("Incorrect results from Function Log when provided " &
-                        "a variety of input parameter values");
-       end if;
- 
-       Arg := 0.001;
-       while Arg < 1.0 and not Incorrect_Inverse loop
-          if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.001) then
-             Incorrect_Inverse := True;
-          end if;
-          Arg := Arg + 0.001;
-       end loop;
- 
-       if Incorrect_Inverse then
-          Report.Failed("Incorrect inverse result comparing ""**"" and " &
-                        "Log function over argument range 0.001..1.0");
-          Incorrect_Inverse := False;
-       end if;
- 
-       Arg := 1.0;
-       while Arg < 10.0 and not Incorrect_Inverse loop
-          if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.01) then
-             Incorrect_Inverse := True;
-          end if;
-          Arg := Arg + 0.01;
-       end loop;
- 
-       if Incorrect_Inverse then
-          Report.Failed("Incorrect inverse result comparing ""**"" and " &
-                        "Log function over argument range 1.0..10.0");
-          Incorrect_Inverse := False;
-       end if;
- 
-       Arg := 1.0;
-       while Arg < 1000.0 and not Incorrect_Inverse loop
-          if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.1) then
-             Incorrect_Inverse := True;
-          end if;
-          Arg := Arg + 1.0;
-       end loop;
- 
-       if Incorrect_Inverse then
-          Report.Failed("Incorrect inverse result comparing ""**"" and " &
-                        "Log function over argument range 1.0..1000.0");
-       end if;
- 
- 
-       -- Testing of Log Function, with specified Base parameter, both 
-       -- instantiated and pre-instantiated versions.
- 
-       -- Check that Argument_Error is raised by the Log function with 
-       -- specified Base parameter, when the X parameter value is negative.
- 
-       begin
-          New_Float_Result := GEF.Log(X => -1.0, Base => 16.0);
-          Report.Failed("Argument_Error not raised by the Log function " &
-                        "with Base parameter, when the input parameter " &
-                        "value is -1.0");
-          Dont_Optimize_New_Float(New_Float_Result, 4);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         => 
-             Report.Failed("Unexpected exception raised by the Log function " &
-                           "with Base parameter, when the X parameter value " &
-                           "is -1.0");
-       end;
- 
-       begin
-          Float_Result := EF.Log(X => -FXA5A00.Large, Base => 8.0);
-          Report.Failed("Argument_Error not raised by the Log function " &
-                        "with Base parameter, when the X parameter "     &
-                        "value is a large negative value");
-          Dont_Optimize_Float(Float_Result, 5);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         => 
-             Report.Failed("Unexpected exception raised by the Log function " &
-                           "with Base parameter, when the X parameter "       &
-                           "value is a large negative value");
-       end;
- 
- 
-       -- Check that Argument_Error is raised by the Log function when 
-       -- the specified Base parameter is zero.
- 
-       begin
-          New_Float_Result := GEF.Log(X => 10.0, Base => 0.0);
-          Report.Failed("Argument_Error not raised by the Log function " &
-                        "with Base parameter of 0.0");
-          Dont_Optimize_New_Float(New_Float_Result, 6);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         => 
-             Report.Failed("Unexpected exception raised by the Log function " &
-                           "with Base parameter of 0.0");
-       end;
- 
- 
-       -- Check that Argument_Error is raised by the Log function when 
-       -- the specified Base parameter is one.
- 
-       begin
-          Float_Result := EF.Log(X => 12.3, Base => 1.0);
-          Report.Failed("Argument_Error not raised by the Log function " &
-                        "with Base parameter of 1.0");
-          Dont_Optimize_Float(Float_Result, 7);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         => 
-             Report.Failed("Unexpected exception raised by the Log function " &
-                           "with Base parameter of 1.0");
-       end;
- 
- 
-       -- Check that Argument_Error is raised by the Log function when 
-       -- the specified Base parameter is negative.
- 
-       begin
-          New_Float_Result := GEF.Log(X => 12.3, Base => -10.0);
-          Report.Failed("Argument_Error not raised by the Log function " &
-                        "with negative Base parameter");
-          Dont_Optimize_New_Float(New_Float_Result, 8);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         => 
-             Report.Failed("Unexpected exception raised by the Log function " &
-                           "with negative Base parameter");
-       end;
- 
- 
-       -- Check that Constraint_Error is raised by the Log function when the
-       -- input X parameter value is 0.0.
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF.Log(X => 0.0, Base => 16.0);
-             Report.Failed("Constraint_Error not raised by the Log function "  &
-                           "with specified Base parameter, when the value of " &
-                           "the parameter X is 0.0");
-             Dont_Optimize_New_Float(New_Float_Result, 9);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by Function Log"    &
-                              "with specified Base parameter, when the value " &
-                              "of the parameter X is 0.0");
-          end;
-       end if;
- 
-       -- Check for the prescribed results of the Log function with specified
-       -- Base parameter.
- 
-       if GEF.Log(X => 1.0, Base => 16.0) /= 0.0 or
-           EF.Log(X => 1.0, Base => 10.0) /= 0.0 or
-          GEF.Log(1.0, Base => 8.0)       /= 0.0 or
-           EF.Log(1.0, 2.0)               /= 0.0
-       then
-          Report.Failed("Incorrect result from Function Log with specified " &
-                        "Base parameter when provided an parameter X input " &
-                        "value of 1.0");
-       end if;
- 
- 
-       -- Check that the Log function with specified Base parameter provides 
-       -- correct results when provided a variety of input parameters.
- 
-       if not Result_Within_Range(GEF.Log( 10.0,  e),     2.30,  0.01)  or
-          not Result_Within_Range( EF.Log(  8.0,  2.0),   3.0,   0.01)  or
-          not Result_Within_Range(GEF.Log(256.0,  2.0),   8.0,   0.01)  or
-          not Result_Within_Range( EF.Log(512.0,  8.0),   3.0,   0.01)  or
-          not Result_Within_Range(GEF.Log(0.5649, e),    -0.57,  0.01)  or
-          not Result_Within_Range( EF.Log(1.7714, e),     0.57,  0.01)  or
-          not Result_Within_Range(GEF.Log(0.5718, 10.0), -0.243, 0.001) or
-          not Result_Within_Range( EF.Log(466.25, 10.0),  2.67,  0.01) 
-       then
-          Report.Failed("Incorrect results from Function Log with specified " &
-                        "Base parameter, when provided a variety of input "   &
-                        "parameter values");
-       end if;
- 
- 
-       Arg := 1.0;
-       while Arg < 1000.0 and 
-             not (Incorrect_Inverse_Base_2  and Incorrect_Inverse_Base_8 and
-                  Incorrect_Inverse_Base_10 and Incorrect_Inverse_Base_16) 
-       loop
-          if not FXA5A00.Result_Within_Range(EF."**"(2.0,EF.Log(Arg,2.0)),
-                                             Arg,
-                                             0.001) 
-          then
-             Incorrect_Inverse_Base_2 := True;
-          end if;
-          if not FXA5A00.Result_Within_Range(EF."**"(8.0,EF.Log(Arg,8.0)),
-                                             Arg,
-                                             0.001) 
-          then
-             Incorrect_Inverse_Base_8 := True;
-          end if;
-          if not FXA5A00.Result_Within_Range(EF."**"(10.0,EF.Log(Arg,10.0)),
-                                             Arg,
-                                             0.001) 
-          then
-             Incorrect_Inverse_Base_10 := True;
-          end if;
-          if not FXA5A00.Result_Within_Range(EF."**"(16.0,EF.Log(Arg,16.0)), 
-                                             Arg,
-                                             0.001) 
-          then
-             Incorrect_Inverse_Base_16 := True;
-          end if;
-          Arg := Arg + 1.0;
-       end loop;
- 
-       if Incorrect_Inverse_Base_2 then
-          Report.Failed("Incorrect inverse result comparing ""**"" and " &
-                        "Log function for Base 2");
-       end if;
- 
-       if Incorrect_Inverse_Base_8 then
-          Report.Failed("Incorrect inverse result comparing ""**"" and " &
-                        "Log function for Base 8");
-       end if;
- 
-       if Incorrect_Inverse_Base_10 then
-          Report.Failed("Incorrect inverse result comparing ""**"" and " &
-                        "Log function for Base 10");
-       end if;
- 
-       if Incorrect_Inverse_Base_16 then
-          Report.Failed("Incorrect inverse result comparing ""**"" and " &
-                        "Log function for Base 16");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A09;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a	Thu Jan  1 00:00:00 1970
***************
*** 1,551 ****
- -- CXA5A10.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions Exp and Sqrt, and the exponentiation
- --      operator "**" provide correct results.
- --
- -- TEST DESCRIPTION:
- --      This test examines both the versions of Exp, Sqrt, and "**"
- --      resulting from the instantiation of the
- --      Ada.Numerics.Generic_Elementary_Functions with a type derived from
- --      type Float, as well as the preinstantiated version of this package
- --      for type Float.
- --      Prescribed results (stated as such in the reference manual),
- --      including instances prescribed to raise exceptions, are examined
- --      in the test cases.  In addition, certain evaluations are performed
- --      for the preinstantiated package where the actual function result is
- --      compared with the expected result (within an epsilon range of
- --      accuracy).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXA5A00.A   (foundation code)
- --         CXA5A10.A
- --
- --
- -- CHANGE HISTORY:
- --      17 Apr 95   SAIC    Initial prerelease version.
- --      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
- --                          use of Result_Within_Range function overloaded for
- --                          FXA5A00.New_Float_Type.
- --      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      01 Oct 01   RLB     Protected Constraint_Error exception tests by
- --                          first testing for 'Machine_Overflows.
- --
- --!
- 
- with Ada.Exceptions;
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Elementary_Functions;
- with FXA5A00;
- with Report;
- 
- procedure CXA5A10 is
- begin
- 
-    Report.Test ("CXA5A10", "Check that Exp, Sqrt, and the ""**"" operator " &
-                            "provide correct results");
- 
-    Test_Block:
-    declare
- 
-       use FXA5A00, Ada.Numerics;
-       use Ada.Exceptions;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
-       package  EF renames Ada.Numerics.Elementary_Functions;
- 
-       use GEF, EF;
- 
-       Arg,
-       Float_Result     : Float;
-       New_Float_Result : New_Float;
- 
-       Flag_1, Flag_2, Flag_3, Flag_4,
-       Incorrect_Inverse_Base_e,
-       Incorrect_Inverse_Base_2,
-       Incorrect_Inverse_Base_8,
-       Incorrect_Inverse_Base_10,
-       Incorrect_Inverse_Base_16        : Boolean := False;
- 
-       procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
-       procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
- 
-    begin
- 
-       -- Testing of the "**" operator, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Argument_Error is raised by the exponentiation operator
-       -- when the value of the Left parameter (operand) is negative.
- 
-       begin
-          New_Float_Result := GEF."**"(Left  => -10.0,
-                                       Right =>   2.0);
-          Report.Failed("Argument_Error not raised by the instantiated "   &
-                        "version of the exponentiation operator when the " &
-                        "value of the Left parameter is negative");
-          Dont_Optimize_New_Float(New_Float_Result, 1);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the "            &
-                           "instantiated version of the exponentiation "    &
-                           "operator when the value of the Left parameter " &
-                           "is negative");
-       end;
- 
-       begin
-          Float_Result := (-FXA5A00.Small) ** 4.0;
-          Report.Failed("Argument_Error not raised by the preinstantiated " &
-                        "version of the exponentiation operator when the "  &
-                        "value of the Left parameter is negative");
-          Dont_Optimize_Float(Float_Result, 2);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the "            &
-                           "preinstantiated version of the exponentiation " &
-                           "operator when the value of the Left parameter " &
-                           "is negative");
-       end;
- 
- 
-       -- Check that Argument_Error is raised by the exponentiation operator
-       -- when both parameters (operands) have the value 0.0.
- 
-       begin
-          New_Float_Result := GEF."**"(0.0, Right => 0.0);
-          Report.Failed("Argument_Error not raised by the instantiated " &
-                        "version of the exponentiation operator when "   &
-                        "both operands are zero");
-          Dont_Optimize_New_Float(New_Float_Result, 3);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the "         &
-                           "instantiated version of the exponentiation " &
-                           "operator when both operands are zero");
-       end;
- 
-       begin
-          Float_Result := 0.0**0.0;
-          Report.Failed("Argument_Error not raised by the preinstantiated " &
-                        "version of the exponentiation operator when both " &
-                        "operands are zero");
-          Dont_Optimize_Float(Float_Result, 4);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by the "            &
-                           "preinstantiated version of the exponentiation " &
-                           "operator when both operands are zero");
-       end;
- 
- 
-       -- Check that Constraint_Error is raised by the exponentiation
-       -- operator when the value of the left parameter (operand) is zero,
-       -- and the value of the right parameter (exponent) is negative.
-       -- This check applies only if Machine_Overflows is true [A.5.1(28, 30)].
- 
-       if New_Float'Machine_Overflows = True then
-          begin
-             New_Float_Result := GEF."**"(0.0, Right => -2.0);
-             Report.Failed("Constraint_Error not raised by the instantiated " &
-                           "version of the exponentiation operator when "     &
-                           "the left parameter is 0.0, and the right "        &
-                           "parameter is negative");
-             Dont_Optimize_New_Float(New_Float_Result, 5);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by the "         &
-                              "instantiated version of the exponentiation " &
-                              "operator when the left parameter is 0.0, "   &
-                              "and the right parameter is negative");
-          end;
-       end if;
- 
-       if Float'Machine_Overflows = True then
-          begin
-             Float_Result := 0.0 ** (-FXA5A00.Small);
-             Report.Failed("Constraint_Error not raised by the " &
-                           "preinstantiated version of the exponentiation " &
-                           "operator when the left parameter is 0.0, and the " &
-                           "right parameter is negative");
-             Dont_Optimize_Float(Float_Result, 6);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Unexpected exception raised by the "            &
-                              "preinstantiated version of the exponentiation " &
-                              "operator when the left parameter is 0.0, and "  &
-                              "the right parameter is negative");
-          end;
-       end if;
- 
-       -- Prescribed results.
-       -- Check that exponentiation by a 0.0 exponent yields the value one.
- 
-       if GEF."**"(Left => 10.0,  Right => 0.0) /= 1.0 or
-           EF."**"(FXA5A00.Large, Right => 0.0) /= 1.0 or
-          GEF."**"(3.0, 0.0)                    /= 1.0 or
-           FXA5A00.Small ** 0.0                 /= 1.0
-       then
-          Report.Failed("Incorrect results returned from the ""**"" " &
-                        "operator when the value of the exponent is 0.0");
-       end if;
- 
- 
-       -- Check that exponentiation by a unit exponent yields the value
-       -- of the left operand.
- 
-       if GEF."**"(Left => 50.0,  Right => 1.0) /= 50.0          or
-           EF."**"(FXA5A00.Large, Right => 1.0) /= FXA5A00.Large or
-          GEF."**"(6.0, 1.0)                    /= 6.0           or
-           FXA5A00.Small ** 1.0                 /= FXA5A00.Small
-       then
-          Report.Failed("Incorrect results returned from the ""**"" " &
-                        "operator when the value of the exponent is 1.0");
-       end if;
- 
- 
-       -- Check that exponentiation of the value 1.0 yields the value 1.0.
- 
-       if GEF."**"(Left => 1.0, Right => 16.0)   /=  1.0 or
-           EF."**"(1.0, Right => FXA5A00.Large)  /=  1.0 or
-          GEF."**"(1.0, 3.0)                     /=  1.0 or
-           1.0 ** FXA5A00.Small                  /=  1.0
-       then
-          Report.Failed("Incorrect results returned from the ""**"" " &
-                        "operator when the value of the operand is 1.0");
-       end if;
- 
- 
-       -- Check that exponentiation of the value 0.0 yields the value 0.0.
- 
-       if GEF."**"(Left => 0.0, Right => 10.0)   /=  0.0 or
-           EF."**"(0.0, Right => FXA5A00.Large)  /=  0.0 or
-          GEF."**"(0.0, 4.0)                     /=  0.0 or
-           0.0 ** FXA5A00.Small                  /=  0.0
-       then
-          Report.Failed("Incorrect results returned from the ""**"" " &
-                        "operator when the value of the operand is 0.0");
-       end if;
- 
- 
-       -- Check that exponentiation of various operands with a variety of
-       -- of exponent values yield correct results.
- 
-       if not Result_Within_Range(GEF."**"(5.0,   2.0),  25.0,   0.01)  or
-          not Result_Within_Range(GEF."**"(1.225, 1.5),   1.36,  0.01)  or
-          not Result_Within_Range(GEF."**"(0.26,  2.0),   0.068, 0.001) or
-          not Result_Within_Range( EF."**"(e,     5.0), 148.4,   0.1)   or
-          not Result_Within_Range( EF."**"(10.0,  e),   522.7,   0.1)   or
-          not Result_Within_Range( EF."**"(e,   (-3.0)),  0.050, 0.001) or
-          not Result_Within_Range(GEF."**"(10.0,(-2.0)),  0.010, 0.001)
-       then
-          Report.Failed("Incorrect results returned from the ""**"" "       &
-                        "operator with a variety of  operand and exponent " &
-                        "values");
-       end if;
- 
- 
-       -- Use the following loops to check for internal consistency between
-       -- inverse functions.
- 
-       declare
-          -- Use the relative error value to account for non-exact
-          -- computations.
-          TC_Relative_Error: Float := 0.005;
-       begin
-          for i in 1..5 loop
-             for j in 0..5 loop
-                if not Incorrect_Inverse_Base_e and
-                   not FXA5A00.Result_Within_Range
-                         (Float(i)**Float(j),
-                          e**(Float(j)*EF.Log(Float(i))),
-                          TC_Relative_Error)
-                then
-                   Incorrect_Inverse_Base_e := True;
-                   Report.Failed("Incorrect Log-** Inverse calc for Base e " &
-                                 "with i= " & Integer'Image(i) & "  and j= " &
-                                 Integer'Image(j));
-                end if;
-                if not Incorrect_Inverse_Base_2 and
-                   not FXA5A00.Result_Within_Range
-                         (Float(i)**Float(j),
-                          2.0**(Float(j)*EF.Log(Float(i),2.0)),
-                          TC_Relative_Error)
-                then
-                   Incorrect_Inverse_Base_2 := True;
-                   Report.Failed("Incorrect Log-** Inverse calc for Base 2 " &
-                                 "with i= " & Integer'Image(i) & "  and j= " &
-                                 Integer'Image(j));
-                end if;
-                if not Incorrect_Inverse_Base_8 and
-                   not FXA5A00.Result_Within_Range
-                         (Float(i)**Float(j),
-                          8.0**(Float(j)*EF.Log(Float(i),8.0)),
-                          TC_Relative_Error)
-                then
-                   Incorrect_Inverse_Base_8 := True;
-                   Report.Failed("Incorrect Log-** Inverse calc for Base 8 " &
-                                 "with i= " & Integer'Image(i) & "  and j= " &
-                                 Integer'Image(j));
-                end if;
-                if not Incorrect_Inverse_Base_10 and
-                   not FXA5A00.Result_Within_Range
-                         (Float(i)**Float(j),
-                          10.0**(Float(j)*EF.Log(Float(i),10.0)),
-                          TC_Relative_Error)
-                then
-                   Incorrect_Inverse_Base_10 := True;
-                   Report.Failed("Incorrect Log-** Inverse calc for Base 10 " &
-                                 "with i= " & Integer'Image(i) & "   and j= " &
-                                 Integer'Image(j));
-                end if;
-                if not Incorrect_Inverse_Base_16 and
-                   not FXA5A00.Result_Within_Range
-                         (Float(i)**Float(j),
-                          16.0**(Float(j)*EF.Log(Float(i),16.0)),
-                          TC_Relative_Error)
-                then
-                   Incorrect_Inverse_Base_16 := True;
-                   Report.Failed("Incorrect Log-** Inverse calc for Base 16 " &
-                                 "with i= " & Integer'Image(i) & "   and j= " &
-                                 Integer'Image(j));
-                end if;
-             end loop;
-          end loop;
-       end;
- 
-       -- Reset Flags.
-       Incorrect_Inverse_Base_e  := False;
-       Incorrect_Inverse_Base_2  := False;
-       Incorrect_Inverse_Base_8  := False;
-       Incorrect_Inverse_Base_10 := False;
-       Incorrect_Inverse_Base_16 := False;
- 
- 
-       -- Testing of Exp Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that the result of the Exp Function, when provided an X
-       -- parameter value of 0.0, is 1.0.
- 
-       if GEF.Exp(X => 0.0) /= 1.0 or
-           EF.Exp(0.0)      /= 1.0
-       then
-          Report.Failed("Incorrect result returned by Function Exp when " &
-                        "given a parameter value of 0.0");
-       end if;
- 
- 
-       -- Check that the Exp Function provides correct results when provided
-       -- a variety of input parameter values.
- 
-       if not Result_Within_Range(GEF.Exp(0.001),    1.01,  0.01)  or
-          not Result_Within_Range( EF.Exp(0.1),      1.11,  0.01)  or
-          not Result_Within_Range(GEF.Exp(1.2697),   3.56,  0.01)  or
-          not Result_Within_Range( EF.Exp(3.2525),  25.9,   0.1)   or
-          not Result_Within_Range(GEF.Exp(-0.2198),  0.803, 0.001) or
-          not Result_Within_Range( EF.Exp(-1.6621),  0.190, 0.001) or
-          not Result_Within_Range(GEF.Exp(-2.3888),  0.092, 0.001) or
-          not Result_Within_Range( EF.Exp(-5.4415),  0.004, 0.001)
-       then
-          Report.Failed("Incorrect result from Function Exp when provided " &
-                        "a variety of input parameter values");
-       end if;
- 
-       -- Use the following loops to check for internal consistency between
-       -- inverse functions.
- 
-       Arg := 0.01;
-       while Arg < 10.0 loop
-          if not Incorrect_Inverse_Base_e and
-             FXA5A00.Result_Within_Range(EF.Exp(Arg),
-                                         e**(Arg*EF.Log(Arg)),
-                                         0.001)
-          then
-             Incorrect_Inverse_Base_e := True;
-             Report.Failed("Incorrect Exp-** Inverse calc for Base e");
-          end if;
-          if not Incorrect_Inverse_Base_2 and
-             FXA5A00.Result_Within_Range(EF.Exp(Arg),
-                                         2.0**(Arg*EF.Log(Arg,2.0)),
-                                         0.001)
-          then
-             Incorrect_Inverse_Base_2 := True;
-             Report.Failed("Incorrect Exp-** Inverse calc for Base 2");
-          end if;
-          if not Incorrect_Inverse_Base_8 and
-             FXA5A00.Result_Within_Range(EF.Exp(Arg),
-                                         8.0**(Arg*EF.Log(Arg,8.0)),
-                                         0.001)
-          then
-             Incorrect_Inverse_Base_8 := True;
-             Report.Failed("Incorrect Exp-** Inverse calc for Base 8");
-          end if;
-          if not Incorrect_Inverse_Base_10 and
-             FXA5A00.Result_Within_Range(EF.Exp(Arg),
-                                         10.0**(Arg*EF.Log(Arg,10.0)),
-                                         0.001)
-          then
-             Incorrect_Inverse_Base_10 := True;
-             Report.Failed("Incorrect Exp-** Inverse calc for Base 10");
-          end if;
-          if not Incorrect_Inverse_Base_16 and
-             FXA5A00.Result_Within_Range(EF.Exp(Arg),
-                                         16.0**(Arg*EF.Log(Arg,16.0)),
-                                         0.001)
-          then
-             Incorrect_Inverse_Base_16 := True;
-             Report.Failed("Incorrect Exp-** Inverse calc for Base 16");
-          end if;
-          Arg := Arg + 0.01;
-       end loop;
- 
- 
-       -- Testing of Sqrt Function, both instantiated and pre-instantiated
-       -- version.
- 
-       -- Check that Argument_Error is raised by the Sqrt Function when
-       -- the value of the input parameter X is negative.
- 
-       begin
-          Float_Result := EF.Sqrt(X => -FXA5A00.Small);
-          Report.Failed("Argument_Error not raised by Function Sqrt "     &
-                        "when provided a small negative input parameter " &
-                        "value");
-          Dont_Optimize_Float(Float_Result, 7);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by Function Sqrt "   &
-                           "when provided a small negative input parameter " &
-                           "value");
-       end;
- 
-       begin
-          New_Float_Result := GEF.Sqrt(X => -64.0);
-          Report.Failed("Argument_Error not raised by Function Sqrt "     &
-                        "when provided a large negative input parameter " &
-                        "value");
-          Dont_Optimize_New_Float(New_Float_Result, 8);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others         =>
-             Report.Failed("Unexpected exception raised by Function Sqrt "   &
-                           "when provided a large negative input parameter " &
-                           "value");
-       end;
- 
- 
-       -- Check that the Sqrt Function, when given an X parameter value of 0.0,
-       -- returns a result of 0.0.
- 
-       if GEF.Sqrt(X => 0.0) /= 0.0 or
-           EF.Sqrt(0.0)      /= 0.0
-       then
-          Report.Failed("Incorrect result from Function Sqrt when provided " &
-                        "an input parameter value of 0.0");
-       end if;
- 
- 
-       -- Check that the Sqrt Function, when given an X parameter input value
-       -- of 1.0, returns a result of 1.0.
- 
-       if GEF.Sqrt(X => 1.0) /= 1.0 or
-           EF.Sqrt(1.0)      /= 1.0
-       then
-          Report.Failed("Incorrect result from Function Sqrt when provided " &
-                        "an input parameter value of 1.0");
-       end if;
- 
- 
-       -- Check that the Sqrt Function provides correct results when provided
-       -- a variety of input parameter values.
- 
-       if not FXA5A00.Result_Within_Range(GEF.Sqrt(0.0327),     0.181, 0.001) or
-          not FXA5A00.Result_Within_Range( EF.Sqrt(0.1808),     0.425, 0.001) or
-          not FXA5A00.Result_Within_Range(GEF.Sqrt(1.0556),     1.03,  0.01)  or
-          not FXA5A00.Result_Within_Range( EF.Sqrt(32.8208),    5.73,  0.01)  or
-          not FXA5A00.Result_Within_Range( EF.Sqrt(27851.0),  166.9,   0.1)   or
-          not FXA5A00.Result_Within_Range( EF.Sqrt(61203.4),  247.4,   0.1)   or
-          not FXA5A00.Result_Within_Range( EF.Sqrt(655891.0), 809.9,   0.1)
-       then
-          Report.Failed("Incorrect result from Function Sqrt when provided " &
-                        "a variety of input parameter values");
-       end if;
- 
-       -- Check internal consistency between functions.
- 
-       Arg := 0.01;
-       while Arg < 10.0 loop
-          if not Flag_1 and
-             not FXA5A00.Result_Within_Range(Arg,
-                                             EF.Sqrt(Arg)*EF.Sqrt(Arg),
-                                             0.01)
-          then
-             Report.Failed("Inconsistency found in Case 1");
-             Flag_1 := True;
-          end if;
-          if not Flag_2 and
-             not FXA5A00.Result_Within_Range(Arg, EF.Sqrt(Arg)**2.0, 0.01)
-          then
-             Report.Failed("Inconsistency found in Case 2");
-             Flag_2 := True;
-          end if;
-          if not Flag_3 and
-             not FXA5A00.Result_Within_Range(EF.Log(Arg),
-                                             EF.Log(Sqrt(Arg)**2.0), 0.01)
-          then
-             Report.Failed("Inconsistency found in Case 3");
-             Flag_3 := True;
-          end if;
-          if not Flag_4 and
-             not FXA5A00.Result_Within_Range(EF.Log(Arg),
-                                             2.00*EF.Log(EF.Sqrt(Arg)),
-                                             0.01)
-          then
-             Report.Failed("Inconsistency found in Case 4");
-             Flag_4 := True;
-          end if;
-          Arg := Arg + 1.0;
-       end loop;
- 
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXA5A10;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,243 ****
- -- CXA8001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that all elements to be transferred to a sequential file of
- --      mode Append_File will be placed following the last element currently
- --      in the file.  
- --      Check that it is possible to append data to a file that has been 
- --      previously appended to.
- --      Check that the predefined procedure Write will place an element after
- --      the last element in the file in mode Append_File.
- --
- -- TEST DESCRIPTION:
- --      This test implements a sequential file system that has the capability
- --      to store data records at the end of a file.  Initially, the file is 
- --      opened with mode Out_File, and data is written to the file.  The file
- --      is closed, then reopened with mode Append_File.  An additional record
- --      is written, and again the file is closed.  The file is then reopened,
- --      again with mode Append_File, and another record is written to the 
- --      file.
- --      The file is closed again, the reopened with mode In_File, and the data
- --      in the file is read and checked for proper ordering within the file.
- --
- --      An expected common usage of Append_File mode would be in the opening
- --      of a file that currently contains data.  Likewise, the reopening of
- --      files in Append_Mode that have been previously appended to for the
- --      addition of more data would be frequently encountered.  This test
- --      attempts to simulate both situations.  (Of course, in an actual user
- --      environment, the open/write/close processing would be performed using
- --      looping structures, rather than the straight-line processing displayed
- --      here.)
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all systems capable of supporting IO operations on 
- --      external Sequential_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Sequential_IO;
- with Report;
- 
- procedure CXA8001 is
- 
-    -- Declare data types and objects to be stored in the file.
-    subtype Name_Type is String (1 .. 10);
-    type    Tickets   is range 0 .. 1000;
- 
-    type Order_Type is record
-       Name          : Name_Type;
-       No_of_Tickets : Tickets;
-    end record;
-    
-    package Order_IO is new Sequential_IO (Order_Type); -- Declare Seq_IO 
-                                                        -- package,
-    Order_File     : Order_IO.File_Type;                -- and file object.
-    Order_Filename : constant String := 
-                            Report.Legal_File_Name ( Nam => "CXA8001" );
-    Incomplete : exception;
- 
- begin
- 
-    Report.Test ("CXA8001", "Check that all elements to be transferred to a " &
-                            "sequential file of mode Append_File will be "    &
-                            "placed following the last element currently "    &
-                            "in the file");
- 
-    Test_for_Sequential_IO_Support:
-    begin
- 
-       -- An implementation that does not support Sequential_IO in a particular
-       -- environment will raise Use_Error or Name_Error on calls to various
-       -- Sequential_IO operations.  This block statement encloses a call to
-       -- Create, which should produce an exception in a non-supportive 
-       -- environment.  These exceptions will be handled to produce a
-       -- Not_Applicable result.
- 
-       Order_IO.Create (File => Order_File,        -- Create Sequential_IO file 
-                        Mode => Order_IO.Out_File, -- with mode Out_File.
-                        Name => Order_Filename);
- 
-    exception
- 
-        when Order_IO.Use_Error | Order_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Sequential_IO" );
-           raise Incomplete;
- 
-    end Test_for_Sequential_IO_Support;
- 
-    Operational_Test_Block:
-    declare
-       -- Assign values into the component fields of the data objects.
-       Buyer_1 : constant Order_Type := ("John Smith", 3);
-       Buyer_2 : constant Order_Type := 
-                   (Name => "Jane Jones", No_of_Tickets => 2);
-       Buyer_3 : Order_Type := ("Mike Brown", 5);
- 
-    begin
-       Order_IO.Write (File => Order_File,      -- Write initial data item 
-                       Item => Buyer_1);        -- to file.
- 
-       Order_IO.Close (File => Order_File);     -- Close file.
- 
-       --
-       -- Enter additional data records into the file.  (Append to a file of
-       -- previous mode Out_File).
-       --
-       Order_IO.Open (Order_File,               -- Open Sequential_IO file 
-                      Order_IO.Append_File,     -- with mode Append_File.
-                      Order_Filename);
-                                                
-       Order_IO.Write (Order_File, Buyer_2);    -- Write second data item 
-                                                -- to file.
-       Order_IO.Close (File => Order_File);     -- Close file.
- 
-       -- Check to determine whether file is actually closed.
-       begin
-          Order_IO.Write (Order_File, Buyer_2);   
-          Report.Failed("Exception not raised on Write to Closed file");
-       exception
-          when Order_IO.Status_Error => null;   -- Expected exception.
-          when others                => 
-            Report.Failed("Incorrect exception on Write to Closed file");
-       end;
- 
-       --
-       -- The following code segment demonstrates appending data to a file 
-       -- that has been previously appended to.
-       --
- 
-       Order_IO.Open (Order_File,               -- Open Sequential_IO file 
-                      Order_IO.Append_File,     -- with mode Append_File.
-                      Order_Filename );
- 
-       Order_IO.Write (Order_File, Buyer_3);    -- Write third data item 
-                                                -- to file.
-       Order_IO.Close (File => Order_File);     -- Close file.
- 
- 
-       Test_Verification_Block:
-       declare
-          TC_Order1, TC_Order2, TC_Order3 : Order_Type;
-       begin
-       
-          Order_IO.Open (Order_File,            -- Open Sequential_IO file 
-                         Order_IO.In_File,      -- with mode In_File.
-                         Order_Filename );
- 
-          Order_IO.Read (File => Order_File,    -- Read records from file.
-                         Item => TC_Order1);       
-          Order_IO.Read (Order_File, TC_Order2);   
-          Order_IO.Read (Order_File, TC_Order3);   
- 
-          -- Compare the contents of each with the individual data items.
-          -- If items read from file do not match the items placed into 
-          -- the file, in the appropriate order, then fail.
- 
-          if ((TC_Order1 /= Buyer_1)               or
-              (TC_Order2.Name /= Buyer_2.Name)     or
-              (TC_Order2.No_of_Tickets /= Buyer_2.No_of_Tickets) or
-              not ((TC_Order3.Name = "Mike Brown") and
-                   (TC_Order3.No_of_Tickets = 5))) then
-             Report.Failed ("Incorrect appending of record data in file");
-          end if;
- 
-          -- Check to determine that no more than three data records were
-          -- actually written to the file.
-          if not Order_IO.End_Of_File (Order_File) then
-             Report.Failed("File not empty after three reads");
-          end if;
- 
-       exception
-       
-          when Order_IO.End_Error =>            -- If three items not in 
-                                                -- file (data overwritten),
-                                                -- then fail.
-             Report.Failed ("Incorrect number of record elements in file");
- 
-          when others => 
-             Report.Failed ("Error raised during data verification");
- 
-       end Test_Verification_Block;
- 
-    exception
- 
-       when others => 
-          Report.Failed("Exception raised during Sequential_IO processing");
- 
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       -- Check that file is open prior to deleting it.
-       if Order_IO.Is_Open(Order_File) then
-          Order_IO.Delete (Order_File);         
-       else
-          Order_IO.Open(Order_File, Order_IO.In_File, Order_Filename);
-          Order_IO.Delete (Order_File);          
-       end if;
- 
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Sequential_IO" );
- 
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXA8001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,285 ****
- -- CXA8002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that resetting a file using mode Append_File allows for the 
- --      writing of elements to the file starting after the last element in
- --      the file.  
- --      Check that the result of function Name can be used on a subsequent
- --      reopen of the file.
- --      Check that a mode change occurs on reset of a file to/from mode 
- --      Append_File.
- --
- -- TEST DESCRIPTION:
- --      This test simulates the read/write of data from/to an individual 
- --      sequential file. New data can be appended to the end of the existing 
- --      file, and the same file can be reset to allow reading of data from 
- --      the file.  This process can occur multiple times.
- --      When the mode of the file is changed with a Reset, the current mode
- --      value assigned to the file is checked using the result of function
- --      Mode.  This, in conjunction with the read/write operations, verifies
- --      that a mode change has taken place on Reset.
- --      
- --      An expected common usage of the scenarios found in this test would
- --      be a case where a single data file is kept open continuously, being
- --      reset for read/append of data.  For systems that do not support a
- --      direct form of I/O, this would allow for efficient use of a sequential
- --      I/O file.
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all systems capable of supporting IO operations on 
- --      external Sequential_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Feb 97   PWB.CTA Fixed handling for file non-support and Reset
- --                          non-support.
- --!
- 
- with Sequential_IO;
- with Report;
- 
- procedure CXA8002 is
-    subtype Employee_Data is String (1 .. 11);
-    package Data_IO       is new Sequential_IO (Employee_Data); 
- 
-    Employee_Data_File : Data_IO.File_Type;
-    Employee_Filename  : constant String := 
-      Report.Legal_File_Name (Nam => "CXA8002");
- 
-    Incomplete         : exception;
- 
- begin
- 
-    Report.Test ("CXA8002", "Check that resetting a file using mode "  &
-                            "Append_File allows for the writing of "   &
-                            "elements to the file starting after the " &
-                            "last element in the file");  
- 
-    Test_for_Sequential_IO_Support:
-    begin
- 
-       -- An implementation that does not support Sequential_IO in a particular
-       -- environment will raise Use_Error or Name_Error on calls to various
-       -- Sequential_IO operations.  This block statement encloses a call to
-       -- Create, which should produce an exception in a non-supportive 
-       -- environment.  These exceptions will be handled to produce a
-       -- Not_Applicable result.
- 
-       Data_IO.Create (File => Employee_Data_File,    -- Create file in 
-                       Mode => Data_IO.Append_File,   -- mode Append_File.
-                       Name => Employee_Filename);
- 
-       --
-       -- The following portion of code demonstrates the fact that a sequential
-       -- file can be created in Append_File mode, and that data can be written
-       -- to the file.
-       --
- 
-    exception
-       when Data_IO.Use_Error | Data_IO.Name_Error =>
-          Report.Not_Applicable
-             ( "Sequential files not supported - Create as Append_File");
-          raise Incomplete;
-    end Test_for_Sequential_IO_Support;
-       Operational_Test_Block:
-       declare
-          Blank_Data         : constant Employee_Data := "           ";
-          Employee_1         : constant Employee_Data := "123-45-6789";
-          Employee_2         :          Employee_Data := "987-65-4321";
- 
-          -- Note: Artificial numerical data chosen above to prevent any
-          --       unintended similarity with persons alive or dead.
- 
-          TC_Employee_Data   :          Employee_Data := Blank_Data;
- 
- 
-          function TC_Mode_Selection (Selector : Integer) 
-            return Data_IO.File_Mode is
-          begin
-             case Report.Ident_Int(Selector) is
-                when 1       => return Data_IO.In_File;
-                when 2       => return Data_IO.Out_File;
-                when others  => return Data_IO.Append_File;
-             end case;
-          end TC_Mode_Selection;
- 
-          Employee_Filename : constant String :=       -- Use function Name to 
-            Data_IO.Name (File => Employee_Data_File); -- store filename in 
-                                                       -- string variable.
-       begin
- 
-          Data_IO.Write (File => Employee_Data_File,   -- Write initial data 
-                         Item => Employee_1);          -- entry to file.
- 
-          --
-          -- The following portion of code demonstrates that a sequential file
-          -- can be reset to various file modes, including Append_File mode, 
-          -- allowing data to be added to the end of the file.
-          --
-          begin
-            Data_IO.Reset (File => Employee_Data_File,   -- Reset file with 
-                           Mode => Data_IO.In_File);     -- mode In_File.
-          exception
-            when Data_IO.Use_Error =>
-               Report.Not_Applicable
-                 ("Reset to In_File not supported for Sequential_IO");
-               raise Incomplete;
-            when others =>
-               Report.Failed 
-                 ("Unexpected exception on Reset to In_File (Sequential_IO)");
-               raise Incomplete;
-          end;
-          if Data_IO."="(Data_IO.Mode (Employee_Data_File), 
-                         TC_Mode_Selection (1)) then   -- Compare In_File mode
-                                                       -- Reset successful, 
-             Data_IO.Read (File => Employee_Data_File, -- now verify file data.
-                           Item => TC_Employee_Data);
-       
-             if ((TC_Employee_Data (1 .. 7)  /= "123-45-") or
-                 (TC_Employee_Data (5 .. 11) /= "45-6789")) then
-                Report.Failed ("Data read error");
-             end if;
- 
-          else
-             Report.Failed ("File mode not changed by Reset");
-          end if;
- 
-          --
-          -- Simulate appending data to a file that has previously been written 
-          -- to and read from.
-          --
-          begin
-            Data_IO.Reset (File => Employee_Data_File,   -- Reset file with 
-                           Mode => Data_IO.Append_File); -- mode Append_File.
-          exception
-            when Data_IO.Use_Error =>
-              Report.Not_Applicable
-                ("Reset to Append_File not supported for Sequential_IO");
-              raise Incomplete;
-            when others =>
-              Report.Failed 
-               ("Unexpected exception on Reset to Append_File (Sequential_IO)");
-               raise Incomplete;
-          end;
- 
-          if Data_IO.Is_Open (Employee_Data_File) then -- File remains open
-                                                       -- following Reset to 
-                                                       -- Append_File mode?
- 
-             if Data_IO."=" (Data_IO.Mode (Employee_Data_File), 
-                             TC_Mode_Selection (3)) then   -- Compare to
-                                                           -- Append_File mode.
-                Data_IO.Write (File => Employee_Data_File, -- Write additional
-                               Item => Employee_2);        -- data to file.
-             else
-                Report.Failed ("File mode not changed by Reset");
-             end if;
- 
-          else
-             Report.Failed 
-               ("File status not Open following Reset to Append mode");
-          end if;
- 
-          Data_IO.Close (Employee_Data_File);
- 
- 
-          Test_Verification_Block:
-          begin
- 
-             Data_IO.Open (File => Employee_Data_File, -- Reopen file, using 
-                           Mode => Data_IO.In_File,    -- previous result of
-                           Name => Employee_Filename); -- function Name.
- 
-             TC_Employee_Data := Blank_Data;           -- Clear record field.
-             Data_IO.Read (Employee_Data_File,         -- Read first record,
-                           TC_Employee_Data);          -- check ordering of 
-                                                       -- records.
- 
-             if not ((TC_Employee_Data (1 .. 3)  = "123") and then
-                     (TC_Employee_Data (4 .. 11) = "-45-6789")) then
-                Report.Failed ("Data read error - first record");
-             end if;
- 
-             TC_Employee_Data := Blank_Data;           -- Clear record field.
-             Data_IO.Read (Employee_Data_File,         -- Read second record,
-                           TC_Employee_Data);          -- check for ordering of 
-                                                       -- records.
- 
-             if ((TC_Employee_Data (1 .. 6)  /= "987-65") or else
-                 not (TC_Employee_Data (3 .. 11) = "7-65-4321")) then
-                Report.Failed ("Data read error - second record");
-             end if;
- 
-             -- Check that only two items were written to the file.
-             if not Data_IO.End_Of_File(Employee_Data_File) then
-                Report.Failed("Incorrect number of records in file");
-             end if;
- 
-          exception
-       
-             when Data_IO.End_Error =>             -- If two items not in 
-                                                   -- file (data overwritten),
-                                                   -- then fail.
-                Report.Failed ("Incorrect number of record elements in file");
- 
-             when others => 
-                Report.Failed ("Error raised during data verification");
- 
-          end Test_Verification_Block;
- 
-       exception
- 
-          when others => 
-             Report.Failed("Exception raised during Sequential_IO processing");
- 
-       end Operational_Test_Block;
- 
-       Final_Block:
-       begin
-         -- Check that file is open prior to deleting it.
-         if Data_IO.Is_Open(Employee_Data_File) then
-            Data_IO.Delete (Employee_Data_File);         
-         else
-            Data_IO.Open(Employee_Data_File, 
-                         Data_IO.In_File, 
-                         Employee_Filename);
-            Data_IO.Delete (Employee_Data_File);          
-         end if;
-       exception
-          when others =>
-             Report.Failed ("Sequential_IO Delete not properly supported");
-       end Final_Block;
- 
-    Report.Result;
- 
- exception
-   when Incomplete =>
-     Report.Result;
-   when others =>
-     Report.Failed ("Unexpected exception");
-     Report.Result;
- end CXA8002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,214 ****
- -- CXA8003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Append_File mode has not been added to package Direct_IO.
- --
- -- TEST DESCRIPTION:
- --      This test uses a procedure to change the mode of an existing Direct_IO
- --      file.  The file descriptor is passed as a parameter, along with a
- --      numeric indicator for the new mode.  Based on the numeric parameter,
- --      a Direct_IO.Reset is performed using a File_Mode'Value transformation
- --      of a string constant into a File_Mode value.  An attempt to reset a 
- --      Direct_IO file to mode Append_File should cause an Constraint_Error
- --      to be raised, as Append_File mode has not been added to Direct_IO in
- --      Ada 9X.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations supporting Direct_IO
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      19 Feb 97   PWB.CTA Allowed for non-support of Reset for certain 
- --                  modes.
- --!
- 
- with Direct_IO;
- with Report;
- 
- procedure CXA8003 is
-    Incomplete : exception;
-       begin
- 
-          Report.Test ("CXA8003", "Check that Append_File mode has not " &
-                                  "been added to package Direct_IO");
- 
-          Test_for_Direct_IO_Support:
-          declare
- 
-             subtype String_Data_Type    is String (1 .. 20);
-             type    Numeric_Data_Type   is range 1 .. 512;
-             type    Composite_Data_Type is array (1 .. 3) of String_Data_Type;
- 
-             type File_Data_Type is record
-                Data_Field_1 : String_Data_Type;
-                Data_Field_2 : Numeric_Data_Type;
-                Data_Field_3 : Composite_Data_Type;
-             end record;
- 
-             package Dir_IO is new Direct_IO (File_Data_Type);
- 
-             Data_File    : Dir_IO.File_Type;
-             Dir_Filename : constant String := Report.Legal_File_Name;
- 
-          begin
- 
-             -- An application creates a text file with mode Out_File.  
-             -- Use_Error will be raised if Direct_IO operations or external 
-             -- files are not supported.
- 
-             Dir_IO.Create (Data_File, 
-                            Dir_IO.Out_File, 
-                            Dir_Filename);
- 
-             Change_File_Mode:
-             declare
- 
-                TC_Append_Test_Executed : Boolean := False;
- 
-                type Mode_Selection_Type is ( A, I, IO, O );
- 
-       
-                procedure Change_Mode (File : in out Dir_IO.File_Type;
-                                       To   : in     Mode_Selection_Type) is
-                begin
-                   case To is
-                      when A  => 
-                         TC_Append_Test_Executed := True;
-                         Dir_IO.Reset 
-                           (File, Dir_IO.File_Mode'Value("Append_File"));
-                      when I  => 
-                         begin
-                           Dir_IO.Reset 
-                             (File, Dir_IO.File_Mode'Value("In_File"));
-                         exception
-                           when Dir_IO.Use_Error =>
-                             Report.Not_Applicable
-                               ("Reset to In_File not supported: Direct_IO");
-                             raise Incomplete;
-                         end;
-                      when IO => 
-                         begin
-                           Dir_IO.Reset 
-                             (File, Dir_IO.File_Mode'Value("Inout_File"));
-                         exception
-                           when Dir_IO.Use_Error =>
-                             Report.Not_Applicable
-                               ("Reset to InOut_File not supported: Direct_IO");
-                             raise Incomplete;
-                         end;
-                      when O  => 
-                        begin
-                          Dir_IO.Reset 
-                            (File, Dir_IO.File_Mode'Value("Out_File"));
-                         exception
-                           when Dir_IO.Use_Error =>
-                             Report.Not_Applicable
-                               ("Reset to Out_File not supported: Direct_IO");
-                             raise Incomplete;
-                         end;
-                   end case;
-                end Change_Mode;
- 
- 
-             begin
- 
-               -- At some point in the processing, the application may call a 
-               -- procedure to change the mode of the file (perhaps for 
-               -- additional data entry, data verification, etc.).  It is at 
-               -- this point that a use of Append_File mode for a Direct_IO 
-               -- file would cause an exception.
- 
-                for I in reverse Mode_Selection_Type loop
-                   Change_Mode (Data_File, I);
-                   Report.Comment 
-                     ("Mode changed to " & 
-                      Dir_IO.File_Mode'Image (Dir_IO.Mode (Data_File)));
-                end loop;
- 
-                Report.Failed("No error raised on change to Append_File mode");
- 
-             exception
- 
-                -- A handler has been provided in the application, which 
-                -- handles the constraint error, allowing processing to 
-                -- continue.
- 
-                when Constraint_Error => 
- 
-                   if TC_Append_Test_Executed then 
-                      Report.Comment ("Constraint_Error correctly raised on " &
-                                      "attempted Append_File mode selection " &
-                                      "for a Direct_IO file");
-                   else
-                      Report.Failed ("Append test was not executed");
-                   end if;
- 
-                when Incomplete => raise;
- 
-                when others  => Report.Failed ("Unexpected exception raised");
- 
-             end Change_File_Mode;
- 
-             Final_Block:
-             begin
-               if Dir_IO.Is_Open (Data_File) then
-                  Dir_IO.Delete (Data_File);
-               else
-                  Dir_IO.Open (Data_File, Dir_IO.In_File, Dir_Filename);
-                  Dir_IO.Delete (Data_File);
-               end if;
-             exception
-               when others =>
-                 Report.Failed ("Delete not properly supported: Direct_IO");
-             end Final_Block;
- 
-          exception
- 
-             -- Since Use_Error or Name_Error can be raised if, for the 
-             -- specified mode, the environment does not support Direct_IO 
-             -- operations, the following handlers are included:
- 
-             when Dir_IO.Name_Error =>
-                Report.Not_Applicable("Name_Error raised on Direct IO Create");
- 
-             when Dir_IO.Use_Error  =>
-                Report.Not_Applicable("Use_Error raised on Direct IO Create");
- 
-             when others            =>
-                Report.Failed 
-                  ("Unexpected exception raised on Direct IO Create");
- 
-          end Test_for_Direct_IO_Support;
- 
-          Report.Result;
- 
- exception
-   when Incomplete =>
-     Report.Result;
- 
- end CXA8003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,287 ****
- -- CXA9001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the operations defined in the generic package 
- --      Ada.Storage_IO provide the ability to store and retrieve objects 
- --      which may include implicit levels of indirection in their 
- --      implementation, from an in-memory buffer.
- --
- -- TEST DESCRIPTION:
- --      The following scenario demonstrates how an object of a type with 
- --      (potential) levels of indirection (based on the implementation) 
- --      can be "flattened" and written/read to/from a Direct_IO file.
- --      In this small example, we have attempted to simulate the situation 
- --      where two independent programs are using a particular Direct_IO file,
- --      one writing data to the file, and the second program reading that file.
- --      The Storage_IO Read and Write procedures are used to "flatten" 
- --      and reconstruct objects of the record type. 
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to implementations capable of supporting external
- --      Direct_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      07 Jun 95   SAIC    Modified to constrain type used with Storage_IO.
- --      20 Nov 95   SAIC    Corrected and enhanced for ACVC 2.0.1.
- --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Report;
- with Ada.Storage_IO;
- with Ada.Direct_IO;
- 
- procedure CXA9001 is
-    package Dir_IO is new Ada.Direct_IO (Integer);
-    Test_File  : Dir_IO.File_Type;
-    Incomplete : exception;
- begin
- 
-    Report.Test ("CXA9001", "Check that the operations defined in the "      &
-                            "generic package Ada.Storage_IO provide the "    &
-                            "ability to store and retrieve objects which "   &
-                            "may include implicit levels of indirection in " &
-                            "their implementation, from an in-memory buffer");
- 
- 
-    Test_For_Direct_IO_Support:
-    begin
- 
-       -- The following Create does not have any bearing on the test scenario,
-       -- but is included to check that the implementation supports Direct_IO
-       -- files.  An exception on this Create statement will raise a Name_Error
-       -- or Use_Error, which will be handled to produce a Not_Applicable
-       -- result. If created, the file is immediately deleted, as it is not 
-       -- needed for the program scenario.
- 
-       Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
- 
-    exception
- 
-        when Dir_IO.Use_Error | Dir_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Direct_IO" );
-           raise Incomplete;
- 
-    end Test_for_Direct_IO_Support;
- 
-    Deletion1:
-    begin
-       Dir_IO.Delete (Test_File);
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Direct_IO - 1" );
-    end Deletion1;
- 
- 
-    Test_Block:
-    declare
- 
-       The_Filename : constant String := Report.Legal_File_Name(2);
- 
-       -- The following type is the basic unit used in this test. It is
-       -- incorporated into the definition of the Unit_Array_Type.
- 
-       type Unit_Type is
-          record
-             Position     : Natural := 19;
-             String_Value : String (1..9) := (others => 'X');
-          end record;
- 
-       TC_Size : Natural := Natural'First;
- 
-       procedure Data_Storage (Number_Of_Units  : in     Natural;
-                               Result           :    out Natural) is
- 
-          -- Type based on input parameter.  Uses type Unit_Type 
-          -- as the array element.
-          type Unit_Array_Type is array (1..Number_Of_Units) 
-            of Unit_Type; 
- 
-          -- This type definition is the ultimate storage type used
-          -- in this test; uses type Unit_Array_Type as a record
-          -- component field.
-          -- This record type contains a component that is an array of
-          -- records, with each of these records containing a Natural
-          -- and a String value (i.e., a record containing an array of
-          -- records).
- 
-          type Data_Storage_Type is
-             record
-                Data_Value : Natural := Number_Of_Units;
-                Unit_Array : Unit_Array_Type;
-             end record;
- 
-          -- The instantiation of the following generic package is a
-          -- central point in this test.  Storage_IO is instantiated for
-          -- a specific data type, and will be used to "flatten" objects
-          -- of that type into buffers.  Direct_IO is instantiated for
-          -- these Storage_IO buffers.
- 
-          package Flat_Storage_IO is 
-            new Ada.Storage_IO (Data_Storage_Type);
-          package Buffer_IO is 
-            new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
- 
-          Buffer_File      : Buffer_IO.File_Type;
-          Outbound_Buffer  : Flat_Storage_IO.Buffer_Type;
-          Storage_Item     : Data_Storage_Type;
- 
-       begin  -- procedure Data_Storage
- 
-          Buffer_IO.Create (Buffer_File, 
-                            Buffer_IO.Out_File, 
-                            The_Filename);
- 
-          Flat_Storage_IO.Write (Buffer => Outbound_Buffer, 
-                                 Item   => Storage_Item);
- 
-          -- At this point, any levels of indirection have been removed
-          -- by the Storage_IO procedure, and the buffered data can be
-          -- written to a file.
- 
-          Buffer_IO.Write (Buffer_File, Outbound_Buffer);
-          Buffer_IO.Close (Buffer_File);
-          Result := Storage_Item.Unit_Array'Last +           -- 5 +
-                    Storage_Item.Unit_Array                  -- 9
-                      (Storage_Item.Unit_Array'First).String_Value'Length;
- 
-       exception
-          when others => 
-             Report.Failed ("Data storage error");
-             if Buffer_IO.Is_Open (Buffer_File) then
-                Buffer_IO.Close (Buffer_File);
-             end if;       
-       end Data_Storage;
- 
-       procedure Data_Retrieval (Number_Of_Units  : in     Natural;
-                                 Result           :    out Natural) is
-          type Unit_Array_Type is array (1..Number_Of_Units) 
-            of Unit_Type;
- 
-          type Data_Storage_Type is
-             record
-                Data_Value : Natural := Number_Of_Units;
-                Unit_Array : Unit_Array_Type;
-             end record;
- 
-          package Flat_Storage_IO is 
-            new Ada.Storage_IO (Data_Storage_Type);
-          package Reader_IO is 
-            new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
- 
-          Reader_File      : Reader_IO.File_Type;
-          Inbound_Buffer   : Flat_Storage_IO.Buffer_Type;
-          Storage_Item     : Data_Storage_Type; 
-          TC_Item          : Data_Storage_Type; 
- 
-       begin  -- procedure Data_Retrieval
- 
-          Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
-          Reader_IO.Read (Reader_File, Inbound_Buffer);
- 
-          Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
- 
-          -- Validate the reconstructed value against an "unflattened"
-          -- value.
- 
-          if Storage_Item.Data_Value /= TC_Item.Data_Value 
-          then
-             Report.Failed ("Data_Retrieval Error - 1");
-          end if;
- 
-          for i in 1..Number_Of_Units loop
-             if Storage_Item.Unit_Array(i).String_Value'Length  /=
-                TC_Item.Unit_Array(i).String_Value'Length      or
-                Storage_Item.Unit_Array(i).Position     /=
-                TC_Item.Unit_Array(i).Position             or
-                Storage_Item.Unit_Array(i).String_Value /=
-                TC_Item.Unit_Array(i).String_Value      
-             then
-                Report.Failed ("Data_Retrieval Error - 2");
-             end if;
-          end loop;
- 
-          Result := Storage_Item.Unit_Array'Last +           -- 5 +
-                    Storage_Item.Unit_Array                  -- 9
-                      (Storage_Item.Unit_Array'First).String_Value'Length;
- 
-          if Reader_IO.Is_Open (Reader_File) then
-             Reader_IO.Delete (Reader_File);
-          else
-             Reader_IO.Open (Reader_File, 
-                             Reader_IO.In_File, 
-                             The_Filename);
-             Reader_IO.Delete (Reader_File);
-          end if;       
- 
-       exception
-          when others => 
-             Report.Failed ("Exception raised in Data_Retrieval");
-             if Reader_IO.Is_Open (Reader_File) then
-                Reader_IO.Delete (Reader_File);
-             else
-                Reader_IO.Open (Reader_File, 
-                                Reader_IO.In_File, 
-                                The_Filename);
-                Reader_IO.Delete (Reader_File);
-             end if;       
-       end Data_Retrieval;
- 
- 
-    begin  -- Test_Block
- 
-       -- The number of Units is provided in this call to Data_Storage.
-       Data_Storage (Number_Of_Units  => Natural(Report.Ident_Int(5)), 
-                     Result           => TC_Size);
- 
-       if TC_Size /= 14 then
-          Report.Failed ("Data_Storage error in Data_Storage");
-       end if;
- 
-       Data_Retrieval (Number_Of_Units  => Natural(Report.Ident_Int(5)), 
-                       Result           => TC_Size);
- 
-       if TC_Size /= 14 then
-          Report.Failed ("Data retrieval error in Data_Retrieval");
-       end if;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXA9001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,482 ****
- -- CXA9002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the operations defined in the generic package 
- --      Ada.Storage_IO provide the ability to store and retrieve objects 
- --      of tagged types from in-memory buffers.
- --
- -- TEST DESCRIPTION:
- --      The following scenario demonstrates how objects of a tagged type, 
- --      extended types, and twice extended types can be written/read
- --      to/from Direct_IO files. The Storage_IO subprograms, Read and Write, 
- --      demonstrated in this scenario, perform tag "fixing" prior to/following
- --      transfer to the Direct_IO files.
- --      This method is especially important for those implementations that 
- --      represent tags as pointers, or for cases where the tagged objects
- --      are read in by a program other than the one that wrote them.  
- --
- --      In this small example, we have attempted to simulate the situation 
- --      where two independent programs are using a series of Direct_IO files,
- --      one writing data to the files, and the second program reading the 
- --      data from those files.  Two procedures are defined, the first
- --      simulating the program responsible for writing, the second simulating 
- --      a separate program opening and reading the data from the files.  
- --      
- --      The hierarchy of types used in this test can be displayed as follows:
- --      
- --                                Account_Type
- --                                 /       \
- --                                /         \
- --                               /           \
- --                  Cash_Account_Type       Investment_Account_Type
- --                     /         \
- --                    /           \
- --                   /             \
- --      Checking_Account_Type    Savings_Account_Type
- --      
- -- APPLICABILITY CRITERIA: 
- --      Applicable to implementations capable of supporting external
- --      Direct_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      08 Nov 95   SAIC    Corrected incorrect prefix of 'Tag for ACVC 2.0.1,
- --                          and mode of files in Procedure Read_Data.
- --                          Added verification of objects reconstructed from
- --                          files.
- --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- package CXA9002_0 is
- 
-    type Investment_Type is (Stocks, Bonds, Mutual_Funds);
-    type Savings_Type    is (Standard, Business, Impound);
- 
-    type Account_Type is tagged 
-       record
-          Num : String (1..3);
-       end record;
- 
-    type Cash_Account_Type is new Account_Type with
-       record
-          Years_As_Customer : Natural := 1;
-       end record;
- 
-    type Investment_Account_Type is new Account_Type with
-       record
-          Investment_Vehicle : Investment_Type := Stocks;
-       end record;
- 
-    type Checking_Account_Type is new Cash_Account_Type with
-       record
-          Checks_Per_Year  : Positive := 200;
-          Interest_Bearing : Boolean  := False;
-       end record;
- 
-    type Savings_Account_Type is new Cash_Account_Type with
-       record
-          Kind : Savings_Type := Standard;
-       end record;
- 
- end CXA9002_0;
- 
- ---
- 
- with Report;
- with Ada.Storage_IO;
- with Ada.Direct_IO;
- with Ada.Tags;
- with CXA9002_0;
- 
- procedure CXA9002 is
-    package Dir_IO is new Ada.Direct_IO (Integer);
-    Test_File : Dir_IO.File_Type;
-    Incomplete : exception;
- begin
- 
-    Report.Test ("CXA9002", "Check that the operations defined in the "   &
-                            "generic package Ada.Storage_IO provide the " &
-                            "ability to store and retrieve objects of "   &
-                            "tagged types from in-memory buffers");
- 
- 
-    Test_For_Direct_IO_Support:
-    begin
- 
-       -- The following Create does not have any bearing on the test scenario,
-       -- but is included to check that the implementation supports Direct_IO
-       -- files.  An exception on this Create statement will raise a Name_Error
-       -- or Use_Error, which will be handled to produce a Not_Applicable
-       -- result. If created, the file is immediately deleted, as it is not 
-       -- needed for the program scenario.
- 
-       Dir_IO.Create (Test_File, 
-                      Dir_IO.Out_File, 
-                      Report.Legal_File_Name(1));
-    exception
- 
-        when Dir_IO.Use_Error | Dir_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Direct_IO" );
-           raise Incomplete;
- 
-    end Test_for_Direct_IO_Support;
- 
-    Deletion:
-    begin
-       Dir_IO.Delete (Test_File);
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Direct_IO" );
-    end Deletion;
- 
-    Test_Block:
-    declare
- 
-       use CXA9002_0; 
- 
-       Acct_Filename : constant String := Report.Legal_File_Name(1);
-       Cash_Filename : constant String := Report.Legal_File_Name(2);
-       Inv_Filename  : constant String := Report.Legal_File_Name(3);
-       Chk_Filename  : constant String := Report.Legal_File_Name(4);
-       Sav_Filename  : constant String := Report.Legal_File_Name(5);
- 
-       type Tag_Pointer_Type is access String;
- 
-       TC_Account_Type_Tag,           
-       TC_Cash_Account_Type_Tag,      
-       TC_Investment_Account_Type_Tag,
-       TC_Checking_Account_Type_Tag,  
-       TC_Savings_Account_Type_Tag    : Tag_Pointer_Type;
- 
-       TC_Account            : Account_Type            := 
-                                 (Num => "123");
- 
-       TC_Cash_Account       : Cash_Account_Type       := 
-                                 (Num               => "234", 
-                                  Years_As_Customer => 3);
- 
-       TC_Investment_Account : Investment_Account_Type := 
-                                 (Num                => "456", 
-                                  Investment_Vehicle => Bonds);
- 
-       TC_Checking_Account   : Checking_Account_Type   :=
-                                 (Num               => "567", 
-                                  Years_As_Customer => 2,  
-                                  Checks_Per_Year   => 300,
-                                  Interest_Bearing  => True);
- 
-       TC_Savings_Account    : Savings_Account_Type    :=
-                                 (Num               => "789", 
-                                  Years_As_Customer => 14, 
-                                  Kind              => Business);
-               
-       procedure Buffer_Data is
- 
-          Account            : Account_Type            := 
-                                 TC_Account;
-          Cash_Account       : Cash_Account_Type       := 
-                                 TC_Cash_Account;
-          Investment_Account : Investment_Account_Type :=
-                                 TC_Investment_Account;
-          Checking_Account   : Checking_Account_Type   :=
-                                 TC_Checking_Account;
-          Savings_Account    : Savings_Account_Type    :=
-                                 TC_Savings_Account;
- 
-          -- The instantiations below are a central point in this test. 
-          -- Storage_IO is instantiated for each of the specific tagged
-          -- type. These instantiated packages will be used to compress 
-          -- tagged objects of these various types into buffers that will 
-          -- be written to the Direct_IO files declared below.
- 
-          package Acct_SIO is new Ada.Storage_IO (Account_Type);
-          package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
-          package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
-          package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
-          package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
- 
-          -- Direct_IO is instantiated for the buffer types defined in the
-          -- instantiated Storage_IO packages.
- 
-          package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
-          package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
-          package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
-          package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
-          package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
- 
-          Acct_Buffer : Acct_SIO.Buffer_Type;
-          Cash_Buffer : Cash_SIO.Buffer_Type;
-          Inv_Buffer  : Inv_SIO.Buffer_Type;
-          Chk_Buffer  : Chk_SIO.Buffer_Type;
-          Sav_Buffer  : Sav_SIO.Buffer_Type;
- 
-          Acct_File   : Acct_DIO.File_Type;
-          Cash_File   : Cash_DIO.File_Type;
-          Inv_File    : Inv_DIO.File_Type;
-          Chk_File    : Chk_DIO.File_Type;
-          Sav_File    : Sav_DIO.File_Type;
- 
-       begin 
- 
-          Acct_DIO.Create (Acct_File, Acct_DIO.Out_File, Acct_Filename);
-          Cash_DIO.Create (Cash_File, Cash_DIO.Out_File, Cash_Filename);
-          Inv_DIO.Create  (Inv_File,  Inv_DIO.Out_File,  Inv_Filename);
-          Chk_DIO.Create  (Chk_File,  Chk_DIO.Out_File,  Chk_Filename);
-          Sav_DIO.Create  (Sav_File,  Sav_DIO.Out_File,  Sav_Filename);
- 
-          -- Store the tag values of the objects declared above for 
-          -- comparison with tag values of objects following processing.
- 
-          TC_Account_Type_Tag := 
-            new String'(Ada.Tags.External_Tag(Account_Type'Tag));
- 
-          TC_Cash_Account_Type_Tag := 
-            new String'(Ada.Tags.External_Tag(Cash_Account_Type'Tag));
- 
-          TC_Investment_Account_Type_Tag := 
-            new String'(Ada.Tags.External_Tag(Investment_Account_Type'Tag));
- 
-          TC_Checking_Account_Type_Tag := 
-            new String'(Ada.Tags.External_Tag(Checking_Account_Type'Tag));
- 
-          TC_Savings_Account_Type_Tag := 
-            new String'(Ada.Tags.External_Tag(Savings_Account_Type'Tag));
- 
-          -- Prepare tagged data for writing to the Direct_IO files using
-          -- Storage_IO procedure to place data in buffers.
- 
-          Acct_SIO.Write (Buffer => Acct_Buffer, Item => Account);
-          Cash_SIO.Write (Cash_Buffer, Cash_Account);
-          Inv_SIO.Write  (Inv_Buffer, Item => Investment_Account);  
-          Chk_SIO.Write  (Buffer => Chk_Buffer, Item => Checking_Account);
-          Sav_SIO.Write  (Sav_Buffer, Savings_Account);
- 
-          -- At this point, the data and associated tag values have been
-          -- buffered by the Storage_IO procedure, and the buffered data 
-          -- can be written to the appropriate Direct_IO file.
- 
-          Acct_DIO.Write (File => Acct_File, Item => Acct_Buffer);
-          Cash_DIO.Write (Cash_File, Cash_Buffer);
-          Inv_DIO.Write  (Inv_File, Item => Inv_Buffer);
-          Chk_DIO.Write  (File => Chk_File, Item =>Chk_Buffer);
-          Sav_DIO.Write  (Sav_File, Sav_Buffer);
- 
-          -- Close all Direct_IO files.
- 
-          Acct_DIO.Close (Acct_File);
-          Cash_DIO.Close (Cash_File);
-          Inv_DIO.Close  (Inv_File); 
-          Chk_DIO.Close  (Chk_File); 
-          Sav_DIO.Close  (Sav_File); 
- 
-       exception
-          when others => Report.Failed("Exception raised in Buffer_Data");
-       end Buffer_Data;
- 
-       procedure Read_Data is
- 
-          Account            : Account_Type;
-          Cash_Account       : Cash_Account_Type;
-          Investment_Account : Investment_Account_Type;
-          Checking_Account   : Checking_Account_Type;
-          Savings_Account    : Savings_Account_Type;
- 
-          -- Storage_IO is instantiated for each of the specific tagged
-          -- type. 
- 
-          package Acct_SIO is new Ada.Storage_IO (Account_Type);
-          package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
-          package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
-          package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
-          package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
- 
-          -- Direct_IO is instantiated for the buffer types defined in the
-          -- instantiated Storage_IO packages.
- 
-          package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
-          package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
-          package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
-          package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
-          package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
- 
-          Acct_Buffer : Acct_SIO.Buffer_Type;
-          Cash_Buffer : Cash_SIO.Buffer_Type;
-          Inv_Buffer  : Inv_SIO.Buffer_Type;
-          Chk_Buffer  : Chk_SIO.Buffer_Type;
-          Sav_Buffer  : Sav_SIO.Buffer_Type;
- 
-          Acct_File   : Acct_DIO.File_Type;
-          Cash_File   : Cash_DIO.File_Type;
-          Inv_File    : Inv_DIO.File_Type;
-          Chk_File    : Chk_DIO.File_Type;
-          Sav_File    : Sav_DIO.File_Type;
- 
-       begin
- 
-          -- Open the Direct_IO files.
- 
-          Acct_DIO.Open (Acct_File, Acct_DIO.In_File, Acct_Filename);
-          Cash_DIO.Open (Cash_File, Cash_DIO.In_File, Cash_Filename);
-          Inv_DIO.Open  (Inv_File,  Inv_DIO.In_File,  Inv_Filename);
-          Chk_DIO.Open  (Chk_File,  Chk_DIO.In_File,  Chk_Filename);
-          Sav_DIO.Open  (Sav_File,  Sav_DIO.In_File,  Sav_Filename);
- 
-          -- Read the buffer data from the files using Direct_IO.
- 
-          Acct_DIO.Read (File => Acct_File, Item => Acct_Buffer);
-          Cash_DIO.Read (Cash_File, Cash_Buffer);
-          Inv_DIO.Read  (Inv_File, Item => Inv_Buffer);
-          Chk_DIO.Read  (File => Chk_File, Item =>Chk_Buffer);
-          Sav_DIO.Read  (Sav_File, Sav_Buffer);
- 
-          -- At this point, the data and associated tag values are stored
-          -- in buffers. Use the Storage_IO procedure Read to recreate the
-          -- tagged objects from the buffers.
- 
-          Acct_SIO.Read (Buffer => Acct_Buffer, Item => Account);
-          Cash_SIO.Read (Cash_Buffer, Cash_Account);
-          Inv_SIO.Read  (Inv_Buffer, Item => Investment_Account);  
-          Chk_SIO.Read  (Buffer => Chk_Buffer, Item => Checking_Account);
-          Sav_SIO.Read  (Sav_Buffer, Savings_Account);
- 
-          -- Delete all Direct_IO files.
- 
-          Acct_DIO.Delete (Acct_File);
-          Cash_DIO.Delete (Cash_File);
-          Inv_DIO.Delete  (Inv_File); 
-          Chk_DIO.Delete  (Chk_File); 
-          Sav_DIO.Delete  (Sav_File); 
- 
-          Data_Verification_Block:
-          begin
- 
-             if Account /= TC_Account then
-                Report.Failed("Incorrect Account object reconstructed");
-             end if;
- 
-             if Cash_Account /= TC_Cash_Account then
-                Report.Failed
-                  ("Incorrect Cash_Account object reconstructed");
-             end if;   
- 
-             if Investment_Account /= TC_Investment_Account then
-                Report.Failed
-                  ("Incorrect Investment_Account object reconstructed");
-             end if;   
- 
-             if Checking_Account /= TC_Checking_Account then
-                Report.Failed
-                  ("Incorrect Checking_Account object reconstructed");
-             end if;   
- 
-             if Savings_Account /= TC_Savings_Account then
-                Report.Failed
-                  ("Incorrect Savings_Account object reconstructed");
-             end if;   
-                
-          exception
-             when others =>
-               Report.Failed
-                 ("Exception raised during Data_Verification Block");
-          end Data_Verification_Block;
- 
- 
-          -- To ensure that the tags of the values reconstructed by 
-          -- Storage_IO were properly preserved, object tag values following 
-          -- object reconstruction are compared with tag values of objects
-          -- stored prior to processing.
- 
-          Tag_Verification_Block:
-          begin
- 
-             if TC_Account_Type_Tag.all /= 
-                Ada.Tags.External_Tag(Account_Type'Class(Account)'Tag)
-             then
-                Report.Failed("Incorrect Account tag");
-             end if;
- 
-             if TC_Cash_Account_Type_Tag.all       /= 
-                Ada.Tags.External_Tag(
-                  Cash_Account_Type'Class(Cash_Account)'Tag)
-             then
-                Report.Failed("Incorrect Cash_Account tag");
-             end if;
- 
-             if TC_Investment_Account_Type_Tag.all /=                 
-                Ada.Tags.External_Tag(
-                  Investment_Account_Type'Class(Investment_Account)'Tag)
-             then
-                Report.Failed("Incorrect Investment_Account tag");
-             end if;
- 
-             if TC_Checking_Account_Type_Tag.all   /=
-                Ada.Tags.External_Tag(
-                  Checking_Account_Type'Class(Checking_Account)'Tag)
-             then
-                Report.Failed("Incorrect Checking_Account tag");
-             end if;
- 
-             if TC_Savings_Account_Type_Tag.all    /=
-                Ada.Tags.External_Tag(
-                  Savings_Account_Type'Class(Savings_Account)'Tag)
-             then
-                Report.Failed("Incorrect Savings_Account tag");
-             end if;
- 
-          exception
-             when others => 
-               Report.Failed ("Exception raised during tag evaluation");
-          end Tag_Verification_Block;
- 
-       exception
-          when others => Report.Failed ("Exception in Read_Data");
-       end Read_Data;
- 
-       begin  -- Test_Block
- 
-       -- Enter the data into the appropriate files.
-       Buffer_Data;
- 
-       -- Reconstruct the data from files, and verify the results.
-       Read_Data;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXA9002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,279 ****
- -- CXAA001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the Line_Length and Page_Length maximums for a Text_IO
- --      file of mode Append_File are initially zero (unbounded) after a
- --      Create, Open, or Reset, and that these values can be modified using
- --      the procedures Set_Line_Length and Set_Page_Length.
- --      Check that setting the Line_Length and Page_Length attributes to zero
- --      results in an unbounded Text_IO file.
- --      Check that setting the line length when in Append_Mode doesn't 
- --      change the length of lines previously written to the Text_IO file.
- --
- -- TEST DESCRIPTION:
- --      This test attempts to simulate a possible text processing environment.
- --      String values, from a number of different string types, are written to 
- --      a Text_IO file.  Prior to the writing of each, the line length is set 
- --      to the particular length of the data being written.  In addition, the 
- --      default line and page lengths are checked, to determine whether they 
- --      are unbounded (length = 0) following a create, reset, or open of a 
- --      Text_IO file with mode Append_File.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA001 is
-    use Ada;
-    Data_File      : Text_IO.File_Type;
-    Data_Filename  : constant String :=
-                               Report.Legal_File_Name ( Nam => "CXAA001" );
-    Incomplete : exception;
- begin
- 
-    Report.Test ("CXAA001","Check that the Line_Length and Page_Length "      &
-                           "maximums for a Text_IO file of mode Append_File " &
-                           "are initially zero (unbounded) after a Create, "  &
-                           "Open, or Reset, and that these values can be "    &
-                           "modified using the procedures Set_Line_Length "   &
-                           "and Set_Page_Length");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise an exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Data_File,
-                       Mode => Text_IO.Append_File,
-                       Name => Data_Filename);
- 
-    exception
- 
-        when Text_IO.Use_Error | Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Append_File for Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       subtype Confidential_Data_Type is string (1 .. 10);
-       subtype Secret_Data_Type       is string (1 .. 20);
-       subtype Top_Secret_Data_Type   is string (1 .. 30);
- 
-       Zero                   : constant Text_IO.Count :=  0;
-       Confidential_Data_Size : constant Text_IO.Count := 10;
-       Secret_Data_Size       : constant Text_IO.Count := 20;
-       Top_Secret_Data_Size   : constant Text_IO.Count := 30;
- 
-       -- The following generic procedure is designed to simulate a text
-       -- processing environment where line and page sizes are set and 
-       -- verified prior to the writing of data to a file.
- 
-       generic
-          Data_Size : Text_IO.Count;
-       procedure Write_Data_To_File (Data_Item : in String);
- 
-       procedure Write_Data_To_File (Data_Item : in String) is
-          use Text_IO;  -- Used to provide visibility to the "/=" operator.
-       begin
-          if (Text_IO.Line_Length (Data_File) /= Zero) then -- Check default
-             Report.Failed("Line not of unbounded length"); -- line length,
-          elsif (Text_IO.Page_Length (Data_File) /= Zero) then -- default
-             Report.Failed ("Page not of unbounded length"); -- page length.
-          end if;
-       
-          Text_IO.Set_Line_Length (File => Data_File,    -- Set the line
-                                   To   => Data_Size);   -- length.
-          Text_IO.Set_Page_Length (File => Data_File,    -- Set the page
-                                   To   => Data_Size);   -- length.
-          -- Verify the lengths set.
-          if (Integer(Text_IO.Line_Length (Data_File)) /= 
-              Report.Ident_Int(Integer(Data_Size))) then
-             Report.Failed ("Line length not set to appropriate length");
-          elsif (Integer(Text_IO.Page_Length (Data_File)) /= 
-                 Report.Ident_Int(Integer(Data_Size))) then
-             Report.Failed ("Page length not set to appropriate length");
-          end if;
- 
-          Text_IO.Put_Line (File => Data_File,           -- Write data to
-                            Item => Data_Item);          -- file.
- 
-       end Write_Data_To_File;
- 
-       -- Instantiation for the three data types/sizes.
- 
-       procedure Write_Confidential_Data is 
-         new Write_Data_To_File (Data_Size => Confidential_Data_Size);
- 
-       procedure Write_Secret_Data is 
-         new Write_Data_To_File (Data_Size => Secret_Data_Size);
- 
-       procedure Write_Top_Secret_Data is 
-         new Write_Data_To_File (Data_Size => Top_Secret_Data_Size);
- 
-       Confidential_Item : Confidential_Data_Type := "Confidenti";
-       Secret_Item       : Secret_Data_Type       := "Secret Data Values  ";
-       Top_Secret_Item   : Top_Secret_Data_Type   := 
-         "Extremely Top Secret Data     ";
- 
-    begin
- 
-       -- The following call simulates processing occurring after the create
-       -- of a Text_IO file with mode Append_File.
- 
-       Write_Confidential_Data (Confidential_Item);
-     
-       -- The following call simulates processing occurring after the reset
-       -- of a Text_IO file with mode Append_File.
- 
-       Reset1:
-       begin
-          Text_IO.Reset (Data_File, Text_IO.Append_File); -- Reset to
-                                                          -- Append_File mode.
-       exception
-          when Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to Append_File not supported for Text_IO" );
-             raise Incomplete;
-       end Reset1;
- 
-       Write_Secret_Data (Data_Item    => Secret_Item);
- 
-       Text_IO.Close (Data_File);                      -- Close file.
- 
-       -- The following processing simulates processing occurring after the
-       -- opening of an existing file with mode Append_File.
- 
-       Text_IO.Open (Data_File,                        -- Open file in
-                     Text_IO.Append_File,              -- Append_File mode.
-                     Data_Filename);  
-                                                          
-       Write_Top_Secret_Data (Top_Secret_Item); 
- 
-       Test_Verification_Block:
-       declare
-          TC_String1,
-          TC_String2,
-          TC_String3  : String (1..80) := (others => ' ');
-          TC_Length1,
-          TC_Length2,
-          TC_Length3  : Natural := 0;
-       begin
- 
-          Reset2:
-          begin
-             Text_IO.Reset (Data_File, Text_IO.In_File); -- Reset for reading.
-          exception
-             when Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset2;
- 
-          Text_IO.Get_Line (Data_File, TC_String1, TC_Length1); 
-          Text_IO.Get_Line (Data_File, TC_String2, TC_Length2); 
-          Text_IO.Get_Line (Data_File, TC_String3, TC_Length3); 
- 
-          -- Verify that the line lengths of each line were accurate.
-          -- Note: Each data line was written to the file after the
-          -- particular line length had been set (to the data length).
- 
-          if not ((TC_Length1 = Natural(Confidential_Data_Size)) and 
-                  (TC_Length2 = Natural(Secret_Data_Size))       and 
-                  (TC_Length3 = Natural(Top_Secret_Data_Size)))  then
-             Report.Failed ("Inaccurate line lengths read from file");
-          end if;
- 
-          -- Verify that the data read from the file are accurate.
-  
-          if (TC_String1(1..TC_Length1) /= Confidential_Item) or else
-             (TC_String2(1..TC_Length2) /= Secret_Item)       or else
-             (TC_String3(1..TC_Length3) /= Top_Secret_Item)   then
-             Report.Failed ("Corrupted data items read from file");
-          end if;
- 
-       exception
-       
-          when Incomplete =>
-             raise; 
- 
-          when others => 
-                Report.Failed ("Error raised during data verification");
- 
-       end Test_Verification_Block;
- 
-    exception
- 
-          when Incomplete =>
-             raise; 
- 
-          when others => 
-             Report.Failed ("Exception raised during Text_IO processing");
- 
-       end Operational_Test_Block;
- 
-       Deletion:
-       begin
-          -- Check that the file is open prior to deleting it.
-          if Text_IO.Is_Open(Data_File) then
-             Text_IO.Delete(Data_File);
-          else
-             Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename);
-             Text_IO.Delete(Data_File);
-          end if;
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Text_IO" );
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,257 ****
- -- CXAA002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedures New_Page, Set_Line, Set_Col, and New_Line
- --      subprograms perform properly on a text file created with mode
- --      Append_File.
- --      Check that the attributes Page, Line, and Column are all set to 1
- --      following the creation of a text file with mode Append_File.
- --      Check that the functions Page, Line, and Col perform properly on a
- --      text file created with mode Append_File.
- --      Check that the procedures Put and Put_Line perform properly on text
- --      files created with mode Append_File.
- --      Check that the procedure Set_Line sets the current line number to
- --      the value specified by the parameter "To" for text files created with
- --      mode Append_File.  
- --      Check that the procedure Set_Col sets the current column number to
- --      the value specified by the parameter "To" for text files created with
- --      mode Append_File.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to simulate the text processing that could
- --      occur with files that have been created in Append_File mode. Various
- --      calls to Text_IO formatting subprograms are called to properly
- --      position text appended to a document.  The text content and position
- --      are subsequently verified for accuracy.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- 
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA002 is
-    use Ada;
-       Data_File        : Text_IO.File_Type;
-       Data_Filename    : constant String := 
-                              Report.Legal_File_Name ( Nam => "CXAA002" );
-    Incomplete : exception;
- begin
- 
-    Report.Test ("CXAA002", "Check that page, line, and column formatting " &
-                            "subprograms perform properly on text files "   &
-                            "created with mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise the exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Data_File,
-                       Mode => Text_IO.Append_File,
-                       Name => Data_Filename);
- 
-    exception
- 
-       when Text_IO.Use_Error | Text_IO.Name_Error =>
-          Report.Not_Applicable
-            ( "Files not supported - Create as Append_File for Text_IO" );
-          raise Incomplete;
- 
-    end Test_for_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
-       Default_Position : constant Text_IO.Positive_Count := 1;
-       Section_Header   : constant String := "VII.  ";
-       Appendix_Title   : constant String := "Appendix A";
-       Appendix_Content : constant String := "TBD";
- 
-       -- The following procedure simulates the addition of an Appendix page
-       -- to an existing text file.
-       procedure Position_Appendix_Text is
-          use Text_IO;   -- To provide visibility to the "/=" operator.
-       begin
- 
-          -- Test control code.
-          -- Verify initial page, line, column number.
-          if "/="(Text_IO.Page (Data_File), Default_Position) then
-             Report.Failed ("Incorrect default page number");   
-          end if;
-          if Text_IO.Line (Data_File) /= Default_Position then
-             Report.Failed ("Incorrect default line number");     
-          end if;   
-          if "/="(Text_IO.Col (Data_File), Default_Position) then
-             Report.Failed ("Incorrect default column number");  
-          end if;   
- 
-          -- Simulated usage code.
-          -- Set new page/line positions.
-          Text_IO.Put_Line
-            (Data_File, "Add some optional data to the file here");
-          Text_IO.New_Page (Data_File);      
-          Text_IO.New_Line (File => Data_File, Spacing => 2);
-       
-          -- Test control code.
-          if Integer(Text_IO.Page (Data_File)) /= Report.Ident_Int(2) or else
-             Integer(Text_IO.Line (Data_File)) /= Report.Ident_Int(3) then
-             Report.Failed ("Incorrect results from page/line positioning");
-          end if;
- 
-          -- Simulated usage code.
-          Text_IO.Put      (Data_File, Section_Header);     -- Position title 
-          Text_IO.Put_Line (Data_File, Appendix_Title);     -- of Appendix.
- 
-          Text_IO.Set_Line (File => Data_File, To => 5);    -- Set new 
-          Text_IO.Set_Col  (File => Data_File, To => 8);    -- position.
- 
-          -- Test control code.
-          if (Integer(Text_IO.Line (Data_File)) /= Report.Ident_Int(5)) or  
-             (Integer(Text_IO.Col  (Data_File)) /= Report.Ident_Int(8)) then
-             Report.Failed ("Incorrect results from line/column positioning");
-          end if;
-                                                               
-          -- Simulated usage code.                          -- Position 
-          Text_IO.Put_Line (Data_File, Appendix_Content);   -- content of 
-                                                            -- Appendix.
-       end Position_Appendix_Text;
- 
-    begin
- 
-       -- This code section simulates a scenario that could occur in a 
-       -- text processing environment:
-       --    A document is created/modified/edited Then...
-       --    Text is to be appended to the document.
-       --    A procedure is called to perform that operation.  
-       --    The position on the appended page is set, verified, and text is 
-       --    appended to the existing file.  
-       -- 
-       -- Note: The text file has been originally created in Append_File
-       -- mode, and has not been closed prior to this processing.
- 
-       Position_Appendix_Text;
- 
-       Test_Verification_Block:
-       declare
-          TC_Page, 
-          TC_Line, 
-          TC_Column   : Text_IO.Positive_Count;
-          TC_Position : Natural := 0;
-          Blanks      : constant String  := "                 ";
-          TC_String   : String (1 .. 17) := Blanks;
-       begin   
-                                        
-          Reset1:
-          begin
-             Text_IO.Reset     (Data_File, Text_IO.In_File);
-          exception
-             when Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset1;
- 
-          Text_IO.Skip_Page (Data_File);
-                                                  -- Loop to the third line
-          for I in 1 .. 3 loop                    -- and read the contents.
-             Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
-          end loop;
- 
-          if (TC_Position /= 16) or else          -- Verify the title line.
-             (TC_String (1..4)  /= "VII.") or else             
-             (TC_String (3..16) /= ("I.  " & Appendix_Title)) then
-             Report.Failed ("Incorrect positioning of title line");
-          end if;
- 
-          TC_String := Blanks;                    -- Clear string.
-                                                  -- Loop to the fifth line
-          for I in 4 .. 5 loop                    -- and read the contents.
-             Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
-          end loop;
- 
-          if (TC_Position /= 10) or               -- Verify the contents.
-             (TC_String (8..10) /= Appendix_Content) then     
-             Report.Failed ("Incorrect positioning of contents line");
-          end if;
- 
-       exception
-       
-          when Incomplete =>
-             raise; 
- 
-          when others => 
-                Report.Failed ("Error raised during data verification");
- 
-       end Test_Verification_Block;
- 
-    exception
- 
-          when Incomplete =>
-             raise; 
- 
-          when others => 
-             Report.Failed ("Exception raised during Text_IO processing");
- 
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       -- Delete the external file.
-       if Text_IO.Is_Open(Data_File) then
-          Text_IO.Delete(Data_File);
-       else
-          Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename);
-          Text_IO.Delete(Data_File);
-       end if;
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Text_IO" );
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,293 ****
- -- CXAA003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedures New_Page, Set_Line, Set_Col, and New_Line
- --      subprograms perform properly on a text file reset (from Out_File) 
- --      with mode Append_File.
- --      Check that the attributes Page, Line, and Column are all set to 1
- --      following the reset of a text file with mode Append_File.
- --      Check that the functions Page, Line, and Col perform properly on a
- --      text file reset with mode Append_File.
- --      Check that the procedures Put and Put_Line perform properly on text
- --      files reset with mode Append_File.
- --      Check that the procedure Set_Line sets the current line number to
- --      the value specified by the parameter "To" for text files reset with
- --      mode Append_File.  Check that Set_Line has no effect if the specified
- --      line equals the current line.
- --      Check that the procedure Set_Col sets the current column number to
- --      the value specified by the parameter "To" for text files reset with
- --      mode Append_File.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to simulate the text processing that could
- --      occur with files that have been created in Out_File mode,
- --      and then reset to Append_File mode. 
- --      Various calls to Text_IO formatting subprograms are called to properly
- --      position text appended to a document.  The text content and position
- --      are subsequently verified for accuracy.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      24 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA003 is
-    use Ada;  
-    Data_File        : Text_IO.File_Type;
-    Data_Filename    : constant String :=
-                       Report.Legal_File_Name ( Nam => "CXAA003" );
-    Incomplete       : exception;
- 
- begin
- 
-    Report.Test ("CXAA003", "Check that page, line, and column formatting " &
-                            "subprograms perform properly on text files "   &
-                            "reset with mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise the exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Data_File,
-                       Mode => Text_IO.Out_File,
-                       Name => Data_Filename);
-    exception
-       when Text_IO.Use_Error | Text_IO.Name_Error =>
-         Report.Not_Applicable
-           ( "Text files not supported - Create as Out_File" );
-         raise Incomplete;
-    end Test_for_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       Default_Position : constant Text_IO.Positive_Count := 1;
- 
-       Section_Header   : constant String := "IX.  ";
-       Glossary_Title   : constant String := "GLOSSARY";
-       Glossary_Content : constant String := "TBD";
- 
-       -- The following procedure simulates the addition of a Glossary page
-       -- to an existing text file that has been reset with mode 
-       -- Append_File.
- 
-       procedure Position_Glossary_Text 
-         (The_File : in out Text_IO.File_Type) is
-          use Text_IO;   -- To provide visibility to the "/=" operator.
-       begin
- 
-          -- Test control code.
-          -- Verify initial page value.
-          if (Text_IO.Page (The_File) /= Default_Position) then
-             Report.Failed ("Incorrect default page number");  
-          end if;
-          -- Verify initial line number.
-          if (Text_IO.Line (The_File) /= Default_Position) then
-             Report.Failed ("Incorrect default line number");  
-          end if;   
-          -- Verify initial column number.
-          if (Text_IO.Col (The_File) /= Default_Position) then 
-             Report.Failed ("Incorrect default column number");
-          end if;   
-          -- Simulated usage code.  Set new page/line positions.
-          Text_IO.New_Page (The_File);                           
-          Text_IO.New_Page (The_File);                       
-          Text_IO.New_Line (File => The_File, Spacing => 1); 
- 
-          -- Test control code.
-          if (Integer(Text_IO.Page(The_File))  /= 
-              Report.Ident_Int(3))                or else
-             (Integer(Text_IO.Line (The_File)) /= 
-              Report.Ident_Int(2)) then 
-             Report.Failed ("Incorrect results from page/line positioning");
-          end if;
- 
-          -- Simulated usage code.  Position title of Glossary.
-          Text_IO.Put      (The_File, Section_Header);        
-          Text_IO.Put_Line (The_File, Glossary_Title);        
-          -- Set line to the current line.
-          Text_IO.Set_Line (File => The_File, To => 3);       
- 
-          -- Test control code.
-          if (Integer(Text_IO.Page (The_File)) /= Report.Ident_Int(3)) or
-             (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(3)) or
-             (Integer(Text_IO.Col (The_File))  /= Report.Ident_Int(1)) then
-             Report.Failed ("Set_Line failed for current line");
-          end if;
- 
-          -- Simulated usage code.
-          Text_IO.Set_Line (File => The_File, To => 4);        -- Set new 
-          Text_IO.Set_Col  (File => The_File, To => 10);       -- position.
- 
-          -- Test control code.
-          if (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(4))  or
-             (Integer(Text_IO.Col  (The_File)) /= Report.Ident_Int(10)) then
-             Report.Failed 
-               ("Incorrect results from line/column positioning");
-          end if;
- 
-          -- Simulated usage code.                          -- Position 
-          Text_IO.Put_Line (The_File, Glossary_Content);    -- content of 
-                                                            -- Glossary.
-       end Position_Glossary_Text;
- 
- 
-    begin
- 
-       -- In the scenario, data is added to the file here.
-       Text_IO.Put_Line (File => Data_File, Item => "Some optional data");
- 
-       -- This code section simulates a scenario that could occur in a 
-       -- text processing environment.  Text is to be appended to an 
-       -- existing document: 
-       --   The file is reset to append mode.
-       --   A procedure is called to perform the positioning and placement
-       --   of text.
-       --   The position on the appended page is set, verified, and text is
-       --   placed in the file.  
-       -- 
-       -- Note: The text file has been originally created in Out_File
-       -- mode, and has subsequently been reset to Append_File mode.
- 
-       Reset1:
-       begin
-          -- Reset has effect of calling New_Page.
-          Text_IO.Reset  (Data_File, Text_IO.Append_File);
-       exception
-          when Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to Append_File not supported for Text_IO" );
-             raise Incomplete;
-       end Reset1;
- 
-       Position_Glossary_Text (The_File => Data_File);
- 
-       Test_Verification_Block:
-       declare
-          TC_Page, TC_Line, TC_Column  : Text_IO.Positive_Count;
-          TC_Position                  : Natural := 0;
-          Blanks                       : constant String  :=
-            "               ";
-          TC_String                    : String (1 .. 15) := Blanks;
-       begin                                          
-          Reset2:
-          begin
-             Text_IO.Reset     (Data_File, Text_IO.In_File);
-          exception
-            when Text_IO.Use_Error =>
-              Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO" );
-              raise Incomplete;
-          end Reset2;
- 
-          Text_IO.Skip_Page (Data_File);
-          Text_IO.Skip_Page (Data_File);
- 
-          -- If the Reset to Append_File mode actually put a page terminator
-          -- on the file, as allowed (but not required) by RM A.10.2(4), then
-          -- we are now on page 3, an empty page.  We'll need to skip one more.
- 
-          if Text_IO.End_Of_Page (Data_File) then
-             Text_IO.Skip_Page (Data_File);
-          end if;
- 
-          -- Now we're on the Glossary page.
- 
-                                                 -- Loop to the second line
-          for I in 1 .. 2 loop                   -- and read the contents.
-             Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
-          end loop;
-             if (TC_Position /= 13) or else         -- Verify the title line.
-                (TC_String (1..2)  /= "IX") or else             
-                (TC_String (3..13) /= (".  " & Glossary_Title)) then
-                Report.Failed ("Incorrect positioning of title line");
-             end if;
- 
-             TC_String := Blanks;                   -- Clear string.
-                                                    -- Loop to the fourth line
-             for I in 3 .. 4 loop                   -- and read the contents.
-                Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
-             end loop;
- 
-             if (TC_Position /= 12) or              -- Verify the contents.
-                (TC_String (8..12) /= "  " & Glossary_Content) then     
-                Report.Failed ("Incorrect positioning of contents line");
-             end if;
- 
-          exception
-             when Incomplete =>
-                raise;
-             when others => 
-                Report.Failed ("Error raised during data verification");
- 
-          end Test_Verification_Block;
- 
-       exception
-          when Incomplete =>
-             raise;
-          when others => 
-             Report.Failed ("Exception raised during Text_IO processing");
- 
-       end Operational_Test_Block;
- 
-       Final_Block:
-       begin
-          -- Delete the external file.
-          if Text_IO.Is_Open (Data_File) then
-             Text_IO.Delete (Data_File);        
-          else
-             Text_IO.Open (Data_File, Text_IO.In_File, Data_Filename);
-             Text_IO.Delete (Data_File);        
-          end if;
-       exception
-          when others =>
-             Report.Failed ( "Delete not properly implemented for Text_IO" );
-       end Final_Block;
- 
-    Report.Result;
- 
-    exception
-      when Incomplete =>
-        Report.Result;
-      when others     =>
-        Report.Failed ( "Unexpected exception" );
-        Report.Result;
- 
- end CXAA003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,260 ****
- -- CXAA004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedures New_Page, Set_Line, Set_Col, and New_Line
- --      perform properly on a text file opened with mode Append_File.
- --      Check that the attributes Page, Line, and Column are all set to 1
- --      following the opening of a text file with mode Append_File.
- --      Check that the functions Page, Line, and Col perform properly on a
- --      text file opened with mode Append_File.
- --      Check that the procedures Put and Put_Line perform properly on text
- --      files opened with mode Append_File.
- --      Check that the procedure Set_Line sets the current line number to
- --      the value specified by the parameter "To" for text files opened with
- --      mode Append_File. 
- --      Check that the procedure Set_Col sets the current column number to
- --      the value specified by the parameter "To" for text files reset with
- --      mode Append_File.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to simulate the text processing that could
- --      occur with files that have been created in Out_File mode,
- --      and then reset to Append_File mode. 
- --      Various calls to Text_IO formatting subprograms are called to properly
- --      position text appended to a document.  The text content and position
- --      are subsequently verified for accuracy.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      24 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA004 is
-    use Ada;   
-    Data_File         : Text_IO.File_Type;
-    Data_Filename     : constant String :=
-                           Report.Legal_File_Name ( Nam => "CXAA004" );
-    Incomplete        : exception;
- 
- begin
- 
-    Report.Test ("CXAA004", "Check that page, line, and column formatting " &
-                            "subprograms perform properly on text files "   &
-                            "opened with mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise the exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Data_File,
-                       Mode => Text_IO.Out_File,
-                       Name => Data_Filename);
- 
-    exception
-       when Text_IO.Use_Error | Text_IO.Name_Error =>
-          Report.Not_Applicable
-             ( "Files not supported - Create for Text_IO" );
-          raise Incomplete;
-    end Test_for_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
-       use Text_IO;  -- To provide visibility to the "/=" operator.
- 
-       Default_Position  : constant Text_IO.Positive_Count := 1;
- 
-       Section_Header    : constant String := "X.  ";
-       Reference_Title   : constant String := "REFERENCES";
-       Reference_Content : constant String := "Available Upon Request";
- 
-    begin
- 
-       -- Some amount of text processing would occur here in the scenario
-       -- following file creation, prior to file closure.
-       Text_IO.Put_Line (File => Data_File, Item => "Some optional data");
- 
-       -- Close has the effect of a call to New_Page (adding a page
-       -- terminator).  
-       Text_IO.Close (Data_File);
- 
-       -- This code section simulates a scenario that could occur in a 
-       -- text processing environment:
-       --     Certain text is to be appended to a document. 
-       --     The file is opened in Append_File mode.
-       --     The position on the appended page is set, verified, and text 
-       --     is placed in the file.  
-       --
-       -- Note: The text file has been originally created in Out_File
-       -- mode, has been subsequently closed and is now being reopened in
-       -- Append_File mode for further processing.
- 
-          Text_IO.Open   (Data_File, Text_IO.Append_File, Data_Filename);
- 
-       -- Test control code.
-       if (Text_IO.Page(Data_File) /= Default_Position) then -- Verify init.
-          Report.Failed ("Incorrect default page number");   -- page value.
-       end if;
-       if (Text_IO.Line(Data_File) /= Default_Position) then -- Verify init.
-          Report.Failed ("Incorrect default line number");   -- line number.
-       end if;   
-       if (Text_IO.Col (Data_File) /= Default_Position) then -- Verify init.
-          Report.Failed ("Incorrect default column number"); -- column no.
-       end if;   
- 
-       -- Simulated usage code.
-       Text_IO.New_Page (Data_File);                        -- Set new page/
-       Text_IO.New_Line (File => Data_File, Spacing => 2);  -- line pos.
-       Text_IO.Put      (Data_File, Section_Header);        -- Position  
-       Text_IO.Put_Line (Data_File, Reference_Title);       -- title.
- 
-       -- Test control code.                                -- Verify new
-       if (Integer(Text_IO.Page (Data_File)) /=             -- page and
-           Report.Ident_Int(2)) or else                     -- line.
-          (Integer(Text_IO.Line (Data_File)) /= 
-           Report.Ident_Int(4)) then                  
-          Report.Failed ("Incorrect results from page/line positioning");
-       end if;
- 
-       -- Simulated usage code.                               
-       Text_IO.Set_Line (File => Data_File, To => 8);       -- Set new 
-       Text_IO.Set_Col  (File => Data_File, To => 30);      -- position.
-       Text_IO.Put_Line (Data_File, Reference_Content);      
-                                                              
-       -- Test control code.
-       if (Integer(Text_IO.Line (Data_File)) /= 
-           Report.Ident_Int(9))                   or         -- Verify new 
-          (Integer(Text_IO.Col  (Data_File)) /=              -- position.
-           Report.Ident_Int(1))                   then         
-          Report.Failed ("Incorrect results from line/column positioning");
-       end if;
- 
-       Test_Verification_Block:
-       declare
-          TC_Page, TC_Line, TC_Column : Text_IO.Positive_Count;
-          TC_Position                 : Natural := 0;
-          TC_String                   : String (1 .. 55) := (others => ' ');
-       begin                                          
- 
-          Reset1:
-          begin
-             Text_IO.Reset     (Data_File, Text_IO.In_File);
-          exception
-             when Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset1;
- 
-          Text_IO.Skip_Page (Data_File);
- 
-          -- If the Reset to Append_File mode actually put a page terminator
-          -- in the file, as allowed (but not required) by RM A.10.2(4), then
-          -- we are now on page 2, an empty page.  Therefore, we need to skip
-          -- one more page.
- 
-          if Text_IO.End_Of_Page (Data_File) then
-             Text_IO.Skip_Page (Data_File);
-          end if;
- 
-          -- Now we're on the reference page.
- 
-                                                  -- Loop to the third line
-          for I in 1 .. 3 loop                    -- and read the contents.
-             Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
-          end loop;
- 
-          if (TC_Position /= 14) or else          -- Verify the title line.
-             (TC_String (1..6)  /= "X.  RE") or else             
-             (TC_String (2..14) /= (".  " & Reference_Title)) then
-             Report.Failed ("Incorrect positioning of title line");
-          end if;
-                                                  -- Loop to the eighth line
-          for I in 4 .. 8 loop                    -- and read the contents.
-             Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
-          end loop;
- 
-          if (TC_Position /= 51) or               -- Verify the contents.
-             (TC_String (30..51) /= "Available Upon Request") then     
-             Report.Failed ("Incorrect positioning of contents line");
-          end if;
- 
-       exception
- 
-             when Incomplete =>
-                raise;      
-             when others => 
-                Report.Failed ("Error raised during data verification");
- 
-       end Test_Verification_Block;
- 
-    exception
- 
-       when Incomplete =>
-          raise;
-       when others => 
-          Report.Failed ("Exception raised during Text_IO processing");
- 
-    end Operational_Test_Block;
- 
-    Final_Block:
-    begin
-       -- Delete the external file.
-       if Text_IO.Is_Open (Data_File) then
-          Text_IO.Delete (Data_File);        
-       else
-          Text_IO.Open (Data_File, Text_IO.In_File, Data_Filename);
-          Text_IO.Delete (Data_File);        
-       end if;
-    exception
-       when others =>
-          Report.Failed ( "Delete not properly implemented - Text_IO" );
-    end Final_Block;
- 
-    Report.Result;
- 
- exception
- 
-    when Incomplete =>
-       Report.Result;
-    when others =>
-       Report.Failed ("Unexpected exception");
-       Report.Result;
- 
- end CXAA004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,292 ****
- -- CXAA005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedure Put, when called with string parameters, does
- --      not update the line number of a text file of mode Append_File, when
- --      the line length is unbounded (i.e., only the column number is 
- --      updated).
- --      Check that a call to the procedure Put with a null string argument
- --      has no measurable effect on a text file of mode Append_File.
- --      
- -- TEST DESCRIPTION:
- --      This test is designed to ensure that when a string is appended to an
- --      unbounded text file, it is placed following the last element currently
- --      in the file.  For an unbounded text file written with Put procedures
- --      only (not Put_Line), the line number should not be incremented by
- --      subsequent calls to Put in Append_File mode.  Only the column number
- --      should be incremented based on the length of the string parameter 
- --      placed in the file.  If a call to Put with a null string argument is
- --      made, no change to the line or column number should occur, and no
- --      element(s) should be added to the file, so that there would be no 
- --      measurable change to the file.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that support Text_IO
- --      processing and external files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      24 Feb 97   CTA.PWB Allowed for non-support of some IO operations.
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA005 is
-    An_Unbounded_File   : Ada.Text_IO.File_Type;
-    Unbounded_File_Name : constant String := 
-                             Report.Legal_File_Name ( Nam => "CXAA005" ); 
-    Incomplete          : exception;
- 
- begin
- 
-    Report.Test ("CXAA005", "Check that the procedure Put does not " &
-                            "increment line numbers when used with " &
-                            "unbounded text files of mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-    -- An application creates a text file in mode Out_File, with the intention
-    -- of entering string data packets into the file as appropriate.  In the 
-    -- event that the particular environment where the application is running 
-    -- does not support Text_IO, Use_Error will be raised on calls to Text_IO 
-    -- operations.  
-    -- This exception will be handled to produce a Not_Applicable result.
- 
-       Ada.Text_IO.Create (File => An_Unbounded_File,
-                           Mode => Ada.Text_IO.Out_File,
-                           Name => Unbounded_File_Name);
-    exception
-       when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
-          Report.Not_Applicable
-             ( "Files not supported - Create for Text_IO" );
-          raise Incomplete;
-    end Test_For_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
-       subtype String_Sequence_Type is string (1 .. 20);
-       type    String_Pointer_Type  is access String_Sequence_Type;
- 
- -- During the course of processing, the application creates a variety of data
- -- pointers that refer to particular data items.  The possibility of having
- -- null data values in this environment exists.
- 
-       Data_Packet_1     : String_Pointer_Type := 
-         new String_Sequence_Type'("One Data Sequence 01");
- 
-       Data_Packet_2     : String_Pointer_Type :=
-         new String_Sequence_Type'("New Data Sequence 02");
-           
-       Blank_Data_Packet : String_Pointer_Type :=
-         new String_Sequence_Type'("                    ");
- 
-       Null_Data_Packet  : constant String     := "";
- 
-       TC_Line, TC_Col   : Natural := 0;
- 
-       function TC_Mode_Selection (Selector : Integer) 
-          return Ada.Text_IO.File_Mode is
-       begin
-          case Selector is
-             when 1       => return Ada.Text_IO.In_File;
-             when 2       => return Ada.Text_IO.Out_File;
-             when others  => return Ada.Text_IO.Append_File;
-          end case;
-       end TC_Mode_Selection;
- 
-    begin                                         
- 
- -- The application places some data into the file, using the Put subroutine.
- -- This operation can occur one-to-many times.
- 
-        Ada.Text_IO.Put (An_Unbounded_File, Data_Packet_1.all);
-    
-        -- Test control code.
-        if (Integer(Ada.Text_IO.Col (An_Unbounded_File))  /=
-            Report.Ident_Int(21))                            or
-           (Integer(Ada.Text_IO.Line (An_Unbounded_File)) /=
-            Report.Ident_Int(1))                             then
-           Report.Failed ("Incorrect Col position after 1st Put");
-        end if;
- 
- -- The application may close the file at some point following its initial 
- -- entry of data.
- 
-       Ada.Text_IO.Close (An_Unbounded_File);
- 
- -- At some later point in the processing, more data needs to be added to the
- -- file, so the application opens the file in Append_File mode.
- 
-       Ada.Text_IO.Open (File => An_Unbounded_File,
-                         Mode => Ada.Text_IO.Append_File,
-                         Name => Unbounded_File_Name);
- 
-       -- Test control code.
-       -- Store line/column number for later comparison.
-       TC_Line := Natural(Ada.Text_IO.Line(An_Unbounded_File));
-       TC_Col  := Natural(Ada.Text_IO.Col(An_Unbounded_File));
- 
- -- Additional data items can then be appended to the file.
- 
-       Ada.Text_IO.Put (An_Unbounded_File, Blank_Data_Packet.all);
- 
-       -- Test control code.
-       if (Natural(Ada.Text_IO.Col (An_Unbounded_File))  /=
-           (TC_Col + 20))                                   or
-          (Natural(Ada.Text_IO.Line (An_Unbounded_File)) /=
-           TC_Line)                                         then
-          Report.Failed ("Incorrect Col position after 2nd Put");
-       end if;
- 
- -- In order to accommodate various scenarios, the application may have changed
- -- the mode of the data file to In_File in order to retrieve/verify some of 
- -- the data contained there.  However, with the need to place more data into 
- -- the file, the file can be reset to Append_File mode.
- 
-       Reset1:
-       begin
-          Ada.Text_IO.Reset (An_Unbounded_File, 
-                             TC_Mode_Selection (Report.Ident_Int(3)));
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to Append_File not supported for Text_IO" );
-             raise Incomplete;
-       end Reset1;
- 
-       -- Test control code.
-       -- Store line/column number for later comparison.
-       TC_Line := Natural(Ada.Text_IO.Line(An_Unbounded_File));
-       TC_Col  := Natural(Ada.Text_IO.Col(An_Unbounded_File));
- 
- -- Additional data can then be appended to the file.  On some occasions, an
- -- attempt to enter a null string value into the file may occur.  This should
- -- have no effect on the file, leaving it unchanged.
- 
-       -- No measurable effect from Put with null string.
-       Ada.Text_IO.Put (An_Unbounded_File, Null_Data_Packet);
- 
-       -- Test control code.
-       -- There should be no change following the Put above.
-       if (Natural(Ada.Text_IO.Col (An_Unbounded_File))  /= 
-           TC_Col)                                          or
-          (Natural(Ada.Text_IO.Line (An_Unbounded_File)) /= 
-           TC_Line)                                         then
-          Report.Failed ("Incorrect Col position after 3rd Put");
-       end if;
- 
- -- Additional data can be appended to the file.
- 
-       Ada.Text_IO.Put (An_Unbounded_File, Data_Packet_2.all);
- 
-       -- Test control code.
-       if (Natural(Ada.Text_IO.Col (An_Unbounded_File))  /=
-           (TC_Col + 20))                                    or
-          (Integer(Ada.Text_IO.Line (An_Unbounded_File)) /=
-           TC_Line)                                         then
-          Report.Failed ("Incorrect Col position after 4th Put");
-       end if;
- 
-       Test_Verification_Block:                  
-       declare                                   
-          File_Data : String (1 .. 80);
-          TC_Width  : Natural;
-       begin                                                
-    
- -- The application has the capability to reset the file to In_File mode to
- -- verify some of the data that is contained there.
- 
-       Reset2:
-       begin
-          Ada.Text_IO.Reset (An_Unbounded_File, Ada.Text_IO.In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported - Text_IO" );
-             raise Incomplete;
-       end Reset2;
- 
-       Ada.Text_IO.Get_Line (An_Unbounded_File,
-                             File_Data, 
-                             TC_Width);
- 
-       -- Test control code.
-       -- Since it is implementation defined whether a page
-       -- terminator separates preexisting text from new text 
-       -- following an open in append mode (as occurred above), 
-       -- verify only that the first data item written to the
-       -- file was not overwritten by any subsequent call to Put.
- 
-       if (File_Data (File_Data'First) /= 'O') or
-           (File_Data (20)              /= '1') then
-          Report.Failed ("Data placed incorrectly in file");
-       end if;
- 
-       exception
-          when Incomplete =>
-             raise;
-          when others => 
-             Report.Failed ("Error raised during data verification");
-       end Test_Verification_Block;
- 
-    exception
-       when Incomplete =>
-          raise;
-       when others => 
-          Report.Failed ("Exception in Text_IO processing");
-    end Operational_Test_Block;
- 
-    Final_Block:
-    begin
-       -- Delete the external file.
-       if Ada.Text_IO.Is_Open(An_Unbounded_File) then
-          Ada.Text_IO.Delete (An_Unbounded_File);
-       else
-          Ada.Text_IO.Open(An_Unbounded_File, 
-                           Ada.Text_IO.In_File,
-                           Unbounded_File_Name);
-          Ada.Text_IO.Delete (An_Unbounded_File);
-       end if;
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented -- Text_IO" );
-    end Final_Block;
- 
-    Report.Result;
- 
- exception
- 
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,285 ****
- -- CXAA006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that for a bounded line length text file of mode Append_File,
- --      when the number of characters to be output exceeds the number of 
- --      columns remaining on the current line, a call to Put will output 
- --      characters of the string sufficient to fill the remaining columns of 
- --      the line (up to line length), then output a line terminator, reset the 
- --      column number, increment the line number, then output the balance of 
- --      the item.
- --      
- --      Check that the procedure Put does not raise Layout_Error when the 
- --      number of characters to be output exceeds the line length of a bounded
- --      text file of mode Append_File.
- --      
- -- TEST DESCRIPTION:
- --      This test demonstrates the situation where an application intends to 
- --      output variable length string elements to a text file in the most
- --      efficient manner possible.  This is the case in a typesetting 
- --      environment where text is compressed and split between lines of a 
- --      bounded length.
- --
- --      The procedure Put will break string parameters placed in the file at
- --      the point of the line length.  Two examples are demonstrated in this
- --      test, one being the case where only one column remains on a line, and
- --      the other being the case where a larger portion of the line remains
- --      unfilled, but still not sufficient to contain the entire output
- --      string.
- --
- --      During the course of the test, the file is reset to Append_File mode,
- --      and the bounded line length is modified for different lines of the
- --      file.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that support Text_IO
- --      processing and external files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA006 is
- 
-    A_Bounded_File    : Ada.Text_IO.File_Type;
-    Bounded_File_Name : constant String := 
-                        Report.Legal_File_Name ( Nam => "CXAA006" );
-    Incomplete : exception;
- 
- begin
- 
-    Report.Test ("CXAA006", "Check that procedure Put will correctly " &
-                            "output string items to a bounded line "   &
-                            "length text file of mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
- -- An application creates a text file in mode Append_File, with the intention 
- -- of using the procedure Put to compress variable length string data into the 
- -- file in the most efficient manner possible.  
- 
-      Ada.Text_IO.Create (File => A_Bounded_File,
-                          Mode => Ada.Text_IO.Append_File,
-                          Name => Bounded_File_Name);
-    exception
-       when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
-          Report.Not_Applicable
-             ( "Files not supported - Create with Append_File for Text_IO" );
-          raise Incomplete;
-    end Test_For_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
-       Twelve_Characters   : constant String := "12Characters";
-       Nineteen_Characters : constant String := "Nineteen_Characters";
-       TC_Line             : Natural := 0;
- 
-       function TC_Mode_Selection (Selector : Integer) 
-       return Ada.Text_IO.File_Mode is
-       begin
-          case Selector is
-             when 1       => return Ada.Text_IO.In_File;
-             when 2       => return Ada.Text_IO.Out_File;
-             when others  => return Ada.Text_IO.Append_File;
-          end case;
-       end TC_Mode_Selection;
- 
-    begin
- 
- -- The application sets the line length of the file to be bound at 20.  All
- -- lines in this file will be limited to that length.
- 
-       Ada.Text_IO.Set_Line_Length (A_Bounded_File, 20);
- 
-       Ada.Text_IO.Put (A_Bounded_File, Nineteen_Characters);
- 
-       -- Test control code.
-       if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
-           Report.Ident_Int(1))                         or
-          (Integer(Ada.Text_IO.Col (A_Bounded_File))  /=
-           Report.Ident_Int(20))                        then
-          Report.Failed ("Incorrect position after 1st Put");
-       end if;
- 
- -- The application finds that there is only one column available on the
- -- current line, so the next string item to be output must be broken at 
- -- the appropriate place (following the first character).
- 
-       Ada.Text_IO.Put (File => A_Bounded_File, 
-                        Item => Twelve_Characters);
- 
-       -- Test control code.
-       if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
-           Report.Ident_Int(2))                         or
-          (Integer(Ada.Text_IO.Col (A_Bounded_File))  /=
-           Report.Ident_Int(12))                        then
-          Report.Failed ("Incorrect position after 2nd Put");
-       end if;
- 
- -- The application subsequently modifies the processing, resetting the file
- -- at this point to In_File mode in order to verify data that has been written 
- -- to the file. Following this, the application resets the file to Append_File
- -- mode in order to continue the placement of data into the file, but modifies
- -- the original bounded line length for subsequent lines to be appended.
- 
-       -- Reset to Append mode; call outputs page terminator and
-       -- resets line length to Unbounded.
-       Reset1:
-       begin
-          Ada.Text_IO.Reset (A_Bounded_File, 
-                             TC_Mode_Selection (Report.Ident_Int(3)));
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to Append_File not supported for Text_IO" );
-             raise Incomplete;
-       end Reset1;
- 
-       Ada.Text_IO.Set_Line_Length (A_Bounded_File, 15);
- 
-       -- Store line number for later comparison.
-       TC_Line := Natural(Ada.Text_IO.Line(A_Bounded_File));
- 
- -- The application finds that fifteen columns are available on the current
- -- line but that the string item to be output exceeds this available space.
- -- It must be split at the end of the line, and the balance placed on the
- -- next file line.
- 
-       Ada.Text_IO.Put (File => A_Bounded_File, 
-                        Item => Nineteen_Characters);
- 
-       -- Test control code.
-       -- Positioned on new line at col 5.
-       if (Natural(Ada.Text_IO.Line (A_Bounded_File)) /=
-           (TC_Line + 1))                                 or
-          (Integer(Ada.Text_IO.Col (A_Bounded_File))  /=
-           Report.Ident_Int(5))                          then
-          Report.Failed ("Incorrect position after 3rd Put");
-       end if;
- 
- 
-       Test_Verification_Block:                  
-       declare                                   
-          First_String  : String (1 .. 80);
-          Second_String : String (1 .. 80);
-          Third_String  : String (1 .. 80);
-          Fourth_String : String (1 .. 80);
-          TC_Width1     : Natural;
-          TC_Width2     : Natural;
-          TC_Width3     : Natural;
-          TC_Width4     : Natural;
-       begin  
- 
- -- The application has the capability to reset the file to In_File mode to
- -- verify some or all of the data that is contained there.
- 
-          Reset2:
-          begin
-             Ada.Text_IO.Reset    (A_Bounded_File, Ada.Text_IO.In_File);
-          exception
-             when others =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset2;
- 
-          Ada.Text_IO.Get_Line 
-             (A_Bounded_File, First_String,  TC_Width1);
-          Ada.Text_IO.Get_Line 
-             (A_Bounded_File, Second_String, TC_Width2);
-          Ada.Text_IO.Get_Line 
-             (A_Bounded_File, Third_String,  TC_Width3);
-          Ada.Text_IO.Get_Line 
-             (A_Bounded_File, Fourth_String, TC_Width4);
- 
-          -- Test control code.
-          if (First_String (1..TC_Width1) /= Nineteen_Characters & "1")  or
-             (Second_String (1..TC_Width2) /= "2Characters")             or
-             (Third_String (1..TC_Width3)  /= 
-              Nineteen_Characters(1..15))                                or
-             (Fourth_String (1..TC_Width4) /= "ters")
-          then
-             Report.Failed ("Data placed incorrectly in file");
-          end if;
- 
-       exception
- 
-          when Incomplete =>
-             raise;
- 
-          when Ada.Text_IO.End_Error =>
-             Report.Failed ("Incorrect number of lines in file");
- 
-          when others            => 
-             Report.Failed ("Error raised during data verification");
- 
-       end Test_Verification_Block;
- 
-    exception
- 
-       when Ada.Text_IO.Layout_Error => 
-          Report.Failed ("Layout Error raised when positioning text");
- 
-       when others               => 
-          Report.Failed ("Exception in Text_IO processing");
- 
-    end Operational_Test_Block;
- 
-    Final_Block:
-    begin
-       -- Delete the external file.
-       if Ada.Text_IO.Is_Open(A_Bounded_File) then
-          Ada.Text_IO.Delete (A_Bounded_File);
-       else
-          Ada.Text_IO.Open (A_Bounded_File, 
-                            Ada.Text_IO.In_File,
-                            Bounded_File_Name);
-          Ada.Text_IO.Delete (A_Bounded_File);
-       end if;
- 
-    exception
-       when others =>
-          Report.Failed 
-             ( "Delete not properly implemented for Text_IO" );
-    end Final_Block;
- 
-    Report.Result;
- 
- exception
- 
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,263 ****
- -- CXAA007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the capabilities of Text_IO.Integer_IO perform correctly
- --      on files of Append_File mode, for instantiations with integer and
- --      user-defined subtypes.
- --      Check that the formatting parameters available in the package can
- --      be used and modified successfully in the storage and retrieval of
- --      data.
- --      
- -- TEST DESCRIPTION:
- --      This test simulates a receiving department inventory system.  Data on
- --      items received is entered into an inventory database. This information
- --      consists of integer entry number, item number, and bar code.  
- --      One item is placed into the inventory file immediately following file
- --      creation, subsequent items are entered following file opening in 
- --      Append_File mode.  Data items are validated by reading all data from
- --      the file and comparing against known values (those used to enter the
- --      data originally).  
- --      
- --      This test verifies issues of create in Append_File mode, appending to
- --      a file previously appended to, opening in Append_File mode, resetting
- --      from Append_File mode to In_File mode, as well as a variety of Text_IO
- --      and Integer_IO predefined subprograms.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA007 is
-    use Ada;
- 
-    Inventory_File     : Text_IO.File_Type;
-    Inventory_Filename : constant String :=
-                            Report.Legal_File_Name ( Nam => "CXAA007" );
-    Incomplete         : exception;
- 
- begin
- 
-    Report.Test ("CXAA007", "Check that the capabilities of "                 &
-                            "Text_IO.Integer_IO operate correctly for files " &
-                            "with mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise the exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Inventory_File,
-                       Mode => Text_IO.Append_File,
-                       Name => Inventory_Filename);
-    exception
-       when Text_IO.Use_Error | Text_IO.Name_Error =>
-          Report.Not_Applicable
-             ( "Files not supported - Create with Append_File for Text_IO" );
-          raise Incomplete;
-    end Test_for_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       Max_Entries_Per_Order : constant Natural := 4;
- 
-       type Bar_Code_Type is range 0 .. 127; -- Values to be stored as base
-                                             -- two numbers in file.
-       type Item_Type is record
-          Entry_Number : Natural        := 0;
-          Item_Number  : Integer        := 0;
-          Bar_Code     : Bar_Code_Type  := 0;
-       end record;   
- 
-       type Inventory_Type is 
-         array (1 .. Max_Entries_Per_Order) of Item_Type;
- 
-       Inventory_List : Inventory_Type := ((1, 119,  87), -- Items received
-                                           (2, 206,  44), -- this order.
-                                           (3, -25, 126),
-                                           (4, -18, 31));
- 
-       Daily_Order        : constant := 1;
-       Entry_Field_Width  : constant Natural :=  1;
-       Item_Base          : constant Natural := 16;
-       Items_Inventoried  : Natural := 1;
-       Items_To_Inventory : Natural := 4;
- 
-       package Entry_IO    is new Text_IO.Integer_IO (Natural);
-       package Item_IO     is new Text_IO.Integer_IO (Integer);
-       package Bar_Code_IO is new Text_IO.Integer_IO (Bar_Code_Type);
- 
- 
-       -- The following procedure simulates the addition of inventory item 
-       -- information into a data file.
- 
-       procedure Update_Inventory (The_Item : in Item_Type) is
-          Spacer : constant String := "   ";
-       begin
-          -- Enter all the incoming data into the inventory file.
-          Entry_IO.Put   (Inventory_File, The_Item.Entry_Number);
-          Text_IO.Put    (Inventory_File, Spacer);
-          Item_IO.Put    (Inventory_File, The_Item.Item_Number); 
-          Text_IO.Put    (Inventory_File, Spacer);
-          Bar_Code_IO.Put(File  => Inventory_File, 
-                          Item  => The_Item.Bar_Code,
-                          Width => 13,
-                          Base  =>  2);
-          Text_IO.New_Line(Inventory_File);
-       end Update_Inventory;
- 
- 
-    begin
- 
-       -- This code section simulates a receiving department maintaining a
-       -- data file containing information on items that have been ordered
-       -- and received.  
-       --
-       -- As new orders are received, the file is opened in Append_File
-       -- mode.
-       -- Data is taken from the inventory list and entered into the file, 
-       -- in specific format.
-       -- Enter the order into the inventory file.  This is item 1 in
-       -- the inventory list.  
-       -- The data entry process can be repeated numerous times as required.
- 
-       Entry_IO.Put     (Inventory_File, 
-                         Inventory_List(Daily_Order).Entry_Number);    
-       Item_IO.Put      (Inventory_File, 
-                         Inventory_List(Daily_Order).Item_Number);
-       Bar_Code_IO.Put  (File  => Inventory_File, 
-                         Item  => Inventory_List(Daily_Order).Bar_Code); 
-       Text_IO.New_Line (Inventory_File);
-      
-       Text_IO.Close    (Inventory_File);
- 
- 
-       Entry_IO.Default_Width := Entry_Field_Width;  -- Modify the default
-                                                     -- width of Entry_IO.
-       Item_IO.Default_Base   := Item_Base;          -- Modify the default
-                                                     -- number base of
-                                                     -- Item_IO
-       Text_IO.Open (Inventory_File, 
-                     Text_IO.Append_File,            -- Open in Append mode.
-                     Inventory_Filename);
-                                                           -- Enter items
-       while (Items_Inventoried < Items_To_Inventory) loop -- 2-4 into the
-          Items_Inventoried := Items_Inventoried + 1;     -- inventory file.
-          Update_Inventory (The_Item => Inventory_List (Items_Inventoried));
-       end loop;
- 
-       Test_Verification_Block:                           -- Read and check
-       declare                                            -- all the data
-          TC_Entry      : Natural;                        -- values that
-          TC_Item       : Integer;                        -- have been
-          TC_Bar_Code   : Bar_Code_Type;                  -- entered in the
-          TC_Item_Count : Natural := 0;                   -- data file.
-       begin                                                
- 
-          Reset1:
-          begin
-             Text_IO.Reset (Inventory_File, Text_IO.In_File);  -- Reset for
-                                                               -- reading.
-          exception
-             when Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to mode In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset1;
- 
-          while not Text_IO.End_Of_File (Inventory_File) loop
-             Entry_IO.Get      (Inventory_File, TC_Entry);
-             Item_IO.Get       (Inventory_File, TC_Item);
-             Bar_Code_IO.Get   (Inventory_File, TC_Bar_Code);
-             Text_IO.Skip_Line (Inventory_File);
-             TC_Item_Count := TC_Item_Count + 1;
- 
-             if (TC_Item     /= Inventory_List(TC_Entry).Item_Number) or
-                (TC_Bar_Code /= Inventory_List(TC_Entry).Bar_Code)    then
-                Report.Failed ("Error in integer data read from file");
-             end if;
-          end loop;
- 
-          if (TC_Item_Count /= Max_Entries_Per_Order) then
-             Report.Failed ("Incorrect number of records read from file");
-          end if;
- 
-       exception
-          when Incomplete =>
-             raise; 
-         when others => 
-             Report.Failed ("Error raised during data verification");
-       end Test_Verification_Block;
-         
-    exception
-       when Incomplete =>
-          raise;
-       when others => 
-          Report.Failed ("Exception in Text_IO.Integer_IO processing");
-    end Operational_Test_Block;
- 
-    Final_Block:
-    begin
-       -- Delete the external file.
-       if Text_IO.Is_Open(Inventory_File) then
-          Text_IO.Delete (Inventory_File);      
-       else
-          Text_IO.Open (Inventory_File, Text_IO.In_File, Inventory_Filename);
-          Text_IO.Delete (Inventory_File);
-       end if;
- 
-    exception
- 
-       when others =>
-          Report.Failed ( "Delete not properly implemented for Text_IO" );
- 
-    end Final_Block;
- 
-    Report.Result;
- 
- exception
- 
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,271 ****
- -- CXAA008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the capabilities provided in instantiations of the 
- --      Ada.Text_IO.Fixed_IO package operate correctly when the mode of
- --      the file is Append_File.  Check that Fixed_IO procedures Put and Get 
- --      properly transfer fixed point data to/from data files that are in
- --      Append_File mode.  Check that the formatting parameters available in 
- --      the package can be used and modified successfully in the appending and 
- --      retrieval of data.
- --      
- -- TEST DESCRIPTION:
- --      This test simulates order processing, with data values being written
- --      to a file, in a specific format, using Fixed_IO.  Validation is done
- --      on this process by reading the data values from the file, and 
- --      comparing them for equality with the values originally written to 
- --      the file.
- --      
- --      This test verifies issues of create in Append_File mode, appending to
- --      a file previously appended to, resetting to Append_File mode, 
- --      resetting from Append_File mode to In_File mode, as well as a 
- --      variety of Text_IO and Fixed_IO predefined subprograms.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA008 is
-    use Ada;
- 
-    Inventory_File     : Text_IO.File_Type;
-    Inventory_Filename : constant String :=
-                           Report.Legal_File_Name ( Nam => "CXAA008" );
-    Incomplete         : exception;
- 
- begin
- 
-    Report.Test ("CXAA008", "Check that the capabilities of "               &
-                            "Text_IO.Fixed_IO operate correctly for files " &
-                            "with mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise the exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Inventory_File,
-                       Mode => Text_IO.Append_File,
-                       Name => Inventory_Filename);
- 
-    exception
-       when Text_IO.Use_Error | Text_IO.Name_Error =>
-          Report.Not_Applicable
-             ( "Files not supported - Create with Append_File for Text_IO" );
-          raise Incomplete;
-    end Test_For_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       Daily_Orders_Received : constant Natural := 4;
- 
-       type Item_Type   is delta 0.1  range    0.0 .. 5000.0;
-       type Cost_Type   is delta 0.01 range    0.0 .. 10_000.0;
-       type Profit_Type is delta 0.01 range -100.0 .. 1000.0;
- 
-       type Product_Type is record
-          Item_Number    : Item_Type   := 0.0;
-          Unit_Cost      : Cost_Type   := 0.00;
-          Percent_Markup : Profit_Type := 0.00;
-       end record;   
- 
-       type Inventory_Type is 
-         array (1 .. Daily_Orders_Received) of Product_Type;
- 
-       Daily_Inventory   : Inventory_Type := ((   1.0,   1.75,  50.00),  
-                                              ( 155.0,  20.00,  -5.50),  
-                                              (3343.5,   2.50, 126.50),
-                                              (4986.0, 180.00,  31.75));
- 
-       package Item_IO   is new Text_IO.Fixed_IO (Item_Type);
-       package Cost_IO   is new Text_IO.Fixed_IO (Cost_Type);
-       package Markup_IO is new Text_IO.Fixed_IO (Profit_Type);
- 
- 
-       function TC_Mode_Selection (Selector : Integer) 
-         return Text_IO.File_Mode is
-       begin
-          case Selector is
-             when 1       => return Text_IO.In_File;
-             when 2       => return Text_IO.Out_File;
-             when others  => return Text_IO.Append_File;
-          end case;
-       end TC_Mode_Selection;
- 
- 
-       -- The following function simulates the addition of inventory item 
-       -- information into a data file.  Boolean status of True is returned
-       -- if all of the data entry was successful, False otherwise.
- 
-       function Update_Inventory (The_List : Inventory_Type) 
-         return Boolean is
-       begin
-          for I in 1 .. Daily_Orders_Received loop
-             Item_IO.Put  (Inventory_File, The_List(I).Item_Number);    
-             Cost_IO.Put  (Inventory_File, The_List(I).Unit_Cost, 10, 4, 0);
-             Markup_IO.Put(File => Inventory_File, 
-                           Item => The_List(I).Percent_Markup,
-                           Fore => 6,
-                           Aft  => 3,
-                           Exp  => 2);
-             Text_IO.New_Line (Inventory_File);
-          end loop;
-          return (True);                         -- Return a Status value.
-       exception
-          when others => return False;
-       end Update_Inventory;
- 
- 
-    begin
- 
-       -- This code section simulates a receiving department maintaining a
-       -- data file containing information on items that have been ordered
-       -- and received. 
- 
-       -- Whenever items are received, the file is reset to Append_File
-       -- mode.  Data is taken from an inventory list and entered into the
-       -- file, in specific format.  
- 
-       Reset1:
-       begin                                                -- Reset to 
-          Text_IO.Reset (Inventory_File,                    -- Append mode.
-                         TC_Mode_Selection (Report.Ident_Int(3))); 
-       exception
-          when Text_IO.Use_Error =>
-             Report.Not_Applicable 
-                ( "Reset to Append_File not supported for Text_IO" );
-       end Reset1;
- 
-                                                            -- Enter data.
-       if not Update_Inventory (The_List => Daily_Inventory) then
-          Report.Failed ("Exception occurred during inventory update");
-          raise Incomplete;
-       end if;
- 
-       Test_Verification_Block:                             
-       declare                                              
-          TC_Item       : Item_Type;
-          TC_Cost       : Cost_Type;
-          TC_Markup     : Profit_Type;
-          TC_Item_Count : Natural := 0;                     
-       begin                                                
- 
-          Reset2:
-          begin
-             Text_IO.Reset (Inventory_File, Text_IO.In_File);  -- Reset for
-                                                               -- reading.
-          exception
-             when Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset2;
- 
-          while not Text_IO.End_Of_File (Inventory_File) loop
-             Item_IO.Get   (Inventory_File, TC_Item);    
-             Cost_IO.Get   (Inventory_File, TC_Cost);
-             Markup_IO.Get (File  => Inventory_File, 
-                            Item  => TC_Markup,
-                            Width => 0);
-             Text_IO.Skip_Line (Inventory_File);
-             TC_Item_Count := TC_Item_Count + 1;
- 
-             -- Verify all of the data fields read from the file.  Compare
-             -- with the values that were originally entered into the file.
- 
-             if (TC_Item /= Daily_Inventory(TC_Item_Count).Item_Number) then
-                Report.Failed ("Error in Item_Number read from file");
-             end if;
-             if (TC_Cost /= Daily_Inventory(TC_Item_Count).Unit_Cost) then
-                Report.Failed ("Error in Unit_Cost read from file");
-             end if;
-             if not (TC_Markup = 
-                     Daily_Inventory(TC_Item_Count).Percent_Markup) then
-                Report.Failed ("Error in Percent_Markup read from file");
-             end if;
- 
-          end loop;
- 
-          if (TC_Item_Count /= Daily_Orders_Received) then
-             Report.Failed ("Incorrect number of records read from file");
-          end if;
- 
-       exception
-          when Incomplete =>
-             raise;
-          when others => 
-             Report.Failed ("Error raised during data verification");
-       end Test_Verification_Block;
- 
-    exception
-       when Incomplete =>
-          raise;
-       when others => 
-          Report.Failed ("Exception in Text_IO.Fixed_IO processing");
-    end Operational_Test_Block;
- 
-    Final_Block:
-    begin
-       -- Delete the external file.
-       if Text_IO.Is_Open (Inventory_File) then
-          Text_IO.Delete (Inventory_File); 
-       else
-          Text_IO.Open (Inventory_File, Text_IO.In_File, Inventory_Filename);
-          Text_IO.Delete (Inventory_File); 
-       end if;
- 
-    exception
- 
-       when others =>
-          Report.Failed ( "Delete not properly implemented for Text_IO" );
- 
-    end Final_Block;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,290 ****
- -- CXAA009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the capabilities provided in instantiations of the
- --      Ada.Text_IO.Float_IO package operate correctly when the mode of 
- --      the file is Append_File. Check that Float_IO procedures Put and Get 
- --      properly transfer floating point data to/from data files that are in
- --      Append_File mode. Check that the formatting parameters available in 
- --      the package can be used and modified successfully in the appending and 
- --      retrieval of data.
- --      
- -- TEST DESCRIPTION:
- --      This test is designed to simulate an environment where a data file
- --      that holds floating point information is created, written to, and 
- --      closed.  In the future, the file can be reopened in Append_File mode,
- --      additional data can be appended to it, and then closed.  This process
- --      of Open/Append/Close can be repeated as necessary.  All data written
- --      to the file is verified for accuracy when retrieved from the file.
- --      
- --      This test verifies issues of create in Append_File mode, appending to
- --      a file previously appended to, opening in Append_File mode, resetting
- --      from Append_File mode to In_File mode, as well as a variety of Text_IO
- --      and Float_IO predefined subprograms.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA009 is
- 
-    use Ada;
-    Loan_File : Text_IO.File_Type;
-    Loan_Filename : constant String :=
-                               Report.Legal_File_Name ( Nam => "CXAA009" );
-    Incomplete : exception;
- 
- begin
- 
-    Report.Test ("CXAA009", "Check that the capabilities of "               &
-                            "Text_IO.Float_IO operate correctly for files " &
-                            "with mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise the exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Loan_File,                    -- Create in
-                       Mode => Text_IO.Out_File,             -- Out_File mode.
-                       Name => Loan_Filename);
- 
-    exception
- 
-        when Text_IO.Use_Error | Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
-       Total_Loans_Outstanding : constant Natural := 3;
-       Transaction_Status      :          Boolean := False;
- 
-       type Account_Balance_Type is digits 6 range 0.0 .. 1.0E6;
-       type Loan_Balance_Type    is digits 6; 
-       type Interest_Rate_Type   is digits 4 range 0.0 .. 30.00;
- 
-       type Loan_Info_Type is record
-          Account_Balance    : Account_Balance_Type := 0.00;
-          Loan_Balance       : Loan_Balance_Type    := 0.00;
-          Loan_Interest_Rate : Interest_Rate_Type   := 0.00;
-       end record;   
- 
-       Home_Refinance_Loan : Loan_Info_Type := 
-                               (14_500.00, 135_000.00, 6.875);
-       Line_Of_Credit_Loan : Loan_Info_Type := 
-                               (  5490.00,   -3000.00, 13.75);
-       Small_Business_Loan : Loan_Info_Type := 
-                               (Account_Balance    => 45_000.00,
-                                Loan_Balance       => 10_500.00,
-                                Loan_Interest_Rate =>     5.875);
- 
-       package Acct_IO is new Text_IO.Float_IO (Account_Balance_Type);
-       package Loan_IO is new Text_IO.Float_IO (Loan_Balance_Type);
-       package Rate_IO is new Text_IO.Float_IO (Interest_Rate_Type);
- 
- 
-       -- The following procedure performs the addition of loan information
-       -- into a data file.  Boolean status of True is returned if all of
-       -- the data entry was successful, False otherwise.
-       -- This demonstrates use of Float_IO using a variety of data formats.
- 
-       procedure Update_Loan_Info (The_File : in out Text_IO.File_Type;
-                                   The_Loan : in     Loan_Info_Type;
-                                   Status   :    out Boolean ) is
-       begin
-          Acct_IO.Put (The_File, The_Loan.Account_Balance);    
-          Loan_IO.Put (The_File, The_Loan.Loan_Balance, 15, 2, 0);
-          Rate_IO.Put (File => The_File, 
-                       Item => The_Loan.Loan_Interest_Rate,
-                       Fore => 6,
-                       Aft  => 3,
-                       Exp  => 0);
-          Text_IO.New_Line (The_File);
-          Status := True;
-       exception
-          when others => Status := False;
-       end Update_Loan_Info;
- 
- 
-    begin
- 
-       -- This code section simulates a bank maintaining a data file 
-       -- containing information on loans that have been made.
-       -- The scenario:
-       --    The loan file was created in Out_File mode. 
-       --    Some number of data records are added.
-       --    The file is closed.
-       --    The file is subsequently reopened in Append_File mode.
-       --    Data is appended to the file.
-       --    The file is closed.
-       --    Repeat the Open/Append/Close process as required.
-       --    Verify data in the file.
-       --    etc.
- 
-       Update_Loan_Info(Loan_File, Home_Refinance_Loan, Transaction_Status);
- 
-       if not Transaction_Status then
-          Report.Failed ("Failure in update of first loan data");
-       end if;
- 
-       Text_IO.Close (Loan_File);
- 
-       -- When subsequent data items are to be added to the file, the file
-       -- is opened in Append_File mode.
- 
-       Text_IO.Open (Loan_File,                            -- Open with
-                     Text_IO.Append_File,                  -- Append mode.
-                     Loan_Filename);
-                                                              
-       Update_Loan_Info(Loan_File, Line_Of_Credit_Loan, Transaction_Status);
- 
-       if not Transaction_Status then
-          Report.Failed("Failure in update of first loan data");
-       end if;
- 
-       Text_IO.Close(Loan_File);
- 
-       -- To add additional data to the file, the file
-       -- is again opened in Append_File mode (appending to a file
-       -- previously appended to).
- 
-       Text_IO.Open (Loan_File,                            -- Open with
-                     Text_IO.Append_File,                  -- Append mode.
-                     Loan_Filename);
-                                                              
-       Update_Loan_Info(Loan_File, Small_Business_Loan, Transaction_Status);
- 
-       if not Transaction_Status then
-          Report.Failed("Failure in update of first loan data");
-       end if;
- 
-       Test_Verification_Block:                             
-       declare
-          type Ledger_Type is 
-            array (1 .. Total_Loans_Outstanding) of Loan_Info_Type;
-          TC_Bank_Ledger : Ledger_Type;
-          TC_Item_Count  : Natural := 0;
-       begin                                                
- 
-          Reset1:
-          begin
-             Text_IO.Reset (Loan_File, Text_IO.In_File);       -- Reset for
-                                                               -- reading.
-          exception
-             when Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset1;
- 
-          while not Text_IO.End_Of_File (Loan_File) loop
-             TC_Item_Count := TC_Item_Count + 1;               
-             Acct_IO.Get (Loan_File, 
-                          TC_Bank_Ledger(TC_Item_Count).Account_Balance);    
-             Loan_IO.Get (Loan_File, 
-                          TC_Bank_Ledger(TC_Item_Count).Loan_Balance, 
-                          0);
-             Rate_IO.Get(File  => Loan_File, 
-                         Item  => 
-                           TC_Bank_Ledger(TC_Item_Count).Loan_Interest_Rate,
-                         Width => 0);
-             Text_IO.Skip_Line(Loan_File);
- 
-          end loop;
- 
-          -- Verify all of the data fields read from the file.  Compare
-          -- with the values that were originally entered into the file.
- 
-          if (TC_Bank_Ledger(1) /= Home_Refinance_Loan) or
-             (TC_Bank_Ledger(2) /= Line_Of_Credit_Loan) or
-             (TC_Bank_Ledger(3) /= Small_Business_Loan) then
-             Report.Failed("Error in data read from file");
-          end if;
- 
-          if (TC_Item_Count /= Total_Loans_Outstanding) then
-             Report.Failed ("Incorrect number of records read from file");
-          end if;
- 
-       exception
-            when Incomplete =>
-               raise; 
-            when others => 
-                Report.Failed ("Error raised during data verification");
-       end Test_Verification_Block;
- 
-    exception
-       when Incomplete =>
-          raise;
-       when others => 
-             Report.Failed ("Exception in Text_IO.Float_IO processing");
-    end Operational_Test_Block;
- 
-    Final_Block:
-    begin
-       -- Delete the external file.
-       if Text_IO.Is_Open(Loan_File) then
-          Text_IO.Delete(Loan_File);
-       else
-          Text_IO.Open(Loan_File, Text_IO.In_File, Loan_Filename);
-          Text_IO.Delete(Loan_File);
-       end if;
- 
-    exception
- 
-       when Text_IO.Use_Error =>
-          Report.Failed
-             ( "Delete not properly implemented for Text_IO" );
- 
-    end Final_Block;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,335 ****
- -- CXAA010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the operations defined in package Ada.Text_IO.Decimal_IO
- --      are available, and that they function correctly when used for the
- --      input/output of Decimal types.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates the Put and Get procedures found in the
- --      generic package Ada.Text_IO.Decimal_IO.  Both Put and Get are
- --      overloaded to allow placement or extraction of decimal values 
- --      to/from a text file or a string.  This test demonstrates both forms
- --      of each subprogram.  
- --      The test defines an array of records containing decimal value
- --      and string component fields.  All component values are placed in a 
- --      Text_IO file, with the decimal values being placed there using the 
- --      version of Put defined for files, and using user-specified formatting 
- --      parameters.  The data is later extracted from the file, with the 
- --      decimal values being removed using the version of Get defined for
- --      files.  Decimal values are then written to strings, using the 
- --      appropriate Put procedure.  Finally, extraction of the decimal data
- --      from the strings completes the evaluation of the Decimal_IO package
- --      subprograms.
- --      The reconstructed data is verified at the end of the test against the
- --      data originally written to the file.
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all implementations capable of supporting external
- --      Text_IO files and Decimal Fixed Point Types
- -- 
- --      All implementations must attempt to compile this test.
- --
- --      For implementations validating against Information Systems Annex (F):
- --        this test must execute and report PASSED.
- --
- --      For implementations not validating against Annex F:
- --        this test may report compile time errors at one or more points
- --        indicated by "-- ANX-F RQMT", in which case it may be graded as inapplicable.
- --        Otherwise, the test must execute and report PASSED.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      20 Feb 95   SAIC    Modified test to allow for Use_Error/Name_Error
- --                          generation by an implementation not supporting
- --                          Text_IO operations.
- --      14 Nov 95   SAIC    Corrected string indexing for ACVC 2.0.1.
- --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --      16 FEB 98   EDS     Modified documentation.
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA010 is
-    use Ada.Text_IO;
-    Tax_Roll      : Ada.Text_IO.File_Type;
-    Tax_Roll_Name : constant String :=
-                            Report.Legal_File_Name ( Nam => "CXAA010" );
-    Incomplete : exception;
- begin
- 
-    Report.Test ("CXAA010", "Check that the operations defined in package " &
-                            "Ada.Text_IO.Decimal_IO are available, and "    &
-                            "that they function correctly when used for "   &
-                            "the input/output of Decimal types");
- 
-    Test_for_Decimal_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO creation or naming
-       -- of external files in a particular environment will raise Use_Error 
-       -- or Name_Error on a call to Text_IO Create. This block statement 
-       -- encloses a call to Create, which should produce an exception in a 
-       -- non-supportive environment.  Either of these exceptions will be 
-       -- handled to produce a Not_Applicable result.
- 
-       Ada.Text_IO.Create (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);
- 
-    exception
- 
-        when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_Decimal_IO_Support;
- 
-    Taxation:
-    declare
- 
-       ID_Length           : constant :=  5;
-       Price_String_Length : constant :=  5;
-       Value_String_Length : constant :=  6;
-       Total_String_Length : constant := 20;
-       Spacer              : constant String := "  ";  -- Two blanks.
- 
-       type Price_Type     is delta 0.1  digits 4;              -- ANX-F RQMT
-       type Value_Type     is delta 0.01 digits 5;              -- ANX-F RQMT
- 
-       type Property_Type  is 
-          record
-             Parcel_ID      : String (1..ID_Length);
-             Purchase_Price : Price_Type;
-             Assessed_Value : Value_Type;
-          end record;
-      
-       type    City_Block_Type     is array (1..4) of Property_Type;
- 
-       subtype Tax_Bill_Type       is string (1..Total_String_Length);
-       type    Tax_Bill_Array_Type is array (1..4) of Tax_Bill_Type;
- 
-       Neighborhood : City_Block_Type := 
-         (("X9254", 123.0, 135.00), ("X3569", 345.0, 140.50),
-          ("X3434", 234.0, 179.50), ("X8838", 456.0, 158.00));
-       
-       Neighborhood_Taxes : Tax_Bill_Array_Type;
- 
-       package Price_IO is new Ada.Text_IO.Decimal_IO (Price_Type);
-       package Value_IO is new Ada.Text_IO.Decimal_IO (Value_Type);
- 
-    begin  -- Taxation
- 
-       Assessors_Office:
-       begin
- 
-          for Parcel in City_Block_Type'Range loop
-             -- Note: All data in the file will be separated with a 
-             --       two-character blank spacer.
-             Ada.Text_IO.Put(Tax_Roll, Neighborhood(Parcel).Parcel_ID);
-             Ada.Text_IO.Put(Tax_Roll, Spacer);
- 
-             -- Use Decimal_IO.Put with non-default format parameters to
-             -- place decimal data into file.
-             Price_IO.Put   (Tax_Roll, Neighborhood(Parcel).Purchase_Price,
-                             Fore => 3, Aft =>1, Exp => 0);
-             Ada.Text_IO.Put(Tax_Roll, Spacer);
- 
-             Value_IO.Put   (Tax_Roll, Neighborhood(Parcel).Assessed_Value,
-                             Fore => 3, Aft =>2, Exp => 0);
-             Ada.Text_IO.New_Line(Tax_Roll);
-          end loop;
- 
-          Ada.Text_IO.Close (Tax_Roll);
- 
-       exception
-          when others => 
-             Report.Failed ("Exception raised in Assessor's Office");
-       end Assessors_Office;
- 
- 
-       Twice_A_Year:
-       declare
- 
-          procedure Collect_Tax(Index     : in     Integer;
-                                Tax_Array : in out Tax_Bill_Array_Type) is
-             ID            : String (1..ID_Length);
-             Price         : Price_Type := 0.0; 
-             Value         : Value_Type := 0.00;
-             Price_String  : String (1..Price_String_Length);
-             Value_String  : String (1..Value_String_Length);
-          begin  
- 
-             -- Extract information from the Text_IO file; one string, two
-             -- decimal values.
-             -- Note that the Spacers that were put in the file above are
-             -- not individually read here, due to the fact that each call
-             -- to Decimal_IO.Get below uses a zero in the Width field,
-             -- which allows each Get procedure to skip these leading blanks
-             -- prior to extracting the numeric value.
-                
-             Ada.Text_IO.Get (Tax_Roll, ID);
- 
-             -- A zero value of Width is provided, so the following
-             -- two calls to Decimal_IO.Get will skip the leading blanks,
-             -- (from the Spacer variable above), then read the numeric
-             -- literals.
- 
-             Price_IO.Get    (Tax_Roll, Price, 0);
-             Value_IO.Get    (Tax_Roll, Value, 0);
-             Ada.Text_IO.Skip_Line (Tax_Roll);
- 
-             -- Convert the values read from the file into string format,
-             -- using user-specified format parameters.
-             -- Format of the Price_String should be "nnn.n"
-             -- Format of the Value_String should be "nnn.nn"
- 
-             Price_IO.Put (To   => Price_String,
-                           Item => Price,
-                           Aft  => 1);
-             Value_IO.Put (Value_String, Value, 2);
- 
-             -- Construct a string of length 20 that contains the Parcel_ID,
-             -- the Purchase_Price, and the Assessed_Value, separated by
-             -- two-character blank data spacers.  Store this string
-             -- into the string array out parameter.
-             -- Format of each Tax_Array element should be 
-             -- "Xnnnn  nnn.n  nnn.nn" (with an 'n' signifying a digit).
- 
-             Tax_Array(Index) := ID           & Spacer &
-                                 Price_String & Spacer &
-                                 Value_String;            
-          exception
-             when Data_Error =>
-                Report.Failed("Data Error raised during the extraction " &
-                              "of decimal data from the file");
-             when others     => 
-               Report.Failed("Exception in Collect_Tax procedure");
-          end Collect_Tax;
- 
-   
-       begin  -- Twice_A_Year
-       
-          Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.In_File, Tax_Roll_Name);
- 
-          -- Determine property tax bills for the entire neighborhood from
-          -- the information that is stored in the file. Store information
-          -- in the Neighborhood_Taxes string array.
- 
-          for Parcel in City_Block_Type'Range loop
-             Collect_Tax (Parcel, Neighborhood_Taxes);
-          end loop;
- 
-       exception
-          when others => 
-            Report.Failed ("Exception in Twice_A_Year Block");
-       end Twice_A_Year;
- 
-       -- Use Decimal_IO Get procedure to extract information from a string.
-       -- Verify data against original values.
-       Validation_Block:
-       declare
-          TC_ID     : String (1..ID_Length);    -- 1..5
-          TC_Price  : Price_Type;
-          TC_Value  : Value_Type;
-          Length    : Positive;
-          Front,
-          Rear      : Integer := 0;
-       begin
- 
-          for Parcel in City_Block_Type'Range loop
-             -- Extract values from the strings of the string array.
-             -- Each element of the string array is 20 characters long; the
-             -- first five characters are the Parcel_ID, two blank characters
-             -- separate data, the next five characters contain the Price 
-             -- decimal value, two blank characters separate data, the last 
-             -- six characters contain the Value decimal value.  
-             -- Extract each of these components in turn.
- 
-             Front := 1;                                        --  1
-             Rear  := ID_Length;                                --  5
-             TC_ID := Neighborhood_Taxes(Parcel)(Front..Rear);
- 
-             -- Extract the decimal value from the next slice of the string.
-             Front := Rear + 3;                                 --  8
-             Rear  := Front + Price_String_Length - 1;          -- 12
-             Price_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
-                           Item => TC_Price,
-                           Last => Length);
- 
-             -- Extract next decimal value from slice of string, based on 
-             -- length of preceding strings read from string array element.
-             Front := Rear + 3;                                 -- 15  
-             Rear  := Total_String_Length;                      -- 20
-             Value_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
-                           Item => TC_Value,
-                           Last => Length);
- 
-             if TC_ID    /= Neighborhood(Parcel).Parcel_ID       or
-                TC_Price /= Neighborhood(Parcel).Purchase_Price  or
-                TC_Value /= Neighborhood(Parcel).Assessed_Value  
-             then
-                Report.Failed ("Incorrect data validation");
-             end if;
- 
-          end loop;
- 
-       exception
-          when others => Report.Failed ("Exception in Validation Block");
-       end Validation_Block;
- 
-       -- Check that the Text_IO file is open, then delete.
- 
-       if not Ada.Text_IO.Is_Open (Tax_Roll) then
-          Report.Failed ("File not left open after processing");
-          Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);
-       end if;
- 
-       Ada.Text_IO.Delete (Tax_Roll);
- 
-    exception
-       when others => 
-          Report.Failed ("Exception in Taxation block");
-          -- Check that the Text_IO file is open, then delete.
-          if not Ada.Text_IO.Is_Open (Tax_Roll) then
-             Ada.Text_IO.Open (Tax_Roll, 
-                               Ada.Text_IO.Out_File, 
-                               Tax_Roll_Name);
-          end if;
-          Ada.Text_IO.Delete (Tax_Roll);
-    end Taxation;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- CXAA011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the operations of Text_IO.Enumeration_IO perform correctly
- --      on files of Append_File mode, for instantiations using 
- --      enumeration types.  Check that Enumeration_IO procedures Put and Get 
- --      properly transfer enumeration data to/from data files.
- --      Check that the formatting parameters available in the package can
- --      be used and modified successfully in the storage and retrieval of data.
- --      
- -- TEST DESCRIPTION:
- --      This test is designed to simulate an environment where a data file
- --      that holds enumeration type information is reset from it current mode
- --      to allow the appending of data to the end of the   This process
- --      of Reset/Write can be repeated as necessary.  All data written
- --      to the file is verified for accuracy when retrieved from the file.
- --
- --      This test verifies issues of resetting a file created in Out_File mode
- --      to Append_File mode, resetting from Append_File mode to In_File mode, 
- --      as well as a variety of Text_IO and Enumeration_IO predefined 
- --      subprograms.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA011 is
-    use Ada;
- 
-    Status_Log          : Text_IO.File_Type;
-    Status_Log_Filename : constant String :=
-                            Report.Legal_File_Name ( Nam => "CXAA011" );
-    Incomplete : exception;
- 
- begin
- 
-    Report.Test ("CXAA011", "Check that the operations of "                 &
-                            "Text_IO.Enumeration_IO operate correctly for " &
-                            "files with mode Append_File");
- 
-    Test_for_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise the exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Text_IO.Create (File => Status_Log,
-                       Mode => Text_IO.Out_File,
-                       Name => Status_Log_Filename);
-    exception
- 
-        when Text_IO.Use_Error | Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_Text_IO_Support;
- 
- 
-    Operational_Test_Block:
-    declare
- 
-       type Days_In_Week is (Monday, Tuesday, Wednesday, Thursday, Friday, 
-                             Saturday, Sunday);
-       type Hours_In_Day is (A0000, A0600, P1200, P0600); -- Six hour 
-                                                          -- blocks.
-       type Status_Type  is (Operational, Off_Line);
- 
-       type Status_Record_Type is record
-          Day    : Days_In_Week;
-          Hour   : Hours_In_Day;
-          Status : Status_Type;
-       end record;
- 
-       Morning_Reading : Status_Record_Type := 
-                           (Wednesday, A0600, Operational);
-       Evening_Reading : Status_Record_Type := 
-                           (Saturday,  P0600, Off_Line);
- 
-       package Day_IO    is new Text_IO.Enumeration_IO (Days_In_Week);
-       package Hours_IO  is new Text_IO.Enumeration_IO (Hours_In_Day);
-       package Status_IO is new Text_IO.Enumeration_IO (Status_Type);
- 
- 
-       -- The following function simulates the hourly recording of equipment
-       -- status.
- 
-       function Record_Status (Reading : Status_Record_Type) 
-       return Boolean is
-          use Text_IO;  -- To provide visibility to type Type_Set and
-                        -- enumeration literal Upper_Case.
-       begin
-          Day_IO.Put       (File => Status_Log, 
-                            Item => Reading.Day, 
-                            Set  => Type_Set'(Upper_Case));
-          Hours_IO.Put     (Status_Log, Reading.Hour, 7);
-          Status_IO.Put    (Status_Log, Reading.Status, 
-                            Width => 8, Set => Lower_Case);
-          Text_IO.New_Line (Status_Log);
-          return (True);
-       exception
-          when others => return False;
-       end Record_Status;
- 
-    begin
- 
-       -- The usage scenario intended is as follows:
-       --    File is created.
-       --    Unrelated/unknown file processing occurs.
-       --    On six hour intervals, file is reset to Append_File mode.
-       --    Data is appended to file.
-       --    Unrelated/unknown file processing resumes.
-       --    Reset/Append process is repeated.
- 
-       Reset1:
-       begin 
-         Text_IO.Reset (Status_Log,                           -- Reset to 
-                         Text_IO.Append_File);                 -- Append mode.
-       exception
-          when Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to Append_File not supported for Text_IO" );
-             raise Incomplete;
-       end Reset1;
- 
-       Day_IO.Default_Width := Days_In_Week'Width + 5;      -- Default values
-                                                            -- are modifiable.
- 
-       if not Record_Status (Morning_Reading) then          -- Enter data.
-          Report.Failed ("Exception occurred during data file update");
-       end if;
- 
-       Reset2:
-       begin
-          Text_IO.Reset (Status_Log,                           -- Reset to 
-                         Text_IO.Append_File);                 -- Append mode.
-       exception
-          when Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to Append_File not supported for Text_IO" );
-             raise Incomplete;
-       end Reset2;
- 
-       if not Record_Status (Evening_Reading) then          -- Enter data.
-          Report.Failed ("Exception occurred during data file update");
-       end if;
- 
-       Test_Verification_Block:                             
-       declare                                              
-          TC_Reading1   : Status_Record_Type;
-          TC_Reading2   : Status_Record_Type;
-       begin                                                
- 
-          Reset3:
-          begin
-             Text_IO.Reset (Status_Log, Text_IO.In_File);      -- Reset for
-                                                               -- reading.
-          exception
-             when Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Text_IO" );
-                raise Incomplete;
-          end Reset3;
- 
-          Day_IO.Get    (Status_Log, TC_Reading1.Day);      -- Read data from
-          Hours_IO.Get  (Status_Log, TC_Reading1.Hour);     -- first record.
-          Status_IO.Get (Status_Log, TC_Reading1.Status);
-          Text_IO.Skip_Line (Status_Log);
- 
-          -- Verify the data read from the file.  Compare with the 
-          -- record that was originally entered into the file.
- 
-          if (TC_Reading1 /= Morning_Reading) then
-             Report.Failed ("Data error on reading first record");
-          end if;
- 
-          Day_IO.Get    (Status_Log, TC_Reading2.Day);      -- Read data from
-          Hours_IO.Get  (Status_Log, TC_Reading2.Hour);     -- second record.
-          Status_IO.Get (Status_Log, TC_Reading2.Status);
-          Text_IO.Skip_Line (Status_Log);
- 
-          -- Verify all of the data fields read from the file.  Compare
-          -- with the values that were originally entered into the file.
- 
-          if (TC_Reading2.Day    /= Evening_Reading.Day)    or
-             (TC_Reading2.Hour   /= Evening_Reading.Hour)   or
-             (TC_Reading2.Status /= Evening_Reading.Status) then
-             Report.Failed ("Data error on reading second record");
-          end if;
- 
-       exception
-         when Incomplete =>
-            raise; 
-          when others => 
-             Report.Failed ("Error raised during data verification");
-       end Test_Verification_Block;
- 
-    exception
-       when Incomplete =>
-          raise; 
-       when others => 
-          Report.Failed ("Exception in Text_IO.Enumeration_IO processing");
-    end Operational_Test_Block;
- 
-    Final_Block:
-    begin
-       -- Delete the external file.
-       if Text_IO.Is_Open (Status_Log) then
-          Text_IO.Delete (Status_Log);   
-       else
-          Text_IO.Open (Status_Log, Text_IO.Out_File, Status_Log_Filename);
-          Text_IO.Delete (Status_Log);   
-       end if;             
-    exception
-       when Text_IO.Use_Error =>
-          Report.Failed
-             ( "Delete not properly implemented for Text_IO" );
- 
-    end Final_Block;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- CXAA012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the exception Mode_Error is raised when an attempt is made
- --      to read from (perform a Get_Line) or use the predefined End_Of_File 
- --      function on a text file with mode Append_File.
- --      
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential for the 
- --      incorrect usage of predefined text processing subprograms, resulting 
- --      from their use with files of the wrong Mode.  This results in the 
- --      raising of Mode_Error exceptions, which is handled within blocks
- --      embedded in the test.
- --      A count is kept to ensure that each anticipated exception is in fact
- --      raised and handled properly.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA012 is
-    use Ada;
-    Text_File     : Text_IO.File_Type;
-    Text_Filename : constant String :=
-                       Report.Legal_File_Name ( Nam => "CXAA012" );
-    Incomplete : exception;
- begin
- 
-         Report.Test ("CXAA012", "Check that the exception Mode_Error is " &
-                                 "raised when an attempt is made to read " &
-                                 "from (perform a Get_Line) or use the "   &
-                                 "predefined End_Of_File function on a "   &
-                                 "text file with mode Append_File");
- 
-         Test_for_Text_IO_Support:
-         begin
- 
-         -- Use_Error or Name_Error will be raised if Text_IO operations 
-         -- or external files are not supported.
- 
-            Text_IO.Create (Text_File, Text_IO.Out_File, Text_Filename);
- 
-       exception
-           when Text_IO.Use_Error | Text_IO.Name_Error =>
-              Report.Not_Applicable
-                 ( "Files not supported - Create as Out_File for Text_IO" );
-              raise Incomplete;
-       end Test_for_Text_IO_Support;
- 
-       -- The application writes some amount of data to the file.
- 
-            Text_IO.Put_Line (Text_File, "Data entered into the file");
- 
-            Text_IO.Close (Text_File);
- 
-            Operational_Test_Block:
-            declare
-               TC_Number_Of_Forced_Mode_Errors : constant Natural := 2;
-               TC_Mode_Errors : Natural := 0;
-            begin
- 
-               Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename);
- 
-               Test_for_Reading:
-               declare
-                  TC_Data   : String (1..80);
-                  TC_Length : Natural := 0;
-               begin
- 
- -- During the course of its processing, the application may become confused
- -- and erroneously attempt to read data from the file that is currently in
- -- Append_File mode (instead of the anticipated In_File mode).
- -- This would result in the raising of Mode_Error.
- 
-                  Text_IO.Get_Line (Text_File, TC_Data, TC_Length);
-                  Report.Failed ("Exception not raised by Get_Line");
- 
- -- An exception handler present within the application handles the exception
- -- and processing can continue.
- 
-               exception
-                  when Text_IO.Mode_Error => 
-                     TC_Mode_Errors := TC_Mode_Errors + 1;
-                  when others             => 
-                     Report.Failed ("Exception in Get_Line processing");
-               end Test_for_Reading;
- 
- 
-               Test_for_End_Of_File:
-               declare
-                  TC_End_Of_File : Boolean;
-               begin
- 
- -- Again, during the course of its processing, the application attempts to 
- -- call the End_Of_File function for the file that is currently in
- -- Append_File mode (instead of the anticipated In_File mode).
- 
-                  TC_End_Of_File := Text_IO.End_Of_File (Text_File);
-                  Report.Failed ("Exception not raised by End_Of_File");
- 
- -- Once again, an exception handler present within the application handles 
- -- the exception and processing continues.
- 
-               exception
-                  when Text_IO.Mode_Error => 
-                     TC_Mode_Errors := TC_Mode_Errors + 1;
-                  when others             => 
-                     Report.Failed("Exception in End_Of_File processing");
-               end Test_for_End_Of_File;
- 
- 
-               if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then
-                  Report.Failed ("Incorrect number of exceptions handled");
-               end if;
- 
-            end Operational_Test_Block;
-      
-            -- Delete the external file.
-            if Text_IO.Is_Open (Text_File) then
-               Text_IO.Delete (Text_File);     
-            else
-               Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
-               Text_IO.Delete (Text_File);     
-            end if;
-          
-         Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- CXAA013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the exception Mode_Error is raised when an attempt is made
- --      to skip a line or page using the predefined Skip_Line and Skip_Page
- --      procedures on a text file with mode Append_File.
- --      
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential for the 
- --      incorrect usage of predefined text processing subprograms, which 
- --      results in the raising of a Mode_Error exception.
- --      A count is kept to ensure that each anticipated exception is in fact
- --      raised and handled properly.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA013 is
-    use Ada;
-    Text_File     : Text_IO.File_Type;
-    Text_Filename : constant String := 
-                               Report.Legal_File_Name ( Nam => "CXAA013" );
-    Incomplete : exception;
- 
- begin
- 
-          Report.Test ("CXAA013", "Check that the exception Mode_Error is " &
-                                  "raised when an attempt is made to skip " &
-                                  "a line or page using the predefined "    &
-                                  "Skip_Line and Skip_Page procedures on "  &
-                                  "a text file with mode Append_File");
- 
-          Test_for_Text_IO_Support:
-          begin
- 
- -- An application creates a text file with mode Append_File.
- -- Use_Error will be raised if Text_IO operations or external files are not
- -- supported.
- 
-             Text_IO.Create (Text_File, Text_IO.Append_File, Text_Filename);
- 
-    exception
- 
-        when Text_IO.Use_Error | Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Append_File for Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_Text_IO_Support;
- 
- -- The application writes some amount of data to the file.
- 
-    Text_IO.Put_Line (Text_File, "Data entered into the file");
- 
-    Operational_Test_Block:
-    declare
-       TC_Number_Of_Forced_Mode_Errors : constant Natural := 2;
-       TC_Mode_Errors : Natural := 0;
-    begin
- 
-       Test_for_Skip_Line:
-       declare
-          TC_Spacing : constant Text_IO.Count := 3;
-       begin
- 
- -- During the course of its processing, the application may attempt to 
- -- invoke the Skip_Line procedure on a file that is currently in Append_File 
- -- mode (instead of the anticipated In_File mode).  This results in the 
- -- raising of Mode_Error.
- 
-          Text_IO.Skip_Line (Text_File, TC_Spacing);
-          Report.Failed ("Exception not raised by Skip_Line");
- 
- -- An exception handler present within the application handles the exception
- -- and processing can continue.
- 
-       exception
-          when Text_IO.Mode_Error => 
-             TC_Mode_Errors := TC_Mode_Errors + 1;
-          when others => 
-             Report.Failed("Exception in Skip_Line processing");
-       end Test_for_Skip_Line;
- 
-       Test_for_Skip_Page:
-       begin
- 
- -- Again, during the course of its processing, the application incorrectly
- -- assumes that the file mode is In_File, this time attempting to call the 
- -- Skip_Page procedure for the file (that is currently in Append_File mode).
- 
-          Text_IO.Skip_Page (Text_File);
-          Report.Failed ("Exception not raised by Skip_Page");
- 
- -- Once again, an exception handler present within the application handles 
- -- the exception and processing continues.
- 
-       exception
-          when Text_IO.Mode_Error => 
-             TC_Mode_Errors := TC_Mode_Errors + 1;
-          when others => 
-             Report.Failed("Exception in Skip_Page processing");
-       end Test_for_Skip_Page;
- 
-       if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then
-          Report.Failed ("Incorrect number of exceptions handled");
-       end if;
- 
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       -- Delete the external file.
-       if Text_IO.Is_Open (Text_File) then
-          Text_IO.Delete (Text_File);     
-       else
-          Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
-          Text_IO.Delete (Text_File);     
-       end if;
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Text_IO" );
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,178 ****
- -- CXAA014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the exception Mode_Error is raised when an attempt is made
- --      to check for the end of a line or page using the predefined functions
- --      End_Of_Line or End_Of_Page on a text file with mode Append_File.
- --      
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential for the 
- --      incorrect usage of predefined text processing subprograms, which 
- --      results in the raising of a Mode_Error exception.
- --      A count is kept to ensure that each anticipated exception is in fact
- --      raised and handled properly.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA014 is
-    use Ada;
-    Text_File     : Text_IO.File_Type;
-    Text_Filename : constant String := 
-                               Report.Legal_File_Name ( Nam => "CXAA014" );
-    Incomplete : exception;
- 
- begin
- 
-          Report.Test ("CXAA014", "Check that the exception Mode_Error is "  &
-                                  "raised when an attempt is made to check " &
-                                  "for the end of a line or page using the " &
-                                  "predefined functions End_Of_Line or "     &
-                                  "End_Of_Page on a text file with mode "    &
-                                  "Append_File");
- 
-          Test_for_Text_IO_Support:
-          begin
- 
- -- Use_Error will be raised if Text_IO operations or external files are not
- -- supported.
- 
-             Text_IO.Create (Text_File, Text_IO.Out_File, Text_Filename);
- 
-    exception
- 
-        when Text_IO.Use_Error | Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_Text_IO_Support;
- 
- 
- -- The application writes some amount of data to the file.
- 
-             for I in 1 .. 10 loop
-                Text_IO.Put_Line (Text_File, "Data entered into the file");
-             end loop;
- 
-             Text_IO.Close (Text_File);
- 
-             Operational_Test_Block:
-             declare
-                TC_Number_Of_Forced_Mode_Errors : constant Natural := 2;
-                TC_Mode_Errors : Natural := 0;
-             begin
- 
-                Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename);
- 
-                Test_for_End_Of_Line:
-                declare
-                   TC_End_Of_Line : Boolean;
-                begin
- 
- -- During the course of its processing, the application may attempt to 
- -- invoke the End_Of_Line function on a file that is currently in Append_File 
- -- mode (instead of the anticipated In_File mode).  This results in the 
- -- raising of Mode_Error.
- 
-                   TC_End_Of_Line := Text_IO.End_Of_Line (Text_File);
-                   Report.Failed ("Exception not raised by End_Of_Line");
- 
- -- An exception handler present within the application handles the exception
- -- and processing can continue.
- 
-                exception
-                   when Text_IO.Mode_Error => 
-                      TC_Mode_Errors := TC_Mode_Errors + 1;
-                   when others => 
-                      Report.Failed("Exception in End_Of_Line processing");
-                end Test_for_End_Of_Line;
- 
- 
-                Test_for_End_Of_Page:
-                declare
-                   TC_End_Of_Page : Boolean;
-                begin
- 
- -- Again, during the course of its processing, the application incorrectly
- -- assumes that the file mode is In_File, this time attempting to call the 
- -- End_Of_Page function for the file (that is currently in Append_File mode).
- 
-                   TC_End_Of_Page := Text_IO.End_Of_Page (Text_File);
-                   Report.Failed ("Exception not raised by End_Of_Page");
- 
- -- Once again, an exception handler present within the application handles 
- -- the exception and processing continues.
- 
-                exception
-                   when Text_IO.Mode_Error => 
-                      TC_Mode_Errors := TC_Mode_Errors + 1;
-                   when others => 
-                      Report.Failed("Exception in End_Of_Page processing");
-                end Test_for_End_Of_Page;
- 
- 
-                if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then
-                   Report.Failed ("Incorrect number of exceptions handled");
-                end if;
- 
-             end Operational_Test_Block;
- 
-             Deletion:
-             begin
-                -- Delete the external file.
-                if Text_IO.Is_Open (Text_File) then
-                   Text_IO.Delete (Text_File);     
-                else
-                   Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
-                   Text_IO.Delete (Text_File);     
-                end if;
-             exception
-                when others =>
-                   Report.Failed
-                      ( "Delete not properly implemented for Text_IO" );
-             end Deletion;
- 
-          Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,227 ****
- -- CXAA015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the exception Status_Error is raised when an attempt is
- --      made to create or open a file in Append_File mode when the file is 
- --      already open.
- --      Check that the exception Name_Error is raised by procedure Open when
- --      attempting to open a file in Append_File mode when the name supplied
- --      as the filename does not correspond to an existing external file.
- --      
- -- TEST DESCRIPTION:
- --      A scenario is created that demonstrates the potential for the 
- --      inappropriate usage of text processing subprograms Create and Open, 
- --      resulting in the raising of Status_Error and Name_Error exceptions.
- --      A count is kept to ensure that each anticipated exception is in fact
- --      raised and handled properly.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support text
- --      files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --!
- 
- with Ada.Text_IO;
- with Report;
- 
- procedure CXAA015 is
-    use Ada;
-    Text_File     : Text_IO.File_Type;
-    Text_Filename : constant String := 
-                               Report.Legal_File_Name ( Nam => "CXAA015" );
-    Incomplete : exception;
- 
- begin
- 
-          Report.Test ("CXAA015", "Check that the appropriate exceptions "    &
-                                  "are raised when procedures Create and "    &
-                                  "Open are used to inappropriately operate " &
-                                  "on files of mode Append_File");
- 
-          Test_for_Text_IO_Support:
-          begin
- 
- -- An application creates a text file with mode Append_File.
- -- Use_Error will be raised if Text_IO operations or external files are not
- -- supported.
- 
-             Text_IO.Create (Text_File, Text_IO.Append_File, Text_Filename);
-          exception
- 
-              when Text_IO.Use_Error | Text_IO.Name_Error =>
-                 Report.Not_Applicable
-                    ( "Files not supported - Create as Append_File for Text_IO" );
-                 raise Incomplete;
- 
-          end Test_for_Text_IO_Support;
- 
- 
- -- The application writes some amount of data to the file.
- 
-             for I in 1 .. 5 loop
-                Text_IO.Put_Line (Text_File, "Data entered into the file");
-             end loop;
- 
-             Operational_Test_Block:
-             declare
-                TC_Number_Of_Forced_Errors : constant Natural := 3;
-                TC_Errors                  :          Natural := 0;
-             begin
- 
- 
-                Test_for_Create:
-                begin
- 
- -- During the course of its processing, the application may (erroneously) 
- -- attempt to create the same file already in existence in Append_File mode.  
- -- This results in the raising of Status_Error.
- 
-                   Text_IO.Create (Text_File, 
-                                   Text_IO.Append_File, 
-                                   Text_Filename);
-                   Report.Failed ("Exception not raised by Create");
- 
- -- An exception handler present within the application handles the exception
- -- and processing can continue.
- 
-                exception
-                   when Text_IO.Status_Error => 
-                      TC_Errors := TC_Errors + 1;
-                   when others => 
-                      Report.Failed("Exception in Create processing");
-                end Test_for_Create;
- 
- 
-                First_Test_For_Open:
-                begin
- 
- -- Again, during the course of its processing, the application incorrectly
- -- attempts to Open a file (in Append_File mode) that is already open.
- 
-                   Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename);
-                   Report.Failed ("Exception not raised by improper Open - 1");
- 
- -- Once again, an exception handler present within the application handles 
- -- the exception and processing continues.
- 
-                exception
-                   when Text_IO.Status_Error => 
-                      TC_Errors := TC_Errors + 1;
- 
- -- At some point in its processing, the application closes the file that is
- -- currently open.
- 
-                      Text_IO.Close (Text_File);
-                   when others => 
-                      Report.Failed("Exception in Open processing - 1");
-                end First_Test_For_Open;
- 
- 
-                Open_With_Wrong_Filename:
-                declare
-                   TC_Wrong_Filename : constant String := 
-                     Report.Legal_File_Name(2);
-                begin
- 
- -- At this point, the application attempts to Open (in Append_File mode) the
- -- file used in previous processing, but it attempts this Open using a name 
- -- string that does not correspond to any existing external file.
- -- First make sure the file doesn't exist.  (If it did, then the check
- -- for open in append mode wouldn't work.)
- 
-                   Verify_No_File:
-                   begin
-                      Text_IO.Open (Text_File,
-                                    Text_IO.In_File,
-                                    TC_Wrong_Filename);
-                   exception
-                      when Text_IO.Name_Error =>
-                         null;
-                      when others =>
-                         Report.Failed ( "Unexpected exception on Open check" );
-                   end Verify_No_File;
- 
-                   Delete_No_File:
-                   begin
-                      if Text_IO.Is_Open (Text_File) then
-                         Text_IO.Delete (Text_File);
-                      end if;
-                   exception
-                      when others =>
-                        Report.Failed ( "Unexpected exception - Delete check" );
-                   end Delete_No_File;
- 
-                   Text_IO.Open (Text_File, 
-                                 Text_IO.Append_File, 
-                                 TC_Wrong_Filename);
-                   Report.Failed ("Exception not raised by improper Open - 2");
- 
- -- An exception handler for the Name_Error, present within the application,
- -- catches the exception and processing continues.
- 
-                exception
-                   when Text_IO.Name_Error => 
-                      TC_Errors := TC_Errors + 1;
-                   when others => 
-                      Report.Failed("Exception in Open processing - 2");
-                end Open_With_Wrong_Filename;
- 
- 
-                if (TC_Errors /= TC_Number_Of_Forced_Errors) then
-                   Report.Failed ("Incorrect number of exceptions handled");
-                end if;
- 
-             end Operational_Test_Block;
- 
-             Deletion:
-             begin
-                -- Delete the external file.
-                if Text_IO.Is_Open (Text_File) then
-                   Text_IO.Delete (Text_File);     
-                else
-                   Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
-                   Text_IO.Delete (Text_File);     
-                end if;
-             exception
-                when others =>
-                   Report.Failed
-                      ( "Delete not properly implemented for Text_IO" );
-             end Deletion;
- 
-          Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAA015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a	Thu Jan  1 00:00:00 1970
***************
*** 1,462 ****
- -- CXAA016.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the type File_Access is available in Ada.Text_IO, and that
- --      objects of this type designate File_Type objects.
- --      Check that function Set_Error will set the current default error file.
- --      Check that versions of Ada.Text_IO functions Standard_Input,
- --      Standard_Output, Standard_Error return File_Access values designating
- --      the standard system input, output, and error files.
- --      Check that versions of Ada.Text_IO functions Current_Input,
- --      Current_Output, Current_Error return File_Access values designating
- --      the current system input, output, and error files.
- --      
- -- TEST DESCRIPTION:
- --      This test tests the use of File_Access objects in referring 
- --      to File_Type objects, as well as several new functions that return 
- --      File_Access objects as results.
- --      Four user-defined files are created.  These files will be set to 
- --      function as current system input, output, and error files.
- --      Data will be read from and written to these files during the
- --      time at which they function as the current system files.  
- --      An array of File_Access objects will be defined.  It will be 
- --      initialized using functions that return File_Access objects 
- --      referencing the Standard and Current Input, Output, and Error files.
- --      This "saves" the initial system environment, which will be modified
- --      to use the user-defined files as the current default Input, Output,
- --      and Error files.  At the end of the test, the data in this array 
- --      will be used to restore the initial system environment.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to implementations capable of supporting
- --      external Text_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      25 May 95   SAIC    Initial prerelease version.
- --      22 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
- --      18 Jan 99   RLB     Repaired to allow Not_Applicable systems to
- --                          fail delete.
- --!
- 
- with Ada.Text_IO;
- package CXAA016_0 is
-    New_Input_File,
-    New_Output_File,
-    New_Error_File_1,
-    New_Error_File_2 : aliased Ada.Text_IO.File_Type;
- end CXAA016_0;
- 
- 
- with Report;
- with Ada.Exceptions;
- with Ada.Text_IO; use Ada.Text_IO;
- with CXAA016_0;   use CXAA016_0;
- 
- procedure CXAA016 is
-    
-    Non_Applicable_System : exception;
-    No_Reset              : exception;
-    Not_Applicable_System : Boolean := False;
- 
-    procedure Delete_File ( A_File : in out Ada.Text_IO.File_Type;
-                            ID_Num : in     Integer ) is
-    begin
-       if not Ada.Text_IO.Is_Open ( A_File ) then
-          Ada.Text_IO.Open ( A_File, 
-                             Ada.Text_IO.In_File, 
-                             Report.Legal_File_Name ( ID_Num ) );
-       end if;
-       Ada.Text_IO.Delete ( A_File );
-    exception
-       when Ada.Text_IO.Name_Error =>
-          if Not_Applicable_System then
-             null; -- File probably wasn't created.
-          else
-             Report.Failed ( "Can't open file for Text_IO" );
-          end if;
-       when Ada.Text_IO.Use_Error =>
-          if Not_Applicable_System then
-             null; -- File probably wasn't created.
-          else
-             Report.Failed ( "Delete not properly implemented for Text_IO" );
-          end if;
-       when others                =>
-          Report.Failed ( "Unexpected exception in Delete_File" );
-    end Delete_File;
- 
- begin
- 
-    Report.Test ("CXAA016", "Check that the type File_Access is available " &
-                            "in Ada.Text_IO, and that objects of this "     &
-                            "type designate File_Type objects");
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
- 
-       type System_File_Array_Type is 
-         array (Integer range <>) of File_Access;        
- 
-       -- Fill the following array with the File_Access results of six
-       -- functions.
- 
-       Initial_Environment : System_File_Array_Type(1..6) := 
-                               ( Standard_Input,
-                                 Standard_Output,
-                                 Standard_Error,
-                                 Current_Input,    
-                                 Current_Output,
-                                 Current_Error );
- 
-       New_Input_Ptr    : File_Access := New_Input_File'Access;
-       New_Output_Ptr   : File_Access := New_Output_File'Access;
-       New_Error_Ptr    : File_Access := New_Error_File_1'Access;
- 
-       Line   : String(1..80);
-       Length : Natural := 0;
- 
-       Line_1 : constant String := "This is the first line in the Output file";
-       Line_2 : constant String := "This is the next line in the Output file";
-       Line_3 : constant String := "This is the first line in Error file 1";
-       Line_4 : constant String := "This is the next line in Error file 1";
-       Line_5 : constant String := "This is the first line in Error file 2";
-       Line_6 : constant String := "This is the next line in Error file 2";
- 
- 
- 
-       procedure New_File (The_File : in out File_Type;
-                           Mode     : in     File_Mode;
-                           Next     : in     Integer) is
-       begin
-          Create (The_File, Mode, Report.Legal_File_Name(Next));
-       exception
-          -- The following two exceptions may be raised if a system is not
-          -- capable of supporting external Text_IO files.  The handler will
-          -- raise a user-defined exception which will result in a 
-          -- Not_Applicable result for the test.
-          when Use_Error | Name_Error => raise Non_Applicable_System;
-       end New_File;
- 
- 
- 
-       procedure Check_Initial_Environment (Env : System_File_Array_Type) is
-       begin
-         -- Check that the system has defined the following sources/
-         -- destinations for input/output/error, and that the six functions
-         -- returning File_Access values are available.
-         if not (Env(1) = Standard_Input  and
-                 Env(2) = Standard_Output and
-                 Env(3) = Standard_Error  and    
-                 Env(4) = Current_Input   and
-                 Env(5) = Current_Output  and
-                 Env(6) = Current_Error) 
-         then
-            Report.Failed("At the start of the test, the Standard and " &
-                          "Current File_Access values associated with " &
-                          "system Input, Output, and Error files do "   &
-                          "not correspond");
-         end if;
-       end Check_Initial_Environment;
- 
- 
- 
-       procedure Load_Input_File (Input_Ptr : in File_Access) is
-       begin
-          -- Load data into the file that will function as the user-defined
-          -- system input file.
-          Put_Line(Input_Ptr.all, Line_1);
-          Put_Line(Input_Ptr.all, Line_2);
-          Put_Line(Input_Ptr.all, Line_3);
-          Put_Line(Input_Ptr.all, Line_4);
-          Put_Line(Input_Ptr.all, Line_5);
-          Put_Line(Input_Ptr.all, Line_6);
-       end Load_Input_File;
- 
- 
- 
-       procedure Restore_Initial_Environment 
-                   (Initial_Env : System_File_Array_Type) is 
-       begin
-          -- Restore the Current Input, Output, and Error files to their
-          -- original states.
- 
-          Set_Input (Initial_Env(4).all);
-          Set_Output(Initial_Env(5).all);
-          Set_Error (Initial_Env(6).all);
- 
-          -- At this point, the user-defined files that were functioning as
-          -- the Current Input, Output, and Error files have been replaced in
-          -- that capacity by the state of the original environment.
- 
-          declare
- 
-             -- Capture the state of the current environment.
- 
-             Current_Env : System_File_Array_Type (1..6) := 
-                             (Standard_Input, Standard_Output, Standard_Error,
-                              Current_Input,  Current_Output,  Current_Error);
-          begin
- 
-             -- Compare the current environment with that of the saved  
-             -- initial environment.
- 
-             if Current_Env /= Initial_Env then
-                Report.Failed("Restored file environment was not the same " &
-                              "as the initial file environment");
-             end if;
-          end;
-       end Restore_Initial_Environment;
- 
- 
- 
-       procedure Verify_Files (O_File, E_File_1, E_File_2 : in File_Type) is
-          Str_1, Str_2, Str_3, Str_4, Str_5, Str_6 : String (1..80);
-          Len_1, Len_2, Len_3, Len_4, Len_5, Len_6 : Natural;
-       begin
-          
-          -- Get the lines that are contained in all the files, and verify
-          -- them against the expected results.
- 
-          Get_Line(O_File, Str_1, Len_1);  -- The user defined output file 
-          Get_Line(O_File, Str_2, Len_2);  -- should contain two lines of data.
-        
-          if Str_1(1..Len_1) /= Line_1 or
-             Str_2(1..Len_2) /= Line_2
-          then
-             Report.Failed("Incorrect results from Current_Output file");
-          end if;
- 
-          Get_Line(E_File_1, Str_3, Len_3);  -- The first error file received 
-          Get_Line(E_File_1, Str_4, Len_4);  -- two lines of data originally,
-          Get_Line(E_File_1, Str_5, Len_5);  -- then had two additional lines
-          Get_Line(E_File_1, Str_6, Len_6);  -- appended from the second error
-                                             -- file.
-          if Str_3(1..Len_3) /= Line_3 or
-             Str_4(1..Len_4) /= Line_4 or
-             Str_5(1..Len_5) /= Line_5 or
-             Str_6(1..Len_6) /= Line_6 
-          then
-             Report.Failed("Incorrect results from first Error file");
-          end if;
- 
-          Get_Line(E_File_2, Str_5, Len_5);  -- The second error file
-          Get_Line(E_File_2, Str_6, Len_6);  -- received two lines of data.
- 
-          if Str_5(1..Len_5) /= Line_5 or
-             Str_6(1..Len_6) /= Line_6 
-          then
-             Report.Failed("Incorrect results from second Error file");
-          end if;
- 
-       end Verify_Files;
- 
- 
- 
-    begin
- 
-       Check_Initial_Environment (Initial_Environment);
- 
-       -- Create user-defined text files that will be set to serve as current
-       -- system input, output, and error files.
- 
-       New_File (New_Input_File,   Out_File, 1); -- Will be reset prior to use.
-       New_File (New_Output_File,  Out_File, 2);
-       New_File (New_Error_File_1, Out_File, 3);
-       New_File (New_Error_File_2, Out_File, 4);
- 
-       -- Enter several lines of text into the new input file.  This file will
-       -- be reset to mode In_File to function as the current system input file.
-       -- Note: File_Access value used as parameter to this procedure.
-       
-       Load_Input_File (New_Input_Ptr);
- 
-       -- Reset the New_Input_File to mode In_File, to allow it to act as the
-       -- current system input file.
- 
-       Reset1:
-       begin
-          Reset (New_Input_File, In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO - 1" );
-             raise No_Reset;
-       end Reset1;
- 
-       -- Establish new files that will function as the current system Input,
-       -- Output, and Error files.
-       
-       Set_Input (New_Input_File);
-       Set_Output(New_Output_Ptr.all);
-       Set_Error (New_Error_Ptr.all);      
- 
-       -- Perform various file processing tasks, exercising specific new
-       -- Text_IO functionality.
-       --
-       -- Read two lines from Current_Input and write them to Current_Output.
- 
-       for i in 1..2 loop
-          Get_Line(Current_Input,  Line, Length);
-          Put_Line(Current_Output, Line(1..Length));
-       end loop;
- 
-       -- Read two lines from Current_Input and write them to Current_Error.
- 
-       for i in 1..2 loop
-          Get_Line(Current_Input, Line, Length);
-          Put_Line(Current_Error, Line(1..Length));
-       end loop;
- 
-       -- Reset the Current system error file.
- 
-       Set_Error (New_Error_File_2);      
- 
-       -- Read two lines from Current_Input and write them to Current_Error.
- 
-       for i in 1..2 loop
-          Get_Line(Current_Input, Line, Length);
-          Put_Line(Current_Error, Line(1..Length));
-       end loop;
- 
-       -- At this point in the processing, the new Output file, and each of
-       -- the two Error files, contain two lines of data.
-       -- Note that New_Error_File_1 has been replaced by New_Error_File_2
-       -- as the current system error file, allowing New_Error_File_1 to be
-       -- reset (Mode_Error raised otherwise).
-       --
-       -- Reset the first Error file to Append_File mode, and then set it to 
-       -- function as the current system error file.
- 
-       Reset2:
-       begin
-          Reset (New_Error_File_1, Append_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to Append_File not supported for Text_IO - 2" );
-             raise No_Reset;
-       end Reset2;
- 
-       Set_Error (New_Error_File_1);
- 
-       -- Reset the second Error file to In_File mode, then set it to become
-       -- the current system input file.
- 
-       Reset3:
-       begin
-          Reset (New_Error_File_2, In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO - 3" );
-             raise No_Reset;
-       end Reset3;
- 
-       New_Error_Ptr := New_Error_File_2'Access; 
-       Set_Input (New_Error_Ptr.all);
- 
-       -- Append all of the text lines (2) in the new current system input
-       -- file onto the current system error file.
- 
-       while not End_Of_File(Current_Input) loop
-          Get_Line(Current_Input, Line, Length);
-          Put_Line(Current_Error, Line(1..Length));
-       end loop;
- 
-       -- Restore the original system file environment, based upon the values
-       -- stored at the start of this test.
-       -- Check that the original environment has been restored.
- 
-       Restore_Initial_Environment (Initial_Environment);
- 
-       -- Reset all three files to In_File_Mode prior to verification.
-       -- Note: If these three files had still been the designated Current
-       --       Input, Output, or Error files for the system, a Reset 
-       --       operation at this point would raise Mode_Error.
-       --       However, at this point, the environment has been restored to
-       --       its original state, and these user-defined files are no longer
-       --       designated as current system files, allowing a Reset.
- 
-       Reset4:
-       begin
-          Reset(New_Error_File_1, In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO - 4" );
-             raise No_Reset;
-       end Reset4;
- 
-       Reset5:
-       begin
-          Reset(New_Error_File_2, In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO - 5" );
-             raise No_Reset;
-       end Reset5;
- 
-       Reset6:
-       begin
-          Reset(New_Output_File,  In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO - 6" );
-             raise No_Reset;
-       end Reset6;
- 
-       -- Check that all the files contain the appropriate data.
- 
-       Verify_Files (New_Output_File, New_Error_File_1, New_Error_File_2);
- 
-    exception
-       when No_Reset =>
-          null;
-       when Non_Applicable_System =>
-          Report.Not_Applicable("System not capable of supporting external " &
-                                "text files -- Name_Error/Use_Error raised " &
-                                "during text file creation");
-          Not_Applicable_System := True;
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Delete_Block:
-    begin
-       Delete_File ( New_Input_File, 1 );
-       Delete_File ( New_Output_File, 2 );
-       Delete_File ( New_Error_File_1, 3 );
-       Delete_File ( New_Error_File_2, 4 );
-    end Delete_Block;
- 
-    Report.Result;
- 
- end CXAA016;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a	Thu Jan  1 00:00:00 1970
***************
*** 1,400 ****
- -- CXAA017.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Ada.Text_IO function Look_Ahead sets parameter End_Of_Line
- --      to True if at the end of a line; otherwise check that it returns the
- --      next character from a file (without consuming it), while setting 
- --      End_Of_Line to False.  
- --      
- --      Check that Ada.Text_IO function Get_Immediate will return the next
- --      control or graphic character in parameter Item from the specified 
- --      file.  Check that the version of Ada.Text_IO function Get_Immediate 
- --      with the Available parameter will, if a character is available in the
- --      specified file, return the character in parameter Item, and set 
- --      parameter Available to True.
- --      
- -- TEST DESCRIPTION:
- --      This test exercises specific capabilities of two Text_IO subprograms, 
- --      Look_Ahead and Get_Immediate.  A file is prepared that contains a 
- --      variety of graphic and control characters on several lines.
- --      In processing this file, a call to Look_Ahead is performed to ensure
- --      that characters are available, then individual characters are 
- --      extracted from the current line using Get_Immediate.  The characters
- --      returned from both subprogram calls are compared with the expected
- --      character result.  Processing on each file line continues until
- --      Look_Ahead indicates that the end of the line is next.  Separate
- --      verification is performed to ensure that all characters of each line
- --      are processed, and that the Available and End_Of_Line parameters
- --      of the subprograms are properly set in the appropriate instances.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to implementations capable of supporting
- --      external Text_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      30 May 95   SAIC    Initial prerelease version.
- --      01 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
- --!
- 
- with Ada.Text_IO;
- package CXAA017_0 is
- 
-    User_Defined_Input_File : aliased Ada.Text_IO.File_Type;
- 
- end CXAA017_0;
- 
- 
- with CXAA017_0; use CXAA017_0;
- with Ada.Characters.Latin_1;
- with Ada.Exceptions;
- with Ada.Text_IO;  
- with Report;
- 
- procedure CXAA017 is
-    
-    use Ada.Characters.Latin_1;
-    use Ada.Exceptions;
-    use Ada.Text_IO;
- 
-    Non_Applicable_System : exception;
-    No_Reset            : exception;
- 
- begin
- 
-    Report.Test ("CXAA017", "Check that Ada.Text_IO subprograms "         &
-                            "Look_Ahead and Get_Immediate are available " &
-                            "and produce correct results");
- 
-    Test_Block:
-    declare
- 
-       User_Input_Ptr    : File_Access := User_Defined_Input_File'Access;
- 
-       UDLA_Char,          -- Acronym UDLA => "User Defined Look Ahead"
-       UDGI_Char,          -- Acronym UDGI => "User Defined Get Immediate"
-       TC_Char           : Character := Ada.Characters.Latin_1.NUL;
- 
-       UDLA_End_Of_Line,
-       UDGI_Available    : Boolean   := False;
- 
-       Char_Pos          : Natural;
- 
-       -- This string contains five ISO 646 Control characters and six ISO 646 
-       -- Graphic characters:
-       TC_String_1  : constant String := STX       & 
-                                         SI        & 
-                                         DC2       & 
-                                         CAN       & 
-                                         US        & 
-                                         Space     & 
-                                         Ampersand & 
-                                         Solidus   & 
-                                         'A'       & 
-                                         LC_X      & 
-                                         DEL; 
- 
-       -- This string contains two ISO 6429 Control and six ISO 6429 Graphic
-       -- characters:
-       TC_String_2  : constant String := IS4                         & 
-                                         SCI                         & 
-                                         Yen_Sign                    & 
-                                         Masculine_Ordinal_Indicator & 
-                                         UC_I_Grave                  & 
-                                         Multiplication_Sign         & 
-                                         LC_C_Cedilla                & 
-                                         LC_Icelandic_Thorn;
- 
-       TC_Number_Of_Strings : constant := 2;
- 
-       type String_Access_Type    is access constant String;
-       type String_Ptr_Array_Type is 
-         array (1..TC_Number_Of_Strings) of String_Access_Type;
- 
-       TC_String_Ptr_Array : String_Ptr_Array_Type := 
-                               (new String'(TC_String_1),
-                                new String'(TC_String_2));
- 
- 
- 
-       procedure Create_New_File (The_File : in out File_Type;
-                                  Mode     : in     File_Mode;
-                                  Next     : in     Integer) is
-       begin
-          Create (The_File, Mode, Report.Legal_File_Name(Next));
-       exception
-          -- The following two exceptions can be raised if a system is not
-          -- capable of supporting external Text_IO files.  The handler will
-          -- raise a user-defined exception which will result in a 
-          -- Not_Applicable result for the test.
-          when Use_Error | Name_Error => raise Non_Applicable_System;
-       end Create_New_File;
- 
- 
- 
-       procedure Load_File (The_File : in out File_Type) is
-       -- This procedure will load several strings into the file denoted
-       -- by the input parameter.  A call to New_Line will add line/page
-       -- termination characters, which will be available  for processing
-       -- along with the text in the file.
-       begin
-          Put_Line (The_File, TC_String_Ptr_Array(1).all);
-          New_Line (The_File, Spacing => 1);
-          Put_Line (The_File, TC_String_Ptr_Array(2).all);
-       end Load_File;
- 
- 
-    begin
- 
-       -- Create user-defined text file that will serve as the appropriate
-       -- sources of input to the procedures under test.
- 
-       Create_New_File (User_Defined_Input_File, Out_File, 1);
- 
-       -- Enter several lines of text into the new input file. 
-       -- The characters that make up these text strings will be processed 
-       -- using the procedures being exercised in this test.
- 
-       Load_File (User_Defined_Input_File);
- 
-       -- Check that Mode_Error is raised by Look_Ahead and Get_Immedidate 
-       -- if the mode of the file object is not In_File.
-       -- Currently, the file mode is Out_File.
- 
-       begin
-          Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
-          Report.Failed("Mode_Error not raised by Look_Ahead");
-          Report.Comment("This char should never be printed: " & UDLA_Char); 
-       exception
-          when Mode_Error => null;  -- OK, expected exception.
-          when The_Error : others => 
-             Report.Failed ("The following exception was raised during the " &
-                            "check that Look_Ahead raised Mode_Error when "  &
-                            "provided a file object that is not in In_File " &
-                            "mode: " & Exception_Name(The_Error));
-       end;
- 
-       begin
-          Get_Immediate(User_Defined_Input_File, UDGI_Char);
-          Report.Failed("Mode_Error not raised by Get_Immediate");
-          Report.Comment("This char should never be printed: " & UDGI_Char);
-       exception
-          when Mode_Error => null;  -- OK, expected exception.
-          when The_Error : others => 
-             Report.Failed ("The following exception was raised during the " &
-                            "check that Get_Immediate raised Mode_Error "    &
-                            "when provided a file object that is not in "    &
-                            "In_File mode: " & Exception_Name(The_Error));
-       end;
- 
- 
-       -- The file will then be reset to In_File mode to properly function as 
-       -- a source of input.
- 
-       Reset1:
-       begin
-          Reset (User_Defined_Input_File, In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO" );
-             raise No_Reset;
-       end Reset1;
- 
-       -- Process the input file, exercising various Text_IO
-       -- functionality, and validating the results at each step.
-       -- Note: The designated File_Access object is used in processing
-       --       the New_Default_Input_File in the second loop below.
- 
-       -- Process characters in first line of text of each file.
- 
-       Char_Pos := 1;
- 
-       -- Check that the first line is not blank.
- 
-       Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
- 
-       while not UDLA_End_Of_Line loop
- 
-          -- Use the Get_Immediate procedure on the file to get the next 
-          -- available character on the current line.
- 
-          Get_Immediate(User_Defined_Input_File, UDGI_Char);
- 
-          -- Check that the characters returned by both procedures are the
-          -- same, and that they match the expected character from the file.
- 
-          if UDLA_Char /= TC_String_Ptr_Array(1).all(Char_Pos) or
-             UDGI_Char /= TC_String_Ptr_Array(1).all(Char_Pos) 
-          then
-             Report.Failed("Incorrect retrieval of character " &
-                           Integer'Image(Char_Pos) & " of first string");
-          end if;
- 
-          -- Increment the character position counter.
-          Char_Pos := Char_Pos + 1;
- 
-          -- Check the next character on the line.  If at the end of line,
-          -- the processing flow will exit the While loop.
- 
-          Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
- 
-       end loop;
- 
-       -- Check to ensure that the "end of line" results returned from the 
-       -- Look_Ahead procedure (used to exit the above While loop) corresponds
-       -- with the result of Function End_Of_Line.
- 
-       if not End_Of_Line(User_Defined_Input_File)
-       then
-          Report.Failed("Result of procedure Look_Ahead that indicated "    &
-                        "being at the end of the line does not correspond " &
-                        "with the result of function End_Of_Line");
-       end if;
- 
-       -- Check that all characters in the string were processed.
- 
-       if Char_Pos-1 /= TC_String_1'Length then
-          Report.Failed("Not all of the characters on the first line " &
-                        "were processed");
-       end if;
- 
- 
-       -- Call procedure Skip_Line to advance beyond the end of the first line.
- 
-       Skip_Line(User_Defined_Input_File);
- 
- 
-       -- Process the second line in the file (a blank line).
- 
-       Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
- 
-       if not UDLA_End_Of_Line then
-          Report.Failed("Incorrect end of line determination from procedure " &
-                        "Look_Ahead when processing a blank line");
-       end if;
- 
-       -- Call procedure Skip_Line to advance beyond the end of the second line.
- 
-       Skip_Line(User_Input_Ptr.all);
- 
- 
-       -- Process characters in the third line of the file (second line 
-       -- of text)
-       -- Note: The version of Get_Immediate used in processing this line has 
-       --       the Boolean parameter Available.
- 
-       Char_Pos := 1;
- 
-       -- Check whether the line is blank (i.e., at end of line, page, or file).
- 
-       Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
- 
-       while not UDLA_End_Of_Line loop
- 
-          -- Use the Get_Immediate procedure on the file to get access to the
-          -- next character on the current line.
- 
-          Get_Immediate(User_Input_Ptr.all, UDGI_Char, UDGI_Available);
- 
-          -- Check that the Available parameter of Get_Immediate was set
-          -- to indicate that a character was available in the file.
-          -- Check that the characters returned by both procedures are the 
-          -- same, and they all match the expected character from the file.
- 
-          if not UDGI_Available                                or
-             UDLA_Char /= TC_String_Ptr_Array(2).all(Char_Pos) or
-             UDGI_Char /= TC_String_Ptr_Array(2).all(Char_Pos) 
-          then
-             Report.Failed("Incorrect retrieval of character " &
-                           Integer'Image(Char_Pos) & " of second string");
-          end if;
- 
-          -- Increment the character position counter.
- 
-          Char_Pos := Char_Pos + 1;
- 
-          -- Check the next character on the line.  If at the end of line,
-          -- the processing flow will exit the While loop.
- 
-          Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
- 
-       end loop;
- 
-       -- Check to ensure that the "end of line" results returned from the 
-       -- Look_Ahead procedure (used to exit the above While loop) corresponds
-       -- with the result of Function End_Of_Line.
- 
-       if not End_Of_Line(User_Defined_Input_File)
-       then
-          Report.Failed("Result of procedure Look_Ahead that indicated "    &
-                        "being at the end of the line does not correspond " &
-                        "with the result of function End_Of_Line");
-       end if;
- 
-       -- Check that all characters in the second string were processed.
- 
-       if Char_Pos-1 /= TC_String_2'Length then
-          Report.Failed("Not all of the characters on the second line " &
-                        "were processed");
-       end if;
- 
- 
-       Deletion:
-       begin
-          -- Delete the user defined file.
- 
-          if Is_Open(User_Defined_Input_File) then
-             Delete(User_Defined_Input_File);
-          else
-             Open(User_Defined_Input_File, Out_File, Report.Legal_File_Name(1));
-             Delete(User_Defined_Input_File);
-          end if;
-       exception
-          when others =>
-             Report.Failed
-                ( "Delete not properly implemented for Text_IO" );
-       end Deletion;
- 
- 
-    exception
- 
-       when No_Reset =>
-          null;
- 
-       when Non_Applicable_System =>
-          Report.Not_Applicable("System not capable of supporting external " &
-                                "text files -- Name_Error/Use_Error raised " &
-                                "during text file creation");
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXAA017;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a	Thu Jan  1 00:00:00 1970
***************
*** 1,277 ****
- -- CXAA018.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in the package Text_IO.Modular_IO
- --      provide correct results.  
- --
- -- TEST DESCRIPTION:
- --      This test checks that the subprograms defined in the 
- --      Ada.Text_IO.Modular_IO package provide correct results.  
- --      A modular type is defined and used to instantiate the generic
- --      package Ada.Text_IO.Modular_IO.  Values of the modular type are
- --      written to a Text_IO file, and to a series of string variables, using
- --      different versions of the procedure Put from the instantiated IO
- --      package.  These modular data items are retrieved from the file and
- --      string variables using the appropriate instantiated version of
- --      procedure Get.  A variety of Base and Width parameter values are
- --      used in the procedure calls.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that support Text_IO
- --      processing and external files.
- --
- --       
- -- CHANGE HISTORY:
- --      03 Jul 95   SAIC    Initial prerelease version.
- --      01 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- with Ada.Text_IO;
- with System;
- with Report;
- 
- procedure CXAA018 is
- begin
- 
-    Report.Test ("CXAA018", "Check that the subprograms defined in "  &
-                            "the package Text_IO.Modular_IO provide " & 
-                            "correct results");
- 
-    Test_for_Text_IO_Support:
-    declare
-       Data_File     : Ada.Text_IO.File_Type;
-       Data_Filename : constant String := Report.Legal_File_Name;
-    begin
- 
-       -- An application creates a text file in mode Out_File, with the 
-       -- intention of entering modular data into the file as appropriate.  
-       -- In the event that the particular environment where the application 
-       -- is running does not support Text_IO, Use_Error or Name_Error will be 
-       -- raised on calls to Text_IO operations.  Either of these exceptions
-       -- will be handled to produce a Not_Applicable result.
- 
-       Ada.Text_IO.Create (File => Data_File,
-                           Mode => Ada.Text_IO.Out_File,
-                           Name => Data_Filename);
- 
-       Test_Block:
-       declare
- 
-          type Mod_Type is mod System.Max_Binary_Modulus; 
-          -- Max_Binary_Modulus must be at least 2**16, which would result
-          -- in a base range of 0..65535 (zero to one less than the given
-          -- modulus) for this modular type.
- 
-          package Mod_IO is new Ada.Text_IO.Modular_IO(Mod_Type);
-          use Ada.Text_IO, Mod_IO;
-          use type Mod_Type;
- 
-          Number_Of_Modular_Items : constant := 6;
-          Number_Of_Error_Items   : constant := 1;
- 
-          TC_Modular              : Mod_Type;
-          TC_Last_Character_Read  : Positive;
- 
-          Modular_Array : array (1..Number_Of_Modular_Items) of Mod_Type := 
-                                    ( 0, 97, 255, 1025, 12097, 65535 );
- 
- 
-          procedure Load_File (The_File : in out Ada.Text_IO.File_Type) is
-          begin
-             -- This procedure does not create, open, or close the data file;
-             -- The_File file object must be Open at this point.
-             -- This procedure is designed to load Modular_Type data into a 
-             -- data file. 
-             --
-             -- Use the Modular_IO procedure Put to enter modular data items
-             -- into the data file.
- 
-             for i in 1..Number_Of_Modular_Items loop
-                -- Use default Base parameter of 10.
-                Mod_IO.Put(File  => Data_File, 
-                           Item  => Modular_Array(i), 
-                           Width => 6, 
-                           Base  => Mod_IO.Default_Base);
-             end loop;
- 
-             -- Enter data into the file such that on the corresponding "Get"
-             -- of this data, Data_Error must be raised.  This value is outside
-             -- the base range of Modular_Type.
-             -- Text_IO is used to enter the value in the file.
- 
-             for i in 1..Number_Of_Error_Items loop
-                Ada.Text_IO.Put(The_File, "-10");  
-             end loop;
- 
-          end Load_File;
- 
- 
- 
-          procedure Process_File(The_File : in out Ada.Text_IO.File_Type) is
-          begin
-             -- This procedure does not create, open, or close the data file;
-             -- The_File file object must be Open at this point.
-             -- Use procedure Get (for Files) to extract the modular data from
-             -- the Text_IO file.  
- 
-             for i in 1..Number_Of_Modular_Items loop
-                Mod_IO.Get(The_File, TC_Modular, Width => 6);
- 
-                if TC_Modular /= Modular_Array(i) then
-                   Report.Failed("Incorrect modular data read from file " &
-                                 "data item #" & Integer'Image(i));
-                end if;
-             end loop;
- 
-             -- The final item in the Data_File is a modular value that is
-             -- outside the base range 0..Num'Last.  This value should raise
-             -- Data_Error on an attempt to "Get" it from the file.
- 
-             for i in 1..Number_Of_Error_Items loop
-                begin
-                   Mod_IO.Get(The_File, TC_Modular, Mod_IO.Default_Width);
-                   Report.Failed
-                     ("Exception Data_Error not raised when Get "   &
-                      "was used to read modular data outside base " &
-                      "range of type, item # "                      & 
-                      Integer'Image(i));
-                exception
-                   when Ada.Text_IO.Data_Error => 
-                      null; -- OK, expected exception.
-                   when others =>
-                      Report.Failed("Unexpected exception raised when Get "  &
-                                    "was used to read modular data outside " &
-                                    "base range of type from Data_File, "    &
-                                    "data item #" & Integer'Image(i));
-                end;
-             end loop;
-        
-          exception
-             when others =>
-               Report.Failed
-                 ("Unexpected exception raised in Process_File");
-          end Process_File;
- 
- 
- 
-       begin  -- Test_Block.
- 
-          -- Place modular values into data file.
- 
-          Load_File(Data_File);
-          Ada.Text_IO.Close(Data_File);
- 
-          -- Read modular values from data file.
- 
-          Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename);
-          Process_File(Data_File);
- 
-          -- Verify versions of Modular_IO procedures Put and Get for Strings.
- 
-          Modular_IO_in_Strings:
-          declare
-             TC_String_Array : array (1..Number_Of_Modular_Items) 
-                               of String(1..30) := (others =>(others => ' '));
-          begin
- 
-             -- Place modular values into strings using the Procedure Put, 
-             -- Use a variety of different "Base" parameter values.
-             -- Note: This version of Put uses the length of the given
-             --       string as the value of the "Width" parameter.
- 
-             for i in 1..2 loop
-                Mod_IO.Put(To   => TC_String_Array(i),
-                           Item => Modular_Array(i),
-                           Base => Mod_IO.Default_Base);
-             end loop;
-             for i in 3..4 loop
-                Mod_IO.Put(TC_String_Array(i),
-                           Modular_Array(i),
-                           Base => 2);
-             end loop;
-             for i in 5..6 loop
-                Mod_IO.Put(TC_String_Array(i), Modular_Array(i), 16);
-             end loop;
- 
-             -- Get modular values from strings using the Procedure Get.
-             -- Compare with expected modular values.
- 
-             for i in 1..Number_Of_Modular_Items loop
- 
-                Mod_IO.Get(From => TC_String_Array(i),
-                           Item => TC_Modular,
-                           Last => TC_Last_Character_Read);
- 
-                if TC_Modular /= Modular_Array(i) then
-                   Report.Failed("Incorrect modular data value obtained "   &
-                                 "from String following use of Procedures " & 
-                                 "Put and Get from Strings, Modular_Array " &
-                                 "item #" & Integer'Image(i));
-                end if;
-             end loop;
-          
-          exception
-             when others => 
-                Report.Failed("Unexpected exception raised during the " &
-                              "evaluation of Put and Get for Strings");
-          end Modular_IO_in_Strings;
- 
-       exception
-          when others => Report.Failed ("Exception raised in Test_Block");
-       end Test_Block;
- 
- 
-       -- Delete the external file.
-       if Ada.Text_IO.Is_Open(Data_File) then
-          Ada.Text_IO.Delete(Data_File);
-       else
-          Ada.Text_IO.Open(Data_File, 
-                           Ada.Text_IO.In_File,
-                           Data_Filename);
-          Ada.Text_IO.Delete(Data_File);
-       end if;
- 
-    exception
- 
-       -- Since Use_Error can be raised if, for the specified mode,
-       -- the environment does not support Text_IO operations, the 
-       -- following handlers are included:
- 
-       when Ada.Text_IO.Use_Error  =>
-          Report.Not_Applicable ("Use_Error raised on Text_IO Create");
- 
-       when Ada.Text_IO.Name_Error =>
-          Report.Not_Applicable ("Name_Error raised on Text_IO Create");
- 
-       when others                 =>
-          Report.Failed ("Unexpected exception raised on text file Create");
- 
-    end Test_for_Text_IO_Support;
- 
-    Report.Result;
- 
- end CXAA018;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a	Thu Jan  1 00:00:00 1970
***************
*** 1,138 ****
- -- CXAA019.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that Standard_Output can be flushed.  Check that 'in' parameters of
- --    types Ada.Text_IO.File_Type and Ada.Streams.Stream_IO.File_Type can be
- --    flushed.  (Defect Report 8652/0051).
- --
- -- CHANGE HISTORY:
- --    12 FEB 2001   PHL   Initial version
- --    16 MAR 2001   RLB   Readied for release; fixed Not_Applicable check
- --                        to terminate test gracefully.
- --
- --!
- with Ada.Streams.Stream_Io;
- use Ada.Streams;
- with Ada.Text_Io;
- with Ada.Wide_Text_Io;
- with Report;
- use Report;
- procedure CXAA019 is
- 
-     procedure Check (File : in Ada.Text_Io.File_Type) is
-     begin
-         Ada.Text_Io.Put_Line
-            (File, "   - CXAA019 About to flush a Text_IO file passed " &
-                   "as 'in' parameter");
-         Ada.Text_Io.Flush (File);
-     end Check;
- 
-     procedure Check (File : in Ada.Wide_Text_Io.File_Type) is
-     begin
-         Ada.Wide_Text_Io.Put_Line
-            (File, "   - CXAA019 About to flush a Wide_Text_IO file passed " &
-                   "as 'in' parameter");
-         Ada.Wide_Text_Io.Flush (File);
-     end Check;
- 
-     procedure Check (File : in Stream_Io.File_Type) is
-         S : Stream_Element_Array (1 .. 10);
-     begin
-         for I in S'Range loop
-             S (I) := Stream_Element (Character'Pos ('A') + I);
-         end loop;
-         Stream_Io.Write (File, S);
-         Comment ("About to flush a Stream_IO file passed as 'in' parameter");
-         Stream_Io.Flush (File);
-     end Check;
- 
- 
- begin
-     Test ("CXAA019",
-           "Check that Standard_Output can be flushed; check that " &
-              "'in' Ada.Text_IO.File_Type and Ada.Streams.Stream_IO.File_Type" &
-              "parameters can be flushed");
- 
-     Ada.Text_Io.Put_Line (Ada.Text_Io.Standard_Output,
-                           "   - CXAA019 About to flush Standard_Output");
-     Ada.Text_Io.Flush (Ada.Text_Io.Standard_Output);
- 
-     Check (Ada.Text_Io.Current_Output);
- 
-     declare
-         TC_OK : Boolean := False;
-         F : Ada.Text_Io.File_Type;
-     begin
-         begin
-             Ada.Text_Io.Create (F, Name => Legal_File_Name (X => 1));
-             TC_OK := True;
-         exception
-             when others =>
-                 Not_Applicable ("Unable to create Out mode Text_IO file");
-         end;
-         if TC_OK then
-             Check (F);
-             Ada.Text_Io.Delete (F);
-         end if;
-     end;
- 
-     declare
-         TC_OK : Boolean := False;
-         F : Ada.Wide_Text_Io.File_Type;
-     begin
-         begin
-             Ada.Wide_Text_Io.Create (F, Name => Legal_File_Name (X => 2));
-             TC_OK := True;
-         exception
-             when others =>
-                 Not_Applicable ("Unable to create Out mode Wide_Text_IO file");
-         end;
-         if TC_OK then
-             Check (F);
-             Ada.Wide_Text_Io.Delete (F);
-         end if;
-     end;
- 
-     declare
-         TC_OK : Boolean := False;
-         F : Stream_Io.File_Type;
-     begin
-         begin
-             Stream_Io.Create (F, Name => Legal_File_Name (X => 3));
-             TC_OK := True;
-         exception
-             when others =>
-                 Not_Applicable ("Unable to create Out mode Stream_IO file");
-         end;
-         if TC_OK then
-             Check (F);
-             Stream_Io.Delete (F);
-         end if;
-     end;
- 
-     Result;
- end CXAA019;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxab001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxab001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxab001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxab001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,272 ****
- -- CXAB001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the operations defined in package Wide_Text_IO allow for 
- --      the input/output of Wide_Character and Wide_String data.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to exercise the components of the Wide_Text_IO
- --      package, including the Put/Get utilities for Wide_Characters and
- --      Wide_String objects.
- --      The test utilizes the Put and Get procedures defined for
- --      Wide_Characters, as well as the Put, Get, Put_Line, and Get_Line
- --      procedures defined for Wide_Strings.  In addition, many of the 
- --      additional subprograms found in package Wide_Text_IO are used in this
- --      test.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations capable of supporting
- --      external Wide_Text_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      26 Feb 97   CTA.PWB Allowed for non-support of some IO operations.
- --!
- 
- with Ada.Wide_Text_IO;
- with Report;
- 
- procedure CXAB001 is
- 
-    Filter_File     : Ada.Wide_Text_IO.File_Type;
-    Filter_Filename : constant String :=
-                               Report.Legal_File_Name ( Nam => "CXAB001" );
-    Incomplete : exception;
- 
- 
- begin
- 
-    Report.Test ("CXAB001", "Check that the operations defined in package " &
-                            "Wide_Text_IO allow for the input/output of "   &
-                            "Wide_Character and Wide_String data");
- 
- 
-    Test_for_Wide_Text_IO_Support:
-    begin
- 
-       -- An implementation that does not support Wide_Text_IO in a particular
-       -- environment will raise Use_Error on calls to various
-       -- Wide_Text_IO operations.  This block statement encloses a call to
-       -- Create, which should raise an exception in a non-supportive 
-       -- environment.  This exception will be handled to produce a
-       -- Not_Applicable result.
- 
-       Ada.Wide_Text_IO.Create (File => Filter_File,                 -- Create.
-                                Mode => Ada.Wide_Text_IO.Out_File,
-                                Name => Filter_Filename);
- 
-    exception
- 
-        when Ada.Wide_Text_IO.Use_Error | Ada.Wide_Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Wide_Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_Wide_Text_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       First_String  : constant Wide_String := "Somewhere ";
-       Second_String : constant Wide_String := "Over The ";
-       Third_String  : constant Wide_String := "Rainbow";
-       Current_Char  : Wide_Character       := ' ';
- 
-    begin
- 
-       Enter_Data_In_File:
-       declare
-          Pos                 : Natural := 1;
-          Bad_Character_Found : Boolean := False;
-       begin
-          -- Use the Put procedure defined for Wide_Character data to 
-          -- write all of the wide characters of the First_String into 
-          -- the file individually, followed by a call to New_Line.
- 
-          while Pos <= First_String'Length loop
-             Ada.Wide_Text_IO.Put (Filter_File, First_String (Pos));  -- Put.
-             Pos := Pos + 1;
-          end loop;
-          Ada.Wide_Text_IO.New_Line (Filter_File);               -- New_Line.
- 
-          -- Reset to In_File mode and read file contents, using the Get
-          -- procedure defined for Wide_Character data.
-          Reset1:
-          begin
-             Ada.Wide_Text_IO.Reset (Filter_File,                      -- Reset.
-                                     Ada.Wide_Text_IO.In_File);   
-          exception
-             when Ada.Wide_Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Wide_Text_IO" );
-                raise Incomplete;
-          end Reset1;
-                                       
-          Pos := 1;
-          while Pos <= First_String'Length loop
-             Ada.Wide_Text_IO.Get (Filter_File, Current_Char);        -- Get.
-             -- Verify the wide character against the original string.
-             if Current_Char /= First_String(Pos) then
-                Bad_Character_Found := True;
-             end if;
-             Pos := Pos + 1;
-          end loop;
- 
-          if Bad_Character_Found then
-             Report.Failed ("Incorrect Wide_Character read from file - 1");
-          end if;
- 
-             -- Following user file/string processing, the Wide_String data 
-             -- of the Second_String and Third_String Wide_String objects are 
-             -- appended to the file.
-             -- The Put procedure defined for Wide_String data is used to 
-             -- transfer the Second_String, followed by a call to New_Line.  
-             -- The Put_Line procedure defined for Wide_String data is used 
-             -- to transfer the Third_String.
-          Reset2:
-          begin
-             Ada.Wide_Text_IO.Reset    (Filter_File,                   -- Reset.
-                                        Ada.Wide_Text_IO.Append_File);
- 
-          exception
-             when Ada.Wide_Text_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to Append_File not supported for Wide_Text_IO" );
-                raise Incomplete;
-          end Reset2;
- 
-          Ada.Wide_Text_IO.Put      (Filter_File, Second_String);     -- Put.
-          Ada.Wide_Text_IO.New_Line (Filter_File);               -- New_Line.
- 
-          Ada.Wide_Text_IO.Put_Line (Filter_File, Third_String); -- Put_Line.
-          Ada.Wide_Text_IO.Close    (Filter_File);               -- Close.
- 
-       exception
- 
-          when Incomplete =>
-            raise; 
- 
-          when others => 
-             Report.Failed ("Exception in Enter_Data_In_File block");
-             raise;
-  
-       end Enter_Data_In_File;
- 
-          ---
- 
-       Filter_Block:
-       declare
- 
-          Pos          : Positive := 1;
-          TC_String2   : Wide_String (1..Second_String'Length);
-          TC_String3   : Wide_String (1..Third_String'Length);
-          Last         : Natural  := Natural'First;
- 
-       begin
- 
-          Ada.Wide_Text_IO.Open (Filter_File,                       -- Open.
-                                 Ada.Wide_Text_IO.In_File,
-                                 Filter_Filename);
- 
- 
-          -- Read the data of the First_String from the file, using the
-          -- Get procedure defined for Wide_Character data.
-          -- Verify that the character corresponds to the data originally
-          -- written to the file.
- 
-          while Pos <= First_String'Length loop
-             Ada.Wide_Text_IO.Get (Filter_File, Current_Char);       -- Get.
-             if Current_Char /= First_String(Pos) then
-                Report.Failed 
-                  ("Incorrect Wide_Character read from file - 2");
-             end if;
-             Pos := Pos + 1;
-          end loop;
-           
-          -- The first line of the file has been read, move to the second.
-          Ada.Wide_Text_IO.Skip_Line (Filter_File);             -- Skip_Line.
- 
-          -- Read the Wide_String data from the second and third lines of
-          -- the file.
-          Ada.Wide_Text_IO.Get       (Filter_File, TC_String2); -- Get.
-          Ada.Wide_Text_IO.Skip_Line (Filter_File);             -- Skip_Line.
-          Ada.Wide_Text_IO.Get_Line  (Filter_File,              -- Get_Line.
-                                      TC_String3, Last);        
- 
-          -- Verify data of second and third strings.
-          if TC_String2 /= Second_String then
-             Report.Failed ("Incorrect Wide_String read from file - 1");
-          end if;
-          if TC_String3 /= Third_String then
-             Report.Failed ("Incorrect Wide_String read from file - 2");
-          end if;
- 
-          -- The file should now be at EOF.                 
-          if not Ada.Wide_Text_IO.End_Of_File (Filter_File) then      -- EOF.
-             Report.Failed ("File not empty following filtering");
-          end if;
- 
-       exception
-          when others => 
-             Report.Failed ("Exception in Filter_Block");
-             raise;
-       end Filter_Block;
- 
-    exception
- 
-       when Incomplete =>
-          raise; 
-       when others => 
-          Report.Failed ("Exception raised in Operational Test Block");
-       
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       if Ada.Wide_Text_IO.Is_Open (Filter_File) then            -- Is_Open.
-          Ada.Wide_Text_IO.Delete (Filter_File);                 -- Delete.
-       else
-          Ada.Wide_Text_IO.Open (Filter_File,                    -- Open.
-                                 Ada.Wide_Text_IO.Out_File, 
-                                 Filter_Filename);
-          Ada.Wide_Text_IO.Delete (Filter_File);                 -- Delete.
-       end if;
-    exception
-       when others =>
-          Report.Failed ("Delete not properly implemented for Wide_Text_IO");
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAB001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,292 ****
- -- CXAC001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the attribute T'Write will, for any specific non-limited
- --      type T, write an item of the subtype to the stream.
- --
- --      Check that the attribute T'Read will, for a specific non-limited
- --      type T, read a value of the subtype from the stream.
- --
- -- TEST DESCRIPTION:
- --      The scenario depicted in this test is that of an environment where 
- --      product data is stored in stream form, then reconstructed into the
- --      appropriate data structures.  Several records of product information
- --      are stored in an array; the array is passed as a parameter to a 
- --      procedure for storage in the stream.  A header is created based on the
- --      number of data records stored in the array.  The header is then written
- --      to the stream, followed by each record maintained in the array.
- --      In order to retrieve data from the stream, the header information is
- --      read from the stream, and the data stored in the header is used to 
- --      perform the appropriate number of read operations of record data from
- --      the stream.  All data read from the stream is validated against the
- ---     values that were written to the stream.
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all systems capable of supporting IO operations on 
- --      external Stream_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      08 Nov 95   SAIC    Corrected call to Read in Procedure Retrieve_Data
- --                          for ACVC 2.0.1.
- --      27 Feb 08   PWB.CTA Allowed for non-support of certain IO operations.
- --!
- 
- with Ada.Streams.Stream_IO;
- with Report;
- 
- procedure CXAC001 is
- 
-    package Strm_Pack renames Ada.Streams.Stream_IO;
-    The_File     : Strm_Pack.File_Type;
-    The_Filename : constant String :=
-                      Report.Legal_File_Name ( Nam => "CXAC001" );
-    Incomplete : exception;
- 
- 
- begin 
- 
-    Report.Test ("CXAC001", "Check that the 'Read and 'Write attributes " &
-                            "will transfer an object of a specific, "     &
-                            "non-limited type to/from a stream");
- 
-    Test_for_Stream_IO_Support:
-    begin
- 
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on 
-       -- calls to various Stream_IO operations.  This block statement 
-       -- encloses a call to Create, which should produce an exception in a 
-       -- non-supportive environment.  These exceptions will be handled to 
-       -- produce a Not_Applicable result.
- 
-       Strm_Pack.Create (The_File, Strm_Pack.Out_File, The_Filename);
- 
-    exception
- 
-        when Ada.Streams.Stream_IO.Use_Error | 
-             Ada.Streams.Stream_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Stream_IO" );
-           raise Incomplete;
- 
-    end Test_for_Stream_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       The_Stream : Strm_Pack.Stream_Access;
-       Todays_Date : String (1 .. 6) := "271193";
- 
-       type ID_Type   is range 1 .. 100;
-       type Size_Type is (Small, Medium, Large, XLarge);
- 
-       type Header_Type is record
-          Number_of_Elements : Natural := 0;
-          Origination_Date   : String (1 .. 6);
-       end record;
- 
-       type Data_Type is record
-          ID   : ID_Type;
-          Size : Size_Type;
-       end record;
- 
-       type Data_Array_Type is array (Positive range <>) of Data_Type;
- 
-       Product_Information_1 : Data_Array_Type (1 .. 3) := ((20, Large),
-                                                            (55, Small),
-                                                            (89, XLarge));
- 
-       Product_Information_2 : Data_Array_Type (1 .. 4) := (( 5, XLarge),
-                                                            (27, Small),
-                                                            (79, Medium),
-                                                            (93, XLarge));
- 
-       procedure Store_Data ( The_Stream : in Strm_Pack.Stream_Access;
-                              The_Array  : in Data_Array_Type ) is
-          Header     : Header_Type;
-       begin
- 
-          -- Fill in header info.
-          Header.Number_of_Elements := The_Array'Length;
-          Header.Origination_Date := Todays_Date;       
- 
-          -- Write header to stream.
-          Header_Type'Write (The_Stream, Header);   
-                                                       
-          -- Write each record in the array to the stream.
-          for I in 1 .. Header.Number_of_Elements loop
-            Data_Type'Write (The_Stream, The_Array (I));
-          end loop;                                     
- 
-       end Store_Data;
- 
-       procedure Retrieve_Data (The_Stream : in     Strm_Pack.Stream_Access;
-                                The_Header :    out Header_Type;
-                                The_Array  :    out Data_Array_Type ) is
-       begin
- 
-          -- Read header from the stream.
-          Header_Type'Read (The_Stream, The_Header);  
-                                                    
-          -- Read the records from the stream into the array.
-          for I in 1 .. The_Header.Number_of_Elements loop    
-             Data_Type'Read (The_Stream, The_Array (I));  
-          end loop;                                       
- 
-       end Retrieve_Data;
- 
-    begin
- 
-       -- Assign access value.
-       The_Stream := Strm_Pack.Stream (The_File);      
- 
-       -- Product information is to be stored in the stream file.  These
-       -- data arrays are of different sizes (actually, the records
-       -- are stored individually, not as a single array).  Prior to the
-       -- record data being written, a header record is initialized with
-       -- information about the data to be written, then itself is written
-       -- to the stream.
- 
-       Store_Data (The_Stream, Product_Information_1);
-       Store_Data (The_Stream, Product_Information_2);
- 
-       Test_Verification_Block:
-       declare
-          Product_Header_1 : Header_Type;
-          Product_Header_2 : Header_Type;
-          Product_Array_1  : Data_Array_Type (1 .. 3);
-          Product_Array_2  : Data_Array_Type (1 .. 4);
-       begin
- 
-          Reset1:
-          begin
-             Strm_Pack.Reset (The_File, Strm_Pack.In_File);
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Stream_IO" );
-                raise Incomplete;
-          end Reset1;
- 
-          -- Data is read from the stream, first the appropriate header, 
-          -- then the associated data records, which are then reconstructed
-          -- into a data array of product information.
- 
-          Retrieve_Data (The_Stream, Product_Header_1, Product_Array_1);
- 
-          -- Validate a field in the header.
-          if (Product_Header_1.Origination_Date   /= Todays_Date) or
-             (Product_Header_1.Number_of_Elements /= 3)    
-          then
-             Report.Failed ("Incorrect Header_1 info read from stream");
-          end if;
- 
-          -- Validate the data records read from the file.
-          for I in 1 .. Product_Header_1.Number_of_Elements loop
-             if (Product_Array_1(I) /= Product_Information_1(I)) then
-                Report.Failed ("Incorrect Product 1 info read from" &
-                               " record: " & Integer'Image (I));
-             end if;
-          end loop;
- 
-          -- Repeat this read and verify operation for the next parcel of
-          -- data.  Again, header and data record information are read from
-          -- the same stream file.  
-          Retrieve_Data (The_Stream, Product_Header_2, Product_Array_2);
- 
-          if (Product_Header_2.Origination_Date   /= Todays_Date) or
-             (Product_Header_2.Number_of_Elements /= 4)    
-          then 
-             Report.Failed ("Incorrect Header_2 info read from stream");
-          end if;
- 
-          for I in 1 .. Product_Header_2.Number_of_Elements loop
-             if (Product_Array_2(I) /= Product_Information_2(I)) then
-                Report.Failed ("Incorrect Product_2 info read from" &
-                               " record: " & Integer'Image (I));
-             end if;
-          end loop;
- 
-       exception
- 
-          when Incomplete =>
-             raise; 
- 
-          when Strm_Pack.End_Error =>           -- If correct number of 
-                                                -- items not in file (data 
-                                                -- overwritten), then fail.
-             Report.Failed ("Incorrect number of record elements in file");
-             if not Strm_Pack.Is_Open (The_File) then
-                Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename);
-             end if;
- 
-          when others => 
-             Report.Failed ("Exception raised in Data Verification Block");
-             if not Strm_Pack.Is_Open (The_File) then
-                Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename);
-             end if;
- 
-       end Test_Verification_Block;
- 
-    exception
- 
-       when Incomplete =>
-          raise; 
- 
-       when others => 
-          Report.Failed ("Exception raised in Operational Test Block");
- 
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       -- Delete the file.
-       if Strm_Pack.Is_Open (The_File) then
-          Strm_Pack.Delete (The_File);
-       else
-          Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename);
-          Strm_Pack.Delete (The_File);
-       end if;
- 
-    exception
- 
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Stream_IO" );
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAC001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,426 ****
- -- CXAC002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in package Ada.Streams.Stream_IO
- --      are accessible, and that they provide the appropriate functionality.
- --
- -- TEST DESCRIPTION:
- --      This test simulates a user filter designed to capitalize the
- --      characters of a string.  It utilizes a variety of the subprograms
- --      contained in the package Ada.Streams.Stream_IO.
- --      Its purpose is to demonstrate the use of a variety of the capabilities
- --      found in the Ada.Streams.Stream_IO package.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations capable of supporting
- --      external Stream_IO files.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      14 Nov 95   SAIC    Corrected visibility problems; corrected
- --                          subtest validating result from function Name
- --                          for ACVC 2.0.1.
- --      05 Oct 96   SAIC    Removed calls to Close/Open in test and replaced
- --                          them with a single call to Reset (per AI95-0001)
- --      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
- --      09 Feb 01   RLB     Corrected non-support check to avoid unintended
- --                          failures.
- --!
- 
- package CXAC002_0 is
- 
-    -- This function searches for the first instance of a specified substring
-    -- within a specified string, returning boolean result. (Case insensitive
-    -- analysis)
- 
-    function Find (Str : in String; Sub : in String) return Boolean;
- 
- end CXAC002_0;
- 
- package body CXAC002_0 is
- 
-    function Find (Str : in String; Sub : in String) return Boolean is
- 
-       New_Str : String(Str'First..Str'Last);
-       New_Sub : String(Sub'First..Sub'Last);
-       Pos     : Integer := Str'First;             -- Character index.
- 
-       function Upper_Case (Str : in String) return String is
-          subtype Upper is Character range 'A'..'Z';
-          subtype Lower is Character range 'a'..'z';
-          Ret : String(Str'First..Str'Last);
-          Pos : Integer;
-       begin
-          for I in Str'Range loop
-             if (Str(I) in Lower) then
-                Pos := Upper'Pos(Upper'First) +
-                       (Lower'Pos(Str(I)) - Lower'Pos(Lower'First));
-                Ret(I) := Upper'Val(Pos);
-             else
-                Ret(I) := Str (I);
-             end if;
-          end loop;
-          return Ret;
-       end Upper_Case;
- 
-    begin
- 
-       New_Str := Upper_Case(Str);             -- Convert Str and Sub to upper
-       New_Sub := Upper_Case(Sub);             -- case for comparison.
- 
-       while (Pos <= New_Str'Last-New_Sub'Length+1)     -- Search until no more
-         and then                                       -- sub-string-length
-         (New_Str(Pos..Pos+New_Sub'Length-1) /= New_Sub) -- slices remain.
-       loop
-          Pos := Pos + 1;
-       end loop;
- 
-       if (Pos > New_Str'Last-New_Sub'Length+1) then  -- Substring not found.
-          return False;
-       else
-          return True;
-       end if;
- 
-    end Find;
- 
- end CXAC002_0;
- 
- 
- with Ada.Streams.Stream_IO, CXAC002_0, Report;
- procedure CXAC002 is
-    Filter_File     : Ada.Streams.Stream_IO.File_Type;
-    Filter_Stream   : Ada.Streams.Stream_IO.Stream_Access;
-    Filter_Filename : constant String :=
-                               Report.Legal_File_Name ( Nam => "CXAC002" );
-    Incomplete : Exception;
- 
- begin
- 
-    Report.Test ("CXAC002", "Check that the subprograms defined in "         &
-                            "package Ada.Streams.Stream_IO are accessible, " &
-                            "and that they provide the appropriate "         &
-                            "functionality");
- 
-    Test_for_Stream_IO_Support:
- 
-    begin
- 
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on
-       -- calls to various Stream_IO operations.  This block statement
-       -- encloses a call to Create, which should produce an exception in a
-       -- non-supportive environment.  These exceptions will be handled to
-       -- produce a Not_Applicable result.
- 
-       Ada.Streams.Stream_IO.Create (Filter_File,                    -- Create.
-                                     Ada.Streams.Stream_IO.Out_File,
-                                     Filter_Filename);
-    exception
- 
-        when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Stream_IO" );
-           raise Incomplete;
- 
-    end Test_for_Stream_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       use CXAC002_0;
-       use type Ada.Streams.Stream_IO.File_Mode;
-       use type Ada.Streams.Stream_IO.Count;
- 
-       File_Size  : Ada.Streams.Stream_IO.Count :=            -- Count.
-         Ada.Streams.Stream_IO.Count'First;                   -- (0)
-       File_Index : Ada.Streams.Stream_IO.Positive_Count :=   -- Pos. Count.
-         Ada.Streams.Stream_IO.Positive_Count'First;          -- (1)
- 
-       First_String  : constant String := "this is going to be ";
-       Second_String : constant String := "the best year of your life";
-       Total_Length  : constant Natural := First_String'Length +
-                                           Second_String'Length;
-       Current_Char  : Character := ' ';
- 
-       Cap_String    : String (1..Total_Length) := (others => ' ');
- 
-       TC_Capital_String : constant String :=
-                 "THIS IS GOING TO BE THE BEST YEAR OF YOUR LIFE";
- 
-    begin
- 
-       if not Ada.Streams.Stream_IO.Is_Open (Filter_File) then   -- Is_Open
-          Report.Failed ("File not open following Create");
-       end if;
- 
-       -- Call function Find to determine if the filename (Sub) is contained
-       -- in the result of Function Name.
- 
-       if not Find(Str => Ada.Streams.Stream_IO.Name(Filter_File), -- Name.
-                   Sub => Filter_Filename)
-       then
-          Report.Failed ("Function Name provided incorrect filename");
-       end if;
-                                                                  -- Stream.
-       Filter_Stream := Ada.Streams.Stream_IO.Stream (Filter_File);
- 
-       ---
- 
-       Enter_Data_In_Stream:
-       declare
-          Pos                 : Natural := 1;
-          Bad_Character_Found : Boolean := False;
-       begin
- 
-          -- Enter data from the first string into the stream.
-          while Pos <= Natural(First_String'Length) loop
-             -- Write all characters of the First_String to the stream.
-             Character'Write (Filter_Stream, First_String (Pos));
-             Pos := Pos + 1;
-             -- Ensure data put in file on a regular basis.
-             if Pos mod 5 = 0 then
-                Ada.Streams.Stream_IO.Flush (Filter_File);         -- Flush.
-             end if;
-          end loop;
- 
-          Ada.Streams.Stream_IO.Flush (Filter_File);               -- Flush.
-          -- Reset to In_File mode and read stream contents.
-          Reset1:
-          begin
-             Ada.Streams.Stream_IO.Reset (Filter_File,                -- Reset.
-                                          Ada.Streams.Stream_IO.In_File);
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Stream_IO" );
-                raise Incomplete;
-          end Reset1;
- 
-          Pos := 1;
-          while Pos <= First_String'Length loop
-             -- Read one character from the stream.
-             Character'Read (Filter_Stream, Current_Char);         -- 'Read
-             -- Verify character against the original string.
-             if Current_Char /= First_String(Pos) then
-                Bad_Character_Found := True;
-             end if;
-             Pos := Pos + 1;
-          end loop;
- 
-          if Bad_Character_Found then
-             Report.Failed ("Incorrect character read from stream");
-          end if;
- 
-          -- Following user stream/string processing, the stream file is
-          -- appended to as follows:
- 
-          Reset2:
-          begin
-             Ada.Streams.Stream_IO.Reset (Filter_File,                -- Reset.
-                                          Ada.Streams.Stream_IO.Append_File);
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to Append_File not supported for Stream_IO" );
-                raise Incomplete;
-          end Reset2;
- 
-          if Ada.Streams.Stream_IO.Mode (Filter_File) /=           -- Mode.
-             Ada.Streams.Stream_IO.Append_File
-          then
-             Report.Failed ("Incorrect mode following Reset to Append");
-          end if;
- 
-          Pos := 1;
-          while Pos <= Natural(Second_String'Length) loop
-             -- Write all characters of the Second_String to the stream.
-             Character'Write (Filter_Stream, Second_String (Pos)); -- 'Write
-             Pos := Pos + 1;
-          end loop;
- 
-          Ada.Streams.Stream_IO.Flush (Filter_File);               -- Flush.
- 
-          -- Record file statistics.
-          File_Size  := Ada.Streams.Stream_IO.Size  (Filter_File); -- Size.
- 
-          Index_Might_Not_Be_Supported:
-          begin
-             File_Index := Ada.Streams.Stream_IO.Index (Filter_File); -- Index.
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable ( "Index not supported for Stream_IO" );
-                raise Incomplete;
-          end Index_Might_Not_Be_Supported;
- 
-       exception
-          when Incomplete =>
-             raise;
-          when others =>
-             Report.Failed ("Exception in Enter_Data_In_Stream block");
-             raise;
-       end Enter_Data_In_Stream;
- 
-       ---
- 
-       Filter_Block:
-       declare
-          Pos          : Positive := 1;
-          Full_String  : constant String := First_String & Second_String;
- 
-          function Capitalize (Char : Character) return Character is
-          begin
-             if Char /= ' ' then
-                return Character'Val( Character'Pos(Char) -
-                       (Character'Pos('a') - Character'Pos('A')));
-             else
-                return Char;
-             end if;
-          end Capitalize;
- 
-       begin
- 
-          Reset3:
-          begin
-            Ada.Streams.Stream_IO.Reset (Filter_File,                -- Reset.
-                                          Ada.Streams.Stream_IO.In_File);
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Stream_IO" );
-                raise Incomplete;
-          end Reset3;
- 
-          if Ada.Streams.Stream_IO.Mode (Filter_File) /=           -- Mode.
-             Ada.Streams.Stream_IO.In_File
-          then
-             Report.Failed ("Incorrect mode following Reset to In_File");
-          end if;
- 
-          if not Ada.Streams.Stream_IO.Is_Open (Filter_File) then -- Is_Open
-             Report.Failed ( "Reset command did not leave file open" );
-          end if;
- 
-          if Ada.Streams.Stream_IO.Size (Filter_File) /=            -- Size.
-             File_Size
-          then
-             Report.Failed ("Reset file is not correct size");
-          end if;
- 
-          if Ada.Streams.Stream_IO.Index (Filter_File) /= 1 then    -- Index.
-             -- File position should have been reset to start of file.
-             Report.Failed ("Index of file not set to 1 following Reset");
-          end if;
- 
-          while Pos <= Full_String'Length loop
-             -- Read one character from the stream.
-             Character'Read (Filter_Stream, Current_Char);          -- 'Read
-             -- Verify character against the original string.
-             if Current_Char /= Full_String(Pos) then
-                Report.Failed ("Incorrect character read from stream");
-             else
-                -- Capitalize the characters read from the stream, and
-                -- place them in a string variable.
-                Cap_String(Pos) := Capitalize (Current_Char);
-             end if;
-             Pos := Pos + 1;
-          end loop;
- 
-          -- File index should now be set to the position following the final
-          -- character in the file (the same as the index value stored at
-          -- the completion of the Enter_Data_In_Stream block).
-          if Ada.Streams.Stream_IO.Index (Filter_File) /=           -- Index.
-             File_Index
-          then
-             Report.Failed ("Incorrect file index position");
-          end if;
- 
-          -- The stream file should now be at EOF.                  -- EOF.
-          if not Ada.Streams.Stream_IO.End_Of_File (Filter_File) then
-             Report.Failed ("File not empty following filtering");
-          end if;
- 
-       exception
- 
-          when Incomplete =>
-             raise;
-          when others =>
-             Report.Failed ("Exception in Filter_Block");
-             raise;
-       end Filter_Block;
- 
-          ---
- 
-       Verification_Block:
-       begin
- 
-          -- Verify that the entire string was examined, and that the
-          -- process of capitalizing the character data was successful.
-          if Cap_String /= TC_Capital_String then
-             Report.Failed ("Incorrect Capitalization");
-          end if;
- 
-       exception
-          when others =>
-             Report.Failed ("Exception in Verification_Block");
-       end Verification_Block;
- 
- 
-    exception
- 
-          when Incomplete =>
-             raise;
-          when others =>
-             Report.Failed ("Exception raised in Operational Test Block");
- 
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       if Ada.Streams.Stream_IO.Is_Open (Filter_File) then          -- Is_Open.
-          Ada.Streams.Stream_IO.Delete (Filter_File);               -- Delete.
-       else
-          Ada.Streams.Stream_IO.Open (Filter_File,                  -- Open.
-                                      Ada.Streams.Stream_IO.Out_File,
-                                      Filter_Filename);
-          Ada.Streams.Stream_IO.Delete (Filter_File);               -- Delete.
-       end if;
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Stream_IO" );
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAC002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,376 ****
- -- CXAC003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the correct exceptions are raised when improperly
- --      manipulating stream file objects.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to focus on Stream_IO file manipulation
- --      exceptions.  Several potentially common user errors are examined in
- --      the test:
- --
- --      A Status_Error should be raised whenever an attempt is made to perform
- --      an operation on a file that is closed.
- --
- --      A Status_Error should be raised when an attempt is made to open a
- --      stream file that is currently open.
- --
- --      A Mode_Error should be raised when attempting to read from (use the
- --      'Read attribute) on an Out_File or Append_Mode file.
- --
- --      A Mode_Error should be raised when checking for End Of File on a
- --      file with mode Out_File or Append_Mode.
- --
- --      A Mode_Error should be raised when attempting to write to (use the
- --      'Output attribute) on a file with mode In_File.
- --
- --      A Name_Error should be raised when the string provided to the Name
- --      parameter of an Open operation does not allow association of an
- --      external file.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations capable of supporting
- --      external Stream_IO files.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
- --      02 Mar 01   PHL     Check that Ada.Streams.Stream_IO.Stream raises
- --                          Status_Error if the file is not open.  (DR 8652/
- --                          0056).
- --      15 Mar 01   RLB     Readied for release.
- --!
- 
- with Ada.Streams.Stream_IO;
- with Report;
- 
- procedure CXAC003 is
- 
-    Stream_File_Object  : Ada.Streams.Stream_IO.File_Type;
-    Stream_Access_Value : Ada.Streams.Stream_IO.Stream_Access;
-    Stream_Filename     : constant String :=
-                               Report.Legal_File_Name ( Nam => "CXAC003" );
-    Incomplete : exception;
- 
- begin
- 
-    Report.Test ("CXAC003", "Check that the correct exceptions are "  &
-                            "raised when improperly manipulating stream " &
-                            "file objects");
- 
-    Test_for_Stream_IO_Support:
-    begin
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on
-       -- calls to various Stream_IO operations.  This block statement
-       -- encloses a call to Create, which should produce an exception in a
-       -- non-supportive environment.  These exceptions will be handled to
-       -- produce a Not_Applicable result.
- 
-       Ada.Streams.Stream_IO.Create (Stream_File_Object,
-                                     Ada.Streams.Stream_IO.Out_File,
-                                     Stream_Filename);
- 
-    exception
- 
-        when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Stream_IO" );
-           raise Incomplete;
- 
-    end Test_for_Stream_IO_Support;
- 
-    Operational_Test_Block:
-    begin
-       -- A potentially common error in a file processing environment
-       -- is to attempt to perform an operation on a stream file that is
-       -- not currently open. Status_Error should be raised in this case.
-       Check_Status_Error:
-       begin
-          Ada.Streams.Stream_IO.Close (Stream_File_Object);
-          -- Attempt to reset a file that is closed.
-          Ada.Streams.Stream_IO.Reset (Stream_File_Object,
-                                       Ada.Streams.Stream_IO.Out_File);
-          Report.Failed ("Exception not raised on Reset of closed file");
-       exception
-          when Ada.Streams.Stream_IO.Status_Error =>
-             null;
-          when others       =>
-             Report.Failed ("Incorrect exception raised - 1");
-       end Check_Status_Error;
- 
-       -- A similar error is to use Ada.Streams.Stream_IO.Stream
-       -- to attempt to perform an operation on a stream file that is
-       -- not currently open. Status_Error should be raised in this case.
-       -- (Defect Report 8652/0046, as reflected in Technical Corrigendum 1.)
-       Check_Status_Error2:
-       begin
-          -- Ensure that the file is not open.
-          if Ada.Streams.Stream_Io.Is_Open (Stream_File_Object) then
-             Ada.Streams.Stream_Io.Close (Stream_File_Object);
-          end if;
-          Stream_Access_Value :=
-             Ada.Streams.Stream_Io.Stream (Stream_File_Object);
-          Report.Failed ("Exception not raised on Stream of closed file");
-       exception
-          when Ada.Streams.Stream_Io.Status_Error =>
-             null;
-          when others =>
-             Report.Failed ("Incorrect exception raised - 2");
-       end Check_Status_Error2;
- 
-       -- Another potentially common error in a file processing environment
-       -- is to attempt to Open a stream file that is currently open.
-       -- Status_Error should be raised in this case.
-       Check_Status_Error3:
-       begin
-          -- Ensure that the file is open.
-          if not Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then
-             Ada.Streams.Stream_IO.Open (Stream_File_Object,
-                                         Ada.Streams.Stream_IO.In_File,
-                                         Stream_Filename);
-          end if;
-          Ada.Streams.Stream_IO.Open (Stream_File_Object,
-                                      Ada.Streams.Stream_IO.In_File,
-                                      Stream_Filename);
-          Report.Failed ("Exception not raised on Open of open file");
-       exception
-          when Ada.Streams.Stream_IO.Status_Error =>
-             null;
-          when others       =>
-             Report.Failed ("Incorrect exception raised - 3");
-       end Check_Status_Error3;
- 
-       -- Another example of a potential error occurring in a file
-       -- processing environment is to attempt to use the 'Read attribute
-       -- on a stream file that is currently in Out_File or Append_File
-       -- mode. Mode_Error should be raised in both of these cases.
-       Check_Mode_Error:
-       declare
-          Int_Var : Integer := -10;
-       begin
- 
-          Reset1:
-          begin
-             Ada.Streams.Stream_IO.Reset (Stream_File_Object,
-                                          Ada.Streams.Stream_IO.Out_File);
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to Out_File not supported for Stream_IO - 1" );
-                raise Incomplete;
-          end Reset1;
- 
-          Stream_Access_Value :=
-               Ada.Streams.Stream_IO.Stream (Stream_File_Object);
-          Integer'Write (Stream_Access_Value, Int_Var);
- 
-          -- File contains an integer value, but is of mode Out_File.
-          Integer'Read (Stream_Access_Value, Int_Var);
-             Report.Failed ("Exception not raised by 'Read of Out_File");
-       exception
-          when Incomplete =>
-             raise;
-          when Ada.Streams.Stream_IO.Mode_Error =>
-             null;
-             Try_Read:
-             begin
-                Reset2:
-                begin
-                   Ada.Streams.Stream_IO.Reset
-                     (Stream_File_Object, Ada.Streams.Stream_IO.Append_File);
-                exception
-                   when Ada.Streams.Stream_IO.Use_Error =>
-                      Report.Not_Applicable
-                         ( "Reset to Append_File not supported " &
-                           "for Stream_IO - 2" );
-                      raise Incomplete;
-                end Reset2;
- 
-                Integer'Write (Stream_Access_Value, Int_Var);
-                -- Attempt read from Append_File mode file.
-                Integer'Read (Stream_Access_Value, Int_Var);
-                Report.Failed
-                   ("Exception not raised by 'Read of Append file");
-             exception
-                when Incomplete =>
-                   null;
-                when Ada.Streams.Stream_IO.Mode_Error =>
-                   null;
-                when others     =>
-                   Report.Failed ("Incorrect exception raised - 4b");
-             end Try_Read;
- 
-          when others => Report.Failed ("Incorrect exception raised - 4a");
-       end Check_Mode_Error;
- 
-       -- Another example of a this type of potential error is to attempt
-       -- to check for End Of File on a stream file that is currently in
-       -- Out_File or Append_File mode. Mode_Error should also be raised
-       -- in both of these cases.
-       Check_End_File:
-       declare
-          Test_Boolean : Boolean := False;
-       begin
-          Reset3:
-          begin
-             Ada.Streams.Stream_IO.Reset (Stream_File_Object,
-                                          Ada.Streams.Stream_IO.Out_File);
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to Out_File not supported for Stream_IO - 3" );
-                raise Incomplete;
-          end Reset3;
- 
-          Test_Boolean :=
-            Ada.Streams.Stream_IO.End_Of_File (Stream_File_Object);
-          Report.Failed ("Exception not raised by EOF on Out_File");
-       exception
-          when Incomplete =>
-             null;
-          when Ada.Streams.Stream_IO.Mode_Error =>
-             null;
-             EOF_For_Append_File:
-             begin
-                Reset4:
-                begin
-                   Ada.Streams.Stream_IO.Reset
-                     (Stream_File_Object, Ada.Streams.Stream_IO.Append_File);
-                exception
-                   when Ada.Streams.Stream_IO.Use_Error =>
-                      Report.Not_Applicable
-                         ( "Reset to Append_File not supported " &
-                           "for Stream_IO - 4" );
-                      raise Incomplete;
-                end Reset4;
- 
-                Test_Boolean :=
-                  Ada.Streams.Stream_IO.End_Of_File (Stream_File_Object);
-                Report.Failed
-                  ("Exception not raised by EOF of Append file");
-             exception
-                when Incomplete =>
-                   raise;
-                when Ada.Streams.Stream_IO.Mode_Error =>
-                   null;
-                when others     =>
-                   Report.Failed ("Incorrect exception raised - 5b");
-             end EOF_For_Append_File;
- 
-          when others => Report.Failed ("Incorrect exception raised - 5a");
-       end Check_End_File;
- 
- 
- 
-       -- In a similar situation to the above cases for attribute 'Read,
-       -- an attempt to use the 'Output attribute on a stream file that
-       -- is currently in In_File mode should result in Mode_Error being
-       -- raised.
-          Check_Output_Mode_Error:
-          begin
-             Reset5:
-             begin
-                Ada.Streams.Stream_IO.Reset (Stream_File_Object,
-                                             Ada.Streams.Stream_IO.In_File);
-          exception
-             when Ada.Streams.Stream_IO.Use_Error =>
-                Report.Not_Applicable
-                   ( "Reset to In_File not supported for Stream_IO - 6" );
-                raise Incomplete;
-          end Reset5;
- 
-          Stream_Access_Value :=
-            Ada.Streams.Stream_IO.Stream (Stream_File_Object);
-          String'Output (Stream_Access_Value, "User-Oriented String");
-          Report.Failed ("Exception not raised by 'Output to In_File");
-       exception
-          when Incomplete =>
-             null;
-          when Ada.Streams.Stream_IO.Mode_Error =>
-             null;
-          when others     =>
-             Report.Failed ("Incorrect exception raised - 6");
-       end Check_Output_Mode_Error;
- 
-       -- Any case of attempting to Open a stream file with a string for
-       -- the parameter Name that does not allow the identification of an
-       -- external file will result in the exception Name_Error being
-       -- raised.
-       Check_Illegal_File_Name:
-       begin
-          if Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then
-             Ada.Streams.Stream_IO.Close (Stream_File_Object);
-          end if;
-          -- No external file exists with this filename, allowing no
-          -- association with an internal file object, resulting in the
-          -- raising of the exception Name_Error.
-          Ada.Streams.Stream_IO.Open(File => Stream_File_Object,
-                                     Mode => Ada.Streams.Stream_IO.Out_File,
-                                     Name => Report.Legal_File_Name(2));
-          Report.Failed ("Exception not raised by bad filename on Open");
-       exception
-          when Ada.Streams.Stream_IO.Name_Error =>
-             null;
-          when others     =>
-             Report.Failed ("Incorrect exception raised - 7");
-       end Check_Illegal_File_Name;
- 
-    exception
-          when Incomplete =>
-             null;
-          when others =>
-             Report.Failed ("Unexpected exception in Operational Test Block");
- 
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       if Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then
-          Ada.Streams.Stream_IO.Delete (Stream_File_Object);
-       else
-          Ada.Streams.Stream_IO.Open (Stream_File_Object,
-                                      Ada.Streams.Stream_IO.Out_File,
-                                      Stream_Filename);
-          Ada.Streams.Stream_IO.Delete (Stream_File_Object);
-       end if;
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Stream_IO" );
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAC003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,310 ****
- -- CXAC004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the Stream_Access type and Stream function found in package
- --      Ada.Text_IO.Text_Streams allows a text file to be processed with the 
- --      functionality of streams.
- --
- -- TEST DESCRIPTION:
- --      This test verifies that the package Ada.Text_IO.Text_Streams is 
- --      available and that the functionality it contains allows a text file to
- --      be manipulated as a stream.
- --      The test defines data objects of a variety of types that can be stored
- --      in a text file.  A text file and associated text stream are then 
- --      defined, and the 'Write attribute is used to enter the individual data
- --      items into the text stream.  Once all the individual data items have 
- --      been written to the stream, the 'Output attribute is used to write 
- --      arrays of these same data objects to the stream.
- --      The text file is reset to serve as an input file, and the 'Read 
- --      attribute is used to extract the individual data items from the 
- --      stream.  These items are then verified against the data originally 
- --      written to the stream. Finally, the 'Input attribute is used to 
- --      extract the data arrays from the stream. These arrays are then 
- --      verified against the original data written to the stream.
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to implementations that support external text files.
- --       
- -- CHANGE HISTORY:
- --      06 Jul 95   SAIC    Initial prerelease version.
- --      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations;
- --                          removed requirement for support of decimal types.
- --!
- 
- with Report;
- with Ada.Text_IO;
- with Ada.Text_IO.Text_Streams;
- with Ada.Characters.Latin_1;
- with Ada.Strings.Unbounded;
- 
- procedure CXAC004 is
- 
-    Data_File     : Ada.Text_IO.File_Type;
-    Data_Filename : constant String := 
-                            Report.Legal_File_Name ( Nam => "CXAC004" );
-    Incomplete : exception;
- 
- begin
- 
-    Report.Test ("CXAC004", "Check that the Stream_Access type and Stream "   &
-                            "function found in package "                      &
-                            "Ada.Text_IO.Text_Streams allows a text file to " &
-                            "be processed with the functionality of streams");
- 
-    Test_for_IO_Support:
-    begin
- 
-       -- Check for Text_IO support in creating the data file.  If the 
-       -- implementation does not support external files, Name_Error or 
-       -- Use_Error will be raised at the point of the following call to 
-       -- Create, resulting in a Not_Applicable test result.
- 
-       Ada.Text_IO.Create(Data_File, Ada.Text_IO.Out_File, Data_Filename);
- 
-    exception
- 
-        when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Text_IO" );
-           raise Incomplete;
- 
-    end Test_for_IO_Support;
- 
-    Test_Block:
-    declare
-       use Ada.Characters.Latin_1, Ada.Strings.Unbounded;
-       TC_Items  : constant := 3;
- 
-       -- Declare types and objects that will be used as data values to be
-       -- written to and read from the text file/stream.
- 
-       type Enum_Type          is (Red, Yellow, Green, Blue, Indigo);
-       type Fixed_Type         is delta 0.125 range 0.0..255.0;
-       type Float_Type         is digits 7 range 0.0..1.0E5;
-       type Modular_Type       is mod 256;  
-       subtype Str_Type        is String(1..4);
- 
-       type Char_Array_Type    is array (1..TC_Items) of Character;
-       type Enum_Array_Type    is array (1..TC_Items) of Enum_Type;
-       type Fixed_Array_Type   is array (1..TC_Items) of Fixed_Type;
-       type Float_Array_Type   is array (1..TC_Items) of Float_Type;
-       type Int_Array_Type     is array (1..TC_Items) of Integer;
-       type Mod_Array_Type     is array (1..TC_Items) of Modular_Type;
-       type Str_Array_Type     is array (1..TC_Items) of Str_Type;
-       type Unb_Str_Array_Type is array (1..TC_Items) of Unbounded_String;
- 
-       Char_Array      : Char_Array_Type    := ('A', 'z', Yen_Sign);
-       TC_Char_Array_1,
-       TC_Char_Array_2 : Char_Array_Type    := (others => Space);
- 
-       Enum_Array      : Enum_Array_Type    := (Blue, Yellow, Indigo);
-       TC_Enum_Array_1,
-       TC_Enum_Array_2 : Enum_Array_Type    := (others => Red);
- 
-       Fix_Array       : Fixed_Array_Type   := (0.125, 123.5, 250.750);
-       TC_Fix_Array_1,
-       TC_Fix_Array_2  : Fixed_Array_Type   := (others => 0.0);
- 
-       Flt_Array       : Float_Array_Type   := (1.0, 150.0, 1500.0);
-       TC_Flt_Array_1,
-       TC_Flt_Array_2  : Float_Array_Type   := (others => 0.0);
- 
-       Int_Array       : Int_Array_Type     := (124, 2349, -24_001);
-       TC_Int_Array_1,
-       TC_Int_Array_2  : Int_Array_Type     := (others => -99);
- 
-       Mod_Array       : Mod_Array_Type     := (10, 127, 255);
-       TC_Mod_Array_1,
-       TC_Mod_Array_2  : Mod_Array_Type     := (others => 0);
- 
-       Str_Array       : Str_Array_Type     := ("abcd", "klmn", "wxyz");
-       TC_Str_Array_1,
-       TC_Str_Array_2  : Str_Array_Type     := (others => "    ");
- 
-       UStr_Array      : Unb_Str_Array_Type := 
-                                         (To_Unbounded_String("cat"),
-                                          To_Unbounded_String("testing"),
-                                          To_Unbounded_String("ACVC"));
-       TC_UStr_Array_1,
-       TC_UStr_Array_2 : Unb_Str_Array_Type := 
-                                         (others => Null_Unbounded_String);
- 
-       -- Create a stream access object pointing to the data file.
- 
-       Data_Stream : Ada.Text_IO.Text_Streams.Stream_Access := 
-                       Ada.Text_IO.Text_Streams.Stream(File => Data_File);
- 
-    begin
- 
-       -- Use the 'Write attribute to enter the three sets of data items
-       -- into the data stream.  
-       -- Note that the data will be mixed within the text file.
- 
-       for i in 1..TC_Items loop
-          Character'Write       (Data_Stream, Char_Array(i));
-          Enum_Type'Write       (Data_Stream, Enum_Array(i));
-          Fixed_Type'Write      (Data_Stream, Fix_Array(i));
-          Float_Type'Write      (Data_Stream, Flt_Array(i));
-          Integer'Write         (Data_Stream, Int_Array(i));
-          Modular_Type'Write    (Data_Stream, Mod_Array(i));
-          Str_Type'Write        (Data_Stream, Str_Array(i));
-          Unbounded_String'Write(Data_Stream, UStr_Array(i));
-       end loop;
- 
-       -- Use the 'Output attribute to enter the entire arrays of each 
-       -- type of data items into the data stream.  
-       -- Note that the array bounds will be written to the stream as part 
-       -- of the action of the 'Output attribute.
- 
-       Char_Array_Type'Output    (Data_Stream, Char_Array);
-       Enum_Array_Type'Output    (Data_Stream, Enum_Array);
-       Fixed_Array_Type'Output   (Data_Stream, Fix_Array);
-       Float_Array_Type'Output   (Data_Stream, Flt_Array);
-       Int_Array_Type'Output     (Data_Stream, Int_Array);
-       Mod_Array_Type'Output     (Data_Stream, Mod_Array);
-       Str_Array_Type'Output     (Data_Stream, Str_Array);
-       Unb_Str_Array_Type'Output (Data_Stream, UStr_Array);
- 
-       -- Reset the data file to mode In_File.  The data file will now serve
-       -- as the source of data which will be compared to the original data
-       -- written to the file above.
-       Reset1:
-       begin
-          Ada.Text_IO.Reset (File => Data_File, Mode => Ada.Text_IO.In_File);
-       exception
-          when Ada.Text_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Text_IO" );
-             raise Incomplete;
-       end Reset1;
- 
-       -- Extract and validate all the single data items from the stream.
- 
-       for i in 1..TC_Items loop
-          Character'Read        (Data_Stream, TC_Char_Array_1(i));
-          Enum_Type'Read        (Data_Stream, TC_Enum_Array_1(i));
-          Fixed_Type'Read       (Data_Stream, TC_Fix_Array_1(i));
-          Float_Type'Read       (Data_Stream, TC_Flt_Array_1(i));
-          Integer'Read          (Data_Stream, TC_Int_Array_1(i));
-          Modular_Type'Read     (Data_Stream, TC_Mod_Array_1(i));
-          Str_Type'Read         (Data_Stream, TC_Str_Array_1(i));
-          Unbounded_String'Read (Data_Stream, TC_UStr_Array_1(i));
-       end loop;
- 
-       if TC_Char_Array_1 /= Char_Array then
-          Report.Failed("Character values do not match");
-       end if;
-       if TC_Enum_Array_1 /= Enum_Array then
-          Report.Failed("Enumeration values do not match");
-       end if;
-       if TC_Fix_Array_1 /= Fix_Array then
-          Report.Failed("Fixed point values do not match");
-       end if;
-       if TC_Flt_Array_1 /= Flt_Array then
-          Report.Failed("Floating point values do not match");
-       end if;
-       if TC_Int_Array_1 /= Int_Array then
-          Report.Failed("Integer values do not match");
-       end if;
-       if TC_Mod_Array_1 /= Mod_Array then
-          Report.Failed("Modular values do not match");
-       end if;
-       if TC_Str_Array_1 /= Str_Array then
-          Report.Failed("String values do not match");
-       end if;
-       if TC_UStr_Array_1 /= UStr_Array then
-          Report.Failed("Unbounded_String values do not match");
-       end if;
- 
-       -- Extract and validate all data arrays from the data stream.
-       -- Note that the 'Input attribute denotes a function, whereas the
-       -- other stream oriented attributes in this test denote procedures.
- 
-       TC_Char_Array_2 := Char_Array_Type'Input(Data_Stream);
-       TC_Enum_Array_2 := Enum_Array_Type'Input(Data_Stream);
-       TC_Fix_Array_2  := Fixed_Array_Type'Input(Data_Stream);
-       TC_Flt_Array_2  := Float_Array_Type'Input(Data_Stream);
-       TC_Int_Array_2  := Int_Array_Type'Input(Data_Stream);
-       TC_Mod_Array_2  := Mod_Array_Type'Input(Data_Stream);
-       TC_Str_Array_2  := Str_Array_Type'Input(Data_Stream);
-       TC_UStr_Array_2 := Unb_Str_Array_Type'Input(Data_Stream);
- 
-       if TC_Char_Array_2 /= Char_Array then
-          Report.Failed("Character array values do not match");
-       end if;
-       if TC_Enum_Array_2 /= Enum_Array then
-          Report.Failed("Enumeration array values do not match");
-       end if;
-       if TC_Fix_Array_2 /= Fix_Array then
-          Report.Failed("Fixed point array values do not match");
-       end if;
-       if TC_Flt_Array_2 /= Flt_Array then
-          Report.Failed("Floating point array values do not match");
-       end if;
-       if TC_Int_Array_2 /= Int_Array then
-          Report.Failed("Integer array values do not match");
-       end if;
-       if TC_Mod_Array_2 /= Mod_Array then
-          Report.Failed("Modular array values do not match");
-       end if;
-       if TC_Str_Array_2 /= Str_Array then
-          Report.Failed("String array values do not match");
-       end if;
-       if TC_UStr_Array_2 /= UStr_Array then
-          Report.Failed("Unbounded_String array values do not match");
-       end if;
- 
-    exception
-       when Incomplete =>
-          raise;
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Deletion:
-    begin
-       -- Delete the data file.
-       if not Ada.Text_IO.Is_Open(Data_File) then
-          Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename);
-       end if;
-       Ada.Text_IO.Delete(Data_File);
- 
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Text_IO" );
- 
-    end Deletion;
- 
-    Report.Result;
- 
- exception
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXAC004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxac005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxac005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,347 ****
- -- CXAC005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
- --     rights in the software and documentation contained herein. Unlimited
- --     rights are the same as those granted by the U.S. Government for older
- --     parts of the Ada Conformity Assessment Test Suite, and are defined
- --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
- --     intends to confer upon all recipients unlimited rights equal to those
- --     held by the ACAA. These rights include rights to use, duplicate,
- --     release or disclose the released technical data and computer software
- --     in whole or in part, in any manner and for any purpose whatsoever, and
- --     to have or permit others to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --    Check that stream file positioning work as specified.  (Defect Report
- --    8652/0055).
- --
- -- CHANGE HISTORY:
- --    12 FEB 2001   PHL   Initial version.
- --    14 MAR 2001   RLB   Readied for release; fixed Not_Applicable check
- --                        to terminate test gracefully.
- --    05 MAR 2007   RLB   Updated to avoid problems with return-by-reference.
- --
- --!
- with Ada.Streams.Stream_Io;
- use Ada.Streams;
- with Ada.Exceptions;
- use Ada.Exceptions;
- with Report;
- use Report;
- procedure CXAC005 is
- 
-     Incomplete : exception;
- 
-     procedure TC_Assert (Condition : Boolean; Message : String) is
-     begin
-         if not Condition then
-             Failed (Message);
-         end if;
-     end TC_Assert;
- 
-     package Checked_Stream_Io is
- 
-         type File_Type (Max_Size : Stream_Element_Count) is limited private;
- 
-         procedure Create (File : in out File_Type;
-                           Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
-                           Name : in String := "";
-                           Form : in String := "");
- 
-         procedure Open (File : in out File_Type;
-                         Mode : in Stream_Io.File_Mode;
-                         Name : in String;
-                         Form : in String := "");
- 
-         procedure Close (File : in out File_Type);
-         procedure Delete (File : in out File_Type);
- 
-         procedure Reset (File : in out File_Type;
-                          Mode : in Stream_Io.File_Mode);
-         procedure Reset (File : in out File_Type);
- 
-         procedure Read (File : in out File_Type;
-                         Item : out Stream_Element_Array;
-                         Last : out Stream_Element_Offset;
-                         From : in Stream_Io.Positive_Count);
- 
-         procedure Read (File : in out File_Type;
-                         Item : out Stream_Element_Array;
-                         Last : out Stream_Element_Offset);
- 
-         procedure Write (File : in out File_Type;
-                          Item : in Stream_Element_Array;
-                          To : in Stream_Io.Positive_Count);
- 
-         procedure Write (File : in out File_Type;
-                          Item : in Stream_Element_Array);
- 
-         procedure Set_Index (File : in out File_Type;
-                              To : in Stream_Io.Positive_Count);
- 
-         function Index (File : in File_Type) return Stream_Io.Positive_Count;
- 
-         function Size (File : in File_Type) return Stream_Io.Count;
- 
-         procedure Set_Mode (File : in out File_Type;
-                             Mode : in Stream_Io.File_Mode);
- 
-     private
-         type File_Type (Max_Size : Stream_Element_Count) is
-             record
-                 File : Stream_Io.File_Type;
-                 Index : Stream_Io.Positive_Count;
-                 Contents :
-                    Stream_Element_Array
-                       (Stream_Element_Offset (Ident_Int (1)) .. Max_Size);
-             end record;
-     end Checked_Stream_Io;
- 
-     package body Checked_Stream_Io is
- 
-         use Stream_Io;
- 
-         procedure Create (File : in out File_Type;
-                           Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
-                           Name : in String := "";
-                           Form : in String := "") is
-         begin
-             Stream_Io.Create (File.File, Mode, Name, Form);
-             File.Index := Stream_Io.Index (File.File);
-             if Mode = Append_File then
-                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
-                         "Index /= Size + 1 -- Create - Append_File");
-             else
-                 TC_Assert (File.Index = 1, "Index /= 1 -- Create - " &
-                                            File_Mode'Image (Mode));
-             end if;
-         end Create;
- 
-         procedure Open (File : in out File_Type;
-                         Mode : in Stream_Io.File_Mode;
-                         Name : in String;
-                         Form : in String := "") is
-         begin
-             Stream_Io.Open (File.File, Mode, Name, Form);
-             File.Index := Stream_Io.Index (File.File);
-             if Mode = Append_File then
-                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
-                         "Index /= Size + 1 -- Open - Append_File");
-             else
-                 TC_Assert (File.Index = 1, "Index /= 1 -- Open - " &
-                                            File_Mode'Image (Mode));
-             end if;
-         end Open;
- 
-         procedure Close (File : in out File_Type) is
-         begin
-             Stream_Io.Close (File.File);
-         end Close;
- 
-         procedure Delete (File : in out File_Type) is
-         begin
-             Stream_Io.Delete (File.File);
-         end Delete;
- 
-         procedure Reset (File : in out File_Type;
-                          Mode : in Stream_Io.File_Mode) is
-         begin
-             Stream_Io.Reset (File.File, Mode);
-             File.Index := Stream_Io.Index (File.File);
-             if Mode = Append_File then
-                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
-                         "Index /= Size + 1 -- Reset - Append_File");
-             else
-                 TC_Assert (File.Index = 1, "Index /= 1 -- Reset - " &
-                                            File_Mode'Image (Mode));
-             end if;
-         end Reset;
- 
-         procedure Reset (File : in out File_Type) is
-         begin
-             Reset (File, Stream_Io.Mode (File.File));
-         end Reset;
- 
- 
-         procedure Read (File : in out File_Type;
-                         Item : out Stream_Element_Array;
-                         Last : out Stream_Element_Offset;
-                         From : in Stream_Io.Positive_Count) is
-         begin
-             Set_Index (File, From);
-             Read (File, Item, Last);
-         end Read;
- 
-         procedure Read (File : in out File_Type;
-                         Item : out Stream_Element_Array;
-                         Last : out Stream_Element_Offset) is
-             Index : constant Stream_Element_Offset :=
-                Stream_Element_Offset (File.Index);
-         begin
-             Stream_Io.Read (File.File, Item, Last);
-             if Last < Item'Last then
-                 TC_Assert (Item (Item'First .. Last) =
-                         File.Contents (Index .. Index + Last - Item'First),
-                         "Incorrect data read from file - 1");
-                 TC_Assert (Count (Index + Last - Item'First) =
-                         Stream_Io.Size (File.File),
-                         "Read stopped before end of file");
-                 File.Index := Count (Index + Last - Item'First) + 1;
-             else
-                 TC_Assert (Item = File.Contents (Index .. Index + Item'Length - 1),
-                         "Incorrect data read from file - 2");
-                 File.Index := File.Index + Item'Length;
-             end if;
-         end Read;
- 
-         procedure Write (File : in out File_Type;
-                          Item : in Stream_Element_Array;
-                          To : in Stream_Io.Positive_Count) is
-         begin
-             Set_Index (File, To);
-             Write (File, Item);
-         end Write;
- 
-         procedure Write (File : in out File_Type;
-                          Item : in Stream_Element_Array) is
-             Index : constant Stream_Element_Offset :=
-                Stream_Element_Offset (File.Index);
-         begin
-             Stream_Io.Write (File.File, Item);
-             File.Contents (Index .. Index + Item'Length - 1) := Item;
-             File.Index := File.Index + Item'Length;
-             TC_Assert (File.Index = Stream_Io.Index (File.File),
-                     "Write failed to move the index");
-         end Write;
- 
-         procedure Set_Index (File : in out File_Type;
-                              To : in Stream_Io.Positive_Count) is
-         begin
-             Stream_Io.Set_Index (File.File, To);
-             File.Index := Stream_Io.Index (File.File);
-             TC_Assert (File.Index = To, "Set_Index failed");
-         end Set_Index;
- 
-         function Index (File : in File_Type) return Stream_Io.Positive_Count is
-             New_Index : constant Count := Stream_Io.Index (File.File);
-         begin
-             TC_Assert (New_Index = File.Index, "Index changed unexpectedly");
-             return New_Index;
-         end Index;
- 
-         function Size (File : in File_Type) return Stream_Io.Count is
-             New_Size : constant Count := Stream_Io.Size (File.File);
-         begin
-             TC_Assert (New_Size <= Count(File.Max_Size), "File too large");
-             return New_Size;
-         end Size;
- 
-         procedure Set_Mode (File : in out File_Type;
-                             Mode : in Stream_Io.File_Mode) is
-             Old_Index : constant Count := File.Index;
-         begin
-             Stream_Io.Set_Mode (File.File, Mode);
-             File.Index := Stream_Io.Index (File.File);
-             if Mode = Append_File then
-                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
-                         "Index /= Size + 1 -- Set_Mode - Append_File");
-             else
-                 TC_Assert (File.Index = Old_Index, "Set_Mode changed the index");
-             end if;
-         end Set_Mode;
- 
-     end Checked_Stream_Io;
- 
-     package Csio renames Checked_Stream_Io;
- 
-     F : Csio.File_Type (100);
-     S : Stream_Element_Array (1 .. 10);
-     Last : Stream_Element_Offset;
- 
- begin
- 
-     Report.Test ("CXAC005",
-                  "Check that stream file positioning work as specified");
- 
-     declare
-         Name : constant String := Legal_File_Name;
-     begin
-         begin
-             Csio.Create (F, Name => Name);
-         exception
-             when others =>
-                 Not_Applicable ("Files not supported - Creation with Out_File for Stream_IO");
-                 raise Incomplete;
-         end;
- 
-         for I in Stream_Element range 1 .. 10 loop
-             Csio.Write (F, ((1 => I + 2)));
-         end loop;
-         Csio.Write (F, (1 .. 15 => 11));
-         Csio.Write (F, (1 .. 15 => 12), To => 15);
- 
-         Csio.Reset (F);
- 
-         for I in Stream_Element range 1 .. 10 loop
-             Csio.Write (F, (1 => I));
-         end loop;
-         Csio.Write (F, (1 .. 15 => 13));
-         Csio.Write (F, (1 .. 15 => 14), To => 15);
-         Csio.Write (F, (1 => 90));
- 
-         Csio.Set_Mode (F, Stream_Io.In_File);
- 
-         Csio.Read (F, S, Last);
-         Csio.Read (F, S, Last, From => 3);
-         Csio.Read (F, S, Last, From => 28);
- 
-         Csio.Set_Mode (F, Stream_Io.Append_File);
-         Csio.Write (F, (1 .. 5 => 88));
- 
-         Csio.Close (F);
- 
-         Csio.Open (F, Name => Name, Mode => Stream_Io.Append_File);
-         Csio.Write (F, (1 .. 3 => 33));
- 
-         Csio.Set_Mode (F, Stream_Io.In_File);
-         Csio.Read (F, S, Last, From => 20);
-         Csio.Read (F, S, Last);
-         Csio.Reset (F, Stream_Io.Out_File);
- 
-         Csio.Write (F, (1 .. 9 => 99));
- 
-         -- Check the contents of the entire file.
-         declare
-             S : Stream_Element_Array
-                    (1 .. Stream_Element_Offset (Csio.Size (F)));
-         begin
-             Csio.Reset (F, Stream_Io.In_File);
-             Csio.Read (F, S, Last);
-         end;
- 
-         Csio.Delete (F);
-     end;
- 
-     Report.Result;
- exception
-    when Incomplete =>
-       Report.Result;
-    when E:others     =>
-       Report.Failed ("Unexpected exception raised - " & Exception_Name (E) &
-                       " - " & Exception_Message (E));
-       Report.Result;
- 
- end CXAC005;
- 
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,291 ****
- -- CXACA01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the default attributes 'Write and 'Read work properly when 
- --      used with objects of a variety of types, including records with 
- --      default discriminants, records without default discriminants, but 
- --      which have the discriminant described in a representation clause for 
- --      the type, and arrays.
- --
- -- TEST DESCRIPTION:
- --      This test simulates a basic sales record system, using Stream_IO to
- --      allow the storage of heterogeneous data in a single stream file.
- --      
- --      Four types of data are written to the stream file for each product.
- --      First, the "header" information on the product is written.  
- --      This is an object of a discriminated (with default) record
- --      type.  This is followed by an integer object containing a count of
- --      the number of sales data records to follow.  The corresponding number
- --      of sales records follow in the stream.  These are of a record type
- --      with a discriminant without a default, but where the discriminant is
- --      included in the representation clause for the type. Finally, an 
- --      array object with statistical sales information for the product is
- --      written to the stream.
- --      
- --      Objects of both record types specified below (discriminated records
- --      with defaults, and discriminated records w/o defaults that have the
- --      discriminant included in a representation clause for the type) should 
- --      have their discriminants included in the stream when using 'Write. 
- --      Likewise, discriminants should be extracted from the stream when 
- --      using 'Read.
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all implementations that support external
- --      Stream_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FXACA00;
- with Ada.Streams.Stream_IO;
- with Report;
- 
- procedure CXACA01 is
- 
- begin
- 
-    Report.Test ("CXACA01", "Check that 'Write and 'Read work properly " &
-                            "when used with complex data types");
- 
-    Test_for_Stream_IO_Support:
-    declare
- 
-       Info_File    : Ada.Streams.Stream_IO.File_Type;
-       Info_Stream  : Ada.Streams.Stream_IO.Stream_Access;
-       The_Filename : constant String := Report.Legal_File_Name;
- 
-    begin
- 
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on 
-       -- calls to various Stream_IO operations.  This block statement 
-       -- encloses a call to Create, which should produce an exception in a 
-       -- non-supportive environment.  These exceptions will be handled to 
-       -- produce a Not_Applicable result.
- 
-       Ada.Streams.Stream_IO.Create (Info_File, 
-                                     Ada.Streams.Stream_IO.Out_File,
-                                     The_Filename);
- 
-       Operational_Test_Block:
-       declare
- 
-       begin
- 
-          Info_Stream := Ada.Streams.Stream_IO.Stream (Info_File);
- 
-          -- Write all of the product information (record, integer, and array 
-          -- objects) defined in package FXACA00 into the stream.
- 
-          Store_Data_Block:
-          begin
- 
-             -- Write information about first product to the stream.
-             FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_01);
-             Integer'Write (Info_Stream, FXACA00.Sale_Count_01);
-             FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_01);
-             FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_02);
-             FXACA00.Sales_Statistics_Type'Write 
-               (Info_Stream, FXACA00.Product_01_Stats);
- 
-             -- Write information about second product to the stream.
-             -- Note: No Sales_Record_Type objects.
-             FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_02);
-             Integer'Write (Info_Stream, FXACA00.Sale_Count_02);
-             FXACA00.Sales_Statistics_Type'Write  
-               (Info_Stream, FXACA00.Product_02_Stats);
- 
-             -- Write information about third product to the stream.
-             FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_03);
-             Integer'Write (Info_Stream, FXACA00.Sale_Count_03);
-             FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_03);
-             FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_04);
-             FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_05);
-             FXACA00.Sales_Statistics_Type'Write  
-               (Info_Stream, FXACA00.Product_03_Stats);
- 
-          end Store_Data_Block;
- 
- 
-          Verify_Data_Block:
-          declare
- 
-             use FXACA00;   -- Used within this block only.
- 
-             type Domestic_Rec_Array_Type is  
-               array (Positive range <>) of Sales_Record_Type (Domestic);
- 
-             type Foreign_Rec_Array_Type is  
-               array (Positive range <>) of Sales_Record_Type (Foreign);
- 
-             TC_Rec1 : Domestic_Rec_Array_Type (1..2);
-             TC_Rec3 : Foreign_Rec_Array_Type  (1..3);
- 
-             TC_Product1 : Product_Type;
-             TC_Product2, 
-             TC_Product3 : Product_Type (Foreign);
- 
-             TC_Count1, 
-             TC_Count2, 
-             TC_Count3   : Integer := -10;  -- Initialized to dummy value.
- 
-             TC_Stat1,
-             TC_Stat2,
-             TC_Stat3    : Sales_Statistics_Type := (others => 500);
- 
-          begin
- 
-             Ada.Streams.Stream_IO.Reset (Info_File, 
-                                          Ada.Streams.Stream_IO.In_File);
- 
-             -- Read all of the data that is contained in the stream.
-             -- Compare all data with the original data in package FXACA00 
-             -- that was written to the stream.
-             -- The calls to the read attribute are in anticipated order, based
-             -- on the order of data written to the stream.  Possible errors,
-             -- such as data placement, overwriting, etc., will be manifest as 
-             -- exceptions raised by the attribute during an unsuccessful read 
-             -- attempt.
- 
-             -- Extract data on first product.
-             Product_Type'Read          (Info_Stream, TC_Product1);
-             Integer'Read               (Info_Stream, TC_Count1);
- 
-             -- Two "domestic" variant sales records will be read from the
-             -- stream.
-             for i in 1 .. TC_Count1 loop
-                Sales_Record_Type'Read     (Info_Stream, TC_Rec1(i) );
-             end loop;
- 
-             Sales_Statistics_Type'Read (Info_Stream, TC_Stat1);
- 
- 
-             -- Extract data on second product.
-             Product_Type'Read          (Info_Stream, TC_Product2);
-             Integer'Read               (Info_Stream, TC_Count2);
-             Sales_Statistics_Type'Read (Info_Stream, TC_Stat2);
- 
- 
-             -- Extract data on third product.
-             Product_Type'Read          (Info_Stream, TC_Product3);
-             Integer'Read               (Info_Stream, TC_Count3);
- 
-             -- Three "foreign" variant sales records will be read from the
-             -- stream.
-             for i in 1 .. TC_Count3 loop
-                Sales_Record_Type'Read     (Info_Stream, TC_Rec3(i) );
-             end loop;
- 
-             Sales_Statistics_Type'Read (Info_Stream, TC_Stat3);
- 
- 
-             -- After all the data has been correctly extracted, the file 
-             -- should be empty.
- 
-             if not Ada.Streams.Stream_IO.End_Of_File (Info_File) then
-                Report.Failed ("Stream file not empty");
-             end if;
- 
-             -- Verify that the data values read from the stream are the same
-             -- as those written to the stream.
- 
-             -- Verify the information of the first product.
-             if ((Product_01             /= TC_Product1)             or else
-                 (Product_01.Manufacture /= TC_Product1.Manufacture) or else
-                 (Sale_Count_01          /= TC_Count1)               or else
-                 (Sale_Rec_01            /= TC_Rec1(1))              or else
-                 (Sale_Rec_01.Buyer      /= TC_Rec1(1).Buyer)        or else
-                 (Sale_Rec_02            /= TC_Rec1(2))              or else
-                 (Sale_Rec_02.Buyer      /= TC_Rec1(2).Buyer)        or else
-                 (Product_01_Stats       /= TC_Stat1))   
-             then
-                Report.Failed ("Product 1 information incorrect");
-             end if;
- 
-             -- Verify the information of the second product.
-             if not ((Product_02       = TC_Product2) and then
-                     (Sale_Count_02    = TC_Count2)   and then
-                     (Product_02_Stats = TC_Stat2))
-             then
-                Report.Failed ("Product 2 information incorrect");
-             end if;
- 
-             -- Verify the information of the third product.
-             if ((Product_03             /= TC_Product3)             or else
-                 (Product_03.Manufacture /= TC_Product3.Manufacture) or else
-                 (Sale_Count_03          /= TC_Count3)               or else
-                 (Sale_Rec_03            /= TC_Rec3(1))              or else
-                 (Sale_Rec_03.Buyer      /= TC_Rec3(1).Buyer)        or else
-                 (Sale_Rec_04            /= TC_Rec3(2))              or else
-                 (Sale_Rec_04.Buyer      /= TC_Rec3(2).Buyer)        or else
-                 (Sale_Rec_05            /= TC_Rec3(3))              or else
-                 (Sale_Rec_05.Buyer      /= TC_Rec3(3).Buyer)        or else
-                 (Product_03_Stats       /= TC_Stat3))   
-             then
-                Report.Failed ("Product 3 information incorrect");
-             end if;
- 
-          end Verify_Data_Block;
- 
-       exception
- 
-          when others => 
-             Report.Failed ("Exception raised in Operational Test Block");
- 
-       end Operational_Test_Block;
- 
-       if Ada.Streams.Stream_IO.Is_Open (Info_File) then
-          Ada.Streams.Stream_IO.Delete (Info_File);
-       else
-          Ada.Streams.Stream_IO.Open (Info_File,
-                                      Ada.Streams.Stream_IO.In_File, 
-                                      The_Filename);
-          Ada.Streams.Stream_IO.Delete (Info_File);
-       end if;
- 
-    exception
- 
-       -- Since Use_Error or Name_Error can be raised if, for the specified
-       -- mode, the environment does not support Stream_IO operations,
-       -- the following handlers are included:
- 
-       when Ada.Streams.Stream_IO.Name_Error =>
-          Report.Not_Applicable ("Name_Error raised on Stream IO Create");
- 
-       when Ada.Streams.Stream_IO.Use_Error  =>
-          Report.Not_Applicable ("Use_Error raised on Stream IO Create");
- 
-       when others                           =>
-          Report.Failed ("Unexpected exception raised on Stream IO Create");
- 
-    end Test_for_Stream_IO_Support;
- 
-    Report.Result;
- 
- end CXACA01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,360 ****
- -- CXACA02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that user defined subprograms can override the default
- --      attributes 'Read and 'Write using attribute definition clauses.
- --      Use objects of record types. 
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates that the default implementations of the
- --      'Read and 'Write attributes can be overridden by user specified 
- --      subprograms in conjunction with attribute definition clauses.
- --      These attributes have been overridden below, and in the user defined
- --      substitutes, values are added or subtracted to global variables.
- --      The global variables are evaluated to ensure that the user defined 
- --      subprograms were used in overriding the type-related default 
- --      attributes.
- --      
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all implementations that support external
- --      Stream_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      21 Nov 95   SAIC    Corrected recursive attribute definitions 
- --                          for ACVC 2.0.1.
- --      24 Aug 96   SAIC    Corrected typo in test verification criteria.
- --
- --!
- 
- with Report;
- with Ada.Streams.Stream_IO;
- 
- procedure CXACA02 is
- begin
- 
-    Report.Test ("CXACA02", "Check that user defined subprograms can "   &
-                            "override the default attributes 'Read and " &
-                            "'Write using attribute definition clauses");
- 
-    Test_for_Stream_IO_Support:
-    declare
- 
-       Data_File      : Ada.Streams.Stream_IO.File_Type;
-       Data_Stream    : Ada.Streams.Stream_IO.Stream_Access;
-       The_Filename   : constant String := Report.Legal_File_Name;
-           
-    begin
- 
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on 
-       -- calls to various Stream_IO operations.  This block statement 
-       -- encloses a call to Create, which should produce an exception in a 
-       -- non-supportive environment.  These exceptions will be handled to 
-       -- produce a Not_Applicable result.
- 
-       Ada.Streams.Stream_IO.Create (Data_File, 
-                                     Ada.Streams.Stream_IO.Out_File,
-                                     The_Filename);
- 
-       Operational_Test_Block:
-       declare
- 
-          type Origin_Type is (Foreign, Domestic);
-          subtype String_Data_Type is String(1..8);
- 
-          type Product_Type is
-             record
-                Item        : String_Data_Type;               
-                ID          : Natural range 1..100;
-                Manufacture : Origin_Type := Domestic;
-                Distributor : String_Data_Type;
-                Importer    : String_Data_Type;
-             end record;
- 
-          type Sales_Record_Type is
-             record                                      
-                Name              : String_Data_Type;
-                Sale_Item         : Boolean := False;
-                Buyer             : Origin_Type;
-                Quantity_Discount : Boolean;
-                Cash_Discount     : Boolean;
-             end record;
- 
- 
-          -- Mode conformant, user defined subprograms that will override 
-          -- the type-related attributes.
-          -- In this test, the user defines these subprograms to add/subtract
-          -- specific values from global variables.
- 
-          procedure Product_Read
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : out Product_Type );
- 
-          procedure Product_Write
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : Product_Type );
- 
-          procedure Sales_Read
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : out Sales_Record_Type );
- 
-          procedure Sales_Write
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : Sales_Record_Type );
- 
-          -- Attribute definition clauses.
- 
-          for Product_Type'Read  use Product_Read;
-          for Product_Type'Write use Product_Write;
- 
-          for Sales_Record_Type'Read  use Sales_Read;
-          for Sales_Record_Type'Write use Sales_Write;
- 
- 
-          -- Object Declarations
- 
-          Product_01 : Product_Type := 
-            ("Product1", 1, Domestic, "Distrib1", "Import 1");
-          Product_02 : Product_Type := 
-            ("Product2", 2, Foreign,  "Distrib2", "Import 2");
- 
-          Sale_Rec_01 : Sales_Record_Type := 
-            ("Buyer 01", False, Domestic, True, True);
-          Sale_Rec_02 : Sales_Record_Type := 
-            ("Buyer 02", True,  Domestic, True, False);
-          Sale_Rec_03 : Sales_Record_Type := (Name              => "Buyer 03", 
-                                              Sale_Item         => True, 
-                                              Buyer             => Foreign,  
-                                              Quantity_Discount => False, 
-                                              Cash_Discount     => True);
-          Sale_Rec_04 : Sales_Record_Type := 
-            ("Buyer 04", True,  Foreign,  False, False);
-          Sale_Rec_05 : Sales_Record_Type := 
-            ("Buyer 05", False, Foreign,  False, False);
- 
-          TC_Read_Total  : Integer := 100;
-          TC_Write_Total : Integer :=   0;
- 
- 
-          -- Subprogram bodies.
-          -- These subprograms are designed to override the default attributes
-          -- 'Read and 'Write for the specified types.  Each adds/subtracts
-          -- a quantity to/from a program control variable, indicating its
-          -- activity.   In addition, each component of the record is
-          -- individually read from or written to the stream, using the 
-          -- appropriate 'Read or 'Write attribute for the component type.
-          -- The string components are moved to/from the stream using the
-          -- 'Input and 'Output attributes for the string subtype, so that
-          -- the bounds of the strings are also written/read.
- 
-          procedure Product_Read
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : out Product_Type ) is
-          begin
-             TC_Read_Total := TC_Read_Total - 10;
- 
-             The_Item.Item := String_Data_Type'Input(Data_Stream); -- Field 1.
-             Natural'Read(Data_Stream, The_Item.ID);               -- Field 2.
-             Origin_Type'Read(Data_Stream,                         -- Field 3.
-                              The_Item.Manufacture);        
-             The_Item.Distributor :=                               -- Field 4.
-               String_Data_Type'Input(Data_Stream);
-             The_Item.Importer    :=                               -- Field 5.  
-               String_Data_Type'Input(Data_Stream);
-          end Product_Read;
- 
- 
-          procedure Product_Write
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : Product_Type ) is
-          begin
-             TC_Write_Total := TC_Write_Total + 5;
- 
-             String_Data_Type'Output(Data_Stream, The_Item.Item);  -- Field 1.
-             Natural'Write(Data_Stream, The_Item.ID);              -- Field 2.
-             Origin_Type'Write(Data_Stream,                        -- Field 3.
-                              The_Item.Manufacture);        
-             String_Data_Type'Output(Data_Stream,                  -- Field 4.
-                                     The_Item.Distributor);
-             String_Data_Type'Output(Data_Stream,                  -- Field 5.
-                                     The_Item.Importer);
-          end Product_Write;
- 
- 
-          procedure Sales_Read
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : out Sales_Record_Type ) is
-          begin
-             TC_Read_Total := TC_Read_Total - 20;
- 
-             The_Item.Name := String_Data_Type'Input(Data_Stream);  -- Field 1.
-             Boolean'Read(Data_Stream, The_Item.Sale_Item);         -- Field 2.
-             Origin_Type'Read(Data_Stream, The_Item.Buyer);         -- Field 3.
-             Boolean'Read(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
-             Boolean'Read(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
-          end Sales_Read;
- 
- 
-          procedure Sales_Write
-            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
-              The_Item : Sales_Record_Type ) is
-          begin
-             TC_Write_Total := TC_Write_Total + 10;
- 
-             String_Data_Type'Output(Data_Stream, The_Item.Name);    -- Field 1.
-             Boolean'Write(Data_Stream, The_Item.Sale_Item);         -- Field 2.
-             Origin_Type'Write(Data_Stream, The_Item.Buyer);         -- Field 3.
-             Boolean'Write(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
-             Boolean'Write(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
-          end Sales_Write;
- 
- 
- 
-       begin
- 
-          Data_Stream := Ada.Streams.Stream_IO.Stream (Data_File);
- 
-          -- Write product and sales data to the stream.
- 
-          Product_Type'Write      (Data_Stream, Product_01);
-          Sales_Record_Type'Write (Data_Stream, Sale_Rec_01);
-          Sales_Record_Type'Write (Data_Stream, Sale_Rec_02);
- 
-          Product_Type'Write      (Data_Stream, Product_02);
-          Sales_Record_Type'Write (Data_Stream, Sale_Rec_03);
-          Sales_Record_Type'Write (Data_Stream, Sale_Rec_04);
-          Sales_Record_Type'Write (Data_Stream, Sale_Rec_05);
- 
-          -- Read data from the stream, and verify the use of the user specified
-          -- attributes.
- 
-          Verify_Data_Block:
-          declare
- 
-             TC_Product1,
-             TC_Product2 : Product_Type;
- 
-             TC_Sale1, 
-             TC_Sale2,
-             TC_Sale3,
-             TC_Sale4,
-             TC_Sale5    : Sales_Record_Type;
- 
-          begin
- 
-             -- Reset the mode of the stream file so that Read/Input
-             -- operations may be performed.
- 
-             Ada.Streams.Stream_IO.Reset (Data_File, 
-                                          Ada.Streams.Stream_IO.In_File);
- 
-             -- Data is read/reconstructed from the stream, in the order that
-             -- the data was placed into the stream.
- 
-             Product_Type'Read      (Data_Stream, TC_Product1);
-             Sales_Record_Type'Read (Data_Stream, TC_Sale1);
-             Sales_Record_Type'Read (Data_Stream, TC_Sale2);
- 
-             Product_Type'Read      (Data_Stream, TC_Product2);
-             Sales_Record_Type'Read (Data_Stream, TC_Sale3);
-             Sales_Record_Type'Read (Data_Stream, TC_Sale4);
-             Sales_Record_Type'Read (Data_Stream, TC_Sale5);
- 
-             -- Verify product data was correctly written to/read from stream.
- 
-             if TC_Product1 /= Product_01 then
-                Report.Failed ("Data verification error, Product 1");
-             end if;
-             if TC_Product2 /= Product_02 then
-                Report.Failed ("Data verification error, Product 2");
-             end if;
- 
-             if TC_Sale1 /= Sale_Rec_01 then
-                Report.Failed ("Data verification error, Sale_Rec_01");
-             end if;
-             if TC_Sale2 /= Sale_Rec_02 then
-                Report.Failed ("Data verification error, Sale_Rec_02");
-             end if;
-             if TC_Sale3 /= Sale_Rec_03 then
-                Report.Failed ("Data verification error, Sale_Rec_03");
-             end if;
-             if TC_Sale4 /= Sale_Rec_04 then
-                Report.Failed ("Data verification error, Sale_Rec_04");
-             end if;
-             if TC_Sale5 /= Sale_Rec_05 then
-                Report.Failed ("Data verification error, Sale_Rec_05");
-             end if;
- 
-             -- Verify that the user defined subprograms were used to
-             -- override the default 'Read and 'Write attributes.
-             -- There were two "product" reads and two writes; there 
-             -- were five "sale record" reads and five writes.
-             
-             if (TC_Read_Total /= -20) or (TC_Write_Total /= 60) then
-                Report.Failed ("Incorrect use of user defined attributes");
-             end if;
- 
-          end Verify_Data_Block;
- 
-       exception
- 
-          when others => 
-             Report.Failed ("Exception raised in Operational Test Block");
-       
-       end Operational_Test_Block;
- 
-       if Ada.Streams.Stream_IO.Is_Open (Data_File) then
-          Ada.Streams.Stream_IO.Delete (Data_File);
-       else
-          Ada.Streams.Stream_IO.Open (Data_File,
-                                      Ada.Streams.Stream_IO.Out_File, 
-                                      The_Filename);
-          Ada.Streams.Stream_IO.Delete (Data_File);
-       end if;
- 
- 
-    exception
- 
-       -- Since Use_Error or Name_Error can be raised if, for the specified
-       -- mode, the environment does not support Stream_IO operations,
-       -- the following handlers are included:
- 
-       when Ada.Streams.Stream_IO.Name_Error =>
-          Report.Not_Applicable ("Name_Error raised on Stream IO Create");
- 
-       when Ada.Streams.Stream_IO.Use_Error  =>
-          Report.Not_Applicable ("Use_Error raised on Stream IO Create");
- 
-       when others                           =>
-          Report.Failed ("Unexpected exception raised");
- 
-    end Test_for_Stream_IO_Support;
- 
-    Report.Result;
- 
- end CXACA02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,264 ****
- -- CXACB01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the default attributes 'Input and 'Output work properly when 
- --      used with objects of a variety of types, including two-dimensional 
- --      arrays and records without default discriminants.
- --
- -- TEST DESCRIPTION:
- --      This test simulates utility company service record storage, using 
- --      Stream_IO to allow the storage of heterogeneous data in a single 
- --      stream file.
- --      
- --      Three types of data are written to the stream file for each utility
- --      service customer.
- --      First, the general information on the customer is written.  
- --      This is an object of a discriminated (without default) record
- --      type.  This is followed by an integer object containing a count of
- --      the number of service months for the customer. Finally, a
- --      two-dimensional array object with monthly consumption information for 
- --      the customer is written to the stream.
- --      
- --      Objects of record types with discriminants without defaults should
- --      have their discriminants included in the stream when using 'Output. 
- --      Likewise, discriminants should be extracted 
- --      from the stream when using 'Input. Similarly, array bounds are written
- --      to and read from the stream when using 'Output and 'Input with array
- --      objects.
- --
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all implementations that support external
- --      Stream_IO files.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FXACB00;
- with Ada.Streams.Stream_IO;
- with Report;
- 
- procedure CXACB01 is
- begin
- 
-    Report.Test ("CXACB01", "Check that the default attributes 'Input and " &
-                            "'Output work properly when used with objects " &
-                            "of record, natural, and array types" );
- 
-    Test_for_Stream_IO_Support:
-    declare
- 
-       Util_File                : Ada.Streams.Stream_IO.File_Type;
-       Util_Stream              : Ada.Streams.Stream_IO.Stream_Access;
-       Utility_Service_Filename : constant String := Report.Legal_File_Name;
- 
-    begin
- 
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on 
-       -- calls to various Stream_IO operations.  This block statement 
-       -- encloses a call to Create, which should produce an exception in a 
-       -- non-supportive environment.  These exceptions will be handled to 
-       -- produce a Not_Applicable result.
- 
-       Ada.Streams.Stream_IO.Create (Util_File, 
-                                     Ada.Streams.Stream_IO.Out_File,
-                                     Utility_Service_Filename);
- 
-       Operational_Test_Block:
-       declare
- 
-          -- The following procedure will store all of the customer specific
-          -- information into the stream.
- 
-          procedure Store_Data_In_Stream
-            (Customer : in FXACB00.Service_Type;
-             Months   : in FXACB00.Months_In_Service_Type;
-             History  : in FXACB00.Service_History_Type) is
-          begin
-             FXACB00.Service_Type'Output           (Util_Stream, Customer);
-             FXACB00.Months_In_Service_Type'Output (Util_Stream, Months);
-             FXACB00.Service_History_Type'Output   (Util_Stream, History);
-          end Store_Data_In_Stream;
- 
- 
-          -- The following procedure will remove from the stream all of the 
-          -- customer related information.
- 
-          procedure Retrieve_Data_From_Stream
-            (Customer : out FXACB00.Service_Type;
-             Months   : out FXACB00.Months_In_Service_Type;
-             History  : out FXACB00.Service_History_Type) is
-          begin
-             Customer := FXACB00.Service_Type'Input           (Util_Stream);
-             Months   := FXACB00.Months_In_Service_Type'Input (Util_Stream);
-             History  := FXACB00.Service_History_Type'Input   (Util_Stream);
-          end Retrieve_Data_From_Stream;
- 
- 
-       begin
- 
-          Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File);
- 
-          -- Write all of the customer service information (record, numeric,
-          -- and array objects) defined in package FXACB00 into the stream.
- 
-          Data_Storage_Block:
-          begin
- 
-             Store_Data_In_Stream (Customer => FXACB00.Customer1,
-                                   Months   => FXACB00.C1_Months,
-                                   History  => FXACB00.C1_Service_History);
- 
-             Store_Data_In_Stream (FXACB00.Customer2, 
-                                   FXACB00.C2_Months, 
-                                   History  => FXACB00.C2_Service_History);
- 
-             Store_Data_In_Stream (Months   => FXACB00.C3_Months,
-                                   History  => FXACB00.C3_Service_History,
-                                   Customer => FXACB00.Customer3);
-          end Data_Storage_Block;
- 
- 
-          Data_Verification_Block:
-          declare
- 
-             TC_Residence  : FXACB00.Service_Type (FXACB00.Residence);
-             TC_Apartment  : FXACB00.Service_Type (FXACB00.Apartment);
-             TC_Commercial : FXACB00.Service_Type (FXACB00.Commercial);
- 
- 
-             TC_Months1, 
-             TC_Months2, 
-             TC_Months3    : FXACB00.Months_In_Service_Type :=
-                               FXACB00.Months_In_Service_Type'First; 
- 
- 
-             TC_History1   : 
-               FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type,
-                                             FXACB00.Month_In_Quarter_Type) :=
-               (others => (others => FXACB00.Electric_Usage_Type'Last));
- 
-             TC_History2   :
-               FXACB00.Service_History_Type 
-                 (FXACB00.Quarterly_Period_Type range 
-                    FXACB00.Spring .. FXACB00.Summer,
-                  FXACB00.Month_In_Quarter_Type) :=
-               (others => (others => FXACB00.Electric_Usage_Type'Last));
- 
-             TC_History3   :
-               FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type,
-                                             FXACB00.Month_In_Quarter_Type) :=
-               (others => (others => FXACB00.Electric_Usage_Type'Last));
- 
-          begin
- 
-             Ada.Streams.Stream_IO.Reset (Util_File, 
-                                          Ada.Streams.Stream_IO.In_File);
- 
-             -- Input all of the data that is contained in the stream.
-             -- Compare all data with the original data in package FXACB00 
-             -- that was written to the stream.
- 
-             Retrieve_Data_From_Stream (TC_Residence, TC_Months1, TC_History1);
-             Retrieve_Data_From_Stream (TC_Apartment, TC_Months2, TC_History2);
-             Retrieve_Data_From_Stream (Customer => TC_Commercial, 
-                                        Months   => TC_Months3, 
-                                        History  => TC_History3);
- 
-             -- After all the data has been correctly extracted, the file 
-             -- should be empty.
- 
-             if not Ada.Streams.Stream_IO.End_Of_File (Util_File) then
-                Report.Failed ("Stream file not empty");
-             end if;
- 
-             -- Verify that the data values read from the stream are the same
-             -- as those written to the stream.
- 
-             if ((FXACB00."/="(FXACB00.Customer1, TC_Residence)) or else
-                 (FXACB00."/="(FXACB00.Customer2, TC_Apartment)) or else
-                 (FXACB00."/="(FXACB00.Customer3, TC_Commercial)))
-             then
-                Report.Failed ("Customer information incorrect");
-             end if;
- 
-             if ((FXACB00."/="(FXACB00.C1_Months, TC_Months1)) or
-                 (FXACB00."/="(FXACB00.C2_Months, TC_Months2)) or
-                 (FXACB00."/="(FXACB00.C3_Months, TC_Months3))) 
-             then
-                Report.Failed ("Number of Months information incorrect");
-             end if;
- 
-             if not ((FXACB00."="(FXACB00.C1_Service_History, TC_History1)) and
-                     (FXACB00."="(FXACB00.C2_Service_History, TC_History2)) and 
-                     (FXACB00."="(FXACB00.C3_Service_History, TC_History3)))
-             then
-                Report.Failed ("Service history information incorrect");
-             end if;
- 
-          end Data_Verification_Block;
- 
-       exception
- 
-          when others => 
-             Report.Failed ("Exception raised in Operational Test Block");
- 
-       end Operational_Test_Block;
- 
-       -- Delete the file.
-       if Ada.Streams.Stream_IO.Is_Open (Util_File) then
-          Ada.Streams.Stream_IO.Delete (Util_File);
-       else
-          Ada.Streams.Stream_IO.Open (Util_File,
-                                      Ada.Streams.Stream_IO.Out_File, 
-                                      Utility_Service_Filename);
-          Ada.Streams.Stream_IO.Delete (Util_File);
-       end if;
- 
- 
-    exception
- 
-       -- Since Use_Error or Name_Error can be raised if, for the specified
-       -- mode, the environment does not support Stream_IO operations,
-       -- the following handlers are included:
- 
-       when Ada.Streams.Stream_IO.Name_Error =>
-          Report.Not_Applicable ("Name_Error raised on Stream IO Create");
- 
-       when Ada.Streams.Stream_IO.Use_Error  =>
-          Report.Not_Applicable ("Use_Error raised on Stream IO Create");
- 
-       when others                           =>
-          Report.Failed ("Unexpected exception raised");
- 
-    end Test_for_Stream_IO_Support;
- 
-    Report.Result;
- 
- end CXACB01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,421 ****
- -- CXACB02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that user defined subprograms can override the default
- --      attributes 'Input and 'Output using attribute definition clauses,
- --      when used with objects of discriminated record and multi-dimensional
- --      array types.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates that the default implementations of the
- --      'Input and 'Output attributes can be overridden by user specified 
- --      subprograms in conjunction with attribute definition clauses.
- --      These attributes have been overridden below, and in the user defined
- --      substitutes, values are added or subtracted to global variables.
- --      Following the completion of the writing/reading test, the global
- --      variables are evaluated to ensure that the user defined subprograms
- --      were used in overriding the type-related default attributes.
- --      
- -- APPLICABILITY CRITERIA: 
- --      Applicable to all implementations that support external
- --      Stream_IO files.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      14 Nov 95   SAIC    Corrected test errors for ACVC 2.0.1.
- --
- --!
- 
- with Report;
- with Ada.Streams.Stream_IO;
- 
- procedure CXACB02 is
- begin
- 
-    Report.Test ("CXACB02", "Check that user defined subprograms can "    &
-                            "override the default attributes 'Input and " &
-                            "'Output using attribute definition clauses");
- 
-    Test_for_Stream_IO_Support:
-    declare
- 
-       Util_File        : Ada.Streams.Stream_IO.File_Type;
-       Util_Stream      : Ada.Streams.Stream_IO.Stream_Access;
-       Utility_Filename : constant String := Report.Legal_File_Name;
- 
-    begin
- 
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on 
-       -- calls to various Stream_IO operations.  This block statement 
-       -- encloses a call to Create, which should produce an exception in a 
-       -- non-supportive environment.  These exceptions will be handled to 
-       -- produce a Not_Applicable result.
- 
-       Ada.Streams.Stream_IO.Create (Util_File, 
-                                     Ada.Streams.Stream_IO.Out_File,
-                                     Utility_Filename);
- 
-       Operational_Test_Block:
-       declare
- 
-          type    Customer_Type          is (Residence, Apartment, Commercial);
-          type    Electric_Usage_Type    is range 0..100000;
-          type    Months_In_Service_Type is range 1..12;
-          type    Quarterly_Period_Type  is (Spring, Summer, Autumn, Winter);
-          subtype Month_In_Quarter_Type  is Positive range 1..3;
-          type    Service_History_Type   is 
-            array (Quarterly_Period_Type range <>, 
-                   Month_In_Quarter_Type range <>) of Electric_Usage_Type;
- 
-          type Service_Type (Customer : Customer_Type) is
-             record
-                Name       : String (1..21);               
-                Account_ID : Natural range 0..100;
-                case Customer is
-                   when Residence | Apartment =>
-                      Low_Income_Credit : Boolean := False;
-                   when Commercial            =>
-                      Baseline_Allowance : Natural range 0..1000;
-                      Quantity_Discount  : Boolean := False;
-                end case;
-             end record;
- 
- 
-          -- Mode conformant, user defined subprograms that will override 
-          -- the type-related attributes.
-          -- In this test, the user defines these subprograms to add/subtract
-          -- specific values from global variables.
- 
-          function Service_Input 
-            (Stream : access Ada.Streams.Root_Stream_Type'Class) 
-            return Service_Type;
- 
-          procedure Service_Output 
-            (Stream : access Ada.Streams.Root_Stream_Type'Class;
-             Item   : Service_Type);
- 
-          function History_Input 
-            (Stream : access Ada.Streams.Root_Stream_Type'Class)
-            return Service_History_Type;
- 
-          procedure History_Output
-            (Stream : access Ada.Streams.Root_Stream_Type'Class;
-             Item   : Service_History_Type);
- 
- 
-          -- Attribute definition clauses.
- 
-          for Service_Type'Input  use Service_Input;
-          for Service_Type'Output use Service_Output;
- 
-          for Service_History_Type'Input  use History_Input;
-          for Service_History_Type'Output use History_Output;
- 
- 
-          -- Object Declarations
- 
-          Customer1 : Service_Type (Residence) := 
-                        (Residence, "1221 Morningstar Lane", 44, False); 
-          Customer2 : Service_Type (Apartment) := 
-                        (Customer => Apartment,
-                         Account_ID => 67,
-                         Name => "15 South Front St. #8",
-                         Low_Income_Credit => True);
-          Customer3 : Service_Type (Commercial) := 
-                        (Commercial,
-                         "12442 Central Avenue ", 
-                         100, 
-                         Baseline_Allowance => 938, 
-                         Quantity_Discount  => True);
- 
-          C1_Service_History : 
-            Service_History_Type (Quarterly_Period_Type, 
-                                  Month_In_Quarter_Type) := 
-              (Spring => (1 => 35, 2 => 39, 3 => 32),
-               Summer => (1 => 34, 2 => 33, 3 => 39),
-               Autumn => (1 => 45, 2 => 40, 3 => 38),
-               Winter => (1 => 53, 2 =>  0, 3 =>  0));
-   
-          C2_Service_History : 
-            Service_History_Type (Quarterly_Period_Type range Spring..Summer, 
-                                  Month_In_Quarter_Type) := 
-              (Spring => (23, 22, 0), Summer => (0, 0, 0));
- 
-          C3_Service_History :
-            Service_History_Type (Quarterly_Period_Type, 
-                                  Month_In_Quarter_Type) := 
-              (others => (others => 200));
- 
-    
-          TC_Input_Total  : Integer := 0;
-          TC_Output_Total : Integer := 0;
- 
- 
-          -- Subprogram bodies.
-          -- These subprograms are designed to override the default attributes
-          -- 'Input and 'Output for the specified types.  Each adds/subtracts
-          -- a quantity to/from a program control variable, indicating its
-          -- activity.  Each user defined "Input" function uses the 'Read
-          -- attribute for the type to accomplish the operation.  Likewise, 
-          -- each user defined "Output" subprogram uses the 'Write attribute 
-          -- for the type.
- 
-          function Service_Input
-            ( Stream : access Ada.Streams.Root_Stream_Type'Class )
-            return Service_Type is
-             Customer : Customer_Type;
-          begin
-             TC_Input_Total := TC_Input_Total + 1;
- 
-             -- Extract the discriminant value from the stream.
-             -- This discriminant would not otherwise be extracted from the
-             -- stream when the Service_Type'Read attribute is used below.
-             Customer_Type'Read (Stream, Customer);
- 
-             declare
-                -- Declare a constant of Service_Type, using the value just
-                -- read from the stream as the discriminant value of the
-                -- object.
-                Service : Service_Type(Customer);
-             begin
-                Service_Type'Read (Stream, Service);
-                return Service;
-             end;
-          end Service_Input;
- 
- 
-         procedure Service_Output
-            ( Stream : access Ada.Streams.Root_Stream_Type'Class;
-              Item   : Service_Type ) is
-          begin
-             TC_Output_Total := TC_Output_Total + 2;
-             -- Write the discriminant value to the stream.
-             -- The attribute 'Write (for the record type) will not write the 
-             -- discriminant of the record object to the stream.  Therefore, it
-             -- must be explicitly written using the 'Write attribute of the
-             -- discriminant type.
-             Customer_Type'Write (Stream, Item.Customer);
-             -- Write the record component values (but not the discriminant) to 
-             -- the stream.
-             Service_Type'Write (Stream, Item);
-          end Service_Output;
- 
- 
-          function History_Input
-            ( Stream : access Ada.Streams.Root_Stream_Type'Class )
-            return Service_History_Type is
-            Quarter_Bound_Low  : Quarterly_Period_Type;
-            Quarter_Bound_High : Quarterly_Period_Type;
-            Month_Bound_Low    : Month_In_Quarter_Type;
-            Month_Bound_High   : Month_In_Quarter_Type;
-          begin
-             TC_Input_Total := TC_Input_Total + 3;
- 
-             -- Read the value of the array bounds from the stream.
-             -- Use these bounds in the creation of an array object that will
-             -- be used to store data from the stream.
-             -- The array bound values would not otherwise be read from the 
-             -- stream by use of the Service_History_Type'Read attribute.
-             Quarterly_Period_Type'Read (Stream, Quarter_Bound_Low);
-             Quarterly_Period_Type'Read (Stream, Quarter_Bound_High);
-             Month_In_Quarter_Type'Read (Stream, Month_Bound_Low);
-             Month_In_Quarter_Type'Read (Stream, Month_Bound_High);
- 
-             declare
-                Service_History_Array : 
-                  Service_History_Type 
-                  (Quarterly_Period_Type range
-                     Quarter_Bound_Low..Quarter_Bound_High, 
-                   Month_In_Quarter_Type range
-                     Month_Bound_Low .. Month_Bound_High);
-             begin
-                Service_History_Type'Read (Stream, Service_History_Array);
-                return Service_History_Array;
-             end;
-          end History_Input;
- 
- 
-          procedure History_Output
-            ( Stream : access Ada.Streams.Root_Stream_Type'Class;
-              Item   : Service_History_Type ) is
-          begin
-             TC_Output_Total := TC_Output_Total + 7;
-             -- Write the upper/lower bounds of the array object dimensions to 
-             -- the stream.
-             Quarterly_Period_Type'Write (Stream, Item'First(1));
-             Quarterly_Period_Type'Write (Stream, Item'Last(1));
-             Month_In_Quarter_Type'Write (Stream, Item'First(2));
-             Month_In_Quarter_Type'Write (Stream, Item'Last(2));
-             -- Write the array values to the stream in canonical order (last
-             -- dimension varying fastest).
-             Service_History_Type'Write (Stream, Item);
-          end History_Output;
- 
- 
- 
-       begin
- 
-          Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File);
- 
-          -- Write data to the stream. A customer service record is followed 
-          -- by a service history array.
- 
-          Service_Type'Output (Util_Stream, Customer1);
-          Service_History_Type'Output (Util_Stream, C1_Service_History);
- 
-          Service_Type'Output (Util_Stream, Customer2);
-          Service_History_Type'Output (Util_Stream, C2_Service_History);
- 
-          Service_Type'Output (Util_Stream, Customer3);
-          Service_History_Type'Output (Util_Stream, C3_Service_History);
- 
- 
-          -- Read data from the stream, and verify the use of the user specified
-          -- attributes.
- 
-          Verify_Data_Block:
-          declare
- 
-             TC_Residence  : Service_Type (Residence);
-             TC_Apartment  : Service_Type (Apartment);
-             TC_Commercial : Service_Type (Commercial);
- 
-             TC_History1   : Service_History_Type (Quarterly_Period_Type, 
-                                                   Month_In_Quarter_Type) :=
-               (others => (others => Electric_Usage_Type'First));
- 
-             TC_History2   : Service_History_Type (Quarterly_Period_Type 
-                                                     range Spring .. Summer,
-                                                   Month_In_Quarter_Type) :=
-               (others => (others => Electric_Usage_Type'First));
- 
-             TC_History3   : Service_History_Type (Quarterly_Period_Type,
-                                                   Month_In_Quarter_Type) :=
-               (others => (others => Electric_Usage_Type'First));
- 
-          begin
- 
-             -- Reset Stream file to mode In_File.
- 
-             Ada.Streams.Stream_IO.Reset (Util_File, 
-                                          Ada.Streams.Stream_IO.In_File);
- 
-             -- Read data from the stream.
- 
-             TC_Residence  := Service_Type'Input (Util_Stream);
-             TC_History1   := Service_History_Type'Input (Util_Stream);
- 
-             TC_Apartment  := Service_Type'Input (Util_Stream);
-             TC_History2   := Service_History_Type'Input (Util_Stream);
- 
-             TC_Commercial := Service_Type'Input (Util_Stream);
-             TC_History3   := Service_History_Type'Input (Util_Stream);
- 
- 
-             -- Verify product data was correctly written to/read from stream,
-             -- including discriminants and array bounds.
- 
-             if (TC_Residence          /= Customer1)                   or
-                (TC_Residence.Customer /= Customer1.Customer)          or 
-                (TC_History1'Last(1)   /= C1_Service_History'Last(1))  or
-                (TC_History1'First(1)  /= C1_Service_History'First(1)) or
-                (TC_History1'Last(2)   /= C1_Service_History'Last(2))  or
-                (TC_History1'First(2)  /= C1_Service_History'First(2)) 
-             then
-                Report.Failed ("Incorrect data from stream - 1");
-             end if;
- 
-             if (TC_Apartment          /= Customer2)                   or
-                (TC_Apartment.Customer /= Customer2.Customer)          or 
-                (TC_History2           /= C2_Service_History)          or
-                (TC_History2'Last(1)   /= C2_Service_History'Last(1))  or
-                (TC_History2'First(1)  /= C2_Service_History'First(1)) or
-                (TC_History2'Last(2)   /= C2_Service_History'Last(2))  or
-                (TC_History2'First(2)  /= C2_Service_History'First(2)) 
-             then
-                Report.Failed ("Incorrect data from stream - 2");
-             end if;
- 
-             if (TC_Commercial          /= Customer3)                   or
-                (TC_Commercial.Customer /= Customer3.Customer)          or 
-                (TC_History3            /= C3_Service_History)          or
-                (TC_History3'Last(1)    /= C3_Service_History'Last(1))  or
-                (TC_History3'First(1)   /= C3_Service_History'First(1)) or
-                (TC_History3'Last(2)    /= C3_Service_History'Last(2))  or
-                (TC_History3'First(2)   /= C3_Service_History'First(2)) 
-             then
-                Report.Failed ("Incorrect data from stream - 3");
-             end if;
- 
-             -- Verify that the user defined subprograms were used to override
-             -- the default 'Input and 'Output attributes.
-             -- There were three calls on each of the user defined attributes.
-             
-             if (TC_Input_Total /= 12 ) or (TC_Output_Total /= 27 ) then
-                Report.Failed ("Incorrect use of user defined attributes");
-             end if;
- 
-          end Verify_Data_Block;
- 
-       exception
- 
-          when others => 
-             Report.Failed ("Exception raised in Operational Test Block");
- 
-       end Operational_Test_Block;
- 
-       if Ada.Streams.Stream_IO.Is_Open (Util_File) then
-          Ada.Streams.Stream_IO.Delete (Util_File);
-       else
-          Ada.Streams.Stream_IO.Open (Util_File,
-                                      Ada.Streams.Stream_IO.Out_File, 
-                                      Utility_Filename);
-          Ada.Streams.Stream_IO.Delete (Util_File);
-       end if;
- 
- 
-    exception
- 
-       -- Since Use_Error or Name_Error can be raised if, for the specified
-       -- mode, the environment does not support Stream_IO operations,
-       -- the following handlers are included:
- 
-       when Ada.Streams.Stream_IO.Name_Error =>
-          Report.Not_Applicable ("Name_Error raised on Stream IO Create");
- 
-       when Ada.Streams.Stream_IO.Use_Error  =>
-          Report.Not_Applicable ("Use_Error raised on Stream IO Create");
- 
-       when others                           =>
-          Report.Failed ("Unexpected exception raised");
- 
-    end Test_for_Stream_IO_Support;
- 
-    Report.Result;
- 
- end CXACB02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,299 ****
- -- CXACC01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the use of 'Class'Output and 'Class'Input allow stream 
- --      manipulation of objects of non-limited class-wide types.
- --
- -- TEST DESCRIPTION:
- --      This test demonstrates the uses of 'Class'Output and 'Class'Input
- --      in moving objects of a particular class to and from a stream file.
- --      A procedure uses a class-wide parameter to move objects of specific 
- --      types in the class to the stream, using the 'Class'Output attribute 
- --      of the root type of the class.  A function returns a class-wide object, 
- --      using the 'Class'Input attribute of the root type of the class to 
- --      extract the object from the stream.
- --      A field-by-field comparison of record objects is performed to validate
- --      the data read from the stream.  Operator precedence rules are used
- --      in the comparison rather than parentheses.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations capable of supporting
- --      external Stream_IO files.
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      14 Nov 95   SAIC    Corrected prefix of 'Tag attribute for ACVC 2.0.1.
- --      24 Aug 96   SAIC    Changed a call to "Create" to "Reset".
- --      26 Feb 97   CTA.PWB Allowed for non-support of some IO operations.
- --!
- 
- with FXACC00, Ada.Streams.Stream_IO, Ada.Tags, Report;
- 
- procedure CXACC01 is
- 
-    Order_File     : Ada.Streams.Stream_IO.File_Type;
-    Order_Stream   : Ada.Streams.Stream_IO.Stream_Access;
-    Order_Filename : constant String := 
-                            Report.Legal_File_Name ( Nam => "CXACC01" );
-    Incomplete : exception;
- 
- begin
- 
-    Report.Test ("CXACC01", "Check that the use of 'Class'Output "        &
-                            "and 'Class'Input allow stream manipulation " &
-                            "of objects of non-limited class-wide types");
- 
-    Test_for_Stream_IO_Support:
-    begin
- 
-       -- If an implementation does not support Stream_IO in a particular
-       -- environment, the exception Use_Error or Name_Error will be raised on 
-       -- calls to various Stream_IO operations.  This block statement 
-       -- encloses a call to Create, which should produce an exception in a 
-       -- non-supportive environment.  These exceptions will be handled to 
-       -- produce a Not_Applicable result.
- 
-       Ada.Streams.Stream_IO.Create (Order_File, 
-                                     Ada.Streams.Stream_IO.Out_File,
-                                     Order_Filename);
- 
-    exception
- 
-        when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
-           Report.Not_Applicable
-              ( "Files not supported - Create as Out_File for Stream_IO" );
-           raise Incomplete;
- 
-    end Test_for_Stream_IO_Support;
- 
-    Operational_Test_Block:
-    declare
- 
-       -- Store tag values associated with objects of tagged types.
- 
-       TC_Box_Office_Tag : constant String :=
-         Ada.Tags.External_Tag(FXACC00.Ticket_Request'Tag);
- 
-       TC_Summer_Tag     : constant String :=
-         Ada.Tags.External_Tag(FXACC00.Subscriber_Request'Tag);
- 
-       TC_Mayoral_Tag    : constant String :=
-         Ada.Tags.External_Tag(FXACC00.VIP_Request'Tag);
- 
-       TC_Late_Tag       : constant String :=
-         Ada.Tags.External_Tag(FXACC00.Last_Minute_Request'Tag);
- 
-          -- The following procedure will take an object of the Ticket_Request
-          -- class and output it to the stream.  Objects of any extended type
-          -- in the class can be output to the stream with this procedure.
- 
-       procedure Order_Entry (Order : FXACC00.Ticket_Request'Class) is
-       begin
-          FXACC00.Ticket_Request'Class'Output (Order_Stream, Order);
-       end Order_Entry;
- 
- 
-       -- The following function will retrieve from the stream an object of
-       -- the Ticket_Request class.
- 
-       function Order_Retrieval return FXACC00.Ticket_Request'Class is
-       begin
-          return FXACC00.Ticket_Request'Class'Input (Order_Stream);
-       end Order_Retrieval;
- 
-    begin
- 
-       Order_Stream := Ada.Streams.Stream_IO.Stream (Order_File);
- 
-       -- Store the data objects in the stream.
-       -- Each of the objects is of a different type within the class.
- 
-       Order_Entry (FXACC00.Box_Office_Request);     -- Object of root type
-       Order_Entry (FXACC00.Summer_Subscription);    -- Obj. of extended type
-       Order_Entry (FXACC00.Mayoral_Ticket_Request); -- Obj. of extended type
-       Order_Entry (FXACC00.Late_Request);           -- Object of twice 
-                                                     -- extended type.
- 
-       -- Reset mode of stream to In_File prior to reading data from it.
-       Reset1:
-       begin
-          Ada.Streams.Stream_IO.Reset (Order_File, 
-                                       Ada.Streams.Stream_IO.In_File);
-       exception
-          when Ada.Streams.Stream_IO.Use_Error =>
-             Report.Not_Applicable
-                ( "Reset to In_File not supported for Stream_IO - 1" );
-             raise Incomplete;
-       end Reset1;
- 
-       Process_Order_Block:
-       declare
- 
-          use FXACC00;
- 
-          -- Declare variables of the root type class,
-          -- and initialize them with class-wide objects returned from
-          -- the stream as function result.
- 
-          Order_1 : Ticket_Request'Class := Order_Retrieval;
-          Order_2 : Ticket_Request'Class := Order_Retrieval;
-          Order_3 : Ticket_Request'Class := Order_Retrieval;
-          Order_4 : Ticket_Request'Class := Order_Retrieval;
- 
-          -- Declare objects of the specific types from within the class
-          -- that correspond to the types of the data written to the
-          -- stream.  Perform a type conversion on the class-wide objects.
- 
-          Ticket_Order      : Ticket_Request := 
-                                 Ticket_Request(Order_1);
-          Subscriber_Order  : Subscriber_Request := 
-                                 Subscriber_Request(Order_2);
-          VIP_Order         : VIP_Request := 
-                                 VIP_Request(Order_3);
-          Last_Minute_Order : Last_Minute_Request := 
-                                 Last_Minute_Request(Order_4);
- 
-       begin
- 
-          -- Perform a field-by-field comparison of all the class-wide 
-          -- objects input from the stream with specific type objects
-          -- originally written to the stream.
- 
-          if Ticket_Order.Location                /= 
-             Box_Office_Request.Location          or
-             Ticket_Order.Number_Of_Tickets       /=
-             Box_Office_Request.Number_Of_Tickets 
-          then
-             Report.Failed ("Ticket_Request object validation failure");
-          end if;
- 
-          if Subscriber_Order.Location               /=
-             Summer_Subscription.Location            or
-             Subscriber_Order.Number_Of_Tickets      /=
-             Summer_Subscription.Number_Of_Tickets   or
-             Subscriber_Order.Subscription_Number    /=
-             Summer_Subscription.Subscription_Number
-          then
-             Report.Failed ("Subscriber_Request object validation failure");
-          end if;
- 
-          if VIP_Order.Location                       /=
-             Mayoral_Ticket_Request.Location          or
-             VIP_Order.Number_Of_Tickets              /=
-             Mayoral_Ticket_Request.Number_Of_Tickets or
-             VIP_Order.Rank                           /=
-             Mayoral_Ticket_Request.Rank              
-          then
-             Report.Failed ("VIP_Request object validation failure");
-          end if;
- 
-          if Last_Minute_Order.Location               /=
-             Late_Request.Location                    or
-             Last_Minute_Order.Number_Of_Tickets      /=
-             Late_Request.Number_Of_Tickets           or
-             Last_Minute_Order.Rank                   /=
-             Late_Request.Rank                        or
-             Last_Minute_Order.Special_Consideration  /=
-             Late_Request.Special_Consideration       or
-             Last_Minute_Order.Donation               /=
-             Late_Request.Donation                    
-          then
-             Report.Failed ("Last_Minute_Request object validation failure");
-          end if;
- 
-          -- Verify tag values from before and after processing.
-          -- The 'Tag attribute is used with objects of a class-wide type.
-    
-          if TC_Box_Office_Tag /= 
-             Ada.Tags.External_Tag(Order_1'Tag)
-          then
-             Report.Failed("Failed tag comparison - 1");
-          end if;
-      
-          if TC_Summer_Tag /=
-             Ada.Tags.External_Tag(Order_2'Tag)
-          then
-             Report.Failed("Failed tag comparison - 2");
-          end if;
- 
-          if TC_Mayoral_Tag /=  
-             Ada.Tags.External_Tag(Order_3'Tag)
-          then
-             Report.Failed("Failed tag comparison - 3");
-          end if;
- 
-          if TC_Late_Tag /=     
-             Ada.Tags.External_Tag(Order_4'Tag)
-          then
-             Report.Failed("Failed tag comparison - 4");
-          end if;
- 
-       end Process_Order_Block;
- 
-          -- After all the data has been correctly extracted, the file 
-          -- should be empty.
- 
-       if not Ada.Streams.Stream_IO.End_Of_File (Order_File) then
-          Report.Failed ("Stream file not empty");
-       end if;
- 
-    exception
-       when Incomplete =>
-          raise; 
-       when Constraint_Error =>
-          Report.Failed ("Constraint_Error raised in Operational Block");
-       when others => 
-          Report.Failed ("Exception raised in Operational Test Block");
-    end Operational_Test_Block;
- 
-    Deletion:
-    begin
-       if Ada.Streams.Stream_IO.Is_Open (Order_File) then
-          Ada.Streams.Stream_IO.Delete (Order_File);
-       else
-          Ada.Streams.Stream_IO.Open (Order_File,
-                                      Ada.Streams.Stream_IO.Out_File, 
-                                      Order_Filename);
-          Ada.Streams.Stream_IO.Delete (Order_File);
-       end if;
-    exception
-       when others =>
-          Report.Failed
-             ( "Delete not properly implemented for Stream_IO" );
-    end Deletion;
- 
-    Report.Result;
- 
- exception
- 
-    when Incomplete =>
-       Report.Result;
-    when others     =>
-       Report.Failed ( "Unexpected exception" );
-       Report.Result;
- 
- end CXACC01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,199 ****
- -- CXAF001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that an implementation supports the functionality defined
- --      in Package Ada.Command_Line.
- --
- -- TEST DESCRIPTION:
- --      This test verifies that an implementation supports the subprograms
- --      contained in package Ada.Command_Line.  Each of the subprograms
- --      is exercised in a general sense, to ensure that it is available,
- --      and that it provides the prescribed results in a known test 
- --      environment.  Function Argument_Count must return zero, or the 
- --      number of arguments passed to the program calling it.  Function
- --      Argument is called with a parameter value one greater than the
- --      actual number of arguments passed to the executing program, which
- --      must result in Constraint_Error being raised.  Function Command_Name
- --      should return the name of the executing program that called it
- --      (specifically, this test name).  Function Set_Exit_Status is called
- --      with two different parameter values, the constants Failure and 
- --      Success defined in package Ada.Command_Line.
- --
- --      The setting of the variable TC_Verbose allows for some additional
- --      output to be displayed during the running of the test as an aid in
- --      tracing the processing flow of the test.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to implementations that support the 
- --      declaration of package Command_Line as defined in the Ada Reference 
- --      manual. 
- --      An alternative declaration is allowed for package Command_Line if 
- --      different functionality is appropriate for the external execution
- --      environment.
- --
- --       
- -- CHANGE HISTORY:
- --      10 Jul 95   SAIC    Initial prerelease version.
- --      02 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      05 AUG 98   EDS     Allow Null string result to be returned from
- --                          Function Command
- --!
- 
- with Ada.Command_Line;
- with Ada.Exceptions;
- with Report;
- 
- procedure CXAF001 is
- begin
- 
-    Report.Test ("CXAF001", "Check that an implementation supports the " &
-                            "functionality defined in Package "          &
-                            "Ada.Command_Line");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
- 
-       type String_Access is access all String;
- 
-       TC_Verbose           : Boolean := False;
-       Number_Of_Arguments  : Natural := Natural'Last;
-       Name_Of_Command      : String_Access;
- 
-    begin
- 
-       -- Check the result of function Argument_Count.
-       -- Note: If the external environment does not support passing arguments
-       --       to the program invoking the function, the function result
-       --       will be zero.
- 
-       Number_Of_Arguments := Ada.Command_Line.Argument_Count;
-       if Number_Of_Arguments = Natural'Last then
-          Report.Failed("Argument_Count did not provide a return result");
-       end if;
-       if TC_Verbose then
-          Report.Comment
-            ("Argument_Count = " & Integer'Image(Number_Of_Arguments));
-       end if;
- 
- 
-       -- Check that the result of Function Argument is Constraint_Error
-       -- when the Number argument is outside the range of 1..Argument_Count.
- 
-       Test_Function_Argument_1 :
-       begin
-          declare
- 
-             -- Define a value that will be outside the range of 
-             -- 1..Argument_Count. 
-             -- Note: If the external execution environment does not support
-             --       passing arguments to a program, then Argument(N) for 
-             --       any N will raise Constraint_Error, since 
-             --       Argument_Count = 0;
- 
-             Arguments_Plus_One : Positive := 
-               Ada.Command_Line.Argument_Count + 1;
- 
-             -- Using the above value in a call to Argument must result in
-             -- the raising of Constraint_Error.
- 
-             Argument_String    : constant String := 
-               Ada.Command_Line.Argument(Arguments_Plus_One);
- 
-          begin
-             Report.Failed("Constraint_Error not raised by Function "  &
-                           "Argument when provided a Number argument " &
-                           "out of range");
-          end;
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-             if TC_Verbose then
-               Report.Comment ("Argument_Count raised Constraint_Error");
-             end if;
-          when others => 
-             Report.Failed ("Unexpected exception raised by Argument " &
-                            "in Test_Function_Argument_1 block");
-       end Test_Function_Argument_1;
- 
- 
-       -- Check that Function Argument returns a string result.
- 
-       Test_Function_Argument_2 :
-       begin
-          if Ada.Command_Line.Argument_Count > 0 then
-             Report.Comment
-               ("Last argument is: " &
-                Ada.Command_Line.Argument(Ada.Command_Line.Argument_Count));
-          elsif TC_Verbose then
-             Report.Comment("Argument_Count is zero, no test of Function " &
-                            "Argument for string result");
-          end if;
-       exception
-          when others => 
-             Report.Failed ("Unexpected exception raised by Argument " &
-                            "in Test_Function_Argument_2 block");
-       end Test_Function_Argument_2;
- 
- 
-       -- Check the result of Function Command_Name.
- 
-       Name_Of_Command := new String'(Ada.Command_Line.Command_Name);
- 
-       if Name_Of_Command = null  then
-          Report.Failed("Null string pointer returned from Function Command");
-       elsif Name_Of_Command.all = "" then
-          Report.Comment("Null string result returned from Function Command");
-       elsif TC_Verbose then
-          Report.Comment("Invoking command is " & Name_Of_Command.all);
-       end if;
- 
- 
-       -- Check that procedure Set_Exit_Status is available.
-       -- Note: If the external execution environment does not support
-       --       returning an exit value from a program, then Set_Exit_Status
-       --       does nothing.
-       
-       Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure);
-       if TC_Verbose then
-          Report.Comment("Exit status set to Failure");
-       end if;
- 
-       Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success);
-       if TC_Verbose then
-          Report.Comment("Exit status set to Success");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXAF001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb2001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb2001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb2001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb2001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,633 ****
- -- CXB2001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that subprograms Shift_Left, Shift_Right, 
- --      Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right are available
- --      and produce correct results for values of signed and modular
- --      integer types of 8 bits. 
- --
- -- TEST DESCRIPTION:
- --      This test uses the shift and rotate functions of package Interfaces
- --      with a modular type representative of 8 bits.  The functions
- --      are used as the right hand of assignment statements, as part of
- --      conditional statements, and as arguments in other function calls.
- --
- --      A check is performed in the test to determine whether the bit 
- --      ordering method used by the machine/implementation is high-order
- --      first ("Big Endian") or low-order first ("Little Endian").  The
- --      specific subtests use this information to evaluate the results of
- --      each of the functions under test.
- --
- --      Note: In the string associated with each Report.Failed statement, the
- --            acronym BE refers to Big Endian, LE refers to Little Endian.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that support signed
- --      and modular integer types of 8 bits.
- --
- --       
- -- CHANGE HISTORY:
- --      21 Aug 95   SAIC    Initial prerelease version.
- --      07 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --
- --!
- 
- with Report;
- with Interfaces;
- with Ada.Exceptions;
- 
- procedure CXB2001 is
- begin
- 
-    Report.Test ("CXB2001", 
-                 "Check that subprograms Shift_Left, Shift_Right, "       &
-                 "Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right " &
-                 "produce correct results for values of signed and "      &
-                 "modular integer types of 8 bits");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Interfaces;
- 
-       TC_Amount             : Natural     := Natural'First;
-       Big_Endian            : Boolean     := False;
- 
-       -- Range of type Unsigned_8 is 0..255 (0..Modulus-1).
-       TC_Val_Unsigned_8,
-       TC_Result_Unsigned_8  : Unsigned_8  := Unsigned_8'First;
- 
-    begin
- 
-       -- Determine whether the machine uses high-order first or low-order
-       -- first bit ordering.
-       -- On a high-order first machine, bit zero of a storage element is
-       -- the most significant bit (interpreting the sequence of bits that
-       -- represent a component as an unsigned integer value).  
-       -- On a low-order first machine, bit zero is the least significant.
-       -- In this check, a right shift of one place on a Big Endian machine
-       -- will yield a result of one, while on a Little Endian machine the
-       -- result would be four.
- 
-       TC_Val_Unsigned_8 := 2;
-       Big_Endian := (Shift_Right(TC_Val_Unsigned_8, 1) = 1);
- 
- 
-       -- Note: The shifting and rotating subprograms operate on a bit-by-bit
-       --       basis, using the binary representation of the value of the 
-       --       operands to yield a binary representation for the result.
- 
-       -- Function Shift_Left.
- 
-       if Big_Endian then   -- High-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
-          TC_Result_Unsigned_8 := Shift_Left(Value  => TC_Val_Unsigned_8, 
-                                             Amount => TC_Amount);
-          if TC_Result_Unsigned_8 /= 254 then
-             Report.Failed("Incorrect result from BE Shift_Left - 1");
-          end if;
- 
-          if Shift_Left(TC_Val_Unsigned_8, 2) /= 252  or
-             Shift_Left(TC_Val_Unsigned_8, 3) /= 248  or
-             Shift_Left(TC_Val_Unsigned_8, 5) /= 224  or
-             Shift_Left(TC_Val_Unsigned_8, 8) /=   0  or
-             Shift_Left(TC_Val_Unsigned_8, 9) /=   0  or
-             Shift_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from BE Shift_Left - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 1;
-          if Shift_Left(TC_Val_Unsigned_8, 1)           /=  2 or
-             Shift_Left(TC_Val_Unsigned_8, Amount => 3) /=  8 
-          then
-             Report.Failed("Incorrect result from BE Shift_Left - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 7;
-          if Shift_Left(TC_Val_Unsigned_8, Amount => 4)      /= 112  or
-             Shift_Left(Shift_Left(TC_Val_Unsigned_8, 7), 1) /=   0
-          then
-             Report.Failed("Incorrect result from BE Shift_Left - 4");
-          end if;
- 
-       else  -- Low-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
-          TC_Result_Unsigned_8 := Shift_Left(TC_Val_Unsigned_8, TC_Amount);
- 
-          if TC_Result_Unsigned_8 /= 127 then
-             Report.Failed("Incorrect result from LE Shift_Left - 1");
-          end if;
- 
-          if Shift_Left(TC_Val_Unsigned_8, 2) /=  63  or
-             Shift_Left(TC_Val_Unsigned_8, 3) /=  31  or
-             Shift_Left(TC_Val_Unsigned_8, 5) /=   7  or
-             Shift_Left(TC_Val_Unsigned_8, 8) /=   0  or
-             Shift_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from LE Shift_Left - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 1;
-          if Shift_Left(TC_Val_Unsigned_8, 1) /= 0 or
-             Shift_Left(TC_Val_Unsigned_8, 7) /= 0  
-          then
-             Report.Failed("Incorrect result from LE Shift_Left - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 129;
-          if Shift_Left(TC_Val_Unsigned_8, 4)                /= 8  or
-             Shift_Left(Shift_Left(TC_Val_Unsigned_8, 7), 1) /= 0
-          then
-             Report.Failed("Incorrect result from LE Shift_Left - 4");
-          end if;
- 
-       end if;
- 
- 
- 
-       -- Function Shift_Right.
- 
-       if Big_Endian then   -- High-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
-          TC_Result_Unsigned_8 := Shift_Right(TC_Val_Unsigned_8, TC_Amount);
- 
-          if TC_Result_Unsigned_8 /= 127 then
-             Report.Failed("Incorrect result from BE Shift_Right - 1");
-          end if;
- 
-          if Shift_Right(TC_Val_Unsigned_8, 2) /=  63  or
-             Shift_Right(TC_Val_Unsigned_8, 3) /=  31  or
-             Shift_Right(TC_Val_Unsigned_8, 5) /=   7  or
-             Shift_Right(TC_Val_Unsigned_8, 8) /=   0  or
-             Shift_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from BE Shift_Right - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 1;
-          if Shift_Right(TC_Val_Unsigned_8, 1) /= 0 or
-             Shift_Right(TC_Val_Unsigned_8, 7) /= 0  
-          then
-             Report.Failed("Incorrect result from BE Shift_Right - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 129;
-          if Shift_Right(TC_Val_Unsigned_8, 4)                 /= 8  or
-             Shift_Right(Shift_Right(TC_Val_Unsigned_8, 7), 1) /= 0
-          then
-             Report.Failed("Incorrect result from BE Shift_Right - 4");
-          end if;
- 
-       else  -- Low-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
-          TC_Result_Unsigned_8 := Shift_Right(Value  => TC_Val_Unsigned_8, 
-                                              Amount => TC_Amount);
-          if TC_Result_Unsigned_8 /= 254 then
-             Report.Failed("Incorrect result from LE Shift_Right - 1");
-          end if;
- 
-          if Shift_Right(TC_Val_Unsigned_8, 2) /= 252  or
-             Shift_Right(TC_Val_Unsigned_8, 3) /= 248  or
-             Shift_Right(TC_Val_Unsigned_8, 5) /= 224  or
-             Shift_Right(TC_Val_Unsigned_8, 8) /=   0  or
-             Shift_Right(TC_Val_Unsigned_8, 9) /=   0  or
-             Shift_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from LE Shift_Right - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 1;
-          if Shift_Right(TC_Val_Unsigned_8, 1)           /=  2 or
-             Shift_Right(TC_Val_Unsigned_8, Amount => 3) /=  8 
-          then
-             Report.Failed("Incorrect result from LE Shift_Right - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 7;
-          if Shift_Right(TC_Val_Unsigned_8, Amount => 4)       /= 112  or
-             Shift_Right(Shift_Right(TC_Val_Unsigned_8, 7), 1) /=   0
-          then
-             Report.Failed("Incorrect result from LE Shift_Right - 4");
-          end if;
- 
-       end if;
- 
- 
- 
-       -- Tests of Shift_Left and Shift_Right in combination.
- 
-       if Big_Endian then   -- High-order first bit ordering.
- 
-          TC_Val_Unsigned_8  := 32;
- 
-          if Shift_Left(Shift_Right(TC_Val_Unsigned_8, 2), 2) /= 
-             TC_Val_Unsigned_8                                       or
-             Shift_Left(Shift_Right(TC_Val_Unsigned_8, 1), 3) /= 128 or
-             Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 6) /=   2 or
-             Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 8) /=   0
-          then
-             Report.Failed("Incorrect result from BE Shift_Left - " &
-                           "Shift_Right functions used in combination");
-          end if;
- 
-       else  -- Low-order first bit ordering.
- 
-          TC_Val_Unsigned_8  := 32;
- 
-          if Shift_Left(Shift_Right(TC_Val_Unsigned_8, 2), 2) /= 
-             TC_Val_Unsigned_8                                       or
-             Shift_Left(Shift_Right(TC_Val_Unsigned_8, 1), 3) /=   8 or
-             Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 3) /=  64 or
-             Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 4) /= 128
-          then
-             Report.Failed("Incorrect result from LE Shift_Left - " &
-                           "Shift_Right functions used in combination");
-          end if;
- 
-       end if;
- 
- 
- 
-       -- Function Shift_Right_Arithmetic.
- 
-       if Big_Endian then   -- High-order first bit ordering.
- 
-          -- Case where the parameter Value is less than
-          -- one half of the modulus.  Zero bits will be shifted in.
-          -- Modulus of type Unsigned_8 is 256; half of the modulus is 128.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 127;  -- Less than one half of modulus.
-          TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
-                                                         TC_Amount);
-          if TC_Result_Unsigned_8 /= 63 then
-             Report.Failed
-               ("Incorrect result from BE Shift_Right_Arithmetic - 1");
-          end if;
- 
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /=  31  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /=  15  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /=   3  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 8) /=   0  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed
-               ("Incorrect result from BE Shift_Right_Arithmetic - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 1;
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, Amount => 1) /= 0 or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3)           /= 0  
-          then
-             Report.Failed
-               ("Incorrect result from BE Shift_Right_Arithmetic - 3");
-          end if;
- 
-          -- Case where the parameter Value is greater than or equal to
-          -- one half of the modulus.  One bits will be shifted in.
-        
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 128;  -- One half of modulus.
-          TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
-                                                         Amount => TC_Amount);
-          if TC_Result_Unsigned_8 /= 192 then
-             Report.Failed
-               ("Incorrect result from BE Shift_Right_Arithmetic - 4");
-          end if;
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 129;  -- Greater than one half of modulus.
-          TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
-                                                         Amount => TC_Amount);
-          if TC_Result_Unsigned_8 /= 192 then
-             Report.Failed
-               ("Incorrect result from BE Shift_Right_Arithmetic - 5");
-          end if;
- 
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /= 224  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /= 240  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /= 252  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 7) /= Unsigned_8'Last or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed
-               ("Incorrect result from BE Shift_Right_Arithmetic - 6");
-          end if;
- 
-          TC_Val_Unsigned_8 := Unsigned_8'Last;
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 1) /= 
-             Unsigned_8'Last 
-          then
-             Report.Failed
-               ("Incorrect result from BE Shift_Right_Arithmetic - 7");
-          end if;
- 
-       else  -- Low-order first bit ordering
- 
-          -- Case where the parameter Value is less than 
-          -- one half of the modulus.  Zero bits will be shifted in.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 127;  -- Less than one half of modulus.
-          TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
-                                                         TC_Amount);
-          if TC_Result_Unsigned_8 /= 254 then
-             Report.Failed
-               ("Incorrect result from LE Shift_Right_Arithmetic - 1");
-          end if;
- 
-          TC_Val_Unsigned_8 := 2;
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /=   8  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /=  16  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /=  64  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 8) /=   0  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed
-               ("Incorrect result from LE Shift_Right_Arithmetic - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 64;
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, Amount => 1) /= 128 or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3)           /=   0  
-          then
-             Report.Failed
-               ("Incorrect result from LE Shift_Right_Arithmetic - 3");
-          end if;
- 
-          -- Case where the parameter Value is greater than or equal to
-          -- one half of the modulus.  One bits will be shifted in.
-        
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 128;  -- One half of modulus.
-          TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
-                                                         Amount => TC_Amount);
- 
-          if TC_Result_Unsigned_8 /= 3 then
-             Report.Failed
-               ("Incorrect result from LE Shift_Right_Arithmetic - 4");
-          end if;
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 129;  -- Greater than one half of modulus.
-          TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
-                                                         Amount => TC_Amount);
- 
-          if TC_Result_Unsigned_8 /= 3 then
-             Report.Failed
-               ("Incorrect result from LE Shift_Right_Arithmetic - 5");
-          end if;
- 
-          TC_Val_Unsigned_8    := 135;  -- Greater than one half of modulus.
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /= 31  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /= 63  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /= Unsigned_8'Last or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 7) /= Unsigned_8'Last or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed
-               ("Incorrect result from LE Shift_Right_Arithmetic - 6");
-          end if;
- 
-          TC_Val_Unsigned_8 := Unsigned_8'Last;
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 1) /= 
-             Unsigned_8'Last 
-          then
-             Report.Failed
-               ("Incorrect result from LE Shift_Right_Arithmetic - 7");
-          end if;
- 
-       end if;
- 
- 
- 
-       -- Function Rotate_Left.
- 
-       if Big_Endian then  -- High-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 129;  
-          TC_Result_Unsigned_8 := Rotate_Left(Value  => TC_Val_Unsigned_8, 
-                                              Amount => TC_Amount);
-          if TC_Result_Unsigned_8 /= 3 then
-             Report.Failed("Incorrect result from BE Rotate_Left - 1");
-          end if;
- 
-          if Rotate_Left(TC_Val_Unsigned_8, 2) /=   6  or
-             Rotate_Left(TC_Val_Unsigned_8, 3) /=  12  or
-             Rotate_Left(TC_Val_Unsigned_8, 5) /=  48  or
-             Rotate_Left(TC_Val_Unsigned_8, 8) /= 129  or
-             Rotate_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from BE Rotate_Left - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 1;
-          if Rotate_Left(Value => TC_Val_Unsigned_8, Amount => 1) /= 2 or
-             Rotate_Left(TC_Val_Unsigned_8, Amount => 3)          /= 8 
-          then 
-             Report.Failed("Incorrect result from BE Rotate_Left - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 82;
-          if Rotate_Left(TC_Val_Unsigned_8, Amount => 4)       /=  37  or
-             Rotate_Left(Rotate_Left(TC_Val_Unsigned_8, 7), 1) /=  82
-          then
-             Report.Failed("Incorrect result from BE Rotate_Left - 4");
-          end if;
- 
-       else   -- Low-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 1;
-          TC_Result_Unsigned_8 := Rotate_Left(TC_Val_Unsigned_8, TC_Amount);
- 
-          if TC_Result_Unsigned_8 /= 128 then
-             Report.Failed("Incorrect result from LE Rotate_Left - 1");
-          end if;
- 
-          TC_Val_Unsigned_8    := 15;
-          if Rotate_Left(TC_Val_Unsigned_8, 2) /=  195  or
-             Rotate_Left(TC_Val_Unsigned_8, 3) /=  225  or
-             Rotate_Left(TC_Val_Unsigned_8, 5) /=  120  or
-             Rotate_Left(TC_Val_Unsigned_8, 8) /= TC_Val_Unsigned_8 or
-             Rotate_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from LE Rotate_Left - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := Unsigned_8'Last;
-          if Rotate_Left(TC_Val_Unsigned_8, 1) /= Unsigned_8'Last then
-             Report.Failed("Incorrect result from LE Rotate_Left - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 12;
-          if Rotate_Left(TC_Val_Unsigned_8, 1) /=   6 or
-             Rotate_Left(TC_Val_Unsigned_8, 3) /= 129  
-          then
-             Report.Failed("Incorrect result from LE Rotate_Left - 4");
-          end if;
- 
-          TC_Val_Unsigned_8 := 129;
-          if Rotate_Left(TC_Val_Unsigned_8, 4)                 /=  24  or
-             Rotate_Left(Rotate_Left(TC_Val_Unsigned_8, 7), 1) /= 129
-          then
-             Report.Failed("Incorrect result from LE Rotate_Left - 5");
-          end if;
- 
-       end if;
- 
- 
- 
-       -- Function Rotate_Right.
- 
-       if Big_Endian then  -- High-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 1;
-          TC_Result_Unsigned_8 := Rotate_Right(TC_Val_Unsigned_8, TC_Amount);
- 
-          if TC_Result_Unsigned_8 /= 128 then
-             Report.Failed("Incorrect result from BE Rotate_Right - 1");
-          end if;
- 
-          TC_Val_Unsigned_8    := 15;
-          if Rotate_Right(TC_Val_Unsigned_8, 2) /=  195  or
-             Rotate_Right(TC_Val_Unsigned_8, 3) /=  225  or
-             Rotate_Right(TC_Val_Unsigned_8, 5) /=  120  or
-             Rotate_Right(TC_Val_Unsigned_8, 8) /= TC_Val_Unsigned_8 or
-             Rotate_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from BE Rotate_Right - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := Unsigned_8'Last;
-          if Rotate_Right(TC_Val_Unsigned_8, 1) /= Unsigned_8'Last then
-             Report.Failed("Incorrect result from BE Rotate_Right - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 12;
-          if Rotate_Right(TC_Val_Unsigned_8, 1) /=   6 or
-             Rotate_Right(TC_Val_Unsigned_8, 3) /= 129  
-          then
-             Report.Failed("Incorrect result from BE Rotate_Right - 4");
-          end if;
- 
-          TC_Val_Unsigned_8 := 129;
-          if Rotate_Right(TC_Val_Unsigned_8, 4)                  /=  24  or
-             Rotate_Right(Rotate_Right(TC_Val_Unsigned_8, 7), 1) /= 129
-          then
-             Report.Failed("Incorrect result from BE Rotate_Right - 5");
-          end if;
- 
-       else  -- Low-order first bit ordering.
- 
-          TC_Amount            := 1;
-          TC_Val_Unsigned_8    := 129;  
-          TC_Result_Unsigned_8 := Rotate_Right(Value  => TC_Val_Unsigned_8, 
-                                               Amount => TC_Amount);
-          if TC_Result_Unsigned_8 /= 3 then
-             Report.Failed("Incorrect result from LE Rotate_Right - 1");
-          end if;
- 
-          if Rotate_Right(TC_Val_Unsigned_8, 2) /=   6  or
-             Rotate_Right(TC_Val_Unsigned_8, 3) /=  12  or
-             Rotate_Right(TC_Val_Unsigned_8, 5) /=  48  or
-             Rotate_Right(TC_Val_Unsigned_8, 8) /= 129  or
-             Rotate_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
-          then
-             Report.Failed("Incorrect result from LE Rotate_Right - 2");
-          end if;
- 
-          TC_Val_Unsigned_8 := 1;
-          if Rotate_Right(Value => TC_Val_Unsigned_8, Amount => 1) /= 2 or
-             Rotate_Right(TC_Val_Unsigned_8, Amount => 3)          /= 8 
-          then 
-             Report.Failed("Incorrect result from LE Rotate_Right - 3");
-          end if;
- 
-          TC_Val_Unsigned_8 := 82;
-          if Rotate_Right(TC_Val_Unsigned_8, Amount => 4)        /=  37  or
-             Rotate_Right(Rotate_Right(TC_Val_Unsigned_8, 7), 1) /=  82
-          then
-             Report.Failed("Incorrect result from LE Rotate_Right - 4");
-          end if;
- 
-       end if;
- 
- 
- 
-       -- Tests of Rotate_Left and Rotate_Right in combination.
- 
-       if Big_Endian then  -- High-order first bit ordering.
- 
-          TC_Val_Unsigned_8  := 17;
- 
-          if Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 2), 2) /= 
-             TC_Val_Unsigned_8                                        or
-             Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 1), 3) /= 68 or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 3), 7) /= 17 or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 2), 8) /= 68 
-          then
-             Report.Failed("Incorrect result from BE Rotate_Left - " &
-                           "Rotate_Right functions used in combination");
-          end if;
- 
-       else  -- Low-order first bit ordering.
- 
-          TC_Val_Unsigned_8 := 4;
- 
-          if Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 2), 2) /= 
-             TC_Val_Unsigned_8                                        or
-             Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 1), 3) /=  1 or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 3), 7) /= 64 or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 2), 8) /=  1 
-          then
-             Report.Failed("Incorrect result from LE Rotate_Left - " &
-                           "Rotate_Right functions used in combination");
-          end if;
- 
-       end if;
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB2001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb2002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb2002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb2002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb2002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,259 ****
- -- CXB2002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that subprograms Shift_Left, Shift_Right, 
- --      Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right are available
- --      and produce correct results for values of signed and modular
- --      integer types of 16 bits.  
- --
- -- TEST DESCRIPTION:
- --      This test uses the shift and rotate functions of package Interfaces
- --      with a modular type representative of 16 bits.  The functions
- --      are used as the right hand of assignment statements, as part of
- --      conditional statements, and as arguments in other function calls.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that support signed
- --      and modular integer types of 16 bits.
- --
- --       
- -- CHANGE HISTORY:
- --      21 Aug 95   SAIC    Initial prerelease version.
- --      07 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Removed subtests based on Big/Little Endian.
- --      17 Feb 97   PWB.CTA Corrected "-" to "+" in parenthesized expressions.
- --!
- 
- with Report;
- with Interfaces;
- with Ada.Exceptions;
- 
- procedure CXB2002 is
- begin
- 
-    Report.Test ("CXB2002", 
-                 "Check that subprograms Shift_Left, Shift_Right, "       &
-                 "Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right " &
-                 "produce correct results for values of signed and "      &
-                 "modular integer types of 16 bits");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Interfaces;
- 
-       TC_Amount             : Natural     := Natural'First;
- 
-       -- Range of type Unsigned_16 is 0..65535 (0..Modulus-1).
-       TC_Val_Unsigned_16,
-       TC_Result_Unsigned_16 : Unsigned_16 := Unsigned_16'First;
- 
-    begin
- 
-       -- Note: The shifting and rotating subprograms operate on a bit-by-bit
-       --       basis, using the binary representation of the value of the 
-       --       operands to yield a binary representation for the result.
- 
-       -- Function Shift_Left.
- 
-          TC_Amount             := 3;
-          TC_Val_Unsigned_16    := Unsigned_16'Last;  -- 65535.
-          TC_Result_Unsigned_16 := Shift_Left(TC_Val_Unsigned_16, TC_Amount);
- 
-          if TC_Result_Unsigned_16 /= Unsigned_16'Last - (2**0 + 2**1 + 2**2)
-          then
-             Report.Failed("Incorrect result from Shift_Left - 1");
-          end if;
- 
-          if Shift_Left(TC_Val_Unsigned_16,  0) /= Unsigned_16'Last  or
-             Shift_Left(TC_Val_Unsigned_16,  5) /= 
-             Unsigned_16'Last - (2**0 + 2**1 + 2**2 + 2**3 +2**4)    or
-             Shift_Left(TC_Val_Unsigned_16, 16) /=     0  
-          then
-             Report.Failed("Incorrect result from Shift_Left - 2");
-          end if;
- 
- 
-       -- Function Shift_Right.
- 
-          TC_Amount             := 3;
-          TC_Val_Unsigned_16    := Unsigned_16'Last;  -- 65535.
-          TC_Result_Unsigned_16 := Shift_Right(Value  => TC_Val_Unsigned_16, 
-                                               Amount => TC_Amount);
- 
-          if TC_Result_Unsigned_16 /= Unsigned_16'Last-(2**15 + 2**14 + 2**13)
-          then
-             Report.Failed("Incorrect result from Shift_Right - 1");
-          end if;
- 
-          if Shift_Right(TC_Val_Unsigned_16,  0) /= Unsigned_16'Last  or
-             Shift_Right(TC_Val_Unsigned_16,  5) /= 
-             Unsigned_16'Last-(2**15 + 2**14 + 2**13 + 2**12 + 2**11) or
-             Shift_Right(TC_Val_Unsigned_16, 16) /=    0  
-          then
-             Report.Failed("Incorrect result from Shift_Right - 2");
-          end if;
- 
- 
-       -- Tests of Shift_Left and Shift_Right in combination.
- 
-          TC_Val_Unsigned_16 := Unsigned_16'Last;
- 
-          if Shift_Left(Shift_Right(TC_Val_Unsigned_16, 4),  4) /= 
-             Unsigned_16'Last-(2**0 + 2**1 + 2**2 + 2**3)         or
-             Shift_Left(Shift_Right(TC_Val_Unsigned_16, 1),  3) /= 
-             Unsigned_16'Last-(2**0 + 2**1 + 2**2)                or
-             Shift_Right(Shift_Left(TC_Val_Unsigned_16, 2),  4) /=  
-             Unsigned_16'Last-(2**15+ 2**14 + 2**13 + 2**12)      or
-             Shift_Right(Shift_Left(TC_Val_Unsigned_16, 2), 16) /= 0
-          then
-             Report.Failed("Incorrect result from Shift_Left - " &
-                           "Shift_Right functions used in combination");
-          end if;
- 
- 
-       -- Function Shift_Right_Arithmetic.
- 
-          -- Case where the parameter Value is less than 
-          -- one half of the modulus.  Zero bits will be shifted in.
-          -- Modulus of type Unsigned_16 is 2**16; one half is 2**15.
- 
-          TC_Amount             := 3;
-          TC_Val_Unsigned_16    := 2**15 - 1; -- Less than one half of modulus.
-          TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
-                                                          TC_Amount);
-          if TC_Result_Unsigned_16 /= 
-             TC_Val_Unsigned_16 - (2**14 + 2**13 + 2**12) 
-          then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 1");
-          end if;
- 
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_16, 0)  /= 
-             TC_Val_Unsigned_16                                           or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_16, 5)  /=
-             TC_Val_Unsigned_16 - (2**14 + 2**13 + 2**12 + 2**11 + 2**10) or 
-             Shift_Right_Arithmetic(TC_Val_Unsigned_16, 16) /=    0  
-          then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 2");
-          end if;
- 
-          -- Case where the parameter Value is greater than or equal to
-          -- one half of the modulus.  One bits will be shifted in.
- 
-          TC_Amount             := 1;
-          TC_Val_Unsigned_16    := 2**15;  -- One half of modulus.
-          TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
-                                                          TC_Amount);
-          if TC_Result_Unsigned_16 /= TC_Val_Unsigned_16 + 2**14 then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 3");
-          end if;
- 
-          TC_Amount             := 1;
-          TC_Val_Unsigned_16    := 2**15 + 1; -- Greater than half of modulus.
-          TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
-                                                          TC_Amount);
-          if TC_Result_Unsigned_16 /= TC_Val_Unsigned_16 + 2**14 - 2**0 then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 4");
-          end if;
- 
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_16, 0)  /= 
-             TC_Val_Unsigned_16                                        or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_16, 4)  /= 
-             TC_Val_Unsigned_16 - 2**0 + 2**14 + 2**13 + 2**12 + 2**11 or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_16, 16) /= Unsigned_16'Last
-          then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 5");
-          end if;
- 
- 
-       -- Function Rotate_Left.
- 
-          TC_Amount             := 3;
-          TC_Val_Unsigned_16    := Unsigned_16'Last;  -- 65535.
-          TC_Result_Unsigned_16 := Rotate_Left(Value  => TC_Val_Unsigned_16, 
-                                               Amount => TC_Amount);
-          if TC_Result_Unsigned_16 /= Unsigned_16'Last then
-             Report.Failed("Incorrect result from Rotate_Left - 1");
-          end if;
- 
-          TC_Val_Unsigned_16    := 2**15 + 2**14 + 2**1 + 2**0;
-          if Rotate_Left(TC_Val_Unsigned_16,  0) /= 
-             2**15 + 2**14 + 2**1 + 2**0            or
-             Rotate_Left(TC_Val_Unsigned_16,  5) /=    
-             2**6 + 2**5 + 2**4 + 2**3              or
-             Rotate_Left(TC_Val_Unsigned_16, 16) /= TC_Val_Unsigned_16  
-          then
-             Report.Failed("Incorrect result from Rotate_Left - 2");
-          end if;
- 
- 
-       -- Function Rotate_Right.
- 
-          TC_Amount             := 1;
-          TC_Val_Unsigned_16    := 2**1 + 2**0;
-          TC_Result_Unsigned_16 := Rotate_Right(Value  => TC_Val_Unsigned_16, 
-                                                Amount => TC_Amount);
-          if TC_Result_Unsigned_16 /= 2**15 + 2**0 then
-             Report.Failed("Incorrect result from Rotate_Right - 1");
-          end if;
- 
-          if Rotate_Right(TC_Val_Unsigned_16,  0) /= 2**1 + 2**0   or
-             Rotate_Right(TC_Val_Unsigned_16,  5) /= 2**12 + 2**11 or
-             Rotate_Right(TC_Val_Unsigned_16, 16) /= 2**1 + 2**0 
-          then
-             Report.Failed("Incorrect result from Rotate_Right - 2");
-          end if;
- 
- 
-       -- Tests of Rotate_Left and Rotate_Right in combination.
- 
-          TC_Val_Unsigned_16 := 32769;
- 
-          if Rotate_Left(Rotate_Right(TC_Val_Unsigned_16, 4),  3) /= 49152 or
-             Rotate_Left(Rotate_Right(TC_Val_Unsigned_16, 1),  3) /=     6 or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_16, 3),  7) /=  6144 or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_16, 1), 16) /=     3
-          then
-             Report.Failed("Incorrect result from Rotate_Left - " &
-                           "Rotate_Right functions used in combination");
-          end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB2002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb2003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb2003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb2003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb2003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,255 ****
- -- CXB2003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that subprograms Shift_Left, Shift_Right, 
- --      Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right are available
- --      and produce correct results for values of signed and modular
- --      integer types of 32 bits.  
- --
- -- TEST DESCRIPTION:
- --      This test uses the shift and rotate functions of package Interfaces
- --      with a modular type representative of 32 bits.  The functions
- --      are used as the right hand of assignment statements, as part of
- --      conditional statements, and as arguments in other function calls.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that support signed
- --      and modular integer types of 32 bits.
- --
- --       
- -- CHANGE HISTORY:
- --      23 Aug 95   SAIC    Initial prerelease version.
- --      07 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Removed all references to Big/Little endian.
- --
- --!
- 
- with Report;
- with Interfaces;
- with Ada.Exceptions;
- 
- procedure CXB2003 is
- begin
- 
-    Report.Test ("CXB2003", 
-                 "Check that subprograms Shift_Left, Shift_Right, "       &
-                 "Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right " &
-                 "are available and produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces;
-       use Ada.Exceptions;
- 
-       TC_Amount   : Natural  := Natural'First;
- 
-       -- Range of type Unsigned_32 is 0..(2**32)-1    (0..Modulus-1).
-       TC_Val_Unsigned_32,
-       TC_Result_Unsigned_32 : Unsigned_32 := Unsigned_32'First;
- 
-    begin
- 
-       -- Note: The shifting and rotating subprograms operate on a bit-by-bit
-       --       basis, using the binary representation of the value of the 
-       --       operands to yield a binary representation for the result.
- 
- 
-       -- Function Shift_Left.
- 
-          TC_Amount             := 2;
-          TC_Val_Unsigned_32    := Unsigned_32'Last; 
-          TC_Result_Unsigned_32 := Shift_Left(TC_Val_Unsigned_32, TC_Amount);
- 
-          if TC_Result_Unsigned_32 /= Unsigned_32'Last - (2**0 + 2**1) then
-             Report.Failed("Incorrect result from Shift_Left - 1");
-          end if;
- 
-          TC_Result_Unsigned_32 := Unsigned_32'Last - (2**0 + 2**1 + 2**2 +
-                                                       2**3 + 2**4);
-          if Shift_Left(TC_Val_Unsigned_32,  5) /= TC_Result_Unsigned_32  or
-             Shift_Left(TC_Val_Unsigned_32,  0) /= Unsigned_32'Last       
-          then
-             Report.Failed("Incorrect result from Shift_Left - 2");
-          end if;
- 
- 
-       -- Function Shift_Right.
- 
-          TC_Amount             := 3;
-          TC_Val_Unsigned_32    := Unsigned_32'Last;  
-          TC_Result_Unsigned_32 := Shift_Right(Value  => TC_Val_Unsigned_32, 
-                                               Amount => TC_Amount);
-          if TC_Result_Unsigned_32 /= 
-             Unsigned_32'Last - (2**31 + 2**30 + 2**29) 
-          then
-             Report.Failed("Incorrect result from Shift_Right - 1");
-          end if;
- 
-          if Shift_Right(TC_Val_Unsigned_32,  0) /= Unsigned_32'Last    or
-             Shift_Right(TC_Val_Unsigned_32,  2) /= Unsigned_32'Last - 
-                                                    (2**31 + 2**30)     
-          then
-             Report.Failed("Incorrect result from Shift_Right - 2");
-          end if;
- 
- 
-       -- Tests of Shift_Left and Shift_Right in combination.
- 
-          TC_Val_Unsigned_32 := Unsigned_32'Last;
- 
-          if Shift_Left(Shift_Right(TC_Val_Unsigned_32, 4),  4) /=
-             Unsigned_32'Last - (2**0 + 2**1 + 2**2 + 2**3)          or
-             Shift_Left(Shift_Right(TC_Val_Unsigned_32, 3),  1) /=
-             Unsigned_32'Last - (2**31 + 2**30 + 2**0)               or
-             Shift_Left(Shift_Right(TC_Val_Unsigned_32, 5),  3) /=
-             Unsigned_32'Last - (2**31 + 2**30 + 2**2 + 2**1 + 2**0) or
-             Shift_Right(Shift_Left(TC_Val_Unsigned_32, 2),  1) /=
-             Unsigned_32'Last - (2**31 + 2**0)                       
-          then
-             Report.Failed("Incorrect result from Shift_Left - " &
-                           "Shift_Right functions used in combination");
-          end if;
- 
- 
-       -- Function Shift_Right_Arithmetic.
- 
-          -- Case where the parameter Value is less than 
-          -- one half of the modulus.  Zero bits will be shifted in.
- 
-          TC_Amount             := 3;
-          TC_Val_Unsigned_32    := 2**15 + 2**10 + 2**1;
-          TC_Result_Unsigned_32 := Shift_Right_Arithmetic(TC_Val_Unsigned_32,
-                                                          TC_Amount);
-          if TC_Result_Unsigned_32 /= (2**12 + 2**7) then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 1");
-          end if;
- 
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_32, 0)  /= 
-             TC_Val_Unsigned_32                                  or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_32, 5)  /= 
-             (2**10 + 2**5)                                      
-          then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 2");
-          end if;
- 
-          -- Case where the parameter Value is greater than or equal to
-          -- one half of the modulus.  One bits will be shifted in.
- 
-          TC_Amount             := 1;
-          TC_Val_Unsigned_32    := 2**31; -- One half of modulus
-          TC_Result_Unsigned_32 := Shift_Right_Arithmetic(TC_Val_Unsigned_32,
-                                                          TC_Amount);
-          if TC_Result_Unsigned_32 /= (2**31 + 2**30) then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 3");
-          end if;
- 
-          TC_Amount             := 1;
-          TC_Val_Unsigned_32    := (2**31 + 2**1);
-          TC_Result_Unsigned_32 := Shift_Right_Arithmetic(TC_Val_Unsigned_32,
-                                                          TC_Amount);
-          if TC_Result_Unsigned_32 /= (2**31 + 2**30 + 2**0) then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 4");
-          end if;
- 
-          if Shift_Right_Arithmetic(TC_Val_Unsigned_32, 0)  /= 
-             TC_Val_Unsigned_32                                or
-             Shift_Right_Arithmetic(TC_Val_Unsigned_32, 3)  /= 
-             (2**31 + 2**30 + 2**29 + 2**28)                   
-          then
-             Report.Failed
-               ("Incorrect result from Shift_Right_Arithmetic - 5");
-          end if;
- 
- 
-       -- Function Rotate_Left.
- 
-          TC_Amount             := 3;
-          TC_Val_Unsigned_32    := Unsigned_32'Last; 
-          TC_Result_Unsigned_32 := Rotate_Left(Value  => TC_Val_Unsigned_32, 
-                                               Amount => TC_Amount);
-          if TC_Result_Unsigned_32 /= Unsigned_32'Last then
-             Report.Failed("Incorrect result from Rotate_Left - 1");
-          end if;
- 
-          TC_Val_Unsigned_32    := 2**31 + 2**30;
-          if Rotate_Left(TC_Val_Unsigned_32,  1) /= (2**31 + 2**0)  or
-             Rotate_Left(TC_Val_Unsigned_32,  5) /= (2**4  + 2**3)  or
-             Rotate_Left(TC_Val_Unsigned_32, 32) /= TC_Val_Unsigned_32  
-          then
-             Report.Failed("Incorrect result from Rotate_Left - 2");
-          end if;
- 
- 
-       -- Function Rotate_Right.
- 
-          TC_Amount             := 2;
-          TC_Val_Unsigned_32    := (2**1 + 2**0);
-          TC_Result_Unsigned_32 := Rotate_Right(Value  => TC_Val_Unsigned_32, 
-                                                Amount => TC_Amount);
-          if TC_Result_Unsigned_32 /= (2**31 + 2**30) then
-             Report.Failed("Incorrect result from Rotate_Right - 1");
-          end if;
- 
-          if Rotate_Right(TC_Val_Unsigned_32,  3) /=  (2**30 + 2**29)  or
-             Rotate_Right(TC_Val_Unsigned_32,  6) /=  (2**27 + 2**26)  or
-             Rotate_Right(TC_Val_Unsigned_32, 32) /=  (2**1  + 2**0) 
-          then
-             Report.Failed("Incorrect result from Rotate_Right - 2");
-          end if;
- 
- 
-       -- Tests of Rotate_Left and Rotate_Right in combination.
- 
-          TC_Val_Unsigned_32 := (2**31 + 2**15 + 2**3);
- 
-          if Rotate_Left(Rotate_Right(TC_Val_Unsigned_32, 4),  3) /= 
-             (2**30 + 2**14 + 2**2)                                   or
-             Rotate_Left(Rotate_Right(TC_Val_Unsigned_32, 1),  3) /= 
-             (2**17 + 2**5  + 2**1)                                   or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_32, 3),  7) /= 
-             (2**31 + 2**27 + 2**11)                                  or
-             Rotate_Right(Rotate_Left(TC_Val_Unsigned_32, 1), 32) /= 
-             (2**16 + 2**4  + 2**0)
-          then
-             Report.Failed("Incorrect result from Rotate_Left - " &
-                           "Rotate_Right functions used in combination");
-          end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB2003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,179 ****
- -- CXB3001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the specifications of the package Interfaces.C are
- --      available for use.
- --
- -- TEST DESCRIPTION: 
- --      This test verifies that the types and subprograms specified for the
- --      interface are present.  It just checks for the presence of
- --      the subprograms.  Other tests are designed to exercise the interface.
- --
- -- APPLICABILITY CRITERIA: 
- --      If an implementation provides package Interfaces.C, this test
- --      must compile, execute, and report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Nov 95   SAIC    Corrected To_C parameter list for ACVC 2.0.1.
- --      28 Feb 96   SAIC    Added applicability criteria.
- --
- --!
- 
- with Report;
- with Interfaces.C;                                             -- N/A => ERROR
- 
- procedure CXB3001 is
-    package C renames Interfaces.C;
-    use type C.signed_char;
-    use type C.unsigned_char;
-    use type C.char;
- 
- begin
- 
-    Report.Test ("CXB3001", "Check the specification of Interfaces.C");
- 
-    declare  -- encapsulate the test
- 
- 
-       tst_CHAR_BIT  : constant :=  C.CHAR_BIT;
-       tst_SCHAR_MIN : constant :=  C.SCHAR_MIN;
-       tst_SCHAR_MAX : constant :=  C.SCHAR_MAX;
-       tst_UCHAR_MAX : constant :=  C.UCHAR_MAX;
- 
-       -- Signed and Unsigned Integers
- 
-       tst_int   : C.int   := C.int'first;
-       tst_short : C.short := C.short'first;
-       tst_long  : C.long  := C.long'first;
- 
-       tst_signed_char_min : C.signed_char :=  C.signed_char'first;
-       tst_signed_char_max : C.signed_char :=  C.signed_char'last;
- 
-       tst_unsigned        : C.unsigned;
-       tst_unsigned_short  : C.unsigned_short;
-       tst_unsigned_long   : C.unsigned_long;
- 
-       tst_unsigned_char :  C.unsigned_char;
-       tst_plain_char    :  C.plain_char;
- 
-       tst_ptrdiff_t : C.ptrdiff_t;
-       tst_size_t    : C.size_t;
- 
-       -- Floating-Point
- 
-       tst_C_float     : C.C_float;
-       tst_double      : C.double;
-       tst_long_double : C.long_double; 
- 
-       -- Characters and Strings
- 
-       tst_char : C.char;
-       tst_nul  : C.char := C.nul;
- 
-       -- Collect all the subprogram calls such that they are compiled
-       -- but not executed
-       --
-       procedure Collect_All_Calls is
- 
-          CAC_char           : C.char;
-          CAC_Character      : Character;
-          CAC_String         : string (1..5);
-          CAC_Boolean        : Boolean := false;
-          CAC_char_array     : C.char_array(1..5);
-          CAC_Integer        : integer;
-          CAC_Natural        : natural;
-          CAC_wchar_t        : C.wchar_t;
-          CAC_Wide_Character : Wide_Character;
-          CAC_wchar_array    : C.wchar_array(1..5);
-          CAC_Wide_String    : Wide_String(1..5);
-          CAC_size_t         : C.size_t;
- 
-       begin
- 
-          CAC_char      := C.To_C (CAC_Character);
-          CAC_Character := C.To_Ada (CAC_char);
- 
-          CAC_char_array :=  C.To_C (CAC_String, CAC_Boolean);
-          CAC_String     :=  C.To_Ada (CAC_char_array, CAC_Boolean); 
- 
-          -- This call is out of LRM order so that we can use the 
-          -- array initialized above
-          CAC_Boolean  := C.Is_Nul_Terminated (CAC_char_array);
- 
-          C.To_C   (CAC_String, CAC_char_array, CAC_size_t, CAC_Boolean);
-          C.To_Ada (CAC_char_array, CAC_String, CAC_Natural, CAC_Boolean); 
- 
-          CAC_wchar_t        := C.To_C (CAC_Wide_Character);
-          CAC_Wide_Character := C.To_Ada (CAC_wchar_t); 
-          CAC_wchar_t        := C.wide_nul; 
- 
-          CAC_wchar_array :=  C.To_C   (CAC_Wide_String, CAC_Boolean);
-          CAC_Wide_String :=  C.To_Ada (CAC_wchar_array, CAC_Boolean);
- 
-          -- This call is out of LRM order so that we can use the 
-          -- array initialized above
-          CAC_Boolean  := C.Is_Nul_Terminated (CAC_wchar_array);
- 
-          C.To_C   (CAC_Wide_String, CAC_wchar_array, CAC_size_t,  CAC_Boolean);
-          C.To_Ada (CAC_wchar_array, CAC_Wide_String, CAC_Natural, CAC_Boolean);
- 
-          raise C.Terminator_Error;
- 
-       end Collect_All_Calls;
- 
- 
- 
-    begin    -- encapsulation
- 
-       if  tst_signed_char_min /= C.SCHAR_MIN then
-          Report.Failed  ("tst_signed_char_min is incorrect");
-       end if;
-       if  tst_signed_char_max /= C.SCHAR_MAX then
-          Report.Failed  ("tst_signed_char_max is incorrect");
-       end if;
-       if C.signed_char'Size /= C.CHAR_BIT then
-          Report.Failed  ("C.signed_char'Size is incorrect");
-       end if;
- 
-       if C.unsigned_char'first /= 0                or
-          C.unsigned_char'last  /= C.UCHAR_MAX      or
-          C.unsigned_char'size  /= C.CHAR_BIT       then
- 
-             Report.Failed  ("unsigned_char is incorrectly defined");
- 
-       end if;
- 
-       if tst_nul /= C.char'first then
-          Report.Failed  ("tst_nul is incorrect");
-       end if;
- 
-    end;     -- encapsulation
- 
-    Report.Result;
- 
- end CXB3001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,158 ****
- -- CXB3002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that the specifications of the package Interfaces.C.Strings
- --      are available for use.
- --
- -- TEST DESCRIPTION:
- --      This test verifies that the types and subprograms specified for the
- --      interface are present
- --
- -- APPLICABILITY CRITERIA: 
- --      If an implementation provides packages Interfaces.C and
- --      Interfaces.C.Strings, this test must compile, execute, and 
- --      report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Feb 96   SAIC    Added applicability criteria.
- --
- --!
- 
- with Report;
- with Interfaces.C;                                            -- N/A => ERROR
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- 
- procedure CXB3002 is
-    package Strings renames Interfaces.C.Strings;              
-    package C renames Interfaces.C;                            
- 
- begin
- 
-    Report.Test ("CXB3002", "Check the specification of Interfaces.C.Strings");
- 
- 
-    declare  -- encapsulate the test
- 
-       TC_Int_1      : integer := 1;
-       TC_Int_2      : integer := 1;
-       TC_String     : String := "ABCD";
-       TC_Boolean    : Boolean := true;
-       TC_char_array : C.char_array (1..5);
-       TC_size_t     : C.size_t := C.size_t'first;
- 
- 
-       --  Note In all of the following the Strings spec. being tested
-       --  is shown in comment lines
-       -- 
-       --    type char_array_access is access all char_array;
-       TST_char_array_access :  Strings.char_array_access := 
-                                        new Interfaces.C.char_array (1..5);
- 
-       --    type chars_ptr is private;
-       --    Null_Ptr : constant chars_ptr;
-       TST_chars_ptr : Strings.chars_ptr := Strings.Null_ptr;
- 
-       --  type chars_ptr_array is array (size_t range <>) of chars_ptr;
-       TST_chars_ptr_array : Strings.chars_ptr_array(1..5);
- 
-    begin    -- encapsulation
- 
-       -- Arrange that the calls to the subprograms are compiled but
-       -- not executed
-       -- 
-       if not Report.Equal ( TC_Int_1, TC_Int_2 ) then
- 
-          --    function To_Chars_Ptr (Item      : in char_array_access;
-          --                           Nul_Check : in Boolean := False)
-          --       return chars_ptr;
-          TST_chars_ptr := Strings.To_Chars_Ptr 
-                                           (TST_char_array_access, TC_Boolean); 
- 
-          --    This one is out of LRM order so that we can "initialize"
-          --    TC_char_array for the "in" parameter of the next one
-          -- 
-          --    function Value (Item : in chars_ptr) return char_array;
-          TC_char_array := Strings.Value (TST_chars_ptr);
- 
-          --    function New_Char_Array (Chars   : in char_array) 
-          --       return chars_ptr;
-          TST_chars_ptr := Strings.New_Char_Array (TC_char_array); 
- 
-          --    function New_String (Str : in String) return chars_ptr;
-          TST_chars_ptr := Strings.New_String ("TEST STRING");
- 
-          --    procedure Free (Item : in out chars_ptr);
-          Strings.Free (TST_chars_ptr);
- 
-          --    function Value (Item : in chars_ptr; Length : in size_t)
-          --       return char_array;
-          TC_char_array := Strings.Value (TST_chars_ptr, TC_size_t);
- 
-          -- Use Report.Comment as a known procedure which takes a string as
-          -- a parameter (this does not actually get output)
-          --    function Value (Item : in chars_ptr) return String;
-          Report.Comment ( Strings.Value (TST_chars_ptr) );
- 
-          --    function Value (Item : in chars_ptr; Length : in size_t) 
-          --       return String;
-          TC_String := Strings.Value (TST_chars_ptr, TC_size_t);
- 
-          --    function Strlen (Item : in chars_ptr) return size_t;
-          TC_size_t := Strings.Strlen (TST_chars_ptr);
- 
-          --    procedure Update (Item   : in chars_ptr;
-          --                      Offset : in size_t;
-          --                      Chars  : in char_array;
-          --                      Check  : in Boolean := True);
-          Strings.Update (TST_chars_ptr, TC_size_t, TC_char_array, TC_Boolean);
- 
-          --    procedure Update (Item   : in chars_ptr;
-          --                      Offset : in size_t;
-          --                      Str    : in String;
-          --                      Check  : in Boolean := True);
-          Strings.Update (TST_chars_ptr, TC_size_t, TC_String, TC_Boolean);
- 
-          --    Update_Error : exception;
-          raise Strings.Update_Error;
-          
-       end if;
- 
-       if not Report.Equal ( TC_Int_2, TC_Int_1 ) then
- 
-          -- This exception is out of LRM presentation order to avoid
-          -- compiler warnings about unreachable code
-          --    Dereference_Error : exception;
-          raise Strings.Dereference_Error;
- 
-       end if;
- 
-    end;     -- encapsulation
- 
-    Report.Result;
- 
- end CXB3002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- CXB3003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that the specifications of the package Interfaces.C.Pointers
- --      are available for use.
- --
- -- TEST DESCRIPTION:
- --      This test verifies that the types and subprograms specified for the
- --      interface are present
- --
- -- APPLICABILITY CRITERIA: 
- --      If an implementation provides package Interfaces.C.Pointers, this
- --      test must compile, execute, and report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Feb 96   SAIC    Added applicability criteria.
- --
- --!
- 
- with Report;
- with Interfaces.C.Pointers;                                   -- N/A => ERROR
- 
- procedure CXB3003 is
-    package C renames Interfaces.C;
- 
-    package Test_Ptrs is new C.Pointers
-                         (Index               => C.size_t,
-                          Element             => C.Char,
-                          Element_Array       => C.Char_Array,
-                          Default_Terminator  => C.Nul);  
-    
- begin
- 
-    Report.Test ("CXB3003", "Check the specification of Interfaces.C.Pointers");
- 
- 
-    declare  -- encapsulate the test
- 
-       TC_Int        : integer := 1;
- 
-       --  Note:  In all of the following the Pointers spec. being tested
-       --  is shown in comments
-       -- 
-       --    type Pointer is access all Element;
-       subtype TST_Pointer_Type is Test_Ptrs.Pointer;
- 
-       TST_Element   : C.Char           := C.Char'First;
-       TST_Pointer   : TST_Pointer_Type := null;
-       TST_Pointer_2 : TST_Pointer_Type := null;  
-       TST_Array     : C.char_array (1..5);
-       TST_Index     : C.ptrdiff_t      := C.ptrdiff_t'First;
- 
-    begin    -- encapsulation
- 
-       -- Arrange that the calls to the subprograms are compiled but
-       -- not executed
-       -- 
-       if not Report.Equal ( TC_Int, TC_Int ) then
-          
- 
-          --    function Value (Ref        : in Pointer;
-          --                    Terminator : in Element := Default_Terminator)
-          --      return Element_Array;
- 
-          TST_Array := Test_Ptrs.Value ( TST_Pointer );  -- default
-          TST_Array := Test_Ptrs.Value ( TST_Pointer, TST_Element ); 
- 
-          --    function Value (Ref    : in Pointer; Length : in ptrdiff_t)
-          --      return Element_Array;
- 
-          TST_Array := Test_Ptrs.Value (TST_Pointer, TST_Index);
- 
-          -- 
-          --    --  C-style Pointer arithmetic
-          -- 
-          --    function "+" (Left : in Pointer;   Right : in ptrdiff_t) 
-          --                                                 return Pointer;
-          TST_Pointer := Test_Ptrs."+" (TST_Pointer, TST_Index); 
- 
-          --    function "+" (Left : in Ptrdiff_T; Right : in Pointer)   
-          --                                                 return Pointer;
-          TST_Pointer := Test_Ptrs."+" (TST_Index, TST_Pointer); 
- 
-          --    function "-" (Left : in Pointer;   Right : in ptrdiff_t) 
-          --                                                 return Pointer;
-          TST_Pointer := Test_Ptrs."-" (TST_Pointer, TST_Index); 
- 
-          --    function "-" (Left : in Pointer;   Right : in Pointer)  
-          --                                                 return ptrdiff_t;
-          TST_Index  := Test_Ptrs."-" (TST_Pointer, TST_Pointer);
- 
-          --    procedure Increment (Ref : in out Pointer);
-          Test_Ptrs.Increment (TST_Pointer);
- 
-          --    procedure Decrement (Ref : in out Pointer);
-          Test_Ptrs.Decrement (TST_Pointer);
- 
-          --    function Virtual_Length 
-          --                 ( Ref        : in Pointer;
-          --                   Terminator : in Element := Default_Terminator)
-          --      return ptrdiff_t;
-          TST_Index := Test_Ptrs.Virtual_Length (TST_Pointer);
-          TST_Index := Test_Ptrs.Virtual_Length (TST_Pointer, TST_Element);
- 
-          --    procedure Copy_Terminated_Array
-          --      (Source     : in Pointer;
-          --       Target     : in Pointer;
-          --       Limit      : in ptrdiff_t := ptrdiff_t'Last;  
-          --       Terminator : in Element := Default_Terminator);
- 
-          Test_Ptrs.Copy_Terminated_Array (TST_Pointer, TST_Pointer_2);
- 
-          Test_Ptrs.Copy_Terminated_Array (TST_Pointer,
-                                           TST_Pointer_2,
-                                           TST_Index);
- 
-          Test_Ptrs.Copy_Terminated_Array (TST_Pointer, 
-                                           TST_Pointer_2,
-                                           TST_Index, 
-                                           TST_Element);
- 
- 
-          --    procedure Copy_Array
-          --      (Source  : in Pointer;
-          --       Target  : in Pointer;
-          --       Length  : in ptrdiff_t);
-          
-          Test_Ptrs.Copy_Array (TST_Pointer, TST_Pointer_2, TST_Index);
- 
-          --    This is out of LRM order to avoid complaints from compilers 
-          --    about inaccessible code
-          --       Pointer_Error : exception;
- 
-          raise Test_Ptrs.Pointer_Error;
- 
-       end if;
- 
-    end;     -- encapsulation
- 
-    Report.Result;
- 
- end CXB3003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30040.c gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30040.c
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30040.c	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30040.c	Thu Jan  1 00:00:00 1970
***************
*** 1,172 ****
- /*
- -- CXB30040.C
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FUNCTION NAME: CXB30040   ("char_gen")
- --
- -- FUNCTION DESCRIPTION:
- --      This C function returns the value of type char corresponding to the
- --      value of its parameter, where
- --          Val  0 ..  9 ==> '0' .. '9'
- --          Val 10 .. 19 ==> 'A' .. 'J'
- --          Val 20 .. 29 ==> 'k' .. 't'
- --          Val 30       ==> ' '
- --          Val 31       ==> '.'
- --          Val 32       ==> ','
- --
- -- INPUT:
- --      This function requires that one int parameter be passed to it.
- --
- -- OUTPUT:
- --      The function will return the appropriate value of type char.
- --
- -- CHANGE HISTORY:
- --      13 Sep 99   RLB     Created function to replace incorrect
- --                          Unchecked_Conversion.
- --
- --!
- */
- 
- char CXB30040 (int val)
- 
- /* NOTE: The above function definition should be accepted by an ANSI-C   */
- /*       compiler.  Older C compilers may reject it; they may, however   */
- /*       accept the following two lines.  An implementation may comment  */
- /*       out the above function definition and uncomment the following   */
- /*       one.  Otherwise, an implementation must provide the necessary   */
- /*       modifications to this C code to satisfy the function            */
- /*       requirements (see Function Description).                        */
- /*                                                                       */
- /*  char CXB30040 (val)                                                  */
- /*     int     val;                                                      */
- /*                                                                       */
- 
- {  char return_value = ';';
- 
-    switch (val)
-    {
-       case 0:
-          return_value = '0';
-          break;
-       case 1:
-          return_value = '1';
-          break;
-       case 2:
-          return_value = '2';
-          break;
-       case 3:
-          return_value = '3';
-          break;
-       case 4:
-          return_value = '4';
-          break;
-       case 5:
-          return_value = '5';
-          break;
-       case 6:
-          return_value = '6';
-          break;
-       case 7:
-          return_value = '7';
-          break;
-       case 8:
-          return_value = '8';
-          break;
-       case 9:
-          return_value = '9';
-          break;
-       case 10:
-          return_value = 'A';
-          break;
-       case 11:
-          return_value = 'B';
-          break;
-       case 12:
-          return_value = 'C';
-          break;
-       case 13:
-          return_value = 'D';
-          break;
-       case 14:
-          return_value = 'E';
-          break;
-       case 15:
-          return_value = 'F';
-          break;
-       case 16:
-          return_value = 'G';
-          break;
-       case 17:
-          return_value = 'H';
-          break;
-       case 18:
-          return_value = 'I';
-          break;
-       case 19:
-          return_value = 'J';
-          break;
-       case 20:
-          return_value = 'k';
-          break;
-       case 21:
-          return_value = 'l';
-          break;
-       case 22:
-          return_value = 'm';
-          break;
-       case 23:
-          return_value = 'n';
-          break;
-       case 24:
-          return_value = 'o';
-          break;
-       case 25:
-          return_value = 'p';
-          break;
-       case 26:
-          return_value = 'q';
-          break;
-       case 27:
-          return_value = 'r';
-          break;
-       case 28:
-          return_value = 's';
-          break;
-       case 29:
-          return_value = 't';
-          break;
-       case 30:
-          return_value = ' ';
-          break;
-       case 31:
-          return_value = '.';
-          break;
-       case 32:
-          return_value = ',';
-          break;
-    }
- 
-    return (return_value); /* Return character value */
- }
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am	Thu Jan  1 00:00:00 1970
***************
*** 1,377 ****
- -- CXB30041.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functions To_C and To_Ada map between the Ada type
- --      Character and the C type char.
- --
- --      Check that the function Is_Nul_Terminated returns True if the
- --      char_array parameter contains nul, and otherwise False.
- --
- --      Check that the function To_C produces a correct char_array result,
- --      with lower bound of 0, and length dependent upon the Item and
- --      Append_Nul parameters.
- --
- --      Check that the function To_Ada produces a correct string result, with
- --      lower bound of 1, and length dependent upon the Item and Trim_Nul
- --      parameters.
- --
- --      Check that the function To_Ada raises Terminator_Error if the
- --      parameter Trim_Nul is set to True, but the actual Item parameter
- --      does not contain the nul char.
- --
- -- TEST DESCRIPTION:
- --      This test uses a variety of Character, char, String, and char_array
- --      objects to test versions of the To_C, To_Ada, and Is_Nul_Terminated
- --      functions.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.  If an implementation provides
- --      package Interfaces.C, this test must compile, execute, and
- --      report "PASSED".
- --
- -- SPECIAL REQUIREMENTS:
- --      The file CXB30040.C must be compiled with a C compiler.
- --      Implementation dialects of C may require alteration of
- --      the C program syntax (see individual C files).
- --
- --      Note that the compiled C code must be bound with the compiled Ada
- --      code to create an executable image.  An implementation must provide
- --      the necessary commands to accomplish this.
- --
- --      Note that the C code included in CXB30040.C conforms
- --      to ANSI-C.  Modifications to these files may be required for other
- --      C compilers.  An implementation must provide the necessary
- --      modifications to satisfy the function requirements.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         CXB30040.C
- --         CXB30041.AM
- --
- -- CHANGE HISTORY:
- --      30 Aug 95   SAIC    Initial prerelease version.
- --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --      13 Sep 99   RLB     Replaced (bogus) Unchecked_Conversions with a
- --                          C function character generator.
- --
- --!
- 
- with Report;
- with Interfaces.C;                                            -- N/A => ERROR
- with Ada.Characters.Latin_1;
- with Ada.Exceptions;
- with Ada.Strings.Fixed;
- with Impdef;
- 
- procedure CXB30041 is
- begin
- 
-    Report.Test ("CXB3004", "Check that the functions To_C and To_Ada " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces, Interfaces.C;
-       use Ada.Characters, Ada.Characters.Latin_1;
-       use Ada.Exceptions;
-       use Ada.Strings.Fixed;
- 
-       Start_Character,
-       Stop_Character,
-       TC_Character    : Character         := Character'First;
-       TC_char,
-       TC_Low_char,
-       TC_High_char    : char              := char'First;
-       TC_String       : String(1..8)      := (others => Latin_1.NUL);
-       TC_char_array   : char_array(0..7)  := (others => C.nul);
- 
-       -- The function Char_Gen returns a character corresponding to its
-       -- argument.
-       --     Value   0 ..  9 ==> '0' .. '9'
-       --     Value  10 .. 19 ==> 'A' .. 'J'
-       --     Value  20 .. 29 ==> 'k' .. 't'
-       --     Value  30       ==> ' '
-       --     Value  31       ==> '.'
-       --     Value  32       ==> ','
- 
-       function Char_Gen (Value   : in int) return char;
- 
-       -- Use the user-defined C function char_gen as a completion to the
-       -- function specification above.
- 
-       pragma Import (Convention    => C,
-                      Entity        => Char_Gen,
-                      External_Name => Impdef.CXB30040_External_Name);
- 
-    begin
- 
-       -- Check that the functions To_C and To_Ada map between the Ada type
-       -- Character and the C type char.
- 
-       if To_C(Ada.Characters.Latin_1.NUL) /= Interfaces.C.nul then
-          Report.Failed("Incorrect result from To_C with NUL character input");
-       end if;
- 
-       Start_Character := Report.Ident_Char('k');
-       Stop_Character  := Report.Ident_Char('t');
-       for TC_Character in Start_Character..Stop_Character loop
-          if To_C(Item => TC_Character) /=
-             Char_Gen(Character'Pos(TC_Character) - Character'Pos('k') + 20) then
-             Report.Failed("Incorrect result from To_C with lower case " &
-                           "alphabetic character input");
-          end if;
-       end loop;
- 
-       Start_Character := Report.Ident_Char('A');
-       Stop_Character  := Report.Ident_Char('J');
-       for TC_Character in Start_Character..Stop_Character loop
-          if To_C(Item => TC_Character) /=
-             Char_Gen(Character'Pos(TC_Character) - Character'Pos('A') + 10) then
-             Report.Failed("Incorrect result from To_C with upper case " &
-                           "alphabetic character input");
-          end if;
-       end loop;
- 
-       Start_Character := Report.Ident_Char('0');
-       Stop_Character  := Report.Ident_Char('9');
-       for TC_Character in Start_Character..Stop_Character loop
-          if To_C(Item => TC_Character) /=
-             Char_Gen(Character'Pos(TC_Character) - Character'Pos('0')) then
-             Report.Failed("Incorrect result from To_C with digit " &
-                           "character input");
-          end if;
-       end loop;
-       if To_C(Item => ' ') /= Char_Gen(30) then
-          Report.Failed("Incorrect result from To_C with space " &
-                        "character input");
-       end if;
-       if To_C(Item => '.') /= Char_Gen(31) then
-          Report.Failed("Incorrect result from To_C with dot " &
-                        "character input");
-       end if;
-       if To_C(Item => ',') /= Char_Gen(32) then
-          Report.Failed("Incorrect result from To_C with comma " &
-                        "character input");
-       end if;
- 
-       if To_Ada(Interfaces.C.nul) /= Ada.Characters.Latin_1.NUL then
-          Report.Failed("Incorrect result from To_Ada with nul char input");
-       end if;
- 
-       for Code in int range
-          int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
-             -- 'k' .. 't'
-          if To_Ada(Item => Char_Gen(Code)) /=
- 	    Character'Val (Character'Pos('k') + (Code - 20)) then
-             Report.Failed("Incorrect result from To_Ada with lower case " &
-                           "alphabetic char input");
-          end if;
-       end loop;
- 
-       for Code in int range
-          int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
-             -- 'A' .. 'J'
-          if To_Ada(Item => Char_Gen(Code)) /=
- 	    Character'Val (Character'Pos('A') + (Code - 10)) then
-             Report.Failed("Incorrect result from To_Ada with upper case " &
-                           "alphabetic char input");
-          end if;
-       end loop;
- 
-       for Code in int range
-          int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
-             -- '0' .. '9'
-          if To_Ada(Item => Char_Gen(Code)) /=
- 	    Character'Val (Character'Pos('0') + (Code)) then
-             Report.Failed("Incorrect result from To_Ada with digit " &
-                           "char input");
-          end if;
-       end loop;
- 
-       if To_Ada(Item => Char_Gen(30)) /= ' ' then
-          Report.Failed("Incorrect result from To_Ada with space " &
-                        "char input");
-       end if;
-       if To_Ada(Item => Char_Gen(31)) /= '.' then
-          Report.Failed("Incorrect result from To_Ada with dot " &
-                        "char input");
-       end if;
-       if To_Ada(Item => Char_Gen(32)) /= ',' then
-          Report.Failed("Incorrect result from To_Ada with comma " &
-                        "char input");
-       end if;
- 
-       -- Check that the function Is_Nul_Terminated produces correct results
-       -- whether or not the char_array argument contains the
-       -- Ada.Interfaces.C.nul character.
- 
-       TC_String := "abcdefgh";
-       if Is_Nul_Terminated(Item => To_C(TC_String, Append_Nul => False)) then
-          Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
-                        "nul char is present");
-       end if;
- 
-       if not Is_Nul_Terminated(To_C(TC_String, Append_Nul => True)) then
-          Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
-                        "nul char is present");
-       end if;
- 
- 
-       -- Now that we've tested the character/char versions of To_Ada and To_C,
-       -- use them to test the string versions.
- 
-       declare
-          i                    : size_t  := 0;
-          j                    : integer := 1;
-          Incorrect_Conversion : Boolean := False;
- 
-          TC_No_nul       : constant char_array := To_C(TC_String, False);
-          TC_nul_Appended : constant char_array := To_C(TC_String, True);
-       begin
- 
-          -- Check that the function To_C produces a char_array result with
-          -- lower bound of 0, and length dependent upon the Item and
-          -- Append_Nul parameters (if Append_Nul is True, length is
-          -- Item'Length + 1; if False, length is Item'Length).
- 
-          if TC_No_nul'First /= 0 or TC_nul_Appended'First /= 0 then
-             Report.Failed("Incorrect lower bound from Function To_C");
-          end if;
- 
-          if TC_No_nul'Length /= TC_String'Length then
-             Report.Failed("Incorrect length returned from Function To_C " &
-                           "when Append_Nul => False");
-          end if;
- 
-          for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
-             if TC_No_nul(i)       /= To_C(TC_char) or -- Single character To_C.
-                TC_nul_Appended(i) /= To_C(TC_char) then
-                Incorrect_Conversion := True;
-             end if;
-             i := i + 1;
-          end loop;
- 
-          if Incorrect_Conversion then
-             Report.Failed("Incorrect result from To_C with string input " &
-                           "and char_array result");
-          end if;
- 
- 
-          if TC_nul_Appended'Length /= TC_String'Length + 1 then
-             Report.Failed("Incorrect length returned from Function To_C " &
-                           "when Append_Nul => True");
-          end if;
- 
-          if not Is_Nul_Terminated(TC_nul_Appended) then
-             Report.Failed("No nul appended to the string parameter during " &
-                           "conversion to char_array by function To_C");
-          end if;
- 
- 
-          -- Check that the function To_Ada produces a string result with
-          -- lower bound of 1, and length dependent upon the Item and
-          -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
-          -- if True, length will be the length of the slice of Item prior to
-          -- the first nul).
- 
-          declare
-             TC_No_NUL_String       : constant String :=
-                                        To_Ada(Item     => TC_nul_Appended,
-                                               Trim_Nul => True);
-             TC_NUL_Appended_String : constant String :=
-                                        To_Ada(TC_nul_Appended, False);
-          begin
- 
-             if TC_No_NUL_String'First       /= 1 or
-                TC_NUL_Appended_String'First /= 1
-             then
-                Report.Failed("Incorrect lower bound from Function To_Ada");
-             end if;
- 
-             if TC_No_NUL_String'Length /= TC_String'Length then
-                Report.Failed("Incorrect length returned from Function " &
-                              "To_Ada when Trim_Nul => True");
-             end if;
- 
-             if TC_NUL_Appended_String'Length /= TC_String'Length + 1 then
-                Report.Failed("Incorrect length returned from Function " &
-                              "To_Ada when Trim_Nul => False");
-             end if;
- 
-             Start_Character := Report.Ident_Char('a');
-             Stop_Character  := Report.Ident_Char('h');
-             for TC_Character in Start_Character..Stop_Character loop
-                if TC_No_NUL_String(j)       /= TC_Character or
-                   TC_NUL_Appended_String(j) /= TC_Character
-                then
-                   Report.Failed("Incorrect result from To_Ada with " &
-                                 "char_array input, index = "         &
-                                 Integer'Image(j));
-                end if;
-                j := j + 1;
-             end loop;
- 
-          end;
- 
- 
-          -- Check that the function To_Ada raises Terminator_Error if the
-          -- parameter Trim_Nul is set to True, but the actual Item parameter
-          -- does not contain the nul char.
- 
-          begin
-             TC_String := To_Ada(TC_No_nul, Trim_Nul => True);
-             Report.Failed("Terminator_Error not raised when Item "    &
-                           "parameter of To_Ada does not contain the " &
-                           "nul char, but parameter Trim_Nul => True");
-             Report.Comment(TC_String & " printed to defeat optimization");
-          exception
-             when Terminator_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Incorrect exception raised by function "  &
-                              "To_Ada when the Item parameter does not " &
-                              "contain the nul char, but parameter "     &
-                              "Trim_Nul => True");
-          end;
- 
-       end;
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB30041;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,396 ****
- -- CXB3005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedure To_C converts the character elements of
- --      a string parameter into char elements of the char_array parameter
- --      Target, with nul termination if parameter Append_Nul is true.
- --
- --      Check that the out parameter Count of procedure To_C is set to the
- --      appropriate value for both the nul/no nul terminated cases.
- --
- --      Check that Constraint_Error is propagated by procedure To_C if the
- --      length of the char_array parameter Target is not sufficient to
- --      hold the converted string value.
- --
- --      Check that the Procedure To_Ada converts char elements of the
- --      char_array parameter Item to the corresponding character elements
- --      of string out parameter Target.
- --
- --      Check that Constraint_Error is propagated by Procedure To_Ada if the
- --      length of string parameter Target is not long enough to hold the
- --      converted char_array value.
- --
- --      Check that Terminator_Error is propagated by Procedure To_Ada if the
- --      parameter Trim_Nul is set to True, but the actual Item parameter
- --      contains no nul char.
- --
- -- TEST DESCRIPTION:
- --      This test uses a variety of String, and char_array objects to test
- --      versions of the To_C and To_Ada procedures.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '-'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.  If an implementation provides
- --      package Interfaces.C, this test must compile, execute, and
- --      report "PASSED".
- --
- -- CHANGE HISTORY:
- --      01 Sep 95   SAIC    Initial prerelease version.
- --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --      14 Sep 99   RLB     Removed incorrect and unnecessary
- --                          Unchecked_Conversion.
- --
- --!
- 
- with Report;
- with Interfaces.C;                                            -- N/A => ERROR
- with Ada.Characters.Latin_1;
- with Ada.Exceptions;
- with Ada.Strings.Fixed;
- 
- procedure CXB3005 is
- begin
- 
-    Report.Test ("CXB3005", "Check that the procedures To_C and To_Ada " &
-                            "produce correct results");
-    Test_Block:
-    declare
- 
-       use Interfaces, Interfaces.C;
-       use Ada.Characters;
-       use Ada.Exceptions;
-       use Ada.Strings.Fixed;
- 
-       TC_Short_String  : String(1..4)     := (others => 'x');
-       TC_String        : String(1..8)     := (others => 'y');
-       TC_char_array    : char_array(0..7) := (others => char'Last);
-       TC_size_t_Count  : size_t           := size_t'First;
-       TC_Natural_Count : Natural          := Natural'First;
- 
- 
-       -- We can use the character forms of To_Ada and To_C here to check
-       -- the results; they were tested in CXB3004. We give them different
-       -- names to avoid confusion below.
- 
-       function Character_to_char (Source : in Character) return char
-           renames To_C;
-       function char_to_Character (Source : in char) return Character
-           renames To_Ada;
- 
-    begin
- 
-       -- Check that the procedure To_C converts the character elements of
-       -- a string parameter into char elements of char_array out parameter
-       -- Target.
-       --
-       -- Case of nul termination.
- 
-       TC_String(1..6) := "abcdef";
- 
-       To_C (Item       => TC_String(1..6),  -- Source slice of length 6.
-             Target     => TC_char_array,    -- Length 8 will accommodate nul.
-             Count      => TC_size_t_Count,
-             Append_Nul => True);
- 
-       -- Check that the out parameter Count is set to the appropriate value
-       -- for the nul terminated case.
- 
-       if TC_size_t_Count /= 7 then
-          Report.Failed("Incorrect setting of out parameter Count by " &
-                        "Procedure To_C when Append_Nul => True");
-       end if;
- 
-       for i in 1..TC_size_t_Count-1 loop
-          if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
-          then
-             Report.Failed("Incorrect result from Procedure To_C when " &
-                           "checking individual char values, case of "  &
-                           "Append_Nul => True; "                       &
-                           "char position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if not Is_Nul_Terminated(TC_char_array) then
-          Report.Failed("No nul char appended to the char_array result " &
-                        "from Procedure To_C when Append_Nul => True");
-       end if;
- 
-       if TC_char_array(0..6) /= To_C("abcdef", True) then
-          Report.Failed("Incorrect result from Procedure To_C when "   &
-                        "directly comparing char_array results, case " &
-                        "of Append_Nul => True");
-       end if;
- 
- 
-       -- Check Procedure To_C with no nul termination.
- 
-       TC_char_array   := (others => Character_to_char('M')); -- Reinitialize.
-       TC_String(1..4) := "WXYZ";
- 
-       To_C (Item       => TC_String(1..4),  -- Source slice of length 4.
-             Target     => TC_char_array,
-             Count      => TC_size_t_Count,
-             Append_Nul => False);
- 
-       -- Check that the out parameter Count is set to the appropriate value
-       -- for the non-nul terminated case.
- 
-       if TC_size_t_Count /= 4 then
-          Report.Failed("Incorrect setting of out parameter Count by " &
-                        "Procedure To_C when Append_Nul => False");
-       end if;
- 
-       for i in 1..TC_size_t_Count loop
-          if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
-          then
-             Report.Failed("Incorrect result from Procedure To_C when " &
-                           "checking individual char values, case of "  &
-                           "Append_Nul => False; "                      &
-                           "char position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if Is_Nul_Terminated(TC_char_array) then
-          Report.Failed("The nul char was appended to the char_array " &
-                        "result of Procedure To_C when Append_Nul => False");
-       end if;
- 
-       if TC_char_array(0..3) /= To_C("WXYZ", False) then
-          Report.Failed("Incorrect result from Procedure To_C when "   &
-                        "directly comparing char_array results, case " &
-                        "of Append_Nul => False");
-       end if;
- 
- 
- 
-       -- Check that Constraint_Error is raised by procedure To_C if the
-       -- length of the target char_array parameter is not sufficient to
-       -- hold the converted string value (plus nul if Append_Nul is True).
- 
-       begin
-          To_C("A string too long",
-               TC_char_array,
-               TC_size_t_Count,
-               Append_Nul => True);
- 
-          Report.Failed("Constraint_Error not raised when the Target " &
-                        "parameter of Procedure To_C is not long enough " &
-                        "to hold the converted string");
-          Report.Comment(char_to_Character(TC_char_array(0)) &
-                         " printed to defeat optimization");
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by Procedure "    &
-                           "To_C when the Target parameter is not long " &
-                           "enough to contain the char_array result");
-       end;
- 
- 
- 
-       -- Check that the procedure To_Ada converts char elements of the
-       -- char_array parameter Item to the corresponding character elements
-       -- of string out parameter Target, with result string length based on
-       -- the Trim_Nul parameter.
-       --
-       -- Case of appended nul char on the char_array In parameter.
- 
-       TC_char_array := To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
-       TC_String     := (others => '*');                      -- Reinitialize.
- 
-       To_Ada (Item     => TC_char_array,
-               Target   => TC_String,
-               Count    => TC_Natural_Count,
-               Trim_Nul => False);
- 
-       if TC_Natural_Count /= 8 then
-          Report.Failed("Incorrect value returned in out parameter Count " &
-                        "by Procedure To_Ada, case of Trim_Nul => False");
-       end if;
- 
-       for i in 1..TC_Natural_Count loop
-          if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
-          then
-             Report.Failed("Incorrect result from Procedure To_Ada when " &
-                           "checking individual char values, case of "    &
-                           "Trim_Nul => False, when a nul is present in " &
-                           "the char_array input parameter; "             &
-                           "position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if TC_String(TC_Natural_Count) /= Latin_1.Nul then
-          Report.Failed("Last character of String result of Procedure "     &
-                        "To_Ada is not Nul, even though a nul was present " &
-                        "in the char_array argument, and the Trim_Nul "     &
-                        "parameter was set to False");
-       end if;
- 
- 
-       TC_char_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
-       TC_String           := (others => '*');                  -- Reinit.
- 
-       To_Ada (Item     => TC_char_array,
-               Target   => TC_String,
-               Count    => TC_Natural_Count,
-               Trim_Nul => True);
- 
-       if TC_Natural_Count /= 3 then
-          Report.Failed("Incorrect value returned in out parameter Count " &
-                        "by Procedure To_Ada, case of Trim_Nul => True");
-       end if;
- 
-       for i in 1..TC_Natural_Count loop
-          if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
-          then
-             Report.Failed("Incorrect result from Procedure To_Ada when " &
-                           "checking individual char values, case of "    &
-                           "Trim_Nul => True, when a nul is present in "  &
-                           "the char_array input parameter; "             &
-                           "position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if TC_String(TC_Natural_Count) = Latin_1.Nul then
-          Report.Failed("Last character of String result of Procedure " &
-                        "To_Ada is  Nul, even though the Trim_Nul "     &
-                        "parameter was set to True");
-       end if;
- 
-       -- Check that TC_String(TC_Natural_Count+1) is unchanged by procedure
-       -- To_Ada.
- 
-       if TC_String(TC_Natural_Count+1) /= '*' then
-          Report.Failed("Incorrect modification to TC_String at position " &
-                        Integer'Image(TC_Natural_Count+1) & " expected = " &
-                        "*, found = " & TC_String(TC_Natural_Count+1));
-       end if;
- 
- 
-       -- Case of no nul char being present in the char_array argument.
- 
-       TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
-       TC_String     := (others => '*');                  -- Reinitialize.
- 
-       To_Ada (Item     => TC_char_array,
-               Target   => TC_String,
-               Count    => TC_Natural_Count,
-               Trim_Nul => False);
- 
-       if TC_Natural_Count /= 8 then
-          Report.Failed("Incorrect value returned in out parameter Count " &
-                        "by Procedure To_Ada, case of Trim_Nul => False, " &
-                        "with no nul char present in the parameter Item");
-       end if;
- 
-       for i in 1..TC_Natural_Count loop
-          if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
-          then
-             Report.Failed("Incorrect result from Procedure To_Ada when "  &
-                           "checking individual char values, case of "     &
-                           "Trim_Nul => False, when a nul is not present " &
-                           "in the char_array input parameter; "           &
-                           "position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if TC_String(TC_Natural_Count) = Latin_1.Nul then
-          Report.Failed("Last character of String result of Procedure " &
-                        "To_Ada is Nul, even though the nul char was "  &
-                        "not present in the parameter Item, with the "  &
-                        "parameter Trim_Nul => False");
-       end if;
- 
- 
- 
-       -- Check that the Procedure To_Ada raises Terminator_Error if the
-       -- parameter Trim_Nul is set to True, but the actual Item parameter
-       -- does not contain the nul char.
- 
-       begin
-          TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
-          TC_String     := (others => '*');
- 
-          To_Ada(TC_char_array,
-                 TC_String,
-                 Count    => TC_Natural_Count,
-                 Trim_Nul => True);
- 
-          Report.Failed("Terminator_Error not raised when Item "    &
-                        "parameter of To_Ada does not contain the " &
-                        "nul char, but parameter Trim_Nul => True");
-          Report.Comment(TC_String & " printed to defeat optimization");
-       exception
-          when Terminator_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by Procedure " &
-                           "To_Ada when the Item parameter does not " &
-                           "contain the nul char, but parameter "     &
-                           "Trim_Nul => True");
-       end;
- 
- 
- 
-       -- Check that Constraint_Error is propagated by procedure To_Ada if the
-       -- length of string parameter Target is not long enough to hold the
-       -- converted char_array value (plus nul if Trim_Nul is False).
- 
-       begin
-          TC_char_array(0..4) := To_C ("ABCD", Append_Nul => True);
- 
-          To_Ada(TC_char_array(0..4),   -- 4 chars plus nul char.
-                 TC_Short_String,       -- Length of 4.
-                 Count    => TC_Natural_Count,
-                 Trim_Nul => False);
- 
-          Report.Failed("Constraint_Error not raised when string "     &
-                        "parameter Target of Procedure To_Ada is not " &
-                        "long enough to hold the converted chars");
-          Report.Comment(TC_Short_String & " printed to defeat optimization");
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by Procedure " &
-                           "To_Ada when string parameter Target is "  &
-                           "not long enough to hold the converted chars");
-       end;
- 
- 
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30060.c gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30060.c
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30060.c	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30060.c	Thu Jan  1 00:00:00 1970
***************
*** 1,174 ****
- /*
- -- CXB30060.C
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- FUNCTION NAME: CXB30060   ("wchar_gen")
- --
- -- FUNCTION DESCRIPTION:
- --      This C function returns the value of type wchar_t corresponding to the
- --      value of its parameter, where
- --          Val  0 ..  9 ==> '0' .. '9'
- --          Val 10 .. 19 ==> 'A' .. 'J'
- --          Val 20 .. 29 ==> 'k' .. 't'
- --          Val 30       ==> ' '
- --          Val 31       ==> '.'
- --          Val 32       ==> ','
- --
- -- INPUT:
- --      This function requires that one int parameter be passed to it.
- --
- -- OUTPUT:
- --      The function will return the appropriate value of type wchar_t.
- --
- -- CHANGE HISTORY:
- --      13 Sep 99   RLB     Created function to replace incorrect
- --                          Unchecked_Conversion.
- --
- --!
- */
- 
- #include <stddef.h>
- 
- wchar_t CXB30060 (int val)
- 
- /* NOTE: The above function definition should be accepted by an ANSI-C   */
- /*       compiler.  Older C compilers may reject it; they may, however   */
- /*       accept the following two lines.  An implementation may comment  */
- /*       out the above function definition and uncomment the following   */
- /*       one.  Otherwise, an implementation must provide the necessary   */
- /*       modifications to this C code to satisfy the function            */
- /*       requirements (see Function Description).                        */
- /*                                                                       */
- /*  wchar_t CXB30060 (val)                                               */
- /*     int     val;                                                      */
- /*                                                                       */
- 
- {  wchar_t return_value = ';';
- 
-    switch (val)
-    {
-       case 0:
-          return_value = '0';
-          break;
-       case 1:
-          return_value = '1';
-          break;
-       case 2:
-          return_value = '2';
-          break;
-       case 3:
-          return_value = '3';
-          break;
-       case 4:
-          return_value = '4';
-          break;
-       case 5:
-          return_value = '5';
-          break;
-       case 6:
-          return_value = '6';
-          break;
-       case 7:
-          return_value = '7';
-          break;
-       case 8:
-          return_value = '8';
-          break;
-       case 9:
-          return_value = '9';
-          break;
-       case 10:
-          return_value = 'A';
-          break;
-       case 11:
-          return_value = 'B';
-          break;
-       case 12:
-          return_value = 'C';
-          break;
-       case 13:
-          return_value = 'D';
-          break;
-       case 14:
-          return_value = 'E';
-          break;
-       case 15:
-          return_value = 'F';
-          break;
-       case 16:
-          return_value = 'G';
-          break;
-       case 17:
-          return_value = 'H';
-          break;
-       case 18:
-          return_value = 'I';
-          break;
-       case 19:
-          return_value = 'J';
-          break;
-       case 20:
-          return_value = 'k';
-          break;
-       case 21:
-          return_value = 'l';
-          break;
-       case 22:
-          return_value = 'm';
-          break;
-       case 23:
-          return_value = 'n';
-          break;
-       case 24:
-          return_value = 'o';
-          break;
-       case 25:
-          return_value = 'p';
-          break;
-       case 26:
-          return_value = 'q';
-          break;
-       case 27:
-          return_value = 'r';
-          break;
-       case 28:
-          return_value = 's';
-          break;
-       case 29:
-          return_value = 't';
-          break;
-       case 30:
-          return_value = ' ';
-          break;
-       case 31:
-          return_value = '.';
-          break;
-       case 32:
-          return_value = ',';
-          break;
-    }
- 
-    return (return_value); /* Return character value */
- }
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30061.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30061.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30061.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30061.am	Thu Jan  1 00:00:00 1970
***************
*** 1,404 ****
- -- CXB30061.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function To_C maps between the Ada type Wide_Character
- --      and the C type wchar_t.
- --
- --      Check that the function To_Ada maps between the C type wchar_t and
- --      the Ada type Wide_Character.
- --
- --      Check that the function Is_Nul_Terminated returns True if the
- --      wchar_array parameter contains wide_nul, and otherwise False.
- --
- --      Check that the function To_C produces a correct wchar_array result,
- --      with lower bound of 0, and length dependent upon the Item and
- --      Append_Nul parameters.
- --
- --      Check that the function To_Ada produces a correct wide_string result,
- --      with lower bound of 1, and length dependent upon the Item and
- --      Trim_Nul parameters.
- --
- --      Check that the function To_Ada raises Terminator_Error if the
- --      parameter Trim_Nul is set to True, but the actual Item parameter
- --      does not contain the wide_nul wchar_t.
- --
- -- TEST DESCRIPTION:
- --      This test uses a variety of Wide_Character, wchar_t, Wide_String, and
- --      wchar_array objects to test versions of the To_C, To_Ada, and
- --      Is_Nul_Terminated functions.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.wchar_t:
- --      ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.  If an implementation provides
- --      package Interfaces.C, this test must compile, execute, and
- --      report "PASSED".
- --
- -- SPECIAL REQUIREMENTS:
- --      The file CXB30060.C must be compiled with a C compiler.
- --      Implementation dialects of C may require alteration of
- --      the C program syntax (see individual C files).
- --
- --      Note that the compiled C code must be bound with the compiled Ada
- --      code to create an executable image.  An implementation must provide
- --      the necessary commands to accomplish this.
- --
- --      Note that the C code included in CXB30060.C conforms
- --      to ANSI-C.  Modifications to these files may be required for other
- --      C compilers.  An implementation must provide the necessary
- --      modifications to satisfy the function requirements.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         CXB30060.C
- --         CXB30061.AM
- --
- -- CHANGE HISTORY:
- --      07 Sep 95   SAIC    Initial prerelease version.
- --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      13 Sep 99   RLB     Replaced (bogus) Unchecked_Conversions with a
- --                          C function character generator.
- --
- --!
- 
- with Report;
- with Interfaces.C;                                            -- N/A => ERROR
- with Ada.Characters.Latin_1;
- with Ada.Characters.Handling;
- with Ada.Exceptions;
- with Ada.Strings.Wide_Fixed;
- with Impdef;
- 
- procedure CXB30061 is
- begin
- 
-    Report.Test ("CXB3006", "Check that the functions To_C and To_Ada " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces, Interfaces.C;
-       use Ada.Characters, Ada.Characters.Latin_1, Ada.Characters.Handling;
-       use Ada.Strings.Wide_Fixed;
- 
-       First_Character,
-       Last_Character  : Character;
-       TC_wchar_t,
-       TC_Low_wchar_t,
-       TC_High_wchar_t : wchar_t           := wchar_t'First;
-       TC_Wide_String  : Wide_String(1..8) := (others => Wide_Character'First);
-       TC_wchar_array  : wchar_array(0..7) := (others => C.wide_nul);
- 
-       -- The function Char_Gen returns a character corresponding to its
-       -- argument.
-       --     Value   0 ..  9 ==> '0' .. '9'
-       --     Value  10 .. 19 ==> 'A' .. 'J'
-       --     Value  20 .. 29 ==> 'k' .. 't'
-       --     Value  30       ==> ' '
-       --     Value  31       ==> '.'
-       --     Value  32       ==> ','
- 
-       function Char_Gen (Value   : in int) return wchar_t;
- 
-       -- Use the user-defined C function char_gen as a completion to the
-       -- function specification above.
- 
-       pragma Import (Convention    => C,
-                      Entity        => Char_Gen,
-                      External_Name => Impdef.CXB30060_External_Name);
- 
-    begin
- 
-       -- Check that the functions To_C and To_Ada map between the Ada type
-       -- Wide_Character and the C type wchar_t.
- 
-       if To_C(To_Wide_Character(Ada.Characters.Latin_1.NUL)) /=
-          Interfaces.C.wide_nul
-       then
-          Report.Failed("Incorrect result from To_C with NUL character input");
-       end if;
- 
-       First_Character := Report.Ident_Char('k');
-       Last_Character  := Report.Ident_Char('t');
-       for i in First_Character..Last_Character loop
-          if To_C(Item => To_Wide_Character(i)) /=
- 	    Char_Gen(Character'Pos(i) - Character'Pos('k') + 20)
-          then
-             Report.Failed("Incorrect result from To_C with lower case " &
-                           "alphabetic wide character input");
-          end if;
-       end loop;
- 
-       First_Character := Report.Ident_Char('A');
-       Last_Character  := Report.Ident_Char('J');
-       for i in First_Character..Last_Character loop
-          if To_C(Item => To_Wide_Character(i)) /=
- 	    Char_Gen(Character'Pos(i) - Character'Pos('A') + 10)
-          then
-             Report.Failed("Incorrect result from To_C with upper case " &
-                           "alphabetic wide character input");
-          end if;
-       end loop;
- 
-       First_Character := Report.Ident_Char('0');
-       Last_Character  := Report.Ident_Char('9');
-       for i in First_Character..Last_Character loop
-          if To_C(Item => To_Wide_Character(i)) /=
- 	    Char_Gen(Character'Pos(i) - Character'Pos('0'))
-          then
-             Report.Failed("Incorrect result from To_C with digit " &
-                           "wide character input");
-          end if;
-       end loop;
- 
-       if To_C(Item => To_Wide_Character(' ')) /= Char_Gen(30)
-       then
-             Report.Failed("Incorrect result from To_C with space " &
-                           "wide character input");
-       end if;
- 
-       if To_C(Item => To_Wide_Character('.')) /= Char_Gen(31)
-       then
-             Report.Failed("Incorrect result from To_C with dot " &
-                           "wide character input");
-       end if;
- 
-       if To_C(Item => To_Wide_Character(',')) /= Char_Gen(32)
-       then
-             Report.Failed("Incorrect result from To_C with comma " &
-                           "wide character input");
-       end if;
- 
-       if To_Ada(Interfaces.C.wide_nul) /=
-          To_Wide_Character(Ada.Characters.Latin_1.NUL)
-       then
-          Report.Failed("Incorrect result from To_Ada with wide_nul " &
-                        "wchar_t input");
-       end if;
- 
-       for Code in int range
-          int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
-             -- 'k' .. 't'
-          if To_Ada(Item => Char_Gen(Code)) /=
- 	    To_Wide_Character(Character'Val (Character'Pos('k') + (Code - 20)))
-          then
-             Report.Failed("Incorrect result from To_Ada with lower case " &
-                           "alphabetic wchar_t input");
-          end if;
-       end loop;
- 
-       for Code in int range
-          int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
-             -- 'A' .. 'J'
-          if To_Ada(Item => Char_Gen(Code)) /=
- 	    To_Wide_Character(Character'Val (Character'Pos('A') + (Code - 10)))
-          then
-             Report.Failed("Incorrect result from To_Ada with upper case " &
-                           "alphabetic wchar_t input");
-          end if;
-       end loop;
- 
-       for Code in int range
-          int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
-             -- '0' .. '9'
-          if To_Ada(Item => Char_Gen(Code)) /=
- 	    To_Wide_Character(Character'Val (Character'Pos('0') + (Code)))
-          then
-             Report.Failed("Incorrect result from To_Ada with digit " &
-                           "wchar_t input");
-          end if;
-       end loop;
- 
-       if To_Ada(Item => Char_Gen(30)) /= ' ' then
-          Report.Failed("Incorrect result from To_Ada with space " &
-                        "char input");
-       end if;
-       if To_Ada(Item => Char_Gen(31)) /= '.' then
-          Report.Failed("Incorrect result from To_Ada with dot " &
-                        "char input");
-       end if;
-       if To_Ada(Item => Char_Gen(32)) /= ',' then
-          Report.Failed("Incorrect result from To_Ada with comma " &
-                        "char input");
-       end if;
- 
-       -- Check that the function Is_Nul_Terminated produces correct results
-       -- whether or not the wchar_array argument contains the
-       -- Ada.Interfaces.C.wide_nul character.
- 
-       TC_Wide_String := "abcdefgh";
-       if Is_Nul_Terminated(Item => To_C(TC_Wide_String, Append_Nul => False))
-       then
-          Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
-                        "wide_nul wchar_t is present");
-       end if;
- 
-       if not Is_Nul_Terminated(To_C(TC_Wide_String, Append_Nul => True)) then
-          Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
-                        "wide_nul wchar_t is present");
-       end if;
- 
- 
- 
-       -- Now that we've tested the character/char versions of To_Ada and To_C,
-       -- use them to test the string versions.
- 
-       declare
-          i                    : size_t  := 0;
-          j                    : integer := 1;
-          Incorrect_Conversion : Boolean := False;
- 
-          TC_No_wide_nul       : constant wchar_array := To_C(TC_Wide_String,
-                                                              False);
-          TC_wide_nul_Appended : constant wchar_array := To_C(TC_Wide_String,
-                                                              True);
-       begin
- 
-          -- Check that the function To_C produces a wchar_array result with
-          -- lower bound of 0, and length dependent upon the Item and
-          -- Append_Nul parameters (if Append_Nul is True, length is
-          -- Item'Length + 1; if False, length is Item'Length).
- 
-          if TC_No_wide_nul'First /= 0 or TC_wide_nul_Appended'First /= 0 then
-             Report.Failed("Incorrect lower bound from Function To_C");
-          end if;
- 
-          if TC_No_wide_nul'Length /= TC_Wide_String'Length then
-             Report.Failed("Incorrect length returned from Function To_C " &
-                           "when Append_Nul => False");
-          end if;
- 
-          if TC_wide_nul_Appended'Length /= TC_Wide_String'Length + 1 then
-             Report.Failed("Incorrect length returned from Function To_C " &
-                           "when Append_Nul => True");
-          end if;
- 
-          if not Is_Nul_Terminated(TC_wide_nul_Appended) then
-             Report.Failed("No wide_nul appended to the wide_string "    &
-                           "parameter during conversion to wchar_array " &
-                           "by function To_C");
-          end if;
- 
-          for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
-             if TC_No_wide_nul(i)       /= To_C(To_Wide_Character(TC_char)) or
-                TC_wide_nul_Appended(i) /= To_C(To_Wide_Character(TC_char)) then
-                -- Use single character To_C.
-                Incorrect_Conversion := True;
-             end if;
-             i := i + 1;
-          end loop;
- 
-          if Incorrect_Conversion then
-             Report.Failed("Incorrect result from To_C with wide_string input " &
-                           "and wchar_array result");
-          end if;
- 
- 
-          -- Check that the function To_Ada produces a wide_string result with
-          -- lower bound of 1, and length dependent upon the Item and
-          -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
-          -- if False, length will be the length of the slice of Item prior to
-          -- the first wide_nul).
- 
-          declare
-             TC_No_NUL_Wide_String       : constant Wide_String :=
-               To_Ada(Item => TC_wide_nul_Appended, Trim_Nul => True);
- 
-             TC_NUL_Appended_Wide_String : constant Wide_String :=
-               To_Ada(TC_wide_nul_Appended, False);
- 
-          begin
- 
-             if TC_No_NUL_Wide_String'First       /= 1 or
-                TC_NUL_Appended_Wide_String'First /= 1
-             then
-                Report.Failed("Incorrect lower bound from Function To_Ada");
-             end if;
- 
-             if TC_No_NUL_Wide_String'Length /= TC_Wide_String'Length then
-                Report.Failed("Incorrect length returned from Function " &
-                              "To_Ada when Trim_Nul => True");
-             end if;
- 
-             if TC_NUL_Appended_Wide_String'Length /=
-                TC_Wide_String'Length + 1
-             then
-                Report.Failed("Incorrect length returned from Function " &
-                              "To_Ada when Trim_Nul => False");
-             end if;
- 
-             for TC_Character in Wide_Character'('a') .. Wide_Character'('h') loop
-                if TC_No_NUL_Wide_String(j)       /= TC_Character or
-                   TC_NUL_Appended_Wide_String(j) /= TC_Character
-                then
-                   Report.Failed("Incorrect result from To_Ada with " &
-                                 "char_array input, index = "         &
-                                 Integer'Image(j));
-                end if;
-                j := j + 1;
-             end loop;
- 
-          end;
- 
- 
-          -- Check that the function To_Ada raises Terminator_Error if the
-          -- parameter Trim_Nul is set to True, but the actual Item parameter
-          -- does not contain the wide_nul wchar_t.
- 
-          begin
-             TC_Wide_String := To_Ada(TC_No_wide_nul, Trim_Nul => True);
-             Report.Failed("Terminator_Error not raised when Item "    &
-                           "parameter of To_Ada does not contain the " &
-                           "wide_nul wchar_t, but parameter Trim_Nul " &
-                           "=> True");
-             Report.Comment
-               (To_String(TC_Wide_String) & " printed to defeat optimization");
-          exception
-             when Terminator_Error => null;  -- OK, expected exception.
-             when others           =>
-                Report.Failed("Incorrect exception raised by function "  &
-                              "To_Ada when the Item parameter does not " &
-                              "contain the wide_nul wchar_t, but "       &
-                              "parameter Trim_Nul => True");
-          end;
- 
-       end;
- 
-    exception
-       when The_Error : others =>
-          Report.Failed
-            ("The following exception was raised in the Test_Block: " &
-             Ada.Exceptions.Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB30061;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,408 ****
- -- CXB3007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedure To_C converts the Wide_Character elements
- --      of a Wide_String parameter into wchar_t elements of the wchar_array
- --      parameter Target, with wide_nul termination if parameter Append_Nul
- --      is true.
- --
- --      Check that the out parameter Count of procedure To_C is set to the
- --      appropriate value for both the wide_nul/no wide_nul terminated cases.
- --
- --      Check that Constraint_Error is propagated by procedure To_C if the
- --      length of the wchar_array parameter Target is not sufficient to
- --      hold the converted Wide_String value.
- --
- --      Check that the Procedure To_Ada converts wchar_t elements of the
- --      wchar_array parameter Item to the corresponding Wide_Character
- --      elements of Wide_String out parameter Target.
- --
- --      Check that Constraint_Error is propagated by Procedure To_Ada if the
- --      length of Wide_String parameter Target is not long enough to hold the
- --      converted wchar_array value.
- --
- --      Check that Terminator_Error is propagated by Procedure To_Ada if the
- --      parameter Trim_Nul is set to True, but the actual Item parameter
- --      contains no wide_nul wchar_t.
- --
- -- TEST DESCRIPTION:
- --      This test uses a variety of Wide_String, and wchar_array objects to
- --      test versions of the To_C and To_Ada procedures.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.wchar_t:
- --      ' ', 'a'..'z', 'A'..'Z', and '-'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.  If an implementation provides
- --      package Interfaces.C, this test must compile, execute, and
- --      report "PASSED".
- --
- -- CHANGE HISTORY:
- --      01 Sep 95   SAIC    Initial prerelease version.
- --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --      14 Sep 99   RLB     Removed incorrect and unnecessary
- --                          Unchecked_Conversion.
- --
- --!
- 
- with Report;
- with Interfaces.C;                                            -- N/A => ERROR
- with Ada.Characters.Latin_1;
- with Ada.Characters.Handling;
- with Ada.Exceptions;
- with Ada.Strings.Wide_Fixed;
- 
- procedure CXB3007 is
- begin
- 
-    Report.Test ("CXB3007", "Check that the procedures To_C and To_Ada " &
-                            "for wide strings produce correct results");
-    Test_Block:
-    declare
- 
-       use Interfaces, Interfaces.C;
-       use Ada.Characters, Ada.Characters.Handling;
-       use Ada.Exceptions;
-       use Ada.Strings.Wide_Fixed;
- 
-       TC_Short_Wide_String  : Wide_String(1..4) :=
-                                          (others => Wide_Character'First);
-       TC_Wide_String        : Wide_String(1..8) :=
-                                          (others => Wide_Character'First);
-       TC_wchar_array        : wchar_array(0..7) := (others => wchar_t'First);
-       TC_size_t_Count       : size_t            := size_t'First;
-       TC_Natural_Count      : Natural           := Natural'First;
- 
- 
-       -- We can use the wide character forms of To_Ada and To_C here to check
-       -- the results; they were tested in CXB3006. We give them different
-       -- names to avoid confusion below.
- 
-       function Wide_Character_to_wchar_t (Source : in Wide_Character)
-           return wchar_t renames To_C;
-       function wchar_t_to_Wide_Character (Source : in wchar_t)
-           return Wide_Character renames To_Ada;
- 
-    begin
- 
-       -- Check that the procedure To_C converts the Wide_Character elements
-       -- of a Wide_String parameter into wchar_t elements of wchar_array out
-       -- parameter Target.
-       --
-       -- Case of wide_nul termination.
- 
-       TC_Wide_String(1..6) := "abcdef";
- 
-       To_C (Item       => TC_Wide_String(1..6),  -- Source slice of length 6.
-             Target     => TC_wchar_array,
-             Count      => TC_size_t_Count,
-             Append_Nul => True);
- 
-       -- Check that the out parameter Count is set to the appropriate value
-       -- for the wide_nul terminated case.
- 
-       if TC_size_t_Count /= 7 then
-          Report.Failed("Incorrect setting of out parameter Count by " &
-                        "Procedure To_C when Append_Nul => True");
-       end if;
- 
-       for i in 1..TC_size_t_Count-1 loop
-          if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
-             TC_Wide_String(Integer(i))
-          then
-             Report.Failed("Incorrect result from Procedure To_C when "    &
-                           "checking individual wchar_t values, case of "  &
-                           "Append_Nul => True; "                          &
-                           "wchar_t position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if not Is_Nul_Terminated(TC_wchar_array) then
-          Report.Failed("No wide_nul wchar_t appended to the wchar_array " &
-                        "result from Procedure To_C when Append_Nul => True");
-       end if;
- 
-       if TC_wchar_array(0..6) /= To_C("abcdef", True) then
-          Report.Failed("Incorrect result from Procedure To_C when "   &
-                        "directly comparing wchar_array results, case " &
-                        "of Append_Nul => True");
-       end if;
- 
- 
-       -- Check Procedure To_C with no wide_nul termination.
- 
-       TC_wchar_array       := (others => Wide_Character_to_wchar_t('M'));
-       TC_Wide_String(1..4) := "WXYZ";
- 
-       To_C (Item       => TC_Wide_String(1..4),  -- Source slice of length 4.
-             Target     => TC_wchar_array,
-             Count      => TC_size_t_Count,
-             Append_Nul => False);
- 
-       -- Check that the out parameter Count is set to the appropriate value
-       -- for the non-wide_nul terminated case.
- 
-       if TC_size_t_Count /= 4 then
-          Report.Failed("Incorrect setting of out parameter Count by " &
-                        "Procedure To_C when Append_Nul => False");
-       end if;
- 
-       for i in 1..TC_size_t_Count loop
-          if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
-             TC_Wide_String(Integer(i))
-          then
-             Report.Failed("Incorrect result from Procedure To_C when "    &
-                           "checking individual wchar_t values, case of "  &
-                           "Append_Nul => False; "                         &
-                           "wchar_t position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if Is_Nul_Terminated(TC_wchar_array) then
-          Report.Failed
-            ("The wide_nul wchar_t was appended to the wchar_array " &
-             "result of Procedure To_C when Append_Nul => False");
-       end if;
- 
-       if TC_wchar_array(0..3) /= To_C("WXYZ", False) then
-          Report.Failed("Incorrect result from Procedure To_C when "    &
-                        "directly comparing wchar_array results, case " &
-                        "of Append_Nul => False");
-       end if;
- 
- 
- 
-       -- Check that Constraint_Error is raised by procedure To_C if the
-       -- length of the target wchar_array parameter is not sufficient to
-       -- hold the converted Wide_String value (plus wide_nul if Append_Nul
-       -- is True).
- 
-       TC_wchar_array := (others => wchar_t'First);
-       begin
-          To_C("A string too long",
-               TC_wchar_array,
-               TC_size_t_Count,
-               Append_Nul => True);
- 
-          Report.Failed("Constraint_Error not raised when the Target "    &
-                        "parameter of Procedure To_C is not long enough " &
-                        "to hold the converted Wide_String");
-          Report.Comment
-            (To_Character(wchar_t_to_Wide_Character(TC_wchar_array(0))) &
-             " printed to defeat optimization");
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by Procedure "    &
-                           "To_C when the Target parameter is not long " &
-                           "enough to contain the wchar_array result");
-       end;
- 
- 
- 
-       -- Check that the procedure To_Ada converts wchar_t elements of the
-       -- wchar_array parameter Item to the corresponding Wide_Character
-       -- elements of Wide_String out parameter Target, with result wide
-       -- string length based on the Trim_Nul parameter.
-       --
-       -- Case of appended wide_nul wchar_t on the wchar_array In parameter.
- 
-       TC_wchar_array :=
-         To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
- 
-       To_Ada (Item     => TC_wchar_array,
-               Target   => TC_Wide_String,
-               Count    => TC_Natural_Count,
-               Trim_Nul => False);
- 
-       if TC_Natural_Count /= 8 then
-          Report.Failed("Incorrect value returned in out parameter Count " &
-                        "by Procedure To_Ada, case of Trim_Nul => False");
-       end if;
- 
-       for i in 1..TC_Natural_Count loop
-          if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
-             TC_wchar_array(size_t(i-1))
-          then
-             Report.Failed("Incorrect result from Procedure To_Ada when "   &
-                           "checking individual wchar_t values, case of "   &
-                           "Trim_Nul => False, when a wide_nul is present " &
-                           "in the wchar_array input parameter; "           &
-                           "position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if TC_Wide_String(TC_Natural_Count) /= To_Wide_Character(Latin_1.Nul)
-       then
-          Report.Failed("Last Wide_Character of Wide_String result of "      &
-                        "Procedure To_Ada is not Nul, even though a "        &
-                        "wide_nul was present in the wchar_array argument, " &
-                        "and the Trim_Nul parameter was set to False");
-       end if;
- 
- 
-       TC_Wide_String       := (others => Wide_Character'First);
-       TC_wchar_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
- 
-       To_Ada (Item     => TC_wchar_array,
-               Target   => TC_Wide_String,
-               Count    => TC_Natural_Count,
-               Trim_Nul => True);
- 
-       if TC_Natural_Count /= 3 then
-          Report.Failed("Incorrect value returned in out parameter Count " &
-                        "by Procedure To_Ada, case of Trim_Nul => True");
-       end if;
- 
-       for i in 1..TC_Natural_Count loop
-          if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
-             TC_wchar_array(size_t(i-1))
-          then
-             Report.Failed("Incorrect result from Procedure To_Ada when "  &
-                           "checking individual wchar_t values, case of "  &
-                           "Trim_Nul => True, when a wide_nul is present " &
-                           "in the wchar_array input parameter; "          &
-                           "position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
-       then
-          Report.Failed("Last Wide_Character of Wide_String result of " &
-                        "Procedure To_Ada is  Nul, even though the "    &
-                        "Trim_Nul parameter was set to True");
-       end if;
- 
-       if TC_Wide_String(TC_Natural_Count+1) /= Wide_Character'First then
-          Report.Failed("Incorrect replacement from To_Ada");
-       end if;
- 
- 
-       -- Case of no wide_nul wchar_t present in the wchar_array argument.
- 
-       TC_Wide_String := (others => Wide_Character'First);
-       TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
- 
-       To_Ada (Item     => TC_wchar_array,
-               Target   => TC_Wide_String,
-               Count    => TC_Natural_Count,
-               Trim_Nul => False);
- 
-       if TC_Natural_Count /= 8 then
-          Report.Failed("Incorrect value returned in out parameter Count "   &
-                        "by Procedure To_Ada, case of Trim_Nul => False, "   &
-                        "with no wide_nul wchar_t present in the parameter " &
-                        "Item");
-       end if;
- 
-       for i in 1..TC_Natural_Count loop
-          if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
-             TC_wchar_array(size_t(i-1))
-          then
-             Report.Failed("Incorrect result from Procedure To_Ada when " &
-                           "checking individual wchar_t values, case of " &
-                           "Trim_Nul => False, when a wide_nul is not "   &
-                           "present in the wchar_array input parameter; " &
-                           "position = " & Integer'Image(Integer(i)));
-          end if;
-       end loop;
- 
-       if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
-       then
-          Report.Failed("Last Wide_Character of Wide_String result of "      &
-                        "Procedure To_Ada is Nul, even though the wide_nul " &
-                        "wchar_t was not present in the parameter Item, "    &
-                        "with the parameter Trim_Nul => False");
-       end if;
- 
- 
- 
-       -- Check that the Procedure To_Ada raises Terminator_Error if the
-       -- parameter Trim_Nul is set to True, but the actual Item parameter
-       -- does not contain the wide_nul wchar_t.
- 
-       begin
-          TC_Wide_String := (others => Wide_Character'First);
-          TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
- 
-          To_Ada(TC_wchar_array,
-                 TC_Wide_String,
-                 Count    => TC_Natural_Count,
-                 Trim_Nul => True);
- 
-          Report.Failed("Terminator_Error not raised when Item "    &
-                        "parameter of To_Ada does not contain the " &
-                        "wide_nul wchar_t, but parameter Trim_Nul => True");
-          Report.Comment(To_String(TC_Wide_String) &
-                         " printed to defeat optimization");
-       exception
-          when Terminator_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by Procedure "     &
-                           "To_Ada when the Item parameter does not "     &
-                           "contain the wide_nul wchar_t, but parameter " &
-                           "Trim_Nul => True");
-       end;
- 
- 
- 
-       -- Check that Constraint_Error is propagated by procedure To_Ada if the
-       -- length of Wide_String parameter Target is not long enough to hold the
-       -- converted wchar_array value (plus wide_nul if Trim_Nul is False).
- 
-       begin
-          TC_wchar_array(0..4) := To_C ("ABCD", Append_Nul => True);
- 
-          To_Ada(TC_wchar_array(0..4),
-                 TC_Short_Wide_String, -- Length of 4.
-                 Count    => TC_Natural_Count,
-                 Trim_Nul => False);
- 
-          Report.Failed("Constraint_Error not raised when Wide_String " &
-                        "parameter Target of Procedure To_Ada is not "  &
-                        "long enough to hold the converted wchar_ts");
-          Report.Comment(To_String(TC_Short_Wide_String) &
-                         " printed to defeat optimization");
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by Procedure "      &
-                           "To_Ada when Wide_String parameter Target is "  &
-                           "not long enough to hold the converted wchar_ts");
-       end;
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,226 ****
- -- CXB3008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that functions imported from the C language <string.h> and
- --      <stdlib.h> libraries can be called from an Ada program.
- --      
- -- TEST DESCRIPTION:
- --      This test checks that C language functions from the <string.h> and
- --      <stdlib.h> libraries can be used as completions of Ada subprograms.
- --      A pragma Import with convention identifier "C" is used to complete
- --      the Ada subprogram specifications.
- --      The three subprogram cases tested are as follows:
- --      1) A C function that returns an int value (strcpy) is used as the
- --         completion of an Ada procedure specification.  The return value
- --         is discarded; parameter modification is the desired effect.
- --      2) A C function that returns an int value (strlen) is used as the
- --         completion of an Ada function specification.
- --      3) A C function that returns a double value (strtod) is used as the
- --         completion of an Ada function specification.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '$'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      packages Interfaces.C and Interfaces.C.Strings.  If an 
- --      implementation provides these packages, this test must compile, 
- --      execute, and report "PASSED".
- --
- -- SPECIAL REQUIREMENTS:
- --      The C language library functions used by this test must be 
- --      available for importing into the test.
- --
- --       
- -- CHANGE HISTORY:
- --      12 Oct 95   SAIC    Initial prerelease version.
- --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      01 DEC 97   EDS     Replaced all references of C function atof with
- --                          C function strtod.
- --      29 JUN 98   EDS     Give Ada function corresponding to strtod a 
- --                          second parameter.
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.C;                                            -- N/A => ERROR
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- with Interfaces.C.Pointers;
- 
- procedure CXB3008 is
- begin
- 
-    Report.Test ("CXB3008", "Check that functions imported from the " &
-                            "C language predefined libraries can be " &
-                            "called from an Ada program");
- 
-    Test_Block:
-    declare
- 
-       package IC  renames Interfaces.C;
-       package ICS renames Interfaces.C.Strings;
-       package ICP is new Interfaces.C.Pointers
-          ( Index => IC.size_t,
-            Element => IC.char,
-            Element_Array => IC.char_array,
-            Default_Terminator => IC.nul );
-       use Ada.Exceptions;
- 
-       use type IC.char;
-       use type IC.char_array;
-       use type IC.size_t;
-       use type IC.double;
- 
-       -- The String_Copy procedure copies the string pointed to by Source, 
-       -- including the terminating nul char, into the char_array pointed
-       -- to by Target.
- 
-       procedure String_Copy (Target : out IC.char_array;
-                              Source : in  IC.char_array);
- 
-       -- The String_Length function returns the length of the nul-terminated 
-       -- string pointed to by The_String.  The nul is not included in
-       -- the count.
- 
-       function String_Length (The_String : in IC.char_array) 
-         return IC.size_t;
- 
-       -- The String_To_Double function converts the char_array pointed to
-       -- by The_String into a double value returned through the function
-       -- name.  The_String must contain a valid floating-point number; if
-       -- not, the value returned is zero.
- 
- --      type Acc_ptr is access IC.char_array;
-       function String_To_Double (The_String : in IC.char_array ; 
-                                  End_Ptr    : ICP.Pointer := null) 
-         return IC.double;
- 
- 
-       -- Use the <string.h> strcpy function as a completion to the procedure
-       -- specification.  Note that the Ada interface to this C function is
-       -- in the form of a procedure (C function return value is not used).
- 
-       pragma Import (C, String_Copy, "strcpy");
- 
-       -- Use the <string.h> strlen function as a completion to the
-       -- String_Length function specification.
- 
-       pragma Import (C, String_Length, "strlen");
- 
-       -- Use the <stdlib.h> strtod function as a completion to the 
-       -- String_To_Double function specification.
- 
-       pragma Import (C, String_To_Double, "strtod");
- 
- 
-       TC_String     : constant String := "Just a Test";
-       Char_Source   : IC.char_array(0..30);
-       Char_Target   : IC.char_array(0..30);
-       Double_Result : IC.double;
-       Source_Ptr,
-       Target_Ptr    : ICS.chars_ptr;
- 
-    begin
- 
-       -- Check that the imported version of C function strcpy produces 
-       -- the correct results.
- 
-       Char_Source(0..21) := "Test of Pragma Import" & IC.nul;
- 
-       String_Copy(Char_Target, Char_Source);
- 
-       if Char_Target(0..21) /= Char_Source(0..21) then
-          Report.Failed("Incorrect result from the imported version of " &
-                        "strcpy - 1");
-       end if;
- 
-       if String_Length(Char_Target) /= 21 then
-          Report.Failed("Incorrect result from the imported version of " &
-                        "strlen - 1");
-       end if;
- 
-       Char_Source(0) := IC.nul;
- 
-       String_Copy(Char_Target, Char_Source);
- 
-       if Char_Target(0) /= Char_Source(0) then
-          Report.Failed("Incorrect result from the imported version of " &
-                        "strcpy - 2");
-       end if;
- 
-       if String_Length(Char_Target) /= 0 then
-          Report.Failed("Incorrect result from the imported version of " &
-                        "strlen - 2");
-       end if;
- 
-       -- The following chars_ptr designates a char_array of 12 chars 
-       -- (including the terminating nul char).
-       Source_Ptr := ICS.New_Char_Array(IC.To_C(TC_String));  
- 
-       String_Copy(Char_Target, ICS.Value(Source_Ptr));
- 
-       Target_Ptr := ICS.New_Char_Array(Char_Target);
- 
-       if ICS.Value(Target_Ptr) /= TC_String then
-          Report.Failed("Incorrect result from the imported version of " &
-                        "strcpy - 3");
-       end if;
-          
-       if String_Length(ICS.Value(Target_Ptr)) /= TC_String'Length then
-          Report.Failed("Incorrect result from the imported version of " &
-                        "strlen - 3");
-       end if;
- 
- 
-       Char_Source(0..9) := "100.00only";
- 
-       Double_Result := String_To_Double(Char_Source);
- 
-       Char_Source(0..13) := "5050.00$$$$$$$";
- 
-       if Double_Result + String_To_Double(Char_Source) /= 5150.00 then
-          Report.Failed("Incorrect result returned from the imported " &
-                        "version of function strtod - 1");
-       end if;
- 
-       Char_Source(0..9) := "xxx$10.00x";  -- String doesn't contain a
-                                           -- valid floating point value.
-       if String_To_Double(Char_Source) /= 0.0 then
-          Report.Failed("Incorrect result returned from the imported " &
-                        "version of function strtod - 2");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,305 ****
- -- CXB3009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function To_Chars_Ptr will return a Null_Ptr value
- --      when the parameter Item is null.  If the parameter Item is not null,
- --      and references a chars_array object that does contain the char nul,
- --      and parameter Nul_Check is True, check that To_Chars_Ptr performs a
- --      pointer conversion from char_array_access type to chars_ptr type.
- --      Check that if parameter Item is not null, and references a
- --      chars_array object that does not contain nul, and parameter Nul_Check
- --      is True, the To_Chars_Ptr function will propagate Terminator_Error.
- --      Check that if parameter Item is not null, and parameter Nul_Check
- --      is False, check that To_Chars_Ptr performs a pointer conversion from
- --      char_array_access type to chars_ptr type.
- --
- --      Check that the New_Char_Array function will return a chars_ptr type
- --      pointer to an allocated object that has been initialized with
- --      the value of parameter Chars.
- --
- --      Check that the function New_String returns a chars_ptr initialized
- --      to a nul-terminated string having the value of the Str parameter.
- --
- -- TEST DESCRIPTION:
- --      This test uses a variety of of string, char_array,
- --      char_array_access and char_ptr values in order to validate the
- --      functions under test, and results are compared for both length
- --      and content.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', and 'A'.. 'Z'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.Strings.  If an implementation provides
- --      package Interfaces.C.Strings, this test must compile, execute, and
- --      report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      20 Sep 95   SAIC    Initial prerelease version.
- --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      01 DEC 97   EDS     Remove incorrect block of code (previously
- --                          lines 264-287)
- --      14 Sep 99   RLB     Added check for behavior of To_Chars_Ptr when
- --                          Nul_Check => False. (From Technical
- --                          Corrigendum 1).
- --!
- 
- with Report;
- with Interfaces.C.Strings;                                   -- N/A => ERROR
- with Ada.Characters.Latin_1;
- with Ada.Exceptions;
- with Ada.Strings.Fixed;
- 
- procedure CXB3009 is
- begin
- 
-    Report.Test ("CXB3009", "Check that functions To_Chars_Ptr, "      &
-                            "New_Chars_Array, and New_String produce " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       package IC  renames Interfaces.C;
-       package ICS renames Interfaces.C.Strings;
-       use Ada.Exceptions;
- 
-       use type IC.char_array;
-       use type IC.size_t;
-       use type ICS.chars_ptr;
- 
-       Null_Char_Array_Access : constant ICS.char_array_access := null;
- 
-       Test_String            : constant String := "Test String";
-       String_With_nul        : String(1..6)    := "Addnul";
-       String_Without_nul     : String(1..6)    := "No nul";
- 
-       Char_Array_With_nul    : IC.char_array(0..6)   :=
-                                  IC.To_C(String_With_nul, True);
-       Char_Array_Without_nul : IC.char_array(0..5)   :=
-                                  IC.To_C(String_Without_nul, False);
-       Char_Array_W_nul_Ptr   : ICS.char_array_access :=
-                                  new IC.char_array'(Char_Array_With_nul);
-       Char_Array_WO_nul_Ptr  : ICS.char_array_access :=
-                                  new IC.char_array'(Char_Array_Without_nul);
- 
-       TC_chars_ptr           : ICS.chars_ptr;
- 
-       TC_size_t              : IC.size_t := IC.size_t'First;
- 
- 
-    begin
- 
-       -- Check that the function To_Chars_Ptr will return a Null_Ptr value
-       -- when the parameter Item is null.
- 
-       if ICS.To_Chars_Ptr(Item      => Null_Char_Array_Access,
-                           Nul_Check => False)     /= ICS.Null_Ptr   or
-          ICS.To_Chars_Ptr(Null_Char_Array_Access,
-                           Nul_Check => True)      /= ICS.Null_Ptr   or
-          ICS.To_Chars_Ptr(Null_Char_Array_Access) /= ICS.Null_Ptr
-       then
-          Report.Failed("Incorrect result from function To_Chars_Ptr " &
-                        "with parameter Item being a null value");
-       end if;
- 
- 
-       -- Check that if the parameter Item is not null, and references a
-       -- chars_array object that does contain the nul char, and parameter
-       -- Nul_Check is True, function To_Chars_Ptr performs a pointer
-       -- conversion from char_array_access type to chars_ptr type.
- 
-       begin
-          TC_chars_ptr := ICS.To_Chars_Ptr(Item      => Char_Array_W_nul_Ptr,
-                                           Nul_Check => True);
- 
-          if ICS.Value(TC_chars_ptr) /= String_With_nul     or
-             ICS.Value(TC_chars_ptr) /= Char_Array_With_nul
-          then
-             Report.Failed("Incorrect result from function To_Chars_Ptr " &
-                           "with parameter Item being non-null and "      &
-                           "containing the nul char");
-          end if;
-       exception
-          when IC.Terminator_Error =>
-            Report.Failed("Terminator_Error raised during the validation " &
-                          "of Function To_Chars_Ptr");
-          when others           =>
-            Report.Failed("Unexpected exception raised during the " &
-                          "validation of Function To_Chars_Ptr");
-       end;
- 
-       -- Check that if parameter Item is not null, and references a
-       -- chars_array object that does not contain nul, and parameter
-       -- Nul_Check is True, the To_Chars_Ptr function will propagate
-       -- Terminator_Error.
- 
-       begin
-          TC_chars_ptr   := ICS.To_Chars_Ptr(Char_Array_WO_nul_Ptr, True);
-          Report.Failed("Terminator_Error was not raised by function "   &
-                        "To_Chars_Ptr when given a parameter Item that " &
-                        "is non-null, and does not contain the nul "     &
-                        "char, but parameter Nul_Check is True");
-          TC_size_t := ICS.Strlen(TC_chars_ptr); -- Use TC_chars_ptr to
-                                                 -- defeat optimization;
-       exception
-           when IC.Terminator_Error => null;     -- Expected exception.
-           when others              =>
-              Report.Failed("Incorrect exception raised when function "    &
-                            "To_Chars_Ptr is given a parameter Item that " &
-                            "is non-null, and does not contain the nul "   &
-                            "char, but parameter Nul_Check is True");
-       end;
- 
-       -- Check that if the parameter Item is not null, and parameter
-       -- Nul_Check is False, function To_Chars_Ptr performs a pointer
-       -- conversion from char_array_access type to chars_ptr type.
- 
-       begin
-          TC_chars_ptr := ICS.To_Chars_Ptr(Item      => Char_Array_WO_nul_Ptr,
-                                           Nul_Check => False);
- 
-          if ICS.Value(TC_chars_ptr, 6) /= String_Without_nul     or
-             ICS.Value(TC_chars_ptr, 6) /= Char_Array_Without_nul
-          then
-             Report.Failed("Incorrect result from function To_Chars_Ptr " &
-                           "with parameter Item being non-null and "      &
-                           "Nul_Check False");
-          end if;
-       exception
-          when IC.Terminator_Error =>
-            Report.Failed("Terminator_Error raised during the validation " &
-                          "of Function To_Chars_Ptr");
-          when others           =>
-            Report.Failed("Unexpected exception raised during the " &
-                          "validation of Function To_Chars_Ptr");
-       end;
- 
- 
-       -- Check that the New_Char_Array function will return a chars_ptr type
-       -- pointer to an allocated object that has been initialized with
-       -- the value of parameter Chars.
-       TC_chars_ptr := ICS.New_String("");
-       ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
- 
-       if TC_chars_ptr /= ICS.Null_Ptr then
-          Report.Failed("Reset of TC_chars_ptr to Null not successful - 1");
-       end if;
- 
-       TC_chars_ptr := ICS.New_Char_Array(Chars => Char_Array_With_nul);
- 
-       if TC_chars_ptr = ICS.Null_Ptr then    -- Check allocation.
-          Report.Failed
-            ("No allocation took place in call to New_Char_Array " &
-             "with a non-null char_array parameter containing a "  &
-             "terminating nul char");
-       end if;
- 
-       -- Length of allocated array is determined using Strlen since array
-       -- is nul terminated.  Contents of array are validated using Value.
- 
-       if ICS.Value (TC_chars_ptr, Length => 7) /= Char_Array_With_nul  or
-          ICS.Strlen(Item => TC_chars_ptr)      /= 6
-       then
-          Report.Failed
-            ("Incorrect length of allocated char_array resulting " &
-             "from call of New_Char_Array with a non-null "        &
-             "char_array parameter containing a terminating nul char");
-       end if;
- 
-       ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
-       if TC_chars_ptr /= ICS.Null_Ptr then
-          Report.Failed("Reset of TC_chars_ptr to Null not successful - 2");
-       end if;
- 
-       TC_chars_ptr := ICS.New_Char_Array(Chars => Char_Array_Without_nul);
- 
-       if TC_chars_ptr = ICS.Null_Ptr then    -- Check allocation.
-          Report.Failed
-            ("No allocation took place in call to New_Char_Array " &
-             "with a non-null char_array parameter that did not "  &
-             "contain a terminating nul char");
-       end if;
- 
-       -- Function Value is used with the total length of the
-       -- Char_Array_Without_nul as a parameter to verify the allocation.
- 
-       if ICS.Value(Item => TC_chars_ptr, Length => 6) /=
-          Char_Array_Without_nul                            or
-          ICS.Strlen(Item => TC_chars_ptr)             /= 6
-       then
-          Report.Failed("Incorrect length of allocated char_array "     &
-                        "resulting from call of New_Char_Array with "   &
-                        "a non-null char_array parameter that did not " &
-                        "contain a terminating nul char");
-       end if;
- 
- 
-       -- Check that the function New_String returns a chars_ptr specifying
-       -- an allocated object initialized to the value of parameter Str.
- 
-       ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
-       if TC_chars_ptr /= ICS.Null_Ptr then
-          Report.Failed("Reset of TC_chars_ptr to Null not successful - 3");
-       end if;
- 
-       TC_chars_ptr := ICS.New_String(Str => Test_String);
- 
-       if ICS.Value(TC_chars_ptr) /= Test_String or
-          ICS.Value(ICS.New_Char_Array(IC.To_C(Test_String,True))) /=
-          Test_String
-       then
-          Report.Failed("Incorrect allocation resulting from function " &
-                        "New_String with a string parameter value");
-       end if;
- 
-       ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
-       if TC_chars_ptr /= ICS.Null_Ptr then
-          Report.Failed("Reset of TC_chars_ptr to Null not successful - 4");
-       end if;
- 
-       if ICS.Value(ICS.New_String(String_Without_nul)) /=
-          String_Without_nul                               or
-          ICS.Value(ICS.New_Char_Array(IC.To_C(String_Without_nul,False))) /=
-          String_Without_nul
-       then
-          Report.Failed("Incorrect allocation resulting from function " &
-                        "New_String with parameter value String_Without_nul");
-       end if;
- 
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,320 ****
- -- CXB3010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the Procedure Free resets the parameter Item to
- --      Null_Ptr.  Check that Free has no effect if Item is Null_Ptr.
- --
- --      Check that the version of Function Value with a chars_ptr parameter
- --      returning a char_array result returns the prefix of an array of
- --      chars.
- --
- --      Check that the version of Function Value with a chars_ptr parameter
- --      and a size_t parameter returning a char_array result returns
- --      the shorter of:
- --        1) the first size_t number of characters, or
- --        2) the characters up to and including the first nul.
- --
- --      Check that both of the above versions of Function Value propagate
- --      Dereference_Error if the Item parameter is Null_Ptr.
- --
- -- TEST DESCRIPTION:
- --      This test validates the Procedure Free and two versions of Function
- --      Value.  A variety of char_array and char_ptr values are provided as
- --      input, and results are compared for both length and content.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', and 'A'..'Z'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.Strings.  If an implementation provides
- --      package Interfaces.C.Strings, this test must compile, execute,
- --      and report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      27 Sep 95   SAIC    Initial prerelease version.
- --      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --      01 DEC 97   EDS     Replicate line 199 at line 256, to ensure that
- --                          TC_chars_ptr has a valid pointer.
- --      08 JUL 99   RLB     Added a test case to check that Value raises
- --                          Constraint_Error when Length = 0. (From Technical
- --                          Corrigendum 1).
- --      25 JAN 01   RLB     Repaired previous test case to avoid raising
- --                          Constraint_Error in test case code.
- --      26 JAN 01   RLB     Added an Ident_Int to the test case to prevent
- --                          optimization.
- 
- --!
- 
- with Report;
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- 
- procedure CXB3010 is
- begin
- 
-    Report.Test ("CXB3010", "Check that Procedure Free and versions of " &
-                            "Function Value produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package IC  renames Interfaces.C;
-       package ICS renames Interfaces.C.Strings;
- 
-       use type IC.char_array;
-       use type IC.size_t;
-       use type ICS.chars_ptr;
-       use type IC.char;
- 
-       Null_Char_Array_Access : constant ICS.char_array_access := null;
- 
-       TC_String_1            : constant String       := "Nonul";
-       TC_String_2            : constant String       := "AbCdE";
-       TC_Blank_String        : constant String(1..5) := (others => ' ');
- 
-       -- The initialization of the following char_array objects
-       -- includes the appending of a terminating nul char, in order to
-       -- prevent the erroneous execution of Function Value.
- 
-       TC_char_array          : IC.char_array :=
-                                  IC.To_C(TC_Blank_String, True);
-       TC_char_array_1        : constant IC.char_array :=
-                                           IC.To_C(TC_String_1, True);
-       TC_char_array_2        : constant IC.char_array :=
-                                           IC.To_C(TC_String_2, True);
-       TC_Blank_char_array    : constant IC.char_array :=
-                                           IC.To_C(TC_Blank_String, True);
- 
-       -- This chars_ptr is initialized via the use of New_Chars_Array to
-       -- avoid erroneous execution of procedure Free.
-       TC_chars_ptr           : ICS.chars_ptr :=
-                                  ICS.New_Char_Array(TC_Blank_char_array);
- 
-    begin
- 
-       -- Check that the Procedure Free resets the parameter Item
-       -- to Null_Ptr.
- 
-       if TC_chars_ptr = ICS.Null_Ptr then
-          Report.Failed("TC_chars_ptr is currently null; it should not be " &
-                        "null since it was given default initialization");
-       end if;
- 
-       ICS.Free(TC_chars_ptr);
- 
-       if TC_chars_ptr /= ICS.Null_Ptr then
-          Report.Failed("TC_chars_ptr was not set to Null_Ptr by " &
-                        "Procedure Free");
-       end if;
- 
-       -- Check that Free has no effect if Item is Null_Ptr.
- 
-       begin
-          TC_chars_ptr := ICS.Null_Ptr;  -- Ensure pointer is null.
-          ICS.Free(TC_chars_ptr);
-          if TC_chars_ptr /= ICS.Null_Ptr then
-             Report.Failed("TC_chars_ptr was set to a non-Null_Ptr value "  &
-                           "by Procedure Free.  It was provided as a null " &
-                           "parameter to Free, and there should have been " &
-                           "no effect from a call to Procedure Free");
-          end if;
-       exception
-          when others =>
-            Report.Failed("Unexpected exception raised by Procedure Free " &
-                          "when parameter Item is Null_Ptr");
-       end;
- 
- 
-       -- Check that the version of Function Value with a chars_ptr parameter
-       -- that returns a char_array result returns an array of chars (up to
-       -- and including the first nul).
- 
-       TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_1);
-       TC_char_array := ICS.Value(Item => TC_chars_ptr);
- 
-       if TC_char_array                  /= TC_char_array_1            or
-          IC.To_Ada(TC_char_array, True) /= IC.To_Ada(TC_char_array_1)
-       then
-          Report.Failed("Incorrect result from Function Value - 1");
-       end if;
- 
-       TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_2);
-       TC_char_array := ICS.Value(Item => TC_chars_ptr);
- 
-       if TC_char_array                  /= TC_char_array_2            or
-          IC.To_Ada(TC_char_array, True) /= IC.To_Ada(TC_char_array_2)
-       then
-          Report.Failed("Incorrect result from Function Value - 2");
-       end if;
- 
-       if ICS.Value(Item => ICS.New_String("A little longer string")) /=
-          IC.To_C("A little longer string")
-       then
-          Report.Failed("Incorrect result from Function Value - 3");
-       end if;
- 
- 
-       -- Check that the version of Function Value with a chars_ptr parameter
-       -- and a size_t parameter that returns a char_array result returns
-       -- the shorter of:
-       --   1) the first size_t number of characters, or
-       --   2) the characters up to and including the first nul.
- 
-       -- Case 1: the first size_t number of characters (less than the
-       --         total length).
- 
-       begin
-          TC_chars_ptr        := ICS.New_Char_Array(TC_char_array_1);
-          TC_char_array(0..2) := ICS.Value(Item => TC_chars_ptr, Length => 3);
- 
-          if TC_char_array(0..2) /= TC_char_array_1(0..2)
-          then
-             Report.Failed
-               ("Incorrect result from Function Value with Length " &
-                "parameter - 1");
-          end if;
-       exception
-          when others =>
-            Report.Failed("Exception raised during Case 1 evaluation");
-       end;
- 
-       -- Case 2: the characters up to and including the first nul.
- 
-       TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_2);
- 
-       -- The length supplied as a parameter exceeds the total length of
-       -- TC_char_array_2.  The result should be the entire TC_char_array_2
-       -- including the terminating nul.
- 
-       TC_char_array := ICS.Value(Item => TC_chars_ptr, Length => 7);
- 
-       if TC_char_array            /= TC_char_array_2            or
-          IC.To_Ada(TC_char_array) /= IC.To_Ada(TC_char_array_2) or
-          not (IC.Is_Nul_Terminated(TC_char_array))
-       then
-          Report.Failed("Incorrect result from Function Value with Length " &
-                        "parameter - 2");
-       end if;
- 
- 
-       -- Check that both of the above versions of Function Value propagate
-       -- Dereference_Error if the Item parameter is Null_Ptr.
- 
-       declare
- 
-          -- Declare a dummy function to demonstrate one way that a chars_ptr
-          -- variable could inadvertantly be set to Null_Ptr prior to a call
-          -- to Value (below).
-          function Freedom (Condition : Boolean := False;
-                            Ptr       : ICS.chars_ptr) return ICS.chars_ptr is
-             Pointer : ICS.chars_ptr := Ptr;
-          begin
-             if Condition then
-                ICS.Free(Pointer);
-             else
-                null; -- An activity that doesn't set the chars_ptr value to
-                      -- Null_Ptr.
-             end if;
-             return Pointer;
-          end Freedom;
- 
-       begin
- 
-          begin
-             TC_char_array := ICS.Value(Item => Freedom(True, TC_chars_ptr));
-             Report.Failed
-               ("Function Value (without Length parameter) did not " &
-                "raise Dereference_Error when provided a null Item " &
-                "parameter input value");
-             if TC_char_array(0) = '6' then   -- Defeat optimization.
-                Report.Comment("Should never be printed");
-             end if;
-          exception
-             when ICS.Dereference_Error => null;  -- OK, expected exception.
-             when others                =>
-               Report.Failed("Incorrect exception raised by Function Value " &
-                             "with Item parameter, when the Item parameter " &
-                             "is Null_Ptr");
-          end;
- 
-          TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_2);
-          begin
-             TC_char_array := ICS.Value(Item   => Freedom(True, TC_chars_ptr),
-                                        Length => 4);
-             Report.Failed
-               ("Function Value (with Length parameter) did not "    &
-                "raise Dereference_Error when provided a null Item " &
-                "parameter input value");
-             if TC_char_array(0) = '6' then   -- Defeat optimization.
-                Report.Comment("Should never be printed");
-             end if;
-          exception
-             when ICS.Dereference_Error => null;  -- OK, expected exception.
-             when others                =>
-               Report.Failed("Incorrect exception raised by Function Value " &
-                             "with both Item and Length parameters, when "   &
-                             "the Item parameter is Null_Ptr");
-          end;
-       end;
- 
-       -- Check that Function Value with two parameters propagates
-       -- Constraint_Error if Length is 0.
- 
-       begin
-          TC_chars_ptr        := ICS.New_Char_Array(TC_char_array_1);
- 	 declare
- 	    TC : IC.char_array := ICS.Value(Item => TC_chars_ptr, Length =>
- 		IC.Size_T(Report.Ident_Int(0)));
- 	 begin
-              Report.Failed
-                  ("Function Value (with Length parameter) did not "    &
-                   "raise Constraint_Error when Length = 0");
-              if TC'Length <= TC_char_array'Length then
-                 TC_char_array(1..TC'Length) := TC; -- Block optimization of TC.
-              end if;
-          end;
- 
-          Report.Failed
-               ("Function Value (with Length parameter) did not "    &
-                "raise Constraint_Error when Length = 0");
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by Function Value " &
-                           "with both Item and Length parameters, when "   &
-                           "Length = 0");
-       end;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,282 ****
- -- CXB3011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the version of Function Value with a chars_ptr parameter
- --      that returns a String result returns an Ada string containing the
- --      characters pointed to by the chars_ptr parameter, up to (but not 
- --      including) the terminating nul.
- --
- --      Check that the version of Function Value with a chars_ptr parameter
- --      and a size_t parameter that returns a String result returns the
- --      shorter of: 
- --        1) a String of the first size_t number of characters, or 
- --        2) a String of characters up to (but not including) the
- --           terminating nul.
- --
- --      Check that the Function Strlen returns a size_t result that
- --      corresponds to the number of chars in the array pointed to by Item,
- --      up to but not including the terminating nul.
- --
- --      Check that both of the above versions of Function Value and
- --      Function Strlen propagate Dereference_Error if the Item parameter
- --      is Null_Ptr.
- --      
- -- TEST DESCRIPTION:
- --      This test validates two versions of Function Value, and the Function
- --      Strlen.  A series of char_ptr values are provided as input, and 
- --      results are compared for length or content.  
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*' and '.'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.C.Strings.  If an implementation provides
- --      package Interfaces.C.Strings, this test must compile, execute, 
- --      and report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      28 Sep 95   SAIC    Initial prerelease version.
- --      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Ada.Characters.Latin_1;
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- 
- procedure CXB3011 is
- begin
- 
-    Report.Test ("CXB3011", "Check that the two versions of Function Value " &
-                            "returning a String result, and the Function "   &
-                            "Strlen, produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package IC   renames Interfaces.C;
-       package ICS  renames Interfaces.C.Strings;
-       package ACL1 renames Ada.Characters.Latin_1;
- 
-       use type IC.char_array;
-       use type IC.size_t;
-       use type ICS.chars_ptr;
- 
-       Null_Char_Array_Access : constant ICS.char_array_access := null;
- 
-       TC_String              : String(1..5)          := (others => 'X');
-       TC_String_1            : constant String       := "*.3*0";
-       TC_String_2            : constant String       := "Two";
-       TC_String_3            : constant String       := "Five5";
-       TC_Blank_String        : constant String(1..5) := (others => ' ');
- 
-       TC_char_array          : IC.char_array := 
-                                  IC.To_C(TC_Blank_String, True);
-       TC_char_array_1        : constant IC.char_array := 
-                                  IC.To_C(TC_String_1, True);
-       TC_char_array_2        : constant IC.char_array := 
-                                  IC.To_C(TC_String_2, True);
-       TC_char_array_3        : constant IC.char_array := 
-                                  IC.To_C(TC_String_3, True);
-       TC_Blank_char_array    : constant IC.char_array := 
-                                  IC.To_C(TC_Blank_String, True);
- 
-       TC_chars_ptr           : ICS.chars_ptr :=
-                                  ICS.New_Char_Array(TC_Blank_char_array); 
- 
-       TC_size_t              : IC.size_t := IC.size_t'First;
- 
- 
-    begin
- 
-       -- Check that the version of Function Value with a chars_ptr parameter
-       -- that returns a String result returns an Ada string containing the 
-       -- characters pointed to by the chars_ptr parameter, up to (but not 
-       -- including) the terminating nul.
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array_1);
-       TC_String    := ICS.Value(Item => TC_chars_ptr);
- 
-       if TC_String                 /= TC_String_1 or
-          TC_String(TC_String'Last)  = ACL1.NUL     
-       then
-          Report.Failed("Incorrect result from Function Value - 1");
-       end if;
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
- 
-       if ICS.Value(Item => TC_chars_ptr) /= 
-          IC.To_Ada(ICS.Value(TC_chars_ptr), Trim_Nul => True)
-       then
-          Report.Failed("Incorrect result from Function Value - 2");
-       end if;
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array_3);
-       TC_String    := ICS.Value(TC_chars_ptr);
- 
-       if TC_String                 /= TC_String_3 or
-          TC_String(TC_String'Last)  = ACL1.NUL    
-       then
-          Report.Failed("Incorrect result from Function Value - 3");
-       end if;
- 
- 
-       -- Check that the version of Function Value with a chars_ptr parameter
-       -- and a size_t parameter that returns a String result returns the
-       -- shorter of: 
-       --   1) a String of the first size_t number of characters, or 
-       --   2) a String of characters up to (but not including) the 
-       --      terminating nul.
-       --
- 
-       -- Case 1 : Length parameter specifies a length shorter than total
-       --          length.
- 
-       TC_chars_ptr    := ICS.New_Char_Array(TC_char_array_1);
-       TC_String       := "XXXXX";  -- Reinitialize all characters in string.
-       TC_String(1..5) := ICS.Value(Item => TC_chars_ptr, Length => 6);
- 
-       if TC_String(1..4)           /= TC_String_1(1..4) or
-          TC_String(TC_String'Last)  = ACL1.NUL          
-       then
-          Report.Failed("Incorrect result from Function Value - 4");
-       end if;
- 
-       -- Case 2 : Length parameter specifies total length.
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
- 
-       if ICS.Value(TC_chars_ptr, Length => 5) /= 
-          IC.To_Ada(ICS.Value(TC_chars_ptr), Trim_Nul => True)
-       then
-          Report.Failed("Incorrect result from Function Value - 5");
-       end if;
- 
-       -- Case 3 : Length parameter specifies a length longer than total
-       --          length.
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array_3);
-       TC_String    := "XXXXX";  -- Reinitialize all characters in string.
-       TC_String    := ICS.Value(TC_chars_ptr, 7);
- 
-       if TC_String                 /= TC_String_3 or
-          TC_String(TC_String'Last)  = ACL1.NUL    
-       then
-          Report.Failed("Incorrect result from Function Value - 6");
-       end if;
- 
- 
-       -- Check that the Function Strlen returns a size_t result that
-       -- corresponds to the number of chars in the array pointed to by
-       -- parameter Item, up to but not including the terminating nul.
- 
-       TC_chars_ptr := ICS.New_Char_Array(IC.To_C("A longer string value"));
-       TC_size_t    := ICS.Strlen(TC_chars_ptr);
- 
-       if TC_size_t /= 21 then
-          Report.Failed("Incorrect result from Function Strlen - 1"); 
-       end if;
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
-       TC_size_t    := ICS.Strlen(TC_chars_ptr);
- 
-       if TC_size_t /= 3 then  -- Nul not included in length.
-          Report.Failed("Incorrect result from Function Strlen - 2"); 
-       end if;
- 
-       TC_chars_ptr := ICS.New_Char_Array(IC.To_C(""));
-       TC_size_t    := ICS.Strlen(TC_chars_ptr);
- 
-       if TC_size_t /= 0 then
-          Report.Failed("Incorrect result from Function Strlen - 3"); 
-       end if;
- 
- 
-       -- Check that both of the above versions of Function Value and
-       -- function Strlen propagate Dereference_Error if the Item parameter
-       -- is Null_Ptr.
- 
-       begin
-          TC_chars_ptr := ICS.Null_Ptr;
-          TC_String    := ICS.Value(Item => TC_chars_ptr);
-          Report.Failed("Function Value (without Length parameter) did not " &
-                        "raise Dereference_Error when provided a null Item " &
-                        "parameter input value");
-          if TC_String(1) = '1' then   -- Defeat optimization.
-             Report.Comment("Should never be printed");
-          end if;
-       exception
-          when ICS.Dereference_Error => null;  -- OK, expected exception.
-          when others                => 
-            Report.Failed("Incorrect exception raised by Function Value " &
-                          "with Item parameter, when the Item parameter " &
-                          "is Null_Ptr");
-       end;
- 
-       begin
-          TC_chars_ptr := ICS.Null_Ptr;
-          TC_String    := ICS.Value(Item => TC_chars_ptr, Length => 4);
-          Report.Failed("Function Value (with Length parameter) did not "    &
-                        "raise Dereference_Error when provided a null Item " &
-                        "parameter input value");
-          if TC_String(1) = '1' then   -- Defeat optimization.
-             Report.Comment("Should never be printed");
-          end if;
-       exception
-          when ICS.Dereference_Error => null;  -- OK, expected exception.
-          when others                => 
-            Report.Failed("Incorrect exception raised by Function Value " &
-                          "with both Item and Length parameters, when "   &
-                          "the Item parameter is Null_Ptr");
-       end;
- 
-       begin
-          TC_chars_ptr := ICS.Null_Ptr;
-          TC_size_t    := ICS.Strlen(Item => TC_chars_ptr);
-          Report.Failed("Function Strlen did not raise Dereference_Error" &
-                        "when provided a null Item parameter input value");
-          if TC_size_t = 35 then   -- Defeat optimization.
-             Report.Comment("Should never be printed");
-          end if;
-       exception
-          when ICS.Dereference_Error => null;  -- OK, expected exception.
-          when others                => 
-            Report.Failed("Incorrect exception raised by Function Strlen " &
-                          "when the Item parameter is Null_Ptr");
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,392 ****
- -- CXB3012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Procedure Update modifies the value pointed to by
- --      the chars_ptr parameter Item, starting at the position
- --      corresponding to parameter Offset, using the chars in
- --      char_array parameter Chars.
- --
- --      Check that the version of Procedure Update with a String parameter
- --      behaves in the manner described above, but with the character
- --      values in the String overwriting the char values in Item.
- --
- --      Check that both of the above versions of Procedure Update will
- --      propagate Update_Error if Check is True, and if the length of
- --      the new chars in Chars, when overlaid starting from position
- --      Offset, will overwrite the first nul in Item.
- --
- -- TEST DESCRIPTION:
- --      This test checks two versions of Procedure Update.  In the first
- --      version of the procedure, the parameter Chars indicates a char_array
- --      argument.  These char_array parameters are provided through the use
- --      of the To_C function (with String IN parameter), both with and
- --      without a terminating nul.  In the case below where a terminating nul
- --      char is appended, the effect of "updating" the value pointed to by the
- --      Item parameter will include its shortening, due to the insertion of
- --      this additional nul in the middle of the char_array.
- --
- --      In the second version of Procedure Update evaluated here, the string
- --      parameter Str is used to modify the char_array pointed to by Item.
- --
- --      Finally, both versions of the procedure are evaluated to ensure that
- --      they propagate Update_Error and Dereference_Error under the proper
- --      conditions.
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '-' and '.'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.Strings.  If an implementation provides
- --      package Interfaces.C.Strings, this test must compile, execute,
- --      and report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      05 Oct 95   SAIC    Initial prerelease version.
- --      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --      14 Sep 99   RLB     Removed incorrect and unnecessary
- --                          Unchecked_Conversion. Added check for raising
- --                          of Dereference_Error for Update (From Technical
- --                          Corrigendum 1).
- --      07 Jan 05   RLB     Modified to reflect change to Update by AI-242
- --                          (which is expected to be part of Amendment 1).
- --                          [This version allows either semantics.]
- 
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- 
- procedure CXB3012 is
- begin
- 
-    Report.Test ("CXB3012", "Check that both versions of Procedure Update " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package IC  renames Interfaces.C;
-       package ICS renames Interfaces.C.Strings;
-       use Ada.Exceptions;
- 
-       use type IC.char;
-       use type IC.char_array;
-       use type IC.size_t;
-       use type ICS.chars_ptr;
- 
-       TC_String_1        : String(1..1)    := "J";
-       TC_String_2        : String(1..2)    := "Ab";
-       TC_String_3        : String(1..3)    := "xyz";
-       TC_String_4        : String(1..4)    := "ACVC";
-       TC_String_5        : String(1..5)    := "1a2b3";
-       TC_String_6        : String(1..6)    := "---...";
-       TC_String_7        : String(1..7)    := "AABBBAA";
-       TC_String_8        : String(1..8)    := "aBcDeFgH";
-       TC_String_9        : String(1..9)    := "JustATest";
-       TC_String_10       : String(1..10)   := "0123456789";
- 
-       TC_Result_String_1 : constant String := "JXXXXXXXXX";
-       TC_Result_String_2 : constant String := "XXXXXXXXAb";
-       TC_Result_String_3 : constant String := "XXXxyz";
-       TC_Result_String_4 : constant String := "XACVC";
-       TC_Result_String_5 : constant String := "1a2b3";
-       TC_Result_String_6 : constant String := "XXX---...";
- 
-       TC_Amd_Result_String_4 :
-                            constant String := "XACVCXXXXX";
-       TC_Amd_Result_String_5 :
-                            constant String := "1a2b3XXXXX";
-       TC_Amd_Result_String_6 :
-                            constant String := "XXX---...X";
-       TC_Amd_Result_String_9 :
-                            constant String := "JustATestX";
- 
-       TC_char_array        : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
-       TC_Result_char_array : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
-       TC_chars_ptr         : ICS.chars_ptr;
-       TC_Length            : IC.size_t;
- 
-    begin
- 
-       -- Check that Procedure Update modifies the value pointed to by
-       -- the chars_ptr parameter Item, starting at the position
-       -- corresponding to parameter Offset, using the chars in
-       -- char_array parameter Chars.
-       -- Note: If parameter Chars contains a nul char (such as a
-       --       terminating nul), the result may be the overall shortening
-       --       of parameter Item.
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
- 
-       ICS.Update(Item   => TC_chars_ptr,
-                  Offset => 0,
-                  Chars  => IC.To_C(TC_String_1, False),  -- No nul char.
-                  Check  => True);
- 
-       if ICS.Value(TC_chars_ptr) /= TC_Result_String_1 then
-          Report.Failed("Incorrect result from Procedure Update - 1");
-       end if;
-       ICS.Free(TC_chars_ptr);
- 
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-       ICS.Update(TC_chars_ptr,
-                  Offset => ICS.Strlen(TC_chars_ptr) - 2,
-                  Chars  => IC.To_C(TC_String_2, False),  -- No nul char.
-                  Check  => True);
- 
-       if ICS.Value(TC_chars_ptr) /= TC_Result_String_2 then
-          Report.Failed("Incorrect result from Procedure Update - 2");
-       end if;
-       ICS.Free(TC_chars_ptr);
- 
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-       ICS.Update(TC_chars_ptr,
-                  3,
-                  Chars  => IC.To_C(TC_String_3),   -- Nul appended, shortens
-                  Check  => False);                 -- array.
- 
-       if ICS.Value(TC_chars_ptr) /= TC_Result_String_3 then
-          Report.Failed("Incorrect result from Procedure Update - 3");
-       end if;
-       ICS.Free(TC_chars_ptr);
- 
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-       ICS.Update(TC_chars_ptr,
-                  0,
-                  IC.To_C(TC_String_10), -- Complete replacement of array.
-                  Check  => False);
- 
-       if ICS.Value(TC_chars_ptr) /= TC_String_10 then
-          Report.Failed("Incorrect result from Procedure Update - 4");
-       end if;
- 
-       -- Perform a character-by-character comparison of the result of
-       -- Procedure Update. Note that char_array lower bound is 0, and
-       -- that the nul char is not compared with any character in the
-       -- string (since the string is not nul terminated).
-       begin
-          TC_Length := ICS.Strlen(TC_chars_ptr);
-          TC_Result_char_array(0..10) := ICS.Value(TC_chars_ptr);
-          for i in 0..TC_Length-1 loop
-             if TC_Result_char_array(i) /=
-                IC.To_C(TC_String_10(Integer(i+1)))
-             then
-                Report.Failed("Incorrect result from the character-by-" &
-                              "character evaluation of the result of "  &
-                              "Procedure Update");
-             end if;
-          end loop;
-       exception
-          when others =>
-            Report.Failed("Exception raised during the character-by-" &
-                          "character evaluation of the result of "    &
-                          "Procedure Update");
-       end;
-       ICS.Free(TC_chars_ptr);
- 
- 
- 
-       -- Check that the version of Procedure Update with a String rather
-       -- than a char_array parameter behaves in the manner described above,
-       -- but with the character values in the String overwriting the char
-       -- values in Item.
-       --
-       -- Note: In Ada 95, In each of the cases below, the String parameter
-       --       Str is treated as if it were nul terminated, which means that
-       --       the char_array pointed to by TC_chars_ptr will be "shortened"
-       --       so that it ends after the last character of the Str
-       --       parameter. For Ada 2005, this rule is dropped, so the
-       --       number of characters remains the same.
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-       ICS.Update(TC_chars_ptr, 1, TC_String_4, False);
- 
-       if ICS.Value(TC_chars_ptr) = TC_Result_String_4 then
-          Report.Comment("Ada 95 result from Procedure Update - 5");
-       elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_4 then
-          Report.Comment("Amendment 1 result from Procedure Update - 5");
-       else
-          Report.Failed("Incorrect result from Procedure Update - 5");
-       end if;
-       ICS.Free(TC_chars_ptr);
- 
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-       ICS.Update(Item   => TC_chars_ptr,
-                  Offset => 0,
-                  Str    => TC_String_5);
- 
-       if ICS.Value(TC_chars_ptr) = TC_Result_String_5 then
-          Report.Comment("Ada 95 result from Procedure Update - 6");
-       elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_5 then
-          Report.Comment("Amendment 1 result from Procedure Update - 6");
-       else
-          Report.Failed("Incorrect result from Procedure Update - 6");
-       end if;
-       ICS.Free(TC_chars_ptr);
- 
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-       ICS.Update(TC_chars_ptr,
-                  3,
-                  Str    => TC_String_6,
-                  Check  => True);
- 
-       if ICS.Value(TC_chars_ptr) = TC_Result_String_6 then
-          Report.Comment("Ada 95 result from Procedure Update - 7");
-       elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_6 then
-          Report.Comment("Amendment 1 result from Procedure Update - 7");
-       else
-          Report.Failed("Incorrect result from Procedure Update - 7");
-       end if;
-       ICS.Free(TC_chars_ptr);
- 
- 
-       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-       ICS.Update(TC_chars_ptr, 0, TC_String_9, True);
- 
-       if ICS.Value(TC_chars_ptr) = TC_String_9 then
-          Report.Comment("Ada 95 result from Procedure Update - 8");
-       elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_9 then
-          Report.Comment("Amendment 1 result from Procedure Update - 8");
-       else
-          Report.Failed("Incorrect result from Procedure Update - 8");
-       end if;
-       ICS.Free(TC_chars_ptr);
- 
-       -- Check what happens if the string and array are the same size (this
-       -- is the case that caused the change made by the Amendment).
-       begin
-          TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-          ICS.Update(Item   => TC_chars_ptr,
-                     Offset => 0,
-                     Str    => TC_String_10,
-                     Check  => True);
-           if ICS.Value(TC_chars_ptr) = TC_String_10 then
-              Report.Comment("Amendment 1 result from Procedure Update - 9");
-           else
-              Report.Failed("Incorrect result from Procedure Update - 9");
-           end if;
-       exception
-          when ICS.Update_Error =>
-              Report.Comment("Ada 95 exception expected from Procedure Update - 9");
-          when others           =>
-            Report.Failed("Incorrect exception raised by Procedure Update " &
-                          "with Str parameter - 9");
-       end;
-       ICS.Free(TC_chars_ptr);
- 
- 
-       -- Check that both of the above versions of Procedure Update will
-       -- propagate Update_Error if Check is True, and if the length of
-       -- the new chars in Chars, when overlaid starting from position
-       -- Offset, will overwrite the first nul in Item.
- 
-       begin
-          TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-          ICS.Update(Item   => TC_chars_ptr,
-                     Offset => 5,
-                     Chars  => IC.To_C(TC_String_7),
-                     Check  => True);
-          Report.Failed("Update_Error not raised by Procedure Update with " &
-                        "Chars parameter");
-          Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
-                         "optimization - should never be printed");
-       exception
-          when ICS.Update_Error => null;  -- OK, expected exception.
-          when others           =>
-            Report.Failed("Incorrect exception raised by Procedure Update " &
-                          "with Chars parameter");
-       end;
- 
-       ICS.Free(TC_chars_ptr);
- 
-       begin
-          TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
-          ICS.Update(Item   => TC_chars_ptr,
-                     Offset => ICS.Strlen(TC_chars_ptr),
-                     Str    => TC_String_8); -- Default Check parameter value.
-          Report.Failed("Update_Error not raised by Procedure Update with " &
-                        "Str parameter");
-          Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
-                         "optimization - should never be printed");
-       exception
-          when ICS.Update_Error => null;  -- OK, expected exception.
-          when others           =>
-            Report.Failed("Incorrect exception raised by Procedure Update " &
-                          "with Str parameter");
-       end;
- 
-       ICS.Free(TC_chars_ptr);
- 
-       -- Check that both of the above versions of Procedure Update will
-       -- propagate Dereference_Error if Item is Null_Ptr.
-       -- Note: Free sets TC_chars_ptr to Null_Ptr.
- 
-       begin
-          ICS.Update(Item   => TC_chars_ptr,
-                     Offset => 5,
-                     Chars  => IC.To_C(TC_String_7),
-                     Check  => True);
-          Report.Failed("Dereference_Error not raised by Procedure Update with " &
-                        "Chars parameter");
-       exception
-          when ICS.Dereference_Error => null;  -- OK, expected exception.
-          when others           =>
-            Report.Failed("Incorrect exception raised by Procedure Update " &
-                          "with Chars parameter");
-       end;
- 
-       begin
-          ICS.Update(Item   => TC_chars_ptr,
-                     Offset => ICS.Strlen(TC_chars_ptr),
-                     Str    => TC_String_8); -- Default Check parameter value.
-          Report.Failed("Dereference_Error not raised by Procedure Update with " &
-                        "Str parameter");
-       exception
-          when ICS.Dereference_Error => null;  -- OK, expected exception.
-          when others           =>
-            Report.Failed("Incorrect exception raised by Procedure Update " &
-                          "with Str parameter");
-       end;
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30130.c gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30130.c
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30130.c	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30130.c	Thu Jan  1 00:00:00 1970
***************
*** 1,86 ****
- /*
- -- CXB30130.C                                                            
- --                                                                       
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --                                                                       
- -- FUNCTION NAME: CXB30130   ("square_it")                               
- --                                                                       
- -- FUNCTION DESCRIPTION:                                                 
- --      This C function returns the square of num1 through the function  
- --      name, and returns the square of parameters num2, num3, and num4  
- --      through the argument list (modifying the objects pointed to by   
- --      the parameters).                         
- --
- -- INPUTS:
- --      This function requires that four parameters be passed to it.
- --      The types of these parameters are, in order: int, pointer to short, 
- --      pointer to float, and pointer to double.
- --
- -- PROCESSING:
- --      The function will calculate the square of the int parameter (num1),
- --      and return this value as the function result through the function
- --      name.  The function will also calculate the square of the values
- --      pointed to by the remaining three parameters (num2, num3, num4), 
- --      and will modify the referenced memory locations to contain the 
- --      squared values.
- --
- -- OUTPUTS:                        
- --      The square of num1 is returned through function name. 
- --      Parameters num2-num4 now point to values that are the squared results
- --      of the originally referenced values (i.e., the original values are
- --      modified as a result of this function).
- --                                                                       
- -- CHANGE HISTORY:                                                       
- --      12 Oct 95   SAIC    Initial prerelease version.                  
- --                                                                       
- --!
- */
-                                                                          
- int CXB30130 (int num1, short* num2, float* num3, double* num4)          
-                                                                          
- /* NOTE: The above function definition should be accepted by an ANSI-C   */
- /*       compiler.  Older C compilers may reject it; they may, however   */
- /*       accept the following five lines.  An implementation may comment */
- /*       out the above function definition and uncomment the following   */
- /*       one.  Otherwise, an implementation must provide the necessary   */
- /*       modifications to this C code to satisfy the function            */
- /*       requirements (see Function Description).                        */
- /*                                                                       */
- /*  int CXB30130 (num1, num2, num3, num4)                                */
- /*     int     num1;                                                     */
- /*     short*  num2;                                                     */
- /*     float*  num3;                                                     */
- /*     double* num4;                                                     */
- /*                                                                       */
- 
- {
-    int return_value = 0;
- 
-    return_value = num1 * num1;
-    *num2 = *num2 * *num2; /* Return square of these parameters through   */
-    *num3 = *num3 * *num3; /* the parameter list.                         */
-    *num4 = *num4 * *num4;
- 
-    return (return_value); /* Return square of num1 through function name */
- }
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30131.c gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30131.c
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30131.c	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30131.c	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- /*
- -- CXB30131.C                                                           
- --                                                                      
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --                                                                      
- -- FUNCTION NAME: CXB30131   ("combine_two_strings")                    
- --                                                                      
- -- FUNCTION DESCRIPTION:                                                
- --      This C function returns a pointer to the combination of two     
- --      input strings. 
- --                                                                      
- -- INPUTS:
- --      This function requires that two parameters be passed to it.
- --      The type of both of these parameters are pointer to char (which
- --      is used to reference an array of chars).
- --
- -- PROCESSING:
- --      The function will create a char array that is equal to the combined
- --      length of the char arrays referenced by the two input parameters.
- --      The char elements contained in the char arrays specified by the 
- --      parameters will be combined (in order) into this new char array.
- --
- -- OUTPUTS:                        
- --      The newly created char array will be returned as the function
- --      result through the function name.  The char arrays referenced by the
- --      two parameters will be unaffected.
- --                                                                       
- -- CHANGE HISTORY:                                                      
- --      12 Oct 95   SAIC    Initial prerelease version. 
- --      26 Oct 96   SAIC    Modified temp array initialization.                
- --      15 Feb 99   RLB     Repaired to remove non-standard function strdup.
- --!
- */
- 
- #include <string.h>
- #include <stdlib.h>
- 
- char *stringdup (char *s)
- {
-   char *result = malloc(sizeof(char)*(strlen(s)+1));
-   return strcpy(result,s);
- }
- 
- char *CXB30131 (char *string1, char *string2)
- 
- /* NOTE: The above function definition should be accepted by an ANSI-C    */
- /*       compiler.  Older C compilers may reject it; they may, however    */
- /*       accept the following three lines.  An implementation may comment */
- /*       out the above function definition and uncomment the following    */
- /*       one.  Otherwise, an implementation must provide the necessary    */
- /*       modifications to this C code to satisfy the function             */
- /*       requirements (see Function Description).                         */
- /*                                                                        */
- /*   char *CXB30131 (string1, string2)                                    */
- /*      char *string1;                                                    */
- /*      char *string2;                                                    */
- 
- {
-    char temp[100];  /* Local array that holds the combined strings */
-    int  index;      /* Loop counter */
-    int  length = 0; /* Variable that holds the length of the strings */
- 
-    /* Initialize the local array */
-    for (index = 0; index < 100; index++)
-    { temp[index] = 0; }
- 
-    /* Use the library function strcpy to copy the contents of string1 
-       into temp.  */
-    strcpy (temp, string1);
- 
-    /* Use the library function strlen to determine the number of 
-       characters in the temp array (without the trailing nul). */
-    length = strlen (temp);
- 
-    /* Add each character in string2 into the temp array, add nul 
-       to the end of the array. */
-    for (index = length; *string2 != '\0'; index++)
-    { temp[index] = *string2++; }
-    temp[index] = '\0';
- 
-    /* Use the library function strdup to return a pointer to temp. */
-    return (stringdup(temp));
- }
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am	Thu Jan  1 00:00:00 1970
***************
*** 1,205 ****
- -- CXB30132.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that imported, user-defined C language functions can be 
- --      called from an Ada program.
- --      
- -- TEST DESCRIPTION:
- --      This test checks that user-defined C language functions can be
- --      imported and referenced from an Ada program.  Two C language
- --      functions are specified in files CXB30130.C and CXB30131.C.  
- --      These two functions are imported to this test program, using two
- --      calls to Pragma Import.  Each function is then called in this test,
- --      and the results of the call are verified.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', and 'A'..'Z'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      packages Interfaces.C and Interfaces.C.Strings.  If an 
- --      implementation provides packages Interfaces.C and 
- --      Interfaces.C.Strings, this test must compile, execute, and 
- --      report "PASSED".
- --
- -- SPECIAL REQUIREMENTS:
- --      The files CXB30130.C and CXB30131.C must be compiled with a C 
- --      compiler.  Implementation dialects of C may require alteration of 
- --      the C program syntax (see individual C files).
- --     
- --      Note that the compiled C code must be bound with the compiled Ada
- --      code to create an executable image.  An implementation must provide
- --      the necessary commands to accomplish this.
- --     
- --      Note that the C code included in CXB30130.C and CXB30131.C conforms
- --      to ANSI-C.  Modifications to these files may be required for other
- --      C compilers.  An implementation must provide the necessary 
- --      modifications to satisfy the function requirements.
- --     
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         CXB30130.C
- --         CXB30131.C
- --         CXB30132.AM
- --
- --       
- -- CHANGE HISTORY:
- --      13 Oct 95   SAIC    Initial prerelease version.
- --      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Impdef;
- with Interfaces.C;                                            -- N/A => ERROR
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- 
- procedure CXB30132 is
- begin
- 
-    Report.Test ("CXB3013", "Check that user-defined C functions can " &
-                            "be imported into an Ada program");
- 
-    Test_Block:
-    declare
- 
-       package IC  renames Interfaces.C;
-       package ICS renames Interfaces.C.Strings;
- 
-       use type IC.char_array;
-       use type IC.int;
-       use type IC.short;
-       use type IC.C_float;
-       use type IC.double;
- 
-       type Short_Ptr          is access all IC.short;
-       type Float_Ptr          is access all IC.C_float;
-       type Double_Ptr         is access all IC.double;
-       subtype Char_Array_Type is IC.char_array(0..20);
- 
-       TC_Default_int      : IC.int             :=   49;
-       TC_Default_short    : IC.short           :=    3;
-       TC_Default_float    : IC.C_float         :=   50.0;
-       TC_Default_double   : IC.double          := 1209.0; 
- 
-       An_Int_Value        : IC.int             := TC_Default_int;
-       A_Short_Value       : aliased IC.short   := TC_Default_short;
-       A_Float_Value       : aliased IC.C_float := TC_Default_float; 
-       A_Double_Value      : aliased IC.double  := TC_Default_double;
- 
-       A_Short_Int_Pointer : Short_Ptr          := A_Short_Value'access;
-       A_Float_Pointer     : Float_Ptr          := A_Float_Value'access;
-       A_Double_Pointer    : Double_Ptr         := A_Double_Value'access;
- 
-       Char_Array_1        : Char_Array_Type;
-       Char_Array_2        : Char_Array_Type;
-       Char_Pointer        : ICS.chars_ptr;
- 
-       TC_Char_Array       : constant Char_Array_Type := 
-                               "Look before you leap" & IC.nul;
-       TC_Return_int       : IC.int := 0;
- 
-       -- The Square_It function returns the square of the value The_Int 
-       -- through the function name, and returns the square of the other
-       -- parameters through the parameter list (the last three parameters 
-       -- are access values).
- 
-       function Square_It (The_Int    : in IC.int;
-                           The_Short  : in Short_Ptr;
-                           The_Float  : in Float_Ptr;
-                           The_Double : in Double_Ptr) return IC.int;
- 
-       -- The Combine_Strings function returns the result of the catenation
-       -- of the two string parameters through the function name.
- 
-       function Combine_Strings (First_Part  : in IC.char_array;
-                                 Second_Part : in IC.char_array) 
-         return ICS.chars_ptr;
- 
- 
-       -- Use the user-defined C function square_it as a completion to the
-       -- function specification above.
- 
-      pragma Import (Convention    => C, 
-                     Entity        => Square_It, 
-                     External_Name => Impdef.CXB30130_External_Name);
- 
-       -- Use the user-defined C function combine_two_strings as a completion
-       -- to the function specification above.
- 
-      pragma Import (C, Combine_Strings, Impdef.CXB30131_External_Name);
- 
- 
-    begin
- 
-       -- Check that the imported version of C function CXB30130 produces 
-       -- the correct results.
- 
-       TC_Return_int := Square_It (The_Int    => An_Int_Value,
-                                   The_Short  => A_Short_Int_Pointer,
-                                   The_Float  => A_Float_Pointer,
-                                   The_Double => A_Double_Pointer);
- 
-       -- Compare the results with the expected results.  Note that in the
-       -- case of the three "pointer" parameters, the objects being pointed
-       -- to have been modified as a result of the function.
- 
-       if TC_Return_int           /= An_Int_Value      * An_Int_Value      or
-          A_Short_Int_Pointer.all /= TC_Default_short  * TC_Default_Short  or
-          A_Short_Value           /= TC_Default_short  * TC_Default_Short  or
-          A_Float_Pointer.all     /= TC_Default_float  * TC_Default_float  or
-          A_Float_Value           /= TC_Default_float  * TC_Default_float  or
-          A_Double_Pointer.all    /= TC_Default_double * TC_Default_double or
-          A_Double_Value          /= TC_Default_double * TC_Default_double 
-       then
-          Report.Failed("Incorrect results returned from function square_it");
-       end if;
- 
- 
-       -- Check that two char_array values are combined by the imported 
-       -- C function CXB30131.
- 
-       Char_Array_1(0..12) := "Look before " & IC.nul;
-       Char_Array_2(0..8)  := "you leap"     & IC.nul;
- 
-       Char_Pointer := Combine_Strings (Char_Array_1, Char_Array_2);
- 
-       if ICS.Value(Char_Pointer) /= TC_Char_Array then
-          Report.Failed("Incorrect value returned from imported function " &
-                        "combine_two_strings");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB30132;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,254 ****
- -- CXB3014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the Function Value with Pointer and Element 
- --      parameters will return an Element_Array result of correct size 
- --      and content (up to and including the first "terminator" Element). 
- --
- --      Check that the Function Value with Pointer and Length parameters 
- --      will return an Element_Array result of appropriate size and content
- --      (the first Length elements pointed to by the parameter Ref).
- --
- --      Check that both versions of Function Value will propagate 
- --      Interfaces.C.Strings.Dereference_Error when the value of
- --      the Ref pointer parameter is null.
- --
- -- TEST DESCRIPTION:
- --      This test tests that both versions of Function Value from the 
- --      generic package Interfaces.C.Pointers are available and produce
- --      correct results.  The generic package is instantiated with size_t,
- --      char, char_array, and nul as actual parameters, and subtests are
- --      performed on each of the Value functions resulting from this
- --      instantiation.
- --      For both function versions, a test is performed where a portion of
- --      a char_array is to be returned as the function result.  Likewise,
- --      a test is performed where each version of the function returns the
- --      entire char_array referenced by the in parameter Ref.
- --      Finally, both versions of Function Value are called with a null
- --      pointer reference, to ensure that Dereference_Error is raised in
- --      this case.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', 'a'..'z', and 'A'..'Z'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      packages Interfaces.C.Strings and Interfaces.C.Pointers.  If an 
- --      implementation provides packages Interfaces.C.Strings and 
- --      Interfaces.C.Pointers, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      19 Oct 95   SAIC    Initial prerelease version.
- --      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      23 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- with Interfaces.C.Pointers;                                   -- N/A => ERROR
- 
- procedure CXB3014 is
- 
- begin
- 
-    Report.Test ("CXB3014", "Check that versions of the Value function "  &
-                            "from package Interfaces.C.Pointers produce " &
-                            "correct results");
- 
-    Test_Block:
-    declare
- 
-       use type Interfaces.C.char, Interfaces.C.size_t;
- 
-       Char_a : constant Interfaces.C.char := 'a';
-       Char_j : constant Interfaces.C.char := 'j';
-       Char_z : constant Interfaces.C.char := 'z';
- 
-       subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;
-       subtype Char_Range       is Interfaces.C.size_t range 0..26;
- 
-       Local_nul       : aliased Interfaces.C.char := Interfaces.C.nul;
-       TC_Array_Size   : Interfaces.C.size_t := 20;
- 
-       TC_String_1     : constant String := "abcdefghij";
-       TC_String_2     : constant String := "abcdefghijklmnopqrstuvwxyz";
-       TC_String_3     : constant String := "abcdefghijklmnopqrst";
-       TC_String_4     : constant String := "abcdefghijklmnopqrstuvwxyz";
-       TC_Blank_String : constant String := "                          ";
- 
-       TC_Char_Array   : Interfaces.C.char_array(Char_Range) :=
-                           Interfaces.C.To_C(TC_String_2, True);
- 
-       TC_Char_Array_1 : Interfaces.C.char_array(0..9);
-       TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);
-       TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);
-       TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);
- 
-       package Char_Pointers is new 
-         Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
-                                Element            => Interfaces.C.char,
-                                Element_Array      => Interfaces.C.char_array,
-                                Default_Terminator => Interfaces.C.nul);
- 
-       Char_Ptr : Char_Pointers.Pointer;
- 
-       use type Char_Pointers.Pointer;
- 
-    begin
- 
-       -- Check that the Function Value with Pointer and Terminator Element 
-       -- parameters will return an Element_Array result of appropriate size 
-       -- and content (up to and including the first "terminator" Element.) 
- 
-       Char_Ptr := TC_Char_Array(0)'Access;
- 
-       -- Provide a new Terminator char in the call of Function Value.
-       -- This call should return only a portion (the first 10 chars) of
-       -- the referenced char_array, up to and including the char 'j'.
- 
-       TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
-                                              Terminator => Char_j);
- 
-       if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or
-          Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)
-       then
-          Report.Failed("Incorrect result from Function Value with Ref " &
-                        "and Terminator parameters, when supplied with " &
-                        "a non-default Terminator char");
-       end if;
- 
-       -- Use the default Terminator char in the call of Function Value.
-       -- This call should return the entire char_array, including the 
-       -- terminating nul char.
- 
-       TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);
- 
-       if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or
-          not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)
-       then
-          Report.Failed("Incorrect result from Function Value with Ref " &
-                        "and Terminator parameters, when using the "     &
-                        "default Terminator char");
-       end if;
- 
- 
- 
-       -- Check that the Function Value with Pointer and Length parameters 
-       -- will return an Element_Array result of appropriate size and content
-       -- (the first Length elements pointed to by the parameter Ref).
-       
-       -- This call should return only a portion (the first 20 chars) of
-       -- the referenced char_array.
- 
-       TC_Char_Array_3 := 
-         Char_Pointers.Value(Ref    => Char_Ptr,
-                             Length => Interfaces.C.ptrdiff_t(TC_Array_Size));
- 
-       -- Verify the individual chars of the result.
-       for i in 0..TC_Array_Size-1 loop
-          if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /= 
-             TC_String_3(Integer(i)+1)
-          then
-             Report.Failed("Incorrect result from Function Value with "  &
-                           "Ref and Length parameters, when specifying " &
-                           "a length less than the full array size");
-             exit;
-          end if;
-       end loop;
- 
-       -- This call should return the entire char_array, including the 
-       -- terminating nul char.
- 
-       TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);
- 
-       if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or
-          not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)
-       then
-          Report.Failed("Incorrect result from Function Value with Ref " &
-                        "and Length parameters, when specifying the "    &
-                        "entire array size");
-       end if;
- 
- 
- 
-       -- Check that both of the above versions of Function Value will 
-       -- propagate Interfaces.C.Strings.Dereference_Error when the value of
-       -- the Ref Pointer parameter is null.
- 
-       Char_Ptr := null;
- 
-       begin
-          TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
-                                                 Terminator => Char_j);
-          Report.Failed("Dereference_Error not raised by Function " &
-                        "Value with Terminator parameter, when "    &
-                        "provided a null reference");
-          -- Call Report.Comment to ensure that the assignment to 
-          -- TC_Char_Array_1 is not "dead", and therefore can not be 
-          -- optimized away.
-          Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));
-       exception
-          when Interfaces.C.Strings.Dereference_Error => 
-            null;  -- OK, expected exception.
-          when others =>
-            Report.Failed("Incorrect exception raised by Function " &
-                          "Value with Terminator parameter, when "  &
-                          "provided a null reference");
-       end;
- 
- 
-       begin
-          TC_Char_Array_3 := 
-            Char_Pointers.Value(Char_Ptr,
-                                Interfaces.C.ptrdiff_t(TC_Array_Size));
-          Report.Failed("Dereference_Error not raised by Function "   &
-                        "Value with Length parameter, when provided " &
-                        "a null reference");
-          -- Call Report.Comment to ensure that the assignment to 
-          -- TC_Char_Array_3 is not "dead", and therefore can not be 
-          -- optimized away.
-          Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));
-       exception
-          when Interfaces.C.Strings.Dereference_Error => 
-            null;  -- OK, expected exception.
-          when others =>
-            Report.Failed("Incorrect exception raised by Function " &
-                          "Value with Length parameter, when "      &
-                          "provided a null reference");
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,520 ****
- -- CXB3015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the "+" and "-" functions with Pointer and ptrdiff_t
- --      parameters that return Pointer values produce correct results,
- --      based on the size of the array elements.
- --
- --      Check that the "-" function with two Pointer parameters that
- --      returns a ptrdiff_t type parameter produces correct results,
- --      based on the size of the array elements.
- --
- --      Check that each of the "+" and "-" functions above will
- --      propagate Pointer_Error if a Pointer parameter is null.
- --
- --      Check that the Increment and Decrement procedures provide the
- --      correct "pointer arithmetic" operations.
- --
- -- TEST DESCRIPTION:
- --      This test checks that the functions "+" and "-", and the procedures
- --      Increment and Decrement in the generic package Interfaces.C.Pointers
- --      will allow the user to perform "pointer arithmetic" operations on
- --      Pointer values.
- --      Package Interfaces.C.Pointers is instantiated three times, for
- --      short values, chars, and arrays of arrays.  Pointers from each
- --      instantiated package are then used to reference different elements
- --      of array objects.  Pointer arithmetic operations are performed on
- --      these pointers, and the results of these operations are verified
- --      against expected pointer positions along the referenced arrays.
- --      The propagation of Pointer_Error is checked for when the function
- --      Pointer parameter is null.
- --
- --      The following chart indicates the combinations of subprograms and
- --      parameter types used in this test.
- --
- --
- --                                 Short    Char    Array
- --                               --------------------------
- --      "+" Pointer, ptrdiff_t  |   X    |        |   X    |
- --                              |--------------------------|
- --      "+" ptrdiff_t, Pointer  |   X    |        |   X    |
- --                              |--------------------------|
- --      "-" Pointer, ptrdiff_t  |        |   X    |   X    |
- --                              |--------------------------|
- --      "-" Pointer, Pointer    |        |   X    |   X    |
- --                              |--------------------------|
- --      Increment (Pointer)     |   X    |        |   X    |
- --                              |--------------------------|
- --      Decrement (Pointer)     |   X    |        |   X    |
- --                               --------------------------
- --
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', and 'a'..'z'.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is applicable to all implementations that provide
- --      package Interfaces.C.Pointers.  If an implementation provides
- --      package Interfaces.C.Pointers, this test must compile, execute, and
- --      report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      26 Oct 95   SAIC    Initial prerelease version.
- --      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --      06 Mar 00   RLB     Repaired so that array of arrays component
- --                          type is statically constrained. (C does not have
- --                          an analog to an array of dynamically constrained
- --                          arrays.)
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.C.Pointers;                                   -- N/A => ERROR
- 
- procedure CXB3015 is
- begin
- 
-    Report.Test ("CXB3015", "Check that +, -, Increment, and Decrement "    &
-                            "subprograms in Package Interfaces.C.Pointers " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use type Interfaces.C.short;
-       use type Interfaces.C.size_t, Interfaces.C.ptrdiff_t;
-       use type Interfaces.C.char,   Interfaces.C.char_array;
- 
-       TC_Count         : Interfaces.C.size_t;
-       TC_Increment     : Interfaces.C.ptrdiff_t;
-       TC_ptrdiff_t     : Interfaces.C.ptrdiff_t;
-       TC_Short         : Interfaces.C.short  :=   0;
-       TC_Verbose       : Boolean             := False;
-       Constant_Min_Array_Size   : constant Interfaces.C.size_t :=   0;
-       Constant_Max_Array_Size   : constant Interfaces.C.size_t :=  20;
-       Min_Array_Size   : Interfaces.C.size_t :=  Interfaces.C.size_t(
-                          Report.Ident_Int(Integer(Constant_Min_Array_Size)));
-       Max_Array_Size   : Interfaces.C.size_t :=  Interfaces.C.size_t(
-                          Report.Ident_Int(Integer(Constant_Max_Array_Size)));
-       Min_size_t,
-       Max_size_t       : Interfaces.C.size_t;
-       Short_Terminator : Interfaces.C.short  := Interfaces.C.short'Last;
-       Alphabet         : constant String     := "abcdefghijklmnopqrstuvwxyz";
- 
- 
-       type Short_Array_Type is
-         array (Interfaces.C.size_t range <>) of aliased Interfaces.C.short;
- 
-       type Constrained_Array_Type is
-         array (Min_Array_Size..Max_Array_Size) of aliased Interfaces.C.short;
- 
-       type Static_Constrained_Array_Type is
-         array (Constant_Min_Array_Size .. Constant_Max_Array_Size) of
-           aliased Interfaces.C.short;
- 
-       type Array_of_Arrays_Type is
-         array (Interfaces.C.size_t range <>) of aliased
-         Static_Constrained_Array_Type;
- 
- 
-       Short_Array       : Short_Array_Type(Min_Array_Size..Max_Array_Size);
- 
-       Constrained_Array : Constrained_Array_Type;
- 
-       Terminator_Array  : Static_Constrained_Array_Type :=
-                             (others => Short_Terminator);
- 
-       Ch_Array          : Interfaces.C.char_array
-                             (0..Interfaces.C.size_t(Alphabet'Length)) :=
-                               Interfaces.C.To_C(Alphabet, True);
- 
-       Array_of_Arrays   : Array_of_Arrays_Type
-                             (Min_Array_Size..Max_Array_Size);
- 
- 
-       package Short_Pointers is new
-         Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
-                                Element            => Interfaces.C.short,
-                                Element_Array      => Short_Array_Type,
-                                Default_Terminator => Short_Terminator);
- 
-       package Char_Pointers is new
-         Interfaces.C.Pointers (Interfaces.C.size_t,
-                                Interfaces.C.char,
-                                Element_Array      => Interfaces.C.char_array,
-                                Default_Terminator => Interfaces.C.nul);
- 
-       package Array_Pointers is new
-         Interfaces.C.Pointers (Interfaces.C.size_t,
-                                Static_Constrained_Array_Type,
-                                Array_of_Arrays_Type,
-                                Terminator_Array);
- 
- 
-       use Short_Pointers, Char_Pointers, Array_Pointers;
- 
-       Short_Ptr       : Short_Pointers.Pointer := Short_Array(0)'Access;
-       Char_Ptr        : Char_Pointers.Pointer  := Ch_Array(0)'Access;
-       Start_Char_Ptr  : Char_Pointers.Pointer  := Ch_Array(1)'Access;
-       End_Char_Ptr    : Char_Pointers.Pointer  := Ch_Array(10)'Access;
-       Array_Ptr       : Array_Pointers.Pointer := Array_of_Arrays(0)'Access;
-       Start_Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(1)'Access;
-       End_Array_Ptr   : Array_Pointers.Pointer := Array_of_Arrays(10)'Access;
- 
-    begin
- 
-       -- Provide initial values for the arrays that hold short int values.
- 
-       for i in Min_Array_Size..Max_Array_Size-1 loop
-          Short_Array(i) := Interfaces.C.short(i);
-          for j in Min_Array_Size..Max_Array_Size loop
-             -- Initialize this "array of arrays" so that element (i)(0)
-             -- is different for each value of i.
-             Array_of_Arrays(i)(j) := TC_Short;
-             TC_Short := TC_Short + 1;
-          end loop;
-       end loop;
- 
-       -- Set the final element of each array object to be the "terminator"
-       -- element used in the instantiations above.
- 
-       Short_Array(Max_Array_Size)     := Short_Terminator;
-       Array_of_Arrays(Max_Array_Size) := Terminator_Array;
- 
-       -- Check starting pointer positions.
- 
-       if Short_Ptr.all /= 0           or
-          Char_Ptr.all  /= Ch_Array(0) or
-          Array_Ptr.all /= Array_of_Arrays(0)
-       then
-          Report.Failed("Incorrect initial value for the first " &
-                        "Short_Array, Ch_Array, or Array_of_Array values");
-       end if;
- 
- 
-       -- Check that both versions of the "+" function with Pointer and
-       -- ptrdiff_t parameters, that return a Pointer value, produce correct
-       -- results, based on the size of the array elements.
- 
-       for i in Min_Array_Size + 1 .. Max_Array_Size loop
- 
-          if Integer(i)/2*2 /= Integer(i)  then -- Odd numbered loops.
-             -- Pointer + ptrdiff_t, increment by 1.
-             Short_Ptr := Short_Ptr + 1;
-          else                                  -- Even numbered loops.
-             -- ptrdiff_t + Pointer, increment by 1.
-             Short_Ptr := 1 + Short_Ptr;
-          end if;
- 
-          if Short_Ptr.all /= Short_Array(i) then
-             Report.Failed("Incorrect value returned following use " &
-                           "of the function +, incrementing by 1, "  &
-                           "array position : " & Integer'Image(Integer(i)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
-       end loop;
- 
-       Array_Ptr    := Array_of_Arrays(Min_Array_Size)'Access;
-       TC_Count     := Min_Array_Size;
-       TC_Increment := 3;
-       while TC_Count+Interfaces.C.size_t(TC_Increment) < Max_Array_Size loop
- 
-          if Integer(TC_Count)/2*2 /= Integer(TC_Count) then
-             -- Odd numbered loops.
-             -- Pointer + ptrdiff_t, increment by 3.
-             Array_Ptr := Array_Pointers."+"(Array_Ptr, TC_Increment);
-          else
-             -- Odd numbered loops.
-             -- ptrdiff_t + Pointer, increment by 3.
-             Array_Ptr := Array_Pointers."+"(Left  => TC_Increment,
-                                             Right => Array_Ptr);
-          end if;
- 
-          if Array_Ptr.all /=
-             Array_of_Arrays(TC_Count+Interfaces.C.size_t(TC_Increment))
-          then
-             Report.Failed("Incorrect value returned following use " &
-                           "of the function +, incrementing by "     &
-                           Integer'Image(Integer(TC_Increment))      &
-                           ", array position : "                     &
-                           Integer'Image(Integer(TC_Count) +
-                                         Integer(TC_Increment)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
- 
-          TC_Count := TC_Count + Interfaces.C.size_t(TC_Increment);
-       end loop;
- 
- 
- 
-       -- Check that the "-" function with Pointer and ptrdiff_t parameters,
-       -- that returns a Pointer result, produces correct results, based
-       -- on the size of the array elements.
- 
-       -- Set the pointer to the last element in the char_array, which is a
-       -- nul char.
-       Char_Ptr := Ch_Array(Interfaces.C.size_t(Alphabet'Length))'Access;
- 
-       if Char_Ptr.all /= Interfaces.C.nul then
-          Report.Failed("Incorrect initial value for the last " &
-                        "Ch_Array value");
-       end if;
- 
-       Min_size_t := 1;
-       Max_size_t := Interfaces.C.size_t(Alphabet'Length);
- 
-       for i in reverse Min_size_t..Max_size_t loop
- 
-          -- Subtract 1 from the pointer; it should now point to the previous
-          -- element in the array.
-          Char_Ptr := Char_Ptr - 1;
- 
-          if Char_Ptr.all /= Ch_Array(i-1) then
-             Report.Failed("Incorrect value returned following use "        &
-                           "of the function '-' with char element values, " &
-                           "array position : " & Integer'Image(Integer(i-1)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
-       end loop;
- 
-       Array_Ptr    := Array_of_Arrays(Max_Array_Size)'Access;
-       TC_Count     := Max_Array_Size;
-       TC_Increment := 3;
-       while TC_Count > Min_Array_Size+Interfaces.C.size_t(TC_Increment) loop
- 
-          -- Decrement the pointer by 3.
-          Array_Ptr := Array_Pointers."-"(Array_Ptr, Right => 3);
- 
-          if Array_Ptr.all /=
-             Array_of_Arrays(TC_Count - Interfaces.C.size_t(TC_Increment))
-          then
-             Report.Failed("Incorrect value returned following use " &
-                           "of the function -, decrementing by "     &
-                           Integer'Image(Integer(TC_Increment))      &
-                           ", array position : "                     &
-                           Integer'Image(Integer(TC_Count-3)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
- 
-          TC_Count := TC_Count - Interfaces.C.size_t(TC_Increment);
-       end loop;
- 
- 
- 
-       -- Check that the "-" function with two Pointer parameters, that
-       -- returns a ptrdiff_t type result, produces correct results,
-       -- based on the size of the array elements.
- 
-       TC_ptrdiff_t := 9;
-       if Char_Pointers."-"(Left  => End_Char_Ptr,
-                            Right => Start_Char_Ptr) /= TC_ptrdiff_t
-       then
-          Report.Failed("Incorrect result from pointer-pointer " &
-                        "subtraction - 1");
-       end if;
- 
-       Start_Char_Ptr := Ch_Array(1)'Access;
-       End_Char_Ptr   := Ch_Array(25)'Access;
- 
-       TC_ptrdiff_t := 24;
-       if Char_Pointers."-"(End_Char_Ptr,
-                            Right => Start_Char_Ptr) /= TC_ptrdiff_t
-       then
-          Report.Failed("Incorrect result from pointer-pointer " &
-                        "subtraction - 2");
-       end if;
- 
-       TC_ptrdiff_t := 9;
-       if Array_Pointers."-"(End_Array_Ptr,
-                             Start_Array_Ptr) /= TC_ptrdiff_t
-       then
-          Report.Failed("Incorrect result from pointer-pointer " &
-                        "subtraction - 3");
-       end if;
- 
-       Start_Array_Ptr := Array_of_Arrays(Min_Array_Size)'Access;
-       End_Array_Ptr   := Array_of_Arrays(Max_Array_Size)'Access;
- 
-       TC_ptrdiff_t := Interfaces.C.ptrdiff_t(Max_Array_Size) -
-                       Interfaces.C.ptrdiff_t(Min_Array_Size);
-       if End_Array_Ptr - Start_Array_Ptr /= TC_ptrdiff_t then
-          Report.Failed("Incorrect result from pointer-pointer " &
-                        "subtraction - 4");
-       end if;
- 
- 
- 
-       -- Check that the Increment procedure produces correct results,
-       -- based upon the size of the array elements.
- 
-       Short_Ptr := Short_Array(0)'Access;
- 
-       for i in Min_Array_Size + 1 .. Max_Array_Size loop
-          -- Increment the value of the Pointer; it should now point
-          -- to the next element in the array.
-          Increment(Ref => Short_Ptr);
- 
-          if Short_Ptr.all /= Short_Array(i) then
-             Report.Failed("Incorrect value returned following use "      &
-                           "of the Procedure Increment on pointer to an " &
-                           "array of short values, array position : "     &
-                           Integer'Image(Integer(i)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
-       end loop;
- 
-       Array_Ptr := Array_of_Arrays(0)'Access;
- 
-       for i in Min_Array_Size + 1 .. Max_Array_Size loop
-          -- Increment the value of the Pointer; it should now point
-          -- to the next element in the array.
-          Increment(Array_Ptr);
- 
-          if Array_Ptr.all /= Array_of_Arrays(i) then
-             Report.Failed("Incorrect value returned following use "    &
-                           "of the Procedure Increment on an array of " &
-                           "arrays, array position : "                  &
-                           Integer'Image(Integer(i)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
-       end loop;
- 
- 
-       -- Check that the Decrement procedure produces correct results,
-       -- based upon the size of the array elements.
- 
-       Short_Ptr := Short_Array(Max_Array_Size)'Access;
- 
-       for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop
-          -- Decrement the value of the Pointer; it should now point
-          -- to the previous element in the array.
-          Decrement(Ref => Short_Ptr);
- 
-          if Short_Ptr.all /= Short_Array(i) then
-             Report.Failed("Incorrect value returned following use "      &
-                           "of the Procedure Decrement on pointer to an " &
-                           "array of short values, array position : "     &
-                           Integer'Image(Integer(i)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
-       end loop;
- 
-       Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access;
- 
-       for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop
-          -- Decrement the value of the Pointer; it should now point
-          -- to the previous array element.
-          Decrement(Array_Ptr);
- 
-          if Array_Ptr.all /= Array_of_Arrays(i) then
-             Report.Failed("Incorrect value returned following use "    &
-                           "of the Procedure Decrement on an array of " &
-                           "arrays, array position : "                  &
-                           Integer'Image(Integer(i)));
-             if not TC_Verbose then
-                exit;
-             end if;
-          end if;
-       end loop;
- 
- 
- 
-       -- Check that each of the "+" and "-" functions above will
-       -- propagate Pointer_Error if a Pointer parameter is null.
- 
-       begin
-          Short_Ptr := null;
-          Short_Ptr := Short_Ptr + 4;
-          Report.Failed("Pointer_Error not raised by Function + when " &
-                        "the Pointer parameter is null");
-          if Short_Ptr /= null then  -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Short_Pointers.Pointer_Error => null; -- OK, expected exception.
-          when others =>
-            Report.Failed("Unexpected exception raised by Function + " &
-                          "when the Pointer parameter is null");
-       end;
- 
- 
-       begin
-          Char_Ptr := null;
-          Char_Ptr := Char_Ptr - 1;
-          Report.Failed("Pointer_Error not raised by Function - when " &
-                        "the Pointer parameter is null");
-          if Char_Ptr /= null then  -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Char_Pointers.Pointer_Error => null; -- OK, expected exception.
-          when others =>
-            Report.Failed("Unexpected exception raised by Function - " &
-                          "when the Pointer parameter is null");
-       end;
- 
- 
-       begin
-          Array_Ptr := null;
-          Decrement(Array_Ptr);
-          Report.Failed("Pointer_Error not raised by Procedure Decrement " &
-                        "when the Pointer parameter is null");
-          if Array_Ptr /= null then  -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Array_Pointers.Pointer_Error => null; -- OK, expected exception.
-          when others =>
-            Report.Failed("Unexpected exception raised by Procedure " &
-                          "Decrement when the Pointer parameter is null");
-       end;
- 
- 
-    exception
-       when The_Error : others =>
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3016.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb3016.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb3016.a	Thu Jan  1 00:00:00 1970
***************
*** 1,516 ****
- -- CXB3016.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that function Virtual_Length returns the number of elements
- --      in the array referenced by the Pointer parameter Ref, up to (but 
- --      not including) the (first) instance of the element specified in 
- --      the Terminator parameter.
- --
- --      Check that the procedure Copy_Terminated_Array copies the array of
- --      elements referenced by Pointer parameter Source, into the array 
- --      pointed to by parameter Target, based on which of the following 
- --      two scenarios occurs first:
- --        1) copying the Terminator element, or
- --        2) copying the number of elements specified in parameter Limit.
- --
- --      Check that procedure Copy_Terminated_Array will propagate
- --      Dereference_Error if either the Source or Target parameter is null.
- --
- --      Check that procedure Copy_Array will copy an array of elements
- --      of length specified in parameter Length, referenced by the 
- --      Pointer parameter Source, into the array pointed to by parameter
- --      Target.
- --
- --      Check that procedure Copy_Array will propagate Dereference_Error
- --      if either the Source or Target parameter is null.
- --
- -- TEST DESCRIPTION:
- --      This test checks that the function Virtual_Length and the procedures
- --      Copy_Terminated_Array and Copy_Array in the generic package 
- --      Interfaces.C.Pointers will allow the user to manipulate arrays of
- --      char and short values through the pointers that reference the
- --      arrays.
- --
- --      Package Interfaces.C.Pointers is instantiated twice, once for
- --      short values and once for chars. Pointers from each instantiated
- --      package are then used to reference arrays of the appropriate 
- --      element type.  The subprograms under test are used to determine the
- --      length, and to copy, either portions or the entire content of the
- --      arrays.  The results of these operations are then compared against
- --      expected results.
- --
- --      The propagation of Dereference_Error is checked for when either
- --      of the two procedures is supplied with a null Pointer parameter.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.C.char:
- --      ' ', and 'a'..'z'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      packages Interfaces.C, Interfaces.C.Strings, and 
- --      Interfaces.C.Pointers. If an implementation provides these packages,
- --      this test must compile, execute, and report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      01 Feb 96   SAIC    Initial release for 2.1
- --      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      26 Oct 96   SAIC    Incorporated reviewer comments.
- --      26 Feb 97   PWB.CTA Moved code using null pointer to avoid errors
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.C;                                            -- N/A => ERROR
- with Interfaces.C.Pointers;                                   -- N/A => ERROR
- with Interfaces.C.Strings;                                    -- N/A => ERROR
- 
- procedure CXB3016 is
- begin
- 
-    Report.Test ("CXB3016", "Check that subprograms Virtual_Length, " &
-                            "Copy_Terminated_Array, and Copy_Array "  &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Interfaces.C.Strings;
- 
-       use type Interfaces.C.char,
-                Interfaces.C.char_array,
-                Interfaces.C.ptrdiff_t,
-                Interfaces.C.short,
-                Interfaces.C.size_t;
- 
-       TC_char          : Interfaces.C.char   :=   'a';
-       TC_ptrdiff_t     : Interfaces.C.ptrdiff_t;
-       TC_Short         : Interfaces.C.short  :=     0;
-       Min_Array_Size   : Interfaces.C.size_t :=     0;
-       Max_Array_Size   : Interfaces.C.size_t :=    20;
-       Short_Terminator : Interfaces.C.short  := Interfaces.C.short'Last;
-       Alphabet         : constant String     := "abcdefghijklmnopqrstuvwxyz";
-       Blank_String     : constant String     := "                          ";
- 
-       type Short_Array_Type is 
-         array (Interfaces.C.size_t range <>) of aliased Interfaces.C.short;
- 
-       Ch_Array         : Interfaces.C.char_array
-                            (0..Interfaces.C.size_t(Alphabet'Length)) :=
-                              Interfaces.C.To_C(Alphabet, True);
- 
-       TC_Ch_Array      : Interfaces.C.char_array
-                            (0..Interfaces.C.size_t(Blank_String'Length)) :=
-                              Interfaces.C.To_C(Blank_String, True);
- 
-       Short_Array      : Short_Array_Type(Min_Array_Size..Max_Array_Size);
-       TC_Short_Array   : Short_Array_Type(Min_Array_Size..Max_Array_Size);
- 
- 
-       package Char_Pointers is new 
-         Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
-                                Element            => Interfaces.C.char,
-                                Element_Array      => Interfaces.C.char_array,
-                                Default_Terminator => Interfaces.C.nul);
- 
-       package Short_Pointers is new 
-         Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
-                                Element            => Interfaces.C.short,
-                                Element_Array      => Short_Array_Type,
-                                Default_Terminator => Short_Terminator);
- 
-       use Short_Pointers, Char_Pointers;
- 
-       Short_Ptr    : Short_Pointers.Pointer := Short_Array(0)'Access;
-       TC_Short_Ptr : Short_Pointers.Pointer := TC_Short_Array(0)'Access;
-       Char_Ptr     : Char_Pointers.Pointer  := Ch_Array(0)'Access;
-       TC_Char_Ptr  : Char_Pointers.Pointer  := TC_Ch_Array(0)'Access;
- 
-    begin
- 
-       -- Provide initial values for the array that holds short int values.
- 
-       for i in Min_Array_Size..Max_Array_Size loop
-          Short_Array(i)    := Interfaces.C.short(i);
-          TC_Short_Array(i) := 100;
-       end loop;
- 
-       -- Set the final element of the short array object to be the "terminator"
-       -- element used in the instantiation above.
- 
-       Short_Array(Max_Array_Size) := Short_Terminator;
- 
-       -- Check starting pointer positions.
- 
-       if Short_Ptr.all /= 0 or 
-          Char_Ptr.all  /= Ch_Array(0)
-       then
-          Report.Failed("Incorrect initial value for the first " &
-                        "Char_Array or Short_Array values");
-       end if;
- 
- 
- 
-       -- Check that function Virtual_Length returns the number of elements
-       -- in the array referenced by the Pointer parameter Ref, up to (but 
-       -- not including) the (first) instance of the element specified in 
-       -- the Terminator parameter.
- 
-       TC_char := 'j';
-       
-       TC_ptrdiff_t := Char_Pointers.Virtual_Length(Ref        => Char_Ptr,
-                                                    Terminator => TC_char);
-       if TC_ptrdiff_t /= 9 then
-          Report.Failed("Incorrect result from function Virtual_Length " &
-                        "with Char_ptr parameter - 1");
-       end if;
- 
-       TC_char := Interfaces.C.nul;
-       
-       TC_ptrdiff_t := Char_Pointers.Virtual_Length(Char_Ptr,
-                                                    Terminator => TC_char);
-       if TC_ptrdiff_t /= Interfaces.C.ptrdiff_t(Alphabet'Length) then
-          Report.Failed("Incorrect result from function Virtual_Length " &
-                        "with Char_ptr parameter - 2");
-       end if;
- 
-       TC_Short := 10;
-       
-       TC_ptrdiff_t := Short_Pointers.Virtual_Length(Short_Ptr, TC_Short);
- 
-       if TC_ptrdiff_t /= 10 then
-          Report.Failed("Incorrect result from function Virtual_Length " &
-                        "with Short_ptr parameter - 1");
-       end if;
- 
-       -- Replace an element of the Short_Array with the element used as the
-       -- terminator of the entire array; now there are two occurrences of the
-       -- terminator element in the array.  The call to Virtual_Length should
-       -- return the number of array elements prior to the first terminator.
- 
-       Short_Array(5) := Short_Terminator;
- 
-       if Short_Pointers.Virtual_Length(Short_Ptr, Short_Terminator) /= 5
-       then
-          Report.Failed("Incorrect result from function Virtual_Length " &
-                        "with Short_ptr parameter - 2");
-       end if;
- 
- 
- 
-       -- Check that the procedure Copy_Terminated_Array copies the array of
-       -- elements referenced by Pointer parameter Source, into the array 
-       -- pointed to by parameter Target, based on which of the following 
-       -- two scenarios occurs first:
-       --   1) copying the Terminator element, or
-       --   2) copying the number of elements specified in parameter Limit.
-       -- Note: Terminator element must be copied to Target, as well as
-       --       all array elements prior to the terminator element.
-       
-       if TC_Ch_Array = Ch_Array then
-          Report.Failed("The two char arrays are equivalent prior to the " &
-                        "call to Copy_Terminated_Array - 1");
-       end if;
- 
- 
-       -- Case 1: Copying the Terminator Element.  (Default terminator)
- 
-       Char_Pointers.Copy_Terminated_Array(Source => Char_Ptr,
-                                           Target => TC_Char_Ptr);
- 
-       if TC_Ch_Array /= Ch_Array then
-          Report.Failed("The two char arrays are not equal following the " &
-                        "call to Copy_Terminated_Array, case of copying "  &
-                        "the Terminator Element, using default terminator");
-       end if;
- 
-       -- Reset the Target Pointer array.
- 
-       TC_Ch_Array := Interfaces.C.To_C(Blank_String, True);
-       TC_Char_Ptr := TC_Ch_Array(0)'Access;
- 
-       if TC_Ch_Array = Ch_Array then
-          Report.Failed("The two char arrays are equivalent prior to the " &
-                        "call to Copy_Terminated_Array - 2");
-       end if;
- 
- 
-       -- Case 2: Copying the Terminator Element.  (Non-Default terminator)
- 
-       TC_char := 'b';  -- Second char in char_array pointed to by Char_Ptr
-       Char_Pointers.Copy_Terminated_Array(Source     => Char_Ptr,
-                                           Target     => TC_Char_Ptr,
-                                           Terminator => TC_char);
- 
-       if TC_Ch_Array(0) /= Ch_Array(0)  or  -- Initial value modified.
-          TC_Ch_Array(1) /= Ch_Array(1)  or  -- Initial value modified.
-          TC_Ch_Array(2)  = Ch_Array(2)  or  -- Initial value not modified.
-          TC_Ch_Array(5)  = Ch_Array(5)  or  -- Initial value not modified.
-          TC_Ch_Array(15) = Ch_Array(15) or  -- Initial value not modified.
-          TC_Ch_Array(25) = Ch_Array(25)     -- Initial value not modified.
-       then
-          Report.Failed("The appropriate portions of the two char arrays " &
-                        "are not equal following the call to "        &
-                        "Copy_Terminated_Array, case of copying the " &
-                        "Terminator Element, using non-default terminator");
-       end if;
- 
- 
-       if TC_Short_Array = Short_Array then
-          Report.Failed("The two short int arrays are equivalent prior " &
-                        "to the call to Copy_Terminated_Array - 1");
-       end if;
- 
-       Short_Pointers.Copy_Terminated_Array(Source     => Short_Ptr,
-                                            Target     => TC_Short_Ptr,
-                                            Terminator => 2);
- 
-       if TC_Short_Array(0) /= Short_Array(0) or
-          TC_Short_Array(1) /= Short_Array(1) or
-          TC_Short_Array(2) /= Short_Array(2) or
-          TC_Short_Array(3) /= 100  -- Initial value not modified.
-       then
-          Report.Failed("The appropriate portions of the two short int " &
-                        "arrays are not equal following the call to "    &
-                        "Copy_Terminated_Array, case of copying the "    &
-                        "Terminator Element, using non-default terminator");
-       end if;
- 
- 
-       -- Case 3: Copying the number of elements specified in parameter Limit.
- 
-       if TC_Short_Array = Short_Array then
-          Report.Failed("The two short int arrays are equivalent prior " &
-                        "to the call to Copy_Terminated_Array - 2");
-       end if;
- 
-       TC_ptrdiff_t := 5;
- 
-       Short_Pointers.Copy_Terminated_Array(Source     => Short_Ptr,
-                                            Target     => TC_Short_Ptr,
-                                            Limit      => TC_ptrdiff_t,
-                                            Terminator => Short_Terminator);
- 
-       if TC_Short_Array(0) /= Short_Array(0) or
-          TC_Short_Array(1) /= Short_Array(1) or
-          TC_Short_Array(2) /= Short_Array(2) or
-          TC_Short_Array(3) /= Short_Array(3) or
-          TC_Short_Array(4) /= Short_Array(4) or
-          TC_Short_Array(5) /= 100  -- Initial value not modified.
-       then
-          Report.Failed("The appropriate portions of the two Short arrays "  &
-                        "are not equal following the call to "               &
-                        "Copy_Terminated_Array, case of copying the number " &
-                        "of elements specified in parameter Limit");
-       end if;
- 
- 
-       -- Case 4: Copying the number of elements specified in parameter Limit,
-       --         which also happens to be the number of elements up to and 
-       --         including the first terminator.
- 
-       -- Reset initial values for the array that holds short int values.
- 
-       for i in Min_Array_Size..Max_Array_Size loop
-          Short_Array(i)    := Interfaces.C.short(i);
-          TC_Short_Array(i) := 100;
-       end loop;
- 
-       if TC_Short_Array = Short_Array then
-          Report.Failed("The two short int arrays are equivalent prior " &
-                        "to the call to Copy_Terminated_Array - 3");
-       end if;
- 
-       TC_ptrdiff_t     := 3;  -- Specifies three elements to be copied.
-       Short_Terminator := 2;  -- Value held in Short_Array third element,
-                               -- will serve as the "terminator" element.
- 
-       Short_Pointers.Copy_Terminated_Array(Source     => Short_Ptr,
-                                            Target     => TC_Short_Ptr,
-                                            Limit      => TC_ptrdiff_t,
-                                            Terminator => Short_Terminator);
- 
-       if TC_Short_Array(0) /= Short_Array(0) or  -- First element copied.
-          TC_Short_Array(1) /= Short_Array(1) or  -- Second element copied.
-          TC_Short_Array(2) /= Short_Array(2) or  -- Third element copied.
-          TC_Short_Array(3) /= 100  -- Initial value of fourth element 
-       then                         -- not modified.
-          Report.Failed("The appropriate portions of the two Short arrays "  &
-                        "are not equal following the call to "               &
-                        "Copy_Terminated_Array, case of copying the number " &
-                        "of elements specified in parameter "                &
-                        "Limit, which also happens to be the number of "     &
-                        "elements up to and including the first terminator");
-       end if;
- 
- 
- 
-       -- Check that procedure Copy_Terminated_Array will propagate
-       -- Dereference_Error if either the Source or Target parameter is null.
-       
-       Char_Ptr := null;
-       begin
-          Char_Pointers.Copy_Terminated_Array(Char_Ptr, TC_Char_Ptr);
-          Report.Failed("Dereference_Error not raised by call to " &
-                        "Copy_Terminated_Array with null Source parameter");
-          if TC_Char_Ptr = null then  -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Dereference_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by call to " &
-                           "Copy_Terminated_Array with null Source parameter");
-       end;
-       
-       TC_Short_Ptr := null;
-       begin
-          Short_Pointers.Copy_Terminated_Array(Short_Ptr, TC_Short_Ptr);
-          Report.Failed("Dereference_Error not raised by call to " &
-                        "Copy_Terminated_Array with null Target parameter");
-          if Short_Ptr = null then  -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Dereference_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by call to " & 
-                           "Copy_Terminated_Array with null Target parameter");
-       end;
- 
- 
- 
-       -- Check that the procedure Copy_Array will copy the array of 
-       -- elements of length specified in parameter Length, referenced by 
-       -- the Pointer parameter Source, into the array pointed to by 
-       -- parameter Target.
-       
-       -- Reinitialize Target arrays prior to test cases below.
- 
-       TC_Ch_Array  := Interfaces.C.To_C(Blank_String, True);
- 
-       for i in Min_Array_Size..Max_Array_Size loop
-          TC_Short_Array(i) := 100;
-       end loop;
- 
-       Char_Ptr     := Ch_Array(0)'Access;
-       TC_Char_Ptr  := TC_Ch_Array(0)'Access;
-       Short_Ptr    := Short_Array(0)'Access;
-       TC_Short_Ptr := TC_Short_Array(0)'Access;
- 
-       TC_ptrdiff_t := 4;
- 
-       Char_Pointers.Copy_Array(Source => Char_Ptr,
-                                Target => TC_Char_Ptr,
-                                Length => TC_ptrdiff_t);
- 
-       if TC_Ch_Array(0) /= Ch_Array(0) or
-          TC_Ch_Array(1) /= Ch_Array(1) or
-          TC_Ch_Array(2) /= Ch_Array(2) or
-          TC_Ch_Array(3) /= Ch_Array(3) or
-          TC_Ch_Array(4)  = Ch_Array(4) 
-       then
-          Report.Failed("Incorrect result from Copy_Array when using " &
-                        "char pointer arguments, partial array copied");
-       end if;
- 
- 
-       TC_ptrdiff_t := Interfaces.C.ptrdiff_t(Max_Array_Size) + 1;
- 
-       Short_Pointers.Copy_Array(Short_Ptr, TC_Short_Ptr, TC_ptrdiff_t);
- 
-       if TC_Short_Array /= Short_Array then
-          Report.Failed("Incorrect result from Copy_Array when using Short " &
-                        "pointer arguments, entire array copied");
-       end if;
- 
- 
- 
-       -- Check that procedure Copy_Array will propagate Dereference_Error
-       -- if either the Source or Target parameter is null.
-       
-       Char_Ptr := null;
-       begin
-          Char_Pointers.Copy_Array(Char_Ptr, TC_Char_Ptr, TC_ptrdiff_t);
-          Report.Failed("Dereference_Error not raised by call to " &
-                        "Copy_Array with null Source parameter");
-          if TC_Char_Ptr = null then  -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Dereference_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by call to " &
-                           "Copy_Array with null Source parameter");
-       end;
-       
-       TC_Short_Ptr := null;
-       begin
-          Short_Pointers.Copy_Array(Short_Ptr, TC_Short_Ptr, TC_ptrdiff_t);
-          Report.Failed("Dereference_Error not raised by call to " &
-                        "Copy_Array with null Target parameter");
-          if Short_Ptr = null then  -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Dereference_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by call to " &
-                           "Copy_Array with null Target parameter");
-       end;
- 
- 
-       -- Check that function Virtual_Length will propagate Dereference_Error 
-       -- if the Source parameter is null.
-       
-       Char_Ptr := null;
-       begin
-          TC_ptrdiff_t := Char_Pointers.Virtual_Length(Char_Ptr,
-                                                       Terminator => TC_char);
-          Report.Failed("Dereference_Error not raised by call to " &
-                        "Virtual_Length with null Source parameter");
-          if TC_ptrdiff_t = 100 then    -- To avoid optimization.
-             Report.Comment("This should never be printed");
-          end if;
-       exception
-          when Dereference_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by call to " &
-                           "Virtual_Length with null Source parameter");
-       end;
-       
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB3016;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,230 ****
- -- CXB4001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the specifications of the package Interfaces.COBOL
- --      are available for use
- --
- -- TEST DESCRIPTION: 
- --      This test verifies that the type and the subprograms specified for
- --      the interface are present.
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Nov 95   SAIC    Corrected visibility errors for ACVC 2.0.1.
- --      28 Feb 96   SAIC    Added applicability criteria.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --      01 DEC 97   EDS     Change "To_Comp" to "To_Binary".
- --!
- 
- with Report;
- with Interfaces.COBOL;                                        -- N/A => ERROR
- 
- procedure CXB4001 is
- 
-    package COBOL renames Interfaces.COBOL;
-    use type COBOL.Byte;
-    use type COBOL.Decimal_Element;
- 
- begin
- 
-    Report.Test ("CXB4001", "Check the specification of Interfaces.COBOL");
- 
- 
-    declare  -- encapsulate the test
- 
-       --  Types and operations for internal data representations
-  
-       TST_Floating : COBOL.Floating;
-       TST_Long_Floating : COBOL.Long_Floating;
- 
-       TST_Binary        : COBOL.Binary;
-       TST_Long_Binary   : COBOL.Long_Binary;
- 
-       TST_Max_Digits_Binary      : constant := COBOL.Max_Digits_Binary; 
-       TST_Max_Digits_Long_Binary : constant := COBOL.Max_Digits_Long_Binary;
- 
-       TST_Decimal_Element : COBOL.Decimal_Element;
- 
-       TST_Packed_Decimal : COBOL.Packed_Decimal (1..5) := 
-                                     (others => COBOL.Decimal_Element'First);
- 
-       --  initialize it so it can reasonably be used later
-       TST_COBOL_Character : COBOL.COBOL_Character :=
-                                                 COBOL.COBOL_Character'First;
- 
-       TST_Ada_To_COBOL : COBOL.COBOL_Character :=  
-                                           COBOL.Ada_To_COBOL (Character'First);
- 
-       TST_COBOL_To_Ada : Character :=  
-                               COBOL.COBOL_To_Ada (COBOL.COBOL_Character'First);
- 
-       --  assignment to make sure it is an array of  COBOL_Character
-       TST_Alphanumeric : COBOL.Alphanumeric (1..5) := 
-                                              (others => TST_COBOL_Character);
- 
-         
-       --  assignment to make sure it is an array of  COBOL_Character
-       TST_Numeric : COBOL.Numeric (1..5) := (others => TST_COBOL_Character);
- 
- 
-       procedure Collect_All_Calls is
- 
-          CAC_Alphanumeric : COBOL.Alphanumeric(1..5) :=
-                               COBOL.To_COBOL("abcde");
-          CAC_String       : String (1..5) := "vwxyz";
-          CAC_Natural      : natural       := 0;
- 
-       begin
-    
-          CAC_Alphanumeric := COBOL.To_COBOL (CAC_String);
-          CAC_String := COBOL.To_Ada  (CAC_Alphanumeric);
- 
-          COBOL.To_COBOL (CAC_String, CAC_Alphanumeric, CAC_Natural);
-          COBOL.To_Ada (CAC_Alphanumeric, CAC_String, CAC_Natural);
- 
-          raise COBOL.Conversion_Error;
- 
-       end Collect_All_Calls;
- 
- 
- 
-       --  Formats for COBOL data representations
- 
-       TST_Unsigned   : COBOL.Display_Format := COBOL.Unsigned;
-       TST_Leading_Separate : COBOL.Display_Format := COBOL.Leading_Separate;
-       TST_Trailing_Separate : COBOL.Display_Format := COBOL.Trailing_Separate;
-       TST_Leading_Nonseparate  : COBOL.Display_Format :=  
-                                                    COBOL.Leading_Nonseparate;
-       TST_Trailing_Nonseparate : COBOL.Display_Format :=  
-                                                    COBOL.Trailing_Nonseparate;
- 
- 
-       TST_High_Order_First  : COBOL.Binary_Format := COBOL.High_Order_First;
-       TST_Low_Order_First   : COBOL.Binary_Format := COBOL.Low_Order_First;
-       TST_Native_Binary     : COBOL.Binary_Format := COBOL.Native_Binary;
- 
- 
-       TST_Packed_Unsigned   : COBOL.Packed_Format := COBOL.Packed_Unsigned;
-       TST_Packed_Signed     : COBOL.Packed_Format := COBOL.Packed_Signed;
- 
- 
-       --  Types for external representation of COBOL binary data
- 
-       TST_Byte_Array : COBOL.Byte_Array(1..5) := (others => COBOL.Byte'First);
- 
-       -- Now instantiate one version of the generic
-       --
-       type bx4001_Decimal is delta 0.1 digits 5;
-       package bx4001_conv is new COBOL.Decimal_Conversions (bx4001_Decimal);
- 
-       procedure Collect_All_Generic_Calls is
-          CAGC_natural        : natural;
-          CAGC_Display_Format : COBOL.Display_Format;
-          CAGC_Boolean        : Boolean;
-          CAGC_Numeric        : COBOL.Numeric(1..5);
-          CAGC_Num            : bx4001_Decimal;
-          CAGC_Packed_Decimal : COBOL.Packed_Decimal (1..5);
-          CAGC_Packed_Format  : COBOL.Packed_Format; 
-          CAGC_Byte_Array     : COBOL.Byte_Array (1..5);
-          CAGC_Binary_Format  : COBOL.Binary_Format;
-          CAGC_Binary         : COBOL.Binary;
-          CAGC_Long_Binary    : COBOL.Long_Binary;
-       begin
- 
-          --  Display Formats: data values are represented as Numeric
-          
-          CAGC_Boolean := bx4001_conv.Valid (CAGC_Numeric, CAGC_Display_Format);
-          CAGC_Natural := bx4001_conv.Length (CAGC_Display_Format);
- 
-          CAGC_Num := bx4001_conv.To_Decimal 
-                                        (CAGC_Numeric, CAGC_Display_Format);
-          CAGC_Numeric := bx4001_conv.To_Display 
-                                        (CAGC_Num, CAGC_Display_Format);
- 
- 
-          --  Packed Formats: data values are represented as Packed_Decimal
-          
-          CAGC_Boolean := bx4001_conv.Valid 
-                                     (CAGC_Packed_Decimal, CAGC_Packed_Format);
- 
-          CAGC_Natural := bx4001_conv.Length (CAGC_Packed_Format);
- 
-          CAGC_Num := bx4001_conv.To_Decimal 
-                                     (CAGC_Packed_Decimal, CAGC_Packed_Format);
- 
-          CAGC_Packed_Decimal := bx4001_conv.To_Packed 
-                                     (CAGC_Num, CAGC_Packed_Format);
- 
- 
-          --  Binary Formats: external data values are represented as 
-          --  Byte_Array
- 
-          CAGC_Boolean := bx4001_conv.Valid 
-                                     (CAGC_Byte_Array, CAGC_Binary_Format);
-          
-          CAGC_Natural := bx4001_conv.Length (CAGC_Binary_Format);
-          CAGC_Num := bx4001_conv.To_Decimal 
-                                     (CAGC_Byte_Array, CAGC_Binary_Format);
- 
-          CAGC_Byte_Array := bx4001_conv.To_Binary (CAGC_Num, CAGC_Binary_Format);
- 
- 
-          --  Internal Binary formats: data values are of type 
-          --  Binary/Long_Binary
- 
-          CAGC_Num := bx4001_conv.To_Decimal (CAGC_Binary);
-          CAGC_Num := bx4001_conv.To_Decimal (CAGC_Long_Binary);
- 
-          CAGC_Binary       := bx4001_conv.To_Binary (CAGC_Num);
-          CAGC_Long_Binary  := bx4001_conv.To_Long_Binary (CAGC_Num);
-          
- 
-       end Collect_All_Generic_Calls;
- 
- 
-    begin    -- encapsulation
- 
-       if COBOL.Byte'First /= 0     or
-          COBOL.Byte'Last  /=  (2 ** COBOL.COBOL_Character'Size) - 1 then
-             Report.Failed ("Byte is incorrectly defined");
-       end if;
- 
-       if  COBOL.Decimal_Element'First /= 0 then
-          Report.Failed ("Decimal_Element is incorrectly defined");
-       end if;
- 
-    end;     -- encapsulation
- 
-    Report.Result;
- 
- end CXB4001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,308 ****
- -- CXB4002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedure To_COBOL converts the character elements 
- --      of the String parameter Item into COBOL_Character elements of the 
- --      Alphanumeric type parameter Target, using the Ada_to_COBOL mapping 
- --      as the basis of conversion.  
- --      Check that the parameter Last contains the index of the last element 
- --      of parameter Target that was assigned by To_COBOL.
- --
- --      Check that Constraint_Error is propagated by procedure To_COBOL 
- --      when the length of String parameter Item exceeds the length of 
- --      Alphanumeric parameter Target.
- --
- --      Check that the procedure To_Ada converts the COBOL_Character 
- --      elements of the Alphanumeric parameter Item into Character elements 
- --      of the String parameter Target, using the COBOL_to_Ada mapping array 
- --      as the basis of conversion.  
- --      Check that the parameter Last contains the index of the last element 
- --      of parameter Target that was assigned by To_Ada.
- --
- --      Check that Constraint_Error is propagated by procedure To_Ada when 
- --      the length of Alphanumeric parameter Item exceeds the length of 
- --      String parameter Target.
- --
- -- TEST DESCRIPTION:
- --      This test checks that the procedures To_COBOL and To_Ada produce
- --      the correct results, based on a variety of parameter input values.
- --      
- --      In the first series of subtests, the Out parameter results of 
- --      procedure To_COBOL are compared against expected results,
- --      which includes (in the parameter Last) the index in Target of the 
- --      last element assigned.  The situation where procedure To_COBOL raises
- --      Constraint_Error (when Item'Length exceeds Target'Length) is also
- --      verified.
- --
- --      In the second series of subtests, the Out parameter results of 
- --      procedure To_Ada are verified, in a similar manner as is done for
- --      procedure To_COBOL.  The case of procedure To_Ada raising 
- --      Constraint_Error is also verified.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.COBOL.COBOL_Character:
- --      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*', '$', '-', '_', and '#'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      12 Jan 96   SAIC    Initial prerelease version.
- --      30 May 96   SAIC    Added applicability criteria for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Ada.Strings.Bounded;
- with Ada.Strings.Unbounded;
- with Interfaces.COBOL;                                          -- N/A => ERROR
- 
- procedure CXB4002 is
- begin
- 
-    Report.Test ("CXB4002", "Check that the procedures To_COBOL and " &
-                            "To_Ada produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
-       package Unb renames Ada.Strings.Unbounded;
- 
-       use Interfaces;
-       use Bnd, Unb;
-       use type Interfaces.COBOL.Alphanumeric;
- 
- 
-       Alphanumeric_1     : COBOL.Alphanumeric(1..1)  := " ";
-       Alphanumeric_5     : COBOL.Alphanumeric(1..5)  := "     ";
-       Alphanumeric_10    : COBOL.Alphanumeric(1..10) := "          ";
-       Alphanumeric_20    : COBOL.Alphanumeric(1..20) := "                    ";
-       TC_Alphanumeric_1  : COBOL.Alphanumeric(1..1)  := "A";
-       TC_Alphanumeric_5  : COBOL.Alphanumeric(1..5)  := "ab*de";
-       TC_Alphanumeric_10 : COBOL.Alphanumeric(1..10) := "$1a2b3C4D5";
-       TC_Alphanumeric_20 : COBOL.Alphanumeric(1..20) := "1234-ABCD_6789#fghij";
- 
-       Bnd_String         : Bnd.Bounded_String   :=
-                              Bnd.To_Bounded_String("          ");
-       TC_Bnd_String      : Bounded_String       :=
-                              To_Bounded_String("$1a2b3C4D5");
- 
-       Unb_String         : Unb.Unbounded_String :=
-                              Unb.To_Unbounded_String("     ");
-       TC_Unb_String      : Unbounded_String     :=
-                              To_Unbounded_String("ab*de");
- 
-       String_1           : String(1..1)   := " ";
-       String_5           : String(1..5)   := "     ";
-       String_10          : String(1..10)  := "          ";
-       String_20          : String(1..20)  := "                    ";
-       TC_String_1        : String(1..1)   := "A";
-       TC_String_20       : String(1..20)  := "1234-ABCD_6789#fghij";
- 
-       TC_Alphanumeric    : constant COBOL.Alphanumeric := ""; -- null array.
-       TC_String          : constant String := "";             -- null string.
-       TC_Natural         : Natural         := 0;
- 
- 
-    begin
- 
-       -- Check that the procedure To_COBOL converts the character elements 
-       -- of the String parameter Item into COBOL_Character elements of the 
-       -- Alphanumeric type parameter Target, using the Ada_to_COBOL mapping 
-       -- as the basis of conversion.  
-       -- Check that the parameter Last contains the index of the last element 
-       -- of parameter Target that was assigned by To_COBOL.
-       
-       COBOL.To_COBOL(Item   => TC_String_1,
-                      Target => Alphanumeric_1,
-                      Last   => TC_Natural);
- 
-       if Alphanumeric_1 /= TC_Alphanumeric_1        or
-          TC_Natural     /= TC_Alphanumeric_1'Length or
-          TC_Natural     /= 1
-       then
-          Report.Failed("Incorrect result from procedure To_COBOL - 1");
-       end if;
- 
-       COBOL.To_COBOL(To_String(TC_Unb_String),
-                      Target => Alphanumeric_5,
-                      Last   => TC_Natural);
- 
-       if Alphanumeric_5 /= TC_Alphanumeric_5        or
-          TC_Natural     /= TC_Alphanumeric_5'Length or
-          TC_Natural     /= 5
-       then
-          Report.Failed("Incorrect result from procedure To_COBOL - 2");
-       end if;
- 
-       COBOL.To_COBOL(To_String(TC_Bnd_String),
-                      Alphanumeric_10,
-                      Last   => TC_Natural);
- 
-       if Alphanumeric_10 /= TC_Alphanumeric_10        or
-          TC_Natural      /= TC_Alphanumeric_10'Length or
-          TC_Natural      /= 10
-       then
-          Report.Failed("Incorrect result from procedure To_COBOL - 3");
-       end if;
- 
-       COBOL.To_COBOL(TC_String_20,
-                      Alphanumeric_20,
-                      TC_Natural);
- 
-       if Alphanumeric_20 /= TC_Alphanumeric_20        or
-          TC_Natural      /= TC_Alphanumeric_20'Length or
-          TC_Natural      /= 20
-       then
-          Report.Failed("Incorrect result from procedure To_COBOL - 4");
-       end if;
- 
-       COBOL.To_COBOL(Item   => TC_String,     -- null string
-                      Target => Alphanumeric_1,
-                      Last   => TC_Natural);
- 
-       if TC_Natural /= 0 then
-          Report.Failed("Incorrect result from procedure To_COBOL, value "  &
-                        "returned in parameter Last should be zero, since " &
-                        "parameter Item is null array");
-       end if;
- 
- 
- 
-       -- Check that Constraint_Error is propagated by procedure To_COBOL 
-       -- when the length of String parameter Item exceeds the length of 
-       -- Alphanumeric parameter Target.
- 
-       begin
- 
-          COBOL.To_COBOL(Item   => TC_String_20,
-                         Target => Alphanumeric_10,
-                         Last   => TC_Natural);
-          Report.Failed("Constraint_Error not raised by procedure To_COBOL " &
-                        "when Item'Length exceeds Target'Length");
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by procedure To_COBOL " &
-                           "when Item'Length exceeds Target'Length");
-       end;
- 
-       
-       -- Check that the procedure To_Ada converts the COBOL_Character 
-       -- elements of the Alphanumeric parameter Item into Character elements 
-       -- of the String parameter Target, using the COBOL_to_Ada mapping array 
-       -- as the basis of conversion.  
-       -- Check that the parameter Last contains the index of the last element 
-       -- of parameter Target that was assigned by To_Ada.
-       
-       COBOL.To_Ada(Item   => TC_Alphanumeric_1,
-                    Target => String_1,
-                    Last   => TC_Natural);
- 
-       if String_1   /= TC_String_1        or
-          TC_Natural /= TC_String_1'Length or
-          TC_Natural /= 1
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 1");
-       end if;
- 
-       COBOL.To_Ada(TC_Alphanumeric_5,
-                    Target => String_5,
-                    Last   => TC_Natural);
- 
-       if String_5   /= To_String(TC_Unb_String) or
-          TC_Natural /= Length(TC_Unb_String)    or
-          TC_Natural /= 5
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 2");
-       end if;
- 
-       COBOL.To_Ada(TC_Alphanumeric_10,
-                    String_10,
-                    Last   => TC_Natural);
- 
-       if String_10   /= To_String(TC_Bnd_String) or
-          TC_Natural  /= Length(TC_Bnd_String)    or
-          TC_Natural  /= 10
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 3");
-       end if;
- 
-       COBOL.To_Ada(TC_Alphanumeric_20,
-                    String_20,
-                    TC_Natural);
- 
-       if String_20   /= TC_String_20        or
-          TC_Natural  /= TC_String_20'Length or
-          TC_Natural  /= 20
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 4");
-       end if;
- 
-       COBOL.To_Ada(Item   => TC_Alphanumeric,  -- null array.
-                    Target => String_20,
-                    Last   => TC_Natural);
- 
-       if TC_Natural /= 0 then
-          Report.Failed("Incorrect result from procedure To_Ada, value "    &
-                        "returned in parameter Last should be zero, since " &
-                        "parameter Item is null array");
-       end if;
- 
- 
- 
-       -- Check that Constraint_Error is propagated by procedure To_Ada when 
-       -- the length of Alphanumeric parameter Item exceeds the length of 
-       -- String parameter Target.
- 
-       begin
- 
-          COBOL.To_Ada(Item   => TC_Alphanumeric_10,
-                       Target => String_5,
-                       Last   => TC_Natural);
-          Report.Failed("Constraint_Error not raised by procedure To_Ada " &
-                        "when Item'Length exceeds Target'Length");
-       exception
-          when Constraint_Error => null;  -- OK, expected exception.
-          when others           =>
-             Report.Failed("Incorrect exception raised by procedure To_Ada " &
-                           "when Item'Length exceeds Target'Length");
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB4002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,310 ****
- -- CXB4003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that function Valid, with the Display_Format parameter 
- --      set to Unsigned, will return True if Numeric parameter Item 
- --      comprises one or more decimal digit characters; check that it 
- --      returns False if the parameter Item is otherwise comprised.
- --
- --      Check that function Valid, with Display_Format parameter set to 
- --      Leading_Separate, will return True if Numeric parameter Item 
- --      comprises a single occurrence of a Plus_Sign or Minus_Sign 
- --      character, and then by one or more decimal digit characters; 
- --      check that it returns False if the parameter Item is otherwise 
- --      comprised.
- --
- --      Check that function Valid, with Display_Format parameter set to 
- --      Trailing_Separate, will return True if Numeric parameter Item 
- --      comprises one or more decimal digit characters, and then by a 
- --      single occurrence of the Plus_Sign or Minus_Sign character; 
- --      check that it returns False if the parameter Item is otherwise
- --      comprised.
- --
- -- TEST DESCRIPTION:
- --      This test checks that a version of function Valid, from an instance
- --      of the generic package Decimal_Conversions, will produce correct
- --      results based on the particular Numeric and Display_Format
- --      parameters provided.  Arrays of both valid and invalid Numeric
- --      data items have been created to correspond to a particular
- --      value of Display_Format.  The result of the function is compared
- --      against the expected result for each appropriate combination of
- --      Numeric and Display_Format parameter.
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.COBOL.COBOL_Character:
- --      ' ', 'A'..'Z', '+', '-', '.', '$'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --      
- --       
- -- CHANGE HISTORY:
- --      18 Jan 96   SAIC    Initial version for 2.1. 
- --      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.COBOL;                                          -- N/A => ERROR
- 
- procedure CXB4003 is
- begin
- 
-    Report.Test ("CXB4003", "Check that function Valid, with various "     &
-                            "Display_Format parameters, produces correct " &
-                            "results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces;
-       use Ada.Exceptions;
- 
-       type A_Numeric_Type     is delta 0.01 digits 16;
-       type Numeric_Access     is access COBOL.Numeric;
-       type Numeric_Items_Type is array(Integer range <>) of Numeric_Access;
- 
-       package Display_Format is 
-         new COBOL.Decimal_Conversions(Num => A_Numeric_Type);
- 
- 
-       Number_Of_Valid_Unsigned_Items            : constant :=  5;
-       Number_Of_Invalid_Unsigned_Items          : constant := 21;
-       Number_Of_Valid_Leading_Separate_Items    : constant :=  5;
-       Number_Of_Invalid_Leading_Separate_Items  : constant := 23;
-       Number_Of_Valid_Trailing_Separate_Items   : constant :=  5;
-       Number_Of_Invalid_Trailing_Separate_Items : constant := 22;
- 
-       Valid_Unsigned_Items :
-         Numeric_Items_Type(1..Number_Of_Valid_Unsigned_Items) :=
-           (new COBOL.Numeric'("0"),
-            new COBOL.Numeric'("1"),
-            new COBOL.Numeric'("0000000001"),
-            new COBOL.Numeric'("1234567890123456"),
-            new COBOL.Numeric'("0000"));
- 
-       Invalid_Unsigned_Items :        
-         Numeric_Items_Type(1..Number_Of_Invalid_Unsigned_Items) :=
-           (new COBOL.Numeric'(" 12345"),
-            new COBOL.Numeric'("    12345"),
-            new COBOL.Numeric'("1234567890 "),
-            new COBOL.Numeric'("1234567890   "),
-            new COBOL.Numeric'("1.01"),
-            new COBOL.Numeric'(".0000000001"),
-            new COBOL.Numeric'("12345 6"),
-            new COBOL.Numeric'("MCXVIII"),
-            new COBOL.Numeric'("15F"),
-            new COBOL.Numeric'("+12345"),
-            new COBOL.Numeric'("$12.30"),
-            new COBOL.Numeric'("1234-"),
-            new COBOL.Numeric'("12--"),
-            new COBOL.Numeric'("+12-"),
-            new COBOL.Numeric'("++99--"),
-            new COBOL.Numeric'("-1.01"),
-            new COBOL.Numeric'("(1.01)"),
-            new COBOL.Numeric'("123,456"),
-            new COBOL.Numeric'("101."),
-            new COBOL.Numeric'(""),
-            new COBOL.Numeric'("1.0000"));
- 
-       Valid_Leading_Separate_Items : 
-         Numeric_Items_Type(1..Number_Of_Valid_Leading_Separate_Items) :=
-           (new COBOL.Numeric'("+1000"),
-            new COBOL.Numeric'("-1"),
-            new COBOL.Numeric'("-0000000001"),
-            new COBOL.Numeric'("+1234567890123456"),
-            new COBOL.Numeric'("-0000"));
- 
-       Invalid_Leading_Separate_Items :
-         Numeric_Items_Type(1..Number_Of_Invalid_Leading_Separate_Items) :=
-           (new COBOL.Numeric'("123456"),
-            new COBOL.Numeric'(" +12345"),
-            new COBOL.Numeric'("    +12345"),
-            new COBOL.Numeric'("- 0000000001"),
-            new COBOL.Numeric'("1234567890- "),
-            new COBOL.Numeric'("1234567890+   "),
-            new COBOL.Numeric'("123-456"),
-            new COBOL.Numeric'("+15F"),
-            new COBOL.Numeric'("++123"),
-            new COBOL.Numeric'("12--"),
-            new COBOL.Numeric'("+12-"),
-            new COBOL.Numeric'("+/-12"),
-            new COBOL.Numeric'("++99--"),
-            new COBOL.Numeric'("1.01"),
-            new COBOL.Numeric'("(1.01)"),
-            new COBOL.Numeric'("+123,456"),
-            new COBOL.Numeric'("+15FF"),
-            new COBOL.Numeric'("- 123"),
-            new COBOL.Numeric'("+$123"),
-            new COBOL.Numeric'(""),
-            new COBOL.Numeric'("-"),
-            new COBOL.Numeric'("-1.01"),
-            new COBOL.Numeric'("1.0000+"));
- 
-       Valid_Trailing_Separate_Items : 
-         Numeric_Items_Type(1..Number_Of_Valid_Trailing_Separate_Items) :=
-           (new COBOL.Numeric'("1001-"),
-            new COBOL.Numeric'("1+"),
-            new COBOL.Numeric'("0000000001+"),
-            new COBOL.Numeric'("1234567890123456-"),
-            new COBOL.Numeric'("0000-"));
- 
-       Invalid_Trailing_Separate_Items :
-         Numeric_Items_Type(1..Number_Of_Invalid_Trailing_Separate_Items) :=
-           (new COBOL.Numeric'("123456"),
-            new COBOL.Numeric'("+12345"),
-            new COBOL.Numeric'("12345 "),
-            new COBOL.Numeric'("123- "),
-            new COBOL.Numeric'("123-   "),
-            new COBOL.Numeric'("12345 +"),
-            new COBOL.Numeric'("12345+   "),
-            new COBOL.Numeric'("-0000000001"),
-            new COBOL.Numeric'("123-456"),
-            new COBOL.Numeric'("12--"),
-            new COBOL.Numeric'("+12-"),
-            new COBOL.Numeric'("99+-"),
-            new COBOL.Numeric'("12+/-"),
-            new COBOL.Numeric'("12.01-"),
-            new COBOL.Numeric'("$12.01+"),
-            new COBOL.Numeric'("(1.01)"),
-            new COBOL.Numeric'("DM12-"),
-            new COBOL.Numeric'("123,456+"),
-            new COBOL.Numeric'(""),
-            new COBOL.Numeric'("-"),
-            new COBOL.Numeric'("1.01-"),
-            new COBOL.Numeric'("+1.0000"));
- 
-    begin
- 
-       -- Check that function Valid, with the Display_Format parameter 
-       -- set to Unsigned, will return True if Numeric parameter Item 
-       -- comprises one or more decimal digit characters; check that it 
-       -- returns False if the parameter Item is otherwise comprised.
- 
-       for i in 1..Number_of_Valid_Unsigned_Items loop
-          -- Fail if the Item parameter is _NOT_ considered Valid.
-          if not Display_Format.Valid(Item   => Valid_Unsigned_Items(i).all, 
-                                      Format => COBOL.Unsigned)
-          then
-             Report.Failed("Incorrect result from function Valid, with "  &
-                           "Format parameter set to Unsigned, for valid " &
-                           "format item number " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-       for i in 1..Number_of_Invalid_Unsigned_Items loop
-          -- Fail if the Item parameter _IS_ considered Valid.
-          if Display_Format.Valid(Item   => Invalid_Unsigned_Items(i).all, 
-                                  Format => COBOL.Unsigned)
-          then
-             Report.Failed("Incorrect result from function Valid, with "    &
-                           "Format parameter set to Unsigned, for invalid " &
-                           "format item number " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
- 
-       -- Check that function Valid, with Display_Format parameter set to 
-       -- Leading_Separate, will return True if Numeric parameter Item 
-       -- comprises a single occurrence of a Plus_Sign or Minus_Sign 
-       -- character, and then by one or more decimal digit characters; 
-       -- check that it returns False if the parameter Item is otherwise 
-       -- comprised.
- 
-       for i in 1..Number_of_Valid_Leading_Separate_Items loop
-          -- Fail if the Item parameter is _NOT_ considered Valid.
-          if not Display_Format.Valid(Valid_Leading_Separate_Items(i).all, 
-                                      Format => COBOL.Leading_Separate)
-          then
-             Report.Failed("Incorrect result from function Valid, with " &
-                           "Format parameter set to Leading_Separate, "  &
-                           "for valid format item number " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-       for i in 1..Number_of_Invalid_Leading_Separate_Items loop
-          -- Fail if the Item parameter _IS_ considered Valid.
-          if Display_Format.Valid(Invalid_Leading_Separate_Items(i).all, 
-                                  Format => COBOL.Leading_Separate)
-          then
-             Report.Failed("Incorrect result from function Valid, with " &
-                           "Format parameter set to Leading_Separate, "  &
-                           "for invalid format item number "             &
-                           Integer'Image(i));
-          end if;
-       end loop;
- 
- 
- 
-       -- Check that function Valid, with Display_Format parameter set to 
-       -- Trailing_Separate, will return True if Numeric parameter Item 
-       -- comprises one or more decimal digit characters, and then by a 
-       -- single occurrence of the Plus_Sign or Minus_Sign character; 
-       -- check that it returns False if the parameter Item is otherwise
-       -- comprised.
- 
-       for i in 1..Number_of_Valid_Trailing_Separate_Items loop
-          -- Fail if the Item parameter is _NOT_ considered Valid.
-          if not Display_Format.Valid(Valid_Trailing_Separate_Items(i).all, 
-                                      COBOL.Trailing_Separate)
-          then
-             Report.Failed("Incorrect result from function Valid, with " &
-                           "Format parameter set to Trailing_Separate, " &
-                           "for valid format item number " & Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-       for i in 1..Number_of_Invalid_Trailing_Separate_Items loop
-          -- Fail if the Item parameter _IS_ considered Valid.
-          if Display_Format.Valid(Invalid_Trailing_Separate_Items(i).all, 
-                                  COBOL.Trailing_Separate)
-          then
-             Report.Failed("Incorrect result from function Valid, with " &
-                           "Format parameter set to Trailing_Separate, " &
-                           "for invalid format item number "             &
-                           Integer'Image(i));
-          end if;
-       end loop;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB4003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,443 ****
- -- CXB4004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that function Length, with Display_Format parameter, will 
- --      return the minimal length of a Numeric value that will be required 
- --      to hold the largest value of type Num represented as Format. 
- --
- --      Check that function To_Decimal will produce a decimal type Num 
- --      result that corresponds to parameter Item as represented by 
- --      parameter Format.
- --
- --      Check that function To_Decimal propagates Conversion_Error when 
- --      the value represented by parameter Item is outside the range of 
- --      the Decimal_Type Num used to instantiate the package 
- --      Decimal_Conversions 
- --
- --      Check that function To_Display returns a Numeric type result that 
- --      represents Item under the specific Display_Format.
- --
- --      Check that function To_Display propagates Conversion_Error when 
- --      parameter Item is negative and the specified Display_Format 
- --      parameter is Unsigned.
- --
- -- TEST DESCRIPTION:
- --      This test checks the results from instantiated versions of three
- --      functions within generic package Interfaces.COBOL.Decimal_Conversions.
- --      This generic package is instantiated twice, with decimal types having
- --      four and ten digits representation. 
- --      The function Length is validated with the Unsigned, Leading_Separate,
- --      and Trailing_Separate Display_Format specifiers.
- --      The results of function To_Decimal are verified in cases where it
- --      is given a variety of Numeric and Display_Format type parameters.
- --      Function To_Decimal is also checked to propagate Conversion_Error
- --      when the value represented by parameter Item is outside the range 
- --      of the type used to instantiate the package.
- --      The results of function To_Display are verified in cases where it
- --      is given a variety of Num and Display_Format parameters.  It is also
- --      checked to ensure that it propagates Conversion_Error if parameter
- --      Num is negative and the Format parameter is Unsigned.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.COBOL.COBOL_Character:
- --      ' ', '0'..'9', '+', '-', and '.'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      06 Feb 96   SAIC    Initial release for 2.1.
- --      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Interfaces.COBOL;                                          -- N/A => ERROR
- with Ada.Exceptions;
- 
- procedure CXB4004 is
- begin
- 
-    Report.Test ("CXB4004", "Check that the functions Length, To_Decimal, " &
-                            "and To_Display produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces;
-       use Ada.Exceptions;
-       use type Interfaces.COBOL.Numeric;
- 
-       Number_Of_Unsigned_Items          : constant := 6;
-       Number_Of_Leading_Separate_Items  : constant := 6;
-       Number_Of_Trailing_Separate_Items : constant := 6;
-       Number_Of_Decimal_Items           : constant := 9;
- 
-       type Decimal_Type_1     is delta 0.01 digits  4;
-       type Decimal_Type_2     is delta 1.0 digits  10;
-       type Numeric_Access     is access COBOL.Numeric;
-       type Numeric_Items_Type is array(Integer range <>) of Numeric_Access;
- 
-       Correct_Result : Boolean        := False;
-       TC_Num_1       : Decimal_Type_1 := 0.0;
-       TC_Num_2       : Decimal_Type_2 := 0.0;
- 
-       package Package_1 is new COBOL.Decimal_Conversions(Decimal_Type_1);
-       package Package_2 is new COBOL.Decimal_Conversions(Decimal_Type_2);
- 
- 
-       Package_1_Numeric_Items :
-         Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
-           (new COBOL.Numeric'("0"),
-            new COBOL.Numeric'("591"),
-            new COBOL.Numeric'("6342"),
-            new COBOL.Numeric'("+0"),
-            new COBOL.Numeric'("-1539"),
-            new COBOL.Numeric'("+9199"),
-            new COBOL.Numeric'("0-"),
-            new COBOL.Numeric'("8934+"),
-            new COBOL.Numeric'("9949-"));
- 
-       Package_2_Numeric_Items :
-         Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
-           (new COBOL.Numeric'("3"),
-            new COBOL.Numeric'("105"),
-            new COBOL.Numeric'("1234567899"),
-            new COBOL.Numeric'("+8"),
-            new COBOL.Numeric'("-12345601"),
-            new COBOL.Numeric'("+9123459999"),
-            new COBOL.Numeric'("1-"),
-            new COBOL.Numeric'("123456781+"),
-            new COBOL.Numeric'("9499999999-"));
- 
- 
-       Decimal_Type_1_Items : array (1..Number_Of_Decimal_Items) 
-                                of Decimal_Type_1 :=
-         (0.0,  5.91,  63.42, 0.0, -15.39,  91.99, 0.0,  89.34, -99.49);
- 
-       Decimal_Type_2_Items : array (1..Number_Of_Decimal_Items) 
-                                of Decimal_Type_2 :=
-         ( 3.0,        105.0,  1234567899.0, 
-           8.0,  -12345601.0,  9123459999.0,
-          -1.0,  123456781.0, -9499999999.0);
- 
-    begin
- 
-       -- Check that function Length with Display_Format parameter will 
-       -- return the minimal length of a Numeric value (number of 
-       -- COBOL_Characters) that will be required to hold the largest 
-       -- value of type Num. 
- 
-       if Package_1.Length(COBOL.Unsigned) /=  4 or
-          Package_2.Length(COBOL.Unsigned) /= 10
-       then
-          Report.Failed("Incorrect results from function Length when " &
-                        "used with Display_Format parameter Unsigned");
-       end if;
- 
-       if Package_1.Length(Format => COBOL.Leading_Separate) /=  5 or
-          Package_2.Length(Format => COBOL.Leading_Separate) /= 11
-       then
-          Report.Failed("Incorrect results from function Length when " &
-                        "used with Display_Format parameter "          &
-                        "Leading_Separate");
-       end if;
- 
-       if Package_1.Length(COBOL.Trailing_Separate) /=  5 or
-          Package_2.Length(COBOL.Trailing_Separate) /= 11
-       then
-          Report.Failed("Incorrect results from function Length when " &
-                        "used with Display_Format parameter "          &
-                        "Trailing_Separate");
-       end if;
- 
- 
-       -- Check that function To_Decimal with Numeric and Display_Format 
-       -- parameters will produce a decimal type Num result that corresponds 
-       -- to parameter Item as represented by parameter Format.
- 
-       for i in 1..Number_Of_Decimal_Items loop
-          case i is
-             when 1..3 =>  -- Unsigned Display_Format parameter.
- 
-                if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
-                                        Format => COBOL.Unsigned) /=
-                   Decimal_Type_1_Items(i)
-                then
-                   Report.Failed
-                     ("Incorrect result from function To_Decimal "    &
-                      "from an instantiation of Decimal_Conversions " &
-                      "using a four-digit Decimal type, with Format " &
-                      "parameter Unsigned, subtest index: "           &
-                      Integer'Image(i)); 
-                end if;
- 
-                if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
-                                        Format => COBOL.Unsigned) /=
-                   Decimal_Type_2_Items(i)
-                then
-                   Report.Failed
-                     ("Incorrect result from function To_Decimal "    &
-                      "from an instantiation of Decimal_Conversions " &
-                      "using a ten-digit Decimal type, with Format "  &
-                      "parameter Unsigned, subtest index: "           &
-                      Integer'Image(i)); 
-                end if;
- 
-             when 4..6 =>  -- Leading_Separate Display_Format parameter.
- 
-                if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
-                                        Format => COBOL.Leading_Separate) /=
-                   Decimal_Type_1_Items(i)
-                then
-                   Report.Failed
-                     ("Incorrect result from function To_Decimal "    &
-                      "from an instantiation of Decimal_Conversions " &
-                      "using a four-digit Decimal type, with Format " &
-                      "parameter Leading_Separate, subtest index: "   &
-                      Integer'Image(i)); 
-                end if;
- 
-                if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
-                                        Format => COBOL.Leading_Separate) /=
-                   Decimal_Type_2_Items(i)
-                then
-                   Report.Failed
-                     ("Incorrect result from function To_Decimal "    &
-                      "from an instantiation of Decimal_Conversions " &
-                      "using a ten-digit Decimal type, with Format "  &
-                      "parameter Leading_Separate, subtest index: "   &
-                      Integer'Image(i)); 
-                end if;
- 
-             when 7..9 =>  -- Trailing_Separate Display_Format parameter.
- 
-                if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
-                                        COBOL.Trailing_Separate) /=
-                   Decimal_Type_1_Items(i)
-                then
-                   Report.Failed
-                     ("Incorrect result from function To_Decimal "    &
-                      "from an instantiation of Decimal_Conversions " &
-                      "using a four-digit Decimal type, with Format " &
-                      "parameter Trailing_Separate, subtest index: "  &
-                      Integer'Image(i)); 
-                end if;
- 
-                if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
-                                        COBOL.Trailing_Separate) /=
-                   Decimal_Type_2_Items(i)
-                then
-                   Report.Failed
-                     ("Incorrect result from function To_Decimal "    &
-                      "from an instantiation of Decimal_Conversions " &
-                      "using a ten-digit Decimal type, with Format "  &
-                      "parameter Trailing_Separate, subtest index: "  &
-                      Integer'Image(i)); 
-                end if;
- 
-          end case;
-       end loop;
- 
- 
-       -- Check that function To_Decimal propagates Conversion_Error when 
-       -- the value represented by Numeric type parameter Item is outside 
-       -- the range of the Decimal_Type Num used to instantiate the package 
-       -- Decimal_Conversions.
- 
-       declare
-          TC_Numeric_1 : Decimal_Type_1 := Decimal_Type_1_Items(1);
-       begin
-          -- The COBOL.Numeric type used as parameter Item represents a
-          -- Decimal value that is outside the range of the Decimal type 
-          -- used to instantiate Package_1.
-          TC_Numeric_1 := 
-            Package_1.To_Decimal(Item   => Package_2_Numeric_Items(8).all,
-                                 Format => COBOL.Trailing_Separate);
-          Report.Failed("Conversion_Error not raised by To_Decimal "     &
-                        "when the value represented by parameter "       &
-                        "Item is outside the range of the Decimal_Type " &
-                        "used to instantiate the package "               &
-                        "Decimal_Conversions");
-          if TC_Numeric_1 = Decimal_Type_1_Items(1) then
-             Report.Comment("To Guard Against Dead Assignment Elimination " &
-                            "-- Should never be printed");
-          end if;
-       exception
-          when COBOL.Conversion_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by To_Decimal "      &
-                           "when the value represented by parameter "       &
-                           "Item is outside the range of the Decimal_Type " &
-                           "used to instantiate the package "               &
-                           "Decimal_Conversions");
-       end;
- 
- 
-       -- Check that function To_Display with decimal type Num and 
-       -- Display_Format parameters returns a Numeric type result that 
-       -- represents Item under the specific Display_Format.
- 
-       -- Unsigned Display_Format parameter.
-       TC_Num_1       := 13.04;
-       Correct_Result := (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) =
-                          "1304") AND
-                         (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) /= 
-                          "13.04");
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Unsigned Display_Format parameter - 1");
-       end if;
- 
-       TC_Num_2       := 1234567890.0;
-       Correct_Result := Package_2.To_Display(TC_Num_2, 
-                                              COBOL.Unsigned) = "1234567890";
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Unsigned Display_Format parameter - 2");
-       end if;
- 
-       -- Leading_Separate Display_Format parameter.
-       TC_Num_1       := -34.29;
-       Correct_Result := (Package_1.To_Display(TC_Num_1, 
-                                               COBOL.Leading_Separate) = 
-                          "-3429") AND
-                         (Package_1.To_Display(TC_Num_1,
-                                               COBOL.Leading_Separate) /=
-                          "-34.29");
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Leading_Separate Display_Format parameter - 1");
-       end if;
- 
-       TC_Num_1       := 19.01;
-       Correct_Result := Package_1.To_Display(TC_Num_1, 
-                                              COBOL.Leading_Separate) = 
-                         "+1901";
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Leading_Separate Display_Format parameter - 2");
-       end if;
- 
-       TC_Num_2       := 1234567890.0;
-       Correct_Result := Package_2.To_Display(TC_Num_2, 
-                                              COBOL.Leading_Separate) = 
-                         "+1234567890";
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Leading_Separate Display_Format parameter - 3");
-       end if;
- 
-       TC_Num_2       := -1234567890.0;
-       Correct_Result := Package_2.To_Display(TC_Num_2, 
-                                              COBOL.Leading_Separate) = 
-                         "-1234567890";
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Leading_Separate Display_Format parameter - 4");
-       end if;
- 
-       -- Trailing_Separate Display_Format parameter.
-       TC_Num_1       := -99.91;
-       Correct_Result := (Package_1.To_Display(TC_Num_1, 
-                                              COBOL.Trailing_Separate) = 
-                          "9991-") AND
-                         (Package_1.To_Display(TC_Num_1,
-                                               COBOL.Trailing_Separate) /=
-                          "99.91-");
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Trailing_Separate Display_Format parameter - 1");
-       end if;
- 
-       TC_Num_1       := 51.99;
-       Correct_Result := Package_1.To_Display(TC_Num_1, 
-                                              COBOL.Trailing_Separate) = 
-                         "5199+";
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Trailing_Separate Display_Format parameter - 2");
-       end if;
- 
-       TC_Num_2       := 1234567890.0;
-       Correct_Result := Package_2.To_Display(TC_Num_2, 
-                                              COBOL.Trailing_Separate) = 
-                         "1234567890+";
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Trailing_Separate Display_Format parameter - 3");
-       end if;
- 
-       TC_Num_2       := -1234567890.0;
-       Correct_Result := Package_2.To_Display(TC_Num_2, 
-                                              COBOL.Trailing_Separate) = 
-                         "1234567890-";
-       if not Correct_Result then
-          Report.Failed("Incorrect result from function To_Display with " &
-                        "Trailing_Separate Display_Format parameter - 4");
-       end if;
- 
- 
-       -- Check that function To_Display propagates Conversion_Error when
-       -- parameter Item is negative and the specified Display_Format 
-       -- parameter is Unsigned.
- 
-       begin
-          if Package_2.To_Display(Item   => Decimal_Type_2_Items(9),
-                                  Format => COBOL.Unsigned) = 
-             Package_2_Numeric_Items(2).all 
-          then
-             Report.Comment("To Guard Against Dead Assignment Elimination " &
-                            "-- Should never be printed");
-          end if;
-          Report.Failed("Conversion_Error not raised by To_Display " &
-                        "when the value represented by parameter "   &
-                        "Item is negative and the Display_Format "   &
-                        "parameter is Unsigned");
-       exception
-          when COBOL.Conversion_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by To_Display " &
-                           "when the value represented by parameter "  &
-                           "Item is negative and the Display_Format "  &
-                           "parameter is Unsigned");
-       end;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB4004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,332 ****
- -- CXB4005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function To_COBOL will convert a String 
- --      parameter value into a type Alphanumeric array of 
- --      COBOL_Characters, with lower bound of one, and length 
- --      equal to length of the String parameter, based on the 
- --      mapping Ada_to_COBOL.
- --
- --      Check that the function To_Ada will convert a type 
- --      Alphanumeric parameter value into a String type result, 
- --      with lower bound of one, and length equal to the length 
- --      of the Alphanumeric parameter, based on the mapping 
- --      COBOL_to_Ada.
- --
- --      Check that the Ada_to_COBOL and COBOL_to_Ada mapping 
- --      arrays provide a mapping capability between Ada's type 
- --      Character and COBOL run-time character sets.
- --
- -- TEST DESCRIPTION:
- --      This test checks that the functions To_COBOL and To_Ada produce
- --      the correct results, based on a variety of parameter input values.
- --      
- --      In the first series of subtests, the results of the function
- --      To_COBOL are compared against expected Alphanumeric type results,
- --      and the length and lower bound of the alphanumeric result are
- --      also verified.  In the second series of subtests, the results of
- --      the function To_Ada are compared against expected String type
- --      results, and the length of the String result is also verified 
- --      against the Alphanumeric type parameter.
- --      
- --      This test also verifies that two mapping array variables defined 
- --      in package Interfaces.COBOL, Ada_To_COBOL and COBOL_To_Ada, are 
- --      available, and that they can be modified by a user at runtime.  
- --      Finally, the effects of user modifications on these mapping 
- --      variables is checked in the test.
- --      
- --      This test uses Fixed, Bounded, and Unbounded_Strings in combination
- --      with the functions under validation.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.COBOL.COBOL_Character:
- --      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*', ',', '.', and '$'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      11 Jan 96   SAIC    Initial prerelease version for ACVC 2.1
- --      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Ada.Strings.Bounded;
- with Ada.Strings.Unbounded;
- with Interfaces.COBOL;                                          -- N/A => ERROR
- 
- procedure CXB4005 is
- begin
- 
-    Report.Test ("CXB4005", "Check that the functions To_COBOL and " &
-                            "To_Ada produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(5);
-       package Unb renames Ada.Strings.Unbounded;
- 
-       use Ada.Exceptions;
-       use Interfaces;
-       use Bnd;
-       use type Unb.Unbounded_String;
-       use type Interfaces.COBOL.Alphanumeric;
- 
-       TC_Alphanumeric_1  : Interfaces.COBOL.Alphanumeric(1..1);
-       TC_Alphanumeric_5  : Interfaces.COBOL.Alphanumeric(1..5);
-       TC_Alphanumeric_10 : Interfaces.COBOL.Alphanumeric(1..10);
-       TC_Alphanumeric_20 : Interfaces.COBOL.Alphanumeric(1..20);
- 
-       Bnd_String,
-       TC_Bnd_String      : Bnd.Bounded_String   :=
-                              Bnd.To_Bounded_String("     ");
-       Unb_String,
-       TC_Unb_String      : Unb.Unbounded_String :=
-                              Unb.To_Unbounded_String("                    ");
- 
-       The_String,
-       TC_String          : String(1..20) := ("                    ");
- 
-    begin
- 
-       -- Check that the function To_COBOL will convert a String 
-       -- parameter value into a type Alphanumeric array of 
-       -- COBOL_Characters, with lower bound of one, and length 
-       -- equal to length of the String parameter, based on the 
-       -- mapping Ada_to_COBOL.
- 
-       Unb_String         := Unb.To_Unbounded_String("A");
-       TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
- 
-       if TC_Alphanumeric_1        /= "A"                    or
-          TC_Alphanumeric_1'Length /= Unb.Length(Unb_String) or
-          TC_Alphanumeric_1'Length /= 1                      or
-          COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
-       then
-          Report.Failed("Incorrect result from function To_COBOL - 1");
-       end if;
- 
-       Bnd_String         := Bnd.To_Bounded_String("abcde");
-       TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
- 
-       if TC_Alphanumeric_5        /= "abcde"                or
-          TC_Alphanumeric_5'Length /= Bnd.Length(Bnd_String) or
-          TC_Alphanumeric_5'Length /= 5                      or
-          COBOL.To_COBOL(Bnd.To_String(Bnd_String))'First  /= 1
-       then
-          Report.Failed("Incorrect result from function To_COBOL - 2");
-       end if;
- 
-       Unb_String         := Unb.To_Unbounded_String("1A2B3c4d5F");
-       TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
- 
-       if TC_Alphanumeric_10        /= "1A2B3c4d5F"           or
-          TC_Alphanumeric_10'Length /= Unb.Length(Unb_String) or
-          TC_Alphanumeric_10'Length /= 10                     or
-          COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
-       then
-          Report.Failed("Incorrect result from function To_COBOL - 3");
-       end if;
- 
-       The_String         := "abcd  ghij" & "1234  7890";
-       TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
- 
-       if TC_Alphanumeric_20                /= "abcd  ghij1234  7890" or
-          TC_Alphanumeric_20'Length         /= The_String'Length      or
-          TC_Alphanumeric_20'Length         /= 20                     or
-          COBOL.To_COBOL(The_String)'First  /= 1
-       then
-          Report.Failed("Incorrect result from function To_COBOL - 4");
-       end if;
- 
- 
- 
-       -- Check that the function To_Ada will convert a type 
-       -- Alphanumeric parameter value into a String type result, 
-       -- with lower bound of one, and length equal to the length 
-       -- of the Alphanumeric parameter, based on the mapping 
-       -- COBOL_to_Ada.
- 
-       TC_Unb_String := Unb.To_Unbounded_String 
-                          (COBOL.To_Ada(TC_Alphanumeric_1));
- 
-       if TC_Unb_String             /= "A"                       or
-          TC_Alphanumeric_1'Length  /= Unb.Length(TC_Unb_String) or
-          Unb.Length(TC_Unb_String) /= 1                         or
-          COBOL.To_Ada(TC_Alphanumeric_1)'First /= 1
-       then
-          Report.Failed("Incorrect value returned from function To_Ada - 1");
-       end if;
- 
-       TC_Bnd_String := Bnd.To_Bounded_String 
-                          (COBOL.To_Ada(TC_Alphanumeric_5));
- 
-       if TC_Bnd_String             /= "abcde"                   or
-          TC_Alphanumeric_5'Length  /= Bnd.Length(TC_Bnd_String) or
-          Bnd.Length(TC_Bnd_String) /= 5                         or
-          COBOL.To_Ada(TC_Alphanumeric_5)'First /= 1
-       then
-          Report.Failed("Incorrect value returned from function To_Ada - 2");
-       end if;
- 
-       TC_Unb_String := Unb.To_Unbounded_String 
-                          (COBOL.To_Ada(TC_Alphanumeric_10));
- 
-       if TC_Unb_String             /= "1A2B3c4d5F"              or
-          TC_Alphanumeric_10'Length /= Unb.Length(TC_Unb_String) or
-          Unb.Length(TC_Unb_String) /= 10                        or
-          COBOL.To_Ada(TC_Alphanumeric_10)'First /= 1
-       then
-          Report.Failed("Incorrect value returned from function To_Ada - 3");
-       end if;
- 
-       TC_String := COBOL.To_Ada(TC_Alphanumeric_20);
- 
-       if TC_String                 /= "abcd  ghij1234  7890" or
-          TC_Alphanumeric_20'Length /= TC_String'Length       or
-          TC_String'Length          /= 20                     or
-          COBOL.To_Ada(TC_Alphanumeric_20)'First /= 1
-       then
-          Report.Failed("Incorrect value returned from function To_Ada - 4");
-       end if;
- 
- 
-       -- Check the two functions when used in combination.
- 
-       if COBOL.To_COBOL(Item => COBOL.To_Ada("This is a test")) /=
-          "This is a test"                                         or
-          COBOL.To_COBOL(COBOL.To_Ada("1234567890abcdeFGHIJ"))   /=
-          "1234567890abcdeFGHIJ"
-       then
-          Report.Failed("Incorrect result returned when using the " &
-                        "functions To_Ada and To_COBOL in combination");
-       end if;
- 
- 
- 
-       -- Check that the Ada_to_COBOL and COBOL_to_Ada mapping 
-       -- arrays provide a mapping capability between Ada's type 
-       -- Character and COBOL run-time character sets.
- 
-       Interfaces.COBOL.Ada_To_COBOL('a') := 'A';
-       Interfaces.COBOL.Ada_To_COBOL('b') := 'B';
-       Interfaces.COBOL.Ada_To_COBOL('c') := 'C';
-       Interfaces.COBOL.Ada_To_COBOL('d') := '1';
-       Interfaces.COBOL.Ada_To_COBOL('e') := '2';
-       Interfaces.COBOL.Ada_To_COBOL('f') := '3';
-       Interfaces.COBOL.Ada_To_COBOL(' ') := '*';
- 
-       Unb_String         := Unb.To_Unbounded_String("b");
-       TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
- 
-       if TC_Alphanumeric_1 /= "B" then
-          Report.Failed("Incorrect result from function To_COBOL after " &
-                        "modification to Ada_To_COBOL mapping array - 1");
-       end if;
- 
-       Bnd_String         := Bnd.To_Bounded_String("abcde");
-       TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
- 
-       if TC_Alphanumeric_5 /= "ABC12" then
-          Report.Failed("Incorrect result from function To_COBOL after " &
-                        "modification to Ada_To_COBOL mapping array - 2");
-       end if;
- 
-       Unb_String         := Unb.To_Unbounded_String("1a2B3c4d5e");
-       TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
- 
-       if TC_Alphanumeric_10 /= "1A2B3C4152" then
-          Report.Failed("Incorrect result from function To_COBOL after " &
-                        "modification to Ada_To_COBOL mapping array - 3");
-       end if;
- 
-       The_String         := "abcd  ghij" & "1234  7890";
-       TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
- 
-       if TC_Alphanumeric_20 /= "ABC1**ghij1234**7890" then
-          Report.Failed("Incorrect result from function To_COBOL after " &
-                        "modification to Ada_To_COBOL mapping array - 4");
-       end if;
- 
- 
-       -- Reset the Ada_To_COBOL mapping array to its original state.
- 
-       Interfaces.COBOL.Ada_To_COBOL('a') := 'a';
-       Interfaces.COBOL.Ada_To_COBOL('b') := 'b';
-       Interfaces.COBOL.Ada_To_COBOL('c') := 'c';
-       Interfaces.COBOL.Ada_To_COBOL('d') := 'd';
-       Interfaces.COBOL.Ada_To_COBOL('e') := 'e';
-       Interfaces.COBOL.Ada_To_COBOL('f') := 'f';
-       Interfaces.COBOL.Ada_To_COBOL(' ') := ' ';
- 
-       -- Modify the COBOL_To_Ada mapping array to check its effect on
-       -- the function To_Ada.
- 
-       Interfaces.COBOL.COBOL_To_Ada(' ') := '*';
-       Interfaces.COBOL.COBOL_To_Ada('$') := 'F';
-       Interfaces.COBOL.COBOL_To_Ada('1') := '7';
-       Interfaces.COBOL.COBOL_To_Ada('.') := ',';
- 
-       Unb_String         := Unb.To_Unbounded_String("  $$100.00");
-       TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
-       TC_Unb_String      := Unb.To_Unbounded_String(
-                               COBOL.To_Ada(TC_Alphanumeric_10));
- 
-       if Unb.To_String(TC_Unb_String) /= "**FF700,00" then
-          Report.Failed("Incorrect result from function To_Ada after " &
-                        "modification of COBOL_To_Ada mapping array - 1");
-       end if;
- 
-       Interfaces.COBOL.COBOL_To_Ada('*') := ' ';
-       Interfaces.COBOL.COBOL_To_Ada('F') := '$';
-       Interfaces.COBOL.COBOL_To_Ada('7') := '1';
-       Interfaces.COBOL.COBOL_To_Ada(',') := '.';
- 
-       if COBOL.To_Ada(COBOL.To_COBOL(Unb.To_String(TC_Unb_String))) /= 
-          Unb_String 
-       then
-          Report.Failed("Incorrect result from function To_Ada after " &
-                        "modification of COBOL_To_Ada mapping array - 2");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed ("The following exception was raised in the " &
-                         "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB4005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,322 ****
- -- CXB4006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function Valid with Packed_Decimal and Packed_Format
- --      parameters returns True if Item (the Packed_Decimal parameter) has
- --      a value consistent with the Packed_Format parameter.
- --
- --      Check that the function Length with Packed_Format parameter returns
- --      the minimal length of a Packed_Decimal value sufficient to hold any
- --      value of type Num when represented according to parameter Format.
- --
- --      Check that the function To_Decimal with Packed_Decimal and 
- --      Packed_Format parameters produces a decimal type value corresponding 
- --      to the Packed_Decimal parameter value Item, under the conditions of 
- --      the Packed_Format parameter Format.
- --
- --      Check that the function To_Packed with Decimal (Num) and 
- --      Packed_Format parameters produces a Packed_Decimal result that 
- --      corresponds to the decimal parameter under conditions of the 
- --      Packed_Format parameter.
- --
- --      Check that Conversion_Error is propagated by function To_Packed if 
- --      the value of the decimal parameter Item is negative and the specified
- --      Packed_Format parameter is Packed_Unsigned.
- --
- --      
- -- TEST DESCRIPTION:
- --      This test checks the results from instantiated versions of 
- --      several functions that deal with parameters or results of type
- --      Packed_Decimal.  Since the rules for the formation of Packed_Decimal
- --      values are implementation defined, several of the subtests cannot
- --      directly check the accuracy of the results produced. Instead, they
- --      verify that the result is within a range of possible values, or
- --      that the result of one function can be converted back to the original 
- --      actual parameter using a "mirror image" conversion function.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      12 Feb 96   SAIC    Initial release for 2.1.
- --      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.COBOL;                                          -- N/A => ERROR
- 
- procedure CXB4006 is
- begin
- 
-    Report.Test ("CXB4006", "Check that the functions Valid, Length, "   &
-                            "To_Decimal, and To_Packed specific to "     &
-                            "Packed_Decimal parameters produce correct " &
-                            "results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces.COBOL;
-       use Ada.Exceptions;
-       use type Interfaces.COBOL.Numeric;
- 
-       type Decimal_Type_1 is delta 0.1    digits  6;
-       type Decimal_Type_2 is delta 0.01   digits  8;
-       type Decimal_Type_3 is delta 0.001  digits 10;
-       type Decimal_Type_4 is delta 0.0001 digits 12;
- 
-       package Pack_1 is new Decimal_Conversions(Decimal_Type_1);
-       package Pack_2 is new Decimal_Conversions(Decimal_Type_2);
-       package Pack_3 is new Decimal_Conversions(Decimal_Type_3);
-       package Pack_4 is new Decimal_Conversions(Decimal_Type_4);
- 
-       TC_Dec_1      : Decimal_Type_1 := 12345.6;
-       TC_Dec_2      : Decimal_Type_2 := 123456.78;
-       TC_Dec_3      : Decimal_Type_3 := 1234567.890;
-       TC_Dec_4      : Decimal_Type_4 := 12345678.9012;
-       TC_Min_Length : Natural        := 1;
-       TC_Max_Length : Natural        := 16;
- 
-    begin
- 
-       -- Check that the function Valid with Packed_Decimal and Packed_Format
-       -- parameters returns True if Item (the Packed_Decimal parameter) has 
-       -- a value consistent with the Packed_Format parameter.
-       -- Note: Since the formation rules for Packed_Decimal values are
-       --       implementation defined, the parameter values here are 
-       --       created by function To_Packed.
- 
-       TC_Dec_1 := 1434.3;
-       if not Pack_1.Valid(Item   => Pack_1.To_Packed(TC_Dec_1, 
-                                                      Packed_Unsigned),
-                           Format => Packed_Unsigned)
-       then
-          Report.Failed("Incorrect result from function Valid - 1");
-       end if;
- 
-       TC_Dec_2 := -4321.03;
-       if not Pack_2.Valid(Pack_2.To_Packed(TC_Dec_2, Packed_Signed),
-                           Format => Packed_Signed)                   or
-          Pack_2.Valid(Pack_2.To_Packed(TC_Dec_2, Packed_Signed),
-                       Format => Packed_Unsigned)
-       then
-          Report.Failed("Incorrect result from function Valid - 2");
-       end if;
- 
-       TC_Dec_3 := 1234567.890;
-       if not Pack_3.Valid(Pack_3.To_Packed(TC_Dec_3, Packed_Unsigned),
-                           Packed_Unsigned)
-       then
-          Report.Failed("Incorrect result from function Valid - 3");
-       end if;
- 
-       TC_Dec_4 := -234.6789;
-       if not Pack_4.Valid(Item   => Pack_4.To_Packed(TC_Dec_4, 
-                                                      Packed_Signed),
-                           Format => Packed_Signed)                        or
-          Pack_4.Valid(Item   => Pack_4.To_Packed(TC_Dec_4, Packed_Signed),
-                       Format => Packed_Unsigned)
-       then
-          Report.Failed("Incorrect result from function Valid - 4");
-       end if;
- 
- 
- 
-       -- Check that the function Length with Packed_Format parameter returns
-       -- the minimal length of a Packed_Decimal value sufficient to hold any
-       -- value of type Num when represented according to parameter Format.
- 
-       if NOT (Pack_1.Length(Packed_Signed)   >= TC_Min_Length AND
-               Pack_1.Length(Packed_Signed)   <= TC_Max_Length AND
-               Pack_1.Length(Packed_Unsigned) >= TC_Min_Length AND
-               Pack_1.Length(Packed_Unsigned) <= TC_Max_Length)
-       then
-          Report.Failed("Incorrect result from function Length - 1");
-       end if;
- 
-       if NOT (Pack_2.Length(Packed_Signed)   >= TC_Min_Length AND
-               Pack_2.Length(Packed_Signed)   <= TC_Max_Length AND
-               Pack_2.Length(Packed_Unsigned) >= TC_Min_Length AND
-               Pack_2.Length(Packed_Unsigned) <= TC_Max_Length)
-       then
-          Report.Failed("Incorrect result from function Length - 2");
-       end if;
- 
-       if NOT (Pack_3.Length(Packed_Signed)   >= TC_Min_Length AND
-               Pack_3.Length(Packed_Signed)   <= TC_Max_Length AND
-               Pack_3.Length(Packed_Unsigned) >= TC_Min_Length AND
-               Pack_3.Length(Packed_Unsigned) <= TC_Max_Length)
-       then
-          Report.Failed("Incorrect result from function Length - 3");
-       end if;
- 
-       if NOT (Pack_4.Length(Packed_Signed)   >= TC_Min_Length AND
-               Pack_4.Length(Packed_Signed)   <= TC_Max_Length AND
-               Pack_4.Length(Packed_Unsigned) >= TC_Min_Length AND
-               Pack_4.Length(Packed_Unsigned) <= TC_Max_Length)
-       then
-          Report.Failed("Incorrect result from function Length - 4");
-       end if;
- 
- 
- 
-       -- Check that the function To_Decimal with Packed_Decimal and 
-       -- Packed_Format parameters produces a decimal type value corresponding 
-       -- to the Packed_Decimal parameter value Item, under the conditions of 
-       -- the Packed_Format parameter Format.
- 
-       begin
-          TC_Dec_1 := 1234.5;
-          if Pack_1.To_Decimal(Item   => Pack_1.To_Packed(TC_Dec_1,
-                                                          Packed_Unsigned),
-                               Format => Packed_Unsigned) /= TC_Dec_1
-          then
-             Report.Failed("Incorrect result from function To_Decimal - 1");
-          end if;
-       exception
-          when The_Error : others => 
-             Report.Failed("The following exception was raised in " &
-                           "subtest 1 of function To_Decimal: "     & 
-                           Exception_Name(The_Error));
-       end;
- 
-       begin
-          TC_Dec_2 := -123456.50;
-          if Pack_2.To_Decimal(Pack_2.To_Packed(TC_Dec_2, Packed_Signed),
-                               Format => Packed_Signed) /= TC_Dec_2
-          then
-             Report.Failed("Incorrect result from function To_Decimal - 2");
-          end if;
-       exception
-          when The_Error : others => 
-             Report.Failed("The following exception was raised in " &
-                           "subtest 2 of function To_Decimal: "     & 
-                           Exception_Name(The_Error));
-       end;
- 
-       begin
-          TC_Dec_3 := 1234567.809;
-          if Pack_3.To_Decimal(Pack_3.To_Packed(TC_Dec_3, Packed_Unsigned),
-                               Packed_Unsigned) /= TC_Dec_3
-          then
-             Report.Failed("Incorrect result from function To_Decimal - 3");
-          end if;
-       exception
-          when The_Error : others => 
-             Report.Failed("The following exception was raised in " &
-                           "subtest 3 of function To_Decimal: "     & 
-                           Exception_Name(The_Error));
-       end;
- 
-       begin
-          TC_Dec_4 := -789.1234;
-          if Pack_4.To_Decimal(Item   => Pack_4.To_Packed(TC_Dec_4,
-                                                          Packed_Signed),
-                               Format => Packed_Signed) /= TC_Dec_4
-          then
-             Report.Failed("Incorrect result from function To_Decimal - 4");
-          end if;
-       exception
-          when The_Error : others => 
-             Report.Failed("The following exception was raised in " &
-                           "subtest 4 of function To_Decimal: "     & 
-                           Exception_Name(The_Error));
-       end;
- 
- 
- 
-       -- Check that the function To_Packed with Decimal (Num) and 
-       -- Packed_Format parameters produces a Packed_Decimal result that 
-       -- corresponds to the decimal parameter under conditions of the 
-       -- Packed_Format parameter.
- 
-       if Pack_1.To_Packed(Item =>  123.4, Format => Packed_Unsigned) =
-          Pack_1.To_Packed(Item => -123.4, Format => Packed_Signed)
-       then
-          Report.Failed("Incorrect result from function To_Packed - 1");
-       end if; 
- 
-       if Pack_2.To_Packed( 123.45, Format => Packed_Unsigned) =
-          Pack_2.To_Packed(-123.45, Format => Packed_Signed)
-       then
-          Report.Failed("Incorrect result from function To_Packed - 2");
-       end if; 
- 
-       if Pack_3.To_Packed(Item =>  123.456, Format => Packed_Unsigned) =
-          Pack_3.To_Packed(Item => -123.456, Format => Packed_Signed)
-       then
-          Report.Failed("Incorrect result from function To_Packed - 3");
-       end if; 
- 
-       if (Pack_4.To_Packed( 123.4567, Packed_Unsigned)     =
-           Pack_4.To_Packed(-123.4567, Packed_Signed))       or
-          (Pack_4.To_Packed(12345678.9012, Packed_Unsigned) =
-           Pack_4.To_Packed(12345678.9013, Packed_Unsigned)) or
-          (Pack_4.To_Packed(12345678.9012, Packed_Unsigned) =
-           Pack_4.To_Packed(22345678.9012, Packed_Unsigned)) 
-       then
-          Report.Failed("Incorrect result from function To_Packed - 4");
-       end if; 
- 
- 
-       -- Check that Conversion_Error is propagated by function To_Packed if 
-       -- the value of the decimal parameter Item is negative and the 
-       -- specified Packed_Format parameter is Packed_Unsigned.
- 
-       begin
-          if Pack_1.To_Packed(Item => -12.3, Format => Packed_Unsigned) =
-             Pack_1.To_Packed(Item =>  12.3, Format => Packed_Signed)
-          then
-             Report.Comment("Should never be printed");
-          end if;
-          Report.Failed("Conversion_Error not raised following call to " & 
-                        "function To_Packed with a negative parameter "  &  
-                        "Item and Packed_Format parameter Packed_Unsigned");
-       exception
-          when Conversion_Error   => null;  -- OK, expected exception.
-          when The_Error : others =>
-             Report.Failed(Exception_Name(The_Error) & " was incorrectly " &
-                           "raised following call to function To_Packed "  & 
-                           "with a negative parameter Item and "           &
-                           "Packed_Format parameter Packed_Unsigned"); 
-       end;
- 
-    exception
-       when The_Error : others => 
-          Report.Failed("The following exception was raised in the " &
-                        "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB4006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,271 ****
- -- CXB4007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function Valid with Byte_Array and Binary_Format 
- --      parameters returns True if the Byte_Array parameter corresponds 
- --      to any value inside the range of type Num.
- --      Check that function Valid returns False if the Byte_Array parameter
- --      corresponds to a value outside the range of Num. 
- --
- --      Check that function Length with Binary_Format parameter will return
- --      the minimum length of a Byte_Array value required to hold any value
- --      of decimal type Num.
- --
- --      Check that function To_Decimal with Byte_Array and Binary_Format
- --      parameters will return a decimal type value that corresponds to
- --      parameter Item (of type Byte_Array) under the specified Format.
- --
- --      Check that Conversion_Error is propagated by function To_Decimal if
- --      the Byte_Array parameter Item represents a decimal value outside the
- --      range of decimal type Num.
- --
- --      Check that function To_Binary will produce a Byte_Array result that
- --      corresponds to the decimal type parameter Item, under the specified
- --      Binary_Format.
- --      
- -- TEST DESCRIPTION:
- --      This test uses several instantiations of generic package 
- --      Decimal_Conversions to provide appropriate test material.
- --      This test uses the function To_Binary to create all Byte_Array 
- --      parameter values used in calls to functions Valid and To_Decimal.
- --      The function Valid is tested with parameters to provide both
- --      valid and invalid expected results.  This test also checks that
- --      Function To_Decimal produces expected results in cases where each
- --      of the three predefined Binary_Format constants are used in the
- --      function calls. In addition, the prescribed propagation of 
- --      Conversion_Error by function To_Decimal is verified.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      14 Feb 96   SAIC    Initial release for 2.1.
- --      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --      05 JAN 98   EDS     Remove incorrect subtest.
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.COBOL;                                          -- N/A => ERROR
- 
- procedure CXB4007 is
- begin
- 
-    Report.Test ("CXB4007", "Check that functions Valid, Length, To_Decimal " &
-                            "and To_Binary specific to Byte_Array and "       &
-                            "Binary_Format parameters produce correct results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces.COBOL;
-       use Ada.Exceptions;
-       use type Interfaces.COBOL.Numeric;
- 
-       type Decimal_Type_1 is delta 0.1    digits  6;
-       type Decimal_Type_2 is delta 0.01   digits  8;
-       type Decimal_Type_3 is delta 0.001  digits 10;
-       type Decimal_Type_4 is delta 0.0001 digits 12;
- 
-       package Pack_1 is new Decimal_Conversions(Decimal_Type_1);
-       package Pack_2 is new Decimal_Conversions(Decimal_Type_2);
-       package Pack_3 is new Decimal_Conversions(Decimal_Type_3);
-       package Pack_4 is new Decimal_Conversions(Decimal_Type_4);
- 
-       TC_Dec_1      : Decimal_Type_1 := 12345.6;
-       TC_Dec_2      : Decimal_Type_2 := 123456.78;
-       TC_Dec_3      : Decimal_Type_3 := 1234567.890;
-       TC_Dec_4      : Decimal_Type_4 := 12345678.9012;
-       TC_Min_Length : Natural        := 1;
-       TC_Max_Length : Natural        := 16;
-       TC_Valid      : Boolean        := False;
- 
-    begin
- 
-       -- Check that the function Valid with Byte_Array and Binary_Format 
-       -- parameters returns True if the Byte_Array parameter corresponds to 
-       -- any value inside the range of type Num.
- 
-       if not Pack_1.Valid(Item   => Pack_1.To_Binary(TC_Dec_1,
-                                                      High_Order_First),
-                           Format => High_Order_First)                   or
-          not Pack_1.Valid(Pack_1.To_Binary(0.0, Low_Order_First), 
-                           Format => Low_Order_First)                    
-       then
-          Report.Failed("Incorrect result from function Valid, using " &
-                        "parameters that should return a positive result - 1");
-       end if;
- 
-       TC_Valid := (Pack_2.Valid(Pack_2.To_Binary(TC_Dec_2, High_Order_First),
-                                 Format => High_Order_First)             and
-                    Pack_2.Valid(Pack_2.To_Binary(0.01, Low_Order_First), 
-                                 Format => Low_Order_First));              
-       if not TC_Valid then
-          Report.Failed("Incorrect result from function Valid, using " &
-                        "parameters that should return a positive result - 2");
-       end if;
- 
-       if not Pack_3.Valid(Item   => Pack_3.To_Binary(TC_Dec_3,
-                                                      Low_Order_First),
-                           Format => Low_Order_First)                  or
-          not Pack_3.Valid(Pack_3.To_Binary(0.001, High_Order_First), 
-                           Format => High_Order_First)                 or
-          not Pack_3.Valid(Pack_3.To_Binary(123.456, Native_Binary),
-                           Native_Binary)
-       then
-          Report.Failed("Incorrect result from function Valid, using " &
-                        "parameters that should return a positive result - 3");
-       end if;
- 
- 
-       -- Check that function Valid returns False if the Byte_Array parameter
-       -- corresponds to a value outside the range of Num. 
-       -- Note: use a Byte_Array value Item created by an instantiation of 
-       --       To_Binary with a larger Num type as the generic formal.
- 
-       if Pack_1.Valid(Item   => Pack_2.To_Binary(TC_Dec_2, Low_Order_First),
-                       Format => Low_Order_First)                or
-          Pack_2.Valid(Pack_3.To_Binary(TC_Dec_3, High_Order_First), 
-                       Format => High_Order_First)               or
-          Pack_3.Valid(Pack_4.To_Binary(TC_Dec_4, Native_Binary),
-                       Native_Binary)
-       then
-          Report.Failed("Incorrect result from function Valid, using " &
-                        "parameters that should return a negative result");
-       end if;
- 
- 
-       -- Check that function Length with Binary_Format parameter will return
-       -- the minimum length of a Byte_Array value required to hold any value
-       -- of decimal type Num.
- 
-       if not (Pack_1.Length(Native_Binary)    >= TC_Min_Length and
-               Pack_1.Length(Low_Order_First)  <= TC_Max_Length and
-               Pack_2.Length(High_Order_First) >= TC_Min_Length and
-               Pack_2.Length(Native_Binary)    <= TC_Max_Length and
-               Pack_3.Length(Low_Order_First)  >= TC_Min_Length and
-               Pack_3.Length(High_Order_First) <= TC_Max_Length and
-               Pack_4.Length(Native_Binary)    >= TC_Min_Length and
-               Pack_4.Length(Low_Order_First)  <= TC_Max_Length)
-       then
-          Report.Failed("Incorrect result from function Length");
-       end if;
- 
- 
- 
-       -- Check that function To_Decimal with Byte_Array and Binary_Format
-       -- parameters will return a decimal type value that corresponds to
-       -- parameter Item (of type Byte_Array) under the specified Format.
- 
-       if Pack_1.To_Decimal(Item   => Pack_1.To_Binary(Item   => TC_Dec_1, 
-                                                       Format => Native_Binary),
-                            Format => Native_Binary) /=
-          TC_Dec_1
-       then
-          Report.Failed("Incorrect result from function To_Decimal - 1");
-       end if;
- 
-       if Pack_3.To_Decimal(Pack_3.To_Binary(TC_Dec_3, High_Order_First),
-                            Format => High_Order_First) /=
-          TC_Dec_3
-       then
-          Report.Failed("Incorrect result from function To_Decimal - 2");
-       end if;
- 
-       if Pack_4.To_Decimal(Pack_4.To_Binary(TC_Dec_4, Low_Order_First),
-                            Low_Order_First) /=
-          TC_Dec_4
-       then
-          Report.Failed("Incorrect result from function To_Decimal - 3");
-       end if;
- 
- 
- 
-       -- Check that Conversion_Error is propagated by function To_Decimal
-       -- if the Byte_Array parameter Item represents a decimal value outside
-       -- the range of decimal type Num.
-       -- Note: use a Byte_Array value Item created by an instantiation of 
-       --       To_Binary with a larger Num type as the generic formal.
- 
-       begin
-          TC_Dec_4 := 99999.9001;
-          TC_Dec_1 := Pack_1.To_Decimal(Pack_4.To_Binary(TC_Dec_4,
-                                                         Native_Binary),
-                                        Format => Native_Binary); 
-          if TC_Dec_1 = 99999.9 then
-             Report.Comment("Minimize dead assignment optimization -- " &
-                            "Should never be printed");
-          end if;
-          Report.Failed("Conversion_Error not raised following call to "   &
-                        "function To_Decimal if the Byte_Array parameter " &
-                        "Item represents a decimal value outside the "     &
-                        "range of decimal type Num");
-       exception
-          when Conversion_Error   => null;  -- OK, expected exception.
-          when The_Error : others =>
-             Report.Failed(Exception_Name(The_Error) & " was incorrectly " &
-                           "raised following call to function To_Decimal " &
-                           "if the Byte_Array parameter Item represents "  &
-                           "a decimal value outside the range of decimal " &
-                           "type Num");
-       end;
- 
- 
- 
-       -- Check that function To_Binary will produce a Byte_Array result that
-       -- corresponds to the decimal type parameter Item, under the specified
-       -- Binary_Format.
- 
-       -- Different ordering.
-       TC_Dec_1 := 12345.6;
-       if Pack_1.To_Binary(TC_Dec_1, Low_Order_First)  =
-          Pack_1.To_Binary(TC_Dec_1, High_Order_First)
-       then
-          Report.Failed("Incorrect result from function To_Binary - 1");
-       end if;
- 
-       -- Variable vs. literal.
-       TC_Dec_2 := 12345.00;
-       if Pack_2.To_Binary(TC_Dec_2, Native_Binary) /=
-          Pack_2.To_Binary(12345.00, Native_Binary)
-       then
-          Report.Failed("Incorrect result from function To_Binary - 2");
-       end if;
- 
-    exception
-       when The_Error : others => 
-          Report.Failed("The following exception was raised in the " &
-                        "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB4007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb4008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb4008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,248 ****
- -- CXB4008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function To_Decimal with Binary parameter will return
- --      the corresponding value of the decimal type Num.
- --
- --      Check that the function To_Decimal with Long_Binary parameter will 
- --      return the corresponding value of the decimal type Num.
- --
- --      Check that both of the To_Decimal functions described above will 
- --      propagate Conversion_Error if the converted value Item is outside 
- --      the range of type Num.
- --
- --      Check that the function To_Binary converts a value of the Ada 
- --      decimal type Num into a Binary type value.
- --
- --      Check that the function To_Long_Binary converts a value of the Ada 
- --      decimal type Num into a Long_Binary type value.
- --      
- -- TEST DESCRIPTION:
- --      This test uses several instantiations of generic package 
- --      Decimal_Conversions to provide appropriate test material.
- --      Two of the instantiations use decimal types as generic actuals
- --      that include the implementation defined constants Max_Digits_Binary 
- --      and Max_Digits_Long_Binary in their definition.
- --
- --      Subtests are included for both versions of function To_Decimal,
- --      (Binary and Long_Binary parameters), and include checks that
- --      Conversion_Error is propagated under the appropriate circumstances.
- --      Functions To_Binary and To_Long_Binary are "sanity" checked, to  
- --      ensure that the functions are available, and that the results are 
- --      appropriate based on their parameter input.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.COBOL.  If an implementation provides
- --      package Interfaces.COBOL, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      21 Feb 96   SAIC    Initial release for 2.1.
- --      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Ada.Exceptions;
- with Interfaces.COBOL;                                          -- N/A => ERROR
- 
- procedure CXB4008 is
- begin
- 
-    Report.Test ("CXB4008", "Check that functions To_Decimal, To_Binary, and " &
-                            "To_Long_Binary produce the correct results");
- 
-    Test_Block:
-    declare
- 
-       use Interfaces.COBOL;
-       use Ada.Exceptions;
-       use type Interfaces.COBOL.Numeric;
- 
-       type Decimal_Type_1 is delta 0.1    digits  6;
-       type Decimal_Type_2 is delta 0.01   digits Max_Digits_Binary;
-       type Decimal_Type_3 is delta 0.001  digits 10;
-       type Decimal_Type_4 is delta 0.0001 digits Max_Digits_Long_Binary;
- 
-       package Pack_1 is new Decimal_Conversions(Decimal_Type_1);
-       package Pack_2 is new Decimal_Conversions(Decimal_Type_2);
-       package Pack_3 is new Decimal_Conversions(Decimal_Type_3);
-       package Pack_4 is new Decimal_Conversions(Decimal_Type_4);
- 
-       TC_Dec_1       : Decimal_Type_1 := 12345.0;
-       TC_Dec_2       : Decimal_Type_2 := 123456.00;
-       TC_Dec_3       : Decimal_Type_3 := 1234567.000;
-       TC_Dec_4       : Decimal_Type_4 := 12345678.0000;
-       TC_Binary      : Interfaces.COBOL.Binary;
-       TC_Long_Binary : Interfaces.COBOL.Long_Binary;
- 
-    begin
- 
-       -- Check that the function To_Decimal with Binary parameter will 
-       -- return the corresponding value of the decimal type Num.
- 
-       if Pack_1.To_Decimal(Item => Pack_1.To_Binary(TC_Dec_1)) /= TC_Dec_1 or
-          Pack_2.To_Decimal(Pack_2.To_Binary(TC_Dec_2))         /= TC_Dec_2 
-       then
-          Report.Failed("Incorrect result from function To_Decimal with " &
-                        "Binary parameter - 1");
-       end if;
- 
-       if Pack_1.To_Decimal(Item => Pack_1.To_Binary(1234.0)) /= 1234.0 then
-          Report.Failed("Incorrect result from function To_Decimal with " &
-                        "Binary parameter - 2");
-       end if;
- 
-       TC_Binary := Pack_2.To_Binary(TC_Dec_2);
-       if Pack_2.To_Decimal(TC_Binary) /= TC_Dec_2 then
-          Report.Failed("Incorrect result from function To_Decimal with " &
-                        "Binary parameter - 3");
-       end if;
- 
- 
- 
-       -- Check that the function To_Decimal with Long_Binary parameter 
-       -- will return the corresponding value of the decimal type Num.
- 
-       if Pack_3.To_Decimal(Item => Pack_3.To_Long_Binary(TC_Dec_3)) /= 
-          TC_Dec_3                                                      or
-          Pack_4.To_Decimal(Pack_4.To_Long_Binary(TC_Dec_4))         /= 
-          TC_Dec_4 
-       then
-          Report.Failed("Incorrect result from function To_Decimal with " &
-                        "Long_Binary parameter - 1");
-       end if;
- 
-       if Pack_3.To_Decimal(Pack_3.To_Long_Binary(1234567.0)) /= 1234567.0 then
-          Report.Failed("Incorrect result from function To_Decimal with " &
-                        "Long_Binary parameter - 2");
-       end if;
- 
-       TC_Long_Binary := Pack_4.To_Long_Binary(TC_Dec_4);
-       if Pack_4.To_Decimal(TC_Long_Binary) /= TC_Dec_4 then
-          Report.Failed("Incorrect result from function To_Decimal with " &
-                        "Long_Binary parameter - 3");
-       end if;
- 
- 
- 
-       -- Check that both of the To_Decimal functions described above 
-       -- will propagate Conversion_Error if the converted value Item is 
-       -- outside the range of type Num.
-       -- Note: Binary/Long_Binary parameter values are created by an 
-       --       instantiation of To_Binary/To_Long_Binary with a larger 
-       --       Num type as the generic formal.
- 
-       Binary_Parameter:
-       begin
-          TC_Dec_1 := Pack_1.To_Decimal(Pack_2.To_Binary(123456.78));
-          Report.Failed("Conversion_Error was not raised by function " &
-                        "To_Decimal with Binary parameter, when the "  &
-                        "converted value Item was outside the range "  &
-                        "of type Num");
-          if TC_Dec_1 = 12345.6 then  -- Avoid dead assignment optimization.
-             Report.Comment("Should never be printed");
-          end if;
-       exception
-          when Conversion_Error   => null;  -- OK, expected exception.
-          when The_Error : others =>
-             Report.Failed(Ada.Exceptions.Exception_Name(The_Error) & " "   &
-                           "was incorrectly raised by function To_Decimal " &
-                           "with Binary parameter, when the converted "     &
-                           "value Item was outside the range of type Num");
-       end Binary_Parameter;
- 
-       Long_Binary_Parameter:
-       begin
-          TC_Dec_3 := Pack_3.To_Decimal(Pack_4.To_Long_Binary(TC_Dec_4));
-          Report.Failed("Conversion_Error was not raised by function "     &
-                        "To_Decimal with Long_Binary parameter, when "     &
-                        "the converted value Item was outside the range "  &
-                        "of type Num");
-          if TC_Dec_3 = 123456.78 then  -- Avoid dead assignment optimization.
-             Report.Comment("Should never be printed");
-          end if;
-       exception
-          when Conversion_Error   => null;  -- OK, expected exception.
-          when The_Error : others =>
-             Report.Failed(Ada.Exceptions.Exception_Name(The_Error) & " "    &
-                           "was incorrectly raised by function To_Decimal "  &
-                           "with Long_Binary parameter, when the converted " &
-                           "value Item was outside the range of type Num");
-       end Long_Binary_Parameter;
- 
- 
- 
-       -- Check that the function To_Binary converts a value of the Ada 
-       -- decimal type Num into a Binary type value.
- 
-       TC_Dec_1 := 123.4;
-       TC_Dec_2 := 9.99;
-       if Pack_1.To_Binary(TC_Dec_1) = Pack_1.To_Binary(-TC_Dec_1) or
-          Pack_2.To_Binary(TC_Dec_2) = Pack_2.To_Binary(-TC_Dec_2) 
-       then
-          Report.Failed("Incorrect result from function To_Binary - 1");
-       end if;
- 
-       if Pack_1.To_Binary(1.1)     = Pack_1.To_Binary(-1.1)      or
-          Pack_2.To_Binary(9999.99) = Pack_2.To_Binary(-9999.99) 
-       then
-          Report.Failed("Incorrect result from function To_Binary - 2");
-       end if;
- 
- 
-       -- Check that the function To_Long_Binary converts a value of the 
-       -- Ada decimal type Num into a Long_Binary type value.
- 
-       TC_Dec_3 := 9.001;
-       TC_Dec_4 := 123.4567;
-       if Pack_3.To_Long_Binary(TC_Dec_3) = Pack_3.To_Long_Binary(-TC_Dec_3) or
-          Pack_4.To_Long_Binary(TC_Dec_4) = Pack_4.To_Long_Binary(-TC_Dec_4)
-       then
-          Report.Failed("Incorrect result from function To_Long_Binary - 1");
-       end if;
- 
-       if Pack_3.To_Long_Binary(1.011)        = 
-          Pack_3.To_Long_Binary(-1.011)         or
-          Pack_4.To_Long_Binary(2345678.9012) = 
-          Pack_4.To_Long_Binary(-2345678.9012)
-       then
-          Report.Failed("Incorrect result from function To_Long_Binary - 2");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed("The following exception was raised in the " &
-                        "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB4008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb5001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb5001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb5001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb5001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- CXB5001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE: 
- --      Check that the specification of the package Interfaces.Fortran
- --      are available for use.
- --
- -- TEST DESCRIPTION:
- --      This test verifies that the types and subprograms specified for the
- --      interface are present
- --
- -- APPLICABILITY CRITERIA: 
- --      If an implementation provides package Interfaces.Fortran, this test
- --      must compile, execute, and report "PASSED".
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      28 Feb 96   SAIC    Added applicability criteria.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Report;
- with Interfaces.Fortran;                                        -- N/A => ERROR
- 
- procedure CXB5001 is
-    package Fortran renames Interfaces.FORTRAN;
- 
- begin
- 
-    Report.Test ("CXB5001", "Check the specification of Interfaces.Fortran");
- 
- 
-    declare  -- encapsulate the test
- 
- 
-          TC_Int     : integer := 1;
-          TC_Natural : natural;
-          TC_String  : String := "ABCD";
-          TC_Character : Character := 'a';
- 
-          TST_Fortran_Integer   :  FORTRAN.Fortran_Integer;
- 
-          TST_Real              : Fortran.Real;
-          TST_Double_Precision  : Fortran.Double_Precision;
- 
-          TST_Logical : Fortran.Logical := FORTRAN.true;     
-                                                    -- verify it is a Boolean
-          TST_Complex : Fortran.Complex;
- 
-          TST_Imaginary_i : Fortran.Imaginary := FORTRAN.i;
-          TST_Imaginary_j : Fortran.Imaginary := FORTRAN.j;
- 
- 
-          -- Initialize it so we can use it below
-          TST_Character_Set : Fortran.Character_Set :=   
-                                                 Fortran.Character_Set'First;
- 
-          TST_Fortran_Character : FORTRAN.Fortran_Character (1..5) := 
-                                        (others => TST_Character_Set);
- 
- 
- 
-    begin    -- encapsulation
- 
-       -- Arrange that the calls to the subprograms are compiled but
-       -- not executed
-       -- 
-       if not Report.Equal ( TC_Int, TC_Int ) then
- 
-          TST_Character_Set := Fortran.To_Fortran (TC_Character);
-          TC_Character := Fortran.To_Ada (TST_Character_Set);
-       
- 
-          TST_Fortran_Character := FORTRAN.To_Fortran ("TEST STRING");   
-          Report.Comment ( Fortran.To_Ada (TST_Fortran_Character) );
- 
-          Fortran.To_Fortran ( TC_String, TST_Fortran_Character, TC_Natural );
-          Fortran.To_Ada ( TST_Fortran_Character, TC_String, TC_Natural );
-          
-       end if;
- 
-    end;     -- encapsulation
- 
-    Report.Result;
- 
- end CXB5001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,334 ****
- -- CXB5002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the Function To_Fortran with a Character parameter will
- --      return the corresponding Fortran Character_Set value.
- --
- --      Check that the Function To_Ada with a Character_Set parameter will 
- --      return the corresponding Ada Character value.
- --
- --      Check that the Function To_Fortran with a String parameter will
- --      return the corresponding Fortran_Character value.
- --
- --      Check that the Function To_Ada with a Fortran_Character parameter
- --      will return the corresponding Ada String value.
- --
- -- TEST DESCRIPTION:
- --      This test checks that the functions To_Fortran and To_Ada produce
- --      the correct results, based on a variety of parameter input values.
- --      
- --      In the first series of subtests, the results of the function
- --      To_Fortran are compared against expected Character_Set type results.
- --      In the second series of subtests, the results of the function To_Ada
- --      are compared against expected String type results, and the length of
- --      the String result is also verified against the Fortran_Character type
- --      parameter.
- --      
- --      This test uses Fixed, Bounded, and Unbounded_Strings in combination
- --      with the functions under validation.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.Fortran.Character_Set:
- --      ' ', 'a'..'z', 'A'..'Z', '1'..'9', '-', '_', '$', '#', and '*'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.Fortran.  If an implementation provides
- --      package Interfaces.Fortran, this test must compile, execute, and 
- --      report "PASSED".
- --
- --      This test does not apply to an implementation in which the Fortran
- --      character set ranges are not contiguous (e.g., EBCDIC).
- --      
- --
- --       
- -- CHANGE HISTORY:
- --      11 Mar 96   SAIC    Initial release for 2.1.
- --      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Ada.Characters.Latin_1;
- with Ada.Exceptions;
- with Ada.Strings.Bounded;
- with Ada.Strings.Unbounded;
- with Ada.Unchecked_Conversion;
- with Interfaces.Fortran;                                      -- N/A => ERROR
- with Report;
- 
- procedure CXB5002 is
- begin
- 
-    Report.Test ("CXB5002", "Check that functions To_Fortran and To_Ada " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package ACL renames Ada.Characters.Latin_1;
-       package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
-       package Unb renames Ada.Strings.Unbounded;
- 
-       use Bnd, Unb;
-       use Interfaces.Fortran;
-       use Ada.Exceptions;
- 
-       Null_Fortran_Character  : constant Fortran_Character := "";
-       Fortran_Character_1     : Fortran_Character(1..1)    := " ";
-       Fortran_Character_5     : Fortran_Character(1..5)    := "     ";
-       Fortran_Character_10    : Fortran_Character(1..10)   := "          ";
-       Fortran_Character_20    : Fortran_Character(1..20)   := 
-                                   "                    ";
-       TC_Fortran_Character_1  : Fortran_Character(1..1)    := "A";
-       TC_Fortran_Character_5  : Fortran_Character(1..5)    := "ab*de";
-       TC_Fortran_Character_10 : Fortran_Character(1..10)   := "$1a2b3C4D5";
-       TC_Fortran_Character_20 : Fortran_Character(1..20)   := 
-                                   "1234-ABCD_6789#fghij";
- 
-       Bnd_String              : Bnd.Bounded_String   :=
-                                   Bnd.To_Bounded_String("          ");
-       TC_Bnd_String           : Bounded_String       :=
-                                   To_Bounded_String("$1a2b3C4D5");
- 
-       Unb_String              : Unb.Unbounded_String :=
-                                   Unb.To_Unbounded_String("     ");
-       TC_Unb_String           : Unbounded_String     :=
-                                   To_Unbounded_String("ab*de");
- 
-       String_1                : String(1..1)    := " ";
-       String_5                : String(1..5)    := "     ";
-       String_10               : String(1..10)   := "          ";
-       String_20               : String(1..20)   := "                    ";
-       TC_String_1             : String(1..1)    := "A";
-       TC_String_20            : String(1..20)   := "1234-ABCD_6789#fghij";
-       Null_String             : constant String := "";
- 
-       Null_Character          : constant Character := ACL.Nul;
-       Character_A             : constant Character := Character'Val(65);
-       Character_Z             : constant Character := Character'Val(90);
-       TC_Character            : Character          := Character'First;
- 
-       Null_Character_Set      : Character_Set      := To_Fortran(ACL.Nul);
-       TC_Character_Set,
-       TC_Low_Character_Set,
-       TC_High_Character_Set   : Character_Set      := Character_Set'First;
- 
- 
-       -- The following procedure checks the results of function To_Ada.
- 
-       procedure Check_Length (Str : in String;
-                               Ftn : in Fortran_Character;
-                               Num : in Natural) is
-       begin
-          if Str'Length /= Ftn'Length or
-             Str'Length /= Num
-          then
-             Report.Failed("Incorrect result from Function To_Ada " &
-                           "with string length " & Integer'Image(Num));
-          end if;
-       end Check_Length;
- 
-       -- To facilitate the conversion of Character-Character_Set data, the 
-       -- following functions have been instantiated.  
- 
-       function Character_to_Character_Set is
-         new Ada.Unchecked_Conversion(Character, Character_Set);
- 
-       function Character_Set_to_Character is
-         new Ada.Unchecked_Conversion(Character_Set, Character);
- 
-    begin
- 
-       -- Check that the Function To_Fortran with a Character parameter
-       -- will return the corresponding Fortran Character_Set value.
- 
-       for TC_Character in ACL.LC_A..ACL.LC_Z loop
-          if To_Fortran(Item => TC_Character) /= 
-             Character_to_Character_Set(TC_Character) 
-          then
-             Report.Failed("Incorrect result from To_Fortran with lower " &
-                           "case alphabetic character input");
-          end if;
-       end loop;
- 
-       for TC_Character in Character_A..Character_Z loop
-          if To_Fortran(TC_Character) /= 
-             Character_to_Character_Set(TC_Character) 
-          then
-             Report.Failed("Incorrect result from To_Fortran with upper " &
-                           "case alphabetic character input");
-          end if;
-       end loop;
- 
-       if To_Fortran(Null_Character) /= 
-          Character_to_Character_Set(Null_Character)
-       then
-          Report.Failed
-            ("Incorrect result from To_Fortran with null character input");
-       end if;
- 
- 
-       -- Check that the Function To_Ada with a Character_Set parameter 
-       -- will return the corresponding Ada Character value.
- 
-       TC_Low_Character_Set  := Character_to_Character_Set('a');
-       TC_High_Character_Set := Character_to_Character_Set('z');
-       for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
-          if To_Ada(Item => TC_Character_Set) /= 
-             Character_Set_to_Character(TC_Character_Set) 
-          then
-             Report.Failed("Incorrect result from To_Ada with lower case " &
-                           "alphabetic Character_Set input");
-          end if;
-       end loop;
- 
-       TC_Low_Character_Set  := Character_to_Character_Set('A');
-       TC_High_Character_Set := Character_to_Character_Set('Z');
-       for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
-          if To_Ada(TC_Character_Set) /= 
-             Character_Set_to_Character(TC_Character_Set) 
-          then
-             Report.Failed("Incorrect result from To_Ada with upper case " &
-                           "alphabetic Character_Set input");
-          end if;
-       end loop;
- 
-       if To_Ada(Character_to_Character_Set(Null_Character)) /=
-          Null_Character
-       then
-          Report.Failed("Incorrect result from To_Ada with a null " &
-                        "Character_Set input");
-       end if;
- 
- 
-       -- Check that the Function To_Fortran with a String parameter 
-       -- will return the corresponding Fortran_Character value.
-       -- Note: The type Fortran_Character is a character array type that
-       --       corresponds to Ada type String.
- 
-       Fortran_Character_1 := To_Fortran(Item => TC_String_1);
- 
-       if Fortran_Character_1 /= TC_Fortran_Character_1 then
-          Report.Failed("Incorrect result from procedure To_Fortran - 1");
-       end if;
- 
-       Fortran_Character_5 := To_Fortran(To_String(TC_Unb_String));
- 
-       if Fortran_Character_5 /= TC_Fortran_Character_5 then
-          Report.Failed("Incorrect result from procedure To_Fortran - 2");
-       end if;
- 
-       Fortran_Character_10 := To_Fortran(To_String(TC_Bnd_String));
- 
-       if Fortran_Character_10 /= TC_Fortran_Character_10 then
-          Report.Failed("Incorrect result from procedure To_Fortran - 3");
-       end if;
- 
-       Fortran_Character_20 := To_Fortran(Item => TC_String_20);
- 
-       if Fortran_Character_20 /= TC_Fortran_Character_20 then
-          Report.Failed("Incorrect result from procedure To_Fortran - 4");
-       end if;
- 
-       if To_Fortran(Null_String) /= Null_Fortran_Character then
-          Report.Failed("Incorrect result from procedure To_Fortran - 5");
-       end if;
- 
- 
-       -- Check that the Function To_Ada with a Fortran_Character parameter
-       -- will return the corresponding Ada String value.
- 
-       String_1 := To_Ada(TC_Fortran_Character_1);
- 
-       if String_1 /= TC_String_1 then
-          Report.Failed("Incorrect value returned from function To_Ada - 1");
-       end if;
- 
-       Check_Length(To_Ada(TC_Fortran_Character_1),
-                    TC_Fortran_Character_1,
-                    Num => 1);
- 
- 
-       Unb_String := Unb.To_Unbounded_String(To_Ada(TC_Fortran_Character_5));
- 
-       if Unb_String /= TC_Unb_String then
-          Report.Failed("Incorrect value returned from function To_Ada - 2");
-       end if;
- 
-       Check_Length(To_Ada(TC_Fortran_Character_5),
-                    TC_Fortran_Character_5,
-                    Num => 5);
- 
- 
-       Bnd_String := Bnd.To_Bounded_String 
-                          (To_Ada(TC_Fortran_Character_10));
- 
-       if Bnd_String /= TC_Bnd_String then
-          Report.Failed("Incorrect value returned from function To_Ada - 3");
-       end if;
- 
-       Check_Length(To_Ada(TC_Fortran_Character_10),
-                    TC_Fortran_Character_10,
-                    Num => 10);
- 
- 
-       String_20 := To_Ada(TC_Fortran_Character_20);
- 
-       if String_20 /= TC_String_20 then
-          Report.Failed("Incorrect value returned from function To_Ada - 4");
-       end if;
- 
-       Check_Length(To_Ada(TC_Fortran_Character_20),
-                    TC_Fortran_Character_20,
-                    Num => 20);
- 
-       if To_Ada(Null_Character_Set) /= Null_Character then
-          Report.Failed("Incorrect value returned from function To_Ada - 5");
-       end if;
- 
- 
-       -- Check the two functions when used in combination.
- 
-       if To_Ada(Item => To_Fortran("This is a test")) /=
-          "This is a test"                                or
-          To_Ada(To_Fortran("1234567890abcdeFGHIJ"))   /=
-          Report.Ident_Str("1234567890abcdeFGHIJ")
-       then
-          Report.Failed("Incorrect result returned when using the " &
-                        "functions To_Ada and To_Fortran in combination");
-       end if;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed("The following exception was raised in the " &
-                        "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB5002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,295 ****
- -- CXB5003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the procedure To_Fortran converts the character elements
- --      of the String parameter Item into Character_Set elements of the
- --      Fortran_Character type parameter Target.  Check that the parameter 
- --      Last contains the index of the last element of parameter Target 
- --      that was assigned by To_Fortran.
- --
- --      Check that Constraint_Error is propagated by procedure To_Fortran
- --      when the length of String parameter Item exceeds the length of 
- --      Fortran_Character parameter Target.
- --
- --      Check that the procedure To_Ada converts the Character_Set
- --      elements of the Fortran_Character parameter Item into Character
- --      elements of the String parameter Target.  Check that the parameter
- --      Last contains the index of the last element of parameter Target 
- --      that was assigned by To_Ada.
- --
- --      Check that Constraint_Error is propagated by procedure To_Ada when
- --      the length of Fortran_Character parameter Item exceeds the length of 
- --      String parameter Target.
- --
- -- TEST DESCRIPTION:
- --      This test checks that the procedures To_Fortran and To_Ada produce
- --      the correct results, based on a variety of parameter input values.
- --      
- --      In the first series of subtests, the Out parameter results of 
- --      procedure To_Fortran are compared against expected results,
- --      which includes (in the parameter Last) the index in Target of the 
- --      last element assigned.  The situation where procedure To_Fortran
- --      raises Constraint_Error (when Item'Length exceeds Target'Length) 
- --      is also verified.
- --
- --      In the second series of subtests, the Out parameter results of 
- --      procedure To_Ada are verified, in a similar manner as is done for
- --      procedure To_Fortran.  The case of procedure To_Ada raising 
- --      Constraint_Error is also verified.
- --      
- --      This test assumes that the following characters are all included
- --      in the implementation defined type Interfaces.Fortran.Character_Set:
- --      ' ', 'a'..'j', 'A'..'D', '1'..'9', '-', '_', '$', '#', and '*'.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable to all implementations that provide 
- --      package Interfaces.Fortran.  If an implementation provides
- --      package Interfaces.Fortran, this test must compile, execute, and 
- --      report "PASSED".
- --
- --       
- -- CHANGE HISTORY:
- --      14 Mar 96   SAIC    Initial release for 2.1.
- --      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
- --      27 Oct 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Ada.Exceptions;
- with Ada.Strings.Bounded;
- with Ada.Strings.Unbounded;
- with Interfaces.Fortran;                                      -- N/A => ERROR
- with Report;
- 
- procedure CXB5003 is
- begin
- 
-    Report.Test ("CXB5003", "Check that procedures To_Fortran and To_Ada " &
-                            "produce correct results");
- 
-    Test_Block:
-    declare
- 
-       package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
-       package Unb renames Ada.Strings.Unbounded;
- 
-       use Bnd, Unb;
-       use Interfaces.Fortran;
-       use Ada.Exceptions;
- 
-       Fortran_Character_1     : Fortran_Character(1..1)  := " ";
-       Fortran_Character_5     : Fortran_Character(1..5)  := "     ";
-       Fortran_Character_10    : Fortran_Character(1..10) := "          ";
-       Fortran_Character_20    : Fortran_Character(1..20) := 
-                                   "                    ";
-       TC_Fortran_Character_1  : Fortran_Character(1..1)  := "A";
-       TC_Fortran_Character_5  : Fortran_Character(1..5)  := "ab*de";
-       TC_Fortran_Character_10 : Fortran_Character(1..10) := "$1a2b3C4D5";
-       TC_Fortran_Character_20 : Fortran_Character(1..20) := 
-                                   "1234-ABCD_6789#fghij";
- 
-       Bnd_String              : Bnd.Bounded_String   :=
-                                   Bnd.To_Bounded_String("          ");
-       TC_Bnd_String           : Bounded_String       :=
-                                   To_Bounded_String("$1a2b3C4D5");
- 
-       Unb_String              : Unb.Unbounded_String :=
-                                   Unb.To_Unbounded_String("     ");
-       TC_Unb_String           : Unbounded_String     :=
-                                   To_Unbounded_String("ab*de");
- 
-       String_1                : String(1..1)   := " ";
-       String_5                : String(1..5)   := "     ";
-       String_10               : String(1..10)  := "          ";
-       String_20               : String(1..20)  := "                    ";
-       TC_String_1             : String(1..1)   := "A";
-       TC_String_20            : String(1..20)  := "1234-ABCD_6789#fghij";
- 
-       TC_Fortran_Character    : constant Fortran_Character := ""; 
-       TC_String               : constant String            := ""; 
-       TC_Natural              : Natural                    := 0;
- 
- 
-    begin
- 
-       -- Check that the procedure To_Fortran converts the character elements
-       -- of the String parameter Item into Character_Set elements of the 
-       -- Fortran_Character type parameter Target.  
-       -- Check that the parameter Last contains the index of the last element
-       -- of parameter Target that was assigned by To_Fortran.
- 
-       To_Fortran(Item   => TC_String_1,
-                  Target => Fortran_Character_1,
-                  Last   => TC_Natural);
- 
-       if Fortran_Character_1 /= TC_Fortran_Character_1        or
-          TC_Natural          /= TC_Fortran_Character_1'Length 
-       then
-          Report.Failed("Incorrect result from procedure To_Fortran - 1");
-       end if;
- 
-       To_Fortran(To_String(TC_Unb_String),
-                  Target => Fortran_Character_5,
-                  Last   => TC_Natural);
- 
-       if Fortran_Character_5 /= TC_Fortran_Character_5        or
-          TC_Natural          /= TC_Fortran_Character_5'Length 
-       then
-          Report.Failed("Incorrect result from procedure To_Fortran - 2");
-       end if;
- 
-       To_Fortran(To_String(TC_Bnd_String),
-                  Fortran_Character_10,
-                  Last   => TC_Natural);
- 
-       if Fortran_Character_10 /= TC_Fortran_Character_10        or
-          TC_Natural           /= TC_Fortran_Character_10'Length
-       then
-          Report.Failed("Incorrect result from procedure To_Fortran - 3");
-       end if;
- 
-       To_Fortran(TC_String_20, Fortran_Character_20, TC_Natural);
- 
-       if Fortran_Character_20 /= TC_Fortran_Character_20        or
-          TC_Natural           /= TC_Fortran_Character_20'Length 
-       then
-          Report.Failed("Incorrect result from procedure To_Fortran - 4");
-       end if;
- 
-       To_Fortran(Item   => TC_String,     -- null string
-                  Target => Fortran_Character_1,
-                  Last   => TC_Natural);
- 
-       if TC_Natural /= 0 then
-          Report.Failed("Incorrect result from procedure To_Fortran, value "  &
-                        "returned in parameter Last should be zero, since " &
-                        "parameter Item is null array");
-       end if;
- 
- 
-       -- Check that Constraint_Error is propagated by procedure To_Fortran
-       -- when the length of String parameter Item exceeds the length of 
-       -- Fortran_Character parameter Target.
- 
-       begin
- 
-          To_Fortran(Item   => TC_String_20,
-                     Target => Fortran_Character_10,
-                     Last   => TC_Natural);
-          Report.Failed("Constraint_Error not raised by procedure " &
-                        "To_Fortran when Item'Length exceeds Target'Length");
-       exception
-          when Constraint_Error   => null;  -- OK, expected exception.
-          when The_Error : others =>
-             Report.Failed("The following exception was raised by procedure " &
-                           "To_Fortran when Item'Length exceeds "             &
-                           "Target'Length: " & Exception_Name(The_Error));
-       end;
- 
- 
-       -- Check that the procedure To_Ada converts the Character_Set 
-       -- elements of the Fortran_Character parameter Item into Character
-       -- elements of the String parameter Target.  
-       -- Check that the parameter Last contains the index of the last 
-       -- element of parameter Target that was assigned by To_Ada.
- 
-       To_Ada(Item   => TC_Fortran_Character_1,
-              Target => String_1,
-              Last   => TC_Natural);
- 
-       if String_1   /= TC_String_1        or
-          TC_Natural /= TC_String_1'Length 
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 1");
-       end if;
- 
-       To_Ada(TC_Fortran_Character_5,
-              Target => String_5,
-              Last   => TC_Natural);
- 
-       if String_5   /= To_String(TC_Unb_String) or
-          TC_Natural /= Length(TC_Unb_String)    
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 2");
-       end if;
- 
-       To_Ada(TC_Fortran_Character_10,
-              String_10,
-              Last   => TC_Natural);
- 
-       if String_10   /= To_String(TC_Bnd_String) or
-          TC_Natural  /= Length(TC_Bnd_String)   
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 3");
-       end if;
- 
-       To_Ada(TC_Fortran_Character_20, String_20, TC_Natural);
- 
-       if String_20   /= TC_String_20        or
-          TC_Natural  /= TC_String_20'Length 
-       then
-          Report.Failed("Incorrect result from procedure To_Ada - 4");
-       end if;
- 
-       To_Ada(Item   => TC_Fortran_Character,  -- null array.
-              Target => String_20,
-              Last   => TC_Natural);
- 
-       if TC_Natural /= 0 then
-          Report.Failed("Incorrect result from procedure To_Ada, value "    &
-                        "returned in parameter Last should be zero, since " &
-                        "parameter Item is null array");
-       end if;
- 
- 
-       -- Check that Constraint_Error is propagated by procedure To_Ada 
-       -- when the length of Fortran_Character parameter Item exceeds the 
-       -- length of String parameter Target.
- 
-       begin
- 
-          To_Ada(Item   => TC_Fortran_Character_10,
-                 Target => String_5,
-                 Last   => TC_Natural);
-          Report.Failed("Constraint_Error not raised by procedure To_Ada " &
-                        "when Item'Length exceeds Target'Length");
-       exception
-          when Constraint_Error   => null;  -- OK, expected exception.
-          when The_Error : others =>
-             Report.Failed("Incorrect exception raised by procedure To_Ada " &
-                           "when Item'Length exceeds Target'Length");
-       end;
- 
- 
-    exception
-       when The_Error : others => 
-          Report.Failed("The following exception was raised in the " &
-                        "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXB5003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,261 ****
- -- CXF1001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that values of 2 and 10 are allowable values for Machine_Radix 
- --      of a decimal first subtype.
- --      Check that the value of Decimal.Max_Decimal_Digits is at least 18; 
- --      the value of Decimal.Max_Scale is at least 18; the value of 
- --      Decimal.Min_Scale is at most 0.
- --
- -- TEST DESCRIPTION:
- --      This test examines the Machine_Radix attribute definition clause
- --      and its effect on Decimal fixed point types, as well as several
- --      constants from the package Ada.Decimal.
- --      The first subtest checks that the Machine_Radix attribute will 
- --      return the value set for Machine_Radix by an attribute definition
- --      clause.  The second and third subtests examine differences between
- --      the binary and decimal scaling of a type, based on the radix 
- --      representation.  The final subtest examines the values
- --      assigned to constants Min_Scale, Max_Scale, and Max_Decimal_Digits,
- --      found in the package Ada.Decimal.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      29 Dec 94   SAIC    Restructured Radix 10 and Radix 2 test blocks.
- --
- --!
- 
- with Report;
- with Ada.Decimal;
- 
- procedure CXF1001 is
- begin
- 
-    Report.Test ("CXF1001", "Check that values of 2 and 10 are allowable " &
-                            "values for Machine_Radix of a decimal first " &
-                            "subtype.  Check that the value of "           &
-                            "Decimal.Max_Decimal_Digits is at least 18; "  &
-                            "the value of Decimal.Max_Scale is at least "  &
-                            "18; the value of Decimal.Min_Scale is at "    &
-                            "most 0");
- 
-    Attribute_Check_Block:
-    declare
- 
-       Del          : constant := 1.0/10**2;
-       Const_Digits : constant :=  3;
-       Two          : constant :=  2;
-       Ten          : constant := 10;
- 
-       type Radix_2_Type_1  is delta 0.01  digits 7;
-       type Radix_2_Type_2  is delta Ada.Decimal.Min_Delta digits 10;        
-       type Radix_2_Type_3  is
-         delta 0.000_1 digits Ada.Decimal.Max_Decimal_Digits;
- 
-       type Radix_10_Type_1 is delta 10.0**(-Ada.Decimal.Max_Scale) digits 8;
-       type Radix_10_Type_2 is delta 10.0**(-Ada.Decimal.Min_Scale) digits 6;
-       type Radix_10_Type_3 is delta Ada.Decimal.Max_Delta digits 15;        
-         
- 
-       -- Use an attribute definition clause to set the Machine_Radix for a
-       -- decimal first subtype to either 2 or 10.
-       for Radix_2_Type_1'Machine_Radix  use 2;                      
-       for Radix_2_Type_2'Machine_Radix  use Two;                    
-       for Radix_2_Type_3'Machine_Radix  use 10-8;                   
- 
-       for Radix_10_Type_1'Machine_Radix use 2*15/Const_Digits;     
-       for Radix_10_Type_2'Machine_Radix use Ten;                             
-       for Radix_10_Type_3'Machine_Radix use Radix_10_Type_2'Machine_Radix;
- 
- 
-    begin
- 
-       -- Check that the attribute 'Machine_Radix returns the value assigned
-       -- by the attribute definition clause.
- 
-       if Radix_2_Type_1'Machine_Radix /= 2  or else
-          Radix_2_Type_2'Machine_Radix /= 2  or else
-          Radix_2_Type_3'Machine_Radix /= 2  
-       then
-          Report.Failed("Incorrect radix value returned, 2 expected");
-       end if;
- 
-       if Radix_10_Type_1'Machine_Radix /= 10  or else
-          Radix_10_Type_2'Machine_Radix /= 10  or else
-          Radix_10_Type_3'Machine_Radix /= 10  
-       then
-          Report.Failed("Incorrect radix value returned, 10 expected");
-       end if;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Attr_Check_Block");
-    end Attribute_Check_Block;
- 
- 
- 
-    Radix_Block:
-    -- Premises:
-    --   1) Choose several numbers, from types using either decimal scaling or
-    --      binary scaling.
-    --   1) Repetitively add these numbers to themselves.
-    --   3) Validate that the result is the expected result, regardless of the
-    --      scaling used in the definition of the type.
-    declare
- 
-       Number_Of_Values : constant :=    3;
-       Loop_Count       : constant := 1000;
- 
-       type Radix_2_Type  is delta 0.0001 digits 10;
-       type Radix_10_Type is delta 0.0001 digits 10;
-                                       
-       for Radix_2_Type'Machine_Radix  use  2;
-       for Radix_10_Type'Machine_Radix use 10;
- 
-       type Result_Record_Type is record
-          Rad_2  : Radix_2_Type;
-          Rad_10 : Radix_10_Type;
-       end record;
- 
-       type Result_Array_Type is array (1..Number_Of_Values) 
-         of Result_Record_Type;
- 
-       Result_Array : Result_Array_Type := ((50.00,  50.00), 
-                                            (613.00, 613.00), 
-                                            (72.70,  72.70));
- 
-       function Repetitive_Radix_2_Add (Value : in Radix_2_Type) 
-         return Radix_2_Type is
-          Result : Radix_2_Type := 0.0;
-       begin
-         for i in 1..Loop_Count loop
-            Result := Result + Value;
-         end loop;
-         return Result;
-       end Repetitive_Radix_2_Add;
- 
-       function Repetitive_Radix_10_Add (Value : in Radix_10_Type) 
-         return Radix_10_Type is
-          Result : Radix_10_Type := 0.0;
-       begin
-         for i in 1..Loop_Count loop
-            Result := Result + Value;
-         end loop;
-         return Result;
-       end Repetitive_Radix_10_Add;
- 
-    begin
- 
-       -- Radix 2 Cases, three different values.
-       -- Compare the result of the repetitive addition with the expected
-       -- Radix 2 result, as well as with the Radix 10 value after type 
-       -- conversion.
- 
-       if Repetitive_Radix_2_Add(0.05) /= Result_Array(1).Rad_2  or
-          Repetitive_Radix_2_Add(0.05) /= Radix_2_Type(Result_Array(1).Rad_10)
-       then
-          Report.Failed("Incorrect Radix 2 Result, Case 1");
-       end if;
- 
-       if Repetitive_Radix_2_Add(0.613) /= 
-          Result_Array(2).Rad_2            or
-          Repetitive_Radix_2_Add(0.613) /= 
-          Radix_2_Type(Result_Array(2).Rad_10)
-       then
-          Report.Failed("Incorrect Radix 2 Result, Case 2");
-       end if;
- 
-       if Repetitive_Radix_2_Add(0.0727)  /= 
-          Result_Array(3).Rad_2              or
-          Repetitive_Radix_2_Add(0.0727)  /= 
-          Radix_2_Type(Result_Array(3).Rad_10)
-       then
-          Report.Failed("Incorrect Radix 2 Result, Case 3");
-       end if;
- 
-       -- Radix 10 Cases, three different values.
-       -- Compare the result of the repetitive addition with the expected
-       -- Radix 10 result, as well as with the Radix 2 value after type 
-       -- conversion.
- 
-       if Repetitive_Radix_10_Add(0.05) /= Result_Array(1).Rad_10  or
-          Repetitive_Radix_10_Add(0.05) /= Radix_10_Type(Result_Array(1).Rad_2)
-       then
-          Report.Failed("Incorrect Radix 10 Result, Case 1");
-       end if;
- 
-       if Repetitive_Radix_10_Add(0.613) /= 
-          Result_Array(2).Rad_10            or
-          Repetitive_Radix_10_Add(0.613) /= 
-          Radix_10_Type(Result_Array(2).Rad_2)
-       then
-          Report.Failed("Incorrect Radix 10 Result, Case 2");
-       end if;
- 
-       if Repetitive_Radix_10_Add(0.0727) /= 
-          Result_Array(3).Rad_10             or
-          Repetitive_Radix_10_Add(0.0727) /= 
-          Radix_10_Type(Result_Array(3).Rad_2)
-       then
-          Report.Failed("Incorrect Radix 10 Result, Case 3");
-       end if;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Radix_Block");
-    end Radix_Block;
- 
- 
- 
-    Size_Block:
-    -- Check the implementation max/min values of constants declared in
-    -- package Ada.Decimal.
-    declare
-       Minimum_Required_Size : constant := 18;
-       Maximum_Allowed_Size  : constant :=  0;
-    begin
- 
-       -- Check that the Max_Decimal_Digits value is at least 18.
-       if not (Ada.Decimal.Max_Decimal_Digits >= Minimum_Required_Size) then
-          Report.Failed("Insufficient size provided for Max_Decimal_Digits");
-       end if;
- 
-       -- Check that the Max_Scale value is at least 18.
-       if not (Ada.Decimal.Max_Scale >= Minimum_Required_Size) then
-          Report.Failed("Insufficient size provided for Max_Scale");
-       end if;
- 
-       -- Check that the Min_Scale value is at most 0.
-       if not (Ada.Decimal.Min_Scale <= Maximum_Allowed_Size) then
-          Report.Failed("Too large a value provided for Min_Scale");
-       end if;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Size_Block");
-    end Size_Block;
- 
-    Report.Result;
- 
- end CXF1001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,755 ****
- -- CXF2001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the Divide procedure provides the following results:
- --        Quotient = Dividend divided by Divisor  and
- --        Remainder = Dividend - (Divisor * Quotient)
- --      Check that the Remainder is calculated exactly.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to test the generic procedure Divide found in
- --      package Ada.Decimal.
- --
- --      The table below attempts to portray the design approach used in this
- --      test.  There are three "dimensions" of concern:
- --        1) the delta value of the Quotient and Remainder types, shown as
- --           column headers,
- --        2) specific choices for the Dividend and Divisor numerical values
- --           (i.e., whether they yielded a repeating/non-terminating result,
- --            or a terminating result ["exact"]), displayed on the left side
- --            of the tables, and
- --        3) the delta for the Dividend and Divisor.
- --
- --      Each row in the tables indicates a specific test case, showing the
- --      specific quotient and remainder (under the appropriate Delta column)
- --      for each combination of dividend and divisor values.  Test cases
- --      follow the top-to-bottom sequence shown in the tables.
- --
- --      Most of the test case sets (same dividend/divisor combinations -
- --      indicated by dashed horizontal lines in the tables) vary the
- --      delta of the quotient and remainder types between test cases. This
- --      allows for an examination of how different deltas for a quotient
- --      and/or remainder type can influence the results of a division with
- --      identical dividend and divisor.
- --
- --      Note: Test cases are performed for both Radix 10 and Radix 2 types.
- --
- --
- --  Divid  Divis    Delta     Delta       Delta       Delta       Delta
- -- (Delta)(Delta)|  .1   |    .01    |   .001    |   .0001   |  .00001   |Test
- --               |---|---|-----|-----|-----|-----|-----|-----|-----|-----|Case
- --    quotient   | Q | R |  Q  |  R  |  Q  |  R  |  Q  |  R  |  Q  |  R  | No.
- -- ---------------------------------------------------------------------------
- --  .05     .3   |.1             .02                                       1,21
- -- (.01)   (.1)  |.1   0                                                   2,22
- --               |         .16               .002                          3,23
- --   0.166666..  |         .16   .00                                       4,24
- --               |                     .166             .0002              5,25
- -- ---------------------------------------------------------------------------
- --  .15     20   |         .00                          .1500              6,26
- -- (.01)    (1)  |         .00               .150                          7,27
- --               |         .00   .15                                       8,28
- --   0.0075      |               .01   .007                                9,29
- --               |                     .007  .010                         10,30
- --               |                                .0075 .0000             11,31
- -- ---------------------------------------------------------------------------
- --  .03125   .5  |                                .0625 .0000             12,32
- -- (.00001) (.1) |                     .062                        .00025 13,33
- --               |                     .062             .0002             14,34
- --   0.0625      |                     .062  .000                         15,35
- --               |               .00   .062                               16,36
- --               |         .06                                     .00125 17,37
- --               |         .06                          .0012             18,38
- --               |         .06               .001                         19,39
- --               |         .06   .00                                      20,40
- -- ---------------------------------------------------------------------------
- -- Divide by Zero| Raise Constraint_Error                                 41
- -- ---------------------------------------------------------------------------
- --
- --
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      29 Dec 94   SAIC    Modified Radix 2 cases to match Radix 10 cases.
- --      03 Oct 95   RBKD    Modified to fix incorrect remainder results.
- --      15 Nov 95   SAIC    Incorporated reviewer fixes for ACVC 2.0.1.
- --      18 Dec 06   RLB     Fixed failure message to have correct block name.
- --!
- 
- with Report;
- with Ada.Decimal;
- 
- procedure CXF2001 is
- 
-    TC_Verbose : Boolean := False;
- 
- begin
- 
-    Report.Test ("CXF2001", "Check that the Divide procedure provides "  &
-                            "correct results. Check that the Remainder " &
-                            "is calculated exactly");
-    Radix_10_Block:
-    declare
- 
- 
-       -- Declare all types and variables used in the various blocks below
-       -- for all Radix 10 evaluations.
- 
-       type DT_1       is delta 1.0     digits 5;
-       type DT_0_1     is delta 0.1     digits 10;
-       type DT_0_01    is delta 0.01    digits 10;
-       type DT_0_001   is delta 0.001   digits 10;
-       type DT_0_0001  is delta 0.0001  digits 10;
-       type DT_0_00001 is delta 0.00001 digits 10;
- 
-       for DT_1'Machine_Radix       use 10;
-       for DT_0_1'Machine_Radix     use 10;
-       for DT_0_01'Machine_Radix    use 10;
-       for DT_0_001'Machine_Radix   use 10;
-       for DT_0_0001'Machine_Radix  use 10;
-       for DT_0_00001'Machine_Radix use 10;
- 
-       Dd_1,       Dv_1,       Quot_1,       Rem_1       : DT_1       := 0.0;
-       Dd_0_1,     Dv_0_1,     Quot_0_1,     Rem_0_1     : DT_0_1     := 0.0;
-       Dd_0_01,    Dv_0_01,    Quot_0_01,    Rem_0_01    : DT_0_01    := 0.0;
-       Dd_0_001,   Dv_0_001,   Quot_0_001,   Rem_0_001   : DT_0_001   := 0.0;
-       Dd_0_0001,  Dv_0_0001,  Quot_0_0001,  Rem_0_0001  : DT_0_0001  := 0.0;
-       Dd_0_00001, Dv_0_00001, Quot_0_00001, Rem_0_00001 : DT_0_00001 := 0.0;
- 
-    begin
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(Dividend_Type  => DT_0_01,
-                                    Divisor_Type   => DT_0_1,
-                                    Quotient_Type  => DT_0_1,
-                                    Remainder_Type => DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 1"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_01);
-          if Quot_0_1 /= DT_0_1(0.1)  or  Rem_0_01 /= DT_0_01(0.02) then
-             Report.Failed("Incorrect values returned, Case 1");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_1, DT_0_1);
-       begin
-          if TC_Verbose then Report.Comment("Case 2"); end if;
-          Dd_0_01 := DT_0_01(0.05);   Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_1);
-          if Quot_0_1 /= DT_0_1(0.1) or  Rem_0_1 /= DT_0_1(0.0) then
-             Report.Failed("Incorrect values returned, Case 2");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 3"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_001);
-          if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_001 /= DT_0_001(0.002) then
-             Report.Failed("Incorrect values returned, Case 3");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 4"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_01);
-          if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_01 /= DT_0_01(0.0) then
-             Report.Failed("Incorrect values returned, Case 4");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 5"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_001, Rem_0_0001);
-          if Quot_0_001 /= DT_0_001(0.166)   or
-             Rem_0_0001 /= DT_0_0001(0.0002)
-          then
-             Report.Failed("Incorrect values returned, Case 5");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 6"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_0001);
-          if Quot_0_01 /= DT_0_01(0.0) or Rem_0_0001 /= DT_0_0001(0.1500) then
-             Report.Failed("Incorrect values returned, Case 6");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 7"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_001);
-          if Quot_0_01 /= DT_0_01(0.0) or Rem_0_001 /= DT_0_001(0.150) then
-             Report.Failed("Incorrect values returned, Case 7");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 8"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_01);
-          if Quot_0_01 /= DT_0_01(0.0) or Rem_0_01 /= DT_0_01(0.15) then
-             Report.Failed("Incorrect values returned, Case 8");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 9"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_001);
-          if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_001 /= DT_0_001(0.01) then
-             Report.Failed("Incorrect values returned, Case 9");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 10"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_01);
-          if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_01 /= DT_0_01(0.01) then
-             Report.Failed("Incorrect values returned, Case 10");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_0001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 11"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_0001, Rem_0_0001);
-          if Quot_0_0001 /= DT_0_0001(0.0075) or
-             Rem_0_0001  /= DT_0_0001(0.0)
-          then
-             Report.Failed("Incorrect values returned, Case 11");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_0001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 12"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_0001, Rem_0_0001);
-          if Quot_0_0001 /= DT_0_0001(0.0625) or
-             Rem_0_0001  /= DT_0_0001(0.0)
-          then
-             Report.Failed("Incorrect values returned, Case 12");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_00001);
-       begin
-          if TC_Verbose then Report.Comment("Case 13"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_00001);
-          if Quot_0_001 /= DT_0_001(0.062) or
-             Rem_0_00001  /= DT_0_00001(0.00025)
-          then
-             Report.Failed("Incorrect values returned, Case 13");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 14"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_0001);
-          if Quot_0_001 /= DT_0_001(0.062) or
-             Rem_0_0001  /= DT_0_0001(0.0002)
-          then
-             Report.Failed("Incorrect values returned, Case 14");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 15"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_001);
-          if Quot_0_001 /= DT_0_001(0.062) or Rem_0_001 /= DT_0_001(0.000)
-          then
-             Report.Failed("Incorrect values returned, Case 15");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 16"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_01);
-          if Quot_0_001 /= DT_0_001(0.062) or Rem_0_01 /= DT_0_01(0.00) then
-             Report.Failed("Incorrect values returned, Case 16");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_00001);
-       begin
-          if TC_Verbose then Report.Comment("Case 17"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_00001);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_00001 /= DT_0_00001(0.00125)
-          then
-             Report.Failed("Incorrect values returned, Case 17");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 18"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_0001);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_0001 /= DT_0_0001(0.0012)
-          then
-             Report.Failed("Incorrect values returned, Case 18");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 19"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_001);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_001 /= DT_0_001(0.001) then
-             Report.Failed("Incorrect values returned, Case 19");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 20"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_01);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_01 /= DT_0_01(0.0) then
-             Report.Failed("Incorrect values returned, Case 20");
-          end if;
-       end;
- 
- 
-    exception
-       when others => Report.Failed("Exception raised in Radix_10_Block");
-    end Radix_10_Block;
- 
- 
- 
-    Radix_2_Block:
-    declare
- 
-       -- Declare all types and variables used in the various blocks below
-       -- for all Radix 2 evaluations.
- 
-       type DT_1       is delta 1.0     digits 5;
-       type DT_0_1     is delta 0.1     digits 10;
-       type DT_0_01    is delta 0.01    digits 10;
-       type DT_0_001   is delta 0.001   digits 10;
-       type DT_0_0001  is delta 0.0001  digits 10;
-       type DT_0_00001 is delta 0.00001 digits 10;
- 
-       for DT_1'Machine_Radix       use 2;
-       for DT_0_1'Machine_Radix     use 2;
-       for DT_0_01'Machine_Radix    use 2;
-       for DT_0_001'Machine_Radix   use 2;
-       for DT_0_0001'Machine_Radix  use 2;
-       for DT_0_00001'Machine_Radix use 2;
- 
-       Dd_1,       Dv_1,       Quot_1,       Rem_1       : DT_1       := 0.0;
-       Dd_0_1,     Dv_0_1,     Quot_0_1,     Rem_0_1     : DT_0_1     := 0.0;
-       Dd_0_01,    Dv_0_01,    Quot_0_01,    Rem_0_01    : DT_0_01    := 0.0;
-       Dd_0_001,   Dv_0_001,   Quot_0_001,   Rem_0_001   : DT_0_001   := 0.0;
-       Dd_0_0001,  Dv_0_0001,  Quot_0_0001,  Rem_0_0001  : DT_0_0001  := 0.0;
-       Dd_0_00001, Dv_0_00001, Quot_0_00001, Rem_0_00001 : DT_0_00001 := 0.0;
- 
-    begin
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(Dividend_Type  => DT_0_01,
-                                    Divisor_Type   => DT_0_1,
-                                    Quotient_Type  => DT_0_1,
-                                    Remainder_Type => DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 21"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_01);
-          if Quot_0_1 /= DT_0_1(0.1)  or  Rem_0_01 /= DT_0_01(0.02) then
-             Report.Failed("Incorrect values returned, Case 21");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_1, DT_0_1);
-       begin
-          if TC_Verbose then Report.Comment("Case 22"); end if;
-          Dd_0_01 := DT_0_01(0.05);   Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_1);
-          if Quot_0_1 /= DT_0_1(0.1) or  Rem_0_1 /= DT_0_1(0.0) then
-             Report.Failed("Incorrect values returned, Case 22");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 23"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_001);
-          if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_001 /= DT_0_001(0.002) then
-             Report.Failed("Incorrect values returned, Case 23");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 24"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_01);
-          if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_01 /= DT_0_01(0.0) then
-             Report.Failed("Incorrect values returned, Case 24");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 25"); end if;
-          Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
-          Div(Dd_0_01, Dv_0_1, Quot_0_001, Rem_0_0001);
-          if Quot_0_001 /= DT_0_001(0.166)   or
-             Rem_0_0001 /= DT_0_0001(0.0002)
-          then
-             Report.Failed("Incorrect values returned, Case 25");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 26"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_0001);
-          if Quot_0_01 /= DT_0_01(0.0) or Rem_0_0001 /= DT_0_0001(0.1500) then
-             Report.Failed("Incorrect values returned, Case 26");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 27"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_001);
-          if Quot_0_01 /= DT_0_01(0.0) or Rem_0_001 /= DT_0_001(0.150) then
-             Report.Failed("Incorrect values returned, Case 27");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 28"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_01);
-          if Quot_0_01 /= DT_0_01(0.0) or Rem_0_01 /= DT_0_01(0.15) then
-             Report.Failed("Incorrect values returned, Case 28");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 29"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_001);
-          if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_001 /= DT_0_001(0.01) then
-             Report.Failed("Incorrect values returned, Case 29");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 30"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_01);
-          if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_01 /= DT_0_01(0.01) then
-             Report.Failed("Incorrect values returned, Case 30");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_0001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 31"); end if;
-          Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
-          Div(Dd_0_01, Dv_1, Quot_0_0001, Rem_0_0001);
-          if Quot_0_0001 /= DT_0_0001(0.0075) or
-             Rem_0_0001  /= DT_0_0001(0.0)
-          then
-             Report.Failed("Incorrect values returned, Case 31");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_0001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 32"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_0001, Rem_0_0001);
-          if Quot_0_0001 /= DT_0_0001(0.0625) or
-             Rem_0_0001  /= DT_0_0001(0.0)
-          then
-             Report.Failed("Incorrect values returned, Case 32");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_00001);
-       begin
-          if TC_Verbose then Report.Comment("Case 33"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_00001);
-          if Quot_0_001 /= DT_0_001(0.062) or
-             Rem_0_00001  /= DT_0_00001(0.00025)
-          then
-             Report.Failed("Incorrect values returned, Case 33");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 34"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_0001);
-          if Quot_0_001 /= DT_0_001(0.062) or
-             Rem_0_0001  /= DT_0_0001(0.0002)
-          then
-             Report.Failed("Incorrect values returned, Case 34");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 35"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_001);
-          if Quot_0_001 /= DT_0_001(0.062) or Rem_0_001 /= DT_0_001(0.000)
-          then
-             Report.Failed("Incorrect values returned, Case 35");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 36"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_01);
-          if Quot_0_001 /= DT_0_001(0.062) or Rem_0_01 /= DT_0_01(0.00) then
-             Report.Failed("Incorrect values returned, Case 36");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_00001);
-       begin
-          if TC_Verbose then Report.Comment("Case 37"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_00001);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_00001 /= DT_0_00001(0.00125)
-          then
-             Report.Failed("Incorrect values returned, Case 37");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 38"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_0001);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_0001 /= DT_0_0001(0.0012)
-          then
-             Report.Failed("Incorrect values returned, Case 38");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_001);
-       begin
-          if TC_Verbose then Report.Comment("Case 39"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_001);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_001 /= DT_0_001(0.001) then
-             Report.Failed("Incorrect values returned, Case 39");
-          end if;
-       end;
- 
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_01);
-       begin
-          if TC_Verbose then Report.Comment("Case 40"); end if;
-          Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
-          Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_01);
-          if Quot_0_01 /= DT_0_01(0.06) or Rem_0_01 /= DT_0_01(0.0) then
-             Report.Failed("Incorrect values returned, Case 40");
-          end if;
-       end;
- 
-       declare
-          procedure Div is
-             new Ada.Decimal.Divide(DT_0_0001, DT_1, DT_0_0001, DT_0_0001);
-       begin
-          if TC_Verbose then Report.Comment("Case 41"); end if;
-          Dd_0_0001 := (DT_0_0001(6062.0) / DT_0_0001(16384.0));
-          Dv_1 := DT_1(0.0);
-          Div(Dd_0_0001, Dv_1, Quot_0_0001, Rem_0_0001);
-          Report.Failed("Divide by Zero didn't raise Constraint_Error, " &
-                        "Case 41");
-       exception
-          when Constraint_Error =>  null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Unexpected exception raised by Divide by Zero," &
-                           "Case 41");
-       end;
- 
-    exception
-       when others => Report.Failed("Exception raised in Radix_2_Block");
-    end Radix_2_Block;
- 
- 
-    Report.Result;
- 
- end CXF2001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,352 ****
- -- CXF2002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the multiplying operators for a decimal fixed point type
- --      return values that are integral multiples of the small of the type.
- --      Check the case where the operand and result types are the same.
- --
- --      Check that if the mathematical result is between multiples of the
- --      small of the result type, the result is truncated toward zero.
- --      Check that if the attribute 'Round is applied to the mathematical
- --      result, however, the result is rounded to the nearest multiple of
- --      the small (away from zero if the result is midway between two
- --      multiples of the small).
- --    
- -- TEST DESCRIPTION:
- --      Two decimal fixed point types are declared, one with a Machine_Radix
- --      value of 2, and one with a value of 10. For each type, checks are
- --      performed on the following operations, where the operand and result
- --      types are the same:
- --
- --         - Multiplication.
- --         - Multiplication, where the attribute 'Round is applied to the
- --           result.
- --         - Division.
- --         - Division, where the attribute 'Round is applied to the result.
- --
- --      Each operation is performed within a loop, where one operand is
- --      always the same variable. After the loop completes, the cumulative
- --      total contained in this variable is compared with the expected
- --      result.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Information Systems Annex.
- --
- --
- -- CHANGE HISTORY:
- --      27 Mar 96   SAIC    Prerelease version for ACVC 2.1.
- --
- --!
- 
- generic
-    type Decimal_Fixed is delta <> digits <>;
- package CXF2002_0 is
- 
-    procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
-                                     Factor  : in     Decimal_Fixed);
- 
-    procedure Divide_And_Truncate   (Balance : in out Decimal_Fixed;
-                                     Divisor : in     Decimal_Fixed);
- 
-    procedure Multiply_And_Round    (Balance : in out Decimal_Fixed;
-                                     Factor  : in     Decimal_Fixed);
- 
-    procedure Divide_And_Round      (Balance : in out Decimal_Fixed;
-                                     Divisor : in     Decimal_Fixed);
- 
- end CXF2002_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CXF2002_0 is
- 
-    procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
-                                     Factor  : in     Decimal_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-       Interest := Factor * Balance;      -- Fixed-fixed multiplication.
-       Balance  := Balance + Interest;
-    end Multiply_And_Truncate;
- 
- 
-    procedure Divide_And_Truncate (Balance : in out Decimal_Fixed;
-                                   Divisor : in     Decimal_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-       Interest := Balance / Divisor;     -- Fixed-fixed division.
-       Balance  := Balance + Interest;
-    end Divide_And_Truncate;
- 
- 
-    procedure Multiply_And_Round (Balance : in out Decimal_Fixed;
-                                  Factor  : in     Decimal_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-                                          -- Fixed-fixed multiplication.
-       Interest := Decimal_Fixed'Round ( Factor * Balance );
-       Balance  := Balance + Interest;
-    end Multiply_And_Round;
- 
- 
-    procedure Divide_And_Round (Balance : in out Decimal_Fixed;
-                                Divisor : in     Decimal_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-                                          -- Fixed-fixed division.
-       Interest := Decimal_Fixed'Round ( Balance / Divisor );
-       Balance  := Balance + Interest;
-    end Divide_And_Round;
- 
- end CXF2002_0;
- 
- 
-      --==================================================================--
- 
- 
- package CXF2002_1 is
- 
-    type Money_Radix2 is delta 0.01 digits 11;  -- range -999,999,999.99 ..
-    for Money_Radix2'Machine_Radix use 2;       --       +999,999,999.99
- 
- 
-    type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 ..
-    for Money_Radix10'Machine_Radix use 10;     --       +999,999,999.99
- 
- end CXF2002_1;
- 
- 
-      --==================================================================--
- 
- 
- with CXF2002_0;
- with CXF2002_1;
- 
- with Report;
- procedure CXF2002 is
- 
-    Loop_Count : constant := 300;
-    type Loop_Range is range 1 .. Loop_Count;
- 
- begin
- 
-    Report.Test ("CXF2002", "Check decimal multiplication and division, and " &
-                            "'Round, where the operand and result types are " &
-                            "the same");
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_2_SUBTESTS:
-    declare
-       package Radix_2 is new CXF2002_0 (CXF2002_1.Money_Radix2);
-       use type CXF2002_1.Money_Radix2;
-    begin
- 
-       RADIX_2_MULTIPLICATION:
-       declare
-          Rate           : constant CXF2002_1.Money_Radix2 := 0.12;
-          Period         : constant Integer                := 12;
-          Factor         :          CXF2002_1.Money_Radix2 := Rate / Period;
- 
-          Initial        : constant CXF2002_1.Money_Radix2 :=   100_000.00;
-          Trunc_Expected : constant CXF2002_1.Money_Radix2 := 1_978_837.50;
-          Round_Expected : constant CXF2002_1.Money_Radix2 := 1_978_846.75;
- 
-          Balance        : CXF2002_1.Money_Radix2;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Multiply_And_Truncate (Balance, Factor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 2 multiply and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Multiply_And_Round (Balance, Factor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 2 multiply and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_2_MULTIPLICATION;
- 
- 
-       RADIX_2_DIVISION:
-       declare
-          Rate           : constant CXF2002_1.Money_Radix2 := 0.25;
-          Period         : constant Integer                := 12;
-          Factor         :          CXF2002_1.Money_Radix2 := Rate / Period;
-          Divisor        : constant CXF2002_1.Money_Radix2 := 1.0 / Factor;
- 
-          Initial        : constant CXF2002_1.Money_Radix2 :=     5_500.36;
-          Trunc_Expected : constant CXF2002_1.Money_Radix2 := 2_091_332.87;
-          Round_Expected : constant CXF2002_1.Money_Radix2 := 2_091_436.88;
- 
-          Balance        : CXF2002_1.Money_Radix2;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Divide_And_Truncate (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 2 divide and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Divide_And_Round (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 2 divide and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_2_DIVISION;
- 
-    end RADIX_2_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_10_SUBTESTS:
-    declare
-       package Radix_10 is new CXF2002_0 (CXF2002_1.Money_Radix10);
-       use type CXF2002_1.Money_Radix10;
-    begin
- 
-       RADIX_10_MULTIPLICATION:
-       declare
-          Rate           : constant CXF2002_1.Money_Radix10 := 0.37;
-          Period         : constant Integer                 := 12;
-          Factor         :          CXF2002_1.Money_Radix10 := Rate / Period;
- 
-          Initial        : constant CXF2002_1.Money_Radix10 :=       459.33;
-          Trunc_Expected : constant CXF2002_1.Money_Radix10 := 3_259_305.54;
-          Round_Expected : constant CXF2002_1.Money_Radix10 := 3_260_544.11;
- 
-          Balance        : CXF2002_1.Money_Radix10;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Multiply_And_Truncate (Balance, Factor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 10 multiply and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Multiply_And_Round (Balance, Factor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 10 multiply and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_10_MULTIPLICATION;
- 
- 
-       RADIX_10_DIVISION:
-       declare
-          Rate           : constant CXF2002_1.Money_Radix10 := 0.15;
-          Period         : constant Integer                 := 12;
-          Factor         :          CXF2002_1.Money_Radix10 := Rate / Period;
-          Divisor        : constant CXF2002_1.Money_Radix10 := 1.0 / Factor;
- 
-          Initial        : constant CXF2002_1.Money_Radix10 :=    29_842.08;
-          Trunc_Expected : constant CXF2002_1.Money_Radix10 :=   590_519.47;
-          Round_Expected : constant CXF2002_1.Money_Radix10 :=   590_528.98;
- 
-          Balance        : CXF2002_1.Money_Radix10;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Divide_And_Truncate (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 10 divide and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Divide_And_Round (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 10 divide and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_10_DIVISION;
- 
-    end RADIX_10_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Report.Result;
- 
- end CXF2002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,363 ****
- -- CXF2003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the multiplying operators for a decimal fixed point type
- --      return values that are integral multiples of the small of the type.
- --      Check the case where the two operands are of different decimal
- --      fixed point types.
- --
- --      Check that if the mathematical result is between multiples of the
- --      small of the result type, the result is truncated toward zero.
- --      Check that if the attribute 'Round is applied to the mathematical
- --      result, however, the result is rounded to the nearest multiple of
- --      the small (away from zero if the result is midway between two
- --      multiples of the small).
- --    
- -- TEST DESCRIPTION:
- --      Two decimal fixed point types A and B are declared, one with a
- --      Machine_Radix value of 2, and one with a value of 10. A third decimal
- --      fixed point type C is declared with digits and delta values different
- --      from those of A and B. For type A (and B), checks are performed
- --      on the following operations, where one operand type is C, and the
- --      other operand type and the result type is A (or B):
- --
- --         - Multiplication.
- --         - Multiplication, where the attribute 'Round is applied to the
- --           result.
- --         - Division.
- --         - Division, where the attribute 'Round is applied to the result.
- --
- --      Each operation is performed within a loop, where one operand is
- --      always the same variable. After the loop completes, the cumulative
- --      total contained in this variable is compared with the expected
- --      result.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Information Systems Annex.
- --
- --
- -- CHANGE HISTORY:
- --      22 Mar 96   SAIC    Prerelease version for ACVC 2.1.
- --
- --!
- 
- generic
-    type Decimal_Fixed_1 is delta <> digits <>;
-    type Decimal_Fixed_2 is delta <> digits <>;
- package CXF2003_0 is
- 
-    procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed_1;
-                                     Factor  : in     Decimal_Fixed_2);
- 
-    procedure Divide_And_Truncate   (Balance : in out Decimal_Fixed_1;
-                                     Divisor : in     Decimal_Fixed_2);
- 
-    procedure Multiply_And_Round    (Balance : in out Decimal_Fixed_1;
-                                     Factor  : in     Decimal_Fixed_2);
- 
-    procedure Divide_And_Round      (Balance : in out Decimal_Fixed_1;
-                                     Divisor : in     Decimal_Fixed_2);
- 
- end CXF2003_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CXF2003_0 is
- 
-    procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed_1;
-                                     Factor  : in     Decimal_Fixed_2) is
-       Interest : Decimal_Fixed_1;
-    begin
-       Interest := Factor * Balance;      -- Fixed-fixed multiplication.
-       Balance  := Balance + Interest;
-    end Multiply_And_Truncate;
- 
- 
-    procedure Divide_And_Truncate (Balance : in out Decimal_Fixed_1;
-                                   Divisor : in     Decimal_Fixed_2) is
-       Interest : Decimal_Fixed_1;
-    begin
-       Interest := Balance / Divisor;     -- Fixed-fixed division.
-       Balance  := Balance + Interest;
-    end Divide_And_Truncate;
- 
- 
-    procedure Multiply_And_Round (Balance : in out Decimal_Fixed_1;
-                                  Factor  : in     Decimal_Fixed_2) is
-       Interest : Decimal_Fixed_1;
-    begin
-                                          -- Fixed-fixed multiplication.
-       Interest := Decimal_Fixed_1'Round ( Factor * Balance );
-       Balance  := Balance + Interest;
-    end Multiply_And_Round;
- 
- 
-    procedure Divide_And_Round (Balance : in out Decimal_Fixed_1;
-                                Divisor : in     Decimal_Fixed_2) is
-       Interest : Decimal_Fixed_1;
-    begin
-                                          -- Fixed-fixed division.
-       Interest := Decimal_Fixed_1'Round ( Balance / Divisor );
-       Balance  := Balance + Interest;
-    end Divide_And_Round;
- 
- end CXF2003_0;
- 
- 
-      --==================================================================--
- 
- 
- package CXF2003_1 is
- 
-    type Money_Radix2 is delta 0.01 digits 11;    -- range -999,999,999.99 ..
-    for Money_Radix2'Machine_Radix use 2;         --       +999,999,999.99
- 
- 
-    type Money_Radix10 is delta 0.01 digits 11;   -- range -999,999,999.99 ..
-    for Money_Radix10'Machine_Radix use 10;       --       +999,999,999.99
- 
- 
-    type Interest_Rate is delta 0.00001 digits 9; -- range -9999.99999 ..
-                                                  --       +9999.99999
- 
- end CXF2003_1;
- 
- 
-      --==================================================================--
- 
- 
- with CXF2003_0;
- with CXF2003_1;
- 
- with Report;
- procedure CXF2003 is
- 
-    Loop_Count : constant := 1825;
-    type Loop_Range is range 1 .. Loop_Count;
- 
- begin
- 
-    Report.Test ("CXF2003", "Check decimal multiplication and division, and " &
-                            "'Round, where the operand types are different");
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_2_SUBTESTS:
-    declare
-       package Radix_2 is new CXF2003_0 (CXF2003_1.Money_Radix2,
-                                         CXF2003_1.Interest_Rate);
-       use type CXF2003_1.Money_Radix2;
-       use type CXF2003_1.Interest_Rate;
-    begin
- 
-       RADIX_2_MULTIPLICATION:
-       declare
-          Rate           : CXF2003_1.Interest_Rate := 0.198;
-          Period         : Integer                 := 365;
-          Factor         : CXF2003_1.Interest_Rate := Rate / Period;
- 
-          Initial        : constant CXF2003_1.Money_Radix2  := 1_000.00;
-          Trunc_Expected : constant CXF2003_1.Money_Radix2  := 2_662.94;
-          Round_Expected : constant CXF2003_1.Money_Radix2  := 2_678.34;
- 
-          Balance        : CXF2003_1.Money_Radix2;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Multiply_And_Truncate (Balance, Factor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 2 multiply and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Multiply_And_Round (Balance, Factor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 2 multiply and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_2_MULTIPLICATION;
- 
- 
-       RADIX_2_DIVISION:
-       declare
-          Rate           : CXF2003_1.Interest_Rate := 0.129;
-          Period         : Integer                 := 365;
-          Factor         : CXF2003_1.Interest_Rate := Rate / Period;
-          Divisor        : CXF2003_1.Interest_Rate := 1.0 / Factor;
- 
-          Initial        : constant CXF2003_1.Money_Radix2  := 14_626.52;
-          Trunc_Expected : constant CXF2003_1.Money_Radix2  := 27_688.26;
-          Round_Expected : constant CXF2003_1.Money_Radix2  := 27_701.12;
- 
-          Balance        : CXF2003_1.Money_Radix2;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Divide_And_Truncate (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 2 divide and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Divide_And_Round (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 2 divide and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_2_DIVISION;
- 
-    end RADIX_2_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_10_SUBTESTS:
-    declare
-       package Radix_10 is new CXF2003_0 (CXF2003_1.Money_Radix10,
-                                          CXF2003_1.Interest_Rate);
-       use type CXF2003_1.Money_Radix10;
-       use type CXF2003_1.Interest_Rate;
-    begin
- 
-       RADIX_10_MULTIPLICATION:
-       declare
-          Rate           : CXF2003_1.Interest_Rate := 0.063;
-          Period         : Integer                 := 365;
-          Factor         : CXF2003_1.Interest_Rate := Rate / Period;
- 
-          Initial        : constant CXF2003_1.Money_Radix10 := 314_036.10;
-          Trunc_Expected : constant CXF2003_1.Money_Radix10 := 428_249.48;
-          Round_Expected : constant CXF2003_1.Money_Radix10 := 428_260.52;
- 
-          Balance        : CXF2003_1.Money_Radix10;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Multiply_And_Truncate (Balance, Factor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 10 multiply and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Multiply_And_Round (Balance, Factor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 10 multiply and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_10_MULTIPLICATION;
- 
- 
-       RADIX_10_DIVISION:
-       declare
-          Rate           : CXF2003_1.Interest_Rate := 0.273;
-          Period         : Integer                 := 365;
-          Factor         : CXF2003_1.Interest_Rate := Rate / Period;
-          Divisor        : CXF2003_1.Interest_Rate := 1.0 / Factor;
- 
-          Initial        : constant CXF2003_1.Money_Radix10 := 25.72;
-          Trunc_Expected : constant CXF2003_1.Money_Radix10 := 79.05;
-          Round_Expected : constant CXF2003_1.Money_Radix10 := 97.46;
- 
-          Balance        : CXF2003_1.Money_Radix10;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Divide_And_Truncate (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Trunc_Expected then
-             Report.Failed ("Wrong result: Radix 10 divide and truncate");
-          end if;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Divide_And_Round (Balance, Divisor);
-          end loop;
- 
-          if Balance /= Round_Expected then
-             Report.Failed ("Wrong result: Radix 10 divide and round");
-          end if;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_10_DIVISION;
- 
-    end RADIX_10_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Report.Result;
- 
- end CXF2003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,513 ****
- -- CXF2004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the multiplying operators for a decimal fixed point type
- --      return values that are integral multiples of the small of the type.
- --      Check the case where one operand is of an ordinary fixed point type.
- --
- --      Check that if the mathematical result is between multiples of the
- --      small of the result type, the result is truncated toward zero.
- --      Check that if the attribute 'Round is applied to the mathematical
- --      result, however, the result is rounded to the nearest multiple of
- --      the small (away from zero if the result is midway between two
- --      multiples of the small).
- --    
- -- TEST DESCRIPTION:
- --      Two decimal fixed point types A and B are declared, one with a
- --      Machine_Radix value of 2, and one with a value of 10. An ordinary
- --      fixed point type C is declared with a delta value different from
- --      those of A and B (although still a power of 10). For type A (and B),
- --      checks are performed on the following operations, where one operand
- --      type is C, and the other operand type and the result type is A (or B):
- --
- --         - Multiplication.
- --         - Multiplication, where the attribute 'Round is applied to the
- --           result.
- --         - Division.
- --         - Division, where the attribute 'Round is applied to the result.
- --
- --      Each operation is performed within a loop, where one operand is
- --      always the same variable. After the loop completes, the cumulative
- --      total contained in this variable is compared with the expected
- --      result.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Information Systems Annex.
- --
- --
- -- CHANGE HISTORY:
- --      22 Mar 96   SAIC    Prerelease version for ACVC 2.1.
- --      11 Aug 96   SAIC    ACVC 2.1: In RADIX_2_MULTIPLICATION, corrected
- --                          value of Rate. Corrected associated commentary.
- --
- --!
- 
- generic
-    type Decimal_Fixed  is delta <> digits <>;
-    type Ordinary_Fixed is delta <>;
- package CXF2004_0 is
- 
-    procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
-                                     Factor  : in     Ordinary_Fixed);
- 
-    procedure Divide_And_Truncate   (Balance : in out Decimal_Fixed;
-                                     Divisor : in     Ordinary_Fixed);
- 
-    procedure Multiply_And_Round    (Balance : in out Decimal_Fixed;
-                                     Factor  : in     Ordinary_Fixed);
- 
-    procedure Divide_And_Round      (Balance : in out Decimal_Fixed;
-                                     Divisor : in     Ordinary_Fixed);
- 
- end CXF2004_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CXF2004_0 is
- 
-    procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
-                                     Factor  : in     Ordinary_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-       Interest := Factor * Balance;      -- Fixed-fixed multiplication.
-       Balance  := Balance + Interest;
-    end Multiply_And_Truncate;
- 
- 
-    procedure Divide_And_Truncate (Balance : in out Decimal_Fixed;
-                                   Divisor : in     Ordinary_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-       Interest := Balance / Divisor;     -- Fixed-fixed division.
-       Balance  := Balance + Interest;
-    end Divide_And_Truncate;
- 
- 
-    procedure Multiply_And_Round (Balance : in out Decimal_Fixed;
-                                  Factor  : in     Ordinary_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-                                          -- Fixed-fixed multiplication.
-       Interest := Decimal_Fixed'Round ( Factor * Balance );
-       Balance  := Balance + Interest;
-    end Multiply_And_Round;
- 
- 
-    procedure Divide_And_Round (Balance : in out Decimal_Fixed;
-                                Divisor : in     Ordinary_Fixed) is
-       Interest : Decimal_Fixed;
-    begin
-                                          -- Fixed-fixed division.
-       Interest := Decimal_Fixed'Round ( Balance / Divisor );
-       Balance  := Balance + Interest;
-    end Divide_And_Round;
- 
- end CXF2004_0;
- 
- 
-      --==================================================================--
- 
- 
- package CXF2004_1 is
- 
-    type Money_Radix2 is delta 0.01 digits 11;    -- range -999,999,999.99 ..
-    for Money_Radix2'Machine_Radix use 2;         --       +999,999,999.99
- 
- 
-    type Money_Radix10 is delta 0.01 digits 11;   -- range -999,999,999.99 ..
-    for Money_Radix10'Machine_Radix use 10;       --       +999,999,999.99
- 
- 
-    type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0;
-    for Interest_Rate'Small use 0.001;            -- Power of 10.
- 
- end CXF2004_1;
- 
- 
-      --==================================================================--
- 
- 
- with CXF2004_0;
- with CXF2004_1;
- 
- with Report;
- procedure CXF2004 is
- 
-    Loop_Count : constant := 180;
-    type Loop_Range is range 1 .. Loop_Count;
- 
-    type Rounding_Scheme is ( Rounds, Truncates );
-    Machine : Rounding_Scheme;
- 
- begin
- 
-    Report.Test ("CXF2004", "Check decimal multiplication and division, and " &
-                            "'Round, where one operand type is ordinary fixed");
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    if CXF2004_1.Interest_Rate'Machine_Rounds then  -- Determine machine's
-       Machine := Rounds;                           -- rounding scheme.
-    else
-       Machine := Truncates;
-    end if;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_2_SUBTESTS:
-    declare
-       package Radix_2 is new CXF2004_0 (CXF2004_1.Money_Radix2,
-                                         CXF2004_1.Interest_Rate);
-       use type CXF2004_1.Money_Radix2;
-       use type CXF2004_1.Interest_Rate;
-    begin
- 
-       RADIX_2_MULTIPLICATION:
-       declare
-          Rate           : constant CXF2004_1.Interest_Rate := 0.154;
-          Period         : constant Integer                 := 12;
-          Factor         :          CXF2004_1.Interest_Rate := Rate / Period;
- 
-          -- The exact value of Factor is:
-          --
-          --    0.154/12 = 0.01283333...
-          --
-          -- The adjacent multiples of small are 0.012 and 0.013. Since
-          -- Factor is of an ordinary fixed point type, it may contain either
-          -- of these values. However, since "Rate / Period" is a static
-          -- expression, the value Factor contains is determined by the
-          -- value of CXF2004_1.Interest_Rate'Machine_Rounds:
-          --
-          --    If Machine_Rounds = FALSE : Factor = 0.012
-          --    If Machine_Rounds = TRUE  : Factor = 0.013
- 
-          Initial                : constant CXF2004_1.Money_Radix2 :=  1_000.00;
- 
-          Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  8_557.07;
-          Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  8_560.47;
- 
-          Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_222.65;
-          Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_225.81;
- 
-          Balance                : CXF2004_1.Money_Radix2;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Multiply_And_Truncate (Balance, Factor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Trunc_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 2 multiply and truncate");
-                end if;
-             when Truncates =>
-                if Balance /= Trunc_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 2 multiply and truncate");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Multiply_And_Round (Balance, Factor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Round_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 2 multiply and round");
-                end if;
-             when Truncates =>
-                if Balance /= Round_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 2 multiply and round");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_2_MULTIPLICATION;
- 
- 
-       RADIX_2_DIVISION:
-       declare
-          Rate           : constant CXF2004_1.Interest_Rate := 0.210;
-          Period         : constant Integer                 := 12;
-          Factor         : constant CXF2004_1.Interest_Rate := Rate / Period;
-          Divisor        :          CXF2004_1.Interest_Rate := 1.0 / Factor;
- 
-          -- The exact value of Factor is:
-          --
-          --    0.210/12 = 0.0175
-          --
-          -- The adjacent multiples of small are 0.017 and 0.018. Since
-          -- Factor is of an ordinary fixed point type, it may contain either
-          -- of these values. However, since "Rate / Period" is a static
-          -- expression, the value Factor contains is determined by the
-          -- value of CXF2004_1.Interest_Rate'Machine_Rounds:
-          --
-          --    If Machine_Rounds = FALSE : Factor = 0.017
-          --    If Machine_Rounds = TRUE  : Factor = 0.018
-          --
-          -- The exact value of Divisor is one of the following values:
-          --
-          --    1.0/0.017 = 58.82352... (Adjacent smalls 58.823 and 58.824)
-          --    1.0/0.018 = 55.55555... (Adjacent smalls 55.555 and 55.556)
-          --
-          -- Again, since "1.0 / Factor" is static, the value Divisor contains
-          -- is determined by the value of CXF2004_1.Interest_Rate'Rounds:
-          --
-          --    If Machine_Rounds = FALSE : Divisor = 58.823
-          --    If Machine_Rounds = TRUE  : Divisor = 55.556
- 
-          Initial                : constant CXF2004_1.Money_Radix2 :=    260.13;
- 
-          Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  5_401.46;
-          Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  5_406.95;
- 
-          Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 :=  6_446.56;
-          Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 :=  6_453.78;
- 
-          Balance                : CXF2004_1.Money_Radix2;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Divide_And_Truncate (Balance, Divisor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Trunc_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 2 divide and truncate");
-                end if;
-             when Truncates =>
-                if Balance /= Trunc_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 2 divide and truncate");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_2.Divide_And_Round (Balance, Divisor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Round_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 2 divide and round");
-                end if;
-             when Truncates =>
-                if Balance /= Round_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 2 divide and round");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_2_DIVISION;
- 
-    end RADIX_2_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_10_SUBTESTS:
-    declare
-       package Radix_10 is new CXF2004_0 (CXF2004_1.Money_Radix10,
-                                          CXF2004_1.Interest_Rate);
-       use type CXF2004_1.Money_Radix10;
-       use type CXF2004_1.Interest_Rate;
-    begin
- 
-       RADIX_10_MULTIPLICATION:
-       declare
-          Rate           : constant CXF2004_1.Interest_Rate := 0.095;
-          Period         : constant Integer                 := 12;
-          Factor         :          CXF2004_1.Interest_Rate := Rate / Period;
- 
-          -- The exact value of Factor is:
-          --
-          --    0.095/12 = 0.00791666...
-          --
-          -- The adjacent multiples of small are 0.007 and 0.008. Since
-          -- Factor is of an ordinary fixed point type, it may contain either
-          -- of these values. However, since "Rate / Period" is a static
-          -- expression, the value Factor contains can be determined based
-          -- on the value of CXF2004_1.Interest_Rate'Machine_Rounds:
-          --
-          --    If Machine_Rounds = FALSE : Factor = 0.007
-          --    If Machine_Rounds = TRUE  : Factor = 0.008
- 
-          Initial                : constant CXF2004_1.Money_Radix10 := 2_125.00;
- 
-          Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_456.90;
-          Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_458.77;
- 
-          Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_915.74;
-          Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_917.84;
- 
-          Balance                : CXF2004_1.Money_Radix10;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Multiply_And_Truncate (Balance, Factor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Trunc_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 10 multiply and truncate");
-                end if;
-             when Truncates =>
-                if Balance /= Trunc_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 10 multiply and truncate");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Multiply_And_Round (Balance, Factor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Round_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 10 multiply and round");
-                end if;
-             when Truncates =>
-                if Balance /= Round_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 10 multiply and round");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_10_MULTIPLICATION;
- 
- 
-       RADIX_10_DIVISION:
-       declare
-          Rate           : constant CXF2004_1.Interest_Rate := 0.295;
-          Period         : constant Integer                 := 12;
-          Factor         : constant CXF2004_1.Interest_Rate := Rate / Period;
-          Divisor        :          CXF2004_1.Interest_Rate := 1.0 / Factor;
- 
-          -- The exact value of Factor is:
-          --
-          --    0.295/12 = 0.02458333...
-          --
-          -- The adjacent multiples of small are 0.024 and 0.025. Thus, the
-          -- exact value of Divisor is one of the following:
-          --
-          --    1.0/0.024 = 41.66666... (Adjacent smalls 41.666 and 41.667)
-          --    1.0/0.025 = 40.0
-          --
-          -- The value of CXF2004_1.Interest_Rate'Machine_Rounds determines
-          -- what Divisor contains:
-          --
-          --    If Machine_Rounds = FALSE : Divisor = 41.666
-          --    If Machine_Rounds = TRUE  : Divisor = 40.000
- 
-          Initial                : constant CXF2004_1.Money_Radix10 :=    72.19;
- 
-          Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_144.60;
-          Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_157.80;
- 
-          Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_133.28;
-          Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_149.06;
- 
-          Balance                : CXF2004_1.Money_Radix10;
-       begin
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Divide_And_Truncate (Balance, Divisor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Trunc_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 10 divide and truncate");
-                end if;
-             when Truncates =>
-                if Balance /= Trunc_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 10 divide and truncate");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
- 
-          Balance := Initial;
- 
-          for I in Loop_Range loop
-             Radix_10.Divide_And_Round (Balance, Divisor);
-          end loop;
- 
-          case (Machine) is
-             when Rounds    => 
-                if Balance /= Round_Expected_MachRnds then
-                   Report.Failed ("Error (R): Radix 10 divide and round");
-                end if;
-             when Truncates =>
-                if Balance /= Round_Expected_MachTrnc then
-                   Report.Failed ("Error (T): Radix 10 divide and round");
-                end if;
-          end case;
- 
-                        ---=---=---=---=---=---=---
-       end RADIX_10_DIVISION;
- 
-    end RADIX_10_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Report.Result;
- 
- end CXF2004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,293 ****
- -- CXF2005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the multiplying operators for a decimal fixed point type
- --      return values that are integral multiples of the small of the type.
- --      Check the case where one operand is of the predefined type Integer.
- --
- -- TEST DESCRIPTION:
- --      Two decimal fixed point types A and B are declared, one with a
- --      Machine_Radix value of 2, and one with a value of 10. A variable of
- --      each type is multiplied repeatedly by a series of different Integer
- --      values. A cumulative result is kept and compared to an expected
- --      final result. Similar checks are performed for division.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Information Systems Annex.
- --
- --
- -- CHANGE HISTORY:
- --      28 Mar 96   SAIC    Prerelease version for ACVC 2.1.
- --
- --!
- 
- generic
-    type Decimal_Fixed  is delta <> digits <>;
- package CXF2005_0 is
- 
-    function Multiply (Operand  : Decimal_Fixed;
-                       Interval : Integer) return Decimal_Fixed;
- 
-    function Divide   (Operand  : Decimal_Fixed;
-                       Interval : Integer) return Decimal_Fixed;
- 
- end CXF2005_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CXF2005_0 is
- 
-    function Multiply (Operand  : Decimal_Fixed;
-                       Interval : Integer) return Decimal_Fixed is
-    begin
-       return Operand * Interval;  -- Fixed-Integer multiplication.
-    end Multiply;
- 
- 
-    function Divide (Operand  : Decimal_Fixed;
-                     Interval : Integer) return Decimal_Fixed is
-    begin
-       return Operand / Interval;  -- Fixed-Integer division.
-    end Divide;
- 
- end CXF2005_0;
- 
- 
-      --==================================================================--
- 
- 
- package CXF2005_1 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0;
-    for Interest_Rate'Small use 0.001;            -- Power of 10.
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Money_Radix2 is delta 0.01 digits 11;    -- range -999,999,999.99 ..
-    for Money_Radix2'Machine_Radix use 2;         --       +999,999,999.99
- 
-    function Factor (Rate     : Interest_Rate;
-                     Interval : Integer) return Money_Radix2;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Money_Radix10 is delta 0.01 digits 11;   -- range -999,999,999.99 ..
-    for Money_Radix10'Machine_Radix use 10;       --       +999,999,999.99
- 
-    function Factor (Rate   : Interest_Rate;
-                     Interval : Integer) return Money_Radix10;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2005_1;
- 
- 
-      --==================================================================--
- 
- 
- package body CXF2005_1 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Factor (Rate   : Interest_Rate;
-                     Interval : Integer) return Money_Radix2 is
-    begin
-       return Money_Radix2( Rate / Interval );
-    end Factor;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Factor (Rate   : Interest_Rate;
-                     Interval : Integer) return Money_Radix10 is
-    begin
-       return Money_Radix10( Rate / Interval );
-    end Factor;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2005_1;
- 
- 
-      --==================================================================--
- 
- 
- with CXF2005_0;
- with CXF2005_1;
- 
- with Report;
- procedure CXF2005 is
- 
-    Loop_Count : constant := 25_000;
-    type Loop_Range is range 1 .. Loop_Count;
- 
- begin
- 
-    Report.Test ("CXF2005", "Check decimal multiplication and division, " &
-                            "where one operand type is Integer");
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_2_SUBTESTS:
-    declare
-       package Radix_2 is new CXF2005_0 (CXF2005_1.Money_Radix2);
-       use type CXF2005_1.Money_Radix2;
-    begin
- 
-       RADIX_2_MULTIPLICATION:
-       declare
-          Rate           : constant CXF2005_1.Interest_Rate := 0.127;
-          Period         : constant Integer                 := 12;
- 
-          Expected       : constant CXF2005_1.Money_Radix2  := 2_624.88;
-          Balance        :          CXF2005_1.Money_Radix2  := 1_000.00;
- 
-          Operand        :          CXF2005_1.Money_Radix2;
-          Increment      :          CXF2005_1.Money_Radix2;
-          Interval       :          Integer;
-       begin
- 
-          for I in Loop_Range loop
-             Interval  := (Integer(I) mod Period) + 1;  -- Range from 1 to 12.
-             Operand   := CXF2005_1.Factor (Rate, Period);
-             Increment := Radix_2.Multiply (Operand, Interval);
-             Balance   := Balance + Increment;
-          end loop;
- 
-          if Balance /= Expected then
-             Report.Failed ("Error: Radix 2 multiply");
-          end if;
- 
-       end RADIX_2_MULTIPLICATION;
- 
- 
- 
-       RADIX_2_DIVISION:
-       declare
-          Rate           : constant CXF2005_1.Interest_Rate := 0.377;
-          Period         : constant Integer                 := 12;
- 
-          Expected       : constant CXF2005_1.Money_Radix2  :=  36_215.58;
-          Balance        :          CXF2005_1.Money_Radix2  := 456_985.01;
- 
-          Operand        :          CXF2005_1.Money_Radix2;
-          Increment      :          CXF2005_1.Money_Radix2;
-          Interval       :          Integer;
-       begin
- 
-          for I in Loop_Range loop
-             Interval  := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400.
-             Operand   := CXF2005_1.Factor (Rate, Period);
-             Increment := Radix_2.Divide (Balance, Interval);
-             Balance   := Balance - (Operand * Increment);
-          end loop;
- 
-          if Balance /= Expected then
-             Report.Failed ("Error: Radix 2 divide");
-          end if;
- 
-       end RADIX_2_DIVISION;
- 
-    end RADIX_2_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    RADIX_10_SUBTESTS:
-    declare
-       package Radix_10 is new CXF2005_0 (CXF2005_1.Money_Radix10);
-       use type CXF2005_1.Money_Radix10;
-    begin
- 
-       RADIX_10_MULTIPLICATION:
-       declare
-          Rate           : constant CXF2005_1.Interest_Rate := 0.721;
-          Period         : constant Integer                 := 12;
- 
-          Expected       : constant CXF2005_1.Money_Radix10 := 9_875.62;
-          Balance        :          CXF2005_1.Money_Radix10 :=   126.34;
- 
-          Operand        :          CXF2005_1.Money_Radix10;
-          Increment      :          CXF2005_1.Money_Radix10;
-          Interval       :          Integer;
-       begin
- 
-          for I in Loop_Range loop
-             Interval  := (Integer(I) mod Period) + 1;  -- Range from 1 to 12.
-             Operand   := CXF2005_1.Factor (Rate, Period);
-             Increment := Radix_10.Multiply (Operand, Interval);
-             Balance   := Balance + Increment;
-          end loop;
- 
-          if Balance /= Expected then
-             Report.Failed ("Error: Radix 10 multiply");
-          end if;
- 
-       end RADIX_10_MULTIPLICATION;
- 
- 
-       RADIX_10_DIVISION:
-       declare
-          Rate           : constant CXF2005_1.Interest_Rate := 0.547;
-          Period         : constant Integer                 := 12;
- 
-          Expected       : constant CXF2005_1.Money_Radix10 :=  26_116.37;
-          Balance        :          CXF2005_1.Money_Radix10 := 770_082.46;
- 
-          Operand        :          CXF2005_1.Money_Radix10;
-          Increment      :          CXF2005_1.Money_Radix10;
-          Interval       :          Integer;
-       begin
- 
-          for I in Loop_Range loop
-             Interval  := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400.
-             Operand   := CXF2005_1.Factor (Rate, Period);
-             Increment := Radix_10.Divide (Balance, Interval);
-             Balance   := Balance - (Operand * Increment);
-          end loop;
- 
-          if Balance /= Expected then
-             Report.Failed ("Error: Radix 10 divide");
-          end if;
- 
-       end RADIX_10_DIVISION;
- 
-    end RADIX_10_SUBTESTS;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Report.Result;
- 
- end CXF2005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,448 ****
- -- CXF2A01.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the binary adding operators for a decimal fixed point type
- --      return values that are integral multiples of the small of the type.
- --    
- -- TEST DESCRIPTION:
- --      The test verifies that decimal addition and subtraction behave as
- --      expected for types with various digits, delta, and Machine_Radix
- --      values. Types with the minimum values for Decimal.Max_Digits and
- --      Decimal.Max_Scale (18) are included.
- --
- --      Two kinds of checks are performed for each type. In the first check,
- --      the iteration, operation, and operand counts in the foundation and
- --      the operation tables in this test are given values such that, when the
- --      operations loop is complete, each operand will have been added to and
- --      subtracted from the loop's cumulator variable the same number of times,
- --      albeit in varying order. Thus, the result returned by the operations
- --      loop should have the same value as that used to initialize the
- --      cumulator (in this test, zero).
- --
- --      In the second check, the same operation (addition for some types and
- --      subtraction for others) is performed during each loop iteration,
- --      resulting in a cumulative total which is checked against an expected
- --      value.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF2A00.A
- --      -> CXF2A01.A
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Information Systems Annex.
- --
- --
- -- CHANGE HISTORY:
- --      08 Apr 96   SAIC    Prerelease version for ACVC 2.1.
- --
- --!
- 
- package CXF2A01_0 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Micro is delta 10.0**(-18) digits 18; -- range -0.999999999999999999 ..
-    for Micro'Machine_Radix use 10;     --              +0.999999999999999999
- 
-    function Add      (Left, Right : Micro) return Micro;
-    function Subtract (Left, Right : Micro) return Micro;
- 
- 
-    type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
- 
-    Micro_Add : Micro_Optr_Ptr := Add'Access;
-    Micro_Sub : Micro_Optr_Ptr := Subtract'Access;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Money is delta 0.01 digits 11; -- range -999,999,999.99 ..
-    for Money'Machine_Radix use 2;      --       +999,999,999.99
- 
-    function Add      (Left, Right : Money) return Money;
-    function Subtract (Left, Right : Money) return Money;
- 
- 
-    type Money_Optr_Ptr is access function (Left, Right : Money) return Money;
- 
-    Money_Add : Money_Optr_Ptr := Add'Access;
-    Money_Sub : Money_Optr_Ptr := Subtract'Access;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    -- Same as Money, but with Radix 10:
- 
-    type Cash is delta 0.01 digits 11; -- range -999,999,999.99 ..
-    for Cash'Machine_Radix use 10;     --       +999,999,999.99
- 
-    function Add      (Left, Right : Cash) return Cash;
-    function Subtract (Left, Right : Cash) return Cash;
- 
- 
-    type Cash_Optr_Ptr is access function (Left, Right : Cash) return Cash;
- 
-    Cash_Add : Cash_Optr_Ptr := Add'Access;
-    Cash_Sub : Cash_Optr_Ptr := Subtract'Access;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Broad is delta 10.0**(-9) digits 18; -- range -999,999,999.999999999 ..
-    for Broad'Machine_Radix use 10;           --       +999,999,999.999999999
- 
-    function Add      (Left, Right : Broad) return Broad;
-    function Subtract (Left, Right : Broad) return Broad;
- 
- 
-    type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
- 
-    Broad_Add : Broad_Optr_Ptr := Add'Access;
-    Broad_Sub : Broad_Optr_Ptr := Subtract'Access;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2A01_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CXF2A01_0 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Add (Left, Right : Micro) return Micro is
-    begin
-       return (Left + Right); -- Decimal fixed addition.
-    end Add;
- 
-    function Subtract (Left, Right : Micro) return Micro is
-    begin
-       return (Left - Right); -- Decimal fixed subtraction.
-    end Subtract;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Add (Left, Right : Money) return Money is
-    begin
-       return (Left + Right); -- Decimal fixed addition.
-    end Add;
- 
-    function Subtract (Left, Right : Money) return Money is
-    begin
-       return (Left - Right); -- Decimal fixed subtraction.
-    end Subtract;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Add (Left, Right : Cash) return Cash is
-    begin
-       return (Left + Right); -- Decimal fixed addition.
-    end Add;
- 
-    function Subtract (Left, Right : Cash) return Cash is
-    begin
-       return (Left - Right); -- Decimal fixed subtraction.
-    end Subtract;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Add (Left, Right : Broad) return Broad is
-    begin
-       return (Left + Right); -- Decimal fixed addition.
-    end Add;
- 
-    function Subtract (Left, Right : Broad) return Broad is
-    begin
-       return (Left - Right); -- Decimal fixed subtraction.
-    end Subtract;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2A01_0;
- 
- 
-      --==================================================================--
- 
- 
- with FXF2A00;
- package CXF2A01_0.CXF2A01_1 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Micro_Ops   is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr;
-    type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro;
- 
-    Micro_Optr_Table_Cancel : Micro_Ops   := ( Micro_Add, Micro_Sub,
-                                               Micro_Add, Micro_Sub,
-                                               Micro_Add, Micro_Sub );
- 
-    Micro_Optr_Table_Cumul  : Micro_Ops   := ( others => Micro_Add );
- 
-    Micro_Opnd_Table_Cancel : Micro_Opnds := ( 0.001025000235111997,
-                                               0.000000000000000003,
-                                               0.724902903219925400,
-                                               0.000459228020000011,
-                                               0.049832104921096533 );
- 
-    Micro_Opnd_Table_Cumul  : Micro_Opnds := ( 0.000002309540000000,
-                                               0.000000278060000000,
-                                               0.000000000000070000,
-                                               0.000010003000000000,
-                                               0.000000023090000000 );
- 
-    function Test_Micro_Ops is new FXF2A00.Operations_Loop
-      (Decimal_Fixed  => Micro,
-       Operator_Ptr   => Micro_Optr_Ptr,
-       Operator_Table => Micro_Ops,
-       Operand_Table  => Micro_Opnds);
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Money_Ops   is array (FXF2A00.Optr_Range) of Money_Optr_Ptr;
-    type Money_Opnds is array (FXF2A00.Opnd_Range) of Money;
- 
-    Money_Optr_Table_Cancel : Money_Ops   := ( Money_Add, Money_Add,
-                                               Money_Sub, Money_Add,
-                                               Money_Sub, Money_Sub );
- 
-    Money_Optr_Table_Cumul  : Money_Ops   := ( others => Money_Sub );
- 
-    Money_Opnd_Table_Cancel  : Money_Opnds := (       127.10,
-                                                     5600.44,
-                                                        0.05,
-                                                   189662.78,
-                                                226900402.99  );
- 
-    Money_Opnd_Table_Cumul   : Money_Opnds := (        17.99,
-                                                      500.41,
-                                                       92.78,
-                                                        0.38,
-                                                     2942.99  );
- 
-    function Test_Money_Ops is new FXF2A00.Operations_Loop
-      (Decimal_Fixed  => Money,
-       Operator_Ptr   => Money_Optr_Ptr,
-       Operator_Table => Money_Ops,
-       Operand_Table  => Money_Opnds);
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Cash_Ops   is array (FXF2A00.Optr_Range) of Cash_Optr_Ptr;
-    type Cash_Opnds is array (FXF2A00.Opnd_Range) of Cash;
- 
-    Cash_Optr_Table_Cancel : Cash_Ops   := ( Cash_Add, Cash_Add,
-                                             Cash_Sub, Cash_Add,
-                                             Cash_Sub, Cash_Sub );
- 
-    Cash_Optr_Table_Cumul  : Cash_Ops   := ( others => Cash_Add );
- 
-    Cash_Opnd_Table_Cancel : Cash_Opnds := (       127.10,
-                                                  5600.44,
-                                                     0.05,
-                                                189662.78,
-                                             226900402.99  );
- 
-    Cash_Opnd_Table_Cumul  : Cash_Opnds := (         3.33,
-                                                100056.14,
-                                                    22.87,
-                                                  3901.55,
-                                                   111.21  );
- 
-    function Test_Cash_Ops is new FXF2A00.Operations_Loop
-      (Decimal_Fixed  => Cash,
-       Operator_Ptr   => Cash_Optr_Ptr,
-       Operator_Table => Cash_Ops,
-       Operand_Table  => Cash_Opnds);
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Broad_Ops   is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
-    type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
- 
-    Broad_Optr_Table_Cancel : Broad_Ops   := ( Broad_Sub, Broad_Add,
-                                               Broad_Add, Broad_Sub,
-                                               Broad_Sub, Broad_Add );
- 
-    Broad_Optr_Table_Cumul  : Broad_Ops   := ( others => Broad_Sub );
- 
-    Broad_Opnd_Table_Cancel : Broad_Opnds := (         1.000009092,
-                                               732919479.445022293,
-                                                   89662.787000006,
-                                                     660.101010133,
-                                                 1121127.999905594  );
- 
-    Broad_Opnd_Table_Cumul  : Broad_Opnds := (        12.000450223,
-                                                     479.430320780,
-                                                       0.003492096,
-                                                       8.112888400,
-                                                    1002.994937800  );
- 
-    function Test_Broad_Ops is new FXF2A00.Operations_Loop
-      (Decimal_Fixed  => Broad,
-       Operator_Ptr   => Broad_Optr_Ptr,
-       Operator_Table => Broad_Ops,
-       Operand_Table  => Broad_Opnds);
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2A01_0.CXF2A01_1;
- 
- 
-      --==================================================================--
- 
- 
- with CXF2A01_0.CXF2A01_1;
- 
- with Report;
- procedure CXF2A01 is
-    package Data renames CXF2A01_0.CXF2A01_1;
- 
-    use type CXF2A01_0.Micro;
-    use type CXF2A01_0.Money;
-    use type CXF2A01_0.Cash;
-    use type CXF2A01_0.Broad;
- 
-    Micro_Cancel_Expected : constant CXF2A01_0.Micro := 0.0;
-    Money_Cancel_Expected : constant CXF2A01_0.Money := 0.0;
-    Cash_Cancel_Expected  : constant CXF2A01_0.Cash  := 0.0;
-    Broad_Cancel_Expected : constant CXF2A01_0.Broad := 0.0;
- 
-    Micro_Cumul_Expected  : constant CXF2A01_0.Micro :=  0.075682140420000000;
-    Money_Cumul_Expected  : constant CXF2A01_0.Money := -21327300.00;
-    Cash_Cumul_Expected   : constant CXF2A01_0.Cash  :=  624570600.00;
-    Broad_Cumul_Expected  : constant CXF2A01_0.Broad := -9015252.535794000;
- 
-    Micro_Actual   : CXF2A01_0.Micro;
-    Money_Actual   : CXF2A01_0.Money;
-    Cash_Actual    : CXF2A01_0.Cash;
-    Broad_Actual   : CXF2A01_0.Broad;
- begin
- 
-    Report.Test ("CXF2A01", "Check decimal addition and subtraction");
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Micro_Actual := Data.Test_Micro_Ops (0.0,
-                                         Data.Micro_Optr_Table_Cancel,
-                                         Data.Micro_Opnd_Table_Cancel);
- 
-    if Micro_Actual /= Micro_Cancel_Expected then
-       Report.Failed ("Wrong cancellation result for type Micro");
-    end if;
- 
-                        ---=---=---=---=---=---=---
- 
- 
-    Micro_Actual := Data.Test_Micro_Ops (0.0,
-                                         Data.Micro_Optr_Table_Cumul,
-                                         Data.Micro_Opnd_Table_Cumul);
- 
-    if Micro_Actual /= Micro_Cumul_Expected then
-       Report.Failed ("Wrong cumulation result for type Micro");
-    end if;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Money_Actual := Data.Test_Money_Ops (0.0,
-                                         Data.Money_Optr_Table_Cancel,
-                                         Data.Money_Opnd_Table_Cancel);
- 
-    if Money_Actual /= Money_Cancel_Expected then
-       Report.Failed ("Wrong cancellation result for type Money");
-    end if;
- 
-                        ---=---=---=---=---=---=---
- 
- 
-    Money_Actual := Data.Test_Money_Ops (0.0,
-                                         Data.Money_Optr_Table_Cumul,
-                                         Data.Money_Opnd_Table_Cumul);
- 
-    if Money_Actual /= Money_Cumul_Expected then
-       Report.Failed ("Wrong cumulation result for type Money");
-    end if;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Cash_Actual := Data.Test_Cash_Ops (0.0,
-                                       Data.Cash_Optr_Table_Cancel,
-                                       Data.Cash_Opnd_Table_Cancel);
- 
-    if Cash_Actual /= Cash_Cancel_Expected then
-       Report.Failed ("Wrong cancellation result for type Cash");
-    end if;
- 
- 
-                        ---=---=---=---=---=---=---
- 
- 
-    Cash_Actual := Data.Test_Cash_Ops (0.0,
-                                       Data.Cash_Optr_Table_Cumul,
-                                       Data.Cash_Opnd_Table_Cumul);
- 
-    if Cash_Actual /= Cash_Cumul_Expected then
-       Report.Failed ("Wrong cumulation result for type Cash");
-    end if;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Broad_Actual := Data.Test_Broad_Ops (0.0,
-                                         Data.Broad_Optr_Table_Cancel,
-                                         Data.Broad_Opnd_Table_Cancel);
- 
-    if Broad_Actual /= Broad_Cancel_Expected then
-       Report.Failed ("Wrong cancellation result for type Broad");
-    end if;
- 
- 
-                        ---=---=---=---=---=---=---
- 
- 
-    Broad_Actual := Data.Test_Broad_Ops (0.0,
-                                         Data.Broad_Optr_Table_Cumul,
-                                         Data.Broad_Opnd_Table_Cumul);
- 
-    if Broad_Actual /= Broad_Cumul_Expected then
-       Report.Failed ("Wrong cumulation result for type Broad");
-    end if;
- 
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- 
-    Report.Result;
- 
- end CXF2A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,354 ****
- -- CXF2A02.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the multiplying operators for a decimal fixed point type
- --      return values that are integral multiples of the small of the type.
- --      Check the case where the operand and result types are the same.
- --
- --      Check that if the mathematical result is between multiples of the
- --      small of the result type, the result is truncated toward zero.
- --    
- -- TEST DESCRIPTION:
- --      The test verifies that decimal multiplication and division behave as
- --      expected for types with various digits, delta, and Machine_Radix
- --      values.
- --
- --      The iteration, operation, and operand counts in the foundation, and
- --      the operations and operand tables in the test, are given values such
- --      that, when the operations loop is complete, truncation of inexact
- --      results should cause the result returned by the operations loop to be
- --      the same as that used to initialize the loop's cumulator variable (in
- --      this test, one).
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --
- --         FXF2A00.A
- --      -> CXF2A02.A
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Information Systems Annex.
- --
- --
- -- CHANGE HISTORY:
- --      13 Mar 96   SAIC    Prerelease version for ACVC 2.1.
- --      04 Aug 96   SAIC    Updated prologue.
- --
- --!
- 
- package CXF2A02_0 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Micro is delta 10.0**(-5) digits 6; -- range -9.99999 ..
-    for Micro'Machine_Radix use 2;      --            +9.99999
- 
-    function Multiply (Left, Right : Micro) return Micro;
-    function Divide   (Left, Right : Micro) return Micro;
- 
- 
-    type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
- 
-    Micro_Mult : Micro_Optr_Ptr := Multiply'Access;
-    Micro_Div  : Micro_Optr_Ptr := Divide'Access;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Basic is delta 0.01 digits 11; -- range -999,999,999.99 ..
-    for Basic'Machine_Radix use 10;     --       +999,999,999.99
- 
-    function Multiply (Left, Right : Basic) return Basic;
-    function Divide   (Left, Right : Basic) return Basic;
- 
- 
-    type Basic_Optr_Ptr is access function (Left, Right : Basic) return Basic;
- 
-    Basic_Mult : Basic_Optr_Ptr := Multiply'Access;
-    Basic_Div  : Basic_Optr_Ptr := Divide'Access;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Broad is delta 10.0**(-3) digits 10; -- range -9,999,999.999 ..
-    for Broad'Machine_Radix use 2;            --       +9,999,999.999
- 
-    function Multiply (Left, Right : Broad) return Broad;
-    function Divide   (Left, Right : Broad) return Broad;
- 
- 
-    type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
- 
-    Broad_Mult : Broad_Optr_Ptr := Multiply'Access;
-    Broad_Div  : Broad_Optr_Ptr := Divide'Access;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2A02_0;
- 
- 
-      --==================================================================--
- 
- 
- package body CXF2A02_0 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Multiply (Left, Right : Micro) return Micro is
-    begin
-       return (Left * Right); -- Decimal fixed multiplication.
-    end Multiply;
- 
-    function Divide (Left, Right : Micro) return Micro is
-    begin
-       return (Left / Right); -- Decimal fixed division.
-    end Divide;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Multiply (Left, Right : Basic) return Basic is
-    begin
-       return (Left * Right); -- Decimal fixed multiplication.
-    end Multiply;
- 
-    function Divide (Left, Right : Basic) return Basic is
-    begin
-       return (Left / Right); -- Decimal fixed division.
-    end Divide;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    function Multiply (Left, Right : Broad) return Broad is
-    begin
-       return (Left * Right); -- Decimal fixed multiplication.
-    end Multiply;
- 
-    function Divide (Left, Right : Broad) return Broad is
-    begin
-       return (Left / Right); -- Decimal fixed division.
-    end Divide;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2A02_0;
- 
- 
-      --==================================================================--
- 
- 
- with FXF2A00;
- package CXF2A02_0.CXF2A02_1 is
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Micro_Ops   is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr;
-    type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro;
- 
-    Micro_Mult_Operator_Table : Micro_Ops   := ( Micro_Mult, Micro_Mult,
-                                                 Micro_Mult, Micro_Mult,
-                                                 Micro_Mult, Micro_Mult );
- 
-    Micro_Div_Operator_Table  : Micro_Ops   := ( Micro_Div, Micro_Div,
-                                                 Micro_Div, Micro_Div,
-                                                 Micro_Div, Micro_Div   );
- 
-    Micro_Mult_Operand_Table  : Micro_Opnds := ( 2.35119,
-                                                 0.05892,
-                                                 9.58122,
-                                                 0.80613,
-                                                 0.93462 );
- 
-    Micro_Div_Operand_Table   : Micro_Opnds := ( 0.58739,
-                                                 4.90012,
-                                                 0.08765,
-                                                 0.71577,
-                                                 5.53768 );
- 
-    function Test_Micro_Ops is new FXF2A00.Operations_Loop
-      (Decimal_Fixed  => Micro,
-       Operator_Ptr   => Micro_Optr_Ptr,
-       Operator_Table => Micro_Ops,
-       Operand_Table  => Micro_Opnds);
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Basic_Ops   is array (FXF2A00.Optr_Range) of Basic_Optr_Ptr;
-    type Basic_Opnds is array (FXF2A00.Opnd_Range) of Basic;
- 
-    Basic_Mult_Operator_Table : Basic_Ops   := ( Basic_Mult, Basic_Mult,
-                                                 Basic_Mult, Basic_Mult,
-                                                 Basic_Mult, Basic_Mult );
- 
-    Basic_Div_Operator_Table  : Basic_Ops   := ( Basic_Div, Basic_Div,
-                                                 Basic_Div, Basic_Div,
-                                                 Basic_Div, Basic_Div   );
- 
-    Basic_Mult_Operand_Table  : Basic_Opnds := (       127.10,
-                                                         0.02,
-                                                         0.87,
-                                                        45.67,
-                                                         0.01  );
- 
-    Basic_Div_Operand_Table   : Basic_Opnds := (         0.03,
-                                                         0.08,
-                                                        23.57,
-                                                         0.11,
-                                                       159.11  );
- 
-    function Test_Basic_Ops is new FXF2A00.Operations_Loop
-      (Decimal_Fixed  => Basic,
-       Operator_Ptr   => Basic_Optr_Ptr,
-       Operator_Table => Basic_Ops,
-       Operand_Table  => Basic_Opnds);
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    type Broad_Ops   is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
-    type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
- 
-    Broad_Mult_Operator_Table : Broad_Ops   := ( Broad_Mult, Broad_Mult,
-                                                 Broad_Mult, Broad_Mult,
-                                                 Broad_Mult, Broad_Mult );
- 
-    Broad_Div_Operator_Table  : Broad_Ops   := ( Broad_Div,  Broad_Div,
-                                                 Broad_Div,  Broad_Div,
-                                                 Broad_Div,  Broad_Div  );
- 
-    Broad_Mult_Operand_Table  : Broad_Opnds := (     589.720,
-                                                       0.106,
-                                                      21.018,
-                                                       0.002,
-                                                       0.381  );
- 
-    Broad_Div_Operand_Table   : Broad_Opnds := (       0.008,
-                                                       0.793,
-                                                       9.092,
-                                                     214.300,
-                                                       0.080  );
- 
-    function Test_Broad_Ops is new FXF2A00.Operations_Loop
-      (Decimal_Fixed  => Broad,
-       Operator_Ptr   => Broad_Optr_Ptr,
-       Operator_Table => Broad_Ops,
-       Operand_Table  => Broad_Opnds);
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
- end CXF2A02_0.CXF2A02_1;
- 
- 
-      --==================================================================--
- 
- 
- with CXF2A02_0.CXF2A02_1;
- 
- with Report;
- procedure CXF2A02 is
-    package Data renames CXF2A02_0.CXF2A02_1;
- 
-    use type CXF2A02_0.Micro;
-    use type CXF2A02_0.Basic;
-    use type CXF2A02_0.Broad;
- 
-    Micro_Expected : constant CXF2A02_0.Micro := 1.0;
-    Basic_Expected : constant CXF2A02_0.Basic := 1.0;
-    Broad_Expected : constant CXF2A02_0.Broad := 1.0;
- 
-    Micro_Actual   : CXF2A02_0.Micro;
-    Basic_Actual   : CXF2A02_0.Basic;
-    Broad_Actual   : CXF2A02_0.Broad;
- begin
- 
-    Report.Test ("CXF2A02", "Check decimal multiplication and division, " &
-                 "where the operand and result types are the same");
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    Micro_Actual := 0.0;
-    Micro_Actual := Data.Test_Micro_Ops (1.0,
-                                         Data.Micro_Mult_Operator_Table,
-                                         Data.Micro_Mult_Operand_Table);
- 
-    if Micro_Actual /= Micro_Expected then
-       Report.Failed ("Wrong result for type Micro multiplication");
-    end if;
- 
- 
-    Micro_Actual := 0.0;
-    Micro_Actual := Data.Test_Micro_Ops (1.0,
-                                         Data.Micro_Div_Operator_Table,
-                                         Data.Micro_Div_Operand_Table);
- 
-    if Micro_Actual /= Micro_Expected then
-       Report.Failed ("Wrong result for type Micro division");
-    end if;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    Basic_Actual := 0.0;
-    Basic_Actual := Data.Test_Basic_Ops (1.0,
-                                         Data.Basic_Mult_Operator_Table,
-                                         Data.Basic_Mult_Operand_Table);
- 
-    if Basic_Actual /= Basic_Expected then
-       Report.Failed ("Wrong result for type Basic multiplication");
-    end if;
- 
- 
-    Basic_Actual := 0.0;
-    Basic_Actual := Data.Test_Basic_Ops (1.0,
-                                         Data.Basic_Div_Operator_Table,
-                                         Data.Basic_Div_Operand_Table);
- 
-    if Basic_Actual /= Basic_Expected then
-       Report.Failed ("Wrong result for type Basic division");
-    end if;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    Broad_Actual := 0.0;
-    Broad_Actual := Data.Test_Broad_Ops (1.0,
-                                         Data.Broad_Mult_Operator_Table,
-                                         Data.Broad_Mult_Operand_Table);
- 
-    if Broad_Actual /= Broad_Expected then
-       Report.Failed ("Wrong result for type Broad multiplication");
-    end if;
- 
- 
-    Broad_Actual := 0.0;
-    Broad_Actual := Data.Test_Broad_Ops (1.0,
-                                         Data.Broad_Div_Operator_Table,
-                                         Data.Broad_Div_Operand_Table);
- 
-    if Broad_Actual /= Broad_Expected then
-       Report.Failed ("Wrong result for type Broad division");
-    end if;
- 
-                ---=---=---=---=---=---=---=---=---=---=---
- 
-    Report.Result;
- 
- end CXF2A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,192 ****
- -- CXF3001.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the edited output string value returned by Function Image
- --      is correct.
- --
- -- TEST DESCRIPTION:
- --      This test is structured using tables of data, consisting of
- --      numerical values, picture strings, and expected image
- --      result strings.  
- --
- --      Each picture string is checked for validity, and an invalid picture 
- --      string will cause immediate test failure on its first pass through
- --      the evaluation loop.  Inside the evaluation loop, each decimal data 
- --      item is combined with each of the picture strings as parameters to a
- --      call to Image, and the result of each call is compared to an 
- --      expected edited output result string.
- --      
- --       
- -- CHANGE HISTORY:
- --      24 Feb 95   SAIC    Initial prerelease version.
- --      23 Jun 95   SAIC    Corrected call to functions Valid and To_Picture.
- --      22 Aug 95   SAIC    Test name changed to CXF3001 (from CXF3301) to
- --                          conform to naming conventions.
- --      24 Feb 97   CTA.PWB Corrected picture strings and expected results.
- --!
- 
- with Ada.Text_IO.Editing;
- with Report;
- 
- procedure CXF3001 is
- begin
- 
-    Report.Test ("CXF3001", "Check that the string value returned by " &
-                            "Function Image is correct");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Text_IO;
- 
-       Number_Of_Decimal_Items    : constant := 5;
-       Number_Of_Picture_Strings  : constant := 4;
-       Number_Of_Expected_Results : constant := Number_Of_Decimal_Items *
-                                                Number_Of_Picture_Strings;
- 
-       type String_Pointer_Type is access String;
- 
-       -- Define a decimal data type, and instantiate the Decimal_Output 
-       -- generic package for the data type.
- 
-       type Decimal_Data_Type is delta 0.01 digits 16;
-       package Ed_Out is new Editing.Decimal_Output (Decimal_Data_Type);
- 
-       -- Define types for the arrays of data that will hold the decimal data 
-       -- values, picture strings, and expected edited output results.
- 
-       type Decimal_Data_Array_Type is 
-         array (Integer range <>) of Decimal_Data_Type;
- 
-       type Picture_String_Array_Type is 
-         array (Integer range <>) of String_Pointer_Type;
- 
-       type Edited_Output_Results_Array_Type is 
-         array (Integer range <>) of String_Pointer_Type;
- 
-       -- Define the data arrays for this test.
- 
-       Decimal_Data : 
-         Decimal_Data_Array_Type(1..Number_Of_Decimal_Items) :=
-           ( 1 =>  5678.90,
-             2 => -6789.01,
-             3 =>     0.00,
-             4 =>     0.20,
-             5 =>     3.45
-           );
- 
-       Picture_Strings : 
-         Picture_String_Array_Type(1..Number_Of_Picture_Strings) :=
-           ( 1 => new String'("-$$_$$9.99"),
-             2 => new String'("-$$_$$$.$$"),
-             3 => new String'("-ZZZZ.ZZ"),
-             4 => new String'("-$$$_999.99")
-           );
- 
-       Edited_Output :
-         Edited_Output_Results_Array_Type(1..Number_Of_Expected_Results) := 
-           ( 1 => new String'(" $5,678.90"),    
-             2 => new String'(" $5,678.90"),
-             3 => new String'(" 5678.90"),     
-             4 => new String'("  $5,678.90"),  
- 
-             5 => new String'("-$6,789.01"),
-             6 => new String'("-$6,789.01"),
-             7 => new String'("-6789.01"),
-             8 => new String'("- $6,789.01"),
- 
-             9 => new String'("     $0.00"),
-            10 => new String'("          "),    
-            11 => new String'("        "),     
-            12 => new String'("   $ 000.00"),  
- 
-            13 => new String'("     $0.20"),
-            14 => new String'("      $.20"),    
-            15 => new String'("     .20"),     
-            16 => new String'("   $ 000.20"),
- 
-            17 => new String'("     $3.45"),
-            18 => new String'("     $3.45"),
-            19 => new String'("    3.45"),
-            20 => new String'("   $ 003.45")
-           );
- 
-       TC_Picture    : Editing.Picture;
-       TC_Loop_Count : Natural := 0;
- 
-    begin
- 
-       -- Compare string result of Image with expected edited output string.  
- 
-       Evaluate_Edited_Output:
-       for i in 1..Number_Of_Decimal_Items loop
-          for j in 1..Number_Of_Picture_Strings loop
- 
-             TC_Loop_Count := TC_Loop_Count + 1;
- 
-             -- Check on the validity of the picture strings prior to
-             -- processing.
- 
-             if Editing.Valid(Picture_Strings(j).all) then
- 
-                -- Create the picture object from the picture string.
-                TC_Picture := Editing.To_Picture(Picture_Strings(j).all);
- 
-                -- Compare actual edited output result of Function Image with
-                -- the expected result.
- 
-                if Ed_Out.Image(Decimal_Data(i), TC_Picture) /=
-                   Edited_Output(TC_Loop_Count).all
-                then
-                   Report.Failed("Incorrect result from Function Image, " &
-                                 "when used with decimal data item # "    &
-                                 Integer'Image(i)                         &
-                                 " and picture string # "                  &
-                                 Integer'Image(j));
-                end if;
- 
-             else
-                Report.Failed("Picture String # " & Integer'Image(j) &
-                              "reported as being invalid");
-                -- Immediate test failure if a string is invalid.
-                exit Evaluate_Edited_Output;
-             end if;
- 
-          end loop;
-       end loop Evaluate_Edited_Output;
- 
-    exception
-       when Editing.Picture_Error =>
-          Report.Failed ("Picture_Error raised in Test_Block");
-       when Layout_Error          =>
-          Report.Failed ("Layout_Error raised in Test_Block");
-       when others                => 
-          Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,231 ****
- -- CXF3002.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the functionality contained in package
- --      Ada.Wide_Text_IO.Editing is available and produces correct results.
- --
- -- TEST DESCRIPTION:
- --      This test is designed to validate the procedures and functions that
- --      are found in package Ada.Wide_Text_IO.Editing, the "wide" 
- --      complementary package to Ada.Text_IO.Editing.  The test is similar 
- --      to CXF3301, which tested a large portion of the Ada.Text_IO.Editing
- --      package.  Additional testing has been added here to cover the balance
- --      of the Wide_Text_IO.Editing child package.
- 
- --      This test is structured using tables of data, consisting of
- --      numerical values, picture strings, and expected image
- --      result strings.  
- --
- --      Each picture string is checked for validity, and an invalid picture 
- --      string will cause immediate test failure on its first pass through
- --      the evaluation loop.  Inside the evaluation loop, each decimal data 
- --      item is combined with each of the picture strings as parameters to a
- --      call to Image, and the result of each call is compared to an 
- --      expected edited output result string.
- --
- --      Note: Each of the functions Valid, To_Picture, and Pic_String has
- --            String (rather than Wide_String) as its parameter or result
- --            subtype, since a picture String is not localizable.
- --      
- --       
- -- CHANGE HISTORY:
- --      22 Jun 95   SAIC    Initial prerelease version.
- --      22 Aug 95   SAIC    Test name changed to CXF3002 (from CXF3401) to 
- --                          conform with naming conventions.
- --      24 Feb 97   PWB.CTA Corrected picture strings and expected values.
- --!
- 
- with Ada.Wide_Text_IO.Editing;
- with Report;
- 
- procedure CXF3002 is
- begin
- 
-    Report.Test ("CXF3002", "Check that the functionality contained " &
-                            "in package Ada.Wide_Text_IO.Editing is " &
-                            "available and produces correct results");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Wide_Text_IO;
- 
-       Number_Of_Decimal_Items    : constant := 5;
-       Number_Of_Picture_Strings  : constant := 4;
-       Number_Of_Expected_Results : constant := Number_Of_Decimal_Items *
-                                                Number_Of_Picture_Strings;
- 
-       Def_Cur   : constant Wide_String    := "$";
-       Def_Fill  : constant Wide_Character := '*';
-       Def_Sep   : constant Wide_Character := Editing.Default_Separator;
-       Def_Radix : constant Wide_Character := Editing.Default_Radix_Mark;
- 
-       type String_Pointer_Type      is access String;
-       type Wide_String_Pointer_Type is access Wide_String;
- 
-       -- Define a decimal data type, and instantiate the Decimal_Output 
-       -- generic package for the data type.
- 
-       type Decimal_Data_Type is delta 0.01 digits 16;
- 
-       package Wide_Ed_Out is 
-         new Editing.Decimal_Output(Num                => Decimal_Data_Type,
-                                    Default_Currency   => Def_Cur,
-                                    Default_Fill       => Def_Fill,
-                                    Default_Separator  => Def_Sep,
-                                    Default_Radix_Mark => Def_Radix);
- 
-       -- Define types for the arrays of data that will hold the decimal data 
-       -- values, picture strings, and expected edited output results.
- 
-       type Decimal_Data_Array_Type is 
-         array (Integer range <>) of Decimal_Data_Type;
- 
-       type Picture_String_Array_Type is 
-         array (Integer range <>) of String_Pointer_Type;
- 
-       type Edited_Output_Results_Array_Type is 
-         array (Integer range <>) of Wide_String_Pointer_Type;
- 
-       -- Define the data arrays for this test.
- 
-       Decimal_Data : 
-         Decimal_Data_Array_Type(1..Number_Of_Decimal_Items) :=
-           ( 1 =>  5678.90,
-             2 => -6789.01,
-             3 =>     0.00,
-             4 =>     0.20,
-             5 =>     3.45
-           );
- 
-       Picture_Strings : 
-         Picture_String_Array_Type(1..Number_Of_Picture_Strings) :=
-           ( 1 => new String'("-$$_$$9.99"),
-             2 => new String'("-$$_$$$.$$"),
-             3 => new String'("-ZZZZ.ZZ"),
-             4 => new String'("-$$$_999.99")
-           );
- 
- 
-       Edited_Output :
-         Edited_Output_Results_Array_Type(1..Number_Of_Expected_Results) := 
-           ( 1 => new Wide_String'(" $5,678.90"),    
-             2 => new Wide_String'(" $5,678.90"),    
-             3 => new Wide_String'(" 5678.90"),     
-             4 => new Wide_String'("  $5,678.90"),  
- 
-             5 => new Wide_String'("-$6,789.01"),
-             6 => new Wide_String'("-$6,789.01"),
-             7 => new Wide_String'("-6789.01"),
-             8 => new Wide_String'("- $6,789.01"),
- 
-             9 => new Wide_String'("     $0.00"),
-            10 => new Wide_String'("          "),    
-            11 => new Wide_String'("        "),     
-            12 => new Wide_String'("   $ 000.00"),  
- 
-            13 => new Wide_String'("     $0.20"),
-            14 => new Wide_String'("      $.20"),    
-            15 => new Wide_String'("     .20"),     
-            16 => new Wide_String'("   $ 000.20"),
- 
-            17 => new Wide_String'("     $3.45"),
-            18 => new Wide_String'("     $3.45"),
-            19 => new Wide_String'("    3.45"),
-            20 => new Wide_String'("   $ 003.45")
-           );
- 
-       TC_Picture    : Editing.Picture;
-       TC_Loop_Count : Natural := 0;
- 
-    begin
- 
-       -- Compare string result of Image with expected edited output wide 
-       -- string.  
- 
-       Evaluate_Edited_Output:
-       for i in 1..Number_Of_Decimal_Items loop
-          for j in 1..Number_Of_Picture_Strings loop
- 
-             TC_Loop_Count := TC_Loop_Count + 1;
- 
-             -- Check on the validity of the picture strings prior to
-             -- processing.
- 
-             if Editing.Valid(Picture_Strings(j).all) then
- 
-                -- Create the picture object from the picture string.
-                TC_Picture := Editing.To_Picture(Picture_Strings(j).all);
- 
-                -- Check results of function Decimal_Output.Valid.
-                if not Wide_Ed_Out.Valid(Decimal_Data(i), TC_Picture) then
-                   Report.Failed("Incorrect result from function Valid "    &
-                                 "when examining the picture string that "  &
-                                 "was produced from string "                &
-                                 Integer'Image(j) & " in conjunction with " &
-                                 "decimal data item # " & Integer'Image(i));
-                end if;
- 
-                -- Check results of function Editing.Pic_String.
-                if Editing.Pic_String(TC_Picture) /= Picture_Strings(j).all then
-                   Report.Failed("Incorrect result from To_Picture/"  &
-                                 "Pic_String conversion for picture " &
-                                 "string # " & Integer'Image(j));
-                end if;
- 
-                -- Compare actual edited output result of Function Image with
-                -- the expected result.
- 
-                if Wide_Ed_Out.Image(Decimal_Data(i), TC_Picture) /=
-                   Edited_Output(TC_Loop_Count).all
-                then
-                   Report.Failed("Incorrect result from Function Image, " &
-                                 "when used with decimal data item # "    &
-                                 Integer'Image(i)                         &
-                                 " and picture string # "                  &
-                                 Integer'Image(j));
-                end if;
- 
-             else
-                Report.Failed("Picture String # " & Integer'Image(j) &
-                              "reported as being invalid");
-             end if;
- 
-          end loop;
-       end loop Evaluate_Edited_Output;
- 
-    exception
-       when Editing.Picture_Error =>
-          Report.Failed ("Picture_Error raised in Test_Block");
-       when Layout_Error          =>
-          Report.Failed ("Layout_Error raised in Test_Block");
-       when others                => 
-          Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,292 ****
- -- CXF3003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that statically identifiable picture strings can be used to
- --      produce correctly formatted edited output.
- --      
- -- TEST DESCRIPTION:
- --      This test defines several picture strings that are statically
- --      identifiable, (i.e.,  Pic : Picture := To_Picture("..."); ).
- --      These picture strings are used in conjunction with decimal data
- --      as parameters in calls to functions Valid and Image.  These
- --      functions are created by an instantiation of the generic package
- --      Ada.Text_IO.Editing.Decimal_Output.
- --
- --       
- -- CHANGE HISTORY:
- --      04 Apr 96   SAIC    Initial release for 2.1.
- --      13 Feb 97   PWB.CTA corrected incorrect picture strings.
- --!
- 
- with Report;
- with Ada.Text_IO.Editing;
- with Ada.Exceptions;
- 
- procedure CXF3003 is
- begin
- 
-    Report.Test ("CXF3003", "Check that statically identifiable "     &
-                            "picture strings can be used to produce " &
-                            "correctly formatted edited output");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Ada.Text_IO.Editing;
- 
-       Def_Cur   : constant String    := "$";
-       Def_Fill  : constant Character := '*';
-       Def_Sep   : constant Character := Default_Separator;
-       Def_Radix : constant Character := 
-                     Ada.Text_IO.Editing.Default_Radix_Mark;
- 
-       type Str_Ptr is access String;
-       type Edited_Output_Array_Type is array (Integer range <>) of Str_Ptr;
- 
-       -- Define a decimal data type, and instantiate the Decimal_Output 
-       -- generic package for the data type.
- 
-       type Decimal_Data_Type is delta 0.01 digits 16;
- 
-       package Image_IO is 
-         new Decimal_Output(Num                => Decimal_Data_Type,
-                            Default_Currency   => Def_Cur,
-                            Default_Fill       => '*',
-                            Default_Separator  => Default_Separator,
-                            Default_Radix_Mark => Def_Radix);
- 
- 
-       type Decimal_Data_Array_Type is 
-         array (Integer range <>) of Decimal_Data_Type;
- 
-       Decimal_Data : Decimal_Data_Array_Type(1..5) :=
-           (1 =>  1357.99,
-            2 => -9029.01,
-            3 =>     0.00,
-            4 =>     0.20,
-            5 =>     3.45);
- 
-       -- Statically identifiable picture strings.
- 
-       Picture_1  : Picture := To_Picture("-$$_$$9.99"); 
-       Picture_2  : Picture := To_Picture("-$$_$$$.$$"); 
-       Picture_3  : Picture := To_Picture("-ZZZZ.ZZ");
-       Picture_5  : Picture := To_Picture("-$$$_999.99");
-       Picture_6  : Picture := To_Picture("-###**_***_**9.99");
-       Picture_7  : Picture := To_Picture("-$**_***_**9.99");
-       Picture_8  : Picture := To_Picture("-$$$$$$.$$");
-       Picture_9  : Picture := To_Picture("-$$$$$$.$$");
-       Picture_10 : Picture := To_Picture("+BBBZZ_ZZZ_ZZZ.ZZ");
-       Picture_11 : Picture := To_Picture("--_---_---_--9");
-       Picture_12 : Picture := To_Picture("-$_$$$_$$$_$$9.99");
-       Picture_14 : Picture := To_Picture("$_$$9.99");
-       Picture_15 : Picture := To_Picture("$$9.99");
- 
- 
-       Picture_1_Output : Edited_Output_Array_Type(1..5) :=
-           ( 1 => new String'(" $1,357.99"),      
-             2 => new String'("-$9,029.01"),    
-             3 => new String'("     $0.00"),
-             4 => new String'("     $0.20"),
-             5 => new String'("     $3.45"));
- 
-       Picture_2_Output : Edited_Output_Array_Type(1..5) :=
-            (1 => new String'(" $1,357.99"),      
-             2 => new String'("-$9,029.01"),    
-             3 => new String'("          "),    
-             4 => new String'("      $.20"),    
-             5 => new String'("     $3.45"));
- 
-       Picture_3_Output : Edited_Output_Array_Type(1..5) :=
-            (1 => new String'(" 1357.99"),       
-             2 => new String'("-9029.01"),
-             3 => new String'("        "),     
-             4 => new String'("     .20"),     
-             5 => new String'("    3.45"));
- 
-       Picture_5_Output : Edited_Output_Array_Type(1..5) := 
-            (1 => new String'("  $1,357.99"),
-             2 => new String'("- $9,029.01"),
-             3 => new String'("   $ 000.00"),  
-             4 => new String'("   $ 000.20"),
-             5 => new String'("   $ 003.45"));
- 
-    begin
- 
-       -- Check the results of function Valid, using the first five decimal
-       -- data items and picture strings.
- 
-       if not Image_IO.Valid(Decimal_Data(1), Picture_1) then
-          Report.Failed("Picture string 1 not valid");
-       elsif not Image_IO.Valid(Decimal_Data(2), Picture_2) then
-          Report.Failed("Picture string 2 not valid");
-       elsif not Image_IO.Valid(Decimal_Data(3), Picture_3) then
-          Report.Failed("Picture string 3 not valid");
-       elsif not Image_IO.Valid(Decimal_Data(5), Picture_5) then
-          Report.Failed("Picture string 5 not valid");
-       end if;
- 
- 
-       -- Check the results of function Image, using the picture strings
-       -- constructed above, with a variety of named vs. positional
-       -- parameter notation and defaulted parameters.
- 
-       for i in 1..5 loop
-          if Image_IO.Image(Item => Decimal_Data(i), Pic => Picture_1) /=
-             Picture_1_Output(i).all
-          then
-             Report.Failed("Incorrect result from function Image with "    &
-                           "decimal data item #" & Integer'Image(i) & ", " &
-                           "combined with Picture_1 picture string."       &
-                           "Expected: " & Picture_1_Output(i).all & ", "   &
-                           "Found: " &
-                           Image_IO.Image(Decimal_Data(i),Picture_1));
-          end if;
- 
-          if Image_IO.Image(Decimal_Data(i), Pic => Picture_2) /=
-             Picture_2_Output(i).all
-          then
-             Report.Failed("Incorrect result from function Image with "    &
-                           "decimal data item #" & Integer'Image(i) & ", " &
-                           "combined with Picture_2 picture string."       &
-                           "Expected: " & Picture_2_Output(i).all & ", "   &
-                           "Found: " &
-                           Image_IO.Image(Decimal_Data(i),Picture_2));
-          end if;
- 
-          if Image_IO.Image(Decimal_Data(i), Picture_3) /=
-             Picture_3_Output(i).all
-          then
-             Report.Failed("Incorrect result from function Image with "    &
-                           "decimal data item #" & Integer'Image(i) & ", " &
-                           "combined with Picture_3 picture string."       &
-                           "Expected: " & Picture_3_Output(i).all & ", "   &
-                           "Found: " &
-                           Image_IO.Image(Decimal_Data(i),Picture_3));
-          end if;
- 
-          if Image_IO.Image(Decimal_Data(i), Picture_5) /=
-             Picture_5_Output(i).all
-          then
-             Report.Failed("Incorrect result from function Image with "    &
-                           "decimal data item #" & Integer'Image(i) & ", " &
-                           "combined with Picture_5 picture string."       &
-                           "Expected: " & Picture_5_Output(i).all & ", "   &
-                           "Found: " &
-                           Image_IO.Image(Decimal_Data(i),Picture_5));
-          end if;
-       end loop;
- 
- 
-       if Image_IO.Image(Item       => 123456.78, 
-                         Pic        => Picture_6,
-                         Currency   => "$",
-                         Fill       => Def_Fill,
-                         Separator  => Def_Sep,
-                         Radix_Mark => Def_Radix) /= "   $***123,456.78"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_6");
-       end if;
- 
-       if Image_IO.Image(123456.78, 
-                         Pic        => Picture_7,
-                         Currency   => Def_Cur,
-                         Fill       => '*',
-                         Separator  => Def_Sep,
-                         Radix_Mark => Def_Radix) /= " $***123,456.78"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_7");
-       end if;
- 
-       if Image_IO.Image(0.0, 
-                         Picture_8,
-                         Currency   => "$",
-                         Fill       => '*',
-                         Separator  => Def_Sep,
-                         Radix_Mark => Def_Radix) /= "          "
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_8");
-       end if;
- 
-       if Image_IO.Image(0.20, 
-                         Picture_9,
-                         Def_Cur,
-                         Fill       => Def_Fill,
-                         Separator  => Default_Separator,
-                         Radix_Mark => Default_Radix_Mark) /= "      $.20"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_9");
-       end if;
- 
-       if Image_IO.Image(123456.00,
-                         Picture_10,
-                         "$",
-                         '*',
-                         Separator  => Def_Sep,
-                         Radix_Mark => Def_Radix) /= "+      123,456.00"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_10");
-       end if;
- 
-       if Image_IO.Image(-123456.78,
-                         Picture_11,
-                         Default_Currency,
-                         Default_Fill,
-                         Default_Separator,
-                         Radix_Mark => Def_Radix) /= "      -123,457"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_11");
-       end if;
- 
-       if Image_IO.Image(123456.78, Picture_12, "$", '*', ',', '.') /= 
-          "      $123,456.78"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_12");
-       end if;
- 
-       if Image_IO.Image(1.23,
-                         Picture_14,
-                         Currency => Def_Cur,
-                         Fill     => Def_Fill) /= "   $1.23"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_14");
-       end if;
- 
-       if Image_IO.Image(12.34, Pic => Picture_15) /= "$12.34"
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_15");
-       end if;
- 
-    exception
-       when The_Error : others => 
-          Report.Failed("The following exception was raised in the " &
-                        "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,257 ****
- -- CXF3004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that statically identifiable picture strings can be used
- --      in conjunction with function Image to produce output strings 
- --      appropriate to foreign currency representations.
- --
- --      Check that statically identifiable picture strings will cause
- --      function Image to raise Layout_Error under the appropriate 
- --      conditions.
- --      
- -- TEST DESCRIPTION:
- --      This test defines several picture strings that are statically
- --      identifiable, (i.e.,  Pic : Picture := To_Picture("..."); ).
- --      These picture strings are used in conjunction with decimal data
- --      as parameters in calls to function Image.  
- --
- --       
- -- CHANGE HISTORY:
- --      11 Apr 96   SAIC    Initial release for 2.1.
- --
- --!
- 
- with Report;
- with Ada.Text_IO.Editing;
- with Ada.Exceptions;
- 
- procedure CXF3004 is
- begin
- 
-    Report.Test ("CXF3004", "Check that statically identifiable "        &
-                            "picture strings will cause function Image " &
-                            "to raise Layout_Error under appropriate "   &
-                            "conditions");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Exceptions;
-       use Ada.Text_IO.Editing;
- 
-       FF_Currency  : constant String    := "FF";
-       DM_Currency  : constant String    := "DM";
-       FF_Separator : constant Character := '.';
-       DM_Separator : constant Character := ',';
-       FF_Radix     : constant Character := ',';
-       DM_Radix     : constant Character := '.';
-       Blank_Fill   : constant Character := ' ';
-       Star_Fill    : constant Character := '*';
- 
- 
-       -- Define a decimal data type, and instantiate the Decimal_Output 
-       -- generic package for the data type.
- 
-       type Decimal_Data_Type is delta 0.01 digits 16;
- 
-       package Image_IO is 
-         new Decimal_Output(Num                => Decimal_Data_Type,
-                            Default_Currency   => "$",
-                            Default_Fill       => Star_Fill,
-                            Default_Separator  => Default_Separator,
-                            Default_Radix_Mark => DM_Radix);
- 
- 
- 
-       -- The following decimal data items are used with picture strings 
-       -- in evaluating use of foreign currency symbols.
- 
-       Dec_Data_1 : Decimal_Data_Type := 123456.78;
-       Dec_Data_2 : Decimal_Data_Type :=     32.10;
-       Dec_Data_3 : Decimal_Data_Type :=  -1234.57;
-       Dec_Data_4 : Decimal_Data_Type := 123456.78;
-       Dec_Data_5 : Decimal_Data_Type :=     12.34;
-       Dec_Data_6 : Decimal_Data_Type :=     12.34;
-       Dec_Data_7 : Decimal_Data_Type :=  12345.67;
- 
- 
-       -- Statically identifiable picture strings.
-       -- These strings are used in conjunction with non-default values 
-       -- for Currency string, Radix mark, and Separator in calls to
-       -- function Image.
- 
-       Picture_1 : Picture := To_Picture("-###**_***_**9.99");    -- FF
-       Picture_2 : Picture := To_Picture("###z_ZZ9.99");          -- FF
-       Picture_3 : Picture := To_Picture("<<<<_<<<.<<###>");      -- DM
-       Picture_4 : Picture := To_Picture("-$_$$$_$$$_$$9.99");    -- DM
-       Picture_5 : Picture := To_Picture("$Zz9.99");              -- DM
-       Picture_6 : Picture := To_Picture("$$$9.99");              -- DM
-       Picture_7 : Picture := To_Picture("###_###_##9.99");       -- CHF
- 
- 
-       -- The following ten edited output strings correspond to the ten
-       -- foreign currency picture strings.
- 
-       Output_1 : constant String := "  FF***123.456,78";
-       Output_2 : constant String := " FF   32,10";
-       Output_3 : constant String := "  (1,234.57DM )";
-       Output_4 : constant String := "      DM123,456.78"; 
-       Output_5 : constant String := "DM 12.34";
-       Output_6 : constant String := " DM12.34";
-       Output_7 : constant String := "  CHF12,345.67";
- 
- 
-    begin
- 
-       -- Check the results of function Image, using the picture strings
-       -- constructed above, in creating foreign currency edited output
-       -- strings.
- 
-       if Image_IO.Image(Item       => Dec_Data_1,
-                         Pic        => Picture_1,
-                         Currency   => FF_Currency,
-                         Fill       => Star_Fill,
-                         Separator  => FF_Separator,
-                         Radix_Mark => FF_Radix) /= Output_1
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_1");
-       end if;
- 
-       if Image_IO.Image(Item       => Dec_Data_2,
-                         Pic        => Picture_2,
-                         Currency   => FF_Currency,
-                         Fill       => Blank_Fill,
-                         Separator  => FF_Separator,
-                         Radix_Mark => FF_Radix) /= Output_2
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_2");
-       end if;
- 
-       if Image_IO.Image(Item       => Dec_Data_3,
-                         Pic        => Picture_3,
-                         Currency   => DM_Currency,
-                         Fill       => Blank_Fill,
-                         Separator  => DM_Separator,
-                         Radix_Mark => DM_Radix) /= Output_3
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_3");
-       end if;
- 
-       if Image_IO.Image(Item       => Dec_Data_4,
-                         Pic        => Picture_4,
-                         Currency   => DM_Currency,
-                         Fill       => Blank_Fill,
-                         Separator  => DM_Separator,
-                         Radix_Mark => DM_Radix) /= Output_4
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_4");
-       end if;
- 
-       if Image_IO.Image(Item       => Dec_Data_5,
-                         Pic        => Picture_5,
-                         Currency   => DM_Currency,
-                         Fill       => Blank_Fill,
-                         Separator  => DM_Separator,
-                         Radix_Mark => DM_Radix) /= Output_5
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_5");
-       end if;
- 
-       if Image_IO.Image(Item       => Dec_Data_6,
-                         Pic        => Picture_6,
-                         Currency   => DM_Currency,
-                         Fill       => Blank_Fill,
-                         Separator  => DM_Separator,
-                         Radix_Mark => DM_Radix) /= Output_6
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_6");
-       end if;
- 
-       if Image_IO.Image(Item       => Dec_Data_7,
-                         Pic        => Picture_7,
-                         Currency   => "CHF",
-                         Fill       => Blank_Fill,
-                         Separator  => ',',
-                         Radix_Mark => '.') /= Output_7
-       then
-          Report.Failed("Incorrect result from Fn. Image using Picture_7");
-       end if;
- 
- 
-       -- The following calls of Function Image, using the specific
-       -- decimal values and picture strings provided, will cause 
-       -- a Layout_Error to be raised.
-       -- Note: The data and the picture strings used in the following 
-       --       evaluations are not themselves erroneous, but when used in
-       --       combination will cause Layout_Error to be raised.
- 
-       Exception_Block_1 :
-       declare
-          Erroneous_Data_1    : Decimal_Data_Type :=  12.34;
-          Erroneous_Picture_1 : Picture := To_Picture("9.99");
-          N         : constant Natural := Image_IO.Length(Erroneous_Picture_1);
-          TC_String : String(1..N);
-       begin
-          TC_String := Image_IO.Image(Erroneous_Data_1, Erroneous_Picture_1);
-          Report.Failed("Layout_Error not raised by combination of "  &
-                        "Erroneous_Picture_1 and Erroneous_Data_1");
-          Report.Comment("Should never be printed: " & TC_String);
-       exception
-          when Ada.Text_IO.Layout_Error => null; -- OK, expected exception.
-          when The_Error : others       => 
-             Report.Failed
-               ("The following exception was incorrectly raised in " &
-                "Exception_Block_1: " & Exception_Name(The_Error));
-       end Exception_Block_1;
-   
-       Exception_Block_2 :
-       declare
-          Erroneous_Data_2    : Decimal_Data_Type :=  -12.34;
-          Erroneous_Picture_2 : Picture := To_Picture("99.99");
-          N         : constant Natural := Image_IO.Length(Erroneous_Picture_2);
-          TC_String : String(1..N);
-       begin
-          TC_String := Image_IO.Image(Erroneous_Data_2, Erroneous_Picture_2);
-          Report.Failed("Layout_Error not raised by combination of "  &
-                        "Erroneous_Picture_2 and Erroneous_Data_2");
-          Report.Comment("Should never be printed: " & TC_String);
-       exception
-          when Ada.Text_IO.Layout_Error => null; -- OK, expected exception.
-          when The_Error : others       => 
-             Report.Failed
-               ("The following exception was incorrectly raised in " &
-                "Exception_Block_2: " & Exception_Name(The_Error));
-       end Exception_Block_2;
-   
-    exception
-       when The_Error : others => 
-          Report.Failed("The following exception was raised in the " &
-                        "Test_Block: " & Exception_Name(The_Error));
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a	Thu Jan  1 00:00:00 1970
***************
*** 1,167 ****
- -- CXF3A01.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function Ada.Text_IO.Editing.Valid returns False if
- --         a) Pic_String is not a well-formed Picture string, or
- --         b) the length of Pic_String exceeds Max_Picture_Length, or
- --         c) Blank_When_Zero is True and Pic_String contains '*';
- --      Check that Valid otherwise returns True.
- --
- -- TEST DESCRIPTION:
- --      This test validates the results of function Editing.Valid under a 
- --      variety of conditions.  Both valid and invalid picture strings are
- --      provided as input parameters to the function.  The use of the 
- --      Blank_When_Zero parameter is evaluated with strings that contain the
- --      zero suppression character '*'.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A01.A
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Report;
- 
- procedure CXF3A01 is
- begin
- 
-    Report.Test ("CXF3A01", "Check that the Valid function from package "    &
-                            "Ada.Text_IO.Editing returns False for strings " &
-                            "that fail to comply with the composition "      &
-                            "constraints defined for picture strings. "      &
-                            "Check that the Valid function returns True "    &
-                            "for strings that conform to the composition "   &
-                            "constraints defined for picture strings");
- 
-    Test_Block:
-    declare
-       use FXF3A00;
-       use Ada.Text_IO;
-    begin
- 
-       -- Use a series of picture strings that conform to the composition
-       -- constraints to validate the Ada.Text_IO.Editing.Valid function.
-       -- The result for each of these calls should be True.
-       -- In all the following cases, the default value of the Blank_When_Zero
-       -- parameter is used.
- 
-       for i in 1..FXF3A00.Number_Of_Valid_Strings loop
- 
-          if not Editing.Valid(Pic_String => FXF3A00.Valid_Strings(i).all) 
-          then
-             Report.Failed("Incorrect result from Function Valid using " &
-                           "Valid_String = " & FXF3A00.Valid_Strings(i).all); 
-          end if;
- 
-       end loop;
- 
- 
-       for i in 1..FXF3A00.Number_Of_Foreign_Strings loop
- 
-          if not Editing.Valid(Pic_String => FXF3A00.Foreign_Strings(i).all) 
-          then
-             Report.Failed("Incorrect result from Function Valid using " &
-                           "Foreign_String = " & 
-                           FXF3A00.Foreign_Strings(i).all);
-          end if;
- 
-       end loop;
- 
- 
-       -- Use a series of picture strings that violate one or more of the 
-       -- composition constraints to validate the Ada.Text_IO.Editing.Valid
-       -- function.  The result for each of these calls should be False.
-       -- In all the following cases, the default value of the Blank_When_Zero
-       -- parameter is used.
- 
-       for i in 1..FXF3A00.Number_Of_Invalid_Strings loop
- 
-          if Editing.Valid(Pic_String => FXF3A00.Invalid_Strings(i).all) 
-          then
-             Report.Failed("Incorrect result from Function Valid using " &
-                           "Invalid_String = " & 
-                           FXF3A00.Invalid_Strings(i).all);
-          end if;
- 
-       end loop;
- 
- 
-       -- In all the following cases, the default value of the Blank_When_Zero
-       -- parameter is overridden with a True actual parameter value.  Using
-       -- valid picture strings that contain the '*' zero suppression character 
-       -- when this parameter value is True must result in a False result
-       -- from function Valid.  Valid picture strings that do not contain the
-       -- '*' character should return a function result of True with True
-       -- provided as the actual parameter to Blank_When_Zero.
- 
-       -- Check entries 1, 2, 25, 36 from the Valid_Strings array, all of
-       -- which contain the '*' zero suppression character.
- 
-       if Editing.Valid(Valid_Strings(1).all,  Blank_When_Zero => True) or
-          Editing.Valid(Valid_Strings(2).all,  Blank_When_Zero => True) or
-          Editing.Valid(Valid_Strings(25).all, Blank_When_Zero => True) or
-          Editing.Valid(Valid_Strings(36).all, Blank_When_Zero => True) 
-       then
-          Report.Failed
-            ("Incorrect result from Function Valid when setting "   &
-             "the value of the Blank_When_Zero parameter to True, " &
-             "and using picture strings with the '*' character");
-       end if;
- 
- 
-       -- Check entries from the Valid_Strings array, none of
-       -- which contain the '*' zero suppression character.
- 
-       for i in 3..24 loop
- 
-          if not Editing.Valid(Pic_String      => Valid_Strings(i).all,  
-                               Blank_When_Zero => True)
-          then
-             Report.Failed("Incorrect result from Function Valid when "    &
-                           "setting the value of the Blank_When_Zero "     &
-                           "parameter to True, and using picture strings " &
-                           "without the '*' character, Valid_String = "    &
-                           FXF3A00.Valid_Strings(i).all);
-          end if;
- 
-       end loop;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3A01;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a	Thu Jan  1 00:00:00 1970
***************
*** 1,267 ****
- -- CXF3A02.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the function Ada.Text_IO.Editing.To_Picture raises
- --      Picture_Error if the picture string provided as input parameter does
- --      not conform to the composition constraints defined for picture 
- --      strings.
- --      Check that when Pic_String is applied to To_Picture, the result
- --      is equivalent to the actual string parameter of To_Picture; 
- --      Check that when Blank_When_Zero is applied to To_Picture, the result
- --      is the same value as the Blank_When_Zero parameter of To_Picture.
- --      
- -- TEST DESCRIPTION:
- --      This test validates that function Editing.To_Picture returns a 
- --      Picture result when provided a valid picture string, and raises a
- --      Picture_Error exception when provided an invalid picture string
- --      input parameter.  In addition, the Picture result of To_Picture is
- --      converted back to a picture string value using function Pic_String,
- --      and the result of function Blank_When_Zero is validated based on the
- --      value of parameter Blank_When_Zero used in the formation of the Picture
- --      by function To_Picture.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A02.A
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      11 Mar 97   PWB.CTA Corrected invalid picture string and uppercase
- --                          problem.
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Ada.Strings.Maps;
- with Ada.Strings.Fixed;
- with Report;
- 
- procedure CXF3A02 is
- 
-    Lower_Alpha : constant String := "abcdefghijklmnopqrstuvwxyz";
-    Upper_Alpha : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
-    function UpperCase ( Source : String ) return String is
-    begin
-       return
-          Ada.Strings.Fixed.Translate
-             ( Source  => Source, 
-               Mapping => Ada.Strings.Maps.To_Mapping 
-                             ( From => Lower_Alpha, 
-                               To => Upper_Alpha ) );
-    end UpperCase;
- 
- begin
- 
-    Report.Test ("CXF3A02", "Check that the function "                       &
-                            "Ada.Text_IO.Editing.To_Picture raises "         &
-                            "Picture_Error if the picture string provided "  &
-                            "as input parameter does not conform to the "    &
-                            "composition constraints defined for picture "   &
-                            "strings");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Text_IO;
-       use FXF3A00;
- 
-       TC_Picture         : Editing.Picture;
-       TC_Blank_When_Zero : Boolean;
- 
-    begin
- 
- 
-       -- Validate that function To_Picture does not raise Picture_Error when
-       -- provided a valid picture string as an input parameter.
- 
-       for i in 1..FXF3A00.Number_Of_Valid_Strings loop
-          begin
-             TC_Picture := 
-               Editing.To_Picture(Pic_String      => Valid_Strings(i).all,
-                                  Blank_When_Zero => False );
-          exception
-             when Editing.Picture_Error => 
-               Report.Failed
-               ("Picture_Error raised by function To_Picture "     &
-                "with a valid picture string as input parameter, " &
-                "Valid_String = " & FXF3A00.Valid_Strings(i).all);
-             when others => 
-               Report.Failed("Unexpected exception raised - 1, " &
-                             "Valid_String = " & FXF3A00.Valid_Strings(i).all);
-          end;
-       end loop;
- 
- 
- 
-       -- Validate that function To_Picture raises Picture_Error when an
-       -- invalid picture string is provided as an input parameter.
-       -- Default value used for parameter Blank_When_Zero.
- 
-       for i in 1..FXF3A00.Number_Of_Invalid_Strings loop
-          begin
-             TC_Picture := 
-               Editing.To_Picture(Pic_String => FXF3A00.Invalid_Strings(i).all);
-             Report.Failed
-               ("Picture_Error not raised by function To_Picture "    &
-                "with an invalid picture string as input parameter, " &
-                "Invalid_String = " & FXF3A00.Invalid_Strings(i).all);
-          exception
-             when Editing.Picture_Error => null;  -- OK, expected exception.
-             when others                => 
-               Report.Failed("Unexpected exception raised, " & 
-                             "Invalid_String = "             &
-                             FXF3A00.Invalid_Strings(i).all);
-          end;
-       end loop;
- 
- 
- 
-       -- Validate that To_Picture and Pic_String/Blank_When_Zero provide 
-       -- "inverse" results.
- 
-       -- Use the default value of the Blank_When_Zero parameter (False) for 
-       -- these evaluations (some valid strings have the '*' zero suppression
-       -- character, which would result in an invalid string if used with a
-       -- True value for the Blank_When_Zero parameter).
- 
-       for i in 1..FXF3A00.Number_Of_Valid_Strings loop
-          begin
- 
-             -- Format a picture string using function To_Picture.
- 
-             TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
- 
-             -- Reconvert the Picture result from To_Picture to a string value
-             -- using function Pic_String, and compare to the original string.
- 
-             if Editing.Pic_String(Pic => TC_Picture) /= 
-                Uppercase (FXF3A00.Valid_Strings(i).all)
-             then
-                Report.Failed
-                  ("Inverse result incorrect from Editing.Pic_String, " &
-                   "Valid_String = " & FXF3A00.Valid_Strings(i).all);
-             end if;
- 
-             -- Ensure that function Blank_When_Zero returns the correct value
-             -- of the Blank_When_Zero parameter used in forming the Picture 
-             -- (default parameter value False used in call to To_Picture 
-             -- above).
- 
-             if Editing.Blank_When_Zero(Pic => TC_Picture) then
-                Report.Failed
-                  ("Inverse result incorrect from Editing.Blank_When_Zero, " &
-                   "Valid_String = " & FXF3A00.Valid_Strings(i).all);
-             end if;
- 
-          exception
-             when others => 
-               Report.Failed("Unexpected exception raised - 2, " &
-                             "Valid_String = " & FXF3A00.Valid_Strings(i).all);
-          end;
-       end loop;
- 
- 
-       -- Specifically check that any lower case letters in the original
-       -- picture string have been converted to upper case form following
-       -- the To_Picture/Pic_String conversion (as shown in previous loop).
- 
-       declare
-          The_Picture         : Editing.Picture;
-          The_Picture_String  : constant String := "+bBbZz_zZz_Zz9.99";
-          The_Expected_Result : constant String := "+BBBZZ_ZZZ_ZZ9.99";
-       begin
-          -- Convert Picture String to Picture.
-          The_Picture := Editing.To_Picture(Pic_String => The_Picture_String);
- 
-          declare
-             -- Reconvert the Picture to a Picture String.
-             The_Result : constant String := Editing.Pic_String(The_Picture);
-          begin
-             if The_Result /= The_Expected_Result then
-                Report.Failed("Conversion to Picture/Reconversion to String " &
-                              "did not produce expected result when Picture " &
-                              "String had lower case letters");
-             end if;
-          end;
-       end;
- 
- 
-       -- Use a value of True for the Blank_When_Zero parameter for the 
-       -- following evaluations (picture strings that do not have the '*' zero 
-       -- suppression character, which would result in an invalid string when 
-       -- used here with a True value for the Blank_When_Zero parameter).
- 
-       for i in 3..24 loop
-          begin
- 
-             -- Format a picture string using function To_Picture.
- 
-             TC_Picture := 
-               Editing.To_Picture(Pic_String      => Valid_Strings(i).all,
-                                  Blank_When_Zero => True);
- 
-             -- Reconvert the Picture result from To_Picture to a string value
-             -- using function Pic_String, and compare to the original string.
- 
-             if Editing.Pic_String(Pic => TC_Picture) /= 
-                UpperCase (FXF3A00.Valid_Strings(i).all)
-             then
-                Report.Failed
-                  ("Inverse result incorrect from Editing.Pic_String, used "   &
-                   "on Picture formed with parameter Blank_When_Zero = True, " &
-                   "Valid_String = " & FXF3A00.Valid_Strings(i).all);
-             end if;
- 
-             -- Ensure that function Blank_When_Zero returns the correct value
-             -- of the Blank_When_Zero parameter used in forming the Picture 
-             -- (default parameter value False overridden in call to 
-             -- To_Picture above).
- 
-             if not Editing.Blank_When_Zero(Pic => TC_Picture) then
-                Report.Failed
-                  ("Inverse result incorrect from Editing.Blank_When_Zero, "  &
-                   "used on a Picture formed with parameter Blank_When_Zero " & 
-                   "= True, Valid_String = " & FXF3A00.Valid_Strings(i).all);
-             end if;
- 
-          exception
-             when others => 
-               Report.Failed("Unexpected exception raised - 3, " &
-                             "Valid_String = " & FXF3A00.Valid_Strings(i).all);
-          end;
-       end loop;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3A02;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a	Thu Jan  1 00:00:00 1970
***************
*** 1,429 ****
- -- CXF3A03.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that function Length in the generic package Decimal_Output
- --      returns the number of characters in the edited output string 
- --      produced by function Image, for a particular decimal type, 
- --      currency string, and radix mark.
- --      Check that function Valid in the generic package Decimal_Output 
- --      returns correct results based on the particular decimal value, 
- --      and the Picture and Currency string parameters.
- --      
- -- TEST DESCRIPTION:
- --      This test uses two instantiations of package Decimal_Output, one
- --      for decimal data with delta 0.01, the other for decimal data with
- --      delta 1.0. The functions Length and Valid found in this generic 
- --      package are evaluated for each instantiation.
- --      Function Length is examined with picture and currency string input
- --      parameters of different sizes.
- --      Function Valid is examined with a decimal type data item, picture
- --      object, and currency string, for cases that are both valid and
- --      invalid (Layout_Error would result from the particular items as
- --      input parameters to function Image).
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A03.A
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Report;
- 
- procedure CXF3A03 is
- begin
- 
-    Report.Test ("CXF3A03", "Check that function Length returns the "     &
-                            "number of characters in the edited output "  &
-                            "string produced by function Image, for a "   &
-                            "particular decimal type, currency string, "  &
-                            "and radix mark.  Check that function Valid " &
-                            "returns correct results based on the "       &
-                            "particular decimal value, and the Picture "  &
-                            "and Currency string parameters");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Text_IO;
-       use FXF3A00;
- 
-       type Instantiation_Type is (NDP, TwoDP);
- 
-       -- Defaults used for all other generic parameters in these
-       -- instantiations.
-       package Pack_NDP is new Editing.Decimal_Output (Decimal_Type_NDP);
-       package Pack_2DP is new Editing.Decimal_Output (Decimal_Type_2DP);
- 
-       TC_Lower_Bound,
-       TC_Higher_Bound : Integer := 0;
- 
-       TC_Picture      : Editing.Picture;
-       TC_US_String    : constant String := "$";
-       TC_FF_String    : constant String := "FF";
-       TC_DM_String    : constant String := "DM";
-       TC_CHF_String   : constant String := "CHF";
- 
- 
-       function Dollar_Sign_Present (Str : String) return Boolean is
-       begin
-          for i in 1..Str'Length loop
-             if Str(i) = '$' then
-                return True;
-             end if;
-          end loop;
-          return False;
-       end Dollar_Sign_Present;
- 
-       function V_Present (Str : String) return Boolean is
-       begin
-          for i in 1..Str'Length loop
-             if Str(i) = 'V' or Str(i) = 'v' then
-                return True;
-             end if;
-          end loop;
-          return False;
-       end V_Present;
- 
- 
-       function Accurate_Length (Pict_Str        : String;
-                                 Inst            : Instantiation_Type;
-                                 Currency_String : String) 
-         return Boolean is
- 
-          TC_Length                     : Natural := 0;
-          TC_Currency_Length_Adjustment : Natural := 0;
-          TC_Radix_Adjustment           : Natural := 0;
-       begin
- 
-          -- Create the picture object from the picture string.
-          TC_Picture := Editing.To_Picture(Pict_Str);
- 
-          -- Calculate the currency length adjustment.
-          if Dollar_Sign_Present (Editing.Pic_String(TC_Picture)) then
-             TC_Currency_Length_Adjustment := Currency_String'Length - 1;
-          end if;
- 
-          -- Calculate the Radix adjustment.
-          if V_Present (Editing.Pic_String(TC_Picture)) then
-             TC_Radix_Adjustment := 1;
-          end if;
- 
-          -- Calculate the length, using the version of Length that comes
-          -- from the appropriate instantiation of Decimal_Output, based
-          -- on the decimal type used in the instantiation.
-          if Inst = NDP then
-             TC_Length  := Pack_NDP.Length(TC_Picture,
-                                           Currency_String);
-          else
-             TC_Length  := Pack_2DP.Length(TC_Picture,
-                                           Currency_String);
-          end if;
- 
-          return TC_Length = Editing.Pic_String(TC_Picture)'Length +
-                               TC_Currency_Length_Adjustment       -
-                               TC_Radix_Adjustment;
-       end Accurate_Length;
- 
- 
-    begin
- 
-       Length_Block:
-       begin
- 
-          -- The first 10 picture strings in the Valid_Strings array correspond
-          -- to data values of a decimal type with delta 0.01. 
-          -- Note: The appropriate instantiation of the Decimal_Output package 
-          --       (and therefore function Length) is used by function 
-          --       Accurate_Length to calculate length.
- 
-          for i in 1..10 loop
-             if not Accurate_Length (FXF3A00.Valid_Strings(i).all, 
-                                     TwoDP, 
-                                     TC_US_String)
-             then
-                Report.Failed("Incorrect result from function Length, "       &
-                              "when used with a decimal type with delta .01 " &
-                              "and with the currency string " & TC_US_String  & 
-                              " in evaluating picture string "                &
-                              FXF3A00.Valid_Strings(i).all );
-             end if;
-          end loop;
- 
- 
-          -- Picture strings 17-20 in the Valid_Strings array correspond
-          -- to data values of a decimal type with delta 1.0.  Again, the
-          -- instantiation of Decimal_Output used is based on this particular
-          -- decimal type.
- 
-          for i in 17..20 loop
-             if not Accurate_Length (FXF3A00.Valid_Strings(i).all, 
-                                     NDP, 
-                                     TC_US_String)
-             then
-                Report.Failed("Incorrect result from function Length, "       &
-                              "when used with a decimal type with delta 1.0 " &
-                              "and with the currency string " & TC_US_String  & 
-                              " in evaluating picture string "                &
-                              FXF3A00.Valid_Strings(i).all );
-             end if;
-          end loop;
- 
- 
-          -- The first 4 picture strings in the Foreign_Strings array
-          -- correspond to data values of a decimal type with delta 0.01, 
-          -- and to the currency string "FF" (two characters). 
- 
-          for i in 1..FXF3A00.Number_of_FF_Strings loop
-             if not Accurate_Length (FXF3A00.Foreign_Strings(i).all, 
-                                     TwoDP, 
-                                     TC_FF_String)
-             then
-                Report.Failed("Incorrect result from function Length, "       &
-                              "when used with a decimal type with delta .01 " &
-                              "and with the currency string " & TC_FF_String  & 
-                              " in evaluating picture string "                &
-                              FXF3A00.Foreign_Strings(i).all );
-             end if;
-          end loop;
- 
- 
-          -- Picture strings 5-9 in the Foreign_Strings array correspond
-          -- to data values of a decimal type with delta 0.01, and to the
-          -- currency string "DM" (two characters). 
- 
-          TC_Lower_Bound  := FXF3A00.Number_of_FF_Strings + 1;
-          TC_Higher_Bound := FXF3A00.Number_of_FF_Strings + 
-                             FXF3A00.Number_of_DM_Strings;
- 
-          for i in TC_Lower_Bound..TC_Higher_Bound loop
-             if not Accurate_Length (FXF3A00.Foreign_Strings(i).all, 
-                                     TwoDP, 
-                                     TC_DM_String)
-             then
-                Report.Failed("Incorrect result from function Length, "       &
-                              "when used with a decimal type with delta .01 " &
-                              "and with the currency string " & TC_DM_String  & 
-                              " in evaluating picture string "                &
-                              FXF3A00.Foreign_Strings(i).all );
-             end if;
-          end loop;
- 
- 
-          -- Picture string #10 in the Foreign_Strings array corresponds
-          -- to a data value of a decimal type with delta 0.01, and to the
-          -- currency string "CHF" (three characters). 
- 
-          if not Accurate_Length (FXF3A00.Foreign_Strings(10).all, 
-                                  TwoDP, 
-                                  TC_CHF_String)
-          then
-             Report.Failed("Incorrect result from function Length, "       &
-                           "when used with a decimal type with delta .01 " &
-                           "and with the currency string "                 & 
-                           TC_CHF_String);
-          end if;
- 
-       exception
-          when others => 
-            Report.Failed("Unexpected exception raised in Length_Block");
-       end Length_Block;
- 
- 
-       Valid_Block:
-       declare
- 
-          -- This offset value is used to align picture string and decimal
-          -- data values from package FXF3A00 for proper correspondence for
-          -- the evaluations below.  
- 
-          TC_Offset : constant Natural := 10;
- 
-       begin
- 
-          -- The following four For Loops examine cases where the
-          -- decimal data/picture string/currency combinations used will 
-          -- generate valid Edited Output strings.  These combinations, when
-          -- provided to the Function Valid (from instantiations of 
-          -- Decimal_Output), should result in a return result of True.
-          -- The particular instantiated version of Valid used in these loops
-          -- is that for decimal data with delta 0.01.
- 
-          -- The first 4 picture strings in the Foreign_Strings array
-          -- correspond to data values of a decimal type with delta 0.01, 
-          -- and to the currency string "FF" (two characters). 
- 
-          for i in 1..FXF3A00.Number_of_FF_Strings loop
-             -- Create the picture object from the picture string.
-             TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(i).all);
- 
-             if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + i),
-                                    TC_Picture,
-                                    TC_FF_String)
-             then
-                Report.Failed("Incorrect result from function Valid, "        &
-                              "when used with a decimal type with delta .01 " &
-                              "and with the currency string " & TC_FF_String  & 
-                              " in evaluating picture string "                &
-                              FXF3A00.Foreign_Strings(i).all );
-             end if;
-          end loop;
- 
- 
-          -- Picture strings 5-9 in the Foreign_Strings array correspond
-          -- to data values of a decimal type with delta 0.01, and to the
-          -- currency string "DM" (two characters). 
- 
-          TC_Lower_Bound  := FXF3A00.Number_of_FF_Strings + 1; 
-          TC_Higher_Bound := FXF3A00.Number_of_FF_Strings + 
-                             FXF3A00.Number_of_DM_Strings;
- 
-          for i in TC_Lower_Bound..TC_Higher_Bound loop
-             -- Create the picture object from the picture string.
-             TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(i).all);
- 
-             if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + i),
-                                    TC_Picture,
-                                    TC_DM_String)
-             then
-                Report.Failed("Incorrect result from function Valid, "        &
-                              "when used with a decimal type with delta .01 " &
-                              "and with the currency string " & TC_DM_String  & 
-                              " in evaluating picture string "                &
-                              FXF3A00.Foreign_Strings(i).all );
-             end if;
-          end loop;
- 
- 
-          -- Picture string #10 in the Foreign_Strings array corresponds
-          -- to a data value of a decimal type with delta 0.01, and to the
-          -- currency string "CHF" (three characters). 
- 
-          -- Create the picture object from the picture string.
-          TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(10).all);
- 
-          if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + 10),
-                                 TC_Picture,
-                                 TC_CHF_String)
-          then
-             Report.Failed("Incorrect result from function Valid, "        &
-                           "when used with a decimal type with delta .01 " &
-                           "and with the currency string "                 & 
-                           TC_CHF_String);
-          end if;
- 
- 
-          -- The following For Loop examines cases where the
-          -- decimal data/picture string/currency combinations used will 
-          -- generate valid Edited Output strings.  
-          -- The particular instantiated version of Valid used in this loop
-          -- is that for decimal data with delta 1.0; the others above have
-          -- been for decimal data with delta 0.01.
-          -- Note: TC_Offset is used here to align picture strings from the
-          --       FXF3A00.Valid_Strings table with the appropriate decimal
-          --       data in the FXF3A00.Data_With_NDP table.
- 
-          for i in 1..FXF3A00.Number_Of_NDP_Items loop
-             -- Create the picture object from the picture string.
-             TC_Picture := 
-                Editing.To_Picture(FXF3A00.Valid_Strings(TC_Offset + i).all);
- 
-             if not Pack_NDP.Valid (FXF3A00.Data_With_NDP(i),
-                                    TC_Picture, 
-                                    TC_US_String)
-             then
-                Report.Failed("Incorrect result from function Valid, "        &
-                              "when used with a decimal type with delta .01 " &
-                              "and with the currency string " & TC_US_String  & 
-                              " in evaluating picture string "                &
-                              FXF3A00.Valid_Strings(i).all );
-             end if;
-          end loop;
- 
- 
-          -- The following three evaluations of picture strings, used in
-          -- conjunction with the specific decimal values provided, will cause 
-          -- Editing.Image to raise Layout_Error (to be examined in other
-          -- tests).  Function Valid should return a False result for these 
-          -- combinations.
-          -- The first two evaluations use the instantiation of Decimal_Output
-          -- with a decimal type with delta 0.01, while the last evaluation
-          -- uses the instantiation with decimal type with delta 1.0.
- 
-          for i in 1..FXF3A00.Number_of_Erroneous_Conditions loop
- 
-             -- Create the picture object from the picture string.
-             TC_Picture := 
-                Editing.To_Picture(FXF3A00.Erroneous_Strings(i).all);
- 
-             if i < 3 then  -- Choose the appropriate instantiation.
-                if Pack_2DP.Valid(Item     => FXF3A00.Erroneous_Data(i),
-                                  Pic      => TC_Picture,
-                                  Currency => TC_US_String)
-                then
-                   Report.Failed("Incorrect result from function Valid, "    &
-                                 "when used with a decimal type with delta " &
-                                 "0.01 and with the currency string "        & 
-                                 TC_US_String                                & 
-                                 " in evaluating picture string "            &
-                                 FXF3A00.Valid_Strings(i).all );
-                end if;
-             else
-                if Pack_NDP.Valid(Item     => FXF3A00.Decimal_Type_NDP(
-                                                FXF3A00.Erroneous_Data(i)),
-                                  Pic      => TC_Picture,
-                                  Currency => TC_US_String)
-                then
-                   Report.Failed("Incorrect result from function Valid, "    &
-                                 "when used with a decimal type with delta " &
-                                 "1.0 and with the currency string "         & 
-                                 TC_US_String                                & 
-                                 " in evaluating picture string "            &
-                                 FXF3A00.Valid_Strings(i).all );
-                end if;
-             end if;
-          end loop;
- 
-       exception
-          when others => 
-            Report.Failed("Unexpected exception raised in Valid_Block");
-       end Valid_Block;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3A03;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a	Thu Jan  1 00:00:00 1970
***************
*** 1,293 ****
- -- CXF3A04.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the edited output string value returned by Function Image
- --      is correct.
- --
- -- TEST DESCRIPTION:
- --      This test is structured using tables of data, consisting of
- --      numerical values, picture strings, and expected image
- --      result strings.  These data tables are found in package FXF3A00.
- --      
- --      The results of the Image function are examined under a number of 
- --      circumstances.  The generic package Decimal_Output is instantiated
- --      twice, for decimal data with delta 0.01 and delta 1.0.  Each version
- --      of Image is called with both default parameters and user-provided
- --      parameters.  The results of each call to Image are compared to an
- --      expected edited output result string.
- --      
- --      In addition, three calls to Image are designed to raise Layout_Error,
- --      due to the combination of decimal value and picture string provided
- --      as input parameters.  If Layout_Error is not raised, or an alternate
- --      exception is raised instead, test failure results.
- --      
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A04.A
- --
- --       
- -- CHANGE HISTORY:
- --      22 JAN 95   SAIC    Initial prerelease version.
- --      11 MAR 97   PWB.CTA Corrected incorrect index expression
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Report;
- 
- procedure CXF3A04 is
- begin
- 
-    Report.Test ("CXF3A04", "Check that the string value returned by " &
-                            "Function Image is correct, based on the " &
-                            "numerical data and picture formatting "   &
-                            "parameters provided to the function");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Text_IO;
- 
-       -- Instantiate the Decimal_Output generic package for the two data
-       -- types, using the default values for the Default_Currency,
-       -- Default_Fill, Default_Separator, and Default_Radix_Mark 
-       -- parameters.
- 
-       package Pack_NDP is 
-         new Editing.Decimal_Output (FXF3A00.Decimal_Type_NDP);
- 
-       package Pack_2DP is 
-         new Editing.Decimal_Output (FXF3A00.Decimal_Type_2DP);
- 
-       TC_Currency   : constant String    := "$";
-       TC_Fill       : constant Character := '*';
-       TC_Separator  : constant Character := ',';
-       TC_Radix_Mark : constant Character := '.';
- 
-       TC_Picture    : Editing.Picture;
- 
- 
-    begin
- 
-       Two_Decimal_Place_Data:
-       -- Use a decimal fixed point type with delta 0.01 (two decimal places) 
-       -- and valid picture strings. Evaluate the result of function Image 
-       -- with the expected edited output result string.
-       declare  
- 
-          TC_Loop_End : constant :=                                     -- 10
-            FXF3A00.Number_Of_2DP_Items - FXF3A00.Number_Of_Foreign_Strings;
- 
-       begin
-          -- The first 10 picture strings in the Valid_Strings array 
-          -- correspond to data values of a decimal type with delta 0.01. 
- 
-          -- Compare string result of Image with expected edited output 
-          -- string.  Evaluate data using both default parameters of Image
-          -- and user-provided parameter values.
-          for i in 1..TC_Loop_End loop
- 
-             -- Create the picture object from the picture string.
-             TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
- 
-             -- Use the default parameters for this loop evaluation of Image.
-             if Pack_2DP.Image(FXF3A00.Data_With_2DP(i), TC_Picture) /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect result from Function Image, "    &
-                              "when used with a decimal type with delta " &
-                              "0.01, picture string "                     &
-                              FXF3A00.Valid_Strings(i).all                &
-                              ", and the default parameters of Image");
-             end if;
- 
-             -- Use user-provided parameters for this loop evaluation of Image.
- 
-             if Pack_2DP.Image(Item       => FXF3A00.Data_With_2DP(i), 
-                               Pic        => TC_Picture,
-                               Currency   => TC_Currency,
-                               Fill       => TC_Fill,
-                               Separator  => TC_Separator,
-                               Radix_Mark => TC_Radix_Mark) /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect result from Function Image, "    &
-                              "when used with a decimal type with delta " &
-                              "0.01, picture string "                     &
-                              FXF3A00.Valid_Strings(i).all                &
-                              ", and user-provided parameters");
-             end if;
- 
-          end loop;
- 
-       exception
-          when others => 
-            Report.Failed("Exception raised in Two_Decimal_Place_Data block");
-       end Two_Decimal_Place_Data;
- 
- 
- 
-       No_Decimal_Place_Data:
-       -- Use a decimal fixed point type with delta 1.00 (no decimal places) 
-       -- and valid picture strings. Evaluate the result of function Image 
-       -- with the expected result string.
-       declare
- 
-          use Editing, FXF3A00;
- 
-          TC_Offset     : constant := 10;
-          TC_Loop_Start : constant := TC_Offset + 1;                   -- 11
-          TC_Loop_End   : constant := TC_Loop_Start +
-                                      Number_Of_NDP_Items - 1;         -- 22
- 
-       begin
-          -- The following evaluations correspond to data values of a 
-          -- decimal type with delta 1.0. 
- 
-          -- Compare string result of Image with expected edited output 
-          -- string.  Evaluate data using both default parameters of Image
-          -- and user-provided parameter values.
-          -- Note: TC_Offset is used to align corresponding data the various
-          --       data tables in foundation package FXF3A00.
- 
-          for i in TC_Loop_Start..TC_Loop_End loop
- 
-             -- Create the picture object from the picture string.
-             TC_Picture := To_Picture(Valid_Strings(i).all);
- 
-             -- Use the default parameters for this loop evaluation of Image.
-             if not (Pack_NDP.Image(Data_With_NDP(i-TC_Offset), TC_Picture) =
-                     Edited_Output(TC_Offset+i).all)
-             then
-                Report.Failed("Incorrect result from Function Image, "    &
-                              "when used with a decimal type with delta " &
-                              "1.0, picture string "                      &
-                              Valid_Strings(i).all                        &
-                              ", and the default parameters of Image");
-             end if;
- 
-             -- Use user-provided parameters for this loop evaluation of Image.
-             if Pack_NDP.Image(Item       => Data_With_NDP(i - TC_Offset), 
-                               Pic        => TC_Picture,
-                               Currency   => TC_Currency,
-                               Fill       => TC_Fill,
-                               Separator  => TC_Separator,
-                               Radix_Mark => TC_Radix_Mark) /=
-                Edited_Output(TC_Offset+i).all
-             then
-                Report.Failed("Incorrect result from Function Image, "    &
-                              "when used with a decimal type with delta " &
-                              "1.0, picture string "                      &
-                              Valid_Strings(i).all                        &
-                              ", and user-provided parameters");
-             end if;
- 
-          end loop;
- 
-       exception
-          when others => 
-            Report.Failed("Exception raised in No_Decimal_Place_Data block");
-       end No_Decimal_Place_Data;
- 
- 
- 
-       Exception_Block:
-       -- The following three calls of Function Image, using the specific
-       -- decimal values and picture strings provided, will cause 
-       -- a Layout_Error to be raised.
-       -- The first two evaluations use the instantiation of Decimal_Output
-       -- with a decimal type with delta 0.01, while the last evaluation
-       -- uses the instantiation with decimal type with delta 1.0.
- 
-       -- Note: The data and the picture strings used in the following 
-       --       evaluations are not themselves erroneous, but when used in
-       --       combination will cause Layout_Error to be raised.
- 
-       begin
- 
-          for i in 1..FXF3A00.Number_Of_Erroneous_Conditions loop    -- 1..3
-             begin
-                -- Create the picture object from the picture string.
-                TC_Picture :=
-                  Editing.To_Picture(FXF3A00.Erroneous_Strings(i).all);
- 
-                -- Layout_Error must be raised by the following calls to
-                -- Function Image.
- 
-                if i < 3 then  -- Choose the appropriate instantiation.
-                   declare
-                      N : constant Natural := Pack_2DP.Length(TC_Picture);
-                      TC_String : String(1..N);
-                   begin
-                      TC_String := Pack_2DP.Image(FXF3A00.Erroneous_Data(i),
-                                                  TC_Picture);
-                   end;
-                else
-                   declare
-                      use FXF3A00;
-                      N : constant Natural := Pack_NDP.Length(TC_Picture,
-                                                              TC_Currency);
-                      TC_String : String(1..N);
-                   begin
-                      TC_String := 
-                        Pack_NDP.Image(Item       => Decimal_Type_NDP(
-                                                       Erroneous_Data(i)),
-                                       Pic        => TC_Picture,
-                                       Currency   => TC_Currency,
-                                       Fill       => TC_Fill,
-                                       Separator  => TC_Separator,
-                                       Radix_Mark => TC_Radix_Mark);
-                   end;
-                end if;
- 
-                Report.Failed("Layout_Error not raised by combination "  &
-                              "# " & Integer'Image(i) & " "              &
-                              "of decimal data and picture string");
- 
-             exception
-                when Layout_Error => null;    -- Expected exception.
-                when others       =>
-                  Report.Failed("Incorrect exception raised by combination " &
-                                "# " & Integer'Image(i) & " "                &
-                                "of decimal data and picture string");
-             end;
-          end loop;
- 
-       exception
-          when others => 
-            Report.Failed("Unexpected exception raised in Exception_Block");
-       end Exception_Block;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3A04;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a	Thu Jan  1 00:00:00 1970
***************
*** 1,266 ****
- -- CXF3A05.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Function Image produces correct results when provided
- --      non-default parameters for Currency, Fill, Separator, and 
- --      Radix_Mark at either the time of package Decimal_Output instantiation,
- --      or in a call to Image.  Check non-default parameters that are 
- --      appropriate for foreign currency representations.
- --
- -- TEST DESCRIPTION:
- --      This test is structured using tables of data, consisting of
- --      numerical values, picture strings, and expected image
- --      result strings.  These data tables are found in package FXF3A00.
- --      
- --      The results of the Image function, resulting from several different
- --      instantiations of Decimal_Output, are compared with expected
- --      edited output string results.  The primary focus of this test is to
- --      examine the effect of non-default parameters, provided during the 
- --      instantiation of package Decimal_Output, or provided as part of a
- --      call to Function Image (that resulted from an instantiation of
- --      Decimal_Output that used default parameters).  The non-default
- --      parameters provided correspond to foreign currency representations.
- --      
- --      For each picture string/decimal data combination examined, two
- --      evaluations of Image are performed.  These correspond to the two
- --      methods of providing the appropriate non-default parameters described
- --      above.  Both forms of Function Image should produce the same expected
- --      edited output string.
- --      
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A05.A
- --
- --       
- -- CHANGE HISTORY:
- --      26 JAN 95   SAIC    Initial prerelease version.
- --      17 FEB 97   PWB.CTA Correct array indices for Foreign_Strings array
- --                          references.
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Report;
- 
- procedure CXF3A05 is
- begin
- 
-    Report.Test ("CXF3A05", "Check that Function Image produces "        &
-                            "correct results when provided non-default " &
-                            "parameters for Currency, Fill, Separator, " &
-                            "and Radix_Mark, appropriate to foreign "    &
-                            "currency representations");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Text_IO;
- 
-       -- Instantiate the Decimal_Output generic package for the several
-       -- combinations of Default_Currency, Default_Fill, Default_Separator,
-       -- and Default_Radix_Mark.
- 
-       package Pack_Def is                   -- Uses default parameter values.
-         new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP);
- 
-       package Pack_FF  is
-         new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP,
-                                    Default_Currency   => "FF",
-                                    Default_Fill       => '*',
-                                    Default_Separator  => '.',
-                                    Default_Radix_Mark => ',');
- 
-       package Pack_DM  is
-         new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP,
-                                    Default_Currency   => "DM",
-                                    Default_Fill       => '*',
-                                    Default_Separator  => ',',
-                                    Default_Radix_Mark => '.');
- 
-       package Pack_CHF  is
-         new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP,
-                                    Default_Currency   => "CHF",
-                                    Default_Fill       => '*',
-                                    Default_Separator  => ',',
-                                    Default_Radix_Mark => '.');
- 
- 
-       TC_Picture    : Editing.Picture;
-       TC_Start_Loop : constant := 11;
-       TC_End_Loop   : constant := TC_Start_Loop +                       -- 20
-                                   FXF3A00.Number_Of_Foreign_Strings - 1;
- 
-    begin
- 
-       -- In the case of each particular type of foreign string examined,
-       -- two versions of Function Image are examined.  First, a version of
-       -- the function that originated from an instantiation of Decimal_Output
-       -- with non-default parameters is checked.  This version of Image is 
-       -- called making use of default parameters in the actual function call.
-       -- In addition, a version of Function Image is checked that resulted 
-       -- from an instantiation of Decimal_Output using default parameters, 
-       -- but which uses non-default parameters in the function call.
- 
-       for i in TC_Start_Loop..TC_End_Loop loop
- 
-          -- Create the picture object from the picture string.
- 
-          TC_Picture := Editing.To_Picture
-                          (FXF3A00.Foreign_Strings(i - TC_Start_Loop + 1).all);
- 
-          -- Based on the ordering of the specific foreign picture strings
-          -- in the FXF3A00.Foreign_Strings table, the following conditional
-          -- is used to determine which type of currency is being examined
-          -- as the loop executes.
- 
-          if i < TC_Start_Loop + FXF3A00.Number_Of_FF_Strings then -- (11-14)
-             -- Process the FF picture strings.
- 
-             -- Check the result of Function Image from an instantiation
-             -- of Decimal_Output that provided non-default actual 
-             -- parameters at the time of package instantiation, and uses
-             -- default parameters in the call of Image.
- 
-             if Pack_FF.Image(Item => FXF3A00.Data_With_2DP(i),
-                              Pic  => TC_Picture)  /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect output from Function Image "     &
-                              "from package instantiated with FF "        &
-                              "related parameters, using picture string " &
-                              FXF3A00.Foreign_Strings
-                                (i - TC_Start_Loop + 1).all);
-             end if;
- 
-             -- Check the result of Function Image that originated from 
-             -- an instantiation of Decimal_Output where default parameters
-             -- were used at the time of package Instantiation, but where
-             -- non-default parameters are provided in the call of Image.
- 
-             if Pack_Def.Image(Item       => FXF3A00.Data_With_2DP(i),
-                               Pic        => TC_Picture,
-                               Currency   => "FF",
-                               Fill       => '*',
-                               Separator  => '.',
-                               Radix_Mark => ',')  /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect output from Function Image "     &
-                              "from package instantiated with default "   &
-                              "parameters, using picture string "         &
-                              FXF3A00.Foreign_Strings
-                                (i - TC_Start_Loop + 1).all               &
-                              ", and FF related parameters in call to Image");
-             end if;
- 
- 
-          elsif i < TC_Start_Loop +                                -- (15-19)
-                    FXF3A00.Number_Of_FF_Strings + 
-                    FXF3A00.Number_Of_DM_Strings  then
-             -- Process the DM picture strings.
- 
-             -- Non-default instantiation parameters, default function call
-             -- parameters.
- 
-             if Pack_DM.Image(Item => FXF3A00.Data_With_2DP(i),
-                              Pic  => TC_Picture)  /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect output from Function Image "     &
-                              "from package instantiated with DM "        &
-                              "related parameters, using picture string " &
-                              FXF3A00.Foreign_Strings
-                                (i - TC_Start_Loop + 1).all);
-             end if;
- 
-             -- Default instantiation parameters, non-default function call
-             -- parameters.
- 
-             if Pack_Def.Image(Item       => FXF3A00.Data_With_2DP(i),
-                               Pic        => TC_Picture,
-                               Currency   => "DM",
-                               Fill       => '*',
-                               Separator  => ',',
-                               Radix_Mark => '.')  /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect output from Function Image "     &
-                              "from package instantiated with default "   &
-                              "parameters, using picture string "         &
-                              FXF3A00.Foreign_Strings
-                                (i - TC_Start_Loop + 1).all               &
-                              ", and DM related parameters in call to Image");
-             end if;
- 
- 
-          else                                                     -- (i=20)
-             -- Process the CHF string.
- 
-             -- Non-default instantiation parameters, default function call
-             -- parameters.
- 
-             if Pack_CHF.Image(FXF3A00.Data_With_2DP(i), TC_Picture)  /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect output from Function Image "     &
-                              "from package instantiated with CHF "       &
-                              "related parameters, using picture string " &
-                              FXF3A00.Foreign_Strings
-                                (i - TC_Start_Loop + 1).all);
-             end if;
- 
-             -- Default instantiation parameters, non-default function call
-             -- parameters.
- 
-             if Pack_Def.Image(FXF3A00.Data_With_2DP(i),
-                               TC_Picture,
-                               "CHF",
-                               '*',
-                               ',',
-                               '.')  /=
-                FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Incorrect output from Function Image "     &
-                              "from package instantiated with default "   &
-                              "parameters, using picture string "         &
-                              FXF3A00.Foreign_Strings
-                                (i - TC_Start_Loop + 1).all               &
-                              ", and CHF related parameters in call to Image");
-             end if;
- 
-          end if;
- 
-       end loop;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3A05;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a	Thu Jan  1 00:00:00 1970
***************
*** 1,302 ****
- -- CXF3A06.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Ada.Text_IO.Editing.Put and Ada.Text_IO.Put have the same
- --      effect.  
- --
- -- TEST DESCRIPTION:
- --      This test is structured using tables of data, consisting of
- --      numerical values, picture strings, and expected image
- --      result strings.  These data tables are found in package FXF3A00.
- --      
- --      The testing approach used in this test is that of writing edited
- --      output data to a text file, using two different approaches.  First,
- --      Ada.Text_IO.Put is used, with a call to an instantiated version of
- --      Function Image supplied as the actual for parameter Item.  The 
- --      second approach is to use a version of Function Put from an 
- --      instantiation of Ada.Text_IO.Editing.Decimal_Output, with the
- --      appropriate parameters for decimal data, picture, and format
- --      specific parameters.  A call to New_Line follows each Put, so that
- --      each entry is placed on a separate line in the text file.
- --      
- --      Edited output for decimal data with two decimal places is in the 
- --      first loop, and once the data has been written to the file, the 
- --      text file is closed, then opened in In_File mode.  The edited
- --      output data is read from the file, and data on successive lines
- --      is compared with the expected edited output result.  The edited
- --      output data produced by both of the Put procedures should be
- --      identical.
- --      
- --      This process is repeated for decimal data with no decimal places.
- --      The file is reopened in Append_File mode, and the edited output
- --      data is added to the file in the same manner as described above.
- --      The file is closed, and reopened to verify the data written.  
- --      The data written above (with two decimal places) is skipped, then
- --      the data to be verified is extracted as above and verified against
- --      the expected edited output string values.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test is applicable only to implementations that support
- --      external text files.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A06.A
- --
- --       
- -- CHANGE HISTORY:
- --      26 JAN 95   SAIC    Initial prerelease version.
- --      26 FEB 97   PWB.CTA Made input buffers sufficiently long
- --                          and removed code depending on shorter buffers
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Report;
- 
- procedure CXF3A06 is
-    use Ada;
- begin
- 
-    Report.Test ("CXF3A06", "Check that Ada.Text_IO.Editing.Put and " &
-                            "Ada.Text_IO.Put have the same effect");
- 
-    Test_for_Text_IO_Support:
-    declare
-       Text_File     : Ada.Text_IO.File_Type;
-       Text_Filename : constant String := Report.Legal_File_Name(1);
-    begin
- 
-       -- Use_Error will be raised if Text_IO operations or external files
-       -- are not supported.
- 
-       Text_IO.Create (Text_File, Text_IO.Out_File, Text_Filename);
- 
-       Test_Block:
-       declare
-          use Ada.Text_IO;
- 
-          -- Instantiate the Decimal_Output generic package for two
-          -- different decimal data types.
- 
-          package Pack_2DP is          -- Uses decimal type with delta 0.01.
-            new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP);
- 
-          package Pack_NDP is          -- Uses decimal type with delta 1.0.
-            new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_NDP,
-                                       Default_Currency   => "$",
-                                       Default_Fill       => '*',
-                                       Default_Separator  => ',',
-                                       Default_Radix_Mark => '.');
- 
-          TC_Picture    : Editing.Picture;
-          TC_Start_Loop : constant :=  1;
-          TC_End_Loop_1 : constant := FXF3A00.Number_Of_2DP_Items -    -- 20-10
-                                      FXF3A00.Number_Of_Foreign_Strings;
-          TC_End_Loop_2 : constant := FXF3A00.Number_Of_NDP_Items;     -- 12
-          TC_Offset     : constant := FXF3A00.Number_Of_2DP_Items;     -- 20
- 
-          TC_String_1, TC_String_2 : String(1..255) := (others => ' ');
-          TC_Last_1,   TC_Last_2   : Natural := 0;
- 
-       begin
- 
-          -- Use the two versions of Put, for data with two decimal points,
-          -- to write edited output strings to the text file.  Use a separate
-          -- line for each string entry.
- 
-          for i in TC_Start_Loop..TC_End_Loop_1 loop               -- 1..10
- 
-             -- Create the picture object from the picture string.
- 
-             TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
- 
-             -- Use the Text_IO version of Put to place an edited output 
-             -- string into a text file. Use default parameters in the call
-             -- to Image for Currency, Fill, Separator, and Radix_Mark.
- 
-             Text_IO.Put(Text_File,
-                         Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i),
-                                        Pic  => TC_Picture));
-             Text_IO.New_Line(Text_File);
- 
-             -- Use the version of Put from the instantiation of 
-             -- Decimal_Output to place an edited output string on a separate
-             -- line of the Text_File.  Use default parameters for Currency,
-             -- Fill, Separator, and Radix_Mark.
- 
-             Pack_2DP.Put(File => Text_File,
-                          Item => FXF3A00.Data_With_2DP(i),
-                          Pic  => TC_Picture);
-             Text_IO.New_Line(Text_File);
- 
-          end loop;
- 
-          Text_IO.Close(Text_File);
- 
-          -- Reopen the text file in In_File mode, and verify the edited
-          -- output found on consecutive lines of the file.
- 
-          Text_IO.Open(Text_File, Text_IO.In_File, Text_Filename);
- 
-          for i in TC_Start_Loop..TC_End_Loop_1 loop
-                -- Read successive lines in the text file.
-                Text_IO.Get_Line(Text_File, TC_String_1, TC_Last_1);
-                Text_IO.Get_Line(Text_File, TC_String_2, TC_Last_2);
- 
-             -- Compare the two strings for equality with the expected edited
-             -- output result.  Failure results if strings don't match, or if
-             -- a reading error occurred from the attempted Get_Line resulting 
-             -- from an improperly formed edited output string.
- 
-             if TC_String_1(1..TC_Last_1) /= FXF3A00.Edited_Output(i).all  or 
-                TC_String_2(1..TC_Last_2) /= FXF3A00.Edited_Output(i).all
-             then
-                Report.Failed("Failed comparison of two edited output "    &
-                              "strings from data with two decimal points " &
-                              ", loop number = " & Integer'Image(i));
-             end if;
-          end loop;
- 
-          Text_IO.Close(Text_File);
- 
-          -- Reopen the text file in Append_File mode.
-          -- Use the two versions of Put, for data with no decimal points,
-          -- to write edited output strings to the text file.  Use a separate
-          -- line for each string entry.
- 
-          Text_IO.Open(Text_File, Text_IO.Append_File, Text_Filename);
- 
-          for i in TC_Start_Loop..TC_End_Loop_2 loop               -- 1..12
- 
-             -- Create the picture object from the picture string specific to
-             -- data with no decimal points.  Use appropriate offset into the
-             -- Valid_Strings array to account for the string data used above.
- 
-             TC_Picture := 
-               Editing.To_Picture(FXF3A00.Valid_Strings(i+TC_End_Loop_1).all);
- 
-             -- Use the Text_IO version of Put to place an edited output 
-             -- string into a text file.  Use non-default parameters in the
-             -- call to Image for Currency, Fill, Separator, and Radix_Mark.
- 
-             Text_IO.Put(Text_File,
-                         Pack_NDP.Image(Item => FXF3A00.Data_With_NDP(i),
-                                        Pic  => TC_Picture,
-                                        Currency   => "$",
-                                        Fill       => '*',
-                                        Separator  => ',',
-                                        Radix_Mark => '.'));
-             Text_IO.New_Line(Text_File);
- 
-             -- Use the version of Put from the instantiation of 
-             -- Decimal_Output to place an edited output string on a separate
-             -- line of the Text_File.  Use non-default parameters for
-             -- Currency, Fill, Separator, and Radix_Mark.
- 
-             Pack_NDP.Put(File       => Text_File,
-                          Item       => FXF3A00.Data_With_NDP(i),
-                          Pic        => TC_Picture,
-                          Currency   => "$",
-                          Fill       => '*',
-                          Separator  => ',',
-                          Radix_Mark => '.');
-             Text_IO.New_Line(Text_File);
- 
-          end loop;
- 
-          Text_IO.Close(Text_File);
- 
-          -- Reopen the text file in In_File mode, and verify the edited
-          -- output found on consecutive lines of the file.
- 
-          Text_IO.Open(Text_File, Text_IO.In_File, Text_Filename);
- 
-          -- Read past data that has been verified above, skipping two lines 
-          -- of the data file for each loop.
- 
-          for i in TC_Start_Loop..TC_End_Loop_1 loop               -- 1..10
-             Text_IO.Skip_Line(Text_File, 2);
-          end loop;
- 
-          -- Verify the last data set that was written to the file.
- 
-          for i in TC_Start_Loop..TC_End_Loop_2 loop               -- 1..12
-                Text_IO.Get_Line(Text_File, TC_String_1, TC_Last_1);
-                Text_IO.Get_Line(Text_File, TC_String_2, TC_Last_2);
- 
-             -- Compare the two strings for equality with the expected edited
-             -- output result.  Failure results if strings don't match, or if
-             -- a reading error occurred from the attempted Get_Line resulting 
-             -- from an improperly formed edited output string.
- 
-             if TC_String_1(1..TC_Last_1)              /= 
-                FXF3A00.Edited_Output(i+TC_Offset).all    or 
-                TC_String_2(1..TC_Last_2)              /= 
-                FXF3A00.Edited_Output(i+TC_Offset).all
-             then
-                Report.Failed("Failed comparison of two edited output "   &
-                              "strings from data with no decimal points " &
-                              ", loop number = " & 
-                              Integer'Image(i));
-             end if;
- 
-          end loop;
- 
-       exception
-          when others => Report.Failed("Exception raised in Test_Block");
-       end Test_Block;
- 
-       -- Delete the external file.
-       if Text_IO.Is_Open (Text_File) then
-          Text_IO.Delete (Text_File);
-       else
-          Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
-          Text_IO.Delete (Text_File);
-       end if;
- 
-    exception
- 
-       -- Since Use_Error can be raised if, for the specified mode,
-       -- the environment does not support Text_IO operations, the 
-       -- following handlers are included:
- 
-       when Text_IO.Use_Error  =>
-          Report.Not_Applicable ("Use_Error raised on Text_IO Create");
- 
-       when Text_IO.Name_Error =>
-          Report.Not_Applicable ("Name_Error raised on Text_IO Create");
- 
-       when others             =>
-          Report.Failed ("Unexpected exception raised in Create block");
- 
-    end Test_for_Text_IO_Support;
- 
-    Report.Result;
- 
- end CXF3A06;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a	Thu Jan  1 00:00:00 1970
***************
*** 1,337 ****
- -- CXF3A07.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that Ada.Text_IO.Editing.Put and Ada.Strings.Fixed.Move
- --      have the same effect in putting edited output results into string
- --      variables.
- --
- -- TEST DESCRIPTION:
- --      This test is structured using tables of data, consisting of
- --      numerical values, picture strings, and expected image
- --      result strings.  These data tables are found in package FXF3A00.
- --      
- --      The operation of the two above subprograms are examined twice, first
- --      with the output of an edited output string to a receiving string
- --      object of equal size, the other to a receiving string object of 
- --      larger size, where justification and padding are considered.
- --      The procedure Editing.Put will place an edited output string into
- --      a larger receiving string with right justification and blank fill.
- --      Procedure Move has parameter control of justification and fill, and
- --      in this test will mirror Put by specifying right justification and
- --      blank fill.  
- --      
- --      In the cases where the edited output string is of shorter length 
- --      than the receiving string object, a blank-filled constant string
- --      will be catenated to the front of the expected edited output string
- --      for comparison with the receiving string object, enabling direct 
- --      string comparison for result verification.
- --      
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A07.A
- --
- --       
- -- CHANGE HISTORY:
- --      30 JAN 95   SAIC    Initial prerelease version.
- --      11 MAR 97   PWB.CTA Fixed string lengths
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Ada.Strings.Fixed;
- with Report;
- 
- procedure CXF3A07 is
- begin
- 
-    Report.Test ("CXF3A07", "Check that Ada.Text_IO.Editing.Put and "  &
-                            "Ada.Strings.Fixed.Move have the same "    &
-                            "effect in putting edited output results " &
-                            "into string variables");
-    Test_Block:
-    declare
- 
-       use Ada.Text_IO;
- 
-       -- Instantiate the Decimal_Output generic package for two
-       -- different decimal data types.
- 
-       package Pack_2DP is          -- Uses decimal type with delta 0.01.
-         new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP);
- 
-       package Pack_NDP is          -- Uses decimal type with delta 1.0.
-         new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_NDP,
-                                    Default_Currency   => "$",
-                                    Default_Fill       => '*',
-                                    Default_Separator  => ',',
-                                    Default_Radix_Mark => '.');
- 
-       TC_Picture     : Editing.Picture;
-       TC_Start_Loop  : Integer := 0;
-       TC_End_Loop    : Integer := 0;
-       TC_Offset      : Integer := 0;
-       TC_Length      : Natural := 0;
- 
-       TC_Put_String_20,                   -- Longer than the longest edited
-       TC_Move_String_20 : String(1..20);  -- output string.
- 
-       TC_Put_String_17,                   -- Exact length of longest edited
-       TC_Move_String_17 : String(1..17);  -- output string in 2DP-US data set.
-                                        
-       TC_Put_String_8,                    -- Exact length of longest edited
-       TC_Move_String_8  : String(1..8);   -- output string in NDP-US data set.
-       
- 
-    begin
- 
-       -- Examine cases where the output string is longer than the length
-       -- of the edited output result.  Use the instantiation of 
-       -- Decimal_Output specific to data with two decimal places.
- 
-       TC_Start_Loop := 1;
-       TC_End_Loop   := FXF3A00.Number_of_2DP_Items -              -- 10
-                        FXF3A00.Number_Of_Foreign_Strings;
- 
-       for i in TC_Start_Loop..TC_End_Loop loop                    -- 1..10
- 
-          -- Create the picture object from the picture string.
- 
-          TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all,
-                                           Blank_When_Zero => False);
- 
-          -- Determine the actual length of the edited output string
-          -- that is expected from Put and Image.
- 
-          TC_Length := Pack_2DP.Length(Pic      => TC_Picture,
-                                       Currency => "$");
- 
-          -- Determine the difference in length between the receiving string
-          -- object and the expected length of the edited output string.
-          -- Define a blank filled string constant with length equal to this
-          -- length difference.
- 
-          declare
-             TC_Length_Diff   : Integer := TC_Put_String_20'Length -
-                                           TC_Length;
-             TC_Buffer_String : constant String(1..TC_Length_Diff) := 
-                                           (others => ' ');
-          begin
- 
-             -- Fill the two receiving string objects with edited output,
-             -- using the two different methods (Put and Move).
- 
-             Pack_2DP.Put(To         => TC_Put_String_20,
-                          Item       => FXF3A00.Data_With_2DP(i),
-                          Pic        => TC_Picture,
-                          Currency   => "$",
-                          Fill       => '*',
-                          Separator  => ',',
-                          Radix_Mark => '.');
- 
- 
-             Ada.Strings.Fixed.Move
-               (Source  => Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i),
-                                          Pic        => TC_Picture,
-                                          Currency   => "$",
-                                          Fill       => '*',
-                                          Separator  => ',',
-                                          Radix_Mark => '.'),
-                Target  => TC_Move_String_20,
-                Drop    => Ada.Strings.Error,
-                Justify => Ada.Strings.Right,
-                Pad     => Ada.Strings.Space);
- 
-             -- Each receiving string object is now filled with the edited
-             -- output result, right justified.
-             -- Compare these two string objects with the expected edited
-             -- output value, which is appended to the blank filled string
-             -- whose length is the difference between the expected edited
-             -- output length and the length of the receiving strings.
- 
-             if TC_Buffer_String & FXF3A00.Edited_Output(i).all  /=
-                TC_Put_String_20                                    or
-                TC_Buffer_String & FXF3A00.Edited_Output(i).all  /=
-                TC_Move_String_20
-             then
-                Report.Failed("Failed case where the output string is " &
-                              "longer than the length of the edited "   &
-                              "output result, loop #" & Integer'Image(i));
-             end if;
- 
-          exception
-             when Layout_Error =>
-                Report.Failed("Layout_Error raised when the output string " &
-                              "is longer than the length of the edited "    &
-                              "output result, loop #" & Integer'Image(i));
-             when others       =>
-                Report.Failed("Exception raised when the output string is " &
-                              "longer than the length of the edited "       &
-                              "output result, loop #" & Integer'Image(i));
-          end;
-       end loop;
- 
- 
-       -- Repeat the above loop, but only evaluate three cases - those where
-       -- the length of the expected edited output string is the exact length 
-       -- of the receiving strings (no justification will be required within
-       -- the string.  This series of evaluations again uses decimal data
-       -- with two decimal places.
- 
-       for i in TC_Start_Loop..TC_End_Loop loop                    -- 1..10
- 
-          case i is
-             when 1 | 5 | 7 =>
- 
-                -- Create the picture object from the picture string.
-                TC_Picture := 
-                  Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
- 
-                -- Fill the two receiving string objects with edited output,
-                -- using the two different methods (Put and Move).
-                -- Use default parameters in the various calls where possible.
- 
-                Pack_2DP.Put(To         => TC_Put_String_17,
-                             Item       => FXF3A00.Data_With_2DP(i),
-                             Pic        => TC_Picture);
- 
- 
-                Ada.Strings.Fixed.Move
-                  (Source  => Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i),
-                                             Pic  => TC_Picture),
-                   Target  => TC_Move_String_17);
- 
-                -- Each receiving string object is now filled with the edited
-                -- output result. Compare these two string objects with the 
-                -- expected edited output value. 
- 
-                if FXF3A00.Edited_Output(i).all  /= TC_Put_String_17  or
-                   FXF3A00.Edited_Output(i).all  /= TC_Move_String_17
-                then
-                   Report.Failed("Failed case where the output string is " &
-                                 "the exact length of the edited output "  &
-                                 "result, loop #" & Integer'Image(i));
-                end if;
- 
-             when others => null;
-          end case;
-       end loop;
- 
- 
-       -- Evaluate a mix of cases, where the expected edited output string
-       -- length is either exactly as long or shorter than the receiving
-       -- output string parameter.  This series of evaluations uses decimal
-       -- data with no decimal places.
- 
-       TC_Start_Loop := TC_End_Loop + 1;                           -- 11
-       TC_End_Loop   := TC_Start_Loop +                            -- 22
-                        FXF3A00.Number_of_NDP_Items - 1;               
-       TC_Offset     := FXF3A00.Number_of_Foreign_Strings;         -- 10
-       -- This offset is required due to the arrangement of data within the
-       -- tables found in FXF3A00.
- 
-       for i in TC_Start_Loop..TC_End_Loop loop                    -- 11..22
- 
-          -- Create the picture object from the picture string.
- 
-          TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
- 
-          -- Determine the actual length of the edited output string
-          -- that is expected from Put and Image.
- 
-          TC_Length := Pack_NDP.Length(TC_Picture);
- 
-          -- Fill the two receiving string objects with edited output,
-          -- using the two different methods (Put and Move).
- 
-          Pack_NDP.Put(TC_Put_String_8,
-                       FXF3A00.Data_With_NDP(i-TC_Offset),
-                       TC_Picture);
- 
-          Ada.Strings.Fixed.Move
-            (Pack_NDP.Image(FXF3A00.Data_With_NDP(i-TC_Offset), TC_Picture),
-             TC_Move_String_8,
-             Ada.Strings.Error,
-             Ada.Strings.Right,
-             Ada.Strings.Space);
- 
-          -- Determine if there is a difference in length between the 
-          -- receiving string object and the expected length of the edited 
-          -- output string.  If so, then define a blank filled string constant 
-          -- with length equal to this length difference.
- 
-          if TC_Length < TC_Put_String_8'Length then
-             declare
-                TC_Length_Diff   : Integer := TC_Put_String_8'Length -
-                                              TC_Length;
-                TC_Buffer_String : constant String(1..TC_Length_Diff) := 
-                                           (others => ' ');
-             begin
- 
-                -- Each receiving string object is now filled with the edited
-                -- output result, right justified.
-                -- Compare these two string objects with the expected edited
-                -- output value, which is appended to the blank filled string
-                -- whose length is the difference between the expected edited
-                -- output length and the length of the receiving strings.
- 
-                if TC_Buffer_String & FXF3A00.Edited_Output(i+TC_Offset).all /=
-                   TC_Put_String_8                                           or
-                   TC_Buffer_String & FXF3A00.Edited_Output(i+TC_Offset).all /=
-                   TC_Move_String_8
-                then
-                   Report.Failed("Failed case where the output string is "  &
-                                 "longer than the length of the edited "    &
-                                 "output result, loop #" & Integer'Image(i) &
-                                 ", using data with no decimal places");
-                end if;
-             end;
-          else
- 
-             -- Compare these two string objects with the expected edited
-             -- output value, which is appended to the blank filled string
-             -- whose length is the difference between the expected edited
-             -- output length and the length of the receiving strings.
- 
-             if FXF3A00.Edited_Output(i+TC_Offset).all /= TC_Put_String_8 or
-                FXF3A00.Edited_Output(i+TC_Offset).all /= TC_Move_String_8
-             then
-                Report.Failed("Failed case where the output string is "  &
-                              "the same length as the edited output "    &
-                              "result, loop #" & Integer'Image(i)        &
-                              ", using data with no decimal places");
-             end if;
-          end if;
-       end loop;
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3A07;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a	Thu Jan  1 00:00:00 1970
***************
*** 1,289 ****
- -- CXF3A08.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the version of Ada.Text_IO.Editing.Put with an out 
- --      String parameter propagates Layout_Error if the edited output string 
- --      result of Put exceeds the length of the out String parameter.
- --      
- -- TEST DESCRIPTION:
- --      This test is structured using tables of data, consisting of
- --      numerical values, picture strings, and expected image
- --      result strings.  These data tables are found in package FXF3A00.
- --      
- --      This test examines the case of the out string parameter to Procedure
- --      Put being insufficiently long to hold the entire edited output
- --      string result of the procedure.  In this case, Layout_Error is to be
- --      raised.  Test failure results if Layout_Error is not raised, or if an
- --      exception other than Layout_Error is raised.
- --      
- --      A number of data combinations are examined, using instantiations 
- --      of Package Decimal_Output with different decimal data types and 
- --      both default and non-default parameters as generic actual parameters.
- --      In addition, calls to Procedure Put are performed using default 
- --      parameters, non-default parameters, and non-default parameters that 
- --      override the generic actual parameters provided at the time of 
- --      instantiation of Decimal_Output.
- --      
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         FXF3A00.A   (foundation code)
- --      => CXF3A08.A
- --
- --       
- -- CHANGE HISTORY:
- --      31 JAN 95   SAIC    Initial prerelease version.
- --
- --!
- 
- with FXF3A00;
- with Ada.Text_IO.Editing;
- with Report;
- 
- procedure CXF3A08 is
- begin
- 
-    Report.Test ("CXF3A08", "Check that the version of "                &
-                            "Ada.Text_IO.Editing.Put with an out "      &
-                            "String parameter propagates Layout_Error " &
-                            "if the output string exceeds the length "  &
-                            "of the out String parameter");
- 
-    Test_Block:
-    declare
- 
-       use Ada.Text_IO;
- 
-       -- Instantiate the Decimal_Output generic package for two
-       -- different decimal data types.
-                                    -- Uses decimal type with delta 0.01 and
-       package Pack_2DP is          -- non-default generic actual parameters.
-         new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP,
-                                    Default_Currency   => "$",
-                                    Default_Fill       => '*',
-                                    Default_Separator  => ',',
-                                    Default_Radix_Mark => '.');
- 
-       package Pack_NDP is          -- Uses decimal type with delta 1.0.
-         new Editing.Decimal_Output(FXF3A00.Decimal_Type_NDP);
- 
-       TC_Picture       : Editing.Picture;
-       TC_Start_Loop    : Integer := 0;
-       TC_End_Loop      : Integer := 0;
-       TC_Offset        : Integer := 0;
- 
-       TC_Short_String  : String(1..4);   -- Shorter than the shortest edited
-                                          -- output string result.
- 
-    begin
- 
-       -- Examine cases where the out string parameter is shorter than 
-       -- the length of the edited output result.  Use the instantiation of 
-       -- Decimal_Output specific to data with two decimal places.
- 
-       TC_Start_Loop := 1;
-       TC_End_Loop   := FXF3A00.Number_of_2DP_Items -              -- 10
-                        FXF3A00.Number_Of_Foreign_Strings;
- 
-       for i in TC_Start_Loop..TC_End_Loop loop                    -- 1..10
- 
-          -- Create the picture object from the picture string.
- 
-          TC_Picture := 
-            Editing.To_Picture(Pic_String => FXF3A00.Valid_Strings(i).all,
-                               Blank_When_Zero => False);
- 
-          -- The out parameter string provided in the call to Put is 
-          -- shorter than the edited output result of the procedure.  
-          -- This will result in a Layout_Error being raised and handled.
-          -- Test failure results from no exception being raised, or from
-          -- the wrong exception being raised.
- 
-          begin
- 
-             -- Use the instantiation of Decimal_Output specific to decimal
-             -- data with two decimal places, as well as non-default 
-             -- parameters and named parameter association.
- 
-             Pack_2DP.Put(To         => TC_Short_String,
-                          Item       => FXF3A00.Data_With_2DP(i),
-                          Pic        => TC_Picture,
-                          Currency   => "$",
-                          Fill       => '*',
-                          Separator  => ',',
-                          Radix_Mark => '.');
- 
-             -- Test failure if exception not raised.
- 
-             Report.Failed
-               ("Layout_Error not raised, decimal data with two decimal " &
-                "places, loop #" & Integer'Image(i));
- 
-          exception
-             when Layout_Error => null;  -- OK, expected exception.
-             when others       =>
-                Report.Failed
-                  ("Incorrect exception raised, Layout_Error expected, " &
-                   "decimal data with two decimal places, loop #"        &
-                   Integer'Image(i));
-          end;
-       end loop;
- 
- 
-       -- Perform similar evaluations as above, but use the instantiation
-       -- of Decimal_Output specific to decimal data with no decimal places.
- 
-       TC_Start_Loop := TC_End_Loop + 1;                           -- 11
-       TC_End_Loop   := TC_Start_Loop +                            -- 22
-                        FXF3A00.Number_of_NDP_Items - 1;               
-       TC_Offset     := FXF3A00.Number_of_Foreign_Strings;         -- 10
-       -- This offset is required due to the arrangement of data within the
-       -- tables found in FXF3A00.
- 
-       for i in TC_Start_Loop..TC_End_Loop loop                    -- 11..22
- 
-          -- Create the picture object from the picture string.
- 
-          TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
- 
-          begin
- 
-             -- Use the instantiation of Decimal_Output specific to decimal
-             -- data with no decimal places, as well as default parameters
-             -- and positional parameter association.
- 
-             Pack_NDP.Put(TC_Short_String,
-                          FXF3A00.Data_With_NDP(i-TC_Offset),
-                          TC_Picture);
- 
-             -- Test failure if exception not raised.
- 
-             Report.Failed
-               ("Layout_Error not raised, decimal data with no decimal " &
-                "places, loop #" & Integer'Image(i));
- 
-          exception
-             when Layout_Error => null;  -- OK, expected exception.
-             when others       =>
-                Report.Failed
-                  ("Incorrect exception raised, Layout_Error expected, " &
-                   "decimal data with no decimal places, loop #"         &
-                   Integer'Image(i));
-          end;
- 
-       end loop;
- 
- 
-       -- Check that Layout_Error is raised by Put resulting from an
-       -- instantiation of Decimal_Output specific to foreign currency
-       -- representations. 
-       -- Note: Both of the following evaluation sets use decimal data with 
-       --       two decimal places.
- 
-       declare
- 
-          package Pack_FF is 
-            new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP,
-                                       Default_Currency   => "FF",
-                                       Default_Fill       => '*',
-                                       Default_Separator  => '.',
-                                       Default_Radix_Mark => ',');
- 
-       begin
- 
-          TC_Offset := FXF3A00.Number_Of_2DP_Items -                 -- 10
-                       FXF3A00.Number_Of_Foreign_Strings;
- 
-          for i in 1..FXF3A00.Number_Of_FF_Strings loop              -- 1..4
-             begin
- 
-                -- Create the picture object from the picture string.
-                TC_Picture := 
-                  Editing.To_Picture(FXF3A00.Foreign_Strings(i).all);
- 
-                Pack_FF.Put(To   => TC_Short_String,
-                            Item => FXF3A00.Data_With_2DP(i+TC_Offset),
-                            Pic  => TC_Picture);
- 
-                Report.Failed("Layout_Error was not raised by Put from "  &
-                              "an instantiation of Decimal_Output using " &
-                              "non-default parameters specific to FF "    &
-                              "currency, loop #" & Integer'Image(i));
- 
-             exception
-                when Layout_Error => null;  -- OK, expected exception.
-                when others       =>
-                   Report.Failed("Incorrect exception raised by Put from "   &
-                                 "an instantiation of Decimal_Output using " &
-                                 "non-default parameters specific to FF "    &
-                                 "currency, loop #" & Integer'Image(i));
-             end;
-          end loop;
- 
- 
-          -- These evaluations use a version of Put resulting from a 
-          -- non-default instantiation of Decimal_Output, but which has 
-          -- specific foreign currency parameters provided in the call that
-          -- override the generic actual parameters provided at instantiation.
- 
-          TC_Offset := TC_Offset + FXF3A00.Number_Of_FF_Strings;      -- 14
- 
-          for i in 1..FXF3A00.Number_Of_DM_Strings loop               -- 1..5
-             begin
-                TC_Picture := 
-                  Editing.To_Picture(FXF3A00.Foreign_Strings
-                                       (i+FXF3A00.Number_Of_FF_Strings).all);
- 
-                Pack_2DP.Put(To         => TC_Short_String,
-                             Item       => FXF3A00.Data_With_2DP(i+TC_Offset),
-                             Pic        => TC_Picture,
-                             Currency   => "DM",
-                             Fill       => '*',
-                             Separator  => ',',
-                             Radix_Mark => '.');
- 
-                Report.Failed("Layout_Error was not raised by Put using " &
-                              "non-default parameters specific to DM "    &
-                              "currency, loop #" & Integer'Image(i));
- 
-             exception
-                when Layout_Error => null;  -- OK, expected exception.
-                when others       =>
-                   Report.Failed("Incorrect exception raised by Put using " &
-                                 "non-default parameters specific to DM "   &
-                                 "currency, loop #" & Integer'Image(i));
-             end;
-          end loop;
- 
-       end;
- 
-    exception
-       when others => Report.Failed("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXF3A08;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,276 ****
- -- CXG1001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in the package
- --      Ada.Numerics.Generic_Complex_Types provide correct results.  
- --      Specifically, check the functions Re, Im (both versions), procedures
- --      Set_Re, Set_Im (both versions), functions Compose_From_Cartesian (all
- --      versions), Compose_From_Polar, Modulus, Argument, and "abs".
- --
- -- TEST DESCRIPTION:
- --      The generic package Generic_Complex_Types 
- --      is instantiated with a real type (new Float), and the results
- --      produced by the specified subprograms are verified.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      15 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
- --                          Modified subtest for Compose_From_Polar.
- --      29 Sep 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Ada.Numerics.Generic_Complex_Types;
- with Report;
- 
- procedure CXG1001 is
- 
- begin
- 
-    Report.Test ("CXG1001", "Check that the subprograms defined in " &
-                            "the package Ada.Numerics.Generic_Complex_Types " & 
-                            "provide correct results");
- 
-    Test_Block:
-    declare
- 
-       type Real_Type is new Float;
- 
-       package Complex_Pack is new 
-         Ada.Numerics.Generic_Complex_Types(Real_Type);
- 
-       use type Complex_Pack.Complex;
- 
-       -- Declare a zero valued complex number.
-       Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0);
- 
-       TC_Complex   : Complex_Pack.Complex := Complex_Zero;
-       TC_Imaginary : Complex_Pack.Imaginary;    
- 
-    begin
- 
-       -- Check that the procedures Set_Re and Set_Im (both versions) provide
-       -- correct results.
- 
-       declare
-          TC_Complex_Real_Field : Complex_Pack.Complex := (5.0, 0.0);
-          TC_Complex_Both_Fields : Complex_Pack.Complex := (5.0, 7.0);
-       begin
- 
-          Complex_Pack.Set_Re(X => TC_Complex, Re => 5.0);
- 
-          if TC_Complex /= TC_Complex_Real_Field then
-             Report.Failed("Incorrect results from Procedure Set_Re");
-          end if;
- 
-          Complex_Pack.Set_Im(X => TC_Complex, Im => 7.0);
- 
-          if TC_Complex.Re /= 5.0 or
-             TC_Complex.Im /= 7.0 or
-             TC_Complex    /= TC_Complex_Both_Fields 
-          then
-             Report.Failed("Incorrect results from Procedure Set_Im " &
-                           "with Complex argument");
-          end if;
- 
-          Complex_Pack.Set_Im(X => TC_Imaginary, Im => 3.0);
- 
- 
-          if Complex_Pack.Im(TC_Imaginary) /= 3.0 then
-             Report.Failed("Incorrect results returned following the use " &
-                           "of Procedure Set_Im with Imaginary argument");
-          end if;
- 
-       end;
- 
- 
-       -- Check that the functions Re and Im (both versions) provide
-       -- correct results.
- 
-       declare
-          TC_Complex_1 : Complex_Pack.Complex := (1.0, 0.0);
-          TC_Complex_2 : Complex_Pack.Complex := (0.0, 2.0);
-          TC_Complex_3 : Complex_Pack.Complex := (4.0, 3.0);
-       begin
- 
-          -- Function Re.
- 
-          if Complex_Pack.Re(X => TC_Complex_1) /= 1.0  or
-             Complex_Pack.Re(X => TC_Complex_2) /= 0.0  or
-             Complex_Pack.Re(X => TC_Complex_3) /= 4.0 
-          then
-             Report.Failed("Incorrect results from Function Re");
-          end if;
- 
-          -- Function Im; version with Complex argument.
- 
-          if Complex_Pack.Im(X => TC_Complex_1) /= 0.0  or
-             Complex_Pack.Im(X => TC_Complex_2) /= 2.0  or
-             Complex_Pack.Im(X => TC_Complex_3) /= 3.0 
-          then
-             Report.Failed("Incorrect results from Function Im " &
-                           "with Complex argument");
-          end if;
- 
- 
-          -- Function Im; version with Imaginary argument.
- 
-          if Complex_Pack.Im(Complex_Pack.i) /= 1.0  or
-             Complex_Pack.Im(Complex_Pack.j) /= 1.0
-          then
-             Report.Failed("Incorrect results from use of Function Im " &
-                           "when used with an Imaginary argument");
-          end if;
- 
-       end;
- 
- 
-       -- Verify the results of the three versions of Function
-       -- Compose_From_Cartesian
- 
-       declare
- 
-          Zero  : constant Real_Type := 0.0;
-          Six   : constant Real_Type := 6.0;
- 
-          TC_Complex_1 : Complex_Pack.Complex := (3.0, 8.0);
-          TC_Complex_2 : Complex_Pack.Complex := (Six, Zero);
-          TC_Complex_3 : Complex_Pack.Complex := (Zero, 1.0);
- 
-       begin
- 
-          TC_Complex := Complex_Pack.Compose_From_Cartesian(3.0, 8.0);
- 
-          if TC_Complex /= TC_Complex_1 then
-             Report.Failed("Incorrect results from Function " &
-                           "Compose_From_Cartesian - 1");
-          end if;
- 
-          -- If only one component is given, the other component is 
-          -- implicitly zero (Both components are set by the following two
-          -- function calls).
- 
-          TC_Complex := Complex_Pack.Compose_From_Cartesian(Re => 6.0);
- 
-          if TC_Complex /= TC_Complex_2 then
-             Report.Failed("Incorrect results from Function " &
-                           "Compose_From_Cartesian - 2");
-          end if;
- 
-          TC_Complex := 
-            Complex_Pack.Compose_From_Cartesian(Im => Complex_Pack.i);
- 
-          if TC_Complex /= TC_Complex_3 then
-             Report.Failed("Incorrect results from Function " &
-                           "Compose_From_Cartesian - 3");
-          end if;
- 
-       end; 
- 
- 
-       -- Verify the results of Function Compose_From_Polar, Modulus, "abs",
-       -- and Argument.
- 
-       declare
- 
-          use Complex_Pack;
- 
-          TC_Modulus,
-          TC_Argument : Real_Type := 0.0;
- 
- 
-          Angle_0     : constant Real_Type :=   0.0;
-          Angle_90    : constant Real_Type :=  90.0;
-          Angle_180   : constant Real_Type := 180.0;
-          Angle_270   : constant Real_Type := 270.0;
-          Angle_360   : constant Real_Type := 360.0;
- 
-       begin
- 
-          -- Verify the result of Function Compose_From_Polar.
-          -- When the value of the parameter Modulus is zero, the 
-          -- Compose_From_Polar function yields a result of zero.
- 
-          if Compose_From_Polar(0.0, 30.0, 360.0) /= Complex_Zero
-          then
-             Report.Failed("Incorrect result from Function " &
-                           "Compose_From_Polar - 1");
-          end if;
- 
-          -- When the value of the parameter Argument is equal to a multiple
-          -- of the quarter cycle, the result of the Compose_From_Polar
-          -- function with specified cycle lies on one of the axes.
- 
-          if Compose_From_Polar( 5.0,  Angle_0,   Angle_360) /= (5.0,  0.0) or
-             Compose_From_Polar( 5.0,  Angle_90,  Angle_360) /= (0.0,  5.0) or
-             Compose_From_Polar(-5.0,  Angle_180, Angle_360) /= (5.0,  0.0) or
-             Compose_From_Polar(-5.0,  Angle_270, Angle_360) /= (0.0,  5.0) or
-             Compose_From_Polar(-5.0,  Angle_90,  Angle_360) /= (0.0, -5.0) or
-             Compose_From_Polar( 5.0,  Angle_270, Angle_360) /= (0.0, -5.0) 
-          then
-             Report.Failed("Incorrect result from Function " &
-                           "Compose_From_Polar - 2");
-          end if;
- 
-          -- When the parameter to Function Argument represents a point on 
-          -- the non-negative real axis, the function yields a zero result.
- 
-          if Argument(Complex_Zero, Angle_360) /= 0.0 then
-             Report.Failed("Incorrect result from Function Argument");
-          end if;
- 
-          -- Function Modulus
- 
-          if Modulus(Complex_Zero) /= 0.0  or
-             Modulus(Compose_From_Polar( 5.0, Angle_90,  Angle_360)) /= 5.0 or
-             Modulus(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 
-          then
-             Report.Failed("Incorrect results from Function Modulus");
-          end if;
- 
-          -- Function "abs", a rename of Function Modulus.
- 
-          if "abs"(Complex_Zero) /= 0.0  or
-             "abs"(Compose_From_Polar( 5.0, Angle_90,  Angle_360)) /= 5.0 or
-             "abs"(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 
-          then
-             Report.Failed("Incorrect results from Function abs");
-          end if;
- 
-       end;
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXG1001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,198 ****
- -- CXG1002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in the package
- --      Ada.Numerics.Generic_Complex_Types provide the prescribed results.  
- --      Specifically, check the various versions of functions "+" and "-".
- --
- -- TEST DESCRIPTION:
- --      This test checks that the subprograms "+" and "-" defined in the 
- --      Generic_Complex_Types package provide the results prescribed for the
- --      evaluation of these complex arithmetic operations.  The functions
- --      Re and Im are used to extract the appropriate component of the 
- --      complex result, in order that the prescribed result component can be
- --      verified.
- --      The generic package is instantiated with a real type (new Float), 
- --      and the results produced by the specified subprograms are verified.
- --
- -- SPECIAL REQUIREMENTS:
- --      This test can be run in either "relaxed" or "strict" mode.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --
- --!
- 
- with Ada.Numerics.Generic_Complex_Types;
- with Report;
- 
- procedure CXG1002 is
- 
- begin
- 
-    Report.Test ("CXG1002", "Check that the subprograms defined in " &
-                            "the package Ada.Numerics.Generic_Complex_Types " & 
-                            "provide the prescribed results");
- 
-    Test_Block:
-    declare
- 
-       type Real_Type is new Float;
- 
-       package Complex_Pack is new 
-         Ada.Numerics.Generic_Complex_Types(Real_Type);
-       use Complex_Pack;
- 
-       -- Declare a zero valued complex number using the record
-       -- aggregate approach.
- 
-       Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0);
- 
-       TC_Complex,
-       TC_Complex_Right,
-       TC_Complex_Left   : Complex_Pack.Complex := Complex_Zero;
- 
-       TC_Real           : Real_Type := 0.0;
- 
-       TC_Imaginary      : Complex_Pack.Imaginary;
- 
-    begin
- 
- 
-       -- Check that the imaginary component of the result of a binary addition
-       -- operator that yields a result of complex type is exact when either
-       -- of its operands is of pure-real type.
- 
-       TC_Complex := Compose_From_Cartesian(2.0, 3.0);
-       TC_Real    := 3.0;
- 
-       if Im("+"(Left => TC_Complex, Right => TC_Real))  /=  3.0 or
-          Im("+"(TC_Complex, 6.0))                       /=  3.0 or
-          Im(TC_Complex + TC_Real)                       /=  3.0 or
-          Im(TC_Complex + 5.0)                           /=  3.0 or
-          Im((7.0, 2.0) + 1.0)                           /=  2.0 or
-          Im((7.0, 5.0) + (-2.0))                        /=  5.0 or
-          Im((-7.0, -2.0) + 1.0)                         /= -2.0 or
-          Im((-7.0, -3.0) + (-3.0))                      /= -3.0
-       then 
-          Report.Failed("Incorrect results from Function ""+"" with " &
-                        "one Complex and one Real argument - 1");
-       end if;
- 
-       if Im("+"(Left => TC_Real, Right => TC_Complex))  /=   3.0  or
-          Im("+"(4.0, TC_Complex))                       /=   3.0  or
-          Im(TC_Real + TC_Complex)                       /=   3.0  or
-          Im(9.0 + TC_Complex)                           /=   3.0  or
-          Im(1.0 + (7.0, -9.0))                          /=  -9.0  or
-          Im((-2.0) + (7.0, 2.0))                        /=   2.0  or
-          Im(1.0 + (-7.0, -5.0))                         /=  -5.0  or
-          Im((-3.0) + (-7.0, 16.0))                      /=  16.0
-       then 
-          Report.Failed("Incorrect results from Function ""+"" with " &
-                        "one Complex and one Real argument - 2");
-       end if;
- 
- 
-       -- Check that the imaginary component of the result of a binary 
-       -- subtraction operator that yields a result of complex type is exact
-       -- when its right operand is of pure-real type.
- 
-       TC_Complex := (8.0, -4.0);
-       TC_Real    := 2.0;
- 
-       if Im("-"(Left => TC_Complex, Right => TC_Real))  /=  -4.0  or
-          Im("-"(TC_Complex, 5.0))                       /=  -4.0  or
-          Im(TC_Complex - TC_Real)                       /=  -4.0  or
-          Im(TC_Complex - 4.0)                           /=  -4.0  or
-          Im((6.0, 5.0) - 1.0)                           /=   5.0  or
-          Im((6.0, 13.0) - 7.0)                          /=  13.0  or
-          Im((-5.0, 3.0) - (2.0))                        /=   3.0  or
-          Im((-5.0, -6.0) - (-3.0))                      /=  -6.0 
-       then 
-          Report.Failed("Incorrect results from Function ""-"" with " &
-                        "one Complex and one Real argument");
-       end if;
- 
- 
-       -- Check that the real component of the result of a binary addition
-       -- operator that yields a result of complex type is exact when either
-       -- of its operands is of pure-imaginary type.
- 
-       TC_Complex := (5.0, 0.0);
- 
-       if Re("+"(Left => TC_Complex, Right => i))  /=   5.0 or
-          Re("+"(Complex_Pack.j, TC_Complex))      /=   5.0 or
-          Re((-8.0,  5.0) + ( 2.0*i))              /=  -8.0 or
-          Re((2.0,  5.0) + (-2.0*i))               /=   2.0 or
-          Re((-20.0, -5.0) + ( 3.0*i))             /= -20.0 or
-          Re((6.0, -5.0) + (-3.0*i))               /=   6.0
-       then
-          Report.Failed("Incorrect results from Function ""+"" with " &
-                        "one Complex and one Imaginary argument");
-       end if;
- 
- 
-       -- Check that the real component of the result of a binary 
-       -- subtraction operator that yields a result of complex type is exact
-       -- when its right operand is of pure-imaginary type.
- 
-       TC_Complex := TC_Complex + i;    -- Should produce (5.0, 1.0)
- 
-       if Re("-"(TC_Complex, i))                   /=  5.0 or
-          Re((-4.0,  4.0) - ( 2.0*i))              /= -4.0 or
-          Re((9.0,  4.0) - ( 5.0*i))               /=  9.0 or
-          Re((16.0, -5.0) - ( 3.0*i))              /= 16.0 or
-          Re((-3.0, -5.0) - (-4.0*i))              /= -3.0
-       then
-          Report.Failed("Incorrect results from Function ""-"" with " &
-                        "one Complex and one Imaginary argument");
-       end if;
- 
- 
-       -- Check that the result of a binary addition operation is exact when
-       -- one of its operands is of real type and the other is of 
-       -- pure-imaginary type; the operator is analogous to the 
-       -- Compose_From_Cartesian function; it performs no arithmetic.
- 
-       TC_Complex := Complex_Pack."+"(5.0, Complex_Pack.i);
- 
-       if TC_Complex                   /= (5.0, 1.0) or
-          (4.0 + i)                    /= (4.0, 1.0) or
-          "+"(Left => j, Right => 3.0) /= (3.0, 1.0) 
-       then
-          Report.Failed("Incorrect results from Function ""+"" with " &
-                        "one Real and one Imaginary argument");
-       end if;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXG1002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,478 ****
- -- CXG1003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in the package Text_IO.Complex_IO
- --      provide correct results.  
- --
- -- TEST DESCRIPTION:
- --      The generic package Ada.Numerics.Generic_Complex_Types is instantiated 
- --      with a real type (new Float). The resulting new package is used as
- --      the generic actual to package Complex_IO.
- --      Two different versions of Put and Get are examined in this test, 
- --      those that input/output complex data values from/to Text_IO files,
- --      and those that input/output complex data values from/to strings.
- --      Two procedures are defined to perform the file data manipulations;
- --      one to place complex data into the file, and one to retrieve the data
- --      from the file and verify its correctness.
- --      Complex data is also put into string variables using the Procedure
- --      Put for strings, and this data is then retrieved and reconverted into
- --      complex values using the Get procedure.
- --
- --
- -- APPLICABILITY CRITERIA: 
- --      This test is only applicable to implementations that:
- --         support Annex G,
- --         support Text_IO and external files
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      29 Dec 94   SAIC    Modified Width parameter in Get function calls.
- --      16 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
- --      29 Sep 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Ada.Text_IO.Complex_IO;
- with Ada.Numerics.Generic_Complex_Types;
- with Report;
- 
- procedure CXG1003 is
- begin
- 
-    Report.Test ("CXG1003", "Check that the subprograms defined in " &
-                            "the package Text_IO.Complex_IO " & 
-                            "provide correct results");
- 
-    Test_for_Text_IO_Support:
-    declare
-       use Ada;
- 
-       Data_File     : Ada.Text_IO.File_Type;
-       Data_Filename : constant String := Report.Legal_File_Name;
- 
-    begin
- 
-       -- An application creates a text file in mode Out_File, with the 
-       -- intention of entering complex data into the file as appropriate.  
-       -- In the event that the particular environment where the application 
-       -- is running does not support Text_IO, Use_Error or Name_Error will be 
-       -- raised on calls to Text_IO operations.  Either of these exceptions
-       -- will be handled to produce a Not_Applicable result.
- 
-       Text_IO.Create (File => Data_File,
-                       Mode => Ada.Text_IO.Out_File,
-                       Name => Data_Filename);
- 
-       Test_Block:
-       declare
- 
-          TC_Verbose : Boolean := False;
- 
-          type Real_Type is new Float;
- 
-          package Complex_Pack is new 
-            Ada.Numerics.Generic_Complex_Types(Real_Type);
- 
-          package C_IO is new Ada.Text_IO.Complex_IO(Complex_Pack);
- 
-          use Ada.Text_IO, C_IO;
-          use type Complex_Pack.Complex;
- 
-          Number_Of_Complex_Items : constant := 6;
-          Number_Of_Error_Items   : constant := 2;
- 
-          TC_Complex              : Complex_Pack.Complex;
-          TC_Last_Character_Read  : Positive;
- 
-          Complex_Array : array (1..Number_Of_Complex_Items) 
-            of Complex_Pack.Complex := ( (3.0, 9.0),
-                                         (4.0, 7.0),
-                                         (5.0, 6.0),
-                                         (6.0, 3.0),
-                                         (2.0, 5.0),
-                                         (3.0, 7.0) );
- 
- 
-          procedure Load_Data_File (The_File : in out Text_IO.File_Type) is
-             use Ada.Text_IO;
-          begin
-             -- This procedure does not create, open, or close the data file;
-             -- The_File file object must be Open at this point.
-             -- This procedure is designed to load complex data into a data 
-             -- file twice, first using Text_IO, then Complex_IO.  In this
-             -- first case, the complex data values are entered as strings,
-             -- assuming a variety of legal formats, as provided in the 
-             -- reference manual.
- 
-             Put_Line(The_File, "(3.0, 9.0)");
-             Put_Line(The_File, "+4. +7.");    -- Relaxed real literal format.
-             Put_Line(The_File, "(5.0 6.)");
-             Put_Line(The_File, "6., 3.0");
-             Put_Line(The_File, "  (  2.0  ,  5.0  )  ");
-             Put_Line(The_File, "(");           -- Complex data separated over
-             Put_Line(The_File, "3.0");         -- several (5) lines.
-             Put_Line(The_File, " , ");        
-             Put_Line(The_File, "7.0  ");
-             Put_Line(The_File, ")");
- 
-             if TC_Verbose then
-                Report.Comment("Complex values entered into data file using " &
-                               "Text_IO, Procedure Load_Data_File");
-             end if;
- 
-             -- Use the Complex_IO procedure Put to enter Complex data items
-             -- into the data file.
-             -- Note: Data is being entered into the file for the *second* time
-             --       at this point. (Using Complex_IO here, Text_IO above)
- 
-             for i in 1..Number_Of_Complex_Items loop
-                C_IO.Put(File => The_File, 
-                         Item => Complex_Array(i), 
-                         Fore => 1, 
-                         Aft  => 1, 
-                         Exp  => 0);
-             end loop;
- 
-             if TC_Verbose then
-                Report.Comment("Complex values entered into data file using " &
-                               "Complex_IO, Procedure Load_Data_File");
-             end if;
- 
-             Put_Line(The_File, "(5A,3)");      -- data to raise Data_Error.
-             Put_Line(The_File, "(3.0,,8.0)");  -- data to raise Data_Error.
- 
-          end Load_Data_File;
- 
- 
- 
-          procedure Process_Data_File (The_File : in out Text_IO.File_Type) is
-              TC_Complex : Complex_Pack.Complex := (0.0, 0.0);
-              TC_Width   : Integer := 0;
-          begin
-             -- This procedure does not create, open, or close the data file;
-             -- The_File file object must be Open at this point.
-             -- Use procedure Get (for Files) to extract the complex data from
-             -- the Text_IO file.  This data was placed into the file using
-             -- Text_IO.
- 
- 
-             for i in 1..Number_Of_Complex_Items loop
-            
-                C_IO.Get(The_File, TC_Complex, TC_Width);
- 
-                if TC_Complex /= Complex_Array(i) then
-                   Report.Failed("Incorrect complex data read from file " &
-                                 "when using Text_IO procedure Get, "     &
-                                 "data item #" & Integer'Image(i));
-                end if;
-             end loop;
- 
-             if TC_Verbose then
-                Report.Comment("First set of complex values extracted " &
-                               "from data file using Complex_IO, "      &
-                               "Procedure Process_Data_File");
-             end if;
- 
-             -- Use procedure Get (for Files) to extract the complex data from
-             -- the Text_IO file.  This data was placed into the file using
-             -- procedure Complex_IO.Put.
-             -- Note: Data is being extracted from the file for the *second*
-             --       time at this point (Using Complex_IO here, Text_IO above)
- 
-             for i in 1..Number_Of_Complex_Items loop
-     
-                C_IO.Get(The_File, TC_Complex, TC_Width);
-           
-                if TC_Complex /= Complex_Array(i) then
-                   Report.Failed("Incorrect complex data read from file " &
-                                 "when using Complex_IO procedure Get, "  &
-                                 "data item #" & Integer'Image(i));
-                end if;
-             end loop;
- 
-             if TC_Verbose then
-                Report.Comment("Second set of complex values extracted " &
-                               "from data file using Complex_IO, "       &
-                               "Procedure Process_Data_File");
-             end if;
- 
-             -- The final items in the Data_File are complex values with 
-             -- incorrect syntax, which should raise Data_Error on an attempt
-             -- to read them from the file.
-             TC_Width := 10;
-             for i in 1..Number_Of_Error_Items loop
-                begin
-                   C_IO.Get(The_File, TC_Complex, TC_Width);
-                   Report.Failed
-                     ("Exception Data_Error not raised when Complex_IO.Get " &
-                      "was used to read complex data with incorrect "        &
-                      "syntax from the Data_File, data item #"               &
-                      Integer'Image(i));
-                exception
-                   when Ada.Text_IO.Data_Error => -- OK, expected exception.
-                      Text_IO.Skip_Line(The_File);
-                   when others =>
-                      Report.Failed
-                        ("Unexpected exception raised when Complex_IO.Get " &
-                         "was used to read complex data with incorrect "    &
-                         "syntax from the Data_File, data item #"           &
-                          Integer'Image(i));
-                end;
-             end loop;
- 
-             if TC_Verbose then
-                Report.Comment("Erroneous set of complex values extracted " &
-                               "from data file using Complex_IO, "          &
-                               "Procedure Process_Data_File");
-             end if;
- 
- 
-          exception
-             when others =>
-               Report.Failed
-                 ("Unexpected exception raised in Process_Data_File");
-          end Process_Data_File;
- 
- 
- 
-       begin  -- Test_Block.
- 
-          -- Place complex values into data file.
- 
-          Load_Data_File(Data_File);
-          Text_IO.Close(Data_File);
- 
-          if TC_Verbose then
-             Report.Comment("Data file loaded with Complex values");
-          end if;
- 
-          -- Read complex values from data file.
- 
-          Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename);
-          Process_Data_File(Data_File);
- 
-          if TC_Verbose then
-             Report.Comment("Complex values extracted from data file");
-          end if;
- 
- 
- 
-          -- Verify versions of Procedures Put and Get for Strings.
- 
-          declare
-             TC_String_Array : array (1..Number_Of_Complex_Items) 
-                               of String(1..15) := (others =>(others => ' '));
-          begin
- 
-             -- Place complex values into strings using the Procedure Put.
- 
-             for i in 1..Number_Of_Complex_Items loop
-                C_IO.Put(To   => TC_String_Array(i),
-                         Item => Complex_Array(i),
-                         Aft  => 1,
-                         Exp  => 0);
-             end loop;
- 
-             if TC_Verbose then
-                Report.Comment("Complex values placed into string array");
-             end if;
- 
-             -- Check the format of the strings containing a complex number.
-             -- The resulting strings are of 15 character length, with the
-             -- real component left justified within the string, followed by
-             -- a comma, and with the imaginary component and closing 
-             -- parenthesis right justified in the string, with blank fill
-             -- for the balance of the string.
- 
-             if TC_String_Array(1) /= "(3.0,      9.0)" or
-                TC_String_Array(2) /= "(4.0,      7.0)" or
-                TC_String_Array(3) /= "(5.0,      6.0)" or
-                TC_String_Array(4) /= "(6.0,      3.0)" or
-                TC_String_Array(5) /= "(2.0,      5.0)" or
-                TC_String_Array(6) /= "(3.0,      7.0)" 
-             then
-                Report.Failed("Incorrect format for complex values that " &
-                              "have been placed into string variables "   &
-                              "using the Complex_IO.Put procedure for "   &
-                              "strings");
-             end if;
- 
-             if TC_Verbose then
-                Report.Comment("String format of Complex values verified");
-             end if;
- 
-             -- Get complex values from strings using the Procedure Get.
-             -- Compare with expected complex values.
- 
-             for i in 1..Number_Of_Complex_Items loop
- 
-                C_IO.Get(From => TC_String_Array(i),
-                         Item => TC_Complex,
-                         Last => TC_Last_Character_Read);
- 
-                if TC_Complex /= Complex_Array(i) then
-                   Report.Failed("Incorrect complex data value obtained "   &
-                                 "from String following use of Procedures " &
-                                 "Put and Get from Strings, Complex_Array " &
-                                 "item #" & Integer'Image(i));
-                end if;
-             end loop;
-          
-             if TC_Verbose then
-                Report.Comment("Complex values removed from String array");
-             end if;
- 
-             -- Verify that Layout_Error is raised if the given string is
-             -- too short to hold the formatted output.
-             Layout_Error_On_Put:
-             declare
-                Much_Too_Short : String(1..2);
-                Complex_Value  : Complex_Pack.Complex := (5.0, 0.0);
-             begin
-                C_IO.Put(Much_Too_Short, Complex_Value);
-                Report.Failed("Layout_Error not raised by Procedure Put " &
-                              "when the given string was too short to "   &
-                              "hold the formatted output");
-             exception
-                when Layout_Error => null;  -- OK, expected exception.
-                when others =>
-                   Report.Failed
-                     ("Unexpected exception raised by Procedure Put when " &
-                      "the given string was too short to hold the "        &
-                      "formatted output");
-             end Layout_Error_On_Put;
- 
-             if TC_Verbose then
-                Report.Comment("Layout Errors verified");
-             end if;
- 
-          exception
-             when others => 
-                Report.Failed("Unexpected exception raised during the " &
-                              "evaluation of Put and Get for Strings");
-          end;
- 
- 
-          -- Place complex values into strings using a variety of legal
-          -- complex data formats.
-          declare
- 
-             type String_Ptr is access String;
- 
-             TC_Complex_String_Array : 
-               array (1..Number_Of_Complex_Items) of String_Ptr := 
-               (new String'( "(3.0, 9.0  )"           ), 
-                new String'( "+4.0  +7.0"             ),
-                new String'( "(5.0 6.0)"              ),
-                new String'( "6.0, 3.0"               ),
-                new String'( "  (   2.0   , 5.0  )  " ),
-                new String'( "(3.0              7.0)" ));
- 
-             -- The following array contains Positive values that correspond
-             -- to the last character that will be read by Procedure Get when
-             -- given each of the above strings as input.
- 
-             TC_Last_Char_Array : array (1..Number_Of_Complex_Items) 
-                of Positive := (12,10,9,8,20,22);
- 
-          begin
- 
-             -- Get complex values from strings using the Procedure Get.
-             -- Compare with expected complex values.
- 
-             for i in 1..Number_Of_Complex_Items loop
- 
-                C_IO.Get(TC_Complex_String_Array(i).all, 
-                         TC_Complex,
-                         TC_Last_Character_Read);
- 
-                if TC_Complex /= Complex_Array(i) then
-                   Report.Failed
-                     ("Incorrect complex data value obtained from " &
-                      "Procedure Get with complex data input of: "  & 
-                      TC_Complex_String_Array(i).all);
-                end if;
- 
-                if TC_Last_Character_Read /= TC_Last_Char_Array(i) then
-                   Report.Failed
-                     ("Incorrect value returned as the last character of " &
-                      "the input string processed by Procedure Get, "      &
-                      "string value : " & TC_Complex_String_Array(i).all   &
-                      "  expected last character value read : "            & 
-                      Positive'Image(TC_Last_Char_Array(i))                &
-                      "  last character value read : "                     &
-                      Positive'Image(TC_Last_Character_Read));
-                end if;
- 
-             end loop;
- 
-             if TC_Verbose then
-                Report.Comment("Complex values removed from strings and " &
-                               "verified against expected values");
-             end if;
- 
-          exception
-             when others => 
-                Report.Failed("Unexpected exception raised during the " &
-                              "evaluation of Get for Strings");
-          end;
- 
-       exception
-          when others => Report.Failed ("Exception raised in Test_Block");
-       end Test_Block;
- 
- 
-       -- Delete the external file.
-       if Ada.Text_IO.Is_Open(Data_File) then
-          Ada.Text_IO.Delete(Data_File);
-       else
-          Ada.Text_IO.Open(Data_File, 
-                           Ada.Text_IO.In_File,
-                           Data_Filename);
-          Ada.Text_IO.Delete(Data_File);
-       end if;
- 
-    exception
- 
-       -- Since Use_Error can be raised if, for the specified mode,
-       -- the environment does not support Text_IO operations, the 
-       -- following handlers are included:
- 
-       when Ada.Text_IO.Use_Error  =>
-          Report.Not_Applicable ("Use_Error raised on Text_IO Create");
- 
-       when Ada.Text_IO.Name_Error  =>
-          Report.Not_Applicable ("Name_Error raised on Text_IO Create");
- 
-       when others             =>
-          Report.Failed ("Unexpected exception raised on text file Create");
- 
-    end Test_for_Text_IO_Support;
- 
-    Report.Result;
- 
- end CXG1003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,360 ****
- -- CXG1004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the specified exceptions are raised by the subprograms
- --      defined in package Ada.Numerics.Generic_Complex_Elementary_Functions
- --      given the prescribed input parameter values.
- --
- -- TEST DESCRIPTION:
- --      This test checks that specific subprograms defined in the 
- --      package Ada.Numerics.Generic_Complex_Elementary_Functions raise the
- --      exceptions Argument_Error and Constraint_Error when their input
- --      parameter value are those specified as causing each exception.
- --      In the case of Constraint_Error, the exception will be raised in
- --      each test case, provided that the value of the attribute
- --      'Machine_Overflows (for the actual type of package 
- --      Generic_Complex_Type) is True.
- --      
- -- APPLICABILITY CRITERIA: 
- --      This test only applies to implementations supporting the 
- --      numerics annex.
- --
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
- --      29 Sep 96   SAIC    Incorporated reviewer comments.
- --      02 Jun 98   EDS     Replace "_i" with "_One".
- --!
- 
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Generic_Complex_Elementary_Functions;
- with Report;
- 
- procedure CXG1004 is
- begin
- 
-    Report.Test ("CXG1004", "Check that the specified exceptions are "      &
-                            "raised by the subprograms defined in package " &
-                            "Ada.Numerics.Generic_Complex_Elementary_"      &
-                            "Functions given the prescribed input "         &
-                            "parameter values");
- 
-    Test_Block:
-    declare
- 
-       type Real_Type is new Float;
- 
-       TC_Overflows : Boolean := Real_Type'Machine_Overflows;
- 
-       package Complex_Pack is 
-         new Ada.Numerics.Generic_Complex_Types(Real_Type);
- 
-       package CEF is 
-         new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack);
- 
-       use Ada.Numerics, Complex_Pack, CEF;
- 
-       Complex_Zero : constant Complex := Compose_From_Cartesian(0.0, 0.0);
-       Plus_One     : constant Complex := Compose_From_Cartesian(1.0, 0.0);
-       Minus_One    : constant Complex := Compose_From_Cartesian(-1.0, 0.0);
-       Plus_i       : constant Complex := Compose_From_Cartesian(i);
-       Minus_i      : constant Complex := Compose_From_Cartesian(-i);
- 
-       Complex_Negative_Real      : constant Complex := 
-                                             Compose_From_Cartesian(-4.0, 2.0);
-       Complex_Negative_Imaginary : constant Complex := 
-                                             Compose_From_Cartesian(3.0, -5.0);
- 
-       TC_Complex   : Complex;
- 
- 
-       -- This procedure is used in "Exception Raising" calls below in an
-       -- attempt to avoid elimination of the subtest through optimization.
- 
-       procedure No_Optimize (The_Complex_Number : Complex) is
-       begin
-          Report.Comment("No Optimize: Should never be printed " &
-                         Integer'Image(Integer(The_Complex_Number.Im)));
-       end No_Optimize;
- 
- 
-    begin
- 
-       -- Check that the exception Numerics.Argument_Error is raised by the
-       -- exponentiation operator when the value of the left operand is zero,
-       -- and the real component of the exponent (or the exponent itself) is
-       -- zero.
- 
-       begin
-          TC_Complex := "**"(Left => Complex_Zero, Right => Complex_Zero);
-          Report.Failed("Argument_Error not raised by exponentiation "  &
-                        "operator, left operand = complex zero, right " &
-                        "operand = complex zero");
-          No_Optimize(TC_Complex);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by exponentiation " &
-                           "operator, left operand = complex zero, right " &
-                           "operand = complex zero");
-       end;
- 
-       begin
-          TC_Complex := Complex_Zero**0.0;
-          Report.Failed("Argument_Error not raised by exponentiation "  &
-                        "operator, left operand = complex zero, right " &
-                        "operand = real zero");
-          No_Optimize(TC_Complex);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by exponentiation " &
-                           "operator, left operand = complex zero, right " &
-                           "operand = real zero");
-       end;
- 
- 
-       begin
-          TC_Complex := "**"(Left => 0.0, Right => Complex_Zero);
-          Report.Failed("Argument_Error not raised by exponentiation " &
-                        "operator, left operand = real zero, right "   &
-                        "operand = complex zero");
-          No_Optimize(TC_Complex);
-       exception
-          when Argument_Error => null;  -- OK, expected exception.
-          when others =>
-             Report.Failed("Incorrect exception raised by exponentiation " &
-                           "operator, left operand = real zero, right "    &
-                           "operand = complex zero");
-       end;
- 
- 
-       -- Check that the exception Constraint_Error is raised under the 
-       -- specified circumstances, provided that
-       -- Complex_Types.Real'Machine_Overflows is True.
- 
-       if TC_Overflows then
- 
-          -- Raised by Log, when the value of the parameter X is zero.
-          begin
-             TC_Complex := Log (X => Complex_Zero);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Log given parameter value of complex zero");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Log given parameter value of complex zero");
-          end;
- 
-          -- Raised by Cot, when the value of the parameter X is zero.
-          begin
-             TC_Complex := Cot (X => Complex_Zero);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Cot given parameter value of complex zero");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Cot given parameter value of complex zero");
-          end;
- 
-          -- Raised by Coth, when the value of the parameter X is zero.
-          begin
-             TC_Complex := Coth (Complex_Zero);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Coth given parameter value of complex zero");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Coth given parameter value of complex zero");
-          end;
- 
-          -- Raised by the exponentiation operator, when the value of the 
-          -- left operand is zero and the real component of the exponent
-          -- is negative.
-          begin
-             TC_Complex := Complex_Zero**Complex_Negative_Real;
-             Report.Failed("Constraint_Error not raised when the "    &
-                           "exponentiation operator left operand is " &
-                           "complex zero, and the real component of " &
-                           "the exponent is negative");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when the "     &
-                              "exponentiation operator left operand is " &
-                              "complex zero, and the real component of " &
-                              "the exponent is negative");
-          end;
- 
-          -- Raised by the exponentiation operator, when the value of the 
-          -- left operand is zero and the exponent itself (when it is of
-          -- type real) is negative.
-          declare
-             Negative_Exponent : constant Real_Type := -4.0;
-          begin
-             TC_Complex := Complex_Zero**Negative_Exponent;
-             Report.Failed("Constraint_Error not raised when the "    &
-                           "exponentiation operator left operand is " &
-                           "complex zero, and the real exponent is "  &
-                           "negative");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when the "     &
-                              "exponentiation operator left operand is " &
-                              "complex zero, and the real exponent is "  &
-                              "negative");
-          end;
- 
-          -- Raised by Arctan, when the value of the parameter is +i.
-          begin
-             TC_Complex := Arctan (Plus_i);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arctan is given parameter value +i");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arctan is given parameter value +i");
-          end;
- 
-          -- Raised by Arctan, when the value of the parameter is -i.
-          begin
-             TC_Complex := Arctan (Minus_i);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arctan is given parameter value -i");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arctan is given parameter value -i");
-          end;
- 
-          -- Raised by Arccot, when the value of the parameter is +i.
-          begin
-             TC_Complex := Arccot (Plus_i);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arccot is given parameter value +i");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arccot is given parameter value +i");
-          end;
- 
-          -- Raised by Arccot, when the value of the parameter is -i.
-          begin
-             TC_Complex := Arccot (Minus_i);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arccot is given parameter value -i");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arccot is given parameter value -i");
-          end;
- 
-          -- Raised by Arctanh, when the value of the parameter is +1.
-          begin
-             TC_Complex := Arctanh (Plus_One);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arctanh is given parameter value +1");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arctanh is given parameter value +1");
-          end;
- 
-          -- Raised by Arctanh, when the value of the parameter is -1.
-          begin
-             TC_Complex := Arctanh (Minus_One);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arctanh is given parameter value -1");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arctanh is given parameter value -1");
-          end;
- 
-          -- Raised by Arccoth, when the value of the parameter is +1.
-          begin
-             TC_Complex := Arccoth (Plus_One);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arccoth is given parameter value +1");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arccoth is given parameter value +1");
-          end;
- 
-          -- Raised by Arccoth, when the value of the parameter is -1.
-          begin
-             TC_Complex := Arccoth (Minus_One);
-             Report.Failed("Constraint_Error not raised when Function " &
-                           "Arccoth is given parameter value -1");
-             No_Optimize(TC_Complex);
-          exception
-             when Constraint_Error => null;  -- OK, expected exception.
-             when others =>
-                Report.Failed("Incorrect exception raised when Function " &
-                              "Arccoth is given parameter value -1");
-          end;
- 
-       else
-          Report.Comment
-            ("Attribute Complex_Pack.Real'Machine_Overflows is False; " &
-             "evaluation of the complex elementary functions under "    &
-             "specified circumstances was not performed");
-       end if;
- 
- 
-    exception
-       when others => 
-         Report.Failed ("Unexpected exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXG1004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,393 ****
- -- CXG1005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the subprograms defined in the package
- --      Ada.Numerics.Generic_Complex_Elementary_Functions provide correct
- --      results.
- --      
- -- TEST DESCRIPTION:
- --      This test checks that specific subprograms defined in the generic
- --      package Generic_Complex_Elementary_Functions are available, and that
- --      they provide prescribed results given specific input values.
- --      The generic package Ada.Numerics.Generic_Complex_Types is instantiated 
- --      with a real type (new Float). The resulting new package is used as
- --      the generic actual to package Complex_IO.
- --      
- -- SPECIAL REQUIREMENTS:
- --      Implementations for which Float'Signed_Zeros is True must provide
- --      a body for ImpDef.Annex_G.Negative_Zero which returns a negative 
- --      zero.
- --
- -- APPLICABILITY CRITERIA
- --      This test only applies to implementations that support the
- --      numerics annex.
- --
- --         
- --       
- -- CHANGE HISTORY:
- --      06 Dec 94   SAIC    ACVC 2.0
- --      16 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
- --      21 Feb 96   SAIC    Incorporated new structure for package Impdef.
- --      29 Sep 96   SAIC    Incorporated reviewer comments.
- --
- --!
- 
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Generic_Complex_Elementary_Functions;
- with ImpDef.Annex_G;
- with Report;
- 
- procedure CXG1005 is
- begin
- 
-    Report.Test ("CXG1005", "Check that the subprograms defined in "  &
-                            "the package Generic_Complex_Elementary_" & 
-                            "Functions provide correct results");
- 
-    Test_Block:
-    declare
- 
-       type Real_Type is new Float;
- 
-       TC_Signed_Zeros : Boolean := Real_Type'Signed_Zeros; 
- 
-       package Complex_Pack is new 
-         Ada.Numerics.Generic_Complex_Types(Real_Type);
- 
-       package CEF is 
-         new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack);
- 
-       use Ada.Numerics, Complex_Pack, CEF;
- 
-       Complex_Zero : constant Complex := Compose_From_Cartesian( 0.0, 0.0);
-       Plus_One     : constant Complex := Compose_From_Cartesian( 1.0, 0.0);
-       Minus_One    : constant Complex := Compose_From_Cartesian(-1.0, 0.0);
-       Plus_i       : constant Complex := Compose_From_Cartesian(i);
-       Minus_i      : constant Complex := Compose_From_Cartesian(-i);
- 
-       Complex_Positive_Real      : constant Complex := 
-                                          Compose_From_Cartesian(4.0, 2.0);
-       Complex_Positive_Imaginary : constant Complex := 
-                                          Compose_From_Cartesian(3.0, 5.0);
-       Complex_Negative_Real      : constant Complex := 
-                                          Compose_From_Cartesian(-4.0, 2.0);
-       Complex_Negative_Imaginary : constant Complex := 
-                                          Compose_From_Cartesian(3.0, -5.0);
- 
- 
-       function A_Zero_Result (Z : Complex) return Boolean is
-       begin
-          return (Re(Z) = 0.0 and Im(Z) = 0.0);
-       end A_Zero_Result;
- 
- 
-       -- In order to evaluate complex elementary functions that are
-       -- prescribed to return a "real" result (meaning that the imaginary
-       -- component is zero), the Function A_Real_Result is defined.
- 
-       function A_Real_Result (Z : Complex) return Boolean is
-       begin
-          return Im(Z) = 0.0;
-       end A_Real_Result;
- 
- 
-       -- In order to evaluate complex elementary functions that are
-       -- prescribed to return an "imaginary" result (meaning that the real
-       -- component of the complex number is zero, and the imaginary
-       -- component is non-zero), the Function An_Imaginary_Result is defined.
- 
-       function An_Imaginary_Result (Z : Complex) return Boolean is
-       begin
-          return  (Re(Z) = 0.0 and Im(Z) /= 0.0);
-       end An_Imaginary_Result;
- 
- 
-    begin
- 
-       -- Check that when the input parameter value is zero, the following
-       -- functions yield a zero result.
- 
-       if not A_Zero_Result( Sqrt(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Sqrt with zero input");
-       end if;
- 
-       if not A_Zero_Result( Sin(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Sin with zero input");
-       end if;
- 
-       if not A_Zero_Result( Arcsin(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Arcsin with zero " &
-                        "input");
-       end if;
- 
-       if not A_Zero_Result( Tan(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Tan with zero input");
-       end if;
- 
-       if not A_Zero_Result( Arctan(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Arctan with zero " &
-                        "input");
-       end if;
- 
-       if not A_Zero_Result( Sinh(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Sinh with zero input");
-       end if;
- 
-       if not A_Zero_Result( Arcsinh(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Arcsinh with zero " &
-                        "input");
-       end if;
- 
-       if not A_Zero_Result( Tanh(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Tanh with zero input");
-       end if;
- 
-       if not A_Zero_Result( Arctanh(Complex_Zero) ) then
-          Report.Failed("Non-zero result from Function Arctanh with zero " &
-                        "input");
-       end if;
- 
- 
-       -- Check that when the input parameter value is zero, the following
-       -- functions yield a result of one.
- 
-       if Exp(Complex_Zero) /= Plus_One 
-       then
-          Report.Failed("Non-zero result from Function Exp with zero input");
-       end if;
- 
-       if Cos(Complex_Zero) /= Plus_One 
-       then
-          Report.Failed("Non-zero result from Function Cos with zero input");
-       end if;
- 
-       if Cosh(Complex_Zero) /= Plus_One 
-       then
-          Report.Failed("Non-zero result from Function Cosh with zero input");
-       end if;
- 
- 
-       -- Check that when the input parameter value is zero, the following
-       -- functions yield a real result.
- 
-       if not A_Real_Result( Arccos(Complex_Zero) ) then
-         Report.Failed("Non-real result from Function Arccos with zero input");
-       end if;
- 
-       if not A_Real_Result( Arccot(Complex_Zero) ) then
-         Report.Failed("Non-real result from Function Arccot with zero input");
-       end if;
- 
- 
-       -- Check that when the input parameter value is zero, the following
-       -- functions yield an imaginary result.
- 
-       if not An_Imaginary_Result( Arccoth(Complex_Zero) ) then
-         Report.Failed("Non-imaginary result from Function Arccoth with " &
-                       "zero input");
-       end if;
- 
- 
-       -- Check that when the input parameter value is one, the Sqrt function 
-       -- yields a result of one.
- 
-       if Sqrt(Plus_One) /= Plus_One then
-          Report.Failed("Incorrect result from Function Sqrt with input " &
-                        "value of one");
-       end if;
- 
- 
-       -- Check that when the input parameter value is one, the following 
-       -- functions yield a result of zero.
- 
-       if not A_Zero_Result( Log(Plus_One) ) then
-          Report.Failed("Non-zero result from Function Log with input " &
-                        "value of one");
-       end if;
- 
-       if not A_Zero_Result( Arccos(Plus_One) ) then
-          Report.Failed("Non-zero result from Function Arccos with input " &
-                        "value of one");
-       end if;
- 
-       if not A_Zero_Result( Arccosh(Plus_One) ) then
-          Report.Failed("Non-zero result from Function Arccosh with input " &
-                        "value of one");
-       end if;
- 
- 
-       -- Check that when the input parameter value is one, the Arcsin 
-       -- function yields a real result.
- 
-       if not A_Real_Result( Arcsin(Plus_One) ) then
-          Report.Failed("Non-real result from Function Arcsin with input " &
-                        "value of one");
-       end if;
- 
- 
-       -- Check that when the input parameter value is minus one, the Sqrt 
-       -- function yields a result of "i", when the sign of the imaginary
-       -- component of the input parameter is positive (and yields "-i", if 
-       -- the sign on the imaginary component is negative), and the 
-       -- Complex_Types.Real'Signed_Zeros attribute is True.
- 
-       if TC_Signed_Zeros then
- 
-          declare
-             Minus_One_With_Pos_Zero_Im_Component : Complex := 
-                                   Compose_From_Cartesian(-1.0, +0.0);
-             Minus_One_With_Neg_Zero_Im_Component : Complex := 
-               Compose_From_Cartesian
-                 (-1.0, Real_Type(ImpDef.Annex_G.Negative_Zero));
-          begin
- 
-             if Sqrt(Minus_One_With_Pos_Zero_Im_Component) /= Plus_i then
-                Report.Failed("Incorrect result from Function Sqrt, when " &
-                              "input value is minus one with a positive "  &
-                              "imaginary component, Signed_Zeros being True");
-             end if;
- 
-             if Sqrt(Minus_One_With_Neg_Zero_Im_Component) /= Minus_i then
-                Report.Failed("Incorrect result from Function Sqrt, when " &
-                              "input value is minus one with a negative "  &
-                              "imaginary component, Signed_Zeros being True");
-             end if;
-          end;
- 
-       else   -- Signed_Zeros is False.
- 
-          -- Check that when the input parameter value is minus one, the Sqrt 
-          -- function yields a result of "i", when the 
-          -- Complex_Types.Real'Signed_Zeros attribute is False.
- 
-          if Sqrt(Minus_One) /= Plus_i then
-             Report.Failed("Incorrect result from Function Sqrt, when "    &
-                           "input value is minus one, Signed_Zeros being " & 
-                           "False");
-          end if;
- 
-       end if;
- 
- 
-       -- Check that when the input parameter value is minus one, the Log
-       -- function yields an imaginary result.
- 
-       if not An_Imaginary_Result( Log(Minus_One) ) then
-          Report.Failed("Non-imaginary result from Function Log with a " &
-                        "minus one input value");
-       end if;
- 
-       -- Check that when the input parameter is minus one, the following 
-       -- functions yield a real result.
- 
-       if not A_Real_Result( Arcsin(Minus_One) ) then
-          Report.Failed("Non-real result from Function Arcsin with a " &
-                        "minus one input value");
-       end if;
- 
-       if not A_Real_Result( Arccos(Minus_One) ) then
-          Report.Failed("Non-real result from Function Arccos with a " &
-                        "minus one input value");
-       end if;
- 
- 
-       -- Check that when the input parameter has a value of +i or -i, the
-       -- Log function yields an imaginary result.
- 
-       if not An_Imaginary_Result( Log(Plus_i) ) then
-          Report.Failed("Non-imaginary result from Function Log with an " &
-                        "input value of ""+i""");
-       end if;
- 
-       if not An_Imaginary_Result( Log(Minus_i) ) then
-          Report.Failed("Non-imaginary result from Function Log with an " &
-                        "input value of ""-i""");
-       end if;
- 
- 
-       -- Check that exponentiation by a zero exponent yields the value one.
- 
-       if "**"(Left  => Compose_From_Cartesian(5.0, 3.0), 
-               Right => Complex_Zero)                     /= Plus_One  or
-          Complex_Negative_Real**0.0                      /= Plus_One  or
-          15.0**Complex_Zero                              /= Plus_One
-       then
-          Report.Failed("Incorrect result from exponentiation with a zero " &
-                        "exponent");
-       end if;
- 
- 
-       -- Check that exponentiation by a unit exponent yields the value of 
-       -- the left operand (as a complex value).
-       -- Note: a "unit exponent" is considered the complex number (1.0, 0.0)
- 
-       if "**"(Complex_Negative_Real, Plus_One) /= 
-          Complex_Negative_Real                    or
-          Complex_Negative_Imaginary**Plus_One  /= 
-          Complex_Negative_Imaginary               or
-          4.0**Plus_One                         /= 
-          Compose_From_Cartesian(4.0, 0.0)
-       then
-          Report.Failed("Incorrect result from exponentiation with a unit " &
-                        "exponent");
-       end if;
- 
- 
-       -- Check that exponentiation of the value one yields the value one.
- 
-       if "**"(Plus_One, Complex_Negative_Imaginary) /= Plus_One  or
-          Plus_One**9.0                              /= Plus_One  or
-          1.0**Complex_Negative_Real                 /= Plus_One
-       then
-          Report.Failed("Incorrect result from exponentiation of the value " &
-                        "One");
-       end if;
- 
- 
-       -- Check that exponentiation of the value zero yields the value zero.
-       begin
-          if not A_Zero_Result("**"(Complex_Zero, 
-                                    Complex_Positive_Imaginary)) or
-             not A_Zero_Result(Complex_Zero**4.0)                or
-             not A_Zero_Result(0.0**Complex_Positive_Real)
-          then
-             Report.Failed("Incorrect result from exponentiation of the " &
-                           "value zero");
-          end if;
-       exception
-          when others =>
-            Report.Failed("Exception raised during the exponentiation of " &
-                          "the complex value zero");
-       end;
- 
- 
-    exception
-       when others => Report.Failed ("Exception raised in Test_Block");
-    end Test_Block;
- 
-    Report.Result;
- 
- end CXG1005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,322 ****
- -- CXG2001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the floating point attributes Model_Mantissa,
- --      Machine_Mantissa, Machine_Radix, and Machine_Rounds
- --      are properly reported.
- --
- -- TEST DESCRIPTION:
- --      This test uses a generic package to compute and check the
- --      values of the Machine_  attributes listed above.  The
- --      generic package is instantiated with the standard FLOAT 
- --      type and a floating point type for the maximum number
- --      of digits of precision.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --
- --
- -- CHANGE HISTORY:
- --      26 JAN 96   SAIC    Initial Release for 2.1
- --
- --!
- 
- -- References:
- --
- --    "Algorithms To Reveal Properties of Floating-Point Arithmetic"
- --    Michael A. Malcolm;  CACM November 1972;  pgs 949-951.
- --
- --    Software Manual for Elementary Functions; W. J. Cody and W. Waite;
- --    Prentice-Hall; 1980
- -----------------------------------------------------------------------
- -- 
- -- This test relies upon the fact that
- -- (A+2.0)-A is not necessarily 2.0.  If A is large enough then adding 
- -- a small value to A does not change the value of A.  Consider the case
- -- where we have a decimal based floating point representation with 4
- -- digits of precision.  A floating point number would logically be 
- -- represented as "DDDD * 10 ** exp" where D is a value in the range 0..9.
- -- The first loop of the test starts A at 2.0 and doubles it until
- -- ((A+1.0)-A)-1.0 is no longer zero.  For our decimal floating point
- -- number this will be 1638 * 10**1  (the value 16384 rounded or truncated
- -- to fit in 4 digits).
- -- The second loop starts B at 2.0 and keeps doubling B until (A+B)-A is
- -- no longer 0.  This will keep looping until B is 8.0 because that is
- -- the first value where rounding (assuming our machine rounds and addition
- -- employs a guard digit) will change the upper 4 digits of the result:
- --       1638_
- --     +     8
- --      -------
- --       1639_
- -- Without rounding the second loop will continue until
- -- B is 16:
- --       1638_
- --     +    16
- --      -------
- --       1639_
- -- 
- -- The radix is then determined by (A+B)-A which will give 10.
- -- 
- -- The use of Tmp and ITmp in the test is to force values to be 
- -- stored into memory in the event that register precision is greater
- -- than the stored precision of the floating point values.
- --      
- -- 
- -- The test for rounding is (ignoring the temporary variables used to 
- -- get the stored precision) is 
- --       Rounds := A + Radix/2.0 - A /= 0.0 ;
- -- where A is the value determined in the first step that is the smallest
- -- power of 2 such that A + 1.0 = A.  This means that the true value of
- -- A has one more digit in its value than 'Machine_Mantissa.
- -- This check will detect the case where a value is always rounded.
- -- There is an additional case where values are rounded to the nearest
- -- even value.  That is referred to as IEEE style rounding in the test.
- -- 
- -----------------------------------------------------------------------
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2001 is
-    Verbose : constant Boolean := False;
- 
-    -- if one of the attribute computation loops exceeds Max_Iterations
-    -- it is most likely due to the compiler reordering an expression
-    -- that should not be reordered.
-    Illegal_Optimization : exception;
-    Max_Iterations : constant := 10_000;
- 
-    generic
-       type Real is digits <>;
-    package Chk_Attrs is
-       procedure Do_Test;
-    end Chk_Attrs;
- 
-    package body Chk_Attrs is
-       package EF is new Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Log (X : Real) return Real renames EF.Log;
- 
- 
-                                    -- names used in paper
-       Radix : Integer;             -- Beta
-       Mantissa_Digits : Integer;   -- t
-       Rounds : Boolean;            -- RND
- 
-       -- made global to Determine_Attributes to help thwart optimization
-       A, B : Real := 2.0;
-       Tmp, Tmpa, Tmp1 : Real;
-       ITmp : Integer;
-       Half_Radix : Real;
- 
-       -- special constants - not declared as constants so that 
-       -- the "stored" precision will be used instead of a "register"
-       -- precision.
-       Zero : Real := 0.0;
-       One  : Real := 1.0;
-       Two  : Real := 2.0;
- 
- 
-       procedure Thwart_Optimization is
-       -- the purpose of this procedure is to reference the
-       -- global variables used by Determine_Attributes so
-       -- that the compiler is not likely to keep them in
-       -- a higher precision register for their entire lifetime.
-       begin
- 	 if Report.Ident_Bool (False) then
- 	    -- never executed
- 	    A := A + 5.0;
- 	    B := B + 6.0;
- 	    Tmp := Tmp + 1.0;
- 	    Tmp1 := Tmp1 + 2.0;
- 	    Tmpa := Tmpa + 2.0;
-             One := 12.34;   Two := 56.78;  Zero := 90.12;
- 	 end if;
-       end Thwart_Optimization;
- 
- 
-       -- determines values for Radix, Mantissa_Digits, and Rounds
-       -- This is mostly a straight translation of the C code.
-       -- The only significant addition is the iteration count
-       -- to prevent endless looping if things are really screwed up.
-       procedure Determine_Attributes is
-          Iterations : Integer;
-       begin
-          Rounds := True;
- 
-          Iterations := 0;
-          Tmp := Real'Machine (((A + One) - A) - One);
-          while Tmp = Zero loop
-             A := Real'Machine(A + A);
-             Tmp := Real'Machine(A + One);
-             Tmp1 := Real'Machine(Tmp - A);
- 	    Tmp := Real'Machine(Tmp1 - One);
- 
-             Iterations := Iterations + 1;
-             if Iterations > Max_Iterations then
-                raise Illegal_Optimization;
-             end if;
-          end loop;
- 
-          Iterations := 0;
- 	 Tmp := Real'Machine(A + B);
- 	 ITmp := Integer (Tmp - A);
-          while ITmp = 0 loop
-             B := Real'Machine(B + B);
- 	    Tmp := Real'Machine(A + B);
- 	    ITmp := Integer (Tmp - A);
- 
-             Iterations := Iterations + 1;
-             if Iterations > Max_Iterations then
-                raise Illegal_Optimization;
-             end if;
-          end loop;
- 
-          Radix := ITmp;
- 
-          Mantissa_Digits := 0;
-          B := 1.0;
- 	 Tmp := Real'Machine(((B + One) - B) - One);
-          Iterations := 0;
-          while (Tmp = Zero) loop
-             Mantissa_Digits := Mantissa_Digits + 1;
-             B := B * Real (Radix);
- 	    Tmp := Real'Machine(B + One);
- 	    Tmp1 := Real'Machine(Tmp - B);
- 	    Tmp := Real'Machine(Tmp1 - One);
- 
-             Iterations := Iterations + 1;
-             if Iterations > Max_Iterations then
-                raise Illegal_Optimization;
-             end if;
-          end loop;
- 
- 	 Rounds := False;
- 	 Half_Radix := Real (Radix) / Two;
- 	 Tmp := Real'Machine(A + Half_Radix);
- 	 Tmp1 := Real'Machine(Tmp - A);
- 	 if (Tmp1 /= Zero) then
- 	    Rounds := True;
- 	 end if;
- 	 Tmpa := Real'Machine(A + Real (Radix));
- 	 Tmp := Real'Machine(Tmpa + Half_Radix);
- 	 if not Rounds and (Tmp - TmpA /= Zero) then
- 	    Rounds := True;
-             if Verbose then
- 	       Report.Comment ("IEEE style rounding");
-             end if;
- 	 end if;
- 
-       exception
- 	 when others =>
- 	    Thwart_Optimization;
- 	    raise;
-       end Determine_Attributes;
- 
- 
-       procedure Do_Test is
-          Show_Results : Boolean := Verbose;
-          Min_Mantissa_Digits : Integer;
-       begin
-          -- compute the actual Machine_* attribute values
-          Determine_Attributes;
- 
-          if Real'Machine_Radix /= Radix then
-             Report.Failed ("'Machine_Radix incorrectly reports" &
-                            Integer'Image (Real'Machine_Radix));
-             Show_Results := True;
-          end if;
- 
-          if Real'Machine_Mantissa /= Mantissa_Digits then
-             Report.Failed ("'Machine_Mantissa incorrectly reports" &
-                            Integer'Image (Real'Machine_Mantissa));
-             Show_Results := True;
-          end if;
- 
-          if Real'Machine_Rounds /= Rounds then
-             Report.Failed ("'Machine_Rounds incorrectly reports " &
-                            Boolean'Image (Real'Machine_Rounds));
-             Show_Results := True;
-          end if;
- 
-          if Show_Results then
-             Report.Comment ("computed Machine_Mantissa is" & 
-                             Integer'Image (Mantissa_Digits));
-             Report.Comment ("computed Radix is" &
-                             Integer'Image (Radix));
-             Report.Comment ("computed Rounds is " &
-                             Boolean'Image (Rounds));
-          end if;
- 
-          -- check the model attributes against the machine attributes
- 	 -- G.2.2(3)/3;6.0
-          if Real'Model_Mantissa > Real'Machine_Mantissa then
- 	    Report.Failed ("model mantissa > machine mantissa");
- 	 end if;
- 
-          -- G.2.2(3)/2;6.0
-          --  'Model_Mantissa >= ceiling(d*log(10)/log(radix))+1
-          Min_Mantissa_Digits := 
-            Integer (
-               Real'Ceiling (
-                  Real(Real'Digits) * Log(10.0) / Log(Real(Real'Machine_Radix))
-                    )       ) + 1;
-          if Real'Model_Mantissa < Min_Mantissa_Digits then
-             Report.Failed ("Model_Mantissa [" &
-                            Integer'Image (Real'Model_Mantissa) &
-                            "] < minimum mantissa digits [" &
-                            Integer'Image (Min_Mantissa_Digits) &
-                            "]");
-          end if;
- 
-       exception
-          when Illegal_Optimization =>
-              Report.Failed ("illegal optimization of" &
-                             " floating point expression");
-       end Do_Test;
-    end Chk_Attrs;
- 
-    package Chk_Float is new Chk_Attrs (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package Chk_A_Long_Float is new Chk_Attrs (A_Long_Float);
- begin
-    Report.Test ("CXG2001",
-                 "Check the attributes Model_Mantissa," &
-                 " Machine_Mantissa, Machine_Radix," &
-                 " and Machine_Rounds");
- 
-    Report.Comment ("checking Standard.Float");
-    Chk_Float.Do_Test;
- 
-    Report.Comment ("checking a digits" & 
-                    Integer'Image (System.Max_Digits) &
-                    " floating point type");
-    Chk_A_Long_Float.Do_Test;
- 
-    Report.Result;
- end CXG2001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,468 ****
- -- CXG2002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex "abs" or modulus function returns
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test uses a generic package to compute and check the
- --      values of the modulus function.  In addition, a non-generic
- --      copy of this package is used to check the non-generic package
- --      Ada.Numerics.Complex_Types.
- --      Of special interest is the case where either the real or
- --      the imaginary part of the argument is very large while the
- --      other part is very small or 0. 
- --      We want to check that the value is computed such that
- --      an overflow does not occur.  If computed directly from the
- --      definition 
- --        abs (x+yi) = sqrt(x**2 + y**2)
- --      then overflow or underflow is much more likely than if the
- --      argument is normalized first.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      31 JAN 96   SAIC    Initial release for 2.1
- --      02 JUN 98   EDS     Add parens to intermediate calculations.
- --!
- 
- --
- -- Reference:
- -- Problems and Methodologies in Mathematical Software Production;
- -- editors: P. C. Messina and A Murli;
- -- Lecture Notes in Computer Science
- -- Volume 142
- -- Springer Verlag 1982
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Complex_Types;
- procedure CXG2002 is
-    Verbose : constant Boolean := False;
-    Maximum_Relative_Error : constant := 3.0;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Complex_Types is new 
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Types;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real := Maximum_Relative_Error) is
-          Rel_Error,
-          Abs_Error,
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Expected - Actual) &
-                            " max_err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Do_Test is
-          Z : Complex;
-          X : Real;
-          T : Real;
-       begin
- 
-          --- test 1 ---
-          begin
-             T := Real'Safe_Last;
-             Z := T + 0.0*i;
-             X := abs Z;
-             Check (X, T, "test 1 -- abs(bigreal + 0i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
- 	 --- test 2 ---
-          begin
-             T := Real'Safe_Last;
- 	    Z := 0.0 + T*i;
- 	    X := Modulus (Z);
-             Check (X, T, "test 2 -- abs(0 + bigreal*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
- 	 --- test 3 ---
-          begin
- 	    Z := 3.0 + 4.0*i;
- 	    X := abs Z;
-             Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
- 	 --- test 4 ---
-          declare
-             S : Real;
-          begin
-             S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
- 	    Z := 3.0 * S + 4.0*S*i;
- 	    X := abs Z;
-             Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", 
-                    5.0*Real'Model_Epsilon);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
- 	 --- test 5 --- 
-          begin
-             T := Real'Model_Small;
- 	    Z := T + 0.0*i;
- 	    X := abs Z;
-             Check (X, T , "test 5 -- abs(small + 0*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 5");
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
- 	 --- test 6 ---
-          begin
-             T := Real'Model_Small;
- 	    Z := 0.0 + T*i;
- 	    X := abs Z;
-             Check (X, T , "test 6 -- abs(0 + small*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
- 	 --- test 7 ---
-          declare
-             S : Real;
-          begin
-             S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
- 	    Z := 3.0 * S + 4.0*S*i;
- 	    X := abs Z;
-             Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", 
-                    5.0*Real'Model_Epsilon);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 7");
-             when others =>
-                Report.Failed ("exception in test 7");
-          end;
- 
- 	 --- test 8 ---
-          declare
-             -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-             Sqrt2 : constant := 
-               1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-          begin
- 	    Z := 1.0 + 1.0*i;
- 	    X := abs Z;
-             Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 8");
-             when others =>
-                Report.Failed ("exception in test 8");
-          end;
- 
- 	 --- test 9 --- 
-          begin
-             T := 0.0;
- 	    Z := T + 0.0*i;
- 	    X := abs Z;
-             Check (X, T , "test 5 -- abs(0 + 0*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 9");
-             when others =>
-                Report.Failed ("exception in test 9");
-          end;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    --- non generic copy of the above generic package
-    -----------------------------------------------------------------------
- 
-    package Non_Generic_Check is
-       subtype Real is Float;
-       procedure Do_Test;
-    end Non_Generic_Check;
- 
-    package body Non_Generic_Check is
-       use Ada.Numerics.Complex_Types;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real := Maximum_Relative_Error) is
-          Rel_Error,
-          Abs_Error,
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Expected - Actual) &
-                            " max_err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Do_Test is
-          Z : Complex;
-          X : Real;
-          T : Real;
-       begin
- 
-          --- test 1 ---
-          begin
-             T := Real'Safe_Last;
-             Z := T + 0.0*i;
-             X := abs Z;
-             Check (X, T, "test 1 -- abs(bigreal + 0i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
- 	 --- test 2 ---
-          begin
-             T := Real'Safe_Last;
- 	    Z := 0.0 + T*i;
- 	    X := Modulus (Z);
-             Check (X, T, "test 2 -- abs(0 + bigreal*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
- 	 --- test 3 ---
-          begin
- 	    Z := 3.0 + 4.0*i;
- 	    X := abs Z;
-             Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
- 	 --- test 4 ---
-          declare
-             S : Real;
-          begin
-             S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
- 	    Z := 3.0 * S + 4.0*S*i;
- 	    X := abs Z;
-             Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", 
-                    5.0*Real'Model_Epsilon);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
- 	 --- test 5 --- 
-          begin
-             T := Real'Model_Small;
- 	    Z := T + 0.0*i;
- 	    X := abs Z;
-             Check (X, T , "test 5 -- abs(small + 0*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 5");
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
- 	 --- test 6 ---
-          begin
-             T := Real'Model_Small;
- 	    Z := 0.0 + T*i;
- 	    X := abs Z;
-             Check (X, T , "test 6 -- abs(0 + small*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
- 	 --- test 7 ---
-          declare
-             S : Real;
-          begin
-             S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
- 	    Z := 3.0 * S + 4.0*S*i;
- 	    X := abs Z;
-             Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", 
-                    5.0*Real'Model_Epsilon);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 7");
-             when others =>
-                Report.Failed ("exception in test 7");
-          end;
- 
- 	 --- test 8 ---
-          declare
-             -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-             Sqrt2 : constant := 
-               1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-          begin
- 	    Z := 1.0 + 1.0*i;
- 	    X := abs Z;
-             Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 8");
-             when others =>
-                Report.Failed ("exception in test 8");
-          end;
- 
- 	 --- test 9 --- 
-          begin
-             T := 0.0;
- 	    Z := T + 0.0*i;
- 	    X := abs Z;
-             Check (X, T , "test 5 -- abs(0 + 0*i)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 9");
-             when others =>
-                Report.Failed ("exception in test 9");
-          end;
-       end Do_Test;
-    end Non_Generic_Check;
- 
-    -----------------------------------------------------------------------
-    --- end of "manual instantiation" 
-    -----------------------------------------------------------------------
-    package Chk_Float is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
- begin
-    Report.Test ("CXG2002",
-                 "Check the accuracy of the complex modulus" &
-                 " function");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
-    Chk_Float.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
-    Chk_A_Long_Float.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking non-generic package");
-    end if;
-    Non_Generic_Check.Do_Test;
-    Report.Result;
- end CXG2002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a	Thu Jan  1 00:00:00 1970
***************
*** 1,701 ****
- -- CXG2003.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the sqrt function returns
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test contains three test packages that are almost
- --      identical.  The first two packages differ only in the 
- --      floating point type that is being tested.  The first
- --      and third package differ only in whether the generic
- --      elementary functions package or the pre-instantiated
- --      package is used.
- --      The test package is not generic so that the arguments
- --      and expected results for some of the test values
- --      can be expressed as universal real instead of being
- --      computed at runtime.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --       2 FEB 96   SAIC    Initial release for 2.1
- --      18 AUG 96   SAIC    Made Check consistent with other tests.
- --
- --!
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- with Ada.Numerics.Elementary_Functions;
- procedure CXG2003 is
-    Verbose : constant Boolean := False;
- 
-    package Float_Check is
-       subtype Real is Float;
-       procedure Do_Test;
-    end Float_Check;
- 
-    package body Float_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames
-            Elementary_Functions.Sqrt;
-       function Log (X : Real) return Real renames
-            Elementary_Functions.Log;
-       function Exp (X : Real) return Real renames
-            Elementary_Functions.Exp;
- 
-       -- The default Maximum Relative Error is the value specified
-       -- in the LRM.
-       Default_MRE : constant Real := 2.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real := Default_MRE) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Actual - Expected) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
-  
-      procedure Argument_Range_Check (A, B : Real;
-                                       Test : String) is
-          -- test a logarithmically distributed selection of 
-          -- arguments selected from the range A to B. 
-          X : Real;
-          Expected : Real;
-          Y : Real;
-          C : Real := Log(B/A);
-          Max_Samples : constant := 1000;
- 
-       begin
-          for I in 1..Max_Samples loop
-             Expected :=  A * Exp(C * Real (I) / Real (Max_Samples));
-             X := Expected * Expected;
-             Y := Sqrt (X);
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-             Check (Y, Expected, 
-                    "test " & Test & " -" &
-                    Integer'Image (I) &
-                    " of argument range",
-                    3.0);
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check");
-          when others =>
-             Report.Failed ("exception in argument range check");
-       end Argument_Range_Check;
- 
-       procedure Do_Test is
-       begin
- 
-          --- test 1 ---
-          declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    Y : Real;
-          begin
-             Y := Sqrt (X);
-             Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
-             T : constant := (Real'Model_EMin + 1) / 2;
-             X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    Y : Real;
-          begin
-             Y := Sqrt (X);
-             Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
- 	    X : constant := 1.0;
- 	    Expected : constant := 1.0;
-             Y : Real;
-          begin
-             Y := Sqrt(X);
-             Check (Y, Expected, "test 3 -- sqrt(1.0)", 
-                  0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
- 	    X : constant := 0.0;
- 	    Expected : constant := 0.0;
-             Y : Real;
-          begin
-             Y := Sqrt(X);
-             Check (Y, Expected, "test 4 -- sqrt(0.0)", 
-                  0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
-          --- test 5 ---
- 	 declare
- 	    X : constant := -1.0;
-             Y : Real;
-          begin
-             Y := Sqrt(X);
-             -- the following code should not be executed.
-             -- The call to Check is to keep the call to Sqrt from
-             -- appearing to be dead code.
-             Check (Y, -1.0, "test 5 -- sqrt(-1)" );
-             Report.Failed ("test 5 - argument_error expected");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 5");
-             when Ada.Numerics.Argument_Error =>
-                if Verbose then
-                   Report.Comment ("test 5 correctly got argument_error");
-                end if;
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
-          --- test 6 ---
- 	 declare
-             X : constant := Ada.Numerics.Pi ** 2;
- 	    Expected : constant := Ada.Numerics.Pi;
- 	    Y : Real;
-          begin
-             Y := Sqrt (X);
-             Check (Y, Expected, "test 6 -- sqrt(pi**2)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
-          --- test 7 & 8 ---
-          Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), 
-                                 1.0, 
-                                 "7");
-          Argument_Range_Check (1.0, 
-                                 Sqrt(Real(Real'Machine_Radix)), 
-                                 "8");
-       end Do_Test;
-    end Float_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
- 
- 
-    package A_Long_Float_Check is
-       subtype Real is A_Long_Float;
-       procedure Do_Test;
-    end A_Long_Float_Check;
- 
-    package body A_Long_Float_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames
-            Elementary_Functions.Sqrt;
-       function Log (X : Real) return Real renames
-            Elementary_Functions.Log;
-       function Exp (X : Real) return Real renames
-            Elementary_Functions.Exp;
- 
-       -- The default Maximum Relative Error is the value specified
-       -- in the LRM.
-       Default_MRE : constant Real := 2.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real := Default_MRE) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Actual - Expected) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Argument_Range_Check (A, B : Real;
-                                       Test : String) is
-          -- test a logarithmically distributed selection of 
-          -- arguments selected from the range A to B. 
-          X : Real;
-          Expected : Real;
-          Y : Real;
-          C : Real := Log(B/A);
-          Max_Samples : constant := 1000;
- 
-       begin
-          for I in 1..Max_Samples loop
-             Expected :=  A * Exp(C * Real (I) / Real (Max_Samples));
-             X := Expected * Expected;
-             Y := Sqrt (X);
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-             Check (Y, Expected, 
-                    "test " & Test & " -" &
-                    Integer'Image (I) &
-                    " of argument range",
-                    3.0);
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check");
-          when others =>
-             Report.Failed ("exception in argument range check");
-       end Argument_Range_Check;
- 
- 
-       procedure Do_Test is
-       begin
- 
-          --- test 1 ---
-          declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    Y : Real;
-          begin
-             Y := Sqrt (X);
-             Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
-             T : constant := (Real'Model_EMin + 1) / 2;
-             X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    Y : Real;
-          begin
-             Y := Sqrt (X);
-             Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
- 	    X : constant := 1.0;
- 	    Expected : constant := 1.0;
-             Y : Real;
-          begin
-             Y := Sqrt(X);
-             Check (Y, Expected, "test 3 -- sqrt(1.0)", 
-                  0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
- 	    X : constant := 0.0;
- 	    Expected : constant := 0.0;
-             Y : Real;
-          begin
-             Y := Sqrt(X);
-             Check (Y, Expected, "test 4 -- sqrt(0.0)", 
-                  0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
-          --- test 5 ---
- 	 declare
- 	    X : constant := -1.0;
-             Y : Real;
-          begin
-             Y := Sqrt(X);
-             -- the following code should not be executed.
-             -- The call to Check is to keep the call to Sqrt from
-             -- appearing to be dead code.
-             Check (Y, -1.0, "test 5 -- sqrt(-1)" );
-             Report.Failed ("test 5 - argument_error expected");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 5");
-             when Ada.Numerics.Argument_Error =>
-                if Verbose then
-                   Report.Comment ("test 5 correctly got argument_error");
-                end if;
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
-          --- test 6 ---
- 	 declare
-             X : constant := Ada.Numerics.Pi ** 2;
- 	    Expected : constant := Ada.Numerics.Pi;
- 	    Y : Real;
-          begin
-             Y := Sqrt (X);
-             Check (Y, Expected, "test 6 -- sqrt(pi**2)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
-          --- test 7 & 8 ---
-          Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), 
-                                 1.0, 
-                                 "7");
-          Argument_Range_Check (1.0, 
-                                 Sqrt(Real(Real'Machine_Radix)), 
-                                 "8");
-       end Do_Test;
-    end A_Long_Float_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
-    package Non_Generic_Check is
-       procedure Do_Test;
-    end Non_Generic_Check;
- 
-    package body Non_Generic_Check is
-       package EF renames
-            Ada.Numerics.Elementary_Functions;
-       subtype Real is Float;
- 
-       -- The default Maximum Relative Error is the value specified
-       -- in the LRM.
-       Default_MRE : constant Real := 2.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real := Default_MRE) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Actual - Expected) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
- 
-       procedure Argument_Range_Check (A, B : Float;
-                                       Test : String) is
-          -- test a logarithmically distributed selection of 
-          -- arguments selected from the range A to B. 
-          X : Float;
-          Expected : Float;
-          Y : Float;
-          C : Float := EF.Log(B/A);
-          Max_Samples : constant := 1000;
- 
-       begin
-          for I in 1..Max_Samples loop
-             Expected :=  A * EF.Exp(C * Float (I) / Float (Max_Samples));
-             X := Expected * Expected;
-             Y := EF.Sqrt (X);
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-             Check (Y, Expected, 
-                    "test " & Test & " -" &
-                    Integer'Image (I) &
-                    " of argument range",
-                    3.0);
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check");
-          when others =>
-             Report.Failed ("exception in argument range check");
-       end Argument_Range_Check;
- 
- 
-       procedure Do_Test is
-       begin
- 
-          --- test 1 ---
-          declare
-             T : constant := (Float'Machine_EMax - 1) / 2;
-             X : constant := (1.0 * Float'Machine_Radix) ** (2 * T);
- 	    Expected : constant := (1.0 * Float'Machine_Radix) ** T;
- 	    Y : Float;
-          begin
-             Y := EF.Sqrt (X);
-             Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
-             T : constant := (Float'Model_EMin + 1) / 2;
-             X : constant := (1.0 * Float'Machine_Radix) ** (2 * T);
- 	    Expected : constant := (1.0 * Float'Machine_Radix) ** T;
- 	    Y : Float;
-          begin
-             Y := EF.Sqrt (X);
-             Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
- 	    X : constant := 1.0;
- 	    Expected : constant := 1.0;
-             Y : Float;
-          begin
-             Y := EF.Sqrt(X);
-             Check (Y, Expected, "test 3 -- sqrt(1.0)", 
-                  0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
- 	    X : constant := 0.0;
- 	    Expected : constant := 0.0;
-             Y : Float;
-          begin
-             Y := EF.Sqrt(X);
-             Check (Y, Expected, "test 4 -- sqrt(0.0)", 
-                  0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
-          --- test 5 ---
- 	 declare
- 	    X : constant := -1.0;
-             Y : Float;
-          begin
-             Y := EF.Sqrt(X);
-             -- the following code should not be executed.
-             -- The call to Check is to keep the call to Sqrt from
-             -- appearing to be dead code.
-             Check (Y, -1.0, "test 5 -- sqrt(-1)" );
-             Report.Failed ("test 5 - argument_error expected");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 5");
-             when Ada.Numerics.Argument_Error =>
-                if Verbose then
-                   Report.Comment ("test 5 correctly got argument_error");
-                end if;
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
-          --- test 6 ---
- 	 declare
-             X : constant := Ada.Numerics.Pi ** 2;
- 	    Expected : constant := Ada.Numerics.Pi;
- 	    Y : Float;
-          begin
-             Y := EF.Sqrt (X);
-             Check (Y, Expected, "test 6 -- sqrt(pi**2)");
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
-          --- test 7 & 8 ---
-          Argument_Range_Check (1.0/EF.Sqrt(Float(Float'Machine_Radix)), 
-                                 1.0, 
-                                 "7");
-          Argument_Range_Check (1.0, 
-                                 EF.Sqrt(Float(Float'Machine_Radix)), 
-                                 "8");
-       end Do_Test;
-    end Non_Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- begin
-    Report.Test ("CXG2003",
-                 "Check the accuracy of the sqrt function"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking non-generic package");
-    end if;
- 
-    Non_Generic_Check.Do_Test;
- 
-    Report.Result;
- end CXG2003;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a	Thu Jan  1 00:00:00 1970
***************
*** 1,499 ****
- -- CXG2004.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the sin and cos functions return
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check both float and a long float type.
- --      The test for each floating point type is divided into
- --      the following parts:
- --         Special value checks where the result is a known constant.
- --         Checks using an identity relationship.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      13 FEB 96   SAIC    Initial release for 2.1
- --      22 APR 96   SAIC    Changed to generic implementation.
- --      18 AUG 96   SAIC    Improvements to commentary.
- --      23 OCT 96   SAIC    Exact results are not required unless the
- --                          cycle is specified.  
- --      28 FEB 97   PWB.CTA Removed checks where cycle 2.0*Pi is specified
- --      02 JUN 98   EDS     Revised calculations to ensure that X is exactly
- --                          three times Y per advice of numerics experts.
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- -- The sin and cos checks are translated directly from 
- -- the netlib FORTRAN code that was written by W. Cody.
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- with Ada.Numerics.Elementary_Functions;
- procedure CXG2004 is
-    Verbose : constant Boolean := False;
-    Number_Samples : constant := 1000;
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant := 
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- 
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
- 
-       function Sin (X : Real) return Real renames
-            Elementary_Functions.Sin;
-       function Cos (X : Real) return Real renames
-            Elementary_Functions.Cos;
-       function Sin (X, Cycle : Real) return Real renames
-            Elementary_Functions.Sin;
-       function Cos (X, Cycle : Real) return Real renames
-            Elementary_Functions.Cos;
- 
-       Accuracy_Error_Reported : Boolean := False;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Rel_Error,
-          Abs_Error,
-          Max_Error : Real;
-       begin
- 
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
- 
-          -- in addition to the relative error checks we apply the
-          -- criteria of G.2.4(16)
-          if abs (Actual) > 1.0 then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & " result > 1.0");
-          elsif abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " &
-                            Real'Image (Actual - Expected) &
-                            " mre:" & 
-                            Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Sin_Check (A, B : Real;
-                            Arg_Range : String) is
-          -- test a selection of 
-          -- arguments selected from the range A to B. 
-          --
-          -- This test uses the identity
- 	 --   sin(x) = sin(x/3)*(3 - 4 * sin(x/3)**2)
- 	 --
-          -- Note that in this test we must take into account the
-          -- error in the calculation of the expected result so
-          -- the maximum relative error is larger than the
-          -- accuracy required by the ARM.
- 
-          X, Y, ZZ : Real;
- 	 Actual, Expected : Real;
- 	 MRE : Real;
- 	 Ran : Real;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1 .. Number_Samples loop
- 	    -- Evenly distributed selection of arguments
- 	    Ran := Real (I) / Real (Number_Samples);
- 
- 	    -- make sure x and x/3 are both exactly representable
- 	    -- on the machine.  See "Implementation and Testing of
-             -- Function Software" page 44.
-             X := (B - A) * Ran + A;
-             Y := Real'Leading_Part 
-                       ( X/3.0, 
-                         Real'Machine_Mantissa - Real'Exponent (3.0) );
-             X := Y * 3.0;
- 
- 	    Actual := Sin (X);
- 
- 	    ZZ := Sin(Y);
- 	    Expected := ZZ * (3.0 - 4.0 * ZZ * ZZ);
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-             -- See Cody pp 139-141.
- 	    MRE := 4.0;
- 
-             Check (Actual, Expected,
-                    "sin test of range" & Arg_Range &
-                       Integer'Image (I),
-                    MRE);
-             exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in sin check");
-          when others =>
-             Report.Failed ("exception in sin check");
-       end Sin_Check;
- 
- 
- 
-       procedure Cos_Check (A, B : Real;
-                                   Arg_Range : String) is
-          -- test a selection of 
-          -- arguments selected from the range A to B. 
-          --
-          -- This test uses the identity
- 	 --   cos(x) = cos(x/3)*(4 * cos(x/3)**2 - 3)
- 	 --
-          -- Note that in this test we must take into account the
-          -- error in the calculation of the expected result so
-          -- the maximum relative error is larger than the
-          -- accuracy required by the ARM.
- 
-          X, Y, ZZ : Real;
- 	 Actual, Expected : Real;
- 	 MRE : Real;
- 	 Ran : Real;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1 .. Number_Samples loop
- 	    -- Evenly distributed selection of arguments
- 	    Ran := Real (I) / Real (Number_Samples);
- 
- 	    -- make sure x and x/3 are both exactly representable
- 	    -- on the machine.  See "Implementation and Testing of
-             -- Function Software" page 44.
-             X := (B - A) * Ran + A;
-             Y := Real'Leading_Part 
-                       ( X/3.0, 
-                         Real'Machine_Mantissa - Real'Exponent (3.0) );
-             X := Y * 3.0;
- 
- 	    Actual := Cos (X);
- 
- 	    ZZ := Cos(Y);
- 	    Expected := ZZ * (4.0 * ZZ * ZZ - 3.0);
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-             -- See Cody pp 141-143.
- 	    MRE := 6.0;
- 
-             Check (Actual, Expected,
-                    "cos test of range" & Arg_Range &
-                       Integer'Image (I),
-                    MRE);
-             exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in cos check");
-          when others =>
-             Report.Failed ("exception in cos check");
-       end Cos_Check;
- 
- 
-       procedure Special_Angle_Checks is
-          type Data_Point is 
-             record
-                Degrees,
-                Radians,
-                Sine,
-                Cosine         : Real;
-                Sin_Result_Error,
-                Cos_Result_Error : Boolean;
-             end record;
- 
-          type Test_Data_Type is array (Positive range <>) of Data_Point;
- 
-          -- the values in the following table only involve static
-          -- expressions to minimize any loss of precision.  However,
-          -- there are two sources of error that must be accounted for
-          -- in the following tests.
-          -- First, when a cycle is not specified there can be a roundoff
-          -- error in the value of Pi used.  This error does not apply
-          -- when a cycle of 2.0 * Pi is explicitly provided.
-          -- Second, the expected results that involve sqrt values also
-          -- have a potential roundoff error.
-          -- The amount of error due to error in the argument is computed
-          -- as follows:
-          --   sin(x+err) = sin(x)*cos(err) + cos(x)*sin(err)
-          --              ~= sin(x) + err * cos(x)
-          -- similarly for cos the error due to error in the argument is
-          -- computed as follows:
-          --   cos(x+err) = cos(x)*cos(err) - sin(x)*sin(err)
-          --              ~= cos(x) - err * sin(x)
-          -- In both cases the term "err" is bounded by 0.5 * argument.
- 
-          Test_Data : constant Test_Data_Type := (
- --  degrees      radians          sine       cosine  sin_er cos_er    test #
-   (  0.0,           0.0,          0.0,         1.0,  False, False ),    -- 1
-   ( 30.0,        Pi/6.0,          0.5,   Sqrt3/2.0,  False, True  ),    -- 2
-   ( 60.0,        Pi/3.0,    Sqrt3/2.0,         0.5,  True,  False ),    -- 3
-   ( 90.0,        Pi/2.0,          1.0,         0.0,  False, False ),    -- 4
-   (120.0,    2.0*Pi/3.0,    Sqrt3/2.0,        -0.5,  True,  False ),    -- 5
-   (150.0,    5.0*Pi/6.0,          0.5,  -Sqrt3/2.0,  False, True  ),    -- 6
-   (180.0,            Pi,          0.0,        -1.0,  False, False ),    -- 7
-   (210.0,    7.0*Pi/6.0,         -0.5,  -Sqrt3/2.0,  False, True  ),    -- 8
-   (240.0,    8.0*Pi/6.0,   -Sqrt3/2.0,        -0.5,  True,  False ),    -- 9
-   (270.0,    9.0*Pi/6.0,         -1.0,         0.0,  False, False ),    -- 10
-   (300.0,   10.0*Pi/6.0,   -Sqrt3/2.0,         0.5,  True,  False ),    -- 11
-   (330.0,   11.0*Pi/6.0,         -0.5,   Sqrt3/2.0,  False, True  ),    -- 12
-   (360.0,        2.0*Pi,          0.0,         1.0,  False, False ),    -- 13
-   ( 45.0,        Pi/4.0,    Sqrt2/2.0,   Sqrt2/2.0,  True,  True  ),    -- 14
-   (135.0,    3.0*Pi/4.0,    Sqrt2/2.0,  -Sqrt2/2.0,  True,  True  ),    -- 15
-   (225.0,    5.0*Pi/4.0,   -Sqrt2/2.0,  -Sqrt2/2.0,  True,  True  ),    -- 16
-   (315.0,    7.0*Pi/4.0,   -Sqrt2/2.0,   Sqrt2/2.0,  True,  True  ),    -- 17
-   (405.0,    9.0*Pi/4.0,    Sqrt2/2.0,   Sqrt2/2.0,  True,  True  ) );  -- 18
-             
-      
-          Y : Real;
-          Sin_Arg_Err,
-          Cos_Arg_Err,
-          Sin_Result_Err,
-          Cos_Result_Err  : Real;
-       begin
-          for I in Test_Data'Range loop
-             -- compute error components
-             Sin_Arg_Err := abs Test_Data (I).Cosine * 
-                            abs Test_Data (I).Radians / 2.0;
-             Cos_Arg_Err := abs Test_Data (I).Sine * 
-                            abs Test_Data (I).Radians / 2.0;
- 
-             if Test_Data (I).Sin_Result_Error then
-                Sin_Result_Err := 0.5;
-             else 
-                Sin_Result_Err := 0.0;
-             end if;
- 
-             if Test_Data (I).Cos_Result_Error then
-                Cos_Result_Err := 1.0;
-             else 
-                Cos_Result_Err := 0.0;
-             end if;
- 
- 
- 
-             Y := Sin (Test_Data (I).Radians);
-             Check (Y, Test_Data (I).Sine,
-                    "test" & Integer'Image (I) & " sin(r)",
-                    2.0 + Sin_Arg_Err + Sin_Result_Err); 
-             Y := Cos (Test_Data (I).Radians);
-             Check (Y, Test_Data (I).Cosine,
-                    "test" & Integer'Image (I) & " cos(r)",
-                    2.0 + Cos_Arg_Err + Cos_Result_Err); 
-             Y := Sin (Test_Data (I).Degrees, 360.0);
-             Check (Y, Test_Data (I).Sine,
-                    "test" & Integer'Image (I) & " sin(d,360)",
-                    2.0 + Sin_Result_Err); 
-             Y := Cos (Test_Data (I).Degrees, 360.0);
-             Check (Y, Test_Data (I).Cosine,
-                    "test" & Integer'Image (I) & " cos(d,360)",
-                    2.0 + Cos_Result_Err); 
- --pwb-math            Y := Sin (Test_Data (I).Radians, 2.0*Pi);
- --pwb-math            Check (Y, Test_Data (I).Sine,
- --pwb-math                   "test" & Integer'Image (I) & " sin(r,2pi)",
- --pwb-math                   2.0 + Sin_Result_Err); 
- --pwb-math            Y := Cos (Test_Data (I).Radians, 2.0*Pi);
- --pwb-math            Check (Y, Test_Data (I).Cosine,
- --pwb-math                   "test" & Integer'Image (I) & " cos(r,2pi)",
- --pwb-math                   2.0 + Cos_Result_Err); 
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in special angle test");
-          when others =>
-             Report.Failed ("exception in special angle test");
-       end Special_Angle_Checks;
- 
- 
-       -- check the rule of A.5.1(41);6.0 which requires that the
-       -- result be exact if the mathematical result is 0.0, 1.0,
-       -- or -1.0
-       procedure Exact_Result_Checks is
-          type Data_Point is 
-             record
-                Degrees,
-                Sine,
-                Cosine         : Real;
-             end record;
- 
-          type Test_Data_Type is array (Positive range <>) of Data_Point;
-          Test_Data : constant Test_Data_Type := (
-             -- degrees       sine       cosine       test #
-               (  0.0,         0.0,         1.0  ),    -- 1
-               ( 90.0,         1.0,         0.0  ),    -- 2
-               (180.0,         0.0,        -1.0  ),    -- 3
-               (270.0,        -1.0,         0.0  ),    -- 4
-               (360.0,         0.0,         1.0  ),    -- 5
-               ( 90.0 + 360.0, 1.0,         0.0  ),    -- 6
-               (180.0 + 360.0, 0.0,        -1.0  ),    -- 7
-               (270.0 + 360.0,-1.0,         0.0  ),    -- 8
-               (360.0 + 360.0, 0.0,         1.0  ) );  -- 9
-          
-          Y : Real;   
-       begin
-          for I in Test_Data'Range loop
-             Y := Sin (Test_Data(I).Degrees, 360.0);
-             if Y /= Test_Data(I).Sine then
-                Report.Failed ("exact result for sin(" &
-                   Real'Image (Test_Data(I).Degrees) & 
-                   ", 360.0) is not" &
-                   Real'Image (Test_Data(I).Sine) &
-                   "  Difference is " &
-                   Real'Image (Y - Test_Data(I).Sine) );
-             end if;
- 
-             Y := Cos (Test_Data(I).Degrees, 360.0);
-             if Y /= Test_Data(I).Cosine then
-                Report.Failed ("exact result for cos(" &
-                   Real'Image (Test_Data(I).Degrees) & 
-                   ", 360.0) is not" &
-                   Real'Image (Test_Data(I).Cosine) &
-                   "  Difference is " &
-                   Real'Image (Y - Test_Data(I).Cosine) );
-             end if;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in exact result check");
-          when others =>
-             Report.Failed ("exception in exact result check");
-       end Exact_Result_Checks;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Angle_Checks;
-          Sin_Check (0.0, Pi/2.0, "0..pi/2");
-          Sin_Check (6.0*Pi, 6.5*Pi, "6pi..6.5pi");
-          Cos_Check (7.0*Pi, 7.5*Pi, "7pi..7.5pi");
-          Exact_Result_Checks;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2004",
-                 "Check the accuracy of the sin and cos functions"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
-    Report.Result;
- end CXG2004;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a	Thu Jan  1 00:00:00 1970
***************
*** 1,204 ****
- -- CXG2005.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that floating point addition and multiplication
- --      have the required accuracy.
- --
- -- TEST DESCRIPTION:
- --      The check for the required precision is essentially a
- --      check that a guard digit is used for the operations.
- --      This test uses a generic package to check the addition
- --      and multiplication results.  The
- --      generic package is instantiated with the standard FLOAT
- --      type and a floating point type for the maximum number
- --      of digits of precision.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --
- --
- -- CHANGE HISTORY:
- --      14 FEB 96   SAIC    Initial Release for 2.1
- --      16 SEP 99   RLB     Repaired to avoid printing thousands of (almost)
- --                          identical failure messages.
- --!
- 
- -- References:
- --
- --    Basic Concepts for Computational Software
- --    W. J. Cody
- --    Problems and Methodologies in Mathematical Software Production
- --    editors P. C. Messina and A. Murli
- --    Lecture Notes in Computer Science   Vol 142
- --    Springer Verlag,  1982
- --
- --    Software Manual for the Elementary Functions
- --    William J. Cody and William Waite
- --    Prentice-Hall, 1980
- --
- 
- with System;
- with Report;
- procedure CXG2005 is
-    Verbose : constant Boolean := False;
- 
-    generic
-       type Real is digits <>;
-    package Guard_Digit_Check is
-       procedure Do_Test;
-    end Guard_Digit_Check;
- 
-    package body Guard_Digit_Check is
-       -- made global so that the compiler will be more likely
-       -- to keep the values in memory instead of in higher
-       -- precision registers.
-       X, Y, Z : Real;
-       OneX : Real;
-       Eps, BN : Real;
- 
-       -- special constants - not declared as constants so that
-       -- the "stored" precision will be used instead of a "register"
-       -- precision.
-       Zero : Real := 0.0;
-       One  : Real := 1.0;
-       Two  : Real := 2.0;
- 
-       Failure_Count : Natural := 0;
- 
-       procedure Thwart_Optimization is
-       -- the purpose of this procedure is to reference the
-       -- global variables used by the test so
-       -- that the compiler is not likely to keep them in
-       -- a higher precision register for their entire lifetime.
-       begin
- 	 if Report.Ident_Bool (False) then
- 	    -- never executed
- 	    X := X + 5.0;
- 	    Y := Y + 6.0;
- 	    Z := Z + 1.0;
- 	    Eps := Eps + 2.0;
- 	    BN := BN + 2.0;
-             OneX := X + Y;
-             One := 12.34;   Two := 56.78;  Zero := 90.12;
- 	 end if;
-       end Thwart_Optimization;
- 
- 
-       procedure Addition_Test is
-       begin
-          for K in 1..10 loop
- 	    Eps := Real (K) * Real'Model_Epsilon;
- 	    for N in 1.. Real'Machine_EMax - 1 loop
- 	       BN := Real(Real'Machine_Radix) ** N;
- 	       X := (One + Eps) * BN;
- 	       Y := (One - Eps) * BN;
- 	       Z := X - Y; -- true value for Z is 2*Eps*BN
- 
- 	       if Z /= Eps*BN + Eps*BN then
- 		  Report.Failed ("addition check failed.  K=" &
- 		     Integer'Image (K) &
- 		     "  N=" & Integer'Image (N) &
- 		     "  difference=" & Real'Image (Z - 2.0*Eps*BN) &
- 		     "  Eps*BN=" & Real'Image (Eps*BN) );
-                   Failure_Count := Failure_Count + 1;
-                   exit when Failure_Count > K*4; -- Avoid displaying dozens of messages.
- 	       end if;
- 	    end loop;
- 	 end loop;
-       exception
- 	 when others =>
- 	    Thwart_Optimization;
-             Report.Failed ("unexpected exception in addition test");
-       end Addition_Test;
- 
- 
-       procedure Multiplication_Test is
-       begin
- 	  X := Real (Real'Machine_Radix) ** (Real'Machine_EMax - 1);
- 	  OneX := One * X;
- 	  Thwart_Optimization;
- 	  if OneX /= X then
- 	     Report.Failed ("multiplication for large values");
- 	  end if;
- 
- 	  X := Real (Real'Machine_Radix) ** (Real'Model_EMin + 1);
- 	  OneX := One * X;
- 	  Thwart_Optimization;
- 	  if OneX /= X then
- 	     Report.Failed ("multiplication for small values");
- 	  end if;
- 
- 	  -- selection of "random" values between 1/radix and radix
-           Y := One / Real (Real'Machine_Radix);
-           Z := Real(Real'Machine_Radix) - One/Real(Real'Machine_Radix);
- 	  for I in 0..100 loop
- 	     X := Y + Real (I) / 100.0 * Z;
- 	     OneX := One * X;
- 	     Thwart_Optimization;
- 	     if OneX /= X then
-                 Report.Failed ("multiplication for case" & Integer'Image (I));
-                 exit when Failure_Count > 40+8; -- Avoid displaying dozens of messages.
- 	     end if;
- 	  end loop;
-       exception
- 	 when others =>
- 	    Thwart_Optimization;
-             Report.Failed ("unexpected exception in multiplication test");
-       end Multiplication_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Addition_Test;
-          Multiplication_Test;
-       end Do_Test;
-    end Guard_Digit_Check;
- 
-    package Chk_Float is new Guard_Digit_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package Chk_A_Long_Float is new Guard_Digit_Check (A_Long_Float);
- begin
-    Report.Test ("CXG2005",
-                 "Check the accuracy of floating point" &
-                 " addition and multiplication");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
-    Chk_Float.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" &
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
-    Chk_A_Long_Float.Do_Test;
- 
-    Report.Result;
- end CXG2005;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a	Thu Jan  1 00:00:00 1970
***************
*** 1,281 ****
- -- CXG2006.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex Argument function returns
- --      results that are within the error bound allowed.
- --      Check that Argument_Error is raised if the Cycle parameter
- --      is less than or equal to zero.
- --
- -- TEST DESCRIPTION:
- --      This test uses a generic package to compute and check the
- --      values of the Argument function.  
- --      Of special interest is the case where either the real or
- --      the imaginary part of the parameter is very large while the
- --      other part is very small or 0. 
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      15 FEB 96   SAIC    Initial release for 2.1
- --      03 MAR 97   PWB.CTA Removed checks involving explicit cycle => 2.0*Pi
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- --
- -- Reference:
- -- Problems and Methodologies in Mathematical Software Production;
- -- editors: P. C. Messina and A Murli;
- -- Lecture Notes in Computer Science
- -- Volume 142
- -- Springer Verlag 1982
- --
- 
- with System;
- with Report;
- with ImpDef.Annex_G;
- with Ada.Numerics;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Complex_Types;
- procedure CXG2006 is
-    Verbose : constant Boolean := False;
- 
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant := 
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- 
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Complex_Types is new 
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Types;
- 
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Actual - Expected) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Cases is
-          type Data_Point is 
-             record
-                Re,
-                Im,
-                Radians,
-                Degrees,
-                Error_Bound   : Real;
-             end record;
- 
-          type Test_Data_Type is array (Positive range <>) of Data_Point;
- 
-          -- the values in the following table only involve static
-          -- expressions to minimize errors in precision introduced by the
-          -- test.  For cases where Pi is used in the argument we must
-          -- allow an extra 1.0*MRE to account for roundoff error in the
-          -- argument.  Where the result involves a square root we allow
-          -- an extra 0.5*MRE to allow for roundoff error.
-          Test_Data : constant Test_Data_Type := (
- --    Re               Im                     Radians  Degrees  Err    Test #
-     (0.0,               0.0,                       0.0,   0.0,  4.0 ),  -- 1
-     (1.0,               0.0,                       0.0,   0.0,  4.0 ),  -- 2
-     (Real'Safe_Last,    0.0,                       0.0,   0.0,  4.0 ),  -- 3
-     (Real'Model_Small,  0.0,                       0.0,   0.0,  4.0 ),  -- 4
-     (1.0,               1.0,                    Pi/4.0,  45.0,  5.0 ),  -- 5
-     (1.0,              -1.0,                   -Pi/4.0, -45.0,  5.0 ),  -- 6
-     (-1.0,             -1.0,               -3.0*Pi/4.0,-135.0,  5.0 ),  -- 7 
-     (-1.0,              1.0,                3.0*Pi/4.0, 135.0,  5.0 ),  -- 8 
-     (Sqrt3,             1.0,                    Pi/6.0,  30.0,  5.5 ),  -- 9
-     (-Sqrt3,            1.0,                5.0*Pi/6.0, 150.0,  5.5 ),  -- 10
-     (Sqrt3,            -1.0,                   -Pi/6.0, -30.0,  5.5 ),  -- 11
-     (-Sqrt3,           -1.0,               -5.0*Pi/6.0,-150.0,  5.5 ),  -- 12
-     (Real'Model_Small,  Real'Model_Small,       Pi/4.0,  45.0,  5.0 ),  -- 13
-     (-Real'Safe_Last,   0.0,                        Pi, 180.0,  5.0 ),  -- 14
-     (-Real'Safe_Last,  -Real'Model_Small,          -Pi,-180.0,  5.0 ),  -- 15
-     (100000.0,          100000.0,               Pi/4.0,  45.0,  5.0 )); -- 16
-     
-          X : Real;
-          Z : Complex;
-       begin
-          for I in Test_Data'Range loop
-             begin
-                Z := (Test_Data(I).Re, Test_Data(I).Im);
-                X := Argument (Z);
- 	       Check (X, Test_Data(I).Radians, 
-                    "test" & Integer'Image (I) & " argument(z)",
-                    Test_Data (I).Error_Bound); 
- --pwb-math               X := Argument (Z, 2.0*Pi);
- --pwb-math	       Check (X, Test_Data(I).Radians, 
- --pwb-math                   "test" & Integer'Image (I) & " argument(z, 2pi)",
- --pwb-math                   Test_Data (I).Error_Bound); 
-                X := Argument (Z, 360.0);
- 	       Check (X, Test_Data(I).Degrees, 
-                    "test" & Integer'Image (I) & " argument(z, 360)",
-                    Test_Data (I).Error_Bound); 
- 
-             exception
-                when Constraint_Error => 
-                   Report.Failed ("Constraint_Error raised in test" &
-                       Integer'Image (I));
-                when others =>
-                   Report.Failed ("exception in test" &
-                       Integer'Image (I));
-             end;
-          end loop;
-         
- 	 if Real'Signed_Zeros then
- 	    begin
- 	      X := Argument ((-1.0, Real(ImpDef.Annex_G.Negative_Zero)));
- 	      Check (X, -Pi, "test of arg((-1,-0)", 4.0);
- 	    exception
- 	       when others =>
- 		  Report.Failed ("exception in signed zero test");
- 	    end;
- 	 end if;
-       end Special_Cases;
- 
- 
-       procedure Exception_Cases is
-       -- check that Argument_Error is raised if Cycle is <= 0
- 	 Z : Complex := (1.0, 1.0);
- 	 X : Real;
- 	 Y : Real;
-       begin
- 	 begin
- 	   X := Argument (Z, Cycle => 0.0);
- 	   Report.Failed ("no exception for cycle = 0.0");
- 	 exception
- 	    when Ada.Numerics.Argument_Error => null;
- 	    when others =>
- 	       Report.Failed ("wrong exception for cycle = 0.0");
- 	 end;
- 
- 	 begin
- 	   Y := Argument (Z, Cycle => -3.0);
- 	   Report.Failed ("no exception for cycle < 0.0");
- 	 exception
- 	    when Ada.Numerics.Argument_Error => null;
- 	    when others =>
- 	       Report.Failed ("wrong exception for cycle < 0.0");
- 	 end;
- 
-          if Report.Ident_Int (2) = 1 then
-             -- optimization thwarting code - never executed
-             Report.Failed("2=1" & Real'Image (X+Y));
-          end if;
-       end Exception_Cases;
- 
- 
-       procedure Do_Test is
-       begin
- 	 Special_Cases;
- 	 Exception_Cases;
-       end Do_Test;
-    end Generic_Check;
- 
-    package Chk_Float is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
- begin
-    Report.Test ("CXG2006",
-                 "Check the accuracy of the complex argument" &
-                 " function");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Chk_Float.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    Chk_A_Long_Float.Do_Test;
- 
-    Report.Result;
- end CXG2006;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a	Thu Jan  1 00:00:00 1970
***************
*** 1,291 ****
- -- CXG2007.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex Compose_From_Polar function returns
- --      results that are within the error bound allowed.
- --      Check that Argument_Error is raised if the Cycle parameter
- --      is less than or equal to zero.
- --
- -- TEST DESCRIPTION:
- --      This test uses a generic package to compute and check the
- --      values of the Compose_From_Polar function.  
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      23 FEB 96   SAIC    Initial release for 2.1
- --      23 APR 96   SAIC    Fixed error checking
- --      03 MAR 97   PWB.CTA Deleted checks with explicit Cycle => 2.0*Pi
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- with System;
- with Report;
- with Ada.Numerics;
- with Ada.Numerics.Generic_Complex_Types;
- procedure CXG2007 is
-    Verbose : constant Boolean := False;
- 
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant := 
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- 
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Complex_Types is new 
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Types;
- 
-       Maximum_Relative_Error : constant Real := 3.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real;
-                        Arg_Error : Real) is
-          -- Arg_Error is additional absolute error that is allowed beyond
-          -- the MRE to account for error in the result that can be
-          -- attributed to error in the arguments.
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Small instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
-          Max_Error := Max_Error + Arg_Error;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MRE : Real;
-                        Arg_Error : Real) is
-          -- Arg_Error is additional absolute error that is allowed beyond
-          -- the MRE to account for error in the result that can be
-          -- attributed to error in the arguments.
-       begin
-          Check (Actual.Re, Expected.Re, 
-                 Test_Name & " real part",
-                 MRE, Arg_Error);
-          Check (Actual.Im, Expected.Im, 
-                 Test_Name & " imaginary part",
-                 MRE, Arg_Error);
-       end Check;
- 
- 
-       procedure Special_Cases is
-          type Data_Point is 
-             record
-                Re,
-                Im,
- 	       Modulus,
-                Radians,
-                Degrees,
- 	       Arg_Error : Real;
-             end record;
- 
- 	 -- shorthand names for various constants
- 	 P4 : constant := Pi/4.0;
- 	 P6 : constant := Pi/6.0;
- 
- 	 MER2 : constant Real := Real'Model_Epsilon * Sqrt2;
- 
-          type Test_Data_Type is array (Positive range <>) of Data_Point;
- 
-          -- the values in the following table only involve static
-          -- expressions so no loss of precision occurs.
-          Test_Data : constant Test_Data_Type := (
-          --Re          Im   Modulus     Radians  Degrees  Arg_Err
-          ( 0.0,        0.0, 0.0,            0.0,   0.0,    0.0 ),    -- 1
-          ( 0.0,        0.0, 0.0,             Pi, 180.0,    0.0 ),    -- 2
-          
-          ( 1.0,        0.0, 1.0,            0.0,   0.0,    0.0 ),    -- 3
-          (-1.0,        0.0, -1.0,           0.0,   0.0,    0.0 ),    -- 4
-          
-          ( 1.0,        1.0,  Sqrt2,          P4,  45.0,    MER2),    -- 5
-          (-1.0,        1.0, -Sqrt2,         -P4, -45.0,    MER2),    -- 6
-          ( 1.0,       -1.0,  Sqrt2,         -P4, -45.0,    MER2),    -- 7
-          (-1.0,       -1.0, -Sqrt2,          P4,  45.0,    MER2),    -- 8
-          (-1.0,       -1.0,  Sqrt2,     -3.0*P4,-135.0,    MER2),    -- 9 
-          (-1.0,        1.0,  Sqrt2,      3.0*P4, 135.0,    MER2),    -- 10
-          ( 1.0,       -1.0, -Sqrt2,      3.0*P4, 135.0,    MER2),    -- 11
-          
-          (-1.0,        0.0, 1.0,             Pi, 180.0,    0.0 ),    -- 12
-          ( 1.0,        0.0, -1.0,            Pi, 180.0,    0.0 ) );  -- 13
- 
-     
-          Z : Complex;
- 	 Exp : Complex;
-       begin
-          for I in Test_Data'Range loop
-             begin
- 	       Exp := (Test_Data (I).Re, Test_Data (I).Im);
- 
-                Z := Compose_From_Polar (Test_Data (I).Modulus,
- 					Test_Data (I).Radians);
- 	       Check (Z, Exp,
-                  "test" & Integer'Image (I) & " compose_from_polar(m,r)",
- 		 Maximum_Relative_Error, Test_Data (I).Arg_Error); 
- 
- --pwb-math               Z := Compose_From_Polar (Test_Data (I).Modulus, 
- --pwb-math					Test_Data (I).Radians,
- --pwb-math					2.0*Pi);
- --pwb-math	       Check (Z, Exp,
- --pwb-math                 "test" & Integer'Image (I) & " compose_from_polar(m,r,2pi)",
- --pwb-math		 Maximum_Relative_Error, Test_Data (I).Arg_Error); 
- 
-                Z := Compose_From_Polar (Test_Data (I).Modulus, 
- 					Test_Data (I).Degrees,
- 					360.0);
- 	       Check (Z, Exp,
-                  "test" & Integer'Image (I) & " compose_from_polar(m,d,360)",
- 		 Maximum_Relative_Error, Test_Data (I).Arg_Error);
- 
-             exception
-                when Constraint_Error => 
-                   Report.Failed ("Constraint_Error raised in test" &
-                       Integer'Image (I));
-                when others =>
-                   Report.Failed ("exception in test" &
-                       Integer'Image (I));
-             end;
-          end loop;
-       end Special_Cases;
- 
- 
-       procedure Exception_Cases is
-       -- check that Argument_Error is raised if Cycle is <= 0
- 	 Z : Complex; 
- 	 W : Complex; 
-       begin
- 	 begin
- 	   Z := Compose_From_Polar (3.0, 0.0, Cycle => 0.0);
- 	   Report.Failed ("no exception for cycle = 0.0");
- 	 exception
- 	    when Ada.Numerics.Argument_Error => null;
- 	    when others =>
- 	       Report.Failed ("wrong exception for cycle = 0.0");
- 	 end;
- 
- 	 begin
- 	   W := Compose_From_Polar (6.0, 1.0, Cycle => -10.0);
- 	   Report.Failed ("no exception for cycle < 0.0");
- 	 exception
- 	    when Ada.Numerics.Argument_Error => null;
- 	    when others =>
- 	       Report.Failed ("wrong exception for cycle < 0.0");
- 	 end;
- 
- 	 if Report.Ident_Int (1) = 2 then
- 	     -- not executed - used to make it appear that we use the
- 	     -- results of the above computation
- 	     Z := Z * W;
- 	     Report.Failed(Real'Image (Z.Re + Z.Im));
- 	 end if;
-       end Exception_Cases;
- 
- 
-       procedure Do_Test is
-       begin
- 	 Special_Cases;
- 	 Exception_Cases;
-       end Do_Test;
-    end Generic_Check;
- 
-    package Chk_Float is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
- begin
-    Report.Test ("CXG2007",
-                 "Check the accuracy of the Compose_From_Polar" &
-                 " function");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
-    Chk_Float.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
-    Chk_A_Long_Float.Do_Test;
- 
-    Report.Result;
- end CXG2007;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a	Thu Jan  1 00:00:00 1970
***************
*** 1,948 ****
- -- CXG2008.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex multiplication and division
- --      operations return results that are within the allowed
- --      error bound.
- --      Check that all the required pure Numerics packages are pure.
- --
- -- TEST DESCRIPTION:
- --      This test contains three test packages that are almost
- --      identical.  The first two packages differ only in the
- --      floating point type that is being tested.  The first
- --      and third package differ only in whether the generic
- --      complex types package or the pre-instantiated
- --      package is used.
- --      The test package is not generic so that the arguments
- --      and expected results for some of the test values
- --      can be expressed as universal real instead of being
- --      computed at runtime.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      24 FEB 96   SAIC    Initial release for 2.1
- --      03 JUN 98   EDS     Correct the test program's incorrect assumption
- --                          that Constraint_Error must be raised by complex
- --                          division by zero, which is contrary to the
- --                          allowance given by the Ada 95 standard G.1.1(40).
- --      13 MAR 01   RLB     Replaced commented out Pure check on non-generic
- --                          packages, as required by Defect Report
- --                          8652/0020 and as reflected in Technical
- --                          Corrigendum 1.
- --!
- 
- ------------------------------------------------------------------------------
- -- Check that the required pure packages are pure by withing them from a
- -- pure package. The non-generic versions of those packages are required to
- -- be pure by Defect Report 8652/0020, Technical Corrigendum 1 [A.5.1(9/1) and
- -- G.1.1(25/1)].
- with Ada.Numerics.Generic_Elementary_Functions;
- with Ada.Numerics.Elementary_Functions;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Complex_Types;
- with Ada.Numerics.Generic_Complex_Elementary_Functions;
- with Ada.Numerics.Complex_Elementary_Functions;
- package CXG2008_0 is
-   pragma Pure;
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant :=
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- end CXG2008_0;
- 
- ------------------------------------------------------------------------------
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Complex_Types;
- with CXG2008_0;  use CXG2008_0;
- procedure CXG2008 is
-    Verbose : constant Boolean := False;
- 
-    package Float_Check is
-       subtype Real is Float;
-       procedure Do_Test;
-    end Float_Check;
- 
-    package body Float_Check is
-       package Complex_Types is new
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Types;
- 
-       -- keep track if an accuracy failure has occurred so the test
-       -- can be short-circuited to avoid thousands of error messages.
-       Failure_Detected : Boolean := False;
- 
-       Mult_MBE : constant Real := 5.0;
-       Divide_MBE : constant Real := 13.0;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MBE : Real) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
-          Abs_Error := MBE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
- 
-          if abs (Actual.Re - Expected.Re) > Max_Error then
-             Failure_Detected := True;
-             Report.Failed (Test_Name &
-                            " actual.re: " & Real'Image (Actual.Re) &
-                            " expected.re: " & Real'Image (Expected.Re) &
-                            " difference.re " &
-                            Real'Image (Actual.Re - Expected.Re) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & " exact result for real part");
- 	    else
- 	       Report.Comment (Test_Name & " passed for real part");
- 	    end if;
-          end if;
- 
-          Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
-          if abs (Actual.Im - Expected.Im) > Max_Error then
-             Failure_Detected := True;
-             Report.Failed (Test_Name &
-                            " actual.im: " & Real'Image (Actual.Im) &
-                            " expected.im: " & Real'Image (Expected.Im) &
-                            " difference.im " &
-                            Real'Image (Actual.Im - Expected.Im) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & " exact result for imaginary part");
- 	    else
- 	       Report.Comment (Test_Name & " passed for imaginary part");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Values is
-       begin
- 
-          --- test 1 ---
-          declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    Expected : Complex := (0.0, 0.0);
-             X : Complex := (0.0, 0.0);
- 	    Y : Complex := (Big, Big);
-             Z : Complex;
-          begin
-             Z := X * Y;
-             Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
-                    Mult_MBE);
-             Z := Y * X;
-             Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
-             T : constant := Real'Model_EMin + 1;
-             Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    U : Complex := (Tiny, Tiny);
-             X : Complex := (0.0, 0.0);
- 	    Expected : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             Z := U * X;
-             Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    B : Complex := (Big, Big);
-             X : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             if Real'Machine_Overflows then
-                Z := B / X;
-                Report.Failed ("test 3 - Constraint_Error not raised");
-                Check (Z, Z, "not executed - optimizer thwarting", 0.0);
-             end if;
-          exception
-             when Constraint_Error => null;  -- expected
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
-             T : constant := Real'Model_EMin + 1;
-             Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    U : Complex := (Tiny, Tiny);
-             X : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             if Real'Machine_Overflows then
-                Z := U / X;
-                Report.Failed ("test 4 - Constraint_Error not raised");
-                Check (Z, Z, "not executed - optimizer thwarting", 0.0);
-             end if;
-          exception
-             when Constraint_Error => null;  -- expected
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
- 
-          --- test 5 ---
- 	 declare
- 	    X : Complex := (Sqrt2, Sqrt2);
-             Z : Complex;
-             Expected : constant Complex := (0.0, 4.0);
-          begin
-             Z := X * X;
-             Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 5");
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
-          --- test 6 ---
- 	 declare
- 	    X : Complex := Sqrt3 - Sqrt3 * i;
-             Z : Complex;
-             Expected : constant Complex := (0.0, -6.0);
-          begin
-             Z := X * X;
-             Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
-          --- test 7 ---
- 	 declare
- 	    X : Complex := Sqrt2 + Sqrt2 * i;
- 	    Y : Complex := Sqrt2 - Sqrt2 * i;
-             Z : Complex;
-             Expected : constant Complex := 0.0 + i;
-          begin
-             Z := X / Y;
-             Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
-                    Divide_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 7");
-             when others =>
-                Report.Failed ("exception in test 7");
-          end;
-       end Special_Values;
- 
- 
-       procedure Do_Mult_Div (X, Y : Complex) is
- 	 Z : Complex;
- 	 Args : constant String :=
- 	   "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
- 	   "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
-       begin
- 	 Z := (X * X) / X;
- 	 Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
- 	 Z := (X * Y) / X;
- 	 Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
- 	 Z := (X * Y) / Y;
- 	 Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
-          when others =>
-             Report.Failed ("exception in Do_Mult_Div for " & Args);
-       end Do_Mult_Div;
- 
-       -- select complex values X and Y where the real and imaginary
-       -- parts are selected from the ranges (1/radix..1) and
-       -- (1..radix).  This translates into quite a few combinations.
-       procedure Mult_Div_Check is
-          Samples : constant := 17;
- 	 Radix : constant Real := Real(Real'Machine_Radix);
- 	 Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
- 	 Low_Sample : Real;  -- (1/radix .. 1)
- 	 High_Sample : Real; -- (1 .. radix)
- 	 Sample : array (1..2) of Real;
- 	 X, Y : Complex;
-       begin
-          for I in 1 .. Samples loop
-             Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
- 			  Inv_Radix;
- 	    Sample (1) := Low_Sample;
- 	    for J in 1 .. Samples loop
-                High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
- 			      Radix;
- 	       Sample (2) := High_Sample;
- 	       for K in 1 .. 2 loop
- 		  for L in 1 .. 2 loop
- 		     X := Complex'(Sample (K), Sample (L));
- 		     Y := Complex'(Sample (L), Sample (K));
- 		     Do_Mult_Div (X, Y);
-                      if Failure_Detected then
-                         return;   -- minimize flood of error messages
-                      end if;
- 		  end loop;
- 	       end loop;
-             end loop;  -- J
-          end loop;  -- I
-       end Mult_Div_Check;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Values;
-          Mult_Div_Check;
-       end Do_Test;
-    end Float_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    -- check the floating point type with the most digits
- 
-    package A_Long_Float_Check is
-       type A_Long_Float is digits System.Max_Digits;
-       subtype Real is A_Long_Float;
-       procedure Do_Test;
-    end A_Long_Float_Check;
- 
-    package body A_Long_Float_Check is
- 
-       package Complex_Types is new
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Types;
- 
-       -- keep track if an accuracy failure has occurred so the test
-       -- can be short-circuited to avoid thousands of error messages.
-       Failure_Detected : Boolean := False;
- 
-       Mult_MBE : constant Real := 5.0;
-       Divide_MBE : constant Real := 13.0;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MBE : Real) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
-          Abs_Error := MBE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
- 
-          if abs (Actual.Re - Expected.Re) > Max_Error then
-             Failure_Detected := True;
-             Report.Failed (Test_Name &
-                            " actual.re: " & Real'Image (Actual.Re) &
-                            " expected.re: " & Real'Image (Expected.Re) &
-                            " difference.re " &
-                            Real'Image (Actual.Re - Expected.Re) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & " exact result for real part");
- 	    else
- 	       Report.Comment (Test_Name & " passed for real part");
- 	    end if;
-          end if;
- 
-          Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
-          if abs (Actual.Im - Expected.Im) > Max_Error then
-             Failure_Detected := True;
-             Report.Failed (Test_Name &
-                            " actual.im: " & Real'Image (Actual.Im) &
-                            " expected.im: " & Real'Image (Expected.Im) &
-                            " difference.im " &
-                            Real'Image (Actual.Im - Expected.Im) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & " exact result for imaginary part");
- 	    else
- 	       Report.Comment (Test_Name & " passed for imaginary part");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Values is
-       begin
- 
-          --- test 1 ---
-          declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    Expected : Complex := (0.0, 0.0);
-             X : Complex := (0.0, 0.0);
- 	    Y : Complex := (Big, Big);
-             Z : Complex;
-          begin
-             Z := X * Y;
-             Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
-                    Mult_MBE);
-             Z := Y * X;
-             Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
-             T : constant := Real'Model_EMin + 1;
-             Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    U : Complex := (Tiny, Tiny);
-             X : Complex := (0.0, 0.0);
- 	    Expected : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             Z := U * X;
-             Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    B : Complex := (Big, Big);
-             X : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             if Real'Machine_Overflows then
-                Z := B / X;
-                Report.Failed ("test 3 - Constraint_Error not raised");
-                Check (Z, Z, "not executed - optimizer thwarting", 0.0);
-             end if;
-          exception
-             when Constraint_Error => null;  -- expected
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
-             T : constant := Real'Model_EMin + 1;
-             Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    U : Complex := (Tiny, Tiny);
-             X : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             if Real'Machine_Overflows then
-                Z := U / X;
-                Report.Failed ("test 4 - Constraint_Error not raised");
-                Check (Z, Z, "not executed - optimizer thwarting", 0.0);
-             end if;
-          exception
-             when Constraint_Error => null;  -- expected
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
- 
-          --- test 5 ---
- 	 declare
- 	    X : Complex := (Sqrt2, Sqrt2);
-             Z : Complex;
-             Expected : constant Complex := (0.0, 4.0);
-          begin
-             Z := X * X;
-             Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 5");
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
-          --- test 6 ---
- 	 declare
- 	    X : Complex := Sqrt3 - Sqrt3 * i;
-             Z : Complex;
-             Expected : constant Complex := (0.0, -6.0);
-          begin
-             Z := X * X;
-             Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
-          --- test 7 ---
- 	 declare
- 	    X : Complex := Sqrt2 + Sqrt2 * i;
- 	    Y : Complex := Sqrt2 - Sqrt2 * i;
-             Z : Complex;
-             Expected : constant Complex := 0.0 + i;
-          begin
-             Z := X / Y;
-             Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
-                    Divide_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 7");
-             when others =>
-                Report.Failed ("exception in test 7");
-          end;
-       end Special_Values;
- 
- 
-       procedure Do_Mult_Div (X, Y : Complex) is
- 	 Z : Complex;
- 	 Args : constant String :=
- 	   "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
- 	   "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
-       begin
- 	 Z := (X * X) / X;
- 	 Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
- 	 Z := (X * Y) / X;
- 	 Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
- 	 Z := (X * Y) / Y;
- 	 Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
-          when others =>
-             Report.Failed ("exception in Do_Mult_Div for " & Args);
-       end Do_Mult_Div;
- 
-       -- select complex values X and Y where the real and imaginary
-       -- parts are selected from the ranges (1/radix..1) and
-       -- (1..radix).  This translates into quite a few combinations.
-       procedure Mult_Div_Check is
-          Samples : constant := 17;
- 	 Radix : constant Real := Real(Real'Machine_Radix);
- 	 Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
- 	 Low_Sample : Real;  -- (1/radix .. 1)
- 	 High_Sample : Real; -- (1 .. radix)
- 	 Sample : array (1..2) of Real;
- 	 X, Y : Complex;
-       begin
-          for I in 1 .. Samples loop
-             Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
- 			  Inv_Radix;
- 	    Sample (1) := Low_Sample;
- 	    for J in 1 .. Samples loop
-                High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
- 			      Radix;
- 	       Sample (2) := High_Sample;
- 	       for K in 1 .. 2 loop
- 		  for L in 1 .. 2 loop
- 		     X := Complex'(Sample (K), Sample (L));
- 		     Y := Complex'(Sample (L), Sample (K));
- 		     Do_Mult_Div (X, Y);
-                      if Failure_Detected then
-                         return;   -- minimize flood of error messages
-                      end if;
- 		  end loop;
- 	       end loop;
-             end loop;  -- J
-          end loop;  -- I
-       end Mult_Div_Check;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Values;
-          Mult_Div_Check;
-       end Do_Test;
-    end A_Long_Float_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
-    package Non_Generic_Check is
-       subtype Real is Float;
-       procedure Do_Test;
-    end Non_Generic_Check;
- 
-    package body Non_Generic_Check is
- 
-       use Ada.Numerics.Complex_Types;
- 
-       -- keep track if an accuracy failure has occurred so the test
-       -- can be short-circuited to avoid thousands of error messages.
-       Failure_Detected : Boolean := False;
- 
-       Mult_MBE : constant Real := 5.0;
-       Divide_MBE : constant Real := 13.0;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MBE : Real) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
-          Abs_Error := MBE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
- 
-          if abs (Actual.Re - Expected.Re) > Max_Error then
-             Failure_Detected := True;
-             Report.Failed (Test_Name &
-                            " actual.re: " & Real'Image (Actual.Re) &
-                            " expected.re: " & Real'Image (Expected.Re) &
-                            " difference.re " &
-                            Real'Image (Actual.Re - Expected.Re) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & " exact result for real part");
- 	    else
- 	       Report.Comment (Test_Name & " passed for real part");
- 	    end if;
-          end if;
- 
-          Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
-          if abs (Actual.Im - Expected.Im) > Max_Error then
-             Failure_Detected := True;
-             Report.Failed (Test_Name &
-                            " actual.im: " & Real'Image (Actual.Im) &
-                            " expected.im: " & Real'Image (Expected.Im) &
-                            " difference.im " &
-                            Real'Image (Actual.Im - Expected.Im) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & " exact result for imaginary part");
- 	    else
- 	       Report.Comment (Test_Name & " passed for imaginary part");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Values is
-       begin
- 
-          --- test 1 ---
-          declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    Expected : Complex := (0.0, 0.0);
-             X : Complex := (0.0, 0.0);
- 	    Y : Complex := (Big, Big);
-             Z : Complex;
-          begin
-             Z := X * Y;
-             Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
-                    Mult_MBE);
-             Z := Y * X;
-             Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
-             T : constant := Real'Model_EMin + 1;
-             Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    U : Complex := (Tiny, Tiny);
-             X : Complex := (0.0, 0.0);
- 	    Expected : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             Z := U * X;
-             Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
-             T : constant := (Real'Machine_EMax - 1) / 2;
-             Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
- 	    B : Complex := (Big, Big);
-             X : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             if Real'Machine_Overflows then
-                Z := B / X;
-                Report.Failed ("test 3 - Constraint_Error not raised");
-                Check (Z, Z, "not executed - optimizer thwarting", 0.0);
-             end if;
-          exception
-             when Constraint_Error => null;  -- expected
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
-             T : constant := Real'Model_EMin + 1;
-             Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
- 	    U : Complex := (Tiny, Tiny);
-             X : Complex := (0.0, 0.0);
- 	    Z : Complex;
-          begin
-             if Real'Machine_Overflows then
-                Z := U / X;
-                Report.Failed ("test 4 - Constraint_Error not raised");
-                Check (Z, Z, "not executed - optimizer thwarting", 0.0);
-             end if;
-          exception
-             when Constraint_Error => null;  -- expected
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
- 
-          --- test 5 ---
- 	 declare
- 	    X : Complex := (Sqrt2, Sqrt2);
-             Z : Complex;
-             Expected : constant Complex := (0.0, 4.0);
-          begin
-             Z := X * X;
-             Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 5");
-             when others =>
-                Report.Failed ("exception in test 5");
-          end;
- 
-          --- test 6 ---
- 	 declare
- 	    X : Complex := Sqrt3 - Sqrt3 * i;
-             Z : Complex;
-             Expected : constant Complex := (0.0, -6.0);
-          begin
-             Z := X * X;
-             Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
-                    Mult_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 6");
-             when others =>
-                Report.Failed ("exception in test 6");
-          end;
- 
-          --- test 7 ---
- 	 declare
- 	    X : Complex := Sqrt2 + Sqrt2 * i;
- 	    Y : Complex := Sqrt2 - Sqrt2 * i;
-             Z : Complex;
-             Expected : constant Complex := 0.0 + i;
-          begin
-             Z := X / Y;
-             Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
-                    Divide_MBE);
-          exception
-             when Constraint_Error =>
-                Report.Failed ("Constraint_Error raised in test 7");
-             when others =>
-                Report.Failed ("exception in test 7");
-          end;
-       end Special_Values;
- 
- 
-       procedure Do_Mult_Div (X, Y : Complex) is
- 	 Z : Complex;
- 	 Args : constant String :=
- 	   "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
- 	   "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
-       begin
- 	 Z := (X * X) / X;
- 	 Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
- 	 Z := (X * Y) / X;
- 	 Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
- 	 Z := (X * Y) / Y;
- 	 Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
-          when others =>
-             Report.Failed ("exception in Do_Mult_Div for " & Args);
-       end Do_Mult_Div;
- 
-       -- select complex values X and Y where the real and imaginary
-       -- parts are selected from the ranges (1/radix..1) and
-       -- (1..radix).  This translates into quite a few combinations.
-       procedure Mult_Div_Check is
-          Samples : constant := 17;
- 	 Radix : constant Real := Real(Real'Machine_Radix);
- 	 Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
- 	 Low_Sample : Real;  -- (1/radix .. 1)
- 	 High_Sample : Real; -- (1 .. radix)
- 	 Sample : array (1..2) of Real;
- 	 X, Y : Complex;
-       begin
-          for I in 1 .. Samples loop
-             Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
- 			  Inv_Radix;
- 	    Sample (1) := Low_Sample;
- 	    for J in 1 .. Samples loop
-                High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
- 			      Radix;
- 	       Sample (2) := High_Sample;
- 	       for K in 1 .. 2 loop
- 		  for L in 1 .. 2 loop
- 		     X := Complex'(Sample (K), Sample (L));
- 		     Y := Complex'(Sample (L), Sample (K));
- 		     Do_Mult_Div (X, Y);
-                      if Failure_Detected then
-                         return;   -- minimize flood of error messages
-                      end if;
- 		  end loop;
- 	       end loop;
-             end loop;  -- J
-          end loop;  -- I
-       end Mult_Div_Check;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Values;
-          Mult_Div_Check;
-       end Do_Test;
-    end Non_Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- begin
-    Report.Test ("CXG2008",
-                 "Check the accuracy of the complex multiplication and" &
-                 " division operators");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" &
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking non-generic package");
-    end if;
- 
-    Non_Generic_Check.Do_Test;
- 
-    Report.Result;
- end CXG2008;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a	Thu Jan  1 00:00:00 1970
***************
*** 1,421 ****
- -- CXG2009.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the real sqrt and complex modulus functions
- --      return results that are within the allowed
- --      error bound.
- --
- -- TEST DESCRIPTION:
- --      This test checks the accuracy of the sqrt and modulus functions 
- --      by computing the norm of various vectors where the result
- --      is known in advance.
- --      This test uses real and complex math together as would an 
- --      actual application.  Considerable use of generics is also
- --      employed.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      26 FEB 96   SAIC    Initial release for 2.1
- --      22 AUG 96   SAIC    Revised Check procedure
- --
- --!
- 
- ------------------------------------------------------------------------------
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2009 is
-    Verbose : constant Boolean := False;
- 
-    --=====================================================================
- 
-    generic
-       type Real is digits <>;
-    package Generic_Real_Norm_Check is
-       procedure Do_Test;
-    end Generic_Real_Norm_Check;
- 
-    -----------------------------------------------------------------------
- 
-    package body Generic_Real_Norm_Check is
-       type Vector is array (Integer range <>) of Real;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames GEF.Sqrt;
- 
-       function One_Norm (V : Vector) return Real is
-       -- sum of absolute values of the elements of the vector
- 	 Result : Real := 0.0;
-       begin
- 	 for I in V'Range loop
- 	    Result := Result + abs V(I);
- 	 end loop;
- 	 return Result;
-       end One_Norm;
- 
-       function Inf_Norm (V : Vector) return Real is
-       -- greatest absolute vector element
- 	 Result : Real := 0.0;
-       begin
- 	 for I in V'Range loop
- 	    if abs V(I) > Result then
- 	       Result := abs V(I);
- 	    end if;
- 	 end loop;
- 	 return Result;
-       end Inf_Norm;
- 
-       function Two_Norm (V : Vector) return Real is
-       -- if greatest absolute vector element is 0 then return 0
-       -- else return greatest * sqrt (sum((element / greatest) ** 2)))
-       --   where greatest is Inf_Norm of the vector
- 	 Inf_N : Real;
- 	 Sum_Squares : Real;
- 	 Term : Real;
-       begin
- 	 Inf_N := Inf_Norm (V);
- 	 if Inf_N = 0.0 then
- 	    return 0.0;
- 	 end if;
-          Sum_Squares := 0.0;
- 	 for I in V'Range loop
- 	    Term := V (I) / Inf_N;
- 	    Sum_Squares := Sum_Squares + Term * Term;
- 	 end loop;
- 	 return Inf_N * Sqrt (Sum_Squares);
-       end Two_Norm;
- 
- 
-       procedure Check (Actual, Expected : Real;
- 		       Test_Name : String;
- 		       MRE : Real;
- 		       Vector_Length : Integer) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
- 	                     "  VectLength:" & 
-                            Integer'Image (Vector_Length) &
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Actual - Expected) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
-             Report.Comment (Test_Name & " vector length" &
-                             Integer'Image (Vector_Length));
- 	  end if;
-       end Check;
- 
- 
-       procedure Do_Test is
-       begin
- 	 for Vector_Length in 1 .. 10 loop
- 	    declare
- 	       V  : Vector (1..Vector_Length) := (1..Vector_Length => 0.0);
- 	       V1 : Vector (1..Vector_Length) := (1..Vector_Length => 1.0);
- 	    begin
- 	       Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length);
- 	       Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length);
- 
- 	       for J in 1..Vector_Length loop
- 		 V := (1..Vector_Length => 0.0);
- 		 V (J) := 1.0;
- 	         Check (One_Norm (V), 1.0, "one_norm (010)", 
- 			0.0, Vector_Length);
- 	         Check (Inf_Norm (V), 1.0, "inf_norm (010)", 
- 			0.0, Vector_Length);
- 	         Check (Two_Norm (V), 1.0, "two_norm (010)", 
- 			0.0, Vector_Length);
- 	       end loop;
- 
- 	       Check (One_Norm (V1), Real (Vector_Length), "one_norm (1)", 
- 		      0.0, Vector_Length);
- 	       Check (Inf_Norm (V1), 1.0, "inf_norm (1)", 
- 		      0.0, Vector_Length);
- 
-                -- error in computing Two_Norm and expected result
-                -- are as follows  (ME is Model_Epsilon * Expected_Value):
-                --   2ME from expected Sqrt
-                --   2ME from Sqrt in Two_Norm times the error in the
-                --   vector calculation.
-                --   The vector calculation contains the following error
-                --   based upon the length N of the vector:
-                --      N*1ME from squaring terms in Two_Norm
-                --      N*1ME from the division of each term in Two_Norm
-                --      (N-1)*1ME from the sum of the terms
-                -- This gives (2 + 2 * (N + N + (N-1)) ) * ME
-                -- which simplifies to (2 + 2N + 2N + 2N - 2) * ME
-                -- or 6*N*ME
- 	       Check (Two_Norm (V1), Sqrt (Real(Vector_Length)), 
-                       "two_norm (1)", 
- 		      (Real (6 * Vector_Length)), 
- 		      Vector_Length);
- 	    exception
- 	       when others => Report.Failed ("exception for vector length" &
- 				Integer'Image (Vector_Length) );
- 	    end;
- 	 end loop;
-       end Do_Test;
-    end Generic_Real_Norm_Check;
- 
-    --=====================================================================
- 
-    generic
-       type Real is digits <>;
-    package Generic_Complex_Norm_Check is
-       procedure Do_Test;
-    end Generic_Complex_Norm_Check;
- 
-    -----------------------------------------------------------------------
- 
-    package body Generic_Complex_Norm_Check is
-       package Complex_Types is new Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Types;
-       type Vector is array (Integer range <>) of Complex;
- 
-       package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames GEF.Sqrt;
- 
-       function One_Norm (V : Vector) return Real is
- 	 Result : Real := 0.0;
-       begin
- 	 for I in V'Range loop
- 	    Result := Result + abs V(I);
- 	 end loop;
- 	 return Result;
-       end One_Norm;
- 
-       function Inf_Norm (V : Vector) return Real is
- 	 Result : Real := 0.0;
-       begin
- 	 for I in V'Range loop
- 	    if abs V(I) > Result then
- 	       Result := abs V(I);
- 	    end if;
- 	 end loop;
- 	 return Result;
-       end Inf_Norm;
- 
-       function Two_Norm (V : Vector) return Real is
- 	 Inf_N : Real;
- 	 Sum_Squares : Real;
- 	 Term : Real;
-       begin
- 	 Inf_N := Inf_Norm (V);
- 	 if Inf_N = 0.0 then
- 	    return 0.0;
- 	 end if;
-          Sum_Squares := 0.0;
- 	 for I in V'Range loop
- 	    Term := abs (V (I) / Inf_N );
- 	    Sum_Squares := Sum_Squares + Term * Term;
- 	 end loop;
- 	 return Inf_N * Sqrt (Sum_Squares);
-       end Two_Norm;
- 
- 
-       procedure Check (Actual, Expected : Real;
- 		       Test_Name : String;
- 		       MRE : Real;
- 		       Vector_Length : Integer) is
-          Rel_Error : Real;
-          Abs_Error : Real;
-          Max_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Report.Failed (Test_Name & 
- 	                     "  VectLength:" & 
-                            Integer'Image (Vector_Length) &
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & 
-                            Real'Image (Actual - Expected) &
-                            " mre:" & Real'Image (Max_Error) );
-          elsif Verbose then
-             Report.Comment (Test_Name & " vector length" &
-                             Integer'Image (Vector_Length));
- 	  end if;
-       end Check;
- 
- 
-       procedure Do_Test is
-       begin
- 	 for Vector_Length in 1 .. 10 loop
- 	    declare
- 	       V  : Vector (1..Vector_Length) := 
-                       (1..Vector_Length => (0.0, 0.0));
-                X, Y : Vector (1..Vector_Length);
- 	    begin
- 	       Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length);
- 	       Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length);
- 
- 	       for J in 1..Vector_Length loop
- 		 X := (1..Vector_Length => (0.0, 0.0) );
-                  Y := X;   -- X and Y are now both zeroed
- 		 X (J).Re := 1.0;
-                  Y (J).Im := 1.0;
- 	         Check (One_Norm (X), 1.0, "one_norm (0x0)", 
- 			0.0, Vector_Length);
- 	         Check (Inf_Norm (X), 1.0, "inf_norm (0x0)", 
- 			0.0, Vector_Length);
- 	         Check (Two_Norm (X), 1.0, "two_norm (0x0)", 
- 			0.0, Vector_Length);
- 	         Check (One_Norm (Y), 1.0, "one_norm (0y0)", 
- 			0.0, Vector_Length);
- 	         Check (Inf_Norm (Y), 1.0, "inf_norm (0y0)", 
- 			0.0, Vector_Length);
- 	         Check (Two_Norm (Y), 1.0, "two_norm (0y0)", 
- 			0.0, Vector_Length);
- 	       end loop;
- 
-                V := (1..Vector_Length => (3.0, 4.0));
- 
-                -- error in One_Norm is 3*N*ME for abs computation +
-                --  (N-1)*ME for the additions
-                -- which gives (4N-1) * ME
- 	       Check (One_Norm (V), 5.0 * Real (Vector_Length), 
- 		      "one_norm ((3,4))", 
- 		      Real (4*Vector_Length - 1), 
- 		      Vector_Length);
- 
-                -- error in Inf_Norm is from abs of single element (3ME)
- 	       Check (Inf_Norm (V), 5.0, 
- 		      "inf_norm ((3,4))", 
- 		      3.0, 
- 		      Vector_Length);
- 
-                -- error in following comes from:
-                --   2ME in sqrt of expected result
-                --   3ME in Inf_Norm calculation
-                --   2ME in sqrt of vector calculation
-                --   vector calculation has following error
-                --      3N*ME for abs
-                --       N*ME for squaring
-                --       N*ME for division
-                --       (N-1)ME for sum
-                -- this results in [2 + 3 + 2(6N-1) ] * ME
-                -- or (12N + 3)ME
- 	       Check (Two_Norm (V), 5.0 * Sqrt (Real(Vector_Length)), 
-                       "two_norm ((3,4))", 
- 		      (12.0 * Real (Vector_Length) + 3.0), 
- 		      Vector_Length);
- 	    exception
- 	       when others => Report.Failed ("exception for complex " &
-                                              "vector length" &
- 	                                     Integer'Image (Vector_Length) );
- 	    end;
- 	 end loop;
-       end Do_Test;
-    end Generic_Complex_Norm_Check;
- 
-    --=====================================================================
- 
-    generic
-       type Real is digits <>;
-    package Generic_Norm_Check is
-       procedure Do_Test;
-    end Generic_Norm_Check;
- 
-    -----------------------------------------------------------------------
- 
-    package body Generic_Norm_Check is
-       package RNC is new Generic_Real_Norm_Check (Real);
-       package CNC is new Generic_Complex_Norm_Check (Real);
-       procedure Do_Test is
-       begin
-          RNC.Do_Test;
-          CNC.Do_Test;
-       end Do_Test;
-    end Generic_Norm_Check;
- 
-    --=====================================================================
- 
-    package Float_Check is new Generic_Norm_Check (Float);
- 
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Norm_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
- 
- begin
-    Report.Test ("CXG2009",
-                 "Check the accuracy of the real sqrt and complex " &
-                 " modulus functions"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
-    Report.Result;
- end CXG2009;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,892 ****
- -- CXG2010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the exp function returns
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test contains three test packages that are almost
- --      identical.  The first two packages differ only in the 
- --      floating point type that is being tested.  The first
- --      and third package differ only in whether the generic
- --      elementary functions package or the pre-instantiated
- --      package is used.
- --      The test package is not generic so that the arguments
- --      and expected results for some of the test values
- --      can be expressed as universal real instead of being
- --      computed at runtime.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex and where the Machine_Radix is 2, 4, 8, or 16.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --       1 Mar 96   SAIC    Initial release for 2.1
- --       2 Sep 96   SAIC    Improved check routine 
- --
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- 
- --
- -- Notes on derivation of error bound for exp(p)*exp(-p)
- --
- -- Let a = true value of exp(p) and ac be the computed value.
- -- Then a = ac(1+e1), where |e1| <= 4*Model_Epsilon.
- -- Similarly, let b = true value of exp(-p) and bc be the computed value.
- -- Then b = bc(1+e2), where |e2| <= 4*ME.
- -- 
- -- The product of x and y is (x*y)(1+e3), where |e3| <= 1.0ME
- -- 
- -- Hence, the computed ab is [ac(1+e1)*bc(1+e2)](1+e3) =
- -- (ac*bc)[1 + e1 + e2 + e3 + e1e2 + e1e3 + e2e3 + e1e2e3).
- -- 
- -- Throwing away the last four tiny terms, we have (ac*bc)(1 + eta),
- -- 
- -- where |eta| <= (4+4+1)ME = 9.0Model_Epsilon.
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- with Ada.Numerics.Elementary_Functions;
- procedure CXG2010 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1000;
-    Accuracy_Error_Reported : Boolean := False;
- 
-    package Float_Check is
-       subtype Real is Float;
-       procedure Do_Test;
-    end Float_Check;
- 
-    package body Float_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames
-            Elementary_Functions.Sqrt;
-       function Exp (X : Real) return Real renames
-            Elementary_Functions.Exp;
- 
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero 
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon 
-          -- instead of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Argument_Range_Check_1 (A, B : Real;
-                                         Test : String) is
-          -- test a evenly distributed selection of 
-          -- arguments selected from the range A to B. 
- 	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
- 	 -- The parameter One_Minus_Exp_Minus_V is the value
- 	 --   1.0 - Exp (-V) 
- 	 -- accurate to machine precision.
-          -- This procedure is a translation of part of Cody's test 
-          X : Real;
-          Y : Real;
- 	 ZX, ZY : Real;
-          V : constant := 1.0 / 16.0;
-          One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2;
- 
-       begin
-          Accuracy_Error_Reported := False;
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             Y := X - V;
- 	    if Y < 0.0 then 
- 	       X := Y + V;
- 	    end if;
- 
- 	    ZX := Exp (X);
- 	    ZY := Exp (Y);
- 
- 	    -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V);
- 	    -- which simplifies to ZX := Exp (X-V);
- 	    ZX := ZX - ZX * One_Minus_Exp_Minus_V;
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-           Check (ZY, ZX, 
-                  "test " & Test & " -" &
-                  Integer'Image (I) &
- 	     	     " exp (" & Real'Image (X) & ")",
-                  9.0);
-            exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check 1");
-          when others =>
-             Report.Failed ("exception in argument range check 1");
-       end Argument_Range_Check_1;
- 
- 
- 
-       procedure Argument_Range_Check_2 (A, B : Real;
-                                         Test : String) is
-          -- test a evenly distributed selection of 
-          -- arguments selected from the range A to B. 
- 	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
- 	 -- The parameter One_Minus_Exp_Minus_V is the value
- 	 --   1.0 - Exp (-V) 
- 	 -- accurate to machine precision.
-          -- This procedure is a translation of part of Cody's test 
-          X : Real;
-          Y : Real;
- 	 ZX, ZY : Real;
-          V : constant := 45.0 / 16.0;
-             -- 1/16 - Exp(45/16)
-          Coeff : constant := 2.4453321046920570389E-3;
- 
-       begin
-          Accuracy_Error_Reported := False;
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             Y := X - V;
- 	    if Y < 0.0 then 
- 	       X := Y + V;
- 	    end if;
- 
- 	    ZX := Exp (X);
- 	    ZY := Exp (Y);
- 
- 	    -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff;
-             -- where Coeff is 1/16 - Exp(45/16)
- 	    -- which simplifies to ZX := Exp (X-V);
- 	    ZX := ZX * 0.0625 - ZX * Coeff;
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-           Check (ZY, ZX, 
-                  "test " & Test & " -" &
-                  Integer'Image (I) &
-                  " exp (" & Real'Image (X) & ")",
-                  9.0);
-            exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check 2");
-          when others =>
-             Report.Failed ("exception in argument range check 2");
-       end Argument_Range_Check_2;
- 
- 
-       procedure Do_Test is
-       begin
- 
-          --- test 1 ---
-          declare
- 	    Y : Real;
-          begin
-             Y := Exp(1.0);
-             -- normal accuracy requirements
-             Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
- 	    Y : Real;
-          begin
-             Y := Exp(16.0) * Exp(-16.0);
-             Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
-             Y : Real;
-          begin
-             Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi);
-             Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
-             Y : Real;
-          begin
-             Y := Exp(0.0);
-             Check (Y, 1.0, "test 4 -- exp(0.0)", 
-                    0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
-          --- test 5 ---
-          -- constants used here only have 19 digits of precision
-          if Real'Digits > 19 then
-             Error_Low_Bound := 0.00000_00000_00000_0001;
-             Report.Comment ("exp accuracy checked to 19 digits");
-          end if;
- 
-          Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), 
-                                   1.0, 
-                                   "5");
-          Error_Low_Bound := 0.0;  -- reset
- 
- 	 --- test 6 ---
-          -- constants used here only have 19 digits of precision
-          if Real'Digits > 19 then
-             Error_Low_Bound := 0.00000_00000_00000_0001;
-             Report.Comment ("exp accuracy checked to 19 digits");
-          end if;
- 
-          Argument_Range_Check_2 (1.0, 
-                                  Sqrt(Real(Real'Machine_Radix)), 
-                                  "6");
-          Error_Low_Bound := 0.0;  -- reset
- 
-       end Do_Test;
-    end Float_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
- 
- 
-    package A_Long_Float_Check is
-       subtype Real is A_Long_Float;
-       procedure Do_Test;
-    end A_Long_Float_Check;
- 
-    package body A_Long_Float_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames
-            Elementary_Functions.Sqrt;
-       function Exp (X : Real) return Real renames
-            Elementary_Functions.Exp;
- 
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero 
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon 
-          -- instead of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Argument_Range_Check_1 (A, B : Real;
-                                         Test : String) is
-          -- test a evenly distributed selection of 
-          -- arguments selected from the range A to B. 
- 	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
- 	 -- The parameter One_Minus_Exp_Minus_V is the value
- 	 --   1.0 - Exp (-V) 
- 	 -- accurate to machine precision.
-          -- This procedure is a translation of part of Cody's test 
-          X : Real;
-          Y : Real;
- 	 ZX, ZY : Real;
-          V : constant := 1.0 / 16.0;
-          One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2;
- 
-       begin
-          Accuracy_Error_Reported := False;
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             Y := X - V;
- 	    if Y < 0.0 then 
- 	       X := Y + V;
- 	    end if;
- 
- 	    ZX := Exp (X);
- 	    ZY := Exp (Y);
- 
- 	    -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V);
- 	    -- which simplifies to ZX := Exp (X-V);
- 	    ZX := ZX - ZX * One_Minus_Exp_Minus_V;
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-           Check (ZY, ZX, 
-                  "test " & Test & " -" &
-                  Integer'Image (I) &
-                  " exp (" & Real'Image (X) & ")",
-                  9.0);
-            exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check 1");
-          when others =>
-             Report.Failed ("exception in argument range check 1");
-       end Argument_Range_Check_1;
- 
- 
- 
-       procedure Argument_Range_Check_2 (A, B : Real;
-                                         Test : String) is
-          -- test a evenly distributed selection of 
-          -- arguments selected from the range A to B. 
- 	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
- 	 -- The parameter One_Minus_Exp_Minus_V is the value
- 	 --   1.0 - Exp (-V) 
- 	 -- accurate to machine precision.
-          -- This procedure is a translation of part of Cody's test 
-          X : Real;
-          Y : Real;
- 	 ZX, ZY : Real;
-          V : constant := 45.0 / 16.0;
-             -- 1/16 - Exp(45/16)
-          Coeff : constant := 2.4453321046920570389E-3;
- 
-       begin
-          Accuracy_Error_Reported := False;
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             Y := X - V;
- 	    if Y < 0.0 then 
- 	       X := Y + V;
- 	    end if;
- 
- 	    ZX := Exp (X);
- 	    ZY := Exp (Y);
- 
- 	    -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff;
-             -- where Coeff is 1/16 - Exp(45/16)
- 	    -- which simplifies to ZX := Exp (X-V);
- 	    ZX := ZX * 0.0625 - ZX * Coeff;
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-           Check (ZY, ZX, 
-                  "test " & Test & " -" &
-                  Integer'Image (I) &
-                  " exp (" & Real'Image (X) & ")",
-                  9.0);
-            exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check 2");
-          when others =>
-             Report.Failed ("exception in argument range check 2");
-       end Argument_Range_Check_2;
- 
- 
-       procedure Do_Test is
-       begin
- 
-          --- test 1 ---
-          declare
- 	    Y : Real;
-          begin
-             Y := Exp(1.0);
-             -- normal accuracy requirements
-             Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
- 	    Y : Real;
-          begin
-             Y := Exp(16.0) * Exp(-16.0);
-             Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
-             Y : Real;
-          begin
-             Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi);
-             Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
-             Y : Real;
-          begin
-             Y := Exp(0.0);
-             Check (Y, 1.0, "test 4 -- exp(0.0)", 
-                    0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
-          --- test 5 ---
-          -- constants used here only have 19 digits of precision
-          if Real'Digits > 19 then
-             Error_Low_Bound := 0.00000_00000_00000_0001;
-             Report.Comment ("exp accuracy checked to 19 digits");
-          end if;
- 
-          Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), 
-                                   1.0, 
-                                   "5");
-          Error_Low_Bound := 0.0;  -- reset
- 
- 	 --- test 6 ---
-          -- constants used here only have 19 digits of precision
-          if Real'Digits > 19 then
-             Error_Low_Bound := 0.00000_00000_00000_0001;
-             Report.Comment ("exp accuracy checked to 19 digits");
-          end if;
- 
-          Argument_Range_Check_2 (1.0, 
-                                  Sqrt(Real(Real'Machine_Radix)), 
-                                  "6");
-          Error_Low_Bound := 0.0;  -- reset
- 
-       end Do_Test;
-    end A_Long_Float_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
-    package Non_Generic_Check is
-       procedure Do_Test;
-       subtype Real is Float;
-    end Non_Generic_Check;
- 
-    package body Non_Generic_Check is
- 
-       package Elementary_Functions renames 
-            Ada.Numerics.Elementary_Functions;
-       function Sqrt (X : Real) return Real renames
-            Elementary_Functions.Sqrt;
-       function Exp (X : Real) return Real renames
-            Elementary_Functions.Exp;
- 
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero 
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon 
-          -- instead of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Argument_Range_Check_1 (A, B : Real;
-                                         Test : String) is
-          -- test a evenly distributed selection of 
-          -- arguments selected from the range A to B. 
- 	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
- 	 -- The parameter One_Minus_Exp_Minus_V is the value
- 	 --   1.0 - Exp (-V) 
- 	 -- accurate to machine precision.
-          -- This procedure is a translation of part of Cody's test 
-          X : Real;
-          Y : Real;
- 	 ZX, ZY : Real;
-          V : constant := 1.0 / 16.0;
-          One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2;
- 
-       begin
-          Accuracy_Error_Reported := False;
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             Y := X - V;
- 	    if Y < 0.0 then 
- 	       X := Y + V;
- 	    end if;
- 
- 	    ZX := Exp (X);
- 	    ZY := Exp (Y);
- 
- 	    -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V);
- 	    -- which simplifies to ZX := Exp (X-V);
- 	    ZX := ZX - ZX * One_Minus_Exp_Minus_V;
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-           Check (ZY, ZX, 
-                  "test " & Test & " -" &
-                  Integer'Image (I) &
-                  " exp (" & Real'Image (X) & ")",
-                  9.0);
-            exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check 1");
-          when others =>
-             Report.Failed ("exception in argument range check 1");
-       end Argument_Range_Check_1;
- 
- 
- 
-       procedure Argument_Range_Check_2 (A, B : Real;
-                                         Test : String) is
-          -- test a evenly distributed selection of 
-          -- arguments selected from the range A to B. 
- 	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
- 	 -- The parameter One_Minus_Exp_Minus_V is the value
- 	 --   1.0 - Exp (-V) 
- 	 -- accurate to machine precision.
-          -- This procedure is a translation of part of Cody's test 
-          X : Real;
-          Y : Real;
- 	 ZX, ZY : Real;
-          V : constant := 45.0 / 16.0;
-             -- 1/16 - Exp(45/16)
-          Coeff : constant := 2.4453321046920570389E-3;
- 
-       begin
-          Accuracy_Error_Reported := False;
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             Y := X - V;
- 	    if Y < 0.0 then 
- 	       X := Y + V;
- 	    end if;
- 
- 	    ZX := Exp (X);
- 	    ZY := Exp (Y);
- 
- 	    -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff;
-             -- where Coeff is 1/16 - Exp(45/16)
- 	    -- which simplifies to ZX := Exp (X-V);
- 	    ZX := ZX * 0.0625 - ZX * Coeff;
- 
-             -- note that since the expected value is computed, we
-             -- must take the error in that computation into account.
-           Check (ZY, ZX, 
-                  "test " & Test & " -" &
-                  Integer'Image (I) &
-                  " exp (" & Real'Image (X) & ")",
-                  9.0);
-            exit when Accuracy_Error_Reported;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in argument range check 2");
-          when others =>
-             Report.Failed ("exception in argument range check 2");
-       end Argument_Range_Check_2;
- 
- 
-       procedure Do_Test is
-       begin
- 
-          --- test 1 ---
-          declare
- 	    Y : Real;
-          begin
-             Y := Exp(1.0);
-             -- normal accuracy requirements
-             Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
- 	 declare
- 	    Y : Real;
-          begin
-             Y := Exp(16.0) * Exp(-16.0);
-             Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
- 	 declare
-             Y : Real;
-          begin
-             Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi);
-             Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
- 	 declare
-             Y : Real;
-          begin
-             Y := Exp(0.0);
-             Check (Y, 1.0, "test 4 -- exp(0.0)", 
-                    0.0);   -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
- 
-          --- test 5 ---
-          -- constants used here only have 19 digits of precision
-          if Real'Digits > 19 then
-             Error_Low_Bound := 0.00000_00000_00000_0001;
-             Report.Comment ("exp accuracy checked to 19 digits");
-          end if;
- 
-          Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), 
-                                   1.0, 
-                                   "5");
-          Error_Low_Bound := 0.0;  -- reset
- 
- 	 --- test 6 ---
-          -- constants used here only have 19 digits of precision
-          if Real'Digits > 19 then
-             Error_Low_Bound := 0.00000_00000_00000_0001;
-             Report.Comment ("exp accuracy checked to 19 digits");
-          end if;
- 
-          Argument_Range_Check_2 (1.0, 
-                                  Sqrt(Real(Real'Machine_Radix)), 
-                                  "6");
-          Error_Low_Bound := 0.0;  -- reset
- 
-       end Do_Test;
-    end Non_Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- begin
-    Report.Test ("CXG2010",
-                 "Check the accuracy of the exp function"); 
- 
-    -- the test only applies to machines with a radix of 2,4,8, or 16
-    case Float'Machine_Radix is
-       when 2 | 4 | 8 | 16 => null;
-       when others =>
- 	     Report.Not_Applicable ("only applicable to binary radix");
- 	     Report.Result;
- 	     return;
-    end case;
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking non-generic package");
-    end if;
- 
-    Non_Generic_Check.Do_Test;
- 
-    Report.Result;
- end CXG2010;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a	Thu Jan  1 00:00:00 1970
***************
*** 1,490 ****
- -- CXG2011.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the log function returns
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks in a range where a Taylor series can be used to compute 
- --            the expected result.
- --         Checks that use an identity for determining the result.
- --         Exception checks.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --       1 Mar 96   SAIC    Initial release for 2.1
- --      22 Aug 96   SAIC    Improved Check routine
- --      02 DEC 97   EDS     Log (0.0) must raise Constraint_Error, 
- --                          not Argument_Error
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2011 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1000;
- 
-    -- CRC Handbook Page 738
-    Ln10 : constant := 2.30258_50929_94045_68401_79914_54684_36420_76011_01489;
-    Ln2  : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755_00134;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real'Base) return Real'Base renames
-            Elementary_Functions.Sqrt;
-       function Exp (X : Real'Base) return Real'Base renames
-            Elementary_Functions.Exp;
-       function Log (X : Real'Base) return Real'Base renames
-            Elementary_Functions.Log;
-       function Log (X, Base : Real'Base) return Real'Base renames
-            Elementary_Functions.Log;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero 
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon 
-          -- instead of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
-             if Actual = Expected then
-                Report.Comment (Test_Name & "  exact result");
-             else
-                Report.Comment (Test_Name & "  passed");
-             end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-       begin
- 
-          --- test 1 ---
-          declare
-             Y : Real;
-          begin
-             Y := Log(1.0);
-             Check (Y, 0.0, "special value test 1 -- log(1)",
-                    0.0);  -- no error allowed
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 1");
-             when others =>
-                Report.Failed ("exception in test 1");
-          end;
- 
-          --- test 2 ---
-          declare
-             Y : Real;
-          begin
-             Y := Log(10.0);
-             Check (Y, Ln10, "special value test 2 -- log(10)", 4.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 2");
-             when others =>
-                Report.Failed ("exception in test 2");
-          end;
- 
-          --- test 3 ---
-          declare
-             Y : Real;
-          begin
-             Y := Log (2.0);
-             Check (Y, Ln2, "special value test 3 -- log(2)", 4.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 3");
-             when others =>
-                Report.Failed ("exception in test 3");
-          end;
- 
-          --- test 4 ---
-          declare
-             Y : Real;
-          begin
-             Y := Log (2.0 ** 18, 2.0);
-             Check (Y, 18.0, "special value test 4 -- log(2**18,2)", 4.0);
-          exception
-             when Constraint_Error => 
-                Report.Failed ("Constraint_Error raised in test 4");
-             when others =>
-                Report.Failed ("exception in test 4");
-          end;
-       end Special_Value_Test;
- 
- 
-       procedure Taylor_Series_Test is
-       -- Use a 4 term taylor series expansion to check a selection of
-       -- arguments very near 1.0.
-       -- The range is chosen so that the 4 term taylor series will
-       -- provide accuracy to machine precision.   Cody pg 49-50.
-          Half_Range : constant Real := Real'Model_Epsilon * 50.0;
-          A : constant Real := 1.0 - Half_Range;
-          B : constant Real := 1.0 + Half_Range;
-          X : Real;
-          Xm1 : Real;
-          Expected : Real;
-          Actual : Real;
- 
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             
-             Xm1 := X - 1.0;
-             -- The following is the first 4 terms of the taylor series
-             -- that has been rearranged to minimize error in the calculation
-             Expected := (Xm1 * (1.0/3.0 - Xm1/4.0) - 0.5) * Xm1 * Xm1 + Xm1;
- 
-             Actual := Log (X);
-             Check (Actual, Expected,
-                    "Taylor Series Test -" &
-                    Integer'Image (I) &
-                    " log (" & Real'Image (X) & ")",
-                    4.0);
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Taylor Series Test");
-          when others =>
-             Report.Failed ("exception in Taylor Series Test");
-       end Taylor_Series_Test;
- 
- 
- 
-       procedure Log_Difference_Identity is
-       -- Check using the identity ln(x) = ln(17x/16) - ln(17/16)
-       -- over the range A to B.
-       -- The selected range assures that both X and 17x/16 will
-       -- have the same exponents and neither argument gets too close
-       -- to 1.    Cody pg 50.
-          A : constant Real := 1.0 / Sqrt (2.0);
-          B : constant Real := 15.0 / 16.0;
-          X : Real;
-          Expected : Real;
-          Actual : Real;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             -- magic argument purification
-             X := Real'Machine (Real'Machine (X+8.0) - 8.0);
-             
-             Expected := Log (X + X / 16.0) - Log (17.0/16.0);
- 
-             Actual := Log (X);
-             Check (Actual, Expected,
-                    "Log Difference Identity -" &
-                    Integer'Image (I) &
-                    " log (" & Real'Image (X) & ")",
-                    4.0);
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Log Difference Identity Test");
-          when others =>
-             Report.Failed ("exception in Log Difference Identity Test");
-       end Log_Difference_Identity;
- 
- 
-       procedure Log_Product_Identity is
-       -- Check using the identity ln(x**2) = 2ln(x)
-       -- over the range A to B.
-       -- This large range is chosen to minimize the possibility of
-       -- undetected systematic errors.   Cody pg 53.
-          A : constant Real := 16.0;
-          B : constant Real := 240.0;
-          X : Real;
-          Expected : Real;
-          Actual : Real;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             -- magic argument purification
-             X := Real'Machine (Real'Machine (X+8.0) - 8.0);
-             
-             Expected := 2.0 * Log (X);
- 
-             Actual := Log (X*X);
-             Check (Actual, Expected,
-                    "Log Product Identity -" &
-                    Integer'Image (I) &
-                    " log (" & Real'Image (X) & ")",
-                    4.0);
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
-          end loop;
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Log Product Identity Test");
-          when others =>
-             Report.Failed ("exception in Log Product Identity Test");
-       end Log_Product_Identity;
- 
- 
-       procedure Log10_Test is
-       -- Check using the identity log(x) = log(11x/10) - log(1.1)
-       -- over the range A to B.  See Cody pg 52.
-          A : constant Real := 1.0 / Sqrt (10.0);
-          B : constant Real := 0.9;
-          X : Real;
-          Expected : Real;
-          Actual : Real;
-       begin
-          if Real'Digits > 17 then
-              -- constant used below is accuract to 17 digits
-             Error_Low_Bound := 0.00000_00000_00000_01;
-             Report.Comment ("log accuracy checked to 19 digits");
-          end if;
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             
-             Expected := Log (X + X/10.0, 10.0)
-                      - 3.77060_15822_50407_5E-4 - 21.0 / 512.0;
- 
-             Actual := Log (X, 10.0);
-             Check (Actual, Expected,
-                    "Log 10 Test -" &
-                    Integer'Image (I) &
-                    " log (" & Real'Image (X) & ")",
-                    4.0);
- 
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-             exit when Accuracy_Error_Reported;
-          end loop;
-          Error_Low_Bound := 0.0;   -- reset
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Log 10 Test");
-          when others =>
-             Report.Failed ("exception in Log 10 Test");
-       end Log10_Test;
- 
- 
-       procedure Exception_Test is
-          X1, X2, X3, X4 : Real;
-       begin
-          begin
-             X1 := Log (0.0);
-             Report.Failed ("exception not raised for LOG(0)");
-          exception
-             -- Log (0.0) must raise Constraint_Error, not Argument_Error,
-             -- as per A.5.1(28,29).  Was incorrect in ACVC 2.1 release.
-             when Ada.Numerics.Argument_Error =>
-                Report.Failed ("Argument_Error raised instead of" &
-                               " Constraint_Error for LOG(0)--A.5.1(28,29)");
-             when Constraint_Error =>  null;  -- ok
-             when others =>
-                Report.Failed ("wrong exception raised for LOG(0)");
-          end;
- 
-          begin
-             X2 := Log ( 1.0, 0.0);
-             Report.Failed ("exception not raised for LOG(1,0)");
-          exception
-             when Ada.Numerics.Argument_Error =>  null;  -- ok
-             when Constraint_Error => 
-                Report.Failed ("constraint_error raised instead of" &
-                               " argument_error for LOG(1,0)");
-             when others =>
-                Report.Failed ("wrong exception raised for LOG(1,0)");
-          end;
- 
-          begin
-             X3 := Log (1.0, 1.0);
-             Report.Failed ("exception not raised for LOG(1,1)");
-          exception
-             when Ada.Numerics.Argument_Error =>  null;  -- ok
-             when Constraint_Error => 
-                Report.Failed ("constraint_error raised instead of" &
-                               " argument_error for LOG(1,1)");
-             when others =>
-                Report.Failed ("wrong exception raised for LOG(1,1)");
-          end;
- 
-          begin
-             X4 := Log (1.0, -10.0);
-             Report.Failed ("exception not raised for LOG(1,-10)");
-          exception
-             when Ada.Numerics.Argument_Error =>  null;  -- ok
-             when Constraint_Error => 
-                Report.Failed ("constraint_error raised instead of" &
-                               " argument_error for LOG(1,-10)");
-             when others =>
-                Report.Failed ("wrong exception raised for LOG(1,-10)");
-          end;
- 
-          -- optimizer thwarting
-          if Report.Ident_Bool (False) then
-             Report.Comment (Real'Image (X1+X2+X3+X4));
-          end if;
-       end Exception_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Taylor_Series_Test;
-          Log_Difference_Identity;
-          Log_Product_Identity;
-          Log10_Test;
-          Exception_Test;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2011",
-                 "Check the accuracy of the log function"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,438 ****
- -- CXG2012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the exponentiation operator returns
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is
- --      instantiated to check both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --         Exception checks.
- --      While this test concentrates on the "**" operator
- --      defined in Generic_Elementary_Functions, a check is also
- --      performed on the standard "**" operator.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --       7 Mar 96   SAIC    Initial release for 2.1
- --       2 Sep 96   SAIC    Improvements as suggested by reviewers
- --	 3 Jun 98   EDS     Add parens to ensure that the expression is not
- --                          evaluated by multiplying its two large terms
- --                          together and overflowing.
- --       3 Dec 01   RLB     Added 'Machine to insure that equality tests
- --                          are certain to work.
- --
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2012 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1000;
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant :=
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- 
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames
-            Elementary_Functions.Sqrt;
-       function Exp (X : Real) return Real renames
-            Elementary_Functions.Exp;
-       function Log (X : Real) return Real renames
-            Elementary_Functions.Log;
-       function "**" (L, R : Real) return Real renames
-            Elementary_Functions."**";
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
- 
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon
-          -- instead of Model_Epsilon and Expected.
-          Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name &
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       -- the following version of Check computes the allowed error bound
-       -- using the operands
-       procedure Check (Actual, Expected : Real;
-                        Left, Right : Real;
-                        Test_Name : String;
-                        MRE_Factor : Real := 1.0) is
-          MRE : Real;
-       begin
-          MRE := MRE_Factor * (4.0 + abs (Right * Log(Left)) / 32.0);
-          Check (Actual, Expected, Test_Name, MRE);
-       end Check;
- 
- 
-       procedure Real_To_Integer_Test is
-          type Int_Check is
- 	    record
- 	       Left : Real;
- 	       Right : Integer;
- 	       Expected : Real;
- 	    end record;
- 	 type Int_Checks is array (Positive range <>) of Int_Check;
- 
-          -- the following tests use only model numbers so the result
-          -- is expected to be exact.
- 	 IC : constant Int_Checks :=
-          ( (  2.0,   5,       32.0),
-            ( -2.0,   5,      -32.0),
-            (  0.5,  -5,       32.0),
-            (  2.0,   0,        1.0),
-            (  0.0,   0,        1.0) );
-       begin
- 	 for I in IC'Range loop
-             declare
- 	       Y : Real;
-             begin
-                Y := IC (I).Left ** IC (I).Right;
-                Check (Y, IC (I).Expected,
- 		      "real to integer test" &
- 		      Real'Image (IC (I).Left) & " ** " &
- 		      Integer'Image (IC (I).Right),
- 		      0.0);  -- no error allowed
-             exception
-                when Constraint_Error =>
-                   Report.Failed ("Constraint_Error raised in rtoi test " &
- 		     Integer'Image (I));
-                when others =>
-                   Report.Failed ("exception in rtoi test " &
- 		     Integer'Image (I));
-             end;
-          end loop;
-       end Real_To_Integer_Test;
- 
- 
-       procedure Special_Value_Test is
-          No_Error : constant := 0.0;
-       begin
-          Check (0.0 ** 1.0, 0.0, "0**1", No_Error);
-          Check (1.0 ** 0.0, 1.0, "1**0", No_Error);
- 
-          Check ( 2.0 **  5.0,  32.0,  2.0,  5.0,  "2**5");
-          Check ( 0.5**(-5.0),  32.0,  0.5, -5.0,  "0.5**-5");
- 
-          Check (Sqrt2 ** 4.0,   4.0,  Sqrt2, 4.0,  "Sqrt2**4");
-          Check (Sqrt3 ** 6.0,  27.0,  Sqrt3, 6.0,  "Sqrt3**6");
- 
-          Check (2.0 ** 0.5,   Sqrt2,    2.0, 0.5,  "2.0**0.5");
- 
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised in Special Value Test");
-          when others =>
-             Report.Failed ("exception in Special Value Test");
-       end Special_Value_Test;
- 
- 
-       procedure Small_Range_Test is
-       -- Several checks over the range 1/radix .. 1
-          A : constant Real := 1.0 / Real (Real'Machine_Radix);
-          B : constant Real := 1.0;
-          X : Real;
-          -- In the cases below where the expected result is
-          -- inexact we allow an additional error amount of
-          -- 1.0 * Model_Epsilon to account for that error.
-          -- This is accomplished by the factor of 1.25 times
-          -- the computed error bound (which is > 4.0) thus
-          -- increasing the error bound by at least
-          -- 1.0 * Model_Epsilon
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 0..Max_Samples loop
-             X :=  Real'Machine((B - A) * Real (I) / Real (Max_Samples) + A);
- 
-             Check (X ** 1.0, X,  -- exact result required
-                    "Small range" & Integer'Image (I) & ": " &
-                    Real'Image (X) & " ** 1.0",
-                    0.0);
- 
-             Check ((X*X) ** 1.5, X**3,  X*X, 1.5,
-                    "Small range" & Integer'Image (I) & ": " &
-                    Real'Image (X*X) & " ** 1.5",
-                    1.25);
- 
-             Check (X ** 13.5, 1.0 / (X ** (-13.5)),  X, 13.5,
-                    "Small range" & Integer'Image (I) & ": " &
-                    Real'Image (X) & " ** 13.5",
-                    2.0);   -- 2 ** computations
- 
-             Check ((X*X) ** 1.25, X**(2.5),  X*X, 1.25,
-                    "Small range" & Integer'Image (I) & ": " &
-                    Real'Image (X*X) & " ** 1.25",
-                    2.0);   -- 2 ** computations
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
- 
-       exception
-          when Constraint_Error =>
-             Report.Failed
-                ("Constraint_Error raised in Small Range Test");
-          when others =>
-             Report.Failed ("exception in Small Range Test");
-       end Small_Range_Test;
- 
- 
-       procedure Large_Range_Test is
-       -- Check over the range A to B where A is 1.0 and
-       -- B is a large value.
-          A : constant Real := 1.0;
-          B : Real;
-          X : Real;
-          Iteration : Integer := 0;
-          Subtest : Character := 'X';
-       begin
-          -- upper bound of range should be as large as possible where
-          -- B**3 is still valid.
-          B := Real'Safe_Last ** 0.333;
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 0..Max_Samples loop
-             Iteration := I;
-             Subtest := 'X';
-             X :=  Real'Machine((B - A) * (Real (I) / Real (Max_Samples)) + A);
- 
-             Subtest := 'A';
-             Check (X ** 1.0, X,  -- exact result required
-                    "Large range" & Integer'Image (I) & ": " &
-                    Real'Image (X) & " ** 1.0",
-                    0.0);
- 
-             Subtest := 'B';
-             Check ((X*X) ** 1.5, X**3,  X*X, 1.5,
-                    "Large range" & Integer'Image (I) & ": " &
-                    Real'Image (X*X) & " ** 1.5",
-                    1.25);   -- inexact expected result
- 
-             Subtest := 'C';
-             Check ((X*X) ** 1.25, X**(2.5),  X*X, 1.25,
-                    "Large range" & Integer'Image (I) & ": " &
-                    Real'Image (X*X) & " ** 1.25",
-                    2.0);   -- two ** operators
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
-       exception
-          when Constraint_Error =>
-             Report.Failed
-                ("Constraint_Error raised in Large Range Test" &
-                 Integer'Image (Iteration) & Subtest);
-          when others =>
-             Report.Failed ("exception in Large Range Test" &
-                 Integer'Image (Iteration) & Subtest);
-       end Large_Range_Test;
- 
- 
-       procedure Exception_Test is
-          X1, X2, X3, X4 : Real;
-       begin
-          begin
-             X1 := 0.0 ** (-1.0);
-             Report.Failed ("exception not raised for 0**-1");
-          exception
-             when Ada.Numerics.Argument_Error =>
-                Report.Failed ("argument_error raised instead of" &
-                               " constraint_error for 0**-1");
-             when Constraint_Error => null;   -- ok
-             when others =>
-                Report.Failed ("wrong exception raised for 0**-1");
-          end;
- 
-          begin
-             X2 := 0.0 ** 0.0;
-             Report.Failed ("exception not raised for 0**0");
-          exception
-             when Ada.Numerics.Argument_Error =>  null;  -- ok
-             when Constraint_Error =>
-                Report.Failed ("constraint_error raised instead of" &
-                               " argument_error for 0**0");
-             when others =>
-                Report.Failed ("wrong exception raised for 0**0");
-          end;
- 
-          begin
-             X3 := (-1.0) ** 1.0;
-             Report.Failed ("exception not raised for -1**1");
-          exception
-             when Ada.Numerics.Argument_Error =>  null;  -- ok
-             when Constraint_Error =>
-                Report.Failed ("constraint_error raised instead of" &
-                               " argument_error for -1**1");
-             when others =>
-                Report.Failed ("wrong exception raised for -1**1");
-          end;
- 
-          begin
-             X4 := (-2.0) ** 2.0;
-             Report.Failed ("exception not raised for -2**2");
-          exception
-             when Ada.Numerics.Argument_Error =>  null;  -- ok
-             when Constraint_Error =>
-                Report.Failed ("constraint_error raised instead of" &
-                               " argument_error for -2**2");
-             when others =>
-                Report.Failed ("wrong exception raised for -2**2");
-          end;
- 
-          -- optimizer thwarting
-          if Report.Ident_Bool (False) then
-             Report.Comment (Real'Image (X1+X2+X3+X4));
-          end if;
-       end Exception_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Real_To_Integer_Test;
-          Special_Value_Test;
-          Small_Range_Test;
-          Large_Range_Test;
-          Exception_Test;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2012",
-                 "Check the accuracy of the ** operator");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" &
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2012;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a	Thu Jan  1 00:00:00 1970
***************
*** 1,367 ****
- -- CXG2013.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the TAN and COT functions return
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --         Exception checks.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      11 Mar 96   SAIC    Initial release for 2.1
- --      17 Aug 96   SAIC    Commentary fixes.
- --      03 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
- --      02 DEC 97   EDS     Change Max_Samples constant to 1001.
- --      29 JUN 98   EDS     Deleted Special_Angle_Test as fatally flawed.
- 
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2013 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1001;
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant := 
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
-    
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sqrt (X : Real) return Real renames
-            Elementary_Functions.Sqrt;
-       function Tan (X : Real) return Real renames
-            Elementary_Functions.Tan;
-       function Cot (X : Real) return Real renames
-            Elementary_Functions.Cot;
-       function Tan (X, Cycle : Real) return Real renames
-            Elementary_Functions.Tan;
-       function Cot (X, Cycle : Real) return Real renames
-            Elementary_Functions.Cot;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
-       -- factor to be applied in computing MRE
-       Maximum_Relative_Error : constant Real := 4.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
-             if Actual = Expected then
-                Report.Comment (Test_Name & "  exact result");
-             else
-                Report.Comment (Test_Name & "  passed");
-             end if;
-          end if;
-       end Check;
- 
- 
- 
-       procedure Exact_Result_Test is
-          No_Error : constant := 0.0;
-       begin
-          -- A.5.1(38);6.0
-          Check (Tan (0.0),  0.0, "tan(0)", No_Error);
- 
-          -- A.5.1(41);6.0
-          Check (Tan (180.0, 360.0), 0.0, "tan(180,360)", No_Error);
-          Check (Tan (360.0, 360.0), 0.0, "tan(360,360)", No_Error);
-          Check (Tan (720.0, 360.0), 0.0, "tan(720,360)", No_Error);
- 
-          -- A.5.1(41);6.0
-          Check (Cot ( 90.0, 360.0), 0.0, "cot( 90,360)", No_Error);
-          Check (Cot (270.0, 360.0), 0.0, "cot(270,360)", No_Error);
-          Check (Cot (810.0, 360.0), 0.0, "cot(810,360)", No_Error);
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Tan_Test (A, B : Real) is
-       -- Use identity Tan(X) = [2*Tan(x/2)]/[1-Tan(x/2) ** 2]
-       -- checks over the range -pi/4 .. pi/4 require no argument reduction
-       -- checks over the range 7pi/8 .. 9pi/8 require argument reduction
-          X, Y : Real;
-          Actual1, Actual2 : Real;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             -- argument purification to insure x and x/2 are exact
-             -- See Cody page 170.
-             Y := Real'Machine (X*0.5);
-             X := Real'Machine (Y + Y);
-            
-             Actual1 := Tan(X);
-             Actual2 := (2.0 * Tan (Y)) / (1.0 - Tan (Y) ** 2);
-  
-             if abs (X - Pi) > ( (B-A)/Real(2*Max_Samples) ) then
-               Check (Actual1, Actual2,
-                      "Tan_Test " & Integer'Image (I) & ": tan(" &
-                      Real'Image (X) & ") ",
-                      (1.0 + Sqrt2) * Maximum_Relative_Error);
-                      -- see Cody pg 165 for error bound info
-             end if;
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Tan_Test");
-          when others =>
-             Report.Failed ("exception in Tan_Test");
-       end Tan_Test;
- 
- 
- 
-       procedure Cot_Test is
-       -- Use identity Cot(X) = [Cot(X/2)**2 - 1]/[2*Cot(X/2)]
-          A : constant := 6.0 * Pi;
-          B : constant := 25.0 / 4.0 * Pi;
-          X, Y : Real;
-          Actual1, Actual2 : Real;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             -- argument purification to insure x and x/2 are exact.
-             -- See Cody page 170.
-             Y := Real'Machine (X*0.5);
-             X := Real'Machine (Y + Y);
-            
-             Actual1 := Cot(X);
-             Actual2 := (Cot (Y) ** 2 - 1.0) / (2.0 * Cot (Y));
-  
-             Check (Actual1, Actual2,
-                    "Cot_Test " & Integer'Image (I) & ": cot(" &
-                    Real'Image (X) & ") ",
-                    (1.0 + Sqrt2) * Maximum_Relative_Error);
-                    -- see Cody pg 165 for error bound info
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Cot_Test");
-          when others =>
-             Report.Failed ("exception in Cot_Test");
-       end Cot_Test;
- 
- 
-       procedure Exception_Test is
-          X1, X2, X3, X4, X5 : Real := 0.0;
-       begin
- 
- 
-          begin  -- A.5.1(20);6.0
-            X1 := Tan (0.0, Cycle => 0.0);
-            Report.Failed ("no exception for cycle = 0.0");
-          exception
-             when Ada.Numerics.Argument_Error => null;
-             when others =>
-                Report.Failed ("wrong exception for cycle = 0.0");
-          end;
- 
-          begin  -- A.5.1(20);6.0
-            X2 := Cot (1.0, Cycle => -3.0);
-            Report.Failed ("no exception for cycle < 0.0");
-          exception
-             when Ada.Numerics.Argument_Error => null;
-             when others =>
-                Report.Failed ("wrong exception for cycle < 0.0");
-          end;
- 
-          -- the remaining tests only apply to machines that overflow
-          if Real'Machine_Overflows then    -- A.5.1(28);6.0
- 
-             begin   -- A.5.1(29);6.0
-                X3 := Cot (0.0);
-                Report.Failed ("exception not raised for cot(0)");
-             exception
-                when Constraint_Error => null;   -- ok
-                when others =>
-                   Report.Failed ("wrong exception raised for cot(0)");
-             end;
-    
-             begin   -- A.5.1(31);6.0
-                X4 := Tan (90.0, 360.0);
-                Report.Failed ("exception not raised for tan(90,360)");
-             exception
-                when Constraint_Error => null;  -- ok
-                when others =>
-                   Report.Failed ("wrong exception raised for tan(90,360)");
-             end;
- 
-             begin   -- A.5.1(32);6.0
-                X5 := Cot (180.0, 360.0);
-                Report.Failed ("exception not raised for cot(180,360)");
-             exception
-                when Constraint_Error => null;  -- ok
-                when others =>
-                   Report.Failed ("wrong exception raised for cot(180,360)");
-             end;
-          end if;
- 
-          -- optimizer thwarting
-          if Report.Ident_Bool (False) then
-             Report.Comment (Real'Image (X1+X2+X3+X4+X5));
-          end if;
-       end Exception_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Exact_Result_Test;
-          Tan_Test (-Pi/4.0, Pi/4.0);
-          Tan_Test (7.0*Pi/8.0, 9.0*Pi/8.0);
-          Cot_Test;
-          Exception_Test;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2013",
-                 "Check the accuracy of the TAN and COT functions"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2013;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a	Thu Jan  1 00:00:00 1970
***************
*** 1,399 ****
- -- CXG2014.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the SINH and COSH functions return
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --         Exception checks.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      15 Mar 96   SAIC    Initial release for 2.1
- --      03 Jun 98   EDS     In line 80, change 1000 to 1024, making it a model
- --                          number.  Add Taylor Series terms in line 281.
- --      15 Feb 99   RLB     Repaired Subtraction_Error_Test to avoid precision
- --                          problems.
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2014 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1024;
- 
-    E  : constant := Ada.Numerics.E;
-    Cosh1 : constant := (E + 1.0 / E) / 2.0;    -- cosh(1.0) 
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
-       function Sinh (X : Real) return Real renames
-            Elementary_Functions.Sinh;
-       function Cosh (X : Real) return Real renames
-            Elementary_Functions.Cosh;
-       function Log (X : Real) return Real renames
-            Elementary_Functions.Log;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Small instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Small;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-          -- In the following tests the expected result is accurate
-          -- to the machine precision so the minimum guaranteed error
-          -- bound can be used.
-          Minimum_Error : constant := 8.0;
-       begin
-          Check (Sinh (1.0),
-                 (E - 1.0 / E) / 2.0,  
-                 "sinh(1)",
-                 Minimum_Error);
-          Check (Cosh (1.0),
-                 Cosh1,
-                 "cosh(1)",
-                 Minimum_Error);
-          Check (Sinh (2.0),
-                 (E * E - (1.0 / (E * E))) / 2.0,
-                 "sinh(2)",
-                 Minimum_Error);
-          Check (Cosh (2.0),
-                 (E * E + (1.0 / (E * E))) / 2.0,
-                 "cosh(2)",
-                 Minimum_Error);
-          Check (Sinh (-1.0),
-                 (1.0 / E - E) / 2.0,  
-                 "sinh(-1)",
-                 Minimum_Error);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
- 
-       procedure Exact_Result_Test is
-          No_Error : constant := 0.0;
-       begin
-          -- A.5.1(38);6.0
-          Check (Sinh (0.0),  0.0, "sinh(0)", No_Error);
-          Check (Cosh (0.0),  1.0, "cosh(0)", No_Error);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Identity_1_Test is
-       -- For the Sinh test use the identity
-       --    2 * Sinh(x) * Cosh(1) = Sinh(x+1) + Sinh (x-1)
-       -- which is transformed to
-       --    Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C
-       -- where C = 1/(2*Cosh(1))
-       --
-       -- For the Cosh test use the identity
-       --    2 * Cosh(x) * Cosh(1) = Cosh(x+1) + Cosh(x-1)
-       -- which is transformed to
-       --    Cosh(x) = C * (Cosh(x+1) + Cosh(x-1))
-       -- where C is the same as above
-       --
-       -- see Cody pg 230-231 for details on the error analysis.
-       -- The net result is a relative error bound of 16 * Model_Epsilon.
- 
-          A : constant := 3.0;
-             -- large upper bound but not so large as to cause Cosh(B)
-             -- to overflow
-          B : constant Real := Log(Real'Safe_Last) - 2.0;
-          X_Minus_1, X, X_Plus_1 : Real; 
-          Actual1, Actual2 : Real;
-          C : constant := 1.0 / (2.0 * Cosh1);
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             -- make sure there is no error in x-1, x, and x+1
-             X_Plus_1 :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             X_Plus_1  := Real'Machine (X_Plus_1);
-             X         := Real'Machine (X_Plus_1 - 1.0);
-             X_Minus_1 := Real'Machine (X - 1.0);
-            
-             -- Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C
-             Actual1 := Sinh(X);
-             Actual2 := C * (Sinh(X_Plus_1) + Sinh(X_Minus_1));
-  
-             Check (Actual1, Actual2,
-                    "Identity_1_Test " & Integer'Image (I) & ": sinh(" &
- 		   Real'Image (X) & ") ",
-                    16.0);
- 
-             -- Cosh(x) = C * (Cosh(x+1) + Cosh(x-1))
-             Actual1 := Cosh (X);
-             Actual2 := C * (Cosh(X_Plus_1) + Cosh (X_Minus_1));
-             Check (Actual1, Actual2,
-                    "Identity_1_Test " & Integer'Image (I) & ": cosh(" &
- 		   Real'Image (X) & ") ",
-                    16.0);
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Identity_1_Test" &
-                 " for X=" & Real'Image (X));
-          when others =>
-             Report.Failed ("exception in Identity_1_Test" &
-                 " for X=" & Real'Image (X));
-       end Identity_1_Test;
- 
- 
- 
-       procedure Subtraction_Error_Test is
-       -- This test detects the error resulting from subtraction if
-       -- the obvious algorithm was used for computing sinh.  That is,
-       -- it it is computed as (e**x - e**-x)/2.
-       -- We check the result by using a Taylor series expansion that
-       -- will produce a result accurate to the machine precision for
-       -- the range under test.
-       --
-       -- The maximum relative error bound for this test is 
-       --  8 for the sinh operation and 7 for the Taylor series
-       -- for a total of 15 * Model_Epsilon
-          A : constant := 0.0;
-          B : constant := 0.5;
-          X : Real;
-          X_Squared : Real;
-          Actual, Expected : Real;
-       begin
-          if Real'digits > 15 then
-              return; -- The approximation below is not accurate beyond
-                      -- 15 digits. Adding more terms makes the error
-                      -- larger, so it makes the test worse for more normal
-                      -- values. Thus, we skip this subtest for larger than
-                      -- 15 digits.
-          end if;
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             X_Squared := X * X;
-            
-             Actual := Sinh(X);
- 
-             -- The Taylor series regrouped a bit
-             Expected := 
-                X * (1.0 + (X_Squared / 6.0) *
-                           (1.0 + (X_Squared/20.0) *
-                                  (1.0 + (X_Squared/42.0) *
-                                         (1.0 + (X_Squared/72.0) *
-                                                (1.0 + (X_Squared/110.0) *
-                                                       (1.0 + (X_Squared/156.0)
-                    ))))));
-  
-             Check (Actual, Expected,
-                    "Subtraction_Error_Test " & Integer'Image (I) & ": sinh(" &
- 		   Real'Image (X) & ") ",
-                    15.0);
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Subtraction_Error_Test");
-          when others =>
-             Report.Failed ("exception in Subtraction_Error_Test");
-       end Subtraction_Error_Test;
- 
- 
-       procedure Exception_Test is
-          X1, X2 : Real := 0.0;
-       begin
-          -- this part of the test is only applicable if 'Machine_Overflows
-          -- is true.
-          if Real'Machine_Overflows then
- 
- 	    begin
- 	      X1 := Sinh (Real'Safe_Last / 2.0);
- 	      Report.Failed ("no exception for sinh overflow");
- 	    exception
- 	       when Constraint_Error => null;
- 	       when others =>
- 	          Report.Failed ("wrong exception sinh overflow");
- 	    end;
- 
- 	    begin
- 	      X2 := Cosh (Real'Safe_Last / 2.0);
- 	      Report.Failed ("no exception for cosh overflow");
- 	    exception
- 	       when Constraint_Error => null;
- 	       when others =>
- 	          Report.Failed ("wrong exception cosh overflow");
- 	    end;
- 
-          end if;
- 
-          -- optimizer thwarting
-          if Report.Ident_Bool (False) then
-             Report.Comment (Real'Image (X1 + X2));
-          end if;
-       end Exception_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-          Identity_1_Test;
-          Subtraction_Error_Test;
-          Exception_Test;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2014",
-                 "Check the accuracy of the SINH and COSH functions"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2014;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a	Thu Jan  1 00:00:00 1970
***************
*** 1,686 ****
- -- CXG2015.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the ARCSIN and ARCCOS functions return
- --      results that are within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is
- --      instantiated to check both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks in a specific range where a Taylor series can be
- --         used to compute an accurate result for comparison.
- --         Exception checks.
- --      The Taylor series tests are a direct translation of the
- --      FORTRAN code found in the reference.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      18 Mar 96   SAIC    Initial release for 2.1
- --      24 Apr 96   SAIC    Fixed error bounds.
- --      17 Aug 96   SAIC    Added reference information and improved
- --                          checking for machines with more than 23
- --                          digits of precision.
- --      03 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
- --      22 Dec 99   RLB     Added model range checking to "exact" results,
- --                          in order to avoid too strictly requiring a specific
- --                          result, and too weakly checking results.
- --
- -- CHANGE NOTE:
- --      According to Ken Dritz, author of the Numerics Annex of the RM,
- --      one should never specify the cycle 2.0*Pi for the trigonometric
- --      functions.  In particular, if the machine number for the first
- --      argument is not an exact multiple of the machine number for the
- --      explicit cycle, then the specified exact results cannot be
- --      reasonably expected.  The affected checks in this test have been
- --      marked as comments, with the additional notation "pwb-math".
- --      Phil Brashear
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- -- CELEFUNT: A Portable Test Package for Complex Elementary Functions
- -- ACM Collected Algorithms number 714
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2015 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1000;
- 
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant :=
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- 
-    Pi : constant := Ada.Numerics.Pi;
- 
-    -- relative error bound from G.2.4(7);6.0
-    Minimum_Error : constant := 4.0;
- 
-    generic
-       type Real is digits <>;
-       Half_PI_Low : in Real; -- The machine number closest to, but not greater
-                              -- than PI/2.0.
-       Half_PI_High : in Real;-- The machine number closest to, but not less
-                              -- than PI/2.0.
-       PI_Low : in Real;      -- The machine number closest to, but not greater
-                              -- than PI.
-       PI_High : in Real;     -- The machine number closest to, but not less
-                              -- than PI.
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new
-            Ada.Numerics.Generic_Elementary_Functions (Real);
- 
-       function Arcsin (X : Real) return Real renames
-            Elementary_Functions.Arcsin;
-       function Arcsin (X, Cycle : Real) return Real renames
-            Elementary_Functions.Arcsin;
-       function Arccos (X : Real) return Real renames
-            Elementary_Functions.ArcCos;
-       function Arccos (X, Cycle : Real) return Real renames
-            Elementary_Functions.ArcCos;
- 
-       -- needed for support
-       function Log (X, Base : Real) return Real renames
-            Elementary_Functions.Log;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name &
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-          -- In the following tests the expected result is accurate
-          -- to the machine precision so the minimum guaranteed error
-          -- bound can be used.
- 
-          type Data_Point is
-             record
-                Degrees,
-                Radians,
-                Argument,
-                Error_Bound : Real;
-             end record;
- 
-          type Test_Data_Type is array (Positive range <>) of Data_Point;
- 
-          -- the values in the following tables only involve static
-          -- expressions so no loss of precision occurs.  However,
-          -- rounding can be an issue with expressions involving Pi
-          -- and square roots.  The error bound specified in the
-          -- table takes the sqrt error into account but not the
-          -- error due to Pi.  The Pi error is added in in the
-          -- radians test below.
- 
-          Arcsin_Test_Data : constant Test_Data_Type := (
-          --  degrees      radians          sine  error_bound   test #
-           --(  0.0,           0.0,          0.0,     0.0 ),    -- 1 - In Exact_Result_Test.
-             ( 30.0,        Pi/6.0,          0.5,     4.0 ),    -- 2
-             ( 60.0,        Pi/3.0,    Sqrt3/2.0,     5.0 ),    -- 3
-           --( 90.0,        Pi/2.0,          1.0,     4.0 ),    -- 4 - In Exact_Result_Test.
-           --(-90.0,       -Pi/2.0,         -1.0,     4.0 ),    -- 5 - In Exact_Result_Test.
-             (-60.0,       -Pi/3.0,   -Sqrt3/2.0,     5.0 ),    -- 6
-             (-30.0,       -Pi/6.0,         -0.5,     4.0 ),    -- 7
-             ( 45.0,        Pi/4.0,    Sqrt2/2.0,     5.0 ),    -- 8
-             (-45.0,       -Pi/4.0,   -Sqrt2/2.0,     5.0 ) );  -- 9
- 
-          Arccos_Test_Data : constant Test_Data_Type := (
-          --  degrees      radians       cosine   error_bound   test #
-           --(  0.0,           0.0,         1.0,      0.0 ),    -- 1 - In Exact_Result_Test.
-             ( 30.0,        Pi/6.0,   Sqrt3/2.0,      5.0 ),    -- 2
-             ( 60.0,        Pi/3.0,         0.5,      4.0 ),    -- 3
-           --( 90.0,        Pi/2.0,         0.0,      4.0 ),    -- 4 - In Exact_Result_Test.
-             (120.0,    2.0*Pi/3.0,        -0.5,      4.0 ),    -- 5
-             (150.0,    5.0*Pi/6.0,  -Sqrt3/2.0,      5.0 ),    -- 6
-           --(180.0,            Pi,        -1.0,      4.0 ),    -- 7 - In Exact_Result_Test.
-             ( 45.0,        Pi/4.0,   Sqrt2/2.0,      5.0 ),    -- 8
-             (135.0,    3.0*Pi/4.0,  -Sqrt2/2.0,      5.0 ) );  -- 9
- 
-          Cycle_Error,
-          Radian_Error : Real;
-       begin
-          for I in Arcsin_Test_Data'Range loop
- 
-             -- note exact result requirements  A.5.1(38);6.0 and
-             -- G.2.4(12);6.0
-             if Arcsin_Test_Data (I).Error_Bound = 0.0 then
-                Cycle_Error := 0.0;
-                Radian_Error := 0.0;
-             else
-                Cycle_Error := Arcsin_Test_Data (I).Error_Bound;
-                -- allow for rounding error in the specification of Pi
-                Radian_Error := Cycle_Error + 1.0;
-             end if;
- 
-             Check (Arcsin (Arcsin_Test_Data (I).Argument),
-                    Arcsin_Test_Data (I).Radians,
-                    "test" & Integer'Image (I) &
-                    " arcsin(" &
-                    Real'Image (Arcsin_Test_Data (I).Argument) &
-                    ")",
-                    Radian_Error);
- --pwb-math            Check (Arcsin (Arcsin_Test_Data (I).Argument, 2.0 * Pi),
- --pwb-math                   Arcsin_Test_Data (I).Radians,
- --pwb-math                   "test" & Integer'Image (I) &
- --pwb-math                   " arcsin(" &
- --pwb-math                   Real'Image (Arcsin_Test_Data (I).Argument) &
- --pwb-math                   ", 2pi)",
- --pwb-math                   Cycle_Error);
-             Check (Arcsin (Arcsin_Test_Data (I).Argument, 360.0),
-                    Arcsin_Test_Data (I).Degrees,
-                    "test" & Integer'Image (I) &
-                    " arcsin(" &
-                    Real'Image (Arcsin_Test_Data (I).Argument) &
-                    ", 360)",
-                    Cycle_Error);
-          end loop;
- 
- 
-          for I in Arccos_Test_Data'Range loop
- 
-             -- note exact result requirements  A.5.1(39);6.0 and
-             -- G.2.4(12);6.0
-             if Arccos_Test_Data (I).Error_Bound = 0.0 then
-                Cycle_Error := 0.0;
-                Radian_Error := 0.0;
-             else
-                Cycle_Error := Arccos_Test_Data (I).Error_Bound;
-                -- allow for rounding error in the specification of Pi
-                Radian_Error := Cycle_Error + 1.0;
-             end if;
- 
-             Check (Arccos (Arccos_Test_Data (I).Argument),
-                    Arccos_Test_Data (I).Radians,
-                    "test" & Integer'Image (I) &
-                    " arccos(" &
-                    Real'Image (Arccos_Test_Data (I).Argument) &
-                    ")",
-                    Radian_Error);
- --pwb-math            Check (Arccos (Arccos_Test_Data (I).Argument, 2.0 * Pi),
- --pwb-math                   Arccos_Test_Data (I).Radians,
- --pwb-math                   "test" & Integer'Image (I) &
- --pwb-math                   " arccos(" &
- --pwb-math                   Real'Image (Arccos_Test_Data (I).Argument) &
- --pwb-math                   ", 2pi)",
- --pwb-math                   Cycle_Error);
-             Check (Arccos (Arccos_Test_Data (I).Argument, 360.0),
-                    Arccos_Test_Data (I).Degrees,
-                    "test" & Integer'Image (I) &
-                    " arccos(" &
-                    Real'Image (Arccos_Test_Data (I).Argument) &
-                    ", 360)",
-                    Cycle_Error);
-          end loop;
- 
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
-       procedure Check_Exact (Actual, Expected_Low, Expected_High : Real;
- 	                     Test_Name : String) is
-          -- If the expected result is not a model number, then Expected_Low is
-          -- the first machine number less than the (exact) expected
-          -- result, and Expected_High is the first machine number greater than
-          -- the (exact) expected result. If the expected result is a model
-          -- number, Expected_Low = Expected_High = the result.
-          Model_Expected_Low  : Real := Expected_Low;
-          Model_Expected_High : Real := Expected_High;
-       begin
-          -- Calculate the first model number nearest to, but below (or equal)
-          -- to the expected result:
-          while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
-             -- Try the next machine number lower:
-             Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
-          end loop;
-          -- Calculate the first model number nearest to, but above (or equal)
-          -- to the expected result:
-          while Real'Model (Model_Expected_High) /= Model_Expected_High loop
-             -- Try the next machine number higher:
-             Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
-          end loop;
- 
-          if Actual < Model_Expected_Low or Actual > Model_Expected_High then
-             Accuracy_Error_Reported := True;
-             if Actual < Model_Expected_Low then
-                Report.Failed (Test_Name &
-                               " actual: " & Real'Image (Actual) &
-                               " expected low: " & Real'Image (Model_Expected_Low) &
-                               " expected high: " & Real'Image (Model_Expected_High) &
-                               " difference: " & Real'Image (Actual - Expected_Low));
-             else
-                Report.Failed (Test_Name &
-                               " actual: " & Real'Image (Actual) &
-                               " expected low: " & Real'Image (Model_Expected_Low) &
-                               " expected high: " & Real'Image (Model_Expected_High) &
-                               " difference: " & Real'Image (Expected_High - Actual));
-             end if;
-          elsif Verbose then
-             Report.Comment (Test_Name & "  passed");
-          end if;
-       end Check_Exact;
- 
- 
-       procedure Exact_Result_Test is
-       begin
-          --  A.5.1(38)
-          Check_Exact (Arcsin (0.0),       0.0, 0.0, "arcsin(0)");
-          Check_Exact (Arcsin (0.0, 45.0), 0.0, 0.0, "arcsin(0,45)");
- 
-          --  A.5.1(39)
-          Check_Exact (Arccos (1.0),       0.0, 0.0, "arccos(1)");
-          Check_Exact (Arccos (1.0, 75.0), 0.0, 0.0, "arccos(1,75)");
- 
-          --  G.2.4(11-13)
-          Check_Exact (Arcsin (1.0), Half_PI_Low, Half_PI_High, "arcsin(1)");
-          Check_Exact (Arcsin (1.0, 360.0), 90.0, 90.0, "arcsin(1,360)");
- 
-          Check_Exact (Arcsin (-1.0), -Half_PI_High, -Half_PI_Low, "arcsin(-1)");
-          Check_Exact (Arcsin (-1.0, 360.0), -90.0, -90.0, "arcsin(-1,360)");
- 
-          Check_Exact (Arccos (0.0), Half_PI_Low, Half_PI_High, "arccos(0)");
-          Check_Exact (Arccos (0.0, 360.0), 90.0, 90.0, "arccos(0,360)");
- 
-          Check_Exact (Arccos (-1.0), PI_Low, PI_High, "arccos(-1)");
-          Check_Exact (Arccos (-1.0, 360.0), 180.0, 180.0, "arccos(-1,360)");
- 
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("Exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Arcsin_Taylor_Series_Test is
-          -- the following range is chosen so that the Taylor series
-          -- used will produce a result accurate to machine precision.
-          --
-          -- The following formula is used for the Taylor series:
-          --  TS(x) =  x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) +
-          --                (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] }
-          --   where xsq = x * x
-          --
-          A : constant := -0.125;
-          B : constant :=  0.125;
-          X : Real;
-          Y, Y_Sq : Real;
-          Actual, Sum, Xm : Real;
-          -- terms in Taylor series
-          K : constant Integer := Integer (
-                 Log (
-                   Real (Real'Machine_Radix) ** Real'Machine_Mantissa,
-                   10.0)) + 1;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             -- make sure there is no error in x-1, x, and x+1
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
- 
-             Y := X;
-             Y_Sq := Y * Y;
-             Sum := 0.0;
-             Xm := Real (K + K + 1);
-             for M in 1 .. K loop
-                Sum := Y_Sq * (Sum + 1.0/Xm);
-                Xm := Xm - 2.0;
-                Sum := Sum * (Xm /(Xm + 1.0));
-             end loop;
-             Sum := Sum * Y;
-             Actual := Y + Sum;
-             Sum := (Y - Actual) + Sum;
-             if not Real'Machine_Rounds then
-                Actual := Actual + (Sum + Sum);
-             end if;
- 
-             Check (Actual, Arcsin (X),
-                    "Taylor Series test" & Integer'Image (I) & ": arcsin(" &
- 		   Real'Image (X) & ") ",
-                    Minimum_Error);
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
- 
-       exception
-          when Constraint_Error =>
-             Report.Failed
-                ("Constraint_Error raised in Arcsin_Taylor_Series_Test" &
-                 " for X=" & Real'Image (X));
-          when others =>
-             Report.Failed ("exception in Arcsin_Taylor_Series_Test" &
-                 " for X=" & Real'Image (X));
-       end Arcsin_Taylor_Series_Test;
- 
- 
- 
-       procedure Arccos_Taylor_Series_Test is
-          -- the following range is chosen so that the Taylor series
-          -- used will produce a result accurate to machine precision.
-          --
-          -- The following formula is used for the Taylor series:
-          --  TS(x) =  x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) +
-          --                (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] }
-          --  arccos(x) = pi/2 - TS(x)
-          A : constant := -0.125;
-          B : constant :=  0.125;
-          C1, C2 : Real;
-          X : Real;
-          Y, Y_Sq : Real;
-          Actual, Sum, Xm, S : Real;
-          -- terms in Taylor series
-          K : constant Integer := Integer (
-                 Log (
-                   Real (Real'Machine_Radix) ** Real'Machine_Mantissa,
-                   10.0)) + 1;
-       begin
-          if Real'Digits > 23 then
-             -- constants in this section only accurate to 23 digits
-             Error_Low_Bound := 0.00000_00000_00000_00000_001;
-             Report.Comment ("arctan accuracy checked to 23 digits");
-          end if;
- 
-          -- C1 + C2 equals Pi/2 accurate to 23 digits
-          if Real'Machine_Radix = 10 then
-             C1 := 1.57;
-             C2 := 7.9632679489661923132E-4;
-          else
-             C1 := 201.0 / 128.0;
-             C2 := 4.8382679489661923132E-4;
-          end if;
- 
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             -- make sure there is no error in x-1, x, and x+1
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
- 
-             Y := X;
-             Y_Sq := Y * Y;
-             Sum := 0.0;
-             Xm := Real (K + K + 1);
-             for M in 1 .. K loop
-                Sum := Y_Sq * (Sum + 1.0/Xm);
-                Xm := Xm - 2.0;
-                Sum := Sum * (Xm /(Xm + 1.0));
-             end loop;
-             Sum := Sum * Y;
- 
-             -- at this point we have arcsin(x).
-             -- We compute arccos(x) = pi/2 - arcsin(x).
-             -- The following code segment is translated directly from
-             -- the CELEFUNT FORTRAN implementation
- 
-             S := C1 + C2;
-             Sum := ((C1 - S) + C2) - Sum;
-             Actual := S + Sum;
-             Sum := ((S - Actual) + Sum) - Y;
-             S := Actual;
-             Actual := S + Sum;
-             Sum := (S - Actual) + Sum;
- 
-             if not Real'Machine_Rounds then
-                Actual := Actual + (Sum + Sum);
-             end if;
- 
-             Check (Actual, Arccos (X),
-                    "Taylor Series test" & Integer'Image (I) & ": arccos(" &
- 		   Real'Image (X) & ") ",
-                    Minimum_Error);
- 
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-             exit when Accuracy_Error_Reported;
-          end loop;
-          Error_Low_Bound := 0.0;  -- reset
-       exception
-          when Constraint_Error =>
-             Report.Failed
-                ("Constraint_Error raised in Arccos_Taylor_Series_Test" &
-                 " for X=" & Real'Image (X));
-          when others =>
-             Report.Failed ("exception in Arccos_Taylor_Series_Test" &
-                 " for X=" & Real'Image (X));
-       end Arccos_Taylor_Series_Test;
- 
- 
- 
-       procedure Identity_Test is
-          -- test the identity arcsin(-x) = -arcsin(x)
-          -- range chosen to be most of the valid range of the argument.
-          A : constant := -0.999;
-          B : constant :=  0.999;
-          X : Real;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             -- make sure there is no error in x-1, x, and x+1
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
- 
-             Check (Arcsin(-X), -Arcsin (X),
-                    "Identity test" & Integer'Image (I) & ": arcsin(" &
- 		   Real'Image (X) & ") ",
-                    8.0);   -- 2 arcsin evaluations => twice the error bound
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
-          end loop;
-       end Identity_Test;
- 
- 
-       procedure Exception_Test is
-          X1, X2 : Real := 0.0;
-       begin
- 	    begin
- 	      X1 := Arcsin (1.1);
- 	      Report.Failed ("no exception for Arcsin (1.1)");
- 	    exception
- 	       when Constraint_Error =>
- 	          Report.Failed ("Constraint_Error instead of " &
-                      "Argument_Error for Arcsin (1.1)");
-                when Ada.Numerics.Argument_Error =>
-                   null;    -- expected result
- 	       when others =>
- 	          Report.Failed ("wrong exception for Arcsin(1.1)");
- 	    end;
- 
- 	    begin
- 	      X2 := Arccos (-1.1);
- 	      Report.Failed ("no exception for Arccos (-1.1)");
- 	    exception
- 	       when Constraint_Error =>
- 	          Report.Failed ("Constraint_Error instead of " &
-                      "Argument_Error for Arccos (-1.1)");
-                when Ada.Numerics.Argument_Error =>
-                   null;    -- expected result
- 	       when others =>
- 	          Report.Failed ("wrong exception for Arccos(-1.1)");
- 	    end;
- 
- 
-          -- optimizer thwarting
-          if Report.Ident_Bool (False) then
-             Report.Comment (Real'Image (X1 + X2));
-          end if;
-       end Exception_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-          Arcsin_Taylor_Series_Test;
-          Arccos_Taylor_Series_Test;
-          Identity_Test;
-          Exception_Test;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    -- These expressions must be truly static, which is why we have to do them
-    -- outside of the generic, and we use the named numbers. Note that we know
-    -- that PI is not a machine number (it is irrational), and it should be
-    -- represented to more digits than supported by the target machine.
-    Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
-    Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
-    Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
-    Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
-    package Float_Check is new Generic_Check (Float,
- 	Half_PI_Low  => Float_Half_PI_Low,
- 	Half_PI_High => Float_Half_PI_High,
- 	PI_Low  => Float_PI_Low,
- 	PI_High => Float_PI_High);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
-    A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
-    A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
-    A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float,
- 	Half_PI_Low  => A_Long_Float_Half_PI_Low,
- 	Half_PI_High => A_Long_Float_Half_PI_High,
- 	PI_Low  => A_Long_Float_PI_Low,
- 	PI_High => A_Long_Float_PI_High);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2015",
-                 "Check the accuracy of the ARCSIN and ARCCOS functions");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" &
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2015;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a	Thu Jan  1 00:00:00 1970
***************
*** 1,482 ****
- -- CXG2016.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the ARCTAN function returns a
- --      result that is within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is
- --      instantiated to check both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Exception checks.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      19 Mar 96   SAIC    Initial release for 2.1
- --      30 APR 96   SAIC    Fixed optimization issue
- --      17 AUG 96   SAIC    Incorporated Reviewer's suggestions.
- --      12 OCT 96   SAIC    Incorporated Reviewer's suggestions.
- --      02 DEC 97   EDS     Remove procedure Identity_1_Test and calls to
- --                          procedure.
- --      29 JUN 98   EDS     Replace -0.0 with call to ImpDef.Annex_G.Negative_Zero
- --      28 APR 99   RLB     Replaced comma accidentally deleted in above change.
- --      15 DEC 99   RLB     Added model range checking to "exact" results,
- --                          in order to avoid too strictly requiring a specific
- --                          result.
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- with Impdef.Annex_G;
- procedure CXG2016 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1000;
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant :=
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- 
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-       Half_PI_Low : in Real; -- The machine number closest to, but not greater
-                              -- than PI/2.0.
-       Half_PI_High : in Real;-- The machine number closest to, but not less
-                              -- than PI/2.0.
-       PI_Low : in Real;      -- The machine number closest to, but not greater
-                              -- than PI.
-       PI_High : in Real;     -- The machine number closest to, but not less
-                              -- than PI.
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new
-            Ada.Numerics.Generic_Elementary_Functions (Real);
- 
-       function Arctan (Y : Real;
-                        X : Real := 1.0) return Real renames
-            Elementary_Functions.Arctan;
-       function Arctan (Y : Real;
-                        X : Real := 1.0;
-                        Cycle : Real) return Real renames
-            Elementary_Functions.Arctan;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon
-          -- instead of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name &
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
-             if Actual = Expected then
-                Report.Comment (Test_Name & "  exact result");
-             else
-                Report.Comment (Test_Name & "  passed");
-             end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-       -- If eta is very small, arctan(x + eta) ~= arctan(x) + eta/(1+x*x).
-       --
-       -- For tests 4 and 5, there is an error of 4.0ME for arctan + an
-       -- additional error of 1.0ME because pi is not exact for a total of 5.0ME.
-       --
-       -- In test 3 there is the error for pi plus an additional error
-       -- of (1.0ME)/4 since sqrt3 is not exact, for a total of 5.25ME.
-       --
-       -- In test 2 there is the error for pi plus an additional error
-       -- of (3/4)(1.0ME) since sqrt3 is not exact, for a total of 5.75ME.
- 
- 
-          type Data_Point is
-             record
-                Degrees,
-                Radians,
-                Tangent,
-                Allowed_Error : Real;
-             end record;
- 
-          type Test_Data_Type is array (Positive range <>) of Data_Point;
- 
-          -- the values in the following table only involve static
-          -- expressions so no additional loss of precision occurs.
-          Test_Data : constant Test_Data_Type := (
-          --  degrees      radians       tangent   error     test #
-             (  0.0,           0.0,          0.0,   4.0 ),    -- 1
-             ( 30.0,        Pi/6.0,    Sqrt3/3.0,   5.75),    -- 2
-             ( 60.0,        Pi/3.0,        Sqrt3,   5.25),    -- 3
-             ( 45.0,        Pi/4.0,          1.0,   5.0 ),    -- 4
-             (-45.0,       -Pi/4.0,         -1.0,   5.0 ) );  -- 5
- 
-       begin
-          for I in Test_Data'Range loop
-             Check (Arctan (Test_Data (I).Tangent),
-                    Test_Data (I).Radians,
-                    "special value test" & Integer'Image (I) &
-                       " arctan(" &
-                       Real'Image (Test_Data (I).Tangent) &
-                       ")",
-                    Test_Data (I).Allowed_Error);
-             Check (Arctan (Test_Data (I).Tangent, Cycle => 360.0),
-                    Test_Data (I).Degrees,
-                    "special value test" & Integer'Image (I) &
-                       " arctan(" &
-                       Real'Image (Test_Data (I).Tangent) &
-                       ", cycle=>360)",
-                    Test_Data (I).Allowed_Error);
-          end loop;
- 
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
- 
-       procedure Check_Exact (Actual, Expected_Low, Expected_High : Real;
- 	                     Test_Name : String) is
-          -- If the expected result is not a model number, then Expected_Low is
-          -- the first machine number less than the (exact) expected
-          -- result, and Expected_High is the first machine number greater than
-          -- the (exact) expected result. If the expected result is a model
-          -- number, Expected_Low = Expected_High = the result.
-          Model_Expected_Low  : Real := Expected_Low;
-          Model_Expected_High : Real := Expected_High;
-       begin
-          -- Calculate the first model number nearest to, but below (or equal)
-          -- to the expected result:
-          while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
-             -- Try the next machine number lower:
-             Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
-          end loop;
-          -- Calculate the first model number nearest to, but above (or equal)
-          -- to the expected result:
-          while Real'Model (Model_Expected_High) /= Model_Expected_High loop
-             -- Try the next machine number higher:
-             Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
-          end loop;
- 
-          if Actual < Model_Expected_Low or Actual > Model_Expected_High then
-             Accuracy_Error_Reported := True;
-             if Actual < Model_Expected_Low then
-                Report.Failed (Test_Name &
-                               " actual: " & Real'Image (Actual) &
-                               " expected low: " & Real'Image (Model_Expected_Low) &
-                               " expected high: " & Real'Image (Model_Expected_High) &
-                               " difference: " & Real'Image (Actual - Expected_Low));
-             else
-                Report.Failed (Test_Name &
-                               " actual: " & Real'Image (Actual) &
-                               " expected low: " & Real'Image (Model_Expected_Low) &
-                               " expected high: " & Real'Image (Model_Expected_High) &
-                               " difference: " & Real'Image (Expected_High - Actual));
-             end if;
-          elsif Verbose then
-             Report.Comment (Test_Name & "  passed");
-          end if;
-       end Check_Exact;
- 
- 
-       procedure Exact_Result_Test is
-       begin
-          --  A.5.1(40);6.0
-          Check_Exact (Arctan (0.0, 1.0),       0.0, 0.0, "arctan(0,1)");
-          Check_Exact (Arctan (0.0, 1.0, 27.0), 0.0, 0.0, "arctan(0,1,27)");
- 
-          --  G.2.4(11-13);6.0
- 
-          Check_Exact (Arctan (1.0, 0.0), Half_PI_Low, Half_PI_High,
-               "arctan(1,0)");
-          Check_Exact (Arctan (1.0, 0.0, 360.0), 90.0, 90.0, "arctan(1,0,360)");
- 
-          Check_Exact (Arctan (-1.0, 0.0), -Half_PI_High, -Half_PI_Low,
-               "arctan(-1,0)");
-          Check_Exact (Arctan (-1.0, 0.0, 360.0), -90.0, -90.0,
-               "arctan(-1,0,360)");
- 
-          if Real'Signed_Zeros then
-             Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(+0,-1)");
-             Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
-                   "arctan(+0,-1,360)");
-             Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0),
-                    -PI_High, -PI_Low, "arctan(-0,-1)");
-             Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0,
-                    360.0), -180.0, -180.0, "arctan(-0,-1,360)");
-          else
-             Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(0,-1)");
-             Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
-                    "arctan(0,-1,360)");
-          end if;
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("Exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Taylor_Series_Test is
-       -- This test checks the Arctan by using a taylor series expansion that
-       -- will produce a result accurate to 19 decimal digits for
-       -- the range under test.
-       --
-       -- The maximum relative error bound for this test is
-       --  4 for the arctan operation and 2 for the Taylor series
-       -- for a total of 6 * Model_Epsilon
- 
-          A : constant := -1.0/16.0;
-          B : constant :=  1.0/16.0;
-          X : Real;
-          Actual, Expected : Real;
-          Sum, Em, X_Squared : Real;
-       begin
-          if Real'Digits > 19 then
-             -- Taylor series calculation produces result accurate to 19
-             -- digits.  If type being tested has more digits then set
-             -- the error low bound to account for this.
-             -- The error low bound is conservatively set to 6*10**-19
-             Error_Low_Bound := 0.00000_00000_00000_0006;
-             Report.Comment ("arctan accuracy checked to 19 digits");
-          end if;
- 
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 0..Max_Samples loop
-             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
-             X_Squared := X * X;
-             Em := 17.0;
-             Sum := X_Squared / Em;
- 
-             for II in 1 .. 7 loop
-                Em := Em - 2.0;
-                Sum := (1.0 / Em - Sum) * X_Squared;
-             end loop;
-             Sum := -X * Sum;
-             Expected := X + Sum;
-             Sum := (X - Expected) + Sum;
-             if not Real'Machine_Rounds then
-                Expected := Expected + (Sum + Sum);
-             end if;
- 
-             Actual := Arctan (X);
- 
-             Check (Actual, Expected,
-                    "Taylor_Series_Test " & Integer'Image (I) & ": arctan(" &
-                    Real'Image (X) & ") ",
-                    6.0);
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
-          Error_Low_Bound := 0.0;  -- reset
-       exception
-          when Constraint_Error =>
-             Report.Failed
-                ("Constraint_Error raised in Taylor_Series_Test");
-          when others =>
-             Report.Failed ("exception in Taylor_Series_Test");
-       end Taylor_Series_Test;
- 
- 
-       procedure Exception_Test is
-          X1, X2, X3 : Real := 0.0;
-       begin
- 
-          begin  -- A.5.1(20);6.0
-            X1 := Arctan(0.0, Cycle => 0.0);
-            Report.Failed ("no exception for cycle = 0.0");
-          exception
-             when Ada.Numerics.Argument_Error => null;
-             when others =>
-                Report.Failed ("wrong exception for cycle = 0.0");
-          end;
- 
-          begin  -- A.5.1(20);6.0
-            X2 := Arctan (0.0, Cycle => -1.0);
-            Report.Failed ("no exception for cycle < 0.0");
-          exception
-             when Ada.Numerics.Argument_Error => null;
-             when others =>
-                Report.Failed ("wrong exception for cycle < 0.0");
-          end;
- 
-          begin  -- A.5.1(25);6.0
-            X3 := Arctan (0.0, 0.0);
-            Report.Failed ("no exception for arctan(0,0)");
-          exception
-             when Ada.Numerics.Argument_Error => null;
-             when others =>
-                Report.Failed ("wrong exception for arctan(0,0)");
-          end;
- 
-          -- optimizer thwarting
-          if Report.Ident_Bool (False) then
-             Report.Comment (Real'Image (X1 + X2 + X3));
-          end if;
-       end Exception_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-          Taylor_Series_Test;
-          Exception_Test;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    -- These expressions must be truly static, which is why we have to do them
-    -- outside of the generic, and we use the named numbers. Note that we know
-    -- that PI is not a machine number (it is irrational), and it should be
-    -- represented to more digits than supported by the target machine.
-    Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
-    Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
-    Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
-    Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
-    package Float_Check is new Generic_Check (Float,
- 	Half_PI_Low  => Float_Half_PI_Low,
- 	Half_PI_High => Float_Half_PI_High,
- 	PI_Low  => Float_PI_Low,
- 	PI_High => Float_PI_High);
- 
-    -- check the Floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
-    A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
-    A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
-    A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float,
- 	Half_PI_Low  => A_Long_Float_Half_PI_Low,
- 	Half_PI_High => A_Long_Float_Half_PI_High,
- 	PI_Low  => A_Long_Float_PI_Low,
- 	PI_High => A_Long_Float_PI_High);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2016",
-                 "Check the accuracy of the ARCTAN function");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" &
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2016;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a	Thu Jan  1 00:00:00 1970
***************
*** 1,296 ****
- -- CXG2017.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the TANH function returns
- --      a result that is within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      20 Mar 96   SAIC    Initial release for 2.1
- --      17 Aug 96   SAIC    Incorporated reviewer comments.
- --      03 Jun 98   EDS     Add parens to remove the potential for overflow.
- --                          Remove the invocation of Identity_Test that checks
- --                          Tanh values that are too close to zero for the
- --                          test's error bounds.
- --!
- 
- --
- -- References:
- --
- -- Software Manual for the Elementary Functions
- -- William J. Cody, Jr. and William Waite
- -- Prentice-Hall, 1980
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- -- Implementation and Testing of Function Software
- -- W. J. Cody
- -- Problems and Methodologies in Mathematical Software Production
- -- editors P. C. Messina and A. Murli
- -- Lecture Notes in Computer Science   Volume 142
- -- Springer Verlag, 1982
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Elementary_Functions;
- procedure CXG2017 is
-    Verbose : constant Boolean := False;
-    Max_Samples : constant := 1000;
- 
-    E  : constant := Ada.Numerics.E;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Elementary_Functions is new 
-            Ada.Numerics.Generic_Elementary_Functions (Real);
- 
-       function Tanh (X : Real) return Real renames
-            Elementary_Functions.Tanh;
- 
-       function Log (X : Real) return Real renames
-            Elementary_Functions.Log;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero 
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Small instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Small;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-          -- In the following tests the expected result is accurate
-          -- to the machine precision so the minimum guaranteed error
-          -- bound can be used.
-          Minimum_Error : constant := 8.0;
-          E2 : constant := E * E;
-       begin
-          Check (Tanh (1.0),
-                 (E - 1.0 / E) / (E + 1.0 / E),  
-                 "tanh(1)",
-                 Minimum_Error);
-          Check (Tanh (2.0),
-                 (E2 - 1.0 / E2) / (E2 + 1.0 / E2),  
-                 "tanh(2)",
-                 Minimum_Error);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
- 
-       procedure Exact_Result_Test is
-          No_Error : constant := 0.0;
-       begin
-          -- A.5.1(38);6.0
-          Check (Tanh (0.0),  0.0, "tanh(0)", No_Error);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Identity_Test (A, B : Real) is
-       -- For this test we use the identity
-       --    TANH(u+v) = [TANH(u) + TANH(v)] / [1 + TANH(u)*TANH(v)]
-       -- which is transformed to
-       --    TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
-       -- where C = TANH(1/8) and y = x - 1/8
-       --
-       -- see Cody pg 248-249 for details on the error analysis.
-       -- The net result is a relative error bound of 16 * Model_Epsilon.
-       --
-       -- The second part of this test checks the identity
-       --    TANH(-x) = -TANH(X)
- 
-          X, Y : Real; 
-          Actual1, Actual2 : Real;
-          C : constant := 1.2435300177159620805e-1;
-       begin
-          if Real'Digits > 20 then
-             -- constant C is accurate to 20 digits.  Set the low bound
-             -- on the error to 16*10**-20
-             Error_Low_Bound := 0.00000_00000_00000_00016;
-             Report.Comment ("tanh accuracy checked to 20 digits");
-          end if;
- 
-          Accuracy_Error_Reported := False;  -- reset
-          for I in 1..Max_Samples loop
-             X :=  (B - A) * (Real (I) / Real (Max_Samples)) + A;
-             Actual1 := Tanh(X);
-            
-             -- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
-             Y := X - (1.0 / 8.0);
-             Actual2 := (Tanh (Y) + C) / (1.0 + Tanh(Y) * C);
-  
-             Check (Actual1, Actual2,
-                    "Identity_1_Test " & Integer'Image (I) & ": tanh(" &
- 		   Real'Image (X) & ") ",
-                    16.0);
- 
-             -- TANH(-x) = -TANH(X)
-             Actual2 := Tanh(-X);
-             Check (-Actual1, Actual2,
-                    "Identity_2_Test " & Integer'Image (I) & ": tanh(" &
- 		   Real'Image (X) & ") ",
-                    16.0);
- 
-             if Accuracy_Error_Reported then
-               -- only report the first error in this test in order to keep
-               -- lots of failures from producing a huge error log
-               return;
-             end if;
- 
-          end loop;
-          Error_Low_Bound := 0.0;   -- reset
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Identity_Test" &
-                 " for X=" & Real'Image (X));
-          when others =>
-             Report.Failed ("exception in Identity_Test" &
-                 " for X=" & Real'Image (X));
-       end Identity_Test;
- 
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-             -- cover a large range
-          Identity_Test (1.0, Real'Safe_Last);
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2017",
-                 "Check the accuracy of the TANH function"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2017;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a	Thu Jan  1 00:00:00 1970
***************
*** 1,355 ****
- -- CXG2018.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex EXP function returns
- --      a result that is within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is
- --      instantiated to check complex numbers based upon
- --      both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      21 Mar 96   SAIC    Initial release for 2.1
- --      17 Aug 96   SAIC    Incorporated reviewer comments.
- --      27 Aug 99   RLB     Repair on the error result of checks.
- --      02 Apr 03   RLB     Added code to discard excess precision in the
- --                          construction of the test value for the
- --                          Identity_Test.
- --
- --!
- 
- --
- -- References:
- --
- -- W. J. Cody
- -- CELEFUNT: A Portable Test Package for Complex Elementary Functions
- -- Algorithm 714, Collected Algorithms from ACM.
- -- Published in Transactions On Mathematical Software,
- -- Vol. 19, No. 1, March, 1993, pp. 1-21.
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Generic_Complex_Elementary_Functions;
- procedure CXG2018 is
-    Verbose : constant Boolean := False;
-    -- Note that Max_Samples is the number of samples taken in
-    -- both the real and imaginary directions.  Thus, for Max_Samples
-    -- of 100 the number of values checked is 10000.
-    Max_Samples : constant := 100;
- 
-    E  : constant := Ada.Numerics.E;
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Complex_Type is new
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Type;
- 
-       package CEF is new
-            Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
- 
-       function Exp (X : Complex) return Complex renames CEF.Exp;
-       function Exp (X : Imaginary) return Complex renames CEF.Exp;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Small instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Small;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if;
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name &
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MRE : Real) is
-       begin
-          Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE);
-          Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE);
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-          -- In the following tests the expected result is accurate
-          -- to the machine precision so the minimum guaranteed error
-          -- bound can be used.
-          --
-          -- The error bounds given assumed z is  exact.  When using
-          -- pi there is an extra error of 1.0ME.
-          -- The pi inside the exp call requires that the complex
-          -- component have an extra error allowance of 1.0*angle*ME.
-          -- Thus for pi/2,the Minimum_Error_I is
-          -- (2.0 + 1.0(pi/2))ME <= 3.6ME.
-          -- For pi, it is (2.0 + 1.0*pi)ME <= 5.2ME,
-          -- and for 2pi, it is (2.0 + 1.0(2pi))ME <= 8.3ME.
- 
-          -- The addition of 1 or i to a result is so that neither of
-          -- the components of an expected result is 0.  This is so
-          -- that a reasonable relative error is allowed.
-          Minimum_Error_C : constant := 7.0;   -- for exp(Complex)
-          Minimum_Error_I : constant := 2.0;   -- for exp(Imaginary)
-       begin
-          Check (Exp (1.0 + 0.0*i) + i,
-                 E + i,
-                 "exp(1+0i)",
-                 Minimum_Error_C);
-          Check (Exp ((Pi / 2.0) * i) + 1.0,
-                 1.0 + 1.0*i,
-                 "exp(pi/2*i)",
-                 3.6);
-          Check (Exp (Pi * i) + i,
-                 -1.0 + 1.0*i,
-                 "exp(pi*i)",
-                 5.2);
-          Check (Exp (Pi * 2.0 * i) + i,
-                 1.0 + i,
-                 "exp(2pi*i)",
-                 8.3);
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
- 
-       procedure Exact_Result_Test is
-          No_Error : constant := 0.0;
-       begin
-          -- G.1.2(36);6.0
-          Check (Exp(0.0 + 0.0*i),  1.0 + 0.0 * i, "exp(0+0i)", No_Error);
-          Check (Exp(      0.0*i),  1.0 + 0.0 * i, "exp(0i)", No_Error);
-       exception
-          when Constraint_Error =>
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Identity_Test (A, B : Real) is
-       -- For this test we use the identity
-       --    Exp(Z) = Exp(Z-W) * Exp (W)
-       -- where W = (1+i)/16
-       --
-       -- The second part of this test checks the identity
-       --    Exp(Z) * Exp(-Z)  = 1
-       --
- 
-          X, Y : Complex;
-          Actual1, Actual2 : Complex;
-          W : constant Complex := (0.0625, 0.0625);
-          -- the following constant was taken from the CELEFUNC EXP test.
-          -- This is the value EXP(W) - 1
-          C : constant Complex := (6.2416044877018563681e-2,
-                                   6.6487597751003112768e-2);
-       begin
-          if Real'Digits > 20 then
-             -- constant ExpW is accurate to 20 digits.
-             -- The low bound is 19 * 10**-20
-             Error_Low_Bound := 0.00000_00000_00019;
-             Report.Comment ("complex exp accuracy checked to 20 digits");
-          end if;
- 
-          Accuracy_Error_Reported := False;  -- reset
-          for II in 1..Max_Samples loop
-             X.Re :=  Real'Machine ((B - A) * Real (II) / Real (Max_Samples)
-                         + A);
-             for J in 1..Max_Samples loop
-                X.Im :=  Real'Machine ((B - A) * Real (J) / Real (Max_Samples)
-                            + A);
- 
-                Actual1 := Exp(X);
- 
-                -- Exp(X) = Exp(X-W) * Exp (W)
-                --        = Exp(X-W) * (1 - (1-Exp(W))
-                --        = Exp(X-W) * (1 + (Exp(W) - 1))
-                --        = Exp(X-W) * (1 + C)
-                Y := X - W;
-                Actual2 := Exp(Y);
-                Actual2 := Actual2 + Actual2 * C;
- 
-                Check (Actual1, Actual2,
-                       "Identity_1_Test " & Integer'Image (II) &
-                          Integer'Image (J) & ": Exp((" &
- 		         Real'Image (X.Re) & ", " &
- 		         Real'Image (X.Im) & ")) ",
-                       20.0);   -- 2 exp and 1 multiply and 1 add = 2*7+1*5+1
-                     -- Note: The above is not strictly correct, as multiply
-                     -- has a box error, rather than a relative error.
-                     -- Supposedly, the interval is chosen to avoid the need
-                     -- to worry about this.
- 
-                -- Exp(X) * Exp(-X) + i  = 1 + i
-                -- The addition of i is to allow a reasonable relative
-                -- error in the imaginary part
-                Actual2 := (Actual1 * Exp(-X)) + i;
-                Check (Actual2, (1.0, 1.0),
-                       "Identity_2_Test " & Integer'Image (II) &
-                          Integer'Image (J) & ": Exp((" &
- 		         Real'Image (X.Re) & ", " &
- 		         Real'Image (X.Im) & ")) ",
-                       20.0);   -- 2 exp and 1 multiply and one add = 2*7+1*5+1
- 
-                if Accuracy_Error_Reported then
-                  -- only report the first error in this test in order to keep
-                  -- lots of failures from producing a huge error log
-                  return;
-                end if;
-             end loop;
-          end loop;
-          Error_Low_Bound := 0.0;
-       exception
-          when Constraint_Error =>
-             Report.Failed
-                ("Constraint_Error raised in Identity_Test" &
-                 " for X=(" & Real'Image (X.Re) &
-                 ", " & Real'Image (X.Im) & ")");
-          when others =>
-             Report.Failed ("exception in Identity_Test" &
-                 " for X=(" & Real'Image (X.Re) &
-                 ", " & Real'Image (X.Im) & ")");
-       end Identity_Test;
- 
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-             -- test regions where we can avoid cancellation error problems
-             -- See Cody page 10.
-          Identity_Test (0.0625, 1.0);
-          Identity_Test (15.0, 17.0);
-          Identity_Test (1.625, 3.0);
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2018",
-                 "Check the accuracy of the complex EXP function");
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" &
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2018;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a	Thu Jan  1 00:00:00 1970
***************
*** 1,338 ****
- -- CXG2019.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex LOG function returns
- --      a result that is within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check complex numbers based upon 
- --      both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --         Exception conditions.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      22 Mar 96   SAIC    Initial release for 2.1
- --
- --!
- 
- --
- -- References:
- --
- -- W. J. Cody
- -- CELEFUNT: A Portable Test Package for Complex Elementary Functions
- -- Algorithm 714, Collected Algorithms from ACM.
- -- Published in Transactions On Mathematical Software,
- -- Vol. 19, No. 1, March, 1993, pp. 1-21.
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Generic_Complex_Elementary_Functions;
- procedure CXG2019 is
-    Verbose : constant Boolean := False;
-    -- Note that Max_Samples is the number of samples taken in
-    -- both the real and imaginary directions.  Thus, for Max_Samples
-    -- of 100 the number of values checked is 10000.
-    Max_Samples : constant := 100;
- 
-    E  : constant := Ada.Numerics.E;
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Complex_Type is new
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Type;
- 
-       package CEF is new 
-            Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
- 
-       function Log (X : Complex) return Complex renames CEF.Log;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Small instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MRE : Real) is
-       begin
-          Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE);
-          Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE);
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-          -- In the following tests the expected result is accurate
-          -- to the machine precision so the minimum guaranteed error
-          -- bound can be used if the argument is exact.
-          --
-          -- When using pi there is an extra error of 1.0ME.  
-          -- Although the real component has an error bound of 13.0, 
-          -- the complex component must take into account this error
-          -- in the value for Pi.
-          --
-          -- One or i is added to the actual and expected results in
-          -- order to prevent the expected result from having a 
-          -- real or imaginary part of 0.  This is to allow a reasonable
-          -- relative error for that component.
-          Minimum_Error : constant := 13.0; 
-       begin
-          Check (1.0 + Log (0.0 + i),
-                 1.0 + Pi / 2.0 * i,
-                 "1+log(0+i)",
-                 Minimum_Error + 1.0);
-          Check (1.0 + Log ((-1.0, 0.0)),
-                 1.0 + (Pi * i),
-                 "log(-1+0i)+1 ",
-                 Minimum_Error + 1.0);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
- 
-       procedure Exact_Result_Test is
-          No_Error : constant := 0.0;
-       begin
-          -- G.1.2(37);6.0
-          Check (Log(1.0 + 0.0*i),  0.0 + 0.0 * i, "log(1+0i)", No_Error);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Identity_Test (RA, RB, IA, IB : Real) is
-       -- Tests an identity over a range of values specified
-       -- by the 4 parameters.  RA and RB denote the range for the
-       -- real part while IA and IB denote the range for the 
-       -- imaginary part.
-       --
-       -- For this test we use the identity
-       --    Log(Z*Z) = 2 * Log(Z)
-       --
- 
-          Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4);
-          W, X, Y, Z : Real;
-          CX, CY : Complex;
-          Actual1, Actual2 : Complex;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for II in 1..Max_Samples loop
-             X :=  (RB - RA) * Real (II) / Real (Max_Samples) + RA;
-             for J in 1..Max_Samples loop
-                Y :=  (IB - IA) * Real (J) / Real (Max_Samples) + IA;
-                
-                -- purify the arguments to minimize roundoff error.
-                -- We construct the values so that the products X*X, 
-                -- Y*Y, and X*Y are all exact machine numbers.
-                -- See Cody page 7 and CELEFUNT code.
-                Z := X * Scale;
-                W := Z + X;
-                X := W - Z;
-                Z := Y * Scale;
-                W := Z + Y;
-                Y := W - Z;
-                CX := Compose_From_Cartesian(X,Y);
-                Z := X*X - Y*Y;
-                W := X*Y;
-                CY := Compose_From_Cartesian(Z,W+W);
-  
-                -- The arguments are now ready so on with the 
-                -- identity computation.
-                Actual1 := Log(CX);
-            
-                Actual2 := Log(CY) * 0.5;
-  
-                Check (Actual1, Actual2,
-                       "Identity_1_Test " & Integer'Image (II) & 
-                          Integer'Image (J) & ": Log((" &
- 		         Real'Image (CX.Re) & ", " &
- 		         Real'Image (CX.Im) & ")) ",
-                       26.0);   -- 2 logs = 2*13.  no error from this multiply
- 
-                if Accuracy_Error_Reported then
-                  -- only report the first error in this test in order to keep
-                  -- lots of failures from producing a huge error log
-                  return;
-                end if;
-             end loop;
-          end loop;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Identity_Test" &
-                 " for X=(" & Real'Image (X) &
-                 ", " & Real'Image (X) & ")");
-          when others =>
-             Report.Failed ("exception in Identity_Test" &
-                 " for X=(" & Real'Image (X) &
-                 ", " & Real'Image (X) & ")");
-       end Identity_Test;
- 
- 
-       procedure Exception_Test is
-       -- Check that log((0,0)) causes constraint_error.
-       -- G.1.2(29);
- 
-          X : Complex := (0.0, 0.0);
-       begin
-          if not Real'Machine_Overflows then
-             -- not applicable:   G.1.2(28);6.0
-             return;
-          end if;
- 
-          begin
-             X := Log ((0.0, 0.0));
-             Report.Failed ("exception not raised for log(0,0)");
-          exception
-             when Constraint_Error => null;  -- ok
-             when others =>
-                Report.Failed ("wrong exception raised for log(0,0)");
-          end;
- 
-          -- optimizer thwarting
-          if Report.Ident_Bool(False) then
-             Report.Comment (Real'Image (X.Re + X.Im));
-          end if;
-       end Exception_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-             -- test regions that do not include the unit circle so that
-             -- the real part of LOG(Z) does not vanish
-             -- See Cody page 9.
-          Identity_Test (   2.0,   10.0,       0.0,    10.0);
-          Identity_Test (1000.0, 2000.0,   -4000.0, -1000.0);
-          Identity_Test (Real'Model_Epsilon, 0.25,
-                         -0.25,              -Real'Model_Epsilon);
-          Exception_Test;
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2019",
-                 "Check the accuracy of the complex LOG function"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2019;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,351 ****
- -- CXG2020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex SQRT function returns
- --      a result that is within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check complex numbers based upon 
- --      both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      24 Mar 96   SAIC    Initial release for 2.1 
- --      17 Aug 96   SAIC    Incorporated reviewer comments.
- --      03 Jun 98   EDS     Added parens to ensure that the expression is not
- --                          evaluated by multiplying its two large terms
- --                          together and overflowing.
- --!
- 
- --
- -- References:
- --
- -- W. J. Cody
- -- CELEFUNT: A Portable Test Package for Complex Elementary Functions
- -- Algorithm 714, Collected Algorithms from ACM.
- -- Published in Transactions On Mathematical Software,
- -- Vol. 19, No. 1, March, 1993, pp. 1-21.
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Generic_Complex_Elementary_Functions;
- procedure CXG2020 is
-    Verbose : constant Boolean := False;
-    -- Note that Max_Samples is the number of samples taken in
-    -- both the real and imaginary directions.  Thus, for Max_Samples
-    -- of 100 the number of values checked is 10000.
-    Max_Samples : constant := 100;
- 
-    E  : constant := Ada.Numerics.E;
-    Pi : constant := Ada.Numerics.Pi;
- 
-    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
-    Sqrt2 : constant := 
-         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
-    Sqrt3 : constant :=
-         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Complex_Type is new
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Type;
- 
-       package CEF is new 
-            Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
- 
-       function Sqrt (X : Complex) return Complex renames CEF.Sqrt;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
- 
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon 
-          -- instead of Model_Epsilon and Expected.
-          Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed");
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MRE : Real) is
-       begin
-          Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE);
-          Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE);
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-          -- In the following tests the expected result is accurate
-          -- to the machine precision so the minimum guaranteed error
-          -- bound can be used if the argument is exact.
-          --
-          -- One or i is added to the actual and expected results in
-          -- order to prevent the expected result from having a 
-          -- real or imaginary part of 0.  This is to allow a reasonable
-          -- relative error for that component.
-          Minimum_Error : constant := 6.0; 
-          Z1, Z2 : Complex;
-       begin
-          Check (Sqrt(9.0+0.0*i) + i,
-                 3.0+1.0*i,
-                 "sqrt(9+0i)+i",
-                 Minimum_Error);
-          Check (Sqrt (-2.0 + 0.0 * i) + 1.0,
-                 1.0 + Sqrt2 * i,
-                 "sqrt(-2)+1 ",
-                 Minimum_Error);
- 
-          -- make sure no exception occurs when taking the sqrt of 
-          -- very large and very small values.
- 
-          Z1 := (Real'Safe_Last * 0.9, Real'Safe_Last * 0.9);
-          Z2 := Sqrt (Z1);
-          begin
-             Check (Z2 * Z2,
-                    Z1,
-                    "sqrt((big,big))",
-                    Minimum_Error + 5.0);  -- +5 for multiply
-          exception
-             when others =>
-                 Report.Failed ("unexpected exception in sqrt((big,big))");
-          end;
-         
-          Z1 := (Real'Model_Epsilon * 10.0, Real'Model_Epsilon * 10.0);
-          Z2 := Sqrt (Z1);
-          begin
-             Check (Z2 * Z2,
-                    Z1,
-                    "sqrt((little,little))",
-                    Minimum_Error + 5.0);  -- +5 for multiply
-          exception
-             when others =>
-                 Report.Failed ("unexpected exception in " &
-                     "sqrt((little,little))");
-          end;
-         
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
- 
-       procedure Exact_Result_Test is
-          No_Error : constant := 0.0;
-       begin
-          -- G.1.2(36);6.0
-          Check (Sqrt(0.0 + 0.0*i),  0.0 + 0.0 * i, "sqrt(0+0i)", No_Error);
- 
-          -- G.1.2(37);6.0
-          Check (Sqrt(1.0 + 0.0*i),  1.0 + 0.0 * i, "sqrt(1+0i)", No_Error);
- 
-          -- G.1.2(38-39);6.0
-          Check (Sqrt(-1.0 + 0.0*i),  0.0 + 1.0 * i, "sqrt(-1+0i)", No_Error);
- 
-          -- G.1.2(40);6.0
-          if Real'Signed_Zeros then
-             Check (Sqrt(-1.0-0.0*i), 0.0 - 1.0 * i, "sqrt(-1-0i)", No_Error);
-          end if;
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Identity_Test (RA, RB, IA, IB : Real) is
-       -- Tests an identity over a range of values specified
-       -- by the 4 parameters.  RA and RB denote the range for the
-       -- real part while IA and IB denote the range for the 
-       -- imaginary part of the result.
-       --
-       -- For this test we use the identity
-       --    Sqrt(Z*Z) = Z
-       --
- 
-          Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4);
-          W, X, Y, Z : Real;
-          CX : Complex;
-          Actual, Expected : Complex;
-       begin
-          Accuracy_Error_Reported := False;  -- reset
-          for II in 1..Max_Samples loop
-             X :=  (RB - RA) * Real (II) / Real (Max_Samples) + RA;
-             for J in 1..Max_Samples loop
-                Y :=  (IB - IA) * Real (J) / Real (Max_Samples) + IA;
-                
-                -- purify the arguments to minimize roundoff error.
-                -- We construct the values so that the products X*X, 
-                -- Y*Y, and X*Y are all exact machine numbers.
-                -- See Cody page 7 and CELEFUNT code.
-                Z := X * Scale;
-                W := Z + X;
-                X := W - Z;
-                Z := Y * Scale;
-                W := Z + Y;
-                Y := W - Z;
-                  -- G.1.2(21);6.0 - real part of result is non-negative
-                Expected := Compose_From_Cartesian( abs X,Y);
-                Z := X*X - Y*Y;
-                W := X*Y;
-                CX := Compose_From_Cartesian(Z,W+W);
-  
-                -- The arguments are now ready so on with the 
-                -- identity computation.
-                Actual := Sqrt(CX);
-            
-                Check (Actual, Expected,
-                       "Identity_1_Test " & Integer'Image (II) & 
-                          Integer'Image (J) & ": Sqrt((" &
- 		         Real'Image (CX.Re) & ", " &
- 		         Real'Image (CX.Im) & ")) ",
-                       8.5);   -- 6.0 from sqrt, 2.5 from argument.  
-                -- See Cody pg 7-8 for analysis of additional error amount.
- 
-                if Accuracy_Error_Reported then
-                  -- only report the first error in this test in order to keep
-                  -- lots of failures from producing a huge error log
-                  return;
-                end if;
-             end loop;
-          end loop;
- 
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Identity_Test" &
-                 " for X=(" & Real'Image (X) &
-                 ", " & Real'Image (X) & ")");
-          when others =>
-             Report.Failed ("exception in Identity_Test" &
-                 " for X=(" & Real'Image (X) &
-                 ", " & Real'Image (X) & ")");
-       end Identity_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-          -- ranges where the sign is the same and where it 
-          -- differs.
-          Identity_Test (   0.0,   10.0,       0.0,    10.0);
-          Identity_Test (   0.0,  100.0,    -100.0,     0.0);
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2020",
-                 "Check the accuracy of the complex SQRT function"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2020;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a	Thu Jan  1 00:00:00 1970
***************
*** 1,386 ****
- -- CXG2021.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that the complex SIN and COS functions return
- --      a result that is within the error bound allowed.
- --
- -- TEST DESCRIPTION:
- --      This test consists of a generic package that is 
- --      instantiated to check complex numbers based upon 
- --      both Float and a long float type.
- --      The test for each floating point type is divided into
- --      several parts:
- --         Special value checks where the result is a known constant.
- --         Checks that use an identity for determining the result.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --      27 Mar 96   SAIC    Initial release for 2.1
- --      22 Aug 96   SAIC    No longer skips test for systems with
- --                          more than 20 digits of precision.
- --
- --!
- 
- --
- -- References:
- --
- -- W. J. Cody
- -- CELEFUNT: A Portable Test Package for Complex Elementary Functions
- -- Algorithm 714, Collected Algorithms from ACM.
- -- Published in Transactions On Mathematical Software,
- -- Vol. 19, No. 1, March, 1993, pp. 1-21.
- --
- -- CRC Standard Mathematical Tables
- -- 23rd Edition 
- --
- 
- with System;
- with Report;
- with Ada.Numerics.Generic_Complex_Types;
- with Ada.Numerics.Generic_Complex_Elementary_Functions;
- procedure CXG2021 is
-    Verbose : constant Boolean := False;
-    -- Note that Max_Samples is the number of samples taken in
-    -- both the real and imaginary directions.  Thus, for Max_Samples
-    -- of 100 the number of values checked is 10000.
-    Max_Samples : constant := 100;
- 
-    E  : constant := Ada.Numerics.E;
-    Pi : constant := Ada.Numerics.Pi;
- 
-    generic
-       type Real is digits <>;
-    package Generic_Check is
-       procedure Do_Test;
-    end Generic_Check;
- 
-    package body Generic_Check is
-       package Complex_Type is new
-            Ada.Numerics.Generic_Complex_Types (Real);
-       use Complex_Type;
- 
-       package CEF is new 
-            Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
- 
-       function Sin (X : Complex) return Complex renames CEF.Sin;
-       function Cos (X : Complex) return Complex renames CEF.Cos;
- 
-       -- flag used to terminate some tests early
-       Accuracy_Error_Reported : Boolean := False;
- 
-       -- The following value is a lower bound on the accuracy
-       -- required.  It is normally 0.0 so that the lower bound
-       -- is computed from Model_Epsilon.  However, for tests
-       -- where the expected result is only known to a certain
-       -- amount of precision this bound takes on a non-zero 
-       -- value to account for that level of precision.
-       Error_Low_Bound : Real := 0.0;
- 
-       -- the E_Factor is an additional amount added to the Expected
-       -- value prior to computing the maximum relative error.
-       -- This is needed because the error analysis (Cody pg 17-20)
-       -- requires this additional allowance.
-       procedure Check (Actual, Expected : Real;
-                        Test_Name : String;
-                        MRE : Real;
-                        E_Factor : Real := 0.0) is
-          Max_Error : Real;
-          Rel_Error : Real;
-          Abs_Error : Real;
-       begin
-          -- In the case where the expected result is very small or 0
-          -- we compute the maximum error as a multiple of Model_Epsilon instead
-          -- of Model_Epsilon and Expected.
-          Rel_Error := MRE * Real'Model_Epsilon * (abs Expected + E_Factor);
-          Abs_Error := MRE * Real'Model_Epsilon;
-          if Rel_Error > Abs_Error then
-             Max_Error := Rel_Error;
-          else
-             Max_Error := Abs_Error;
-          end if; 
- 
-          -- take into account the low bound on the error
-          if Max_Error < Error_Low_Bound then
-             Max_Error := Error_Low_Bound;
-          end if;
- 
-          if abs (Actual - Expected) > Max_Error then
-             Accuracy_Error_Reported := True;
-             Report.Failed (Test_Name & 
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) &
-                            " efactor:" & Real'Image (E_Factor) );
-          elsif Verbose then
- 	    if Actual = Expected then
- 	       Report.Comment (Test_Name & "  exact result");
- 	    else
- 	       Report.Comment (Test_Name & "  passed" &
-                            " actual: " & Real'Image (Actual) &
-                            " expected: " & Real'Image (Expected) &
-                            " difference: " & Real'Image (Actual - Expected) &
-                            " max err:" & Real'Image (Max_Error) &
-                            " efactor:" & Real'Image (E_Factor) );
- 	    end if;
-          end if;
-       end Check;
- 
- 
-       procedure Check (Actual, Expected : Complex;
-                        Test_Name : String;
-                        MRE : Real;
-                        R_Factor, I_Factor : Real := 0.0) is
-       begin
-          Check (Actual.Re, Expected.Re, Test_Name & " real part", 
-                 MRE, R_Factor);
-          Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", 
-                 MRE, I_Factor);
-       end Check;
- 
- 
-       procedure Special_Value_Test is
-          -- In the following tests the expected result is accurate
-          -- to the machine precision so the minimum guaranteed error
-          -- bound can be used if the argument is exact.
-          -- Since the argument involves Pi, we must allow for this
-          -- inexact argument.
-          Minimum_Error : constant := 11.0; 
-       begin
-          Check (Sin (Pi/2.0 + 0.0*i),
-                 1.0 + 0.0*i,
-                 "sin(pi/2+0i)",
-                 Minimum_Error + 1.0);
-          Check (Cos (Pi/2.0 + 0.0*i),
-                 0.0 + 0.0*i,
-                 "cos(pi/2+0i)",
-                 Minimum_Error + 1.0);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in special value test");
-          when others =>
-             Report.Failed ("exception in special value test");
-       end Special_Value_Test;
- 
- 
- 
-       procedure Exact_Result_Test is
-          No_Error : constant := 0.0;
-       begin
-          -- G.1.2(36);6.0
-          Check (Sin(0.0 + 0.0*i),  0.0 + 0.0 * i, "sin(0+0i)", No_Error);
-          Check (Cos(0.0 + 0.0*i),  1.0 + 0.0 * i, "cos(0+0i)", No_Error);
-       exception
-          when Constraint_Error => 
-             Report.Failed ("Constraint_Error raised in Exact_Result Test");
-          when others =>
-             Report.Failed ("exception in Exact_Result Test");
-       end Exact_Result_Test;
- 
- 
-       procedure Identity_Test (RA, RB, IA, IB : Real) is
-       -- Tests an identity over a range of values specified
-       -- by the 4 parameters.  RA and RB denote the range for the
-       -- real part while IA and IB denote the range for the 
-       -- imaginary part.
-       --
-       -- For this test we use the identity
-       --    Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W)
-       -- and
-       --    Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W)
-       --
- 
-          X, Y : Real;
-          Z   : Complex;
-          W : constant Complex := Compose_From_Cartesian(0.0625, 0.0625);
-          ZmW : Complex;  -- Z - W
-          Sin_ZmW,
-          Cos_ZmW : Complex;
-          Actual1, Actual2 : Complex;
-          R_Factor : Real;  -- additional real error factor
-          I_Factor : Real;  -- additional imaginary error factor
-          Sin_W : constant Complex := (6.2581348413276935585E-2,
-                                       6.2418588008436587236E-2);
-          -- numeric stability is enhanced by using Cos(W) - 1.0 instead of
-          -- Cos(W) in the computation.
-          Cos_W_m_1 : constant Complex := (-2.5431314180235545803E-6,
-                                             -3.9062493377261771826E-3);
- 
- 
-       begin
-          if Real'Digits > 20 then
-             -- constants used here accurate to 20 digits.  Allow 1
-             -- additional digit of error for computation.
-             Error_Low_Bound := 0.00000_00000_00000_0001;
-             Report.Comment ("accuracy checked to 19 digits");
-          end if;
- 
-          Accuracy_Error_Reported := False;  -- reset
-          for II in 0..Max_Samples loop
-             X :=  (RB - RA) * Real (II) / Real (Max_Samples) + RA;
-             for J in 0..Max_Samples loop
-                Y :=  (IB - IA) * Real (J) / Real (Max_Samples) + IA;
-                
-                Z := Compose_From_Cartesian(X,Y);
-                ZmW := Z - W;
-                Sin_ZmW := Sin (ZmW);
-                Cos_ZmW := Cos (ZmW);
- 
-                -- now for the first identity 
-                --    Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W)
-                --           = Sin(Z-W) * (1+(Cos(W)-1)) + Cos(Z-W) * Sin(W)
-                --           = Sin(Z-W) + Sin(Z-W)*(Cos(W)-1) + Cos(Z-W)*Sin(W)
- 
- 
-                Actual1 := Sin (Z);
-                Actual2 := Sin_ZmW + (Sin_ZmW * Cos_W_m_1 + Cos_ZmW * Sin_W);
- 
-                -- The computation of the additional error factors are taken
-                -- from Cody pages 17-20.
- 
-                R_Factor := abs (Re (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) +
-                            abs (Im (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) +
-                            abs (Re (Cos_ZmW) * Re (Sin_W)) +
-                            abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1));
-  
-                I_Factor := abs (Re (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) +
-                            abs (Im (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) +
-                            abs (Re (Cos_ZmW) * Im (Sin_W)) +
-                            abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1));
-  
-                Check (Actual1, Actual2,
-                       "Identity_1_Test " & Integer'Image (II) & 
-                          Integer'Image (J) & ": Sin((" &
- 		         Real'Image (Z.Re) & ", " &
- 		         Real'Image (Z.Im) & ")) ",
-                       11.0, R_Factor, I_Factor); 
- 
-                -- now for the second identity 
-                --    Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W)
-                --           = Cos(Z-W) * (1+(Cos(W)-1) - Sin(Z-W) * Sin(W)
-                Actual1 := Cos (Z);
-                Actual2 := Cos_ZmW + (Cos_ZmW * Cos_W_m_1 - Sin_ZmW * Sin_W);
- 
-                -- The computation of the additional error factors are taken
-                -- from Cody pages 17-20.
- 
-                R_Factor := abs (Re (Sin_ZmW) * Re (Sin_W)) +
-                            abs (Im (Sin_ZmW) * Im (Sin_W)) +
-                            abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1)) +
-                            abs (Im (Cos_ZmW) * Im (1.0 - Cos_W_m_1));
-  
-                I_Factor := abs (Re (Sin_ZmW) * Im (Sin_W)) +
-                            abs (Im (Sin_ZmW) * Re (Sin_W)) +
-                            abs (Re (Cos_ZmW) * Im (1.0 - Cos_W_m_1)) +
-                            abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1));
-  
-                Check (Actual1, Actual2,
-                       "Identity_2_Test " & Integer'Image (II) & 
-                          Integer'Image (J) & ": Cos((" &
- 		         Real'Image (Z.Re) & ", " &
- 		         Real'Image (Z.Im) & ")) ",
-                       11.0, R_Factor, I_Factor); 
- 
-                if Accuracy_Error_Reported then
-                  -- only report the first error in this test in order to keep
-                  -- lots of failures from producing a huge error log
-                  Error_Low_Bound := 0.0;  -- reset
-                  return;
-                end if;
-             end loop;
-          end loop;
- 
-          Error_Low_Bound := 0.0;  -- reset
-       exception
-          when Constraint_Error => 
-             Report.Failed 
-                ("Constraint_Error raised in Identity_Test" &
-                 " for Z=(" & Real'Image (X) &
-                 ", " & Real'Image (Y) & ")");
-          when others =>
-             Report.Failed ("exception in Identity_Test" &
-                 " for Z=(" & Real'Image (X) &
-                 ", " & Real'Image (Y) & ")");
-       end Identity_Test;
- 
- 
-       procedure Do_Test is
-       begin
-          Special_Value_Test;
-          Exact_Result_Test;
-             -- test regions where sin and cos have the same sign and
-             -- about the same magnitude.  This will minimize subtraction
-             -- errors in the identities.
-             -- See Cody page 17.
-          Identity_Test (0.0625,   10.0,    0.0625,    10.0);
-          Identity_Test (  16.0,   17.0,      16.0,    17.0);
-       end Do_Test;
-    end Generic_Check;
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
-    package Float_Check is new Generic_Check (Float);
- 
-    -- check the floating point type with the most digits
-    type A_Long_Float is digits System.Max_Digits;
-    package A_Long_Float_Check is new Generic_Check (A_Long_Float);
- 
-    -----------------------------------------------------------------------
-    -----------------------------------------------------------------------
- 
- 
- begin
-    Report.Test ("CXG2021",
-                 "Check the accuracy of the complex SIN and COS functions"); 
- 
-    if Verbose then
-       Report.Comment ("checking Standard.Float");
-    end if;
- 
-    Float_Check.Do_Test;
- 
-    if Verbose then
-       Report.Comment ("checking a digits" & 
-                       Integer'Image (System.Max_Digits) &
-                       " floating point type");
-    end if;
- 
-    A_Long_Float_Check.Do_Test;
- 
- 
-    Report.Result;
- end CXG2021;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a	Thu Jan  1 00:00:00 1970
***************
*** 1,309 ****
- -- CXG2022.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that multiplication and division of binary fixed point 
- --      numbers with compatible 'small values produce exact results.
- --
- -- TEST DESCRIPTION:
- --      Signed, unsigned, and a mixture of signed and unsigned
- --      binary fixed point values are multiplied and divided.
- --      The result is checked against the expected "perfect result set"
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --
- --
- -- CHANGE HISTORY:
- --       1 Apr 96   SAIC    Initial release for 2.1
- --      29 Jan 1998 EDS     Repaired fixed point errors ("**" and 
- --                          assumptions about 'Small)
- --!
- 
- with System;
- with Report;
- procedure CXG2022 is
-    Verbose : constant Boolean := False;
- 
- procedure Check_Signed is
-    type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) ..
-                                   2.0 ** (System.Max_Mantissa) - 1.0;
-    type Halves is delta 0.5 range -2.0 ** (System.Max_Mantissa-2) ..
-                                    2.0 ** (System.Max_Mantissa-2) - 1.0;
-    P1, P2, P3, P4 : Pairs;
-    H1, H2, H3, H4 : Halves;
- 
-    procedure Dont_Opt is
-    -- keep optimizer from knowing the constant value of expressions
-    begin
-       if Report.Ident_Bool (False) then
-          P1 :=  2.0;  P2 := 4.0;  P3 := 6.0;
-          H1 := -2.0;  H2 := 9.0;  H3 := 3.0;
-       end if;
-    end Dont_Opt;
- 
- begin
-    H1 := -0.5;
-    H2 := Halves'First;
-    H3 := 1.0;
-    P1 := 12.0;
-    P2 := Pairs'First;
-    P3 := Pairs'Last;
-    Dont_Opt;
- 
-    P4 := Pairs (P1 * H1);     -- 12.0 * -0.5
-    if P4 /= -6.0 then
-       Report.Failed ("12.0 * -0.5 = " & Pairs'Image (P4));
-    end if;
- 
-    H4 := Halves (P1 / H1);     -- 12.0 / -0.5
-    if H4 /= -24.0 then
-       Report.Failed ("12.0 / -0.5 = " & Halves'Image (H4));
-    end if;
- 
-    P4 := P3 * H3;     -- Pairs'Last * 1.0
-    if P4 /= Pairs'Last then
-       Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := P3 / H3;     -- Pairs'Last / 1.0
-    if P4 /= Pairs'Last then
-       Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := P2 * 0.25;     -- Pairs'First * 0.25
-    if P4 /= Pairs (-2.0 ** (System.Max_Mantissa - 2)) then
-       Report.Failed ("Pairs'First * 0.25 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := 100.5 / H1;   -- 100.5 / -0.5
-    if P4 = -201.0 then
-       null;   -- Perfect result
-    elsif Pairs'Small = 2.0 and ( P4 = -200.0 or P4 = -202.0 ) then
-       null;   -- Allowed variation
-    else
-       Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) &
-                      " and 100.5/-0.5 = " & Pairs'Image (P4) );
-    end if;
- 
-    H4 := H1 * H2;   --  -0.5 * Halves'First
-    if H4 /= Halves (2.0 ** (System.Max_Mantissa-3)) then
-       Report.Failed ("-0.5 * Halves'First =" & Halves'Image (H4) &
-                      " instead of " &
-                      Halves'Image( Halves(2.0 ** (System.Max_Mantissa-3)))); 
-    end if;
- 
- exception
-    when others =>
-       Report.Failed ("unexpected exception in Check_Signed");
- end Check_Signed;
- 
- 
- 
- procedure Check_Unsigned is
-    type Pairs is delta 2.0 range 0.0 .. 2.0 ** (System.Max_Mantissa+1) - 1.0;
-    type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0;
-    P1, P2, P3, P4 : Pairs;
-    H1, H2, H3, H4 : Halves;
- 
-    procedure Dont_Opt is
-    -- keep optimizer from knowing the constant value of expressions
-    begin
-       if Report.Ident_Bool (False) then
-          P1 :=  2.0;  P2 := 4.0;  P3 := 6.0;
-          H1 :=  2.0;  H2 := 9.0;  H3 := 3.0;
-       end if;
-    end Dont_Opt;
- 
- begin
-    H1 := 10.5;
-    H2 := Halves(2.0 ** (System.Max_Mantissa - 6));
-    H3 := 1.0;
-    P1 := 12.0;
-    P2 := Pairs'Last / 2;
-    P3 := Pairs'Last;
-    Dont_Opt;
- 
-    P4 := Pairs (P1 * H1);     -- 12.0 * 10.5
-    if P4 /= 126.0 then
-       Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4));
-    end if;
- 
-    H4 := Halves (P1 / H1);     -- 12.0 / 10.5
-    if H4 /= 1.0 and H4 /= 1.5 then
-       Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4));
-    end if;
- 
-    P4 := P3 * H3;     -- Pairs'Last * 1.0
-    if P4 /= Pairs'Last then
-       Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := P3 / H3;     -- Pairs'Last / 1.0
-    if P4 /= Pairs'Last then
-       Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := P1 * 0.25;     -- 12.0 * 0.25
-    if P4 /= 2.0 and P4 /= 4.0 then
-       Report.Failed ("12.0 * 0.25 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := 100.5 / H1;   -- 100.5 / 10.5    = 9.571...
-    if P4 /= 8.0 and P4 /= 10.0 then
-       Report.Failed ("100.5/10.5 = " & Pairs'Image (P4));
-    end if;
- 
-    H4 := H2 * 2;   --  2**(max_mantissa-6) * 2
-    if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then
-       Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) &
-                      " instead of " &
-                      Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); 
-    end if;
- 
- exception
-    when others =>
-       Report.Failed ("unexpected exception in Check_Unsigned");
- end Check_Unsigned;
- 
- 
- 
- procedure Check_Mixed is
-    type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) ..
-                                   2.0 ** (System.Max_Mantissa) - 1.0;
-    type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0;
-    P1, P2, P3, P4 : Pairs;
-    H1, H2, H3, H4 : Halves;
- 
-    procedure Dont_Opt is
-    -- keep optimizer from knowing the constant value of expressions
-    begin
-       if Report.Ident_Bool (False) then
-          P1 :=  2.0;  P2 := 4.0;  P3 := 6.0;
-          H1 :=  2.0;  H2 := 9.0;  H3 := 3.0;
-       end if;
-    end Dont_Opt;
- 
- begin
-    H1 := 10.5;
-    H2 := Halves(2.0 ** (System.Max_Mantissa - 6));
-    H3 := 1.0;
-    P1 := 12.0;
-    P2 := -4.0;
-    P3 := Pairs'Last;
-    Dont_Opt;
- 
-    P4 := Pairs (P1 * H1);     -- 12.0 * 10.5
-    if P4 /= 126.0 then
-       Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4));
-    end if;
- 
-    H4 := Halves (P1 / H1);     -- 12.0 / 10.5
-    if H4 /= 1.0 and H4 /= 1.5 then
-       Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4));
-    end if;
- 
-    P4 := P3 * H3;     -- Pairs'Last * 1.0
-    if P4 /= Pairs'Last then
-       Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := P3 / H3;     -- Pairs'Last / 1.0
-    if P4 /= Pairs'Last then
-       Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4));
-    end if;
- 
-    P4 := P1 * 0.25;   -- 12.0 * 0.25
-    if P4 = 3.0 then
-       null;    -- Perfect result
-    elsif Pairs'Small = 2.0 and then ( P4 = 2.0 or P4 = 4.0 ) then
-       null;    -- Allowed deviation
-    else
-       Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) &
-                      "and 12.0 * 0.25 = " & Pairs'Image (P4) );
-    end if;
- 
-    P4 := 100.5 / H1;   -- 100.5 / 10.5    = 9.571...
-    if P4 = 9.0 then
-       null;    -- Perfect result
-    elsif Pairs'Small = 2.0 and then ( P4 = 8.0 or P4 = 10.0 ) then
-       null;    -- Allowed values
-    else
-      Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) &
-                     "and 100.5/10.5 = " & Pairs'Image (P4) );
-    end if;
- 
-    H4 := H2 * 2;   --  2**(max_mantissa-6) * 2
-    if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then
-       Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) &
-                      " instead of " &
-                      Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); 
-    end if;
- 
-    P4 := Pairs(P1 * 6) / P2;    -- 12 * 6 / -4
-    if (P4 /= -18.0)  then
-       Report.Failed ("12*6/-4 = " & Pairs'Image(P4));
-    end if;
- 
-    P4 := Halves(P1 * 6.0) / P2;    -- 12 * 6 / -4
-    if (P4 /= -18.0)  then
-       Report.Failed ("Halves(12*6)/-4 = " & Pairs'Image(P4));
-    end if;
- 
- exception
-    when others =>
-       Report.Failed ("unexpected exception in Check_Mixed");
- end Check_Mixed;
- 
- 
- begin  -- main
-    Report.Test ("CXG2022",
-                 "Check the accuracy of multiplication and division" &
-                 " of binary fixed point numbers"); 
-    if Verbose then
-       Report.Comment ("starting signed test");
-    end if;
-    Check_Signed;
- 
-    if Verbose then
-       Report.Comment ("starting unsigned test");
-    end if;
-    Check_Unsigned;
- 
-    if Verbose then
-       Report.Comment ("starting mixed sign test");
-    end if;
-    Check_Mixed;
- 
-    Report.Result;
- end CXG2022;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a	Thu Jan  1 00:00:00 1970
***************
*** 1,351 ****
- -- CXG2023.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that multiplication and division of decimal fixed point 
- --      numbers produce exact results.
- --
- -- TEST DESCRIPTION:
- --      Check that multiplication and division of decimal fixed point 
- --      numbers produce exact results.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --      This test applies only to implementations supporting
- --      decimal fixed point types of at least 9 digits.
- --
- --
- -- CHANGE HISTORY:
- --       3 Apr 96   SAIC    Initial release for 2.1
- --
- --!
- 
- with System;
- with Report;
- procedure CXG2023 is
-    Verbose : constant Boolean := False;
- 
- procedure Check_1 is
-    Num_Digits : constant := 6;
-    type Pennies is delta 0.01 digits Num_Digits;
-    type Franklins is delta 100.0 digits Num_Digits;
-    type Dollars is delta 1.0 digits Num_Digits;
- 
-    P1 : Pennies;
-    F1 : Franklins;
-    D1 : Dollars;
- 
-    -- optimization thwarting functions
- 
-    function P (X : Pennies) return Pennies is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 3.21;    -- never executed
-       end if;
-    end P;
- 
- 
-    function F (X : Franklins) return Franklins is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 32100.0;    -- never executed
-       end if;
-    end F;
- 
- 
-    function D (X : Dollars) return Dollars is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 321.0;    -- never executed
-       end if;
-    end D;
- 
- 
- begin
-    -- multiplication where one operand is universal real
- 
-    P1 := P(0.05) * 200.0;
-    if P1 /= 10.00 then
-       Report.Failed ("1 - expected 10.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := P(0.05) * 100.0;
-    if D1 /= 5.00 then
-       Report.Failed ("2 - expected 5.00  got " & Dollars'Image (D1));
-    end if;
- 
-    F1 := P(0.05) * 50_000.0;
-    if F1 /= 2500.00 then
-       Report.Failed ("3 - expected 2500.0  got " & Franklins'Image (F1));
-    end if;
- 
-    -- multiplication where both operands are decimal fixed
- 
-    P1 := P(0.05) * D(-200.0);
-    if P1 /= -10.00 then
-       Report.Failed ("4 - expected -10.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := P(0.05) * P(-100.0);
-    if D1 /= -5.00 then
-       Report.Failed ("5 - expected -5.00  got " & Dollars'Image (D1));
-    end if;
- 
-    F1 := P(-0.05) * F(50_000.0);
-    if F1 /= -2500.00 then
-       Report.Failed ("6 - expected -2500.0  got " & Franklins'Image (F1));
-    end if;
- 
-    -- division where one operand is universal real
- 
-    P1 := P(0.05) / 0.001;
-    if P1 /= 50.00 then
-       Report.Failed ("7 - expected 50.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := D(1000.0) / 3.0;
-    if D1 /= 333.00 then
-       Report.Failed ("8 - expected 333.00  got " & Dollars'Image (D1));
-    end if;
- 
-    F1 := P(1234.56) / 0.0001;
-    if F1 /= 12345600.00 then
-       Report.Failed ("9 - expected 12345600.0  got " & Franklins'Image (F1));
-    end if;
- 
- 
-    -- division where both operands are decimal fixed
- 
-    P1 := P(0.05) / D(1.0);
-    if P1 /= 0.05 then
-       Report.Failed ("10 - expected 0.05  got " & Pennies'Image (P1));
-    end if;
- 
-        -- check for truncation toward 0
-    D1 := P(-101.00) / P(2.0);
-    if D1 /= -50.00 then
-       Report.Failed ("11 - expected -50.00  got " & Dollars'Image (D1));
-    end if;
- 
-    P1 := P(-102.03) / P(-0.5);
-    if P1 /= 204.06 then
-       Report.Failed ("12 - expected 204.06  got " & Pennies'Image (P1));
-    end if;
- 
-    F1 := P(876.54) / P(0.03);
-    if F1 /= 29200.00 then
-       Report.Failed ("13 - expected 29200.0  got " & Franklins'Image (F1));
-    end if;
- 
- exception
-    when others =>
-       Report.Failed ("unexpected exception in Check_1");
- end Check_1;
- 
- generic
-    type Pennies   is delta<> digits<>;
-    type Dollars   is delta<> digits<>;
-    type Franklins is delta<> digits<>;
- procedure Generic_Check;
- procedure Generic_Check is
- 
-    -- the following code is copied directly from the
-    -- above procedure Check_1
- 
-    P1 : Pennies;
-    F1 : Franklins;
-    D1 : Dollars;
- 
-    -- optimization thwarting functions
- 
-    function P (X : Pennies) return Pennies is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 3.21;    -- never executed
-       end if;
-    end P;
- 
- 
-    function F (X : Franklins) return Franklins is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 32100.0;    -- never executed
-       end if;
-    end F;
- 
- 
-    function D (X : Dollars) return Dollars is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 321.0;    -- never executed
-       end if;
-    end D;
- 
- 
- begin
-    -- multiplication where one operand is universal real
- 
-    P1 := P(0.05) * 200.0;
-    if P1 /= 10.00 then
-       Report.Failed ("1 - expected 10.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := P(0.05) * 100.0;
-    if D1 /= 5.00 then
-       Report.Failed ("2 - expected 5.00  got " & Dollars'Image (D1));
-    end if;
- 
-    F1 := P(0.05) * 50_000.0;
-    if F1 /= 2500.00 then
-       Report.Failed ("3 - expected 2500.0  got " & Franklins'Image (F1));
-    end if;
- 
-    -- multiplication where both operands are decimal fixed
- 
-    P1 := P(0.05) * D(-200.0);
-    if P1 /= -10.00 then
-       Report.Failed ("4 - expected -10.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := P(0.05) * P(-100.0);
-    if D1 /= -5.00 then
-       Report.Failed ("5 - expected -5.00  got " & Dollars'Image (D1));
-    end if;
- 
-    F1 := P(-0.05) * F(50_000.0);
-    if F1 /= -2500.00 then
-       Report.Failed ("6 - expected -2500.0  got " & Franklins'Image (F1));
-    end if;
- 
-    -- division where one operand is universal real
- 
-    P1 := P(0.05) / 0.001;
-    if P1 /= 50.00 then
-       Report.Failed ("7 - expected 50.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := D(1000.0) / 3.0;
-    if D1 /= 333.00 then
-       Report.Failed ("8 - expected 333.00  got " & Dollars'Image (D1));
-    end if;
- 
-    F1 := P(1234.56) / 0.0001;
-    if F1 /= 12345600.00 then
-       Report.Failed ("9 - expected 12345600.0  got " & Franklins'Image (F1));
-    end if;
- 
- 
-    -- division where both operands are decimal fixed
- 
-    P1 := P(0.05) / D(1.0);
-    if P1 /= 0.05 then
-       Report.Failed ("10 - expected 0.05  got " & Pennies'Image (P1));
-    end if;
- 
-        -- check for truncation toward 0
-    D1 := P(-101.00) / P(2.0);
-    if D1 /= -50.00 then
-       Report.Failed ("11 - expected -50.00  got " & Dollars'Image (D1));
-    end if;
- 
-    P1 := P(-102.03) / P(-0.5);
-    if P1 /= 204.06 then
-       Report.Failed ("12 - expected 204.06  got " & Pennies'Image (P1));
-    end if;
- 
-    F1 := P(876.54) / P(0.03);
-    if F1 /= 29200.00 then
-       Report.Failed ("13 - expected 29200.0  got " & Franklins'Image (F1));
-    end if;
- 
- end Generic_Check;
- 
- 
- procedure Check_G6 is
-    Num_Digits : constant := 6;
-    type Pennies is delta 0.01 digits Num_Digits;
-    type Franklins is delta 100.0 digits Num_Digits;
-    type Dollars is delta 1.0 digits Num_Digits;
- 
-    procedure G is new Generic_Check (Pennies, Dollars, Franklins);
- begin
-    G;
- end Check_G6;
- 
- 
- procedure Check_G9 is
-    Num_Digits : constant := 9;
-    type Pennies is delta 0.01 digits Num_Digits;
-    type Franklins is delta 100.0 digits Num_Digits;
-    type Dollars is delta 1.0 digits Num_Digits;
- 
-    procedure G is new Generic_Check (Pennies, Dollars, Franklins);
- begin
-    G;
- end Check_G9;
- 
- 
- begin  -- main
-    Report.Test ("CXG2023",
-                 "Check the accuracy of multiplication and division" &
-                 " of decimal fixed point numbers"); 
- 
-    if Verbose then
-       Report.Comment ("starting Check_1");
-    end if;
-    Check_1;
- 
-    if Verbose then
-       Report.Comment ("starting Check_G6");
-    end if;
-    Check_G6;
- 
-    if Verbose then
-       Report.Comment ("starting Check_G9");
-    end if;
-    Check_G9;
- 
-    Report.Result;
- end CXG2023;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a	Thu Jan  1 00:00:00 1970
***************
*** 1,191 ****
- -- CXG2024.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that multiplication and division of decimal 
- --      and binary fixed point numbers that result in a
- --      decimal fixed point type produce acceptable results.
- --
- -- TEST DESCRIPTION:
- --      Multiplication and division of mixed binary and decimal
- --      values are performed.  Identity functions are used so 
- --      that the operands of the expressions will not be seen
- --      as static by the compiler.
- --
- -- SPECIAL REQUIREMENTS
- --      The Strict Mode for the numerical accuracy must be
- --      selected.  The method by which this mode is selected
- --      is implementation dependent.
- --
- -- APPLICABILITY CRITERIA:
- --      This test applies only to implementations supporting the
- --      Numerics Annex.
- --      This test only applies to the Strict Mode for numerical
- --      accuracy.
- --      This test applies only to implementations supporting
- --      decimal fixed point types of at least 9 digits.
- --
- --
- -- CHANGE HISTORY:
- --       4 Apr 96   SAIC    Initial release for 2.1
- --      17 Aug 96   SAIC    Removed checks for close results
- --
- --!
- 
- with System;
- with Report;
- procedure CXG2024 is
- 
- procedure Do_Check is
-    Num_Digits : constant := 9;
-    type Pennies is delta 0.01 digits Num_Digits;
-    type Dollars is delta 1.0 digits Num_Digits;
- 
-    type Signed_Sixteenths is delta 0.0625 
-           range -2.0 ** (System.Max_Mantissa-5) ..
-                  2.0 ** (System.Max_Mantissa-5) - 1.0;
-    type Unsigned_Sixteenths is delta 0.0625 
-           range 0.0 .. 2.0 ** (System.Max_Mantissa-4) - 1.0;
- 
-    P1 : Pennies;
-    D1 : Dollars;
- 
-    -- optimization thwarting functions
- 
-    function P (X : Pennies) return Pennies is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 3.21;    -- never executed
-       end if;
-    end P;
- 
- 
-    function D (X : Dollars) return Dollars is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 321.0;    -- never executed
-       end if;
-    end D;
- 
- 
-    function US (X : Unsigned_Sixteenths) return Unsigned_Sixteenths is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 321.0;    -- never executed
-       end if;
-    end US;
- 
- 
-    function SS (X : Signed_Sixteenths) return Signed_Sixteenths is
-    begin
-       if Report.Ident_Bool (True) then
-           return X;
-       else
-           return 321.0;    -- never executed
-       end if;
-    end SS;
- 
- 
- begin
- 
-    P1 := P(0.05) * SS(-200.0);
-    if P1 /= -10.00 then
-          Report.Failed ("1 - expected -10.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := P(0.05) * SS(-100.0);
-    if D1 /= -5.00 then
-          Report.Failed ("2 - expected -5.00  got " & Dollars'Image (D1));
-    end if;
- 
-    P1 := P(0.05) * US(200.0);
-    if P1 /= 10.00 then
-          Report.Failed ("3 - expected 10.00  got " & Pennies'Image (P1));
-    end if;
- 
-    D1 := P(-0.05) * US(100.0);
-    if D1 /= -5.00 then
-          Report.Failed ("4 - expected -5.00  got " & Dollars'Image (D1));
-    end if;
- 
- 
- 
-    P1 := P(0.05) / US(1.0);
-    if P1 /= 0.05 then
-          Report.Failed ("6 - expected 0.05  got " & Pennies'Image (P1));
-    end if;
- 
-   
-    -- check rounding
- 
-    D1 := Dollars'Round (Pennies (P(-101.00) / US(2.0)));
-    if D1 /= -51.00 then
-          Report.Failed ("11 - expected -51.00  got " & Dollars'Image (D1));
-    end if;
- 
-    D1 := Dollars'Round (Pennies (P(101.00) / US(2.0)));
-    if D1 /= 51.00 then
-          Report.Failed ("12 - expected 51.00  got " & Dollars'Image (D1));
-    end if;
- 
-    D1 := Dollars'Round (Pennies (SS(-101.00) / P(2.0)));
-    if D1 /= -51.00 then
-          Report.Failed ("13 - expected -51.00  got " & Dollars'Image (D1));
-    end if;
- 
-    D1 := Dollars'Round (Pennies (US(101.00) / P(2.0)));
-    if D1 /= 51.00 then
-          Report.Failed ("14 - expected 51.00  got " & Dollars'Image (D1));
-    end if;
- 
- 
- 
-    P1 := P(-102.03) / SS(-0.5);
-    if P1 /= 204.06 then
-          Report.Failed ("15 - expected 204.06  got " & Pennies'Image (P1));
-    end if;
- 
- 
- exception
-    when others =>
-       Report.Failed ("unexpected exception in Do_Check");
- end Do_Check;
- 
- 
- begin  -- main
-    Report.Test ("CXG2024",
-                 "Check the accuracy of multiplication and division" &
-                 " of mixed decimal and binary fixed point numbers"); 
- 
-    Do_Check;
- 
-    Report.Result;
- end CXG2024;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a	Thu Jan  1 00:00:00 1970
***************
*** 1,243 ****
- -- CXH3001.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check pragma Reviewable.
- --     Check that pragma Reviewable is accepted as a configuration pragma.
- --
- -- TEST DESCRIPTION
- --     The test requires that the configuration pragma Reviewable
- --     be processed.  The following package contains a simple "one of each
- --     construct in the language" to check that the configuration pragma has
- --     not disallowed some feature of the language.  This test should generate
- --     no errors.
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Safety and Security Annex.
- --
- -- PASS/FAIL CRITERIA:
- --      This test passes if it correctly compiles, executes, and reports PASS.
- --      It fails if the pragma is rejected.  The effect of the pragma should
- --      be to produce a listing with information, including warnings, as
- --      required in H.3.1. Specific form and contents of this listing are not
- --      required by this test and are not part of the PASS/FAIL criteria.
- --
- -- SPECIAL REQUIREMENTS
- --      The implementation must process a configuration pragma which is not
- --      part of any Compilation Unit; the method employed is implementation
- --      defined.
- --
- --      Pragma Reviewable requires that the implementation provide the
- --      following information for the compilation units in this test:
- --
- --        o Where compiler-generated run-time checks remain (6)
- --
- --        o Identification of any construct with a language-defined check
- --          that is recognized prior to runtime as certain to fail if
- --          executed (7)
- --
- --        o For each reference to a scalar object, an identification of
- --          the reference as either "known to be initialized,"
- --          or "possibly uninitialized" (8)
- --
- --        o Where run-time support routines are implicitly invoked (9)
- --
- --        o An object code listing including: (10)
- --
- --          o Machine instructions with relative offsets (11)
- --
- --          o Where each data object is stored during its lifetime (12)
- --
- --          o Correspondence with the source program (13)
- --
- --        o Identification of each construct for which the implementation
- --          detects the possibility of erroneous execution (14)
- --
- --        o For each subprogram, block, task or other construct implemented by
- --          reserving and subsequently freezing an area of the run-time stack,
- --          an identification of the length of the fixed-size portion of
- --          the area and an indication of whether the non-fixed size portion
- --          is reserved on the stack or in a dynamically managed storage
- --          region (15)
- --
- --
- -- CHANGE HISTORY:
- --      26 OCT 95   SAIC   Initial version
- --      12 NOV 96   SAIC   Revised for 2.1
- --      27 AUG 99   RLB    Removed result dependence on uninitialized object.
- --      30 AUG 99   RLB    Repaired the above.
- --
- --!
- 
- ---------------------------- CONFIGURATION PRAGMAS -----------------------
- 
- pragma Reviewable;                                                -- OK
-                                                 -- configuration pragma
- 
- ------------------------ END OF CONFIGURATION PRAGMAS --------------------
- 
- 
- ----------------------------------------------------------------- CXH3001_0
- 
- package CXH3001_0 is
- 
-   type Enum is (Item,Stuff,Things);
- 
-   type Int is range 0..256;
- 
-   type Unt is mod 256;
- 
-   type Flt is digits 5;
- 
-   type Fix is delta 0.5 range -1.0..1.0;
- 
-   type Root(Disc: Enum) is tagged record
-     I: Int; U:Unt;
-   end record;
- 
-   type List is array(Unt) of Root(Stuff);
- 
-   type A_List is access List;
-   type A_Proc is access procedure(R:Root);
- 
-   procedure P(R:Root);
- 
-   function F return A_Proc;
- 
-   protected PT is
-     entry Set(Switch: Boolean);
-     function Enquire return Boolean;
-   private
-     Toggle : Boolean;
-   end PT;
- 
-   task TT is
-     entry Release;
-   end TT;
- 
-   Global_Variable : Boolean := False;
- 
- end CXH3001_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- with Report;
- package body CXH3001_0 is
- 
-  procedure P(R:Root) is
-     Warnable : Positive := 0; -- (7)                      -- OPTIONAL WARNING
-     -- this would raise Constraint_Error if P were ever called, however
-     -- this test never calls P.
-   begin
-     case R.Disc is
-       when Item   => Report.Comment("Got Item");
-       when Stuff  => Report.Comment("Got Stuff");
-       when Things => Report.Comment("Got Things");
-     end case;
-     if Report.Ident_Int( Warnable ) = 0 then
-       Global_Variable := not Global_Variable; -- (8) known to be initialized
-     end if;
-   end P;
- 
-   function F return A_Proc is
-   begin
-     return P'Access;
-   end F;
- 
-   protected body PT is
- 
-     entry Set(Switch: Boolean) when True is
-     begin
-       Toggle := Switch;
-     end Set;
- 
-     function Enquire return Boolean is
-     begin
-       return Toggle;
-     end Enquire;
- 
-   end PT;
- 
-   task body TT is
-   begin
-     loop
-       accept Release;
-       exit when Global_Variable;
-     end loop;
-   end TT;
- 
-   -- (9) TT activation
- end CXH3001_0;
- 
- ------------------------------------------------------------------- CXH3001
- 
- with Report;
- with CXH3001_0;
- procedure CXH3001 is
- begin
-   Report.Test("CXH3001", "Check pragma Reviewable as a configuration pragma");
- 
-   Block: declare
-     A_Truth : Boolean;
-     Message : String := Report.Ident_Str( "Bad value encountered" );
-   begin
-     begin
-       A_Truth := Report.Ident_Bool( True ) or A_Truth;  -- (8) not initialized
-       if not A_Truth then
-         Report.Comment ("True or Uninit = False");
-         A_Truth := Report.Ident_Bool (True);
-       else
-         A_Truth := Report.Ident_Bool (True);
-           -- We do this separately on each branch in order to insure that a
-           -- clever optimizer can find out little about this value. Ident_Bool
-           -- is supposed to be opaque to any optimizer.
-       end if;
-     exception
-       when Constraint_Error | Program_Error =>
-            -- Possible results of accessing an uninitialized object.
-         A_Truth := Report.Ident_Bool (True);
-     end;
- 
-     CXH3001_0.PT.Set( A_Truth );
- 
-     CXH3001_0.Global_Variable := A_Truth;
- 
-     CXH3001_0.TT.Release;  -- (9) rendezvous with TT
- 
-     while CXH3001_0.TT'Callable loop
-       delay 1.0; -- wait for TT to become non-callable
-     end loop;
- 
-     if   not CXH3001_0.PT.Enquire
-       or not CXH3001_0.Global_Variable
-       or CXH3001_0.TT'Callable then
-       Report.Failed(Message);
-     end if;
- 
-   end Block;
- 
-   Report.Result;
- end CXH3001;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a	Thu Jan  1 00:00:00 1970
***************
*** 1,343 ****
- -- CXH3002.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check that pragma Inspection_Point is allowed whereever a declarative
- --     item or statement is allowed.  Check that pragma Inspection_Point may
- --     have zero or more arguments.  Check that the execution of pragma
- --     Inspection_Point has no effect.
- --
- -- TEST DESCRIPTION
- --     Check pragma Inspection_Point applied to:
- --       A no objects,
- --       B one object,
- --       C multiple objects.
- --     Check pragma Inspection_Point applied to:
- --       D Enumeration type objects,
- --       E Integer type objects (signed and unsigned),
- --       F access type objects,
- --       G Floating Point type objects,
- --       H Fixed point type objects,
- --       I array type objects,
- --       J record type objects,
- --       K tagged type objects,
- --       L protected type objects,
- --       M controlled type objects,
- --       N task type objects.
- --     Check pragma Inspection_Point applied in:
- --       O declarations (package, procedure)
- --       P statements (incl package elaboration)
- --       Q subprogram (procedure, function, finalization)
- --       R package
- --       S specification
- --       T body (PO entry, task body, loop body, accept body, select body)
- --       U task
- --       V protected object
- --
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Safety and Security Annex.
- --
- --
- -- CHANGE HISTORY:
- --      26 OCT 95   SAIC   Initial version
- --      12 NOV 96   SAIC   Revised for 2.1
- --
- --!
- 
- ----------------------------------------------------------------- CXH3002_0
- 
- package CXH3002_0 is
- 
-   type Enum is (Item,Stuff,Things);
- 
-   type Int  is range 0..256;
- 
-   type Unt  is mod 256;
- 
-   type Flt  is digits 5;
- 
-   type Fix  is delta 0.5 range -1.0..1.0;
- 
-   type Root(Disc: Enum) is record
-     I: Int;
-     U: Unt;
-   end record;
- 
-   type List   is array(Unt) of Root(Stuff);
- 
-   type A_List is access all List;
-   type A_Proc is access procedure(R:Root);
- 
-   procedure Proc(R:Root);
-   function  Func return A_Proc;
- 
-   protected type PT is
-     entry Prot_Entry(Switch: Boolean);
-   private
-     Toggle : Boolean := False;
-   end PT;
- 
-   task type TT is
-     entry Task_Entry(Items: in A_List);
-   end TT;
- 
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-   pragma Inspection_Point;                                          -- AORS
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
- 
- end CXH3002_0;
- 
- ----------------------------------------------------------------- CXH3002_1
- 
- with Ada.Finalization;
- package CXH3002_0.CXH3002_1 is
- 
-   type Final is new Ada.Finalization.Controlled with 
-     record
-       Value : Natural;
-     end record;
- 
-   procedure Initialize( F: in out Final );
-   procedure Adjust( F: in out Final );
-   procedure Finalize( F: in out Final );
- 
- end CXH3002_0.CXH3002_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CXH3002_0
- 
- package body CXH3002_0 is
- 
-   Global_Variable : Character := 'A';
- 
-   procedure Proc(R:Root) is
-   begin
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-     pragma Inspection_Point( Global_Variable );                     -- BDPQT
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-     case R.Disc is
-       when Item   => Global_Variable := 'I';
-       when Stuff  => Global_Variable := 'S';
-       when Things => Global_Variable := 'T';
-     end case;
-  end Proc;
- 
-   function Func return A_Proc is
-   begin
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-     pragma Inspection_Point;                                        -- APQT
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-     return Proc'Access;
-   end Func;
- 
-   protected body PT is
-     entry Prot_Entry(Switch: Boolean) when True is
-       begin
-         Toggle := Switch;
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-         pragma Inspection_Point;                                    -- APVT
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-       end Prot_Entry;
-   end PT;
- 
-   task body TT is
-     List_Copy : A_List;
-   begin
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-     pragma Inspection_Point;                                        -- APUT
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-     loop
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-       pragma Inspection_Point;                                      -- APUT
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-       select
-         accept Task_Entry(Items: in A_List) do
-           List_Copy := Items;
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-           pragma Inspection_Point( List_Copy );                     -- BFPUT
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-         end Task_Entry;
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-         pragma Inspection_Point;                                    -- APUT
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-       or terminate;
-       end select;
-     end loop;
-   end TT;
- 
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-   pragma Inspection_Point;                                           -- ARTO
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
- 
- end CXH3002_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CXH3002_1
- 
- with Report;
- package body CXH3002_0.CXH3002_1 is
- 
-   Embedded_Final_Object : Final
-                         := (Ada.Finalization.Controlled with Value => 1);
-                         -- attempt to call Initialize here would P_E!
- 
-   procedure Initialize( F: in out Final ) is
-   begin
-     F.Value := 1;
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-     pragma Inspection_Point( Embedded_Final_Object );                -- BKQP
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-   end Initialize;
- 
-   procedure Adjust( F: in out Final ) is
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-     pragma Inspection_Point;                                          -- AQO
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-   begin
-     F.Value := 2;
-   end Adjust;
- 
-   procedure Finalize( F: in out Final ) is
-   begin
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-     pragma Inspection_Point;                                         -- AQP
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-     if F.Value not in 1..10 then
-       Report.Failed("Bad value in controlled object at finalization");
-     end if;
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-     pragma Inspection_Point;                                         -- AQP
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
-   end Finalize;
- 
- begin
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---======
-   pragma Inspection_Point( Embedded_Final_Object );                  -- BKRTP
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---======
-   null;
- end CXH3002_0.CXH3002_1;
- 
- ------------------------------------------------------------------- CXH3002
- 
- with Report;
- with CXH3002_0.CXH3002_1;
- procedure CXH3002 is
- 
-   use type CXH3002_0.Enum, CXH3002_0.Int, CXH3002_0.Unt, CXH3002_0.Flt,
-            CXH3002_0.Fix,  CXH3002_0.Root;
- 
-   Main_Enum  : CXH3002_0.Enum := CXH3002_0.Item;
-   Main_Int   : CXH3002_0.Int;
-   Main_Unt   : CXH3002_0.Unt;
-   Main_Flt   : CXH3002_0.Flt;
-   Main_Fix   : CXH3002_0.Fix;
-   Main_Rec   : CXH3002_0.Root(CXH3002_0.Stuff) 
-                := (CXH3002_0.Stuff, I => 1, U => 2);
- 
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
-   pragma Inspection_Point( Main_Rec );                               -- BJQO
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
- 
-   Main_List   : CXH3002_0.List := ( others => Main_Rec );
- 
-   Main_A_List : CXH3002_0.A_List := new CXH3002_0.List'( others => Main_Rec );
-   Main_A_Proc : CXH3002_0.A_Proc := CXH3002_0.Func;
-                                  -- CXH3002_0.Proc'Access
-   Main_PT     : CXH3002_0.PT;
-   Main_TT     : CXH3002_0.TT;
- 
-   type Test_Range is (First, Second);
- 
-   procedure Assert( Truth : Boolean; Message : String ) is
-   begin
-     if not Truth then
-       Report.Failed( "Unexpected value found in " & Message );
-     end if;
-   end Assert;
- 
- begin  -- Main test procedure.
- 
-   Report.Test ("CXH3002", "Check pragma Inspection_Point" );
-    
-  Enclosure:declare
-    Main_Final : CXH3002_0.CXH3002_1.Final;
-    Xtra_Final : CXH3002_0.CXH3002_1.Final;
-  begin
-   for Test_Case in Test_Range loop
- 
- 
-     case Test_Case is
-       when First  =>
-         Main_Final.Value := 5;
-         Xtra_Final := Main_Final; -- call Adjust
-         Main_Enum  := CXH3002_0.Things;
-         Main_Int   := CXH3002_0.Int'First;
-         Main_Unt   := CXH3002_0.Unt'Last;
-         Main_Flt   := 3.14;
-         Main_Fix   := 0.5;
-         Main_Rec   := (CXH3002_0.Stuff, I => 3, U => 4);
-         Main_List(Main_Unt) := Main_Rec;
-         Main_A_List(CXH3002_0.Unt'First) := (CXH3002_0.Stuff, I => 5, U => 6);
-         Main_A_Proc( Main_A_List(2) );
-         Main_PT.Prot_Entry(True);
-         Main_TT.Task_Entry( null );
- 
-       when Second =>
-         Assert( Main_Final.Value = 5, "Main_Final" );
-         Assert( Xtra_Final.Value = 2, "Xtra_Final" );
-         Assert( Main_Enum = CXH3002_0.Things, "Main_Enum" );
-         Assert( Main_Int = CXH3002_0.Int'First, "Main_Int" );
-         Assert( Main_Unt = CXH3002_0.Unt'Last, "Main_Unt" );
-         Assert( Main_Flt in 3.0..3.5, "Main_Flt" );
-         Assert( Main_Fix = 0.5, "Main_Fix" );
-         Assert( Main_Rec = (CXH3002_0.Stuff, I => 3, U => 4), "Main_Rec" );
-         Assert( Main_List(Main_Unt) = Main_Rec, "Main_List" );
-         Assert( Main_A_List(CXH3002_0.Unt'First)
-                   = (CXH3002_0.Stuff, I => 5, U => 6), "Main_A_List" );
- 
-    end case; 
- 
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==
-     pragma Inspection_Point(                                       -- CQP
-                       Main_Final,                                    -- M
-                       Main_Enum,                                     -- D
-                       Main_Int,                                      -- E
-                       Main_Unt,                                      -- E
-                       Main_Flt,                                      -- G
-                       Main_Fix,                                      -- H
-                       Main_Rec,                                      -- J
-                       Main_List,                                     -- I
-                       Main_A_List,                                   -- F
-                       Main_A_Proc,                                   -- F
-                       Main_PT,                                       -- L
-                       Main_TT );                                     -- N
-   -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==
- 
-   end loop;
-  end Enclosure;
- 
-   Report.Result;
- 
- end CXH3002;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh30030.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh30030.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh30030.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh30030.a	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- CXH30030.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     See CHX30031.AM
- --
- -- TEST DESCRIPTION
- --     See CHX30031.AM
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --      => CXH30030.A
- --         CXH30031.AM
- --
- -- APPLICABILITY CRITERIA:
- --     See CHX30031.AM
- --
- -- SPECIAL REQUIREMENTS
- --     See CHX30031.AM
- --
- -- CHANGE HISTORY:
- --      26 OCT 95   SAIC   Initial version for 2.1
- --      07 JUN 96   SAIC   Revised by reviewer request, split to multifile
- --
- --!
- 
-   pragma Reviewable;
- 
- -- This test requires that this configuration pragma be applied to all
- -- following compilation units in the environment; specifically the ones
- -- in file CXH30031.AM
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh30031.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh30031.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cxh/cxh30031.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cxh/cxh30031.am	Thu Jan  1 00:00:00 1970
***************
*** 1,215 ****
- -- CXH30031.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE
- --     Check pragma Reviewable.
- --     Check that pragma Reviewable is accepted as a configuration pragma.
- --
- -- TEST DESCRIPTION
- --     This test checks that pragma Reviewable is processed as a
- --     configuration pragma.  See CXH3001 for testing pragma Reviewable as
- --     other than a configuration pragma.
- --
- -- TEST FILES:
- --      The following files comprise this test:
- --
- --         CXH30030.A
- --      => CXH30031.AM
- --
- -- APPLICABILITY CRITERIA:
- --      This test is only applicable for a compiler attempting validation
- --      for the Safety and Security Annex.
- --
- -- SPECIAL REQUIREMENTS
- --      The implementation must process a configuration pragma which is not
- --      part of any Compilation Unit; the method employed is implementation
- --      defined.
- --
- --
- -- CHANGE HISTORY:
- --      26 OCT 95   SAIC   Initial version for 2.1
- --      07 JUN 96   SAIC   Revised by reviewer request
- --      03 NOV 96   SAIC   Documentation revision
- --
- --      03 NOV 96   Keith  Documentation revision
- --      27 AUG 99   RLB    Removed result dependence on uninitialized object.
- --      30 AUG 99   RLB    Repaired the above.
- --
- --!
- 
-   pragma Reviewable;
- 
- ----------------------------------------------------------------- CXH3003_0
- 
- package CXH3003_0 is
- 
-   type Enum is (Item,Stuff,Things);
- 
-   type Int is range 0..256;
- 
-   type Unt is mod 256;
- 
-   type Flt is digits 5;
- 
-   type Fix is delta 0.5 range -1.0..1.0;
- 
-   type Root(Disc: Enum) is tagged record
-     I: Int; U:Unt;
-   end record;
- 
-   type List is array(Unt) of Root(Stuff);
- 
-   type A_List is access List;
-   type A_Proc is access procedure(R:Root);
- 
-   procedure P(R:Root);
- 
-   function F return A_Proc;
- 
-   Global_Variable : Boolean := False;
- 
- end CXH3003_0;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- with Report;
- package body CXH3003_0 is
- 
-  procedure P(R:Root) is
-     Warnable : Positive := 0;                             -- OPTIONAL WARNING
-   begin
-     case R.Disc is
-       when Item   => Report.Comment("Got Item");
-       when Stuff  => Report.Comment("Got Stuff");
-       when Things => Report.Comment("Got Things");
-     end case;
-     if Report.Ident_Int( Warnable ) = 0 then
-       Global_Variable := not Global_Variable;     -- known to be initialized
-     end if;
-   end P;
- 
-   function F return A_Proc is
-   begin
-     return P'Access;
-   end F;
- 
- end CXH3003_0;
- 
- ----------------------------------------------------------------- CXH3003_1
- 
- package CXH3003_0.CXH3003_1 is
- 
-   protected PT is
-     entry Set(Switch: Boolean);
-     function Enquire return Boolean;
-   private
-     Toggle : Boolean;
-   end PT;
- 
-   task TT is
-     entry Release;
-   end TT;
- 
- end CXH3003_0.CXH3003_1;
- 
- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- 
- package body CXH3003_0.CXH3003_1 is
- 
-   protected body PT is
- 
-     entry Set(Switch: Boolean) when True is
-     begin
-       Toggle := Switch;
-     end Set;
- 
-     function Enquire return Boolean is
-     begin
-       return Toggle;
-     end Enquire;
- 
-   end PT;
- 
-   task body TT is
-   begin
-     loop
-       accept Release;
-       exit when Global_Variable;
-     end loop;
-   end TT;
- 
-  -- TT activation
- 
- end CXH3003_0.CXH3003_1;
- 
- ------------------------------------------------------------------- CXH3003
- 
- with Report;
- with CXH3003_0.CXH3003_1;
- procedure CXH30031 is
- begin
- 
-   Report.Test("CXH3003", "Check pragma Reviewable as a configuration pragma");
- 
-   Block: declare
-     A_Truth : Boolean;
-     Message : String := Report.Ident_Str( "Bad value encountered" );
-   begin
-     begin
-       A_Truth := Report.Ident_Bool( True ) or A_Truth;  -- not initialized
-       if not A_Truth then
-         Report.Comment ("True or Uninit = False");
-         A_Truth := Report.Ident_Bool (True);
-       else
-         A_Truth := Report.Ident_Bool (True);
-           -- We do this separately on each branch in order to insure that a
-           -- clever optimizer can find out little about this value. Ident_Bool
-           -- is supposed to be opaque to any optimizer.
-       end if;
-     exception
-       when Constraint_Error | Program_Error =>
-            -- Possible results of accessing an uninitialized object.
-         A_Truth := Report.Ident_Bool (True);
-     end;
- 
-     CXH3003_0.CXH3003_1.PT.Set( A_Truth );
- 
-     CXH3003_0.Global_Variable := A_Truth;
- 
-     CXH3003_0.CXH3003_1.TT.Release;  -- rendezvous with TT
- 
-     while CXH3003_0.CXH3003_1.TT'Callable loop  -- wait for TT to complete
-       delay 1.0;
-     end loop;
- 
-     if   not CXH3003_0.CXH3003_1.PT.Enquire
-       or not CXH3003_0.Global_Variable then
-       Report.Failed(Message);
-     end if;
- 
-   end Block;
- 
-   Report.Result;
- 
- end CXH30031;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cz/cz1101a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cz/cz1101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cz/cz1101a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cz/cz1101a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- CZ1101A.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     CHECK THAT THE REPORT ROUTINES OF THE REPORT PACKAGE WORK
- --     CORRECTLY.
- --
- -- PASS/FAIL CRITERIA:
- --     THIS TEST PASSES IF THE OUTPUT MATCHES THAT SUPPLIED IN THE
- --     APPLICABLE VERSION OF THE ACVC USERS' GUIDE.  THE EXPECTED
- --     TEST RESULT IS "TENTATIVELY PASSED."
- 
- -- HISTORY:
- --     JRK 08/07/81  CREATED ORIGINAL TEST.
- --     JRK 10/27/82
- --     JRK 06/01/84
- --     JET 01/13/88  ADDED TESTS OF SPECIAL_ACTION AND UPDATED HEADER.
- --     PWB 06/24/88  CORRECTED LENGTH OF ONE OUTPUT STRING AND ADDED
- --                   PASS/FAIL CRITERIA.
- --     BCB 05/17/90  CORRECTED LENGTH OF 'MAX_LEN LONG' OUTPUT STRING.
- --                   ADDED CODE TO CREATE REPFILE.
- --     LDC 05/17/90  REMOVED DIRECT_IO REFERENCES.
- --     PWN 12/03/94  REMOVED ADA 9X INCOMPATIBILITIES.
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CZ1101A IS
- 
- 
-      DATE_AND_TIME : STRING(1..17);
- 
-      DATE, TIME : STRING(1..7);
- 
- BEGIN
- 
-      COMMENT ("(CZ1101A) CHECK REPORT ROUTINES");
-      COMMENT ("   INITIAL VALUES SHOULD BE 'NO_NAME' AND 'FAILED'");
-      RESULT;
- 
-      TEST ("PASS_TEST", "CHECKING 'TEST' AND 'RESULT' FOR 'PASSED'");
-      COMMENT ("THIS LINE IS EXACTLY 'MAX_LEN' LONG. " &
-               "...5...60....5...70");
-      COMMENT ("THIS COMMENT HAS A WORD THAT SPANS THE FOLD " &
-               "POINT. THIS COMMENT FITS EXACTLY ON TWO LINES. " &
-               "..5...60....5...70");
-      COMMENT ("THIS_COMMENT_IS_ONE_VERY_LONG_WORD_AND_SO_" &
-               "IT_SHOULD_BE_SPLIT_AT_THE_FOLD_POINT");
-      RESULT;
- 
-      COMMENT ("CHECK THAT 'RESULT' RESETS VALUES TO 'NO_NAME' " &
-               "AND 'FAILED'");
-      RESULT;
- 
-      TEST ("FAIL_TEST", "CHECKING 'FAILED' AND 'RESULT' FOR 'FAILED'");
-      FAILED ("'RESULT' SHOULD NOW BE 'FAILED'");
-      RESULT;
- 
-      TEST ("NA_TEST", "CHECKING 'NOT-APPLICABLE'");
-      NOT_APPLICABLE ("'RESULT' SHOULD NOW BE 'NOT-APPLICABLE'");
-      RESULT;
- 
-      TEST ("FAIL_NA_TEST", "CHECKING 'NOT_APPLICABLE', 'FAILED', " &
-                            "'NOT_APPLICABLE'");
-      NOT_APPLICABLE ("'RESULT' BECOMES 'NOT-APPLICABLE'");
-      FAILED ("'RESULT' BECOMES 'FAILED'");
-      NOT_APPLICABLE ("CALLING 'NOT_APPLICABLE' DOESN'T CHANGE " &
-                      "'RESULT'");
-      RESULT;
- 
-      TEST ("SPEC_NA_TEST", "CHECKING 'SPEC_ACT', 'NOT_APPLICABLE', " &
-                            "'SPEC_ACT'");
-      SPECIAL_ACTION("'RESULT' BECOMES 'TENTATIVELY PASSED'");
-      NOT_APPLICABLE ("'RESULT' BECOMES 'NOT APPLICABLE'");
-      SPECIAL_ACTION("CALLING 'SPECIAL_ACTION' DOESN'T CHANGE 'RESULT'");
-      RESULT;
- 
-      TEST ("SPEC_FAIL_TEST", "CHECKING 'SPEC_ACT', 'FAILED', " &
-                              "'SPEC_ACT'");
-      SPECIAL_ACTION("'RESULT' BECOMES 'TENTATIVELY PASSED'");
-      FAILED ("'RESULT' BECOMES 'FAILED'");
-      SPECIAL_ACTION("CALLING 'SPECIAL_ACTION' DOESN'T CHANGE 'RESULT'");
-      RESULT;
- 
-      TEST ("CZ1101A", "CHECKING 'SPECIAL_ACTION' ALONE");
-      SPECIAL_ACTION("'RESULT' BECOMES 'TENTATIVELY PASSED'");
-      RESULT;
- 
- END CZ1101A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cz/cz1102a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cz/cz1102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cz/cz1102a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cz/cz1102a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- CZ1102A.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- CHECK THAT THE DYNAMIC VALUE ROUTINES OF THE REPORT PACKAGE WORK
- --   CORRECTLY.
- 
- -- JRK 8/7/81
- -- JRK 10/27/82
- -- RLB 03/20/00 - Added checks for Integer'First and Integer'Last.
- 
- WITH REPORT;
- USE REPORT;
- 
- PROCEDURE CZ1102A IS
- 
- BEGIN
- 
-      TEST ("CZ1102A", "CHECK THAT THE DYNAMIC VALUE ROUTINES OF " &
-                          "THE REPORT PACKAGE WORK CORRECTLY");
- 
-      IF NOT EQUAL (0, 0) OR
-         EQUAL (0, 1) OR
-         NOT EQUAL (1, 1) OR
-         NOT EQUAL (3, 3) OR
-         NOT EQUAL (4, 4) OR
-         NOT EQUAL (-1, -1) OR
-         NOT EQUAL (INTEGER'FIRST, INTEGER'FIRST) OR
-         NOT EQUAL (INTEGER'LAST, INTEGER'LAST) OR
-         EQUAL (-1, 0) THEN
-           FAILED ("'EQUAL' NOT WORKING");
-      END IF;
- 
-      IF IDENT_INT (5) /= 5 THEN
-           FAILED ("'IDENT_INT' NOT WORKING");
-      END IF;
- 
-      IF IDENT_CHAR ('E') /= 'E' THEN
-           FAILED ("'IDENT_CHAR' NOT WORKING");
-      END IF;
- 
-      IF IDENT_BOOL (TRUE) /= TRUE THEN
-           FAILED ("'IDENT_BOOL' NOT WORKING");
-      END IF;
- 
-      IF IDENT_STR ("") /= "" OR
-         IDENT_STR ("K") /= "K" OR
-         IDENT_STR ("PQRS") /= "PQRS" THEN
-           FAILED ("'IDENT_STR' NOT WORKING");
-      END IF;
- 
-      RESULT;
- 
- END CZ1102A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/cz/cz1103a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/cz/cz1103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/cz/cz1103a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/cz/cz1103a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,232 ****
- -- CZ1103A.ADA
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
- --     this public release, the Government intends to confer upon all
- --     recipients unlimited rights  equal to those held by the Government.
- --     These rights include rights to use, duplicate, release or disclose the
- --     released technical data and computer software in whole or in part, in
- --     any manner and for any purpose whatsoever, and to have or permit others
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     CHECK THAT THE PROCEDURE CHECK_FILE WORKS CORRECTLY, IN
- --     PARTICULAR, THAT IT WILL REPORT INCORRECT FILE CONTENTS
- --     AS TEST FAILURES.
- 
- --     THIS TEST INTENTIONALLY CONTAINS MISMATCHES BETWEEN FILE
- --     CONTENTS AND THE 'CONTENTS' STRING PARAMETER OF PROCEDURE
- --     CHECK_FILE.
- 
- -- PASS/FAIL CRITERIA:
- --     IF AN IMPLEMENTATION SUPPORTS EXTERNAL FILES, IT PASSES THIS TEST
- --     IF TEST EXECUTION REPORTS THE FOLLOWING FOUR FAILURES, REPORTS AN
- --     INTERMEDIATE "FAILED" RESULT, REPORTS A FINAL "TENTATIVELY PASSED"
- --     RESULT, AND REPORTS NO OTHER FAILURES.
- --        * CZ1103A FROM CHECK_FILE: END OF LINE EXPECTED - E
- --                     ENCOUNTERED.
- --        * CZ1103A FROM CHECK_FILE: END_OF_PAGE NOT WHERE EXPECTED.
- --        * CZ1103A FROM CHECK_FILE: END_OF_FILE NOT WHERE EXPECTED.
- --        * CZ1103A FROM CHECK_FILE: FILE DOES NOT CONTAIN CORRECT
- --                      OUTPUT - EXPECTED C - GOT I.
- --
- --     IF AN IMPLEMENTATION DOES NOT SUPPORT EXTERNAL FILES, IT PASSES THIS
- --     TEST IF TEST EXECUTION REPORTS NINE FAILURES FOR INCOMPLETE SUBTESTS
- --     SIMILAR TO THE SAMPLE BELOW, REPORTS AN INTERMEDIATE "FAILED" RESULT,
- --     REPORTS A FINAL "TENTATIVELY PASSED" RESULT, AND REPORTS NO OTHER
- --     FAILURES.
- --        * CZ1103A TEST WITH EMPTY FILE INCOMPLETE.
- 
- -- HISTORY:
- --     SPS 12/09/82  CREATED ORIGINAL TEST.
- --     JRK 11/18/85  ADDED COMMENTS ABOUT PASS/FAIL CRITERIA.
- --     JET 01/13/88  UPDATED HEADER FORMAT, ADDED FINAL CALL TO
- --                   SPECIAL_ACTION.
- --     PWB 06/24/88  CORRECTED PASS/FAIL CRITERIA TO INDICATE THE
- --                   EXPECTED RESULT (TENTATIVELY PASSED).
- --     RLB 03/20/00  CORRECTED PASS/FAIL CRITERIA TO REFLECT PROPER RESULT
- --                   FOR AN IMPLEMENTATION THAT DOES NOT SUPPORT EXTERNAL FILES.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE CZ1103A IS
- 
-      NULL_FILE : FILE_TYPE;
-      FILE_WITH_BLANK_LINES : FILE_TYPE;
-      FILE_WITH_BLANK_PAGES : FILE_TYPE;
-      FILE_WITH_TRAILING_BLANKS : FILE_TYPE;
-      FILE_WITHOUT_TRAILING_BLANKS : FILE_TYPE;
-      FILE_WITH_END_OF_LINE_ERROR : FILE_TYPE;
-      FILE_WITH_END_OF_PAGE_ERROR : FILE_TYPE;
-      FILE_WITH_END_OF_FILE_ERROR : FILE_TYPE;
-      FILE_WITH_DATA_ERROR : FILE_TYPE;
- 
- BEGIN
- 
-      TEST ("CZ1103A", "CHECK THAT PROCEDURE CHECK_FILE WORKS");
- 
- -- THIS SECTION TESTS CHECK_FILE WITH AN EMPTY FILE.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH AN EMPTY FILE");
-           CREATE (NULL_FILE, OUT_FILE);
-           CHECK_FILE (NULL_FILE, "#@%");
-           CLOSE (NULL_FILE);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH EMPTY FILE INCOMPLETE");
- 
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH BLANK LINES.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH A FILE WITH BLANK LINES");
-           CREATE (FILE_WITH_BLANK_LINES, OUT_FILE);
-           NEW_LINE (FILE_WITH_BLANK_LINES, 20);
-           CHECK_FILE (FILE_WITH_BLANK_LINES, "####################@%");
-           CLOSE (FILE_WITH_BLANK_LINES);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH FILE WITH BLANK LINES INCOMPLETE");
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH BLANK LINES AND PAGES.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH A FILE WITH BLANK LINES " &
-                    "AND PAGES");
-           CREATE (FILE_WITH_BLANK_PAGES, OUT_FILE);
-           NEW_LINE (FILE_WITH_BLANK_PAGES, 3);
-           NEW_PAGE (FILE_WITH_BLANK_PAGES);
-           NEW_LINE (FILE_WITH_BLANK_PAGES, 2);
-           NEW_PAGE (FILE_WITH_BLANK_PAGES);
-           NEW_PAGE (FILE_WITH_BLANK_PAGES);
-           CHECK_FILE (FILE_WITH_BLANK_PAGES, "###@##@#@%");
-           CLOSE (FILE_WITH_BLANK_PAGES);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH FILE WITH BLANK PAGES INCOMPLETE");
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH TRAILING BLANKS.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH A FILE WITH TRAILING BLANKS");
-           CREATE (FILE_WITH_TRAILING_BLANKS, OUT_FILE);
-           FOR I IN 1 .. 3 LOOP
-                PUT_LINE (FILE_WITH_TRAILING_BLANKS,
-                          "LINE WITH TRAILING BLANKS    ");
-           END LOOP;
-           CHECK_FILE(FILE_WITH_TRAILING_BLANKS, "LINE WITH TRAILING" &
-                     " BLANKS#LINE WITH TRAILING BLANKS#LINE" &
-                     " WITH TRAILING BLANKS#@%");
-           CLOSE (FILE_WITH_TRAILING_BLANKS);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH FILE WITH TRAILING BLANKS " &
-                        "INCOMPLETE");
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITHOUT TRAILING BLANKS.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH A FILE WITHOUT TRAILING BLANKS");
-           CREATE (FILE_WITHOUT_TRAILING_BLANKS, OUT_FILE);
-           FOR I IN 1 .. 3 LOOP
-                PUT_LINE (FILE_WITHOUT_TRAILING_BLANKS,
-                          "LINE WITHOUT TRAILING BLANKS");
-           END LOOP;
-           CHECK_FILE(FILE_WITHOUT_TRAILING_BLANKS, "LINE WITHOUT " &
-                     "TRAILING BLANKS#LINE WITHOUT TRAILING BLANKS#" &
-                     "LINE WITHOUT TRAILING BLANKS#@%");
-           CLOSE (FILE_WITHOUT_TRAILING_BLANKS);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH FILE WITHOUT TRAILING BLANKS " &
-                        "INCOMPLETE");
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH AN END OF LINE ERROR.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH A FILE WITH AN END OF LINE ERROR");
-           CREATE (FILE_WITH_END_OF_LINE_ERROR, OUT_FILE);
-           PUT_LINE (FILE_WITH_END_OF_LINE_ERROR, "THIS LINE WILL " &
-                     "CONTAIN AN END OF LINE IN THE WRONG PLACE");
-           CHECK_FILE (FILE_WITH_END_OF_LINE_ERROR, "THIS LINE WILL " &
-                "CONTAIN AN # IN THE WRONG PLACE#@%");
-           CLOSE (FILE_WITH_END_OF_LINE_ERROR);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH END_OF_LINE ERROR INCOMPLETE");
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH AN END OF PAGE ERROR.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH FILE WITH END OF PAGE ERROR");
-           CREATE (FILE_WITH_END_OF_PAGE_ERROR, OUT_FILE);
-           PUT_LINE (FILE_WITH_END_OF_PAGE_ERROR, "THIS LINE WILL " &
-                     "CONTAIN AN END OF PAGE IN THE WRONG PLACE");
-           CHECK_FILE (FILE_WITH_END_OF_PAGE_ERROR, "THIS LINE WILL " &
-                "CONTAIN AN @ IN THE WRONG PLACE#@%");
-           CLOSE (FILE_WITH_END_OF_PAGE_ERROR);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH END_OF_PAGE ERROR INCOMPLETE");
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH AN END OF FILE ERROR.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH FILE WITH END OF FILE ERROR");
-           CREATE (FILE_WITH_END_OF_FILE_ERROR, OUT_FILE);
-           PUT_LINE (FILE_WITH_END_OF_FILE_ERROR, "THIS LINE WILL " &
-                     "CONTAIN AN END OF FILE IN THE WRONG PLACE");
-           CHECK_FILE (FILE_WITH_END_OF_FILE_ERROR, "THIS LINE WILL " &
-                "CONTAIN AN % IN THE WRONG PLACE#@%");
-           CLOSE (FILE_WITH_END_OF_FILE_ERROR);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH END_OF_FILE ERROR INCOMPLETE");
-      END;
- 
- -- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH INCORRECT DATA.
- 
-      BEGIN
-           COMMENT ("BEGIN TEST WITH FILE WITH INCORRECT DATA");
-           CREATE (FILE_WITH_DATA_ERROR, OUT_FILE);
-           PUT_LINE (FILE_WITH_DATA_ERROR, "LINE WITH INCORRECT " &
-                     "DATA");
-           CHECK_FILE (FILE_WITH_DATA_ERROR, "LINE WITH CORRECT " &
-                       "DATA#@%");
-           CLOSE (FILE_WITH_DATA_ERROR);
-      EXCEPTION
-           WHEN OTHERS =>
-                FAILED ("TEST WITH INCORRECT DATA INCOMPLETE");
-      END;
- 
-      RESULT;
- 
-      TEST ("CZ1103A", "THE LINE ABOVE SHOULD REPORT FAILURE");
-      SPECIAL_ACTION ("COMPARE THIS OUTPUT TO THE EXPECTED RESULT");
-      RESULT;
- 
- END CZ1103A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a002a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a002a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a002a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- D4A002A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- LARGE LITERALS IN NUMBER DECLARATIONS, BUT WITH RESULTING
- -- SMALLER VALUE OBTAINED BY SUBTRACTION. THIS TEST LIMITS VALUES
- -- TO 32 BINARY PLACES.
- 
- -- BAW 29 SEPT 80
- -- JBG 12/6/84
- 
- WITH REPORT;
- PROCEDURE D4A002A IS
- 
-      USE REPORT;
- 
-      X : CONSTANT := 1_034_567_890 - 1_034_567_891;
-      Y : CONSTANT := 107 * (10 ** 7) - 1_069_999_999;
-      Z : CONSTANT := (1024 ** 3) - (2 ** 30);
-      D : CONSTANT := 1_073_741_823 / 32_769;
-      E : CONSTANT := 536_870_912 REM 2_304_167;
-      F : CONSTANT := (-134_217_728) MOD (-262_657);
- 
- BEGIN TEST("D4A002A","LARGE INTEGER RANGE (WITH CANCELLATION) IN " &
-            "NUMBER DECLARATIONS; LONGEST INTEGER IS 32 BITS");
- 
-       IF X /= -1 OR Y /= 1 OR Z /= 0 OR D /= 32_767 OR E /= 1 OR F /= -1
-       THEN FAILED("EXPRESSIONS WITH A LARGE INTEGER RANGE (WITH " &
-                   "CANCELLATION) ARE NOT EXACT ");
-       END IF;
- 
-       RESULT;
- 
- END D4A002A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a002b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- D4A002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- LARGER LITERALS IN NUMBER DECLARATIONS, BUT WITH RESULTING
- -- SMALLER VALUE OBTAINED BY SUBTRACTION. THIS TEST LIMITS VALUES
- -- TO 64 BINARY PLACES.
- 
- -- BAW 29 SEPT 80
- -- JBG 05/02/85     RENAMED TO -B.  REVISED SO THAT ALL RESULTS FIT IN
- --                  16 BITS.
- 
- WITH REPORT;
- PROCEDURE D4A002B IS
- 
-      USE REPORT;
- 
-      X : CONSTANT := 4123456789012345678 - 4123456789012345679;
-      Y : CONSTANT := 4 * (10 ** 18) - 3999999999999999999;
-      Z : CONSTANT := (1024 ** 6) - (2 ** 60);
-      D : CONSTANT := 9_223_372_036_854_775_807 / 994_862_694_084_217;
-      E : CONSTANT := 36_028_790_976_242_271 REM 17_600_175_361;
-      F : CONSTANT := ( - 2 ** 51 ) MOD ( - 131_071 );
- 
- BEGIN TEST("D4A002B","LARGE INTEGER RANGE (WITH CANCELLATION) IN " &
-            "NUMBER DECLARATIONS; LONGEST INTEGER IS 64 BITS ");
- 
-       IF X /= -1 OR Y /= 1 OR Z /= 0
-          OR D /= 9271 OR E /= 1 OR F /= -1
-       THEN FAILED("EXPRESSIONS WITH A LARGE INTEGER RANGE (WITH " &
-                   "CANCELLATION) ARE NOT EXACT ");
-       END IF;
- 
-       RESULT;
- 
- END D4A002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a004a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a004a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a004a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- D4A004A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- 32 BIT INTEGERS IN NUMBER DECLARATIONS. UNLIKE TEST D4A002A,
- -- NO CANCELLATION IS INVOLVED.
- 
- -- A COMPILER MAY REFUSE TO COMPILE THIS TEST BECAUSE THE NUMBERS
- -- INVOLVED ARE TOO BIG.
- 
- -- BAW 29 SEPT 80
- -- JBG 12/6/84
- 
- WITH REPORT;
- PROCEDURE D4A004A IS
- 
-      USE REPORT;
- 
-      X : CONSTANT := 511_111_111 + 501_111_111;
-      Y : CONSTANT := -599_999_999 - 411_111_112;
-      Z : CONSTANT := 10 * (10 ** 8);
-      D : CONSTANT := 2 ** 30 / 1;
-      E : CONSTANT := ( 2 ** 29 - 1) REM 233;
-      F : CONSTANT := ABS(( - 2 ** 27 + 1) MOD 511);
- 
- BEGIN TEST("D4A004A","LARGE INTEGER VALUES IN NUMBER DECLARATIONS; " &
-            "LONGEST INTEGER IS 32 BITS ");
- 
-       IF X /= 1_012_222_222 OR Y /= -1_011_111_111
-       THEN FAILED("ADDITION OR SUBTRACTION NOT EXACT");
-       END IF;
- 
-       IF Z /= 1_000_000_000  OR D /= 1_073_741_824 OR E /= 0 OR F /= 0
-       THEN FAILED("INTEGER ** IS NOT EXACT");
-       END IF;
- 
-       RESULT;
- 
- END D4A004A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a004b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/d/d4a004b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/d/d4a004b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- D4A004B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- INTEGERS TO 64 BITS IN NUMBER DECLARATIONS. UNLIKE TEST C4A002B,
- -- NO CANCELLATION IS INVOLVED.
- 
- -- BAW 29 SEPT 80
- -- JWC 7/8/85   RENAMED TO -AB
- 
- WITH REPORT;
- PROCEDURE D4A004B IS
- 
-      USE REPORT;
- 
-      X : CONSTANT := 2200000000000000000 + 2199999999999999999;
-      Y : CONSTANT := -2200000000000000001 - 2199999999999999998;
-      Z : CONSTANT := 4 * (10 ** 18);
-      D : CONSTANT := 2 ** 63 / 1;
-      E : CONSTANT := ( 2 ** 63 - 1 ) REM 454_279;
-      F : CONSTANT := ABS(( -2 ** 55 + 1 ) MOD 2047 );
- 
- BEGIN TEST("D4A004B","LARGE INTEGER VALUES IN NUMBER DECLARATIONS; " &
-            "LONGEST INTEGER IS 64 BITS ");
- 
-       IF X /= 4399999999999999999 THEN
-           FAILED ("ERROR X");
-       END IF;
- 
-       IF Y /= -4399999999999999999 THEN
-           FAILED ("ERROR Y");
-       END IF;
- 
-       IF Z /= 4000000000000000000 THEN
-           FAILED ("ERROR Z");
-       END IF;
- 
-       IF E /= 0 THEN
-           FAILED ("ERROR E");
-       END IF;
- 
-       IF F /= 0 THEN
-           FAILED ("ERROR F");
-       END IF;
- 
-       IF D /= 9_223_372_036_854_775_808 THEN
-           FAILED ("ERROR D");
-       END IF;
- 
-       RESULT;
- 
- END D4A004B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/e28002b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/e28002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/e28002b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/e28002b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,111 ****
- -- E28002B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT A PREDEFINED OR AN UNRECOGNIZED PRAGMA MAY HAVE
- --     ARGUMENTS INVOLVING OVERLOADED IDENTIFIERS WITHOUT ENOUGH
- --     CONTEXTUAL INFORMATION TO RESOLVE THE OVERLOADING.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST IS PASSED IF IT REPORTS "TENTATIVELY PASSED" AND
- --     THE STARRED COMMENT DOES NOT APPEAR IN THE LISTING.
- 
- --     AN IMPLEMENTATION FAILS THIS TEST IF THE STARRED COMMENT
- --     LINE APPEARS IN THE COMPILATION LISTING.
- 
- -- HISTORY:
- --     TBN 02/24/86  CREATED ORIGINAL TEST.
- --     JET 01/13/88  ADDED CALLS TO SPECIAL_ACTION AND UPDATED HEADER.
- --     EDS 10/28/97  ADDED DECLARATIONS FOR PROCEDURES XYZ.
- 
- WITH REPORT, SYSTEM; USE REPORT, SYSTEM;
- PROCEDURE E28002B IS
- 
-      FUNCTION OFF RETURN INTEGER IS
-      BEGIN
-           RETURN 1;
-      END OFF;
- 
-      FUNCTION OFF RETURN BOOLEAN IS
-      BEGIN
-           RETURN TRUE;
-      END OFF;
- 
-      PRAGMA LIST (OFF);
- --***** THIS LINE MUST NOT APPEAR IN COMPILATION LISTING.
-      PRAGMA LIST (ON);
- 
-      FUNCTION ELABORATION_CHECK RETURN INTEGER IS
-      BEGIN
-           RETURN 1;
-      END ELABORATION_CHECK;
- 
-      FUNCTION ELABORATION_CHECK RETURN BOOLEAN IS
-      BEGIN
-           RETURN TRUE;
-      END ELABORATION_CHECK;
- 
-      PRAGMA SUPPRESS (ELABORATION_CHECK, ELABORATION_CHECK);
- 
-      FUNCTION TIME RETURN INTEGER IS
-      BEGIN
-           RETURN 1;
-      END TIME;
- 
-      FUNCTION TIME RETURN BOOLEAN IS
-      BEGIN
-           RETURN TRUE;
-      END TIME;
- 
-      PRAGMA OPTIMIZE (TIME);
- 
-      PROCEDURE XYZ;
-      PROCEDURE XYZ (COUNT : INTEGER);
- 
-      PRAGMA INLINE (XYZ);
-      PRAGMA PHIL_BRASHEAR (XYZ);
- 
-      PROCEDURE XYZ IS
-      BEGIN
-           NULL;
-      END XYZ;
- 
-      PROCEDURE XYZ (COUNT : INTEGER) IS
-      BEGIN
-           NULL;
-      END XYZ;
- 
- BEGIN
-      TEST ("E28002B", "CHECK THAT A PREDEFINED OR AN UNRECOGNIZED " &
-                       "PRAGMA MAY HAVE ARGUMENTS INVOLVING " &
-                       "OVERLOADED IDENTIFIERS WITHOUT ENOUGH " &
-                       "CONTEXTUAL INFORMATION TO RESOLVE THE " &
-                       "OVERLOADING");
- 
-      SPECIAL_ACTION ("CHECK THAT THE COMPILATION LISTING DOES NOT " &
-                      "SHOW THE STARRED COMMENT LINE");
- 
-      RESULT;
- 
- END E28002B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/e28005d.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/e28005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/e28005d.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/e28005d.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- PRAGMA PAGE;
- -- E28005D.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN PRAGMA PAGE IS USED AT THE BEGINNING OR END OF A
- --     COMPILATION, THERE IS NO PROBLEM.
- 
- -- PASS/FAIL CRITERIA:
- --     THE TEST MUST COMPILE TO EXECUTE WITH A 'TENTATIVELY PASSED'
- --     RESULT.  THERE IS A PAGE BREAK BEFORE THE TEST NAME AND A
- --     PAGE BREAK AFTER THE END OF THE TEST.
- 
- -- HISTORY:
- --     RJW 04/16/86  CREATED ORIGINAL TEST.
- --     JET 01/13/88  ADDED CALLS TO SPECIAL_ACTION AND UPDATED HEADER.
- 
- WITH REPORT; USE REPORT;
- 
- PROCEDURE E28005D IS
- BEGIN
-      TEST ( "E28005D", "CHECK THAT WHEN PRAGMA PAGE IS USED AT THE " &
-                        "BEGINNING OR END OF A COMPILATION, THERE " &
-                        "IS NO PROBLEM");
- 
-      SPECIAL_ACTION ("CHECK THAT THE PAGE PRAGMAS AT THE BEGINNING " &
-                      "AND END OF THE PROGRAM CAUSE THE TEXT " &
-                      "FOLLOWING THE PRAGMAS TO APPEAR AT THE START " &
-                      "OF A NEW PAGE OF THE COMPILATION LISTING");
-      RESULT;
- 
- END E28005D;
- 
- PRAGMA PAGE;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/e52103y.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/e52103y.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/e52103y.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/e52103y.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,132 ****
- -- E52103Y.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- CHECK WHETHER A NULL ARRAY WITH ONE DIMENSION OF LENGTH GREATER THAN
- -- INTEGER'LAST RAISES CONSTRAINT_ERROR OR NO EXCEPTION,
- -- EITHER WHEN DECLARED OR  ASSIGNED.
- 
- -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
- --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
- --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
- --    ARE PERFORMED CORRECTLY.
- --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
- --    ARE TREATED ELSEWHERE.)
- 
- 
- -- THIS IS A SPECIAL CASE IN
- 
- --    DIVISION  D :  NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
- --                   STATICALLY
- 
- -- WHICH (THE SPECIAL CASE) TREATS TWO-DIMENSIONAL ARRAYS WHOSE LENGTH
- --    ALONG ONE DIMENSION IS GREATER THAN  INTEGER'LAST  AND WHOSE
- --    LENGTH ALONG THE OTHER DIMENSION IS  0 .
- 
- 
- -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
- -- ***       remove incompatibilities associated with the transition   -- 9X
- -- ***       to Ada 9X.                                                -- 9X
- -- ***                                                                 -- 9X
- 
- -- RM  07/31/81
- -- SPS 03/22/83
- -- JBG 05/02/83
- -- JBG 06/01/85
- -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
- --               AI-00387.
- -- LDC 06/01/88  CHANGED HEADER COMMENT TO INDICATE CONSTRAINT_ERROR
- --               IS ALLOWED.  ADDED CODE TO PREVENT DEAD VARIABLE
- --               OPTIMIZATION.
- -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
- 
- WITH REPORT;
- PROCEDURE  E52103Y  IS
- 
-      USE  REPORT ;
- 
- BEGIN
- 
-      TEST( "E52103Y","CHECK WHETHER CONSTRAINT_ERROR " &
-                      "OR NO EXCEPTION IS RAISED WHEN DIMENSION OF " &
-                      "AN ARRAY HAS LENGTH > INTEGER'LAST");
-      BEGIN
- 
-           DECLARE
- 
-                TYPE  TA42  IS  ARRAY(
-                     INTEGER RANGE IDENT_INT( 13 )..IDENT_INT( 12 ),
-                     INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST)
-                                     )  OF BOOLEAN ;
- 
-                SUBTYPE  TA41  IS  TA42 ;
- 
-                ARR41  :  TA41 ;
-                ARR42  :  TA42 ;
- 
-           BEGIN
- 
-                COMMENT ("NO EXCEPTION FOR ARRAY DECLARATION");
- 
-                -- NULL ARRAY ASSIGNMENT:
- 
-                ARR42 := ARR41 ;
-                IF ARR42'LENGTH(1) /= 0 THEN
-                     FOR I IN TA42'RANGE(2) LOOP
-                          ARR41(13,I) := IDENT_BOOL(ARR42(13,I));
-                     END LOOP;
-                END IF;
- 
-                COMMENT ("NO EXCEPTION RAISED FOR NULL ARRAY " &
-                         "ASSIGNMENT");
- 
-           EXCEPTION
- 
-                WHEN CONSTRAINT_ERROR =>
-                     COMMENT ("CONSTRAINT_ERROR RAISED IN LENGTH " &
-                              "COMPARISON");
- 
-                WHEN  OTHERS  =>
-                     FAILED( "OTHER EXCEPTION RAISED  -  SUBTEST 2" );
- 
-           END ;
- 
-      EXCEPTION
- 
-           WHEN CONSTRAINT_ERROR =>
-                COMMENT ("CONSTRAINT_ERROR RAISED BY DECLARATION OF " &
-                         "NULL ARRAY TYPE WITH ONE DIMENSION > " &
-                         "INTEGER'LAST");
- 
-           WHEN OTHERS =>
-                FAILED ("SOME OTHER EXCEPTION RAISED");
- 
-      END;
- 
-      -------------------------------------------------------------------
- 
- 
-      RESULT ;
- 
- 
- END E52103Y;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/eb4011a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/eb4011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/eb4011a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/eb4011a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,79 ****
- -- EB4011A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT UNHANDLED EXCEPTIONS RAISED IN PACKAGE SUBUNITS ARE
- --     PROPAGATED TO THE ENVIRONMENT STATICALLY ENCLOSING THE
- --     CORRESPONDING BODY STUB (DECLARER OF THE PARENT UNIT).
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST MUST EXECUTE AND REPORT "TENTATIVELY PASSED". IN
- --     ADDITION, THE OUTPUT/LOG FILE MUST INDICATE THAT THE PROGRAM
- --     TERMINATED WITH AN UNHANDLED EXCEPTION.
- 
- -- HISTORY:
- --     DHH 03/29/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE EB4011A IS
- 
-      PACKAGE EB4011A_OUTSIDE IS
-      END EB4011A_OUTSIDE;
- 
-      PACKAGE EB4011A1 IS
-      END EB4011A1;
- 
-      PACKAGE BODY EB4011A1 IS
-      BEGIN
- 
-           TEST("EB4011A", "CHECK THAT UNHANDLED EXCEPTIONS RAISED IN " &
-                           "PACKAGE SUBUNITS ARE PROPAGATED TO THE " &
-                           "ENVIRONMENT STATICALLY ENCLOSING THE" &
-                           "CORRESPONDING BODY STUB (DECLARER OF THE " &
-                           "PARENT UNIT)");
- 
-           SPECIAL_ACTION("CHECK THE OUTPUT FILE TO SEE IF THIS " &
-                          "PROGRAM TERMINATED WITH AN UNHANDLED " &
-                          "EXCEPTION");
- 
-           RESULT;
- 
-      END EB4011A1;
- 
-      PACKAGE BODY EB4011A_OUTSIDE IS SEPARATE;
- 
- BEGIN
- 
-      TEST("EB4011A", "THIS LINE SHOULD NOT PRINT OUT");
- 
-      FAILED("EXCEPTION DID NOT CAUSE MAIN PROGRAM TERMINATION");
-      RESULT;
- 
- END EB4011A;
- 
- SEPARATE (EB4011A)
- PACKAGE BODY EB4011A_OUTSIDE IS
- BEGIN
-      RAISE CONSTRAINT_ERROR;
- END EB4011A_OUTSIDE;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/eb4012a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/eb4012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/eb4012a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/eb4012a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- EB4012A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN AN UNHANDLED EXCEPTION IS RAISED IN THE MAIN
- --     PROGRAM, THE MAIN PROGRAM IS ABANDONED.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST MUST EXECUTE AND PRINT "TENTATIVELY PASSED". IN
- --     ADDITION, THE OUTPUT/LOG FILE MUST SHOW THAT THE PROGRAM
- --     WAS ABANDONED DUE TO AN UNHANDLED EXCEPTION.
- 
- -- HISTORY:
- --     DHH 03/29/88 CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- PROCEDURE EB4012A IS
- 
- BEGIN
-      TEST("EB4012A", "CHECK THAT WHEN AN UNHANDLED EXCEPTION IS " &
-                      "RAISED IN THE MAIN PROGRAM, THE MAIN PROGRAM " &
-                      "IS ABANDONED");
-      SPECIAL_ACTION("CHECK THE OUTPUT/LOG FILE TO SEE THAT THIS " &
-                     "PROGRAM WAS ABANDONED BECAUSE OF AN UNHANDLED " &
-                     "EXCEPTION");
- 
-      RESULT;
- 
-      IF EQUAL(3,3) THEN
-           RAISE CONSTRAINT_ERROR;
-      END IF;
- 
-      TEST("EB4012A", "SHOULD NOT PRINT OUT");
-      FAILED("CONSTRAINT_ERROR NOT RAISED");
- 
-      RESULT;
- 
- END EB4012A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/eb4014a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/eb4014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/eb4014a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/eb4014a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,87 ****
- -- EB4014A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT WHEN EXCEPTIONS ARE RAISED DURING THE ELABORATION OF
- --     A LIBRARY UNIT, EXECUTION OF THE MAIN PROGRAM IS ABANDONED.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST MUST EXECUTE AND REPORT "TENTATIVELY PASSED". IN
- --     ADDITION, THE OUTPUT/LOG FILE MUST INDICATE THAT THE PROGRAM
- --     TERMINATED WITH AN UNHANDLED EXCEPTION.
- 
- -- HISTORY:
- --     DHH 03/29/88 CREATED ORIGINAL TEST.
- --     PWN 05/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
- 
- WITH REPORT; USE REPORT;
- FUNCTION EB4014A1 RETURN INTEGER IS
- BEGIN
- 
-      TEST("EB4014A", "THIS LINE SHOULD NOT BE PRINTED");
- 
-      FAILED("THE MAIN PROGRAM BODY WAS ENTERED");
-      RESULT;
- 
-      RETURN IDENT_INT(1);
- 
- END EB4014A1;
- 
- WITH REPORT; USE REPORT;
- PRAGMA ELABORATE (REPORT);
- PACKAGE EB4014A_OUTSIDE IS
-      PROCEDURE REQUIRE_BODY;
- END EB4014A_OUTSIDE;
- 
- PACKAGE BODY EB4014A_OUTSIDE IS
-      PROCEDURE REQUIRE_BODY IS
-      BEGIN
-           NULL;
-      END;
- BEGIN
-      TEST("EB4014A", "CHECK THAT WHEN EXCEPTIONS ARE RAISED DURING " &
-                      "THE ELABORATION OF A LIBRARY UNIT, EXECUTION " &
-                      "OF THE MAIN PROGRAM IS ABANDONED");
- 
-      SPECIAL_ACTION("CHECK THE OUTPUT/LOG FILE TO SEE IF THIS " &
-                     "PROGRAM TERMINATED WITH AN UNHANDLED " &
-                     "EXCEPTION");
- 
-      RESULT;
- 
-      RAISE CONSTRAINT_ERROR;
- END EB4014A_OUTSIDE;
- 
- WITH EB4014A1; WITH EB4014A_OUTSIDE;
- WITH REPORT; USE REPORT;
- PROCEDURE EB4014A IS
-      X : INTEGER := EB4014A1;
- BEGIN
- 
-      TEST("EB4014A", "THIS LINE SHOULD NOT PRINT OUT");
- 
-      FAILED("EXCEPTION DID NOT CAUSE MAIN PROGRAM TERMINATION");
-      RESULT;
-      X := IDENT_INT(X);
- END EB4014A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3203a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3203a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3203a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,168 ****
- -- EE3203A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT SET_INPUT AND SET_OUTPUT CAN BE USED, AND THAT THEY
- --     DO NOT REDEFINE OR CLOSE THE CORRESPONDING STANDARD FILES.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST IS PASSED IF IT EXECUTES AND THE STANDARD OUTPUT FILE
- --     CONTAINS THE LINE "INITIAL TEXT OF STANDARD_OUTPUT".
- 
- -- HISTORY:
- --     ABW 08/25/82
- --     SPS 11/19/82
- --     VKG 02/15/83
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/19/87  CORRECTED EXCEPTION HANDLING, REMOVED DEPENDENCE
- --                   ON RESET, AND ADDED CHECKS FOR USE_ERROR ON DELETE.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE EE3203A IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE_IN, FILE_OUT : FILE_TYPE;
-      LST : NATURAL;
-      IN_STR : STRING (1 .. 50);
- 
- BEGIN
- 
-      TEST ("EE3203A", "CHECK THAT SET_INPUT AND SET_OUTPUT " &
-                       "CAN BE USED, AND THAT CORRESPONDING " &
-                       "STANDARD FILES ARE UNCHANGED");
- 
-      BEGIN
-           CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE - 1");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE - 1");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      BEGIN
-           CREATE (FILE_OUT, OUT_FILE, LEGAL_FILE_NAME(2));
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
-                                "OUT_FILE MODE - 2");
-                RAISE INCOMPLETE;
-           WHEN NAME_ERROR =>
-                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
-                                "WITH OUT_FILE MODE - 2");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      PUT (FILE_IN, "INITIAL TEXT OF FILE_IN");
-      PUT (FILE_OUT, "INITIAL TEXT OF FILE_OUT");
-      PUT ("INITIAL TEXT OF STANDARD_OUTPUT");
- 
-      CLOSE (FILE_IN);
- 
-      BEGIN
-           OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
-                                "IN_FILE MODE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SET_INPUT (FILE_IN);
-      SET_OUTPUT (FILE_OUT);
- 
-      IF NOT IS_OPEN (STANDARD_INPUT) THEN
-           FAILED ("STANDARD_INPUT NOT OPEN");
-      END IF;
- 
-      IF NOT IS_OPEN (FILE_IN) THEN
-           FAILED ("FILE_IN NOT OPEN");
-      END IF;
- 
-      IF NOT IS_OPEN (STANDARD_OUTPUT) THEN
-           FAILED ("STANDARD_OUTPUT NOT OPEN");
-      END IF;
- 
-      IF NOT IS_OPEN (FILE_OUT) THEN
-           FAILED ("FILE_OUT NOT OPEN");
-      END IF;
- 
-      NEW_LINE;
-      PUT ("SECOND LINE OF OUTPUT");
- 
-      GET_LINE (IN_STR, LST);
-      IF IN_STR (1 .. LST) /= "INITIAL TEXT OF FILE_IN" THEN
-           FAILED ("DEFAULT INPUT INCORRECT");
-      END IF;
- 
-      CHECK_FILE (FILE_IN, "INITIAL TEXT OF FILE_IN#@%");
-      SET_OUTPUT (FILE => STANDARD_OUTPUT);
-      SET_INPUT (FILE => STANDARD_INPUT);
-      CHECK_FILE (FILE_OUT, "INITIAL TEXT OF FILE_OUT#" &
-                            "SECOND LINE OF OUTPUT#@%");
- 
-      SPECIAL_ACTION ("THE STANDARD OUTPUT FILE SHOULD CONTAIN " &
-                      "THE LINE : INITIAL TEXT OF STANDARD_OUTPUT");
- 
-      BEGIN
-           DELETE (FILE_IN);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      BEGIN
-           DELETE (FILE_OUT);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END EE3203A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3204a.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3204a.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3204a.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- EE3204A.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT AFTER THE DEFAULT FILES HAVE BEEN REDEFINED,
- --     OUTPUT ON THE STANDARD FILES IS STILL PROPERLY HANDLED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
- --     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
- 
- -- HISTORY:
- --     JLH 07/08/88  CREATED ORIGINAL TEST.
- 
- WITH REPORT; USE REPORT;
- WITH TEXT_IO; USE TEXT_IO;
- 
- PROCEDURE EE3204A IS
- 
-      FILE1, FILE2 : FILE_TYPE;
-      ITEM : CHARACTER := 'B';
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("EE3204A", "CHECK THAT AFTER THE DEFAULT FILES HAVE BEEN " &
-                       "REDEFINED, OUTPUT ON THE STANDARD " &
-                       "FILES IS STILL PROPERLY HANDLED");
- 
-      BEGIN
- 
-           BEGIN
-                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
-                                     "WITH MODE OUT_FILE");
-                     RAISE INCOMPLETE;
-                WHEN OTHERS =>
-                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2));
-           PUT (FILE2, 'A');
-           NEW_LINE (FILE2);
-           PUT (FILE2, 'B');
- 
-           CLOSE (FILE2);
- 
-           BEGIN
-                OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2));
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
-                                     "WITH MODE IN_FILE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_INPUT (FILE2);
- 
-           GET (ITEM);
-           IF ITEM /= 'A' THEN
-                FAILED ("INCORRECT VALUE READ FROM DEFAULT FILE");
-           END IF;
- 
-           SET_OUTPUT (FILE1);
- 
-           PUT ("THIS TEST FAILS IF THIS APPEARS IN STANDARD OUTPUT");
-           NEW_LINE;
-           PUT ("THIS TEST FAILS IF THIS APPEARS IN STANDARD OUTPUT");
- 
-           PUT (STANDARD_OUTPUT, "FIRST LINE OF INPUT");
-           NEW_LINE (STANDARD_OUTPUT);
-           PUT (STANDARD_OUTPUT, "SECOND LINE OF INPUT");
- 
-           SPECIAL_ACTION ("CHECK THAT THE CONTENTS OF THE STANDARD " &
-                           "OUTPUT FILE ARE CORRECT");
-           SPECIAL_ACTION ("IT SHOULD CONTAIN:");
-           SPECIAL_ACTION ("TEST HEADER LINES");
-           SPECIAL_ACTION ("FIRST LINE OF INPUT");
-           SPECIAL_ACTION ("SECOND LINE OF INPUT");
- 
-           BEGIN
-                DELETE (FILE1);
-                DELETE (FILE2);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END EE3204A;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3402b.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3402b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3402b.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3402b.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- EE3402B.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT NEW_LINE HAS AN OPTIONAL SPACING PARAMETER WITH
- --     DEFAULT VALUE ONE, AND CHECK THAT NEW_LINE OPERATES ON THE
- --     CURRENT DEFAULT OUTPUT FILE IF NO FILE IS SPECIFIED.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
- --     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/16/82
- --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     DWC 08/19/87  ADDED SPECIAL ACTION FUNCTION AND REMOVED
- --                   EXCEPTION HANDLERS.  CHANGED TO AN E TEST.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- WITH CHECK_FILE;
- 
- PROCEDURE EE3402B IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE, FILE_OUT : FILE_TYPE;
-      SPAC : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
-      TWO : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
-      FOUR : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
-      CUR_LINE : COUNT;
- 
- BEGIN
- 
-      TEST ("EE3402B", "CHECK THAT NEW_LINE HAS AN OPTIONAL " &
-                       "SPACING PARAMETER WITH DEFAULT VALUE ONE, " &
-                       "AND CHECK THAT NEW_LINE OPERATES ON THE " &
-                       "CURRENT DEFAULT OUTPUT FILE IF NO FILE IS " &
-                       "SPECIFIED.");
- 
-      BEGIN
-           CREATE (FILE);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
-                                "WITH OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE - 1");
-                RAISE INCOMPLETE;
-      END;
- 
-      CREATE (FILE_OUT);
- 
-      SPECIAL_ACTION ("CHECK OUTPUT FOR FOUR BLANK LINES");
- 
-      NEW_LINE (FILE);
-      IF LINE (FILE) /= TWO THEN
-           FAILED ("SPACING DEFAULT NOT ONE");
-      END IF;
- 
-      SPECIAL_ACTION ("FOUR BLANK LINES SHOULD FOLLOW THIS COMMENT");
-      CUR_LINE := LINE (STANDARD_OUTPUT);
-      NEW_LINE (SPAC);
-      IF LINE (STANDARD_OUTPUT) /= CUR_LINE + 4 THEN
-           FAILED ("FILE DEFAULT NOT CORRECT FOR STANDARD_OUTPUT");
-      END IF;
- 
-      SET_OUTPUT (FILE_OUT);
-      NEW_LINE (SPAC);
-      IF LINE (CURRENT_OUTPUT) /= FOUR + 1 THEN
-           FAILED ("FILE DEFAULT NOT CORRECT FOR CURRENT_OUTPUT");
-      END IF;
- 
-      SET_OUTPUT (STANDARD_OUTPUT);      -- RESET STANDARD OUTPUT
-      COMMENT ("CHECKING FILE");
-      CHECK_FILE (FILE, "#@%");
-      COMMENT ("CHECKING FILE_OUT");
-      CHECK_FILE (FILE_OUT, "####@%");
- 
-      CLOSE (FILE);
-      CLOSE (FILE_OUT);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END EE3402B;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3409f.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3409f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3409f.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3409f.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- EE3409F.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT THE FILE PARAMETER FOR SET_COL IS OPTIONAL, AND
- --     THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT
- --     OUTPUT FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
- --     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
- 
- -- HISTORY:
- --     ABW 08/26/82
- --     SPS 09/20/82
- --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
- --                   RESULT WHEN FILES ARE NOT SUPPORTED.
- --     JLH 08/31/87  CORRECTED EXCEPTION HANDLING, CHECKED FOR
- --                   USE_ERROR ON DELETE, AND RENAMED FROM
- --                   CE3409F.ADA.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE EE3409F IS
- 
-      INCOMPLETE : EXCEPTION;
-      FILE_OUT : FILE_TYPE;
-      TWO   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
-      THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
- 
- BEGIN
- 
-      TEST ("EE3409F", "CHECK DEFAULT FILE FOR SET_COL");
- 
-      BEGIN
-           CREATE (FILE_OUT);
-      EXCEPTION
-           WHEN USE_ERROR =>
-                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                "FOR TEMPORARY FILES WITH " &
-                                "OUT_FILE MODE");
-                RAISE INCOMPLETE;
-           WHEN OTHERS =>
-                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
-                RAISE INCOMPLETE;
-      END;
- 
-      SPECIAL_ACTION ("THE NEXT LINE SHOULD BEGIN IN COLUMN TWO");
- 
-      SET_COL (TWO);
-      PUT ("SHOULD BEGIN IN COLUMN TWO");
- 
-      IF COL (STANDARD_OUTPUT) /= 28 THEN
-           FAILED ("SET_COL DOES NOT OPERATE ON THE DEFAULT " &
-                   "STANDARD_OUTPUT");
-      END IF;
- 
-      NEW_LINE;
- 
-      SET_OUTPUT (FILE_OUT);
-      SET_COL (THREE);
-      IF COL (CURRENT_OUTPUT) /= THREE THEN
-           FAILED ("SET_COL DOES NOT OPERATE ON THE DEFAULT " &
-                   "CURRENT_OUTPUT");
-      END IF;
- 
-      CLOSE (FILE_OUT);
- 
-      RESULT;
- 
- EXCEPTION
-      WHEN INCOMPLETE =>
-           RESULT;
- 
- END EE3409F;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3412c.ada gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3412c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/e/ee3412c.ada	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/e/ee3412c.ada	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- EE3412C.ADA
- 
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- -- OBJECTIVE:
- --     CHECK THAT LINE OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN
- --     NO FILE IS SPECIFIED.  CHECK THAT LINE CAN OPERATE ON FILES OF
- --     MODE IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT
- --     INPUT_FILE.
- 
- -- APPLICABILITY CRITERIA:
- --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
- --     TEXT FILES.
- 
- -- PASS/FAIL CRITERIA:
- --     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
- --     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
- 
- -- HISTORY:
- --     SPS 09/29/82
- --     JBG 08/30/83
- --     JLH 09/02/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
- --                   CODE, CHECKED FOR USE_ERROR ON DELETE, AND RENAMED
- --                   FROM CE3412C.ADA.
- 
- WITH REPORT;
- USE REPORT;
- WITH TEXT_IO;
- USE TEXT_IO;
- 
- PROCEDURE EE3412C IS
-      INCOMPLETE : EXCEPTION;
- 
- BEGIN
- 
-      TEST ("EE3412C", "CHECK THAT LINE OPERATES ON DEFAULT IN_FILE " &
-                       "AND OUT_FILE FILES");
- 
-      DECLARE
-           F1, F2 : FILE_TYPE;
-           C : POSITIVE_COUNT;
-           X : CHARACTER;
-           ITEM : STRING (1..6);
-      BEGIN
-           C := LINE (STANDARD_OUTPUT);
-           NEW_LINE (STANDARD_OUTPUT);
-           SPECIAL_ACTION ("ONE BLANK LINE SHOULD PRECEDE THIS COMMENT");
-           IF LINE /= C+2 THEN
-                FAILED ("DEFAULT FOR LINE NOT STANDARD_OUTPUT");
-           END IF;
- 
-           BEGIN
-                CREATE (F1, OUT_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
-                                     "WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-                WHEN NAME_ERROR =>
-                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
-                                     "CREATE WITH OUT_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           CREATE (F2, OUT_FILE);
- 
-           SET_OUTPUT (F2);
- 
-           FOR I IN 1 .. 6 LOOP
-                PUT (F1, "STRING");
-                NEW_LINE (F1);
-           END LOOP;
-           IF LINE (F1) /= 7 THEN
-                FAILED ("LINE INCORRECT SUBTEST 1");
-           END IF;
- 
-           SET_LINE_LENGTH (3);
-           PUT ("OUTPUT STRING");
-           IF LINE /= LINE(F2) THEN
-                FAILED ("LINE INCORRECT SUBTEST 2");
-           END IF;
- 
-           CLOSE (F1);
- 
-           BEGIN
-                OPEN (F1, IN_FILE, LEGAL_FILE_NAME);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
-                                     "WITH IN_FILE MODE");
-                     RAISE INCOMPLETE;
-           END;
- 
-           SET_INPUT (F1);
- 
-           GET (F1, ITEM);
-           IF ITEM /= "STRING" THEN
-                FAILED ("INCORRECT VALUE READ");
-           END IF;
- 
-           SKIP_LINE(F1);
-           SKIP_LINE(F1);
-           SKIP_LINE(F1);
-           IF LINE (CURRENT_INPUT) /= 4 AND LINE (F1) /= 4 THEN
-                FAILED ("LINE INCORRECT SUBTEST 3");
-           END IF;
- 
-           BEGIN
-                DELETE (F1);
-           EXCEPTION
-                WHEN USE_ERROR =>
-                     NULL;
-           END;
- 
-           CLOSE (F2);
- 
-      EXCEPTION
-           WHEN INCOMPLETE =>
-                NULL;
-      END;
- 
-      RESULT;
- 
- END EE3412C;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140010.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140010.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140010.a	Thu Jan  1 00:00:00 1970
***************
*** 1,51 ****
- -- LA140010.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140011.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140011.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140011.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140010.A
- --         LA140011.AM
- --         LA140012.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140011.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- package LA140010_0 is
-      TC_Var : integer := 100;
- end LA140010_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140011.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140011.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140011.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140011.am	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- LA140011.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library level function body depends
- --      on a unit that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package, a function that withs the
- --      package, and a procedure that withs the function.  Then, 
- --      a new version of the package is compiled (in a separate
- --      file, simulating an editing modification to the package).
- --      Unless automatic recompilation is supported, this 
- --      test should fail to link.  Otherwise, the test should 
- --      recompile and link the correct version of the withed package 
- --      and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140010 (and include the results in the
- --            program library).
- --         2) Compile the file LA140011 (and include the results in the
- --            program library).
- --         3) Compile the file LA140012 (and include the results in the
- --            program library).
- --         4) Attempt to build an executable image.
- --         5) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140010.A
- --      -> LA140011.AM
- --         LA140012.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA140011_0 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007I baseline version
- --     08 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Changed unit and file names to conform to
- --                             coding standards. Modified prologue.
- --     07 DEC 96   SAIC        Moved LA140010_0 to a separate file.
- --
- --!
- 
- function LA140011_0 return integer;
- 
- with LA140010_0;
- function LA140011_0 return integer is
- begin
-      return LA140010_0.TC_Var;
- end LA140011_0;
- 
- with Report; use Report;
- with LA140011_0;
- procedure LA140011 is
-      TC_Val : integer := 0;
- begin
-      Test ("LA14001", "Check that a compilation unit " &
-                       "may not depend semantically on " &
-                       "two different versions of the same " &
-                       "compilation unit.  Check the case " &
-                       "where a library level function body " &
-                       "depends on a unit that is changed");
- 
-      TC_Val := LA140011_0;
-      if TC_Val = 100 then
-           Failed ("Revised package not used");
-      elsif TC_Val /= -10 then
-           Failed ("Incorrect test value returned");
-      end if;
- 
-      Result;
- end LA140011;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140012.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140012.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140012.a	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- LA140012.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140011.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140011.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140011.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140010.A
- --         LA140011.AM
- --      -> LA140012.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140011.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007I baseline version
- --     08 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Modified prologue to conform to standards.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- package LA140010_0 is
-      TC_Var : integer := -10;
- end LA140010_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140020.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140020.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140020.a	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- LA140020.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140021.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140021.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140021.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140020.A
- --         LA140021.AM
- --         LA140022.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140021.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- package LA140020_0 is
-      procedure P (TC_change : out integer);
- 
-      TC_Var : integer := 100;
- end LA140020_0;
- 
- package body LA140020_0 is
-      procedure P (TC_change : out integer) is 
-      begin 
-           TC_change := TC_Var;
-      end P;
- end LA140020_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140021.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140021.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140021.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140021.am	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- LA140021.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a unit depends on a package whose
- --      declaration is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles the specification of a package containing
- --      the specification of a procedure.  Then it compiles the body 
- --      of the package containing the body of the procedure and the 
- --      main test procedure.  The main procedure withs the first 
- --      package and calls the procedure in the first package.  Then, 
- --      the withed package specification is changed and recompiled.  
- --      Unless automatic recompilation is supported, this test should 
- --      fail to link.  Otherwise, the test should recompile the package 
- --      body and main procedure, link the correct versions of the unit, 
- --      and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140020 (and include the results in the
- --            program library).
- --         2) Compile the file LA140021 (and include the results in the
- --            program library).
- --         3) Compile the file LA140022 (and include the results in the
- --            program library).
- --         4) Attempt to build an executable image.
- --         5) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140020.A
- --      -> LA140021.AM
- --         LA140022.A
- --
- -- PASS/FAIL CRITERIA:                
- --      The test passes if a link time error message reports that 
- --      LA140020_0 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007J baseline version
- --     08 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Changed unit and file names to conform to
- --                             coding conventions.
- --     07 DEC 96   SAIC        Moved LA140020_0 to a separate file.
- --
- --!
- 
- with Report; use Report;
- with LA140020_0;
- 
- procedure LA140021 is
-      TC_Val : integer := 0;
- begin
-      Test ("LA14002", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of " &
-                       "the same compilation unit.  Check the case " &
-                       "where a unit depends on a package whose " &
-                       "declaration is changed");
- 
-      LA140020_0.P (TC_Val);
-      if TC_Val = 100 then
-           Failed ("Changed unit not used");
-      elsif TC_Val /= -10 then
-           Failed ("Incorrect test value");
-      end if;
- 
-      Result;
- end LA140021;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140022.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140022.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140022.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140022.a	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- LA140022.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140021.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140021.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140021.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140020.A
- --         LA140021.AM
- --      -> LA140022.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140021.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007J baseline version
- --     08 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Modified prologue to conform to coding
- --                             conventions.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization. Added body for unit to
- --                             allow automatic recompilation.
- --
- --!
- 
- package LA140020_0 is
-      procedure P (TC_change : out integer);
- 
-      TC_Var : integer := -10;
- end LA140020_0;
- 
- package body LA140020_0 is
-      procedure P (TC_change : out integer) is 
-      begin 
-           TC_change := TC_Var;
-      end P;
- end LA140020_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140030.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140030.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140030.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140030.a	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- LA140030.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140032.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140032.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140032.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --    =>   LA140030.A
- --         LA140031.A
- --         LA140032.AM
- --         LA140033.A 
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140032.AM.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007K baseline version
- --     09 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Modified prologue to conform to coding
- --                             conventions.
- --
- --!
- 
- package LA140030 is
-      TC_named_number : constant := 100;
-      TC_Var : integer := 100;
- end LA140030;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140031.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140031.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140031.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140031.a	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- LA140031.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140032.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140032.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140032.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140030.A
- --    =>   LA140031.A
- --         LA140032.AM
- --         LA140033.A 
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140032.AM.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007K baseline version
- --     09 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Modified prologue to conform to coding
- --                             conventions.
- --
- --!
- 
- package LA140031 is
-      procedure P (TC_Change : out integer);
- end LA140031;
- 
- with LA140030;     -- when LA140030 is revised and recompiled,
-                    -- this semantic dependency has to be handled
- 
- package body LA140031 is
-      procedure P (TC_Change : out integer) is 
-      begin
-           TC_Change := LA140030.TC_Var;
-      end P;
- end LA140031;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140032.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140032.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140032.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140032.am	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- LA140032.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a package body depends on a package
- --      specification that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package specification, then a second
- --      package specification and body that withs the first package, 
- --      followed by a procedure that makes a call to a procedure 
- --      contained inside the second package.  Then, the first 
- --      package specification is recompiled, making the body of 
- --      package LA140031 obsolete.  Unless automatic recompilation 
- --      is supported this test should fail to link.  Otherwise, the 
- --      test should recompile and link the correct version of the 
- --      withed package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140030 (and include the results in the
- --            program library).
- --         2) Compile the file LA140031 (and include the results in the
- --            program library).
- --         3) Compile the file LA140032 (and include the results in the
- --            program library).
- --         4) Compile the file LA140033 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140030.A
- --         LA140031.A
- --    =>   LA140032.AM
- --         LA140033.A 
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA140031 is missing or obsolete, and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007K baseline version
- --     09 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Changed main program name and prologue
- --                             to conform to coding conventions.
- --
- --!
- 
- 
- with Report; use Report;
- with LA140031;
- procedure LA140032 is
-      TC_Val : integer := 0;
- begin
-      Test ("LA14003", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit.  " &
-                       "Check the case where a package body " &
-                       "depends on a package specification that " &
-                       "is changed");
- 
-      LA140031.P (TC_Val);
- 
-      if TC_Val = 100 then
-           Failed ("Obsolete unit elaborated");
-      elsif TC_Val /= -10 then
-           Failed ("Incorrect test value");
-      end if;
- 
-      Result;
- end LA140032;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140033.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140033.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140033.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140033.a	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- LA140033.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140032.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140032.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140032.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140030.A
- --         LA140031.A
- --         LA140032.AM
- --    =>   LA140033.A 
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140032.AM.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007K baseline version
- --     09 MAY 95   SAIC        Initial version
- --     16 NOV 96   SAIC        Modified prologue to conform to coding
- --                             conventions.
- --
- --!
- 
- package LA140030 is
-      TC_Var : integer := -10;
- end LA140030;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140040.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140040.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140040.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140040.a	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- LA140040.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140041.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140041.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140041.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140040.A
- --         LA140041.AM
- --         LA140042.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140041.AM.
- --
- -- CHANGE HISTORY:
- --     09 MAY 95   SAIC    Initial version
- --     10 DEC 96   SAIC    Reorganized to permit automatic recompilation.
- --
- --!
- 
- package LA14004_0 is
-      TC_Var : integer := 100;
- end LA14004_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140041.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140041.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140041.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140041.am	Thu Jan  1 00:00:00 1970
***************
*** 1,108 ****
- -- LA140041.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic function depends on a 
- --      library level package.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package specification, then a generic 
- --      function specification and body that withs the package, 
- --      followed by a procedure that makes a call to an instance of
- --      the generic function.  Then, the package specification is
- --      recompiled, making the body of function LA14004_1 obsolete.
- --      Unless automatic recompilation is supported this test should fail
- --      to link.  Otherwise, the test should recompile and link 
- --      the correct version of the withed package and report
- --      "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140040 (and include the results in the
- --            program library).
- --         2) Compile the file LA140041 (and include the results in the
- --            program library).
- --         3) Compile the file LA140042 (and include the results in the
- --            program library).
- --         4) Attempt to build an executable image.
- --         5) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140040.A
- --      -> LA140041.AM
- --         LA140042.A
- --
- -- PASS/FAIL CRITERIA:                
- --      Expect a link-time error message that the body of generic 
- --      function LA14004_1 is missing or obsolete.  If automatic
- --      recompilation is supported, and an executable image is 
- --      built, expect a "PASSED" message from execution.
- --
- -- CHANGE HISTORY:
- --     09 MAY 95   SAIC    Initial version
- --     10 DEC 96   SAIC    Reorganized to permit automatic recompilation.
- --
- --!
- 
- generic
- function LA14004_1 return integer;
- 
- with LA14004_0;     -- Revision and recompilation of LA14004_0
-                     -- will require resolution of this semantic
-                     -- dependency
- function LA14004_1 return integer is
- begin
-      return LA14004_0.TC_Var;
- end LA14004_1;
- 
- 
- 
- with Report; use Report;
- with LA14004_1;
- procedure LA140041 is
-      TC_Val : integer := 0;
- 
-      function F_LA14004_1 is new LA14004_1;
- begin
-      Test ("LA14004", "Check that a compilation unit may " &
-                       "not depend semantically on two " &
-                       "different versions of the same " &
-                       "compilation unit.  Check the case " &
-                       "where a generic function depends on a "&
-                       "library level package");
- 
-       TC_Val := F_LA14004_1;
- 
-       if TC_Val = 100 then
-            Failed ("Obsolete unit used in elaboration");
-       elsif TC_Val /= -10 then
-            Failed ("Incorrect test value returned");
-       end if;
- 
-      Result;
- end LA140041;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140042.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140042.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140042.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140042.a	Thu Jan  1 00:00:00 1970
***************
*** 1,53 ****
- -- LA140042.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140041.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140041.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140041.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140040.A
- --         LA140041.AM
- --      -> LA140042.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140041.AM.
- --
- -- CHANGE HISTORY:
- --     09 MAY 95   SAIC    Initial version
- --     10 DEC 96   SAIC    Reorganized to permit automatic recompilation.
- --
- --!
- 
- package LA14004_0 is
-      Small_array : array (1..15) of integer;
-      TC_Var : integer := -10;
- end LA14004_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140050.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140050.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140050.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140050.a	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- LA140050.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     See LA140052.AM.
- --
- -- TEST DESCRIPTION:
- --     See LA140052.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --     See LA140052.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140050.A
- --         LA140051.A
- --         LA140052.AM
- --         LA140053.A
- --
- -- PASS/FAIL CRITERIA:
- --     See LA140052.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- generic
-      hi : integer;
-      lo : integer;
-      type flt is digits <>;
- package LA14005_0 is
-      TC_var : flt := flt(lo);
-      type gen_flt is new flt range flt(lo)..flt(hi);
-      max : integer := hi;
-      min : integer := lo;
-      avg : integer := (hi + lo)/ (integer(2.0));
- end LA14005_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140051.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140051.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140051.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140051.a	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- LA140051.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     See LA140052.AM.
- --
- -- TEST DESCRIPTION:
- --     See LA140052.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --     See LA140052.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140050.A
- --      -> LA140051.A
- --         LA140052.AM
- --         LA140053.A
- --
- -- PASS/FAIL CRITERIA:
- --     See LA140052.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- with LA14005_0;
- generic 
-      with package types is new LA14005_0 (<>);
- package LA14005_1 is
-      TC_constant_flt : constant types.gen_flt := types.gen_flt(types.avg);
-      function return_flt return types.gen_flt;
- end LA14005_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140052.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140052.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140052.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140052.am	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- LA140052.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically on two 
- --      different versions of the same compilation unit.  Check the case 
- --      where a generic package body depends on a generic package 
- --      specification.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic package specification and body, 
- --      followed by a procedure that makes a call to a procedure
- --      contained inside the generic package.  Then, the generic package
- --      specification is recompiled, making the body of the generic
- --      package obsolete.  Unless automatic recompilation is 
- --      supported this test should fail to link.  Otherwise, the test should 
- --      recompile and link the correct version of the units and report
- --      "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140050 (and include the results in the
- --            program library).
- --         2) Compile the file LA140051 (and include the results in the
- --            program library).
- --         3) Compile the file LA140052 (and include the results in the
- --            program library).
- --         4) Compile the file LA140053 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140050.A
- --         LA140051.A
- --      -> LA140052.AM
- --         LA140053.A
- --
- -- PASS/FAIL CRITERIA:                
- --      Expect a link-time error message that the body of generic
- --      package LA14005_1 is missing or obsolete.  If automatic
- --      recompilation is supported, and an executable image is 
- --      built, expect a "PASSED" message from execution.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008I baseline version
- --     09 MAY 95   SAIC        Initial version
- --     08 NOV 96   SAIC        Unit naming correction
- --     07 DEC 96   SAIC        Moved spec of LA14005_1 to a separate file.
- --
- --!
- 
- package body LA14005_1 is
-      function return_flt return types.gen_flt is
-      begin
-           return types.gen_flt(types.TC_var);
-      end return_flt;
- begin
-      types.TC_var := types.flt(TC_constant_flt);
- end LA14005_1;
- 
-           ---------------------------------------------------------
- 
- with Report; use Report;
- with LA14005_0;
- with LA14005_1;
- procedure LA140052 is
-      subtype TC_flt is float digits 5;
- 
-      package Y is new LA14005_0 (integer(100.0), integer(0.0), TC_flt);
-      package inst is new LA14005_1 (Y);
-      TC_var : TC_flt;
- begin
-      Test ("LA14005", "Check that a compilation unit may not depend " &
-            "semantically on two different versions of the same " &
-            "compilation unit. Check the case where a generic package " &
-            "body depends on a generic package specification");
- 
-      TC_var := TC_flt(inst.return_flt);
- 
-      if TC_Var /= TC_flt(Y.min) then
-           Failed ("Obsolete unit used in elaboration");
-      end if;
- 
-      Result;
- end LA140052;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140053.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140053.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140053.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140053.a	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- LA140053.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     See LA140052.AM.
- --
- -- TEST DESCRIPTION:
- --     See LA140052.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --     See LA140052.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140050.A
- --         LA140051.A
- --         LA140052.AM
- --      -> LA140053.A
- --
- -- PASS/FAIL CRITERIA:
- --     See LA140052.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008I baseline version
- --     09 MAY 95   SAIC        Initial version
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- with LA14005_0;
- generic 
-      with package types is new LA14005_0 (<>);
- package LA14005_1 is
-      TC_constant_flt : constant 
-              types.gen_flt := types.gen_flt(types.min);  --changed line
-      function return_flt return types.gen_flt;
- end LA14005_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140060.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140060.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140060.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140060.a	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- LA140060.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140062.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140062.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140062.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140060.A
- --         LA140061.A
- --         LA140062.AM
- --         LA140063.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140062.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- package LA14006_types is 
-      type t_type is tagged record
-           f : integer := 87;
-      end record;
- end LA14006_types;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140061.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140061.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140061.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140061.a	Thu Jan  1 00:00:00 1970
***************
*** 1,66 ****
- -- LA140061.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140062.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140062.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140062.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140060.A
- --      -> LA140061.A
- --         LA140062.AM
- --         LA140063.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140062.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- with LA14006_types;
- use  LA14006_types;
- generic
-      type t is new t_type with private;
- package LA14006_0 is
- 
-      type T2 is new t with record 
-           g : integer := 100;
-      end record;
-      
-      TC_var : T2;
-      
- private 
-      type type_t is new t with record
-           g2 : integer := 99;
-      end record;
- end LA14006_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140062.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140062.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140062.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140062.am	Thu Jan  1 00:00:00 1970
***************
*** 1,135 ****
- -- LA140062.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically 
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic package depends on another
- --      generic package specification.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic package specification, then
- --      compiles a generic package specification and body, 
- --      followed by a procedure that makes a call to a procedure
- --      contained inside the second generic package.  Then, the
- --      first generic package specification is recompiled, 
- --      making the body of the generic package LA140060 obsolete.
- --      Unless automatic recompilation is supported this test should 
- --      fail to link.  Otherwise, the test should recompile and link 
- --      the correct version of the units and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140060 (and include the results in the
- --            program library).
- --         2) Compile the file LA140061 (and include the results in the
- --            program library).
- --         3) Compile the file LA140062 (and include the results in the
- --            program library).
- --         4) Compile the file LA140063 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140060.A
- --         LA140061.A
- --      -> LA140062.AM
- --         LA140063.A
- --
- -- PASS/FAIL CRITERIA:                
- --      Expect a link-time error message that the body of generic
- --      package LA14006_1 is missing or obsolete.  If automatic
- --      recompilation is supported, and an executable image is 
- --      built, expect a "PASSED" message from execution.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008K baseline version
- --     09 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Moved LA14006_0 to a separate file. Added
- --                             pragma Elaborate to context clause of LA14006_2.
- --
- --!
- 
- with LA14006_0;
- with LA14006_types;
- use  LA14006_types;
- generic
-      type additional is (<>);
-      add_val : additional;
- package LA14006_1 is
-      type T3 is new t_type with record
-           h: additional := add_val;
-      end record;
-  
-      procedure P (TC_Change : out integer);
- 
-      package inst is new LA14006_0 (T3);
- end LA14006_1;
- 
- ----------------------------------------------------------------
- 
- package body LA14006_1 is
-      procedure P (TC_Change : out integer) is 
-      begin 
-            TC_Change := inst.TC_Var.g;
-      end P;
- end LA14006_1;
- 
- ----------------------------------------------------------------
- 
- with LA14006_1;
- pragma Elaborate (LA14006_1);
- package LA14006_2 is new LA14006_1 (integer, 300);
- 
- ----------------------------------------------------------------
- 
- with Report; use Report;
- with LA14006_2;
- procedure LA140062 is
-      TC_Val : integer := 0;
- begin
-      Test ("LA14006", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit. " &
-                       "Check the case where a generic package " &
-                       "depends on another generic package " &
-                       "specification");
- 
-      LA14006_2.P (TC_Val);
- 
-      if TC_Val = 100 then
-           Failed ("Obsolete unit used in elaboration");
-      elsif TC_Val /= -10 then
-           Failed ("Incorrect test value received");
-      end if;
- 
-      Result;
- end LA140062;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140063.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140063.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140063.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140063.a	Thu Jan  1 00:00:00 1970
***************
*** 1,70 ****
- -- LA140063.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140062.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140062.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140062.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140060.A
- --         LA140061.A
- --         LA140062.AM
- --      -> LA140063.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140062.AM.
- --
- -- CHANGE HISTORY:
- --     09 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- with LA14006_types;
- use  LA14006_types;
- generic
-      type t is new t_type with private;
- package LA14006_0 is
-      type T2 is new t with record
-           g : integer := -10;
-      end record;
-  
-      TC_var : T2;
-      Other_var : integer := 12;
-  
-      private
-           type type_t is new t with record
-                g2 : integer := 88;
-           end record;
- end LA14006_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140070.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140070.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140070.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140070.a	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- LA140070.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140072.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140072.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140072.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140070.A
- --         LA140071.A
- --         LA140072.AM
- --         LA140073.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140072.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007L baseline version
- --     12 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA14007_0 is        -- this will be modified and recompiled
-      type mod_16 is new integer;
-      type rec is tagged record
-           f: mod_16 := 12;
-      end record;
-      type t_rec is new rec with record
-           g : mod_16 := -2;
-      end record;
-      TC_Var : t_rec;
- end LA14007_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140071.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140071.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140071.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140071.a	Thu Jan  1 00:00:00 1970
***************
*** 1,72 ****
- -- LA140071.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140072.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140072.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140072.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140070.A
- --      -> LA140071.A
- --         LA140072.AM
- --         LA140073.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140072.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007L baseline version
- --     12 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform to coding
- --                             conventions. Deleted extraneous procedure
- --                             specification.
- --
- --!
- 
- procedure LA14007_1 (TC_Parent : in out integer);
- 
-      --================================================================--
- 
- procedure LA14007_1 (TC_Parent : in out integer) is
-      procedure LA14007_2 (TC_Local : in out integer) is separate;
- begin
-      LA14007_2 (TC_Parent);
- end LA14007_1;
- 
-      --================================================================--
- 
- with LA14007_0;
- 
- separate (LA14007_1)
- procedure LA14007_2 (TC_Local : in out integer) is
- begin
-      TC_Local := integer (LA14007_0.TC_Var.f);
- end LA14007_2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140072.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140072.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140072.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140072.am	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- LA140072.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a separate procedure body depends on
- --      a non-generic package specification that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package specification, a procedure,
- --      the separate procedure body and a main procedure that
- --      withs the first package.  Then, a new version of the
- --      first package specification is compiled (in a separate
- --      file, simulating editing and modification of the unit). 
- --      Unless automatic recompilation is supported, this test
- --      should fail to link.  Otherwise, the test should 
- --      recompile and link the correct version of the withed 
- --      package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140070 (and include the results in the
- --            program library).
- --         2) Compile the file LA140071 (and include the results in the
- --            program library).
- --         3) Compile the file LA140072 (and include the results in the
- --            program library).
- --         4) Compile the file LA140073 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140070.A
- --         LA140071.A
- --      -> LA140072.AM
- --         LA140073.A 
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14007_1.LA14007_2 is missing or obsolete and no executable 
- --      image results.  The test also passes if an executable image is 
- --      produced and reports "PASSED" (in the case where the implementation
- --      supports automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007L baseline version
- --     12 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- 
- with Report; use Report;
- with LA14007_1;
- 
- procedure LA140072 is
-      TC_Val : integer := 0;
- begin
-      Test ("LA14007", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit.  " &
-                       "Check the case where a separate procedure " &
-                       "body depends on a non-generic package " &
-                       "specification that is changed");
- 
-      LA14007_1 (TC_Val);
- 
-      if TC_Val = 12 then
-           Failed ("Obsolete unit used in elaboration");
-      elsif TC_Val /= 3 then
-           Failed ("Incorrect test value returned");
-      end if;
- 
-      Result;
- end LA140072;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140073.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140073.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140073.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140073.a	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- LA140073.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140072.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140072.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140072.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140070.A
- --         LA140071.A
- --         LA140072.AM
- --      -> LA140073.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140072.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007L baseline version
- --     12 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA14007_0 is        -- this is the corrected version
-      extra_integer : integer;
-      type mod_16 is new integer;
-      type rec is tagged record
-           f: mod_16 := 3;
-      end record;
-      type t_rec is new rec with record
-           null;
-      end record;
-      TC_Var : t_rec;
- end LA14007_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140080.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140080.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140080.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140080.a	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- LA140080.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140082.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140082.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140082.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140080.A
- --         LA140081.A
- --         LA140082.AM
- --         LA140083.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140082.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12  LA5007M baseline version
- --     25 MAY 95   SAIC       Initial version
- --     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
- --
- --!
- 
- function LA14008_0 return integer;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140081.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140081.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140081.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140081.a	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- LA140081.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140082.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140082.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140082.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140080.A
- --      -> LA140081.A
- --         LA140082.AM
- --         LA140083.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140082.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12  LA5007M baseline version
- --     25 MAY 95   SAIC       Initial version
- --     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
- --
- --!
- 
- function LA14008_0 return integer is
-      TC_local : integer := 0;
-      TC_var   : integer := 100;
- 
-      function LA14008_1 return integer is separate;  
-                              -- when LA14008_0 is revised and recompiled,
-                              -- this semantic dependency has to be 
-                              -- handled
- begin
-      TC_local := LA14008_1;
-      return TC_local;
- end LA14008_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140082.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140082.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140082.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140082.am	Thu Jan  1 00:00:00 1970
***************
*** 1,106 ****
- -- LA140082.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a subunit function body depends
- --      on a unit that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a function, separate subunit function 
- --      body, and a procedure that withs the function.  Then, 
- --      a new version of the parent function is compiled (in a separate
- --      file, simulating and editing modification to the package).
- --      Unless automatic recompilation is supported, this 
- --      test should fail to link.  Otherwise, the test should 
- --      recompile and link the correct version of the withed package 
- --      and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140080 (and include the results in the
- --            program library).
- --         2) Compile the file LA140081 (and include the results in the
- --            program library).
- --         3) Compile the file LA140082 (and include the results in the
- --            program library).
- --         4) Compile the file LA140083 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140080.A
- --         LA140081.A
- --      -> LA140082.AM
- --         LA140083.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14008_0.LA14008_1 is missing or obsolete and no executable image
- --      results.  The test passes if an executable image is produced
- --      and reports "PASSED" (in case the implementation supports
- --      automatic recompilation).            
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12  LA5007M baseline version
- --     25 MAY 95   SAIC       Initial version
- --     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
- --
- --!
- 
- separate (LA14008_0)
- 
- function LA14008_1 return integer is
- begin
-      return LA14008_0.TC_var;
- end LA14008_1;
- 
-     --==================================================================--
-  
- with Report; use Report;
- with LA14008_0;         
-      
- procedure LA140082 is
-      TC_val    : integer := 0;
- begin
-      Test ("LA14008", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of " &
-                       "the same compilation unit.  Check the case " &
-                       "where a subunit function body depends on a " &
-                       "unit that is changed");
-  
-      TC_val := LA14008_0;
-  
-      if TC_val = 100 then
-           Failed ("Revised unit not used");
-      elsif TC_val /= -10 then
-           Failed ("Incorrect value returned");
-      end if;
-  
-      Result;
- end LA140082;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140083.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140083.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140083.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140083.a	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- LA140083.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140082.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140082.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140082.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140080.A
- --         LA140081.A
- --         LA140082.AM
- --      -> LA140083.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140082.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12  LA5007M baseline version
- --     25 MAY 95   SAIC       Initial version
- --     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
- --
- 
- function LA14008_0 return integer is
-      Another_var : integer := 1000;
-      TC_local : integer := 0;
-      TC_var   : integer := -10;
- 
-      function LA14008_1 return integer is separate;
- 
- begin
-      TC_local := LA14008_1;
-      return TC_local;
- end LA14008_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140090.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140090.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140090.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140090.a	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- LA140090.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140092.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140092.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140092.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140090.A
- --         LA140091.A
- --         LA140092.AM
- --         LA140093.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140092.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007N baseline version
- --     25 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- package LA14009_0 is
- 
-      package LA14009_1 is
- 
-           procedure P (TC_local : in out integer);
- 
-      end LA14009_1;
- 
- end LA14009_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140091.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140091.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140091.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140091.a	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- LA140091.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140092.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140092.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140092.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140090.A
- --      -> LA140091.A
- --         LA140092.AM
- --         LA140093.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140092.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007N baseline version
- --     25 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- package body LA14009_0 is
-      TC_var : integer := 100;
- 
-      package body LA14009_1 is separate;
-                              -- when LA14009_0 is revised and recompiled,
-                              -- this semantic dependency has to be 
-                              -- handled
- 
- end LA14009_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140092.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140092.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140092.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140092.am	Thu Jan  1 00:00:00 1970
***************
*** 1,110 ****
- -- LA140092.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a subunit package body depends
- --      on a unit that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package, separate subunit package 
- --      body, and a procedure that withs the package.  Then, 
- --      a new version of the package is compiled (in a separate
- --      file, simulating and editing modification to the package).
- --      Unless automatic recompilation is supported, this 
- --      test should fail to link.  Otherwise, the test should 
- --      recompile and link the correct version of the withed package 
- --      and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140090 (and include the results in the
- --            program library).
- --         2) Compile the file LA140091 (and include the results in the
- --            program library).
- --         3) Compile the file LA140092 (and include the results in the
- --            program library).
- --         4) Compile the file LA140093 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140090.A
- --         LA140091.A
- --      -> LA140092.AM
- --         LA140093.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14009_0.LA14009_1 is missing or obsolete and no executable image
- --      results.  The test passes if an executable image is produced
- --      and reports "PASSED" (in case the implementation supports
- --      automatic recompilation).            
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007N baseline version
- --     25 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- separate (LA14009_0)
- 
- package body LA14009_1 is
- 
-      procedure P (TC_local : in out integer) is
-      begin 
-           TC_local := LA14009_0.TC_var;
-      end P;
- 
- end LA14009_1;
- 
- 
- 
- with Report; use Report;
- with LA14009_0;
- 
- procedure LA140092 is
-      TC_val : integer := 0;
- begin
-      Test ("LA14009", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of the " &
-                       "same compilation unit.  Check the case where " &
-                       "a subunit package body depends on a unit that " &
-                       "is changed");
-  
-      LA14009_0.LA14009_1.P(TC_Val);
-  
-      if TC_val = 100 then
-           Failed ("Revised package body not used");
-      elsif TC_val /= -10 then
-           Failed ("Incorrect value returned");
-      end if;
-  
-      Result;
- end LA140092;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140093.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140093.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140093.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140093.a	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- LA140093.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140092.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140092.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140092.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140090.A
- --         LA140091.A
- --         LA140092.AM
- --      -> LA140093.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140092.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007N baseline version
- --     25 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- package body LA14009_0 is
-      New_TC_var : integer := 50;
-      Dummy_array : array (1..100) of boolean := (others => False);
-      TC_var : constant integer := -10;
- 
-      package body LA14009_1 is separate;
- 
- end LA14009_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140100.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140100.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140100.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140100.a	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- LA140100.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140102.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140102.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140102.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140100.A
- --         LA140101.A
- --         LA140102.AM
- --         LA140103.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140102.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008O baseline version
- --     29 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA14010_0 is
-      delta_v : integer := 1;
- end LA14010_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140101.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140101.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140101.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140101.a	Thu Jan  1 00:00:00 1970
***************
*** 1,89 ****
- -- LA140101.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140102.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140102.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140102.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140100.A
- --      -> LA140101.A
- --         LA140102.AM
- --         LA140103.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140102.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008O baseline version
- --     29 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified prologue to conform to coding
- --                             conventions. Changed task to task type.
- --
- --!
- 
- generic
-      type scalar is range <>;
- package LA14010_1 is
-      procedure inc (param : in out scalar);   
- end LA14010_1;
- 
- with LA14010_0;
- use LA14010_0;
- 
- package body LA14010_1 is
-      procedure inc (param : in out scalar) is
-      begin 
-           for i in 1..delta_v loop
-                param := param + 1;
-           end loop;
-      end inc;
- 
-      task type inc_task is
-           entry increment (param : in out scalar);
-      end inc_task;
- 
-      task body inc_task is separate;
- end LA14010_1;
- 
- 
- separate (LA14010_1)
- 
- task body inc_task is
-      static_zero : integer := 0;
- begin
-      accept increment (param : in out scalar) do
-           static_zero := LA14010_0.delta_v + static_zero;
-           static_zero := static_zero - LA14010_0.delta_v;
-           inc (param);
-      end increment;
- end inc_task;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140102.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140102.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140102.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140102.am	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- LA140102.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a task body depends on a package 
- --      specification.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package spec, a generic package 
- --      with a body containing a task with a body that withs the 
- --      first package spec, and a main procedure that withs the 
- --      generic package and calls the task.  Then, a new version 
- --      of the package spec is compiled (in a separate file, simulating 
- --      editing and modification of the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the package spec and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140100 (and include the results in the
- --            program library).
- --         2) Compile the file LA140101 (and include the results in the
- --            program library).
- --         3) Compile the file LA140102 (and include the results in the
- --            program library).
- --         4) Compile the file LA140103 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140100.A
- --         LA140101.A
- --      -> LA140102.AM
- --         LA140103.A 
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14010_1.INC_TASK is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008O baseline version
- --     29 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with Report; use Report;
- with LA14010_1;
- 
- procedure LA140102 is
-      subtype scalar_type is integer range 0..100;
-      TC_val : scalar_type := 0;
-      package Gen_pack is new LA14010_1(scalar_type);
- begin
-      Test ("LA14010", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit.  " &
-                       "Check the case where a task body depends " &
-                       "on a package specification");
- 
-      Gen_pack.inc(TC_val);
- 
-      if TC_val = 1 then
-           Failed ("Old package specification used");
-      elsif TC_val /= 10 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140102;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140103.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140103.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140103.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140103.a	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- LA140103.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140102.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140102.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140102.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140100.A
- --         LA140101.A
- --         LA140102.AM
- --      -> LA140103.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140102.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008O baseline version
- --     29 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA14010_0 is
-      New_var : integer := 100;
-      Local_array : array (1..51) of integer;
-      delta_v : constant integer := 10;
- end LA14010_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140110.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140110.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140110.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140110.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- LA140110.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140112.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140112.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140112.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140110.A
- --         LA140111.A
- --         LA140112.AM
- --         LA140113.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140112.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007P baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- 
- procedure LA14011_0 (Change_this : in out integer);
- 
- 
- procedure LA14011_0 (Change_this : in out integer) is
- begin
-      if Change_this = 10 then
-           Change_this := 100;
-      else 
-           Change_this := 50;
-      end if;
- end LA14011_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140111.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140111.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140111.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140111.a	Thu Jan  1 00:00:00 1970
***************
*** 1,62 ****
- -- LA140111.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140112.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140112.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140112.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140110.A
- --      -> LA140111.A
- --         LA140112.AM
- --         LA140113.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140112.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007P baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- 
- with LA14011_0;
- 
- procedure LA14011_1 (Change_this1 : in out integer);
- 
- 
- procedure LA14011_1 (Change_this1 : in out integer) is
- begin
-      LA14011_0(Change_this1);
- end LA14011_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140112.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140112.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140112.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140112.am	Thu Jan  1 00:00:00 1970
***************
*** 1,103 ****
- -- LA140112.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library procedure depends
- --      on a unit that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a procedure, a procedure that withs 
- --      the first procedure, and a procedure that withs the second
- --      procedure.  Then, a new version of the first procedure is 
- --      compiled (in a separate file, simulating an editing 
- --      modification to the package).  Unless automatic recompilation 
- --      is supported, this test should fail to link.  Otherwise, the 
- --      test should recompile and link the correct version of the 
- --      withed package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140110 (and include the results in the
- --            program library).
- --         2) Compile the file LA140111 (and include the results in the
- --            program library).
- --         3) Compile the file LA140112 (and include the results in the
- --            program library).
- --         4) Compile the file LA140113 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140110.A
- --         LA140111.A
- --      -> LA140112.AM
- --         LA140113.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14011_1 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007P baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- 
- with Report; use Report;
- with LA14011_1;              -- when LA14011_0 is revised and recompiled,
-                              -- this semantic dependency has to be 
-                              -- handled
- 
- 
- procedure LA140112 is
-      TC_val : integer := 10;
- begin
-      Test ("LA14011", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of " &
-                       "the same compilation unit.  Check the case " &
-                       "where a library procedure depends on a unit " &
-                       "that is changed");
- 
-      LA14011_1(TC_val);
- 
-      if TC_val = 100 then
-           Failed ("Revised procedure not used");
-      elsif TC_val /= -10 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140112;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140113.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140113.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140113.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140113.a	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- LA140113.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140112.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140112.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140112.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140110.A
- --         LA140111.A
- --         LA140112.AM
- --      -> LA140113.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140112.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007P baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- procedure LA14011_0 (Change_this : in out integer);
- 
- 
- procedure LA14011_0 (Change_this : in out integer) is
- begin
-      Change_this := -Change_this;
- end LA14011_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140120.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140120.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140120.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140120.a	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- LA140120.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140122.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140122.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140122.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140120.A
- --         LA140121.A
- --         LA140122.AM
- --         LA140123.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140122.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007Q baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- function LA14012_0 (Parm_1 : integer) return integer;
- 
- 
- function LA14012_0 (Parm_1 : integer) return integer is
- begin
-      if Parm_1 >= 0 then
-           return 100;
-      else 
-           return 200;
-      end if;
- end LA14012_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140121.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140121.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140121.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140121.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- LA140121.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140122.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140122.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140122.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140120.A
- --      -> LA140121.A
- --         LA140122.AM
- --         LA140123.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140122.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007Q baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- 
- with LA14012_0;
- 
- function LA14012_1 return integer;
- 
- 
- function LA14012_1 return integer is
-      Local_val : integer := 5;
- begin
-      Local_val := LA14012_0 (Parm_1 => Local_val);
-      return Local_val;
- end LA14012_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140122.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140122.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140122.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140122.am	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- LA140122.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library level function depends
- --      on a unit that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a function, a function that withs 
- --      the first function, and a procedure that withs the second
- --      function.  Then, a new version of the first function is 
- --      compiled (in a separate file, simulating an editing 
- --      modification to the package).  Unless automatic recompilation 
- --      is supported, this test should fail to link.  Otherwise, the 
- --      test should recompile and link the correct version of the 
- --      withed package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140120 (and include the results in the
- --            program library).
- --         2) Compile the file LA140121 (and include the results in the
- --            program library).
- --         3) Compile the file LA140122 (and include the results in the
- --            program library).
- --         4) Compile the file LA140123 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140120.A
- --         LA140121.A
- --      -> LA140122.AM
- --         LA140123.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14012_1 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007Q baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with Report; use Report;
- with LA14012_1;              -- when LA14012_0 is revised and recompiled,
-                              -- this semantic dependency has to be 
-                              -- handled
- 
- 
- procedure LA140122 is
-      TC_local : integer := 5;
- begin
-      Test ("LA14012", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of " &
-                       "the same compilation unit.  Check the case " &
-                       "where a library level function depends on a " &
-                       "unit that is changed");
- 
-      TC_local := LA14012_1;
- 
-      if TC_local = 100 then
-           Failed ("Revised function not used");
-      elsif TC_local /= -10 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140122;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140123.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140123.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140123.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140123.a	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- LA140123.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140122.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140122.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140122.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140120.A
- --         LA140121.A
- --         LA140122.AM
- --      -> LA140123.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140122.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007Q baseline version
- --     25 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- function LA14012_0 (Parm_1 : integer) return integer;
- 
- 
- function LA14012_0 (Parm_1 : integer) return integer is
- begin
-      return -(2 * Parm_1);
- end LA14012_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140130.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140130.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140130.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140130.a	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- LA140130.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140132.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140132.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140132.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140130.A
- --         LA140131.A
- --         LA140132.AM
- --         LA140133.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140132.AM.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007R baseline version
- --     26 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA140130 is
-      subtype TC_type is integer range 0..100;
-      TC_var : TC_type := TC_type'last;
- end LA140130;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140131.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140131.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140131.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140131.a	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- LA140131.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140132.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140132.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140132.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140130.A
- --      -> LA140131.A
- --         LA140132.AM
- --         LA140133.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140132.AM.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007R baseline version
- --     26 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with LA140130;
- 
- package LA140131 is
-      TC_local : LA140130.TC_type := LA140130.TC_var;
- end LA140131;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140132.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140132.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140132.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140132.am	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- LA140132.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library level package depends
- --      on a package specification that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package spec., a package that withs 
- --      the first package, and a procedure that withs the second
- --      package.  Then, a new version of the first package spec. is 
- --      compiled (in a separate file, simulating an editing 
- --      modification to the package).  Unless automatic recompilation 
- --      is supported, this test should fail to link.  Otherwise, the 
- --      test should recompile and link the correct version of the 
- --      withed package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140130 (and include the results in the
- --            program library).
- --         2) Compile the file LA140131 (and include the results in the
- --            program library).
- --         3) Compile the file LA140132 (and include the results in the
- --            program library).
- --         4) Compile the file LA140133 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140130.A
- --         LA140131.A
- --      -> LA140132.AM
- --         LA140133.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA140131 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007R baseline version
- --     26 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with Report; use Report;
- with LA140131;               -- when LA140130 is revised and recompiled,
-                              -- this semantic dependency has to be 
-                              -- handled
- 
- 
- procedure LA140132 is
-      TC_val : integer := 0;
- begin
-      Test ("LA14013", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of " &
-                       "the same compilation unit.  Check the case " &
-                       "where a library level package depends on a " &
-                       "package specification that is changed");
- 
-      TC_val := LA140131.TC_local;
- 
-      if TC_val = 100 then
-           Failed ("Revised package specification not used");
-      elsif TC_val /= -49 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140132;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140133.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140133.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140133.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140133.a	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- LA140133.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140132.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140132.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140132.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140130.A
- --         LA140131.A
- --         LA140132.AM
- --      -> LA140133.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140132.AM.
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007R baseline version
- --     26 MAY 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA140130 is
-      subtype TC_type is integer range -49..50;
-      TC_const : constant TC_type := TC_type'first;
-      TC_var : TC_type := TC_const;
- end LA140130;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140140.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140140.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140140.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140140.a	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- LA140140.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140142.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140142.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140142.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140140.A
- --         LA140141.A
- --         LA140142.AM
- --         LA140143.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140142.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007S baseline version
- --     26 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- procedure LA14014_0 (Change_one : in out integer) is
- begin
-      Change_one := Change_one * 5;
- end LA14014_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140141.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140141.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140141.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140141.a	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- LA140141.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140142.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140142.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140142.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140140.A
- --      -> LA140141.A
- --         LA140142.AM
- --         LA140143.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140142.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007S baseline version
- --     26 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- with LA14014_0;
- procedure LA14014_1 (Change_this : out integer) is
- begin
-      Change_this := 10;
-      LA14014_0(Change_one => Change_this);
- end LA14014_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140142.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140142.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140142.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140142.am	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- LA140142.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library level procedure depends
- --      on another library level procedure that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a procedure, a procedure that withs 
- --      the first procedure, and a procedure that withs the second
- --      procedure.  Then, a new version of the first procedure is 
- --      compiled (in a separate file, simulating and editing 
- --      modification to the procedure).  Unless automatic recompilation 
- --      is supported, this test should fail to link.  Otherwise, the 
- --      test should recompile and link the correct version of the 
- --      withed package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140140 (and include the results in the
- --            program library).
- --         2) Compile the file LA140141 (and include the results in the
- --            program library).
- --         3) Compile the file LA140142 (and include the results in the
- --            program library).
- --         4) Compile the file LA140143 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140140.A
- --         LA140141.A
- --      -> LA140142.AM
- --         LA140143.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14014_1 is missing or obsolete and no executable image
- --      results.  The test passes if an executable image is produced
- --      and reports "PASSED" (in case the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007S baseline version
- --     26 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- with Report; use Report;
- with LA14014_1;              -- when LA14014_0 is revised and recompiled,
-                              -- this semantic dependency has to be 
-                              -- handled
- 
- procedure LA140142 is
-      TC_val : integer := 0;
- begin
-      Test ("LA14014", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of " &
-                       "the same compilation unit.  Check the case " &
-                       "where a library level procedure depends on " &
-                       "another library level procedure that is changed");
- 
-      LA14014_1(TC_val);
- 
-      if TC_val = 50 then
-           Failed ("Revised procedure not used");
-      elsif TC_val = 70 then
-           Failed ("Revised procedure not used");
-      elsif TC_val /= -10 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140142;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140143.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140143.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140143.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140143.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- LA140143.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140142.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140142.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140142.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140140.A
- --         LA140141.A
- --         LA140142.AM
- --      -> LA140143.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140142.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007S baseline version
- --     26 MAY 95   SAIC        Initial version
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --
- --!
- 
- procedure LA14014_0 (Change_two : in integer := 0;
-                      Change_one : out integer) is
- begin
- 
-      if Change_two = 10 then
-           Change_one := 70;
-      elsif Change_two = 0 then
-           Change_one := -10;
-      else 
-           Change_one := 30;
-      end if;
- 
- end LA14014_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140150.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140150.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140150.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140150.a	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- LA140150.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140152.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140152.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140152.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140150.A
- --         LA140151.A
- --         LA140152.AM
- --         LA140153.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140152.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007T baseline version
- --     06 JUN 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- function LA14015_0 (Param_1 : integer) return boolean is
- begin
-      return Param_1 = 5;
- end LA14015_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140151.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140151.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140151.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140151.a	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- LA140151.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140152.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140152.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140152.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140150.A
- --      -> LA140151.A
- --         LA140152.AM
- --         LA140153.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140152.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007T baseline version
- --     06 JUN 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with LA14015_0;              -- when LA140150 is revised and recompiled,
-                              -- this semantic dependency has to be 
-                              -- handled
- 
- 
- function LA14015_1 (P : integer) return integer is
- begin
-      if LA14015_0 (Param_1 => P) then
-           return 100;
-      else 
-           return -10;
-      end if;
- end LA14015_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140152.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140152.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140152.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140152.am	Thu Jan  1 00:00:00 1970
***************
*** 1,101 ****
- -- LA140152.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library level function depends
- --      on another library level function that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a function, a function that withs and
- --      calls the first, and a procedure that withs the second
- --      function.  Then, a new version of the first function is 
- --      compiled (in a separate file, simulating an editing 
- --      modification to the function).  Unless automatic recompilation 
- --      is supported, this test should fail to link.  Otherwise, the 
- --      test should recompile and link the correct version of the 
- --      withed package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140150 (and include the results in the
- --            program library).
- --         2) Compile the file LA140151 (and include the results in the
- --            program library).
- --         3) Compile the file LA140152 (and include the results in the
- --            program library).
- --         4) Compile the file LA140153 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140150.A
- --         LA140151.A
- --      -> LA140152.AM
- --         LA140153.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14015_1 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007T baseline version
- --     06 JUN 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with Report; use Report;
- with LA14015_1;
- 
- procedure LA140152 is
-      TC_local : integer := 5;
- begin
-      Test ("LA14015", "Check that a compilation unit may " &
-                       "not depend semantically on two " &
-                       "different versions of the same " &
-                       "compilation unit.  Check the case " &
-                       "where a library level function " &
-                       "depends on another library level " &
-                       "function that is changed");
- 
-      TC_local := LA14015_1 (5);
- 
-      if TC_local = 100 then
-           Failed ("Revised unit not used");
-      elsif TC_local /= -10 then
-           Failed ("Incorrect value returned");
-      end if;
-      
-      Result;
- end LA140152;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140153.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140153.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140153.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140153.a	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- LA140153.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140152.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140152.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140152.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140150.A
- --         LA140151.A
- --         LA140152.AM
- --      -> LA140153.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140152.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007T baseline version
- --     06 JUN 95   SAIC        Initial version
- --     17 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- function LA14015_0 (Param_2 : boolean := false;
-                     Param_1 : integer := 10) return boolean is
- begin
-      if Param_2 then
-           return true;
-      else
-           return Param_1 = 10;
-      end if;
- end LA14015_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140160.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140160.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140160.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140160.a	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- LA140160.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140162.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140162.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140162.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140160.A
- --         LA140161.A
- --         LA140162.AM
- --         LA140163.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140162.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- package LA14016_0 is 
-      subtype status_code is integer range 0..10;
-      type tagged_type is abstract tagged null record;
-      function status (param : tagged_type) return status_code is abstract;
- end LA14016_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140161.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140161.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140161.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140161.a	Thu Jan  1 00:00:00 1970
***************
*** 1,63 ****
- -- LA140161.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140162.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140162.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140162.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140160.A
- --      -> LA140161.A
- --         LA140162.AM
- --         LA140162.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140162.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- with LA14016_0;
- generic 
-      type T is new LA14016_0.tagged_type with private;
-      type count_type is range <>;
- package LA14016_1 is
-      default_status : constant LA14016_0.status_code := 0;
-      type new_t is new T with 
-           record
-                count : count_type;
-           end record;
-      function status (param : new_t) return LA14016_0.status_code;
- 
-      procedure inc (param : in out new_t);
- end LA14016_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140162.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140162.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140162.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140162.am	Thu Jan  1 00:00:00 1970
***************
*** 1,196 ****
- -- LA140162.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a separate procedure depends
- --      on a withed generic package that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test declares a package which contains a generic procedure GP,
- --      the body of which is a subunit. The package also contains a procedure
- --      P which instantiates GP and calls the instance. The instance itself
- --      calls a procedure which is declared within the instance of a generic
- --      package X. The test compiles each of these compilation units and the
- --      main procedure, then compiles a new version of the generic package X
- --      (in a separate file, simulating an editing modification to the unit).
- --      Unless automatic recompilation is supported, this test should fail to
- --      link.  Otherwise, the test should recompile and link the correct
- --      version of the generic package X and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140160 (and include the results in the
- --            program library).
- --         2) Compile the file LA140161 (and include the results in the
- --            program library).
- --         3) Compile the file LA140162 (and include the results in the
- --            program library).
- --         4) Compile the file LA140163 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140160.A
- --         LA140161.A
- --      -> LA140162.AM
- --         LA140163.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14016_4.gen_def is missing or obsolete and no executable 
- --      image results.  The test also passes if an executable image is
- --      produced and reports "PASSED" (in the case where the implementation
- --      supports automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008L baseline version
- --     16 JUN 95   SAIC        Initial version
- --     07 DEC 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions. Restructured subunits
- --                             to prevent potential Program_Error due to
- --                             premature instantiation of gen_def. Moved
- --                             LA14016_1 to a separate file. Added pragma
- --                             Elaborate to context clause of LA14016_3.
- --
- --
- --!
- 
- package body LA14016_1 is
-      procedure inc (param : in out new_t) is
-      begin
-           param.count := param.count + 1; 
-      end inc;
-      function status (param : new_t) return LA14016_0.status_code is
-      begin
-           return LA14016_0.status_code(param.count);
-      end status;
- end LA14016_1;
- 
- ---------------------------------------------------------
- 
- with LA14016_0;
- package LA14016_2 is
-      type extended is new LA14016_0.tagged_type with
-           record
-                status : LA14016_0.status_code := 10;
-           end record;
-      function status (param : extended) return LA14016_0.status_code;
- end LA14016_2;
- 
- ---------------------------------------------------------
- 
- package body LA14016_2 is
-      function status (param : extended) return LA14016_0.status_code is
-      begin
-           return param.status;
-      end status;
- end LA14016_2;
- 
- ---------------------------------------------------------
- 
- with LA14016_0;
- with LA14016_1;
- with LA14016_2;
- pragma Elaborate (LA14016_1);
- package LA14016_3 is new LA14016_1 (LA14016_2.extended,
-                                     LA14016_0.status_code);
- 
- ---------------------------------------------------------
- 
- with LA14016_3;
- package LA14016_4 is
- 
-    procedure gen_caller (p1 : in out LA14016_3.new_t);
- 
-    generic
-       new_max : integer;
-    procedure gen_def (param : in out LA14016_3.new_t);
- 
- end LA14016_4;
- 
- ---------------------------------------------------------
- 
- package body LA14016_4 is
-    procedure gen_def (param : in out LA14016_3.new_t) is separate;
-    procedure gen_caller (p1 : in out LA14016_3.new_t) is separate;
- end LA14016_4;
- 
- ---------------------------------------------------------
- 
- separate (LA14016_4)
- procedure gen_def (param : in out LA14016_3.new_t) is
- begin
-      param.status := LA14016_3.default_status;  --originally 0
-                                                 --later change to 5
-      param.count := param.status;
-      LA14016_3.inc (param);
- end gen_def;
- 
- ---------------------------------------------------------
- 
- separate (LA14016_4)
- procedure gen_caller (p1 : in out LA14016_3.new_t) is
-    procedure default is new gen_def (101);
- begin
-    default (p1);
- end gen_caller;
- 
- ---------------------------------------------------------
- 
- with Report; use Report;
- with LA14016_3;
- with LA14016_4;
- with LA14016_2;
- 
- procedure LA140162 is
-      E : LA14016_3.new_t; --status defaults to 10
- begin
-      Test ("LA14016","Check that a compilation unit may not depend " &
-                      "semantically on two different versions of the " &
-                      "same compilation unit.  Check the case where a " &
-                      "separate procedure depends on a withed generic " &
-                      "package that is changed");
- 
-      LA14016_4.gen_caller (E);
-  
-      if E.status = 0 then
-           Failed ("Old generic used");
-      elsif E.status = 10 then
-           Failed ("Status not updated");
-      elsif E.status /= 5 then
-           Failed ("Wrong status value used");
-      end if;
- 
-      if E.count /= 6 then
-           Failed ("Count not properly handled");
-      end if;
- 
-      Result;
- end LA140162;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140163.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140163.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140163.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140163.a	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- -- LA140163.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140162.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140162.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140162.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140160.A
- --         LA140161.A
- --         LA140162.AM
- --      -> LA140163.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140162.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008L baseline version
- --     16 JUN 95   SAIC        Initial version
- --     07 DEC 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions and to reflect new
- --                             test file organization.
- --
- --!
- 
- with LA14016_0;
- generic 
-      type T is new LA14016_0.tagged_type with private;
-      type count_type is range <>;
- package LA14016_1 is
-      default_status : constant LA14016_0.status_code := 5;
-      type new_t is new T with 
-           record
-                count : count_type;
-           end record;
-      function status (param : new_t) return LA14016_0.status_code;
- 
-      procedure inc (param : in out new_t);
- end LA14016_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140170.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140170.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140170.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140170.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- LA140170.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140172.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140172.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140172.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140170.A
- --         LA140171.A
- --         LA140172.AM
- --         LA140173.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140172.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- package LA14017_0 is
-      type swap_type_ptr is record
-           p_all : integer;
-      end record;
-      subtype count_type is integer;
- end LA14017_0;
- 
- -----------------------------------------------------
- 
- with LA14017_0;
- use LA14017_0;
- generic
-      type swap_type is private;
- function LA14017_1 (P1, P2 : swap_type_ptr;
-                     count : count_type) return count_type;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140171.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140171.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140171.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140171.a	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- LA140171.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140172.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140172.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140172.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140170.A
- --      -> LA140171.A
- --         LA140172.AM
- --         LA140173.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140172.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- function LA14017_1 (P1, P2 : swap_type_ptr;
-                     count : count_type) return count_type is
-      temp : integer := 0;
-      count_factor : count_type := 10;
- 
-      function Inc (Param : integer) return integer;
- 
-      function Inc (Param : integer) return integer is separate;     
- 
-      procedure Swap_Ptrs (P1, P2 : in out swap_type_ptr) is
-           temp : integer := 0;
-      begin
-           temp := P1.p_all;
-           P1.p_all := P2.p_all;
-           P2.p_all := temp;
-      end Swap_Ptrs;
- 
- begin
-      return count_type (Inc (integer(count)));
- end LA14017_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140172.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140172.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140172.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140172.am	Thu Jan  1 00:00:00 1970
***************
*** 1,121 ****
- -- LA140172.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a separate function semantically 
- --      depends on a library level generic function that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic function, and a procedure that 
- --      withs the function.  Then, a new version of the generic 
- --      function body is compiled (in a separate file, simulating 
- --      and editing modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the withed function and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140170 (and include the results in the
- --            program library).
- --         2) Compile the file LA140171 (and include the results in the
- --            program library).
- --         3) Compile the file LA140172 (and include the results in the
- --            program library).
- --         4) Compile the file LA140173 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140170.A
- --         LA140171.A
- --      -> LA140172.AM
- --         LA140173.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14017_1.Inc is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008M baseline version
- --     16 JUN 95   SAIC        Initial version
- --     03 MAR 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Moved LA14017_1 to a separate file.
- --
- --!
- 
- separate (LA14017_1)     -- This dependency must be resolved 
-                          -- after LA140171.A is compiled.
- 
- function Inc (Param : integer) return integer is
- begin
-      return Param + integer (count_factor);
- end Inc;
- 
- -----------------------------------------------------
- 
- 
- with Report; use Report;
- with LA14017_1;
- with LA14017_0;
- 
- procedure LA140172 is
-      type Access_integer is access integer;
-      TC_local : integer := 0;
-      P1, P2 : LA14017_0.swap_type_ptr;
- 
-      function New_swap is new LA14017_1(swap_type => integer);
- begin
-      Test ("LA14017", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit. " &
-                       "Check the case where a separate " &
-                       "function semantically depends on a " &
-                       "library level generic function that is " &
-                       "changed");
- 
-      P1.p_all := 0;
-      P2 := P1;
-      TC_local := integer (New_swap(P1,P2,0));
- 
-      if TC_local = 10 then
-           Failed ("Revised library level function not used");
-      elsif TC_local /= -10 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140172;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140173.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140173.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140173.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140173.a	Thu Jan  1 00:00:00 1970
***************
*** 1,75 ****
- -- LA140173.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140172.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140172.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140172.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140170.A
- --         LA140171.A
- --         LA140172.AM
- --      -> LA140173.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140172.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008M baseline version
- --     16 JUN 95   SAIC        Initial version
- --     03 MAR 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- function LA14017_1 (P1, P2 : swap_type_ptr;
-                     count : count_type) return count_type is
-      count_factor : count_type := -10;
- 
-      procedure Swap_Ptrs (P1, P2 : in out swap_type_ptr) is
-           temp : integer := 0;
-      begin
-           temp := P1.p_all;
-           P1.p_all := P2.p_all;
-           P2.p_all := temp;
-      end Swap_Ptrs;
- 
-      function Inc (Param : integer) return integer;
- 
-      function Inc (Param : integer) return integer is separate;
- 
-      temp : integer := 0;
- begin
-      return count_type (Inc (integer(count)));
- end LA14017_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140180.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140180.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140180.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140180.a	Thu Jan  1 00:00:00 1970
***************
*** 1,65 ****
- -- LA140180.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140182.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140182.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140182.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140180.A
- --         LA140181.A
- --         LA140182.AM
- --         LA140183.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140182.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
-                   
- generic
-      type unsigned is mod <>;
-      mod_value : unsigned := 1;
- package LA14018_0 is
-      --types declared locally
- 
-      generic
-           type discrete is (<>);
-      package utils_18 is
-           procedure Dec (Param : in out unsigned);
- 
-           -- other utilities
-      end utils_18;
- 
-      --routines that make this generic useful
- end LA14018_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140181.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140181.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140181.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140181.a	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- -- LA140181.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140182.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140182.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140182.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140180.A
- --      -> LA140181.A
- --         LA140182.AM
- --         LA140183.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140182.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
-                   
- package body LA14018_0 is
-      offset : constant unsigned := mod_value;
-      
-      package body utils_18 is separate;
- end LA14018_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140182.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140182.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140182.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140182.am	Thu Jan  1 00:00:00 1970
***************
*** 1,118 ****
- -- LA140182.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a separate generic package body depends
- --      on a library level generic package body that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic package and its body, and a
- --      procedure that withs the generic package.  Then a new 
- --      version of the generic package body is compiled (in a 
- --      separate file, simulating and editing modification to the
- --      unit).  Unless automatic recompilation is supported, this
- --      test should fail to link.  Otherwise, the test should 
- --      recompile and link the correct version of the with package
- --      withed package and report "PASSED" at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140180 (and include the results in the
- --            program library).
- --         2) Compile the file LA140181 (and include the results in the
- --            program library).
- --         3) Compile the file LA140182 (and include the results in the
- --            program library).
- --         4) Compile the file LA140183 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140180.A
- --         LA140181.A
- --      -> LA140182.AM
- --         LA140183.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14018_0.utils_18 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008N baseline version
- --     16 JUN 95   SAIC        Initial version
- --     07 DEC 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions. Moved instantiation
- --                             of utils_18 to avoid potential Program_Error.
- --                             Moved LA14018_0 to a separate file.
- --
- --!
-                   
- separate (LA14018_0)        -- This dependency must be resolved
-                             -- after LA140181.A is compiled.
- package body utils_18 is
-      procedure Dec (Param : in out unsigned) is 
-      begin 
-           Param := Param - offset;
-      end Dec;
- end utils_18;
- 
- --------------------------------------------------------
- 
- with Report; use Report;
- with LA14018_0;
- procedure LA140182 is
-      type mod_4 is mod 4; -- 0, 1, 2, 3, 0, 1,...
-      TC_var : mod_4 := 2;
- 
-      package Mod_stuff is new LA14018_0 (mod_4);
-      package unsigned_utils is new Mod_stuff.utils_18 (mod_4);
- begin
-      Test ("LA14018", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit. "&
-                       "Check the case where a separate package " &
-                       "body depends on a library level generic " &
-                       "package body that is changed");
- 
-      unsigned_utils.Dec (TC_var);
- 
-      if TC_var = 2 then
-           Failed ("Dec routine did not work");
-      elsif TC_var = 1 then
-           Failed ("New body for LA14018_0 not used");
-      elsif TC_var /= 3 then 
-           Failed ("Unexpected result produced");
-      end if;
- 
-      Result;
- end LA140182;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140183.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140183.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140183.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140183.a	Thu Jan  1 00:00:00 1970
***************
*** 1,60 ****
- -- LA140183.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140182.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140182.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140182.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140180.A
- --         LA140181.A
- --         LA140182.AM
- --      -> LA140183.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140182.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008N baseline version
- --     16 JUN 95   SAIC        Initial version
- --     07 DEC 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions, and to reflect new test
- --                             file organization.
- --
- --!
- 
- package body LA14018_0 is
-      New_TC_var : integer := 101;
-      New_array : array (1..101) of integer := (others => 0);
-      offset : constant unsigned := mod_value + 2;
-      
-      package body utils_18 is separate;
- end LA14018_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140190.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140190.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140190.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140190.a	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- LA140190.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140192.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140192.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140192.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140190.A
- --         LA140191.A
- --         LA140192.AM
- --         LA140193.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140192.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008P baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- procedure LA14019_0 (Param : in out integer);
- 
- 
- procedure LA14019_0 (Param : in out integer) is
-      TC_offset : constant integer := 1;
- begin
-      Param := Param + TC_offset;
- end LA14019_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140191.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140191.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140191.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140191.a	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- LA140191.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140192.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140192.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140192.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140190.A
- --      -> LA140191.A
- --         LA140192.AM
- --         LA140193.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140192.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008P baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- generic
-      type integer_type is range <>;
- procedure LA14019_1 (Test_val : in out integer);
- 
- with LA14019_0;
- procedure LA14019_1 (Test_val : in out integer) is
-      arr : array (1..5) of integer;
-      sum : integer := 0;
-      temp_val : integer := 0;
- begin
-      arr(1) := Test_val;
-      for i in 2..arr'last loop
-           temp_val := arr(i-1);
-           LA14019_0 (temp_val);
-           arr(i) := temp_val;
-      end loop;
-      for i in 1..arr'last loop
-           sum := sum + arr(i);
-      end loop;
-      Test_val := sum;
- end LA14019_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140192.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140192.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140192.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140192.am	Thu Jan  1 00:00:00 1970
***************
*** 1,107 ****
- -- LA140192.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library level generic procedure
- --      depends on library level procedure that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a procedure, a generic procedure that 
- --      withs the first procedure and a main procedure that withs
- --      the generic procedure.  Then, a new version of the  
- --      procedure is compiled (in a separate file, simulating 
- --      and editing modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the withed function and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140190 (and include the results in the
- --            program library).
- --         2) Compile the file LA140191 (and include the results in the
- --            program library).
- --         3) Compile the file LA140192 (and include the results in the
- --            program library).
- --         4) Compile the file LA140193 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140190.A
- --         LA140191.A
- --      -> LA140192.AM
- --         LA140193.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA140192 is missing or obsolete, or that LA14019_1 is 
- --      missing or obsolete (optional) and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008P baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with Report; use Report;
- with LA14019_1;       -- This dependency must be resolved
-                       -- after LA140193 is compiled.
- 
- procedure LA140192 is
-      subtype count is integer range 0..100;
-      procedure Gen_proc is new LA14019_1 (count);
-      TC_local : count := 0;
- begin
-      Test ("LA14019", "Check that a compilation unit may " &
-                       "not depend semantically on two " &
-                       "different versions of the same " &
-                       "compilation unit.  Check the case " &
-                       "where a library level generic " &
-                       "procedure depends on library level " &
-                       "procedure that is changed.");
- 
-      Gen_proc (TC_local);
- 
-      if TC_local = 10 then
-           Failed ("Revised library level procedure not used");
-      elsif TC_local /= 52 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140192;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140193.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140193.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140193.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140193.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- LA140193.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140192.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140192.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140192.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140190.A
- --         LA140191.A
- --         LA140192.AM
- --      -> LA140193.A 
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140192.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008P baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     17 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- procedure LA14019_0 (Param : in out integer);
- 
- 
- procedure LA14019_0 (Param : in out integer) is
-      Local_array : array (1..10) of float := (others => 0.0);
-      Local_var : integer := 0;
-      TC_var : constant integer := -9;
- 
- begin
-      Param := (1 + Param) * 2;
- end LA14019_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140200.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140200.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140200.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140200.a	Thu Jan  1 00:00:00 1970
***************
*** 1,76 ****
- -- LA140200.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140202.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140202.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140202.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140200.A
- --         LA140201.A
- --         LA140202.AM
- --         LA140203.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140202.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008Q baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --                             Reworded objective. Moved instance to
- --                             library-level and redesigned to use generic
- --                             formal function. Fixed arithmetic errors.
- --
- --!
- 
- package LA14020_0 is
- 
-      subtype apples is integer range 0..100;
-      subtype oranges is integer range 0..200;
- 
-      type Fruit_Basket is tagged record
-         App : apples;
-         Ora : oranges;
-      end record;
- 
- end LA14020_0;
- 
-     --==================================================================--
- 
- package LA14020_0.LA14020_1 is
- 
-     type Bigger_Basket is new Fruit_Basket with record
-        Total : integer;
-     end record;
- 
- end LA14020_0.LA14020_1;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140201.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140201.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140201.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140201.a	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- LA140201.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140202.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140202.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140202.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140200.A
- --      -> LA140201.A
- --         LA140202.AM
- --         LA140203.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140202.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008Q baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --                             Reworded objective. Moved instance to
- --                             library-level and redesigned to use generic
- --                             formal function. Fixed arithmetic errors.
- --
- --!
- 
- with LA14020_0;
- generic
-      type Basket is new LA14020_0.Fruit_Basket with private;
- function LA14020_2 (Left, Right : Basket) return Basket;
- 
-     --==================================================================--
- 
- function LA14020_2 (Left, Right : Basket) return Basket is
-    Result : Basket;
- begin
-    Result.App := Left.App + Left.App;
-    Result.Ora := Right.Ora + Right.Ora;
-         -- wrong algorithm, to be corrected later
- 
-    return Result;
- end LA14020_2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140202.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140202.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140202.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140202.am	Thu Jan  1 00:00:00 1970
***************
*** 1,144 ****
- -- LA140202.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a library level instance depends on
- --      a library level generic function whose body is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic function, an instance of a generic
- --      function that withs the first function and a main procedure that 
- --      withs the instance.  Then a new version of the first generic function
- --      is compiled (in a separate file, simulating editing and modification
- --      of the unit).  Unless automatic recompilation is supported, this
- --      test should fail to link. Otherwise, the test should recompile and
- --      link the correct version of the withed function and report "PASSED"
- --      at execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140200 (and include the results in the
- --            program library).
- --         2) Compile the file LA140201 (and include the results in the
- --            program library).
- --         3) Compile the file LA140202 (and include the results in the
- --            program library).
- --         4) Compile the file LA140203 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140200.A
- --         LA140201.A
- --      -> LA140202.AM
- --         LA140203.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA140202 is missing or obsolete, or that LA14020_3 or LA14020_4
- --      is missing or obsolete (optional) and no executable image
- --      results.  The test passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation
- --      supports automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008Q baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --                             Reworded objective. Moved instance to
- --                             library-level and redesigned to use generic
- --                             formal function. Fixed arithmetic errors.
- --
- --!
- 
- with LA14020_0.LA14020_1;
- with LA14020_2;
- pragma Elaborate (LA14020_2);
- function LA14020_3 is new LA14020_2 (LA14020_0.LA14020_1.Bigger_Basket);
- 
-     --==================================================================--
- 
- with LA14020_0.LA14020_1;
- generic
-      type Market_Basket is new LA14020_0.LA14020_1.Bigger_Basket with private;
-      with function "+" (L,R: Market_Basket) return Market_Basket is <>;
- function LA14020_4 (B1, B2 : Market_Basket) return Market_Basket;
- 
-     --==================================================================--
- 
- with LA14020_3;
- function LA14020_4 (B1, B2 : Market_Basket) return Market_Basket is
-    Result : Market_Basket;
- begin
-    Result := B1 + B2;
-    Result.Total := integer (Result.App) + integer (Result.Ora);
-    return Result;
- end LA14020_4;
- 
-     --==================================================================--
- 
- with Report;
- 
- with LA14020_0.LA14020_1;
- with LA14020_3;
- with LA14020_4;
- 
- procedure LA140202 is
-    package Child renames LA14020_0.LA14020_1;
- 
-    Basket_1 : Child.Bigger_Basket := (App => 5, Ora => 20, Total => 0);
-    Basket_2 : Child.Bigger_Basket := (App => 7, Ora =>  3, Total => 0);
- 
-    function Total is new LA14020_4 (Child.Bigger_Basket, LA14020_3);
- begin
-      Report.Test ("LA14020", "Check that a compilation unit may "  &
-                              "not depend semantically on two "     &
-                              "different versions of the same "     &
-                              "compilation unit. Check the case "   &
-                              "where a library level instance "     &
-                              "depends on a library level generic " &
-                              "function whose body is changed");
- 
-      Basket_1 := Total (Basket_1, Basket_2);
- 
-      if    Basket_1.App    = 10 or
-            Basket_1.Ora    =  6 or
-            Basket_1.Total  = 16
-      then
-         Report.Failed ("Revised generic function not used");
-      elsif Basket_1.App   /= 12 or
-            Basket_1.Ora   /= 23 or
-            Basket_1.Total /= 35 then
-         Report.Failed ("Incorrect result returned");
-      end if;
- 
-      Report.Result;
- end LA140202;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140203.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140203.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140203.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140203.a	Thu Jan  1 00:00:00 1970
***************
*** 1,71 ****
- -- LA140203.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140202.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140202.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140202.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140200.A
- --         LA140201.A
- --         LA140202.AM
- --      -> LA140203.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140202.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008Q baseline version
- --     23 JUN 95   SAIC        Initial version
- --     29 FEB 96   SAIC        First revision after review
- --     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
- --                             Reworded objective. Moved instance to
- --                             library-level and redesigned to use generic
- --                             formal function. Fixed arithmetic errors.
- --
- --!
- 
- with LA14020_0;
- generic
-      type Basket is new LA14020_0.Fruit_Basket with private;
- function LA14020_2 (Left, Right : Basket) return Basket;
- 
-     --==================================================================--
- 
- function LA14020_2 (Left, Right : Basket) return Basket is
-    Result : Basket;
- begin
-    Result.App := Left.App + Right.App;
-    Result.Ora := Left.Ora + Right.Ora;
-         -- correct algorithm
- 
-    return Result;
- end LA14020_2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140210.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140210.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140210.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140210.a	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- LA140210.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140211.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140211.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140211.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140210.A
- --         LA140211.AM
- --         LA140212.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140211.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- generic
-      type swap_type is private;
-      type int_type is range <>;
-      times : int_type :=1;
- package LA14021_0 is
-      procedure swap (this, for_that : in out swap_type);
- end LA14021_0;
- 
- ---------------------------------------------------------
- 
- package body LA14021_0 is
-      procedure swap (this, for_that : in out swap_type) is
-           temp : swap_type;
-      begin
-           for i in int_type'first..times loop
-                temp := this;
-                this := for_that;
-                for_that := temp;
-           end loop;
-      end swap;
- end LA14021_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140211.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140211.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140211.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140211.am	Thu Jan  1 00:00:00 1970
***************
*** 1,134 ****
- -- LA140211.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic package depends on another
- --      generic package that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic package, a second generic 
- --      package that withs the first and a main procedure that  
- --      withs the second package.  Then, a new version of the  
- --      first package is compiled (in a separate file, simulating 
- --      editing and modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the withed function and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140210 (and include the results in the
- --            program library).
- --         2) Compile the file LA140211 (and include the results in the
- --            program library).
- --         3) Compile the file LA140212 (and include the results in the
- --            program library).
- --         4) Attempt to build an executable image.
- --         5) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140210.A
- --      -> LA140211.AM
- --         LA140212.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14021_1 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008R baseline version
- --     23 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Moved LA14021_0 to a separate file.
- --
- --!
- 
- package LA14021_1 is
-      type data_record is tagged 
-           record
-           info : character;
-           end record;
-      subtype loop_count is integer range 1..100;
-      type data_type is new data_record  with
-           record
-                 serial : integer := 0;
-           end record;
- end LA14021_1;
- 
- ---------------------------------------------------------
- 
- with LA14021_1;
- with LA14021_0;
- generic     
-      type data_rec is new LA14021_1.data_record with private;
- package LA14021_2 is
-      package util is new LA14021_0 (character, LA14021_1.loop_count);
-      procedure flip_flop (rec1, rec2 : in out data_rec);
- end LA14021_2;
- 
- ---------------------------------------------------------
- 
- package body LA14021_2 is
-      procedure flip_flop (rec1, rec2 : in out data_rec) is
-      begin
-           util.swap (rec1.info, rec2.info);
-     end flip_flop;
- end LA14021_2;
- 
- ---------------------------------------------------------
- 
- with Report; use Report;
- with LA14021_1;
- with LA14021_2;
- 
- procedure LA140211 is
-      package util is new LA14021_2 (LA14021_1.data_type);
-      datum_1 : LA14021_1.data_type := LA14021_1.data_type'('a', 1);
-      datum_2 : LA14021_1.data_type := LA14021_1.data_type'('b', 2);
- begin
-      Test ("LA14021", "Check that a compilation unit may " &
-                       "not depend semantically on two " &
-                       "different versions of the same " &
-                       "compilation unit.  Check the case " &
-                       "where a generic package depends on " &
-                       "another generic package that is changed");
- 
-      util.flip_flop (datum_1, datum_2);
-      if datum_1.info = 'b' then
-           Failed ("Revised unit not used");
-      elsif datum_1.info /= 'a' then 
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140211;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140212.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140212.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140212.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140212.a	Thu Jan  1 00:00:00 1970
***************
*** 1,74 ****
- -- LA140212.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140211.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140211.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140211.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140210.A
- --         LA140211.AM
- --      -> LA140212.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140211.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008R baseline version
- --     23 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- generic
-      type swap_type is private;
-      type int_type is range <>;
-      times : int_type :=2; --this line contains the change
- package LA14021_0 is
-      procedure swap (this, for_that : in out swap_type);
- end LA14021_0;
- 
- ---------------------------------------------------------
- 
- package body LA14021_0 is
-      procedure swap (this, for_that : in out swap_type) is
-           temp : swap_type;
-      begin
-           for i in int_type'first..times loop
-                temp := this;
-                this := for_that;
-                for_that := temp;
-           end loop;
-      end swap;
- end LA14021_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140220.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140220.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140220.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140220.a	Thu Jan  1 00:00:00 1970
***************
*** 1,64 ****
- -- LA140220.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140221.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140221.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140221.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140220.A
- --         LA140221.AM
- --         LA140222.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140221.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- generic
-      type stuff is private;
-      type ptr is access stuff;
-      type return_result is range <>;
-      delta_val : return_result := 1;
- procedure LA14022_0 (pointer : in out ptr;
-                       result : in out return_result);
- 
- -------------------------------------------------------
- 
- procedure LA14022_0 (pointer : in out ptr;
-                       result : in out return_result) is
- begin
-      pointer := new stuff;
-      result := result + delta_val;
- end LA14022_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140221.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140221.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140221.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140221.am	Thu Jan  1 00:00:00 1970
***************
*** 1,128 ****
- -- LA140221.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic instantiation depends on
- --      a generic procedure that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic procedure, a second generic 
- --      procedure, a generic instantiation of the second procedure 
- --      that depends on both the first and second generic
- --      procedures, and a main procedure that withs the instantiated
- --      procedure.  Then, a new version of the first generic  
- --      procedure is compiled (in a separate file, simulating 
- --      editing and modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the withed function and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140220 (and include the results in the
- --            program library).
- --         2) Compile the file LA140221 (and include the results in the
- --            program library).
- --         3) Compile the file LA140222 (and include the results in the
- --            program library).
- --         4) Attempt to build an executable image.
- --         5) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140220.A
- --      -> LA140221.AM
- --         LA140222.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14022_2 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008S baseline version
- --     23 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Moved LA14022_0 to a separate file. Added
- --                             pragma Elaborate to context clause of
- --                             LA14022_2.
- --
- --!
- 
- package LA14022_1 is
-      type rec_ptr; 
-      type rec is record
-           data : integer;
-      end record;
-      type rec_ptr is access rec;
-      subtype data_int is integer range 0..100;
- end LA14022_1;
- 
- 
- with LA14022_0;
- with LA14022_1;
- pragma Elaborate (LA14022_0);
- procedure LA14022_2 is new 
-      LA14022_0 (stuff => LA14022_1.rec,
-                 ptr => LA14022_1.rec_ptr,
-                 return_result => LA14022_1.data_int,
-                 delta_val => 50);
- 
- with Report;
- use Report;
- with LA14022_2;
- with LA14022_1;
- use LA14022_1;
- procedure LA140221 is
-      TC_val : LA14022_1.data_int := 10;
-      P, Q : LA14022_1.rec_ptr;
- begin
-      Test ("LA14022", "Check that a compilation unit may not " & 
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit. " &
-                       "Check the case where a generic " &
-                       "instantiation depends on a generic " &
-                       "procedure that is changed");
- 
-      Q := P;
-      LA14022_2 (Q, TC_val);
- 
-      if Q /= P then
-           Failed ("Wrong procedure result");
-      end if;
-      if TC_val = 60 then
-           Failed ("Old instantiation used");
-      elsif TC_val /= 10 then
-           Failed ("Wrong result");
-      end if;
- 
-      Result;
- end LA140221;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140222.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140222.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140222.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140222.a	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- -- LA140222.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140221.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140221.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140221.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140220.A
- --         LA140221.AM
- --      -> LA140222.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140221.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008S baseline version
- --     23 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- generic
-      type stuff is private;
-      type ptr is access stuff;
-      type return_result is range <>;
-      delta_val : return_result := 1;
- procedure LA14022_0 (pointer : in out ptr;
-                       result : in out return_result);
- 
- -------------------------------------------------------
- 
- procedure LA14022_0 (pointer : in out ptr;
-                       result : in out return_result) is
- begin
-      pointer := null;
-      result := result + return_result'first;
- end LA14022_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140240.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140240.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140240.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140240.a	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- LA140240.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140242.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140242.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140242.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140240.A
- --         LA140241.A
- --         LA140242.AM
- --         LA140243.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140242.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008U baseline version
- --     29 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- generic
-      Local_max : positive;
-      type Thing is private;
- package LA14024_0 is
-      type Goodies is tagged
-           record
-                X, Y : integer := 100;
-           end record;
- end LA14024_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140241.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140241.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140241.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140241.a	Thu Jan  1 00:00:00 1970
***************
*** 1,55 ****
- -- LA140241.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140242.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140242.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140242.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140240.A
- --      -> LA140241.A
- --         LA140242.AM
- --         LA140243.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140242.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008U baseline version
- --     29 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with LA14024_0;
- 
- package LA14024_1 is new LA14024_0 (100, integer);
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140242.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140242.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140242.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140242.am	Thu Jan  1 00:00:00 1970
***************
*** 1,104 ****
- -- LA140242.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic instantiation depends on
- --      a generic package that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic package, a generic
- --      instantiation of the generic package, and a main
- --      procedure that withs the instantiated generic 
- --      package.  Then, a new version of the first generic  
- --      package is compiled (in a separate file, simulating 
- --      editing and modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the withed package and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140240 (and include the results in the
- --            program library).
- --         2) Compile the file LA140241 (and include the results in the
- --            program library).
- --         3) Compile the file LA140242 (and include the results in the
- --            program library).
- --         4) Compile the file LA140243 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140240.A
- --         LA140241.A
- --      -> LA140242.AM
- --         LA140243.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA140242 is missing or obsolete, or that LA14024_1 is 
- --      missing or obsolete (optional) and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008U baseline version
- --     29 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with Report; use Report;
- with LA14024_1;
- 
- procedure LA140242 is
-      TC_val : integer := 0;
-      Local_goodies : LA14024_1.Goodies;
- begin
-      Test ("LA14024", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit.  " &
-                       "Check the case where a generic " &
-                       "instantiation depends on a generic " &
-                       "package that is changed");
- 
-      TC_val := Local_goodies.X;
- 
-      if TC_val = 100 then
-           Failed ("Revised generic package not used");
-      elsif TC_val /= -10 then 
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140242;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140243.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140243.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140243.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140243.a	Thu Jan  1 00:00:00 1970
***************
*** 1,61 ****
- -- LA140243.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140242.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140242.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140242.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140240.A
- --         LA140241.A
- --         LA140242.AM
- --      -> LA140243.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140242.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008U baseline version
- --     29 JUN 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- generic
-      Local_max : positive;
-      type Thing is private;
- package LA14024_0 is
-      type Goodies is tagged
-           record
-                Y, X : integer := -10;
-           end record;
- end LA14024_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140250.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140250.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140250.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140250.a	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- LA140250.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     See LA140251.AM.
- --
- -- TEST DESCRIPTION:
- --     See LA140251.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --     See LA140251.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140050.A
- --         LA140051.AM
- --         LA140052.A
- --
- -- PASS/FAIL CRITERIA:
- --     See LA140251.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- package LA14025_0 is
-      subtype byte is integer range 0..511;
-      byte_val : constant byte := 128;
-      type Data_rec is tagged record
-           Id : integer := 1;
-           Val: byte := byte_val;
-      end record;
- end LA14025_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140251.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140251.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140251.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140251.am	Thu Jan  1 00:00:00 1970
***************
*** 1,141 ****
- -- LA140251.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic instantiation depends on
- --      a non-generic package that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package, a generic package, a 
- --      generic instantiation that withs both of the first two
- --      packages, and a main procedure that withs the instantiated 
- --      generic package.  Then, a new version of the first   
- --      package is compiled (in a separate file, simulating 
- --      editing and modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the withed package and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140250 (and include the results in the
- --            program library).
- --         2) Compile the file LA140251 (and include the results in the
- --            program library).
- --         3) Compile the file LA140252 (and include the results in the
- --            program library).
- --         4) Attempt to build an executable image.
- --         5) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140250.A
- --      -> LA140251.AM
- --         LA140252.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14025 is missing or obsolete, or that LA14025_2 is 
- --      missing or obsolete (optional) and no executable image
- --      results.  The test passes if an executable image is produced
- --      and reports "PASSED" (in case the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008V baseline version
- --     06 JUL 95   SAIC        Initial version
- --     08 NOV 96   SAIC        Unit naming correction
- --     07 DEC 96   SAIC        Moved LA14025_0 to a separate file. Added
- --                             pragma Elaborate to context clause of
- --                             LA14025_2.
- --
- --!
- 
- with LA14025_0;
- generic
-      type your_addition is (<>);
- package LA14025_1 is          --extensions, utilities
-      type extended_record is new LA14025_0.data_rec with record
-           new_data : your_addition;
-      end record;
-      procedure stuff (param : your_addition);
-      function fetch (param : LA14025_0.byte) return LA14025_0.byte;
- private
-      obj : extended_record;
- end LA14025_1;
- 
- ---------------------------------------------
- 
- package body LA14025_1 is
-      procedure stuff (param : your_addition) is
-      begin
-           obj.new_data := param; 
-      end stuff;
- 
-      function fetch (param : LA14025_0.byte) return LA14025_0.byte is
-      begin
-           return (param + obj.val);
-      end fetch;
- end LA14025_1;
- 
- ---------------------------------------------
- 
- with LA14025_0;
- with LA14025_1;
- pragma Elaborate (LA14025_1);
- package LA14025_2 is new LA14025_1 (LA14025_0.byte);
- 
- ---------------------------------------------
- 
- with Report; use Report;
- with LA14025_2;
- with LA14025_0;
- procedure LA140251 is
-      TC_val : LA14025_0.byte := 0;
-      Temp_var : LA14025_2.extended_record;
- begin
-      Test ("LA14025", "Check that a compilation unit may not " &
-                       "depend semantically on two different " &
-                       "versions of the same compilation unit.  " &
-                       "Check the case where a generic " &
-                       "instantiation depends on a non-generic " &
-                       "package that is changed");
- 
-      LA14025_2.stuff(10);
-      
-      TC_val := LA14025_2.fetch (Temp_var.val);
- 
-      if TC_val = 256 then
-           Failed ("Old version of package used");
-      elsif TC_val /= 128 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140251;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140252.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140252.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140252.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140252.a	Thu Jan  1 00:00:00 1970
***************
*** 1,59 ****
- -- LA140252.A 
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --     See LA140251.AM.
- --
- -- TEST DESCRIPTION:
- --     See LA140251.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --     See LA140251.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140050.A
- --         LA140051.AM
- --      -> LA140052.A
- --
- -- PASS/FAIL CRITERIA:
- --     See LA140251.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008V baseline version
- --     06 JUL 95   SAIC        Initial version
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- package LA14025_0 is
-      subtype byte is integer range 0..511;
-      byte_val : constant byte := 64;
-      type Data_rec is tagged record
-           Id : integer := 1;
-           Val: byte := byte_val;
-      end record;
- end LA14025_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140260.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140260.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140260.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140260.a	Thu Jan  1 00:00:00 1970
***************
*** 1,98 ****
- -- LA140260.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140262.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140262.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140262.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140260.A
- --         LA140261.A
- --         LA140262.AM
- --         LA140263.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140262.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- package LA14026_0 is
-      type basic_rec is tagged 
-           record 
-                null;
-           end record;
- end LA14026_0;
- 
- ---------------------------------------------------------
- 
- with LA14026_0;
- generic
-      type data_type is private;
-      type serial_type is range <>;
-      serial_init : serial_type;
- package LA14026_1 is
- 
-      pragma Elaborate_Body;
- 
-      function get_serial_num return serial_type;
- 
-      type node_type is new LA14026_0.basic_rec with 
-           record
-                data_field : data_type;
-                serial_no : serial_type := get_serial_num;
-           end record;
- end LA14026_1;
- 
- ---------------------------------------------------------
- 
- package body LA14026_1 is
-      serial : serial_type := serial_init;
-      function get_serial_num return serial_type is
-      begin
-           serial := serial + 1;
-           return serial;
-      end;
- end LA14026_1;
- 
- ---------------------------------------------------------
- 
- package LA14026_2 is
-      subtype serial_type is integer range 0..5;
-      subtype data_type is integer range 0..100;
- 
-      type data_rec is record
-           F1 : data_type := data_type'first;
-           F2 : data_type := data_type'last;
-      end record;
- end LA14026_2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140261.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140261.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140261.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140261.a	Thu Jan  1 00:00:00 1970
***************
*** 1,52 ****
- -- LA140261.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140262.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140262.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140262.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140260.A
- --      -> LA140261.A
- --         LA140262.AM
- --         LA140263.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140262.AM.
- --
- -- CHANGE HISTORY:
- --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
- --
- --!
- 
- with LA14026_2, LA14026_1;
- package LA14026_3 is new LA14026_1 (LA14026_2.data_rec, 
-                                     LA14026_2.serial_type, 0);
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140262.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140262.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140262.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140262.am	Thu Jan  1 00:00:00 1970
***************
*** 1,140 ****
- -- LA140262.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a generic instantiation depends on
- --      a generic package instantiation that is changed.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a generic package, a generic  
- --      instantiation of the generic package, another generic   
- --      package, a generic instantiation of the second generic  
- --      package that withs the first generic instantiation 
- --      packages, and a main procedure that withs the instantiated 
- --      generic package.  Then, a new version of the first generic  
- --      package is compiled (in a separate file, simulating 
- --      editing and modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the instantiation and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140260 (and include the results in the
- --            program library).
- --         2) Compile the file LA140261 (and include the results in the
- --            program library).
- --         3) Compile the file LA140262 (and include the results in the
- --            program library).
- --         4) Compile the file LA140263 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140260.A
- --         LA140261.A
- --      -> LA140262.AM
- --         LA140263.A
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA140260 is missing or obsolete, or that LA14026_5 is 
- --      missing or obsolete (optional) and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008W baseline version
- --     06 JUL 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Moved LA14026_3 to a separate file. Added
- --                             pragma Elaborate to context clause of LA14026_5.
- --
- --!
- 
- with LA14026_0;
- generic
-      type rec is new LA14026_0.basic_rec with private;
- package LA14026_4 is
-      type extended_node;
-      type extended_node_ptr is access extended_node;
-      type extended_node is new rec with 
-           record
-                next : extended_node_ptr := null;
-           end record;
-      procedure add_next (node : in out extended_node; ptr : extended_node_ptr);
- end LA14026_4;
- 
- ---------------------------------------------------------
-  
- package body LA14026_4 is
-      procedure add_next (node : in out extended_node; 
-                          ptr : extended_node_ptr) is
-      begin
-           node.next := ptr;
-      end add_next;
- end LA14026_4;
- 
- ---------------------------------------------------------
- 
- with LA14026_3, LA14026_4;
- pragma Elaborate (LA14026_4);
- package LA14026_5 is new LA14026_4 (LA14026_3.node_type);
- 
- ---------------------------------------------------------
- 
- with Report;
- use Report;
- with LA14026_5;
- 
- procedure LA140262 is
-      root : LA14026_5.extended_node_ptr := new LA14026_5.extended_node;
-      next : LA14026_5.extended_node_ptr := new LA14026_5.extended_node;
- begin
-      Test ("LA14026","Check that a compilation unit may not depend " &
-                      "semantically on two different versions of " &
-                      "the same compilation unit.  Check the case " &
-                      "where a generic instantiation depends on " &
-                      "a generic package instantiation that is " &
-                      "changed");
- 
-      
-      LA14026_5.add_next (root.all, next);
- 
-      if root.all.next.serial_no = 2 then
-           Failed ("Old version of unit used");
-      elsif root.all.next.serial_no /= 5 then
-           Failed ("Wrong value returned");
-      end if;
- 
-      Result;
- end LA140262;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140263.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140263.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140263.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140263.a	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- -- LA140263.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140262.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140262.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140262.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140260.A
- --         LA140261.A
- --         LA140262.AM
- --      -> LA140263.A
- --
- -- PASS/FAIL CRITERIA:                
- --      See LA140262.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5008W baseline version
- --     06 JUL 95   SAIC        Initial version
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --     07 DEC 96   SAIC        Modified prologue to reflect new test
- --                             file organization.
- --
- --!
- 
- with LA14026_2, LA14026_1;
- package LA14026_3 is new LA14026_1 (LA14026_2.data_rec, 
-                                     LA14026_2.serial_type, 3);
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140270.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140270.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140270.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140270.a	Thu Jan  1 00:00:00 1970
***************
*** 1,56 ****
- -- LA140270.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140272.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140272.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140272.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --      -> LA140270.A
- --         LA140271.A
- --         LA140272.AM
- --         LA140273.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140272.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007O baseline version
- --     28 JUL 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     18 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA14027_0 is
-      Sample_value : integer := 100;
- end LA14027_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140271.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140271.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140271.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140271.a	Thu Jan  1 00:00:00 1970
***************
*** 1,93 ****
- -- LA140271.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140272.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140272.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140272.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140270.A
- --      -> LA140271.A
- --         LA140272.AM
- --         LA140273.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140272.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007O baseline version
- --     28 JUL 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions. Removed loop from
- --                             task body to prevent hang.
- --
- --!
- 
- package LA14027_1 is
-      procedure Random (Number : out integer);
- end LA14027_1;
- 
-   --------------------------------------------
- 
- package body LA14027_1 is
-      task LA14027_2 is
-           entry Get (Value : out integer);
-      end LA14027_2;
- 
-      task body LA14027_2 is separate;
- 
-      procedure Random (Number : out integer) is
-      begin
-           -- get a random number from sampling task
-           LA14027_2.Get (Number);
-           -- massage it
-           Number := Number + 10;
-           -- and return it
-      end;
- end LA14027_1;
- 
-   --------------------------------------------
- 
- with LA14027_0;  -- must resolve this
- 
- separate (LA14027_1)
- 
- task body LA14027_2 is
-      begin
-           select
-                accept Get (Value : out integer) do
-                     -- sample some random physical process
-                     Value := LA14027_0.Sample_value;
-                     -- and return it
-                end Get;
-           end select;
- end LA14027_2;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140272.am gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140272.am
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140272.am	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140272.am	Thu Jan  1 00:00:00 1970
***************
*** 1,102 ****
- -- LA140272.AM
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      Check that a compilation unit may not depend semantically
- --      on two different versions of the same compilation unit.
- --      Check the case where a task body depends on non-generic 
- --      package specification.
- --
- -- TEST DESCRIPTION:
- --      This test compiles a package spec, another package 
- --      with a body containing a task with a body that withs the 
- --      first package spec, and a main procedure that withs the 
- --      second package.  Then, a new version of the first package
- --      spec is compiled (in a separate file, simulating 
- --      editing and modification to the unit).  Unless automatic 
- --      recompilation is supported, this test should fail to link.  
- --      Otherwise, the test should recompile and link the correct 
- --      version of the package spec and report "PASSED" at 
- --      execution time.
- --
- -- SPECIAL REQUIREMENTS:
- --      To build this test:
- --         1) Compile the file LA140270 (and include the results in the
- --            program library).
- --         2) Compile the file LA140271 (and include the results in the
- --            program library).
- --         3) Compile the file LA140272 (and include the results in the
- --            program library).
- --         4) Compile the file LA140273 (and include the results in the
- --            program library).
- --         5) Attempt to build an executable image.
- --         6) If an executable image results, run it.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140270.A
- --         LA140271.A
- --      -> LA140272.AM
- --         LA140273.A 
- --
- -- PASS/FAIL CRITERIA:    
- --      The test passes if a link time error message reports that 
- --      LA14027_1.LA14027_2 is missing or obsolete and no executable image
- --      results.  The test also passes if an executable image is produced
- --      and reports "PASSED" (in the case where the implementation supports
- --      automatic recompilation).            
- --
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007O baseline version
- --     28 JUL 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     18 NOV 96   SAIC        Modified unit names and prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- with Report; use Report;
- with LA14027_1;
- 
- procedure LA140272 is
-      TC_val : integer := 0;
- begin
-      Test ("LA14027", "Check that a compilation unit may not depend " &
-                       "semantically on two different versions of the " &
-                       "same compilation unit.  Check the case where " &
-                       "a task body depends on non-generic package " &
-                       "specification");
- 
-      LA14027_1.Random (TC_val);
- 
-      if TC_val = 110 then
-           Failed ("Old version used");
-      elsif TC_val /= 0 then
-           Failed ("Incorrect value returned");
-      end if;
- 
-      Result;
- end LA140272;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140273.a gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140273.a
*** gcc-16-20250518/gcc/testsuite/ada/acats/tests/l/la140273.a	Sun May 18 22:32:10 2025
--- gcc-16-20250525/gcc/testsuite/ada/acats/tests/l/la140273.a	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- -- LA140273.A
- --
- --                             Grant of Unlimited Rights
- --
- --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
- --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
- --     unlimited rights in the software and documentation contained herein.
- --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
- --     this public release, the Government intends to confer upon all 
- --     recipients unlimited rights  equal to those held by the Government.  
- --     These rights include rights to use, duplicate, release or disclose the 
- --     released technical data and computer software in whole or in part, in 
- --     any manner and for any purpose whatsoever, and to have or permit others 
- --     to do so.
- --
- --                                    DISCLAIMER
- --
- --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
- --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
- --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
- --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
- --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
- --     PARTICULAR PURPOSE OF SAID MATERIAL.
- --*
- --
- -- OBJECTIVE:
- --      See LA140272.AM.
- --
- -- TEST DESCRIPTION:
- --      See LA140272.AM.
- --
- -- SPECIAL REQUIREMENTS:
- --      See LA140272.AM.
- --
- -- TEST FILES:
- --      This test consists of the following files:
- --         LA140270.A
- --         LA140271.A
- --         LA140272.AM
- --      -> LA140273.A
- --
- -- PASS/FAIL CRITERIA:    
- --      See LA140272.AM.
- --
- -- CHANGE HISTORY:
- --     01 MAY 95   ACVC 1.12   LA5007O baseline version
- --     28 JUL 95   SAIC        Initial version
- --     29 JAN 96   SAIC        First revision after review
- --     18 NOV 96   SAIC        Modified prologue to conform
- --                             to coding conventions.
- --
- --!
- 
- package LA14027_0 is
-      New_var : integer := 100;
-      Local_array : array (1..51) of integer;
-      Sample_value : constant integer := -10;
- end LA14027_0;
--- 0 ----
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/elabd.lst gcc-16-20250525/gcc/testsuite/ada/acats-2/elabd.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/elabd.lst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/elabd.lst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,5 ----
+ c731001
+ c854002
+ ca11018
+ ca11019
+ ca5006a
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/floatstore.lst gcc-16-20250525/gcc/testsuite/ada/acats-2/floatstore.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/floatstore.lst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/floatstore.lst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1 ----
+ cxg2021
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/norun.lst gcc-16-20250525/gcc/testsuite/ada/acats-2/norun.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/norun.lst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/norun.lst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,2 ----
+ # Tests must be sorted in alphabetical order
+ templat
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/run_acats.sh gcc-16-20250525/gcc/testsuite/ada/acats-2/run_acats.sh
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/run_acats.sh	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/run_acats.sh	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ #!/bin/sh
+ 
+ if [ "$testdir" = "" ]; then
+    echo You must use make check or make check-ada
+    exit 1
+ fi
+ 
+ # Provide which replacement.
+ #
+ # type -p is missing from Solaris 2 /bin/sh and /bin/ksh (ksh88), but both
+ # ksh93 and bash have it.
+ # type output format differs between ksh88 and ksh93, so avoid it if
+ # type -p is present.  Unfortunately, HP-UX /bin/sh ignores -p with type.
+ # Fall back to whence which ksh88 and ksh93 provide, but bash does not.
+ 
+ which () {
+     path=`type -p $* 2>/dev/null` && { echo $path | awk '{print $NF}'; return 0; }
+     path=`type $* 2>/dev/null` && { echo $path | awk '{print $NF}'; return 0; }
+     path=`whence $* 2>/dev/null` && { echo $path; return 0; }
+     return 1
+ }
+ 
+ # Set up environment to use the Ada compiler from the object tree
+ 
+ host_gnatchop=`which gnatchop`
+ host_gnatmake=`which gnatmake`
+ ROOT=`${PWDCMD-pwd}`
+ BASE=`cd $ROOT/../../..; ${PWDCMD-pwd}`
+ 
+ PATH=$BASE:$ROOT:$PATH
+ ADA_INCLUDE_PATH=$BASE/ada/rts
+ LD_LIBRARY_PATH=$ADA_INCLUDE_PATH:$BASE:$LD_LIBRARY_PATH
+ ADA_OBJECTS_PATH=$ADA_INCLUDE_PATH
+ 
+ if [ ! -d $ADA_INCLUDE_PATH ]; then
+    echo gnatlib missing, exiting.
+    exit 1
+ fi
+ 
+ if [ ! -f $BASE/gnatchop ]; then
+    echo gnattools missing, exiting.
+    exit 1
+ fi
+ 
+ if [ ! -f $BASE/gnatmake ]; then
+    echo gnattools missing, exiting.
+    exit 1
+ fi
+ 
+ export PATH ADA_INCLUDE_PATH ADA_OBJECTS_PATH BASE LD_LIBRARY_PATH
+ 
+ echo '#!/bin/sh' > host_gnatchop
+ echo PATH=`dirname $host_gnatchop`:'$PATH' >> host_gnatchop
+ echo unset ADA_INCLUDE_PATH ADA_OBJECTS_PATH GCC_EXEC_PREFIX >> host_gnatchop
+ echo export PATH >> host_gnatchop
+ echo exec gnatchop '"$@"' >> host_gnatchop
+ 
+ chmod +x host_gnatchop
+ 
+ echo '#!/bin/sh' > host_gnatmake
+ echo PATH=`dirname $host_gnatmake`:'$PATH' >> host_gnatmake
+ echo unset ADA_INCLUDE_PATH ADA_OBJECTS_PATH GCC_EXEC_PREFIX >> host_gnatmake
+ echo export PATH >> host_gnatmake
+ echo exec gnatmake '"$@"' >> host_gnatmake
+ 
+ chmod +x host_gnatmake
+ 
+ # Limit the stack to 16MB for stack checking
+ ulimit -s 16384
+ 
+ exec $testdir/run_all.sh ${1+"$@"}
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/run_all.sh gcc-16-20250525/gcc/testsuite/ada/acats-2/run_all.sh
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/run_all.sh	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/run_all.sh	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,405 ----
+ #!/bin/sh
+ # Run ACATS 2 with the GNU Ada compiler
+ 
+ # The following functions are to be customized if you run in cross
+ # environment or want to change compilation flags.  Note that for
+ # tests requiring checks not turned on by default, this script
+ # automatically adds the needed flags to pass (e.g. -gnatE).
+ 
+ # gccflags="-O3 -funroll-loops"
+ # gnatflags="-gnatn"
+ 
+ gccflags="-O2"
+ gnatflags="-gnatws"
+ 
+ # End of customization section.
+ 
+ # Perform arithmetic evaluation on the ARGs, and store the result in the
+ # global $as_val. Take advantage of shells that can avoid forks. The arguments
+ # must be portable across $(()) and expr.
+ if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+   eval 'as_fn_arith ()
+   {
+     as_val=$(( $* ))
+   }'
+ else
+   as_fn_arith ()
+   {
+     as_val=`expr "$@" || test $? -eq 1`
+   }
+ fi # as_fn_arith
+ 
+ display_noeol () {
+   printf "$@"
+   printf "$@" >> $dir/acats.sum
+   printf "$@" >> $dir/acats.log
+ }
+ 
+ display () {
+   echo "$@"
+   echo "$@" >> $dir/acats.sum
+   echo "$@" >> $dir/acats.log
+ }
+ 
+ log () {
+   echo "$@" >> $dir/acats.sum
+   echo "$@" >> $dir/acats.log
+ }
+ 
+ dir=`${PWDCMD-pwd}`
+ 
+ if [ "$dir" = "$testdir" ]; then
+   echo "error: srcdir must be different than objdir, exiting."
+   exit 1
+ fi
+ 
+ GCC="$BASE/xgcc -B$BASE/"
+ 
+ target_gnatchop () {
+   $BASE/gnatchop --GCC="$BASE/xgcc" $*
+ }
+ 
+ target_gnatmake () {
+   echo $BASE/gnatmake --GNATBIND=$BASE/gnatbind --GNATLINK=$BASE/gnatlink --GCC="$GCC" $gnatflags $gccflags $* -largs $EXTERNAL_OBJECTS --GCC="$GCC"
+   $BASE/gnatmake --GNATBIND=$BASE/gnatbind --GNATLINK=$BASE/gnatlink --GCC="$GCC" $gnatflags $gccflags $* -largs $EXTERNAL_OBJECTS --GCC="$GCC"
+ }
+ 
+ target_gcc () {
+   $GCC $gccflags $*
+ }
+ 
+ target_run () {
+   eval $EXPECT -f $testdir/run_test.exp $*
+ }
+ 
+ clean_dir () {
+   rm -f "$binmain" *.o *.ali > /dev/null 2>&1
+ }
+ 
+ find_main () {
+   ls ${i}?.adb > ${i}.lst 2> /dev/null
+   ls ${i}*m.adb >> ${i}.lst 2> /dev/null
+   ls ${i}.adb >> ${i}.lst 2> /dev/null
+   main=`tail -1 ${i}.lst`
+ }
+ 
+ EXTERNAL_OBJECTS=""
+ # Global variable to communicate external objects to link with.
+ 
+ rm -f $dir/acats.sum $dir/acats.log
+ 
+ display "Test Run By $USER on `date`"
+ 
+ display "		=== acats configuration ==="
+ 
+ target=`$GCC -dumpmachine`
+ 
+ display target gcc is $GCC
+ display `$GCC -v 2>&1`
+ display host=`gcc -dumpmachine`
+ display target=$target
+ display `type gnatmake`
+ gnatls -v >> $dir/acats.log
+ display ""
+ 
+ if [ -n "$GCC_RUNTEST_PARALLELIZE_DIR" ]; then
+   dir_support=$dir/../acats-2/support
+ 
+   rm -rf $dir/run
+   mv $dir/tests $dir/tests.$$ 2> /dev/null
+   rm -rf $dir/tests.$$ &
+   mkdir -p $dir/run
+ 
+   cp -pr $dir/../acats-2/tests $dir/
+ else
+   dir_support=$dir/support
+ 
+ display "		=== acats support ==="
+ display_noeol "Generating support files..."
+ 
+ rm -rf $dir/support
+ mkdir -p $dir/support
+ cd $dir/support
+ 
+ cp $testdir/support/*.ada $testdir/support/*.a $testdir/support/*.tst $dir/support
+ 
+ # Find out the size in bit of an address on the target
+ target_gnatmake $testdir/support/impbit.adb >> $dir/acats.log 2>&1
+ if [ $? -ne 0 ]; then
+    display "**** Failed to compile impbit"
+    exit 1
+ fi
+ target_run $dir/support/impbit > $dir/support/impbit.out 2>&1
+ target_bit=`cat $dir/support/impbit.out`
+ echo target_bit="$target_bit" >> $dir/acats.log
+ 
+ case "$target_bit" in
+   *32*)
+     target_max_int="9223372036854775807"
+     target_min_int="-9223372036854775808"
+     ;;
+   *64*)
+     target_max_int="170141183460469231731687303715884105727"
+     target_min_int="-170141183460469231731687303715884105728"
+     ;;
+   *)
+     display "**** Unsupported bits per word"
+     exit 1
+ esac
+ 
+ echo target_max_insn="$target_max_int" >> $dir/acats.log
+ echo target_min_insn="$target_min_int" >> $dir/acats.log
+ 
+ # Find out a suitable asm statement
+ # Adapted from configure.ac gcc_cv_as_dwarf2_debug_line
+ case "$target" in
+   ia64*-*-* | s390*-*-*)
+     target_insn="nop 0"
+     ;;
+   mmix-*-*)
+     target_insn="swym 0"
+     ;;
+   *)
+     target_insn="nop"
+     ;;
+ esac
+ echo target_insn="$target_insn" >> $dir/acats.log
+ 
+ sed -e "s,ACATS4GNATDIR,$dir,g" \
+   < $testdir/support/impdef.a > $dir/support/impdef.a
+ sed -e "s,ACATS4GNATDIR,$dir,g" \
+   -e "s,ACATS4GNATBIT,$target_bit,g" \
+   -e "s,ACATS4GNATINSN,$target_insn,g" \
+   -e "s,ACATS4GNATMAXINT,$target_max_int,g" \
+   -e "s,ACATS4GNATMININT,$target_min_int,g" \
+   < $testdir/support/macro.dfs > $dir/support/MACRO.DFS
+ sed -e "s,ACATS4GNATDIR,$dir,g" \
+   < $testdir/support/tsttests.dat > $dir/support/TSTTESTS.DAT
+ 
+ cp $testdir/tests/cd/*.c $dir/support
+ cp $testdir/tests/cxb/*.c $dir/support
+ grep -v '^#' $testdir/norun.lst | sort > $dir/support/norun.lst
+ 
+ rm -rf $dir/run
+ mv $dir/tests $dir/tests.$$ 2> /dev/null
+ rm -rf $dir/tests.$$ &
+ mkdir -p $dir/run
+ 
+ cp -pr $testdir/tests $dir/
+ 
+ for i in $dir/support/*.ada $dir/support/*.a; do 
+    host_gnatchop $i >> $dir/acats.log 2>&1
+ done
+ 
+ # These tools are used to preprocess some ACATS sources
+ # they need to be compiled native on the host.
+ 
+ host_gnatmake -q -gnatws macrosub.adb
+ if [ $? -ne 0 ]; then
+    display "**** Failed to compile macrosub"
+    exit 1
+ fi
+ ./macrosub > macrosub.out 2>&1
+ 
+ gcc -c cd300051.c
+ host_gnatmake -q -gnatws widechr.adb
+ if [ $? -ne 0 ]; then
+    display "**** Failed to compile widechr"
+    exit 1
+ fi
+ ./widechr > widechr.out 2>&1
+ 
+ rm -f $dir/support/macrosub
+ rm -f $dir/support/widechr
+ rm -f $dir/support/*.ali
+ rm -f $dir/support/*.o
+ 
+ display " done."
+ 
+ # From here, all compilations will be made by the target compiler
+ 
+ display_noeol "Compiling support files..."
+ 
+ target_gcc -c *.c
+ if [ $? -ne 0 ]; then
+    display "**** Failed to compile C code"
+    exit 1
+ fi
+ 
+ target_gnatchop *.adt >> $dir/acats.log 2>&1
+ 
+ target_gnatmake -c -gnato -gnatE *.ads >> $dir/acats.log 2>&1
+ target_gnatmake -c -gnato -gnatE *.adb >> $dir/acats.log 2>&1
+ 
+ display " done."
+ display ""
+ 
+ fi
+ 
+ display "		=== acats tests ==="
+ 
+ if [ $# -eq 0 ]; then
+    chapters=`cd $dir/tests; echo [a-z]*`
+ else
+    chapters=$*
+ fi
+ 
+ glob_countn=0
+ glob_countok=0
+ glob_countu=0
+ par_count=0
+ par_countm=0
+ par_last=
+ 
+ for chapter in $chapters; do
+    # Used to generate support once and finish after that.
+    [ "$chapter" = "NONE" ] && continue
+ 
+    display Running chapter $chapter ...
+ 
+    if [ ! -d $dir/tests/$chapter ]; then
+       display "*** CHAPTER $chapter does not exist, skipping."
+       display ""
+       continue
+    fi
+ 
+    cd $dir/tests/$chapter
+    ls *.a *.ada *.adt *.am *.dep 2> /dev/null | sed -e 's/\(.*\)\..*/\1/g' | \
+    cut -c1-7 | sort | uniq | comm -23 - $dir_support/norun.lst \
+      > $dir/tests/$chapter/${chapter}.lst 
+    countn=`wc -l < $dir/tests/$chapter/${chapter}.lst`
+    as_fn_arith $glob_countn + $countn
+    glob_countn=$as_val
+    for i in `cat $dir/tests/$chapter/${chapter}.lst`; do 
+ 
+       # If running multiple run_all.sh jobs in parallel, decide
+       # if we should run this test in the current instance.
+       if [ -n "$GCC_RUNTEST_PARALLELIZE_DIR" ]; then
+ 	 case "$i" in
+ 	    # Ugh, some tests have inter-test dependencies, those
+ 	    # tests have to be scheduled on the same parallel instance
+ 	    # as previous test.
+ 	    ce2108f | ce2108h | ce3112d) ;;
+ 	    # All others can be hopefully scheduled freely.
+ 	    *)
+ 	       as_fn_arith $par_countm + 1
+ 	       par_countm=$as_val
+ 	       [ $par_countm -eq 10 ] && par_countm=0
+ 	       if [ $par_countm -eq 1 ]; then
+ 		  as_fn_arith $par_count + 1
+ 		  par_count=$as_val
+ 		  if mkdir $GCC_RUNTEST_PARALLELIZE_DIR/$par_count 2>/dev/null; then
+ 		     par_last=1
+ 		  else
+ 		     par_last=
+ 		  fi
+ 	       fi;;
+ 	 esac
+ 	 if [ -z "$par_last" ]; then
+ 	    as_fn_arith $glob_countn - 1
+ 	    glob_countn=$as_val
+ 	    continue
+ 	 fi
+       fi
+ 
+       extraflags="-gnat95"
+       grep $i $testdir/elabd.lst > /dev/null 2>&1
+       if [ $? -eq 0 ]; then
+          extraflags="$extraflags -gnatE"
+       fi
+       grep $i $testdir/floatstore.lst > /dev/null 2>&1
+       if [ $? -eq 0 ]; then
+          extraflags="$extraflags -ffloat-store"
+       fi
+       grep $i $testdir/stackcheck.lst > /dev/null 2>&1
+       if [ $? -eq 0 ]; then
+          extraflags="$extraflags -fstack-check"
+       fi
+       test=$dir/tests/$chapter/$i
+       mkdir $test && cd $test >> $dir/acats.log 2>&1
+ 
+       if [ $? -ne 0 ]; then
+          display "FAIL:	$i"
+          failed="${failed}${i} "
+          clean_dir
+          continue
+       fi
+ 
+       target_gnatchop -c -w `ls ${test}*.a ${test}*.ada ${test}*.adt ${test}*.am ${test}*.dep 2> /dev/null` >> $dir/acats.log 2>&1
+       main=""
+       find_main
+       if [ -z "$main" ]; then
+          sync
+          find_main
+       fi
+       binmain=`echo $main | sed -e 's/\(.*\)\..*/\1/g'`
+       echo "BUILD $main" >> $dir/acats.log
+       EXTERNAL_OBJECTS=""
+       case $i in
+         cxb3004) EXTERNAL_OBJECTS="$dir_support/cxb30040.o";;
+         cxb3006) EXTERNAL_OBJECTS="$dir_support/cxb30060.o";;
+         cxb3013) EXTERNAL_OBJECTS="$dir_support/cxb30130.o $dir_support/cxb30131.o";;
+         ca1020e) rm -f ca1020e_func1.adb ca1020e_func2.adb ca1020e_proc1.adb ca1020e_proc2.adb > /dev/null 2>&1;;
+         ca14028) rm -f ca14028_func2.ads ca14028_func3.ads ca14028_proc1.ads ca14028_proc3.ads > /dev/null 2>&1;;
+       esac
+       if [ "$main" = "" ]; then
+          display "FAIL:	$i"
+          failed="${failed}${i} "
+          clean_dir
+          continue
+       fi
+ 
+       target_gnatmake $extraflags -I$dir_support $main >> $dir/acats.log 2>&1
+       if [ $? -ne 0 ]; then
+          display "FAIL:	$i"
+          failed="${failed}${i} "
+          clean_dir
+          continue
+       fi
+ 
+       echo "RUN $binmain" >> $dir/acats.log
+       cd $dir/run
+       if [ ! -x $dir/tests/$chapter/$i/$binmain ]; then
+          sync
+       fi
+       target_run $dir/tests/$chapter/$i/$binmain > $dir/tests/$chapter/$i/${i}.log 2>&1
+       cd $dir/tests/$chapter/$i
+       cat ${i}.log >> $dir/acats.log
+       egrep -e '(==== |\+\+\+\+ |\!\!\!\! )' ${i}.log > /dev/null 2>&1
+       if [ $? -ne 0 ]; then
+          grep 'tasking not implemented' ${i}.log > /dev/null 2>&1
+ 
+          if [ $? -ne 0 ]; then
+             display "FAIL:	$i"
+             failed="${failed}${i} "
+          else
+             log "UNSUPPORTED:	$i"
+             as_fn_arith $glob_countn - 1
+             glob_countn=$as_val
+             as_fn_arith $glob_countu + 1
+             glob_countu=$as_val
+          fi
+       else
+          log "PASS:	$i"
+          as_fn_arith $glob_countok + 1
+          glob_countok=$as_val
+       fi
+       clean_dir
+    done
+ done
+ 
+ display "		=== acats Summary ==="
+ display "# of expected passes		$glob_countok"
+ display "# of unexpected failures	`expr $glob_countn - $glob_countok`"
+ 
+ if [ $glob_countu -ne 0 ]; then
+    display "# of unsupported tests		$glob_countu"
+ fi
+ 
+ if [ $glob_countok -ne $glob_countn ]; then
+    display "*** FAILURES: $failed"
+ fi
+ 
+ display "$0 completed at `date`"
+ 
+ exit 0
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/run_test.exp gcc-16-20250525/gcc/testsuite/ada/acats-2/run_test.exp
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/run_test.exp	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/run_test.exp	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,13 ----
+ #!/usr/bin/expect -f
+ 
+ if {[info exists env(DEJAGNU_TIMEOUT)]} {
+     set timeout $env(DEJAGNU_TIMEOUT)
+ } else {
+     set timeout 300 
+ }
+ 
+ spawn -noecho $argv
+ expect timeout {
+     send_user "Program timed out.\n"
+     exit 1
+ }
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/stackcheck.lst gcc-16-20250525/gcc/testsuite/ada/acats-2/stackcheck.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/stackcheck.lst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/stackcheck.lst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,6 ----
+ c52103x
+ c52104x
+ c52104y
+ cb1010a
+ cb1010c
+ cb1010d
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/acats26.lst gcc-16-20250525/gcc/testsuite/ada/acats-2/support/acats26.lst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/acats26.lst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/acats26.lst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,4332 ----
+ a22006b.ada
+ a22006c.ada
+ a22006d.ada
+ a26007a.tst
+ a27003a.ada
+ a29003a.ada
+ a2a031a.ada
+ a33003a.ada
+ a34017c.ada
+ a35101b.ada
+ a35402a.ada
+ a35801f.ada
+ a35902c.ada
+ a38106d.ada
+ a38106e.ada
+ a49027a.ada
+ a49027b.ada
+ a49027c.ada
+ a54b01a.ada
+ a54b02a.ada
+ a55b12a.ada
+ a55b13a.ada
+ a55b14a.ada
+ a71004a.ada
+ a73001i.ada
+ a73001j.ada
+ a74105b.ada
+ a74106a.ada
+ a74106b.ada
+ a74106c.ada
+ a74205e.ada
+ a74205f.ada
+ a83009a.ada
+ a83009b.ada
+ a83a02a.ada
+ a83a02b.ada
+ a83a06a.ada
+ a83a08a.ada
+ a83c01c.ada
+ a83c01h.ada
+ a83c01i.ada
+ a85007d.ada
+ a85013b.ada
+ a87b59a.ada
+ a95001c.ada
+ a95074d.ada
+ a97106a.ada
+ a99006a.ada
+ aa2010a.ada
+ aa2012a.ada
+ acats25.lst
+ ac1015b.ada
+ ac3106a.ada
+ ac3206a.ada
+ ac3207a.ada
+ ad7001b.ada
+ ad7001c0.ada
+ ad7001c1.ada
+ ad7001d0.ada
+ ad7001d1.ada
+ ad7006a.ada
+ ad7101a.ada
+ ad7101c.ada
+ ad7102a.ada
+ ad7103a.ada
+ ad7103c.ada
+ ad7104a.ada
+ ad7201a.ada
+ ad7203b.ada
+ ad7205b.ada
+ ad8011a.tst
+ ada101a.ada
+ ae2113a.ada
+ ae2113b.ada
+ ae3002g.ada
+ ae3101a.ada
+ ae3702a.ada
+ ae3709a.ada
+ b22001a.tst
+ b22001b.tst
+ b22001c.tst
+ b22001d.tst
+ b22001e.tst
+ b22001f.tst
+ b22001g.tst
+ b22001h.ada
+ b22001i.tst
+ b22001j.tst
+ b22001k.tst
+ b22001l.tst
+ b22001m.tst
+ b22001n.tst
+ b23002a.ada
+ b23004a.ada
+ b23004b.ada
+ b24001a.ada
+ b24001b.ada
+ b24001c.ada
+ b24005a.ada
+ b24005b.ada
+ b24007a.ada
+ b24009a.ada
+ b24009b.ada
+ b24104a.ada
+ b24204a.ada
+ b24204b.ada
+ b24204c.ada
+ b24204d.ada
+ b24204e.ada
+ b24204f.ada
+ b24205a.ada
+ b24206a.ada
+ b24206b.ada
+ b24211b.ada
+ b25002a.ada
+ b25002b.ada
+ b26001a.ada
+ b26002a.ada
+ b26005a.ada
+ b28001a.ada
+ b28001b.ada
+ b28001c.ada
+ b28001d.ada
+ b28001e.ada
+ b28001f.ada
+ b28001g.ada
+ b28001h.ada
+ b28001i.ada
+ b28001j.ada
+ b28001k.ada
+ b28001l.ada
+ b28001m.ada
+ b28001n.ada
+ b28001o.ada
+ b28001p.ada
+ b28001q.ada
+ b28001r.ada
+ b28001s.ada
+ b28001t.ada
+ b28001u.ada
+ b28001v.ada
+ b28001w.ada
+ b29001a.ada
+ b2a003a.ada
+ b2a003b.ada
+ b2a003c.ada
+ b2a003d.ada
+ b2a003e.ada
+ b2a003f.ada
+ b2a005a.ada
+ b2a005b.ada
+ b2a007a.ada
+ b2a010a.ada
+ b2a021a.ada
+ b32101a.ada
+ b32103a.ada
+ b32104a.ada
+ b32106a.ada
+ b32201a.ada
+ b32202a.ada
+ b32202b.ada
+ b32202c.ada
+ b330001.a
+ b33001a.ada
+ b33101a.ada
+ b33102a.ada
+ b33102b.ada
+ b33102c.ada
+ b33102d.ada
+ b33102e.ada
+ b33201a.ada
+ b33201b.ada
+ b33201c.ada
+ b33201d.ada
+ b33201e.ada
+ b33204a.ada
+ b33205a.ada
+ b33302a.ada
+ b34001b.ada
+ b34001e.ada
+ b34002b.ada
+ b34003b.ada
+ b34004b.ada
+ b34005b.ada
+ b34005e.ada
+ b34005h.ada
+ b34005k.ada
+ b34005n.ada
+ b34005q.ada
+ b34005t.ada
+ b34006b.ada
+ b34006e.ada
+ b34006h.ada
+ b34006k.ada
+ b34007b.ada
+ b34007e.ada
+ b34007h.ada
+ b34007k.ada
+ b34007n.ada
+ b34007q.ada
+ b34007t.ada
+ b34008b.ada
+ b34009b.ada
+ b34009e.ada
+ b34009h.ada
+ b34009k.ada
+ b34011a.ada
+ b34014b.ada
+ b34014d.ada
+ b34014f.ada
+ b34014i.ada
+ b34014m.ada
+ b34014o.ada
+ b34014q.ada
+ b34014s.ada
+ b34014v.ada
+ b34014z.ada
+ b35004a.ada
+ b35101a.ada
+ b35103a.ada
+ b35103b.ada
+ b35302a.ada
+ b354001.a
+ b35401a.ada
+ b35401b.ada
+ b35403a.ada
+ b35501a.ada
+ b35501b.ada
+ b35506a.ada
+ b35506b.ada
+ b35506c.ada
+ b35506d.ada
+ b35701a.ada
+ b35709a.ada
+ b35901a.ada
+ b35901c.ada
+ b35901d.ada
+ b35a01a.ada
+ b35a08a.ada
+ b360001.a
+ b36001a.ada
+ b36002a.ada
+ b36101a.ada
+ b36102a.ada
+ b36103a.ada
+ b36105c.dep
+ b36171a.ada
+ b36171b.ada
+ b36171c.ada
+ b36171d.ada
+ b36171e.ada
+ b36171f.ada
+ b36171g.ada
+ b36171h.ada
+ b36171i.ada
+ b36201a.ada
+ b36307a.ada
+ b370001.a
+ b370002.a
+ b37004a.ada
+ b37004b.ada
+ b37004c.ada
+ b37004d.ada
+ b37004e.ada
+ b37004f.ada
+ b37004g.ada
+ b3710010.a
+ b3710011.a
+ b3710012.a
+ b3710013.a
+ b3710014.am
+ b37101a.ada
+ b37102a.ada
+ b37104a.ada
+ b37106a.ada
+ b37201a.ada
+ b37201b.ada
+ b37203a.ada
+ b37301i.ada
+ b37301j.ada
+ b37302a.ada
+ b37303a.ada
+ b37309b.ada
+ b37310b.ada
+ b37311a.ada
+ b37401a.ada
+ b37409b.ada
+ b380001.a
+ b38003a.ada
+ b38003b.ada
+ b38003c.ada
+ b38003d.ada
+ b38008a.ada
+ b38008b.ada
+ b38009a.ada
+ b38009d.ada
+ b38101a.ada
+ b38101b.ada
+ b38101c.ada
+ b38103a.ada
+ b38103b.ada
+ b38103c0.ada
+ b38103c1.ada
+ b38103c2.ada
+ b38103c3.ada
+ b38103d.ada
+ b38103e0.ada
+ b38103e1.ada
+ b38105a.ada
+ b38105b.ada
+ b38203a.ada
+ b390001.a
+ b391001.a
+ b391002.a
+ b391003.a
+ b391004.a
+ b392001.a
+ b392002.a
+ b392003.a
+ b392004.a
+ b392005.a
+ b392006.a
+ b392007.a
+ b392008.a
+ b392009.a
+ b392010.a
+ b392011.a
+ b393001.a
+ b393002.a
+ b393003.a
+ b393004.a
+ b393005.a
+ b393006.a
+ b393007.a
+ b3a0001.a
+ b3a0002.a
+ b3a0003.a
+ b3a0004.a
+ b3a2002.a
+ b3a2003.a
+ b3a2004.a
+ b3a2005.a
+ b3a2006.a
+ b3a2007.a
+ b3a2008.a
+ b3a2009.a
+ b3a2010.a
+ b3a2011.a
+ b3a2012.a
+ b3a2013.a
+ b3a2014.a
+ b3a2015.a
+ b3a2016.a
+ b41101a.ada
+ b41101c.ada
+ b41201a.ada
+ b41201c.ada
+ b41202c.ada
+ b41202d.ada
+ b41324b.ada
+ b41325b.ada
+ b41327b.ada
+ b420001.a
+ b430001.a
+ b43001m.ada
+ b43002d.ada
+ b43002e.ada
+ b43002f.ada
+ b43002g.ada
+ b43002h.ada
+ b43002i.ada
+ b43002j.ada
+ b43002k.ada
+ b43005a.ada
+ b43005b.ada
+ b43005f.ada
+ b43101a.ada
+ b43102a.ada
+ b43102b.ada
+ b43105c.ada
+ b43201a.ada
+ b43201c.ada
+ b43201d.ada
+ b43202a.ada
+ b43202c.ada
+ b43209b.ada
+ b43221a.ada
+ b43221b.ada
+ b43223a.ada
+ b44001a.ada
+ b44001b.ada
+ b44002b.ada
+ b44002c.ada
+ b44004a.ada
+ b44004b.ada
+ b44004c.ada
+ b44004d.ada
+ b44004e.ada
+ b45102a.ada
+ b45116a.ada
+ b45121a.ada
+ b45204a.ada
+ b45205a.ada
+ b45206c.ada
+ b45207a.ada
+ b45207b.ada
+ b45207c.ada
+ b45207d.ada
+ b45207g.ada
+ b45207h.ada
+ b45207i.ada
+ b45207j.ada
+ b45207m.ada
+ b45207n.ada
+ b45207o.ada
+ b45207p.ada
+ b45207s.ada
+ b45207t.ada
+ b45207u.ada
+ b45207v.ada
+ b45208a.ada
+ b45208b.ada
+ b45208c.ada
+ b45208g.ada
+ b45208h.ada
+ b45208i.ada
+ b45208m.ada
+ b45208n.ada
+ b45208s.ada
+ b45208t.ada
+ b45209a.ada
+ b45209b.ada
+ b45209c.ada
+ b45209d.ada
+ b45209e.ada
+ b45209f.ada
+ b45209g.ada
+ b45209h.ada
+ b45209i.ada
+ b45209j.ada
+ b45209k.ada
+ b45221a.ada
+ b45261a.ada
+ b45261b.ada
+ b45261c.ada
+ b45261d.ada
+ b45301a.ada
+ b45301b.ada
+ b45301c.ada
+ b45302a.ada
+ b45341a.ada
+ b455002.a
+ b45501a.ada
+ b45501b.ada
+ b45501c.ada
+ b45522a.ada
+ b45537a.ada
+ b45601a.ada
+ b45625a.ada
+ b45661a.ada
+ b460001.a
+ b460002.a
+ b460004.a
+ b460005.a
+ b460006.a
+ b46002a.ada
+ b46003a.ada
+ b46004a.ada
+ b46004b.ada
+ b46004c.ada
+ b46004d.ada
+ b46004e.ada
+ b46005a.ada
+ b47001a.ada
+ b480001.a
+ b48001a.ada
+ b48001b.ada
+ b48002a.ada
+ b48002b.ada
+ b48002c.ada
+ b48002d.ada
+ b48002e.ada
+ b48002g.ada
+ b48003a.ada
+ b48003b.ada
+ b48003c.ada
+ b48003d.ada
+ b48003e.ada
+ b490001.a
+ b490002.a
+ b49002a.ada
+ b49004a.ada
+ b49005a.ada
+ b49007a.ada
+ b49007b.ada
+ b49008a.ada
+ b49008c.ada
+ b49009b.ada
+ b49009c.ada
+ b49010a.ada
+ b49011a.ada
+ b4a010c.ada
+ b4a016a.ada
+ b51001a.ada
+ b51004b.ada
+ b51004c.ada
+ b52002a.ada
+ b52002b.ada
+ b52002c.ada
+ b52002d.ada
+ b52002e.ada
+ b52002f.ada
+ b52002g.ada
+ b52004a.ada
+ b52004b.ada
+ b52004c.ada
+ b52004d.dep
+ b52004e.dep
+ b53001a.ada
+ b53001b.ada
+ b53002a.ada
+ b53002b.ada
+ b53009a.ada
+ b53009b.ada
+ b53009c.ada
+ b54a01b.ada
+ b54a01f.ada
+ b54a01g.ada
+ b54a01l.ada
+ b54a05a.ada
+ b54a05b.ada
+ b54a10a.ada
+ b54a12a.ada
+ b54a20a.ada
+ b54a21a.ada
+ b54a25a.ada
+ b54a60a.ada
+ b54a60b.ada
+ b54b01b.tst
+ b54b01c.ada
+ b54b02b.ada
+ b54b02c.ada
+ b54b02d.ada
+ b54b04a.ada
+ b54b04b.ada
+ b54b05a.ada
+ b54b06a.ada
+ b55a01a.ada
+ b55a01d.ada
+ b55a01e.ada
+ b55a01j.ada
+ b55a01k.ada
+ b55a01l.ada
+ b55a01n.ada
+ b55a01o.ada
+ b55a01t.ada
+ b55a01u.ada
+ b55a01v.ada
+ b55b01a.ada
+ b55b01b.ada
+ b55b09b.ada
+ b55b09c.dep
+ b55b09d.dep
+ b55b12b.ada
+ b55b12c.ada
+ b55b17a.ada
+ b55b17b.ada
+ b55b17c.ada
+ b55b18a.ada
+ b56001a.ada
+ b56001d.ada
+ b56001e.ada
+ b56001f.ada
+ b56001g.ada
+ b56001h.ada
+ b57001a.ada
+ b57001b.ada
+ b57001c.ada
+ b57001d.ada
+ b58001a.ada
+ b58002a.ada
+ b58002b.ada
+ b58002c.ada
+ b58003a.ada
+ b58003b.ada
+ b59001a.ada
+ b59001c.ada
+ b59001d.ada
+ b59001e.ada
+ b59001f.ada
+ b59001g.ada
+ b59001h.ada
+ b59001i.ada
+ b610001.a
+ b61001f.ada
+ b61005a.ada
+ b61006a.ada
+ b61011a.ada
+ b62001a.ada
+ b62001b.ada
+ b62001c.ada
+ b62001d.ada
+ b63001a.ada
+ b63001b.ada
+ b63005a.ada
+ b63005b.ada
+ b63006a.ada
+ b63009a.ada
+ b63009b.ada
+ b63009c0.ada
+ b63009c1.ada
+ b63009c2.ada
+ b63009c3.ada
+ b63103a.ada
+ b64002a.ada
+ b64002c.ada
+ b64003a.ada
+ b64004a.ada
+ b64004b.ada
+ b64004c.ada
+ b64004d.ada
+ b64004e.ada
+ b64004f.ada
+ b641001.a
+ b64101a.ada
+ b64201a.ada
+ b65001a.ada
+ b65002a.ada
+ b65002b.ada
+ b660001.a
+ b660002.a
+ b66001a.ada
+ b66001b.ada
+ b66001c.ada
+ b66001d.ada
+ b67001a.ada
+ b67001b.ada
+ b67001c.ada
+ b67001d.ada
+ b67001h.ada
+ b67001i.ada
+ b67001j.ada
+ b67001k.ada
+ b67004a.ada
+ b71001a.ada
+ b71001b.ada
+ b71001c.ada
+ b71001d.ada
+ b71001f.ada
+ b71001g.ada
+ b71001h.ada
+ b71001i.ada
+ b71001j.ada
+ b71001l.ada
+ b71001m.ada
+ b71001n.ada
+ b71001o.ada
+ b71001p.ada
+ b71001r.ada
+ b71001t.ada
+ b71001u.ada
+ b71001v.ada
+ b7200010.a
+ b7200011.a
+ b7200012.a
+ b7200013.a
+ b7200014.a
+ b7200015.a
+ b7200016.a
+ b730001.a
+ b730002.a
+ b730003.a
+ b730004.a
+ b730005.a
+ b7300060.a
+ b7300061.a
+ b7300062.a
+ b7300063.am
+ b73001a.ada
+ b73001b.ada
+ b73001c.ada
+ b73001d.ada
+ b73001e.ada
+ b73001f.ada
+ b73001g.ada
+ b73001h.ada
+ b73004a.ada
+ b73004b0.ada
+ b73004b1.ada
+ b73004b2.ada
+ b7310010.a
+ b7310011.a
+ b7310012.a
+ b7310013.a
+ b7310014.a
+ b7310015.a
+ b7310016.am
+ b731a01.a
+ b731a02.a
+ b740001.a
+ b74001a.ada
+ b74001b.ada
+ b74101a.ada
+ b74101b.ada
+ b74103a.ada
+ b74103d.ada
+ b74103e.ada
+ b74103g.ada
+ b74103i.ada
+ b74104a.ada
+ b74105a.ada
+ b74105c.ada
+ b74201a.ada
+ b74202a.ada
+ b74202b.ada
+ b74202c.ada
+ b74202d.ada
+ b74203b.ada
+ b74203c.ada
+ b74203d.ada
+ b74203e.ada
+ b74205a.ada
+ b74207a.ada
+ b74304a.ada
+ b74304b.ada
+ b74304c.ada
+ b74404a.ada
+ b74404b.ada
+ b74409a.ada
+ b810001.a
+ b830001.a
+ b8300020.a
+ b8300021.a
+ b8300022.a
+ b8300023.a
+ b8300024.a
+ b8300025.am
+ b83001a.ada
+ b83003a.ada
+ b83003b0.ada
+ b83003b1.ada
+ b83003b2.ada
+ b83003b3.ada
+ b83003b4.ada
+ b83003c.ada
+ b83004a.ada
+ b83004b0.ada
+ b83004b1.ada
+ b83004b2.ada
+ b83004b3.ada
+ b83004c0.ada
+ b83004c1.ada
+ b83004c2.ada
+ b83004d0.ada
+ b83004d1.ada
+ b83004d2.ada
+ b83004d3.ada
+ b83006a.ada
+ b83006b.ada
+ b83008a.ada
+ b83008b.ada
+ b83011a.ada
+ b83023b.ada
+ b83024b.ada
+ b83024f0.ada
+ b83024f1.ada
+ b83024f2.ada
+ b83024f3.ada
+ b83026b.ada
+ b83027b.ada
+ b83027d.ada
+ b83028b.ada
+ b83029b.ada
+ b83030b.ada
+ b83030d.ada
+ b83031b.ada
+ b83031d.ada
+ b83031f.ada
+ b83032b.ada
+ b83033b.ada
+ b83041e.ada
+ b83a01a.ada
+ b83a01b.ada
+ b83a01c.ada
+ b83a05a.ada
+ b83a06b.ada
+ b83a06h.ada
+ b83a07a.ada
+ b83a07b.ada
+ b83a07c.ada
+ b83a08b.ada
+ b83a09a.ada
+ b83b01a.ada
+ b83b02c.ada
+ b83e01a.ada
+ b83e01b.ada
+ b83e01c.ada
+ b83e01d.ada
+ b83e01e0.ada
+ b83e01e1.ada
+ b83e01e2.ada
+ b83e01e3.ada
+ b83e01f0.ada
+ b83e01f1.ada
+ b83e01f2.ada
+ b83e01f3.ada
+ b83e01f4.ada
+ b83e01f5.ada
+ b83e01f6.ada
+ b83e11a.ada
+ b83f02a.ada
+ b83f02b.ada
+ b83f02c.ada
+ b840001.a
+ b84001a.ada
+ b84002b.ada
+ b84004a.ada
+ b84005b.ada
+ b84006a.ada
+ b84007a.ada
+ b84008b.ada
+ b85001a.ada
+ b85001b.ada
+ b85001c.ada
+ b85001d.ada
+ b85001e.ada
+ b85001f.ada
+ b85001g.ada
+ b85001h.ada
+ b85001i.ada
+ b85001j.ada
+ b85001k.ada
+ b85001l.ada
+ b85002a.ada
+ b85003a.ada
+ b85003b.ada
+ b85004a.ada
+ b85008f.ada
+ b85008g.ada
+ b85008h.ada
+ b85010a.ada
+ b85010b.ada
+ b85012a.ada
+ b85013c.ada
+ b85013d.ada
+ b85015a.ada
+ b8510010.a
+ b8510011.a
+ b8510012.am
+ b854001.a
+ b86001a0.ada
+ b86001a1.ada
+ b87b23b.ada
+ b87b26a.ada
+ b87b48c.ada
+ b91001b.ada
+ b91001c.ada
+ b91001d.ada
+ b91001e.ada
+ b91001f.ada
+ b91001g.ada
+ b91002a.ada
+ b91002b.ada
+ b91002c.ada
+ b91002d.ada
+ b91002e.ada
+ b91002f.ada
+ b91002g.ada
+ b91002h.ada
+ b91002i.ada
+ b91002j.ada
+ b91002k.ada
+ b91002l.ada
+ b91003a.ada
+ b91003b.ada
+ b91003c.ada
+ b91003d.ada
+ b91003e.ada
+ b91004a.ada
+ b91005a.ada
+ b92001a.ada
+ b92001b.ada
+ b940001.a
+ b940002.a
+ b940003.a
+ b940004.a
+ b940005.a
+ b940006.a
+ b940007.a
+ b95001a.ada
+ b95001b.ada
+ b95001d.ada
+ b95002a.ada
+ b95003a.ada
+ b95004a.ada
+ b95004b.ada
+ b95006a.ada
+ b95006b.ada
+ b95006c.ada
+ b95006d.ada
+ b95007a.ada
+ b95007b.ada
+ b95020a.ada
+ b95020b0.ada
+ b95020b1.ada
+ b95020b2.ada
+ b95030a.ada
+ b95031a.ada
+ b95032a.ada
+ b95061a.ada
+ b95061b.ada
+ b95061c.ada
+ b95061d.ada
+ b95061e.ada
+ b95061f.ada
+ b95061g.ada
+ b95062a.ada
+ b95063a.ada
+ b95064a.ada
+ b95068a.ada
+ b95070a.ada
+ b95080a.ada
+ b95080c.ada
+ b95081a.ada
+ b95082a.ada
+ b95082b.ada
+ b95082c.ada
+ b95082d.ada
+ b95082e.ada
+ b95082f.ada
+ b95083a.ada
+ b95094a.ada
+ b95094b.ada
+ b95094c.ada
+ b951001.a
+ b952001.a
+ b952002.a
+ b952003.a
+ b952004.a
+ b954001.a
+ b954003.a
+ b954004.a
+ b960001.a
+ b96002a.ada
+ b97102b.ada
+ b97102c.ada
+ b97102d.ada
+ b97102f.ada
+ b97102g.ada
+ b97102h.ada
+ b97102i.ada
+ b97103a.ada
+ b97103b.ada
+ b97103d.ada
+ b97103e.ada
+ b97103f.ada
+ b97103g.ada
+ b97104a.ada
+ b97104b.ada
+ b97104c.ada
+ b97104d.ada
+ b97104e.ada
+ b97104f.ada
+ b97104g.ada
+ b97107a.ada
+ b97108a.ada
+ b97108b.ada
+ b97109a.ada
+ b97110a.ada
+ b97110b.ada
+ b97111a.ada
+ b97206a.ada
+ b97306a.ada
+ b99001a.ada
+ b99001b.ada
+ b99002a.ada
+ b99002b.ada
+ b99002c.ada
+ b99003a.ada
+ b9a001a.ada
+ b9a001b.ada
+ ba1001a0.ada
+ ba1001a1.ada
+ ba1001a4.ada
+ ba1001ac.ada
+ ba1001d.ada
+ ba1010a0.ada
+ ba1010a1.ada
+ ba1010a2.ada
+ ba1010a3.ada
+ ba1010b0.ada
+ ba1010b1.ada
+ ba1010b2.ada
+ ba1010b4.ada
+ ba1010b5.ada
+ ba1010b6.ada
+ ba1010b7.ada
+ ba1010b8.ada
+ ba1010c0.ada
+ ba1010c1.ada
+ ba1010c2.ada
+ ba1010c3.ada
+ ba1010c4.ada
+ ba1010c5.ada
+ ba1010c6.ada
+ ba1010d0.ada
+ ba1010d1.ada
+ ba1010d2.ada
+ ba1010d3.ada
+ ba1010e0.ada
+ ba1010e1.ada
+ ba1010e2.ada
+ ba1010e3.ada
+ ba1010e4.ada
+ ba1010e5.ada
+ ba1010e6.ada
+ ba1010f0.ada
+ ba1010f1.ada
+ ba1010f3.ada
+ ba1010f4.ada
+ ba1010f5.ada
+ ba1010f6.ada
+ ba1010f7.ada
+ ba1010f8.ada
+ ba1010g0.ada
+ ba1010g2.ada
+ ba1010g3.ada
+ ba1010g4.ada
+ ba1010g5.ada
+ ba1010h0.ada
+ ba1010h2.ada
+ ba1010i0.ada
+ ba1010i1.ada
+ ba1010i3.ada
+ ba1010i4.ada
+ ba1010j0.ada
+ ba1010j1.ada
+ ba1010j2.ada
+ ba1010j4.ada
+ ba1010j5.ada
+ ba1010j6.ada
+ ba1010j7.ada
+ ba1010j8.ada
+ ba1010k0.ada
+ ba1010k1.ada
+ ba1010k2.ada
+ ba1010k3.ada
+ ba1010k4.ada
+ ba1010k5.ada
+ ba1010k6.ada
+ ba1010l0.ada
+ ba1010l1.ada
+ ba1010l2.ada
+ ba1010l3.ada
+ ba1010l4.ada
+ ba1010l5.ada
+ ba1010l6.ada
+ ba1010m0.ada
+ ba1010m1.ada
+ ba1010m3.ada
+ ba1010m4.ada
+ ba1010m5.ada
+ ba1010m6.ada
+ ba1010m7.ada
+ ba1010m8.ada
+ ba1010n0.ada
+ ba1010n2.ada
+ ba1010n3.ada
+ ba1010n4.ada
+ ba1010n5.ada
+ ba1010p0.ada
+ ba1010p2.ada
+ ba1010q0.ada
+ ba1010q1.ada
+ ba1010q3.ada
+ ba1010q4.ada
+ ba1011b0.ada
+ ba1011b1.ada
+ ba1011b2.ada
+ ba1011b3.ada
+ ba1011b4.ada
+ ba1011b5.ada
+ ba1011b6.ada
+ ba1011b7.ada
+ ba1011b8.ada
+ ba1011c0.ada
+ ba1011c1.ada
+ ba1011c2.ada
+ ba1011c3.ada
+ ba1011c4.ada
+ ba1011c5.ada
+ ba1011c6.ada
+ ba1011c7.ada
+ ba1011c8.ada
+ ba1020a0.ada
+ ba1020a1.ada
+ ba1020a2.ada
+ ba1020a3.ada
+ ba1020a4.ada
+ ba1020a5.ada
+ ba1020a6.ada
+ ba1020a7.ada
+ ba1020a8.ada
+ ba1020b0.ada
+ ba1020b1.ada
+ ba1020b2.ada
+ ba1020b3.ada
+ ba1020b4.ada
+ ba1020b5.ada
+ ba1020b6.ada
+ ba1020c0.ada
+ ba1020c1.ada
+ ba1020c2.ada
+ ba1020c3.ada
+ ba1020c4.ada
+ ba1020c5.ada
+ ba1020f0.ada
+ ba1020f1.ada
+ ba1020f2.ada
+ ba11001.a
+ ba11002.a
+ ba11003.a
+ ba11004.a
+ ba11005.a
+ ba11007.a
+ ba11008.a
+ ba11009.a
+ ba11010.a
+ ba11011.a
+ ba11012.a
+ ba1101a.ada
+ ba1101b0.ada
+ ba1101b1.ada
+ ba1101b2.ada
+ ba1101b3.ada
+ ba1101b4.ada
+ ba1101c0.ada
+ ba1101c1.ada
+ ba1101c2.ada
+ ba1101c3.ada
+ ba1101c4.ada
+ ba1101c5.ada
+ ba1101c6.ada
+ ba1101e0.ada
+ ba1101e1.ada
+ ba1101f.ada
+ ba1101g.ada
+ ba1109a0.ada
+ ba1109a1.ada
+ ba1109a2.ada
+ ba1110a0.ada
+ ba1110a1.ada
+ ba1110a2.ada
+ ba1110a3.ada
+ ba1110a4.ada
+ ba1110a5.ada
+ ba12001.a
+ ba12002.a
+ ba12003.a
+ ba12004.a
+ ba12005.a
+ ba12007.a
+ ba12008.a
+ ba13b01.a
+ ba13b02.a
+ ba15001.a
+ ba150020.a
+ ba150021.a
+ ba150022.a
+ ba150023.a
+ ba150024.a
+ ba150025.a
+ ba150026.a
+ ba150027.a
+ ba150028.a
+ ba150029.am
+ ba2001a.ada
+ ba2001b.ada
+ ba2001c.ada
+ ba2001d.ada
+ ba2001f0.ada
+ ba2001f1.ada
+ ba2001f2.ada
+ ba2003b0.ada
+ ba2003b1.ada
+ ba2011a0.ada
+ ba2011a1.ada
+ ba2011a2.ada
+ ba2011a3.ada
+ ba2011a4.ada
+ ba2011a5.ada
+ ba2011a6.ada
+ ba2011a7.ada
+ ba2011a8.ada
+ ba2011a9.ada
+ ba2013a.ada
+ ba2013b.ada
+ ba21001.a
+ ba21002.a
+ ba210030.a
+ ba210031.a
+ ba210032.a
+ ba210033.a
+ ba210034.a
+ ba210035.a
+ ba210040.a
+ ba210041.a
+ ba210042.a
+ ba210043.a
+ ba210044.a
+ ba210045.am
+ ba21a01.a
+ ba21a02.a
+ ba3001a0.ada
+ ba3001a1.ada
+ ba3001a2.ada
+ ba3001a3.ada
+ ba3001b0.ada
+ ba3001b1.ada
+ ba3001c0.ada
+ ba3001c1.ada
+ ba3001e0.ada
+ ba3001e1.ada
+ ba3001e2.ada
+ ba3001e3.ada
+ ba3001f0.ada
+ ba3001f1.ada
+ ba3001f2.ada
+ ba3001f3.ada
+ ba3006a0.ada
+ ba3006a1.ada
+ ba3006a2.ada
+ ba3006a3.ada
+ ba3006a4.ada
+ ba3006a5.ada
+ ba3006a6.ada
+ ba3006b0.ada
+ ba3006b1.ada
+ ba3006b2.ada
+ ba3006b3.ada
+ ba3006b4.ada
+ bb10001.a
+ bb20001.a
+ bb2001a.ada
+ bb2002a.ada
+ bb2003a.ada
+ bb2003b.ada
+ bb2003c.ada
+ bb3001a.ada
+ bb3002a.ada
+ bc1001a.ada
+ bc1002a.ada
+ bc1005a.ada
+ bc1008a.ada
+ bc1008b.ada
+ bc1008c.ada
+ bc1009a.ada
+ bc1011a.ada
+ bc1011b.ada
+ bc1011c.ada
+ bc1012a.ada
+ bc1013a.ada
+ bc1014a.ada
+ bc1014b.ada
+ bc1016a.ada
+ bc1016b.ada
+ bc1101a.ada
+ bc1102a.ada
+ bc1103a.ada
+ bc1106a.ada
+ bc1107a.ada
+ bc1109a.ada
+ bc1109b.ada
+ bc1109c.ada
+ bc1109d.ada
+ bc1110a.ada
+ bc1201a.ada
+ bc1201b.ada
+ bc1201c.ada
+ bc1201d.ada
+ bc1201e.ada
+ bc1201f.ada
+ bc1201g.ada
+ bc1201h.ada
+ bc1201i.ada
+ bc1201j.ada
+ bc1201k.ada
+ bc1201l.ada
+ bc1202a.ada
+ bc1202c.ada
+ bc1202e.ada
+ bc1202f.ada
+ bc1202g.ada
+ bc1203a.ada
+ bc1205a.ada
+ bc1206a.ada
+ bc1207a.ada
+ bc1208a.ada
+ bc1226a.ada
+ bc1230a.ada
+ bc1303a.ada
+ bc1303b.ada
+ bc1303c.ada
+ bc1303d.ada
+ bc1303e.ada
+ bc1303f.ada
+ bc1303g.ada
+ bc1306a.ada
+ bc2001b.ada
+ bc2001c.ada
+ bc2001d.ada
+ bc2001e.ada
+ bc2004a.ada
+ bc2004b.ada
+ bc30001.a
+ bc3001a.ada
+ bc3002a.ada
+ bc3002b.ada
+ bc3002c.ada
+ bc3002d.ada
+ bc3002e.ada
+ bc3005a.ada
+ bc3005b.ada
+ bc3005c.ada
+ bc3006a.ada
+ bc3009c.ada
+ bc3011b.ada
+ bc3013a.ada
+ bc3016g.ada
+ bc3018a.ada
+ bc3101a.ada
+ bc3101b.ada
+ bc3102a.ada
+ bc3102b.ada
+ bc3103b.ada
+ bc3123c.ada
+ bc3201a.ada
+ bc3201b.ada
+ bc3201c.ada
+ bc3202a.ada
+ bc3202b.ada
+ bc3202c.ada
+ bc3202d.ada
+ bc3205c.ada
+ bc3301a.ada
+ bc3301b.ada
+ bc3302a.ada
+ bc3302b.ada
+ bc3303a.ada
+ bc3304a.ada
+ bc3401a.ada
+ bc3401b.ada
+ bc3402a.ada
+ bc3402b.ada
+ bc3403a.ada
+ bc3403b.ada
+ bc3403c.ada
+ bc3404a.ada
+ bc3404b.ada
+ bc3404c.ada
+ bc3404d.ada
+ bc3404e.ada
+ bc3404f.ada
+ bc3405a.ada
+ bc3405b.ada
+ bc3405d.ada
+ bc3405e.ada
+ bc3405f.ada
+ bc3501a.ada
+ bc3501b.ada
+ bc3501c.ada
+ bc3501d.ada
+ bc3501e.ada
+ bc3501f.ada
+ bc3501g.ada
+ bc3501h.ada
+ bc3501i.ada
+ bc3501j.ada
+ bc3501k.ada
+ bc3502a.ada
+ bc3502b.ada
+ bc3502c.ada
+ bc3502d.ada
+ bc3502e.ada
+ bc3502f.ada
+ bc3502g.ada
+ bc3502h.ada
+ bc3502i.ada
+ bc3502j.ada
+ bc3502k.ada
+ bc3502l.ada
+ bc3502m.ada
+ bc3502n.ada
+ bc3502o.ada
+ bc3503a.ada
+ bc3503c.ada
+ bc3503d.ada
+ bc3503e.ada
+ bc3503f.ada
+ bc3604a.ada
+ bc3604b.ada
+ bc3607a.ada
+ bc40001.a
+ bc40002.a
+ bc50001.a
+ bc50002.a
+ bc50003.a
+ bc50004.a
+ bc51002.a
+ bc51003.a
+ bc51004.a
+ bc51005.a
+ bc51006.a
+ bc51007.a
+ bc51011.a
+ bc51012.a
+ bc51013.a
+ bc51015.a
+ bc51016.a
+ bc51017.a
+ bc51018.a
+ bc51019.a
+ bc51020.a
+ bc51b01.a
+ bc51b02.a
+ bc51c01.a
+ bc51c02.a
+ bc53001.a
+ bc53002.a
+ bc54001.a
+ bc54002.a
+ bc54003.a
+ bc54a01.a
+ bc54a02.a
+ bc54a03.a
+ bc54a04.a
+ bc54a05.a
+ bc54a06.a
+ bc70001.a
+ bc70002.a
+ bc70003.a
+ bc70004.a
+ bc70005.a
+ bc70006.a
+ bc70007.a
+ bc70008.a
+ bc70009.a
+ bc70010.a
+ bd1b01a.ada
+ bd1b02b.ada
+ bd1b03c.ada
+ bd1b05e.ada
+ bd1b06j.ada
+ bd2001b.ada
+ bd2a01h.ada
+ bd2a02a.tst
+ bd2a03a.ada
+ bd2a03b.ada
+ bd2a06a.ada
+ bd2a25a.ada
+ bd2a35a.ada
+ bd2a45a.ada
+ bd2a55a.ada
+ bd2a55b.ada
+ bd2a67a.ada
+ bd2a77a.ada
+ bd2a85a.ada
+ bd2a85b.ada
+ bd2b01c.ada
+ bd2b02a.ada
+ bd2b03a.ada
+ bd2b03b.ada
+ bd2b03c.ada
+ bd2c01d.tst
+ bd2c02a.tst
+ bd2c03a.tst
+ bd2d01c.ada
+ bd2d01d.ada
+ bd2d02a.ada
+ bd2d03a.ada
+ bd2d03b.ada
+ bd3001a.ada
+ bd3001b.ada
+ bd3001c.ada
+ bd3002a.ada
+ bd3003a.ada
+ bd3003b.ada
+ bd3012a.ada
+ bd3013a.ada
+ bd4001a.ada
+ bd4002a.ada
+ bd4003a.ada
+ bd4003b.ada
+ bd4003c.ada
+ bd4006a.tst
+ bd4007a.ada
+ bd4009a.ada
+ bd4011a.ada
+ bd5001a.ada
+ bd5005a.ada
+ bd5005d.ada
+ bd5102a.ada
+ bd5102b.ada
+ bd5103a.ada
+ bd5104a.ada
+ bd7001a.ada
+ bd7101h.ada
+ bd7201c.ada
+ bd7203a.ada
+ bd7204a.ada
+ bd7205a.ada
+ bd7301a.ada
+ bd7302a.ada
+ bd8001a.tst
+ bd8002a.tst
+ bd8003a.tst
+ bd8004a.tst
+ bd8004b.tst
+ bd8004c.tst
+ bdb0a01.a
+ bdd2001.a
+ bdd2002.a
+ bde0001.a
+ bde0002.a
+ bde0003.a
+ bde0004.a
+ bde0005.a
+ bde0006.a
+ bde0007.a
+ bde0008.a
+ bde0009.a
+ bde0010.a
+ be2101e.ada
+ be2101j.ada
+ be2114a.ada
+ be2116a.ada
+ be2208a.ada
+ be3002a.ada
+ be3002e.ada
+ be3205a.ada
+ be3301c.ada
+ be3606c.ada
+ be3703a.ada
+ be3802a.ada
+ be3803a.ada
+ be3902a.ada
+ be3903a.ada
+ bxa8001.a
+ bxac001.a
+ bxac002.a
+ bxac003.a
+ bxac004.a
+ bxac005.a
+ bxc3001.a
+ bxc3002.a
+ bxc5001.a
+ bxc6001.a
+ bxc6002.a
+ bxc6003.a
+ bxc6a01.a
+ bxc6a02.a
+ bxc6a03.a
+ bxc6a04.a
+ bxd1001.a
+ bxd1002.a
+ bxe2007.a
+ bxe2008.a
+ bxe2009.a
+ bxe2010.a
+ bxe2011.a
+ bxe2012.a
+ bxe2013.a
+ bxe2a01.a
+ bxe2a02.a
+ bxe2a03.a
+ bxe2a04.a
+ bxe2a05.a
+ bxe2a06.a
+ bxe4001.a
+ bxf1001.a
+ bxh4001.a
+ bxh4002.a
+ bxh4003.a
+ bxh4004.a
+ bxh4005.a
+ bxh4006.a
+ bxh4007.a
+ bxh4008.a
+ bxh4009.a
+ bxh4010.a
+ bxh4011.a
+ bxh4012.a
+ bxh4013.a
+ c23001a.ada
+ c23003a.tst
+ c23003b.tst
+ c23003g.tst
+ c23003i.tst
+ c23006a.ada
+ c23006b.ada
+ c23006c.ada
+ c23006d.ada
+ c23006e.ada
+ c23006f.ada
+ c23006g.ada
+ c24002d.ada
+ c24003a.ada
+ c24003b.ada
+ c24003c.ada
+ c24106a.ada
+ c24202d.ada
+ c24203a.ada
+ c24203b.ada
+ c24207a.ada
+ c24211a.ada
+ c250001.aw
+ c250002.aw
+ c25001a.ada
+ c25001b.ada
+ c26006a.ada
+ c26008a.ada
+ c2a001a.ada
+ c2a001b.ada
+ c2a001c.ada
+ c2a002a.ada
+ c2a008a.ada
+ c2a021b.ada
+ c32001a.ada
+ c32001b.ada
+ c32001c.ada
+ c32001d.ada
+ c32001e.ada
+ c32107a.ada
+ c32107c.ada
+ c32108a.ada
+ c32108b.ada
+ c32111a.ada
+ c32111b.ada
+ c32112b.ada
+ c32113a.ada
+ c32115a.ada
+ c32115b.ada
+ c330001.a
+ c330002.a
+ c332001.a
+ c340001.a
+ c34001a.ada
+ c34001c.ada
+ c34001d.ada
+ c34001f.ada
+ c34002a.ada
+ c34002c.ada
+ c34003a.ada
+ c34003c.ada
+ c34004a.ada
+ c34004c.ada
+ c34005a.ada
+ c34005c.ada
+ c34005d.ada
+ c34005f.ada
+ c34005g.ada
+ c34005i.ada
+ c34005j.ada
+ c34005l.ada
+ c34005m.ada
+ c34005o.ada
+ c34005p.ada
+ c34005r.ada
+ c34005s.ada
+ c34005u.ada
+ c34005v.ada
+ c34006a.ada
+ c34006d.ada
+ c34006f.ada
+ c34006g.ada
+ c34006j.ada
+ c34006l.ada
+ c34007a.ada
+ c34007d.ada
+ c34007f.ada
+ c34007g.ada
+ c34007i.ada
+ c34007j.ada
+ c34007m.ada
+ c34007p.ada
+ c34007r.ada
+ c34007s.ada
+ c34007u.ada
+ c34007v.ada
+ c34008a.ada
+ c34009a.ada
+ c34009d.ada
+ c34009f.ada
+ c34009g.ada
+ c34009j.ada
+ c34009l.ada
+ c34011b.ada
+ c34012a.ada
+ c34014a.ada
+ c34014c.ada
+ c34014e.ada
+ c34014g.ada
+ c34014h.ada
+ c34014n.ada
+ c34014p.ada
+ c34014r.ada
+ c34014t.ada
+ c34014u.ada
+ c34018a.ada
+ c340a01.a
+ c340a02.a
+ c341a01.a
+ c341a02.a
+ c341a03.a
+ c341a04.a
+ c35003a.ada
+ c35003b.ada
+ c35003d.ada
+ c35102a.ada
+ c352001.a
+ c354002.a
+ c354003.a
+ c35502a.ada
+ c35502b.ada
+ c35502c.ada
+ c35502d.tst
+ c35502e.ada
+ c35502f.tst
+ c35502g.ada
+ c35502h.ada
+ c35502i.ada
+ c35502j.ada
+ c35502k.ada
+ c35502l.ada
+ c35502m.ada
+ c35502n.ada
+ c35502o.ada
+ c35502p.ada
+ c35503a.ada
+ c35503b.ada
+ c35503c.ada
+ c35503d.tst
+ c35503e.ada
+ c35503f.tst
+ c35503g.ada
+ c35503h.ada
+ c35503k.ada
+ c35503l.ada
+ c35503o.ada
+ c35503p.ada
+ c35504a.ada
+ c35504b.ada
+ c35505c.ada
+ c35505e.ada
+ c35505f.ada
+ c35507a.ada
+ c35507b.ada
+ c35507c.ada
+ c35507e.ada
+ c35507g.ada
+ c35507h.ada
+ c35507i.ada
+ c35507j.ada
+ c35507k.ada
+ c35507l.ada
+ c35507m.ada
+ c35507n.ada
+ c35507o.ada
+ c35507p.ada
+ c35508a.ada
+ c35508b.ada
+ c35508c.ada
+ c35508e.ada
+ c35508g.ada
+ c35508h.ada
+ c35508k.ada
+ c35508l.ada
+ c35508o.ada
+ c35508p.ada
+ c35703a.ada
+ c35704a.ada
+ c35704b.ada
+ c35704c.ada
+ c35704d.ada
+ c35801d.ada
+ c35902d.ada
+ c35904a.ada
+ c35904b.ada
+ c35a02a.ada
+ c35a05a.ada
+ c35a05d.ada
+ c35a05n.ada
+ c35a05q.ada
+ c35a07a.ada
+ c35a07d.ada
+ c35a08b.ada
+ c360002.a
+ c36104a.ada
+ c36104b.ada
+ c36172a.ada
+ c36172b.ada
+ c36172c.ada
+ c36174a.ada
+ c36180a.ada
+ c36202c.ada
+ c36203a.ada
+ c36204a.ada
+ c36204b.ada
+ c36204c.ada
+ c36204d.ada
+ c36205a.ada
+ c36205b.ada
+ c36205c.ada
+ c36205d.ada
+ c36205e.ada
+ c36205f.ada
+ c36205g.ada
+ c36205h.ada
+ c36205i.ada
+ c36205j.ada
+ c36205k.ada
+ c36205l.ada
+ c36301a.ada
+ c36301b.ada
+ c36302a.ada
+ c36304a.ada
+ c36305a.ada
+ c37002a.ada
+ c37003a.ada
+ c37003b.ada
+ c37005a.ada
+ c37006a.ada
+ c37008a.ada
+ c37008b.ada
+ c37009a.ada
+ c37010a.ada
+ c37010b.ada
+ c371001.a
+ c371002.a
+ c371003.a
+ c37102b.ada
+ c37103a.ada
+ c37105a.ada
+ c37107a.ada
+ c37108b.ada
+ c37206a.ada
+ c37207a.ada
+ c37208a.ada
+ c37208b.ada
+ c37209a.ada
+ c37209b.ada
+ c37210a.ada
+ c37211a.ada
+ c37211b.ada
+ c37211c.ada
+ c37211d.ada
+ c37211e.ada
+ c37213b.ada
+ c37213d.ada
+ c37213f.ada
+ c37213h.ada
+ c37213j.ada
+ c37213k.ada
+ c37213l.ada
+ c37215b.ada
+ c37215d.ada
+ c37215f.ada
+ c37215h.ada
+ c37217a.ada
+ c37217b.ada
+ c37217c.ada
+ c37304a.ada
+ c37305a.ada
+ c37306a.ada
+ c37309a.ada
+ c37310a.ada
+ c37312a.ada
+ c37402a.ada
+ c37403a.ada
+ c37404a.ada
+ c37404b.ada
+ c37405a.ada
+ c37411a.ada
+ c380001.a
+ c380002.a
+ c380003.a
+ c380004.a
+ c38002a.ada
+ c38002b.ada
+ c38005a.ada
+ c38005b.ada
+ c38005c.ada
+ c38006a.ada
+ c38102a.ada
+ c38102b.ada
+ c38102c.ada
+ c38102d.ada
+ c38102e.ada
+ c38104a.ada
+ c38107a.ada
+ c38107b.ada
+ c38108a.ada
+ c38108b.ada
+ c38108c0.ada
+ c38108c1.ada
+ c38108c2.ada
+ c38108d0.ada
+ c38108d1.ada
+ c38202a.ada
+ c3900010.a
+ c3900011.am
+ c390002.a
+ c390003.a
+ c390004.a
+ c3900050.a
+ c3900051.a
+ c3900052.a
+ c3900053.am
+ c3900060.a
+ c3900061.a
+ c3900062.a
+ c3900063.am
+ c390007.a
+ c390010.a
+ c390011.a
+ c39006a.ada
+ c39006b.ada
+ c39006c0.ada
+ c39006c1.ada
+ c39006d.ada
+ c39006e.ada
+ c39006f0.ada
+ c39006f1.ada
+ c39006f2.ada
+ c39006f3.ada
+ c39006g.ada
+ c39007a.ada
+ c39007b.ada
+ c39008a.ada
+ c39008b.ada
+ c39008c.ada
+ c390a010.a
+ c390a011.am
+ c390a020.a
+ c390a021.a
+ c390a022.am
+ c390a030.a
+ c390a031.am
+ c391001.a
+ c391002.a
+ c392002.a
+ c392003.a
+ c392004.a
+ c392005.a
+ c392008.a
+ c392010.a
+ c392011.a
+ c392013.a
+ c392014.a
+ c392a01.a
+ c392c05.a
+ c392c07.a
+ c392d01.a
+ c392d02.a
+ c392d03.a
+ c393001.a
+ c393007.a
+ c393008.a
+ c393009.a
+ c393010.a
+ c393011.a
+ c393012.a
+ c393a02.a
+ c393a03.a
+ c393a05.a
+ c393a06.a
+ c393b12.a
+ c393b13.a
+ c393b14.a
+ c3a0001.a
+ c3a0002.a
+ c3a0003.a
+ c3a0004.a
+ c3a0005.a
+ c3a0006.a
+ c3a0007.a
+ c3a0008.a
+ c3a0009.a
+ c3a0010.a
+ c3a0011.a
+ c3a00120.a
+ c3a00121.a
+ c3a00122.am
+ c3a0013.a
+ c3a0014.a
+ c3a0015.a
+ c3a1001.a
+ c3a1002.a
+ c3a2001.a
+ c3a2002.a
+ c3a2003.a
+ c3a2a01.a
+ c3a2a02.a
+ c410001.a
+ c41101d.ada
+ c41103a.ada
+ c41103b.ada
+ c41104a.ada
+ c41105a.ada
+ c41107a.ada
+ c41201d.ada
+ c41203a.ada
+ c41203b.ada
+ c41204a.ada
+ c41205a.ada
+ c41206a.ada
+ c41207a.ada
+ c41301a.ada
+ c41303a.ada
+ c41303b.ada
+ c41303c.ada
+ c41303e.ada
+ c41303f.ada
+ c41303g.ada
+ c41303i.ada
+ c41303j.ada
+ c41303k.ada
+ c41303m.ada
+ c41303n.ada
+ c41303o.ada
+ c41303q.ada
+ c41303r.ada
+ c41303s.ada
+ c41303u.ada
+ c41303v.ada
+ c41303w.ada
+ c41304a.ada
+ c41304b.ada
+ c41306a.ada
+ c41306b.ada
+ c41306c.ada
+ c41307d.ada
+ c41309a.ada
+ c41320a.ada
+ c41321a.ada
+ c41322a.ada
+ c41323a.ada
+ c41324a.ada
+ c41325a.ada
+ c41326a.ada
+ c41327a.ada
+ c41328a.ada
+ c41401a.ada
+ c41402a.ada
+ c41404a.ada
+ c420001.a
+ c42006a.ada
+ c42007e.ada
+ c43003a.ada
+ c43004a.ada
+ c43004c.ada
+ c431001.a
+ c43103a.ada
+ c43103b.ada
+ c43104a.ada
+ c43105a.ada
+ c43105b.ada
+ c43106a.ada
+ c43107a.ada
+ c43108a.ada
+ c432001.a
+ c432002.a
+ c432003.a
+ c432004.a
+ c43204a.ada
+ c43204c.ada
+ c43204e.ada
+ c43204f.ada
+ c43204g.ada
+ c43204h.ada
+ c43204i.ada
+ c43205a.ada
+ c43205b.ada
+ c43205c.ada
+ c43205d.ada
+ c43205e.ada
+ c43205g.ada
+ c43205h.ada
+ c43205i.ada
+ c43205j.ada
+ c43205k.ada
+ c43206a.ada
+ c43207b.ada
+ c43207d.ada
+ c43208a.ada
+ c43208b.ada
+ c43209a.ada
+ c43210a.ada
+ c43211a.ada
+ c43212a.ada
+ c43212c.ada
+ c43214a.ada
+ c43214b.ada
+ c43214c.ada
+ c43214d.ada
+ c43214e.ada
+ c43214f.ada
+ c43215a.ada
+ c43215b.ada
+ c43222a.ada
+ c43224a.ada
+ c433001.a
+ c44003d.ada
+ c44003f.ada
+ c44003g.ada
+ c450001.a
+ c45112a.ada
+ c45112b.ada
+ c45113a.ada
+ c45114b.ada
+ c452001.a
+ c45201a.ada
+ c45201b.ada
+ c45202b.ada
+ c45210a.ada
+ c45211a.ada
+ c45220a.ada
+ c45220b.ada
+ c45220c.ada
+ c45220d.ada
+ c45220e.ada
+ c45220f.ada
+ c45231a.ada
+ c45231b.dep
+ c45231c.dep
+ c45231d.tst
+ c45232b.ada
+ c45242b.ada
+ c45251a.ada
+ c45252a.ada
+ c45252b.ada
+ c45253a.ada
+ c45262a.ada
+ c45262b.ada
+ c45262c.ada
+ c45262d.ada
+ c45264a.ada
+ c45264b.ada
+ c45264c.ada
+ c45265a.ada
+ c45271a.ada
+ c45272a.ada
+ c45273a.ada
+ c45274a.ada
+ c45274b.ada
+ c45274c.ada
+ c45281a.ada
+ c45282a.ada
+ c45282b.ada
+ c45291a.ada
+ c45303a.ada
+ c45304a.ada
+ c45304b.dep
+ c45304c.dep
+ c45322a.ada
+ c45323a.ada
+ c45331a.ada
+ c45342a.ada
+ c45343a.ada
+ c45344a.ada
+ c45345b.ada
+ c45347a.ada
+ c45347b.ada
+ c45347c.ada
+ c45347d.ada
+ c45411a.ada
+ c45411b.dep
+ c45411c.dep
+ c45411d.ada
+ c45413a.ada
+ c45431a.ada
+ c455001.a
+ c45502b.dep
+ c45502c.dep
+ c45503a.ada
+ c45503b.dep
+ c45503c.dep
+ c45504a.ada
+ c45504b.dep
+ c45504c.dep
+ c45504d.ada
+ c45504e.dep
+ c45504f.dep
+ c45505a.ada
+ c45523a.ada
+ c45531a.ada
+ c45531b.ada
+ c45531c.ada
+ c45531d.ada
+ c45531e.ada
+ c45531f.ada
+ c45531g.ada
+ c45531h.ada
+ c45531i.ada
+ c45531j.ada
+ c45531k.ada
+ c45531l.ada
+ c45531m.dep
+ c45531n.dep
+ c45531o.dep
+ c45531p.dep
+ c45532a.ada
+ c45532b.ada
+ c45532c.ada
+ c45532d.ada
+ c45532e.ada
+ c45532f.ada
+ c45532g.ada
+ c45532h.ada
+ c45532i.ada
+ c45532j.ada
+ c45532k.ada
+ c45532l.ada
+ c45532m.dep
+ c45532n.dep
+ c45532o.dep
+ c45532p.dep
+ c45534b.ada
+ c45536a.dep
+ c456001.a
+ c45611a.ada
+ c45611b.dep
+ c45611c.dep
+ c45613a.ada
+ c45613b.dep
+ c45613c.dep
+ c45614a.ada
+ c45614b.dep
+ c45614c.dep
+ c45631a.ada
+ c45631b.dep
+ c45631c.dep
+ c45632a.ada
+ c45632b.dep
+ c45632c.dep
+ c45651a.ada
+ c45662a.ada
+ c45662b.ada
+ c45672a.ada
+ c460001.a
+ c460002.a
+ c460004.a
+ c460005.a
+ c460006.a
+ c460007.a
+ c460008.a
+ c460009.a
+ c460010.a
+ c460011.a
+ c460012.a
+ c46011a.ada
+ c46013a.ada
+ c46014a.ada
+ c46021a.ada
+ c46024a.ada
+ c46031a.ada
+ c46032a.ada
+ c46033a.ada
+ c46041a.ada
+ c46042a.ada
+ c46043b.ada
+ c46044b.ada
+ c46051a.ada
+ c46051b.ada
+ c46051c.ada
+ c46052a.ada
+ c46053a.ada
+ c46054a.ada
+ c460a01.a
+ c460a02.a
+ c47002a.ada
+ c47002b.ada
+ c47002c.ada
+ c47002d.ada
+ c47003a.ada
+ c47004a.ada
+ c47005a.ada
+ c47006a.ada
+ c47007a.ada
+ c47008a.ada
+ c47009a.ada
+ c47009b.ada
+ c48004a.ada
+ c48004b.ada
+ c48004c.ada
+ c48004d.ada
+ c48004e.ada
+ c48004f.ada
+ c48005a.ada
+ c48005b.ada
+ c48006a.ada
+ c48006b.ada
+ c48007a.ada
+ c48007b.ada
+ c48007c.ada
+ c48008a.ada
+ c48008c.ada
+ c48009a.ada
+ c48009b.ada
+ c48009c.ada
+ c48009d.ada
+ c48009e.ada
+ c48009f.ada
+ c48009g.ada
+ c48009h.ada
+ c48009i.ada
+ c48009j.ada
+ c48010a.ada
+ c48011a.ada
+ c48012a.ada
+ c490001.a
+ c490002.a
+ c490003.a
+ c49020a.ada
+ c49021a.ada
+ c49022a.ada
+ c49022b.ada
+ c49022c.ada
+ c49023a.ada
+ c49024a.ada
+ c49025a.ada
+ c49026a.ada
+ c4a005b.ada
+ c4a006a.ada
+ c4a007a.tst
+ c4a010a.ada
+ c4a010b.ada
+ c4a011a.ada
+ c4a012b.ada
+ c4a013a.ada
+ c4a014a.ada
+ c51004a.ada
+ c52005a.ada
+ c52005b.ada
+ c52005c.ada
+ c52005d.ada
+ c52005e.ada
+ c52005f.ada
+ c52008a.ada
+ c52008b.ada
+ c52009a.ada
+ c52009b.ada
+ c52010a.ada
+ c52011a.ada
+ c52011b.ada
+ c52101a.ada
+ c52102a.ada
+ c52102b.ada
+ c52102c.ada
+ c52102d.ada
+ c52103a.ada
+ c52103b.ada
+ c52103c.ada
+ c52103f.ada
+ c52103g.ada
+ c52103h.ada
+ c52103k.ada
+ c52103l.ada
+ c52103m.ada
+ c52103p.ada
+ c52103q.ada
+ c52103r.ada
+ c52103x.ada
+ c52104a.ada
+ c52104b.ada
+ c52104c.ada
+ c52104f.ada
+ c52104g.ada
+ c52104h.ada
+ c52104k.ada
+ c52104l.ada
+ c52104m.ada
+ c52104p.ada
+ c52104q.ada
+ c52104r.ada
+ c52104x.ada
+ c52104y.ada
+ c53007a.ada
+ c540001.a
+ c54a03a.ada
+ c54a04a.ada
+ c54a07a.ada
+ c54a13a.ada
+ c54a13b.ada
+ c54a13c.ada
+ c54a13d.ada
+ c54a22a.ada
+ c54a23a.ada
+ c54a24a.ada
+ c54a24b.ada
+ c54a42a.ada
+ c54a42b.ada
+ c54a42c.ada
+ c54a42d.ada
+ c54a42e.ada
+ c54a42f.ada
+ c54a42g.ada
+ c55b03a.ada
+ c55b04a.ada
+ c55b05a.ada
+ c55b06a.ada
+ c55b06b.ada
+ c55b07a.dep
+ c55b07b.dep
+ c55b10a.ada
+ c55b11a.ada
+ c55b11b.ada
+ c55b15a.ada
+ c55b16a.ada
+ c55c02a.ada
+ c55c02b.ada
+ c56002a.ada
+ c57003a.ada
+ c57004a.ada
+ c57004b.ada
+ c58004c.ada
+ c58004d.ada
+ c58004g.ada
+ c58005a.ada
+ c58005b.ada
+ c58005h.ada
+ c58006a.ada
+ c58006b.ada
+ c59002a.ada
+ c59002b.ada
+ c59002c.ada
+ c61008a.ada
+ c61009a.ada
+ c61010a.ada
+ c62002a.ada
+ c62003a.ada
+ c62003b.ada
+ c62004a.ada
+ c62006a.ada
+ c631001.a
+ c640001.a
+ c64002b.ada
+ c64004g.ada
+ c64005a.ada
+ c64005b.ada
+ c64005c.ada
+ c64005d0.ada
+ c64005da.ada
+ c64005db.ada
+ c64005dc.ada
+ c641001.a
+ c64103b.ada
+ c64103c.ada
+ c64103d.ada
+ c64103e.ada
+ c64103f.ada
+ c64104a.ada
+ c64104b.ada
+ c64104c.ada
+ c64104d.ada
+ c64104e.ada
+ c64104f.ada
+ c64104g.ada
+ c64104h.ada
+ c64104i.ada
+ c64104j.ada
+ c64104k.ada
+ c64104l.ada
+ c64104m.ada
+ c64104n.ada
+ c64104o.ada
+ c64105a.ada
+ c64105b.ada
+ c64105c.ada
+ c64105d.ada
+ c64106a.ada
+ c64106b.ada
+ c64106c.ada
+ c64106d.ada
+ c64107a.ada
+ c64108a.ada
+ c64109a.ada
+ c64109b.ada
+ c64109c.ada
+ c64109d.ada
+ c64109e.ada
+ c64109f.ada
+ c64109g.ada
+ c64109h.ada
+ c64109i.ada
+ c64109j.ada
+ c64109k.ada
+ c64109l.ada
+ c64201b.ada
+ c64201c.ada
+ c64202a.ada
+ c650001.a
+ c65003a.ada
+ c65003b.ada
+ c66002a.ada
+ c66002c.ada
+ c66002d.ada
+ c66002e.ada
+ c66002f.ada
+ c66002g.ada
+ c67002a.ada
+ c67002b.ada
+ c67002c.ada
+ c67002d.ada
+ c67002e.ada
+ c67003f.ada
+ c67005a.ada
+ c67005b.ada
+ c67005c.ada
+ c67005d.ada
+ c72001b.ada
+ c72002a.ada
+ c730001.a
+ c730002.a
+ c730003.a
+ c730004.a
+ c73002a.ada
+ c730a01.a
+ c730a02.a
+ c731001.a
+ c74004a.ada
+ c74203a.ada
+ c74206a.ada
+ c74207b.ada
+ c74208a.ada
+ c74208b.ada
+ c74209a.ada
+ c74210a.ada
+ c74211a.ada
+ c74211b.ada
+ c74302a.ada
+ c74302b.ada
+ c74305a.ada
+ c74305b.ada
+ c74306a.ada
+ c74307a.ada
+ c74401d.ada
+ c74401e.ada
+ c74401k.ada
+ c74401q.ada
+ c74402a.ada
+ c74402b.ada
+ c74406a.ada
+ c74407b.ada
+ c74409b.ada
+ c760001.a
+ c760002.a
+ c760007.a
+ c760009.a
+ c760010.a
+ c760011.a
+ c760012.a
+ c760013.a
+ c761001.a
+ c761002.a
+ c761003.a
+ c761004.a
+ c761005.a
+ c761006.a
+ c761007.a
+ c761010.a
+ c761011.a
+ c761012.a
+ c83007a.ada
+ c83012d.ada
+ c83022a.ada
+ c83022g0.ada
+ c83022g1.ada
+ c83023a.ada
+ c83024a.ada
+ c83024e0.ada
+ c83024e1.ada
+ c83025a.ada
+ c83025c.ada
+ c83027a.ada
+ c83027c.ada
+ c83028a.ada
+ c83029a.ada
+ c83030a.ada
+ c83030c.ada
+ c83031a.ada
+ c83031c.ada
+ c83031e.ada
+ c83032a.ada
+ c83033a.ada
+ c83051a.ada
+ c83b02a.ada
+ c83b02b.ada
+ c83e02a.ada
+ c83e02b.ada
+ c83e03a.ada
+ c83f01a.ada
+ c83f01b.ada
+ c83f01c0.ada
+ c83f01c1.ada
+ c83f01c2.ada
+ c83f01d0.ada
+ c83f01d1.ada
+ c83f03a.ada
+ c83f03b.ada
+ c83f03c0.ada
+ c83f03c1.ada
+ c83f03c2.ada
+ c83f03d0.ada
+ c83f03d1.ada
+ c840001.a
+ c84002a.ada
+ c84005a.ada
+ c84008a.ada
+ c84009a.ada
+ c85004b.ada
+ c85005a.ada
+ c85005b.ada
+ c85005c.ada
+ c85005d.ada
+ c85005e.ada
+ c85005f.ada
+ c85005g.ada
+ c85006a.ada
+ c85006b.ada
+ c85006c.ada
+ c85006d.ada
+ c85006e.ada
+ c85006f.ada
+ c85006g.ada
+ c85007a.ada
+ c85007e.ada
+ c85009a.ada
+ c85011a.ada
+ c85013a.ada
+ c85014a.ada
+ c85014b.ada
+ c85014c.ada
+ c85017a.ada
+ c85018a.ada
+ c85018b.ada
+ c85019a.ada
+ c854001.a
+ c854002.a
+ c854003.a
+ c86003a.ada
+ c86004a.ada
+ c86004b0.ada
+ c86004b1.ada
+ c86004b2.ada
+ c86004c0.ada
+ c86004c1.ada
+ c86004c2.ada
+ c86006i.ada
+ c86007a.ada
+ c87a05a.ada
+ c87a05b.ada
+ c87b02a.ada
+ c87b02b.ada
+ c87b03a.ada
+ c87b04a.ada
+ c87b04b.ada
+ c87b04c.ada
+ c87b05a.ada
+ c87b06a.ada
+ c87b07a.ada
+ c87b07b.ada
+ c87b07c.ada
+ c87b07d.ada
+ c87b07e.ada
+ c87b08a.ada
+ c87b09a.ada
+ c87b09c.ada
+ c87b10a.ada
+ c87b11a.ada
+ c87b11b.ada
+ c87b13a.ada
+ c87b14a.ada
+ c87b14b.ada
+ c87b14c.ada
+ c87b14d.ada
+ c87b15a.ada
+ c87b16a.ada
+ c87b17a.ada
+ c87b18a.ada
+ c87b18b.ada
+ c87b19a.ada
+ c87b23a.ada
+ c87b24a.ada
+ c87b24b.ada
+ c87b26b.ada
+ c87b27a.ada
+ c87b28a.ada
+ c87b29a.ada
+ c87b30a.ada
+ c87b31a.ada
+ c87b32a.ada
+ c87b33a.ada
+ c87b34a.ada
+ c87b34b.ada
+ c87b34c.ada
+ c87b35c.ada
+ c87b38a.ada
+ c87b39a.ada
+ c87b40a.ada
+ c87b41a.ada
+ c87b42a.ada
+ c87b43a.ada
+ c87b44a.ada
+ c87b45a.ada
+ c87b45c.ada
+ c87b47a.ada
+ c87b48a.ada
+ c87b48b.ada
+ c87b50a.ada
+ c87b54a.ada
+ c87b57a.ada
+ c87b62a.ada
+ c87b62b.ada
+ c87b62c.ada
+ c87b62d.tst
+ c910001.a
+ c910002.a
+ c910003.a
+ c91004b.ada
+ c91004c.ada
+ c91006a.ada
+ c91007a.ada
+ c92002a.ada
+ c92003a.ada
+ c92005a.ada
+ c92005b.ada
+ c92006a.ada
+ c930001.a
+ c93001a.ada
+ c93002a.ada
+ c93003a.ada
+ c93004a.ada
+ c93004b.ada
+ c93004c.ada
+ c93004d.ada
+ c93004f.ada
+ c93005a.ada
+ c93005b.ada
+ c93005c.ada
+ c93005d.ada
+ c93005e.ada
+ c93005f.ada
+ c93005g.ada
+ c93005h.ada
+ c93006a.ada
+ c93007a.ada
+ c93008a.ada
+ c93008b.ada
+ c940001.a
+ c940002.a
+ c940004.a
+ c940005.a
+ c940006.a
+ c940007.a
+ c940010.a
+ c940011.a
+ c940012.a
+ c940013.a
+ c940014.a
+ c940015.a
+ c940016.a
+ c94001a.ada
+ c94001b.ada
+ c94001c.ada
+ c94001e.ada
+ c94001f.ada
+ c94001g.ada
+ c94002a.ada
+ c94002b.ada
+ c94002d.ada
+ c94002e.ada
+ c94002f.ada
+ c94002g.ada
+ c94004a.ada
+ c94004b.ada
+ c94004c.ada
+ c94005a.ada
+ c94005b.ada
+ c94006a.ada
+ c94007a.ada
+ c94007b.ada
+ c94008a.ada
+ c94008b.ada
+ c94008c.ada
+ c94008d.ada
+ c94010a.ada
+ c94011a.ada
+ c94020a.ada
+ c940a03.a
+ c95008a.ada
+ c95009a.ada
+ c95010a.ada
+ c95011a.ada
+ c95012a.ada
+ c95021a.ada
+ c95022a.ada
+ c95022b.ada
+ c95033a.ada
+ c95033b.ada
+ c95034a.ada
+ c95034b.ada
+ c95035a.ada
+ c95040a.ada
+ c95040b.ada
+ c95040c.ada
+ c95040d.ada
+ c95041a.ada
+ c95065a.ada
+ c95065b.ada
+ c95065c.ada
+ c95065d.ada
+ c95065e.ada
+ c95065f.ada
+ c95066a.ada
+ c95067a.ada
+ c95071a.ada
+ c95072a.ada
+ c95072b.ada
+ c95073a.ada
+ c95074c.ada
+ c95076a.ada
+ c95078a.ada
+ c95080b.ada
+ c95082g.ada
+ c95085a.ada
+ c95085b.ada
+ c95085c.ada
+ c95085d.ada
+ c95085e.ada
+ c95085f.ada
+ c95085g.ada
+ c95085h.ada
+ c95085i.ada
+ c95085j.ada
+ c95085k.ada
+ c95085l.ada
+ c95085m.ada
+ c95085n.ada
+ c95085o.ada
+ c95086a.ada
+ c95086b.ada
+ c95086c.ada
+ c95086d.ada
+ c95086e.ada
+ c95086f.ada
+ c95087a.ada
+ c95087b.ada
+ c95087c.ada
+ c95087d.ada
+ c95088a.ada
+ c95089a.ada
+ c95090a.ada
+ c95092a.ada
+ c95093a.ada
+ c95095a.ada
+ c95095b.ada
+ c95095c.ada
+ c95095d.ada
+ c95095e.ada
+ c951001.a
+ c951002.a
+ c953001.a
+ c953002.a
+ c953003.a
+ c954001.a
+ c954010.a
+ c954011.a
+ c954012.a
+ c954013.a
+ c954014.a
+ c954015.a
+ c954016.a
+ c954017.a
+ c954018.a
+ c954019.a
+ c954020.a
+ c954021.a
+ c954022.a
+ c954023.a
+ c954024.a
+ c954025.a
+ c954026.a
+ c954a01.a
+ c954a02.a
+ c954a03.a
+ c960001.a
+ c960002.a
+ c960004.a
+ c96001a.ada
+ c96004a.ada
+ c96005a.ada
+ c96005b.tst
+ c96005d.ada
+ c96005f.ada
+ c96006a.ada
+ c96007a.ada
+ c96008a.ada
+ c96008b.ada
+ c97112a.ada
+ c97113a.ada
+ c97114a.ada
+ c97115a.ada
+ c97116a.ada
+ c97117a.ada
+ c97117b.ada
+ c97117c.ada
+ c97118a.ada
+ c97120a.ada
+ c97120b.ada
+ c97201a.ada
+ c97201b.ada
+ c97201c.ada
+ c97201d.ada
+ c97201e.ada
+ c97201g.ada
+ c97201h.ada
+ c97201x.ada
+ c97202a.ada
+ c97203a.ada
+ c97203b.ada
+ c97203c.ada
+ c97204a.ada
+ c97204b.ada
+ c97205a.ada
+ c97205b.ada
+ c97301a.ada
+ c97301b.ada
+ c97301c.ada
+ c97301d.ada
+ c97301e.ada
+ c97302a.ada
+ c97303a.ada
+ c97303b.ada
+ c97303c.ada
+ c97304a.ada
+ c97304b.ada
+ c97305a.ada
+ c97305b.ada
+ c97305c.ada
+ c97305d.ada
+ c97307a.ada
+ c974001.a
+ c974002.a
+ c974003.a
+ c974004.a
+ c974005.a
+ c974006.a
+ c974007.a
+ c974008.a
+ c974009.a
+ c974010.a
+ c974011.a
+ c974012.a
+ c974013.a
+ c974014.a
+ c980001.a
+ c980002.a
+ c980003.a
+ c99004a.ada
+ c99005a.ada
+ c9a003a.ada
+ c9a004a.ada
+ c9a007a.ada
+ c9a009a.ada
+ c9a009c.ada
+ c9a009f.ada
+ c9a009g.ada
+ c9a009h.ada
+ c9a010a.ada
+ c9a011a.ada
+ c9a011b.ada
+ ca1003a.ada
+ ca1004a.ada
+ ca1005a.ada
+ ca1006a.ada
+ ca1011a0.ada
+ ca1011a1.ada
+ ca1011a2.ada
+ ca1011a3.ada
+ ca1011a4.ada
+ ca1011a5.ada
+ ca1011a6.ada
+ ca1012a0.ada
+ ca1012a1.ada
+ ca1012a2.ada
+ ca1012a3.ada
+ ca1012a4.ada
+ ca1012b0.ada
+ ca1012b2.ada
+ ca1012b4.ada
+ ca1013a0.ada
+ ca1013a1.ada
+ ca1013a2.ada
+ ca1013a3.ada
+ ca1013a4.ada
+ ca1013a5.ada
+ ca1013a6.ada
+ ca1014a0.ada
+ ca1014a1.ada
+ ca1014a2.ada
+ ca1014a3.ada
+ ca1020e0.ada
+ ca1020e1.ada
+ ca1020e2.ada
+ ca1020e3.ada
+ ca1022a0.ada
+ ca1022a1.ada
+ ca1022a2.ada
+ ca1022a3.ada
+ ca1022a4.ada
+ ca1022a5.ada
+ ca1022a6.ada
+ ca11001.a
+ ca11002.a
+ ca11003.a
+ ca110040.a
+ ca110041.a
+ ca110042.am
+ ca110050.a
+ ca110051.am
+ ca11006.a
+ ca11007.a
+ ca11008.a
+ ca11009.a
+ ca11010.a
+ ca11011.a
+ ca11012.a
+ ca11013.a
+ ca11014.a
+ ca11015.a
+ ca11016.a
+ ca11017.a
+ ca11018.a
+ ca11019.a
+ ca11020.a
+ ca11021.a
+ ca11022.a
+ ca1102a0.ada
+ ca1102a1.ada
+ ca1102a2.ada
+ ca1106a.ada
+ ca1108a.ada
+ ca1108b.ada
+ ca11a01.a
+ ca11a02.a
+ ca11b01.a
+ ca11b02.a
+ ca11c01.a
+ ca11c02.a
+ ca11c03.a
+ ca11d010.a
+ ca11d011.a
+ ca11d012.a
+ ca11d013.am
+ ca11d02.a
+ ca11d03.a
+ ca13001.a
+ ca13002.a
+ ca13003.a
+ ca13a01.a
+ ca13a02.a
+ ca140230.a
+ ca140231.a
+ ca140232.am
+ ca140233.a
+ ca140280.a
+ ca140281.a
+ ca140282.a
+ ca140283.am
+ ca15003.a
+ ca200020.a
+ ca200021.a
+ ca200022.am
+ ca2001h0.ada
+ ca2001h1.ada
+ ca2001h2.ada
+ ca2001h3.ada
+ ca2002a0.ada
+ ca2002a1.ada
+ ca2002a2.ada
+ ca2003a0.ada
+ ca2003a1.ada
+ ca2004a0.ada
+ ca2004a1.ada
+ ca2004a2.ada
+ ca2004a3.ada
+ ca2004a4.ada
+ ca2007a0.ada
+ ca2007a1.ada
+ ca2007a2.ada
+ ca2007a3.ada
+ ca2008a0.ada
+ ca2008a1.ada
+ ca2008a2.ada
+ ca2009a.ada
+ ca2009c0.ada
+ ca2009c1.ada
+ ca2009d.ada
+ ca2009f0.ada
+ ca2009f1.ada
+ ca2009f2.ada
+ ca2011b.ada
+ ca21001.a
+ ca3011a0.ada
+ ca3011a1.ada
+ ca3011a2.ada
+ ca3011a3.ada
+ ca3011a4.ada
+ ca5003a0.ada
+ ca5003a1.ada
+ ca5003a2.ada
+ ca5003a3.ada
+ ca5003a4.ada
+ ca5003a5.ada
+ ca5003a6.ada
+ ca5003b0.ada
+ ca5003b1.ada
+ ca5003b2.ada
+ ca5003b3.ada
+ ca5003b4.ada
+ ca5003b5.ada
+ ca5004a.ada
+ ca5004b0.ada
+ ca5004b1.ada
+ ca5004b2.ada
+ ca5006a.ada
+ cb10002.a
+ cb1001a.ada
+ cb1004a.ada
+ cb1005a.ada
+ cb1010a.ada
+ cb1010c.ada
+ cb1010d.ada
+ cb20001.a
+ cb20003.a
+ cb20004.a
+ cb20005.a
+ cb20006.a
+ cb20007.a
+ cb2004a.ada
+ cb2005a.ada
+ cb2006a.ada
+ cb2007a.ada
+ cb20a02.a
+ cb3003a.ada
+ cb3003b.ada
+ cb3004a.ada
+ cb40005.a
+ cb4001a.ada
+ cb4002a.ada
+ cb4003a.ada
+ cb4004a.ada
+ cb4005a.ada
+ cb4006a.ada
+ cb4007a.ada
+ cb4008a.ada
+ cb4009a.ada
+ cb4013a.ada
+ cb40a01.a
+ cb40a020.a
+ cb40a021.am
+ cb40a030.a
+ cb40a031.am
+ cb40a04.a
+ cb41001.a
+ cb41002.a
+ cb41003.a
+ cb41004.a
+ cb5001a.ada
+ cb5001b.ada
+ cb5002a.ada
+ cc1004a.ada
+ cc1005b.ada
+ cc1010a.ada
+ cc1010b.ada
+ cc1018a.ada
+ cc1104c.ada
+ cc1107b.ada
+ cc1111a.ada
+ cc1204a.ada
+ cc1207b.ada
+ cc1220a.ada
+ cc1221a.ada
+ cc1221b.ada
+ cc1221c.ada
+ cc1221d.ada
+ cc1222a.ada
+ cc1223a.ada
+ cc1224a.ada
+ cc1225a.tst
+ cc1226b.ada
+ cc1227a.ada
+ cc1301a.ada
+ cc1302a.ada
+ cc1304a.ada
+ cc1304b.ada
+ cc1307a.ada
+ cc1307b.ada
+ cc1308a.ada
+ cc1310a.ada
+ cc1311a.ada
+ cc1311b.ada
+ cc2002a.ada
+ cc30001.a
+ cc30002.a
+ cc3004a.ada
+ cc3007a.ada
+ cc3007b.ada
+ cc3011a.ada
+ cc3011d.ada
+ cc3012a.ada
+ cc3015a.ada
+ cc3016b.ada
+ cc3016c.ada
+ cc3016f.ada
+ cc3016i.ada
+ cc3017b.ada
+ cc3017c.ada
+ cc3019a.ada
+ cc3019b0.ada
+ cc3019b1.ada
+ cc3019b2.ada
+ cc3019c0.ada
+ cc3019c1.ada
+ cc3019c2.ada
+ cc3106b.ada
+ cc3120a.ada
+ cc3120b.ada
+ cc3121a.ada
+ cc3123a.ada
+ cc3125a.ada
+ cc3125b.ada
+ cc3125c.ada
+ cc3125d.ada
+ cc3126a.ada
+ cc3127a.ada
+ cc3128a.ada
+ cc3203a.ada
+ cc3207b.ada
+ cc3220a.ada
+ cc3221a.ada
+ cc3222a.ada
+ cc3223a.ada
+ cc3224a.ada
+ cc3225a.ada
+ cc3230a.ada
+ cc3231a.ada
+ cc3232a.ada
+ cc3233a.ada
+ cc3234a.ada
+ cc3235a.ada
+ cc3236a.ada
+ cc3240a.ada
+ cc3305a.ada
+ cc3305b.ada
+ cc3305c.ada
+ cc3305d.ada
+ cc3601a.ada
+ cc3601c.ada
+ cc3602a.ada
+ cc3603a.ada
+ cc3605a.ada
+ cc3606a.ada
+ cc3606b.ada
+ cc3607b.ada
+ cc40001.a
+ cc50001.a
+ cc50a01.a
+ cc50a02.a
+ cc51001.a
+ cc51002.a
+ cc51003.a
+ cc51004.a
+ cc51006.a
+ cc51007.a
+ cc51008.a
+ cc51a01.a
+ cc51b03.a
+ cc51d01.a
+ cc51d02.a
+ cc54001.a
+ cc54002.a
+ cc54003.a
+ cc54004.a
+ cc70001.a
+ cc70002.a
+ cc70003.a
+ cc70a01.a
+ cc70a02.a
+ cc70b01.a
+ cc70b02.a
+ cc70c01.a
+ cc70c02.a
+ cd10001.a
+ cd10002.a
+ cd1009a.ada
+ cd1009b.ada
+ cd1009d.ada
+ cd1009e.ada
+ cd1009f.ada
+ cd1009g.ada
+ cd1009h.ada
+ cd1009i.ada
+ cd1009j.ada
+ cd1009k.tst
+ cd1009l.ada
+ cd1009m.ada
+ cd1009n.ada
+ cd1009o.ada
+ cd1009p.ada
+ cd1009q.ada
+ cd1009r.ada
+ cd1009s.ada
+ cd1009t.tst
+ cd1009u.tst
+ cd1009v.ada
+ cd1009w.ada
+ cd1009x.ada
+ cd1009y.ada
+ cd1009z.ada
+ cd1c03a.ada
+ cd1c03b.ada
+ cd1c03c.ada
+ cd1c03e.tst
+ cd1c03f.ada
+ cd1c03g.ada
+ cd1c03h.ada
+ cd1c03i.ada
+ cd1c04a.ada
+ cd1c04d.ada
+ cd1c04e.ada
+ cd1c06a.tst
+ cd20001.a
+ cd2a21a.ada
+ cd2a21c.ada
+ cd2a21e.ada
+ cd2a22a.ada
+ cd2a22e.ada
+ cd2a22i.ada
+ cd2a22j.ada
+ cd2a23a.ada
+ cd2a23e.ada
+ cd2a24a.ada
+ cd2a24e.ada
+ cd2a24i.ada
+ cd2a24j.ada
+ cd2a31a.ada
+ cd2a31c.ada
+ cd2a31e.ada
+ cd2a32a.ada
+ cd2a32c.ada
+ cd2a32e.ada
+ cd2a32g.ada
+ cd2a32i.ada
+ cd2a32j.ada
+ cd2a51a.ada
+ cd2a53a.ada
+ cd2a53e.ada
+ cd2a83c.tst
+ cd2a91c.tst
+ cd2b11a.ada
+ cd2b11b.ada
+ cd2b11d.ada
+ cd2b11e.ada
+ cd2b11f.ada
+ cd2b15c.ada
+ cd2b16a.ada
+ cd2c11a.tst
+ cd2c11d.tst
+ cd2d11a.ada
+ cd2d13a.ada
+ cd30001.a
+ cd30002.a
+ cd30003.a
+ cd30004.a
+ cd300050.am
+ cd300051.c
+ cd3014a.ada
+ cd3014c.ada
+ cd3014d.ada
+ cd3014f.ada
+ cd3015a.ada
+ cd3015c.ada
+ cd3015e.ada
+ cd3015f.ada
+ cd3015g.ada
+ cd3015h.ada
+ cd3015i.ada
+ cd3015k.ada
+ cd3021a.ada
+ cd33001.a
+ cd33002.a
+ cd40001.a
+ cd4031a.ada
+ cd4041a.tst
+ cd4051a.ada
+ cd4051b.ada
+ cd4051c.ada
+ cd4051d.ada
+ cd5003a.ada
+ cd5003b.ada
+ cd5003c.ada
+ cd5003d.ada
+ cd5003e.ada
+ cd5003f.ada
+ cd5003g.ada
+ cd5003h.ada
+ cd5003i.ada
+ cd5011a.ada
+ cd5011c.ada
+ cd5011e.ada
+ cd5011g.ada
+ cd5011i.ada
+ cd5011k.ada
+ cd5011m.ada
+ cd5011q.ada
+ cd5011s.ada
+ cd5012a.ada
+ cd5012b.ada
+ cd5012e.ada
+ cd5012f.ada
+ cd5012i.ada
+ cd5012m.ada
+ cd5013a.ada
+ cd5013c.ada
+ cd5013e.ada
+ cd5013g.ada
+ cd5013i.ada
+ cd5013k.ada
+ cd5013m.ada
+ cd5013o.ada
+ cd5014a.ada
+ cd5014c.ada
+ cd5014e.ada
+ cd5014g.ada
+ cd5014i.ada
+ cd5014k.ada
+ cd5014m.ada
+ cd5014o.ada
+ cd5014t.ada
+ cd5014v.ada
+ cd5014x.ada
+ cd5014y.ada
+ cd5014z.ada
+ cd70001.a
+ cd7002a.ada
+ cd7007b.ada
+ cd7101d.ada
+ cd7101e.dep
+ cd7101f.dep
+ cd7101g.tst
+ cd7103d.ada
+ cd7202a.ada
+ cd7204b.ada
+ cd7204c.ada
+ cd72a01.a
+ cd72a02.a
+ cd7305a.ada
+ cd90001.a
+ cd92001.a
+ cda201a.ada
+ cda201b.ada
+ cda201c.ada
+ cda201e.ada
+ cdb0a01.a
+ cdb0a02.a
+ cdd1001.a
+ cdd2001.a
+ cdd2a01.a
+ cdd2a02.a
+ cdd2a03.a
+ cde0001.a
+ ce2102a.ada
+ ce2102b.ada
+ ce2102c.tst
+ ce2102d.ada
+ ce2102e.ada
+ ce2102f.ada
+ ce2102g.ada
+ ce2102h.tst
+ ce2102i.ada
+ ce2102j.ada
+ ce2102k.ada
+ ce2102l.ada
+ ce2102m.ada
+ ce2102n.ada
+ ce2102o.ada
+ ce2102p.ada
+ ce2102q.ada
+ ce2102r.ada
+ ce2102s.ada
+ ce2102t.ada
+ ce2102u.ada
+ ce2102v.ada
+ ce2102w.ada
+ ce2102x.ada
+ ce2102y.ada
+ ce2103a.tst
+ ce2103b.tst
+ ce2103c.ada
+ ce2103d.ada
+ ce2104a.ada
+ ce2104b.ada
+ ce2104c.ada
+ ce2104d.ada
+ ce2106a.ada
+ ce2106b.ada
+ ce2108e.ada
+ ce2108f.ada
+ ce2108g.ada
+ ce2108h.ada
+ ce2109a.ada
+ ce2109b.ada
+ ce2109c.ada
+ ce2110a.ada
+ ce2110c.ada
+ ce2111a.ada
+ ce2111b.ada
+ ce2111c.ada
+ ce2111e.ada
+ ce2111f.ada
+ ce2111g.ada
+ ce2111i.ada
+ ce2201a.ada
+ ce2201b.ada
+ ce2201c.ada
+ ce2201d.dep
+ ce2201e.dep
+ ce2201f.ada
+ ce2201g.ada
+ ce2201h.ada
+ ce2201i.ada
+ ce2201j.ada
+ ce2201k.ada
+ ce2201l.ada
+ ce2201m.ada
+ ce2201n.ada
+ ce2202a.ada
+ ce2203a.tst
+ ce2204a.ada
+ ce2204b.ada
+ ce2204c.ada
+ ce2204d.ada
+ ce2205a.ada
+ ce2206a.ada
+ ce2208b.ada
+ ce2401a.ada
+ ce2401b.ada
+ ce2401c.ada
+ ce2401e.ada
+ ce2401f.ada
+ ce2401h.ada
+ ce2401i.ada
+ ce2401j.ada
+ ce2401k.ada
+ ce2401l.ada
+ ce2402a.ada
+ ce2403a.tst
+ ce2404a.ada
+ ce2404b.ada
+ ce2405b.ada
+ ce2406a.ada
+ ce2407a.ada
+ ce2407b.ada
+ ce2408a.ada
+ ce2408b.ada
+ ce2409a.ada
+ ce2409b.ada
+ ce2410a.ada
+ ce2410b.ada
+ ce2411a.ada
+ ce3002b.tst
+ ce3002c.tst
+ ce3002d.ada
+ ce3002f.ada
+ ce3102a.ada
+ ce3102b.tst
+ ce3102d.ada
+ ce3102e.ada
+ ce3102f.ada
+ ce3102g.ada
+ ce3102h.ada
+ ce3102i.ada
+ ce3102j.ada
+ ce3102k.ada
+ ce3103a.ada
+ ce3104a.ada
+ ce3104b.ada
+ ce3104c.ada
+ ce3106a.ada
+ ce3106b.ada
+ ce3107a.tst
+ ce3107b.ada
+ ce3108a.ada
+ ce3108b.ada
+ ce3110a.ada
+ ce3112c.ada
+ ce3112d.ada
+ ce3114a.ada
+ ce3115a.ada
+ ce3201a.ada
+ ce3202a.ada
+ ce3206a.ada
+ ce3207a.ada
+ ce3301a.ada
+ ce3302a.ada
+ ce3303a.ada
+ ce3304a.tst
+ ce3305a.ada
+ ce3306a.ada
+ ce3401a.ada
+ ce3402a.ada
+ ce3402c.ada
+ ce3402d.ada
+ ce3402e.ada
+ ce3403a.ada
+ ce3403b.ada
+ ce3403c.ada
+ ce3403d.ada
+ ce3403e.ada
+ ce3403f.ada
+ ce3404a.ada
+ ce3404b.ada
+ ce3404c.ada
+ ce3404d.ada
+ ce3405a.ada
+ ce3405c.ada
+ ce3405d.ada
+ ce3406a.ada
+ ce3406b.ada
+ ce3406c.ada
+ ce3406d.ada
+ ce3407a.ada
+ ce3407b.ada
+ ce3407c.ada
+ ce3408a.ada
+ ce3408b.ada
+ ce3408c.ada
+ ce3409a.ada
+ ce3409b.ada
+ ce3409c.ada
+ ce3409d.ada
+ ce3409e.ada
+ ce3410a.ada
+ ce3410b.ada
+ ce3410c.ada
+ ce3410d.ada
+ ce3410e.ada
+ ce3411a.ada
+ ce3411c.ada
+ ce3412a.ada
+ ce3413a.ada
+ ce3413b.ada
+ ce3413c.ada
+ ce3414a.ada
+ ce3601a.ada
+ ce3602a.ada
+ ce3602b.ada
+ ce3602c.ada
+ ce3602d.ada
+ ce3603a.ada
+ ce3604a.ada
+ ce3604b.ada
+ ce3605a.ada
+ ce3605b.ada
+ ce3605c.ada
+ ce3605d.ada
+ ce3605e.ada
+ ce3606a.ada
+ ce3606b.ada
+ ce3701a.ada
+ ce3704a.ada
+ ce3704b.ada
+ ce3704c.ada
+ ce3704d.ada
+ ce3704e.ada
+ ce3704f.ada
+ ce3704m.ada
+ ce3704n.ada
+ ce3704o.ada
+ ce3705a.ada
+ ce3705b.ada
+ ce3705c.ada
+ ce3705d.ada
+ ce3705e.ada
+ ce3706c.ada
+ ce3706d.ada
+ ce3706f.ada
+ ce3706g.ada
+ ce3707a.ada
+ ce3708a.ada
+ ce3801a.ada
+ ce3801b.ada
+ ce3804a.ada
+ ce3804b.ada
+ ce3804c.ada
+ ce3804d.ada
+ ce3804e.ada
+ ce3804f.ada
+ ce3804g.ada
+ ce3804h.ada
+ ce3804i.ada
+ ce3804j.ada
+ ce3804m.ada
+ ce3804o.ada
+ ce3804p.ada
+ ce3805a.ada
+ ce3805b.ada
+ ce3806a.ada
+ ce3806b.ada
+ ce3806c.ada
+ ce3806d.ada
+ ce3806e.ada
+ ce3806f.ada
+ ce3806g.ada
+ ce3806h.ada
+ ce3809a.ada
+ ce3809b.ada
+ ce3810a.ada
+ ce3810b.ada
+ ce3815a.ada
+ ce3901a.ada
+ ce3902b.ada
+ ce3904a.ada
+ ce3904b.ada
+ ce3905a.ada
+ ce3905b.ada
+ ce3905c.ada
+ ce3905l.ada
+ ce3906a.ada
+ ce3906b.ada
+ ce3906c.ada
+ ce3906d.ada
+ ce3906e.ada
+ ce3906f.ada
+ ce3907a.ada
+ ce3908a.ada
+ checkfil.ada
+ coverage.txt
+ cxa3001.a
+ cxa3002.a
+ cxa3003.a
+ cxa3004.a
+ cxa4001.a
+ cxa4002.a
+ cxa4003.a
+ cxa4004.a
+ cxa4005.a
+ cxa4006.a
+ cxa4007.a
+ cxa4008.a
+ cxa4009.a
+ cxa4010.a
+ cxa4011.a
+ cxa4012.a
+ cxa4013.a
+ cxa4014.a
+ cxa4015.a
+ cxa4016.a
+ cxa4017.a
+ cxa4018.a
+ cxa4019.a
+ cxa4020.a
+ cxa4021.a
+ cxa4022.a
+ cxa4023.a
+ cxa4024.a
+ cxa4025.a
+ cxa4026.a
+ cxa4027.a
+ cxa4028.a
+ cxa4029.a
+ cxa4030.a
+ cxa4031.a
+ cxa4032.a
+ cxa4033.a
+ cxa4034.a
+ cxa5011.a
+ cxa5012.a
+ cxa5013.a
+ cxa5015.a
+ cxa5a01.a
+ cxa5a02.a
+ cxa5a03.a
+ cxa5a04.a
+ cxa5a05.a
+ cxa5a06.a
+ cxa5a07.a
+ cxa5a08.a
+ cxa5a09.a
+ cxa5a10.a
+ cxa8001.a
+ cxa8002.a
+ cxa8003.a
+ cxa9001.a
+ cxa9002.a
+ cxaa001.a
+ cxaa002.a
+ cxaa003.a
+ cxaa004.a
+ cxaa005.a
+ cxaa006.a
+ cxaa007.a
+ cxaa008.a
+ cxaa009.a
+ cxaa010.a
+ cxaa011.a
+ cxaa012.a
+ cxaa013.a
+ cxaa014.a
+ cxaa015.a
+ cxaa016.a
+ cxaa017.a
+ cxaa018.a
+ cxaa019.a
+ cxab001.a
+ cxac001.a
+ cxac002.a
+ cxac003.a
+ cxac004.a
+ cxac005.a
+ cxaca01.a
+ cxaca02.a
+ cxacb01.a
+ cxacb02.a
+ cxacc01.a
+ cxaf001.a
+ cxb2001.a
+ cxb2002.a
+ cxb2003.a
+ cxb3001.a
+ cxb3002.a
+ cxb3003.a
+ cxb30040.c
+ cxb30041.am
+ cxb3005.a
+ cxb30060.c
+ cxb30061.am
+ cxb3007.a
+ cxb3008.a
+ cxb3009.a
+ cxb3010.a
+ cxb3011.a
+ cxb3012.a
+ cxb30130.c
+ cxb30131.c
+ cxb30132.am
+ cxb3014.a
+ cxb3015.a
+ cxb3016.a
+ cxb4001.a
+ cxb4002.a
+ cxb4003.a
+ cxb4004.a
+ cxb4005.a
+ cxb4006.a
+ cxb4007.a
+ cxb4008.a
+ cxb40090.cbl
+ cxb40091.cbl
+ cxb40092.cbl
+ cxb40093.am
+ cxb5001.a
+ cxb5002.a
+ cxb5003.a
+ cxb50040.ftn
+ cxb50041.ftn
+ cxb50042.am
+ cxb50050.ftn
+ cxb50051.ftn
+ cxb50052.am
+ cxc3001.a
+ cxc3002.a
+ cxc3003.a
+ cxc3004.a
+ cxc3005.a
+ cxc3006.a
+ cxc3007.a
+ cxc3008.a
+ cxc3009.a
+ cxc6001.a
+ cxc6002.a
+ cxc6003.a
+ cxc7001.a
+ cxc7002.a
+ cxc7003.a
+ cxc7004.a
+ cxd1001.a
+ cxd1002.a
+ cxd1003.a
+ cxd1004.a
+ cxd1005.a
+ cxd1006.a
+ cxd1007.a
+ cxd1008.a
+ cxd2001.a
+ cxd2002.a
+ cxd2003.a
+ cxd2004.a
+ cxd2006.a
+ cxd2007.a
+ cxd2008.a
+ cxd3001.a
+ cxd3002.a
+ cxd3003.a
+ cxd4001.a
+ cxd4002.a
+ cxd4003.a
+ cxd4004.a
+ cxd4005.a
+ cxd4006.a
+ cxd4007.a
+ cxd4008.a
+ cxd4009.a
+ cxd4010.a
+ cxd5001.a
+ cxd6001.a
+ cxd6002.a
+ cxd6003.a
+ cxd8001.a
+ cxd8002.a
+ cxd8003.a
+ cxd9001.a
+ cxda001.a
+ cxda002.a
+ cxda003.a
+ cxda004.a
+ cxdb001.a
+ cxdb002.a
+ cxdb003.a
+ cxdb004.a
+ cxe1001.a
+ cxe2001.a
+ cxe2002.a
+ cxe4001.a
+ cxe4002.a
+ cxe4003.a
+ cxe4004.a
+ cxe4005.a
+ cxe4006.a
+ cxe5001.a
+ cxe5002.a
+ cxe5003.a
+ cxf1001.a
+ cxf2001.a
+ cxf2002.a
+ cxf2003.a
+ cxf2004.a
+ cxf2005.a
+ cxf2a01.a
+ cxf2a02.a
+ cxf3001.a
+ cxf3002.a
+ cxf3003.a
+ cxf3004.a
+ cxf3a01.a
+ cxf3a02.a
+ cxf3a03.a
+ cxf3a04.a
+ cxf3a05.a
+ cxf3a06.a
+ cxf3a07.a
+ cxf3a08.a
+ cxg1001.a
+ cxg1002.a
+ cxg1003.a
+ cxg1004.a
+ cxg1005.a
+ cxg2001.a
+ cxg2002.a
+ cxg2003.a
+ cxg2004.a
+ cxg2005.a
+ cxg2006.a
+ cxg2007.a
+ cxg2008.a
+ cxg2009.a
+ cxg2010.a
+ cxg2011.a
+ cxg2012.a
+ cxg2013.a
+ cxg2014.a
+ cxg2015.a
+ cxg2016.a
+ cxg2017.a
+ cxg2018.a
+ cxg2019.a
+ cxg2020.a
+ cxg2021.a
+ cxg2022.a
+ cxg2023.a
+ cxg2024.a
+ cxh1001.a
+ cxh3001.a
+ cxh3002.a
+ cxh30030.a
+ cxh30031.am
+ cz00004.a
+ cz1101a.ada
+ cz1102a.ada
+ cz1103a.ada
+ d4a002a.ada
+ d4a002b.ada
+ d4a004a.ada
+ d4a004b.ada
+ e28002b.ada
+ e28005d.ada
+ e52103y.ada
+ eb4011a.ada
+ eb4012a.ada
+ eb4014a.ada
+ ee3203a.ada
+ ee3204a.ada
+ ee3402b.ada
+ ee3409f.ada
+ ee3412c.ada
+ enumchek.ada
+ f340a000.a
+ f340a001.a
+ f341a00.a
+ f390a00.a
+ f392a00.a
+ f392c00.a
+ f392d00.a
+ f393a00.a
+ f393b00.a
+ f3a2a00.a
+ f460a00.a
+ f730a000.a
+ f730a001.a
+ f731a00.a
+ f940a00.a
+ f954a00.a
+ fa11a00.a
+ fa11b00.a
+ fa11c00.a
+ fa11d00.a
+ fa13a00.a
+ fa13b00.a
+ fa21a00.a
+ fb20a00.a
+ fb40a00.a
+ fc50a00.a
+ fc51a00.a
+ fc51b00.a
+ fc51c00.a
+ fc51d00.a
+ fc54a00.a
+ fc70a00.a
+ fc70b00.a
+ fc70c00.a
+ fcndecl.ada
+ fd72a00.a
+ fdb0a00.a
+ fdd2a00.a
+ fxa5a00.a
+ fxaca00.a
+ fxacb00.a
+ fxacc00.a
+ fxc6a00.a
+ fxe2a00.a
+ fxf2a00.a
+ fxf3a00.a
+ impdef.a
+ impdefc.a
+ impdefd.a
+ impdefe.a
+ impdefg.a
+ impdefh.a
+ la140010.a
+ la140011.am
+ la140012.a
+ la140020.a
+ la140021.am
+ la140022.a
+ la140030.a
+ la140031.a
+ la140032.am
+ la140033.a
+ la140040.a
+ la140041.am
+ la140042.a
+ la140050.a
+ la140051.a
+ la140052.am
+ la140053.a
+ la140060.a
+ la140061.a
+ la140062.am
+ la140063.a
+ la140070.a
+ la140071.a
+ la140072.am
+ la140073.a
+ la140080.a
+ la140081.a
+ la140082.am
+ la140083.a
+ la140090.a
+ la140091.a
+ la140092.am
+ la140093.a
+ la140100.a
+ la140101.a
+ la140102.am
+ la140103.a
+ la140110.a
+ la140111.a
+ la140112.am
+ la140113.a
+ la140120.a
+ la140121.a
+ la140122.am
+ la140123.a
+ la140130.a
+ la140131.a
+ la140132.am
+ la140133.a
+ la140140.a
+ la140141.a
+ la140142.am
+ la140143.a
+ la140150.a
+ la140151.a
+ la140152.am
+ la140153.a
+ la140160.a
+ la140161.a
+ la140162.am
+ la140163.a
+ la140170.a
+ la140171.a
+ la140172.am
+ la140173.a
+ la140180.a
+ la140181.a
+ la140182.am
+ la140183.a
+ la140190.a
+ la140191.a
+ la140192.am
+ la140193.a
+ la140200.a
+ la140201.a
+ la140202.am
+ la140203.a
+ la140210.a
+ la140211.am
+ la140212.a
+ la140220.a
+ la140221.am
+ la140222.a
+ la140240.a
+ la140241.a
+ la140242.am
+ la140243.a
+ la140250.a
+ la140251.am
+ la140252.a
+ la140260.a
+ la140261.a
+ la140262.am
+ la140263.a
+ la140270.a
+ la140271.a
+ la140272.am
+ la140273.a
+ la200010.a
+ la200011.a
+ la200012.am
+ la5001a0.ada
+ la5001a1.ada
+ la5001a2.ada
+ la5001a3.ada
+ la5001a4.ada
+ la5001a5.ada
+ la5001a6.ada
+ la5001a7.ada
+ la5007a0.ada
+ la5007a1.ada
+ la5007b0.ada
+ la5007b1.ada
+ la5007c0.ada
+ la5007c1.ada
+ la5007d0.ada
+ la5007d1.ada
+ la5007e0.ada
+ la5007e1.ada
+ la5007f0.ada
+ la5007f1.ada
+ la5007g0.ada
+ la5007g1.ada
+ la5008a0.ada
+ la5008a1.ada
+ la5008b0.ada
+ la5008b1.ada
+ la5008c0.ada
+ la5008c1.ada
+ la5008d0.ada
+ la5008d1.ada
+ la5008e0.ada
+ la5008e1.ada
+ la5008f0.ada
+ la5008f1.ada
+ la5008g0.ada
+ la5008g1.ada
+ lc300010.a
+ lc300011.a
+ lc300012.am
+ lc300020.a
+ lc300021.a
+ lc300022.am
+ lc300030.a
+ lc300031.a
+ lc300032.am
+ lencheck.ada
+ lxd70010.a
+ lxd70011.a
+ lxd70012.am
+ lxd70030.a
+ lxd70031.a
+ lxd70032.am
+ lxd70040.a
+ lxd70041.a
+ lxd70042.am
+ lxd70050.a
+ lxd70051.a
+ lxd70052.am
+ lxd70060.a
+ lxd70061.a
+ lxd70062.am
+ lxd70070.a
+ lxd70071.a
+ lxd70072.am
+ lxd70080.a
+ lxd70081.a
+ lxd70082.am
+ lxd70090.a
+ lxd70091.a
+ lxd70092.am
+ lxe30010.am
+ lxe30011.am
+ lxe30020.am
+ lxe30021.am
+ lxh40010.a
+ lxh40011.a
+ lxh40012.am
+ lxh40020.a
+ lxh40021.a
+ lxh40022.am
+ lxh40030.a
+ lxh40031.a
+ lxh40032.a
+ lxh40033.am
+ lxh40040.a
+ lxh40041.a
+ lxh40042.a
+ lxh40043.am
+ lxh40050.a
+ lxh40051.a
+ lxh40052.a
+ lxh40053.am
+ lxh40060.a
+ lxh40061.a
+ lxh40062.a
+ lxh40063.am
+ lxh40070.a
+ lxh40071.a
+ lxh40072.a
+ lxh40073.am
+ lxh40080.a
+ lxh40081.a
+ lxh40082.a
+ lxh40083.a
+ lxh40084.am
+ lxh40090.a
+ lxh40091.a
+ lxh40092.a
+ lxh40093.am
+ lxh40100.a
+ lxh40101.a
+ lxh40102.a
+ lxh40103.am
+ lxh40110.a
+ lxh40111.a
+ lxh40112.am
+ lxh40120.a
+ lxh40121.a
+ lxh40122.a
+ lxh40123.am
+ lxh40130.a
+ lxh40131.a
+ lxh40132.a
+ lxh40133.am
+ lxh40140.a
+ lxh40141.a
+ lxh40142.am
+ macro.dfs
+ macrosub.ada
+ repbody.ada
+ repspec.ada
+ spprt13s.tst
+ tctouch.ada
+ testobj.txt
+ tsttests.dat
+ ug-apxa.doc
+ ug-apxa.pdf
+ ug-apxa.txt
+ ug-apxb.doc
+ ug-apxb.pdf
+ ug-apxb.txt
+ ug-apxc.doc
+ ug-apxc.pdf
+ ug-apxc.txt
+ ug-apxd.doc
+ ug-apxd.pdf
+ ug-apxd.txt
+ ug-body.doc
+ ug-body.pdf
+ ug-body.txt
+ widechr.a
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/checkfil.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/checkfil.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/checkfil.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/checkfil.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,197 ----
+ -- CHECK_FILE.ADA
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- THIS IS A PROCEDURE USED BY MANY OF THE CHAPTER 14 TESTS TO CHECK THE
+ -- CONTENTS OF A TEXT FILE.
+ 
+ -- THIS PROCEDURE ASSUMES THE FILE PARAMETER PASSED TO IT IS AN OPEN
+ -- TEXT FILE.
+ 
+ -- THE STRING PARAMETER CONTAINS THE CHARACTERS THAT ARE SUPPOSED TO BE
+ -- IN THE TEXT FILE.  A '#' CHARACTER IS USED IN THE STRING TO DENOTE 
+ -- THE END OF A LINE.  A '@' CHARACTER IS USED TO DENOTE THE END OF A 
+ -- PAGE. A '%' CHARACTER IS USED TO DENOTE THE END OF THE TEXT FILE.
+ -- THESE SYMBOLS SHOULD NOT BE USED AS TEXT OUTPUT.
+ 
+ -- SPS 11/30/82
+ -- JBG 2/3/83
+ 
+ WITH REPORT; USE REPORT;
+ WITH TEXT_IO; USE TEXT_IO;
+ 
+ PROCEDURE CHECK_FILE (FILE: IN OUT FILE_TYPE; CONTENTS : STRING) IS
+ 
+      X : CHARACTER;
+      COL_COUNT : POSITIVE_COUNT := 1;
+      LINE_COUNT : POSITIVE_COUNT := 1;
+      PAGE_COUNT : POSITIVE_COUNT := 1;
+      TRAILING_BLANKS_MSG_WRITTEN : BOOLEAN := FALSE;
+      STOP_PROCESSING : EXCEPTION;
+ 
+      PROCEDURE CHECK_END_OF_LINE (EXPECT_END_OF_PAGE : BOOLEAN) IS
+      BEGIN
+ 
+ -- SKIP OVER ANY TRAILING BLANKS.  AN IMPLEMENTATION CAN LEGALLY
+ -- APPEND BLANKS TO THE END OF ANY LINE.
+ 
+           WHILE NOT END_OF_LINE (FILE) LOOP
+                GET (FILE, X);
+                IF X /= ' ' THEN
+                     FAILED ("FROM CHECK_FILE: END OF LINE EXPECTED - " &
+                             X & " ENCOUNTERED");
+                     RAISE STOP_PROCESSING;
+                ELSE
+                     IF NOT TRAILING_BLANKS_MSG_WRITTEN THEN
+                          COMMENT ("FROM CHECK_FILE: " &
+                                   "THIS IMPLEMENTATION PADS " &
+                                   "LINES WITH BLANKS");
+                          TRAILING_BLANKS_MSG_WRITTEN := TRUE;
+                     END IF;
+                END IF;
+           END LOOP;
+ 
+           IF LINE_COUNT /= LINE (FILE) THEN
+                FAILED ("FROM CHECK_FILE: " &
+                        "LINE COUNT INCORRECT - EXPECTED " &
+                        POSITIVE_COUNT'IMAGE(LINE_COUNT) &
+                        " GOT FROM FILE " & 
+                        POSITIVE_COUNT'IMAGE(LINE(FILE)));
+           END IF;
+ 
+ -- NOTE:  DO NOT SKIP_LINE WHEN AT END OF PAGE BECAUSE SKIP_LINE WILL
+ --        ALSO SKIP THE PAGE TERMINATOR.  SEE RM 14.3.5 PARAGRAPH 1.
+ 
+           IF NOT EXPECT_END_OF_PAGE THEN
+                IF END_OF_PAGE (FILE) THEN
+                     FAILED ("FROM CHECK_FILE: PREMATURE END OF PAGE");
+                     RAISE STOP_PROCESSING;
+                ELSE
+                     SKIP_LINE (FILE);
+                     LINE_COUNT := LINE_COUNT + 1;
+                END IF;
+           END IF;
+           COL_COUNT := 1;
+      END CHECK_END_OF_LINE;
+ 
+      PROCEDURE CHECK_END_OF_PAGE IS
+      BEGIN
+           IF NOT END_OF_PAGE (FILE) THEN
+                FAILED ("FROM CHECK_FILE: " &
+                        "END_OF_PAGE NOT WHERE EXPECTED");
+                RAISE STOP_PROCESSING;
+           ELSE
+                IF PAGE_COUNT /= PAGE (FILE) THEN
+                     FAILED ("FROM CHECK_FILE: " &
+                             "PAGE COUNT INCORRECT - EXPECTED " &
+                             POSITIVE_COUNT'IMAGE (PAGE_COUNT) &
+                             " GOT FROM FILE " &
+                             POSITIVE_COUNT'IMAGE (PAGE(FILE)));
+                END IF;
+ 
+                SKIP_PAGE (FILE);
+                PAGE_COUNT := PAGE_COUNT + 1;
+                LINE_COUNT := 1;
+           END IF;
+      END CHECK_END_OF_PAGE;
+ 
+ BEGIN
+ 
+      RESET (FILE, IN_FILE);
+      SET_LINE_LENGTH (STANDARD_OUTPUT, 0);
+      SET_PAGE_LENGTH (STANDARD_OUTPUT, 0);
+ 
+      FOR I IN 1 .. CONTENTS'LENGTH LOOP
+ 
+           BEGIN
+                CASE CONTENTS (I) IS
+                     WHEN '#' =>
+                          CHECK_END_OF_LINE (CONTENTS (I + 1) = '@');
+                     WHEN '@' =>
+                          CHECK_END_OF_PAGE;
+                     WHEN '%' =>
+                          IF NOT END_OF_FILE (FILE) THEN
+                               FAILED ("FROM CHECK_FILE: " &
+                                       "END_OF_FILE NOT WHERE EXPECTED");
+                               RAISE STOP_PROCESSING;
+                          END IF;
+                     WHEN OTHERS =>
+                          IF COL_COUNT /= COL(FILE) THEN
+                               FAILED ("FROM CHECK_FILE: " &
+                                       "COL COUNT INCORRECT - " &
+                                       "EXPECTED " & POSITIVE_COUNT'
+                                       IMAGE(COL_COUNT) & " GOT FROM " &
+                                       "FILE " & POSITIVE_COUNT'IMAGE
+                                       (COL(FILE)));
+                          END IF;
+                          GET (FILE, X);
+                          COL_COUNT := COL_COUNT + 1;
+                          IF X /= CONTENTS (I) THEN
+                               FAILED("FROM CHECK_FILE: " &
+                                      "FILE DOES NOT CONTAIN CORRECT " &
+                                      "OUTPUT - EXPECTED " & CONTENTS(I) 
+                                      & " - GOT " & X);
+                               RAISE STOP_PROCESSING;
+                          END IF;
+                END CASE;
+           EXCEPTION
+                WHEN STOP_PROCESSING =>
+                     COMMENT ("FROM CHECK_FILE: " &
+                              "LAST CHARACTER IN FOLLOWING STRING " &
+                              "REVEALED ERROR: " & CONTENTS (1 .. I));
+                     EXIT;
+           END;
+  
+      END LOOP;
+ 
+ EXCEPTION
+      WHEN STATUS_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "STATUS_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN MODE_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "MODE_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN NAME_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "NAME_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN USE_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "USE_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN DEVICE_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "DEVICE_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN END_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "END_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN DATA_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "DATA_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN LAYOUT_ERROR =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "LAYOUT_ERROR RAISED - FILE CHECKING INCOMPLETE");
+      WHEN OTHERS =>
+           FAILED ("FROM CHECK_FILE: " &
+                   "SOME EXCEPTION RAISED - FILE CHECKING INCOMPLETE");
+ 
+ END CHECK_FILE;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/enumchek.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/enumchek.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/enumchek.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/enumchek.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE ACVC
+ -- CHAPTER 13 C TESTS. IT IS INSTANTIATED WITH TWO TYPES. THE FIRST IS AN
+ -- ENUMERATION TYPE FOR WHICH AN ENUMERATION CLAUSE HAS BEEN GIVEN, AND THE
+ -- SECOND IS AN INTEGER TYPE WHOSE 'SIZE IS THE SAME AS THE 'SIZE OF THIS
+ -- ENUMERATION TYPE.
+ 
+ -- THE PROCEDURE ENUM_CHECK IS THEN CALLED WITH THREE ARGUMENTS. THE FIRST IS
+ -- AN ENUMERATION LITERAL FROM THE ENUMERATION TYPE, THE SECOND IS AN INTEGER
+ -- LITERAL WHICH IS THE VALUE OF THE EXPECTED REPRESENTATION (TAKEN FROM THE
+ -- ENUMERATION REPRESENTATION CLAUSE), AND THE THIRD IS A STRING DESCRIBING OR
+ -- NAMING THE TYPE (USED IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS).
+ 
+ -- THE CHECK IS TO CONVERT THE ENUMERATION VALUE TO A BOOLEAN ARRAY WITH A
+ -- LENGTH CORRESONDING TO THE 'SIZE OF THE ENUMERATION TYPE. AN INTEGER TYPE
+ -- IS THEN CREATED WITH THIS SAME 'SIZE, AND THE REQUIRED REPRESENTATION VALUE
+ -- IS CONVERTED FROM THIS TYPE TO A BOOLEAN ARRAY WITH THE SAME LENGTH. THE
+ -- TWO BOOLEAN ARRAYS ARE THEN COMPARED AND SHOULD BE EQUAL. THE CONVERSIONS
+ -- ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF UNCHECKED_CONVERSION.
+ 
+ -- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE AUTHORIZED
+ 
+ GENERIC
+ 
+    TYPE ENUM_TYPE IS PRIVATE;
+    TYPE INT_TYPE IS RANGE <>;
+ 
+ PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE;
+ 		      REP_VALUE  : INT_TYPE;
+ 		      TYPE_ID	 : STRING);
+ 
+ 
+ WITH UNCHECKED_CONVERSION;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE;
+ 		      REP_VALUE  : INT_TYPE;
+ 		      TYPE_ID	 : STRING) IS
+ 
+    TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. ENUM_TYPE'SIZE) OF BOOLEAN;
+    PRAGMA PACK (BIT_ARRAY_TYPE);
+ 
+    FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (ENUM_TYPE, BIT_ARRAY_TYPE);
+    FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (INT_TYPE, BIT_ARRAY_TYPE);
+ 
+    BIT_ARRAY_1 : BIT_ARRAY_TYPE;
+    BIT_ARRAY_2 : BIT_ARRAY_TYPE;
+ 
+    INT_VALUE : INT_TYPE := INT_TYPE (REP_VALUE);
+ 
+ BEGIN
+ 
+    -- VERIFY CORRECT CALL (THIS IS A SANITY CHECK ON THE TEST ITSELF)
+ 
+    IF ENUM_TYPE'SIZE /= INT_TYPE'SIZE THEN
+       FAILED ("ERROR IN ENUM_CHECK CALL: SIZES DO NOT MATCH");
+    END IF;
+ 
+    BIT_ARRAY_1 := TO_BITS (TEST_VALUE);
+    BIT_ARRAY_2 := TO_BITS (INT_VALUE);
+ 
+    IF BIT_ARRAY_1 /= BIT_ARRAY_2 THEN
+       FAILED ("CHECK ON REPRESENTATION OF TYPE " & TYPE_ID & " FAILED.");
+    END IF;
+ 
+ END ENUM_CHECK;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f340a000.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f340a000.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f340a000.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f340a000.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- F340A000.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This file simulates a generic linked list abstraction for use in tests
+ --      covering tagged types and type extensions.
+ --
+ -- TEST FILES:
+ --      This foundation consists of the following files:
+ --
+ --      => F340A000.A
+ --         F340A001.A
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma
+ --                          Elaborate_Body.
+ --
+ --!
+ 
+ generic  -- Singly-linked list abstraction.
+    type Parent_Type is tagged private;                   -- Actual is parent
+ package F340A000 is                                      -- tagged type.
+ 
+    pragma Elaborate_Body;
+ 
+ 
+    -- Declarations for visible linked list nodes:
+ 
+    type Node_Type;
+ 
+    type Node_Ptr is access Node_Type;
+ 
+    type Node_Type is new Parent_Type with record         -- Record extension
+       Next : Node_Ptr := null;                           -- of parent type.
+    end record;
+ 
+ 
+    -- Inherits primitive operations of actual type corresponding
+    -- to Parent_Type.
+ 
+    -- Add node at head of list.
+    procedure Add (Item : in     Node_Ptr;
+                   Head : in out Node_Ptr);
+ 
+    -- Remove node from head of list and return it.
+    procedure Remove (Head : in out Node_Ptr;
+                      Item :    out Node_Ptr);
+ 
+ 
+ 
+    -- Declarations for private linked list nodes:
+ 
+    type Priv_Node_Type is new Parent_Type with private;  -- Private extension
+                                                          -- of parent type.
+ 
+    -- Inherits primitive operations of actual parameter corresponding
+    -- to Parent_Type.
+ 
+ 
+    type Priv_Node_Ptr is access Priv_Node_Type;
+ 
+ 
+    -- Add node at head of list.
+    procedure Add (Item : in     Priv_Node_Ptr;
+                   Head : in out Priv_Node_Ptr);
+ 
+    -- Remove node from head of list and return it.
+    procedure Remove (Head : in out Priv_Node_Ptr;
+                      Item :    out Priv_Node_Ptr);
+                      
+ 
+ private
+ 
+    type Priv_Node_Type is new Parent_Type with record
+       Next : Priv_Node_Ptr := null;
+    end record;
+ 
+ end F340A000;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F340A000 is  -- Singly-linked list abstraction.
+ 
+    procedure Add (Item : in     Node_Ptr;
+                   Head : in out Node_Ptr) is
+    begin
+       if Item /= null then
+          Item.Next := Head;
+          Head := Item;
+       end if;
+    end Add;
+ 
+ 
+    procedure Remove (Head : in out Node_Ptr;
+                      Item :    out Node_Ptr) is
+    begin
+       Item := Head;
+       if Head /= null then
+          Head := Head.Next;
+       end if;
+    end Remove;
+ 
+ 
+    procedure Add (Item : in     Priv_Node_Ptr;
+                   Head : in out Priv_Node_Ptr) is
+    begin
+       if Item /= null then
+          Item.Next := Head;
+          Head := Item;
+       end if;
+    end Add;
+ 
+ 
+    procedure Remove (Head : in out Priv_Node_Ptr;
+                      Item :    out Priv_Node_Ptr) is
+    begin
+       Item := Head;
+       if Head /= null then
+          Head := Head.Next;
+       end if;
+    end Remove;
+ 
+ 
+ end F340A000;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f340a001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f340a001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f340a001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f340a001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- F340A001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This file declares a tagged type and primitive subprogram for use in
+ --      tests covering tagged types and type extensions.
+ --
+ -- TEST FILES:
+ --      The following files comprise this foundation:
+ --
+ --         F340A000.A
+ --      => F340A001.A
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package F340A001 is  -- Book definitions.
+ 
+ 
+    type Text_Ptr is access String;
+ 
+    type Book_Type is tagged record                      -- Root tagged type.
+       Title  : Text_Ptr;
+       Author : Text_Ptr;
+    end record;
+ 
+ 
+    procedure Create_Book (Title  : in     Text_Ptr;     -- Primitive operation
+                           Author : in     Text_Ptr;     -- of root tagged type.
+                           Book   :    out Book_Type);
+                           
+ 
+ end F340A001;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F340A001 is  -- Book definitions.
+ 
+ 
+    procedure Create_Book (Title  : in     Text_Ptr;
+                           Author : in     Text_Ptr;
+                           Book   :    out Book_Type) is
+    begin
+       Book.Title  := Title;
+       Book.Author := Author;
+    end Create_Book;
+                           
+ 
+ end F340A001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f341a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f341a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f341a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f341a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,216 ----
+ -- F341A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides a simple class hierarchy (a root type and two
+ --      levels of derivation from it) to use in testing the basic OO features
+ --      related to tagged types.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package F341A00_0 is   -- package Bank
+ 
+   type Dollar_Amount  is new Float;  
+  
+    type Account is tagged
+       record
+         Current_Balance: Dollar_Amount;
+       end record;
+ 
+    -- Primitive operations.
+ 
+    procedure Deposit        (A : in out Account; 
+                              X : in     Dollar_Amount);
+    procedure Withdrawal     (A : in out Account; 
+                              X : in     Dollar_Amount);
+    function  Balance        (A : in     Account) return Dollar_Amount;
+    procedure Service_Charge (A : in out Account);
+    procedure Add_Interest   (A : in out Account);
+    procedure Open           (A : in out Account);
+ 
+ end F341A00_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ package body F341A00_0 is
+ 
+    -- Primitive operations for type Account.
+ 
+    procedure Deposit (A : in out Account; 
+                       X : in     Dollar_Amount) is
+    begin
+       A.Current_Balance := A.Current_Balance + X;
+    end Deposit;
+ 
+    --
+ 
+    procedure Withdrawal (A : in out Account; 
+                          X : in     Dollar_Amount) is
+    begin
+       A.Current_Balance := A.Current_Balance - X;
+    end Withdrawal;
+ 
+    --
+ 
+    function  Balance (A : in     Account) return Dollar_Amount is
+    begin
+       return (A.Current_Balance);
+    end Balance;
+ 
+    --
+ 
+    procedure Service_Charge (A : in out Account) is
+    begin
+       A.Current_Balance := A.Current_Balance - 5.00;
+    end Service_Charge;
+ 
+    --
+ 
+    procedure Add_Interest (A : in out Account) is
+       -- No interest accumulated on this type of account.
+       Interest_On_Account : Dollar_Amount := 0.00;
+    begin
+       A.Current_Balance := A.Current_Balance + Interest_On_Account;
+    end Add_Interest;
+ 
+    --
+ 
+    procedure Open (A : in out Account) is
+       Initial_Deposit : Dollar_Amount := 10.00;
+    begin
+       A.Current_Balance := Initial_Deposit;
+    end Open;
+ 
+ end F341A00_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with F341A00_0;
+ 
+ package F341A00_1 is    -- package Checking
+ 
+    package Bank renames F341A00_0;
+ 
+    type Account is new Bank.Account with 
+       record
+          Overdraft_Fee : Bank.Dollar_Amount;
+       end record;
+ 
+ 
+    -- Inherited primitive operations.
+    -- procedure Deposit       (A : in out Account; X : in Bank.Dollar_Amount);
+    -- procedure Withdrawal    (A : in out Account; X : in Bank.Dollar_Amount);
+    -- function  Balance       (A : in     Account) return Bank.Dollar_Amount;
+    -- procedure Service_Charge(A : in out Account);
+    -- procedure Add_Interest  (A : in out Account);
+ 
+    -- Overridden primitive operation.
+    procedure Open (A : in out Account);
+ 
+ end F341A00_1;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ package body F341A00_1 is
+ 
+    -- Overridden primitive operation.
+ 
+    procedure Open (A : in out Account) is
+       Check_Guarantee : Bank.Dollar_Amount :=  10.00;
+       Initial_Deposit : Bank.Dollar_Amount := 100.00;
+    begin
+       A.Current_Balance := Initial_Deposit;
+       A.Overdraft_Fee   := Check_Guarantee;
+    end Open;
+ 
+ end F341A00_1;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with F341A00_0;  -- package Bank
+ with F341A00_1;  -- package Checking
+ 
+ package F341A00_2 is    -- package Interest_Checking 
+ 
+    package Bank     renames F341A00_0;
+    package Checking renames F341A00_1;
+ 
+    subtype Interest_Rate is Bank.Dollar_Amount digits 4;  
+ 
+    Current_Rate : Interest_Rate := 0.030;
+ 
+    type Account is new Checking.Account with
+       record
+          Rate : Interest_Rate;
+       end record;
+ 
+    -- "Twice" inherited primitive operations (Bank.Account, Checking.Account)
+    -- procedure Deposit       (A : in out Account; X : in Bank.Dollar_Amount);
+    -- procedure Withdrawal    (A : in out Account; X : in Bank.Dollar_Amount);
+    -- function  Balance       (A : in     Account) return Bank.Dollar_Amount;
+    -- procedure Service_Charge(A : in out Account);
+ 
+    -- Overridden primitive operations.
+    procedure Add_Interest (A : in out Account);
+    procedure Open         (A : in out Account);
+ 
+ end F341A00_2;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ package body F341A00_2 is
+ 
+    -- Overridden primitive operations.
+ 
+    procedure Add_Interest (A : in out Account) is
+       use type Bank.Dollar_Amount;
+       Interest_On_Account : Bank.Dollar_Amount
+                           := Bank.Dollar_Amount(A.Current_Balance * A.Rate);
+    begin
+       A.Current_Balance := A.Current_Balance + Interest_On_Account;
+    end Add_Interest;
+ 
+    procedure Open (A : in out Account) is
+       Initial_Deposit : Bank.Dollar_Amount := 1000.00;
+    begin
+       Checking.Open (Checking.Account (A));
+       A.Current_Balance := Initial_Deposit;
+       A.Rate            := Current_Rate;
+    end Open;
+ 
+ end F341A00_2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f390a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f390a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f390a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f390a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- F390A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This file declares the root type and primitive subprograms of an
+ --      alert system abstraction, to be used for tests covering tagged
+ --      types and type extensions.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Added pragma Elaborate for Ada.Calendar.
+ --
+ --!
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package F390A00 is  -- Alert system abstraction.
+ 
+ 
+    -- Declarations used by component Display_On and procedure Display.
+ 
+    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
+    type Display_Counters is array (Device_Enum) of Natural;
+ 
+    Display_Count_For : Display_Counters := (others => 0);
+ 
+ 
+    -- Declarations used by component Arrival_Time.
+ 
+    Default_Time : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1901, 1, 1);
+    Alert_Time   : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1991, 6, 15);
+ 
+ 
+ 
+    type Alert_Type is tagged record                   -- Root tagged type.
+       Arrival_Time : Ada.Calendar.Time := Default_Time;
+       Display_On   : Device_Enum   := Null_Device;
+    end record;
+ 
+ 
+    procedure Display (A : in Alert_Type);             -- To be inherited by
+                                                       -- all derivatives.
+ 
+    procedure Handle (A : in out Alert_Type);          -- To be overridden by
+                                                       -- all derivatives.
+ 
+ end F390A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F390A00 is  -- Alert system abstraction.
+ 
+ 
+    procedure Display (A : in Alert_Type) is
+    begin
+       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
+    end Display;
+ 
+ 
+    procedure Handle (A : in out Alert_Type) is
+    begin
+       A.Arrival_Time := Alert_Time;
+       Display (A);
+    end Handle;
+ 
+ 
+ end F390A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f392a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f392a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f392a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f392a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,200 ----
+ -- F392A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides a basis for tests needing a hierarchy of
+ --      types to check object-oriented features.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package F392A00 is          -- package Accounts
+ 
+    --
+    -- Types and subtypes.
+    --
+ 
+    type Dollar_Amount  is new Float; 
+    type Interest_Rate  is delta 0.001 range 0.000 .. 1.000;
+    type Account_Types  is (Bank, Savings, Preferred, Total);
+    type Account_Counter is array (Account_Types) of Integer;
+    type Account_Rep is (President, Manager, New_Account_Manager, Teller);
+ 
+    --
+    -- Constants.
+    --
+ 
+    Opening_Balance           : constant Dollar_Amount := 100.00;
+    Current_Rate              : constant Interest_Rate := 0.030;
+    Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00;
+ 
+    --
+    -- Global Variables
+    --
+ 
+    Bank_Reserve         : Dollar_Amount   := 0.00;
+    Daily_Representative : Account_Rep     := New_Account_Manager;
+    Number_Of_Accounts   : Account_Counter := (Bank      => 0,
+                                               Savings   => 0,
+                                               Preferred => 0,
+                                               Total     => 0);
+    --
+    -- Account types and their primitive operations.
+    --
+ 
+    -- Root type.
+ 
+    type Bank_Account is tagged
+       record
+          Balance : Dollar_Amount;
+       end record;
+ 
+    -- Primitive operations of Bank_Account.
+ 
+    procedure Increment_Bank_Reserve (Acct : in     Bank_Account);
+    procedure Assign_Representative  (Acct : in     Bank_Account);
+    procedure Increment_Counters     (Acct : in     Bank_Account);
+    procedure Open                   (Acct : in out Bank_Account);
+ 
+    --
+                           
+    type Savings_Account is new Bank_Account with
+       record
+          Rate : Interest_Rate;
+       end record;
+ 
+    -- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account).
+ 
+    -- Primitive operations (Overridden).
+    procedure Assign_Representative (Acct : in     Savings_Account);
+    procedure Increment_Counters    (Acct : in     Savings_Account);
+    procedure Open                  (Acct : in out Savings_Account);
+                           
+    --
+ 
+    type Preferred_Account is new Savings_Account with
+       record
+          Minimum_Balance : Dollar_Amount;
+       end record;
+ 
+    -- Procedure Increment_Bank_Reserve inherited twice.
+    -- Procedure Assign_Representative inherited from parent (Savings_Account).
+ 
+    -- Primitive operations (Overridden).
+    procedure Increment_Counters (Acct : in     Preferred_Account);
+    procedure Open               (Acct : in out Preferred_Account);
+ 
+    -- Function used to verify Open operation for Preferred_Account objects.
+    function Verify_Open (Acct : in Preferred_Account) return Boolean;
+ 
+    
+ end F392A00;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ package body F392A00 is
+ 
+    --
+    -- Primitive operations for Bank_Account.
+    --
+ 
+    procedure Increment_Bank_Reserve (Acct : in Bank_Account) is
+    begin
+       Bank_Reserve := Bank_Reserve + Acct.Balance;
+    end Increment_Bank_Reserve;
+ 
+    procedure Assign_Representative (Acct : in Bank_Account) is
+    begin
+       Daily_Representative := Teller;
+    end Assign_Representative;
+ 
+    procedure Increment_Counters (Acct : in Bank_Account) is
+    begin
+       Number_Of_Accounts (Bank)  := Number_Of_Accounts (Bank) + 1;
+       Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
+    end Increment_Counters;
+ 
+    procedure Open (Acct : in out Bank_Account) is
+    begin
+       Acct.Balance := Opening_Balance;
+    end Open;
+ 
+ 
+    --
+    -- Overridden operations for Savings_Account type.
+    --
+ 
+    procedure Assign_Representative (Acct : in Savings_Account) is
+    begin
+       Daily_Representative := Manager;
+    end Assign_Representative;
+ 
+    procedure Increment_Counters (Acct : in Savings_Account) is
+    begin
+       Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1;
+       Number_Of_Accounts (Total)   := Number_Of_Accounts (Total) + 1;
+    end Increment_Counters;
+ 
+    procedure Open (Acct : in out Savings_Account) is
+    begin
+       Open (Bank_Account(Acct));
+       Acct.Rate := Current_Rate;
+       Acct.Balance := 2.0 * Opening_Balance;
+    end Open;
+      
+ 
+    --
+    -- Overridden operation for Preferred_Account type.
+    --
+                      
+    procedure Increment_Counters (Acct : in Preferred_Account) is
+    begin
+       Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1;
+       Number_Of_Accounts (Total)     := Number_Of_Accounts (Total) + 1;
+    end Increment_Counters;
+ 
+    procedure Open (Acct : in out Preferred_Account) is
+    begin
+       Open (Savings_Account(Acct));
+       Acct.Minimum_Balance := Preferred_Minimum_Balance;
+       Acct.Balance := Acct.Minimum_Balance;
+    end Open;
+ 
+    --
+    -- Function used to verify Open operation for Preferred_Account objects.
+    --
+ 
+    function Verify_Open (Acct : in Preferred_Account) return Boolean is
+    begin                                                    
+       return (Acct.Balance         = Preferred_Minimum_Balance and
+               Acct.Rate            = Current_Rate              and
+               Acct.Minimum_Balance = Preferred_Minimum_Balance);
+    end Verify_Open;
+ 
+ end F392A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f392c00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f392c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f392c00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f392c00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- F392C00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides a basis for tagged type and dispatching
+ --      tests.  Each test describes the utilizations.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      24 OCT 95   SAIC    Updated for ACVC 2.0.1
+ --
+ --!
+ 
+ package F392C00_1 is  -- Switches
+ 
+   type Toggle is tagged private;    ---------------------------------- Toggle
+ 
+   function Create return Toggle;
+   procedure Flip   ( It : in out Toggle );
+   function On      ( It : Toggle'Class ) return Boolean;
+   function Off     ( It : Toggle'Class ) return Boolean;
+ 
+   type Dimmer is new Toggle with private;    ------------------------- Dimmer
+ 
+   type Luminance is range 0..100;
+ 
+   function  Create return Dimmer;
+   procedure Flip    ( It : in out Dimmer );
+   procedure Brighten( It : in out Dimmer;
+                       By : in Luminance := 10 );
+   procedure Dim     ( It : in out Dimmer;
+                       By : in Luminance := 10 );
+   function Intensity( It : Dimmer ) return Luminance;
+ 
+   type Auto_Dimmer is new Dimmer with private;    --------------- Auto_Dimmer
+ 
+   function  Create return Auto_Dimmer;
+   procedure Flip      ( It: in out Auto_Dimmer );
+   procedure Set_Auto  ( It: in out Auto_Dimmer );
+   procedure Clear_Auto( It: in out Auto_Dimmer );
+   -- procedure Set_Manual( It: in out Auto_Dimmer ) renames Clear_Auto;
+   procedure Set_Cutin ( It: in out Auto_Dimmer; Lumens: in Luminance );
+   procedure Set_Cutout( It: in out Auto_Dimmer; Lumens: in Luminance );
+ 
+   function Auto            ( It: Auto_Dimmer ) return Boolean;
+   function Cutout_Threshold( It: Auto_Dimmer ) return Luminance;
+   function Cutin_Threshold ( It: Auto_Dimmer ) return Luminance;
+ 
+   function TC_CW_TI( Key : Character ) return Toggle'Class;
+ 
+   function TC_Non_Disp( It: Toggle ) return Boolean;
+   function TC_Non_Disp( It: Dimmer ) return Boolean;
+   function TC_Non_Disp( It: Auto_Dimmer ) return Boolean;
+ 
+ private
+ 
+   type Toggle is tagged record
+     On : Boolean := False;
+   end record;
+ 
+   type Dimmer is new Toggle with record
+     Intensity : Luminance := 100;
+   end record;  
+ 
+   type Auto_Dimmer is new Dimmer with record
+     Cutout_Threshold : Luminance := 60;
+     Cutin_Threshold  : Luminance := 40;
+     Auto_Engaged     : Boolean := False;
+   end record;  
+ 
+ end F392C00_1;
+ 
+ with TCTouch;
+ package body F392C00_1 is
+ 
+   function Create return Toggle is
+   begin
+     TCTouch.Touch( '1' );  ------------------------------------------------ 1
+     return Toggle'( On => True );
+   end Create;
+ 
+   function Create return Dimmer is
+   begin
+     TCTouch.Touch( '2' );  ------------------------------------------------ 2
+     return Dimmer'( On => True, Intensity => 75 );
+   end Create;
+ 
+   function Create return Auto_Dimmer is
+   begin
+     TCTouch.Touch( '3' );  ------------------------------------------------ 3
+     return  Auto_Dimmer'( On => True, Intensity => 25,
+                           Cutout_Threshold | Cutin_Threshold => 50,
+                           Auto_Engaged => True );
+   end Create;
+ 
+   procedure Flip   ( It : in out Toggle ) is
+   begin
+     TCTouch.Touch( 'A' );  ------------------------------------------------ A
+     It.On := not It.On;
+   end Flip;
+ 
+   function On( It : Toggle'Class ) return Boolean is
+   begin
+     TCTouch.Touch( 'B' );  ------------------------------------------------ B
+     return It.On;
+   end On;
+ 
+   function Off( It : Toggle'Class ) return Boolean is
+   begin
+     TCTouch.Touch( 'C' );  ------------------------------------------------ C
+     return not It.On;
+   end Off;
+ 
+   procedure Brighten( It : in out Dimmer;
+                       By : in Luminance := 10 ) is
+   begin
+     TCTouch.Touch( 'D' );  ------------------------------------------------ D
+     if (It.Intensity+By) <= Luminance'Last then
+       It.Intensity := It.Intensity+By;
+     else
+       It.Intensity := Luminance'Last;
+     end if;
+   end Brighten;
+ 
+   procedure Dim     ( It : in out Dimmer;
+                       By : in Luminance := 10 ) is
+   begin
+     TCTouch.Touch( 'E' );  ------------------------------------------------ E
+     if (It.Intensity-By) >= Luminance'First then
+       It.Intensity := It.Intensity-By;
+     else
+       It.Intensity := Luminance'First;
+     end if;
+   end Dim;
+ 
+   function Intensity( It : Dimmer ) return Luminance is
+   begin
+     TCTouch.Touch( 'F' );  ------------------------------------------------ F
+     if On(It) then
+       return It.Intensity;
+     else
+       return Luminance'First;
+     end if;
+   end Intensity;
+ 
+   procedure Flip    ( It : in out Dimmer ) is
+   begin
+     TCTouch.Touch( 'G' );  ------------------------------------------------ G
+     if On( It ) and (It.Intensity < 50) then
+       It.Intensity := Luminance'Last - It.Intensity;
+     else
+       Flip( Toggle( It ) );
+     end if;
+   end Flip;
+ 
+   procedure Set_Auto  ( It: in out Auto_Dimmer ) is
+   begin
+     TCTouch.Touch( 'H' );  ------------------------------------------------ H
+     It.Auto_Engaged := True;
+   end Set_Auto;
+ 
+   procedure Clear_Auto( It: in out Auto_Dimmer ) is
+   begin
+     TCTouch.Touch( 'I' );  ------------------------------------------------ I
+     It.Auto_Engaged := False;
+   end Clear_Auto;
+ 
+   function  Auto           ( It: Auto_Dimmer ) return Boolean is
+   begin
+     TCTouch.Touch( 'J' );  ------------------------------------------------ J
+     return It.Auto_Engaged;
+   end Auto;
+ 
+   procedure Flip     ( It: in out Auto_Dimmer ) is
+   begin
+     TCTouch.Touch( 'K' );  ------------------------------------------------ K
+     if It.Auto_Engaged then
+       if Off(It) then
+        Flip( Dimmer( It ) );
+       else
+        It.Auto_Engaged := False;
+       end if;
+     else
+       Flip( Dimmer( It ) );
+     end if;
+   end Flip;
+ 
+   procedure Set_Cutin ( It : in out Auto_Dimmer;
+                         Lumens : in Luminance) is
+   begin
+     TCTouch.Touch( 'L' );  ------------------------------------------------ L
+     It.Cutin_Threshold := Lumens;
+   end Set_Cutin;
+ 
+   procedure Set_Cutout( It : in out Auto_Dimmer;
+                         Lumens : in Luminance) is
+   begin
+     TCTouch.Touch( 'M' );  ------------------------------------------------ M
+     It.Cutout_Threshold := Lumens;
+   end Set_Cutout;
+ 
+   function Cutout_Threshold( It : Auto_Dimmer ) return Luminance is
+   begin
+     TCTouch.Touch( 'N' );  ------------------------------------------------ N
+     return It.Cutout_Threshold;
+   end Cutout_Threshold;
+ 
+   function Cutin_Threshold ( It : Auto_Dimmer ) return Luminance is
+   begin
+     TCTouch.Touch( 'O' );  ------------------------------------------------ O
+     return It.Cutin_Threshold;
+   end Cutin_Threshold;
+ 
+   function TC_CW_TI( Key : Character ) return Toggle'Class is
+   begin
+     TCTouch.Touch( 'W' );  ------------------------------------------------ W
+     case Key is
+       when 'T' | 't' => return Toggle'( On => True );
+       when 'D' | 'd' => return Dimmer'( On => True, Intensity => 75 );
+       when 'A' | 'a' => return Auto_Dimmer'( On => True, Intensity => 25,
+                                  Cutout_Threshold | Cutin_Threshold => 50,
+                                  Auto_Engaged => True );
+       when others => null;
+     end case;
+   end TC_CW_TI;
+ 
+   function TC_Non_Disp( It: Toggle ) return Boolean is
+   begin
+     TCTouch.Touch( 'X' );  ------------------------------------------------ X
+     return It.On;
+   end TC_Non_Disp;
+ 
+   function TC_Non_Disp( It: Dimmer ) return Boolean is
+   begin
+     TCTouch.Touch( 'Y' );  ------------------------------------------------ Y
+     return It.On;
+   end TC_Non_Disp;
+ 
+   function TC_Non_Disp( It: Auto_Dimmer ) return Boolean is
+   begin
+     TCTouch.Touch( 'Z' );  ------------------------------------------------ Z
+     return It.On;
+   end TC_Non_Disp;
+ 
+ end F392C00_1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f392d00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f392d00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f392d00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f392d00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- F392D00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares parent tagged types and subprograms for use 
+ --      in tests covering dispatching operations.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package F392D00 is
+ 
+    type Depth_Of_Field is range 5 .. 100;  
+    type Shutter_Speed  is (One, Two_Fifty, Four_Hundred, Thousand);
+ 
+    type Remote_Camera is tagged record
+       DOF    : Depth_Of_Field := 10;
+       Shutter: Shutter_Speed  := One;
+    end record;
+ 
+    -- ...Other declarations.
+ 
+    procedure Focus (C     : in out Remote_Camera;
+                     Depth : in     Depth_Of_Field);
+ 
+    procedure Self_Test (C: in out Remote_Camera'Class);
+ 
+    -- ...Other operations.
+ 
+ private
+ 
+    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
+                                 Speed : in     Shutter_Speed);
+ 
+    -- For the basic remote camera, shutter speed might be set as a function of
+    -- focus perhaps, thus it is declared as a private operation (usable
+    -- only internally within the abstraction).
+ 
+ 
+ end F392D00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F392D00 is
+ 
+    procedure Focus (C     : in out Remote_Camera;
+                     Depth : in     Depth_Of_Field) is
+    begin
+       -- Artificial for testing purposes.
+       C.DOF := 46;
+    end Focus;
+ 
+    -----------------------------------------------------------
+    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
+                                 Speed : in     Shutter_Speed) is
+    begin
+       -- Artificial for testing purposes.
+       C.Shutter := Thousand;
+    end Set_Shutter_Speed;
+ 
+    -----------------------------------------------------------
+    procedure Self_Test (C: in out Remote_Camera'Class) is
+       TC_Dummy_Depth : constant Depth_Of_Field := 23;
+       TC_Dummy_Speed : constant Shutter_Speed  := Four_Hundred;
+    begin
+ 
+       -- Test focus at various depths:
+       Focus(C, TC_Dummy_Depth);
+       -- ...Additional calls to Focus.
+ 
+       -- Test various shutter speeds:
+       Set_Shutter_Speed(C, TC_Dummy_Speed);
+       -- ...Additional calls to Set_Shutter_Speed.
+ 
+    end Self_Test;
+ 
+ end F392D00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f393a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f393a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f393a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f393a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,245 ----
+ -- F393A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides a simple background for a class family
+ --      based on an abstract type.  It is to be used to test the
+ --      dispatching of various forms of subprogram defined/inherited and
+ --      overridden with the abstract type.
+ --
+ --  type                       procedures                  functions
+ --  ----                       ----------                  ---------
+ --  Object                     Initialize, Swap(abstract)  Create(abstract)
+ --        Object'Class                                     Initialized
+ --    Windmill is new Object   Swap, Stop, Add_Spin        Create, Spin
+ --      Pump is new Windmill   Set_Rate                    Create, Rate
+ --      Mill is new Windmill   Swap, Stop                  Create
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+  
+ package F393A00_0 is
+    procedure TC_Touch ( A_Tag : Character );
+    procedure TC_Validate( Expected: String; Message: String );
+ end F393A00_0;
+  
+ with Report;
+ package body F393A00_0 is
+    Expectation : String(1..20);
+    Finger      : Natural := 0;
+  
+    procedure TC_Touch ( A_Tag : Character ) is
+    begin
+      Finger := Finger+1;
+      Expectation(Finger) := A_Tag;
+    end TC_Touch;
+  
+    procedure TC_Validate( Expected: String; Message: String ) is
+    begin
+      if Expectation(1..Finger) /= Expected then
+        Report.Failed( Message & " Expecting: " & Expected 
+  			     & " Got: " & Expectation(1..Finger) );
+      end if;
+      Finger := 0;
+    end TC_Validate;
+ end F393A00_0;
+  
+ ----------------------------------------------------------------------
+  
+ package F393A00_1 is
+    type Object is abstract tagged private;
+    procedure Initialize( An_Object: in out Object );
+    function  Initialized( An_Object: Object'Class ) return Boolean;
+    procedure Swap( A,B: in out Object ) is abstract;
+    function  Create return Object is abstract;
+ private
+    type Object is abstract tagged record
+      Initialized : Boolean := False;
+    end record;
+ end F393A00_1;
+  
+ with F393A00_0;
+ package body F393A00_1 is
+    procedure Initialize( An_Object: in out Object ) is
+    begin
+      An_Object.Initialized := True;
+      F393A00_0.TC_Touch('a');
+    end Initialize;
+  
+    function  Initialized( An_Object: Object'Class ) return Boolean is
+    begin
+      F393A00_0.TC_Touch('b');
+      return An_Object.Initialized;
+    end Initialized;
+ end F393A00_1;
+  
+ ----------------------------------------------------------------------
+  
+ with F393A00_1;
+ package F393A00_2 is
+  
+    type Rotational_Measurement is range -1_000 .. 1_000;
+    type Windmill is new F393A00_1.Object with private;
+  
+    procedure Swap( A,B: in out Windmill );  
+  
+    function  Create return Windmill;        
+  
+    procedure Add_Spin( To_Mill : in out Windmill;
+  		      RPMs    : in     Rotational_Measurement );
+  
+    procedure Stop( Mill : in out Windmill );
+  
+    function  Spin( Mill : Windmill ) return Rotational_Measurement;
+  
+ private
+    type Windmill is new F393A00_1.Object with
+      record
+        Spin : Rotational_Measurement := 0;
+      end record;
+ end F393A00_2;
+  
+ with F393A00_0;
+ package body F393A00_2 is
+  
+    procedure Swap( A,B: in out Windmill ) is
+      T : constant Windmill := B;
+    begin
+      F393A00_0.TC_Touch('c');
+      B := A;
+      A := T;
+    end Swap;
+  
+    function  Create return Windmill is
+      A_Mill : Windmill;
+    begin
+      F393A00_0.TC_Touch('d');
+      return A_Mill;
+    end Create;
+  
+    procedure Add_Spin( To_Mill : in out Windmill;
+  		      RPMs    : in     Rotational_Measurement ) is
+    begin
+      F393A00_0.TC_Touch('e');
+      To_Mill.Spin := To_Mill.Spin + RPMs;
+    end Add_Spin;
+  
+    procedure Stop( Mill : in out Windmill ) is
+    begin
+      F393A00_0.TC_Touch('f');
+      Mill.Spin := 0;
+    end Stop;
+  
+    function  Spin( Mill : Windmill ) return Rotational_Measurement is
+    begin
+      F393A00_0.TC_Touch('g');
+      return Mill.Spin;
+    end Spin;
+  
+ end F393A00_2;
+  
+ ----------------------------------------------------------------------
+  
+ with F393A00_2;
+ package F393A00_3 is
+    type Pump is new F393A00_2.Windmill with private;
+    function Create return Pump;
+  
+    type Gallons_Per_Revolution is digits 3;
+    procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution);
+    function  Rate( Of_Pump: Pump ) return Gallons_Per_Revolution;
+ private
+    type Pump is new F393A00_2.Windmill with
+      record
+        GPRPM : Gallons_Per_Revolution := 0.0; -- Gallons/RPM
+      end record;
+ end F393A00_3;
+  
+ with F393A00_0;
+ package body F393A00_3 is
+    function Create return Pump is
+      Sump : Pump;
+    begin
+      F393A00_0.TC_Touch('h');
+      return Sump;
+    end Create;
+  
+    procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution)
+    is
+    begin
+      F393A00_0.TC_Touch('i');
+      A_Pump.GPRPM := To_Rate;
+    end Set_Rate;
+  
+    function  Rate( Of_Pump: Pump ) return Gallons_Per_Revolution is
+    begin
+      F393A00_0.TC_Touch('j');
+      return Of_Pump.GPRPM;
+    end Rate;
+ end F393A00_3;
+  
+ ----------------------------------------------------------------------
+ 
+ with F393A00_2;
+ with F393A00_3;
+ package F393A00_4 is
+    type Mill is new F393A00_2.Windmill with private;
+  
+    procedure Swap( A,B: in out Mill );
+    function  Create return Mill;
+    procedure Stop( It: in out Mill );
+  private
+    type Mill is new F393A00_2.Windmill with
+      record
+        Pump: F393A00_3.Pump := F393A00_3.Create;
+      end record;
+ end F393A00_4;
+  
+ with F393A00_0;
+ package body F393A00_4 is
+    procedure Swap( A,B: in out Mill ) is
+      T: constant Mill := A;
+    begin
+      F393A00_0.TC_Touch('k');
+      A := B;
+      B := T;
+    end Swap;
+  
+    function  Create return Mill is
+      A_Mill : Mill;
+    begin
+      F393A00_0.TC_Touch('l');
+      return A_Mill;
+    end Create;
+  
+    procedure Stop( It: in out Mill ) is
+    begin
+      F393A00_0.TC_Touch('m');
+      F393A00_3.Stop( It.Pump ); 
+      F393A00_2.Stop( F393A00_2.Windmill( It ) ); 
+    end Stop;
+ end F393A00_4;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f393b00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f393b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f393b00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f393b00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- F393B00.A   
+  -- Alert_Foundation
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- FOUNDATION DESCRIPTION:
+  --      This package declares three abstract types for use in C660 series 
+  --      tests, Alert, Special_Alert, and Private_Alert.
+  --      It models (in miniature) an application situation in which an 
+  --      abstraction is defined in terms of structure (record and operations 
+  --      on the record) but not in terms of content (record is null).  It 
+  --      also models a situation in which an abstraction includes some 
+  --      specific, implementation dependent, information.
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  package F393B00 is
+     type Alert is abstract tagged null record;  -- abstract type
+                                                 -- see procedure Handle below
+  
+     procedure Handle (A : in out Alert) is abstract;
+                                                 -- abstract procedure, 
+                                                 -- explicitly declared
+  
+  
+     type Private_Alert is abstract tagged private;
+  
+     procedure Handle (PA : in out Private_Alert) is abstract;
+                                                 -- ensures that Private_Alert
+                                                 -- is visibly abstract
+  
+  
+     type Status_Kind is (Practice, Real, Dont_Care);
+     type Urgency_Kind is (Low, Medium, High);
+  
+     type Practice_Alert is new Alert with record
+       Status : Status_Kind := Dont_Care;
+       Urgency : Urgency_Kind := Low;
+     end record;
+  
+     procedure Handle (PA : in out Practice_Alert);
+                                                 -- overrides inherited Handle
+  
+  
+  
+     type Device is (Teletype, Console, Big_Screen);
+  
+     type Special_Alert (Age : Integer) is 
+       abstract new Practice_Alert with record
+         Display : Device;
+       end record;
+  
+     procedure Handle (SA : in out Special_Alert) is abstract; 
+                                                 -- overrides inherited Handle
+  
+  private
+     subtype Implementation_Detail is Integer range 1..10;
+  
+     type Private_Alert is abstract tagged record
+       Private_Field : Implementation_Detail := 1;
+     end record;
+  
+   
+  end F393B00;
+  
+  --=======================================================================--
+  
+  package body F393B00 is
+  
+       procedure Handle (PA : in out Practice_Alert) is
+         begin
+           PA.Status := Real;
+           PA.Urgency := Medium;
+         end Handle;
+  
+  end F393B00;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f3a2a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f3a2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f3a2a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f3a2a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- F3A2A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares support types and subprograms for testing
+ --      run-time accessibility checks.
+ --
+ -- CHANGE HISTORY:
+ --      01 May 95   SAIC    Initial prerelease version.
+ --
+ --!
+ 
+ package F3A2A00 is
+ 
+    type Tagged_Type is tagged record
+       C: Integer := 0;
+    end record;
+ 
+    type Array_Type is array (1 .. 10) of Tagged_Type;
+ 
+    type AccTag_L0      is access all Tagged_Type;
+    type AccTagClass_L0 is access all Tagged_Type'Class;
+ 
+    type AccArr_L0 is access all Array_Type;
+ 
+    X_L0 : Tagged_Type;
+ 
+ 
+    type TC_Result_Kind is (OK, P_E, O_E);
+ 
+    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
+                                  Expected: in TC_Result_Kind;
+                                  Message : in String);
+ end F3A2A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body F3A2A00 is
+ 
+    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
+                                  Expected: in TC_Result_Kind;
+                                  Message : in String) is
+    begin
+       if Actual /= Expected then
+          case Actual is
+             when OK  =>
+                Report.Failed ("No exception raised: "         & Message);
+             when P_E =>
+                Report.Failed ("Program_Error raised: "        & Message);
+             when O_E =>
+                Report.Failed ("Unexpected exception raised: " & Message);
+          end case;
+       end if;
+    end TC_Display_Results;
+ 
+ end F3A2A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f460a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f460a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f460a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f460a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- F460A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares support types and subprograms for testing
+ --      run-time accessibility checks.
+ --
+ -- CHANGE HISTORY:
+ --      11 May 95   SAIC    Initial prerelease version.
+ --      24 Apr 96   SAIC    Modified Array_Type.
+ --
+ --!
+ 
+ package F460A00 is
+ 
+    type Tagged_Type is tagged record
+       C : Integer := 0;
+    end record;
+ 
+    type Derived_Tagged_Type is new Tagged_Type with record
+       D : String (1 .. 4) := "void";
+    end record;
+ 
+    type Composite_Type (D: access Tagged_Type) is limited record
+       C : Boolean;
+    end record;
+ 
+    type Array_Type is array (1 .. 10) of Tagged_Type;
+ 
+    type AccTag_L0      is access constant Tagged_Type;
+    type AccTagClass_L0 is access all      Tagged_Type'Class;
+ 
+    type AccArr_L0 is access all Array_Type;
+ 
+    X_DerivedTag : aliased Derived_Tagged_Type;
+    PTagClass_L0 : AccTagClass_L0 := X_DerivedTag'Access;
+ 
+    type TC_Result_Kind is (OK, UN_Init, PE_Exception, Others_Exception);
+ 
+    procedure TC_Check_Results (Actual  : in TC_Result_Kind;
+                                Expected: in TC_Result_Kind;
+                                Message : in String);
+ end F460A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body F460A00 is
+ 
+    procedure TC_Check_Results (Actual  : in TC_Result_Kind;
+                                Expected: in TC_Result_Kind;
+                                Message : in String) is
+    begin
+       if Actual /= Expected then
+          case Actual is
+             when OK | UN_Init  =>
+                Report.Failed ("No exception raised: "         & Message);
+             when PE_Exception =>
+                Report.Failed ("Program_Error raised: "        & Message);
+             when Others_Exception =>
+                Report.Failed ("Unexpected exception raised: " & Message);
+          end case;
+       end if;
+    end TC_Check_Results;
+ 
+ end F460A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f730a000.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f730a000.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f730a000.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f730a000.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- F730A000.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This file simulates a generic linked list abstraction for use in tests
+ --      covering tagged types and type extensions.
+ --
+ -- TEST FILES:
+ --      This foundation consists of the following files:
+ --
+ --      => F730A000.A
+ --         F730A001.A
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      03 Aug 96   SAIC    ACVC 2.1: Modified prologue. Added pragma
+ --                          Elaborate_Body. Removed extraneous record
+ --                          extension.
+ --
+ --!
+ 
+ generic  -- Singly-linked list abstraction.
+    type Parent_Type is tagged private;                   -- Actual is parent
+ package F730A000 is                                      -- tagged type.
+ 
+    pragma Elaborate_Body;
+ 
+ 
+    -- Declarations for private linked list nodes:
+ 
+    type Priv_Node_Type is new Parent_Type with private;  -- Private extension
+                                                          -- of parent type.
+ 
+    -- Inherits primitive operations of actual parameter corresponding
+    -- to Parent_Type.
+ 
+ 
+    type Priv_Node_Ptr is access Priv_Node_Type;
+ 
+ 
+    -- Add node at head of list.
+    procedure Add (Item : in     Priv_Node_Ptr;
+                   Head : in out Priv_Node_Ptr);
+ 
+    -- Remove node from head of list and return it.
+    procedure Remove (Head : in out Priv_Node_Ptr;
+                      Item :    out Priv_Node_Ptr);
+                      
+ 
+ private
+ 
+    type Priv_Node_Type is new Parent_Type with record
+       Next : Priv_Node_Ptr := null;
+    end record;
+ 
+ end F730A000;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F730A000 is  -- Singly-linked list abstraction.
+ 
+ 
+    procedure Add (Item : in     Priv_Node_Ptr;
+                   Head : in out Priv_Node_Ptr) is
+    begin
+       if Item /= null then
+          Item.Next := Head;
+          Head := Item;
+       end if;
+    end Add;
+ 
+ 
+    procedure Remove (Head : in out Priv_Node_Ptr;
+                      Item :    out Priv_Node_Ptr) is
+    begin
+       Item := Head;
+       if Head /= null then
+          Head := Head.Next;
+       end if;
+    end Remove;
+ 
+ 
+ end F730A000;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f730a001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f730a001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f730a001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f730a001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,76 ----
+ -- F730A001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This file declares a tagged type and primitive subprogram for use in
+ --      tests covering tagged types and type extensions.
+ --
+ -- TEST FILES:
+ --      The following files comprise this foundation:
+ --
+ --         F730A000.A
+ --      => F730A001.A
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package F730A001 is  -- Book definitions.
+ 
+ 
+    type Text_Ptr is access String;
+ 
+    type Book_Type is tagged record                      -- Root tagged type.
+       Title  : Text_Ptr;
+       Author : Text_Ptr;
+    end record;
+ 
+ 
+    procedure Create_Book (Title  : in     Text_Ptr;     -- Primitive operation
+                           Author : in     Text_Ptr;     -- of root tagged type.
+                           Book   :    out Book_Type);
+                           
+ 
+ end F730A001;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F730A001 is  -- Book definitions.
+ 
+ 
+    procedure Create_Book (Title  : in     Text_Ptr;
+                           Author : in     Text_Ptr;
+                           Book   :    out Book_Type) is
+    begin
+       Book.Title  := Title;
+       Book.Author := Author;
+    end Create_Book;
+                           
+ 
+ end F730A001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f731a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f731a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f731a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f731a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- F731A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares parent tagged types and subprograms for use 
+ --      in tests covering operations of private types and private extensions.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package F731A00 is
+ 
+    type Parent is tagged private;
+ 
+    function Vis_Op (P: Parent) return Boolean;
+ 
+ private
+ 
+    type Parent is tagged record
+       Component : Integer := 1;
+    end record;
+ 
+    function Pri_Op (P: Parent) return Boolean;
+ 
+ end F731A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F731A00 is
+    function Vis_Op (P: Parent) return Boolean is
+    begin
+       return True;
+    end Vis_Op;
+ 
+    function Pri_Op (P: Parent) return Boolean is 
+    begin
+       return False;
+    end Pri_Op;
+ 
+ end F731A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f940a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f940a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f940a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f940a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- F940A00.A
+ --
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation contains test control code for tests covering 
+ --      the protected record.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package F940A00 is
+      -- Interlock_Foundation
+    
+   protected type Interlock_Type is
+     entry Post;
+     entry Consume;
+   private
+     Int_Count : Integer := 0;
+   end Interlock_Type;
+ 
+   protected Counter is                 -- used to count the number of
+     procedure Increment;               -- resources that have been granted
+     procedure Decrement;               -- to tasks
+     function Number return integer;
+   private
+     Count : Integer := 0;
+   end Counter;
+ 
+ end F940A00;
+  -- Interlock_Foundation
+ 
+ --===================================--
+ 
+ package body F940A00 is
+           -- Interlock_Foundation
+ 
+   protected body Interlock_Type is
+ 
+     entry Post when true is
+     begin
+       Int_Count := Int_Count + 1;
+     end Post;
+ 
+     entry Consume when Int_Count > 0 is
+     begin
+       Int_Count := Int_Count - 1;
+     end Consume;
+ 
+   end Interlock_Type;
+ 
+ 
+   protected body Counter is
+ 
+     procedure Increment is
+       begin
+         Count := Count + 1;
+       end Increment;
+ 
+     procedure Decrement is
+       begin
+         Count := Count - 1;
+       end Decrement;
+ 
+     function Number return Integer is 
+       begin
+         return Count;
+       end Number;
+ 
+   end Counter;
+ 
+ end F940A00;
+  -- Interlock_Foundation
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f954a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f954a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/f954a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/f954a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- F954A00.A
+ --
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      This file contains foundation code for tests covering the requeue
+ --      statement.
+ --
+ -- TEST DESCRIPTION:
+ --      See prologues of specific tests.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package F954A00 is  -- Printer device abstraction.
+ 
+ 
+    -- Model a printer device driver as a protected type. A printer remains
+    -- unavailable while data is printing. The printer generates an interrupt
+    -- when printing is complete, after which the printer is again made
+    -- available.
+ 
+ 
+    type Printers_Info is tagged record
+       Some_Info : Integer;
+    end record;
+ 
+                --==============================================--
+ 
+    protected type Printers is   -- Device driver for printer.
+ 
+       procedure Start_Printing (File_Name : String);  -- Begin printing on
+                                                       -- printer.
+ 
+       procedure Handle_Interrupt;                     -- Handle interrupt from
+                                                       -- printer.
+ 
+       entry Done_Printing;                            -- Wait until printer is
+                                                       -- done.
+ 
+       function Available return Boolean;              -- Return value of Ready.
+       function Is_Done return Boolean;                -- Return value of Done.
+ 
+    private
+ 
+       Ready : Boolean := True;                        -- Entry barrier.
+       Done  : Boolean := True;                        -- Testing flag.
+ 
+    end Printers;
+ 
+                --==============================================--
+ 
+    Number_Of_Printers : constant := 2;
+ 
+    type Printer_ID is range 1 .. Number_Of_Printers;
+ 
+    type Printer_Array is array (Printer_ID) of Printers;
+    type Info_Array    is array (Printer_ID) of Printers_Info;
+ 
+    Printer       : Printer_Array;
+    Printer_Info  : constant Info_Array  := ( (Some_Info => 1),
+                                              (Some_Info => 2) ); 
+ 
+ end F954A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body F954A00 is  -- Printer server abstraction.
+ 
+ 
+    protected body Printers is
+ 
+       procedure Start_Printing (File_Name : String) is
+       begin
+          Ready := False;                              -- Block other requests
+          Done  := False;                              -- for this printer
+          -- Send data to the printer...               -- and begin printing.
+       end Start_Printing;
+ 
+ 
+       -- Set the "not ready" one-shot
+       entry Done_Printing when Ready is               -- Callers wait here
+       begin                                           -- until printing is
+          Done := True;                                -- done (signaled by a
+       end Done_Printing;                              -- printer interrupt).
+ 
+ 
+       procedure Handle_Interrupt is                   -- Called when the 
+       begin                                           -- printer interrupts,
+          Ready := True;                               -- indicating that
+       end Handle_Interrupt;                           -- printing is done.
+ 
+ 
+       function Available return Boolean is            -- Artifice for test
+       begin                                           -- purposes: checks
+          return (Ready);                              -- whether printer is
+       end Available;                                  -- still printing.
+ 
+ 
+       function Is_Done return Boolean is              -- Artifice for test
+       begin                                           -- purposes: checks
+          return (Done);                               -- whether Done_Printing
+       end Is_Done;                                    -- entry was executed.
+ 
+    end Printers;
+ 
+ 
+ end F954A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- FA11A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares a tagged type and primitive subprograms in
+ --      a parent package.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FA11A00 is     -- Widget_Pkg
+ -- This package represents processing of widgets in a window system.  It 
+ -- contains a tagged type that can be extended by its children.
+ 
+    type Widget_Length is range 1 .. 100;
+ 
+    type Widget is tagged                     -- Parent tagged type
+       record            
+          Width, Height : Widget_Length;
+          -- More components to be added by extension
+       end record;
+ 
+    -- To be inherited by its children derivatives.
+    procedure Set_Width (The_Widget : in out Widget; 
+                         W          : in     Widget_Length);      
+                        
+    -- To be inherited by its children derivatives.
+    procedure Set_Height (The_Widget : in out Widget;    
+                          H          : in     Widget_Length);    
+ 
+ end FA11A00;        -- Widget_Pkg
+ 
+ --=======================================================================--
+ 
+ package body FA11A00 is     -- Widget_Pkg
+ 
+    procedure Set_Width (The_Widget : in out Widget; 
+                         W          : in Widget_Length) is
+    begin
+       The_Widget.Width := W;
+    end Set_Width;
+    -------------------------------------------------------
+    procedure Set_Height (The_Widget : in out Widget; 
+                          H          : in Widget_Length) is
+    begin
+       The_Widget.Height := H;
+    end Set_Height;
+ 
+ end FA11A00;     -- Widget_Pkg
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11b00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11b00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11b00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- FA11B00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares parent types and operations that can
+ --      be inherited by its children.  
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FA11B00 is          -- Application_One_Widget
+ -- This foundation simulates code that might be obtained as an already
+ -- implemented set of objects and services, perhaps from a source code
+ -- vendor.  It represents processing of widgets in a window system.  
+ -- These widgets all have the same characteristics, but they are application 
+ -- specific, so we do not allow assignment of an App_1_Widget to App_2_Widget.
+ 
+ -- The dimension measurement is in pixels (dots on the screen).
+    type Pixels is range 0 .. 10_000;
+    type Widget_Id is new Integer;
+    type Widget_Color_Enum is (Amber, Green, White, None);
+    subtype Widget_Label_Str is string (1 .. 15);
+ 
+    type Widget_Location is 
+      record
+         X_Location, Y_Location : Pixels;
+      end record;
+ 
+    type Widget_Size is 
+      record
+         X_Length, Y_Length : Pixels;
+      end record;
+ 
+    -- NOTE : not a tagged record.    
+    type App1_Widget (Maximum_Size : Pixels := Pixels'Last) 
+       is record          -- Parent type
+          Size          : Widget_Size       := (Maximum_Size, Maximum_Size);
+          ID            : Widget_Id         := 1;
+          Location      : Widget_Location   := (0,0);
+          Color         : Widget_Color_Enum := None;
+          Label         : Widget_Label_Str  := "               ";
+       end record;
+ 
+    -- Primitive operation of type Widget.
+    -- To be inherited by its children derivatives.
+    procedure App1_Widget_Specific_Oper (The_Widget : in out App1_Widget; 
+                                         I          : in     Widget_Id;
+                                         C          : in     Widget_Color_Enum;
+                                         L          : in     Widget_Label_Str);
+                        
+ end FA11B00;                -- Application_One_Widget
+ 
+ --=======================================================================--
+ 
+ package body FA11B00 is     -- Application_One_Widget
+ 
+    procedure Set_Color (The_Widget : in out App1_Widget; 
+                         C          : in     Widget_Color_Enum) is
+    begin
+       The_Widget.Color := C;
+    end Set_Color;
+    -------------------------------------------------------------
+    procedure Set_Label (The_Widget : in out App1_Widget; 
+                         L          : in     Widget_Label_Str) is
+    begin
+       The_Widget.Label := L;
+    end Set_Label;
+    -------------------------------------------------------------
+    procedure Set_Id (The_Widget : in out App1_Widget; 
+                      I          : in     Widget_Id) is
+    begin
+       The_Widget.Id := I;
+    end Set_Id;
+    -------------------------------------------------------------
+    procedure App1_Widget_Specific_Oper 
+      (The_Widget : in out App1_Widget; 
+       I          : in     Widget_Id;
+       C          : in     Widget_Color_Enum;
+       L          : in     Widget_Label_Str) is
+    begin
+       Set_Color    (The_Widget, C);
+       Set_Label    (The_Widget, L);
+       Set_Id       (The_Widget, I);
+    end App1_Widget_Specific_Oper;
+ 
+ end FA11B00;                -- Application_One_Widget
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11c00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11c00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11c00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- FA11C00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares parent types and operations that can
+ --      be inherited by its children.  
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FA11C00_0 is         -- Package Animal
+ 
+    type Kilogram_Weight_Type is new Natural;
+    subtype Species_Name_Type is String (1 .. 20);
+ 
+    type Animal is tagged
+       record
+          Common_Name : Species_Name_Type;
+          Weight      : Kilogram_Weight_Type;
+       end record;
+ 
+    function Image (A : Animal) return String;
+ 
+ end FA11C00_0;               -- Package Animal
+ 
+      --=================================================================--
+ 
+ package body FA11C00_0 is    -- Package body Animal
+ 
+    function Image (A : Animal) return String is
+    begin
+       return ("Animal Species:  " & A.Common_Name);
+    end Image;
+ 
+ end FA11C00_0;               -- Package body Animal
+ 
+      --=================================================================--
+ 
+ package FA11C00_0.FA11C00_1 is         -- Package Animal.Mammal
+ 
+    type Hair_Color_Type is (Black, Brown, Blonde, Grey, White, Red);
+ 
+    type Mammal is new Animal with
+       record
+          Hair_Color : Hair_Color_Type;
+       end record;
+ 
+    function Image (M : Mammal) return String;
+ 
+ end FA11C00_0.FA11C00_1;               -- Package Animal.Mammal
+ 
+      --=================================================================--
+ 
+ package body FA11C00_0.FA11C00_1 is    -- Package body Animal.Mammal
+ 
+    function Image (M : Mammal) return String is
+    begin
+       return ("Mammal Species:  " & M.Common_Name);
+    end Image;
+ 
+ end FA11C00_0.FA11C00_1;               -- Package body Animal.Mammal
+ 
+      --=================================================================--
+ 
+ package FA11C00_0.FA11C00_1.FA11C00_2 is -- Package Animal.Mammal.Primate
+ 
+    type Habitat_Type is (Arboreal, Terrestrial);
+ 
+    type Primate is new Mammal with
+       record
+          Habitat : Habitat_Type;
+       end record;
+ 
+    function Image (P : Primate) return String;
+ 
+ end FA11C00_0.FA11C00_1.FA11C00_2;       -- Package Animal.Mammal.Primate
+ 
+      --=================================================================--
+ 
+                                          -- Package body Animal.Mammal.Primate
+ package body FA11C00_0.FA11C00_1.FA11C00_2 is 
+ 
+    function Image (P : Primate) return String is
+    begin
+       return ("Primate Species: " & P.Common_Name);
+    end Image;
+ 
+ end FA11C00_0.FA11C00_1.FA11C00_2;       -- Package body Animal.Mammal.Primate
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11d00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11d00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa11d00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa11d00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- FA11D00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares parent types and operations that can
+ --      be inherited by its children.  
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Dec 94   SAIC    Modified type Int_Type
+ --
+ --!
+ 
+ package FA11D00 is  -- Complex_Definition_Pkg
+ 
+    -- Simulate a complex number support package. Complex numbers
+    -- are treated as coordinates in the Cartesian plane.
+ 
+    type Int_Type is range -200 .. 100;
+ 
+    type Complex_Type is record
+       Real : Int_Type;
+       Imag : Int_Type;
+    end record;
+ 
+    Zero        : constant Complex_Type := (Real => 0, Imag => 0);
+    One         : constant Complex_Type := (Real => 1, Imag => 0);
+    Check_Value : constant Complex_Type := (Real => 17, Imag => 23);
+ 
+    Add_Error       : exception;              
+    Subtract_Error  : exception;              
+    Divide_Error    : exception;              
+    Multiply_Error  : exception;              
+ 
+    TC_Handled_In_Caller,                     
+    TC_Handled_In_Child_Pkg_Proc,
+    TC_Handled_In_Child_Pkg_Func,
+    TC_Handled_In_Grandchild_Pkg_Proc,
+    TC_Handled_In_Grandchild_Pkg_Func,
+    TC_Handled_In_Child_Sub,
+    TC_Propagated_To_Caller : boolean := False;
+ 
+    function Complex (Real, Imag : Int_Type)
+      return Complex_Type;                             
+ 
+ end FA11D00;     -- Complex_Definition_Pkg
+ 
+ --=======================================================================--
+ 
+ package body FA11D00 is  -- Complex_Definition_Pkg
+    function Complex (Real, Imag : Int_Type) return Complex_Type is
+    begin
+       return (Real, Imag);
+    end Complex;
+ 
+ end FA11D00;     -- Complex_Definition_Pkg
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa13a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa13a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa13a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa13a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,171 ----
+ -- FA13A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation code is used to check visibility of separate
+ --      subunit of child packages.
+ --      Declares a package containing type definitions; package will be
+ --      with'ed by the root of the elevator abstraction.
+ --
+ --      Declare an elevator abstraction in a parent root package which manages 
+ --      basic operations.  This package has a private part.  Declare a 
+ --      private child package which calculates the floors for going up or 
+ --      down.  Declare a public child package which provides the actual 
+ --      operations.  
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Simulates a fragment of an elevator operation application.
+ 
+ package FA13A00_0 is                      -- Building Manager
+ 
+    type Electrical_Power is (Off, V120, V240);
+    Power : Electrical_Power := V120;
+ 
+    -- other type definitions and procedure declarations in real application.
+ 
+ end FA13A00_0;
+ 
+ -- No bodies provided for FA13A00_0.
+ 
+      --==================================================================--
+ 
+ package FA13A00_1 is                      -- Basic Elevator Operations
+ 
+    type Call_Waiting_Type is private;
+    type Floor is (Basement, Floor1, Floor2, Floor3, Penthouse);
+    type Floor_No is range Floor'Pos(Floor'First) .. Floor'Pos(Floor'Last);
+    Current_Floor : Floor   := Floor1;
+ 
+    TC_Operation  : boolean := true;       
+ 
+    procedure Call (F : in Floor; C : in out Call_Waiting_Type);
+    procedure Clear_Calls (C : in out Call_Waiting_Type);
+ 
+ private
+    type Call_Waiting_Type is array (Floor) of boolean;
+    Call_Waiting : Call_Waiting_Type := (others => false);
+ 
+ end FA13A00_1;
+ 
+ 
+      --==================================================================--
+ 
+ package body FA13A00_1 is              
+ 
+    -- Call the elevator.
+ 
+    procedure Call (F : in Floor; C : in out Call_Waiting_Type) is
+    begin
+       C (F) := true;
+    end Call;
+ 
+    --------------------------------------------
+ 
+    -- Clear all calls of the elevator.
+ 
+    procedure Clear_Calls (C : in out Call_Waiting_Type) is
+    begin
+       C := (others => false);
+    end Clear_Calls;
+ 
+ end FA13A00_1;
+ 
+      --==================================================================--
+ 
+ -- Private child package of an elevator application.  This package calculates
+ -- how many floors to go up or down.
+ 
+ private package FA13A00_1.FA13A00_2 is    -- Floor Calculation
+ 
+    -- Other type definitions in real application.
+ 
+    procedure Up (HowMany : in Floor_No);
+                  
+    procedure Down (HowMany : in Floor_No);
+ 
+ end FA13A00_1.FA13A00_2;
+ 
+      --==================================================================--
+ 
+ package body FA13A00_1.FA13A00_2 is              
+ 
+    -- Go up from the current floor.
+ 
+    procedure Up (HowMany : in Floor_No) is
+    begin
+       Current_Floor := Floor'val (Floor'pos (Current_Floor) + HowMany);
+    end Up;
+ 
+    --------------------------------------------
+ 
+    -- Go down from the current floor.
+ 
+    procedure Down (HowMany : in Floor_No) is
+    begin
+       Current_Floor := Floor'val (Floor'pos (Current_Floor) - HowMany);
+    end Down;
+ 
+ end FA13A00_1.FA13A00_2;
+ 
+      --==================================================================--
+ 
+ -- Public child package of an elevator application.  This package provides
+ -- the actual operation of the elevator.
+ 
+ package FA13A00_1.FA13A00_3 is            -- Move Elevator  
+ 
+    -- Other type definitions in real application.
+ 
+    procedure Move_Elevator (F : in     Floor;
+                             C : in out Call_Waiting_Type);
+ 
+ end FA13A00_1.FA13A00_3;
+ 
+      --==================================================================--
+ 
+ with FA13A00_1.FA13A00_2;                 -- Floor Calculation
+ 
+ package body FA13A00_1.FA13A00_3 is              
+ 
+    -- Going up or down depends on the current floor.
+ 
+    procedure Move_Elevator (F : in     Floor;
+                             C : in out Call_Waiting_Type) is
+    begin
+       if F > Current_Floor then
+          FA13A00_1.FA13A00_2.Up (Floor'Pos (F) - Floor'Pos (Current_Floor));
+          FA13A00_1.Call (F, C);
+       elsif F < Current_Floor then
+          FA13A00_1.FA13A00_2.Down (Floor'Pos (Current_Floor) - Floor'Pos (F));
+          FA13A00_1.Call (F, C);
+       end if;
+ 
+    end Move_Elevator;
+ 
+ end FA13A00_1.FA13A00_3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa13b00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa13b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa13b00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa13b00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- FA13B00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation code is used to check visibility of separate
+ --      subunit of child packages.
+ --      Declares a package containing type definitions and a private
+ --      part; package will be with'ed by the parent's body of the subunits.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FA13B00_0 is             
+ 
+    -- Type definitions.
+ 
+    type Visible_Integer is range 1 .. 10;
+ 
+    type Private_Record is private;
+ 
+    type Visible_Tagged is tagged
+       record
+          PR : Private_Record;
+       end record;
+ 
+    type Private_Tagged is tagged private;
+ 
+    Visible_Num : Visible_Integer := 7;
+ 
+    -- Subprogram definitions.
+ 
+    function Assign_Visible_Tagged (I : Visible_Integer) 
+      return Visible_Tagged;
+ 
+    function Assign_Private_Tagged (I : Visible_Integer) 
+      return Private_Tagged;
+ 
+ private
+ 
+    -- Type definitions.
+ 
+    type Private_Integer is range 11 .. 20;
+ 
+    type Private_Record is
+       record
+          VI : Visible_Integer;
+       end record;
+ 
+    type Private_Tagged is tagged
+       record
+          VI : Visible_Integer;
+       end record;
+ 
+    -- Object definitions.
+ 
+    Private_Num : Visible_Integer :=  6;
+ 
+ end FA13B00_0;
+ 
+      --==================================================================--
+ 
+ package body FA13B00_0 is             
+ 
+    function Assign_Visible_Tagged(I : Visible_Integer) 
+      return Visible_Tagged is
+      VT : Visible_Tagged := (PR => (VI => I));
+    begin
+      return VT;
+    end Assign_Visible_Tagged;
+ 
+    -------------------------------------------------------
+ 
+    function Assign_Private_Tagged (I : Visible_Integer) 
+      return Private_Tagged is
+      PT : Private_Tagged := (VI => I);
+    begin
+      return PT;
+    end Assign_Private_Tagged;
+ 
+    -------------------------------------------------------
+ 
+ end FA13B00_0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa21a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa21a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fa21a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fa21a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,127 ----
+ -- FA21A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares various supporting types, objects, and
+ --      subprograms for use in tests checking preelaborability.
+ --
+ -- CHANGE HISTORY:
+ --      20 Mar 95   SAIC    Initial prerelease version.
+ --
+ --!
+ 
+ with Ada.Finalization; -- Preelaborated library unit.
+ package FA21A00 is
+ 
+    pragma Preelaborate (FA21A00);
+ 
+ 
+    type My_Int is new Integer range 0 .. 100;
+    function Func return My_Int;                 -- Non-static function.
+ 
+    subtype Idx is Natural range 1 .. 5;
+ 
+    Three : constant My_Int :=  3;
+    Ten   :          My_Int := 10;               -- Non-static.
+ 
+    type RecWithDisc (D: My_Int) is record
+       Twice: My_Int := D*2;
+    end record;
+ 
+    type RecCallDefault is record
+       C : My_Int := Func;
+       D : My_Int := 0;
+    end record;
+ 
+    type RecPrimDefault is record
+       C : My_Int := Ten;
+    end record;
+ 
+    type Tag is tagged record
+       C : My_Int;
+    end record;
+ 
+    type AccTag is access all Tag;
+ 
+    Tag1: aliased Tag;                                                 -- OK.
+ 
+    type My_Controlled is new Ada.Finalization.Controlled with record
+       C : My_Int;
+    end record;
+ 
+    type ContComp is tagged record
+       C: My_Controlled;
+    end record;
+ 
+    task type Tsk (D: My_Int);
+ 
+    protected type Prot is
+       entry E;
+    end Prot;
+ 
+    type Priv is tagged private;
+ 
+    type PrivComp is array (1 .. 5) of Priv;
+ 
+    type Pri_Ext is new Tag with private;
+ 
+    type PriExtComp is array (1 .. 5) of Pri_Ext;
+ 
+ private
+ 
+    type Priv is tagged record
+       B: Boolean;
+    end record;
+ 
+    type Pri_Ext is new Tag with record
+       N: String (1 .. 5);
+    end record;
+ 
+ end FA21A00;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body FA21A00 is
+ 
+    task body Tsk is
+    begin
+       null;
+    end Tsk;
+ 
+    protected body Prot is
+       entry E when False is
+       begin
+          null;
+       end E;
+    end Prot;
+ 
+    function Func return My_Int is
+    begin
+       return 0;
+    end Func;
+ 
+ end FA21A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fb20a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fb20a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fb20a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fb20a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- FB20A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This test performs a search for the first instance of a specified 
+ --      substring within a specified string, returning boolean result.
+ --      (Case insensitive analysis)  Both the string and the substring are 
+ --      made upper case.  Successive slices are taken from the input string
+ --      and compared with the substring. If a match is found, the search is 
+ --      terminated immediately. The search continues until the last index 
+ --      position from which a substring-length slice can be constructed is
+ --      passed. 
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FB20A00 is
+ 
+    function Find ( Str : in String ;           
+                    Sub : in String ) return Boolean;
+ 
+ end FB20A00;
+ 
+      --=================================================================--
+ 
+ package body FB20A00 is
+                  
+    function Find ( Str : in String ;          
+                    Sub : in String ) return Boolean is
+ 
+       New_Str : String (Str'First .. Str'Last);
+       New_Sub : String (Sub'First .. Sub'Last);
+ 
+       Pos : Integer := Str'First ;             -- Character index.
+ 
+                  
+       function Upper_Case (Str : in String) return String is
+          subtype Upper is Character range 'A' .. 'Z' ;
+          subtype Lower is Character range 'a' .. 'z' ;
+          Ret : String (Str'First .. Str'Last) ;
+          Pos : Integer;
+       begin
+          for I in Str'Range loop
+             if ( Str (I) in Lower ) then
+                Pos := Upper'Pos (Upper'First) +
+                       ( Lower'Pos (Str(I)) - Lower'Pos(Lower'First) ) ;
+                Ret (I) := Upper'Val (Pos) ;
+             else
+                Ret (I) := Str (I);
+             end if ;
+          end loop ;
+          return (Ret) ;
+       end Upper_Case;
+ 
+    begin
+ 
+       
+       New_Str := Upper_Case (Str);             -- Convert Str and Sub to upper 
+       New_Sub := Upper_Case (Sub);             -- case for comparison.
+ 
+       while ( Pos <= New_Str'Last-New_Sub'Length+1 )  -- Search until no more 
+         and then                                      -- sub-string-length 
+         ( New_Str ( Pos .. Pos+New_Sub'Length-1 ) /= New_Sub ) -- slices
+                                                                -- remain.
+       loop
+          Pos := Pos + 1 ;
+       end loop ;
+ 
+       if ( Pos > New_Str'Last-New_Sub'Length+1 ) then  -- Substring not found.
+          return (False);
+       else
+          return (True);
+       end if ;
+ 
+    end Find;
+ 
+ end FB20A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fb40a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fb40a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fb40a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fb40a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- FB40A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation package contains global variables, types, a user
+ --      defined exception, and two subprograms used to increment the 
+ --      global variables.
+ --      See prologues of specific tests for specific information.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package FB40A00 is               -- package Text_Parser
+ 
+    -- Global Variables
+ 
+    AlphaNumeric_Count,
+    Non_AlphaNumeric_Count : Natural := 0;
+ 
+ 
+    -- Types
+ 
+    type String_Pointer_Type is access String;
+ 
+ 
+    -- Exceptions
+ 
+    Completed_Text_Processing : exception;   
+ 
+    -- Subprograms
+ 
+    procedure Increment_AlphaNumeric_Count;   
+    procedure Increment_Non_AlphaNumeric_Count;   
+ 
+ end FB40A00;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ package body FB40A00 is
+ 
+ 
+    procedure Increment_AlphaNumeric_Count is
+    begin
+       AlphaNumeric_Count := AlphaNumeric_Count + 1;
+    end Increment_AlphaNumeric_Count;
+ 
+ 
+    procedure Increment_Non_AlphaNumeric_Count is
+    begin
+       Non_AlphaNumeric_Count := Non_AlphaNumeric_Count + 1;
+    end Increment_Non_AlphaNumeric_Count;
+ 
+ 
+ end FB40A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc50a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc50a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc50a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc50a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- FC50A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares various tagged types which will be passed as
+ --      actuals to generic formal tagged private types. It also declares
+ --      various objects of these types, which will be used for testing.
+ --      The types defined are both discriminated and nondiscriminated.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FC50A00 is
+ 
+ --
+ -- Nonlimited tagged types:
+ --
+ 
+    type Count_Type is tagged record                     -- Nondiscriminated
+       Count : Integer := 0;                             -- type.
+    end record;
+ 
+ 
+    subtype Str_Len  is Natural range 0 .. 100;
+    subtype Stu_ID   is String (1 .. 5);
+    subtype Dept_ID  is String (1 .. 4);
+    subtype Emp_ID   is String (1 .. 9);
+    type    Status   is (Student, Faculty, Staff);
+    subtype Reserved is Positive range 1 .. 50;
+ 
+ 
+    type Person_Type (Stat : Status;                     -- Discriminated
+                      NameLen, AddrLen : Str_Len) is     -- type.
+      tagged record                                 
+       Name    : String (1 .. NameLen);
+       Address : String (1 .. AddrLen);
+       case Stat is
+          when Student =>
+             Student_ID  : Stu_ID;
+          when Faculty =>
+             Department  : Dept_ID;
+          when Staff   =>
+             Employee_ID : Emp_ID;
+       end case;
+    end record;
+ 
+ 
+    type VIPerson_Type is new Person_Type with record    -- Extension of
+       Parking_Space : Reserved;                         -- discriminated type.
+    end record;
+ 
+ 
+    -- Testing entities: ------------------------------------------------
+ 
+    TC_Count_Item     : constant Count_Type    := (Count => 111);
+    TC_Default_Count  : constant Count_Type    := (Count => 0);
+ 
+    TC_Person_Item    : constant Person_Type   :=
+      (Faculty, 18, 17, "Eccles, John Scott", "Popham House, Lee", "0931");
+    TC_Default_Person : constant Person_Type   :=
+      (Student, 0, 0, "", "", "00000");
+ 
+    TC_VIPerson_Item  : constant VIPerson_Type := (TC_Person_Item with 1);
+ 
+    ---------------------------------------------------------------------
+ 
+ 
+ end FC50A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- FC51A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation defines a fraction type abstraction. Fractions are
+ --      implemented as records with two scalar components: a numerator
+ --      of type integer and a denominator of type positive. Fractions are
+ --      created via an overloaded "/" operator.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FC51A00 is   -- Fraction type abstraction.
+ 
+    type Fraction_Type is private;
+ 
+    -- Create a fraction object by integer division.
+    function "/" (Left, Right : Integer) return Fraction_Type;
+ 
+    -- Change the sign of a fraction.
+    function "-" (Frac : Fraction_Type) return Fraction_Type;
+ 
+    -- Return value of numerator as integer.
+    function Numerator (Frac : Fraction_Type) return Integer;
+ 
+    -- Return value of denominator as integer.
+    function Denominator (Frac : Fraction_Type) return Integer;
+ 
+    -- ... Other operations on fraction types.
+ 
+ private
+ 
+    type Fraction_Type is record
+       Numerator   : Integer;
+       Denominator : Positive;
+    end record;
+ 
+ end FC51A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body FC51A00 is
+ 
+    function "/" (Left, Right : Integer) return Fraction_Type is
+       Result : Fraction_Type;
+    begin
+       Result.Numerator   := Left;
+       Result.Denominator := Right;
+       return Result;
+    end "/";
+ 
+ 
+    function "-" (Frac : Fraction_Type) return Fraction_Type is
+       Result : Fraction_Type := Frac;
+    begin
+       Result.Numerator := -(Result.Numerator);
+       return Result;
+    end "-";
+ 
+ 
+    function Numerator (Frac : Fraction_Type) return Integer is
+    begin
+       return (Frac.Numerator);
+    end Numerator;
+ 
+ 
+    function Denominator (Frac : Fraction_Type) return Integer is
+    begin
+       return (Frac.Denominator);
+    end Denominator;
+ 
+ 
+ end FC51A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51b00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51b00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51b00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,62 ----
+ -- FC51B00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares a set of tagged and untagged indefinite
+ --      subtypes.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FC51B00 is  -- Type definitions.
+ 
+    subtype Size is Natural range 1 .. 4;
+ 
+    type Matrix is array                                 -- Unconstrained array
+      (Size range <>, Size range <>) of Integer;         -- type.
+ 
+    type Square (Side : Size) is record                  -- Unconstrained record
+       Mat : Matrix (1 .. Side, 1 .. Side);              -- with undefaulted
+    end record;                                          -- discriminants.
+ 
+    type Square_Pair (Dimension : Size) is tagged record -- Unconstrained tagged
+       Left  : Square (Dimension);                       -- type.
+       Right : Square (Dimension);
+    end record;
+ 
+    type Vector is tagged record                         -- Constrained tagged
+       Mat : Matrix (1 .. 3, 1 .. 1);                    -- type (used to get
+    end record;                                          -- class-wide type).
+ 
+    generic  -- Template for a generic formal package.
+       type Vectors (<>) is new Vector with private;     -- Type with unknown
+    package Signature is end;                            -- discriminants.
+ 
+ end FC51B00;
+ 
+ 
+ -- No body for FC51B00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51c00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51c00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51c00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- FC51C00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares a hierarchy of tagged types, which includes
+ --      both abstract and non-abstract types, and which have both abstract
+ --      and non-abstract primitive subprograms.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      03 Nov 95   SAIC    ACVC 2.0.1 fixes: Deleted primitive operation Proc
+ --                          of Concrete_Root.
+ --      11 Aug 96   SAIC    ACVC 2.1: Changed procedure bodies to update
+ --                          actual parameters.
+ --
+ --!
+ 
+ package FC51C00 is
+ 
+ --
+ -- Non-abstract ultimate ancestor type:
+ --
+ 
+    type Concrete_Root is tagged null record;
+ 
+    function Func (P: Concrete_Root) return Concrete_Root;    -- Abstract when
+                                                              -- inherited.
+ 
+ 
+ --
+ -- Abstract descendant of non-abstract ultimate ancestor:
+ --
+ 
+    type Abstract_Child is abstract new Concrete_Root with null record;
+ 
+    -- Inherits:
+    -- function Func (P: Abstract_Child) return Abstract_Child is abstract;
+ 
+    procedure Proc (P: in out Abstract_Child) is abstract;    -- Abstract.
+    procedure New_Proc (P : out Abstract_Child) is abstract;  -- Abstract.
+ 
+    
+ 
+ --
+ -- Non-abstract descendant of abstract descendant:
+ --
+ 
+    type Concrete_GrandChild is new Abstract_Child with null record;
+ 
+    function Func (P: Concrete_GrandChild) return Concrete_GrandChild;
+ 
+    procedure Proc (P: in out Concrete_GrandChild);
+    procedure New_Proc (P : out Concrete_GrandChild);
+ 
+    
+ end FC51C00;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body FC51C00 is
+ 
+    Value : Concrete_GrandChild;
+ 
+ 
+    function Func (P: Concrete_Root) return Concrete_Root is
+    begin
+       return P;
+    end Func;
+ 
+ 
+    function Func (P: Concrete_GrandChild) return Concrete_GrandChild is
+    begin
+       return P;
+    end Func;
+ 
+ 
+    procedure Proc (P: in out Concrete_GrandChild) is
+    begin
+       P := Value;
+    end Proc;
+ 
+ 
+    procedure New_Proc (P : out Concrete_GrandChild) is
+    begin
+       P := Value;
+    end New_Proc;
+ 
+ end FC51C00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51d00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51d00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc51d00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc51d00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- FC51D00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation defines a generic list abstraction. List elements can
+ --      be of any (nonlimited) type. Lists are implemented as arrays of
+ --      pointers and are only two elements in length.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ generic
+    type Element_Type (<>) is private;
+ package FC51D00 is  -- This package simulates a generic list abstraction.
+ 
+    -- The definition of List_Type below is purely artificial; its validity
+    -- in the context of the abstraction is irrelevant to the feature being
+    -- tested.
+ 
+    type Element_Ptr is access Element_Type;
+ 
+    subtype List_Size is Natural range 1 .. 2;
+    type List_Type is array (List_Size) of Element_Ptr;
+ 
+    function  View_Element (I : List_Size; L : List_Type) return Element_Type;
+ 
+    procedure Write_Element (I : in     List_Size;
+                             L : in out List_Type;
+                             E : in     Element_Type);
+ 
+    -- ... Other list operations for Element_Type.
+ 
+ end FC51D00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body FC51D00 is
+ 
+    -- The implementations of the operations below are purely artificial; the
+    -- validity of their implementations in the context of the abstraction is
+    -- irrelevant to the feature being tested.
+ 
+    function View_Element (I : List_Size; L : List_Type) return Element_Type is
+    begin
+       return L(I).all;
+    end View_Element;
+ 
+ 
+    procedure Write_Element (I : in     List_Size;
+                             L : in out List_Type;
+                             E : in     Element_Type) is
+    begin
+       L(I) := new Element_Type'(E);
+    end Write_Element;
+ 
+ end FC51D00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc54a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc54a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc54a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc54a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- FC54A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares various types which will serve as designated
+ --      types for tests involving generic formal access types (including
+ --      access-to-subprogram types).
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FC54A00 is
+ 
+ 
+    -- Discrete (integer) types:
+ 
+    Bits : constant := 8;                    -- Named number.
+ 
+    type    Numerals           is range -256 .. 255;
+    type    New_Numerals       is new Numerals range -128 .. 127;
+    subtype Positives          is Numerals range 0 .. 255;
+    subtype Same_Numerals      is Numerals;
+    subtype Numerals_Static    is Numerals range -2**Bits .. 2**Bits - 1;
+ 
+    Min  : Numerals  := Numerals'First;      -- Variable.
+    Max  : Integer   := 255;                 -- Variable.
+ 
+    subtype Numerals_Nonstatic is Numerals  range Min .. 255;
+    subtype Positive_Nonstatic is Positives range 0 .. Positives(Max);
+    subtype Pos_Dupl_Nonstatic is Positives range 0 .. Positives(Max);
+    subtype Pos_Attr_Nonstatic is Positives range Positive_Nonstatic'Range;
+ 
+ 
+ 
+    -- Floating point types:
+ 
+    type    Float_Type       is digits 3;
+    type    New_Float        is new Float_Type;
+    subtype Float_100        is Float_Type range 0.0 .. 100.0;
+    subtype Same_Float       is Float_Type;
+ 
+    Hundred : constant := 100.0;             -- Named number.
+ 
+    type    Float_With_Range is digits 3 range 0.0 .. 100.0;
+    subtype Float_Same_Range is Float_With_Range range 0.0 .. Hundred;
+ 
+ 
+ 
+    -- Tagged record types:
+ 
+    subtype Lengths is Natural range 0 .. 50;
+ 
+    type Parent is abstract tagged null record;
+ 
+    type Tag (Len: Lengths) is new Parent with record
+       Msg : String (1 .. Len);
+    end record;
+ 
+    type New_Tag is new Tag with record
+       Sent : Boolean;
+    end record;
+ 
+    subtype Same_Tag is Tag;
+ 
+    Twenty : constant := 20;                 -- Named number.
+ 
+    subtype Tag20      is Tag (Len => 20);
+    subtype Tag25      is Tag (25);
+    subtype Tag_Twenty is Tag (Twenty);
+ 
+    My_Len : Lengths := Twenty;              -- Variable.
+    subtype Sub_Length is Lengths range 1 .. My_Len;
+ 
+    subtype Tag20_Nonstatic      is Tag (Len => Sub_Length'Last);
+    subtype Tag20_Dupl_Nonstatic is Tag (Sub_Length'Last);
+    subtype Tag20_Same_Nonstatic is Tag20_Nonstatic;
+    subtype Tag20_Var_Nonstatic  is Tag (Len => My_Len);
+ 
+ 
+ 
+    -- Access types (designated type is tagged):
+ 
+    type Tagged_Ptr         is access Tag;
+    type Tag_Class_Ptr      is access Tag'Class;
+ 
+    subtype Msg_Ptr_Static  is Tagged_Ptr(Twenty);
+ 
+ 
+ 
+    -- Array types:
+ 
+    type    New_String  is new String;
+    subtype Same_String is String;
+ 
+    Ten : constant := 10;                    -- Named number.
+ 
+    subtype Msg_Static  is     String(1 .. Ten);
+    type    Msg10       is new String(1 .. 10);
+    subtype Msg20       is     String(1 .. 20);
+ 
+    Size : Positive := 10;
+ 
+    subtype Msg_Nonstatic      is String(1 .. Size);
+    subtype Msg_Dupl_Nonstatic is String(1 .. Size);
+    subtype Msg_Same_Nonstatic is Msg_Nonstatic;
+ 
+ 
+ end FC54A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc70a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc70a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc70a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc70a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- FC70A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This file simulates a generic complex integer support package, to be
+ --      used for tests covering generic formal packages.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ generic               -- Complex integer abstraction.
+    type Int_Type is range <>;
+ package FC70A00 is
+ 
+    -- Simulate a generic complex integer support package. Complex integers
+    -- are treated as coordinates in the Cartesian plane.
+ 
+ 
+    type Complex_Type is private;
+ 
+    Zero : constant Complex_Type;                      -- (0,0).
+    One  : constant Complex_Type;                      -- (1,0).
+ 
+ 
+    function "-" (Right : Complex_Type)                -- Invert a complex
+      return Complex_Type;                             -- integer.
+ 
+    function "+" (Left, Right : Complex_Type)          -- Add two complex
+      return Complex_Type;                             -- integers.
+ 
+    function "*" (Left, Right : Complex_Type)          -- Multiply two complex
+      return Complex_Type;                             -- integers.
+ 
+    function Reciprocal (Right : Complex_Type)         -- Return the reciprocal
+      return Complex_Type;                             -- of a complex integer.
+ 
+    function Complex (Real, Imag : Int_Type)           -- Create a complex
+      return Complex_Type;                             -- integer.
+ 
+ private
+    
+    type Complex_Type is record
+       Real : Int_Type;
+       Imag : Int_Type;
+    end record;
+ 
+    Zero : constant Complex_Type := (Real => 0, Imag => 0);
+    One  : constant Complex_Type := (Real => 1, Imag => 0);
+ 
+ end FC70A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body FC70A00 is  -- Complex integer abstraction.
+ 
+    function Complex (Real, Imag : Int_Type) return Complex_Type is
+    begin
+       return ( (Real, Imag) );
+    end Complex;
+ 
+                --==============================================--
+ 
+    function "-" (Right : Complex_Type) return Complex_Type is
+    begin
+       return ( (-Right.Real, -Right.Imag) );
+    end "-";
+ 
+                --==============================================--
+ 
+    function "+" (Left, Right : Complex_Type) return Complex_Type is
+    begin
+       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
+    end "+";
+ 
+                --==============================================--
+ 
+    function "*" (Left, Right : Complex_Type) return Complex_Type is
+    begin
+       return ( (Real => (Left.Real * Right.Real) - (Left.Imag * Right.Imag),
+                 Imag => (Left.Imag * Right.Real) + (Left.Real * Right.Imag)) );
+    end "*";
+ 
+                --==============================================--
+ 
+    function Reciprocal (Right : Complex_Type) return Complex_Type is
+       Denominator : Int_Type := Right.Real**2 + Right.Imag**2;
+    begin  -- NOTE: Results are truncated.
+       return ( (Right.Real/Denominator, -Right.Imag/Denominator) );
+    end Reciprocal;
+ 
+ end FC70A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc70b00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc70b00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc70b00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc70b00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- FC70B00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation defines a generic list abstraction. List elements can
+ --      be of any (nonlimited) type. Lists are implemented as singly linked
+ --      lists. Access to list elements is sequential. For each list, pointers
+ --      are maintained to the first and last elements in the list, as well as
+ --      the next element to be accessed.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ generic                           -- List abstraction.
+    type Element_Type is private;  -- List elems can be of any nonlimited type.
+ package FC70B00 is
+ 
+    type List_Type is limited private;
+ 
+    -- Return true if current element is last in the list.
+    function End_Of_List (L : List_Type) return Boolean;
+ 
+    -- Read current element value; do NOT advance "current" pointer.
+    procedure View_Element (L : in List_Type; E : out Element_Type);
+ 
+    -- Read from current element and advance "current" pointer.
+    procedure Read_Element (L : in out List_Type; E : out Element_Type);
+ 
+    -- Write to current element and advance "current" pointer.
+    procedure Write_Element (L : in out List_Type; E : in Element_Type);
+ 
+    -- Add element to end of list.
+    procedure Add_Element (L : in out List_Type; E : in Element_Type);
+ 
+    -- Set "current" pointer to first list element.
+    procedure Reset (L : in out List_Type);
+ 
+ private
+ 
+    type Node_Type;
+    type Node_Pointer is access Node_Type;
+ 
+    type Node_Type is record
+       Item : Element_Type;
+       Next : Node_Pointer;
+    end record;
+ 
+    type List_Type is record
+       First   : Node_Pointer;
+       Current : Node_Pointer;
+       Last    : Node_Pointer;
+    end record;
+ 
+ end FC70B00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body FC70B00 is
+ 
+    function End_Of_List (L : List_Type) return Boolean is
+    begin
+       return (L.Current = null);
+    end End_Of_List;
+ 
+ 
+    procedure View_Element (L : in List_Type; E : out Element_Type) is
+    begin
+       -- ... Error-checking code omitted for brevity.
+       E := L.Current.Item;               -- Retrieve current element.
+    end View_Element;
+ 
+ 
+    procedure Read_Element (L : in out List_Type; E : out Element_Type) is
+    begin
+       -- ... Error-checking code omitted for brevity.
+       E         := L.Current.Item;       -- Retrieve current element.
+       L.Current := L.Current.Next;       -- Advance "current" pointer.
+    end Read_Element;
+ 
+ 
+    procedure Write_Element (L : in out List_Type; E : in Element_Type) is
+    begin
+       -- ... Error-checking code omitted for brevity.
+       L.Current.Item := E;               -- Write to current element.
+       L.Current      := L.Current.Next;  -- Advance "current" pointer.
+    end Write_Element;
+ 
+ 
+    procedure Add_Element (L : in out List_Type; E : in Element_Type) is
+       New_Node : Node_Pointer := new Node_Type'(E, null); 
+    begin
+       if L.First = null then             -- No elements in list, so add new
+          L.First := New_Node;            -- element at beginning of list.
+       else
+          L.Last.Next := New_Node;        -- Add new element at end of list.
+       end if;
+       L.Last := New_Node;                -- Set last-in-list pointer.
+    end Add_Element;
+ 
+ 
+    procedure Reset (L : in out List_Type) is
+    begin
+       L.Current := L.First;              -- Set "current" pointer to first
+    end Reset;                            -- list element.
+ 
+ 
+ end FC70B00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc70c00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc70c00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fc70c00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fc70c00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- FC70C00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation defines a generic list abstraction in two packages.
+ --      The first package declares the types, the second declares the
+ --      operations. List elements can be of any (nonlimited) type. Lists are
+ --      implemented as singly linked lists. Access to list elements is
+ --      sequential. For each list, pointers are maintained to the first and
+ --      last elements in the list, as well as the next element to be accessed.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ generic             
+    type Element_Type is private;  -- List elems may be of any nonlimited type.
+ package FC70C00_0 is              -- List abstraction.
+ 
+    type Node_Type;
+    type Node_Pointer is access Node_Type;
+ 
+    type Node_Type is record
+       Item : Element_Type;
+       Next : Node_Pointer;
+    end record;
+ 
+    type List_Type is record
+       First   : Node_Pointer;
+       Current : Node_Pointer;
+       Last    : Node_Pointer;
+    end record;
+ 
+ end FC70C00_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- No body for FC70C00_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC70C00_0;                -- List abstraction.
+ generic
+    with package List_Mgr is new FC70C00_0 (<>);
+ package FC70C00_1 is           -- Basic list operations.
+ 
+    -- Return true if current element is last in the list.
+    function End_Of_List (L : List_Mgr.List_Type) return Boolean;
+ 
+    -- Set "current" pointer to first list element.
+    procedure Reset (L : in out List_Mgr.List_Type);
+ 
+ end FC70C00_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body FC70C00_1 is
+ 
+    function End_Of_List (L : List_Mgr.List_Type) return Boolean is
+       use List_Mgr;  -- Renders "=" directly visible.
+    begin
+       return (L.Current = null);
+    end End_Of_List;
+ 
+ 
+    procedure Reset (L : in out List_Mgr.List_Type) is
+    begin
+       L.Current := L.First;                 -- Set "current" pointer to first
+    end Reset;                               -- list element.
+ 
+ end FC70C00_1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fcndecl.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fcndecl.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fcndecl.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fcndecl.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- FCNDECL.ADA
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- PACKAGE THAT MAY BE MODIFIED TO DECLARE FUNCTIONS THAT RETURN
+ -- VALUES USABLE FOR INITIALIZATION OF CONSTANTS IN PACKAGE SPPRT13.
+ 
+ WITH SYSTEM;
+ PACKAGE FCNDECL IS
+ -- INSERT FUNCTION DECLARATIONS AS NEEDED.
+ 
+   type Mem is array (1 .. 100) of Long_Long_Integer;
+   Var0: Mem;
+   Var1: Mem;
+   Var2: Mem;
+ 
+   Var_Addr : constant System.Address := Var0'address;
+   Var_Addr1: constant System.Address := Var1'address;
+   Var_Addr2: constant System.Address := Var2'address;
+ 
+   Ent0: Mem;
+   Ent1: Mem;
+   Ent2: Mem;
+ 
+   Entry_Addr : constant System.Address := Ent0'address;
+   Entry_Addr1: constant System.Address := Ent0'address;
+   Entry_Addr2: constant System.Address := Ent0'address;
+ 
+ END FCNDECL;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fd72a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fd72a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fd72a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fd72a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- FD72A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides a basis for testing package
+ --      System.Address_To_Access_Conversions
+ --
+ -- TEST FILES:
+ --      The following files comprise this foundation:
+ --
+ --         FD72A00.A
+ --
+ -- CHANGE HISTORY:
+ --      08 FEB 96   SAIC    Initial version
+ --
+ --!
+ 
+ with Impdef;
+ with System.Storage_Elements;
+ package FD72A00 is
+   use System;
+ 
+   subtype Number is System.Storage_Elements.Integer_Address;
+ 
+   package Num_IO renames Impdef.Address_Value_IO;
+ 
+     -- the following conversions To/From Hex are to prevent optimizers from
+     -- optimizing out the otherwise senseless identity conversions, and
+     -- given the unknown nature of the type Number, the Identity operations
+     -- provided in Report will not suffice to this cause.
+ 
+     function Address_To_Hex( Adder: System.Address ) return String;
+ 
+     function Hex_To_Address( Hex: access String ) return System.Address;
+ 
+ end FD72A00;
+ 
+ package body FD72A00 is
+ 
+     function Address_To_Hex( Adder: System.Address ) return String is
+       S : String(1..64)
+        := "uninitializedDEFuninitializedDEFuninitializedDEFuninitializedDEF";
+       DeBlank : Positive := S'First;
+     begin
+       Num_IO.Put( S, Number( System.Storage_Elements.To_Integer( Adder ) ),
+                   Base => 16 );
+       while S(DeBlank) = ' ' loop
+         DeBlank := DeBlank +1;
+       end loop;
+       return S(DeBlank..S'Last);
+     end Address_To_Hex;
+ 
+     function Hex_To_Address( Hex: access String ) return System.Address is
+       The_Number : Number;
+       Tail       : Natural;
+     begin
+       Num_IO.Get( Hex.all, The_Number, Tail );
+       return System.Storage_Elements.To_Address(
+                       System.Storage_Elements.Integer_Address( The_Number ) );
+     end Hex_To_Address;
+ 
+ end FD72A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fdb0a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fdb0a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fdb0a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fdb0a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- FDB0A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides the basis for testing package
+ --      System.Storage_Pools.  It provides simple implementations of
+ --      Allocate and Deallocate that have the side effect of calling
+ --      TCTouch.Touch when they are called.
+ --
+ -- CHANGE HISTORY:
+ --      02 JUN 95   SAIC   Initial version
+ --      05 APR 96   SAIC   Fixed header for 2.1
+ --      02 JUL 98   EDS    Swapped Pool.Avail change with overflow check
+ --!
+ 
+ ---------------------------------------------------------------- FDB0A00
+ 
+ with Report;
+ with System.Storage_Pools;
+ with System.Storage_Elements;
+ package FDB0A00 is
+ 
+   type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count )
+      is new System.Storage_Pools.Root_Storage_Pool with private;
+ 
+   procedure Allocate(
+     Pool : in out Stack_Heap;
+     Storage_Address : out System.Address;
+     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
+     Alignment : in System.Storage_Elements.Storage_Count);
+ 
+   procedure Deallocate(
+     Pool : in out Stack_Heap;
+     Storage_Address : in System.Address;
+     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
+     Alignment : in System.Storage_Elements.Storage_Count);
+ 
+   function Storage_Size( Pool: in Stack_Heap )
+            return System.Storage_Elements.Storage_Count;
+ 
+   function TC_Largest_Request return System.Storage_Elements.Storage_Count;
+ 
+   Pool_Overflow : exception;
+ 
+ private
+ 
+   type Data_Array is array(System.Storage_Elements.Storage_Count range <>)
+                      of System.Storage_Elements.Storage_Element;
+ 
+   type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count )
+      is new System.Storage_Pools.Root_Storage_Pool with record
+        Data  : Data_Array(1..Water_Line);
+        Avail : System.Storage_Elements.Storage_Count := 1;
+   end record;
+ 
+ end FDB0A00;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body FDB0A00 is
+ 
+   Largest_Request_On_Record : System.Storage_Elements.Storage_Count := 0;
+ 
+   procedure Allocate(
+     Pool : in out Stack_Heap;
+     Storage_Address : out System.Address;
+     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
+     Alignment : in System.Storage_Elements.Storage_Count) is
+       use type System.Storage_Elements.Storage_Offset;
+   begin
+     TCTouch.Touch('A');  --------------------------------------------------- A
+ 
+     -- set the pointer to the next correctly aligned available address
+     Pool.Avail := Pool.Avail
+                 + (Alignment - (Pool.Data(Pool.Avail)'Address mod Alignment));
+ 
+     -- check for overflow
+     if Pool.Avail + Size_In_Storage_Elements > Pool.Water_Line then
+       raise Pool_Overflow;
+     end if;
+ 
+     -- set the resulting address to that address
+     Storage_Address := Pool.Data(Pool.Avail)'Address;
+ 
+     -- update the housekeeping
+     Pool.Avail := Pool.Avail + Size_In_Storage_Elements;
+     Largest_Request_On_Record
+       := System.Storage_Elements.Storage_Count'Max(Largest_Request_On_Record,
+                                                    Size_In_Storage_Elements);
+   exception
+     when Constraint_Error => raise Pool_Overflow;  -- in case I missed an edge
+   end Allocate;
+ 
+   procedure Deallocate(
+     Pool : in out Stack_Heap;
+     Storage_Address : in System.Address;
+     Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
+     Alignment : in System.Storage_Elements.Storage_Count) is
+   begin
+     TCTouch.Touch('D');  --------------------------------------------------- D
+ 
+     -- for the purposes of validation, the simplest possible implementation
+     -- of Deallocate is shown below:
+ 
+     null;
+ 
+   end Deallocate;
+ 
+   function Storage_Size( Pool: in Stack_Heap )
+            return System.Storage_Elements.Storage_Count is
+   begin
+     TCTouch.Touch('S');  --------------------------------------------------- S
+     return Pool.Water_Line;
+   end Storage_Size;
+ 
+   function TC_Largest_Request return System.Storage_Elements.Storage_Count is
+   begin
+     return Largest_Request_On_Record;
+   end TC_Largest_Request;
+ 
+ end FDB0A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fdd2a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fdd2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fdd2a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fdd2a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- FDD2A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides the basis for testing user-defined stream
+ --      attributes. It provides operations which count calls to stream
+ --      attributes.
+ --
+ -- CHANGE HISTORY:
+ --    30 JUL 2001   PHL   Initial version.
+ --     5 DEC 2001   RLB   Reformatted for ACATS.
+ --
+ 
+ with Ada.Streams;
+ use Ada.Streams;
+ package FDD2A00 is
+ 
+     type Kinds is (Read, Write, Input, Output);
+     type Counts is array (Kinds) of Natural;
+ 
+ 
+     type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
+         record
+             First : Stream_Element_Offset := 1;
+             Last : Stream_Element_Offset := 0;
+             Contents : Stream_Element_Array (1 .. Size);
+         end record;
+ 
+     procedure Clear (Stream : in out My_Stream);
+ 
+     procedure Read (Stream : in out My_Stream;
+                     Item : out Stream_Element_Array;
+                     Last : out Stream_Element_Offset);
+ 
+     procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
+ 
+ 
+     generic
+         type T (<>) is limited private;
+         with procedure Actual_Write
+                           (Stream : access Root_Stream_Type'Class; Item : T);
+         with function Actual_Input
+                          (Stream : access Root_Stream_Type'Class) return T;
+         with procedure Actual_Read (Stream : access Root_Stream_Type'Class;
+                                     Item : out T);
+         with procedure Actual_Output
+                           (Stream : access Root_Stream_Type'Class; Item : T);
+     package Counting_Stream_Ops is
+ 
+         procedure Write (Stream : access Root_Stream_Type'Class; Item : T);
+         function Input (Stream : access Root_Stream_Type'Class) return T;
+         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T);
+         procedure Output (Stream : access Root_Stream_Type'Class; Item : T);
+ 
+         function Get_Counts return Counts;
+ 
+     end Counting_Stream_Ops;
+ 
+ end FDD2A00;
+ package body FDD2A00 is
+ 
+     procedure Clear (Stream : in out My_Stream) is
+     begin
+         Stream.First := 1;
+         Stream.Last := 0;
+     end Clear;
+ 
+     procedure Read (Stream : in out My_Stream;
+                     Item : out Stream_Element_Array;
+                     Last : out Stream_Element_Offset) is
+     begin
+         if Item'Length >= Stream.Last - Stream.First + 1 then
+             Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
+                Stream.Contents (Stream.First .. Stream.Last);
+             Last := Item'First + Stream.Last - Stream.First;
+             Stream.First := Stream.Last + 1;
+         else
+             Item := Stream.Contents (Stream.First ..
+                                         Stream.First + Item'Length - 1);
+             Last := Item'Last;
+             Stream.First := Stream.First + Item'Length;
+         end if;
+     end Read;
+ 
+     procedure Write (Stream : in out My_Stream;
+                      Item : in Stream_Element_Array) is
+     begin
+         Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
+         Stream.Last := Stream.Last + Item'Length;
+     end Write;
+ 
+ 
+     package body Counting_Stream_Ops is
+         Cnts : Counts := (others => 0);
+ 
+         procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
+         begin
+             Cnts (Write) := Cnts (Write) + 1;
+             Actual_Write (Stream, Item);
+         end Write;
+ 
+         function Input (Stream : access Root_Stream_Type'Class) return T is
+         begin
+             Cnts (Input) := Cnts (Input) + 1;
+             return Actual_Input (Stream);
+         end Input;
+ 
+         procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
+         begin
+             Cnts (Read) := Cnts (Read) + 1;
+             Actual_Read (Stream, Item);
+         end Read;
+ 
+         procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
+         begin
+             Cnts (Output) := Cnts (Output) + 1;
+             Actual_Output (Stream, Item);
+         end Output;
+ 
+         function Get_Counts return Counts is
+         begin
+             return Cnts;
+         end Get_Counts;
+ 
+     end Counting_Stream_Ops;
+ 
+ end FDD2A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxa5a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxa5a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxa5a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxa5a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,121 ----
+ -- FXA5A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation package contains constants and a function used in 
+ --      the evaluation of the Generic Elementary Functions.
+ --
+ -- CHANGE HISTORY:
+ --      06 Mar 95   SAIC    Initial prerelease version.
+ --      03 Apr 95   SAIC    Corrected error in context clause.
+ --      12 Jun 95   SAIC    Added procedure Dont_Optimize.  Added New_Float
+ --                          type, and overload of function 
+ --                          Result_Within_Range.
+ --
+ --!
+ 
+ with Ada.Numerics;
+ with Report;
+ 
+ package FXA5A00 is
+ 
+    -- Constants.
+ 
+    Epsilon               : constant Float := Float'Model_Epsilon;
+    Small                 : constant Float := Float'Model_Small;
+    Large                 : constant Float := Float'Safe_Last;
+    Minus_Large           : constant Float := Float'Safe_First; 
+ 
+    Half_Pi               : constant Float := Ada.Numerics.Pi / 2.0;
+    Two_Pi                : constant Float := Ada.Numerics.Pi * 2.0;
+ 
+    Floating_Delta        : constant Float :=  0.05;
+    One_Plus_Delta        : constant Float :=  1.0 + Floating_Delta;
+    One_Minus_Delta       : constant Float :=  1.0 - Floating_Delta;
+    Minus_One_Plus_Delta  : constant Float := -1.0 + Floating_Delta;
+    Minus_One_Minus_Delta : constant Float := -1.0 - Floating_Delta;
+ 
+ 
+    type New_Float is new Float digits 6;
+ 
+    function Result_Within_Range (Result          : Float;
+                                  Expected_Result : Float;
+                                  Relative_Error  : Float) return Boolean;
+ 
+    function Result_Within_Range (Result          : New_Float;
+                                  Expected_Result : Float;
+                                  Relative_Error  : Float) return Boolean;
+ 
+    -- This procedure is designed to defeat optimization attempts by an 
+    -- implementation in cases where an exception is specifically raised
+    -- in a test to test a prescribed exception result condition.
+    -- The parameter Num is a unique identifier for location purposes within
+    -- the test.
+ 
+    generic
+       type Eval_Type is digits <>;
+    procedure Dont_Optimize (Check_Result : Eval_Type; 
+                             Num          : Integer);
+ 
+ end FXA5A00;
+ 
+ ---
+ 
+ package body FXA5A00 is
+ 
+ 
+    function Result_Within_Range (Result          : Float;
+                                  Expected_Result : Float;
+                                  Relative_Error  : Float) return Boolean is
+    begin
+       return (Result <= Expected_Result + Relative_Error) and 
+              (Result >= Expected_Result - Relative_Error);
+    end Result_Within_Range;
+ 
+ 
+    function Result_Within_Range (Result          : New_Float;
+                                  Expected_Result : Float;
+                                  Relative_Error  : Float) return Boolean is
+    begin
+       return (Float(Result) <= Expected_Result + Relative_Error) and 
+              (Float(Result) >= Expected_Result - Relative_Error);
+    end Result_Within_Range;
+ 
+ 
+    procedure Dont_Optimize (Check_Result : Eval_Type; 
+                             Num          : Integer) is
+    begin
+       -- Note that the use of Minus_Large here is simply as a "dummy" value,
+       -- designed to indicate use of the Check_Result parameter, and has no
+       -- pass/fail significance to any test using this procedure.
+       --
+       if Float(Check_Result) = Minus_Large then
+          Report.Comment("Attempted Defeat of Optimization ONLY -- Not " &
+                         "a cause for test failure! "                    & 
+                         "Result = Minus_Large, Case:" & Integer'Image(Num));
+       end if;
+    end Dont_Optimize;
+ 
+ end FXA5A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxaca00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxaca00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxaca00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxaca00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- FXACA00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation consists of type definitions and object declarations 
+ --      used by tests of Stream_IO functionality.
+ --      Objects of both record types specified below (discriminated records
+ --      with defaults, and discriminated records w/o defaults that have the
+ --      discriminant included in a representation clause for the type) should 
+ --      have their discriminants included in the stream when using 'Write 
+ --      Likewise, discriminants should be extracted from the stream when
+ --      using 'Read.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      02 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+ --
+ --!
+ 
+ with ImpDef;
+ 
+ package FXACA00 is
+ 
+    type Origin_Type is (Foreign, Domestic);
+ 
+    for Origin_Type'Size use 1;   -- Forces objects of the type to be
+                                  -- representable in 1 bit, used in rep clause
+                                  -- below for Sales_Record_Type.
+ 
+    type Product_Type (Manufacture : Origin_Type := Domestic) is
+       record
+          Item : String (1..8);               
+          ID   : Natural range 1..100;
+          case Manufacture is
+             when Foreign  =>
+                Importer : String (1..10);
+             when Domestic =>
+                Distributor : String (1..10);
+          end case;
+       end record;
+ 
+ 
+    type Sales_Record_Type (Buyer : Origin_Type) is   -- No default provided
+       record                                         -- for the discriminant.
+          Name      : String (1..6);
+          Sale_Item : Boolean := False;
+          case Buyer is
+             when Foreign  =>
+                Quantity_Discount : Boolean;
+             when Domestic =>
+                Cash_Discount : Boolean;
+          end case;
+       end record;
+ 
+ 
+    String_Bits : constant := ImpDef.Char_Bits * 6 - 1;
+ 
+    -- This discriminated record type has a representation clause that 
+    -- includes the discriminant of the object of this type.
+ 
+    for Sales_Record_Type use                    
+       record                                    
+          Name              at 0 range 0..String_Bits;    
+          Sale_Item         at ImpDef.Next_Storage_Slot range 0..0;     
+          Buyer             at ImpDef.Next_Storage_Slot range 1..1;     
+          Quantity_Discount at ImpDef.Next_Storage_Slot range 2..2;
+          Cash_Discount     at ImpDef.Next_Storage_Slot range 3..3;
+       end record;
+ 
+ 
+    type Timespan_Type is (Week, Month, Year);
+ 
+    type Sales_Statistics_Type is 
+       array (Timespan_Type) of natural range 0 .. 500;
+ 
+ 
+    -- Object Declarations
+ 
+ 
+    Product_01 : Product_Type := (Domestic, "Product1", 1, "Distrib 01");
+    Product_02 : Product_Type (Manufacture => Foreign) := (Foreign,
+                                                           "Product2",
+                                                           2,
+                                                           "Importer02");
+    Product_03 : Product_Type (Foreign) := (Manufacture => Foreign,
+                                            Item        => "Product3",
+                                            ID          => 3,
+                                            Importer    => "Importer03");
+    --
+ 
+    Sale_Count_01 : Integer := 2;
+    Sale_Count_02 : Integer := 0;
+    Sale_Count_03 : Integer := 3;
+ 
+    --
+ 
+    Sale_Rec_01 : Sales_Record_Type (Domestic) := 
+      (Domestic, "Buyer1", False, True);
+    Sale_Rec_02 : Sales_Record_Type (Domestic) := 
+      (Domestic, "Buyer2", True,  False);
+ 
+    Sale_Rec_03 : Sales_Record_Type (Buyer => Foreign) := 
+      (Buyer => Foreign, Name => "Buyer3", Sale_Item => True, 
+       Quantity_Discount => True);
+ 
+    Sale_Rec_04 : Sales_Record_Type (Foreign) := 
+      (Foreign, "Buyer4", True, False);
+    Sale_Rec_05 : Sales_Record_Type (Buyer => Foreign) := (Foreign,
+                                                           "Buyer5",
+                                                           False,
+                                                           False);
+    --
+ 
+                                                        
+    Product_01_Stats : Sales_Statistics_Type := (2,4,8);
+    Product_02_Stats : Sales_Statistics_Type := (Week  =>  0,
+                                                 Month =>  5,
+                                                 Year  => 10);
+    Product_03_Stats : Sales_Statistics_Type := (3, 6, others => 12);
+ 
+ 
+ end FXACA00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxacb00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxacb00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxacb00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxacb00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- FXACB00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation consists of type definitions and object declarations 
+ --      used by tests of Stream_IO functionality.
+ --      These types include an unconstrained array type, and a discriminated 
+ --      record without a default discriminant, specifically chosen for use in 
+ --      demonstrating the capabilities of 'Output and 'Input. 
+ --      
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FXACB00 is
+ 
+    type    Customer_Type          is (Residence, Apartment, Commercial);
+    type    Electric_Usage_Type    is range 0..100000;
+    type    Months_In_Service_Type is range 1..12;
+    type    Quarterly_Period_Type  is (Spring, Summer, Autumn, Winter);
+    subtype Month_In_Quarter_Type  is Positive range 1..3;
+    type    Service_History_Type   is 
+      array (Quarterly_Period_Type range <>, Month_In_Quarter_Type range <>) 
+      of Electric_Usage_Type;
+ 
+ 
+    type Service_Type (Customer : Customer_Type) is
+       record
+          Name       : String (1..21);               
+          Account_ID : Natural range 0..100;
+          case Customer is
+             when Residence | Apartment =>
+                Low_Income_Credit : Boolean := False;
+             when Commercial            =>
+                Baseline_Allowance : Natural range 0..1000;
+                Quantity_Discount  : Boolean := False;
+          end case;
+       end record;
+ 
+ 
+    -- Object Declarations
+ 
+ 
+    Customer1 : Service_Type (Residence) := 
+      (Residence, "1221 Morningstar Lane", 44, False); 
+    Customer2 : Service_Type (Apartment) := (Customer => Apartment,
+                                             Account_ID => 67,
+                                             Name => "15 South Front St. #8",
+                                             Low_Income_Credit => True);
+    Customer3 : Service_Type (Commercial) := (Commercial,
+                                              "12442 Central Avenue ", 
+                                              100, 
+                                              Baseline_Allowance => 938, 
+                                              Quantity_Discount  => True);
+ 
+    --
+ 
+    C1_Months : Months_In_Service_Type := 10;
+    C2_Months : Months_In_Service_Type :=  2;
+    C3_Months : Months_In_Service_Type := 12;
+    
+    --
+ 
+    C1_Service_History : 
+      Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) := 
+        (Spring => (1 => 35, 2 => 39, 3 => 32),
+         Summer => (1 => 34, 2 => 33, 3 => 39),
+         Autumn => (1 => 45, 2 => 40, 3 => 38),
+         Winter => (1 => 53, 2 =>  0, 3 =>  0));
+   
+    C2_Service_History : 
+      Service_History_Type (Quarterly_Period_Type range Spring..Summer, 
+                            Month_In_Quarter_Type) := 
+        (Spring => (23, 22, 0), Summer => (0, 0, 0));
+ 
+    C3_Service_History :
+      Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) := 
+        (others => (others => 200));
+ 
+    --
+ 
+    Total_Customers_In_Service : constant Natural := 3;
+ 
+ end FXACB00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxacc00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxacc00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxacc00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxacc00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- FXACC00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation consists of a tagged type definition and several
+ --      record extensions.  Objects of each type have also been declared 
+ --      and given initial values.
+ --      
+ --      Visual Description of Type Extensions:
+ --      
+ --                         type Ticket_Request
+ --                                  |
+ --                   _______________|_________________
+ --                  |                                 |
+ --                  |                                 |
+ --         type Subscriber_Request             type VIP_Request
+ --                                                    |
+ --                                                    |
+ --                                             type Last_Minute_Request
+ --      
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Ada.Calendar;
+ 
+ package FXACC00 is
+ 
+    type    Location_Type      is (Backstage, Orchestra, Center, Back, Balcony);
+    type    Quantity_Type      is range 1 .. 100;
+    subtype Season_Ticket_Type is Positive range 1 .. 1750;
+    type    VIP_Status_Type    is (Mayor, City_Council, Visitor);
+    type    Donation_Type      is (To_Charity, To_Theatre, Personal);
+ 
+    Show_Of_Appreciation : constant Boolean := True;
+ 
+    type Ticket_Request is tagged
+       record
+          Location          : Location_Type;
+          Number_Of_Tickets : Quantity_Type;
+       end record;
+ 
+ 
+    type Subscriber_Request is new Ticket_Request with
+       record
+          Subscription_Number : Season_Ticket_Type;
+       end record;
+ 
+ 
+    type VIP_Request is new Ticket_Request with
+       record
+          Rank : VIP_Status_Type;
+       end record;
+ 
+ 
+    type Last_Minute_Request (Special_Consideration : Boolean) 
+      is new VIP_Request with
+       record
+          Time_of_Request : Ada.Calendar.Time;
+          case Special_Consideration is
+             when True  => Donation : Donation_Type;
+             when False => null;
+          end case;
+       end record;
+ 
+ 
+    -- Object Declarations.
+ 
+ 
+    Box_Office_Request     : Ticket_Request := 
+                               (Location          => Back, 
+                                Number_Of_Tickets => 2);
+ 
+    Summer_Subscription    : Subscriber_Request := 
+                               (Ticket_Request'(Box_Office_Request) 
+                                with Subscription_Number => 567);  
+ 
+    Mayoral_Ticket_Request : VIP_Request := 
+                               (Location          => Backstage,
+                                Number_Of_Tickets => 6,
+                                Rank              => Mayor);
+                                             
+    Late_Request           : Last_Minute_Request (Show_Of_Appreciation) :=
+                               (Special_Consideration => Show_Of_Appreciation, 
+                                Location              => Orchestra, 
+                                Number_Of_Tickets     => 2, 
+                                Rank                  => City_Council,
+                                Time_Of_Request       => Ada.Calendar.Clock,
+                                Donation              => To_Charity);
+ 
+ 
+ end FXACC00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxc6a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxc6a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxc6a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxc6a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,162 ----
+ -- FXC6A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --     This foundation declares various volatile and non-volatile types. Some
+ --     are by-reference types, and some allow pass-by-copy.
+ --
+ -- CHANGE HISTORY:
+ --      23 Jan 96   SAIC    Initial version for ACVC 2.1.
+ --      02 DEC 97   EDS     Removed Pragma Volatile applied to composite types.
+ --      27 AUG 99   RLB     Repaired so Nonvolatile_Tagged really is
+ --                          Nonvolatile.
+ --!
+ 
+ package FXC6A00 is
+ 
+    type Roman is ('I', 'V', 'X', 'L', 'C', 'D', 'M');  -- By-copy type.
+ 
+    type Acc_Roman is access all Roman;
+ 
+ 
+    type Tagged_Type is tagged record                   -- By-reference type.
+       C: Natural;
+    end record;
+ 
+ 
+    type Volatile_Tagged is new Tagged_Type with record -- Volatile by-reference
+       R1: Roman;                                       -- type.
+    end record;
+    pragma Volatile (Volatile_Tagged);
+ 
+    type Acc_Volatile_Tagged is access all Volatile_Tagged;
+ 
+                                                        -- By-reference type.
+    type NonVolatile_Tagged is new Tagged_Type with record
+       R2: aliased Roman;
+    end record;
+ 
+ 
+    task type Task_Type is                              -- By-reference type.
+       entry Calculate (C: in out Natural);
+    end Task_Type;
+ 
+    type Acc_Task_Type is access all Task_Type;
+ 
+ 
+    protected type Protected_Type is                    -- By-reference type.
+       procedure Op;
+    private
+       Count : Natural := 0;
+    end Protected_Type;
+ 
+ 
+    protected type Volatile_Protected is                -- Volatile by-reference
+       procedure Handler;                               -- type.
+       pragma Interrupt_Handler (Handler);
+ 
+       function Handled return Boolean;
+    private
+       Was_Handled : Boolean := False;
+    end Volatile_Protected;
+    pragma Volatile (Volatile_Protected);
+ 
+    type Acc_Vol_Protected is access all Volatile_Protected;
+ 
+ 
+    type Record_Type is record                          -- Allows pass-by-copy.
+       C: String(1 .. 2);
+    end record;
+ 
+ 
+    type Volatile_Record is limited record              -- Volatile by-reference
+       C: String(1 .. 2);                               -- type.
+    end record;
+    pragma Volatile (Volatile_Record);
+ 
+ 
+    type Composite_Type is record                       -- By-reference type.
+       C: Tagged_Type;
+       D: aliased Volatile_Tagged;                      -- Volatile component.
+    end record;
+ 
+ 
+    type Private_Type is private;                       -- By-reference type.
+ 
+ 
+    type Array_Type is array (1..3) of Tagged_Type;     -- By-reference type.
+    pragma Volatile_Components (Array_Type);
+ 
+    type Acc_Array_Type is access all Array_Type;
+ 
+ 
+    type Lim_Private_Type is limited private;           -- By-copy type.
+ 
+ private
+ 
+    type Private_Type is new Tagged_Type with record
+       D: Character;
+    end record;
+ 
+ 
+    type Lim_Private_Type is new Integer;
+ 
+ end FXC6A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body FXC6A00 is
+ 
+    task body Task_Type is
+    begin
+       accept Calculate (C: in out Natural) do
+          C := C * 10;
+       end Calculate;
+    end Task_Type;
+ 
+ 
+    protected body Protected_Type is
+       procedure Op is
+       begin
+          Count := Count + 1;
+       end Op;
+    end Protected_Type;
+ 
+ 
+    protected body Volatile_Protected is
+       procedure Handler is
+       begin
+          Was_Handled := True;
+       end Handler;
+ 
+       function Handled return Boolean is
+       begin
+          return Was_Handled;
+       end Handled;
+    end Volatile_Protected;
+ 
+ end FXC6A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxe2a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxe2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxe2a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxe2a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- FXE2A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation provides a Declared Pure package, a Shared Passive 
+ --      package, a Remote Types package and a normal, unrestricted package. 
+ --
+ --      It is used by tests checking the interrelationship between the 
+ --      categorized packages
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ --====================================================================
+ 
+ -- This is a DECLARED PURE package
+ --
+ package FXE2A00_0 is
+ 
+    pragma pure (FXE2A00_0);
+ 
+    type Type_From_0 is (Red, Orange, Yellow);
+ 
+ 
+ end FXE2A00_0;
+ 
+ 
+ --====================================================================
+ 
+ -- This is a SHARED_PASSIVE package
+ --
+ package FXE2A00_1 is
+ 
+ 
+    pragma shared_passive (FXE2A00_1);
+    
+    type Type_From_1 is (Blue, Indigo, Violet);
+ 
+ end FXE2A00_1;
+ 
+ 
+ --====================================================================
+ 
+ -- This is a REMOTE TYPES package
+ --
+ package FXE2A00_2 is
+ 
+    pragma Remote_Types (FXE2A00_2);
+ 
+    type Type_From_2 is (Red, Orange, Yellow, Green, Blue, Indigo, Violet); 
+ 
+ end FXE2A00_2;
+ 
+ 
+ --====================================================================
+ 
+ -- This is a NORMAL unrestricted package which has no categorization
+ --
+ package FXE2A00_4 is
+ 
+    type Type_From_4 is (Black, White);
+ 
+ end FXE2A00_4;
+ 
+ --====================================================================
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxf2a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxf2a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxf2a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxf2a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- FXF2A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation declares supporting objects, types and a generic
+ --      function for testing decimal fixed point operations.
+ --
+ --      The generic function contains a loop which steps through two arrays:
+ --      one of binary operations and one of operands. For each iteration, the
+ --      current operation is performed on the current operand and a variable
+ --      "Result" e.g.:
+ --
+ --                   Result := Operation(2)(Operand(3), Result);
+ --
+ --      The result of each operation is cumulated in Result and returned to
+ --      the caller when the loop completes.
+ --
+ -- CHANGE HISTORY:
+ --      12 Mar 96   SAIC    Prerelease version for ACVC 2.1.
+ --
+ --!
+ 
+ package FXF2A00 is
+ 
+    Loop_Count : constant := 30000;             -- # test iterations.
+    Optr_Count : constant :=     6;             -- # operations in op sequence.
+    Opnd_Count : constant :=     5;             -- # different operands.
+ 
+    type Loop_Range is range 1 .. Loop_Count;   -- range 1 .. 30000.
+    type Optr_Range is mod Optr_Count;          -- range 0 .. 5.
+    type Opnd_Range is mod Opnd_Count;          -- range 0 .. 4.
+ 
+ 
+    generic
+ 
+       type Decimal_Fixed is delta <> digits <>;
+ 
+       type Operator_Ptr is access
+         function (L, R : Decimal_Fixed) return Decimal_Fixed;
+ 
+       type Operator_Table is array (Optr_Range) of Operator_Ptr;
+       type Operand_Table  is array (Opnd_Range) of Decimal_Fixed;
+ 
+    function Operations_Loop (Initial : Decimal_Fixed;
+                              Operator: Operator_Table;
+                              Operand : Operand_Table) return Decimal_Fixed;
+ 
+ end FXF2A00;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body FXF2A00 is
+ 
+    function Operations_Loop (Initial : Decimal_Fixed;
+                              Operator: Operator_Table;
+                              Operand : Operand_Table) return Decimal_Fixed is
+ 
+       Result     : Decimal_Fixed := Initial;  -- Cumulator.
+       Optr_Index : Optr_Range := 0;           -- Index into operations table.
+       Opnd_Index : Opnd_Range := 0;           -- Index into operand table.
+ 
+    begin
+       for Count in Loop_Range loop
+          Result     := Operator(Optr_Index) (Result, Operand(Opnd_Index));
+          Optr_Index := Optr_Index + 1;        -- Modular addition.
+          Opnd_Index := Opnd_Index + 1;        -- Modular addition.
+       end loop;
+ 
+       return Result;
+    end Operations_Loop;
+ 
+ end FXF2A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxf3a00.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxf3a00.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/fxf3a00.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/fxf3a00.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,330 ----
+ -- FXF3A00.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      This foundation contains decimal data values, valid and invalid
+ --      Picture strings, and Edited Output result strings that will be used
+ --      in tests of Appendix F.3.
+ --      Note:  In this foundation package, the effect of "Table Driven Data"
+ --      is achieved using a series of arrays to hold the various data items.
+ --      Since the data items (Picture strings, Edited Output) are often of
+ --      different lengths, the arrays are defined to contain pointers to 
+ --      string values, thereby allowing the "tables" to hold string data of
+ --      different sizes.
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Feb 95   SAIC    Picture string, decimal data, and edited_output
+ --                          modifications.
+ --      23 Feb 95   SAIC    Picture string modification.
+ --      10 Mar 95   SAIC    Added explanatory comments.
+ --      15 Nov 95   SAIC    Corrected picture string for ACVC 2.0.1.
+ --      06 Oct 96   SAIC    Corrected invalid picture strings.
+ --      13 Feb 97   PWB.CTA Deleted invalid picture string.
+ --      17 Feb 97   PWB.CTA Added leading blank to two picture strings
+ --!
+ 
+ with Ada.Text_IO.Editing;
+ 
+ package FXF3A00 is
+ 
+    Number_Of_NDP_Items            : constant :=  12; -- No Decimal Places.
+    Number_Of_2DP_Items            : constant :=  20; -- Two Decimal Places.
+    Number_Of_Valid_Strings        : constant :=  40;
+    Number_Of_FF_Strings           : constant :=   4; -- French Francs
+    Number_Of_DM_Strings           : constant :=   5; -- Deutchemarks
+    Number_Of_CHF_Strings          : constant :=   1; -- Swiss Francs
+    Number_Of_Foreign_Strings      : constant :=   Number_Of_FF_Strings +
+                                                   Number_Of_DM_Strings +
+                                                   Number_Of_CHF_Strings; 
+    Number_Of_Invalid_Strings       : constant :=  25;
+    Number_Of_Erroneous_Conditions  : constant :=   3;
+    Number_Of_Edited_Output_Strings : constant :=  32;
+ 
+    -- The following string is to be used as a picture string with length 
+    -- beyond the maximum (Max_Picture_Length) that is supported by the 
+    -- implementation.  
+ 
+    A_Picture_String_Too_Long       : constant 
+      String (1..Ada.Text_IO.Editing.Max_Picture_Length + 1) := (others => '9');
+ 
+ 
+    type Str_Ptr is access String;
+ 
+    type Decimal_Type_NDP is delta 1.0  digits 16;  -- no decimal places
+    type Decimal_Type_2DP is delta 0.01 digits 16;  -- two decimal places
+ 
+    type Data_Array_Type_1 is array (Integer range <>) of Decimal_Type_NDP;
+    type Data_Array_Type_2 is array (Integer range <>) of Decimal_Type_2DP;
+ 
+ 
+    type Picture_String_Array_Type        is 
+      array (Integer range <>) of Str_Ptr;
+ 
+    type Edited_Output_Results_Array_Type is 
+      array (Integer range <>) of Str_Ptr;
+ 
+ 
+ 
+   Data_With_NDP : Data_Array_Type_1 (1..Number_Of_NDP_Items) := 
+                      ( 1 => 1234.0,
+                        2 => 51234.0,
+                        3 => -1234.0,
+                        4 => 1234.0,
+                        5 => 1.0,
+                        6 => 0.0,
+                        7 => -10.0,
+                        8 => -1.0,
+                        9 => 1234.0,
+                       10 => 1.0,
+                       11 => 36.0,
+                       12 => 0.0
+                      );
+ 
+ 
+    Data_With_2DP : Data_Array_Type_2 (1..Number_Of_2DP_Items) := 
+                      ( 1 => 123456.78,
+                        2 => 123456.78,
+                        3 => 0.0,
+                        4 => 0.20,
+                        5 => 123456.00,
+                        6 => -123456.78,
+                        7 => 123456.78,
+                        8 => -12.34,
+                        9 => 1.23,
+                       10 => 12.34,
+ 
+         -- Items 11-20 are used with picture strings in evaluating use of
+         -- foreign currency symbols.
+ 
+                       11 => 123456.78,
+                       12 => 123456.78,
+                       13 => 32.10,
+                       14 => -5432.10,
+                       15 => -1234.57,
+                       16 => 123456.78,
+                       17 => 12.34,
+                       18 => 12.34,
+                       19 => 1.23,
+                       20 => 12345.67
+                      );
+ 
+ 
+ 
+    Valid_Strings   : Picture_String_Array_Type 
+                        (1..Number_Of_Valid_Strings) := 
+ 
+         -- Items 1-10 are used in conjunction with Data_With_2DP values
+         -- to produce edited output strings, as well as in tests of
+         -- function Valid.
+ 
+                        ( 1 => new String'("-###**_***_**9.99"),
+                          2 => new String'("-$**_***_**9.99"),
+                          3 => new String'("-$$$$$$.$$"),
+                          4 => new String'("-$$$$$$.$$"),
+                          5 => new String'("+BBBZZ_ZZZ_ZZZ.ZZ"),
+                          6 => new String'("--_---_---_--9"),
+                          7 => new String'("-$_$$$_$$$_$$9.99"),
+                          8 => new String'("<$$_$$$9.99>"),
+                          9 => new String'("$_$$9.99"),
+                         10 => new String'("$$9.99"),
+ 
+         -- Items 11-22 are used in conjunction with Data_With_NDP values
+         -- to produce edited output strings.
+ 
+                         11 => new String'("ZZZZ9"),
+                         12 => new String'("ZZZZ9"),
+                         13 => new String'("<#Z_ZZ9>"),
+                         14 => new String'("<#Z_ZZ9>"),
+                         15 => new String'("ZZZ.ZZ"),
+                         16 => new String'("ZZZ.ZZ"),
+                         17 => new String'("<###99>"),
+                         18 => new String'("ZZZZZ-"),
+                         19 => new String'("$$$$9"),
+                         20 => new String'("$$$$$"),
+                         21 => new String'("<###99>"),
+                         22 => new String'("$$$$9"),
+ 
+         -- Items 23-40 are used in validation of the Valid, To_Picture, and
+         -- Pic_String subprograms of package Text_IO.Editing, and are not
+         -- used to generate edited output.
+ 
+                         23 => new String'("zZzZzZzZzZzZzZzZzZ"),
+                         24 => new String'("999999999999999999"),
+                         25 => new String'("******************"),
+                         26 => new String'("$$$$$$$$$$$$$$$$$$"),
+                         27 => new String'("9999/9999B9999_999909999"),
+                         28 => new String'("+999999999999999999"),
+                         29 => new String'("-999999999999999999"),
+                         30 => new String'("999999999999999999+"),
+                         31 => new String'("999999999999999999-"),
+                         32 => new String'("<<<_<<<_<<<_<<<_<<<_<<9>"),
+                         33 => new String'("++++++++++++++++++++"),
+                         34 => new String'("--------------------"),
+                         35 => new String'("zZzZzZzZzZzZzZzZzZ.zZ"),
+                         36 => new String'("******************.99"),
+                         37 => new String'("$$$$$$$$$$$$$$$$$$.99"),
+ 
+        -- The following string has length 30, which is the minimum value 
+        -- that must be supported for Max_Picture_Length.
+ 
+                         38 => new String'("9_999_999_999_999_999_999BB.99"),
+                         39 => new String'("<<<_<<<_<<<_<<<.99>"),
+                         40 => new String'("ZZZZZZZZZZZZZZZZZ+")
+                        );
+ 
+ 
+ 
+    Foreign_Strings : Picture_String_Array_Type 
+                        (1..Number_Of_Foreign_Strings) :=
+ 
+        -- These strings are going to be used in conjunction with non-default
+        -- values for Currency string, Radix mark, and Separator in calls to
+        -- Image and Put, as well as in tests of function Valid.
+ 
+                        ( 1 => new String'("-###**_***_**9.99"),    -- FF
+                          2 => new String'("-$**_***_**9.99"),      -- FF
+                          3 => new String'("<###z_ZZ9.99>"),        -- FF
+                          4 => new String'("<###Z_ZZ9.99>"),        -- FF
+                          5 => new String'("<<<<_<<<.<<###>"),      -- DM
+                          6 => new String'("-$_$$$_$$$_$$9.99"),    -- DM
+                          7 => new String'("$z99.99"),              -- DM
+                          8 => new String'("$$$9.99"),              -- DM
+                          9 => new String'("$_$$9.99"),             -- DM
+                         10 => new String'("###_###_##9.99")        -- CHF
+                        );
+ 
+ 
+ 
+    Invalid_Strings : Picture_String_Array_Type 
+                        (1..Number_Of_Invalid_Strings) := 
+        --
+        -- The RM references to the right of these invalid picture strings
+        -- indicates which of the composition constraints of picture strings
+        -- is violated by the particular string (and all following strings
+        -- until another reference is presented).  However, certain strings
+        -- violate multiple of the constraints.
+        --
+                        ( 1 => new String'("<<<"),        
+                          2 => new String'("<<>>"),       
+                          3 => new String'("<<<9_B0/$DB"),
+                          4 => new String'("+BB"),        
+                          5 => new String'("<-"),
+                          6 => new String'("<CR"),
+                          7 => new String'("<db"),
+                          8 => new String'("<<BBBcr"),    
+                          9 => new String'("<<__DB"),
+                         10 => new String'("<<<++++_++-"),
+                         11 => new String'("-999.99>"),   
+                         12 => new String'("+++9.99+"),
+                         13 => new String'("++++>>"),     
+                         14 => new String'("->"),
+                         15 => new String'("++9-"),  
+                         16 => new String'("---999999->"),
+                         17 => new String'("+++-"),       
+                         18 => new String'("+++_+++_+.--"),
+                         19 => new String'("--B.BB+>"),
+                         20 => new String'("$$#$"),       
+                         21 => new String'("#B$$$$"),
+                         22 => new String'("**Z"),        
+                         23 => new String'("ZZZzzz*"),
+                         24 => new String'("9.99DB(2)"), 
+                         25 => new String'(A_Picture_String_Too_Long)
+                        );
+ 
+ 
+    Edited_Output : Edited_Output_Results_Array_Type
+                      (1..Number_Of_Edited_Output_Strings) :=   
+ 
+         -- The following 10 edited output strings result from the first 10
+         -- valid strings when used with the first 10 Data_With_2DP numeric 
+         -- values.
+                            ( 1 => new String'("   $***123,456.78"),
+                              2 => new String'(" $***123,456.78"),
+                              3 => new String'("          "),
+                              4 => new String'("      $.20"),
+                              5 => new String'("+      123,456.00"),
+                              6 => new String'("      -123,457"),
+                              7 => new String'("      $123,456.78"),
+                              8 => new String'("(    $12.34)"),
+                              9 => new String'("   $1.23"),
+                             10 => new String'("$12.34"),
+ 
+         -- The following 10 edited output strings correspond to the 10 foreign
+         -- currency picture strings (the currency string is supplied at the
+         -- time of the call to Editing.Image or Editing.Put), when used in
+         -- conjunction with Data_With_2DP items 11-20
+ 
+                             11 => new String'("  FF***123.456,78"),
+                             12 => new String'(" FF***123.456,78"),
+                             13 => new String'("  FF   32,10 "),
+                             14 => new String'("( FF5.432,10)"), 
+                             15 => new String'("  (1,234.57DM )"),
+                             16 => new String'("      DM123,456.78"), 
+                             17 => new String'("DM 12.34"),
+                             18 => new String'(" DM12.34"),
+                             19 => new String'("   DM1.23"),
+                             20 => new String'("  CHF12,345.67"),
+ 
+         -- The following 12 edited output strings correspond to the 12 
+         -- Data_With_NDP items formatted using Valid_String items 11-22.
+         -- This combination shows decimal data with no decimal places 
+         -- formatted using picture strings.
+ 
+                             21 => new String'(" 1234"),
+                             22 => new String'("51234"),
+                             23 => new String'("($1,234)"),
+                             24 => new String'(" $1,234 "),
+                             25 => new String'("  1.00"),
+                             26 => new String'("      "),
+                             27 => new String'("(  $10)"),
+                             28 => new String'("    1-"),
+                             29 => new String'("$1234"),
+                             30 => new String'("   $1"),
+                             31 => new String'("   $36 "),
+                             32 => new String'("   $0")
+                            );
+ 
+ 
+ 
+    -- The following data is used to create exception situations in tests of
+    -- the Edited Output capabilities of package Ada.Text_IO.Editing.  The data
+    -- are not themselves erroneous, but will produce exceptions based on the
+    -- data/picture string combination used.
+ 
+    Erroneous_Data : Data_Array_Type_2 (1..Number_Of_Erroneous_Conditions) :=
+                      ( 1 => 12.34,
+                        2 => -12.34,
+                        3 => 51234.0
+                      );
+ 
+    Erroneous_Strings : Picture_String_Array_Type 
+                          (1..Number_Of_Erroneous_Conditions) :=
+                            ( 1 => new String'("9.99"),
+                              2 => new String'("99.99"),
+                              3 => new String'("$$$$9")
+                            );
+ 
+ end FXF3A00;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impbit.adb gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impbit.adb
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impbit.adb	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impbit.adb	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,6 ----
+ with System;
+ with Ada.Text_IO;
+ procedure Impbit is
+ begin
+    Ada.Text_IO.Put_Line (System.Address'Size'Img);
+ end Impbit;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdef.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdef.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdef.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdef.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,385 ----
+ -- IMPDEF.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- DESCRIPTION:
+ --     This package provides tailorable entities for a particular
+ --     implementation.  Each entity may be modified to suit the needs
+ --     of the implementation.  Default values are provided to act as
+ --     a guide.
+ --
+ --     The entities in this package are those which are used in at least
+ --     one core test. Entities which are used exclusively in tests for
+ --     annexes C-H are located in annex-specific child units of this package.
+ --
+ -- CHANGE HISTORY:
+ --     12 DEC 93   SAIC    Initial PreRelease version
+ --     02 DEC 94   SAIC    Second  PreRelease version
+ --     16 May 95   SAIC    Added constants specific to tests of the random
+ --                         number generator.
+ --     16 May 95   SAIC    Added Max_RPC_Call_Time constant.
+ --     17 Jul 95   SAIC    Added Non_State_String constant.
+ --     21 Aug 95   SAIC    Created from existing IMPSPEC.ADA and IMPBODY.ADA
+ --                         files.
+ --     30 Oct 95   SAIC    Added external name string constants.
+ --     24 Jan 96   SAIC    Added alignment constants.
+ --     29 Jan 96   SAIC    Moved entities not used in core tests into annex-
+ --                         specific child packages. Adjusted commentary.
+ --                         Renamed Validating_System_Programming_Annex to
+ --                         Validating_Annex_C. Added similar Validating_Annex_?
+ --                         constants for the other non-core annexes (D-H).
+ --     01 Mar 96   SAIC    Added external name string constants.
+ --     21 Mar 96   SAIC    Added external name string constants.
+ --     02 May 96   SAIC    Removed constants for draft test CXA5014, which was
+ --                         removed from the tentative ACVC 2.1 suite.
+ --                         Added constants for use with FXACA00.
+ --     06 Jun 96   SAIC    Added constants for wide character test files.
+ --     11 Dec 96   SAIC    Updated constants for wide character test files.
+ --     13 Dec 96   SAIC    Added Address_Value_IO
+ --     13 Sep 99   RLB     Added more external name string constants.
+ --     16 Sep 99   RLB     Corrected definition of Non_State_String constant.
+ --
+ --!
+ 
+ with Report;
+ with Ada.Text_IO;
+ with System.Storage_Elements;
+ 
+ package ImpDef is
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following boolean constants indicate whether this validation will
+    -- include any of annexes C-H. The values of these booleans affect the
+    -- behavior of the test result reporting software.
+    --
+    --    True  means the associated annex IS included in the validation.
+    --    False means the associated annex is NOT included.
+ 
+    Validating_Annex_C : constant Boolean := True;
+    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
+ 
+    Validating_Annex_D : constant Boolean := True;
+    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
+ 
+    Validating_Annex_E : constant Boolean := True;
+    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
+ 
+    Validating_Annex_F : constant Boolean := True;
+    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
+ 
+    Validating_Annex_G : constant Boolean := True;
+    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
+ 
+    Validating_Annex_H : constant Boolean := True;
+    --                                       ^^^^^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This is the minimum time required to allow another task to get
+    -- control.  It is expected that the task is on the Ready queue.
+    -- A duration of 0.0 would normally be sufficient but some number
+    -- greater than that is expected.
+ 
+    Minimum_Task_Switch : constant Duration := 0.001;
+    --                                         ^^^ --- MODIFY HERE AS NEEDED
+ 
+    -- The above constant has been chosen for use with delay statements in the
+    -- GCC testsuite so that they do not take too long, but may be too small.
+ 
+    Long_Minimum_Task_Switch : constant Duration := 0.1;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This is the time required to activate another task and allow it
+    -- to run to its first accept statement.  We are considering a simple task
+    -- with very few Ada statements before the accept.  An implementation is
+    -- free to specify a delay of several seconds, or even minutes if need be.
+    -- The main effect of specifying a longer delay than necessary will be an
+    -- extension of the time needed to run the associated tests.
+ 
+    Switch_To_New_Task : constant Duration := 0.001;
+    --                                        ^^^ -- MODIFY HERE AS NEEDED
+ 
+    -- The above constant has been chosen for use with delay statements in the
+    -- GCC testsuite so that they do not take too long, but may be too small.
+ 
+    Long_Switch_To_New_Task : constant Duration := 0.1;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This is the time which will clear the queues of other tasks
+    -- waiting to run.  It is expected that this will be about five
+    -- times greater than Switch_To_New_Task.
+ 
+    Clear_Ready_Queue : constant Duration := 0.1;
+    --                                       ^^^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- Some implementations will boot with the time set to 1901/1/1/0.0
+    -- When a delay of Delay_For_Time_Past is given, the implementation
+    -- guarantees that a subsequent call to Ada.Calendar.Time_Of(1901,1,1)
+    -- will yield a time that has already passed (for example, when used in
+    -- a delay_until statement).
+ 
+    Delay_For_Time_Past : constant Duration := 0.001;
+    --                                         ^^^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- Minimum time interval between calls to the time dependent Reset
+    -- procedures in Float_Random and Discrete_Random packages that is
+    -- guaranteed to initiate different sequences.  See RM A.5.2(45).
+ 
+    Time_Dependent_Reset : constant Duration := 0.001;
+    --                                          ^^^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- Test CXA5013 will loop, trying to generate the required sequence
+    -- of random numbers.  If the RNG is faulty, the required sequence
+    -- will never be generated.  Delay_Per_Random_Test is a time-out value
+    -- which allows the test to run for a period of time after which the
+    -- test is failed if the required sequence has not been produced.
+    -- This value should be the time allowed for the test to run before it
+    -- times out.  It should be long enough to allow multiple (independent)
+    -- runs of the testing code, each generating up to 1000 random
+    -- numbers.
+ 
+    Delay_Per_Random_Test : constant Duration := 0.001;
+    --                                           ^^^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The time required to execute this procedure must be greater than the
+    -- time slice unit on implementations which use time slicing.  For
+    -- implementations which do not use time slicing the body can be null.
+ 
+    procedure Exceed_Time_Slice;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This constant must not depict a random number generator state value.
+    -- Using this string in a call to function Value from either the
+    -- Discrete_Random or Float_Random packages will result in
+    -- Constraint_Error or Program_Error (expected result in test CXA5012).
+    -- If there is no such string, set it to "**NONE**".
+ 
+    Non_State_String : constant String := "By No Means A State";
+    --           MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This string constant must be a legal external tag value as used by
+    -- CD10001 for the type Some_Tagged_Type in the representation
+    -- specification for the value of 'External_Tag.
+ 
+    External_Tag_Value : constant String := "implementation_defined";
+    --             MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^^^^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following address constant must be a valid address to locate
+    -- the C program CD30005_1.  It is shown here as a named number;
+    -- the implementation may choose to type the constant as appropriate.
+ 
+    function Cd30005_Proc (X : Integer) return Integer;
+    pragma Import (C, Cd30005_Proc, "_cd30005_1");
+  
+    pragma Linker_Options ("ACATS4GNATDIR/support/cd300051.o");
+  
+    CD30005_1_Foreign_Address : constant System.Address:= Cd30005_Proc'Address;
+  
+    -- CD30005_1_Foreign_Address : constant System.Address:=
+    --          System.Storage_Elements.To_Address ( 16#0000_0000# )
+    --                    MODIFY HERE AS REQUIRED --- ^^^^^^^^^^^^^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following string constant must be the external name resulting
+    -- from the C compilation of CD30005_1.  The string will be used as an
+    -- argument to pragma Import.
+ 
+    CD30005_1_External_Name : constant String := "_cd30005_1";
+    --                  MODIFY HERE AS NEEDED --- ^^^^^^^^^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following constants should represent the largest default alignment
+    -- value and the largest alignment value supported by the linker.
+    -- See RM 13.3(35).
+ 
+    Max_Default_Alignment : constant := Standard'Maximum_Alignment;
+    --                                  ^ --- MODIFY HERE AS NEEDED
+ 
+    Max_Linker_Alignment  : constant := Standard'Maximum_Alignment;
+    --                                  ^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following string constants must be the external names resulting
+    -- from the C compilation of CXB30040.C, CXB30060.C, CXB30130.C, and
+    -- CXB30131.C.  The strings will be used as arguments to pragma Import.
+ 
+    CXB30040_External_Name : constant String := "CXB30040";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB30060_External_Name : constant String := "CXB30060";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB30130_External_Name : constant String := "CXB30130";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB30131_External_Name : constant String := "CXB30131";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following string constants must be the external names resulting
+    -- from the COBOL compilation of CXB40090.CBL, CXB40091.CBL, and
+    -- CXB40092.CBL.  The strings will be used as arguments to pragma Import.
+ 
+    CXB40090_External_Name : constant String := "CXB40090";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB40091_External_Name : constant String := "CXB40091";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB40092_External_Name : constant String := "CXB40092";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following string constants must be the external names resulting
+    -- from the Fortran compilation of CXB50040.FTN, CXB50041.FTN,
+    -- CXB50050.FTN, and CXB50051.FTN.
+    --
+    -- The strings will be used as arguments to pragma Import.
+    --
+    -- Note that the use of these four string constants will be split between
+    -- two tests, CXB5004 and CXB5005.
+ 
+    CXB50040_External_Name : constant String := "CXB50040";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB50041_External_Name : constant String := "CXB50041";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB50050_External_Name : constant String := "CXB50050";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+    CXB50051_External_Name : constant String := "CXB50051";
+    --                 MODIFY HERE AS NEEDED --- ^^^^^^^^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following constants have been defined for use with the
+    -- representation clause in FXACA00 of type Sales_Record_Type.
+    --
+    -- Char_Bits should be an integer at least as large as the number
+    -- of bits needed to hold a character in an array.
+    -- A value of 6 * Char_Bits will be used in a representation clause
+    -- to reserve space for a six character string.
+    --
+    -- Next_Storage_Slot should indicate the next storage unit in the record
+    -- representation clause that does not overlap the storage designated for
+    -- the six character string.
+ 
+    Char_Bits         : constant := 8;
+    --     MODIFY HERE AS NEEDED ---^
+ 
+    Next_Storage_Slot : constant := 6;
+    --     MODIFY HERE AS NEEDED ---^
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following string constant must be the path name for the .AW
+    -- files that will be processed by the Wide Character processor to
+    -- create the C250001 and C250002 tests.  The Wide Character processor
+    -- will expect to find the files to process at this location.
+ 
+    Test_Path_Root : constant String :=
+      "ACATS4GNATDIR/tests/c2/";
+    -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ --- MODIFY HERE AS NEEDED
+ 
+    -- The following two strings must not be modified unless the .AW file
+    -- names have been changed.  The Wide Character processor will use
+    -- these strings to find the .AW files used in creating the C250001
+    -- and C250002 tests.
+ 
+   Wide_Character_Test : constant String := Test_Path_Root & "c250001";
+   Upper_Latin_Test    : constant String := Test_Path_Root & "c250002";
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following instance of Integer_IO or Modular_IO must be supplied
+    -- in order for test CD72A02 to compile correctly.
+    -- Depending on the choice of base type used for the type
+    -- System.Storage_Elements.Integer_Address; one of the two instances will
+    -- be correct.  Comment out the incorrect instance.
+ 
+    -- package Address_Value_IO is
+    --     new Ada.Text_IO.Integer_IO(System.Storage_Elements.Integer_Address);
+ 
+    package Address_Value_IO is
+         new Ada.Text_IO.Modular_IO(System.Storage_Elements.Integer_Address);
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The following constants have been defined for use with various delay
+    -- statements in the GCC testsuite so that they do not take too long.
+ 
+    One_Second : constant Duration := 0.001;
+    One_Long_Second : constant Duration := 0.1;
+ 
+ end ImpDef;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body ImpDef is
+ 
+    -- NOTE: These are example bodies.  It is expected that implementors
+    --       will write their own versions of these routines.
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The time required to execute this procedure must be greater than the
+    -- time slice unit on implementations which use time slicing.  For
+    -- implementations which do not use time slicing the body can be null.
+ 
+    Procedure Exceed_Time_Slice is
+       T : Integer := 0;
+       Loop_Max : constant Integer := 4_000;
+    begin
+       for I in 1..Loop_Max loop
+          T := Report.Ident_Int (1) * Report.Ident_Int (2);
+       end loop;
+    end Exceed_Time_Slice;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+ end ImpDef;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefc.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefc.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefc.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefc.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,140 ----
+ -- IMPDEFC.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- DESCRIPTION:
+ --     This package provides tailorable entities for a particular
+ --     implementation.  Each entity may be modified to suit the needs
+ --     of the implementation.  Default values are provided to act as
+ --     a guide.
+ --
+ --     The entities in this package are those which are used exclusively
+ --     in tests for Annex C (Systems Programming).
+ -- 
+ -- APPLICABILITY CRITERIA:
+ --     This package is only required for implementations validating the
+ --     Systems Programming Annex.
+ -- 
+ -- CHANGE HISTORY:
+ --     29 Jan 96   SAIC    Initial version for ACVC 2.1.
+ --
+ --!
+  
+ with Ada.Interrupts.Names;
+ 
+ package ImpDef.Annex_C is
+  
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- Interrupt_To_Generate should identify a non-reserved interrupt
+    -- that can be predictably generated within a reasonable time interval
+    -- (as specified by the constant Wait_For_Interrupt) during testing.
+ 
+    Interrupt_To_Generate: constant Ada.Interrupts.Interrupt_ID :=
+       Ada.Interrupts.Interrupt_ID'First;  -- to allow trivial compilation
+    -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  --- MODIFY HERE AS NEEDED
+    
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+  
+    -- Wait_For_Interrupt should specify the reasonable time interval during
+    -- which the interrupt identified by Interrupt_To_Generate can be
+    -- expected to be generated.
+ 
+    Wait_For_Interrupt : constant := 10.0;
+    --                               ^^^^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The procedure Enable_Interrupts should enable interrupts, if this
+    -- is required by the implementation. [See additional notes on this
+    -- procedure in the package body.]
+ 
+    procedure Enable_Interrupts;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The procedure Generate_Interrupt should generate the interrupt
+    -- identified by Interrupt_To_Generate within the time interval
+    -- specified by Wait_For_Interrupt. [See additional notes on this
+    -- procedure in the package body.]
+ 
+    procedure Generate_Interrupt;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+ end ImpDef.Annex_C;
+ 
+ 
+      --==================================================================--
+ 
+  
+ package body ImpDef.Annex_C is
+  
+    -- NOTE: These are example bodies.  It is expected that implementors
+    --       will write their own versions of these routines.
+  
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The procedure Enable_Interrupts should enable interrupts, if this
+    -- is required by the implementation.
+    --
+    -- The default body is null, since it is expected that most implementations
+    -- will not need to perform this step.
+    --
+    -- Note that Enable_Interrupts will be called only once per test.
+ 
+    procedure Enable_Interrupts is
+    begin
+       null;
+ 
+    -- ^^^^^^^^^^^^^^^^^^^^  MODIFY THIS BODY AS NEEDED  ^^^^^^^^^^^^^^^^^^^^
+ 
+    end Enable_Interrupts;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The procedure Generate_Interrupt should generate the interrupt
+    -- identified by Interrupt_To_Generate within the time interval
+    -- specified by Wait_For_Interrupt.
+    --
+    -- The default body assumes that an interrupt will be generated by some
+    -- physical act during testing. While this approach is acceptable, the
+    -- interrupt should ideally be generated by appropriate code in the
+    -- procedure body.
+    --
+    -- Note that Generate_Interrupt may be called multiple times by a single
+    -- test. The code used to implement this procedure should account for this
+    -- possibility.
+ 
+    procedure Generate_Interrupt is
+    begin
+       Report.Comment (". >>>>> GENERATE THE INTERRUPT NOW <<<<< ");
+ 
+    -- ^^^^^^^^^^^^^^^^^^^^  MODIFY THIS BODY AS NEEDED  ^^^^^^^^^^^^^^^^^^^^
+ 
+    end Generate_Interrupt;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+ end ImpDef.Annex_C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefd.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefd.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefd.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefd.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- IMPDEFD.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- DESCRIPTION:
+ --     This package provides tailorable entities for a particular
+ --     implementation.  Each entity may be modified to suit the needs
+ --     of the implementation.  Default values are provided to act as
+ --     a guide.
+ --
+ --     The entities in this package are those which are used exclusively
+ --     in tests for Annex D (Real-Time Systems).
+ -- 
+ -- APPLICABILITY CRITERIA:
+ --     This package is only required for implementations validating the
+ --     Real-Time Systems Annex.
+ -- 
+ -- CHANGE HISTORY:
+ --     29 Jan 96   SAIC    Initial version for ACVC 2.1.
+ --     27 Aug 98   EDS     Removed Processor_Type value Time_Slice
+ --!
+  
+ package ImpDef.Annex_D is
+  
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This constant is the maximum storage size that can be specified
+    -- for a task.  A single task that has this size must be able to
+    -- run.  Ideally, this value is large enough that two tasks of this
+    -- size cannot run at the same time.  If the value is too small then
+    -- test CXDC001 may take longer to run.  See the test for further
+    -- information.
+ 
+    Maximum_Task_Storage_Size : constant := 16_000_000;
+    --                                      ^^^^^^^^^^ --- MODIFY HERE AS NEEDED
+    
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- Indicates the type of processor on which the tests are running.
+ 
+    type Processor_Type is (Uni_Processor, Multi_Processor);
+ 
+    Processor : constant Processor_Type := Uni_Processor;
+    --                                     ^^^^^^^^^^^ --- MODIFY HERE AS NEEDED
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+ end ImpDef.Annex_D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefe.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefe.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefe.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefe.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,58 ----
+ -- IMPDEFE.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- DESCRIPTION:
+ --     This package provides tailorable entities for a particular
+ --     implementation.  Each entity may be modified to suit the needs
+ --     of the implementation.  Default values are provided to act as
+ --     a guide.
+ --
+ --     The entities in this package are those which are used exclusively
+ --     in tests for Annex E (Distributed Systems).
+ -- 
+ -- APPLICABILITY CRITERIA:
+ --     This package is only required for implementations validating the
+ --     Distributed Systems Annex.
+ -- 
+ -- CHANGE HISTORY:
+ --     29 Jan 96   SAIC    Initial version for ACVC 2.1.
+ --
+ --!
+  
+ package ImpDef.Annex_E is
+  
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- The Max_RPC_Call_Time value is the longest time a test needs to wait for
+    -- an RPC to complete.  Included in this time is the time for the called
+    -- procedure to make a task entry call where the task is ready to accept
+    -- the call.
+ 
+    Max_RPC_Call_Time : constant Duration := 2.0;
+    --                                       ^^^  --- MODIFY HERE AS NEEDED
+  
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+ end ImpDef.Annex_E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefg.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefg.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefg.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefg.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- IMPDEFG.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- DESCRIPTION:
+ --     This package provides tailorable entities for a particular
+ --     implementation.  Each entity may be modified to suit the needs
+ --     of the implementation.  Default values are provided to act as
+ --     a guide.
+ --
+ --     The entities in this package are those which are used exclusively
+ --     in tests for Annex G (Numerics).
+ -- 
+ -- APPLICABILITY CRITERIA:
+ --     This package is only required for implementations validating the
+ --     Numerics Annex.
+ -- 
+ -- CHANGE HISTORY:
+ --     29 Jan 96   SAIC    Initial version for ACVC 2.1.
+ --
+ --!
+  
+ package ImpDef.Annex_G is
+  
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This function must return a "negative zero" value for implementations
+    -- for which Float'Signed_Zeros is True.
+ 
+    function Negative_Zero return Float;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+ end ImpDef.Annex_G;
+ 
+ 
+      --==================================================================--
+ 
+  
+ package body ImpDef.Annex_G is
+ 
+    -- NOTE: These are example bodies.  It is expected that implementors
+    --       will write their own versions of these routines.
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+    -- This function must return a negative zero value for implementations
+    -- for which Float'Signed_Zeros is True.
+    --
+    -- The default body simply returns a negated literal 0.0.  If the
+    -- default body does not return the value corresponding to a negatively
+    -- signed zero for the implementation under test, it must be replaced
+    -- by one which does.  See RM A.5.3(13).
+ 
+    function Negative_Zero return Float is
+    begin
+       return -0.0;      -- Note: If this value is not negative zero for the
+                         --       implementation, use of this "default" value
+                         --       could result in false failures in
+                         --       implementations where Float'Signed_Zeros
+                         --       is True.
+ 
+    -- ^^^^^^^^^^^^^^^^^^^^  MODIFY THIS BODY AS NEEDED  ^^^^^^^^^^^^^^^^^^^^
+ 
+    end Negative_Zero;
+ 
+ --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+ 
+ end ImpDef.Annex_G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefh.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefh.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/impdefh.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/impdefh.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- IMPDEFH.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- DESCRIPTION:
+ --      This package is used to define those values that are implementation
+ --      defined for use with validating the Safety and Security special needs
+ --      annex, Annex-H.
+ --
+ -- APPLICABILITY CRITERIA:
+ --     This package is only required for implementations validating the
+ --     Safety and Security Annex.
+ --
+ -- CHANGE HISTORY:
+ --      13 FEB 96   SAIC    Initial version
+ --      25 NOV 96   SAIC    Revised for release 2.1
+ --
+ --!
+ 
+ package Impdef.Annex_H is
+ 
+   type Scalar_To_Normalize is
+        (   Id0,  Id1,  Id2,  Id3,  Id4,  Id5,  Id6,  Id7,  Id8,  Id9,
+           Id10, Id11, Id12, Id13, Id14, Id15, Id16, Id17, Id18, Id19,
+           Id20, Id21, Id22, Id23, Id24, Id25, Id26, Id27, Id28, Id29,
+           Id30, Id31, Id32, Id33, Id34, Id35, Id36, Id37, Id38, Id39,
+           Id40, Id41, Id42, Id43, Id44, Id45, Id46, Id47, Id48, Id49,
+           Id50, Id51, Id52, Id53, Id54, Id55, Id56, Id57, Id58, Id59,
+           Id60, Id61, Id62, Id63, Id64, Id65, Id66, Id67, Id68, Id69,
+           Id70, Id71, Id72, Id73, Id74, Id75, Id76, Id77, Id78, Id79,
+           Id80, Id81, Id82, Id83, Id84, Id85, Id86, Id87, Id88, Id89,
+           Id90, Id91, Id92, Id93, Id94, Id95, Id96, Id97, Id98, Id99,
+           IdA0, IdA1, IdA2, IdA3, IdA4, IdA5, IdA6, IdA7, IdA8, IdA9,
+           IdB0, IdB1, IdB2, IdB3, IdB4, IdB5, IdB6 );
+ 
+   -- NO MODIFICATION NEEDED TO TYPE SCALAR_TO_NORMALIZE.  DO NOT MODIFY.
+ 
+   type Small_Number is range 1..100;
+ 
+   -- NO MODIFICATION NEEDED TO TYPE SMALL_NUMBER.  DO NOT MODIFY.
+ 
+ --=====================================================================
+   -- When the value documented in H.1(5) as the predictable initial value
+   -- for an uninitialized object of the type Scalar_To_Normalize
+   -- (an enumeration type containing 127 identifiers) is to be in the range
+   -- Id0..IdB6, set the following constant to True; otherwise leave it set
+   -- to False.
+ 
+   Default_For_Scalar_To_Normalize_Is_In_Range : constant Boolean := False;
+   --                                      MODIFY HERE AS NEEDED --- ^^^^^
+ 
+ --=====================================================================
+   -- If the above constant Default_For_Scalar_To_Normalize_Is_In_Range is
+   -- set True, the following constant must be set to the value documented
+   -- in H.1(5) as the predictable initial value for the type
+   -- Scalar_To_Normalize.
+ 
+   Default_For_Scalar_To_Normalize : constant Scalar_To_Normalize := Id0;
+   --                                      MODIFY HERE AS NEEDED --- ^^^
+ 
+ --=====================================================================
+   -- When the value documented in H.1(5) as the predictable initial value
+   -- for an uninitialized object of the type Small_Number
+   -- (an integer type containing 100 values) is to be in the range
+   -- 1..100, set the following constant to True; otherwise leave it set
+   -- to False.
+ 
+   Default_For_Small_Number_Is_In_Range : constant Boolean := False;
+   --                               MODIFY HERE AS NEEDED --- ^^^^^
+ 
+ --=====================================================================
+   -- If the above constant Default_For_Small_Number_Is_In_Range is
+   -- set True, the following constant must be set to the value documented
+   -- in H.1(5) as the predictable initial value for the type Small_Number.
+ 
+   Default_For_Small_Number : constant Small_Number := 100;
+   --                        MODIFY HERE AS NEEDED --- ^^^
+ 
+ --=====================================================================
+ 
+ end Impdef.Annex_H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/lencheck.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/lencheck.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/lencheck.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/lencheck.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE 
+ -- ACVC CHAPTER 13 C TESTS. IT IS INSTANTIATED FOR A TYPE WHOSE 
+ -- REPRESENTATION IS TO BE CHECKED, AND THEN THE PROCEDURE REP_CHECK 
+ -- IS CALLED WITH TWO ARGUMENTS, THE FIRST IS A VALUE OF THE TYPE TO 
+ -- BE CHECKED, AND THE SECOND IS A STRING DESCRIBING OR NAMING THE 
+ -- TYPE (FOR USE IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS)
+ 
+ -- THE CHECK IS TO CONVERT THE VALUE TO A PACKED BOOLEAN ARRAY WITH A 
+ -- LENGTH CORRESPONDING TO THE 'SIZE OF THE TYPE, AND THEN CONVERT IT 
+ -- BACK AGAIN AND CHECK THAT THE SAME VALUE IS OBTAINED. THE 
+ -- CONVERSIONS ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF 
+ -- UNCHECKED_CONVERSION.
+ 
+ -- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE 
+ --                             AUTHORIZED
+ -- DHH 03/27/89 CHANGED REP_CHECK TO LENGTH_CHECK BY ADDING A THIRD
+ --              PARAMETER TO GIVE LENGTH EXPECTED AND BY DOING A BIT TO
+ --              BIT COPY OF THE UNCHECKED CONVERSION BOOLEAN ARRAY SO 
+ --              A STRAIGHT COMPARE OF THE TWO VALUES CAN BE DONE.
+ 
+ GENERIC
+ 
+    TYPE TEST_TYPE IS PRIVATE;
+ 
+ PROCEDURE LENGTH_CHECK (TEST_VALUE      : TEST_TYPE; 
+                         EXPECTED_LENGTH : INTEGER;
+                         TYPE_ID         : STRING);
+ 
+ WITH UNCHECKED_CONVERSION;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE LENGTH_CHECK (TEST_VALUE      : TEST_TYPE; 
+                         EXPECTED_LENGTH : INTEGER;
+                         TYPE_ID         : STRING) IS
+    LEN : CONSTANT INTEGER := EXPECTED_LENGTH;
+    TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. LEN) OF BOOLEAN;
+    PRAGMA PACK (BIT_ARRAY_TYPE);
+    TYPE NEW_BIT_ARRAY_TYPE IS ARRAY (1 .. 3) OF BIT_ARRAY_TYPE;
+ 
+    FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (TEST_TYPE,
+                                                  BIT_ARRAY_TYPE);
+    FUNCTION FROM_BITS IS NEW UNCHECKED_CONVERSION (BIT_ARRAY_TYPE,
+                                                    TEST_TYPE);
+ 
+    BIT_ARRAY : BIT_ARRAY_TYPE := (OTHERS => FALSE);
+ 
+    BIT_ARRAY_NEW : NEW_BIT_ARRAY_TYPE := (OTHERS => (OTHERS => FALSE));
+ BEGIN
+ 
+    BIT_ARRAY := TO_BITS (TEST_VALUE);
+ 
+    FOR I IN 1 .. LEN LOOP
+         BIT_ARRAY_NEW(IDENT_INT(1)) (IDENT_INT(I)) := BIT_ARRAY(I);
+    END LOOP;
+ 
+    IF TEST_VALUE /= FROM_BITS (BIT_ARRAY_NEW(1)) THEN
+       FAILED ("CHECK ON REPRESENTATION FOR " & TYPE_ID & " FAILED.");
+    END IF;
+ 
+ END LENGTH_CHECK;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/macro.dfs gcc-16-20250525/gcc/testsuite/ada/acats-2/support/macro.dfs
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/macro.dfs	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/macro.dfs	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,300 ----
+ -- MACRO.DFS
+ -- THIS FILE CONTAINS THE MACRO DEFINITIONS USED IN THE ACVC TESTS.
+ -- THESE DEFINITIONS ARE USED BY THE ACVC TEST PRE-PROCESSOR,
+ -- MACROSUB. MACROSUB WILL CALCULATE VALUES FOR THOSE MACRO SYMBOLS 
+ -- WHOSE DEFINITIONS DEPEND ON THE VALUE OF MAX_IN_LEN (NAMELY, THE
+ -- VALUES OF THE MACRO SYMBOLS BIG_ID1, BIG_ID2, BIG_ID3, BIG_ID4,
+ -- BIG_STRING1, BIG_STRING2, MAX_STRING_LITERAL, BIG_INT_LIT, BIG_REAL_LIT, 
+ -- AND BLANKS).  THEREFORE, ANY VALUES GIVEN IN THIS FILE FOR THOSE
+ -- MACRO SYMBOLS WILL BE IGNORED BY MACROSUB.  
+ 
+ -- NOTE: AS REQUIRED BY THE MACROSUB PROGRAM, THE FIRST MACRO DEFINED
+ -- IN THIS FILE IS $MAX_IN_LEN.  THE NEXT 5 MACRO DEFINITIONS
+ -- ARE FOR THOSE MACRO SYMBOLS THAT DEPEND ON THE VALUE OF
+ -- MAX_IN_LEN.  THESE ARE IN ALPHABETIC ORDER.  FOLLOWING THESE
+ -- ARE 36 MORE DEFINITIONS, ALSO IN ALPHABETIC ORDER.
+ 
+ -- EACH DEFINITION IS ACCORDING TO THE FOLLOWING FORMAT:
+ 
+ -- A. A NUMBER OF LINES PRECEDED BY THE ADA COMMENT DELIMITER, --.
+ --    THE FIRST OF THESE LINES CONTAINS THE MACRO SYMBOL AS IT APPEARS
+ --    IN THE TEST FILES (WITH THE DOLLAR SIGN).  THE NEXT FEW "COMMENT"
+ --    LINES CONTAIN A DESCRIPTION OF THE VALUE TO BE SUBSTITUTED.
+ --    THE REMAINING "COMMENT" LINES, THE FIRST OF WHICH BEGINS WITH THE
+ --    WORDS "USED IN:  " (NO QUOTES), CONTAIN A LIST OF THE TEST FILES
+ --    (WITHOUT THE .TST EXTENSION) IN WHICH THE MACRO SYMBOL APPEARS.
+ --    EACH TEST FILE NAME IS PRECEDED BY ONE OR MORE BLANKS.
+ -- B. A LINE, WITHOUT THE COMMENT DELIMITER, CONSISTING OF THE 
+ --    IDENTIFIER (WITHOUT THE DOLLAR SIGN) OF THE MACRO SYMBOL,
+ --    FOLLOWED BY A SPACE OR TAB, FOLLOWED BY THE VALUE TO BE
+ --    SUBSTITUTED.  IN THE DISTRIBUTION FILE, A SAMPLE VALUE IS
+ --    PROVIDED; THIS VALUE MUST BE REPLACED BY A VALUE APPROPRIATE TO
+ --    THE IMPLEMENTATION.
+ 
+ -- DEFINITIONS ARE SEPARATED BY ONE OR MORE EMPTY LINES.
+ -- THE LIST OF DEFINITIONS BEGINS AFTER THE FOLLOWING EMPTY LINE.
+ 
+ -- $MAX_IN_LEN                                                          
+ -- AN INTEGER LITERAL GIVING THE MAXIMUM LENGTH PERMITTED BY THE   
+ -- COMPILER FOR A LINE OF ADA SOURCE CODE (NOT INCLUDING AN END-OF-LINE
+ -- CHARACTER).                                             
+ -- USED IN:  A26007A                          
+ MAX_IN_LEN                200            
+ 					
+ -- $MAX_STRING_LITERAL
+ -- A STRING LITERAL CONSISTING OF $MAX_IN_LEN CHARACTERS (INCLUDING THE
+ -- QUOTE CHARACTERS).
+ -- USED IN:  A26007A
+ MAX_STRING_LITERAL	"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+ 
+ -- $BIG_ID1                                      
+ -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN. 
+ -- THE MACROSUB PROGRAM WILL SUPPLY AN IDENTIFIER IN WHICH THE   
+ -- LAST CHARACTER IS '1' AND ALL OTHERS ARE 'A'.       
+ -- USED IN:  C23003A  C23003B  C23003G  C23003I
+ --           C35502D  C35502F
+ BIG_ID1  AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA1
+ 						
+ -- $BIG_ID2                                        
+ -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
+ -- DIFFERING FROM $BIG_ID1 ONLY IN THE LAST CHARACTER.  THE MACROSUB
+ -- PROGRAM WILL USE '2' AS THE LAST CHARACTER.         
+ -- USED IN:  C23003A  C23003B  B23003F  C23003G  C23003I   
+ BIG_ID2  AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2
+ 
+ -- $BIG_ID3                                                
+ -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN.
+ -- MACROSUB WILL USE '3' AS THE "MIDDLE" CHARACTER; ALL OTHERS ARE 'A'.
+ -- USED IN:  C23003A  C23003B  C23003G  C23003I
+ BIG_ID3  AAAAAAAAAAAAAAAAAAAAAAAAAAAAA3AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ 
+ -- $BIG_ID4                                            
+ -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
+ -- DIFFERING FROM $BIG_ID3 ONLY IN THE MIDDLE CHARACTER.  MACROSUB
+ -- WILL USE '4' AS THE MIDDLE CHARACTER.                      
+ -- USED IN:  C23003A  C23003B  C23003G  C23003I
+ BIG_ID4  AAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ 							
+ -- $BIG_STRING1                                                
+ -- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING2
+ -- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
+ -- USED IN:  C35502D  C35502F              
+ BIG_STRING1  "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"            
+ 							
+ -- $BIG_STRING2                                            
+ -- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING1
+ -- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
+ -- USED IN:  C35502D  C35502F                              
+ BIG_STRING2  "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA1"                
+ 
+ -- $BLANKS                                                   
+ -- A SEQUENCE OF ($MAX_IN_LEN - 20) BLANKS.            
+ -- USED IN:  B22001A  B22001B  B22001C  B22001D  B22001E  B22001F
+ --           B22001G  B22001I  B22001J  B22001K  B22001L  B22001M 
+ --           B22001N                                             
+ --      <       LIMITS OF SAMPLE SHOWN BY ANGLE BRACKETS           >
+ BLANKS                                                      
+ 								
+ -- $ACC_SIZE                                                
+ -- AN INTEGER LITERAL WHOSE VALUE IS THE MINIMUM NUMBER OF BITS
+ -- SUFFICIENT TO HOLD ANY VALUE OF AN ACCESS TYPE.         
+ -- USED IN:  CD2A83C  BD2A02A
+ ACC_SIZE                  ACATS4GNATBIT
+ 			
+ -- $ALIGNMENT                                    
+ -- A VALUE THAT IS LEGITIMATE FOR USE IN A RECORD ALIGNMENT CLAUSE.
+ -- USED IN:  CD4041A BD4006A                                 
+ ALIGNMENT 4                                 
+ 
+ -- $COUNT_LAST                                     
+ -- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.COUNT'LAST. 
+ -- USED IN:  CE3002B                                
+ COUNT_LAST                2147483647                  
+ 			
+ -- $ENTRY_ADDRESS                                     
+ -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY 
+ -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.   
+ -- USED IN:  SPPRT13SP                                
+ ENTRY_ADDRESS  ENTRY_ADDR                      
+ 
+ -- $ENTRY_ADDRESS1                            
+ -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
+ -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.  THE ADDRESS
+ -- MUST BE DISTINCT FROM THAT USED IN $ENTRY_ADDRESS.       
+ -- USED IN:  SPPRT13SP                                   
+ ENTRY_ADDRESS1  ENTRY_ADDR1                   
+ 			
+ -- $ENTRY_ADDRESS2                      
+ -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY 
+ -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.  THE ADDRESS
+ -- MUST BE DISTINCT FROM THOSE USED IN $ENTRY_ADDRESS      
+ -- AND $ENTRY_ADDRESS1.                         
+ -- USED IN:  SPPRT13SP                  
+ ENTRY_ADDRESS2  ENTRY_ADDR2            
+ 			
+ -- $FIELD_LAST                            
+ -- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.FIELD'LAST. 
+ -- USED IN:  CE3002C                            
+ FIELD_LAST                255               
+ 					
+ -- $FORM_STRING                           
+ -- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE MEETS BOTH
+ -- CONDITIONS: (1) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
+ -- AN APPROPRIATE LINE-LENGTH FOR THE FILE, (2) THERE IS A VALUE 
+ -- OF TYPE TEXT_IO.COUNT THAT IS NOT AN APPROPRIATE PAGE-LENGTH 
+ -- FOR THE FILE.                   
+ -- IF IT IS NOT POSSIBLE TO SATISFY BOTH CONDITIONS, THEN SUBSTITUTE
+ -- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE SATISFIES ONE
+ -- OF THE CONDITIONS.  IF IT IS NOT POSSIBLE TO SATISFY EITHER CONDITION,
+ -- THEN SUBSTITUTE THE NULL STRING ("").     
+ -- USED IN:  CE3304A                 
+ FORM_STRING               ""           
+ 							
+ -- $FORM_STRING2                              
+ -- A STRING LITERAL SPECIFYING THAT THE CAPACITY OF THE FILE IS
+ -- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION 
+ -- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL 
+ -- "CANNOT_RESTRICT_FILE_CAPACITY".                          
+ -- USED IN:  CE2203A  CE2403A                 
+ FORM_STRING2              "CANNOT_RESTRICT_FILE_CAPACITY" 
+ 					
+ -- $GREATER_THAN_DURATION              
+ -- A REAL LITERAL WHOSE VALUE (NOT SUBJECT TO ROUND-OFF ERROR 
+ -- IF POSSIBLE) LIES BETWEEN DURATION'BASE'LAST AND DURATION'LAST.  IF
+ -- NO SUCH VALUES EXIST, USE A VALUE IN DURATION'RANGE.  
+ -- USED IN:  C96005B                                 
+ GREATER_THAN_DURATION     86_000.0         
+ 	
+ 							
+ 						
+ 
+ -- $ILLEGAL_EXTERNAL_FILE_NAME1             
+ -- AN ILLEGAL EXTERNAL FILE NAME (E.G., TOO LONG, CONTAINING INVALID
+ -- CHARACTERS, CONTAINING WILD-CARD CHARACTERS, OR SPECIFYING A 
+ -- NONEXISTENT DIRECTORY).                             
+ -- USED IN:  CE2102C  CE2102H  CE2103A  CE2103B  CE3102B  CE3107A
+ ILLEGAL_EXTERNAL_FILE_NAME1       /NODIRECTORY/FILENAME
+ 	
+ -- $ILLEGAL_EXTERNAL_FILE_NAME2                  
+ -- AN ILLEGAL EXTERNAL FILE NAME, DIFFERENT FROM $ILLEGAL_EXTERNAL_FILE_NAME1.
+ -- USED IN:  CE2102C  CE2102H  CE2103A  CE2103B  CE3102B    
+ ILLEGAL_EXTERNAL_FILE_NAME2       /@@/@@/@@\@@\@@\@@
+ 							
+ -- $INAPPROPRIATE_LINE_LENGTH                      
+ -- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH 
+ -- FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
+ -- USED IN:  CE3304A                                 
+ INAPPROPRIATE_LINE_LENGTH -1                     
+ 							
+ -- $INAPPROPRIATE_PAGE_LENGTH                    
+ -- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH
+ -- FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
+ -- USED IN:  CE3304A                              
+ INAPPROPRIATE_PAGE_LENGTH -1              
+ 
+ -- $INTEGER_FIRST                            
+ -- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS INTEGER'FIRST.
+ -- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
+ -- BLANKS.                        
+ -- USED IN:  C35503F  B54B01B                  
+ INTEGER_FIRST             -2147483648      
+ 			
+ -- $INTEGER_LAST                             
+ -- AN INTEGER LITERAL WHOSE VALUE IS INTEGER'LAST.  THE LITERAL MUST
+ -- NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING BLANKS. 
+ -- USED IN:  C35503F  B54B01B         
+ INTEGER_LAST              2147483647                 
+ 
+ 
+ -- $LESS_THAN_DURATION                
+ -- A REAL LITERAL (WITH SIGN) WHOSE VALUE (NOT SUBJECT TO
+ -- ROUND-OFF ERROR IF POSSIBLE) LIES BETWEEN DURATION'BASE'FIRST AND
+ -- DURATION'FIRST.  IF NO SUCH VALUES EXIST, USE A VALUE IN
+ -- DURATION'RANGE.                                 
+ -- USED IN:  C96005B                           
+ LESS_THAN_DURATION        -86_400.0      
+ 
+ 	
+ -- $MACHINE_CODE_STATEMENT       
+ -- A VALID MACHINE CODE STATEMENT AS SPECIFIED IN THE PACKAGE 
+ -- MACHINE_CODE.  IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE
+ -- CODE THEN USE THE ADA NULL STATEMENT (I.E. NULL; ).   
+ -- USED IN:  AD8011A  BD8001A  BD8002A  BD8004A  BD8004B
+ MACHINE_CODE_STATEMENT     Asm_Insn'(Asm ("ACATS4GNATINSN"));       
+ 						
+ -- $MAX_INT                                     
+ -- AN INTEGER LITERAL WHOSE VALUE IS SYSTEM.MAX_INT.
+ -- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
+ -- BLANKS.                                                      
+ -- USED IN:  C35503D  C35503F  C4A007A 
+ MAX_INT                  ACATS4GNATMAXINT
+ 
+ 					
+ -- $MIN_INT                                     
+ -- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS SYSTEM.MIN_INT.
+ -- THE LITERAL MUST NOT CONTAIN UNDERSCORES OR LEADING OR TRAILING
+ -- BLANKS.                                                    
+ -- USED IN:  C35503D  C35503F  
+ MIN_INT                  ACATS4GNATMININT
+ 						
+ -- $NAME                                               
+ -- THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN INTEGER,
+ -- SHORT_INTEGER, OR LONG_INTEGER.                          
+ -- (IMPLEMENTATIONS WHICH HAVE NO SUCH TYPES SHOULD USE AN UNDEFINED
+ -- IDENTIFIER SUCH AS   NO_SUCH_TYPE_AVAILABLE.)                  
+ -- USED IN:  C45231D  CD7101G  
+ NAME  LONG_LONG_INTEGER                                 
+ 							
+ -- $OPTIONAL_DISC                                       
+ -- A DISCRIMINANT USED AS THE DISCRIMINANT PART OF $RECORD_NAME.
+ -- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED THEN SUBSTITUTE
+ -- NO_SUCH_MACHINE_CODE_DISC.                            
+ -- USED IN:  BD8002A
+ OPTIONAL_DISC             
+ 							
+ -- $RECORD_DEFINITION                                   
+ -- THE RECORD TYPE DEFINITION (WITH FINAL SEMICOLON) FOR THE TYPE THAT
+ -- WAS USED IN THE MACRO $RECORD_NAME, AS DECLARED IN PACKAGE    
+ -- MACHINE_CODE.  IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE,
+ -- THEN USE A NULL RECORD DEFINITION                             
+ -- USED IN:  BD8002A                                   
+ RECORD_DEFINITION         RECORD  ASM : STRING (1..4); END RECORD;
+ 							
+ -- $RECORD_NAME
+ -- A VALID RECORD TYPE NAME THAT IS DEFINED IN PACKAGE MACHINE_CODE.
+ -- IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE THEN 
+ -- USE THE NAME "NO_SUCH_MACHINE_CODE_TYPE"
+ -- USED IN:  BD8002A
+ RECORD_NAME	Asm_Insn
+ 
+ -- $TASK_SIZE                                       
+ -- AN INTEGER LITERAL WHOSE VALUE IS THE NUMBER OF BITS REQUIRED TO
+ -- HOLD A TASK OBJECT.                                       
+ -- USED IN:  CD2A91C 
+ TASK_SIZE                 ACATS4GNATBIT
+ 							
+ -- $TASK_STORAGE_SIZE                                 
+ -- THE NUMBER OF STORAGE UNITS REQUIRED FOR A TASK ACTIVATION.
+ -- USED IN:  BD2C01D  BD2C02A  BD2C03A  C87B62D  CD1009K  CD1009T  
+ --           CD1009U  CD1C03E  CD1C06A  CD2C11A  CC1225A  CD2C11D
+ TASK_STORAGE_SIZE 32768                                         
+ 							
+ -- $VARIABLE_ADDRESS                              
+ -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
+ -- IMPLEMENTATION.                                           
+ -- USED IN:  SPPRT13SP                                 
+ VARIABLE_ADDRESS  VAR_ADDR
+ 							
+ -- $VARIABLE_ADDRESS1                                   
+ -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
+ -- IMPLEMENTATION.  THE ADDRESS MUST BE DISTINCT FROM THAT USED IN
+ -- THE MACRO $VARIABLE_ADDRESS.                              
+ -- USED IN:  SPPRT13SP                                       
+ VARIABLE_ADDRESS1  VAR_ADDR1
+ 							
+ -- $VARIABLE_ADDRESS2                    
+ -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
+ -- IMPLEMENTATION.  THE ADDRESS MUST BE DISTINCT FROM THOSE USED IN
+ -- THE MACROS $VARIABLE_ADDRESS AND $VARIABLE_ADDRESS1.          
+ -- USED IN:  SPPRT13SP                                    
+ VARIABLE_ADDRESS2  VAR_ADDR2
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/macrodef.adb gcc-16-20250525/gcc/testsuite/ada/acats-2/support/macrodef.adb
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/macrodef.adb	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/macrodef.adb	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,11 ----
+ with Ada.Text_IO;
+ with System;
+ procedure Macrodef is
+ begin
+    Ada.Text_IO.Put_Line ("Integer'First = " & Integer'Image (Integer'First));
+    Ada.Text_IO.Put_Line ("Integer'Last = " & Integer'Image (Integer'Last));
+    Ada.Text_IO.Put_Line ("System.Min_Int = " & Long_Long_Integer'Image (System.Min_Int));
+    Ada.Text_IO.Put_Line ("System.Max_Int = " & Long_Long_Integer'Image (System.Max_Int));
+    Ada.Text_IO.Put_Line ("Ada.Text_IO.Count'Last = " & Ada.Text_IO.Count'Image (Ada.Text_IO.Count'Last));
+    Ada.Text_IO.Put_Line ("Ada.Text_IO.Field'Last = " & Ada.Text_IO.Field'Image (Ada.Text_IO.Field'Last));
+ end Macrodef;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/macrosub.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/macrosub.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/macrosub.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/macrosub.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,548 ----
+ -- MACROSUB.ADA
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -----------------------------------------------------------------------
+ --                                                                   --
+ --   THIS PROGRAM IS CALLED MACROSUB.  IT IS USED TO REPLACE THE     --
+ --   MACROS IN THE ACVC TEST SUITE WITH THEIR PROPER VALUES.  THE    --
+ --   STEPS LISTED BELOW SHOULD BE FOLLOWED TO ENSURE PROPER RUNNING  --
+ --   OF THE MACROSUB PROGRAM:                                        --
+ --                                                                   --
+ --           1) Edit the file MACRO.DFS (included with the testtape) --
+ --              and insert your macro values.  The macros which use  --
+ --              the value of MAX_IN_LEN are calculated automatically --
+ --              and do not need to be entered.                       --
+ --                                                                   --
+ --           2) Create a file called TSTTESTS.DAT which includes all --
+ --              of the .TST test file names and their directory      --
+ --              specifications, if necessary.  If a different name   --
+ --              other than TSTTESTS.DAT is used, this name must be   --
+ --              substituted in the MACROSUB.ADA file.                --
+ --                                                                   --
+ --           3) Compile and link MACROSUB.                           --
+ --                                                                   --
+ --           4) Run the MACROSUB program.                            --
+ --                                                                   --
+ --   WHEN THE PROGRAM FINISHES RUNNING, THE MACROS WILL HAVE BEEN    --
+ --   REPLACED WITH THE APPROPRIATE VALUES FROM MACRO.DFS.            --
+ --                                                                   --
+ --                                                                   --
+ --                                                                   --
+ -- HISTORY:                                                          --
+ --     BCB 04/17/90  CHANGED MODE OF CALC_MAX_VALS TO OUT.  CHANGED  --
+ --                   VALUE OF MAX_VAL_LENGTH FROM 512 TO 400.  ADDED --
+ --                   EXCEPTION HANDLER SO PROGRAM DOES NOT CRASH IF  --
+ --                   AN EXCEPTION IS RAISED.  ADDED MESSAGES TO      --
+ --                   REPORT PROGRESS OF PROGRAM.  CHANGED PROGRAM SO --
+ --                   IT DOES NOT ABORT IF A FILE CANNOT BE FOUND.    --
+ --                   MODIFIED PROGRAM SO IT ACCEPTS FILENAMES WITH   --
+ --                   VERSION NUMBERS.                                --
+ -----------------------------------------------------------------------
+ 
+ WITH TEXT_IO;
+ USE TEXT_IO;
+ 
+ PACKAGE DEFS IS
+ 
+ -----------------------------------------------------------------------
+ --                                                                   --
+ --   THIS PACKAGE IS USED BY MACROSUB.ADA, PARSEMAC.ADA, AND BY      --
+ --   GETSUBS.ADA.  THE PACKAGE CONTAINS VARIABLE DECLARATIONS WHICH  --
+ --   NEED TO BE KNOWN BY ALL OF THE PROCEDURES AND PACKAGES WHICH    --
+ --   MAKE UP THE PROGRAM.                                            --
+ --                                                                   --
+ -----------------------------------------------------------------------
+ 
+      MAX_VAL_LENGTH : CONSTANT INTEGER := 400;
+ 
+      SUBTYPE VAL_STRING IS STRING (1..MAX_VAL_LENGTH);
+ 
+      TYPE REC_TYPE IS RECORD
+           MACRO_NAME : STRING (1..80);
+           NAME_LENGTH, VALUE_LENGTH : INTEGER;
+           MACRO_VALUE : VAL_STRING;
+      END RECORD;
+ 
+      TYPE TABLE_TYPE IS ARRAY (1..100) OF REC_TYPE;
+ 
+      SYMBOL_TABLE : TABLE_TYPE;
+ 
+      NUM_MACROS : INTEGER;
+ 
+ END DEFS;
+ 
+ WITH TEXT_IO;
+ USE TEXT_IO;
+ WITH DEFS;
+ USE DEFS;
+ 
+ PACKAGE GETSUBS IS
+ 
+ ------------------------------------------------------------------------
+ --                                                                    --
+ --  THIS PACKAGE IS USED BY MACROSUB.ADA FOR READING FROM MACRO.DFS   --
+ --  THE VALUES FOR THE MACRO SUBSTITUTIONS FOR A TEST TAPE.           --
+ --                                                                    --
+ ------------------------------------------------------------------------
+ 
+      MAC_FILE, LINE_LEN : EXCEPTION;
+ 
+      PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER;
+                              CALCULATED : OUT BOOLEAN);
+ 
+      PROCEDURE FILL_TABLE;
+ 
+ END GETSUBS;
+ 
+ PACKAGE BODY GETSUBS IS
+ 
+ -----------------------------------------------------------------------
+ --                                                                   --
+ --    PROCEDURE CALC_MAX_VALS CALCULATES THE VALUE FOR THE MACRO     --
+ --    READ FROM MACRO.DFS IF ITS LENGTH IS EQUAL OR NEARLY EQUAL TO  --
+ --    MAX_IN_LEN.  IT THEN RETURNS A FLAG SET TO TRUE IF A VALUE WAS --
+ --    CALCULATED, FALSE IF ONE WAS NOT.                              --
+ --                                                                   --
+ -----------------------------------------------------------------------
+ 
+      PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER;
+                              CALCULATED : OUT BOOLEAN) IS
+ 
+      BEGIN
+ 
+           IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = "BIG_ID1"
+                THEN SYMBOL_TABLE (INDEX).MACRO_VALUE (1..MAX_IN_LEN) :=
+                (1..(MAX_IN_LEN-1) => 'A') & "1";
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BIG_ID2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..MAX_IN_LEN) := (1..(MAX_IN_LEN-1) => 'A') & "2";
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BIG_ID3" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "3" &
+                ((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A');
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BIG_ID4" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "4" &
+                ((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A');
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BIG_STRING1" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..(MAX_IN_LEN + 1)/2 + 2) :=
+                           '"' & (1..(MAX_IN_LEN + 1)/2 => 'A') & '"';
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BIG_STRING2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2) :=
+                '"' & (2..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 => 'A') &
+                '1' & '"';
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "MAX_STRING_LITERAL" THEN SYMBOL_TABLE (INDEX).
+                MACRO_VALUE (1..MAX_IN_LEN) := '"' &
+                (1..MAX_IN_LEN-2 => 'A') & '"';
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BIG_INT_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..MAX_IN_LEN)  := (1..MAX_IN_LEN-3 => '0') & "298";
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BIG_REAL_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..MAX_IN_LEN) := (1..MAX_IN_LEN-5 => '0') & "690.0";
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "MAX_LEN_INT_BASED_LITERAL" THEN
+                SYMBOL_TABLE (INDEX).
+                MACRO_VALUE (1..MAX_IN_LEN) := "2:" &
+                (1..MAX_IN_LEN - 5 => '0') & "11:";
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "MAX_LEN_REAL_BASED_LITERAL" THEN SYMBOL_TABLE (INDEX).
+                MACRO_VALUE (1..MAX_IN_LEN) := "16:" &
+                (1..MAX_IN_LEN - 7 => '0') & "F.E:";
+                CALCULATED := TRUE;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BLANKS" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
+                (1..MAX_IN_LEN-20) := (1..MAX_IN_LEN-20 => ' ');
+                CALCULATED := TRUE;
+           ELSE
+                CALCULATED := FALSE;
+           END IF;
+           IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                "BLANKS" THEN SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
+                MAX_IN_LEN - 20;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                 "BIG_STRING1" THEN
+                SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
+                            (MAX_IN_LEN + 1)/2 + 2;
+           ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
+                 "BIG_STRING2" THEN
+                SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
+                       MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2;
+           ELSE SYMBOL_TABLE (INDEX).VALUE_LENGTH := MAX_IN_LEN;
+           END IF;
+      END CALC_MAX_VALS;
+ 
+ -----------------------------------------------------------------------
+ --                                                                   --
+ --    PROCEDURE FILL_TABLE READS THE MACRO NAMES AND MACRO VALUES IN --
+ --    FROM MACRO.DFS AND STORES THEM IN THE SYMBOL TABLE.  PROCEDURE --
+ --    CALC_MAX_VALS IS CALLED TO DETERMINE IF THE MACRO VALUE SHOULD --
+ --    BE CALCULATED OR READ FROM MACRO.DFS.                          --
+ --                                                                   --
+ -----------------------------------------------------------------------
+ 
+      PROCEDURE FILL_TABLE IS
+ 
+           INFILE1 : FILE_TYPE;
+           MACRO_FILE : CONSTANT STRING := "MACRO.DFS";
+           A_LINE : VAL_STRING;
+           I, INDEX, LENGTH, HOLD, A_LENGTH, NAME : INTEGER;
+           MAX_IN_LEN : INTEGER := 1;
+           CALCULATED : BOOLEAN;
+ 
+      BEGIN
+           INDEX := 1;
+           BEGIN
+                OPEN (INFILE1, IN_FILE, MACRO_FILE);
+           EXCEPTION
+                WHEN NAME_ERROR =>
+                     PUT_LINE ("** ERROR: MACRO FILE " & MACRO_FILE &
+                               " NOT FOUND.");
+                     RAISE MAC_FILE;
+           END;
+           WHILE NOT END_OF_FILE (INFILE1) LOOP
+                GET_LINE (INFILE1, A_LINE, A_LENGTH);
+                IF A_LENGTH > 0 AND A_LINE (1..2) /= "--" AND
+                   A_LINE (1) /= ' ' AND A_LINE (1) /= ASCII.HT THEN
+                     I := 1;
+                     WHILE I <= A_LENGTH AND THEN
+                            ((A_LINE (I) IN 'A'..'Z') OR
+                             (A_LINE (I) IN '0'..'9') OR
+                             A_LINE (I) = '_') LOOP
+                          I := I + 1;
+                     END LOOP;
+                     I := I - 1;
+                     LENGTH := I;
+                     BEGIN
+                          SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) :=
+                               A_LINE (1..I);
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               PUT_LINE ("** ERROR: LINE LENGTH IS " &
+                                         "GREATER THAN MAX_VAL_LENGTH.");
+                               RAISE LINE_LEN;
+                     END;
+                     SYMBOL_TABLE (INDEX).NAME_LENGTH := I;
+                     CALC_MAX_VALS (INDEX, LENGTH, MAX_IN_LEN,
+                                    CALCULATED);
+                     IF NOT CALCULATED THEN
+                          I := I + 1;
+                          WHILE A_LINE (I) = ' ' OR A_LINE (I) =
+                            ASCII.HT LOOP
+                               I := I + 1;
+                               IF SYMBOL_TABLE (INDEX).MACRO_NAME
+                                    (1..LENGTH) = "BLANKS" THEN
+                                    EXIT;
+                               END IF;
+                          END LOOP;
+                          HOLD := I;
+ 
+ -- MACRO VALUE BEGINS AT POSITION HOLD.
+ -- NOW FIND WHERE IT ENDS BY STARTING AT THE END OF THE INPUT
+ -- LINE AND SEARCHING BACKWARD FOR A NON-BLANK.
+ 
+                          I := A_LENGTH;
+                          WHILE I > HOLD AND THEN (A_LINE (I) = ' '
+                             OR A_LINE(I) = ASCII.HT) LOOP
+                               I := I - 1;
+                          END LOOP;
+                          LENGTH := I - HOLD + 1;
+                          SYMBOL_TABLE (INDEX).MACRO_VALUE (1..LENGTH)
+                               := A_LINE (HOLD..I);
+                          SYMBOL_TABLE (INDEX).VALUE_LENGTH := LENGTH;
+                          NAME := SYMBOL_TABLE (INDEX).NAME_LENGTH;
+                          IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..NAME) =
+                               "MAX_IN_LEN" THEN MAX_IN_LEN :=
+                               INTEGER'VALUE (SYMBOL_TABLE (INDEX).
+                               MACRO_VALUE (1..LENGTH));
+                          END IF;
+                     END IF;
+                     INDEX := INDEX + 1;
+                END IF;
+           END LOOP;
+           NUM_MACROS := INDEX - 1;
+           CLOSE (INFILE1);
+      END FILL_TABLE;
+ 
+ BEGIN
+      NULL;
+ END GETSUBS;
+ 
+ WITH TEXT_IO;
+ USE TEXT_IO;
+ WITH DEFS;
+ USE DEFS;
+ 
+ PACKAGE PARSEMAC IS
+ 
+ ------------------------------------------------------------------------
+ --                                                                    --
+ --   THIS PACKAGE IS USED BY MACROSUB.ADA FOR FINDING A MACRO TO      --
+ --   SUBSTITUTE.  MACRO SUBSTITUTIONS ARE MADE IN *.TST TESTS IN THE  --
+ --   ACVC TEST SUITE.  THIS PROCEDURE IS CURRENTLY SET UP FOR ACVC    --
+ --   VERSION 1.10.                                                    --
+ --                                                                    --
+ ------------------------------------------------------------------------
+ 
+      PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING;
+                                A_LENGTH : IN INTEGER;
+                                PTR : IN OUT INTEGER;
+                                MACRO : OUT STRING;
+                                MACRO_LEN : IN OUT INTEGER);
+ 
+ 
+      PROCEDURE WHICH_MACRO (MACRO : IN STRING;
+                             MACRO_LEN : IN INTEGER;
+                             TEMP_MACRO : OUT STRING;
+                             TEMP_MACRO_LEN : IN OUT INTEGER);
+ 
+ END PARSEMAC;
+ 
+ PACKAGE BODY PARSEMAC IS
+ 
+ -----------------------------------------------------------------------
+ --    PROCEDURE LOOK_FOR_MACRO LOOKS FOR A DOLLAR SIGN WHICH SIGNALS --
+ --    THE START OF A MACRO IN THE *.TST FILES.  IT THEN COUNTS       --
+ --    CHARACTERS UNTIL A <LETTER>, <NUMBER>, OR <_> IS NOT FOUND.    --
+ --    RETURN PARAMETERS SEND THE BEGINNING POINTER AND LENGTH OF THE --
+ --    MACRO BACK TO THE MAIN PROGRAM.  ALSO RETURNED IS THE MACRO    --
+ --    STRING.                                                        --
+ -----------------------------------------------------------------------
+ 
+      PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING;
+                                A_LENGTH : IN INTEGER;
+                                PTR : IN OUT INTEGER;
+                                MACRO : OUT STRING;
+                                MACRO_LEN : IN OUT INTEGER) IS
+ 
+      II, J : INTEGER := INTEGER'LAST;
+ 
+      BEGIN
+           FOR I IN PTR..A_LENGTH LOOP
+                IF A_LINE (I) = '$' THEN
+                     II := I+1;
+                     EXIT;
+                END IF;
+                II := I;
+           END LOOP;
+           IF II < A_LENGTH THEN    -- DOLLAR SIGN IS FOUND.
+                J := II;
+                WHILE J <= A_LENGTH AND THEN ((A_LINE(J) IN 'A'..'Z') OR
+                       (A_LINE(J) IN '0'..'9') OR
+                        A_LINE(J) = '_') LOOP
+                        J := J+1;
+                END LOOP;
+                J := J-1;
+                MACRO_LEN := (J-II+1);
+                MACRO (1..MACRO_LEN) := A_LINE (II .. J);
+                              -- DON'T INCLUDE THE DOLLAR SIGN
+                PTR := J+1;
+           ELSE
+                MACRO_LEN := 0;
+           END IF;
+      RETURN;
+      END LOOK_FOR_MACRO;
+ 
+ ------------------------------------------------------------------------
+ --    PROCEDURE WHICH_MACRO COMPARES THE INPUT MACRO STRING TO A      --
+ --    VALUE READ FROM MACRO.DFS AND STORED IN THE SYMBOL TABLE AND    --
+ --    RETURNS THE MACRO SUBSTITUTION STRING BACK TO THE MAIN PROGRAM. --
+ ------------------------------------------------------------------------
+ 
+      PROCEDURE WHICH_MACRO (MACRO : IN STRING;
+                             MACRO_LEN : IN INTEGER;
+                             TEMP_MACRO : OUT STRING;
+                             TEMP_MACRO_LEN : IN OUT INTEGER) IS
+ 
+      BEGIN
+           FOR INDEX IN 1 .. NUM_MACROS LOOP
+                IF MACRO (1..MACRO_LEN) =
+                   SYMBOL_TABLE (INDEX).MACRO_NAME
+                       (1..SYMBOL_TABLE (INDEX).NAME_LENGTH) THEN
+                     TEMP_MACRO_LEN :=
+                       SYMBOL_TABLE (INDEX).VALUE_LENGTH;
+                     TEMP_MACRO (1..TEMP_MACRO_LEN) :=
+                       SYMBOL_TABLE (INDEX).MACRO_VALUE
+                         (1..TEMP_MACRO_LEN);
+                     EXIT;
+                END IF;
+                IF INDEX = NUM_MACROS THEN
+                     PUT_LINE ("** ERROR: MACRO " & MACRO (1..MACRO_LEN)
+                               & " NOT FOUND.  UPDATE PROGRAM.");
+                     TEMP_MACRO_LEN := MACRO_LEN;
+                     TEMP_MACRO (1..TEMP_MACRO_LEN) :=
+                        MACRO (1..MACRO_LEN);
+                END IF;
+           END LOOP;
+ 
+      END WHICH_MACRO;
+ 
+ BEGIN
+      NULL;
+ END PARSEMAC;
+ 
+ WITH TEXT_IO, GETSUBS, PARSEMAC, DEFS;
+ USE TEXT_IO, GETSUBS, PARSEMAC, DEFS;
+ 
+ PROCEDURE MACROSUB IS
+ 
+ ------------------------------------------------------------------------
+ --                                                                    --
+ --    MACROSUB IS THE MAIN PROGRAM THAT CALLS PROCEDURES IN TWO       --
+ --    PACKAGES, GETSUBS AND PARSEMAC.  THIS PROGRAM IS USED TO MAKE   --
+ --    THE MACRO SUBSTITUTIONS FOR TST TESTS IN THE ACVC TEST SUITE.   --
+ --                                                                    --
+ ------------------------------------------------------------------------
+ 
+      INFILE1, INFILE2, OUTFILE1     : FILE_TYPE;
+      FNAME, MACRO                   : VAL_STRING;
+      LENGTH, A_LENGTH, PTR,
+      TEMP_MACRO_LENGTH, MACRO_LEN, FILE_COUNT : INTEGER := 0;
+      A_LINE, TEMP_MACRO, TEMP_LINE, NEW_LINE : VAL_STRING;
+      END_OF_LINE_SEARCH, FLAG       : BOOLEAN := FALSE;
+      TESTS_FILE                     : CONSTANT STRING := "TSTTESTS.DAT";
+      TSTTESTS,FILE_CRE              : EXCEPTION;
+ 
+ BEGIN
+      PUT_LINE ("BEGINNING MACRO SUBSTITUTIONS.");
+      FILL_TABLE;
+      BEGIN
+           OPEN (INFILE2, IN_FILE, TESTS_FILE);
+      EXCEPTION
+           WHEN NAME_ERROR =>
+                PUT_LINE ("** ERROR: ERROR DURING OPENING OF " &
+                          "TSTTESTS.DAT");
+                RAISE TSTTESTS;
+      END;
+      WHILE NOT END_OF_FILE (INFILE2) LOOP
+           GET_LINE (INFILE2, FNAME, LENGTH);
+           FILE_COUNT := FILE_COUNT + 1;
+           BEGIN
+                OPEN (INFILE1, IN_FILE, FNAME(1..LENGTH));
+           EXCEPTION
+                WHEN NAME_ERROR =>
+                     PUT_LINE ("** ERROR: ERROR DURING OPENING OF " &
+                               FNAME(1..LENGTH) & ".");
+                     FLAG := TRUE;
+           END;
+           IF NOT FLAG THEN
+                PUT_LINE ("WORKING ON " & FNAME(1..LENGTH));
+                IF FILE_COUNT = 70 THEN
+                     PUT_LINE ("MACRO SUBSTITUTIONS HALF COMPLETED.");
+                END IF;
+                FOR I IN REVERSE 1 .. LENGTH LOOP
+                     IF FNAME(I) = ';' THEN
+                          LENGTH := I - 1;
+                          EXIT;
+                     END IF;
+                END LOOP;
+                IF FNAME (LENGTH-2..LENGTH) = "TST" THEN
+                     FNAME (LENGTH-2..LENGTH) := "ADT";
+                ELSIF FNAME (LENGTH-2..LENGTH) = "tst" THEN
+                     FNAME (LENGTH-2..LENGTH) := "adt";
+                END IF;
+                BEGIN
+                     CREATE (OUTFILE1, OUT_FILE, FNAME (1..LENGTH));
+                EXCEPTION
+                     WHEN OTHERS =>
+                          PUT_LINE ("** ERROR: EXCEPTION RAISED DURING" &
+                                    " ATTEMPTED CREATION OF " &
+                                    FNAME(1..LENGTH) & ".");
+                          RAISE FILE_CRE;
+                END;
+                WHILE NOT END_OF_FILE (INFILE1) LOOP
+                     GET_LINE (INFILE1, A_LINE, A_LENGTH);
+                     IF A_LENGTH > 0 AND A_LINE(1..2) /= "--" THEN
+                          END_OF_LINE_SEARCH := FALSE;
+                          PTR := 1;
+                          WHILE NOT END_OF_LINE_SEARCH LOOP
+                               LOOK_FOR_MACRO (A_LINE, A_LENGTH, PTR,
+                                               MACRO, MACRO_LEN);
+                               IF MACRO_LEN = 0 THEN
+                                    END_OF_LINE_SEARCH := TRUE;
+                               ELSE --  SEE WHICH MACRO IT IS
+                                    WHICH_MACRO (MACRO, MACRO_LEN,
+                                        TEMP_MACRO, TEMP_MACRO_LENGTH);
+                               END IF;
+                               IF NOT END_OF_LINE_SEARCH THEN
+                                    IF PTR-MACRO_LEN-2 > 0 THEN
+                                  -- IF MACRO IS NOT FIRST ON THE LINE
+                                         NEW_LINE (1..PTR-MACRO_LEN-2)
+                                          := A_LINE(1..PTR-MACRO_LEN -2);
+                                  -- THE OLD LINE UNTIL THE DOLLAR SIGN
+                                    END IF;
+                                    NEW_LINE(PTR-MACRO_LEN-1 ..
+                                             TEMP_MACRO_LENGTH +
+                                             (PTR-MACRO_LEN) - 2) :=
+                                        TEMP_MACRO(1..TEMP_MACRO_LENGTH);
+                                    IF PTR <= A_LENGTH THEN
+                                  -- IF MACRO IS NOT LAST ON THE LINE
+                                         NEW_LINE (TEMP_MACRO_LENGTH +
+                                              PTR-MACRO_LEN - 1 ..
+                                              TEMP_MACRO_LENGTH - 1 +
+                                              A_LENGTH - MACRO_LEN) :=
+                                              A_LINE (PTR..A_LENGTH);
+                                    ELSE
+                                         END_OF_LINE_SEARCH := TRUE;
+                                    END IF;
+                                    A_LENGTH := A_LENGTH +
+                                                TEMP_MACRO_LENGTH -
+                                                MACRO_LEN - 1;
+                                    A_LINE (1..A_LENGTH) :=
+                                           NEW_LINE (1..A_LENGTH);
+                                    PTR := PTR - MACRO_LEN +
+                                           TEMP_MACRO_LENGTH - 1;
+                               END IF;
+                          END LOOP;
+                     END IF;
+                     PUT_LINE (OUTFILE1, A_LINE (1..A_LENGTH));
+                END LOOP;
+                CLOSE (OUTFILE1);
+                CLOSE (INFILE1);
+           ELSE
+                FLAG := FALSE;
+           END IF;
+      END LOOP;
+      CLOSE (INFILE2);
+      PUT_LINE ("MACRO SUBSTITUTIONS COMPLETED.");
+ EXCEPTION
+      WHEN MAC_FILE | LINE_LEN | TSTTESTS | FILE_CRE =>
+           NULL;
+      WHEN OTHERS =>
+           PUT_LINE ("UNEXPECTED EXCEPTION RAISED");
+ END MACROSUB;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/repbody.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/repbody.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/repbody.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/repbody.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,330 ----
+ -- REPBODY.ADA
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- HISTORY:
+ --      DCB 04/27/80
+ --      JRK 6/10/80
+ --      JRK 11/12/80
+ --      JRK 8/6/81
+ --      JRK 10/27/82
+ --      JRK 6/1/84
+ --      JRK 11/18/85  ADDED PRAGMA ELABORATE.
+ --      PWB 07/29/87  ADDED STATUS ACTION_REQUIRED AND
+ --                    PROCEDURE SPECIAL_ACTION.
+ --      TBN 08/20/87  ADDED FUNCTION LEGAL_FILE_NAME.
+ --      BCB 05/17/90  MODIFIED TO ALLOW OUTPUT TO DIRECT_IO FILE.
+ --                    ADDED TIME-STAMP.
+ --      LDC 05/17/90  REMOVED OUTPUT TO DIRECT_IO FILE.
+ --      WMC 08/11/92  UPDATED ACVC VERSION STRING TO "9X BASIC".
+ --      DTN 07/05/92  UPDATED ACVC VERSION STRING TO
+ --                    "ACVC 2.0 JULY 6 1993 DRAFT".
+ --      WMC 01/24/94  MODIFIED LEGAL_FILE_NAME TO ALLOW FIVE POSSIBLE
+ --                    FILE NAMES (INCREASED RANGE OF TYPE FILE_NUM TO 1..5).
+ --      WMC 11/06/94  UPDATED ACVC VERSION STRING TO
+ --                    "ACVC 2.0 NOVEMBER 6 1994 DRAFT".
+ --      DTN 12/04/94  UPDATED ACVC VERSION STRING TO
+ --                    "ACVC 2.0".
+ --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_CHAR.
+ --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_STR.
+ --      DTN 11/21/95  UPDATED ACVC VERSION STRING TO
+ --                    "ACVC 2.0.1".
+ --      DTN 12/14/95  UPDATED ACVC VERSION STRING TO
+ --                    "ACVC 2.1".
+ --      EDS 12/17/97  UPDATED ACVC VERSION STRING TO
+ --                    "2.2".
+ --      RLB  3/16/00  UPDATED ACATS VERSION STRING TO "2.3".
+ --                    CHANGED VARIOUS STRINGS TO READ "ACATS".
+ --      RLB  3/22/01  UPDATED ACATS VERSION STRING TO "2.4".
+ --      RLB  3/29/02  UPDATED ACATS VERSION STRING TO "2.5".
+ --      RLB  3/06/07  UPDATED ACATS VERSION STRING TO "2.6".
+ 
+ WITH TEXT_IO, CALENDAR;
+ USE TEXT_IO, CALENDAR;
+ PRAGMA ELABORATE (TEXT_IO, CALENDAR);
+ 
+ PACKAGE BODY REPORT IS
+ 
+      TYPE STATUS IS (PASS, FAIL, DOES_NOT_APPLY, ACTION_REQUIRED,
+                      UNKNOWN);
+ 
+      TYPE TIME_INTEGER IS RANGE 0 .. 86_400;
+ 
+      TEST_STATUS : STATUS := FAIL;
+ 
+      MAX_NAME_LEN : CONSTANT := 15;     -- MAXIMUM TEST NAME LENGTH.
+      TEST_NAME : STRING (1..MAX_NAME_LEN);
+ 
+      NO_NAME : CONSTANT STRING (1..7) := "NO_NAME";
+      TEST_NAME_LEN : INTEGER RANGE 0..MAX_NAME_LEN := 0;
+ 
+ 
+ 
+      ACATS_VERSION : CONSTANT STRING := "2.6";
+                                        -- VERSION OF ACATS BEING RUN (X.XX).
+ 
+      PROCEDURE PUT_MSG (MSG : STRING) IS
+           -- WRITE MESSAGE.  LONG MESSAGES ARE FOLDED (AND INDENTED).
+           MAX_LEN : CONSTANT INTEGER RANGE 50..150 := 72;  -- MAXIMUM
+                                         -- OUTPUT LINE LENGTH.
+           INDENT : CONSTANT INTEGER := TEST_NAME_LEN + 9;  -- AMOUNT TO
+                                         -- INDENT CONTINUATION LINES.
+           I : INTEGER := 0;             -- CURRENT INDENTATION.
+           M : INTEGER := MSG'FIRST;     -- START OF MESSAGE SLICE.
+           N : INTEGER;                  -- END OF MESSAGE SLICE.
+      BEGIN
+           LOOP
+                IF I + (MSG'LAST-M+1) > MAX_LEN THEN
+                     N := M + (MAX_LEN-I) - 1;
+                     IF MSG (N) /= ' ' THEN
+                          WHILE N >= M AND THEN MSG (N+1) /= ' ' LOOP
+                               N := N - 1;
+                          END LOOP;
+                          IF N < M THEN
+                               N := M + (MAX_LEN-I) - 1;
+                          END IF;
+                     END IF;
+                ELSE N := MSG'LAST;
+                END IF;
+                SET_COL (STANDARD_OUTPUT, TEXT_IO.COUNT (I+1));
+                PUT_LINE (STANDARD_OUTPUT, MSG (M..N));
+                I := INDENT;
+                M := N + 1;
+                WHILE M <= MSG'LAST AND THEN MSG (M) = ' ' LOOP
+                     M := M + 1;
+                END LOOP;
+                EXIT WHEN M > MSG'LAST;
+           END LOOP;
+      END PUT_MSG;
+ 
+      FUNCTION TIME_STAMP RETURN STRING IS
+           TIME_NOW : CALENDAR.TIME;
+           YEAR,
+           MONTH,
+           DAY,
+           HOUR,
+           MINUTE,
+           SECOND : TIME_INTEGER := 1;
+ 
+           FUNCTION CONVERT (NUMBER : TIME_INTEGER) RETURN STRING IS
+                STR : STRING (1..2) := (OTHERS => '0');
+                DEC_DIGIT : CONSTANT STRING := "0123456789";
+                NUM : TIME_INTEGER := NUMBER;
+           BEGIN
+                IF NUM = 0 THEN
+                     RETURN STR;
+                ELSE
+                     NUM := NUM MOD 100;
+                     STR (2) := DEC_DIGIT (INTEGER (NUM MOD 10 + 1));
+                     NUM := NUM / 10;
+                     STR (1) := DEC_DIGIT (INTEGER (NUM + 1));
+                     RETURN STR;
+                END IF;
+           END CONVERT;
+      BEGIN
+           TIME_NOW := CALENDAR.CLOCK;
+           SPLIT (TIME_NOW, YEAR_NUMBER (YEAR), MONTH_NUMBER (MONTH),
+                   DAY_NUMBER (DAY), DAY_DURATION (SECOND));
+           HOUR := SECOND / 3600;
+           SECOND := SECOND MOD 3600;
+           MINUTE := SECOND / 60;
+           SECOND := SECOND MOD 60;
+           RETURN (CONVERT (TIME_INTEGER (YEAR)) & "-" &
+                   CONVERT (TIME_INTEGER (MONTH)) & "-" &
+                   CONVERT (TIME_INTEGER (DAY)) & " " &
+                   CONVERT (TIME_INTEGER (HOUR)) & ":" &
+                   CONVERT (TIME_INTEGER (MINUTE)) & ":" &
+                   CONVERT (TIME_INTEGER (SECOND)));
+      END TIME_STAMP;
+ 
+      PROCEDURE TEST (NAME : STRING; DESCR : STRING) IS
+      BEGIN
+           TEST_STATUS := PASS;
+           IF NAME'LENGTH <= MAX_NAME_LEN THEN
+                TEST_NAME_LEN := NAME'LENGTH;
+           ELSE TEST_NAME_LEN := MAX_NAME_LEN;
+           END IF;
+           TEST_NAME (1..TEST_NAME_LEN) :=
+                     NAME (NAME'FIRST .. NAME'FIRST+TEST_NAME_LEN-1);
+ 
+           PUT_MSG ("");
+           PUT_MSG (",.,. " & TEST_NAME (1..TEST_NAME_LEN) & " " &
+                    "ACATS " & ACATS_VERSION & " " & TIME_STAMP);
+           PUT_MSG ("---- " & TEST_NAME (1..TEST_NAME_LEN) & " " &
+                    DESCR & ".");
+      END TEST;
+ 
+      PROCEDURE COMMENT (DESCR : STRING) IS
+      BEGIN
+           PUT_MSG ("   - " & TEST_NAME (1..TEST_NAME_LEN) & " " &
+                    DESCR & ".");
+      END COMMENT;
+ 
+      PROCEDURE FAILED (DESCR : STRING) IS
+      BEGIN
+           TEST_STATUS := FAIL;
+           PUT_MSG ("   * " & TEST_NAME (1..TEST_NAME_LEN) & " " &
+                    DESCR & ".");
+      END FAILED;
+ 
+      PROCEDURE NOT_APPLICABLE (DESCR : STRING) IS
+      BEGIN
+           IF TEST_STATUS = PASS OR TEST_STATUS = ACTION_REQUIRED THEN
+                TEST_STATUS := DOES_NOT_APPLY;
+           END IF;
+           PUT_MSG ("   + " & TEST_NAME (1..TEST_NAME_LEN) & " " &
+                    DESCR & ".");
+      END NOT_APPLICABLE;
+ 
+      PROCEDURE SPECIAL_ACTION (DESCR : STRING) IS
+      BEGIN
+           IF TEST_STATUS = PASS THEN
+                TEST_STATUS := ACTION_REQUIRED;
+           END IF;
+           PUT_MSG ("   ! " & TEST_NAME (1..TEST_NAME_LEN) & " " &
+                    DESCR & ".");
+      END SPECIAL_ACTION;
+ 
+      PROCEDURE RESULT IS
+      BEGIN
+           CASE TEST_STATUS IS
+           WHEN PASS =>
+                PUT_MSG ("==== " & TEST_NAME (1..TEST_NAME_LEN) &
+                         " PASSED ============================.");
+           WHEN DOES_NOT_APPLY =>
+                PUT_MSG ("++++ " & TEST_NAME (1..TEST_NAME_LEN) &
+                         " NOT-APPLICABLE ++++++++++++++++++++.");
+           WHEN ACTION_REQUIRED =>
+                PUT_MSG ("!!!! " & TEST_NAME (1..TEST_NAME_LEN) &
+                         " TENTATIVELY PASSED !!!!!!!!!!!!!!!!.");
+                PUT_MSG ("!!!! " & (1..TEST_NAME_LEN => ' ') &
+                         " SEE '!' COMMENTS FOR SPECIAL NOTES!!");
+           WHEN OTHERS =>
+                PUT_MSG ("**** " & TEST_NAME (1..TEST_NAME_LEN) &
+                         " FAILED ****************************.");
+           END CASE;
+           TEST_STATUS := FAIL;
+           TEST_NAME_LEN := NO_NAME'LENGTH;
+           TEST_NAME (1..TEST_NAME_LEN) := NO_NAME;
+      END RESULT;
+ 
+      FUNCTION IDENT_INT (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           IF EQUAL (X, X) THEN          -- ALWAYS EQUAL.
+                RETURN X;                -- ALWAYS EXECUTED.
+           END IF;
+           RETURN 0;                     -- NEVER EXECUTED.
+      END IDENT_INT;
+ 
+      FUNCTION IDENT_CHAR (X : CHARACTER) RETURN CHARACTER IS
+      BEGIN
+           IF EQUAL (CHARACTER'POS(X), CHARACTER'POS(X)) THEN  -- ALWAYS
+                                         -- EQUAL.
+                RETURN X;                -- ALWAYS EXECUTED.
+           END IF;
+           RETURN '0';                   -- NEVER EXECUTED.
+      END IDENT_CHAR;
+ 
+      FUNCTION IDENT_WIDE_CHAR (X : WIDE_CHARACTER) RETURN WIDE_CHARACTER IS
+      BEGIN
+           IF EQUAL (WIDE_CHARACTER'POS(X), WIDE_CHARACTER'POS(X)) THEN
+                                         -- ALWAYS EQUAL.
+                RETURN X;                -- ALWAYS EXECUTED.
+           END IF;
+           RETURN '0';                   -- NEVER EXECUTED.
+      END IDENT_WIDE_CHAR;
+ 
+      FUNCTION IDENT_BOOL (X : BOOLEAN) RETURN BOOLEAN IS
+      BEGIN
+           IF EQUAL (BOOLEAN'POS(X), BOOLEAN'POS(X)) THEN  -- ALWAYS
+                                         -- EQUAL.
+                RETURN X;                -- ALWAYS EXECUTED.
+           END IF;
+           RETURN FALSE;                 -- NEVER EXECUTED.
+      END IDENT_BOOL;
+ 
+      FUNCTION IDENT_STR (X : STRING) RETURN STRING IS
+      BEGIN
+           IF EQUAL (X'LENGTH, X'LENGTH) THEN  -- ALWAYS EQUAL.
+                RETURN X;                -- ALWAYS EXECUTED.
+           END IF;
+           RETURN "";                    -- NEVER EXECUTED.
+      END IDENT_STR;
+ 
+      FUNCTION IDENT_WIDE_STR (X : WIDE_STRING) RETURN WIDE_STRING IS
+      BEGIN
+           IF EQUAL (X'LENGTH, X'LENGTH) THEN  -- ALWAYS EQUAL.
+                RETURN X;                -- ALWAYS EXECUTED.
+           END IF;
+           RETURN "";                    -- NEVER EXECUTED.
+      END IDENT_WIDE_STR;
+ 
+      FUNCTION EQUAL (X, Y : INTEGER) RETURN BOOLEAN IS
+           REC_LIMIT : CONSTANT INTEGER RANGE 1..100 := 3;  -- RECURSION
+                                         -- LIMIT.
+           Z : BOOLEAN;                  -- RESULT.
+      BEGIN
+           IF X < 0 THEN
+                IF Y < 0 THEN
+                     Z := EQUAL (-X, -Y);
+                ELSE Z := FALSE;
+                END IF;
+           ELSIF X > REC_LIMIT THEN
+                Z := EQUAL (REC_LIMIT, Y-X+REC_LIMIT);
+           ELSIF X > 0 THEN
+                Z := EQUAL (X-1, Y-1);
+           ELSE Z := Y = 0;
+           END IF;
+           RETURN Z;
+      EXCEPTION
+           WHEN OTHERS =>
+                RETURN X = Y;
+      END EQUAL;
+ 
+      FUNCTION LEGAL_FILE_NAME (X : FILE_NUM := 1;
+                                NAM : STRING := "")
+                               RETURN STRING IS
+           SUFFIX : STRING (2..6);
+      BEGIN
+           IF NAM = "" THEN
+                SUFFIX := TEST_NAME(3..7);
+           ELSE
+                SUFFIX := NAM(3..7);
+           END IF;
+ 
+           CASE X IS
+                WHEN 1 => RETURN ('X' & SUFFIX);
+                WHEN 2 => RETURN ('Y' & SUFFIX);
+                WHEN 3 => RETURN ('Z' & SUFFIX);
+                WHEN 4 => RETURN ('V' & SUFFIX);
+                WHEN 5 => RETURN ('W' & SUFFIX);
+           END CASE;
+      END LEGAL_FILE_NAME;
+ 
+ BEGIN
+ 
+      TEST_NAME_LEN := NO_NAME'LENGTH;
+      TEST_NAME (1..TEST_NAME_LEN) := NO_NAME;
+ 
+ END REPORT;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/repspec.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/repspec.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/repspec.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/repspec.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- REPSPEC.ADA
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- PURPOSE:
+ --      THIS REPORT PACKAGE PROVIDES THE MECHANISM FOR REPORTING THE
+ --      PASS/FAIL/NOT-APPLICABLE RESULTS OF EXECUTABLE (CLASSES A, C,
+ --      D, E, AND L) TESTS.
+ 
+ --      IT ALSO PROVIDES THE MECHANISM FOR GUARANTEEING THAT CERTAIN
+ --      VALUES BECOME DYNAMIC (NOT KNOWN AT COMPILE-TIME).
+ 
+ -- HISTORY:
+ --      JRK 12/13/79
+ --      JRK 06/10/80
+ --      JRK 08/06/81
+ --      JRK 10/27/82
+ --      JRK 06/01/84
+ --      PWB 07/30/87  ADDED PROCEDURE SPECIAL_ACTION.
+ --      TBN 08/20/87  ADDED FUNCTION LEGAL_FILE_NAME.
+ --      BCB 05/17/90  ADDED FUNCTION TIME_STAMP.
+ --      WMC 01/24/94  INCREASED RANGE OF TYPE FILE_NUM FROM 1..3 TO 1..5.
+ --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_CHAR.
+ --      KAS 06/19/95  ADDED FUNCTION IDENT_WIDE_STR.
+ 
+ PACKAGE REPORT IS
+ 
+      SUBTYPE FILE_NUM IS INTEGER RANGE 1..5;
+ 
+   -- THE REPORT ROUTINES.
+ 
+      PROCEDURE TEST           -- THIS ROUTINE MUST BE INVOKED AT THE
+                               -- START OF A TEST, BEFORE ANY OF THE
+                               -- OTHER REPORT ROUTINES ARE INVOKED.
+                               -- IT SAVES THE TEST NAME AND OUTPUTS THE
+                               -- NAME AND DESCRIPTION.
+         ( NAME : STRING;      -- TEST NAME, E.G., "C23001A-AB".
+           DESCR : STRING      -- BRIEF DESCRIPTION OF TEST, E.G.,
+                               -- "UPPER/LOWER CASE EQUIVALENCE IN " &
+                               -- "IDENTIFIERS".
+         );
+ 
+      PROCEDURE FAILED         -- OUTPUT A FAILURE MESSAGE.  SHOULD BE
+                               -- INVOKED SEPARATELY TO REPORT THE
+                               -- FAILURE OF EACH SUBTEST WITHIN A TEST.
+         ( DESCR : STRING      -- BRIEF DESCRIPTION OF WHAT FAILED.
+                               -- SHOULD BE PHRASED AS:
+                               -- "(FAILED BECAUSE) ...REASON...".
+         );
+ 
+      PROCEDURE NOT_APPLICABLE -- OUTPUT A NOT-APPLICABLE MESSAGE.
+                               -- SHOULD BE INVOKED SEPARATELY TO REPORT
+                               -- THE NON-APPLICABILITY OF EACH SUBTEST
+                               -- WITHIN A TEST.
+         ( DESCR : STRING      -- BRIEF DESCRIPTION OF WHAT IS
+                               -- NOT-APPLICABLE. SHOULD BE PHRASED AS:
+                               -- "(NOT-APPLICABLE BECAUSE)...REASON...".
+         );
+ 
+      PROCEDURE SPECIAL_ACTION -- OUTPUT A MESSAGE DESCRIBING SPECIAL
+                               -- ACTIONS TO BE TAKEN.
+                               -- SHOULD BE INVOKED SEPARATELY TO GIVE
+                               -- EACH SPECIAL ACTION.
+         ( DESCR : STRING      -- BRIEF DESCRIPTION OF ACTION TO BE
+                               -- TAKEN.
+         );
+ 
+      PROCEDURE COMMENT        -- OUTPUT A COMMENT MESSAGE.
+         ( DESCR : STRING      -- THE MESSAGE.
+         );
+ 
+      PROCEDURE RESULT;        -- THIS ROUTINE MUST BE INVOKED AT THE
+                               -- END OF A TEST.  IT OUTPUTS A MESSAGE
+                               -- INDICATING WHETHER THE TEST AS A
+                               -- WHOLE HAS PASSED, FAILED, IS
+                               -- NOT-APPLICABLE, OR HAS TENTATIVELY
+                               -- PASSED PENDING SPECIAL ACTIONS.
+ 
+   -- THE DYNAMIC VALUE ROUTINES.
+ 
+      -- EVEN WITH STATIC ARGUMENTS, THESE FUNCTIONS WILL HAVE DYNAMIC
+      -- RESULTS.
+ 
+      FUNCTION IDENT_INT       -- AN IDENTITY FUNCTION FOR TYPE INTEGER.
+         ( X : INTEGER         -- THE ARGUMENT.
+         ) RETURN INTEGER;     -- X.
+ 
+      FUNCTION IDENT_CHAR      -- AN IDENTITY FUNCTION FOR TYPE
+                               -- CHARACTER.
+         ( X : CHARACTER       -- THE ARGUMENT.
+         ) RETURN CHARACTER;   -- X.
+ 
+      FUNCTION IDENT_WIDE_CHAR -- AN IDENTITY FUNCTION FOR TYPE
+                               -- WIDE_CHARACTER.
+         ( X : WIDE_CHARACTER  -- THE ARGUMENT.
+         ) RETURN WIDE_CHARACTER; -- X.
+ 
+      FUNCTION IDENT_BOOL      -- AN IDENTITY FUNCTION FOR TYPE BOOLEAN.
+         ( X : BOOLEAN         -- THE ARGUMENT.
+         ) RETURN BOOLEAN;     -- X.
+ 
+      FUNCTION IDENT_STR       -- AN IDENTITY FUNCTION FOR TYPE STRING.
+         ( X : STRING          -- THE ARGUMENT.
+         ) RETURN STRING;      -- X.
+ 
+      FUNCTION IDENT_WIDE_STR  -- AN IDENTITY FUNCTION FOR TYPE WIDE_STRING.
+         ( X : WIDE_STRING     -- THE ARGUMENT.
+         ) RETURN WIDE_STRING; -- X.
+ 
+      FUNCTION EQUAL           -- A RECURSIVE EQUALITY FUNCTION FOR TYPE
+                               -- INTEGER.
+         ( X, Y : INTEGER      -- THE ARGUMENTS.
+         ) RETURN BOOLEAN;     -- X = Y.
+ 
+ -- OTHER UTILITY ROUTINES.
+ 
+      FUNCTION LEGAL_FILE_NAME -- A FUNCTION TO GENERATE LEGAL EXTERNAL
+                               -- FILE NAMES.
+         ( X : FILE_NUM := 1;  -- DETERMINES FIRST CHARACTER OF NAME.
+           NAM : STRING := ""  -- DETERMINES REST OF NAME.
+         ) RETURN STRING;      -- THE GENERATED NAME.
+ 
+      FUNCTION TIME_STAMP      -- A FUNCTION TO GENERATE THE TIME AND
+                               -- DATE TO PLACE IN THE OUTPUT OF AN ACVC
+                               -- TEST.
+           RETURN STRING;      -- THE TIME AND DATE.
+ 
+ END REPORT;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/spprt13s.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/support/spprt13s.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/spprt13s.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/spprt13s.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- SPPRT13SP.TST
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- SPECIFICATION FOR PACKAGE SPPRT13
+ 
+ -- PURPOSE:
+ --     THIS PACKAGE CONTAINS CONSTANTS OF TYPE SYSTEM.ADDRESS.
+ --     THESE CONSTANTS ARE USED BY SELECTED CHAPTER 13 TESTS,
+ --     BY PARTS OF THE AVAT SYSTEM, AND BY ISOLATED TESTS FOR
+ --     OTHER CHAPTERS.
+ 
+ -- MACRO SUBSTITUTIONS:
+ --     $VARIABLE_ADDRESS, $VARIABLE_ADDRESS1, AND $VARIABLE_ADDRESS2 ARE
+ --     EXPRESSIONS YIELDING LEGAL ADDRESSES FOR VARIABLES FOR THIS
+ --     IMPLEMENTATION.
+ 
+ --     $ENTRY_ADDRESS, $ENTRY_ADDRESS1, AND $ENTRY_ADDRESS2 ARE
+ --     EXPRESSIONS YIELDING LEGAL ADDRESSES FOR TASK ENTRIES
+ --     (I.E., FOR INTERRUPTS) FOR THIS IMPLEMENTATION.
+ 
+ --     IF NO EXPRESSIONS CAN BE GIVEN THAT ARE SATISFACTORY FOR THE
+ --     VALUES OF THESE CONSTANTS, THEN DECLARE SUITABLE FUNCTIONS
+ --     IN THE SPECIFICATION OF PACKAGE FCNDECL, CREATE A PACKAGE BODY
+ --     CONTAINING BODIES FOR THE FUNCTIONS, AND REPLACE THE MACROS WITH
+ --     APPROPRIATE FUNCTION CALLS.
+ 
+ WITH FCNDECL; USE FCNDECL;
+ WITH SYSTEM;
+ PACKAGE SPPRT13 IS
+ 
+         VARIABLE_ADDRESS  : CONSTANT SYSTEM.ADDRESS :=
+                             $VARIABLE_ADDRESS;
+         VARIABLE_ADDRESS1 : CONSTANT SYSTEM.ADDRESS :=
+                             $VARIABLE_ADDRESS1;
+         VARIABLE_ADDRESS2 : CONSTANT SYSTEM.ADDRESS :=
+                             $VARIABLE_ADDRESS2;
+ 
+         ENTRY_ADDRESS  : CONSTANT SYSTEM.ADDRESS :=
+                             $ENTRY_ADDRESS;
+         ENTRY_ADDRESS1 : CONSTANT SYSTEM.ADDRESS :=
+                             $ENTRY_ADDRESS1;
+         ENTRY_ADDRESS2 : CONSTANT SYSTEM.ADDRESS :=
+                             $ENTRY_ADDRESS2;
+ 
+ END SPPRT13;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/tctouch.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/support/tctouch.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/tctouch.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/tctouch.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,265 ----
+ -- TCTouch.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- FOUNDATION DESCRIPTION:
+ --      The tools in this foundation are not peculiar to any particular
+ --      aspect of the language, but simplify the test writing and reading
+ --      process.  Assert and Assert_Not are used to reduce the textual
+ --      overhead of the test-that-this-condition-is-(not)-true paradigm.
+ --      Touch and Validate are used to simplify tracing an expected path
+ --      of execution.
+ --      A tag comment of the form:
+ --
+ --      TCTouch.Touch( 'A' ); ----------------------------------------- A
+ --
+ --      is recommended to improve readability of this feature.
+ --
+ --      Report.Test must be called before any of the procedures in this
+ --      package with the exception of Touch.
+ --      The usage paradigm is to call Touch in locations in the test where you
+ --      want a trace of execution.  Each call to Touch should have a unique
+ --      character associated with it.  At each place where a check can
+ --      reasonably be performed to determine correct execution of a
+ --      sub-test, a call to Validate should be made.  The first parameter
+ --      passed to Validate is the expected string of characters produced by
+ --      call(s) to Touch in the subtest just executed.  The second parameter
+ --      is the message to pass to Report.Failed if the expected sequence was
+ --      not executed.
+ --
+ --      Validate should always be called after calls to Touch before a test
+ --      completes.
+ --
+ --      In the event that calls may have been made to Touch that are not
+ --      intended to be recorded, or, the failure of a previous subtest may
+ --      leave Touch calls "Unvalidated", the procedure Flush will reset the
+ --      tracker to the "empty" state.  Flush does not make any calls to
+ --      Report.
+ --
+ --      Calls to Assert and Assert_Not are to replace the idiom:
+ --
+ --         if BadCondition then  -- or if not PositiveTest then
+ --           Report.Failed(Message);
+ --         end if;
+ --
+ --      with:
+ --
+ --         Assert_Not( BadCondition, Message ); -- or
+ --         Assert( PositiveTest, Message );
+ --
+ --      Implementation_Check is for use with tests that cross the boundary
+ --      between the core and the Special Needs Annexes.  There are several
+ --      instances where language in the core becomes enforceable only when
+ --      a Special Needs Annex is supported.  Implementation_Check should be
+ --      called in place of Report.Failed in these cases; it examines the
+ --      constants in Impdef that indicate if the particular Special Needs
+ --      Annex is being validated with this validation; and acts accordingly.
+ --
+ --      The constant Foundation_ID contains the internal change version
+ --      for this software.
+ --
+ -- ERROR CONDITIONS:
+ --
+ --      It is an error to perform more than Max_Touch_Count (80) calls to
+ --      Touch without a subsequent call to Validate.  To do so will cause
+ --      a false test failure.
+ --
+ -- CHANGE HISTORY:
+ --     02 JUN 94   SAIC    Initial version
+ --     27 OCT 94   SAIC    Revised version
+ --     07 AUG 95   SAIC    Added Implementation_Check
+ --     07 FEB 96   SAIC    Changed to match new Impdef for 2.1
+ --     16 MAR 00   RLB     Changed foundation id to reflect test suite version.
+ --     22 MAR 01   RLB     Changed foundation id to reflect test suite version.
+ --     29 MAR 02   RLB     Changed foundation id to reflect test suite version.
+ --     06 MAR 07   RLB     Changed foundation id to reflect test suite version.
+ --
+ --!
+ 
+ package TCTouch is
+   Foundation_ID   : constant String := "TCTouch ACATS 2.6";
+   Max_Touch_Count : constant        := 80;
+ 
+   procedure Assert    ( SB_True  : Boolean; Message : String );
+   procedure Assert_Not( SB_False : Boolean; Message : String );
+ 
+   procedure Touch   ( A_Tag   : Character );
+   procedure Validate( Expected: String;
+                       Message : String;
+                       Order_Meaningful : Boolean := True );
+ 
+   procedure Flush;
+ 
+   type Special_Needs_Annexes is ( Annex_C, Annex_D, Annex_E,
+                                   Annex_F, Annex_G, Annex_H );
+ 
+   procedure Implementation_Check( Message : in String;
+                                   Annex   : in Special_Needs_Annexes
+                                           := Annex_C );
+     -- If Impdef.Validating_Annex_<Annex> is true, will call Report.Failed
+     -- otherwise will call Report.Not_Applicable.  This is to allow tests
+     -- which are driven by wording in the core of the language, yet have
+     -- their functionality dictated by the Special Needs Annexes to perform
+     -- dual purpose.
+     -- The default of Annex_C for the Annex parameter is to support early
+     -- tests written with the assumption that Implementation_Check was
+     -- expressly for use with the Systems Programming Annex.
+ 
+ end TCTouch;
+ 
+ with Report;
+ with Impdef;
+ package body TCTouch is
+ 
+   procedure Assert( SB_True : Boolean; Message : String ) is
+   begin
+     if not SB_True then
+       Report.Failed( "Assertion failed: " & Message );
+     end if;
+   end Assert;
+ 
+   procedure Assert_Not( SB_False : Boolean; Message : String ) is
+   begin
+     if SB_False then
+       Report.Failed( "Assertion failed: " & Message );
+     end if;
+   end Assert_Not;
+ 
+   Collection : String(1..Max_Touch_Count);
+   Finger     : Natural := 0;
+ 
+   procedure Touch ( A_Tag : Character ) is
+   begin
+     Finger := Finger+1;
+     Collection(Finger) := A_Tag;
+   exception
+     when Constraint_Error =>
+       Report.Failed("Trace Overflow: " & Collection);
+       Finger := 0;
+   end Touch;
+ 
+   procedure Sort_String( S: in out String ) is
+   -- algorithm from Booch Components Page 472
+     No_Swaps : Boolean;
+     procedure Swap(C1, C2: in out Character) is
+       T: Character := C1;
+     begin  C1 := C2; C2 := T; end Swap;
+   begin
+     for OI in S'First+1..S'Last loop
+       No_Swaps := True;
+       for II in reverse OI..S'Last loop
+         if S(II) < S(II-1) then
+           Swap(S(II),S(II-1));
+           No_Swaps := False;
+         end if;
+       end loop;
+       exit when No_Swaps;
+     end loop;
+   end Sort_String;
+ 
+   procedure Validate( Expected: String;
+                       Message : String;
+                       Order_Meaningful : Boolean := True) is
+     Want : String(1..Expected'Length) := Expected;
+   begin
+     if not Order_Meaningful then
+       Sort_String( Want );
+       Sort_String( Collection(1..Finger) );
+     end if;
+     if Collection(1..Finger) /= Want then
+       Report.Failed( Message & " Expecting: " & Want
+ 			     & " Got: " & Collection(1..Finger) );
+     end if;
+     Finger := 0;
+   end Validate;
+ 
+   procedure Flush is
+   begin
+     Finger := 0;
+   end Flush;
+ 
+   procedure Implementation_Check( Message : in String;
+                                   Annex   : in Special_Needs_Annexes
+                                           := Annex_C ) is
+                                           -- default to cover some legacy
+   -- USAGE DISCIPLINE:
+   --   Implementation_Check is designed to be used in tests that have
+   --   interdependency on one of the Special Needs Annexes, yet are _really_
+   --   tests based in the core language.  There will be instances where the
+   --   execution of a test would be failing in the light of the requirements
+   --   of the annex, yet from the point of view of the core language without
+   --   the additional requirements of the annex, the test does not apply.
+   --   In these cases, rather than issuing a call to Report.Failed, calling
+   --   TCTouch.Implementation_Check will check that sensitivity, and if
+   --   the implementation is attempting to validate against the specific
+   --   annex, Report.Failed will be called, otherwise, Report.Not_Applicable
+   --   will be called.
+   begin
+ 
+     case Annex is
+       when Annex_C =>
+         if ImpDef.Validating_Annex_C then
+           Report.Failed( Message );
+         else
+           Report.Not_Applicable( Message & " Annex C not supported" );
+        end if;
+ 
+       when Annex_D =>
+         if ImpDef.Validating_Annex_D then
+           Report.Failed( Message );
+         else
+           Report.Not_Applicable( Message & " Annex D not supported" );
+        end if;
+ 
+       when Annex_E =>
+         if ImpDef.Validating_Annex_E then
+           Report.Failed( Message );
+         else
+           Report.Not_Applicable( Message & " Annex E not supported" );
+        end if;
+ 
+       when Annex_F =>
+         if ImpDef.Validating_Annex_F then
+           Report.Failed( Message );
+         else
+           Report.Not_Applicable( Message & " Annex F not supported" );
+        end if;
+ 
+       when Annex_G =>
+         if ImpDef.Validating_Annex_G then
+           Report.Failed( Message );
+         else
+           Report.Not_Applicable( Message & " Annex G not supported" );
+        end if;
+ 
+       when Annex_H =>
+         if ImpDef.Validating_Annex_H then
+           Report.Failed( Message );
+         else
+           Report.Not_Applicable( Message & " Annex H not supported" );
+        end if;
+     end case;
+  end Implementation_Check;
+ 
+ end TCTouch;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/tsttests.dat gcc-16-20250525/gcc/testsuite/ada/acats-2/support/tsttests.dat
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/tsttests.dat	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/tsttests.dat	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,38 ----
+ ACATS4GNATDIR/tests/a/a26007a.tst
+ ACATS4GNATDIR/tests/a/ad8011a.tst
+ ACATS4GNATDIR/tests/c2/c23003a.tst
+ ACATS4GNATDIR/tests/c2/c23003b.tst
+ ACATS4GNATDIR/tests/c2/c23003g.tst
+ ACATS4GNATDIR/tests/c2/c23003i.tst
+ ACATS4GNATDIR/tests/c3/c35502d.tst
+ ACATS4GNATDIR/tests/c3/c35502f.tst
+ ACATS4GNATDIR/tests/c3/c35503d.tst
+ ACATS4GNATDIR/tests/c3/c35503f.tst
+ ACATS4GNATDIR/tests/c4/c45231d.tst
+ ACATS4GNATDIR/tests/c4/c4a007a.tst
+ ACATS4GNATDIR/tests/c8/c87b62d.tst
+ ACATS4GNATDIR/tests/c9/c96005b.tst
+ ACATS4GNATDIR/tests/cc/cc1225a.tst
+ ACATS4GNATDIR/tests/cd/cd1009k.tst
+ ACATS4GNATDIR/tests/cd/cd1009t.tst
+ ACATS4GNATDIR/tests/cd/cd1009u.tst
+ ACATS4GNATDIR/tests/cd/cd1c03e.tst
+ ACATS4GNATDIR/tests/cd/cd1c06a.tst
+ ACATS4GNATDIR/tests/cd/cd2a83c.tst
+ ACATS4GNATDIR/tests/cd/cd2a91c.tst
+ ACATS4GNATDIR/tests/cd/cd2c11a.tst
+ ACATS4GNATDIR/tests/cd/cd2c11d.tst
+ ACATS4GNATDIR/tests/cd/cd4041a.tst
+ ACATS4GNATDIR/tests/cd/cd7101g.tst
+ ACATS4GNATDIR/tests/ce/ce2102c.tst
+ ACATS4GNATDIR/tests/ce/ce2102h.tst
+ ACATS4GNATDIR/tests/ce/ce2103a.tst
+ ACATS4GNATDIR/tests/ce/ce2103b.tst
+ ACATS4GNATDIR/tests/ce/ce2203a.tst
+ ACATS4GNATDIR/tests/ce/ce2403a.tst
+ ACATS4GNATDIR/tests/ce/ce3002b.tst
+ ACATS4GNATDIR/tests/ce/ce3002c.tst
+ ACATS4GNATDIR/tests/ce/ce3102b.tst
+ ACATS4GNATDIR/tests/ce/ce3107a.tst
+ ACATS4GNATDIR/tests/ce/ce3304a.tst
+ ACATS4GNATDIR/support/spprt13s.tst
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/support/widechr.a gcc-16-20250525/gcc/testsuite/ada/acats-2/support/widechr.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/support/widechr.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/support/widechr.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,294 ----
+ -- WIDECHR.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- DESCRIPTION:
+ --
+ --      This program reads C250001.AW and C250002.AW; translates a special
+ --      character sequence into characters and wide characters with positions
+ --      above ASCII.DEL.  The resulting tests are written as C250001.A and
+ --      C250002.A respectively.   This program may need to
+ --      be modified if the Wide_Character representation recognized by
+ --      your compiler differs from the Wide_Character
+ --      representation generated by the package Ada.Wide_Text_IO.
+ --      Modify this program as needed to translate that file.
+ --
+ --      A wide character is represented by an 8 character sequence:
+ --
+ --          ["abcd"]
+ --
+ --      where the character code represented is specified by four hexadecimal
+ --      digits, abcd, with letters in upper case. For example the wide
+ --      character with the code 16#AB13# is represented by the eight
+ --      character sequence:
+ --
+ --          ["AB13"]
+ --
+ -- ASSUMPTIONS:
+ --
+ --      The path for these files is specified in ImpDef.
+ --
+ -- SPECIAL REQUIREMENTS:
+ --
+ --     Compile, bind and execute this program.  It will process the ".AW"
+ --     tests, "translating" them to ".A" tests.
+ --
+ -- CHANGE HISTORY:
+ --      11 DEC 96   SAIC   ACVC 2.1 Release
+ --
+ --      11 DEC 96   Keith  Constructed initial release version
+ --!
+ 
+ with Ada.Text_IO;
+ with Ada.Wide_Text_IO;
+ with Ada.Strings.Fixed;
+ with Impdef;
+ 
+ procedure WideChr is
+ 
+   -- Debug
+   --
+   -- To have the program generate trace/debugging information, de-comment
+   -- the call to Put_Line
+ 
+   procedure Debug( S: String ) is
+   begin
+     null; -- Ada.Text_IO.Put_Line(S);
+   end Debug;
+ 
+   package TIO renames Ada.Text_IO;
+   package WIO renames Ada.Wide_Text_IO;
+   package SF renames Ada.Strings.Fixed;
+ 
+   In_File : TIO.File_Type;
+ 
+   -- This program is actually dual-purpose.  It translates the ["xxxx"]
+   -- notation to Wide_Character, as well as a similar notation ["xx"] into
+   -- Character.  The intent of the latter being the ability to represent
+   -- literals in the Latin-1 character set that have position numbers
+   -- greater than ASCII.DEL.  The variable Output_Mode drives the algorithms
+   -- to generate Wide_Character output (Wide) or Character output (Narrow).
+ 
+   type Output_Modes is ( Wide, Narrow );
+   Output_Mode : Output_Modes := Wide;
+ 
+   Wide_Out   : WIO.File_Type;
+   Narrow_Out : TIO.File_Type;
+ 
+   In_Line   : String(1..132); -- SB: $MAX_LINE_LENGTH
+ 
+   -- Index variables
+   -- 
+   -- the following index variables: In_Length, Front, Open_Bracket and
+   -- Close_Bracket are used by the scanning software to keep track of
+   -- what's where.
+   --
+   -- In_Length stores the value returned by Ada.Text_IO.Get_Line indicating
+   -- the position of the last "useful" character in the string In_Line.
+   --
+   -- Front retains the index of the first non-translating character in
+   -- In_Line, it is used to indicate the starting index of the portion of
+   -- the string to save without special interpretation.  In the example
+   -- below, where there are two consecutive characters to translate, we see
+   -- that Front will assume three different values processing the string,
+   -- these are indicated by the digits '1', '2' & '3' in the comment
+   -- attached to the declaration.  The processing software will dump
+   -- In_Line(Front..Open_Bracket-1) to the output stream.  Note that in
+   -- the second case, this results in a null string, and in the third case,
+   -- where Open_Bracket does not obtain a third value, the slice
+   -- In_Line(Front..In_Length) is used instead.
+   --
+   -- Open_Bracket and Close_Bracket are used to retain the starting index
+   -- of the character pairs [" and "] respectively.  For the purposes of
+   -- this software the character pairs are what are considered to be the
+   -- "brackets" enclosing the hexadecimal values to be translated.
+   --  Looking at the example below you will see where these index variables
+   -- will "point" in the first and second case.
+ 
+   In_Length     : Natural := 0;  --->  Some_["0A12"]["0B13"]_Thing
+   Front         : Natural := 0;  --  1              2       3
+   Open_Bracket  : Natural := 0;  --         1       2
+   Close_Bracket : Natural := 0;  --               1       2
+ 
+   -- Xlation
+   --
+   -- This translation table gives an easy way to translate the "decimal"
+   -- value of a hex digit (as represented by a Latin-1 character)
+ 
+   type Xlate is array(Character range '0'..'F') of Natural;
+   Xlation : constant Xlate :=
+             ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
+              '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
+              'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
+              'F' => 15,
+              others => 0);
+ 
+   -- To_Ch
+   --
+   -- This function takes a string which is assumed to be trimmed to just a
+   -- hexadecimal representation of a Latin-1 character.  The result of the
+   -- function is the Latin-1 character at the position designated by the
+   -- incoming hexadecimal value.  (hexadecimal in human readable form)
+ 
+   function To_Ch( S:String ) return Character is
+     Numerical : Natural := 0;
+   begin
+     Debug("To Wide: " & S);
+     for I in S'Range loop
+       Numerical := Numerical * 16 + Xlation(S(I));
+     end loop;
+     return Character'Val(Numerical);
+   exception
+     when Constraint_Error => return '_';
+   end To_Ch;
+ 
+   -- To_Wide
+   --
+   -- This function takes a string which is assumed to be trimmed to just a
+   -- hexadecimal representation of a Wide_character.  The result of the
+   -- function is the Wide_character at the position designated by the
+   -- incoming hexadecimal value.  (hexadecimal in human readable form)
+ 
+   function To_Wide( S:String ) return Wide_character is
+     Numerical : Natural := 0;
+   begin
+     Debug("To Wide: " & S);
+     for I in S'Range loop
+       Numerical := Numerical * 16 + Xlation(S(I));
+     end loop;
+     return Wide_Character'Val(Numerical);
+   exception
+     when Constraint_Error => return '_';
+   end To_Wide;
+ 
+   -- Make_Wide
+   --
+   -- this function converts a String to a Wide_String
+ 
+   function Make_Wide( S: String ) return Wide_String is
+     W: Wide_String(S'Range);
+   begin
+     for I in S'Range loop
+       W(I) := Wide_Character'Val( Character'Pos(S(I)) );
+     end loop;
+     return W;
+   end Make_Wide;
+ 
+   -- Close_Files
+   --
+   -- Depending on which input we've processed, close the output file
+ 
+   procedure Close_Files is
+   begin
+     TIO.Close(In_File);
+     if Output_Mode = Wide then
+       WIO.Close(Wide_Out);
+     else
+       TIO.Close(Narrow_Out);
+     end if;
+   end Close_Files;
+ 
+   -- Process
+   --
+   -- for all lines in the input file
+   --   scan the file for occurrences of [" and "]
+   --     for found occurrence, attempt translation of the characters found
+   --     between the brackets.  As a safeguard, unrecognizable character
+   --     sequences will be replaced with the underscore character.  This
+   --     handles the cases in the tests where the test documentation includes
+   --     examples that are non-conformant: i.e. ["abcd"] or ["XXXX"]
+ 
+   procedure Process( Input_File_Name: String ) is
+   begin
+     TIO.Open(In_File,TIO.In_File,Input_File_Name & ".aw" );
+ 
+     if Output_Mode = Wide then
+       WIO.Create(Wide_Out,WIO.Out_File, Input_File_Name & ".a" );
+     else
+       TIO.Create(Narrow_Out,TIO.Out_File, Input_File_Name & ".a" );
+     end if;
+ 
+     File: while not TIO.End_Of_File( In_File ) loop
+       In_Line := (others => ' ');
+       TIO.Get_Line(In_File,In_Line,In_Length);
+       Debug(In_Line(1..In_Length));
+ 
+       Front := 1;
+ 
+       Line: loop
+ 	     -- scan for next occurrence of ["abcd"]
+ 	     Open_Bracket := SF.Index( In_Line(Front..In_Length), "[""" );
+ 	     Close_Bracket := SF.Index( In_Line(Front..In_Length), """]" );
+ 	     Debug( "[=" & Natural'Image(Open_Bracket) );
+ 	     Debug( "]=" & Natural'Image(Close_Bracket) );
+ 
+ 	     if Open_Bracket = 0 or Close_Bracket = 0 then
+         -- done with the line, output remaining characters and exit
+ 	       Debug("Done with line");
+ 	       if Output_Mode = Wide then
+ 	         WIO.Put_Line(Wide_Out, Make_Wide(In_Line(Front..In_Length)) );
+ 	       else
+ 	         TIO.Put_Line(Narrow_Out, In_Line(Front..In_Length) );
+ 	       end if;
+ 	       exit Line;
+ 	     else
+ 	       -- output the "normal" stuff up to the bracket
+ 	       if Output_Mode = Wide then
+ 	         WIO.Put(Wide_Out, Make_Wide(In_Line(Front..Open_Bracket-1)) );
+ 	       else
+ 	         TIO.Put(Narrow_Out, In_Line(Front..Open_Bracket-1) );
+ 	       end if;
+ 
+ 	       -- point beyond the closing bracket
+ 	       Front := Close_Bracket +2;
+ 
+ 	       -- output the translated hexadecimal character
+ 	       if Output_Mode = Wide then
+ 	         WIO.Put(Wide_Out,
+ 	              	    To_Wide( In_Line(Open_Bracket+2..Close_Bracket-1) ));
+ 	       else
+ 	         TIO.Put(Narrow_Out,
+ 		                    To_Ch( In_Line(Open_Bracket+2..Close_Bracket-1)) );
+ 	       end if;
+      	end if;
+       end loop Line;
+ 
+     end loop File;
+     
+     Close_Files;
+   exception
+     when others =>
+       Ada.Text_IO.Put_Line("Error in processing " & Input_File_Name);
+       raise;
+   end Process;
+ 
+ begin
+ 
+   Output_Mode := Wide;
+   Process( Impdef.Wide_Character_Test );
+ 
+   Output_Mode := Narrow;
+   Process( Impdef.Upper_Latin_Test );
+ 
+ end WideChr;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a22006b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a22006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a22006b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a22006b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,38 ----
+ -- A22006B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT HORIZONTAL TABULATION CAN BE USED WITHIN AND OUTSIDE OF
+ -- COMMENTS.
+ 
+ -- JBG 5/26/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A22006B IS
+ BEGIN
+ 	TEST ("A22006B", "CHECK USE OF HT IN AND OUT OF COMMENTS");
+      -- PRECEDING LINE CONTAINED A LEADING HT
+      -- NEXT LINE CONTAINS A TAB INSIDE A COMMENT
+      -- HERE IS HT =>	<= CHARACTER IN A COMMENT
+      RESULT;	-- TAB PRECEDES THIS COMMENT
+ END A22006B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a22006c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a22006c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a22006c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a22006c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ 
+ 
+ 
+ -- A22006C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A COMPILATION MAY BE PRECEDED BY EXTRA LINES
+ -- (INCLUDING LINES TERMINATED BY FORMAT EFFECTORS OTHER
+ --  THAN HORIZONTAL TABULATION).
+ 
+ -- NOTE: THIS FILE BEGINS WITH:
+ --       1) AN EMPTY LINE
+ --       2) A CARRIAGE RETURN CHARACTER       (ASCII 13. = 0D HEX)
+ --       3) A CARRIAGE RETURN CHARACTER       (ASCII 13. = 0D HEX)
+ --       4) A VERTICAL TABULATION CHARACTER   (ASCII 11. = 0B HEX)
+ --       5) A LINE FEED CHARACTER             (ASCII 10. = 0A HEX)
+ --       6) A LINE FEED CHARACTER             (ASCII 10. = 0A HEX)
+ --       7) A FORM FEED CHARACTER             (ASCII 12. = 0C HEX)
+ 
+ -- PWB  2/13/86
+ 
+ WITH REPORT;
+ USE  REPORT;
+ 
+ PROCEDURE A22006C IS
+ BEGIN
+      TEST ("A22006C", "CHECK THAT A COMPILATION CAN BE PRECEDED " &
+                       "BY EXTRA LINES");
+      RESULT;
+ END A22006C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a22006d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a22006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a22006d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a22006d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,41 ----
+     	-- A22006D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A COMPILATION CAN BE PRECEDED BY SPACES AND
+ -- HORIZONTAL TABULATION CHARACTERS.
+ 
+ -- NOTE: THE FIRST LINE OF THIS FILE BEGINS WITH FOUR SPACE
+ --       CHARACTERS AND A HORIZONTAL TABULATION CHARACTER
+ 
+ -- PWB  2/13/86
+ 
+ WITH REPORT;
+ USE  REPORT;
+ 
+ PROCEDURE A22006D IS
+ BEGIN
+      TEST ("A22006D", "CHECK THAT A COMPILATION CAN BE PRECEDED " &
+                       "BY SPACE AND HORIZONTAL TABULATION CHARACTERS");
+      RESULT;
+ END A22006D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a26007a.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a26007a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a26007a.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a26007a.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,48 ----
+ -- A26007A.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A STRING LITERAL HAVING THE MAXIMUM PERMITTED LINE LENGTH
+ -- CAN BE GENERATED.
+ 
+ -- TBN 3/5/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A26007A IS
+ 
+      MAX_LEN_STRING_LIT : STRING (1 .. $MAX_IN_LEN - 2);
+ 
+      -- MAX_IN_LEN IS THE MAXIMUM LINE LENGTH PERMITTED.
+ 
+ BEGIN
+      TEST ("A26007A", "CHECK THAT A STRING LITERAL HAVING THE " &
+                       "MAXIMUM PERMITTED LINE LENGTH CAN BE GENERATED");
+ 
+      MAX_LEN_STRING_LIT :=
+ $MAX_STRING_LITERAL
+ ;
+      -- MAX_STRING_LITERAL IS A STRING LITERAL THAT IS MAXIMUM LENGTH.
+      -- QUOTES ARE COUNTED AS PART OF THE STRING LITERAL.
+ 
+      RESULT;
+ END A26007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a27003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a27003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a27003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a27003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ -- A27003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN A STRING LITERAL, CONSECUTIVE HYPHENS
+ -- ARE PERMITTED WITHOUT INDICATING A COMMENT,
+ -- AND THAT IN A COMMENT, A SINGLE DOUBLE-QUOTE IS
+ -- PERMITTED WITHOUT INDICATING A STRING LITERAL.
+ 
+ -- PWB  03/04/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A27003A IS
+ 
+      -- COMMENT :  "  IS PERMITTED HERE.
+ 
+      STR1 : CONSTANT STRING := "AB--C";
+      STR2 : STRING (1..10);
+ 
+ BEGIN
+ 
+      TEST ("A27003A", "CONSECUTIVE HYPHENS PERMITTED IN " &
+                       "STRING LITERAL, AND QUOTE PERMITTED " &
+                       "IN COMMENT");
+ 
+      STR2 := STR1 & "--ABC";
+      -- COMMENT : " IS PERMITTED HERE.
+ 
+      RESULT;
+ 
+ END A27003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a29003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a29003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a29003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a29003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- A29003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL PREDEFINED ATTRIBUTES EXCEPT DIGITS, DELTA, AND RANGE,
+ -- AND ALL PREDEFINED TYPE AND PACKAGE NAMES ARE NOT RESERVED WORDS.
+ 
+ -- AH  8/11/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A29003A IS
+      SUBTYPE INT IS INTEGER;
+ 
+ -- PREDEFINED ATTRIBUTES
+ 
+      ADDRESS           : INT := IDENT_INT(0);        -- ATTRIBUTE
+      AFT               : INT := IDENT_INT(0);        -- ATTRIBUTE
+      BASE              : INT := IDENT_INT(0);        -- ATTRIBUTE
+      CALLABLE          : INT := IDENT_INT(0);        -- ATTRIBUTE
+      CONSTRAINED       : INT := IDENT_INT(0);        -- ATTRIBUTE
+      COUNT             : INT := IDENT_INT(0);        -- ATTRIBUTE
+      EMAX              : INT := IDENT_INT(0);        -- ATTRIBUTE
+      EPSILON           : INT := IDENT_INT(0);        -- ATTRIBUTE
+      FIRST             : INT := IDENT_INT(0);        -- ATTRIBUTE
+      FIRST_BIT         : INT := IDENT_INT(0);        -- ATTRIBUTE
+      FORE              : INT := IDENT_INT(0);        -- ATTRIBUTE
+      IMAGE             : INT := IDENT_INT(0);        -- ATTRIBUTE
+      LARGE             : INT := IDENT_INT(0);        -- ATTRIBUTE
+      LAST              : INT := IDENT_INT(0);        -- ATTRIBUTE
+      LAST_BIT          : INT := IDENT_INT(0);        -- ATTRIBUTE
+      LENGTH            : INT := IDENT_INT(0);        -- ATTRIBUTE
+      MACHINE_EMAX      : INT := IDENT_INT(0);        -- ATTRIBUTE
+      MACHINE_EMIN      : INT := IDENT_INT(0);        -- ATTRIBUTE
+      MACHINE_MANTISSA  : INT := IDENT_INT(0);        -- ATTRIBUTE
+      MACHINE_OVERFLOWS : INT := IDENT_INT(0);        -- ATTRIBUTE
+      MACHINE_RADIX     : INT := IDENT_INT(0);        -- ATTRIBUTE
+      MACHINE_ROUNDS    : INT := IDENT_INT(0);        -- ATTRIBUTE
+      MANTISSA          : INT := IDENT_INT(0);        -- ATTRIBUTE
+      POS               : INT := IDENT_INT(0);        -- ATTRIBUTE
+      POSITION          : INT := IDENT_INT(0);        -- ATTRIBUTE
+      PRED              : INT := IDENT_INT(0);        -- ATTRIBUTE
+      SAFE_EMAX         : INT := IDENT_INT(0);        -- ATTRIBUTE
+      SAFE_LARGE        : INT := IDENT_INT(0);        -- ATTRIBUTE
+      SAFE_SMALL        : INT := IDENT_INT(0);        -- ATTRIBUTE
+      SIZE              : INT := IDENT_INT(0);        -- ATTRIBUTE
+      SMALL             : INT := IDENT_INT(0);        -- ATTRIBUTE
+      STORAGE_SIZE      : INT := IDENT_INT(0);        -- ATTRIBUTE
+      SUCC              : INT := IDENT_INT(0);        -- ATTRIBUTE
+      TERMINATED        : INT := IDENT_INT(0);        -- ATTRIBUTE
+      VAL               : INT := IDENT_INT(0);        -- ATTRIBUTE
+      VALUE             : INT := IDENT_INT(0);        -- ATTRIBUTE
+      WIDTH             : INT := IDENT_INT(0);        -- ATTRIBUTE
+ 
+ -- PREDEFINED TYPES
+ 
+      BOOLEAN   : INT := IDENT_INT(0);                -- TYPE
+      CHARACTER : INT := IDENT_INT(0);                -- TYPE
+      DURATION  : INT := IDENT_INT(0);                -- TYPE
+      FLOAT     : INT := IDENT_INT(0);                -- TYPE
+      INTEGER   : INT := IDENT_INT(0);                -- TYPE
+      NATURAL   : INT := IDENT_INT(0);                -- TYPE
+      POSITIVE  : INT := IDENT_INT(0);                -- TYPE
+      STRING    : INT := IDENT_INT(0);                -- TYPE
+ 
+ -- PREDEFINED PACKAGE NAMES
+ 
+      ASCII                  : INT := IDENT_INT(0);     -- PACKAGE
+      CALENDAR               : INT := IDENT_INT(0);     -- PACKAGE
+      DIRECT_IO              : INT := IDENT_INT(0);     -- PACKAGE
+      IO_EXCEPTIONS          : INT := IDENT_INT(0);     -- PACKAGE
+      LOW_LEVEL_IO           : INT := IDENT_INT(0);     -- PACKAGE
+      MACHINE_CODE           : INT := IDENT_INT(0);     -- PACKAGE
+      SEQUENTIAL_IO          : INT := IDENT_INT(0);     -- PACKAGE
+      SYSTEM                 : INT := IDENT_INT(0);     -- PACKAGE
+      TEXT_IO                : INT := IDENT_INT(0);     -- PACKAGE
+      UNCHECKED_CONVERSION   : INT := IDENT_INT(0);     -- PACKAGE
+      UNCHECKED_DEALLOCATION : INT := IDENT_INT(0);     -- PACKAGE
+ 
+ BEGIN
+      TEST("A29003A", "NO ADDITIONAL RESERVED WORDS");
+      RESULT;
+ END A29003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a2a031a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a2a031a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a2a031a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a2a031a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- A2A031A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXCLAMATION MARK CAN REPLACE A VERTICAL BAR WHEN THE
+ -- VERTICAL BAR IS USED AS A SEPARATOR.
+ 
+ -- CONTEXTS ARE:
+ --   AS A CHOICE IN A VARIANT PART
+ --   IN A DISCRIMINANT CONSTRAINT
+ --   IN A CASE STATEMENT CHOICE
+ --   IN AN AGGREGATE
+ --   IN AN EXCEPTION HANDLER.
+ 
+ -- JBG 5/25/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A2A031A IS
+ 
+      TYPE ENUM IS (E1, E2, E3);
+      TYPE REC (A, B : ENUM) IS
+           RECORD
+                C : INTEGER;
+                CASE A IS
+                     WHEN E1 ! E2 =>     -- CHOICE OF VARIANT.
+                          D : INTEGER;
+                     WHEN E3 =>
+                          E : FLOAT;
+                END CASE;
+           END RECORD;
+ 
+      EX1, EX2, EX3 : EXCEPTION;
+ 
+      VAR  : REC (A!B => E2);            -- DISCRIMINANT CONSTRAINT.
+ 
+      EVAR : ENUM := E2;
+ 
+ BEGIN
+ 
+      TEST ("A2A031A", "CHECK USE OF ! AS SEPARATOR IN PLACE OF |");
+ 
+      CASE EVAR IS
+           WHEN E3 => NULL;
+           WHEN E2!E1 => NULL;           -- CASE STATEMENT CHOICE.
+      END CASE;
+ 
+      VAR := (A!B => E2, C ! D => 0);    -- AGGREGATE.
+ 
+      RESULT;
+ EXCEPTION
+      WHEN EX1!EX2 ! EX3 => NULL;        -- EXCEPTION HANDLER.
+ END A2A031A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a33003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a33003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a33003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a33003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,49 ----
+ -- A33003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FOLLOWING FORMS OF ALMOST RECURSIVE TYPES CAN BE
+ -- DECLARED:
+ --     A) A RECORD HAVING A COMPONENT OF AN ACCESS TYPE WHOSE DESIGNATED
+ --        TYPE IS THE RECORD TYPE;
+ 
+ -- TBN  10/6/86
+ -- DTN 11/12/91     DELETED SUBPARTS (B and C).
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A33003A IS
+ 
+      TYPE REC;
+      TYPE ACC_REC IS ACCESS REC;
+      TYPE REC IS
+           RECORD
+                A : INTEGER;
+                B : ACC_REC;
+           END RECORD;
+ 
+ BEGIN
+      TEST ("A33003A", "CHECK THAT ALMOST RECURSIVE TYPES CAN BE " &
+                       "DECLARED");
+ 
+      RESULT;
+ END A33003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a34017c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a34017c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a34017c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a34017c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- A34017C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A DERIVED TYPE DEFINITION IS GIVEN IN THE VISIBLE PART
+ -- OF A PACKAGE, THE TYPE MAY BE USED AS THE PARENT TYPE IN A DERIVED
+ -- TYPE DEFINITION IN THE PRIVATE PART OF THE PACKAGE AND IN THE BODY.
+ 
+ -- CHECK THAT IF A TYPE IS DECLARED IN THE VISIBLE PART OF A PACKAGE,
+ -- AND IS NOT A DERIVED TYPE OR A PRIVATE TYPE, IT MAY BE USED AS THE
+ -- PARENT TYPE IN A DERIVED TYPE DEFINITION IN THE VISIBLE PART, PRIVATE
+ -- PART, AND BODY.
+ 
+ 
+ -- DSJ 4/27/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE A34017C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "A34017C", "CHECK THAT A DERIVED TYPE MAY BE USED AS A " &
+                       "PARENT TYPE IN THE PRIVATE PART AND BODY.  " &
+                       "CHECK THAT OTHER TYPES MAY BE USED AS PARENT " &
+                       "TYPES IN VISIBLE PART ALSO");
+ 
+      DECLARE
+ 
+           TYPE REC IS
+                RECORD
+                     C : INTEGER;
+                END RECORD;
+ 
+           PACKAGE PACK1 IS
+ 
+                TYPE T1 IS RANGE 1 .. 10;
+                TYPE T2 IS NEW REC;
+ 
+                TYPE T3 IS (A,B,C);
+                TYPE T4 IS ARRAY ( 1 .. 2 ) OF INTEGER;
+                TYPE T5 IS
+                     RECORD
+                          X : CHARACTER;
+                     END RECORD;
+                TYPE T6 IS ACCESS INTEGER;
+ 
+                TYPE N1 IS NEW T3;
+                TYPE N2 IS NEW T4;
+                TYPE N3 IS NEW T5;
+                TYPE N4 IS NEW T6;
+ 
+           PRIVATE
+ 
+                TYPE P1 IS NEW T1;
+                TYPE P2 IS NEW T2;
+                TYPE P3 IS NEW T3;
+                TYPE P4 IS NEW T4;
+                TYPE P5 IS NEW T5;
+                TYPE P6 IS NEW T6;
+ 
+           END PACK1;
+ 
+           PACKAGE BODY PACK1 IS
+      
+                TYPE Q1 IS NEW T1;
+                TYPE Q2 IS NEW T2;
+                TYPE Q3 IS NEW T3;
+                TYPE Q4 IS NEW T4;
+                TYPE Q5 IS NEW T5;
+                TYPE Q6 IS NEW T6;
+ 
+           END PACK1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END A34017C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35101b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35101b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35101b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35101b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- A35101B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ONE ENUMERATION LITERAL IS PERMITTED IN AN ENUMERATION
+ -- TYPE DEFINITION.
+ 
+ -- RJW 2/14/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE A35101B IS
+ 
+ BEGIN
+ 
+      TEST ("A35101B", "CHECK THAT ONE ENUMERATION LITERAL IS " &
+                       "PERMITTED IN AN ENUMERATION TYPE " &
+                       "DEFINITION" );
+      DECLARE
+ 
+           TYPE E1 IS (A);                         -- OK.
+           TYPE E2 IS ('1');                       -- OK.
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END A35101B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35402a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35402a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35402a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- A35402A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF AN INTEGER TYPE DEFINITION NEED NOT 
+ -- HAVE THE SAME INTEGER TYPE.
+ 
+ -- RJW 2/20/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE A35402A IS
+ 
+ BEGIN
+ 
+      TEST ( "A35402A", "CHECK THAT THE BOUNDS OF AN INTEGER " &
+                        "TYPE DEFINITION NEED NOT HAVE THE SAME " &
+                        "INTEGER TYPE" );
+ 
+      DECLARE     
+           TYPE INT1 IS RANGE 1 .. 10;
+           TYPE INT2 IS RANGE 2 .. 8;
+           TYPE INT3 IS NEW INTEGER;
+      
+           I  : CONSTANT INTEGER   := 5;
+           I1 : CONSTANT INT1      := 5;
+           I2 : CONSTANT INT2      := 5;
+           I3 : CONSTANT INT3      := 5;
+      
+           TYPE INTRANGE1 IS RANGE I  .. I1;          -- OK.
+ 
+           TYPE INTRANGE2 IS RANGE I1 .. I2;          -- OK.
+ 
+           TYPE INTRANGE3 IS RANGE I2 .. I3;          -- OK.
+           
+           TYPE INTRANGE4 IS RANGE I3 .. I;           -- OK.
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END A35402A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35801f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35801f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35801f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35801f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- A35801F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES FIRST AND LAST RETURN VALUES HAVING THE
+ -- SAME BASE TYPE AS THE PREFIX WHEN THE PREFIX IS A FLOATING POINT
+ -- TYPE.
+ 
+ -- THIS CHECK IS PROVIDED THROUGH THE USE OF THIS TEST IN CONJUNCTION
+ -- WITH TEST B35801C.
+ 
+ -- R.WILLIAMS 8/21/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A35801F IS
+ 
+      TYPE REAL IS DIGITS 3 RANGE -100.0 .. 100.0;
+      SUBTYPE SURREAL IS REAL RANGE -50.0 .. 50.0;
+ 
+      TYPE NFLT IS NEW FLOAT;
+      SUBTYPE UNIT IS NFLT RANGE -1.0 .. 1.0;     
+ 
+      SUBTYPE EMPTY IS FLOAT RANGE 1.0 .. -1.0;
+ 
+      R1 : REAL := SURREAL'FIRST;       -- OK.
+      R2 : REAL := SURREAL'LAST;        -- OK.
+ 
+      N1 : NFLT := UNIT'FIRST;          -- OK.
+      N2 : NFLT := UNIT'LAST;           -- OK.
+ 
+      F1 : FLOAT := FLOAT'FIRST;        -- OK.
+      F2 : FLOAT := FLOAT'LAST;         -- OK.
+ 
+      E1 : FLOAT := EMPTY'FIRST;        -- OK.
+      E2 : FLOAT := EMPTY'LAST;         -- OK.
+ 
+ BEGIN
+      TEST ( "A35801F", "CHECK THAT THE ATTRIBUTES FIRST AND LAST " &
+                        "RETURN VALUES HAVING THE SAME BASE TYPE AS " &
+                        "THE PREFIX WHEN THE PREFIX IS A FLOATING " &
+                        "POINT TYPE" );
+ 
+      RESULT;
+ END A35801F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35902c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35902c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a35902c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a35902c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ -- A35902C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A FIXED POINT TYPE WITH ONLY ONE MODEL NUMBER IS
+ --     ALLOWED.
+ 
+ -- HISTORY:
+ --     RJW 02/26/86 CREATED ORIGINAL TEST.
+ --     DHH 10/15/87 CORRECTED RANGE ERRORS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE A35902C IS
+ 
+ BEGIN
+ 
+      TEST ("A35902C", "CHECK THAT A FIXED POINT TYPE WITH ONLY ONE " &
+                       "MODEL NUMBER IS ALLOWED" );
+      DECLARE
+           TYPE F IS DELTA 1.0 RANGE -0.5 .. 0.5;   -- OK.
+           F1 : F := 0.0;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END A35902C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a38106d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a38106d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a38106d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a38106d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- A38106D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE
+ -- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON
+ -- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE
+ -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
+ -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE
+ -- INCOMPLETE TYPE.
+ 
+ -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES
+ -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES
+ -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY
+ --     TYPES
+ 
+ -- PART 1: FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE SPECIFICATION.
+ 
+ -- DSJ  5/05/83
+ -- SPS 10/18/83
+ -- EG  12/19/83
+ 
+ WITH REPORT ;
+ PROCEDURE A38106D IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("A38106D", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS "    &
+                     "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " &
+                     "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE "   &
+                     "ACCESS TYPE AND AFTER THE FULL DECLARATION "     &
+                     "(WHICH IS IN THE PACKAGE SPECIFICATION)") ;
+ 
+      DECLARE
+ 
+           PACKAGE PACK1 IS
+                TYPE T1 ;
+                TYPE T2 ;
+ 
+                PACKAGE PACK2 IS
+                     TYPE ACC1 IS ACCESS T1 ;
+                     TYPE ACC2 IS ACCESS T2 ;
+                END PACK2 ;
+ 
+                TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
+                TYPE T2 IS
+                     RECORD
+                          C1, C2 : INTEGER ;
+                     END RECORD ;
+           END PACK1 ;
+ 
+           PACKAGE BODY PACK1 IS
+                A1 : PACK2.ACC1 := NEW T1'(2,4) ;  -- LEGAL
+                A2 : PACK2.ACC1 := NEW T1'(6,8) ;  -- LEGAL
+                R1 : PACK2.ACC2 := NEW T2'(3,5) ;  -- LEGAL
+                R2 : PACK2.ACC2 := NEW T2'(7,9) ;  -- LEGAL
+ 
+                PACKAGE BODY PACK2 IS
+                     X1 : INTEGER := A1(1) ;            -- LEGAL
+                     X2 : INTEGER := A1'FIRST ;         -- LEGAL
+                     X3 : INTEGER := A1'LAST ;          -- LEGAL
+                     X4 : INTEGER := A1'LENGTH ;        -- LEGAL
+                     B1 : BOOLEAN := 3 IN A1'RANGE ;    -- LEGAL
+                     X5 : INTEGER := R1.C1 ;            -- LEGAL
+                END PACK2 ;
+ 
+           END PACK1 ;
+ 
+      BEGIN
+ 
+           NULL ;
+ 
+      END ;
+ 
+      RESULT ;
+ 
+ END A38106D ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a38106e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a38106e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a38106e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a38106e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- A38106E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE
+ -- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON
+ -- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE
+ -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
+ -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE
+ -- INCOMPLETE TYPE.
+ 
+ -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES
+ -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES
+ -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY
+ --     TYPES
+ 
+ -- PART 2 : FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE BODY
+ 
+ -- DSJ  5/05/83
+ -- SPS 10/18/83
+ -- EG  12/19/83
+ 
+ WITH REPORT ;
+ PROCEDURE A38106E IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("A38106E", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS " &
+                     "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " &
+                     "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE "   &
+                     "ACCESS TYPE AND AFTER THE FULL DECLARATION "     &
+                     "(WHICH IS IN THE PACKAGE BODY)");
+ 
+      DECLARE
+ 
+           PACKAGE PACK1 IS
+           PRIVATE
+                TYPE T1 ;
+                TYPE T2 ;
+                PACKAGE PACK2 IS
+                     TYPE ACC1 IS ACCESS T1 ;
+                     TYPE ACC2 IS ACCESS T2 ;
+                END PACK2 ;
+           END PACK1 ;
+ 
+           PACKAGE BODY PACK1 IS
+                TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
+                TYPE T2 IS
+                     RECORD
+                          C1, C2 : INTEGER ;
+                     END RECORD ;
+ 
+                A1 : PACK2.ACC1 := NEW T1'(2,4) ;  -- LEGAL
+                A2 : PACK2.ACC1 := NEW T1'(6,8) ;  -- LEGAL
+                R1 : PACK2.ACC2 := NEW T2'(3,5) ;  -- LEGAL
+                R2 : PACK2.ACC2 := NEW T2'(7,9) ;  -- LEGAL
+ 
+                PACKAGE BODY PACK2 IS
+                     X1 : INTEGER := A1(1) ;            -- LEGAL
+                     X2 : INTEGER := A1'FIRST ;         -- LEGAL
+                     X3 : INTEGER := A1'LAST ;          -- LEGAL
+                     X4 : INTEGER := A1'LENGTH ;        -- LEGAL
+                     B1 : BOOLEAN := 3 IN A1'RANGE ;    -- LEGAL
+                     X5 : INTEGER := R1.C1 ;            -- LEGAL
+                END PACK2 ;
+ 
+           END PACK1 ;
+ 
+      BEGIN
+ 
+           NULL ;
+ 
+      END ;
+ 
+      RESULT ;
+ 
+ END A38106E ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a49027a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a49027a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a49027a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a49027a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- A49027A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --   CHECK THAT A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE AND 
+ --   STATIC IN THE CORRESPONDING INSTANCE.
+ --   CHECK THAT FOR A GENERIC INSTANTIATION, IF THE ACTUAL PARAMETER
+ --   IS A STATIC SUBTYPE, THEN EVERY USE OF THE CORRESPONDING FORMAL
+ --   PARAMETER WITHIN THE INSTANCE IS CONSIDERED TO DENOTE A STATIC
+ --   SUBTYPE
+ --
+ -- THIS IS A TEST BASED ON AI-00409/05-BI-WJ.
+ 
+ -- HISTORY:
+ --         EDWARD V. BERARD, 27 AUGUST 1990
+ --         CJJ   10 OCT 1990  TEST OBJECTIVE CHANGED TO REFLECT AIG 
+ --                            OBJECTIVE.
+ 
+ WITH REPORT ;
+ 
+ PROCEDURE A49027A IS
+ 
+ BEGIN  -- A49027A
+ 
+     REPORT.TEST ("A49027A", "CHECK THAT A SUBTYPE CAN BE NONSTATIC " &
+                  "IN A GENERIC TEMPLATE AND STATIC IN THE " &
+                  "CORRESPONDING INSTANCE.") ;
+                  
+     LOCAL_BLOCK:
+     
+     DECLARE
+     
+         TYPE NUMBER IS RANGE 1 .. 10 ;
+         
+         GENERIC
+         
+             TYPE NUMBER_TYPE IS RANGE <> ;
+             
+         PACKAGE STATIC_TEST IS
+         
+             TYPE NEW_NUMBER_TYPE IS NEW NUMBER_TYPE ;
+             SUBTYPE SUB_NUMBER_TYPE IS NUMBER_TYPE ;
+ 
+         END STATIC_TEST ;
+         
+         PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST
+                                     (NUMBER_TYPE => NUMBER) ;
+                                     
+         TYPE ANOTHER_NUMBER IS RANGE 
+                 NEW_STATIC_TEST.NEW_NUMBER_TYPE'FIRST ..
+                 NEW_STATIC_TEST.NEW_NUMBER_TYPE'LAST ;
+         
+         TYPE YET_ANOTHER_NUMBER IS RANGE 
+                 NEW_STATIC_TEST.SUB_NUMBER_TYPE'FIRST ..
+                 NEW_STATIC_TEST.SUB_NUMBER_TYPE'LAST ;
+         
+     BEGIN  -- LOCAL_BLOCK
+     
+         NULL ;
+         
+     END LOCAL_BLOCK ;
+     
+     REPORT.RESULT ;
+     
+ END A49027A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a49027b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a49027b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a49027b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a49027b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- A49027B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --   CHECK THAT A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE
+ --   AND STATIC IN THE CORRESPONDING INSTANCE.
+ 
+ --   CHECK THAT IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE
+ --   CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE,
+ --   THEN EACH USE OF THE FORMAL PARAMETERS IN THE INSTANCE IS SAID TO
+ --   BE STATIC.
+ --
+ --   A NAME DENOTING A CONSTANT DECLARED IN A GENERIC INSTANCE IS
+ --   ALLOWED AS A PRIMARY IN A STATIC EXPRESSION IF THE CONSTANT
+ --   IS DECLARED BY A CONSTANT DECLARATION WITH A STATIC SUBTYPE
+ --   AND INITIALIZED WITH A STATIC EXPRESSION.
+ --
+ --   THIS IS A TEST BASED ON AI-00505/03-BI-WA.
+ 
+ -- HISTORY:
+ --         EDWARD V. BERARD, 27 AUGUST 1990
+ --         DAS   8 OCT 90   ADDED CODE TO MATCH EXAMPLE 1 IN
+ --                          AI-00505.
+ --         JRL 05/29/92  CORRECTED MINOR PROBLEM IN REPORT.TEST STRING.
+ --         JRL 02/18/93  EXPANDED TEXT OF REPORT.TEST STRING.
+ --         PWN 04/14/95  CORRECTED MINOR COPYRIGHT COMMENT PROBLEM.
+ 
+ 
+ WITH REPORT ;
+ 
+ PROCEDURE A49027B IS
+ 
+ BEGIN  -- A49027B
+ 
+      REPORT.TEST ("A49027B", "CHECK THAT IF A GENERIC ACTUAL " &
+                   "PARAMETER IS A STATIC EXPRESSION AND THE " &
+                   "CORRESPONDING FORMAL PARAMETER HAS A STATIC " &
+                   "SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " &
+                   "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE " &
+                   "STATIC. CHECK THAT A NAME DENOTING A CONSTANT " &
+                   "DECLARED IN A GENERIC INSTANCE IS ALLOWED AS " &
+                   "A PRIMARY IN A STATIC EXPRESSION IF THE " &
+                   "CONSTANT IS DECLARED BY A CONSTANT DECLARATION " &
+                   "WITH A STATIC SUBTYPE AND INITIALIZED WITH A " &
+                   "STATIC EXPRESSION. (AI-00505)");
+ 
+      LOCAL_BLOCK:
+ 
+      DECLARE
+ 
+           TYPE NUMBER IS RANGE 1 .. 10 ;
+           TYPE COLOR IS (RED, ORANGE, YELLOW, GREEN, BLUE) ;
+           MIDDLE_COLOR : CONSTANT COLOR := GREEN ;
+ 
+           ENUMERATED_VALUE : COLOR := COLOR'LAST ;
+ 
+           GENERIC
+ 
+                TYPE NUMBER_TYPE IS RANGE <> ;
+                X : INTEGER ;
+                TYPE ENUMERATED IS (<>) ;
+ 
+                FIRST_NUMBER            : IN NUMBER_TYPE ;
+                SECOND_NUMBER           : IN NUMBER_TYPE ;
+                THIRD_NUMBER            : IN NUMBER_TYPE ;
+                FIRST_ENUMERATED        : IN ENUMERATED ;
+                SECOND_ENUMERATED       : IN ENUMERATED ;
+                THIRD_ENUMERATED        : IN ENUMERATED ;
+ 
+                FIRST_INTEGER_VALUE     : IN INTEGER ;
+                SECOND_INTEGER_VALUE    : IN INTEGER ;
+ 
+           PACKAGE STATIC_TEST IS
+ 
+                Y : CONSTANT INTEGER := X;
+                Z : CONSTANT NUMBER_TYPE := 5;
+ 
+                SUBTYPE FIRST_NUMBER_SUBTYPE IS NUMBER_TYPE
+                    RANGE FIRST_NUMBER .. SECOND_NUMBER ;
+                SUBTYPE SECOND_NUMBER_SUBTYPE IS NUMBER_TYPE
+                    RANGE FIRST_NUMBER .. THIRD_NUMBER ;
+ 
+                SUBTYPE FIRST_ENUMERATED_SUBTYPE IS ENUMERATED
+                    RANGE FIRST_ENUMERATED .. SECOND_ENUMERATED ;
+                SUBTYPE SECOND_ENUMERATED_SUBTYPE IS ENUMERATED
+                    RANGE FIRST_ENUMERATED .. THIRD_ENUMERATED ;
+ 
+                SUBTYPE THIRD_NUMBER_TYPE IS INTEGER
+                    RANGE FIRST_INTEGER_VALUE .. SECOND_INTEGER_VALUE ;
+ 
+           END STATIC_TEST ;
+ 
+           PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST
+                    (NUMBER_TYPE            => NUMBER,
+                     X                      => 3,
+                     ENUMERATED             => COLOR,
+                     FIRST_NUMBER           => NUMBER'FIRST,
+                     SECOND_NUMBER          => NUMBER'LAST,
+                     THIRD_NUMBER           => NUMBER'SUCC(NUMBER'FIRST),
+                     FIRST_ENUMERATED       => RED,
+                     SECOND_ENUMERATED      => MIDDLE_COLOR,
+                     THIRD_ENUMERATED       => COLOR'VAL (1),
+                     FIRST_INTEGER_VALUE    => COLOR'POS (YELLOW),
+                     SECOND_INTEGER_VALUE   => NUMBER'POS (5)) ;
+ 
+           TYPE T1 IS RANGE 1 .. NEW_STATIC_TEST.Y;
+           TYPE T2 IS RANGE 1 .. NEW_STATIC_TEST.Z;
+ 
+           TYPE ANOTHER_NUMBER IS RANGE
+                    NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'FIRST ..
+                    NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'LAST ;
+ 
+           TYPE YET_ANOTHER_NUMBER IS RANGE
+                    NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'FIRST ..
+                    NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'LAST ;
+ 
+           TYPE STILL_ANOTHER_NUMBER IS RANGE
+                    NEW_STATIC_TEST.THIRD_NUMBER_TYPE'FIRST ..
+                    NEW_STATIC_TEST.THIRD_NUMBER_TYPE'LAST ;
+ 
+      BEGIN  -- LOCAL_BLOCK
+ 
+           CASE ENUMERATED_VALUE IS
+                 WHEN YELLOW      => NULL ;
+                 WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'FIRST
+                                  => NULL ;
+                 WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'LAST
+                                  => NULL ;
+                 WHEN NEW_STATIC_TEST.SECOND_ENUMERATED_SUBTYPE'LAST
+                                  => NULL ;
+                 WHEN COLOR'LAST  => NULL ;
+           END CASE ;
+ 
+      END LOCAL_BLOCK ;
+ 
+      REPORT.RESULT ;
+ 
+ END A49027B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a49027c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a49027c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a49027c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a49027c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- A49027C.ADA
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --   CHECK THAT IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE
+ --   CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE,
+ --   THEN EACH USE OF THE FORMAL PARAMETER IN THE INSTANCE IS SAID TO
+ --   BE STATIC.
+ --
+ --   SEE AI-00505.  THIS TEST IS TAKEN FROM THE SECOND EXAMPLE.
+ --
+ -- HISTORY:
+ --   DAS  8 OCT 90   INITIAL VERSION.
+ --   PWN  12/01/95   CORRECTED FORMAT OF CALL TO REPORT.TEST
+ --   KAS  25NOV96    CHANGED LITERAL 7 TO (IMPDEF.CHAR_BITS-1)
+ --!
+ 
+ WITH REPORT; USE REPORT;
+ WITH IMPDEF;
+ 
+ PROCEDURE A49027C IS
+ 
+      GENERIC
+           X : INTEGER;
+      PACKAGE GP IS
+           TYPE REC IS
+                RECORD
+                     C : STRING (1..X);
+                END RECORD;
+      END GP;
+ 
+      PACKAGE NP IS NEW GP (1);
+ 
+      TYPE NR IS NEW NP.REC;
+      FOR NR USE
+           RECORD
+                C AT 0 RANGE 0..IMPDEF.CHAR_BITS-1; -- SUBTYPE INDICATION
+           END RECORD;             -- FOR C IN NP IS CONSIDERED STATIC.
+ 
+ BEGIN
+      TEST("A49027C", "CHECK THAT IF A GENERIC PARAMETER IS A STATIC " &
+           "EXPRESSION AND THE CORRESPONDING (IN) PARAMETER HAS A " &
+           "STATIC SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " &
+           "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE STATIC.");
+ 
+      RESULT;
+ 
+ END A49027C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a54b01a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a54b01a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a54b01a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a54b01a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- A54B01A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A CASE EXPRESSION IS A CONSTANT, VARIABLE,
+ --    TYPE CONVERSION, OR QUALIFIED EXPRESSION,
+ --    AND THE SUBTYPE OF THE
+ --    EXPRESSION IS STATIC, AN  'OTHERS'  CAN BE OMITTED IF ALL
+ --    VALUES IN THE SUBTYPE'S RANGE ARE COVERED.
+ 
+ 
+ -- RM 01/23/80
+ -- SPS 10/26/82
+ -- SPS 2/1/83
+ 
+ WITH REPORT ;
+ PROCEDURE  A54B01A  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN                                                       
+ 
+      TEST("A54B01A" , "CHECK THAT IF" &
+                       " THE SUBTYPE OF A CASE EXPRESSION IS STATIC," &
+                       " AN  'OTHERS'  CAN BE OMITTED IF ALL" &
+                       " VALUES IN THE SUBTYPE'S RANGE ARE COVERED" );
+ 
+      -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER:
+      --
+      --    I.   CONSTANTS
+      --
+      --    II.  STATIC SUBRANGES
+      --
+      --         (A)    VARIABLES (INTEGER , BOOLEAN)
+      --         (B)    QUALIFIED EXPRESSIONS
+      --         (C)    TYPE CONVERSIONS
+ 
+      DECLARE  -- CONSTANTS
+           T : CONSTANT BOOLEAN := TRUE;
+           FIVE : CONSTANT INTEGER := IDENT_INT(5);
+      BEGIN
+ 
+           CASE  FIVE  IS
+                WHEN  INTEGER'FIRST..4  =>  NULL ;
+                WHEN  5                 =>  NULL ; 
+                WHEN  6 .. INTEGER'LAST =>  NULL ; 
+           END CASE;                                         
+                                                             
+           CASE  T  IS
+                WHEN  TRUE              =>  NULL ;
+                WHEN  FALSE             =>  NULL ;
+           END CASE;
+ 
+      END ;
+ 
+ 
+      DECLARE   --  STATIC SUBRANGES
+           
+           SUBTYPE  STAT  IS  INTEGER RANGE 1..5 ;
+           I   : INTEGER RANGE 1..5 ;
+           J   : STAT ;
+           BOOL: BOOLEAN := FALSE ;
+           CHAR: CHARACTER := 'U' ;
+           TYPE  ENUMERATION  IS  ( FIRST,SECOND,THIRD,FOURTH,FIFTH );
+           ENUM: ENUMERATION := THIRD ;
+ 
+ 
+      BEGIN
+ 
+           I  :=  IDENT_INT( 2 );
+           J  :=  IDENT_INT( 2 );
+ 
+           CASE  I  IS
+                WHEN  1 | 3 | 5  =>  NULL ;
+                WHEN  2 | 4      =>  NULL ;
+           END CASE;
+ 
+           CASE  BOOL  IS
+                WHEN  TRUE   =>  NULL ;
+                WHEN  FALSE  =>  NULL ;
+           END CASE;
+ 
+           CASE  STAT'( 2 )  IS
+                WHEN  5 | 2..4  =>  NULL ;
+                WHEN  1         =>  NULL ;
+           END CASE;
+ 
+           CASE  STAT( J )  IS
+                WHEN  5 | 2..4  =>  NULL ;
+                WHEN  1         =>  NULL ;
+           END CASE;
+ 
+ 
+      END ;     --  STATIC SUBRANGES
+ 
+      RESULT ;
+ 
+ 
+ END A54B01A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a54b02a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a54b02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a54b02a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a54b02a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,184 ----
+ -- A54B02A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A CASE EXPRESSION IS A VARIABLE, CONSTANT, TYPE 
+ --    CONVERSION, ATTRIBUTE (IN PARTICULAR 'FIRST AND 'LAST),
+ --    FUNCTION INVOCATION, QUALIFIED EXPRESSION, OR A PARENTHESIZED
+ --    EXPRESSION HAVING ONE OF THESE FORMS, AND THE SUBTYPE OF THE
+ --    EXPRESSION IS NON-STATIC, AN  'OTHERS'  CAN BE OMITTED IF ALL
+ --    VALUES IN THE BASE TYPE'S RANGE ARE COVERED.
+ 
+ -- RM 01/27/80
+ -- SPS 10/26/82
+ -- SPS 2/2/83
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ WITH REPORT ;
+ PROCEDURE  A54B02A  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN                                                       
+ 
+      TEST("A54B02A" , "CHECK THAT IF THE" &
+                       " SUBTYPE OF A CASE EXPRESSION IS NON-STATIC," &
+                       " AN  'OTHERS'  CAN BE OMITTED IF ALL" &
+                       " VALUES IN THE BASE TYPE'S RANGE ARE COVERED" );
+ 
+      -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER:
+      --
+      --         (A)    VARIABLES (INTEGER , BOOLEAN)
+      --         (B)    CONSTANTS (INTEGER, BOOLEAN)
+      --         (C)    ATTRIBUTES ('FIRST, 'LAST)    
+      --         (D)    FUNCTION CALLS
+      --         (E)    QUALIFIED EXPRESSIONS
+      --         (F)    TYPE CONVERSIONS
+      --         (G)    PARENTHESIZED EXPRESSIONS OF THE ABOVE KINDS
+ 
+ 
+      DECLARE   --  NON-STATIC RANGES
+           
+           SUBTYPE  STAT   IS  INTEGER RANGE 1..50 ;
+           SUBTYPE  DYN    IS  STAT    RANGE 1..IDENT_INT( 5 ) ;
+           I   : STAT RANGE 1..IDENT_INT( 5 );
+           J   : DYN ;
+           SUBTYPE  DYNCHAR  IS
+                 CHARACTER RANGE ASCII.NUL .. IDENT_CHAR('Q');
+           SUBTYPE  STATCHAR  IS
+                 DYNCHAR RANGE 'A' .. 'C' ;
+           CHAR: DYNCHAR := 'F' ;
+           TYPE  ENUMERATION  IS  ( A,B,C,D,E,F,G,H,K,L,M,N );
+           SUBTYPE  STATENUM  IS
+                 ENUMERATION RANGE  A .. L ;
+           SUBTYPE  DYNENUM  IS
+                 STATENUM  RANGE  A .. ENUMERATION'VAL(IDENT_INT(5));
+           ENUM: DYNENUM := B ;
+           CONS : CONSTANT DYN := 3;
+ 
+           FUNCTION  FF  RETURN DYN  IS
+           BEGIN
+                RETURN  2 ;
+           END  FF ;
+ 
+      BEGIN
+ 
+           I  :=  IDENT_INT( 2 );
+           J  :=  IDENT_INT( 2 );
+ 
+           CASE  I  IS
+                WHEN  1 | 3 | 5  =>  NULL ;
+                WHEN  2 | 4      =>  NULL ;
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+           END CASE;
+ 
+           CASE  J  IS
+                WHEN  1 | 3 | 5  =>  NULL ;
+                WHEN  2 | 4      =>  NULL ;
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+           END CASE;
+ 
+           CASE CONS IS
+                WHEN  INTEGER'FIRST..INTEGER'LAST  =>  NULL;
+           END CASE;
+ 
+           CASE DYN'FIRST IS
+                WHEN INTEGER'FIRST..0  =>  NULL;
+                WHEN 1..INTEGER'LAST  =>  NULL;
+           END CASE;
+ 
+           CASE STATCHAR'LAST IS
+                WHEN CHARACTER'FIRST..'A'  =>  NULL;
+                WHEN 'B'..CHARACTER'LAST  =>  NULL;
+           END CASE;
+ 
+           CASE  FF  IS
+                WHEN  4..5  =>  NULL ;
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+                WHEN  1..3  =>  NULL ;
+           END CASE;
+ 
+           CASE  DYN'( 2 )  IS
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+                WHEN  5 | 2..4  =>  NULL ;
+                WHEN  1         =>  NULL ;
+           END CASE;
+ 
+           CASE  DYN( J )  IS
+                WHEN  5 | 2..4  =>  NULL ;
+                WHEN  1         =>  NULL ;
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+           END CASE;
+ 
+ 
+           CASE  ( CHAR )  IS
+                WHEN  ASCII.NUL .. 'P'  =>  NULL ;
+                WHEN  'Q'               =>  NULL ; 
+                WHEN  'R' .. 'Y'        =>  NULL ; 
+                WHEN  'Z' .. CHARACTER'LAST  =>  NULL ;
+           END CASE;
+ 
+           CASE  ( ENUM )  IS
+                WHEN  A | C | E  =>  NULL ;
+                WHEN  B | D      =>  NULL ;
+                WHEN  F .. L     =>  NULL ;
+                WHEN  M .. N     =>  NULL ;
+           END CASE;
+ 
+           CASE  ( FF )  IS
+                WHEN  1 | 3 | 5  =>  NULL ;
+                WHEN  2 | 4      =>  NULL ;
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+           END CASE;
+ 
+           CASE  ( DYN'( I ) )  IS
+                WHEN  4..5  =>  NULL ;
+                WHEN  1..3  =>  NULL ;
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+           END CASE;
+ 
+           CASE  ( DYN( 2 ) )  IS
+                WHEN  5 | 2..4  =>  NULL ;
+                WHEN  1         =>  NULL ;
+                WHEN  INTEGER'FIRST..0 | 6..INTEGER'LAST  =>  NULL ;
+           END CASE;
+ 
+           CASE (CONS) IS
+                WHEN 1..100  =>  NULL;
+                WHEN INTEGER'FIRST..0  =>  NULL;
+                WHEN 101..INTEGER'LAST  =>  NULL;
+           END CASE;
+ 
+           CASE (DYNCHAR'LAST) IS
+                WHEN 'B'..'Y'  =>  NULL;
+                WHEN CHARACTER'FIRST..'A'  =>  NULL;
+                WHEN 'Z'..CHARACTER'LAST  =>  NULL;
+           END CASE;
+ 
+      END;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END A54B02A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a55b12a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a55b12a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a55b12a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a55b12a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- A55B12A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE SUBTYPE OF A LOOP PARAMETER IN A LOOP OF THE FORM
+ --
+ --                    FOR  I  IN  ST RANGE L..R  LOOP
+ --
+ --    IS CORRECTLY DETERMINED SO THAT WHEN THE LOOP PARAMETER IS USED
+ --    IN A CASE STATEMENT  AN 'OTHERS' ALTERNATIVE IS NOT REQUIRED IF
+ --    THE CHOICES COVER THE APPROPRIATE RANGE OF SUBTYPE VALUES.
+ 
+ -- CASE  A :
+ --    L  AND  R  ARE BOTH STATIC EXPRESSIONS, AND  ST  IS A STATIC
+ --    SUBTYPE COVERING A RANGE GREATER THAN  L..R .
+ 
+ 
+ -- RM 02/02/80
+ -- JRK 03/02/83
+ 
+ WITH REPORT ;
+ PROCEDURE  A55B12A  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("A55B12A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" &
+                       " IN A LOOP OF THE FORM  'FOR  I  IN  ST RANGE" &
+                       " L..R  LOOP'  IS CORRECTLY DETERMINED  (A)" );
+ 
+      DECLARE
+ 
+           SUBTYPE   STAT  IS       INTEGER RANGE 1..10 ;
+           TYPE  NEW_STAT  IS  NEW  INTEGER RANGE 1..10 ;
+ 
+           TYPE  ENUMERATION  IS  ( A,B,C,D,E,F,G,H,K,L,M,N );
+           SUBTYPE   STAT_E  IS     ENUMERATION RANGE A..L ;
+           SUBTYPE   STAT_B  IS     BOOLEAN RANGE FALSE..TRUE ;
+           SUBTYPE   STAT_C  IS     CHARACTER RANGE 'A'..'L' ;
+ 
+      BEGIN
+ 
+           FOR  I  IN  STAT  RANGE  1..5  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL ;
+                     WHEN  2 | 4      =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+           FOR  I  IN  NEW_STAT  RANGE  1..5  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL ;
+                     WHEN  2 | 4      =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+           FOR  I  IN  INTEGER  RANGE  1..5  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL ;
+                     WHEN  2 | 4      =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  REVERSE  STAT RANGE 1..5  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL ;
+                     WHEN  2 | 4      =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  STAT_E  RANGE  A..E  LOOP
+ 
+                CASE  I  IS
+                     WHEN  C..E  =>  NULL ;
+                     WHEN  A..B  =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  STAT_B  RANGE TRUE..TRUE  LOOP
+ 
+                CASE  I  IS
+                     WHEN  TRUE  =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  STAT_C  RANGE 'A'..'E'  LOOP
+ 
+                CASE  I  IS
+                     WHEN  'A'..'C'  =>  NULL ;
+                     WHEN  'D'..'E'  =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  STAT_C  RANGE 'E'..'B'  LOOP
+ 
+                CASE  I  IS
+                     WHEN  'D'..'C'  =>  NULL ;
+                     WHEN  'E'..'B'  =>  NULL ;
+                     WHEN  'F'..'A'  =>  NULL ;
+                     WHEN  'M'..'A'  =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+      END ;
+ 
+      RESULT ;
+ 
+ END A55B12A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a55b13a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a55b13a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a55b13a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a55b13a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- A55B13A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- USING A  CASE_STATEMENT , CHECK THAT IF  L , R  ARE LITERALS
+ --    OF TYPE  T  (INTEGER, BOOLEAN, CHARACTER, USER-DEFINED
+ --    ENUMERATION TYPE)  THE SUBTYPE BOUNDS ASSOCIATED WITH A
+ --    LOOP OF THE FORM
+ --               FOR  I  IN  L..R  LOOP
+ --    ARE THE SAME AS THOSE FOR THE CORRESPONDING LOOP OF THE FORM
+ --               FOR  I  IN  T RANGE L..R  LOOP   .
+ 
+ 
+ -- RM 04/07/81
+ -- SPS 3/2/83
+ -- JBG 8/21/83
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ WITH REPORT ;
+ PROCEDURE  A55B13A  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("A55B13A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER"   &
+                       " IN A LOOP OF THE FORM  'FOR  I  IN "         &
+                       " LITERAL_L .. LITERAL_R  LOOP'  IS CORRECTLY" &
+                       " DETERMINED" );
+ 
+      DECLARE
+ 
+           TYPE  ENUMERATION  IS  ( A,B,C,D,MIDPOINT,E,F,G,H );
+           ONE   :  CONSTANT  :=  1 ;
+           FIVE  :  CONSTANT  :=  5 ;
+ 
+ 
+      BEGIN
+ 
+ 
+           FOR  I  IN  1..5  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL ;
+                     WHEN  2 | 4      =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  REVERSE  ONE .. FIVE  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL ;
+                     WHEN  2 | 4      =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  REVERSE FALSE..TRUE  LOOP
+ 
+                CASE  I  IS
+                     WHEN  FALSE  =>  NULL ;
+                     WHEN  TRUE   =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  CHARACTER'('A') .. ASCII.DEL  LOOP
+ 
+                CASE  I  IS
+                     WHEN  CHARACTER'('A')..CHARACTER'('U')  =>  NULL ;
+                     WHEN  CHARACTER'('V')..ASCII.DEL  =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  CHARACTER'('A')..CHARACTER'('H')  LOOP
+ 
+                CASE  I  IS
+                     WHEN  CHARACTER'('A')..CHARACTER'('D')  =>  NULL ;
+                     WHEN  CHARACTER'('E')..CHARACTER'('H')  =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  REVERSE B..H  LOOP
+ 
+                CASE  I  IS
+                     WHEN  B..D      =>  NULL ;
+                     WHEN  E..H      =>  NULL ;
+                     WHEN  MIDPOINT  =>  NULL ;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END A55B13A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a55b14a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a55b14a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a55b14a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a55b14a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- A55B14A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- USING A  CASE_STATEMENT , CHECK THAT THE SUBTYPE BOUNDS ASSOCIATED
+ --    WITH A LOOP OF THE FORM
+ --               FOR  I  IN  ST  LOOP
+ --    ARE, RESPECTIVELY,  ST'FIRST..ST'LAST WHEN ST IS STATIC.
+ 
+ -- RM 04/07/81
+ -- SPS 3/2/83
+ -- JBG 3/14/83
+ 
+ WITH REPORT;
+ PROCEDURE  A55B14A  IS
+ 
+      USE REPORT;
+      USE ASCII ;
+ 
+      TYPE  ENUMERATION  IS  ( A,B,C,D,MIDPOINT,E,F,G,H );
+      SUBTYPE   ST_I  IS       INTEGER RANGE 1..5       ;
+      TYPE  NEW_ST_I  IS   NEW INTEGER RANGE 1..5       ;
+      SUBTYPE   ST_E  IS       ENUMERATION RANGE B..G   ;
+      SUBTYPE   ST_B  IS       BOOLEAN RANGE FALSE..FALSE;
+      SUBTYPE   ST_C  IS       CHARACTER RANGE 'A'..DEL ;
+ 
+ BEGIN
+ 
+      TEST("A55B14A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER"     &
+                       " IN A LOOP OF THE FORM  'FOR  I  IN  ST  LOOP'" &
+                       " ARE CORRECTLY DETERMINED WHEN ST IS STATIC" );
+ 
+      BEGIN
+ 
+ 
+           FOR  I  IN  ST_I  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL;
+                     WHEN  2 | 4      =>  NULL;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  NEW_ST_I  LOOP
+ 
+                CASE  I  IS
+                     WHEN  1 | 3 | 5  =>  NULL;
+                     WHEN  2 | 4      =>  NULL;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  ST_B  LOOP
+ 
+                CASE  I  IS
+                     WHEN  FALSE  =>  NULL;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  ST_C  LOOP
+ 
+                CASE  I  IS
+                     WHEN  'A'..'U'  =>  NULL;
+                     WHEN  'V'..DEL  =>  NULL;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+           FOR  I  IN  ST_E  LOOP
+ 
+                CASE  I  IS
+                     WHEN  B..D      =>  NULL;
+                     WHEN  E..G      =>  NULL;
+                     WHEN  MIDPOINT  =>  NULL;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END A55B14A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a71004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a71004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a71004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a71004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- A71004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL FORMS OF DECLARATION PERMITTED IN THE PRIVATE PART OF
+ -- A PACKAGE ARE INDEED ACCEPTED BY THE COMPILER. 
+ -- TASKS, GENERICS, FIXED AND FLOAT DECLARATIONS ARE NOT TESTED.
+ 
+ -- DAT 5/6/81
+ -- VKG 2/16/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE A71004A IS
+ BEGIN
+ 
+      TEST ("A71004A", "ALL FORMS OF DECLARATIONS IN PRIVATE PART");
+ 
+      DD:
+      DECLARE
+ 
+           PACKAGE P1 IS
+ 
+                TYPE P IS PRIVATE;
+                TYPE L IS LIMITED PRIVATE;
+                CP : CONSTANT P;
+                CL : CONSTANT L;
+ 
+           PRIVATE
+ 
+                ONE : CONSTANT := 1;
+                TWO : CONSTANT := ONE * 1.0 + 1.0;
+                N1, N2, N3 : CONSTANT := TWO;
+                TYPE I IS RANGE -10 .. 10;
+                X4, X5 : CONSTANT I := I(IDENT_INT(3));
+                X6, X7 : I := X4 + X5;
+                TYPE AR IS ARRAY (I) OF L;
+ 
+                X10 : ARRAY (IDENT_INT(1) .. IDENT_INT (10)) OF I;
+                X11 : CONSTANT ARRAY (1..10) OF I := (1..10=>3);
+                TYPE T3 IS (E12);
+                TYPE T4 IS NEW T3;
+ 
+                TYPE REC1 (D:BOOLEAN:=TRUE) IS RECORD NULL; END RECORD;
+                SUBTYPE  REC1TRUE  IS  REC1( D => TRUE ) ;
+                TYPE L IS NEW REC1TRUE ;
+                X8 , X9 : AR;
+                TYPE  A6  IS  ACCESS REC1 ;
+                SUBTYPE  L1  IS  L ;
+                SUBTYPE  A7  IS  A6(D=>TRUE);
+                SUBTYPE I14 IS I RANGE 1 .. 1;
+                TYPE UA1 IS ARRAY (I14 RANGE <> ) OF I14;
+                TYPE UA2 IS NEW UA1;
+                USE STANDARD.ASCII;
+ 
+                PROCEDURE P1 ;
+ 
+                FUNCTION F1 (X : UA1) RETURN UA1;
+ 
+                FUNCTION "+" (X : UA1) RETURN UA1;
+ 
+                PACKAGE  PK IS
+                PRIVATE
+                END;
+ 
+                PACKAGE PK1 IS
+                     PACKAGE PK2 IS END;
+                PRIVATE
+                     PACKAGE PK3 IS PRIVATE END;
+                END PK1;
+ 
+                EX : EXCEPTION;
+                EX1, EX2 : EXCEPTION;
+                X99 : I RENAMES X7;
+                EX3 : EXCEPTION RENAMES EX1;
+                PACKAGE PQ1 RENAMES DD.P1;
+                PACKAGE PQ2 RENAMES PK1;
+                PACKAGE PQ3 RENAMES PQ2 . PK2;
+                FUNCTION "-" (X : UA1) RETURN UA1 RENAMES "+";
+                PROCEDURE P98 RENAMES P1;
+                TYPE P IS NEW L;
+                CP : CONSTANT P := (D=> TRUE);
+                CL : CONSTANT L := L(CP);
+ 
+           END P1;
+ 
+           PACKAGE BODY P1 IS
+ 
+                PROCEDURE P1 IS BEGIN NULL; END P1;
+ 
+                FUNCTION F1 (X : UA1) RETURN UA1 IS
+                BEGIN RETURN X; END F1;
+ 
+                FUNCTION "+" (X : UA1) RETURN UA1 IS
+                BEGIN RETURN F1(X); END "+";
+ 
+                PACKAGE BODY PK1 IS
+                     PACKAGE BODY PK3 IS END;
+                END PK1;
+ 
+           BEGIN
+                NULL ;
+           END P1;
+ 
+      BEGIN
+           NULL;
+      END DD;
+      RESULT;
+ 
+ END A71004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a73001i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a73001i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a73001i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a73001i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- A73001I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR
+ -- GENERIC INSTANTIATION IN A PACKAGE SPECIFICATION NO PACKAGE BODY IS
+ -- REQUIRED.
+ 
+ -- BHS 6/26/84
+ 
+ WITH REPORT;
+ PROCEDURE A73001I IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("A73001I", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " &
+                       "SUBPROGRAM DECLARED BY RENAMING DECLARATION " &
+                       "OR GENERIC INSTANTIATION IN A PACKAGE " &
+                       "SPECIFICATION");
+ 
+      DECLARE
+           PACKAGE PACK1 IS
+                FUNCTION ADDI (X,Y : INTEGER) RETURN INTEGER RENAMES "+";
+           END PACK1;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+ 
+      DECLARE
+           GENERIC
+                TYPE ITEM IS RANGE <>;
+           PROCEDURE P (X : IN OUT ITEM);
+ 
+           PROCEDURE P (X : IN OUT ITEM) IS
+           BEGIN
+                NULL;
+           END P;
+ 
+           PACKAGE PACK2 IS
+                PROCEDURE NADA IS NEW P (INTEGER);
+           END PACK2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END A73001I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a73001j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a73001j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a73001j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a73001j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- A73001J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR
+ -- GENERIC INSTANTIATION IN A GENERIC PACKAGE SPECIFICATION, NO PACKAGE
+ -- BODY IS REQUIRED.
+ 
+ 
+ -- BHS 6/27/84
+ 
+ WITH REPORT;
+ PROCEDURE A73001J IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("A73001J", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " &
+                       "SUBPROGRAM DECLARED BY RENAMING DECLARATION " &
+                       "OR GENERIC INSTANTIATION IN A GENERIC " &
+                       "PACKAGE SPECIFICATION");
+ 
+      DECLARE
+           GENERIC
+                TYPE ITEM IS RANGE <>;
+           PACKAGE PACK1 IS
+                FUNCTION ADDI (X,Y : ITEM) RETURN ITEM RENAMES "+";
+           END PACK1;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+ 
+      DECLARE
+           GENERIC
+                TYPE ITEM IS RANGE <>;
+           PROCEDURE P (X : IN OUT ITEM);
+ 
+           PROCEDURE P (X : IN OUT ITEM) IS
+           BEGIN
+                NULL;
+           END P;
+ 
+           GENERIC
+                TYPE OBJ IS RANGE <>;
+           PACKAGE PACK2 IS
+                PROCEDURE NADA IS NEW P (OBJ);
+           END PACK2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END A73001J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74105b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74105b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74105b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74105b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- A74105B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FULL TYPE DECLARATION OF A PRIVATE TYPE WITHOUT
+ -- DISCRIMINANTS MAY BE A CONSTRAINED TYPE WITH DISCRIMINANTS.
+ 
+ -- DSJ 4/29/83
+ -- SPS 10/22/83
+ 
+ WITH REPORT;
+ PROCEDURE A74105B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("A74105B", "CHECK THAT THE FULL TYPE DECLARATION OF A " &
+                       "PRIVATE TYPE WITHOUT DISCRIMINANTS MAY BE " &
+                       "A CONSTRAINED TYPE WITH DISCRIMINANTS");
+ 
+      DECLARE
+ 
+           TYPE REC1 (D : INTEGER) IS
+                RECORD
+                     C1, C2 : INTEGER;
+                END RECORD;
+ 
+           TYPE REC2 (F : INTEGER := 0) IS
+                RECORD
+                     E1, E2 : INTEGER;
+                END RECORD;
+ 
+           TYPE REC3 IS NEW REC1 (D => 1);
+ 
+           TYPE REC4 IS NEW REC2 (F => 2);
+ 
+           PACKAGE PACK1 IS
+                TYPE P1 IS PRIVATE;
+                TYPE P2 IS PRIVATE;
+                TYPE P3 IS PRIVATE;
+                TYPE P4 IS PRIVATE;
+           PRIVATE
+                TYPE P1 IS ACCESS REC1;
+                TYPE P2 IS NEW REC4;
+                TYPE P3 IS NEW REC1 (D => 5);
+                TYPE P4 IS NEW REC2 (F => 7);
+           END PACK1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END A74105B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74106a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74106a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74106a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,168 ----
+ -- A74106A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED
+ --    PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE,
+ --    RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH
+ --    OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE
+ --    ABOVE.
+ 
+ -- PART A: TYPES NOT INVOLVING FLOATING-POINT DATA OR FIXED-POINT DATA.
+ 
+ 
+ -- RM 05/13/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  A74106A  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "A74106A" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " &
+                        "TYPES CAN BE DEFINED IN TERMS OF " &
+                        "VARIOUS OTHER TYPES" );
+ 
+      DECLARE
+ 
+           TYPE  ENUM  IS  ( A , B , C , D );
+ 
+           PACKAGE  P0  IS
+                TYPE  T0  IS  PRIVATE;
+           PRIVATE
+                TYPE  T0  IS  NEW INTEGER;
+           END  P0;
+ 
+           PACKAGE  P1  IS
+                USE   P0;
+                TYPE  T1  IS  PRIVATE;
+                TYPE  T2  IS  PRIVATE;
+                TYPE  T3  IS  PRIVATE;
+                TYPE  T4  IS  PRIVATE;
+                TYPE  T5  IS  PRIVATE;
+                TYPE  T6  IS  PRIVATE;
+                TYPE  T7  IS  PRIVATE;
+                TYPE  T8  IS  PRIVATE;
+                TYPE  T9  IS  PRIVATE;
+                TYPE  TA  IS  PRIVATE;
+                TYPE  TB  IS  PRIVATE;
+                TYPE  TC  IS  PRIVATE;
+                TYPE  TD(I : INTEGER)  IS  PRIVATE;
+                TYPE  NT  IS  NEW  ENUM;
+                TYPE  ARR_T            IS  ARRAY(1..2) OF BOOLEAN;
+                TYPE  ACC_T            IS  ACCESS CHARACTER;
+                TYPE  REC_T            IS RECORD T : BOOLEAN; END RECORD;
+                TYPE  D_REC_T(I : INTEGER := 1)  IS 
+                     RECORD T : ENUM; END RECORD;
+           PRIVATE
+                TYPE  TY(B : BOOLEAN)  IS  
+                     RECORD G : BOOLEAN; END RECORD;
+                TYPE  TC  IS  NEW  T0;
+                TYPE  T1  IS  RANGE 1..100;
+                TYPE  T2  IS  NEW CHARACTER RANGE 'A'..'Z';
+                TYPE  T3  IS  NEW  NT;
+                TYPE  T4  IS  ARRAY(1..2) OF INTEGER;
+                TYPE  T5  IS  NEW ARR_T;
+                TYPE  T6  IS  ACCESS ENUM;
+                TYPE  T7  IS  NEW ACC_T;
+                TYPE  T8  IS  
+                     RECORD T : CHARACTER; END RECORD;
+                TYPE  T9  IS  NEW REC_T;
+                TYPE  TA  IS  ACCESS TD;
+                TYPE  TB  IS  ACCESS D_REC_T;
+                TYPE  TD(I : INTEGER)  IS  
+                     RECORD G : BOOLEAN; END RECORD;
+ 
+           END  P1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+ 
+      DECLARE
+ 
+           TYPE  ENUM  IS  ( A , B , C , D );
+ 
+           PACKAGE  P0  IS
+                TYPE  T0  IS  LIMITED PRIVATE;
+           PRIVATE
+                TYPE  T0  IS  NEW ENUM;
+           END  P0;
+ 
+           PACKAGE  P1  IS
+                USE   P0;
+                TYPE  T1  IS  LIMITED PRIVATE;
+                TYPE  T2  IS  LIMITED PRIVATE;
+                TYPE  T3  IS  LIMITED PRIVATE;
+                TYPE  T4  IS  LIMITED PRIVATE;
+                TYPE  T5  IS  LIMITED PRIVATE;
+                TYPE  T6  IS  LIMITED PRIVATE;
+                TYPE  T7  IS  LIMITED PRIVATE;
+                TYPE  T8  IS  LIMITED PRIVATE;
+                TYPE  T9  IS  LIMITED PRIVATE;
+                TYPE  TA  IS  LIMITED PRIVATE;
+                TYPE  TB  IS  LIMITED PRIVATE;
+                TYPE  TC  IS  LIMITED PRIVATE;
+                TYPE  TD(I : INTEGER)  IS  LIMITED PRIVATE;
+                TYPE  NT  IS  NEW  ENUM;
+                TYPE  ARR_T           IS  ARRAY(1..2) OF BOOLEAN;
+                TYPE  ACC_T           IS  ACCESS CHARACTER;
+                TYPE  REC_T           IS  RECORD T : BOOLEAN; END RECORD;
+                TYPE  D_REC_T(I : INTEGER := 1)  IS 
+                     RECORD T : ENUM; END RECORD;
+           PRIVATE
+                TYPE  TY(B : BOOLEAN)  IS  
+                     RECORD G : BOOLEAN; END RECORD;
+                TYPE  TC  IS  NEW  T0;
+                TYPE  T1  IS  RANGE 1..100;
+                TYPE  T2  IS  NEW CHARACTER RANGE 'A'..'Z';
+                TYPE  T3  IS  NEW  NT;
+                TYPE  T4  IS  ARRAY(1..2) OF INTEGER;
+                TYPE  T5  IS  NEW ARR_T;
+                TYPE  T6  IS  ACCESS ENUM;
+                TYPE  T7  IS  NEW ACC_T;
+                TYPE  T8  IS  RECORD T : CHARACTER; END RECORD;
+                TYPE  T9  IS  NEW REC_T;
+                TYPE  TA  IS  ACCESS TD;
+                TYPE  TB  IS  ACCESS D_REC_T;
+                TYPE  TD(I : INTEGER)  IS  
+                     RECORD G : BOOLEAN; END RECORD;
+ 
+           END  P1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END A74106A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74106b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74106b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74106b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- A74106B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED
+ --    PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE,
+ --    RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH
+ --    OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE
+ --    ABOVE.
+ 
+ -- PART B: TYPES INVOLVING FLOATING-POINT DATA.
+ 
+ 
+ -- RM 05/08/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  A74106B  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "A74106B" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " &
+                        "TYPES CAN BE DEFINED IN TERMS OF " &
+                        "FLOATING-POINT TYPES" );
+ 
+      DECLARE
+ 
+           PACKAGE  P0  IS
+                TYPE  F0  IS  PRIVATE;
+           PRIVATE
+                TYPE  F0  IS  NEW FLOAT;
+           END  P0;
+ 
+           PACKAGE  P1  IS
+                USE   P0;
+                TYPE  F1  IS  PRIVATE;
+                TYPE  F2  IS  PRIVATE;
+                TYPE  F3  IS  PRIVATE;
+                TYPE  F4  IS  PRIVATE;
+                TYPE  F5  IS  PRIVATE;
+                TYPE  F6  IS  PRIVATE;
+                TYPE  F7  IS  PRIVATE;
+                TYPE  F8  IS  PRIVATE;
+                TYPE  F9  IS  PRIVATE;
+                TYPE  FA  IS  PRIVATE;
+                TYPE  FB  IS  PRIVATE;
+                TYPE  FC  IS  PRIVATE;
+                TYPE  FD(I : INTEGER)  IS  PRIVATE;
+                TYPE  NF  IS  NEW  FLOAT;
+                TYPE  ARR_F             IS  ARRAY(1..2) OF FLOAT;
+                TYPE  ACC_F             IS  ACCESS FLOAT;
+                TYPE  REC_F             IS RECORD F : FLOAT; END RECORD;
+                TYPE  D_REC_F(I : INTEGER := 1) IS 
+                     RECORD F : FLOAT; END RECORD;
+           PRIVATE
+                TYPE  FY(B : BOOLEAN)  IS  RECORD G : FLOAT; END RECORD;
+                TYPE  FC  IS  NEW  F0;
+                TYPE  F1  IS  DIGITS 3;
+                TYPE  F2  IS  NEW FLOAT DIGITS 4;
+                TYPE  F3  IS  NEW  NF;
+                TYPE  F4  IS  ARRAY(1..2) OF FLOAT;
+                TYPE  F5  IS  NEW ARR_F;
+                TYPE  F6  IS  ACCESS FLOAT;
+                TYPE  F7  IS  NEW ACC_F;
+                TYPE  F8  IS  RECORD F : FLOAT; END RECORD;
+                TYPE  F9  IS  NEW REC_F;
+                TYPE  FA  IS  ACCESS FD;
+                TYPE  FB  IS  ACCESS D_REC_F;
+                TYPE  FD(I : INTEGER)  IS  RECORD G : FLOAT; END RECORD;
+ 
+           END  P1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+ 
+      DECLARE
+ 
+           PACKAGE  P0  IS
+                TYPE  F0  IS  LIMITED PRIVATE;
+           PRIVATE
+                TYPE  F0  IS  NEW FLOAT;
+           END  P0;
+ 
+           PACKAGE  P1  IS
+                USE   P0;
+                TYPE  F1  IS  LIMITED PRIVATE;
+                TYPE  F2  IS  LIMITED PRIVATE;
+                TYPE  F3  IS  LIMITED PRIVATE;
+                TYPE  F4  IS  LIMITED PRIVATE;
+                TYPE  F5  IS  LIMITED PRIVATE;
+                TYPE  F6  IS  LIMITED PRIVATE;
+                TYPE  F7  IS  LIMITED PRIVATE;
+                TYPE  F8  IS  LIMITED PRIVATE;
+                TYPE  F9  IS  LIMITED PRIVATE;
+                TYPE  FA  IS  LIMITED PRIVATE;
+                TYPE  FB  IS  LIMITED PRIVATE;
+                TYPE  FC  IS  LIMITED PRIVATE;
+                TYPE  FD(I : INTEGER)  IS  LIMITED PRIVATE;
+                TYPE  NF  IS  NEW  FLOAT;
+                TYPE  ARR_F             IS  ARRAY(1..2) OF FLOAT;
+                TYPE  ACC_F             IS  ACCESS FLOAT;
+                TYPE  REC_F             IS RECORD F : FLOAT; END RECORD;
+                TYPE  D_REC_F(I : INTEGER := 1) IS 
+                     RECORD F : FLOAT; END RECORD;
+           PRIVATE
+                TYPE  FY(B : BOOLEAN)  IS  RECORD G : FLOAT; END RECORD;
+                TYPE  FC  IS  NEW  F0;
+                TYPE  F1  IS  DIGITS 3;
+                TYPE  F2  IS  NEW FLOAT DIGITS 4;
+                TYPE  F3  IS  NEW  NF;
+                TYPE  F4  IS  ARRAY(1..2) OF FLOAT;
+                TYPE  F5  IS  NEW ARR_F;
+                TYPE  F6  IS  ACCESS FLOAT;
+                TYPE  F7  IS  NEW ACC_F;
+                TYPE  F8  IS  RECORD F : FLOAT; END RECORD;
+                TYPE  F9  IS  NEW REC_F;
+                TYPE  FA  IS  ACCESS FD;
+                TYPE  FB  IS  ACCESS D_REC_F;
+                TYPE  FD(I : INTEGER)  IS  RECORD G : FLOAT; END RECORD;
+ 
+           END  P1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END A74106B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74106c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74106c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74106c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74106c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,155 ----
+ -- A74106C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED
+ --     PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY
+ --     TYPE, RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE
+ --     (WITH OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY
+ --     OF THE ABOVE.
+ 
+ --     PART C: TYPES INVOLVING FIXED-POINT DATA.
+ 
+ -- HISTORY:
+ --     RM  05/11/81 CREATED ORIGINAL TEST.
+ --     DHH 10/15/87 CORRECTED RANGE ERRORS.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  A74106C  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "A74106C" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE" &
+                        " TYPES CAN BE DEFINED IN TERMS OF" &
+                        " FIXED-POINT TYPES" );
+ 
+      DECLARE
+ 
+           PACKAGE  P0  IS
+                TYPE  F0  IS  PRIVATE;
+           PRIVATE
+                TYPE  F0  IS  DELTA 1.0  RANGE 0.0 .. 10.0;
+           END  P0;
+ 
+           PACKAGE  P1  IS
+                USE   P0;
+                TYPE  FX  IS  DELTA 0.1  RANGE 0.0 .. 1.0;
+                TYPE  F1  IS  PRIVATE;
+                TYPE  F2  IS  PRIVATE;
+                TYPE  F3  IS  PRIVATE;
+                TYPE  F4  IS  PRIVATE;
+                TYPE  F5  IS  PRIVATE;
+                TYPE  F6  IS  PRIVATE;
+                TYPE  F7  IS  PRIVATE;
+                TYPE  F8  IS  PRIVATE;
+                TYPE  F9  IS  PRIVATE;
+                TYPE  FA  IS  PRIVATE;
+                TYPE  FB  IS  PRIVATE;
+                TYPE  FC  IS  PRIVATE;
+                TYPE  NF  IS  DELTA 0.1 RANGE 1.0 .. 2.0;
+                TYPE  ARR_F             IS  ARRAY(1..2) OF FX;
+                TYPE  ACC_F             IS  ACCESS FX;
+                TYPE  REC_F             IS  RECORD F : FX; END RECORD;
+                TYPE  D_REC_F(I : INTEGER := 1) IS
+                     RECORD F : FX; END RECORD;
+           PRIVATE
+                TYPE  FC  IS  NEW  F0;
+                TYPE  F1  IS  DELTA 100.0  RANGE -100.0 .. 900.0;
+                TYPE  F2  IS  NEW  FX  RANGE 0.0 .. 0.5;
+                TYPE  F3  IS  NEW  NF;
+                TYPE  F4  IS  ARRAY(1..2) OF FX;
+                TYPE  F5  IS  NEW ARR_F;
+                TYPE  F6  IS  ACCESS FX;
+                TYPE  F7  IS  NEW ACC_F;
+                TYPE  F8  IS  RECORD F : FX; END RECORD;
+                TYPE  F9  IS  NEW REC_F;
+                TYPE  FA  IS  ACCESS D_REC_F;
+                TYPE  FB  IS  ACCESS D_REC_F;
+           END  P1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+ 
+      DECLARE
+ 
+           PACKAGE  P0  IS
+                TYPE  F0  IS  LIMITED PRIVATE;
+           PRIVATE
+                TYPE  F0  IS  DELTA 1.0  RANGE 0.0 .. 10.0;
+           END  P0;
+ 
+           PACKAGE  P1  IS
+                USE   P0;
+                TYPE  FX  IS  DELTA 0.1  RANGE 0.0 .. 1.0;
+                TYPE  F1  IS  LIMITED PRIVATE;
+                TYPE  F2  IS  LIMITED PRIVATE;
+                TYPE  F3  IS  LIMITED PRIVATE;
+                TYPE  F4  IS  LIMITED PRIVATE;
+                TYPE  F5  IS  LIMITED PRIVATE;
+                TYPE  F6  IS  LIMITED PRIVATE;
+                TYPE  F7  IS  LIMITED PRIVATE;
+                TYPE  F8  IS  LIMITED PRIVATE;
+                TYPE  F9  IS  LIMITED PRIVATE;
+                TYPE  FA  IS  LIMITED PRIVATE;
+                TYPE  FB  IS  LIMITED PRIVATE;
+                TYPE  FC  IS  LIMITED PRIVATE;
+                TYPE  NF  IS  DELTA 0.1 RANGE 1.0 .. 2.0;
+                TYPE  ARR_F                 IS  ARRAY(1..2) OF FX;
+                TYPE  ACC_F                 IS  ACCESS FX;
+                TYPE  REC_F                 IS RECORD F : FX; END RECORD;
+                TYPE  D_REC_F(I : INTEGER := 1) IS
+                     RECORD F : FX; END RECORD;
+           PRIVATE
+                TYPE  FC  IS  NEW  F0;
+                TYPE  F1  IS  DELTA 100.0  RANGE -100.0 .. 900.0;
+                TYPE  F2  IS  NEW  FX  RANGE 0.0 .. 0.5;
+                TYPE  F3  IS  NEW  NF;
+                TYPE  F4  IS  ARRAY(1..2) OF FX;
+                TYPE  F5  IS  NEW ARR_F;
+                TYPE  F6  IS  ACCESS FX;
+                TYPE  F7  IS  NEW ACC_F;
+                TYPE  F8  IS  RECORD F : FX; END RECORD;
+                TYPE  F9  IS  NEW REC_F;
+                TYPE  FA  IS  ACCESS D_REC_F;
+                TYPE  FB  IS  ACCESS D_REC_F;
+           END  P1;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END A74106C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74205e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74205e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74205e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74205e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- A74205E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ADDITIONAL OPERATIONS FOR A COMPOSITE TYPE WITH A
+ -- COMPONENT OF A PRIVATE TYPE ARE AVAILABLE AT THE EARLIEST
+ -- PLACE WITHIN THE IMMEDIATE SCOPE OF THE DECLARATION OF THE COMPOSITE
+ -- TYPE AND AFTER THE FULL DECLARATION OF THE PRIVATE TYPE.
+ 
+ -- IN PARTICULAR, CHECH FOR THE FOLLOWING :
+ 
+ -- (1)  RELATIONAL OPERATORS WITH ARRAYS OF SCALAR TYPES
+ -- (2)  EQUALITY WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES 
+ -- (3)  LOGICAL OPERATORS WITH ARRAYS OF BOOLEAN TYPES
+ -- (4)  CATENATION WITH ARRAYS OF LIMITED PRIVATE TYPES
+ -- (5)  INITIALIZATION WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES
+ -- (6)  ASSIGNMENT WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES
+ -- (7)  SELECTED COMPONENTS WITH COMPOSITES OF PRIVATE RECORD TYPES
+ -- (8)  INDEXED COMPONENTS WITH COMPOSITES OF PRIVATE ARRAY TYPES
+ -- (9)  SLICES WITH COMPOSITES OF PRIVATE ARRAY TYPES
+ -- (10) QUALIFICATION FOR COMPOSITES OF PRIVATE TYPES
+ -- (11) AGGREGATES FOR ARRAYS AND RECORDS OF PRIVATES TYPES
+ -- (12) USE OF 'SIZE FOR ARRAYS AND RECORDS OF PRIVATE TYPES
+ 
+ -- DSJ 5/2/83
+ 
+ WITH REPORT ;
+ PROCEDURE A74205E IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("A74205E", "CHECK THAT ADDITIONAL OPERATIONS FOR "
+                    & "COMPOSITE TYPES OF PRIVATE TYPES ARE "
+                    & "AVAILABLE AT THE EARLIEST PLACE AFTER THE "
+                    & "FULL DECLARATION AND IN THE IMMEDIATE "
+                    & "SCOPE OF THE COMPOSITE TYPE") ;
+ 
+      DECLARE
+ 
+           PACKAGE PACK1 IS
+                TYPE LP1 IS LIMITED PRIVATE ;
+                PACKAGE PACK_LP IS
+                     TYPE LP_ARR IS ARRAY (INTEGER RANGE <>) OF LP1 ;
+                     SUBTYPE LP_ARR2 IS LP_ARR ( 1 .. 2 ) ;
+                     SUBTYPE LP_ARR4 IS LP_ARR ( 1 .. 4 ) ;
+                END PACK_LP ;
+ 
+                TYPE T1 IS PRIVATE ;
+                PACKAGE PACK2 IS
+                     TYPE ARR IS ARRAY (INTEGER RANGE <>) OF T1 ;
+                     SUBTYPE ARR2 IS ARR ( 1 .. 2 ) ;
+                     SUBTYPE ARR4 IS ARR ( 1 .. 4 ) ;
+                END PACK2 ;
+ 
+                TYPE T2 IS PRIVATE ;
+                TYPE T3 IS PRIVATE ;
+                PACKAGE PACK3 IS
+                     TYPE ARR_T2 IS ARRAY ( 1 .. 2 ) OF T2 ;
+                     TYPE ARR_T3 IS ARRAY ( 1 .. 2 ) OF T3 ;
+                END PACK3 ;
+           PRIVATE
+                TYPE LP1 IS NEW BOOLEAN ;
+                TYPE T1 IS NEW BOOLEAN ;
+                TYPE T2 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
+                TYPE T3 IS
+                     RECORD
+                          C1 : INTEGER ;
+                     END RECORD ;
+           END PACK1 ;
+ 
+           PACKAGE BODY PACK1 IS
+ 
+                PACKAGE BODY PACK_LP IS
+                     L1, L2 : LP_ARR2 := (TRUE,FALSE) ; -- LEGAL
+                     A3 : LP_ARR2 := L1 ;               -- LEGAL
+                     B3 : BOOLEAN := L1 =  L2 ;         -- LEGAL
+                     B4 : BOOLEAN := L1 /= L2 ;         -- LEGAL
+                END PACK_LP ;
+ 
+                PACKAGE BODY PACK2 IS
+                     A1, A2 : ARR2 := (FALSE,TRUE) ;    -- LEGAL
+                     A4 : ARR2    := ARR2'(A1) ;        -- LEGAL
+                     B1 : BOOLEAN := A1 <  A2 ;         -- LEGAL
+                     B2 : BOOLEAN := A1 >= A2 ;         -- LEGAL
+                     N3 : INTEGER := A1'SIZE ;          -- LEGAL
+                     PROCEDURE G1 (X : ARR2 := NOT A1) IS    -- LEGAL
+                     BEGIN
+                          NULL ; 
+                     END G1 ;
+ 
+                     PROCEDURE G2 (X : ARR2 := A1 AND A2) IS -- LEGAL
+                     BEGIN
+                          NULL ;
+                     END G2 ;
+ 
+                     PROCEDURE G3 (X : ARR4 := A1 & A2) IS   -- LEGAL
+                     BEGIN
+                          NULL ;
+                     END G3 ;
+ 
+                     PROCEDURE G4 (X : ARR2 := (FALSE,TRUE) ) IS -- LEGAL
+                     BEGIN
+                          NULL ;
+                     END G4 ;
+                END PACK2 ;
+ 
+                PACKAGE BODY PACK3 IS
+                     X2 : ARR_T2 :=
+                          (1=>(1,2), 2=>(3,4)) ;        -- LEGAL
+                     X3 : ARR_T3 :=
+                          (1=>(C1=>5), 2=>(C1=>6)) ;    -- LEGAL
+                     N1 : INTEGER := X3(1).C1 ;         -- LEGAL
+                     N2 : INTEGER := X2(1)(2) ;         -- LEGAL
+                     N4 : T2      := X2(1)(1..2) ;      -- LEGAL
+                END PACK3 ;
+ 
+           END PACK1 ;
+ 
+      BEGIN
+ 
+           NULL ;
+ 
+      END ;
+ 
+      RESULT ;
+ 
+ END A74205E ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74205f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74205f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a74205f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a74205f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- A74205F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS A PRIVATE TYPE
+ -- ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON
+ -- CHARACTERISTICS OF THE FULL DECLARATION OF THE PRIVATE TYPE ARE MADE
+ -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
+ -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE PRIVATE
+ -- TYPE.
+ 
+ -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES
+ -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES
+ -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY
+ --     TYPES
+ 
+ -- DSJ 5/5/83
+ 
+ WITH REPORT ;
+ PROCEDURE A74205F IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("A74205F", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS TYPES "
+                    & "OF PRIVATE TYPES ARE AVAILABLE AT THE EARLIEST "
+                    & "PLACE IN THE IMMEDIATE SCOPE OF THE ACCESS TYPE "
+                    & "AND AFTER THE FULL DECLARATION") ;
+ 
+      DECLARE
+ 
+           PACKAGE PACK1 IS
+                TYPE T1 IS PRIVATE ;
+                TYPE T2 IS PRIVATE ;
+                PACKAGE PACK2 IS
+                     TYPE ACC1 IS ACCESS T1 ;
+                     TYPE ACC2 IS ACCESS T2 ;
+                END PACK2 ;
+           PRIVATE
+                TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ;
+                TYPE T2 IS
+                     RECORD
+                          C1, C2 : INTEGER ;
+                     END RECORD ;
+           END PACK1 ;
+ 
+           PACKAGE BODY PACK1 IS
+                A1 : PACK2.ACC1 := NEW T1'(2,4) ;  -- LEGAL
+                A2 : PACK2.ACC1 := NEW T1'(6,8) ;  -- LEGAL
+                R1 : PACK2.ACC2 := NEW T2'(3,5) ;  -- LEGAL
+                R2 : PACK2.ACC2 := NEW T2'(7,9) ;  -- LEGAL
+ 
+                PACKAGE BODY PACK2 IS
+                     X1 : INTEGER := A1(1) ;            -- LEGAL
+                     X2 : INTEGER := A1'FIRST ;         -- LEGAL
+                     X3 : INTEGER := A1'LAST ;          -- LEGAL
+                     X4 : INTEGER := A1'LENGTH ;        -- LEGAL
+                     B1 : BOOLEAN := 3 IN A1'RANGE ;    -- LEGAL
+                     X5 : INTEGER := R1.C1 ;            -- LEGAL
+                END PACK2 ;
+ 
+           END PACK1 ;
+ 
+      BEGIN
+ 
+           NULL ;
+ 
+      END ;
+ 
+      RESULT ;
+ 
+ END A74205F ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,198 ----
+ -- A83009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED TYPE DECLARATION AND A GENERIC
+ --     INSTANTIATION MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS.
+ --     CHECK THE CASES WHERE:
+ --          1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE
+ --             SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN
+ --             THE IMPLICIT SUBPROGRAM SPECIFICATIONS.
+ --          2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND
+ --             THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS
+ --             THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN
+ --             FOR THE GENERIC FORMAL-TYPE PARAMETERS.
+ --     TEST CASES WHERE THE DERIVED TYPE DECLARATIONS AND GENERIC
+ --     INSTANTIATIONS ARE GIVEN IN:
+ --          . THE VISIBLE PART OF A PACKAGE SPECIFICATION,
+ --          . THE PRIVATE PART OF A PACKAGE SPECIFICATION,
+ --          . A PACKAGE BODY,
+ --          . A SUBPROGRAM BODY,
+ --          . A BLOCK STATEMENT.
+ --
+ -- HISTORY:
+ --     VCL  03-08-88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A83009A IS
+      TYPE ENUM IS (E1, E2, E3);
+ 
+      GENERIC
+           TYPE T1 IS (<>);
+           TYPE T2 IS (<>);
+      PACKAGE G_PACK IS
+           TYPE PARENT IS (E1, E2, E3);
+ 
+           PROCEDURE HP (P1 : PARENT; P2 : T1);
+           PROCEDURE HP (P3 : PARENT; P4 : T2);
+ 
+           FUNCTION HF (P1 : T1) RETURN PARENT;
+           FUNCTION HF (P2 : T2) RETURN PARENT;
+      END G_PACK;
+ 
+      PACKAGE BODY G_PACK IS
+           PROCEDURE HP (P1 : PARENT; P2 : T1) IS
+           BEGIN
+                NULL;
+           END HP;
+ 
+           PROCEDURE HP (P3 : PARENT; P4 : T2) IS
+           BEGIN
+                NULL;
+           END HP;
+ 
+           FUNCTION HF (P1 : T1) RETURN PARENT IS
+           BEGIN
+                RETURN E1;
+           END HF;
+ 
+           FUNCTION HF (P2 : T2) RETURN PARENT IS
+           BEGIN
+                RETURN E2;
+           END HF;
+      END G_PACK;
+ BEGIN
+      TEST ("A83009A", "A DERIVED TYPE DECLARATION AND A GENERIC " &
+                       "INSTANTIATION MAY DERIVE TWO OR " &
+                       "MORE SUBPROGRAM HOMOGRAPHS");
+ 
+      DECLARE
+      -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION.
+ 
+           PACKAGE PACK2 IS
+                TYPE CHILD1 IS PRIVATE;
+ 
+                PACKAGE IN_PACK2 IS
+                     TYPE PARENT IS (E1, E2, E3);
+                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1);
+                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT);
+ 
+                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
+                                 RETURN PARENT;
+                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
+                                 RETURN PARENT;
+                END IN_PACK2;
+           PRIVATE
+                TYPE CHILD1 IS NEW IN_PACK2.PARENT;
+           END PACK2;
+ 
+           PACKAGE BODY PACK2 IS
+                TYPE CHILD2 IS NEW CHILD1;
+ 
+                PACKAGE IN_BODY IS
+                     TYPE CHILD3 IS NEW CHILD1;
+                END IN_BODY;
+ 
+                PROCEDURE P IS
+                     TYPE CHILD4 IS NEW CHILD1;
+                BEGIN
+                     NULL;
+                END;
+ 
+                PACKAGE BODY IN_PACK2 IS
+                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS
+                     BEGIN
+                          NULL;
+                     END HP;
+ 
+                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS
+                     BEGIN
+                          NULL;
+                     END HP;
+ 
+                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
+                                 RETURN PARENT IS
+                     BEGIN
+                          RETURN E1;
+                     END HF;
+ 
+                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
+                                 RETURN PARENT IS
+                     BEGIN
+                          RETURN E2;
+                     END HF;
+                END IN_PACK2;
+           BEGIN
+                DECLARE
+                     TYPE CHILD5 IS NEW CHILD1;
+                BEGIN
+                     NULL;
+                END;
+           END PACK2;
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE
+      -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS.
+ 
+           PACKAGE INSTANCE1 IS
+                NEW G_PACK (BOOLEAN, BOOLEAN);
+ 
+           TYPE CHILD1 IS NEW INSTANCE1.PARENT;
+ 
+           PACKAGE PACK1 IS
+                PACKAGE INSTANCE2 IS
+                     NEW G_PACK (CHARACTER, CHARACTER);
+ 
+                TYPE CHILD2 IS NEW INSTANCE2.PARENT;
+                TYPE CHILD3 IS PRIVATE;
+           PRIVATE
+                PACKAGE INSTANCE3 IS
+                     NEW G_PACK (ENUM, ENUM);
+ 
+                TYPE CHILD3 IS NEW INSTANCE3.PARENT;
+           END PACK1;
+ 
+           PROCEDURE P1 IS
+                PACKAGE INSTANCE4 IS
+                     NEW G_PACK (BOOLEAN, BOOLEAN);
+ 
+                TYPE CHILD4 IS NEW INSTANCE4.PARENT;
+           BEGIN
+                NULL;
+           END P1;
+ 
+           PACKAGE BODY PACK1 IS
+                PACKAGE INSTANCE5 IS
+                     NEW G_PACK (ENUM, ENUM);
+ 
+                TYPE CHILD5 IS NEW INSTANCE5.PARENT;
+           END PACK1;
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END A83009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83009b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83009b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83009b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,196 ----
+ -- A83009B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED TYPE DECLARATION IN A GENERIC
+ --     UNIT MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS.
+ --     CHECK THE CASES WHERE:
+ --          1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE
+ --             SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN
+ --             THE IMPLICIT SUBPROGRAM SPECIFICATIONS.
+ --          2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND
+ --             THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS
+ --             THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN
+ --             FOR THE GENERIC FORMAL-TYPE PARAMETERS.
+ --     TEST CASES WHERE THE DERIVED TYPE DECLARATIONS ARE GIVEN IN:
+ --          . THE VISIBLE PART OF A GENERIC PACKAGE SPECIFICATION,
+ --          . THE PRIVATE PART OF A GENERIC PACKAGE SPECIFICATION,
+ --          . A GENERIC PACKAGE BODY,
+ --          . A GENERIC SUBPROGRAM BODY.
+ --
+ -- HISTORY:
+ --     DHH 09/20/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A83009B IS
+      TYPE ENUM IS (E1, E2, E3);
+ 
+      GENERIC
+           TYPE T1 IS (<>);
+           TYPE T2 IS (<>);
+      PACKAGE G_PACK IS
+           TYPE PARENT IS (E1, E2, E3);
+ 
+           PROCEDURE HP (P1 : PARENT; P2 : T1);
+           PROCEDURE HP (P3 : PARENT; P4 : T2);
+ 
+           FUNCTION HF (P1 : T1) RETURN PARENT;
+           FUNCTION HF (P2 : T2) RETURN PARENT;
+      END G_PACK;
+ 
+      PACKAGE BODY G_PACK IS
+           PROCEDURE HP (P1 : PARENT; P2 : T1) IS
+           BEGIN
+                NULL;
+           END HP;
+ 
+           PROCEDURE HP (P3 : PARENT; P4 : T2) IS
+           BEGIN
+                NULL;
+           END HP;
+ 
+           FUNCTION HF (P1 : T1) RETURN PARENT IS
+           BEGIN
+                RETURN E1;
+           END HF;
+ 
+           FUNCTION HF (P2 : T2) RETURN PARENT IS
+           BEGIN
+                RETURN E2;
+           END HF;
+      END G_PACK;
+ BEGIN
+      TEST ("A83009B", "A DERIVED TYPE DECLARATION IN A GENERIC " &
+                       "UNIT MAY DERIVE TWO OR MORE SUBPROGRAM " &
+                       "HOMOGRAPHS");
+ 
+      DECLARE
+      -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION.
+ 
+           GENERIC
+           PACKAGE PACK2 IS
+                TYPE CHILD1 IS PRIVATE;
+ 
+                PACKAGE IN_PACK2 IS
+                     TYPE PARENT IS (E1, E2, E3);
+                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1);
+                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT);
+ 
+                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
+                                 RETURN PARENT;
+                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
+                                 RETURN PARENT;
+                END IN_PACK2;
+ 
+                USE IN_PACK2;
+           PRIVATE
+                TYPE CHILD1 IS NEW IN_PACK2.PARENT;  -- PRIVATE PART
+           END PACK2;                                -- OF SPEC.
+ 
+           PACKAGE BODY PACK2 IS
+                TYPE CHILD2 IS NEW CHILD1;  -- VISIBLE PART OF BODY.
+ 
+                GENERIC
+                PACKAGE IN_BODY IS
+                     TYPE CHILD3 IS NEW CHILD1; -- VISIBLE PART OF SPEC.
+                END IN_BODY;
+ 
+                GENERIC
+                PROCEDURE P;
+                PROCEDURE P IS
+                     TYPE CHILD4 IS NEW CHILD1;  -- SUBPROGRAM BODY.
+                BEGIN
+                     NULL;
+                END;
+ 
+                PACKAGE BODY IN_PACK2 IS
+                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS
+                     BEGIN
+                          NULL;
+                     END HP;
+ 
+                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS
+                     BEGIN
+                          NULL;
+                     END HP;
+ 
+                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
+                                 RETURN PARENT IS
+                     BEGIN
+                          RETURN E1;
+                     END HF;
+ 
+                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
+                                 RETURN PARENT IS
+                     BEGIN
+                          RETURN E2;
+                     END HF;
+                END IN_PACK2;
+           BEGIN
+                NULL;
+           END PACK2;
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE
+      -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS.
+ 
+           GENERIC
+           PACKAGE PACK1 IS
+                PACKAGE INSTANCE2 IS
+                   NEW G_PACK (CHARACTER, CHARACTER);
+ 
+                TYPE CHILD2 IS NEW INSTANCE2.PARENT;
+                TYPE CHILD3 IS PRIVATE;
+           PRIVATE
+                PACKAGE INSTANCE3 IS
+                     NEW G_PACK (ENUM, ENUM);
+ 
+                TYPE CHILD3 IS NEW INSTANCE3.PARENT;
+           END PACK1;
+ 
+           GENERIC
+           PROCEDURE P1;
+           PROCEDURE P1 IS
+                PACKAGE INSTANCE4 IS
+                     NEW G_PACK (BOOLEAN, BOOLEAN);
+ 
+                TYPE CHILD4 IS NEW INSTANCE4.PARENT;
+           BEGIN
+                NULL;
+           END P1;
+ 
+           PACKAGE BODY PACK1 IS
+                PACKAGE INSTANCE5 IS
+                     NEW G_PACK (ENUM, ENUM);
+ 
+                TYPE CHILD5 IS NEW INSTANCE5.PARENT;
+           END PACK1;
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END A83009B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a02a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a02a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a02a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- A83A02A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A LABEL IN A NESTED SUBPROGRAM OR PACKAGE CAN BE IDENTICAL
+ --    TO A LABEL OUTSIDE SUCH CONSTRUCT.  
+ 
+ 
+ -- "INSIDE LABEL":  INSIDE   * PACKAGE                    _PACK        A
+ --                           * FUNCTION INSIDE PACKAGE    _PACKFUN     B
+ --                           * PROCEDURE                  _PROC        C
+ --                           * PROCEDURE INSIDE BLOCK     _BLOCKPROC   D
+ 
+ -- "OUTSIDE LABEL": INSIDE   * MAIN                       _MAIN        1
+ --                           * BLOCK IN MAIN              _BLOCK       2
+ --                           * LOOP IN BLOCK IN MAIN      _BLOCKLOOP   3
+ --                           * LOOP IN MAIN               _LOOP        4
+ 
+ -- CASES TESTED:  A1  B2  A3  B4                           1 2 3 4
+ --                D1  C2  C3  D4
+ --                    D2          AB                  A    X . X .
+ --                                                    B    . X . X
+ --                                                    C    . X X .
+ --                                                    D    X . . X
+   
+ 
+ -- RM 02/09/80
+ 
+ 
+ WITH REPORT ;
+ PROCEDURE  A83A02A  IS
+ 
+      USE REPORT ;
+ 
+      PROCEDURE  PROC1  IS
+      BEGIN
+           << LAB_PROC_BLOCK >>                NULL ;    -- C2   C       
+           << LAB_PROC_BLOCKLOOP >>            NULL ;    -- C3
+      END  PROC1 ;
+ 
+      PACKAGE  PACK1  IS
+           FUNCTION  F  RETURN INTEGER ;
+      END  PACK1 ;
+ 
+      PACKAGE BODY  PACK1  IS
+           FUNCTION  F  RETURN INTEGER  IS
+           BEGIN
+                << LAB_PACKFUN_BLOCK >>        NULL ;    -- B2    B
+                << LAB_PACKFUN_LOOP >>         NULL ;    -- B4
+                << LAB_PACKFUN_PACK >>         NULL ;    -- BA (AB)
+                RETURN 7 ;
+           END  F ;
+      BEGIN
+           << LAB_PACK_MAIN >>                 NULL ;    -- A1    A
+           << LAB_PACK_BLOCKLOOP >>            NULL ;    -- A3
+           << LAB_PACKFUN_PACK >>              NULL ;    -- BA (AB)
+      END  PACK1 ;
+ 
+ BEGIN                                                       
+ 
+      TEST( "A83A02A" , "CHECK THAT A LABEL IN A NESTED SUBPROGRAM" &
+                        " OR PACKAGE CAN BE IDENTICAL TO A LABEL"   &
+                        " OUTSIDE SUCH CONSTRUCT" );
+ 
+      << LAB_PACK_MAIN >>                      NULL ;    -- A1          1
+      << LAB_BLOCKPROC_MAIN >>                 NULL ;    -- D1
+ 
+ 
+      DECLARE  -- 
+ 
+           PROCEDURE  PROC2  IS
+           BEGIN
+                << LAB_BLOCKPROC_MAIN >>       NULL ;    -- D1    D
+                << LAB_BLOCKPROC_LOOP >>       NULL ;    -- D4
+                << LAB_BLOCKPROC_BLOCK >>      NULL ;    -- D2
+           END  PROC2 ;
+ 
+      BEGIN
+ 
+           << LAB_PACKFUN_BLOCK >>             NULL ;    -- B2          2
+           << LAB_PROC_BLOCK >>                NULL ;    -- C2
+           << LAB_BLOCKPROC_BLOCK >>           NULL ;    -- D2
+ 
+           FOR  I  IN  1..2  LOOP
+                << LAB_PACK_BLOCKLOOP >>       NULL ;    -- A3          3
+                << LAB_PROC_BLOCKLOOP >>       NULL ;    -- C3
+           END LOOP;
+ 
+      END ;
+ 
+      FOR  I  IN  1..2  LOOP
+           << LAB_PACKFUN_LOOP >>              NULL ;    -- B4          4
+           << LAB_BLOCKPROC_LOOP >>            NULL ;    -- D4
+      END LOOP;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END A83A02A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a02b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a02b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a02b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- A83A02B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A LABEL IN A NESTED TASK CAN BE IDENTICAL TO A LABEL
+ --    OUTSIDE THE TASK.  
+ 
+ 
+ -- "INSIDE LABEL":  INSIDE   * TASK BODY                  _TASK        A
+ --                           * BLOCK IN TASK BODY         _TASKBLOCK   B
+ --                           * LOOP IN BLOCK IN TASK BODY _TASKBLOCKLOOP
+ --                           * ACCEPT ST. WITHIN TASK BDY _TASKACCEPT  D
+ 
+ -- "OUTSIDE LABEL": INSIDE   * MAIN                       _MAIN        1
+ --                           * BLOCK IN MAIN              _BLOCK       2
+ --                           * LOOP IN BLOCK IN MAIN      _BLOCKLOOP   3
+ --                           * LOOP IN MAIN               _LOOP        4
+ 
+ -- CASES TESTED:  A1  B2  A3  B4                        |  1 2 3 4
+ --                D1  C2  C3  D4                     ---+----------
+ --                                                    A |  X . X .
+ --                                                    B |  . X . X
+ --                                                    C |  . X X .
+ --                                                    D |  X . . X
+   
+ 
+ -- RM 02/10/80
+ 
+ 
+ WITH REPORT ;
+ PROCEDURE  A83A02B  IS
+ 
+      USE REPORT ;
+ 
+      TASK TYPE  TASK1  IS
+           ENTRY  E1 ;
+      END  TASK1 ;
+ 
+      TASK BODY  TASK1  IS
+      BEGIN
+ 
+           << LAB_TASK_MAIN >>                    NULL ;  -- A1    A
+           << LAB_TASK_BLOCKLOOP >>               NULL ;  -- A3
+ 
+           BEGIN
+ 
+                << LAB_TASKBLOCK_BLOCK >>         NULL ;  -- B2    B
+                << LAB_TASKBLOCK_LOOP >>          NULL ;  -- B4
+ 
+                FOR  I  IN  1..2  LOOP
+                     << LAB_TASKBLOCKLOOP_BLOCK >>NULL ;  -- C2    C
+                     << LAB_TASKBLOCKLOOP_BLOCKLOOP >>
+                                                  NULL ;  -- C3        
+                END LOOP;
+ 
+           END ;
+ 
+           ACCEPT  E1  DO
+                << LAB_TASKACCEPT_MAIN >>         NULL ;  -- D1    D
+                << LAB_TASKACCEPT_LOOP >>         NULL ;  -- D4
+           END  E1 ;
+ 
+      END  TASK1 ;
+ 
+ BEGIN                                                       
+ 
+      TEST( "A83A02B" , "CHECK THAT A LABEL IN A NESTED TASK" &
+                        " CAN BE IDENTICAL TO A LABEL"   &
+                        " OUTSIDE THE TASK" );
+ 
+      << LAB_TASK_MAIN >>                         NULL ;  -- A1         1
+      << LAB_TASKACCEPT_MAIN >>                   NULL ;  -- D1
+ 
+ 
+      BEGIN
+ 
+           << LAB_TASKBLOCK_BLOCK >>              NULL ;  -- B2         2
+           << LAB_TASKBLOCKLOOP_BLOCK >>          NULL ;  -- C2
+ 
+           FOR  I  IN  1..2  LOOP
+                << LAB_TASK_BLOCKLOOP >>          NULL ;  -- A3         3
+                << LAB_TASKBLOCKLOOP_BLOCKLOOP >> NULL ;  -- C3
+           END LOOP;
+ 
+      END ;
+ 
+      FOR  I  IN  1..2  LOOP
+           << LAB_TASKBLOCK_LOOP >>               NULL ;  -- B4         4
+           << LAB_TASKACCEPT_LOOP >>              NULL ;  -- D4
+      END LOOP;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END A83A02B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a06a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a06a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a06a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a06a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- A83A06A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A STATEMENT LABEL INSIDE A BLOCK BODY CAN BE THE
+ --    SAME AS A VARIABLE, CONSTANT, NAMED LITERAL, SUBPROGRAM,
+ --    ENUMERATION LITERAL, TYPE, OR PACKAGE DECLARED IN THE
+ --    ENCLOSING BODY.
+ 
+ 
+ -- RM 02/12/80
+ -- JBG 5/16/83
+ -- JBG 8/21/83
+ -- JRK 12/19/83
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  A83A06A  IS
+ 
+      LAB_VAR            :  INTEGER;
+      LAB_CONST          :  CONSTANT INTEGER := 12;
+      LAB_NAMEDLITERAL   :  CONSTANT := 13;
+      TYPE  ENUM  IS        ( AA , BB , LAB_ENUMERAL );
+      TYPE  LAB_TYPE  IS    NEW INTEGER;
+ 
+      PROCEDURE  LAB_PROCEDURE  IS
+      BEGIN
+           NULL;
+      END LAB_PROCEDURE;
+ 
+      FUNCTION  LAB_FUNCTION  RETURN INTEGER  IS
+      BEGIN
+           RETURN 7;
+      END LAB_FUNCTION;
+ 
+      PACKAGE  LAB_PACKAGE  IS
+           INT : INTEGER;
+      END LAB_PACKAGE;
+ 
+ BEGIN
+ 
+      TEST ("A83A06A", "CHECK THAT STATEMENT LABELS INSIDE A BLOCK " &
+                       "BODY CAN BE THE SAME AS IDENTIFIERS DECLARED "&
+                       "OUTSIDE THE BODY");
+ 
+      LAB_BLOCK_1 :   BEGIN  NULL;  END     LAB_BLOCK_1;
+ 
+      LAB_LOOP_1  :   LOOP   EXIT;  END LOOP LAB_LOOP_1;
+ 
+      BEGIN
+ 
+           << LAB_VAR >>                    -- OK.
+                BEGIN NULL; END;
+           << LAB_ENUMERAL >>        NULL;  -- OK.
+ 
+      << LAB_PROCEDURE >>                   -- OK.
+           FOR  I  IN  INTEGER  LOOP
+                << LAB_CONST >>      NULL;  -- OK.
+                << LAB_TYPE >>       NULL;  -- OK.
+                << LAB_FUNCTION >>   EXIT;  -- OK.
+           END LOOP;
+ 
+           << LAB_NAMEDLITERAL >>    NULL;  
+           << LAB_PACKAGE >>         NULL;  
+      END;
+ 
+      LAB_BLOCK_2 :                          -- OK.
+           BEGIN  NULL;  END LAB_BLOCK_2;
+ 
+      LAB_LOOP_2  :                          -- OK.
+           LOOP   EXIT;  END LOOP LAB_LOOP_2;
+ 
+      RESULT;
+ 
+ END A83A06A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a08a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a08a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83a08a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83a08a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- A83A08A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     A STATEMENT LABEL DECLARED OUTSIDE A BLOCK CAN HAVE THE SAME
+ --     IDENTIFIER AS AN ENTITY DECLARED IN THE BLOCK, AND A GOTO
+ --     STATEMENT USING THE LABEL IS LEGAL OUTSIDE THE BLOCK.
+ 
+ -- HISTORY:
+ --     PMW 09/20/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT;  USE REPORT;
+ WITH SYSTEM;
+ 
+ PROCEDURE A83A08A IS
+ 
+      PASSES : INTEGER := 0;
+ 
+ BEGIN
+      TEST ("A83A08A", "A STATEMENT LABEL DECLARED OUTSIDE A BLOCK " &
+                       "CAN HAVE THE SAME IDENTIFIER AS AN ENTITY " &
+                       "DECLARED IN THE BLOCK, AND A GOTO STATEMENT " &
+                       "USING THE LABEL IS LEGAL OUTSIDE THE BLOCK");
+ 
+      GOTO LBLS;
+ 
+      <<LBL>>
+ 
+      DECLARE
+           LBL : INTEGER := 1;
+      BEGIN
+           LBL := IDENT_INT (LBL);
+           PASSES := PASSES + 1;
+      END;
+ 
+      <<LBLS>>
+ 
+      BEGIN
+           DECLARE
+                TYPE STUFF IS (LBL, LBL_ONE, LBL_TWO);
+                ITEM : STUFF := LBL;
+ 
+                FUNCTION LBLS (ITEM : STUFF) RETURN BOOLEAN IS
+                BEGIN
+                     <<LBL_2>>
+                     CASE ITEM IS
+                          WHEN LBL => RETURN TRUE;
+                          WHEN LBL_ONE => PASSES := PASSES + 1;
+                          WHEN LBL_TWO => RETURN FALSE;
+                     END CASE;
+                     IF PASSES < 2 THEN
+                          PASSES := PASSES + 1;
+                          GOTO LBL_2;
+                     ELSE
+                          RETURN TRUE;
+                     END IF;
+                END LBLS;
+ 
+           BEGIN
+                CASE PASSES IS
+                     WHEN 0 => ITEM := LBL;
+                     WHEN 1 => ITEM := LBL_ONE;
+                     WHEN OTHERS => ITEM := LBL_TWO;
+                END CASE;
+                IF NOT LBLS (ITEM) THEN
+                     COMMENT ("IRRELEVANT");
+                END IF;
+           END;
+      END;
+ 
+ 
+      IF PASSES > 1 THEN
+           GOTO ENOUGH;
+      END IF;
+      GOTO LBL;
+ 
+      <<ENOUGH>>
+ 
+      RESULT;
+ 
+ END A83A08A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83c01c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83c01c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83c01c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83c01c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- A83C01C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF
+ --    FORMAL PARAMETERS, LABELS, LOOP PARAMETERS,
+ --    VARIABLES, CONSTANTS, SUBPROGRAMS, PACKAGES, TYPES.
+ -- (NAMES OF COMPONENTS IN LOGICALLY NESTED RECORDS ARE TESTED IN
+ --    C83C01B.ADA .)
+ -- (NAMES OF TASKS ARE TESTED IN  A83C01T.ADA .)
+ 
+ --    RM    24 JUNE 1980
+ --    JRK   10 NOV  1980
+ --    RM    01 JAN  1982
+ 
+ WITH REPORT;
+ PROCEDURE  A83C01C  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "A83C01C" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" &
+                        " NAMES OF VARIABLES AND CONSTANTS " ) ;
+ 
+ 
+ 
+      DECLARE
+ 
+           VAR1 , VAR2 : INTEGER := 27 ;
+           CONST1      : CONSTANT INTEGER := 13 ;
+           CONST2      : CONSTANT BOOLEAN := FALSE ;
+ 
+           TYPE  R1A  IS
+                RECORD
+                     VAR1,VAR2,CONST1:INTEGER ;
+                END RECORD ;
+ 
+           TYPE  R1  IS
+                RECORD
+                     VAR1   : INTEGER ;
+                     VAR2   : BOOLEAN ;
+                     CONST1 : BOOLEAN ;
+                     A      : R1A ;
+                END RECORD ;
+ 
+           A : R1 := ( VAR1 => VAR1 , A => ( VAR1 => VAR2 ,
+                                             VAR2 => VAR2 ,
+                                             CONST1 => VAR1 ) ,
+                       VAR2 => CONST2 , CONST1 => CONST2 ) ;
+ 
+      BEGIN
+ 
+           VAR1 := A.A.VAR2 ;
+           A.CONST1 := CONST2 ;
+           A.A.CONST1 := A.VAR1 + VAR2 ;
+ 
+      END ;
+ 
+ 
+      RESULT;
+ 
+ END A83C01C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83c01h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83c01h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83c01h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83c01h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- A83C01H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF
+ --    LABELS.
+ 
+ --    RM    24 JUNE 1980
+ --    JRK   10 NOV  1980
+ --    RM    01 JAN  1982
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  A83C01H  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "A83C01H" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" &
+                        " NAMES OF LABELS" ) ;
+ 
+ 
+      -- TEST FOR LABELS
+ 
+      DECLARE
+ 
+           TYPE  R1A  IS
+                RECORD
+                     LAB3 : INTEGER ;
+                END RECORD ;
+ 
+           TYPE  R1  IS
+                RECORD
+                     LAB1 : INTEGER ;
+                     LAB2 : R1A ;
+                END RECORD ;
+ 
+           A1 : R1 := ( 1 , ( LAB3 => 5 ) );
+ 
+      BEGIN
+ 
+           << LAB1 >>
+           << LAB2 >>
+           << LAB3 >>
+ 
+           A1.LAB1 := A1.LAB2.LAB3 ;
+ 
+           DECLARE
+ 
+                TYPE  R1A  IS
+                     RECORD
+                          LAB3 : INTEGER ;
+                          LAB4 : INTEGER ;
+                     END RECORD ;
+ 
+                TYPE  R1  IS
+                     RECORD
+                          LAB1 : INTEGER ;
+                          LAB2 : R1A ;
+                     END RECORD ;
+ 
+                A1 : R1 := ( 3 , ( 6 , 7 ) );
+ 
+           BEGIN
+ 
+                << LAB4 >>
+ 
+                A1.LAB1 := A1.LAB2.LAB3 + A1.LAB2.LAB4 ;
+ 
+           END ;
+ 
+      END ;
+ 
+ 
+ 
+      RESULT;
+ 
+ END A83C01H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83c01i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83c01i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a83c01i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a83c01i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- A83C01I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF
+ --    LOOP PARAMETERS.
+ 
+ --    RM    24 JUNE 1980
+ --    JRK   10 NOV  1980
+ --    RM    01 JAN  1982
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  A83C01I  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "A83C01I" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" &
+                        " NAMES OF LOOP PARAMETERS" ) ;
+ 
+ 
+ 
+      -- TEST FOR LOOP PARAMETERS
+ 
+ 
+      DECLARE
+ 
+           TYPE  R1A  IS
+                RECORD
+                     LOOP3 : INTEGER ;
+                END RECORD ;
+ 
+           TYPE  R1  IS
+                RECORD
+                     LOOP1 : INTEGER ;
+                     LOOP2 : R1A ;
+                END RECORD ;
+ 
+           A1 : R1 := ( 3 , ( LOOP3 => 7 ) );
+ 
+      BEGIN
+ 
+           FOR  LOOP1  IN  0..1  LOOP
+ 
+                FOR  LOOP2  IN  0..2  LOOP
+ 
+                     FOR  LOOP3  IN  0..3  LOOP
+ 
+                          A1.LOOP1 := A1.LOOP2.LOOP3 ;
+ 
+                          DECLARE
+ 
+                               TYPE  R1A  IS
+                                    RECORD
+                                         LOOP3 : INTEGER ;
+                                         LOOP4 : INTEGER ;
+                                    END RECORD ;
+ 
+                               TYPE  R1  IS
+                                    RECORD
+                                         LOOP1 : INTEGER ;
+                                         LOOP2 : R1A ;
+                                    END RECORD ;
+ 
+                               A1 : R1 := ( 3 , ( 6 , 7 ) );
+ 
+                          BEGIN
+ 
+                               FOR  LOOP4  IN  0..4  LOOP
+ 
+                                    A1.LOOP1 := A1.LOOP2.LOOP3 +
+                                                A1.LOOP2.LOOP4 ;
+ 
+                               END LOOP ;
+ 
+                          END ;
+ 
+                     END LOOP ;
+ 
+                END LOOP ;
+ 
+           END LOOP ;
+ 
+      END ;
+ 
+ 
+ 
+      RESULT;
+ 
+ END A83C01I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a85007d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a85007d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a85007d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a85007d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- A85007D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'FIRST, 'LAST, 'LENGTH, 'RANGE, 'ADDRESS, 'CONSTRAINED, 
+ -- AND 'SIZE CAN BE APPLIED TO RENAMED NON-ACCESS OUT FORMAL PARAMETERS
+ -- AND RENAMED COMPONENTS OF NON-ACCESS OUT PARAMETERS. 
+ 
+ -- SPS 02/21/84 (SEE A62006D-B.ADA)
+ -- EG  02/22/84
+ -- EG  05/30/84
+ -- JBG 12/2/84
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM;
+ 
+ PROCEDURE A85007D IS
+      
+      PROCEDURE Q (X : SYSTEM.ADDRESS) IS
+      BEGIN
+           NULL;
+      END Q;
+ 
+ BEGIN
+ 
+      TEST ("A85007D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " &
+            "RENAMED NON-ACCESS FORMAL OUT PARAMETERS");
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN;
+           TYPE REC (D : INTEGER) IS RECORD
+                Y : BOOLEAN;
+                X : ARR;
+           END RECORD;
+ 
+           PROCEDURE PROC (C2 : OUT ARR;
+                           C3 : OUT REC) IS
+ 
+                X : SYSTEM.ADDRESS;
+                I : INTEGER;
+ 
+                C21 : ARR RENAMES C2;
+                C22 : ARR RENAMES C21;
+                C31 : REC RENAMES C3;
+                C32 : REC RENAMES C31;
+                C33 : ARR RENAMES C3.X;
+                C34 : ARR RENAMES C33;
+                C35 : ARR RENAMES C32.X;
+                C36 : BOOLEAN RENAMES C3.Y;
+                C37 : BOOLEAN RENAMES C36;
+                C38 : BOOLEAN RENAMES C32.Y;
+ 
+           BEGIN
+ 
+                I := C21'LENGTH;
+                Q(C21'ADDRESS);
+                I := C21'SIZE;
+                I := C22'LENGTH;
+                Q(C22'ADDRESS);
+                I := C22'SIZE;
+ 
+                FOR I IN C21'RANGE LOOP
+                     NULL;
+                END LOOP;
+                FOR I IN C22'RANGE LOOP
+                     NULL;
+                END LOOP;
+ 
+                FOR I IN C21'FIRST..C21'LAST LOOP
+                     NULL;
+                END LOOP;
+                FOR I IN C22'FIRST..C22'LAST LOOP
+                     NULL;
+                END LOOP;
+ 
+                I := C31.X'LENGTH;
+                C3.Y := C31'CONSTRAINED;        
+                FOR J IN C31.X'RANGE LOOP
+                     NULL;
+                END LOOP;
+                FOR J IN C31.X'FIRST..C31.X'LAST LOOP
+                     NULL;
+                END LOOP;
+                I := C32.X'LENGTH;
+                C31.Y := C32'CONSTRAINED;
+                FOR J IN C32.X'RANGE LOOP
+                     NULL;
+                END LOOP;
+                FOR J IN C32.X'FIRST..C32.X'LAST LOOP
+                     NULL;
+                END LOOP;
+                I := C33'LENGTH;
+                FOR J IN C33'RANGE LOOP
+                     NULL;
+                END LOOP;
+                FOR J IN C33'FIRST..C33'LAST LOOP
+                     NULL;
+                END LOOP;
+                I := C34'LENGTH;
+                FOR J IN C34'RANGE LOOP
+                     NULL;
+                END LOOP;
+                FOR J IN C34'FIRST..C34'LAST LOOP
+                     NULL;
+                END LOOP;
+                I := C35'LENGTH;
+                FOR J IN C35'RANGE LOOP
+                     NULL;
+                END LOOP;
+                FOR J IN C35'FIRST..C35'LAST LOOP
+                     NULL;
+                END LOOP;
+ 
+                Q(C31.Y'ADDRESS);
+                I := C31.Y'SIZE;
+                Q(C32.Y'ADDRESS);
+                I := C32.Y'SIZE;
+                Q(C36'ADDRESS);
+                I := C36'SIZE;
+                Q(C37'ADDRESS);
+                I := C37'SIZE;
+                Q(C38'ADDRESS);
+                I := C38'SIZE;
+ 
+           END PROC;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END A85007D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a85013b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a85013b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a85013b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a85013b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- A85013B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT:
+ 
+ --   A) A SUBPROGRAM OR ENTRY CAN BE RENAMED WITHIN ITS OWN BODY.
+ 
+ --   B) THE NEW NAME OF A SUBPROGRAM CAN BE USED IN A RENAMING
+ --      DECLARATION.
+ 
+ -- EG  02/22/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE A85013B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("A85013B","CHECK THAT A SUBPROGRAM CAN BE RENAMED WITHIN " &
+                     "ITS OWN BODY AND THAT THE NEW NAME CAN BE USED" &
+                     " IN A RENAMING DECLARATION");
+ 
+      DECLARE
+ 
+           PROCEDURE PROC1 (A : BOOLEAN) IS
+                PROCEDURE PROC2 (B : BOOLEAN := FALSE) RENAMES PROC1;
+                PROCEDURE PROC3 (C : BOOLEAN := FALSE) RENAMES PROC2;
+           BEGIN
+                IF A THEN
+                     PROC3;
+                END IF;
+           END PROC1;
+ 
+      BEGIN
+ 
+           PROC1 (TRUE);
+ 
+      END;
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+                PROCEDURE E1 RENAMES E;
+                PROCEDURE E2 RENAMES E1;
+           BEGIN
+                ACCEPT E DO
+                     DECLARE
+                          PROCEDURE E3 RENAMES E;
+                          PROCEDURE E4 RENAMES E3;
+                     BEGIN
+                          NULL;
+                     END;
+                END E;
+           END T;
+ 
+      BEGIN
+           T.E;
+      END;
+ 
+      RESULT;
+ 
+ END A85013B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a87b59a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a87b59a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a87b59a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a87b59a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,250 ----
+ -- A87B59A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM PARAMETER MUST BE A 
+ -- SUBPROGRAM, AN ENUMERATION LITERAL, OR AN ENTRY WITH THE SAME 
+ -- PARAMETER AND RESULT TYPE PROFILE AS THE FORMAL PARAMETER, AN 
+ -- OVERLOADED NAME APPEARING AS AN ACTUAL PARAMETER CAN BE RESOLVED.
+ 
+ -- R.WILLIAMS 9/24/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE A87B59A IS
+ 
+ BEGIN
+      TEST ( "A87B59A", "CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM " &
+                        "PARAMETER MUST BE A SUBPROGRAM, AN " &
+                        "ENUMERATION LITERAL, OR AN ENTRY WITH THE " &
+                        "SAME PARAMETER AND RESULT TYPE PROFILE AS " &
+                        "THE FORMAL PARAMETER, AN OVERLOADED NAME " &
+                        "APPEARING AS AN ACTUAL PARAMETER CAN BE " &
+                        "RESOLVED" );
+ 
+      DECLARE -- A.
+           FUNCTION F1 RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (0);
+           END F1;
+ 
+           FUNCTION F1 RETURN BOOLEAN IS
+           BEGIN
+                RETURN IDENT_BOOL (TRUE);
+           END F1;
+ 
+           GENERIC
+                TYPE T IS (<>);
+                WITH FUNCTION F RETURN T;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+           BEGIN
+                NULL;
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (INTEGER, F1);
+           PROCEDURE P2 IS NEW P (BOOLEAN, F1);
+ 
+      BEGIN         
+           P1;
+           P2;
+      END; -- A.
+           
+      DECLARE -- B.
+           FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (X);
+           END F1;
+ 
+           FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN IDENT_BOOL (B);
+           END F1;
+ 
+           FUNCTION F1 (B : BOOLEAN; X : INTEGER) RETURN BOOLEAN IS
+           BEGIN
+                RETURN IDENT_BOOL (B);
+           END F1;
+           
+           GENERIC
+                TYPE T1 IS (<>);
+                TYPE T2 IS (<>);
+                WITH FUNCTION F (A : T1; B : T2) RETURN T1;
+           PROCEDURE P1;
+ 
+           PROCEDURE P1 IS
+           BEGIN
+                NULL;
+           END P1;
+ 
+           GENERIC
+                TYPE T1 IS (<>);
+                TYPE T2 IS (<>);
+                WITH FUNCTION F (A : T1; B : T2) RETURN T2;
+           PROCEDURE P2;
+ 
+           PROCEDURE P2 IS
+           BEGIN
+                NULL;
+           END P2;
+ 
+           PROCEDURE PROC1 IS NEW P1 (INTEGER, BOOLEAN, F1);
+           PROCEDURE PROC2 IS NEW P1 (BOOLEAN, INTEGER, F1);
+           PROCEDURE PROC3 IS NEW P2 (INTEGER, BOOLEAN, F1);
+ 
+      BEGIN         
+           PROC1;
+           PROC2;
+      END; -- B.
+ 
+      DECLARE -- C.
+           TYPE COLOR IS (RED, YELLOW, BLUE);
+           C : COLOR;
+ 
+           TYPE LIGHT IS (RED, YELLOW, GREEN);          
+           L : LIGHT;
+ 
+           GENERIC
+                TYPE T IS (<>);
+                WITH FUNCTION F RETURN T;
+           FUNCTION GF RETURN T;
+ 
+           FUNCTION GF RETURN T IS
+           BEGIN
+                RETURN T'VAL (IDENT_INT (T'POS (F)));
+           END GF;
+ 
+           FUNCTION F1 IS NEW GF (COLOR, RED);
+           FUNCTION F2 IS NEW GF (LIGHT, YELLOW);
+      BEGIN
+           C := F1;
+           L := F2;
+      END; -- C.
+ 
+      DECLARE -- D.
+           TASK TK IS
+                ENTRY E (X : INTEGER);
+                ENTRY E (X : BOOLEAN);
+                ENTRY E (X : INTEGER; Y : BOOLEAN);
+                ENTRY E (X : BOOLEAN; Y : INTEGER);
+           END TK;
+ 
+           TASK BODY TK IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT E (X : INTEGER);
+                     OR
+                          ACCEPT E (X : BOOLEAN);
+                     OR 
+                          ACCEPT E (X : INTEGER; Y : BOOLEAN);
+                     OR 
+                          ACCEPT E (X : BOOLEAN; Y : INTEGER);
+                     OR 
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END TK;
+ 
+           GENERIC
+                TYPE T1 IS (<>);
+                TYPE T2 IS (<>);
+                WITH PROCEDURE P1 (X : T1);
+                WITH PROCEDURE P2 (X : T1; Y : T2);
+           PACKAGE PKG IS 
+                PROCEDURE P;
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+                PROCEDURE P IS
+                BEGIN
+                     IF EQUAL (3, 3) THEN
+                          P1 (T1'VAL (1));
+                          P2 (T1'VAL (0), T2'VAL (1));
+                     END IF;
+                END P;
+           END PKG;
+ 
+           PACKAGE PK1 IS NEW PKG (INTEGER, BOOLEAN, TK.E, TK.E);
+           PACKAGE PK2 IS NEW PKG (BOOLEAN, INTEGER, TK.E, TK.E);
+ 
+      BEGIN
+           PK1.P;
+           PK2.P;               
+      END; -- D.
+ 
+      DECLARE -- E.
+           FUNCTION "+" (X, Y : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN IDENT_BOOL (X OR Y);
+           END "+";
+ 
+           GENERIC
+                TYPE T IS (<>);
+                WITH FUNCTION "+" (X, Y : T) RETURN T;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                S : T;
+           BEGIN
+                S := "+" (T'VAL (0), T'VAL (1));
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (BOOLEAN, "+");
+           PROCEDURE P2 IS NEW P (INTEGER, "+");
+      
+      BEGIN
+           P1;
+           P2;
+      END; -- E.
+           
+      DECLARE -- F.
+           TYPE ADD_OPS IS ('+', '-', '&');
+ 
+           GENERIC
+                TYPE T1 IS (<>);
+                TYPE T2 IS (<>);
+                TYPE T3 IS ARRAY (POSITIVE RANGE <> ) OF T2;
+                X2 : T2;
+                X3 : T3;
+                WITH FUNCTION F1 RETURN T1;
+                WITH FUNCTION F2 (X : T2; Y : T3) RETURN T3;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                A : T1;
+                S : T3 (IDENT_INT (1) .. IDENT_INT (2));               
+           BEGIN
+                A := F1;
+                S := F2 (X2, X3);               
+           END P;
+           
+           PROCEDURE P1 IS NEW P (ADD_OPS, CHARACTER, STRING,
+                                  '&', "&", '&', "&");
+      
+      BEGIN
+           P1;
+      END; -- F.
+           
+      RESULT;
+ END A87B59A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a95001c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a95001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a95001c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a95001c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- A95001C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE BOUNDS OF THE DISCRETE RANGE OF AN ENTRY FAMILY
+ -- ARE INTEGER LITERALS, NAMED NUMBERS, OR ATTRIBUTES HAVING TYPE 
+ -- UNIVERSAL_INTEGER, BUT NOT EXPRESSIONS OF TYPE UNIVERSAL_INTEGER,
+ -- THE INDEX (IN AN ENTRY NAME OR ACCEPT STATEMENT) IS OF THE
+ -- PREDEFINED TYPE INTEGER.
+ 
+ -- WEI  3/4/82
+ -- RJK  2/1/84     ADDED TO ACVC
+ -- TBN  1/7/86     RENAMED FROM B950DHA-B.ADA.  ADDED NAMED CONSTANTS 
+ --                 AND ATTRIBUTES AS KINDS OF BOUNDS, AND MADE TEST
+ --                 EXECUTABLE.
+ -- RJW 4/11/86     RENAMED FROM C95001C-B.ADA.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE A95001C IS
+ 
+      SUBTYPE T IS INTEGER RANGE 1 .. 10;
+      I : INTEGER := 1;
+      NAMED_INT1 : CONSTANT := 1;
+      NAMED_INT2 : CONSTANT := 2;
+ 
+      TASK T1 IS
+           ENTRY E1 (1 .. 2);
+           ENTRY E2 (NAMED_INT1 .. NAMED_INT2);
+           ENTRY E3 (T'POS(1) .. T'POS(2));
+      END T1;
+ 
+      TASK BODY T1 IS
+           I_INT : INTEGER := 1;
+           I_POS : INTEGER := 2;
+      BEGIN
+           ACCEPT E1 (I_INT);
+           ACCEPT E2 (I_POS);
+           ACCEPT E3 (T'SUCC(1));
+      END T1;
+ 
+ BEGIN
+      TEST ("A95001C", "CHECK THAT IF THE BOUNDS OF THE DISCRETE " &
+                       "RANGE OF AN ENTRY FAMILY ARE INTEGER " &
+                       "LITERALS, NAMED NUMBERS, OR " &
+                       "(UNIVERSAL_INTEGER) ATTRIBUTES, THE INDEX " &
+                       "IS OF THE PREDEFINED TYPE INTEGER");
+ 
+      T1.E1 (I);
+      T1.E2 (NAMED_INT2);
+      T1.E3 (T'SUCC(I));
+ 
+      RESULT;
+ END A95001C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a95074d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a95074d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a95074d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a95074d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- A95074D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'ADDRESS, 'CONSTRAINED, 'SIZE, 'POSITION, 'FIRST_BIT,
+ -- AND 'LAST_BIT CAN BE APPLIED TO AN OUT PARAMETER OR OUT PARAMETER
+ -- SUBCOMPONENT THAT DOES NOT HAVE AN ACCESS TYPE.
+ 
+ -- JWC 6/25/85
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM;
+ PROCEDURE A95074D IS
+ BEGIN
+ 
+      TEST ("A95074D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " &
+            "NON-ACCESS FORMAL OUT PARAMETERS");
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN;
+ 
+           TYPE REC (D : INTEGER := 1) IS RECORD
+                Y : BOOLEAN;
+                X : ARR;
+           END RECORD;
+ 
+           TASK T IS
+                ENTRY E (C1 : OUT ARR; C2 : OUT REC);
+           END T;
+ 
+           TASK BODY T IS
+                X : SYSTEM.ADDRESS;
+                I : INTEGER;
+           BEGIN
+                IF IDENT_BOOL (FALSE) THEN
+                     ACCEPT E (C1 : OUT ARR; C2 : OUT REC) DO
+ 
+                          C2.Y := C2'CONSTRAINED;
+ 
+                          X := C1'ADDRESS;
+                          X := C1(1)'ADDRESS;
+                          X := C2'ADDRESS;
+                          X := C2.Y'ADDRESS;
+ 
+                          I := C1'SIZE;
+                          I := C2.Y'SIZE;
+ 
+                          I := C2.X'POSITION;
+                          I := C2.Y'FIRST_BIT;
+                          I := C2.Y'LAST_BIT;
+                     END E;
+                END IF;
+           END T;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END A95074D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a97106a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a97106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a97106a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a97106a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- A97106A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SELECTIVE_WAIT MAY HAVE MORE THAN ONE  'DELAY'  ALTER-
+ --    NATIVE.
+ 
+ 
+ -- RM 4/27/1982
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE  A97106A  IS
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST ( "A97106A" , "CHECK THAT A SELECTIVE_WAIT MAY HAVE" &
+                         " MORE THAN ONE  'DELAY'  ALTERNATIVE" );
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK TYPE  TT  IS
+                ENTRY  A ;
+           END  TT ;
+ 
+ 
+           TASK BODY  TT  IS
+                DUMMY : BOOLEAN := FALSE ;
+           BEGIN
+ 
+                SELECT
+                          ACCEPT  A ;
+                OR
+                          DELAY 2.5 ;
+                OR
+                          ACCEPT  A ;
+                OR
+                          ACCEPT  A ;
+                OR
+                          DELAY 2.5 ;  -- MULTIPLE 'DELAY'S PERMITTED (IF
+                OR                     --     AND ONLY IF SINGLE 'DELAY'S
+                          DELAY 2.5 ;  --     ARE PERMITTED).
+                OR
+                          ACCEPT  A ;
+                END SELECT ;
+ 
+           END  TT ;
+ 
+      BEGIN
+           NULL ;
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ 
+ END  A97106A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a99006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a99006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/a99006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/a99006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- A99006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'COUNT RETURNS A UNIVERSAL INTEGER VALUE.
+ 
+ -- HISTORY:
+ --     DHH 03/28/88 CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE A99006A IS
+ 
+      TASK CHOICE IS
+           ENTRY START;
+           ENTRY E1;
+           ENTRY STOP;
+      END CHOICE;
+ 
+      TASK BODY CHOICE IS
+           X : INTEGER;
+      BEGIN
+           ACCEPT START;
+           ACCEPT E1 DO
+                DECLARE
+                     TYPE Y IS NEW INTEGER RANGE -5 .. 5;
+                     T : Y := E1'COUNT;
+                BEGIN
+                     X := E1'COUNT;
+                END;
+           END E1;
+           ACCEPT STOP;
+      END CHOICE;
+ 
+ BEGIN
+ 
+      TEST("A99006A", "CHECK THAT 'COUNT RETURNS A UNIVERSAL INTEGER " &
+                      "VALUE");
+ 
+      CHOICE.START;
+      CHOICE.E1;
+      CHOICE.STOP;
+ 
+      RESULT;
+ END A99006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/aa2010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/aa2010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/aa2010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/aa2010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,199 ----
+ -- AA2010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL TO IDENTIFIERS DECLARED IN
+ -- STANDARD, NAMELY, BOOLEAN, INTEGER, FLOAT, CHARACTER, ASCII, 
+ -- NATURAL, POSITIVE, STRING, DURATION, CONSTRAINT_ERROR, 
+ -- NUMERIC_ERROR, PROGRAM_ERROR, STORAGE_ERROR, AND TASKING_ERROR.
+ 
+ -- R.WILLIAMS 9/18/86
+ 
+ PACKAGE AA2010A_TYPEDEF IS
+      TYPE ENUM IS (E1, E2, E3);
+ END AA2010A_TYPEDEF;
+ 
+ WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF;
+ PACKAGE AA2010A_PARENT IS
+ 
+      PROCEDURE BOOLEAN;
+      FUNCTION INTEGER RETURN ENUM;
+      PACKAGE FLOAT IS END FLOAT;
+ 
+      PROCEDURE CHARACTER;
+      FUNCTION ASCII RETURN ENUM;
+ 
+      TASK NATURAL IS
+           ENTRY E;
+      END NATURAL;
+ 
+      PROCEDURE POSITIVE;
+      FUNCTION STRING RETURN ENUM;
+      PACKAGE DURATION IS END DURATION;
+ 
+      PROCEDURE CONSTRAINT_ERROR;
+      FUNCTION NUMERIC_ERROR RETURN ENUM;
+ 
+      TASK PROGRAM_ERROR IS
+           ENTRY E;
+      END PROGRAM_ERROR;
+ 
+      PROCEDURE STORAGE_ERROR;
+      FUNCTION TASKING_ERROR RETURN ENUM;
+ 
+ END AA2010A_PARENT;
+ 
+ PACKAGE BODY AA2010A_PARENT IS
+ 
+      PROCEDURE BOOLEAN IS SEPARATE;
+      FUNCTION INTEGER RETURN ENUM IS SEPARATE;
+      PACKAGE BODY FLOAT IS SEPARATE;
+ 
+      PROCEDURE CHARACTER IS SEPARATE;
+      FUNCTION ASCII RETURN ENUM IS SEPARATE;
+      TASK BODY NATURAL IS SEPARATE;
+ 
+      PROCEDURE POSITIVE IS SEPARATE;
+      FUNCTION STRING RETURN ENUM IS SEPARATE;
+      PACKAGE BODY DURATION IS SEPARATE;
+ 
+      PROCEDURE CONSTRAINT_ERROR IS SEPARATE;
+      FUNCTION NUMERIC_ERROR RETURN ENUM IS SEPARATE;
+      TASK BODY PROGRAM_ERROR IS SEPARATE;
+ 
+      PROCEDURE STORAGE_ERROR IS SEPARATE;
+      FUNCTION TASKING_ERROR RETURN ENUM IS SEPARATE;
+ 
+ END AA2010A_PARENT;
+ 
+ SEPARATE (AA2010A_PARENT)
+ PROCEDURE BOOLEAN IS 
+ BEGIN
+      NULL;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ FUNCTION INTEGER RETURN ENUM IS 
+ BEGIN
+      RETURN E1;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ PACKAGE BODY FLOAT IS END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ PROCEDURE CHARACTER IS 
+ BEGIN
+      NULL;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ FUNCTION ASCII RETURN ENUM IS 
+ BEGIN
+      RETURN E1;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ TASK BODY NATURAL IS 
+ BEGIN
+      ACCEPT E;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ PROCEDURE POSITIVE IS 
+ BEGIN
+      NULL;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ FUNCTION STRING RETURN ENUM IS 
+ BEGIN
+      RETURN E1;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ PACKAGE BODY DURATION IS END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ PROCEDURE CONSTRAINT_ERROR IS 
+ BEGIN
+      NULL;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ FUNCTION NUMERIC_ERROR RETURN ENUM IS 
+ BEGIN
+      RETURN E1;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ TASK BODY PROGRAM_ERROR IS 
+ BEGIN
+      ACCEPT E;     
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ PROCEDURE STORAGE_ERROR IS 
+ BEGIN
+      NULL;
+ END;
+ 
+ SEPARATE (AA2010A_PARENT)
+ FUNCTION TASKING_ERROR RETURN ENUM IS 
+ BEGIN
+      RETURN E1;
+ END;
+ 
+ WITH REPORT; USE REPORT;
+ WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF;
+ WITH AA2010A_PARENT; USE AA2010A_PARENT; 
+ PROCEDURE AA2010A IS
+      E : ENUM;
+ BEGIN
+      TEST ( "AA2010A", "CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL " &
+                        "TO IDENTIFIERS DECLARED IN STANDARD, " &
+                        "NAMELY, BOOLEAN, INTEGER, FLOAT, " &
+                        "CHARACTER, ASCII, NATURAL, POSITIVE, " &
+                        "STRING, DURATION, CONSTRAINT_ERROR, " &
+                        "NUMERIC_ERROR, PROGRAM_ERROR, " &
+                        "STORAGE_ERROR, AND TASKING_ERROR" );
+      
+      AA2010A_PARENT.BOOLEAN;
+      E := AA2010A_PARENT.INTEGER;
+ 
+      AA2010A_PARENT.CHARACTER;
+      E := AA2010A_PARENT.ASCII;
+      AA2010A_PARENT.NATURAL.E;
+ 
+      AA2010A_PARENT.POSITIVE;
+      E := AA2010A_PARENT.STRING;
+ 
+      AA2010A_PARENT.CONSTRAINT_ERROR;
+      E := AA2010A_PARENT.NUMERIC_ERROR;
+      AA2010A_PARENT.PROGRAM_ERROR.E;
+ 
+      AA2010A_PARENT.STORAGE_ERROR;
+      E := AA2010A_PARENT.TASKING_ERROR;
+ 
+      RESULT;
+ END AA2010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/aa2012a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/aa2012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/aa2012a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/aa2012a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- AA2012A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A BODY STUB CAN SERVE AS AN IMPLICIT DECLARATION OF A 
+ -- SUBPROGRAM, I.E., A PRECEDING SUBPROGRAM DECLARATION IS NOT 
+ -- REQUIRED.
+ 
+ -- R.WILLIAMS 9/18/86
+ 
+ PROCEDURE AA2012A1 IS
+ 
+      I : INTEGER;
+ 
+      PROCEDURE AA2012A2 IS SEPARATE;
+ 
+      FUNCTION AA2012A3 RETURN INTEGER IS SEPARATE;
+ 
+ BEGIN
+      AA2012A2;
+      I := AA2012A3;
+ 
+ END AA2012A1;
+ 
+ SEPARATE (AA2012A1)
+ PROCEDURE AA2012A2 IS
+ BEGIN
+      NULL;
+ END;
+ 
+ SEPARATE (AA2012A1)
+ FUNCTION AA2012A3 RETURN INTEGER IS
+ BEGIN
+      RETURN 5;
+ END;
+      
+ WITH AA2012A1;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AA2012A IS
+ 
+ BEGIN
+      TEST ( "AA2012A", "CHECK THAT A BODY STUB CAN SERVE AS AN " &
+                        "IMPLICIT DECLARATION OF A SUBPROGRAM, " &
+                        "I.E., A PRECEDING SUBPROGRAM DECLARATION " &
+                        "IS NOT REQUIRED" );
+ 
+      AA2012A1;
+ 
+      RESULT;
+ END AA2012A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac1015b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac1015b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac1015b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac1015b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- AC1015B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WITHIN A GENERIC SUBPROGRAM THE NAME OF THE GENERIC
+ --     SUBPROGRAM CAN BE USED AS AN ACTUAL PARAMETER IN AN
+ --     INSTANTIATION.
+ 
+ -- HISTORY:
+ --     BCB 03/28/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE AC1015B IS
+ 
+      GENERIC
+      PROCEDURE P;
+ 
+      PROCEDURE P IS
+           GENERIC
+                WITH PROCEDURE F;
+           PROCEDURE T;
+ 
+           PROCEDURE T IS
+           BEGIN
+                NULL;
+           END T;
+ 
+           PROCEDURE S IS NEW T(F => P);
+ 
+      BEGIN
+           NULL;
+      END P;
+ 
+      GENERIC
+      FUNCTION D RETURN BOOLEAN;
+ 
+      FUNCTION D RETURN BOOLEAN IS
+           GENERIC
+                WITH FUNCTION L RETURN BOOLEAN;
+           FUNCTION A RETURN BOOLEAN;
+ 
+           FUNCTION A RETURN BOOLEAN IS
+           BEGIN
+                RETURN TRUE;
+           END A;
+ 
+           FUNCTION B IS NEW A(L => D);
+ 
+      BEGIN
+           RETURN TRUE;
+      END D;
+ 
+ BEGIN
+      TEST ("AC1015B", "CHECK THAT WITHIN A GENERIC SUBPROGRAM THE " &
+                       "NAME OF THE GENERIC SUBPROGRAM CAN BE USED AS " &
+                       "AN ACTUAL PARAMETER IN AN INSTANTIATION");
+ 
+      RESULT;
+ END AC1015B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac3106a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac3106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac3106a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac3106a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,216 ----
+ -- AC3106A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN ACTUAL GENERIC IN OUT PARAMETER CAN BE:
+ --          A) ANY SUBCOMPONENT THAT DOES NOT DEPEND ON A DISCRIMINANT,
+ --             EVEN IF THE ENCLOSING VARIABLE IS UNCONSTRAINED;
+ --          B) ANY SUBCOMPONENT OF AN UNCONSTAINED VARIABLE OF A
+ --             RECORD TYPE IF THE DISCRIMINANTS OF THE
+ --             VARIABLE DO NOT HAVE DEFAULTS AND THE VARIABLE IS NOT
+ --             A GENERIC FORMAL IN OUT PARAMETER;
+ --          C) ANY COMPONENT OF AN OBJECT DESIGNATED BY AN ACCESS
+ --             VALUE.
+ 
+ -- HISTORY:
+ --     RJW 11/07/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE AC3106A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+ 
+      TYPE REC (D : INT := 0) IS RECORD
+           A : INTEGER := 5;
+           CASE D IS
+                WHEN OTHERS =>
+                     V : INTEGER := 5;
+           END CASE;
+      END RECORD;
+ 
+      TYPE AR_REC IS ARRAY (1 .. 10) OF REC;
+ 
+      TYPE R_REC IS RECORD
+           E : REC;
+      END RECORD;
+ 
+      TYPE A_STRING IS ACCESS STRING;
+      TYPE A_REC IS ACCESS REC;
+      TYPE A_AR_REC IS ACCESS AR_REC;
+      TYPE A_R_REC IS ACCESS R_REC;
+ 
+      TYPE DIS (L : INT := 1) IS RECORD
+           S : STRING (1 .. L) := "A";
+           R : REC (L);
+           AS : A_STRING (1 .. L) := NEW STRING (1 .. L);
+           AR : A_REC (L) := NEW REC (1);
+           RC : REC (3);
+           ARU : A_REC := NEW REC;
+           V_AR : AR_REC;
+           V_R : R_REC;
+           AC_AR : A_AR_REC := NEW AR_REC;
+           AC_R : A_R_REC := NEW R_REC;
+      END RECORD;
+ 
+      TYPE A_DIS IS ACCESS DIS;
+      AD : A_DIS := NEW DIS;
+ 
+      TYPE DIS2 (L : INT) IS RECORD
+           S : STRING (1 .. L);
+           R : REC (L);
+           AS : A_STRING (1 .. L);
+           AR : A_REC (L);
+      END RECORD;
+ 
+      X : DIS;
+ 
+      SUBTYPE REC3 IS REC (3);
+ 
+      GENERIC
+           GREC3 : IN OUT REC3;
+      PACKAGE PREC3 IS END PREC3;
+ 
+      SUBTYPE REC0 IS REC (0);
+ 
+      GENERIC
+           GREC0 : IN OUT REC0;
+      PACKAGE PREC0 IS END PREC0;
+ 
+      GENERIC
+           GINT : IN OUT INTEGER;
+      PACKAGE PINT IS END PINT;
+ 
+      GENERIC
+           GA_REC : IN OUT A_REC;
+      PACKAGE PA_REC IS END PA_REC;
+ 
+      GENERIC
+           GAR_REC : IN OUT AR_REC;
+      PACKAGE PAR_REC IS END PAR_REC;
+ 
+      GENERIC
+           GR_REC : IN OUT R_REC;
+      PACKAGE PR_REC IS END PR_REC;
+ 
+      GENERIC
+           GA_AR_REC : IN OUT A_AR_REC;
+      PACKAGE PA_AR_REC IS END PA_AR_REC;
+ 
+      GENERIC
+           GA_R_REC : IN OUT A_R_REC;
+      PACKAGE PA_R_REC IS END PA_R_REC;
+ 
+      TYPE BUFFER (SIZE : INT) IS RECORD
+           POS : NATURAL := 0;
+           VAL : STRING (1 .. SIZE);
+      END RECORD;
+ 
+      SUBTYPE BUFF_5 IS BUFFER (5);
+ 
+      GENERIC
+           Y : IN OUT CHARACTER;
+      PACKAGE P_CHAR IS END P_CHAR;
+ 
+      SUBTYPE STRING5 IS STRING (1 .. 5);
+      GENERIC
+           GSTRING : STRING5;
+      PACKAGE P_STRING IS END P_STRING;
+ 
+      GENERIC
+           GA_STRING : A_STRING;
+      PACKAGE P_A_STRING IS END P_A_STRING;
+ 
+      GENERIC
+           X : IN OUT BUFF_5;
+      PACKAGE P_BUFF IS
+           RX : BUFF_5 RENAMES X;
+      END P_BUFF;
+ 
+      Z : BUFFER (1) := (SIZE => 1, POS =>82, VAL =>"R");
+ BEGIN
+      TEST ("AC3106A", "CHECK THE PERMITTED FORMS OF AN ACTUAL " &
+                       "GENERIC IN OUT PARAMETER");
+ 
+      DECLARE -- A)
+           PACKAGE NPINT3 IS NEW PINT (X.RC.A);
+           PACKAGE NPINT4 IS NEW PINT (X.RC.V);
+           PACKAGE NPREC3 IS NEW PREC3 (X.RC);
+           PACKAGE NPA_REC IS NEW PA_REC (X.ARU);
+           PACKAGE NPINT5 IS NEW PINT (X.ARU.A);
+           PACKAGE NPINT6 IS NEW PINT (X.ARU.V);
+           PACKAGE NPAR_REC IS NEW PAR_REC (X.V_AR);
+           PACKAGE NPREC01 IS NEW PREC0 (X.V_AR (1));
+           PACKAGE NPR_REC IS NEW PR_REC (X.V_R);
+           PACKAGE NPREC02 IS NEW PREC0 (X.V_R.E);
+           PACKAGE NPINT7 IS NEW PINT (X.V_R.E.A);
+ 
+           PACKAGE NP_BUFF IS NEW P_BUFF (Z);
+           USE NP_BUFF;
+ 
+           PACKAGE NP_CHAR3 IS NEW P_CHAR (RX.VAL (1));
+ 
+           PROCEDURE PROC (X : IN OUT BUFFER) IS
+                PACKAGE NP_CHAR4 IS NEW P_CHAR (X.VAL (1));
+           BEGIN
+                NULL;
+           END;
+      BEGIN
+           NULL;
+      END; -- A)
+ 
+      DECLARE -- B)
+           PROCEDURE PROC (Y : IN OUT DIS2) IS
+                PACKAGE NP_STRING IS NEW P_STRING (Y.S);
+                PACKAGE NP_CHAR IS NEW P_CHAR (Y.S (1));
+                PACKAGE NP_A_STRING IS NEW P_A_STRING (Y.AS);
+                PACKAGE NP_CHAR2 IS NEW P_CHAR (Y.AS (1));
+                PACKAGE NPINT3 IS NEW PINT (Y.R.A);
+                PACKAGE NPINT4 IS NEW PINT (Y.R.V);
+                PACKAGE NPREC3 IS NEW PREC3 (Y.R);
+                PACKAGE NPA_REC IS NEW PA_REC (Y.AR);
+                PACKAGE NPINT5 IS NEW PINT (Y.AR.A);
+                PACKAGE NPINT6 IS NEW PINT (Y.AR.V);
+           BEGIN
+                NULL;
+           END;
+      BEGIN
+           NULL;
+      END; -- B)
+ 
+      DECLARE -- C)
+           PACKAGE NP_CHAR IS NEW P_CHAR (AD.S (1));
+           PACKAGE NP_A_STRING IS NEW P_A_STRING (AD.AS);
+           PACKAGE NP_CHAR2 IS NEW P_CHAR (AD.AS (1));
+           PACKAGE NPINT3 IS NEW PINT (AD.R.A);
+           PACKAGE NPINT4 IS NEW PINT (AD.R.V);
+           PACKAGE NPREC3 IS NEW PREC3 (AD.R);
+           PACKAGE NPA_REC IS NEW PA_REC (AD.AR);
+           PACKAGE NPINT5 IS NEW PINT (AD.AR.A);
+           PACKAGE NPINT6 IS NEW PINT (AD.AR.V);
+      BEGIN
+           NULL;
+      END; -- C)
+ 
+      RESULT;
+ END AC3106A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac3206a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac3206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac3206a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac3206a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- AC3206A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN INSTANTIATION IS LEGAL IF A FORMAL PRIVATE TYPE IS
+ --     USED IN  A CONSTANT DECLARATION AND THE ACTUAL PARAMETER IS A
+ --     TYPE WITH DISCRIMINANTS THAT DO AND DO NOT HAVE DEFAULTS. (CHECK
+ --     CASES THAT USED TO BE FORBIDDEN).
+ 
+ -- HISTORY:
+ --     DHH 09/16/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE AC3206A IS
+ 
+ BEGIN
+      TEST ("AC3206A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " &
+                       "FORMAL PRIVATE TYPE IS USED IN  A CONSTANT " &
+                       "DECLARATION AND THE ACTUAL PARAMETER IS A " &
+                       "TYPE WITH DISCRIMINANTS THAT DO AND DO NOT " &
+                       "HAVE DEFAULTS");
+ 
+      DECLARE             -- CHECK DEFAULTS LEGAL UNDER AI-37.
+ 
+           GENERIC
+                TYPE GEN IS PRIVATE;
+                INIT : GEN;
+           PACKAGE GEN_PACK IS
+                CONST : CONSTANT GEN := INIT;
+                SUBTYPE NEW_GEN IS GEN;
+           END GEN_PACK;
+ 
+           TYPE REC(A : INTEGER := 4) IS
+                RECORD
+                     X : INTEGER;
+                     Y : BOOLEAN;
+                END RECORD;
+ 
+           PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE));
+           USE P;
+ 
+           CON : CONSTANT P.NEW_GEN := (4, 5, FALSE);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE GEN(DIS : INTEGER) IS PRIVATE;
+                INIT : GEN;
+           PACKAGE GEN_PACK IS
+                CONST : CONSTANT GEN := INIT;
+                SUBTYPE NEW_GEN IS GEN(4);
+           END GEN_PACK;
+ 
+           TYPE REC(A : INTEGER := 4) IS
+                RECORD
+                     X : INTEGER;
+                     Y : BOOLEAN;
+                END RECORD;
+ 
+           PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE));
+           USE P;
+ 
+           CON : CONSTANT P.NEW_GEN := (4, 5, FALSE);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE GEN(DIS : INTEGER) IS PRIVATE;
+                INIT : GEN;
+           PACKAGE GEN_PACK IS
+                CONST : CONSTANT GEN := INIT;
+                SUBTYPE NEW_GEN IS GEN(4);
+           END GEN_PACK;
+ 
+           TYPE REC(A : INTEGER) IS
+                RECORD
+                     X : INTEGER;
+                     Y : BOOLEAN;
+                END RECORD;
+ 
+           PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE));
+           USE P;
+ 
+           CON : CONSTANT P.NEW_GEN := (4, 5, FALSE);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END AC3206A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac3207a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac3207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ac3207a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ac3207a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- AC3207A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN INSTANTIATION IS LEGAL IF A FORMAL PARAMETER
+ --     HAVING A LIMITED PRIVATE TYPE WITHOUT DISCRIMINANTS IS USED TO
+ --     DECLARE AN OBJECT IN A BLOCK THAT CONTAINS A SELECTIVE WAIT
+ --     WITH A TERMINATE ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE
+ --     TYPE IS A TASK TYPE OR A TYPE WITH A SUBCOMPONENT OF A TASK TYPE.
+ 
+ -- HISTORY:
+ --     DHH 09/16/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE AC3207A IS
+ 
+      GENERIC
+           TYPE PRIV IS LIMITED PRIVATE;
+      PACKAGE GEN_P IS
+           TASK T1 IS
+                ENTRY E;
+           END T1;
+      END GEN_P;
+ 
+      TASK TYPE TASK_T IS
+      END TASK_T;
+ 
+      TYPE REC IS
+           RECORD
+                OBJ : TASK_T;
+           END RECORD;
+ 
+      PACKAGE BODY GEN_P IS
+           TASK BODY T1 IS
+           BEGIN
+                DECLARE
+                     OBJ : PRIV;
+                BEGIN
+                     SELECT
+                          ACCEPT E;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END;
+           END T1;
+      END GEN_P;
+ 
+      TASK BODY TASK_T IS
+      BEGIN
+           NULL;
+      END;
+ 
+      PACKAGE P IS NEW GEN_P(TASK_T);
+      PACKAGE NEW_P IS NEW GEN_P(REC);
+ 
+ BEGIN
+      TEST ("AC3207A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " &
+                       "FORMAL PARAMETER HAVING A LIMITED PRIVATE " &
+                       "TYPE WITHOUT DISCRIMINANTS IS USED TO " &
+                       "DECLARE AN OBJECT IN A BLOCK THAT CONTAINS " &
+                       "A SELECTIVE WAIT WITH A TERMINATE " &
+                       "ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE " &
+                       "TYPE IS A TASK TYPE OR A TYPE WITH A " &
+                       "SUBCOMPONENT OF A TASK TYPE");
+ 
+      P.T1.E;
+ 
+      NEW_P.T1.E;
+ 
+      RESULT;
+ END AC3207A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- AD7001B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
+ --     IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE UNIT
+ --     CONTAINING THE REFERENCES.
+ 
+ -- HISTORY:
+ --     JET 09/08/87  CREATED ORIGINAL TEST.
+ --     VCL 03/30/88  CREATED NAMED NUMBERS WITH VALUES OF
+ --                   SYSTEM.MIN_INT AND SYSTEM.MAX_INT. DELETED
+ --                   ASSIGNMENTS OF MIN_INT AND MAX_INT TO INTEGER
+ --                   VARIABLES.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7001B IS
+ 
+      CHECK_ADDRESS  : SYSTEM.ADDRESS;
+      CHECK_NAME     : SYSTEM.NAME := SYSTEM.SYSTEM_NAME;
+      CHECK_PRIORITY : SYSTEM.PRIORITY;
+      I              : INTEGER;
+      F              : FLOAT;
+      SMALL          : CONSTANT := SYSTEM.MIN_INT;
+      LARGE          : CONSTANT := SYSTEM.MAX_INT;
+      MEM            : CONSTANT := SYSTEM.MEMORY_SIZE;
+ 
+ BEGIN
+ 
+      TEST ("AD7001B", "CHECK THAT A DECLARATION IN PACKAGE " &
+                       "SYSTEM IS ACCESSIBLE IF A WITH CLAUSE " &
+                       "NAMING SYSTEM IS PROVIDED FOR THE UNIT " &
+                       "CONTAINING THE REFERENCES");
+ 
+      I := SYSTEM.STORAGE_UNIT;
+      I := SYSTEM.MAX_DIGITS;
+      I := SYSTEM.MAX_MANTISSA;
+      F := SYSTEM.FINE_DELTA;
+      F := SYSTEM.TICK;
+ 
+      RESULT;
+ 
+ END AD7001B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- AD7001C0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
+ --     IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM
+ --     IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN A
+ --     SEPARATE FILE.
+ 
+ -- HISTORY:
+ --     JET 09/09/87  CREATED ORIGINAL TEST.
+ --     RJW 05/03/88  REVISED AND ENTERED TEST INTO ACVC.
+ --     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ -- THIS FILE CONTAINS PACKAGE SPEC AD7001C_PACKAGE AND THE MAIN
+ --     PROCEDURE FOR TEST AD7001C.  FILE AD7001C1.ADA CONTAINS
+ --     THE PACKAGE BODY FOR THE PACKAGE SPEC AND IS ALSO REQUIRED
+ --     FOR TEST EXECUTION.
+ 
+ WITH SYSTEM;
+ 
+ PACKAGE AD7001C_PACKAGE IS
+ 
+      I : INTEGER;
+      F : FLOAT;
+ 
+   PROCEDURE REQUIRE_BODY;
+ 
+ END AD7001C_PACKAGE;
+ 
+ 
+ WITH AD7001C_PACKAGE; USE AD7001C_PACKAGE;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7001C0M IS
+ 
+ BEGIN
+      TEST ("AD7001C", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " &
+                       "IS ACCESSIBLE IN A LIBRARY PACKAGE BODY IF " &
+                       "A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR " &
+                       "THE PACKAGE SPECIFICATION, ALTHOUGH IN A " &
+                       "SEPARATE FILE");
+      RESULT;
+ END AD7001C0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- AD7001C1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
+ --     IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM
+ --     IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN ANOTHER
+ --     FILE.
+ 
+ -- HISTORY:
+ --     JET 09/09/87  CREATED ORIGINAL TEST.
+ --     RJW 05/03/88  REVISED AND ENTERED IN ACVC.
+ --     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ -- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001C_PACKAGE.
+ --     FILE AD7001C0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE
+ --     FOR TEST AD7001C AND IS ALSO REQUIRED FOR TEST EXECUTION.
+ 
+ PACKAGE BODY AD7001C_PACKAGE IS
+ 
+      CHECK_ADDRESS  : SYSTEM.ADDRESS;
+      CHECK_NAME     : SYSTEM.NAME := SYSTEM.SYSTEM_NAME;
+      CHECK_PRIORITY : SYSTEM.PRIORITY;
+      MEM_SIZE       : CONSTANT := SYSTEM.MEMORY_SIZE;
+ 
+      TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ 
+ BEGIN
+      I := SYSTEM.STORAGE_UNIT;
+      I := SYSTEM.MAX_DIGITS;
+      I := SYSTEM.MAX_MANTISSA;
+      F := SYSTEM.FINE_DELTA;
+      F := SYSTEM.TICK;
+ END AD7001C_PACKAGE;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001d0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001d0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001d0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- AD7001D0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE
+ --     IN A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED
+ --     FOR THE MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A
+ --     SEPARATE FILE.
+ 
+ -- HISTORY:
+ --     JET 09/09/87  CREATED ORIGINAL TEST.
+ --     RJW 05/03/88  REVISED AND ENTERED TEST INTO ACVC.
+ 
+ -- THIS FILE CONTAINS THE MAIN PROCEDURE FOR TEST AD7001D.  FILE
+ --     AD7001D1.ADA CONTAINS THE PACKAGE BODY FOR THE SUBUNIT PACKAGE
+ --     SPEC AND IS ALSO REQUIRED FOR TEST EXECUTION.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7001D0M IS
+ 
+      PACKAGE AD7001D_PACKAGE IS
+ 
+           I : INTEGER;
+           F : FLOAT;
+ 
+      END AD7001D_PACKAGE;
+ 
+      PACKAGE BODY AD7001D_PACKAGE IS SEPARATE;
+ 
+ BEGIN
+      TEST ("AD7001D", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " &
+                       "IS ACCESSIBLE IN A SUBUNIT IF A WITH CLAUSE " &
+                       "NAMING SYSTEM IS PROVIDED FOR THE MAIN UNIT " &
+                       "CONTAINING THE SUBUNIT, ALTHOUGH IN A " &
+                       "SEPARATE FILE");
+      RESULT;
+ END AD7001D0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001d1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7001d1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7001d1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,55 ----
+ -- AD7001D1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE IN
+ --     A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE
+ --     MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A SEPARATE
+ --     FILE.
+ 
+ -- HISTORY:
+ --     JET 09/09/87  CREATED ORIGINAL TEST.
+ 
+ -- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001D_PACKAGE.
+ --     FILE AD7001D0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE
+ --     FOR TEST AD7001D AND IS ALSO REQUIRED FOR TEST EXECUTION.
+ 
+ SEPARATE (AD7001D0M)
+ 
+ PACKAGE BODY AD7001D_PACKAGE IS
+ 
+      CHECK_ADDRESS  : SYSTEM.ADDRESS;
+      CHECK_NAME     : SYSTEM.NAME := SYSTEM.SYSTEM_NAME;
+      CHECK_PRIORITY : SYSTEM.PRIORITY;
+      MEM_SIZE       : CONSTANT := SYSTEM.MEMORY_SIZE;
+ 
+      TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
+ 
+ BEGIN
+      I := SYSTEM.STORAGE_UNIT;
+      I := SYSTEM.MAX_DIGITS;
+      I := SYSTEM.MAX_MANTISSA;
+      F := SYSTEM.FINE_DELTA;
+      F := SYSTEM.TICK;
+ END AD7001D_PACKAGE;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,47 ----
+ -- AD7006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS DECLARED AND
+ --     THAT IT IS A STATIC UNIVERSAL INTEGER.
+ 
+ -- HISTORY:
+ --     VCL  09/14/87  CREATED ORIGINAL TEST.
+ --     RJW  06/13/89  MODIFIED TEST AND REMOVED INTEGER VARIABLE.
+ 
+ WITH SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AD7006A IS
+ BEGIN
+      TEST ("AD7006A", "THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS " &
+                       "DECLARED AND IT IS A STATIC UNIVERSAL " &
+                       "INTEGER");
+ 
+      DECLARE
+           MY_MSIZE : CONSTANT := SYSTEM.MEMORY_SIZE - 1;
+      BEGIN
+           RESULT;
+      END;
+ 
+ END AD7006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7101a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7101a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7101a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ -- AD7101A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT MIN_INT AND MAX_INT ARE DECLARED IN PACKAGE SYSTEM
+ --     AND THAT BOTH ARE STATIC AND HAVE TYPE <UNIVERSAL INTEGER>.
+ 
+ -- HISTORY:
+ --     JET 09/10/87  CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7101A IS
+ 
+ U_MIN : CONSTANT := SYSTEM.MIN_INT;
+ U_MAX : CONSTANT := SYSTEM.MAX_INT;
+ 
+ TYPE S_MIN IS RANGE SYSTEM.MIN_INT .. 7;
+ TYPE S_MAX IS RANGE 7 .. SYSTEM.MAX_INT;
+ 
+ BEGIN
+ 
+      TEST ("AD7101A", "CHECK THAT MIN_INT AND MAX_INT ARE DECLARED " &
+                       "IN PACKAGE SYSTEM AND THAT BOTH ARE STATIC " &
+                       "AND HAVE TYPE <UNIVERSAL INTEGER>");
+ 
+      RESULT;
+ 
+ END AD7101A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7101c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7101c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7101c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7101c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- AD7101C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT TYPE DEFINITIONS WITH RANGES -MAX_INT .. MAX_INT
+ --     AND MIN_INT .. MAX_INT ARE ACCEPTED.
+ 
+ -- HISTORY:
+ --     JET 09/10/87  CREATED ORIGINAL TEST.
+ --     VCL 03/30/88  CHANGED INTEGER SUBTYPE DECLARATIONS TO TYPE
+ --                   DEFINITIONS.
+ 
+ WITH SYSTEM;  USE SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7101C IS
+ 
+      TYPE CHECK1 IS RANGE -MAX_INT .. MAX_INT;
+      TYPE CHECK2 IS RANGE  MIN_INT .. MAX_INT;
+ 
+ BEGIN
+ 
+      TEST ("AD7101C", "CHECK THAT TYPE DEFINITIONS WITH RANGES " &
+                       "-MAX_INT .. MAX_INT AND MIN_INT .. MAX_INT " &
+                       "ARE ACCEPTED");
+ 
+      RESULT;
+ 
+ END AD7101C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7102a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7102a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7102a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- AD7102A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE CONSTANT MAX_DIGITS IS DECLARED WITHIN THE
+ --     PACKAGE SYSTEM, THAT ITS TYPE IS <UNIVERSAL_INTEGER>, AND THAT
+ --     ITS VALUE IS STATIC.
+ 
+ -- HISTORY:
+ --     BCB 09/10/87  CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7102A IS
+ 
+      U_DIGITS : CONSTANT := SYSTEM.MAX_DIGITS;
+ 
+      TYPE S_DIGITS IS RANGE 7 .. SYSTEM.MAX_DIGITS;
+ 
+ BEGIN
+ 
+      TEST ("AD7102A", "CHECK THAT THE CONSTANT MAX_DIGITS IS " &
+                       "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " &
+                       "TYPE IS <UNIVERSAL_INTEGER>, AND THAT ITS " &
+                       "VALUE IS STATIC");
+      RESULT;
+ 
+ END AD7102A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7103a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7103a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7103a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- AD7103A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE CONSTANT MAX_MANTISSA IS DECLARED WITHIN THE
+ --     PACKAGE SYSTEM, THAT ITS TYPE IS <UNIVERSAL_INTEGER>, AND THAT
+ --     ITS VALUE IS STATIC.
+ 
+ -- HISTORY:
+ --     BCB 09/10/87  CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7103A IS
+ 
+      U_MANTISSA : CONSTANT := SYSTEM.MAX_MANTISSA;
+ 
+      TYPE S_MANTISSA IS RANGE 7 .. SYSTEM.MAX_MANTISSA;
+ 
+ BEGIN
+ 
+      TEST ("AD7103A", "CHECK THAT THE CONSTANT MAX_MANTISSA IS " &
+                       "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " &
+                       "TYPE IS <UNIVERSAL_INTEGER>, AND THAT ITS " &
+                       "VALUE IS STATIC");
+      RESULT;
+ 
+ END AD7103A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7103c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7103c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7103c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7103c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- AD7103C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE CONSTANT FINE_DELTA IS DECLARED WITHIN THE
+ --     PACKAGE SYSTEM, THAT ITS TYPE IS <UNIVERSAL_REAL>, AND THAT
+ --     ITS VALUE IS STATIC.
+ 
+ -- HISTORY:
+ --     BCB 09/10/87  CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7103C IS
+ 
+      U_DELTA : CONSTANT := SYSTEM.FINE_DELTA;
+ 
+      TYPE S_DELTA IS DELTA SYSTEM.FINE_DELTA RANGE -1.0 .. 1.0;
+ 
+ BEGIN
+ 
+      TEST ("AD7103C", "CHECK THAT THE CONSTANT FINE_DELTA IS " &
+                       "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " &
+                       "TYPE IS <UNIVERSAL_REAL>, AND THAT ITS " &
+                       "VALUE IS STATIC");
+      RESULT;
+ 
+ END AD7103C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7104a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7104a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7104a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- AD7104A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE CONSTANT TICK IS DECLARED WITHIN THE PACKAGE
+ --     SYSTEM, THAT ITS TYPE IS <UNIVERSAL_REAL>, AND THAT ITS VALUE
+ --     IS STATIC.
+ 
+ -- HISTORY:
+ --     BCB 09/10/87  CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ 
+ PROCEDURE AD7104A IS
+ 
+      U_TICK: CONSTANT := SYSTEM.TICK;
+ 
+      F : FLOAT := SYSTEM.TICK;
+ 
+ BEGIN
+ 
+      TEST ("AD7104A", "CHECK THAT THE CONSTANT TICK IS DECLARED " &
+                       "WITHIN THE PACKAGE SYSTEM, THAT ITS TYPE IS " &
+                       "<UNIVERSAL_REAL>, AND THAT ITS VALUE IS STATIC");
+ 
+      RESULT;
+ 
+ END AD7104A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7201a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7201a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7201a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- AD7201A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE PREFIX OF THE 'ADDRESS ATTRIBUTE CAN DENOTE A
+ --     PACKAGE, SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL.
+ 
+ -- HISTORY:
+ --     DHH 09/01/88  CREATED ORIGINAL TEST.
+ --     RJW 02/23/90  REMOVED TESTS FOR THE 'ADDRESS ATTRIBUTE APPLIED TO
+ --                   A GENERIC UNIT.  REMOVED DECLARATION OF TYPE
+ --                   "COLOR".
+ --     DTN 11/22/91  DELETED SUBPART (A).
+ 
+ WITH SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AD7201A IS
+ 
+      SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS;
+ 
+ BEGIN
+      TEST ("AD7201A", "CHECK THAT THE PREFIX OF THE 'ADDRESS " &
+                       "ATTRIBUTE CAN DENOTE A PACKAGE, " &
+                       "SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL");
+ 
+      DECLARE
+           PACKAGE B IS
+           END B;
+           B1 : BOOLEAN := (B'ADDRESS IN MY_ADDRESS);
+ 
+           PROCEDURE C;
+           C1 : BOOLEAN := (C'ADDRESS IN MY_ADDRESS);
+ 
+           FUNCTION D RETURN BOOLEAN;
+           D1 : BOOLEAN := (D'ADDRESS IN MY_ADDRESS);
+ 
+           TASK E IS
+           END E;
+           E1 : BOOLEAN := (E'ADDRESS IN MY_ADDRESS);
+ 
+           TASK TYPE F IS
+           END F;
+           F1 : BOOLEAN := (F'ADDRESS IN MY_ADDRESS);
+ 
+           G1 : BOOLEAN;
+ 
+           PACKAGE BODY B IS
+           BEGIN
+                NULL;
+           END B;
+ 
+           PROCEDURE C IS
+           BEGIN
+                NULL;
+           END C;
+ 
+           FUNCTION D RETURN BOOLEAN IS
+           BEGIN
+                RETURN TRUE;
+           END D;
+ 
+           TASK BODY E IS
+           BEGIN
+                NULL;
+           END E;
+ 
+           TASK BODY F IS
+           BEGIN
+                NULL;
+           END F;
+ 
+      BEGIN
+ <<G>>     G1 := (G'ADDRESS IN MY_ADDRESS);
+      END;
+ 
+      RESULT;
+ END AD7201A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7203b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7203b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7203b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- AD7203B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE PREFIX OF THE 'SIZE' ATTRIBUTE CAN BE AN OBJECT,
+ --     A TYPE, OR A SUBTYPE.
+ 
+ -- HISTORY:
+ --     BCB  09/27/88  CREATED ORIGINAL TEST BY MODIFYING AND RENAMING
+ --                    CD7203B.ADA.
+ 
+ WITH SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AD7203B IS
+ 
+      TYPE I_REC IS
+           RECORD
+                I1, I2 : INTEGER;
+           END RECORD;
+ 
+      I   : INTEGER;
+      I_A : ARRAY (1 ..5) OF INTEGER;
+      I_R : I_REC;
+ 
+      I_SIZE : INTEGER := I'SIZE;
+      I_A_SIZE : INTEGER := I_A'SIZE;
+      I_R_SIZE : INTEGER := I_R'SIZE;
+      I_A_1_SIZE : INTEGER := I_A(1)'SIZE;
+      I_R_I1_SIZE : INTEGER := I_R.I1'SIZE;
+ 
+      TYPE FIXED IS DELTA 0.01 RANGE -1.0 .. 1.0;
+      TYPE FXD_REC IS
+           RECORD
+                FXD1, FXD2 : FIXED;
+           END RECORD;
+ 
+      FXD   : FIXED;
+      FXD_A : ARRAY (1 .. 5) OF FIXED;
+      FXD_R : FXD_REC;
+ 
+      FXD_SIZE : INTEGER := FXD'SIZE;
+      FXD_A_SIZE : INTEGER := FXD_A'SIZE;
+      FXD_R_SIZE : INTEGER := FXD_R'SIZE;
+      FXD_A_1_SIZE : INTEGER := FXD_A(1)'SIZE;
+      FXD_R_FXD1_SIZE : INTEGER := FXD_R.FXD1'SIZE;
+ 
+      TYPE FLT_REC IS
+           RECORD
+                FLT1, FLT2 : FLOAT;
+           END RECORD;
+ 
+      FLT   : FLOAT;
+      FLT_A : ARRAY (1 .. 5) OF FLOAT;
+      FLT_R : FLT_REC;
+ 
+      FLT_SIZE : INTEGER := FLT'SIZE;
+      FLT_A_SIZE : INTEGER := FLT_A'SIZE;
+      FLT_R_SIZE : INTEGER := FLT_R'SIZE;
+      FLT_A_1_SIZE : INTEGER := FLT_A(1)'SIZE;
+      FLT_R_FLT1_SIZE : INTEGER := FLT_R.FLT1'SIZE;
+ 
+      SUBTYPE TINY_INT IS INTEGER RANGE 0 .. 255;
+      TYPE TI_REC IS
+           RECORD
+                TI1, TI2 : TINY_INT;
+           END RECORD;
+ 
+      TI   : TINY_INT;
+      TI_A : ARRAY (1 .. 5) OF TINY_INT;
+      TI_R : TI_REC;
+ 
+      TINY_INT_SIZE : INTEGER := TINY_INT'SIZE;
+      TI_SIZE : INTEGER := TI'SIZE;
+      TI_A_SIZE : INTEGER := TI_A'SIZE;
+      TI_R_SIZE : INTEGER := TI_R'SIZE;
+      TI_A_1_SIZE : INTEGER := TI_A(1)'SIZE;
+      TI_R_TI1_SIZE : INTEGER := TI_R.TI1'SIZE;
+ 
+      TYPE STR IS ARRAY (TINY_INT RANGE <>) OF CHARACTER;
+      TYPE STR_2 IS ARRAY (1 .. 127) OF CHARACTER;
+      TYPE STR_REC IS
+           RECORD
+                S1, S2 : STR (TINY_INT'FIRST .. TINY_INT'LAST);
+           END RECORD;
+ 
+      S   : STR (TINY_INT'FIRST .. TINY_INT'LAST);
+      S_A : ARRAY (1 .. 5) OF STR (TINY_INT'FIRST .. TINY_INT'LAST);
+      S_R : STR_REC;
+ 
+      STR_2_SIZE : INTEGER := STR_2'SIZE;
+      S_SIZE : INTEGER := S'SIZE;
+      S_A_SIZE : INTEGER := S_A'SIZE;
+      S_R_SIZE : INTEGER := S_R'SIZE;
+      S_A_1_SIZE : INTEGER := S_A(1)'SIZE;
+      S_R_S1_SIZE : INTEGER := S_R.S1'SIZE;
+ 
+      TYPE C_REC IS
+           RECORD
+                C1, C2 : CHARACTER;
+           END RECORD;
+ 
+      C   : CHARACTER;
+      C_A : ARRAY (1 .. 5) OF CHARACTER;
+      C_R : C_REC;
+ 
+      C_SIZE : INTEGER := C'SIZE;
+      C_A_SIZE : INTEGER := C_A'SIZE;
+      C_R_SIZE : INTEGER := C_R'SIZE;
+      C_A_1_SIZE : INTEGER := C_A(1)'SIZE;
+      C_R_C1_SIZE : INTEGER := C_R.C1'SIZE;
+ 
+      TYPE B_REC IS
+           RECORD
+                B1, B2 : BOOLEAN;
+           END RECORD;
+ 
+      B   : BOOLEAN;
+      B_A : ARRAY (1 .. 5) OF BOOLEAN;
+      B_R : B_REC;
+ 
+      B_SIZE : INTEGER := B'SIZE;
+      B_A_SIZE : INTEGER := B_A'SIZE;
+      B_R_SIZE : INTEGER := B_R'SIZE;
+      B_A_1_SIZE : INTEGER := B_A(1)'SIZE;
+      B_R_B1_SIZE : INTEGER := B_R.B1'SIZE;
+ 
+      TYPE DISCR IS RANGE 1 .. 2;
+      TYPE DISCR_REC (D : DISCR := 1) IS
+           RECORD
+                CASE D IS
+                     WHEN 1 =>
+                          C1_I : INTEGER;
+                     WHEN 2 =>
+                          C2_I1 : INTEGER;
+                          C2_I2 : INTEGER;
+                END CASE;
+           END RECORD;
+ 
+      DR_UC : DISCR_REC;
+      DR_C  : DISCR_REC (2);
+      DR_A  : ARRAY (1 .. 5) OF DISCR_REC;
+ 
+      DR_UC_SIZE : INTEGER := DR_UC'SIZE;
+      DR_C_SIZE : INTEGER := DR_C'SIZE;
+      DR_A_SIZE : INTEGER := DR_A'SIZE;
+      DR_UC_C1_I_SIZE : INTEGER := DR_UC.C1_I'SIZE;
+      DR_A_1_SIZE : INTEGER := DR_A(1)'SIZE;
+ 
+      TYPE ENUM IS (E1, E2, E3, E4);
+      TYPE ENUM_REC IS
+           RECORD
+                E1, E2 : ENUM;
+           END RECORD;
+ 
+      E   : ENUM;
+      E_A : ARRAY (1 .. 5) OF ENUM;
+      E_R : ENUM_REC;
+ 
+      E_SIZE : INTEGER := E'SIZE;
+      E_A_SIZE : INTEGER := E_A'SIZE;
+      E_R_SIZE : INTEGER := E_R'SIZE;
+      E_A_1_SIZE : INTEGER := E_A(1)'SIZE;
+      E_R_E1_SIZE : INTEGER := E_R.E1'SIZE;
+ 
+      TASK TYPE TSK IS END TSK;
+      TYPE TSK_REC IS
+           RECORD
+                TSK1, TSK2 : TSK;
+           END RECORD;
+ 
+      T   : TSK;
+      T_A : ARRAY (1 .. 5) OF TSK;
+      T_R : TSK_REC;
+ 
+      T_SIZE : INTEGER := T'SIZE;
+      T_A_SIZE : INTEGER := T_A'SIZE;
+      T_R_SIZE : INTEGER := T_R'SIZE;
+      T_A_1_SIZE : INTEGER := T_A(1)'SIZE;
+      T_R_TSK1_SIZE : INTEGER := T_R.TSK1'SIZE;
+ 
+      TYPE ACC IS ACCESS INTEGER;
+      TYPE ACC_REC IS
+           RECORD
+                A1, A2 : ACC;
+           END RECORD;
+ 
+      A   : ACC;
+      A_A : ARRAY (1 .. 5) OF ACC;
+      A_R : ACC_REC;
+ 
+      A_SIZE : INTEGER := A'SIZE;
+      A_A_SIZE : INTEGER := A_A'SIZE;
+      A_R_SIZE : INTEGER := A_R'SIZE;
+      A_A_1_SIZE : INTEGER := A_A(1)'SIZE;
+      A_R_A1_SIZE : INTEGER := A_R.A1'SIZE;
+ 
+      PACKAGE PK IS
+           TYPE PRV IS PRIVATE;
+           TYPE PRV_REC IS
+                RECORD
+                     P1, P2 : PRV;
+                END  RECORD;
+ 
+           TYPE LPRV IS LIMITED PRIVATE;
+           TYPE LPRV_REC IS
+                RECORD
+                     LP1, LP2 : LPRV;
+                END RECORD;
+      PRIVATE
+           TYPE PRV IS NEW INTEGER;
+ 
+           TYPE LPRV IS NEW INTEGER;
+      END PK;
+      USE PK;
+ 
+      P   : PRV;
+      P_A : ARRAY (1 .. 5) OF PRV;
+      P_R : PRV_REC;
+ 
+      P_SIZE : INTEGER := P'SIZE;
+      P_A_SIZE : INTEGER := P_A'SIZE;
+      P_R_SIZE : INTEGER := P_R'SIZE;
+      P_A_1_SIZE : INTEGER := P_A(1)'SIZE;
+      P_R_P1_SIZE : INTEGER := P_R.P1'SIZE;
+ 
+      LP   : LPRV;
+      LP_A : ARRAY (1 .. 5) OF LPRV;
+      LP_R : LPRV_REC;
+ 
+      LP_SIZE : INTEGER := LP'SIZE;
+      LP_A_SIZE : INTEGER := LP_A'SIZE;
+      LP_R_SIZE : INTEGER := LP_R'SIZE;
+      LP_A_1_SIZE : INTEGER := LP_A(1)'SIZE;
+      LP_R_LP1_SIZE : INTEGER := LP_R.LP1'SIZE;
+ 
+      TASK BODY TSK IS
+      BEGIN
+           NULL;
+      END TSK;
+ 
+ BEGIN
+      TEST ("AD7203B", "CHECK THAT THE PREFIX OF THE 'SIZE' ATTRIBUTE " &
+                       "CAN BE AN OBJECT, A TYPE, OR A SUBTYPE");
+ 
+      RESULT;
+ END AD7203B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7205b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad7205b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad7205b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- AD7205B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE PREFIX OF THE 'STORAGE_SIZE ATTRIBUTE CAN BE AN
+ --     ACCESS TYPE, A TASK TYPE, A TASK OBJECT, OR A SINGLE TASK.
+ 
+ -- HISTORY:
+ --     JET 09/22/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE AD7205B IS
+ 
+      B : BOOLEAN;
+ 
+      TYPE A IS ACCESS INTEGER;
+      TASK TYPE T;
+      T1 : T;
+      TASK T2;
+ 
+      TASK BODY T IS
+      BEGIN
+           NULL;
+      END T;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           NULL;
+      END T2;
+ 
+ BEGIN
+ 
+      TEST ("AD7205B", "CHECK THAT THE PREFIX OF THE 'STORAGE_SIZE " &
+                       "ATTRIBUTE CAN BE AN ACCESS TYPE, A TASK TYPE, " &
+                       "A TASK OBJECT, OR A SINGLE TASK");
+ 
+      B := A'STORAGE_SIZE = T'STORAGE_SIZE;   -- ACCESS AND TASK TYPES.
+      B := T1'STORAGE_SIZE = T2'STORAGE_SIZE; -- TASK OBJECT & SINGLE
+                                              --   TASK.
+ 
+      RESULT;
+ 
+ END AD7205B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad8011a.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad8011a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ad8011a.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ad8011a.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- AD8011A.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CODE STATEMENTS ARE ALLOWED IN A PROCEDURE BODY.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+ --     MACHINE CODE INSERTIONS.
+ 
+ --     IF SUCH INSERTIONS ARE NOT SUPPORTED, THE "WITH MACHINE_CODE"
+ --     CLAUSE MUST BE REJECTED.
+ 
+ 
+ -- MACRO SUBSTITUTION:
+ --     IF MACHINE CODE INSERTIONS ARE SUPPORTED THEN THE MACRO
+ --     $MACHINE_CODE_STATEMENT MUST BE REPLACED BY A VALID CODE
+ --     STATEMENT.
+ 
+ --     IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED, THEN SUBSTITUTE
+ --     THE ADA NULL STATEMENT (IE: NULL;) FOR $MACHINE_CODE_STATEMENT.
+ 
+ -- HISTORY:
+ --     DHH 08/30/88  CREATED ORIGINAL TEST.
+ 
+ WITH MACHINE_CODE;                            -- N/A => ERROR.
+ USE MACHINE_CODE;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AD8011A IS
+ 
+      PROCEDURE CODE IS
+      BEGIN
+           $MACHINE_CODE_STATEMENT
+      END;
+ 
+ BEGIN
+      TEST("AD8011A", "CHECK THAT CODE STATEMENTS ARE ALLOWED IN " &
+                      "A PROCEDURE BODY");
+ 
+      CODE;
+ 
+      RESULT;
+ END AD8011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ada101a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ada101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ada101a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ada101a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- ADA101A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT UNCHECKED_DEALLOCATION CAN BE INSTANTIATED WITH ANY
+ --     TYPE AS THE OBJECT PARAMETER.
+ 
+ -- HISTORY:
+ --     JET 09/23/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ WITH UNCHECKED_DEALLOCATION;
+ PROCEDURE ADA101A IS
+ 
+      TYPE ENUM IS (CURLY, MOE, LARRY);
+      TYPE DER IS NEW INTEGER;
+      SUBTYPE SUB IS CHARACTER RANGE 'A'..'Z';
+      TASK TYPE TSK;
+      TYPE ACC IS ACCESS INTEGER;
+ 
+      PACKAGE P IS
+           TYPE PRIV IS PRIVATE;
+      PRIVATE
+           TYPE PRIV IS RANGE -100..100;
+      END P;
+      USE P;
+ 
+      TYPE ARR1 IS ARRAY (INTEGER RANGE 1..10) OF INTEGER;
+      TYPE ARR2 IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+ 
+      TYPE REC1 IS RECORD
+           D, I : INTEGER;
+      END RECORD;
+ 
+      TYPE REC2 (D : INTEGER) IS RECORD
+           C : CHARACTER;
+      END RECORD;
+ 
+      TYPE INTEGERA IS ACCESS INTEGER;
+      TYPE FLOATA IS ACCESS FLOAT;
+      TYPE ENUMA IS ACCESS ENUM;
+      TYPE BOOLEANA IS ACCESS BOOLEAN;
+      TYPE CHARACTERA IS ACCESS CHARACTER;
+      TYPE DERA IS ACCESS DER;
+      TYPE SUBA IS ACCESS SUB;
+      TYPE TSKA IS ACCESS TSK;
+      TYPE ACCA IS ACCESS ACC;
+      TYPE PRIVA IS ACCESS PRIV;
+      TYPE ARR1A IS ACCESS ARR1;
+      TYPE ARR2A IS ACCESS ARR2;
+      TYPE REC1A IS ACCESS REC1;
+      TYPE REC2A IS ACCESS REC2;
+ 
+      TASK BODY TSK IS
+      BEGIN
+           NULL;
+      END TSK;
+ 
+      PROCEDURE RLSI IS NEW UNCHECKED_DEALLOCATION(INTEGER, INTEGERA);
+      PROCEDURE RLSF IS NEW UNCHECKED_DEALLOCATION(FLOAT, FLOATA);
+      PROCEDURE RLSE IS NEW UNCHECKED_DEALLOCATION(ENUM, ENUMA);
+      PROCEDURE RLSB IS NEW UNCHECKED_DEALLOCATION(BOOLEAN, BOOLEANA);
+      PROCEDURE RLSC IS NEW UNCHECKED_DEALLOCATION(CHARACTER,CHARACTERA);
+      PROCEDURE RLSD IS NEW UNCHECKED_DEALLOCATION(DER, DERA);
+      PROCEDURE RLSS IS NEW UNCHECKED_DEALLOCATION(SUB, SUBA);
+      PROCEDURE RLST IS NEW UNCHECKED_DEALLOCATION(TSK, TSKA);
+      PROCEDURE RLSA IS NEW UNCHECKED_DEALLOCATION(ACC, ACCA);
+      PROCEDURE RLSP IS NEW UNCHECKED_DEALLOCATION(PRIV, PRIVA);
+      PROCEDURE RLSA1 IS NEW UNCHECKED_DEALLOCATION(ARR1, ARR1A);
+      PROCEDURE RLSA2 IS NEW UNCHECKED_DEALLOCATION(ARR2, ARR2A);
+      PROCEDURE RLSR1 IS NEW UNCHECKED_DEALLOCATION(REC1, REC1A);
+      PROCEDURE RLSR2 IS NEW UNCHECKED_DEALLOCATION(REC2, REC2A);
+ 
+ BEGIN
+      TEST ("ADA101A", "CHECK THAT UNCHECKED_DEALLOCATION CAN BE " &
+                       "INSTANTIATED WITH ANY TYPE AS THE OBJECT " &
+                       "PARAMETER");
+ 
+      RESULT;
+ END ADA101A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae2113a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae2113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae2113a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae2113a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- AE2113A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE,
+ -- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT
+ -- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES.
+ 
+ -- TBN  9/30/86
+ 
+ WITH DIRECT_IO;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AE2113A IS
+ 
+      PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+      USE DIR_IO;
+ 
+      TEMP : FILE_TYPE;
+ 
+ BEGIN
+      TEST ("AE2113A", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " &
+                       "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " &
+                       "IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT " &
+                       "SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER " &
+                       "NAMES");
+      BEGIN
+           CREATE (FILE=> TEMP, MODE=> OUT_FILE,
+                   NAME=> "AE2113A.DAT", FORM=> "");
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           RESET (FILE=> TEMP, MODE=> OUT_FILE);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           CLOSE (FILE=> TEMP);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           OPEN (FILE=> TEMP, MODE=> OUT_FILE,
+                   NAME=> "AE2113A.DAT", FORM=> "");
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF IS_OPEN (FILE=> TEMP) THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF MODE (FILE=> TEMP) /= OUT_FILE THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF NAME (FILE=> TEMP) /= "AE2113A.DAT" THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF FORM (FILE=> TEMP) /= "" THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           DELETE (FILE=> TEMP);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      RESULT;
+ END AE2113A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae2113b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae2113b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae2113b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae2113b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- AE2113B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE,
+ -- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND THAT
+ -- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES.
+ 
+ -- TBN  9/30/86
+ 
+ WITH SEQUENTIAL_IO;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AE2113B IS
+ 
+      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+      USE SEQ_IO;
+ 
+      TEMP : FILE_TYPE;
+ 
+ BEGIN
+      TEST ("AE2113B", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " &
+                       "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " &
+                       "IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND " &
+                       "THAT SUBPROGRAMS HAVE THE CORRECT FORMAL " &
+                       "PARAMETER NAMES");
+      BEGIN
+           CREATE (FILE=> TEMP, MODE=> OUT_FILE,
+                   NAME=> "AE2113B.DAT", FORM=> "");
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           RESET (FILE=> TEMP, MODE=> OUT_FILE);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           CLOSE (FILE=> TEMP);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           OPEN (FILE=> TEMP, MODE=> OUT_FILE,
+                   NAME=> "AE2113B.DAT", FORM=> "");
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF IS_OPEN (FILE=> TEMP) THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF MODE (FILE=> TEMP) /= OUT_FILE THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF NAME (FILE=> TEMP) /= "AE2113B.DAT" THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF FORM (FILE=> TEMP) /= "" THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           DELETE (FILE=> TEMP);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      RESULT;
+ END AE2113B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3002g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3002g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3002g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3002g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,47 ----
+ -- AE3002G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FILE_MODE IS VISIBLE AND HAS LITERALS IN_FILE AND
+ -- OUT_FILE.  ASLO CHECK THAT TYPE_SET IS VISIBLE AND HAS LITERALS
+ -- LOWER_CASE AND UPPER_CASE.
+ 
+ -- TBN  10/3/86
+ 
+ WITH TEXT_IO; USE TEXT_IO;
+ WITH REPORT; USE REPORT;
+ PROCEDURE AE3002G IS
+ 
+      TEMP_FILE : FILE_TYPE;
+      MODE : FILE_MODE := IN_FILE;
+      LETTERS : TYPE_SET := LOWER_CASE;
+ 
+ BEGIN
+      TEST ("AE3002G", "CHECK THAT FILE_MODE AND TYPE_SET ARE VISIBLE " &
+                       "AND CHECK THEIR LITERALS");
+ 
+      MODE := OUT_FILE;
+      LETTERS := UPPER_CASE;
+ 
+      RESULT;
+ END AE3002G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3101a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3101a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3101a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,135 ----
+ -- AE3101A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CREATE, OPEN, CLOSE, DELETE, RESET, MODE, NAME,
+ --     FORM, IS_OPEN, AND END_OF_FILE ARE AVAILABLE FOR TEXT FILES.
+ --     ALSO CHECK THAT FORMAL PARAMETER NAMES ARE CORRECT.
+ 
+ -- HISTORY:
+ --     ABW 08/24/82
+ --     SPS 09/16/82
+ --     SPS 11/09/82
+ --     DWC 09/24/87  REMOVED DEPENDENCE ON FILE SUPPORT.
+ 
+ WITH REPORT;
+ USE REPORT;
+ WITH TEXT_IO;
+ USE TEXT_IO;
+ 
+ PROCEDURE AE3101A IS
+ 
+      FILE1 : FILE_TYPE;
+ 
+ BEGIN
+ 
+      TEST ("AE3101A" , "CHECK THAT CREATE, OPEN, DELETE, " &
+                        "RESET, MODE, NAME, FORM, IS_OPEN, " &
+                        "AND END_OF_FILE ARE AVAILABLE " &
+                        "FOR TEXT FILE");
+ 
+      BEGIN
+           CREATE (FILE => FILE1,
+                   MODE => OUT_FILE,
+                   NAME => LEGAL_FILE_NAME,
+                   FORM => "");
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           RESET (FILE => FILE1, MODE => IN_FILE);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           CLOSE (FILE => FILE1);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           OPEN (FILE => FILE1,
+                 MODE => IN_FILE,
+                 NAME => LEGAL_FILE_NAME,
+                 FORM => "");
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      IF IS_OPEN (FILE => FILE1) THEN
+           NULL;
+      END IF;
+ 
+      BEGIN
+           IF MODE (FILE => FILE1) /= IN_FILE THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF NAME (FILE => FILE1) /= LEGAL_FILE_NAME THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF FORM (FILE => FILE1) /= "" THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           IF END_OF_FILE (FILE => FILE1) THEN
+                NULL;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      BEGIN
+           DELETE (FILE => FILE1);
+      EXCEPTION
+           WHEN OTHERS =>
+                NULL;
+      END;
+ 
+      RESULT;
+ 
+ END AE3101A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3702a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3702a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3702a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3702a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- AE3702A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR USER DEFINED INTEGER
+ -- TYPES.
+ 
+ -- SPS 10/1/82
+ 
+ WITH REPORT; USE REPORT;
+ WITH TEXT_IO; USE TEXT_IO;
+ 
+ PROCEDURE AE3702A IS
+ BEGIN
+ 
+      TEST ("AE3702A", "CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR " &
+                       "USER DEFINED TYPES");
+ 
+      DECLARE
+           TYPE I1 IS RANGE 6 .. 14;
+           TYPE I2 IS NEW INTEGER;
+           TYPE I3 IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+           SUBTYPE S1 IS INTEGER RANGE 6 .. 14;
+           SUBTYPE S2 IS INTEGER;
+           SUBTYPE S3 IS INTEGER RANGE 0 .. INTEGER'LAST;
+ 
+           PACKAGE NIO1 IS NEW INTEGER_IO (I1);
+           PACKAGE NIO2 IS NEW INTEGER_IO (I2);
+           PACKAGE NIO3 IS NEW INTEGER_IO (I3);
+           PACKAGE NIO4 IS NEW INTEGER_IO (S1);
+           PACKAGE NIO5 IS NEW INTEGER_IO (S2);
+           PACKAGE NIO6 IS NEW INTEGER_IO (S3);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END AE3702A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3709a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3709a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/a/ae3709a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/a/ae3709a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,56 ----
+ -- AE3709A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THE NAMES OF THE FORMAL PARAMETERS.
+ 
+ -- JBG 3/30/83
+ 
+ WITH REPORT; USE REPORT;
+ WITH TEXT_IO; USE TEXT_IO;
+ 
+ PROCEDURE AE3709A IS
+ 
+      PACKAGE INT IS NEW INTEGER_IO(INTEGER);
+      USE INT;
+      FILE : FILE_TYPE;
+      STR  : STRING(1..3);
+      LAST : POSITIVE;
+      ITEM : INTEGER;
+ 
+ BEGIN
+ 
+      TEST ("AE3709A", "CHECK NAMES OF FORMAL PARAMETERS");
+ 
+      IF EQUAL(2, 3) THEN
+           GET (FILE => FILE, ITEM => ITEM, WIDTH => 0);
+           GET (ITEM => ITEM, WIDTH => 0);
+           PUT (FILE => FILE, ITEM => ITEM, WIDTH => 4, BASE => 4);
+           PUT (ITEM => ITEM, WIDTH => 4, BASE => 4);
+           GET (FROM => STR, ITEM => ITEM, LAST => LAST);
+           PUT (TO   => STR, ITEM => ITEM, BASE => 4);
+      END IF;
+ 
+      RESULT;
+ 
+ END AE3709A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C23001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UPPER AND LOWER CASE LETTERS ARE EQUIVALENT IN IDENTIFIERS
+ -- (INCLUDING RESERVED WORDS).
+ 
+ -- JRK 12/12/79
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C23001A IS
+ 
+         USE REPORT;
+ 
+         AN_IDENTIFIER : INTEGER := 1;
+ 
+ BEGIN
+         TEST ("C23001A", "UPPER/LOWER CASE EQUIVALENCE IN IDENTIFIERS");
+ 
+         DECLARE
+                 an_identifier : INTEGER := 3;
+         BEGIN
+                 IF an_identifier /= AN_IDENTIFIER THEN
+                         FAILED ("LOWER CASE NOT EQUIVALENT TO UPPER " &
+                                 "IN DECLARABLE IDENTIFIERS");
+                 END IF;
+         END;
+ 
+         IF An_IdEnTIfieR /= AN_IDENTIFIER THEN
+                 FAILED ("MIXED CASE NOT EQUIVALENT TO UPPER IN " &
+                         "DECLARABLE IDENTIFIERS");
+         END IF;
+ 
+         if AN_IDENTIFIER = 1 ThEn
+                 AN_IDENTIFIER := 2;
+         END IF;
+         IF AN_IDENTIFIER /= 2 THEN
+                 FAILED ("LOWER AND/OR MIXED CASE NOT EQUIVALENT TO " &
+                         "UPPER IN RESERVED WORDS");
+         END IF;
+ 
+         RESULT;
+ END C23001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003a.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003a.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003a.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C23003A.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT VARIABLE IDENTIFIERS CAN BE AS LONG AS THE MAXIMUM LENGTH
+ -- IDENTIFIER PERMITTED AND THAT ALL CHARACTERS ARE SIGNIFICANT.
+ 
+ -- JRK 12/12/79
+ -- JRK 1/11/80
+ -- JWC 6/28/85   RENAMED TO -AB
+ -- KAS 12/04/95 CHANGED "INPUT LINE LENGTH" TO "LENGTH IDENTIFIER"
+ 
+ WITH REPORT;
+ PROCEDURE C23003A IS
+ 
+         USE REPORT;
+ 
+ BEGIN
+         TEST ("C23003A", "MAXIMUM LENGTH VARIABLE IDENTIFIERS");
+ 
+         -- BIG_ID1 AND BIG_ID2 ARE TWO MAXIMUM LENGTH IDENTIFIERS THAT
+         -- DIFFER ONLY IN THEIR LAST CHARACTER.
+ 
+         DECLARE
+ $BIG_ID1
+                                         -- BIG_ID1
+                         : INTEGER := 1;
+         BEGIN
+                 DECLARE
+ $BIG_ID2
+                                                 -- BIG_ID2
+                                 : INTEGER := 2;
+                 BEGIN
+ 
+                         IF
+ $BIG_ID1
+                                                 -- BIG_ID1
+                                 +
+ $BIG_ID2
+                                                 -- BIG_ID2
+                                         /= 3 THEN
+                                 FAILED ("IDENTIFIERS AS LONG AS " &
+                                         "MAXIMUM INPUT LINE LENGTH " &
+                                         "NOT PERMITTED OR NOT " &
+                                         "DISTINGUISHED BY DISTINCT " &
+                                         "SUFFIXES");
+                         END IF;
+ 
+                 END;
+         END;
+ 
+         -- BIG_ID3 AND BIG_ID4 ARE TWO MAXIMUM LENGTH IDENTIFIERS THAT
+         -- DIFFER ONLY IN THEIR MIDDLE CHARACTER.
+ 
+         DECLARE
+ $BIG_ID3
+                                         -- BIG_ID3
+                         : INTEGER := 3;
+         BEGIN
+                 DECLARE
+ $BIG_ID4
+                                                 -- BIG_ID4
+                                 : INTEGER := 4;
+                 BEGIN
+ 
+                         IF
+ $BIG_ID3
+                                                 -- BIG_ID3
+                                 +
+ $BIG_ID4
+                                                 -- BIG_ID4
+                                         /= 7 THEN
+                                 FAILED ("IDENTIFIERS AS LONG AS " &
+                                         "MAXIMUM INPUT LINE LENGTH " &
+                                         "NOT PERMITTED OR NOT " &
+                                         "DISTINGUISHED BY DISTINCT " &
+                                         "MIDDLES");
+                         END IF;
+ 
+                 END;
+         END;
+ 
+         RESULT;
+ END C23003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003b.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003b.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003b.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003b.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C23003B.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- CHECK THAT THE NAME OF A LIBRARY UNIT PACKAGE AND THE NAME OF A LIBRARY
+ -- SUBPROGRAM CAN BE AS LONG AS THE LONGEST IDENTIFIER ALLOWED BY
+ -- AN IMPLEMENTATION.
+ 
+ -- JBG 5/26/85
+ -- DTN 3/25/92  CONSOLIDATION OF C23003B.TST AND C23003C.TST.
+ -- KAS 11/04/95 CHANGE "LINE" TO "IDENTIFIER"
+ 
+ PACKAGE
+ $BIG_ID1
+ IS
+   A : INTEGER := 1;
+ END
+ $BIG_ID1
+ ;
+ PACKAGE
+ $BIG_ID2
+ IS
+   B : INTEGER := 2;
+ END
+ $BIG_ID2
+ ;
+ 
+ PROCEDURE
+ $BIG_ID3
+      (X : OUT INTEGER) IS
+ BEGIN
+      X := 1;
+ END
+ $BIG_ID3
+ ;
+ PROCEDURE
+ $BIG_ID4
+      (X : OUT INTEGER) IS
+ BEGIN
+      X := 2;
+ END
+ $BIG_ID4
+ ;
+ 
+ WITH
+ $BIG_ID1
+ ,
+ $BIG_ID2
+ ,
+ $BIG_ID3
+ ,
+ $BIG_ID4
+ ;
+ USE
+ $BIG_ID1
+ ,
+ $BIG_ID2
+ ;
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23003B IS
+      X1, X2 : INTEGER := 0;
+ BEGIN
+      TEST ("C23003B", "CHECK LONGEST POSSIBLE IDENTIFIER CAN BE USED " &
+                       "FOR LIBRARY PACKAGE AND SUBPROGRAM");
+ 
+      IF A + IDENT_INT(1) /= B THEN
+           FAILED ("INCORRECT PACKAGE IDENTIFICATION");
+      END IF;
+ 
+ 
+ $BIG_ID3
+           (X1);
+ $BIG_ID4
+           (X2);
+ 
+      IF X1 + IDENT_INT(1) /= X2 THEN
+           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
+      END IF;
+ 
+      RESULT;
+ END C23003B; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003g.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003g.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003g.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003g.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- C23003G.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NAME OF A GENERIC LIBRARY UNIT PACKAGE AND THE NAME
+ -- OF A GENERIC LIBRARY UNIT SUBPROGRAM CAN BE AS LONG 
+ 
+ -- JBG 5/26/85
+ -- DTN 3/25/92  CONSOLIDATION OF C23003G.TST AND C23003H.TST.
+ -- KAS 12/4/95  CHANGE "LINE" TO "IDENTIFIER"
+ 
+ GENERIC
+ PACKAGE
+ $BIG_ID1
+ IS
+   A : INTEGER := 1;
+ END
+ $BIG_ID1
+ ;
+ GENERIC
+ PACKAGE
+ $BIG_ID2
+ IS
+   B : INTEGER := 2;
+ END
+ $BIG_ID2
+ ;
+ 
+ GENERIC
+ FUNCTION
+ $BIG_ID3
+ RETURN INTEGER;
+ 
+ FUNCTION
+ $BIG_ID3
+ RETURN INTEGER IS
+ BEGIN
+      RETURN 3;
+ END
+ $BIG_ID3
+ ;
+ 
+ GENERIC
+ FUNCTION
+ $BIG_ID4
+ RETURN INTEGER;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION
+ $BIG_ID4
+ RETURN INTEGER IS
+ BEGIN
+      RETURN IDENT_INT(4);
+ END
+ $BIG_ID4
+ ;
+ 
+ WITH
+ $BIG_ID3
+ ;
+ PRAGMA ELABORATE (
+ $BIG_ID3
+ );
+ FUNCTION F1 IS NEW
+ $BIG_ID3
+ ;
+ 
+ WITH
+ $BIG_ID1
+ ;
+ PRAGMA ELABORATE (
+ $BIG_ID1
+ );
+ PACKAGE C23003G_PKG IS NEW
+ $BIG_ID1
+ ;
+ WITH C23003G_PKG, F1,
+ $BIG_ID2
+ ,
+ $BIG_ID4
+ ;
+ USE C23003G_PKG;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23003G IS
+ 
+      PACKAGE P2 IS NEW
+ $BIG_ID2
+ ;
+      USE P2;
+      FUNCTION F2 IS NEW
+ $BIG_ID4
+ ;
+ 
+ BEGIN
+      TEST ("C23003G", "CHECK LONGEST POSSIBLE IDENTIFIER CAN BE USED " &
+                       "FOR GENERIC LIBRARY PACKAGE AND SUBPROGRAM");
+ 
+      IF A + IDENT_INT(1) /= B THEN
+           FAILED ("INCORRECT PACKAGE IDENTIFICATION");
+      END IF;
+ 
+ 
+      IF F1 + IDENT_INT(1) /= F2 THEN
+           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
+      END IF;
+ 
+      RESULT;
+ END C23003G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003i.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003i.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23003i.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23003i.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C23003I.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE LONGEST POSSIBLE IDENTIFIER CAN BE THE NAME OF A
+ -- LIBRARY PACKAGE CREATED BY A GENERIC INSTANTIATION.
+ 
+ -- JBG 5/26/85
+ -- DTN 3/25/92  DELETED TEST OF TWO MAXIMUM LENGTH PACKAGE NAMES THAT
+ --              DIFFER ONLY IN THEIR MIDDLE CHARACTER.
+ 
+ GENERIC
+      C : INTEGER;
+ PACKAGE C23003I_PKG IS
+      A : INTEGER := C;
+ END C23003I_PKG;
+ 
+ WITH C23003I_PKG;
+ PRAGMA ELABORATE (C23003I_PKG);
+ PACKAGE
+ $BIG_ID1
+      IS NEW C23003I_PKG (1);
+ 
+ WITH REPORT; USE REPORT;
+ WITH C23003I_PKG;
+ PRAGMA ELABORATE (REPORT, C23003I_PKG);
+ PACKAGE
+ $BIG_ID2
+      IS NEW C23003I_PKG (IDENT_INT(2));
+ 
+ WITH
+ $BIG_ID1
+ ,
+ $BIG_ID2
+ ;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23003I IS
+ BEGIN
+      TEST ("C23003I", "CHECK THAT LONGEST POSSIBLE IDENTIFIER CAN BE " &
+                       "USED FOR A LIBRARY PACKAGE INSTANTIATION");
+ 
+      IF 
+ $BIG_ID1
+           .A + IDENT_INT(1) /=
+ $BIG_ID2
+           .A THEN
+               FAILED ("INCORRECT PACKAGE IDENTIFICATION");
+      END IF;
+ 
+      RESULT;
+ END C23003I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,48 ----
+ -- C23006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN IDENTIFIERS.
+ 
+ -- JRK 12/12/79
+ -- JBG 5/25/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23006A IS
+ 
+         AN_IDENTIFIER : INTEGER := 1;
+ 
+ BEGIN
+         TEST ("C23006A", "UNDERSCORES ARE SIGNFICANT IN IDENTIFERS");
+ 
+         DECLARE
+                 ANIDENTIFIER : INTEGER := 3;
+         BEGIN
+                 IF ANIDENTIFIER = AN_IDENTIFIER THEN
+                         FAILED ("UNDERSCORE IGNORED " &
+                                 "IN DECLARABLE IDENTIFIERS");
+                 END IF;
+         END;
+ 
+         RESULT;
+ END C23006A; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- C23006B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY PACKAGE IDENTIFIERS
+ 
+ -- JBG 5/26/85
+ -- PWN 5/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ PACKAGE C23006B_PKG IS
+      A : INTEGER := 1;
+ END C23006B_PKG;
+ 
+ PACKAGE C23006BPKG IS
+      D : INTEGER := 4;
+      PROCEDURE REQUIRE_BODY;
+ END C23006BPKG;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY C23006BPKG IS
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ BEGIN
+      D := IDENT_INT (5);
+ END C23006BPKG;
+ 
+ WITH C23006BPKG, C23006B_PKG;
+ USE C23006BPKG, C23006B_PKG;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23006B IS
+ BEGIN
+      TEST ("C23006B", "CHECK UNDERSCORES ARE SIGNIFICANT " &
+                       "FOR LIBRARY PACKAGE IDENTIFIERS");
+ 
+      IF A + IDENT_INT(4) /= D THEN
+           FAILED ("INCORRECT PACKAGE IDENTIFICATION");
+      END IF;
+ 
+      RESULT;
+ END C23006B; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C23006C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNDERSCORES ARE SIGNFICANT IN NAMES OF LIBRARY
+ -- SUBPROGRAMS. 
+ 
+ -- JBG 5/26/85
+ 
+ PROCEDURE C23006C_PROC (X : OUT INTEGER) IS
+ BEGIN
+      X := 1;
+ END C23006C_PROC;
+ 
+ PROCEDURE C23006CPROC (X : OUT INTEGER);
+ 
+ PROCEDURE C23006CPROC (X : OUT INTEGER) IS
+ BEGIN
+      X := 2;
+ END C23006CPROC;
+ 
+ FUNCTION C23006C_FUNC RETURN INTEGER IS
+ BEGIN
+      RETURN 3;
+ END C23006C_FUNC;
+ 
+ FUNCTION C23006CFUNC RETURN INTEGER;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION C23006CFUNC RETURN INTEGER IS
+ BEGIN
+      RETURN IDENT_INT(4);
+ END C23006CFUNC;
+ 
+ WITH C23006C_PROC, C23006CPROC, C23006C_FUNC, C23006CFUNC;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23006C IS
+      X1, X2 : INTEGER;
+ BEGIN
+      TEST ("C23006C", "CHECK UNDERSCORES ARE SIGNIFICANT " &
+                       "FOR LIBRARY SUBPROGRAM");
+ 
+      C23006C_PROC (X1);
+      C23006CPROC (X2);
+      IF X1 + IDENT_INT(1) /= X2 THEN
+           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
+      END IF;
+ 
+      IF C23006C_FUNC + IDENT_INT(1) /= C23006CFUNC THEN
+           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
+      END IF;
+ 
+      RESULT;
+ END C23006C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C23006D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN THE NAMES OF GENERIC
+ -- LIBRARY PACKAGES
+ 
+ -- JBG 5/26/85
+ -- PWN 5/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ GENERIC
+ PACKAGE C23006D_PKG IS
+      A : INTEGER := 1;
+ END C23006D_PKG;
+ 
+ GENERIC
+ PACKAGE C23006DPKG IS
+      D : INTEGER := 2;
+      PROCEDURE REQUIRE_BODY;
+ END C23006DPKG;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY C23006DPKG IS
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ BEGIN
+      D := IDENT_INT (5);
+ END C23006DPKG;
+ 
+ WITH C23006D_PKG;
+ PRAGMA ELABORATE (C23006D_PKG);
+ PACKAGE C23006D_INST IS NEW C23006D_PKG;
+ 
+ WITH C23006DPKG, C23006D_INST;
+ USE C23006D_INST;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23006D IS
+ 
+      PACKAGE P2 IS NEW C23006DPKG;
+      USE P2;
+ 
+ BEGIN
+      TEST ("C23006D", "CHECK UNDERSCORES ARE SIGNIFICANT " &
+                       "FOR GENERIC LIBRARY PACKAGE IDENTIFIERS");
+ 
+      IF A + IDENT_INT(4) /= D THEN
+           FAILED ("INCORRECT PACKAGE IDENTIFICATION - 1");
+      END IF;
+ 
+      RESULT;
+ END C23006D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C23006E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN THE NAMES OF GENERIC
+ -- LIBRARY UNIT SUBPROGRAMS.
+ 
+ -- JBG 5/26/85
+ 
+ GENERIC
+ PROCEDURE C23006E_PROC (X : OUT INTEGER);
+ 
+ PROCEDURE C23006E_PROC (X : OUT INTEGER) IS
+ BEGIN
+      X := 1;
+ END C23006E_PROC;
+ 
+ GENERIC
+ PROCEDURE C230063PROC (X : OUT INTEGER);
+ 
+ PROCEDURE C230063PROC (X : OUT INTEGER) IS
+ BEGIN
+      X := 2;
+ END C230063PROC;
+ 
+ GENERIC
+ FUNCTION C23006E_GFUNC RETURN INTEGER;
+ 
+ FUNCTION C23006E_GFUNC RETURN INTEGER IS
+ BEGIN
+      RETURN 3;
+ END C23006E_GFUNC;
+ 
+ GENERIC
+ FUNCTION C23006EGFUNC RETURN INTEGER;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION C23006EGFUNC RETURN INTEGER IS
+ BEGIN
+      RETURN IDENT_INT(4);
+ END C23006EGFUNC;
+ 
+ WITH C23006E_PROC;
+ PRAGMA ELABORATE (C23006E_PROC);
+ PROCEDURE P1 IS NEW C23006E_PROC;
+ 
+ WITH C23006E_GFUNC;
+ PRAGMA ELABORATE (C23006E_GFUNC);
+ FUNCTION F1 IS NEW C23006E_GFUNC;
+ 
+ WITH P1, F1, C230063PROC, C23006EGFUNC;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23006E IS
+ 
+      X1, X2 : INTEGER;
+      PROCEDURE P2 IS NEW C230063PROC;
+      FUNCTION F2 IS NEW C23006EGFUNC;
+ 
+ BEGIN
+      TEST ("C23006E", "CHECK UNDERSCORES ARE SIGNIFICANT " &
+                       "FOR GENERIC LIBRARY SUBPROGRAM IDENTIFIERS");
+ 
+      P1 (X1);
+      P2 (X2);
+      IF X1 + IDENT_INT(1) /= X2 THEN
+           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
+      END IF;
+ 
+      IF F1 + IDENT_INT(1) /= F2 THEN
+           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
+      END IF;
+ 
+      RESULT;
+ END C23006E; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,57 ----
+ -- C23006F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY PACKAGE NAMES
+ -- CREATED BY A GENERIC INSTANTIATION.
+ 
+ -- JBG 5/26/85
+ 
+ GENERIC
+      C : INTEGER;
+ PACKAGE C23006F_PKG IS
+      A : INTEGER := C;
+ END C23006F_PKG;
+ 
+ WITH C23006F_PKG;
+ PRAGMA ELABORATE (C23006F_PKG);
+ PACKAGE C23006F_INST IS NEW C23006F_PKG (1);
+ 
+ WITH REPORT; USE REPORT;
+ WITH C23006F_PKG;
+ PRAGMA ELABORATE (REPORT, C23006F_PKG);
+ PACKAGE C23006FINST IS NEW C23006F_PKG (IDENT_INT(2));
+ 
+ WITH C23006F_INST, C23006FINST;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23006F IS
+ BEGIN
+      TEST ("C23006F", "CHECK THAT UNDERSCORES ARE SIGNIFICANT IN " &
+                       "NAMES USED FOR A LIBRARY PACKAGE INSTANTIATION");
+ 
+      IF C23006F_INST.A + IDENT_INT(1) /= C23006FINST.A THEN
+           FAILED ("INCORRECT PACKAGE IDENTIFICATION - 1");
+      END IF;
+ 
+      RESULT;
+ END C23006F; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c23006g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c23006g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C23006G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY SUBPROGRAM NAMES
+ -- CREATED BY A GENERIC INSTANTIATION.
+ 
+ -- JBG 5/26/85
+ 
+ GENERIC
+      C : INTEGER;
+ PROCEDURE C23006G_PROC (X : OUT INTEGER);
+ 
+ PROCEDURE C23006G_PROC (X : OUT INTEGER) IS
+ BEGIN
+      X := C;
+ END C23006G_PROC;
+ 
+ GENERIC
+      C : INTEGER;
+ FUNCTION C23006G_FUNC RETURN INTEGER;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION C23006G_FUNC RETURN INTEGER IS
+ BEGIN
+      RETURN IDENT_INT(C);
+ END C23006G_FUNC;
+ 
+ WITH C23006G_PROC;
+ PRAGMA ELABORATE (C23006G_PROC);
+ PROCEDURE C23006G_INSTP IS NEW C23006G_PROC (1);
+ 
+ WITH REPORT; USE REPORT;
+ WITH C23006G_PROC;
+ PRAGMA ELABORATE (REPORT, C23006G_PROC);
+ PROCEDURE C23006GINSTP IS NEW C23006G_PROC (IDENT_INT(2));
+ 
+ WITH C23006G_FUNC;
+ PRAGMA ELABORATE (C23006G_FUNC);
+ FUNCTION C23006G_INSTF IS NEW C23006G_FUNC (3);
+ 
+ WITH C23006G_FUNC;
+ PRAGMA ELABORATE (C23006G_FUNC);
+ FUNCTION C23006GINSTF IS NEW C23006G_FUNC (4);
+ 
+ WITH C23006G_INSTP, C23006GINSTP, C23006G_INSTF, C23006GINSTF;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C23006G IS
+      X1, X2 : INTEGER;
+ BEGIN
+      TEST ("C23006G", "CHECK THAT UNDERSCORES ARE SIGNFICANT IN NAMES "&
+                       "USED FOR A LIBRARY SUBPROGRAM INSTANTIATION");
+      C23006G_INSTP (X1);
+      C23006GINSTP (X2);
+ 
+      IF X1 + IDENT_INT(1) /= X2 THEN
+           FAILED ("INCORRECT PROCEDURE IDENTIFICATION");
+      END IF;
+ 
+      IF C23006G_INSTF + IDENT_INT(1) /= C23006GINSTF THEN
+           FAILED ("INCORRECT FUNCTION IDENTIFICATION");
+      END IF;
+ 
+      RESULT;
+ END C23006G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24002d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24002d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24002d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C24002D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LOWER CASE E MAY BE USED IN INTEGER LITERALS, FLOATING POINT 
+ -- LITERALS, AND FIXED POINT LITERALS.
+ -- CHECK THAT THESE NUMERIC LITERALS YIELD THE CORRECT VALUES.
+ 
+ -- WMC 03/16/92  CONSOLIDATION OF C24002A.ADA, C24002B.ADA, C24002C.ADA
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C24002D IS
+ 
+         USE REPORT;
+ 
+ BEGIN
+         TEST("C24002D", "CHECK THAT LOWER CASE E WORKS IN INTEGER, " &
+                         "FLOATING POINT, AND FIXED POINT LITERALS, " &
+                         "AND THAT THESE NUMERIC LITERALS YIELD THE " &
+                         "CORRECT VALUES");
+ 
+         -- Integer Literals
+         DECLARE
+            X,Y : INTEGER;
+         BEGIN
+            X := 12e1;
+            Y := 16#E#e1;
+ 
+            IF (X /= 120) OR (Y /= 224) THEN
+                 FAILED("INCORRECT HANDLING OF LOWER CASE E " &
+                        "IN INTEGER LITERALS");
+            END IF;
+         END;
+ 
+ 
+         -- Floating Point Literal
+         DECLARE
+            X : FLOAT;
+         BEGIN
+            X := 16#F.FF#e+2;
+ 
+            IF (X /= 4095.0) THEN
+                 FAILED("INCORRECT HANDLING OF LOWER CASE E " &
+                        "IN BASED FLOATING POINT LITERALS");
+            END IF;
+         END;
+ 
+ 
+         -- Fixed Point Literal
+         DECLARE 
+            TYPE FIXED IS DELTA 0.1 RANGE 0.0 .. 300.0;
+            X : FIXED;
+         BEGIN
+            X := 16#F.F#e1;
+ 
+            IF (X /= 255.0) THEN
+                 FAILED("INCORRECT HANDLING OF LOWER CASE E " &
+                        "IN BASED FIXED POINT LITERALS");
+            END IF;
+         END;
+ 
+         RESULT;
+ 
+ END C24002D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,61 ----
+ -- C24003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS OF INTEGER LITERALS
+ -- ARE IGNORED.
+ 
+ -- JRK 12/12/79
+ -- JRK 12/16/80
+ -- TBN 10/16/85     RENAMED FROM C24003A.TST AND FIXED LINE LENGTH.
+ -- DTN 11/12/91     DELETED SUBPART (B).  CHANGED EXTENSION FROM '.TST' 
+ --                  TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C24003A IS
+ 
+         USE REPORT;
+ 
+ BEGIN
+         TEST ("C24003A", "LEADING ZEROES IN INTEGER LITERALS");
+         
+         IF 0000000000000000000000000000000000000000247 /= 247 THEN
+                 FAILED ("LEADING ZEROES IN INTEGER LITERALS NOT " &
+                         "IGNORED");
+         END IF;
+ 
+         IF 35E00000000000000000000000000000000000000001 /= 350 THEN
+                 FAILED ("LEADING ZEROES IN EXPONENTS NOT IGNORED");
+         END IF;
+ 
+         IF 000000000000000000000000000000000000000016#FF# /= 255 THEN
+                 FAILED ("LEADING ZEROES IN BASES NOT IGNORED");
+         END IF;
+ 
+         IF 16#0000000000000000000000000000000000000000FF# /= 255 THEN
+                 FAILED ("LEADING ZEROES IN BASED INTEGER LITERALS " &
+                         "NOT IGNORED");
+         END IF;
+ 
+         RESULT;
+ END C24003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24003b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24003b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24003b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C24003B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS AND TRAILING ZEROES IN
+ -- FRACTIONAL PARTS OF FLOATING POINT LITERALS ARE IGNORED.
+ 
+ -- JRK 12/12/79
+ -- JRK 12/16/80
+ -- TBN 10/21/85     RENAMED FROM C24003B.TST AND FIXED LINE LENGTH.
+ -- DTN 11/12/91     DELETED SUBPART (B).  CHANGED EXTENSION FROM '.TST' 
+ --                  TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C24003B IS
+ 
+         USE REPORT;
+ 
+         FL : FLOAT := 69.0E1;
+ 
+ BEGIN
+         TEST ("C24003B", "LEADING/TRAILING ZEROES IN " &
+               "FLOATING POINT LITERALS");
+ 
+         IF 000000000000000000000000000000000000000069.0E1 /= FL THEN
+                 FAILED ("LEADING ZEROES IN INTEGRAL PART OF FLOATING " &
+                         "POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 69.0000000000000000000000000000000000000000E1 /= FL THEN
+                            -- MIGHT RAISE NUMERIC_ERROR AT COMPILE-TIME.
+                 FAILED ("TRAILING ZEROES IN FRACTIONAL PART OF " &
+                         "FLOATING POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 0000000000000000000000000000000000000000690.00000 /= FL THEN
+                 FAILED ("LEADING/TRAILING ZEROES IN MANTISSA OF " &
+                         "FLOATING POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 69.0E00000000000000000000000000000000000000001 /= FL THEN
+                 FAILED ("LEADING ZEROES IN EXPONENT OF FLOATING " &
+                         "POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 16#00000000000000000000000000000000000000002B.2#E1 /= FL THEN
+                 FAILED ("LEADING ZEROES IN BASED FLOATING POINT " &
+                         "LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 16#2B.20000000000000000000000000000000000000000#E1 /= FL THEN
+                 FAILED ("TRAILING ZEROES IN BASED FLOATING POINT " &
+                         "LITERAL NOT IGNORED");
+         END IF;
+ 
+         RESULT;
+ END C24003B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24003c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24003c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24003c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24003c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C24003C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS AND TRAILING ZEROES IN
+ -- FRACTIONAL PARTS OF FIXED POINT LITERALS ARE IGNORED.
+ 
+ -- JRK 12/12/79
+ -- JRK 12/16/80
+ -- TBN 10/21/85     RENAMED FROM C24003C.TST AND FIXED LINE LENGTH.
+ -- DTN 11/12/91     DELETED SUBPART (B).  CHANGED EXTENSION FROM '.TST' 
+ --                  TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C24003C IS
+ 
+         USE REPORT;
+ 
+         TYPE FIXED IS DELTA 1.0 RANGE 0.0 .. 1000.0;
+         FX : FIXED := 69.0E1;
+ 
+ BEGIN
+ 
+         TEST ("C24003C", "LEADING/TRAILING ZEROES IN " &
+               "FIXED POINT LITERALS");
+ 
+         IF 000000000000000000000000000000000000000069.0E1 /= FX THEN
+                 FAILED ("LEADING ZEROES IN INTEGRAL PART OF FIXED " &
+                         "POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 69.0000000000000000000000000000000000000000E1 /= FX THEN
+                            -- MIGHT RAISE NUMERIC_ERROR AT COMPILE-TIME.
+                 FAILED ("TRAILING ZEROES IN FRACTIONAL PART OF " &
+                         "FIXED POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 0000000000000000000000000000000000000000690.00000 /= FX THEN
+                 FAILED ("LEADING/TRAILING ZEROES IN MANTISSA OF " &
+                         "FIXED POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 69.0E00000000000000000000000000000000000000001 /= FX THEN
+                 FAILED ("LEADING ZEROES IN EXPONENT OF FIXED " &
+                         "POINT LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 16#00000000000000000000000000000000000000002B.2#E1 /= FX THEN
+                 FAILED ("LEADING ZEROES IN BASED FIXED POINT " &
+                         "LITERAL NOT IGNORED");
+         END IF;
+ 
+         IF 16#2B.20000000000000000000000000000000000000000#E1 /= FX THEN
+                 FAILED ("TRAILING ZEROES IN BASED FIXED POINT " &
+                         "LITERAL NOT IGNORED");
+         END IF;
+ 
+         RESULT;
+ END C24003C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24106a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24106a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24106a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- C24106A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT UNDERSCORE CHARACTERS ARE PERMITTED IN ANY PART OF
+ --     A NON-BASED DECIMAL LITERAL.
+ 
+ -- HISTORY:
+ --     DHH 01/19/88 CREATED ORIGINAL TEST
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C24106A IS
+ 
+ BEGIN
+      TEST("C24106A", "CHECK THAT UNDERSCORE CHARACTERS " &
+                      "ARE PERMITTED IN ANY PART OF " &
+                      "A NON-BASED DECIMAL LITERAL");
+ 
+      IF 1.2_3_4_5_6 /= 1.23456 THEN
+              FAILED("UNDERSCORES NOT PERMITTED IN FRACTIONAL PART " &
+                     "OF A NON_BASED LITERAL");
+      END IF;
+      IF 1_2_3_4_5.6 /= 12345.6 THEN
+              FAILED("UNDERSCORES NOT PERMITTED IN INTEGRAL PART " &
+                     "OF A NON_BASED LITERAL");
+      END IF;
+      IF 0.12E1_2 /= 0.12E12 THEN
+              FAILED("UNDERSCORES NOT PERMITTED IN EXPONENT PART " &
+                     "OF A NON_BASED LITERAL");
+      END IF;
+      IF 1_2_3_4_5 /= 12345 THEN
+              FAILED("UNDERSCORES NOT PERMITTED IN INTEGRAL PART " &
+                     "OF A NON_BASED LITERAL INTEGER");
+      END IF;
+      IF 0E1_0 /= 0 THEN
+              FAILED("UNDERSCORES NOT PERMITTED IN EXPONENT PART " &
+                     "OF A NON_BASED LITERAL INTEGER");
+      END IF;
+ 
+      RESULT;
+ END C24106A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24202d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24202d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24202d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24202d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C24202D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
+ -- IN EVERY PART OF BASED INTEGER, FLOATING POINT, AND FIXED POINT LITERALS.
+ 
+ -- WMC 03/16/92  CONSOLIDATION OF C24202A.ADA, C24202B.ADA, C24202C.ADA
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C24202D IS
+ 
+      USE REPORT;
+ 
+      TYPE FIXED1 IS DELTA 2.0**(-6) RANGE 0.0 .. 10.0;
+ 
+      I1, I2     : INTEGER;
+      F1, F2, F3 : FLOAT;
+      F4, F5     : FIXED1;
+ 
+ BEGIN
+      TEST("C24202D", "UNDERSCORES ALLOWED IN NUMERIC LITERALS");
+ 
+      I1 := 12_3;
+      I2 := 16#D#E0_1;
+ 
+      IF (I1 /= 123) OR (I2 /= 16#D#E01) THEN
+           FAILED("UNDERSCORES IN INTEGER LITERALS NOT HANDLED CORRECTLY");
+      END IF;
+ 
+ 
+      F1 := 1.2_5E1;
+      F2 := 8#1_3.5#;
+      F3 := 8#3.4#E1_1;
+ 
+      IF (F1 /= 1.25E1) OR (F2 /= 8#13.5#) OR (F3 /= 8#3.4#E11) THEN
+           FAILED("UNDERSCORES IN FLOATING POINT LITERALS NOT " &
+                  "HANDLED CORRECTLY");
+      END IF;
+ 
+ 
+      F4 := 1_6#1.A#;
+      F5 := 8#2.3_7#;
+ 
+      IF (F4 /= 16#1.A#) OR (F5 /= 8#2.37#) THEN
+           FAILED("UNDERSCORES IN FIXED POINT LITERALS NOT " &
+                  "HANDLED CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ 
+ END C24202D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24203a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24203a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24203a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C24203A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT BASED INTEGER LITERALS WITH BASES 2 THROUGH 16 ALL
+ -- YIELD CORRECT VALUES.
+ 
+ -- JRK 12/12/79
+ -- JRK 10/27/80
+ -- JWC 6/28/85   RENAMED FROM C24103A.ADA
+ 
+ WITH REPORT;
+ PROCEDURE C24203A IS
+ 
+         USE REPORT;
+ 
+         I : INTEGER := 200;
+ 
+ BEGIN
+         TEST ("C24203A", "VALUES OF BASED INTEGER LITERALS");
+ 
+         IF 2#11# /= 3 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 2 INTEGER");
+         END IF;
+ 
+         IF 3#22# /= 8 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 3 INTEGER");
+         END IF;
+ 
+         IF 4#33# /= 15 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 4 INTEGER");
+         END IF;
+ 
+         IF 5#44# /= 24 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 5 INTEGER");
+         END IF;
+ 
+         IF 6#55# /= 35 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 6 INTEGER");
+         END IF;
+ 
+         IF 7#66# /= 48 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER");
+         END IF;
+ 
+         IF 8#77# /= 63 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 8 INTEGER");
+         END IF;
+ 
+         IF 9#88# /= 80 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 9 INTEGER");
+         END IF;
+ 
+         IF 10#99# /= 99 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 10 INTEGER");
+         END IF;
+ 
+         IF 11#AA# /= 120 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 11 INTEGER");
+         END IF;
+ 
+         IF 12#BB# /= 143 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 12 INTEGER");
+         END IF;
+ 
+         IF 13#CC# /= 168 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 13 INTEGER");
+         END IF;
+ 
+         IF 14#DD# /= 195 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 14 INTEGER");
+         END IF;
+ 
+         IF 15#EE# /= 224 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 15 INTEGER");
+         END IF;
+ 
+         IF 16#FF# /= 255 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 16 INTEGER");
+         END IF;
+ 
+         ----------------------------------------
+ 
+         IF 7#66#E1 /= 336 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER " &
+                         "WITH EXPONENT");
+         END IF;
+ 
+         RESULT;
+ END C24203A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24203b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24203b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24203b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C24203B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT BASED REAL LITERALS WITH BASES 2 THROUGH 16 ALL
+ --     YIELD CORRECT VALUES.
+ 
+ --     THIS TEST USES MODEL NUMBERS OF DIGITS 6.
+ 
+ -- HISTORY:
+ --     DHH 06/15/88 CREATED ORIGINAL TEST.
+ --     DTN 11/30/95 REMOVED CONFORMANCE CHECKS WHERE RULES RELAXED.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C24203B IS
+ 
+      TYPE CHECK IS DIGITS 6;
+ 
+ BEGIN
+      TEST("C24203B", "CHECK THAT BASED REAL LITERALS WITH BASES " &
+                      "2 THROUGH 16 ALL YIELD CORRECT VALUES");
+ 
+      IF
+       2#0.0000000000000000000000000000000000000000000000000000000000001#
+       /= 2.0 ** (-61) THEN
+           FAILED ("INCORRECT VALUE FOR BASE 2 REAL LITERAL");
+      END IF;
+ 
+      IF 3#0.00000000001# <
+         ((2.0 ** (-18)) + (251558.0 * (2.0 ** (-37)))) OR
+         3#0.00000000001# >
+         ((2.0 ** (-18)) + (251559.0 * (2.0 ** (-37)))) THEN
+           FAILED ("INCORRECT VALUE FOR BASE 3 REAL LITERAL");
+      END IF;
+ 
+      IF 4#13333333.213# /= 32767.609375 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 4 REAL LITERAL");
+      END IF;
+ 
+      IF 5#2021444.4241121# < 32749.90625 OR
+         5#2021444.4241121# > 32749.921875 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 5 REAL LITERAL");
+      END IF;
+ 
+      IF 6#411355.531043# /= 32759.921875 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 6 REAL LITERAL");
+      END IF;
+ 
+      IF 7#164366.625344# < 32780.90625 OR
+         7#164366.625344# > 32780.9375 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 7 REAL LITERAL");
+      END IF;
+ 
+      IF 8#77777.07# /= 32767.109375 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 8 REAL LITERAL");
+      END IF;
+ 
+      IF 9#48888.820314# < 32804.90625 OR
+         9#48888.820314# > 32804.9375 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 9 REAL LITERAL");
+      END IF;
+ 
+      IF 10#32767.921875# /= 32767.921875 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 10 REAL LITERAL");
+      END IF;
+ 
+      IF 11#2267A.A06682# < 32757.90625 OR
+         11#2267A.A06682# > 32757.921875 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 11 REAL LITERAL");
+      END IF;
+ 
+      IF 12#16B5B.B09# /= 32759.921875  THEN
+           FAILED ("INCORRECT VALUE FOR BASE 12 REAL LITERAL");
+      END IF;
+ 
+      IF 13#11B9C.BB616# < 32746.90625 OR
+         13#11B9C.BB616# > 32746.921875 THEN
+           FAILED ("INCORRECT VALUE FOR BASE 13 REAL LITERAL");
+      END IF;
+ 
+      IF 14#BD1D.CC98A7# /= 32759.921875  THEN
+           FAILED ("INCORRECT VALUE FOR BASE 14 REAL LITERAL");
+      END IF;
+ 
+      IF 15#3D28188D45881111111111.0# <
+                                   (((2.0 ** 21) -2.0) * (2.0 ** 63)) THEN
+           FAILED ("INCORRECT VALUE FOR BASE 15 REAL LITERAL");
+      END IF;
+ 
+ 
+      RESULT;
+ END C24203B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24207a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24207a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24207a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- C24207A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LETTERS IN A BASED LITERAL MAY APPEAR IN UPPER OR LOWER 
+ -- CASE.
+ 
+ -- TBN 2/28/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C24207A IS
+ 
+      TYPE FLOAT IS DIGITS 5;
+      INT_1 : INTEGER := 15#AbC# ;
+      INT_2 : INTEGER := 15#aBc# ;
+      FLO_1 : FLOAT := 16#FeD.C#e1;
+      FLO_2 : FLOAT := 16#fEd.c#E1;
+ 
+ BEGIN
+      TEST("C24207A", "CHECK THAT LETTERS IN A BASED LITERAL MAY " &
+                      "APPEAR IN UPPER OR LOWER CASE");
+ 
+      IF INT_1 /= INT_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 1");
+      END IF;
+ 
+      IF FLO_1 /= FLO_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 2");
+      END IF;
+ 
+      INT_1 := 14#aBc#E1;
+      INT_2 := 14#AbC#e1;
+      FLO_1 := 16#CdEf.aB#E0;
+      FLO_2 := 16#cDeF.Ab#e0;
+ 
+      IF INT_1 /= INT_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 3");
+      END IF;
+ 
+      IF FLO_1 /= FLO_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 4");
+      END IF;
+      
+      RESULT;
+ END C24207A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24211a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c24211a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c24211a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C24211A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT LEGAL FORMS INVOLVING A DIGIT FOLLOWED BY A COLON ARE
+ --     CORRECTLY ANALYZED USING A TWO CHARACTER LOOK-AHEAD.
+ 
+ -- HISTORY:
+ --     DHH 01/19/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C24211A IS
+ 
+      TYPE FIXED IS DELTA 0.0125 RANGE -1.0 .. 100.0;
+ 
+      A : INTEGER RANGE 0 .. 2:10::= 1;
+      B : INTEGER RANGE 0 .. 2#10#:= 1;
+      X : FIXED RANGE 0.0 .. 16:3.0::= 1.0;
+      Y : FIXED RANGE 0.0 .. 16#3.0#:= 1.0;
+      IN2 : INTEGER;
+      BOOL : BOOLEAN:=3:10:=3:10:;
+ 
+ BEGIN
+ 
+      TEST("C24211A", "CHECK THAT LEGAL FORMS INVOLVING A DIGIT " &
+                      "FOLLOWED BY A COLON ARE CORRECTLY ANALYZED " &
+                      "USING A TWO CHARACTER LOOK-AHEAD");
+ 
+      IF IDENT_INT(A) /= B THEN
+           FAILED("CALCULATIONS OF BASED INTEGER LITERALS WHEN " &
+                  "REPRESENTED BY SHARPS DO NOT MATCH CALCULATIONS " &
+                  "OF BASED INTEGER LITERALS REPRESENTED BY COLONS");
+      END IF;
+      A := A + 1;
+ 
+ 
+      IF EQUAL(3,3) THEN
+           Y := X + Y;
+      ELSE
+           Y := X - Y;
+      END IF;
+ 
+      IF (2 * X) = Y THEN
+           NULL;
+      ELSE
+           FAILED("CALCULATIONS OF BASED REAL LITERALS WHEN " &
+                  "REPRESENTED BY SHARPS DO NOT MATCH CALCULATIONS " &
+                  "OF BASED REAL LITERALS REPRESENTED BY COLONS");
+      END IF;
+      IF NOT BOOL THEN
+           FAILED("BOOLEAN VALUE BASED ON REAL LITERAL WAS CALCULATED " &
+                  "INCORRECTLY");
+           IN2:=2:10:;
+      ELSE
+           BOOL := FALSE;
+           IN2:=3:10:;
+      END IF;
+      IF BOOL THEN
+           A := A + 1;
+      ELSE
+           A := A - 1;
+      END IF;
+ 
+      RESULT;
+ END C24211A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c250001.aw gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c250001.aw
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c250001.aw	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c250001.aw	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,167 ----
+ -- C250001.AW
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that wide character literals are supported.
+ --      Check that wide character string literals are supported.
+ --
+ -- TEST DESCRIPTION:
+ --      This test utilizes the brackets scheme for representing wide character
+ --      values in transportable 7 bit ASCII as proposed by Robert Dewar;
+ --      this test defines Wide_Character and Wide_String objects, and assigns
+ --      and tests several sample values.
+ --
+ -- SPECIAL REQUIREMENTS:
+ --
+ --      This file must be preprocessed before it can be executed as a test.
+ --
+ --      This test requires that all occurrences of the bracket escape
+ --      representation for wide characters be replaced, as appropriate, with
+ --      the corresponding wide character as represented by the implementation.
+ --
+ --      Characters above ASCII.Del are represented by an 8 character sequence:
+ --
+ --          ["xxxx"]
+ --
+ --      where the character code represented is specified by four hexadecimal
+ --      digits, (<xxxx>) upper case. For example the wide character with the
+ --      code 16#ABCD# is represented by the eight character sequence:
+ --
+ --          ["ABCD"]
+ --
+ --      The following function documents the translation algorithm:
+ --
+ --     function To_Wide( S:String ) return Wide_character is
+ --       Numerical : Natural := 0;
+ --       type Xlate is array(Character range '0'..'F') of Natural;
+ --       Xlation : Xlate
+ --               := ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
+ --                   '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
+ --                   'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
+ --                   'F' => 15,  others => 0 );
+ --     begin
+ --       for I in S'Range loop
+ --         Numerical := Numerical * 16 + Xlation(S(I));
+ --       end loop;
+ --       return Wide_Character'Val(Numerical);  -- the returned value is
+ --                                   implementation dependent
+ --     exception
+ --       when Constraint_Error => raise;
+ --     end To_Wide;
+ --
+ --
+ -- CHANGE HISTORY:
+ --      26 OCT 95   SAIC   Initial .Aversion
+ --      11 APR 96   SAIC   Minor robustness changes for 2.1
+ --      12 NOV 96   SAIC   Changed file extension to .AW
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C250001_0
+ 
+ package C250001_0 is
+ 
+   -- The wide characters used in this test are sequential starting with
+   -- the character '["4F42"]' 16#0F42#
+ 
+   Four_Eff_Four_Two : constant Wide_Character := '["4F42"]';
+ 
+   Four_Eff_4_3_Through_9 : constant Wide_String := 
+                "["4F43"]["4F44"]["4F45"]["4F46"]["4F47"]["4F48"]["4F49"]";
+ 
+   Four_Eff_A_B : constant Wide_String := "["4F4A"]["4F4B"]";
+ 
+ end C250001_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ -- no package body C250001_0 is required or allowed
+ 
+ ------------------------------------------------------------------- C250001
+ 
+ with Report;
+ with C250001_0;
+ with Ada.Tags;
+ 
+ procedure C250001 is
+   use C250001_0; 
+ 
+   function Hex( N: Natural ) return String is
+     S : String := "xxxx";
+     T : String := "0123456789ABCDEF";
+     V : Natural := N;
+   begin
+     for I in reverse 1..4 loop
+       S(I) := T(V rem 16 +1);
+       V := V / 16;
+     end loop;
+     return S;
+   end Hex;
+ 
+   procedure Match( Check : Wide_Character; Matching : Natural ) is
+   begin
+     if Wide_Character'Pos( Check ) /= Matching then
+       Report.Failed( "Didn't match for " & Hex(Matching) );
+     end if;
+   end Match;
+ 
+   type Value_List is array(Positive range <>) of Natural;
+ 
+   procedure Match( Check : Wide_String; Matching : Value_List ) is
+   begin
+     if Check'Length /= Matching'Length then
+       Report.Failed( "Check'Length /= Matching'Length" );
+     else
+       for I in Check'Range loop
+         Match( Check(I), Matching(I) );
+       end loop;
+     end if;
+   end Match;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C250001", "Check that wide character literals " &
+                           "are supported.  Check that wide character " &
+                           "string literals are supported." );
+ 
+   Match( Four_Eff_Four_Two, 16#4F42# );
+ 
+   Match(Four_Eff_4_3_Through_9,
+          (16#4F43#,16#4F44#,16#4F45#,16#4F46#,16#4F47#,16#4F48#,16#4F49#) );
+ 
+  -- check catenations
+ 
+   Match( Four_Eff_Four_Two & Four_Eff_Four_Two, (16#4F42#,16#4F42#) );
+ 
+   Match( Four_Eff_Four_Two & Four_Eff_A_B, (16#4F42#,16#4F4A#,16#4F4B#) );
+ 
+   Match( Four_Eff_A_B & Four_Eff_Four_Two, (16#4F4A#,16#4F4B#,16#4F42#) );
+ 
+   Match( Four_Eff_A_B & Four_Eff_A_B,
+          (16#4F4A#,16#4F4B#,16#4F4A#,16#4F4B#) );
+ 
+   Report.Result;
+ 
+ end C250001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c250002.aw gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c250002.aw
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c250002.aw	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c250002.aw	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,213 ----
+ -- C250002.AW
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that characters in Latin-1 above ASCII.Del can be used in
+ --      identifiers, character literals and strings.
+ -- 
+ -- TEST DESCRIPTION:
+ --      This test utilizes the brackets scheme for representing Latin-1
+ --      character values in transportable 7 bit ASCII as proposed by
+ --      Robert Dewar; this test defines Character and String objects,
+ --      assigns and tests several sample values.  Several Identifiers
+ --      used in this test also include Characters via the bracket escape
+ --      sequence scheme.
+ --
+ --      Note that C250001 checks Wide_Characters and Wide_Strings.
+ --
+ -- SPECIAL REQUIREMENTS:
+ --
+ --      This file must be preprocessed before it can be executed as a test.
+ --
+ --      This test requires that all occurrences of the bracket escaped
+ --      characters be replaced with the corresponding 8 bit character.
+ --
+ --      Characters above ASCII.Del are represented by a 6 character sequence:
+ --
+ --          ["xx"]
+ --
+ --      where the character code represented is specified by two hexadecimal
+ --      digits (<xx>) upper case. For example the Latin-1 character with the
+ --      code 16#AB# is represented by the six character sequence:
+ --
+ --          ["AB"]
+ --
+ --      None of the values used in this test should be interpreted as
+ --      a control character.
+ --
+ --      The following function documents the translation algorithm:
+ --
+ --     function To_Char( S:String ) return Character is
+ --       Numerical : Natural := 0;
+ --       type Xlate is array(Character range '0'..'F') of Natural;
+ --       Xlation : Xlate
+ --               := ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
+ --                   '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
+ --                   'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
+ --                   'F' => 15,  others => 0 );
+ --     begin
+ --       for I in S'Range loop
+ --         Numerical := Numerical * 16 + Xlation(S(I));
+ --       end loop;
+ --       return Character'Val(Numerical);
+ --     end To_Char;
+ --
+ --
+ -- CHANGE HISTORY:
+ --      10 JAN 96   SAIC   Initial version
+ --      12 NOV 96   SAIC   Changed file extension to .AW
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C250002_0
+ 
+ package C250002_0 is
+ 
+   -- The extended characters used in this test start with
+   -- the character '["A1"]' 16#A1# and increase from there
+ 
+   type Tagged_["C0"]_Id is tagged record
+     Length, Width: Natural;
+   end record;
+ 
+   X_Char_A2 : constant Character := '["A2"]';
+ 
+   X_Char_A3_Through_A9 : constant String := 
+                "["A3"]["A4"]["A5"]["A6"]["A7"]["A8"]["A9"]";
+ 
+   X_Char_AA_AB : constant String := "["AA"]["AB"]";
+ 
+ end C250002_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ -- no package body C250002_0 is required or allowed
+ 
+ ----------------------------------------------------------------- C250002_X
+ 
+ with Ada.Characters.Latin_1;
+ package C250002_["C1"] is
+ 
+   type Enum is ( Item, 'A', '["AD"]', AE_["C6"]["E6"]_ae,
+                  '["2D"]', '["FF"]' );
+ 
+   task type C2_["C2"] is
+     entry C2_["C3"];
+   end C2_["C2"];
+ 
+ end C250002_["C1"];
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C250002_["C1"] is
+ 
+   task body C2_["C2"] is
+   begin
+     accept C2_["C3"];
+   end C2_["C2"];
+ 
+ end C250002_["C1"];
+ 
+ ------------------------------------------------------------------- C250002
+ 
+ with Report;
+ with C250002_0;
+ with C250002_["C1"];
+ 
+ with Ada.Tags;
+ 
+ procedure C250002 is
+   use C250002_0; 
+ 
+   My_Task: C250002_["C1"].C2_["C2"];
+ 
+   function Hex( N: Natural ) return String is
+     S : String := "xx";
+     T : String := "0123456789ABCDEF";
+   begin
+     S(1) := T(N  /  16 +1);
+     S(2) := T(N mod 16 +1);
+     return S;
+   end Hex;
+ 
+   procedure Match( Check : Character; Matching : Natural ) is
+   begin
+     if Check /= Character'Val( Matching ) then
+       Report.Failed( "Didn't match for " & Hex(Matching) );
+     end if;
+   end Match;
+ 
+   type Value_List is array(Positive range <>) of Natural;
+ 
+   procedure Match( Check : String; Matching : Value_List ) is
+   begin
+     if Check'Length /= Matching'Length then
+       Report.Failed( "Check'Length /= Matching'Length" );
+     else
+       for I in Check'Range loop
+         Match( Check(I), Matching(I - Check'First + Matching'First) );
+       end loop;
+     end if;
+   end Match;
+ 
+   TC_Count : Natural := 0;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C250002", "Check that characters above ASCII.Del can be " &
+                           "used in identifiers, character literals and " &
+                           "strings" );
+ 
+   Report.Comment( Ada.Tags.Expanded_Name(Tagged_["C0"]_Id'Tag) );
+ 
+   for Specials in C250002_["C1"].Enum loop
+     TC_Count := TC_Count +1;
+   end loop;
+ 
+   if TC_Count /= 6 then
+     Report.Failed("Expected 6 literals in Enum");
+   end if;
+ 
+   Match( X_Char_A2, 16#A2# );
+ 
+   Match(X_Char_A3_Through_A9,
+          (16#A3#,16#A4#,16#A5#,16#A6#,16#A7#,16#A8#,16#A9#) );
+ 
+   -- check catenations
+ 
+   Match( X_Char_A2 & X_Char_A2, (16#A2#,16#A2#) );
+ 
+   Match( X_Char_A2 & X_Char_AA_AB, (16#A2#,16#AA#,16#AB#) );
+ 
+   Match( X_Char_AA_AB & X_Char_A2, (16#AA#,16#AB#,16#A2#) );
+ 
+   Match( X_Char_AA_AB & X_Char_AA_AB,
+          (16#AA#,16#AB#,16#AA#,16#AB#) );
+ 
+   My_Task.C2_["C3"];
+ 
+   Report.Result;
+ 
+ end C250002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c25001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c25001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c25001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c25001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,211 ----
+ -- C25001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL CHARACTER LITERALS CAN BE WRITTEN.
+ 
+ --      CASE A: THE BASIC CHARACTER SET.
+ 
+ -- TBN  3/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C25001A IS
+ 
+ BEGIN
+      TEST ("C25001A", "CHECK THAT EACH CHARACTER IN THE BASIC " &
+                       "CHARACTER SET CAN BE WRITTEN");
+ 
+      IF CHARACTER'POS('A') /= 65 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'A'");
+      END IF;
+      IF CHARACTER'POS('B') /= 66 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'B'");
+      END IF;
+      IF CHARACTER'POS('C') /= 67 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'C'");
+      END IF;
+      IF CHARACTER'POS('D') /= 68 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'D'");
+      END IF;
+      IF CHARACTER'POS('E') /= 69 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'E'");
+      END IF;
+      IF CHARACTER'POS('F') /= 70 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'F'");
+      END IF;
+      IF CHARACTER'POS('G') /= 71 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'G'");
+      END IF;
+      IF CHARACTER'POS('H') /= 72 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'H'");
+      END IF;
+      IF CHARACTER'POS('I') /= 73 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'I'");
+      END IF;
+      IF CHARACTER'POS('J') /= 74 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'J'");
+      END IF;
+      IF CHARACTER'POS('K') /= 75 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'K'");
+      END IF;
+      IF CHARACTER'POS('L') /= 76 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'L'");
+      END IF;
+      IF CHARACTER'POS('M') /= 77 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'M'");
+      END IF;
+      IF CHARACTER'POS('N') /= 78 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'N'");
+      END IF;
+      IF CHARACTER'POS('O') /= 79 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'O'");
+      END IF;
+      IF CHARACTER'POS('P') /= 80 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'P'");
+      END IF;
+      IF CHARACTER'POS('Q') /= 81 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'Q'");
+      END IF;
+      IF CHARACTER'POS('R') /= 82 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'R'");
+      END IF;
+      IF CHARACTER'POS('S') /= 83 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'S'");
+      END IF;
+      IF CHARACTER'POS('T') /= 84 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'T'");
+      END IF;
+      IF CHARACTER'POS('U') /= 85 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'U'");
+      END IF;
+      IF CHARACTER'POS('V') /= 86 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'V'");
+      END IF;
+      IF CHARACTER'POS('W') /= 87 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'W'");
+      END IF;
+      IF CHARACTER'POS('X') /= 88 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'X'");
+      END IF;
+      IF CHARACTER'POS('Y') /= 89 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'Y'");
+      END IF;
+      IF CHARACTER'POS('Z') /= 90 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'Z'");
+      END IF;
+ 
+      IF CHARACTER'POS('0') /= 48 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '0'");
+      END IF;
+      IF CHARACTER'POS('1') /= 49 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '1'");
+      END IF;
+      IF CHARACTER'POS('2') /= 50 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '2'");
+      END IF;
+      IF CHARACTER'POS('3') /= 51 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '3'");
+      END IF;
+      IF CHARACTER'POS('4') /= 52 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '4'");
+      END IF;
+      IF CHARACTER'POS('5') /= 53 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '5'");
+      END IF;
+      IF CHARACTER'POS('6') /= 54 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '6'");
+      END IF;
+      IF CHARACTER'POS('7') /= 55 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '7'");
+      END IF;
+      IF CHARACTER'POS('8') /= 56 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '8'");
+      END IF;
+      IF CHARACTER'POS('9') /= 57 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '9'");
+      END IF;
+ 
+      IF CHARACTER'POS('"') /= 34 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '""'");
+      END IF;
+      IF CHARACTER'POS('#') /= 35 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '#'");
+      END IF;
+      IF CHARACTER'POS('&') /= 38 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '&'");
+      END IF;
+      IF CHARACTER'POS(''') /= 39 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '''");
+      END IF;
+      IF CHARACTER'POS('(') /= 40 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '('");
+      END IF;
+      IF CHARACTER'POS(')') /= 41 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR ')'");
+      END IF;
+      IF CHARACTER'POS('*') /= 42 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '*'");
+      END IF;
+      IF CHARACTER'POS('+') /= 43 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '+'");
+      END IF;
+      IF CHARACTER'POS(',') /= 44 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR ','");
+      END IF;
+      IF CHARACTER'POS('-') /= 45 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '-'");
+      END IF;
+      IF CHARACTER'POS('.') /= 46 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '.'");
+      END IF;
+      IF CHARACTER'POS('/') /= 47 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '/'");
+      END IF;
+      IF CHARACTER'POS(':') /= 58 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR ':'");
+      END IF;
+      IF CHARACTER'POS(';') /= 59 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR ';'");
+      END IF;
+      IF CHARACTER'POS('<') /= 60 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '<'");
+      END IF;
+      IF CHARACTER'POS('=') /= 61 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '='");
+      END IF;
+      IF CHARACTER'POS('>') /= 62 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '>'");
+      END IF;
+      IF CHARACTER'POS('_') /= 95 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '_'");
+      END IF;
+      IF CHARACTER'POS('|') /= 124 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '|'");
+      END IF;
+ 
+      IF CHARACTER'POS(' ') /= 32 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR ' '");
+      END IF;
+ 
+      RESULT;
+ END C25001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c25001b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c25001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c25001b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c25001b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,160 ----
+ -- C25001B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL CHARACTER LITERALS CAN BE WRITTEN.
+ 
+ --      CASE B: THE LOWER CASE LETTERS AND THE OTHER
+ --              SPECIAL CHARACTERS.
+ 
+ -- TBN  8/1/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C25001B IS
+ 
+ BEGIN
+      TEST ("C25001B", "CHECK THAT EACH CHARACTER IN THE LOWER CASE " &
+                       "LETTERS AND THE OTHER SPECIAL CHARACTERS CAN " &
+                       "BE WRITTEN");
+ 
+      IF CHARACTER'POS('a') /= 97 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'a'");
+      END IF;
+      IF CHARACTER'POS('b') /= 98 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'b'");
+      END IF;
+      IF CHARACTER'POS('c') /= 99 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'c'");
+      END IF;
+      IF CHARACTER'POS('d') /= 100 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'd'");
+      END IF;
+      IF CHARACTER'POS('e') /= 101 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'e'");
+      END IF;
+      IF CHARACTER'POS('f') /= 102 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'f'");
+      END IF;
+      IF CHARACTER'POS('g') /= 103 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'g'");
+      END IF;
+      IF CHARACTER'POS('h') /= 104 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'h'");
+      END IF;
+      IF CHARACTER'POS('i') /= 105 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'i'");
+      END IF;
+      IF CHARACTER'POS('j') /= 106 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'j'");
+      END IF;
+      IF CHARACTER'POS('k') /= 107 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'k'");
+      END IF;
+      IF CHARACTER'POS('l') /= 108 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'l'");
+      END IF;
+      IF CHARACTER'POS('m') /= 109 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'm'");
+      END IF;
+      IF CHARACTER'POS('n') /= 110 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'n'");
+      END IF;
+      IF CHARACTER'POS('o') /= 111 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'o'");
+      END IF;
+      IF CHARACTER'POS('p') /= 112 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'p'");
+      END IF;
+      IF CHARACTER'POS('q') /= 113 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'q'");
+      END IF;
+      IF CHARACTER'POS('r') /= 114 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'r'");
+      END IF;
+      IF CHARACTER'POS('s') /= 115 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 's'");
+      END IF;
+      IF CHARACTER'POS('t') /= 116 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 't'");
+      END IF;
+      IF CHARACTER'POS('u') /= 117 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'u'");
+      END IF;
+      IF CHARACTER'POS('v') /= 118 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'v'");
+      END IF;
+      IF CHARACTER'POS('w') /= 119 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'w'");
+      END IF;
+      IF CHARACTER'POS('x') /= 120 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'x'");
+      END IF;
+      IF CHARACTER'POS('y') /= 121 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'y'");
+      END IF;
+      IF CHARACTER'POS('z') /= 122 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR 'z'");
+      END IF;
+ 
+      IF CHARACTER'POS('!') /= 33 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '!'");
+      END IF;
+      IF CHARACTER'POS('$') /= 36 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '$'");
+      END IF;
+      IF CHARACTER'POS('%') /= 37 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '%'");
+      END IF;
+      IF CHARACTER'POS('?') /= 63 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '?'");
+      END IF;
+      IF CHARACTER'POS('@') /= 64 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '@'");
+      END IF;
+      IF CHARACTER'POS('[') /= 91 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '['");
+      END IF;
+      IF CHARACTER'POS('\') /= 92 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '\'");
+      END IF;
+      IF CHARACTER'POS(']') /= 93 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR ']'");
+      END IF;
+      IF CHARACTER'POS('^') /= 94 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '^'");
+      END IF;
+      IF CHARACTER'POS('`') /= 96 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '`'");
+      END IF;
+      IF CHARACTER'POS('{') /= 123 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '{'");
+      END IF;
+      IF CHARACTER'POS('}') /= 125 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '}'");
+      END IF;
+      IF CHARACTER'POS('~') /= 126 THEN
+           FAILED ("INCORRECT POSITION NUMBER FOR '~'");
+      END IF;
+  
+      RESULT;
+ END C25001B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c26006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c26006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c26006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c26006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- C26006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL ASCII CHARACTERS CAN APPEAR IN THE MIDDLE OF A STRING
+ -- (I.E., NONE ARE USED IN THE INTERNAL REPRESENTATION TO TERMINATE THE
+ -- STRING).
+ 
+ -- JRK 12/12/79
+ 
+ WITH REPORT;
+ PROCEDURE C26006A IS
+ 
+         USE REPORT;
+ 
+         S1 : STRING (1..3) := "A 1";
+         S2 : STRING (1..3) := "A 2";
+ 
+ BEGIN
+         TEST ("C26006A", "ALL ASCII CHARACTERS CAN APPEAR IN MIDDLE " &
+               "OF STRINGS");
+ 
+         FOR C IN CHARACTER'FIRST .. CHARACTER'LAST LOOP
+                 S1 (2) := C;
+                 S2 (2) := C;
+                 IF S1 = S2 THEN
+                         FAILED (CHARACTER'IMAGE(C) & " TERMINATED A " &
+                                 "STRING = COMPARISON");
+                 END IF;
+         END LOOP;
+ 
+         RESULT;
+ END C26006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c26008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c26008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c26008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c26008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ -- C26008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UPPER AND LOWER CASE LETTERS ARE DISTINCT WITHIN STRING
+ -- LITERALS.
+ 
+ -- JRK 12/12/79
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ WITH REPORT;
+ PROCEDURE C26008A IS
+ 
+         USE REPORT;
+ 
+ BEGIN
+         TEST ("C26008A", "UPPER/LOWER CASE ARE DISTINCT IN STRING " &
+               "LITERALS");
+ 
+         IF CHARACTER'('a') = 'A'  THEN
+                 FAILED ("LOWER CASE NOT DISTINCT FROM UPPER IN " &
+                         "CHARACTER LITERALS");
+         END IF;
+ 
+         IF STRING'("abcde") = "ABCDE" THEN
+                 FAILED ("LOWER CASE NOT DISTINCT FROM UPPER IN " &
+                         "STRING LITERALS");
+         END IF;
+ 
+         RESULT;
+ END C26008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- C2A001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
+ -- IN EVERY PART OF A BASED INTEGER LITERAL WHEN SHARPS
+ -- ARE USED INSTEAD OF COLONS.
+ 
+ -- INTEGER LITERALS.
+ 
+ -- DCB 1/24/80
+ -- JRK 10/27/80
+ -- JBG 5/28/85
+ 
+ WITH REPORT;
+ PROCEDURE C2A001A IS
+ 
+      USE REPORT;
+ 
+      I1, I2, I3, I4 : INTEGER;
+ 
+ BEGIN
+      TEST("C2A001A", "UNDERSCORES ALLOWED IN BASED INTEGER LITERALS " &
+                      "THAT HAVE COLONS");
+ 
+      I1 := 12_3;
+      I2 := 1_6:D:;
+      I3 := 2:1011_0101:;
+      I4 := 16:D:E0_1;
+ 
+      IF I1 = 123 AND I2 = 16:D: AND I3 = 2:10110101: AND
+         I4 = 16:D:E01 THEN
+           NULL;
+      ELSE 
+           FAILED("UNDERSCORES IN INTEGER LITERALS NOT HANDLED " &
+                  "CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C2A001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a001b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a001b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a001b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- C2A001B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
+ -- IN EVERY PART OF A BASED FLOATING POINT LITERAL THAT
+ -- USES COLONS INSTEAD OF SHARPS.
+ 
+ -- DCB 04/22/80
+ -- JRK 10/27/80
+ -- JBG 5/28/85
+ 
+ WITH REPORT;
+ PROCEDURE C2A001B IS
+ 
+      USE REPORT;
+ 
+      F1, F2, F3, F4, F5 : FLOAT;
+ 
+ BEGIN
+      TEST("C2A001B", "UNDERSCORES ALLOWED IN BASED FLOATING POINT " &
+                      "LITERALS THAT HAVE COLONS");
+ 
+      F1 := 1.2_5E1;
+      F2 := 1_6:1.A:;
+      F3 := 8:1_3.5:;
+      F4 := 8:2.3_7:;
+      F5 := 8:3.4:E1_1;
+ 
+      IF F1 = 1.25E1 AND F2 = 16:1.A: AND F3 = 8:13.5: AND
+         F4 = 8:2.37: AND F5 = 8:3.4:E11 THEN
+           NULL;
+      ELSE 
+           FAILED("UNDERSCORES IN FLOATING POINT LITERALS NOT " &
+                  "HANDLED CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C2A001B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a001c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a001c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a001c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- C2A001C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED
+ -- IN EVERY PART OF A BASED FIXED POINT LITERAL THAT USES
+ -- COLONS INSTEAD OF SHARPS.
+ 
+ -- DCB 04/22/80
+ -- JRK 10/27/80
+ -- JBG 5/28/85
+ 
+ WITH REPORT;
+ PROCEDURE C2A001C IS
+ 
+      USE REPORT;
+ 
+      TYPE FIXED1 IS DELTA 2.0**(-6) RANGE 0.0 .. 10.0;
+      TYPE FIXED2 IS DELTA 2.0**(-4) RANGE 0.0 .. 100.0;
+ 
+      F2, F4 : FIXED1;
+      F1, F3, F5 : FIXED2;
+ 
+ BEGIN
+      TEST("C2A001C", "UNDERSCORES ALLOWED IN BASED FIXED POINT " &
+                      "LITERALS THAT USE COLONS");
+ 
+      F1 := 1.2_5E1;
+      F2 := 1_6:1.A:;
+      F3 := 8:1_3.5:;
+      F4 := 8:2.3_7:;
+      F5 := 8:3.4:E0_1;
+ 
+      IF F1 = 1.25E1 AND F2 = 16:1.A: AND F3 = 8:13.5: AND
+         F4 = 8:2.37: AND F5 = 8:3.4:E01 THEN
+           NULL;
+      ELSE 
+           FAILED("UNDERSCORES IN FIXED POINT LITERALS NOT " &
+                  "HANDLED CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C2A001C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C2A002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT BASED INTEGER LITERALS WITH BASES 2 THROUGH 16 ALL
+ -- YIELD CORRECT VALUES WHEN COLONS ARE USED INSTEAD OF SHARPS.
+ 
+ -- JRK 12/12/79
+ -- JRK 10/27/80
+ -- JBG 5/28/85
+ 
+ WITH REPORT;
+ PROCEDURE C2A002A IS
+ 
+         USE REPORT;
+ 
+         I : INTEGER := 200;
+ 
+ BEGIN
+         TEST ("C2A002A", "VALUES OF BASED INTEGER LITERALS WITH " &
+                          "COLONS");
+ 
+         IF 2:11: /= 3 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 2 INTEGER");
+         END IF;
+ 
+         IF 3:22: /= 8 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 3 INTEGER");
+         END IF;
+ 
+         IF 4:33: /= 15 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 4 INTEGER");
+         END IF;
+ 
+         IF 5:44: /= 24 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 5 INTEGER");
+         END IF;
+ 
+         IF 6:55: /= 35 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 6 INTEGER");
+         END IF;
+ 
+         IF 7:66: /= 48 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER");
+         END IF;
+ 
+         IF 8:77: /= 63 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 8 INTEGER");
+         END IF;
+ 
+         IF 9:88: /= 80 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 9 INTEGER");
+         END IF;
+ 
+         IF 10:99: /= 99 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 10 INTEGER");
+         END IF;
+ 
+         IF 11:AA: /= 120 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 11 INTEGER");
+         END IF;
+ 
+         IF 12:BB: /= 143 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 12 INTEGER");
+         END IF;
+ 
+         IF 13:CC: /= 168 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 13 INTEGER");
+         END IF;
+ 
+         IF 14:DD: /= 195 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 14 INTEGER");
+         END IF;
+ 
+         IF 15:EE: /= 224 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 15 INTEGER");
+         END IF;
+ 
+         IF 16:FF: /= 255 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 16 INTEGER");
+         END IF;
+ 
+         ----------------------------------------
+ 
+         IF 7:66:E1 /= 336 THEN
+                 FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER " &
+                         "WITH EXPONENT");
+         END IF;
+ 
+         RESULT;
+ END C2A002A; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- C2A008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UPPER AND LOWER CASE "E" MAY APPEAR IN BASED LITERALS,
+ -- WHEN USING COLONS IN PLACE OF THE SHARP SIGN.
+ 
+ -- TBN 2/28/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C2A008A IS
+ 
+      TYPE FLOAT IS DIGITS 5;
+      INT_1 : INTEGER := 15:A:E1;
+      INT_2 : INTEGER := 15:A:e1;
+      FLO_1 : FLOAT := 16:FD.C:E1;
+      FLO_2 : FLOAT := 16:FD.C:e1;
+ 
+ BEGIN
+      TEST("C2A008A", "CHECK THAT UPPER AND LOWER CASE ""E"" MAY " &
+                      "APPEAR IN BASED LITERALS, WHEN USING COLONS " &
+                      "IN PLACE OF THE SHARP SIGN");
+ 
+      IF INT_1 /= INT_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 1");
+      END IF;
+ 
+      IF FLO_1 /= FLO_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 2");
+      END IF;
+ 
+      INT_1 := 14:BC:E1;
+      INT_2 := 14:BC:e1;
+      FLO_1 := 16:DEF.AB:E0;
+      FLO_2 := 16:DEF.AB:e0;
+ 
+      IF INT_1 /= INT_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 3");
+      END IF;
+ 
+      IF FLO_1 /= FLO_2 THEN
+           FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 4");
+      END IF;
+      
+      RESULT;
+ END C2A008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a021b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a021b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c2/c2a021b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c2/c2a021b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,44 ----
+ -- C2A021B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A STRING LITERAL DELIMITED BY PERCENT SIGNS MUST CONTAIN A
+ -- DOUBLED PERCENT CHARACTER IF THE STRING VALUE IS TO CONTAIN A PERCENT
+ -- CHARACTER.
+ 
+ -- JBG 5/25/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C2A021B IS
+      X : STRING (1..5) := %%%%%345%;
+      Y : STRING (1..5) := IDENT_STR ("%%345");
+ BEGIN
+      TEST ("C2A021B", "CHECK USE OF PERCENT SIGN INSIDE STRINGS " &
+                       "DELIMITED WITH PERCENT SIGNS");
+ 
+      IF X /= Y THEN
+           FAILED ("STRING LITERALS NOT EQUAL");
+      END IF;
+ 
+      RESULT;
+ END C2A021B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C32001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR SCALAR TYPES, THE 
+ -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
+ -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
+ -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
+ -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
+ 
+ -- RJW 7/16/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32001A IS
+ 
+      BUMP : ARRAY (1 .. 8) OF INTEGER := (OTHERS => 0);
+ 
+      FUNCTION F (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP (I) + 1;
+           RETURN BUMP (I);
+      END F;
+           
+ BEGIN
+      TEST ("C32001A", "CHECK THAT IN MULTIPLE OBJECT DECLARATION " & 
+                       "FOR SCALAR TYPES, THE SUBTYPE INDICATION " & 
+                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
+                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
+                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
+                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
+                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
+                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
+      
+      DECLARE
+ 
+           TYPE DAY IS (MON, TUES, WED, THURS, FRI);
+           D1, D2   : DAY 
+                      RANGE MON .. DAY'VAL (F (1)) :=
+                      DAY'VAL (F (1) - 1);
+           CD1, CD2 : CONSTANT DAY 
+                      RANGE MON .. DAY'VAL (F (2)) :=
+                      DAY'VAL (F (2) - 1);
+ 
+           I1, I2   : INTEGER RANGE 0 .. F (3) :=
+                      F (3) - 1;
+           CI1, CI2 : CONSTANT INTEGER RANGE 0 .. F (4) 
+                      := F (4) - 1;
+ 
+           TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
+           FL1, FL2   : FLT RANGE 0.0 .. FLT (F (5)) :=
+                        FLT (F (5) - 1);
+           CFL1, CFL2 : CONSTANT FLT 
+                        RANGE 0.0 .. FLT (F (6)) := 
+                        FLT (F (6) - 1);
+ 
+           TYPE FIX IS DELTA 1.0 RANGE -5.0 .. 5.0;
+           FI1, FI2   : FIX RANGE 0.0 .. FIX (F (7)) :=
+                        FIX (F (7) - 1);
+           CFI1, CFI2 : CONSTANT FIX 
+                        RANGE 0.0 .. FIX (F (8)) := 
+                        FIX (F (8) - 1);
+ 
+      BEGIN
+           IF D1 /= TUES THEN 
+                FAILED ( "D1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF D2 /= THURS THEN 
+                FAILED ( "D2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CD1 /= TUES THEN 
+                FAILED ( "CD1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CD2 /= THURS THEN 
+                FAILED ( "CD2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF I1 /= 1 THEN 
+                FAILED ( "I1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF I2 /= 3 THEN 
+                FAILED ( "I2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CI1 /= 1 THEN 
+                FAILED ( "CI1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CI2 /= 3 THEN 
+                FAILED ( "CI2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF FL1 /= 1.0 THEN 
+                FAILED ( "FL1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF FL2 /= 3.0 THEN 
+                FAILED ( "FL2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CFL1 /= 1.0 THEN 
+                FAILED ( "CFL1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CFL2 /= 3.0 THEN 
+                FAILED ( "CFL2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF FI1 /= 1.0 THEN 
+                FAILED ( "FI1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF FI2 /= 3.0 THEN 
+                FAILED ( "FI2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CFI1 /= 1.0 THEN 
+                FAILED ( "CFI1 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+           IF CFI2 /= 3.0 THEN 
+                FAILED ( "CFI2 NOT INITIALIZED TO CORRECT VALUE" );
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C32001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,249 ----
+ -- C32001B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ARRAY TYPES, THE
+ --     SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE
+ --     EVALUATED ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE
+ --     SUBTYPE INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE
+ --     EVALUATIONS YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT
+ --     DECLARATIONS.
+ 
+ -- HISTORY:
+ --     RJW 07/16/86  CREATED ORIGINAL TEST.
+ --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
+ --                   COMMENTS FOR S4 AND CS4 TO READ THAT THE BOUNDS ARE
+ --                   1 .. 6 AND THE COMPONENT TYPE ARR IS 1 .. 5.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32001B IS
+ 
+      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+ 
+      BUMP : ARRAY (1 .. 4) OF INTEGER := (0, 0, 0, 0);
+ 
+      FUNCTION F (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP (I) + 1;
+           RETURN BUMP (I);
+      END F;
+ 
+ BEGIN
+      TEST ("C32001B", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " &
+                       "FOR ARRAY TYPES, THE SUBTYPE INDICATION " &
+                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
+                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
+                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
+                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
+                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
+                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
+ 
+      DECLARE
+ 
+           S1, S2   : ARR (1 .. F (1)) := (OTHERS => F (1));
+           CS1, CS2 : CONSTANT ARR (1 .. F (2)) := (OTHERS => F (2));
+ 
+           PROCEDURE CHECK (A, B : ARR; STR1, STR2 : STRING) IS
+           BEGIN
+                IF A'LAST /= 1 THEN
+                     FAILED ( "INCORRECT UPPER BOUND FOR " & STR1 );
+                END IF;
+ 
+                IF A (1) /= 2 THEN
+                     FAILED ( "INCORRECT INITIAL VALUE FOR " & STR1 );
+                END IF;
+ 
+                IF B'LAST /= 3 THEN
+                     FAILED ( "INCORRECT UPPER BOUND FOR " & STR2 );
+                END IF;
+ 
+                BEGIN
+                     IF B (1 .. 3) = (4, 5, 6) THEN
+                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
+                                    "(4, 5, 6)" );
+                     ELSIF B (1 .. 3) = (5, 4, 6) THEN
+                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
+                                    "(5, 4, 6)" );
+                     ELSIF B (1 .. 3) = (4, 6, 5) THEN
+                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
+                                    "(4, 6, 5)" );
+                     ELSIF B (1 .. 3) = (6, 4, 5) THEN
+                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
+                                    "(6, 4, 5)" );
+                     ELSIF B (1 .. 3) = (6, 5, 4) THEN
+                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
+                                    "(6, 5, 4)" );
+                     ELSIF B (1 .. 3) = (5, 6, 4) THEN
+                          COMMENT ( STR2 & " WAS INITIALIZED TO " &
+                                    "(5, 6, 4)" );
+                     ELSE
+                          FAILED ( STR2 & " HAS INCORRECT INITIAL " &
+                                   "VALUE" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          FAILED ( "CONSTRAINT_ERROR RAISED - " &
+                                    STR2 );
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED - " &
+                                    STR2 );
+                END;
+           END;
+ 
+      BEGIN
+           CHECK (S1, S2, "S1", "S2");
+           CHECK (CS1, CS2, "CS1", "CS2");
+      END;
+ 
+      DECLARE
+ 
+           S3, S4 : ARRAY (1 .. F (3)) OF ARR (1 .. F (3)) :=
+                    (OTHERS => (OTHERS => F (3)));
+ 
+           CS3, CS4 : CONSTANT ARRAY (1.. F (4)) OF
+                      ARR (1 .. F (4)) :=
+                      (OTHERS => (OTHERS => F (4)));
+      BEGIN
+           IF S3'LAST = 1 THEN
+                IF S3 (1)'LAST = 2 THEN
+                     COMMENT ( "S3 HAS BOUNDS 1 .. 1 AND " &
+                               "COMPONENT TYPE ARR (1 .. 2)" );
+                     IF S3 (1)(1 .. 2) = (3, 4) THEN
+                          COMMENT ( "S3 HAS INITIAL VALUES " &
+                                    "3 AND 4 - 1" );
+                     ELSIF S3 (1)(1 .. 2) = (4, 3) THEN
+                          COMMENT ( "S3 HAS INITIAL VALUES " &
+                                    "4 AND 3 - 1" );
+                     ELSE
+                          FAILED ( "S3 HAS WRONG INITIAL VALUES - 1" );
+                     END IF;
+                ELSE
+                     FAILED ( "S3 HAS WRONG COMPONENT TYPE - 1" );
+                END IF;
+           ELSIF S3'LAST = 2 THEN
+                IF S3 (1)'LAST = 1 THEN
+                     COMMENT ( "S3 HAS BOUNDS 1 .. 2 AND " &
+                               "COMPONENT TYPE ARR (1 .. 1)" );
+                     IF S3 (1) (1) = 3 AND S3 (2) (1) = 4 THEN
+                          COMMENT ( "S3 HAS INITIAL VALUES " &
+                                    "3 AND 4 - 2" );
+                     ELSIF S3 (1) (1) = 4 AND S3 (2) (1) = 3 THEN
+                          COMMENT ( "S3 HAS INITIAL VALUES " &
+                                    "4 AND 3 - 2" );
+                     ELSE
+                          FAILED ( "S3 HAS WRONG INITIAL VALUES - 2" );
+                     END IF;
+                ELSE
+                     FAILED ( "S3 HAS WRONG COMPONENT TYPE - 2" );
+                END IF;
+           ELSE
+                FAILED ( "S3 HAS INCORRECT BOUNDS" );
+           END IF;
+ 
+           IF S4'LAST = 5 THEN
+                IF S4 (1)'LAST = 6 THEN
+                     COMMENT ( "S4 HAS BOUNDS 1 .. 5 AND " &
+                               "COMPONENT TYPE ARR (1 .. 6)" );
+                ELSE
+                     FAILED ( "S4 HAS WRONG COMPONENT TYPE - 1" );
+                END IF;
+           ELSIF S4'LAST = 6 THEN
+                IF S4 (1)'FIRST = 1 AND S4 (1)'LAST = 5 THEN
+                     COMMENT ( "S4 HAS BOUNDS 1 .. 6 AND " &
+                               "COMPONENT TYPE ARR (1 .. 5)" );
+                ELSE
+                     FAILED ( "S4 HAS WRONG COMPONENT TYPE - 2" );
+                END IF;
+           ELSE
+                FAILED ( "S4 HAS INCORRECT BOUNDS" );
+           END IF;
+ 
+           IF BUMP (3) /= 36 THEN
+                FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " &
+                         "TIMES TO INITIALIZE S4" );
+           END IF;
+ 
+           IF CS3'FIRST = 1 AND CS3'LAST = 1 THEN
+                IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 2 THEN
+                     COMMENT ( "CS3 HAS BOUNDS 1 .. 1 AND " &
+                               "COMPONENT TYPE ARR (1 .. 2)" );
+                     IF CS3 (1)(1 .. 2) = (3, 4) THEN
+                          COMMENT ( "CS3 HAS INITIAL VALUES " &
+                                    "3 AND 4 - 1" );
+                     ELSIF CS3 (1)(1 .. 2) = (4, 3) THEN
+                          COMMENT ( "CS3 HAS INITIAL VALUES " &
+                                    "4 AND 3 - 1" );
+                     ELSE
+                          FAILED ( "CS3 HAS WRONG INITIAL VALUES - 1" );
+                     END IF;
+                ELSE
+                     FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 1" );
+                END IF;
+           ELSIF CS3'FIRST = 1 AND CS3'LAST = 2 THEN
+                IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 1 THEN
+                     COMMENT ( "CS3 HAS BOUNDS 1 .. 2 AND " &
+                               "COMPONENT TYPE ARR (1 .. 1)" );
+                     IF CS3 (1) (1) = 3 AND CS3 (2) (1) = 4 THEN
+                          COMMENT ( "CS3 HAS INITIAL VALUES " &
+                                    "3 AND 4 - 2" );
+                     ELSIF CS3 (1) (1) = 4 AND CS3 (2) (1) = 3 THEN
+                          COMMENT ( "CS3 HAS INITIAL VALUES " &
+                                    "4 AND 3 - 2" );
+                     ELSE
+                          FAILED ( "CS3 HAS WRONG INITIAL VALUES - 2" );
+                     END IF;
+                ELSE
+                     FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 2" );
+                END IF;
+           ELSE
+                FAILED ( "CS3 HAS INCORRECT BOUNDS" );
+           END IF;
+ 
+           IF CS4'FIRST = 1 AND CS4'LAST = 5 THEN
+                IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 6 THEN
+                     COMMENT ( "CS4 HAS BOUNDS 1 .. 5 AND " &
+                               "COMPONENT TYPE ARR (1 .. 6)" );
+                ELSE
+                     FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 1" );
+                END IF;
+           ELSIF CS4'FIRST = 1 AND CS4'LAST = 6 THEN
+                IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 5 THEN
+                     COMMENT ( "CS4 HAS BOUNDS 1 .. 6 AND " &
+                               "COMPONENT TYPE ARR (1 .. 5)" );
+                ELSE
+                     FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 2" );
+                END IF;
+           ELSE
+                FAILED ( "CS4 HAS INCORRECT BOUNDS" );
+           END IF;
+ 
+           IF BUMP (4) /= 36 THEN
+                FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " &
+                         "TIMES TO INITIALIZE CS4" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C32001B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C32001C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR RECORD TYPES, THE 
+ -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
+ -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
+ -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
+ -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
+ 
+ -- RJW 7/16/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32001C IS
+ 
+      TYPE ARR IS ARRAY (1 .. 2) OF INTEGER;
+      F1, G1 : ARR;
+      BUMP : ARR := (0, 0);
+ 
+      FUNCTION F (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP(I) + 1;
+           F1 (I) := BUMP (I);
+           RETURN BUMP (I);
+      END F;
+ 
+      FUNCTION G (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP(I) + 1;
+           G1 (I) := BUMP (I);
+           RETURN BUMP (I);
+      END G;
+ 
+      FUNCTION H (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP(I) + 1;
+           RETURN BUMP (I);
+      END H;
+ 
+ BEGIN
+      TEST ("C32001C", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 
+                       "FOR RECORD TYPES, THE SUBTYPE INDICATION " & 
+                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
+                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
+                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
+                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
+                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
+                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
+      
+      DECLARE
+ 
+           TYPE REC (D1, D2 : INTEGER) IS
+                RECORD 
+                     VALUE : INTEGER;
+                END RECORD;
+      
+           R1, R2   : REC (F (1), G (1)) := 
+                      (F1 (1), G1 (1), VALUE => H (1));
+           CR1, CR2 : CONSTANT REC (F (2), G (2)) := 
+                      (F1 (2), G1 (2), VALUE => H (2));
+           
+           PROCEDURE CHECK 
+             (R : REC; V1, V2, VAL : INTEGER; S : STRING) IS
+           BEGIN          
+                IF R.D1 = V1 THEN
+                     IF R.D2 = V2 THEN
+                          COMMENT ( S & ".D1 INITIALIZED TO " & 
+                                    INTEGER'IMAGE (V1) & " AND " &
+                                    S & ".D2 INITIALIZED TO " &
+                                    INTEGER'IMAGE (V2));
+                     ELSE
+                          FAILED ( S & 
+                                   ".D2 INITIALIZED INCORRECTLY - 1" );
+                     END IF;
+                ELSIF R.D1 = V2 THEN
+                     IF R.D2 =V1 THEN
+                          COMMENT ( S & ".D1 INITIALIZED TO " & 
+                                    INTEGER'IMAGE (V2) & " AND " &
+                                    S & ".D2 INITIALIZED TO " &
+                                    INTEGER'IMAGE (V1));
+                     ELSE
+                          FAILED ( S & 
+                                   ".D2 INITIALIZED INCORRECTLY - 2" );
+                     END IF;
+                ELSE
+                     FAILED ( S & ".D1 INITIALIZED INCORRECTLY TO " &
+                               INTEGER'IMAGE (R.D1) );
+                END IF;
+                
+                IF R.VALUE /= VAL THEN
+                     FAILED ( S & ".VALUE INITIALIZED INCORRECTLY" );
+                END IF;
+           END CHECK;
+      
+      BEGIN     
+           CHECK (R1, 1, 2, 3, "R1");
+           CHECK (R2, 4, 5, 6, "R2");
+ 
+           CHECK (CR1, 1, 2, 3, "CR1");
+           CHECK (CR2, 4, 5, 6, "CR2");
+      END;     
+ 
+      RESULT;
+ END C32001C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C32001D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ACCESS TYPES, THE 
+ -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
+ -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
+ -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
+ -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
+ 
+ -- RJW 7/16/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32001D IS
+ 
+      TYPE ARR IS ARRAY (1 .. 2) OF INTEGER;
+      BUMP : ARR := (0, 0);
+      F1 : ARR;
+ 
+      FUNCTION F (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP (I) + 1;
+           F1 (I) := BUMP (I);
+           RETURN BUMP (I);
+      END F;
+ 
+      FUNCTION G (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP (I) + 1;
+           RETURN BUMP (I);
+      END G;
+ 
+ BEGIN
+      TEST ("C32001D", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 
+                       "FOR ACCESS TYPES, THE SUBTYPE INDICATION " & 
+                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
+                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
+                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
+                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
+                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
+                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
+      
+      DECLARE
+      
+           TYPE CELL (SIZE : INTEGER) IS
+                RECORD
+                     VALUE : INTEGER;
+                END RECORD;
+ 
+           TYPE LINK IS ACCESS CELL;
+ 
+           L1, L2   : LINK (F (1)) := NEW CELL'(F1 (1), G (1));
+ 
+           CL1, CL2 : CONSTANT LINK (F (2)) := NEW CELL'(F1 (2), G (2));
+           
+           PROCEDURE CHECK (L : LINK; V1, V2 : INTEGER; S : STRING) IS
+           BEGIN
+                IF L.SIZE /= V1 THEN
+                     FAILED ( S & ".SIZE INITIALIZED INCORRECTLY TO " &
+                              INTEGER'IMAGE (L.SIZE));
+                END IF;
+ 
+                IF L.VALUE /= V2 THEN
+                     FAILED ( S & ".VALUE INITIALIZED INCORRECTLY TO " &
+                              INTEGER'IMAGE (L.VALUE));
+                END IF;
+           END CHECK;
+ 
+      BEGIN
+           CHECK (L1, 1, 2, "L1");
+           CHECK (L2, 3, 4, "L2");
+ 
+           CHECK (CL1, 1, 2, "CL1");
+           CHECK (CL2, 3, 4, "CL2");
+      END;
+ 
+      RESULT;
+ END C32001D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32001e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32001e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,253 ----
+ -- C32001E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR PRIVATE TYPES, THE 
+ -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
+ -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 
+ -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS 
+ -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
+ 
+ -- RJW 7/18/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32001E IS
+ 
+      BUMP : ARRAY (1 .. 10) OF INTEGER := (OTHERS => 0);
+      G1 : ARRAY (5 .. 6) OF INTEGER;
+ 
+      FUNCTION F (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP (I) + 1;
+           RETURN BUMP (I);
+      END F;
+ 
+      FUNCTION G (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BUMP (I) := BUMP (I) + 1;
+           G1 (I) := BUMP (I);
+           RETURN BUMP (I);
+      END G;
+ 
+ BEGIN
+      TEST ("C32001E", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 
+                       "FOR PRIVATE TYPES, THE SUBTYPE INDICATION " & 
+                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
+                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
+                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
+                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
+                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
+                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
+      
+      DECLARE
+           PACKAGE PKG1 IS
+                TYPE PBOOL IS PRIVATE;
+                TYPE PINT IS PRIVATE;
+                TYPE PREC (D : INTEGER) IS PRIVATE;
+                TYPE PARR IS PRIVATE;
+                TYPE PACC IS PRIVATE;
+                
+                FUNCTION INIT1 (I : INTEGER) RETURN PBOOL;
+                FUNCTION INIT2 (I : INTEGER) RETURN PINT;
+                FUNCTION INIT3 (I : INTEGER) RETURN PREC;
+                FUNCTION INIT4 (I : INTEGER) RETURN PARR;
+                FUNCTION INIT5 (I : INTEGER) RETURN PACC;
+ 
+                PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING);
+                PROCEDURE CHECK2 (I : PINT;  J : INTEGER; S : STRING);
+                PROCEDURE CHECK3 (R : PREC;  I, J : INTEGER; 
+                                  S : STRING);
+                PROCEDURE CHECK4 (A : PARR;  I, J : INTEGER; 
+                                  S : STRING);
+                PROCEDURE CHECK5 (V : PACC; S : STRING);
+                PROCEDURE CHECK6 (V : PACC; S : STRING);
+ 
+           PRIVATE
+                TYPE PBOOL IS NEW BOOLEAN;
+                TYPE PINT IS NEW INTEGER;
+ 
+                TYPE PREC (D : INTEGER) IS 
+                     RECORD 
+                          VALUE : INTEGER;
+                     END RECORD;
+ 
+                TYPE PARR IS ARRAY (1 .. 2) OF INTEGER;
+ 
+                TYPE VECTOR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+                TYPE PACC IS ACCESS VECTOR;
+           END PKG1;
+ 
+           PACKAGE BODY PKG1 IS
+                FUNCTION INIT1 (I : INTEGER) RETURN PBOOL IS
+                BEGIN
+                     RETURN PBOOL'VAL (F (I) - 1);
+                END INIT1;
+ 
+                FUNCTION INIT2 (I : INTEGER) RETURN PINT IS
+                BEGIN
+                     RETURN PINT'VAL (F (I));
+                END INIT2;
+ 
+                FUNCTION INIT3 (I : INTEGER) RETURN PREC IS
+                     PR : PREC (G1 (I)) := (G1 (I), F (I));
+                BEGIN
+                     RETURN PR;
+                END INIT3;
+ 
+                FUNCTION INIT4 (I : INTEGER) RETURN PARR IS
+                     PA : PARR := (1 .. 2 => F (I));
+                BEGIN
+                     RETURN PA;
+                END INIT4;
+ 
+                FUNCTION INIT5 (I : INTEGER) RETURN PACC IS
+                     ACCV : PACC := NEW VECTOR'(1 .. F (I) => F (I));
+                BEGIN
+                     RETURN ACCV;
+                END INIT5;
+ 
+                PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING) IS
+                BEGIN
+                     IF B /= PBOOL'VAL (I) THEN 
+                          FAILED ( S & " HAS AN INCORRECT VALUE OF " &
+                                   PBOOL'IMAGE (B));
+                     END IF;
+                END CHECK1;
+ 
+                PROCEDURE CHECK2 (I : PINT; J : INTEGER; S : STRING) IS 
+                BEGIN
+                     IF I /= PINT'VAL (J) THEN 
+                          FAILED ( S & " HAS AN INCORRECT VALUE OF " &
+                                   PINT'IMAGE (I));
+                     END IF;
+                END CHECK2;
+ 
+                PROCEDURE CHECK3 (R : PREC; I, J : INTEGER; 
+                                  S : STRING) IS
+                BEGIN
+                     IF R.D /= I THEN 
+                          FAILED ( S & ".D HAS AN INCORRECT VALUE OF " 
+                                   & INTEGER'IMAGE (R.D));
+                     END IF;
+ 
+                     IF R.VALUE /= J THEN
+                          FAILED ( S & ".VALUE HAS AN INCORRECT " &
+                                   "VALUE OF " & 
+                                   INTEGER'IMAGE (R.VALUE));
+                     END IF;
+                END CHECK3;
+ 
+                PROCEDURE CHECK4 (A : PARR; I, J : INTEGER; 
+                                  S : STRING) IS
+                BEGIN
+                     IF A /= (I, J) AND A /= (J, I) THEN
+                          FAILED ( S & " HAS AN INCORRECT VALUE" );
+                     END IF;
+                END CHECK4;
+ 
+                PROCEDURE CHECK5 (V : PACC; S : STRING) IS
+                BEGIN
+                     IF V'LAST /= 1 THEN
+                          FAILED ( S & " HAS AN INCORRECT UPPER BOUND " 
+                                   & "OF " & INTEGER'IMAGE (V'LAST));
+                     END IF;
+ 
+                     IF V (1) /= 2 THEN 
+                          FAILED ( S & " HAS AN INCORRECT COMPONENT " &
+                                   "VALUE" );
+                     END IF;
+                END CHECK5;
+                
+                PROCEDURE CHECK6 (V : PACC; S : STRING) IS
+                BEGIN
+                     IF V'LAST /= 3 THEN
+                          FAILED ( S & " HAS AN INCORRECT UPPER BOUND " 
+                                   & "OF " & INTEGER'IMAGE (V'LAST));
+                     END IF;
+ 
+                     IF V.ALL = (4, 5, 6) OR V.ALL = (5, 4, 6) OR 
+                        V.ALL = (4, 6, 5) OR V.ALL = (6, 4, 5) OR
+                        V.ALL = (5, 6, 4) OR V.ALL = (6, 5, 4) THEN
+                          NULL;
+                     ELSE
+                          FAILED ( S & " HAS AN INCORRECT COMPONENT " &
+                                   "VALUE" );
+                     END IF;
+                END CHECK6;
+ 
+           END PKG1;
+           
+           PACKAGE PKG2 IS END PKG2;
+      
+           PACKAGE BODY PKG2 IS
+                USE PKG1;
+ 
+                B1, B2   : PBOOL := INIT1 (1);
+                CB1, CB2 : CONSTANT PBOOL := INIT1 (2);
+             
+                I1, I2   : PINT := INIT2 (3);
+                CI1, CI2 : CONSTANT PINT := INIT2 (4);
+ 
+                R1, R2   : PREC (G (5)) := INIT3 (5);
+                CR1, CR2 : CONSTANT PREC (G (6)) := INIT3 (6);
+ 
+                A1, A2   : PARR := INIT4 (7);
+                CA1, CA2 : CONSTANT PARR := INIT4 (8);
+ 
+                V1, V2   : PACC  := INIT5 (9);
+                CV1, CV2 : CONSTANT PACC  := INIT5 (10);
+ 
+           BEGIN
+                CHECK1 (B1, 0, "B1");
+                CHECK1 (B2, 1, "B2");
+                CHECK1 (CB1, 0, "CB1");
+                CHECK1 (CB2, 1, "CB2");
+ 
+                CHECK2 (I1, 1, "I1");
+                CHECK2 (I2, 2, "I2");
+                CHECK2 (CI1, 1, "CI1");
+                CHECK2 (CI2, 2, "CI2");
+ 
+                CHECK3 (R1, 1, 2, "R1");
+                CHECK3 (R2, 3, 4, "R2");
+                CHECK3 (CR1, 1, 2, "CR1");
+                CHECK3 (CR2, 3, 4, "CR2");
+ 
+                CHECK4 (A1, 1, 2, "A1");
+                CHECK4 (A2, 3, 4, "A2");
+                CHECK4 (CA1, 1, 2, "CA1");
+                CHECK4 (CA2, 3, 4, "CA2");
+ 
+                CHECK5 (V1, "V1");
+                CHECK6 (V2, "V2");
+                CHECK5 (CV1, "CV1");
+                CHECK6 (CV2, "CV2");
+       END PKG2;
+ 
+      BEGIN
+           NULL;          
+      END;
+ 
+      RESULT;
+ END C32001E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32107a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32107a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32107a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,363 ----
+ -- C32107A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OBJECT DECLARATIONS ARE ELABORATED IN THE ORDER OF THEIR 
+ -- OCCURRENCE, I.E., THAT EXPRESSIONS ASSOCIATED WITH ONE DECLARATION
+ -- (INCLUDING DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE EVALUATED BEFORE
+ -- ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. ALSO, CHECK THAT
+ -- EXPRESSIONS IN THE SUBTYPE INDICATION OR THE CONSTRAINED ARRAY 
+ -- DEFINITION ARE EVALUATED BEFORE ANY INITIALIZATION EXPRESSIONS ARE
+ -- EVALUATED.
+ 
+ -- R.WILLIAMS 9/24/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C32107A IS
+ 
+      BUMP : INTEGER := 0;
+ 
+      ORDER_CHECK : INTEGER;
+ 
+      G1, H1, I1 : INTEGER;
+ 
+      FIRST_CALL : BOOLEAN := TRUE;
+ 
+      TYPE ARR1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+ 
+      TYPE ARR1_NAME IS ACCESS ARR1;
+ 
+      TYPE ARR2 IS ARRAY (POSITIVE RANGE <>, POSITIVE RANGE <>) OF 
+           INTEGER;
+ 
+      TYPE REC (D : INTEGER) IS
+           RECORD
+                COMP : INTEGER;
+           END RECORD;          
+ 
+      TYPE REC_NAME IS ACCESS REC;
+ 
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN BUMP;
+      END F;
+ 
+      FUNCTION G RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           G1 := BUMP;
+           RETURN BUMP;
+      END G;
+      
+      FUNCTION H RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           H1 := BUMP;
+           RETURN BUMP;
+      END H;
+      
+      FUNCTION I RETURN INTEGER IS
+      BEGIN
+           IF FIRST_CALL THEN
+                BUMP := BUMP + 1;
+                I1 := BUMP;
+                FIRST_CALL := FALSE;
+           END IF;
+           RETURN I1;
+      END I;
+ 
+ BEGIN
+      TEST ( "C32107A", "CHECK THAT OBJECT DECLARATIONS ARE " &
+                        "ELABORATED IN THE ORDER OF THEIR " &
+                        "OCCURRENCE, I.E., THAT EXPRESSIONS " &
+                        "ASSOCIATED WITH ONE DECLARATION (INCLUDING " &
+                        "DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE " &
+                        "EVALUATED BEFORE ANY EXPRESSION BELONGING " &
+                        "TO THE NEXT DECLARATION.  ALSO, CHECK THAT " &
+                        "EXPRESSIONS IN THE SUBTYPE INDICATION OR " &
+                        "THE CONSTRAINED ARRAY DEFINITION ARE " &
+                        "EVALUATED BEFORE ANY INITIALIZATION " &
+                        "EXPRESSIONS ARE EVALUATED" );
+      
+      DECLARE -- (A).
+           I1 : INTEGER := 10000 * F;
+           A1 : CONSTANT ARRAY (1 .. H) OF REC (G * 100) :=
+                (1 .. H1 => (G1 * 100, I * 10));
+           I2 : CONSTANT INTEGER := F * 1000;
+      BEGIN
+           ORDER_CHECK := I1 + I2 + A1'LAST + A1 (1).D + A1 (1).COMP;
+           IF ORDER_CHECK = 15243 OR ORDER_CHECK = 15342 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 15343 OR " &
+                         "15242 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
+           END IF;
+      END; -- (A).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (B).
+           A : ARR2 (1 .. F, 1 .. F * 10);
+           R : REC (G * 100) := (G1 * 100, F * 1000);
+           I : INTEGER RANGE 1 .. H;
+           S : REC (F * 10);               
+      BEGIN
+           ORDER_CHECK := 
+                A'LAST (1) + A'LAST (2) + R.D + R.COMP; 
+           IF (H1 + S.D = 65) AND 
+              (ORDER_CHECK = 4321 OR ORDER_CHECK = 4312) THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE 65 " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 65 4321 OR " &
+                         "65 4312 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (H1 + S.D) &
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
+           END IF;
+      END; -- (B).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (C).
+           I1 : CONSTANT INTEGER RANGE 1 .. G * 10 := F;
+           A1 : ARRAY (1 .. F * 100) OF INTEGER RANGE 1 .. H * 1000;
+      BEGIN
+           ORDER_CHECK := I1 + (G1 * 10) + A1'LAST + (H1 * 1000);
+           IF ORDER_CHECK = 4312 OR ORDER_CHECK = 3412 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 4312 OR " &
+                         "3412 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
+           END IF;
+      END; -- (C).         
+ 
+      BUMP := 0;
+      FIRST_CALL := TRUE;
+ 
+      DECLARE -- (D).
+           A1 : ARRAY (1 .. G) OF REC (H * 10000) := 
+                (1 .. G1 => (H1 * 10000, I * 100));
+           R1 : CONSTANT REC := (F * 1000, F * 10);
+ 
+      BEGIN
+           ORDER_CHECK := 
+                A1'LAST + A1 (1).D + A1 (1).COMP + R1.D + R1.COMP;
+           IF ORDER_CHECK = 25341 OR ORDER_CHECK = 24351 OR
+              ORDER_CHECK = 15342 OR ORDER_CHECK = 14352 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 25341, " &
+                         "24351, 15342 OR 14352  -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
+           END IF;
+      END; -- (D).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (E).
+           A1 : CONSTANT ARR1_NAME := NEW ARR1' (1 .. F => F * 10);
+           R1 : REC_NAME (H * 100) := NEW REC'(H1 * 100, F * 1000);
+ 
+      BEGIN
+           ORDER_CHECK := A1.ALL'LAST + A1.ALL (1) + R1.D + R1.COMP;
+           IF ORDER_CHECK /= 4321 THEN
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 4321 " &
+                         "-- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (E)" );
+           END IF;
+      END; -- (E).         
+ 
+      BUMP := 0;
+      FIRST_CALL := TRUE;
+ 
+      DECLARE -- (F).
+           A1 : CONSTANT ARRAY (1 .. G) OF INTEGER RANGE 1 .. H * 100 :=
+                (1 .. G1 => I * 10);
+           A2 : ARR1 (1 .. F * 1000);
+      BEGIN
+           ORDER_CHECK := 
+                A1'LAST + (H1 * 100) + A1 (1) + A2'LAST;
+           IF ORDER_CHECK = 4231 OR ORDER_CHECK = 4132 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 4231 OR " &
+                         "4132 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
+           END IF;
+      END; -- (F).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (G).
+           A1 : ARR1_NAME (1 .. G) := NEW ARR1 (1 .. G1);
+           R1 : CONSTANT REC_NAME (H * 10) := 
+                NEW REC'(H1 * 10, F * 100);
+      BEGIN
+           ORDER_CHECK := A1.ALL'LAST + R1.D + R1.COMP;
+           IF ORDER_CHECK /= 321 THEN
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 321 OR " &
+                         "-- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (G)" );
+           END IF;
+      END; -- (G).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (H). 
+           TYPE REC (D : INTEGER := F) IS
+                RECORD
+                     COMP : INTEGER := F * 10;
+                END RECORD;
+ 
+           R1 : REC;
+           R2 : REC (G * 100) := (G1 * 100, F * 1000);
+      BEGIN
+           ORDER_CHECK := R1.D + R1.COMP + R2.D + R2.COMP;
+           IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
+              ORDER_CHECK = 3421 OR ORDER_CHECK = 3412 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
+                         "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
+           END IF;
+      END; -- (H).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (I).
+           TYPE REC2 (D1, D2 : INTEGER) IS
+                RECORD
+                     COMP : INTEGER;
+                END RECORD;
+ 
+           R1 : REC2 (G  * 1000, H  * 10000) := 
+                     (G1 * 1000, H1 * 10000, F * 100);
+           R2 : REC2 (F, F * 10);
+      BEGIN
+           ORDER_CHECK := R1.D1 + R1.D2 + R1.COMP + R2.D1 + R2.D2;
+           IF ORDER_CHECK = 21354 OR ORDER_CHECK = 21345 OR
+              ORDER_CHECK = 12345 OR ORDER_CHECK = 12354 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 21354, " &
+                         "21345, 12354, OR 12345 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
+           END IF;
+ 
+      END; -- (I).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (J).
+           PACKAGE P IS 
+                TYPE PRIV (D : INTEGER) IS PRIVATE;
+ 
+                P1 : CONSTANT PRIV;
+                P2 : CONSTANT PRIV;          
+ 
+                FUNCTION GET_A (P : PRIV) RETURN INTEGER;
+           PRIVATE
+                TYPE PRIV (D : INTEGER) IS
+                     RECORD
+                          COMP : INTEGER;
+                     END RECORD;
+                P1 : CONSTANT PRIV := (F , F * 10);
+                P2 : CONSTANT PRIV := (F * 100, F * 1000);
+           END P;
+                     
+           PACKAGE BODY P IS
+                FUNCTION GET_A (P : PRIV) RETURN INTEGER IS
+                BEGIN
+                     RETURN P.COMP;
+                END GET_A;
+           END P;
+           
+           USE P;
+      BEGIN
+           ORDER_CHECK := P1.D + GET_A (P1) + P2.D + GET_A (P2);
+           IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
+              ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
+                         "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
+           END IF;
+      END; -- (J).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (K).
+           PACKAGE P IS 
+                TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE;
+ 
+           PRIVATE
+                TYPE PRIV (D1, D2 : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END P;
+           
+           USE P;
+ 
+           P1 : PRIV (F, F * 10);
+           P2 : PRIV (F * 100, F * 1000);
+ 
+      BEGIN
+           ORDER_CHECK := P1.D1 + P1.D2 + P2.D1 + P2.D2;
+           IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
+              ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
+                COMMENT ( "ORDER_CHECK HAS VALUE " &
+                           INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
+           ELSE
+                FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
+                         "VALUE OF ORDER_CHECK SHOULD BE 4321, 4312, " &
+                         "3421, OR 3412 -- ACTUAL VALUE IS " & 
+                          INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
+           END IF;
+ 
+      END; -- (K).         
+ 
+      RESULT;
+ END C32107A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32107c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32107c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32107c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32107c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C32107C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR OBJECTS OF A GENERIC FORMAL TYPE WHOSE ACTUAL PARAMETER IS A 
+ -- TYPE WITH DEFAULT VALUES, CHECK THAT OBJECT DECLARATIONS ARE 
+ -- ELABORATED IN THE ORDER OF THEIR OCCURRENCE, I.E., THAT EXPRESSIONS 
+ -- ASSOCIATED WITH ONE DECLARATION (INCLUDING DEFAULT EXPRESSIONS) ARE 
+ -- EVALUATED BEFORE ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. 
+ 
+ -- R.WILLIAMS 9/24/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C32107C IS
+ 
+      BUMP : INTEGER := 0;
+ 
+      G1, H1 : INTEGER;
+ 
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN BUMP;
+      END F;
+ 
+      FUNCTION G RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           G1 := BUMP;
+           RETURN BUMP;
+      END G;
+      
+      FUNCTION H RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           H1 := BUMP;
+           RETURN BUMP;
+      END H;
+      
+ BEGIN
+      TEST ( "C32107C", "FOR OBJECTS OF A GENERIC FORMAL TYPE WHOSE " &
+                        "ACTUAL PARAMETER IS A TYPE WITH DEFAULT " &
+                        "VALUES, CHECK THAT OBJECT DECLARATIONS ARE " &
+                        "ELABORATED IN THE ORDER OF THEIR " &
+                        "OCCURRENCE, I.E., THAT EXPRESSIONS " &
+                        "ASSOCIATED WITH ONE DECLARATION (INCLUDING " &
+                        "DEFAULT EXPRESSIONS) ARE EVALUATED BEFORE " &
+                        "ANY EXPRESSION BELONGING TO THE NEXT " &
+                        "DECLARATION" );
+ 
+      DECLARE -- (A).
+           TYPE REC (D : INTEGER := F) IS
+                RECORD
+                     A : INTEGER := F;
+                END RECORD;
+ 
+           FUNCTION GET_A (R : REC) RETURN INTEGER IS
+           BEGIN
+                RETURN R.A;
+           END GET_A;
+ 
+           GENERIC
+                TYPE T IS (<>);
+                TYPE PRIV (D : T) IS PRIVATE;
+                WITH FUNCTION GET_A (P : PRIV) RETURN INTEGER IS <>;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                P1 : PRIV (T'VAL (F));
+                P2 : PRIV (T'VAL (F * 100));
+                ORDER_CHECK : INTEGER;
+                
+           BEGIN
+                ORDER_CHECK := 
+                     T'POS (P1.D) + T'POS (P2.D) + 
+                     (GET_A (P1) * 10) + (GET_A (P2) * 1000);
+                IF ORDER_CHECK /= 4321 THEN
+                     FAILED ( "OBJECTS NOT ELABORATED IN PROPER " &
+                              "ORDER VALUE OF ORDER_CHECK SHOULD BE " &
+                              "4321 -- ACTUAL VALUE IS " & 
+                               INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
+                END IF;
+           END P;
+           
+           PROCEDURE PROC IS NEW P (INTEGER, REC);
+ 
+      BEGIN
+           PROC;
+      END; -- (A).         
+ 
+      BUMP := 0;
+ 
+      DECLARE -- (B).
+           TYPE REC (D1 : INTEGER := F; D2 : INTEGER := F) IS
+                RECORD
+                     A : INTEGER := F;
+                END RECORD;
+ 
+           FUNCTION GET_A (R : REC) RETURN INTEGER IS
+           BEGIN
+                RETURN R.A;
+           END GET_A;
+ 
+           GENERIC
+                TYPE T IS (<>);
+                TYPE PRIV (D1 : T; D2 : T) IS PRIVATE;
+                WITH FUNCTION GET_A (P : PRIV) RETURN INTEGER IS <>;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                P1 : PRIV (T'VAL (F * 1000), T'VAL (F * 10000));
+                P2 : PRIV (T'VAL (F), T'VAL (F * 10));
+                ORDER_CHECK : INTEGER;
+                
+           BEGIN
+                ORDER_CHECK := 
+                T'POS (P1.D1) + T'POS (P1.D2) + 
+                T'POS (P2.D1) + T'POS (P2.D2) + 
+                (GET_A (P1) * 100);
+                IF (GET_A (P2) = 6) AND 
+                   (ORDER_CHECK = 12345 OR ORDER_CHECK = 21345 OR
+                    ORDER_CHECK = 21354 OR ORDER_CHECK = 12354) THEN
+                     COMMENT ( "ORDER_CHECK HAS VALUE " &
+                                INTEGER'IMAGE (ORDER_CHECK) & 
+                               " - (B)" );
+                ELSE
+                     FAILED ( "OBJECTS NOT ELABORATED IN PROPER " &
+                              "ORDER VALUE OF ORDER_CHECK SHOULD BE " &
+                              "6 12345, 6 21345, 6 21354, OR " &
+                              "6 12354 -- ACTUAL VALUE IS " &
+                               INTEGER'IMAGE (GET_A (P2)) &
+                               INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
+                END IF;
+ 
+           END P;
+           
+           PROCEDURE PROC IS NEW P (INTEGER, REC);
+ 
+      BEGIN
+           PROC;
+      END; -- (B).         
+ 
+      RESULT;
+ END C32107C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32108a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32108a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32108a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- C32108A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DEFAULT EXPRESSIONS ARE NOT EVALUATED, IF INITIALIZATION
+ -- EXPRESSIONS ARE GIVEN FOR THE OBJECT DECLARATIONS.
+ 
+ -- TBN 3/20/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C32108A IS
+ 
+      FUNCTION DEFAULT_CHECK (NUMBER : INTEGER) RETURN INTEGER IS
+      BEGIN
+           IF NUMBER /= 0 THEN
+                FAILED ("DEFAULT EXPRESSIONS ARE EVALUATED -" &
+                        INTEGER'IMAGE (NUMBER));
+           END IF;
+           RETURN (1);
+      END DEFAULT_CHECK;
+ 
+ BEGIN
+      TEST ("C32108A", "CHECK THAT DEFAULT EXPRESSIONS ARE NOT " &
+                       "EVALUATED, IF INITIALIZATION EXPRESSIONS ARE " &
+                       "GIVEN FOR THE OBJECT DECLARATIONS");
+ 
+      DECLARE     -- (A)
+ 
+           TYPE REC_TYP1 IS
+                RECORD
+                     AGE : INTEGER := DEFAULT_CHECK (1);
+                END RECORD;
+ 
+           REC1 : REC_TYP1 := (AGE => DEFAULT_CHECK (0));
+ 
+ 
+           TYPE REC_TYP2 (D : INTEGER := DEFAULT_CHECK (2)) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           REC2 : REC_TYP2 (DEFAULT_CHECK (0));
+ 
+ 
+           TYPE REC_TYP3 (D : INTEGER := DEFAULT_CHECK (3)) IS
+                RECORD
+                     A : INTEGER := DEFAULT_CHECK (4);
+                END RECORD;
+ 
+           REC3 : REC_TYP3 := (D => DEFAULT_CHECK (0),
+                               A => DEFAULT_CHECK (0));
+ 
+      BEGIN     -- (A)
+           NULL;
+      END;      -- (A)
+ 
+      RESULT;
+ END C32108A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32108b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32108b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32108b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C32108B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A DEFAULT EXPRESSION IS EVALUATED FOR A COMPONENT, NO
+ -- DEFAULT EXPRESSIONS ARE EVALUATED FOR ANY SUBCOMPONENTS.
+ 
+ -- TBN 3/21/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C32108B IS
+ 
+      FUNCTION DEFAULT_CHECK (NUMBER : INTEGER) RETURN INTEGER IS
+      BEGIN
+           IF NUMBER /= 0 THEN
+                FAILED ("SUBCOMPONENT DEFAULT EXPRESSIONS ARE " &
+                        "EVALUATED -" & INTEGER'IMAGE (NUMBER));
+           END IF;
+           RETURN (1);
+      END DEFAULT_CHECK;
+ 
+ BEGIN
+      TEST ("C32108B", "CHECK THAT IF A DEFAULT EXPRESSION IS " &
+                       "EVALUATED FOR A COMPONENT, NO DEFAULT " &
+                       "EXPRESSIONS ARE EVALUATED FOR ANY " &
+                       "SUBCOMPONENTS");
+ 
+      DECLARE     -- (A)
+ 
+           TYPE REC_TYP1 IS
+                RECORD
+                     AGE : INTEGER := DEFAULT_CHECK (1);
+                END RECORD;
+ 
+           TYPE REC_TYP2 (D : INTEGER := DEFAULT_CHECK(2)) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE REC_TYP3 (D : INTEGER := DEFAULT_CHECK(3)) IS
+                RECORD
+                     A : INTEGER := DEFAULT_CHECK(4);
+                END RECORD;
+ 
+           TYPE REC_TYP4 IS
+                RECORD
+                     ONE : REC_TYP1 := (AGE => DEFAULT_CHECK (0));
+                     TWO : REC_TYP2 (DEFAULT_CHECK(0));
+                     THREE : REC_TYP3 := (D => DEFAULT_CHECK (0),
+                                          A => DEFAULT_CHECK (0));
+                END RECORD;
+ 
+           REC4 : REC_TYP4;
+ 
+      BEGIN     -- (A)
+           NULL;
+      END;      -- (A)
+ 
+      RESULT;
+ END C32108B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32111a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32111a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32111a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32111a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,282 ----
+ -- C32111A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ -- CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION,
+ --    INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL VALUE,
+ --    CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES OUTSIDE THE
+ --    RANGE OF THE SUBTYPE.
+ 
+ -- HISTORY:
+ --    RJW 07/20/86  CREATED ORIGINAL TEST.
+ --    JET 08/04/87  IMPROVED DEFEAT OF COMPILER OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32111A IS
+ 
+      TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI);
+      SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED;
+ 
+      SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9';
+ 
+      SUBTYPE SHORT IS INTEGER RANGE -100 .. 100;
+ 
+      TYPE INT IS RANGE -10 .. 10;
+      SUBTYPE PINT IS INT RANGE 1 .. 10;
+ 
+      TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
+      SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0;
+ 
+      TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
+      SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0;
+ 
+ BEGIN
+      TEST ("C32111A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
+                       "HAVING AN ENUMERATION, INTEGER, FLOAT OR " &
+                       "FIXED TYPE IS DECLARED WITH AN INITIAL " &
+                       "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " &
+                       "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " &
+                       "SUBTYPE" );
+ 
+      BEGIN
+           DECLARE
+                D : MIDWEEK := WEEKDAY'VAL (IDENT_INT (1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'D'" );
+                IF D = TUES THEN
+                     COMMENT ("VARIABLE 'D' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'D'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                D : CONSTANT WEEKDAY RANGE WED .. WED :=
+                    WEEKDAY'VAL (IDENT_INT (3));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'D'" );
+                IF D = TUES THEN
+                     COMMENT ("INITIALIZE VARIABLE 'D'");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'D'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                P : CONSTANT DIGIT := IDENT_CHAR ('/');
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'P'" );
+                IF P = '0' THEN
+                     COMMENT ("VARIABLE 'P' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'P'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                Q : CHARACTER RANGE 'A' .. 'E' := IDENT_CHAR ('F');
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'Q'" );
+                IF Q = 'A' THEN
+                     COMMENT ("VARIABLE 'Q' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'Q'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                I  :  SHORT := IDENT_INT (-101);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'I'" );
+                IF I = 1 THEN
+                     COMMENT ("VARIABLE 'I' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'I'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                J  : CONSTANT INTEGER RANGE 0 .. 100 := IDENT_INT (101);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'J'" );
+                IF J = -1 THEN
+                     COMMENT ("VARIABLE 'J' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'J'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                K  : INT RANGE 0 .. 1 := INT (IDENT_INT (2));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'K'" );
+                IF K = 2 THEN
+                     COMMENT ("VARIABLE 'K' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'K'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                L  : CONSTANT PINT := INT (IDENT_INT (0));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'L'" );
+                IF L = 1 THEN
+                     COMMENT ("VARIABLE 'L' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'L'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FL : SFLT := FLT (IDENT_INT (1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FL'" );
+                IF FL = 3.14 THEN
+                     COMMENT ("VARIABLE 'FL' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FL'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 :=
+                      FLT (IDENT_INT (-1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FL1'" );
+                IF FL1 = 0.0 THEN
+                     COMMENT ("VARIABLE 'FL1' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FL1'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FI : FIXED RANGE 0.0 .. 0.0 := IDENT_INT (1) * 0.5;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FI'" );
+                IF FI = 0.5 THEN
+                     COMMENT ("VARIABLE 'FI' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FI'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FI1 : CONSTANT SFIXED := IDENT_INT (-1) * 0.5;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FI1'" );
+                IF FI1 = 0.5 THEN
+                     COMMENT ("VARIABLE 'FI1' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FI1'" );
+      END;
+ 
+      RESULT;
+ END C32111A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32111b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32111b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32111b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32111b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,282 ----
+ -- C32111B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ -- CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION,
+ --    INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL STATIC
+ --    VALUE, CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES
+ --    OUTSIDE THE RANGE OF THE SUBTYPE.
+ 
+ -- HISTORY:
+ --    JET 08/04/87  CREATED ORIGINAL TEST BASED ON C32111A BY RJW
+ --                  BUT WITH STATIC VALUES INSTEAD OF DYNAMIC
+ --                  IDENTITY FUNCTION.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32111B IS
+ 
+      TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI);
+      SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED;
+ 
+      SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9';
+ 
+      SUBTYPE SHORT IS INTEGER RANGE -100 .. 100;
+ 
+      TYPE INT IS RANGE -10 .. 10;
+      SUBTYPE PINT IS INT RANGE 1 .. 10;
+ 
+      TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
+      SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0;
+ 
+      TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
+      SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0;
+ 
+ BEGIN
+      TEST ("C32111B", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
+                       "HAVING AN ENUMERATION, INTEGER, FLOAT OR " &
+                       "FIXED TYPE IS DECLARED WITH AN INITIAL STATIC " &
+                       "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " &
+                       "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " &
+                       "SUBTYPE" );
+ 
+      BEGIN
+           DECLARE
+                D : MIDWEEK := WEEKDAY'VAL (1);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'D'" );
+                IF D = TUES THEN
+                     COMMENT ("VARIABLE 'D' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'D'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                D : CONSTANT WEEKDAY RANGE WED .. WED :=
+                    WEEKDAY'VAL (3);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'D'" );
+                IF D = TUES THEN
+                     COMMENT ("INITIALIZE VARIABLE 'D'");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'D'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                P : CONSTANT DIGIT := '/';
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'P'" );
+                IF P = '0' THEN
+                     COMMENT ("VARIABLE 'P' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'P'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                Q : CHARACTER RANGE 'A' .. 'E' := 'F';
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'Q'" );
+                IF Q = 'A' THEN
+                     COMMENT ("VARIABLE 'Q' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'Q'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                I  :  SHORT := -101;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'I'" );
+                IF I = 1 THEN
+                     COMMENT ("VARIABLE 'I' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'I'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                J  : CONSTANT INTEGER RANGE 0 .. 100 := 101;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'J'" );
+                IF J = -1 THEN
+                     COMMENT ("VARIABLE 'J' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'J'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                K  : INT RANGE 0 .. 1 := 2;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'K'" );
+                IF K = 2 THEN
+                     COMMENT ("VARIABLE 'K' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'K'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                L  : CONSTANT PINT := 0;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'L'" );
+                IF L = 1 THEN
+                     COMMENT ("VARIABLE 'L' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'L'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FL : SFLT := 1.0;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FL'" );
+                IF FL = 3.14 THEN
+                     COMMENT ("VARIABLE 'FL' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FL'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 := -1.0;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FL1'" );
+                IF FL1 = 0.0 THEN
+                     COMMENT ("VARIABLE 'FL1' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FL1'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FI : FIXED RANGE 0.0 .. 0.0 := 0.5;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FI'" );
+                IF FI = 0.5 THEN
+                     COMMENT ("VARIABLE 'FI' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'FI'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                FI1 : CONSTANT SFIXED := -0.5;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FI1'" );
+                IF FI1 = 0.5 THEN
+                     COMMENT ("VARIABLE 'FI1' INITIALIZED");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'FI1'" );
+      END;
+ 
+      RESULT;
+ END C32111B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32112b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32112b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32112b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32112b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- C32112B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR THE DECLARATION OF A NULL
+ -- ARRAY OBJECT IF THE INITIAL VALUE IS NOT A NULL ARRAY.
+ 
+ -- RJW 7/20/86
+ -- GMT 7/01/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
+ --              CHANGED THE RANGE VALUES OF A FEW DIMENSIONS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32112B IS
+ 
+      TYPE ARR1 IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+      SUBTYPE NARR1 IS ARR1 (IDENT_INT (2) .. IDENT_INT (1));
+ 
+ 
+      TYPE ARR2 IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
+           OF INTEGER;
+      SUBTYPE NARR2 IS ARR2 (IDENT_INT (1) .. IDENT_INT (2),
+                             IDENT_INT (1) .. IDENT_INT (0));
+ 
+ BEGIN
+      TEST ("C32112B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                       "THE DECLARATION OF A NULL ARRAY OBJECT IF " &
+                       "THE INITIAL VALUE IS NOT A NULL ARRAY");
+ 
+      BEGIN
+           DECLARE
+                A   : ARR1 (IDENT_INT(1) .. IDENT_INT(2));
+                N1A : NARR1 := (A'RANGE => 0);
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N1A'");
+                A(1) := IDENT_INT(N1A(1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N1A'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A   : ARR1 (IDENT_INT (1) .. IDENT_INT (2));
+                N1B : CONSTANT NARR1 := (A'RANGE => 0);
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N1B'");
+                A(1) := IDENT_INT(N1B(1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N1B'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A   : ARR1 (IDENT_INT (1) .. IDENT_INT (1));
+                N1C : CONSTANT NARR1 := (A'RANGE => 0);
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N1C'");
+                A(1) := IDENT_INT(N1C(1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N1C'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A   : ARR1 (IDENT_INT (1) .. IDENT_INT (1));
+                N1D : NARR1 := (A'RANGE => 0);
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N1D'");
+                A(1) := IDENT_INT(N1D(1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N1D'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A   : ARR1 (IDENT_INT (0) .. IDENT_INT (1));
+                N1E : ARR1 (IDENT_INT (1) .. IDENT_INT (0)) :=
+                           (A'RANGE  => 0);
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N1E'");
+                A(1) := IDENT_INT(N1E(1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N1E'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A   : ARR1 (IDENT_INT (0) .. IDENT_INT (1));
+                N1F : CONSTANT ARR1 (IDENT_INT (1) .. IDENT_INT (0)) :=
+                      (A'RANGE => 0);
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N1F'");
+                A(1) := IDENT_INT(N1F(1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N1F'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A   : ARR2 (IDENT_INT (1) .. IDENT_INT (2),
+                            IDENT_INT (0) .. IDENT_INT (1));
+                N2A : CONSTANT NARR2 := (A'RANGE => (A'RANGE (2) =>0));
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N2'");
+                A(1,1) := IDENT_INT(N2A(1,1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N2A'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A : ARR2 (IDENT_INT (1) .. IDENT_INT (2),
+                          IDENT_INT (0) .. IDENT_INT (1));
+                N2B : NARR2 := (A'RANGE => (A'RANGE (2) =>0));
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N2B'");
+                A(1,1) := IDENT_INT(N2B(1,1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N2B'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A : ARR2 (IDENT_INT (1) .. IDENT_INT (3),
+                          IDENT_INT (1) .. IDENT_INT (1));
+                N2C : CONSTANT NARR2 := (A'RANGE => (A'RANGE (2) =>0));
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N2C'");
+                A(1,1) := IDENT_INT(N2C(1,1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N2C'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A : ARR2 (IDENT_INT (1) .. IDENT_INT (3),
+                          IDENT_INT (1) .. IDENT_INT (1));
+                N2D : NARR2 := (A'RANGE => (A'RANGE (2) =>0));
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N2D'");
+                A(1,1) := IDENT_INT(N2D(1,1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N2D'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A : ARR2 (IDENT_INT (1) .. IDENT_INT (1),
+                          IDENT_INT (1) .. IDENT_INT (1));
+                N2E : CONSTANT ARR2 (IDENT_INT (2) .. IDENT_INT (1),
+                                     IDENT_INT (1) .. IDENT_INT (1)) :=
+                                    (A'RANGE => (A'RANGE (2) =>0));
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N2E'");
+                A(1,1) := IDENT_INT(N2E(1,1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF CONSTANT 'N2E'");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A   : ARR2 (IDENT_INT (1) .. IDENT_INT (1),
+                            IDENT_INT (1) .. IDENT_INT (1));
+                N2F : ARR2 (IDENT_INT (2) .. IDENT_INT (1),
+                            IDENT_INT (1) .. IDENT_INT (1)) :=
+                            (A'RANGE => (A'RANGE (2) =>0));
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N2F'");
+                A(1,1) := IDENT_INT(N2F(1,1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                        "OF VARIABLE 'N2F'");
+      END;
+ 
+      RESULT;
+ END C32112B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32113a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32113a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32113a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,534 ----
+ -- C32113A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED TYPE
+ --     WITH DISCRIMINANTS IS DECLARED WITH AN INITIAL VALUE,
+ --     CONSTRAINT_ERROR IS RAISED IF THE CORRESPONDING DISCRIMINANTS OF
+ --     THE INITIAL VALUE AND THE SUBTYPE DO NOT HAVE THE SAME VALUE.
+ 
+ -- HISTORY:
+ --     RJW 07/20/86
+ --     DWC 06/22/87  ADDED SUBTYPE PRIVAS.  ADDED CODE TO PREVENT DEAD
+ --                   VARIABLE OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32113A IS
+ 
+      PACKAGE PKG IS
+           TYPE PRIVA (D : INTEGER := 0) IS PRIVATE;
+           SUBTYPE PRIVAS IS PRIVA (IDENT_INT (1));
+           PRA1 : CONSTANT PRIVAS;
+ 
+           TYPE PRIVB (D1, D2 : INTEGER) IS PRIVATE;
+           PRB12 : CONSTANT PRIVB;
+ 
+      PRIVATE
+           TYPE PRIVA (D : INTEGER := 0) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE PRIVB (D1, D2 : INTEGER) IS
+                RECORD
+                      NULL;
+                END RECORD;
+ 
+           PRA1  : CONSTANT PRIVAS := (D => (IDENT_INT (1)));
+           PRB12 : CONSTANT PRIVB := (IDENT_INT (1), IDENT_INT (2));
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE RECA (D : INTEGER := 0) IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      TYPE RECB (D1, D2 : INTEGER) IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      RA1 : CONSTANT RECA (IDENT_INT (1)) := (D => (IDENT_INT (1)));
+ 
+      RB12 : CONSTANT RECB := (IDENT_INT (1), IDENT_INT (2));
+ 
+ BEGIN
+      TEST ("C32113A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
+                       "HAVING A CONSTRAINED TYPE IS DECLARED WITH " &
+                       "AN INITIAL VALUE, CONSTRAINT_ERROR IS " &
+                       "RAISED IF THE CORRESPONDING DISCRIMINANTS " &
+                       "OF THE INITIAL VALUE AND THE SUBTYPE DO " &
+                       "NOT HAVE THE SAME VALUE" );
+ 
+      BEGIN
+           DECLARE
+                PR1 : CONSTANT PRIVA (IDENT_INT (0)) := PRA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR1'" );
+                IF PR1 = PRA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR1'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PR2 : CONSTANT PRIVA (IDENT_INT (2)) := PRA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR2'" );
+                IF PR2 = PRA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR2'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PR3 : PRIVA (IDENT_INT (0)) := PRA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR3'" );
+                IF PR3 = PRA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR3'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PR4 : PRIVA (IDENT_INT (2)) := PRA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR4'" );
+                IF PR4 = PRA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR4'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SPRIVA IS PRIVA (IDENT_INT (-1));
+                PR5 : CONSTANT SPRIVA := PRA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR5'" );
+                IF PR5 = PRA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR5'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SPRIVA IS PRIVA (IDENT_INT (3));
+                PR6 : SPRIVA := PRA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR6'" );
+                IF PR6 = PRA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR6'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PR7 : CONSTANT PRIVB (IDENT_INT (1), IDENT_INT (1)) :=
+                      PRB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR7'" );
+                IF PR7 = PRB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR7'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PR8 : CONSTANT PRIVB (IDENT_INT (2), IDENT_INT (2)) :=
+                      PRB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR8'" );
+                IF PR8 = PRB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR8'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PR9 : PRIVB (IDENT_INT (1), IDENT_INT (1)) := PRB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR9'" );
+                IF PR9 = PRB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR9'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PR10 : PRIVB (IDENT_INT (2), IDENT_INT (2)) := PRB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR10'" );
+                IF PR10 = PRB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR10'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SPRIVB IS
+                        PRIVB (IDENT_INT (-1), IDENT_INT (-2));
+                PR11 : CONSTANT SPRIVB := PRB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR11'" );
+                IF PR11 = PRB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'PR11'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SPRIVB IS PRIVB (IDENT_INT (2), IDENT_INT (1));
+                PR12 : SPRIVB := PRB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR12'" );
+                IF PR12 = PRB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'PR12'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R1 : CONSTANT RECA (IDENT_INT (0)) := RA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R1'" );
+                IF R1 = RA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R1'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R2 : CONSTANT RECA (IDENT_INT (2)) := RA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R2'" );
+                IF R2 = RA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R2'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R3 : RECA (IDENT_INT (0)) := RA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R3'" );
+                IF R3 = RA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R3'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R4 : RECA (IDENT_INT (2)) := RA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R4'" );
+                IF R4 = RA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R4'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SRECA IS RECA (IDENT_INT (-1));
+                R5 : CONSTANT SRECA := RA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R5'" );
+                IF R5 = RA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R5'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SRECA IS RECA (IDENT_INT (3));
+                R6 : SRECA := RA1;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R6'" );
+                IF R6 = RA1 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R6'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R7 : CONSTANT RECB (IDENT_INT (1), IDENT_INT (1)) :=
+                      RB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R7'" );
+                IF R7 = RB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R7'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R8 : CONSTANT RECB (IDENT_INT (2), IDENT_INT (2)) :=
+                      RB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R8'" );
+                IF R8 = RB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R8'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R9 : RECB (IDENT_INT (1), IDENT_INT (1)) := RB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R9'" );
+                IF R9 = RB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R9'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R10 : RECB (IDENT_INT (2), IDENT_INT (2)) := RB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R10'" );
+                IF R10 = RB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R10'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SRECB IS
+                        RECB (IDENT_INT (-1), IDENT_INT (-2));
+                R11 : CONSTANT SRECB := RB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R11'" );
+                IF R11 = RB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'R11'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SRECB IS RECB (IDENT_INT (2), IDENT_INT (1));
+                R12 : SRECB := RB12;
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R12'" );
+                IF R12 = RB12 THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'R12'" );
+      END;
+ 
+      RESULT;
+ END C32113A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32115a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32115a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32115a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32115a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,338 ----
+ -- C32115A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED
+ --    ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE,
+ --    CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT
+ --    VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING
+ --    VALUE SPECIFIED FOR THE ACCESS SUBTYPE.
+ 
+ -- HISTORY:
+ --    RJW 07/20/86  CREATED ORIGINAL TEST.
+ --    JET 08/05/87  ADDED DEFEAT OF DEAD VARIABLE OPTIMIZATION.
+ --    PWN 11/30/94  REMOVED TEST ILLEGAL IN ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32115A IS
+ 
+      PACKAGE PKG IS
+           TYPE PRIV (D : INTEGER) IS PRIVATE;
+ 
+      PRIVATE
+           TYPE PRIV (D : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE ACCP IS ACCESS PRIV (IDENT_INT (1));
+ 
+      TYPE REC (D : INTEGER) IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      TYPE ACCR IS ACCESS REC (IDENT_INT (2));
+ 
+      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+ 
+      TYPE ACCA IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (2));
+ 
+      TYPE ACCN IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (0));
+ 
+ BEGIN
+      TEST ("C32115A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
+                       "HAVING A CONSTRAINED ACCESS TYPE IS " &
+                       "DECLARED WITH AN INITIAL NON-NULL ACCESS " &
+                       "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " &
+                       "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " &
+                       "DESIGNATED OBJECT DOES NOT EQUAL THE " &
+                       "CORRESPONDING VALUE SPECIFIED FOR THE " &
+                       "ACCESS SUBTYPE" );
+ 
+      BEGIN
+           DECLARE
+                AC1 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (2)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC1'" );
+                IF AC1 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC1' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC1'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC2 : ACCP := NEW PRIV (D => (IDENT_INT (2)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC2'" );
+                IF AC2 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC2' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC2'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC3 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (0)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC3'" );
+                IF AC3 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC3' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC3'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC4 : ACCP := NEW PRIV (D => (IDENT_INT (0)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC4'" );
+                IF AC4 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC4' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC4'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC5 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (1)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC5'" );
+                IF AC5 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC5' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC5'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC6 : ACCR := NEW REC' (D => (IDENT_INT (1)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC6'" );
+                IF AC6 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC6' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC6'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC7 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (3)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC7'" );
+                IF AC7 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC7' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC7'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC8 : ACCR := NEW REC' (D => (IDENT_INT (3)));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC8'" );
+                IF AC8 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC8' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC8'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC9 : CONSTANT ACCA :=
+                     NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC9'" );
+                IF AC9 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC9' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC9'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC10 : ACCA :=
+                     NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC10'" );
+                IF AC10 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC10' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC10'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC11 : CONSTANT ACCA :=
+                     NEW ARR' (IDENT_INT (0) .. IDENT_INT (2) => 0);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC11'" );
+                IF AC11 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC11' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC11'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC12 : ACCA :=
+                     NEW ARR'(IDENT_INT (0) .. IDENT_INT (2) => 0);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC12'" );
+                IF AC12 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC12' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC12'" );
+      END;
+ 
+ 
+      BEGIN
+           DECLARE
+                AC15 : CONSTANT ACCN :=
+                     NEW ARR' (IDENT_INT (0) .. IDENT_INT (0) => 0);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC15'" );
+                IF AC15 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC15' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC15'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC16 : ACCN :=
+                     NEW ARR'(IDENT_INT (0) .. IDENT_INT (0) => 0);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC16'" );
+                IF AC16 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC16' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC16'" );
+      END;
+ 
+      RESULT;
+ END C32115A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32115b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32115b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c32115b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c32115b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,376 ----
+ -- C32115B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING AN UNCONSTRAINED
+ --    ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE,
+ --    CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT
+ --    VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING
+ --    VALUE SPECIFIED FOR THE ACCESS SUBTYPE OF THE OBJECT.
+ 
+ -- HISTORY:
+ --    JET 08/05/87  CREATED ORIGINAL TEST BASED ON C32115A BY RJW
+ --                  BUT WITH UNCONSTRAINED ACCESS TYPES AND
+ --                  CONSTRAINED VARIABLE/CONSTANT DECLARATIONS.
+ -- KAS 12/4/95 FIXED TYPO IN CALL TO REPORT.TEST
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C32115B IS
+ 
+      PACKAGE PKG IS
+           TYPE PRIV (D : INTEGER) IS PRIVATE;
+ 
+      PRIVATE
+           TYPE PRIV (D : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE ACCP IS ACCESS PRIV;
+ 
+      TYPE REC (D : INTEGER) IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      TYPE ACCR IS ACCESS REC;
+ 
+      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+ 
+      TYPE ACCA IS ACCESS ARR;
+ 
+      TYPE ACCN IS ACCESS ARR;
+ 
+ BEGIN
+      TEST ("C32115B", "CHECK THAT WHEN CONSTRAINED VARIABLE OR " &
+                       "CONSTANT HAVING AN UNCONSTRAINED ACCESS TYPE " &
+                       "IS DECLARED WITH AN INITIAL NON-NULL ACCESS " &
+                       "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " &
+                       "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " &
+                       "DESIGNATED OBJECT DOES NOT EQUAL THE " &
+                       "CORRESPONDING VALUE SPECIFIED FOR THE " &
+                       "ACCESS SUBTYPE OF THE OBJECT" );
+ 
+      BEGIN
+           DECLARE
+                AC1 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (2));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC1'" );
+                IF AC1 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC1' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC1'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC2 : ACCP(1) := NEW PRIV (IDENT_INT (2));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC2'" );
+                IF AC2 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC2' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC2'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC3 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (0));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC3'" );
+                IF AC3 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC3' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC3'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC4 : ACCP(1) := NEW PRIV (IDENT_INT (0));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC4'" );
+                IF AC4 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC4' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC4'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC5 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC5'" );
+                IF AC5 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC5' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC5'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC6 : ACCR(2) := NEW REC (IDENT_INT (1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC6'" );
+                IF AC6 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC6' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC6'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC7 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (3));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC7'" );
+                IF AC7 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC7' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC7'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC8 : ACCR(2) := NEW REC (IDENT_INT (3));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC8'" );
+                IF AC8 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC8' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC8'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC9 : CONSTANT ACCA(1 .. 2) :=
+                      NEW ARR(IDENT_INT(1) .. IDENT_INT (1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC9'" );
+                IF AC9 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC9' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC9'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC10 : ACCA (1..2) :=
+                     NEW ARR(IDENT_INT (1) .. IDENT_INT (1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC10'" );
+                IF AC10 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC10' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC10'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC11 : CONSTANT ACCA(1..2) :=
+                     NEW ARR(IDENT_INT (0) .. IDENT_INT (2));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC11'" );
+                IF AC11 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC11' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC11'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC12 : ACCA(1..2) :=
+                     NEW ARR(IDENT_INT (0) .. IDENT_INT (2));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC12'" );
+                IF AC12 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC12' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC12'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC13 : CONSTANT ACCA (1..2) :=
+                     NEW ARR(IDENT_INT (2) .. IDENT_INT (3));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC13'" );
+                IF AC13 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC13' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC13'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC14 : ACCA(1..2) :=
+                     NEW ARR(IDENT_INT (2) .. IDENT_INT (3));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC14'" );
+                IF AC14 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC14' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC14'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC15 : CONSTANT ACCN(1..0) :=
+                     NEW ARR(IDENT_INT (0) .. IDENT_INT (0));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC15'" );
+                IF AC15 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC15' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF CONSTANT 'AC15'" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                AC16 : ACCN(1..0) :=
+                     NEW ARR(IDENT_INT (0) .. IDENT_INT (0));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC16'" );
+                IF AC16 /= NULL THEN
+                     COMMENT ("DEFEAT 'AC16' OPTIMIZATION");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
+                         "OF VARIABLE 'AC16'" );
+      END;
+ 
+      RESULT;
+ END C32115B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c330001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c330001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c330001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c330001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,354 ----
+ -- C330001.A 
+ -- 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- 
+ -- OBJECTIVE: 
+ --      Check that a variable object of an indefinite type is properly 
+ --      initialized/constrained by an initial value assignment that is 
+ --      a) an aggregate, b) a function, or c) an object.  Check that objects 
+ --      of the above types do not need explicit constraints if they have 
+ --      initial values.  
+ --                    
+ -- TEST DESCRIPTION: 
+ --      An indefinite subtype is either: 
+ --         a) An unconstrained array subtype. 
+ --         b) A subtype with unknown discriminants.
+ --         c) A subtype with unconstrained discriminants without defaults. 
+ -- 
+ --      Declare several indefinite types in a parent package specification.  
+ --      In the private part, complete one type with a discriminant without 
+ --      default (indefinite) and the other with a default discriminant 
+ --      (definite).  Declare objects of both indefinite and definite subtypes 
+ --      in children (private and public) with initialization expressions.  The 
+ --      test verifies all values of the objects.  It also verifies that
+ --      Constraint_Error is raised if an attempt is made to change the 
+ --      discriminants of the objects of the indefinite subtypes.        
+ -- 
+ -- 
+ -- CHANGE HISTORY: 
+ --      15 Jan 95   SAIC    Initial version for ACVC 2.1
+ --      25 Jul 96   SAIC    Modified test description. Deleted use C330001_0.
+ --      20 Nov 98   RLB     Added Elaborate pragmas to avoid problems
+ --                          with an unconventional, but legal, elaboration
+ --                          order.
+ --!
+ 
+ package C330001_0 is  
+ 
+    subtype Sub_Type is Integer range 1 .. 20;
+ 
+    type Tag_W_Disc (D : Sub_Type) is tagged record
+        C1 :  String (1 .. D);
+    end record;
+ 
+    -- Indefinite type declarations.
+ 
+    type FullViewDefinite_Unknown_Disc (<>) is private;           
+ 
+    type Indefinite_No_Disc is array (Positive range <>) of Integer;
+ 
+    type Indefinite_Tag_W_Disc (D : Sub_Type) is tagged
+      record
+         C1 : Boolean := False;
+      end record;
+ 
+    type Indefinite_New_W_Disc (ND : Sub_Type) is new 
+      Indefinite_Tag_W_Disc (ND) with record
+         C2 : Integer := 9;
+      end record;
+ 
+    type Indefinite_W_Inherit_Disc_1 is new Tag_W_Disc with 
+      record     
+         S : Sub_Type := 18;
+      end record;
+                                                     
+    type Indefinite_W_Inherit_Disc_2 is     
+      new Tag_W_Disc with private;                                       
+                                                                            
+    function Indef_Func_1 return FullViewDefinite_Unknown_Disc;
+ 
+    function Indef_Func_2 (P : Sub_Type) return Indefinite_W_Inherit_Disc_2;
+ 
+ private
+ 
+    type FullViewDefinite_Unknown_Disc (D : Sub_Type := 2) is
+       record     
+         S : String (1 .. D) := "Hi";
+       end record;
+ 
+    type Indefinite_W_Inherit_Disc_2 is new Tag_W_Disc with 
+       record     
+         S : Sub_Type;
+       end record;
+ 
+ end C330001_0;
+ 
+      --==================================================================--
+ 
+ package body C330001_0 is  
+ 
+    function Indef_Func_1 return FullViewDefinite_Unknown_Disc is
+       Var_1 : FullViewDefinite_Unknown_Disc;      -- No need for explicit 
+                                                   -- constraints, use initial
+    begin                                          -- values.
+       return Var_1;
+    end Indef_Func_1;
+ 
+    ------------------------------------------------------------------
+    function Indef_Func_2 (P : Sub_Type) return Indefinite_W_Inherit_Disc_2 is
+       Var_2 : Indefinite_W_Inherit_Disc_2 := (D => 5, C1 => "Hello", S => P);
+    begin
+       return Var_2;
+    end Indef_Func_2;
+ 
+ end C330001_0;
+ 
+      --==================================================================--
+ 
+ with C330001_0;
+ pragma Elaborate(C330001_0); -- Insure that the functions can be called.
+ private
+ package C330001_0.C330001_1 is  
+ 
+    PrivateChild_Obj    : Tag_W_Disc := (D => 4, C1 => "ACVC");
+ 
+    PrivateChild_Obj_01 : Indefinite_W_Inherit_Disc_1 
+      := Indefinite_W_Inherit_Disc_1'(PrivateChild_Obj with S => 15);
+ 
+    -- Since full view of Indefinite_W_Inherit_Disc_2 is indefinite in 
+    -- the parent package, Indefinite_W_Inherit_Disc_2 needs an initialization
+    -- expression.
+ 
+    PrivateChild_Obj_02 : Indefinite_W_Inherit_Disc_2 := Indef_Func_2 (19);
+ 
+    -- Since full view of FullViewDefinite_Unknown_Disc is definite in the 
+    -- parent package, no initialization expression needed for 
+    -- PrivateChild_Obj_03.
+ 
+    PrivateChild_Obj_03 : FullViewDefinite_Unknown_Disc;
+ 
+    PrivateChild_Obj_04 : Indefinite_No_Disc          := (12, 15);
+ 
+ end C330001_0.C330001_1;
+ 
+      --==================================================================--
+ 
+ with C330001_0;
+ pragma Elaborate(C330001_0); -- Insure that the functions can be called.
+ package C330001_0.C330001_2 is  
+ 
+    PublicChild_Obj_01 : FullViewDefinite_Unknown_Disc := Indef_Func_1;
+ 
+    PublicChild_Obj_02 : Indefinite_W_Inherit_Disc_2   := Indef_Func_2 (4);
+ 
+    PublicChild_Obj_03 : Indefinite_No_Disc            := (38, 72, 21, 59);
+ 
+    PublicChild_Obj_04 : Indefinite_Tag_W_Disc         := (D => 7, C1 => True);
+ 
+    PublicChild_Obj_05 : Indefinite_Tag_W_Disc         := PublicChild_Obj_04;
+ 
+    PublicChild_Obj_06 : Indefinite_New_W_Disc (6);
+ 
+    procedure Assign_Private_Obj_3;
+ 
+    function Raised_CE_PublicChild_Obj return Boolean;
+ 
+    function Raised_CE_PrivateChild_Obj return Boolean;
+ 
+    -- The following functions check the private types defined in the parent
+    -- and the private child package from within the client program.
+ 
+    function Verify_Public_Obj_1 return Boolean;
+ 
+    function Verify_Public_Obj_2 return Boolean;
+ 
+    function Verify_Private_Obj_1 return Boolean;
+ 
+    function Verify_Private_Obj_2 return Boolean;
+ 
+    function Verify_Private_Obj_3 return Boolean;
+ 
+ end C330001_0.C330001_2;
+ 
+      --==================================================================--
+ 
+ with Report;
+ with C330001_0.C330001_1;
+ package body C330001_0.C330001_2 is  
+ 
+    procedure Assign_Private_Obj_3 is
+    begin
+       C330001_0.C330001_1.PrivateChild_Obj_03 := (5, "Aloha");
+    end Assign_Private_Obj_3;
+ 
+    ------------------------------------------------------------------
+    function Raised_CE_PublicChild_Obj return Boolean is
+    begin
+       PublicChild_Obj_03 := (16, 13);       -- C_E, can't change constraints 
+                                             -- of PublicChild_Obj_03.
+ 
+       Report.Failed ("Constraint_Error not raised - Public child");
+ 
+       -- Next line prevents dead assignment.
+ 
+       Report.Comment ("PublicChild_Obj_03'First is" & Integer'Image 
+                       (PublicChild_Obj_03'First) );
+       return False;
+ 
+    exception                             
+       when Constraint_Error => 
+          return True;                       -- Exception is expected.
+       when others           => 
+          return False;
+    end Raised_CE_PublicChild_Obj;
+ 
+    ------------------------------------------------------------------
+    function Raised_CE_PrivateChild_Obj return Boolean is
+    begin
+       C330001_0.C330001_1.PrivateChild_Obj_04 := (21, 87, 18);      
+                                             -- C_E, can't change constraints
+                                             -- of PrivateChild_Obj_04.
+ 
+       Report.Failed ("Constraint_Error not raised - Private child");
+ 
+       -- Next line prevents dead assignment.
+ 
+       Report.Comment ("PrivateChild_Obj_04'Last is" & Integer'Image 
+                       (C330001_0.C330001_1.PrivateChild_Obj_04'Last) );
+       return False;
+ 
+    exception                             
+       when Constraint_Error => 
+          return True;                       -- Exception is expected.
+       when others           => 
+          return False;
+    end Raised_CE_PrivateChild_Obj;
+ 
+    ------------------------------------------------------------------
+    function Verify_Public_Obj_1 return Boolean is
+    begin
+       return (PublicChild_Obj_01.D = 2 and PublicChild_Obj_01.S = "Hi");
+ 
+    end Verify_Public_Obj_1;
+ 
+    ------------------------------------------------------------------
+    function Verify_Public_Obj_2 return Boolean is
+    begin
+       return (PublicChild_Obj_02.D  = 5       and
+               PublicChild_Obj_02.C1 = "Hello" and 
+               PublicChild_Obj_02.S  = 4);
+ 
+    end Verify_Public_Obj_2;
+ 
+    ------------------------------------------------------------------
+    function Verify_Private_Obj_1 return Boolean is
+    begin
+       return (C330001_0.C330001_1.PrivateChild_Obj_01.D  = 4      and
+               C330001_0.C330001_1.PrivateChild_Obj_01.C1 = "ACVC" and
+               C330001_0.C330001_1.PrivateChild_Obj_01.S  = 15);
+ 
+    end Verify_Private_Obj_1;
+ 
+    ------------------------------------------------------------------
+    function Verify_Private_Obj_2 return Boolean is
+    begin
+       return (C330001_0.C330001_1.PrivateChild_Obj_02.D  = 5       and
+               C330001_0.C330001_1.PrivateChild_Obj_02.C1 = "Hello" and
+               C330001_0.C330001_1.PrivateChild_Obj_02.S  = 19);
+ 
+    end Verify_Private_Obj_2;
+ 
+    ------------------------------------------------------------------
+    function Verify_Private_Obj_3 return Boolean is
+    begin
+       return (C330001_0.C330001_1.PrivateChild_Obj_03.D = 5 and
+               C330001_0.C330001_1.PrivateChild_Obj_03.S = "Aloha");
+ 
+    end Verify_Private_Obj_3;
+ 
+ end C330001_0.C330001_2;
+ 
+      --==================================================================--
+ 
+ with C330001_0.C330001_2;
+ with Report;
+ 
+ use  C330001_0.C330001_2;
+ 
+ procedure C330001 is  
+ begin
+    Report.Test ("C330001", "Check that a variable object of an indefinite " &
+                 "type is properly initialized/constrained by an initial "   &
+                 "value assignment that is a) an aggregate, b) a function, " &
+                 "or c) an object.  Check that objects of the above types "  &
+                 "do not need explicit constraints if they have initial "    &
+                 "values");
+ 
+    -- Verify values of public child objects.
+ 
+    if not (Verify_Public_Obj_1 and Verify_Public_Obj_2) then 
+       Report.Failed ("Wrong values for PublicChild_Obj_01 or " &
+                      "PublicChild_Obj_02");
+    end if;
+    
+    if PublicChild_Obj_03'First /= 1 or
+       PublicChild_Obj_03'Last  /= 4 then
+       Report.Failed ("Wrong values for PublicChild_Obj_03");
+    end if;
+ 
+    if PublicChild_Obj_05.D  /= 7 or 
+       not PublicChild_Obj_05.C1  then
+       Report.Failed ("Wrong values for PublicChild_Obj_05");
+    end if;
+ 
+    if PublicChild_Obj_06.ND /= 6 or 
+       PublicChild_Obj_06.C2 /= 9 or
+       PublicChild_Obj_06.C1      then
+       Report.Failed ("Wrong values for PublicChild_Obj_06");
+    end if;
+ 
+    -- Definite object can have its discriminant changed by assignment to
+    -- the entire object.
+ 
+    Assign_Private_Obj_3;
+ 
+    -- Verify values of private child objects.
+ 
+    if not Verify_Private_Obj_1 or not 
+           Verify_Private_Obj_2 or not 
+           Verify_Private_Obj_3 then
+       Report.Failed ("Wrong values for PrivateChild_Obj_01 or " &
+                      "PrivateChild_Obj_02 or PrivateChild_Obj_03");
+    end if;
+ 
+    -- Attempt to change the discriminants of the objects of the indefinite
+    -- subtypes:  Constraint_Error.
+ 
+    if not Raised_CE_PublicChild_Obj or not Raised_CE_PrivateChild_Obj then
+       Report.Failed ("Constraint_Error not raised");
+    end if;
+ 
+    Report.Result;
+ 
+ end C330001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c330002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c330002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c330002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c330002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,326 ----
+ -- C330002.A 
+ -- 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- 
+ -- OBJECTIVE: 
+ --      Check that if a subtype indication of a variable object defines an  
+ --      indefinite subtype, then there is an initialization expression. 
+ --      Check that the object remains so constrained throughout its lifetime. 
+ --      Check for cases of tagged record, arrays and generic formal type. 
+ --                    
+ -- TEST DESCRIPTION: 
+ --      An indefinite subtype is either: 
+ --         a) An unconstrained array subtype. 
+ --         b) A subtype with unknown discriminants (this includes class-wide 
+ --            types). 
+ --         c) A subtype with unconstrained discriminants without defaults. 
+ -- 
+ --      Declare tagged types with unconstrained discriminants without 
+ --      defaults.  Declare an unconstrained array.  Declare a generic formal
+ --      type with an unknown discriminant and a formal object of this type.  
+ --      In the generic package, declare an object of the formal type using 
+ --      the formal object as its initial value.  In the main program, 
+ --      declare objects of tagged types.  Instantiate the generic package.  
+ --      The test checks that Constraint_Error is raised if an attempt is 
+ --      made to change bounds as well as discriminants of the objects of the 
+ --      indefinite subtypes.  
+ -- 
+ -- 
+ -- CHANGE HISTORY: 
+ --      01 Nov 95   SAIC    Initial prerelease version. 
+ --      27 Jul 96   SAIC    Modified test description & Report.Test.  Added
+ --                          code to prevent dead variable optimization.
+ -- 
+ --!
+ 
+ package C330002_0 is  
+ 
+    subtype Small_Num is Integer range 1 .. 20;
+ 
+    -- Types with unconstrained discriminants without defaults.      
+ 
+    type Tag_Type (Disc : Small_Num) is tagged         
+      record                                          
+        S : String (1 .. Disc);                       
+      end record;
+ 
+    function  Tag_Value return Tag_Type;
+ 
+    procedure Assign_Tag (A : out Tag_Type);
+ 
+    procedure Avoid_Optimization_and_Fail (P : Tag_Type; Msg : String);
+ 
+    ---------------------------------------------------------------------
+    -- An unconstrained array type.
+ 
+    type Array_Type is array (Positive range <>) of Integer;
+ 
+    function  Array_Value return Array_Type;
+ 
+    procedure Assign_Array (A : out Array_Type);
+ 
+    ---------------------------------------------------------------------
+    generic
+       -- Type with an unknown discriminant.
+       type Formal_Type (<>) is private;
+       FT_Obj  : Formal_Type;
+    package Gen is
+       Gen_Obj : Formal_Type := FT_Obj;
+    end Gen;
+ 
+ end C330002_0;
+ 
+      --==================================================================--
+ 
+ with Report;
+ package body C330002_0 is  
+ 
+    procedure Assign_Tag (A : out Tag_Type) is
+    begin
+       A := (3, "Bye");
+    end Assign_Tag;
+ 
+    ----------------------------------------------------------------------
+    procedure Avoid_Optimization_and_Fail (P : Tag_Type; Msg : String) is
+       Default : Tag_Type := (1, "!"); -- Unique value.
+    begin                       
+       if P = Default then       -- Both If branches can't do the same thing.
+          Report.Failed  (Msg & ": Constraint_Error not raised");
+       else                      -- Subtests should always select this path.
+          Report.Failed ("Constraint_Error not raised " & Msg);
+       end if;
+    end Avoid_Optimization_and_Fail;
+ 
+    ----------------------------------------------------------------------
+    function  Tag_Value return Tag_Type is
+       TO : Tag_Type := (4 , "ACVC");
+    begin
+       return TO;
+    end Tag_Value;
+ 
+    ----------------------------------------------------------------------
+    function  Array_Value return Array_Type is
+       IA : Array_Type := (20, 31);
+    begin
+       return IA;
+    end Array_Value;
+ 
+    ----------------------------------------------------------------------
+    procedure Assign_Array (A : out Array_Type) is
+    begin
+       A := (84, 36);
+    end Assign_Array;
+ 
+ end C330002_0;
+ 
+      --==================================================================--
+ 
+ with Report;
+ with C330002_0;
+ use  C330002_0;
+ 
+ procedure C330002 is  
+ 
+ begin
+    Report.Test ("C330002", "Check that if a subtype indication of a "      &
+                 "variable object defines an indefinite subtype, then "     & 
+                 "there is an initialization expression.  Check that "      &
+                 "the object remains so constrained throughout its "        &
+                 "lifetime.  Check that Constraint_Error is raised "        &
+                 "if an attempt is made to change bounds as well as "       &
+                 "discriminants of the objects of the indefinite "          &
+                 "subtypes.  Check for cases of tagged record and generic " &
+                 "formal types");
+ 
+    TagObj_Block:
+    declare
+       TObj_ByAgg  : Tag_Type := (5, "Hello");    -- Initial assignment is
+                                                  -- aggregate.   
+       TObj_ByObj  : Tag_Type := TObj_ByAgg;      -- Initial assignment is
+                                                  -- an object.   
+       TObj_ByFunc : Tag_Type := Tag_Value;       -- Initial assignment is
+                                                  -- function return value.
+       Ren_Obj     : Tag_Type renames TObj_ByAgg;        
+ 
+    begin
+ 
+       begin
+          if (TObj_ByAgg.Disc /= 5) or (TObj_ByAgg.S /= "Hello") then
+             Report.Failed ("Wrong initial values for TObj_ByAgg");
+          end if;
+            
+          TObj_ByAgg := (2, "Hi");                -- C_E, can't change the 
+                                                  -- value of the discriminant.
+ 
+          Avoid_Optimization_and_Fail (TObj_ByAgg, "Subtest 1");
+ 
+       exception
+          when Constraint_Error => null;          -- Exception is expected.
+          when others           => 
+             Report.Failed ("Unexpected exception - Subtest 1");
+       end;
+ 
+ 
+       begin
+          Assign_Tag (Ren_Obj);                   -- C_E, can't change the 
+                                                  -- value of the discriminant.
+ 
+          Avoid_Optimization_and_Fail (Ren_Obj, "Subtest 2");
+ 
+       exception
+          when Constraint_Error => null;          -- Exception is expected.
+          when others           => 
+             Report.Failed ("Unexpected exception - Subtest 2");
+       end;
+ 
+ 
+       begin
+          if (TObj_ByObj.Disc /= 5) or (TObj_ByObj.S /= "Hello") then
+             Report.Failed ("Wrong initial values for TObj_ByObj");
+          end if;
+ 
+          TObj_ByObj := (3, "Bye");               -- C_E, can't change the 
+                                                  -- value of the discriminant.
+ 
+          Avoid_Optimization_and_Fail (TObj_ByObj, "Subtest 3");
+ 
+       exception
+          when Constraint_Error => null;          -- Exception is expected.
+          when others           => 
+             Report.Failed ("Unexpected exception - Subtest 3");
+       end;
+ 
+ 
+       begin
+          if (TObj_ByFunc.Disc /= 4) or (TObj_ByFunc.S /= "ACVC") then
+             Report.Failed ("Wrong initial values for TObj_ByFunc");
+          end if;
+ 
+          TObj_ByFunc := (5, "Aloha");            -- C_E, can't change the 
+                                                  -- value of the discriminant.
+ 
+          Avoid_Optimization_and_Fail (TObj_ByFunc, "Subtest 4");
+ 
+       exception
+          when Constraint_Error => null;          -- Exception is expected.
+          when others           => 
+             Report.Failed ("Unexpected exception - Subtest 4");
+       end;
+ 
+    end TagObj_Block;
+ 
+ 
+    ArrObj_Block:
+    declare
+       Arr_Const   :  constant Array_Type               
+                   := (9, 7, 6, 8); 
+       Arr_ByAgg   :  Array_Type                  -- Initial assignment is
+                   := (10, 11, 12);               -- aggregate.            
+       Arr_ByFunc  :  Array_Type                  -- Initial assignment is
+                   := Array_Value;                -- function return value.
+       Arr_ByObj   :  Array_Type                  -- Initial assignment is
+                   := Arr_ByAgg;                  -- object.
+ 
+       Arr_Obj     :  array (Positive range <>) of Integer 
+                   := (1, 2, 3, 4, 5);
+     begin
+ 
+       begin
+          if (Arr_Const'First /= 1) or (Arr_Const'Last /= 4) then
+             Report.Failed ("Wrong bounds for Arr_Const");
+          end if;
+ 
+          if (Arr_ByAgg'First /= 1) or (Arr_ByAgg'Last /= 3) then
+             Report.Failed ("Wrong bounds for Arr_ByAgg");
+          end if;
+ 
+          if (Arr_ByFunc'First /= 1) or (Arr_ByFunc'Last /= 2) then
+             Report.Failed ("Wrong bounds for Arr_ByFunc");
+          end if;
+ 
+          if (Arr_ByObj'First /= 1) or (Arr_ByObj'Last /= 3) then
+             Report.Failed ("Wrong bounds for Arr_ByObj");
+          end if;
+ 
+          Assign_Array (Arr_ByObj);               -- C_E, Arr_ByObj bounds are
+                                                  -- 1..3.
+ 
+          Report.Failed ("Constraint_Error not raised - Subtest 5");
+ 
+       exception
+             when Constraint_Error => null;        -- Exception is expected.
+             when others           => 
+                Report.Failed ("Unexpected exception - Subtest 5");
+       end;
+ 
+ 
+       begin
+          if (Arr_Obj'First /= 1) or (Arr_Obj'Last /= 5) then
+             Report.Failed ("Wrong bounds for Arr_Obj");
+          end if;
+ 
+          for I in 0 .. 5 loop
+             Arr_Obj (I + 1) := I + 5;             -- C_E, Arr_Obj bounds are
+          end loop;                                -- 1..5.
+ 
+          Report.Failed ("Constraint_Error not raised - Subtest 6");
+ 
+       exception
+             when Constraint_Error => null;        -- Exception is expected.
+             when others           => 
+                Report.Failed ("Unexpected exception - Subtest 6");
+       end;
+ 
+    end ArrObj_Block;
+ 
+ 
+    GenericObj_Block:
+    declare
+       type Rec (Disc : Small_Num) is 
+         record     
+            S : Small_Num := Disc;
+         end record;
+ 
+       Rec_Obj : Rec := (2, 2);
+       package IGen is new Gen (Rec, Rec_Obj);
+ 
+    begin
+       IGen.Gen_Obj := (3, 3);                    -- C_E, can't change the 
+                                                  -- value of the discriminant.
+ 
+       Report.Failed ("Constraint_Error not raised - Subtest 7");
+ 
+       -- Next line prevents dead assignment.
+       Report.Comment ("Disc is" & Integer'Image (IGen.Gen_Obj.Disc));
+ 
+    exception
+       when Constraint_Error => null;             -- Exception is expected.
+       when others           => 
+          Report.Failed ("Unexpected exception - Subtest 7");
+ 
+    end GenericObj_Block;
+ 
+    Report.Result;
+ 
+ end C330002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c332001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c332001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c332001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c332001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,226 ----
+ -- C332001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the static expression given for a number declaration may be
+ --      of any numeric type.  Check that the type of a named number is
+ --      universal_integer or universal_real regardless of the type of the
+ --      static expression that provides its value.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines a large cross section of mixed type named numbers.
+ --      Well, obviously the named numbers don't have types (other than
+ --      universal_integer and universal_real) associated with them.
+ --      This test uses typed static values in the definition of several named
+ --      numbers, and then mixes the named numbers to ensure that their typed
+ --      origins do not interfere with the use of their values.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      10 OCT 95   SAIC   Initial version
+ --      11 APR 96   SAIC   Fixed a few arithmetic errors for 2.1
+ --      24 NOV 98   RLB    Removed decimal types to insure that this
+ --                         test is applicable to all implementations.
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C332001_0
+ 
+ package C332001_0 is
+ 
+   type Enumeration_Type is ( Ah, Gnome, Er, Ay, Shun );
+ 
+   type Integer_Type is range 0..1023;
+ 
+   type Modular_Type is mod 256;
+ 
+   type Floating_Type is digits 4;
+ 
+   type Fixed_Type is delta 0.125 range -10.0 .. 10.0;
+ 
+   type Mod_Array is array(Modular_Type) of Floating_Type;
+ 
+   type Int_Array is array(Integer_Type) of Fixed_Type;
+ 
+   type Record_Type is record
+     Pinkie : Integer_Type;
+     Ring   : Modular_Type;
+     Middle : Floating_Type;
+     Index  : Fixed_Type;
+   end record;
+ 
+   Mod_Array_Object : Mod_Array;
+   Int_Array_Object : Int_Array;
+ 
+   Record_Object : Record_Type;
+ 
+   -- numeric_literals 
+ 
+   Nothing_New_Integer : constant := 1;
+   Nothing_New_Real    : constant := 1.0;
+ 
+   -- static constants
+ 
+   Integ : constant Integer_Type  := 2;
+   Modul : constant Modular_Type  := 2;
+   Float : constant Floating_Type := 2.0;   -- bad practice, good test
+   Fixed : constant Fixed_Type    := 2.0;
+ 
+   Named_Integer : constant := Integ; -- 2
+   Named_Modular : constant := Modul; -- 2
+   Named_Float   : constant := Float; -- 2.0
+   Named_Fixed   : constant := Fixed; -- 2.0
+ 
+   -- function calls
+   -- parenthetical expressions
+ 
+   Fn_Integer : constant := Integer_Type'Min(Integ * 2, 8);    -- 4
+   Fn_Modular : constant := Modular_Type'Max(Modul + 2, Modular_Type'First);--4
+   Fn_Float   : constant := (Float ** 2);                      -- 4.0
+   Fn_Fixed   : constant := - Fixed;                           -- -2.0
+   -- attributes
+ 
+   ITF : constant := Integer_Type'First;         --   0
+   MTL : constant := Modular_Type'Last;          -- 255
+   MTM : constant := Modular_Type'Modulus;       -- 256
+   ENP : constant := Enumeration_Type'Pos(Ay);   --   3
+   MTP : constant := Modular_Type'Pred(Modul);   --   1
+   FTS : constant := Fixed_Type'Size;            --   # impdef
+   ITS : constant := Integer_Type'Succ(Integ);   --   3
+ 
+   -- array attributes 'First, 'Last, 'Length
+ 
+   MAFirst : constant := Mod_Array_Object'First;  --    0
+   IALast  : constant := Int_Array_Object'Last;   -- 1023
+   MAL     : constant := Mod_Array_Object'Length; --  255
+   IAL     : constant := Int_Array_Object'Length; -- 1024
+ 
+   -- type conversions
+   --
+   -- F\T Int Mod Flt Fix
+   -- Int  .   X   O   X 
+   -- Mod  O   .   X   O 
+   -- Flt  X   O   .   X 
+   -- Fix  O   X   O   . 
+ 
+   Int2Mod : constant := Modular_Type (Integ);  -- 2
+   Int2Fix : constant := Fixed_Type (Integ);    -- 2.0
+   Mod2Flt : constant := Floating_Type (Modul); -- 2.0
+   Flt2Int : constant := Integer_Type(Float);   -- 2
+   Flt2Fix : constant := Fixed_Type (Float);    -- 2.0
+   Fix2Mod : constant := Modular_Type (Fixed);  -- 2
+ 
+   procedure Check_Values;
+ 
+   -- TRANSITION CHECKS
+   --
+   -- The following were illegal in Ada83; they are now legal in Ada95
+   --
+ 
+   Int_Base_First : constant := Integer'Base'First;  -- # impdef
+   Int_First      : constant := Integer'First;       -- # impdef
+   Int_Last       : constant := Integer'Last;        -- # impdef
+   Int_Val        : constant := Integer'Val(17);     -- 17
+   
+   -- END OF TRANSITION CHECKS
+ 
+ end C332001_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C332001_0 is
+ 
+   procedure Assert( Truth : Boolean; Message: String ) is
+   begin
+     if not Truth then
+       Report.Failed("Assertion " & Message & " not true" );
+     end if;
+   end Assert;
+ 
+   procedure Check_Values is
+   begin
+ 
+     Assert( Nothing_New_Integer * Named_Integer = Named_Modular,
+            "Nothing_New_Integer * Named_Integer = Named_Modular" ); -- 1*2 = 2
+     Assert( Nothing_New_Real * Named_Float = Named_Fixed,
+            "Nothing_New_Real * Named_Float = Named_Fixed" );-- 1.0*2.0 = 2.0
+ 
+     Assert( Fn_Integer = Int2Mod + Flt2Int,
+            "Fn_Integer = Int2Mod + Flt2Int" );              -- 4 = 2+2
+     Assert( Fn_Modular = Flt2Int * 2,
+            "Fn_Modular = Flt2Int * 2" );                    -- 4 = 2*2
+     Assert( Fn_Float   = Mod2Flt ** Fix2Mod,
+            "Fn_Float   = Mod2Flt ** Fix2Mod" );             -- 4.0 = 2.0**2
+     Assert( Fn_Fixed   = (- Mod2Flt),
+            "Fn_Fixed   = (- Mod2Flt)" );                    -- -2.0 = (-2.0)
+ 
+     Assert( ITF = Modular_Type'First,
+            "ITF = Modular_Type'First" );                    -- 0 = 0
+     Assert( MTL < Integer_Type'Last,
+            "MTL < Integer_Type'Last" );                     -- 255 < 1023
+     Assert( MTM < Integer_Type'Last,
+            "MTM < Integer_Type'Last" );                     -- 256 < 1023
+     Assert( ENP > MTP,
+            "ENP > MTP" );                                   -- 3 > 1
+     Assert( (FTS < MTL) or (FTS >= MTL),  -- given FTS is impdef...
+            "(FTS < MTL) or (FTS >= MTL)" );                 -- True
+     Assert( FTS > ITS,
+            "FTS > ITS" );                                   -- impdef > 3
+ 
+     Assert( MAFirst = Int_Array_Object'First,
+            "MAFirst = Int_Array_Object'First" );            -- 0 = 0
+     Assert( IALast  > MAFirst,
+            "IALast  > MAFirst" );                           -- 1023 > 0
+     Assert( MAL     < IAL,
+            "MAL     < IAL" );                               -- 255 < 1024
+ 
+     Assert( Mod2Flt = Flt2Fix,
+            "Mod2Flt = Flt2Fix" );                           -- 2.0 = 2.0
+ 
+   end Check_Values;
+ 
+ end C332001_0;
+ 
+ ------------------------------------------------------------------- C332001
+ 
+ with Report;
+ with C332001_0;
+ procedure C332001 is
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C332001", "Check that the static expression given for a " &
+                           "number declaration may be of any numeric type. " &
+                           "Check that the type of the named number is " &
+                           "universal_integer of universal_real regardless " &
+                           "of the type of the static expression that " &
+                           "provides its value" );
+    
+   C332001_0.Check_Values;
+ 
+   Report.Result;
+ 
+ end C332001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c340001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c340001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c340001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c340001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,470 ----
+ -- C340001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that user-defined equality operators are inherited by a
+ --      derived type except when the derived type is a nonlimited record
+ --      extension. In the latter case, ensure that the primitive
+ --      equality operation of the record extension compares any extended
+ --      components according to the predefined equality operators of the
+ --      component types.  Also check that the parent portion of the extended
+ --      type is compared using the user-defined equality operation of the
+ --      parent type.
+ --
+ -- TEST DESCRIPTION:
+ --      Declares a nonlimited tagged record and a limited tagged record
+ --      type, each in a separate package. A user-defined "=" operation is
+ --      defined for each type. Each type is extended with one new record
+ --      component added.
+ --
+ --      Objects are declared for each parent and extended types and are
+ --      assigned values. For the limited type, modifier operations defined
+ --      in the package are used to assign values.
+ --
+ --      To verify the use of the user-defined "=", values are assigned so
+ --      that predefined equality will return the opposite result if called.
+ --      Similarly, values are assigned to the extended type objects so that
+ --      one comparison will verify that the inherited components from the
+ --      parent are compared using the user-defined equality operation.
+ --
+ --      A second comparison sets the values of the inherited components to
+ --      be the same so that equality based on the extended component may be
+ --      verified. For the nonlimited type, the test for equality should
+ --      fail, as the "=" defined for this type should include testing
+ --      equality of the extended component. For the limited type, "=" of the
+ --      parent should be inherited as-is, so the test for equality should
+ --      succeed even though the records differ in the extended component.
+ --
+ --      A third package declares a discriminated tagged record. Equality
+ --      is user-defined and ignores the discriminant value. A type
+ --      extension is declared which also contains a discriminant. Since
+ --      an inherited discriminant may not be referenced other than in a
+ --      "new" discriminant, the type extension is also discriminated. The
+ --      discriminant is used as the constraint for the parent type.
+ --
+ --      A variant part is declared in the type extension based on the new
+ --      discriminant. Comparisons are made to confirm that the user-defined
+ --      equality operator is used to compare values of the type extension.
+ --      Two record objects are given values so that user-defined equality
+ --      for the parent portion of the record succeeds, but the variant
+ --      parts in the type extended object differ. These objects are checked
+ --      to ensure that they are not equal.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --
+ --! 
+ 
+ with Ada.Calendar;
+ package C340001_0 is
+ 
+    type DB_Record is tagged record
+       Key : Natural range 1 .. 9999;
+       Data : String (1..10);
+    end record;
+ 
+    function "=" (L, R : in DB_Record) return Boolean;
+ 
+    type Dated_Record is new DB_Record with record
+       Retrieval_Time : Ada.Calendar.Time;
+    end record;
+ 
+ end C340001_0;
+ 
+ package body C340001_0 is
+ 
+    function "=" (L, R : in DB_Record) return Boolean is
+    -- Key is ignored in determining equality of records
+    begin
+       return L.Data = R.Data;
+    end "=";
+    
+ end C340001_0;
+ 
+ package C340001_1 is
+ 
+    type List_Contents is array (1..10) of Integer;
+    type List is tagged limited record
+       Length   : Natural range 0..10 := 0;
+       Contents : List_Contents := (others => 0);
+    end record;
+ 
+    procedure Add_To (L : in out List; New_Value : in Integer);
+    procedure Remove_From (L : in out List);
+ 
+    function "=" (L, R : in List) return Boolean;
+ 
+    subtype Revision_Mark is Character range 'A' .. 'Z';
+    type Revisable_List is new List with record
+       Revision : Revision_Mark := 'A';
+    end record;
+ 
+    procedure Revise (L : in out Revisable_List);
+ 
+ end C340001_1;
+ 
+ package body C340001_1 is
+ 
+    -- Note: This is not a complete abstraction of a list. Exceptions
+    -- are not defined and boundary checks are not made.
+ 
+    procedure Add_To (L : in out List; New_Value : in Integer) is
+    begin
+       L.Length := L.Length + 1;
+       L.Contents (L.Length) := New_Value;
+    end Add_To;
+ 
+    procedure Remove_From (L : in out List) is
+    -- The list length is decremented. "Old" values are left in the
+    -- array. They are overwritten when a new value is added.
+    begin
+       L.Length := L.Length - 1;
+    end Remove_From;
+ 
+    function "=" (L, R : in List) return Boolean is
+    -- Two lists are equal if they are the same length and
+    -- the component values within that length are the same.
+    -- Values stored past the end of the list are ignored.
+    begin
+       return L.Length = R.Length
+ 	 and then L.Contents (1..L.Length) = R.Contents (1..R.Length);
+    end "=";
+ 
+    procedure Revise (L : in out Revisable_List) is
+    begin
+       L.Revision := Character'Succ (L.Revision);
+    end Revise;
+    
+ end C340001_1;
+ 
+ package C340001_2 is
+ 
+    type Media is (Paper, Electronic);
+ 
+    type Transaction (Medium : Media) is tagged record
+       ID : Natural range 1000 .. 9999;
+    end record;
+ 
+    function "=" (L, R : in Transaction) return Boolean;
+ 
+    type Authorization (Kind : Media) is new Transaction (Medium => Kind)
+    with record
+       case Kind is
+       when Paper =>
+ 	 Signature_On_File : Boolean;
+       when Electronic =>
+         Paper_Backup   : Boolean; -- to retain opposing value
+       end case;
+    end record;
+ 
+ end C340001_2;
+ 
+ package body C340001_2 is
+ 
+    function "=" (L, R : in Transaction) return Boolean is
+    -- There may be electronic and paper copies of the same transaction.
+    -- The ID uniquely identifies a transaction. The medium (stored in
+    -- the discriminant) is ignored.
+    begin
+       return L.ID = R.ID;
+    end "=";
+ 
+ end C340001_2;
+ 
+ 
+ with C340001_0; -- nonlimited tagged record declarations
+ with C340001_1; -- limited tagged record declarations
+ with C340001_2; -- tagged variant declarations
+ with Ada.Calendar;
+ with Report;
+ procedure C340001 is
+ 
+    DB_Rec1 : C340001_0.DB_Record := (Key  => 1,
+ 				     Data => "aaaaaaaaaa");
+    DB_Rec2 : C340001_0.DB_Record := (Key  => 55,
+ 				     Data => "aaaaaaaaaa");
+    -- DB_Rec1  = DB_Rec2 using user-defined equality
+    -- DB_Rec1 /= DB_Rec2 using predefined equality
+ 
+    Some_Time : Ada.Calendar.Time :=
+       Ada.Calendar.Time_Of (Month => 9, Day => 16, Year => 1993);
+ 
+    Another_Time : Ada.Calendar.Time :=
+       Ada.Calendar.Time_Of (Month => 9, Day => 19, Year => 1993);
+ 
+    Dated_Rec1 : C340001_0.Dated_Record := (Key  => 2,
+ 					   Data => "aaaaaaaaaa",
+ 					   Retrieval_Time => Some_Time);
+    Dated_Rec2 : C340001_0.Dated_Record := (Key  => 77,
+ 					   Data => "aaaaaaaaaa",
+ 					   Retrieval_Time => Some_Time);
+    Dated_Rec3 : C340001_0.Dated_Record := (Key  => 77,
+ 					   Data => "aaaaaaaaaa",
+ 					   Retrieval_Time => Another_Time);
+    -- Dated_Rec1  = Dated_Rec2 if DB_Record."=" used for parent portion
+    -- Dated_Rec2 /= Dated_Rec3 if extended component is compared
+    --    using Ada.Calendar.Time."="
+ 
+    List1 : C340001_1.List;
+    List2 : C340001_1.List;
+ 
+    RList1 : C340001_1.Revisable_List;
+    RList2 : C340001_1.Revisable_List;
+    RList3 : C340001_1.Revisable_List;
+ 
+    Current : C340001_2.Transaction (C340001_2.Paper) :=
+       (C340001_2.Paper, 2001);
+    Last    : C340001_2.Transaction (C340001_2.Electronic) :=
+       (C340001_2.Electronic, 2001);
+    -- Current  = Last using user-defined equality
+    -- Current /= Last using predefined equality
+ 
+    Approval1 : C340001_2.Authorization (C340001_2.Paper)
+     := (Kind => C340001_2.Paper,
+         ID => 1040,
+         Signature_On_File => True);
+    Approval2 : C340001_2.Authorization (C340001_2.Paper)
+     := (Kind => C340001_2.Paper,
+         ID => 2167,
+         Signature_On_File => False);
+    Approval3 : C340001_2.Authorization (C340001_2.Electronic)
+     := (Kind => C340001_2.Electronic,
+         ID => 2167,
+         Paper_Backup => False);
+    -- Approval1 /= Approval2 if user-defined equality extended with
+    --    component equality.
+    -- Approval2 /= Approval3 if differing variant parts checked
+ 
+    -- Direct visibility to operator symbols
+    use type C340001_0.DB_Record;
+    use type C340001_0.Dated_Record;
+ 
+    use type C340001_1.List;
+    use type C340001_1.Revisable_List;
+ 
+    use type C340001_2.Transaction;
+    use type C340001_2.Authorization;
+ 
+ begin
+ 
+    Report.Test ("C340001", "Inheritance of user-defined ""=""");
+ 
+    -- Approval1 /= Approval2 if user-defined equality extended with
+    --    component equality.
+    -- Approval2 /= Approval3 if differing variant parts checked
+ 
+    ---------------------------------------------------------------------
+    -- Check that "=" and "/=" for the parent type call the user-defined
+    -- operation
+    ---------------------------------------------------------------------
+ 
+    if not (DB_Rec1 = DB_Rec2) then
+       Report.Failed ("Nonlimited tagged record: " &
+ 		     "User-defined equality did not override predefined " &
+ 		     "equality");
+    end if;
+ 
+    if DB_Rec1 /= DB_Rec2 then
+       Report.Failed ("Nonlimited tagged record: " &
+ 		     "User-defined equality did not override predefined " &
+ 		     "inequality as well");
+    end if;
+ 
+    ---------------------------------------------------------------------
+    -- Check that "=" and "/=" for the type extension use the user-defined 
+    -- equality operations from the parent to compare the inherited
+    -- components
+    ---------------------------------------------------------------------
+    
+    if not (Dated_Rec1 = Dated_Rec2) then
+       Report.Failed ("Nonlimited tagged record: " &
+ 		     "User-defined equality was not used to compare " &
+ 		     "components inherited from parent");
+    end if;
+ 
+    if Dated_Rec1 /= Dated_Rec2 then
+       Report.Failed ("Nonlimited tagged record: " &
+ 		     "User-defined inequality was not used to compare " &
+ 		     "components inherited from parent");
+    end if;
+ 
+    ---------------------------------------------------------------------
+    -- Check that equality and inequality for the type extension incorporate
+    -- the predefined equality operators for the extended component type
+    ---------------------------------------------------------------------
+    if Dated_Rec2 = Dated_Rec3 then
+       Report.Failed ("Nonlimited tagged record: " &
+ 		     "Record equality was not extended with component " &
+ 		     "equality");
+    end if;
+ 
+    if not (Dated_Rec2 /= Dated_Rec3) then
+       Report.Failed ("Nonlimited tagged record: " &
+ 		     "Record inequality was not extended with component " &
+ 		     "equality");
+    end if;
+ 
+    ---------------------------------------------------------------------
+    C340001_1.Add_To (List1, 1);
+    C340001_1.Add_To (List1, 2);
+    C340001_1.Add_To (List1, 3);
+    C340001_1.Remove_From (List1);
+ 
+    C340001_1.Add_To (List2, 1);
+    C340001_1.Add_To (List2, 2);
+    
+    -- List1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0))
+    -- List2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0))
+    
+    -- List1 = List2 using user-defined equality
+    -- List1 /= List2 using predefined equality
+ 
+    ---------------------------------------------------------------------
+    -- Check that "=" and "/=" for the parent type call the user-defined
+    -- operation
+    ---------------------------------------------------------------------
+    if not (List1 = List2) then
+       Report.Failed ("Limited tagged record   : " &
+ 		     "User-defined equality incorrectly implemented " );
+    end if;
+    
+    if List1 /= List2 then
+       Report.Failed ("Limited tagged record   : " &
+ 		     "User-defined equality incorrectly implemented " );
+    end if;
+ 
+    ---------------------------------------------------------------------
+    -- RList1 and RList2 are made equal but "different" by adding
+    -- a nonzero value to RList1 then removing it. Removal updates
+    -- the list Length only, not its contents. The two lists will be
+    -- equal according to the defined list abstraction, but the records
+    -- will contain differing component values.
+ 
+    C340001_1.Add_To (RList1, 1);
+    C340001_1.Add_To (RList1, 2);
+    C340001_1.Add_To (RList1, 3);
+    C340001_1.Remove_From (RList1);
+ 
+    C340001_1.Add_To (RList2, 1);
+    C340001_1.Add_To (RList2, 2);
+ 
+    C340001_1.Add_To (RList3, 1);
+    C340001_1.Add_To (RList3, 2);
+ 
+    C340001_1.Revise (RList3);
+ 
+    -- RList1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0), 'A')
+    -- RList2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'A')
+    -- RList3 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'B')
+    
+    -- RList1 = RList2 if List."=" inherited
+    -- RList2 /= RList3 if List."=" inherited and extended with Character "="
+ 
+    ---------------------------------------------------------------------
+    -- Check that "=" and "/=" are the user-defined operations inherited
+    -- from the parent type.
+    ---------------------------------------------------------------------
+    if not (RList1 = RList2) then
+       Report.Failed ("Limited tagged record   : " &
+ 		     "User-defined equality was not inherited");
+    end if;
+ 
+    if RList1 /= RList2 then
+       Report.Failed ("Limited tagged record   : " &
+ 		     "User-defined inequality was not inherited");
+    end if;
+    ---------------------------------------------------------------------
+    -- Check that "=" and "/=" for the type extension are NOT extended
+    -- with the predefined equality operators for the extended component.
+    -- A limited type extension should inherit the parent equality operation
+    -- as is.
+    ---------------------------------------------------------------------
+    if not (RList2 = RList3) then
+       Report.Failed ("Limited tagged record   : " &
+ 		     "Inherited equality operation was extended with " &
+ 		     "component equality");
+    end if;
+ 
+    if RList2 /= RList3 then
+       Report.Failed ("Limited tagged record   : " &
+ 		     "Inherited inequality operation was extended with " &
+ 		     "component equality");
+    end if;
+ 
+    ---------------------------------------------------------------------
+    -- Check that "=" and "/=" for the parent type call the user-defined
+    -- operation
+    ---------------------------------------------------------------------
+    if not (Current = Last) then
+       Report.Failed ("Variant record          : " &
+ 		     "User-defined equality did not override predefined " &
+ 		     "equality");
+    end if;
+    
+    if Current /= Last then
+       Report.Failed ("Variant record          : " &
+ 		     "User-defined inequality did not override predefined " &
+ 		     "inequality");
+    end if;
+ 
+    ---------------------------------------------------------------------
+    -- Check that user-defined equality was incorporated and extended
+    -- with equality of extended components.
+    ---------------------------------------------------------------------
+    if not (Approval1 /= Approval2) then
+       Report.Failed ("Variant record          : " &
+ 		     "Inequality was not extended with component " &
+ 		     "inequality");
+    end if;
+ 
+    if Approval1 = Approval2 then
+       Report.Failed ("Variant record          : " &
+ 		     "Equality was not extended with component " &
+ 		     "equality");
+    end if;
+    
+    ---------------------------------------------------------------------
+    -- Check that equality and inequality for the type extension
+    -- succeed despite the presence of differing variant parts.
+    ---------------------------------------------------------------------
+    if Approval2 = Approval3 then
+       Report.Failed ("Variant record          : " &
+ 		     "Equality succeeded even though variant parts " &
+ 		     "in type extension differ");
+    end if;
+ 
+    if not (Approval2 /= Approval3) then
+       Report.Failed ("Variant record          : " &
+ 		     "Inequality failed even though variant parts " &
+ 		     "in type extension differ");
+    end if;
+    
+    ---------------------------------------------------------------------
+    Report.Result;
+    ---------------------------------------------------------------------
+ 
+ end C340001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- C34001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ -- (IMPLICITLY) FOR DERIVED ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES.
+ 
+ -- JRK 8/20/86
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34001A IS
+ 
+      TYPE PARENT IS (E1, E2, E3, 'A', E4, E5, E6);
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE
+                PARENT'VAL (IDENT_INT (PARENT'POS (E2))) ..
+                PARENT'VAL (IDENT_INT (PARENT'POS (E5)));
+ 
+      TYPE T IS NEW SUBPARENT RANGE
+                PARENT'VAL (IDENT_INT (PARENT'POS (E3))) ..
+                PARENT'VAL (IDENT_INT (PARENT'POS (E4)));
+ 
+      X : T       := E3;
+      W : PARENT  := E1;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (T'POS (X), T'POS (X)) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN T'FIRST;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34001A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES");
+ 
+      X := IDENT (E4);
+      IF X /= E4 THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= E4 THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= E4 THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := E3;
+      END IF;
+      IF T (W) /= E3 THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF PARENT (X) /= E4 OR PARENT (T'VAL (0)) /= E1 THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF IDENT ('A') /= 'A' THEN
+           FAILED ("INCORRECT 'A'");
+      END IF;
+ 
+      IF IDENT (E3) /= E3 OR IDENT (E4) = E1 THEN
+           FAILED ("INCORRECT ENUMERATION LITERAL");
+      END IF;
+ 
+      IF X = IDENT ('A') OR X = E1 THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT (E4) OR NOT (X /= E1) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF X < IDENT (E4) OR X < E1 THEN
+           FAILED ("INCORRECT <");
+      END IF;
+ 
+      IF X > IDENT (E4) OR X > E6 THEN
+           FAILED ("INCORRECT >");
+      END IF;
+ 
+      IF X <= IDENT ('A') OR X <= E1 THEN
+           FAILED ("INCORRECT <=");
+      END IF;
+ 
+      IF IDENT ('A') >= X OR X >= E6 THEN
+           FAILED ("INCORRECT >=");
+      END IF;
+ 
+      IF NOT (X IN T) OR E1 IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (E1 NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'BASE'SIZE < 3 THEN
+           FAILED ("INCORRECT 'BASE'SIZE");
+      END IF;
+ 
+      IF T'FIRST /= E3 OR T'BASE'FIRST /= E1 THEN
+           FAILED ("INCORRECT 'FIRST");
+      END IF;
+ 
+      IF T'IMAGE (X) /= "E4" OR T'IMAGE (E1) /= "E1" THEN
+           FAILED ("INCORRECT 'IMAGE");
+      END IF;
+ 
+      IF T'LAST /= E4 OR T'BASE'LAST /= E6 THEN
+           FAILED ("INCORRECT 'LAST");
+      END IF;
+ 
+      IF T'POS (X) /= 4 OR T'POS (E1) /= 0 THEN
+           FAILED ("INCORRECT 'POS");
+      END IF;
+ 
+      IF T'PRED (X) /= 'A' OR T'PRED (E2) /= E1 THEN
+           FAILED ("INCORRECT 'PRED");
+      END IF;
+ 
+      IF T'SIZE < 2 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < 2 THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      IF T'SUCC (IDENT ('A')) /= X OR T'SUCC (E1) /= E2 THEN
+           FAILED ("INCORRECT 'SUCC");
+      END IF;
+ 
+      IF T'VAL (IDENT_INT (4)) /= X OR T'VAL (0) /= E1 THEN
+           FAILED ("INCORRECT 'VAL");
+      END IF;
+ 
+      IF T'VALUE (IDENT_STR ("E4")) /= X OR T'VALUE ("E1") /= E1 THEN
+           FAILED ("INCORRECT 'VALUE");
+      END IF;
+ 
+      IF T'WIDTH /= 3 OR T'BASE'WIDTH /= 3 THEN
+           FAILED ("INCORRECT 'WIDTH");
+      END IF;
+ 
+      RESULT;
+ END C34001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,150 ----
+ -- C34001C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 8/20/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34001C IS
+ 
+      TYPE PARENT IS (E1, E2, E3, 'A', E4, E5, E6);
+ 
+      TYPE T IS NEW PARENT RANGE
+                PARENT'VAL (IDENT_INT (PARENT'POS (E3))) ..
+                PARENT'VAL (IDENT_INT (PARENT'POS (E4)));
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE E3 .. E4;
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+ BEGIN
+      TEST ("C34001C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF T'BASE'FIRST /= E1 OR T'BASE'LAST /= E6 OR
+         S'BASE'FIRST /= E1 OR S'BASE'LAST /= E6 THEN
+           FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
+      END IF;
+ 
+      IF T'PRED (E2) /= E1 OR T'SUCC (E1) /= E2 OR
+         S'PRED (E2) /= E1 OR S'SUCC (E1) /= E2 THEN
+           FAILED ("INCORRECT 'PRED OR 'SUCC");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= E3 OR T'LAST /= E4 OR
+         S'FIRST /= E3 OR S'LAST /= E4 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := E3;
+           Y := E3;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+           END IF;
+           X := E4;
+           Y := E4;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := E2;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := E2");
+           IF X = E2 THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := E2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := E2");
+      END;
+ 
+      BEGIN
+           X := E5;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := E5");
+           IF X = E5 THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := E5");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := E5");
+      END;
+ 
+      BEGIN
+           Y := E2;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := E2");
+           IF Y = E2 THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := E2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := E2");
+      END;
+ 
+      BEGIN
+           Y := E5;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := E5");
+           IF Y = E5 THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := E5");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := E5");
+      END;
+ 
+      RESULT;
+ END C34001C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,209 ----
+ -- C34001D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ -- (IMPLICITLY) FOR DERIVED BOOLEAN TYPES.
+ 
+ -- JRK 8/20/86
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34001D IS
+ 
+      SUBTYPE PARENT IS BOOLEAN;
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE
+                PARENT'VAL (IDENT_INT (PARENT'POS (FALSE))) ..
+                PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
+ 
+      TYPE T IS NEW SUBPARENT RANGE
+                PARENT'VAL (IDENT_INT (PARENT'POS (TRUE))) ..
+                PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
+ 
+      X : T       := TRUE;
+      W : PARENT  := FALSE;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (T'POS (X), T'POS (X)) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN T'FIRST;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34001D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "BOOLEAN TYPES");
+ 
+      X := IDENT (TRUE);
+      IF X /= TRUE THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= TRUE THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= TRUE THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := TRUE;
+      END IF;
+      IF T (W) /= TRUE THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF PARENT (X) /= TRUE OR PARENT (T'VAL (0)) /= FALSE THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF IDENT (TRUE) /= TRUE OR IDENT (TRUE) = FALSE THEN
+           FAILED ("INCORRECT ENUMERATION LITERAL");
+      END IF;
+ 
+      IF NOT X /= FALSE OR NOT FALSE /= X THEN
+           FAILED ("INCORRECT ""NOT""");
+      END IF;
+ 
+      IF (X AND IDENT (TRUE)) /= TRUE OR (X AND FALSE) /= FALSE THEN
+           FAILED ("INCORRECT ""AND""");
+      END IF;
+ 
+      IF (X OR IDENT (TRUE)) /= TRUE OR (FALSE OR X) /= TRUE THEN
+           FAILED ("INCORRECT ""OR""");
+      END IF;
+ 
+      IF (X XOR IDENT (TRUE)) /= FALSE OR (X XOR FALSE) /= TRUE THEN
+           FAILED ("INCORRECT ""XOR""");
+      END IF;
+ 
+      IF (X AND THEN IDENT (TRUE)) /= TRUE OR
+         (X AND THEN FALSE) /= FALSE THEN
+           FAILED ("INCORRECT ""AND THEN""");
+      END IF;
+ 
+      IF (X OR ELSE IDENT (TRUE)) /= TRUE OR
+         (FALSE OR ELSE X) /= TRUE THEN
+           FAILED ("INCORRECT ""OR ELSE""");
+      END IF;
+ 
+      IF NOT (X = IDENT (TRUE)) OR X = FALSE THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT (TRUE) OR NOT (X /= FALSE) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF X < IDENT (TRUE) OR X < FALSE THEN
+           FAILED ("INCORRECT <");
+      END IF;
+ 
+      IF X > IDENT (TRUE) OR FALSE > X THEN
+           FAILED ("INCORRECT >");
+      END IF;
+ 
+      IF NOT (X <= IDENT (TRUE)) OR X <= FALSE THEN
+           FAILED ("INCORRECT <=");
+      END IF;
+ 
+      IF NOT (X >= IDENT (TRUE)) OR FALSE >= X THEN
+           FAILED ("INCORRECT >=");
+      END IF;
+ 
+      IF NOT (X IN T) OR FALSE IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (FALSE NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'BASE'SIZE < 1 THEN
+           FAILED ("INCORRECT 'BASE'SIZE");
+      END IF;
+ 
+      IF T'FIRST /= TRUE OR T'BASE'FIRST /= FALSE THEN
+           FAILED ("INCORRECT 'FIRST");
+      END IF;
+ 
+      IF T'IMAGE (X) /= "TRUE" OR T'IMAGE (FALSE) /= "FALSE" THEN
+           FAILED ("INCORRECT 'IMAGE");
+      END IF;
+ 
+      IF T'LAST /= TRUE OR T'BASE'LAST /= TRUE THEN
+           FAILED ("INCORRECT 'LAST");
+      END IF;
+ 
+      IF T'POS (X) /= 1 OR T'POS (FALSE) /= 0 THEN
+           FAILED ("INCORRECT 'POS");
+      END IF;
+ 
+      IF T'PRED (X) /= FALSE THEN
+           FAILED ("INCORRECT 'PRED");
+      END IF;
+ 
+      IF T'SIZE < 1 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < 1 THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      IF T'SUCC (T'VAL (IDENT_INT (0))) /= X THEN
+           FAILED ("INCORRECT 'SUCC");
+      END IF;
+ 
+      IF T'VAL (IDENT_INT (1)) /= X OR T'VAL (0) /= FALSE THEN
+           FAILED ("INCORRECT 'VAL");
+      END IF;
+ 
+      IF T'VALUE (IDENT_STR ("TRUE")) /= X OR
+         T'VALUE ("FALSE") /= FALSE THEN
+           FAILED ("INCORRECT 'VALUE");
+      END IF;
+ 
+      IF T'WIDTH /= 4 OR T'BASE'WIDTH /= 5 THEN
+           FAILED ("INCORRECT 'WIDTH");
+      END IF;
+ 
+      RESULT;
+ END C34001D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34001f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34001f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- C34001F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED BOOLEAN TYPES:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 8/20/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34001F IS
+ 
+      SUBTYPE PARENT IS BOOLEAN;
+ 
+      TYPE T IS NEW PARENT RANGE
+                PARENT'VAL (IDENT_INT (PARENT'POS (FALSE))) ..
+                PARENT'VAL (IDENT_INT (PARENT'POS (FALSE)));
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE TRUE .. TRUE;
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+ BEGIN
+      TEST ("C34001F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "BOOLEAN TYPES");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF T'BASE'FIRST /= FALSE OR T'BASE'LAST /= TRUE OR
+         S'BASE'FIRST /= FALSE OR S'BASE'LAST /= TRUE THEN
+           FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
+      END IF;
+ 
+      IF T'PRED (TRUE) /= FALSE OR T'SUCC (FALSE) /= TRUE OR
+         S'PRED (TRUE) /= FALSE OR S'SUCC (FALSE) /= TRUE THEN
+           FAILED ("INCORRECT 'PRED OR 'SUCC");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= FALSE OR T'LAST /= FALSE OR
+         S'FIRST /= TRUE  OR S'LAST /= TRUE  THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := FALSE;
+           Y := TRUE;
+           IF NOT PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := TRUE;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := TRUE");
+           IF X = TRUE THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := TRUE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := TRUE");
+      END;
+ 
+      BEGIN
+           Y := FALSE;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := FALSE");
+           IF Y = FALSE THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := FALSE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := FALSE");
+      END;
+ 
+      RESULT;
+ END C34001F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,265 ----
+ -- C34002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ -- (IMPLICITLY) FOR DERIVED INTEGER TYPES.
+ 
+ -- JRK 8/21/86
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34002A IS
+ 
+      TYPE PARENT IS RANGE -100 .. 100;
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE
+                PARENT'VAL (IDENT_INT (-50)) ..
+                PARENT'VAL (IDENT_INT ( 50));
+ 
+      TYPE T IS NEW SUBPARENT RANGE
+                PARENT'VAL (IDENT_INT (-30)) ..
+                PARENT'VAL (IDENT_INT ( 30));
+ 
+      TYPE FIXED IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
+ 
+      X : T        := -30;
+      W : PARENT   := -100;
+      N : CONSTANT := 1;
+      M : CONSTANT := 100;
+      B : BOOLEAN  := FALSE;
+      F : FLOAT    := 0.0;
+      G : FIXED    := 0.0;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (T'POS (X), T'POS (X)) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN T'FIRST;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34002A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "INTEGER TYPES");
+ 
+      X := IDENT (30);
+      IF X /= 30 THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= 30 THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= 30 THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := -30;
+      END IF;
+      IF T (W) /= -30 THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF PARENT (X) /= 30 OR PARENT (T'VAL (-100)) /= -100 THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF T (IDENT_INT (-30)) /= -30 THEN
+           FAILED ("INCORRECT CONVERSION FROM INTEGER");
+      END IF;
+ 
+      IF INTEGER (X) /= 30 OR INTEGER (T'VAL (-100)) /= -100 THEN
+           FAILED ("INCORRECT CONVERSION TO INTEGER");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           F := -30.0;
+      END IF;
+      IF T (F) /= -30 THEN
+           FAILED ("INCORRECT CONVERSION FROM FLOAT");
+      END IF;
+ 
+      IF FLOAT (X) /= 30.0 OR FLOAT (T'VAL (-100)) /= -100.0 THEN
+           FAILED ("INCORRECT CONVERSION TO FLOAT");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           G := -30.0;
+      END IF;
+      IF T (G) /= -30 THEN
+           FAILED ("INCORRECT CONVERSION FROM FIXED");
+      END IF;
+ 
+      IF FIXED (X) /= 30.0 OR FIXED (T'VAL (-100)) /= -100.0 THEN
+           FAILED ("INCORRECT CONVERSION TO FIXED");
+      END IF;
+ 
+      IF IDENT (N) /= 1 OR X = M THEN
+           FAILED ("INCORRECT IMPLICIT CONVERSION");
+      END IF;
+ 
+      IF IDENT (30) /= 30 OR X = 100 THEN
+           FAILED ("INCORRECT INTEGER LITERAL");
+      END IF;
+ 
+      IF X = IDENT (0) OR X = 100 THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT (30) OR NOT (X /= 100) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF X < IDENT (30) OR 100 < X THEN
+           FAILED ("INCORRECT <");
+      END IF;
+ 
+      IF X > IDENT (30) OR X > 100 THEN
+           FAILED ("INCORRECT >");
+      END IF;
+ 
+      IF X <= IDENT (0) OR 100 <= X THEN
+           FAILED ("INCORRECT <=");
+      END IF;
+ 
+      IF IDENT (0) >= X OR X >= 100 THEN
+           FAILED ("INCORRECT >=");
+      END IF;
+ 
+      IF NOT (X IN T) OR 100 IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (100 NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      IF +X /= 30 OR +T'VAL(-100) /= -100 THEN
+           FAILED ("INCORRECT UNARY +");
+      END IF;
+ 
+      IF -X /= 0 - 30 OR -T'VAL(-100) /= 100 THEN
+           FAILED ("INCORRECT UNARY -");
+      END IF;
+ 
+      IF ABS X /= 30 OR ABS T'VAL (-100) /= 100 THEN
+           FAILED ("INCORRECT ABS");
+      END IF;
+ 
+      IF X + IDENT (-1) /= 29 OR X + 70 /= 100 THEN
+           FAILED ("INCORRECT BINARY +");
+      END IF;
+ 
+      IF X - IDENT (30) /= 0 OR X - 100 /= -70 THEN
+           FAILED ("INCORRECT BINARY -");
+      END IF;
+ 
+      IF X * IDENT (-1) /= -30 OR IDENT (2) * 50 /= 100 THEN
+           FAILED ("INCORRECT *");
+      END IF;
+ 
+      IF X / IDENT (3) /= 10 OR 90 / X /= 3 THEN
+           FAILED ("INCORRECT /");
+      END IF;
+ 
+      IF X MOD IDENT (7) /= 2 OR 100 MOD X /= 10 THEN
+           FAILED ("INCORRECT MOD");
+      END IF;
+ 
+      IF X REM IDENT (7) /= 2 OR 100 REM X /= 10 THEN
+           FAILED ("INCORRECT REM");
+      END IF;
+ 
+      IF X ** IDENT_INT (1) /= 30 OR
+         T'VAL (100) ** IDENT_INT (1) /= 100 THEN
+           FAILED ("INCORRECT **");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'BASE'SIZE < 8 THEN
+           FAILED ("INCORRECT 'BASE'SIZE");
+      END IF;
+ 
+      IF T'FIRST /= -30 OR
+         T'POS (T'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) THEN
+           FAILED ("INCORRECT 'FIRST");
+      END IF;
+ 
+      IF T'IMAGE (X) /= " 30" OR T'IMAGE (-100) /= "-100" THEN
+           FAILED ("INCORRECT 'IMAGE");
+      END IF;
+ 
+      IF T'LAST /= 30 OR
+         T'POS (T'BASE'LAST) /= PARENT'POS (PARENT'BASE'LAST) THEN
+           FAILED ("INCORRECT 'LAST");
+      END IF;
+ 
+      IF T'POS (X) /= 30 OR T'POS (-100) /= -100 THEN
+           FAILED ("INCORRECT 'POS");
+      END IF;
+ 
+      IF T'PRED (X) /= 29 OR T'PRED (100) /= 99 THEN
+           FAILED ("INCORRECT 'PRED");
+      END IF;
+ 
+      IF T'SIZE < 6 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < 6 THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      IF T'SUCC (IDENT (29)) /= X OR T'SUCC (99) /= 100 THEN
+           FAILED ("INCORRECT 'SUCC");
+      END IF;
+ 
+      IF T'VAL (IDENT_INT (30)) /= X OR T'VAL (100) /= 100 THEN
+           FAILED ("INCORRECT 'VAL");
+      END IF;
+ 
+      IF T'VALUE (IDENT_STR ("30")) /= X OR T'VALUE ("100") /= 100 THEN
+           FAILED ("INCORRECT 'VALUE");
+      END IF;
+ 
+      IF T'WIDTH /= 3 OR T'BASE'WIDTH < 4 THEN
+           FAILED ("INCORRECT 'WIDTH");
+      END IF;
+ 
+      RESULT;
+ END C34002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34002c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34002c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34002c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C34002C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED INTEGER TYPES:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 8/21/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34002C IS
+ 
+      TYPE PARENT IS RANGE -100 .. 100;
+ 
+      TYPE T IS NEW PARENT RANGE
+                PARENT'VAL (IDENT_INT (-30)) ..
+                PARENT'VAL (IDENT_INT ( 30));
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE -30 .. 30;
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+ BEGIN
+      TEST ("C34002C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "INTEGER TYPES");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF T'POS (T'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) OR
+         S'POS (S'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) OR
+         T'POS (T'BASE'LAST)  /= PARENT'POS (PARENT'BASE'LAST)  OR
+         S'POS (S'BASE'LAST)  /= PARENT'POS (PARENT'BASE'LAST)  THEN
+           FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
+      END IF;
+ 
+      IF T'PRED (100) /= 99 OR T'SUCC (99) /= 100 OR
+         S'PRED (100) /= 99 OR S'SUCC (99) /= 100 THEN
+           FAILED ("INCORRECT 'PRED OR 'SUCC");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= -30 OR T'LAST /= 30 OR
+         S'FIRST /= -30 OR S'LAST /= 30 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := -30;
+           Y := -30;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+           END IF;
+           X := 30;
+           Y := 30;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := -31;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := -31");
+           IF X = -31 THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := -31");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := -31");
+      END;
+ 
+      BEGIN
+           X := 31;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := 31");
+           IF X = 31 THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := 31");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := 31");
+      END;
+ 
+      BEGIN
+           Y := -31;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := -31");
+           IF Y = -31 THEN -- USE Y.
+                COMMENT ("Y ALTERED -- Y := -31");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := -31");
+      END;
+ 
+      BEGIN
+           Y := 31;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := 31");
+           IF Y = 31 THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := 31");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := 31");
+      END;
+ 
+      RESULT;
+ END C34002C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,260 ----
+ -- C34003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ -- (IMPLICITLY) FOR DERIVED FLOATING POINT TYPES.
+ 
+ -- JRK 9/4/86
+ -- GJD 11/14/95  REMOVED USES OF OBSOLETE ADA 83 ATTRIBUTES.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34003A IS
+ 
+      TYPE PARENT IS DIGITS 5;
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE
+                PARENT (IDENT_INT (-50)) ..
+                PARENT (IDENT_INT ( 50));
+ 
+      TYPE T IS NEW SUBPARENT DIGITS 4 RANGE
+                PARENT (IDENT_INT (-30)) ..
+                PARENT (IDENT_INT ( 30));
+ 
+      TYPE FIXED IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
+ 
+      X : T        := -30.0;
+      W : PARENT   := -100.0;
+      R : CONSTANT := 1.0;
+      M : CONSTANT := 100.0;
+      B : BOOLEAN  := FALSE;
+      F : FLOAT    := 0.0;
+      G : FIXED    := 0.0;
+ 
+      Z : CONSTANT T := 0.0;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN T'FIRST;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34003A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "FLOATING POINT TYPES");
+ 
+      X := IDENT (30.0);
+      IF X /= 30.0 THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= 30.0 THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= 30.0 THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := -30.0;
+      END IF;
+      IF T (W) /= -30.0 THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF T (IDENT_INT (-30)) /= -30.0 THEN
+           FAILED ("INCORRECT CONVERSION FROM INTEGER");
+      END IF;
+ 
+      IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
+           FAILED ("INCORRECT CONVERSION TO INTEGER");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           F := -30.0;
+      END IF;
+      IF T (F) /= -30.0 THEN
+           FAILED ("INCORRECT CONVERSION FROM FLOAT");
+      END IF;
+ 
+      IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
+           FAILED ("INCORRECT CONVERSION TO FLOAT");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           G := -30.0;
+      END IF;
+      IF T (G) /= -30.0 THEN
+           FAILED ("INCORRECT CONVERSION FROM FIXED");
+      END IF;
+ 
+      IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
+           FAILED ("INCORRECT CONVERSION TO FIXED");
+      END IF;
+ 
+      IF IDENT (R) /= 1.0 OR X = M THEN
+           FAILED ("INCORRECT IMPLICIT CONVERSION");
+      END IF;
+ 
+      IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
+           FAILED ("INCORRECT REAL LITERAL");
+      END IF;
+ 
+      IF X = IDENT (0.0) OR X = 100.0 THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF X < IDENT (30.0) OR 100.0 < X THEN
+           FAILED ("INCORRECT <");
+      END IF;
+ 
+      IF X > IDENT (30.0) OR X > 100.0 THEN
+           FAILED ("INCORRECT >");
+      END IF;
+ 
+      IF X <= IDENT (0.0) OR 100.0 <= X THEN
+           FAILED ("INCORRECT <=");
+      END IF;
+ 
+      IF IDENT (0.0) >= X OR X >= 100.0 THEN
+           FAILED ("INCORRECT >=");
+      END IF;
+ 
+      IF NOT (X IN T) OR 100.0 IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
+           FAILED ("INCORRECT UNARY +");
+      END IF;
+ 
+      IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
+           FAILED ("INCORRECT UNARY -");
+      END IF;
+ 
+      IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
+           FAILED ("INCORRECT ABS");
+      END IF;
+ 
+      IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
+           FAILED ("INCORRECT BINARY +");
+      END IF;
+ 
+      IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
+           FAILED ("INCORRECT BINARY -");
+      END IF;
+ 
+      IF X * IDENT (-1.0) /= -30.0 OR IDENT (2.0) * 50.0 /= 100.0 THEN
+           FAILED ("INCORRECT *");
+      END IF;
+ 
+      IF X / IDENT (3.0) /= 10.0 OR 90.0 / X /= 3.0 THEN
+           FAILED ("INCORRECT /");
+      END IF;
+ 
+      IF X ** IDENT_INT (1) /= 30.0 OR
+         (Z + 100.0) ** IDENT_INT (1) /= 100.0 THEN
+           FAILED ("INCORRECT **");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'BASE'SIZE < 27 THEN
+           FAILED ("INCORRECT 'BASE'SIZE");
+      END IF;
+ 
+      IF T'DIGITS /= 4 OR T'BASE'DIGITS < 5 THEN
+           FAILED ("INCORRECT 'DIGITS");
+      END IF;
+ 
+      IF T'FIRST /= -30.0 THEN
+           FAILED ("INCORRECT 'FIRST");
+      END IF;
+ 
+      IF T'LAST /= 30.0 THEN
+           FAILED ("INCORRECT 'LAST");
+      END IF;
+ 
+      IF T'MACHINE_EMAX < 1 OR T'BASE'MACHINE_EMAX /= T'MACHINE_EMAX THEN
+           FAILED ("INCORRECT 'MACHINE_EMAX");
+      END IF;
+ 
+      IF T'MACHINE_EMIN > -1 OR T'BASE'MACHINE_EMIN /= T'MACHINE_EMIN THEN
+           FAILED ("INCORRECT 'MACHINE_EMIN");
+      END IF;
+ 
+      IF T'MACHINE_MANTISSA < 1 OR
+         T'BASE'MACHINE_MANTISSA /= T'MACHINE_MANTISSA THEN
+           FAILED ("INCORRECT 'MACHINE_MANTISSA");
+      END IF;
+ 
+      IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN
+           FAILED ("INCORRECT 'MACHINE_OVERFLOWS");
+      END IF;
+ 
+      IF T'MACHINE_RADIX < 2 OR
+         T'BASE'MACHINE_RADIX /= T'MACHINE_RADIX THEN
+           FAILED ("INCORRECT 'MACHINE_RADIX");
+      END IF;
+ 
+      IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN
+           FAILED ("INCORRECT 'MACHINE_ROUNDS");
+      END IF;
+ 
+      IF T'SIZE < 23 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < 23 THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34003c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34003c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34003c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34003c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- C34003C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED FLOATING POINT TYPES:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 9/4/86
+ -- GJD 11/15/95  REMOVED USES OF OBSOLETE ADA 83 ATTRIBUTE (SAFE_LARGE).
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34003C IS
+ 
+      TYPE PARENT IS DIGITS 5;
+ 
+      TYPE T IS NEW PARENT DIGITS 4 RANGE
+                PARENT (IDENT_INT (-30)) ..
+                PARENT (IDENT_INT ( 30));
+ 
+      SUBTYPE SUBPARENT IS PARENT DIGITS 4 RANGE -30.0 .. 30.0;
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+ BEGIN
+      TEST ("C34003C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "FLOATING POINT TYPES");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF T'BASE'DIGITS < 5 OR S'BASE'DIGITS < 5 THEN
+           FAILED ("INCORRECT 'BASE'DIGITS");
+      END IF;
+ 
+      IF  12344.0 + T'(1.0) + 1.0 /=  12346.0 OR
+          12344.0 + S'(1.0) + 1.0 /=  12346.0 OR
+         -12344.0 - T'(1.0) - 1.0 /= -12346.0 OR
+         -12344.0 - S'(1.0) - 1.0 /= -12346.0 THEN
+           FAILED ("INCORRECT + OR -");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'DIGITS /= 4 OR S'DIGITS /= 4 THEN
+           FAILED ("INCORRECT 'DIGITS");
+      END IF;
+ 
+      IF T'FIRST /= -30.0 OR T'LAST /= 30.0 OR
+         S'FIRST /= -30.0 OR S'LAST /= 30.0 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := -30.0;
+           Y := -30.0;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+           END IF;
+           X := 30.0;
+           Y := 30.0;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := -31.0;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := -31.0");
+           IF X = -31.0 THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := -31.0");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := -31.0");
+      END;
+ 
+      BEGIN
+           X := 31.0;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := 31.0");
+           IF X = 31.0 THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := 31.0");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := 31.0");
+      END;
+ 
+      BEGIN
+           Y := -31.0;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := -31.0");
+           IF Y = -31.0 THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := -31.0");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := -31.0");
+      END;
+ 
+      BEGIN
+           Y := 31.0;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := 31.0");
+           IF Y = 31.0 THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := 31.0");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := 31.0");
+      END;
+ 
+      RESULT;
+ END C34003C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- C34004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --      (IMPLICITLY) FOR DERIVED FIXED POINT TYPES.
+ 
+ -- HISTORY:
+ --      JRK 09/08/86  CREATED ORIGINAL TEST.
+ --      JET 08/06/87  FIXED BUGS IN DELTAS AND RANGE ERROR.
+ --      JET 09/22/88  CHANGED USAGE OF X'SIZE.
+ --      RDH 04/16/90  ADDED TEST FOR REAL VARIABLE VALUES.
+ --      THS 09/25/90  REMOVED ALL REFERENCES TO B, MODIFIED CHECK OF
+ --                    '=', INITIALIZED Z NON-STATICALLY, MOVED BINARY
+ --                    CHECKS.
+ --      DTN 11/30/95  REMOVED NON ADA95 ATTRIBUTES.               
+ --      KAS 03/04/96  REMOVED COMPARISON OF T'SMALL TO T'BASE'SMALL
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34004A IS
+ 
+      TYPE PARENT IS DELTA 2.0 ** (-7) RANGE -100.0 .. 100.0;
+ 
+      SUBTYPE SUBPARENT IS PARENT RANGE
+                IDENT_INT (1) * (-50.0) ..
+                IDENT_INT (1) * ( 50.0);
+ 
+      TYPE T IS NEW SUBPARENT DELTA 2.0 ** (-4) RANGE
+                IDENT_INT (1) * (-30.0) ..
+                IDENT_INT (1) * ( 30.0);
+ 
+      TYPE FIXED IS DELTA 2.0 ** (-4) RANGE -1000.0 .. 1000.0;
+ 
+      X : T        := -30.0;
+      I : INTEGER  := X'SIZE;  --CHECK FOR THE AVAILABILITY OF 'SIZE.
+      W : PARENT   := -100.0;
+      R : CONSTANT := 1.0;
+      M : CONSTANT := 100.0;
+      F : FLOAT    := 0.0;
+      G : FIXED    := 0.0;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN T'FIRST;
+      END IDENT;
+ 
+ BEGIN
+ 
+      DECLARE
+           Z : CONSTANT T := IDENT(0.0);
+      BEGIN
+           TEST ("C34004A", "CHECK THAT THE REQUIRED PREDEFINED " &
+                            "OPERATIONS ARE DECLARED (IMPLICITLY) " &
+                            "FOR DERIVED FIXED POINT TYPES");
+ 
+           X := IDENT (30.0);
+           IF X /= 30.0 THEN
+                FAILED ("INCORRECT :=");
+           END IF;
+ 
+           IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
+                FAILED ("INCORRECT BINARY +");
+           END IF;
+ 
+           IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
+                FAILED ("INCORRECT BINARY -");
+           END IF;
+ 
+           IF T'(X) /= 30.0 THEN
+                FAILED ("INCORRECT QUALIFICATION");
+           END IF;
+ 
+           IF T (X) /= 30.0 THEN
+                FAILED ("INCORRECT SELF CONVERSION");
+           END IF;
+ 
+           IF EQUAL (3, 3) THEN
+                W := -30.0;
+           END IF;
+           IF T (W) /= -30.0 THEN
+                FAILED ("INCORRECT CONVERSION FROM PARENT");
+           END IF;
+ 
+           IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+ 
+           IF T (IDENT_INT (-30)) /= -30.0 THEN
+                FAILED ("INCORRECT CONVERSION FROM INTEGER");
+           END IF;
+ 
+           IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
+                FAILED ("INCORRECT CONVERSION TO INTEGER");
+           END IF;
+ 
+           IF EQUAL (3, 3) THEN
+                F := -30.0;
+           END IF;
+           IF T (F) /= -30.0 THEN
+                FAILED ("INCORRECT CONVERSION FROM FLOAT");
+           END IF;
+ 
+           IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
+                FAILED ("INCORRECT CONVERSION TO FLOAT");
+           END IF;
+ 
+           IF EQUAL (3, 3) THEN
+                G := -30.0;
+           END IF;
+           IF T (G) /= -30.0 THEN
+                FAILED ("INCORRECT CONVERSION FROM FIXED");
+           END IF;
+ 
+           IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
+                FAILED ("INCORRECT CONVERSION TO FIXED");
+           END IF;
+ 
+           IF IDENT (R) /= 1.0 OR X = M THEN
+                FAILED ("INCORRECT IMPLICIT CONVERSION");
+           END IF;
+ 
+           IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
+                FAILED ("INCORRECT REAL LITERAL");
+           END IF;
+ 
+           IF NOT (X = IDENT (30.0)) THEN
+                FAILED ("INCORRECT =");
+           END IF;
+ 
+           IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
+                FAILED ("INCORRECT /=");
+           END IF;
+ 
+           IF X < IDENT (30.0) OR 100.0 < X THEN
+                FAILED ("INCORRECT <");
+           END IF;
+ 
+           IF X > IDENT (30.0) OR X > 100.0 THEN
+                FAILED ("INCORRECT >");
+           END IF;
+ 
+           IF X <= IDENT (0.0) OR 100.0 <= X THEN
+                FAILED ("INCORRECT <=");
+           END IF;
+ 
+           IF IDENT (0.0) >= X OR X >= 100.0 THEN
+                FAILED ("INCORRECT >=");
+           END IF;
+ 
+           IF NOT (X IN T) OR 100.0 IN T THEN
+                FAILED ("INCORRECT ""IN""");
+           END IF;
+ 
+           IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
+                FAILED ("INCORRECT ""NOT IN""");
+           END IF;
+ 
+           IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
+                FAILED ("INCORRECT UNARY +");
+           END IF;
+ 
+           IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
+                FAILED ("INCORRECT UNARY -");
+           END IF;
+ 
+           IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
+                FAILED ("INCORRECT ABS");
+           END IF;
+ 
+           IF T (X * IDENT (-1.0)) /= -30.0 OR
+              T (IDENT (2.0) * (Z + 15.0)) /= 30.0 THEN
+                FAILED ("INCORRECT * (FIXED, FIXED)");
+           END IF;
+ 
+           IF X * IDENT_INT (-1) /= -30.0 OR
+              (Z + 50.0) * 2 /= 100.0 THEN
+                FAILED ("INCORRECT * (FIXED, INTEGER)");
+           END IF;
+ 
+           IF IDENT_INT (-1) * X /= -30.0 OR
+              2 * (Z + 50.0) /= 100.0 THEN
+                FAILED ("INCORRECT * (INTEGER, FIXED)");
+           END IF;
+ 
+           IF T (X / IDENT (3.0)) /= 10.0 OR
+              T ((Z + 90.0) / X) /= 3.0 THEN
+                FAILED ("INCORRECT / (FIXED, FIXED)");
+           END IF;
+ 
+           IF X / IDENT_INT (3) /= 10.0 OR (Z + 90.0) / 30 /= 3.0 THEN
+                FAILED ("INCORRECT / (FIXED, INTEGER)");
+           END IF;
+ 
+           A (X'ADDRESS);
+ 
+           IF T'AFT /= 2 OR T'BASE'AFT < 3 THEN
+                FAILED ("INCORRECT 'AFT");
+           END IF;
+ 
+           IF T'BASE'SIZE < 15 THEN
+                FAILED ("INCORRECT 'BASE'SIZE");
+           END IF;
+ 
+           IF T'DELTA /= 2.0 ** (-4) OR T'BASE'DELTA > 2.0 ** (-7) THEN
+                FAILED ("INCORRECT 'DELTA");
+           END IF;
+ 
+ 
+           IF T'FORE /= 3 OR T'BASE'FORE < 4 THEN
+                FAILED ("INCORRECT 'FORE");
+           END IF;
+ 
+ 
+ 
+           IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN
+                FAILED ("INCORRECT 'MACHINE_OVERFLOWS");
+           END IF;
+ 
+           IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN
+                FAILED ("INCORRECT 'MACHINE_ROUNDS");
+           END IF;
+ 
+ 
+ 
+ 
+           IF T'SIZE < 10 THEN
+                FAILED ("INCORRECT TYPE'SIZE");
+           END IF;
+ 
+           IF T'SMALL > 2.0 ** (-4) OR T'BASE'SMALL > 2.0 ** (-7) THEN
+                FAILED ("INCORRECT 'SMALL");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C34004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34004c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34004c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34004c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C34004C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED FIXED POINT TYPES:
+ 
+ --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
+ --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --     CONSTRAINED.
+ 
+ --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --     IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 09/08/86
+ --     JLH 09/25/87  REFORMATTED HEADER.
+ --     JRL 03/13/92  MODIFIED TO DEFEAT OPTIMIZATION WHEN ATTEMPTING TO
+ --                   RAISE CONSTRAINT_ERROR.
+ --     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+ --     DTN 11/30/95  REMOVED NON ADA95 ATTRIBUTES.               
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34004C IS
+ 
+      TYPE PARENT IS DELTA 0.01 RANGE -100.0 .. 100.0;
+ 
+      TYPE T IS NEW PARENT DELTA 0.1 RANGE
+                IDENT_INT (1) * (-30.0) ..
+                IDENT_INT (1) * ( 30.0);
+ 
+      SUBTYPE SUBPARENT IS PARENT DELTA 0.1 RANGE -30.0 .. 30.0;
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X,XA : T;
+      Y,YA : S;
+ 
+ 
+      FUNCTION OUT_OF_BOUNDS ( VAR1 , VAR2 : T ) RETURN BOOLEAN IS
+      BEGIN
+         IF ( VAR1 + VAR2 ) IN T THEN
+            RETURN FALSE ;
+         ELSE
+            RETURN TRUE ;
+         END IF ;
+      EXCEPTION
+         WHEN CONSTRAINT_ERROR =>
+            RETURN TRUE ;
+      END OUT_OF_BOUNDS ;
+ 
+ 
+      FUNCTION OUT_OF_BOUNDS ( VAR1 , VAR2 : S ) RETURN BOOLEAN IS
+      BEGIN
+         IF ( VAR1 + VAR2 ) IN S THEN
+            RETURN FALSE ;
+         ELSE
+            RETURN TRUE ;
+         END IF ;
+      EXCEPTION
+         WHEN CONSTRAINT_ERROR =>
+            RETURN TRUE ;
+      END OUT_OF_BOUNDS ;
+ 
+ 
+ BEGIN
+      TEST ("C34004C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "FIXED POINT TYPES");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      DECLARE
+           TBD : CONSTANT := BOOLEAN'POS (T'BASE'DELTA <= 0.01);
+           SBD : CONSTANT := BOOLEAN'POS (S'BASE'DELTA <= 0.01);
+      BEGIN
+           IF TBD = 0 OR SBD = 0 THEN
+                FAILED ("INCORRECT 'BASE'DELTA");
+           END IF;
+      END;
+ 
+ 
+      DECLARE
+           N : INTEGER := IDENT_INT (8);
+      BEGIN
+           IF  98.0 + T'(1.0) + N * 0.0078125 /=  99.0625 OR
+               98.0 + S'(1.0) + 8 * 0.0078125 /=  99.0625 OR
+              -98.0 - T'(1.0) - N * 0.0078125 /= -99.0625 OR
+              -98.0 - S'(1.0) - 8 * 0.0078125 /= -99.0625 THEN
+                FAILED ("INCORRECT + OR -");
+           END IF;
+      END;
+ 
+ 
+      IF T'FIRST /= -30.0 OR T'LAST /= 30.0 OR
+         S'FIRST /= -30.0 OR S'LAST /= 30.0 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := -30.0;
+           Y := -30.0;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+           END IF;
+           X := 30.0;
+           Y := 30.0;
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+ 
+      BEGIN
+           X  := -30.0 ;
+           XA := -0.0625 ;
+           IF NOT OUT_OF_BOUNDS ( X , XA ) THEN
+              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- X := -30.0625" ) ;
+           END IF ;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := -30.0625");
+      END;
+ 
+ 
+      BEGIN
+           X  := 30.0 ;
+           XA := 0.0625 ;
+           IF NOT OUT_OF_BOUNDS ( X , XA ) THEN
+              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- X := 30.0625" ) ;
+           END IF ;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := 30.0625");
+      END;
+ 
+ 
+      BEGIN
+           Y  := -30.0 ;
+           YA := -0.0625 ;
+           IF NOT OUT_OF_BOUNDS ( Y , YA ) THEN
+              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- Y := -30.0625" ) ;
+           END IF ;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := -30.0625");
+      END;
+ 
+ 
+      BEGIN
+           Y  := 30.0 ;
+           YA := 0.0625 ;
+           IF NOT OUT_OF_BOUNDS ( Y , YA ) THEN
+              FAILED ( "CONSTRAINT_ERROR NOT RAISED -- Y := 30.0625" ) ;
+           END IF ;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := 30.0625");
+      END;
+ 
+      RESULT;
+ END C34004C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,410 ----
+ -- C34005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+ --     WHOSE COMPONENT TYPE IS A NON-LIMITED, NON-DISCRETE TYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/10/86  CREATED ORIGINAL TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005A IS
+ 
+      SUBTYPE COMPONENT IS FLOAT;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+      SUBTYPE ARR IS ARRT (2 .. 4);
+ 
+      X : T               := (OTHERS => 2.0);
+      W : PARENT (5 .. 7) := (OTHERS => 2.0);
+      C : COMPONENT       := 1.0;
+      B : BOOLEAN         := FALSE;
+      U : ARR             := (OTHERS => C);
+      N : CONSTANT        := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN (OTHERS => C);
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := B + 1.0;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN (OTHERS => -1.0);
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34005A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A NON-LIMITED, NON-DISCRETE TYPE");
+ 
+      X := IDENT ((1.0, 2.0, 3.0));
+      IF X /= (1.0, 2.0, 3.0) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= (1.0, 2.0, 3.0) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= (1.0, 2.0, 3.0) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := (1.0, 2.0, 3.0);
+      END IF;
+      IF T (W) /= (1.0, 2.0, 3.0) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      BEGIN
+           IF PARENT (X) /= (1.0, 2.0, 3.0) OR
+              PARENT (CREATE (2, 3, 4.0, X)) /= (4.0, 5.0) THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           U := (1.0, 2.0, 3.0);
+      END IF;
+      IF T (U) /= (1.0, 2.0, 3.0) THEN
+           FAILED ("INCORRECT CONVERSION FROM ARRAY");
+      END IF;
+ 
+      BEGIN
+           IF ARR (X) /= (1.0, 2.0, 3.0) OR
+              ARRT (CREATE (1, 2, 3.0, X)) /= (3.0, 4.0) THEN
+                FAILED ("INCORRECT CONVERSION TO ARRAY");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+      END;
+ 
+      IF IDENT ((1.0, 2.0, 3.0)) /= (1.0, 2.0, 3.0) OR
+         X = (1.0, 2.0) THEN
+           FAILED ("INCORRECT AGGREGATE");
+      END IF;
+ 
+      BEGIN
+           IF X (IDENT_INT (5)) /= 1.0 OR
+              CREATE (2, 3, 4.0, X) (3) /= 5.0 THEN
+                FAILED ("INCORRECT INDEX (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+      END;
+ 
+      X (IDENT_INT (7)) := 4.0;
+      IF X /= (1.0, 2.0, 4.0) THEN
+           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+      END IF;
+ 
+      BEGIN
+           X := IDENT ((1.0, 2.0, 3.0));
+           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2.0, 3.0) OR
+              CREATE (1, 4, 4.0, X) (1 .. 3) /= (4.0, 5.0, 6.0) THEN
+                FAILED ("INCORRECT SLICE (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+      END;
+ 
+      X (IDENT_INT (5) .. IDENT_INT (6)) := (4.0, 5.0);
+      IF X /= (4.0, 5.0, 3.0) THEN
+           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+      END IF;
+ 
+      X := IDENT ((1.0, 2.0, 3.0));
+      IF X = IDENT ((1.0, 2.0, 4.0)) OR X = (1.0, 2.0) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT ((1.0, 2.0, 3.0)) OR NOT (X /= (2.0, 3.0)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR (1.0, 2.0) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT ((1.0, 2.0) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      BEGIN
+           IF X & (4.0, 5.0, 6.0) /= (1.0, 2.0, 3.0, 4.0, 5.0, 6.0) OR
+              CREATE (2, 3, 2.0, X) & (4.0, 5.0) /=
+              (2.0, 3.0, 4.0, 5.0) THEN
+                FAILED ("INCORRECT & (ARRAY, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+      END;
+ 
+      BEGIN
+           IF X & 4.0 /= (1.0, 2.0, 3.0, 4.0) OR
+              CREATE (2, 3, 2.0, X) & 4.0 /= (2.0, 3.0, 4.0) THEN
+                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+      END;
+ 
+      BEGIN
+           IF 4.0 & X /= (4.0, 1.0, 2.0, 3.0) OR
+              2.0 & CREATE (2, 3, 3.0, X) /= (2.0, 3.0, 4.0) THEN
+                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           C := 2.0;
+      END IF;
+ 
+      BEGIN
+           IF C & 3.0 /= CREATE (2, 3, 2.0, X) THEN
+                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+      END;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'FIRST /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST");
+      END IF;
+ 
+      IF X'FIRST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF T'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST (N)");
+      END IF;
+ 
+      IF X'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF T'LAST /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST");
+      END IF;
+ 
+      IF X'LAST /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF T'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST (N)");
+      END IF;
+ 
+      IF X'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF T'LENGTH /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF T'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH (N)");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      IF T'SIZE < T'LENGTH * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < X'LENGTH * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C34005C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+ --     NON-LIMITED, NON-DISCRETE TYPE:
+ --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
+ --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --     CONSTRAINED.
+ --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --     IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/10/86  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005C IS
+ 
+      SUBTYPE COMPONENT IS FLOAT;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := (OTHERS => 2.0);
+      Y : S := (OTHERS => 2.0);
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := B + 1.0;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34005C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A NON-LIMITED, NON-DISCRETE TYPE");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      BEGIN
+           IF CREATE (2, 3, 4.0, X) /= (4.0, 5.0) OR
+              CREATE (2, 3, 4.0, Y) /= (4.0, 5.0) THEN
+                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                        "SUBTYPE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION");
+      END;
+ 
+      IF X & (3.0, 4.0) /= (2.0, 2.0, 2.0, 3.0, 4.0) OR
+         Y & (3.0, 4.0) /= (2.0, 2.0, 2.0, 3.0, 4.0) THEN
+           FAILED ("INCORRECT &");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= 5 OR T'LAST /= 7 OR
+         S'FIRST /= 5 OR S'LAST /= 7 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := (1.0, 2.0, 3.0);
+           Y := (1.0, 2.0, 3.0);
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := (1.0, 2.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (1.0, 2.0)");
+           IF X = (1.0, 2.0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (1.0, 2.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := (1.0, 2.0)");
+      END;
+ 
+      BEGIN
+           X := (1.0, 2.0, 3.0, 4.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (1.0, 2.0, 3.0, 4.0)");
+           IF X = (1.0, 2.0, 3.0, 4.0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (1.0, 2.0, 3.0, 4.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (1.0, 2.0, 3.0, 4.0)");
+      END;
+ 
+      BEGIN
+           Y := (1.0, 2.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (1.0, 2.0)");
+           IF Y = (1.0, 2.0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (1.0, 2.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := (1.0, 2.0)");
+      END;
+ 
+      BEGIN
+           Y := (1.0, 2.0, 3.0, 4.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (1.0, 2.0, 3.0, 4.0)");
+           IF Y = (1.0, 2.0, 3.0, 4.0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (1.0, 2.0, 3.0, 4.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (1.0, 2.0, 3.0, 4.0)");
+      END;
+ 
+      RESULT;
+ END C34005C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,425 ----
+ -- C34005D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+ --     WHOSE COMPONENT TYPE IS A DISCRETE TYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/12/86  CREATED ORIGINAL TEST.
+ --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005D IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+      SUBTYPE ARR IS ARRT (2 .. 4);
+ 
+      X : T               := (OTHERS => 2);
+      W : PARENT (5 .. 7) := (OTHERS => 2);
+      C : COMPONENT       := 1;
+      B : BOOLEAN         := FALSE;
+      U : ARR             := (OTHERS => C);
+      N : CONSTANT        := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN (OTHERS => C);
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := B + 1;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN (OTHERS => -1);
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34005D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A DISCRETE TYPE");
+ 
+      X := IDENT ((1, 2, 3));
+      IF X /= (1, 2, 3) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= (1, 2, 3) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= (1, 2, 3) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := (1, 2, 3);
+      END IF;
+      IF T (W) /= (1, 2, 3) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      BEGIN
+           IF PARENT (X) /= (1, 2, 3) OR
+              PARENT (CREATE (2, 3, 4, X)) /= (4, 5) THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           U := (1, 2, 3);
+      END IF;
+      IF T (U) /= (1, 2, 3) THEN
+           FAILED ("INCORRECT CONVERSION FROM ARRAY");
+      END IF;
+ 
+      BEGIN
+           IF ARR (X) /= (1, 2, 3) OR
+              ARRT (CREATE (1, 2, 3, X)) /= (3, 4) THEN
+                FAILED ("INCORRECT CONVERSION TO ARRAY");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+      END;
+ 
+      IF IDENT ((1, 2, 3)) /= (1, 2, 3) OR
+         X = (1, 2) THEN
+           FAILED ("INCORRECT AGGREGATE");
+      END IF;
+ 
+      BEGIN
+           IF X (IDENT_INT (5)) /= 1 OR
+              CREATE (2, 3, 4, X) (3) /= 5 THEN
+                FAILED ("INCORRECT INDEX (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+      END;
+ 
+      X (IDENT_INT (7)) := 4;
+      IF X /= (1, 2, 4) THEN
+           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+      END IF;
+ 
+      BEGIN
+           X := IDENT ((1, 2, 3));
+           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR
+              CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN
+                FAILED ("INCORRECT SLICE (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+      END;
+ 
+      X (IDENT_INT (5) .. IDENT_INT (6)) := (4, 5);
+      IF X /= (4, 5, 3) THEN
+           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+      END IF;
+ 
+      X := IDENT ((1, 2, 3));
+      IF X = IDENT ((1, 2, 4)) OR X = (1, 2) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT ((1, 2, 3)) OR NOT (X /= (2, 3)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF X < IDENT ((1, 2, 3)) OR X < (1, 2) THEN
+           FAILED ("INCORRECT <");
+      END IF;
+ 
+      IF X > IDENT ((1, 2, 3)) OR X > (1, 3) THEN
+           FAILED ("INCORRECT >");
+      END IF;
+ 
+      IF X <= IDENT ((1, 2, 2)) OR X <= (1, 2, 2, 4) THEN
+           FAILED ("INCORRECT <=");
+      END IF;
+ 
+      IF X >= IDENT ((1, 2, 4)) OR X >= (1, 2, 3, 1) THEN
+           FAILED ("INCORRECT >=");
+      END IF;
+ 
+      IF NOT (X IN T) OR (1, 2) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT ((1, 2) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      BEGIN
+           IF X & (4, 5, 6) /= (1, 2, 3, 4, 5, 6) OR
+              CREATE (2, 3, 2, X) & (4, 5) /= (2, 3, 4, 5) THEN
+                FAILED ("INCORRECT & (ARRAY, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+      END;
+ 
+      BEGIN
+           IF X & 4 /= (1, 2, 3, 4) OR
+              CREATE (2, 3, 2, X) & 4 /= (2, 3, 4) THEN
+                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+      END;
+ 
+      BEGIN
+           IF 4 & X /= (4, 1, 2, 3) OR
+              2 & CREATE (2, 3, 3, X) /= (2, 3, 4) THEN
+                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           C := 2;
+      END IF;
+ 
+      BEGIN
+           IF C & 3 /= CREATE (2, 3, 2, X) THEN
+                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+      END;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'FIRST /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST");
+      END IF;
+ 
+      IF X'FIRST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF T'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST (N)");
+      END IF;
+ 
+      IF X'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF T'LAST /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST");
+      END IF;
+ 
+      IF X'LAST /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF T'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST (N)");
+      END IF;
+ 
+      IF X'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF T'LENGTH /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF T'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH (N)");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      IF T'SIZE < T'LENGTH * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < X'LENGTH * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34005D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C34005F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+ --     DISCRETE TYPE:
+ --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
+ --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --     CONSTRAINED.
+ --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --     IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/12/86  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005F IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := (OTHERS => 2);
+      Y : S := (OTHERS => 2);
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := B + 1;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34005F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A DISCRETE TYPE");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      BEGIN
+           IF CREATE (2, 3, 4, X) /= (4, 5) OR
+              CREATE (2, 3, 4, Y) /= (4, 5) THEN
+                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                        "SUBTYPE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION");
+      END;
+ 
+      IF X & (3, 4) /= (2, 2, 2, 3, 4) OR
+         Y & (3, 4) /= (2, 2, 2, 3, 4) THEN
+           FAILED ("INCORRECT &");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= 5 OR T'LAST /= 7 OR
+         S'FIRST /= 5 OR S'LAST /= 7 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := (1, 2, 3);
+           Y := (1, 2, 3);
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := (1, 2);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (1, 2)");
+           IF X = (1, 2) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (1, 2)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := (1, 2)");
+      END;
+ 
+      BEGIN
+           X := (1, 2, 3, 4);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (1, 2, 3, 4)");
+           IF X = (1, 2, 3, 4) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (1, 2, 3, 4)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (1, 2, 3, 4)");
+      END;
+ 
+      BEGIN
+           Y := (1, 2);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (1, 2)");
+           IF Y = (1, 2) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (1, 2)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := (1, 2)");
+      END;
+ 
+      BEGIN
+           Y := (1, 2, 3, 4);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (1, 2, 3, 4)");
+           IF Y = (1, 2, 3, 4) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (1, 2, 3, 4)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (1, 2, 3, 4)");
+      END;
+ 
+      RESULT;
+ END C34005F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,423 ----
+ -- C34005G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --    (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+ --    WHOSE COMPONENT TYPE IS A CHARACTER TYPE.
+ 
+ -- HISTORY:
+ --    JRK 9/15/86  CREATED ORIGINAL TEST.
+ --    RJW 8/21/89  MODIFIED CHECKS FOR OBJECT AND TYPE SIZES.
+ --    PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005G IS
+ 
+      TYPE COMPONENT IS NEW CHARACTER;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+      SUBTYPE ARR IS ARRT (2 .. 4);
+ 
+      X : T               := (OTHERS => 'B');
+      W : PARENT (5 .. 7) := (OTHERS => 'B');
+      C : COMPONENT       := 'A';
+      B : BOOLEAN         := FALSE;
+      U : ARR             := (OTHERS => C);
+      N : CONSTANT        := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN (OTHERS => C);
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := COMPONENT'SUCC (B);
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN (OTHERS => '-');
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34005G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A CHARACTER TYPE");
+ 
+      X := IDENT ("ABC");
+      IF X /= "ABC" THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= "ABC" THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= "ABC" THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := "ABC";
+      END IF;
+      IF T (W) /= "ABC" THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      BEGIN
+           IF PARENT (X) /= "ABC" OR
+              PARENT (CREATE (2, 3, 'D', X)) /= "DE" THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           U := "ABC";
+      END IF;
+      IF T (U) /= "ABC" THEN
+           FAILED ("INCORRECT CONVERSION FROM ARRAY");
+      END IF;
+ 
+      BEGIN
+           IF ARR (X) /= "ABC" OR
+              ARRT (CREATE (1, 2, 'C', X)) /= "CD" THEN
+                FAILED ("INCORRECT CONVERSION TO ARRAY");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+      END;
+ 
+      IF IDENT ("ABC") /= ('A', 'B', 'C') OR
+         X = "AB" THEN
+           FAILED ("INCORRECT STRING LITERAL");
+      END IF;
+ 
+      IF IDENT (('A', 'B', 'C')) /= "ABC" OR
+         X = ('A', 'B') THEN
+           FAILED ("INCORRECT AGGREGATE");
+      END IF;
+ 
+      BEGIN
+           IF X (IDENT_INT (5)) /= 'A' OR
+              CREATE (2, 3, 'D', X) (3) /= 'E' THEN
+                FAILED ("INCORRECT INDEX (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+      END;
+ 
+      X (IDENT_INT (7)) := 'D';
+      IF X /= "ABD" THEN
+           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+      END IF;
+ 
+      BEGIN
+           X := IDENT ("ABC");
+           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= "BC" OR
+              CREATE (1, 4, 'D', X) (1 .. 3) /= "DEF" THEN
+                FAILED ("INCORRECT SLICE (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+      END;
+ 
+      X (IDENT_INT (5) .. IDENT_INT (6)) := "DE";
+      IF X /= "DEC" THEN
+           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+      END IF;
+ 
+      X := IDENT ("ABC");
+      IF X = IDENT ("ABD") OR X = "AB" THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT ("ABC") OR NOT (X /= "BC") THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF X < IDENT ("ABC") OR X < "AB" THEN
+           FAILED ("INCORRECT <");
+      END IF;
+ 
+      IF X > IDENT ("ABC") OR X > "AC" THEN
+           FAILED ("INCORRECT >");
+      END IF;
+ 
+      IF X <= IDENT ("ABB") OR X <= "ABBD" THEN
+           FAILED ("INCORRECT <=");
+      END IF;
+ 
+      IF X >= IDENT ("ABD") OR X >= "ABCA" THEN
+           FAILED ("INCORRECT >=");
+      END IF;
+ 
+      IF NOT (X IN T) OR "AB" IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT ("AB" NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      BEGIN
+           IF X & "DEF" /= "ABCDEF" OR
+              CREATE (2, 3, 'B', X) & "DE" /= "BCDE" THEN
+                FAILED ("INCORRECT & (ARRAY, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+      END;
+ 
+      BEGIN
+           IF X & 'D' /= "ABCD" OR
+              CREATE (2, 3, 'B', X) & 'D' /= "BCD" THEN
+                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+      END;
+ 
+      BEGIN
+           IF 'D' & X /= "DABC" OR
+              'B' & CREATE (2, 3, 'C', X) /= "BCD" THEN
+                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           C := 'B';
+      END IF;
+ 
+      BEGIN
+           IF C & 'C' /= CREATE (2, 3, 'B', X) THEN
+                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+      END;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'FIRST /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST");
+      END IF;
+ 
+      IF X'FIRST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF T'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST (N)");
+      END IF;
+ 
+      IF X'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF T'LAST /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST");
+      END IF;
+ 
+      IF X'LAST /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF T'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST (N)");
+      END IF;
+ 
+      IF X'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF T'LENGTH /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF T'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH (N)");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C34005G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C34005I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+ --     CHARACTER TYPE:
+ --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
+ --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --     CONSTRAINED.
+ --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --     IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/15/86  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005I IS
+ 
+      TYPE COMPONENT IS NEW CHARACTER;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := (OTHERS => 'B');
+      Y : S := (OTHERS => 'B');
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := COMPONENT'SUCC (B);
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34005I", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A CHARACTER TYPE");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      BEGIN
+           IF CREATE (2, 3, 'D', X) /= "DE" OR
+              CREATE (2, 3, 'D', Y) /= "DE" THEN
+                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                        "SUBTYPE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION");
+      END;
+ 
+      IF X & "CD" /= "BBBCD" OR
+         Y & "CD" /= "BBBCD" THEN
+           FAILED ("INCORRECT &");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= 5 OR T'LAST /= 7 OR
+         S'FIRST /= 5 OR S'LAST /= 7 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := "ABC";
+           Y := "ABC";
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := "AB";
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := ""AB""");
+           IF X = "AB" THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := ""AB""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := ""AB""");
+      END;
+ 
+      BEGIN
+           X := "ABCD";
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := ""ABCD""");
+           IF X = "ABCD" THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := ""ABCD""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := ""ABCD""");
+      END;
+ 
+      BEGIN
+           Y := "AB";
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := ""AB""");
+           IF Y = "AB" THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := ""AB""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := ""AB""");
+      END;
+ 
+      BEGIN
+           Y := "ABCD";
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := ""ABCD""");
+           IF Y = "ABCD" THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := ""ABCD""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := ""ABCD""");
+      END;
+ 
+      RESULT;
+ END C34005I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,482 ----
+ -- C34005J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+ --     WHOSE COMPONENT TYPE IS A BOOLEAN TYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/16/86  CREATED ORIGINAL TEST.
+ --     RJW 8/21/89  MODIFIED CHECKS FOR TYPE AND OBJECT SIZES.
+ --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005J IS
+ 
+      SUBTYPE COMPONENT IS BOOLEAN;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+      SUBTYPE ARR IS ARRT (2 .. 4);
+ 
+      X : T               := (OTHERS => TRUE);
+      W : PARENT (5 .. 7) := (OTHERS => TRUE);
+      C : COMPONENT       := FALSE;
+      B : BOOLEAN         := FALSE;
+      U : ARR             := (OTHERS => C);
+      N : CONSTANT        := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN (OTHERS => C);
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := NOT B;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN (OTHERS => FALSE);
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34005J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A BOOLEAN TYPE");
+ 
+      X := IDENT ((TRUE, FALSE, TRUE));
+      IF X /= (TRUE, FALSE, TRUE) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= (TRUE, FALSE, TRUE) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= (TRUE, FALSE, TRUE) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := (TRUE, FALSE, TRUE);
+      END IF;
+      IF T (W) /= (TRUE, FALSE, TRUE) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      BEGIN
+           IF PARENT (X) /= (TRUE, FALSE, TRUE) OR
+              PARENT (CREATE (2, 3, FALSE, X)) /= (FALSE, TRUE) THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           U := (TRUE, FALSE, TRUE);
+      END IF;
+      IF T (U) /= (TRUE, FALSE, TRUE) THEN
+           FAILED ("INCORRECT CONVERSION FROM ARRAY");
+      END IF;
+ 
+      BEGIN
+           IF ARR (X) /= (TRUE, FALSE, TRUE) OR
+              ARRT (CREATE (1, 2, TRUE, X)) /= (TRUE, FALSE) THEN
+                FAILED ("INCORRECT CONVERSION TO ARRAY");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+      END;
+ 
+      IF IDENT ((TRUE, FALSE, TRUE)) /= (TRUE, FALSE, TRUE) OR
+         X = (TRUE, FALSE) THEN
+           FAILED ("INCORRECT AGGREGATE");
+      END IF;
+ 
+      BEGIN
+           IF X (IDENT_INT (5)) /= TRUE OR
+              CREATE (2, 3, FALSE, X) (3) /= TRUE THEN
+                FAILED ("INCORRECT INDEX (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+      END;
+ 
+      X (IDENT_INT (7)) := FALSE;
+      IF X /= (TRUE, FALSE, FALSE) THEN
+           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+      END IF;
+ 
+      BEGIN
+           X := IDENT ((TRUE, FALSE, TRUE));
+           IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (FALSE, TRUE) OR
+              CREATE (1, 4, FALSE, X) (1 .. 3) /=
+              (FALSE, TRUE, FALSE) THEN
+                FAILED ("INCORRECT SLICE (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+      END;
+ 
+      X (IDENT_INT (5) .. IDENT_INT (6)) := (FALSE, TRUE);
+      IF X /= (FALSE, TRUE, TRUE) THEN
+           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+      END IF;
+ 
+      BEGIN
+           X := IDENT ((TRUE, FALSE, TRUE));
+           IF NOT X /= (FALSE, TRUE, FALSE) OR
+              NOT CREATE (2, 3, FALSE, X) /= (TRUE, FALSE) THEN
+                FAILED ("INCORRECT ""NOT""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+      END;
+ 
+      BEGIN
+           IF (X AND IDENT ((TRUE, TRUE, FALSE))) /=
+              (TRUE, FALSE, FALSE) OR
+              (CREATE (1, 4, FALSE, X) AND
+              (FALSE, FALSE, TRUE, TRUE)) /=
+              (FALSE, FALSE, FALSE, TRUE) THEN
+                FAILED ("INCORRECT ""AND""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+      END;
+ 
+      BEGIN
+           IF (X OR IDENT ((TRUE, FALSE, FALSE))) /=
+              (TRUE, FALSE, TRUE) OR
+              (CREATE (1, 4, FALSE, X) OR (FALSE, FALSE, TRUE, TRUE)) /=
+              (FALSE, TRUE, TRUE, TRUE) THEN
+                FAILED ("INCORRECT ""OR""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+      END;
+ 
+      BEGIN
+           IF (X XOR IDENT ((TRUE, TRUE, FALSE))) /=
+              (FALSE, TRUE, TRUE) OR
+              (CREATE (1, 4, FALSE, X) XOR
+              (FALSE, FALSE, TRUE, TRUE)) /=
+              (FALSE, TRUE, TRUE, FALSE) THEN
+                FAILED ("INCORRECT ""XOR""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+      END;
+ 
+      IF X = IDENT ((TRUE, FALSE, FALSE)) OR X = (TRUE, FALSE) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT ((TRUE, FALSE, TRUE)) OR
+         NOT (X /= (FALSE, TRUE)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF X < IDENT ((TRUE, FALSE, TRUE)) OR X < (TRUE, FALSE) THEN
+           FAILED ("INCORRECT <");
+      END IF;
+ 
+      IF X > IDENT ((TRUE, FALSE, TRUE)) OR X > (TRUE, TRUE) THEN
+           FAILED ("INCORRECT >");
+      END IF;
+ 
+      IF X <= IDENT ((TRUE, FALSE, FALSE)) OR
+         X <= (TRUE, FALSE, FALSE, TRUE) THEN
+           FAILED ("INCORRECT <=");
+      END IF;
+ 
+      IF X >= IDENT ((TRUE, TRUE, FALSE)) OR
+         X >= (TRUE, FALSE, TRUE, FALSE) THEN
+           FAILED ("INCORRECT >=");
+      END IF;
+ 
+      IF NOT (X IN T) OR (TRUE, FALSE) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT ((TRUE, FALSE) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      BEGIN
+           IF X & (FALSE, TRUE, FALSE) /=
+              (TRUE, FALSE, TRUE, FALSE, TRUE, FALSE) OR
+              CREATE (2, 3, FALSE, X) & (FALSE, TRUE) /=
+              (FALSE, TRUE, FALSE, TRUE) THEN
+                FAILED ("INCORRECT & (ARRAY, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 9");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 9");
+      END;
+ 
+      BEGIN
+           IF X & FALSE /= (TRUE, FALSE, TRUE, FALSE) OR
+              CREATE (2, 3, FALSE, X) & FALSE /=
+              (FALSE, TRUE, FALSE) THEN
+                FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 10");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 10");
+      END;
+ 
+      BEGIN
+           IF FALSE & X /= (FALSE, TRUE, FALSE, TRUE) OR
+              FALSE & CREATE (2, 3, TRUE, X) /=
+              (FALSE, TRUE, FALSE) THEN
+                FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 11");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 11");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           C := FALSE;
+      END IF;
+ 
+      BEGIN
+           IF C & TRUE /= CREATE (2, 3, FALSE, X) THEN
+                FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 12");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 12");
+      END;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'FIRST /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST");
+      END IF;
+ 
+      IF X'FIRST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF T'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST (N)");
+      END IF;
+ 
+      IF X'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF T'LAST /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST");
+      END IF;
+ 
+      IF X'LAST /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF T'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST (N)");
+      END IF;
+ 
+      IF X'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF T'LENGTH /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF T'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH (N)");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C34005J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C34005L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+ --     BOOLEAN TYPE:
+ --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
+ --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --     CONSTRAINED.
+ --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --     IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/16/86  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005L IS
+ 
+      SUBTYPE COMPONENT IS BOOLEAN;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := (OTHERS => TRUE);
+      Y : S := (OTHERS => TRUE);
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := NOT B;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34005L", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A BOOLEAN TYPE");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      BEGIN
+           IF CREATE (2, 3, FALSE, X) /= (FALSE, TRUE) OR
+              CREATE (2, 3, FALSE, Y) /= (FALSE, TRUE) THEN
+                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                        "SUBTYPE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION");
+      END;
+ 
+      IF X & (FALSE, TRUE) /= (TRUE, TRUE, TRUE, FALSE, TRUE) OR
+         Y & (FALSE, TRUE) /= (TRUE, TRUE, TRUE, FALSE, TRUE) THEN
+           FAILED ("INCORRECT &");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= 5 OR T'LAST /= 7 OR
+         S'FIRST /= 5 OR S'LAST /= 7 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := (TRUE, FALSE, TRUE);
+           Y := (TRUE, FALSE, TRUE);
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := (TRUE, FALSE);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (TRUE, FALSE)");
+           IF X = (TRUE, FALSE) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (TRUE, FALSE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- X := (TRUE, FALSE)");
+      END;
+ 
+      BEGIN
+           X := (TRUE, FALSE, TRUE, FALSE);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (TRUE, FALSE, TRUE, FALSE)");
+           IF X = (TRUE, FALSE, TRUE, FALSE) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (TRUE, FALSE, TRUE, FALSE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (TRUE, FALSE, TRUE, FALSE)");
+      END;
+ 
+      BEGIN
+           Y := (TRUE, FALSE);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (TRUE, FALSE)");
+           IF Y = (TRUE, FALSE) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (TRUE, FALSE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- Y := (TRUE, FALSE)");
+      END;
+ 
+      BEGIN
+           Y := (TRUE, FALSE, TRUE, FALSE);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (TRUE, FALSE, TRUE, FALSE)");
+           IF Y = (TRUE, FALSE, TRUE, FALSE) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (TRUE, FALSE, TRUE, FALSE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (TRUE, FALSE, TRUE, FALSE)");
+      END;
+ 
+      RESULT;
+ END C34005L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,353 ----
+ -- C34005M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
+ --     COMPONENT TYPE IS A NON-LIMITED TYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/17/86  CREATED ORIGINAL TEST.
+ --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005M IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 10;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                                COMPONENT;
+ 
+           FUNCTION CREATE ( F1, L1 : INDEX;
+                             F2, L2 : INDEX;
+                             C      : COMPONENT;
+                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                            IDENT_INT (6) .. IDENT_INT (8));
+ 
+      TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
+                         COMPONENT;
+ 
+      SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
+ 
+      X : T                       := (OTHERS => (OTHERS => 2));
+      W : PARENT (4 .. 5, 6 .. 8) := (OTHERS => (OTHERS => 2));
+      C : COMPONENT               := 1;
+      B : BOOLEAN                 := FALSE;
+      U : ARR                     := (OTHERS => (OTHERS => C));
+      N : CONSTANT                := 2;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN (OTHERS => (OTHERS => C));
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F1, L1 : INDEX;
+                F2, L2 : INDEX;
+                C      : COMPONENT;
+                DUMMY  : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F1 .. L1, F2 .. L2);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F1 .. L1 LOOP
+                     FOR J IN F2 .. L2 LOOP
+                          A (I, J) := B;
+                          B := B + 1;
+                     END LOOP;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN (OTHERS => (OTHERS => -1));
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34005M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A NON-LIMITED TYPE");
+ 
+      X := IDENT (((1, 2, 3), (4, 5, 6)));
+      IF X /= ((1, 2, 3), (4, 5, 6)) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= ((1, 2, 3), (4, 5, 6)) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= ((1, 2, 3), (4, 5, 6)) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := ((1, 2, 3), (4, 5, 6));
+      END IF;
+      IF T (W) /= ((1, 2, 3), (4, 5, 6)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      BEGIN
+           IF PARENT (X) /= ((1, 2, 3), (4, 5, 6)) OR
+              PARENT (CREATE (6, 9, 2, 3, 4, X)) /=
+              ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+      END;
+ 
+      IF EQUAL (3, 3) THEN
+           U := ((1, 2, 3), (4, 5, 6));
+      END IF;
+      IF T (U) /= ((1, 2, 3), (4, 5, 6)) THEN
+           FAILED ("INCORRECT CONVERSION FROM ARRAY");
+      END IF;
+ 
+      BEGIN
+           IF ARR (X) /= ((1, 2, 3), (4, 5, 6)) OR
+              ARRT (CREATE (7, 9, 2, 5, 3, X)) /=
+              ((3, 4, 5, 6), (7, 8, 9, 10), (11, 12, 13, 14)) THEN
+                FAILED ("INCORRECT CONVERSION TO ARRAY");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+      END;
+ 
+      IF IDENT (((1, 2, 3), (4, 5, 6))) /= ((1, 2, 3), (4, 5, 6)) OR
+         X = ((1, 2), (3, 4), (5, 6)) THEN
+           FAILED ("INCORRECT AGGREGATE");
+      END IF;
+ 
+      BEGIN
+           IF X (IDENT_INT (4), IDENT_INT (6)) /= 1 OR
+              CREATE (6, 9, 2, 3, 4, X) (9, 3) /= 11 THEN
+                FAILED ("INCORRECT INDEX (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+      END;
+ 
+      X (IDENT_INT (5), IDENT_INT (8)) := 7;
+      IF X /= ((1, 2, 3), (4, 5, 7)) THEN
+           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+      END IF;
+ 
+      X := IDENT (((1, 2, 3), (4, 5, 6)));
+      IF X = IDENT (((1, 2, 3), (4, 5, 7))) OR
+         X = ((1, 2), (4, 5)) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT (((1, 2, 3), (4, 5, 6))) OR
+         NOT (X /= ((1, 2, 3), (4, 5, 6), (7, 8, 9))) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR ((1, 2), (3, 4)) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR
+         NOT (((1, 2, 3), (4, 5, 6), (7, 8, 9)) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'FIRST /= 4 THEN
+           FAILED ("INCORRECT TYPE'FIRST");
+      END IF;
+ 
+      IF X'FIRST /= 4 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 4 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF T'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT TYPE'FIRST (N)");
+      END IF;
+ 
+      IF X'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF T'LAST /= 5 THEN
+           FAILED ("INCORRECT TYPE'LAST");
+      END IF;
+ 
+      IF X'LAST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 5 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF T'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT TYPE'LAST (N)");
+      END IF;
+ 
+      IF X'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF T'LENGTH /= 2 THEN
+           FAILED ("INCORRECT TYPE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH /= 2 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 2 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF T'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH (N)");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT TYPE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (1 .. 2, T'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT TYPE'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (1 .. 2, X'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (1 .. 2, V'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34005M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,277 ----
+ -- C34005O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE
+ --     IS A NON-LIMITED TYPE:
+ --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
+ --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --     CONSTRAINED.
+ --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --     IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/17/86  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005O IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 10;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                                COMPONENT;
+ 
+           FUNCTION CREATE ( F1, L1 : INDEX;
+                             F2, L2 : INDEX;
+                             C      : COMPONENT;
+                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                            IDENT_INT (6) .. IDENT_INT (8));
+ 
+      SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := (OTHERS => (OTHERS => 2));
+      Y : S := (OTHERS => (OTHERS => 2));
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F1, L1 : INDEX;
+                F2, L2 : INDEX;
+                C      : COMPONENT;
+                DUMMY  : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F1 .. L1, F2 .. L2);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F1 .. L1 LOOP
+                     FOR J IN F2 .. L2 LOOP
+                          A (I, J) := B;
+                          B := B + 1;
+                     END LOOP;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34005O", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A NON-LIMITED TYPE");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      BEGIN
+           IF CREATE (6, 9, 2, 3, 1, X) /=
+              ((1, 2), (3, 4), (5, 6), (7, 8)) OR
+              CREATE (6, 9, 2, 3, 1, Y) /=
+              ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
+                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                        "SUBTYPE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION");
+      END;
+ 
+      IF ((1, 2), (3, 4), (5, 6), (7, 8)) IN T OR
+         ((1, 2), (3, 4), (5, 6), (7, 8)) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= 4 OR T'LAST /= 5 OR
+         S'FIRST /= 4 OR S'LAST /= 5 OR
+         T'FIRST (2) /= 6 OR T'LAST (2) /= 8 OR
+         S'FIRST (2) /= 6 OR S'LAST (2) /= 8 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := ((1, 2, 3), (4, 5, 6));
+           Y := ((1, 2, 3), (4, 5, 6));
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := (4 => (6 .. 8 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (4 => (6 .. 8 => 0))");
+           IF X = (4 => (6 .. 8 => 0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := (4 => (6 .. 8 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (4 => (6 .. 8 => 0))");
+      END;
+ 
+      BEGIN
+           X := (4 .. 6 => (6 .. 8 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (4 .. 6 => (6 .. 8 => 0))");
+           IF X = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := (4 .. 6 => (6 .. 8 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (4 .. 6 => (6 .. 8 => 0))");
+      END;
+ 
+      BEGIN
+           X := (4 .. 5 => (6 .. 7 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (4 .. 5 => (6 .. 7 => 0))");
+           IF X = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := (4 .. 5 => (6 .. 7 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (4 .. 5 => (6 .. 7 => 0))");
+      END;
+ 
+      BEGIN
+           X := (4 .. 5 => (6 .. 9 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (4 .. 5 => (6 .. 9 => 0))");
+           IF X = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := (4 .. 5 => (6 .. 9 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (4 .. 5 => (6 .. 9 => 0))");
+      END;
+ 
+      BEGIN
+           Y := (4 => (6 .. 8 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (4 => (6 .. 8 => 0))");
+           IF Y = (4 => (6 .. 8 => 0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := (4 => (6 .. 8 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (4 => (6 .. 8 => 0))");
+      END;
+ 
+      BEGIN
+           Y := (4 .. 6 => (6 .. 8 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (4 .. 6 => (6 .. 8 => 0))");
+           IF Y = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := (4 .. 6 => (6 .. 8 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (4 .. 6 => (6 .. 8 => 0))");
+      END;
+ 
+      BEGIN
+           Y := (4 .. 5 => (6 .. 7 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (4 .. 5 => (6 .. 7 => 0))");
+           IF Y = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := (4 .. 5 => (6 .. 7 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (4 .. 5 => (6 .. 7 => 0))");
+      END;
+ 
+      BEGIN
+           Y := (4 .. 5 => (6 .. 9 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (4 .. 5 => (6 .. 9 => 0))");
+           IF Y = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := (4 .. 5 => (6 .. 9 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (4 .. 5 => (6 .. 9 => 0))");
+      END;
+ 
+      RESULT;
+ END C34005O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,405 ----
+ -- C34005P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE
+ --     COMPONENT TYPE IS A LIMITED TYPE.
+ 
+ -- HISTORY:
+ --     JRK 08/17/87  CREATED ORIGINAL TEST.
+ --     VCL 07/01/88  MODIFIED THE STATEMENTS INVOLVING THE 'SIZE
+ --                   ATTRIBUTE TO REMOVE ANY ASSUMPTIONS ABOUT THE
+ --                   SIZES.  ADDED EXCEPTION HANDLERS TO CATCH INCORRECT
+ --                   TYPE CONVERSIONS TO DERIVED SUBTYPES.
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ --     RLB 10/03/02  REMOVED ILLEGAL (BY AI-246) TYPE CONVERSIONS AND
+ --                   SUPPORTING CODE.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005P IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C1 : CONSTANT LP;
+           C2 : CONSTANT LP;
+           C3 : CONSTANT LP;
+           C4 : CONSTANT LP;
+           C5 : CONSTANT LP;
+           C6 : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C1 : CONSTANT LP := 1;
+           C2 : CONSTANT LP := 2;
+           C3 : CONSTANT LP := 3;
+           C4 : CONSTANT LP := 4;
+           C5 : CONSTANT LP := 5;
+           C6 : CONSTANT LP := 6;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT;
+ 
+           FUNCTION AGGR (X, Y, Z : COMPONENT) RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      X : T;
+      W : PARENT (5 .. 7);
+      C : COMPONENT;
+      B : BOOLEAN := FALSE;
+      N : CONSTANT := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+           RESULT : T;
+      BEGIN
+           FOR I IN RESULT'RANGE LOOP
+                ASSIGN (RESULT (I), C);
+           END LOOP;
+           RETURN RESULT;
+      END V;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER IS
+           BEGIN
+                RETURN INTEGER (X);
+           END VALUE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT;
+           BEGIN
+                ASSIGN (B, C);
+                FOR I IN F .. L LOOP
+                     ASSIGN (A (I), B);
+                     ASSIGN (B, CREATE (VALUE (B) + 1));
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                IF X'LENGTH /= Y'LENGTH THEN
+                     RETURN FALSE;
+                ELSE FOR I IN X'RANGE LOOP
+                          IF NOT EQUAL (X (I),
+                                        Y (I - X'FIRST + Y'FIRST)) THEN
+                               RETURN FALSE;
+                          END IF;
+                     END LOOP;
+                END IF;
+                RETURN TRUE;
+           END EQUAL;
+ 
+           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT IS
+                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 1);
+           BEGIN
+                ASSIGN (RESULT (INDEX'FIRST    ), X);
+                ASSIGN (RESULT (INDEX'FIRST + 1), Y);
+                RETURN RESULT;
+           END AGGR;
+ 
+           FUNCTION AGGR (X, Y, Z : COMPONENT) RETURN PARENT IS
+                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 2);
+           BEGIN
+                ASSIGN (RESULT (INDEX'FIRST    ), X);
+                ASSIGN (RESULT (INDEX'FIRST + 1), Y);
+                ASSIGN (RESULT (INDEX'FIRST + 2), Z);
+                RETURN RESULT;
+           END AGGR;
+ 
+      END PKG_P;
+ 
+ BEGIN
+      TEST ("C34005P", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A LIMITED TYPE");
+ 
+      ASSIGN (X (IDENT_INT (5)), CREATE (1));
+      ASSIGN (X (IDENT_INT (6)), CREATE (2));
+      ASSIGN (X (IDENT_INT (7)), CREATE (3));
+ 
+      ASSIGN (W (5), CREATE (1));
+      ASSIGN (W (6), CREATE (2));
+      ASSIGN (W (7), CREATE (3));
+ 
+      ASSIGN (C, CREATE (2));
+ 
+      IF NOT EQUAL (T'(X), AGGR (C1, C2, C3)) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF NOT EQUAL (T(X), AGGR (C1, C2, C3)) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF NOT EQUAL (T(W), AGGR (C1, C2, C3)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF NOT EQUAL (PARENT(X), AGGR (C1, C2, C3)) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+      END IF;
+ 
+      BEGIN
+           IF NOT EQUAL (PARENT(CREATE (2, 3, C4, X)),
+                         AGGR (C4, C5))                 THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
+                        "VALUES OUTSIDE OF THE SUBTYPE T - 1");
+      END;
+ 
+      IF NOT EQUAL (X(IDENT_INT (5)), C1) THEN
+           FAILED ("INCORRECT INDEX (VALUE)");
+      END IF;
+ 
+      BEGIN
+           IF NOT EQUAL (X(IDENT_INT (6)..IDENT_INT (7)),
+                         AGGR (C2, C3))     OR
+              NOT EQUAL (CREATE (1, 4, C4, X)(1..3),
+                         AGGR (C4, C5, C6))           THEN
+                FAILED ("INCORRECT SLICE (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED WHILE CHECKING SLICES");
+      END;
+ 
+      IF NOT (X IN T) OR AGGR (C1, C2) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (AGGR (C1, C2) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'FIRST /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST");
+      END IF;
+ 
+      IF X'FIRST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF T'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT TYPE'FIRST (N)");
+      END IF;
+ 
+      IF X'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF T'LAST /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST");
+      END IF;
+ 
+      IF X'LAST /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF T'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT TYPE'LAST (N)");
+      END IF;
+ 
+      IF X'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF T'LENGTH /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF T'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH (N)");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT TYPE'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      IF X'SIZE < T'SIZE THEN
+           COMMENT ("X'SIZE < T'SIZE");
+      ELSIF X'SIZE = T'SIZE THEN
+           COMMENT ("X'SIZE = T'SIZE");
+      ELSE
+           COMMENT ("X'SIZE > T'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34005P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005r.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005r.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005r.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,346 ----
+ -- C34005R.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+ --     LIMITED TYPE:
+ 
+ --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
+ --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
+ --        IS CONSTRAINED.
+ 
+ --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
+ --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 08/19/87  CREATED ORIGINAL TEST.
+ --     VCL 07/01/88  ADDED EXCEPTION HANDLERS TO CATCH INCORRECT TYPE
+ --                   CONVERSIONS TO DERIVED SUBTYPES.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005R IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C1 : CONSTANT LP;
+           C2 : CONSTANT LP;
+           C3 : CONSTANT LP;
+           C4 : CONSTANT LP;
+           C5 : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C1 : CONSTANT LP := 1;
+           C2 : CONSTANT LP := 2;
+           C3 : CONSTANT LP := 3;
+           C4 : CONSTANT LP := 4;
+           C5 : CONSTANT LP := 5;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 100;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+ 
+           FUNCTION CREATE ( F, L  : INDEX;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT;
+ 
+           FUNCTION AGGR (W, X, Y, Z : COMPONENT) RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER IS
+           BEGIN
+                RETURN INTEGER (X);
+           END VALUE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( F, L  : INDEX;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F .. L);
+                B : COMPONENT;
+           BEGIN
+                ASSIGN (B, C);
+                FOR I IN F .. L LOOP
+                     ASSIGN (A (I), B);
+                     ASSIGN (B, CREATE (VALUE (B) + 1));
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                IF X'LENGTH /= Y'LENGTH THEN
+                     RETURN FALSE;
+                ELSE FOR I IN X'RANGE LOOP
+                          IF NOT EQUAL (X (I),
+                                        Y (I - X'FIRST + Y'FIRST)) THEN
+                               RETURN FALSE;
+                          END IF;
+                     END LOOP;
+                END IF;
+                RETURN TRUE;
+           END EQUAL;
+ 
+           FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT IS
+                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 1);
+           BEGIN
+                ASSIGN (RESULT (INDEX'FIRST    ), X);
+                ASSIGN (RESULT (INDEX'FIRST + 1), Y);
+                RETURN RESULT;
+           END AGGR;
+ 
+           FUNCTION AGGR (W, X, Y, Z : COMPONENT) RETURN PARENT IS
+                RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 3);
+           BEGIN
+                ASSIGN (RESULT (INDEX'FIRST    ), W);
+                ASSIGN (RESULT (INDEX'FIRST + 1), X);
+                ASSIGN (RESULT (INDEX'FIRST + 2), Y);
+                ASSIGN (RESULT (INDEX'FIRST + 3), Z);
+                RETURN RESULT;
+           END AGGR;
+ 
+      END PKG_P;
+ 
+      PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
+      BEGIN
+           FOR I IN X'RANGE LOOP
+                ASSIGN (X (I), Y (I));
+           END LOOP;
+      END ASSIGN;
+ 
+      PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
+      BEGIN
+           FOR I IN X'RANGE LOOP
+                ASSIGN (X (I), Y (I));
+           END LOOP;
+      END ASSIGN;
+ 
+ BEGIN
+      TEST ("C34005R", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A LIMITED TYPE");
+ 
+      ASSIGN (X (IDENT_INT (5)), CREATE (2));
+      ASSIGN (X (IDENT_INT (6)), CREATE (3));
+      ASSIGN (X (IDENT_INT (7)), CREATE (4));
+ 
+      ASSIGN (Y (5), C2);
+      ASSIGN (Y (6), C3);
+      ASSIGN (Y (7), C4);
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      BEGIN
+           IF NOT EQUAL (CREATE (2, 3, C4, X), AGGR (C4, C5)) THEN
+                FAILED ("CANNOT CREATE BASE TYPE VALUES OUTSIDE " &
+                        "OF THE SUBTYPE T");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
+                        "VALUES OUTSIDE OF THE SUBTYPE T");
+      END;
+ 
+      BEGIN
+           IF NOT EQUAL (CREATE (2, 3, C4, Y), AGGR (C4, C5)) THEN
+                FAILED ("CANNOT CREATE BASE TYPE VALUES OUTSIDE " &
+                        "OF THE SUBTYPE S");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
+                        "VALUES OUTSIDE OF THE SUBTYPE S");
+      END;
+ 
+      BEGIN
+           IF NOT EQUAL (X(IDENT_INT (6)..IDENT_INT (7)),
+                         AGGR (C3, C4))                     THEN
+                FAILED ("INCORRECT SLICE OF X (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED WHILE CHECKING SLICE OF X");
+      END;
+ 
+      BEGIN
+           IF NOT EQUAL (AGGR (C3, C4),
+                         Y(IDENT_INT (6)..IDENT_INT (7)))  THEN
+                FAILED ("INCORRECT SLICE OF Y (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED WHILE CHECKING SLICE OF Y");
+      END;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= 5 OR T'LAST /= 7 OR
+         S'FIRST /= 5 OR S'LAST /= 7 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           ASSIGN (X, CREATE (5, 7, C1, X));
+           ASSIGN (Y, CREATE (5, 7, C1, Y));
+           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, AGGR (C1, C2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, AGGR (C1, C2))");
+           IF EQUAL (X, AGGR (C1, C2)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- ASSIGN (X, AGGR (C1, C2))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, AGGR (C1, C2))");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, AGGR (C1, C2, C3, C4));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, AGGR (C1, C2, C3, C4))");
+           IF EQUAL (X, AGGR (C1, C2, C3, C4)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, AGGR (C1, C2, C3, C4))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, AGGR (C1, C2, C3, C4))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, AGGR (C1, C2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, AGGR (C1, C2))");
+           IF EQUAL (Y, AGGR (C1, C2)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- ASSIGN (Y, AGGR (C1, C2))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, AGGR (C1, C2))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, AGGR (C1, C2, C3, C4));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
+           IF EQUAL (Y, AGGR (C1, C2, C3, C4)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
+      END;
+ 
+      RESULT;
+ END C34005R;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005s.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005s.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005s.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,404 ----
+ -- C34005S.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
+ --     COMPONENT TYPE IS A LIMITED TYPE.  THIS TEST IS PART 1 OF 2
+ --     TESTS WHICH COVER THE OBJECTIVE.  THE SECOND PART IS IN TEST
+ --     C34005V.
+ 
+ -- HISTORY:
+ --     JRK 08/20/87  CREATED ORIGINAL TEST.
+ --     BCB 04/12/90  SPLIT ORIGINAL TEST INTO C34005S.ADA AND
+ --                   C34005V.ADA
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005S IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C1  : CONSTANT LP;
+           C2  : CONSTANT LP;
+           C3  : CONSTANT LP;
+           C4  : CONSTANT LP;
+           C5  : CONSTANT LP;
+           C6  : CONSTANT LP;
+           C7  : CONSTANT LP;
+           C8  : CONSTANT LP;
+           C9  : CONSTANT LP;
+           C10 : CONSTANT LP;
+           C11 : CONSTANT LP;
+           C12 : CONSTANT LP;
+           C13 : CONSTANT LP;
+           C14 : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C1  : CONSTANT LP :=  1;
+           C2  : CONSTANT LP :=  2;
+           C3  : CONSTANT LP :=  3;
+           C4  : CONSTANT LP :=  4;
+           C5  : CONSTANT LP :=  5;
+           C6  : CONSTANT LP :=  6;
+           C7  : CONSTANT LP :=  7;
+           C8  : CONSTANT LP :=  8;
+           C9  : CONSTANT LP :=  9;
+           C10 : CONSTANT LP := 10;
+           C11 : CONSTANT LP := 11;
+           C12 : CONSTANT LP := 12;
+           C13 : CONSTANT LP := 13;
+           C14 : CONSTANT LP := 14;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 10;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                                COMPONENT;
+ 
+           FUNCTION CREATE ( F1, L1 : INDEX;
+                             F2, L2 : INDEX;
+                             C      : COMPONENT;
+                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                            IDENT_INT (6) .. IDENT_INT (8));
+ 
+      TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
+                         COMPONENT;
+ 
+      SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
+ 
+      X : T;
+      W : PARENT (4 .. 5, 6 .. 8);
+      C : COMPONENT;
+      B : BOOLEAN := FALSE;
+      U : ARR;
+      N : CONSTANT := 2;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+           RESULT : T;
+      BEGIN
+           FOR I IN RESULT'RANGE LOOP
+                FOR J IN RESULT'RANGE(2) LOOP
+                     ASSIGN (RESULT (I, J), C);
+                END LOOP;
+           END LOOP;
+           RETURN RESULT;
+      END V;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER IS
+           BEGIN
+                RETURN INTEGER (X);
+           END VALUE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( F1, L1 : INDEX;
+                F2, L2 : INDEX;
+                C      : COMPONENT;
+                DUMMY  : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F1 .. L1, F2 .. L2);
+                B : COMPONENT;
+           BEGIN
+                ASSIGN (B, C);
+                FOR I IN F1 .. L1 LOOP
+                     FOR J IN F2 .. L2 LOOP
+                          ASSIGN (A (I, J), B);
+                          ASSIGN (B, CREATE (VALUE (B) + 1));
+                     END LOOP;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                IF X'LENGTH /= Y'LENGTH OR
+                   X'LENGTH(2) /= Y'LENGTH(2) THEN
+                     RETURN FALSE;
+                ELSE FOR I IN X'RANGE LOOP
+                          FOR J IN X'RANGE(2) LOOP
+                               IF NOT EQUAL (X (I, J),
+                                             Y (I - X'FIRST + Y'FIRST,
+                                                J - X'FIRST(2) +
+                                                    Y'FIRST(2))) THEN
+                                    RETURN FALSE;
+                               END IF;
+                          END LOOP;
+                     END LOOP;
+                END IF;
+                RETURN TRUE;
+           END EQUAL;
+ 
+      END PKG_P;
+ 
+      FUNCTION EQUAL (X, Y : ARRT) RETURN BOOLEAN IS
+      BEGIN
+           IF X'LENGTH /= Y'LENGTH OR X'LENGTH(2) /= Y'LENGTH(2) THEN
+                RETURN FALSE;
+           ELSE FOR I IN X'RANGE LOOP
+                     FOR J IN X'RANGE(2) LOOP
+                          IF NOT EQUAL (X (I, J),
+                                        Y (I - X'FIRST + Y'FIRST,
+                                           J - X'FIRST(2) +
+                                               Y'FIRST(2))) THEN
+                               RETURN FALSE;
+                          END IF;
+                     END LOOP;
+                END LOOP;
+           END IF;
+           RETURN TRUE;
+      END EQUAL;
+ 
+ BEGIN
+      TEST ("C34005S", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A LIMITED TYPE.    THIS TEST IS PART " &
+                       "1 OF 2 TESTS WHICH COVER THE OBJECTIVE.  THE " &
+                       "SECOND PART IS IN TEST C34005V");
+ 
+      ASSIGN (X (IDENT_INT (4), IDENT_INT (6)), CREATE (1));
+      ASSIGN (X (IDENT_INT (4), IDENT_INT (7)), CREATE (2));
+      ASSIGN (X (IDENT_INT (4), IDENT_INT (8)), CREATE (3));
+      ASSIGN (X (IDENT_INT (5), IDENT_INT (6)), CREATE (4));
+      ASSIGN (X (IDENT_INT (5), IDENT_INT (7)), CREATE (5));
+      ASSIGN (X (IDENT_INT (5), IDENT_INT (8)), CREATE (6));
+ 
+      ASSIGN (W (4, 6), CREATE (1));
+      ASSIGN (W (4, 7), CREATE (2));
+      ASSIGN (W (4, 8), CREATE (3));
+      ASSIGN (W (5, 6), CREATE (4));
+      ASSIGN (W (5, 7), CREATE (5));
+      ASSIGN (W (5, 8), CREATE (6));
+ 
+      ASSIGN (C, CREATE (2));
+ 
+      ASSIGN (U (8, 2), CREATE (1));
+      ASSIGN (U (8, 3), CREATE (2));
+      ASSIGN (U (8, 4), CREATE (3));
+      ASSIGN (U (9, 2), CREATE (4));
+      ASSIGN (U (9, 3), CREATE (5));
+      ASSIGN (U (9, 4), CREATE (6));
+ 
+      IF NOT EQUAL (X (IDENT_INT (4), IDENT_INT (6)), C1) OR
+         NOT EQUAL (CREATE (6, 9, 2, 3, C4, X) (9, 3), C11) THEN
+           FAILED ("INCORRECT INDEX (VALUE)");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF T'FIRST /= 4 THEN
+           FAILED ("INCORRECT TYPE'FIRST");
+      END IF;
+ 
+      IF X'FIRST /= 4 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 4 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF T'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT TYPE'FIRST (N)");
+      END IF;
+ 
+      IF X'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF T'LAST /= 5 THEN
+           FAILED ("INCORRECT TYPE'LAST");
+      END IF;
+ 
+      IF X'LAST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 5 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF T'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT TYPE'LAST (N)");
+      END IF;
+ 
+      IF X'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF T'LENGTH /= 2 THEN
+           FAILED ("INCORRECT TYPE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH /= 2 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 2 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF T'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT TYPE'LENGTH (N)");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : PARENT (T'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT TYPE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (X'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (V'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (1 .. 2, T'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT TYPE'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (1 .. 2, X'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : PARENT (1 .. 2, V'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34005S;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005u.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005u.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005u.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,408 ----
+ -- C34005U.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS
+ --     A LIMITED TYPE:
+ 
+ --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
+ --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
+ --        IS CONSTRAINED.
+ 
+ --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
+ --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 08/21/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005U IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C1  : CONSTANT LP;
+           C2  : CONSTANT LP;
+           C3  : CONSTANT LP;
+           C4  : CONSTANT LP;
+           C5  : CONSTANT LP;
+           C6  : CONSTANT LP;
+           C7  : CONSTANT LP;
+           C8  : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C1  : CONSTANT LP :=  1;
+           C2  : CONSTANT LP :=  2;
+           C3  : CONSTANT LP :=  3;
+           C4  : CONSTANT LP :=  4;
+           C5  : CONSTANT LP :=  5;
+           C6  : CONSTANT LP :=  6;
+           C7  : CONSTANT LP :=  7;
+           C8  : CONSTANT LP :=  8;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 10;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                                COMPONENT;
+ 
+           FUNCTION CREATE ( F1, L1 : INDEX;
+                             F2, L2 : INDEX;
+                             C      : COMPONENT;
+                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                         RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                            IDENT_INT (6) .. IDENT_INT (8));
+ 
+      SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER IS
+           BEGIN
+                RETURN INTEGER (X);
+           END VALUE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( F1, L1 : INDEX;
+                F2, L2 : INDEX;
+                C      : COMPONENT;
+                DUMMY  : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F1 .. L1, F2 .. L2);
+                B : COMPONENT;
+           BEGIN
+                ASSIGN (B, C);
+                FOR I IN F1 .. L1 LOOP
+                     FOR J IN F2 .. L2 LOOP
+                          ASSIGN (A (I, J), B);
+                          ASSIGN (B, CREATE (VALUE (B) + 1));
+                     END LOOP;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                IF X'LENGTH /= Y'LENGTH OR
+                   X'LENGTH(2) /= Y'LENGTH(2) THEN
+                     RETURN FALSE;
+                ELSE FOR I IN X'RANGE LOOP
+                          FOR J IN X'RANGE(2) LOOP
+                               IF NOT EQUAL (X (I, J),
+                                             Y (I - X'FIRST + Y'FIRST,
+                                                J - X'FIRST(2) +
+                                                    Y'FIRST(2))) THEN
+                                    RETURN FALSE;
+                               END IF;
+                          END LOOP;
+                     END LOOP;
+                END IF;
+                RETURN TRUE;
+           END EQUAL;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                         RETURN PARENT IS
+                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 3,
+                            INDEX'FIRST .. INDEX'FIRST + 1);
+           BEGIN
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
+                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), E);
+                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), F);
+                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST    ), G);
+                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST + 1), H);
+                RETURN X;
+           END AGGR;
+ 
+      END PKG_P;
+ 
+      PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
+      BEGIN
+           FOR I IN X'RANGE LOOP
+                FOR J IN X'RANGE(2) LOOP
+                     ASSIGN (X (I, J), Y (I, J));
+                END LOOP;
+           END LOOP;
+      END ASSIGN;
+ 
+      PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
+      BEGIN
+           FOR I IN X'RANGE LOOP
+                FOR J IN X'RANGE(2) LOOP
+                     ASSIGN (X (I, J), Y (I, J));
+                END LOOP;
+           END LOOP;
+      END ASSIGN;
+ 
+ BEGIN
+      TEST ("C34005U", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A LIMITED TYPE");
+ 
+      FOR I IN X'RANGE LOOP
+           FOR J IN X'RANGE(2) LOOP
+                ASSIGN (X (I, J), C2);
+                ASSIGN (Y (I, J), C2);
+           END LOOP;
+      END LOOP;
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+      BEGIN
+           IF NOT EQUAL (CREATE (6, 9, 2, 3, C1, X),
+                         AGGR (C1, C2, C3, C4, C5, C6, C7, C8)) OR
+              NOT EQUAL (CREATE (6, 9, 2, 3, C1, Y),
+                         AGGR (C1, C2, C3, C4, C5, C6, C7, C8)) THEN
+                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                        "SUBTYPE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR WHEN TRYING TO CREATE BASE " &
+                        "TYPE VALUES OUTSIDE THE SUBTYPE");
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION WHEN TRYING TO CREATE BASE TYPE " &
+                        "VALUES OUTSIDE THE SUBTYPE");
+      END;
+ 
+      IF AGGR (C1, C2, C3, C4, C5, C6, C7, C8) IN T OR
+         AGGR (C1, C2, C3, C4, C5, C6, C7, C8) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF T'FIRST /= 4 OR T'LAST /= 5 OR
+         S'FIRST /= 4 OR S'LAST /= 5 OR
+         T'FIRST (2) /= 6 OR T'LAST (2) /= 8 OR
+         S'FIRST (2) /= 6 OR S'LAST (2) /= 8 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           ASSIGN (X, CREATE (4, 5, 6, 8, C1, X));
+           ASSIGN (Y, CREATE (4, 5, 6, 8, C1, Y));
+           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, CREATE (4, 4, 6, 8, C1, X));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
+           IF EQUAL (X, CREATE (4, 4, 6, 8, C1, X)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, CREATE (4, 6, 6, 8, C1, X));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
+           IF EQUAL (X, CREATE (4, 6, 6, 8, C1, X)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, CREATE (4, 5, 6, 7, C1, X));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
+           IF EQUAL (X, CREATE (4, 5, 6, 7, C1, X)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, CREATE (4, 5, 6, 9, C1, X));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
+           IF EQUAL (X, CREATE (4, 5, 6, 9, C1, X)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
+           IF EQUAL (Y, CREATE (4, 4, 6, 8, C1, Y)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
+           IF EQUAL (Y, CREATE (4, 6, 6, 8, C1, Y)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
+           IF EQUAL (Y, CREATE (4, 5, 6, 7, C1, Y)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
+           IF EQUAL (Y, CREATE (4, 5, 6, 9, C1, Y)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
+      END;
+ 
+      RESULT;
+ END C34005U;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005v.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34005v.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34005v.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,336 ----
+ -- C34005V.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
+ --     COMPONENT TYPE IS A LIMITED TYPE.  THIS TEST IS PART 2 OF 2
+ --     TESTS WHICH COVER THE OBJECTIVE.  THE FIRST PART IS IN TEST
+ --     C34005S.
+ 
+ -- HISTORY:
+ --     BCB 04/12/90  CREATED ORIGINAL TEST FROM SPLIT OF C34005S.ADA.
+ --     RLB 10/03/02  REMOVED ILLEGAL (BY AI-246) TYPE CONVERSIONS AND
+ --                   SUPPORTING CODE.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34005V IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C1  : CONSTANT LP;
+           C2  : CONSTANT LP;
+           C3  : CONSTANT LP;
+           C4  : CONSTANT LP;
+           C5  : CONSTANT LP;
+           C6  : CONSTANT LP;
+           C7  : CONSTANT LP;
+           C8  : CONSTANT LP;
+           C9  : CONSTANT LP;
+           C10 : CONSTANT LP;
+           C11 : CONSTANT LP;
+           C12 : CONSTANT LP;
+           C13 : CONSTANT LP;
+           C14 : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C1  : CONSTANT LP :=  1;
+           C2  : CONSTANT LP :=  2;
+           C3  : CONSTANT LP :=  3;
+           C4  : CONSTANT LP :=  4;
+           C5  : CONSTANT LP :=  5;
+           C6  : CONSTANT LP :=  6;
+           C7  : CONSTANT LP :=  7;
+           C8  : CONSTANT LP :=  8;
+           C9  : CONSTANT LP :=  9;
+           C10 : CONSTANT LP := 10;
+           C11 : CONSTANT LP := 11;
+           C12 : CONSTANT LP := 12;
+           C13 : CONSTANT LP := 13;
+           C14 : CONSTANT LP := 14;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           FIRST : CONSTANT := 0;
+           LAST  : CONSTANT := 10;
+ 
+           SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+ 
+           TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                                COMPONENT;
+ 
+           FUNCTION CREATE ( F1, L1 : INDEX;
+                             F2, L2 : INDEX;
+                             C      : COMPONENT;
+                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           FUNCTION AGGR (A, B, C, D : COMPONENT) RETURN PARENT;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F : COMPONENT) RETURN PARENT;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                         RETURN PARENT;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F, G, H, I : COMPONENT)
+                         RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                            IDENT_INT (6) .. IDENT_INT (8));
+ 
+      X : T;
+      W : PARENT (4 .. 5, 6 .. 8);
+      C : COMPONENT;
+      B : BOOLEAN := FALSE;
+      N : CONSTANT := 2;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+           RESULT : T;
+      BEGIN
+           FOR I IN RESULT'RANGE LOOP
+                FOR J IN RESULT'RANGE(2) LOOP
+                     ASSIGN (RESULT (I, J), C);
+                END LOOP;
+           END LOOP;
+           RETURN RESULT;
+      END V;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION VALUE (X : LP) RETURN INTEGER IS
+           BEGIN
+                RETURN INTEGER (X);
+           END VALUE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( F1, L1 : INDEX;
+                F2, L2 : INDEX;
+                C      : COMPONENT;
+                DUMMY  : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (F1 .. L1, F2 .. L2);
+                B : COMPONENT;
+           BEGIN
+                ASSIGN (B, C);
+                FOR I IN F1 .. L1 LOOP
+                     FOR J IN F2 .. L2 LOOP
+                          ASSIGN (A (I, J), B);
+                          ASSIGN (B, CREATE (VALUE (B) + 1));
+                     END LOOP;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                IF X'LENGTH /= Y'LENGTH OR
+                   X'LENGTH(2) /= Y'LENGTH(2) THEN
+                     RETURN FALSE;
+                ELSE FOR I IN X'RANGE LOOP
+                          FOR J IN X'RANGE(2) LOOP
+                               IF NOT EQUAL (X (I, J),
+                                             Y (I - X'FIRST + Y'FIRST,
+                                                J - X'FIRST(2) +
+                                                    Y'FIRST(2))) THEN
+                                    RETURN FALSE;
+                               END IF;
+                          END LOOP;
+                     END LOOP;
+                END IF;
+                RETURN TRUE;
+           END EQUAL;
+ 
+           FUNCTION AGGR (A, B, C, D : COMPONENT) RETURN PARENT IS
+                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 1,
+                            INDEX'FIRST .. INDEX'FIRST + 1);
+           BEGIN
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
+                RETURN X;
+           END AGGR;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F : COMPONENT) RETURN PARENT IS
+                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 1,
+                            INDEX'FIRST .. INDEX'FIRST + 2);
+           BEGIN
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 2), C);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), D);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), E);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 2), F);
+                RETURN X;
+           END AGGR;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                         RETURN PARENT IS
+                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 3,
+                            INDEX'FIRST .. INDEX'FIRST + 1);
+           BEGIN
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
+                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), E);
+                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), F);
+                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST    ), G);
+                ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST + 1), H);
+                RETURN X;
+           END AGGR;
+ 
+           FUNCTION AGGR (A, B, C, D, E, F, G, H, I : COMPONENT)
+                         RETURN PARENT IS
+                X : PARENT (INDEX'FIRST .. INDEX'FIRST + 2,
+                            INDEX'FIRST .. INDEX'FIRST + 2);
+           BEGIN
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+                ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 2), C);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), D);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), E);
+                ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 2), F);
+                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), G);
+                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), H);
+                ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 2), I);
+                RETURN X;
+           END AGGR;
+ 
+      END PKG_P;
+ 
+ BEGIN
+      TEST ("C34005V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                       "TYPE IS A LIMITED TYPE.  THIS TEST IS PART 2 " &
+                       "OF 2 TESTS WHICH COVER THE OBJECTIVE.  THE " &
+                       "FIRST PART IS IN TEST C34005S");
+ 
+      ASSIGN (X (IDENT_INT (4), IDENT_INT (6)), CREATE (1));
+      ASSIGN (X (IDENT_INT (4), IDENT_INT (7)), CREATE (2));
+      ASSIGN (X (IDENT_INT (4), IDENT_INT (8)), CREATE (3));
+      ASSIGN (X (IDENT_INT (5), IDENT_INT (6)), CREATE (4));
+      ASSIGN (X (IDENT_INT (5), IDENT_INT (7)), CREATE (5));
+      ASSIGN (X (IDENT_INT (5), IDENT_INT (8)), CREATE (6));
+ 
+      ASSIGN (W (4, 6), CREATE (1));
+      ASSIGN (W (4, 7), CREATE (2));
+      ASSIGN (W (4, 8), CREATE (3));
+      ASSIGN (W (5, 6), CREATE (4));
+      ASSIGN (W (5, 7), CREATE (5));
+      ASSIGN (W (5, 8), CREATE (6));
+ 
+      ASSIGN (C, CREATE (2));
+ 
+      IF NOT EQUAL (T'(X), AGGR (C1, C2, C3, C4, C5, C6)) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF NOT EQUAL (T (X), AGGR (C1, C2, C3, C4, C5, C6)) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF NOT EQUAL (T (W), AGGR (C1, C2, C3, C4, C5, C6)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      BEGIN
+           IF NOT EQUAL (PARENT (X), AGGR (C1, C2, C3, C4, C5, C6)) OR
+              NOT EQUAL (PARENT (CREATE (6, 9, 2, 3, C4, X)),
+                         AGGR (C4, C5, C6, C7, C8, C9, C10, C11)) THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR WHEN PREPARING TO CONVERT " &
+                        "TO PARENT");
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION WHEN PREPARING TO CONVERT " &
+                        "TO PARENT");
+      END;
+ 
+      IF NOT (X IN T) OR AGGR (C1, C2, C3, C4) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR
+         NOT (AGGR (C1, C2, C3, C4, C5, C6, C7, C8, C9) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      RESULT;
+ END C34005V;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- C34006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITHOUT DISCRIMINANTS
+ --     AND WITH NON-LIMITED COMPONENT TYPES.
+ 
+ -- HISTORY:
+ --     JRK 09/22/86  CREATED ORIGINAL TEST.
+ --     BCB 09/26/88  REMOVED COMPARISONS INVOLVING SIZE.
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34006A IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      TYPE PARENT IS
+           RECORD
+                C : COMPONENT;
+                B : BOOLEAN := TRUE;
+           END RECORD;
+ 
+      TYPE T IS NEW PARENT;
+ 
+      X : T         := (2, FALSE);
+      K : INTEGER   := X'SIZE;
+      W : PARENT    := (2, FALSE);
+      C : COMPONENT := 1;
+      B : BOOLEAN   := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (X.C, X.C) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN (-1, FALSE);
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34006A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "RECORD TYPES WITHOUT DISCRIMINANTS AND WITH " &
+                       "NON-LIMITED COMPONENT TYPES");
+ 
+      X := IDENT ((1, TRUE));
+      IF X /= (1, TRUE) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= (1, TRUE) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= (1, TRUE) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := (1, TRUE);
+      END IF;
+      IF T (W) /= (1, TRUE) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF PARENT (X) /= (1, TRUE) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF IDENT ((1, TRUE)) /= (1, TRUE) THEN
+           FAILED ("INCORRECT AGGREGATE");
+      END IF;
+ 
+      IF X.C /= 1 OR X.B /= TRUE THEN
+           FAILED ("INCORRECT SELECTION (VALUE)");
+      END IF;
+ 
+      X.C := IDENT_INT (3);
+      X.B := IDENT_BOOL (FALSE);
+      IF X /= (3, FALSE) THEN
+           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+      END IF;
+ 
+      X := IDENT ((1, TRUE));
+      IF X = IDENT ((1, FALSE)) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT ((1, TRUE)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF X.C'FIRST_BIT < 0 THEN
+           FAILED ("INCORRECT 'FIRST_BIT");
+      END IF;
+ 
+      IF X.C'LAST_BIT < 0 OR
+         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+           FAILED ("INCORRECT 'LAST_BIT");
+      END IF;
+ 
+      IF X.C'POSITION < 0 THEN
+           FAILED ("INCORRECT 'POSITION");
+      END IF;
+ 
+ 
+      RESULT;
+ END C34006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,238 ----
+ -- C34006D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH
+ --     NON-LIMITED COMPONENT TYPES.
+ 
+ -- HISTORY:
+ --     JRK 09/22/86  CREATED ORIGINAL TEST.
+ --     BCB 11/13/87  CHANGED TEST SO AN OBJECT'S SIZE MAY BE LESS THAN
+ --                   THAT OF ITS TYPE.
+ --     RJW 08/21/89  MODIFIED CHECKS FOR SIZE.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34006D IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L);
+                               C : COMPONENT;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      X : T         := (TRUE, 3, 2, "AAA", 2);
+      W : PARENT    := (TRUE, 3, 2, "AAA", 2);
+      C : COMPONENT := 1;
+      B : BOOLEAN   := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, C);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF EQUAL (X.I, X.I) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN (TRUE, 3, -1, "---", -1);
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34006D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "RECORD TYPES WITH DISCRIMINANTS AND WITH " &
+                       "NON-LIMITED COMPONENT TYPES");
+ 
+      X := IDENT ((TRUE, 3, 1, "ABC", 4));
+      IF X /= (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := (TRUE, 3, 1, "ABC", 4);
+      END IF;
+      IF T (W) /= (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      BEGIN
+           IF PARENT (X) /= (TRUE, 3, 1, "ABC", 4) OR
+              PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
+              (FALSE, 2, 3, 6.0) THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+      END;
+ 
+      IF IDENT ((TRUE, 3, 1, "ABC", 4)) /= (TRUE, 3, 1, "ABC", 4) OR
+         X = (FALSE, 3, 1, 4.0) THEN
+           FAILED ("INCORRECT AGGREGATE");
+      END IF;
+ 
+      BEGIN
+           IF X.B /= TRUE OR X.L /= 3 OR
+              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+                FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+      END;
+ 
+      BEGIN
+           IF X.I /= 1 OR X.S /= "ABC" OR X.C /= 4 OR
+              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I /= 3 OR
+              CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F /= 6.0 THEN
+                FAILED ("INCORRECT SELECTION (VALUE)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+      END;
+ 
+      X.I := IDENT_INT (7);
+      X.S := IDENT_STR ("XYZ");
+      X.C := IDENT_INT (9);
+      IF X /= (TRUE, 3, 7, "XYZ", 9) THEN
+           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+      END IF;
+ 
+      X := IDENT ((TRUE, 3, 1, "ABC", 4));
+      IF X = IDENT ((TRUE, 3, 1, "ABC", 5)) OR
+         X = (FALSE, 2, 3, 6.0) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= IDENT ((TRUE, 3, 1, "ABC", 4)) OR
+         NOT (X /= (FALSE, 2, 3, 6.0)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR (FALSE, 2, 3, 6.0) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT ((FALSE, 2, 3, 6.0) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED THEN
+           FAILED ("INCORRECT 'CONSTRAINED");
+      END IF;
+ 
+      IF X.C'FIRST_BIT < 0 THEN
+           FAILED ("INCORRECT 'FIRST_BIT");
+      END IF;
+ 
+      IF X.C'LAST_BIT < 0 OR
+         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+           FAILED ("INCORRECT 'LAST_BIT");
+      END IF;
+ 
+      IF X.C'POSITION < 0 THEN
+           FAILED ("INCORRECT 'POSITION");
+      END IF;
+ 
+      RESULT;
+ END C34006D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,228 ----
+ -- C34006F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH NON-LIMITED
+ --     COMPONENT TYPES:
+ --     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
+ --     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --     CONSTRAINED.
+ --     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --     IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 9/22/86  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34006F IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L);
+                               C : COMPONENT;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := (TRUE, 3, 2, "AAA", 2);
+      Y : S := (TRUE, 3, 2, "AAA", 2);
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, C);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34006F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "RECORD TYPES WITH DISCRIMINANTS AND WITH " &
+                       "NON-LIMITED COMPONENT TYPES");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      BEGIN
+           IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) /=
+              (FALSE, 2, 3, 6.0) OR
+              CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) /=
+              (FALSE, 2, 3, 6.0) THEN
+                FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                        "SUBTYPE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+      END;
+ 
+      BEGIN
+           IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+              CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+                FAILED ("INCORRECT ""IN""");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+           WHEN OTHERS =>
+                FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+      END;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         Y.B /= TRUE OR Y.L /= 3 THEN
+           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+           FAILED ("INCORRECT 'CONSTRAINED");
+      END IF;
+ 
+      BEGIN
+           X := (TRUE, 3, 1, "ABC", 4);
+           Y := (TRUE, 3, 1, "ABC", 4);
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := (FALSE, 3, 2, 6.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (FALSE, 3, 2, 6.0)");
+           IF X = (FALSE, 3, 2, 6.0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (FALSE, 3, 2, 6.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (FALSE, 3, 2, 6.0)");
+      END;
+ 
+      BEGIN
+           X := (TRUE, 4, 2, "ZZZZ", 6);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := (TRUE, 4, 2, ""ZZZZ"", 6)");
+           IF X = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := (TRUE, 4, 2, ""ZZZZ"", 6)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := (TRUE, 4, 2, ""ZZZZ"", 6)");
+      END;
+ 
+      BEGIN
+           Y := (FALSE, 3, 2, 6.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (FALSE, 3, 2, 6.0)");
+           IF Y = (FALSE, 3, 2, 6.0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (FALSE, 3, 2, 6.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (FALSE, 3, 2, 6.0)");
+      END;
+ 
+      BEGIN
+           Y := (TRUE, 4, 2, "ZZZZ", 6);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
+           IF Y = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
+      END;
+ 
+      RESULT;
+ END C34006F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,199 ----
+ -- C34006G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITHOUT DISCRIMINANTS AND
+ --     WITH A LIMITED COMPONENT TYPE.
+ 
+ -- HISTORY:
+ --     JRK 08/24/87  CREATED ORIGINAL TEST.
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34006G IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C1 : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C1 : CONSTANT LP := 1;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           TYPE PARENT IS
+                RECORD
+                     C : COMPONENT;
+                     B : BOOLEAN := TRUE;
+                END RECORD;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           FUNCTION AGGR (C : COMPONENT; B : BOOLEAN) RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT;
+ 
+      X : T;
+      W : PARENT;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                RETURN EQUAL (X.C, Y.C) AND X.B = Y.B;
+           END EQUAL;
+ 
+           FUNCTION AGGR (C : COMPONENT; B : BOOLEAN) RETURN PARENT IS
+                RESULT : PARENT;
+           BEGIN
+                ASSIGN (RESULT.C, C);
+                RESULT.B := B;
+                RETURN RESULT;
+           END AGGR;
+ 
+      END PKG_P;
+ 
+ BEGIN
+      TEST ("C34006G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "RECORD TYPES WITHOUT DISCRIMINANTS AND WITH A " &
+                       "LIMITED COMPONENT TYPE");
+ 
+      ASSIGN (X.C, CREATE (1));
+      X.B := IDENT_BOOL (TRUE);
+ 
+      ASSIGN (W.C, CREATE (1));
+      W.B := IDENT_BOOL (TRUE);
+ 
+      IF NOT EQUAL (T'(X), AGGR (C1, TRUE)) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF NOT EQUAL (T (X), AGGR (C1, TRUE)) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF NOT EQUAL (T (W), AGGR (C1, TRUE)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF NOT EQUAL (PARENT (X), AGGR (C1, TRUE)) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF NOT EQUAL (X.C, C1) OR X.B /= TRUE THEN
+           FAILED ("INCORRECT SELECTION (VALUE)");
+      END IF;
+ 
+      X.B := IDENT_BOOL (FALSE);
+      IF NOT EQUAL (X, AGGR (C1, FALSE)) THEN
+           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+      END IF;
+ 
+      X.B := IDENT_BOOL (TRUE);
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF X.C'FIRST_BIT < 0 THEN
+           FAILED ("INCORRECT 'FIRST_BIT");
+      END IF;
+ 
+      IF X.C'LAST_BIT < 0 OR
+         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+           FAILED ("INCORRECT 'LAST_BIT");
+      END IF;
+ 
+      IF X.C'POSITION < 0 THEN
+           FAILED ("INCORRECT 'POSITION");
+      END IF;
+ 
+      IF X'SIZE   < T'SIZE OR
+         X.C'SIZE < COMPONENT'SIZE OR
+         X.B'SIZE < BOOLEAN'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34006G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,311 ----
+ -- C34006J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH
+ --     A LIMITED COMPONENT TYPE.
+ 
+ -- HISTORY:
+ --     JRK 08/25/87  CREATED ORIGINAL TEST.
+ --     VCL 06/28/88  MODIFIED THE STATEMENTS INVOLVING THE 'SIZE
+ --                   ATTRIBUTE TO REMOVE ANY ASSUMPTIONS ABOUT THE
+ --                   SIZES.
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34006J IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C4 : CONSTANT LP;
+           C5 : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C4 : CONSTANT LP := 4;
+           C5 : CONSTANT LP := 5;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                RECORD
+                     I : INTEGER := 2;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L) := (1 .. L => 'A');
+                               C : COMPONENT;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           FUNCTION AGGR ( B : BOOLEAN;
+                           L : LENGTH;
+                           I : INTEGER;
+                           S : STRING;
+                           C : COMPONENT
+                         ) RETURN PARENT;
+ 
+           FUNCTION AGGR ( B : BOOLEAN;
+                           L : LENGTH;
+                           I : INTEGER;
+                           F : FLOAT
+                         ) RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      X : T;
+      W : PARENT;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (B, L);
+           BEGIN
+                A.I := I;
+                CASE B IS
+                     WHEN TRUE =>
+                          A.S := S;
+                          ASSIGN (A.C, C);
+                     WHEN FALSE =>
+                          A.F := F;
+                END CASE;
+                RETURN A;
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                IF X.B /= Y.B OR X.L /= Y.L OR X.I /= Y.I THEN
+                     RETURN FALSE;
+                END IF;
+                CASE X.B IS
+                     WHEN TRUE =>
+                          RETURN X.S = Y.S AND EQUAL (X.C, Y.C);
+                     WHEN FALSE =>
+                          RETURN X.F = Y.F;
+                END CASE;
+           END EQUAL;
+ 
+           FUNCTION AGGR
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT
+              ) RETURN PARENT
+           IS
+                RESULT : PARENT (B, L);
+           BEGIN
+                RESULT.I := I;
+                RESULT.S := S;
+                ASSIGN (RESULT.C, C);
+                RETURN RESULT;
+           END AGGR;
+ 
+           FUNCTION AGGR
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                F : FLOAT
+              ) RETURN PARENT
+           IS
+                RESULT : PARENT (B, L);
+           BEGIN
+                RESULT.I := I;
+                RESULT.F := F;
+                RETURN RESULT;
+           END AGGR;
+ 
+      END PKG_P;
+ 
+ BEGIN
+      TEST ("C34006J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "RECORD TYPES WITH DISCRIMINANTS AND WITH A " &
+                       "LIMITED COMPONENT TYPE");
+ 
+      X.I := IDENT_INT (1);
+      X.S := IDENT_STR ("ABC");
+      ASSIGN (X.C, CREATE (4));
+ 
+      W.I := IDENT_INT (1);
+      W.S := IDENT_STR ("ABC");
+      ASSIGN (W.C, CREATE (4));
+ 
+      IF NOT EQUAL (T'(X), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF NOT EQUAL (T(X), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF NOT EQUAL (T(W), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF NOT EQUAL (PARENT(X), AGGR (TRUE, 3, 1, "ABC", C4))   OR
+         NOT EQUAL (PARENT(CREATE (FALSE, 2, 3, "XX", C5, 6.0, X)),
+                    AGGR (FALSE, 2, 3, 6.0))   THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).B /= FALSE OR
+         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).L /= 2 THEN
+           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+      END IF;
+ 
+      IF X.I /= 1 OR X.S /= "ABC" OR NOT EQUAL (X.C, C4) OR
+         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).I /= 3 OR
+         CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).F /= 6.0 THEN
+           FAILED ("INCORRECT SELECTION (VALUE)");
+      END IF;
+ 
+      X.I := IDENT_INT (7);
+      X.S := IDENT_STR ("XYZ");
+      IF NOT EQUAL (X, AGGR (TRUE, 3, 7, "XYZ", C4)) THEN
+           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+      END IF;
+ 
+      X.I := IDENT_INT (1);
+      X.S := IDENT_STR ("ABC");
+      IF NOT (X IN T) OR AGGR (FALSE, 2, 3, 6.0) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (AGGR (FALSE, 2, 3, 6.0) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED THEN
+           FAILED ("INCORRECT 'CONSTRAINED");
+      END IF;
+ 
+      IF X.C'FIRST_BIT < 0 THEN
+           FAILED ("INCORRECT 'FIRST_BIT");
+      END IF;
+ 
+      IF X.C'LAST_BIT < 0 OR
+         X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+           FAILED ("INCORRECT 'LAST_BIT");
+      END IF;
+ 
+      IF X.C'POSITION < 0 THEN
+           FAILED ("INCORRECT 'POSITION");
+      END IF;
+ 
+      IF X'SIZE < T'SIZE THEN
+           COMMENT ("X'SIZE < T'SIZE");
+      ELSIF X'SIZE = T'SIZE THEN
+           COMMENT ("X'SIZE = T'SIZE");
+      ELSE
+           COMMENT ("X'SIZE > T'SIZE");
+      END IF;
+ 
+      RESULT;
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("UNEXPECTED EXCEPTION RAISED WHILE CHECKING BASIC " &
+                   "OPERATIONS");
+           RESULT;
+ END C34006J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34006l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34006l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,345 ----
+ -- C34006L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH A LIMITED
+ --     COMPONENT TYPE:
+ 
+ --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
+ --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
+ --        IS CONSTRAINED.
+ 
+ --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
+ --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 08/26/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34006L IS
+ 
+      PACKAGE PKG_L IS
+ 
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+ 
+           C2 : CONSTANT LP;
+           C4 : CONSTANT LP;
+           C5 : CONSTANT LP;
+           C6 : CONSTANT LP;
+ 
+      PRIVATE
+ 
+           TYPE LP IS NEW INTEGER;
+ 
+           C2 : CONSTANT LP := 2;
+           C4 : CONSTANT LP := 4;
+           C5 : CONSTANT LP := 5;
+           C6 : CONSTANT LP := 6;
+ 
+      END PKG_L;
+ 
+      USE PKG_L;
+ 
+      SUBTYPE COMPONENT IS LP;
+ 
+      PACKAGE PKG_P IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                RECORD
+                     I : INTEGER := 2;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L) := (1 .. L => 'A');
+                               C : COMPONENT;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           FUNCTION AGGR ( B : BOOLEAN;
+                           L : LENGTH;
+                           I : INTEGER;
+                           S : STRING;
+                           C : COMPONENT
+                         ) RETURN PARENT;
+ 
+           FUNCTION AGGR ( B : BOOLEAN;
+                           L : LENGTH;
+                           I : INTEGER;
+                           F : FLOAT
+                         ) RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+      PACKAGE BODY PKG_L IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN LP IS
+           BEGIN
+                RETURN LP (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG_L;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT (B, L);
+           BEGIN
+                A.I := I;
+                CASE B IS
+                     WHEN TRUE =>
+                          A.S := S;
+                          ASSIGN (A.C, C);
+                     WHEN FALSE =>
+                          A.F := F;
+                END CASE;
+                RETURN A;
+           END CREATE;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                IF X.B /= Y.B OR X.L /= Y.L OR X.I /= Y.I THEN
+                     RETURN FALSE;
+                END IF;
+                CASE X.B IS
+                     WHEN TRUE =>
+                          RETURN X.S = Y.S AND EQUAL (X.C, Y.C);
+                     WHEN FALSE =>
+                          RETURN X.F = Y.F;
+                END CASE;
+           END EQUAL;
+ 
+           FUNCTION AGGR
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT
+              ) RETURN PARENT
+           IS
+                RESULT : PARENT (B, L);
+           BEGIN
+                RESULT.I := I;
+                RESULT.S := S;
+                ASSIGN (RESULT.C, C);
+                RETURN RESULT;
+           END AGGR;
+ 
+           FUNCTION AGGR
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                F : FLOAT
+              ) RETURN PARENT
+           IS
+                RESULT : PARENT (B, L);
+           BEGIN
+                RESULT.I := I;
+                RESULT.F := F;
+                RETURN RESULT;
+           END AGGR;
+ 
+      END PKG_P;
+ 
+      PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
+      BEGIN
+           X.I := Y.I;
+           X.S := Y.S;
+           ASSIGN (X.C, Y.C);
+      END ASSIGN;
+ 
+      PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
+      BEGIN
+           X.I := Y.I;
+           X.S := Y.S;
+           ASSIGN (X.C, Y.C);
+      END ASSIGN;
+ 
+ BEGIN
+      TEST ("C34006L", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "RECORD TYPES WITH DISCRIMINANTS AND WITH A " &
+                       "LIMITED COMPONENT TYPE");
+ 
+      ASSIGN (X.C, CREATE (2));
+      ASSIGN (Y.C, C2);
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, X),
+                    AGGR (FALSE, 2, 3, 6.0)) OR
+         NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, Y),
+                    AGGR (FALSE, 2, 3, 6.0)) THEN
+           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+      END IF;
+ 
+      IF CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, X) IN T OR
+         CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, Y) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         Y.B /= TRUE OR Y.L /= 3 THEN
+           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+           FAILED ("INCORRECT 'CONSTRAINED");
+      END IF;
+ 
+      BEGIN
+           ASSIGN (X, AGGR (TRUE, 3, 1, "ABC", C4));
+           ASSIGN (Y, AGGR (TRUE, 3, 1, "ABC", C4));
+           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, AGGR (FALSE, 3, 2, 6.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
+           IF EQUAL (X, AGGR (FALSE, 3, 2, 6.0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, AGGR (TRUE, 4, 2, "ZZZZ", C6));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+           IF EQUAL (X, AGGR (TRUE, 4, 2, "ZZZZ", C6)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
+           IF EQUAL (Y, AGGR (FALSE, 3, 2, 6.0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, AGGR (TRUE, 4, 2, "ZZZZ", C6));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+           IF EQUAL (Y, AGGR (TRUE, 4, 2, "ZZZZ", C6)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+      END;
+ 
+      RESULT;
+ END C34006L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,181 ----
+ -- C34007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS
+ --     NOT AN ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A TYPE WITH
+ --     DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 09/24/86  CREATED ORIGINAL TEST.
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+ --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+ --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+ --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+ --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007A IS
+ 
+      TYPE DESIGNATED IS RANGE -100 .. 100;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED RANGE
+                DESIGNATED'VAL (IDENT_INT (-50)) ..
+                DESIGNATED'VAL (IDENT_INT ( 50));
+ 
+      TYPE PARENT IS ACCESS SUBDESIGNATED RANGE
+                DESIGNATED'VAL (IDENT_INT (-30)) ..
+                DESIGNATED'VAL (IDENT_INT ( 30));
+ 
+      TYPE T IS NEW PARENT;
+ 
+      X : T       := NEW DESIGNATED'(-30);
+      K : INTEGER := X'SIZE;
+      Y : T       := NEW DESIGNATED'( 30);
+      W : PARENT  := NEW DESIGNATED'( 30);
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF X = NULL OR ELSE
+              EQUAL (DESIGNATED'POS (X.ALL), DESIGNATED'POS (X.ALL)) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW DESIGNATED;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34007A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS NOT AN " &
+                       "ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A " &
+                       "TYPE WITH DISCRIMINANTS");
+ 
+      IF Y = NULL OR ELSE Y.ALL /= 30 THEN
+           FAILED ("INCORRECT INITIALIZATION");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X /= Y THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= Y THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= Y THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := NEW DESIGNATED'(-30);
+      END IF;
+      X := T (W);
+      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= -30 THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      X := IDENT (Y);
+      W := PARENT (X);
+      IF W = NULL OR ELSE W.ALL /= 30 OR ELSE T (W) /= Y THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF IDENT (NULL) /= NULL OR X = NULL THEN
+           FAILED ("INCORRECT NULL");
+      END IF;
+ 
+      X := IDENT (NEW DESIGNATED'(30));
+      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= 30 THEN
+           FAILED ("INCORRECT ALLOCATOR");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X.ALL /= 30 THEN
+           FAILED ("INCORRECT .ALL (VALUE)");
+      END IF;
+ 
+      X.ALL := DESIGNATED'VAL (IDENT_INT (10));
+      IF X /= Y OR Y.ALL /= 10 THEN
+           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := 30;
+      X := IDENT (NULL);
+      BEGIN
+           IF X.ALL = 0 THEN
+                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+      END;
+ 
+      X := IDENT (Y);
+      IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= Y OR NOT (X /= NULL) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      A (X'ADDRESS);
+ 
+      BEGIN
+           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                        "EQUAL OF COLLECTION SIZE OF PARENT TYPE");
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                         "UNDEFINED STORAGE_SIZE (AI-00608)");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C34007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,266 ----
+ -- C34007D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+ --     ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS PART 1 OF 2 TESTS
+ --     WHICH COVER THE OBJECTIVE.  THE SECOND PART IS IN TEST C34007V.
+ 
+ -- HISTORY:
+ --     JRK 09/25/86  CREATED ORIGINAL TEST.
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+ --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+ --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+ --     BCB 04/12/90  SPLIT ORIGINAL TEST INTO C34007D.ADA AND
+ --                   C34007V.ADA.  PUT CHECK FOR 'STORAGE_SIZE IN
+ --                   EXCEPTION HANDLER.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+ --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007D IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) ..
+                                           IDENT_INT (7));
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      X : T         := NEW SUBDESIGNATED'(OTHERS => 2);
+      K : INTEGER   := X'SIZE;
+      Y : T         := NEW SUBDESIGNATED'(1, 2, 3);
+      W : PARENT    := NEW SUBDESIGNATED'(OTHERS => 2);
+      C : COMPONENT := 1;
+      N : CONSTANT  := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN NEW SUBDESIGNATED'(OTHERS => C);
+      END V;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF X = NULL OR ELSE
+              EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW SUBDESIGNATED;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34007D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS " &
+                       "PART 1 OF 2 TESTS WHICH COVER THE OBJECTIVE.  " &
+                       "THE SECOND PART IS IN TEST C34007V");
+ 
+      IF Y = NULL OR ELSE Y.ALL /= (1, 2, 3) THEN
+           FAILED ("INCORRECT INITIALIZATION");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X /= Y THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= Y THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= Y THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := NEW SUBDESIGNATED'(1, 2, 3);
+      END IF;
+      X := T (W);
+      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, 2, 3) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      X := IDENT (Y);
+      W := PARENT (X);
+      IF W = NULL OR ELSE W.ALL /= (1, 2, 3) OR ELSE T (W) /= Y THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+      END IF;
+ 
+      IF IDENT (NULL) /= NULL OR X = NULL THEN
+           FAILED ("INCORRECT NULL");
+      END IF;
+ 
+      X := IDENT (NEW SUBDESIGNATED'(1, 2, 3));
+      IF (X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, 2, 3)) OR
+         X = NEW DESIGNATED'(1, 2) THEN
+           FAILED ("INCORRECT ALLOCATOR");
+      END IF;
+ 
+      X := IDENT (NULL);
+      BEGIN
+           IF X.ALL = (0, 0, 0) THEN
+                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+      END;
+ 
+      X := IDENT (Y);
+      X (IDENT_INT (7)) := 4;
+      IF X /= Y OR Y.ALL /= (1, 2, 4) THEN
+           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := (1, 2, 3);
+      X := IDENT (Y);
+      X (IDENT_INT (5) .. IDENT_INT (6)) := (4, 5);
+      IF X /= Y OR Y.ALL /= (4, 5, 3) THEN
+           FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+      END IF;
+ 
+      A (X'ADDRESS);
+ 
+      IF X'FIRST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF X'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 5 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF X'LAST /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF X'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 7 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF X'LENGTH /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : DESIGNATED (X'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : DESIGNATED (V'RANGE);
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : DESIGNATED (X'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : DESIGNATED (V'RANGE (N));
+      BEGIN
+           IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      IF T'SIZE < 1 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      BEGIN
+           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                         "UNDEFINED STORAGE_SIZE (AI-00608)");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C34007D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- C34007F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A ONE-DIMENSIONAL
+ -- ARRAY TYPE:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 9/25/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007F IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED (5 .. 7);
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( F, L  : NATURAL;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := NEW SUBDESIGNATED'(OTHERS => 2);
+      Y : S := NEW SUBDESIGNATED'(OTHERS => 2);
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : NATURAL;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT    := NEW DESIGNATED (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := B + 1;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34007F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "ONE-DIMENSIONAL ARRAY TYPE");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF CREATE (2, 3, 4, X) . ALL /= (4, 5) OR
+         CREATE (2, 3, 4, Y) . ALL /= (4, 5) THEN
+           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+      END IF;
+ 
+      IF CREATE (2, 3, 4, X) IN T OR
+         CREATE (2, 3, 4, Y) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X'FIRST /= 5 OR X'LAST /= 7 OR
+         Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := NEW SUBDESIGNATED'(1, 2, 3);
+           Y := NEW SUBDESIGNATED'(1, 2, 3);
+           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+              X.ALL /= Y.ALL THEN
+                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(6 .. 8 => 0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := NEW DESIGNATED'(6 .. 8 => 0)");
+           IF X = NULL OR ELSE X.ALL = (0, 0, 0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := NEW DESIGNATED'(6 .. 8 => 0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := NEW DESIGNATED'(6 .. 8 => 0)");
+      END;
+ 
+      BEGIN
+           Y := NEW DESIGNATED'(6 .. 8 => 0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := NEW DESIGNATED'(6 .. 8 => 0)");
+           IF Y = NULL OR ELSE Y.ALL = (0, 0, 0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := NEW DESIGNATED'(6 .. 8 => 0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := NEW DESIGNATED'(6 .. 8 => 0)");
+      END;
+ 
+      RESULT;
+ END C34007F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,350 ----
+ -- C34007G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+ --     MULTI-DIMENSIONAL ARRAY TYPE.
+ 
+ -- HISTORY:
+ --     JRK 09/25/86  CREATED ORIGINAL TEST.
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+ --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+ --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+ --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007G IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) OF
+                               COMPONENT;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED
+                                    (IDENT_INT (4) .. IDENT_INT (5),
+                                     IDENT_INT (6) .. IDENT_INT (8));
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( F1, L1 : NATURAL;
+                             F2, L2 : NATURAL;
+                             C      : COMPONENT;
+                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                            IDENT_INT (6) .. IDENT_INT (8));
+ 
+      X : T         := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+      Y : T         := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+      W : PARENT    := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+      C : COMPONENT := 1;
+      N : CONSTANT  := 2;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN NEW SUBDESIGNATED'(OTHERS => (OTHERS => C));
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F1, L1 : NATURAL;
+                F2, L2 : NATURAL;
+                C      : COMPONENT;
+                DUMMY  : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT    := NEW DESIGNATED (F1 .. L1, F2 .. L2);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F1 .. L1 LOOP
+                     FOR J IN F2 .. L2 LOOP
+                          A (I, J) := B;
+                          B := B + 1;
+                     END LOOP;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF X = NULL OR ELSE
+              EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW SUBDESIGNATED;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34007G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "MULTI-DIMENSIONAL ARRAY TYPE");
+ 
+      IF Y = NULL OR ELSE Y.ALL /= ((1, 2, 3), (4, 5, 6)) THEN
+           FAILED ("INCORRECT INITIALIZATION");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X /= Y THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= Y THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= Y THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+      END IF;
+      X := T (W);
+      IF X = NULL OR ELSE X = Y OR ELSE
+         X.ALL /= ((1, 2, 3), (4, 5, 6)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      X := IDENT (Y);
+      W := PARENT (X);
+      IF W = NULL OR ELSE W.ALL /= ((1, 2, 3), (4, 5, 6)) OR ELSE
+         T (W) /= Y THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+      END IF;
+ 
+      W := PARENT (CREATE (6, 9, 2, 3, 4, X));
+      IF W = NULL OR ELSE
+         W.ALL /= ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+      END IF;
+ 
+      IF IDENT (NULL) /= NULL OR X = NULL THEN
+           FAILED ("INCORRECT NULL");
+      END IF;
+ 
+      X := IDENT (NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6)));
+      IF (X = NULL OR ELSE X = Y OR ELSE
+          X.ALL /= ((1, 2, 3), (4, 5, 6))) OR
+         X = NEW DESIGNATED'((1, 2), (3, 4), (5, 6)) THEN
+           FAILED ("INCORRECT ALLOCATOR");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X.ALL /= ((1, 2, 3), (4, 5, 6)) OR
+         CREATE (6, 9, 2, 3, 4, X) . ALL /=
+         ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
+           FAILED ("INCORRECT .ALL (VALUE)");
+      END IF;
+ 
+      X.ALL := ((10, 11, 12), (13, 14, 15));
+      IF X /= Y OR Y.ALL /= ((10, 11, 12), (13, 14, 15)) THEN
+           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := ((1, 2, 3), (4, 5, 6));
+      BEGIN
+           CREATE (6, 9, 2, 3, 4, X) . ALL :=
+                ((20, 21), (22, 23), (24, 25), (26, 27));
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+      END;
+ 
+      X := IDENT (NULL);
+      BEGIN
+           IF X.ALL = ((0, 0, 0), (0, 0, 0)) THEN
+                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+      END;
+ 
+      X := IDENT (Y);
+      IF X (IDENT_INT (4), IDENT_INT (6)) /= 1 OR
+         CREATE (6, 9, 2, 3, 4, X) (9, 3) /= 11 THEN
+           FAILED ("INCORRECT INDEX (VALUE)");
+      END IF;
+ 
+      X (IDENT_INT (5), IDENT_INT (8)) := 7;
+      IF X /= Y OR Y.ALL /= ((1, 2, 3), (4, 5, 7)) THEN
+           FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := ((1, 2, 3), (4, 5, 6));
+      X := IDENT (Y);
+      BEGIN
+           CREATE (6, 9, 2, 3, 4, X) (6, 2) := 15;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)");
+      END;
+ 
+      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+         X = CREATE (6, 9, 2, 3, 4, X) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= Y OR NOT (X /= NULL) OR
+         NOT (X /= CREATE (7, 9, 2, 4, 1, X)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR CREATE (2, 3, 4, 5, 1, X) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (CREATE (7, 9, 2, 4, 1, X) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      A (X'ADDRESS);
+ 
+      IF X'FIRST /= 4 THEN
+           FAILED ("INCORRECT OBJECT'FIRST");
+      END IF;
+ 
+      IF V'FIRST /= 4 THEN
+           FAILED ("INCORRECT VALUE'FIRST");
+      END IF;
+ 
+      IF X'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT OBJECT'FIRST (N)");
+      END IF;
+ 
+      IF V'FIRST (N) /= 6 THEN
+           FAILED ("INCORRECT VALUE'FIRST (N)");
+      END IF;
+ 
+      IF X'LAST /= 5 THEN
+           FAILED ("INCORRECT OBJECT'LAST");
+      END IF;
+ 
+      IF V'LAST /= 5 THEN
+           FAILED ("INCORRECT VALUE'LAST");
+      END IF;
+ 
+      IF X'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT OBJECT'LAST (N)");
+      END IF;
+ 
+      IF V'LAST (N) /= 8 THEN
+           FAILED ("INCORRECT VALUE'LAST (N)");
+      END IF;
+ 
+      IF X'LENGTH /= 2 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH");
+      END IF;
+ 
+      IF V'LENGTH /= 2 THEN
+           FAILED ("INCORRECT VALUE'LENGTH");
+      END IF;
+ 
+      IF X'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT OBJECT'LENGTH (N)");
+      END IF;
+ 
+      IF V'LENGTH (N) /= 3 THEN
+           FAILED ("INCORRECT VALUE'LENGTH (N)");
+      END IF;
+ 
+      DECLARE
+           Y : DESIGNATED (X'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT OBJECT'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : DESIGNATED (V'RANGE, 1 .. 3);
+      BEGIN
+           IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+                FAILED ("INCORRECT VALUE'RANGE");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : DESIGNATED (1 .. 2, X'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT OBJECT'RANGE (N)");
+           END IF;
+      END;
+ 
+      DECLARE
+           Y : DESIGNATED (1 .. 2, V'RANGE (N));
+      BEGIN
+           IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+                FAILED ("INCORRECT VALUE'RANGE (N)");
+           END IF;
+      END;
+ 
+      IF T'SIZE < 1 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE < T'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      BEGIN
+           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                         "UNDEFINED STORAGE_SIZE (AI-00608)");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C34007G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,213 ----
+ -- C34007I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A MULTI-DIMENSIONAL
+ -- ARRAY TYPE:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 9/25/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007I IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) OF
+                               COMPONENT;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED (4 .. 5, 6 .. 8);
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( F1, L1 : NATURAL;
+                             F2, L2 : NATURAL;
+                             C      : COMPONENT;
+                             DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                            IDENT_INT (6) .. IDENT_INT (8));
+ 
+      SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+      Y : S := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F1, L1 : NATURAL;
+                F2, L2 : NATURAL;
+                C      : COMPONENT;
+                DUMMY  : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT    := NEW DESIGNATED (F1 .. L1, F2 .. L2);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F1 .. L1 LOOP
+                     FOR J IN F2 .. L2 LOOP
+                          A (I, J) := B;
+                          B := B + 1;
+                     END LOOP;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34007I", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "MULTI-DIMENSIONAL ARRAY TYPE");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF CREATE (6, 9, 2, 3, 1, X) . ALL /=
+         ((1, 2), (3, 4), (5, 6), (7, 8)) OR
+         CREATE (6, 9, 2, 3, 1, Y) . ALL /=
+         ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
+           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+      END IF;
+ 
+      IF CREATE (6, 9, 2, 3, 1, X) IN T OR
+         CREATE (6, 9, 2, 3, 1, Y) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X'FIRST /= 4 OR X'LAST /= 5 OR
+         Y'FIRST /= 4 OR Y'LAST /= 5 OR
+         X'FIRST (2) /= 6 OR X'LAST (2) /= 8 OR
+         Y'FIRST (2) /= 6 OR Y'LAST (2) /= 8 THEN
+           FAILED ("INCORRECT 'FIRST OR 'LAST");
+      END IF;
+ 
+      BEGIN
+           X := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+           Y := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+              X.ALL /= Y.ALL THEN
+                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+           IF X = NULL OR ELSE
+              X.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := NEW DESIGNATED'(5 .. 6 => " &
+                         "(6 .. 8 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+      END;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+           IF X = NULL OR ELSE
+              X.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := NEW DESIGNATED'(4 .. 5 => " &
+                         "(5 .. 7 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+      END;
+ 
+      BEGIN
+           Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+           IF Y = NULL OR ELSE
+              Y.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := NEW DESIGNATED'(5 .. 6 => " &
+                         "(6 .. 8 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+      END;
+ 
+      BEGIN
+           Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+           IF Y = NULL OR ELSE
+              Y.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := NEW DESIGNATED'(4 .. 5 => " &
+                         "(5 .. 7 => 0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+      END;
+ 
+      RESULT;
+ END C34007I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,258 ----
+ -- C34007J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE
+ --     IS A TASK TYPE.
+ 
+ -- HISTORY:
+ --     JRK 09/26/86  CREATED ORIGINAL TEST.
+ --     JLH 09/25/87  REFORMATTED HEADER.
+ --     BCB 09/26/88  REMOVED COMPARISION INVOLVING OBJECT SIZE.
+ --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+ --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007J IS
+ 
+      TASK TYPE DESIGNATED IS
+           ENTRY E (I : IN OUT INTEGER);
+           ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER);
+           ENTRY R (I : OUT INTEGER);
+           ENTRY W (I : INTEGER);
+      END DESIGNATED;
+ 
+      TYPE PARENT IS ACCESS DESIGNATED;
+ 
+      TYPE T IS NEW PARENT;
+ 
+      X : T;
+      K : INTEGER := X'SIZE;
+      Y : T;
+      W : PARENT;
+      I : INTEGER := 0;
+      J : INTEGER := 0;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN NEW DESIGNATED;
+      END V;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF (X = NULL OR ELSE X'CALLABLE) OR IDENT_BOOL (TRUE) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW DESIGNATED;
+      END IDENT;
+ 
+      TASK BODY DESIGNATED IS
+           N : INTEGER := 1;
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E (I : IN OUT INTEGER) DO
+                          I := I + N;
+                     END E;
+                OR
+                     ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO
+                          J := I + N;
+                     END F;
+                OR
+                     ACCEPT R (I : OUT INTEGER) DO
+                          I := N;
+                     END R;
+                OR
+                     ACCEPT W (I : INTEGER) DO
+                          N := I;
+                     END W;
+                OR
+                     TERMINATE;
+                END SELECT;
+           END LOOP;
+      END DESIGNATED;
+ 
+ BEGIN
+      TEST ("C34007J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "TASK TYPE");
+ 
+      X := NEW DESIGNATED;
+      Y := NEW DESIGNATED;
+      W := NEW DESIGNATED;
+ 
+      IF Y = NULL THEN
+           FAILED ("INCORRECT INITIALIZATION - 1");
+      ELSE Y.W (2);
+           Y.R (I);
+           IF I /= 2 THEN
+                FAILED ("INCORRECT INITIALIZATION - 2");
+           END IF;
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X /= Y THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= Y THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= Y THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := NEW DESIGNATED;
+           W.W (3);
+      END IF;
+      X := T (W);
+      IF X = NULL OR X = Y THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT - 1");
+      ELSE I := 5;
+           X.E (I);
+           IF I /= 8 THEN
+                FAILED ("INCORRECT CONVERSION FROM PARENT - 2");
+           END IF;
+      END IF;
+ 
+      X := IDENT (Y);
+      W := PARENT (X);
+      IF W = NULL OR T (W) /= Y THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+      ELSE I := 5;
+           W.E (I);
+           IF I /= 7 THEN
+                FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+           END IF;
+      END IF;
+ 
+      IF IDENT (NULL) /= NULL OR X = NULL THEN
+           FAILED ("INCORRECT NULL");
+      END IF;
+ 
+      X := IDENT (NEW DESIGNATED);
+      IF X = NULL OR X = Y THEN
+           FAILED ("INCORRECT ALLOCATOR - 1");
+      ELSE I := 5;
+           X.E (I);
+           IF I /= 6 THEN
+                FAILED ("INCORRECT ALLOCATOR - 2");
+           END IF;
+      END IF;
+ 
+      X := IDENT (Y);
+      I := 5;
+      X.E (I);
+      IF I /= 7 THEN
+           FAILED ("INCORRECT SELECTION (ENTRY)");
+      END IF;
+ 
+      I := 5;
+      X.F (IDENT_INT (2)) (I, J);
+      IF J /= 7 THEN
+           FAILED ("INCORRECT SELECTION (FAMILY)");
+      END IF;
+ 
+      I := 5;
+      X.ALL.E (I);
+      IF I /= 7 THEN
+           FAILED ("INCORRECT .ALL");
+      END IF;
+ 
+      X := IDENT (NULL);
+      BEGIN
+           IF X.ALL'CALLABLE THEN
+                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+      END;
+ 
+      X := IDENT (Y);
+      IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= Y OR NOT (X /= NULL) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      A (X'ADDRESS);
+ 
+      IF NOT X'CALLABLE THEN
+           FAILED ("INCORRECT OBJECT'CALLABLE");
+      END IF;
+ 
+      IF NOT V'CALLABLE THEN
+           FAILED ("INCORRECT VALUE'CALLABLE");
+      END IF;
+ 
+      BEGIN
+           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                         "UNDEFINED STORAGE_SIZE (AI-00608)");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      IF X'TERMINATED THEN
+           FAILED ("INCORRECT OBJECT'TERMINATED");
+      END IF;
+ 
+      IF V'TERMINATED THEN
+           FAILED ("INCORRECT VALUE'TERMINATED");
+      END IF;
+ 
+      RESULT;
+ END C34007J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C34007M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+ --     RECORD TYPE WITHOUT DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 09/29/86  CREATED ORIGINAL TEST.
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+ --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+ --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+ --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+ --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007M IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      TYPE DESIGNATED IS
+           RECORD
+                C : COMPONENT;
+                B : BOOLEAN := TRUE;
+           END RECORD;
+ 
+      TYPE PARENT IS ACCESS DESIGNATED;
+ 
+      TYPE T IS NEW PARENT;
+ 
+      X : T       := NEW DESIGNATED'(2, FALSE);
+      K : INTEGER := X'SIZE;
+      Y : T       := NEW DESIGNATED'(1, TRUE);
+      W : PARENT  := NEW DESIGNATED'(2, FALSE);
+      C : COMPONENT := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF X = NULL OR ELSE EQUAL (X.C, X.C) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW DESIGNATED'(-1, FALSE);
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34007M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "RECORD TYPE WITHOUT DISCRIMINANTS");
+ 
+      IF Y = NULL OR ELSE Y.ALL /= (1, TRUE) THEN
+           FAILED ("INCORRECT INITIALIZATION");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X /= Y THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= Y THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= Y THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := NEW DESIGNATED'(1, TRUE);
+      END IF;
+      X := T (W);
+      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      X := IDENT (Y);
+      W := PARENT (X);
+      IF W = NULL OR ELSE W.ALL /= (1, TRUE) OR ELSE T (W) /= Y THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF IDENT (NULL) /= NULL OR X = NULL THEN
+           FAILED ("INCORRECT NULL");
+      END IF;
+ 
+      X := IDENT (NEW DESIGNATED'(1, TRUE));
+      IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
+           FAILED ("INCORRECT ALLOCATOR");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X.C /= 1 OR X.B /= TRUE THEN
+           FAILED ("INCORRECT SELECTION (VALUE)");
+      END IF;
+ 
+      X.C := IDENT_INT (3);
+      X.B := IDENT_BOOL (FALSE);
+      IF X /= Y OR Y.ALL /= (3, FALSE) THEN
+           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := (1, TRUE);
+      X := IDENT (Y);
+      IF X.ALL /= (1, TRUE) THEN
+           FAILED ("INCORRECT .ALL (VALUE)");
+      END IF;
+ 
+      X.ALL := (10, FALSE);
+      IF X /= Y OR Y.ALL /= (10, FALSE) THEN
+           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := (1, TRUE);
+      X := IDENT (NULL);
+      BEGIN
+           IF X.ALL = (0, FALSE) THEN
+                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+      END;
+ 
+      X := IDENT (Y);
+      IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= Y OR NOT (X /= NULL) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      A (X'ADDRESS);
+ 
+      BEGIN
+           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                         "UNDEFINED STORAGE_SIZE (AI-00608)");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C34007M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,283 ----
+ -- C34007P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+ --     RECORD TYPE WITH DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 09/29/86  CREATED ORIGINAL TEST.
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+ --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+ --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+ --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+ --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007P IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+ 
+      TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+           RECORD
+                I : INTEGER;
+                CASE B IS
+                     WHEN TRUE =>
+                          S : STRING (1 .. L);
+                          C : COMPONENT;
+                     WHEN FALSE =>
+                          F : FLOAT := 5.0;
+                END CASE;
+           END RECORD;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_BOOL (TRUE),
+                                           IDENT_INT (3));
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      X : T       := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+      K : INTEGER := X'SIZE;
+      Y : T       := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+      W : PARENT  := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+      C : COMPONENT := 1;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN NEW DESIGNATED'(TRUE, L, I, S, C);
+                     WHEN FALSE =>
+                          RETURN NEW DESIGNATED'(FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF X = NULL OR ELSE EQUAL (X.I, X.I) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW DESIGNATED'(TRUE, 3, -1, "---", -1);
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34007P", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "RECORD TYPE WITH DISCRIMINANTS");
+ 
+      IF Y = NULL OR ELSE Y.ALL /= (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT INITIALIZATION");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X /= Y THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= Y THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= Y THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+      END IF;
+      X := T (W);
+      IF X = NULL OR ELSE X = Y OR ELSE
+         X.ALL /= (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      X := IDENT (Y);
+      W := PARENT (X);
+      IF W = NULL OR ELSE W.ALL /= (TRUE, 3, 1, "ABC", 4) OR ELSE
+         T (W) /= Y THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+      END IF;
+ 
+      W := PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X));
+      IF W = NULL OR ELSE W.ALL /= (FALSE, 2, 3, 6.0) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+      END IF;
+ 
+      IF IDENT (NULL) /= NULL OR X = NULL THEN
+           FAILED ("INCORRECT NULL");
+      END IF;
+ 
+      X := IDENT (NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4));
+      IF (X = NULL OR ELSE X = Y OR ELSE
+          X.ALL /= (TRUE, 3, 1, "ABC", 4)) OR
+         X = NEW DESIGNATED'(FALSE, 3, 1, 4.0) THEN
+           FAILED ("INCORRECT ALLOCATOR");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X.B /= TRUE OR X.L /= 3 OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+      END IF;
+ 
+      IF X.I /= 1 OR X.S /= "ABC" OR X.C /= 4 OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I /= 3 OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F /= 6.0 THEN
+           FAILED ("INCORRECT SELECTION (VALUE)");
+      END IF;
+ 
+      X.I := IDENT_INT (7);
+      X.S := IDENT_STR ("XYZ");
+      X.C := IDENT_INT (9);
+      IF X /= Y OR Y.ALL /= (TRUE, 3, 7, "XYZ", 9) THEN
+           FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := (TRUE, 3, 1, "ABC", 4);
+      X := IDENT (Y);
+      BEGIN
+           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I := 10;
+           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F := 10.0;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR SELECTION (ASSIGNMENT)");
+      END;
+ 
+      IF X.ALL /= (TRUE, 3, 1, "ABC", 4) OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL /=
+         (FALSE, 2, 3, 6.0) THEN
+           FAILED ("INCORRECT .ALL (VALUE)");
+      END IF;
+ 
+      X.ALL := (TRUE, 3, 10, "ZZZ", 15);
+      IF X /= Y OR Y.ALL /= (TRUE, 3, 10, "ZZZ", 15) THEN
+           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := (TRUE, 3, 1, "ABC", 4);
+      BEGIN
+           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL :=
+                (FALSE, 2, 10, 15.0);
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+      END;
+ 
+      X := IDENT (NULL);
+      BEGIN
+           IF X.ALL = (FALSE, 0, 0, 0.0) THEN
+                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+      END;
+ 
+      X := IDENT (Y);
+      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+         X = CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= Y OR NOT (X /= NULL) OR
+         NOT (X /= CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR
+         NOT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      A (X'ADDRESS);
+ 
+      IF T'SIZE < 1 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      BEGIN
+           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                         "UNDEFINED STORAGE_SIZE (AI-00608)");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C34007P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007r.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007r.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007r.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,218 ----
+ -- C34007R.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A RECORD TYPE
+ -- WITH DISCRIMINANTS:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 9/29/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007R IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+ 
+      TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+           RECORD
+                I : INTEGER;
+                CASE B IS
+                     WHEN TRUE =>
+                          S : STRING (1 .. L);
+                          C : COMPONENT;
+                     WHEN FALSE =>
+                          F : FLOAT := 5.0;
+                END CASE;
+           END RECORD;
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+      Y : S := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN NEW DESIGNATED'(TRUE, L, I, S, C);
+                     WHEN FALSE =>
+                          RETURN NEW DESIGNATED'(FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34007R", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "RECORD TYPE WITH DISCRIMINANTS");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) . ALL /=
+         (FALSE, 2, 3, 6.0) OR
+         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) . ALL /=
+         (FALSE, 2, 3, 6.0) THEN
+           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+      END IF;
+ 
+      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         Y.B /= TRUE OR Y.L /= 3 THEN
+           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+      END IF;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+           Y := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+              X.ALL /= Y.ALL THEN
+                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(FALSE, 3, 2, 6.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+           IF X = NULL OR ELSE X.ALL = (FALSE, 3, 2, 6.0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+      END;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(TRUE, 4, 2, "ZZZZ", 6);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+           IF X = NULL OR ELSE
+              X.ALL = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := NEW DESIGNATED'" &
+                         "(TRUE, 4, 2, ""ZZZZ"", 6)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+      END;
+ 
+      BEGIN
+           Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+           IF Y = NULL OR ELSE Y.ALL = (FALSE, 3, 2, 6.0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+      END;
+ 
+      BEGIN
+           Y := NEW DESIGNATED'(TRUE, 4, 2, "ZZZZ", 6);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+           IF Y = NULL OR ELSE
+              Y.ALL = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := NEW DESIGNATED'" &
+                         "(TRUE, 4, 2, ""ZZZZ"", 6)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+      END;
+ 
+      RESULT;
+ END C34007R;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007s.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007s.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007s.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,299 ----
+ -- C34007S.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+ --     PRIVATE TYPE WITH DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 09/30/86  CREATED ORIGINAL TEST.
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+ --                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+ --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+ --     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+ --                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007S IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG_D IS
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+ 
+           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                           PRIVATE;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT
+                           ) RETURN DESIGNATED;
+ 
+      PRIVATE
+ 
+           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                RECORD
+                     I : INTEGER := 2;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L) := (1 .. L => 'A');
+                               C : COMPONENT := 2;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+      END PKG_D;
+ 
+      USE PKG_D;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_BOOL (TRUE),
+                                           IDENT_INT (3));
+ 
+      PACKAGE PKG_P IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      X : T       := NEW DESIGNATED (TRUE, 3);
+      K : INTEGER := X'SIZE;
+      Y : T       := NEW DESIGNATED (TRUE, 3);
+      W : PARENT  := NEW DESIGNATED (TRUE, 3);
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           NULL;
+      END A;
+ 
+      PACKAGE BODY PKG_D IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT
+              ) RETURN DESIGNATED
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, C);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+      END PKG_D;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN NEW DESIGNATED'(CREATE (B, L, I, S, C, F));
+           END CREATE;
+ 
+      END PKG_P;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF X = NULL OR ELSE EQUAL (X.L, X.L) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW DESIGNATED'(CREATE (TRUE, 3, -1, "---", -1, -1.0));
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34007S", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "PRIVATE TYPE WITH DISCRIMINANTS");
+ 
+      Y.ALL := CREATE (TRUE, 3, 1, "ABC", 4, 1.0);
+      IF Y = NULL OR ELSE
+         Y.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) THEN
+           FAILED ("INCORRECT INITIALIZATION");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X /= Y THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= Y THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= Y THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
+      END IF;
+      X := T (W);
+      IF X = NULL OR ELSE X = Y OR ELSE
+         X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      X := IDENT (Y);
+      W := PARENT (X);
+      IF W = NULL OR ELSE
+         W.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) OR ELSE
+         T (W) /= Y THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+      END IF;
+ 
+      W := PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X));
+      IF W = NULL OR ELSE
+         W.ALL /= CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+      END IF;
+ 
+      IF IDENT (NULL) /= NULL OR X = NULL THEN
+           FAILED ("INCORRECT NULL");
+      END IF;
+ 
+      X := IDENT (NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0)));
+      IF (X = NULL OR ELSE X = Y OR ELSE
+          X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0)) OR
+         X = NEW DESIGNATED'(CREATE (FALSE, 3, 1, "XXX", 5, 4.0)) THEN
+           FAILED ("INCORRECT ALLOCATOR");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X.B /= TRUE OR X.L /= 3 OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+      END IF;
+ 
+      IF X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL /=
+         CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
+           FAILED ("INCORRECT .ALL (VALUE)");
+      END IF;
+ 
+      X.ALL := CREATE (TRUE, 3, 10, "ZZZ", 15, 1.0);
+      IF X /= Y OR Y.ALL /= CREATE (TRUE, 3, 10, "ZZZ", 15, 2.0) THEN
+           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := CREATE (TRUE, 3, 1, "ABC", 4, 1.0);
+      BEGIN
+           CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL :=
+                CREATE (FALSE, 2, 10, "ZZ", 7, 15.0);
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+      END;
+ 
+      X := IDENT (NULL);
+      BEGIN
+           IF X.ALL = CREATE (FALSE, 0, 0, "", 0, 0.0) THEN
+                FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+           ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+      END;
+ 
+      X := IDENT (Y);
+      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+         X = CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= Y OR NOT (X /= NULL) OR
+         NOT (X /= CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR
+         NOT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      A (X'ADDRESS);
+ 
+      IF T'SIZE < 1 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      BEGIN
+           IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+                FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                        "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                         "UNDEFINED STORAGE_SIZE (AI-00608)");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C34007S;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007u.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007u.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007u.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,266 ----
+ -- C34007U.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A PRIVATE TYPE
+ -- WITH DISCRIMINANTS:
+ 
+ --   CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE
+ --   DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
+ --   CONSTRAINED.
+ 
+ --   CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
+ --   IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- JRK 9/30/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007U IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      PACKAGE PKG_D IS
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+ 
+           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                           PRIVATE;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT
+                           ) RETURN DESIGNATED;
+ 
+      PRIVATE
+ 
+           TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                RECORD
+                     I : INTEGER := 2;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L) := (1 .. L => 'A');
+                               C : COMPONENT := 2;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+      END PKG_D;
+ 
+      USE PKG_D;
+ 
+      PACKAGE PKG_P IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             C : COMPONENT;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG_P;
+ 
+      USE PKG_P;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T := NEW DESIGNATED (TRUE, 3);
+      Y : S := NEW DESIGNATED (TRUE, 3);
+ 
+      PACKAGE BODY PKG_D IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT
+              ) RETURN DESIGNATED
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, C);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+      END PKG_D;
+ 
+      PACKAGE BODY PKG_P IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                C : COMPONENT;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN NEW DESIGNATED'(CREATE (B, L, I, S, C, F));
+           END CREATE;
+ 
+      END PKG_P;
+ 
+ BEGIN
+      TEST ("C34007U", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "PRIVATE TYPE WITH DISCRIMINANTS");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF CREATE (FALSE, 2, 3, "WW", 5, 6.0, X) . ALL /=
+         CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) OR
+         CREATE (FALSE, 2, 3, "WW", 5, 6.0, Y) . ALL /=
+         CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
+           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+      END IF;
+ 
+      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         Y.B /= TRUE OR Y.L /= 3 THEN
+           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+      END IF;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
+           Y := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
+           IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+              X.ALL /= Y.ALL THEN
+                FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := NEW DESIGNATED'" &
+                   "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+           IF X = NULL OR ELSE
+              X.ALL = CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := NEW DESIGNATED'" &
+                         "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := NEW DESIGNATED'" &
+                        "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+      END;
+ 
+      BEGIN
+           X := NEW DESIGNATED'(CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := NEW DESIGNATED'" &
+                   "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+           IF X = NULL OR ELSE
+              X.ALL = CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := NEW DESIGNATED'" &
+                         "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := NEW DESIGNATED'" &
+                        "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+      END;
+ 
+      BEGIN
+           Y := NEW DESIGNATED'(CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := NEW DESIGNATED'" &
+                   "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+           IF Y = NULL OR ELSE
+              Y.ALL = CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := NEW DESIGNATED'" &
+                         "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := NEW DESIGNATED'" &
+                        "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+      END;
+ 
+      BEGIN
+           Y := NEW DESIGNATED'(CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := NEW DESIGNATED'" &
+                   "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+           IF Y = NULL OR ELSE
+              Y.ALL = CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := NEW DESIGNATED'" &
+                         "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := NEW DESIGNATED'" &
+                        "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+      END;
+ 
+      RESULT;
+ END C34007U;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007v.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34007v.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34007v.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- C34007V.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+ --     ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS PART 2 OF 2 TESTS
+ --     WHICH COVER THE OBJECTIVE.  THE FIRST PART IS IN TEST C34007D.
+ 
+ -- HISTORY:
+ --     BCB 04/12/90  CREATED ORIGINAL TEST FROM SPLIT OF C34007D.ADA.
+ --     THS 09/18/90  REMOVED DECLARATION OF B, DELETED PROCEDURE A,
+ --                   AND REMOVED ALL REFERENCES TO B.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34007V IS
+ 
+      SUBTYPE COMPONENT IS INTEGER;
+ 
+      TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
+ 
+      SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) ..
+                                           IDENT_INT (7));
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS ACCESS DESIGNATED;
+ 
+           FUNCTION CREATE ( F, L  : NATURAL;
+                             C     : COMPONENT;
+                             DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+ 
+      X : T         := NEW SUBDESIGNATED'(OTHERS => 2);
+      K : INTEGER   := X'SIZE;
+      Y : T         := NEW SUBDESIGNATED'(1, 2, 3);
+      W : PARENT    := NEW SUBDESIGNATED'(OTHERS => 2);
+      C : COMPONENT := 1;
+      N : CONSTANT  := 1;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN NEW SUBDESIGNATED'(OTHERS => C);
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( F, L  : NATURAL;
+                C     : COMPONENT;
+                DUMMY : PARENT
+              ) RETURN PARENT
+           IS
+                A : PARENT    := NEW DESIGNATED (F .. L);
+                B : COMPONENT := C;
+           BEGIN
+                FOR I IN F .. L LOOP
+                     A (I) := B;
+                     B := B + 1;
+                END LOOP;
+                RETURN A;
+           END CREATE;
+ 
+      END PKG;
+ 
+      FUNCTION IDENT (X : T) RETURN T IS
+      BEGIN
+           IF X = NULL OR ELSE
+              EQUAL (X'LENGTH, X'LENGTH) THEN
+                RETURN X;                          -- ALWAYS EXECUTED.
+           END IF;
+           RETURN NEW SUBDESIGNATED;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C34007V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                       "ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS " &
+                       "PART 2 OF 2 TESTS WHICH COVER THE OBJECTIVE.  " &
+                       "THE FIRST PART IS IN TEST C34007V");
+ 
+      W := PARENT (CREATE (2, 3, 4, X));
+      IF W = NULL OR ELSE W.ALL /= (4, 5) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+      END IF;
+ 
+      X := IDENT (Y);
+      IF X.ALL /= (1, 2, 3) OR CREATE (2, 3, 4, X) . ALL /= (4, 5) THEN
+           FAILED ("INCORRECT .ALL (VALUE)");
+      END IF;
+ 
+      X.ALL := (10, 11, 12);
+      IF X /= Y OR Y.ALL /= (10, 11, 12) THEN
+           FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+      END IF;
+ 
+      Y.ALL := (1, 2, 3);
+      BEGIN
+           CREATE (2, 3, 4, X) . ALL := (10, 11);
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+      END;
+ 
+ 
+      X := IDENT (Y);
+      IF X (IDENT_INT (5)) /= 1 OR
+         CREATE (2, 3, 4, X) (3) /= 5 THEN
+           FAILED ("INCORRECT INDEX (VALUE)");
+      END IF;
+ 
+      Y.ALL := (1, 2, 3);
+      X := IDENT (Y);
+      BEGIN
+           CREATE (2, 3, 4, X) (2) := 10;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)");
+      END;
+ 
+      IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR
+         CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN
+           FAILED ("INCORRECT SLICE (VALUE)");
+      END IF;
+ 
+      Y.ALL := (1, 2, 3);
+      X := IDENT (Y);
+      BEGIN
+           CREATE (1, 4, 4, X) (2 .. 4) := (10, 11, 12);
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION FOR SLICE (ASSIGNMENT)");
+      END;
+ 
+      IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+         X = CREATE (2, 3, 4, X) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= Y OR NOT (X /= NULL) OR NOT (X /= CREATE (2, 3, 4, X)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR CREATE (2, 3, 4, X) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (CREATE (2, 3, 4, X) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      RESULT;
+ END C34007V;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,226 ----
+ -- C34008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED TASK TYPES.
+ 
+ -- HISTORY:
+ --     JRK 08/27/87  CREATED ORIGINAL TEST.
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ --     DTN 11/30/95  REMOVED ATTIBUTES OF NON-OBJECTS.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34008A IS
+ 
+      PACKAGE PKG IS
+ 
+           TASK TYPE PARENT IS
+                ENTRY E (I : IN OUT INTEGER);
+                ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER);
+                ENTRY G;
+                ENTRY H (1 .. 3);
+                ENTRY R (I : OUT INTEGER);
+                ENTRY W (I : INTEGER);
+           END PARENT;
+ 
+           FUNCTION ID (X : PARENT) RETURN INTEGER;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT;
+ 
+      TASK TYPE AUX;
+ 
+      X : T;
+      W : PARENT;
+      B : BOOLEAN := FALSE;
+      I : INTEGER := 0;
+      J : INTEGER := 0;
+      A1, A2 : AUX;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      FUNCTION V RETURN T IS
+      BEGIN
+           RETURN X;
+      END V;
+ 
+      PACKAGE BODY PKG IS
+ 
+           TASK BODY PARENT IS
+                N : INTEGER := 1;
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT E (I : IN OUT INTEGER) DO
+                               I := I + N;
+                          END E;
+                     OR
+                          ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO
+                               J := I + N;
+                          END F;
+                     OR
+                          ACCEPT G DO
+                               WHILE H(2)'COUNT < 2 LOOP
+                                    DELAY 5.0;
+                               END LOOP;
+                               ACCEPT H (2) DO
+                                    IF E'COUNT    /= 0 OR
+                                       F(1)'COUNT /= 0 OR
+                                       F(2)'COUNT /= 0 OR
+                                       F(3)'COUNT /= 0 OR
+                                       G'COUNT    /= 0 OR
+                                       H(1)'COUNT /= 0 OR
+                                       H(2)'COUNT /= 1 OR
+                                       H(3)'COUNT /= 0 OR
+                                       R'COUNT    /= 0 OR
+                                       W'COUNT    /= 0 THEN
+                                         FAILED ("INCORRECT 'COUNT");
+                                    END IF;
+                               END H;
+                               ACCEPT H (2);
+                          END G;
+                     OR
+                          ACCEPT R (I : OUT INTEGER) DO
+                               I := N;
+                          END R;
+                     OR
+                          ACCEPT W (I : INTEGER) DO
+                               N := I;
+                          END W;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END PARENT;
+ 
+           FUNCTION ID (X : PARENT) RETURN INTEGER IS
+                I : INTEGER;
+           BEGIN
+                X.R (I);
+                RETURN I;
+           END ID;
+ 
+      END PKG;
+ 
+      TASK BODY AUX IS
+      BEGIN
+           X.H (2);
+      END AUX;
+ 
+ BEGIN
+      TEST ("C34008A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED TASK " &
+                       "TYPES");
+ 
+      X.W (IDENT_INT (2));
+      IF ID (X) /= 2 THEN
+           FAILED ("INCORRECT INITIALIZATION");
+      END IF;
+ 
+      IF ID (T'(X)) /= 2 THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF ID (T (X)) /= 2 THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      W.W (IDENT_INT (3));
+      IF ID (T (W)) /= 3 THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF ID (PARENT (X)) /= 2 THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      I := 5;
+      X.E (I);
+      IF I /= 7 THEN
+           FAILED ("INCORRECT SELECTION (ENTRY)");
+      END IF;
+ 
+      I := 5;
+      X.F (IDENT_INT (2)) (I, J);
+      IF J /= 7 THEN
+           FAILED ("INCORRECT SELECTION (FAMILY)");
+      END IF;
+ 
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT OBJECT'ADDRESS");
+      END IF;
+ 
+      IF NOT X'CALLABLE THEN
+           FAILED ("INCORRECT OBJECT'CALLABLE");
+      END IF;
+ 
+      IF NOT V'CALLABLE THEN
+           FAILED ("INCORRECT VALUE'CALLABLE");
+      END IF;
+ 
+      X.G;
+ 
+      IF X'SIZE < T'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      IF T'STORAGE_SIZE < 0 THEN
+           FAILED ("INCORRECT TYPE'STORAGE_SIZE");
+      END IF;
+ 
+      IF X'STORAGE_SIZE < 0 THEN
+           FAILED ("INCORRECT OBJECT'STORAGE_SIZE");
+      END IF;
+ 
+      IF X'TERMINATED THEN
+           FAILED ("INCORRECT OBJECT'TERMINATED");
+      END IF;
+ 
+      IF V'TERMINATED THEN
+           FAILED ("INCORRECT VALUE'TERMINATED");
+      END IF;
+ 
+      RESULT;
+ END C34008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- C34009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITHOUT
+ --     DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 08/28/87  CREATED ORIGINAL TEST.
+ --     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34009A IS
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN PARENT;
+ 
+           FUNCTION CON (X : INTEGER) RETURN PARENT;
+ 
+      PRIVATE
+ 
+           TYPE PARENT IS NEW INTEGER;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT;
+ 
+      X : T;
+      K : INTEGER := X'SIZE;
+      W : PARENT;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN PARENT IS
+           BEGIN
+                RETURN PARENT (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION CON (X : INTEGER) RETURN PARENT IS
+           BEGIN
+                RETURN PARENT (X);
+           END CON;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34009A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "NON-LIMITED PRIVATE TYPES WITHOUT " &
+                       "DISCRIMINANTS");
+ 
+      X := CREATE (30);
+      IF X /= CON (30) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= CON (30) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= CON (30) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      W := CREATE (-30);
+      IF T (W) /= CON (-30) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF PARENT (X) /= CON (30) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF X = CON (0) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= CON (30) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      RESULT;
+ END C34009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,226 ----
+ -- C34009D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITH
+ --     DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 08/31/87  CREATED ORIGINAL TEST.
+ --     WMC 03/13/92  REVISED TYPE'SIZE CHECKS.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34009D IS
+ 
+      PACKAGE PKG IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS PRIVATE;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             J : INTEGER;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          S : STRING;
+                          J : INTEGER
+                        ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          F : FLOAT
+                        ) RETURN PARENT;
+ 
+      PRIVATE
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L);
+                               J : INTEGER;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      X : T;
+      W : PARENT;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, J);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (TRUE, L, I, S, J);
+           END CON;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                F : FLOAT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (FALSE, L, I, F);
+           END CON;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34009D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+ 
+      X := CON (TRUE, 3, 2, "AAA", 2);
+      W := CON (TRUE, 3, 2, "AAA", 2);
+ 
+      IF EQUAL (3, 3) THEN
+           X := CON (TRUE, 3, 1, "ABC", 4);
+      END IF;
+      IF X /= CON (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT :=");
+      END IF;
+ 
+      IF T'(X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF T (X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           W := CON (TRUE, 3, 1, "ABC", 4);
+      END IF;
+      IF T (W) /= CON (TRUE, 3, 1, "ABC", 4) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF PARENT (X) /= CON (TRUE, 3, 1, "ABC", 4) OR
+         PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
+         CON (FALSE, 2, 3, 6.0) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+      END IF;
+ 
+      IF X = CON (TRUE, 3, 1, "ABC", 5) OR
+         X = CON (FALSE, 2, 3, 6.0) THEN
+           FAILED ("INCORRECT =");
+      END IF;
+ 
+      IF X /= CON (TRUE, 3, 1, "ABC", 4) OR
+         NOT (X /= CON (FALSE, 2, 3, 6.0)) THEN
+           FAILED ("INCORRECT /=");
+      END IF;
+ 
+      IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED THEN
+           FAILED ("INCORRECT OBJECT'CONSTRAINED");
+      END IF;
+ 
+      IF T'SIZE <= 0 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE   < T'SIZE OR
+         X.B'SIZE < BOOLEAN'SIZE OR
+         X.L'SIZE < LENGTH'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34009D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,256 ----
+ -- C34009F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS:
+ 
+ --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
+ --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
+ --        IS CONSTRAINED.
+ 
+ --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
+ --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 08/31/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34009F IS
+ 
+      PACKAGE PKG IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS PRIVATE;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             J : INTEGER;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          S : STRING;
+                          J : INTEGER
+                        ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          F : FLOAT
+                        ) RETURN PARENT;
+ 
+      PRIVATE
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L);
+                               J : INTEGER;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, J);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (TRUE, L, I, S, J);
+           END CON;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                F : FLOAT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (FALSE, L, I, F);
+           END CON;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34009F", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+ 
+      X := CON (TRUE, 3, 2, "AAA", 2);
+      Y := CON (TRUE, 3, 2, "AAA", 2);
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) /=
+         CON (FALSE, 2, 3, 6.0) OR
+         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) /=
+         CON (FALSE, 2, 3, 6.0) THEN
+           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+      END IF;
+ 
+      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         Y.B /= TRUE OR Y.L /= 3 THEN
+           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+           FAILED ("INCORRECT 'CONSTRAINED");
+      END IF;
+ 
+      BEGIN
+           X := CON (TRUE, 3, 1, "ABC", 4);
+           Y := CON (TRUE, 3, 1, "ABC", 4);
+           IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+      END;
+ 
+      BEGIN
+           X := CON (FALSE, 3, 2, 6.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := CON (FALSE, 3, 2, 6.0)");
+           IF X = CON (FALSE, 3, 2, 6.0) THEN  -- USE X.
+                COMMENT ("X ALTERED -- X := CON (FALSE, 3, 2, 6.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := CON (FALSE, 3, 2, 6.0)");
+      END;
+ 
+      BEGIN
+           X := CON (TRUE, 4, 2, "ZZZZ", 6);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+           IF X = CON (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+      END;
+ 
+      BEGIN
+           Y := CON (FALSE, 3, 2, 6.0);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := CON (FALSE, 3, 2, 6.0)");
+           IF Y = CON (FALSE, 3, 2, 6.0) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- Y := CON (FALSE, 3, 2, 6.0)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := CON (FALSE, 3, 2, 6.0)");
+      END;
+ 
+      BEGIN
+           Y := CON (TRUE, 4, 2, "ZZZZ", 6);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+           IF Y = CON (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+      END;
+ 
+      RESULT;
+ END C34009F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,137 ----
+ -- C34009G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED LIMITED PRIVATE TYPES WITHOUT
+ --     DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 09/01/87  CREATED ORIGINAL TEST.
+ --     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34009G IS
+ 
+      PACKAGE PKG IS
+ 
+           TYPE PARENT IS LIMITED PRIVATE;
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN PARENT;
+ 
+           FUNCTION CON (X : INTEGER) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
+ 
+      PRIVATE
+ 
+           TYPE PARENT IS NEW INTEGER;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT;
+ 
+      X : T;
+      W : PARENT;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE (X : INTEGER) RETURN PARENT IS
+           BEGIN
+                RETURN PARENT (IDENT_INT (X));
+           END CREATE;
+ 
+           FUNCTION CON (X : INTEGER) RETURN PARENT IS
+           BEGIN
+                RETURN PARENT (X);
+           END CON;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34009G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
+ 
+      ASSIGN (X, CREATE (30));
+      IF NOT EQUAL (T'(X), CON (30)) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF NOT EQUAL (T (X), CON (30)) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      ASSIGN (W, CREATE (-30));
+      IF NOT EQUAL (T (W), CON (-30)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF NOT EQUAL (PARENT (X), CON (30)) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF NOT (X IN T) THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+      IF X'SIZE < T'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34009G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,225 ----
+ -- C34009J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+ --     (IMPLICITLY) FOR DERIVED LIMITED PRIVATE TYPES WITH
+ --     DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 09/01/87  CREATED ORIGINAL TEST.
+ --     WMC 03/13/92  REVISED TYPE'SIZE CHECKS.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34009J IS
+ 
+      PACKAGE PKG IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                       LIMITED PRIVATE;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             J : INTEGER;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          S : STRING;
+                          J : INTEGER
+                        ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          F : FLOAT
+                        ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
+ 
+      PRIVATE
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                RECORD
+                     I : INTEGER := 2;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L) := (1 .. L => 'A');
+                               J : INTEGER := 2;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      X : T;
+      W : PARENT;
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE A (X : ADDRESS) IS
+      BEGIN
+           B := IDENT_BOOL (TRUE);
+      END A;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, J);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (TRUE, L, I, S, J);
+           END CON;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                F : FLOAT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (FALSE, L, I, F);
+           END CON;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34009J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                       "LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+ 
+      IF EQUAL (3, 3) THEN
+           ASSIGN (X, CON (TRUE, 3, 1, "ABC", 4));
+      END IF;
+      IF NOT EQUAL (T'(X), CON (TRUE, 3, 1, "ABC", 4)) THEN
+           FAILED ("INCORRECT QUALIFICATION");
+      END IF;
+ 
+      IF NOT EQUAL (T (X), CON (TRUE, 3, 1, "ABC", 4)) THEN
+           FAILED ("INCORRECT SELF CONVERSION");
+      END IF;
+ 
+      IF EQUAL (3, 3) THEN
+           ASSIGN (W, CON (TRUE, 3, 1, "ABC", 4));
+      END IF;
+      IF NOT EQUAL (T (W), CON (TRUE, 3, 1, "ABC", 4)) THEN
+           FAILED ("INCORRECT CONVERSION FROM PARENT");
+      END IF;
+ 
+      IF NOT EQUAL (PARENT (X), CON (TRUE, 3, 1, "ABC", 4)) OR
+         NOT EQUAL (PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)),
+                    CON (FALSE, 2, 3, 6.0)) THEN
+           FAILED ("INCORRECT CONVERSION TO PARENT");
+      END IF;
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+         CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+           FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+      END IF;
+ 
+      IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) NOT IN T) THEN
+           FAILED ("INCORRECT ""NOT IN""");
+      END IF;
+ 
+      B := FALSE;
+      A (X'ADDRESS);
+      IF NOT B THEN
+           FAILED ("INCORRECT 'ADDRESS");
+      END IF;
+ 
+ 
+      IF NOT X'CONSTRAINED THEN
+           FAILED ("INCORRECT OBJECT'CONSTRAINED");
+      END IF;
+ 
+      IF T'SIZE <= 0 THEN
+           FAILED ("INCORRECT TYPE'SIZE");
+      END IF;
+ 
+      IF X'SIZE   < T'SIZE OR
+         X.B'SIZE < BOOLEAN'SIZE OR
+         X.L'SIZE < LENGTH'SIZE THEN
+           FAILED ("INCORRECT OBJECT'SIZE");
+      END IF;
+ 
+      RESULT;
+ END C34009J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34009l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34009l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,270 ----
+ -- C34009L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR DERIVED LIMITED PRIVATE TYPES WITH DISCRIMINANTS:
+ 
+ --        CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT
+ --        FOR THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION
+ --        IS CONSTRAINED.
+ 
+ --        CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS
+ --        ALSO IMPOSED ON THE DERIVED SUBTYPE.
+ 
+ -- HISTORY:
+ --     JRK 09/01/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34009L IS
+ 
+      PACKAGE PKG IS
+ 
+           MAX_LEN : CONSTANT := 10;
+ 
+           SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                       LIMITED PRIVATE;
+ 
+           FUNCTION CREATE ( B : BOOLEAN;
+                             L : LENGTH;
+                             I : INTEGER;
+                             S : STRING;
+                             J : INTEGER;
+                             F : FLOAT;
+                             X : PARENT  -- TO RESOLVE OVERLOADING.
+                           ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          S : STRING;
+                          J : INTEGER
+                        ) RETURN PARENT;
+ 
+           FUNCTION CON ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          F : FLOAT
+                        ) RETURN PARENT;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+ 
+           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
+ 
+      PRIVATE
+ 
+           TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                RECORD
+                     I : INTEGER := 2;
+                     CASE B IS
+                          WHEN TRUE =>
+                               S : STRING (1 .. L) := (1 .. L => 'A');
+                               J : INTEGER := 2;
+                          WHEN FALSE =>
+                               F : FLOAT := 5.0;
+                     END CASE;
+                END RECORD;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+ 
+      SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+ 
+      TYPE S IS NEW SUBPARENT;
+ 
+      X : T;
+      Y : S;
+ 
+      PACKAGE BODY PKG IS
+ 
+           FUNCTION CREATE
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER;
+                F : FLOAT;
+                X : PARENT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                CASE B IS
+                     WHEN TRUE =>
+                          RETURN (TRUE, L, I, S, J);
+                     WHEN FALSE =>
+                          RETURN (FALSE, L, I, F);
+                END CASE;
+           END CREATE;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                S : STRING;
+                J : INTEGER
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (TRUE, L, I, S, J);
+           END CON;
+ 
+           FUNCTION CON
+              ( B : BOOLEAN;
+                L : LENGTH;
+                I : INTEGER;
+                F : FLOAT
+              ) RETURN PARENT
+           IS
+           BEGIN
+                RETURN (FALSE, L, I, F);
+           END CON;
+ 
+           FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END EQUAL;
+ 
+           PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
+           BEGIN
+                X := Y;
+           END ASSIGN;
+ 
+      END PKG;
+ 
+ BEGIN
+      TEST ("C34009L", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
+                       "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
+                       "WHEN THE DERIVED TYPE DEFINITION IS " &
+                       "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
+                       "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
+                       "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
+                       "LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+ 
+      -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+ 
+      IF NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X),
+                    CON (FALSE, 2, 3, 6.0)) OR
+         NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y),
+                    CON (FALSE, 2, 3, 6.0)) THEN
+           FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+      END IF;
+ 
+      IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+         CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+           FAILED ("INCORRECT ""IN""");
+      END IF;
+ 
+      -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+ 
+      IF X.B /= TRUE OR X.L /= 3 OR
+         Y.B /= TRUE OR Y.L /= 3 THEN
+           FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+           FAILED ("INCORRECT 'CONSTRAINED");
+      END IF;
+ 
+      BEGIN
+           ASSIGN (X, CON (TRUE, 3, 1, "ABC", 4));
+           ASSIGN (Y, CON (TRUE, 3, 1, "ABC", 4));
+           IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+                FAILED ("INCORRECT CONVERSION TO PARENT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, CON (FALSE, 3, 2, 6.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
+           IF EQUAL (X, CON (FALSE, 3, 2, 6.0)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
+      END;
+ 
+      BEGIN
+           ASSIGN (X, CON (TRUE, 4, 2, "ZZZZ", 6));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+           IF EQUAL (X, CON (TRUE, 4, 2, "ZZZZ", 6)) THEN  -- USE X.
+                COMMENT ("X ALTERED -- " &
+                         "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, CON (FALSE, 3, 2, 6.0));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
+           IF EQUAL (Y, CON (FALSE, 3, 2, 6.0)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
+      END;
+ 
+      BEGIN
+           ASSIGN (Y, CON (TRUE, 4, 2, "ZZZZ", 6));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                   "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+           IF EQUAL (Y, CON (TRUE, 4, 2, "ZZZZ", 6)) THEN  -- USE Y.
+                COMMENT ("Y ALTERED -- " &
+                         "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED -- " &
+                        "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+      END;
+ 
+      RESULT;
+ END C34009L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34011b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34011b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34011b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,343 ----
+ -- C34011B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED TYPE DECLARATION IS NOT CONSIDERED EXACTLY
+ --     EQUIVALENT TO AN ANONYMOUS DECLARATION OF THE DERIVED TYPE
+ --     FOLLOWED BY A SUBTYPE DECLARATION OF THE DERIVED SUBTYPE.  IN
+ --     PARTICULAR, CHECK THAT CONSTRAINT_ERROR CAN BE RAISED WHEN THE
+ --     SUBTYPE INDICATION OF THE DERIVED TYPE DECLARATION IS ELABORATED
+ --     (EVEN THOUGH THE CONSTRAINT WOULD SATISFY THE DERIVED (BASE)
+ --     TYPE).
+ 
+ -- HISTORY:
+ --     JRK 09/04/87  CREATED ORIGINAL TEST.
+ --     EDS 07/29/98  AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34011B IS
+ 
+      SUBTYPE BOOL IS BOOLEAN RANGE FALSE .. FALSE;
+ 
+      SUBTYPE FLT IS FLOAT RANGE -10.0 .. 10.0;
+ 
+      SUBTYPE DUR IS DURATION RANGE 0.0 .. 10.0;
+ 
+      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+ 
+      TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
+ 
+      TYPE REC (D : INT := 0) IS
+           RECORD
+                I : INTEGER;
+           END RECORD;
+ 
+      PACKAGE PT IS
+           TYPE PRIV (D : POSITIVE := 1) IS PRIVATE;
+      PRIVATE
+           TYPE PRIV (D : POSITIVE := 1) IS
+                RECORD
+                     I : INTEGER;
+                END RECORD;
+      END PT;
+ 
+      USE PT;
+ 
+      TYPE ACC_ARR IS ACCESS ARR;
+ 
+      TYPE ACC_REC IS ACCESS REC;
+ 
+ BEGIN
+      TEST ("C34011B", "CHECK THAT CONSTRAINT_ERROR CAN BE RAISED " &
+                       "WHEN THE SUBTYPE INDICATION OF A DERIVED TYPE " &
+                       "DECLARATION IS ELABORATED");
+ 
+      BEGIN
+           DECLARE
+             TYPE T IS NEW BOOL RANGE FALSE .. BOOL(IDENT_BOOL(TRUE));
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T := T(IDENT_BOOL(TRUE));
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                              " AT PROPER PLACE - BOOL " & 
+                              T'IMAGE(T1) );   --USE T1);
+             END;
+ 
+             FAILED ("EXCEPTION NOT RAISED - BOOL");
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - BOOL");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - BOOL");
+      END;
+ 
+      BEGIN
+           DECLARE
+             TYPE T IS NEW POSITIVE RANGE IDENT_INT (0) .. 10;
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T := T(IDENT_INT(1));
+             BEGIN
+                  FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR - POSITIVE " &
+                              T'IMAGE(T1)); --USE T1
+             END;
+             FAILED ("EXCEPTION NOT RAISED - POSITIVE" );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - POSITIVE");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - POSITIVE");
+      END;
+ 
+      BEGIN
+           DECLARE
+             TYPE T IS NEW FLT RANGE 0.0 .. FLT(IDENT_INT(20));
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T := T(IDENT_INT(0));
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                        " AT PROPER PLACE " &
+                        T'IMAGE(T1) ); --USE T1
+ 
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                              " AT PROPER PLACE "); 
+             END;
+             FAILED ("EXCEPTION NOT RAISED - FLT" );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - FLT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - FLT");
+      END;
+ 
+      BEGIN
+           DECLARE
+             TYPE T IS NEW DUR RANGE DUR(IDENT_INT(-1)) .. 5.0;
+ 
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T := T(IDENT_INT(2));
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                        " AT PROPER PLACE " &
+                        T'IMAGE(T1) );  -- USE T1
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             END;
+             FAILED ("EXCEPTION NOT RAISED - DUR " );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - DUR");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - DUR");
+      END;
+ 
+      BEGIN
+           DECLARE
+             TYPE T IS NEW ARR (IDENT_INT (-1) .. 10);
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T := (OTHERS => IDENT_INT(3));
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
+                        "AT PROPER PLACE " &
+                        INTEGER'IMAGE(T1(1)) ); --USE T1
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             END;
+             FAILED ("EXCEPTION NOT RAISED - ARR " );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - ARR");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - ARR");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE T IS NEW REC (IDENT_INT (11));
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T;
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
+                              "AT PROPER PLACE " &
+                              INTEGER'IMAGE(T1.D) ); --USE T1
+             END;
+             FAILED ("EXCEPTION NOT RAISED - REC " );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - REC");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - REC");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE T IS NEW PRIV (IDENT_INT (0));  --RAISES C_E
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T;
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 
+                              "AT PROPER PLACE " &
+                              INTEGER'IMAGE(T1.D) ); --USE T1
+             END;
+             FAILED ("EXCEPTION NOT RAISED - PRIV " ); 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - PRIV");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - PRIV");
+      END;
+ 
+      BEGIN
+           DECLARE
+             TYPE T IS NEW ACC_ARR (0 .. IDENT_INT (11));  --RAISES C_E
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T;
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
+                              "AT PROPER PLACE " &
+                              INTEGER'IMAGE(T1(1)) ); --USE T1
+             END;
+             FAILED ("EXCEPTION NOT RAISED - ACC_ARR " );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - ACC_ARR");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - ACC_ARR");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE T IS NEW ACC_REC (IDENT_INT (-1));  --RAISES C_E
+ 
+           BEGIN
+             DECLARE
+                -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+                T1 : T;
+             BEGIN
+                FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+             EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 
+                              "AT PROPER PLACE " &
+                              INTEGER'IMAGE(T1.D) ); --USE T1
+             END;
+                 FAILED ("EXCEPTION NOT RAISED - ACC_REC " );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER ENTERED - ACC_REC");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - ACC_REC");
+      END;
+ 
+      RESULT;
+ END C34011B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34012a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34012a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34012a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C34012A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT DEFAULT EXPRESSIONS IN DERIVED RECORD TYPES AND
+ --     DERIVED SUBPROGRAMS ARE EVALUATED USING THE ENTITIES DENOTED BY
+ --     THE EXPRESSIONS IN THE PARENT TYPE.
+ 
+ -- HISTORY:
+ --     RJW 06/19/86  CREATED ORIGINAL TEST.
+ --     BCB 08/19/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
+ --                   PACKAGE B SO WOULD HAVE ONE CASE WHERE DEFAULT IS
+ --                   DECLARED BEFORE THE DERIVED TYPE DECLARATION.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34012A IS
+ 
+ BEGIN
+      TEST ("C34012A", "CHECK THAT DEFAULT EXPRESSIONS IN DERIVED " &
+                       "RECORD TYPES AND DERIVED SUBPROGRAMS ARE " &
+                       "EVALUATED USING THE ENTITIES DENOTED BY THE " &
+                       "EXPRESSIONS IN THE PARENT TYPE" );
+ 
+      DECLARE
+           PACKAGE P IS
+                X : INTEGER := 5;
+                TYPE REC IS
+                     RECORD
+                          C : INTEGER := X;
+                     END RECORD;
+           END P;
+ 
+           PACKAGE Q IS
+                X : INTEGER := 6;
+                TYPE NEW_REC IS NEW P.REC;
+                QVAR : NEW_REC;
+           END Q;
+ 
+           PACKAGE R IS
+                X : INTEGER := 7;
+                TYPE BRAND_NEW_REC IS NEW Q.NEW_REC;
+                RVAR : BRAND_NEW_REC;
+           END R;
+ 
+           USE Q;
+           USE R;
+      BEGIN
+           IF QVAR.C = 5 THEN
+                NULL;
+           ELSE
+                FAILED ( "INCORRECT VALUE FOR QVAR" );
+           END IF;
+ 
+           IF RVAR.C = 5 THEN
+                NULL;
+           ELSE
+                FAILED ( "INCORRECT VALUE FOR RVAR" );
+           END IF;
+      END;
+ 
+      DECLARE
+           PACKAGE A IS
+                TYPE T IS RANGE 1 .. 10;
+                DEFAULT : T := 5;
+                FUNCTION F (X : T := DEFAULT) RETURN T;
+           END A;
+ 
+           PACKAGE BODY A IS
+                FUNCTION F (X : T := DEFAULT) RETURN T IS
+                BEGIN
+                     RETURN X;
+                END F;
+           END A;
+ 
+           PACKAGE B IS
+                DEFAULT : A.T:= 6;
+                TYPE NEW_T IS NEW A.T;
+                BVAR : NEW_T := F;
+           END B;
+ 
+           PACKAGE C IS
+                TYPE BRAND_NEW_T IS NEW B.NEW_T;
+                DEFAULT : BRAND_NEW_T := 7;
+                CVAR : BRAND_NEW_T :=F;
+           END C;
+ 
+           USE B;
+           USE C;
+      BEGIN
+           IF BVAR = 5 THEN
+                NULL;
+           ELSE
+                FAILED ( "INCORRECT VALUE FOR BVAR" );
+           END IF;
+ 
+           IF CVAR = 5 THEN
+                NULL;
+           ELSE
+                FAILED ( "INCORRECT VALUE FOR CVAR" );
+           END IF;
+ 
+           DECLARE
+                VAR : BRAND_NEW_T := F;
+           BEGIN
+                IF VAR = 5 THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT VALUE FOR VAR" );
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END C34012A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,256 ----
+ -- C34014A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
+ --     DECLARED EXPLICITLY IN THE SAME VISIBLE PART.
+ 
+ -- HISTORY:
+ --     JRK 09/08/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014A IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION F RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION F RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (1));
+           END F;
+      END P;
+ 
+ BEGIN
+      TEST ("C34014A", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
+                       "THE SAME VISIBLE PART");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+                FUNCTION F RETURN QT;
+                TYPE QR IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+           PRIVATE
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION F RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END F;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 2 THEN
+                FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
+           END IF;
+ 
+           IF Z /= 2 THEN
+                FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+                FUNCTION G RETURN QT;
+                FUNCTION F RETURN QT RENAMES G;
+                TYPE QR IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+           PRIVATE
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
+                             "1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 2 THEN
+                FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 2");
+           END IF;
+ 
+           IF Z /= 2 THEN
+                FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           FUNCTION G RETURN T;
+ 
+           FUNCTION G RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (2));
+           END G;
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+                FUNCTION F IS NEW G (QT);
+                W : QT := F;
+           PRIVATE
+                TYPE QS IS NEW QT;
+                Z : QS := F;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
+                             "INSTANTIATION");
+                END IF;
+ 
+                IF W /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
+                             "INSTANTIATION - 1");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT DERIVED - " &
+                             "INSTANTIATION - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 2 THEN
+                FAILED ("NEW SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
+                        "2");
+           END IF;
+ 
+           IF Z /= 2 THEN
+                FAILED ("NEW SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
+                        "2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,259 ----
+ -- C34014C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
+ --     DECLARED EXPLICITLY IN THE PRIVATE PART.
+ 
+ -- HISTORY:
+ --     JRK 09/11/87  CREATED ORIGINAL TEST.
+ --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+ --     PWN 10/24/96  RESTORED CHECK WITH NEW ADA 95 RESULTS EXPECTED.
+ --     PWB.CTA 02/20/97  Made failure messages unique.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014C IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION F RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION F RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (1));
+           END F;
+      END P;
+ 
+ BEGIN
+      TEST ("C34014C", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
+                       "THE PRIVATE PART");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+           PRIVATE
+                FUNCTION F RETURN QT;
+                TYPE QR IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION F RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END F;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL");
+                END IF;
+ 
+             IF Z /= 2 THEN
+                  FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+             END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+           PRIVATE
+                FUNCTION G RETURN QT;
+                FUNCTION F RETURN QT RENAMES G;
+                TYPE QR IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING");
+                END IF;
+ 
+          IF Z /= 2 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - " &
+                             "1");
+          END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           FUNCTION G RETURN T;
+ 
+           FUNCTION G RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (2));
+           END G;
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+           PRIVATE
+                FUNCTION F IS NEW G (QT);
+                W : QT := F;
+                TYPE QS IS NEW QT;
+                Z : QS := F;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
+                             "INSTANTIATION - 1");
+                END IF;
+ 
+                IF W /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
+                             "INSTANTIATION");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("OLD SUBPROGRAM NOT DERIVED - " &
+                             "INSTANTIATION - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
+                        "2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
+                        "2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,257 ----
+ -- C34014E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
+ --     DECLARED EXPLICITLY IN THE PACKAGE BODY.
+ 
+ -- HISTORY:
+ --     JRK 09/15/87  CREATED ORIGINAL TEST.
+ --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+ --     PWN 04/11/96  Restored subtests in Ada95 legal format.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014E IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION F RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION F RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (1));
+           END F;
+      END P;
+ 
+ BEGIN
+      TEST ("C34014E", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
+                       "THE PACKAGE BODY");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION F RETURN QT;
+                TYPE QR IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+ 
+                FUNCTION F RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END F;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL");
+                END IF;
+ 
+             IF Z /= 2 THEN
+                  FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+             END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G RETURN QT;
+                FUNCTION F RETURN QT RENAMES G;
+                TYPE QR IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+ 
+                FUNCTION G RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - " &
+                             "1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           FUNCTION G RETURN T;
+ 
+           FUNCTION G RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (2));
+           END G;
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION F IS NEW G (QT);
+                W : QT := F;
+                TYPE QS IS NEW QT;
+                Z : QS := F;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
+                             "INSTANTIATION - 1");
+                END IF;
+ 
+                IF W /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
+                             "INSTANTIATION");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("OLD SUBPROGRAM NOT DERIVED - " &
+                             "INSTANTIATION - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
+                        "2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
+                        "2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- C34014G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC SUBPROGRAM IS LATER
+ --     DECLARED EXPLICITLY.
+ 
+ -- HISTORY:
+ --     JRK 09/16/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014G IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION F RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION F RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (1));
+           END F;
+      END P;
+ 
+ BEGIN
+      TEST ("C34014G", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC " &
+                       "SUBPROGRAM IS LATER DECLARED EXPLICITLY");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NO NEW SUBPROGRAM DECLARED EXPLICITLY");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := F;
+           PRIVATE
+                TYPE QS IS NEW QT;
+                Z : QS := F;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT VISIBLE - 1");
+                END IF;
+ 
+                IF Z /= 1 THEN
+                     FAILED ("OLD SUBPROGRAM NOT DERIVED - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT VISIBLE - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD SUBPROGRAM NOT DERIVED - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,208 ----
+ -- C34014H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+ --     PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A
+ --     HOMOGRAPHIC SUBPROGRAM IN THE VISIBLE PART.
+ 
+ -- HISTORY:
+ --     JRK 09/16/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014H IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION F RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION F RETURN T IS
+           BEGIN
+                RETURN T (IDENT_INT (1));
+           END F;
+      END P;
+ 
+ BEGIN
+      TEST ("C34014H", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                       "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " &
+                       "DECLARATION OF A HOMOGRAPHIC SUBPROGRAM IN " &
+                       "THE VISIBLE PART");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS PRIVATE;
+                C2 : CONSTANT QT;
+                FUNCTION F RETURN QT;
+                TYPE QR1 IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+           PRIVATE
+                TYPE QT IS NEW T;
+                C2 : CONSTANT QT := 2;
+                TYPE QR2 IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION F RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END F;
+ 
+                PACKAGE R IS
+                     X : QR1;
+                     Y : QR2;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                             "DECL - 2");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= C2 THEN
+                FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 3");
+           END IF;
+ 
+           IF Z /= RT (C2) THEN
+                FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS PRIVATE;
+                C2 : CONSTANT QT;
+                FUNCTION G RETURN QT;
+                FUNCTION F RETURN QT RENAMES G;
+                TYPE QR1 IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+           PRIVATE
+                TYPE QT IS NEW T;
+                C2 : CONSTANT QT := 2;
+                TYPE QR2 IS
+                     RECORD
+                          C : QT := F;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G RETURN QT IS
+                BEGIN
+                     RETURN QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     X : QR1;
+                     Y : QR2;
+                     Z : QS := F;
+                END R;
+                USE R;
+           BEGIN
+                IF X.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                             "2");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
+                             "1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := F;
+                TYPE RT IS NEW QT;
+                Z : RT := F;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= C2 THEN
+                FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 3");
+           END IF;
+ 
+           IF Z /= RT (C2) THEN
+                FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014n.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014n.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014n.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,256 ----
+ -- C34014N.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
+ --     DECLARED EXPLICITLY IN THE SAME VISIBLE PART.
+ 
+ -- HISTORY:
+ --     JRK 09/21/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014N IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION "+" (X : T) RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION "+" (X : T) RETURN T IS
+           BEGIN
+                RETURN X + T (IDENT_INT (1));
+           END "+";
+      END P;
+ 
+ BEGIN
+      TEST ("C34014N", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                       "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
+                       "THE SAME VISIBLE PART");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+                FUNCTION "+" (Y : QT) RETURN QT;
+                TYPE QR IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+           PRIVATE
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION "+" (Y : QT) RETURN QT IS
+                BEGIN
+                     RETURN Y + QT (IDENT_INT (2));
+                END "+";
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 2 THEN
+                FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
+           END IF;
+ 
+           IF Z /= 2 THEN
+                FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+                FUNCTION G (X : QT) RETURN QT;
+                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+                TYPE QR IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+           PRIVATE
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G (X : QT) RETURN QT IS
+                BEGIN
+                     RETURN X + QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - " &
+                             "1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 2 THEN
+                FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - 2");
+           END IF;
+ 
+           IF Z /= 2 THEN
+                FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           FUNCTION G (Y : T) RETURN T;
+ 
+           FUNCTION G (Y : T) RETURN T IS
+           BEGIN
+                RETURN Y + T (IDENT_INT (2));
+           END G;
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+                FUNCTION "+" IS NEW G (QT);
+                W : QT := +0;
+           PRIVATE
+                TYPE QS IS NEW QT;
+                Z : QS := +0;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - " &
+                             "INSTANTIATION");
+                END IF;
+ 
+                IF W /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - " &
+                             "INSTANTIATION - 1");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT DERIVED - " &
+                             "INSTANTIATION - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 2 THEN
+                FAILED ("NEW OPERATOR NOT VISIBLE - INSTANTIATION - " &
+                        "2");
+           END IF;
+ 
+           IF Z /= 2 THEN
+                FAILED ("NEW OPERATOR NOT DERIVED - INSTANTIATION - " &
+                        "2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,258 ----
+ -- C34014P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
+ --     DECLARED EXPLICITLY IN THE PRIVATE PART.
+ 
+ -- HISTORY:
+ --     JRK 09/22/87  CREATED ORIGINAL TEST.
+ --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+ --     PWN 04/11/96  Restored subtests in Ada95 legal format.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014P IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION "+" (X : T) RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION "+" (X : T) RETURN T IS
+           BEGIN
+                RETURN X + T (IDENT_INT (1));
+           END "+";
+      END P;
+ 
+ BEGIN
+      TEST ("C34014P", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                       "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
+                       "THE PRIVATE PART");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+           PRIVATE
+                FUNCTION "+" (Y : QT) RETURN QT;
+                TYPE QR IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION "+" (Y : QT) RETURN QT IS
+                BEGIN
+                     RETURN Y + QT (IDENT_INT (2));
+                END "+";
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                    FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+           PRIVATE
+                FUNCTION G (X : QT) RETURN QT;
+                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+                TYPE QR IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G (X : QT) RETURN QT IS
+                BEGIN
+                     RETURN X + QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING");
+                END IF;
+ 
+            IF Z /= 2 THEN
+                 FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - " &
+                             "1");
+            END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           FUNCTION G (Y : T) RETURN T;
+ 
+           FUNCTION G (Y : T) RETURN T IS
+           BEGIN
+                RETURN Y + T (IDENT_INT (2));
+           END G;
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+           PRIVATE
+                FUNCTION "+" IS NEW G (QT);
+                W : QT := +0;
+                TYPE QS IS NEW QT;
+                Z : QS := +0;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - " &
+                             "INSTANTIATION - 1");
+                END IF;
+ 
+                IF W /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - " &
+                             "INSTANTIATION");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("OLD OPERATOR NOT DERIVED - " &
+                             "INSTANTIATION - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD OPERATOR NOT VISIBLE - INSTANTIATION - " &
+                        "2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - INSTANTIATION - " &
+                        "2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014r.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014r.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014r.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,257 ----
+ -- C34014R.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
+ --     DECLARED EXPLICITLY IN THE PACKAGE BODY.
+ 
+ -- HISTORY:
+ --     JRK 09/22/87  CREATED ORIGINAL TEST.
+ --     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+ --     PWN 04/11/96  Restored subtests in Ada95 legal format.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014R IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION "+" (X : T) RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION "+" (X : T) RETURN T IS
+           BEGIN
+                RETURN X + T (IDENT_INT (1));
+           END "+";
+      END P;
+ 
+ BEGIN
+      TEST ("C34014R", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                       "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
+                       "THE PACKAGE BODY");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION "+" (Y : QT) RETURN QT;
+                TYPE QR IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+ 
+                FUNCTION "+" (Y : QT) RETURN QT IS
+                BEGIN
+                     RETURN Y + QT (IDENT_INT (2));
+                END "+";
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                    FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G (X : QT) RETURN QT;
+                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+                TYPE QR IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+ 
+                FUNCTION G (X : QT) RETURN QT IS
+                BEGIN
+                     RETURN X + QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     Y : QR;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING");
+                END IF;
+ 
+             IF Z /= 2 THEN
+                 FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - " &
+                             "1");
+             END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           FUNCTION G (Y : T) RETURN T;
+ 
+           FUNCTION G (Y : T) RETURN T IS
+           BEGIN
+                RETURN Y + T (IDENT_INT (2));
+           END G;
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION "+" IS NEW G (QT);
+                W : QT := +0;
+                TYPE QS IS NEW QT;
+                Z : QS := +0;
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - " &
+                             "INSTANTIATION - 1");
+                END IF;
+ 
+                IF W /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - " &
+                             "INSTANTIATION");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("OLD OPERATOR NOT DERIVED - " &
+                             "INSTANTIATION - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD OPERATOR NOT VISIBLE - INSTANTIATION - " &
+                        "2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - INSTANTIATION - " &
+                        "2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014R;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014t.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014t.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014t.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014t.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- C34014T.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC OPERATOR IS LATER
+ --     DECLARED EXPLICITLY.
+ 
+ -- HISTORY:
+ --     JRK 09/22/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014T IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION "+" (X : T) RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION "+" (X : T) RETURN T IS
+           BEGIN
+                RETURN X + T (IDENT_INT (1));
+           END "+";
+      END P;
+ 
+ BEGIN
+      TEST ("C34014T", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                       "VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC " &
+                       "OPERATOR IS LATER DECLARED EXPLICITLY");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NO NEW OPERATOR DECLARED EXPLICITLY");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS NEW T;
+                X : QT := +0;
+           PRIVATE
+                TYPE QS IS NEW QT;
+                Z : QS := +0;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT VISIBLE - 1");
+                END IF;
+ 
+                IF Z /= 1 THEN
+                     FAILED ("OLD OPERATOR NOT DERIVED - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +0;
+                TYPE RT IS NEW QT;
+                Z : RT := +0;
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= 1 THEN
+                FAILED ("OLD OPERATOR NOT VISIBLE - 2");
+           END IF;
+ 
+           IF Z /= 1 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014T;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014u.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34014u.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34014u.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,212 ----
+ -- C34014U.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DERIVED OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+ --     UNDER APPROPRIATE CIRCUMSTANCES.
+ 
+ --     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+ --     PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A
+ --     HOMOGRAPHIC OPERATOR IN THE VISIBLE PART.
+ 
+ -- HISTORY:
+ --     JRK 09/23/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C34014U IS
+ 
+      PACKAGE P IS
+           TYPE T IS RANGE -100 .. 100;
+           FUNCTION "+" (X : T) RETURN T;
+      END P;
+      USE P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION "+" (X : T) RETURN T IS
+           BEGIN
+                RETURN X + T (IDENT_INT (1));
+           END "+";
+      END P;
+ 
+ BEGIN
+      TEST ("C34014U", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                       "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                       "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                       "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                       "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " &
+                       "DECLARATION OF A HOMOGRAPHIC OPERATOR IN " &
+                       "THE VISIBLE PART");
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS PRIVATE;
+                C0 : CONSTANT QT;
+                C2 : CONSTANT QT;
+                FUNCTION "+" (Y : QT) RETURN QT;
+                TYPE QR1 IS
+                     RECORD
+                          C : QT := +C0;
+                     END RECORD;
+           PRIVATE
+                TYPE QT IS NEW T;
+                C0 : CONSTANT QT := 0;
+                C2 : CONSTANT QT := 2;
+                TYPE QR2 IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION "+" (Y : QT) RETURN QT IS
+                BEGIN
+                     RETURN Y + QT (IDENT_INT (2));
+                END "+";
+ 
+                PACKAGE R IS
+                     X : QR1;
+                     Y : QR2;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                             "DECL - 2");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG " &
+                             "DECL - 1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +C0;
+                TYPE RT IS NEW QT;
+                Z : RT := +RT(C0);
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= C2 THEN
+                FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG DECL - 3");
+           END IF;
+ 
+           IF Z /= RT (C2) THEN
+                FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+ 
+      DECLARE
+ 
+           PACKAGE Q IS
+                TYPE QT IS PRIVATE;
+                C0 : CONSTANT QT;
+                C2 : CONSTANT QT;
+                FUNCTION G (X : QT) RETURN QT;
+                FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+                TYPE QR1 IS
+                     RECORD
+                          C : QT := +C0;
+                     END RECORD;
+           PRIVATE
+                TYPE QT IS NEW T;
+                C0 : CONSTANT QT := 0;
+                C2 : CONSTANT QT := 2;
+                TYPE QR2 IS
+                     RECORD
+                          C : QT := +0;
+                     END RECORD;
+                TYPE QS IS NEW QT;
+           END Q;
+           USE Q;
+ 
+           PACKAGE BODY Q IS
+                FUNCTION G (X : QT) RETURN QT IS
+                BEGIN
+                     RETURN X + QT (IDENT_INT (2));
+                END G;
+ 
+                PACKAGE R IS
+                     X : QR1;
+                     Y : QR2;
+                     Z : QS := +0;
+                END R;
+                USE R;
+           BEGIN
+                IF X.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
+                             "1");
+                END IF;
+ 
+                IF Y.C /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
+                             "2");
+                END IF;
+ 
+                IF Z /= 2 THEN
+                     FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - " &
+                             "1");
+                END IF;
+           END Q;
+ 
+           PACKAGE R IS
+                Y : QT := +C0;
+                TYPE RT IS NEW QT;
+                Z : RT := +RT(C0);
+           END R;
+           USE R;
+ 
+      BEGIN
+           IF Y /= C2 THEN
+                FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - 3");
+           END IF;
+ 
+           IF Z /= RT (C2) THEN
+                FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - 2");
+           END IF;
+      END;
+ 
+      -----------------------------------------------------------------
+ 
+      RESULT;
+ END C34014U;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34018a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34018a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c34018a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c34018a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,154 ----
+ -- C34018A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CALLS OF DERIVED SUBPROGRAMS CHECK CONSTRAINTS OF THE
+ -- PARENT SUBPROGRAM, NOT THE CONSTRAINTS OF THE DERIVED SUBTYPE.
+ 
+ -- JBG 11/15/85
+ -- JRK 2/12/86   CORRECTED ERROR: RESOLVED AMBIGUOUS CALL G(41) TO
+ --               TYPE NEW_INT.
+ -- EDS 7/16/98   AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C34018A IS
+ 
+      PACKAGE P IS
+           TYPE INT IS RANGE 1..100;
+           SUBTYPE INT_50 IS INT RANGE 1..50;
+           SUBTYPE INT_51 IS INT RANGE 51..100;
+ 
+           FUNCTION "+" (L, R : INT) RETURN INT;
+           FUNCTION G (X : INT_50) RETURN INT_51;
+ 
+           TYPE STR IS ARRAY (1..10) OF CHARACTER;
+           FUNCTION F (X : STR) RETURN STR;
+      END P;
+ 
+      USE P;
+ 
+      TYPE NEW_STR IS NEW P.STR;
+      TYPE NEW_INT IS NEW P.INT RANGE 51..90;
+ 
+      PACKAGE BODY P IS
+ 
+           FUNCTION "+" (L, R : INT) RETURN INT IS
+           BEGIN
+                RETURN INT(INTEGER(L) + INTEGER(R));
+           END "+";
+ 
+           FUNCTION G (X : INT_50) RETURN INT_51 IS
+           BEGIN
+                RETURN X + 10;
+           END G;
+ 
+           FUNCTION F (X : STR) RETURN STR IS
+           BEGIN
+                RETURN X;
+           END F;
+ 
+      END P;
+ 
+ BEGIN
+ 
+      TEST ("C34018A", "CHECK CONSTRAINTS PROCESSED CORRECTLY FOR " &
+                       "CALLS OF DERIVED SUBPROGRAMS");
+ 
+      DECLARE
+ 
+           Y : NEW_STR := F("1234567890");    -- UNAMBIGUOUS.
+ 
+      BEGIN
+           IF Y /= "1234567890" THEN
+                FAILED ("DERIVED F");
+           END IF;
+      END;
+ 
+      DECLARE
+ 
+           A : INT := 51;
+           B : NEW_INT := NEW_INT(IDENT_INT(90));
+ 
+      BEGIN
+ 
+           BEGIN
+                A := A + 0;
+                FAILED ("NO EXCEPTION - A + 0 = " & INT'IMAGE(A) ); --Use A
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                IF B + 2 /= 92 THEN      -- 92 IN INT.
+                     FAILED ("WRONG RESULT - B + 2");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("WRONG CONSTRAINT FOR DERIVED ""+""");
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 2");
+           END;
+ 
+           BEGIN
+                IF B + 14 > 90 THEN      -- 104 NOT IN INT.
+                     FAILED ("NO EXCEPTION RAISED FOR DERIVED ""+""");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 3");
+           END;
+ 
+ 
+           BEGIN
+                IF G(B) > 90 THEN        -- 90 NOT IN INT_50.
+                     FAILED ("NO EXCEPTION RAISED FOR DERIVED G");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 4");
+           END;
+ 
+           BEGIN
+                IF C34018A.G(41) /= 51 THEN  -- 41 CONVERTED TO
+                                             --    NEW_INT'BASE.
+                                             -- 41 IN INT_50.
+                                             -- 51 IN INT_51.
+                     FAILED ("WRONG RESULT - G(41)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("C_E RAISED FOR LITERAL ARGUMENT");
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 5");
+           END;
+      END;
+ 
+      RESULT;
+ END C34018A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c340a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c340a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c340a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c340a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C340A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a tagged type declared in a package specification
+ --      may be passed as a generic formal (tagged) private type to a generic
+ --      package declaration. Check that the formal type may be extended with
+ --      a record extension in the generic package.
+ --
+ --      Check that, in the instance, the record extension inherits the
+ --      user-defined primitive subprograms of the tagged actual.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a tagged type and an associated primitive subprogram in a
+ --      package specification (foundation code). Declare a generic package
+ --      which takes a tagged type as a formal parameter, and then extends
+ --      it with a record extension (foundation code).
+ --      
+ --      Instantiate the generic package with the tagged type from the first
+ --      package (the "generic" extension should now have inherited
+ --      the primitive subprogram of the tagged type from the first
+ --      package).
+ -- 
+ --      In the main program, call the primitive subprogram inherited by the
+ --      "generic" extension, and verify the correctness of the components.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F340A000.A
+ --         F340A001.A
+ --      => C340A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Removed extraneous
+ --                          comments.
+ --
+ --!
+ 
+ with F340A001;        -- Book definitions.  
+ package C340A01_0 is  -- Raw data to be used in creating book elements.
+ 
+ 
+    Book_Count : constant := 3;
+ 
+    subtype Number_Of_Books is Integer range 1 .. Book_Count;
+ 
+    type Data_List is array (Number_Of_Books) of F340A001.Text_Ptr;
+ 
+    Title_List  : Data_List := (new String'("Wuthering Heights"),
+                                new String'("Heart of Darkness"),
+                                new String'("Ulysses"));
+ 
+    Author_List : Data_List := (new String'("Bronte, Emily"),
+                                new String'("Conrad, Joseph"),
+                                new String'("Joyce, James"));
+ 
+ end C340A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- Library-level instantiation. Actual parameter is tagged record.
+ 
+ with F340A001;  -- Book definitions.
+ with F340A000;  -- Singly-linked list abstraction.
+ package C340A01_1 is new F340A000 (Parent_Type => F340A001.Book_Type);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with F340A001;   -- Book definitions.
+ with C340A01_0;  -- Raw book data.
+ with C340A01_1;  -- Instance.
+ 
+ use  F340A001;   -- Primitive operations of Book_Type directly visible.
+ use  C340A01_1;  -- Operations inherited by Node_Type directly visible.
+ 
+ procedure C340A01 is
+ 
+ 
+    List_Of_Books : Node_Ptr := null;  -- Head of linked list of books.
+ 
+ 
+           --========================================================--
+ 
+ 
+    procedure Create_List (Title, Author : in     C340A01_0.Data_List;
+                           Head          : in out Node_Ptr) is
+ 
+       Book     : Node_Type;  -- Object of extended type.
+       Book_Ptr : Node_Ptr;
+ 
+    begin
+       for I in C340A01_0.Number_Of_Books loop
+          Create_Book (Title (I), Author (I), Book);    -- Call inherited
+                                                        -- operation.
+          Book_Ptr := new Node_Type'(Book);
+          Add (Book_Ptr, Head);
+       end loop;
+    end Create_List;
+ 
+ 
+           --========================================================--
+ 
+ 
+    function Bad_List_Contents return Boolean is
+    begin
+       return (List_Of_Books.Title.all            /= "Ulysses"           or
+               List_Of_Books.Author.all           /= "Joyce, James"      or
+               List_Of_Books.Next.Title.all       /= "Heart of Darkness" or
+               List_Of_Books.Next.Author.all      /= "Conrad, Joseph"    or
+               List_Of_Books.Next.Next.Title.all  /= "Wuthering Heights" or
+               List_Of_Books.Next.Next.Author.all /= "Bronte, Emily");
+    end Bad_List_Contents;
+ 
+ 
+           --========================================================--
+ 
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C340A01", "Inheritance of primitive operations: record " &
+                 "extension of formal tagged private type; actual is " &
+                 "an ultimate ancestor type");
+ 
+    -- Create linked list using inherited operation:
+    Create_List (C340A01_0.Title_List, C340A01_0.Author_List, List_Of_Books);
+ 
+    -- Verify results:
+    if Bad_List_Contents then
+       Report.Failed ("Wrong values after call to inherited operation");
+    end if;
+ 
+    Report.Result;
+ 
+ end C340A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c340a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c340a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c340a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c340a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,221 ----
+ -- C340A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a record extension (declared in a package specification) of
+ --      a tagged type (declared in a different package specification) may be
+ --      passed as a generic formal (tagged) private type to a generic package
+ --      declaration. Check that the formal type may be further extended with a
+ --      record extension in the generic package.
+ --
+ --      Check that, in the instance, the record extension inherits the
+ --      user-defined primitive subprograms of the tagged actual, including
+ --      those inherited by the actual from its parent.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a tagged type and an associated primitive subprogram in a
+ --      package specification (foundation code). Declare a record extension
+ --      of the tagged type and an associated primitive subprogram in a second
+ --      package specification. Declare a generic package which takes a tagged
+ --      type as a formal parameter, and then extends it with a record
+ --      extension (foundation code).
+ --      
+ --      Instantiate the generic package with the record extension from the
+ --      second package (the "generic" extension should now have inherited
+ --      the primitive subprograms of the record extension from the second
+ --      package).
+ -- 
+ --      In the main program, call the primitive subprograms inherited by the
+ --      "generic" extension. There are two: (1) Create_Book, declared for
+ --      the root tagged type in the first package (inherited by the record
+ --      extension of the second package, and then in turn by the "generic"
+ --      extension), and (2) Update_Pages, declared for the record extension
+ --      in the second package. Verify the correctness of the components.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F340A000.A
+ --         F340A001.A
+ --      => C340A02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Removed extraneous
+ --                          comments.
+ --
+ --!
+ 
+ with F340A001;        -- Book definitions.
+ package C340A02_0 is  -- Extended book abstraction.
+ 
+ 
+    type Detailed_Book_Type is new F340A001.Book_Type with record
+       Pages : Natural;                                        -- Record ext.
+    end record;                                                -- of root tagged
+                                                               -- type.
+ 
+    -- Inherits Create_Book from Book_Type.
+ 
+    procedure Update_Pages (Book  : in out Detailed_Book_Type; -- Primitive op.
+                            Pages : in     Natural);           -- of extension.
+ 
+ 
+ end C340A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C340A02_0 is
+ 
+ 
+    procedure Update_Pages (Book  : in out Detailed_Book_Type;
+                            Pages : in     Natural) is
+    begin
+       Book.Pages := Pages;
+    end Update_Pages;
+ 
+ 
+ end C340A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F340A001;        -- Book definitions.
+ package C340A02_1 is  -- Raw data to be used in creating book elements.
+ 
+ 
+    Book_Count : constant := 3;
+ 
+    subtype Number_Of_Books is Integer range 1 .. Book_Count;
+ 
+    type Data_List   is array (Number_Of_Books) of F340A001.Text_Ptr;
+    type Page_Counts is array (Number_Of_Books) of Natural;
+ 
+    Title_List  : Data_List   := (new String'("Wuthering Heights"),
+                                  new String'("Heart of Darkness"),
+                                  new String'("Ulysses"));
+ 
+    Author_List : Data_List   := (new String'("Bronte, Emily"),
+                                  new String'("Conrad, Joseph"),
+                                  new String'("Joyce, James"));
+ 
+    Page_List   : Page_Counts := (237, 215, 456);
+ 
+ end C340A02_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- Library-level instantiation. Actual parameter is record extension.
+ 
+ with C340A02_0;  -- Extended book abstraction.
+ with F340A000;   -- Singly-linked list abstraction.
+ package C340A02_2 is new F340A000
+   (Parent_Type => C340A02_0.Detailed_Book_Type);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with C340A02_0; -- Extended book abstraction.
+ with C340A02_1; -- Raw book data.
+ with C340A02_2; -- Instance.
+ 
+ use  C340A02_0; -- Primitive operations of Detailed_Book_Type directly visible.
+ use  C340A02_2; -- Operations inherited by Node_Type directly visible.
+ 
+ procedure C340A02 is
+ 
+ 
+    List_Of_Books : Node_Ptr := null;  -- Head of linked list of books.
+ 
+ 
+           --========================================================--
+ 
+ 
+    procedure Create_List (Title, Author : in     C340A02_1.Data_List;
+                           Pages         : in     C340A02_1.Page_Counts;
+                           Head          : in out Node_Ptr) is
+ 
+       Book     : Node_Type;  -- Object of extended type.
+       Book_Ptr : Node_Ptr;
+ 
+    begin
+       for I in C340A02_1.Number_Of_Books loop
+          Create_Book (Title (I), Author (I), Book);    -- Call twice-inherited
+                                                        -- operation.
+          Update_Pages (Book, Pages (I));               -- Call inherited op.
+          Book_Ptr := new Node_Type'(Book);
+          Add (Book_Ptr, Head);
+       end loop;
+    end Create_List;
+ 
+ 
+           --========================================================--
+ 
+ 
+    function Bad_List_Contents return Boolean is
+    begin
+       return (List_Of_Books.Title.all            /= "Ulysses"           or
+               List_Of_Books.Author.all           /= "Joyce, James"      or
+               List_Of_Books.Pages                /= 456                 or
+               List_Of_Books.Next.Title.all       /= "Heart of Darkness" or
+               List_Of_Books.Next.Author.all      /= "Conrad, Joseph"    or
+               List_Of_Books.Next.Pages           /= 215                 or
+               List_Of_Books.Next.Next.Title.all  /= "Wuthering Heights" or
+               List_Of_Books.Next.Next.Author.all /= "Bronte, Emily"     or
+               List_Of_Books.Next.Next.Pages      /= 237);
+ 
+    end Bad_List_Contents;
+ 
+ 
+           --========================================================--
+ 
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C340A02", "Inheritance of primitive operations: record " &
+                 "extension of formal tagged private type; actual is " &
+                 "a record extension");
+ 
+    -- Create linked list using inherited operation:
+    Create_List (C340A02_1.Title_List, C340A02_1.Author_List,
+                 C340A02_1.Page_List,  List_Of_Books);
+ 
+    -- Verify results:
+    if Bad_List_Contents then
+       Report.Failed ("Wrong values after call to inherited operations");
+    end if;
+ 
+    Report.Result;
+ 
+ end C340A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C341A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that formal parameters of a class-wide type can be passed 
+ --      values of any specific type within the class.
+ --
+ -- TEST DESCRIPTION:
+ --      Define an object of a root tagged type and of various types derived
+ --      from the root.  Define objects of the root class, and initialize them
+ --      by parameter association of objects of the specific types (root and 
+ --      extended types) within the class.
+ --
+ --      The particular root and extended types used in this abstraction are
+ --      defined in foundation code (F341A00.A), and are graphically displayed
+ --      as follows:
+ --
+ --           package Bank
+ --              type Account
+ --                  |
+ --                  |
+ --                  |
+ --               package Checking
+ --                  type Account
+ --                      |
+ --                      |
+ --                      | 
+ --                   package Interest_Checking
+ --                          type Account
+ --
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F341A00.A
+ --
+ --      The following files comprise this test:
+ --
+ --      => C341A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with F341A00_0;            -- package Bank
+ with F341A00_1;            -- package Checking
+ with F341A00_2;            -- package Interest_Checking
+ with Report;
+ 
+ procedure C341A01 is
+ 
+    package Bank              renames F341A00_0;
+    use type Bank.Dollar_Amount;
+    package Checking          renames F341A00_1;
+    package Interest_Checking renames F341A00_2;
+ 
+    Max_Accts    : constant := 3;
+    Bank_Balance : Bank.Dollar_Amount := 0.00;
+ 
+    -- Initialize objects of specific tagged types.
+    B_Acct  : Bank.Account              := (Current_Balance => 10.00); 
+    C_Acct  : Checking.Account          := (100.00, 10.00); 
+    IC_Acct : Interest_Checking.Account := (1000.00, 10.00, 0.030);
+ 
+    -- Define and initialize (by parameter association) objects of class-wide 
+    -- type originating from the root type (Bank.Account).
+ 
+    -- Define an account auditing procedure with a class-wide
+    -- variable that can hold a value of any object within the class.
+    procedure Audit (Next_Account : Bank.Account'Class) is
+    begin
+       Bank_Balance := Bank_Balance + Next_Account.Current_Balance;
+    end Audit;
+ 
+ 
+ begin  -- C341A01
+ 
+    Report.Test ("C341A01", "Check that objects of a class-wide type can " &
+                            "be initialized, by direct assignment, to a "  &
+                            "value of any specific type within the class" ); 
+ 
+    -- Perform nightly audit of total funds on deposit in bank.
+    Audit (B_Acct);
+    Audit (C_Acct);
+    Audit (IC_Acct);
+ 
+    if Bank_Balance /= 1110.00 then
+       Report.Failed ("Class-wide object processing failed");
+    end if;
+ 
+    Report.Result;
+ 
+ end C341A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C341A02.A
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- OBJECTIVE:
+  --      Check that class-wide objects can be reassigned with objects from 
+  --      the same specific type used to initialize them.
+  --
+  -- TEST DESCRIPTION:
+  --      Define new objects of specific types from within a class. Reassign
+  --      previously declared class-wide objects with the new specific type 
+  --      objects. Check that new assignments were performed.
+  --
+  --      The particular root and extended types used in this abstraction are
+  --      defined in foundation code (F341A00.A), and are graphically displayed
+  --      as follows:
+  --
+  --           package Bank
+  --              type Account
+  --                  |
+  --                  |
+  --                  |
+  --               package Checking
+  --                  type Account
+  --                      |
+  --                      |
+  --                      | 
+  --                   package Interest_Checking
+  --                          type Account
+  --
+  -- TEST FILES:
+  --      This test depends on the following foundation code:
+  --
+  --         F341A00.A
+  --
+  --      The following files comprise this test:
+  --
+  --      => C341A02.A
+  --
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  with F341A00_0;            -- package Bank
+  with F341A00_1;            -- package Checking
+  with F341A00_2;            -- package Interest_Checking
+  with Report;
+  
+  procedure C341A02 is
+  
+     package Bank              renames F341A00_0;
+     package Checking          renames F341A00_1;
+     package Interest_Checking renames F341A00_2;
+  
+     Max_Accts    : constant := 3;
+     Bank_Balance : Bank.Dollar_Amount := 0.00;
+  
+     -- Define and initialize objects of specific types.
+     B_Acct      : aliased Bank.Account := (Current_Balance => 10.00); 
+     C_Acct      : aliased Checking.Account          := (100.00, 10.00); 
+     IC_Acct     : aliased Interest_Checking.Account := (1000.00, 10.00, 0.030);
+     New_B_Acct  : aliased Bank.Account := (Current_Balance => 20.00);
+     New_C_Acct  : aliased Checking.Account          := (200.00,  20.00);
+     New_IC_Acct : aliased Interest_Checking.Account := (2000.00, 20.00, 0.060);
+  
+  
+     -- Define and initialize (by direct assignment) objects of a class-wide 
+     -- type originating from the root type (Bank.Account).
+     
+     type ATM_Card is access all Bank.Account'Class;
+  
+     Accounts : array (1 .. Max_Accts) of ATM_Card := 
+       (1 => B_Acct'Access, 2 => C_Acct'Access, 3 => IC_Acct'Access);
+  
+     New_Accounts : array (1 .. Max_Accts) of ATM_Card := 
+       (1 => New_B_Acct'Access,
+        2 => New_C_Acct'Access,
+        3 => New_IC_Acct'Access);
+  
+     -- Define an account auditing procedure with a class-wide
+     -- variable that can hold a value of any object within the class,
+     -- and once initialized, can hold other values of the same specific type.
+  
+     procedure Audit (Num : in     integer;
+                      Amt :    out Bank.Dollar_Amount) is
+        Account_Being_Audited : Bank.Account'Class := Accounts(Num).all;
+        use type Bank.Dollar_Amount;
+     begin
+        Amt := Account_Being_Audited.Current_Balance;
+        -- Reassign class-wide variable to another object of the type used to
+        -- initialize it.
+        Account_Being_Audited := New_Accounts(Num).all;
+        Amt := Amt + Account_Being_Audited.Current_Balance;  -- Reading OUT
+     end Audit;                                              -- parameter.
+  
+  
+  begin 
+  
+     Report.Test ("C341A02", "Check that class-wide objects can be "  &
+                             "reassigned with objects from the same " &
+                             "specific type used to initialize them" );
+     Night_Audit:
+     declare
+        use type Bank.Dollar_Amount;
+        Acct_Value : Bank.Dollar_Amount := 0.00;
+     begin
+        -- Perform nightly audit of total funds on deposit in bank.
+        for i in 1 .. Max_Accts loop
+           Audit (i, Acct_Value);
+           Bank_Balance := Bank_Balance + Acct_Value;
+        end loop;
+  
+        if Bank_Balance /= 3330.00 then
+           Report.Failed ("Class-wide object processing failed");
+        end if;
+  
+     end Night_Audit;
+  
+     Report.Result;
+  
+  end C341A02;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,140 ----
+ -- C341A03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an object of one class-wide type can initialize a 
+ --      class-wide object of a different type when the operation is embedded
+ --      in a generic unit.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare specific-type objects of an extended type.  Declare an array
+ --      of access values designating class-wide objects, initialized to point
+ --      to the objects of the specific type.  Define a generic subprogram
+ --      having a generic formal derived type parameter.  Within the generic,
+ --      declare a class-wide variable of the formal parameter type.  Verify
+ --      that the variable can be initialized with the value of an object
+ --      of another class-wide type within the class.
+ --
+ --      The particular root and extended types used in this abstraction are
+ --      defined in foundation code (F341A00.A), and are graphically displayed
+ --      as follows:
+ --
+ --           package Bank
+ --              type Account
+ --                  |
+ --                  |
+ --                  |
+ --               package Checking
+ --                  type Account
+ --                      |
+ --                      |
+ --                      | 
+ --                   package Interest_Checking
+ --                          type Account
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F341A00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Dec 94   SAIC    Changed level of 'Class for ATM_Card
+ --
+ --!
+ 
+ with F341A00_0;            -- package Bank
+ generic
+    type Account_Type is new F341A00_0.Account with private; -- new Bank.Account
+ function C341A03_0 (The_Account : Account_Type'Class)       -- function Audit
+   return F341A00_0.Dollar_Amount;
+ 
+ function C341A03_0 (The_Account : Account_Type'Class)
+   return F341A00_0.Dollar_Amount is
+    Acct : Account_Type'Class := The_Account;  -- Init. of class-wide with
+ begin                                         -- another class-wide object.
+    return Acct.Current_Balance;
+ end C341A03_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with F341A00_0;            -- package Bank
+ with F341A00_1;            -- package Checking
+ with C341A03_0;            -- generic function Audit
+ with Report;
+ 
+ procedure C341A03 is
+ 
+    package Bank     renames F341A00_0;
+    package Checking renames F341A00_1;
+ 
+    Current_Checking_Accounts : constant := 3;
+ 
+    Checking_Acct1 : aliased Checking.Account := (Current_Balance => 10.00,
+                                                  Overdraft_Fee   =>  5.00);
+    Checking_Acct2 : aliased Checking.Account := (Current_Balance => 20.00,
+                                                  Overdraft_Fee   =>  5.00);
+    Checking_Acct3 : aliased Checking.Account := (Current_Balance => 30.00,
+                                                  Overdraft_Fee   =>  5.00);
+ 
+    type ATM_Card is access all Checking.Account'Class;
+ 
+    -- Declare array of accesses to class-wide objects.
+    Account_Array : array (1 .. Current_Checking_Accounts) of 
+      ATM_Card := (Checking_Acct1'Access, 
+                   Checking_Acct2'Access, 
+                   Checking_Acct3'Access);
+ begin  -- C341A03
+ 
+    Report.Test ("C341A03",  "Check that an object of one class-wide type " &
+                             "can initialize a class-wide object of a "   &
+                             "different type when the operation is embedded " &
+                             "in a generic unit" );
+ 
+    Audit_Checking_Accounts:
+    declare
+       Balance_In_Checking_Accounts : Bank.Dollar_Amount := 0.00;
+       -- Instantiate with a specific extended type.
+       function Checking_Audit is new C341A03_0 (Checking.Account);
+       use type Bank.Dollar_Amount;
+    begin
+ 
+       for I in 1 .. Current_Checking_Accounts loop
+          Balance_In_Checking_Accounts := Balance_In_Checking_Accounts + 
+            Checking_Audit (Account_Array (I).all);
+       end loop;
+ 
+       if Balance_In_Checking_Accounts /= 60.00 then
+          Report.Failed ("Incorrect initialization of class-wide object");
+       end if;
+ 
+    end Audit_Checking_Accounts;
+ 
+    Report.Result;
+ 
+ end C341A03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a04.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a04.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c341a04.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c341a04.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,141 ----
+ -- C341A04.A
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- OBJECTIVE:
+  --      Check that class-wide objects can be initialized using allocation. 
+  --
+  -- TEST DESCRIPTION:
+  --      Declare access types that refer to class-wide types, one with basis
+  --      of the root type, another with basis of a type extended from the root.
+  --      Declare objects of these access types, and allocate class-wide
+  --      objects, initialized to values of specific types within the particular
+  --      classes.
+  --
+  --      The particular root and extended types used in this abstraction are
+  --      defined in foundation code (F341A00.A), and are graphically displayed
+  --      as follows:
+  --
+  --           package Bank
+  --              type Account
+  --                  |
+  --                  |
+  --                  |
+  --               package Checking
+  --                  type Account
+  --                      |
+  --                      |
+  --                      | 
+  --                   package Interest_Checking
+  --                          type Account
+  --
+  -- TEST FILES:
+  --      This test depends on the following foundation code:
+  --
+  --         F341A00.A
+  --
+  --      The following files comprise this test:
+  --
+  --      => C341A04.A
+  --
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  with F341A00_0;            -- package Bank
+  with F341A00_1;            -- package Checking
+  with F341A00_2;            -- package Interest_Checking
+  with Report;
+  
+  procedure C341A04 is
+  
+     package Bank              renames F341A00_0;
+     package Checking          renames F341A00_1;
+     package Interest_Checking renames F341A00_2;
+  
+     use type Bank.Dollar_Amount;
+  
+     Max_Accts    : constant := 3;
+     Bank_Balance : Bank.Dollar_Amount := 0.00;
+  
+     -- Define access types referring to class of types rooted at 
+     -- Bank.Account (root). 
+  
+     type Bank_Account_Pointer is access Bank.Account'Class;
+  
+     --
+     -- Define class-wide objects, initializing them through allocation.
+     --
+  
+     -- Initialized to specific type that is basis of class.
+     Bank_Acct : Bank_Account_Pointer :=
+       new Bank.Account'(Current_Balance => 10.00);
+  
+     -- Initialized to specific type that has been extended from the basis
+     -- of the class.
+     Checking_Acct : Bank_Account_Pointer :=
+       new Checking.Account'(Current_Balance => 100.00,
+                             Overdraft_Fee   =>  10.00);
+  
+     -- Initialized to specific type that has been twice extended from the
+     -- basis of the class.
+     IC_Acct : Bank_Account_Pointer := 
+       new Interest_Checking.Account'(Current_Balance => 1000.00,
+                                      Overdraft_Fee   =>   10.00,
+                                      Rate            =>    0.030);
+  
+     -- Declare and initialize array of pointers to objects of
+     -- Bank.Account'Class.
+  
+     Accounts : array (1 .. Max_Accts) of Bank_Account_Pointer :=
+       (Bank_Acct, Checking_Acct, IC_Acct);
+  
+  
+     -- Audit will process any account object within Bank.Account'Class.
+  
+     function Audit (Ptr : Bank_Account_Pointer) return Bank.Dollar_Amount is
+     begin
+        return (Ptr.Current_Balance);
+     end Audit;
+  
+  
+  begin  -- C341A04
+  
+     Report.Test ("C341A04", "Check that class-wide objects were " &
+                             "successfully initialized using allocation" );
+  
+     for i in 1 .. Max_Accts loop
+        Bank_Balance := Bank_Balance + Audit (Accounts(i));
+     end loop;
+  
+     if Bank_Balance /= 1110.00 then
+        Report.Failed ("Failed class-wide object allocation");
+     end if;
+  
+     Report.Result;
+  
+  end C341A04;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,234 ----
+ -- C35003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR AN INTEGER OR
+ --     ENUMERATION SUBTYPE INDICATION WHEN THE LOWER OR UPPER BOUND
+ --     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
+ 
+ -- HISTORY:
+ --     JET 01/25/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35003A IS
+ 
+      TYPE ENUM IS (ZERO, ONE, TWO, THREE);
+      SUBTYPE SUBENUM IS ENUM RANGE ONE..TWO;
+      TYPE INT IS RANGE 1..10;
+      SUBTYPE SUBINT IS INTEGER RANGE -10..10;
+      TYPE A1 IS ARRAY (0..11) OF INTEGER;
+      TYPE A2 IS ARRAY (INTEGER RANGE -11..10) OF INTEGER;
+ 
+ BEGIN
+      TEST ("C35003A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR AN " &
+                       "INTEGER OR ENUMERATION SUBTYPE INDICATION " &
+                       "WHEN THE LOWER OR UPPER BOUND OF A NON-NULL " &
+                       "RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK");
+      BEGIN
+           DECLARE
+                SUBTYPE SUBSUBENUM IS SUBENUM RANGE ZERO..TWO;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (E1)");
+                DECLARE
+                     Z : SUBSUBENUM := ONE;
+                BEGIN
+                     IF NOT EQUAL(SUBSUBENUM'POS(Z),SUBSUBENUM'POS(Z))
+                     THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (E1)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (E1)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (SUBENUM RANGE ONE..THREE) OF INTEGER;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (E2)");
+                DECLARE
+                     Z : A := (OTHERS => 0);
+                BEGIN
+                     IF NOT EQUAL(Z(ONE),Z(ONE)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (E2)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (E2)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE I IS ACCESS INT RANGE INT(IDENT_INT(0))..10;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (I1)");
+                DECLARE
+                     Z : I := NEW INT'(1);
+                BEGIN
+                     IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (I1)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (I1)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE I IS NEW INT RANGE 1..INT'SUCC(10);
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (I2)");
+                DECLARE
+                     Z : I := 1;
+                BEGIN
+                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (I2)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (I2)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE R IS RECORD
+                     A : SUBINT RANGE IDENT_INT(-11)..0;
+                END RECORD;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (S1)");
+                DECLARE
+                     Z : R := (A => 1);
+                BEGIN
+                     IF NOT EQUAL(INTEGER(Z.A),INTEGER(Z.A)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (S1)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (S1)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                Z : SUBINT RANGE 0..IDENT_INT(11) := 0;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (S2)");
+                IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                     COMMENT ("DON'T OPTIMIZE Z");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (S2)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (S2)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE I IS SUBINT RANGE A1'RANGE;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (R1)");
+                DECLARE
+                     Z : I := 1;
+                BEGIN
+                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (R1)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (R1)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE I IS SUBINT RANGE A2'RANGE;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (R2)");
+                DECLARE
+                     Z : I := 1;
+                BEGIN
+                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (R2)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (R2)");
+      END;
+ 
+      RESULT;
+ 
+ END C35003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35003b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35003b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35003b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,217 ----
+ -- C35003B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A SUBTYPE INDICATION
+ --     OF A DISCRETE GENERIC FORMAL TYPE WHEN THE LOWER OR UPPER BOUND
+ --     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
+ 
+ -- HISTORY:
+ --     JET 07/08/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35003B IS
+ 
+      TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
+      TYPE INT IS RANGE -10..10;
+ 
+      GENERIC
+           TYPE GEN_ENUM IS (<>);
+           TYPE GEN_INT IS RANGE <>;
+      PACKAGE GEN_PACK IS
+           SUBTYPE SUBENUM IS GEN_ENUM RANGE
+                GEN_ENUM'SUCC(GEN_ENUM'FIRST) ..
+                GEN_ENUM'PRED(GEN_ENUM'LAST);
+           SUBTYPE SUBINT IS GEN_INT RANGE
+                GEN_INT'SUCC(GEN_INT'FIRST) ..
+                GEN_INT'PRED(GEN_INT'LAST);
+           TYPE A1 IS ARRAY (0..GEN_INT'LAST) OF INTEGER;
+           TYPE A2 IS ARRAY (GEN_INT RANGE GEN_INT'FIRST..0) OF INTEGER;
+      END GEN_PACK;
+ 
+      PACKAGE BODY GEN_PACK IS
+      BEGIN
+           TEST ("C35003B", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                            "FOR A SUBTYPE INDICATION OF A DISCRETE " &
+                            "GENERIC FORMAL TYPE WHEN THE LOWER OR " &
+                            "UPPER BOUND OF A NON-NULL RANGE LIES " &
+                            "OUTSIDE THE RANGE OF THE TYPE MARK");
+           BEGIN
+                DECLARE
+                     SUBTYPE SUBSUBENUM IS SUBENUM RANGE
+                          GEN_ENUM'FIRST..SUBENUM'LAST;
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED (E1)");
+                     DECLARE
+                          Z : SUBSUBENUM := SUBENUM'FIRST;
+                     BEGIN
+                          IF NOT EQUAL(SUBSUBENUM'POS(Z),
+                                       SUBSUBENUM'POS(Z)) THEN
+                               COMMENT ("DON'T OPTIMIZE Z");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG " &
+                                  "PLACE (E1)");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED (E1)");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE A IS ARRAY (SUBENUM RANGE SUBENUM'FIRST ..
+                          GEN_ENUM'LAST) OF INTEGER;
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED (E2)");
+                     DECLARE
+                          Z : A := (OTHERS => 0);
+                     BEGIN
+                          IF NOT EQUAL(Z(SUBENUM'FIRST),
+                                       Z(SUBENUM'FIRST)) THEN
+                               COMMENT ("DON'T OPTIMIZE Z");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                  "(E2)");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED (E2)");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE I IS ACCESS SUBINT RANGE
+                          GEN_INT'FIRST..SUBINT'LAST;
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED (I1)");
+                     DECLARE
+                          Z : I := NEW SUBINT'(SUBINT'FIRST);
+                     BEGIN
+                          IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL))
+                          THEN
+                               COMMENT ("DON'T OPTIMIZE Z");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                  "(I1)");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED (I1)");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE I IS NEW
+                          SUBINT RANGE SUBINT'FIRST..GEN_INT'LAST;
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED (I2)");
+                     DECLARE
+                          Z : I := I'FIRST;
+                     BEGIN
+                          IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                               COMMENT ("DON'T OPTIMIZE Z");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                  "(I2)");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED (I2)");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE I IS SUBINT RANGE A1'RANGE;
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED (R1)");
+                     DECLARE
+                          Z : I := SUBINT'FIRST;
+                     BEGIN
+                          IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                               COMMENT ("DON'T OPTIMIZE Z");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                  "(R1)");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED (R1)");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE I IS SUBINT RANGE A2'RANGE;
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED (R2)");
+                     DECLARE
+                          Z : I := 1;
+                     BEGIN
+                          IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                               COMMENT ("DON'T OPTIMIZE Z");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                  "(R2)");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED (R2)");
+           END;
+      END GEN_PACK;
+ 
+      PACKAGE ENUM_PACK IS NEW GEN_PACK(ENUM, INT);
+ 
+ BEGIN
+      RESULT;
+ END C35003B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35003d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35003d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35003d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35003d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C35003D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A FLOATING-POINT
+ --     SUBTYPE INDICATION WHEN THE LOWER OR UPPER BOUND OF A NON-NULL
+ --     RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
+ 
+ -- HISTORY:
+ --     JET 07/11/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35003D IS
+ 
+      SUBTYPE FLT1 IS FLOAT RANGE -100.0 .. 100.0;
+ 
+ BEGIN
+      TEST ("C35003D", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                       "FLOATING-POINT SUBTYPE INDICATION WHEN THE " &
+                       "LOWER OR UPPER BOUND OF A NON-NULL RANGE LIES " &
+                       "OUTSIDE THE RANGE OF THE TYPE MARK");
+      BEGIN
+           DECLARE
+                SUBTYPE F IS FLT1 RANGE 0.0..101.0+FLT1(IDENT_INT(0));
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (F1)");
+                DECLARE
+                     Z : F := 1.0;
+                BEGIN
+                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (F1)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (F1)");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE F IS FLT1 RANGE -101.0..0.0;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED (F2)");
+                DECLARE
+                     Z : F := -1.0;
+                BEGIN
+                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                          COMMENT ("DON'T OPTIMIZE Z");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (F2)");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED (F2)");
+      END;
+ 
+      RESULT;
+ 
+ END C35003D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35102a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35102a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35102a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,364 ----
+ -- C35102A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ENUMERATION LITERAL BELONGING TO ONE ENUMERATION TYPE
+ -- MAY BE DECLARED IN ANOTHER ENUMERATION TYPE DEFINITION IN THE SAME
+ -- DECLARATIVE REGION.
+ 
+ -- R.WILLIAMS 8/20/86
+ -- GMT 6/30/87           MOVED THE CALL TO  REPORT.TEST INTO A NEWLY
+ --                       CREATED PACKAGE NAMED SHOW_TEST_HEADER.
+ --                       ADDED CODE FOR MY_PACK AND MY_FTN.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35102A IS
+ 
+      TYPE E1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+      TYPE E2 IS ('A', 'C', RED, BLUE);
+ 
+      PACKAGE  SHOW_TEST_HEADER  IS
+               -- PURPOSE OF THIS PACKAGE:
+               -- WE WANT THE TEST HEADER INFORMATION TO BE
+               -- PRINTED  BEFORE  ANY OF THE  PASS/FAIL  MESSAGES.
+      END SHOW_TEST_HEADER;
+ 
+      PACKAGE  BODY  SHOW_TEST_HEADER  IS
+      BEGIN
+           TEST ( "C35102A",
+                  "CHECK THAT AN ENUMERATION LITERAL BELONGING "   &
+                  "TO ONE ENUMERATION TYPE MAY BE DECLARED IN "    &
+                  "ANOTHER ENUMERATION TYPE DEFINITION IN THE "    &
+                  "SAME DECLARATIVE REGION" );
+      END SHOW_TEST_HEADER;
+ 
+      FUNCTION  MY_FTN (  E : E1  ) RETURN  E2  IS
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN MY_FTN - 1" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN MY_FTN - 1" );
+           END IF;
+ 
+           RETURN E2'VAL (  IDENT_INT ( E1'POS(E) )  );
+      END MY_FTN;
+ 
+ 
+      PACKAGE MY_PACK IS
+      END MY_PACK;
+ 
+      PACKAGE BODY MY_PACK IS
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+      BEGIN  -- MY_PACK
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN MY_PACK - 1" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN MY_PACK - 1" );
+           END IF;
+      END MY_PACK;
+ 
+      PACKAGE PKG IS
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+ 
+      END PKG;
+ 
+      PACKAGE BODY PKG IS
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN PKG - 1" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN PKG - 1" );
+           END IF;
+      END PKG;
+ 
+      PACKAGE PRIV IS
+           TYPE ENUM1 IS PRIVATE;
+           TYPE ENUM2 IS PRIVATE;
+ 
+           FUNCTION FE1 (E : E1) RETURN ENUM1;
+ 
+           FUNCTION FE2 (E : E2) RETURN ENUM2;
+ 
+      PRIVATE
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+ 
+      END PRIV;
+ 
+      PACKAGE BODY PRIV IS
+           FUNCTION FE1 (E : E1) RETURN ENUM1 IS
+           BEGIN
+                RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
+           END FE1;
+ 
+           FUNCTION FE2 (E : E2) RETURN ENUM2 IS
+           BEGIN
+                RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
+           END FE2;
+ 
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN PRIV - 1" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN PRIV - 1" );
+           END IF;
+      END PRIV;
+ 
+      PACKAGE LPRIV IS
+           TYPE ENUM1 IS LIMITED PRIVATE;
+           TYPE ENUM2 IS LIMITED PRIVATE;
+ 
+           FUNCTION FE1 (E : E1) RETURN ENUM1;
+ 
+           FUNCTION FE2 (E : E2) RETURN ENUM2;
+ 
+           FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN;
+ 
+           FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN;
+ 
+      PRIVATE
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+ 
+      END LPRIV;
+ 
+      PACKAGE BODY LPRIV IS
+           FUNCTION FE1 (E : E1) RETURN ENUM1 IS
+           BEGIN
+                RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
+           END FE1;
+ 
+           FUNCTION FE2 (E : E2) RETURN ENUM2 IS
+           BEGIN
+                RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
+           END FE2;
+ 
+           FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN IS
+           BEGIN
+                IF A = B THEN
+                     RETURN TRUE;
+                ELSE
+                     RETURN FALSE;
+                END IF;
+           END EQUALS;
+ 
+           FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN IS
+           BEGIN
+                IF A = B THEN
+                     RETURN TRUE;
+                ELSE
+                     RETURN FALSE;
+                END IF;
+           END EQUALS;
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN LPRIV - 1" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN LPRIV - 2" );
+           END IF;
+      END LPRIV;
+ 
+      TASK T1;
+ 
+      TASK BODY T1 IS
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+ 
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN T1" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN T1" );
+           END IF;
+      END T1;
+ 
+      TASK T2 IS
+           ENTRY E;
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           ACCEPT E DO
+                DECLARE
+                     TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+                     TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+ 
+                BEGIN
+                     IF ENUM2'SUCC ('A') /= 'C' THEN
+                     FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                              "IN T2.E" );
+                     END IF;
+ 
+                     IF ENUM1'POS (RED) /= 3 THEN
+                          FAILED ( "RED NOT DECLARED CORRECTLY IN " &
+                                   "ENUM1 IN T2.E" );
+                     END IF;
+                END;
+           END E;
+      END T2;
+ 
+      GENERIC
+      PROCEDURE GP1;
+ 
+      PROCEDURE GP1 IS
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+ 
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN GP1" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN GP1" );
+           END IF;
+      END GP1;
+ 
+      GENERIC
+           TYPE E1 IS (<>);
+           TYPE E2 IS (<>);
+      PROCEDURE GP2;
+ 
+      PROCEDURE GP2 IS
+      BEGIN
+           IF E2'SUCC (E2'VALUE ("'A'")) /= E2'VALUE ("'C'") THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN E2 " &
+                         "IN GP2" );
+           END IF;
+ 
+           IF E1'POS (E1'VALUE ("RED")) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN E1 " &
+                         "IN GP2" );
+           END IF;
+      END GP2;
+ 
+      PROCEDURE NEWGP1 IS NEW GP1;
+      PROCEDURE NEWGP2 IS NEW GP2 (E1, E2);
+ 
+ BEGIN
+ 
+      DECLARE
+           TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+           TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+ 
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN BLOCK" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN BLOCK" );
+           END IF;
+      END;
+ 
+      DECLARE
+           USE PKG;
+      BEGIN
+           IF ENUM2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN PKG - 2" );
+           END IF;
+ 
+           IF ENUM1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN PKG - 2" );
+           END IF;
+      END;
+ 
+      DECLARE
+           USE PRIV;
+      BEGIN
+           IF FE2 (E2'SUCC('A')) /= FE2 ('C') THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN PRIV - 2" );
+           END IF;
+ 
+           IF FE1 (RED) /= FE1 (E1'VAL (3)) THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN PRIV - 2" );
+           END IF;
+      END;
+ 
+      DECLARE
+           USE LPRIV;
+      BEGIN
+           IF NOT EQUALS (FE2 (E2'SUCC('A')), FE2 ('C')) THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                         "IN LPRIV - 2" );
+           END IF;
+ 
+           IF NOT EQUALS (FE1 (RED), FE1 (E1'VAL (3))) THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                         "IN LPRIV - 2" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF E2'SUCC ('A') /= 'C' THEN
+                FAILED ( "'A' NOT DECLARED CORRECTLY IN E2" );
+           END IF;
+ 
+           IF E1'POS (RED) /= 3 THEN
+                FAILED ( "RED NOT DECLARED CORRECTLY IN E1" );
+           END IF;
+      END;
+ 
+      NEWGP1;
+      NEWGP2;
+      T2.E;
+ 
+      RESULT;
+ END C35102A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c352001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c352001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c352001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c352001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,270 ----
+ --
+ -- C352001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the predefined Character type comprises 256 positions.  
+ --      Check that the names of the non-graphic characters are usable with 
+ --      the attributes (Wide_)Image and (Wide_)Value, and that these
+ --      attributes produce the correct result.
+ --                 
+ -- TEST DESCRIPTION:
+ --      Build two tables of nongraphic characters from positions of Row 00 
+ --      (0000-001F and 007F-009F) of the ISO 10646 Basic Multilingual Plane.
+ --      Fill the first table with compiler created strings. Fill the second 
+ --      table with strings defined by the language.  Compare the two tables.  
+ --      Check 256 positions of the predefined character type.  Use attributes 
+ --      (Wide_)Image and (Wide_)Value to check the values of the non-graphic 
+ --      characters and the last 2 characters.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      20 Jun 95   SAIC    Initial prerelease version.
+ --      27 Jan 96   SAIC    Revised for 2.1.  Hid values, added "del" case.
+ --
+ --!
+ 
+ with Ada.Characters.Handling;
+ with Report;
+ procedure C352001 is
+ 
+    Lower_Bound  : Integer  :=  0;
+    Middle_Bound : Integer  := 31;
+    Upper_Bound  : Integer  := 159;
+    Half_Bound   : Integer  := 127;
+    Max_Bound    : Integer  := 255;
+ 
+    type Dyn_String is access String;
+    type Value_Result is array (Character) of Dyn_String;
+ 
+    Table_Of_Character : Value_Result;
+    TC_Table           : Value_Result;
+ 
+    function CVII(K : Natural) return Character is
+    begin
+      return Character'Val( Report.Ident_Int(K) );
+    end CVII;
+ 
+    function "=" (L, R : String) return Boolean is
+       UCL : String (L'First .. L'Last);
+       UCR : String (R'First .. R'last);
+    begin
+       UCL := Ada.Characters.Handling.To_Upper (L);
+       UCR := Ada.Characters.Handling.To_Upper (R);
+       if UCL'Last /= UCR'Last then 
+          return False;
+       else
+          for I in UCL'First .. UCR'Last loop
+             if UCL (I) /= UCR (I) then 
+                return False;
+             end if;
+          end loop;
+          return True;
+        end if;
+    end "=";
+ 
+ begin
+ 
+    Report.Test ("C352001", "Check that, the predefined Character type "     &
+                 "comprises 256 positions.  Check that the names of the "    &
+                 "non-graphic characters are usable with the attributes "    &
+                 "(Wide_)Image and (Wide_)Value, and that these attributes " &
+                 "produce the correct result");
+ 
+    -- Fill table with strings (positions of Row 00 (0000-001F) of the ISO 
+    -- 10646 Basic Multilingual Plane created by the compiler.
+ 
+    for I in CVII(Lower_Bound) .. CVII(Middle_Bound) loop
+       Table_Of_Character (I) := new String'(Character'Image(I));
+    end loop;
+ 
+    -- Fill table with strings (positions of Row 00 (007F-009F) of the ISO 
+    -- 10646 Basic Multilingual Plane created by the compiler.
+ 
+    for I in CVII(Half_Bound) .. CVII(Upper_Bound) loop
+       Table_Of_Character (I) := new String'(Character'Image(I));
+    end loop;
+ 
+    -- Fill table with strings (positions of Row 00 (0000-001F) of the ISO 
+    -- 10646 Basic Multilingual Plane defined by the language.
+ 
+    TC_Table (CVII(0))   := new String'("nul");
+    TC_Table (CVII(1))   := new String'("soh");
+    TC_Table (CVII(2))   := new String'("stx");
+    TC_Table (CVII(3))   := new String'("etx");
+    TC_Table (CVII(4))   := new String'("eot");
+    TC_Table (CVII(5))   := new String'("enq");
+    TC_Table (CVII(6))   := new String'("ack");
+    TC_Table (CVII(7))   := new String'("bel"); 
+    TC_Table (CVII(8))   := new String'("bs");
+    TC_Table (CVII(9))   := new String'("ht");
+    TC_Table (CVII(10))  := new String'("lf");
+    TC_Table (CVII(11))  := new String'("vt");
+    TC_Table (CVII(12))  := new String'("ff");
+    TC_Table (CVII(13))  := new String'("cr");
+    TC_Table (CVII(14))  := new String'("so");
+    TC_Table (CVII(15))  := new String'("si");
+    TC_Table (CVII(16))  := new String'("dle");
+    TC_Table (CVII(17))  := new String'("dc1");
+    TC_Table (CVII(18))  := new String'("dc2");
+    TC_Table (CVII(19))  := new String'("dc3");
+    TC_Table (CVII(20))  := new String'("dc4");
+    TC_Table (CVII(21))  := new String'("nak");
+    TC_Table (CVII(22))  := new String'("syn");
+    TC_Table (CVII(23))  := new String'("etb");
+    TC_Table (CVII(24))  := new String'("can");
+    TC_Table (CVII(25))  := new String'("em");
+    TC_Table (CVII(26))  := new String'("sub");
+    TC_Table (CVII(27))  := new String'("esc");
+    TC_Table (CVII(28))  := new String'("fs");
+    TC_Table (CVII(29))  := new String'("gs");
+    TC_Table (CVII(30))  := new String'("rs");
+    TC_Table (CVII(31))  := new String'("us");
+    TC_Table (CVII(127)) := new String'("del");
+ 
+    -- Fill table with strings (positions of Row 00 (007F-009F) of the ISO 
+    -- 10646 Basic Multilingual Plane defined by the language.
+ 
+    TC_Table (CVII(128)) := new String'("reserved_128");
+    TC_Table (CVII(129)) := new String'("reserved_129");
+    TC_Table (CVII(130)) := new String'("bph");
+    TC_Table (CVII(131)) := new String'("nbh");
+    TC_Table (CVII(132)) := new String'("reserved_132");
+    TC_Table (CVII(133)) := new String'("nel");
+    TC_Table (CVII(134)) := new String'("ssa");
+    TC_Table (CVII(135)) := new String'("esa");
+    TC_Table (CVII(136)) := new String'("hts");
+    TC_Table (CVII(137)) := new String'("htj");
+    TC_Table (CVII(138)) := new String'("vts");
+    TC_Table (CVII(139)) := new String'("pld");
+    TC_Table (CVII(140)) := new String'("plu");
+    TC_Table (CVII(141)) := new String'("ri");
+    TC_Table (CVII(142)) := new String'("ss2");
+    TC_Table (CVII(143)) := new String'("ss3");
+    TC_Table (CVII(144)) := new String'("dcs");
+    TC_Table (CVII(145)) := new String'("pu1");
+    TC_Table (CVII(146)) := new String'("pu2");
+    TC_Table (CVII(147)) := new String'("sts");
+    TC_Table (CVII(148)) := new String'("cch");
+    TC_Table (CVII(149)) := new String'("mw");
+    TC_Table (CVII(150)) := new String'("spa");
+    TC_Table (CVII(151)) := new String'("epa");
+    TC_Table (CVII(152)) := new String'("sos");
+    TC_Table (CVII(153)) := new String'("reserved_153");
+    TC_Table (CVII(154)) := new String'("sci");
+    TC_Table (CVII(155)) := new String'("csi");
+    TC_Table (CVII(156)) := new String'("st");
+    TC_Table (CVII(157)) := new String'("osc");
+    TC_Table (CVII(158)) := new String'("pm");
+    TC_Table (CVII(159)) := new String'("apc");
+ 
+ 
+    -- Compare the first half of two tables.
+    for I in CVII(Lower_Bound) .. CVII(Middle_Bound) loop
+      if TC_Table(I).all /= Table_Of_Character(I).all then
+        Report.Failed("Value of character#" & Integer'Image(Character'Pos(I)) &
+                      " is not the same in the first half of the table");
+      end if;
+    end loop;
+ 
+ 
+    -- Compare the second half of two tables.
+    for I in CVII(Half_Bound) .. CVII(Upper_Bound) loop
+      if TC_Table(I).all /= Table_Of_Character(I).all then
+        Report.Failed("Value of character#" & Integer'Image(Character'Pos(I)) &
+                      " is not the same in the second half of the table");
+      end if;
+    end loop;
+ 
+ 
+    -- Check the first character.
+    if Character'Image( Character'First ) /= "NUL" then
+       Report.Failed("Value of character#"                           &
+                      Integer'Image(Character'Pos (Character'First)) &
+                     " is not NUL");
+    end if;
+ 
+ 
+    -- Check that the names of the non-graphic characters are usable with
+    -- Image and Value attributes.
+    if Character'Value( Character'Image( CVII(153) )) /= 
+      CVII( 153 ) then
+         Report.Failed ("Value of character#"                       &
+                         Integer'Image( Character'Pos(CVII(153)) )  &
+                        " is not reserved_153");
+    end if;
+ 
+ 
+    for I in CVII(Lower_Bound) .. CVII(Max_Bound) loop
+      if Character'Value( 
+           Report.Ident_Str(
+             Character'Image(CVII(Character'Pos(I)))))
+         /= CVII( Character'Pos(I)) then
+           Report.Failed ("Value of character#"                             &
+                           Integer'Image( Character'Pos(I) )                &
+                          " is not the same as the predefined character type");
+      end if;
+    end loop;
+ 
+ 
+    -- Check Wide_Character attributes.
+    for I in Wide_Character'Val(Lower_Bound) .. Wide_Character'Val(Max_Bound) 
+    loop
+      if Wide_Character'Wide_Value(
+           Report.Ident_Wide_Str(
+             Wide_Character'Wide_Image(
+               Wide_Character'Val(Wide_Character'Pos(I)))))
+         /= Wide_Character'Val(Wide_Character'Pos(I)) 
+      then
+         Report.Failed ("Value of the predefined Wide_Character type " &
+                        "is not correct");
+      end if;
+    end loop;
+ 
+ 
+    if Wide_Character'Value( Wide_Character'Image(Wide_Character'Val(132)) ) 
+      /= Wide_Character'Val( Report.Ident_Int(132) ) then
+         Report.Failed ("Wide_Character at 132 is not reserved_132");
+    end if;
+ 
+ 
+    if Wide_Character'Image( Wide_Character'First ) /= "NUL" then
+       Report.Failed ("Wide_Character'First is not NUL");
+    end if;
+ 
+ 
+    if Wide_Character'Image 
+      (Wide_Character'Pred (Wide_Character'Last) ) /= "FFFE" then
+       Report.Failed ("Wide_Character at 65534 is not FFFE");
+    end if;
+   
+     
+    if Wide_Character'Image(Wide_Character'Last) /= "FFFF" then
+       Report.Failed ("Wide_Character'Last is not FFFF");
+    end if;
+ 
+    Report.Result;
+ 
+ end C352001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c354002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c354002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c354002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c354002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,335 ----
+ --
+ -- C354002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the attributes of modular types yield
+ --      correct values/results.  The attributes checked are:
+ --
+ --      First, Last, Range, Base, Min, Max, Succ, Pred, 
+ --      Image, Width, Value, Pos, and Val
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines several modular types.  One type defined at
+ --      each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus,
+ --      a power of two half that of System.Max_Binary_Modulus, one less
+ --      than that power of two; one more than that power of two, two
+ --      less than a (large) power of two.  For each of these types,
+ --      determine the correct operation of the following attributes:
+ --
+ --      First, Last, Range, Base, Min, Max, Succ, Pred, Image, Width,
+ --      Value, Pos, Val, and Modulus
+ --
+ --      The attributes Wide_Image and Wide_Value are deferred to C354003.
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      08 SEP 94   SAIC    Initial version
+ --      17 NOV 94   SAIC    Revised version
+ --      13 DEC 94   SAIC    split off Wide_String attributes into C354003
+ --      06 JAN 95   SAIC    Promoted to next release
+ --      19 APR 95   SAIC    Revised in accord with reviewer comments
+ --      27 JAN 96   SAIC    Eliminated 32/64 bit potential conflict for 2.1
+ --
+ --!
+ 
+ with Report;
+ with System;
+ with TCTouch;
+ procedure C354002 is
+ 
+   function ID(Local_Value: Integer) return Integer renames Report.Ident_Int;
+   function ID(Local_Value: String)  return String renames  Report.Ident_Str;
+ 
+   Power_2_Bits          : constant := System.Storage_Unit;
+   Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2;
+ 
+   type Max_Binary      is mod System.Max_Binary_Modulus;
+   type Max_NonBinary   is mod System.Max_Nonbinary_Modulus;
+   type Half_Max_Binary is mod Half_Max_Binary_Value;
+ 
+   type Medium          is mod 2048;
+   type Medium_Plus     is mod 2042;
+   type Medium_Minus    is mod 2111;
+ 
+   type Small  is mod 2;
+   type Finger is mod 5;
+ 
+   MBL  : constant := Max_NonBinary'Last;
+   MNBM : constant := Max_NonBinary'Modulus;
+ 
+   Ones_Complement_Permission : constant Boolean := MBL = MNBM;
+ 
+   type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie);
+ 
+   subtype Midrange is Medium_Minus range 222 .. 1111;
+ 
+ -- a few numbers for testing purposes
+   Max_Binary_Mod_Over_3      : constant := Max_Binary'Modulus / 3;
+   Max_NonBinary_Mod_Over_4   : constant := Max_NonBinary'Modulus / 4;
+   System_Max_Bin_Mod_Pred    : constant := System.Max_Binary_Modulus - 1;
+   System_Max_NonBin_Mod_Pred : constant := System.Max_Nonbinary_Modulus - 1;
+   Half_Max_Bin_Value_Pred    : constant := Half_Max_Binary_Value - 1;
+ 
+   AMB,   BMB   : Max_Binary;
+   AHMB,  BHMB  : Half_Max_Binary;
+   AM,    BM    : Medium;
+   AMP,   BMP   : Medium_Plus;
+   AMM,   BMM   : Medium_Minus;
+   AS,    BS    : Small;
+   AF,    BF    : Finger;
+ 
+   TC_Pass_Case : Boolean := True;
+ 
+   procedure Value_Fault( S: String ) is
+   -- check 'Value for failure modes
+   begin
+     -- the evaluation of the 'Value expression should raise C_E
+     TCTouch.Assert_Not( Midrange'Value(S) = 0, "Value_Fault" );
+     if Midrange'Value(S) not in Midrange'Base then
+       Report.Failed("'Value(" & S & ") raised no exception");
+     end if;
+   exception
+     when Constraint_Error => null; -- expected case
+     when others =>
+          Report.Failed("'Value(" & S & ") raised wrong exception");
+   end Value_Fault;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C354002", "Check attributes of modular types" );
+ 
+ -- Base
+   TCTouch.Assert( Midrange'Base'First = 0, "Midrange'Base'First" );
+   TCTouch.Assert( Midrange'Base'Last  = Medium_Minus'Last,
+                   "Midrange'Base'Last" );
+ 
+ -- First
+   TCTouch.Assert( Max_Binary'First = 0,         "Max_Binary'First" );
+   TCTouch.Assert( Max_NonBinary'First = 0,      "Max_NonBinary'First" );
+   TCTouch.Assert( Half_Max_Binary'First = 0,    "Half_Max_Binary'First" );
+ 
+   TCTouch.Assert( Medium'First = Medium(ID(0)), "Medium'First" );
+   TCTouch.Assert( Medium_Plus'First = Medium_Plus(ID(0)),
+                                                 "Medium_Plus'First" );
+   TCTouch.Assert( Medium_Minus'First = Medium_Minus(ID(0)),
+                                                 "Medium_Minus'First" );
+ 
+   TCTouch.Assert( Small'First = Small(ID(0)),   "Small'First" );
+   TCTouch.Assert( Finger'First = Finger(ID(0)), "Finger'First" );
+   TCTouch.Assert( Midrange'First = Midrange(ID(222)),
+                                                 "Midrange'First" );
+ 
+ -- Image
+   TCTouch.Assert( Half_Max_Binary'Image(255) = " 255",
+                  "Half_Max_Binary'Image" );
+   TCTouch.Assert( Medium'Image(0) = ID(" 0"),  "Medium'Image" );
+   TCTouch.Assert( Medium_Plus'Image(Medium_Plus'Last) = " 2041",
+                  "Medium_Plus'Image" );
+   TCTouch.Assert( Medium_Minus'Image(Medium_Minus(ID(1024))) = " 1024",
+                  "Medium_Minus'Image" );
+   TCTouch.Assert( Small'Image(Small(ID(1))) = " 1", "Small'Image" );
+   TCTouch.Assert( Midrange'Image(Midrange(ID(333))) = " 333",
+                   "Midrange'Image" );
+ 
+ -- Last
+   TCTouch.Assert( Max_Binary'Last      = System_Max_Bin_Mod_Pred,
+                  "Max_Binary'Last");
+   if Ones_Complement_Permission then
+     TCTouch.Assert( Max_NonBinary'Last >= System_Max_NonBin_Mod_Pred,
+                    "Max_NonBinary'Last (ones comp)");
+   else
+     TCTouch.Assert( Max_NonBinary'Last   = System_Max_NonBin_Mod_Pred,
+                    "Max_NonBinary'Last");
+   end if;
+   TCTouch.Assert( Half_Max_Binary'Last = Half_Max_Bin_Value_Pred,
+                  "Half_Max_Binary'Last");
+ 
+   TCTouch.Assert( Medium'Last          = Medium(ID(2047)), "Medium'Last");
+   TCTouch.Assert( Medium_Plus'Last     = Medium_Plus(ID(2041)),
+                   "Medium_Plus'Last");
+   TCTouch.Assert( Medium_Minus'Last    = Medium_Minus(ID(2110)),
+                   "Medium_Minus'Last");
+   TCTouch.Assert( Small'Last    = Small(ID(1)), "Small'Last");
+   TCTouch.Assert( Finger'Last   = Finger(ID(4)), "Finger'Last");
+   TCTouch.Assert( Midrange'Last = Midrange(ID(1111)), "Midrange'Last");
+ 
+ -- Max
+   TCTouch.Assert( Max_Binary'Max(Power_2_Bits, Max_Binary'Last)
+                   = Max_Binary'Last,                     "Max_Binary'Max");
+   TCTouch.Assert( Max_NonBinary'Max(100,2000) = 2000, "Max_NonBinary'Max");
+   TCTouch.Assert( Half_Max_Binary'Max(123,456) = 456,
+                                                     "Half_Max_Binary'Max");
+ 
+   TCTouch.Assert( Medium'Max(0,2040) = 2040,                 "Medium'Max");
+   TCTouch.Assert( Medium_Plus'Max(0,1) = 1,             "Medium_Plus'Max");
+   TCTouch.Assert( Medium_Minus'Max(2001,1995) = 2001,  "Medium_Minus'Max");
+   TCTouch.Assert( Small'Max(1,0) = 1,                         "Small'Max");
+   TCTouch.Assert( Finger'Max(Finger'Last+1,4) = 4,           "Finger'Max");
+   TCTouch.Assert( Midrange'Max(Midrange'First+1,222) = Midrange'First+1,
+                                                           "Midrange'Max");
+ 
+ -- Min
+   TCTouch.Assert( Max_Binary'Min(Power_2_Bits, Max_Binary'Last)
+                   = Power_2_Bits,                        "Max_Binary'Min");
+   TCTouch.Assert( Max_NonBinary'Min(100,2000) = 100,  "Max_NonBinary'Min");
+   TCTouch.Assert( Half_Max_Binary'Min(123,456) = 123,
+                                                     "Half_Max_Binary'Min");
+ 
+   TCTouch.Assert( Medium'Min(0,Medium(ID(2040))) = 0,        "Medium'Min");
+   TCTouch.Assert( Medium_Plus'Min(0,1) = 0,             "Medium_Plus'Min");
+   TCTouch.Assert( Medium_Minus'Min(2001,1995) = 1995,  "Medium_Minus'Min");
+   TCTouch.Assert( Small'Min(1,0) = 0,                         "Small'Min");
+   TCTouch.Assert( Finger'Min(Finger'Last+1,4) /= 4,          "Finger'Min");
+   TCTouch.Assert( Midrange'Min(Midrange'First+1,222) = 222,
+                                                           "Midrange'Min");
+ -- Modulus
+   TCTouch.Assert( Max_Binary'Modulus = System.Max_Binary_Modulus,
+                  "Max_Binary'Modulus");
+   TCTouch.Assert( Max_NonBinary'Modulus = System.Max_Nonbinary_Modulus,
+                  "Max_NonBinary'Modulus");
+   TCTouch.Assert( Half_Max_Binary'Modulus = Half_Max_Binary_Value,
+                  "Half_Max_Binary'Modulus");
+ 
+   TCTouch.Assert( Medium'Modulus       = 2048, "Medium'Modulus");
+   TCTouch.Assert( Medium_Plus'Modulus  = 2042, "Medium_Plus'Modulus");
+   TCTouch.Assert( Medium_Minus'Modulus = 2111, "Medium_Minus'Modulus");
+   TCTouch.Assert( Small'Modulus        =    2, "Small'Modulus");
+   TCTouch.Assert( Finger'Modulus       =    5, "Finger'Modulus");
+   TCTouch.Assert( Midrange'Modulus = ID(2111), "Midrange'Modulus");
+ 
+ -- Pos
+   declare
+     Int : Natural := 222;
+   begin
+     for I in Midrange loop
+       TC_Pass_Case := TC_Pass_Case and Midrange'Pos(I) = Int;
+                     
+       Int := Int +1;
+     end loop;
+   end;
+ 
+   TCTouch.Assert( TC_Pass_Case, "Midrange'Pos");
+ 
+ -- Pred
+   TCTouch.Assert( Max_Binary'Pred(0)      = System_Max_Bin_Mod_Pred,
+                  "Max_Binary'Pred(0)");
+   if Ones_Complement_Permission then
+     TCTouch.Assert( Max_NonBinary'Pred(0) >= System_Max_NonBin_Mod_Pred,
+                    "Max_NonBinary'Pred(0) (ones comp)");
+   else
+     TCTouch.Assert( Max_NonBinary'Pred(0)   = System_Max_NonBin_Mod_Pred,
+                    "Max_NonBinary'Pred(0)");
+   end if;
+   TCTouch.Assert( Half_Max_Binary'Pred(0) = Half_Max_Bin_Value_Pred,
+                  "Half_Max_Binary'Pred(0)");
+ 
+   TCTouch.Assert( Medium'Pred(Medium(ID(0))) = 2047, "Medium'Pred(0)");
+   TCTouch.Assert( Medium_Plus'Pred(0)     = 2041, "Medium_Plus'Pred(0)");
+   TCTouch.Assert( Medium_Minus'Pred(0)    = 2110, "Medium_Minus'Pred(0)");
+   TCTouch.Assert( Small'Pred(0)  = 1, "Small'Pred(0)");
+   TCTouch.Assert( Finger'Pred(Finger(ID(0))) = 4, "Finger'Pred(0)");
+   TCTouch.Assert( Midrange'Pred(222) = 221, "Midrange'Pred('First)");
+ 
+ -- Range
+   for I in Midrange'Range loop
+     if I not in Midrange then
+       Report.Failed("Midrange loop test");
+     end if;
+   end loop;
+   for I in Medium'Range loop
+     if I not in Medium then
+       Report.Failed("Medium loop test");
+     end if;
+   end loop;
+   for I in Medium_Minus'Range loop
+     if I not in 0..2110 then
+       Report.Failed("Medium loop test");
+     end if;
+   end loop;
+ 
+ -- Succ
+   TCTouch.Assert( Max_Binary'Succ(System_Max_Bin_Mod_Pred)         = 0,
+                  "Max_Binary'Succ('Last)");
+   if Ones_Complement_Permission then
+     TCTouch.Assert( (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred) = 0)
+                 or (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred)
+                     = Max_NonBinary'Last),
+                    "Max_NonBinary'Succ('Last) (ones comp)");
+   else
+     TCTouch.Assert( Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred)   = 0,
+                    "Max_NonBinary'Succ('Last)");
+   end if;
+  TCTouch.Assert( Half_Max_Binary'Succ(Half_Max_Bin_Value_Pred)    = 0,
+                  "Half_Max_Binary'Succ('Last)");
+ 
+   TCTouch.Assert( Medium'Succ(2047)       = 0, "Medium'Succ('Last)");
+   TCTouch.Assert( Medium_Plus'Succ(2041)  = 0, "Medium_Plus'Succ('Last)");
+   TCTouch.Assert( Medium_Minus'Succ(2110) = 0, "Medium_Minus'Succ('Last)");
+   TCTouch.Assert( Small'Succ(1)           = 0, "Small'Succ('Last)");
+   TCTouch.Assert( Finger'Succ(4)          = 0, "Finger'Succ('Last)");
+   TCTouch.Assert( Midrange'Succ(Midrange(ID(1111))) = 1112,
+                   "Midrange'Succ('Last)");
+ 
+ -- Val
+   for I in Natural range ID(222)..ID(1111) loop
+     TCTouch.Assert( Midrange'Val(I) = Medium_Minus(I), "Midrange'Val");
+   end loop;
+ 
+ -- Value
+ 
+   TCTouch.Assert( Half_Max_Binary'Value("255") = 255,
+                  "Half_Max_Binary'Value" );
+ 
+   TCTouch.Assert( Medium'Value(" 1e2") = 100,   "Medium'Value(""1e2"")" );
+   TCTouch.Assert( Medium'Value(" 0 ")  =   0,   "Medium'Value" );
+   TCTouch.Assert( Medium_Plus'Value(ID("2041")) = 2041,
+                  "Medium_Plus'Value" );
+   TCTouch.Assert( Medium_Minus'Value(ID("+10_24")) = 1024,
+                  "Medium_Minus'Value" );
+ 
+   TCTouch.Assert( Small'Value("+1") = 1,            "Small'Value" );
+   TCTouch.Assert( Midrange'Value(ID("333")) = 333,  "Midrange'Value" );
+   TCTouch.Assert( Midrange'Value("1E3") = 1000,
+                  "Midrange'Value(""1E3"")" );
+ 
+   Value_Fault( "bad input" );
+   Value_Fault( "-333" );
+   Value_Fault( "9999" );
+   Value_Fault( ".1" );
+   Value_Fault( "1e-1" );
+ 
+ -- Width
+   TCTouch.Assert( Medium'Width       = 5, "Medium'Width");
+   TCTouch.Assert( Medium_Plus'Width  = 5, "Medium_Plus'Width");
+   TCTouch.Assert( Medium_Minus'Width = 5, "Medium_Minus'Width");
+   TCTouch.Assert( Small'Width        = 2, "Small'Width");
+   TCTouch.Assert( Finger'Width       = 2, "Finger'Width");
+   TCTouch.Assert( Midrange'Width     = 5, "Midrange'Width");
+ 
+   Report.Result;
+ 
+ end C354002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c354003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c354003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c354003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c354003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,211 ----
+ -- C354003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the Wide_String attributes of modular types yield
+ --      correct values/results.  The attributes checked are:
+ --
+ --      Wide_Image
+ --      Wide_Value
+ --
+ -- TEST DESCRIPTION:
+ --      This test is split from C354002.  It tests only the attributes:
+ --
+ --      Wide_Image, Wide_Value
+ --
+ --      This test defines several modular types.  One type defined at
+ --      each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus,
+ --      a power of two half that of System.Max_Binary_Modulus, one less
+ --      than that power of two; one more than that power of two, two
+ --      less than a (large) power of two.  For each of these types,
+ --      determine the correct operation of the Wide_String attributes.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      13 DEC 94   SAIC    Initial version
+ --      06 JAN 94   SAIC    Promoted to future release
+ --      19 APR 95   SAIC    Revised in accord with reviewer comments
+ --      01 DEC 95   SAIC    Corrected for 2.0.1
+ --      27 JAN 96   SAIC    Eliminated potential 32/64 bit conflict for 2.1
+ --      24 FEB 97   PWB.CTA Corrected out-of-range value
+ --!
+ 
+ with Report;
+ with System;
+ with TCTouch;
+ with Ada.Characters.Handling;
+ procedure C354003 is
+ 
+   function ID(Local_Value: Integer) return Integer renames Report.Ident_Int;
+   function ID(Local_Value: String)  return String renames  Report.Ident_Str;
+ 
+   function ID(Local_Value: String) return Wide_String is
+   begin
+     return Ada.Characters.Handling.To_Wide_String( ID( Local_Value ) );
+   end ID;
+ 
+   Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2;
+ 
+   type Max_Binary      is mod System.Max_Binary_Modulus;
+   type Max_NonBinary   is mod System.Max_Nonbinary_Modulus;
+   type Half_Max_Binary is mod Half_Max_Binary_Value;
+ 
+   type Medium          is mod 2048;
+   type Medium_Plus     is mod 2042;
+   type Medium_Minus    is mod 2111;
+ 
+   type Small  is mod 2;
+   type Finger is mod 5;
+ 
+   type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie);
+ 
+   subtype Midrange is Medium_Minus range 222 .. 1111;
+ 
+   AMB,   BMB   : Max_Binary;
+   AHMB,  BHMB  : Half_Max_Binary;
+   AM,    BM    : Medium;
+   AMP,   BMP   : Medium_Plus;
+   AMM,   BMM   : Medium_Minus;
+   AS,    BS    : Small;
+   AF,    BF    : Finger;
+ 
+   procedure Wide_Value_Fault( S: Wide_String ) is
+   -- check 'Wide_Value for failure modes
+   begin
+     -- the evaluation of the 'Wide_Value expression should raise C_E
+     TCTouch.Assert_Not( Midrange'Wide_Value(S) = 0, "Wide_Value_Fault" );
+     if Midrange'Wide_Value(S) not in Midrange'Base then
+       Report.Failed("'Wide_Value  raised no exception");
+     end if;
+   exception
+     when Constraint_Error => null; -- expected case
+     when others =>
+          Report.Failed("'Wide_Value raised wrong exception");
+   end Wide_Value_Fault;
+ 
+ 
+   The_Cap, The_Toe : Natural;
+ 
+   procedure Check_Non_Static_Cases( Lower_Bound,Upper_Bound : Medium ) is
+     subtype Non_Static is Medium range Lower_Bound..Upper_Bound;
+   begin
+   -- First, Last, Range, Min, Max, Succ, Pred, Pos, and Val
+ 
+     TCTouch.Assert( Non_Static'First = Medium(The_Toe), "Non_Static'First" );
+     TCTouch.Assert( Non_Static'Last = Non_Static(The_Cap),
+                     "Non_Static'Last" );
+     TCTouch.Assert( Non_Static(The_Cap/2) in Non_Static'Range,
+                     "Non_Static'Range" );
+     TCTouch.Assert( Non_Static'Min(Medium(Report.Ident_Int(100)),
+                                    Medium(Report.Ident_Int(200))) = 100,
+                     "Non_Static'Min" );
+     TCTouch.Assert( Non_Static'Max(Medium(Report.Ident_Int(100)),
+                                    Medium(Report.Ident_Int(200))) = 200,
+                     "Non_Static'Max" );
+     TCTouch.Assert( Non_Static'Succ(Non_Static(The_Cap))
+                     = Medium'Succ(Upper_Bound),
+                     "Non_Static'Succ" );
+     TCTouch.Assert( Non_Static'Pred(Medium(Report.Ident_Int(The_Cap)))
+                     = Non_Static(Report.Ident_Int(The_Cap-1)),
+                     "Non_Static'Pred" );
+     TCTouch.Assert( Non_Static'Pos(Upper_Bound) = Non_Static(The_Cap),
+                     "Non_Static'Pos" );
+     TCTouch.Assert( Non_Static'Val(Non_Static(The_Cap)) = Upper_Bound,
+                     "Non_Static'Val" );
+ 
+   end Check_Non_Static_Cases;
+ 
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C354003", "Check Wide_String attributes of modular types" );
+ 
+   Wide_Strings_Needed: declare
+ 
+     Max_Bin_Mod_Div_3 : constant := Max_Binary'Modulus/3;
+     Max_Non_Mod_Div_4 : constant := Max_NonBinary'Modulus/4;
+ 
+   begin
+ 
+ -- Wide_Image
+ 
+     TCTouch.Assert( Half_Max_Binary'Wide_Image(255) = " 255",
+                    "Half_Max_Binary'Wide_Image" );
+ 
+     TCTouch.Assert( Medium'Wide_Image(0) = " 0",  "Medium'Wide_Image" );
+ 
+     TCTouch.Assert( Medium_Plus'Wide_Image(Medium_Plus'Last) = " 2041",
+                    "Medium_Plus'Wide_Image" );
+ 
+     TCTouch.Assert( Medium_Minus'Wide_Image(Medium_Minus(ID(1024))) = " 1024",
+                    "Medium_Minus'Wide_Image" );
+ 
+     TCTouch.Assert( Small'Wide_Image(1) = " 1",   "Small'Wide_Image" );
+ 
+     TCTouch.Assert( Midrange'Wide_Image(Midrange(ID(333))) = " 333",
+                    "Midrange'Wide_Image" );
+ 
+ -- Wide_Value
+ 
+     TCTouch.Assert( Half_Max_Binary'Wide_Value("255") = 255,
+                    "Half_Max_Binary'Wide_Value" );
+ 
+     TCTouch.Assert( Medium'Wide_Value(" 0 ")  = 0,   "Medium'Wide_Value" );
+ 
+     TCTouch.Assert( Medium_Plus'Wide_Value(ID("2041")) = Medium_Plus'Last,
+                    "Medium_Plus'Wide_Value" );
+ 
+     TCTouch.Assert( Medium_Minus'Wide_Value("+1_4 ") = 14,
+                    "Medium_Minus'Wide_Value" );
+ 
+     TCTouch.Assert( Small'Wide_Value("+1") = 1,      "Small'Wide_Value" );
+ 
+     TCTouch.Assert( Midrange'Wide_Value(ID("333")) = 333,
+                    "Midrange'Wide_Value" );
+ 
+     TCTouch.Assert( Midrange'Wide_Value(ID("1E3")) = 1000,
+                    "Midrange'Wide_Value(""1E3"")" );
+ 
+     Wide_Value_Fault( "bad input" );
+     Wide_Value_Fault( "-333" );
+     Wide_Value_Fault( "9999" );
+     Wide_Value_Fault( ".1" );
+     Wide_Value_Fault( "1e-1" );
+ 
+   end Wide_Strings_Needed;
+ 
+   The_Toe := Report.Ident_Int(25);
+   The_Cap := Report.Ident_Int(256);
+   Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
+                           Medium(Report.Ident_Int(The_Cap)) );
+ 
+   The_Toe := Report.Ident_Int(40);
+   The_Cap := Report.Ident_Int(2047);
+   Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
+                           Medium(Report.Ident_Int(The_Cap)) );
+ 
+   Report.Result;
+ 
+ end C354003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C35502A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+ -- WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR 
+ -- A CHARACTER TYPE.   
+ 
+ -- RJW 5/05/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35502A  IS
+ 
+ BEGIN
+ 
+      TEST( "C35502A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                        "THE CORRECT RESULTS WHEN THE PREFIX " &
+                        "IS AN ENUMERATION TYPE OTHER THAN " &
+                        "A BOOLEAN OR A CHARACTER TYPE" );
+ 
+      DECLARE
+           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+ 
+           SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
+           SUBTYPE NOENUM IS ENUM RANGE ABC .. A;
+           
+           TYPE NEWENUM IS NEW ENUM;
+          
+      BEGIN
+ 
+           IF ENUM'WIDTH /= IDENT_INT(5) THEN
+                FAILED( "INCORRECT WIDTH FOR ENUM" );
+           END IF;
+ 
+           IF NEWENUM'WIDTH /= IDENT_INT(5) THEN
+                FAILED( "INCORRECT WIDTH FOR NEWENUM" );
+           END IF;
+ 
+           IF SUBENUM'WIDTH /= IDENT_INT(3) THEN
+                FAILED( "INCORRECT WIDTH FOR SUBENUM" );
+           END IF;
+ 
+           IF NOENUM'WIDTH /= IDENT_INT(0) THEN
+                FAILED( "INCORRECT WIDTH FOR NOENUM" );
+           END IF;
+ 
+      END;                    
+ 
+      RESULT;
+ END C35502A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C35502B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+ -- WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL 
+ -- PARAMETER IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR CHARACTER 
+ -- TYPE.   
+ 
+ -- RJW 5/05/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35502B  IS
+ 
+ BEGIN
+ 
+      TEST( "C35502B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                        "THE CORRECT RESULTS WHEN THE PREFIX " &
+                        "IS A GENERIC FORMAL DISCRETE TYPE " &
+                        "WHOSE ACTUAL PARAMETER IS AN ENUMERATION " &
+                        "TYPE" );
+ 
+      DECLARE
+           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+           SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
+           SUBTYPE NOENUM IS ENUM RANGE ABC .. A;
+           
+           TYPE NEWENUM IS NEW ENUM;
+ 
+           GENERIC
+                TYPE E IS (<>);
+                W : INTEGER;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                SUBTYPE NOENUM IS E RANGE 
+                     E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
+           BEGIN
+                IF E'WIDTH /= IDENT_INT(W) THEN 
+                     FAILED ( "INCORRECT E'WIDTH FOR " & STR );
+                END IF;
+                IF NOENUM'WIDTH /= IDENT_INT(0) THEN
+                     FAILED ( "INCORRECT NOENUM'WIDTH FOR " & STR );
+                END IF;
+           END P;
+ 
+           PROCEDURE PROC1 IS NEW P (ENUM, 5);
+           PROCEDURE PROC2 IS NEW P (SUBENUM, 3);
+           PROCEDURE PROC3 IS NEW P (NEWENUM, 5);
+           PROCEDURE PROC4 IS NEW P (NOENUM, 0);
+ 
+      BEGIN
+           PROC1 ( "ENUM" );
+           PROC2 ( "SUBENUM" );
+           PROC3 ( "NEWENUM" );
+           PROC4 ( "NOENUM" );
+      END;                    
+ 
+      RESULT;
+ END C35502B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,318 ----
+ -- C35502C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
+ -- RESULTS WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN
+ -- OR A CHARACTER TYPE.   
+ -- SUBTESTS ARE:
+ --     PART (A). TESTS FOR IMAGE.
+ --     PART (B). TESTS FOR VALUE.
+ 
+ -- RJW 5/07/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35502C  IS
+ 
+           TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
+           SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+           TYPE NEWENUM IS NEW ENUM;
+ 
+           FUNCTION IDENT (X : ENUM) RETURN ENUM IS
+                BEGIN
+                     IF EQUAL (ENUM'POS (X), ENUM'POS(X)) THEN
+                          RETURN X;
+                     END IF;
+                     RETURN ENUM'FIRST;
+                END IDENT;       
+ 
+ BEGIN
+ 
+      TEST( "C35502C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                        "'VALUE' YIELD THE CORRECT RESULTS " &
+                        "WHEN THE PREFIX IS AN ENUMERATION TYPE " &
+                        "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
+ 
+ -- PART (A).
+ 
+      BEGIN  
+ 
+           IF ENUM'IMAGE ( IDENT(ABC) ) /= "ABC" THEN
+                FAILED ( "INCORRECT ENUM'IMAGE FOR ABC" );
+           END IF;
+           IF ENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR ABC IN ENUM" );
+           END IF;
+ 
+           IF ENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
+                FAILED ( "INCORRECT ENUM'IMAGE FOR A_B_C" );
+           END IF;
+           IF ENUM'IMAGE ( IDENT(A_B_C) )'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR A_B_C IN ENUM" );
+           END IF;
+ 
+           IF SUBENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
+                FAILED ( "INCORRECT SUBENUM'IMAGE FOR A_B_C" );
+           END IF;          
+           IF SUBENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR ABC " &
+                         "IN SUBENUM" );
+           END IF;          
+ 
+           IF NEWENUM'IMAGE ( ABC ) /= IDENT_STR("ABC") THEN
+                FAILED ( "INCORRECT NEWENUM'IMAGE FOR ABC" );
+           END IF;          
+           IF NEWENUM'IMAGE ( ABC )'FIRST /= IDENT_INT(1) THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR ABC" &
+                         "IN NEWENUM" );
+           END IF;          
+ 
+           IF ENUM'IMAGE ( IDENT(abcd) ) /= "ABCD" THEN
+                FAILED ( "INCORRECT ENUM'IMAGE FOR abcd" );
+           END IF;          
+           IF ENUM'IMAGE ( IDENT(abcd) )'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR abcd IN ENUM" );
+           END IF;          
+ 
+      END;
+ 
+ -----------------------------------------------------------------------
+ 
+ -- PART (B).
+ 
+      BEGIN  
+           IF ENUM'VALUE (IDENT_STR("ABC")) /= ABC THEN     
+                FAILED ( "INCORRECT VALUE FOR ""ABC""" );  
+           END IF;
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABC""" );  
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE (IDENT_STR("abc")) /= abc THEN     
+                FAILED ( "INCORRECT VALUE FOR ""abc""" );  
+           END IF;
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""abc""" );  
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE ("ABC") /= ABC THEN     
+                FAILED ( "INCORRECT VALUE FOR ABC" );  
+           END IF;
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ABC" );  
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VALUE (IDENT_STR("abcd")) /= abcd THEN
+                FAILED ( "INCORRECT VALUE FOR ""abcd""" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""abcd""" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VALUE (IDENT_STR("ABCD")) /= abcd THEN
+                FAILED ( "INCORRECT VALUE FOR ""ABCD""" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABCD""" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VALUE ("abcd") /= abcd THEN
+                FAILED ( "INCORRECT VALUE FOR abcd" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR abcd" );
+      END;
+ 
+      BEGIN
+           IF SUBENUM'VALUE (IDENT_STR("A_B_C")) /= A_B_C THEN
+                FAILED ( "INCORRECT VALUE FOR ""A_B_C""" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""A_B_C""" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE (IDENT_STR("ABC     ")) /= ABC THEN
+                FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE WITH " &
+                         "TRAILING BLANKS" );
+      END;
+ 
+      BEGIN          
+           IF NEWENUM'VALUE (IDENT_STR("  A_B_C")) /= A_B_C THEN
+                FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE WITH LEADING " &
+                         "BLANKS" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE (IDENT_STR("A_BC")) /= ABC THEN
+                FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - ""A_BC""" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE (IDENT_STR("A BC")) /= ABC THEN
+                FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - ""A BC""" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE (IDENT_STR("A&BC")) /= ABC THEN
+                FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - ""A&BC""" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE (IDENT_CHAR(ASCII.HT) & "BC") /= BC THEN
+                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VALUE ("A" & (IDENT_CHAR(ASCII.HT))) /= A THEN
+                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VALUE (IDENT_STR("B__C")) /= BC THEN
+                FAILED ( "NO EXCEPTION RAISED - " &
+                         "CONSECUTIVE UNDERSCORES - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - " &
+                         "CONSECUTIVE UNDERSCORES - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - " &
+                         "CONSECUTIVE UNDERSCORES" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VALUE (IDENT_STR("BC_")) /= BC THEN
+                FAILED ( "NO EXCEPTION RAISED - " & 
+                         "TRAILING UNDERSCORE - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - " & 
+                         "TRAILING UNDERSCORE - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - " & 
+                         "TRAILING UNDERSCORE" );
+      END;
+ 
+      BEGIN
+           IF SUBENUM'VALUE (IDENT_STR("_BC")) /= BC THEN
+                FAILED ( "NO EXCEPTION RAISED - " & 
+                         "LEADING UNDERSCORE - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - " & 
+                         "LEADING UNDERSCORE - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - " & 
+                         "LEADING UNDERSCORE" );
+      END;
+ 
+      BEGIN
+           IF SUBENUM'VALUE (IDENT_STR("0BC")) /= BC THEN
+                FAILED ( "NO EXCEPTION RAISED - " & 
+                         "FIRST CHARACTER IS A DIGIT - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - " & 
+                         "FIRST CHARACTER IS A DIGIT - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - " & 
+                         "FIRST CHARACTER IS A DIGIT" );
+      END;
+ 
+      RESULT;
+ END C35502C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502d.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502d.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502d.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C35502D.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
+ -- LONGEST POSSIBLE ENUMERATION LITERAL.
+ 
+ -- RJW 2/21/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502D IS
+ 
+ BEGIN
+      TEST ("C35502D", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
+                       "CORRECT RESULTS FOR THE LONGEST POSSIBLE " &
+                       "ENUMERATION LITERAL");
+ 
+      -- BIG_ID1 IS A MAXIMUM LENGTH IDENTIFIER. BIG_STRING1 AND 
+      -- BIG_STRING2 ARE TWO STRING LITERALS WHICH WHEN CONCATENATED 
+      -- FORM THE IMAGE OF BIG_ID1;
+ 
+ 
+      DECLARE
+           TYPE ENUM IS (
+ $BIG_ID1
+                         );                             
+ 
+      BEGIN
+           BEGIN
+                IF ENUM'VALUE (
+ $BIG_STRING1  
+ &
+ $BIG_STRING2
+ ) /= 
+ $BIG_ID1
+                     THEN
+                     FAILED ( "INCORRECT RESULTS FOR 'VALUE'" );
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED FOR 'VALUE'" );
+           END;
+           BEGIN           
+                IF ENUM'IMAGE( 
+ $BIG_ID1
+ ) /=
+ (
+ $BIG_STRING1
+ &
+ $BIG_STRING2
+ )                   THEN
+                     FAILED ( "INCORRECT RESULTS FOR 'IMAGE'" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED FOR 'IMAGE'" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED FOR 'IMAGE'" );
+           END;
+      END;
+ 
+      RESULT;
+ END C35502D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,155 ----
+ -- C35502E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
+ -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL 
+ -- PARAMETER IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A 
+ -- CHARACTER TYPE.   
+ -- SUBTESTS ARE:
+ --     PART (A). TESTS FOR IMAGE.
+ --     PART (B). TESTS FOR VALUE.
+ 
+ -- RJW 5/13/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35502E  IS
+ 
+           TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
+           SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+           TYPE NEWENUM IS NEW ENUM;
+ 
+ BEGIN
+ 
+      TEST( "C35502E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ACTUAL PARAMETER IS AN ENUMERATION TYPE " &
+                        "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
+ 
+ -- PART (A).
+      DECLARE
+           GENERIC
+                TYPE E IS (<>);
+                STR1 : STRING;
+           PROCEDURE P ( E1 : E; STR2 : STRING );
+           
+           PROCEDURE P ( E1 : E; STR2 : STRING ) IS
+                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+           BEGIN
+                IF SE'IMAGE ( E1 ) /= STR2 THEN
+                     FAILED ( "INCORRECT SE'IMAGE FOR " & STR2 & " IN "
+                               & STR1 );
+                END IF;
+                IF SE'IMAGE ( E1 )'FIRST /= 1 THEN
+                     FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 
+                               & " IN " & STR1 );
+                END IF;
+           END P;
+           
+           PROCEDURE PE IS NEW P ( ENUM , "ENUM" );
+           PROCEDURE PS IS NEW P ( SUBENUM, "SUBENUM" );
+           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+ 
+      BEGIN
+           PE ( ABC, "ABC" );
+           PE ( A_B_C, "A_B_C" );
+           PS ( BC, "BC" );
+           PN ( ABC, "ABC" );
+           PE ( abcd, "ABCD" );
+      END;
+ 
+ -----------------------------------------------------------------------
+ 
+ -- PART (B).
+ 
+      DECLARE
+           GENERIC
+                TYPE E IS (<>);
+                STR1 : STRING;
+           PROCEDURE P ( STR2 : STRING ; E1 : E );
+           
+           PROCEDURE P ( STR2 : STRING ; E1 : E ) IS
+                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+           BEGIN
+                IF E'VALUE ( STR2 ) /= E1 THEN     
+                     FAILED ( "INCORRECT " & STR1 & "'VALUE FOR """ & 
+                               STR2 & """" ); 
+                END IF;
+           EXCEPTION     
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED - " & STR1 & "'VALUE " &
+                              "FOR """ & STR2 & """" );  
+           END P;
+ 
+           PROCEDURE PE IS NEW P ( ENUM , "ENUM" );
+           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+ 
+      BEGIN
+           PN ("abcd", abcd);
+           PN ("A_B_C", A_B_C);
+           PE ("ABC     ", ABC);
+           PE ("  A_B_C", A_B_C);
+      END;
+ 
+ 
+      DECLARE
+           GENERIC
+                TYPE E IS (<>);
+           PROCEDURE P ( STR : STRING );
+           
+           PROCEDURE P ( STR : STRING ) IS
+                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+           BEGIN
+                IF SE'VALUE (STR) = SE'VAL (0) THEN
+                     FAILED ( "NO EXCEPTION RAISED - " & STR & " - 1" );
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED - " & STR & " - 2" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED - " & STR );
+           END P;
+ 
+           PROCEDURE PE IS NEW P ( ENUM );
+           PROCEDURE PS IS NEW P ( SUBENUM );
+           PROCEDURE PN IS NEW P ( NEWENUM );
+           
+      BEGIN
+           PS ("A BC");
+           PN ("A&BC");
+           PE (ASCII.HT & "BC");
+           PE ("A" & ASCII.HT);
+           PS ("_BC");
+           PN ("BC_");
+           PE ("B__C");
+           PE ("0BC");
+ 
+      END;
+ 
+      RESULT;
+ END C35502E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502f.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502f.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502f.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502f.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- C35502F.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMAGE AND VALUE ATTRIBUTES ARE CORRECT FOR A FORMAL
+ -- DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN ENUMERATED TYPE
+ -- WITH THE LONGEST POSSIBLE IDENTIFIER AS ONE CONSTANT.
+ 
+ -- PWB  03/05/86
+ -- DWC  07/22/87     -- ADDED THE CONSTANT STRING 'STR'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502F IS
+ 
+      -- BIG_ID1 IS AN IDENTIFIER OF MAXIMUM LENGTH.
+      TYPE ENUM IS ( EVAL1,
+ $BIG_ID1
+                   );
+ 
+      -- BIG_STRING1 & BIG_STRING2 YIELDS BIG_ID.
+      STR1 : CONSTANT STRING :=
+ $BIG_STRING1;
+      STR2 : CONSTANT STRING :=
+ $BIG_STRING2;
+      STR : CONSTANT STRING := STR1 & STR2;
+ 
+      GENERIC
+           TYPE FORMAL IS (<>);
+      PROCEDURE GEN_PROC;
+ 
+      PROCEDURE GEN_PROC IS
+      BEGIN
+           VALUE_CHECK:
+           BEGIN
+                IF FORMAL'VALUE (STR) /= FORMAL'LAST THEN
+                     FAILED ("VALUE OF LONG STRING NOT LONG IDENTIFIER");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN CHECKING " &
+                             "VALUE ATTRIBUTE");
+           END VALUE_CHECK;
+ 
+           IMAGE_CHECK:
+           BEGIN
+                IF FORMAL'IMAGE (FORMAL'LAST) /= STR
+                THEN
+                     FAILED ("IMAGE OF LONG IDENTIFIER NOT LONG STRING");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN CHECKING " &
+                             "IMAGE ATTRIBUTE");
+           END IMAGE_CHECK;
+ 
+      END GEN_PROC;
+ 
+      PROCEDURE TEST_PROC IS NEW GEN_PROC (ENUM);
+ 
+ BEGIN   -- C35502F
+ 
+      TEST ("C35502F", "IMAGE AND VALUE ATTRIBUTES FOR A FORMAL " &
+                       "DISCRETE TYPE WITH ONE ACTUAL VALUE HAVING " &
+                       "LONGEST POSSIBLE IDENTIFIER");
+      TEST_PROC;
+      RESULT;
+ 
+ END C35502F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C35502G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN 
+ -- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A 
+ -- CHARACTER TYPE.
+ 
+ -- RJW 5/27/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502G IS
+ 
+           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+           SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+           TYPE NEWENUM IS NEW ENUM;
+           SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+ 
+ BEGIN
+      TEST ("C35502G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                       "ENUMERATION TYPE OTHER THAN A CHARACTER " &
+                       "OR A BOOLEAN TYPE" );
+ 
+      BEGIN
+           FOR I IN ENUM'VAL (1) .. ENUM'VAL (4) LOOP
+                IF SUBENUM'PRED (I) /= 
+                   ENUM'VAL (ENUM'POS (I) - 1) THEN
+                     FAILED ("INCORRECT SUBENUM'PRED(" &
+                              ENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+ 
+           FOR I IN ENUM'VAL (0) .. ENUM'VAL (3) LOOP
+                IF SUBENUM'SUCC (I) /= 
+                   ENUM'VAL (ENUM'POS (I) + 1) THEN
+                     FAILED ("INCORRECT SUBENUM'SUCC(" &
+                              ENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+      END;
+ 
+      BEGIN
+           FOR I IN NEWENUM'VAL (1) .. NEWENUM'VAL (4) LOOP
+                IF SUBNEW'PRED (I) /= 
+                   NEWENUM'VAL (NEWENUM'POS (I) - 1) THEN
+                     FAILED ("INCORRECT SUBNEW'PRED(" &
+                              NEWENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+ 
+           FOR I IN NEWENUM'VAL (0) .. NEWENUM'VAL (3) LOOP
+                IF SUBNEW'SUCC (I) /= 
+                   NEWENUM'VAL (NEWENUM'POS (I) + 1) THEN
+                     FAILED ("INCORRECT SUBNEW'SUCC(" &
+                              NEWENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+      END;
+ 
+      RESULT;
+ END C35502G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C35502H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN 
+ -- THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+ -- AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A CHARACTER TYPE.
+ 
+ -- RJW 5/27/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502H IS
+ 
+           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+ 
+           TYPE NEWENUM IS NEW ENUM;
+ 
+ BEGIN
+      TEST ("C35502H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                       "ARGUMENT IS AN ENUMERATION TYPE OTHER THAN " &
+                       "A CHARACTER OR A BOOLEAN TYPE" );
+ 
+      DECLARE
+           GENERIC
+                TYPE E IS (<>);
+                STR : STRING;
+           PROCEDURE P;
+           
+           PROCEDURE P IS
+                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+           BEGIN
+                FOR I IN E'VAL (1) .. E'VAL (4) LOOP
+                     IF SE'PRED (I) /= 
+                        E'VAL (E'POS (I) - 1) THEN
+                          FAILED ("INCORRECT " & STR & "'PRED(" &
+                                   E'IMAGE (I) & ")" );
+                     END IF;
+                END LOOP;
+ 
+                FOR I IN E'VAL (0) .. E'VAL (3) LOOP
+                     IF SE'SUCC (I) /= 
+                        E'VAL (E'POS (I) + 1) THEN
+                          FAILED ("INCORRECT " & STR & "'SUCC(" &
+                                   E'IMAGE (I) & ")" );
+                     END IF;
+                END LOOP;
+ 
+           END P;
+ 
+           PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+ 
+      BEGIN
+           PE;
+           PN;
+      END;
+           
+      RESULT;
+ END C35502H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C35502I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN
+ --     THE PREFIX IS AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A
+ --     CHARACTER TYPE, WITH A REPRESENTATION CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 05/27/86  CREATED ORIGINAL TEST.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502I IS
+ 
+      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+      FOR ENUM USE (A => 2, BC => 4, ABC => 6,
+                    A_B_C => 8, ABCD => 10);
+      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+      TYPE NEWENUM IS NEW ENUM;
+      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+ 
+ BEGIN
+      TEST ("C35502I", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                       "ENUMERATION TYPE, OTHER THAN A CHARACTER " &
+                       "OR A BOOLEAN TYPE, WITH A REPRESENTATION " &
+                       "CLAUSE" );
+ 
+      BEGIN
+           FOR I IN ENUM'VAL (1) .. ENUM'VAL (4) LOOP
+                IF SUBENUM'PRED (I) /=
+                   ENUM'VAL (ENUM'POS (I) - 1) THEN
+                     FAILED ("INCORRECT SUBENUM'PRED(" &
+                              ENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+ 
+           FOR I IN ENUM'VAL (0) .. ENUM'VAL (3) LOOP
+                IF SUBENUM'SUCC (I) /=
+                   ENUM'VAL (ENUM'POS (I) + 1) THEN
+                     FAILED ("INCORRECT SUBENUM'SUCC(" &
+                              ENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+      END;
+ 
+      BEGIN
+           FOR I IN NEWENUM'VAL (1) .. NEWENUM'VAL (4) LOOP
+                IF SUBNEW'PRED (I) /=
+                   NEWENUM'VAL (NEWENUM'POS (I) - 1) THEN
+                     FAILED ("INCORRECT SUBNEW'PRED(" &
+                              NEWENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+ 
+           FOR I IN NEWENUM'VAL (0) .. NEWENUM'VAL (3) LOOP
+                IF SUBNEW'SUCC (I) /=
+                   NEWENUM'VAL (NEWENUM'POS (I) + 1) THEN
+                     FAILED ("INCORRECT SUBNEW'SUCC(" &
+                              NEWENUM'IMAGE (I) & ")" );
+                END IF;
+           END LOOP;
+      END;
+ 
+      RESULT;
+ END C35502I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C35502J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN
+ --     THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+ --     AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A CHARACTER TYPE,
+ --     WITH AN ENUMERATION REPRESENTATION CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 05/27/86  CREATED ORIGINAL TEST.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502J IS
+           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+           FOR ENUM USE (A => 2, BC => 4, ABC => 6,
+                         A_B_C => 8, ABCD => 10);
+ 
+           TYPE NEWENUM IS NEW ENUM;
+ 
+ BEGIN
+      TEST ("C35502J", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS " &
+                       "A FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                       "ARGUMENT IS AN ENUMERATION TYPE, OTHER THAN " &
+                       "A CHARACTER OR A BOOLEAN TYPE, WITH AN " &
+                       "ENUMERATION REPRESENTATION CLAUSE" );
+ 
+      DECLARE
+           GENERIC
+                TYPE E IS (<>);
+                STR : STRING;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+ 
+           BEGIN
+                FOR I IN E'VAL (1) .. E'VAL (4)
+                     LOOP
+                          IF SE'PRED (I) /=
+                             E'VAL (E'POS (I) - 1) THEN
+                               FAILED ("INCORRECT " & STR & "'PRED(" &
+                                        E'IMAGE (I) & ")" );
+                          END IF;
+                     END LOOP;
+ 
+                FOR I IN E'VAL (0) .. E'VAL (3)
+                     LOOP
+                          IF SE'SUCC (I) /=
+                             E'VAL (E'POS (I) + 1) THEN
+                               FAILED ("INCORRECT " & STR & "'SUCC(" &
+                                        E'IMAGE (I) & ")" );
+                          END IF;
+                     END LOOP;
+ 
+      END P;
+ 
+      PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+      PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+ 
+      BEGIN
+           PE;
+           PN;
+      END;
+ 
+      RESULT;
+ END C35502J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,174 ----
+ -- C35502K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
+ -- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A
+ -- CHARACTER TYPE.
+ 
+ -- RJW 5/27/86
+ -- GMT 7/02/87  ADDED ENUM'VAL(3) CHECK NEAR END OF 2ND BLOCK STATEMENT.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502K IS
+ 
+      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+      TYPE NEWENUM IS NEW ENUM;
+      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+ 
+ BEGIN
+      TEST ("C35502K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                       "ENUMERATION TYPE OTHER THAN A CHARACTER " &
+                       "OR A BOOLEAN TYPE" );
+ 
+      DECLARE
+           POSITION : INTEGER;
+      BEGIN
+           POSITION := 0;
+ 
+           FOR E IN ENUM LOOP
+                IF SUBENUM'POS (E) /= POSITION THEN
+                     FAILED ( "INCORRECT SUBENUM'POS (" &
+                               ENUM'IMAGE (E) & ")" );
+                END IF;
+ 
+                IF SUBENUM'VAL (POSITION) /= E THEN
+                     FAILED ( "INCORRECT SUBENUM'VAL (" &
+                               INTEGER'IMAGE (POSITION) &
+                              ")" );
+                END IF;
+ 
+                POSITION := POSITION + 1;
+           END LOOP;
+ 
+           POSITION := 0;
+           FOR E IN NEWENUM LOOP
+                IF SUBNEW'POS (E) /= POSITION THEN
+                     FAILED ( "INCORRECT SUBNEW'POS (" &
+                               NEWENUM'IMAGE (E) & ")" );
+                END IF;
+ 
+                IF SUBNEW'VAL (POSITION) /= E THEN
+                     FAILED ( "INCORRECT SUBNEW'VAL (" &
+                               INTEGER'IMAGE (POSITION) &
+                              ")" );
+                END IF;
+ 
+                POSITION := POSITION + 1;
+           END LOOP;
+      END;
+ 
+      DECLARE
+           FUNCTION A_B_C RETURN ENUM IS
+           BEGIN
+                RETURN ENUM'VAL (IDENT_INT (0));
+           END A_B_C;
+ 
+      BEGIN
+           IF ENUM'VAL (0) /= A_B_C THEN
+                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                         "BY FUNCTION - 1" );
+           END IF;
+ 
+           IF ENUM'VAL (0) = C35502K.A_B_C THEN
+                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                         "BY FUNCTION - 2" );
+           END IF;
+ 
+           IF ENUM'VAL (3) /= C35502K.A_B_C THEN
+                FAILED ( "WRONG ENUM'VAL (3) WHEN HIDDEN " &
+                         "BY FUNCTION - 3" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF ENUM'VAL (IDENT_INT (-1)) = A THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR ENUM'VAL (IDENT_INT (-1)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR ENUM'VAL (IDENT_INT (-1)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR ENUM'VAL (IDENT_INT (-1))" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VAL (IDENT_INT (-1)) = A THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (-1))" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VAL (IDENT_INT (5)) = A THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR ENUM'VAL (IDENT_INT (5)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR ENUM'VAL (IDENT_INT (5)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR ENUM'VAL (IDENT_INT (5))" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VAL (IDENT_INT (5)) = A THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (5)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (5)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (5))" );
+      END;
+ 
+      RESULT;
+ END C35502K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C35502L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN 
+ -- THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+ -- AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A CHARACTER TYPE.
+ 
+ -- RJW 5/27/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502L IS
+      
+      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+      TYPE NEWENUM IS NEW ENUM;
+      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+ 
+ BEGIN
+      TEST ("C35502L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT " &
+                       "IS AN ENUMERATION TYPE OTHER THAN A " &
+                       "CHARACTER OR A BOOLEAN TYPE" );
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE E IS (<>);
+                STR : STRING;
+           PROCEDURE P;
+           
+           PROCEDURE P IS
+                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+                POSITION : INTEGER;
+           BEGIN
+      
+                POSITION := 0;
+ 
+                FOR E1 IN E
+                     LOOP
+                          IF SE'POS (E1) /= POSITION THEN
+                               FAILED ( "INCORRECT SE'POS (" &
+                                         E'IMAGE (E1) & ")" );
+                          END IF;
+                     
+                          IF SE'VAL (POSITION) /= E1 THEN 
+                               FAILED ( "INCORRECT " & STR & "'VAL (" &
+                                         INTEGER'IMAGE (POSITION) & 
+                                        ")" );
+                          END IF;
+      
+                          POSITION := POSITION + 1;
+                     END LOOP;
+           
+                BEGIN
+                     IF E'VAL (-1) = E'VAL (1) THEN
+                          FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                    STR & "'VAL (-1) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                    STR & "'VAL (-1) - 2" );
+                     END IF;
+                EXCEPTION
+                      WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " & 
+                                    STR & "'VAL (-1)" );
+                END;
+ 
+                BEGIN
+                     IF E'VAL (5) = E'VAL (4) THEN
+                          FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                    STR & "'VAL (5) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                    STR & "'VAL (5) - 2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " & 
+                                    STR & "'VAL (5)" );
+                END;
+           END P;
+      
+           PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+      BEGIN          
+           PE;          
+           PN;
+      END;
+      
+      DECLARE
+           GENERIC
+                TYPE E IS (<>);
+           FUNCTION F (E1 : E) RETURN BOOLEAN;
+ 
+           FUNCTION F (E1 : E) RETURN BOOLEAN IS
+           BEGIN
+                RETURN E'VAL (0) = E1;
+           END F;               
+      
+           FUNCTION FE IS NEW F (ENUM);
+ 
+      BEGIN
+ 
+           DECLARE
+                FUNCTION A_B_C RETURN ENUM IS
+                BEGIN
+                     RETURN ENUM'VAL (IDENT_INT (0));
+                END A_B_C;
+           BEGIN
+                IF FE (A_B_C) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT VAL FOR A_B_C WHEN HIDDEN " &
+                              "BY A FUNCTION" );
+                END IF;
+ 
+                IF FE (C35502L.A_B_C) THEN
+                     FAILED ( "INCORRECT VAL FOR C35502L.A_B_C" );
+                END IF;
+          END;
+      END;
+ 
+      RESULT;
+ END C35502L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,177 ----
+ -- C35502M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
+ --     THE PREFIX IS AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A
+ --     CHARACTER TYPE, WITH AN ENUMERATION REPRESENTATION CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 05/27/86  CREATED ORIGINAL TEST.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502M IS
+ 
+      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+      FOR ENUM USE (A => 2, BC => 4, ABC => 6,
+                    A_B_C => 8, ABCD => 10);
+ 
+      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+      TYPE NEWENUM IS NEW ENUM;
+      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+ 
+ BEGIN
+      TEST ("C35502M", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                       "ENUMERATION TYPE, OTHER THAN A CHARACTER " &
+                       "OR A BOOLEAN TYPE, WITH AN ENUMERATION " &
+                       "REPRESENTATION CLAUSE" );
+ 
+      DECLARE
+           POSITION : INTEGER;
+      BEGIN
+           POSITION := 0;
+ 
+           FOR E IN ENUM
+                LOOP
+                     IF SUBENUM'POS (E) /= POSITION THEN
+                          FAILED ( "INCORRECT SUBENUM'POS (" &
+                                    ENUM'IMAGE (E) & ")" );
+                     END IF;
+ 
+                     IF SUBENUM'VAL (POSITION) /= E THEN
+                          FAILED ( "INCORRECT SUBENUM'VAL (" &
+                                    INTEGER'IMAGE (POSITION) &
+                                   ")" );
+                     END IF;
+ 
+                     POSITION := POSITION + 1;
+                END LOOP;
+ 
+           POSITION := 0;
+           FOR E IN NEWENUM
+                LOOP
+                     IF SUBNEW'POS (E) /= POSITION THEN
+                          FAILED ( "INCORRECT SUBNEW'POS (" &
+                                    NEWENUM'IMAGE (E) & ")" );
+                     END IF;
+ 
+                     IF SUBNEW'VAL (POSITION) /= E THEN
+                          FAILED ( "INCORRECT SUBNEW'VAL (" &
+                                    INTEGER'IMAGE (POSITION) &
+                                   ")" );
+                     END IF;
+ 
+                     POSITION := POSITION + 1;
+                END LOOP;
+      END;
+ 
+      DECLARE
+           FUNCTION A_B_C RETURN ENUM IS
+           BEGIN
+                RETURN A;
+           END A_B_C;
+ 
+      BEGIN
+           IF ENUM'VAL (0) /= A_B_C THEN
+                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                         "BY FUNCTION - 1" );
+           END IF;
+ 
+           IF ENUM'VAL (0) = C35502M.A_B_C THEN
+                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                         "BY FUNCTION - 2" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF ENUM'VAL (IDENT_INT (-1)) = ENUM'FIRST THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "ENUM'VAL (IDENT_INT (-1)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "ENUM'VAL (IDENT_INT (-1)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "ENUM'VAL (IDENT_INT (-1))" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VAL (IDENT_INT (-1)) = NEWENUM'LAST THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (-1))" );
+      END;
+ 
+      BEGIN
+           IF ENUM'VAL (IDENT_INT (5)) = ENUM'LAST THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "ENUM'VAL (IDENT_INT (5)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "ENUM'VAL (IDENT_INT (5)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "ENUM'VAL (IDENT_INT (5))" );
+      END;
+ 
+      BEGIN
+           IF NEWENUM'VAL (IDENT_INT (5)) = NEWENUM'LAST THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (5)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (5)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NEWENUM'VAL (IDENT_INT (5))" );
+      END;
+ 
+      RESULT;
+ END C35502M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502n.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502n.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502n.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C35502N.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
+ --     THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+ --     AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A CHARACTER TYPE,
+ --     WITH AN ENUMERATION REPRESENTATION CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 05/27/86
+ --     DWC 07/22/87  ADDED THE PARAMETER 'N' TO FUNCTION F.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35502N IS
+ 
+      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+      FOR ENUM USE (A => 1, BC => 4, ABC => 5, A_B_C => 6,
+                    ABCD => 8);
+ 
+      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+ 
+      TYPE NEWENUM IS NEW ENUM;
+      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+ 
+ BEGIN
+      TEST ("C35502N", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT " &
+                       "IS AN ENUMERATION TYPE, OTHER THAN A " &
+                       "CHARACTER OR A BOOLEAN TYPE, WITH AN " &
+                       "ENUMERATION REPRESENTATION CLAUSE" );
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE E IS (<>);
+                STR : STRING;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+                POSITION : INTEGER;
+           BEGIN
+ 
+                POSITION := 0;
+ 
+                FOR E1 IN E LOOP
+                     IF SE'POS (E1) /= POSITION THEN
+                          FAILED ( "INCORRECT " & STR & "'POS (" &
+                                    E'IMAGE (E1) & ")" );
+                     END IF;
+ 
+                     IF SE'VAL (POSITION) /= E1 THEN
+                          FAILED ( "INCORRECT " & STR & "'VAL (" &
+                                    INTEGER'IMAGE (POSITION) &
+                                    ")" );
+                     END IF;
+ 
+                     POSITION := POSITION + 1;
+                END LOOP;
+ 
+                BEGIN
+                     IF E'VAL (-1) = E'VAL (1) THEN
+                          FAILED ( "NO EXCEPTION RAISED FOR " &
+                                    STR & "'VAL (-1) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED FOR " &
+                                    STR & "'VAL (-1) - 2" );
+                     END IF;
+                EXCEPTION
+                      WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'VAL (-1)" );
+                END;
+ 
+                BEGIN
+                     IF E'VAL (5) = E'VAL (4) THEN
+                          FAILED ( "NO EXCEPTION RAISED FOR " &
+                                    STR & "'VAL (5) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED FOR " &
+                                    STR & "'VAL (5) - 2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'VAL (5)" );
+                END;
+           END P;
+ 
+           PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+           PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+      BEGIN
+           PE;
+           PN;
+      END;
+ 
+      DECLARE
+           FUNCTION A_B_C RETURN ENUM IS
+           BEGIN
+                RETURN ENUM'VAL (IDENT_INT (0));
+           END A_B_C;
+ 
+           GENERIC
+                TYPE E IS (<>);
+           FUNCTION F (N : INTEGER;
+                       E1 : E) RETURN BOOLEAN;
+ 
+           FUNCTION F (N : INTEGER;
+                       E1 : E) RETURN BOOLEAN IS
+           BEGIN
+                RETURN E'VAL (N) = E1;
+           END F;
+ 
+           FUNCTION FE IS NEW F (ENUM);
+ 
+      BEGIN
+ 
+      IF NOT FE (0, A_B_C) THEN
+           FAILED ( "INCORRECT VAL FOR A_B_C WHEN HIDDEN " &
+                    "BY A FUNCTION" );
+      END IF;
+ 
+      IF NOT FE (3, C35502N.A_B_C) THEN
+                     FAILED ( "INCORRECT VAL FOR C35502N.A_B_C" );
+      END IF;
+      END;
+ 
+      RESULT;
+ END C35502N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,52 ----
+ -- C35502O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'FIRST AND 'LAST GIVE CORRECT RESULTS FOR TYPES
+ -- AND SUBTYPES.
+ 
+ -- DAT 3/17/81
+ -- R. WILLIAMS 11/11/86      RENAMED FROM C35104A.ADA.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35502O IS
+ 
+      TYPE E IS (E1, E2, E3, E4, E5);
+ 
+      SUBTYPE S IS E RANGE E2 .. E4;
+ 
+ BEGIN
+      TEST ("C35502O", "CHECK THAT 'FIRST AND 'LAST WORK FOR"
+           & " ENUMERATION TYPES AND SUBTYPES");
+ 
+      IF E'FIRST /= E1 OR E'LAST /= E5
+      OR E'BASE'FIRST /= E1 OR E'BASE'LAST /= E5
+      OR S'BASE'FIRST /= E1 OR S'BASE'LAST /= E5
+      OR S'FIRST /= E2 OR S'LAST /= E4
+      OR BOOLEAN'FIRST /= FALSE OR BOOLEAN'LAST /= TRUE
+      THEN
+           FAILED ("'FIRST OR 'LAST GIVES WRONG RESULTS");
+      END IF;
+ 
+      RESULT;
+ END C35502O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35502p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35502p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- C35502P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR AN ENUMERATION TYPE OTHER THAN BOOLEAN OR CHARACTER TYPE,
+ --     CHECK THAT THE RESULTS AND TYPE PRODUCED BY THE ATTRIBUTES
+ --     ARE CORRECT.
+ 
+ --     CHECK THAT 'FIRST AND 'LAST YIELD CORRECT RESULTS WHEN THE
+ --     PREFIX DENOTES A NULL SUBTYPE.
+ 
+ -- HISTORY:
+ --     RJW 05/05/86  CREATED ORIGINAL TEST.
+ --     CJJ 06/09/87  CHANGED "=" COMPARISONS IN GENERIC
+ --                   PROCEDURE Q TO "/=".
+ 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35502P  IS
+ 
+ BEGIN
+ 
+      TEST( "C35502P" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
+                        "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
+                        "WHOSE ACTUAL PARAMETER IS AN ENUMERATION " &
+                        "TYPE OTHER THAN A CHARACTER OR A BOOLEAN " &
+                        "TYPE" );
+ 
+      DECLARE
+        -- FOR THESE DECLARATIONS, 'FIRST AND 'LAST REFER TO THE
+        -- SUBTYPE VALUES, BUT 'VAL AND 'POS ARE INHERITED FROM THE
+        -- BASE TYPE.
+ 
+           TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+           SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
+ 
+           TYPE NEWENUM IS NEW ENUM RANGE BC .. A_B_C;
+           TYPE NONEWENUM IS NEW ENUM RANGE ABCD .. A;
+           GENERIC
+                TYPE E IS (<>);
+                F, L : E;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                SUBTYPE NOENUM IS E RANGE
+                    E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
+           BEGIN
+                IF E'FIRST /= F THEN
+                     FAILED ( "INCORRECT E'FIRST FOR " & STR );
+                END IF;
+                IF NOENUM'FIRST /= E'VAL (2) THEN
+                     FAILED ( "INCORRECT NOENUM'FIRST FOR " & STR );
+                END IF;
+ 
+                IF E'LAST /= L THEN
+                     FAILED ( "INCORRECT E'LAST FOR " & STR );
+                END IF;
+                IF NOENUM'LAST /= E'VAL (1) THEN
+                     FAILED ( "INCORRECT NOENUM'LAST FOR " & STR );
+                END IF;
+           END P;
+ 
+           GENERIC
+                TYPE E IS (<>);
+           PROCEDURE Q;
+ 
+           PROCEDURE Q IS
+                SUBTYPE NOENUM IS E RANGE
+                        E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
+           BEGIN
+                IF E'FIRST /= E'VAL (IDENT_INT(4)) THEN
+                     FAILED ( "INCORRECT E'FIRST FOR NONEWENUM" );
+                END IF;
+                IF NOENUM'FIRST /= E'VAL (2) THEN
+                     FAILED ( "INCORRECT NOENUM'FIRST FOR NONEWENUM");
+                END IF;
+ 
+                IF E'LAST /= E'VAL (IDENT_INT(0)) THEN
+                     FAILED ( "INCORRECT E'LAST FOR NONEWENUM");
+                END IF;
+                IF NOENUM'LAST /= E'VAL (1) THEN
+                     FAILED ( "INCORRECT NOENUM'LAST FOR NONEWENUM");
+                END IF;
+           END Q;
+ 
+           PROCEDURE PROC1 IS NEW P (ENUM, A, ABCD);
+           PROCEDURE PROC2 IS NEW P (SUBENUM, A, ABC);
+           PROCEDURE PROC3 IS NEW P (NEWENUM, BC, A_B_C);
+           PROCEDURE PROC4 IS NEW Q (NONEWENUM);
+ 
+      BEGIN
+           PROC1 ( "ENUM" );
+           PROC2 ( "SUBENUM" );
+           PROC3 ( "NEWENUM" );
+           PROC4;
+      END;
+ 
+      RESULT;
+ END C35502P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C35503A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'WIDTH' YIELDS THE CORRECT RESULT WHEN THE PREFIX IS AN 
+ -- INTEGER TYPE.
+ 
+ -- RJW 3/12/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503A IS
+ 
+ BEGIN
+      TEST ("C35503A", "CHECK THAT 'WIDTH' YIELDS THE CORRECT " &
+                       "RESULT WHEN THE PREFIX IS AN INTEGER TYPE" );
+ 
+      DECLARE
+           SUBTYPE SINTEGER IS INTEGER;
+           
+           TYPE INT IS RANGE -1000 .. 1000;
+           TYPE INT2 IS NEW INT RANGE 1E2 .. 1E2;
+ 
+           SUBTYPE SINT1 IS INT RANGE 00000 .. 100;
+           SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
+           SUBTYPE SINT3 IS INT RANGE -100 .. 9;
+           SUBTYPE NOINT IS INT RANGE 1 .. -1;
+ 
+      BEGIN
+           IF IDENT_INT(SINTEGER'WIDTH) /= INTEGER'WIDTH THEN
+                FAILED ( "WRONG WIDTH FOR 'SINTEGER'" );
+           END IF;
+ 
+           IF IDENT_INT(INT'WIDTH) /= 5 THEN
+                FAILED ( "WRONG WIDTH FOR 'INT'" );
+           END IF;
+ 
+           IF IDENT_INT(INT2'WIDTH) /= 4 THEN
+                FAILED ( "WRONG WIDTH FOR 'INT2'");
+           END IF;
+ 
+           IF IDENT_INT(SINT1'WIDTH) /= 4 THEN 
+                FAILED ( "WRONG WIDTH FOR 'SINT1'" );
+           END IF;
+ 
+           IF IDENT_INT(SINT2'WIDTH) /= 4 THEN 
+                FAILED ( "WRONG WIDTH FOR 'SINT2'" );
+           END IF;
+ 
+           IF IDENT_INT(SINT3'WIDTH) /= 4 THEN
+                FAILED ( "WRONG WIDTH FOR 'SINT3'" );
+           END IF;
+ 
+           IF IDENT_INT(NOINT'WIDTH) /= 0 THEN
+                FAILED ( "WRONG WIDTH FOR 'NOINT'" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C35503A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C35503B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'WIDTH' YIELDS THE CORRECT RESULT WHEN THE PREFIX IS A
+ -- GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN INTEGER 
+ -- TYPE.
+ 
+ -- RJW 3/17/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503B IS
+ 
+ BEGIN
+      TEST ("C35503B", "CHECK THAT 'WIDTH' YIELDS THE CORRECT " &
+                       "RESULT WHEN THE PREFIX IS A GENERIC FORMAL "  &
+                       "DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN " &
+                       "INTEGER TYPE" );
+ 
+      DECLARE
+ 
+           TYPE INT IS RANGE -1000 .. 1000;
+           TYPE INT2 IS NEW INT RANGE 0E8 .. 1E3;
+           SUBTYPE SINT1 IS INT RANGE 00000 .. 300;
+           SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
+ 
+           GENERIC
+                TYPE I IS (<>);
+                W : INTEGER;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                SUBTYPE SUBI IS I 
+                     RANGE I'VAL (IDENT_INT(224)) .. I'VAL (255);
+                SUBTYPE NORANGE IS I 
+                     RANGE I'VAL (255) .. I'VAL (IDENT_INT(224));
+           BEGIN
+                IF IDENT_INT(I'WIDTH) /= W THEN 
+                     FAILED ( "INCORRECT I'WIDTH FOR " & STR );
+                END IF;
+ 
+                IF IDENT_INT(SUBI'WIDTH) /= 4 THEN
+                     FAILED ( "INCORRECT SUBI'WIDTH FOR " & STR );
+                END IF;
+ 
+                IF IDENT_INT(NORANGE'WIDTH) /= 0 THEN
+                     FAILED ( "INCORRECT NORANGE'WIDTH FOR " & STR );
+                END IF;
+           END P;
+ 
+           PROCEDURE P_INTEGER IS NEW P (INTEGER, INTEGER'WIDTH);
+           PROCEDURE P_INT     IS NEW P (INT, 5);
+           PROCEDURE P_INT2    IS NEW P (INT2, 5);
+           PROCEDURE P_SINT1   IS NEW P (SINT1, 4);
+           PROCEDURE P_SINT2   IS NEW P (SINT2, 4);
+ 
+      BEGIN
+           P_INTEGER ("'INTEGER'");
+           P_INT     ("'INT'");
+           P_INT2    ("'INT2'");
+           P_SINT1   ("'SINT1'");
+           P_SINT2   ("'SINT2'");
+      END;
+ 
+      RESULT;
+ END C35503B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,543 ----
+ -- C35503C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
+ --     THE PREFIX IS AN INTEGER TYPE.
+ --     SUBTESTS ARE :
+ --         PART (A). TESTS FOR 'IMAGE'.
+ --         PART (B). TESTS FOR 'VALUE'.
+ 
+ -- HISTORY:
+ --     RJW  03/17/86  CREATED ORIGINAL TEST.
+ --     VCL  10/23/87  MODIFIED THIS HEADER, ADDED A CHECK THAT
+ --                    CONSTRAINT_ERROR IS RAISED FOR THE ATTRIBUTE
+ --                    'VALUE' IF THE FINAL SHARP OR COLON IS MISSING
+ --                    FROM A BASED LITERAL.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35503C IS
+      TYPE NEWINT IS NEW INTEGER;
+      TYPE INT IS RANGE -1000 .. 1000;
+ 
+      FUNCTION IDENT (X : INT) RETURN INT IS
+      BEGIN
+           IF EQUAL (INT'POS (X), INT'POS(X)) THEN
+                RETURN X;
+           END IF;
+           RETURN INT'FIRST;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C35503C", "THE ATTIBUTES 'IMAGE' AND 'VALUE' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                       "INTEGER TYPE" );
+ -- PART (A).
+ 
+      BEGIN
+           IF INTEGER'IMAGE (-500) /= "-500" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-500'" );
+           END IF;
+           IF INTEGER'IMAGE (-500)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-500'" );
+           END IF;
+ 
+           IF NEWINT'IMAGE (2 ** 6) /= " 64" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '2 ** 6'" );
+           END IF;
+           IF NEWINT'IMAGE (2 ** 6)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '2 ** 6'" );
+           END IF;
+ 
+           IF NATURAL'IMAGE (-1E2) /= "-100" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-1E2'" );
+           END IF;
+           IF NATURAL'IMAGE (-1E2)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-1E2'" );
+           END IF;
+ 
+           IF NEWINT'IMAGE (3_45) /= " 345" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '3_45'" );
+           END IF;
+           IF NEWINT'IMAGE (3_45)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '3_45'" );
+           END IF;
+ 
+           IF INTEGER'IMAGE (-2#1111_1111#) /= "-255" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-2#1111_1111#'" );
+           END IF;
+           IF INTEGER'IMAGE (-2#1111_1111#)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-2#1111_1111#'" );
+           END IF;
+ 
+           IF NEWINT'IMAGE (16#FF#) /= " 255" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '16#FF#'" );
+           END IF;
+           IF NEWINT'IMAGE (16#FF#)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '16#FF#'" );
+           END IF;
+ 
+           IF INTEGER'IMAGE (-016#0FF#) /= "-255" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-016#0FF#'" );
+           END IF;
+           IF INTEGER'IMAGE (-016#0FF#)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-016#0FF#'" );
+           END IF;
+ 
+           IF NEWINT'IMAGE (2#1110_0000#) /= " 224" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '2#1110_0000#'" );
+           END IF;
+           IF NEWINT'IMAGE (2#1110_0000#)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '2#1110_0000#'" );
+           END IF;
+ 
+           IF POSITIVE'IMAGE (-16#E#E1) /= "-224" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-16#E#E1'" );
+           END IF;
+           IF POSITIVE'IMAGE (-16#E#E1)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-16#E#E1'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(-1000)) /= "-1000" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-1000'" );
+           END IF;
+           IF INT'IMAGE (IDENT(-1000))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-1000'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(-999)) /= "-999" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-999'" );
+           END IF;
+           IF INT'IMAGE (IDENT(-999))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-999'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(-10)) /= "-10" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-1000'" );
+           END IF;
+           IF INT'IMAGE (IDENT(-10))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-10'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(-9)) /= "-9" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-9'" );
+           END IF;
+           IF INT'IMAGE (IDENT(-9))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-9'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(-1)) /= "-1" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '-1'" );
+           END IF;
+           IF INT'IMAGE (IDENT(-1))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '-1'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(0)) /= " 0" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '0'" );
+           END IF;
+           IF INT'IMAGE (IDENT(0))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '0'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(1)) /= " 1" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '1'" );
+           END IF;
+           IF INT'IMAGE (IDENT(1))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '1'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(9)) /= " 9" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '9'" );
+           END IF;
+           IF INT'IMAGE (IDENT(9))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '9'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(10)) /= " 10" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '10'" );
+           END IF;
+           IF INT'IMAGE (IDENT(10))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '10'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(999)) /= " 999" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '999'" );
+           END IF;
+           IF INT'IMAGE (IDENT(999))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '999'" );
+           END IF;
+ 
+           IF INT'IMAGE (IDENT(1000)) /= " 1000" THEN
+                FAILED ( "INCORRECT 'IMAGE' OF '1000'" );
+           END IF;
+           IF INT'IMAGE (IDENT(1000))'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR '1000'" );
+           END IF;
+ 
+      END;
+ 
+ -----------------------------------------------------------------------
+ 
+ -- PART (B).
+ 
+      BEGIN
+           IF POSITIVE'VALUE (IDENT_STR("-500")) /= -500 THEN
+                FAILED ( "INCORRECT 'VALUE' OF ""-500""" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""-500""" );
+      END;
+ 
+      BEGIN
+           IF NEWINT'VALUE (" -001E2") /= -100 THEN
+                FAILED ( "INCORRECT 'VALUE' OF "" -001E2""" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF "" -001E2""" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE ("03_45") /= 345 THEN
+                FAILED ( "INCORRECT 'VALUE' OF ""03_45""" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""03_45""" );
+      END;
+ 
+      BEGIN
+           IF NEWINT'VALUE ("-2#1111_1111#") /= -255 THEN
+                FAILED ( "INCORRECT 'VALUE' OF ""-2#1111_1111#""" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF "&
+                         """-2#1111_1111#""" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("16#FF#")) /= 255 THEN
+                FAILED ( "INCORRECT 'VALUE' OF ""16#FF#""" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""16#FF#""" );
+      END;
+ 
+      BEGIN
+           IF NATURAL'VALUE (IDENT_STR("-016#0FF#")) /= -255 THEN
+                FAILED ( "INCORRECT 'VALUE' OF ""-016#0FF#""" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
+                         """-016#0FF#""" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE ("2#1110_0000#     ") /= 224 THEN
+                FAILED ( "INCORRECT 'VALUE' OF " &
+                         """2#1110_0000#     """ );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
+                         """2#1110_0000#     """ );
+      END;
+ 
+      BEGIN
+           IF NEWINT'VALUE ("  -16#E#E1") /= -224 THEN
+                FAILED ( "INCORRECT 'VALUE' OF ""  -16#E#E1""" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
+                         """  -16#E#E1""" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE ("5/0") = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED - ""5/0"" - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - ""5/0"" - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - ""5/0""" );
+      END;
+ 
+      DECLARE
+           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 10;
+      BEGIN
+           IF SUBINT'VALUE (IDENT_STR("-500")) /= -500 THEN
+                FAILED ( "INCORRECT VALUE WITH ""-500"" AND SUBINT" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - SUBINT" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("1.0")) = 1 THEN
+                FAILED ( "NO EXCEPTION RAISED - "" 1.0"" - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - ""1.0"" - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - ""1.0"" " );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_CHAR(ASCII.HT) & "244") /= 244 THEN
+                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE ("244" & (IDENT_CHAR(ASCII.HT))) /= 244 THEN
+                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("2__44")) /= 244 THEN
+                FAILED ( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "WITH CONSECUTIVE '_'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("_244")) /= 244 THEN
+                FAILED ( "NO EXCEPTION RAISED - LEADING '_' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - LEADING '_' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - LEADING '_'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("244_")) /= 244 THEN
+                FAILED ( "NO EXCEPTION RAISED - TRAILING '_' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - TRAILING '_' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - TRAILING '_'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("244_E1")) /= 2440 THEN
+                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - '_' BEFORE 'E'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("244E_1")) /= 2440 THEN
+                FAILED ( "NO EXCEPTION RAISED - '_' " &
+                         "FOLLOWING 'E' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - '_' FOLLOWING 'E' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "- '_' FOLLOWING 'E'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("244_e1")) /= 2440 THEN
+                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - '_' BEFORE 'e'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("16#_FF#")) /= 255 THEN
+                FAILED ( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
+                         "LITERAL - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
+                         "LITERAL - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "- LEADING '_' IN BASED LITERAL" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("1E-0")) /= 1 THEN
+                FAILED ( "NO EXCEPTION RAISED - NEGATIVE " &
+                         "EXPONENT - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - NEGATIVE EXPONENT - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "- NEGATIVE EXPONENT" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("244.")) /= 244 THEN
+                FAILED ( "NO EXCEPTION RAISED - TRAILING '.' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - TRAILING '.' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - TRAILING '.'" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("8#811#")) /= 0 THEN
+                FAILED ( "NO EXCEPTION RAISED - " &
+                         "DIGITS NOT IN CORRECT RANGE - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - " &
+                         "DIGITS NOT IN CORRECT RANGE - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - " &
+                         "DIGITS NOT IN CORRECT RANGE" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("1#000#")) /= 0 THEN
+                FAILED ( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "- BASE LESS THAN 2" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("17#0#")) /= 0 THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "- BASE GREATER THAN 16 - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "- BASE GREATER THAN 16 - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "- BASE GREATER THAN 16" );
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("8#666")) /= 438 THEN
+                FAILED ("NO EXCEPTION RAISED - MISSING FINAL SHARP - 1");
+           ELSE
+                FAILED ("NO EXCEPTION RAISED - MISSING FINAL SHARP - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - MISSING FINAL SHARP");
+      END;
+ 
+      BEGIN
+           IF INTEGER'VALUE (IDENT_STR("16:FF")) /= 255 THEN
+                FAILED ("NO EXCEPTION RAISED - MISSING FINAL COLON - 1");
+           ELSE
+                FAILED ("NO EXCEPTION RAISED - MISSING FINAL COLON - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - MISSING FINAL COLON");
+      END;
+ 
+      RESULT;
+ END C35503C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503d.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503d.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503d.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C35503D.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
+ --     LARGEST/SMALLEST INTEGER LITERAL FOR THE LONGEST INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 02/26/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503D IS
+ 
+      TYPE INT IS RANGE MIN_INT .. MAX_INT;
+ 
+      FUNCTION IDENT (X:INT) RETURN INT IS
+           BEGIN
+                IF EQUAL (3,3) THEN
+                     RETURN X;
+                END IF;
+                RETURN 0;
+           END IDENT;
+ 
+ BEGIN
+      TEST ("C35503D", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
+                       "CORRECT RESULTS FOR THE LARGEST/SMALLEST "&
+                       "INTEGER LITERAL FOR THE LARGEST INTEGER TYPE");
+ 
+      -- MIN_INT IS THE DECIMAL LITERAL FOR SYSTEM.MIN_INT.
+      -- MAX_INT IS THE DECIMAL LITERAL FOR SYSTEM.MAX_INT.
+ 
+      BEGIN
+           IF INT'VALUE (IDENT_STR("$MIN_INT")) /= MIN_INT THEN
+                FAILED("INCORRECT RESULTS FOR 'VALUE' - MIN_INT");
+           END IF;
+      EXCEPTION
+            WHEN CONSTRAINT_ERROR =>
+                FAILED("CONSTRAINT_ERROR RAISED FOR 'VALUE' - MIN_INT");
+            WHEN OTHERS =>
+                FAILED("OTHER EXCEPTION RAISED FOR 'VALUE' - MIN_INT");
+      END;
+ 
+      BEGIN
+            IF INT'IMAGE (IDENT(MIN_INT)) /= "$MIN_INT" THEN
+                 FAILED("INCORRECT RESULTS FOR 'IMAGE' - MIN_INT");
+            END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("EXCEPTION RAISED FOR 'IMAGE' - MIN_INT");
+      END;
+ 
+      BEGIN
+            IF INT'VALUE (IDENT_STR("$MAX_INT")) /= MAX_INT THEN
+                FAILED("INCORRECT RESULTS FOR 'VALUE' - MAX_INT");
+            END IF;
+      EXCEPTION
+            WHEN CONSTRAINT_ERROR =>
+                FAILED("CONSTRAINT_ERROR RAISED FOR 'VALUE' - MAX_INT");
+            WHEN OTHERS =>
+                FAILED("OTHER EXCEPTION RAISED FOR 'VALUE' - MAX_INT");
+      END;
+ 
+      BEGIN
+            IF INT'IMAGE (IDENT(MAX_INT)) /= ' ' & "$MAX_INT" THEN
+                FAILED("INCORRECT RESULTS FOR 'IMAGE' - MAXINT");
+            END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("EXCEPTION RAISED FOR 'IMAGE' - MAXINT");
+      END;
+ 
+      RESULT;
+ END C35503D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,212 ----
+ -- C35503E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
+ --     THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL
+ --     PARAMETER IS AN INTEGER TYPE.
+ --     SUBTESTS ARE :
+ --         PART (A). TESTS FOR 'IMAGE'.
+ --         PART (B). TESTS FOR 'VALUE'.
+ 
+ -- HISTORY:
+ --     RJW 03/17/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503E IS
+ 
+ BEGIN
+      TEST ("C35503E", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE " &
+                       "CORRECT RESULTS  WHEN THE PREFIX IS A " &
+                       "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                       "PARAMETER IS AN INTEGER TYPE" );
+ -- PART (A).
+ 
+      DECLARE
+           TYPE NEWINT IS NEW INTEGER RANGE -2000 .. 2000;
+ 
+           GENERIC
+                TYPE INT IS (<>);
+           PROCEDURE P (I1 : INT; STR : STRING );
+ 
+           PROCEDURE P (I1 : INT; STR : STRING) IS
+                SUBTYPE SUBINT IS INT
+                RANGE INT'VAL (IDENT_INT(-1000)) ..
+                                               INT'VAL (IDENT_INT(1000));
+           BEGIN
+ 
+                IF INT'IMAGE (I1) /= STR THEN
+                     FAILED ( "INCORRECT INT'IMAGE OF " & STR );
+                END IF;
+                IF INT'IMAGE (I1)'FIRST /= 1 THEN
+                     FAILED ( "INCORRECT LOWER BOUND FOR INT'IMAGE OF " &
+                              STR );
+                END IF;
+ 
+                IF SUBINT'IMAGE (I1) /= STR THEN
+                     FAILED ( "INCORRECT SUBINT'IMAGE OF " & STR );
+                END IF;
+                IF SUBINT'IMAGE (I1)'FIRST /= 1 THEN
+                     FAILED ( "INCORRECT LOWER BOUND FOR SUBINT'IMAGE " &
+                              "OF " & STR );
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE PROC1 IS NEW P (INTEGER);
+           PROCEDURE PROC2 IS NEW P (NEWINT);
+ 
+      BEGIN
+           PROC1 (-500, "-500");
+           PROC2 (0, " 0");
+           PROC2 (99," 99");
+      END;
+ 
+ -----------------------------------------------------------------------
+ 
+ -- PART (B).
+ 
+      DECLARE
+           TYPE NEWINT IS NEW INTEGER;
+ 
+           GENERIC
+                TYPE INT IS (<>);
+           PROCEDURE P (STR : STRING; I1 : INT );
+ 
+           PROCEDURE P (STR : STRING; I1 : INT) IS
+                SUBTYPE SUBINT IS INT
+                     RANGE INT'VAL (IDENT_INT(0)) ..
+                                                 INT'VAL (IDENT_INT(10));
+ 
+           BEGIN
+                BEGIN
+                     IF INT'VALUE (STR) /= I1 THEN
+                          FAILED ( "INCORRECT INT'VALUE OF """ &
+                                   STR & """");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED INT'VALUE OF """ &
+                                   STR & """");
+                END;
+                BEGIN
+                     IF SUBINT'VALUE (STR) /= I1 THEN
+                          FAILED ( "INCORRECT SUBINT'VALUE OF """ &
+                                   STR & """");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED SUBINT'VALUE " &
+                                   "OF """ & STR & """");
+                END;
+           END P;
+ 
+           PROCEDURE PROC1 IS NEW P (INTEGER);
+           PROCEDURE PROC2 IS NEW P (NEWINT);
+ 
+      BEGIN
+                PROC1 ("-500" , -500);
+                PROC2 (" -001E2 " , -100);
+                PROC1 ("3_45" , 345);
+                PROC2 ("-2#1111_1111#" , -255);
+                PROC1 ("16#FF#" , 255);
+                PROC2 ("-016#0FF#" , -255);
+                PROC1 ("2#1110_0000#     " , 224);
+                PROC2 ("-16#E#E1" , -224);
+ 
+      END;
+ 
+      DECLARE
+           TYPE NEWINT IS NEW INTEGER;
+ 
+           GENERIC
+                TYPE INT IS (<>);
+           PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING);
+ 
+           PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING) IS
+                SUBTYPE SUBINT IS INT
+                     RANGE INT'VAL (IDENT_INT(0)) ..
+                                                 INT'VAL (IDENT_INT(10));
+ 
+           BEGIN
+                BEGIN
+                     IF INT'VALUE (STR1) = I1 THEN
+                          FAILED ( "NO EXCEPTION RAISED - INT'VALUE " &
+                                   "WITH " & STR2 & " - EQUAL");
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED " &
+                                   "- INT'VALUE WITH " &
+                                   STR2 & " - NOT EQUAL" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED - " &
+                                   "INT'VALUE WITH " & STR2 );
+                END;
+                BEGIN
+                     IF SUBINT'VALUE (STR1) = I1 THEN
+                          FAILED ( "NO EXCEPTION RAISED - " &
+                                   "SUBINT'VALUE WITH " & STR2
+                                    & " - EQUAL" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED - " &
+                                   "SUBINT'VALUE WITH " &
+                                    STR2 & " - NOT EQUAL" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED  - " &
+                                   "SUBINT'VALUE WITH " & STR2 );
+                END;
+           END P;
+ 
+           PROCEDURE PROC1 IS NEW P (INTEGER);
+           PROCEDURE PROC2 IS NEW P (NEWINT);
+ 
+      BEGIN
+           PROC1 ("1.0"           , 1,      "DECIMAL POINT");
+           PROC1 (ASCII.HT & "244", 244,    "LEADING 'HT'" );
+           PROC2 ("244" & ASCII.HT, 244,    "TRAILING 'HT'" );
+           PROC1 ("2__44"         , 244,    "CONSECUTIVE '_'" );
+           PROC2 ("_244"          , 244,    "LEADING '_'" );
+           PROC1 ("244_"          , 244,    "TRAILING '_'" );
+           PROC2 ("244_E1"        , 2440,   "'_' BEFORE 'E'" );
+           PROC1 ("244E_1"        , 2440,   "'_' FOLLOWING 'E'" );
+           PROC2 ("244_e1"        , 2440,   "'_' BEFORE 'e'" );
+           PROC1 ("16#_FF#"       , 255,    "'_' IN BASED LITERAL" );
+           PROC2 ("1E-0"          ,   0,    "NEGATIVE EXPONENT" );
+           PROC1 ("244."          , 244,    "TRAILING '.'" );
+           PROC2 ("8#811#"        , 0,      "DIGITS OUTSIDE OF RANGE" );
+           PROC1 ("1#000#"        , 0,      "BASE LESS THAN 2" );
+           PROC2 ("17#0#"         , 0,      "BASE GREATER THAN 16" );
+      END;
+ 
+      RESULT;
+ END C35503E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503f.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503f.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503f.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503f.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- C35503F.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
+ --     LARGEST/SMALLEST INTEGER LITERAL AND A FORMAL DISCRETE TYPE WHOSE
+ --     ACTUAL PARAMETER IS AN INTEGER TYPE.
+ 
+ -- HISTORY
+ --     RJW 05/12/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503F IS
+ 
+ TYPE LONGEST_INT IS RANGE MIN_INT .. MAX_INT;
+ 
+ BEGIN
+      TEST ("C35503F", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
+                       "CORRECT RESULTS FOR THE LARGEST/SMALLEST "&
+                       "INTEGER LITERAL AND A FORMAL DISCRETE TYPE " &
+                       "WHOSE ACTUAL PARAMETER IS AN INTEGER TYPE");
+ 
+      -- INTEGER_FIRST IS THE DECIMAL LITERAL IMAGE OF INTEGER'FIRST.
+      -- INTEGER_LAST IS THE DECIMAL LITERAL IMAGE OF INTEGER'LAST.
+      -- MIN_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MIN_INT.
+      -- MAX_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MAX_INT.
+ 
+      DECLARE
+           GENERIC
+                TYPE INT IS (<>);
+           PROCEDURE P ( FS, LS : STRING; FI, LI : INT );
+ 
+           PROCEDURE P ( FS, LS : STRING; FI, LI : INT ) IS
+           BEGIN
+                BEGIN
+                     IF INT'VALUE (FS) /= FI THEN
+                          FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
+                                   FS );
+                     END IF;
+                EXCEPTION
+                      WHEN CONSTRAINT_ERROR =>
+                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
+                                   "'VALUE' OF " & FS );
+                      WHEN OTHERS =>
+                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
+                                   "'VALUE' OF " & FS );
+                END;
+ 
+                BEGIN
+                     IF INT'VALUE (LS) /= LI THEN
+                          FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
+                                   LS );
+                     END IF;
+                EXCEPTION
+                      WHEN CONSTRAINT_ERROR =>
+                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
+                                   "'VALUE' OF " & LS );
+                      WHEN OTHERS =>
+                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
+                                   "'VALUE' OF " & LS );
+                END;
+           END P;
+ 
+           GENERIC
+                TYPE INT IS  (<>);
+           PROCEDURE Q ( FS, LS : STRING; FI, LI : INT );
+ 
+           PROCEDURE Q ( FS, LS : STRING; FI, LI : INT ) IS
+           BEGIN
+                BEGIN
+                      IF INT'IMAGE(FI) /= FS THEN
+                           FAILED ( "INCORRECT RESULTS FOR " &
+                                    "'IMAGE' WITH " & FS );
+                      END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
+                                    "WITH " & FS );
+                END;
+ 
+                BEGIN
+                      IF INT'IMAGE(LI) /= LS THEN
+                          FAILED ( "INCORRECT RESULTS FOR " &
+                                   "'IMAGE' WITH " & LS );
+                      END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
+                                   "WITH " & LS );
+                END;
+           END Q;
+ 
+           PROCEDURE P1 IS NEW P ( INTEGER );
+           PROCEDURE Q1 IS NEW Q ( INTEGER );
+           PROCEDURE P2 IS NEW P ( LONGEST_INT );
+           PROCEDURE Q2 IS NEW Q ( LONGEST_INT );
+      BEGIN
+           P1 ("$INTEGER_FIRST", "$INTEGER_LAST", INTEGER'FIRST,
+                                                          INTEGER'LAST);
+           P2 ("$MIN_INT", "$MAX_INT", MIN_INT, MAX_INT);
+           Q1 ("$INTEGER_FIRST"," $INTEGER_LAST", INTEGER'FIRST,
+                                                          INTEGER'LAST);
+           Q2 ("$MIN_INT", " $MAX_INT", MIN_INT, MAX_INT);
+ 
+      END;
+ 
+      RESULT;
+ END C35503F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C35503G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULT WHEN THE
+ --     PREFIX IS AN INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/17/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503G IS
+ 
+ BEGIN
+      TEST ("C35503G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULT WHEN THE PREFIX IS AN " &
+                       "INTEGER TYPE" );
+ 
+      DECLARE
+           TYPE INT IS RANGE -6 .. 6;
+           SUBTYPE SINT IS INT RANGE -4 .. 4;
+ 
+      BEGIN
+ 
+           FOR I IN INT'FIRST + 1 .. INT'LAST LOOP
+                BEGIN
+                     IF SINT'PRED (I) /= I - 1 THEN
+                          FAILED ( "WRONG SINT'PRED FOR " &
+                                   INT'IMAGE (I));
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR " &
+                                   "SINT'PRED OF " &
+                                   INT'IMAGE (I));
+                END;
+           END LOOP;
+ 
+           FOR I IN INT'FIRST .. INT'LAST - 1 LOOP
+                BEGIN
+                     IF SINT'SUCC (I) /= I + 1 THEN
+                          FAILED ( "WRONG SINT'SUCC FOR " &
+                                   INT'IMAGE (I));
+                          END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR " &
+                                   "SINT'SUCC OF " &
+                                   INT'IMAGE (I));
+                END;
+           END LOOP;
+ 
+      END;
+ 
+      DECLARE
+           SUBTYPE INTRANGE IS INTEGER RANGE IDENT_INT(-6) ..
+                                                           IDENT_INT(6);
+           SUBTYPE SINTEGER IS INTEGER RANGE IDENT_INT(-4) ..
+                                                           IDENT_INT(4);
+ 
+      BEGIN
+           FOR I IN INTRANGE LOOP
+                BEGIN
+                     IF SINTEGER'PRED (I) /= I - IDENT_INT(1) THEN
+                          FAILED ( "WRONG SINTEGER'PRED FOR " &
+                                   INTEGER'IMAGE (I));
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR " &
+                                   "SINTEGER'PRED OF " &
+                                   INTEGER'IMAGE (I));
+                END;
+                BEGIN
+                     IF SINTEGER'SUCC (I) /= I + IDENT_INT(1) THEN
+                          FAILED ( "WRONG SINTEGER'SUCC FOR " &
+                                   INTEGER'IMAGE (I));
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR " &
+                                   "SINTEGER'SUCC OF " &
+                                   INTEGER'IMAGE (I));
+                END;
+           END LOOP;
+ 
+      END;
+ 
+      RESULT;
+ END C35503G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C35503H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULT WHEN THE
+ --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
+ --     IS AN INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/17/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503H IS
+ 
+ BEGIN
+      TEST ("C35503H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULT WHEN THE PREFIX IS A GENERIC " &
+                       "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
+                       "IS AN INTEGER TYPE" );
+ 
+      DECLARE
+           TYPE INTRANGE IS RANGE -6 .. 6;
+ 
+           GENERIC
+                TYPE INT IS (<>);
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                SUBTYPE SINT IS INT
+                     RANGE INT'VAL (IDENT_INT(-4)) ..
+                                                 INT'VAL (IDENT_INT(4));
+           BEGIN
+                FOR I IN INT'VAL (IDENT_INT(-6))  ..
+                                                 INT'VAL (IDENT_INT(6))
+                LOOP
+                     BEGIN
+                          IF SINT'PRED (I) /=
+                             SINT'VAL (SINT'POS (I) - 1) THEN
+                               FAILED ( "WRONG " & STR & "'PRED " &
+                                        "FOR " & INT'IMAGE (I) );
+                          END IF;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ( "EXCEPTION RAISED FOR " &
+                                         STR & "'PRED OF " &
+                                         INT'IMAGE (I));
+                     END;
+                     BEGIN
+                          IF SINT'SUCC (I) /=
+                             SINT'VAL (SINT'POS (I) + 1) THEN
+                               FAILED ( "WRONG " & STR & "'SUCC " &
+                                        "FOR " &  INT'IMAGE (I));
+                          END IF;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ( "EXCEPTION RAISED FOR " &
+                                         STR & "'SUCC OF " &
+                                         INT'IMAGE (I));
+                     END;
+                END LOOP;
+           END P;
+ 
+           PROCEDURE PROC1 IS NEW P (INTRANGE);
+           PROCEDURE PROC2 IS NEW P (INTEGER);
+      BEGIN
+           PROC1 ("INTRANGE");
+           PROC2 ("INTEGER");
+      END;
+ 
+      RESULT;
+ END C35503H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C35503K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS AN INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/17/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     PWN 11/30/94 REMOVED ATTRIBUTE TESTS ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503K IS
+ 
+ BEGIN
+      TEST ("C35503K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                       "INTEGER TYPE" );
+ 
+      DECLARE
+           TYPE INT IS RANGE -6 .. 6;
+           SUBTYPE SINT IS INT RANGE -4 .. 4;
+ 
+           PROCEDURE P (I : INTEGER; STR : STRING) IS
+           BEGIN
+                BEGIN
+                     IF INTEGER'POS (I) /= I THEN
+                          FAILED ( "WRONG POS FOR " & STR);
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR POS OF " &
+                                    STR);
+                END;
+                BEGIN
+                     IF INTEGER'VAL (I) /= I THEN
+                          FAILED ( "WRONG VAL FOR " & STR);
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR VAL OF " &
+                                    STR);
+                END;
+           END P;
+ 
+      BEGIN
+           P ( INTEGER'FIRST, "INTEGER'FIRST");
+           P ( INTEGER'LAST,  "INTEGER'LAST");
+           P ( 0, "'0'");
+ 
+           FOR I IN INT'FIRST .. INT'LAST LOOP
+                BEGIN
+                     IF SINT'POS (I) /= I THEN
+                          FAILED ( "WRONG POS FOR "
+                                    & INT'IMAGE (I));
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR POS OF "
+                                   & INT'IMAGE (I));
+                END;
+                BEGIN
+                     IF SINT'VAL (I) /= I THEN
+                          FAILED ( "WRONG VAL FOR "
+                                   & INT'IMAGE (I));
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED FOR VAL OF "
+                                   & INT'IMAGE (I));
+                END;
+           END LOOP;
+ 
+           BEGIN
+                IF INT'VAL (INTEGER'(0)) /= 0 THEN
+                     FAILED ( "WRONG VAL FOR INT WITH INTEGER" );
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED FOR VAL OF " &
+                              "INT WITH INTEGER" );
+           END;
+ 
+           BEGIN
+                IF INTEGER'VAL (INT'(0)) /= 0 THEN
+                     FAILED ( "WRONG VAL FOR INTEGER WITH INT" );
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED FOR VAL OF " &
+                              "INTEGER WITH INT" );
+           END;
+      END;
+ 
+      RESULT;
+ END C35503K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C35503L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
+ --     IS AN INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/17/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503L IS
+ 
+ BEGIN
+      TEST ("C35503L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "GENERIC FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL PARAMETER IS AN INTEGER TYPE" );
+ 
+      DECLARE
+           TYPE INTRANGE IS RANGE -6 .. 6;
+ 
+           GENERIC
+                TYPE INT IS (<>);
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                SUBTYPE SINT IS INT RANGE
+                    INT'VAL (IDENT_INT(-4)) .. INT'VAL (IDENT_INT(4));
+                I :INTEGER;
+           BEGIN
+                I := IDENT_INT(-6);
+                FOR S IN INT'VAL (IDENT_INT(-6)) ..
+                                                  INT'VAL (IDENT_INT(6))
+                LOOP
+                     BEGIN
+                          IF SINT'POS (S) /= I THEN
+                               FAILED ( "WRONG VALUE FOR " &
+                                         STR & "'POS OF "
+                                        & INT'IMAGE (S) );
+                          END IF;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ( "EXCEPTION RAISED FOR " &
+                                         STR & "'POS "
+                                        & "OF " & INT'IMAGE (S) );
+                     END;
+                     BEGIN
+                          IF SINT'VAL (I) /= S THEN
+                               FAILED ( "WRONG VALUE FOR " &
+                                         STR & "'VAL "
+                                        & "OF " & INT'IMAGE (S) );
+                          END IF;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ( "EXCEPTION RAISED FOR " &
+                                         STR & "'VAL "
+                                        & "OF " & INT'IMAGE (S) );
+                     END;
+                     I := I + 1;
+                END LOOP;
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (INTRANGE);
+           PROCEDURE P2 IS NEW P (INTEGER);
+ 
+      BEGIN
+           P1 ("INTRANGE");
+           P2 ("INTEGER");
+      END;
+ 
+      RESULT;
+ 
+ END C35503L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C35503O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS AN INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/17/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503O IS
+ 
+ BEGIN
+      TEST ("C35503O", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                       "INTEGER TYPE" );
+ 
+      DECLARE
+           SUBTYPE SINTEGER IS INTEGER;
+           SUBTYPE SMALL IS INTEGER RANGE IDENT_INT(-10) ..
+                                                          IDENT_INT(10);
+           SUBTYPE NOINTEGER IS INTEGER
+             RANGE IDENT_INT(5) .. IDENT_INT(-7);
+ 
+           TYPE INT IS RANGE -6 .. 6;
+           SUBTYPE SINT IS INT
+             RANGE INT(IDENT_INT(-4)) .. INT(IDENT_INT(4));
+           SUBTYPE NOINT IS INT
+             RANGE INT(IDENT_INT(1)) .. INT(IDENT_INT(-1));
+           TYPE NEWINT IS NEW INTEGER RANGE IDENT_INT(-9) ..
+                                                           IDENT_INT(-2);
+           SUBTYPE SNEWINT IS NEWINT RANGE -7 .. -5;
+           SUBTYPE NONEWINT IS NEWINT RANGE 3 .. -15;
+ 
+      BEGIN
+           IF SINTEGER'FIRST /= INTEGER'FIRST THEN
+                FAILED ( "WRONG VALUE FOR SINTEGER'FIRST" );
+           END IF;
+           IF SINTEGER'LAST /= INTEGER'LAST THEN
+                FAILED ( "WRONG VALUE FOR SINTEGER'LAST" );
+           END IF;
+ 
+           IF SMALL'FIRST /= -10 THEN
+                FAILED ( "WRONG VALUE FOR SMALL'FIRST" );
+           END IF;
+           IF SMALL'LAST /= 10 THEN
+                FAILED ( "WRONG VALUE FOR SMALL'LAST" );
+           END IF;
+ 
+           IF NOINTEGER'FIRST /= 5 THEN
+                FAILED ( "WRONG VALUE FOR NOINTEGER'FIRST" );
+           END IF;
+           IF NOINTEGER'LAST /= -7 THEN
+                FAILED ( "WRONG VALUE FOR NOINTEGER'LAST" );
+           END IF;
+ 
+           IF INT'FIRST /= -6 THEN
+                FAILED ( "WRONG VALUE FOR INT'FIRST" );
+           END IF;
+           IF INT'LAST /= 6 THEN
+                FAILED ( "WRONG VALUE FOR INT'LAST" );
+           END IF;
+ 
+           IF SINT'FIRST /= -4 THEN
+                FAILED ( "WRONG VALUE FOR SINT'FIRST" );
+           END IF;
+           IF SINT'LAST /= 4 THEN
+                FAILED ( "WRONG VALUE FOR SINT'LAST" );
+           END IF;
+ 
+           IF NOINT'FIRST /= 1 THEN
+                FAILED ( "WRONG VALUE FOR NOINT'FIRST" );
+           END IF;
+           IF NOINT'LAST /= -1 THEN
+                FAILED ( "WRONG VALUE FOR NOINT'LAST" );
+           END IF;
+ 
+           IF NEWINT'FIRST /= -9 THEN
+                FAILED ( "WRONG VALUE FOR NEWINT'FIRST" );
+           END IF;
+           IF NEWINT'LAST /= -2 THEN
+                FAILED ( "WRONG VALUE FOR NEWINT'LAST" );
+           END IF;
+ 
+           IF SNEWINT'FIRST /= -7 THEN
+                FAILED ( "WRONG VALUE FOR SNEWINT'FIRST" );
+           END IF;
+           IF SNEWINT'LAST /= -5 THEN
+                FAILED ( "WRONG VALUE FOR SNEWINT'LAST" );
+           END IF;
+ 
+           IF NONEWINT'FIRST /= 3 THEN
+                FAILED ( "WRONG VALUE FOR NONEWINT'FIRST" );
+           END IF;
+           IF NONEWINT'LAST /= -15 THEN
+                FAILED ( "WRONG VALUE FOR NONEWINT'LAST" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C35503O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35503p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35503p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C35503P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ARGUMENT IS AN
+ --     INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/24/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35503P IS
+ 
+ BEGIN
+      TEST ("C35503P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "GENERIC FORMAL DISCRETE TYPE WHOSE ARGUMENT " &
+                       "IS AN INTEGER TYPE" );
+ 
+ 
+      DECLARE
+ 
+           TYPE INT IS RANGE -6 .. 6;
+           SUBTYPE SINT IS INT RANGE INT(IDENT_INT(-4)) ..
+                                                      INT(IDENT_INT(4));
+           SUBTYPE NOINT IS INT RANGE INT(IDENT_INT(1)) ..
+                                                     INT(IDENT_INT(-1));
+ 
+           GENERIC
+                TYPE I IS (<>);
+                F, L : I;
+           PROCEDURE P ( STR : STRING );
+ 
+           PROCEDURE P ( STR : STRING ) IS
+           BEGIN
+                IF I'FIRST /= F THEN
+                     FAILED ( "INCORRECT 'FIRST' FOR " & STR );
+                END IF;
+                IF I'LAST /= L THEN
+                     FAILED ( "INCORRECT 'LAST' FOR " & STR );
+                END IF;
+           END P;
+ 
+           GENERIC
+                TYPE I IS (<>);
+                F, L : I;
+           PROCEDURE Q;
+ 
+           PROCEDURE Q IS
+                SUBTYPE SI IS I;
+           BEGIN
+                IF SI'FIRST /= F THEN
+                     FAILED ( "INCORRECT VALUE FOR INTEGER'FIRST" );
+                END IF;
+                IF SI'LAST /= L THEN
+                     FAILED ( "INCORRECT VALUE FOR INTEGER'LAST" );
+                END IF;
+           END Q;
+ 
+           GENERIC
+                TYPE I IS (<>);
+           PROCEDURE R;
+ 
+           PROCEDURE R IS
+                SUBTYPE SI IS I;
+           BEGIN
+                IF SI'FIRST /= SI'VAL (IDENT_INT(1)) THEN
+                     FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
+                END IF;
+                IF SI'LAST /= SI'VAL (IDENT_INT(-1)) THEN
+                     FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
+                END IF;
+           END R;
+ 
+           PROCEDURE P1 IS NEW P ( I => INT, F => -6, L => 6 );
+           PROCEDURE P2 IS NEW P ( I => SINT, F => -4, L => 4 );
+           PROCEDURE Q1 IS NEW Q
+                ( I => INTEGER, F => INTEGER'FIRST, L => INTEGER'LAST );
+           PROCEDURE R1 IS NEW R ( I => NOINT);
+ 
+      BEGIN
+           P1 ( "INT" );
+           P2 ( "SINT" );
+           Q1;
+           R1;
+      END;
+ 
+      RESULT;
+ END C35503P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35504a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35504a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35504a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35504a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- C35504A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE USER-DEFINED 
+ -- ENUMERATION ARGUMENT TO 'SUCC, 'PRED, 'POS, 'VAL, 'IMAGE, AND 'VALUE
+ -- IS NOT IN THE ATTRIBUTED SUBTYPE'S RANGE CONSTRAINT.
+ 
+ -- DAT 3/18/81
+ -- SPS 01/13/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35504A IS
+ 
+      TYPE E IS (A, 'A', B, 'B', C, 'C', D, 'D', XYZ);
+ 
+      SUBTYPE S IS E RANGE B .. C;
+ 
+ BEGIN
+      TEST ("C35504A", "CONSTRAINT_ERROR IS NOT RAISED IN T'SUCC(X),"
+           & " T'PRED(X), T'POS(X), T'VAL(X), T'IMAGE(X), AND"
+           & " T'VALUE(X) WHEN THE VALUES ARE NOT WITHIN T'S"
+           & " RANGE CONSTRAINT, FOR USER-DEFINED ENUMERATION TYPES");
+ 
+      BEGIN
+           FOR X IN E LOOP
+                IF (X /= A AND THEN S'SUCC(S'PRED(X)) /= X)
+                OR (X /= XYZ AND THEN S'PRED(S'SUCC(X)) /= X)
+                OR S'VAL(S'POS(X)) /= X
+                OR S'VALUE(S'IMAGE(X)) /= X
+                THEN
+                     FAILED ("WRONG ATTRIBUTE VALUE");
+                END IF;
+           END LOOP;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR RAISED"
+                     & " WHEN IT SHOULDN'T HAVE BEEN");
+           WHEN OTHERS => FAILED ("INCORRECT EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C35504A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35504b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35504b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35504b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35504b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C35504B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR I'SUCC, I'PRED,
+ -- I'POS, I'VAL, I'IMAGE, AND I'VALUE FOR INTEGER ARGUMENTS
+ -- OUTSIDE THE RANGE OF I.
+ 
+ -- DAT 3/30/81
+ -- SPS 01/13/83
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE C35504B IS
+ 
+      SUBTYPE I IS INTEGER RANGE 0 .. 0;
+ 
+ BEGIN
+      TEST ("C35504B", "CONSTRAINT_ERROR IS NOT RAISED FOR"
+           & " INTEGER SUBTYPE ATTRIBUTES 'SUCC, 'PRED, 'POS, 'VAL,"
+           & " 'IMAGE, AND 'VALUE WHOSE ARGUMENTS ARE OUTSIDE THE"
+           & " SUBTYPE");
+ 
+      BEGIN
+           IF I'SUCC(-1) /= I'PRED(1)
+           THEN
+                FAILED ("WRONG ATTRIBUTE VALUE - 1");
+           END IF;
+ 
+           IF I'SUCC (100) /= 101
+           THEN
+                FAILED ("WRONG ATTRIBUTE VALUE - 2");
+           END IF;
+ 
+           IF I'PRED (100) /= 99
+           THEN
+                FAILED ("WRONG ATTRIBUTE VALUE - 3");
+           END IF;
+ 
+           IF I'POS (-100) /= -100
+           THEN
+                FAILED ("WRONG ATTRIBUTE VALUE - 4");
+           END IF;
+ 
+           IF I'VAL(-100) /= -100
+           THEN
+                FAILED ("WRONG ATTRIBUTE VALUE - 5");
+           END IF;
+ 
+           IF I'IMAGE(1234) /= " 1234"
+           THEN
+                FAILED ("WRONG ATTRIBUTE VALUE - 6");
+           END IF;
+ 
+           IF I'VALUE("999") /= 999
+           THEN
+                FAILED ("WRONG ATTRIBUTE VALUE - 7");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C35504B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35505c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35505c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35505c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35505c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C35505C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR 'SUCC' AND 'PRED',
+ --     IF THE RETURNED VALUES WOULD BE OUTSIDE OF THE BASE TYPE,
+ --     WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT
+ --     IS A USER-DEFINED ENUMERATION TYPE.
+ 
+ -- HISTORY:
+ --     RJW 06/05/86  CREATED ORIGINAL TEST.
+ --     VCL 08/19/87  REMOVED THE FUNCTION 'IDENT' IN THE GENERIC
+ --                   PROCEDURE 'P' AND REPLACED ALL CALLS TO 'IDENT'
+ --                   WITH "T'VAL(IDENT_INT(T'POS(...)))".
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35505C IS
+ 
+      TYPE B IS ('Z', 'X', Z, X);
+ 
+      SUBTYPE C IS B RANGE 'X' .. Z;
+ 
+ BEGIN
+      TEST ( "C35505C", "CHECK THAT 'SUCC' AND 'PRED' RAISE " &
+                        "CONSTRAINT_ERROR APPROPRIATELY WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ARGUMENT IS A USER-DEFINED ENUMERATION TYPE" );
+ 
+      DECLARE
+           GENERIC
+                TYPE T IS (<>);
+                STR : STRING;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+ 
+           BEGIN
+                BEGIN
+                     IF T'PRED (T'VAL (IDENT_INT (T'POS
+                               (T'BASE'FIRST)))) = T'FIRST THEN
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'PRED -  1" );
+                     ELSE
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'PRED -  2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'PRED - 1" );
+                END;
+ 
+                BEGIN
+                     IF T'SUCC (T'VAL (IDENT_INT (T'POS
+                               (T'BASE'LAST)))) = T'LAST THEN
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'SUCC -  1" );
+                     ELSE
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'SUCC -  2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'SUCC - 1" );
+                END;
+           END P;
+ 
+           PROCEDURE PB IS NEW P (B, "B");
+           PROCEDURE PC IS NEW P (C, "C");
+      BEGIN
+           PB;
+           PC;
+      END;
+ RESULT;
+ END C35505C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35505e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35505e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35505e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35505e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- C35505E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR 'SUCC' AND 'PRED',
+ --     IF THE RESULT WOULD BE OUTSIDE THE RANGE OF THE BASE TYPE,
+ --     WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT
+ --     IS TYPE CHARACTER OR A SUBTYPE OF TYPE CHARACTER.
+ 
+ -- HISTORY:
+ --     DWC 07/01/87
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35505E IS
+ 
+      TYPE CHAR IS ('A', B, C);
+      SUBTYPE NEWCHAR IS CHAR;
+ 
+ BEGIN
+      TEST ( "C35505E", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                        "'SUCC' AND 'PRED', IF THE RESULT WOULD BE " &
+                        "OUTSIDE THE RANGE OF THE BASE TYPE, WHEN " &
+                        "THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ACTUAL ARGUMENT IS A CHARACTER TYPE ");
+ 
+      DECLARE
+           GENERIC
+                TYPE SUBCH IS (<>);
+                STR : STRING;
+                I1, I2 : INTEGER;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+ 
+                FUNCTION IDENT (C : SUBCH) RETURN SUBCH IS
+                BEGIN
+                     RETURN SUBCH'VAL (IDENT_INT (SUBCH'POS (C)));
+                END IDENT;
+ 
+           BEGIN
+                BEGIN
+                     IF SUBCH'PRED (SUBCH'BASE'FIRST) = SUBCH'VAL (0)
+                          THEN
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'PRED -  1" );
+                     ELSE
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'PRED -  2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'PRED - 1" );
+                END;
+ 
+                BEGIN
+                     IF SUBCH'SUCC (SUBCH'BASE'LAST) = SUBCH'VAL (0) THEN
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'SUCC -  1" );
+                     ELSE
+                          FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                    STR & "'SUCC -  2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'SUCC - 1" );
+                END;
+ 
+                BEGIN
+                     IF SUBCH'PRED (IDENT (SUBCH'BASE'FIRST)) =
+                        SUBCH'VAL (I1) THEN
+                          FAILED ( "NO EXCEPTION RAISED " &
+                                   "FOR " & STR & "'PRED " &
+                                   "(IDENT (SUBCH'BASE'FIRST)) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED " &
+                                   "FOR " & STR & "'PRED " &
+                                   "(IDENT (SUBCH'BASE'FIRST)) - 2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED " &
+                                   "FOR " & STR & "'PRED " &
+                                   "(IDENT (SUBCH'BASE'FIRST))" );
+                END;
+ 
+                BEGIN
+                     IF SUBCH'SUCC (IDENT(SUBCH'BASE'LAST)) =
+                        SUBCH'VAL (I2) THEN
+                          FAILED ( "NO EXCEPTION RAISED " &
+                                   "FOR " & STR & "'SUCC " &
+                                   "(IDENT (SUBCH'BASE'LAST)) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED " &
+                                   "FOR " & STR & "'SUCC " &
+                                   "(IDENT (SUBCH'BASE'LAST)) - 2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED " &
+                                   "FOR " & STR & "'SUCC " &
+                                   "(IDENT (SUBCH'BASE'LAST))" );
+                END;
+           END P;
+ 
+           PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR", 0, 1);
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
+      BEGIN
+           PCHAR;
+           PNCHAR;
+      END;
+ RESULT;
+ END C35505E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35505f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35505f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35505f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35505f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C35505F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT ERROR IS RAISED BY THE ATTRIBUTES
+ --     'PRED' AND 'SUCC' WHEN THE PREFIX IS A CHARACTER TYPE
+ --     AND THE RESULT IS OUTSIDE OF THE BASE TYPE.
+ 
+ -- HISTORY:
+ --     JET 08/18/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35505F  IS
+ 
+      TYPE CHAR IS ('A', B);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+      BEGIN
+           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+      END;
+ 
+      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+      BEGIN
+           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+      END;
+ 
+ BEGIN
+ 
+      TEST( "C35505F" , "CHECK THAT CONSTRAINT ERROR IS RAISED BY " &
+                        "THE ATTRIBUTES 'PRED' AND 'SUCC' WHEN THE " &
+                        "PREFIX IS A CHARACTER TYPE AND THE RESULT " &
+                        "IS OUTSIDE OF THE BASE TYPE" );
+ 
+      BEGIN
+           IF CHAR'PRED (IDENT ('A')) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'PRED (IDENT ('A')) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'PRED (IDENT ('A')) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHAR'PRED (IDENT ('A'))" );
+      END;
+ 
+      BEGIN
+           IF CHAR'SUCC (IDENT (B)) = B THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'SUCC (IDENT (B)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'SUCC (IDENT (B)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHAR'SUCC (IDENT (B))" );
+      END;
+ 
+      BEGIN
+           IF NEWCHAR'PRED (IDENT ('A')) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'PRED (IDENT ('A')) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'PRED (IDENT ('A')) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR NEWCHAR'PRED (IDENT ('A'))" );
+      END;
+ 
+      BEGIN
+           IF NEWCHAR'SUCC (IDENT (B)) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'SUCC (IDENT (B)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'SUCC (IDENT (B)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR NEWCHAR'SUCC (IDENT (B))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'PRED (IDENT_CHAR (CHARACTER'BASE'FIRST)) = 'A'
+              THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHARACTER'PRED " &
+                         "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHARACTER'PRED " &
+                         "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'PRED " &
+                         "(IDENT_CHAR (CHARACTER'BASE'FIRST))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'SUCC (IDENT_CHAR (CHARACTER'BASE'LAST)) = 'Z'
+              THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHARACTER'SUCC " &
+                         "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHARACTER'SUCC " &
+                         "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'SUCC " &
+                         "(IDENT_CHAR (CHARACTER'BASE'LAST))" );
+      END;
+ 
+      RESULT;
+ 
+ END C35505F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- C35507A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+ -- WHEN THE PREFIX IS A CHARACTER TYPE.   
+ 
+ -- RJW 5/29/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507A  IS
+ 
+ BEGIN
+ 
+      TEST( "C35507A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                        "THE CORRECT RESULTS WHEN THE PREFIX " &
+                        "IS A CHARACTER TYPE" );
+ 
+      DECLARE
+           TYPE CHAR1 IS (A, 'A');
+ 
+           SUBTYPE CHAR2 IS CHARACTER RANGE 'A' .. 'Z';
+ 
+           SUBTYPE NOCHAR IS CHARACTER RANGE 'Z' .. 'A';
+           
+           TYPE NEWCHAR IS NEW CHARACTER 
+                     RANGE 'A' .. 'Z';
+ 
+      BEGIN
+           IF CHAR1'WIDTH /= 3 THEN
+                FAILED( "INCORRECT WIDTH FOR CHAR1" );
+           END IF;
+ 
+           IF CHAR2'WIDTH /= 3 THEN
+                FAILED( "INCORRECT WIDTH FOR CHAR2" );
+           END IF;
+ 
+           IF NEWCHAR'WIDTH /= 3 THEN
+                FAILED( "INCORRECT WIDTH FOR NEWCHAR" );
+           END IF;
+ 
+           IF NOCHAR'WIDTH /= 0 THEN
+                FAILED( "INCORRECT WIDTH FOR NOCHAR" );
+           END IF;
+      END;
+ 
+      DECLARE
+           SUBTYPE NONGRAPH IS CHARACTER 
+                     RANGE CHARACTER'VAL (0) .. CHARACTER'VAL (31);
+ 
+           MAX : INTEGER := 0;
+ 
+      BEGIN
+           FOR CH IN NONGRAPH
+                LOOP
+                     IF CHARACTER'IMAGE (CH)'LENGTH > MAX THEN
+                          MAX := CHARACTER'IMAGE (CH)'LENGTH;
+                     END IF;
+           END LOOP;
+           
+           IF NONGRAPH'WIDTH /= MAX THEN
+                FAILED ( "INCORRECT WIDTH FOR NONGRAPH" );
+           END IF;
+      END;                    
+ 
+      RESULT;
+ END C35507A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- C35507B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+ -- WHEN THE PREFIX IS FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS
+ -- A CHARACTER TYPE.   
+ 
+ -- RJW 5/29/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507B  IS
+ 
+      GENERIC
+           TYPE CH IS (<>);
+      PROCEDURE P ( STR : STRING; W : INTEGER );
+ 
+      PROCEDURE P ( STR : STRING; W : INTEGER ) IS
+ 
+           SUBTYPE NOCHAR IS CH RANGE CH'VAL (1) .. CH'VAL(0);
+      BEGIN
+           IF CH'WIDTH /= W THEN
+                FAILED( "INCORRECT WIDTH FOR " & STR );
+           END IF;
+      
+           IF NOCHAR'WIDTH /= 0 THEN
+                FAILED( "INCORRECT WIDTH FOR NOCHAR WITH " & STR );
+           END IF;
+      END P;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C35507B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                        "THE CORRECT RESULTS WHEN THE PREFIX " &
+                        "IS A FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                        "PARAMETER IS A CHARACTER TYPE" );
+ 
+      DECLARE
+           TYPE CHAR1 IS (A, 'A');
+ 
+           SUBTYPE CHAR2 IS CHARACTER RANGE 'A' .. 'Z';
+           
+           TYPE NEWCHAR IS NEW CHARACTER 
+                     RANGE 'A' .. 'Z';
+ 
+           PROCEDURE P1 IS NEW P (CHAR1);
+           PROCEDURE P2 IS NEW P (CHAR2);
+           PROCEDURE P3 IS NEW P (NEWCHAR);
+      BEGIN
+           P1 ("CHAR1", 3);
+           P2 ("CHAR2", 3);
+           P3 ("NEWCHAR", 3);
+      END;
+ 
+      DECLARE
+           SUBTYPE NONGRAPH IS CHARACTER 
+                     RANGE CHARACTER'VAL (0) .. CHARACTER'VAL (31);
+ 
+           MAX : INTEGER := 0;
+ 
+           PROCEDURE PN IS NEW P (NONGRAPH);
+      BEGIN
+           FOR CH IN NONGRAPH
+                LOOP
+                     IF CHARACTER'IMAGE (CH)'LENGTH > MAX THEN
+                          MAX := CHARACTER'IMAGE (CH)'LENGTH;
+                     END IF;
+           END LOOP;
+           
+           PN ("NONGRAPH", MAX);
+      END;                    
+ 
+      RESULT;
+ END C35507B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,360 ----
+ -- C35507C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
+ --     SUBTESTS ARE:
+ --         (A). TESTS FOR IMAGE.
+ --         (B). TESTS FOR VALUE.
+ 
+ -- HISTORY:
+ --     RJW 05/29/86  CREATED ORIGINAL TEST.
+ --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
+ --                   CORRECTED ERROR MESSAGES AND ADDED CALLS TO
+ --                   IDENT_STR.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507C  IS
+ 
+      TYPE CHAR IS ('A', 'a');
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+      BEGIN
+           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+      END IDENT;
+ 
+      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+      BEGIN
+           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+      END IDENT;
+ 
+      PROCEDURE CHECK_BOUND (STR1, STR2 : STRING) IS
+      BEGIN
+           IF STR1'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 &
+                         "'IMAGE ('" & STR1 & "')" );
+           END IF;
+      END CHECK_BOUND;
+ 
+ BEGIN
+ 
+      TEST( "C35507C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A CHARACTER TYPE" );
+ 
+      BEGIN  -- (A).
+           IF CHAR'IMAGE ('A') /= "'A'" THEN
+                FAILED ( "INCORRECT IMAGE FOR CHAR'('A')" );
+           END IF;
+ 
+           CHECK_BOUND (CHAR'IMAGE ('A'), "CHAR");
+ 
+           IF CHAR'IMAGE ('a') /= "'a'" THEN
+                FAILED ( "INCORRECT IMAGE FOR CHAR'('a')" );
+           END IF;
+ 
+           CHECK_BOUND (CHAR'IMAGE ('a'), "CHAR");
+ 
+           IF NEWCHAR'IMAGE ('A') /= "'A'" THEN
+                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('A')" );
+           END IF;
+ 
+           CHECK_BOUND (NEWCHAR'IMAGE ('A'), "NEWCHAR");
+ 
+           IF NEWCHAR'IMAGE ('a') /= "'a'" THEN
+                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('a')" );
+           END IF;
+ 
+           CHECK_BOUND (NEWCHAR'IMAGE ('a'), "NEWCHAR");
+ 
+           IF CHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
+                FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('A'))" );
+           END IF;
+ 
+           CHECK_BOUND (CHAR'IMAGE (IDENT ('A')), "IDENT OF CHAR");
+ 
+           IF CHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
+                FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('a'))" );
+           END IF;
+ 
+           CHECK_BOUND (CHAR'IMAGE (IDENT ('a')), "IDENT OF CHAR");
+ 
+           IF NEWCHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
+                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('A'))" );
+           END IF;
+ 
+           CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('A')), "IDENT OF NEWCHAR");
+ 
+           IF NEWCHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
+                FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('a'))" );
+           END IF;
+ 
+           CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('a')), "IDENT OF NEWCHAR");
+ 
+           FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
+                IF CHARACTER'IMAGE (CH) /= ("'" & CH) & "'" THEN
+                     FAILED ( "INCORRECT IMAGE FOR CHARACTER'(" &
+                               CH & ")" );
+                END IF;
+ 
+                CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
+ 
+           END LOOP;
+ 
+           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+                CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
+           END LOOP;
+ 
+           CHECK_BOUND (CHARACTER'IMAGE (CHARACTER'VAL (127)),
+                        "CHARACTER");
+ 
+      END;
+ 
+      ---------------------------------------------------------------
+ 
+      DECLARE -- (B).
+ 
+           SUBTYPE SUBCHAR IS CHARACTER
+                RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
+      BEGIN
+           FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
+                IF SUBCHAR'VALUE (("'" & CH) & "'") /= CH THEN
+                     FAILED ( "INCORRECT SUBCHAR'VALUE FOR " & CH );
+                END IF;
+           END LOOP;
+ 
+           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+                IF SUBCHAR'VALUE (CHARACTER'IMAGE (CH)) /= CH THEN
+                     FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
+                               CHARACTER'IMAGE (CH) );
+                END IF;
+           END LOOP;
+ 
+           IF SUBCHAR'VALUE (CHARACTER'IMAGE (CHARACTER'VAL (127))) /=
+              CHARACTER'VAL (127) THEN
+                FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
+                         "CHARACTER'VAL (127)" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF CHAR'VALUE ("'A'") /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'(""'A'"")" );
+           END IF;
+ 
+           IF CHAR'VALUE ("'a'") /= 'a' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'(""'a'"")" );
+           END IF;
+ 
+           IF NEWCHAR'VALUE ("'A'") /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'A'"")" );
+           END IF;
+ 
+           IF NEWCHAR'VALUE ("'a'") /= 'a' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'a'"")" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF CHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
+                         "(""'A'""))" );
+           END IF;
+ 
+           IF CHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
+                         "(""'a'""))" );
+           END IF;
+ 
+           IF NEWCHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
+                         "(""'A'""))" );
+           END IF;
+ 
+           IF NEWCHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
+                         "(""'a'""))" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF CHAR'VALUE (IDENT_STR ("'B'")) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHAR'VALUE (IDENT_STR (""'B'""))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE (IDENT_CHAR (ASCII.HT) & "'A'") = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE " &
+                         "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE " &
+                         "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE " &
+                         "(IDENT_CHAR (ASCII.HT) & ""'A'"")" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE ("'B'" & IDENT_CHAR (ASCII.HT)) = 'B' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (""'B'"" & " &
+                         "IDENT_CHAR (ASCII.HT)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (""'B'"" & " &
+                         "IDENT_CHAR (ASCII.HT)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE (""'B'"" & " &
+                         "IDENT_CHAR (ASCII.HT)) " );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE ("'C'" & IDENT_CHAR (ASCII.BEL)) = 'C'
+              THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (""'C'"" & " &
+                         "IDENT_CHAR (ASCII.BEL)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (""'C'"" & " &
+                         "IDENT_CHAR (ASCII.BEL)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE (""'C'"" & " &
+                         "IDENT_CHAR (ASCII.BEL))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE (IDENT_STR ("'")) = ''' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""'"")) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""'"")) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE (IDENT_STR (""'""))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE (IDENT_STR ("''")) = ''' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""''"")) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""''"")) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE (IDENT_STR (""''""))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE (IDENT_STR ("'A")) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""'A"")) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""'A"")) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE IDENT_STR (""'A""))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE (IDENT_STR ("A'")) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""A'"")) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""A'"")) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE (IDENT_STR (""A'""))" );
+      END;
+ 
+      BEGIN
+           IF CHARACTER'VALUE (IDENT_STR ("'AB'")) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VALUE IDENT_STR (""'AB'""))" );
+      END;
+ 
+      RESULT;
+ END C35507C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,194 ----
+ -- C35507E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+ --     PARAMETER IS A CHARACTER TYPE.
+ --     SUBTESTS ARE:
+ --         (A). TESTS FOR IMAGE.
+ --         (B). TESTS FOR VALUE.
+ 
+ -- HISTORY:
+ --     RJW  05/29/86  CREATED ORIGINAL TEST.
+ --     VCL  10/23/87  MODIFIED THIS HEADER, CHANGED THE CALLS TO
+ --                    PROCEDURE 'PCH', IN THE SECOND PART OF SUBTEST B,
+ --                    TO INCLUDE ANOTHER CALL TO PROCEDURE 'PCHAR' AND
+ --                    CALLS TO PROCEDURE 'PNCHAR'.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  C35507E  IS
+ 
+      TYPE CHAR IS ('A', 'a');
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+      PROCEDURE CHECK_LOWER_BOUND (STR1, STR2 : STRING) IS
+      BEGIN
+           IF STR1'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 & "'(" &
+                         STR1 & ")" );
+           END IF;
+      END CHECK_LOWER_BOUND;
+ 
+ BEGIN
+ 
+      TEST( "C35507E" , "THE ATTRIBUTES 'IMAGE' AND " &
+                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+ 
+      DECLARE -- (A).
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR1 : STRING;
+           PROCEDURE P (CH : CHTYPE; STR2 : STRING);
+ 
+           PROCEDURE P (CH : CHTYPE; STR2 : STRING) IS
+                SUBTYPE SUBCH IS CHTYPE;
+           BEGIN
+                IF SUBCH'IMAGE (CH) /= STR2 THEN
+                     FAILED ( "INCORRECT IMAGE FOR " & STR1 & "'(" &
+                               STR2 & ")" );
+                END IF;
+ 
+                CHECK_LOWER_BOUND (SUBCH'IMAGE (CH), STR1);
+           END P;
+ 
+           PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR");
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
+           PROCEDURE PCH    IS NEW P (CHARACTER, "CHARACTER");
+ 
+      BEGIN
+           PCHAR ('A', "'A'");
+           PCHAR ('a', "'a'");
+           PNCHAR ('A', "'A'");
+           PNCHAR ('a', "'a'");
+ 
+           FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
+                PCH (CH, ("'" & CH) & "'" );
+           END LOOP;
+      END;
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE CHTYPE IS (<>);
+           PROCEDURE P (CH : CHTYPE; STR : STRING);
+ 
+           PROCEDURE P (CH : CHTYPE; STR : STRING) IS
+                SUBTYPE SUBCH IS CHTYPE;
+           BEGIN
+                CHECK_LOWER_BOUND (CHTYPE'IMAGE (CH), "CHARACTER");
+           END P;
+ 
+           PROCEDURE PN IS NEW P (CHARACTER);
+ 
+      BEGIN
+ 
+           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+                PN (CH, CHARACTER'IMAGE (CH));
+           END LOOP;
+ 
+           PN (ASCII.DEL, CHARACTER'IMAGE (ASCII.DEL));
+      END;
+ 
+      ---------------------------------------------------------------
+ 
+      DECLARE -- (B).
+ 
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR1 : STRING;
+           PROCEDURE P (STR2 : STRING; CH : CHTYPE);
+ 
+           PROCEDURE P (STR2 : STRING; CH : CHTYPE) IS
+                SUBTYPE SUBCH IS CHTYPE;
+           BEGIN
+                IF SUBCH'VALUE (STR2) /= CH THEN
+                     FAILED ( "INCORRECT " & STR1 & "'VALUE FOR " &
+                               STR2 );
+                END IF;
+           END P;
+ 
+           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
+           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
+ 
+      BEGIN
+           FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+                 PCH (CHARACTER'IMAGE (CH), CH );
+           END LOOP;
+ 
+           PCH (CHARACTER'IMAGE (CHARACTER'VAL (127)),
+                CHARACTER'VAL (127));
+ 
+           PCHAR ("'A'", 'A');
+           PCHAR ("'a'", 'a' );
+           PNCHAR ("'A'", 'A');
+           PNCHAR ("'a'", 'a');
+      END;
+ 
+      DECLARE
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR1 : STRING;
+           PROCEDURE P (STR2 : STRING);
+ 
+           PROCEDURE P (STR2 : STRING) IS
+                SUBTYPE SUBCH IS CHTYPE;
+           BEGIN
+                IF SUBCH'VALUE (STR2) = SUBCH'VAL (0) THEN
+                     FAILED ( "NO EXCEPTION RAISED FOR " &
+                               STR1 & "'VALUE (" & STR2 & ") - 1" );
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED FOR " &
+                               STR1 & "'VALUE (" & STR2 & ") - 2" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED " &
+                              "FOR " & STR1 & "'VALUE (" & STR2 & ")" );
+           END P;
+ 
+           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
+           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
+ 
+      BEGIN
+           PCHAR ("'B'");
+           PCH (ASCII.HT & "'A'");
+           PCH ("'B'" & ASCII.HT);
+           PCH ("'C'" & ASCII.BEL);
+           PCH ("'");
+           PNCHAR ("''");
+           PCHAR ("'A");
+           PNCHAR ("A'");
+           PCH ("'AB'");
+      END;
+ 
+      RESULT;
+ END C35507E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- C35507G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 06/03/86  CREATED ORIGINAL TEST.
+ --     JET 08/13/87  REMOVED TESTS INTENDED FOR C35505F.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507G  IS
+ 
+      TYPE CHAR IS ('A', B);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+      BEGIN
+           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+      END;
+ 
+      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+      BEGIN
+           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+      END;
+ 
+ BEGIN
+ 
+      TEST( "C35507G" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A CHARACTER TYPE" );
+ 
+      BEGIN
+           IF CHAR'SUCC ('A') /= B THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'SUCC('A')" );
+           END IF;
+ 
+           IF CHAR'PRED (IDENT (B)) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'PRED (IDENT (B))" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF NEWCHAR'SUCC (IDENT ('A')) /= B THEN
+                FAILED ( "INCORRECT VALUE FOR " &
+                         "IDENT (NEWCHAR'SUCC('A'))" );
+           END IF;
+ 
+           IF NEWCHAR'PRED (B) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'PRED(B)" );
+           END IF;
+      END;
+ 
+      FOR CH IN CHARACTER'VAL (1) .. CHARACTER'VAL (127) LOOP
+           IF CHARACTER'PRED (CH) /=
+              CHARACTER'VAL (CHARACTER'POS (CH) - 1) THEN
+                FAILED ( "INCORRECT VALUE FOR CHARACTER'PRED OF " &
+                          CHARACTER'IMAGE (CH) );
+           END IF;
+      END LOOP;
+ 
+      FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (126) LOOP
+           IF CHARACTER'SUCC (CH) /=
+              CHARACTER'VAL (CHARACTER'POS (CH) + 1) THEN
+                FAILED ( "INCORRECT VALUE FOR CHARACTER'SUCC OF " &
+                          CHARACTER'IMAGE (CH) );
+           END IF;
+      END LOOP;
+ 
+      RESULT;
+ 
+ END C35507G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- C35507H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
+ -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+ -- PARAMETER IS A CHARACTER TYPE.
+ 
+ -- RJW 6/03/86
+ -- DWC 7/01/87     -- ADDED THIRD VALUE TO CHAR TYPE.
+                    -- REMOVED SECTION OF CODE AND PLACED INTO
+                    -- C35505E.ADA.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507H  IS
+ 
+      TYPE CHAR IS ('A', B, C);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+ BEGIN
+ 
+      TEST( "C35507H" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+ 
+      DECLARE
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR : STRING;
+                I1, I2 : INTEGER;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                SUBTYPE SUBCH IS CHTYPE
+                     RANGE CHTYPE'VAL (I1) .. CHTYPE'VAL (I2);
+ 
+           BEGIN
+                FOR CH IN SUBCH'VAL (I1 + 1) .. SUBCH'VAL (I2) LOOP
+                     IF SUBCH'PRED (CH) /=
+                        SUBCH'VAL (SUBCH'POS (CH) - 1) THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR &
+                                   "'PRED OF " & SUBCH'IMAGE (CH) );
+                     END IF;
+                END LOOP;
+ 
+                FOR CH IN SUBCH'VAL (I1) .. SUBCH'VAL (I2 - 1) LOOP
+                     IF SUBCH'SUCC (CH) /=
+                        SUBCH'VAL (SUBCH'POS (CH) + 1) THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR &
+                                   "'SUCC OF " & SUBCH'IMAGE (CH) );
+                     END IF;
+                END LOOP;
+ 
+           END P;
+ 
+           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 0, 1);
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
+           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 0, 127);
+      BEGIN
+           PCHAR;
+           PNCHAR;
+           PCH;
+      END;
+ 
+      RESULT;
+ END C35507H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C35507I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE WITH AN ENUMERATION
+ --     REPRESENTATION CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 06/03/86  CREATED ORIGINAL TEST.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ --     DTN 11/26/91  DELETED CONSTRAINT_ERROR FOR ATTRIBUTES PRED AND
+ --                   SUCC SUBTESTS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507I  IS
+ 
+      TYPE CHAR IS ('A', B);
+      FOR CHAR USE ('A' => 2, B => 5);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+      BEGIN
+           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+      END;
+ 
+      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+      BEGIN
+           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+      END;
+ 
+ BEGIN
+ 
+      TEST( "C35507I" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A CHARACTER TYPE WITH AN " &
+                        "ENUMERATION REPRESENTATION CLAUSE" );
+ 
+      BEGIN
+           IF CHAR'SUCC ('A') /= B THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'SUCC('A')" );
+           END IF;
+ 
+           IF CHAR'PRED (IDENT (B)) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'PRED (IDENT (B))" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF IDENT (NEWCHAR'SUCC ('A')) /= B THEN
+                FAILED ( "INCORRECT VALUE FOR " &
+                         "IDENT (NEWCHAR'SUCC('A'))" );
+           END IF;
+ 
+           IF NEWCHAR'PRED (B) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'PRED(B)" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C35507I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C35507J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+ --     PARAMETER IS A CHARACTER TYPE WITH AN ENUMERATION REPRESENTATION
+ --     CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 06/03/86  CREATED ORIGINAL TEST.
+ --     JET 09/22/87  MADE REPRESENTATION VALUES CONSECUTIVE.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507J  IS
+ 
+      TYPE CHAR IS ('A', B);
+      FOR CHAR USE ('A' => 4, B => 5);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+ BEGIN
+ 
+      TEST( "C35507J" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                        "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ACTUAL PARAMETER IS A CHARACTER TYPE WITH " &
+                        "WITH AN ENUMERATION REPRESENTATION CLAUSE" );
+ 
+ 
+      DECLARE
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR : STRING;
+                I1, I2 : INTEGER;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                SUBTYPE SUBCH IS CHTYPE
+                          RANGE CHTYPE'VAL (I1) .. CHTYPE'VAL (I2);
+           BEGIN
+                FOR CH IN SUBCH'VAL (I1 + 1) .. SUBCH'VAL (I2) LOOP
+                     IF SUBCH'PRED (CH) /=
+                        SUBCH'VAL (SUBCH'POS (CH) - 1) THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR &
+                                   "'PRED OF " & SUBCH'IMAGE (CH) );
+                     END IF;
+                END LOOP;
+ 
+                FOR CH IN SUBCH'VAL (I1) .. SUBCH'VAL (I2 - 1) LOOP
+                     IF SUBCH'SUCC (CH) /=
+                        SUBCH'VAL (SUBCH'POS (CH) + 1) THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR &
+                                   "'SUCC OF " & SUBCH'IMAGE (CH) );
+                     END IF;
+                END LOOP;
+ 
+           END P;
+ 
+           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 0, 1);
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
+ 
+      BEGIN
+           PCHAR;
+           PNCHAR;
+ 
+      END;
+ 
+      RESULT;
+ END C35507J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,224 ----
+ -- C35507K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
+ 
+ -- HISTORY:
+ --     RJW 06/03/86
+ --     JLH 07/28/87  MODIFIED FUNCTION IDENT.
+ -- PWN 11/30/94 REMOVED PART OF TEST INVALID FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507K  IS
+ 
+      TYPE CHAR IS ('A', B);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+      SUBTYPE SCHAR IS CHARACTER
+              RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
+ 
+      BLANK : CONSTANT CHARACTER := ' ';
+ 
+      POSITION : INTEGER;
+ 
+      NONGRAPH : ARRAY (0 .. 31) OF CHARACTER :=
+           (ASCII.NUL, ASCII.SOH, ASCII.STX, ASCII.ETX,
+            ASCII.EOT, ASCII.ENQ, ASCII.ACK, ASCII.BEL,
+            ASCII.BS,  ASCII.HT,  ASCII.LF,  ASCII.VT,
+            ASCII.FF,  ASCII.CR,  ASCII.SO,  ASCII.SI,
+            ASCII.DLE, ASCII.DC1, ASCII.DC2, ASCII.DC3,
+            ASCII.DC4, ASCII.NAK, ASCII.SYN, ASCII.ETB,
+            ASCII.CAN, ASCII.EM,  ASCII.SUB, ASCII.ESC,
+            ASCII.FS,  ASCII.GS,  ASCII.RS,  ASCII.US);
+ 
+      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+      BEGIN
+           IF EQUAL (CHAR'POS (CH), CHAR'POS (CH)) THEN
+                RETURN CH;
+           END IF;
+           RETURN CHAR'FIRST;
+      END IDENT;
+ 
+      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+      BEGIN
+           IF EQUAL (NEWCHAR'POS (CH), NEWCHAR'POS (CH)) THEN
+                RETURN CH;
+           END IF;
+           RETURN NEWCHAR'FIRST;
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST( "C35507K" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A CHARACTER TYPE" );
+ 
+      BEGIN
+           IF CHAR'POS ('A') /= 0 THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') - 1" );
+           END IF;
+ 
+           IF CHAR'POS (B) /= 1 THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'POS(B) - 1" );
+           END IF;
+ 
+           IF CHAR'VAL (0) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
+           END IF;
+ 
+           IF CHAR'VAL (1) /= B THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
+           END IF;
+ 
+           IF CHAR'POS (IDENT ('A')) /= 0 THEN
+                FAILED ( "INCORRECT VALUE " &
+                         "FOR CHAR'POS (IDENT ('A')) - 2" );
+           END IF;
+ 
+           IF CHAR'POS (IDENT (B)) /= 1 THEN
+                FAILED ( "INCORRECT VALUE " &
+                         "FOR CHAR'POS (IDENT (B)) - 2" );
+           END IF;
+ 
+      END;
+ 
+      BEGIN
+           IF NEWCHAR'POS ('A') /= 0 THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
+           END IF;
+ 
+           IF NEWCHAR'POS (B) /= 1 THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) - 1" );
+           END IF;
+ 
+           IF NEWCHAR'VAL (0) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) - 1" );
+           END IF;
+ 
+           IF NEWCHAR'VAL (1) /= B THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
+           END IF;
+ 
+           IF NEWCHAR'VAL (IDENT_INT (1)) /= B THEN
+                FAILED ( "INCORRECT VALUE " &
+                         "FOR NEWCHAR'POS (IDENT (B)) - 2" );
+           END IF;
+ 
+           IF (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE " &
+                         "FOR IDENT (NEWCHAR'VAL (0)) - 2" );
+           END IF;
+ 
+      END;
+ 
+      BEGIN
+           IF CHAR'VAL (IDENT_INT (2)) = B THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'VAL (IDENT_INT (2)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHAR'VAL (IDENT_INT (2)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                          "FOR CHAR'VAL (IDENT_INT (2))" );
+      END;
+ 
+      BEGIN
+           IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
+      END;
+ 
+      POSITION := 0;
+ 
+      FOR CH IN CHARACTER LOOP
+           IF SCHAR'POS (CH) /= POSITION THEN
+                FAILED ( "INCORRECT VALUE FOR SCHAR'POS OF " &
+                          CHARACTER'IMAGE (CH) );
+           END IF;
+ 
+           POSITION := POSITION + 1;
+      END LOOP;
+ 
+      FOR POSITION IN 0 .. 31 LOOP
+           IF CHARACTER'VAL (POSITION) /= NONGRAPH (POSITION) THEN
+                FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
+                         "NONGRAPHIC CHARACTER IN POSITION - " &
+                          INTEGER'IMAGE (POSITION) );
+           END IF;
+      END LOOP;
+ 
+      POSITION := 32;
+ 
+      FOR CH IN BLANK .. ASCII.TILDE LOOP
+           IF SCHAR'VAL (POSITION) /= CH THEN
+                FAILED ( "INCORRECT VALUE FOR SCHAR'VAL OF " &
+                         "GRAPHIC CHARACTER IN POSITION - " &
+                          INTEGER'IMAGE (POSITION) );
+           END IF;
+ 
+           POSITION := POSITION + 1;
+      END LOOP;
+ 
+      IF CHARACTER'VAL (127) /= ASCII.DEL THEN
+           FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
+                     "NONGRAPHIC CHARACTER IN POSITION - 127" );
+      END IF;
+ 
+      BEGIN
+           IF CHARACTER'VAL (IDENT_INT (-1)) = ASCII.NUL THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHARACTER'VAL (IDENT_INT (-1)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR CHARACTER'VAL (IDENT_INT (-1)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHARACTER'VAL (IDENT_INT (-1))" );
+      END;
+ 
+      RESULT;
+ END C35507K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C35507L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT 
+ -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+ -- PARAMETER IS A CHARACTER TYPE.   
+ 
+ -- RJW 6/03/86
+ -- PWN 11/30/94 REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507L  IS
+ 
+      TYPE CHAR IS ('A', B);
+ 
+      TYPE NEWCHAR IS NEW CHAR;     
+ 
+ BEGIN
+ 
+      TEST( "C35507L" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " & 
+                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+ 
+      DECLARE
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR : STRING;
+                I1 : INTEGER;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                SUBTYPE SUBCH IS CHTYPE;               
+                CH : CHTYPE;
+                POSITION : INTEGER;
+           BEGIN
+                POSITION := 0;
+                FOR CH IN CHTYPE LOOP
+                     IF SUBCH'POS (CH) /= POSITION THEN 
+                          FAILED ( "INCORRECT VALUE FOR " & STR & 
+                                   "'POS OF " & CHTYPE'IMAGE (CH) );
+                     END IF;
+      
+                     IF SUBCH'VAL (POSITION) /= CH THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR & 
+                                   "'VAL OF CHARACTER IN POSITION - " &
+                                     INTEGER'IMAGE (POSITION) );
+                     END IF;
+                     POSITION := POSITION + 1;
+                END LOOP;
+      
+                BEGIN
+                     IF SUBCH'VAL (-1) = SUBCH'VAL (0) THEN
+                          FAILED ( "NO EXCEPTION RAISED " & 
+                                   "FOR " & STR & "'VAL (-1) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED " & 
+                                   "FOR " & STR & "'VAL (-1) - 2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED " & 
+                                   "FOR " & STR & "'VAL (-1)" );
+                END;     
+           END P;
+           
+           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 1);
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 1);
+           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 127);
+      BEGIN
+           PCHAR;
+           PNCHAR;
+           PCH;
+      END;
+ 
+      RESULT;
+ END C35507L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- C35507M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE WITH AN ENUMERATION
+ --     REPRESENTATION CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 06/03/86  CREATED ORIGINAL TEST
+ --     JLH 07/28/87  MODIFIED FUNCTION IDENT.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35507M  IS
+ 
+      TYPE CHAR IS ('A', B);
+      FOR CHAR USE ('A' => 4, B => 5);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN CH;
+           ELSE
+                RETURN 'A';
+           END IF;
+      END IDENT;
+ 
+      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN CH;
+           ELSE
+                RETURN 'A';
+           END IF;
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST( "C35507M" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A CHARACTER TYPE WITH AN " &
+                        "ENUMERATION REPESENTATION CLAUSE" );
+ 
+      BEGIN
+           IF CHAR'POS ('A') /= 0 THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'POS('A')" );
+           END IF;
+ 
+           IF CHAR'POS (B) /= 1 THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'POS(B)" );
+           END IF;
+ 
+           IF CHAR'VAL (0) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
+           END IF;
+ 
+           IF CHAR'VAL (1) /= B THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF NEWCHAR'POS ('A') /= 0 THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
+           END IF;
+ 
+           IF NEWCHAR'POS (B) /= 1 THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B)" );
+           END IF;
+ 
+           IF NEWCHAR'VAL (0) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0)" );
+           END IF;
+ 
+           IF NEWCHAR'VAL (1) /= B THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF CHAR'POS (IDENT ('A')) /= 0 THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') WITH " &
+                         "IDENT" );
+           END IF;
+ 
+           IF NEWCHAR'POS (IDENT (B)) /= 1 THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) WITH " &
+                         "IDENT" );
+           END IF;
+ 
+           IF IDENT (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) WITH " &
+                         "IDENT" );
+           END IF;
+ 
+           IF IDENT (CHAR'VAL (IDENT_INT(1))) /= B THEN
+                FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1) WITH IDENT" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF CHAR'VAL (IDENT_INT(2)) = B THEN
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHAR'VAL (IDENT_INT(2)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "CHAR'VAL (IDENT_INT(2)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "CHAR'VAL (IDENT_INT(2))" );
+      END;
+ 
+      BEGIN
+           IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED " &
+                         "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
+      END;
+ 
+      RESULT;
+ END C35507M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507n.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507n.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507n.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C35507N.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+ --     PARAMETER IS A CHARACTER TYPE WITH AN ENUMERATION REPRESENTATION
+ --     CLAUSE.
+ 
+ -- HISTORY:
+ --     RJW 06/03/86  CREATED ORIGINAL TEST.
+ --     JET 09/22/87  MADE REPRESENTATION VALUES CONSECUTIVE.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ --     PWN 11/30/94  REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507N  IS
+ 
+      TYPE CHAR IS ('A', B);
+      FOR CHAR USE ('A' => 4, B => 5);
+ 
+      TYPE NEWCHAR IS NEW CHAR;
+ 
+ BEGIN
+ 
+      TEST( "C35507N" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                        "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ACTUAL PARAMETER IS A CHARACTER TYPE " &
+                        "WITH AN ENUMERATION REPRESENTATION CLAUSE" );
+ 
+      DECLARE
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR : STRING;
+                I1 : INTEGER;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                SUBTYPE SUBCH IS CHTYPE;
+                CH : CHTYPE;
+                POSITION : INTEGER;
+           BEGIN
+                POSITION := 0;
+                FOR CH IN CHTYPE LOOP
+                     IF SUBCH'POS (CH) /= POSITION THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR &
+                                   "'POS OF " & CHTYPE'IMAGE (CH) );
+                     END IF;
+ 
+                     IF SUBCH'VAL (POSITION) /= CH THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR &
+                                   "'VAL OF CHARACTER IN POSITION - " &
+                                     INTEGER'IMAGE (POSITION) );
+                     END IF;
+                     POSITION := POSITION + 1;
+                END LOOP;
+ 
+                BEGIN
+                     IF SUBCH'VAL (-1) = SUBCH'VAL (0) THEN
+                          FAILED ( "NO EXCEPTION RAISED " &
+                                   "FOR " & STR & "'VAL (-1) - 1" );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED " &
+                                   "FOR " & STR & "'VAL (-1) - 2" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED " &
+                                   "FOR " & STR & "'VAL (-1)" );
+                END;
+           END P;
+ 
+           PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 1);
+           PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 1);
+           PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 127);
+      BEGIN
+           PCHAR;
+           PNCHAR;
+           PCH;
+      END;
+ 
+      RESULT;
+ END C35507N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C35507O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES 'FIRST' AND 'LAST' YIELD THE CORRECT 
+ -- RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.   
+ 
+ -- RJW 6/03/86
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ --              REMOVED PART OF TEST INVALID FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507O  IS
+ 
+      TYPE CHAR IS ('A', B);
+ 
+      TYPE NEWCHAR IS NEW CHAR;     
+ 
+      SPACE : CONSTANT CHARACTER := CHARACTER'(' ');
+ 
+      SUBTYPE NOCHAR IS CHARACTER RANGE CHARACTER'('Z') .. CHARACTER'('A');
+      SUBTYPE GRAPHIC IS CHARACTER RANGE SPACE .. ASCII.TILDE;
+      SUBTYPE NONGRAPHIC IS CHARACTER RANGE ASCII.NUL .. ASCII.US;
+ 
+      FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+      BEGIN
+           RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+      END IDENT;
+ 
+      FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+      BEGIN
+           RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST( "C35507O" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
+                        "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A CHARACTER TYPE" );
+ 
+      BEGIN 
+           IF IDENT (CHAR'FIRST) /= 'A' THEN 
+                FAILED ( "INCORRECT VALUE FOR CHAR'FIRST" );
+           END IF;
+ 
+           IF CHAR'LAST /= B THEN 
+                 FAILED ( "INCORRECT VALUE FOR CHAR'LAST" );
+           END IF;
+      END;
+ 
+      BEGIN 
+           IF NEWCHAR'FIRST /= 'A' THEN 
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'FIRST" );
+           END IF;
+ 
+           IF NEWCHAR'LAST /= IDENT (B) THEN 
+                FAILED ( "INCORRECT VALUE FOR NEWCHAR'LAST" );
+           END IF;
+      END;
+ 
+      BEGIN 
+           IF NOCHAR'FIRST /= CHARACTER'('Z') THEN 
+                FAILED ( "INCORRECT VALUE FOR NOCHAR'FIRST" );
+           END IF;
+ 
+           IF NOCHAR'LAST /= CHARACTER'('A') THEN 
+                FAILED ( "INCORRECT VALUE FOR NOCHAR'LAST" );
+           END IF;
+      END;
+ 
+      BEGIN 
+           IF CHARACTER'FIRST /= ASCII.NUL THEN 
+                FAILED ( "INCORRECT VALUE FOR CHARACTER'FIRST" );
+           END IF;
+ 
+      END;
+ 
+      BEGIN 
+           IF NONGRAPHIC'FIRST /= IDENT_CHAR (ASCII.NUL) THEN 
+                FAILED ( "INCORRECT VALUE FOR NONGRAPHIC'FIRST" );
+           END IF;
+ 
+           IF NONGRAPHIC'LAST /= ASCII.US THEN 
+                FAILED ( "INCORRECT VALUE FOR NONGRAPHIC'LAST" );
+           END IF;
+      END;
+ 
+      BEGIN 
+           IF GRAPHIC'FIRST /= SPACE THEN 
+                FAILED ( "INCORRECT VALUE FOR GRAPHIC'FIRST" );
+           END IF;
+ 
+           IF GRAPHIC'LAST /= ASCII.TILDE THEN 
+                FAILED ( "INCORRECT VALUE FOR GRAPHIC'LAST" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C35507O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35507p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35507p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C35507P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES 'FIRST' AND 'LAST' YIELD THE CORRECT 
+ -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+ -- PARAMETER IS A CHARACTER TYPE.   
+ 
+ -- RJW 6/03/86
+ -- PWN 11/30/94 REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35507P  IS
+ 
+      TYPE CHAR IS ('A', B);
+ 
+      TYPE NEWCHAR IS NEW CHAR;     
+ 
+      SPACE : CONSTANT CHARACTER := ' ';
+ 
+      SUBTYPE GRAPHIC IS CHARACTER RANGE SPACE .. ASCII.TILDE;
+      SUBTYPE NONGRAPHIC IS CHARACTER RANGE ASCII.NUL .. ASCII.US;
+ BEGIN
+ 
+      TEST( "C35507P" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
+                        "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                        "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+ 
+      DECLARE
+           GENERIC
+                TYPE CHTYPE IS (<>);
+                STR : STRING;
+                F, L : CHTYPE;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS 
+                SUBTYPE NOCHAR IS CHTYPE RANGE L .. F;
+           BEGIN 
+                IF CHTYPE'FIRST /= F THEN 
+                     FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
+                END IF;
+ 
+                IF CHTYPE'LAST /= L THEN 
+                     FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
+                END IF;
+ 
+                IF NOCHAR'FIRST /= L THEN 
+                     FAILED ( "INCORRECT VALUE FOR NOCHAR'FIRST AS A " &
+                              "SUBTYPE OF " & STR );
+                END IF;
+ 
+                IF NOCHAR'LAST /= F THEN 
+                     FAILED ( "INCORRECT VALUE FOR NOCHAR'LAST AS A " &
+                              "SUBTYPE OF " & STR  );
+                END IF;
+           END P;
+           
+           PROCEDURE P1 IS NEW P (CHAR, "CHAR", 'A', B);          
+           PROCEDURE P2 IS NEW P (NEWCHAR, "NEWCHAR", 'A', B);          
+           PROCEDURE P3 IS NEW P 
+                (GRAPHIC, "GRAPHIC", SPACE, ASCII.TILDE);
+           PROCEDURE P4 IS NEW P 
+                (NONGRAPHIC, "NONGRAPHIC", ASCII.NUL, ASCII.US);
+      BEGIN
+           P1;
+           P2;
+           P3;
+           P4;
+      END;
+ 
+      RESULT;
+ END C35507P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C35508A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS WHEN 
+ -- THE PREFIX IS A BOOLEAN TYPE.   
+ 
+ -- RJW 3/14/86  COMPLETELY REVISED.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35508A  IS
+ 
+ BEGIN
+ 
+      TEST( "C35508A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                        "THE CORRECT RESULTS WHEN THE PREFIX IS A " &
+                        "BOOLEAN TYPE" );
+ 
+      DECLARE
+           TYPE NEWBOOL IS NEW BOOLEAN;
+           SUBTYPE FRANGE IS BOOLEAN 
+                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+           SUBTYPE TRANGE IS BOOLEAN 
+                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
+           SUBTYPE NOBOOL IS BOOLEAN 
+                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
+ 
+      BEGIN
+ 
+           IF BOOLEAN'WIDTH /= 5 THEN
+                FAILED( "INCORRECT WIDTH FOR BOOLEAN" );
+           END IF;
+ 
+           IF NEWBOOL'WIDTH /= 5 THEN
+                FAILED( "INCORRECT WIDTH FOR NEWBOOL" );
+           END IF;
+ 
+           IF FRANGE'WIDTH /= 5 THEN
+                FAILED( "INCORRECT WIDTH FOR FRANGE" );
+           END IF;
+ 
+           IF TRANGE'WIDTH /= 4 THEN
+                FAILED( "INCORRECT WIDTH FOR TRANGE" );
+           END IF;
+ 
+           IF NOBOOL'WIDTH /= 0 THEN
+                FAILED( "INCORRECT WIDTH FOR NOBOOL" );
+           END IF;
+      
+      END;                    
+ 
+      RESULT;
+ END C35508A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C35508B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS WHEN 
+ -- THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL 
+ -- PARAMETER IS A BOOLEAN TYPE.   
+ 
+ -- RJW 3/19/86  COMPLETELY REVISED.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35508B  IS
+ 
+ BEGIN
+ 
+      TEST( "C35508B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                        "THE CORRECT RESULTS WHEN THE PREFIX IS A " &
+                        "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                        "PARAMETER IS A BOOLEAN TYPE" );
+ 
+      DECLARE
+           SUBTYPE FRANGE IS BOOLEAN 
+                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+           SUBTYPE TRANGE IS BOOLEAN 
+                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
+           TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+           GENERIC
+                TYPE B IS (<>);
+                W : INTEGER;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                SUBTYPE NOBOOL IS B RANGE 
+                     B'VAL (IDENT_INT(1)) .. B'VAL (IDENT_INT(0));
+           BEGIN
+                IF B'WIDTH /= W THEN 
+                     FAILED ( "INCORRECT B'WIDTH FOR " & STR );
+                END IF;
+                IF NOBOOL'WIDTH /= 0 THEN
+                     FAILED ( "INCORRECT NOBOOL'WIDTH FOR " & STR );
+                END IF;
+           END P;
+ 
+           PROCEDURE PROC1 IS NEW P (BOOLEAN, 5);
+           PROCEDURE PROC2 IS NEW P (FRANGE, 5);
+           PROCEDURE PROC3 IS NEW P (TRANGE, 4);
+           PROCEDURE PROC4 IS NEW P (NEWBOOL, 5);
+ 
+      BEGIN
+           PROC1 ( "BOOLEAN" );
+           PROC2 ( "FRANGE" );
+           PROC3 ( "TRANGE");
+           PROC4 ( "NEWBOOL" );
+      END;                    
+ 
+      RESULT;
+ END C35508B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C35508C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
+ -- RESULTS WHEN THE PREFIX IS A BOOLEAN TYPE.   
+ 
+ -- SUBTESTS ARE:
+ --     (A). TESTS FOR IMAGE.
+ --     (B). TESTS FOR VALUE.
+ 
+ -- RJW 3/19/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35508C  IS     
+ 
+      TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+ BEGIN
+ 
+      TEST( "C35508C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                        "PREFIX IS A BOOLEAN TYPE" );
+ -- PART (A).
+ 
+      DECLARE
+ 
+           A5, B5 : INTEGER := IDENT_INT(5);
+           C6     : INTEGER := IDENT_INT(6);
+      BEGIN  
+ 
+           IF BOOLEAN'IMAGE ( A5 = B5 ) /= "TRUE" THEN
+                FAILED ( "INCORRECT IMAGE FOR 'A5 = B5'" );
+           END IF;
+           IF BOOLEAN'IMAGE ( A5 = B5 )'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR 'A5 = B5'" );
+           END IF;
+ 
+           IF BOOLEAN'IMAGE ( C6 = A5 ) /= "FALSE" THEN
+                FAILED ( "INCORRECT IMAGE FOR 'C6 = A5'" );
+           END IF;          
+           IF BOOLEAN'IMAGE ( C6 = A5 )'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR 'C6 = A5'" );
+           END IF;          
+ 
+           IF BOOLEAN'IMAGE (TRUE) /= "TRUE" THEN
+                FAILED ( "INCORRECT IMAGE FOR 'TRUE'" );
+           END IF;          
+           IF BOOLEAN'IMAGE (TRUE)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR 'TRUE'" );
+           END IF;          
+ 
+           IF NEWBOOL'IMAGE (FALSE) /= "FALSE" THEN
+                FAILED ( "INCORRECT IMAGE FOR NEWBOOL'FALSE'" );
+           END IF;          
+           IF NEWBOOL'IMAGE (FALSE)'FIRST /= 1 THEN
+                FAILED ( "INCORRECT LOWER BOUND FOR NEWBOOL'FALSE'" );
+           END IF;          
+      END;
+ 
+ -----------------------------------------------------------------------
+ 
+ -- PART (B).
+ 
+      BEGIN  
+           IF BOOLEAN'VALUE (IDENT_STR("TRUE")) /= TRUE THEN     
+                FAILED ( "INCORRECT VALUE FOR ""TRUE""" );  
+           END IF;
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""TRUE""" );  
+      END;
+ 
+      BEGIN
+           IF NEWBOOL'VALUE (IDENT_STR("FALSE")) /= FALSE THEN
+                FAILED ( "INCORRECT VALUE FOR ""FALSE""" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""FALSE""" );
+      END;
+ 
+      BEGIN
+           IF BOOLEAN'VALUE ("true") /= TRUE THEN
+                FAILED ( "INCORRECT VALUE FOR ""true""" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR ""true""" );
+      END;
+ 
+      BEGIN
+           IF NEWBOOL'VALUE ("false") /= FALSE THEN
+                FAILED ( "INCORRECT VALUE FOR ""false""" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE FOR " &
+                         """false""" );
+      END;
+ 
+      BEGIN
+           IF BOOLEAN'VALUE (IDENT_STR("TRUE     ")) /= TRUE THEN
+                FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE - " &
+                         "TRAILING BLANKS" );
+      END;
+ 
+      BEGIN          
+           IF NEWBOOL'VALUE ("  FALSE") /= FALSE THEN
+                FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
+           END IF;          
+      EXCEPTION     
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - VALUE - LEADING " &
+                         "BLANKS" );
+      END;
+ 
+      DECLARE 
+           SUBTYPE SUBBOOL IS BOOLEAN RANGE FALSE .. FALSE;
+      BEGIN
+           IF SUBBOOL'VALUE (IDENT_STR("TRUE")) /= TRUE THEN     
+                FAILED ( "INCORRECT VALUE - ""TRUE"" AND " & 
+                         "SUBBOOL" );  
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - SUBBOOL" );
+      END;
+      
+      BEGIN
+           IF BOOLEAN'VALUE (IDENT_STR("MAYBE")) = TRUE THEN
+                FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - ""MAYBE"" " );
+      END;
+ 
+      BEGIN
+           IF BOOLEAN'VALUE (IDENT_CHAR(ASCII.HT) & "TRUE") = TRUE THEN
+                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
+      END;
+ 
+      BEGIN
+           IF NEWBOOL'VALUE ("FALSE" & ASCII.HT) = FALSE THEN
+                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
+      END;
+ 
+      RESULT;
+ END C35508C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,192 ----
+ -- C35508E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
+ --     RESULTS WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE
+ --     ACTUAL ARGUMENT IS A BOOLEAN TYPE.
+ 
+ --     SUBTESTS ARE:
+ --         (A). TESTS FOR IMAGE.
+ --         (B). TESTS FOR VALUE.
+ 
+ -- HISTORY:
+ --     RJW 03/19/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C35508E  IS
+ 
+ BEGIN
+ 
+      TEST( "C35508E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                        "'VALUE' YIELD THE CORRECT RESULTS  WHEN THE " &
+                        "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
+                        "WHOSE ACTUAL ARGUMENT IS A BOOLEAN TYPE" );
+ -- PART (A).
+ 
+      DECLARE
+           TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+           GENERIC
+                TYPE BOOL IS (<>);
+           PROCEDURE P (B : BOOL; STR : STRING );
+ 
+           PROCEDURE P (B : BOOL; STR : STRING) IS
+                SUBTYPE SUBBOOL IS BOOL
+                     RANGE BOOL'VAL (IDENT_INT(0)) ..
+                                                BOOL'VAL (IDENT_INT(0));
+           BEGIN
+ 
+                IF BOOL'IMAGE (B) /= STR THEN
+                     FAILED ( "INCORRECT BOOL'IMAGE OF " & STR );
+                END IF;
+                IF BOOL'IMAGE (B)'FIRST /= 1 THEN
+                     FAILED ( "INCORRECT BOOL'FIRST FOR " & STR );
+                END IF;
+ 
+                IF SUBBOOL'IMAGE (B) /= STR THEN
+                     FAILED ( "INCORRECT SUBBOOL'IMAGE OF " & STR );
+                END IF;
+                IF SUBBOOL'IMAGE (B)'FIRST /= 1 THEN
+                     FAILED ( "INCORRECT SUBBOOL'FIRST FOR " & STR );
+                END IF;
+           END P;
+ 
+           PROCEDURE NP1 IS NEW P ( BOOLEAN );
+           PROCEDURE NP2 IS NEW P ( NEWBOOL );
+      BEGIN
+           NP1 ( TRUE, "TRUE" );
+           NP2 ( FALSE, "FALSE" );
+ 
+      END;
+ 
+ -----------------------------------------------------------------------
+ 
+ -- PART (B).
+ 
+      DECLARE
+           TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+           GENERIC
+                TYPE BOOL IS (<>);
+           PROCEDURE P (STR : STRING; B : BOOL );
+ 
+           PROCEDURE P (STR : STRING; B : BOOL) IS
+                SUBTYPE SUBBOOL IS BOOL
+                     RANGE BOOL'VAL (IDENT_INT(0)) ..
+                                                BOOL'VAL (IDENT_INT(0));
+ 
+           BEGIN
+                BEGIN
+                     IF BOOL'VALUE (STR) /= B THEN
+                          FAILED ( "INCORRECT BOOL'VALUE OF """ &
+                                   STR & """" );
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED BOOL'VALUE OF """ &
+                                   STR & """" );
+                END;
+                BEGIN
+                     IF SUBBOOL'VALUE (STR) /= B THEN
+                          FAILED ( "INCORRECT SUBBOOL'VALUE OF """ &
+                                   STR & """" );
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED SUBBOOL'VALUE " &
+                                   "OF """ & STR & """" );
+                END;
+           END P;
+ 
+           PROCEDURE NP1 IS NEW P ( BOOLEAN );
+           PROCEDURE NP2 IS NEW P ( NEWBOOL );
+ 
+      BEGIN
+           NP1 ( "TRUE", TRUE );
+           NP2 ( "FALSE", FALSE );
+           NP2 ( "true", TRUE );
+           NP1 ( "false", FALSE );
+           NP1 ( "         TRUE", TRUE );
+           NP2 ( "FALSE        ", FALSE );
+      END;
+ 
+      DECLARE
+           GENERIC
+                TYPE BOOL IS (<>);
+           PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING);
+ 
+           PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING) IS
+                SUBTYPE SUBBOOL IS BOOL
+                     RANGE BOOL'VAL (IDENT_INT(0)) ..
+                                                 BOOL'VAL (IDENT_INT(0));
+ 
+           BEGIN
+                BEGIN
+                     IF BOOL'VALUE (STR1) = B THEN
+                          FAILED ( "NO EXCEPTION RAISED - " &
+                                   "BOOL'VALUE WITH " & STR2 &
+                                   "- EQUAL " );
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED - " &
+                                   "BOOL'VALUE WITH " & STR2 &
+                                   " - NOT EQUAL" );
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED - " &
+                                   "BOOL'VALUE WITH " & STR2 );
+                END;
+                BEGIN
+                     IF SUBBOOL'VALUE (STR1) /= B THEN
+                          FAILED ( "NO EXCEPTION RAISED - " &
+                                   "SUBBOOL'VALUE WITH " &
+                                   STR2 & " - EQUAL");
+                     ELSE
+                          FAILED ( "NO EXCEPTION RAISED - " &
+                                   "SUBBOOL'VALUE WITH " &
+                                   STR2 & " - NOT EQUAL");
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED - " &
+                                   "SUBBOOL'VALUE WITH " & STR2 );
+                END;
+           END P;
+ 
+           PROCEDURE NP IS NEW P ( BOOLEAN );
+      BEGIN
+           NP ( "MAYBE", TRUE, "NON-BOOLEAN VALUE");
+           NP ( ASCII.HT & "TRUE", TRUE, "LEADING 'HT'" );
+           NP ( "FALSE" & ASCII.HT , FALSE, "TRAILING 'HT'" );
+      END;
+ 
+      RESULT;
+ END C35508E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C35508G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS A BOOLEAN TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/19/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35508G IS
+ 
+ BEGIN
+      TEST ("C35508G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "BOOLEAN TYPE" );
+ 
+      BEGIN
+           IF BOOLEAN'PRED (IDENT_BOOL(TRUE)) /= FALSE THEN
+                FAILED ( "INCORRECT VALUE FOR PRED OF TRUE" );
+           END IF;
+           IF BOOLEAN'SUCC (IDENT_BOOL(FALSE)) /= TRUE THEN
+                FAILED ( "INCORRECT VALUE FOR SUCC OF FALSE" );
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE NEWBOOL IS NEW BOOLEAN;
+      BEGIN
+           IF NEWBOOL'PRED (TRUE) /= FALSE THEN
+                FAILED ( "INCORRECT VALUE FOR NEWBOOL'PRED OF TRUE" );
+           END IF;
+           IF NEWBOOL'SUCC (FALSE) /= TRUE THEN
+                FAILED ( "INCORRECT VALUE FOR NEWBOOL'SUCC OF FALSE" );
+           END IF;
+      END;
+ 
+      DECLARE
+ 
+           SUBTYPE SBOOL IS BOOLEAN RANGE IDENT_BOOL(TRUE) ..
+                                                       IDENT_BOOL(TRUE);
+ 
+      BEGIN
+           BEGIN
+                IF SBOOL'PRED (IDENT_BOOL(TRUE)) /= FALSE THEN
+                     FAILED ( "INCORRECT VALUE FOR SBOOL'PRED " &
+                              "OF TRUE" );
+                END IF;
+           END;
+ 
+           BEGIN
+                IF SBOOL'PRED (IDENT_BOOL(SBOOL'BASE'FIRST)) = TRUE THEN
+                     FAILED("'PRED('FIRST) WRAPPED AROUNT TO TRUE");
+                END IF;
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "'PRED (SBOOL'BASE'FIRST)" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                              "'PRED (SBOOL'BASE'FIRST)" );
+           END;
+ 
+           BEGIN
+                IF SBOOL'SUCC (IDENT_BOOL(SBOOL'BASE'LAST)) = FALSE THEN
+                     FAILED("'SUCC('LAST) WRAPPED AROUNT TO FALSE");
+                END IF;
+                FAILED ( "NO EXCEPTION RAISED FOR " &
+                         "'SUCC (SBOOL'BASE'LAST)" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                              "'SUCC (SBOOL'BASE'LAST)" );
+           END;
+      END;
+ 
+      RESULT;
+ END C35508G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C35508H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS A
+ --     BOOLEAN TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/24/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35508H IS
+ 
+ BEGIN
+      TEST ("C35508H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
+                       "IS A BOOLEAN TYPE" );
+ 
+      DECLARE
+ 
+           TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+           GENERIC
+                TYPE BOOL IS (<>);
+                F, T : BOOL;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                SUBTYPE SBOOL IS BOOL RANGE T .. T;
+           BEGIN
+                BEGIN
+                     IF BOOL'PRED (T) /= F THEN
+                          FAILED ( "INCORRECT VALUE FOR " &
+                                    STR & "'PRED OF T" );
+                     END IF;
+                     IF BOOL'SUCC (F) /= T THEN
+                          FAILED ( "INCORRECT VALUE FOR " &
+                                    STR & "'SUCC OF F" );
+                     END IF;
+                END;
+ 
+                BEGIN
+                     IF SBOOL'PRED (T) /= F THEN
+                          FAILED ( "INCORRECT VALUE FOR SBOOL'PRED " &
+                                   "OF T FOR " & STR);
+                     END IF;
+                END;
+ 
+                BEGIN
+                     IF SBOOL'PRED (SBOOL'BASE'FIRST) = T THEN
+                          FAILED("'PRED('FIRST) WRAPPED AROUND " &
+                                 "TO TRUE FOR " & STR);
+                     END IF;
+                     FAILED ( "NO EXCEPTION RAISED FOR " &
+                               STR & "'PRED (SBOOL'BASE'FIRST)" );
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'PRED (SBOOL'BASE'FIRST)" );
+                END;
+ 
+                BEGIN
+                     IF SBOOL'SUCC (SBOOL'BASE'LAST) = F THEN
+                          FAILED("'SUCC('LAST) WRAPPED AROUND TO " &
+                                 "FALSE FOR " & STR);
+                     END IF;
+                     FAILED ( "NO EXCEPTION RAISED FOR " & STR &
+                              "'SUCC (SBOOL'BASE'LAST)" );
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'SUCC (SBOOL'BASE'LAST)" );
+                END;
+           END P;
+ 
+           PROCEDURE NP1 IS NEW P
+                          ( BOOL => BOOLEAN, F => FALSE, T => TRUE );
+ 
+           PROCEDURE NP2 IS NEW P
+                          ( BOOL => NEWBOOL, F => FALSE, T => TRUE );
+      BEGIN
+           NP1 ("BOOLEAN");
+           NP2 ("NEWBOOL");
+      END;
+ 
+      RESULT;
+ END C35508H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C35508K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE 
+ -- PREFIX IS A BOOLEAN TYPE.
+ 
+ -- RJW 3/19/86
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35508K IS
+ 
+      TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+ BEGIN
+      TEST ("C35508K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS  WHEN THE PREFIX IS A " &
+                       "BOOLEAN TYPE" );
+ 
+      BEGIN
+           IF BOOLEAN'POS (IDENT_BOOL(FALSE)) /= 0 THEN
+                FAILED ( "WRONG POS FOR 'FALSE'" );
+           END IF;
+           IF BOOLEAN'POS (IDENT_BOOL(TRUE)) /= 1 THEN
+                FAILED ( "WRONG POS FOR 'TRUE'" );
+           END IF;
+ 
+           IF BOOLEAN'VAL (IDENT_INT(0)) /= FALSE THEN
+                FAILED ( "WRONG VAL FOR '0'" );
+           END IF;
+           IF BOOLEAN'VAL (IDENT_INT(1)) /= TRUE THEN
+                FAILED ( "WRONG VAL FOR '1'" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF BOOLEAN'VAL (IDENT_INT(-1)) = TRUE THEN
+                FAILED("'VAL(-1) WRAPPED AROUND TO TRUE");
+           END IF;
+           FAILED ( "NO EXCEPTION RAISED FOR VAL OF '-1'" );
+      EXCEPTION     
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VAL OF '-1'" );
+      END;
+ 
+      BEGIN
+           IF BOOLEAN'VAL (IDENT_INT(2)) = FALSE THEN
+                FAILED("BOOLEAN'VAL(2) WRAPPED AROUND TO FALSE");
+           END IF;
+           FAILED ( "NO EXCEPTION RAISED FOR VAL OF '2'" );
+      EXCEPTION     
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VAL OF '2'" );
+      END;
+ 
+      BEGIN
+           IF NEWBOOL'POS (FALSE) /= 0 THEN
+                FAILED ( "WRONG POS FOR NEWBOOL'(FALSE)" );
+           END IF;
+           IF NEWBOOL'POS (TRUE) /= 1 THEN
+                FAILED ( "WRONG POS FOR NEWBOOL'(TRUE)" );
+           END IF;
+ 
+           IF NEWBOOL'VAL (0) /= FALSE THEN
+                FAILED ( "WRONG NEWBOOL'VAL FOR '0'" );
+           END IF;
+           IF NEWBOOL'VAL (1) /= TRUE THEN
+                FAILED ( "WRONG NEWBOOL'VAL FOR '1'" );
+           END IF;
+      END;
+ 
+      BEGIN
+           IF NEWBOOL'VAL (IDENT_INT(-1)) = TRUE THEN
+                FAILED("NEWBOOL'VAL(-1) WRAPPED AROUND TO TRUE"); 
+           END IF;
+           FAILED ( "NO EXCEPTION RAISED FOR NEWBOOL'VAL OF '-1'" );
+      EXCEPTION     
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NEWBOOL'VAL OF '-1'" );
+      END;
+ 
+      BEGIN
+           IF NEWBOOL'VAL (IDENT_INT(2)) = FALSE THEN
+                FAILED("NEWBOOL'VAL(2) WRAPPED AROUND TO FALSE");
+           END IF;
+           FAILED ( "NO EXCEPTION RAISED FOR NEWBOOL'VAL OF '2'" );
+      EXCEPTION     
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NEWBOOL'VAL OF '2'" );
+      END;
+ 
+      RESULT;
+ END C35508K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- C35508L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE 
+ -- PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS A 
+ -- BOOLEAN TYPE.
+ 
+ -- RJW 3/24/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35508L IS
+ 
+ BEGIN
+      TEST ("C35508L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
+                       "IS A BOOLEAN TYPE" );
+ 
+      DECLARE
+           TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+           GENERIC 
+                TYPE BOOL IS (<>);
+           PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER);
+ 
+           PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER) IS
+                SUBTYPE SBOOL IS BOOL 
+                RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0));
+           BEGIN
+                IF BOOL'POS (B) /= I THEN
+                     FAILED ( "WRONG " & STR & "'POS FOR " &
+                               BOOL'IMAGE (B) & " - 1" );
+                END IF;
+                IF BOOL'VAL (I) /= B THEN
+                     FAILED ( "WRONG " & STR & "'VAL FOR " &
+                               INTEGER'IMAGE (I) & " - 1" );
+                END IF;
+ 
+                IF SBOOL'POS (B) /= I THEN
+                     FAILED ( "WRONG " & STR & "'POS FOR " &
+                               BOOL'IMAGE (B) & " - 2" );
+                END IF;
+ 
+                IF SBOOL'VAL (I) /= B THEN
+                     FAILED ( "WRONG " & STR & "'VAL FOR " &
+                               INTEGER'IMAGE (I) & " - 2" );
+                END IF;
+           END P;
+ 
+           GENERIC 
+                TYPE BOOL IS (<>);
+           PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER);
+ 
+           PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER) IS
+                SUBTYPE SBOOL IS BOOL 
+                RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0));
+           BEGIN
+                BEGIN
+                     IF BOOL'VAL (I) = B THEN
+                          FAILED (STR & "'VAL OF " & INTEGER'IMAGE (I) &
+                                        " = " & BOOL'IMAGE (B));
+                     END IF;
+                     FAILED ( "NO EXCEPTION RAISED FOR " & STR & 
+                              "'VAL OF " & INTEGER'IMAGE (I) );
+                EXCEPTION     
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " & STR &
+                                   "'VAL " & "OF " &
+                                    INTEGER'IMAGE (I) );
+                END;
+           
+                BEGIN
+                     IF SBOOL'VAL (I) = B THEN
+                          FAILED (STR & " SBOOL'VAL OF " & 
+                                  INTEGER'IMAGE(I) & " = " &
+                                  BOOL'IMAGE (B) );
+                          END IF;
+                          FAILED( "NO EXCEPTION RAISED FOR VAL OF " &
+                                   INTEGER'IMAGE (I)  &
+                                  "WITH SBOOL OF " & STR);
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " & STR &
+                                   "'VAL " & "OF " &
+                                    INTEGER'IMAGE (I) &
+                                   "WITH SBOOL " );  
+                END;
+           END Q;
+ 
+           PROCEDURE NP1 IS NEW P ( BOOL => BOOLEAN );
+           PROCEDURE NP2 IS NEW P ( BOOL => NEWBOOL );
+           PROCEDURE NQ1 IS NEW Q ( BOOL => BOOLEAN );
+           PROCEDURE NQ2 IS NEW Q ( BOOL => NEWBOOL );
+      BEGIN
+           NP1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(0) );
+           NP1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(1) );
+           NP2 ( "NEWBOOL", FALSE , 0 );
+           NP2 ( "NEWBOOL", TRUE , 1 );
+           NQ1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(-1) );
+           NQ1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(2) );
+           NQ2 ( "NEWBOOL", FALSE , -1 );
+           NQ2 ( "NEWBOOL", TRUE , 2 );
+      END;
+ 
+      RESULT;
+ END C35508L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C35508O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS A BOOLEAN TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/19/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35508O IS
+ 
+ BEGIN
+      TEST ("C35508O", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "BOOLEAN TYPE" );
+ 
+      DECLARE
+           SUBTYPE TBOOL IS BOOLEAN RANGE IDENT_BOOL(TRUE) ..
+                                                      IDENT_BOOL(TRUE);
+           SUBTYPE FBOOL IS BOOLEAN
+                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+           SUBTYPE NOBOOL IS BOOLEAN
+                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
+           TYPE NEWBOOL IS NEW BOOLEAN;
+           TYPE NIL IS NEW BOOLEAN RANGE IDENT_BOOL(TRUE) ..
+                                                     IDENT_BOOL(FALSE);
+ 
+      BEGIN
+           IF IDENT_BOOL(BOOLEAN'FIRST) /= FALSE THEN
+                FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST" );
+           END IF;
+           IF IDENT_BOOL(BOOLEAN'LAST) /= TRUE THEN
+                FAILED ( "WRONG VALUE FOR BOOLEAN'LAST" );
+           END IF;
+ 
+           IF TBOOL'FIRST /= TRUE THEN
+                FAILED ( "WRONG VALUE FOR TBOOL'FIRST" );
+           END IF;
+           IF TBOOL'LAST /= TRUE THEN
+                FAILED ( "WRONG VALUE FOR TBOOL'LAST" );
+           END IF;
+ 
+           IF FBOOL'FIRST /= FALSE THEN
+                FAILED ( "WRONG VALUE FOR FBOOL'FIRST" );
+           END IF;
+           IF FBOOL'LAST /= FALSE THEN
+                FAILED ( "WRONG VALUE FOR FBOOL'LAST" );
+           END IF;
+ 
+           IF NOBOOL'FIRST /= TRUE THEN
+                FAILED ( "WRONG VALUE FOR NOBOOL'FIRST" );
+           END IF;
+           IF NOBOOL'LAST /= FALSE THEN
+                FAILED ( "WRONG VALUE FOR NOBOOL'LAST" );
+           END IF;
+ 
+           IF NEWBOOL'FIRST /= FALSE THEN
+                FAILED ( "WRONG VALUE FOR NEWBOOL'FIRST" );
+           END IF;
+           IF NEWBOOL'LAST /= TRUE THEN
+                FAILED ( "WRONG VALUE FOR NEWBOOL'LAST" );
+           END IF;
+           IF NIL'FIRST /= TRUE THEN
+                FAILED ( "WRONG VALUE FOR NIL'FIRST" );
+           END IF;
+           IF NIL'LAST /= FALSE THEN
+                FAILED ( "WRONG VALUE FOR NIL'LAST" );
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C35508O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35508p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35508p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,131 ----
+ -- C35508P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+ --     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
+ --     IS A BOOLEAN TYPE.
+ 
+ -- HISTORY:
+ --     RJW 03/19/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35508P IS
+ 
+ BEGIN
+      TEST ("C35508P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                       "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                       "PARAMETER IS A BOOLEAN TYPE" );
+      DECLARE
+           SUBTYPE TBOOL IS BOOLEAN
+                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
+           SUBTYPE FBOOL IS BOOLEAN
+                RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+           SUBTYPE NOBOOL IS BOOLEAN
+                RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
+           TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+           GENERIC
+                TYPE BOOL IS (<>);
+                F, L : BOOL;
+           PROCEDURE P ( STR : STRING );
+ 
+           PROCEDURE P ( STR : STRING ) IS
+           BEGIN
+                IF BOOL'FIRST /= F THEN
+                     FAILED ( "WRONG VALUE FOR " & STR & "'FIRST" );
+                END IF;
+                IF BOOL'LAST /= L THEN
+                     FAILED ( "WRONG VALUE FOR " & STR & "'LAST" );
+                END IF;
+           END P;
+ 
+           GENERIC
+                TYPE BOOL IS (<>);
+           PROCEDURE Q;
+ 
+           PROCEDURE Q IS
+           BEGIN
+                IF BOOL'FIRST /= BOOL'VAL (IDENT_INT(1)) THEN
+                     FAILED ( "WRONG 'FIRST FOR NOBOOL" );
+                END IF;
+                IF BOOL'LAST /= BOOL'VAL (IDENT_INT(0)) THEN
+                     FAILED ( "WRONG 'LAST FOR NOBOOL" );
+                END IF;
+           END Q;
+ 
+           GENERIC
+                TYPE BOOL IS (<>);
+                F, L : BOOL;
+           PROCEDURE R;
+ 
+           PROCEDURE R IS
+                SUBTYPE SBOOL IS BOOL
+                               RANGE BOOL'VAL (0) .. BOOL'VAL (1);
+           BEGIN
+                IF SBOOL'FIRST /= F THEN
+                     FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST AS " &
+                              "SUBTYPE " );
+                END IF;
+                IF SBOOL'LAST /= L THEN
+                     FAILED ( "WRONG VALUE FOR BOOLEAN'LAST AS " &
+                              "SUBTYPE" );
+                END IF;
+           END R;
+ 
+           PROCEDURE P1 IS NEW P
+           ( BOOL => BOOLEAN, F => IDENT_BOOL(FALSE),
+                                               L => IDENT_BOOL(TRUE) );
+ 
+           PROCEDURE P2 IS NEW P
+           ( BOOL => TBOOL, F => IDENT_BOOL(TRUE),
+                                               L => IDENT_BOOL(TRUE) );
+ 
+           PROCEDURE P3 IS NEW P
+           ( BOOL => FBOOL, F => IDENT_BOOL(FALSE),
+                                              L => IDENT_BOOL(FALSE) );
+ 
+           PROCEDURE P4 IS NEW P
+                          (BOOL => NEWBOOL, F => FALSE, L => TRUE );
+ 
+           PROCEDURE Q1 IS NEW Q
+                          ( BOOL => NOBOOL );
+ 
+           PROCEDURE R1 IS NEW R
+                          ( BOOL => BOOLEAN, F => FALSE, L => TRUE );
+ 
+      BEGIN
+           P1 ( "BOOLEAN" );
+           P2 ( "TBOOL" );
+           P3 ( "FBOOL" );
+           P4 ( "NEWBOOL" );
+           Q1;
+           R1;
+      END;
+ 
+      RESULT;
+ END C35508P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35703a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35703a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35703a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35703a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C35703A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'FIRST AND 'LAST EXIST AND CAN BE ASSIGNED.  CHECK THAT
+ -- 'FIRST IS LESS THAN OR EQUAL TO 'LAST.
+ 
+ -- BAW 5 SEPT 80
+ -- R.WILLIAMS 8/21/86    ADDED A TYPE DECLARED WITHOUT A RANGE
+ --                       CONSTRAINT.  RENAMED TO -B.  ADDED EXCEPTION
+ --                       HANDLERS.
+ -- GMT 6/29/87           MOVED THE CALL TO  REPORT.TEST INTO A NEWLY
+ --                       CREATED PACKAGE NAMED SHOW_TEST_HEADER.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35703A IS
+ 
+      TYPE REAL1 IS DIGITS 2 RANGE 0.25..0.5;
+      TYPE REAL2 IS DIGITS 3;
+ 
+      PACKAGE  SHOW_TEST_HEADER  IS
+               -- PURPOSE OF THIS PACKAGE:
+               -- WE WANT THE TEST HEADER INFORMATION TO BE
+               -- PRINTED  BEFORE  ANY OF THE  PASS/FAIL  MESSAGES.
+      END SHOW_TEST_HEADER;
+ 
+      PACKAGE  BODY  SHOW_TEST_HEADER  IS
+      BEGIN
+           TEST( "C35703A",
+                 "CHECK THAT FIRST AND LAST CAN BE ASSIGNED " &
+                 "AND THAT FIRST <= LAST" );
+      END SHOW_TEST_HEADER;
+ 
+      PACKAGE XPKG IS
+           X : REAL1;
+      END XPKG;
+ 
+      PACKAGE BODY XPKG IS
+      BEGIN
+           X := REAL1'FIRST;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                         "REAL1'FIRST" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                         "REAL1'FIRST" );
+      END XPKG;
+ 
+      PACKAGE YPKG IS
+           Y : REAL1;
+      END YPKG;
+ 
+      PACKAGE BODY YPKG IS
+      BEGIN
+           Y := REAL1'LAST;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                         "REAL1'LAST" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                         "REAL1'LAST" );
+      END YPKG;
+ 
+      PACKAGE APKG IS
+           A : REAL2;
+      END APKG;
+ 
+      PACKAGE BODY APKG IS
+      BEGIN
+           A := REAL2'FIRST;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                         "REAL2'FIRST" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                         "REAL2'FIRST" );
+      END APKG;
+ 
+      PACKAGE BPKG IS
+           B : REAL2;
+      END BPKG;
+ 
+      PACKAGE BODY BPKG IS
+      BEGIN
+           B := REAL2'LAST;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                         "REAL2'LAST" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                         "REAL2'LAST" );
+      END BPKG;
+ 
+ 
+ BEGIN
+ 
+      DECLARE
+           USE XPKG;
+           USE YPKG;
+      BEGIN
+           IF X > Y THEN
+                FAILED ( "REAL1'FIRST IS GREATER THAN REAL1'LAST" );
+           END IF;
+      END;
+ 
+      DECLARE
+           USE APKG;
+           USE BPKG;
+      BEGIN
+           IF A > B THEN
+                FAILED ( "REAL2'FIRST IS GREATER THEN REAL2'LAST" );
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C35703A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- C35704A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FIXED POINT VALUES CAN BE USED IN FLOATING POINT RANGE
+ -- CONSTRAINT IN TYPE DEFINITION.
+ 
+ -- BAW 9/5/80
+ -- JCR 4/7/82
+ 
+ WITH REPORT;
+ PROCEDURE C35704A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C35704A","CHECK THAT L AND R CAN BE FIXED POINT" &
+            " IN A FLOATING POINT TYPE DEFINITION");
+ 
+      DECLARE
+ 
+ 
+           TYPE F IS DELTA 0.5 RANGE -5.0..5.0;
+ 
+           F1 : CONSTANT F := -4.0;
+           F2 : CONSTANT F := 4.0;
+ 
+           TYPE G1 IS DIGITS 5 RANGE F1..F2;
+      BEGIN
+ 
+           IF (ABS(G1'FIRST)-4.0) /= 0.0 OR
+              (ABS(G1'LAST)-4.0)  /= 0.0
+           THEN FAILED ("ERROR IN USING FIXED-POINT IN RANGE " &
+                        "CONSTRAINT");
+           END IF;
+ 
+      END;
+      RESULT;
+ 
+ END C35704A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,62 ----
+ -- C35704B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DIFFERENT FLOATING POINT TYPES FROM SAME PARENT CAN BE
+ -- USED IN A FLOATING POINT RANGE CONSTRAINT IN A TYPE DEFINITION.
+ 
+ -- JCR 4/7/82
+ 
+ WITH REPORT;
+ PROCEDURE C35704B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C35704B", "DIFFERENT FLOATING POINT TYPES " &
+            "FROM THE SAME PARENT IN FLOATING POINT" &
+            "TYPE DEFINITION'S RANGE CONSTRAINT");
+ 
+      DECLARE
+           TYPE F IS  DIGITS 5 RANGE -5.0 .. 5.0;
+ 
+           TYPE F1 IS NEW F;
+ 
+           TYPE G1 IS DIGITS 5 RANGE F1'FIRST..F'LAST;
+           TYPE G2 IS DIGITS 5 RANGE F'FIRST..F1'LAST;
+ 
+      BEGIN
+ 
+           IF G1'FIRST /= G1(G2'FIRST) OR G1'LAST /= G1(G2'LAST) OR
+              G2'FIRST /= G2(F'FIRST) OR G2'LAST /= G2(F'LAST)
+           THEN 
+                FAILED ("USING DIFF FLOATING POINT TYPES " &
+                        "FROM SAME PARENT");
+ 
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C35704B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,62 ----
+ -- C35704C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DIFFERENT FLOATING POINT TYPES FROM DIFFERENT PARENTS
+ -- CAN BE USE IN FLOATING POINT RANGE CONSTRAINTS IN TYPE DEFINITIONS.
+ 
+ -- JCR 4/7/82
+ 
+ WITH REPORT;
+ PROCEDURE C35704C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C35704C", "DIFFERENT FLOATING POINT TYPES " &
+            "FROM DIFFERENT PARENTS IN FLOATING POINT RANGE " &
+            "CONSTRAINT IN TYPE DEFINITION");
+ 
+      DECLARE
+ 
+           TYPE F IS DIGITS 5 RANGE -5.0 .. 5.0;
+           TYPE F1 IS DIGITS 5 RANGE -5.0 .. 5.0;
+      
+           TYPE G1 IS DIGITS 5 RANGE  F'FIRST..F1'LAST;
+           TYPE G2 IS DIGITS 5 RANGE F1'FIRST..F'LAST;
+      
+      BEGIN
+ 
+ 
+           IF G1'FIRST /= G1(F'FIRST) OR G1'FIRST /= G1(G2'FIRST) OR
+           G1'FIRST /= G1(F1'FIRST) OR G1'LAST /= G1(F'LAST) OR
+           G1'LAST /= G1(G2'LAST) OR G1'LAST /= G1(F1'LAST)
+ 
+           THEN FAILED ("USING FLOAT FROM DIFF PARENTS");
+ 
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C35704C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35704d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35704d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- C35704D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A COMBINATION OF FIXED AND FLOAT CAN BE USED IN A
+ -- FLOATING POINT RANGE CONSTRAINT IN A TYPE DEFINITION.
+ 
+ -- JCR 4/7/82
+ 
+ WITH REPORT;
+ PROCEDURE C35704D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C35704D","MIXED FIXED AND FLOAT IN FLOATING " &
+            "POINT RANGE CONSTRAINT IN A TYPE DEFINITION");
+ 
+      DECLARE
+ 
+           TYPE F IS DIGITS 5;
+           TYPE R IS DELTA 0.5 RANGE -5.0 .. 5.0;
+ 
+           T1 : CONSTANT F := -4.0;
+           T2 : CONSTANT F := 4.0;
+ 
+           R1 : CONSTANT R := -4.0;
+           R2 : CONSTANT R := 4.0;
+ 
+           TYPE G1 IS DIGITS 5 RANGE T1..R2;
+           TYPE G2 IS DIGITS 5 RANGE R1..T2;
+ 
+      BEGIN
+ 
+           IF (ABS(G1'FIRST)- 4.0) /= 0.0  OR
+              (ABS(G1'LAST) - 4.0) /= 0.0  OR
+              (ABS(G2'FIRST)- 4.0) /= 0.0  OR
+              (ABS(G2'LAST) - 4.0) /= 0.0
+      
+           THEN FAILED ("MIXED FIXED AND FLOAT IN FLOAT RANGE " &
+                        "CONSTRAINT");
+      
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+  
+ 
+ END C35704D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35801d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35801d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35801d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35801d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C35801D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ATTRIBUTES FIRST AND LAST RETURN VALUES HAVING THE
+ -- SAME BASE TYPE AS THE PREFIX WHEN THE PREFIX IS A GENERIC FORMAL 
+ -- SUBTYPE WHOSE ACTUAL ARGUMENT IS A FLOATING POINT TYPE.
+ 
+ -- R.WILLIAMS 8/21/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35801D IS
+      TYPE REAL IS DIGITS 3 RANGE -100.0 .. 100.0;
+ 
+      TYPE NFLT IS NEW FLOAT;
+ 
+      GENERIC
+           TYPE F IS DIGITS <>;
+      PROCEDURE P (STR : STRING);
+ 
+      PROCEDURE P (STR : STRING) IS
+ 
+           SUBTYPE SF IS F RANGE -1.0 .. 1.0;
+           F1 : SF := 0.0;
+           F2 : SF := 0.0;
+           
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                F1 := SF'FIRST;
+                F2 := SF'LAST;
+           END IF;
+ 
+           IF F1 /= -1.0 OR F2 /= 1.0 THEN
+                FAILED ( "WRONG RESULTS FROM " & STR & "'FIRST OR " &
+                         STR & "'LAST" );
+           END IF;
+      END P;
+      
+      PROCEDURE NP1 IS NEW P (FLOAT);
+ 
+      PROCEDURE NP2 IS NEW P (NFLT);
+ 
+      PROCEDURE NP3 IS NEW P (REAL);
+ 
+ BEGIN
+      TEST ( "C35801D", "CHECK THAT THE ATTRIBUTES FIRST AND " &
+                        "LAST RETURN VALUES HAVING THE SAME " &
+                        "BASE TYPE AS THE PREFIX WHEN THE " &
+                        "PREFIX IS A GENERIC FORMAL SUBTYPE " &
+                        "WHOSE ACTUAL ARGUMENT IS A FLOATING " &
+                        "POINT TYPE" );
+ 
+ 
+      NP1 ("FLOAT");
+      NP2 ("NFLT");
+      NP3 ("REAL");
+ 
+      RESULT;     
+ END C35801D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35902d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35902d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35902d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35902d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,121 ----
+ -- C35902D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BINARY POINT IN THE MANTISSA OF A FIXED POINT NUMBER
+ -- CAN LIE OUTSIDE THE MANTISSA (EITHER TO THE LEFT OR TO THE RIGHT).
+ 
+ -- WRG 7/18/86
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C35902D IS
+ 
+ BEGIN
+ 
+      TEST ("C35902D", "CHECK THAT THE BINARY POINT IN THE MANTISSA " &
+                       "OF A FIXED POINT NUMBER CAN LIE OUTSIDE THE " &
+                       "MANTISSA (EITHER TO THE LEFT OR TO THE RIGHT)");
+ 
+      COMMENT ("VALUE OF SYSTEM.MAX_MANTISSA IS" &
+               POSITIVE'IMAGE(MAX_MANTISSA) );
+ 
+   A: DECLARE
+ 
+           RS : CONSTANT := 2.0;
+ 
+           TYPE ONE_TO_THE_RIGHT IS
+                DELTA RS
+                RANGE -(2.0 ** (MAX_MANTISSA+1) ) ..
+                        2.0 ** (MAX_MANTISSA+1);
+                -- THE BINARY POINT IS ONE PLACE TO THE RIGHT OF THE
+                -- LARGEST POSSIBLE MANTISSA.
+ 
+           R1, R2 : ONE_TO_THE_RIGHT;
+ 
+      BEGIN
+ 
+           R1 := RS;
+           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+                R1 := R1 * IDENT_INT (2);
+           END LOOP;
+           R2 := R1 - RS;
+           R2 := R2 + R1;
+           -- AT THIS POINT, R2 SHOULD EQUAL ONE_TO_THE_RIGHT'LARGE.
+           R2 := -R2;
+           R2 := R2 + (R1 - RS);
+           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+                R2 := R2 / IDENT_INT (2);
+           END LOOP;
+           IF R2 /= -RS THEN
+                FAILED ("IDENTITY-PRESERVING OPERATIONS ARE FLAKY - A");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - A");
+ 
+      END A;
+ 
+   B: DECLARE
+ 
+           LS : CONSTANT := 2.0 ** (-(MAX_MANTISSA+1) );
+ 
+           TYPE ONE_TO_THE_LEFT IS
+                DELTA LS
+                RANGE -(2.0 ** (-1) ) ..
+                        2.0 ** (-1);
+                -- THE BINARY POINT IS ONE PLACE TO THE LEFT OF THE
+                -- LARGEST POSSIBLE MANTISSA.
+ 
+           L1, L2 : ONE_TO_THE_LEFT;
+ 
+      BEGIN
+ 
+           L1 := LS;
+           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+                L1 := L1 * IDENT_INT (2);
+           END LOOP;
+           L2 := L1 - LS;
+           L2 := L2 + L1;
+           -- AT THIS POINT, L2 SHOULD EQUAL ONE_TO_THE_LEFT'LARGE.
+           L2 := -L2;
+           L2 := L2 + (L1 - LS);
+           FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+                L2 := L2 / IDENT_INT (2);
+           END LOOP;
+           IF L2 /= -LS THEN
+                FAILED ("IDENTITY-PRESERVING OPERATIONS ARE FLAKY - B");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - B");
+ 
+      END B;
+ 
+      RESULT;
+ 
+ END C35902D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35904a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35904a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35904a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35904a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C35904A.ADA
+  
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT INCOMPATIBLE FIXED POINT CONSTRAINTS RAISE
+ --     APPROPRIATE EXCEPTIONS.
+  
+  
+ -- HISTORY:
+ --     RJK 05/17/83  CREATED ORIGINAL TEST.
+ --     PWB 02/03/86  CORRECTED TEST ERROR:
+ --                   ADDED POSSIBLITY OF NUMERIC_ERROR
+ --                   IN DECLARATIONS OF SFX3 AND SFX4.
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  CHANGED RANGE
+ --                   CONSTRAINTS OF SUBTYPE SFX1.  CHANGED UPPER BOUND
+ --                   OF THE CONSTRAINT OF SFX4.  CHANGED RANGE
+ --                   CONSTRAINTS OF FIX.
+ --     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+ --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+ --     EDS 07/16/98  AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35904A IS
+ 
+      TYPE FIX IS DELTA 0.5 RANGE -3.0 .. 3.0;
+ 
+ BEGIN
+ 
+      TEST ("C35904A", "CHECK THAT INCOMPATIBLE FIXED POINT " &
+                       "CONSTRAINTS RAISE APPROPRIATE EXCEPTION");
+  
+ -- TEST FOR CORRECT SUBTYPE DEFINITION FOR COMPATIBILITY BETWEEN TYPE
+ -- AND SUBTYPE CONSTRAINTS.
+  
+      BEGIN
+  
+           DECLARE
+  
+                SUBTYPE SFX1 IS FIX DELTA 1.0 RANGE 0.0 .. 2.0;   -- OK.
+                SFX1_VAR : SFX1;
+  
+           BEGIN
+                SFX1_VAR := 1.0;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                 FAILED ("FIXED POINT CONSTRAINTS ARE NOT IN ERROR");
+           WHEN OTHERS =>
+                 FAILED ("EXCEPTION SHOULD NOT BE RAISED WHILE " &
+                         "CHECKING DELTA CONSTRAINT");
+      END;
+ 
+ -- TEST FOR INCORRECT SUBTYPE DEFINITION ON ACCURACY BETWEEN TYPE AND
+ -- SUBTYPE DEFINITIONS.
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                SUBTYPE SFX IS FIX DELTA 0.1;  -- DELTA IS SMALLER FOR
+                                               -- SUBTYPE THAN FOR TYPE.
+                -- DEFINE AN OBJECT OF SUBTYPE SFX AND USE IT TO AVOID 
+                -- OPTIMIZATION OF SUBTYPE
+                SFX_VAR : SFX := FIX(IDENT_INT(1));
+ 
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED FOR INCOMPATABLE DELTA " & 
+                        FIX'IMAGE(SFX_VAR) );  --USE SFX_VAR
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                        "DELTA CONSTRAINT");
+      END;
+ 
+      RESULT;
+ 
+ END C35904A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35904b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35904b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35904b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35904b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C35904B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INCOMPATIBLE FIXED POINT CONSTRAINTS RAISE
+ -- CONSTRAINT_ERROR FOR GENERIC FORMAL TYPES.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- RJW 6/20/86
+ -- DWC 07/24/87     -- ADDED NUMERIC_ERROR HANDLERS.
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ -- EDS 07/16/98 AVOID OPTIMIZATION 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35904B IS
+ 
+      GENERIC
+           TYPE FIX IS DELTA <>;
+      PROCEDURE PROC (STR : STRING);
+ 
+      PROCEDURE PROC (STR : STRING) IS
+           SUBTYPE SFIX IS FIX DELTA 0.1 RANGE -1.0 .. 1.0;
+           -- DEFINE AN OBJECT OF SUBTYPE SFIX AND USE IT TO AVOID 
+           -- OPTIMIZATION OF SUBTYPE
+           SFIX_VAR : SFIX := SFIX(IDENT_INT(0));
+      BEGIN
+           FAILED ("NO EXCEPTION RAISED FOR " & STR & " " &
+                   SFIX'IMAGE(SFIX_VAR) );  --USE SFIX_VAR
+      END PROC;
+ 
+ BEGIN
+ 
+      TEST ( "C35904B", "CHECK THAT INCOMPATIBLE FIXED POINT " &
+                        "CONSTRAINTS RAISE CONSTRAINT_ERROR " &
+                        "FOR GENERIC FORMAL TYPES" );
+ 
+ -- TEST FOR INCORRECT SUBTYPE DEFINITION ON ACCURACY BETWEEN TYPE AND
+ -- SUBTYPE DEFINITIONS.
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                TYPE FIX1 IS DELTA 0.5          -- DELTA IS SMALLER FOR
+                          RANGE -2.0 .. 2.0;    -- SUBTYPE THEN FOR
+                                                -- TYPE.
+ 
+                PROCEDURE NPROC IS NEW PROC (FIX1);
+ 
+           BEGIN
+                NPROC ( "INCOMPATIBLE DELTA" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                        "DELTA CONSTRAINT");
+      END;
+ 
+ -- TEST THAT CONSTRAINT_ERROR IS RAISED
+ -- FOR A RANGE VIOLATION.
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                TYPE FIX2 IS DELTA 0.1 RANGE 0.0 .. 2.0; -- LOWER
+                                                         -- BOUND.
+ 
+                PROCEDURE NPROC IS NEW PROC (FIX2);
+ 
+           BEGIN
+                NPROC ("FIXED POINT LOWER BOUND CONSTRAINT VIOLATION");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
+                         "LOWER BOUND VIOLATION");
+           WHEN OTHERS =>
+                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                        "FIXED POINT LOWER BOUND CONSTRAINT");
+      END;
+ 
+ -- TEST THAT CONSTRAINT_ERROR IS RAISED
+ -- FOR A RANGE VIOLATION.
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                TYPE FIX3 IS DELTA 0.1 RANGE -2.0 .. 0.0;  -- UPPER
+                                                           -- BOUND.
+ 
+                PROCEDURE NPROC IS NEW PROC (FIX3);
+           BEGIN
+                NPROC ("FIXED POINT UPPER BOUND CONSTRAINT VIOLATION");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
+                         "UPPER BOUND VIOLATION");
+           WHEN OTHERS =>
+                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                        "FIXED POINT UPPER BOUND CONSTRAINT");
+      END;
+ 
+      RESULT;
+ 
+ END C35904B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a02a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a02a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a02a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C35A02A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT T'DELTA YIELDS CORRECT VALUES FOR SUBTYPE T.
+ 
+ -- RJW 2/27/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35A02A IS
+ 
+ BEGIN
+ 
+      TEST ( "C35A02A", "CHECK THAT T'DELTA YIELDS CORRECT VALUES " &
+                        "FOR SUBTYPE T" );
+                               
+      DECLARE
+           D  : CONSTANT := 0.125;
+           SD : CONSTANT := 1.0;
+      
+           TYPE VOLT IS DELTA D RANGE 0.0 .. 255.0;
+           SUBTYPE ROUGH_VOLTAGE IS VOLT DELTA SD;
+ 
+           GENERIC
+                TYPE FIXED IS DELTA <> ;
+           FUNCTION F RETURN FIXED;
+ 
+           FUNCTION F RETURN FIXED IS
+           BEGIN
+                RETURN FIXED'DELTA;
+           END F;
+ 
+           FUNCTION VF IS NEW F (VOLT);
+           FUNCTION RF IS NEW F (ROUGH_VOLTAGE);
+ 
+      BEGIN 
+           IF VOLT'DELTA /= D THEN
+                FAILED ( "INCORRECT VALUE FOR VOLT'DELTA" );
+           END IF;
+           IF ROUGH_VOLTAGE'DELTA /= SD THEN 
+                FAILED ( "INCORRECT VALUE FOR ROUGH_VOLTAGE'DELTA" );
+           END IF;
+ 
+           IF VF /= D THEN
+                FAILED ( "INCORRECT VALUE FOR VF" );
+           END IF;
+           IF RF /= SD THEN
+                FAILED ( "INCORRECT VALUE FOR RF" );
+           END IF;
+      END;               
+ 
+      RESULT;
+ 
+ END C35A02A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C35A05A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+ -- THE CORRECT VALUES.
+ 
+ -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+ 
+ -- WRG 8/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35A05A IS
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE LEFT_OUT_M1       IS DELTA 0.25  RANGE -0.5 .. 0.5;
+      TYPE LEFT_EDGE_M1      IS DELTA 0.5   RANGE -1.0 .. 1.0;
+      TYPE RIGHT_EDGE_M1     IS DELTA 1.0   RANGE -2.0 .. 2.0;
+      TYPE RIGHT_OUT_M1      IS DELTA 2.0   RANGE -4.0 .. 4.0;
+      TYPE MIDDLE_M2         IS DELTA 0.5   RANGE -2.0 .. 2.0;
+      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+      TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
+      TYPE MIDDLE_M16        IS DELTA 2.0 **(-6) RANGE -1024.0 .. 1024.0;
+      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+      TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
+      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+      TYPE DECIMAL_M11       IS DELTA 0.09999 RANGE  -100.0 ..    100.0;
+      TYPE DECIMAL2_M18      IS DELTA 0.1   RANGE   -9999.0 ..   9999.0;
+ 
+      -------------------------------------------------------------------
+ 
+      SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
+           DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
+      SUBTYPE ST_MIDDLE_M14   IS MIDDLE_M16
+           DELTA 2.0 ** (-5) RANGE -512.0 .. IDENT_INT (1) * 512.0;
+      SUBTYPE ST_MIDDLE_M2    IS LIKE_DURATION_M23
+           DELTA 0.5 RANGE -2.0 .. 2.0;
+      SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
+           DELTA 0.5 RANGE  0.0 .. 2.5;
+      SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
+           DELTA  10.0 RANGE -1000.0 .. 1000.0;
+      SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
+           DELTA 100.0 RANGE  -500.0 ..  500.0;
+ 
+      -------------------------------------------------------------------
+ 
+      PROCEDURE CHECK_FORE_AND_AFT
+          (NAME        : STRING;
+           ACTUAL_FORE : INTEGER; CORRECT_FORE : POSITIVE;
+           ACTUAL_AFT  : INTEGER; CORRECT_AFT  : POSITIVE) IS
+      BEGIN
+           IF ACTUAL_FORE /= IDENT_INT (CORRECT_FORE) THEN
+                FAILED (NAME & "'FORE =" & INTEGER'IMAGE(ACTUAL_FORE) );
+           END IF;
+           IF ACTUAL_AFT /= IDENT_INT (CORRECT_AFT) THEN
+                FAILED (NAME & "'AFT  =" & INTEGER'IMAGE(ACTUAL_AFT) );
+           END IF;
+      END CHECK_FORE_AND_AFT;
+ 
+ BEGIN
+ 
+      TEST ("C35A05A", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                       "BASIC TYPES");
+ 
+      CHECK_FORE_AND_AFT ("LEFT_OUT_M1",       LEFT_OUT_M1'FORE, 2,
+                                               LEFT_OUT_M1'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("LEFT_EDGE_M1",      LEFT_EDGE_M1'FORE, 2,
+                                               LEFT_EDGE_M1'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("RIGHT_EDGE_M1",     RIGHT_EDGE_M1'FORE, 2,
+                                               RIGHT_EDGE_M1'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("RIGHT_OUT_M1",      RIGHT_OUT_M1'FORE, 2,
+                                               RIGHT_OUT_M1'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("MIDDLE_M2",         MIDDLE_M2'FORE, 2,
+                                               MIDDLE_M2'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("MIDDLE_M3",         MIDDLE_M3'FORE, 2,
+                                               MIDDLE_M3'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("MIDDLE_M15",        MIDDLE_M15'FORE, 4,
+                                               MIDDLE_M15'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("MIDDLE_M16",        MIDDLE_M16'FORE, 5,
+                                               MIDDLE_M16'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("LIKE_DURATION_M23", LIKE_DURATION_M23'FORE, 6,
+                                               LIKE_DURATION_M23'AFT, 2);
+ 
+      CHECK_FORE_AND_AFT ("DECIMAL_M18",       DECIMAL_M18'FORE, 6,
+                                               DECIMAL_M18'AFT,  1);
+ 
+      IF DECIMAL_M4'FORE /= 5 AND DECIMAL_M4'FORE /= 4 THEN
+           FAILED ("DECIMAL_M4'FORE =" &
+                   INTEGER'IMAGE(DECIMAL_M4'FORE) );
+      END IF;
+      IF DECIMAL_M4'AFT /= 1 THEN
+           FAILED ("DECIMAL_M4'AFT  =" &
+                   INTEGER'IMAGE(DECIMAL_M4'AFT) );
+      END IF;
+ 
+      CHECK_FORE_AND_AFT ("DECIMAL_M11",       DECIMAL_M11'FORE, 4,
+                                               DECIMAL_M11'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("DECIMAL2_M18",      DECIMAL2_M18'FORE, 5,
+                                               DECIMAL2_M18'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("ST_LEFT_EDGE_M6",   ST_LEFT_EDGE_M6'FORE, 2,
+                                               ST_LEFT_EDGE_M6'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("ST_MIDDLE_M14",     ST_MIDDLE_M14'FORE, 4,
+                                               ST_MIDDLE_M14'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("ST_MIDDLE_M2",      ST_MIDDLE_M2'FORE, 2,
+                                               ST_MIDDLE_M2'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("ST_MIDDLE_M3",      ST_MIDDLE_M3'FORE, 2,
+                                               ST_MIDDLE_M3'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("ST_DECIMAL_M7",     ST_DECIMAL_M7'FORE, 5,
+                                               ST_DECIMAL_M7'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("ST_DECIMAL_M3",     ST_DECIMAL_M3'FORE, 4,
+                                               ST_DECIMAL_M3'AFT,  1);
+ 
+      RESULT;
+ 
+ END C35A05A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C35A05D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+ -- THE CORRECT VALUES.
+ 
+ -- CASE D: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC.
+ 
+ -- WRG 8/14/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35A05D IS
+ 
+      PI      : CONSTANT := 3.14159_26535_89793_23846;
+      TWO_PI  : CONSTANT := 2 * PI;
+      HALF_PI : CONSTANT := PI / 2;
+ 
+      MM : CONSTANT := 23;
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE MICRO_ANGLE_ERROR_M15  IS
+           DELTA 16.0  RANGE -(2.0 ** 19) .. 2.0 ** 19;
+      TYPE TRACK_RANGE_M15        IS
+           DELTA 0.125 RANGE -(2.0 ** 12) .. 2.0 ** 12;
+      TYPE SECONDS_MM             IS
+           DELTA 2.0 ** (8 - MM) RANGE -(2.0 ** 8) .. 2.0 ** 8;
+      TYPE RANGE_CELL_MM          IS
+           DELTA 2.0 ** (-5)
+           RANGE -(2.0 ** (MM - 5) ) .. 2.0 ** (MM - 5);
+ 
+      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
+      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
+ 
+      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
+      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
+ 
+      TYPE SYMMETRIC_DEGREES_M7  IS
+           DELTA 2.0         RANGE -180.0 .. 180.0;
+      TYPE NATURAL_DEGREES_M15   IS
+           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
+      TYPE SYMMETRIC_RADIANS_M16 IS
+           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
+      TYPE NATURAL_RADIANS_M8    IS
+           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
+ 
+      -------------------------------------------------------------------
+ 
+      SUBTYPE ST_MILES_M8             IS MILES_M16
+           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
+      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
+           DELTA 0.25 RANGE 0.0 .. 360.0;
+      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
+           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
+ 
+      -------------------------------------------------------------------
+ 
+      PROCEDURE CHECK_FORE_AND_AFT
+          (NAME        : STRING;
+           ACTUAL_FORE : INTEGER; CORRECT_FORE : POSITIVE;
+           ACTUAL_AFT  : INTEGER; CORRECT_AFT  : POSITIVE) IS
+      BEGIN
+           IF ACTUAL_FORE /= IDENT_INT (CORRECT_FORE) THEN
+                FAILED (NAME & "'FORE =" & INTEGER'IMAGE(ACTUAL_FORE) );
+           END IF;
+           IF ACTUAL_AFT /= IDENT_INT (CORRECT_AFT) THEN
+                FAILED (NAME & "'AFT  =" & INTEGER'IMAGE(ACTUAL_AFT) );
+           END IF;
+      END CHECK_FORE_AND_AFT;
+ 
+ BEGIN
+ 
+      TEST ("C35A05D", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                       "TYPICAL TYPES");
+ 
+      CHECK_FORE_AND_AFT ("MICRO_ANGLE_ERROR_M15",
+                                          MICRO_ANGLE_ERROR_M15'FORE, 7,
+                                          MICRO_ANGLE_ERROR_M15'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("TRACK_RANGE_M15", TRACK_RANGE_M15'FORE, 5,
+                                             TRACK_RANGE_M15'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("SECONDS_MM",      SECONDS_MM'FORE, 4,
+                                             SECONDS_MM'AFT,  5);
+ 
+      CHECK_FORE_AND_AFT ("RANGE_CELL_MM",   RANGE_CELL_MM'FORE, 7,
+                                             RANGE_CELL_MM'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("PIXEL_M10",       PIXEL_M10'FORE, 2,
+                                             PIXEL_M10'AFT,  4);
+ 
+      CHECK_FORE_AND_AFT ("RULER_M8",        RULER_M8'FORE, 3,
+                                             RULER_M8'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("HOURS_M16",       HOURS_M16'FORE, 3,
+                                             HOURS_M16'AFT,  4);
+ 
+      CHECK_FORE_AND_AFT ("MILES_M16",       MILES_M16'FORE, 5,
+                                             MILES_M16'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("SYMMETRIC_DEGREES_M7",
+                                          SYMMETRIC_DEGREES_M7'FORE, 4,
+                                          SYMMETRIC_DEGREES_M7'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("NATURAL_DEGREES_M15",
+                                          NATURAL_DEGREES_M15'FORE, 4,
+                                          NATURAL_DEGREES_M15'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("SYMMETRIC_RADIANS_M16",
+                                          SYMMETRIC_RADIANS_M16'FORE, 2,
+                                          SYMMETRIC_RADIANS_M16'AFT,  5);
+ 
+      CHECK_FORE_AND_AFT ("NATURAL_RADIANS_M8",
+                                          NATURAL_RADIANS_M8'FORE, 2,
+                                          NATURAL_RADIANS_M8'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("ST_MILES_M8",  ST_MILES_M8'FORE, 3,
+                                          ST_MILES_M8'AFT,  2);
+ 
+      CHECK_FORE_AND_AFT ("ST_NATURAL_DEGREES_M11",
+                                        ST_NATURAL_DEGREES_M11'FORE, 4,
+                                        ST_NATURAL_DEGREES_M11'AFT,  1);
+ 
+      CHECK_FORE_AND_AFT ("ST_SYMMETRIC_RADIANS_M8",
+                                        ST_SYMMETRIC_RADIANS_M8'FORE, 2,
+                                        ST_SYMMETRIC_RADIANS_M8'AFT,  2);
+ 
+      RESULT;
+ 
+ END C35A05D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05n.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05n.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05n.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,160 ----
+ -- C35A05N.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+ -- THE CORRECT VALUES.
+ 
+ -- CASE N: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE,
+ --         FOR GENERICS.
+ 
+ -- WRG 8/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35A05N IS
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE LEFT_OUT_M1       IS DELTA 0.25  RANGE -0.5 .. 0.5;
+      TYPE LEFT_EDGE_M1      IS DELTA 0.5   RANGE -1.0 .. 1.0;
+      TYPE RIGHT_EDGE_M1     IS DELTA 1.0   RANGE -2.0 .. 2.0;
+      TYPE RIGHT_OUT_M1      IS DELTA 2.0   RANGE -4.0 .. 4.0;
+      TYPE MIDDLE_M2         IS DELTA 0.5   RANGE -2.0 .. 2.0;
+      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+      TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
+      TYPE MIDDLE_M16        IS DELTA 2.0 **(-6) RANGE -1024.0 .. 1024.0;
+      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+      TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
+      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+      TYPE DECIMAL_M11       IS DELTA 0.09999 RANGE  -100.0 ..    100.0;
+      TYPE DECIMAL2_M18      IS DELTA 0.1   RANGE   -9999.0 ..   9999.0;
+ 
+      -------------------------------------------------------------------
+ 
+      SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
+           DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
+      SUBTYPE ST_MIDDLE_M14   IS MIDDLE_M16
+           DELTA 2.0 ** (-5) RANGE -512.0 .. IDENT_INT (1) * 512.0;
+      SUBTYPE ST_MIDDLE_M2    IS LIKE_DURATION_M23
+           DELTA 0.5 RANGE -2.0 .. 2.0;
+      SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
+           DELTA 0.5 RANGE  0.0 .. 2.5;
+      SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
+           DELTA  10.0 RANGE -1000.0 .. 1000.0;
+      SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
+           DELTA 100.0 RANGE  -500.0 ..  500.0;
+ 
+      -------------------------------------------------------------------
+ 
+      TYPE FORE_AND_AFT IS
+           RECORD
+                FORE, AFT : INTEGER;
+           END RECORD;
+ 
+      GENERIC
+           TYPE T IS DELTA <>;
+      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
+ 
+      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
+      BEGIN
+           RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
+      END ATTRIBUTES;
+ 
+      -------------------------------------------------------------------
+ 
+      PROCEDURE CHECK_ATTRIBUTES
+          (NAME : STRING;
+           ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
+      BEGIN
+           IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
+                FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
+                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
+           END IF;
+           IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
+                FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
+                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
+           END IF;
+      END CHECK_ATTRIBUTES;
+ 
+      -------------------------------------------------------------------
+ 
+      FUNCTION FA_LEFT_OUT_M1       IS NEW ATTRIBUTES(LEFT_OUT_M1      );
+      FUNCTION FA_LEFT_EDGE_M1      IS NEW ATTRIBUTES(LEFT_EDGE_M1     );
+      FUNCTION FA_RIGHT_EDGE_M1     IS NEW ATTRIBUTES(RIGHT_EDGE_M1    );
+      FUNCTION FA_RIGHT_OUT_M1      IS NEW ATTRIBUTES(RIGHT_OUT_M1     );
+      FUNCTION FA_MIDDLE_M2         IS NEW ATTRIBUTES(MIDDLE_M2        );
+      FUNCTION FA_MIDDLE_M3         IS NEW ATTRIBUTES(MIDDLE_M3        );
+      FUNCTION FA_MIDDLE_M15        IS NEW ATTRIBUTES(MIDDLE_M15       );
+      FUNCTION FA_MIDDLE_M16        IS NEW ATTRIBUTES(MIDDLE_M16       );
+      FUNCTION FA_LIKE_DURATION_M23 IS NEW ATTRIBUTES(LIKE_DURATION_M23);
+      FUNCTION FA_DECIMAL_M18       IS NEW ATTRIBUTES(DECIMAL_M18      );
+      FUNCTION FA_DECIMAL_M4        IS NEW ATTRIBUTES(DECIMAL_M4       );
+      FUNCTION FA_DECIMAL_M11       IS NEW ATTRIBUTES(DECIMAL_M11      );
+      FUNCTION FA_DECIMAL2_M18      IS NEW ATTRIBUTES(DECIMAL2_M18     );
+      FUNCTION FA_ST_LEFT_EDGE_M6   IS NEW ATTRIBUTES(ST_LEFT_EDGE_M6  );
+      FUNCTION FA_ST_MIDDLE_M14     IS NEW ATTRIBUTES(ST_MIDDLE_M14    );
+      FUNCTION FA_ST_MIDDLE_M2      IS NEW ATTRIBUTES(ST_MIDDLE_M2     );
+      FUNCTION FA_ST_MIDDLE_M3      IS NEW ATTRIBUTES(ST_MIDDLE_M3     );
+      FUNCTION FA_ST_DECIMAL_M7     IS NEW ATTRIBUTES(ST_DECIMAL_M7    );
+      FUNCTION FA_ST_DECIMAL_M3     IS NEW ATTRIBUTES(ST_DECIMAL_M3    );
+ 
+ BEGIN
+ 
+      TEST ("C35A05N", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                       "BASIC TYPES, GENERICS");
+ 
+      CHECK_ATTRIBUTES ("LEFT_OUT_M1",     FA_LEFT_OUT_M1,     (2, 1) );
+      CHECK_ATTRIBUTES ("LEFT_EDGE_M1",    FA_LEFT_EDGE_M1,    (2, 1) );
+      CHECK_ATTRIBUTES ("RIGHT_EDGE_M1",   FA_RIGHT_EDGE_M1,   (2, 1) );
+      CHECK_ATTRIBUTES ("RIGHT_OUT_M1",    FA_RIGHT_OUT_M1,    (2, 1) );
+      CHECK_ATTRIBUTES ("MIDDLE_M2",       FA_MIDDLE_M2,       (2, 1) );
+      CHECK_ATTRIBUTES ("MIDDLE_M3",       FA_MIDDLE_M3,       (2, 1) );
+      CHECK_ATTRIBUTES ("MIDDLE_M15",      FA_MIDDLE_M15,      (4, 2) );
+      CHECK_ATTRIBUTES ("MIDDLE_M16",      FA_MIDDLE_M16,      (5, 2) );
+      CHECK_ATTRIBUTES ("LIKE_DURATION_M23",
+                                         FA_LIKE_DURATION_M23, (6, 2) );
+      CHECK_ATTRIBUTES ("DECIMAL_M18",     FA_DECIMAL_M18,     (6, 1) );
+ 
+      IF FA_DECIMAL_M4.FORE /= 5 AND FA_DECIMAL_M4.FORE /= 4 THEN
+           FAILED ("GENERIC 'FORE FOR DECIMAL_M4 =" &
+                   INTEGER'IMAGE(FA_DECIMAL_M4.FORE) );
+      END IF;
+      IF FA_DECIMAL_M4.AFT /= 1 THEN
+           FAILED ("GENERIC 'AFT  FOR DECIMAL_M4 =" &
+                   INTEGER'IMAGE(FA_DECIMAL_M4.AFT) );
+      END IF;
+ 
+      CHECK_ATTRIBUTES ("DECIMAL_M11",     FA_DECIMAL_M11,     (4, 2) );
+      CHECK_ATTRIBUTES ("DECIMAL2_M18",    FA_DECIMAL2_M18,    (5, 1) );
+      CHECK_ATTRIBUTES ("ST_LEFT_EDGE_M6", FA_ST_LEFT_EDGE_M6, (2, 2) );
+      CHECK_ATTRIBUTES ("ST_MIDDLE_M14",   FA_ST_MIDDLE_M14,   (4, 2) );
+      CHECK_ATTRIBUTES ("ST_MIDDLE_M2",    FA_ST_MIDDLE_M2,    (2, 1) );
+      CHECK_ATTRIBUTES ("ST_MIDDLE_M3",    FA_ST_MIDDLE_M3,    (2, 1) );
+      CHECK_ATTRIBUTES ("ST_DECIMAL_M7",   FA_ST_DECIMAL_M7,   (5, 1) );
+      CHECK_ATTRIBUTES ("ST_DECIMAL_M3",   FA_ST_DECIMAL_M3,   (4, 1) );
+ 
+      RESULT;
+ 
+ END C35A05N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05q.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a05q.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a05q.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,184 ----
+ -- C35A05Q.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+ -- THE CORRECT VALUES.
+ 
+ -- CASE Q: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC,
+ --         FOR GENERICS.
+ 
+ -- WRG 8/20/86
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C35A05Q IS
+ 
+      PI      : CONSTANT := 3.14159_26535_89793_23846;
+      TWO_PI  : CONSTANT := 2 * PI;
+      HALF_PI : CONSTANT := PI / 2;
+ 
+      MM : CONSTANT := 23;
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE MICRO_ANGLE_ERROR_M15  IS
+           DELTA 16.0  RANGE -(2.0 ** 19) .. 2.0 ** 19;
+      TYPE TRACK_RANGE_M15        IS
+           DELTA 0.125 RANGE -(2.0 ** 12) .. 2.0 ** 12;
+      TYPE SECONDS_MM             IS
+           DELTA 2.0 ** (8 - MM) RANGE -(2.0 ** 8) .. 2.0 ** 8;
+      TYPE RANGE_CELL_MM          IS
+           DELTA 2.0 ** (-5)
+           RANGE -(2.0 ** (MM - 5) ) .. 2.0 ** (MM - 5);
+ 
+      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
+      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
+ 
+      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
+      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
+ 
+      TYPE SYMMETRIC_DEGREES_M7  IS
+           DELTA 2.0         RANGE -180.0 .. 180.0;
+      TYPE NATURAL_DEGREES_M15   IS
+           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
+      TYPE SYMMETRIC_RADIANS_M16 IS
+           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
+      TYPE NATURAL_RADIANS_M8    IS
+           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
+ 
+      -------------------------------------------------------------------
+ 
+      SUBTYPE ST_MILES_M8             IS MILES_M16
+           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
+      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
+           DELTA 0.25 RANGE 0.0 .. 360.0;
+      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
+           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
+ 
+      -------------------------------------------------------------------
+ 
+      TYPE FORE_AND_AFT IS
+           RECORD
+                FORE, AFT : INTEGER;
+           END RECORD;
+ 
+      GENERIC
+           TYPE T IS DELTA <>;
+      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
+ 
+      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
+      BEGIN
+           RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
+      END ATTRIBUTES;
+ 
+      -------------------------------------------------------------------
+ 
+      PROCEDURE CHECK_ATTRIBUTES
+          (NAME : STRING;
+           ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
+      BEGIN
+           IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
+                FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
+                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
+           END IF;
+           IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
+                FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
+                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
+           END IF;
+      END CHECK_ATTRIBUTES;
+ 
+      -------------------------------------------------------------------
+ 
+      FUNCTION FA_MICRO_ANGLE_ERROR_M15
+                              IS NEW ATTRIBUTES(MICRO_ANGLE_ERROR_M15  );
+      FUNCTION FA_TRACK_RANGE_M15
+                              IS NEW ATTRIBUTES(TRACK_RANGE_M15        );
+      FUNCTION FA_SECONDS_MM  IS NEW ATTRIBUTES(SECONDS_MM             );
+      FUNCTION FA_RANGE_CELL_MM
+                              IS NEW ATTRIBUTES(RANGE_CELL_MM          );
+      FUNCTION FA_PIXEL_M10   IS NEW ATTRIBUTES(PIXEL_M10              );
+      FUNCTION FA_RULER_M8    IS NEW ATTRIBUTES(RULER_M8               );
+      FUNCTION FA_HOURS_M16   IS NEW ATTRIBUTES(HOURS_M16              );
+      FUNCTION FA_MILES_M16   IS NEW ATTRIBUTES(MILES_M16              );
+      FUNCTION FA_SYMMETRIC_DEGREES_M7
+                              IS NEW ATTRIBUTES(SYMMETRIC_DEGREES_M7   );
+      FUNCTION FA_NATURAL_DEGREES_M15
+                              IS NEW ATTRIBUTES(NATURAL_DEGREES_M15    );
+      FUNCTION FA_SYMMETRIC_RADIANS_M16
+                              IS NEW ATTRIBUTES(SYMMETRIC_RADIANS_M16  );
+      FUNCTION FA_NATURAL_RADIANS_M8
+                              IS NEW ATTRIBUTES(NATURAL_RADIANS_M8     );
+      FUNCTION FA_ST_MILES_M8 IS NEW ATTRIBUTES(ST_MILES_M8            );
+      FUNCTION FA_ST_NATURAL_DEGREES_M11
+                              IS NEW ATTRIBUTES(ST_NATURAL_DEGREES_M11 );
+      FUNCTION FA_ST_SYMMETRIC_RADIANS_M8
+                              IS NEW ATTRIBUTES(ST_SYMMETRIC_RADIANS_M8);
+ 
+ BEGIN
+ 
+      TEST ("C35A05Q", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                       "TYPICAL TYPES, GENERICS");
+ 
+      CHECK_ATTRIBUTES ("MICRO_ANGLE_ERROR_M15",
+                                     FA_MICRO_ANGLE_ERROR_M15, (7, 1) );
+ 
+      CHECK_ATTRIBUTES ("TRACK_RANGE_M15", FA_TRACK_RANGE_M15, (5, 1) );
+ 
+      CHECK_ATTRIBUTES ("SECONDS_MM", FA_SECONDS_MM, (4, 5) );
+ 
+      CHECK_ATTRIBUTES ("RANGE_CELL_MM", FA_RANGE_CELL_MM, (7, 2) );
+ 
+      CHECK_ATTRIBUTES ("PIXEL_M10", FA_PIXEL_M10, (2, 4) );
+ 
+      CHECK_ATTRIBUTES ("RULER_M8",  FA_RULER_M8, (3, 2) );
+ 
+      CHECK_ATTRIBUTES ("HOURS_M16", FA_HOURS_M16, (3, 4) );
+ 
+      CHECK_ATTRIBUTES ("MILES_M16", FA_MILES_M16, (5, 2) );
+ 
+      CHECK_ATTRIBUTES ("SYMMETRIC_DEGREES_M7",
+                                     FA_SYMMETRIC_DEGREES_M7, (4, 1) );
+ 
+      CHECK_ATTRIBUTES ("NATURAL_DEGREES_M15",
+                                     FA_NATURAL_DEGREES_M15, (4, 2) );
+ 
+      CHECK_ATTRIBUTES ("SYMMETRIC_RADIANS_M16",
+                                     FA_SYMMETRIC_RADIANS_M16, (2, 5) );
+ 
+      CHECK_ATTRIBUTES ("NATURAL_RADIANS_M8",
+                                     FA_NATURAL_RADIANS_M8, (2, 2) );
+ 
+      CHECK_ATTRIBUTES ("ST_MILES_M8", FA_ST_MILES_M8, (3, 2) );
+ 
+      CHECK_ATTRIBUTES ("ST_NATURAL_DEGREES_M11",
+                                     FA_ST_NATURAL_DEGREES_M11, (4, 1) );
+ 
+      CHECK_ATTRIBUTES ("ST_SYMMETRIC_RADIANS_M8",
+                                    FA_ST_SYMMETRIC_RADIANS_M8, (2, 2) );
+ 
+      RESULT;
+ 
+ END C35A05Q;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a07a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a07a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a07a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a07a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- C35A07A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES THE FIRST AND LAST ATTRIBUTES YIELD
+ -- CORRECT VALUES.
+ 
+ -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+ 
+ -- WRG 8/25/86
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C35A07A IS
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+      TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
+      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+      TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
+      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+           -- LARGEST MODEL NUMBER IS 960.0.
+ 
+      -------------------------------------------------------------------
+ 
+      SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
+           DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
+      SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
+           DELTA 0.5 RANGE  0.0 .. 2.5;
+      SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
+           DELTA  10.0 RANGE -1000.0 .. 1000.0;
+           -- LARGEST MODEL NUMBER IS 1016.0.
+      SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
+           DELTA 100.0 RANGE  -500.0 ..  500.0;
+           -- LARGEST MODEL NUMBER IS 448.0.
+      SUBTYPE ST_MIDDLE_M15   IS MIDDLE_M15
+           RANGE 6.0 .. 3.0;
+ 
+ BEGIN
+ 
+      TEST ("C35A07A", "CHECK THAT FOR FIXED POINT TYPES THE FIRST " &
+                       "AND LAST ATTRIBUTES YIELD CORRECT VALUES - " &
+                       "BASIC TYPES");
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      IF MIDDLE_M3'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("MIDDLE_M3'FIRST /= 0.0");
+      END IF;
+      IF MIDDLE_M3'LAST /= IDENT_INT (1) * 2.5 THEN
+           FAILED ("MIDDLE_M3'LAST /= 2.5");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      IF LIKE_DURATION_M23'FIRST /= IDENT_INT (1) * (-86_400.0) THEN
+           FAILED ("LIKE_DURATION_M23'FIRST /= -86_400.0");
+      END IF;
+      IF LIKE_DURATION_M23'LAST  /= IDENT_INT (1) * 86_400.0 THEN
+           FAILED ("LIKE_DURATION_M23'LAST  /=  86_400.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF DECIMAL_M18'FIRST /= IDENT_INT (1) * (-10_000.0) THEN
+           FAILED ("DECIMAL_M18'FIRST /= -10_000.0");
+      END IF;
+      IF DECIMAL_M18'LAST /= IDENT_INT (1) * 10_000.0 THEN
+           FAILED ("DECIMAL_M18'LAST /= 10_000.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      IF ST_MIDDLE_M3'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("ST_MIDDLE_M3'FIRST /= 0.0");
+      END IF;
+      IF ST_MIDDLE_M3'LAST /= IDENT_INT (1) * 2.5 THEN
+           FAILED ("ST_MIDDLE_M3'LAST /= 2.5");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF ST_DECIMAL_M7'FIRST /= IDENT_INT (1) * (-1000.0) THEN
+           FAILED ("ST_DECIMAL_M7'FIRST /= -1000.0");
+      END IF;
+      IF ST_DECIMAL_M7'LAST /= IDENT_INT (1) * 1000.0 THEN
+           FAILED ("ST_DECIMAL_M7'LAST /= 1000.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      IF ST_MIDDLE_M15'FIRST /= IDENT_INT (1) * 6.0 THEN
+           FAILED ("ST_MIDDLE_M15'FIRST /= 6.0");
+      END IF;
+      IF ST_MIDDLE_M15'LAST /= IDENT_INT (1) * 3.0 THEN
+           FAILED ("ST_MIDDLE_M15'LAST /= 3.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ END C35A07A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a07d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a07d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a07d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a07d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C35A07D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES THE FIRST AND LAST ATTRIBUTES YIELD
+ -- CORRECT VALUES.
+ 
+ -- CASE D: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC.
+ 
+ -- WRG 8/25/86
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C35A07D IS
+ 
+      PI      : CONSTANT := 3.14159_26535_89793_23846;
+      TWO_PI  : CONSTANT := 2 * PI;
+      HALF_PI : CONSTANT := PI / 2;
+ 
+      MM : CONSTANT := MAX_MANTISSA;
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
+      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
+ 
+      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
+      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
+ 
+      TYPE SYMMETRIC_DEGREES_M7  IS
+           DELTA 2.0         RANGE -180.0 .. 180.0;
+      TYPE NATURAL_DEGREES_M15   IS
+           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
+      TYPE SYMMETRIC_RADIANS_M16 IS
+           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
+                -- 'SMALL = 2.0 ** (-14) = 0.00006_10351_5625.
+      TYPE NATURAL_RADIANS_M8    IS
+           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
+                -- 'SMALL = 2.0 ** ( -5) = 0.03125.
+ 
+      -------------------------------------------------------------------
+ 
+      SUBTYPE ST_MILES_M8             IS MILES_M16
+           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
+      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
+           DELTA 0.25 RANGE 0.0 .. 360.0;
+      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
+           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
+                -- 'SMALL = 2.0 ** ( -7) = 0.00781_25.
+ 
+ BEGIN
+ 
+      TEST ("C35A07D", "CHECK THAT FOR FIXED POINT TYPES THE FIRST " &
+                       "AND LAST ATTRIBUTES YIELD CORRECT VALUES - " &
+                       "TYPICAL TYPES");
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      IF PIXEL_M10'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("PIXEL_M10'FIRST /= 0.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF RULER_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("RULER_M8'FIRST /= 0.0");
+      END IF;
+      IF RULER_M8'LAST /= IDENT_INT (1) * 12.0 THEN
+           FAILED ("RULER_M8'LAST /= 12.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF HOURS_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("HOURS_M16'FIRST /= 0.0");
+      END IF;
+      IF HOURS_M16'LAST /= IDENT_INT (1) * 24.0 THEN
+           FAILED ("HOURS_M16'LAST /= 24.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF MILES_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("MILES_M16'FIRST /= 0.0");
+      END IF;
+      IF MILES_M16'LAST /= IDENT_INT (1) * 3000.0 THEN
+           FAILED ("MILES_M16'LAST /= 3000.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF SYMMETRIC_DEGREES_M7'FIRST /= IDENT_INT (1) * (-180.0) THEN
+           FAILED ("SYMMETRIC_DEGREES_M7'FIRST /= -180.0");
+      END IF;
+      IF SYMMETRIC_DEGREES_M7'LAST /= IDENT_INT (1) * 180.0 THEN
+           FAILED ("SYMMETRIC_DEGREES_M7'LAST /= 180.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF NATURAL_DEGREES_M15'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("NATURAL_DEGREES_M15'FIRST /= 0.0");
+      END IF;
+      IF NATURAL_DEGREES_M15'LAST /= IDENT_INT (1) * 360.0 THEN
+           FAILED ("NATURAL_DEGREES_M15'LAST /= 360.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      -- PI IS IN 3.0 + 2319 * 'SMALL .. 3.0 + 2320 * 'SMALL.
+      IF SYMMETRIC_RADIANS_M16'FIRST NOT IN
+         -3.14160_15625 .. -3.14154_05273_4375 THEN
+           FAILED ("SYMMETRIC_RADIANS_M16'FIRST NOT IN " &
+                   "-3.14160_15625 .. -3.14154_05273_4375");
+      END IF;
+      IF SYMMETRIC_RADIANS_M16'LAST  NOT IN
+         3.14154_05273_4375 .. 3.14160_15625 THEN
+           FAILED ("SYMMETRIC_RADIANS_M16'LAST NOT IN " &
+                   "3.14154_05273_4375 .. 3.14160_15625");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF NATURAL_RADIANS_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("NATURAL_RADIANS_M8'FIRST /= 0.0");
+      END IF;
+      -- TWO_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
+      IF NATURAL_RADIANS_M8'LAST  NOT IN 6.28125 .. 6.3125 THEN
+           FAILED ("NATURAL_RADIANS_M8'LAST NOT IN 6.28125 .. 6.3125");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF ST_MILES_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("ST_MILES_M8'FIRST /= 0.0");
+      END IF;
+      IF ST_MILES_M8'LAST /= IDENT_INT (1) * 10.0 THEN
+           FAILED ("ST_MILES_M8'LAST /= 10.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      IF ST_NATURAL_DEGREES_M11'FIRST /= IDENT_INT (1) * 0.0 THEN
+           FAILED ("ST_NATURAL_DEGREES_M11'FIRST /= 0.0");
+      END IF;
+      IF ST_NATURAL_DEGREES_M11'LAST /= IDENT_INT (1) * 360.0 THEN
+           FAILED ("ST_NATURAL_DEGREES_M11'LAST /= 360.0");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      -- HALF_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
+      IF ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN
+         -1.57812_5 .. -1.57031_25 THEN
+           FAILED ("ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN " &
+                   "-1.57812_5 .. -1.57031_25");
+      END IF;
+      IF ST_SYMMETRIC_RADIANS_M8'LAST  NOT IN
+         1.57031_25 .. 1.57812_5 THEN
+           FAILED ("ST_SYMMETRIC_RADIANS_M8'LAST NOT IN " &
+                   "1.57031_25 .. 1.57812_5");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ END C35A07D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a08b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a08b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c35a08b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c35a08b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C35A08B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE MULTIPLICATION AND DIVISION OPERATORS FOR TWO
+ --     FIXED POINT OPERANDS ARE DECLARED IN STANDARD AND ARE DIRECTLY
+ --     VISIBLE.
+ 
+ -- HISTORY:
+ --     BCB 01/21/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C35A08B IS
+ 
+      PACKAGE P IS
+           TYPE T1 IS DELTA 2.0**(-4) RANGE -100.0 .. 100.0;
+           TYPE T2 IS DELTA 2.0**(-4) RANGE -100.0 .. 100.0;
+      END P;
+      USE P;
+ 
+      X1 : P.T1 := 6.0;
+      X2 : P.T1 := 2.0;
+      X3 : P.T1;
+      X4 : P.T1;
+      X5 : P.T1;
+      X6 : P.T1;
+ 
+      X7 : P.T2 := 2.0;
+ 
+      FUNCTION IDENT_FIXED(X : P.T1) RETURN P.T1 IS
+      BEGIN
+           RETURN X * IDENT_INT(1);
+      END IDENT_FIXED;
+ 
+ BEGIN
+      TEST ("C35A08B", "CHECK THAT THE MULTIPLICATION AND DIVISION " &
+                       "OPERATORS FOR TWO FIXED POINT OPERANDS ARE " &
+                       "DECLARED IN STANDARD AND ARE DIRECTLY VISIBLE");
+ 
+      X3 := P.T1 (X1 * X2);
+      X4 := P.T1 (X1 / X2);
+ 
+      X5 := P.T1 (STANDARD."*" (X1,X2));
+      X6 := P.T1 (STANDARD."/" (X1,X2));
+ 
+      IF X3 /= IDENT_FIXED (12.0) THEN
+           FAILED ("IMPROPER VALUE FOR FIXED POINT MULTIPLICATION - 1");
+      END IF;
+ 
+      IF X4 /= IDENT_FIXED (3.0) THEN
+           FAILED ("IMPROPER VALUE FOR FIXED POINT DIVISION - 1");
+      END IF;
+ 
+      X3 := P.T1 (X1 * X7);
+      X4 := P.T1 (X1 / X7);
+ 
+      X5 := P.T1 (STANDARD."*" (X1,X7));
+      X6 := P.T1 (STANDARD."/" (X1,X7));
+ 
+      IF X3 /= IDENT_FIXED (12.0) THEN
+           FAILED ("IMPROPER VALUE FOR FIXED POINT MULTIPLICATION - 2");
+      END IF;
+ 
+      IF X4 /= IDENT_FIXED (3.0) THEN
+           FAILED ("IMPROPER VALUE FOR FIXED POINT DIVISION - 2");
+      END IF;
+ 
+      RESULT;
+ END C35A08B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c360002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c360002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c360002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c360002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,268 ----
+ -- C360002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that modular types may be used as array indices.
+ --
+ --      Check that if aliased appears in the component_definition of an
+ --      array_type that each component of the array is aliased.
+ --
+ --      Check that references to aliased array objects produce correct
+ --      results, and that out-of-bounds indexing correctly produces
+ --      Constraint_Error.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines several array types and subtypes indexed by modular
+ --      types; some aliased some not, some with aliased components, some not.
+ --
+ --      It then checks that assignments move the correct data.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      28 SEP 95   SAIC   Initial version
+ --      23 APR 96   SAIC   Doc fixes, fixed constrained/unconstrained conflict
+ --      13 FEB 97   PWB.CTA Removed illegal declarations and affected code
+ --!
+ 
+ ------------------------------------------------------------------- C360002
+ 
+ with Report;
+ 
+ procedure C360002 is
+ 
+   Verbose : Boolean := Report.Ident_Bool( False );
+ 
+   type Mod_128 is mod 128;
+ 
+   function Ident_128( I: Integer ) return Mod_128 is
+   begin
+     return Mod_128( Report.Ident_Int( I ) );
+   end Ident_128;
+ 
+   type Unconstrained_Array
+        is array( Mod_128 range <> ) of Integer;
+ 
+   type Unconstrained_Array_Aliased
+        is array( Mod_128 range <> ) of aliased Integer;
+ 
+   type Access_All_Unconstrained_Array
+        is access all Unconstrained_Array;
+ 
+   type Access_All_Unconstrained_Array_Aliased
+        is access all Unconstrained_Array_Aliased;
+ 
+   subtype Array_01_10
+           is Unconstrained_Array(01..10);
+ 
+   subtype Array_11_20
+           is Unconstrained_Array(11..20);
+ 
+   subtype Array_Aliased_01_10
+           is Unconstrained_Array_Aliased(01..10);
+ 
+   subtype Array_Aliased_11_20
+           is Unconstrained_Array_Aliased(11..20);
+ 
+   subtype Access_All_01_10_Array
+           is Access_All_Unconstrained_Array(01..10);
+ 
+   subtype Access_All_01_10_Array_Aliased
+           is Access_All_Unconstrained_Array_Aliased(01..10);
+ 
+   subtype Access_All_11_20_Array
+           is Access_All_Unconstrained_Array(11..20);
+ 
+   subtype Access_All_11_20_Array_Aliased
+           is Access_All_Unconstrained_Array_Aliased(11..20);
+ 
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   -- these 'filler' functions create unique values for every element that
+   -- is used and/or tested in this test.
+ 
+   Well_Bottom : Integer := 0;
+ 
+   function Filler( Size : Mod_128 ) return Unconstrained_Array is
+     It : Unconstrained_Array( 0..Size-1 );
+   begin
+     for Eyes in It'Range loop
+       It(Eyes) := Integer( Eyes ) + Well_Bottom;
+     end loop;
+     Well_Bottom := Well_Bottom + It'Length;
+     return It;
+   end Filler;
+ 
+   function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
+     It : Unconstrained_Array_Aliased( 0..Size-1 );
+   begin
+     for Ayes in It'Range loop
+       It(Ayes) := Integer( Ayes ) + Well_Bottom;
+     end loop;
+     Well_Bottom := Well_Bottom + It'Length;
+     return It;
+   end Filler;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   An_Integer : Integer;
+ 
+   type AAI is access all Integer;
+ 
+   An_Integer_Access : AAI;
+ 
+   Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
+ 
+   Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
+ 
+   Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
+ 
+   Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
+ 
+   Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
+ 
+   Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
+ 
+   Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
+                                    := Filler(10);               -- 60..69
+ 
+   Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
+                                    := Filler(10);               -- 70..79
+ 
+   Check_Item            : Access_All_Unconstrained_Array;
+ 
+   Check_Aliased_Item    : Access_All_Unconstrained_Array_Aliased;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   procedure Fail( Message : String; CI, SB : Integer ) is
+   begin
+     Report.Failed("Wrong value passed " & Message);
+     if Verbose then
+       Report.Comment("got" & Integer'Image(CI) &
+                      " should be" & Integer'Image(SB) );
+     end if;
+   end Fail;
+ 
+   procedure Check_Array_01_10( Checked_Item : Array_01_10;
+                                Low_SB       : Integer ) is
+   begin
+     for Index in Checked_Item'Range loop
+       if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
+         Fail("unaliased 1..10", Checked_Item(Index),
+                                 (Low_SB +Integer(Index)-1));
+       end if;
+     end loop;
+   end Check_Array_01_10;
+ 
+   procedure Check_Array_11_20( Checked_Item : Array_11_20;
+                                Low_SB       : Integer ) is
+   begin
+     for Index in Checked_Item'Range loop
+       if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
+         Fail("unaliased 11..20", Checked_Item(Index),
+                                  (Low_SB +Integer(Index)-11));
+       end if;
+     end loop;
+  end Check_Array_11_20;
+ 
+   procedure Check_Single_Integer( The_Integer, SB : Integer;
+                                   Message         : String ) is
+   begin
+     if The_Integer /= SB then
+       Report.Failed("Wrong integer value for " & Message );
+     end if;
+   end Check_Single_Integer;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C360002", "Check that modular types may be used as array " &
+                           "indices.  Check that if aliased appears in " &
+                           "the component_definition of an array_type that " &
+                           "each component of the array is aliased.  Check " &
+                           "that references to aliased array objects " &
+                           "produce correct results, and that out of bound " &
+                           "references to aliased objects correctly " &
+                           "produce Constraint_Error" );
+   -- start with checks that the Filler assignments produced the expected
+   -- result.  This is a "case 0" test to check that nothing REALLY surprising
+   -- is happening
+ 
+   Check_Array_01_10( Array_Item_01_10, 0 );
+   Check_Array_11_20( Array_Item_11_20, 10 );
+ 
+   -- check that having the variable aliased makes no difference
+   Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
+   Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
+ 
+   -- now check that conversion between array types where the only
+   -- difference in the definitions is that the components are aliased works
+ 
+   Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
+   Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
+ 
+   -- check that conversion of an aliased object with aliased components
+   -- also works
+ 
+   Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
+                      60 );
+   Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
+                      70 );
+ 
+   -- check that the bounds will slide
+ 
+   Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
+   Check_Array_11_20( Array_11_20( Array_Item_01_10 ),  0 );
+ 
+   -- point at some of the components and check them
+ 
+   An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
+ 
+   Check_Single_Integer( An_Integer_Access.all, 24,
+                        "Aliased component 'Access");
+ 
+   An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
+ 
+   Check_Single_Integer( An_Integer_Access.all, 66,
+                        "Aliased Aliased component 'Access");
+ 
+   -- check some assignments
+ 
+   Array_Item_01_10 := Aliased_Array_Item_01_10;
+   Check_Array_01_10( Array_Item_01_10, 40 );
+ 
+   Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
+   Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
+ 
+   Aliased_Array_Aliased_Item_11_20(11..20)
+                                        := Aliased_Array_Aliased_Item_01_10;
+   Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
+                      60 );
+ 
+   Report.Result;
+ 
+ end C360002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36104a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36104a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36104a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,359 ----
+ -- C36104A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED OR NOT, AS APPROPRIATE,
+ -- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
+ -- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
+ -- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS,
+ -- WHERE AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
+ -- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
+ -- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
+ -- ONLY STATIC CASES ARE CHECKED HERE.
+ 
+ -- DAT 2/3/81
+ -- JRK 2/25/81
+ -- VKG 1/21/83
+ -- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
+ --                   2) DELETED "NULL INDEX RANGES, CONSTRAINT_ERROR 
+ --                      RAISED" SECTION.
+ --                   3) DELETED ANY MENTION OF CASE STATEMENT CHOICES
+ --                      AND VARIANT CHOICES IN THE ABOVE COMMENT.
+ -- EDS      7/16/98  AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ PROCEDURE C36104A IS
+ 
+      USE REPORT;
+ 
+      TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+      TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
+      SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
+      SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
+ 
+      TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
+      TYPE I_10 IS NEW INT_10;
+      SUBTYPE I_5 IS I_10 RANGE -5 .. 5;
+      TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
+ 
+ BEGIN
+      TEST ("C36104A", "CONSTRAINT_ERROR IS RAISED OR NOT IN STATIC "
+           & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
+ 
+      -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
+                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+           BEGIN
+                DECLARE
+                   -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 
+                   -- OPTIMIZATION OF SUBTYPE
+                   A1 : A := (OTHERS => I_5(IDENT_INT(1)));
+                BEGIN
+                   FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " & 
+                           I_5'IMAGE(A1(1)) );  --USE A1
+                END;
+           EXCEPTION
+              --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
+              --REPORT FAILED.
+              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                 FAILED ("WRONG EXCEPTION RAISED 1");
+      END;
+        
+      BEGIN
+           FOR I IN MID_WEEK RANGE MON .. MON LOOP
+                FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
+           END LOOP;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE P IS ACCESS I_5_ARRAY (I_5 RANGE 0 .. 6);
+                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+           BEGIN
+              DECLARE
+                 TYPE PA IS NEW P;
+                 -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 
+                 -- OPTIMIZATION OF TYPE
+                 PA1 : PA := NEW I_5_ARRAY'(0 .. I_5(IDENT_INT(6)) =>
+                                            I_5(IDENT_INT(1)));
+              BEGIN
+                 FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " & 
+                         I_5'IMAGE(PA1(1))); --USE PA1
+              END;
+           EXCEPTION
+              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 4");
+      END;
+ 
+      DECLARE
+           W : WEEK_ARRAY (MID_WEEK);
+      BEGIN
+           W := (MID_WEEK RANGE MON .. WED => WED);
+           -- CONSTRAINT_ERROR RAISED.
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " & 
+                   MID_WEEK'IMAGE(W(WED))); --USE W
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 7");
+      END;
+ 
+      DECLARE
+           W : WEEK_ARRAY (WORK_WEEK);
+      BEGIN
+           W := (W'RANGE => WED); -- OK.
+           W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
+                   MID_WEEK'IMAGE(W(WED))); --USE W
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 8");
+      END;
+ 
+      BEGIN
+           DECLARE
+                W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
+                -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
+           BEGIN
+                W := (W'RANGE => WED); -- OK.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " & 
+                        MID_WEEK'IMAGE(W(WED))); --USE W
+           EXCEPTION
+                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 9");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 9");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. TUE);
+                -- RAISES CONSTRAINT_ERROR.
+           BEGIN
+              DECLARE
+                 W1 : W := (OTHERS => WED);
+              BEGIN
+                 FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " & 
+                         MID_WEEK'IMAGE(W1(WED))); --USE W1
+              END;
+           EXCEPTION
+              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 10");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. WED);
+                -- RAISES CONSTRAINT_ERROR.
+           BEGIN
+                DECLARE
+                     W1 : W := (OTHERS => (WED));
+                BEGIN
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
+                             MID_WEEK'IMAGE(W1(WED))); --USE W1
+                END;
+           EXCEPTION
+                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 11");
+      END;
+ 
+      -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (I_5 RANGE -5 .. -6) OF I_5;
+                A1 : A;
+           BEGIN
+                IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
+                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
+      END;
+ 
+      BEGIN
+           FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+           FOR I IN MID_WEEK RANGE FRI .. WED LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+           FOR I IN MID_WEEK RANGE MON .. SUN LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+           FOR I IN I_5 RANGE 10 .. -10 LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+           FOR I IN I_5 RANGE 10 .. 9 LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+           FOR I IN I_5 RANGE -10 .. -11 LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+           FOR I IN I_5 RANGE -10 .. -20 LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+           FOR I IN I_5 RANGE 6 .. 5 LOOP
+                FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+           END LOOP;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE P IS ACCESS I_5_ARRAY (-5 .. -6);
+                PA1 : P := NEW I_5_ARRAY (-5 .. -6);
+           BEGIN
+                IF PA1'LENGTH /= IDENT_INT(0) THEN
+                     FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED 5");
+      END;
+ 
+      DECLARE
+           TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
+           W : NARR(SNARR) := (1,2);
+      BEGIN
+           IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
+                FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
+      END;
+ 
+      DECLARE
+           W : WEEK_ARRAY (MID_WEEK);
+      BEGIN
+           W := (W'RANGE => WED); -- OK.
+           W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
+      END;
+ 
+      BEGIN
+           DECLARE
+                W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
+           BEGIN
+                IF (W'FIRST /= MON) THEN
+                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+                W1 : W;
+           BEGIN
+                IF (W1'FIRST /= TUE) THEN
+                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+                W1 : W;
+           BEGIN
+                IF (W1'FIRST /= TUE) THEN
+                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
+      END;
+ 
+      -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
+ 
+      BEGIN
+           IF SUN IN  SAT .. SUN
+           OR SAT IN  FRI .. WED
+           OR WED IN  THU .. TUE
+           OR THU IN  MON .. SUN
+           OR FRI IN  SAT .. FRI
+           OR WED IN  FRI .. MON
+           THEN
+                FAILED ("INCORRECT 'IN' EVALUATION 1");
+           END IF;
+ 
+           IF INTEGER'(0) IN  10 .. -10
+           OR INTEGER'(0) IN  10 .. 9
+           OR INTEGER'(0) IN  -10 .. -11
+           OR INTEGER'(0) IN  -10 .. -20 
+           OR INTEGER'(0) IN  6 .. 5
+           OR INTEGER'(0) IN  5 .. 3
+           OR INTEGER'(0) IN  7 .. 3
+           THEN
+                FAILED ("INCORRECT 'IN' EVALUATION 2");
+           END IF;
+ 
+           IF WED NOT IN  THU .. TUE
+           AND INTEGER'(0) NOT IN  4 .. -4
+           THEN NULL;
+           ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
+      END;
+ 
+ 
+      RESULT;
+ END C36104A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36104b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36104b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36104b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,421 ----
+ -- C36104B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED OR NOT, AS APPROPRIATE,
+ -- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
+ -- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
+ -- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS, WHERE
+ -- AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
+ -- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
+ -- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
+ -- ONLY DYNAMIC CASES ARE CHECKED HERE.
+ 
+ -- DAT 2/3/81
+ -- JRK 2/25/81
+ -- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
+ --                   2) DELETED "NULL INDEX RANGE, CONSTRAINT_ERROR
+ --                      RAISED" SECTION.
+ --                   3) MADE USE OF DYNAMIC-RESULT FUNCTIONS.
+ --                   4) DELETED ALL REFERENCES TO CASE STATEMENT CHOICES
+ --                      AND VARIANT PART CHOICES IN THE ABOVE COMMENT.
+ -- EDS      7/16/98  AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ PROCEDURE C36104B IS
+ 
+      USE REPORT;
+ 
+      TYPE WEEK IS (SSUN, SMON, STUE, SWED, STHU, SFRI, SSAT);
+      SUN : WEEK := WEEK'VAL(IDENT_INT(0));
+      MON : WEEK := WEEK'VAL(IDENT_INT(1));
+      TUE : WEEK := WEEK'VAL(IDENT_INT(2));
+      WED : WEEK := WEEK'VAL(IDENT_INT(3));
+      THU : WEEK := WEEK'VAL(IDENT_INT(4));
+      FRI : WEEK := WEEK'VAL(IDENT_INT(5));
+      SAT : WEEK := WEEK'VAL(IDENT_INT(6));
+      TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
+      SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
+      SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
+ 
+      TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
+      TYPE I_10 IS NEW INT_10;
+      SUBTYPE I_5 IS I_10 RANGE I_10(IDENT_INT(-5)) ..
+                                I_10(IDENT_INT(5));
+      TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
+ 
+      FUNCTION F(DAY : WEEK) RETURN WEEK IS
+         BEGIN
+           RETURN DAY;
+         END;
+ 
+ BEGIN
+      TEST ("C36104B", "CONSTRAINT_ERROR IS RAISED OR NOT IN DYNAMIC "
+           & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
+ 
+      -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
+                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+           BEGIN
+                DECLARE
+                   -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 
+                   -- OPTIMIZATION OF SUBTYPE
+                   A1 : A := (A'RANGE => I_5(IDENT_INT(1)));
+                BEGIN
+                   FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " & 
+                           I_5'IMAGE(A1(1)) );  --USE A1
+                END;
+           EXCEPTION
+              --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
+              --REPORT FAILED.
+              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 1");
+      END;
+ 
+      BEGIN
+           FOR I IN MID_WEEK RANGE MON .. MON LOOP
+ 
+                IF EQUAL(2,2)  THEN
+                     SAT := SSAT;
+                END IF;
+ 
+           END LOOP;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE P IS ACCESS I_5_ARRAY (0 .. 6);
+                -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+           BEGIN
+                DECLARE
+                   TYPE PA IS NEW P;
+                   -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 
+                   -- OPTIMIZATION OF TYPE
+                   PA1 : PA :=NEW I_5_ARRAY'(0.. I_5(IDENT_INT(6)) => 
+                                             I_5(IDENT_INT(1)));
+                BEGIN
+                   FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " & 
+                           I_5'IMAGE(PA1(1))); --USE PA1
+                END;
+           EXCEPTION
+              WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 4");
+      END;
+ 
+      DECLARE
+           W : WEEK_ARRAY (MID_WEEK);
+      BEGIN
+           W := (MID_WEEK RANGE MON .. WED => WED);
+           -- CONSTRAINT_ERROR RAISED.
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " & 
+                        MID_WEEK'IMAGE(W(WED))); --USE W
+           EXCEPTION
+                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 7");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 7");
+      END;
+ 
+      DECLARE
+           W : WEEK_ARRAY (WORK_WEEK);
+      BEGIN
+           W := (W'RANGE => WED); -- OK.
+           W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
+                        MID_WEEK'IMAGE(W(WED))); --USE W
+           EXCEPTION
+                WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 8");
+      END;
+ 
+      BEGIN
+           DECLARE
+                W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
+                -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
+           BEGIN
+                W(WED) := THU;        -- OK.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " &
+                        WEEK'IMAGE(W(WED)));   -- USE W
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 9");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. WED);
+                -- RAISES CONSTRAINT_ERROR.
+           BEGIN
+                DECLARE
+                     X : W;              -- OK.
+                BEGIN
+                     X(TUE) := THU;   -- OK.
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " &
+                             WEEK'IMAGE(X(TUE)));   -- USE X
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. THU);
+                -- RAISES CONSTRAINT_ERROR.
+           BEGIN
+                DECLARE
+                     T : W;               -- OK.
+                BEGIN
+                     T(TUE) := THU;    -- OK.
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED 11 " &
+                             WEEK'IMAGE(T(TUE)));
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 11");
+      END;
+ 
+      -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (I_5 RANGE I_5(IDENT_INT(-5)) .. -6) OF I_5;
+                A1 : A;
+           BEGIN
+                IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
+                     FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
+      END;
+ 
+      BEGIN
+           FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
+                
+                IF EQUAL(2,2)  THEN
+                     TUE := STUE;
+                END IF;
+ 
+           END LOOP;
+           FOR I IN MID_WEEK RANGE FRI .. WED LOOP
+                
+                IF EQUAL(2,2)  THEN
+                     MON := SMON;
+                END IF;
+ 
+           END LOOP;
+           FOR I IN MID_WEEK RANGE MON .. SUN LOOP
+                
+                IF EQUAL(3,3)  THEN
+                     WED := SWED;
+                END IF;
+ 
+           END LOOP;
+           FOR I IN I_5 RANGE 10 .. -10 LOOP
+ 
+                IF EQUAL(2,2)  THEN
+                     TUE := STUE;
+                END IF;
+ 
+           END LOOP;
+           FOR I IN I_5 RANGE 10 .. 9 LOOP
+ 
+                IF EQUAL(2,2)  THEN
+                     THU := STHU;
+                END IF;
+ 
+           END LOOP;
+           FOR I IN I_5 RANGE -10 .. -11 LOOP
+ 
+                IF EQUAL(2,2)  THEN
+                     SAT := SSAT;
+                END IF;
+ 
+           END LOOP;
+           FOR I IN I_5 RANGE -10 .. -20 LOOP
+ 
+                IF EQUAL(2,2)  THEN
+                     SUN := SSUN;
+                END IF;
+ 
+           END LOOP;
+           FOR I IN I_5 RANGE 6 .. 5 LOOP
+ 
+                IF EQUAL(2,2)  THEN
+                     MON := SMON;
+                END IF;
+ 
+           END LOOP;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE P IS ACCESS I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
+                PA1 : P := NEW I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
+           BEGIN
+                IF PA1'LENGTH /= IDENT_INT(0) THEN
+                     FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED 5");
+      END;
+ 
+      DECLARE
+           TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
+           W : NARR(SNARR) := (1,2);
+      BEGIN
+           IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
+                FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
+      END;
+ 
+      DECLARE
+           W : WEEK_ARRAY (MID_WEEK);
+      BEGIN
+           W := (W'RANGE => WED); -- OK.
+           W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
+      END;
+ 
+      BEGIN
+           DECLARE
+                W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
+           BEGIN
+ 
+                IF EQUAL(W'LENGTH,0)  THEN
+                     TUE := STUE;
+                END IF;
+ 
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+           BEGIN
+ 
+                IF EQUAL(W'LENGTH,0)  THEN
+                     MON := SMON;
+                END IF;
+ 
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+           BEGIN
+ 
+                IF EQUAL(W'LENGTH,0)  THEN
+                     WED := SWED;
+                END IF;
+ 
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
+      END;
+ 
+      -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
+ 
+      BEGIN
+           IF F(SUN) IN  SAT .. SUN
+           OR SAT IN  FRI .. WED
+           OR F(WED) IN  THU .. TUE
+           OR THU IN  MON .. SUN
+           OR F(FRI) IN  SAT .. FRI
+           OR WED IN  FRI .. MON
+           THEN
+                FAILED ("INCORRECT 'IN' EVALUATION 1");
+           END IF;
+ 
+           IF IDENT_INT(0) IN  10 .. IDENT_INT(-10)
+           OR 0 IN  IDENT_INT(10) .. 9
+           OR IDENT_INT(0) IN  IDENT_INT(-10) .. -11
+           OR 0 IN  -10 .. IDENT_INT(-20) 
+           OR IDENT_INT(0) IN  6 .. IDENT_INT(5)
+           OR 0 IN  5 .. IDENT_INT(3)
+           OR IDENT_INT(0) IN  7 .. IDENT_INT(3)
+           THEN
+                FAILED ("INCORRECT 'IN' EVALUATION 2");
+           END IF;
+ 
+           IF F(WED) NOT IN  THU .. TUE
+           AND IDENT_INT(0) NOT IN  IDENT_INT(4) .. -4
+           THEN NULL;
+           ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
+      END;
+ 
+      RESULT;
+ END C36104B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36172a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36172a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36172a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36172a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,250 ----
+ -- C36172A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED APPROPRIATELY
+ -- ON DISCRETE_RANGES USED AS INDEX_CONSTRAINTS.
+ 
+ -- DAT 2/9/81
+ -- SPS 4/7/82
+ -- JBG 6/5/85
+ 
+ WITH REPORT;
+ PROCEDURE C36172A IS
+ 
+      USE REPORT;
+ 
+      SUBTYPE INT_10 IS INTEGER RANGE 1 .. 10;
+      TYPE A IS ARRAY (INT_10 RANGE <> ) OF INTEGER;
+ 
+      SUBTYPE INT_11 IS INTEGER RANGE 0 .. 11;
+      SUBTYPE NULL_6_4 IS INTEGER RANGE 6 .. 4;
+      SUBTYPE NULL_11_10 IS INTEGER RANGE 11 .. 10;
+      SUBTYPE INT_9_11 IS INTEGER RANGE 9 .. 11;
+ 
+      TYPE A_9_11 IS ARRAY (9..11) OF BOOLEAN;
+      TYPE A_11_10 IS ARRAY (11 .. 10) OF INTEGER;
+      SUBTYPE A_1_10 IS A(INT_10);
+ 
+ BEGIN
+      TEST ("C36172A", "CONSTRAINT_ERROR IS RAISED APPROPRIATELY" &
+            " FOR INDEX_RANGES");
+ 
+      BEGIN
+           DECLARE
+                V : A (9 .. 11);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     FAILED ("OUT-OF-BOUNDS INDEX_RANGE 1");
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (11 .. 10);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 2");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 2");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (6 .. 4);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 3");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (INT_9_11);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     FAILED ("OUT-OF-BOUNDS INDEX RANGE 4");
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION 4");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (NULL_11_10);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 5");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 5");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (NULL_6_4);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 6");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 6");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (INT_9_11 RANGE 10 .. 11);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     FAILED ("BAD NON-NULL INDEX RANGE 7");
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION 7");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (NULL_11_10 RANGE 11 .. 10);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 8");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 8");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (NULL_6_4 RANGE 6 .. 4);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 9");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 9");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (A_9_11'RANGE);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     FAILED ("BAD INDEX RANGE 10");
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (A_11_10'RANGE);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 11");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 11");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : A (6 .. 4);
+           BEGIN
+                IF EQUAL (V'FIRST, V'FIRST) THEN
+                     NULL;
+                ELSE
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+                "RAISED INAPPROPRIATELY 12");
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+                "SHOULD BE 12");
+      END;
+ 
+      RESULT;
+ END C36172A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36172b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36172b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36172b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36172b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,161 ----
+ -- C36172B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A MULTIDIMENSIONAL INDEX
+ -- CONSTRAINT IF ONE OF THE RANGES IS A NULL RANGE AND THE OTHER IS A
+ -- NON-NULL RANGE WITH A BOUND THAT LIES OUTSIDE THE INDEX SUBTYPE.
+ 
+ -- CHECK THAT NO EXCEPTION IS RAISED IF ALL DISCRETE RANGES ARE NULL.
+ 
+ -- JBG 6/5/85
+ -- EDS 7/16/98     AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C36172B IS
+      SUBTYPE INT_10 IS INTEGER RANGE 1..10;
+      TYPE ARR2 IS ARRAY (INT_10 RANGE <>, INT_10 RANGE <>) OF INTEGER;
+ BEGIN
+      TEST ("C36172B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                       "NON-NULL DIMENSION OF A NULL MULTIDIMENSIONAL " &
+                       "INDEX CONSTRAINT IF A BOUND LIES OUTSIDE THE " &
+                       "INDEX SUBTYPE");
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (6..4, 9..11);
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                        "THE INDEX SUBTYPE (13) " & INTEGER'IMAGE(V'FIRST));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 13");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (0..3, 8..7);
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                        "THE INDEX SUBTYPE (14) " & INTEGER'IMAGE(V'FIRST));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 14");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (6..4, IDENT_INT(0)..2);
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                        "THE INDEX SUBTYPE (15) " & INTEGER'IMAGE(V'FIRST));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 15");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (9..IDENT_INT(11), 6..4);
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                        "THE INDEX SUBTYPE (16) " & INTEGER'IMAGE(V'FIRST));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 16");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (6..IDENT_INT(4), 9..IDENT_INT(11));
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                        "THE INDEX SUBTYPE (17) " & INTEGER'IMAGE(V'FIRST));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 17");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (IDENT_INT(-1)..2, IDENT_INT(6)..4);
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                        "THE INDEX SUBTYPE (18) " & INTEGER'IMAGE(V'FIRST));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 18");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (6..-1, 11..9);
+           BEGIN
+                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 19");
+      END;
+ 
+      BEGIN
+           DECLARE
+                V : ARR2 (IDENT_INT(11)..9, 6..IDENT_INT(0));
+           BEGIN
+                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 20");
+      END;
+ 
+      RESULT;
+ END C36172B; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36172c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36172c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36172c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36172c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,58 ----
+ -- C36172C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NO EXCEPTION IS RAISED FOR A NULL ARRAY WHOSE DIFFERENCE
+ -- IN BOUNDS LIES OUTSIDE THE INDEX BASE TYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- JBG 6/5/85
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C36172C IS
+ BEGIN
+      TEST ("C36172C", "CHECK THAT NO EXCEPTION IS RAISED FOR A NULL " &
+                       "ARRAY WHOSE DIFFERENCE IN BOUNDS LIES OUTSIDE " &
+                       "THE INDEX BASE TYPE");
+ 
+      BEGIN
+           DECLARE
+                V : STRING (INTEGER'LAST .. -2);
+           BEGIN
+                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
+                     FAILED ("IMPOSSIBLE");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C36172C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36174a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36174a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36174a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36174a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- C36174A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INDEX_CONSTRAINTS MAY BE OMITTED FOR CONSTANTS.
+ 
+ -- DAT 2/9/81
+ -- JBG 12/8/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C36174A IS
+ 
+      USE REPORT;
+ 
+      S0 : CONSTANT STRING := "";
+      S1 : CONSTANT STRING := S0;
+      S2 : CONSTANT STRING := (1 .. 0 => 'Z');
+      S3 : CONSTANT STRING := ('A', 'B', 'C');
+      S4 : CONSTANT STRING := S3 & "ABC" & S3 & S2 & "Z";
+      S9 : CONSTANT STRING := S0 & S1 & S2 & S3(3..1);
+ 
+      TYPE A4 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>,
+           INTEGER RANGE <>, INTEGER RANGE <>) OF STRING (1 .. 0);
+      C4 : CONSTANT A4 :=
+           (-6 .. -4 =>
+                (4 .. 5 =>
+                     (-4 .. -5 =>
+                          (1000 .. 2000 =>
+                               S9))));
+      S10 : CONSTANT STRING := (10 .. 9 => 'Q');
+ 
+      TYPE I_12 IS NEW INTEGER RANGE 10 .. 12;
+      TYPE A_12 IS ARRAY (I_12 RANGE <>, I_12 RANGE <>) OF I_12;
+      A12 : CONSTANT A_12 :=
+           (11 .. 12 => (10 .. 10 => 10));
+      B12 : CONSTANT A_12 :=
+           (11 => (10 | 12 => 10, 11 => 11),
+            10 => (10 | 12 | 11 => 12));
+ 
+      N6 : CONSTANT INTEGER := IDENT_INT (6);
+      S6 : CONSTANT STRING := (N6 .. N6 + 6 => 'Z');
+      S7 : CONSTANT STRING := S6 (N6 .. N6 + IDENT_INT (-1));
+ 
+ BEGIN
+      TEST ("C36174A", "INDEX_CONSTRAINTS MAY BE OMITTED FOR CONSTANTS");
+ 
+      IF S0'FIRST /= 1 OR S0'LAST /= 0
+      OR S1'FIRST /= 1 OR S1'LAST /= 0
+      OR S2'FIRST /= 1 OR S2'LAST /= 0
+      OR S3'FIRST /= 1 OR S3'LAST /= 3
+      THEN
+           FAILED ("INVALID STRING CONSTANT BOUNDS 1");
+      END IF;
+ 
+      IF S4'FIRST /= 1 OR S4'LAST /= 10 THEN
+           FAILED ("INVALID STRING CONSTANT BOUNDS 2");
+      END IF;
+ 
+      IF S9'FIRST /= 3 OR S9'LAST /= 1 THEN
+           FAILED ("INVALID STRING CONSTANT BOUNDS 3");
+      END IF;
+ 
+      IF C4'FIRST(1) /= -6 OR C4'LAST(1) /= -4
+      OR C4'FIRST(2) /= 4 OR C4'LAST(2) /= 5
+      OR C4'FIRST(3) /= -4 OR C4'LAST(3) /= -5
+      OR C4'FIRST(4) /= 1000 OR C4'LAST(4) /= 2000
+      THEN
+           FAILED ("INVALID ARRAY CONSTANT BOUNDS");
+      END IF;
+ 
+      IF S10'FIRST /= 10 OR S10'LAST /= 9
+      THEN
+           FAILED ("INVALID STRING CONSTANT BOUNDS 10");
+      END IF;
+ 
+      IF A12'FIRST /= 11 OR A12'LAST /= 12
+      OR A12'FIRST(2) /= 10 OR A12'LAST(2) /= 10
+      THEN FAILED ("INVALID ARRAY CONSTANT BOUNDS 2");
+      END IF;
+ 
+      IF B12'FIRST /= 10 OR B12'LAST /= 11
+      OR B12'FIRST(2) /= 10 OR B12'LAST(2) /= 12
+      THEN
+           FAILED ("INVALID ARRAY CONSTANT BOUNDS 3");
+      END IF;
+ 
+      IF S6'FIRST /= 6 OR S6'LAST /= 12 OR S6'LENGTH /= 7
+      THEN
+           FAILED ("INVALID STRING CONSTANT  BOUNDS 12");
+      END IF;
+ 
+      IF S7'FIRST /= 6 OR S7'LAST /= 5 THEN
+           FAILED ("INVALID STRING CONSTANT BOUNDS 13");
+      END IF;
+ 
+      RESULT;
+ END C36174A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36180a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36180a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36180a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36180a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C36180A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN INDEX CONSTRAINT CAN HAVE THE FORM A'RANGE,
+ --     WHERE A IS A PREVIOUSLY DECLARED ARRAY OBJECT OR CONSTRAINED
+ --     ARRAY SUBTYPE.
+ 
+ -- HISTORY:
+ --     BCB 01/21/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C36180A IS
+ 
+      TYPE J IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+      TYPE K IS ARRAY (1..10) OF INTEGER;
+ 
+      SUBTYPE A IS J (0 .. 50);
+ 
+      SUBTYPE W IS J (A'RANGE);
+ 
+      SUBTYPE X IS J (K'RANGE);
+ 
+      TYPE Y IS ACCESS J;
+ 
+      TYPE Z IS ACCESS J;
+ 
+      TYPE F IS NEW J (A'RANGE);
+ 
+      TYPE G IS NEW J (K'RANGE);
+ 
+      B : ARRAY (A'RANGE) OF INTEGER;
+ 
+      C : ARRAY (K'RANGE) OF INTEGER;
+ 
+      D : ARRAY (1 .. 10) OF INTEGER;
+ 
+      E : ARRAY (D'RANGE) OF INTEGER;
+ 
+      H : J (A'RANGE);
+ 
+      I : J (K'RANGE);
+ 
+      L : J (D'RANGE);
+ 
+      V1 : W;
+ 
+      V2 : X;
+ 
+      V3 : Y := NEW J (A'RANGE);
+ 
+      V4 : Z := NEW J (K'RANGE);
+ 
+      V5 : F;
+ 
+      V6 : G;
+ 
+ BEGIN
+      TEST ("C36180A", "CHECK THAT AN INDEX CONSTRAINT CAN HAVE THE " &
+                       "FORM A'RANGE, WHERE A IS A PREVIOUSLY " &
+                       "DECLARED ARRAY OBJECT OR CONSTRAINED ARRAY " &
+                       "SUBTYPE");
+ 
+      IF B'FIRST /= IDENT_INT (0) OR B'LAST /= IDENT_INT (50)
+           THEN FAILED ("IMPROPER VALUE FOR B'FIRST OR B'LAST");
+      END IF;
+ 
+      IF C'FIRST /= IDENT_INT (1) OR C'LAST /= IDENT_INT (10)
+           THEN FAILED ("IMPROPER VALUE FOR C'FIRST OR C'LAST");
+      END IF;
+ 
+      IF E'FIRST /= IDENT_INT (1) OR E'LAST /= IDENT_INT (10)
+           THEN FAILED ("IMPROPER VALUE FOR E'FIRST OR E'LAST");
+      END IF;
+ 
+      IF H'FIRST /= IDENT_INT (0) OR H'LAST /= IDENT_INT (50)
+           THEN FAILED ("IMPROPER VALUE FOR H'FIRST OR H'LAST");
+      END IF;
+ 
+      IF I'FIRST /= IDENT_INT (1) OR I'LAST /= IDENT_INT (10)
+           THEN FAILED ("IMPROPER VALUE FOR I'FIRST OR I'LAST");
+      END IF;
+ 
+      IF L'FIRST /= IDENT_INT (1) OR L'LAST /= IDENT_INT (10)
+           THEN FAILED ("IMPROPER VALUE FOR L'FIRST OR L'LAST");
+      END IF;
+ 
+      IF V1'FIRST /= IDENT_INT (0) OR V1'LAST /= IDENT_INT (50)
+           THEN FAILED ("IMPROPER VALUE FOR V1'FIRST OR V1'LAST");
+      END IF;
+ 
+      IF V2'FIRST /= IDENT_INT (1) OR V2'LAST /= IDENT_INT (10)
+           THEN FAILED ("IMPROPER VALUE FOR V2'FIRST OR V2'LAST");
+      END IF;
+ 
+      IF V3.ALL'FIRST /= IDENT_INT (0) OR V3.ALL'LAST /= IDENT_INT (50)
+           THEN FAILED ("IMPROPER VALUE FOR V3'FIRST OR V3'LAST");
+      END IF;
+ 
+      IF V4.ALL'FIRST /= IDENT_INT (1) OR V4.ALL'LAST /= IDENT_INT (10)
+           THEN FAILED ("IMPROPER VALUE FOR V4'FIRST OR V4'LAST");
+      END IF;
+ 
+      IF V5'FIRST /= IDENT_INT (0) OR V5'LAST /= IDENT_INT (50)
+           THEN FAILED ("IMPROPER VALUE FOR V5'FIRST OR V5'LAST");
+      END IF;
+ 
+      IF V6'FIRST /= IDENT_INT (1) OR V6'LAST /= IDENT_INT (10)
+           THEN FAILED ("IMPROPER VALUE FOR V6'FIRST OR V6'LAST");
+      END IF;
+ 
+      RESULT;
+ END C36180A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36202c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36202c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36202c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36202c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C36202C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'LENGTH DOES NOT RAISE AN EXCEPTION
+ -- WHEN APPLIED TO A NULL ARRAY A, EVEN IF A'LAST - A'FIRST 
+ -- WOULD RAISE CONSTRAINT_ERROR.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- L.BROWN  07/29/86
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ 
+ PROCEDURE C36202C IS
+ 
+      TYPE LRG_INT IS RANGE MIN_INT .. MAX_INT;
+ 
+      BEGIN
+           TEST("C36202C", "NO EXCEPTION IS RAISED FOR 'LENGTH "&
+                           "WHEN APPLIED TO A NULL ARRAY");
+               
+           DECLARE
+                TYPE LRG_ARR IS ARRAY
+                               (LRG_INT RANGE MAX_INT .. MIN_INT)
+                                      OF INTEGER;
+                LRG_OBJ : LRG_ARR;
+ 
+           BEGIN
+                IF LRG_OBJ'LENGTH /= 0  THEN
+                     FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                            "FOR ONE-DIM NULL ARRAY");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR WAS RAISED " &
+                            "FOR ONE-DIM NULL ARRAY");
+                WHEN OTHERS =>
+                     FAILED("EXCEPTION RAISED FOR ONE-DIM " &
+                            "NULL ARRAY");
+           END;
+ 
+           DECLARE
+                TYPE LRG2_ARR IS ARRAY (LRG_INT RANGE 1 .. 3 ,
+                                 LRG_INT RANGE MAX_INT .. MIN_INT)
+                                 OF INTEGER;
+           BEGIN
+                IF LRG2_ARR'LENGTH(2) /= 0  THEN
+                     FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                            "FOR TWO-DIM NULL ARRAY");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR WAS RAISED " &
+                            "FOR TWO-DIM NULL ARRAY");
+                WHEN OTHERS =>
+                     FAILED("EXCEPTION RAISED FOR TWO-DIM " &
+                            "NULL ARRAY");
+           END;
+ 
+      RESULT;
+ 
+      END C36202C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36203a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36203a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36203a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,76 ----
+ -- C36203A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'LENGTH YIELDS A RESULT OF TYPE UNIVERSAL INTEGER.
+ 
+ -- L.BROWN  07/31/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C36203A IS
+ 
+      TYPE NINT IS NEW INTEGER RANGE 1 .. 5;
+ 
+      TYPE INT_ARR IS ARRAY(INTEGER RANGE 1 .. 3) OF INTEGER;
+      TYPE INT2_ARR IS ARRAY(INTEGER RANGE 1 .. 3,
+                             INTEGER RANGE 1 .. 2) OF INTEGER;
+ 
+      OBJA : INTEGER := 3;
+      OBJB : NINT := 3;
+ 
+ BEGIN
+      TEST("C36203A", "'LENGTH YIELDS A RESULT OF TYPE " &
+                      "UNIVERSAL INTEGER");
+      IF (OBJA + INT_ARR'LENGTH) /= IDENT_INT(6)  THEN
+           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                  "FOR ONE-DIM ARRAY TYPE 1");
+      END IF;
+ 
+      IF (OBJB + INT_ARR'LENGTH) /= 6  THEN
+           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                  "FOR ONE-DIM ARRAY TYPE 2");
+      END IF;
+ 
+      IF (OBJA + INT2_ARR'LENGTH(1)) /= IDENT_INT(6)  THEN
+           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                  "FOR FIRST DIMENSION OF TWO-DIM ARRAY TYPE 1");
+      END IF;
+ 
+      IF (OBJB + INT2_ARR'LENGTH(1)) /= 6  THEN
+           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                  "FOR FIRST DIMENSION OF TWO-DIM ARRAY TYPE 2");
+      END IF;
+ 
+      IF (OBJA + INT2_ARR'LENGTH(2)) /= IDENT_INT(5)  THEN
+           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                  "FOR SECOND DIMENSION OF TWO-DIM ARRAY TYPE 1");
+      END IF;
+ 
+      IF (OBJB + INT2_ARR'LENGTH(2)) /= 5  THEN
+           FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                  "FOR SECOND DIMENSION OF TWO-DIM ARRAY TYPE 2");
+      END IF;
+ 
+      RESULT;
+ 
+ END C36203A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C36204A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES.
+ -- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED.
+ 
+ -- DAT 2/12/81
+ -- SPS 11/1/82
+ -- WMC 03/16/92  CREATED TYPE RANGE CHECK FOR AE_TYPE.
+ 
+ WITH REPORT;
+ PROCEDURE C36204A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C36204A", "ARRAY ATTRIBUTES RETURN CORRECT VALUES");
+ 
+      DECLARE
+           A1 : ARRAY (BOOLEAN,
+                       INTEGER RANGE IDENT_INT(1)..IDENT_INT(10))
+                OF STRING(IDENT_INT(5)..IDENT_INT(7));
+           TYPE NI IS  RANGE -3 .. 3;
+           N : NI := NI(IDENT_INT(2));
+           SUBTYPE SNI IS NI RANGE -N .. N;
+           TYPE AA IS ARRAY (NI, SNI, BOOLEAN)
+                OF NI;
+           A1_1_1 : BOOLEAN := A1'FIRST;
+           A1_1_2 : BOOLEAN := A1'LAST(1);
+           A1_2_1 : INTEGER RANGE A1'RANGE(2) := A1'FIRST(2);  -- 1
+           A1_2_2 : INTEGER RANGE A1'RANGE(2) := A1'LAST(2);   -- 10
+           SUBTYPE AE_TYPE IS INTEGER RANGE A1(TRUE,5)'RANGE;    -- RANGE 5..7
+           A2 : AA;
+           A4 : ARRAY (A1_1_1 .. A1_1_2, A1_2_1 .. A1_2_2) OF
+                STRING (IDENT_INT(1)..IDENT_INT(3));
+ 
+           I : INTEGER;
+           B : BOOLEAN;
+      BEGIN
+           IF A4'FIRST /= IDENT_BOOL(FALSE)
+              OR A4'LAST /= IDENT_BOOL(TRUE)
+              OR A4'FIRST(2) /= INTEGER'(1)
+              OR A4'LAST(2) /= INTEGER'(10)
+           THEN
+                FAILED ("INCORRECT 'FIRST OR 'LAST  - 1");
+           END IF;
+       
+           IF A4'LENGTH /= INTEGER'(2)
+              OR A4'LENGTH /= NI'(2)
+              OR A4'LENGTH(1) /= N
+              OR A4'LENGTH(2) /= A4'LAST(2)
+           THEN
+                FAILED ("INCORRECT 'LENGTH - 1");
+           END IF;
+ 
+           A4 := (BOOLEAN => (1 .. 10 => "XYZ"));
+           FOR L1 IN A1'RANGE(1) LOOP
+                FOR L2 IN A4'RANGE(2) LOOP
+                     A1(L1,L2) := A4(L1,L2);
+                END LOOP;
+           END LOOP;
+ 
+           IF AA'FIRST(1) /= NI'(-3)
+              OR AA'LAST(1) /= N + 1
+              OR AA'FIRST(2) /= -N
+              OR AA'LAST(2) /= N
+              OR AA'FIRST(3) /= IDENT_BOOL(FALSE)
+              OR AA'LAST(3) /= IDENT_BOOL(TRUE)
+           THEN
+                FAILED ("INCORRECT 'FIRST OR 'LAST - 2");
+           END IF;
+ 
+           IF N NOT IN AA'RANGE(2)
+              OR IDENT_BOOL(FALSE) NOT IN AA'RANGE(3)
+              OR N + 1 NOT IN AA'RANGE
+              OR N + 1 IN AA'RANGE(2)
+           THEN
+                FAILED ("INCORRECT 'RANGE - 1");
+           END IF;
+ 
+           IF AA'LENGTH /= INTEGER'(7)
+              OR AA'LENGTH(2) - 3 /= N
+              OR AA'LENGTH(3) /= 2
+           THEN
+                FAILED ("INCORRECT 'LENGTH - 2");
+           END IF;
+ 
+           IF A2'FIRST(1) /= NI'(-3)
+              OR A2'LAST(1) /= N + 1
+              OR A2'FIRST(2) /= -N
+              OR A2'LAST(2) /= N
+              OR A2'FIRST(3) /= IDENT_BOOL(FALSE)
+              OR A2'LAST(3) /= IDENT_BOOL(TRUE)
+           THEN 
+                FAILED ("INCORRECT 'FIRST OR 'LAST - 3");
+           END IF;
+ 
+           IF N NOT IN A2'RANGE(2)
+              OR IDENT_BOOL(FALSE) NOT IN A2'RANGE(3)
+              OR N + 1 NOT IN A2'RANGE
+              OR N + 1 IN A2'RANGE(2)
+           THEN
+                FAILED ("INCORRECT 'RANGE - 2");
+           END IF;
+ 
+           IF A2'LENGTH /= INTEGER'(7)
+              OR A2'LENGTH(2) - 3 /= INTEGER(N)
+              OR A2'LENGTH(3) /= 2
+           THEN
+                FAILED ("INCORRECT 'LENGTH - 3");
+           END IF;
+ 
+           IF (AE_TYPE'FIRST /= 5) OR (AE_TYPE'LAST /= 7) THEN
+              FAILED ("INCORRECT TYPE RANGE DEFINED FOR AE_TYPE");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED  ("EXCEPTION RAISED ?");
+      END;
+ 
+      RESULT;
+ END C36204A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,229 ----
+ -- C36204B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES WITH
+ --     ACCESS VALUES AND FUNCTION CALLS AS THE PREFIXES.
+ 
+ -- HISTORY:
+ --     L.BROWN   08/05/86
+ --     DWC  07/24/87  DELETED BLANK AT END OF TEST DESCRIPTION.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C36204B IS
+ 
+      BEGIN
+           TEST("C36204B", "ARRAY ATTRIBUTES RETURN CORRECT VALUES " &
+                           "FOR ACCESS VALUES AND FUNCTION CALLS AS " &
+                           "PREFIXES");
+           DECLARE
+                TYPE ARR1 IS ARRAY (INTEGER RANGE IDENT_INT(1) ..
+                                    IDENT_INT(10)) OF INTEGER ;
+                TYPE ARR2 IS ARRAY (BOOLEAN,
+                                    INTEGER RANGE IDENT_INT(1) ..
+                                    IDENT_INT(3)) OF INTEGER ;
+ 
+                TYPE PTR1 IS ACCESS ARR1;
+                TYPE PTR2 IS ACCESS ARR2;
+ 
+                PT1 : PTR1 := NEW ARR1'(ARR1'RANGE => 0);
+                PT2 : PTR2 := NEW ARR2'(ARR2'RANGE(1) =>
+                                       (ARR2'RANGE(2) => 0));
+                SUBTYPE ARR1_RANGE IS INTEGER RANGE PT1'RANGE;
+           BEGIN
+                IF PT1'FIRST /= IDENT_INT(1) THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 1");
+                END IF;
+ 
+                IF PT2'FIRST(2) /= IDENT_INT(1)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 1");
+                END IF;
+ 
+                IF ARR1_RANGE'FIRST /= IDENT_INT(1) THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 2");
+                END IF;
+ 
+                IF PT1'LAST /= IDENT_INT(10) THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 3");
+                END IF;
+ 
+                IF PT2'LAST(2) /= IDENT_INT(3)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 2");
+                END IF;
+ 
+                IF ARR1_RANGE'LAST /= IDENT_INT(10) THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 4");
+                END IF;
+ 
+                IF PT1'LENGTH /= IDENT_INT(10) THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 5");
+                END IF;
+ 
+                IF PT2'LENGTH(2) /= IDENT_INT(3)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                            "ARRAY USING ACCESS TYPES AS PREFIXES 3");
+                END IF;
+ 
+           END;
+ 
+           DECLARE
+ 
+                TYPE UNCON IS ARRAY (INTEGER RANGE <>) OF INTEGER ;
+                TYPE UNCON2 IS ARRAY (INTEGER RANGE <>,
+                                      INTEGER RANGE <>) OF INTEGER ;
+ 
+                ARY1 : STRING(IDENT_INT(5) .. IDENT_INT(8));
+                F : INTEGER := IDENT_INT(1);
+                L : INTEGER := IDENT_INT(3);
+ 
+                FUNCTION FUN( LO,HI : INTEGER ) RETURN UNCON IS
+                     ARR : UNCON(IDENT_INT(LO) .. IDENT_INT(HI));
+                     BEGIN
+                          ARR := (ARR'RANGE => 0);
+                          RETURN ARR;
+                     END FUN;
+ 
+                FUNCTION FUN2( LO,HI : INTEGER ) RETURN UNCON2 IS
+                     AR2 : UNCON2(IDENT_INT(LO) .. IDENT_INT(HI),
+                                  IDENT_INT(LO) .. IDENT_INT(HI));
+                     BEGIN
+                          AR2 := (AR2'RANGE(1) =>(AR2'RANGE(2) => 0));
+                          RETURN AR2;
+                     END FUN2;
+           BEGIN
+ 
+                ARY1 := (ARY1'RANGE => 'A');
+ 
+                IF FUN(F,L)'FIRST /= IDENT_INT(1)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 1");
+                END IF;
+ 
+                IF FUN2(F,L)'FIRST(2) /= IDENT_INT(1)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 1");
+                END IF;
+ 
+                IF "&"(ARY1,"XX")'FIRST /= IDENT_INT(5)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 2");
+                END IF;
+ 
+                IF FUN(F,L)'LAST /= IDENT_INT(3)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 3");
+                END IF;
+ 
+                IF FUN2(F,L)'LAST(2) /= IDENT_INT(3)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 2");
+                END IF;
+ 
+                IF "&"(ARY1,"YY")'LAST /= IDENT_INT(10)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 4");
+                END IF;
+ 
+                IF FUN(F,L)'LENGTH /= IDENT_INT(3) THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 5");
+                END IF;
+ 
+                IF FUN2(F,L)'LENGTH(2) /= IDENT_INT(3)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 3");
+                END IF;
+ 
+                IF "&"(ARY1,"XX")'LENGTH /= IDENT_INT(6)  THEN
+                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                            "ARRAY USING FUNCTION RESULTS AS " &
+                            "PREFIXES 6");
+                END IF;
+ 
+                DECLARE
+ 
+                     SUBTYPE SMIN IS INTEGER RANGE FUN(F,L)'RANGE;
+                     SUBTYPE SMIN2 IS INTEGER RANGE FUN2(F,L)'RANGE(2);
+                     SUBTYPE SMIN3 IS INTEGER RANGE "&"(ARY1,"YY")'RANGE;
+ 
+                BEGIN
+                     IF SMIN'FIRST /= IDENT_INT(1)  THEN
+                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                 "ONE-DIM ARRAY USING FUNCTION " &
+                                 "RESULTS AS PREFIXES 7");
+                     END IF;
+ 
+                     IF SMIN2'FIRST /= IDENT_INT(1)  THEN
+                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                 "TWO-DIM ARRAY USING FUNCTION " &
+                                 "RESULTS AS PREFIXES 4");
+                     END IF;
+ 
+                     IF SMIN3'FIRST /= IDENT_INT(5)  THEN
+                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                 "ONE-DIM ARRAY USING FUNCTION " &
+                                 "RESULTS AS PREFIXES 8");
+                     END IF;
+ 
+                     IF SMIN'LAST /= IDENT_INT(3)  THEN
+                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                 "ONE-DIM ARRAY USING FUNCTION " &
+                                 "RESULTS AS PREFIXES 9");
+                     END IF;
+ 
+                     IF SMIN2'LAST /= IDENT_INT(3)  THEN
+                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                 "TWO-DIM ARRAY USING FUNCTION " &
+                                 "RESULTS AS PREFIXES 5");
+                     END IF;
+ 
+                     IF SMIN3'LAST /= IDENT_INT(10)  THEN
+                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                 "ONE-DIM ARRAY USING FUNCTION " &
+                                 "RESULTS AS PREFIXES 10");
+                     END IF;
+ 
+                END;
+ 
+           END;
+ 
+      RESULT;
+ 
+      END C36204B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,221 ----
+ -- C36204C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE 'RANGE ATTRIBUTE CAN BE USED TO DECLARE OBJECTS
+ --     AND IN A SUBTYPE AND TYPE DECLARATION.
+ 
+ -- HISTORY:
+ --     LB  08/13/86  CREATED ORIGINAL TEST.
+ --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
+ --                   REARRANGED STATEMENTS SO TEST IS CALLED FIRST.
+ --                   ELIMINATED DEAD VARIABLE OPTIMIZATION.  CHECKED
+ --                   RANGE VALUES FOR A SMALL INTEGER.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  C36204C  IS
+ 
+ BEGIN
+      TEST("C36204C","USING 'RANGE TO DECLARE OBJECTS AND " &
+                     "IN A SUBTYPE AND TYPE DECLARATION " &
+                     "RETURNS THE CORRECT VALUES.");
+ 
+      DECLARE
+ 
+           ARR : ARRAY(IDENT_INT(4) .. IDENT_INT(10)) OF INTEGER;
+           OBJ1 : ARRAY(ARR'RANGE) OF BOOLEAN;
+ 
+           SUBTYPE SMALL_INT IS INTEGER RANGE ARR'RANGE ;
+           SML : SMALL_INT;
+ 
+           TYPE OTHER_ARR IS ARRAY(ARR'RANGE) OF CHARACTER;
+           OBJ2 : OTHER_ARR;
+ 
+           TYPE ARR_TYPE IS ARRAY(INTEGER RANGE IDENT_INT(1) ..
+                                  IDENT_INT(10)) OF INTEGER;
+           TYPE ARR_PTR IS ACCESS ARR_TYPE;
+           PTR : ARR_PTR := NEW ARR_TYPE'(ARR_TYPE'RANGE => 0);
+ 
+           FUNCTION F RETURN ARR_TYPE IS
+                AR : ARR_TYPE := (ARR_TYPE'RANGE => 0);
+                BEGIN
+                     RETURN AR;
+                END F;
+ 
+           BEGIN
+                BEGIN
+                     IF OBJ1'FIRST /= IDENT_INT(4)  THEN
+                          FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
+                                 "DECLARATION 1");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING " &
+                                 "OBJECT DECLARATION 1");
+                END;
+ 
+                BEGIN
+                     IF OBJ1'LAST /= IDENT_INT(10)  THEN
+                          FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
+                                 "DECLARATION 2");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING " &
+                                 "OBJECT DECLARATION 2");
+                END;
+ 
+                BEGIN
+                     IF SMALL_INT'FIRST /= 4 THEN
+                          FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
+                                 "INTEGER DECLARATION 1");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
+                                 " INTEGER DECLARATION 1");
+                END;
+ 
+                BEGIN
+                     IF SMALL_INT'LAST /= 10 THEN
+                          FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
+                                 "INTEGER DECLARATION 2");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
+                                 " INTEGER DECLARATION 2");
+                END;
+ 
+                BEGIN
+                     SML := IDENT_INT(3) ;
+                     IF SML = 3 THEN
+                          COMMENT("VARIABLE SML OPTIMIZED VALUE 1");
+                     END IF;
+                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                            "VALUE 1");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                 "RANGE VALUE 1");
+                END;
+ 
+                BEGIN
+                     SML := IDENT_INT(11) ;
+                     IF SML = 11 THEN
+                          COMMENT("VARIABLE SML OPTIMIZED VALUE 2");
+                     END IF;
+                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                            "VALUE 2");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                 "RANGE VALUE 2");
+                END;
+ 
+                BEGIN
+                     IF OBJ2'FIRST /= IDENT_INT(4)  THEN
+                          FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
+                                 "DECLARATION 1");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING A " &
+                                 "TYPE DECLARATION 1");
+                END;
+ 
+                BEGIN
+                     IF OBJ2'LAST /= IDENT_INT(10)  THEN
+                          FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
+                                 "DECLARATION 2");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING A " &
+                                 "TYPE DECLARATION 2");
+                END;
+ 
+                BEGIN
+                     IF PTR'FIRST /= IDENT_INT(1)  THEN
+                          FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
+                                 "TYPE DECLARATION 1");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
+                                 "ACCESS TYPE DECLARATION 1");
+                END;
+ 
+                BEGIN
+                     IF PTR'LAST /= IDENT_INT(10)  THEN
+                          FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
+                                 "TYPE DECLARATION 2");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
+                                 "ACCESS TYPE DECLARATION 2");
+                END;
+ 
+                DECLARE
+                     OBJ_F1 : INTEGER RANGE F'RANGE ;
+                BEGIN
+                     OBJ_F1 := IDENT_INT(0) ;
+                     IF OBJ_F1 = 0 THEN
+                          COMMENT("VARIABLE OBJ_F1 OPTIMIZED VALUE 1");
+                     END IF;
+                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                            "VALUE 3");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                 "RANGE VALUE 3");
+                END;
+ 
+                DECLARE
+                     OBJ_F2 : INTEGER RANGE F'RANGE ;
+                BEGIN
+                     OBJ_F2 := IDENT_INT(11) ;
+                     IF OBJ_F2 = 11 THEN
+                          COMMENT("VARIABLE OBJ_F2 OPTIMIZED VALUE 1");
+                     END IF;
+                     FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                            "VALUE 4");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                 "RANGE VALUE 4");
+                END;
+           END;
+      RESULT;
+ 
+ END C36204C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36204d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36204d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,598 ----
+ -- C36204D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES.
+ -- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED. THIS TEST CHECKS 
+ -- THE ABOVE FOR ARRAYS WITHIN GENERIC PROGRAM UNITS.
+ 
+ -- HISTROY
+ --  EDWARD V. BERARD, 9 AUGUST 1990
+ 
+ WITH REPORT ;
+ WITH SYSTEM ;
+ 
+ PROCEDURE C36204D IS
+ 
+     SHORT_START : CONSTANT := -10 ;
+     SHORT_END    : CONSTANT := 10 ;
+     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+     SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
+     
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+     SUBTYPE MID_YEAR IS MONTH_TYPE RANGE MAY .. AUG ;
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+       MONTH : MONTH_TYPE ;
+       DAY   : DAY_TYPE ;
+       YEAR  : YEAR_TYPE ;
+     END RECORD ;
+     
+     TODAY         : DATE := (MONTH => AUG,
+                              DAY   => 10,
+                              YEAR  => 1990) ;
+                             
+     FIRST_DATE     : DATE := (DAY   => 6,
+                               MONTH => JUN,
+                               YEAR  => 1967) ;
+                             
+     FUNCTION "=" (LEFT  : IN SYSTEM.ADDRESS ;
+                   RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN
+             RENAMES SYSTEM."=" ;
+ 
+     GENERIC
+     
+         TYPE FIRST_INDEX IS (<>) ;
+         FIRST_INDEX_LENGTH : IN NATURAL ;
+         FIRST_TEST_VALUE : IN FIRST_INDEX ;
+         TYPE SECOND_INDEX IS (<>) ;
+         SECOND_INDEX_LENGTH : IN NATURAL ;
+         SECOND_TEST_VALUE : IN SECOND_INDEX ;
+         TYPE THIRD_INDEX IS (<>) ;
+         THIRD_INDEX_LENGTH : IN NATURAL ;
+         THIRD_TEST_VALUE : IN THIRD_INDEX ;
+         TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
+         FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+         SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+         TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
+         THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+         FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+     
+     PACKAGE ARRAY_ATTRIBUTE_TEST IS
+     
+         TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
+             OF FIRST_COMPONENT_TYPE ;
+             
+         TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
+             OF SECOND_COMPONENT_TYPE ;
+             
+     END ARRAY_ATTRIBUTE_TEST ;
+     
+     PACKAGE BODY ARRAY_ATTRIBUTE_TEST IS
+     
+         FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                     FIRST_DEFAULT_VALUE)) ;
+         
+         SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                        THIRD_DEFAULT_VALUE))) ;
+                                     
+         THIRD_ARRAY : CONSTANT MATRIX 
+                              := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                     SECOND_DEFAULT_VALUE)) ;
+                                         
+         FOURTH_ARRAY : CONSTANT CUBE 
+                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                        FOURTH_DEFAULT_VALUE))) ;
+                                     
+         FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
+         FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
+         FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
+         FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
+         
+         SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
+         SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
+         SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
+         SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
+         SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
+         SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
+         
+         FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
+         FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
+         
+         SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
+         SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
+         SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
+         
+         MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
+         CUBE_SIZE    : NATURAL := CUBE'SIZE ;
+         
+         FAA  : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
+         SAA  : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
+         TAA  : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
+         FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
+              
+      BEGIN  -- ARRAY_ATTRIBUTE_TEST
+      
+         IF (FA1 /= FIRST_INDEX'FIRST) OR
+            (FA3 /= SECOND_INDEX'FIRST) OR
+            (SA1 /= FIRST_INDEX'FIRST) OR
+            (SA3 /= SECOND_INDEX'FIRST) OR
+            (SA5 /= THIRD_INDEX'FIRST) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST - PACKAGE") ;
+         END IF ;
+         
+         IF (FA2 /= FIRST_INDEX'LAST) OR
+            (FA4 /= SECOND_INDEX'LAST) OR
+            (SA2 /= FIRST_INDEX'LAST) OR
+            (SA4 /= SECOND_INDEX'LAST) OR
+            (SA6 /= THIRD_INDEX'LAST) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST - PACKAGE") ;
+         END IF ;
+         
+         IF (FAL1 /= FIRST_INDEX_LENGTH) OR
+            (FAL2 /= SECOND_INDEX_LENGTH) OR
+            (SAL1 /= FIRST_INDEX_LENGTH) OR
+            (SAL2 /= SECOND_INDEX_LENGTH) OR
+            (SAL3 /= THIRD_INDEX_LENGTH) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH - PACKAGE") ;
+         END IF ;
+         
+         FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
+             FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
+                 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
+                     SECOND_DEFAULT_VALUE ;
+             END LOOP ;
+         END LOOP ;
+         
+         IF FIRST_ARRAY /= THIRD_ARRAY THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "FOR 2-DIMENSIONAL ARRAY. - PACKAGE") ;
+         END IF ;
+         
+         FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
+             FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
+                 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
+                     SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
+                         := FOURTH_DEFAULT_VALUE ;
+                 END LOOP ;
+             END LOOP ;
+         END LOOP ;
+         
+         IF SECOND_ARRAY /= FOURTH_ARRAY THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "FOR 3-DIMENSIONAL ARRAY. - PACKAGE") ;
+         END IF ;
+         
+         IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
+            (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
+            (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
+            (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
+            (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "- PACKAGE") ;
+         END IF ;
+         
+         IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
+                            "- PACKAGE") ;
+         END IF ;
+         
+         IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
+            OR (SAA = TAA) OR (TAA = FRAA) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
+                            "- PACKAGE") ;
+         END IF ;
+         
+     END ARRAY_ATTRIBUTE_TEST ;
+ 
+     GENERIC
+     
+         TYPE FIRST_INDEX IS (<>) ;
+         FIRST_INDEX_LENGTH : IN NATURAL ;
+         FIRST_TEST_VALUE : IN FIRST_INDEX ;
+         TYPE SECOND_INDEX IS (<>) ;
+         SECOND_INDEX_LENGTH : IN NATURAL ;
+         SECOND_TEST_VALUE : IN SECOND_INDEX ;
+         TYPE THIRD_INDEX IS (<>) ;
+         THIRD_INDEX_LENGTH : IN NATURAL ;
+         THIRD_TEST_VALUE : IN THIRD_INDEX ;
+         TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
+         FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+         SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+         TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
+         THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+         FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+         
+     PROCEDURE PROC_ARRAY_ATT_TEST ;
+     
+     PROCEDURE PROC_ARRAY_ATT_TEST IS
+     
+         TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
+             OF FIRST_COMPONENT_TYPE ;
+             
+         TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
+             OF SECOND_COMPONENT_TYPE ;
+             
+         FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                     FIRST_DEFAULT_VALUE)) ;
+         
+         SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                        THIRD_DEFAULT_VALUE))) ;
+                                     
+         THIRD_ARRAY : CONSTANT MATRIX 
+                              := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                     SECOND_DEFAULT_VALUE)) ;
+                                         
+         FOURTH_ARRAY : CONSTANT CUBE 
+                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                        FOURTH_DEFAULT_VALUE))) ;
+                                     
+         FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
+         FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
+         FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
+         FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
+         
+         SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
+         SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
+         SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
+         SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
+         SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
+         SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
+         
+         FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
+         FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
+         
+         SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
+         SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
+         SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
+         
+         MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
+         CUBE_SIZE    : NATURAL := CUBE'SIZE ;
+         
+         FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
+         SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
+         TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
+         FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
+              
+      BEGIN  -- PROC_ARRAY_ATT_TEST
+ 
+         IF (FA1 /= FIRST_INDEX'FIRST) OR
+            (FA3 /= SECOND_INDEX'FIRST) OR
+            (SA1 /= FIRST_INDEX'FIRST) OR
+            (SA3 /= SECOND_INDEX'FIRST) OR
+            (SA5 /= THIRD_INDEX'FIRST) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
+                            "- PROCEDURE") ;
+         END IF ;
+         
+         IF (FA2 /= FIRST_INDEX'LAST) OR
+            (FA4 /= SECOND_INDEX'LAST) OR
+            (SA2 /= FIRST_INDEX'LAST) OR
+            (SA4 /= SECOND_INDEX'LAST) OR
+            (SA6 /= THIRD_INDEX'LAST) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
+                            "- PROCEDURE") ;
+         END IF ;
+         
+         IF (FAL1 /= FIRST_INDEX_LENGTH) OR
+            (FAL2 /= SECOND_INDEX_LENGTH) OR
+            (SAL1 /= FIRST_INDEX_LENGTH) OR
+            (SAL2 /= SECOND_INDEX_LENGTH) OR
+            (SAL3 /= THIRD_INDEX_LENGTH) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
+                            "- PROCEDURE") ;
+         END IF ;
+         
+         FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
+             FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
+                 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
+                     SECOND_DEFAULT_VALUE ;
+             END LOOP ;
+         END LOOP ;
+         
+         IF FIRST_ARRAY /= THIRD_ARRAY THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "FOR 2-DIMENSIONAL ARRAY. - PROCEDURE") ;
+         END IF ;
+         
+         FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
+             FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
+                 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
+                     SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
+                         := FOURTH_DEFAULT_VALUE ;
+                 END LOOP ;
+             END LOOP ;
+         END LOOP ;
+         
+         IF SECOND_ARRAY /= FOURTH_ARRAY THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "FOR 3-DIMENSIONAL ARRAY. - PROCEDURE") ;
+         END IF ;
+         
+         IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
+            (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
+            (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
+            (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
+            (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "- PROCEDURE") ;
+         END IF ;
+         
+         IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
+                            "- PROCEDURE") ;
+         END IF ;
+         
+         IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
+            OR (SAA = TAA) OR (TAA = FRAA) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
+                            "- PROCEDURE") ;
+         END IF ;
+         
+     END PROC_ARRAY_ATT_TEST ;
+ 
+     GENERIC
+     
+         TYPE FIRST_INDEX IS (<>) ;
+         FIRST_INDEX_LENGTH : IN NATURAL ;
+         FIRST_TEST_VALUE : IN FIRST_INDEX ;
+         TYPE SECOND_INDEX IS (<>) ;
+         SECOND_INDEX_LENGTH : IN NATURAL ;
+         SECOND_TEST_VALUE : IN SECOND_INDEX ;
+         TYPE THIRD_INDEX IS (<>) ;
+         THIRD_INDEX_LENGTH : IN NATURAL ;
+         THIRD_TEST_VALUE : IN THIRD_INDEX ;
+         TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
+         FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+         SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+         TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
+         THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+         FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+         
+     FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN ;
+     
+     FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN IS
+     
+         TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
+             OF FIRST_COMPONENT_TYPE ;
+             
+         TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
+             OF SECOND_COMPONENT_TYPE ;
+             
+         FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                     FIRST_DEFAULT_VALUE)) ;
+         
+         SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                        THIRD_DEFAULT_VALUE))) ;
+                                     
+         THIRD_ARRAY : CONSTANT MATRIX 
+                              := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                     SECOND_DEFAULT_VALUE)) ;
+                                         
+         FOURTH_ARRAY : CONSTANT CUBE 
+                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                        FOURTH_DEFAULT_VALUE))) ;
+                                     
+         FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
+         FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
+         FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
+         FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
+         
+         SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
+         SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
+         SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
+         SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
+         SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
+         SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
+         
+         FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
+         FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
+         
+         SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
+         SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
+         SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
+         
+         MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
+         CUBE_SIZE    : NATURAL := CUBE'SIZE ;
+         
+         FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
+         SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
+         TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
+         FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
+              
+      BEGIN  -- FUNC_ARRAY_ATT_TEST
+ 
+         IF (FA1 /= FIRST_INDEX'FIRST) OR
+            (FA3 /= SECOND_INDEX'FIRST) OR
+            (SA1 /= FIRST_INDEX'FIRST) OR
+            (SA3 /= SECOND_INDEX'FIRST) OR
+            (SA5 /= THIRD_INDEX'FIRST) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
+                            "- FUNCTION") ;
+         END IF ;
+         
+         IF (FA2 /= FIRST_INDEX'LAST) OR
+            (FA4 /= SECOND_INDEX'LAST) OR
+            (SA2 /= FIRST_INDEX'LAST) OR
+            (SA4 /= SECOND_INDEX'LAST) OR
+            (SA6 /= THIRD_INDEX'LAST) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
+                            "- FUNCTION") ;
+         END IF ;
+         
+         IF (FAL1 /= FIRST_INDEX_LENGTH) OR
+            (FAL2 /= SECOND_INDEX_LENGTH) OR
+            (SAL1 /= FIRST_INDEX_LENGTH) OR
+            (SAL2 /= SECOND_INDEX_LENGTH) OR
+            (SAL3 /= THIRD_INDEX_LENGTH) THEN
+             REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
+                            "- FUNCTION") ;
+         END IF ;
+         
+         FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
+             FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
+                 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
+                     SECOND_DEFAULT_VALUE ;
+             END LOOP ;
+         END LOOP ;
+         
+         IF FIRST_ARRAY /= THIRD_ARRAY THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "FOR 2-DIMENSIONAL ARRAY. - FUNCTION") ;
+         END IF ;
+         
+         FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
+             FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
+                 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
+                     SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
+                         := FOURTH_DEFAULT_VALUE ;
+                 END LOOP ;
+             END LOOP ;
+         END LOOP ;
+         
+         IF SECOND_ARRAY /= FOURTH_ARRAY THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "FOR 3-DIMENSIONAL ARRAY. - FUNCTION") ;
+         END IF ;
+         
+         IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
+            (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
+            (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
+            (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
+            (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                            "- FUNCTION") ;
+         END IF ;
+         
+         IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
+                            "- FUNCTION") ;
+         END IF ;
+         
+         IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
+            OR (SAA = TAA) OR (TAA = FRAA) THEN
+             REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
+                            "- FUNCTION") ;
+         END IF ;
+         
+         RETURN TRUE ;
+         
+     END FUNC_ARRAY_ATT_TEST ;
+ 
+ 
+ BEGIN -- C36204D
+ 
+     REPORT.TEST ("C36204D", "ARRAY ATTRIBUTES RETURN CORRECT " &
+                   "VALUES WITHIN GENERIC PROGRAM UNITS.") ;
+      
+     LOCAL_BLOCK:
+     
+     DECLARE
+     
+         DUMMY : BOOLEAN := FALSE ;
+     
+         PACKAGE NEW_ARRAY_ATTRIBUTE_TEST IS NEW ARRAY_ATTRIBUTE_TEST (
+             FIRST_INDEX             => SHORT_RANGE,
+             FIRST_INDEX_LENGTH      => SHORT_LENGTH,
+             FIRST_TEST_VALUE        => -7,
+             SECOND_INDEX            => MONTH_TYPE,
+             SECOND_INDEX_LENGTH     => 12,
+             SECOND_TEST_VALUE       => AUG,
+             THIRD_INDEX             => BOOLEAN,
+             THIRD_INDEX_LENGTH      => 2,
+             THIRD_TEST_VALUE        => FALSE,
+             FIRST_COMPONENT_TYPE    => MONTH_TYPE,
+             FIRST_DEFAULT_VALUE     => JAN,
+             SECOND_DEFAULT_VALUE    => DEC,
+             SECOND_COMPONENT_TYPE   => DATE,
+             THIRD_DEFAULT_VALUE     => TODAY,
+             FOURTH_DEFAULT_VALUE    => FIRST_DATE) ;
+         
+         PROCEDURE NEW_PROC_ARRAY_ATT_TEST IS NEW PROC_ARRAY_ATT_TEST (
+             FIRST_INDEX             => MONTH_TYPE,
+             FIRST_INDEX_LENGTH      => 12,
+             FIRST_TEST_VALUE        => AUG,
+             SECOND_INDEX            => SHORT_RANGE,
+             SECOND_INDEX_LENGTH     => SHORT_LENGTH,
+             SECOND_TEST_VALUE       => -7,
+             THIRD_INDEX             => BOOLEAN,
+             THIRD_INDEX_LENGTH      => 2,
+             THIRD_TEST_VALUE        => FALSE,
+             FIRST_COMPONENT_TYPE    => DATE,
+             FIRST_DEFAULT_VALUE     => TODAY,
+             SECOND_DEFAULT_VALUE    => FIRST_DATE,
+             SECOND_COMPONENT_TYPE   => MONTH_TYPE,
+             THIRD_DEFAULT_VALUE     => JAN,
+             FOURTH_DEFAULT_VALUE    => DEC) ;
+ 
+         FUNCTION NEW_FUNC_ARRAY_ATT_TEST IS NEW FUNC_ARRAY_ATT_TEST (
+             FIRST_INDEX             => DAY_TYPE,
+             FIRST_INDEX_LENGTH      => 31,
+             FIRST_TEST_VALUE        => 25,
+             SECOND_INDEX            => SHORT_RANGE,
+             SECOND_INDEX_LENGTH     => SHORT_LENGTH,
+             SECOND_TEST_VALUE       => -7,
+             THIRD_INDEX             => MID_YEAR,
+             THIRD_INDEX_LENGTH      => 4,
+             THIRD_TEST_VALUE        => JUL,
+             FIRST_COMPONENT_TYPE    => DATE,
+             FIRST_DEFAULT_VALUE     => TODAY,
+             SECOND_DEFAULT_VALUE    => FIRST_DATE,
+             SECOND_COMPONENT_TYPE   => MONTH_TYPE,
+             THIRD_DEFAULT_VALUE     => JAN,
+             FOURTH_DEFAULT_VALUE    => DEC) ;
+ 
+     BEGIN  -- LOCAL_BLOCK
+     
+         NEW_PROC_ARRAY_ATT_TEST ;
+         
+         DUMMY := NEW_FUNC_ARRAY_ATT_TEST ;
+         IF NOT DUMMY THEN
+             REPORT.FAILED ("WRONG VALUE RETURNED BY FUNCTION.") ;
+         END IF ;
+         
+     END LOCAL_BLOCK ;
+      
+     REPORT.RESULT ;
+      
+ END C36204D ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,212 ----
+ -- C36205A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
+ --   PARAMETERS
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205A IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205A", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - BASIC CHECKS");
+ 
+      IF A10'FIRST /= 1
+         OR A2_10'FIRST(1) /= 1
+         OR A2_10'FIRST(2) /= IDENT_INT(13)
+         OR A2_20'FIRST /= 11
+         OR A2_20'FIRST(2) /= 21
+      THEN
+           FAILED ("'FIRST FOR OBJECTS IS WRONG");
+      END IF;
+ 
+ 
+      IF A10'LAST(1) /= 10
+         OR A2_10'LAST /= 10
+         OR A2_10'LAST(2) /= 20
+         OR A2_20'LAST(1) /= 30
+         OR A2_20'LAST(2) /= IDENT_INT(20)
+      THEN
+           FAILED ("'LAST FOR OBJECTS IS WRONG");
+      END IF;
+        IF A10'LENGTH /= IDENT_INT(10)
+         OR A2_10'LENGTH(1) /= 10
+         OR A2_10'LENGTH(2) /= IDENT_INT(8)
+         OR A2_20'LENGTH /= 20
+         OR A2_20'LENGTH(2) /= IDENT_INT(0)
+      THEN
+           FAILED ("'LENGTH FOR OBJECTS IS WRONG");
+      END IF;
+ 
+      IF 0 IN A10'RANGE
+         OR IDENT_INT(11) IN A10'RANGE(1)
+         OR IDENT_INT(0) IN A2_10'RANGE(1)
+         OR 11 IN A2_10'RANGE
+         OR 12 IN A2_10'RANGE(2)
+         OR IDENT_INT(21) IN A2_10'RANGE(2)
+         OR 10 IN A2_20'RANGE
+         OR IDENT_INT(31) IN A2_20'RANGE(1)
+         OR IDENT_INT(20) IN A2_20'RANGE(2)
+         OR 0 IN A2_20'RANGE(2)
+      THEN
+           FAILED ("'RANGE FOR OBJECTS IS WRONG");
+      END IF;
+ 
+      P1 (A10, 1, 10, "P1 1");
+      P1 (A20, 18, 20, "P1 A20");
+      P2(A2_10, 1, 10, 13, 20, "P2 1");
+      P2 (A2_20, 11, 30, 21, 20, "P2 2");
+      S1 (ALF, 1, 5, "X0");
+      S1 (ARF, 5, 9, "ARF1");
+ 
+      RESULT;
+ 
+ END C36205A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,169 ----
+ -- C36205B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF NON-NULL STATIC SLICES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205B IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205B", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - NON-NULL STATIC SLICES");
+ 
+      P1 (A10(1 .. 10), 1, 10, "P1 2");
+      P1 (A10(1..9), 1, 9, "P1 3");
+      P1 (A10(2..10), 2, 10, "P1 4");
+      P1 (A10 (2..9), 2, 9, "P1 5");
+      P1 (A10 (4 .. 5), 4, 5, "P1 6");
+      P1 (A10 (5 .. 5), 5, 5, "P1 7");
+ 
+      RESULT;
+ END C36205B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C36205C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF NON-NULL DYNAMIC SLICES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205C IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205C", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - NON-NULL DYNAMIC SLICES");
+ 
+      P1 (A10 (I10..I10), 10, 10, "P1 8");
+      P1 (A10 (I10 - 9 .. I10), 1, 10, "P1 9");
+ 
+      RESULT;
+ END C36205C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,180 ----
+ -- C36205D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF NULL STATIC SLICES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205D IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205D", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - NULL STATIC SLICES");
+ 
+      P1 (A10 (1 .. 0), 1, 0, "P1 11");
+      P1 (A10 (2 .. 1), 2, 1, "P1 12");
+ 
+      P1 (A10, 1, 10, "P1 1");
+      P1 (A10(1 .. 10), 1, 10, "P1 2");
+      P1 (A10(1..9), 1, 9, "P1 3");
+      P1 (A10(2..10), 2, 10, "P1 4");
+      P1 (A10 (2..9), 2, 9, "P1 5");
+      P1 (A10 (4 .. 5), 4, 5, "P1 6");
+      P1 (A10 (5 .. 5), 5, 5, "P1 7");
+      P1 (A10 (I10..I10), 10, 10, "P1 8");
+      P1 (A10 (I10 - 9 .. I10), 1, 10, "P1 9");
+      P1 (A10 (I10 .. I10 - 1), 10, 9, "P1 10");
+      P1 (A10 (9 .. 10), 9, 10, "P1 13");
+      P1 (A10 (10 .. 9), 10, 9, "P1 14");
+      P1 (A10 (9 .. I10 - 1), 9, 9, "P1 15");
+      P1 (A10 (9 .. 8), 9, 8, "P1 16");
+ 
+      RESULT;
+ END C36205D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C36205E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF DYNAMIC NULL SLICES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205E IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205E", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - DYNAMIC NULL SLICES");
+ 
+      P1 (A10 (I10 .. I10 - 1), 10, 9, "P1 10");
+ 
+      RESULT;
+ END C36205E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C36205F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF STATIC NON-NULL AGGREGATES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205F IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205F", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - STATIC NON-NULL AGGREGATES");
+ 
+      P1 ((3 .. 5 => 2), 3, 5, "P1 16");
+      P1 ((5 .. 5 => 5), 5, 5, "P1 17");
+ 
+      RESULT;
+ END C36205F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C36205G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF DYNAMIC NON-NULL AGGREGATES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205G IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205G", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - DYNAMIC NON-NULL AGGREGATES");
+ 
+      P1 ((IDENT_INT(3) .. IDENT_INT(5) => 2), 3, 5, "P1 16");
+      P1 ((IDENT_INT(5) .. 5 => 5), 5, 5, "P1 17");
+ 
+      RESULT;
+ END C36205G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,166 ----
+ -- C36205H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF STATIC NULL AGGREGATES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205H IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205H", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - STATIC NULL AGGREGATES");
+ 
+      P1 ((5 .. 4 => 4), 5, 4, "P1 18");
+      P1 ((1 .. 0 => 0), 1, 0, "P1 19");
+      P1 ((-12 .. -13 => 3), -12, -13, "P1 21");
+ 
+      RESULT;
+ END C36205H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,167 ----
+ -- C36205I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF DYNAMIC NULL AGGREGATES
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205I IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      SUBTYPE STR IS STRING;
+      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205I", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - DYNAMIC NULL AGGREGATES");
+ 
+ 
+      P1 ((IDENT_INT(5) .. IDENT_INT(4) => 4), 5, 4, "P1 18");
+      P1 ((IDENT_INT(1) .. IDENT_INT(0) => 0), 1, 0, "P1 19");
+      P1 ((IDENT_INT(-12) .. -13 => 3), -12, -13, "P1 21");
+ 
+      RESULT;
+ END C36205I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,180 ----
+ -- C36205J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF SLICES AND AGGREGATES OF MORE COMPLEX FORMS
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205J IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      TYPE STR IS NEW STRING;
+      ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205J", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - COMPLEX MIXTURE OF SLICES/AGGREGATES");
+ 
+      FOR J IN IDENT_INT (-3) .. IDENT_INT (3) LOOP
+           FOR K IN J - 1 .. 2 LOOP
+                P1 ((J .. K => 0), J, K, "X");
+                P1 (A10 (J + 4 .. K + 4), J+4, K+4, "Y");
+           END LOOP;
+      END LOOP;
+      FOR I IN 18 .. 20 LOOP
+           FOR J IN I-1 .. 20 LOOP
+                P1 (A20 (I .. J), I, J, "A20 88");
+           END LOOP;
+      END LOOP;
+      FOR I IN 1 .. 5 LOOP
+           FOR J IN I - 1 .. 5 LOOP
+                S1( ALF (I .. J), I, J, "ALF 1");
+                S1 (ARF (I+4..J+4), I+4, J+4, "ARF 4");
+           END LOOP;
+      END LOOP;
+ 
+      RESULT;
+ END C36205J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,173 ----
+ -- C36205K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
+ -- UNCONSTRAINED FORMAL PARAMETERS.
+ 
+ -- ATTRIBUTES OF SLICE OF SLICE
+ 
+ -- DAT 2/17/81
+ -- JBG 9/11/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36205K IS
+ 
+      USE REPORT;
+ 
+      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+           INTEGER RANGE <> ) OF INTEGER;
+      A10 : I_A (1 .. 10);
+      A20 : I_A (18 .. 20);
+      I10 : INTEGER := IDENT_INT (10);
+      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
+      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+      TYPE STR IS NEW STRING;
+      ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
+      ARF : STR(5 .. 9) := ALF;
+ 
+      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= FIR
+              OR A'FIRST(1) /= FIR
+           THEN
+                FAILED ("'FIRST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST /= LAS
+              OR A'LAST(1) /= LAS
+           THEN
+                FAILED ("'LAST IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH /= LAS - FIR + 1
+              OR A'LENGTH /= A'LENGTH(1)
+           THEN
+                FAILED ("'LENGTH IS WRONG " & S);
+           END IF;
+ 
+           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+              OR FIR - 1 IN A'RANGE
+              OR LAS + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE IS WRONG " & S);
+           END IF;
+ 
+      END P1;
+ 
+      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+      BEGIN
+           IF A'FIRST /= A'FIRST(1)
+              OR A'FIRST /= F1
+           THEN
+                FAILED ("'FIRST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(1) /= L1 THEN
+                FAILED ("'LAST(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LENGTH(1) /= A'LENGTH
+              OR A'LENGTH /= L1 - F1 + 1
+           THEN
+                FAILED ("'LENGTH(1) IS WRONG " & S);
+           END IF;
+ 
+           IF F1 - 1 IN A'RANGE
+              OR (F1 NOT IN A'RANGE AND F1 <= L1)
+              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+              OR L1 + 1 IN A'RANGE(1)
+           THEN
+                FAILED ("'RANGE(1) IS WRONG " & S);
+           END IF;
+ 
+           IF A'FIRST(2) /= F2 THEN
+                FAILED ("'FIRST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF A'LAST(2) /= L2 THEN
+                FAILED ("'LAST(2) IS WRONG " & S);
+           END IF;
+ 
+           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+                FAILED ("'LENGTH(2) IS WRONG " & S);
+           END IF;
+ 
+           IF F2 - 1 IN A'RANGE(2)
+              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+              OR L2 + 1 IN A'RANGE(2)
+           THEN
+                FAILED ("'RANGE(2) IS WRONG " & S);
+           END IF;
+      END P2;
+ 
+      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+      BEGIN
+           IF S'FIRST /= F THEN
+                FAILED ("STRING 'FIRST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LAST(1) /= L THEN
+                FAILED ("STRING 'LAST IS WRONG " & MESS);
+           END IF;
+ 
+           IF S'LENGTH /= L - F + 1
+              OR S'LENGTH(1) /= S'LENGTH
+           THEN
+                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+           END IF;
+ 
+           IF (F <= L AND
+                 (F NOT IN S'RANGE
+                 OR L NOT IN S'RANGE
+                 OR F NOT IN S'RANGE(1)
+                 OR L NOT IN S'RANGE(1)))
+              OR F - 1 IN S'RANGE
+              OR L + 1 IN S'RANGE(1)
+           THEN
+                FAILED ("STRING 'RANGE IS WRONG " & MESS);
+           END IF;
+      END S1;
+ 
+ BEGIN
+      TEST ( "C36205K", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                        "ARRAYS - SLICES OF SLICES");
+ 
+      FOR I IN 18 .. 20 LOOP
+           FOR J IN I-1 .. 20 LOOP
+                P1 (A20 (A20'RANGE)(I..J), I, J, "A20 99");
+           END LOOP;
+      END LOOP;
+      FOR I IN 1 .. 5 LOOP
+           FOR J IN I - 1 .. 5 LOOP
+                S1 (ALF (1..5)(I..J),I,J,"ALF 3");
+           END LOOP;
+      END LOOP;
+ 
+      RESULT;
+ END C36205K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36205l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36205l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,288 ----
+ -- C36205L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE
+ --      FOR GENERIC PROCEDURES, CHECK THAT ATTRIBUTES GIVE THE
+ --      CORRECT VALUES FOR UNCONSTRAINED FORMAL PARAMETERS.
+ --      BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
+ --      PARAMETERS TO GENERIC PROCEDURES
+ 
+ -- HISTORY
+ --      EDWARD V. BERARD, 9 AUGUST 1990
+ --      DAS   8 OCT 1990   ADDED OUT MODE PARAMETER TO GENERIC
+ --                         PROCEDURE TEST_PROCEDURE AND FORMAL
+ --                         GENERIC PARAMETER COMPONENT_VALUE.
+ 
+ WITH REPORT ;
+ 
+ PROCEDURE C36205L IS
+ 
+      SHORT_START : CONSTANT := -100 ;
+      SHORT_END   : CONSTANT := 100 ;
+      TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+      SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
+ 
+      MEDIUM_START    : CONSTANT := 1 ;
+      MEDIUM_END      : CONSTANT := 100 ;
+      TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
+      MEDIUM_LENGTH : CONSTANT NATURAL := (MEDIUM_END - MEDIUM_START
+                                           + 1) ;
+ 
+      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                          SEP, OCT, NOV, DEC) ;
+      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+      TYPE DATE IS RECORD
+           MONTH : MONTH_TYPE ;
+           DAY   : DAY_TYPE ;
+           YEAR  : YEAR_TYPE ;
+      END RECORD ;
+ 
+      TODAY : DATE := (MONTH => AUG,
+                       DAY   => 9,
+                       YEAR  => 1990) ;
+ 
+      SUBTYPE SHORT_STRING IS STRING (1 ..5) ;
+ 
+      DEFAULT_STRING : SHORT_STRING := "ABCDE" ;
+ 
+      TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
+                                    MEDIUM_RANGE RANGE <>) OF DATE ;
+ 
+      TYPE SECOND_TEMPLATE IS ARRAY (MONTH_TYPE RANGE <>,
+                                     DAY_TYPE RANGE <>) OF SHORT_STRING ;
+ 
+      TYPE THIRD_TEMPLATE IS ARRAY (CHARACTER RANGE <>,
+                                    BOOLEAN RANGE <>) OF DAY_TYPE ;
+ 
+      FIRST_ARRAY      : FIRST_TEMPLATE (-10 .. 10, 27 .. 35)
+                             := (-10 .. 10 =>
+                                (27 .. 35 => TODAY)) ;
+      SECOND_ARRAY     : SECOND_TEMPLATE (JAN .. JUN, 1 .. 25)
+                             := (JAN .. JUN =>
+                                (1 .. 25 => DEFAULT_STRING)) ;
+      THIRD_ARRAY      : THIRD_TEMPLATE ('A' .. 'Z', FALSE .. TRUE)
+                             := ('A' .. 'Z' =>
+                                (FALSE .. TRUE => DAY_TYPE (9))) ;
+ 
+      FOURTH_ARRAY    : FIRST_TEMPLATE (0 .. 27, 75 .. 100)
+                             := (0 .. 27 =>
+                                (75 .. 100 => TODAY)) ;
+      FIFTH_ARRAY     : SECOND_TEMPLATE (JUL .. OCT, 6 .. 10)
+                             := (JUL .. OCT =>
+                                (6 .. 10 => DEFAULT_STRING)) ;
+      SIXTH_ARRAY      : THIRD_TEMPLATE ('X' .. 'Z', TRUE .. TRUE)
+                             := ('X' .. 'Z' =>
+                                (TRUE .. TRUE => DAY_TYPE (31))) ;
+ 
+      GENERIC
+ 
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           TYPE UNCONSTRAINED_ARRAY IS ARRAY (FIRST_INDEX RANGE <>,
+                     SECOND_INDEX RANGE <>) OF COMPONENT_TYPE ;
+           COMPONENT_VALUE: IN  COMPONENT_TYPE;
+ 
+      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                                FFIFS        : IN FIRST_INDEX ;
+                                FFILS        : IN FIRST_INDEX ;
+                                FSIFS        : IN SECOND_INDEX ;
+                                FSILS        : IN SECOND_INDEX ;
+                                FFLEN        : IN NATURAL ;
+                                FSLEN        : IN NATURAL ;
+                                FFIRT        : IN FIRST_INDEX ;
+                                FSIRT        : IN SECOND_INDEX ;
+                                SECOND       : OUT UNCONSTRAINED_ARRAY ;
+                                SFIFS        : IN FIRST_INDEX ;
+                                SFILS        : IN FIRST_INDEX ;
+                                SSIFS        : IN SECOND_INDEX ;
+                                SSILS        : IN SECOND_INDEX ;
+                                SFLEN        : IN NATURAL ;
+                                SSLEN        : IN NATURAL ;
+                                SFIRT        : IN FIRST_INDEX ;
+                                SSIRT        : IN SECOND_INDEX ;
+                                REMARKS      : IN STRING) ;
+ 
+      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                                FFIFS        : IN FIRST_INDEX ;
+                                FFILS        : IN FIRST_INDEX ;
+                                FSIFS        : IN SECOND_INDEX ;
+                                FSILS        : IN SECOND_INDEX ;
+                                FFLEN        : IN NATURAL ;
+                                FSLEN        : IN NATURAL ;
+                                FFIRT        : IN FIRST_INDEX ;
+                                FSIRT        : IN SECOND_INDEX ;
+                                SECOND       : OUT UNCONSTRAINED_ARRAY ;
+                                SFIFS        : IN FIRST_INDEX ;
+                                SFILS        : IN FIRST_INDEX ;
+                                SSIFS        : IN SECOND_INDEX ;
+                                SSILS        : IN SECOND_INDEX ;
+                                SFLEN        : IN NATURAL ;
+                                SSLEN        : IN NATURAL ;
+                                SFIRT        : IN FIRST_INDEX ;
+                                SSIRT        : IN SECOND_INDEX ;
+                                REMARKS      : IN STRING) IS
+ 
+      BEGIN -- TEST_PROCEDURE
+ 
+           IF (FIRST'FIRST /= FFIFS) OR
+              (FIRST'FIRST (1) /= FFIFS) OR
+              (FIRST'FIRST (2) /= FSIFS) OR
+              (SECOND'FIRST /= SFIFS) OR
+              (SECOND'FIRST (1) /= SFIFS) OR
+              (SECOND'FIRST (2) /= SSIFS) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FIRST'LAST /= FFILS) OR
+              (FIRST'LAST (1) /= FFILS) OR
+              (FIRST'LAST (2) /= FSILS) OR
+              (SECOND'LAST /= SFILS) OR
+              (SECOND'LAST (1) /= SFILS) OR
+              (SECOND'LAST (2) /= SSILS) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FIRST'LENGTH /= FFLEN) OR
+              (FIRST'LENGTH (1) /= FFLEN) OR
+              (FIRST'LENGTH (2) /= FSLEN) OR
+              (SECOND'LENGTH /= SFLEN) OR
+              (SECOND'LENGTH (1) /= SFLEN) OR
+              (SECOND'LENGTH (2) /= SSLEN) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FFIRT NOT IN FIRST'RANGE (1)) OR
+              (FFIRT NOT IN FIRST'RANGE) OR
+              (SFIRT NOT IN SECOND'RANGE (1)) OR
+              (SFIRT NOT IN SECOND'RANGE) OR
+              (FSIRT NOT IN FIRST'RANGE (2)) OR
+              (SSIRT NOT IN SECOND'RANGE (2)) THEN
+                REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE " &
+                               "ATTRIBUTE.  " & REMARKS) ;
+           END IF ;
+ 
+           -- ASSIGN VALUES TO THE ARRAY PARAMETER OF MODE OUT
+           FOR I IN SECOND'RANGE(1) LOOP
+                FOR J IN SECOND'RANGE(2) LOOP
+                     SECOND(I, J) := COMPONENT_VALUE;
+                END LOOP;
+           END LOOP;
+ 
+      END TEST_PROCEDURE ;
+ 
+      PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
+           FIRST_INDEX           => SHORT_RANGE,
+           SECOND_INDEX          => MEDIUM_RANGE,
+           COMPONENT_TYPE        => DATE,
+           UNCONSTRAINED_ARRAY   => FIRST_TEMPLATE,
+           COMPONENT_VALUE       => TODAY) ;
+ 
+      PROCEDURE SECOND_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
+           FIRST_INDEX           => MONTH_TYPE,
+           SECOND_INDEX          => DAY_TYPE,
+           COMPONENT_TYPE        => SHORT_STRING,
+           UNCONSTRAINED_ARRAY   => SECOND_TEMPLATE,
+           COMPONENT_VALUE       => DEFAULT_STRING) ;
+ 
+      PROCEDURE THIRD_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
+           FIRST_INDEX           => CHARACTER,
+           SECOND_INDEX          => BOOLEAN,
+           COMPONENT_TYPE        => DAY_TYPE,
+           UNCONSTRAINED_ARRAY   => THIRD_TEMPLATE,
+           COMPONENT_VALUE       => DAY_TYPE'FIRST) ;
+ 
+ 
+ BEGIN  -- C36205L
+ 
+       REPORT.TEST ( "C36205L","FOR GENERIC PROCEDURES, CHECK THAT " &
+                     "ATTRIBUTES GIVE THE CORRECT VALUES FOR " &
+                     "UNCONSTRAINED FORMAL PARAMETERS.  BASIC " &
+                     "CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS " &
+                     "PASSED AS PARAMETERS TO GENERIC PROCEDURES");
+ 
+      FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
+                            FFIFS        => -10,
+                            FFILS        => 10,
+                            FSIFS        => 27,
+                            FSILS        => 35,
+                            FFLEN        => 21,
+                            FSLEN        => 9,
+                            FFIRT        => 0,
+                            FSIRT        => 29,
+                            SECOND       => FOURTH_ARRAY,
+                            SFIFS        => 0,
+                            SFILS        => 27,
+                            SSIFS        => 75,
+                            SSILS        => 100,
+                            SFLEN        => 28,
+                            SSLEN        => 26,
+                            SFIRT        => 5,
+                            SSIRT        => 100,
+                            REMARKS      => "FIRST_TEST_PROCEDURE") ;
+ 
+      SECOND_TEST_PROCEDURE (FIRST        => SECOND_ARRAY,
+                             FFIFS        => JAN,
+                             FFILS        => JUN,
+                             FSIFS        => 1,
+                             FSILS        => 25,
+                             FFLEN        => 6,
+                             FSLEN        => 25,
+                             FFIRT        => MAR,
+                             FSIRT        => 17,
+                             SECOND       => FIFTH_ARRAY,
+                             SFIFS        => JUL,
+                             SFILS        => OCT,
+                             SSIFS        => 6,
+                             SSILS        => 10,
+                             SFLEN        => 4,
+                             SSLEN        => 5,
+                             SFIRT        => JUL,
+                             SSIRT        => 6,
+                             REMARKS      => "SECOND_TEST_PROCEDURE") ;
+ 
+      THIRD_TEST_PROCEDURE (FIRST        => THIRD_ARRAY,
+                            FFIFS        => 'A',
+                            FFILS        => 'Z',
+                            FSIFS        => FALSE,
+                            FSILS        => TRUE,
+                            FFLEN        => 26,
+                            FSLEN        => 2,
+                            FFIRT        => 'T',
+                            FSIRT        => TRUE,
+                            SECOND       => SIXTH_ARRAY,
+                            SFIFS        => 'X',
+                            SFILS        => 'Z',
+                            SSIFS        => TRUE,
+                            SSILS        => TRUE,
+                            SFLEN        => 3,
+                            SSLEN        => 1,
+                            SFIRT        => 'Z',
+                            SSIRT        => TRUE,
+                            REMARKS      => "THIRD_TEST_PROCEDURE") ;
+ 
+       REPORT.RESULT ;
+ 
+ END C36205L ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36301a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36301a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36301a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- C36301A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PREDEFINED POSITIVE AND STRING TYPES
+ -- ARE CORRECTLY DEFINED.
+ 
+ -- DAT 2/17/81
+ -- JBG 12/27/82
+ -- RJW 1/20/86 - CHANGED 'NATURAL' TO 'POSITIVE'.  ADDED ADDITIONAL 
+ --               CASES, INCLUDING A CHECK FOR STRINGS WITH BOUNDS
+ --               OF INTEGER'FIRST AND INTEGER'LAST.
+ -- EDS 7/16/98   AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C36301A IS
+      
+ BEGIN
+      TEST ( "C36301A", "CHECK ATTRIBUTES OF PREDEFINED POSITIVE " &
+                        "AND STRING" );
+ 
+      BEGIN
+           IF POSITIVE'FIRST /= 1 THEN
+                FAILED ( "POSITIVE'FIRST IS WRONG" );
+           END IF;
+ 
+           IF POSITIVE'LAST /= INTEGER'LAST THEN
+                FAILED ( "POSITIVE'LAST IS WRONG" );
+           END IF;
+      END;
+ 
+      DECLARE
+ 
+           C : STRING (1..2) := ( 'A', 'B' );
+ 
+      BEGIN
+           IF C'LENGTH /= 2  THEN
+                FAILED ( "LENGTH OF C IS WRONG" );
+           END IF;
+ 
+           IF C'FIRST /= 1 THEN
+                FAILED ( "C'FIRST IS WRONG" );
+           END IF;
+ 
+           IF C'LAST /= 2 THEN
+                FAILED ( "C'LAST IS WRONG" );
+           END IF;
+      END;
+ 
+      DECLARE
+ 
+           SUBTYPE LARGE IS STRING ( INTEGER'LAST - 3 .. INTEGER'LAST );
+ 
+      BEGIN
+           IF LARGE'LENGTH /= 4  THEN
+                FAILED ( "LENGTH OF LARGE IS WRONG" );
+           END IF;
+ 
+           IF LARGE'FIRST /= INTEGER'LAST - 3  THEN
+                FAILED ( "LARGE'FIRST IS WRONG" );
+           END IF;
+ 
+           IF LARGE'LAST /= INTEGER'LAST THEN
+                FAILED ( "LARGE'LAST IS WRONG" );
+           END IF;
+      END;
+ 
+      DECLARE
+ 
+           SUBTYPE LARGER IS STRING ( 1 .. INTEGER'LAST );
+ 
+      BEGIN
+           IF LARGER'LENGTH /= INTEGER'LAST THEN
+                FAILED ( "LENGTH OF LARGER IS WRONG" );
+           END IF;
+ 
+           IF LARGER'FIRST /= 1 THEN
+                FAILED ( "LARGER'FIRST IS WRONG" );
+           END IF;
+ 
+           IF LARGER'LAST /= INTEGER'LAST THEN
+                FAILED ( "LARGER'LAST IS WRONG" );
+           END IF;
+      END;
+ 
+      BEGIN
+           DECLARE
+ 
+                D : STRING ( INTEGER'FIRST .. INTEGER'FIRST + 3 );
+ 
+           BEGIN
+                IF D'FIRST /= INTEGER'FIRST THEN   -- USE D
+                     FAILED ("D'FIRST IS INCORRECT " & INTEGER'IMAGE(D'FIRST));
+                END IF;
+                FAILED ( "NO EXCEPTION RAISED" );
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED" );
+      END;
+ 
+      BEGIN
+           DECLARE
+ 
+                E : STRING ( -1 .. INTEGER'FIRST );
+           
+           BEGIN
+                IF E'LENGTH /= 0 THEN
+                     FAILED ( "LENGTH OF E IS WRONG" );
+                END IF;
+ 
+                IF E'FIRST /= -1 THEN
+                     FAILED ( "E'FIRST IS WRONG" );
+                END IF;
+ 
+                IF E'LAST /= INTEGER'FIRST THEN
+                     FAILED ( "E'LAST IS WRONG" );
+                END IF;
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED FOR NULL STRING" );
+      END;
+ 
+      RESULT;
+ END C36301A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36301b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36301b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36301b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36301b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,55 ----
+ -- C36301B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PREDEFINED STRING ATTRIBUTES ARE CORRECTLY IMPLEMENTED.
+ 
+ -- CASE B: STRING OF LENGTH INTEGER'LAST
+ 
+ -- DAT 2/17/81
+ -- JBG 12/28/82
+ 
+ WITH REPORT;
+ PROCEDURE C36301B IS
+ 
+      USE REPORT;
+ 
+      SUBTYPE STR2 IS STRING (1..INTEGER'LAST);
+ 
+ BEGIN
+      TEST("C36301B", "CHECK ATTRIBUTES OF LONGEST STRING");
+ 
+      IF STR2'FIRST /= 1 THEN
+           FAILED ("STR'FIRST NOT 1");
+      END IF;
+ 
+      IF STR2'LAST /= INTEGER'LAST THEN
+           FAILED ("STR'LAST NOT INTEGER'LAST");
+      END IF;
+ 
+      IF STR2'LENGTH /= INTEGER'LAST THEN
+           FAILED ("'LENGTH NOT INTEGER'LAST");
+      END IF;
+ 
+      RESULT;
+ END C36301B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36302a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36302a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36302a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- C36302A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A STRING VARIABLE MAY BE DECLARED WITH AN INDEX
+ -- STARTING WITH AN INTEGER GREATER THAN 1.
+ 
+ -- DAT 2/17/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C36302A IS
+ 
+      USE REPORT;
+ 
+      S5 : STRING (5 .. 10);
+      SX : STRING (INTEGER'LAST - 5 .. INTEGER'LAST);
+ 
+ BEGIN
+      TEST ("C36302A", "STRING VARIABLE INDICES NEEDN'T START AT 1");
+ 
+      IF S5'FIRST /= 5
+      OR S5'LAST /= 10
+      OR S5'LENGTH /= 6
+      OR SX'FIRST /= INTEGER'LAST - 5
+      OR SX'LAST /= INTEGER'LAST
+      OR SX'LENGTH /= 6
+      THEN
+           FAILED ("WRONG STRING ATTRIBUTES");
+      END IF;
+ 
+      RESULT;
+ END C36302A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36304a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36304a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36304a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C36304A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT BOUNDS OF CONSTANT STRING OBJECTS IF NOT GIVEN IN
+ -- THE DECLARATIONS ARE DETERMINED BY THE STRINGS' INITIAL VALUES.
+ 
+ -- DAT 2/17/81
+ -- JBG 8/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C36304A IS
+ 
+      USE REPORT;
+ 
+      I3 : INTEGER := IDENT_INT (3);
+ 
+      S3 : CONSTANT STRING := "ABC";
+      S0 : CONSTANT STRING := "";
+      S1 : CONSTANT STRING := "A";
+      S2 : CONSTANT STRING := "AB";
+      S5 : CONSTANT STRING := "ABCDE";
+      S3A : CONSTANT STRING (I3 .. I3 + 2) := S3(I3 - 2 .. I3);
+      S3C : CONSTANT STRING := S3A;
+      S3D : CONSTANT STRING := S3C & "";
+      S3E : CONSTANT STRING := S3D;
+      X3 : CONSTANT STRING := (I3 .. 5 => 'X');
+      Y3 : CONSTANT STRING := X3;
+      Z0 : CONSTANT STRING := (-3..-5 => 'A');
+ 
+      PROCEDURE C (S : STRING; 
+                   FIRST, LAST, LENGTH : INTEGER; 
+                   ID : STRING) IS
+      BEGIN
+           IF S'FIRST /= FIRST THEN
+                FAILED ("'FIRST IS " & INTEGER'IMAGE(S'FIRST) &
+                        " INSTEAD OF " & INTEGER'IMAGE(FIRST) &
+                        " FOR " & ID);
+           END IF;
+ 
+           IF S'LAST /= LAST THEN
+                FAILED ("'LAST IS " & INTEGER'IMAGE(S'LAST) &
+                        " INSTEAD OF " & INTEGER'IMAGE(LAST) &
+                        " FOR " & ID);
+           END IF;
+ 
+           IF S'LENGTH /= LENGTH THEN
+                FAILED ("'LENGTH IS " & INTEGER'IMAGE(S'LENGTH) &
+                        " INSTEAD OF " & INTEGER'IMAGE(LENGTH) &
+                        " FOR " & ID);
+           END IF;
+      END C;
+ 
+ BEGIN
+      TEST ("C36304A", "CHECK UNUSUAL CONSTANT STRING BOUNDS");
+ 
+ 
+      C(S0, 1, 0, 0, "S0");
+      C(S1, 1, 1, 1, "S1");
+      C(S2, 1, 2, 2, "S2");
+      C(S5, 1, 5, 5, "S5");
+      C(S3, 1, 3, 3, "S3");
+      C(S3C, 3, 5, 3, "S3C");
+      C(S3D, 3, 5, 3, "S3D");
+      C(S3E, 3, 5, 3, "S3E");
+      C(X3, 3, 5, 3, "X3");
+      C(Y3, 3, 5, 3, "Y3");
+      C(Z0, IDENT_INT(-3), IDENT_INT(-5), IDENT_INT(0), "Z0");
+ 
+      RESULT;
+ END C36304A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36305a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c36305a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c36305a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C36305A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A STRING VARIABLE IS CONSIDERED AN ARRAY.
+ 
+ -- DAT 2/17/81
+ -- SPS 10/25/82
+ -- EDS 07/16/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ PROCEDURE C36305A IS
+ 
+      USE REPORT;
+ 
+      S : STRING (IDENT_INT(5) .. IDENT_INT (10));
+      T : STRING (S'RANGE);
+      U : STRING (T'FIRST .. T'LAST);
+      SUBTYPE I_5 IS INTEGER RANGE U'RANGE(1);
+      I5 : I_5;
+      C : CONSTANT STRING := "ABCDEF";
+ 
+ BEGIN
+      TEST ("C36305A", "CHECK THAT STRINGS ARE REALLY ARRAYS");
+ 
+      IF S'FIRST /= 5
+      OR S'LAST /= 10
+      OR S'LENGTH /= 6
+      OR U'FIRST(1) /= 5
+      OR U'LAST(1) /= 10
+      OR U'LENGTH(1) /= 6
+      THEN
+           FAILED ("INCORRECT STRING ATTRIBUTE VALUES");
+      END IF;
+ 
+      IF 4 IN U'RANGE
+      OR 3 IN U'RANGE(1)
+      OR 0 IN U'RANGE
+      OR 1 IN U'RANGE
+      OR 5 NOT IN U'RANGE
+      OR 7 NOT IN U'RANGE
+      OR 10 NOT IN U'RANGE
+      OR NOT (11 NOT IN U'RANGE)
+      THEN
+           FAILED ("INCORRECT STRING RANGE ATTRIBUTE");
+      END IF;
+ 
+      BEGIN
+           BEGIN
+                BEGIN
+                     I5 := 4;
+                     FAILED ("BAD I5 SUBRANGE 1 " & INTEGER'IMAGE(I5)); --use I5
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR => NULL;
+                END;
+                I5 := INTEGER'(11);
+                FAILED ("BAD I5 SUBRANGE 2 " & INTEGER'IMAGE(I5)); --use I5
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
+           END;
+           I5 := INTEGER'(5);
+           I5 := I5 + I5;
+           I5 := NATURAL'(8);
+      EXCEPTION
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+      END;
+ 
+      FOR I IN S'RANGE LOOP
+           S(I) :=  C(11 - I);
+      END LOOP;
+      T := S;
+      FOR I IN REVERSE U'RANGE LOOP
+           U(I) := T(15 - I);
+      END LOOP;
+ 
+      FOR I IN 1 .. C'LENGTH LOOP
+           IF C(1 .. I) /= U(5 .. I + 4)
+           OR U(I + 4 .. U'LAST) /= C(I .. C'LAST)
+           OR C(I) /= U (I + 4)
+           OR C(I .. I)(I .. I)(I) /= U(U'RANGE)(I + 4) THEN
+                FAILED ("INCORRECT CHARACTER MISMATCH IN STRING");
+                EXIT;
+           END IF;
+      END LOOP;
+ 
+      IF U /= C
+      OR U /= "ABCDEF"
+      OR U(U'RANGE) /= C(C'RANGE)
+      OR U(5 .. 10) /= C(1 .. 6)
+      OR U(5 .. 6) /= C(1 .. 2)
+      THEN
+           FAILED ("STRINGS AS ARRAYS BEHAVE INCORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C36305A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C37002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INDEX CONSTRAINTS WITH NON-STATIC EXPRESSIONS CAN BE
+ -- USED TO CONSTRAIN RECORD COMPONENTS HAVING AN ARRAY TYPE.
+ 
+ -- RJW 2/28/86 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C37002A IS
+ 
+ BEGIN
+      TEST ( "C37002A", "CHECK THAT INDEX CONSTRAINTS WITH " &
+                        "NON-STATIC EXPRESSIONS CAN BE USED TO " &
+                        "CONSTRAIN RECORD COMPONENTS HAVING AN " &
+                        "ARRAY TYPE" );
+ 
+      DECLARE
+           X : INTEGER := IDENT_INT(5);
+           SUBTYPE S IS INTEGER RANGE 1 .. X;
+           TYPE AR1 IS ARRAY (S) OF INTEGER;
+ 
+           SUBTYPE T IS INTEGER RANGE X .. 10;
+           TYPE AR2 IS ARRAY (T) OF INTEGER;
+           TYPE U IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           SUBTYPE V IS INTEGER RANGE 1 .. 10;     
+ 
+           TYPE R IS 
+                RECORD
+                     A : STRING (1 .. X);              
+                     B : STRING (X .. 10);             
+                     C : AR1;                          
+                     D : AR2;                          
+                     E : STRING (S);
+                     F : U(T);
+                     G : U(V RANGE 1 ..X);
+                     H : STRING (POSITIVE RANGE X .. 10);
+                     I : U(AR1'RANGE);
+                     J : STRING (AR2'RANGE);
+                END RECORD;
+           RR : R;
+  
+      BEGIN
+           IF RR.A'LAST /= 5 OR RR.B'FIRST /= 5 OR
+              RR.C'LAST /= 5 OR RR.D'FIRST /= 5 OR
+              RR.E'LAST /= 5 OR RR.F'FIRST /= 5 OR
+              RR.G'LAST /= 5 OR RR.H'FIRST /= 5 OR
+              RR.I'LAST /= 5 OR RR.J'FIRST /= 5 THEN 
+           
+                   FAILED("WRONG VALUE FOR NON-STATIC BOUND");
+ 
+            END IF;
+           
+      END;
+ 
+      RESULT;
+ END C37002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,198 ----
+ -- C37003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT MULTIPLE COMPONENT DECLARATIONS ARE TREATED AS A SERIES
+ -- OF SINGLE COMNENT DECLARATIONS, I.E., THE COMPONENTS ALL HAVE THE
+ -- SAME TYPE AND ANY EXPRESSION USED IN CONSTRAINTS OR INITIALIZATIONS
+ -- IS EVALUATED ONCE FOR EACH COMPONENT.
+ 
+ -- DAT 3/30/81
+ -- SPS 10/26/82
+ -- JWC 10/23/85  RENAMED FROM C37013A-AB.ADA.
+ --               ADDED TEST TO ENSURE THAT ANY EXPRESSION USED
+ --               IN A CONSTRAINT IS EVALUATED ONCE FOR EACH
+ --               COMPONENT.
+ -- JRK 11/15/85  ADDED INITIALIZATION EVALUATION CHECKS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C37003A IS
+ 
+      X : INTEGER := 0;
+ 
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           X := X + 1;
+           RETURN X;
+      END F;
+ 
+      PROCEDURE RESET IS
+      BEGIN
+           X := 0;
+      END RESET;
+ 
+ BEGIN
+      TEST ("C37003A", "CHECK THAT MULTIPLE COMPONENT DECLARATIONS " &
+                       "ARE TREATED AS A SERIES OF SINGLE COMPONENT " &
+                       "DECLARATIONS");
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+           TYPE REC1 IS RECORD
+                A1, A2 : ARR (1 .. F) := (OTHERS => F);
+           END RECORD;
+ 
+           R1 : REC1 := (OTHERS => (OTHERS => 1));
+           Y : INTEGER := X;
+           R1A : REC1;
+ 
+      BEGIN
+ 
+           IF R1.A1 = R1.A2 THEN        -- TEST TO SEE IF THE COMPONENTS
+                NULL;                   -- ARE OF THE SAME TYPE.
+           END IF;
+ 
+           IF Y /= 2 THEN
+                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                        "FOR ARRAYS");
+           END IF;
+ 
+           IF X /= 5 THEN
+                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
+                        "EACH ARRAY COMPONENT");
+           END IF;
+ 
+           RESET;
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE REC2 IS RECORD
+                I1, I2 : INTEGER RANGE 1 .. F := F * IDENT_INT(0) + 1;
+           END RECORD;
+ 
+           R2 : REC2 := (OTHERS => 1);
+           Y : INTEGER := X;
+           R2A : REC2;
+ 
+      BEGIN
+ 
+           IF R2.I1 = R2.I2 THEN        -- TEST TO SEE IF THE COMPONENTS
+                NULL;                   -- ARE OF THE SAME TYPE.
+           END IF;
+ 
+           IF Y /= 2 THEN
+                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                        "FOR SCALARS");
+           END IF;
+ 
+           IF X /= 4 THEN
+                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
+                        "EACH SCALAR COMPONENT");
+           END IF;
+ 
+           RESET;
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE REC3X (DSC : INTEGER) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           TYPE REC3Y IS RECORD
+                I : INTEGER;
+           END RECORD;
+ 
+           TYPE REC3 IS RECORD
+                RX1, RX2 : REC3X (F);
+                RY1, RY2 : REC3Y := (I => F);
+           END RECORD;
+ 
+           R3 : REC3 := ((DSC => 1), (DSC => 2), (I => 0), (I => 0));
+           Y : INTEGER := X;
+           R3A : REC3;
+ 
+      BEGIN
+ 
+           IF R3.RX1 = R3.RX2 THEN       -- TEST TO SEE IF THE COMPONENTS
+                NULL;                    -- ARE OF THE SAME TYPE.
+           END IF;
+ 
+           IF Y /= 2 THEN
+                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                        "FOR RECORDS");
+           END IF;
+ 
+           IF X /= 4 THEN
+                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
+                        "FOR EACH RECORD COMPONENT");
+           END IF;
+ 
+           RESET;
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE REC4X (DSC : INTEGER) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           TYPE ACR IS ACCESS REC4X;
+           TYPE ACI IS ACCESS INTEGER;
+ 
+           TYPE REC4 IS RECORD
+                AC1, AC2 : ACR (F);
+                AC3, AC4 : ACI := NEW INTEGER'(F);
+           END RECORD;
+ 
+           R4 : REC4 := (NULL, NULL, NULL, NULL);
+           Y : INTEGER := X;
+           R4A : REC4;
+ 
+      BEGIN
+ 
+           IF R4.AC1 = R4.AC2 THEN       -- TEST TO SEE IF THE COMPONENTS
+                NULL;                    -- ARE OF THE SAME TYPE.
+           END IF;
+ 
+           IF Y /= 2 THEN
+                FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                        "FOR ACCESS");
+           END IF;
+ 
+           IF X /= 4 THEN
+                FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
+                        "FOR EACH ACCESS COMPONENT");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C37003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37003b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37003b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37003b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- C37003B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR A RECORD WITH MULTIPLE DISCRIMINANTS WHICH HAVE
+ --     DEFAULT EXPRESSIONS, THE EXPRESSIONS ARE EVALUATED ONCE FOR
+ --     EACH DISCRIMINANT IN THE ASSOCIATION.
+ 
+ -- HISTORY:
+ --     DHH 08/04/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37003B IS
+ 
+      X : INTEGER := 0;
+ 
+      FUNCTION F1 RETURN INTEGER IS
+      BEGIN
+           X := X + 1;
+           RETURN X;
+      END F1;
+ 
+ BEGIN
+      TEST("C37003B", "CHECK THAT FOR A RECORD WITH MULTIPLE " &
+                      "DISCRIMINANTS WHICH HAVE DEFAULT EXPRESSIONS, " &
+                      "THE  EXPRESSIONS ARE EVALUATED ONCE FOR EACH " &
+                      "DISCRIMINANT IN THE ASSOCIATION");
+ 
+      DECLARE
+           TYPE REC(D1, D2, D3, D4, D5 : INTEGER := F1) IS
+                RECORD
+                     Y : INTEGER := (D1 + D2 + D3 + D4 + D5);
+                END RECORD;
+ 
+           REC_F1 : REC;
+ 
+      BEGIN
+           IF REC_F1.Y /= IDENT_INT(15) THEN
+                FAILED("MULTIPLE DISCRIMINANTS NOT EVALUATED " &
+                       "SEPARATELY");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C37003B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C37005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SCALAR RECORD COMPONENTS MAY HAVE NON-STATIC
+ -- RANGE CONSTRAINTS OR DEFAULT INITIAL VALUES.
+ 
+ -- DAT 3/6/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ -- EDS 7/16/98   AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ PROCEDURE C37005A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C37005A", "SCALAR RECORD COMPONENTS MAY HAVE NON-STATIC"
+                     & " RANGE CONSTRAINTS OR DEFAULT INITIAL VALUES");
+ 
+      DECLARE
+           SUBTYPE DT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (5);
+           L : INTEGER := IDENT_INT (DT'FIRST);
+           R : INTEGER := IDENT_INT (DT'LAST);
+           SUBTYPE DT2 IS INTEGER RANGE L .. R;
+           M : INTEGER := (L + R) / 2;
+ 
+           TYPE REC IS
+                RECORD
+                     C1 : INTEGER := M;
+                     C2 : DT2 := (L + R) / 2;
+                     C3 : BOOLEAN RANGE (L < M) .. (R > M)
+                          := IDENT_BOOL (TRUE);
+                     C4 : INTEGER RANGE L .. R := DT'FIRST;
+                END RECORD;
+ 
+           R1, R2 : REC := ((L+R)/2, M, M IN DT, L);
+           R3 : REC;
+      BEGIN
+           IF R3 /= R1
+           THEN
+                FAILED ("INCORRECT RECORD VALUES");
+           END IF;
+ 
+           R3 := (R2.C2, R2.C1, R3.C3, R);  -- CONSTRAINTS CHECKED BY :=
+           IF EQUAL(IDENT_INT(1), 2) THEN
+                FAILED("IMPOSSIBLE " & INTEGER'IMAGE(R3.C1));  --USE R3
+           END IF;
+ 
+           BEGIN
+                R3 := (M, M, IDENT_BOOL (FALSE), M); -- RAISES CON_ERR.
+                FAILED ("CONSTRAINT ERROR NOT RAISED " & INTEGER'IMAGE(R3.C1));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+           END;
+ 
+           FOR I IN DT LOOP
+                R3 := (I, I, I /= 100, I);
+                R1.C2 := I;
+                IF EQUAL(IDENT_INT(1), 2) THEN
+                     FAILED("IMPOSSIBLE " & 
+                            INTEGER'IMAGE(R3.C1 + R1.C2));  --USE R3, R1
+                END IF;
+           END LOOP;
+ 
+      EXCEPTION
+           WHEN OTHERS => FAILED ("INVALID EXCEPTION");
+      END;
+ 
+      RESULT;
+ END C37005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,272 ----
+ -- C37006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A COMPONENT OF A RECORD, ACCESS, OR PRIVATE TYPE, OR FOR A 
+ -- LIMITED PRIVATE COMPONENT, CHECK THAT A NON-STATIC EXPRESSION CAN 
+ -- BE USED IN A DISCRIMINANT CONSTRAINT OR (EXCEPTING LIMITED PRIVATE 
+ -- COMPONENTS) IN SPECIFYING A DEFAULT INITIAL VALUE.
+  
+ -- R.WILLIAMS 8/28/86
+  
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37006A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0 .. 100;
+ 
+      TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
+ 
+      TYPE REC1 (D1, D2 : INT) IS
+           RECORD
+                A : ARR (D1 .. D2);
+           END RECORD;
+ 
+      TYPE REC1_NAME IS ACCESS REC1;
+  
+      PROCEDURE CHECK (AR : ARR; STR : STRING) IS
+      BEGIN
+           IF AR'FIRST /= 1 OR AR'LAST /= 2 THEN
+                FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN COMPONENT " &
+                         "OF " & STR & " TYPE");
+           ELSIF AR /= (3, 4) THEN
+                FAILED ( "INITIALIZATION OF R.COMP.A IN COMPONENT OF " &
+                          STR & " TYPE FAILED" );
+           END IF;
+      END CHECK;
+           
+      PACKAGE PACK IS
+           TYPE PRIV (D1, D2 : INT) IS PRIVATE;
+           TYPE LIM (D1, D2 : INT) IS LIMITED PRIVATE;
+           FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV;
+           PROCEDURE PRIV_CHECK (R : PRIV);
+           PROCEDURE LIM_CHECK (R : LIM);
+ 
+      PRIVATE
+           TYPE PRIV (D1, D2 : INT) IS
+                RECORD
+                     A : ARR (D1 .. D2);
+                END RECORD;
+ 
+           TYPE LIM (D1, D2 : INT) IS
+                RECORD
+                     A : ARR (D1 .. D2);
+                END RECORD;
+      END PACK;
+ 
+      PACKAGE BODY PACK IS
+ 
+           FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV IS
+           BEGIN
+                RETURN (IDENT_INT (1), IDENT_INT (2),
+                        ARR'(1 => 3, 2 => 4));
+           END PRIV_FUN;
+           
+           PROCEDURE PRIV_CHECK (R : PRIV) IS
+           BEGIN
+                CHECK (R.A, "PRIVATE TYPE" );
+           END PRIV_CHECK;
+ 
+           PROCEDURE LIM_CHECK (R : LIM) IS
+           BEGIN
+                IF R.A'FIRST /= 1 OR R.A'LAST /= 2 THEN
+                     FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN " &
+                              "COMPONENT OF LIMITED PRIVATE TYPE");
+                END IF;
+           END LIM_CHECK;
+      END PACK;
+  
+      USE PACK;
+ 
+ BEGIN
+      
+      TEST ( "C37006A", "FOR A COMPONENT OF A RECORD, ACCESS, " &
+                        "OR PRIVATE TYPE, OR FOR A LIMITED PRIVATE " &
+                        "COMPONENT, CHECK THAT A NON-STATIC " &
+                        "EXPRESSION CAN BE USED IN A DISCRIMINANT " &
+                        "CONSTRAINT OR (EXCEPTING LIMITED PRIVATE " &
+                        "COMPONENTS) IN SPECIFYING A DEFAULT " &
+                        "INITIAL VALUE" );
+  
+      BEGIN
+           DECLARE
+           
+                TYPE REC2 IS
+                     RECORD
+                          COMP : REC1 (IDENT_INT (1), IDENT_INT (2)) := 
+                                 (IDENT_INT (1), IDENT_INT (2), 
+                                  ARR'(1 => 3, 2 => 4));
+                     END RECORD;
+  
+           R : REC2;
+ 
+           BEGIN
+                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
+                     CHECK (R.COMP.A, "RECORD");
+                ELSE 
+                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                              "OF RECORD TYPE COMPONENT" );
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              "RECORD TYPE COMPONENT" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              "RECORD TYPE COMPONENT" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                         "OF RECORD TYPE COMPONENT" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                         "OF RECORD TYPE COMPONENT" );
+      END;
+  
+      BEGIN
+           DECLARE
+           
+                TYPE REC2 IS
+                     RECORD
+                          COMP : REC1_NAME (IDENT_INT (1), 
+                                            IDENT_INT (2)) := 
+                                 NEW REC1'(IDENT_INT (1), 
+                                           IDENT_INT (2), 
+                                           ARR'(1 => 3, 2 => 4));
+                     END RECORD;
+  
+           R : REC2;
+ 
+           BEGIN
+                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
+                     CHECK (R.COMP.A, "ACCESS");
+                ELSE 
+                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                              "OF ACCESS TYPE COMPONENT" );
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              "ACCESS TYPE COMPONENT" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              "ACCESS TYPE COMPONENT" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                         "OF ACCESS TYPE COMPONENT" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                         "OF ACCESS TYPE COMPONENT" );
+      END;
+  
+      BEGIN
+           DECLARE
+           
+                TYPE REC2 IS
+                     RECORD
+                          COMP : PRIV (IDENT_INT (1), IDENT_INT (2)) := 
+                                 PRIV_FUN (IDENT_INT (1), 
+                                           IDENT_INT (2));
+                     END RECORD;
+  
+           R : REC2;
+ 
+           BEGIN
+                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
+                     PRIV_CHECK (R.COMP);
+                ELSE 
+                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                              "OF PRIVATE TYPE COMPONENT" );
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              "PRIVATE TYPE COMPONENT" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              "PRIVATE TYPE COMPONENT" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                         "OF PRIVATE TYPE COMPONENT" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                         "OF PRIVATE TYPE COMPONENT" );
+      END;
+  
+      BEGIN
+           DECLARE
+           
+                TYPE REC2 IS
+                     RECORD
+                          COMP : LIM (IDENT_INT (1), IDENT_INT (2));
+                     END RECORD;
+ 
+           R : REC2;
+ 
+           BEGIN
+                IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
+                     LIM_CHECK (R.COMP);
+                ELSE
+                     FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                              "OF LIM PRIV TYPE COMPONENT" );
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              " LIM PRIV TYPE COMPONENT" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                              "SEQUENCE FOLLOWING DECLARATION OF " &
+                              " LIM PRIV TYPE COMPONENT" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                         "OF  LIM PRIV TYPE COMPONENT" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                         "OF  LIM PRIV TYPE COMPONENT" );
+      END;
+  
+      RESULT;
+  
+ END C37006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,270 ----
+ -- C37008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SPECIFYING AN INVALID DEFAULT INITIALIZATION
+ -- RAISES CONSTRAINT_ERROR WHEN AN OBJECT IS DECLARED.
+ 
+ -- DAT 3/6/81
+ -- SPS 10/26/82
+ -- RJW 1/9/86 -  REVISED COMMENTS. ADDED 'IDENT_INT'.
+ -- EDS 7/22/98   AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C37008A IS
+ BEGIN
+      TEST ("C37008A", "CHECK THAT INVALID DEFAULT RECORD"
+                     & " COMPONENT INITIALIZATIONS RAISE"
+                     & " CONSTRAINT_ERROR");
+ 
+      BEGIN
+           DECLARE
+                TYPE R1 IS RECORD
+                     C1 : INTEGER RANGE 1 .. 5 := IDENT_INT (0);
+                END RECORD;
+                REC1 : R1;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 1 " & INTEGER'IMAGE(REC1.C1));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE R IS RECORD
+                     C : CHARACTER RANGE 'A' .. 'Y' := 'Z';
+                END RECORD;
+                REC2 : R;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 1A " & (REC2.C));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1A");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE R2 IS RECORD
+                     C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE;
+                END RECORD;
+                REC3 : R2;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 2 " & BOOLEAN'IMAGE(REC3.C2));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE E IS (E1, E2, E3);
+                TYPE R IS RECORD
+                     C : E RANGE E2 .. E3 := E1;
+                END RECORD;
+                REC4 : R;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 2A " & E'IMAGE(REC4.C));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2A");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE R3 IS RECORD
+                     C3 : INTEGER RANGE 1 .. 5;
+                END RECORD;
+                REC5 : R3;
+                TYPE R3A IS RECORD
+                     C3A : R3 := (OTHERS => IDENT_INT (6));
+                END RECORD;
+                REC6 : R3A;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 3 " & 
+                        INTEGER'IMAGE(REC6.C3A.C3));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9;
+                TYPE R4 IS RECORD
+                     C4 : ARR
+                          := (1 => 8, 2 => 9, 3 => 10);
+                END RECORD;
+                REC7 : R4;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 4 " & 
+                        INTEGER'IMAGE(REC7.C4(1)));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 4");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. 5;
+ 
+                TYPE AA IS ACCESS A;
+ 
+                TYPE R5 IS RECORD
+                     C5 : AA := NEW A' (4, 5, 6);
+                END RECORD;
+                REC8 : R5;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 5 " & 
+                        INTEGER'IMAGE(REC8.C5(1)));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 5");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. 5;
+ 
+                TYPE AA IS ACCESS A (1 .. 3);
+ 
+                TYPE R6 IS RECORD
+                     C6 : AA := NEW A' (4, 4, 4, 4);
+                END RECORD;
+                REC9 : R6;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 6 " & 
+                        INTEGER'IMAGE(REC9.C6(1)));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 6");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE AI IS ACCESS INTEGER RANGE 6 .. 8;
+ 
+                TYPE R7 IS RECORD
+                     C7 : AI := NEW INTEGER' (5);
+                END RECORD;
+                REC10 : R7;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 7 " & 
+                        INTEGER'IMAGE(REC10.C7.ALL));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 7");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE UA IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 3 .. 5;
+ 
+                SUBTYPE CA IS UA (7 .. 8);
+ 
+                TYPE R8 IS RECORD
+                     C8 : CA := (6 .. 8 => 4);
+                END RECORD;
+                REC11 : R8;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 8 " & 
+                        INTEGER'IMAGE(REC11.C8(7)));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 8");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE UA IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 3 .. IDENT_INT(5);
+ 
+                TYPE R9 IS RECORD
+                     C9 : UA (11 .. 11) := (11 => 6);
+                END RECORD;
+                REC12 : R9;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 9 " & 
+                        INTEGER'IMAGE(REC12.C9(11)));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 9");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. IDENT_INT (5);
+ 
+                TYPE AA IS ACCESS A;
+ 
+                TYPE R10 IS RECORD
+                     C10 : AA := NEW A '(4, 5, 6);
+                END RECORD;
+                REC13 : R10;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 10 " & 
+                        INTEGER'IMAGE(REC13.C10(1)));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. 5;
+ 
+                TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3));
+ 
+                TYPE R11 IS RECORD
+                     C11 : AA := NEW A '(4, 4, 4, 4);
+                END RECORD;
+                REC14 : R11;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED 11 " & 
+                        INTEGER'IMAGE(REC14.C11(1)));
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 11");
+      END;
+ 
+      RESULT;
+ END C37008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37008b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37008b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37008b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,232 ----
+ -- C37008B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NO CONSTRAINT ERROR IS RAISED FOR AN UNUSED TYPE
+ -- DECLARATION WITH AN INVALID DEFAULT VALUE
+ 
+ -- JBG 9/11/81
+ -- SPS 10/25/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C37008B IS
+ BEGIN
+      TEST ("C37008B", "CHECK THAT INVALID DEFAULT RECORD"
+                     & " COMPONENT INITIALIZATIONS DO NOT RAISE"
+                     & " CONSTRAINT_ERROR");
+ 
+      BEGIN
+           DECLARE
+                TYPE R1 IS RECORD
+                     C1 : INTEGER RANGE 1 .. 5 := 0;
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE R IS RECORD
+                     C : CHARACTER RANGE 'A' .. 'Y' := 'Z';
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 1A");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE R2 IS RECORD
+                     C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE;
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 2");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE E IS (E1, E2, E3);
+                TYPE R IS RECORD
+                     C : E RANGE E2 .. E3 := E1;
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 2A");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE R3 IS RECORD
+                     C3 : INTEGER RANGE 1 .. 5;
+                END RECORD;
+                TYPE R3A IS RECORD
+                     C3A : R3 := (OTHERS => 6);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9;
+                TYPE R4 IS RECORD
+                     C4 : ARR
+                          := (1 => 8, 2 => 9, 3 => 10);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 4");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. 5;
+ 
+                TYPE AA IS ACCESS A;
+ 
+                TYPE R5 IS RECORD
+                     C5 : AA := NEW A'(4, 5, 6);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 5");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. 5;
+ 
+                TYPE AA IS ACCESS A (1 .. 3);
+ 
+                TYPE R6 IS RECORD
+                     C6 : AA := NEW A'(4, 4, 4, 4);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 6");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE AI IS ACCESS INTEGER RANGE 6 .. 8;
+ 
+                TYPE R7 IS RECORD
+                     C7 : AI := NEW INTEGER'(5);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE UA IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 3 .. 5;
+ 
+                SUBTYPE CA IS UA (7 .. 8);
+ 
+                TYPE R8 IS RECORD
+                     C8 : CA := (6 .. 8 => 4);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE UA IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 3 .. IDENT_INT(5);
+ 
+                TYPE R9 IS RECORD
+                     C9 : UA (11 .. 11) := (11 => 6);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. IDENT_INT (5);
+ 
+                TYPE AA IS ACCESS A;
+ 
+                TYPE R10 IS RECORD
+                     C10 : AA := NEW A'(4, 5, 6);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE A IS ARRAY (NATURAL RANGE <> )
+                     OF INTEGER RANGE 1 .. 5;
+ 
+                TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3));
+ 
+                TYPE R11 IS RECORD
+                     C11 : AA := NEW A'(4, 4, 4, 4);
+                END RECORD;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED 11");
+      END;
+ 
+      RESULT;
+ END C37008B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C37009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN UNCONSTRAINED RECORD TYPE CAN BE USED TO DECLARE A
+ --     RECORD COMPONENT THAT CAN BE INITIALIZED WITH AN APPROPRIATE
+ --     EXPLICIT OR DEFAULT VALUE.
+ 
+ -- HISTORY:
+ --     DHH 02/01/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C37009A IS
+ 
+      TYPE FLOAT IS DIGITS 5;
+      TYPE COLOR IS (RED, YELLOW, BLUE);
+ 
+      TYPE COMPONENT IS
+           RECORD
+                I : INTEGER := 1;
+                X : FLOAT := 3.5;
+                BOL : BOOLEAN := FALSE;
+                FIRST : COLOR := RED;
+           END RECORD;
+      TYPE COMP_DIS(A : INTEGER := 1) IS
+           RECORD
+                I : INTEGER := 1;
+                X : FLOAT := 3.5;
+                BOL : BOOLEAN := FALSE;
+                FIRST : COLOR := RED;
+           END RECORD;
+      SUBTYPE SMAL_INTEGER IS INTEGER RANGE 1 .. 10;
+      TYPE LIST IS ARRAY(INTEGER RANGE <>) OF FLOAT;
+ 
+      TYPE DISCRIM(P : SMAL_INTEGER := 2) IS
+           RECORD
+                A : LIST(1 .. P) := (1 .. P => 1.25);
+           END RECORD;
+ 
+      TYPE REC_T IS                                     -- EXPLICIT INIT.
+           RECORD
+                T : COMPONENT := (5, 6.0, TRUE, YELLOW);
+                U : DISCRIM(3) := (3, (1 .. 3 => 2.25));
+                L : COMP_DIS(5) := (A => 5, I => 5, X => 6.0,
+                                       BOL =>TRUE, FIRST => YELLOW);
+           END RECORD;
+ 
+      TYPE REC_DEF_T IS                                 -- DEFAULT INIT.
+           RECORD
+                T : COMPONENT;
+                U : DISCRIM;
+                L : COMP_DIS;
+           END RECORD;
+ 
+      REC : REC_T;
+      REC_DEF : REC_DEF_T;
+ 
+      FUNCTION IDENT_FLT(X : FLOAT) RETURN FLOAT IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN X;
+           ELSE
+                RETURN 0.0;
+           END IF;
+      END IDENT_FLT;
+ 
+      FUNCTION IDENT_ENUM(X : COLOR) RETURN COLOR IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN X;
+           ELSE
+                RETURN BLUE;
+           END IF;
+      END IDENT_ENUM;
+ 
+ BEGIN
+      TEST("C37009A", "CHECK THAT AN UNCONSTRAINED RECORD TYPE CAN " &
+                      "BE USED TO DECLARE A RECORD COMPONENT THAT " &
+                      "CAN BE INITIALIZED WITH AN APPROPRIATE " &
+                      "EXPLICIT OR DEFAULT VALUE");
+ 
+      IF REC_DEF.T.I /= IDENT_INT(1) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF INTEGER");
+      END IF;
+ 
+      IF IDENT_BOOL(REC_DEF.T.BOL) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF BOOLEAN");
+      END IF;
+ 
+      IF REC_DEF.T.X /= IDENT_FLT(3.5) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF REAL");
+      END IF;
+ 
+      IF REC_DEF.T.FIRST /= IDENT_ENUM(RED) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF ENUMERATION");
+      END IF;
+ 
+      FOR I IN 1 .. 2 LOOP
+           IF REC_DEF.U.A(I) /= IDENT_FLT(1.25) THEN
+                FAILED("INCORRECT DEFAULT INITIALIZATION OF ARRAY " &
+                       "POSITION " & INTEGER'IMAGE(I));
+           END IF;
+      END LOOP;
+ 
+      IF REC_DEF.L.A /= IDENT_INT(1) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF DISCRIMINANT " &
+                  "- L");
+      END IF;
+ 
+      IF REC_DEF.L.I /= IDENT_INT(1) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF INTEGER - L");
+      END IF;
+ 
+      IF IDENT_BOOL(REC_DEF.L.BOL) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF BOOLEAN - L");
+      END IF;
+ 
+      IF REC_DEF.L.X /= IDENT_FLT(3.5) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF REAL - L");
+      END IF;
+ 
+      IF REC_DEF.L.FIRST /= IDENT_ENUM(RED) THEN
+           FAILED("INCORRECT DEFAULT INITIALIZATION OF ENUMERATION - L");
+      END IF;
+ --------------------------------------------------------------------
+      IF REC.T.I /= IDENT_INT(5) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF INTEGER");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(REC.T.BOL) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF BOOLEAN");
+      END IF;
+ 
+      IF REC.T.X /= IDENT_FLT(6.0) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF REAL");
+      END IF;
+ 
+      IF REC.T.FIRST /= YELLOW THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF ENUMERATION");
+      END IF;
+ 
+      FOR I IN 1 .. 3 LOOP
+           IF REC.U.A(I) /= IDENT_FLT(2.25) THEN
+                FAILED("INCORRECT EXPLICIT INITIALIZATION OF ARRAY " &
+                       "POSITION " & INTEGER'IMAGE(I));
+           END IF;
+      END LOOP;
+ 
+      IF REC.L.A /= IDENT_INT(5) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF DISCRIMINANT " &
+                  "- L");
+      END IF;
+ 
+      IF REC.L.I /= IDENT_INT(5) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF INTEGER - L");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(REC.L.BOL) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF BOOLEAN - L");
+      END IF;
+ 
+      IF REC.L.X /= IDENT_FLT(6.0) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF REAL - L");
+      END IF;
+ 
+      IF REC.L.FIRST /= IDENT_ENUM(YELLOW) THEN
+           FAILED("INCORRECT EXPLICIT INITIALIZATION OF ENUMERATION " &
+                  "- L");
+      END IF;
+ 
+      RESULT;
+ 
+ END C37009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,140 ----
+ -- C37010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EXPRESSIONS IN CONSTRAINTS OF COMPONENT DECLARATIONS ARE
+ -- EVALUATED IN THE ORDER THE COMPONENTS APPEAR.
+ 
+ -- R.WILLIAMS 8/22/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37010A IS
+      
+      TYPE R (D : INTEGER) IS
+              RECORD
+                   NULL;
+              END RECORD;
+ 
+      TYPE ACCR IS ACCESS R;
+ 
+      TYPE ARR IS ARRAY (POSITIVE RANGE <> ) OF INTEGER;
+ 
+      TYPE ACCA IS ACCESS ARR;
+ 
+      BUMP : INTEGER := 0;
+ 
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN BUMP;
+      END;          
+ 
+ BEGIN
+      TEST ( "C37010A", "CHECK THAT EXPRESSIONS IN CONSTRAINTS OF " &
+                        "COMPONENT DECLARATIONS ARE EVALUATED IN " &
+                        "THE ORDER THE COMPONENTS APPEAR" );
+ 
+      DECLARE
+           
+           TYPE REC1 IS 
+                RECORD
+                     A1 : R (D => F);
+                     B1 : STRING (1 .. F);
+                     C1 : ACCR (F);
+                     D1 : ACCA (1 .. F);
+                END RECORD;
+                
+           R1 : REC1;
+ 
+      BEGIN
+           IF R1.A1.D /= 1 THEN 
+                FAILED ( "INCORRECT VALUE FOR R1.A1.D" );
+           END IF;
+      
+           IF R1.B1'LAST /= 2 THEN
+                FAILED ( "INCORRECT VALUE FOR R1.B1'LAST" );
+           END IF;
+      
+           BEGIN
+                R1.C1 := NEW R'(D => 3);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R1.C1" );
+           END;
+ 
+           BEGIN
+                R1.D1 := NEW ARR (1 .. 4);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R1.D1" );
+           END;
+ 
+      END;
+ 
+      BUMP := 0;
+           
+      DECLARE
+           
+           TYPE REC2 (I : INTEGER) IS
+                RECORD
+                     CASE I IS
+                          WHEN 1 =>
+                               NULL;
+                          WHEN OTHERS =>
+                               A2 : R (D => F);
+                               B2 : ARR (1 .. F);
+                               C2 : ACCR (F);
+                               D2 : ACCA (1 .. F);
+                     END CASE;                     
+                END RECORD;
+ 
+           R2 : REC2 (IDENT_INT (2));
+ 
+      BEGIN
+           
+           IF R2.A2.D /= 1 THEN 
+                FAILED ( "INCORRECT VALUE FOR R2.A2.D" );
+           END IF;
+ 
+           IF R2.B2'LAST /= 2 THEN
+                FAILED ( "INCORRECT VALUE FOR R2.B2'LAST" );
+           END IF;
+ 
+           BEGIN
+                R2.C2 := NEW R (D => 3);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R2.C2" );
+           END;
+  
+           BEGIN
+                R2.D2 := NEW ARR (1 .. 4);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R2.D2" );
+           END;                         
+           
+      END;
+           
+      RESULT;
+ END C37010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37010b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37010b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37010b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37010b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C37010B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EXPRESSIONS IN AN INDEX CONSTRAINT OR DISCRIMINANT 
+ -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT DECLARATION IS 
+ -- ELABORATED EVEN IF SOME BOUNDS OR DISCRIMINANTS ARE GIVEN BY
+ -- A DISCRIMINANT OF AN ENCLOSING RECORD TYPE.
+ 
+ -- R.WILLIAMS 8/22/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37010B IS
+      
+      INIT :INTEGER := IDENT_INT (5);
+ 
+      TYPE R (D1, D2 : INTEGER) IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      TYPE ACCR IS ACCESS R;
+ 
+      TYPE ARR IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+ 
+      TYPE ACCA IS ACCESS ARR;
+ 
+      FUNCTION RESET (N : INTEGER) RETURN INTEGER IS
+      BEGIN
+           INIT := IDENT_INT (N);
+           RETURN N;
+      END RESET;
+ 
+ BEGIN
+      TEST ( "C37010B", "CHECK THAT EXPRESSIONS IN AN INDEX " &
+                        "CONSTRAINT OR DISCRIMINANT CONSTRAINT " &
+                        "ARE EVALUATED WHEN THE COMPONENT " &
+                        "DECLARATION IS ELABORATED EVEN IF SOME " &
+                        "BOUNDS OR DISCRIMINANTS ARE GIVEN BY " &
+                        "A DISCRIMINANT OF AN ENCLOSING RECORD TYPE" );
+ 
+      DECLARE
+           
+           TYPE REC1 (D : INTEGER) IS 
+                RECORD
+                     W1 : R (D1 => INIT, D2 => D);
+                     X1 : ARR (INIT .. D);
+                     Y1 : ACCR (D, INIT);
+                     Z1 : ACCA (D .. INIT);
+                END RECORD;
+           
+           INT1 : INTEGER := RESET (10);
+ 
+           R1 : REC1 (D => 4);
+ 
+      BEGIN
+           IF R1.W1.D1 /= 5 THEN 
+                FAILED ( "INCORRECT VALUE FOR R1.W1.D1" );
+           END IF;
+      
+           IF R1.W1.D2 /= 4 THEN 
+                FAILED ( "INCORRECT VALUE FOR R1.W1.D2" );
+           END IF;
+ 
+           IF R1.X1'FIRST /= 5 THEN
+                FAILED ( "INCORRECT VALUE FOR R1.X1'FIRST" );
+           END IF;
+ 
+           IF R1.X1'LAST /= 4 THEN
+                FAILED ( "INCORRECT VALUE FOR R1.X1'LAST" );
+           END IF;
+ 
+           BEGIN
+                R1.Y1 := NEW R (4, 5);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R1.Y1" );
+           END;
+ 
+           BEGIN
+                R1.Z1 := NEW ARR (4 .. 5);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R1.Z1" );
+           END;
+                     
+      END;
+ 
+      DECLARE
+           
+           TYPE REC2 (D : INTEGER) IS
+                RECORD
+                     CASE D IS
+                          WHEN 1 =>
+                               NULL;
+                          WHEN 2 =>
+                               NULL;
+                          WHEN OTHERS =>
+                               W2 : R (D1 => D, D2 => INIT);
+                               X2 : ARR (D .. INIT);
+                               Y2 : ACCR (INIT, D);
+                               Z2 : ACCA (D .. INIT);
+                     END CASE;                     
+                END RECORD;
+ 
+           INT2 : INTEGER := RESET (20);
+ 
+           R2 : REC2 (D => 6);
+ 
+      BEGIN
+           IF R2.W2.D1 /= 6 THEN 
+                FAILED ( "INCORRECT VALUE FOR R2.W2.D1" );
+           END IF;
+ 
+           IF R2.W2.D2 /= 10 THEN 
+                FAILED ( "INCORRECT VALUE FOR R2.W2.D2" );
+           END IF;
+ 
+           IF R2.X2'FIRST /= 6 THEN
+                FAILED ( "INCORRECT VALUE FOR R2.X2'FIRST" );
+           END IF;
+ 
+           IF R2.X2'LAST /= 10 THEN
+                FAILED ( "INCORRECT VALUE FOR R2.X2'LAST" );
+           END IF;
+ 
+           BEGIN
+                R2.Y2 := NEW R (10, 6);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R2.Y2" );
+           END;
+ 
+           BEGIN
+                R2.Z2 := NEW ARR (6 .. 10);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "INCORRECT VALUE FOR R2.Z2" );
+           END;
+                     
+      END;
+ 
+      RESULT;
+ END C37010B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c371001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c371001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c371001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c371001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,388 ----
+ -- C371001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a discriminant constraint depends on a discriminant,
+ --      the evaluation of the expressions in the constraint is deferred 
+ --      until an object of the subtype is created.  Check for cases of 
+ --      records with private type component.
+ --
+ -- TEST DESCRIPTION:
+ --      This transition test defines record type and incomplete types with 
+ --      discriminant components which depend on the discriminants.  The 
+ --      discriminants are calculated by function calls.  The test verifies
+ --      that Constraint_Error is raised during the object creations when 
+ --      values of discriminants are incompatible with the subtypes.
+ --
+ --      Inspired by C37214A.ADA and C37216A.ADA.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      11 Apr 96   SAIC    Initial version for ACVC 2.1.
+ --      06 Oct 96   SAIC    Added LM references. Replaced "others exception"
+ --                          with "unexpected exception"                     
+ --
+ --!
+ 
+ with Report; 
+ 
+ procedure C371001 is
+ 
+    subtype Small_Int is Integer range 1..10;
+ 
+    Func1_Cons : Integer := 0;
+ 
+    ---------------------------------------------------------
+    function Func1 return Integer is
+    begin
+       Func1_Cons := Func1_Cons + Report.Ident_Int(1);
+       return Func1_Cons;
+    end Func1;
+ 
+ 
+ begin
+    Report.Test ("C371001", "Check that if a discriminant constraint " &
+                 "depends on a discriminant, the evaluation of the "   &
+                 "expressions in the constraint is deferred until "    &
+                 "object declarations");
+ 
+    ---------------------------------------------------------
+    -- Constraint checks on an object declaration of a record.
+ 
+    begin
+ 
+       declare
+ 
+          package C371001_0 is
+ 
+             type PT_W_Disc (D : Small_Int) is private;
+             type Rec_W_Private (D1 : Integer) is
+               record
+                  C : PT_W_Disc (D1);
+               end record;
+    
+             type Rec (D3 : Integer) is
+               record
+                  C1 : Rec_W_Private (D3);
+               end record;
+ 
+          private
+             type PT_W_Disc (D : Small_Int) is 
+               record
+                  Str : String (1 .. D) := (others => '*');
+               end record;
+ 
+          end C371001_0;                         
+ 
+          --=====================================================--
+ 
+          Obj : C371001_0.Rec(Report.Ident_Int(0));  -- Constraint_Error raised.
+ 
+       begin
+          Report.Failed ("Obj - Constraint_Error should be raised");
+          if Obj.C1.D1 /= 0 then
+             Report.Failed ("Obj - Shouldn't get here");
+          end if;
+ 
+       exception
+          when others           => 
+               Report.Failed ("Obj - exception raised too late");
+       end;
+ 
+    exception                      
+       when Constraint_Error =>                      -- Exception expected.
+            null;
+       when others           => 
+            Report.Failed ("Obj - unexpected exception raised");
+    end;
+ 
+    -------------------------------------------------------------------
+    -- Constraint checks on an object declaration of an array.
+ 
+    begin
+       declare
+ 
+          package C371001_1 is
+ 
+             type PT_W_Disc (D : Small_Int) is private;
+             type Rec_W_Private (D1 : Integer) is
+               record
+                  C : PT_W_Disc (D1);
+               end record;
+ 
+             type Rec_01 (D3 : Integer) is
+               record
+                  C1 : Rec_W_Private (D3);
+               end record;
+ 
+             type Arr is array (1 .. 5) of 
+               Rec_01(Report.Ident_Int(0));          -- No Constraint_Error 
+                                                     -- raised. 
+          private
+             type PT_W_Disc (D : Small_Int) is 
+               record
+                  Str : String (1 .. D) := (others => '*');
+               end record;
+ 
+          end C371001_1;                         
+ 
+          --=====================================================--
+ 
+       begin
+          declare
+             Obj1 : C371001_1.Arr;                   -- Constraint_Error raised.
+          begin
+             Report.Failed ("Obj1 - Constraint_Error should be raised");
+             if Obj1(1).D3 /= 0 then
+                Report.Failed ("Obj1 - Shouldn't get here");
+             end if;
+ 
+          exception
+             when others           => 
+                  Report.Failed ("Obj1 - exception raised too late");
+          end;
+ 
+       exception
+          when Constraint_Error =>                   -- Exception expected.
+               null;
+          when others =>
+               Report.Failed ("Obj1 - unexpected exception raised");
+       end;
+ 
+    exception
+       when Constraint_Error =>
+            Report.Failed ("Arr - Constraint_Error raised");
+       when others =>
+            Report.Failed ("Arr - unexpected exception raised");
+    end;
+ 
+ 
+    -------------------------------------------------------------------
+    -- Constraint checks on an object declaration of an access type.
+ 
+    begin
+       declare
+ 
+          package C371001_2 is
+ 
+             type PT_W_Disc (D : Small_Int) is private;
+             type Rec_W_Private (D1 : Integer) is
+               record
+                  C : PT_W_Disc (D1);
+               end record;
+    
+             type Rec_02 (D3 : Integer) is
+               record
+                  C1 : Rec_W_Private (D3);
+               end record;
+ 
+             type Acc_Rec2 is access Rec_02          -- No Constraint_Error 
+               (Report.Ident_Int(11));               -- raised. 
+ 
+          private
+             type PT_W_Disc (D : Small_Int) is 
+               record
+                  Str : String (1 .. D) := (others => '*');
+               end record;
+ 
+          end C371001_2;                         
+ 
+          --=====================================================--
+ 
+       begin
+          declare
+             Obj2 : C371001_2.Acc_Rec2;              -- No Constraint_Error 
+                                                     -- raised.
+          begin
+             Obj2 := new C371001_2.Rec_02 (Report.Ident_Int(11));       
+                                                     -- Constraint_Error raised.
+ 
+             Report.Failed ("Obj2 - Constraint_Error should be raised");
+             if Obj2.D3 /= 1 then
+                Report.Failed ("Obj2 - Shouldn't get here");
+             end if;
+ 
+          exception
+             when Constraint_Error =>                -- Exception expected.
+                null;
+             when others           => 
+                Report.Failed ("Obj2 - unexpected exception raised in " &
+                               "assignment");
+          end;
+ 
+       exception
+          when Constraint_Error =>  
+               Report.Failed ("Obj2 - Constraint_Error raised in declaration");
+          when others =>
+               Report.Failed ("Obj2 - unexpected exception raised in " &
+                              "declaration");
+       end;
+ 
+    exception
+       when Constraint_Error =>  
+            Report.Failed ("Acc_Rec2 - Constraint_Error raised");
+       when others =>
+            Report.Failed ("Acc_Rec2 - unexpected exception raised");
+    end;
+ 
+    -------------------------------------------------------------------
+    -- Constraint checks on an object declaration of a subtype.
+ 
+    Func1_Cons := -1;
+ 
+    begin
+       declare
+ 
+          package C371001_3 is
+ 
+             type PT_W_Disc (D1, D2 : Small_Int) is private;
+             type Rec_W_Private (D3, D4 : Integer) is
+               record
+                  C : PT_W_Disc (D3, D4);
+               end record;
+    
+             type Rec_03 (D5 : Integer) is
+               record
+                  C1 : Rec_W_Private (D5, Func1);     -- Func1 evaluated,
+               end record;                            -- value 0.
+ 
+             subtype Subtype_Rec is Rec_03(1);        -- No Constraint_Error 
+                                                      -- raised. 
+          private
+             type PT_W_Disc (D1, D2 : Small_Int) is 
+               record
+                  Str1 : String (1 .. D1) := (others => '*');
+                  Str2 : String (1 .. D2) := (others => '*');
+               end record;
+ 
+          end C371001_3;                         
+ 
+          --=====================================================--
+ 
+       begin
+          declare
+             Obj3 : C371001_3.Subtype_Rec;            -- Constraint_Error raised.
+          begin
+             Report.Failed ("Obj3 - Constraint_Error should be raised");
+             if Obj3.D5 /= 1 then
+                Report.Failed ("Obj3 - Shouldn't get here");
+             end if;
+ 
+          exception
+             when others           => 
+                  Report.Failed ("Obj3 - exception raised too late");
+          end;
+ 
+       exception
+          when Constraint_Error =>                    -- Exception expected.
+               null;
+          when others =>
+               Report.Failed ("Obj3 - unexpected exception raised");
+       end;
+ 
+    exception
+       when Constraint_Error =>
+            Report.Failed ("Subtype_Rec - Constraint_Error raised");
+       when others =>
+            Report.Failed ("Subtype_Rec - unexpected exception raised");
+    end;
+ 
+    -------------------------------------------------------------------
+    -- Constraint checks on an object declaration of an incomplete type.
+ 
+    Func1_Cons := 10;
+ 
+    begin
+       declare
+ 
+          package C371001_4 is
+ 
+             type Rec_04 (D3 : Integer);
+             type PT_W_Disc (D : Small_Int) is private;
+             type Rec_W_Private (D1, D2 : Small_Int) is
+               record
+                  C : PT_W_Disc (D2);
+               end record;
+ 
+             type Rec_04 (D3 : Integer) is
+               record
+                  C1 : Rec_W_Private (D3, Func1);     -- Func1 evaluated
+               end record;                            -- value 11.
+ 
+             type Acc_Rec4 is access Rec_04 (1);      -- No Constraint_Error 
+                                                      -- raised. 
+          private
+             type PT_W_Disc (D : Small_Int) is 
+               record
+                  Str : String (1 .. D) := (others => '*');
+               end record;
+ 
+          end C371001_4;                         
+ 
+          --=====================================================--
+ 
+       begin
+          declare
+             Obj4 : C371001_4.Acc_Rec4;               -- No Constraint_Error 
+                                                      -- raised.
+          begin
+             Obj4 := new C371001_4.Rec_04 (1);        -- Constraint_Error raised.
+ 
+             Report.Failed ("Obj4 - Constraint_Error should be raised");
+             if Obj4.D3 /= 1 then
+                Report.Failed ("Obj4 - Shouldn't get here");
+             end if;
+ 
+          exception
+             when Constraint_Error =>                 -- Exception expected.
+                null;
+             when others           => 
+                Report.Failed ("Obj4 - unexpected exception raised in " &
+                               "assignment");
+          end;
+ 
+       exception
+          when Constraint_Error =>  
+               Report.Failed ("Obj4 - Constraint_Error raised in declaration");
+          when others =>
+               Report.Failed ("Obj4 - unexpected exception raised in " &
+                              "declaration");
+       end;
+ 
+    exception
+       when Constraint_Error =>  
+            Report.Failed ("Acc_Rec4 - Constraint_Error raised");
+       when others =>
+            Report.Failed ("Acc_Rec4 - unexpected exception raised");
+    end;
+ 
+    Report.Result;
+ 
+ exception
+    when others =>
+         Report.Failed ("Discriminant value checked too soon");
+         Report.Result;
+ 
+ end C371001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c371002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c371002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c371002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c371002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,364 ----
+ -- C371002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a discriminant constraint depends on a discriminant,
+ --      the evaluation of the expressions in the constraint is deferred until
+ --      an object of the subtype is created.  Check for cases of records.
+ --
+ -- TEST DESCRIPTION:
+ --      This transition test defines record types with discriminant components
+ --      which depend on the discriminants.  The discriminants are calculated 
+ --      by function calls.  The test verifies that Constraint_Error is raised 
+ --      during the object creations when values of discriminants are 
+ --      incompatible with the subtypes.
+ --
+ --      Inspired by C37213A.ADA, C37213C.ADA, C37215A.ADA and C37215C.ADA.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      05 Apr 96   SAIC    Initial version for ACVC 2.1.
+ --
+ --!
+ 
+ with Report; 
+ 
+ procedure C371002 is
+ 
+    subtype Small_Int is Integer range 1..10;
+ 
+    type Rec_W_Disc (Disc1, Disc2 : Small_Int) is 
+      record 
+         Str1 : String (1 .. Disc1) := (others => '*');
+         Str2 : String (1 .. Disc2) := (others => '*');
+      end record;
+ 
+    type My_Array is array (Small_Int range <>) of Integer;
+ 
+    Func1_Cons : Integer := 0;
+ 
+    ---------------------------------------------------------
+    function Chk (Cons    : Integer;
+                  Value   : Integer;
+                  Message : String) return Boolean is
+    begin
+       if Cons /= Value then
+          Report.Failed (Message & ": Func1_Cons is " &
+                         Integer'Image(Func1_Cons));
+       end if;
+       return True;
+    end Chk;
+ 
+    ---------------------------------------------------------
+    function Func1 return Integer is
+    begin
+       Func1_Cons := Func1_Cons + Report.Ident_Int(1);
+       return Func1_Cons;
+    end Func1;
+ 
+ begin
+    Report.Test ("C371002", "Check that if a discriminant constraint " &
+                 "depends on a discriminant, the evaluation of the "   &
+                 "expressions in the constraint is deferred until "    &
+                 "object declarations");
+ 
+    ---------------------------------------------------------
+    declare
+       type Rec1 (D3 : Integer) is
+         record
+            C1 : Rec_W_Disc (D3, Func1);      -- Func1 evaluated, value 1.
+         end record;
+       
+       Chk1 : Boolean := Chk (Func1_Cons, 1,
+                              "Func1 not evaluated for Rec1");
+ 
+       Obj1 : Rec1 (1);                       -- Func1 not evaluated again.
+       Obj2 : Rec1 (2);                       -- Func1 not evaluated again. 
+ 
+       Chk2 : Boolean := Chk (Func1_Cons, 1,
+                              "Func1 evaluated too many times");
+    begin
+       if Obj1 /= (D3 => 1, 
+                   C1 => (Disc1   => 1,  
+                          Disc2   => 1, 
+                          Str1    => (others => '*'),
+                          Str2    => (others => '*'))) or
+          Obj2 /= (D3 => 2, 
+                   C1 => (Disc1   => 2,  
+                          Disc2   => 1, 
+                          Str1    => (others => '*'),
+                          Str2    => (others => '*'))) then
+            Report.Failed ("Obj1 & Obj2 - Discriminant values not correct");
+       end if;
+    end;
+ 
+    ---------------------------------------------------------
+    Func1_Cons := -11;
+ 
+    declare
+       type Rec_Of_Rec_01 (D3 : Integer) is
+         record
+            C1 : Rec_W_Disc (D3, Func1);      -- Func1 evaluated, value -10.
+         end record;                          -- Constraint_Error not raised. 
+ 
+       type Rec_Of_MyArr_01 (D3 : Integer) is
+         record
+            C1 : My_Array (Func1 .. D3);      -- Func1 evaluated, value -9.
+         end record;                          -- Constraint_Error not raised. 
+ 
+       type Rec_Of_Rec_02 (D3 : Integer) is
+         record
+            C1 : Rec_W_Disc (D3, 1);
+         end record;
+ 
+       type Rec_Of_MyArr_02 (D3 : Integer) is
+         record
+            C1 : My_Array (D3 .. 1);       
+         end record;
+ 
+    begin
+ 
+       ---------------------------------------------------------
+       begin
+          declare
+             Obj3 : Rec_Of_Rec_01(1);         -- Constraint_Error raised.
+          begin
+             Report.Failed ("Obj3 - Constraint_Error should be raised");
+             if Obj3 /= (1, (1, 1, others => (others => '*'))) then
+                Report.Comment ("Obj3 - Shouldn't get here");
+             end if;
+          end;
+ 
+       exception
+          when Constraint_Error =>            -- Exception expected.
+               null;
+          when others           => 
+               Report.Failed ("Obj3 - others exception raised");
+       end;
+         
+       ---------------------------------------------------------
+       begin
+          declare
+             subtype Subtype_Rec is Rec_Of_Rec_01(1);  
+                                              -- No Constraint_Error raised.
+          begin
+             declare
+                Obj4 : Subtype_Rec;           -- Constraint_Error raised.
+             begin
+                Report.Failed ("Obj4 - Constraint_Error should be raised");
+                if Obj4 /= (D3 => 1, 
+                            C1 => (Disc1   => 1,  
+                                   Disc2   => 1, 
+                                   Str1    => (others => '*'),
+                                   Str2    => (others => '*'))) then
+                   Report.Comment ("Obj4 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>         -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("Obj4 - others exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Subtype_Rec - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Subtype_Rec - others exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       begin
+          declare
+             type Arr is array (1..5)         -- No Constraint_Error raised.
+               of Rec_Of_Rec_01(1);                         
+                                                        
+          begin
+             declare
+                Obj5 : Arr;                   -- Constraint_Error raised.
+             begin
+                Report.Failed ("Obj5 - Constraint_Error should be raised");
+                if Obj5 /= (1..5 => (1, (1, 1, others => (others => '*')))) then
+                   Report.Comment ("Obj5 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>         -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("Obj5 - others exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Arr - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Arr - others exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       begin
+          declare
+             type Rec_Of_Rec_Of_MyArr is
+               record
+                  C1 : Rec_Of_MyArr_01(1);    -- No Constraint_Error raised.
+               end record;                    
+          begin
+             declare
+                Obj6 : Rec_Of_Rec_Of_MyArr;   -- Constraint_Error raised.
+             begin
+                Report.Failed ("Obj6 - Constraint_Error should be raised");
+                if Obj6 /= (C1 => (1, (1, 1))) then
+                   Report.Comment ("Obj6 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>         -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("Obj6 - others exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Rec_Of_Rec_Of_MyArr - others exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       begin
+          declare
+             type New_Rec is 
+               new Rec_Of_MyArr_01(1);        -- No Constraint_Error raised.
+ 
+          begin
+             declare
+                Obj7 : New_Rec;               -- Constraint_Error raised.
+             begin
+                Report.Failed ("Obj7 - Constraint_Error should be raised");
+                if Obj7 /= (1, (1, 1)) then
+                   Report.Comment ("Obj7 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>         -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("Obj7 - others exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("New_Rec - Constraint_Error raised");
+          when others =>
+               Report.Failed ("New_Rec - others exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       begin
+          declare
+             type Acc_Rec is 
+               access Rec_Of_Rec_02 (Report.Ident_Int(0));
+                                              -- No Constraint_Error raised.
+          begin
+             declare
+                Obj8 : Acc_Rec;               -- No Constraint_Error raised.
+ 
+             begin                                   
+                Obj8 := new Rec_Of_Rec_02 (Report.Ident_Int(0));
+                                              -- Constraint_Error raised.
+ 
+                Report.Failed ("Obj8 - Constraint_Error should be raised");
+                if Obj8.all /= (D3 => 1, 
+                                C1 => (Disc1   => 1,  
+                                       Disc2   => 1, 
+                                       Str1    => (others => '*'),
+                                       Str2    => (others => '*'))) then
+                   Report.Comment ("Obj8 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>         -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("Obj8 - others exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Acc_Rec - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Acc_Rec - others exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       begin
+          declare
+             type Acc_Rec_MyArr is access 
+               Rec_Of_MyArr_02;               -- No Constraint_Error 
+                                              -- raised for either
+             Obj9 : Acc_Rec_MyArr;            -- declaration.
+ 
+          begin
+             Obj9 := new Rec_Of_MyArr_02 (Report.Ident_Int(0));
+                                              -- Constraint_Error raised.
+ 
+             Report.Failed ("Obj9 - Constraint_Error should be raised");
+ 
+             if Obj9.all /= (1, (1, 1)) then
+                Report.Comment ("Obj9 - Shouldn't get here");
+             end if;
+        
+          exception
+             when Constraint_Error =>         -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("Obj9 - others exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Acc_Rec_MyArr - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Acc_Rec_MyArr - others exception raised");
+       end;
+ 
+    end;      
+ 
+    Report.Result;
+ 
+ exception
+      when others =>
+           Report.Failed ("Discriminant value checked too soon");
+           Report.Result;
+ 
+ end C371002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c371003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c371003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c371003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c371003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,474 ----
+ -- C371003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a discriminant constraint depends on a discriminant,
+ --      the evaluation of the expressions in the constraint is deferred 
+ --      until an object of the subtype is created.  Check for cases of 
+ --      records where the component containing the constraint is present
+ --      in the subtype.                                                    
+ --
+ -- TEST DESCRIPTION:
+ --      This transition test defines record types with discriminant components
+ --      which depend on the discriminants.  The discriminants are calculated 
+ --      by function calls.  The test verifies that Constraint_Error is raised 
+ --      during the object creations when values of discriminants are 
+ --      incompatible with the subtypes.  Also check for cases, where the
+ --      component is absent.
+ --
+ --      Inspired by C37213E.ADA, C37213G.ADA, C37215E.ADA, and C37215G.ADA.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      10 Apr 96   SAIC    Initial version for ACVC 2.1.
+ --      14 Jul 96   SAIC    Modified test description.  Added exception handler
+ --                          for VObj_10 assignment.
+ --      26 Oct 96   SAIC    Added LM references.        
+ --
+ --!
+ 
+ with Report; 
+ 
+ procedure C371003 is
+ 
+    subtype Small_Int is Integer range 1..10;
+ 
+    type Rec_W_Disc (Disc1, Disc2 : Small_Int) is 
+      record 
+         Str1 : String (1 .. Disc1) := (others => '*');
+         Str2 : String (1 .. Disc2) := (others => '*');
+      end record;
+ 
+    type My_Array is array (Small_Int range <>) of Integer;
+ 
+    Func1_Cons : Integer := 0;
+ 
+    ---------------------------------------------------------
+    function Chk (Cons    : Integer;
+                  Value   : Integer;
+                  Message : String) return Boolean is
+    begin
+       if Cons /= Value then
+          Report.Failed (Message & ": Func1_Cons is " &
+                         Integer'Image(Func1_Cons));
+       end if;
+       return True;
+    end Chk;
+ 
+    ---------------------------------------------------------
+    function Func1 return Integer is
+    begin
+       Func1_Cons := Func1_Cons + Report.Ident_Int(1);
+       return Func1_Cons;
+    end Func1;
+ 
+ 
+ begin
+    Report.Test ("C371003", "Check that if a discriminant constraint " &
+                 "depends on a discriminant, the evaluation of the "   &
+                 "expressions in the constraint is deferred until "    &
+                 "object declarations");
+ 
+    ---------------------------------------------------------
+    declare
+       type VRec_01 (D3 : Integer) is
+         record
+            case D3 is
+               when -5..10 => 
+                  C1 : Rec_W_Disc (D3, Func1);    -- Func1 evaluated, value 1.
+               when others =>
+                  C2 : Integer := Report.Ident_Int(0); 
+            end case;
+         end record;
+ 
+         Chk1 : Boolean := Chk (Func1_Cons, 1, 
+                                "Func1 not evaluated for VRec_01");
+ 
+         VObj_1 : VRec_01(1);                     -- Func1 not evaluated again
+         VObj_2 : VRec_01(2);                     -- Func1 not evaluated again
+ 
+         Chk2 : Boolean := Chk (Func1_Cons, 1, 
+                                "Func1 evaluated too many times");
+     
+    begin
+       if VObj_1 /= (D3 => 1, 
+                     C1 => (Disc1   => 1,  
+                            Disc2   => 1, 
+                            Str1    => (others => '*'),
+                            Str2    => (others => '*'))) or
+          VObj_2 /= (D3 => 2, 
+                     C1 => (Disc1   => 2,  
+                            Disc2   => 1, 
+                            Str1    => (others => '*'),
+                            Str2    => (others => '*'))) then
+          Report.Failed ("VObj_1 & VObj_2 - Discriminant values not correct");
+       end if;
+    end;
+ 
+    ---------------------------------------------------------
+    Func1_Cons := -11;
+ 
+    declare
+       type VRec_Of_VRec_01 (D3 : Integer) is
+         record
+            case D3 is
+               when -5..10 => 
+                  C1 : Rec_W_Disc (Func1, D3);   -- Func1 evaluated, value -10.
+               when others =>                    -- Constraint_Error not raised. 
+                  C2 : Integer := Report.Ident_Int(0); 
+            end case;
+         end record;
+ 
+       type VRec_Of_VRec_02 (D3 : Integer) is
+         record
+            case D3 is
+               when -5..10 => 
+                  C1 : Rec_W_Disc (1, D3); 
+               when others =>
+                  C2 : Integer := Report.Ident_Int(0); 
+            end case;
+         end record;
+ 
+       type VRec_Of_MyArr_01 (D3 : Integer) is
+         record
+            case D3 is
+               when -5..10 => 
+                  C1 : My_Array  (Func1..D3);    -- Func1 evaluated, value -9.
+               when others =>                    -- Constraint_Error not raised. 
+                  C2 : Integer := Report.Ident_Int(0); 
+            end case;
+         end record;
+ 
+       type VRec_Of_MyArr_02 (D3 : Integer) is
+         record
+            case D3 is
+               when -5..10 => 
+                  C1 : My_Array  (D3..1);
+               when others =>          
+                  C2 : Integer := Report.Ident_Int(0); 
+            end case;
+         end record;
+ 
+    begin
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is present.
+       begin
+          declare
+             VObj_3 : VRec_Of_VRec_01(1);        -- Constraint_Error raised.
+          begin
+             Report.Failed ("VObj_3 - Constraint_Error should be raised");
+             if VObj_3 /= (1, (1, 1, others => (others => '*'))) then
+                 Report.Comment ("VObj_3 - Shouldn't get here");
+             end if;
+          end;
+ 
+       exception
+          when Constraint_Error =>               -- Exception expected.
+               null;
+          when others           => 
+               Report.Failed ("VObj_3 - unexpected exception raised");
+       end;
+         
+       ---------------------------------------------------------
+       -- Component containing the constraint is present.
+       begin
+          declare
+             subtype Subtype_VRec is             -- No Constraint_Error raised.
+               VRec_Of_VRec_01(Report.Ident_Int(1));      
+          begin
+             declare
+                VObj_4 : Subtype_VRec;           -- Constraint_Error raised.
+             begin
+                Report.Failed ("VObj_4 - Constraint_Error should be raised");
+                if VObj_4 /= (D3 => 1, 
+                              C1 => (Disc1   => 1,  
+                                     Disc2   => 1, 
+                                     Str1    => (others => '*'),
+                                     Str2    => (others => '*'))) then
+                   Report.Comment ("VObj_4 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>            -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("VObj_4 - unexpected exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Subtype_VRec - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Subtype_VRec - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is absent.
+       begin
+          declare
+             type Arr is array (1..5) of         
+               VRec_Of_VRec_01(Report.Ident_Int(-6)); -- No Constraint_Error 
+             VObj_5 : Arr;                            -- for either declaration.
+ 
+          begin
+             if VObj_5 /= (1 .. 5 => (-6, 0)) then
+                Report.Comment ("VObj_5 - wrong values");
+             end if;
+          end;
+ 
+       exception
+          when others =>
+               Report.Failed ("Arr - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is present.
+       begin
+          declare
+             type Rec_Of_Rec_Of_MyArr is
+               record
+                  C1 : VRec_Of_MyArr_01(1);    -- No Constraint_Error raised.
+               end record;                    
+          begin
+             declare
+                Obj_6 : Rec_Of_Rec_Of_MyArr;   -- Constraint_Error raised.
+             begin
+                Report.Failed ("Obj_6 - Constraint_Error should be raised");
+                if Obj_6 /= (C1 => (1, (1, 1))) then
+                   Report.Comment ("Obj_6 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>         -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("Obj_6 - unexpected exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Rec_Of_Rec_Of_MyArr - unexpected exception " &
+                              "raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is absent.
+       begin
+          declare
+             type New_VRec_Arr is 
+               new VRec_Of_MyArr_01(11);       -- No Constraint_Error raised
+             Obj_7 : New_VRec_Arr;             -- for either declaration.
+ 
+          begin
+             if Obj_7 /= (11, 0) then
+                Report.Failed ("Obj_7 - value incorrect");
+             end if;
+          end;
+ 
+       exception
+          when others =>
+               Report.Failed ("New_VRec_Arr - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is present.
+       begin
+          declare
+             type New_VRec is new
+               VRec_Of_VRec_02(Report.Ident_Int(0)); -- No Constraint_Error 
+                                                     -- raised.
+          begin
+             declare
+                 VObj_8 : New_VRec;                  -- Constraint_Error raised.
+             begin
+                Report.Failed ("VObj_8 - Constraint_Error should be raised");
+                if VObj_8 /= (1, (1, 1, others => (others => '*'))) then
+                   Report.Comment ("VObj_8 - Shouldn't get here");
+                end if;
+             end;
+ 
+          exception
+             when Constraint_Error =>               -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("VObj_8 - unexpected exception raised");
+          end;
+ 
+       exception                                    
+          when Constraint_Error =>
+               Report.Failed ("New_VRec - Constraint_Error raised");
+          when others =>
+               Report.Failed ("New_VRec - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is absent.
+       begin
+          declare
+             subtype Sub_VRec is
+               VRec_Of_VRec_02(Report.Ident_Int(11)); -- No Constraint_Error 
+             VObj_9 : Sub_VRec;                       -- raised for either
+                                                      -- declaration.
+          begin
+             if VObj_9 /= (11, 0) then
+                Report.Comment ("VObj_9 - wrong values");
+             end if;
+          end;
+ 
+       exception                                    
+          when others =>
+               Report.Failed ("Sub_VRec - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is present.
+       begin
+          declare
+             type Acc_VRec_01 is access 
+               VRec_Of_VRec_02(Report.Ident_Int(0));  -- No Constraint_Error 
+                                                      -- raised.
+          begin
+             declare
+                VObj_10 : Acc_VRec_01;                -- No Constraint_Error 
+                                                      -- raised.
+             begin
+                VObj_10 := new VRec_Of_VRec_02
+                             (Report.Ident_Int(0));   -- Constraint_Error
+                                                      -- raised.
+                Report.Failed ("VObj_10 - Constraint_Error should be raised");
+                if VObj_10.all /= (1, (1, 1, others => (others => '*'))) then
+                   Report.Comment ("VObj_10 - Shouldn't get here");
+                end if;
+      
+             exception
+                when Constraint_Error =>              -- Exception expected.
+                    null;
+                when others =>
+                    Report.Failed ("VObj_10 - unexpected exception raised");
+             end;
+ 
+          exception
+             when Constraint_Error =>
+                 Report.Failed ("VObj_10 - Constraint_Error exception raised");
+             when others =>
+                 Report.Failed ("VObj_10 - unexpected exception raised at " &
+                                "declaration");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Acc_VRec_01 - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Acc_VRec_01 - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is absent.
+       begin
+          declare
+             type Acc_VRec_02 is access 
+               VRec_Of_VRec_02(11);                  -- No Constraint_Error 
+                                                     -- raised for either
+             VObj_11 :  Acc_VRec_02;                 -- declaration.
+ 
+          begin
+             VObj_11 := new VRec_Of_VRec_02(11);
+             if VObj_11.all /= (11, 0) then
+                Report.Comment ("VObj_11 - wrong values");
+             end if;
+          end;
+ 
+       exception
+          when others =>
+               Report.Failed ("Acc_VRec_02 - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is present.
+       begin
+          declare
+             type Acc_VRec_03 is access 
+               VRec_Of_MyArr_02;                    -- No Constraint_Error 
+                                                    -- raised for either
+             VObj_12 : Acc_VRec_03;                 -- declaration.
+          begin
+             VObj_12 := new VRec_Of_MyArr_02
+                            (Report.Ident_Int(0)); -- Constraint_Error raised.
+ 
+             Report.Failed ("VObj_12 - Constraint_Error should be raised");
+             if VObj_12.all /= (1, (1, 1)) then
+                Report.Comment ("VObj_12 - Shouldn't get here");
+             end if;
+        
+          exception
+             when Constraint_Error =>              -- Exception expected.
+                 null;
+             when others =>
+                 Report.Failed ("VObj_12 - unexpected exception raised");
+          end;
+ 
+       exception
+          when Constraint_Error =>
+               Report.Failed ("Acc_VRec_03 - Constraint_Error raised");
+          when others =>
+               Report.Failed ("Acc_VRec_03 - unexpected exception raised");
+       end;
+ 
+       ---------------------------------------------------------
+       -- Component containing the constraint is absent.
+       begin
+          declare
+             type Acc_VRec_04 is access 
+               VRec_Of_MyArr_02(11);                 -- No Constraint_Error 
+                                                     -- raised for either
+             VObj_13 :  Acc_VRec_04;                 -- declaration.
+                     
+          begin
+             VObj_13 := new VRec_Of_MyArr_02(11);
+             if VObj_13.all /= (11, 0) then
+                Report.Comment ("VObj_13 - wrong values");
+             end if;
+          end;
+ 
+       exception
+          when others =>
+               Report.Failed ("Acc_VRec_04 - unexpected exception raised");
+       end;
+ 
+    end;
+ 
+    Report.Result;
+ 
+ exception
+      when others =>
+           Report.Failed ("Discriminant value checked too soon");
+           Report.Result;
+ 
+ end C371003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37102b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37102b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37102b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37102b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C37102B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT, FOR A RECORD TYPE, THE IDENTIFIER FOR A DISCRIMINANT 
+ -- CAN BE USED AS A SELECTED COMPONENT IN AN INDEX OR DISCRIMINANT 
+ -- CONSTRAINT, AS THE NAME OF A DISCRIMINANT IN A DISCRIMINANT 
+ -- SPECIFICATION, AND AS THE PARAMETER NAME IN A FUNCTION CALL IN A 
+ -- DISCRIMINANT OR INDEX CONSTRAINT.
+ 
+ -- R.WILLIAMS 8/25/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37102B IS
+      
+ BEGIN
+      TEST ( "C37102B", "CHECK THAT, FOR A RECORD TYPE, THE " &
+                        "IDENTIFIER FOR A DISCRIMINANT CAN BE USED " &
+                        "AS A SELECTED COMPONENT IN AN INDEX OR " &
+                        "DISCRIMINANT CONSTRAINT, AS THE NAME OF A " &
+                        "DISCRIMINANT IN A DISCRIMINANT " &
+                        "SPECIFICATION, AND AS THE PARAMETER NAME " &
+                        "IN A FUNCTION CALL IN A DISCRIMINANT OR " &
+                        "INDEX CONSTRAINT" );
+ 
+      DECLARE
+ 
+           FUNCTION F (D : INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (D);
+           END F;
+ 
+           PACKAGE P IS
+ 
+                TYPE D IS NEW INTEGER;
+           
+                TYPE REC1 IS
+                     RECORD
+                          D : INTEGER := IDENT_INT (1);
+                     END RECORD;
+ 
+                G : REC1;
+ 
+                TYPE REC2 (D : INTEGER := 3) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                H : REC2 (IDENT_INT (5));
+ 
+                TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+                TYPE Q (D : INTEGER := 0) IS
+                     RECORD
+                          J : REC2 (D => H.D);
+                          K : ARR (G.D .. F (D => 5));
+                          L : REC2 (F (D => 4));
+                     END RECORD;
+                
+           END P;
+ 
+           USE P;
+ 
+      BEGIN
+           DECLARE
+                R : Q;
+           
+           BEGIN
+                IF R.J.D /= 5 THEN
+                     FAILED ( "INCORRECT VALUE FOR R.J" );
+                END IF;
+                
+                IF R.K'FIRST /= 1 THEN
+                     FAILED ( "INCORRECT VALUE FOR R.K'FIRST" );
+                END IF;
+ 
+                IF R.K'LAST /= 5 THEN
+                     FAILED ( "INCORRECT VALUE FOR R.K'LAST" );
+                END IF;
+ 
+                IF R.L.D /= 4 THEN
+                     FAILED ( "INCORRECT VALUE FOR R.L" );
+                END IF;
+           END;
+         
+      END;
+ 
+      RESULT;
+ END C37102B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37103a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37103a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37103a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C37103A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DISCRIMINANTS MAY BE BOOLEAN, CHARACTER, USER_ENUM,
+ -- INTEGER, DERIVED CHARACTER, DERIVED USER_ENUM, DERIVED INTEGER,
+ -- AND DERIVED DERIVED USER_ENUM.
+ 
+ -- DAT 5/18/81
+ -- SPS 10/25/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C37103A IS
+ BEGIN
+      TEST ("C37103A", "MANY DIFFERENT DISCRIMINANT TYPES");
+      DECLARE
+           PACKAGE P1 IS
+                TYPE ENUM IS (A, Z, Q, 'W', 'A');
+           END P1;
+ 
+           PACKAGE P2 IS
+                TYPE E2 IS NEW P1.ENUM;
+           END P2;
+ 
+           PACKAGE P3 IS
+                TYPE E3 IS NEW P2.E2;
+           END P3;
+ 
+           USE P1, P2, P3;
+           TYPE INT IS NEW INTEGER RANGE -3 .. 7;
+           TYPE CHAR IS NEW CHARACTER;
+           TYPE R1 (D : ENUM) IS RECORD NULL; END RECORD;
+           TYPE R2 (D : INTEGER) IS RECORD NULL; END RECORD;
+           TYPE R3 (D : BOOLEAN) IS RECORD NULL; END RECORD;
+           TYPE R4 (D : CHARACTER) IS RECORD NULL; END RECORD;
+           TYPE R5 (D : CHAR) IS RECORD NULL; END RECORD;
+           TYPE R6 (D : E2) IS RECORD NULL; END RECORD;
+           TYPE R7 (D : E3) IS RECORD NULL; END RECORD;
+           TYPE R8 (D : INT) IS RECORD NULL; END RECORD;
+           O1 : R1(A) := (D => A);
+           O2 : R2(3) := (D => 3);
+           O3 : R3(TRUE) := (D => TRUE);
+           O4 : R4(ASCII.NUL) := (D => ASCII.NUL);
+           O5 : R5('A') := (D => 'A');
+           O6 : R6('A') := (D => 'A');
+           O7 : R7(A) := (D => A);
+           O8 : R8(2) := (D => 2);
+      BEGIN
+           IF O1.D /= A
+           OR O2.D /= 3
+           OR NOT O3.D
+           OR O4.D IN 'A' .. 'Z'
+           OR O5.D /= 'A'
+           OR O6.D /= 'A'
+           OR O7.D /= A
+           OR O8.D /= 2
+           THEN FAILED ("WRONG DISCRIMINANT VALUE");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C37103A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37105a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37105a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37105a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,55 ----
+ -- C37105A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT RECORDS WITH ONLY DISCRIMINANTS ARE OK.
+ 
+ -- DAT 5/18/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C37105A IS
+ BEGIN
+      TEST ("C37105A", "RECORDS WITH ONLY DISCRIMINANTS");
+ 
+      DECLARE
+           TYPE R1 (D : BOOLEAN) IS RECORD
+                NULL; END RECORD;
+           TYPE R2 (D, E : BOOLEAN) IS RECORD
+                NULL; END RECORD;
+           TYPE R3 (A,B,C,D : INTEGER; W,X,Y,Z : CHARACTER) IS
+                RECORD NULL; END RECORD;
+           OBJ1 : R1 (IDENT_BOOL(TRUE));
+           OBJ2 : R2 (IDENT_BOOL(FALSE), IDENT_BOOL(TRUE));
+           OBJ3 : R3 (1,2,3,4,'A','B','C',IDENT_CHAR('D'));
+      BEGIN
+           IF OBJ1 = (D => (FALSE))
+           OR OBJ2 /= (FALSE, (TRUE))
+           OR OBJ3 /= (1,2,3,4,'A','B','C',('D'))
+           THEN FAILED ("DISCRIMINANT-ONLY RECORDS DON'T WORK");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C37105A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37107a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37107a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37107a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,154 ----
+ -- C37107A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A DEFAULT DISCRIMINANT EXPRESSION NEED NOT BE STATIC AND
+ -- IS EVALUATED ONLY WHEN NEEDED.
+ 
+ -- R.WILLIAMS 8/25/86
+ -- GMT        6/29/87  ADDED INTEGER ARGUMENT TO THE FUNCTION F.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37107A IS
+ 
+      FUNCTION  F (  B : BOOLEAN;
+                     I : INTEGER  ) RETURN INTEGER IS
+      BEGIN
+           IF NOT B THEN
+                FAILED ( "DEFAULT DISCRIMINANT EVALUATED " &
+                         "UNNECESSARILY - "                &
+                         INTEGER'IMAGE(I)  );
+           END IF;
+ 
+           RETURN IDENT_INT (1);
+      END F;
+ 
+ BEGIN
+      TEST ( "C37107A", "CHECK THAT A DEFAULT DISCRIMINANT " &
+                        "EXPRESSION NEED NOT BE STATIC AND IS " &
+                        "EVALUATED ONLY WHEN NEEDED" );
+ 
+      DECLARE
+           TYPE REC1 (  D : INTEGER := F (TRUE,1)  ) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           R1 : REC1;
+ 
+           TYPE REC2 (  D : INTEGER := F (FALSE,2)  ) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           R2 : REC2 (D => 0);
+ 
+      BEGIN
+           IF R1.D /= 1 THEN
+                FAILED ( "INCORRECT VALUE FOR R1.D" );
+           END IF;
+ 
+           IF R2.D /= 0 THEN
+                FAILED ( "INCORRECT VALUE FOR R2.D" );
+           END IF;
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE PRIV IS
+                TYPE REC3 (  D : INTEGER := F (TRUE,3)  ) IS PRIVATE;
+                TYPE REC4 (  D : INTEGER := F (FALSE,4) ) IS PRIVATE;
+ 
+           PRIVATE
+                TYPE REC3 (  D : INTEGER := F (TRUE,3)  ) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TYPE REC4 (  D : INTEGER := F (FALSE,4)  ) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PRIV;
+ 
+           USE PRIV;
+ 
+      BEGIN
+           DECLARE
+                R3 : REC3;
+                R4 : REC4 (D => 0);
+ 
+           BEGIN
+                IF R3.D /= 1 THEN
+                     FAILED ( "INCORRECT VALUE FOR R3.D" );
+                END IF;
+ 
+                IF R4.D /= 0 THEN
+                     FAILED ( "INCORRECT VALUE FOR R4.D" );
+                END IF;
+           END;
+ 
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE LPRIV IS
+                TYPE  REC5
+                      (  D : INTEGER := F (TRUE,5)  ) IS LIMITED PRIVATE;
+                TYPE  REC6
+                      (  D : INTEGER := F (FALSE,6) ) IS LIMITED PRIVATE;
+ 
+           PRIVATE
+                TYPE REC5 (  D : INTEGER := F (TRUE,5)  ) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TYPE REC6 (  D : INTEGER := F (FALSE,6) ) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END LPRIV;
+ 
+           USE LPRIV;
+ 
+      BEGIN
+           DECLARE
+                R5 : REC5;
+                R6 : REC6 (D => 0);
+ 
+           BEGIN
+                IF R5.D /= 1 THEN
+                     FAILED ( "INCORRECT VALUE FOR R5.D" );
+                END IF;
+ 
+                IF R6.D /= 0 THEN
+                     FAILED ( "INCORRECT VALUE FOR R6.D" );
+                END IF;
+           END;
+ 
+      END;
+ 
+      RESULT;
+ END C37107A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37108b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37108b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37108b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,247 ----
+ -- C37108B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IN AN OBJECT DECLARATION IF
+ -- A DEFAULT INITIAL VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE 
+ -- CONSTRAINTS OF A RECORD OR AN ARRAY TYPE WHOSE CONSTRAINT
+ -- DEPENDS ON A DISCRIMINANT, AND NO EXPLICIT INITIALIZATION IS
+ -- PROVIDED FOR THE OBJECT.
+ 
+ -- R.WILLIAMS 8/25/86
+ -- EDS        7/16/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37108B IS
+      
+      TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+ 
+      TYPE R (P : POSITIVE) IS
+           RECORD
+                NULL;
+           END RECORD;
+      
+ BEGIN
+      TEST ( "C37108B", "CHECK THAT CONSTRAINT_ERROR IS RAISED IN " &
+                        "AN OBJECT DECLARATION IF A DEFAULT INITIAL " &
+                        "VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE " &
+                        "CONSTRAINTS OF A RECORD OR AN ARRAY TYPE " &
+                        "WHOSE CONSTRAINT DEPENDS ON A DISCRIMINANT, " &
+                        "AND NO EXPLICIT INITIALIZATION IS PROVIDED " &
+                        "FOR THE OBJECT" );
+ 
+ 
+      BEGIN
+           DECLARE     
+                TYPE REC1 (D : NATURAL := IDENT_INT (0)) IS
+                     RECORD
+                          A : ARR (D .. 5);
+                     END RECORD;
+                
+           BEGIN
+                DECLARE 
+                     R1 : REC1;
+                     
+                BEGIN
+                     R1.A (1) := IDENT_INT (2);
+                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
+                              "R1" & INTEGER'IMAGE(R1.A(5)));  --USE R2
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION FOR R1 RAISED INSIDE " &
+                                   "BLOCK" );
+                END;
+      
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF R1" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                         "DECLARATION OF REC1" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                         "DECLARATION OF REC1" );
+      END;
+      
+      BEGIN
+           DECLARE     
+                TYPE REC2 (D : INTEGER := IDENT_INT (-1)) IS
+                     RECORD
+                          A : R (P => D);
+                     END RECORD;
+                
+           BEGIN
+                DECLARE 
+                     R2 : REC2;
+                     
+                BEGIN
+                     R2.A := R'(P => IDENT_INT (1));
+                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
+                              "R2" & INTEGER'IMAGE(R2.A.P));  --USE R2
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION FOR R2 RAISED INSIDE " &
+                                   "BLOCK" );
+                END;
+      
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF R2" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                         "DECLARATION OF REC2" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                         "DECLARATION OF REC2" );
+      END;
+ 
+      BEGIN
+           DECLARE     
+                PACKAGE PRIV IS
+                     TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS 
+                          PRIVATE;
+                     PROCEDURE PROC (R :REC3);
+                          
+                PRIVATE
+                     TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS
+                          RECORD
+                               A : R (P => D);
+                          END RECORD;
+                END PRIV;
+                
+                PACKAGE BODY PRIV IS
+                     PROCEDURE PROC (R : REC3) IS
+                          I : INTEGER;
+                     BEGIN
+                          I := IDENT_INT (R.A.P);
+                          IF EQUAL(2, IDENT_INT(1)) THEN
+                               FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
+                          END IF;
+                     END PROC;
+                END PRIV;
+ 
+                USE PRIV;
+                
+           BEGIN
+                DECLARE 
+                     R3 : REC3;
+                     
+                BEGIN
+                     PROC (R3);
+                     FAILED ( "NO EXCEPTION RAISED AT " &
+                               "DECLARATION OF R3" );
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION FOR R3 RAISED INSIDE " &
+                                   "BLOCK" );
+                END;
+      
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF R3" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                         "DECLARATION OF REC3" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                         "DECLARATION OF REC3" );
+      END;
+ 
+      BEGIN
+           DECLARE     
+                PACKAGE LPRIV IS
+                     TYPE REC4 (D : NATURAL := IDENT_INT (0))
+                          IS LIMITED PRIVATE;
+                     PROCEDURE PROC (R :REC4);
+                          
+                PRIVATE
+                     TYPE REC4 (D : NATURAL := IDENT_INT (0)) IS
+                          RECORD
+                               A : ARR (D .. 5);
+                          END RECORD;
+                END LPRIV;
+                
+                PACKAGE BODY LPRIV IS
+                     PROCEDURE PROC (R : REC4) IS
+                          I : INTEGER;
+                     BEGIN
+                          I := IDENT_INT (R.A'FIRST);
+                          IF EQUAL(2, IDENT_INT(1)) THEN
+                               FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
+                          END IF;
+                     END PROC;
+                END LPRIV;
+ 
+                USE LPRIV;
+                
+           BEGIN
+                DECLARE 
+                     R4 : REC4;
+                     
+                BEGIN
+                     PROC (R4);
+                     FAILED ( "NO EXCEPTION RAISED AT " &
+                              "DECLARATION OF R4" );
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION FOR R4 RAISED INSIDE " &
+                                   "BLOCK" );
+                END;
+      
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF R4" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                         "DECLARATION OF REC4" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                         "DECLARATION OF REC4" );
+      END;
+ 
+      RESULT;
+ END C37108B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37206a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37206a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37206a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- C37206A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR A TYPE WITHOUT DEFAULT DISCRIMINANT VALUES (BUT WITH
+ --     DISCRIMINANTS) CHECK THAT A TYPEMARK WHICH DENOTES SUCH AN
+ --     UNCONSTRAINED TYPE CAN BE USED IN:
+ 
+ --      1) A SUBTYPE DECLARATION, AND THE SUBTYPE NAME ACTS SIMPLY AS A
+ --         NEW NAME FOR THE UNCONSTRAINED TYPE;
+ --      2) IN A CONSTANT DECLARATION.
+ 
+ -- HISTORY:
+ --     AH  08/21/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     DTN 11/13/91 DELETED SUBPARTS (2 and 3).
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37206A IS
+ BEGIN
+ 
+      TEST ("C37206A", "FOR TYPE WITH DEFAULT-LESS DISCRIMINANTS, " &
+            "UNCONSTRAINED TYPE_MARK CAN BE USED IN A SUBTYPE " &
+            "DECLARATION OR IN A CONSTANT DECLARATION");
+ 
+      DECLARE
+           TYPE REC(DISC : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           SUBTYPE ST IS REC;                               -- 1.
+ 
+           C1 : CONSTANT REC := (DISC => 5);                -- 2.
+           C2 : CONSTANT REC := (DISC => IDENT_INT(5));     -- 2.
+      BEGIN
+ 
+           IF C1 /= C2 OR C1 /= (DISC => 5) THEN
+                FAILED ("CONSTANT DECLARATIONS INCORRECT");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C37206A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37207a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37207a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37207a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,230 ----
+ -- C37207A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ 
+ --     FOR A TYPE WITH OR WITHOUT DEFAULT DISCRIMINANT VALUES, CHECK
+ --     THAT A DISCRIMINANT CONSTRAINT CAN BE SUPPLIED IN THE FOLLOWING
+ --     CONTEXTS AND HAS THE PROPER EFFECT:
+ 
+ --     IN A 1) OBJECT_DECLARATION, 2) COMPONENT_DECLARATION OR
+ --     3) SUBTYPE INDICATION OF AN ARRAY_TYPE_DEFINITION, AND HENCE,
+ --     ASSIGNMENTS CANNOT ATTEMPT TO CHANGE THE SPECIFIED DISCRIMINANT
+ --     VALUES WITHOUT RAISING CONSTRAINT_ERROR
+ 
+ --     4) IN AN ACCESS_TYPE_DEFINITION, AND HENCE, ACCESS VALUES
+ --     OF THIS ACCESS TYPE CANNOT BE ASSIGNED NON-NULL VALUES
+ --     DESIGNATING OBJECTS WITH DIFFERENT DISCRIMINANT VALUES.
+ 
+ --     5) IN AN ALLOCATOR, AND THE ALLOCATED OBJECT HAS THE SPECIFIED
+ --     DISCRIMINANT VALUES.
+ 
+ --     6) IN A FORMAL PARAMETER DECLARATION OF A SUBPROGRAM, AND
+ --     HENCE, ASSIGNMENTS TO THE FORMAL PARAMETER CANNOT ATTEMPT TO
+ --     CHANGE THE DISCRIMINANT VALUES WITHOUT RAISING CONSTRAINT_ERROR,
+ --     CONSTRAINED IS TRUE, AND IF ACTUAL PARAMETERS HAVE DISCRIMINANT
+ --     VALUES DIFFERENT FROM THE SPECIFIED ONES, CONSTRAINT_ERROR IS
+ --     RAISED.
+ 
+ -- HISTORY:
+ 
+ --     ASL 07/24/81
+ --     RJW 08/28/86  CORRECTED SYNTAX ERRORS.
+ --     JLH 08/07/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
+ --     EDS 07/16/98  AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37207A IS
+ 
+ BEGIN
+      TEST ("C37207A","DISCRIMINANT CONSTRAINT CAN BE SUPPLIED TO " &
+           "DECLARATIONS AND DEFINITIONS USING TYPES WITH OR WITHOUT " &
+           "DEFAULT DISCRIMINANT VALUES");
+ 
+      DECLARE
+           TYPE REC1 (DISC : INTEGER := 5) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE REC2 (DISC : INTEGER) IS
+                RECORD
+                     NULL;
+                 END RECORD;
+ 
+           OBJ1 : REC1(6);                     -- 1.
+           OBJ2 : REC2(6);                     -- 1.
+           BADOBJ1 : REC1(7);                  -- 1.
+           BADOBJ2 : REC2(7);                  -- 1.
+ 
+           TYPE REC3 IS
+                RECORD
+                     COMP1 : REC1(6);          -- 2.
+                     COMP2 : REC2(6);          -- 2.
+                END RECORD;
+ 
+           OBJ3 : REC3;
+ 
+           TYPE ARR1 IS ARRAY (1..10) OF REC1(6);  -- 3.
+           TYPE ARR2 IS ARRAY (1..10) OF REC2(6);  -- 3.
+ 
+           A1 : ARR1;
+           A2 : ARR2;
+ 
+           TYPE REC1_NAME IS ACCESS REC1(6);   -- 4.
+           TYPE REC2_NAME IS ACCESS REC2(6);   -- 4.
+ 
+           ACC1 : REC1_NAME;
+           ACC2 : REC2_NAME;
+ 
+           SUBTYPE REC16 IS REC1(6);
+           SUBTYPE REC26 IS REC2(6);
+ 
+           PROCEDURE PROC (P1 : IN OUT REC16;     -- 6.
+                          P2 : IN OUT REC26) IS  -- 6.
+           BEGIN
+                IF NOT (P1'CONSTRAINED AND P2'CONSTRAINED) THEN  -- 6.
+                     FAILED ("'CONSTRAINED ATTRIBUTE INCORRECT FOR " &
+                             "CONSTRAINED FORMAL PARAMETERS");
+                END IF;
+                BEGIN
+                     P1 := (DISC => 7);         -- 6.
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                             "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                             "CONSTRAINED FORMAL PARAMETER " &                                                                                  
+                             INTEGER'IMAGE(P1.DISC));
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR => NULL;
+                     WHEN OTHERS => FAILED ("WRONG EXCEPTION     (1)");
+                END;
+                BEGIN
+                     P2 := (DISC => 7);         -- 6.
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                             "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                             "CONSTRAINED FORMAL PARAMETER " & 
+                             INTEGER'IMAGE(P2.DISC));
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR => NULL;
+                     WHEN OTHERS => FAILED ("WRONG EXCEPTION     (2)");
+                END;
+           END PROC;
+      BEGIN
+ ---------------------------------------------------------------
+ 
+           BEGIN
+                OBJ1 := (DISC => IDENT_INT(7));           -- 1.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                        "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                        "CONSTRAINED OBJECT");
+                IF OBJ1 = (DISC => 7) THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (3)");
+           END;
+ 
+ ---------------------------------------------------------------
+ 
+           BEGIN
+                OBJ3 := ((DISC => IDENT_INT(7)),      -- 2.
+                         (DISC => IDENT_INT(7)));     -- 2.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                        "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                        "CONSTRAINED RECORD COMPONENT");
+                IF OBJ3 = ((DISC => 7), (DISC => 7)) THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (4)");
+           END;
+ 
+ --------------------------------------------------------------
+ 
+           BEGIN
+                A2(2) := (DISC => IDENT_INT(7));          -- 3.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                        "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                        "CONSTRAINED ARRAY COMPONENT");
+                IF A2(2) = (DISC => 7) THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (5)");
+           END;
+ 
+ --------------------------------------------------------------
+ 
+           BEGIN
+                ACC1 := NEW REC1(DISC => IDENT_INT(7));   -- 4.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                        "ATTEMPT TO ASSIGN INCOMPATIBLE OBJECT " &
+                        "TO ACCESS VARIABLE");
+                IF ACC1 =  NEW REC1(DISC => 7) THEN
+                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+                END IF;
+          EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (6)");
+           END;
+ 
+ ----------------------------------------------------------------
+ 
+                ACC1 := NEW REC1(DISC => IDENT_INT(6));  -- OK.
+ 
+           BEGIN
+                ACC1.ALL := BADOBJ1;           -- 5.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                        "ATTEMPT TO ASSIGN INCOMPATIBLE OBJECT " &
+                        "TO ACCESSED OBJECT");
+                IF ACC1.ALL = BADOBJ1 THEN
+                     COMMENT ("PREVENT DEAD VARIABLE OPTIMIZATION");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (7)");
+           END;
+ 
+ -----------------------------------------------------------------
+ 
+                PROC (OBJ1,OBJ2);              -- OK.
+ 
+           BEGIN
+                PROC (BADOBJ1,BADOBJ2);        -- 6.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                        "PASSING OF CONSTRAINED ACTUAL " &
+                        "PARAMETERS TO DIFFERENTLY CONSTRAINED " &
+                        "FORMAL PARAMETERS");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION     (8)");
+           END;
+ 
+ ---------------------------------------------------------------
+      END;
+ 
+      RESULT;
+ END C37207A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37208a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37208a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37208a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37208a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,172 ----
+ -- C37208A.ADA     (RA #534/1)
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A TYPE WITH DEFAULT DISCRIMINANT VALUES, CHECK THAT A
+ -- DISCRIMINANT CONSTRAINT CAN BE OMITTED IN:
+  
+      -- AN OBJECT DECLARATION, AND HENCE ASSIGNMENTS TO THE OBJECT CAN 
+      -- CHANGE ITS DISCRIMINANTS;
+  
+      -- A COMPONENT_DECLARATION IN A RECORD TYPE DEFINITION, AND HENCE
+      -- ASSIGNMENTS TO THE COMPONENT CAN CHANGE THE VALUE OF ITS
+      -- DISCRIMINANTS;
+  
+      -- A SUBTYPE INDICATION IN AN ARRAY TYPE DEFINITION, AND HENCE
+      -- ASSIGNMENTS TO ONE OF THE COMPONENTS CAN CHANGE ITS 
+      -- DISCRIMINANT VALUES;
+  
+      -- A FORMAL PARAMETER OF A SUBPROGRAM; EXCEPT FOR PARAMETERS OF
+      -- MODE IN, THE 'CONSTRAINED ATTRIBUTE OF THE ACTUAL PARAMETER
+      -- BECOMES THE 'CONSTRAINED ATTRIBUTE OF THE FORMAL PARAMETER;
+      -- FOR IN OUT AND OUT PARAMETERS, IF THE 'CONSTRAINED ATTRIBUTE IS 
+      -- FALSE, ASSIGNMENTS TO THE FORMAL PARAMETER CAN CHANGE THE 
+      -- DISCRIMINANTS OF THE ACTUAL PARAMETER; IF THE 'CONSTRAINED 
+      -- ATTRIBUTE IS TRUE, ASSIGNNMENTS THAT ATTEMPT TO CHANGE THE 
+      -- DISCRIMINANTS OF THE ACTUAL PARAMETER RAISE CONSTRAINT_ERROR.
+  
+ -- ASL 7/23/81
+ -- EDS 7/16/98    AVOID OPTIMIZATION
+  
+ WITH REPORT;
+ PROCEDURE C37208A IS
+  
+      USE REPORT;
+  
+ BEGIN
+      TEST ("C37208A","DISCRIMINANT CONSTRAINT CAN BE OMITTED " &
+            "FROM OBJECT DECLARATION, COMPONENT DECLARATION, SUBTYPE " &
+            "INDICATION OR FORMAL SUBPROGRAM PARAMETER, IF THE TYPE " &
+            "HAS DEFAULT DISCRIMINANTS");
+  
+      DECLARE
+           TYPE REC1(DISC : INTEGER := 7) IS
+                RECORD
+                     NULL;
+                END RECORD;
+  
+           TYPE REC2 IS
+                RECORD
+                     COMP : REC1;
+                END RECORD;
+  
+           R : REC2;
+           U1,U2,U3 : REC1 := (DISC => 3);
+           C1,C2,C3 : REC1(3) := (DISC => 3);
+           ARR : ARRAY(INTEGER RANGE 1..10) OF REC1;
+           ARR2 : ARRAY (1..10) OF REC1(4);
+  
+           PROCEDURE PROC(P_IN : IN REC1;
+                          P_OUT : OUT REC1;
+                          P_IN_OUT : IN OUT REC1;
+                          CONSTR : IN BOOLEAN) IS
+           BEGIN
+                IF P_OUT'CONSTRAINED /= CONSTR
+                     OR P_IN_OUT'CONSTRAINED /= CONSTR THEN
+                     FAILED ("CONSTRAINED ATTRIBUTES DO NOT MATCH " &
+                               "FOR ACTUAL AND FORMAL PARAMETERS");
+                END IF;
+ 
+                IF P_IN'CONSTRAINED /= IDENT_BOOL(TRUE) THEN
+                     FAILED ("'CONSTRAINED IS FALSE FOR IN " &
+                             "PARAMETER");
+                END IF;
+  
+                IF NOT CONSTR THEN     -- UNCONSTRAINED ACTUAL PARAM
+                     P_OUT := (DISC => IDENT_INT(0));
+                     P_IN_OUT := (DISC => IDENT_INT(0));
+                ELSE
+                     BEGIN
+                          P_OUT := (DISC => IDENT_INT(0));
+                          FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
+                                  "PARAMETER ILLEGALLY CHANGED - 1");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION - 1");
+                     END;
+ 
+                     BEGIN
+                          P_IN_OUT := (DISC => IDENT_INT(0));
+                          FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
+                                  "PARAMETER ILLEGALLY CHANGED - 2");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR => NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION - 2");
+                     END;
+                END IF;
+           END PROC;
+      BEGIN
+           IF U1.DISC /= IDENT_INT(3) THEN
+                FAILED ("INITIAL DISCRIMINANT VALUE WRONG - U1");
+           END IF;
+ 
+           U1 := (DISC => IDENT_INT(5));
+           IF U1.DISC /= 5 THEN
+                FAILED ("ASSIGNMENT FAILED FOR OBJECT");
+           END IF;
+  
+           IF R.COMP.DISC /= IDENT_INT(7) THEN
+                FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - R");
+           END IF;
+ 
+           R.COMP := (DISC => IDENT_INT(5));
+           IF R.COMP.DISC /= 5 THEN
+                FAILED ("ASSIGNMENT FAILED FOR RECORD COMPONENT");
+           END IF;
+  
+           FOR I IN 1..10 LOOP
+                IF ARR(I).DISC /= IDENT_INT(7) THEN
+                     FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - ARR");
+                END IF;
+           END LOOP;
+ 
+           ARR(3) := (DISC => IDENT_INT(5));
+           IF ARR(3).DISC /= 5 THEN
+                FAILED ("ASSIGNMENT FAILED FOR ARRAY COMPONENT");
+           END IF;
+  
+           IF ARR /= (1..2|4..10 => (DISC => 7), 3 => (DISC => 5)) THEN
+                FAILED ("MODIFIED WRONG COMPONENTS");
+           END IF;
+ 
+           PROC(C1,C2,C3,IDENT_BOOL(TRUE));
+           PROC(U1,U2,U3,IDENT_BOOL(FALSE));
+           IF U2.DISC /= 0 OR U3.DISC /= 0 THEN
+                FAILED ("ASSIGNMENT TO UNCONSTRAINED ACTUAL PARAMETER " &
+                        "FAILED TO CHANGE DISCRIMINANT");
+           END IF;
+ 
+           PROC(ARR(1), ARR(3), ARR(4), FALSE);
+           IF ARR(3).DISC /= 0 OR ARR(4).DISC /= 0 THEN
+                FAILED ("ARRAY COMPONENT ASSIGNMENTS DIDN'T CHANGE " &
+                        "DISCRIMINANT OF COMPONENT");
+           END IF;
+ 
+           PROC (ARR2(2), ARR2(5), ARR2(10), TRUE);
+      END;
+  
+      RESULT;
+ END C37208A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37208b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37208b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37208b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37208b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C37208B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A TYPE WITH DEFAULT DISCRIMINANT VALUES, CHECK THAT A
+ -- DISCRIMINANT CONSTRAINT CAN BE OMITTED IN A GENERIC FORMAL
+ -- PARAMETER, AND HENCE, FOR BOTH IN AND IN OUT PARAMETERS, THE
+ -- 'CONSTRAINED ATTRIBUTE OF THE ACTUAL PARAMETER BECOMES THE
+ -- 'CONSTRAINED ATTRIBUTE OF THE FORMAL PARAMETER, AND, FOR IN
+ -- OUT PARAMETERS, IF THE 'CONSTRAINED ATTRIBUTE IS FALSE,
+ -- ASSIGNMENTS TO THE FORMAL PARAMETERS CAN CHANGE THE
+ -- DISCRIMINANTS OF THE ACTUAL PARAMETER; IF THE 'CONSTRAINED
+ -- ATTRIBUTE IS  TRUE, ASSIGNMENTS THAT ATTEMPT TO CHANGE THE
+ -- DISCRIMINANTS OF THE ACTUAL PARAMETER RAISE CONSTRAINT_ERROR.
+  
+ -- ASL 7/29/81
+ -- VKG 1/20/83
+ -- EDS 7/16/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ PROCEDURE C37208B IS
+  
+      USE REPORT;
+  
+ BEGIN
+      TEST ("C37208B","FOR TYPES WITH DEFAULT DISCRIMINANT " &
+             "VALUES, DISCRIMINANT CONSTRAINTS CAN BE OMITTED " &
+             "IN GENERIC FORMAL PARAMETERS, AND THE " &
+             "'CONSTRAINED ATTRIBUTE HAS CORRECT VALUES " &
+             "DEPENDING ON THE ACTUAL PARAMETERS");
+  
+      DECLARE
+           TYPE REC(DISC : INTEGER := 7) IS
+                RECORD
+                     NULL;
+                END RECORD;
+  
+           KC : CONSTANT REC(3) := (DISC => 3);
+           KU : CONSTANT REC := (DISC => 3);
+           OBJC1,OBJC2 : REC(3) := (DISC => 3);
+           OBJU1,OBJU2 : REC := (DISC => 3);
+  
+           GENERIC
+                P_IN1 : REC;
+                P_IN2 : REC;
+                P_IN_OUT : IN OUT REC;
+                STATUS : BOOLEAN;
+           PROCEDURE PROC;
+ 
+           PROCEDURE PROC IS
+           BEGIN
+ 
+                IF P_IN1'CONSTRAINED /= TRUE  OR
+                   P_IN2'CONSTRAINED /= TRUE  OR
+                   P_IN_OUT'CONSTRAINED /= STATUS
+                THEN
+ 
+                     FAILED ("'CONSTRAINED ATTRIBUTES DO NOT MATCH " &
+                             "FOR ACTUAL AND FORMAL PARAMETERS");
+                END IF;
+                IF NOT STATUS THEN
+                     BEGIN
+                          P_IN_OUT := (DISC => IDENT_INT(7));
+                     EXCEPTION 
+                          WHEN OTHERS =>
+                               FAILED ("EXCEPTION RAISED " &
+                                       "WHEN TRYING TO " &
+                                       "CHANGE UNCONSTRAINED " &
+                                       "DISCRIMINANT VALUE");
+                     END;
+                ELSE
+                     BEGIN
+                          P_IN_OUT := (DISC => IDENT_INT(7));
+                          FAILED ("DISCRIMINANT OF CONSTRAINED " &
+                                  "ACTUAL PARAMETER ILLEGALLY " &
+                                  "CHANGED BY ASSIGNMENT");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR => NULL;     
+                          WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+                     END;
+                END IF;
+           END PROC;
+ 
+      BEGIN
+ 
+           DECLARE
+                PROCEDURE PROC_C IS NEW PROC(KC,OBJC1,OBJC2,IDENT_BOOL(TRUE));
+                PROCEDURE PROC_U IS NEW PROC(KU,OBJU1,OBJU2,IDENT_BOOL(FALSE));
+           BEGIN
+                PROC_C;
+                PROC_U;
+                IF OBJU2.DISC /= 7 THEN
+                FAILED ("ASSIGNMENT TO UNCONSTRAINED ACTUAL " &
+                        "PARAMETER FAILED TO CHANGE DISCRIMINANT ");
+                END IF;
+           END;
+ 
+      END;
+      RESULT;
+ END C37208B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37209a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37209a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37209a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37209a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C37209A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR A CONSTANT OBJECT 
+ -- DECLARATION WHOSE SUBTYPE INDICATION SPECIFIES AN UNCONSTRAINED
+ -- TYPE WITH DEFAULT DISCRIMINANT VALUES AND WHOSE INITIALIZATION
+ -- EXPRESSION SPECIFIES A VALUE WHOSE DISCRIMINANTS ARE NOT EQUAL TO
+ -- THE DEFAULT VALUE.
+ 
+ -- R.WILLIAMS 8/25/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37209A IS
+      
+ BEGIN
+      TEST ( "C37209A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+                        "FOR A CONSTANT OBJECT DECLARATION WHOSE " &
+                        "SUBTYPE INDICATION SPECIFIES AN " &
+                        "UNCONSTRAINED TYPE WITH DEFAULT " &
+                        "DISCRIMINANT VALUES AND WHOSE " &
+                        "INITIALIZATION EXPRESSION SPECIFIES A VALUE " &
+                        "WHOSE DISCRIMINANTS ARE NOT EQUAL TO THE " &
+                        "DEFAULT VALUE" );
+      DECLARE
+ 
+           TYPE REC1 (D : INTEGER := IDENT_INT (5)) IS
+                RECORD
+                     NULL;
+                END RECORD;
+                
+      BEGIN
+           DECLARE 
+                R1 : CONSTANT REC1 := (D => IDENT_INT (10));     
+           BEGIN
+                COMMENT ( "NO EXCEPTION RAISED AT DECLARATION OF R1" );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
+                         "R1" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
+                         "R1" );
+      END;          
+      
+ 
+      BEGIN
+           DECLARE     
+                PACKAGE PRIV IS
+                     TYPE REC2 (D : INTEGER:= IDENT_INT (5)) IS PRIVATE;
+                     R2 : CONSTANT REC2;
+ 
+                PRIVATE
+                     TYPE REC2 (D : INTEGER := IDENT_INT (5)) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+ 
+                     R2 : CONSTANT REC2 := (D => IDENT_INT (10));
+                END PRIV;
+           
+                USE PRIV;
+                
+           BEGIN
+                DECLARE 
+                     I : INTEGER := R2.D;                    
+                BEGIN
+                     COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
+                               "OF R2" );
+               END;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
+                          "R2" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                         "OF R2" );
+      END;
+ 
+      BEGIN
+           DECLARE     
+                PACKAGE LPRIV IS
+                     TYPE REC3 (D : INTEGER:= IDENT_INT (5)) IS 
+                          LIMITED PRIVATE;
+ 
+                     R3 : CONSTANT REC3;
+ 
+                PRIVATE
+                     TYPE REC3 (D : INTEGER := IDENT_INT (5)) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+ 
+                     R3 : CONSTANT REC3 := (D => IDENT_INT (10));
+                END LPRIV;
+           
+                USE LPRIV;
+ 
+           BEGIN
+                DECLARE
+                     I : INTEGER;
+                BEGIN
+                     I := R3.D;
+                     COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
+                               "OF R3" );
+               END;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
+                          "R3" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                         "OF R3" );
+      END;
+ 
+      RESULT;
+ END C37209A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37209b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37209b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37209b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37209b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,194 ----
+ -- C37209B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE SUBTYPE
+ --     INDICATION IN A CONSTANT OBJECT DECLARATION SPECIFIES A
+ --     CONSTRAINED SUBTYPE WITH DISCRIMINANTS AND THE INITIALIZATION
+ --     VALUE DOES NOT BELONG TO THE SUBTYPE (I. E., THE DISCRIMINANT
+ --     VALUE DOES NOT MATCH THOSE SPECIFIED BY THE CONSTRAINT).
+ 
+ -- HISTORY:
+ --     RJW 08/25/86  CREATED ORIGINAL TEST
+ --     VCL 08/19/87  CHANGED THE RETURN TYPE OF FUNTION 'INIT' IN
+ --                   PACKAGE 'PRIV2' SO THAT 'INIT' IS UNCONSTRAINED,
+ --                   THUS NOT RAISING A CONSTRAINT ERROR ON RETURN FROM
+ --                   'INIT'.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37209B IS
+ 
+ BEGIN
+      TEST ( "C37209B", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                        "THE SUBTYPE INDICATION IN A CONSTANT " &
+                        "OBJECT DECLARATION SPECIFIES A CONSTRAINED " &
+                        "SUBTYPE WITH DISCRIMINANTS AND THE " &
+                        "INITIALIZATION VALUE DOES NOT BELONG TO " &
+                        "THE SUBTYPE (I. E., THE DISCRIMINANT VALUE " &
+                        "DOES NOT MATCH THOSE SPECIFIED BY THE " &
+                        "CONSTRAINT)" );
+      DECLARE
+ 
+           TYPE REC (D : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           SUBTYPE REC1 IS REC (IDENT_INT (5));
+      BEGIN
+           DECLARE
+                R1 : CONSTANT REC1 := (D => IDENT_INT (10));
+                I  : INTEGER := IDENT_INT (R1.D);
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED FOR DECLARATION OF " &
+                         "R1" );
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
+                         "R1" );
+      END;
+ 
+ 
+      BEGIN
+           DECLARE
+                PACKAGE PRIV1 IS
+                     TYPE REC (D : INTEGER) IS PRIVATE;
+                     SUBTYPE REC2 IS REC (IDENT_INT (5));
+                     R2 : CONSTANT REC2;
+ 
+                PRIVATE
+                     TYPE REC (D : INTEGER) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+ 
+                     R2 : CONSTANT REC2 := (D => IDENT_INT (10));
+                END PRIV1;
+ 
+                USE PRIV1;
+ 
+           BEGIN
+                DECLARE
+                     I : INTEGER := IDENT_INT (R2.D);
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
+                              "OF R2" );
+               END;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                         "OF R2" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PACKAGE PRIV2 IS
+                     TYPE REC (D : INTEGER) IS PRIVATE;
+                     SUBTYPE REC3 IS REC (IDENT_INT (5));
+ 
+                     FUNCTION INIT (D : INTEGER) RETURN REC;
+                PRIVATE
+                     TYPE REC (D : INTEGER) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+ 
+                END PRIV2;
+ 
+                PACKAGE BODY PRIV2 IS
+                     FUNCTION INIT (D : INTEGER) RETURN REC IS
+                     BEGIN
+                          RETURN (D => IDENT_INT (D));
+                     END INIT;
+                END PRIV2;
+ 
+                USE PRIV2;
+ 
+           BEGIN
+                DECLARE
+                     R3 : CONSTANT REC3 := INIT (10);
+                     I  : INTEGER := IDENT_INT (R3.D);
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
+                              "OF R3" );
+               END;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                         "OF R3" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PACKAGE LPRIV IS
+                     TYPE REC  (D : INTEGER) IS
+                          LIMITED PRIVATE;
+                     SUBTYPE REC4 IS REC (IDENT_INT (5));
+ 
+                     R4 : CONSTANT REC4;
+ 
+                PRIVATE
+                     TYPE REC (D : INTEGER) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+ 
+                     R4 : CONSTANT REC4 := (D => IDENT_INT (10));
+                END LPRIV;
+ 
+                USE LPRIV;
+ 
+           BEGIN
+                DECLARE
+                     I : INTEGER := IDENT_INT (R4.D);
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
+                              "OF R4" );
+               END;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                         "OF R4" );
+      END;
+ 
+      RESULT;
+ END C37209B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37210a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37210a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37210a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C37210A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE EXPRESSION IN A DISCRIMINANT ASSOCIATION WITH MORE 
+ -- THAN ONE NAME IS EVALUATED ONCE FOR EACH NAME.
+ 
+ -- R.WILLIAMS 8/28/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37210A IS
+ 
+      BUMP : INTEGER := IDENT_INT (0);
+ 
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN BUMP;
+      END F;
+ 
+      FUNCTION CHECK (STR : STRING) RETURN INTEGER IS
+      BEGIN
+           IF BUMP /= 2 THEN
+                FAILED ( "INCORRECT DISCRIMINANT VALUES FOR " & STR);
+           END IF;
+           BUMP := IDENT_INT (0);
+           RETURN 5;
+      END CHECK;
+           
+ BEGIN
+      TEST ( "C37210A", "CHECK THAT THE EXPRESSION IN A " &
+                        "DISCRIMINANT ASSOCIATION WITH MORE THAN " &
+                        "ONE NAME IS EVALUATED ONCE FOR EACH NAME" );
+ 
+      DECLARE
+           TYPE REC (D1, D2 : INTEGER) IS
+                RECORD 
+                     NULL;
+                END RECORD;
+ 
+           R : REC (D1 | D2 => F);
+ 
+           I1 : INTEGER := CHECK ( "R" );
+ 
+           TYPE ACC IS ACCESS REC;
+ 
+           AC : ACC (D1 | D2 => F);
+      
+           I2 : INTEGER := CHECK ( "AC" );
+           
+           PACKAGE PKG IS
+                TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE; 
+                TYPE PACC IS ACCESS PRIV;
+ 
+                TYPE LIM (D1, D2 : INTEGER) IS LIMITED PRIVATE;
+                TYPE LACC IS ACCESS LIM;
+ 
+           PRIVATE
+                TYPE PRIV (D1, D2 : INTEGER) IS 
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TYPE LIM (D1, D2 : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PKG;                                  
+           
+           USE PKG;
+ 
+      BEGIN
+ 
+           DECLARE
+                P  : PRIV (D1 | D2 => F);
+                
+                I1 : INTEGER := CHECK ( "P" );
+ 
+                PA : PACC (D1 | D2 => F);
+ 
+                I2 : INTEGER := CHECK ( "PA" );
+ 
+                L  : LIM (D1 | D2 => F);
+           
+                I3 : INTEGER := CHECK ( "L" );
+ 
+                LA : LACC (D1 | D2 => F);
+ 
+                I : INTEGER;
+           BEGIN
+                I := CHECK ( "LA" );
+           END;
+      END;
+ 
+      RESULT;
+ END C37210A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,242 ----
+ -- C37211A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
+ -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+ -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+ -- INDICATIONS WHERE THE TYPE MARK DENOTES A RECORD TYPE.
+ 
+ -- R.WILLIAMS 8/28/86
+ -- EDS        7/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37211A IS
+ 
+      TYPE REC (D : POSITIVE) IS
+           RECORD
+                NULL;
+           END RECORD;
+      
+ BEGIN
+      TEST ( "C37211A", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                        "TYPE MARK DENOTES A RECORD TYPE" );
+                          
+      BEGIN
+           DECLARE
+                SUBTYPE SUBREC IS REC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     SR : SUBREC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF SUBTYPE SUBREC " & INTEGER'IMAGE(SR.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT SR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "SUBTYPE SUBREC" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE ARR IS ARRAY (1 .. 10) OF REC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     AR : ARR;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ARR " & INTEGER'IMAGE(AR(1).D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT AR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ARR" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE REC1 IS 
+                     RECORD
+                          X : REC (IDENT_INT (-1));
+                     END RECORD;
+ 
+           BEGIN
+                DECLARE
+                     R1 : REC1;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1.X.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT R1" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE REC1" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE ACCREC IS ACCESS REC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     ACR : ACCREC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ACCREC " & INTEGER'IMAGE(ACR.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT ACR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ACCREC" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE NEWREC IS NEW REC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     NR : NEWREC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE NEWREC " & INTEGER'IMAGE(NR.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT NR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE NEWREC" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                R : REC (IDENT_INT (-1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                         "R " & INTEGER'IMAGE(R.D));
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                              "CONTAINING R" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                         "R" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE REC_NAME IS ACCESS REC;
+           BEGIN
+                DECLARE
+                     RN : REC_NAME := NEW REC (IDENT_INT (-1));
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "DECLARATION OF OBJECT RN " & INTEGER'IMAGE(RN.D));
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;               
+                WHEN OTHERS => 
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF OBJECT RN" );
+           END;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                         "REC_NAME" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE BAD_REC (D : POSITIVE := IDENT_INT (-1)) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           BEGIN
+                DECLARE
+                     BR : BAD_REC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "DECLARATION OF OBJECT BR " & INTEGER'IMAGE(BR.D));
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;               
+                WHEN OTHERS => 
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF OBJECT BR" );
+           END;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                         "BAD_REC" );
+      END;
+ 
+      RESULT;
+ END C37211A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,495 ----
+ -- C37211B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
+ -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+ -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+ -- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 
+ -- PRIVATE TYPE, AND THE DISCRIMINANT CONSTRAINT OCCURS AFTER THE FULL 
+ -- DECLARATION OF THE TYPE.
+ 
+ -- R.WILLIAMS 8/28/86
+ -- EDS        7/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37211B IS
+ 
+      SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
+      
+      PACKAGE PKG IS
+           TYPE PRIV (L : LIES) IS PRIVATE;
+           TYPE LIM  (L : LIES) IS LIMITED PRIVATE;
+ 
+      PRIVATE
+           TYPE PRIV (L : LIES) IS 
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE LIM (L : LIES) IS
+                RECORD
+                     NULL;
+                END RECORD;
+      END PKG;     
+      
+      USE PKG;
+ 
+ BEGIN
+      TEST ( "C37211B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                        "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
+                        "PRIVATE TYPE, AND THE DISCRIMINANT " &
+                        "CONSTRAINT OCCURS AFTER THE FULL " & 
+                        "DECLARATION OF THE TYPE" );
+                          
+      BEGIN
+           DECLARE
+                SUBTYPE SUBPRIV IS PRIV (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     SP : SUBPRIV;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF SUBTYPE SUBPRIV " & 
+                              BOOLEAN'IMAGE(SP.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT SP" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "SUBTYPE SUBPRIV" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE SUBLIM IS LIM (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     SL : SUBLIM;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF SUBTYPE SUBLIM" & 
+                              BOOLEAN'IMAGE(SL.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT SL " );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "SUBTYPE SUBLIM" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE PARR IS ARRAY (1 .. 5) OF PRIV (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     PAR : PARR;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE PARR " & 
+                              BOOLEAN'IMAGE(PAR(1).L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT PAR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE PARR" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE LARR IS ARRAY (1 .. 10) OF LIM (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     LAR : LARR;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE LARR " & 
+                              BOOLEAN'IMAGE(LAR(1).L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT LAR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE LARR" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE PRIV1 IS 
+                     RECORD
+                          X : PRIV (IDENT_BOOL (TRUE));
+                     END RECORD;
+ 
+           BEGIN
+                DECLARE
+                     P1 : PRIV1;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE PRIV1 " & 
+                              BOOLEAN'IMAGE(P1.X.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT P1" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE PRIV1" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE LIM1 IS 
+                     RECORD
+                          X : LIM (IDENT_BOOL (TRUE));
+                     END RECORD;
+ 
+           BEGIN
+                DECLARE
+                     L1 : LIM1;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE LIM1 " & 
+                              BOOLEAN'IMAGE(L1.X.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT L1" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE LIM1" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE ACCPRIV IS ACCESS PRIV (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     ACP : ACCPRIV;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ACCPRIV " & 
+                              BOOLEAN'IMAGE(ACP.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT ACP" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ACCPRIV" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE ACCLIM IS ACCESS LIM (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     ACL : ACCLIM;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ACCLIM " & 
+                              BOOLEAN'IMAGE(ACL.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT ACL" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ACCLIM" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE NEWPRIV IS NEW PRIV (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     NP : NEWPRIV;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE NEWPRIV " & 
+                              BOOLEAN'IMAGE(NP.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT NP" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE NEWPRIV" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE NEWLIM IS NEW LIM (IDENT_BOOL (TRUE));
+           BEGIN
+                DECLARE
+                     NL : NEWLIM;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE NEWLIM " & 
+                              BOOLEAN'IMAGE(NL.L));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT NL" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE NEWLIM" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                P : PRIV (IDENT_BOOL (TRUE));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                         "P " & BOOLEAN'IMAGE(P.L));
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                              "CONTAINING P" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                         "P" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                L : LIM (IDENT_BOOL (TRUE));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                         "L " & BOOLEAN'IMAGE(L.L));
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                              "CONTAINING L" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                         "L" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE PRIV_NAME IS ACCESS PRIV;
+           BEGIN
+                DECLARE
+                     PN : PRIV_NAME := NEW PRIV (IDENT_BOOL (TRUE));
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "DECLARATION OF OBJECT PN " & 
+                              BOOLEAN'IMAGE(PN.L));
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;               
+                WHEN OTHERS => 
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF OBJECT PN" );
+           END;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                         "PRIV_NAME" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE LIM_NAME IS ACCESS LIM;
+           BEGIN
+                DECLARE
+                     LN : LIM_NAME := NEW LIM (IDENT_BOOL (TRUE));
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "DECLARATION OF OBJECT LN " & 
+                              BOOLEAN'IMAGE(LN.L));
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;               
+                WHEN OTHERS => 
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF OBJECT LN" );
+           END;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                         "LIM_NAME" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PACKAGE PP IS
+                     TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
+                          PRIVATE;
+                PRIVATE
+                     TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PP;
+ 
+                USE PP;
+           BEGIN
+                DECLARE
+                     BP : BAD_PRIV;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "DECLARATION OF OBJECT BP " & 
+                              BOOLEAN'IMAGE(BP.D));
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;               
+                WHEN OTHERS => 
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF OBJECT BP" );
+           END;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                         "BAD_PRIV" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                PACKAGE PL IS
+                     TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
+                          LIMITED PRIVATE;
+                PRIVATE
+                     TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PL;
+ 
+                USE PL;
+           BEGIN
+                DECLARE
+                     BL : BAD_LIM;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "DECLARATION OF OBJECT BL " & 
+                              BOOLEAN'IMAGE(BL.D));
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;               
+                WHEN OTHERS => 
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF OBJECT BL" );
+           END;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                         "BAD_LIM" );
+      END;
+ 
+      RESULT;
+ END C37211B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,426 ----
+ -- C37211C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
+ -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+ -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+ -- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 
+ -- PRIVATE TYPE, THE DISCRIMINANT CONSTRAINT OCCURS BEFORE THE FULL 
+ -- DECLARATION OF THE TYPE, AND THERE ARE NO COMPONENTS OF THE TYPE 
+ -- DEPENDENT ON THE DISCRIMINANT.
+ 
+ -- R.WILLIAMS 8/28/86
+ -- EDS        7/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37211C IS
+ 
+      GLOBAL : BOOLEAN;
+ 
+      SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
+ 
+      FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
+      BEGIN
+           GLOBAL := B;
+           RETURN B;
+      END SWITCH;
+      
+ BEGIN
+      TEST ( "C37211C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                        "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
+                        "PRIVATE TYPE, AND THE DISCRIMINANT " &
+                        "CONSTRAINT OCCURS BEFORE THE FULL " &
+                        "DECLARATION OF THE TYPE" );
+                          
+      BEGIN
+           DECLARE
+                                    
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PP IS
+                     TYPE PRIV1 (D : LIES) IS PRIVATE;
+                     SUBTYPE SUBPRIV IS PRIV1 (IDENT_BOOL (TRUE));
+ 
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE PRIV1 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PP;
+                     
+                USE PP;
+           BEGIN
+                DECLARE
+                     SP : SUBPRIV;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF SUBTYPE SUBPRIV " & BOOLEAN'IMAGE(SP.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT SP" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE PRIV1 NOT SUBTYPE SUBPRIV" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "SUBTYPE SUBPRIV" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                                    
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PL IS
+                     TYPE LIM1 (D : LIES) IS LIMITED PRIVATE;
+                     SUBTYPE SUBLIM IS LIM1 (IDENT_BOOL (TRUE));
+ 
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE LIM1 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PL;
+                     
+                USE PL;
+           BEGIN
+                DECLARE
+                     SL : SUBLIM;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF SUBTYPE SUBLIM " & BOOLEAN'IMAGE(SL.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT SL" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE LIM1 NOT SUBTYPE SUBLIM" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "SUBTYPE SUBLIM" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PP IS
+                     TYPE PRIV2 (D : LIES) IS PRIVATE;
+                     TYPE PARR IS ARRAY (1 .. 5) OF 
+                          PRIV2 (IDENT_BOOL (TRUE));
+      
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE PRIV2 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PP;
+                     
+                USE PP;
+           BEGIN
+                DECLARE
+                     PAR : PARR;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE PARR " & BOOLEAN'IMAGE(PAR(1).D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT PAR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE PRIV2 NOT TYPE PARR" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE PARR" );
+      END;
+           
+      BEGIN
+           DECLARE
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PL IS
+                     TYPE LIM2 (D : LIES) IS LIMITED PRIVATE;
+                     TYPE LARR IS ARRAY (1 .. 5) OF 
+                          LIM2 (IDENT_BOOL (TRUE));
+      
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE LIM2 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PL;
+                     
+                USE PL;
+           BEGIN
+                DECLARE
+                     LAR : LARR;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE LARR " & BOOLEAN'IMAGE(LAR(1).D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT LAR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE LIM2 NOT TYPE LARR" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE LARR" );
+      END;
+           
+      BEGIN
+           DECLARE
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PP IS
+                     TYPE PRIV3 (D : LIES) IS PRIVATE;
+ 
+                     TYPE PRIV4 IS 
+                          RECORD
+                               X : PRIV3 (IDENT_BOOL (TRUE));
+                          END RECORD;
+ 
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE PRIV3 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PP;
+                     
+                USE PP;
+           BEGIN
+                DECLARE
+                     P4 : PRIV4;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE PRIV4 " & BOOLEAN'IMAGE(P4.X.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT P4" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE PRIV3 NOT TYPE PRIV4" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE PRIV4" );
+      END;
+           
+      BEGIN
+           DECLARE
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PL IS
+                     TYPE LIM3 (D : LIES) IS LIMITED PRIVATE;
+ 
+                     TYPE LIM4 IS 
+                          RECORD
+                               X : LIM3 (IDENT_BOOL (TRUE));
+                          END RECORD;
+ 
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE LIM3 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PL;
+                     
+                USE PL;
+           BEGIN
+                DECLARE
+                     L4 : LIM4;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE LIM4 " & BOOLEAN'IMAGE(L4.X.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT L4" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE LIM3 NOT TYPE LIM4" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE LIM4" );
+      END;
+           
+      BEGIN
+           DECLARE
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PP IS
+                     TYPE PRIV5 (D : LIES) IS PRIVATE;
+                     TYPE ACCPRIV IS ACCESS PRIV5 (IDENT_BOOL (TRUE));
+ 
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE PRIV5 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PP;
+                     
+                USE PP;
+ 
+           BEGIN
+                DECLARE
+                     ACP : ACCPRIV;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ACCPRIV " & BOOLEAN'IMAGE(ACP.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT ACP" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE PRIV5 NOT TYPE ACCPRIV" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ACCPRIV" );
+      END;
+           
+      BEGIN
+           DECLARE
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                PACKAGE PL IS
+                     TYPE LIM5 (D : LIES) IS LIMITED PRIVATE;
+                     TYPE ACCLIM IS ACCESS LIM5 (IDENT_BOOL (TRUE));
+ 
+                     B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                PRIVATE
+                     TYPE LIM5 (D : LIES) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END PL;
+                     
+                USE PL;
+ 
+           BEGIN
+                DECLARE
+                     ACL : ACCLIM;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ACCLIM " & BOOLEAN'IMAGE(ACL.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT ACL" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE LIM5 NOT TYPE ACCLIM" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ACCLIM" );
+      END;
+           
+      RESULT;
+ END C37211C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C37211D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
+ -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+ -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+ -- INDICATIONS WHERE THE TYPE MARK DENOTES AN INCOMPLETE TYPE.
+ 
+ -- R.WILLIAMS 8/28/86
+ -- EDS        7/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37211D IS
+ 
+      GLOBAL : BOOLEAN;
+ 
+      TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+ 
+      SUBTYPE WEEKDAY IS DAY RANGE MON .. FRI;
+ 
+      FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
+      BEGIN
+           GLOBAL := B;
+           RETURN B;
+      END SWITCH;
+      
+      FUNCTION IDENT (D : DAY) RETURN DAY IS
+      BEGIN
+           RETURN DAY'VAL (IDENT_INT (DAY'POS (D)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C37211D", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                        "TYPE MARK DENOTES AN INCOMPLETE TYPE" );
+                          
+      BEGIN
+           DECLARE
+                                    
+                B1 : BOOLEAN := SWITCH (TRUE);
+ 
+                TYPE REC (D : WEEKDAY);
+ 
+                TYPE ACCREC IS ACCESS REC (IDENT (SUN));
+ 
+                B2 : BOOLEAN := SWITCH (FALSE);
+ 
+                TYPE REC (D : WEEKDAY) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           BEGIN
+                DECLARE
+                     AC : ACCREC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ACCREC " & DAY'IMAGE(AC.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT AC" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL THEN 
+                     NULL;
+                ELSE
+                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                              "FULL TYPE REC NOT TYPE ACCREC" );
+                END IF;                    
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ACCREC" );
+      END;
+ 
+      RESULT;
+ END C37211D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37211e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37211e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,233 ----
+ -- C37211E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
+ -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+ -- OF THE DISCRIMINANT. 
+ 
+ -- R.WILLIAMS 8/28/86
+ -- PWN 10/27/95  REMOVED CHECK WHERE CONSTRAINT RULES HAVE CHANGED.
+ -- PWN 12/03/95  CORRECTED FORMATING PROBLEM.
+ -- TMB 11/20/96  REINTRODUCED CHECK REMOVED ON 10/27 WITH ADA95 CHANGES
+ -- TMB 12/2/96   DELETED CHECK OF CONSTRAINED ACCESS TYPE
+ -- EDS 07/14/98  AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37211E IS
+ 
+      TYPE REC (D : POSITIVE) IS
+           RECORD
+                NULL;
+           END RECORD;
+      
+      TYPE ACC IS ACCESS REC;
+ BEGIN
+      TEST ( "C37211E", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                        "TYPE MARK DENOTES AN ACCESS TYPE" );
+                          
+      BEGIN
+           DECLARE
+                SUBTYPE SUBACC IS ACC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     SA : SUBACC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF SUBTYPE SUBACC " & 
+                              INTEGER'IMAGE(SA.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT SA" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "SUBTYPE SUBACC" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                TYPE ARR IS ARRAY (1 .. 10) OF ACC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     AR : ARR;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ARR " & 
+                              INTEGER'IMAGE(AR(1).D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT AR" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ARR" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE REC1 IS 
+                     RECORD
+                          X : ACC (IDENT_INT (-1));
+                     END RECORD;
+ 
+           BEGIN
+                DECLARE
+                     R1 : REC1;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1.X.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT R1" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE REC1" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE ACCA IS ACCESS ACC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     ACA : ACCA;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE ACCA " & 
+                              INTEGER'IMAGE(ACA.ALL.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT ACA" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE ACCA" );
+      END;
+           
+      BEGIN
+           DECLARE
+                TYPE NEWACC IS NEW ACC (IDENT_INT (-1));
+           BEGIN
+                DECLARE
+                     NA : NEWACC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "ELABORATION OF TYPE NEWACC " & 
+                              INTEGER'IMAGE(NA.D));
+                END;
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                              "OBJECT NA" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                         "TYPE NEWACC" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                A : ACC (IDENT_INT (-1));
+           BEGIN
+                FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                         "A " & INTEGER'IMAGE(A.D));
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                              "CONTAINING A" );
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                         "A" );
+      END;
+ 
+ 
+      BEGIN
+           DECLARE
+                TYPE BAD_ACC (D : POSITIVE := IDENT_INT (-1)) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           BEGIN
+                DECLARE
+                     BAC : BAD_ACC;
+                BEGIN
+                     FAILED ( "NO EXCEPTION RAISED AT THE " &
+                              "DECLARATION OF OBJECT BAC " & 
+                              INTEGER'IMAGE(BAC.D));
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                                   "DECLARING BAC" );
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;               
+                WHEN OTHERS => 
+                     FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                              "OF OBJECT BAC" );
+           END;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                         "BAD_ACC" );
+      END;
+ 
+      RESULT;
+ END C37211E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,241 ----
+ -- C37213B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF
+ --        A DISCRIMINANT CONSTRAINT
+ -- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
+ -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
+ -- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
+ --
+ --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+ --      DECLARATION.
+ 
+ -- JBG 10/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37213B IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+      TYPE REC (D1, D2 : SM) IS
+           RECORD NULL; END RECORD;
+ 
+      F1_CONS : INTEGER := 2;
+ 
+      FUNCTION CHK (
+           CONS    : INTEGER;
+           VALUE   : INTEGER;
+           MESSAGE : STRING) RETURN BOOLEAN IS
+      BEGIN
+           IF CONS /= VALUE THEN
+                FAILED (MESSAGE & ": CONS IS " &
+                        INTEGER'IMAGE(CONS));
+           END IF;
+           RETURN TRUE;
+      END CHK;
+ 
+      FUNCTION F1 RETURN INTEGER IS
+      BEGIN
+           F1_CONS := F1_CONS - IDENT_INT(1);
+           RETURN F1_CONS;
+      END F1;
+ 
+ BEGIN
+      TEST ("C37213B", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
+                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                       "AND DISCRIMINANTS HAVE DEFAULTS");
+ 
+ -- CASE B
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := 1) IS
+                RECORD
+                     C1 : REC (D3, F1);       -- F1 EVALUATED
+                END RECORD;
+           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+           X : CONS;             -- F1 NOT EVALUATED AGAIN
+           Y : CONS;             -- F1 NOT EVALUATED AGAIN
+           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+      BEGIN
+           IF X /= (1, (1, 1)) OR Y /= (1, (1, 1)) THEN
+                FAILED ("DISCRIMINANT VALUES NOT CORRECT");
+           END IF;
+      END;
+ 
+      F1_CONS := 12;
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := 1) IS
+                RECORD
+                     C1 : REC(D3, F1);
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                     IF X /= (1, (1, 1)) THEN
+                          COMMENT ("SHOULDN'T GET HERE");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS;
+                BEGIN
+                     X := NEW CONS;
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                     BEGIN
+                          IF X.ALL /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 3");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 4");
+                          IF X /= (1..5 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 5");
+                          IF X /= (C1 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE DREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : DREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 6");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+           RESULT;
+ 
+ END C37213B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,240 ----
+ -- C37213D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF
+ --        AN INDEX CONSTRAINT
+ -- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
+ -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
+ -- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
+ --
+ --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+ --      DECLARATION.
+ 
+ -- JBG 10/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37213D IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+      TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+ 
+      F1_CONS : INTEGER := 2;
+ 
+      FUNCTION CHK (
+           CONS    : INTEGER;
+           VALUE   : INTEGER;
+           MESSAGE : STRING) RETURN BOOLEAN IS
+      BEGIN
+           IF CONS /= VALUE THEN
+                FAILED (MESSAGE & ": CONS IS " &
+                        INTEGER'IMAGE(CONS));
+           END IF;
+           RETURN TRUE;
+      END CHK;
+ 
+      FUNCTION F1 RETURN INTEGER IS
+      BEGIN
+           F1_CONS := F1_CONS - IDENT_INT(1);
+           RETURN F1_CONS;
+      END F1;
+ 
+ BEGIN
+      TEST ("C37213D", "CHECK EVALUATION OF INDEX BOUNDS " &
+                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                       "AND DISCRIMINANTS HAVE DEFAULTS");
+ 
+ -- CASE B
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := 1) IS
+                RECORD
+                     C1 : MY_ARR (F1..D3);    -- F1 EVALUATED.
+                END RECORD;
+           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+           X : CONS;             -- F1 NOT EVALUATED AGAIN
+           Y : CONS;             -- F1 NOT EVALUATED AGAIN
+           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+      BEGIN
+           IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
+                FAILED ("INDEX BOUNDS NOT CORRECT");
+           END IF;
+      END;
+ 
+      F1_CONS := 12;
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := 1) IS
+                RECORD
+                     C1 : MY_ARR(D3..F1);
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                     IF X /= (1, (1, 1)) THEN
+                          COMMENT ("SHOULDN'T GET HERE");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS;
+                BEGIN
+                     X := NEW CONS;
+                     FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                     BEGIN
+                          IF X.ALL /= (1, (1 => 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 3");
+                          IF X /= (1, (1 => 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 4");
+                          IF X /= (1..5 => (1, (1 => 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 5");
+                          IF X /= (C1 => (1, (1 => 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE DREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : DREC;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 6");
+                          IF X /= (1, (1 => 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+           RESULT;
+ 
+ END C37213D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,379 ----
+ -- C37213F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF
+ --        A DISCRIMINANT CONSTRAINT
+ -- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
+ -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
+ -- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
+ --
+ --   CASE D: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+ --      DECLARATION AND THE COMPONENT IS PRESENT IN THE DEFAULT SUBTYPE.
+ 
+ -- JBG 10/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37213F IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+      TYPE REC (D1, D2 : SM) IS
+           RECORD NULL; END RECORD;
+ 
+      F1_CONS : INTEGER := 2;
+ 
+      FUNCTION CHK (
+           CONS    : INTEGER;
+           VALUE   : INTEGER;
+           MESSAGE : STRING) RETURN BOOLEAN IS
+      BEGIN
+           IF CONS /= VALUE THEN
+                FAILED (MESSAGE & ": CONS IS " &
+                        INTEGER'IMAGE(CONS));
+           END IF;
+           RETURN TRUE;
+      END CHK;
+ 
+      FUNCTION F1 RETURN INTEGER IS
+      BEGIN
+           F1_CONS := F1_CONS - IDENT_INT(1);
+           RETURN F1_CONS;
+      END F1;
+ 
+ BEGIN
+      TEST ("C37213F", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
+                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                       "DISCRIMINANTS HAVE DEFAULTS, AND COMPONENT" &
+                       "SUBTYPE DETERMINES WHETHER CONSTRAINT SHOULD " &
+                       "BE CHECKED");
+ 
+ -- CASE D1: COMPONENT IS PRESENT
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(1)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : REC (D3, F1);       -- F1 EVALUATED
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(0);
+                     END CASE;
+                END RECORD;
+           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+           X : CONS;             -- F1 NOT EVALUATED AGAIN
+           Y : CONS;             -- F1 NOT EVALUATED AGAIN
+           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+      BEGIN
+           IF X /= (1, (1, 1)) OR Y /= (1, (1, 1)) THEN
+                FAILED ("DISCRIMINANT VALUES NOT CORRECT");
+           END IF;
+      END;
+ 
+      F1_CONS := 12;
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(1)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : REC(D3, F1);
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(0);
+                     END CASE;
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                     IF X /= (1, (1, 1)) THEN
+                          COMMENT ("SHOULDN'T GET HERE");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS;
+                BEGIN
+                     X := NEW CONS;
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                     IF X.ALL /= (1, (1, 1)) THEN
+                          COMMENT ("IRRELEVANT");
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 3");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 4");
+                          IF X /= (1..5 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 5");
+                          IF X /= (C1 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE DREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : DREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 6");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+           END;
+ 
+      END;
+ 
+ -- CASE C2 : COMPONENT IS ABSENT
+ 
+      F1_CONS := 2;
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(-6)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : REC (D3, F1);       -- F1 EVALUATED
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(0);
+                     END CASE;
+                END RECORD;
+           CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED - 2");
+           X : CONS;             -- F1 NOT EVALUATED AGAIN
+           Y : CONS;             -- F1 NOT EVALUATED AGAIN
+           CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED - 2");
+      BEGIN
+           IF X /= (-6, 0) OR Y /= (-6, 0) THEN
+                FAILED ("DISCRIMINANT VALUES NOT CORRECT");
+           END IF;
+      END;
+ 
+      F1_CONS := 12;
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : REC(D3, F1);
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(0);
+                     END CASE;
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     IF X /= (11, 0) THEN
+                          FAILED ("WRONG VALUE FOR X - 11");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 11");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          IF X /= (11, 0) THEN
+                               FAILED ("X VALUE WRONG - 12");
+                          END IF;
+                     END;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 12");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                     X : ARR;
+                BEGIN
+                     IF X /= (1..5 => (11, 0)) THEN
+                          FAILED ("X VALUE INCORRECT - 13");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 13");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                     X : NREC;
+                BEGIN
+                     IF X /= (C1 => (11, 0)) THEN
+                          FAILED ("X VALUE IS INCORRECT - 14");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 14");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS NEW CONS;
+                     X : NREC;
+                BEGIN
+                     IF X /= (11, 0) THEN
+                          FAILED ("X VALUE INCORRECT - 15");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 15");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS := NEW CONS;
+                BEGIN
+                     IF X.ALL /= (11, 0) THEN
+                          FAILED ("X VALUE INCORRECT - 17");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 17");
+           END;
+      END;
+ 
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+           RESULT;
+ 
+ END C37213F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,457 ----
+ -- C37213H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, WHERE AN INDEX CONSTRAINT DEPENDS ON A RECORD
+ --     DISCRIMINANT WITH A DEFAULT VALUE AND THE RECORD TYPE IS NOT
+ --     EXPLICITLY CONSTRAINED, THAT THE NON-DISCRIMINANT EXPRESSIONS
+ --     IN THE INDEX CONSTRAINT ARE:
+ --          1) EVALUATED WHEN THE RECORD COMPONENT SUBTYPE DEFINITION
+ --             IS ELABORATED,
+ --          2) PROPERLY CHECKED FOR COMPATIBILITY ONLY IN AN ALLOCATION
+ --             OR OBJECT DECLARATION AND ONLY IF THE DISCRIMINANT-
+ --             DEPENDENT COMPONENT IS PRESENT IN THE SUBTYPE.
+ 
+ -- HISTORY:
+ --     JBG  10/17/86  CREATED ORIGINAL TEST.
+ --     VCL  10/23/87  MODIFIED THIS HEADER; MODIFIED THE CHECK OF
+ --                    SUBTYPE 'SCONS', IN BOTH SUBPARTS OF THE TEST,
+ --                    TO INDICATE FAILURE IF CONSTRAINT_ERROR IS RAISED
+ --                    FOR THE SUBTYPE DECLARATION AND FAILURE IF
+ --                    CONSTRAINT_ERROR IS NOT RAISED FOR AN OBJECT
+ --                    DECLARATION OF THIS SUBTYPE; RELOCATED THE CALL TO
+ --                    REPORT.TEST SO THAT IT COMES BEFORE ANY
+ --                    DECLARATIONS;  ADDED 'SEQUENCE_NUMBER' TO IDENTIFY
+ --                    THE CURRENT SUBTEST (FOR EXCEPTIONS); CHANGE THE
+ --                    TYPE OF THE DISCRIMINANT IN THE RECORD 'CONS'
+ --                    TO AN INTEGER SUBTYPE.
+ --     VCL  03/30/88  MODIFIED HEADER AND MESSAGES OUTPUT BY REPORT
+ --                    PACKAGE.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37213H IS
+ BEGIN
+      TEST ("C37213H", "THE NON-DISCRIMINANT EXPRESSIONS OF AN " &
+                       "INDEX CONSTRAINT THAT DEPEND ON A " &
+                       "DISCRIMINANT WITH A DEFAULT VALUE ARE " &
+                       "PROPERLY EVALUATED AND CHECKED WHEN THE " &
+                       "RECORD TYPE IS NOT EXPLICITLY CONSTRAINED AND " &
+                       "THE COMPONENT IS AND IS NOT PRESENT IN THE " &
+                       "SUBTYPE");
+ 
+      DECLARE
+           SEQUENCE_NUMBER : INTEGER;
+ 
+           SUBTYPE DISCR IS INTEGER RANGE -50..50;
+           SUBTYPE SM IS INTEGER RANGE 1..10;
+           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+ 
+           F1_CONS : INTEGER := 2;
+ 
+           FUNCTION CHK (
+                CONS    : INTEGER;
+                VALUE   : INTEGER;
+                MESSAGE : STRING) RETURN BOOLEAN IS
+           BEGIN
+                IF CONS /= VALUE THEN
+                     FAILED (MESSAGE & ": F1_CONS IS " &
+                             INTEGER'IMAGE(F1_CONS));
+                END IF;
+                RETURN TRUE;
+           END CHK;
+ 
+           FUNCTION F1 RETURN INTEGER IS
+           BEGIN
+                F1_CONS := F1_CONS - IDENT_INT(1);
+                RETURN F1_CONS;
+           END F1;
+      BEGIN
+ 
+ 
+ -- CASE 1: DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT.
+ 
+           SEQUENCE_NUMBER :=1;
+           DECLARE
+                TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(F1..D3); -- F1 EVALUATED.
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(0);
+                          END CASE;
+                     END RECORD;
+ 
+                CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+ 
+                X : CONS;                     -- F1 NOT EVALUATED AGAIN.
+                Y : CONS;                     -- F1 NOT EVALUATED AGAIN.
+ 
+                CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+           BEGIN
+                IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
+                     FAILED ("VALUES NOT CORRECT");
+                END IF;
+           END;
+ 
+ 
+           F1_CONS := 12;
+ 
+           SEQUENCE_NUMBER := 2;
+           DECLARE
+                TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..F1);
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(0);
+                          END CASE;
+                     END RECORD;
+           BEGIN
+                BEGIN
+                     DECLARE
+                          X : CONS;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("INCORRECT VALUES FOR X - 1");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          SUBTYPE SCONS IS CONS;
+                     BEGIN
+                          DECLARE
+                               X : SCONS;
+                          BEGIN
+                               FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                               IF X /= (1, (1, 1)) THEN
+                                    COMMENT ("INCORRECT VALUES FOR X " &
+                                             "- 2");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                       "- 2A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE ARR IS ARRAY (1..5) OF CONS;
+                     BEGIN
+                          DECLARE
+                               X : ARR;
+                          BEGIN
+                               FAILED ("INDEX CHECK NOT PERFORMED - 3");
+                               IF X /= (1..5 => (1, (1, 1))) THEN
+                                    COMMENT ("INCORRECT VALUES FOR X " &
+                                             "- 3");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                       "- 3A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE NREC IS
+                               RECORD
+                                    C1 : CONS;
+                               END RECORD;
+                     BEGIN
+                          DECLARE
+                               X : NREC;
+                          BEGIN
+                               FAILED ("INDEX CHECK NOT PERFORMED - 4");
+                               IF X /= (C1 => (1, (1, 1))) THEN
+                                    COMMENT ("INCORRECT VALUES FOR X " &
+                                             "- 4");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                       "- 4A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE NREC IS NEW CONS;
+                     BEGIN
+                          DECLARE
+                               X : NREC;
+                          BEGIN
+                               FAILED ("INDEX CHECK NOT PERFORMED - 5");
+                               IF X /= (1, (1, 1)) THEN
+                                    COMMENT ("INCORRECT VALUES FOR X " &
+                                             "- 5");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                        "- 5A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE ACC_CONS IS ACCESS CONS;
+                     BEGIN
+                          DECLARE
+                               X : ACC_CONS;
+                          BEGIN
+                               X := NEW CONS;
+                               FAILED ("INDEX CHECK NOT PERFORMED - 6");
+                               IF X.ALL /= (1, (1, 1)) THEN
+                                    COMMENT ("INCORRECT VALUES FOR X " &
+                                             "- 6");
+                               END IF;
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    COMMENT ("UNEXPECTED EXCEPTION " &
+                                             "RAISED - 6A");
+                          END;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               COMMENT ("UNEXPECTED EXCEPTION RAISED " &
+                                        "- 6B");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
+                END;
+           END;
+ 
+ 
+ -- CASE D2: DISCRIMINANT-DEPENDENT COMPONENT IS ABSENT.
+ 
+           F1_CONS := 2;
+ 
+           SEQUENCE_NUMBER := 3;
+           DECLARE
+                TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..F1); -- F1 EVALUATED.
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(0);
+                          END CASE;
+                     END RECORD;
+                CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+ 
+                X : CONS;                      -- F1 NOT EVALUATED AGAIN.
+                Y : CONS;                      -- F1 NOT EVALUATED AGAIN.
+ 
+                CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+           BEGIN
+                IF X /= (-6, 0) OR Y /= (-6, 0) THEN
+                     FAILED ("VALUES NOT CORRECT");
+                END IF;
+           END;
+ 
+           F1_CONS := 12;
+ 
+           SEQUENCE_NUMBER := 4;
+           DECLARE
+                TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..F1);
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(0);
+                          END CASE;
+                     END RECORD;
+           BEGIN
+                BEGIN
+                     DECLARE
+                          X : CONS;
+                     BEGIN
+                          IF X /= (11, 0) THEN
+                               FAILED ("X VALUE IS INCORRECT - 11");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          SUBTYPE SCONS IS CONS;
+                     BEGIN
+                          DECLARE
+                               X : SCONS;
+                          BEGIN
+                               IF X /= (11, 0) THEN
+                                    FAILED ("X VALUE INCORRECT - 12");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                       "12A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE ARR IS ARRAY (1..5) OF CONS;
+                     BEGIN
+                          DECLARE
+                               X : ARR;
+                          BEGIN
+                               IF X /= (1..5 => (11, 0)) THEN
+                                    FAILED ("X VALUE INCORRECT - 13");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                       "13A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE NREC IS
+                               RECORD
+                                    C1 : CONS;
+                               END RECORD;
+                     BEGIN
+                          DECLARE
+                               X : NREC;
+                          BEGIN
+                               IF X /= (C1 => (11, 0)) THEN
+                                    FAILED ("X VALUE INCORRECT - 14");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                       "14A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE NREC IS NEW CONS;
+                     BEGIN
+                          DECLARE
+                               X : NREC;
+                          BEGIN
+                               IF X /= (11, 0) THEN
+                                    FAILED ("X VALUE INCORRECT - 15");
+                               END IF;
+                          END;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                       "15A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          TYPE ACC_CONS IS ACCESS CONS;
+                          X : ACC_CONS;
+                     BEGIN
+                          X := NEW CONS;
+                          IF X.ALL /= (11, 0) THEN
+                               FAILED ("X VALUE INCORRECT - 17");
+                          END IF;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                       "17A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                           FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
+                END;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &
+                        INTEGER'IMAGE (SEQUENCE_NUMBER));
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                        INTEGER'IMAGE (SEQUENCE_NUMBER));
+      END;
+ 
+      RESULT;
+ END C37213H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,320 ----
+ -- C37213J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
+ --     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
+ --     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN
+ --     OBJECT OR A SUBTYPE, THAT THE NON-DISCRIMINANT EXPRESSIONS
+ --     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
+ --          1) ONLY IN AN OBJECT DECLARATION, AND
+ --          2) ONLY IF THE DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT
+ --             IN THE SUBTYPE.
+ 
+ -- HISTORY:
+ --     JBG  10/17/86  CREATED ORIGINAL TEST.
+ --     VCL  10/23/87  MODIFIED THIS HEADER; SEPARATED THIS TEST INTO
+ --                    3 NEW TESTS (J,K,L); CHANGED THE AGGREGATE FOR
+ --                    THE PARAMETER 'VALUE' IN THE CALL OF PROCEDURE
+ --                    'SUBTYPE_CHK1';  MOVED THE CALL TO REPORT.TEST
+ --                    SO THAT IT COMES BEFORE ANY DECLARATIONS; ADDED
+ --                    A SEQUENCE COUNTER TO IDENTIFY WHICH SUBTEST
+ --                    DECLARATION PART RAISES CONSTRAINT_ERROR.
+ --     VCL  03/28/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
+ --                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
+ --                    PARAMETERS TO THE GENERIC UNITS AND THE
+ --                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
+ --                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
+ --                    ARE TOGETHER.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37213J IS
+ BEGIN
+      TEST ("C37213J", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
+                       "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
+                       "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
+                       "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
+                       "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
+                       "FORMAL TYPE USED TO DECLARE AN OBJECT OR A " &
+                       "SUBTYPE");
+ 
+      DECLARE
+           SUBTYPE SM IS INTEGER RANGE 1..10;
+           TYPE REC (D1, D2 : SM) IS
+                RECORD NULL; END RECORD;
+           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+ 
+           SEQUENCE_NUMBER : INTEGER;
+ 
+           GENERIC
+                TYPE CONS IS PRIVATE;
+                OBJ_XCP : BOOLEAN;
+                TAG     : STRING;
+           PACKAGE OBJ_CHK IS END OBJ_CHK;
+ 
+           GENERIC
+                TYPE CONS IS PRIVATE;
+           PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
+                                 TAG     : STRING);
+ 
+           PACKAGE BODY OBJ_CHK IS
+           BEGIN          -- DECLARE AN OBJECT OF THE FORMAL TYPE.
+                DECLARE
+                     X : CONS;
+ 
+                     FUNCTION VALUE RETURN CONS IS
+                     BEGIN
+                          IF EQUAL (3,3) THEN
+                               RETURN X;
+                          ELSE
+                               RETURN X;
+                          END IF;
+                     END VALUE;
+                BEGIN
+                     IF OBJ_XCP THEN
+                          FAILED ("NO CHECK DURING DECLARATION " &
+                                  "OF OBJECT OF TYPE CONS - " & TAG);
+                     ELSIF X /= VALUE THEN
+                          FAILED ("INCORRECT VALUE FOR OBJECT OF " &
+                                  "TYPE CONS - " & TAG);
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT OBJ_XCP THEN
+                          FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                  "DURING DECLARATION OF OBJECT " &
+                                  "OF TYPE CONS - " & TAG);
+                     END IF;
+           END OBJ_CHK;
+ 
+           PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
+                                 TAG     : STRING)    IS
+           BEGIN          -- DECLARE A SUBTYPE OF THE FORMAL TYPE.
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+ 
+                          FUNCTION VALUE RETURN SCONS IS
+                          BEGIN
+                               IF EQUAL (5, 5) THEN
+                                    RETURN X;
+                               ELSE
+                                    RETURN X;
+                               END IF;
+                          END VALUE;
+                     BEGIN
+                          IF OBJ_XCP THEN
+                               FAILED ("NO CHECK DURING DECLARATION " &
+                                       "OF OBJECT OF SUBTYPE SCONS - " &
+                                       TAG);
+                          ELSIF X /= VALUE THEN
+                               FAILED ("INCORRECT VALUE FOR OBJECT " &
+                                       "OF SUBTYPE SCONS - " & TAG);
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          IF NOT OBJ_XCP THEN
+                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                       "DURING DECLARATION OF OBJECT " &
+                                       "OF SUBTYPE SCONS - " & TAG);
+                          END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                             "DURING SUBTYPE DECLARATION - " & TAG);
+           END SUBTYP_CHK;
+      BEGIN
+           SEQUENCE_NUMBER := 1;
+           DECLARE
+                TYPE REC_DEF (D3 : INTEGER := 1) IS
+                     RECORD
+                          C1 : REC (D3, 0);
+                     END RECORD;
+ 
+                PACKAGE PACK1 IS NEW OBJ_CHK (REC_DEF,
+                          OBJ_XCP => TRUE,
+                          TAG     => "PACK1");
+ 
+                PROCEDURE PROC1 IS NEW SUBTYP_CHK (REC_DEF);
+           BEGIN
+                PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
+           END;
+ 
+           SEQUENCE_NUMBER := 2;
+           DECLARE
+                TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
+                     RECORD
+                          C1 : MY_ARR (0..D3);
+                     END RECORD;
+ 
+                PACKAGE PACK2 IS NEW OBJ_CHK (ARR_DEF,
+                          OBJ_XCP => TRUE,
+                          TAG     => "PACK2");
+ 
+                PROCEDURE PROC2 IS NEW SUBTYP_CHK (ARR_DEF);
+           BEGIN
+                PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
+           END;
+ 
+ 
+           SEQUENCE_NUMBER := 3;
+           DECLARE
+                TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK3 IS NEW OBJ_CHK (VAR_REC_DEF1,
+                               OBJ_XCP => TRUE,
+                               TAG     => "PACK3");
+ 
+                PROCEDURE PROC3 IS NEW SUBTYP_CHK (VAR_REC_DEF1);
+           BEGIN
+                PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
+           END;
+ 
+           SEQUENCE_NUMBER := 4;
+           DECLARE
+                TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK4 IS NEW OBJ_CHK (VAR_REC_DEF6,
+                               OBJ_XCP => FALSE,
+                               TAG     => "PACK4");
+ 
+                PROCEDURE PROC4 IS NEW SUBTYP_CHK (VAR_REC_DEF6);
+           BEGIN
+                PROC4 (OBJ_XCP => FALSE,TAG => "PROC4");
+           END;
+ 
+           SEQUENCE_NUMBER := 5;
+           DECLARE
+                TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK5 IS NEW OBJ_CHK (VAR_REC_DEF11,
+                               OBJ_XCP => FALSE,
+                               TAG     => "PACK5");
+ 
+                PROCEDURE PROC5 IS NEW SUBTYP_CHK (VAR_REC_DEF11);
+           BEGIN
+                PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
+           END;
+ 
+           SEQUENCE_NUMBER := 6;
+           DECLARE
+                TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK6 IS NEW OBJ_CHK (VAR_ARR_DEF1,
+                               OBJ_XCP => TRUE,
+                               TAG     => "PACK6");
+ 
+                PROCEDURE PROC6 IS NEW SUBTYP_CHK (VAR_ARR_DEF1);
+           BEGIN
+                PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
+           END;
+ 
+           SEQUENCE_NUMBER := 7;
+           DECLARE
+                TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK7 IS NEW OBJ_CHK (VAR_ARR_DEF6,
+                               OBJ_XCP => FALSE,
+                               TAG     => "PACK7");
+ 
+                PROCEDURE PROC7 IS NEW SUBTYP_CHK (VAR_ARR_DEF6);
+           BEGIN
+                PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
+           END;
+ 
+           SEQUENCE_NUMBER := 8;
+           DECLARE
+                TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK8 IS NEW OBJ_CHK (VAR_ARR_DEF11,
+                               OBJ_XCP => FALSE,
+                               TAG     => "PACK8");
+ 
+                PROCEDURE PROC8 IS NEW SUBTYP_CHK (VAR_ARR_DEF11);
+           BEGIN
+                PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
+           END;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED DURING DECLARATION / " &
+                        "INSTANTIATION ELABORATION - " &
+                        INTEGER'IMAGE(SEQUENCE_NUMBER));
+      END;
+ 
+      RESULT;
+ END C37213J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,324 ----
+ -- C37213K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
+ --     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
+ --     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN
+ --     ARRAY OR RECORD COMPONENT, THAT THE NON-DISCRIMINANT EXPRESSIONS
+ --     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
+ --          1) ONLY IN AN OBJECT DECLARATION, AND
+ --          2) ONLY IF THE DESCRIMINANT-DEPENDENT COMPONENT IS PRESENT
+ --             IN THE SUBTYPE.
+ 
+ -- HISTORY:
+ --     VCL  10/23/88  CREATED ORIGINAL TEST BY SPLITTING FROM C37213J.
+ --     VCL  03/30/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
+ --                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
+ --                    PARAMETERS TO THE GENERIC UNITS AND THE
+ --                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
+ --                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
+ --                    ARE TOGETHER;  REWROTE ONE OF THE GENERIC
+ --                    PACKAGES AS A GENERIC PROCEDURE TO BROADEN
+ --                    COVERAGE OF TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37213K IS
+ BEGIN
+      TEST ("C37213K", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
+                       "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
+                       "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
+                       "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
+                       "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
+                       "FORMAL TYPE USED TO DECLARE AN ARRAY OR A " &
+                       "RECORD COMPONENT");
+ 
+      DECLARE
+           SUBTYPE SM IS INTEGER RANGE 1..10;
+           TYPE REC (D1, D2 : SM) IS
+                RECORD NULL; END RECORD;
+           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+ 
+           SEQUENCE_NUMBER : INTEGER;
+ 
+           GENERIC
+                TYPE CONS IS PRIVATE;
+                OBJ_XCP : BOOLEAN;
+                TAG     : STRING;
+           PACKAGE ARRAY_COMP_CHK IS END ARRAY_COMP_CHK;
+ 
+           PACKAGE BODY ARRAY_COMP_CHK IS
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+ 
+                          FUNCTION VALUE RETURN ARR IS
+                          BEGIN
+                               IF EQUAL (3,3) THEN
+                                    RETURN X;
+                               ELSE
+                                    RETURN X;
+                               END IF;
+                          END VALUE;
+                     BEGIN
+                          IF OBJ_XCP THEN
+                               FAILED ("NO CHECK DURING DECLARATION " &
+                                       "OF OBJECT OF TYPE ARR - " & TAG);
+                          ELSIF X /= VALUE THEN
+                               FAILED ("INCORRECT VALUE FOR OBJECT OF " &
+                                       "TYPE ARR - " & TAG);
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          IF NOT OBJ_XCP THEN
+                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                       "DURING DECLARATION OF OBJECT " &
+                                       "OF TYPE ARR - " & TAG);
+                          END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                             "DURING DECLARATION OF ARR - " & TAG);
+           END ARRAY_COMP_CHK;
+ 
+           GENERIC
+                TYPE CONS IS PRIVATE;
+           PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN;
+                                   TAG     : STRING);
+ 
+           PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN;
+                                   TAG     : STRING)   IS
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+ 
+                          FUNCTION VALUE RETURN NREC IS
+                          BEGIN
+                               IF EQUAL (5, 5) THEN
+                                    RETURN X;
+                               ELSE
+                                    RETURN X;
+                               END IF;
+                          END VALUE;
+                     BEGIN
+                          IF OBJ_XCP THEN
+                               FAILED ("NO CHECK DURING DECLARATION " &
+                                       "OF OBJECT OF TYPE NREC - " &
+                                       TAG);
+                          ELSIF X /= VALUE THEN
+                               FAILED ("INCORRECT VALUE FOR OBJECT " &
+                                       "OF TYPE NREC - " & TAG);
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          IF NOT OBJ_XCP THEN
+                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                       "DURING DECLARATION OF OBJECT " &
+                                       "OF TYPE NREC - " & TAG);
+                          END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                             "DURING DECLARATION OF NREC - " & TAG);
+           END;
+      BEGIN
+           SEQUENCE_NUMBER := 1;
+           DECLARE
+                TYPE REC_DEF (D3 : INTEGER := 1) IS
+                     RECORD
+                          C1 : REC (D3, 0);
+                     END RECORD;
+ 
+                PACKAGE PACK1 IS NEW ARRAY_COMP_CHK (REC_DEF,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK1");
+ 
+                PROCEDURE PROC1 IS NEW REC_COMP_CHK (REC_DEF);
+           BEGIN
+                PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
+           END;
+ 
+           SEQUENCE_NUMBER := 2;
+           DECLARE
+                TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
+                     RECORD
+                          C1 : MY_ARR (0..D3);
+                     END RECORD;
+ 
+                PACKAGE PACK2 IS NEW ARRAY_COMP_CHK (ARR_DEF,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK2");
+ 
+                PROCEDURE PROC2 IS NEW REC_COMP_CHK (ARR_DEF);
+           BEGIN
+                PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
+           END;
+ 
+           SEQUENCE_NUMBER := 3;
+           DECLARE
+                TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK3 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF1,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK3");
+ 
+                PROCEDURE PROC3 IS NEW REC_COMP_CHK (VAR_REC_DEF1);
+           BEGIN
+                PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
+           END;
+ 
+           SEQUENCE_NUMBER := 4;
+           DECLARE
+                TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK4 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF6,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK4");
+ 
+                PROCEDURE PROC4 IS NEW REC_COMP_CHK (VAR_REC_DEF6);
+           BEGIN
+                PROC4 (OBJ_XCP => FALSE, TAG => "PROC4");
+           END;
+ 
+           SEQUENCE_NUMBER := 5;
+           DECLARE
+                TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK5 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF11,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK5");
+ 
+                PROCEDURE PROC5 IS NEW REC_COMP_CHK (VAR_REC_DEF11);
+           BEGIN
+                PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
+           END;
+ 
+           SEQUENCE_NUMBER := 6;
+           DECLARE
+                TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK6 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF1,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK6");
+ 
+                PROCEDURE PROC6 IS NEW REC_COMP_CHK (VAR_ARR_DEF1);
+           BEGIN
+                PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
+           END;
+ 
+           SEQUENCE_NUMBER := 7;
+           DECLARE
+                TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK7 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF6,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK7");
+ 
+                PROCEDURE PROC7 IS NEW REC_COMP_CHK (VAR_ARR_DEF6);
+           BEGIN
+                PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
+           END;
+ 
+           SEQUENCE_NUMBER := 8;
+           DECLARE
+                TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK8 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF11,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK8");
+ 
+                PROCEDURE PROC8 IS NEW REC_COMP_CHK (VAR_ARR_DEF11);
+           BEGIN
+                PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
+                        "DECLARATION / INSTANTIATION ELABORATION - " &
+                        INTEGER'IMAGE (SEQUENCE_NUMBER));
+      END;
+ 
+      RESULT;
+ END C37213K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37213l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37213l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,329 ----
+ -- C37213L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
+ --     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
+ --     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE A
+ --     DERIVED OR AN ACCESS TYPE, THAT THE NON-DISCRIMINANT EXPRESSIONS
+ --     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
+ --          1) ONLY IN AN OBJECT DECLARATION OR ALLOCATOR, AND
+ --          2) ONLY IF THE DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT
+ --             IN THE SUBTYPE.
+ 
+ -- HISTORY:
+ --     VCL  10/23/88  CREATED ORIGINAL TEST BY SPLITTING FROM C37213J.
+ --     VCL  03/30/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
+ --                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
+ --                    PARAMETERS TO THE GENERIC UNITS AND THE
+ --                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
+ --                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
+ --                    ARE TOGETHER;  REWROTE ONE OF THE GENERIC
+ --                    PACKAGES AS A GENERIC PROCEDURE TO BROADEN
+ --                    COVERAGE OF TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37213L IS
+ BEGIN
+      TEST ("C37213L", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
+                       "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
+                       "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
+                       "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
+                       "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
+                       "FORMAL TYPE USED TO DECLARE A DERIVED OR AN " &
+                       "ACCESS TYPE");
+ 
+      DECLARE
+           SUBTYPE SM IS INTEGER RANGE 1..10;
+           TYPE REC (D1, D2 : SM) IS
+                RECORD NULL; END RECORD;
+           TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+ 
+           SEQUENCE_NUMBER : INTEGER;
+ 
+           GENERIC
+                TYPE CONS IS PRIVATE;
+                OBJ_XCP : BOOLEAN;
+                TAG     : STRING;
+           PACKAGE DER_CHK IS  END DER_CHK;
+ 
+           PACKAGE BODY DER_CHK IS
+           BEGIN
+                DECLARE
+                     TYPE DREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : DREC;
+ 
+                          FUNCTION VALUE RETURN DREC IS
+                          BEGIN
+                               IF EQUAL (3,3) THEN
+                                    RETURN X;
+                               ELSE
+                                    RETURN X;
+                               END IF;
+                          END VALUE;
+                     BEGIN
+                          IF OBJ_XCP THEN
+                               FAILED ("NO CHECK DURING DECLARATION " &
+                                       "OF OBJECT OF TYPE DREC - " &
+                                       TAG);
+                          ELSIF X /= VALUE THEN
+                               FAILED ("INCORRECT VALUE FOR OBJECT OF " &
+                                       "TYPE DREC - " & TAG);
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          IF NOT OBJ_XCP THEN
+                               FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                       "DURING DECLARATION OF OBJECT " &
+                                       "OF TYPE DREC - " & TAG);
+                          END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                             "DURING DECLARATION OF DREC - " & TAG);
+           END;
+ 
+           GENERIC
+                TYPE CONS IS PRIVATE;
+           PROCEDURE ACC_CHK (OBJ_XCP : BOOLEAN;
+                              TAG     : STRING);
+ 
+           PROCEDURE ACC_CHK (OBJ_XCP : BOOLEAN;
+                              TAG     : STRING)  IS
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                BEGIN
+                     DECLARE
+                          X : ACC_CONS;
+ 
+                          FUNCTION VALUE RETURN CONS IS
+                          BEGIN
+                               IF EQUAL (5, 5) THEN
+                                    RETURN X.ALL;
+                               ELSE
+                                    RETURN X.ALL;
+                               END IF;
+                          END VALUE;
+                     BEGIN
+                          X := NEW CONS;
+ 
+                          IF OBJ_XCP THEN
+                               FAILED ("NO CHECK DURING ALLOCATION " &
+                                       "OF OBJECT OF TYPE CONS - " &
+                                       TAG);
+                          ELSIF X.ALL /= VALUE THEN
+                               FAILED ("INCORRECT VALUE FOR OBJECT " &
+                                       "OF TYPE CONS - " & TAG);
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               IF NOT OBJ_XCP THEN
+                                    FAILED ("IMPROPER CONSTRAINT " &
+                                            "CHECKED DURING " &
+                                            "ALLOCATION OF OBJECT " &
+                                            "OF TYPE CONS - " & TAG);
+                               END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                                  "DURING DECLARATION OF X - " & TAG);
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                             "DURING DECLARATION OF ACC_CONS - " & TAG);
+           END ACC_CHK;
+      BEGIN
+           SEQUENCE_NUMBER := 1;
+           DECLARE
+                TYPE REC_DEF (D3 : INTEGER := 1) IS
+                     RECORD
+                          C1 : REC (D3, 0);
+                     END RECORD;
+ 
+                PACKAGE PACK1 IS NEW DER_CHK (REC_DEF,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK1");
+ 
+                PROCEDURE PROC1 IS NEW ACC_CHK (REC_DEF);
+           BEGIN
+                PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
+           END;
+ 
+           SEQUENCE_NUMBER := 2;
+           DECLARE
+                TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
+                     RECORD
+                          C1 : MY_ARR (0..D3);
+                     END RECORD;
+ 
+                PACKAGE PACK2 IS NEW DER_CHK (ARR_DEF,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK2");
+ 
+                PROCEDURE PROC2 IS NEW ACC_CHK (ARR_DEF);
+           BEGIN
+                PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
+           END;
+ 
+           SEQUENCE_NUMBER := 3;
+           DECLARE
+                TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK3 IS NEW DER_CHK (VAR_REC_DEF1,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK3");
+ 
+                PROCEDURE PROC3 IS NEW ACC_CHK (VAR_REC_DEF1);
+           BEGIN
+                PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
+           END;
+ 
+           SEQUENCE_NUMBER := 4;
+           DECLARE
+                TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK4 IS NEW DER_CHK (VAR_REC_DEF6,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK4");
+ 
+                PROCEDURE PROC4 IS NEW ACC_CHK (VAR_REC_DEF6);
+           BEGIN
+                PROC4 (OBJ_XCP => FALSE, TAG => "PROC4");
+           END;
+ 
+           SEQUENCE_NUMBER := 5;
+           DECLARE
+                TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : REC (D3, IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK5 IS NEW DER_CHK (VAR_REC_DEF11,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK5");
+ 
+                PROCEDURE PROC5 IS NEW ACC_CHK (VAR_REC_DEF11);
+           BEGIN
+                PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
+           END;
+ 
+           SEQUENCE_NUMBER := 6;
+           DECLARE
+                TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK6 IS NEW DER_CHK (VAR_ARR_DEF1,
+                                   OBJ_XCP => TRUE,
+                                   TAG     => "PACK6");
+ 
+                PROCEDURE PROC6 IS NEW ACC_CHK (VAR_ARR_DEF1);
+           BEGIN
+                PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
+           END;
+ 
+           SEQUENCE_NUMBER := 7;
+           DECLARE
+                TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK7 IS NEW DER_CHK (VAR_ARR_DEF6,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK7");
+ 
+                PROCEDURE PROC7 IS NEW ACC_CHK (VAR_ARR_DEF6);
+           BEGIN
+                PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
+           END;
+ 
+           SEQUENCE_NUMBER := 8;
+           DECLARE
+                TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
+                     RECORD
+                          CASE D3 IS
+                               WHEN -5..10 =>
+                                    C1 : MY_ARR(D3..IDENT_INT(11));
+                               WHEN OTHERS =>
+                                    C2 : INTEGER := IDENT_INT(5);
+                          END CASE;
+                     END RECORD;
+ 
+                PACKAGE PACK8 IS NEW DER_CHK (VAR_ARR_DEF11,
+                                   OBJ_XCP => FALSE,
+                                   TAG     => "PACK8");
+ 
+                PROCEDURE PROC8 IS NEW ACC_CHK (VAR_ARR_DEF11);
+           BEGIN
+                PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
+                        "DECLARATION / INSTANTIATION ELABORATION - " &
+                        INTEGER'IMAGE (SEQUENCE_NUMBER));
+      END;
+ 
+      RESULT;
+ END C37213L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,203 ----
+ -- C37215B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF
+ --        A DISCRIMINANT CONSTRAINT
+ -- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
+ -- COMPATIBILITY WHEN THE RECORD TYPE IS:
+ --
+ --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+ --      DECLARATION.
+ 
+ -- JBG 10/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37215B IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+      TYPE REC (D1, D2 : SM) IS
+           RECORD NULL; END RECORD;
+ 
+ BEGIN
+      TEST ("C37215B", "CHECK COMPATIBILITY OF DISCRIMINANT EXPRESSIONS"&
+                       " WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                       "AND DISCRIMINANTS HAVE DEFAULTS");
+ 
+ -- CASE B
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+                RECORD
+                     C1 : REC(D3, 1);
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                     IF X /= (1, (1, 1)) THEN
+                          COMMENT ("SHOULDN'T GET HERE");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS;
+                BEGIN
+                     X := NEW CONS;
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                     BEGIN
+                          IF X.ALL /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 3");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 4");
+                          IF X /= (1..5 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 5");
+                          IF X /= (C1 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE DREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : DREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 6");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+           RESULT;
+ 
+ END C37215B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,202 ----
+ -- C37215D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF
+ --        AN INDEX CONSTRAINT
+ -- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
+ -- COMPATIBILITY WHEN THE RECORD TYPE IS:
+ --
+ --   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+ --      DECLARATION.
+ 
+ -- JBG 10/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37215D IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+      TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+ 
+ BEGIN
+      TEST ("C37215D", "CHECK COMPATIBILITY OF INDEX BOUNDS " &
+                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                       "AND DISCRIMINANTS HAVE DEFAULTS");
+ 
+ -- CASE B
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+                RECORD
+                     C1 : MY_ARR(2..D3);
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                     IF X /= (1, (1, 1)) THEN
+                          COMMENT ("SHOULDN'T GET HERE");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS;
+                BEGIN
+                     X := NEW CONS;
+                     FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                     BEGIN
+                          IF X.ALL /= (1, (1 => 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 3");
+                          IF X /= (1, (1 => 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 4");
+                          IF X /= (1..5 => (1, (1 => 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 5");
+                          IF X /= (C1 => (1, (1 => 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE DREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : DREC;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT " &
+                                  "PERFORMED - 6");
+                          IF X /= (1, (1 => 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+           RESULT;
+ 
+ END C37215D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,313 ----
+ -- C37215F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF
+ --        A DISCRIMINANT CONSTRAINT
+ -- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
+ -- COMPATIBILITY WHEN THE RECORD TYPE IS:
+ --
+ --   CASE D: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+ --      DECLARATION AND THE COMPONENT IS PRESENT IN THE DEFAULT SUBTYPE.
+ 
+ -- JBG 10/17/86
+ -- PWN 05/31/96  Corrected format of call to "TEST" 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37215F IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+      TYPE REC (D1, D2 : SM) IS
+           RECORD NULL; END RECORD;
+ 
+ BEGIN
+      TEST ("C37215F", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
+                       "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                       "DISCRIMINANTS HAVE DEFAULTS, AND COMPONENT " &
+                       "SUBTYPE DETERMINES WHETHER CONSTRAINT SHOULD " &
+                       "BE CHECKED");
+ 
+ -- CASE D1: COMPONENT IS PRESENT
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : REC(D3, 1);
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(0);
+                     END CASE;
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                     IF X /= (1, (1, 1)) THEN
+                          COMMENT ("SHOULDN'T GET HERE");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS;
+                BEGIN
+                     X := NEW CONS;
+                     FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                     IF X.ALL /= (1, (1, 1)) THEN
+                          COMMENT ("IRRELEVANT");
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 3");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 4");
+                          IF X /= (1..5 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 5");
+                          IF X /= (C1 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE DREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : DREC;
+                     BEGIN
+                          FAILED ("DISCRIMINANT CHECK NOT " &
+                                  "PERFORMED - 6");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+           END;
+ 
+      END;
+ 
+ -- CASE C2 : COMPONENT IS ABSENT
+ 
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : REC(D3, IDENT_INT(1));
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(5);
+                     END CASE;
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     IF X /= (11, 5) THEN
+                          FAILED ("WRONG VALUE FOR X - 11");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 11");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          IF X /= (11, 5) THEN
+                               FAILED ("X VALUE WRONG - 12");
+                          END IF;
+                     END;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 12");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                     X : ARR;
+                BEGIN
+                     IF X /= (1..5 => (11, 5)) THEN
+                          FAILED ("X VALUE INCORRECT - 13");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 13");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                     X : NREC;
+                BEGIN
+                     IF X /= (C1 => (11, 5)) THEN
+                          FAILED ("X VALUE IS INCORRECT - 14");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 14");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS NEW CONS;
+                     X : NREC;
+                BEGIN
+                     IF X /= (11, 5) THEN
+                          FAILED ("X VALUE INCORRECT - 15");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 15");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS := NEW CONS;
+                BEGIN
+                     IF X.ALL /= (11, 5) THEN
+                          FAILED ("X VALUE INCORRECT - 17");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NONEXISTENT CONSTRAINT CHECKED - 17");
+           END;
+      END;
+ 
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+           RESULT;
+ 
+ END C37215F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37215h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37215h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,345 ----
+ -- C37215H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT IF AN INDEX CONSTRAINT DEPENDS ON A DISCRIMINANT,
+ --      THE DISCRIMINANT VALUE IS CHECKED FOR COMPATIBILITY WHEN THE
+ --      RECORD TYPE IS:
+ --
+ --           CASE D: CONSTRAINED BY DEFAULT AND THE COMPONENT IS
+ --                   PRESENT IN THE SUBTYPE.
+ 
+ -- HISTORY:
+ --      JBG 10/17/86  CREATED ORIGINAL TEST.
+ --      RJW 10/13/87  CORRECTED VARIOUS CONSTRAINT ERRORS IN 'CASE D1'.
+ --      VCL 03/30/88  CORRECTED VARIOUS CONSTRAINT ERRORS WITH TYPE
+ --                    DECLARATIONS THROUGHOUT THE TEST.  ADDED SEQUENCE
+ --                    NUMBERS.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37215H IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+      TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+ 
+      SEQUENCE_NUMBER : INTEGER;
+ BEGIN
+      TEST ("C37215H", "THE DISCRIMINANT VALUES OF AN INDEX " &
+                       "CONSTRAINT ARE PROPERLY CHECK FOR " &
+                       "COMPATIBILITY WHEN THE DISCRIMINANT IS " &
+                       "DEFINED BY DEFAULT AND THE COMPONENT IS AND " &
+                       "IS NOT PRESENT IN THE SUBTYPE");
+ 
+ -- CASE D1: COMPONENT IS PRESENT
+ 
+      SEQUENCE_NUMBER := 1;
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : MY_ARR(D3..1);
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(0);
+                     END CASE;
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                     IF X /= (1, (1, 1)) THEN
+                          COMMENT ("SHOULDN'T GET HERE");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT PERFORMED - 3");
+                          IF X /= (1..5 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT PERFORMED - 4");
+                          IF X /= (C1 => (1, (1, 1))) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          FAILED ("INDEX CHECK NOT PERFORMED - 5");
+                          IF X /= (1, (1, 1)) THEN
+                               COMMENT ("IRRELEVANT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                BEGIN
+                     DECLARE
+                          X : ACC_CONS;
+                     BEGIN
+                          X := NEW CONS;
+                          FAILED ("INDEX CHECK NOT PERFORMED - 6");
+                          IF X.ALL /= (1, (1, 1)) THEN
+                               COMMENT ("WRONG VALUE FOR X - 6");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                       "- 6A");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6B");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
+           END;
+      END;
+ 
+ -- CASE D2: COMPONENT IS ABSENT
+ 
+      SEQUENCE_NUMBER := 2;
+      DECLARE
+           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+                RECORD
+                     CASE D3 IS
+                          WHEN -5..10 =>
+                               C1 : MY_ARR(IDENT_INT(2)..D3);
+                          WHEN OTHERS =>
+                               C2 : INTEGER := IDENT_INT(5);
+                     END CASE;
+                END RECORD;
+      BEGIN
+           BEGIN
+                DECLARE
+                     X : CONS;
+                BEGIN
+                     IF X /= (11, 5) THEN
+                          COMMENT ("X VALUE IS INCORRECT - 11");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     SUBTYPE SCONS IS CONS;
+                BEGIN
+                     DECLARE
+                          X : SCONS;
+                     BEGIN
+                          IF X /= (11, 5) THEN
+                               FAILED ("X VALUE INCORRECT - 12");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 12A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ARR IS ARRAY (1..5) OF CONS;
+                BEGIN
+                     DECLARE
+                          X : ARR;
+                     BEGIN
+                          IF X /= (1..5 => (11, 5)) THEN
+                               FAILED ("X VALUE INCORRECT - 13");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 13A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS
+                          RECORD
+                               C1 : CONS;
+                          END RECORD;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          IF X /= (C1 => (11, 5)) THEN
+                               FAILED ("X VALUE INCORRECT - 14");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 14A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE NREC IS NEW CONS;
+                BEGIN
+                     DECLARE
+                          X : NREC;
+                     BEGIN
+                          IF X /= (11, 5) THEN
+                               FAILED ("X VALUE INCORRECT - 15");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 15A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     TYPE ACC_CONS IS ACCESS CONS;
+                     X : ACC_CONS;
+                BEGIN
+                     X := NEW CONS;
+                     IF X.ALL /= (11, 5) THEN
+                          FAILED ("X VALUE INCORRECT - 17");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 17A");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
+           END;
+      END;
+ 
+      RESULT;
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("INDEX VALUES CHECKED TOO SOON - " &
+                   INTEGER'IMAGE(SEQUENCE_NUMBER));
+           RESULT;
+ END C37215H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37217a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37217a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37217a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37217a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C37217A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
+ --     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
+ --     TYPE - AFTER THE TYPE'S FULL DECLARATION.
+ 
+ -- HISTORY:
+ --     DHH 02/05/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37217A IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+ BEGIN  --C37217A BODY
+      TEST ("C37217A", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
+                       "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
+                       "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " &
+                       "- AFTER THE TYPE'S FULL DECLARATION");
+ 
+                                          -- CHECK FULL DECLARATION
+                                          -- LOWER LIMIT
+      BEGIN
+           DECLARE
+ 
+                TYPE SM_REC(D : SM) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TYPE REC(D1 : INTEGER) IS
+                     RECORD
+                          INT : SM_REC(D1);
+                     END RECORD;
+ 
+                TYPE PTR IS ACCESS REC;
+ 
+                Y : PTR(IDENT_INT(0));           -- OPTIONAL EXCEPTION.
+           BEGIN
+                COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
+                        "- LOWER");
+                Y := NEW REC(IDENT_INT(0));      -- MANDATORY EXCEPTION.
+                FAILED("CONSTRAINT ERROR NOT RAISED");
+ 
+                IF IDENT_INT(Y.INT.D) /= IDENT_INT(-1) THEN
+                     COMMENT ("IRRELEVANT");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                            "VARIABLE ALLOCATION - LOWER");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT("OPTIONAL CONSTRAINT ERROR RAISED - LOWER");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                       "VARIABLE DECLARATION - LOWER");
+      END;
+ ---------------------------------------------------------------------
+                                          -- CHECK FULL DECLARATION
+                                          -- UPPER LIMIT
+      BEGIN
+           DECLARE
+                TYPE SM_ARR IS ARRAY(SM RANGE <>) OF INTEGER;
+ 
+                TYPE REC(D1 : INTEGER) IS
+                     RECORD
+                          INT : SM_ARR(1 .. D1);
+                     END RECORD;
+ 
+                TYPE PTR IS ACCESS REC;
+ 
+                Y : PTR(IDENT_INT(11));           -- OPTIONAL EXCEPTION.
+           BEGIN
+                COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
+                        "- UPPER");
+                Y := NEW REC'(IDENT_INT(11),     -- MANDATORY EXCEPTION.
+                                       INT => (OTHERS => IDENT_INT(0)));
+                FAILED("CONSTRAINT ERROR NOT RAISED");
+ 
+                IF IDENT_INT(Y.INT(IDENT_INT(1))) /= 11 THEN
+                     COMMENT ("IRRELEVANT");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                            "VARIABLE ALLOCATION - UPPER");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
+                        "- UPPER");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                       "VARIABLE DECLARATION - UPPER");
+      END;
+ 
+      RESULT;
+ 
+ END C37217A;  -- BODY
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37217b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37217b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37217b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37217b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- C37217B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
+ --     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
+ --     TYPE - BEFORE THE DESIGNATED TYPE'S FULL DECLARATION.
+ 
+ -- HISTORY:
+ --     DHH 08/04/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37217B IS
+ 
+      SUBTYPE SM IS INTEGER RANGE 1..10;
+ 
+ BEGIN  --C37217B BODY
+      TEST ("C37217B", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
+                       "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
+                       "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE - " &
+                       "BEFORE THE DESIGNATED TYPE'S FULL DECLARATION");
+ 
+ ---------------------------------------------------------------------
+                                              -- INCOMPLETE DECLARATION
+                                              -- UPPER LIMIT
+      BEGIN  -- F
+           DECLARE  -- F
+                TYPE REC(D1 : INTEGER);
+ 
+                TYPE PTR IS ACCESS REC;
+                X : PTR(IDENT_INT(11));
+ 
+                TYPE SM_REC(D : SM) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TYPE REC(D1 : INTEGER) IS
+                     RECORD
+                          INT : SM_REC(D1);
+                     END RECORD;
+           BEGIN
+                COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED " &
+                        "- UPPER");
+                X := NEW REC(IDENT_INT(11));
+                FAILED("CONSTRAINT ERROR NOT RAISED - UPPER");
+ 
+                IF IDENT_INT(X.INT.D) /= IDENT_INT(1) THEN
+                     COMMENT("IRREVELANT");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                            "VARIABLE USE - INCOMPLETE UPPER");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
+                        "- INCOMPLETE UPPER");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                       "VARIABLE DECLARATION - INCOMPLETE UPPER");
+      END;  -- F
+ 
+ -----------------------------------------------------------------------
+                                               -- INCOMPLETE DECLARATION
+                                               -- LOWER LIMIT
+      BEGIN  -- A
+           DECLARE  -- A
+                TYPE REC(D1 : INTEGER);
+ 
+                TYPE PTR IS ACCESS REC;
+                X : PTR(IDENT_INT(0));
+ 
+                TYPE SM_ARR IS ARRAY(SM RANGE <>) OF INTEGER;
+ 
+                TYPE REC(D1 : INTEGER) IS
+                     RECORD
+                          INT : SM_ARR(D1 .. 2);
+                     END RECORD;
+           BEGIN
+                COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED " &
+                        "- LOWER");
+                X := NEW REC'(IDENT_INT(0), INT =>
+                                              (OTHERS => IDENT_INT(1)));
+                FAILED("CONSTRAINT ERROR NOT RAISED - LOWER");
+ 
+                IF X.INT(IDENT_INT(1)) /= IDENT_INT(1) THEN
+                     COMMENT("IRREVELANT");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                            "VARIABLE USE - INCOMPLETE LOWER");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
+                        "- INCOMPLETE LOWER");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                       "VARIABLE DECLARATION - INCOMPLETE LOWER");
+      END;
+ -----------------------------------------------------------------------
+      RESULT;
+ 
+ END C37217B;  -- BODY
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37217c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37217c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37217c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37217c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C37217C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
+ --     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
+ --     TYPE - WHEN THERE IS A "LOOP" IN THE DESIGNATED TYPE'S FULL
+ --     DECLARATION.
+ 
+ -- HISTORY:
+ --     DHH 08/04/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37217C IS
+ 
+ BEGIN  --C37217C BODY
+      TEST ("C37217C", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
+                       "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
+                       "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " &
+                       "- WHEN THERE IS A ""LOOP"" IN THE DESIGNATED " &
+                       "TYPE'S FULL DECLARATION");
+ 
+      BEGIN
+           DECLARE
+                TYPE R1(D1 : INTEGER);
+                TYPE R2(D2 : INTEGER);
+                TYPE R3(D3 : POSITIVE);
+ 
+                TYPE ACC_R1 IS ACCESS R1;
+                TYPE ACC_R2 IS ACCESS R2;
+                TYPE ACC_R3 IS ACCESS R3;
+ 
+                TYPE R1(D1 : INTEGER) IS
+                     RECORD
+                          C1 : ACC_R2(D1);
+                     END RECORD;
+ 
+                TYPE R2(D2 : INTEGER) IS
+                     RECORD
+                          C2 : ACC_R3(D2);
+                     END RECORD;
+ 
+                TYPE R3(D3 : POSITIVE) IS
+                     RECORD
+                          C3 : ACC_R1(D3);
+                     END RECORD;
+ 
+                 X1 : ACC_R1(IDENT_INT(0));
+ 
+           BEGIN
+                COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED");
+ 
+                X1 := NEW R1'(D1 =>IDENT_INT(0),
+                              C1 => NEW R2'(D2 => IDENT_INT(0),
+                                            C2 => NEW R3(IDENT_INT(0))));
+ 
+                FAILED("CONSTRAINT_ERROR NOT RAISED");
+ 
+                IF IDENT_INT(X1.C1.C2.D3) /= IDENT_INT(0) THEN
+                     COMMENT("THIS LINE SHOULD NOT PRINT OUT");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                            "VARIABLE USE - LOOPED");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                       "VARIABLE DECLARATION - LOOPED");
+      END;
+ 
+      RESULT;
+ 
+ END C37217C;  -- BODY
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37304a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37304a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37304a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C37304A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL FORMS OF CHOICE ARE PERMITTED IN A VARIANT_PART,
+ -- AND, IN PARTICULAR, THAT FORMS LIKE ST RANGE L..R, AND ST ARE 
+ -- PERMITTED.
+  
+ -- ASL 7/31/81
+ --  RM 8/26/82
+ -- SPS 1/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C37304A IS
+  
+      USE REPORT;
+      
+ BEGIN
+ 
+      TEST("C37304A","ALL FORMS OF CHOICE ALLOWED IN A VARIANT_PART");
+ 
+      DECLARE
+ 
+           TYPE T IS RANGE 1 .. 10;
+           C5 : CONSTANT T := 5;
+           SUBTYPE S1 IS T RANGE 1 .. 5;
+           SUBTYPE S2 IS T RANGE C5 + 1 .. 7;
+           SUBTYPE SN IS T RANGE C5 + 4 .. C5 - 4 + 7;  -- NULL RANGE.
+           SUBTYPE S10 IS T RANGE C5 + 5 .. T'LAST;
+ 
+           TYPE VREC( DISC : T := 8 ) IS
+                RECORD
+                     CASE DISC IS
+                          WHEN SN                       -- 9..8
+                          | S1 RANGE 1 .. 0             -- 1..0
+                          | S2 RANGE C5 + 2 .. C5 + 1   -- 7..6
+                          | 3 .. 2                      -- 3..2
+                               => NULL;
+ 
+                          WHEN  S1 RANGE 4 .. C5        -- 4..5
+                          | S1 RANGE C5 - 4 .. C5 / 2   -- 1..2
+                          | 3 .. 1 + C5 MOD 3           -- 3..3
+                          | SN                          -- 9..8
+                          | S1 RANGE 5 .. C5 - 1        -- 5..4
+                          | 6 .. 7                      -- 6..7
+                          | S10                         -- 10..10
+                          | 9                           -- 9
+                          | S10 RANGE 10 .. 9           -- 10..9
+                               => NULL;
+ 
+                          WHEN C5 + C5 - 2 .. 8         -- 8
+                               => NULL;
+ 
+                     END CASE;
+                END RECORD;
+  
+           V : VREC;
+ 
+      BEGIN
+ 
+           IF EQUAL(3,3) THEN
+                V := (DISC => 5);
+           END IF;
+           IF V.DISC /= 5 THEN
+                FAILED ("ASSIGNMENT FAILED");
+           END IF;
+ 
+      END;
+  
+      RESULT;
+ 
+ END C37304A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37305a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37305a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37305a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C37305A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CHOICES DENOTING A NULL RANGE OF VALUES ARE PERMITTED,
+ -- AND THAT FOR CHOICES CONSISTING OF A SUBTYPE NAME FOLLOWED BY A
+ -- RANGE CONSTRAINT WHERE THE LOWER BOUND IS GREATER THAN THE UPPER
+ -- BOUND, THE BOUNDS NEED NOT BE IN THE RANGE OF THE SUBTYPE VALUES.
+ 
+ -- CHECK THAT AN OTHERS ALTERNATIVE CAN BE PROVIDED EVEN IF ALL VALUES
+ -- OF THE CASE EXPRESSION HAVE BEEN COVERED BY PRECEDING ALTERNATIVES.
+ 
+ -- ASL 7/14/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C37305A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C37305A","NULL RANGES ALLOWED IN CHOICES FOR VARIANT " &
+            "PARTS.  OTHERS ALTERNATIVE ALLOWED AFTER ALL VALUES " &
+            "PREVIOUSLY COVERED");
+ 
+      DECLARE
+           SUBTYPE ST IS INTEGER RANGE 1..10;
+ 
+           TYPE REC(DISC : ST := 1) IS
+                RECORD
+                     CASE DISC IS
+                          WHEN 0..-1 => NULL;
+                          WHEN 1..-3 => NULL;
+                          WHEN 6..5 =>
+                               COMP : INTEGER;
+                          WHEN 11..10 => NULL;
+                          WHEN 15..12 => NULL;
+                          WHEN 11..0 => NULL;
+                          WHEN 1..10 => NULL;
+                          WHEN OTHERS => NULL;
+                     END CASE;
+                END RECORD;
+ 
+           R : REC;
+      BEGIN
+           R := (DISC => 4);
+ 
+           IF EQUAL(3,4) THEN
+                R := (DISC => 7);
+           END IF;
+ 
+           IF R.DISC /= 4 THEN
+                FAILED ("ASSIGNMENT FAILED");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C37305A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37306a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37306a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37306a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37306a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- C37306A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN A VARIANT PART OF A RECORD THE CHOICES WITHIN AND
+ -- BETWEEN ALTERNATIVES CAN APPEAR IN NON-MONOTONIC ORDER.
+ 
+ -- ASL 7/13/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT;
+ PROCEDURE C37306A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C37306A","NON-MONOTONIC ORDER OF CHOICES IN VARIANT PARTS");
+ 
+      DECLARE
+           TYPE COLOR IS (WHITE,RED,ORANGE,YELLOW,GREEN,AQUA,BLUE,BLACK);
+ 
+           TYPE REC(DISC : COLOR := BLUE) IS
+                RECORD
+                     CASE DISC IS
+                          WHEN ORANGE => NULL;
+                          WHEN GREEN | WHITE | BLACK => NULL;
+                          WHEN YELLOW => NULL;
+                          WHEN BLUE | RED => NULL;
+                          WHEN OTHERS => NULL;
+                     END CASE;
+                END RECORD;
+ 
+           R : REC;
+      BEGIN
+           R := (DISC => WHITE);
+ 
+           IF EQUAL(3,4) THEN
+                R := (DISC => RED);
+           END IF;
+ 
+           IF R.DISC /= WHITE THEN
+                FAILED ("ASSIGNMENT FAILED");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C37306A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37309a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37309a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37309a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37309a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C37309A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A DISCRIMINANT HAS A STATIC SUBTYPE, AN OTHERS
+ -- CHOICE CAN BE OMITTED IF ALL VALUES IN THE 
+ -- SUBTYPE'S RANGE ARE COVERED IN A VARIANT PART.
+  
+ -- ASL 7/10/81
+ -- SPS 10/25/82
+ -- SPS 7/17/83
+ 
+ WITH REPORT;
+ PROCEDURE C37309A IS
+ 
+      USE REPORT;
+  
+ BEGIN
+      TEST ("C37309A","OTHERS CHOICE CAN BE OMITTED IN VARIANT PART " &
+            "IF ALL VALUES IN STATIC SUBTYPE RANGE OF DISCRIMINANT " &
+            "ARE COVERED");
+  
+      DECLARE
+           SUBTYPE STATCHAR IS CHARACTER RANGE 'I'..'N';
+           TYPE REC1(DISC : STATCHAR := 'J') IS
+                RECORD
+                     CASE DISC IS
+                          WHEN 'I' => NULL;
+                          WHEN 'J' => NULL;
+                          WHEN 'K' => NULL;
+                          WHEN 'L' => NULL;
+                          WHEN 'M' => NULL;
+                          WHEN 'N' => NULL;
+                     END CASE;          
+                END RECORD;
+       
+           R1 : REC1;
+      BEGIN
+           R1 := (DISC => 'N');
+           IF EQUAL(3,3) THEN
+                R1 := (DISC => 'K');
+           END IF;
+           IF R1.DISC /= 'K' THEN
+                FAILED ("ASSIGNMENT FAILED - 1");
+           END IF;
+  
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED");
+      END;
+  
+      RESULT;
+  
+ END C37309A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37310a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37310a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37310a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37310a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C37310A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A DISCRIMINANT HAS A DYNAMIC SUBTYPE, AN OTHERS
+ -- CHOICE CAN BE OMITTED IF ALL VALUES IN THE BASE
+ -- TYPE'S RANGE ARE COVERED.
+  
+ -- ASL 7/10/81
+ -- SPS 10/25/82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT;
+ PROCEDURE C37310A IS
+  
+      USE REPORT;
+  
+ BEGIN
+      TEST ("C37310A", "CHECK DYNAMIC DISCRIMINANT SUBTYPES " &
+                       "IN VARIANT RECORD DECLARATIONS");
+ 
+      DECLARE
+  
+           ACHAR : CHARACTER := IDENT_CHAR('A');
+           ECHAR : CHARACTER := IDENT_CHAR('E');
+           JCHAR : CHARACTER := IDENT_CHAR('J');
+           MCHAR : CHARACTER := IDENT_CHAR('M');
+           SUBTYPE STATCHAR IS CHARACTER RANGE 'I'..'N';
+           SUBTYPE DYNCHAR IS CHARACTER RANGE ACHAR..ECHAR; 
+           SUBTYPE SSTAT IS STATCHAR RANGE JCHAR..MCHAR;
+ 
+           TYPE LETTER IS NEW CHARACTER RANGE 'A'..'Z';
+           SUBTYPE DYNLETTER IS 
+                LETTER RANGE LETTER(ECHAR)..LETTER(JCHAR);     
+  
+           TYPE REC1(DISC : SSTAT := 'K') IS
+                RECORD
+                     CASE DISC IS
+                          WHEN ASCII.NUL..CHARACTER'LAST => NULL;
+                     END CASE;
+                END RECORD;
+       
+           TYPE REC2(DISC : DYNCHAR := 'C') IS
+                RECORD
+                     CASE DISC IS
+                          WHEN ASCII.NUL..CHARACTER'LAST => NULL;
+                     END CASE;       
+                END RECORD;
+       
+           TYPE REC3(DISC: DYNCHAR := 'D') IS
+                RECORD
+                     CASE DISC IS
+                          WHEN CHARACTER'FIRST..CHARACTER'LAST => NULL;
+                     END CASE; 
+                END RECORD;
+       
+           TYPE REC4(DISC : DYNLETTER := 'F') IS
+                RECORD
+                     CASE DISC IS
+                          WHEN LETTER'BASE'FIRST..
+                               LETTER'BASE'LAST => NULL;
+                     END CASE; 
+                END RECORD;
+  
+           R1 : REC1;
+           R2 : REC2;
+           R3 : REC3;
+           R4 : REC4;
+      BEGIN
+           IF EQUAL(3,3) THEN
+                R1 := (DISC => 'L');
+           END IF;
+           IF R1.DISC /= 'L' THEN
+                FAILED ("ASSIGNMENT FAILED - 1");
+           END IF;
+  
+           IF EQUAL(3,3) THEN
+               R2 := (DISC => 'B');
+           END IF;
+           IF R2.DISC /= 'B' THEN
+                FAILED ("ASSIGNMENT FAILED - 2");
+           END IF;
+  
+           IF EQUAL(3,3) THEN
+                R3 := (DISC => 'B');
+           END IF;
+           IF R3.DISC /= 'B' THEN
+                FAILED ("ASSIGNMENT FAILED - 3");
+           END IF;
+  
+           IF EQUAL(3,3) THEN
+                R4 := (DISC => 'H');
+           END IF;
+           IF R4.DISC /= 'H' THEN
+                FAILED ("ASSIGNMENT FAILED - 4");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED");
+      END;
+  
+      RESULT;
+  
+ END C37310A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37312a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37312a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37312a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37312a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C37312A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DISCRIMINANT CAN HAVE A GENERIC FORMAL DISCRETE
+ --     TYPE WHEN IT DOES NOT GOVERN A VARIANT PART AND THAT AN
+ --     OBJECT OF A GENERIC FORMAL TYPE CAN CONSTRAIN A COMPONENT
+ --     IN A VARIANT PART.
+ 
+ -- HISTORY:
+ --     AH  08/22/86  CREATED ORIGINAL TEST.
+ --     JET 08/13/87  REVISED FROM CLASS 'A' TO CLASS 'C' TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C37312A IS
+ 
+ BEGIN
+      TEST ("C37312A", "DISCRIMINANT TYPE IS GENERIC FORMAL TYPE");
+ 
+      DECLARE
+           TYPE T IS RANGE 1 ..5;
+ 
+           GENERIC
+                TYPE G1 IS RANGE <>;
+           PACKAGE P IS
+                TYPE G2 (D1 : G1) IS
+                     RECORD
+                          R1 : G1;
+                          R2 : BOOLEAN;
+                     END RECORD;
+ 
+                TYPE STR IS ARRAY(G1 RANGE <>) OF INTEGER;
+                TYPE G3 (D : G1; E : INTEGER) IS
+                     RECORD
+                          CASE E IS
+                               WHEN 1 =>
+                                    S1 : STR(G1'FIRST..D);
+                               WHEN OTHERS =>
+                                    S2 : INTEGER;
+                          END CASE;
+                     END RECORD;
+ 
+           END P;
+ 
+           PACKAGE PKG IS NEW P (G1 => T);
+           USE PKG;
+ 
+           A2: G2(1) := (1, 5, FALSE);
+           A3: G3(5, 1) := (5, 1, (1, 2, 3, 4, 5));
+ 
+      BEGIN
+           A2.R2 := IDENT_BOOL (TRUE);
+           A3.S1(1) := IDENT_INT (6);
+ 
+           IF A2 /= (1, 5, TRUE) THEN
+                FAILED ("INVALID CONTENTS OF RECORD A2");
+           END IF;
+           IF A3 /= (5, 1, (6, 2, 3, 4, 5)) THEN
+                FAILED ("INVALID CONTENTS OF RECORD A3");
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C37312A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37402a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37402a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37402a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,253 ----
+ -- C37402A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 
+ -- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT 
+ -- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL 
+ -- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER 
+ -- FOR THE OTHER MODES.
+ 
+ -- R.WILLIAMS 9/1/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37402A IS
+ 
+ BEGIN
+      TEST ( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
+                        "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
+                        "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
+                        "HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " &
+                        "APPLIED TO FORMAL PARAMETERS OF MODE IN " &
+                        "AND HAS THE VALUE OF THE ACTUAL PARAMETER " &
+                        "FOR THE OTHER MODES" );
+ 
+      
+      DECLARE
+ 
+           SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+ 
+           TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>) 
+                OF INTEGER;
+ 
+           TYPE SQUARE (SIDE : INT := 1) IS
+                RECORD
+                     MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
+                END RECORD;
+ 
+           SC : CONSTANT SQUARE := (2, ((0, 0), (0, 0)));
+ 
+           AC : SQUARE (2) := (2, ((1, 2), (3, 4)));
+           AU : SQUARE     := (SIDE => 1, MAT => (1 => (1 => 1)));
+ 
+           BC : SQUARE (2) := AC;
+           BU : SQUARE     := AU;
+ 
+           CC : SQUARE (2);
+           CU : SQUARE;
+  
+           PROCEDURE P (CON, IN_CON : IN     SQUARE; 
+                        INOUT_CON   : IN OUT SQUARE;
+                        OUT_CON     : OUT    SQUARE; 
+                        IN_UNC      : IN     SQUARE; 
+                        INOUT_UNC   : IN OUT SQUARE; 
+                        OUT_UNC     : OUT    SQUARE) IS
+ 
+           BEGIN
+                IF CON'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 1" );
+                END IF;
+ 
+                IF IN_CON'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 2" );
+                END IF;
+ 
+                IF IN_UNC'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 3" );
+                END IF;
+ 
+                IF INOUT_CON'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                              "CONSTRAINED OBJECT OF IN OUT MODE - 1" );
+                END IF;
+ 
+                IF OUT_CON'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                              "CONSTRAINED OBJECT OF OUT MODE - 1" );
+                END IF;
+ 
+                IF INOUT_UNC'CONSTRAINED THEN
+                     FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                              "UNCONSTRAINED OBJECT OF IN OUT MODE " &
+                              "- 1" );
+                END IF;
+ 
+                IF OUT_UNC'CONSTRAINED THEN
+                     FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                              "UNCONSTRAINED OBJECT OF OUT MODE - 1" );
+                END IF;
+           
+                OUT_CON := (2, ((1, 2), (3, 4)));
+                OUT_UNC := (2, ((1, 2), (3, 4)));
+           END P;
+ 
+           TASK T IS 
+                ENTRY Q (CON, IN_CON : IN     SQUARE; 
+                         INOUT_CON   : IN OUT SQUARE;
+                         OUT_CON     : OUT    SQUARE; 
+                         IN_UNC      : IN     SQUARE; 
+                         INOUT_UNC   : IN OUT SQUARE; 
+                         OUT_UNC     : OUT    SQUARE);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT Q (CON, IN_CON : IN     SQUARE; 
+                          INOUT_CON   : IN OUT SQUARE;
+                          OUT_CON     : OUT    SQUARE; 
+                          IN_UNC      : IN     SQUARE; 
+                          INOUT_UNC   : IN OUT SQUARE; 
+                          OUT_UNC     : OUT    SQUARE) DO
+                     BEGIN
+                          IF CON'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "OBJECT OF IN MODE - 4" );
+                          END IF;
+ 
+                          IF IN_CON'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "OBJECT OF IN MODE - 5" );
+                          END IF;
+ 
+                          IF IN_UNC'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "OBJECT OF IN MODE - 6" );
+                          END IF;
+      
+                          IF INOUT_CON'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "CONSTRAINED OBJECT OF " &
+                                        "IN OUT MODE - 2" );
+                          END IF;
+           
+                          IF OUT_CON'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "CONSTRAINED OBJECT OF " &
+                                        "OUT MODE - 2" );
+                          END IF;
+ 
+                          IF INOUT_UNC'CONSTRAINED THEN
+                               FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                                        "UNCONSTRAINED OBJECT OF " &
+                                        "IN OUT MODE - 2" );
+                          END IF;
+           
+                          IF OUT_UNC'CONSTRAINED THEN
+                               FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                                        "UNCONSTRAINED OBJECT OF " &
+                                        "OUT MODE - 2" );
+                          END IF;
+           
+                          OUT_CON := (2, ((1, 2), (3, 4)));
+                          OUT_UNC := (2, ((1, 2), (3, 4)));
+                     END;
+                END Q;
+           END T;
+ 
+           GENERIC
+                CON, IN_CON : IN     SQUARE; 
+                INOUT_CON   : IN OUT SQUARE;
+                IN_UNC      : IN     SQUARE; 
+                INOUT_UNC   : IN OUT SQUARE; 
+           PACKAGE R IS END R;
+ 
+           PACKAGE BODY R IS
+           BEGIN
+                IF CON'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 7" );
+                END IF;
+ 
+                IF IN_CON'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 8" );
+                END IF;
+ 
+                IF IN_UNC'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 9" );
+                END IF;
+ 
+                IF INOUT_CON'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                              "CONSTRAINED OBJECT OF IN OUT MODE - 3" );
+                END IF;
+ 
+                IF INOUT_UNC'CONSTRAINED THEN
+                     FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                              "UNCONSTRAINED OBJECT OF IN OUT MODE " &
+                              "- 3" );
+                END IF;
+ 
+           END R;
+ 
+           PACKAGE S IS NEW R (SC, AC, BC, AU, BU);
+ 
+      BEGIN
+           P (SC, AC, BC, CC, AU, BU, CU);
+           T.Q (SC, AC, BC, CC, AU, BU, CU);
+      END;
+           
+      RESULT;
+ END C37402A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37403a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37403a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37403a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37403a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- C37403A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 
+ -- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT DO 
+ -- NOT HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' REGARDLESS OF THE MODE 
+ -- OF THE PARAMETER.
+ 
+ -- R.WILLIAMS 9/1/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37403A IS
+ 
+ BEGIN
+      TEST ( "C37403A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
+                        "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
+                        "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
+                        "DO NOT HAVE DEFAULTS, 'CONSTRAINED IS " &
+                        "'TRUE' REGARDLESS OF THE MODE OF THE " &
+                        "PARAMETER" );
+ 
+      
+      DECLARE
+ 
+           SUBTYPE INT IS INTEGER RANGE 1.. 10;
+ 
+           TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>) 
+                OF INTEGER;
+ 
+           TYPE SQUARE (SIDE : INT) IS
+                RECORD
+                     MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
+                END RECORD;
+ 
+           S1 : SQUARE (2) := (2, ((1, 2), (3, 4)));
+ 
+           S2 : SQUARE (2) := S1;
+ 
+           S3 : SQUARE (2);
+  
+           SC : CONSTANT SQUARE := (SIDE => 1, MAT => (1 => (1 => 1)));
+ 
+           PROCEDURE P (PIN1, PIN2 : IN     SQUARE; 
+                        PINOUT     : IN OUT SQUARE;
+                        POUT       : OUT    SQUARE) IS
+ 
+           BEGIN
+                IF PIN1'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 1" );
+                END IF;
+ 
+                IF PIN2'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 2" );
+                END IF;
+ 
+                IF PINOUT'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                              "OBJECT OF IN OUT MODE - 1" );
+                END IF;
+ 
+                IF POUT'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                              "OBJECT OF OUT MODE - 1" );
+                END IF;
+ 
+                POUT := (2, ((1, 2), (3, 4)));
+           END P;
+ 
+           TASK T IS 
+                ENTRY Q (PIN1, PIN2  : IN     SQUARE; 
+                         PINOUT      : IN OUT SQUARE;
+                         POUT        : OUT    SQUARE);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT Q (PIN1, PIN2  : IN     SQUARE; 
+                          PINOUT      : IN OUT SQUARE;
+                          POUT        : OUT    SQUARE) DO
+ 
+                     BEGIN
+                          IF PIN1'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "OBJECT OF IN MODE - 3" );
+                          END IF;
+ 
+                          IF PIN2'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "OBJECT OF IN MODE - 4" );
+                          END IF;
+      
+                          IF PINOUT'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "OBJECT OF " &
+                                        "IN OUT MODE - 2" );
+                          END IF;
+           
+                          IF POUT'CONSTRAINED THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                        "OBJECT OF " &
+                                        "OUT MODE - 2" );
+                          END IF;
+ 
+                          POUT := (2, ((1, 2), (3, 4)));
+                     END;
+                END Q;
+           END T;
+ 
+           GENERIC
+                PIN1, PIN2 : IN     SQUARE; 
+                PINOUT     : IN OUT SQUARE;
+           PACKAGE R IS END R;
+ 
+           PACKAGE BODY R IS
+           BEGIN
+                IF PIN1'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 5" );
+                END IF;
+ 
+                IF PIN2'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                              "OF IN MODE - 6" );
+                END IF;
+ 
+                IF PINOUT'CONSTRAINED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                              "OBJECT OF IN OUT MODE - 3" );
+                END IF;
+ 
+           END R;
+ 
+           PACKAGE S IS NEW R (S1, SC, S2);
+ 
+      BEGIN
+           P (S1, SC, S2, S3);
+           T.Q (S1, SC, S2, S3);
+      END;
+           
+      RESULT;
+ END C37403A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37404a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37404a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37404a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37404a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,168 ----
+ --C37404A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES DECLARED WITH A
+ --     CONSTRAINED TYPE, FOR CONSTANT OBJECTS (EVEN IF NOT DECLARED
+ --     WITH A CONSTRAINED TYPE), AND DESIGNATED OBJECTS.
+ 
+ -- HISTORY:
+ --     DHH 02/25/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37404A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+      TYPE REC(A : INT) IS
+           RECORD
+                I : INT;
+      END RECORD;
+ 
+      TYPE ACC_REC IS ACCESS REC(4);
+      TYPE ACC_REC1 IS ACCESS REC;
+      SUBTYPE REC4 IS REC(4);
+      SUBTYPE REC5 IS REC;
+ 
+      TYPE REC_DEF(A : INT := 5) IS
+           RECORD
+                I : INT := 1;
+      END RECORD;
+ 
+      TYPE ACC_DEF IS ACCESS REC_DEF(4);
+      TYPE ACC_DEF1 IS ACCESS REC_DEF;
+      SUBTYPE REC6 IS REC_DEF(6);
+      SUBTYPE REC7 IS REC_DEF;
+ 
+      A : REC4 := (A => 4, I => 1);                    -- CONSTRAINED.
+      B : REC5(4) := (A => 4, I => 1);                 -- CONSTRAINED.
+      C : REC6;                                        -- CONSTRAINED.
+      D : REC7(6);                                     -- CONSTRAINED.
+      E : ACC_REC1(4);                                 -- CONSTRAINED.
+      F : ACC_DEF1(4);                                 -- CONSTRAINED.
+      G : ACC_REC1;                                    -- UNCONSTRAINED.
+      H : ACC_DEF1;                                    -- UNCONSTRAINED.
+ 
+      R : REC(5) := (A => 5, I => 1);                  -- CONSTRAINED.
+      T : REC_DEF(5);                                  -- CONSTRAINED.
+      U : ACC_REC;                                     -- CONSTRAINED.
+      V : ACC_DEF;                                     -- CONSTRAINED.
+      W : CONSTANT REC(5) := (A => 5, I => 1);         -- CONSTANT.
+      X : CONSTANT REC := (A => 5, I => 1);            -- CONSTANT.
+      Y : CONSTANT REC_DEF(5) := (A => 5, I => 1);     -- CONSTANT.
+      Z : CONSTANT REC_DEF := (A => 5, I => 1);        -- CONSTANT.
+ 
+ BEGIN
+      TEST("C37404A", "CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES " &
+                      "DECLARED WITH A  CONSTRAINED TYPE, FOR " &
+                      "CONSTANT OBJECTS (EVEN IF NOT DECLARED WITH A " &
+                      "CONSTRAINED TYPE), AND DESIGNATED OBJECTS");
+ 
+      U := NEW REC(4);
+      V := NEW REC_DEF(4);
+      E := NEW REC(4);
+      F := NEW REC_DEF(4);
+      G := NEW REC(4);                                 -- CONSTRAINED.
+      H := NEW REC_DEF(4);                             -- CONSTRAINED.
+ 
+      IF NOT A'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE1");
+      END IF;
+ 
+      IF NOT B'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE2");
+      END IF;
+ 
+      IF NOT C'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE1");
+      END IF;
+ 
+      IF NOT D'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE2");
+      END IF;
+ 
+      IF NOT R'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR RECORD COMPONENT");
+      END IF;
+ 
+      IF NOT T'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT VARIABLE");
+      END IF;
+ 
+      IF NOT E.ALL'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 1");
+      END IF;
+ 
+      IF NOT F.ALL'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 1");
+      END IF;
+ 
+      IF NOT G.ALL'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 2");
+      END IF;
+ 
+      IF NOT H.ALL'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 2");
+      END IF;
+ 
+      IF NOT U.ALL'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 3");
+      END IF;
+ 
+      IF NOT V.ALL'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 3");
+      END IF;
+ 
+      IF NOT W'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, CONSTRAINED");
+      END IF;
+ 
+      IF NOT X'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, UNCONSTRAINED");
+      END IF;
+ 
+      IF NOT Y'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
+                  "CONSTRAINED");
+      END IF;
+ 
+      IF NOT Z'CONSTRAINED THEN
+           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
+                  "UNCONSTRAINED");
+      END IF;
+ 
+      IF IDENT_INT(T.I) /= 1 OR
+         IDENT_INT(C.I) /= 1 OR
+         IDENT_INT(D.I) /= 1 OR
+         IDENT_INT(W.A) /= 5 OR
+         IDENT_INT(X.A) /= 5 OR
+         IDENT_INT(Y.A) /= 5 OR
+         IDENT_INT(Z.I) /= 1 OR
+         IDENT_INT(A.I) /= 1 OR
+         IDENT_INT(B.I) /= 1 OR
+         IDENT_BOOL(R.I /= 1) THEN
+              FAILED("INCORRECT INITIALIZATION VALUES");
+      END IF;
+ 
+      RESULT;
+ END C37404A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37404b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37404b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37404b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37404b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ --C37404B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'CONSTRAINED IS FALSE FOR VARIABLES THAT HAVE
+ --     DISCRIMINANTS WITH DEFAULT VALUES.
+ 
+ -- HISTORY:
+ --     LDC 06/08/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37404B IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+ 
+      TYPE REC_DEF(A : INT := 5) IS
+           RECORD
+                I : INT := 1;
+      END RECORD;
+ 
+      SUBTYPE REC_DEF_SUB IS REC_DEF;
+ 
+      TYPE REC_DEF_ARR     IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF;
+      TYPE REC_DEF_SARR IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF_SUB;
+ 
+      PACKAGE PRI_PACK IS
+           TYPE REC_DEF_PRI(A : INTEGER := 5) IS PRIVATE;
+           TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS LIMITED PRIVATE;
+ 
+      PRIVATE
+ 
+           TYPE REC_DEF_PRI(A : INTEGER := 5) IS
+                RECORD
+                     I : INTEGER := 1;
+           END RECORD;
+ 
+           TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS
+                RECORD
+                     I : INTEGER := 1;
+           END RECORD;
+ 
+      END PRI_PACK;
+      USE PRI_PACK;
+ 
+      A : REC_DEF;
+      B : REC_DEF_SUB;
+      C : ARRAY (0..15) OF REC_DEF;
+      D : ARRAY (0..15) OF REC_DEF_SUB;
+      E : REC_DEF_ARR;
+      F : REC_DEF_SARR;
+      G : REC_DEF_PRI;
+      H : REC_DEF_LIM_PRI;
+ 
+      Z : REC_DEF;
+ 
+      PROCEDURE SUBPROG(REC : OUT REC_DEF) IS
+ 
+      BEGIN
+           IF REC'CONSTRAINED THEN
+                FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT " &
+                       "PARAMETER INSIDE THE SUBPROGRAM");
+           END IF;
+      END SUBPROG;
+ 
+ BEGIN
+      TEST("C37404B", "CHECK THAT 'CONSTRAINED IS FALSE FOR VARIABLES" &
+                      " THAT HAVE DISCRIMINANTS WITH DEFAULT VALUES.");
+ 
+      IF A'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR RECORD COMPONENT");
+      END IF;
+ 
+      IF B'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR SUBTYPE");
+      END IF;
+ 
+      IF C(1)'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE");
+      END IF;
+ 
+      IF D(1)'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE");
+      END IF;
+ 
+      IF E(1)'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE");
+      END IF;
+ 
+      IF F(1)'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE");
+      END IF;
+ 
+      IF G'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR PRIVATE TYPE");
+      END IF;
+ 
+      IF H'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR LIMITED PRIVATE TYPE");
+      END IF;
+ 
+      SUBPROG(Z);
+      IF Z'CONSTRAINED THEN
+           FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT PARAMETER " &
+                  "AFTER THE CALL");
+      END IF;
+ 
+      IF IDENT_INT(A.I)    /= 1 OR
+         IDENT_INT(B.I)    /= 1 OR
+         IDENT_INT(C(1).I) /= 1 OR
+         IDENT_INT(D(1).I) /= 1 OR
+         IDENT_INT(E(1).I) /= 1 OR
+         IDENT_INT(F(1).I) /= 1 OR
+         IDENT_INT(Z.I)    /= 1 OR
+         IDENT_INT(A.A)    /= 5 OR
+         IDENT_INT(B.A)    /= 5 OR
+         IDENT_INT(C(1).A) /= 5 OR
+         IDENT_INT(D(1).A) /= 5 OR
+         IDENT_INT(E(1).A) /= 5 OR
+         IDENT_INT(F(1).A) /= 5 OR
+         IDENT_INT(G.A)    /= 5 OR
+         IDENT_INT(H.A)    /= 5 OR
+         IDENT_INT(Z.A)    /= 5 THEN
+              FAILED("INCORRECT INITIALIZATION VALUES");
+      END IF;
+ 
+      RESULT;
+ END C37404B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37405a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37405a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37405a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37405a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,161 ----
+ -- C37405A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED
+ -- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT
+ -- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED
+ -- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER.
+  
+ -- ASL 7/21/81
+ -- TBN 1/20/86     RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS 
+ --                 OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND
+ --                 RECORD COMPONENTS.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37405A IS
+  
+      TYPE REC(DISC : INTEGER := 25) IS
+           RECORD
+                COMP : INTEGER;
+           END RECORD;
+  
+      SUBTYPE CONSTR IS REC(10);
+      SUBTYPE UNCONSTR IS REC;
+ 
+      TYPE REC_C IS 
+           RECORD
+                COMP: CONSTR;
+           END RECORD;
+ 
+      TYPE REC_U IS
+           RECORD
+                COMP: UNCONSTR;
+           END RECORD;
+  
+      C1,C2 : CONSTR;
+      U1,U2 : UNCONSTR;
+ -- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2.
+ 
+      ARR_C : ARRAY (1..5) OF CONSTR;
+      ARR_U : ARRAY (1..5) OF UNCONSTR;
+ 
+      REC_COMP_C : REC_C;
+      REC_COMP_U : REC_U;
+  
+      PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+      BEGIN
+           PARM := C2;
+           IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN
+                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                        "ASSIGNMENT - 1");
+           END IF;
+      END PROC11;
+ 
+      PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+      BEGIN
+           PARM := U2;
+           IF B /= PARM'CONSTRAINED THEN
+                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                        "ASSIGNMENT - 2");
+           END IF;
+      END PROC12;
+ 
+      PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+      BEGIN
+           IF B /= PARM'CONSTRAINED THEN
+                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                        "PASSING PARAMETER");
+           END IF;
+  
+           PROC11(PARM, B);
+  
+           PROC12(PARM, B);
+ 
+      END PROC1;
+  
+      PROCEDURE PROC2(PARM : IN OUT CONSTR) IS
+      BEGIN
+           COMMENT ("CALLING PROC1 FROM PROC2");   -- IN CASE TEST FAILS.
+           PROC1(PARM,TRUE);
+           PARM := U2;
+           IF NOT PARM'CONSTRAINED THEN
+                FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                        "ASSIGNMENT - 3");
+           END IF;
+      END PROC2;
+ BEGIN
+      TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " &
+                      "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT");
+  
+      C2 := (DISC => IDENT_INT(10), COMP => 3);
+      U2 := (DISC => IDENT_INT(10), COMP => 4);
+ 
+      ARR_C := (1..5 => U2);
+      ARR_U := (1..5 => C2);
+ 
+      REC_COMP_C := (COMP => U2);
+      REC_COMP_U := (COMP => C2);
+  
+      C1 := U2;
+      U1 := C2;
+  
+      IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN
+           FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4");
+      END IF;
+ 
+      IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN
+           FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5");
+      END IF;
+ 
+      IF REC_COMP_U.COMP'CONSTRAINED
+          OR NOT REC_COMP_C.COMP'CONSTRAINED THEN
+           FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6");
+      END IF;
+  
+      COMMENT("CALLING PROC1 DIRECTLY");
+      PROC1(C1,TRUE);
+      PROC2(C1);
+ 
+      COMMENT("CALLING PROC1 DIRECTLY");
+      PROC1(U1,FALSE);
+      PROC2(U1);
+ 
+      COMMENT("CALLING PROC1 DIRECTLY");
+      PROC1(ARR_C(4), TRUE);
+      PROC2(ARR_C(5));
+ 
+      COMMENT("CALLING PROC1 DIRECTLY");
+      PROC1(ARR_U(2), FALSE);
+      PROC2(ARR_U(3));
+ 
+      COMMENT("CALLING PROC1 DIRECTLY");
+      PROC1(REC_COMP_C.COMP, TRUE);
+      PROC2(REC_COMP_C.COMP);
+ 
+      COMMENT("CALLING PROC1 DIRECTLY");
+      PROC1(REC_COMP_U.COMP, FALSE);
+      PROC2(REC_COMP_U.COMP);
+  
+      RESULT;
+ END C37405A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37411a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37411a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c37411a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c37411a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C37411A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATIONS OF ASSIGNMENT, COMPARISON, MEMBERSHIP
+ --     TESTS, QUALIFICATION, TYPE CONVERSION, 'BASE, 'SIZE AND 'ADDRESS,
+ --     ARE DEFINED FOR NULL RECORDS.
+ 
+ -- HISTORY:
+ --     DHH 03/04/88 CREATED ORIGINAL TEST.
+ --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C37411A IS
+      TYPE S IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      SUBTYPE SS IS S;
+ 
+      U,V,W : S;
+      X : SS;
+ 
+ BEGIN
+ 
+      TEST("C37411A", "CHECK THAT THE OPERATIONS OF ASSIGNMENT, " &
+                      "COMPARISON, MEMBERSHIP TESTS, QUALIFICATION, " &
+                      "TYPE CONVERSION, 'BASE, 'SIZE AND 'ADDRESS, " &
+                      "ARE DEFINED FOR NULL RECORDS");
+      U := W;
+      IF U /= W THEN
+           FAILED("EQUALITY/ASSIGNMENT DOES NOT PERFORM CORRECTLY");
+      END IF;
+ 
+      IF V NOT IN S THEN
+           FAILED("MEMBERSHIP DOES NOT PERFORM CORRECTLY");
+      END IF;
+ 
+      IF X /= SS(V) THEN
+           FAILED("TYPE CONVERSION DOES NOT PERFORM CORRECTLY");
+      END IF;
+ 
+      IF S'(U) /= S'(W) THEN
+           FAILED("QUALIFIED EXPRESSION DOES NOT PERFORM CORRECTLY");
+      END IF;
+ 
+      IF X'SIZE /= V'SIZE THEN
+           FAILED("'BASE'SIZE DOES NOT PERFORM CORRECTLY WHEN PREFIX " &
+                  "IS AN OBJECT");
+      END IF;
+ 
+      IF X'ADDRESS = V'ADDRESS THEN
+           COMMENT("NULL RECORDS HAVE THE SAME ADDRESS");
+      ELSE
+           COMMENT("NULL RECORDS DO NOT HAVE THE SAME ADDRESS");
+      END IF;
+ 
+      RESULT;
+ END C37411A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C380001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that checks are made properly when a per-object expression contains
+ --    an attribute whose prefix denotes the current instance of the type.
+ --    (Defect Report 8652/0002, as reflected in Technical Corrigendum 1,
+ --    RM95 3.8(18/1)).
+ --
+ -- CHANGE HISTORY:
+ --     9 FEB 2001   PHL   Initial version.
+ --    29 JUN 2002   RLB   Readied for release.
+ --
+ --!
+ with Ada.Exceptions;
+ use Ada.Exceptions;
+ with Report;
+ use Report;
+ procedure C380001 is
+ 
+     type Negative is range Integer'First .. -1;
+ 
+     type R1 is
+         record
+             C : Negative := Negative (Ident_Int (R1'Size));
+         end record;
+ 
+ 
+     type R2;
+ 
+     type R3 (D1 : access R2; D2 : Natural) is limited null record;
+ 
+     type R2 is limited
+         record
+             C : R3 (R2'Access, Ident_Int (-1));
+         end record;
+ 
+ begin
+     Test ("C380001", "Check that checks are made properly when a " &
+                         "per-object expression contains an attribute whose " &
+                         "prefix denotes the current instance of the type");
+     begin
+         declare
+             X : R1;
+         begin
+             Failed
+                ("No exception raised when evaluating a per-object expression " &
+                 "containing an attribute - 1");
+         end;
+     exception
+         when Constraint_Error =>
+             null;
+         when E: others =>
+             Failed ("Exception " & Exception_Name (E) &
+                     " raised - " & Exception_Information (E) & " - 1");
+     end;
+ 
+     declare
+         type A is access R1;
+         X : A;
+     begin
+         X := new R1;
+         Failed ("No exception raised when evaluating a per-object expression " &
+                 "containing an attribute - 2");
+     exception
+         when Constraint_Error =>
+             null;
+         when E: others =>
+             Failed ("Exception " & Exception_Name (E) &
+                     " raised - " & Exception_Information (E) & " - 2");
+     end;
+ 
+     begin
+         declare
+             X : R2;
+         begin
+             Failed
+                ("No exception raised when elaborating a per-object constraint " &
+                 "containing an attribute - 3");
+         end;
+     exception
+         when Constraint_Error =>
+             null;
+         when E: others =>
+             Failed ("Exception " & Exception_Name (E) &
+                     " raised - " & Exception_Information (E) & " - 3");
+     end;
+ 
+     declare
+         type A is access R2;
+         X : A;
+     begin
+         X := new R2;
+         Failed
+            ("No exception raised when evaluating a per-object constraint " &
+             "containing an attribute - 4");
+     exception
+         when Constraint_Error =>
+             null;
+         when E: others =>
+             Failed ("Exception " & Exception_Name (E) &
+                     " raised - " & Exception_Information (E) & " - 4");
+     end;
+ 
+     Result;
+ end C380001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C380002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that an expression in a per-object discriminant constraint which is
+ --    part of a named association is evaluated once for each association.
+ --    (Defect Report 8652/0002, as reflected in Technical Corrigendum 1,
+ --    RM95 3.8(18.1/1)).
+ --
+ -- CHANGE HISTORY:
+ --     9 FEB 2001   PHL   Initial version.
+ --    29 JUN 2002   RLB   Readied for release.
+ --
+ --!
+ with Ada.Exceptions;
+ use Ada.Exceptions;
+ with Report;
+ use Report;
+ procedure C380002 is
+ 
+     F_Val : Integer := Ident_Int (0);
+ 
+     function F return Integer is
+     begin
+         F_Val := F_Val + Ident_Int (1);
+         return F_Val;
+     end F;
+ 
+     type R1;
+ 
+     type R2 (D0 : Integer; D1 : access R1; D2 : Integer; D3 : Integer) is
+        limited null record;
+ 
+     type R1 is limited
+         record
+             C : R2 (D1 => R1'Access, D0 | D2 | D3 => F);
+         end record;
+ 
+ begin
+     Test ("C380002", "Check that an expression in a per-object discriminant " &
+                         "constraint which is part of a named association is " &
+                         "evaluated once for each association");
+ 
+     if not Equal (F_Val, 3) then
+         Failed ("Expression not evaluated the proper number of times");
+     end if;
+ 
+     Result;
+ end C380002;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,223 ----
+ -- C380003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that per-object expressions are evaluated as specified for
+ --    protected components.  (Defect Report 8652/0002, as reflected in
+ --    Technical Corrigendum 1, RM95 3.6(22/1) and 3.8(18/1)).
+ --
+ -- CHANGE HISTORY:
+ --     9 FEB 2001   PHL   Initial version.
+ --    29 JUN 2002   RLB   Readied for release.
+ --
+ --!
+ with Report;
+ use Report;
+ procedure C380003 is
+ 
+     subtype Sm is Integer range 1 .. 10;
+ 
+     type Rec (D1, D2 : Sm) is
+         record
+             null;
+         end record;
+ 
+ begin
+     Test ("C380003",
+           "Check compatibility of discriminant expressions" &
+              " when the constraint depends on discriminants, " &
+              "and the discriminants have defaults - protected components");
+ 
+     declare
+         protected type Cons (D3 : Integer := Ident_Int (11)) is
+             function C1_D1 return Integer;
+             function C1_D2 return Integer;
+         private
+             C1 : Rec (D3, 1);
+         end Cons;
+         protected body Cons is
+             function C1_D1 return Integer is
+             begin
+                 return C1.D1;
+             end C1_D1;
+             function C1_D2 return Integer is
+             begin
+                 return C1.D2;
+             end C1_D2;
+         end Cons;
+ 
+         function Is_Ok
+                     (C : Cons; D3 : Integer; C1_D1 : Integer; C1_D2 : Integer)
+                     return Boolean is
+         begin
+             return C.D3 = D3 and C.C1_D1 = C1_D1 and C.C1_D2 = C1_D2;
+         end Is_Ok;
+ 
+     begin
+         begin
+             declare
+                 X : Cons;
+             begin
+                 Failed ("Discriminant check not performed - 1");
+                 if not Is_Ok (X, 1, 1, 1) then
+                     Comment ("Shouldn't get here");
+                 end if;
+             end;
+         exception
+             when Constraint_Error =>
+                 null;
+             when others =>
+                 Failed ("Unexpected exception - 1");
+         end;
+ 
+         begin
+             declare
+                 type Acc_Cons is access Cons;
+                 X : Acc_Cons;
+             begin
+                 X := new Cons;
+                 Failed ("Discriminant check not performed - 2");
+                 begin
+                     if not Is_Ok (X.all, 1, 1, 1) then
+                         Comment ("Irrelevant");
+                     end if;
+                 end;
+             exception
+                 when Constraint_Error =>
+                     null;
+                 when others =>
+                     Failed ("Unexpected exception raised - 2");
+             end;
+         exception
+             when others =>
+                 Failed ("Constraint checked too soon - 2");
+         end;
+ 
+         begin
+             declare
+                 subtype Scons is Cons;
+             begin
+                 declare
+                     X : Scons;
+                 begin
+                     Failed ("Discriminant check not performed - 3");
+                     if not Is_Ok (X, 1, 1, 1) then
+                         Comment ("Irrelevant");
+                     end if;
+                 end;
+             exception
+                 when Constraint_Error =>
+                     null;
+                 when others =>
+                     Failed ("Unexpected exception raised - 3");
+             end;
+         exception
+             when others =>
+                 Failed ("Constraint checked too soon - 3");
+         end;
+ 
+         begin
+             declare
+                 type Arr is array (1 .. 5) of Cons;
+             begin
+                 declare
+                     X : Arr;
+                 begin
+                     Failed ("Discriminant check not performed - 4");
+                     for I in Arr'Range loop
+                         if not Is_Ok (X (I), 1, 1, 1) then
+                             Comment ("Irrelevant");
+                         end if;
+                     end loop;
+                 end;
+             exception
+                 when Constraint_Error =>
+                     null;
+                 when others =>
+                     Failed ("Unexpected exception raised - 4");
+             end;
+         exception
+             when others =>
+                 Failed ("Constraint checked too soon - 4");
+         end;
+ 
+         begin
+             declare
+                 type Nrec is
+                     record
+                         C1 : Cons;
+                     end record;
+             begin
+                 declare
+                     X : Nrec;
+                 begin
+                     Failed ("Discriminant check not performed - 5");
+                     if not Is_Ok (X.C1, 1, 1, 1) then
+                         Comment ("Irrelevant");
+                     end if;
+                 end;
+             exception
+                 when Constraint_Error =>
+                     null;
+                 when others =>
+                     Failed ("Unexpected exception raised - 5");
+             end;
+         exception
+             when others =>
+                 Failed ("Constraint checked too soon - 5");
+         end;
+ 
+         begin
+             declare
+                 type Drec is new Cons;
+             begin
+                 declare
+                     X : Drec;
+                 begin
+                     Failed ("Discriminant check not performed - 6");
+                     if not Is_Ok (Cons (X), 1, 1, 1) then
+                         Comment ("Irrelevant");
+                     end if;
+                 end;
+             exception
+                 when Constraint_Error =>
+                     null;
+                 when others =>
+                     Failed ("Unexpected exception raised - 6");
+             end;
+         exception
+             when others =>
+                 Failed ("Constraint checked too soon - 6");
+         end;
+ 
+     end;
+ 
+     Result;
+ 
+ exception
+     when others =>
+         Failed ("Constraint check done too early");
+         Result;
+ end C380003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c380004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c380004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,385 ----
+ -- C380004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that per-object expressions are evaluated as specified for entry
+ --    families and protected components.  (Defect Report 8652/0002,
+ --    as reflected in Technical Corrigendum 1, RM95 3.6(22/1), 3.8(18/1), and
+ --    9.5.2(22/1)).
+ --
+ -- CHANGE HISTORY:
+ --     9 FEB 2001   PHL   Initial version.
+ --    29 JUN 2002   RLB   Readied for release.
+ --
+ --!
+ with Report;
+ use Report;
+ procedure C380004 is
+ 
+     type Rec (D1, D2 : Positive) is
+         record
+             null;
+         end record;
+ 
+     F1_Poe : Integer;
+ 
+     function Chk (Poe : Integer; Value : Integer; Message : String)
+                  return Boolean is
+     begin
+         if Poe /= Value then
+             Failed (Message & ": Poe is " & Integer'Image (Poe));
+         end if;
+         return True;
+     end Chk;
+ 
+     function F1 return Integer is
+     begin
+         F1_Poe := F1_Poe - Ident_Int (1);
+         return F1_Poe;
+     end F1;
+ 
+     generic
+         type T is limited private;
+         with function Is_Ok (X : T;
+                              Param1 : Integer;
+                              Param2 : Integer;
+                              Param3 : Integer) return Boolean;
+     procedure Check;
+ 
+     procedure Check is
+     begin
+ 
+         declare
+             type Poe is new T;
+             Chk1 : Boolean := Chk (F1_Poe, 17, "F1 evaluated");
+             X : Poe;             -- F1 evaluated
+             Y : Poe;             -- F1 evaluated
+             Chk2 : Boolean := Chk (F1_Poe, 15, "F1 not evaluated");
+         begin
+             if not Is_Ok (T (X), 16, 16, 17) or
+                not Is_Ok (T (Y), 15, 15, 17) then
+                 Failed ("Discriminant values not correct - 0");
+             end if;
+         end;
+ 
+         declare
+             type Poe is new T;
+         begin
+             begin
+                 declare
+                     X : Poe;
+                 begin
+                     if not Is_Ok (T (X), 14, 14, 17) then
+                         Failed ("Discriminant values not correct - 1");
+                     end if;
+                 end;
+             exception
+                 when others =>
+                     Failed ("Unexpected exception - 1");
+             end;
+ 
+             declare
+                 type Acc_Poe is access Poe;
+                 X : Acc_Poe;
+             begin
+                 X := new Poe;
+                 begin
+                     if not Is_Ok (T (X.all), 13, 13, 17) then
+                         Failed ("Discriminant values not correct - 2");
+                     end if;
+                 end;
+             exception
+                 when others =>
+                     Failed ("Unexpected exception raised - 2");
+             end;
+ 
+             declare
+                 subtype Spoe is Poe;
+                 X : Spoe;
+             begin
+                 if not Is_Ok (T (X), 12, 12, 17) then
+                     Failed ("Discriminant values not correct - 3");
+                 end if;
+             exception
+                 when others =>
+                     Failed ("Unexpected exception raised - 3");
+             end;
+ 
+             declare
+                 type Arr is array (1 .. 2) of Poe;
+                 X : Arr;
+             begin
+                 if Is_Ok (T (X (1)), 11, 11, 17) and then
+                    Is_Ok (T (X (2)), 10, 10, 17) then
+                     null;
+                 elsif Is_Ok (T (X (2)), 11, 11, 17) and then
+                       Is_Ok (T (X (1)), 10, 10, 17) then
+                     null;
+                 else
+                     Failed ("Discriminant values not correct - 4");
+                 end if;
+             exception
+                 when others =>
+                     Failed ("Unexpected exception raised - 4");
+             end;
+ 
+             declare
+                 type Nrec is
+                     record
+                         C1, C2 : Poe;
+                     end record;
+                 X : Nrec;
+             begin
+                 if Is_Ok (T (X.C1), 8, 8, 17) and then
+                    Is_Ok (T (X.C2), 9, 9, 17) then
+                     null;
+                 elsif Is_Ok (T (X.C2), 8, 8, 17) and then
+                       Is_Ok (T (X.C1), 9, 9, 17) then
+                     null;
+                 else
+                     Failed ("Discriminant values not correct - 5");
+                 end if;
+             exception
+                 when others =>
+                     Failed ("Unexpected exception raised - 5");
+             end;
+ 
+             declare
+                 type Drec is new Poe;
+                 X : Drec;
+             begin
+                 if not Is_Ok (T (X), 7, 7, 17) then
+                     Failed ("Discriminant values not correct - 6");
+                 end if;
+             exception
+                 when others =>
+                     Failed ("Unexpected exception raised - 6");
+             end;
+         end;
+     end Check;
+ 
+ 
+ begin
+     Test ("C380004",
+           "Check evaluation of discriminant expressions " &
+              "when the constraint depends on a discriminant, " &
+              "and the discriminants have defaults - discriminant-dependent" &
+              "entry families and protected components");
+ 
+ 
+     Comment ("Discriminant-dependent entry families for task types");
+ 
+     F1_Poe := 18;
+ 
+     declare
+         task type Poe (D3 : Positive := F1) is
+             entry E (D3 .. F1);    -- F1 evaluated
+             entry Is_Ok (D3 : Integer;
+                          E_First : Integer;
+                          E_Last : Integer;
+                          Ok : out Boolean);
+         end Poe;
+         task body Poe is
+         begin
+             loop
+                 select
+                     accept Is_Ok (D3 : Integer;
+                                   E_First : Integer;
+                                   E_Last : Integer;
+                                   Ok : out Boolean) do
+                         declare
+                             Cnt : Natural;
+                         begin
+                             if Poe.D3 = D3 then
+                                 -- Can't think of a better way to check the
+                                 -- bounds of the entry family.
+                                 begin
+                                     Cnt := E (E_First)'Count;
+                                     Cnt := E (E_Last)'Count;
+                                 exception
+                                     when Constraint_Error =>
+                                         Ok := False;
+                                         return;
+                                 end;
+                                 begin
+                                     Cnt := E (E_First - 1)'Count;
+                                     Ok := False;
+                                     return;
+                                 exception
+                                     when Constraint_Error =>
+                                         null;
+                                     when others =>
+                                         Ok := False;
+                                         return;
+                                 end;
+                                 begin
+                                     Cnt := E (E_Last + 1)'Count;
+                                     Ok := False;
+                                     return;
+                                 exception
+                                     when Constraint_Error =>
+                                         null;
+                                     when others =>
+                                         Ok := False;
+                                         return;
+                                 end;
+                                 Ok := True;
+                             else
+                                 Ok := False;
+                                 return;
+                             end if;
+                         end;
+                     end Is_Ok;
+                 or
+                     terminate;
+                 end select;
+             end loop;
+         end Poe;
+ 
+         function Is_Ok
+                     (C : Poe; D3 : Integer; E_First : Integer; E_Last : Integer)
+                     return Boolean is
+             Ok : Boolean;
+         begin
+             C.Is_Ok (D3, E_First, E_Last, Ok);
+             return Ok;
+         end Is_Ok;
+ 
+         procedure Chk is new Check (Poe, Is_Ok);
+ 
+     begin
+         Chk;
+     end;
+ 
+ 
+     Comment ("Discriminant-dependent entry families for protected types");
+ 
+     F1_Poe := 18;
+ 
+     declare
+         protected type Poe (D3 : Integer := F1) is
+             entry E (D3 .. F1);    -- F1 evaluated
+             function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer)
+                            return Boolean;
+         end Poe;
+         protected body Poe is
+             entry E (for I in D3 .. F1) when True is
+             begin
+                 null;
+             end E;
+             function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer)
+                            return Boolean is
+                 Cnt : Natural;
+             begin
+                 if Poe.D3 = D3 then
+                     -- Can't think of a better way to check the
+                     -- bounds of the entry family.
+                     begin
+                         Cnt := E (E_First)'Count;
+                         Cnt := E (E_Last)'Count;
+                     exception
+                         when Constraint_Error =>
+                             return False;
+                     end;
+                     begin
+                         Cnt := E (E_First - 1)'Count;
+                         return False;
+                     exception
+                         when Constraint_Error =>
+                             null;
+                         when others =>
+                             return False;
+                     end;
+                     begin
+                         Cnt := E (E_Last + 1)'Count;
+                         return False;
+                     exception
+                         when Constraint_Error =>
+                             null;
+                         when others =>
+                             return False;
+                     end;
+                     return True;
+                 else
+                     return False;
+                 end if;
+             end Is_Ok;
+         end Poe;
+ 
+         function Is_Ok
+                     (C : Poe; D3 : Integer; E_First : Integer; E_Last : Integer)
+                     return Boolean is
+         begin
+             return C.Is_Ok (D3, E_First, E_Last);
+         end Is_Ok;
+ 
+         procedure Chk is new Check (Poe, Is_Ok);
+ 
+     begin
+         Chk;
+     end;
+ 
+     Comment ("Protected components");
+ 
+     F1_Poe := 18;
+ 
+     declare
+         protected type Poe (D3 : Integer := F1) is
+             function C1_D1 return Integer;
+             function C1_D2 return Integer;
+         private
+             C1 : Rec (D3, F1);    -- F1 evaluated
+         end Poe;
+         protected body Poe is
+             function C1_D1 return Integer is
+             begin
+                 return C1.D1;
+             end C1_D1;
+             function C1_D2 return Integer is
+             begin
+                 return C1.D2;
+             end C1_D2;
+         end Poe;
+ 
+         function Is_Ok (C : Poe; D3 : Integer; C1_D1 : Integer; C1_D2 : Integer)
+                        return Boolean is
+         begin
+             return C.D3 = D3 and C.C1_D1 = C1_D1 and C.C1_D2 = C1_D2;
+         end Is_Ok;
+ 
+         procedure Chk is new Check (Poe, Is_Ok);
+ 
+     begin
+         Chk;
+     end;
+ 
+     Result;
+ 
+ exception
+     when others =>
+         Failed ("Unexpected exception");
+         Result;
+ 
+ end C380004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,420 ----
+ -- C38002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN UNCONSTRAINED ARRAY TYPE OR A RECORD WITHOUT
+ --     DEFAULT DISCRIMINANTS CAN BE USED IN AN ACCESS_TYPE_DEFINITION
+ --     WITHOUT AN INDEX OR DISCRIMINANT CONSTRAINT.
+ --
+ --     CHECK THAT (NON-STATIC) INDEX OR DISCRIMINANT CONSTRAINTS CAN
+ --     SUBSEQUENTLY BE IMPOSED WHEN THE TYPE IS USED IN AN OBJECT
+ --     DECLARATION, ARRAY COMPONENT DECLARATION, RECORD COMPONENT
+ --     DECLARATION, ACCESS TYPE DECLARATION, PARAMETER DECLARATION,
+ --     DERIVED TYPE DEFINITION, PRIVATE TYPE.
+ --
+ --     CHECK FOR UNCONSTRAINED GENERIC FORMAL TYPE.
+ 
+ -- HISTORY:
+ --     AH  09/02/86 CREATED ORIGINAL TEST.
+ --     DHH 08/16/88 REVISED HEADER AND ENTERED COMMENTS FOR PRIVATE TYPE
+ --                  AND CORRECTED INDENTATION.
+ --     BCB 04/12/90 ADDED CHECKS FOR AN ARRAY AS A SUBPROGRAM RETURN
+ --                  TYPE AND AN ARRAY AS A FORMAL PARAMETER.
+ --     LDC 10/01/90 ADDED CODE SO F, FPROC, G, GPROC AREN'T OPTIMIZED 
+ --                  AWAY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38002A IS
+ 
+ BEGIN
+      TEST ("C38002A", "NON-STATIC CONSTRAINTS CAN BE IMPOSED " &
+            "ON ACCESS TYPES ACCESSING PREVIOUSLY UNCONSTRAINED " &
+            "ARRAY OR RECORD TYPES");
+ 
+      DECLARE
+           C3 : CONSTANT INTEGER := IDENT_INT(3);
+ 
+           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           TYPE ARR_NAME IS ACCESS ARR;
+           SUBTYPE ARR_NAME_3 IS ARR_NAME(1..3);
+ 
+           TYPE REC(DISC : INTEGER) IS
+                RECORD
+                     COMP : ARR_NAME(1..DISC);
+                END RECORD;
+           TYPE REC_NAME IS ACCESS REC;
+ 
+           OBJ : REC_NAME(C3);
+ 
+           TYPE ARR2 IS ARRAY (1..10) OF REC_NAME(C3);
+ 
+           TYPE REC2 IS
+                RECORD
+                     COMP2 : REC_NAME(C3);
+                END RECORD;
+ 
+           TYPE NAME_REC_NAME IS ACCESS REC_NAME(C3);
+ 
+           TYPE DERIV IS NEW REC_NAME(C3);
+           SUBTYPE REC_NAME_3 IS REC_NAME(C3);
+ 
+           FUNCTION F (PARM : REC_NAME_3) RETURN REC_NAME_3 IS
+           BEGIN
+                IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
+                     COMMENT("DON'T OPTIMIZE F AWAY");
+                END IF;
+                RETURN PARM;
+           END;
+ 
+           PROCEDURE FPROC (PARM : REC_NAME_3) IS
+           BEGIN
+                IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
+                     COMMENT("DON'T OPTIMIZE FPROC AWAY");
+                END IF;
+           END FPROC;
+ 
+           FUNCTION G (PA : ARR_NAME_3) RETURN ARR_NAME_3 IS
+           BEGIN
+                IF NOT EQUAL(IDENT_INT(5), 3 + IDENT_INT(2)) THEN
+                     COMMENT("DON'T OPTIMIZE G AWAY");
+                END IF;
+                RETURN PA;
+           END G;
+ 
+           PROCEDURE GPROC (PA : ARR_NAME_3) IS
+           BEGIN
+                IF NOT EQUAL(IDENT_INT(6), 4 + IDENT_INT(2)) THEN
+                     COMMENT("DON'T OPTIMIZE GPROC AWAY");
+                END IF;
+           END GPROC;
+ 
+      BEGIN
+           DECLARE
+                R : REC_NAME;
+           BEGIN
+                R := NEW REC'(DISC => 3, COMP => NEW ARR'(1..3 => 5));
+                R := F(R);
+                R := NEW REC'(DISC => 4, COMP => NEW ARR'(1..4 => 5));
+                R := F(R);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY FUNCTION FOR RECORD");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF R = NULL OR ELSE R.DISC /= 4 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                  "ACCESS VALUE - RECORD,FUNCTION");
+                     END IF;
+           END;
+ 
+           DECLARE
+                R : REC_NAME;
+           BEGIN
+                R := NEW REC'(DISC => 3, COMP => NEW ARR'(1..3 => 5));
+                FPROC(R);
+                R := NEW REC'(DISC => 4, COMP => NEW ARR'(1..4 => 5));
+                FPROC(R);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY PROCEDURE FOR RECORD");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF R = NULL OR ELSE R.DISC /= 4 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                  "ACCESS VALUE - RECORD,PROCEDURE");
+                     END IF;
+           END;
+ 
+           DECLARE
+                A : ARR_NAME;
+           BEGIN
+                A := NEW ARR'(1..3 => 5);
+                A := G(A);
+                A := NEW ARR'(1..4 => 6);
+                A := G(A);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY FUNCTION FOR ARRAY");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF A = NULL OR ELSE A(4) /= 6 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                  "ACCESS VALUE - ARRAY,FUNCTION");
+                     END IF;
+           END;
+ 
+           DECLARE
+                A : ARR_NAME;
+           BEGIN
+                A := NEW ARR'(1..3 => 5);
+                GPROC(A);
+                A := NEW ARR'(1..4 => 6);
+                GPROC(A);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY PROCEDURE FOR ARRAY");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF A = NULL OR ELSE A(4) /= 6 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                  "ACCESS VALUE - ARRAY,PROCEDURE");
+                     END IF;
+           END;
+      END;
+ 
+      DECLARE
+           C3 : CONSTANT INTEGER := IDENT_INT(3);
+ 
+           TYPE REC (DISC : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE P_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           TYPE P_ARR_NAME IS ACCESS P_ARR;
+ 
+           TYPE P_REC_NAME IS ACCESS REC;
+ 
+           GENERIC
+                TYPE UNCON_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           PACKAGE P IS
+                TYPE ACC_REC IS ACCESS REC;
+                TYPE ACC_ARR IS ACCESS UNCON_ARR;
+                TYPE ACC_P_ARR IS ACCESS P_ARR;
+                SUBTYPE ACC_P_ARR_3 IS ACC_P_ARR(1..3);
+                OBJ : ACC_REC(C3);
+ 
+                TYPE ARR2 IS ARRAY (1..10) OF ACC_REC(C3);
+ 
+                TYPE REC1 IS
+                     RECORD
+                          COMP1 : ACC_REC(C3);
+                     END RECORD;
+ 
+                TYPE REC2 IS
+                     RECORD
+                          COMP2 : ACC_ARR(1..C3);
+                     END RECORD;
+ 
+                SUBTYPE ACC_REC_3 IS ACC_REC(C3);
+ 
+                FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3;
+ 
+                PROCEDURE FPROC (PARM : ACC_REC_3);
+ 
+                FUNCTION G (PA : ACC_P_ARR_3) RETURN ACC_P_ARR_3;
+ 
+                PROCEDURE GPROC (PA : ACC_P_ARR_3);
+ 
+                TYPE ACC1 IS PRIVATE;
+                TYPE ACC2 IS PRIVATE;
+                TYPE DER1 IS PRIVATE;
+                TYPE DER2 IS PRIVATE;
+ 
+           PRIVATE
+ 
+                TYPE ACC1 IS ACCESS ACC_REC(C3);
+                TYPE ACC2 IS ACCESS ACC_ARR(1..C3);
+                TYPE DER1 IS NEW ACC_REC(C3);
+                TYPE DER2 IS NEW ACC_ARR(1..C3);
+           END P;
+ 
+           PACKAGE BODY P IS
+                FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3 IS
+                BEGIN
+                     IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
+                          COMMENT("DON'T OPTIMIZE F AWAY");
+                     END IF;
+                     RETURN PARM;
+                END;
+ 
+                PROCEDURE FPROC (PARM : ACC_REC_3) IS
+                BEGIN
+                     IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
+                          COMMENT("DON'T OPTIMIZE FPROC AWAY");
+                     END IF;
+                END FPROC;
+ 
+                FUNCTION G (PA : ACC_P_ARR_3) RETURN ACC_P_ARR_3 IS
+                BEGIN
+                     IF NOT EQUAL(IDENT_INT(5), 3 + IDENT_INT(2)) THEN
+                          COMMENT("DON'T OPTIMIZE G AWAY");
+                     END IF;
+                     RETURN PA;
+                END;
+ 
+                PROCEDURE GPROC (PA : ACC_P_ARR_3) IS
+                BEGIN
+                     IF NOT EQUAL(IDENT_INT(6), 4 + IDENT_INT(2)) THEN
+                          COMMENT("DON'T OPTIMIZE GPROC AWAY");
+                     END IF;
+                END GPROC;
+           END P;
+ 
+           PACKAGE NP IS NEW P (UNCON_ARR => P_ARR);
+ 
+           USE NP;
+ 
+      BEGIN
+           DECLARE
+                R : ACC_REC;
+           BEGIN
+                R := NEW REC(DISC => 3);
+                R := F(R);
+                R := NEW REC(DISC => 4);
+                R := F(R);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY FUNCTION FOR A RECORD -GENERIC");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF R = NULL OR ELSE R.DISC /= 4 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                  "OF ACCESS VALUE - RECORD," &
+                                  "FUNCTION -GENERIC");
+                     END IF;
+           END;
+ 
+           DECLARE
+                R : ACC_REC;
+           BEGIN
+                R := NEW REC(DISC => 3);
+                FPROC(R);
+                R := NEW REC(DISC => 4);
+                FPROC(R);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY PROCEDURE FOR A RECORD -GENERIC");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF R = NULL OR ELSE R.DISC /= 4 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                  "OF ACCESS VALUE - RECORD," &
+                                  "PROCEDURE -GENERIC");
+                     END IF;
+           END;
+ 
+           DECLARE
+                A : ACC_P_ARR;
+           BEGIN
+                A := NEW P_ARR'(1..3 => 5);
+                A := G(A);
+                A := NEW P_ARR'(1..4 => 6);
+                A := G(A);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY FUNCTION FOR AN ARRAY -GENERIC");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF A = NULL OR ELSE A(4) /= 6 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                  "OF ACCESS VALUE - ARRAY," &
+                                  "FUNCTION -GENERIC");
+                     END IF;
+           END;
+ 
+           DECLARE
+                A : ACC_P_ARR;
+           BEGIN
+                A := NEW P_ARR'(1..3 => 5);
+                GPROC(A);
+                A := NEW P_ARR'(1..4 => 6);
+                GPROC(A);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY PROCEDURE FOR AN ARRAY -GENERIC");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF A = NULL OR ELSE A(4) /= 6 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                  "OF ACCESS VALUE - ARRAY," &
+                                  "PROCEDURE -GENERIC");
+                     END IF;
+           END;
+      END;
+ 
+      DECLARE
+           TYPE CON_INT IS RANGE 1..10;
+ 
+           GENERIC
+                TYPE UNCON_INT IS RANGE <>;
+           PACKAGE P2 IS
+                SUBTYPE NEW_INT IS UNCON_INT RANGE 1..5;
+                FUNCTION FUNC_INT (PARM : NEW_INT) RETURN NEW_INT;
+ 
+                PROCEDURE PROC_INT (PARM : NEW_INT);
+           END P2;
+ 
+           PACKAGE BODY P2 IS
+                FUNCTION FUNC_INT (PARM : NEW_INT) RETURN NEW_INT IS
+                BEGIN
+                     IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
+                          COMMENT("DON'T OPTIMIZE F AWAY");
+                     END IF;
+                     RETURN PARM;
+                END FUNC_INT;
+ 
+                PROCEDURE PROC_INT (PARM : NEW_INT) IS
+                BEGIN
+                     IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
+                          COMMENT("DON'T OPTIMIZE FPROC AWAY");
+                     END IF;
+                END PROC_INT;
+           END P2;
+ 
+           PACKAGE NP2 IS NEW P2 (UNCON_INT => CON_INT);
+ 
+           USE NP2;
+ 
+      BEGIN
+           DECLARE
+                R : CON_INT;
+           BEGIN
+                R := 2;
+                R := FUNC_INT(R);
+                R := 8;
+                R := FUNC_INT(R);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON VALUE " &
+                        "ACCEPTED BY FUNCTION -GENERIC");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF R /= 8 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                  "OF VALUE -FUNCTION, GENERIC");
+                     END IF;
+           END;
+ 
+           DECLARE
+                R : CON_INT;
+           BEGIN
+                R := 2;
+                PROC_INT(R);
+                R := 9;
+                PROC_INT(R);
+                FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                        "ACCEPTED BY PROCEDURE -GENERIC");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF R /= 9 THEN
+                          FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                  "OF ACCESS VALUE - PROCEDURE, " &
+                                  "GENERIC");
+                     END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END C38002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38002b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38002b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38002b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,123 ----
+ -- C38002B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN UNCONSTRAINED ARRAY TYPE OR A RECORD WITHOUT
+ --     DEFAULT DISCRIMINANTS CAN BE USED IN AN ACCESS_TYPE_DEFINITION
+ --     WITHOUT AN INDEX OR DISCRIMINANT CONSTRAINT.
+ --
+ --     CHECK THAT (NON-STATIC) INDEX OR DISCRIMINANT CONSTRAINTS CAN
+ --     SUBSEQUENTLY BE IMPOSED WHEN THE TYPE IS USED IN AN OBJECT
+ --     DECLARATION, ARRAY COMPONENT DECLARATION, RECORD COMPONENT
+ --     DECLARATION, ACCESS TYPE DECLARATION, PARAMETER DECLARATION,
+ --     ALLOCATOR, DERIVED TYPE DEFINITION, PRIVATE TYPE, OR AS THE
+ --     RETURN TYPE IN A FUNCTION DECLARATION.
+ --
+ --     CHECK FOR GENERIC FORMAL ACCESS TYPES.
+ 
+ -- HISTORY:
+ --     AH  09/02/86 CREATED ORIGINAL TEST.
+ --     DHH 08/22/88 REVISED HEADER, ADDED 'PRIVATE TYPE' TO COMMENTS
+ --                  AND CORRECTED INDENTATION.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38002B IS
+ 
+      C3 : CONSTANT INTEGER := IDENT_INT(3);
+ 
+      TYPE UNCON_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+      TYPE REC (DISC : INTEGER) IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      TYPE P_ARR_NAME IS ACCESS UNCON_ARR;
+      TYPE P_REC_NAME IS ACCESS REC;
+ 
+      GENERIC
+           TYPE ACC_REC IS ACCESS REC;
+           TYPE ACC_ARR IS ACCESS UNCON_ARR;
+      PACKAGE P IS
+           OBJ : ACC_REC(C3);
+ 
+           TYPE ARR2 IS ARRAY (1..10) OF ACC_REC(C3);
+ 
+           TYPE REC1 IS
+                RECORD
+                     COMP1 : ACC_REC(C3);
+                END RECORD;
+ 
+           TYPE REC2 IS
+                RECORD
+                     COMP2 : ACC_ARR(1..C3);
+                END RECORD;
+ 
+           SUBTYPE ACC_REC_3 IS ACC_REC(C3);
+           R : ACC_REC;
+ 
+           FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3;
+ 
+           TYPE ACC1 IS PRIVATE;
+           TYPE ACC2 IS PRIVATE;
+           TYPE DER1 IS PRIVATE;
+           TYPE DER2 IS PRIVATE;
+ 
+      PRIVATE
+ 
+           TYPE ACC1 IS ACCESS ACC_REC(C3);
+           TYPE ACC2 IS ACCESS ACC_ARR(1..C3);
+           TYPE DER1 IS NEW ACC_REC(C3);
+           TYPE DER2 IS NEW ACC_ARR(1..C3);
+      END P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3 IS
+           BEGIN
+                RETURN PARM;
+           END;
+      END P;
+ 
+      PACKAGE NP IS NEW P (ACC_REC => P_REC_NAME, ACC_ARR => P_ARR_NAME);
+ 
+      USE NP;
+ BEGIN
+      TEST ("C38002B", "NON-STATIC CONSTRAINTS CAN BE IMPOSED " &
+            "ON ACCESS TYPES ACCESSING PREVIOUSLY UNCONSTRAINED " &
+            "ARRAY OR RECORD TYPES");
+ 
+      R := NEW REC(DISC => 3);
+      R := F(R);
+      R := NEW REC(DISC => 4);
+      R := F(R);
+      FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE ACCEPTED " &
+              "BY GENERIC FUNCTION");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF R = NULL OR ELSE R.DISC /= 4 THEN
+                     FAILED (" ERROR IN EVALUATION/ASSIGNMENT OF " &
+                             "GENERIC ACCESS VALUE");
+                END IF;
+ 
+      RESULT;
+ END C38002B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C38005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL (UNINITIALIZED) ACCESS OBJECTS ARE INITIALIZED
+ -- TO NULL BY DEFAULT. VARIABLES, ARRAYS, RECORDS, ARRAYS OF RECORDS,
+ -- ARRAYS OF ARRAYS, RECORDS WITH ARRAYS AND RECORD COMPONENTS
+ -- ARE ALL CHECKED.
+ -- FUNCTION RESULTS (I.E. RETURNED FROM IMPLICIT FUNCTION RETURN)
+ -- ARE NOT CHECKED.
+ 
+ -- DAT 3/6/81
+ -- VKG 1/5/83
+ -- SPS 2/17/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C38005A IS
+ 
+      TYPE REC;
+      TYPE ACC_REC IS ACCESS REC;
+      TYPE VECTOR IS ARRAY ( NATURAL RANGE <> ) OF ACC_REC;
+      TYPE REC IS RECORD
+           VECT : VECTOR (3 .. 5);
+      END RECORD;
+ 
+      TYPE ACC_VECT IS ACCESS VECTOR;
+      TYPE ARR_REC IS ARRAY (1 .. 2) OF REC;
+      TYPE REC2;
+      TYPE ACC_REC2 IS ACCESS REC2;
+      TYPE REC2 IS RECORD
+           C1 : ACC_REC;
+           C2 : ACC_VECT;
+           C3 : ARR_REC;
+           C4 : REC;
+           C5 : ACC_REC2;
+      END RECORD;
+ 
+      N_REC      : REC;
+      N_ACC_REC  : ACC_REC;
+      N_VEC      : VECTOR (3 .. IDENT_INT (5));
+      N_ACC_VECT : ACC_VECT;
+      N_ARR_REC  : ARR_REC;
+      N_REC2     : REC2;
+      N_ACC_REC2 : ACC_REC2;
+      N_ARR      : ARRAY (1..2) OF VECTOR (1..2);
+      Q : REC2 :=
+                 (C1 => NEW REC,
+                  C2 => NEW VECTOR'(NEW REC, NEW REC'(N_REC)),
+                  C3 => (1 | 2 => (VECT=>(3|4=> NEW REC, 
+                                          5=>N_ACC_REC)
+                                  )),
+                  C4 => N_REC2.C4,
+                  C5 => NEW REC2'(N_REC2));
+ 
+ BEGIN
+      TEST ("C38005A", "DEFAULT VALUE FOR ACCESS OBJECTS IS NULL");
+ 
+      IF N_REC /= REC'(VECT => (3..5 => NULL))
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 1");
+      END IF;
+ 
+      IF N_ACC_REC /= NULL
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 2");
+      END IF;
+ 
+      IF N_VEC /= N_REC.VECT
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 3");
+      END IF;
+ 
+      IF N_ARR /= ((NULL, NULL), (NULL, NULL))
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 4");
+      END IF;
+ 
+      IF N_ACC_VECT /= NULL
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 5");
+      END IF;
+ 
+      IF N_ARR_REC /= (N_REC, N_REC)
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 6");
+      END IF;
+ 
+      IF N_REC2 /= (NULL, NULL, N_ARR_REC, N_REC, NULL)
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 7");
+      END IF;
+ 
+      IF N_ACC_REC2 /= NULL
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 8");
+      END IF;
+ 
+      IF Q /= (Q.C1, Q.C2, (Q.C3(1), Q.C3(2)), N_REC, Q.C5)
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 9");
+      END IF;
+ 
+      IF Q.C1.ALL /= N_REC
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 10");
+      END IF;
+ 
+      IF Q.C2.ALL(0).ALL /= N_REC
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 11");
+      END IF;
+ 
+      IF Q.C2(1).VECT /= N_VEC
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 12");
+      END IF;
+ 
+      IF Q.C3(2).VECT /= (3 => Q.C3(2).VECT(3),
+                          4 => Q.C3(2).VECT(4),
+                          5=>NULL)
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 13");
+      END IF;
+ 
+      IF Q.C3(2).VECT(3).ALL /= N_REC
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 14");
+      END IF;
+ 
+      IF Q.C5.ALL /= N_REC2
+      THEN
+           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 15");
+      END IF;
+ 
+      DECLARE
+           PROCEDURE T (R : OUT REC2) IS
+           BEGIN
+                NULL;
+           END T;
+      BEGIN
+           N_REC2 := Q;
+           T(Q);
+           IF Q /= N_REC2 THEN
+                FAILED ("INCORRECT OUT PARM INIT 2");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C38005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C38005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ANY OBJECT WITH A FORMAL PRIVATE TYPE, WHOSE ACTUAL
+ --     TYPE IN AN INSTANTIATION IS AN ACCESS TYPE, IS INITIALIZED BY
+ --     DEFAULT TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH ARE ARRAY
+ --     AND RECORD COMPONENTS.
+ 
+ -- HISTORY:
+ --     DHH 07/12/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38005B IS
+ 
+ BEGIN
+      TEST("C38005B", "CHECK THAT ANY OBJECT WITH A FORMAL PRIVATE " &
+                      "TYPE, WHOSE ACTUAL TYPE IN AN INSTANTIATION " &
+                      "IS AN ACCESS TYPE, IS INITIALIZED BY DEFAULT " &
+                      "TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH " &
+                      "ARE ARRAY AND RECORD COMPONENTS");
+      DECLARE
+           TYPE ARRY IS ARRAY(1 .. 10) OF BOOLEAN;
+           TYPE REC1 IS
+                RECORD
+                     A : INTEGER;
+                     B : ARRY;
+                END RECORD;
+ 
+           TYPE POINTER IS ACCESS REC1;
+ 
+           GENERIC
+                TYPE NEW_PTR IS PRIVATE;
+           PACKAGE GEN_PACK IS
+                TYPE PTR_ARY IS ARRAY(1 .. 5) OF NEW_PTR;
+                TYPE RECORD1 IS
+                     RECORD
+                          A : NEW_PTR;
+                          B : PTR_ARY;
+                     END RECORD;
+ 
+                OBJ : NEW_PTR;
+                ARY : PTR_ARY;
+                REC : RECORD1;
+           END GEN_PACK;
+ 
+           PACKAGE TEST_P IS NEW GEN_PACK(POINTER);
+           USE TEST_P;
+ 
+      BEGIN
+           IF OBJ /= NULL THEN
+                FAILED("OBJECT NOT INITIALIZED TO NULL");
+           END IF;
+ 
+           FOR I IN 1 .. 5 LOOP
+                IF ARY(I) /= NULL THEN
+                     FAILED("ARRAY COMPONENT " &
+                             INTEGER'IMAGE(I) &
+                            " NOT INITIALIZED TO NULL");
+                END IF;
+           END LOOP;
+ 
+           IF REC.A /= NULL THEN
+                FAILED("RECORD OBJECT NOT INITIALIZED TO NULL");
+           END IF;
+ 
+           FOR I IN 1 .. 5 LOOP
+                IF REC.B(I) /= NULL THEN
+                     FAILED("RECORD SUBCOMPONENT " &
+                            INTEGER'IMAGE(I) &
+                            " NOT INITIALIZED TO NULL");
+                END IF;
+           END LOOP;
+      END;
+ 
+      RESULT;
+ END C38005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38005c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38005c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38005c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- C38005C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ALL OBJECTS OF FORMAL ACCESS TYPE, INCLUDING ARRAY AND
+ --     RECORD COMPONENTS, ARE INITIALIZED BY DEFAULT WITH THE VALUE
+ --     NULL.
+ 
+ -- HISTORY:
+ --     DHH 08/04/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38005C IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+ 
+      TYPE ACC_I IS ACCESS INT;
+ 
+      SUBTYPE NEW_NODE IS CHARACTER;
+ 
+      TYPE ACC_CHAR IS ACCESS NEW_NODE;
+ 
+      X : ACC_I := NEW INT'(IDENT_INT(5));
+      Y : NEW_NODE := 'A';
+      Z : ACC_CHAR := NEW NEW_NODE'(Y);
+ 
+      GENERIC
+           TYPE ACC_INT IS ACCESS INT;
+           TYPE NODE IS PRIVATE;
+           TYPE LINK IS ACCESS NODE;
+      PROCEDURE P(U : ACC_INT; V : NODE; W : LINK);
+ 
+      GENERIC
+           TYPE ACC_INT IS ACCESS INT;
+           TYPE NODE IS PRIVATE;
+           TYPE LINK IS ACCESS NODE;
+      PACKAGE PACK IS
+ 
+           SUBTYPE NEW_ACC IS ACC_INT;
+ 
+           SUBTYPE NEW_L IS LINK;
+ 
+           TYPE ARR IS ARRAY(1 .. 4) OF ACC_INT;
+ 
+           TYPE REC IS
+                RECORD
+                     I : ACC_INT;
+                     L : LINK;
+                END RECORD;
+ 
+      END PACK;
+ 
+      PACKAGE NEW_PACK IS NEW PACK(ACC_I, NEW_NODE, ACC_CHAR);
+      USE NEW_PACK;
+ 
+      A : NEW_PACK.NEW_ACC;
+      B : NEW_PACK.NEW_L;
+      C : NEW_PACK.ARR;
+      D : NEW_PACK.REC;
+ 
+      PROCEDURE P(U : ACC_INT; V : NODE; W : LINK) IS
+ 
+           TYPE ARR IS ARRAY(1 .. 4) OF ACC_INT;
+ 
+           TYPE REC IS
+                RECORD
+                     I : ACC_INT;
+                     L : LINK;
+                END RECORD;
+ 
+           A : ACC_INT;
+           B : LINK;
+           C : ARR;
+           D : REC;
+ 
+      BEGIN
+           IF A /= NULL THEN
+                FAILED("OBJECT A NOT INITIALIZED - PROC");
+           END IF;
+ 
+           IF B /= NULL THEN
+                FAILED("OBJECT B NOT INITIALIZED - PROC");
+           END IF;
+ 
+           FOR I IN 1 .. 4 LOOP
+                IF C(I) /= NULL THEN
+                     FAILED("ARRAY " & INTEGER'IMAGE(I) &
+                            "NOT INITIALIZED - PROC");
+                END IF;
+           END LOOP;
+ 
+           IF D.I /= NULL THEN
+                FAILED("RECORD.I NOT INITIALIZED - PROC");
+           END IF;
+ 
+           IF D.L /= NULL THEN
+                FAILED("RECORD.L NOT INITIALIZED - PROC");
+           END IF;
+ 
+      END P;
+ 
+      PROCEDURE PROC IS NEW P(ACC_I, NEW_NODE, ACC_CHAR);
+ 
+ BEGIN
+      TEST("C38005C", "CHECK THAT ALL OBJECTS OF FORMAL ACCESS TYPE, " &
+                      "INCLUDING ARRAY AND RECORD COMPONENTS, ARE " &
+                      "INITIALIZED BY DEFAULT WITH THE VALUE NULL");
+ 
+      PROC(X, Y, Z);
+ 
+      IF A /= NULL THEN
+           FAILED("OBJECT A NOT INITIALIZED - PACK");
+      END IF;
+ 
+      IF B /= NULL THEN
+           FAILED("OBJECT B NOT INITIALIZED - PACK");
+      END IF;
+ 
+      FOR I IN 1 .. 4 LOOP
+           IF C(I) /= NULL THEN
+                FAILED("ARRAY " & INTEGER'IMAGE(I) &
+                       "NOT INITIALIZED - PACK");
+           END IF;
+      END LOOP;
+ 
+      IF D.I /= NULL THEN
+           FAILED("RECORD.I NOT INITIALIZED - PACK");
+      END IF;
+ 
+      IF D.L /= NULL THEN
+           FAILED("RECORD.L NOT INITIALIZED - PACK");
+      END IF;
+ 
+      RESULT;
+ END C38005C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- C38006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OBJECTS ACCESSED BY CONSTANTS CAN BE MODIFIED.
+ 
+ -- DAT 3/6/81
+ -- SPS 10/25/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C38006A IS
+ 
+      TYPE AI IS ACCESS INTEGER;
+ 
+      C : CONSTANT AI := NEW INTEGER'(1);
+ 
+ BEGIN
+      TEST ("C38006A", "OBJECTS ACCESSED BY CONSTANTS MAY BE ASSIGNED");
+ 
+      FOR I IN 1 .. 10 LOOP
+           IF C.ALL /= I AND I > 1 THEN
+                FAILED ("OBJECT ACCESSED THRU CONSTANT NOT CHANGED");
+                EXIT;
+           END IF;
+           C.ALL := C.ALL + 1;
+      END LOOP;
+ 
+      RESULT;
+ END C38006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C38102A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INCOMPLETE TYPE DECLARATION CAN BE GIVEN FOR ANY TYPE.
+ -- FULL DECLARATIONS FOR INTEGER, ENUMERATION, CONSTRAINED AND
+ -- UNCONSTRAINED ARRAYS, RECORDS WITHOUT DISCRIMINANTS,
+ -- AN ACCESS TYPE, OR TYPES DERIVED FROM ANY OF THE ABOVE.
+ 
+ -- (FLOAT, FIXED, TASKS AND RECORDS WITH DISCRIMINANTS ARE CHECKED
+ -- IN OTHER TESTS).
+ 
+ -- DAT 3/24/81
+ -- SPS 10/25/82
+ -- SPS 2/17/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C38102A IS
+ BEGIN
+      TEST ("C38102A", "ANY TYPE MAY BE INCOMPLETE");
+ 
+      DECLARE
+ 
+           TYPE X1;
+           TYPE X2;
+           TYPE X3;
+           TYPE X4;
+           TYPE X5;
+           TYPE X6;
+           TYPE X7;
+           TYPE X8;
+      
+           TYPE D1;
+           TYPE D2;
+           TYPE D3;
+           TYPE D4;
+           TYPE D5;
+           TYPE D6;
+      
+           TYPE X1 IS RANGE 1 .. 10;
+           TYPE X2 IS (TRUE, FALSE, MAYBE, GREEN);
+           TYPE X3 IS ARRAY (1 .. 3) OF STRING (1..10);
+           TYPE X4 IS ARRAY (NATURAL RANGE <> ) OF X3;
+           TYPE AR1 IS ARRAY (X2) OF X3;
+           TYPE X5 IS RECORD
+                C1 : X4 (1..3);
+                C2 : AR1;
+           END RECORD;
+           TYPE X6 IS ACCESS X8;
+           TYPE X7 IS ACCESS X6;
+           TYPE X8 IS ACCESS X6;
+      
+           TYPE D1 IS NEW X1;
+           TYPE D2 IS NEW X2;
+           TYPE D3 IS NEW X3;
+           TYPE D4 IS NEW X4;
+           TYPE D5 IS NEW X5;
+           SUBTYPE D7 IS X7;
+           SUBTYPE D8 IS X8;
+           TYPE D6 IS ACCESS D8;
+      
+           PACKAGE P IS
+      
+                TYPE X1;
+                TYPE X2;
+                TYPE X3;
+                TYPE X4;
+                TYPE X5;
+                TYPE X6;
+                TYPE X7 IS PRIVATE;
+                TYPE X8 IS LIMITED PRIVATE;
+      
+                TYPE D1;
+                TYPE D2;
+                TYPE D3;
+                TYPE D4;
+                TYPE D5;
+                TYPE D6;
+      
+                TYPE X1 IS RANGE 1 .. 10;
+                TYPE X2 IS (TRUE, FALSE, MAYBE, GREEN);
+                TYPE X3 IS ARRAY (1 .. 3) OF STRING (1..10);
+                TYPE X4 IS ARRAY (NATURAL RANGE <> ) OF X3;
+                TYPE AR1 IS ARRAY (X2) OF X3;
+                TYPE X5 IS RECORD
+                     C1 : X4 (1..3);
+                     C2 : AR1;
+                END RECORD;
+                TYPE X6 IS ACCESS X8;
+      
+                TYPE D1 IS RANGE 1 .. 10;
+                TYPE D2 IS NEW X2;
+                TYPE D3 IS NEW X3;
+                TYPE D4 IS NEW X4;
+                TYPE D5 IS NEW X5;
+                TYPE D6 IS NEW X6;
+                SUBTYPE D7 IS X7;
+                SUBTYPE D8 IS X8;
+                TYPE D9 IS ACCESS D8;
+ 
+                VX7 : CONSTANT X7;
+      
+           PRIVATE
+      
+                TYPE X7 IS RECORD
+                     C1 : X1;
+                     C3 : X3;
+                     C5 : X5;
+                     C6 : X6;
+                     C8 : D9;
+                END RECORD;
+ 
+                V3 : X3 := (X3'RANGE => "ABCDEFGHIJ");
+                TYPE A7 IS ACCESS X7;
+                TYPE X8 IS ARRAY (V3'RANGE) OF A7;
+      
+                VX7 : CONSTANT X7 := (3, V3, ((1..3=>V3),
+                     (TRUE..GREEN=>V3)), NULL,
+                     NEW D8);
+           END P;
+           USE P;
+ 
+           VD7: P.D7;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                VD7 := D7(VX7);
+           END P;
+ 
+      BEGIN
+           IF VX7 /= P.X7(VD7) THEN
+                FAILED ("WRONG VALUE SOMEWHERE");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C38102A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,56 ----
+ -- C38102B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INCOMPLETE TYPES CAN BE FLOAT.
+ 
+ -- DAT 3/24/81
+ -- SPS 10/25/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C38102B IS
+ 
+ BEGIN
+      TEST ("C38102B", "INCOMPLETE TYPE CAN BE FLOAT");
+      
+      DECLARE
+ 
+           TYPE F;
+           TYPE G;
+           TYPE AF IS ACCESS F;
+           TYPE F IS DIGITS 2;
+           TYPE G IS NEW F RANGE 1.0 .. 1.5;
+           TYPE AG IS ACCESS G RANGE 1.0 .. 1.3;
+      
+           XF : AF := NEW F' (2.0);
+           XG : AG := NEW G' (G (XF.ALL/2.0));
+ 
+      BEGIN
+           IF XG.ALL NOT IN G THEN
+                FAILED ("ACCESS TO FLOAT");
+           END IF;
+      END;
+      
+      RESULT;
+ END C38102B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- C38102C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT INCOMPLETE TYPES CAN BE FIXED.
+ 
+ -- HISTORY:
+ --     DAT 03/24/81  CREATED ORIGINAL TEST.
+ --     SPS 10/25/82
+ --     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  CHANGED VARIOUS
+ --                   VALUES TO CORRECT CONSTRAINT PROBLEMS.  CHANGED
+ --                   THE VALUE OF F'DELTA, USING A POWER OF TWO.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C38102C IS
+ BEGIN
+      TEST ("C38102C", "INCOMPLETE TYPE CAN BE FIXED");
+ 
+      DECLARE
+ 
+           TYPE F;
+           TYPE G;
+           TYPE AF IS ACCESS F;
+           TYPE F IS DELTA 0.25 RANGE -2.0 .. 2.0;
+           TYPE G IS NEW F RANGE -1.0 .. 1.5;
+           TYPE AG IS ACCESS G RANGE -0.75 .. 1.25;
+ 
+           XF : AF := NEW F '(1.0);
+           XG : AG := NEW G '(G (XF.ALL/2));
+ 
+      BEGIN
+           IF XG.ALL NOT IN G THEN
+                FAILED ("ACCESS TO FIXED");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C38102C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,54 ----
+ -- C38102D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A TASK TYPE.
+ 
+ -- AH    8/14/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38102D IS
+      GLOBAL : INTEGER := 0;
+ BEGIN
+      TEST("C38102D", "INCOMPLETE TYPES CAN BE TASKS");
+      DECLARE
+           TYPE T1;
+           TASK TYPE T1 IS
+                ENTRY E(LOCAL : IN OUT INTEGER);
+           END T1;
+           T1_OBJ : T1;
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E(LOCAL : IN OUT INTEGER) DO
+                     LOCAL := IDENT_INT(2);
+                END E;
+           END T1;
+      BEGIN
+           T1_OBJ.E(GLOBAL);
+      END;
+ 
+      IF GLOBAL /= IDENT_INT(2) THEN
+           FAILED ("TASK NOT EXECUTED");
+      END IF;
+      RESULT;
+ END C38102D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38102e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38102e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C38102E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC 
+ -- FORMAL TYPE.
+ 
+ -- AH     8/15/86
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ -- DNT 11/28/95  CHANGED TO FLAG1 := F4.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38102E IS
+      TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET);
+      TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0;
+      TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5;
+      SUBTYPE P1 IS INTEGER;
+      TYPE P2 IS RANGE 0 .. 10;
+      TYPE P3 IS ARRAY (P2) OF INTEGER;
+      TYPE P4 IS ARRAY (P2, P2) OF INTEGER;
+ 
+      F1, F2 : BOOLEAN;
+ 
+      GENERIC
+           TYPE G1 IS (<>);
+           TYPE G2 IS RANGE <>;
+      FUNCTION G_DISCRETE RETURN BOOLEAN;
+ 
+      FUNCTION G_DISCRETE RETURN BOOLEAN IS
+           TYPE INC1;
+           TYPE INC2;
+           TYPE F1 IS NEW G1;
+           TYPE INC1 IS NEW G1;
+           TYPE INC2 IS NEW G2;
+ 
+           OBJ1_0 : INC1;
+           OBJ1_1 : INC1;
+           OBJ2_0 : INC2;
+           OBJ2_1 : INC2;
+           OBJ3 : F1;
+ 
+           RESULT_VALUE1 : BOOLEAN := FALSE;
+           RESULT_VALUE2 : BOOLEAN := FALSE;
+      BEGIN
+           OBJ3 := F1'LAST;
+           OBJ3 := F1'PRED(OBJ3);
+           IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN
+                RESULT_VALUE1 := TRUE;
+           END IF;
+           OBJ2_0 := INC2'FIRST;
+           OBJ2_1 := INC2'LAST;
+           IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) +
+                                   INC2'PRED(OBJ2_1)) THEN
+                RESULT_VALUE2 := TRUE;
+           END IF;
+ 
+           RETURN (RESULT_VALUE1 AND RESULT_VALUE2);
+      END G_DISCRETE;
+ 
+      GENERIC
+           TYPE G3 IS DIGITS <>;
+           TYPE G4 IS DELTA <>;
+      PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN);
+ 
+      PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS
+           F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN;
+           TYPE INC3;
+           TYPE INC4;
+           TYPE P1 IS NEW G3;
+           TYPE P2 IS NEW G4;
+           TYPE INC3 IS NEW G3;
+           TYPE INC4 IS NEW G4;
+      BEGIN
+           F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST);
+ 
+           F5 := P2'FORE = INC4'FORE;
+           F6 := P2'AFT = INC4'AFT;
+           F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST -
+                                                  INC4'FIRST));
+           F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST);
+ 
+           FLAG1 := F4;
+           FLAG2 := F5 AND F6 AND F7 AND F8;
+      END REALS;
+ 
+      GENERIC
+           TYPE ITEM IS PRIVATE;
+           TYPE INDEX IS RANGE <>;
+           TYPE G5 IS ARRAY (INDEX) OF ITEM;
+           TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM;
+      PACKAGE DIMENSIONS IS
+           TYPE INC5;
+           TYPE INC6;
+           TYPE D1 IS NEW G5;
+           TYPE D2 IS NEW G6;
+           TYPE INC5 IS NEW G5;
+           TYPE INC6 IS NEW G6;
+           FUNCTION CHECK RETURN BOOLEAN;
+      END DIMENSIONS;
+ 
+      PACKAGE BODY DIMENSIONS IS
+           FUNCTION CHECK RETURN BOOLEAN IS
+                A1 : INC5;
+                A2 : INC6;
+                DIM1 : D1;
+                DIM2 : D2;
+                F1, F2 : BOOLEAN;
+           BEGIN
+                F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE;
+                F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE = 
+                      DIM2(INDEX'FIRST, INDEX'LAST)'SIZE;
+ 
+                RETURN (F1 AND F2);
+           END CHECK;
+      END DIMENSIONS;
+      
+      PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED);
+      FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2);
+      PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3,
+                                     G6 => P4);
+ 
+      USE PKG;
+ BEGIN
+      TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " &
+                       "FORMAL TYPES");
+ 
+      IF NOT DISCRETE THEN
+           FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED");
+      END IF;
+ 
+      PROC (F1, F2);
+      IF (NOT F1) THEN
+           FAILED ("FLOAT TYPES NOT DERIVED");
+      END IF;
+      IF (NOT F2) THEN
+           FAILED ("FIXED TYPES NOT DERIVED");
+      END IF;
+ 
+      IF NOT CHECK THEN
+           FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED");
+      END IF;
+ 
+      RESULT;
+ END C38102E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38104a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38104a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38104a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C38104A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN INCOMPLETE TYPE WITH DISCRIMINANTS CAN BE
+ --     USED IN AN ACCESS TYPE DEFINITION WITH A COMPATIBLE DISCRIMINANT
+ --     CONSTRAINT.
+ 
+ -- HISTORY:
+ --     PMW 09/01/88  CREATED ORIGINAL TEST BY RENAMING E38104A.ADA.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C38104A IS
+ 
+ BEGIN
+ 
+      TEST ("C38104A","INCOMPLETELY DECLARED TYPE CAN BE USED AS TYPE " &
+            "MARK IN ACCESS TYPE DEFINITION, AND CAN BE CONSTRAINED " &
+            "THERE OR LATER IF INCOMPLETE TYPE HAD DISCRIMINANT(S)");
+ 
+      DECLARE
+           TYPE T1;
+           TYPE T1_NAME IS ACCESS T1;
+ 
+           TYPE T1 IS
+                RECORD
+                     COMP : INTEGER;
+                END RECORD;
+ 
+           TYPE T2(DISC : INTEGER := 5);
+           TYPE T2_NAME1 IS ACCESS T2(5);
+           TYPE T2_NAME2 IS ACCESS T2;
+ 
+           SUBTYPE SUB_T2_NAME2 IS T2_NAME2(5);
+           TYPE T2_NAME2_NAME IS ACCESS T2_NAME2(5);
+           X : T2_NAME2(5);
+ 
+           TYPE T2(DISC : INTEGER := 5) IS
+                RECORD
+                     COMP : T2_NAME2(DISC);
+                END RECORD;
+ 
+           X1N : T1_NAME;
+           X2A,X2B : T2;
+           X2N2 : T2_NAME2;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                X1N := NEW T1 '(COMP => 5);
+           END IF;
+ 
+           IF X1N.COMP /= 5 THEN
+                FAILED ("ASSIGNMENT FAILED - 1");
+           END IF;
+ 
+           X2A := (DISC => IDENT_INT(7), COMP => NULL);
+           X2N2 := NEW T2(IDENT_INT(7));
+           X2N2.ALL := X2A;
+ 
+           IF EQUAL(3,3) THEN
+                X2B := (DISC => IDENT_INT(7), COMP => X2N2);
+           END IF;
+ 
+           IF X2B.COMP.COMP /= NULL
+                OR X2B.COMP.DISC /= 7 THEN
+                FAILED ("ASSIGNMENT FAILED - 2");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C38104A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38107a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38107a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38107a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C38107A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR AN INCOMPLETE TYPE WITH DISCRIMINANTS DECLARED IN THE
+ --     VISIBLE PART OF A PACKAGE OR IN A DECLARATIVE PART, CHECK THAT
+ --     CONSTRAINT_ERROR IS RAISED IF A DISCRIMINANT CONSTRAINT IS
+ --     SPECIFIED FOR THE TYPE AND ONE OF THE DISCRIMINANT VALUES DOES
+ --     NOT BELONG TO THE CORRESPONDING DISCRIMINANT'S SUBTYPE.
+ 
+ -- HISTORY:
+ --     BCB 01/21/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C38107A IS
+ 
+ BEGIN
+      TEST ("C38107A", "FOR AN INCOMPLETE TYPE WITH DISCRIMINANTS " &
+                       "DECLARED IN THE VISIBLE PART OF A PACKAGE OR " &
+                       "IN A DECLARATIVE PART, CHECK THAT CONSTRAINT_" &
+                       "ERROR IS RAISED IF A DISCRIMINANT CONSTRAINT " &
+                       "IS SPECIFIED FOR THE TYPE AND ONE OF THE " &
+                       "DISCRIMINANT VALUES DOES NOT BELONG TO THE " &
+                       "CORRESPONDING DISCRIMINANT'S SUBTYPE");
+ 
+      BEGIN
+           DECLARE
+                PACKAGE P IS
+                     SUBTYPE INT6 IS INTEGER RANGE 1 .. 6;
+                     TYPE T_INT6 (D6 : INT6);
+                     TYPE TEST IS ACCESS T_INT6(7);  -- CONSTRAINT_ERROR.
+                     TYPE T_INT6 (D6 : INT6) IS
+                          RECORD
+                               NULL;
+                          END RECORD;
+                END P;
+                USE P;
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
+                DECLARE
+                     T : P.TEST := NEW T_INT6(7);
+                BEGIN
+                     IF EQUAL(T.D6, T.D6) THEN
+                          COMMENT ("DON'T OPTIMIZE T.D6");
+                     END IF;
+                END;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 1");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE INT7 IS INTEGER RANGE 1 .. 7;
+                TYPE T_INT7 (D7 : INT7);
+                TYPE TEST IS ACCESS T_INT7(8);       -- CONSTRAINT_ERROR.
+                TYPE T_INT7 (D7 : INT7) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
+                DECLARE
+                     T : TEST := NEW T_INT7(6);
+                BEGIN
+                     IF EQUAL(T.D7, T.D7) THEN
+                          COMMENT ("DON'T OPTIMIZE T.D7");
+                     END IF;
+                END;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 2");
+      END;
+      RESULT;
+ END C38107A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38107b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38107b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38107b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38107b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,194 ----
+ -- C38107B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN ACCESS TYPE WHICH
+ --     DESIGNATES AN INCOMPLETE TYPE WHICH WAS DECLARED IN THE VISIBLE
+ --     OR PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN A DECLARATIVE
+ --     PART, CONSTRAINT_ERROR IS RAISED IF ONE OF THE
+ --     DISCRIMINANT'S VALUES DOES NOT BELONG TO THE CORRESPONDING
+ --     DISCRIMINANT'S SUBTYPE.
+ 
+ -- HISTORY:
+ --     DHH 08/05/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38107B IS
+ 
+ BEGIN
+      TEST("C38107B", "IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN " &
+                      "ACCESS TYPE WHICH DESIGNATES AN INCOMPLETE " &
+                      "TYPE WHICH WAS DECLARED IN THE VISIBLE OR " &
+                      "PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN " &
+                      "A DECLARATIVE PART, CONSTRAINT_ERROR IS " &
+                      "RAISED IF ONE OF THE DISCRIMINANT'S VALUES " &
+                      "DOES NOT BELONG TO THE CORRESPONDING " &
+                      "DISCRIMINANT'S SUBTYPE");
+ 
+ ------------------------------ VISIBLE ------------------------------
+      BEGIN
+           DECLARE
+                PACKAGE PACK IS
+                     SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
+ 
+                     TYPE INCOMPLETE(A : SMALLER);
+ 
+                     TYPE ACC_INC IS ACCESS INCOMPLETE;
+                     SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
+ 
+                     TYPE INCOMPLETE(A : SMALLER) IS
+                          RECORD
+                               T : INTEGER := A;
+                          END RECORD;
+ 
+                END PACK;
+ 
+                PACKAGE BODY PACK IS
+                BEGIN
+                     FAILED("CONSTRAINT_ERROR NOT RAISED - VISIBLE");
+                     DECLARE
+                          Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
+                     BEGIN
+                          IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
+                               COMMENT("THIS LINE SHOULD NOT PRINT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          FAILED("CONSTRAINT_ERROR RAISED LATE " &
+                                 "- VISIBLE");
+                     WHEN OTHERS =>
+                          FAILED("UNEXPECTED EXCEPTION RAISED " &
+                                 "LATE - VISIBLE");
+                END PACK;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED " &
+                       "- VISIBLE");
+      END;
+ 
+ ------------------------------ PRIVATE ------------------------------
+      BEGIN
+           DECLARE
+                PACKAGE PACK2 IS
+                     SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
+ 
+                     TYPE PRIV IS PRIVATE;
+ 
+                PRIVATE
+                     TYPE PRIV IS
+                          RECORD
+                               V : INTEGER;
+                          END RECORD;
+ 
+                     TYPE INCOMPLETE(A : SMALLER);
+ 
+                     TYPE ACC_INC IS ACCESS INCOMPLETE;
+                     SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(0));
+ 
+                     TYPE INCOMPLETE(A : SMALLER) IS
+                          RECORD
+                               T : INTEGER := A;
+                               U : PRIV := (V => A ** IDENT_INT(2));
+                          END RECORD;
+ 
+                END PACK2;
+ 
+                PACKAGE BODY PACK2 IS
+                BEGIN
+                     FAILED("CONSTRAINT_ERROR NOT RAISED - PRIVATE");
+                     DECLARE
+                          Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(0));
+                     BEGIN
+                          IF IDENT_INT(Z.T) = IDENT_INT(0) THEN
+                               COMMENT("THIS LINE SHOULD NOT PRINT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
+                                 "- PRIVATE");
+                     WHEN OTHERS =>
+                          FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
+                                 "- PRIVATE");
+                END PACK2;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                          FAILED("UNEXPECTED EXCEPTION RAISED " &
+                                 "- PRIVATE");
+      END;
+ 
+ -------------------------- DECLARATIVE PART --------------------------
+      BEGIN
+           DECLARE
+                SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
+ 
+                TYPE INCOMPLETE(A : SMALLER);
+ 
+                TYPE ACC_INC IS ACCESS INCOMPLETE;
+                SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
+ 
+                TYPE INCOMPLETE(A : SMALLER) IS
+                     RECORD
+                          T : INTEGER := INTEGER'(A);
+                     END RECORD;
+ 
+           BEGIN
+                FAILED("CONSTRAINT_ERROR NOT RAISED - BLOCK " &
+                       "STATEMENT");
+                DECLARE
+                     Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
+                BEGIN
+                     IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
+                          COMMENT("THIS LINE SHOULD NOT PRINT");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
+                            "- BLOCK STATEMENT");
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
+                            "- BLOCK STATEMENT");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                          FAILED("UNEXPECTED EXCEPTION RAISED " &
+                                 "- BLOCK STATEMENT");
+      END;
+ 
+      RESULT;
+ END C38107B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C38108A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
+ -- A PACKAGE, WITH THE FULL DECLARATION OCCURRING IN THE PACKAGE BODY.
+ 
+ -- AH  8/20/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38108A IS
+ 
+      PACKAGE P IS 
+           TYPE L IS LIMITED PRIVATE;
+           PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+           FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+      PRIVATE
+           TYPE INC (D : INTEGER);
+           TYPE L IS ACCESS INC;
+      END P;
+ 
+      PACKAGE BODY P IS
+           TYPE INC (D : INTEGER) IS
+                RECORD
+                     C : INTEGER;
+                END RECORD;
+           
+           PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+           BEGIN
+                Y := NEW INC(1);
+                Y.C := X;
+           END ASSIGN;
+ 
+           FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+           BEGIN
+                RETURN (X.C = Y.C);          
+           END "=";
+ 
+      END P;
+ 
+ USE P;
+ BEGIN
+ 
+      TEST ("C38108A", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                       "PRIVATE PART WITHOUT FULL DECLARATION");
+      DECLARE
+           VAL_1, VAL_2 : L;
+      BEGIN
+           ASSIGN (2, VAL_1);
+           ASSIGN (2, VAL_2);
+           IF NOT "=" (VAL_1, VAL_2) THEN
+                FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C38108A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,76 ----
+ -- C38108B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
+ -- A LIBRARY PACKAGE, WITH THE FULL DECLARATION OCCURRING LATER IN A 
+ -- PACKAGE BODY.
+ 
+ -- AH  8/20/86
+ 
+ PACKAGE C38108B_P IS 
+      TYPE L IS LIMITED PRIVATE;
+      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+ PRIVATE
+      TYPE INC (D : INTEGER);
+      TYPE L IS ACCESS INC;
+ END C38108B_P;
+ 
+ PACKAGE BODY C38108B_P IS
+      TYPE INC (D : INTEGER) IS
+           RECORD
+                C : INTEGER;
+           END RECORD;
+      
+      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+      BEGIN
+           Y := NEW INC(1);
+           Y.C := X;
+      END ASSIGN;
+ 
+      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+      BEGIN
+           RETURN (X.C = Y.C);          
+      END "=";
+ 
+ END C38108B_P;
+ 
+ WITH REPORT; USE REPORT;
+ WITH C38108B_P; USE C38108B_P;
+ PROCEDURE C38108B IS
+      VAL_1, VAL_2 : L;
+ BEGIN
+ 
+      TEST ("C38108B", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                       "PRIVATE PART WITHOUT FULL DECLARATION - " &
+                       "LIBRARY PACKAGE");
+ 
+      ASSIGN (2, VAL_1);
+      ASSIGN (2, VAL_2);
+      IF NOT "=" (VAL_1, VAL_2) THEN
+           FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+      END IF;
+ 
+      RESULT;
+ END C38108B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- C38108C0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SPECIFICATION OF LIBRARY PACKAGE USED WITH C38108C1M.
+ 
+ -- AH  8/20/86
+ 
+ PACKAGE C38108C0 IS
+      TYPE L IS LIMITED PRIVATE;
+      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+ PRIVATE
+      TYPE INC (D : INTEGER);
+      TYPE L IS ACCESS INC;
+ END C38108C0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,52 ----
+ -- C38108C1M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INCOMPLETE TYPE CAN BE DELCARED IN A SEPARATELY
+ -- COMPILED PACKAGE SPECIFICATION AND ITS FULL DECLARATION CAN LATER BE 
+ -- GIVEN IN A SEPARATELY COMPILED BODY.
+ 
+ -- AH  8/20/86
+ 
+ -- C38108C0    THE PACKAGE SPECIFICATION.
+ -- C38108C1M   THE MAIN PROGRAM.
+ -- C38108C2    THE PACKAGE BODY.
+ 
+ WITH REPORT; USE REPORT;
+ WITH C38108C0; USE C38108C0;
+ PROCEDURE C38108C1M IS
+      VAL_1, VAL_2 : L;
+ BEGIN
+ 
+      TEST ("C38108C", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                       "PRIVATE PART WITHOUT FULL DECLARATION - " &
+                       "LIBRARY PACKAGE");
+ 
+      ASSIGN (2, VAL_1);
+      ASSIGN (2, VAL_2);
+      IF NOT "=" (VAL_1, VAL_2) THEN
+           FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+      END IF;
+ 
+      RESULT;
+ END C38108C1M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108c2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108c2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108c2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,47 ----
+ -- C38108C2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- PACKAGE BODY FOR USE WITH C38108C1M.
+ -- SPECIFICATION IS IN C38108C0.
+ 
+ -- AH  8/20/86
+ 
+ PACKAGE BODY C38108C0 IS
+      TYPE INC (D : INTEGER) IS
+           RECORD
+                C : INTEGER;
+           END RECORD;
+      
+      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+      BEGIN
+           Y := NEW INC(1);
+           Y.C := X;
+      END ASSIGN;
+ 
+      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+      BEGIN
+           RETURN (X.C = Y.C);          
+      END "=";
+ 
+ END C38108C0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108d0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108d0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108d0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- C38108D0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
+ -- A PACKAGE, WITH THE FULL DECLARATION OCCURRING LATER IN A 
+ -- PACKAGE BODY SUBUNIT.
+ 
+ -- OTHER FILES: C38108D1.ADA (PACKAGE BODY SUBUNIT.)
+ 
+ -- AH  8/20/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C38108D0M IS
+      PACKAGE C38108D1 IS
+           TYPE L IS LIMITED PRIVATE;
+           PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+           FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+      PRIVATE
+           TYPE INC (D : INTEGER);
+           TYPE L IS ACCESS INC;
+      END C38108D1;
+ 
+      PACKAGE BODY C38108D1 IS SEPARATE;
+ 
+ USE C38108D1;
+ BEGIN
+ 
+      TEST ("C38108D", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                       "PRIVATE PART WITH FULL DECLARATION IN " &
+                       "A PACKAGE BODY SUBUNIT");
+ 
+ DECLARE
+      VAL_1, VAL_2 : L;
+ BEGIN
+      ASSIGN (2, VAL_1);
+      ASSIGN (2, VAL_2);
+      IF NOT "=" (VAL_1, VAL_2) THEN
+           FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+      END IF;
+ END;
+ 
+      RESULT;
+ END C38108D0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108d1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38108d1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38108d1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,47 ----
+ -- C38108D1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- PACKAGE BODY SUBUNIT USED WITH C38108D0M.
+ 
+ -- AH  8/20/86
+ 
+ SEPARATE (C38108D0M)
+ PACKAGE BODY C38108D1 IS
+      TYPE INC (D : INTEGER) IS
+           RECORD
+                C : INTEGER;
+           END RECORD;
+      
+      PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+      BEGIN
+           Y := NEW INC(1);
+           Y.C := X;
+      END ASSIGN;
+ 
+      FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+      BEGIN
+           RETURN (X.C = Y.C);          
+      END "=";
+ 
+ END C38108D1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38202a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c38202a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c38202a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,197 ----
+ -- C38202A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT TASKING ATTRIBUTES ARE DECLARED AND RETURN CORRECT 
+ -- VALUES FOR OBJECTS HAVING AN ACCESS TYPE WHOSE DESIGNATED 
+ -- TYPE IS A TASK TYPE.
+ -- CHECK THE ACCESS TYPE RESULTS OF FUNCTION CALLS.
+ 
+ -- AH  9/12/86
+ -- EDS 7/14/98  AVOID OPTIMIZATION
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C38202A IS
+ BEGIN 
+      TEST ("C38202A", "OBJECTS HAVING ACCESS TYPES WITH DESIGNATED " &
+            "TASK TYPE CAN BE PREFIX OF TASKING ATTRIBUTES");
+ 
+ -- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
+ --                   (2)  TASK IS NOT CALLABLE, TERMINATED.
+ 
+      DECLARE 
+           TASK TYPE TSK IS 
+                ENTRY GO_ON;
+           END TSK;
+ 
+           TASK DRIVER IS 
+                ENTRY TSK_DONE;
+           END DRIVER;
+ 
+           TYPE P_TYPE IS ACCESS TSK;
+           P : P_TYPE;
+ 
+           TASK BODY TSK IS
+                I : INTEGER RANGE 0 .. 2;
+           BEGIN 
+                ACCEPT GO_ON;
+                I := IDENT_INT(5);         -- CONSTRAINT_ERROR RAISED.
+                FAILED ("CONSTAINT_ERROR NOT RAISED IN TASK " &
+                        " TSK - 1A " & INTEGER'IMAGE(I));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     DRIVER.TSK_DONE;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN TASK " &
+                             "TSK - 1A ");
+                     DRIVER.TSK_DONE;
+           END TSK;
+ 
+           TASK BODY DRIVER IS
+                COUNTER : INTEGER := 1;
+           BEGIN
+                P := NEW TSK;
+                IF NOT P'CALLABLE THEN
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE - 1B");
+                END IF;
+ 
+                IF P'TERMINATED THEN 
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE - 1C");
+                END IF;
+ 
+                P.GO_ON;
+                ACCEPT TSK_DONE;
+                WHILE (NOT P'TERMINATED AND COUNTER <= 3) LOOP
+                     DELAY 10.0 * Impdef.One_Second;
+                     COUNTER := COUNTER + 1;
+                END LOOP;
+ 
+                IF COUNTER > 3 THEN
+                     FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
+                             "TIME - 1D");
+                END IF;
+ 
+                IF P'CALLABLE THEN
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE - 1E");
+                END IF;
+ 
+                IF NOT P'TERMINATED THEN
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE - 1F");
+                END IF;
+           END DRIVER;
+ 
+      BEGIN
+           NULL;
+      END;     -- BLOCK
+ 
+ -- CHECK ACCESS TYPE RESULT RETURNED FROM FUNCTION.
+ -- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
+ --                   (2)  TASK IS NOT CALLABLE, TERMINATED.
+ 
+      DECLARE 
+           TASK TYPE TSK IS 
+                ENTRY GO_ON;
+           END TSK;
+ 
+           TASK DRIVER IS 
+                ENTRY TSK_DONE;
+           END DRIVER;
+ 
+           TYPE P_TYPE IS ACCESS TSK;
+           P : P_TYPE;
+ 
+           TSK_CREATED : BOOLEAN := FALSE;
+ 
+           FUNCTION F1 RETURN P_TYPE IS
+           BEGIN
+                RETURN P;
+           END F1;
+ 
+           TASK BODY TSK IS
+                I : INTEGER RANGE 0 .. 2;
+           BEGIN 
+                ACCEPT GO_ON;
+                I := IDENT_INT(5);          -- CONSTRAINT_ERROR RAISED.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED IN TASK " &
+                        "TSK - 2A " & INTEGER'IMAGE(I));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     DRIVER.TSK_DONE;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN TASK " &
+                             "TSK - 2A ");
+                     DRIVER.TSK_DONE;
+           END TSK;
+ 
+           TASK BODY DRIVER IS
+                COUNTER : INTEGER := 1;
+           BEGIN
+                P := NEW TSK;               -- ACTIVATE P.ALL (F1.ALL).
+                IF NOT F1'CALLABLE THEN
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE WHEN PREFIX IS VALUE FROM " &
+                             "FUNCTION CALL - 2B");
+                END IF;
+ 
+                IF F1'TERMINATED THEN 
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE WHEN PREFIX IS VALUE FROM " &
+                             "FUNCTION CALL - 2C");
+                END IF;
+ 
+                F1.ALL.GO_ON;
+                ACCEPT TSK_DONE;
+                WHILE (NOT F1'TERMINATED AND COUNTER <= 3) LOOP
+                     DELAY 10.0 * Impdef.One_Second;
+                     COUNTER := COUNTER + 1;
+                END LOOP;
+ 
+                IF COUNTER > 3 THEN
+                     FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
+                             "TIME - 2D");
+                END IF;
+ 
+                IF F1'CALLABLE THEN
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE WHEN PREFIX IS VALUE FROM " &
+                             "FUNCTION CALL - 2E");
+                END IF;
+ 
+                IF NOT F1'TERMINATED THEN
+                     FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                             "VALUE WHEN PREFIX IS VALUE FROM " &
+                             "FUNCTION CALL - 2F");
+                END IF;
+           END DRIVER;
+ 
+      BEGIN
+           NULL;
+      END;     -- BLOCK
+ 
+      RESULT;
+ END C38202A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- C3900010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C3900011.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C3900011.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --      => C3900010.A
+ --         C3900011.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+ --                          for Ada.Calendar.
+ --
+ --!
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package C3900010 is
+ 
+ 
+    -- Declarations used by component Display_On and procedure Display.
+ 
+    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
+    type Display_Counters is array (Device_Enum) of Natural;
+ 
+    Display_Count_For : Display_Counters := (others => 0);
+ 
+ 
+    -- Declarations required for component Arrival_Time.
+ 
+    Default_Time : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1901, 1, 1);
+    Alert_Time   : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1991, 6, 15);
+ 
+ 
+    type Alert_Type is tagged record                    -- Root tagged type.
+       Arrival_Time : Ada.Calendar.Time := Default_Time;
+       Display_On   : Device_Enum       := Null_Device;
+    end record;
+ 
+ 
+    procedure Display (A : in Alert_Type);             -- To be inherited by
+                                                       -- all derivatives.
+ 
+    procedure Handle (A : in out Alert_Type);          -- To be inherited by
+                                                       -- all derivatives.
+ 
+ 
+ 
+    type Low_Alert_Type is new Alert_Type with record  -- Record extension of
+       Level : Integer := 0;                           -- root tagged type.
+    end record;
+ 
+    -- Inherits procedure Display from Alert.
+    -- Inherits procedure Handle  from Alert.
+ 
+    function Level_Of (LA : in Low_Alert_Type)         -- To be inherited by
+      return Integer;                                  -- all derivatives.
+ 
+ 
+ 
+    -- Declarations required for component Action_Officer;
+ 
+    type Person_Enum is (Nobody,          Duty_Officer,
+                         Watch_Commander, Commanding_Officer);
+ 
+ 
+ 
+    type Medium_Alert_Type is new Low_Alert_Type with record
+       Action_Officer : Person_Enum := Nobody;         -- Record extension of
+    end record;                                        -- record extension.
+ 
+    -- Inherits (inherited) procedure Display from Low_Alert_Type.
+    -- Inherits (inherited) procedure Handle  from Low_Alert_Type.
+ 
+    -- Inherits function Level_Of from Low_Alert_Type.
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum);
+ 
+ 
+ end C3900010;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C3900010 is
+ 
+ 
+    procedure Display (A : in Alert_Type) is
+    begin
+       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
+    end Display;
+ 
+ 
+    procedure Handle (A : in out Alert_Type) is
+    begin
+       A.Arrival_Time := Alert_Time;
+    end Handle;
+ 
+ 
+    function Level_Of (LA : in Low_Alert_Type) return Integer is
+    begin
+       return (LA.Level + 1);
+    end Level_Of;
+ 
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum) is
+    begin
+       MA.Action_Officer := To;
+    end Assign_Officer;
+ 
+ 
+ end C3900010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900011.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900011.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900011.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900011.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,253 ----
+ -- C3900011.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a record extension can be declared in the same package
+ --      as its parent, and that this parent may be a tagged record or a
+ --      record extension. Check that each derivative inherits all user-
+ --      defined primitive subprograms of its parent (including those that
+ --      its parent inherited), and that it may declare its own primitive
+ --      subprograms.
+ --
+ --      Check that predefined equality operators are defined for the root
+ --      tagged type.
+ --
+ --      Check that type conversion is defined from a type extension to its
+ --      parent, and that this parent itself may be a type extension.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type in a package specification. Declare two
+ --      primitive subprograms for the type.
+ -- 
+ --      Extend the root type with a record extension in the same package
+ --      specification. Declare a new primitive subprogram for the extension
+ --      (in addition to its two inherited subprograms).
+ -- 
+ --      Extend the extension with a record extension in the same package
+ --      specification. Declare a new primitive subprogram for this second
+ --      extension (in addition to its three inherited subprograms).
+ -- 
+ --      In the main program, declare operations for the root tagged type which
+ --      utilize aggregates and equality operators to verify the correctness
+ --      of the components. Overload these operations for the two type
+ --      extensions. Within each of these overloading operations, utilize type
+ --      conversion to call the parent's implementation of the same operation.
+ -- 
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         C3900010.A
+ --      => C3900011.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with C3900010;
+ with Report;
+ procedure C3900011 is
+ 
+ 
+    package Check_Alert_Values is
+ 
+       -- Declare functions to verify correctness of tagged record components
+       -- before and after calls to their primitive subprograms.
+ 
+ 
+       -- Alert_Type:
+ 
+       function Initial_Values_Okay (A : in C3900010.Alert_Type)
+         return Boolean;
+ 
+       function Bad_Final_Values (A : in C3900010.Alert_Type)
+         return Boolean;
+ 
+ 
+       -- Low_Alert_Type:
+ 
+       function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type)
+         return Boolean;
+ 
+       function Bad_Final_Values (LA : in C3900010.Low_Alert_Type)
+         return Boolean;
+ 
+ 
+       -- Medium_Alert_Type:
+ 
+       function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type)
+         return Boolean;
+ 
+       function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type)
+         return Boolean;
+ 
+ 
+    end Check_Alert_Values;
+ 
+ 
+         --==========================================================--
+ 
+ 
+    package body Check_Alert_Values is
+ 
+ 
+       function Initial_Values_Okay (A : in C3900010.Alert_Type)
+         return Boolean is
+          use type C3900010.Alert_Type;
+       begin                                      -- "=" operator availability.
+          return (A = (Arrival_Time => C3900010.Default_Time,
+                       Display_On   => C3900010.Null_Device));
+       end Initial_Values_Okay;
+ 
+ 
+       function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type)
+         return Boolean is
+       begin                                      -- Type conversion.
+          return (Initial_Values_Okay (C3900010.Alert_Type (LA)) and
+                  LA.Level = 0);                               
+       end Initial_Values_Okay;
+ 
+ 
+       function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type)
+         return Boolean is
+          use type C3900010.Person_Enum;
+       begin                                      -- Type conversion.
+          return (Initial_Values_Okay (C3900010.Low_Alert_Type (MA)) and
+                  MA.Action_Officer = C3900010.Nobody);
+       end Initial_Values_Okay;
+ 
+ 
+       function Bad_Final_Values (A : in C3900010.Alert_Type)
+         return Boolean is
+          use type C3900010.Alert_Type;
+       begin                                      -- "/=" operator availability.
+          return (A /= (Arrival_Time => C3900010.Alert_Time,
+                        Display_On   => C3900010.Null_Device));
+       end Bad_Final_Values;
+ 
+ 
+       function Bad_Final_Values (LA : in C3900010.Low_Alert_Type)
+         return Boolean is
+          use type C3900010.Low_Alert_Type;
+       begin                                      -- "=" operator availability.
+          return not ( LA = (Arrival_Time => C3900010.Alert_Time,
+                             Display_On   => C3900010.Teletype,
+                             Level        => 1) );
+       end Bad_Final_Values;
+ 
+ 
+       function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type)
+         return Boolean is
+          use type C3900010.Medium_Alert_Type;
+       begin                                      -- "/=" operator availability.
+          return ( MA /= (C3900010.Alert_Time,
+                          C3900010.Console,
+                          1,
+                          C3900010.Duty_Officer) );
+       end Bad_Final_Values;
+ 
+ 
+    end Check_Alert_Values;
+ 
+ 
+         --==========================================================--
+ 
+ 
+    use Check_Alert_Values;
+    use C3900010;
+ 
+    Root_Alarm   : C3900010.Alert_Type;
+    Low_Alarm    : C3900010.Low_Alert_Type;
+    Medium_Alarm : C3900010.Medium_Alert_Type;
+ 
+ begin
+ 
+    Report.Test ("C390001", "Primitive operation inheritance by type " &
+                 "extensions: all extensions declared in same package " &
+                 "as parent");
+ 
+ 
+ -- Check root tagged type:
+ 
+    if Initial_Values_Okay (Root_Alarm) then
+       Handle  (Root_Alarm);                          -- Explicitly declared.
+       Display (Root_Alarm);                          -- Explicitly declared.
+ 
+       if Bad_Final_Values (Root_Alarm) then
+          Report.Failed ("Wrong results after Alert_Type calls");
+       end if;
+    else
+       Report.Failed ("Wrong initial values for Alert_Type");
+    end if;
+ 
+ 
+ -- Check record extension of root tagged type:
+ 
+    if Initial_Values_Okay (Low_Alarm) then
+       Handle (Low_Alarm);                            -- Inherited.
+       Low_Alarm.Display_On := Teletype;
+       Display (Low_Alarm);                           -- Inherited.
+       Low_Alarm.Level := Level_Of (Low_Alarm);       -- Explicitly declared.
+ 
+       if Bad_Final_Values (Low_Alarm) then
+          Report.Failed ("Wrong results after Low_Alert_Type calls");
+       end if;
+    else
+       Report.Failed ("Wrong initial values for Low_Alert_Type");
+    end if;
+ 
+ 
+ -- Check record extension of record extension:
+ 
+    if Initial_Values_Okay (Medium_Alarm) then
+       Handle (Medium_Alarm);                         -- Inherited twice.
+       Medium_Alarm.Display_On := Console;
+       Display (Medium_Alarm);                        -- Inherited twice.
+       Medium_Alarm.Level := Level_Of (Medium_Alarm); -- Inherited.
+       Assign_Officer (Medium_Alarm, Duty_Officer);   -- Explicitly declared.
+ 
+       if Bad_Final_Values (Medium_Alarm) then
+          Report.Failed ("Wrong results after Medium_Alert_Type calls");
+       end if;
+    else
+       Report.Failed ("Wrong initial values for Medium_Alert_Type");
+    end if;
+ 
+ 
+ -- Check final display counts:
+ 
+    if C3900010.Display_Count_For /= (Null_Device => 1,
+                                      Teletype    => 1,
+                                      Console     => 1,
+                                      Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong final values for display counts");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C3900011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C390002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a tagged base type may be declared, and derived
+ --      from in simple, private and extended forms.  (Overlaps with C390B04)
+ --      Check that the package Ada.Tags is present and correctly implemented.
+ --      Check for the correct operation of Expanded_Name, External_Tag and
+ --      Internal_Tag within that package.  Check that the exception Tag_Error
+ --      is correctly raised on calling Internal_Tag with bad input.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares a tagged type, and derives three types from it.
+ --      These types are then used to test the presence and function of the
+ --      package Ada.Tags.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --      27 Jan 96   SAIC    Update RM references for 2.1
+ --
+ --!
+ 
+ with Report;
+ with Ada.Tags;  
+ 
+ procedure C390002 is
+ 
+   package Vehicle is
+ 
+     type Object is tagged limited private;  -- ancestor type
+     procedure Create( The_Vehicle : in out Object; Wheels : in Natural );
+     function  Wheels( The_Vehicle : Object ) return Natural;
+ 
+   private
+ 
+     type Object is tagged limited record
+       Wheel_Count : Natural := 0;
+     end record;
+ 
+   end Vehicle;
+ 
+   package Motivators is
+ 
+     type Bicycle is new Vehicle.Object with null record; -- simple 
+ 
+     type Car is new Vehicle.Object with record           -- extended
+       Convertible : Boolean;
+     end record;
+ 
+     type Truck is new Vehicle.Object with private;       -- private
+ 
+   private
+ 
+     type Truck is new Vehicle.Object with record
+       Air_Horn : Boolean;
+     end record;
+ 
+   end Motivators;
+ 
+   package body Vehicle is
+ 
+     procedure Create( The_Vehicle : in out Object; Wheels : in Natural ) is
+     begin
+       The_Vehicle.Wheel_Count := Wheels;
+     end Create;
+ 
+     function  Wheels( The_Vehicle : Object ) return Natural is
+     begin
+       return The_Vehicle.Wheel_Count;
+     end Wheels;
+ 
+   end Vehicle;
+ 
+   function TC_ID_Tag( Tag : in Ada.Tags.Tag ) return Ada.Tags.Tag is
+   begin
+     return Ada.Tags.Internal_Tag( Ada.Tags.External_Tag( Tag ) );
+     Report.Comment("This message intentionally blank.");
+   end TC_ID_Tag;
+ 
+   procedure Check_Tags( Machine       : in Vehicle.Object'Class;
+                         Expected_Name : in String;
+                         External_Tag  : in String ) is
+     The_Tag : constant Ada.Tags.Tag := Machine'Tag;
+     use type Ada.Tags.Tag;
+   begin
+       if Ada.Tags.Expanded_Name(The_Tag) /= Expected_Name then  
+          Report.Failed ("Failed in Check_Tags, Expanded_Name "
+                         & Expected_Name);
+       end if;
+       if Ada.Tags.External_Tag(The_Tag) /= External_Tag then  
+          Report.Failed ("Failed in Check_Tags, External_Tag "
+                         & Expected_Name);
+       end if;
+       if Ada.Tags.Internal_Tag(External_Tag) /= The_Tag then
+          Report.Failed ("Failed in Check_Tags, Internal_Tag "
+                         & Expected_Name);
+       end if;
+   end Check_Tags;
+ 
+   procedure Check_Exception is
+     Boeing_777_Id : Ada.Tags.Tag;
+   begin
+     Boeing_777_Id := Ada.Tags.Internal_Tag("!@#$%^:*\/?"" not a tag!");
+     Report.Failed ("Failed in Check_Exception, no exception");
+     Boeing_777_Id := TC_ID_Tag( Boeing_777_Id ); 
+   exception
+     when Ada.Tags.Tag_Error => null;  
+     when others =>
+       Report.Failed ("Failed in Check_Exception, wrong exception");
+   end Check_Exception;
+ 
+   use Motivators;
+   Two_Wheeler      : Bicycle;
+   Four_Wheeler     : Car;
+   Eighteen_Wheeler : Truck;
+ 
+ begin  -- Main test procedure.
+ 
+     Report.Test ("C390002", "Check that a tagged type may be declared and " &
+                  "derived from in simple, private and extended forms.  " &
+                  "Check package Ada.Tags" );
+ 
+     Create( Two_Wheeler,       2 );
+     Create( Four_Wheeler,      4 );
+     Create( Eighteen_Wheeler, 18 );
+    
+     Check_Tags( Machine       => Two_Wheeler, 
+                 Expected_Name => "C390002.MOTIVATORS.BICYCLE",
+                 External_Tag  => Bicycle'External_Tag );
+     Check_Tags( Machine       => Four_Wheeler, 
+                 Expected_Name => "C390002.MOTIVATORS.CAR",
+                 External_Tag  => Car'External_Tag );
+     Check_Tags( Machine       => Eighteen_Wheeler, 
+                 Expected_Name => "C390002.MOTIVATORS.TRUCK",
+                 External_Tag  => Truck'External_Tag );
+ 
+     Check_Exception;
+  
+   Report.Result;
+ 
+ end C390002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,419 ----
+ -- C390003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that for a subtype S of a tagged type T, S'Class denotes a
+ --     class-wide subtype.  Check that T'Tag denotes the tag of the type T,
+ --     and that, for a class-wide tagged type X, X'Tag denotes the tag of X.
+ --     Check that the tags of stand alone objects, record and array
+ --     components, aggregates, and formal parameters identify their type.
+ --     Check that the tag of a value of a formal parameter is that of the
+ --     actual parameter, even if the actual is passed by a view conversion.
+ --
+ -- TEST DESCRIPTION:
+ --     This test defines a class hierarchy (based on C390002) and
+ --     uses it to determine the correctness of the resulting tag
+ --     information generated by the compiler.  A type is defined in the
+ --     class which contains components of the class as part of its
+ --     definition.  This is to reduce the overall number of types
+ --     required, and to achieve the required nesting to accomplish
+ --     this test.  The model is that of a car carrier truck; both car
+ --     and truck being in the class of Vehicle.
+ --
+ --      Class Hierarchy:
+ --                         Vehicle - - - - - - - (Bicycle)
+ --                        /   |   \               /      \
+ --                   Truck   Car   Q_Machine   Tandem  Motorcycle
+ --                     |
+ --                Auto_Carrier
+ --      Contains:
+ --                Auto_Carrier( Car )
+ --                Q_Machine( Car, Motorcycle )
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed ARM references from objective text.
+ --      20 Dec 94   SAIC    Replaced three unnecessary extension
+ --                          aggregates with simple aggregates.
+ --      16 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C390003_1
+ 
+ with Ada.Tags;
+ package C390003_1 is -- Vehicle
+ 
+   type TC_Keys is (Veh, MC, Tand, Car, Q, Truk, Heavy);
+   type States  is (Good, Flat, Worn);
+ 
+   type Wheel_List is array(Positive range <>) of States;
+ 
+   type Object(Wheels: Positive) is tagged record
+     Wheel_State : Wheel_List(1..Wheels);
+   end record;
+ 
+   procedure TC_Validate( It: Object; Key: TC_Keys );
+   procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag );
+ 
+   procedure Create( The_Vehicle : in out Object; Tyres : in States );
+   procedure Rotate( The_Vehicle : in out Object );
+   function  Wheels( The_Vehicle : Object ) return Positive;
+ 
+ end C390003_1; -- Vehicle;
+ 
+ ----------------------------------------------------------------- C390003_2
+ 
+ with C390003_1;
+ package C390003_2 is -- Motivators
+ 
+   package Vehicle renames C390003_1;
+   subtype Bicycle is Vehicle.Object(2);  -- constrained subtype
+ 
+   type Motorcycle is new Bicycle with record
+     Displacement : Natural;
+   end record;
+   procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys );
+ 
+   type Tandem is new Bicycle with null record;
+   procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys );
+ 
+   type Car is new Vehicle.Object(4) with  -- extended, constrained
+     record
+       Displacement : Natural;
+     end record;
+   procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys );
+ 
+   type Truck is new Vehicle.Object with  -- extended, unconstrained
+     record
+       Tare : Natural;
+     end record;
+   procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys );
+ 
+ end C390003_2; -- Motivators;
+ 
+ ----------------------------------------------------------------- C390003_3
+ 
+ with C390003_1;
+ with C390003_2;
+ package C390003_3 is -- Special_Trucks
+   package Vehicle    renames C390003_1;
+   package Motivators renames C390003_2;
+   Max_Cars_On_Vehicle : constant := 6;
+   type Cargo_Index is range 0..Max_Cars_On_Vehicle;
+   type Cargo is array(Cargo_Index range 1..Max_Cars_On_Vehicle)
+                 of Motivators.Car;
+   type Auto_Carrier is new Motivators.Truck(18) with
+     record
+       Load_Count : Cargo_Index := 0;
+       Payload    : Cargo;
+     end record;
+   procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys );
+   procedure Load  ( The_Car : in     Motivators.Car;
+                     Onto    : in out Auto_Carrier);
+   procedure Unload( The_Car :    out Motivators.Car;
+                     Off_of   : in out Auto_Carrier);
+ end C390003_3;
+ 
+ ----------------------------------------------------------------- C390003_4
+ 
+ with C390003_1;
+ with C390003_2;
+ package C390003_4 is -- James_Bond
+ 
+   package Vehicle   renames C390003_1;
+   package Motivators renames C390003_2;
+ 
+   type Q_Machine is new Vehicle.Object(4) with record
+     Car_Part  : Motivators.Car;
+     Bike_Part : Motivators.Motorcycle;
+   end record;
+   procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys );
+ 
+ end C390003_4;
+ 
+ ----------------------------------------------------------------- C390003_1
+ 
+ with Report;
+ with Ada.Tags;
+ package body C390003_1 is -- Vehicle
+ 
+   function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
+ 
+   procedure TC_Validate( It: Object; Key: TC_Keys ) is
+   begin
+     if Key /= Veh then
+       Report.Failed("Expected Veh Key");
+     end if;
+   end TC_Validate;
+ 
+   procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag ) is
+   begin
+     if It'Tag /= The_Tag then
+       Report.Failed("Unexpected Tag for classwide formal");
+     end if;
+   end TC_Validate;
+ 
+   procedure Create( The_Vehicle : in out Object; Tyres : in States ) is
+   begin
+     The_Vehicle.Wheel_State := ( others => Tyres );
+   end Create;
+ 
+   function  Wheels( The_Vehicle : Object ) return Positive is
+   begin
+     return The_Vehicle.Wheels;
+   end Wheels;
+ 
+   procedure Rotate( The_Vehicle : in out Object ) is
+     Push : States;
+     Pulled : States
+          := The_Vehicle.Wheel_State(The_Vehicle.Wheel_State'Last);
+   begin
+     for Finger in
+         The_Vehicle.Wheel_State'First..The_Vehicle.Wheel_State'Last loop
+       Push := The_Vehicle.Wheel_State(Finger);
+       The_Vehicle.Wheel_State(Finger) := Pulled;
+       Pulled := Push;
+     end loop;
+   end Rotate;
+ 
+ end C390003_1; -- Vehicle;
+ 
+ ----------------------------------------------------------------- C390003_2
+ 
+ with Ada.Tags;
+ with Report;
+ package body C390003_2 is -- Motivators
+ 
+   function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+   function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+ 
+   procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys ) is
+   begin
+     if Key /= Vehicle.MC then
+       Report.Failed("Expected MC Key");
+     end if;
+   end TC_Validate;
+ 
+   procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys ) is
+   begin
+     if Key /= Vehicle.Tand then
+       Report.Failed("Expected Tand Key");
+     end if;
+   end TC_Validate;
+ 
+   procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys ) is
+   begin
+     if Key /= Vehicle.Car then
+       Report.Failed("Expected Car Key");
+     end if;
+   end TC_Validate;
+ 
+   procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys ) is
+   begin
+     if Key /= Vehicle.Truk then
+       Report.Failed("Expected Truk Key");
+     end if;
+   end TC_Validate;
+ end C390003_2; -- Motivators;
+ 
+ ----------------------------------------------------------------- C390003_3
+ 
+ with Ada.Tags;
+ with Report;
+ package body C390003_3 is -- Special_Trucks
+ 
+   function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+   function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+ 
+   procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys ) is
+   begin
+     if Key /= Vehicle.Heavy then
+       Report.Failed("Expected Heavy Key");
+     end if;
+   end TC_Validate;
+ 
+   procedure Load  ( The_Car : in     Motivators.Car;
+                     Onto    : in out Auto_Carrier) is
+   begin
+     Onto.Load_Count := Onto.Load_Count +1;
+     Onto.Payload(Onto.Load_Count) := The_Car;
+   end Load;
+   procedure Unload( The_Car :    out Motivators.Car;
+                     Off_of   : in out Auto_Carrier) is
+   begin
+     The_Car := Off_of.Payload(Off_of.Load_Count);
+     Off_of.Load_Count := Off_of.Load_Count -1;
+   end Unload;
+ 
+ end C390003_3;
+ 
+ ----------------------------------------------------------------- C390003_4
+ 
+ with Report, Ada.Tags;
+ package body C390003_4 is -- James_Bond
+ 
+   function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+   function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+ 
+   procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys ) is
+   begin
+     if Key /= Vehicle.Q then
+       Report.Failed("Expected Q Key");
+     end if;
+   end TC_Validate;
+ 
+ end C390003_4;
+ 
+ ------------------------------------------------------------------- C390003
+ 
+ with Report;
+ with C390003_1;
+ with C390003_2;
+ with C390003_3;
+ with C390003_4;
+ procedure C390003 is
+ 
+   package Vehicle        renames C390003_1;  use Vehicle;
+   package Motivators     renames C390003_2;
+   package Special_Trucks renames C390003_3;
+   package James_Bond     renames C390003_4;
+ 
+   -- The cast, in order of complexity:
+ 
+   Pennys_Bike : Motivators.Bicycle;
+   Weekender   : Motivators.Tandem;
+   Qs_Moped    : Motivators.Motorcycle;
+   Ms_Limo     : Motivators.Car;
+   Yard_Van    : Motivators.Truck(8);
+   Specter_X   : Special_Trucks.Auto_Carrier;
+   Gen_II      : James_Bond.Q_Machine;
+ 
+ 
+   -- Check compatibility with the corresponding class wide type.
+ 
+   procedure Vehicle_Shop( It  : in out Vehicle.Object'Class;
+                           Key : in     Vehicle.TC_Keys ) is
+ 
+     -- Check that Subtype'Class is defined for tagged subtypes.
+     procedure Bike_Shop( Bike: in out Motivators.Bicycle'Class ) is
+     begin
+         -- Dispatch to appropriate TC_Validate
+       Vehicle.TC_Validate( Bike, Key );
+     end Bike_Shop;
+ 
+   begin
+     Vehicle.TC_Validate( It, Key );
+     if Vehicle.Wheels( It ) = 2 then
+       Bike_Shop( It );  -- only call Bike_Shop when It has 2 wheels
+     end if;
+   end Vehicle_Shop;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C390003", "Check that for a subtype S of a tagged type " &
+                "T, S'Class denotes a class-wide subtype.  Check that " &
+                "T'Tag denotes the tag of the type T, and that, for a " &
+                "class-wide tagged type X, X'Tag denotes the tag of X.  " &
+                "Check that the tags of stand alone objects, record and " &
+                "array components, aggregates, and formal parameters " &
+                "identify their type. Check that the tag of a value of a " &
+                "formal parameter is that of the actual parameter, even " &
+                "if the actual is passed by a view conversion" );
+ 
+ --     Check that the tags of stand alone objects, record and array
+ --     components, aggregates, and formal parameters identify their type.
+ --     Check that the tag of a value of a formal parameter is that of the
+ --     actual parameter, even if the actual is passed by a view conversion.
+ 
+   Vehicle_Shop( Pennys_Bike,          Veh );
+   Vehicle_Shop( Weekender,            Tand );
+   Vehicle_Shop( Qs_Moped,             MC );
+   Vehicle_Shop( Ms_Limo,              Car );
+   Vehicle_Shop( Yard_Van,             Truk );
+   Vehicle_Shop( Specter_X,            Heavy );
+   Vehicle_Shop( Specter_X.Payload(1), Car );
+   Vehicle_Shop( Gen_II,               Q );
+   Vehicle_Shop( Gen_II.Car_Part,      Car );
+   Vehicle_Shop( Gen_II.Bike_Part,     MC );
+ 
+   Vehicle.TC_Validate( Pennys_Bike, Vehicle.Object'Tag );
+   Vehicle.TC_Validate( Weekender,   Motivators.Tandem'Tag );
+   Vehicle.TC_Validate( Qs_Moped,    Motivators.Motorcycle'Tag );
+   Vehicle.TC_Validate( Ms_Limo,     Motivators.Car'Tag );
+   Vehicle.TC_Validate( Yard_Van,    Motivators.Truck'Tag );
+   Vehicle.TC_Validate( Specter_X,   Special_Trucks.Auto_Carrier'Tag );
+   Vehicle.TC_Validate( Specter_X.Payload(1), Motivators.Car'Tag );
+   Vehicle.TC_Validate( Gen_II,              James_Bond.Q_Machine'Tag );
+   Vehicle.TC_Validate( Gen_II.Car_Part,     Motivators.Car'Tag );
+   Vehicle.TC_Validate( Gen_II.Bike_Part,    Motivators.Motorcycle'Tag );
+ 
+ -- Check the tag generated for an aggregate.
+ 
+   Rentals: declare
+     Mikes_Rental : Vehicle.Object'Class :=
+                      Vehicle.Object'( 3, (Good, Flat, Worn));
+     Diannes_Car  : Vehicle.Object'Class :=
+                       Motivators.Tandem'( Wheels      => 2, 
+                                           Wheel_State => (Good, Good) );
+     Jims_Bike    : Vehicle.Object'Class :=
+                       Motivators.Motorcycle'( Pennys_Bike
+                                               with Displacement => 350 );
+     Bills_Limo   : Vehicle.Object'Class :=
+                       Motivators.Car'( Wheels       => 4,
+                                        Wheel_State  => (others => Good),
+                                        Displacement => 282 );
+     Alans_Car    : Vehicle.Object'Class :=
+                       Motivators.Truck'( 18, (others => Worn),
+                                          Tare => 5_500 );
+     Pats_Truck   : Vehicle.Object'Class := Specter_X;
+     Keiths_Car   : Vehicle.Object'Class := Gen_II;
+     Isaacs_Bus   : Vehicle.Object'Class := Keiths_Car;
+ 
+   begin
+     Vehicle.TC_Validate( Mikes_Rental, Vehicle.Object'Tag );
+     Vehicle.TC_Validate( Diannes_Car,  Motivators.Tandem'Tag );
+     Vehicle.TC_Validate( Jims_Bike,    Motivators.Motorcycle'Tag );
+     Vehicle.TC_Validate( Bills_Limo,   Motivators.Car'Tag );
+     Vehicle.TC_Validate( Alans_Car,    Motivators.Truck'Tag );
+     Vehicle.TC_Validate( Pats_Truck,   Special_Trucks.Auto_Carrier'Tag );
+     Vehicle.TC_Validate( Keiths_Car,   James_Bond.Q_Machine'Tag );
+   end Rentals;
+ 
+ -- Check the tag of parameters.
+ -- Check that the tag is not affected by view conversion.
+ 
+   Vehicle.TC_Validate( Vehicle.Object( Gen_II  ), James_Bond.Q_Machine'Tag );
+   Vehicle.TC_Validate( Vehicle.Object( Ms_Limo ), Motivators.Car'Tag );
+   Vehicle.TC_Validate( Motivators.Bicycle( Weekender ),
+                        Motivators.Tandem'Tag );
+   Vehicle.TC_Validate( Motivators.Bicycle( Gen_II.Bike_Part ),
+                        Motivators.Motorcycle'Tag );
+ 
+   Report.Result;
+ 
+ end C390003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,404 ----
+ -- C390004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that the tags of allocated objects correctly identify the
+ --     type of the allocated object.  Check that the tag corresponds
+ --     correctly to the value resulting from both normal and view
+ --     conversion.  Check that the tags of accessed values designating
+ --     aliased objects correctly identify the type of the object.  Check
+ --     that the tag of a function result correctly evaluates.  Check this
+ --     for class-wide functions.  The tag of a class-wide function result
+ --     should be the tag appropriate to the actual value returned, not the
+ --     tag of the ancestor type.
+ --
+ -- TEST DESCRIPTION:
+ --     This test defines a class hierarchy of types, with reference
+ --     semantics (an access type to the class-wide type).  Similar in
+ --     structure to C392005, this test checks that dynamic allocation does
+ --     not adversely impact the tagging of types.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C390004_1 is -- DMV
+   type Equipment is ( T_Veh, T_Car, T_Con, T_Jep );
+ 
+   type Vehicle is tagged record
+     Wheels : Natural := 4;
+     Parked : Boolean := False;
+   end record;
+ 
+   function  Wheels    ( It: Vehicle ) return Natural;
+   procedure Park      ( It: in out Vehicle );
+   procedure UnPark    ( It: in out Vehicle );
+   procedure Set_Wheels( It: in out Vehicle; To_Count: in Natural );
+   procedure TC_Check  ( It: in Vehicle; To_Equip: in Equipment );
+ 
+   type Car is new Vehicle with record
+     Passengers : Natural := 0;
+   end record;
+ 
+   function  Passengers     ( It: Car ) return Natural;
+   procedure Load_Passengers( It: in out Car; To_Count: in Natural );
+   procedure Park           ( It: in out Car );
+   procedure TC_Check       ( It: in Car; To_Equip: in Equipment );
+ 
+   type Convertible is new Car with record
+     Top_Up : Boolean := True;
+   end record;
+ 
+   function  Top_Up   ( It: Convertible ) return Boolean;
+   procedure Lower_Top( It: in out Convertible );
+   procedure Park     ( It: in out Convertible );
+   procedure Raise_Top( It: in out Convertible );
+   procedure TC_Check ( It: in Convertible; To_Equip: in Equipment );
+ 
+   type Jeep is new Convertible with record
+     Windshield_Up : Boolean := True;
+   end record;
+ 
+   function  Windshield_Up   ( It: Jeep ) return Boolean;
+   procedure Lower_Windshield( It: in out Jeep );
+   procedure Park            ( It: in out Jeep );
+   procedure Raise_Windshield( It: in out Jeep );
+   procedure TC_Check        ( It: in Jeep; To_Equip: in Equipment );
+ 
+ end C390004_1;
+ 
+ with Report;
+ package body C390004_1 is
+ 
+   procedure Set_Wheels( It: in out Vehicle; To_Count: in Natural ) is
+   begin
+     It.Wheels := To_Count;
+   end Set_Wheels;
+ 
+   function  Wheels( It: Vehicle ) return Natural is
+   begin
+     return It.Wheels;
+   end Wheels;
+ 
+   procedure Park      ( It: in out Vehicle ) is
+   begin
+     It.Parked := True;
+   end Park;
+ 
+   procedure UnPark    ( It: in out Vehicle ) is
+   begin
+     It.Parked := False;
+   end UnPark;
+ 
+   procedure TC_Check  ( It: in Vehicle; To_Equip: in Equipment ) is
+   begin
+     if To_Equip /= T_Veh then
+       Report.Failed ("Failed, called Vehicle for "
+                      & Equipment'Image(To_Equip));      
+     end if;
+   end TC_Check;
+ 
+   procedure TC_Check  ( It: in Car; To_Equip: in Equipment ) is
+   begin
+     if To_Equip /= T_Car then
+       Report.Failed ("Failed, called Car for "
+                      & Equipment'Image(To_Equip));      
+     end if;
+   end TC_Check;
+ 
+   procedure TC_Check  ( It: in Convertible; To_Equip: in Equipment ) is
+   begin
+     if To_Equip /= T_Con then
+       Report.Failed ("Failed, called Convertible for "
+                      & Equipment'Image(To_Equip));      
+     end if;
+   end TC_Check;
+ 
+   procedure TC_Check  ( It: in Jeep; To_Equip: in Equipment ) is
+   begin
+     if To_Equip /= T_Jep then
+       Report.Failed ("Failed, called Jeep for "
+                      & Equipment'Image(To_Equip));      
+     end if;
+   end TC_Check;
+ 
+   procedure Load_Passengers( It: in out Car; To_Count: in Natural ) is
+   begin
+     It.Passengers := To_Count;
+     UnPark( It );
+   end Load_Passengers;
+ 
+   procedure Park( It: in out Car ) is
+   begin
+     It.Passengers := 0;
+     Park( Vehicle( It ) );
+   end Park;
+ 
+   function  Passengers( It: Car ) return Natural is
+   begin
+     return It.Passengers;
+   end Passengers;
+ 
+   procedure Raise_Top( It: in out Convertible ) is
+   begin
+     It.Top_Up := True;
+   end Raise_Top;
+ 
+   procedure Lower_Top( It: in out Convertible ) is
+   begin
+     It.Top_Up := False;
+   end Lower_Top;
+ 
+   function  Top_Up   ( It: Convertible ) return Boolean is
+   begin
+     return It.Top_Up;
+   end Top_Up;
+ 
+   procedure Park     ( It: in out Convertible ) is
+   begin
+     It.Top_Up := True;
+     Park( Car( It ) );
+   end Park;
+ 
+   procedure Raise_Windshield( It: in out Jeep ) is
+   begin
+     It.Windshield_Up := True;
+   end Raise_Windshield;
+ 
+   procedure Lower_Windshield( It: in out Jeep ) is
+   begin
+     It.Windshield_Up := False;
+   end Lower_Windshield;
+ 
+   function  Windshield_Up( It: Jeep ) return Boolean is
+   begin
+     return It.Windshield_Up;
+   end Windshield_Up;
+ 
+   procedure Park( It: in out Jeep ) is
+   begin
+     It.Windshield_Up := True;
+     Park( Convertible( It ) );
+   end Park;
+ end C390004_1;
+ 
+ with Report;
+ with Ada.Tags;
+ with C390004_1;
+ procedure C390004 is
+   package DMV renames C390004_1;
+ 
+   The_Vehicle     : aliased DMV.Vehicle;
+   The_Car         : aliased DMV.Car;
+   The_Convertible : aliased DMV.Convertible;
+   The_Jeep        : aliased DMV.Jeep;
+ 
+   type C_Reference is access all DMV.Car'Class;
+   type V_Reference is access all DMV.Vehicle'Class;
+ 
+   Designator : V_Reference;
+   Storage    : Natural;
+ 
+   procedure Valet( It: in out DMV.Vehicle'Class ) is
+   begin
+     DMV.Park( It );
+   end Valet;
+ 
+   procedure TC_Match( Object: DMV.Vehicle'Class;
+                       Taglet: Ada.Tags.Tag;
+                       Where : String ) is
+     use Ada.Tags;
+   begin
+     if Object'Tag /= Taglet then
+       Report.Failed("Tag mismatch: " & Where);
+     end if;
+   end TC_Match;
+ 
+   procedure Parking_Validation( It: DMV.Vehicle; TC_Message: String ) is
+   begin
+     if DMV.Wheels( It ) /= 1  or not It.Parked then
+       Report.Failed ("Failed Vehicle " & TC_Message);
+     end if;
+   end Parking_Validation;
+ 
+   procedure Parking_Validation( It: DMV.Car; TC_Message: String ) is
+   begin
+     if DMV.Wheels( It ) /= 2 or DMV.Passengers( It ) /= 0
+        or not It.Parked then
+       Report.Failed ("Failed Car " & TC_Message);
+     end if;
+   end Parking_Validation;
+ 
+   procedure Parking_Validation( It: DMV.Convertible;
+                                 TC_Message: String ) is
+   begin
+     if DMV.Wheels( It ) /= 3 or DMV.Passengers( It ) /= 0
+        or not DMV.Top_Up( It ) or not It.Parked then
+       Report.Failed ("Failed Convertible " & TC_Message);
+     end if;
+   end Parking_Validation;
+ 
+   procedure Parking_Validation( It: DMV.Jeep; TC_Message: String ) is
+   begin
+     if DMV.Wheels( It ) /= 4 or DMV.Passengers( It ) /= 0
+        or not DMV.Top_Up( It ) or not DMV.Windshield_Up( It )
+        or not It.Parked then
+       Report.Failed ("Failed Jeep " & TC_Message);
+     end if;
+   end Parking_Validation;
+ 
+   function Wash( It: V_Reference; TC_Expect : Ada.Tags.Tag )
+                                     return DMV.Vehicle'Class is
+     This_Machine : DMV.Vehicle'Class := It.all;
+   begin
+     TC_Match( It.all, TC_Expect, "Class-wide object in Wash" );
+     Storage := DMV.Wheels( This_Machine );
+     return This_Machine;
+   end Wash;
+ 
+   function Wash( It: C_Reference; TC_Expect : Ada.Tags.Tag )
+                                     return DMV.Car'Class is
+     This_Machine : DMV.Car'Class := It.all;
+   begin
+     TC_Match( It.all, TC_Expect, "Class-wide object in Wash" );
+     Storage := DMV.Wheels( This_Machine );
+     return This_Machine;
+   end Wash;
+ 
+ begin
+ 
+   Report.Test( "C390004", "Check that the tags of allocated objects "
+                         & "correctly identify the type of the allocated "
+                         & "object.  Check that tags resulting from "
+                         & "normal and view conversions.  Check tags of "
+                         & "accessed values designating aliased objects. "
+                         & "Check function result tags" );
+ 
+   DMV.Set_Wheels( The_Vehicle, 1 );
+   DMV.Set_Wheels( The_Car, 2 );
+   DMV.Set_Wheels( The_Convertible, 3 );
+   DMV.Set_Wheels( The_Jeep, 4 );
+ 
+   Valet( The_Vehicle );
+   Valet( The_Car );
+   Valet( The_Convertible );
+   Valet( The_Jeep );
+ 
+   Parking_Validation( The_Vehicle,     "setup" );
+   Parking_Validation( The_Car,         "setup" );
+   Parking_Validation( The_Convertible, "setup" );
+   Parking_Validation( The_Jeep,        "setup" );
+ 
+ -- Check that the tags of allocated objects correctly identify the type
+ -- of the allocated object.
+ 
+   Designator := new DMV.Vehicle;
+   DMV.TC_Check( Designator.all, DMV.T_Veh );
+   TC_Match( Designator.all, DMV.Vehicle'Tag, "allocated Vehicle" );
+ 
+   Designator := new DMV.Car;
+   DMV.TC_Check( Designator.all, DMV.T_Car );
+   TC_Match( Designator.all, DMV.Car'Tag, "allocated Car");
+ 
+   Designator := new DMV.Convertible;
+   DMV.TC_Check( Designator.all, DMV.T_Con );
+   TC_Match( Designator.all, DMV.Convertible'Tag, "allocated Convertible" );
+ 
+   Designator := new DMV.Jeep;
+   DMV.TC_Check( Designator.all, DMV.T_Jep );
+   TC_Match( Designator.all, DMV.Jeep'Tag, "allocated Jeep" );
+ 
+ -- Check that view conversion causes the correct dispatch
+   DMV.TC_Check( DMV.Vehicle( The_Jeep ),     DMV.T_Veh );
+   DMV.TC_Check( DMV.Car( The_Jeep ),         DMV.T_Car );
+   DMV.TC_Check( DMV.Convertible( The_Jeep ), DMV.T_Con );
+ 
+ -- And that view conversion does not change the tag
+   TC_Match( DMV.Vehicle( The_Jeep ),     DMV.Jeep'Tag, "View Conv Veh" );
+   TC_Match( DMV.Car( The_Jeep ),         DMV.Jeep'Tag, "View Conv Car" );
+   TC_Match( DMV.Convertible( The_Jeep ), DMV.Jeep'Tag, "View Conv Jep" );
+ 
+ -- Check that the tags of accessed values designating aliased objects
+ -- correctly identify the type of the object.
+   Designator := The_Vehicle'Access;
+   DMV.TC_Check( Designator.all, DMV.T_Veh );
+   TC_Match( Designator.all, DMV.Vehicle'Tag, "aliased Vehicle" );
+ 
+   Designator := The_Car'Access;
+   DMV.TC_Check( Designator.all, DMV.T_Car );
+   TC_Match( Designator.all, DMV.Car'Tag, "aliased Car" );
+ 
+   Designator := The_Convertible'Access;
+   DMV.TC_Check( Designator.all, DMV.T_Con );
+   TC_Match( Designator.all, DMV.Convertible'Tag, "aliased Convertible" );
+ 
+   Designator := The_Jeep'Access;
+   DMV.TC_Check( Designator.all, DMV.T_Jep );
+   TC_Match( Designator.all, DMV.Jeep'Tag, "aliased Jeep" );
+ 
+ -- Check that the tag of a function result correctly evaluates.
+ -- Check this for class-wide functions.  The tag of a class-wide
+ -- function result should be the tag appropriate to the actual value
+ -- returned, not the tag of the ancestor type.
+   Function_Check: declare
+     A_Vehicle     : V_Reference := new DMV.Vehicle'( The_Vehicle );
+     A_Car         : C_Reference := new DMV.Car'( The_Car );
+     A_Convertible : C_Reference := new DMV.Convertible'( The_Convertible );
+     A_Jeep        : C_Reference := new DMV.Jeep'( The_Jeep );
+   begin
+     DMV.Unpark( A_Vehicle.all );
+     DMV.Load_Passengers( A_Car.all, 5 );
+     DMV.Load_Passengers( A_Convertible.all, 6 );
+     DMV.Load_Passengers( A_Jeep.all, 7 );
+     DMV.Lower_Top( DMV.Convertible(A_Convertible.all) );
+     DMV.Lower_Top( DMV.Jeep(A_Jeep.all) );
+     DMV.Lower_Windshield( DMV.Jeep(A_Jeep.all) );
+ 
+     if DMV.Wheels( Wash( A_Jeep, DMV.Jeep'Tag ) ) /= 4
+        or Storage /= 4 then
+       Report.Failed("Did not correctly wash Jeep");
+     end if;
+ 
+     if DMV.Wheels( Wash( A_Convertible, DMV.Convertible'Tag ) ) /= 3
+        or Storage /= 3 then
+       Report.Failed("Did not correctly wash Convertible");
+     end if;
+ 
+     if DMV.Wheels( Wash( A_Car, DMV.Car'Tag ) ) /= 2
+        or Storage /= 2 then
+       Report.Failed("Did not correctly wash Car");
+     end if;
+ 
+     if DMV.Wheels( Wash( A_Vehicle, DMV.Vehicle'Tag ) ) /= 1
+        or Storage /= 1 then
+       Report.Failed("Did not correctly wash Vehicle");
+     end if; 
+ 
+   end Function_Check;
+ 
+   Report.Result;
+ end C390004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900050.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900050.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900050.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900050.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,157 ----
+ -- C3900050.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C3900053.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C3900053.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --      => C3900050.A
+ --         C3900051.A
+ --         C3900052.A
+ --         C3900053.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+ --                          for Ada.Calendar.
+ --
+ --!
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package C3900050 is  -- Alert system abstraction.
+ 
+    -- Declarations used by component Arrival_Time.
+ 
+    Default_Time : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1901, 1, 1);
+    Alert_Time   : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1991, 6, 15);
+ 
+ 
+    -- Declarations used by component Display_On and procedure Display.
+ 
+    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
+    type Display_Counters is array (Device_Enum) of Natural;
+ 
+    Display_Count_For : Display_Counters := (others => 0);
+ 
+ 
+ 
+    type Alert_Type is tagged private;                 -- Root tagged type.
+ 
+    procedure Set_Display (A : in out Alert_Type;      -- To be inherited by
+                           D : in     Device_Enum);    -- all derivatives.
+ 
+    procedure Display (A : in Alert_Type);             -- To be inherited by
+                                                       -- all derivatives.
+ 
+    procedure Handle (A : in out Alert_Type);          -- To be overridden by
+                                                       -- all derivatives.
+ 
+ 
+    -- The following functions are needed to verify the values of the
+    -- root tagged type's private components.
+ 
+    function Get_Time (A: Alert_Type) return Ada.Calendar.Time;
+ 
+    function Get_Display (A: Alert_Type) return Device_Enum;
+ 
+    function Initial_Values_Okay (A : in Alert_Type)
+      return Boolean;
+ 
+    function Bad_Final_Values (A : in Alert_Type)
+      return Boolean;
+ 
+ private
+ 
+    type Alert_Type is tagged record                    -- Root tagged type.
+       Arrival_Time : Ada.Calendar.Time := Default_Time;
+       Display_On   : Device_Enum   := Null_Device;
+    end record;
+ 
+ 
+ end C3900050;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C3900050 is  -- Alert system abstraction.
+ 
+ 
+    procedure Set_Display (A : in out Alert_Type;
+                           D : in     Device_Enum) is
+    begin
+       A.Display_On := D;
+    end Set_Display;
+ 
+ 
+    procedure Display (A : in Alert_Type) is
+    begin
+       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
+    end Display;
+ 
+ 
+    procedure Handle (A : in out Alert_Type) is
+    begin
+       A.Arrival_Time := Alert_Time;
+       Display (A);
+    end Handle;
+ 
+ 
+    function Get_Time (A: Alert_Type) return Ada.Calendar.Time is
+    begin
+       return A.Arrival_Time;
+    end Get_Time;
+ 
+ 
+    function Get_Display (A: Alert_Type) return Device_Enum is
+    begin
+       return A.Display_On;
+    end Get_Display;
+ 
+ 
+    function Initial_Values_Okay (A : in Alert_Type) return Boolean is
+    begin
+       return (A = (Arrival_Time => Default_Time,         -- Check "=" operator
+                    Display_On   => Null_Device));        -- availability.
+    end Initial_Values_Okay;                              -- Aggregate with
+                                                          -- named associations.
+ 
+    function Bad_Final_Values (A : in Alert_Type) return Boolean is
+    begin
+       return (A /= (Alert_Time, Null_Device));           -- Check "/=" operator
+                                                          -- availability.
+    end Bad_Final_Values;                                 -- Aggregate with
+                                                          -- positional assoc.
+ 
+ end C3900050;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900051.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900051.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900051.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900051.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,137 ----
+ -- C3900051.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C3900053.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C3900053.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         C3900050.A
+ --      => C3900051.A
+ --         C3900052.A
+ --         C3900053.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+ --                          for Ada.Calendar.
+ --
+ --!
+ 
+ with C3900050;       -- Alert system abstraction.
+ package C3900051 is  -- Extended alert system abstraction.
+ 
+ 
+    type Low_Alert_Type is new C3900050.Alert_Type
+      with private;                                      -- Private extension of
+                                                         -- root tagged type.
+ 
+    -- Inherits procedure Display from Alert_Type.
+ 
+    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                         -- primitive subprog.
+ 
+    procedure Set_Level (LA : in out Low_Alert_Type;     -- To be inherited by
+                         L  : in     Integer);           -- all derivatives.
+ 
+ 
+    -- The following functions are needed to verify the values of the
+    -- extension's private components.
+ 
+    function Get_Level (LA: Low_Alert_Type) return Integer;
+ 
+    function Initial_Values_Okay (LA : in Low_Alert_Type)
+      return Boolean;                                    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    function Bad_Final_Values (LA : in Low_Alert_Type)   -- Override parent's
+      return Boolean;                                    -- primitive subprog.
+ 
+ 
+ private
+ 
+    type Low_Alert_Type is new C3900050.Alert_Type with record
+       Level : Integer := 0;
+    end record;
+ 
+ end C3900051;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package body C3900051 is  -- Extended alert system abstraction.
+ 
+    use C3900050;  -- Alert system abstraction.
+ 
+ 
+    procedure Set_Level (LA : in out Low_Alert_Type;
+                         L  : in     Integer) is
+    begin
+       LA.Level := L;
+    end Set_Level;
+ 
+ 
+    procedure Handle (LA : in out Low_Alert_Type) is
+    begin
+       Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
+       Set_Level (LA, 1);          -- Call newly declared operation.
+       Set_Display (Alert_Type(LA),
+                    Teletype);     -- Call parent's operation (type conversion).
+       Display (LA);              
+    end Handle;
+ 
+ 
+    function Get_Level (LA: Low_Alert_Type) return Integer is
+    begin
+       return LA.Level;
+    end Get_Level;
+ 
+ 
+    function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
+    begin
+       -- Call parent's operation (type conversion).
+       return (Initial_Values_Okay (Alert_Type (LA)) and
+               LA.Level = 0);
+    end Initial_Values_Okay;
+ 
+ 
+    function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
+       use type Ada.Calendar.Time;
+    begin
+       return (Get_Time(LA)    /= Alert_Time or
+               Get_Display(LA) /= Teletype or
+               LA.Level        /= 1);
+    end Bad_Final_Values;
+ 
+ 
+ end C3900051;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900052.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900052.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900052.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900052.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- C3900052.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C3900053.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C3900053.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         C3900050.A
+ --         C3900051.A
+ --      => C3900052.A
+ --         C3900053.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+ --                          for Ada.Calendar.
+ --
+ --!
+ 
+ with C3900051;       -- Extended alert system abstraction.
+ package C3900052 is  -- Further extended alert system abstraction.
+ 
+ 
+    -- Declarations used by component Action_Officer;
+ 
+    type Person_Enum is (Nobody,          Duty_Officer,
+                         Watch_Commander, Commanding_Officer);
+ 
+ 
+    type Medium_Alert_Type is new C3900051.Low_Alert_Type
+      with private;                                      -- Private extension of
+                                                         -- private extension.
+ 
+    -- Inherits (inherited) procedure Display from Low_Alert_Type.
+    -- Inherits function Level_Of from Low_Alert_Type.
+ 
+    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum);
+ 
+ 
+    -- The following functions are needed to verify the values of the
+    -- extension's private components.
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type)
+      return Boolean;                                    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    function Bad_Final_Values (MA: in Medium_Alert_Type) -- Override parent's
+      return Boolean;                                    -- primitive subprog.
+ 
+ private
+ 
+    type Medium_Alert_Type is new C3900051.Low_Alert_Type with record
+       Action_Officer : Person_Enum := Nobody;
+    end record;
+ 
+ end C3900052;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C3900050;            -- Basic alert abstraction.
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package body C3900052 is  -- Further extended alert system abstraction.
+ 
+    use C3900050;  -- Enumeration values directly visible.
+    use C3900051;  -- Extended alert system abstraction.
+ 
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum) is
+    begin
+       MA.Action_Officer := To;
+    end Assign_Officer;
+ 
+ 
+    procedure Handle (MA : in out Medium_Alert_Type) is
+    begin
+       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+       Set_Level (MA, 2);                 -- Call inherited operation.
+       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+       Set_Display (MA, Console);         -- Call inherited operation.
+       Display (MA);                      -- Call doubly inherited operation.
+    end Handle;
+ 
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+    begin
+       -- Call parent's operation (type conversion).
+       return (Initial_Values_Okay (Low_Alert_Type (MA)) and
+               MA.Action_Officer = Nobody);
+    end Initial_Values_Okay;
+ 
+ 
+    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+       use type Ada.Calendar.Time;
+    begin
+       return (Get_Time(MA)      /= Alert_Time or
+               Get_Display(MA)   /= Console    or
+               Get_Level(MA)     /= 2          or
+               MA.Action_Officer /= Duty_Officer);
+    end Bad_Final_Values;
+ 
+ 
+ end C3900052;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900053.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900053.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900053.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900053.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C3900053.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a private tagged type declared in a package specification
+ --      may be extended with a private extension in a different package
+ --      specification, and that this private extension may in turn be extended
+ --      by a private extension in a third package.
+ --
+ --      Check that each derivative inherits the user-defined primitive
+ --      subprograms of its parent (including those that its parent inherited),
+ --      that it may override these inherited primitive subprograms, and that it
+ --      may also declare its own primitive subprograms.
+ --
+ --      Check that type conversion is defined from a type extension to its
+ --      parent, and that this parent itself may be a type extension.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged private type and two associated primitive
+ --      subprograms in a package specification. Declare operations to verify
+ --      the correctness of the components. Declare operations which return
+ --      values of the type's private components, and which will be
+ --      inherited by later derivatives.
+ -- 
+ --      Extend the root type with a private extension in a second package
+ --      specification. Declare a new primitive subprogram for the extension,
+ --      and override one of the two inherited subprograms. Within the
+ --      overriding subprogram, utilize type conversion to call the parent's
+ --      implementation of the same subprogram. Also within the overriding
+ --      subprogram, call the new primitive subprogram and each inherited
+ --      subprogram. Declare operations of the private extension which
+ --      override the verification operations of its parent. Declare operations
+ --      of the private extension which return values of the extension's
+ --      private components, and which will be inherited by later derivatives.
+ --      
+ --      Extend the extension with a private extension in a third package
+ --      specification. Declare a new primitive subprogram for this private
+ --      extension, and override one of the three inherited subprograms.
+ --      Within the overriding subprogram, utilize type conversion to call the
+ --      parent's implementation of the same subprogram. Also within the
+ --      overriding subprogram, call the new primitive subprogram and each
+ --      inherited subprogram. Declare operations of the private extension
+ --      which override the verification operations of its parent.
+ -- 
+ --      In the main program, declare objects of the root tagged type and
+ --      the two type extensions. For each object, call the overriding
+ --      subprogram, and verify the correctness of the components by calling
+ --      the verification operations.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         C3900050.A
+ --         C3900051.A
+ --         C3900052.A
+ --      => C3900053.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 May 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ 
+ with C3900050; -- Basic alert abstraction.
+ with C3900051; -- Extended alert abstraction.
+ with C3900052; -- Further extended alert abstraction.
+ 
+ use  C3900050; -- Primitive operations of Alert_Type directly visible.
+ 
+ procedure C3900053 is
+ begin
+ 
+    Report.Test ("C390005", "Primitive operation inheritance by type " &
+                 "extensions: root type is private; all extensions are " &
+                 "private and declared in different packages");
+ 
+ 
+    ALERT_SUBTEST: -------------------------------------------------------------
+ 
+       declare
+          Alarm : C3900050.Alert_Type;     -- Root tagged private type.
+       begin
+          if not Initial_Values_Okay (Alarm) then
+             Report.Failed ("Wrong initial values for Alert_Type");
+          end if;
+ 
+          Handle (Alarm);
+ 
+          if Bad_Final_Values (Alarm) then
+             Report.Failed ("Wrong values for Alert_Type after Handle");
+          end if;
+       end Alert_Subtest;
+ 
+ 
+    -- Check intermediate display counts:
+ 
+    if C3900050.Display_Count_For (Null_Device) /= 1 or
+       C3900050.Display_Count_For (Teletype)    /= 0 or
+       C3900050.Display_Count_For (Console)     /= 0 or
+       C3900050.Display_Count_For (Big_Screen)  /= 0
+    then
+       Report.Failed ("Wrong display counts after Alert_Type");
+    end if;
+ 
+ 
+    LOW_ALERT_SUBTEST: ---------------------------------------------------------
+ 
+       declare
+          Low_Alarm : C3900051.Low_Alert_Type; -- Priv. ext. of tagged type.
+          use C3900051; -- Primitive operations of extension directly visible.
+       begin
+          if not Initial_Values_Okay (Low_Alarm) then
+             Report.Failed ("Wrong initial values for Low_Alert_Type");
+          end if;
+ 
+          Handle (Low_Alarm);
+ 
+          if Bad_Final_Values (Low_Alarm) then
+             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+          end if;
+       end Low_Alert_Subtest;
+ 
+ 
+    -- Check intermediate display counts:
+ 
+    if C3900050.Display_Count_For /= (Null_Device => 2,
+                                      Teletype    => 1,
+                                      Console     => 0,
+                                      Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Low_Alert_Type");
+    end if;
+ 
+ 
+    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+ 
+       declare
+          Medium_Alarm : C3900052.Medium_Alert_Type; -- Priv. ext. of extension.
+          use C3900052; -- Primitive operations of extension directly visible.
+       begin
+          if not Initial_Values_Okay (Medium_Alarm) then
+             Report.Failed ("Wrong initial values for Medium_Alert_Type");
+          end if;
+ 
+          Handle (Medium_Alarm);
+ 
+          if Bad_Final_Values (Medium_Alarm) then
+             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+          end if;
+       end Medium_Alert_Subtest;
+ 
+ 
+    -- Check final display counts:
+ 
+    if C3900050.Display_Count_For /= (Null_Device => 3,
+                                      Teletype    => 2,
+                                      Console     => 1,
+                                      Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Medium_Alert_Type");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C3900053;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900060.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900060.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900060.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900060.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- C3900060.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C3900063.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C3900063.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --      => C3900060.A
+ --         C3900061.A
+ --         C3900062.A
+ --         C3900063.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+ --                          for Ada.Calendar.
+ --
+ --!
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package C3900060 is  -- Alert system abstraction.
+ 
+ 
+    -- Declarations used by component Arrival_Time.
+ 
+    Default_Time : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1901, 1, 1);
+    Alert_Time   : constant Ada.Calendar.Time :=
+                     Ada.Calendar.Time_Of (1991, 6, 15);
+ 
+ 
+    -- Declarations used by component Display_On and procedure Display.
+ 
+    type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
+    type Display_Counters is array (Device_Enum) of Natural;
+ 
+    Display_Count_For : Display_Counters := (others => 0);
+ 
+ 
+ 
+    type Alert_Type is tagged private;                 -- Root tagged type.
+ 
+    procedure Set_Display (A : in out Alert_Type;      -- To be inherited by
+                           D : in     Device_Enum);    -- all derivatives.
+ 
+    procedure Display (A : in Alert_Type);             -- To be inherited by
+                                                       -- all derivatives.
+ 
+    procedure Handle (A : in out Alert_Type);          -- To be overridden by
+                                                       -- all derivatives.
+ 
+ 
+    -- The following functions are needed to verify the values of the
+    -- root tagged type's private components.
+ 
+    function Get_Time (A: Alert_Type) return Ada.Calendar.Time;
+ 
+    function Get_Display (A: Alert_Type) return Device_Enum;
+ 
+    function Initial_Values_Okay (A : in Alert_Type)
+      return Boolean;
+ 
+    function Bad_Final_Values (A : in Alert_Type)
+      return Boolean;
+ 
+ private
+ 
+    type Alert_Type is tagged record                    -- Root tagged type.
+       Arrival_Time : Ada.Calendar.Time := Default_Time;
+       Display_On   : Device_Enum   := Null_Device;
+    end record;
+ 
+ 
+ end C3900060;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C3900060 is
+ 
+ 
+    procedure Set_Display (A : in out Alert_Type;
+                           D : in     Device_Enum) is
+    begin
+       A.Display_On := D;
+    end Set_Display;
+ 
+ 
+    procedure Display (A : in Alert_Type) is
+    begin
+       Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
+    end Display;
+ 
+ 
+    procedure Handle (A : in out Alert_Type) is
+    begin
+       A.Arrival_Time := Alert_Time;
+       Display (A);
+    end Handle;
+ 
+ 
+    function Get_Time (A: Alert_Type) return Ada.Calendar.Time is
+    begin
+       return A.Arrival_Time;
+    end Get_Time;
+ 
+ 
+    function Get_Display (A: Alert_Type) return Device_Enum is
+    begin
+       return A.Display_On;
+    end Get_Display;
+ 
+ 
+    function Initial_Values_Okay (A : in Alert_Type) return Boolean is
+    begin
+       return (A = (Arrival_Time => Default_Time,         -- Check "=" operator
+                    Display_On   => Null_Device));        -- availability.
+    end Initial_Values_Okay;                              -- Aggregate with
+                                                          -- named associations.
+ 
+    function Bad_Final_Values (A : in Alert_Type) return Boolean is
+    begin
+       return (A /= (Alert_Time, Null_Device));           -- Check "/=" operator
+                                                          -- availability.
+    end Bad_Final_Values;                                 -- Aggregate with
+                                                          -- positional assoc.
+ 
+ end C3900060;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900061.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900061.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900061.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900061.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- C3900061.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C3900063.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C3900063.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         C3900060.A
+ --      => C3900061.A
+ --         C3900062.A
+ --         C3900063.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+ --                          for Ada.Calendar.
+ --
+ --!
+ 
+ with C3900060;       -- Alert system abstraction.
+ package C3900061 is  -- Extended alert abstraction.
+ 
+ 
+    type Low_Alert_Type is new C3900060.Alert_Type
+      with private;                                      -- Private extension of
+                                                         -- root tagged type.
+ 
+    -- Inherits procedure Display from Alert_Type.
+ 
+    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                         -- primitive subprog.
+ 
+    procedure Set_Level (LA : in out Low_Alert_Type;     -- To be inherited by
+                         L  : in     Integer);           -- all derivatives.
+ 
+ 
+    -- The following functions are needed to verify the values of the
+    -- extension's private components.
+ 
+    function Get_Level (LA: Low_Alert_Type) return Integer;
+ 
+    function Initial_Values_Okay (LA : in Low_Alert_Type)
+      return Boolean;                                    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    function Bad_Final_Values (LA : in Low_Alert_Type)   -- Override parent's
+      return Boolean;                                    -- primitive subprog.
+ 
+ 
+ private
+ 
+    type Low_Alert_Type is new C3900060.Alert_Type with record
+       Level : Integer := 0;
+    end record;
+ 
+ end C3900061;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package body C3900061 is
+ 
+    use C3900060;  -- Alert system abstraction.
+ 
+ 
+    procedure Set_Level (LA : in out Low_Alert_Type;
+                         L  : in     Integer) is
+    begin
+       LA.Level := L;
+    end Set_Level;
+ 
+ 
+    procedure Handle (LA : in out Low_Alert_Type) is
+    begin
+       Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
+       Set_Level (LA, 1);          -- Call newly declared operation.
+       Set_Display (Alert_Type(LA),
+                    Teletype);     -- Call parent's operation (type conversion).
+       Display (LA);               -- Call inherited operation.
+    end Handle;
+ 
+ 
+    function Get_Level (LA: Low_Alert_Type) return Integer is
+    begin
+       return LA.Level;
+    end Get_Level;
+ 
+ 
+    function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
+    begin
+       -- Call parent's operation (type conversion).
+       return (Initial_Values_Okay (Alert_Type (LA)) and
+               LA.Level = 0);
+    end Initial_Values_Okay;
+ 
+ 
+    function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
+       use type Ada.Calendar.Time;
+    begin
+       return (Get_Time(LA)    /= Alert_Time or
+               Get_Display(LA) /= Teletype or
+               LA.Level        /= 1);
+    end Bad_Final_Values;
+ 
+ 
+ end C3900061;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900062.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900062.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900062.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900062.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,137 ----
+ -- C3900062.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C3900063.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C3900063.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         C3900060.A
+ --         C3900061.A
+ --      => C3900062.A
+ --         C3900063.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+ --                          for Ada.Calendar.
+ --
+ --!
+ 
+ with C3900061;       -- Extended alert system abstraction.
+ package C3900062 is  -- Further extended alert system abstraction.
+ 
+ 
+    -- Declarations used by component Action_Officer;
+ 
+    type Person_Enum is (Nobody,          Duty_Officer,
+                         Watch_Commander, Commanding_Officer);
+ 
+ 
+    type Medium_Alert_Type is new C3900061.Low_Alert_Type
+      with record                                        -- Record extension of
+       Action_Officer : Person_Enum := Nobody;           -- private extension.
+    end record;
+ 
+ 
+    -- Inherits (inherited) procedure Display from Low_Alert_Type.
+    -- Inherits function Level_Of from Low_Alert_Type.
+ 
+    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum);
+ 
+ 
+    -- The following functions are needed to verify the values of the
+    -- extension's private components.
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type)
+      return Boolean;                                    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    function Bad_Final_Values (MA: in Medium_Alert_Type) -- Override parent's
+      return Boolean;                                    -- primitive subprog.
+ 
+ 
+ end C3900062;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C3900060;            -- Basic alert abstraction.
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package body C3900062 is
+ 
+    use C3900060;  -- Enumeration values directly visible.
+    use C3900061;  -- Extended alert system abstraction.
+ 
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum) is
+    begin
+       MA.Action_Officer := To;
+    end Assign_Officer;
+ 
+ 
+    procedure Handle (MA : in out Medium_Alert_Type) is
+    begin
+       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+       Set_Level (MA, 2);                 -- Call inherited operation.
+       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+       Set_Display (MA, Console);         -- Call inherited operation.
+       Display (MA);                      -- Call doubly inherited operation.
+    end Handle;
+ 
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+    begin
+       -- Call parent's operation (type conversion).
+       return (Initial_Values_Okay (Low_Alert_Type (MA)) and
+               MA.Action_Officer = Nobody);
+    end Initial_Values_Okay;
+ 
+ 
+    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+       use type Ada.Calendar.Time;
+    begin
+       return (Get_Time(MA)      /= Alert_Time or
+               Get_Display(MA)   /= Console    or
+               Get_Level(MA)     /= 2          or
+               MA.Action_Officer /= Duty_Officer);
+    end Bad_Final_Values;
+ 
+ 
+ end C3900062;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900063.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900063.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3900063.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3900063.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- C3900063.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a private tagged type declared in a package specification
+ --      may be extended with a private extension in a different package
+ --      specification, and that this private extension may in turn be extended
+ --      by a record extension in a third package.
+ --
+ --      Check that each derivative inherits the user-defined primitive
+ --      subprograms of its parent (including those that its parent inherited),
+ --      that it may override these inherited primitive subprograms, and that it
+ --      may also declare its own primitive subprograms.
+ --
+ --      Check that type conversion is defined from a type extension to its
+ --      parent, and that this parent itself may be a type extension.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged private type and two associated primitive
+ --      subprograms in a package specification. Declare operations to verify
+ --      the correctness of the components. Declare operations which return
+ --      values of the type's private components, and which will be inherited
+ --      by later derivatives.
+ -- 
+ --      Extend the root type with a private extension in a second package
+ --      specification. Declare a new primitive subprogram for the extension,
+ --      and override one of the two inherited subprograms. Within the
+ --      overriding subprogram, utilize type conversion to call the parent's
+ --      implementation of the same subprogram. Also within the overriding
+ --      subprogram, call the new primitive subprogram and each inherited
+ --      subprogram. Declare operations of the private extension which
+ --      override the verification operations of its parent. Declare
+ --      operations which return values of the extension's private components,
+ --      and which will be inherited by later derivatives.
+ --      
+ --      Extend the extension with a record extension in a third package
+ --      specification. Declare a new primitive subprogram for this record
+ --      extension, and override one of the three inherited subprograms.
+ --      Within the overriding subprogram, utilize type conversion to call the
+ --      parent's implementation of the same subprogram. Also within the
+ --      overriding subprogram, call the new primitive subprogram and each
+ --      inherited subprogram. Declare operations of the record extension
+ --      which override the verification operations of its parent.
+ -- 
+ --      In the main program, declare objects of the root tagged type and
+ --      the two type extensions. For each object, call the overriding
+ --      subprogram, and verify the correctness of the components by calling
+ --      the verification operations.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         C3900060.A
+ --         C3900061.A
+ --         C3900062.A
+ --      => C3900063.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ 
+ with C3900060; -- Basic alert abstraction.
+ with C3900062; -- Further extended alert abstraction.
+ 
+ use  C3900060; -- Primitive operations of Alert_Type directly visible.
+ 
+ procedure C3900063 is
+ begin
+ 
+    Report.Test ("C390006", "Primitive operation inheritance by type " &
+                 "extensions: all extensions declared in different " &
+                 "packages; root type and 1st extension are private, " &
+                 "2nd extension is record extension");
+ 
+ 
+    -- The cases for type C3900060.Alert_Type and C3900061.Low_Alert_Type
+    -- are tested in C390005. Those subtests are not repeated here.
+ 
+ 
+    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+ 
+       declare
+          Medium_Alarm : C3900062.Medium_Alert_Type; -- Rec. ext. of extension.
+          use C3900062; -- Primitive operations of extension directly visible.
+       begin
+          if not Initial_Values_Okay (Medium_Alarm) then
+             Report.Failed ("Wrong initial values for Medium_Alert_Type");
+          end if;
+ 
+          Handle (Medium_Alarm);
+ 
+          if Bad_Final_Values (Medium_Alarm) then
+             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+          end if;
+       end Medium_Alert_Subtest;
+ 
+ 
+    -- Check final display counts:
+ 
+    if C3900060.Display_Count_For /= (Null_Device => 1,
+                                      Teletype    => 1,
+                                      Console     => 1,
+                                      Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Medium_Alert_Type");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C3900063;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,374 ----
+ -- C390007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the tag of an object of a tagged type is preserved by
+ --      type conversion and parameter passing.
+ --
+ -- TEST DESCRIPTION:
+ --      The fact that the tag of an object is not changed is verified by
+ --      making dispatching calls to primitive operations, and confirming that
+ --      the proper body is executed. Objects of both specific and class-wide
+ --      types are checked. 
+ --
+ --      The dispatching calls are made in two contexts. The first is a
+ --      straightforward dispatching call made from within a class-wide
+ --      operation. The second is a redispatch from within a primitive
+ --      operation.
+ --
+ --      For the parameter passing case, the initial class-wide and specific
+ --      objects are passed directly in calls to the class-wide and primitive
+ --      operations. The redispatch is accomplished by initializing a local
+ --      class-wide object in the primitive operation to the value of the
+ --      formal parameter, and using the local object as the actual in the
+ --      (re)dispatching call.
+ --
+ --      For the type conversion case, the initial class-wide object is assigned
+ --      a view conversion of an object of a specific type:
+ --
+ --         type T is tagged ...
+ --         type DT is new T with ...
+ --
+ --         A : DT;
+ --         B : T'Class := T(A); -- Despite conversion, tag of B is that of DT.
+ --
+ --      The class-wide object is then passed directly in calls to the
+ --      class-wide and primitive operations. For the initial object of a
+ --      specific type, however, a view conversion of the object is passed,
+ --      forcing a non-dispatching call in the primitive operation case. Within
+ --      the primitive operation, a view conversion of the formal parameter to
+ --      a class-wide type is then used to force a (re)dispatching call.
+ --
+ --      For the type conversion and parameter passing case, a combining of
+ --      view conversion and parameter passing of initial specific objects are 
+ --      called directly to the class-wide and primitive operations. 
+ --
+ --
+ -- CHANGE HISTORY:
+ --      28 Jun 95   SAIC    Initial prerelease version.
+ --      23 Apr 96   SAIC    Added use C390007_0 in the main.
+ --
+ --!
+ 
+ package C390007_0 is
+ 
+    type Call_ID_Kind is (None, Parent_Outer,  Parent_Inner,
+                                Derived_Outer, Derived_Inner);
+ 
+    type Root_Type is abstract tagged null record;
+ 
+    procedure Outer_Proc (X : in out Root_Type) is abstract;
+    procedure Inner_Proc (X : in out Root_Type) is abstract;
+ 
+    procedure ClassWide_Proc (X : in out Root_Type'Class);
+ 
+ end C390007_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390007_0 is
+ 
+    procedure ClassWide_Proc (X : in out Root_Type'Class) is
+    begin
+       Inner_Proc (X);
+    end ClassWide_Proc;
+ 
+ end C390007_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package C390007_0.C390007_1 is
+ 
+    type Param_Parent_Type is new Root_Type with record
+       Last_Call : Call_ID_Kind := None;
+    end record;
+ 
+    procedure Outer_Proc (X : in out Param_Parent_Type);
+    procedure Inner_Proc (X : in out Param_Parent_Type);
+ 
+ end C390007_0.C390007_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390007_0.C390007_1 is
+ 
+    procedure Outer_Proc (X : in out Param_Parent_Type) is
+    begin
+       X.Last_Call := Parent_Outer;
+    end Outer_Proc;
+ 
+    procedure Inner_Proc (X : in out Param_Parent_Type) is
+    begin
+       X.Last_Call := Parent_Inner;
+    end Inner_Proc;
+ 
+ end C390007_0.C390007_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package C390007_0.C390007_1.C390007_2 is
+ 
+    type Param_Derived_Type is new Param_Parent_Type with null record;
+ 
+    procedure Outer_Proc (X : in out Param_Derived_Type);
+    procedure Inner_Proc (X : in out Param_Derived_Type);
+ 
+ end C390007_0.C390007_1.C390007_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390007_0.C390007_1.C390007_2 is
+ 
+    procedure Outer_Proc (X : in out Param_Derived_Type) is
+       Y : Root_Type'Class := X;
+    begin
+       Inner_Proc (Y);  -- Redispatch.
+       Root_Type'Class (X) := Y;
+    end Outer_Proc;
+ 
+    procedure Inner_Proc (X : in out Param_Derived_Type) is
+    begin
+       X.Last_Call := Derived_Inner;
+    end Inner_Proc;
+ 
+ end C390007_0.C390007_1.C390007_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package C390007_0.C390007_3 is
+ 
+    type Convert_Parent_Type is new Root_Type with record
+       First_Call  : Call_ID_Kind := None;
+       Second_Call : Call_ID_Kind := None;
+    end record;
+ 
+    procedure Outer_Proc (X : in out Convert_Parent_Type);
+    procedure Inner_Proc (X : in out Convert_Parent_Type);
+ 
+ end C390007_0.C390007_3;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390007_0.C390007_3 is
+ 
+    procedure Outer_Proc (X : in out Convert_Parent_Type) is
+    begin
+       X.First_Call := Parent_Outer;
+       Inner_Proc (Root_Type'Class(X));  -- Redispatch.
+    end Outer_Proc;
+ 
+    procedure Inner_Proc (X : in out Convert_Parent_Type) is
+    begin
+       X.Second_Call := Parent_Inner;
+    end Inner_Proc;
+ 
+ end C390007_0.C390007_3;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package C390007_0.C390007_3.C390007_4 is
+ 
+    type Convert_Derived_Type is new Convert_Parent_Type with null record;
+ 
+    procedure Outer_Proc (X : in out Convert_Derived_Type);
+    procedure Inner_Proc (X : in out Convert_Derived_Type);
+ 
+ end C390007_0.C390007_3.C390007_4;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390007_0.C390007_3.C390007_4 is
+ 
+    procedure Outer_Proc (X : in out Convert_Derived_Type) is
+    begin
+       X.First_Call := Derived_Outer;
+       Inner_Proc (Root_Type'Class(X));  -- Redispatch.
+    end Outer_Proc;
+ 
+    procedure Inner_Proc (X : in out Convert_Derived_Type) is
+    begin
+       X.Second_Call := Derived_Inner;
+    end Inner_Proc;
+ 
+ end C390007_0.C390007_3.C390007_4;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C390007_0.C390007_1.C390007_2;
+ with C390007_0.C390007_3.C390007_4;
+ use  C390007_0;
+ 
+ with Report;
+ procedure C390007 is
+ begin
+    Report.Test ("C390007", "Check that the tag of an object of a tagged " &
+                 "type is preserved by type conversion and parameter passing");
+ 
+ 
+    --
+    -- Check that tags are preserved by parameter passing:
+    --
+ 
+    Parameter_Passing_Subtest:
+    declare
+       Specific_A  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+       Specific_B  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+ 
+       ClassWide_A : C390007_0.C390007_1.Param_Parent_Type'Class := Specific_A;
+       ClassWide_B : C390007_0.C390007_1.Param_Parent_Type'Class := Specific_B;
+ 
+       use C390007_0.C390007_1;
+       use C390007_0.C390007_1.C390007_2;
+    begin
+ 
+       Outer_Proc (Specific_A);         
+       if Specific_A.Last_Call /= Derived_Inner then
+          Report.Failed ("Parameter passing: tag not preserved in call to " &
+                         "primitive operation with specific operand");
+       end if;
+ 
+       C390007_0.ClassWide_Proc (Specific_B);
+       if Specific_B.Last_Call /= Derived_Inner then
+          Report.Failed ("Parameter passing: tag not preserved in call to " &
+                         "class-wide operation with specific operand");
+       end if;
+ 
+       Outer_Proc (ClassWide_A);        
+       if ClassWide_A.Last_Call /= Derived_Inner then
+          Report.Failed ("Parameter passing: tag not preserved in call to " &
+                         "primitive operation with class-wide operand");
+       end if;
+ 
+       C390007_0.ClassWide_Proc (ClassWide_B);
+       if ClassWide_B.Last_Call /= Derived_Inner then
+          Report.Failed ("Parameter passing: tag not preserved in call to " &
+                         "class-wide operation with class-wide operand");
+       end if;
+ 
+    end Parameter_Passing_Subtest;
+ 
+ 
+    --
+    -- Check that tags are preserved by type conversion:
+    --
+ 
+    Type_Conversion_Subtest:
+    declare
+       Specific_A  : C390007_0.C390007_3.C390007_4.Convert_Derived_Type;
+       Specific_B  : C390007_0.C390007_3.C390007_4.Convert_Derived_Type;
+ 
+       ClassWide_A : C390007_0.C390007_3.Convert_Parent_Type'Class :=
+                     C390007_0.C390007_3.Convert_Parent_Type(Specific_A);
+       ClassWide_B : C390007_0.C390007_3.Convert_Parent_Type'Class :=
+                     C390007_0.C390007_3.Convert_Parent_Type(Specific_B);
+ 
+       use C390007_0.C390007_3;
+       use C390007_0.C390007_3.C390007_4;
+    begin
+ 
+       Outer_Proc (Convert_Parent_Type(Specific_A));
+       if (Specific_A.First_Call  /= Parent_Outer)  or
+          (Specific_A.Second_Call /= Derived_Inner)
+       then
+          Report.Failed ("Type conversion: tag not preserved in call to " &
+                         "primitive operation with specific operand");
+       end if;
+ 
+       Outer_Proc (ClassWide_A);   
+       if (ClassWide_A.First_Call  /= Derived_Outer) or
+          (ClassWide_A.Second_Call /= Derived_Inner)
+       then
+          Report.Failed ("Type conversion: tag not preserved in call to " &
+                         "primitive operation with class-wide operand");
+       end if;
+ 
+       C390007_0.ClassWide_Proc (Convert_Parent_Type(Specific_B));
+       if (Specific_B.Second_Call /= Derived_Inner) then
+          Report.Failed ("Type conversion: tag not preserved in call to " &
+                         "class-wide operation with specific operand");
+       end if;
+ 
+       C390007_0.ClassWide_Proc (ClassWide_B);
+       if (ClassWide_A.Second_Call /= Derived_Inner) then
+          Report.Failed ("Type conversion: tag not preserved in call to " &
+                         "class-wide operation with class-wide operand");
+       end if;
+ 
+    end Type_Conversion_Subtest;
+ 
+ 
+    --
+    -- Check that tags are preserved by type conversion and parameter passing:
+    --
+ 
+    Type_Conversion_And_Parameter_Passing_Subtest:
+    declare
+       Specific_A  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+       Specific_B  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+ 
+       use C390007_0.C390007_1;
+       use C390007_0.C390007_1.C390007_2;
+    begin
+ 
+       Outer_Proc (Param_Parent_Type (Specific_A));   
+       if Specific_A.Last_Call /= Parent_Outer then
+          Report.Failed ("Type conversion and parameter passing: tag not " &
+                         "preserved in call to primitive operation with "  &
+                         "specific operand");
+       end if;
+ 
+       C390007_0.ClassWide_Proc (Param_Parent_Type (Specific_B));
+       if Specific_B.Last_Call /= Derived_Inner then
+          Report.Failed ("Type conversion and parameter passing: tag not " &
+                         "preserved in call to class-wide operation with "  &
+                         "specific operand");
+       end if;
+ 
+    end Type_Conversion_And_Parameter_Passing_Subtest;
+ 
+ 
+    Report.Result;
+ 
+ end C390007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,216 ----
+ -- C390010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that if S is a subtype of a tagged type T, and if S is
+ --     constrained, then the allowable values of S'Class are only those
+ --     that, when converted to T, belong to S.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines a small tagged hierarchy of discriminated tagged
+ --      records, and constrained subtypes of those tagged record types.
+ --      It then uses access to the classwide of the constrained subtype
+ --      to check the objective.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      09 APR 96   SAIC   Initial version
+ --      03 NOV 96   SAIC   Revised for 2.1 release
+ --      31 DEC 97   EDS    Restored use of intermediate access variable
+ --                         to eliminate raising of Program_Error
+ --      13 SEP 99   RLB    Repaired previous change to avoid premature
+ --                         subtype check.
+ --      28 JUN 02   RLB    Added pragma Elaborate_All (Report);.
+ --!
+ 
+ ----------------------------------------------------------------- C390010_0
+ 
+ with Report; pragma Elaborate_All (Report);
+ package C390010_0 is
+ 
+   -- the defined subprograms will allow checking the placement of
+   -- constraint_checks
+ 
+   -- define a discriminated tagged type, and a constrained subtype of
+   -- that type:
+ 
+   type Discr_Tag_Record( Disc: Boolean ) is tagged record
+     FieldA : Character := 'A';
+     case Disc is
+       when True  => FieldB : Character := 'B';
+       when False => FieldC : Character := 'C';
+     end case;
+   end record;
+ 
+   procedure Dispatching_Op( DTO : in out Discr_Tag_Record );
+ 
+   Authentic : Boolean := Report.Ident_Bool( True );
+ 
+   subtype True_Record is Discr_Tag_Record( Authentic );
+ 
+ 
+   -- derive a type, "passing through" one discriminant, adding one
+   -- discriminant, and a constrained subtype of THAT type:
+ 
+   type Derived_Record( Disc1, Disc2: Boolean ) is
+     new Discr_Tag_Record( Disc1 ) with record
+       FieldD : Character := 'D';
+       case Disc2 is
+         when True  => FieldE : Character := 'E';
+         when False => FieldF : Character := 'F';
+       end case;
+     end record;
+ 
+   procedure Dispatching_Op( DR : in out Derived_Record );
+ 
+   subtype True_True_Derived is Derived_Record( Authentic, Authentic );
+ 
+ 
+   -- now, define an access to classwide type, using the classwide from the
+   -- constrained subtype of the root (or parent) type:
+ 
+   type Subtype_Parent_Class_Access is access all True_Record'Class;
+   type Parent_Class_Access is access all Discr_Tag_Record'Class;
+ 
+   procedure PCW_Op( SPCA : in Subtype_Parent_Class_Access );
+ 
+ end C390010_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- C390010_0
+ 
+ with Report;
+ with TCTouch;
+ package body C390010_0 is
+ 
+   procedure Dispatching_Op( DTO : in out Discr_Tag_Record ) is
+   begin
+     TCTouch.Touch('1');  --------------------------------------------------- 1
+     if DTO.Disc then
+       TCTouch.Touch(DTO.FieldB);  ------------------------------------------ B
+     else
+       TCTouch.Touch(DTO.FieldC);  ------------------------------------------ C
+     end if;
+   end Dispatching_Op;
+ 
+ 
+   procedure Dispatching_Op( DR : in out Derived_Record ) is
+   begin
+     TCTouch.Touch('2');  --------------------------------------------------- 2
+     if DR.Disc1 then
+       TCTouch.Touch(DR.FieldB);   ------------------------------------------ B
+     else
+       TCTouch.Touch(DR.FieldC);   ------------------------------------------ C
+     end if;
+     if DR.Disc2 then
+       TCTouch.Touch(DR.FieldE);   ------------------------------------------ E
+     else
+       TCTouch.Touch(DR.FieldF);   ------------------------------------------ F
+     end if;
+   end Dispatching_Op;
+ 
+   procedure PCW_Op( SPCA : in Subtype_Parent_Class_Access ) is
+   begin
+ 
+     -- the following line is the "heart" of this test, objects of all types
+     -- covered by the classwide type will be passed to this subprogram in
+     -- the execution of the test.
+     if SPCA.Disc then
+       TCTouch.Touch(SPCA.FieldB); ------------------------------------------ B
+     else
+       TCTouch.Touch(SPCA.FieldC); ------------------------------------------ C
+     end if;
+ 
+     Dispatching_Op( SPCA.all );  -- check that this dispatches correctly,
+                                  -- with discriminants correctly represented
+ 
+   end PCW_Op;
+ 
+ end C390010_0;
+ 
+ ------------------------------------------------------------------- C390010
+ 
+ with Report;
+ with TCTouch;
+ with C390010_0;
+ procedure C390010 is
+ 
+   package CP renames C390010_0;
+ 
+   procedure Check_Element( Item : access CP.Discr_Tag_Record'Class ) is
+   begin
+ 
+     -- the implicit conversion from the general access parameter to the more
+     -- constrained subtype access type in the following call should cause
+     -- Constraint_Error in the cases where the object is not correctly
+     -- constrained
+ 
+     CP.PCW_Op( Item.all'Access );
+ 
+   exception
+     when Constraint_Error => TCTouch.Touch('X');  -------------------------- X
+     when others => Report.Failed("Unanticipated exception in Check_Element");
+ 
+   end Check_Element;
+ 
+   An_Item : CP.Parent_Class_Access;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C390010", "Check that if S is a subtype of a tagged type " &
+                           "T, and if S is constrained, then the allowable " &
+                           "values of S'Class are only those that, when " &
+                           "converted to T, belong to S" );
+ 
+   An_Item := new CP.Discr_Tag_Record(True);
+   Check_Element( An_Item );
+   TCTouch.Validate("B1B","Case 1");
+ 
+   An_Item := new CP.Discr_Tag_Record(False);
+   Check_Element( An_Item );
+   TCTouch.Validate("X","Case 2");
+ 
+   An_Item := new CP.True_Record;
+   Check_Element( An_Item );
+   TCTouch.Validate("B1B","Case 3");
+ 
+   An_Item := new CP.Derived_Record(False, False);
+   Check_Element( An_Item );
+   TCTouch.Validate("X","Case 4");
+ 
+   An_Item := new CP.Derived_Record(False, True);
+   Check_Element( An_Item );
+   TCTouch.Validate("X","Case 5");
+ 
+   An_Item := new CP.Derived_Record(True, False);
+   Check_Element( An_Item );
+   TCTouch.Validate("B2BF","Case 6");
+ 
+   An_Item := new CP.True_True_Derived;
+   Check_Element( An_Item );
+   TCTouch.Validate("B2BE","Case 7");
+ 
+   Report.Result;
+ 
+ end C390010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,250 ----
+ -- C390011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that tagged types declared within generic package declarations
+ --     generate distinct tags for each instance of the generic.
+ --
+ -- TEST DESCRIPTION:
+ --     This test defines a very simple generic package (with the expectation
+ --     that it should be easily be shared), and a few instances of that
+ --     package.  In true user-like fashion, two of the instances are identical
+ --     (to wit: IIO is new Integer_IO(Integer)).  The tags generated for each
+ --     of them are placed into a list.  The last action of the test is to
+ --     check that everything in the list is unique.
+ --
+ --     Almost as an aside, this test defines functions that return T'Base and
+ --     T'Class, and then exercises these functions.
+ --
+ --     (JPR) persistent objects really need a function like:
+ --        function Get_Object return T'class;
+ --
+ --
+ -- CHANGE HISTORY:
+ --      20 OCT 95   SAIC   Initial version
+ --      23 APR 96   SAIC   Commentary Corrections 2.1
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C390011_0
+ 
+ with Ada.Tags;
+ package C390011_0 is
+ 
+   procedure Add_Tag_To_List( T : Ada.Tags.Tag; X_Name, X_Tag: String );
+ 
+   procedure Check_List_For_Duplicates;
+ 
+ end C390011_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C390011_0 is
+ 
+   use type Ada.Tags.Tag;
+   type SP is access String;
+ 
+   type List_Item;
+   type List_P is access List_Item;
+   type List_Item is record
+     The_Tag  : Ada.Tags.Tag;
+     Exp_Name : SP;
+     Ext_Tag  : SP;
+     Next : List_P;
+   end record;
+ 
+   The_List : List_P;
+ 
+   procedure Add_Tag_To_List ( T : Ada.Tags.Tag; X_Name, X_Tag: String ) is
+   begin  -- prepend the tag information to the list
+     The_List := new List_Item'( The_Tag  => T, 
+                                 Exp_Name => new String'(X_Name), 
+                                 Ext_Tag  => new String'(X_Tag),
+                                 Next     => The_List );
+   end Add_Tag_To_List;
+ 
+   procedure Check_List_For_Duplicates is
+     Finger : List_P;
+     Thumb  : List_P := The_List;
+   begin  -- 
+     while Thumb /= null loop
+       Finger := Thumb.Next;
+       while Finger /= null loop
+         -- Check that the tag is unique
+         if Finger.The_Tag = Thumb.The_Tag then
+           Report.Failed("Duplicate Tag");
+         end if;
+ 
+         -- Check that the Expanded name is unique
+         if Finger.Exp_Name.all = Thumb.Exp_Name.all then
+           Report.Failed("Tag name " & Finger.Exp_Name.all & " repeats");
+         end if;
+ 
+         -- Check that the External Tag is unique
+ 
+         if Finger.Ext_Tag.all = Thumb.Ext_Tag.all then
+           Report.Failed("External Tag " & Finger.Ext_Tag.all & " repeats");
+         end if;
+         Finger := Finger.Next;
+       end loop;
+       Thumb  := Thumb.Next;
+    end loop;
+   end Check_List_For_Duplicates;
+ 
+ begin
+   -- some things I just don't trust...
+   if The_List /= null then
+     Report.Failed("Implicit default for The_List not null");
+   end if;
+ end C390011_0;
+ 
+ ----------------------------------------------------------------- C390011_1
+ 
+ generic
+   type Index is (<>);
+   type Item is private;
+ package C390011_1 is
+ 
+   type List is array(Index range <>) of Item;
+   type ListP is access all List;
+ 
+   type Table is tagged record
+     Data: ListP;
+   end record;
+ 
+   function Sort( T: in Table'Class ) return Table'Class;
+ 
+   function Stable_Table return Table'Class;
+ 
+   function Table_End( T: Table ) return Index'Base;
+ 
+ end C390011_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C390011_1 is
+ 
+     -- In a user program this package would DO something
+ 
+   function Sort( T: in Table'Class ) return Table'Class is
+   begin
+    return T;
+   end Sort;
+ 
+   Empty : Table'Class := Table'( Data => null );
+ 
+   function Stable_Table return Table'Class is
+   begin
+     return Empty;
+   end Stable_Table;
+ 
+   function Table_End( T: Table ) return Index'Base is
+   begin
+     return Index'Base( T.Data.all'Last );
+   end Table_End;
+ 
+ end C390011_1;
+ 
+ ----------------------------------------------------------------- C390011_2
+ 
+ with C390011_1;
+ package C390011_2 is new C390011_1( Index => Character, Item => Float );
+ 
+ ----------------------------------------------------------------- C390011_3
+ 
+ with C390011_1;
+ package C390011_3 is new C390011_1( Index => Character, Item => Float );
+ 
+ ----------------------------------------------------------------- C390011_4
+ 
+ with C390011_1;
+ package C390011_4 is new C390011_1( Index => Integer, Item => Character );
+ 
+ ----------------------------------------------------------------- C390011_5
+ 
+ with C390011_3;
+ with C390011_4;
+ package C390011_5 is
+ 
+   type Table_3 is new C390011_3.Table with record
+     Serial_Number : Integer;
+   end record;
+ 
+   type Table_4 is new C390011_4.Table with record
+     Serial_Number : Integer;
+   end record;
+ 
+ end C390011_5;
+ 
+ -- no package body C390011_5 required
+ 
+ ------------------------------------------------------------------- C390011
+ 
+ with Report;
+ with C390011_0;
+ with C390011_2;
+ with C390011_3;
+ with C390011_4;
+ with C390011_5;
+ with Ada.Tags;
+ procedure C390011 is
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C390011", "Check that tagged types declared within " &
+                           "generic package declarations generate distinct " &
+                           "tags for each instance of the generic. " &
+                           "Check that 'Base may be used as a subtype mark. " &
+                           "Check that T'Base and T'Class are allowed as " &
+                           "the subtype mark in a function result" );
+ 
+   -- build the tag information table
+   C390011_0.Add_Tag_To_List(T => C390011_2.Table'Tag,
+                        X_Name => Ada.Tags.Expanded_Name(C390011_2.Table'Tag),
+                        X_Tag  => Ada.Tags.External_Tag(C390011_2.Table'Tag) );
+ 
+   C390011_0.Add_Tag_To_List(T => C390011_3.Table'Tag,
+                        X_Name => Ada.Tags.Expanded_Name(C390011_3.Table'Tag),
+                        X_Tag  => Ada.Tags.External_Tag(C390011_3.Table'Tag) );
+ 
+   C390011_0.Add_Tag_To_List(T => C390011_4.Table'Tag,
+                        X_Name => Ada.Tags.Expanded_Name(C390011_4.Table'Tag),
+                        X_Tag  => Ada.Tags.External_Tag(C390011_4.Table'Tag) );
+ 
+   C390011_0.Add_Tag_To_List(T => C390011_5.Table_3'Tag,
+                      X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_3'Tag),
+                      X_Tag  => Ada.Tags.External_Tag(C390011_5.Table_3'Tag) );
+ 
+   C390011_0.Add_Tag_To_List(T => C390011_5.Table_4'Tag,
+                      X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_4'Tag),
+                      X_Tag  => Ada.Tags.External_Tag(C390011_5.Table_4'Tag) );
+ 
+   -- preform the check for distinct tags
+   C390011_0.Check_List_For_Duplicates;
+ 
+   Report.Result;
+ 
+ end C390011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,207 ----
+ -- C39006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
+ -- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
+ -- FOLLOWING:
+ --     A) A FUNCTION IS CALLED IN THE INITIALIZATION EXPRESSION OF A
+ --        SCALAR VARIABLE OR A RECORD COMPONENT, AND THE SCALAR OR
+ --        RECORD VARIABLE'S DECLARATION IS ELABORATED BEFORE THE
+ --        SUBPROGRAM BODY IS ELABORATED.
+ 
+ -- TBN  8/14/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C39006A IS
+ 
+ BEGIN
+      TEST ("C39006A", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
+                       "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " &
+                       "BODY HAS NOT YET BEEN ELABORATED");
+      BEGIN
+           DECLARE
+ 
+                FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER;
+ 
+                VAR1 : INTEGER := INIT_1 (1);
+ 
+                FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER IS
+                BEGIN
+                     RETURN (A + IDENT_INT(1));
+                END INIT_1;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 1");
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+      END;
+ 
+      BEGIN
+           DECLARE
+ 
+                FUNCTION INIT_2 (A : INTEGER) RETURN INTEGER;
+ 
+                TYPE REC1 IS
+                     RECORD
+                          NUMBER : INTEGER := INIT_2 (2);
+                     END RECORD;
+ 
+                VAR2 : REC1;
+ 
+                FUNCTION INIT_2 (A : INTEGER) RETURN INTEGER IS
+                BEGIN
+                     RETURN (A + IDENT_INT(1));
+                END INIT_2;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 2");
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+      BEGIN
+           DECLARE
+ 
+                FUNCTION F1 RETURN INTEGER;
+ 
+                PACKAGE PACK IS
+                     VAR1 : INTEGER := F1;
+                END PACK;
+ 
+                FUNCTION F1 RETURN INTEGER IS
+                BEGIN
+                     RETURN (IDENT_INT(1));
+                END F1;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 3");
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+      END;
+ 
+      BEGIN
+           DECLARE
+ 
+                PACKAGE PACK IS
+                     FUNCTION F2 RETURN INTEGER;
+                     VAR2 : INTEGER := F2;
+                END PACK;
+ 
+                PACKAGE BODY PACK IS
+                     FUNCTION F2 RETURN INTEGER IS
+                     BEGIN
+                          RETURN (IDENT_INT(3));
+                     END F2;
+                END PACK;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 4");
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+      END;
+ 
+      BEGIN
+           DECLARE
+ 
+                FUNCTION INIT_3 (A : INTEGER) RETURN INTEGER;
+ 
+                GENERIC
+                     PACKAGE Q IS
+                          VAR1 : INTEGER := INIT_3 (1);
+                     END Q;
+ 
+                PACKAGE NEW_Q IS NEW Q;
+ 
+                FUNCTION INIT_3 (A : INTEGER) RETURN INTEGER IS
+                BEGIN
+                     RETURN (A + IDENT_INT(3));
+                END INIT_3;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 5");
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+      END;
+ 
+      BEGIN
+           DECLARE
+ 
+                FUNCTION FUN RETURN INTEGER;
+ 
+                TYPE PARAM IS
+                     RECORD
+                          COMP : INTEGER := FUN;
+                     END RECORD;
+ 
+                GENERIC
+                     TYPE T IS PRIVATE;
+                PACKAGE GP IS
+                     OBJ : T;
+                END GP;
+ 
+                PACKAGE INST IS NEW GP(PARAM);
+ 
+                FUNCTION FUN RETURN INTEGER IS
+                BEGIN
+                     RETURN (IDENT_INT(3));
+                END FUN;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 6");
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+      END;
+ 
+      RESULT;
+ END C39006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- C39006B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
+ -- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
+ -- FOLLOWING:
+ --     B) THE SUBPROGRAM IS CALLED IN A PACKAGE BODY.
+ --     C) THE SUBPROGRAM IS AN ACTUAL GENERIC PARAMETER CALLED DURING
+ --        ELABORATION OF THE GENERIC INSTANTIATION.
+ --     D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL
+ --        PACKAGE BODY.
+ 
+ -- TBN  8/19/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C39006B IS
+ 
+ BEGIN
+      TEST ("C39006B", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
+                       "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " &
+                       "BODY HAS NOT YET BEEN ELABORATED");
+      BEGIN
+           DECLARE
+                PACKAGE PACK IS
+                     FUNCTION FUN RETURN INTEGER;
+                     PROCEDURE PROC (A : IN OUT INTEGER);
+                END PACK;
+ 
+                PACKAGE BODY PACK IS
+ 
+                     VAR1 : INTEGER := 0;
+ 
+                     PROCEDURE PROC (A : IN OUT INTEGER) IS
+                     BEGIN
+                          IF A = IDENT_INT(1) THEN
+                               A := A + FUN;
+                               FAILED ("PROGRAM_ERROR NOT RAISED - 1");
+                          ELSE
+                               A := IDENT_INT(1);
+                          END IF;
+                     EXCEPTION
+                          WHEN PROGRAM_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                       "1");
+                     END PROC;
+ 
+                     PACKAGE INSIDE IS
+                     END INSIDE;
+ 
+                     PACKAGE BODY INSIDE IS
+                     BEGIN
+                          PROC (VAR1);
+                          PROC (VAR1);
+                     END INSIDE;
+ 
+                     FUNCTION FUN RETURN INTEGER IS
+                     BEGIN
+                          RETURN (IDENT_INT(1));
+                     END FUN;
+ 
+                BEGIN
+                     NULL;
+                END PACK;
+ 
+           BEGIN
+                NULL;
+           END;
+      END;
+ 
+      BEGIN
+           DECLARE
+                FUNCTION INIT_2 RETURN INTEGER;
+ 
+                GENERIC
+                     WITH FUNCTION FF RETURN INTEGER;
+                PACKAGE P IS
+                     Y : INTEGER;
+                END P;
+ 
+                GLOBAL_INT : INTEGER := IDENT_INT(1);
+ 
+                PACKAGE BODY P IS
+                BEGIN
+                     IF GLOBAL_INT = 1 THEN
+                          Y := FF;
+                     END IF;
+                END P;
+ 
+                PACKAGE N IS
+                     PACKAGE NEW_P IS NEW P(INIT_2);
+                END N;
+ 
+                FUNCTION INIT_2 RETURN INTEGER IS
+                BEGIN
+                     RETURN (IDENT_INT (1));
+                END INIT_2;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 2");
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+      DECLARE
+ 
+           PROCEDURE ADD1 (A : IN OUT INTEGER);
+ 
+           PACKAGE P IS
+                VAR : INTEGER := IDENT_INT(1);
+           END P;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                IF VAR = 1 THEN
+                     ADD1 (VAR);
+                     FAILED ("PROGRAM_ERROR NOT RAISED - 3");
+                END IF;
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+           END P;
+ 
+           PROCEDURE ADD1 (A : IN OUT INTEGER) IS
+           BEGIN
+                A := A + IDENT_INT(1);
+           END ADD1;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C39006B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- C39006C0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
+ -- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
+ -- FOLLOWING:
+ --     D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL
+ --        PACKAGE BODY SUBUNIT THAT IS IN C39006C1.ADA.
+ 
+ -- SEPARATE FILES ARE:
+ --     C39006C0M     THE MAIN PROCEDURE.
+ --     C39006C1      A SUBUNIT PACKAGE BODY.
+ 
+ -- TBN  8/19/86
+ -- LDC  5/26/88   CHANGED TEST NAME PARAMETER FROM C39006C0M TO
+ --                C39006C IN THE TEST CALL.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C39006C0M IS
+ 
+      PACKAGE CALL_TEST_FIRST IS
+      END CALL_TEST_FIRST;
+ 
+      PACKAGE BODY CALL_TEST_FIRST IS
+      BEGIN
+           TEST ("C39006C", "CHECK THAT PROGRAM_ERROR IS RAISED IF " &
+                              "THE SUBPROGRAM WHOSE BODY HAS NOT BEEN " &
+                              "ELABORATED IS CALLED DURING " &
+                              "ELABORATION OF AN OPTIONAL PACKAGE " &
+                              "BODY SUBUNIT");
+      END CALL_TEST_FIRST;
+ 
+      PROCEDURE ADD1 (A : IN OUT INTEGER);
+ 
+      PACKAGE C39006C1 IS
+           VAR : INTEGER := IDENT_INT(1);
+      END C39006C1;
+ 
+      PACKAGE BODY C39006C1 IS SEPARATE;
+ 
+      PROCEDURE ADD1 (A : IN OUT INTEGER) IS
+      BEGIN
+           A := A + IDENT_INT(1);
+      END ADD1;
+ 
+ BEGIN
+      RESULT;
+ END C39006C0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,41 ----
+ -- C39006C1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- PACKAGE BODY SUBUNIT FOR C39006C0M.ADA.
+ 
+ -- TBN  8/19/86
+ 
+ SEPARATE (C39006C0M)
+ PACKAGE BODY C39006C1 IS
+ BEGIN
+      IF VAR = IDENT_INT(1) THEN
+           ADD1 (VAR);
+           FAILED ("PROGRAM_ERROR NOT RAISED");
+      END IF;
+ EXCEPTION
+      WHEN PROGRAM_ERROR =>
+           NULL;
+      WHEN OTHERS =>
+           FAILED ("UNEXPECTED EXCEPTION RAISED");
+ END C39006C1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- C39006D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A FUNCTION IS USED IN A DEFAULT EXPRESSION FOR A
+ -- SUBPROGRAM OR FORMAL GENERIC PARAMETER, PROGRAM_ERROR IS RAISED
+ -- WHEN AN ATTEMPT IS MADE TO EVALUATE THE DEFAULT EXPRESSION,
+ -- BECAUSE THE FUNCTION'S BODY HAS NOT BEEN ELABORATED YET.
+ 
+ -- TBN  8/20/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C39006D IS
+ 
+ BEGIN
+      TEST ("C39006D", "CHECK THAT IF A FUNCTION IS USED IN A DEFAULT " &
+                       "EXPRESSION FOR A SUBPROGRAM OR FORMAL GENERIC " &
+                       "PARAMETER, PROGRAM_ERROR IS RAISED WHEN AN " &
+                       "ATTEMPT IS MADE TO EVALUATE THE DEFAULT " &
+                       "EXPRESSION");
+      DECLARE
+           FUNCTION FUN RETURN INTEGER;
+ 
+           PACKAGE P IS
+                PROCEDURE DEFAULT (A : INTEGER := FUN);
+           END P;
+ 
+           PACKAGE BODY P IS
+                PROCEDURE DEFAULT (A : INTEGER := FUN) IS
+                     B : INTEGER := 1;
+                BEGIN
+                     B := B + IDENT_INT(A);
+                END DEFAULT;
+           BEGIN
+                DEFAULT (2);
+                DEFAULT;
+                FAILED ("PROGRAM_ERROR NOT RAISED - 1");
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+           END P;
+ 
+           FUNCTION FUN RETURN INTEGER IS
+           BEGIN
+                RETURN (IDENT_INT(1));
+           END FUN;
+      BEGIN
+           NULL;
+      END;
+ 
+      BEGIN
+           DECLARE
+                FUNCTION INIT_1 RETURN INTEGER;
+ 
+                GENERIC
+                     LENGTH : INTEGER := INIT_1;
+                PACKAGE P IS
+                     TYPE ARRAY1 IS ARRAY (1 .. LENGTH) OF INTEGER;
+                END P;
+ 
+                PACKAGE NEW_P1 IS NEW P (4);
+                PACKAGE NEW_P2 IS NEW P;
+ 
+                FUNCTION INIT_1 RETURN INTEGER IS
+                BEGIN
+                     RETURN (IDENT_INT(2));
+                END INIT_1;
+ 
+           BEGIN
+                FAILED ("PROGRAM_ERROR NOT RAISED - 2");
+           END;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+      DECLARE
+           FUNCTION INIT_2 RETURN INTEGER;
+ 
+           GLOBAL_INT : INTEGER := IDENT_INT(1);
+ 
+           GENERIC
+           PACKAGE Q IS
+                PROCEDURE ADD1 (A : INTEGER := INIT_2);
+           END Q;
+ 
+           PACKAGE BODY Q IS
+                PROCEDURE ADD1 (A : INTEGER := INIT_2) IS
+                     B : INTEGER;
+                BEGIN
+                     B := A;
+                END ADD1;
+           BEGIN
+                IF GLOBAL_INT = IDENT_INT(1) THEN
+                     ADD1;
+                     FAILED ("PROGRAM_ERROR NOT RAISED - 3");
+                ELSE
+                     ADD1 (2);
+                END IF;
+ 
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+           END Q;
+ 
+           PACKAGE NEW_Q IS NEW Q;
+ 
+           FUNCTION INIT_2 RETURN INTEGER IS
+           BEGIN
+                RETURN (IDENT_INT(1));
+           END INIT_2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C39006D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,213 ----
+ -- C39006E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PROGRAM_ERROR IS NOT RAISED IF A SUBPROGRAM'S BODY HAS
+ -- BEEN ELABORATED BEFORE IT IS CALLED. CHECK THE FOLLOWING:
+ --     A) A SUBPROGRAM CAN APPEAR IN A NON-ELABORATED DECLARATIVE PART
+ --        OR PACKAGE SPECIFICATION BEFORE ITS BODY.
+ 
+ -- TBN  8/21/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C39006E IS
+ 
+ BEGIN
+      TEST ("C39006E", "CHECK THAT PROGRAM_ERROR IS NOT RAISED IF A " &
+                       "SUBPROGRAM IS CALLED IN A NON-ELABORATED " &
+                       "DECLARATIVE PART OR PACKAGE SPECIFICATION " &
+                       "BEFORE ITS BODY IS ELABORATED");
+      DECLARE -- (A)
+ 
+           FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER;
+ 
+           PACKAGE P IS
+                PROCEDURE USE_INIT1;
+           END P;
+ 
+           PACKAGE BODY P IS
+                PROCEDURE USE_INIT1 IS
+                BEGIN
+                     IF NOT EQUAL (3, 3) THEN
+                          DECLARE
+                               X : INTEGER := INIT_1 (1);
+                          BEGIN
+                               NULL;
+                          END;
+                     ELSE
+                          NULL;
+                     END IF;
+ 
+                EXCEPTION
+                     WHEN PROGRAM_ERROR =>
+                          FAILED ("PROGRAM_ERROR RAISED - 1");
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+                END USE_INIT1;
+ 
+           BEGIN
+                USE_INIT1;
+           END P;
+ 
+           FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN (A + IDENT_INT(1));
+           END INIT_1;
+ 
+      BEGIN -- (A)
+           NULL;
+      END; -- (A)
+ 
+      DECLARE -- (B)
+ 
+           PROCEDURE INIT_2 (A : IN OUT INTEGER);
+ 
+           PACKAGE P IS
+                FUNCTION USE_INIT2 RETURN BOOLEAN;
+           END P;
+ 
+           PACKAGE BODY P IS
+                FUNCTION USE_INIT2 RETURN BOOLEAN IS
+                BEGIN
+                     IF NOT EQUAL (3, 3) THEN
+                          DECLARE
+                               X : INTEGER;
+                          BEGIN
+                               INIT_2 (X);
+                          END;
+                     END IF;
+                     RETURN IDENT_BOOL (FALSE);
+ 
+                EXCEPTION
+                     WHEN PROGRAM_ERROR =>
+                          FAILED ("PROGRAM_ERROR RAISED - 2");
+                          RETURN FALSE;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+                          RETURN FALSE;
+                END USE_INIT2;
+           BEGIN
+                IF USE_INIT2 THEN
+                     FAILED ("INCORRECT RESULTS FROM FUNCTION CALL - 2");
+                END IF;
+           END P;
+ 
+           PROCEDURE INIT_2 (A : IN OUT INTEGER) IS
+           BEGIN
+                A := A + IDENT_INT(1);
+           END INIT_2;
+ 
+      BEGIN -- (B)
+           NULL;
+      END; -- (B)
+ 
+      DECLARE -- (C)
+           FUNCTION INIT_3 RETURN INTEGER;
+ 
+           PACKAGE Q IS
+                VAR : INTEGER;
+           END Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF NOT EQUAL (3, 3) THEN
+                     VAR := INIT_3;
+                END IF;
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     FAILED ("PROGRAM_ERROR RAISED - 3");
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+           END Q;
+ 
+           FUNCTION INIT_3 RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (1);
+           END INIT_3;
+ 
+      BEGIN -- (C)
+           NULL;
+      END; -- (C)
+ 
+      DECLARE -- (D)
+           PROCEDURE INIT_4 (A : IN OUT INTEGER);
+ 
+           PACKAGE Q IS
+                VAR : INTEGER := 1;
+           END Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF NOT EQUAL (3, 3) THEN
+                     INIT_4 (VAR);
+                END IF;
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     FAILED ("PROGRAM_ERROR RAISED - 4");
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+           END Q;
+ 
+           PROCEDURE INIT_4 (A : IN OUT INTEGER) IS
+           BEGIN
+                A := IDENT_INT (4);
+           END INIT_4;
+ 
+      BEGIN -- (D)
+           NULL;
+      END; -- (D)
+ 
+      BEGIN -- (E)
+ 
+           DECLARE
+                FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER;
+ 
+                PROCEDURE USE_INIT5 IS
+                     PACKAGE Q IS
+                          X : INTEGER := INIT_5 (1);
+                     END Q;
+                     USE Q;
+                BEGIN
+                     X := IDENT_INT (5);
+ 
+                END USE_INIT5;
+ 
+                FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER IS
+                BEGIN
+                     RETURN (A + IDENT_INT(1));
+                END INIT_5;
+ 
+           BEGIN
+                USE_INIT5;
+           END;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                FAILED ("PROGRAM_ERROR RAISED - 5");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+ 
+      END; -- (E)
+ 
+      RESULT;
+ END C39006E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,44 ----
+ -- C39006F0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+ --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+ --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+ --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+ --           SUBPROGRAM.
+ 
+ --     THIS SUBPROGRAM LIBRARY UNIT IS USED BY C39006F2.ADA.
+ 
+ -- HISTORY:
+ --     TBN  08/22/86  CREATED ORIGINAL TEST.
+ --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+ --                    TO 'TEST'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ FUNCTION C39006F0 (A : INTEGER) RETURN INTEGER IS
+ BEGIN
+      RETURN (IDENT_INT(A));
+ END C39006F0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,42 ----
+ -- C39006F1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+ --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+ --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+ --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+ --           SUBPROGRAM.
+ 
+ --     THIS LIBRARY PACKAGE SPECIFICATION IS USED BY C39006F3M.ADA.
+ 
+ -- HISTORY:
+ --     TBN  08/22/86  CREATED ORIGINAL TEST.
+ --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+ --                    TO 'TEST'.
+ --     PWN  05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ PACKAGE C39006F1 IS
+      PROCEDURE REQUIRE_BODY;
+ END C39006F1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- C39006F2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+ --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+ --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+ --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+ --           SUBPROGRAM.
+ 
+ --     THIS LIBRARY PACKAGE BODY IS USED BY C39006F3M.ADA.
+ 
+ -- HISTORY:
+ --     TBN  08/22/86  CREATED ORIGINAL TEST.
+ --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+ --                    TO 'TEST'.
+ --     PWN  05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ WITH C39006F0;
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (C39006F0, REPORT);
+ 
+ PACKAGE BODY C39006F1 IS
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ 
+ BEGIN
+      TEST ("C39006F", "CHECK THAT NO PROGRAM_ERROR IS RAISED IF A " &
+                       "SUBPROGRAM'S BODY HAS BEEN ELABORATED " &
+                       "BEFORE IT IS CALLED, WHEN A SUBPROGRAM " &
+                       "LIBRARY UNIT IS USED IN ANOTHER UNIT AND " &
+                       "PRAGMA ELABORATE IS USED");
+      BEGIN
+           DECLARE
+                VAR1 : INTEGER := C39006F0 (IDENT_INT(1));
+           BEGIN
+                IF VAR1 /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT RESULTS - 1");
+                END IF;
+           END;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                FAILED ("PROGRAM_ERROR RAISED - 1");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+      END;
+ 
+      DECLARE
+           VAR2 : INTEGER := 1;
+ 
+           PROCEDURE CHECK (B : IN OUT INTEGER) IS
+           BEGIN
+                B := C39006F0 (IDENT_INT(2));
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     FAILED ("PROGRAM_ERROR RAISED - 2");
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+           END CHECK;
+      BEGIN
+           CHECK (VAR2);
+           IF VAR2 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+      END;
+ 
+      DECLARE
+           PACKAGE P IS
+                VAR3 : INTEGER;
+           END P;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                VAR3 := C39006F0 (IDENT_INT(3));
+                IF VAR3 /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RESULTS - 3");
+                END IF;
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     FAILED ("PROGRAM_ERROR RAISED - 3");
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION - 3");
+           END P;
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE
+           GENERIC
+                VAR4 : INTEGER := 1;
+           PACKAGE Q IS
+                TYPE ARRAY_TYP1 IS ARRAY (1 .. VAR4) OF INTEGER;
+                ARRAY_1 : ARRAY_TYP1;
+           END Q;
+ 
+           PACKAGE NEW_Q IS NEW Q (C39006F0 (IDENT_INT(4)));
+ 
+           USE NEW_Q;
+ 
+      BEGIN
+           IF ARRAY_1'LAST /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+      END;
+ 
+ END C39006F1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006f3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006f3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,49 ----
+ -- C39006F3M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+ --     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+ --        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+ --           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+ --           SUBPROGRAM.
+ 
+ -- SEPARATE FILES ARE:
+ --      C39006F0     A LIBRARY FUNCTION.
+ --      C39006F1     A LIBRARY PACKAGE SPECIFICATION.
+ --      C39006F2     A LIBRARY PACKAGE BODY.
+ --      C39006F3M    (THIS FILE) THE MAIN PROCEDURE.
+ 
+ -- HISTORY:
+ --     TBN  08/22/86  CREATED ORIGINAL TEST.
+ --     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+ --                    TO 'TEST'.
+ 
+ WITH C39006F1;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C39006F3M IS
+ BEGIN
+      RESULT;
+ END C39006F3M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39006g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39006g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C39006G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO CALL A
+ --     SUBPROGRAM WHOSE BODY IS NOT YET ELABORATED.  USE A PACKAGE
+ --     WITH OPTIONAL BODY, WHERE THE SUBPROGRAM IS CALLED IN THE BODY.
+ 
+ -- HISTORY:
+ --     BCB 08/01/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C39006G IS
+ 
+      PROCEDURE INIT (X : IN OUT INTEGER);
+ 
+      PACKAGE P IS
+      END P;
+ 
+      PACKAGE BODY P IS
+           X : INTEGER := IDENT_INT(5);
+      BEGIN
+           TEST ("C39006G", "CHECK THAT PROGRAM_ERROR IS RAISED BY " &
+                            "AN ATTEMPT TO CALL A SUBPROGRAM WHOSE " &
+                            "BODY IS NOT YET ELABORATED.  USE A " &
+                            "PACKAGE WITH OPTIONAL BODY, WHERE THE " &
+                            "SUBPROGRAM IS CALLED IN THE BODY");
+           INIT(X);
+           FAILED ("NO EXCEPTION RAISED");
+           IF X /= IDENT_INT(10) THEN
+                COMMENT ("TOTALLY IRRELEVANT");
+           END IF;
+           RESULT;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                RESULT;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION WAS RAISED");
+                RESULT;
+      END P;
+ 
+      PROCEDURE INIT (X : IN OUT INTEGER) IS
+      BEGIN
+           X := IDENT_INT(10);
+      END INIT;
+ 
+ BEGIN
+      NULL;
+ END C39006G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- C39007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO
+ -- INSTANTIATE A GENERIC UNIT WHOSE BODY HAS NOT BEEN ELABORATED.
+ -- CHECK THE FOLLOWING CASE:
+ --     A) A SIMPLE CASE WHERE THE GENERIC UNIT BODY OCCURS LATER IN
+ --        THE SAME DECLARATIVE PART.
+ 
+ -- TBN  9/12/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C39007A IS
+ 
+ BEGIN
+      TEST ("C39007A", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
+                       "ATTEMPT IS MADE TO INSTANTIATE A GENERIC " &
+                       "UNIT WHOSE BODY HAS NOT BEEN ELABORATED, " &
+                       "BUT OCCURS IN THE SAME DECLARATIVE PART");
+ 
+      BEGIN
+           IF EQUAL (1, 1) THEN
+                DECLARE
+                     GENERIC
+                     PACKAGE P IS
+                          A : INTEGER;
+                          PROCEDURE ASSIGN (X : OUT INTEGER);
+                     END P;
+ 
+                     PACKAGE NEW_P IS NEW P;
+ 
+                     PACKAGE BODY P IS
+                          PROCEDURE ASSIGN (X : OUT INTEGER) IS
+                          BEGIN
+                               X := IDENT_INT (1);
+                          END ASSIGN;
+                     BEGIN
+                          ASSIGN (A);
+                     END P;
+ 
+                BEGIN
+                     NULL;
+                END;
+                FAILED ("PROGRAM_ERROR WAS NOT RAISED - 1");
+           END IF;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+      END;
+ 
+ ------------------------------------------------------------------------
+ 
+      BEGIN
+           IF EQUAL (2, 2) THEN
+                DECLARE
+                     GENERIC
+                     PROCEDURE ADD1 (X : IN OUT INTEGER);
+ 
+                     PROCEDURE NEW_ADD1 IS NEW ADD1;
+ 
+                     PROCEDURE ADD1 (X : IN OUT INTEGER) IS
+                     BEGIN
+                          X := X + IDENT_INT (1);
+                     END ADD1;
+                BEGIN
+                     NULL;
+                END;
+                FAILED ("PROGRAM_ERROR WAS NOT RAISED - 2");
+           END IF;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+ ------------------------------------------------------------------------
+ 
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                DECLARE
+                     GENERIC
+                     FUNCTION INIT RETURN INTEGER;
+ 
+                     FUNCTION NEW_INIT IS NEW INIT;
+ 
+                     FUNCTION INIT RETURN INTEGER IS
+                     BEGIN
+                          RETURN (IDENT_INT (1));
+                     END INIT;
+                BEGIN
+                     NULL;
+                END;
+                FAILED ("PROGRAM_ERROR WAS NOT RAISED - 3");
+           END IF;
+ 
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+      END;
+ 
+ ------------------------------------------------------------------------
+ 
+      RESULT;
+ END C39007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39007b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39007b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39007b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C39007B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO INSTANTIATE
+ --     A GENERIC UNIT WHOSE BODY IS NOT YET ELABORATED.  USE A GENERIC
+ --     UNIT THAT IS DECLARED AND INSTANTIATED IN A PACKAGE
+ --     SPECIFICATION.
+ 
+ -- HISTORY:
+ --     BCB 08/01/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C39007B IS
+ 
+ BEGIN
+      TEST ("C39007B", "CHECK THAT PROGRAM_ERROR IS RAISED BY AN " &
+                       "ATTEMPT TO INSTANTIATE A GENERIC UNIT WHOSE " &
+                       "BODY IS NOT YET ELABORATED.  USE A GENERIC " &
+                       "UNIT THAT IS DECLARED AND INSTANTIATED IN A " &
+                       "PACKAGE SPECIFICATION");
+ 
+      DECLARE
+      BEGIN
+           DECLARE
+                PACKAGE P IS
+                     GENERIC
+                     FUNCTION F RETURN BOOLEAN;
+ 
+                     FUNCTION NEW_F IS NEW F;
+                END P;
+ 
+                PACKAGE BODY P IS
+                     FUNCTION F RETURN BOOLEAN IS
+                     BEGIN
+                          RETURN TRUE;
+                     END F;
+                END P;
+           BEGIN
+                FAILED ("NO EXCEPTION RAISED");
+                DECLARE
+                     X : BOOLEAN := IDENT_BOOL(FALSE);
+                BEGIN
+                     X := P.NEW_F;
+                     IF X /= IDENT_BOOL(TRUE) THEN
+                          COMMENT ("NOT RELEVANT");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED TOO LATE");
+                END;
+           END;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C39007B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C39008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO ACTIVATE
+ --     A TASK BEFORE ITS BODY HAS BEEN ELABORATED.  CHECK THE CASE IN
+ --     WHICH A TASK VARIABLE IS DECLARED IN A PACKAGE SPECIFICATION AND
+ --     THE PACKAGE BODY OCCURS BEFORE THE TASK BODY.
+ 
+ -- HISTORY:
+ --     BCB 01/21/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C39008A IS
+ 
+ BEGIN
+      TEST ("C39008A", "CHECK THAT PROGRAM_ERROR IS RAISED BY AN " &
+                       "ATTEMPT TO ACTIVATE A TASK BEFORE ITS BODY " &
+                       "HAS BEEN ELABORATED.  CHECK THE CASE IN WHICH " &
+                       "A TASK VARIABLE IS DECLARED IN A PACKAGE " &
+                       "SPECIFICATION AND THE PACKAGE BODY OCCURS " &
+                       "BEFORE THE TASK BODY");
+ 
+      BEGIN
+           DECLARE
+                TASK TYPE T;
+ 
+                PACKAGE P IS
+                     X : T;
+                END P;
+ 
+                PACKAGE BODY P IS
+                END P;                                  -- PROGRAM_ERROR.
+ 
+                TASK BODY T IS
+                BEGIN
+                     COMMENT ("TASK MESSAGE");
+                END T;
+           BEGIN
+                FAILED ("PROGRAM_ERROR WAS NOT RAISED");
+           END;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR WAS RAISED");
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN PROGRAM_ERROR WAS " &
+                        "RAISED");
+      END;
+ 
+      RESULT;
+ END C39008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39008b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39008b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39008b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C39008B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE ACTIVATION OF A TASK IS ATTEMPTED BEFORE THE
+ -- ELABORATION OF THE CORRESPONDING BODY IS FINISHED, THE EXCEPTION
+ -- PROGRAM_ERROR IS RAISED, NOT TASKING_ERROR (SEE AI-00149).
+ 
+ -- WEI  3/04/82
+ -- JBG  2/17/84
+ -- EG  11/02/84
+ -- JBG 5/23/85
+ -- JWC 6/28/85   RENAMED FROM C93007B-B.ADA
+ 
+ WITH REPORT;
+  USE REPORT;
+ 
+ PROCEDURE C39008B IS
+ 
+ BEGIN
+ 
+      TEST ("C39008B", "PROGRAM_ERROR AFTER ATTEMPT OF ACTIVATION " &
+                       "BEFORE ELABORATION");
+ BLOCK1:
+      BEGIN
+ BLOCK2:
+           DECLARE
+                TASK TYPE TT1;
+ 
+                TYPE ATT1 IS ACCESS TT1;
+ 
+                POINTER_TT1 : ATT1 := NEW TT1;  -- ACCESSING TASK BODY
+                                                -- BEFORE ITS ELABORATION
+ 
+                TASK BODY TT1 IS
+                BEGIN
+                     FAILED ("TT1 ACTIVATED");
+                END TT1;
+ 
+           BEGIN
+ 
+                FAILED ("TT1 ACTIVATED - 2");
+ 
+           END BLOCK2;
+ 
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+      END BLOCK1;
+ 
+      RESULT;
+ 
+ END C39008B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39008c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39008c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c39008c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c39008c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C39008C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT PROGRAM_ERROR IS RAISED WHEN AN ATTEMPT IS MADE TO
+ --     ACTIVATE A TASK BEFORE ITS BODY HAS BEEN ELABORATED.  CHECK THE
+ --     CASE IN WHICH SEVERAL TASKS ARE TO BE ACTIVATED, AND ONLY SOME
+ --     HAVE UNELABORATED BODIES; NO TASKS SHOULD BE ACTIVATED.
+ 
+ -- HISTORY:
+ --     BCB 07/08/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C39008C IS
+ 
+ BEGIN
+      TEST ("C39008C", "CHECK THAT PROGRAM_ERROR IS RAISED WHEN AN " &
+                       "ATTEMPT IS MADE TO ACTIVATE A TASK BEFORE ITS " &
+                       "BODY HAS BEEN ELABORATED.  CHECK THE CASE IN " &
+                       "WHICH SEVERAL TASKS ARE TO BE ACTIVATED, AND " &
+                       "ONLY SOME HAVE UNELABORATED BODIES; NO TASKS " &
+                       "SHOULD BE ACTIVATED");
+ 
+      BEGIN
+           DECLARE
+                TASK TYPE A;
+ 
+                TASK TYPE B;
+ 
+                TASK TYPE C;
+ 
+                TASK TYPE D;
+ 
+                PACKAGE P IS
+                     W : A;
+                     X : B;
+                     Y : C;
+                     Z : D;
+                END P;
+ 
+                TASK BODY A IS
+                BEGIN
+                     FAILED ("TASK A ACTIVATED");
+                END A;
+ 
+                TASK BODY D IS
+                BEGIN
+                     FAILED ("TASK D ACTIVATED");
+                END D;
+ 
+                PACKAGE BODY P IS
+                END P;
+ 
+                TASK BODY B IS
+                BEGIN
+                     FAILED ("TASK B ACTIVATED");
+                END B;
+ 
+                TASK BODY C IS
+                BEGIN
+                     FAILED ("TASK C ACTIVATED");
+                END C;
+           BEGIN
+                FAILED ("PROGRAM_ERROR WAS NOT RAISED");
+           END;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN PROGRAM_ERROR WAS " &
+                        "RAISED");
+      END;
+ 
+      RESULT;
+ END C39008C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,127 ----
+ -- C390A010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C390A011.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C390A011.AM.
+ -- 
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F390A00.A
+ --      => C390A010.A
+ --         C390A011.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with F390A00;  -- Alert system abstraction.
+ package C390A010 is
+ 
+ 
+    type Low_Alert_Type is new F390A00.Alert_Type with record
+       Level : Integer := 0;                             -- Record extension of
+    end record;                                          -- root tagged type.
+ 
+    -- Inherits procedure Display from Alert_Type.
+ 
+    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                         -- primitive subprog.
+ 
+    function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
+      return Integer;                                    -- all derivatives.
+ 
+ 
+ 
+    -- Declarations required for component Action_Officer;
+ 
+    type Person_Enum is (Nobody,          Duty_Officer,
+                         Watch_Commander, Commanding_Officer);
+ 
+ 
+    type Medium_Alert_Type is new Low_Alert_Type with record
+       Action_Officer : Person_Enum := Nobody;           -- Record extension of
+    end record;                                          -- record extension.
+ 
+    -- Inherits (inherited) procedure Display from Low_Alert_Type.
+    -- Inherits function Level_Of from Low_Alert_Type.
+ 
+    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum);
+ 
+ 
+ end C390A010;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390A010 is
+ 
+    use F390A00;  -- Alert system abstraction.
+ 
+ 
+    function Level_Of (LA : in Low_Alert_Type) return Integer is
+    begin
+       return (LA.Level + 1);
+    end Level_Of;
+ 
+ 
+    procedure Handle (LA : in out Low_Alert_Type) is
+    begin
+       Handle (Alert_Type (LA));          -- Call parent's op (type conversion).
+       LA.Level := Level_Of (LA);         -- Call newly declared operation.
+       LA.Display_On := Teletype;
+       Display (LA);                      -- Call inherited operation.
+    end Handle;
+ 
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum) is
+    begin
+       MA.Action_Officer := To;
+    end Assign_Officer;
+ 
+ 
+    procedure Handle (MA : in out Medium_Alert_Type) is
+    begin
+       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+       MA.Level := Level_Of (MA);         -- Call inherited operation.
+       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+       MA.Display_On := Console;
+       Display (MA);                      -- Call twice-inherited operation.
+    end Handle;
+ 
+ 
+ end C390A010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a011.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a011.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a011.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a011.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,218 ----
+ -- C390A011.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a nonprivate tagged type declared in a package specification
+ --      may be extended with a record extension in a different package
+ --      specification, and that this record extension may in turn be extended
+ --      by a record extension.
+ --
+ --      Check that each derivative inherits the user-defined primitive
+ --      subprograms of its parent (including those that its parent inherited),
+ --      that it may override these inherited primitive subprograms, and that it
+ --      may also declare its own primitive subprograms.
+ --
+ --      Check that predefined equality operators are defined for the tagged
+ --      type and its derivatives.
+ --
+ --      Check that type conversion is defined from a type extension to its
+ --      parent, and that this parent itself may be a type extension.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type and two associated primitive subprograms
+ --      in a package specification (foundation code).
+ -- 
+ --      Extend the root type with a record extension in a different package
+ --      specification. Declare a new primitive subprogram for the extension,
+ --      and override one of the two inherited subprograms. Within the
+ --      overriding subprogram, utilize type conversion to call the parent's
+ --      implementation of the same subprogram. Also within the overriding
+ --      subprogram, call the new primitive subprogram and each inherited
+ --      subprogram.
+ --      
+ --      Extend the extension with a record extension in the same package
+ --      specification. Declare a new primitive subprogram for this second
+ --      extension, and override one of the three inherited subprograms.
+ --      Within the overriding subprogram, utilize type conversion to call the
+ --      parent's implementation of the same subprogram. Also within the
+ --      overriding subprogram, call the new primitive subprogram and each
+ --      inherited subprogram.
+ -- 
+ --      In the main program, declare objects of the root tagged type
+ --      and the two type extensions. For each object, call the overriding
+ --      subprogram, and verify the correctness of the components by using
+ --      aggregates and equality operators, or by checking the components
+ --      directly.
+ -- 
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F390A00.A
+ --         C390A010.A
+ --      => C390A011.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ 
+ with F390A00;   -- Basic alert abstraction.
+ with C390A010;  -- Extended alert abstraction.
+ 
+ use  F390A00;   -- Primitive operations of Alert_Type directly visible.
+ 
+ with Ada.Calendar;
+ 
+ procedure C390A011 is
+    use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
+ begin
+ 
+    Report.Test ("C390A01", "Primitive operation inheritance by type " &
+                 "extensions: all extensions declared in same package, " &
+                 "but a different package from that of root type");
+ 
+ 
+    ALERT_SUBTEST: -------------------------------------------------------------
+ 
+       declare
+          Alarm : F390A00.Alert_Type;  -- Root tagged type.
+       begin
+ 
+          -- Check "/=" operator availability. Aggregate with positional
+          -- associations:
+          if Alarm /= (Default_Time, Null_Device) then
+             Report.Failed ("Wrong initial values for Alert_Type");
+          end if;
+ 
+          Handle (Alarm);
+ 
+          -- Check "=" operator availability. Aggregate with named
+          -- associations:
+          if not (Alarm = (Arrival_Time => Alert_Time,
+                           Display_On   => Null_Device))
+          then
+             Report.Failed ("Wrong values for Alert_Type after Handle");
+          end if;
+ 
+       end Alert_Subtest;
+ 
+ 
+    -- Check intermediate display counts:
+ 
+    if F390A00.Display_Count_For (Null_Device) /= 1 or
+       F390A00.Display_Count_For (Teletype)    /= 0 or
+       F390A00.Display_Count_For (Console)     /= 0 or
+       F390A00.Display_Count_For (Big_Screen)  /= 0
+    then
+       Report.Failed ("Wrong display counts after Alert_Type");
+    end if;
+ 
+ 
+    LOW_ALERT_SUBTEST: ---------------------------------------------------------
+ 
+       declare
+          Low_Alarm : C390A010.Low_Alert_Type;  -- Extension of tagged type.
+          use C390A010; -- Primitive operations of extension directly visible.
+       begin
+ 
+          -- Check "=" operator availability. Aggregate with positional
+          -- associations:
+          if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
+             Report.Failed ("Wrong initial values for Low_Alert_Type");
+          end if;
+ 
+          Handle (Low_Alarm);
+ 
+          -- Check component availability:
+          if Low_Alarm.Arrival_Time /= Alert_Time or
+             Low_Alarm.Display_On   /= Teletype   or
+             Low_Alarm.Level        /= 1
+          then
+             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+          end if;
+ 
+       end Low_Alert_Subtest;
+ 
+ 
+    -- Check intermediate display counts:
+ 
+    if F390A00.Display_Count_For /= (Null_Device => 2,
+                                     Teletype    => 1,
+                                     Console     => 0,
+                                     Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Low_Alert_Type");
+    end if;
+ 
+ 
+    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+ 
+       declare
+          Medium_Alarm : C390A010.Medium_Alert_Type; -- Extension of extension.
+          use C390A010; -- Primitive operations of extension directly visible.
+       begin
+ 
+          -- Check component availability:
+          if Medium_Alarm.Level          /= 0            or
+             Medium_Alarm.Arrival_Time   /= Default_Time or
+             Medium_Alarm.Action_Officer /= Nobody       or
+             Medium_Alarm.Display_On     /= Null_Device
+          then
+             Report.Failed ("Wrong initial values for Medium_Alert_Type");
+          end if;
+ 
+          Handle (Medium_Alarm);
+ 
+          -- Check "/=" operator availability. Aggregate with named
+          -- associations:
+          if Medium_Alarm /= (Arrival_Time   => Alert_Time,
+                              Display_On     => Console,
+                              Level          => 2,
+                              Action_Officer => Duty_Officer)
+          then
+             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+          end if;
+ 
+       end Medium_Alert_Subtest;
+ 
+ 
+    -- Check final display counts:
+ 
+    if F390A00.Display_Count_For /= (Null_Device => 3,
+                                     Teletype    => 2,
+                                     Console     => 1,
+                                     Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Medium_Alert_Type");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C390A011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a020.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a020.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a020.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C390A020.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C390A022.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C390A022.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F390A00.A
+ --      => C390A020.A
+ --         C390A021.A
+ --         C390A022.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with F390A00;  -- Alert system abstraction.
+ package C390A020 is
+ 
+ 
+    type Low_Alert_Type is new F390A00.Alert_Type with record
+       Level : Integer := 0;                             -- Record extension of
+    end record;                                          -- root tagged type.
+ 
+    -- Inherits procedure Display from Alert_Type.
+ 
+    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                         -- primitive subprog.
+ 
+    function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
+      return Integer;                                    -- all derivatives.
+ 
+ 
+ end C390A020;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390A020 is
+ 
+    use F390A00;  -- Alert system abstraction.
+ 
+ 
+    function Level_Of (LA : in Low_Alert_Type) return Integer is
+    begin
+       return (LA.Level + 1);
+    end Level_Of;
+ 
+ 
+    procedure Handle (LA : in out Low_Alert_Type) is
+    begin
+       Handle (Alert_Type (LA));   -- Call parent's oper. (type conversion).
+       LA.Level := Level_Of (LA);  -- Call newly declared operation.
+       LA.Display_On := Teletype;
+       Display (LA);               -- Call inherited operation.
+    end Handle;
+ 
+ 
+ end C390A020;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a021.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a021.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a021.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- C390A021.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C390A022.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C390A022.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F390A00.A
+ --         C390A020.A
+ --      => C390A021.A
+ --         C390A022.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with C390A020;  -- Extended alert abstraction.
+ package C390A021 is
+ 
+ 
+    -- Declarations used by component Action_Officer;
+ 
+    type Person_Enum is (Nobody,          Duty_Officer,
+                         Watch_Commander, Commanding_Officer);
+ 
+ 
+    type Medium_Alert_Type is new C390A020.Low_Alert_Type
+      with private;                                      -- Private extension of
+                                                         -- record extension.
+ 
+    -- Inherits (inherited) procedure Display from Low_Alert_Type.
+    -- Inherits function Level_Of from Low_Alert_Type.
+ 
+    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum);
+ 
+ 
+    -- The following two functions are needed to verify the values of the
+    -- extension's private components.
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type)
+      return Boolean;
+ 
+    function Bad_Final_Values (MA : in Medium_Alert_Type)
+      return Boolean;
+ 
+ 
+ private
+ 
+    type Medium_Alert_Type is new C390A020.Low_Alert_Type with record
+       Action_Officer : Person_Enum := Nobody;
+    end record;
+ 
+ end C390A021;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F390A00;  -- Basic alert abstraction.
+ use  F390A00;
+ package body C390A021 is
+ 
+    use C390A020;  -- Extended alert abstraction.
+ 
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum) is
+    begin
+       MA.Action_Officer := To;
+    end Assign_Officer;
+ 
+ 
+    procedure Handle (MA : in out Medium_Alert_Type) is
+    begin
+       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+       MA.Level := Level_Of (MA);         -- Call inherited operation.
+       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+       MA.Display_On := Console;
+       Display (MA);                      -- Call twice-inherited operation.
+    end Handle;
+ 
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+    begin
+       return (MA = (Arrival_Time   => Default_Time,      -- Check "=" operator
+                     Display_On     => Null_Device,       -- availability.
+                     Level          => 0,                 -- Aggregate with
+                     Action_Officer => Nobody));          -- named associations.
+    end Initial_Values_Okay;
+ 
+ 
+    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+    begin
+       return (MA /= (Alert_Time, Console,                -- Check "/=" operator
+                      2         , Duty_Officer));         -- availability.
+    end Bad_Final_Values;                                 -- Aggregate with
+                                                          -- positional assoc.
+ 
+ end C390A021;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a022.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a022.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a022.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a022.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,179 ----
+ -- C390A022.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a nonprivate tagged type declared in a package specification
+ --      may be extended with a record extension in a different package
+ --      specification, and that this record extension may in turn be extended
+ --      by a private extension in a third package.
+ --  
+ --      Check that each derivative inherits the user-defined primitive
+ --      subprograms of its parent (including those that its parent inherited),
+ --      that it may override these inherited primitive subprograms, and that it
+ --      may also declare its own primitive subprograms.
+ --
+ --      Check that predefined equality operators are defined for the tagged
+ --      type and its derivatives.
+ --
+ --      Check that type conversion is defined from a type extension to its
+ --      parent, and that this parent itself may be a type extension.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type and two associated primitive subprograms
+ --      in a package specification (foundation code).
+ -- 
+ --      Extend the root type with a record extension in a different package
+ --      specification. Declare a new primitive subprogram for the extension,
+ --      and override one of the two inherited subprograms. Within the
+ --      overriding subprogram, utilize type conversion to call the parent's
+ --      implementation of the same subprogram. Also within the overriding
+ --      subprogram, call the new primitive subprogram and each inherited
+ --      subprogram.
+ --      
+ --      Extend the extension with a private extension in a third package
+ --      specification. Declare a new primitive subprogram for this private
+ --      extension, and override one of the three inherited subprograms.
+ --      Within the overriding subprogram, utilize type conversion to call the
+ --      parent's implementation of the same subprogram. Also within the
+ --      overriding subprogram, call the new primitive subprogram and each
+ --      inherited subprogram.
+ -- 
+ --      Also in the third package, declare two operations of the private
+ --      extension which utilize aggregates and equality operators to verify
+ --      the correctness of the components.
+ --
+ --      In the main program, declare objects of the two extended types.
+ --      For each object, call the overriding subprogram, and verify the
+ --      correctness of the components by using aggregates and equality
+ --      operators, or by checking the components directly, or, for the private
+ --      extension, by calling the verification operations declared in the
+ --      third package.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F390A00.A
+ --         C390A020.A
+ --         C390A021.A
+ --      => C390A022.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ 
+ with F390A00;   -- Basic alert abstraction.
+ with C390A020;  -- Extended alert abstraction.
+ with C390A021;  -- Further extended alert abstraction.
+ 
+ use  F390A00;   -- Primitive operations of Alert_Type directly visible.
+ 
+ with Ada.Calendar;
+ 
+ procedure C390A022 is
+    use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
+ begin
+ 
+    Report.Test ("C390A02", "Primitive operation inheritance by type " &
+                 "extensions: all extensions declared in different " &
+                 "packages; second extension is private");
+ 
+ 
+    -- The case for type F390A00.Alert_Type is tested in C390A01.
+    -- That subtest is not repeated here.
+ 
+ 
+    LOW_ALERT_SUBTEST: ---------------------------------------------------------
+ 
+       declare
+          Low_Alarm : C390A020.Low_Alert_Type;  -- Extension of tagged type.
+          use C390A020; -- Primitive operations of extension directly visible.
+       begin
+ 
+          -- Check "=" operator availability. Aggregate with positional
+          -- associations:
+          if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
+             Report.Failed ("Wrong initial values for Low_Alert_Type");
+          end if;
+ 
+          Handle (Low_Alarm);
+ 
+          -- Check component availability:
+          if Low_Alarm.Arrival_Time /= Alert_Time or
+             Low_Alarm.Display_On   /= Teletype   or
+             Low_Alarm.Level        /= 1
+          then
+             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+          end if;
+       end Low_Alert_Subtest;
+ 
+ 
+    -- Check intermediate display counts:
+ 
+    if F390A00.Display_Count_For /= (Null_Device => 1,
+                                     Teletype    => 1,
+                                     Console     => 0,
+                                     Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Low_Alert_Type");
+    end if;
+ 
+ 
+    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+ 
+       declare
+          Medium_Alarm : C390A021.Medium_Alert_Type; -- Priv. ext. of extension.
+          use C390A021; -- Primitive operations of extension directly visible.
+       begin
+          if not C390A021.Initial_Values_Okay (Medium_Alarm) then
+             Report.Failed ("Wrong initial values for Medium_Alert_Type");
+          end if;
+ 
+          Handle (Medium_Alarm);
+ 
+          if C390A021.Bad_Final_Values (Medium_Alarm) then
+             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+          end if;
+       end Medium_Alert_Subtest;
+ 
+ 
+    -- Check final display counts:
+ 
+    if F390A00.Display_Count_For /= (Null_Device => 2,
+                                     Teletype    => 2,
+                                     Console     => 1,
+                                     Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Medium_Alert_Type");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C390A022;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a030.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a030.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a030.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a030.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,188 ----
+ -- C390A030.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See C390A031.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See C390A031.AM.
+ -- 
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F390A00.A
+ --      => C390A030.A
+ --         C390A031.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with F390A00;  -- Alert system abstraction.
+ package C390A030 is
+ 
+ 
+    type Low_Alert_Type is new F390A00.Alert_Type        -- Private extension of
+      with private;                                      -- root tagged type.
+ 
+    -- Inherits procedure Display from Alert_Type.
+ 
+    procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                         -- primitive subprog.
+ 
+    function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
+      return Integer;                                    -- all derivatives.
+ 
+ 
+    -- The following two functions are needed to verify the values of the
+    -- extension's private components.
+ 
+    function Initial_Values_Okay (LA : in Low_Alert_Type)
+      return Boolean;
+ 
+    function Bad_Final_Values (LA : in Low_Alert_Type)
+      return Boolean;
+ 
+ 
+    -- Declarations used by private extension component.
+ 
+    type Person_Enum is (Nobody,          Duty_Officer,
+                         Watch_Commander, Commanding_Officer);
+ 
+ 
+    type Medium_Alert_Type is new Low_Alert_Type         -- Private extension of
+      with private;                                      -- private extension.
+ 
+    -- Inherits (inherited) procedure Display from Low_Alert_Type.
+    -- Inherits function Level_Of from Low_Alert_Type.
+ 
+    procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                         -- primitive subprog.
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum);
+ 
+ 
+    -- The following two functions are needed to verify the values of the
+    -- extension's private components.
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type)
+      return Boolean;                                    -- Override parent's
+                                                         -- operation.
+ 
+    function Bad_Final_Values (MA : in Medium_Alert_Type)
+      return Boolean;                                    -- Override parent's
+                                                         -- operation.
+ 
+ private
+ 
+    type Low_Alert_Type is new F390A00.Alert_Type with record
+       Level : Integer := 0;
+    end record;
+ 
+ 
+    type Medium_Alert_Type is new Low_Alert_Type with record
+       Action_Officer : Person_Enum := Nobody;
+    end record;
+ 
+ end C390A030;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C390A030 is
+ 
+    use F390A00;  -- Alert system abstraction.
+ 
+ 
+    function Level_Of (LA : in Low_Alert_Type) return Integer is
+    begin
+       return (LA.Level + 1);
+    end Level_Of;
+ 
+ 
+    procedure Handle (LA : in out Low_Alert_Type) is
+    begin
+       Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
+       LA.Level := Level_Of (LA);  -- Call newly declared operation.
+       LA.Display_On := Teletype;
+       Display (LA);               -- Call inherited operation.
+    end Handle;
+ 
+ 
+    function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
+    begin
+       return (LA = (Arrival_Time   => Default_Time,      -- Check "=" operator
+                     Display_On     => Null_Device,       -- availability.
+                     Level          => 0));               -- Aggregate with
+    end Initial_Values_Okay;                              -- named associations.
+ 
+ 
+    function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
+    begin
+       return (LA /= (Alert_Time, Teletype, 1));          -- Check "/=" operator
+                                                          -- availability.
+    end Bad_Final_Values;                                 -- Aggregate with
+                                                          -- positional assoc.
+ 
+    procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                              To : in     Person_Enum) is
+    begin
+       MA.Action_Officer := To;
+    end Assign_Officer;
+ 
+ 
+    procedure Handle (MA : in out Medium_Alert_Type) is
+    begin
+       Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+       MA.Level := Level_Of (MA);         -- Call inherited operation.
+       Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+       MA.Display_On := Console;
+       Display (MA);                      -- Call twice-inherited operation.
+    end Handle;
+ 
+ 
+    function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+    begin
+       -- Call parent's operation (type conversion).
+       return (Initial_Values_Okay (Low_Alert_Type (MA)) and
+               MA.Action_Officer = Nobody);
+    end Initial_Values_Okay;
+ 
+ 
+    function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+    begin
+       return not (MA = (Arrival_Time   => Alert_Time,    -- Check "=" operator
+                         Display_On     => Console,       -- availability.
+                         Level          => 2,             -- Aggregate with
+                         Action_Officer => Duty_Officer));-- named associations.
+    end Bad_Final_Values;
+ 
+ 
+ end C390A030;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a031.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a031.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c390a031.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c390a031.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,167 ----
+ -- C390A031.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a nonprivate tagged type declared in a package specification
+ --      may be extended with a private extension in a different package
+ --      specification, and that this private extension may in turn be extended
+ --      by a private extension.
+ --
+ --      Check that each derivative inherits the user-defined primitive
+ --      subprograms of its parent (including those that its parent inherited),
+ --      that it may override these inherited primitive subprograms, and that it
+ --      may also declare its own primitive subprograms.
+ --
+ --      Check that predefined equality operators are defined for the tagged
+ --      type and its derivatives.
+ --
+ --      Check that type conversion is defined from a type extension to its
+ --      parent, and that this parent itself may be a type extension.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type and two associated primitive subprograms
+ --      in a package specification (foundation code).
+ -- 
+ --      Extend the root type with a private extension in a different package
+ --      specification. Declare a new primitive subprogram for the extension,
+ --      and override one of the two inherited subprograms. Within the
+ --      overriding subprogram, utilize type conversion to call the parent's
+ --      implementation of the same subprogram. Also within the overriding
+ --      subprogram, call the new primitive subprogram and each inherited
+ --      subprogram. Declare operations of the private extension which utilize
+ --      aggregates and equality operators to verify the correctness of the
+ --      components.
+ --      
+ --      Extend the extension with a private extension in the same package
+ --      specification. Declare a new primitive subprogram for this second
+ --      extension, and override one of the three inherited subprograms.
+ --      Within the overriding subprogram, utilize type conversion to call the
+ --      parent's implementation of the same subprogram. Also within the
+ --      overriding subprogram, call the new primitive subprogram and each
+ --      inherited subprogram. Declare operations of the private extension
+ --      which override the verification operations of its parent. Within
+ --      these overriding operations, utilize type conversion to call the
+ --      parent's implementations of the same operations.
+ -- 
+ --      In the main program, declare objects of the two extended types.
+ --      For each object, call the overriding subprogram, and verify the
+ --      correctness of the components by calling the verification operations
+ --      declared in the second package.
+ -- 
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         F390A00.A
+ --         C390A030.A
+ --      => C390A031.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ 
+ with F390A00;  -- Basic alert abstraction.
+ with C390A030; -- Extended alert abstraction.
+ 
+ use  F390A00;  -- Primitive operations of Alert_Type directly visible.
+ 
+ procedure C390A031 is
+ begin
+ 
+    Report.Test ("C390A03", "Primitive operation inheritance by type " &
+                 "extensions: all extensions are private and declared " &
+                 "in same package, but a different package from that " &
+                 "of root type");
+ 
+ 
+    -- The case for type F390A00.Alert_Type is tested in C390A01.
+    -- That subtest is not repeated here.
+ 
+ 
+    LOW_ALERT_SUBTEST: ---------------------------------------------------------
+ 
+       declare
+          Low_Alarm : C390A030.Low_Alert_Type;  -- Priv. ext. of tagged type.
+          use C390A030; -- Primitive operations of extension directly visible.
+       begin
+          if not C390A030.Initial_Values_Okay (Low_Alarm) then
+             Report.Failed ("Wrong initial values for Low_Alert_Type");
+          end if;
+ 
+          Handle (Low_Alarm);
+ 
+          if C390A030.Bad_Final_Values (Low_Alarm) then
+             Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+          end if;
+       end Low_Alert_Subtest;
+ 
+ 
+    -- Check intermediate display counts:
+ 
+    if F390A00.Display_Count_For /= (Null_Device => 1,
+                                     Teletype    => 1,
+                                     Console     => 0,
+                                     Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Low_Alert");
+    end if;
+ 
+ 
+    MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+ 
+       declare
+          Medium_Alarm : C390A030.Medium_Alert_Type; -- Priv. ext. of extension.
+          use C390A030; -- Primitive operations of extension directly visible.
+       begin
+          if not C390A030.Initial_Values_Okay (Medium_Alarm) then
+             Report.Failed ("Wrong initial values for Medium_Alert_Type");
+          end if;
+ 
+          Handle (Medium_Alarm);
+ 
+          if C390A030.Bad_Final_Values (Medium_Alarm) then
+             Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+          end if;
+       end Medium_Alert_Subtest;
+ 
+ 
+    -- Check final display counts:
+ 
+    if F390A00.Display_Count_For /= (Null_Device => 2,
+                                     Teletype    => 2,
+                                     Console     => 1,
+                                     Big_Screen  => 0)
+    then
+       Report.Failed ("Wrong display counts after Medium_Alert_Type");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C390A031;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c391001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c391001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c391001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c391001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,329 ----
+ -- C391001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that structures nesting discriminated records as
+ --      components in record extension are correctly supported.  Check
+ --      for this using limited private structures.
+ --      Check that record extensions inherit all the visible components
+ --      of their ancestor types. 
+ --      Check that discriminants are correctly inherited.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines a textbook object, a serial number plaque.
+ --      This object is used in each of several other structures modeled
+ --      after those used in an existing antenna modeling software system.
+ --      Record types discriminated and undiscriminated are nested to
+ --      produce a layered design.  Some parametrization is programmatic;
+ --      some parametrization is data-driven.
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --      19 Apr 95   SAIC    Added "limited" to full type def of "Object"
+ --
+ --!
+  
+  package C391001_1 is 
+    type Object is tagged limited private;
+    -- Constructor operation
+    procedure Create( The_Plaque : in out Object );
+    -- Selector operations
+    function "="( Left_Plaque,Right_Plaque : Object ) return Boolean;
+    function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+      return Boolean;
+    function Serial_Number( A_Plaque : Object ) return Natural;
+    Unserialized : exception;  -- Serial_Number called before Create
+    Reserialized : exception;  -- Create called twice
+  private
+    type Object is tagged limited record
+      Serial_Number : Natural := 0;
+    end record;
+  end C391001_1;
+  
+  package body C391001_1 is
+    Counter : Natural := 0;
+    procedure Create( The_Plaque : in out Object ) is
+    begin
+      if The_Plaque.Serial_Number = 0 then
+        Counter := Counter +1;
+        The_Plaque.Serial_Number := Counter;
+      else
+        raise Reserialized;
+      end if;
+    end Create;
+  
+    function "="( Left_Plaque,Right_Plaque : Object ) return Boolean is
+    begin
+      return (Left_Plaque.Serial_Number = Right_Plaque.Serial_Number)
+             and then -- two uninitialized plates are unequal
+               (Left_Plaque.Serial_Number /= 0);
+    end "=";
+  
+    function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+      return Boolean is
+    begin
+      return (Left_Plaque.Serial_Number = Right_Natural);
+    end TC_Match;
+  
+    function Serial_Number( A_Plaque : Object ) return Natural is
+    begin
+      if A_Plaque.Serial_Number = 0 then
+        raise Unserialized;
+      end if;
+      return A_Plaque.Serial_Number;
+    end Serial_Number;
+  end C391001_1;
+  
+  with C391001_1;
+  package C391001_2 is -- package Boards is
+  
+    package Plaque renames C391001_1;
+  
+    type Modes is (Receiving, Transmitting, Standby);
+    type Link(Mode: Modes := Standby) is record
+      case Mode is
+        when Receiving    => TC_R : Integer := 100; 
+        when Transmitting => TC_T : Integer := 200;
+        when Standby      => TC_S : Integer := 300; -- TGA, TSA, SSA
+      end case;
+    end record;
+  
+    type Data_Formats is (S_Band, KU_Band, UHF);
+  
+  
+    type Transceiver(Band: Data_Formats) is tagged limited record
+      ID : Plaque.Object;
+      The_Link: Link;
+      case Band is
+        when S_Band  => TC_S_Band_Data  : Integer := 1; -- TGA, SSA
+        when KU_Band => TC_KU_Band_Data : Integer := 2; -- TSA
+        when UHF     => TC_UHF_Data     : Integer := 3;
+      end case;
+    end record;
+  end C391001_2;
+  
+  with C391001_1;
+  with C391001_2;
+  package C391001_3 is -- package Modules
+    package Plaque renames C391001_1;
+    package Boards renames C391001_2;
+    use type Boards.Modes;
+    use type Boards.Data_Formats;
+  
+    type Command_Formats is ( Set_Compression_Code,
+                              Set_Data_Rate,
+                              Set_Power_State );
+  
+    type Electronics_Module(EBand             : Boards.Data_Formats;
+                            The_Command_Format: Command_Formats)
+      is new Boards.Transceiver(EBand) with record
+        case The_Command_Format is
+          when Set_Compression_Code => TC_SCC : Integer := 10; -- SSA
+          when Set_Data_Rate        => TC_SDR : Integer := 20; -- TGA
+          when Set_Power_State      => TC_SPS : Integer := 30; -- TSA
+        end case;
+      end record;
+  end C391001_3;
+  
+  with Report;
+  with C391001_1;
+  with C391001_2;
+  with C391001_3;
+  procedure C391001 is
+    package Plaque  renames C391001_1;
+    package Boards  renames C391001_2;
+    package Modules renames C391001_3;
+    use type Boards.Modes;
+    use type Boards.Data_Formats;
+    use type Modules.Command_Formats;
+  
+    type Azimuth is range 0..359;
+  
+    type Ground_Antenna(The_Band          : Boards.Data_Formats;
+                        The_Command_Format: Modules.Command_Formats) is
+      record
+        ID          : Plaque.Object;
+        Electronics : Modules.Electronics_Module(The_Band,The_Command_Format);
+        Pointing    : Azimuth;
+      end record;
+  
+    type Space_Antenna(The_Band    : Boards.Data_Formats := Boards.KU_Band;
+                       The_Command : Modules.Command_Formats
+                                     := Modules.Set_Power_State)
+    is
+      record
+        ID          : Plaque.Object;
+        Electronics : Modules.Electronics_Module(The_Band,The_Command);
+      end record;
+  
+    The_Ground_Antenna     : Ground_Antenna (Boards.S_Band,
+                                             Modules.Set_Data_Rate);
+    The_Space_Antenna      : Space_Antenna;
+    Space_Station_Antenna  : Space_Antenna  (Boards.S_Band,
+                                             Modules.Set_Compression_Code);
+  
+  
+    procedure Validate( Condition : Boolean; Message: String ) is
+    begin
+      if not Condition then
+        Report.Failed("Failed " & Message );
+      end if;
+    end Validate;
+  
+  begin
+    Report.Test("C391001", "Check nested tagged discriminated "
+                         & "record structures");
+  
+    Plaque.Create( The_Ground_Antenna.ID );               -- 1
+    Plaque.Create( The_Ground_Antenna.Electronics.ID );   -- 2
+    Plaque.Create( The_Space_Antenna.ID );                -- 3
+    Plaque.Create( The_Space_Antenna.Electronics.ID );    -- 4
+    Plaque.Create( Space_Station_Antenna.ID );            -- 5
+    Plaque.Create( Space_Station_Antenna.Electronics.ID );-- 6
+  
+    The_Ground_Antenna.Pointing := 180;
+    Validate( The_Ground_Antenna.The_Band = Boards.S_Band, "TGA discr 1" );
+    Validate( The_Ground_Antenna.The_Command_Format = Modules.Set_Data_Rate,
+              "TGA discr 2" );
+    Validate( Plaque.TC_Match(The_Ground_Antenna.ID,1), "TGA comp 1" );
+    Validate( The_Ground_Antenna.Electronics.EBand = Boards.S_Band,
+              "TGA comp 2.discr 1" );
+    Validate( The_Ground_Antenna.Electronics.The_Command_Format
+              = Modules.Set_Data_Rate, "TGA comp 2.discr 2" );
+    Validate( The_Ground_Antenna.Electronics.TC_SDR = 20,
+              "TGA comp 2.1" );
+    Validate( Plaque.TC_Match( The_Ground_Antenna.Electronics.ID, 2 ),
+              "TGA comp 2.inher.1" );
+    Validate( The_Ground_Antenna.Electronics.The_Link.Mode = Boards.Standby,
+              "TGA comp 2.inher.2.discr" );
+    Validate( The_Ground_Antenna.Electronics.The_Link.TC_S = 300,
+              "TGA comp 2.inher.2.1" );
+    Validate( The_Ground_Antenna.Electronics.TC_S_Band_Data = 1,
+              "TGA comp 2.inher.3" );
+    Validate( The_Ground_Antenna.Pointing = 180, "TGA comp 3" );
+  
+    Validate( The_Space_Antenna.The_Band = Boards.KU_Band, "TSA discr 1");
+    Validate( The_Space_Antenna.The_Command = Modules.Set_Power_State,
+              "TSA discr 2");
+    Validate( Plaque.TC_Match(The_Space_Antenna.ID,3),
+              "TSA comp 1");
+    Validate( The_Space_Antenna.Electronics.EBand = Boards.KU_Band,
+              "TSA comp 2.discr 1");
+    Validate( The_Space_Antenna.Electronics.The_Command_Format
+              = Modules.Set_Power_State,  "TSA comp 2.discr 2");
+    Validate( Plaque.TC_Match(The_Space_Antenna.Electronics.ID,4),
+              "TSA comp 2.inher.1");
+    Validate( The_Space_Antenna.Electronics.The_Link.Mode = Boards.Standby,
+              "TSA comp 2.inher.2.discr");
+    Validate( The_Space_Antenna.Electronics.The_Link.TC_S = 300,
+              "TSA comp 2.inher.2.1");
+    Validate( The_Space_Antenna.Electronics.TC_KU_Band_Data = 2,
+              "TSA comp 2.inher.3");
+    Validate( The_Space_Antenna.Electronics.TC_SPS = 30,
+              "TSA comp 2.1");
+  
+    Validate( Space_Station_Antenna.The_Band = Boards.S_Band, "SSA discr 1");
+    Validate( Space_Station_Antenna.The_Command = Modules.Set_Compression_Code,
+              "SSA discr 2");
+    Validate( Plaque.TC_Match(Space_Station_Antenna.ID,5),
+              "SSA comp 1");
+    Validate( Space_Station_Antenna.Electronics.EBand = Boards.S_Band,
+              "SSA comp 2.discr 1");
+    Validate( Space_Station_Antenna.Electronics.The_Command_Format
+              = Modules.Set_Compression_Code,  "SSA comp 2.discr 2");
+    Validate( Plaque.TC_Match(Space_Station_Antenna.Electronics.ID,6),
+              "SSA comp 2.inher.1");
+    Validate( Space_Station_Antenna.Electronics.The_Link.Mode = Boards.Standby,
+              "SSA comp 2.inher.2.discr");
+    Validate( Space_Station_Antenna.Electronics.The_Link.TC_S = 300,
+              "SSA comp 2.inher.2.1");
+    Validate( Space_Station_Antenna.Electronics.TC_S_Band_Data = 1,
+              "SSA comp 2.inher.3");
+    Validate( Space_Station_Antenna.Electronics.TC_SCC = 10,
+              "SSA comp 2.1");
+  
+    The_Ground_Antenna.Electronics.TC_SDR         := 1001;
+    The_Ground_Antenna.Electronics.The_Link       :=
+ (Boards.Transmitting,2001);
+    The_Ground_Antenna.Electronics.TC_S_Band_Data := 3001;
+    The_Ground_Antenna.Pointing                   :=   41;
+  
+    The_Space_Antenna.Electronics.The_Link        := (Boards.Receiving,1010);
+    The_Space_Antenna.Electronics.TC_KU_Band_Data := 2020;
+    The_Space_Antenna.Electronics.TC_SPS          := 3030;
+  
+    Space_Station_Antenna.Electronics.The_Link
+      := The_Space_Antenna.Electronics.The_Link;
+    Space_Station_Antenna.Electronics.The_Link.TC_R  := 111;
+    Space_Station_Antenna.Electronics.TC_S_Band_Data := 222;
+    Space_Station_Antenna.Electronics.TC_SCC         := 333;
+  
+  ----------------------------------------------------------------------
+    begin -- should fail discriminant check
+      The_Ground_Antenna.Electronics.TC_SCC := 909;
+      Report.Failed("Discriminant check, no exception");
+    exception
+      when Constraint_Error => null;
+      when others =>
+           Report.Failed("Discriminant check, wrong exception");
+    end;
+  
+    Validate( The_Ground_Antenna.Electronics.TC_SDR         = 1001,
+              "assigned value 1");
+    Validate( The_Ground_Antenna.Electronics.The_Link.Mode
+                                             = Boards.Transmitting,
+              "assigned value 2.1");
+    Validate( The_Ground_Antenna.Electronics.The_Link.TC_T  = 2001,
+              "assigned value 2.2");
+    Validate( The_Ground_Antenna.Electronics.TC_S_Band_Data = 3001,
+              "assigned value 3");
+    Validate( The_Ground_Antenna.Pointing                   =   41,
+              "assigned value 4");
+  
+    Validate( The_Space_Antenna.Electronics.The_Link.Mode   = Boards.Receiving,
+              "assigned value 5.1");
+    Validate( The_Space_Antenna.Electronics.The_Link.TC_R   = 1010,
+              "assigned value 5.2");
+    Validate( The_Space_Antenna.Electronics.TC_KU_Band_Data = 2020,
+              "assigned value 6");
+    Validate( The_Space_Antenna.Electronics.TC_SPS          = 3030,
+              "assigned value 7");
+  
+    Validate( Space_Station_Antenna.Electronics.The_Link.Mode
+                                                  = Boards.Receiving,
+              "assigned value 8.1");
+    Validate( Space_Station_Antenna.Electronics.The_Link.TC_R  = 111,
+              "assigned value 8.2");
+    Validate( Space_Station_Antenna.Electronics.TC_S_Band_Data = 222,
+              "assigned value 9");
+    Validate( Space_Station_Antenna.Electronics.TC_SCC         = 333,
+              "assigned value 10");
+  
+    Report.Result;
+  
+ end C391001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c391002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c391002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c391002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c391002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,493 ----
+ -- C391002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that structures nesting discriminated records as
+ --      components in record extension are correctly supported.
+ --      Check that record extensions inherit all the visible components
+ --      of their ancestor types.
+ --      Check that discriminants are correctly inherited.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines a simple class hierarchy, where the final
+ --      derivations exercise the different possible "permissions" available
+ --      to a designer.  Extension aggregates for discriminated types are used
+ --      to set values of these final types.  The key difference between
+ --      this test and C391001 is that the types are visible, and allow the
+ --      creation of complex discriminated extension aggregates.  Another
+ --      layer of derivation is present to more robustly check that the
+ --      inheritance is correctly supported.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Dec 94   SAIC    Removed offending parenthesis in aggregate
+ --                          extensions, corrected typo: TC_MC SB TC_PC,
+ --                          corrected visibility errors for literals,
+ --                          added qualification for aggregate expressions
+ --                          used in extension aggregates, corrected parameter
+ --                          order in call to Communications.Creator
+ --     01 MAY 95    SAIC    Removed "limited" from the definition of Mil_Comm
+ --     14 OCT 95    SAIC    Fixed some value bugs for ACVC 2.0.1
+ --     04 MAR 96    SAIC    Altered 3 overambitious extension aggregates
+ --     11 APR 96    SAIC    Updated documentation for 2.1
+ --     27 FEB 97    PWB.CTA Deleted extra (illegal) component association
+ --!
+ 
+ ----------------------------------------------------------------- C391002_1
+ 
+ package C391002_1 is 
+ 
+   type Object is tagged private;  
+ 
+   -- Constructor operation
+   procedure Create( The_Plaque : in out Object );
+ 
+   -- Selector operations
+   function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+     return Boolean;
+ 
+   function Serial_Number( A_Plaque : Object ) return Natural;
+ 
+   Unserialized : exception;  -- Serial_Number called before Create
+   Reserialized : exception;  -- Create called twice
+ 
+ private
+   type Object is tagged record
+     Serial_Number : Natural := 0;
+   end record;
+ end C391002_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C391002_1 is
+ 
+   Counter : Natural := 0;
+ 
+   procedure Create( The_Plaque : in out Object ) is
+   begin
+     if The_Plaque.Serial_Number = 0 then
+       Counter := Counter +1;
+       The_Plaque.Serial_Number := Counter;
+     else
+       raise Reserialized;
+     end if;
+   end Create;
+ 
+   function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+     return Boolean is
+   begin
+     return (Left_Plaque.Serial_Number = Right_Natural);
+   end TC_Match;
+ 
+   function Serial_Number( A_Plaque : Object ) return Natural is
+   begin
+     if A_Plaque.Serial_Number = 0 then
+       raise Unserialized;
+     end if;
+     return A_Plaque.Serial_Number;
+   end Serial_Number;
+ end C391002_1;
+ 
+ ----------------------------------------------------------------- C391002_2
+ 
+ with C391002_1;
+ package C391002_2 is -- package Boards is
+ 
+   package Plaque renames C391002_1;
+ 
+   type Modes is (Receiving, Transmitting, Standby);
+   type Link(Mode: Modes := Standby) is record
+     case Mode is
+       when Receiving    => TC_R : Integer := 100; 
+       when Transmitting => TC_T : Integer := 200;
+       when Standby      => TC_S : Integer := 300; -- TGA, TSA, SSA
+     end case;
+   end record;
+ 
+   type Data_Formats is (S_Band, KU_Band, UHF);
+ 
+   type Transceiver(Band: Data_Formats) is tagged record
+     ID : Plaque.Object;
+     The_Link: Link;
+     case Band is
+       when S_Band  => TC_S_Band_Data  : Integer := 1; -- TGA, SSA, Milnet
+       when KU_Band => TC_KU_Band_Data : Integer := 2; -- TSA, Usenet
+       when UHF     => TC_UHF_Data     : Integer := 3; -- Gossip
+     end case;
+   end record;
+ end C391002_2;
+ 
+ ----------------------------------------------------------------- C391002_3
+ 
+ with C391002_1;
+ with C391002_2;
+ package C391002_3 is -- package Modules
+ 
+   package Plaque renames C391002_1;
+   package Boards renames C391002_2;
+   use type Boards.Modes;
+   use type Boards.Data_Formats;
+ 
+   type Command_Formats is ( Set_Compression_Code,
+                             Set_Data_Rate,
+                             Set_Power_State );
+ 
+   type Electronics_Module(EBand       : Boards.Data_Formats;
+                           The_Command : Command_Formats)
+     is new Boards.Transceiver(EBand) with record
+       case The_Command is
+         when Set_Compression_Code => TC_SCC : Integer := 10; -- SSA, Gossip
+         when Set_Data_Rate        => TC_SDR : Integer := 20; -- TGA, Usenet
+         when Set_Power_State      => TC_SPS : Integer := 30; -- TSA, Milnet
+       end case;
+     end record;
+ end C391002_3;
+ 
+ ----------------------------------------------------------------- C391002_4
+ 
+ with C391002_3;
+ package C391002_4 is -- Communications
+   package Modules renames C391002_3;
+ 
+   type Public_Comm is new Modules.Electronics_Module with
+     record
+       TC_VC : Integer;
+     end record;
+ 
+   type Private_Comm is new Modules.Electronics_Module with private;
+ 
+   type Mil_Comm is new Modules.Electronics_Module with private;
+ 
+   procedure Creator( Plugs : in Modules.Electronics_Module;
+                      Gives : out Mil_Comm);
+ 
+   function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
+             return Private_Comm;
+ 
+   procedure Setup( It : in out Public_Comm;  Value : in Integer );
+   procedure Setup( It : in out Private_Comm; Value : in Integer );
+   procedure Setup( It : in out Mil_Comm;     Value : in Integer );
+ 
+   function  Selector( It : Public_Comm )  return Integer;
+   function  Selector( It : Private_Comm ) return Integer;
+   function  Selector( It : Mil_Comm )     return Integer;
+ 
+ private
+   type Private_Comm is new Modules.Electronics_Module with
+     record
+       TC_PC : Integer;
+     end record;
+ 
+   type Mil_Comm is new Modules.Electronics_Module with 
+     record
+       TC_MC : Integer;
+     end record;
+ end C391002_4; -- Communications
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with TCTouch;
+ package body C391002_4 is -- Communications
+ 
+   procedure Creator( Plugs : in Modules.Electronics_Module;
+                      Gives : out Mil_Comm) is
+   begin
+     Gives := ( Plugs with TC_MC => -1 );
+   end Creator;
+ 
+   function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
+             return Private_Comm is
+   begin
+     return ( Plugs with TC_PC => Key );
+   end Creator;
+ 
+   procedure Setup( It : in out Public_Comm; Value : in Integer ) is
+   begin
+     It.TC_VC := Value;
+     TCTouch.Assert( Value = 1, "Public_Comm");
+   end Setup;
+ 
+   procedure Setup( It : in out Private_Comm; Value : in Integer ) is
+   begin
+     It.TC_PC := Value;
+     TCTouch.Assert( Value = 2, "Private_Comm");
+   end Setup;
+ 
+   procedure Setup( It : in out Mil_Comm; Value : in Integer ) is
+   begin
+     It.TC_MC := Value;
+     TCTouch.Assert( Value = 3, "Private_Comm");
+   end Setup;
+ 
+   function  Selector( It : Public_Comm )  return Integer is
+   begin
+     return It.TC_VC;
+   end Selector;
+ 
+   function  Selector( It : Private_Comm ) return Integer is
+   begin
+     return It.TC_PC;
+   end Selector;
+ 
+   function  Selector( It : Mil_Comm )     return Integer is
+   begin
+     return It.TC_MC;
+   end Selector;
+ 
+ end C391002_4; -- Communications
+ 
+ ------------------------------------------------------------------- C391002
+ 
+ with Report;
+ with TCTouch;
+ with C391002_1;
+ with C391002_2;
+ with C391002_3;
+ with C391002_4;
+ procedure C391002 is
+ 
+   package Plaque  renames C391002_1;
+   package Boards  renames C391002_2;
+   package Modules renames C391002_3;
+   package Communications renames C391002_4;
+ 
+   procedure Assert( Condition: Boolean; Message: String )
+     renames TCTouch.Assert;
+ 
+   use type Boards.Modes;
+   use type Boards.Data_Formats;
+   use type Modules.Command_Formats;
+ 
+   type Azimuth is range 0..359;
+ 
+   type Ground_Antenna(The_Band    : Boards.Data_Formats;
+                       The_Command : Modules.Command_Formats) is
+     record
+       ID          : Plaque.Object;
+       Electronics : Modules.Electronics_Module(The_Band,The_Command);
+       Pointing    : Azimuth;
+     end record;
+ 
+   type Space_Antenna(The_Band    : Boards.Data_Formats    := Boards.KU_Band;
+                      The_Command : Modules.Command_Formats
+                                    := Modules.Set_Power_State)
+   is
+     record
+       ID          : Plaque.Object;
+       Electronics : Modules.Electronics_Module(The_Band,The_Command);
+     end record;
+ 
+   The_Ground_Antenna     : Ground_Antenna (Boards.S_Band,
+                                            Modules.Set_Data_Rate);
+   The_Space_Antenna      : Space_Antenna;
+   Space_Station_Antenna  : Space_Antenna  (Boards.UHF,
+                                            Modules.Set_Compression_Code);
+ 
+   Gossip : Communications.Public_Comm  (Boards.UHF,
+                                         Modules.Set_Compression_Code);
+   Usenet : Communications.Private_Comm (Boards.KU_Band,
+                                         Modules.Set_Data_Rate);
+   Milnet : Communications.Mil_Comm     (Boards.S_Band,
+                                         Modules.Set_Power_State);
+ 
+ 
+ begin
+ 
+   Report.Test("C391002", "Check nested tagged discriminated"
+                        & " record structures");
+ 
+   Plaque.Create( The_Ground_Antenna.ID );               -- 1
+   Plaque.Create( The_Ground_Antenna.Electronics.ID );   -- 2
+   Plaque.Create( The_Space_Antenna.ID );                -- 3
+   Plaque.Create( The_Space_Antenna.Electronics.ID );    -- 4
+   Plaque.Create( Space_Station_Antenna.ID );            -- 5
+   Plaque.Create( Space_Station_Antenna.Electronics.ID );-- 6
+ 
+   The_Ground_Antenna := ( The_Band    => Boards.S_Band,
+                           The_Command => Modules.Set_Data_Rate,
+                           ID          => The_Ground_Antenna.ID,
+                           Electronics =>
+                           ( Boards.Transceiver'(
+                               Band     => Boards.S_Band,
+                               ID       => The_Ground_Antenna.Electronics.ID,
+                               The_Link => ( Mode => Boards.Transmitting,
+                                             TC_T => 222 ),
+                               TC_S_Band_Data => 8 )
+                             with   EBand       => Boards.S_Band,
+                                    The_Command => Modules.Set_Data_Rate,
+                                    TC_SDR      => 11 ),
+                           Pointing    => 270 );
+ 
+   The_Space_Antenna := ( The_Band    => Boards.S_Band,
+                          The_Command => Modules.Set_Data_Rate,
+                          ID          => The_Space_Antenna.ID,
+                          Electronics =>
+                          ( Boards.Transceiver'(
+                              Band     => Boards.S_Band,
+                              ID       => The_Space_Antenna.Electronics.ID,
+                              The_Link => ( Mode => Boards.Transmitting,
+                                            TC_T => 456 ),
+                              TC_S_Band_Data => 88 )
+                            with
+                                EBand       => Boards.S_Band,
+                                The_Command => Modules.Set_Data_Rate,
+                                TC_SDR      => 42
+                         ) );
+ 
+   Space_Station_Antenna := ( Boards.UHF, Modules.Set_Compression_Code,
+                              Space_Station_Antenna.ID,
+                              ( Boards.Transceiver'(
+                                  Boards.UHF,
+                                  Space_Station_Antenna.Electronics.ID,
+                                  ( Boards.Transmitting, 202 ),
+                                  42 )
+                                  with Boards.UHF, 
+                                       Modules.Set_Compression_Code,
+                                       TC_SCC => 101
+                            ) );
+ 
+   Assert( The_Ground_Antenna.The_Band = Boards.S_Band, "TGA disc 1" );
+   Assert( The_Ground_Antenna.The_Command = Modules.Set_Data_Rate,
+             "TGA disc 2" );
+   Assert( Plaque.TC_Match(The_Ground_Antenna.ID,1), "TGA comp 3" );
+   Assert( The_Ground_Antenna.Electronics.EBand = Boards.S_Band,
+             "TGA comp 2.disc 1" );
+   Assert( The_Ground_Antenna.Electronics.The_Command
+              = Modules.Set_Data_Rate,
+             "TGA comp 2.disc 2" );
+   Assert( The_Ground_Antenna.Electronics.TC_SDR = 11,
+             "TGA comp 2.1" );
+   Assert( Plaque.TC_Match( The_Ground_Antenna.Electronics.ID, 2 ),
+             "TGA comp 2.inher.1" );
+   Assert( The_Ground_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
+             "TGA comp 2.inher.2.disc" );
+   Assert( The_Ground_Antenna.Electronics.The_Link.TC_T = 222,
+             "TGA comp 2.inher.2.1" );
+   Assert( The_Ground_Antenna.Electronics.TC_S_Band_Data = 8,
+             "TGA comp 2.inher.3" );
+   Assert( The_Ground_Antenna.Pointing = 270, "TGA comp 3" );
+ 
+   Assert( The_Space_Antenna.The_Band = Boards.S_Band, "TSA disc 1");
+   Assert( The_Space_Antenna.The_Command = Modules.Set_Data_Rate,
+             "TSA disc 2");
+   Assert( Plaque.TC_Match(The_Space_Antenna.ID,3),
+             "TSA comp 1");
+   Assert( The_Space_Antenna.Electronics.EBand = Boards.S_Band,
+             "TSA comp 2.disc 1");
+   Assert( The_Space_Antenna.Electronics.The_Command = Modules.Set_Data_Rate,
+             "TSA comp 2.disc 2");
+   Assert( The_Space_Antenna.Electronics.TC_SDR = 42,
+             "TSA comp 2.1");
+   Assert( Plaque.TC_Match(The_Space_Antenna.Electronics.ID,4),
+             "TSA comp 2.inher.1");
+   Assert( The_Space_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
+             "TSA comp 2.inher.2.disc");
+   Assert( The_Space_Antenna.Electronics.The_Link.TC_T = 456,
+             "TSA comp 2.inher.2.1");
+   Assert( The_Space_Antenna.Electronics.TC_S_Band_Data = 88,
+             "TSA comp 2.inher.3");
+ 
+   Assert( Space_Station_Antenna.The_Band = Boards.UHF, "SSA disc 1");
+   Assert( Space_Station_Antenna.The_Command = Modules.Set_Compression_Code,
+             "SSA disc 2");
+   Assert( Plaque.TC_Match(Space_Station_Antenna.ID,5),
+             "SSA comp 1");
+   Assert( Space_Station_Antenna.Electronics.EBand = Boards.UHF,
+             "SSA comp 2.disc 1");
+   Assert( Space_Station_Antenna.Electronics.The_Command
+              = Modules.Set_Compression_Code,
+             "SSA comp 2.disc 2");
+   Assert( Space_Station_Antenna.Electronics.TC_SCC = 101,
+             "SSA comp 2.1");
+   Assert( Plaque.TC_Match(Space_Station_Antenna.Electronics.ID,6),
+             "SSA comp 2.inher.1");
+   Assert( Space_Station_Antenna.Electronics.The_Link.Mode
+             = Boards.Transmitting,
+             "SSA comp 2.inher.2.disc");
+   Assert( Space_Station_Antenna.Electronics.The_Link.TC_T = 202,
+             "SSA comp 2.inher.2.1");
+   Assert( Space_Station_Antenna.Electronics.TC_UHF_Data = 42,
+             "SSA comp 2.inher.3");
+ 
+ 
+   The_Space_Antenna := ( The_Band    => Boards.S_Band,
+                          The_Command => Modules.Set_Power_State,
+                          ID          => The_Space_Antenna.ID,
+                          Electronics =>
+                          ( Boards.Transceiver'(
+                              Band     => Boards.S_Band,
+                              ID       => The_Space_Antenna.Electronics.ID,
+                              The_Link => ( Mode => Boards.Transmitting,
+                                            TC_T => 1 ),
+                              TC_S_Band_Data => 5 )
+                            with
+                                EBand       => Boards.S_Band,
+                                The_Command => Modules.Set_Power_State,
+                                TC_SPS      => 101
+                         ) );
+ 
+   Communications.Creator( The_Space_Antenna.Electronics, Milnet );
+   Assert( Communications.Selector( Milnet ) = -1, "Milnet creator" );
+ 
+   Usenet := Communications.Creator( -2, 
+                      ( Boards.Transceiver'(
+                          Band        => Boards.KU_Band,
+                          ID          => The_Space_Antenna.Electronics.ID,
+                          The_Link    => ( Boards.Transmitting, TC_T => 101 ),
+                          TC_KU_Band_Data => 395 )
+                     with Boards.KU_Band, Modules.Set_Data_Rate, 66 ) );
+ 
+   Assert( Communications.Selector( Usenet ) = -2, "Usenet creator" );
+ 
+   Gossip := ( 
+     Modules.Electronics_Module'(
+       Boards.Transceiver'(
+          Band        => Boards.UHF,
+          ID          => The_Space_Antenna.Electronics.ID,
+          The_Link    => ( Boards.Transmitting, TC_T => 101 ),
+          TC_UHF_Data => 395 )
+        with 
+          Boards.UHF, Modules.Set_Compression_Code, 66 )
+      with
+        TC_VC => -3 ); 
+ 
+   Assert( Gossip.TC_VC = -3, "Gossip Aggregate" );
+ 
+   Communications.Setup( Gossip, 1 ); -- (Boards.UHF,
+                                      -- Modules.Set_Compression_Code)
+   Communications.Setup( Usenet, 2 ); -- (Boards.KU_Band,
+                                      -- Modules.Set_Data_Rate)
+   Communications.Setup( Milnet, 3 ); -- (Boards.S_Band,
+                                      -- Modules.Set_Power_State)
+ 
+   Assert( Communications.Selector( Gossip ) = 1, "Gossip Setup" );
+   Assert( Communications.Selector( Usenet ) = 2, "Usenet Setup" );
+   Assert( Communications.Selector( Milnet ) = 3, "Milnet Setup" );
+ 
+   Report.Result;
+ 
+ end C391002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,349 ----
+ -- C392002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the use of a class-wide formal parameter allows for the 
+ --      proper dispatching of objects to the appropriate implementation of 
+ --      a primitive operation.  Check this in the case where the root tagged
+ --      type is defined in a generic package, and the type derived from it is
+ --      defined in that same generic package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type, and some associated primitive operations.
+ --      Extend the root type, and override one or more primitive operations, 
+ --      inheriting the other primitive operations from the root type.
+ --      Derive from the extended type, again overriding some primitive
+ --      operations and inheriting others (including some that the parent 
+ --      inherited).
+ --      Define a subprogram with a class-wide parameter, inside of which is a 
+ --      call on a dispatching primitive operation.  These primitive operations
+ --      modify global variables (the class-wide parameter has mode IN).
+ --     
+ --  The following hierarchy of tagged types and primitive operations is 
+ --  utilized in this test:
+ --
+ --
+ --    type Vehicle (root)
+ --            |
+ --    type Motorcycle
+ --            |
+ --            | Operations
+ --            |   Engine_Size
+ --            |   Catalytic_Converter
+ --            |   Emissions_Produced
+ --            |
+ --    type Automobile (extended from Motorcycle)
+ --            |
+ --            | Operations
+ --            |   (Engine_Size)       (inherited)
+ --            |   Catalytic_Converter (overridden)
+ --            |   Emissions_Produced  (overridden)
+ --            |
+ --    type Truck (extended from Automobile)
+ --            |
+ --            | Operations
+ --            |   (Engine_Size)         (inherited twice - Motorcycle)
+ --            |   (Catalytic_Converter) (inherited - Automobile)
+ --            |   Emissions_Produced    (overridden)
+ -- 
+ --
+ -- In this test, we are concerned with the following selection of dispatching
+ -- calls, accomplished with the use of a Vehicle'Class IN procedure 
+ -- parameter :
+ --
+ --                       \ Type
+ --               Prim. Op \   Motorcycle      Automobile        Truck
+ --                         \------------------------------------------------ 
+ --             Engine_Size |      X               X               X
+ --     Catalytic_Converter |      X               X               X
+ --     Emissions_Produced  |      X               X               X
+ --
+ --
+ --
+ -- The location of the declaration and derivation of the root and extended
+ -- types will be varied over a series of tests.  Locations of declaration
+ -- and derivation for a particular test are marked with an asterisk (*).
+ --
+ -- Root type:
+ --       
+ --       Declared in package.                                          
+ --    *  Declared in generic package.
+ --
+ -- Extended types:
+ --
+ --    *  Derived in parent location.
+ --       Derived in a nested package.
+ --       Derived in a nested subprogram.
+ --       Derived in a nested generic package.
+ --       Derived in a separate package.
+ --       Derived in a separate visible child package.
+ --       Derived in a separate private child package.
+ --
+ -- Primitive Operations:
+ --
+ --    *  Procedures with same parameter profile.
+ --       Procedures with different parameter profile.
+ --    *  Functions with same parameter profile.
+ --       Functions with different parameter profile.
+ --    *  Mixture of Procedures and Functions.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      09 May 96   SAIC    Made single-file for 2.1
+ --
+ --!
+ 
+ ------------------------------------------------------------------- C392002_0
+ 
+ -- Declare the root and extended types, along with their primitive
+ -- operations in a generic package.
+ 
+ generic
+ 
+    type Cubic_Inches     is range <>;
+    type Emission_Measure is digits <>;
+    Emissions_per_Engine_Cubic_Inch : Emission_Measure;
+ 
+ package C392002_0 is       -- package Vehicle_Simulation
+ 
+    --
+    -- Equipment types and their primitive operations.
+    --
+ 
+    -- Root type.
+ 
+    type Vehicle is abstract tagged 
+       record 
+          Weight : Integer;
+          Wheels : Positive;
+       end record;
+ 
+    -- Abstract operations of type Vehicle.
+    function Engine_Size         (V : in Vehicle) return Cubic_Inches
+             is abstract;
+    function Catalytic_Converter (V : in Vehicle) return Boolean
+             is abstract;
+    function Emissions_Produced  (V : in Vehicle) return Emission_Measure
+             is abstract;
+ 
+    --
+ 
+    type Motorcycle is new Vehicle with
+       record
+          Size_Of_Engine : Cubic_Inches;
+       end record;
+ 
+    -- Primitive operations of type Motorcycle.
+    function Engine_Size         (V : in Motorcycle) return Cubic_Inches;
+    function Catalytic_Converter (V : in Motorcycle) return Boolean;
+    function Emissions_Produced  (V : in Motorcycle) return Emission_Measure;
+ 
+    --
+                           
+    type Automobile is new Motorcycle with
+       record
+          Passenger_Capacity : Integer;
+       end record;
+ 
+    -- Function Engine_Size inherited from parent (Motorcycle).
+    -- Primitive operations (Overridden).
+    function Catalytic_Converter (V : in Automobile) return Boolean;
+    function Emissions_Produced  (V : in Automobile) return Emission_Measure;
+                           
+    --
+ 
+    type Truck is new Automobile with
+       record
+          Hauling_Capacity : Natural;
+       end record;
+ 
+    -- Function Engine_Size inherited twice.
+    -- Function Catalytic_Converter inherited from parent (Automobile).
+    -- Primitive operation (Overridden).
+    function Emissions_Produced  (V : in Truck) return Emission_Measure;
+ 
+ end C392002_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body c392002_0 is
+ 
+    --
+    -- Primitive operations for Motorcycle.
+    --
+ 
+    function Engine_Size         (V : in Motorcycle) return Cubic_Inches is
+    begin
+       return (V.Size_Of_Engine);
+    end Engine_Size;
+ 
+ 
+    function Catalytic_Converter (V : in Motorcycle) return Boolean is
+    begin
+       return (False);
+    end Catalytic_Converter;
+ 
+ 
+    function Emissions_Produced  (V : in Motorcycle) return Emission_Measure is
+    begin
+       return 100.00;
+    end Emissions_Produced;
+ 
+    --
+    -- Overridden operations for Automobile type.
+    --
+ 
+    function Catalytic_Converter (V : in Automobile) return Boolean is
+    begin
+       return (True);
+    end Catalytic_Converter;
+ 
+ 
+    function Emissions_Produced  (V : in Automobile) return Emission_Measure is
+    begin
+       return 200.00;
+    end Emissions_Produced;
+ 
+    --
+    -- Overridden operation for Truck type.
+    --
+ 
+    function Emissions_Produced  (V : in Truck) return Emission_Measure is
+    begin
+       return 300.00;
+    end Emissions_Produced;
+                      
+ end C392002_0;
+ 
+ --------------------------------------------------------------------- C392002
+ 
+ with C392002_0;        -- with Vehicle_Simulation;
+ with Report;
+ 
+ procedure C392002 is  
+ 
+    type Decade                     is (c1970, c1980, c1990);
+    type Vehicle_Emissions          is digits 6;
+    type Engine_Emissions_by_Decade is array (Decade) of Vehicle_Emissions;
+    subtype Engine_Size             is Integer range 100 .. 1000;
+ 
+    Five_Tons                  : constant Natural := 10000;
+    Catalytic_Converter_Offset : constant Vehicle_Emissions := 0.8;
+    Truck_Adjustment_Factor    : constant Vehicle_Emissions := 1.2;
+ 
+ 
+    Engine_Emission_Factor : Engine_Emissions_by_Decade := (c1970 => 10.00,
+                                                            c1980 =>  8.00,
+                                                            c1990 =>  5.00);
+ 
+    -- Instantiate generic package for 1970 simulation.
+ 
+    package Sim_1970 is new C392002_0
+      (Cubic_Inches                    => Engine_Size,
+       Emission_Measure                => Vehicle_Emissions,
+       Emissions_Per_Engine_Cubic_Inch => Engine_Emission_Factor (c1970));
+ 
+ 
+    -- Declare and initialize vehicle objects.
+ 
+    Cycle_1970 : Sim_1970.Motorcycle := (Weight         => 400, 
+                                         Wheels         =>   2,
+                                         Size_Of_Engine => 100);
+ 
+    Auto_1970  : Sim_1970.Automobile := (2000, 4, 500, 5);
+ 
+    Truck_1970 : Sim_1970.Truck      := (Weight             => 5000, 
+                                         Wheels             => 18, 
+                                         Size_Of_Engine     => 1000, 
+                                         Passenger_Capacity => 2, 
+                                         Hauling_Capacity   => Five_Tons);
+ 
+    -- Function Get_Engine_Size performs a dispatching call on a
+    -- primitive operation that has been defined for an ancestor type and 
+    -- inherited by each type derived from the ancestor.
+ 
+    function Get_Engine_Size (V : in Sim_1970.Vehicle'Class) 
+      return Engine_Size is
+    begin
+      return (Sim_1970.Engine_Size (V)); -- Dispatch according to tag.
+    end Get_Engine_Size;
+  
+ 
+    -- Function Catalytic_Converter_Present performs a dispatching call on 
+    -- a primitive operation that has been defined for an ancestor type, 
+    -- overridden in the parent extended type, and inherited by the subsequent 
+    -- extended type.
+ 
+    function Catalytic_Converter_Present (V : in Sim_1970.Vehicle'Class)
+      return Boolean is
+    begin
+       return (Sim_1970.Catalytic_Converter (V)); -- Dispatch according to tag.
+    end Catalytic_Converter_Present;
+ 
+ 
+    -- Function Air_Quality_Measure performs a dispatching call on 
+    -- a primitive operation that has been defined for an ancestor type, and
+    -- overridden in each subsequent extended type.
+ 
+    function Air_Quality_Measure (V : in Sim_1970.Vehicle'Class)
+      return Vehicle_Emissions is
+    begin
+       return (Sim_1970.Emissions_Produced (V));  -- Dispatch according to tag.
+    end Air_Quality_Measure;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ begin  -- Main test procedure.
+ 
+    Report.Test ("C392002",  "Check that the use of a class-wide parameter "
+                           & "allows for proper dispatching where root type "
+                           & "and extended types are declared in the same "
+                           & "generic package" );
+ 
+    if (Get_Engine_Size (Cycle_1970) /=  100) or
+       (Get_Engine_Size (Auto_1970)  /=  500) or
+       (Get_Engine_Size (Truck_1970) /= 1000) 
+    then
+       Report.Failed ("Failed dispatch to Get_Engine_Size");
+    end if;
+ 
+    if Catalytic_Converter_Present (Cycle_1970)    or
+       not Catalytic_Converter_Present (Auto_1970) or
+       not Catalytic_Converter_Present (Truck_1970)
+    then
+       Report.Failed ("Failed dispatch to Catalytic_Converter_Present");
+    end if;
+ 
+    if ((Air_Quality_Measure (Cycle_1970) /= 100.00) or
+        (Air_Quality_Measure (Auto_1970)  /= 200.00) or
+        (Air_Quality_Measure (Truck_1970) /= 300.00)) 
+    then
+       Report.Failed ("Failed dispatch to Air_Quality_Measure");
+    end if;
+ 
+    Report.Result;
+ 
+ end C392002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,453 ----
+ -- C392003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the use of a class-wide formal parameter allows for the 
+ --      proper dispatching of objects to the appropriate implementation of 
+ --      a primitive operation.  Check this where the root tagged type is
+ --      defined in a package, and the extended type is defined in a nested
+ --      package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type, and some associated primitive operations.
+ --      Extend the root type, and override one or more primitive operations, 
+ --      inheriting the other primitive operations from the root type.
+ --      Derive from the extended type, again overriding some primitive
+ --      operations and inheriting others (including some that the parent 
+ --      inherited).
+ --      Define a subprogram with a class-wide parameter, inside of which is a 
+ --      call on a dispatching primitive operation.  These primitive operations
+ --      modify global variables (the class-wide parameter has mode IN).
+ --     
+ --     
+ --     
+ -- The following hierarchy of tagged types and primitive operations is 
+ -- utilized in this test:
+ --
+ --    type Bank_Account (root)
+ --            |
+ --            | Operations
+ --            |   Increment_Bank_Reserve
+ --            |   Assign_Representative
+ --            |   Increment_Counters
+ --            |   Open
+ --            |
+ --    type Savings_Account (extended from Bank_Account)
+ --            |
+ --            | Operations
+ --            |   (Increment_Bank_Reserve) (inherited)
+ --            |   Assign_Representative    (overridden)
+ --            |   Increment_Counters       (overridden)
+ --            |   Open                     (overridden)
+ --            |
+ --    type Preferred_Account (extended from Savings_Account)
+ --            |
+ --            | Operations
+ --            |   (Increment_Bank_Reserve) (inherited twice - Bank_Acct.)
+ --            |   (Assign_Representative)  (inherited - Savings_Acct.)
+ --            |   Increment_Counters       (overridden)
+ --            |   Open                     (overridden)
+ -- 
+ --
+ -- In this test, we are concerned with the following selection of dispatching
+ -- calls, accomplished with the use of a Bank_Account'Class IN procedure 
+ -- parameter :
+ --
+ --                       \ Type
+ --               Prim. Op \  Bank_Account  Savings_Account Preferred_Account
+ --                         \------------------------------------------------ 
+ --   Increment_Bank_Reserve|      X                               X
+ --   Assign_Representative |                      X
+ --   Increment_Counters    |      X               X               X
+ --
+ --
+ --
+ -- The location of the declaration and derivation of the root and extended
+ -- types will be varied over a series of tests.  Locations of declaration
+ -- and derivation for a particular test are marked with an asterisk (*).
+ --
+ -- Root type:
+ --       
+ --    *  Declared in package.
+ --       Declared in generic package.
+ --
+ -- Extended types:
+ --
+ --       Derived in parent location.
+ --    *  Derived in a nested package.
+ --       Derived in a nested subprogram.
+ --       Derived in a nested generic package.
+ --       Derived in a separate package.
+ --       Derived in a separate visible child package.
+ --       Derived in a separate private child package.
+ --
+ -- Primitive Operations:
+ --
+ --    *  Procedures with same parameter profile.
+ --       Procedures with different parameter profile.
+ --    *  Functions with same parameter profile.
+ --       Functions with different parameter profile.
+ --    *  Mixture of Procedures and Functions.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+  
+  
+  with Report;
+  
+  procedure C392003 is
+  
+        --
+        -- Types and subtypes.
+        --
+  
+        type Dollar_Amount  is new float;
+        type Interest_Rate  is delta 0.001 range 0.000 .. 1.000;
+        type Account_Types  is (Bank, Savings, Preferred, Total);
+        type Account_Counter is array (Account_Types) of integer;
+        type Account_Rep is (President, Manager, New_Account_Manager, Teller);
+  
+        --
+        -- Constants.
+        --
+  
+        Opening_Balance           : constant Dollar_Amount := 100.00;
+        Current_Rate              : constant Interest_Rate := 0.030;
+        Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00;
+  
+        --
+        -- Global Variables
+        --
+  
+        Bank_Reserve         : Dollar_Amount   := 0.00;
+        Daily_Representative : Account_Rep     := New_Account_Manager;
+        Number_Of_Accounts   : Account_Counter := (Bank      => 0,
+                                                   Savings   => 0,
+                                                   Preferred => 0,
+                                                   Total     => 0);
+  
+     -- Root tagged type and primitive operations declared in internal 
+     -- package (Accounts).
+     -- Extended types (and primitive operations) derived in nested packages.
+  
+       --=================================================================--
+  
+     package Accounts is
+  
+        --
+        -- Root account type and primitive operations.
+        --
+  
+        -- Root type.
+  
+        type Bank_Account is tagged
+           record
+              Balance : Dollar_Amount;
+           end record;
+  
+        -- Primitive operations of Bank_Account.
+  
+        function  Increment_Bank_Reserve (Acct : in     Bank_Account) 
+          return Dollar_Amount;
+        function Assign_Representative   (Acct : in     Bank_Account)
+          return Account_Rep;
+        procedure Increment_Counters     (Acct : in     Bank_Account);
+        procedure Open                   (Acct : in out Bank_Account);
+  
+       --=================================================================--
+                            
+        package S_And_L is 
+  
+           -- Declare extended type in a nested package.
+  
+           type Savings_Account is new Bank_Account with
+           record
+              Rate : Interest_Rate;
+           end record;
+  
+           -- Function Increment_Bank_Reserve inherited from 
+           -- parent (Bank_Account).
+  
+           -- Primitive operations (Overridden).
+           function Assign_Representative (Acct : in     Savings_Account)
+             return Account_Rep;
+           procedure Increment_Counters   (Acct : in     Savings_Account);
+           procedure Open                 (Acct : in out Savings_Account);
+                            
+  
+       --=================================================================--
+                            
+           package Premium is 
+  
+              -- Declare further extended type in a nested package.
+  
+              type Preferred_Account is new Savings_Account with
+              record
+                 Minimum_Balance : Dollar_Amount;
+              end record;
+  
+              -- Function Increment_Bank_Reserve inherited twice.
+              -- Function Assign_Representative inherited from parent 
+              --   (Savings_Account).
+  
+              -- Primitive operation (Overridden).
+              procedure Increment_Counters (Acct : in     Preferred_Account);
+              procedure Open               (Acct : in out Preferred_Account);
+  
+              -- Function used to verify Open operation for Preferred_Account 
+              -- objects.
+              function Verify_Open (Acct : in Preferred_Account) return Boolean;
+  
+           end Premium;
+  
+        end S_And_L;
+  
+     end Accounts;
+  
+       --=================================================================--
+  
+     package body Accounts is
+  
+        --
+        -- Primitive operations for Bank_Account.
+        --
+  
+        function Increment_Bank_Reserve (Acct : in Bank_Account) 
+          return Dollar_Amount is
+        begin
+           return (Bank_Reserve + Acct.Balance);
+        end Increment_Bank_Reserve;
+  
+        function Assign_Representative (Acct : in Bank_Account) 
+          return Account_Rep is
+        begin
+           return Account_Rep'(Teller);
+        end Assign_Representative;
+  
+        procedure Increment_Counters (Acct : in Bank_Account) is
+        begin
+           Number_Of_Accounts (Bank)  := Number_Of_Accounts (Bank) + 1;
+           Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
+        end Increment_Counters;
+  
+        procedure Open (Acct : in out Bank_Account) is
+        begin
+           Acct.Balance := Opening_Balance;
+        end Open;
+  
+       --=================================================================--
+  
+        package body S_And_L is
+  
+           --
+           -- Overridden operations for Savings_Account type.
+           --
+  
+           function Assign_Representative (Acct : in Savings_Account) 
+             return Account_Rep is
+           begin
+              return (Manager);
+           end Assign_Representative;
+  
+           procedure Increment_Counters (Acct : in Savings_Account) is
+           begin
+              Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1;
+              Number_Of_Accounts (Total)   := Number_Of_Accounts (Total) + 1;
+           end Increment_Counters;
+  
+           procedure Open (Acct : in out Savings_Account) is
+           begin
+              Open (Bank_Account(Acct));
+              Acct.Rate := Current_Rate;
+              Acct.Balance := 2.0 * Opening_Balance;
+           end Open;
+       
+       --=================================================================--
+  
+           package body Premium is
+  
+              --
+              -- Overridden operations for Preferred_Account type.
+              --
+                       
+              procedure Increment_Counters (Acct : in Preferred_Account) is
+              begin
+                 Number_Of_Accounts (Preferred) := 
+                   Number_Of_Accounts (Preferred) + 1;
+                 Number_Of_Accounts (Total)     := 
+                   Number_Of_Accounts (Total) + 1;
+              end Increment_Counters;
+  
+              procedure Open (Acct : in out Preferred_Account) is
+              begin
+                 Open (Savings_Account(Acct));
+                 Acct.Minimum_Balance := Preferred_Minimum_Balance;
+                 Acct.Balance := Acct.Minimum_Balance;
+              end Open;
+  
+              --
+              -- Function used to verify Open operation for Preferred_Account 
+              -- objects.
+              --
+  
+              function Verify_Open (Acct : in Preferred_Account) 
+                return Boolean is
+              begin                                                    
+                 return (Acct.Balance         = Preferred_Minimum_Balance and
+                         Acct.Rate            = Current_Rate              and
+                         Acct.Minimum_Balance = Preferred_Minimum_Balance);
+              end Verify_Open;
+  
+           end Premium;
+   
+        end S_And_L;
+  
+     end Accounts;
+  
+       --=================================================================--
+  
+     -- Declare account objects.
+  
+     B_Account : Accounts.Bank_Account;
+     S_Account : Accounts.S_And_L.Savings_Account;
+     P_Account : Accounts.S_And_L.Premium.Preferred_Account;
+  
+     -- Procedures to operate on accounts.
+     -- Each uses a class-wide IN parameter, as well as a call to a
+     -- dispatching operation.
+  
+     -- Function Tabulate_Account performs a dispatching call on a primitive
+     -- operation that has been overridden for each of the extended types.
+  
+     procedure Tabulate_Account (Acct : in Accounts.Bank_Account'Class) is
+     begin
+        Accounts.Increment_Counters (Acct);   -- Dispatch according to tag.
+     end Tabulate_Account;
+  
+     -- Function Accumulate_Reserve performs a dispatching call on a
+     -- primitive operation that has been defined for the root type and 
+     -- inherited by each derived type.
+  
+     function Accumulate_Reserve (Acct : in Accounts.Bank_Account'Class) 
+       return Dollar_Amount is
+     begin
+        -- Dispatch according to tag.
+        return (Accounts.Increment_Bank_Reserve (Acct));   
+     end Accumulate_Reserve;
+  
+     -- Procedure Resolve_Dispute performs a dispatching call on a primitive
+     -- operation that has been defined in the root type, overridden in the
+     -- first derived extended type, and inherited by the subsequent extended
+     -- type.
+  
+     procedure Resolve_Dispute (Acct : in Accounts.Bank_Account'Class) is
+     begin
+        -- Dispatch according to tag.
+        Daily_Representative := Accounts.Assign_Representative (Acct);   
+     end Resolve_Dispute;
+  
+       --=================================================================--
+  
+  begin  -- Main test procedure.
+  
+     Report.Test ("C392003", "Check that the use of a class-wide parameter "   &
+                              "allows for proper dispatching where root type " &
+                              "is declared in a nested package, and "          &
+                              "subsequent extended types are derived in "      &
+                              "further nested packages" );
+     
+     Bank_Account_Subtest:
+     begin
+        Accounts.Open (B_Account);
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been defined for this specific type.
+        Bank_Reserve := Accumulate_Reserve (Acct => B_Account);
+        Tabulate_Account (B_Account);
+  
+        if (Bank_Reserve /= Opening_Balance) or
+           (Number_Of_Accounts (Bank) /= 1)  or
+           (Number_Of_Accounts (Total) /= 1) 
+        then
+           Report.Failed ("Failed in Bank_Account_Subtest");
+        end if;
+  
+     end Bank_Account_Subtest;
+  
+  
+     Savings_Account_Subtest:
+     begin
+        Accounts.S_And_L.Open (Acct => S_Account);
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been overridden for this extended type.
+        Resolve_Dispute  (Acct => S_Account);
+        Tabulate_Account (S_Account);
+  
+        if (Daily_Representative /= Manager)   or 
+           (Number_Of_Accounts (Savings) /= 1) or
+           (Number_Of_Accounts (Total) /= 2)
+        then
+           Report.Failed ("Failed in Savings_Account_Subtest");
+        end if;
+  
+     end Savings_Account_Subtest;
+  
+  
+  
+     Preferred_Account_Subtest:
+     begin
+        Accounts.S_And_L.Premium.Open (P_Account);
+  
+        -- Verify that the correct implementation of Open (overridden) was 
+        -- used for the Preferred_Account object.
+        if not Accounts.S_And_L.Premium.Verify_Open (P_Account) then
+           Report.Failed ("Incorrect values for init. Preferred Acct object");
+        end if;
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been twice inherited by this extended type.
+        Bank_Reserve := Accumulate_Reserve (Acct => P_Account);
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been overridden for this extended type (the
+        -- operation was overridden by its parent type as well).
+        Tabulate_Account (P_Account);
+        
+        if Bank_Reserve /= 1100.00             or 
+           Number_Of_Accounts (Preferred) /= 1 or
+           Number_Of_Accounts (Total) /= 3
+        then
+           Report.Failed ("Failed in Preferred_Account_Subtest");
+        end if;
+  
+     end Preferred_Account_Subtest;
+  
+     Report.Result;
+  
+  end C392003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,189 ----
+ -- C392004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that subprograms inherited from tagged derivations, which are
+ --      subsequently redefined for the derived type, are available to the
+ --      package defining the new class via view conversion.  Check
+ --      that operations performed on objects using view conversion do not 
+ --      affect the extended fields.  Check that visible operations not masked 
+ --      by the deriving package remain available to the client, and do not 
+ --      affect the extended fields.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares a tagged type, with a constructor operation,
+ --      derives a type from that tagged type, and declares a constructor
+ --      operation which masks the inherited operation.  It then tests
+ --      that the correct constructor is called, and that the extended
+ --      part of the derived type remains untouched as appropriate.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --      04 Jan 94   SAIC    Fixed objective typo, removed dead code.
+ --
+ --!
+ 
+ with Report;
+ 
+ package C392004_1 is
+ 
+   type Vehicle is tagged private;
+ 
+   procedure Create ( The_Vehicle :    out Vehicle; TC_Flag : Natural );
+   procedure Start  ( The_Vehicle : in out Vehicle );
+ 
+ private
+ 
+   type Vehicle is tagged record
+     Engine_On : Boolean;
+   end record;
+ 
+ end C392004_1;
+ 
+ package body C392004_1 is
+   procedure Create ( The_Vehicle : out Vehicle; TC_Flag : Natural ) is
+   begin
+     case TC_Flag is
+       when 1 => null; -- expected flag for this subprogram
+       when others =>
+          Report.Failed ("Called Vehicle Create");
+     end case;
+     The_Vehicle := (Engine_On => False);
+   end Create;
+ 
+   procedure Start ( The_Vehicle : in out Vehicle ) is
+   begin
+     The_Vehicle.Engine_On := True;
+   end Start;
+ 
+ end C392004_1;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with C392004_1;
+ package C392004_2 is
+ 
+   type Car is new C392004_1.Vehicle with record
+     Convertible : Boolean;
+   end record;
+ 
+   -- masking definition
+   procedure Create( The_Car : out Car; TC_Flag : Natural );
+ 
+   type Limo is new Car with null record;
+ 
+   procedure Create( The_Limo : out Limo; TC_Flag : Natural );
+ 
+ end C392004_2;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with Report;
+ package body C392004_2 is
+ 
+   procedure Create( The_Car : out Car; TC_Flag : Natural ) is
+   begin
+     case TC_Flag is
+       when 2      => null; -- expected flag for this subprogram
+       when others => Report.Failed ("Called Car Create");
+     end case;
+     C392004_1.Create( C392004_1.Vehicle(The_Car), 1);
+     The_Car.Convertible := False;
+   end Create;
+ 
+   procedure Create( The_Limo : out Limo; TC_Flag : Natural ) is
+   begin
+     case TC_Flag is
+       when 3      => null; -- expected flag for this subprogram
+       when others => Report.Failed ("Called Limo Create");
+     end case;
+     C392004_1.Create( C392004_1.Vehicle(The_Limo), 1);
+     The_Limo.Convertible := True;
+  end Create;
+ 
+ end C392004_2;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with Report;
+ with C392004_1; use C392004_1;
+ with C392004_2; use C392004_2;
+ procedure C392004 is
+ 
+   My_Car : Car;
+   Your_Car : Limo;
+ 
+   procedure TC_Assert( Is_True : Boolean; Message : String ) is
+   begin
+     if not Is_True then
+       Report.Failed (Message);
+     end if;
+   end TC_Assert;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C392004", "Check subprogram inheritance & visibility " &
+                           "for derived tagged types" );
+ 
+   My_Car.Convertible := False;
+   Create( Vehicle( My_Car ), 1 );
+   TC_Assert( not My_Car.Convertible, "Altered descendent component 1");
+ 
+   Create( Your_Car, 3 );
+   TC_Assert( Your_Car.Convertible, "Did not set inherited component 2");
+ 
+   My_Car.Convertible := True;
+   Create( Vehicle( My_Car ), 1 );
+   TC_Assert( My_Car.Convertible, "Altered descendent component 3");
+ 
+   Create( My_Car, 2 );
+   TC_Assert( not My_Car.Convertible, "Did not set extending component 4");
+ 
+   My_Car.Convertible := False;
+   Start( Vehicle( My_Car ) );
+   TC_Assert( not My_Car.Convertible , "Altered descendent component 5");
+ 
+   Start( My_Car );
+   TC_Assert( not My_Car.Convertible, "Altered unreferenced component 6");
+ 
+   Your_Car.Convertible := False;
+   Start( Vehicle( Your_Car ) );
+   TC_Assert( not Your_Car.Convertible , "Altered descendent component 7");
+ 
+   Start( Your_Car );
+   TC_Assert( not Your_Car.Convertible, "Altered unreferenced component 8");
+ 
+   My_Car.Convertible := True;
+   Start( Vehicle( My_Car ) );
+   TC_Assert( My_Car.Convertible, "Altered descendent component 9");
+ 
+   Start( My_Car );
+   TC_Assert( My_Car.Convertible, "Altered unreferenced component 10");
+ 
+   Report.Result;
+ 
+ end C392004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,367 ----
+ -- C392005.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for an implicitly declared dispatching operation that is
+ --      overridden, the body executed is the body for the overriding
+ --      subprogram, even if the overriding occurs in a private part.
+ --
+ --      Check for the case where the overriding operations are declared in a
+ --      public child unit of the package declaring the parent type, and the
+ --      descendant type is a private extension.
+ --
+ --      Check for both dispatching and nondispatching calls.
+ --
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      package Parent is
+ --         type Root is tagged ...
+ --         procedure Vis_Op (P: Root);
+ --      private
+ --         procedure Pri_Op (P: Root);
+ --      end Parent;
+ --
+ --      package Parent.Child is
+ --         type Derived is new Root with private;
+ --         -- Implicit Vis_Op (P: Derived) declared here.
+ --
+ --         procedure Pri_Op (P: Derived);                  -- (A)
+ --         ...
+ --      private
+ --         type Derived is new Root with record...
+ --         -- Implicit Pri_Op (P: Derived) declared here.
+ 
+ --         procedure Vis_Op (P: Derived);                  -- (B)
+ --         ...
+ --      end Parent.Child;
+ --
+ --      Type Derived inherits both Vis_Op and Pri_Op from the ancestor type
+ --      Root. Note, however, that Vis_Op is implicitly declared in the visible
+ --      part, whereas Pri_Op is implicitly declared in the private part
+ --      (inherited subprograms for a private extension are implicitly declared
+ --      after the private_extension_declaration if the corresponding
+ --      declaration from the ancestor is visible at that place; otherwise the
+ --      inherited subprogram is not declared for the private extension,
+ --      although it might be for the full type).
+ --
+ --      Even though Root's version of Pri_Op hasn't been implicitly declared
+ --      for Derived at the time Derived's version of Pri_Op has been
+ --      explicitly declared, the explicit Pri_Op still overrides the implicit
+ --      version. 
+ --      Also, even though the explicit Vis_Op for Derived is declared in the
+ --      private part it still overrides the implicit version declared in the
+ --      visible part. Calls with tag Derived will execute (A) and (B).
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      26 Nov 96   SAIC    Improved for ACVC 2.1
+ --
+ --!
+ 
+ package C392005_0 is
+ 
+    type Remote_Camera is tagged private;
+ 
+    type Depth_Of_Field is range 5 .. 100;  
+    type Shutter_Speed  is (One, Two_Fifty, Four_Hundred, Thousand);
+    type Aperture       is (Eight, Sixteen, Thirty_Two);     
+ 
+    -- ...Other declarations.
+ 
+    procedure Focus (Cam   : in out Remote_Camera;
+                     Depth : in     Depth_Of_Field);
+ 
+    procedure Self_Test (C: in out Remote_Camera'Class);
+ 
+    -- ...Other operations.
+ 
+    function TC_Get_Depth (C: Remote_Camera) return Depth_Of_Field;
+    function TC_Get_Speed (C: Remote_Camera) return Shutter_Speed;
+ 
+ private
+ 
+    type Remote_Camera is tagged record
+       DOF    : Depth_Of_Field := 10;
+       Shutter: Shutter_Speed  := One;
+       FStop  : Aperture       := Eight;
+    end record;
+ 
+    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
+                                 Speed : in     Shutter_Speed);
+ 
+    -- For the basic remote camera, shutter speed might be set as a function of
+    -- focus perhaps, thus it is declared as a private operation (usable
+    -- only internally within the abstraction).
+ 
+    function Set_Aperture (C : Remote_Camera) return Aperture;
+                                
+ end C392005_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C392005_0 is
+ 
+    procedure Focus (Cam   : in out Remote_Camera;
+                     Depth : in     Depth_Of_Field) is
+    begin
+       -- Artificial for testing purposes.
+       Cam.DOF := 46;
+    end Focus;
+ 
+    -----------------------------------------------------------
+    procedure Set_Shutter_Speed (C     : in out Remote_Camera;
+                                 Speed : in     Shutter_Speed) is
+    begin
+       -- Artificial for testing purposes.
+       C.Shutter := Thousand;
+    end Set_Shutter_Speed;
+ 
+    -----------------------------------------------------------
+    function Set_Aperture (C : Remote_Camera) return Aperture is
+    begin
+       -- Artificial for testing purposes.
+       return Thirty_Two;
+    end Set_Aperture;
+ 
+    -----------------------------------------------------------
+    procedure Self_Test (C: in out Remote_Camera'Class) is
+       TC_Dummy_Depth : constant Depth_Of_Field := 23;
+       TC_Dummy_Speed : constant Shutter_Speed  := Four_Hundred;
+    begin
+ 
+       -- Test focus at various depths:
+       Focus(C, TC_Dummy_Depth);
+       -- ...Additional calls to Focus.
+ 
+       -- Test various shutter speeds:
+       Set_Shutter_Speed(C, TC_Dummy_Speed);
+       -- ...Additional calls to Set_Shutter_Speed.
+ 
+    end Self_Test;
+ 
+    -----------------------------------------------------------
+    function TC_Get_Depth (C: Remote_Camera) return Depth_Of_Field is
+    begin
+       return C.DOF;
+    end TC_Get_Depth;
+ 
+    -----------------------------------------------------------
+    function TC_Get_Speed (C: Remote_Camera) return Shutter_Speed is
+    begin
+       return C.Shutter;
+    end TC_Get_Speed;
+ 
+ end C392005_0;
+ 
+      --==================================================================--
+ 
+ 
+ package C392005_0.C392005_1 is
+ 
+    type Auto_Speed is new Remote_Camera with private;
+ 
+ 
+    -- procedure Focus (C     : in out Auto_Speed;      -- Implicitly declared
+    --                  Depth : in     Depth_Of_Field)  -- here.
+ 
+    -- For the improved remote camera, shutter speed can be set manually,
+    -- so it is declared as a public operation.
+ 
+    -- The order of declarations for Set_Aperture and Set_Shutter_Speed are
+    -- reversed from the original declarations to trap potential compiler
+    -- problems related to subprogram ordering.
+ 
+    function Set_Aperture (C : Auto_Speed) return Aperture;    -- Overrides
+                                                               -- inherited op.
+ 
+    procedure Set_Shutter_Speed (C     : in out Auto_Speed;    -- Overrides
+                                 Speed : in     Shutter_Speed);-- inherited op.
+ 
+    -- Set_Shutter_Speed and Set_Aperture override the operations inherited
+    -- from the parent, even though the inherited operations are not implicitly
+    -- declared until the private part below.
+ 
+    type New_Camera is private;
+ 
+    function TC_Get_Aper (C: New_Camera) return Aperture;
+ 
+    -- ...Other operations.
+ 
+ private
+    type Film_Speed is (One_Hundred, Two_Hundred, Four_Hundred);
+ 
+    type Auto_Speed is new Remote_Camera with record
+       ASA : Film_Speed;
+    end record;
+ 
+    -- procedure Set_Shutter_Speed (C     : in out Auto_Speed;    -- Implicitly
+    --                              Speed : in     Shutter_Speed) -- declared
+                                                                  -- here.
+ 
+    -- function Set_Aperture (C : Auto_Speed) return Aperture;    -- Implicitly
+                                                                  -- declared.
+ 
+    procedure Focus (C     : in out Auto_Speed;                -- Overrides
+                     Depth : in     Depth_Of_Field);           -- inherited op.
+ 
+    -- For the improved remote camera, perhaps the focusing algorithm is
+    -- different, so the original Focus operation is overridden here.
+ 
+    Auto_Camera : Auto_Speed;
+ 
+    type New_Camera is record
+       Aper : Aperture := Set_Aperture (Auto_Camera);  -- Calls the overridden,
+    end record;                                        -- not the inherited op.
+ 
+ end C392005_0.C392005_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C392005_0.C392005_1 is
+ 
+    procedure Focus (C     : in out Auto_Speed;
+                     Depth : in     Depth_Of_Field) is
+    begin
+       -- Artificial for testing purposes.
+       C.DOF := 57;
+    end Focus;
+ 
+    ---------------------------------------------------------------
+    procedure Set_Shutter_Speed (C     : in out Auto_Speed;
+                                 Speed : in     Shutter_Speed) is
+    begin
+       -- Artificial for testing purposes.
+       C.Shutter := Two_Fifty;
+    end Set_Shutter_Speed;
+ 
+    -----------------------------------------------------------
+    function Set_Aperture (C : Auto_Speed) return Aperture is
+    begin
+       -- Artificial for testing purposes.
+       return Sixteen;
+    end Set_Aperture;
+ 
+    -----------------------------------------------------------
+    function TC_Get_Aper (C: New_Camera) return Aperture is
+    begin
+       return C.Aper;
+    end TC_Get_Aper;
+ 
+ end C392005_0.C392005_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C392005_0.C392005_1;
+ 
+ with Report;
+ 
+ procedure C392005 is
+    Basic_Camera : C392005_0.Remote_Camera;
+    Auto_Camera1 : C392005_0.C392005_1.Auto_Speed;
+    Auto_Camera2 : C392005_0.C392005_1.Auto_Speed;
+    Auto_Depth   : C392005_0.Depth_Of_Field := 67;
+    New_Camera1  : C392005_0.C392005_1.New_Camera;
+    TC_Expected_Basic_Depth : constant C392005_0.Depth_Of_Field := 46;
+    TC_Expected_Auto_Depth  : constant C392005_0.Depth_Of_Field := 57;
+    TC_Expected_Basic_Speed : constant C392005_0.Shutter_Speed  
+                            := C392005_0.Thousand;
+    TC_Expected_Auto_Speed  : constant C392005_0.Shutter_Speed  
+                            := C392005_0.Two_Fifty;
+    TC_Expected_New_Aper    : constant C392005_0.Aperture 
+                            := C392005_0.Sixteen;
+ 
+    use type C392005_0.Depth_Of_Field;
+    use type C392005_0.Shutter_Speed;
+    use type C392005_0.Aperture;
+ 
+ begin
+    Report.Test ("C392005", "Dispatching for overridden primitive "        &
+                 "subprograms: private extension declared in child unit, " &
+                 "parent is tagged private whose full view is tagged record");
+ 
+ -- Call the class-wide operation for Remote_Camera'Class, which itself makes
+ -- dispatching calls to Focus and Set_Shutter_Speed:
+ 
+ 
+    -- For an object of type Remote_Camera, the dispatching calls should
+    -- dispatch to the bodies declared for the root type:
+      
+    C392005_0.Self_Test(Basic_Camera);
+ 
+    if C392005_0.TC_Get_Depth (Basic_Camera) /= TC_Expected_Basic_Depth 
+      or else C392005_0.TC_Get_Speed (Basic_Camera) /= TC_Expected_Basic_Speed
+    then
+       Report.Failed ("Calls dispatched incorrectly for root type");
+    end if;
+ 
+ 
+    -- For an object of type Auto_Speed, the dispatching calls should
+    -- dispatch to the bodies declared for the derived type:
+      
+    C392005_0.Self_Test(Auto_Camera1);
+ 
+    if C392005_0.C392005_1.TC_Get_Depth(Auto_Camera1) /= TC_Expected_Auto_Depth
+ 
+       or
+       C392005_0.C392005_1.TC_Get_Speed(Auto_Camera1) /= TC_Expected_Auto_Speed
+    then
+       Report.Failed ("Calls dispatched incorrectly for derived type");
+    end if;
+ 
+    -- For an object of type Auto_Speed, a non-dispatching call to Focus should
+ 
+    -- execute the body declared for the derived type (even through it is 
+    -- declared in the private part).
+ 
+    C392005_0.C392005_1.Focus (Auto_Camera2, Auto_Depth);
+ 
+    if C392005_0.C392005_1.TC_Get_Depth(Auto_Camera2) /= TC_Expected_Auto_Depth
+ 
+    then
+       Report.Failed ("Non-dispatching call to privately overriding " &
+                      "subprogram executed the wrong body");
+    end if;
+ 
+    -- For an object of type New_Camera, the initialization using Set_Ap 
+    -- should execute the overridden body, not the inherited one.
+ 
+    if C392005_0.C392005_1.TC_Get_Aper (New_Camera1) /= TC_Expected_New_Aper  
+    then
+       Report.Failed ("Non-dispatching call to visible overriding " &
+                      "subprogram executed the wrong body");
+    end if;
+ 
+    Report.Result;
+ 
+ end C392005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392008.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392008.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392008.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,401 ----
+ -- C392008.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the use of a class-wide formal parameter allows for the 
+ --      proper dispatching of objects to the appropriate implementation of 
+ --      a primitive operation.  Check this for the case where the root tagged
+ --      type is defined in a package and the extended type is defined in a
+ --      dependent package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type, and some associated primitive operations,
+ --      in a visible library package.
+ --      Extend the root type in another visible library package, and override 
+ --      one or more primitive operations, inheriting the other primitive 
+ --      operations from the root type.
+ --      Derive from the extended type in yet another visible library package, 
+ --      again overriding some primitive operations and inheriting others 
+ --      (including some that the parent inherited).
+ --      Define subprograms with class-wide parameters, inside of which is a 
+ --      call on a dispatching primitive operation.  These primitive
+ --      operations modify the objects of the specific class passed as actuals
+ --      to the class-wide formal parameter (class-wide formal parameter has 
+ --      mode IN OUT).
+ --     
+ -- The following hierarchy of tagged types and primitive operations is 
+ -- utilized in this test:
+ --
+ --   package Bank
+ --      type Account (root)
+ --            |
+ --            | Operations
+ --            |     proc Deposit
+ --            |     proc Withdrawal
+ --            |     func Balance        
+ --            |     proc Service_Charge 
+ --            |     proc Add_Interest   
+ --            |     proc Open
+ --            |
+ --   package Checking
+ --      type Account (extended from Bank.Account)
+ --            |
+ --            | Operations
+ --            |     proc Deposit         (inherited)
+ --            |     proc Withdrawal      (inherited)
+ --            |     func Balance         (inherited)
+ --            |     proc Service_Charge  (inherited)
+ --            |     proc Add_Interest    (inherited)
+ --            |     proc Open            (overridden)
+ --            |
+ --   package Interest_Checking
+ --      type Account (extended from Checking.Account)
+ --            |
+ --            | Operations
+ --            |     proc Deposit         (inherited twice - Bank.Acct.)
+ --            |     proc Withdrawal      (inherited twice - Bank.Acct.)
+ --            |     func Balance         (inherited twice - Bank.Acct.)
+ --            |     proc Service_Charge  (inherited twice - Bank.Acct.)
+ --            |     proc Add_Interest    (overridden)
+ --            |     proc Open            (overridden)
+ --            |   
+ --
+ -- In this test, we are concerned with the following selection of dispatching
+ -- calls, accomplished with the use of a Bank.Account'Class IN OUT formal
+ -- parameter :
+ --
+ --                \ Type
+ --        Prim. Op \  Bank.Account  Checking.Account Interest_Checking.Account
+ --                  \---------------------------------------------------------
+ 
+ --   Service_Charge |      X                X                 X
+ --   Add_Interest   |      X                X                 X
+ --   Open           |      X                X                 X
+ --
+ --
+ --
+ -- The location of the declaration of the root and derivation of extended
+ -- types will be varied over a series of tests.  Locations of declaration
+ -- and derivation for a particular test are marked with an asterisk (*).
+ --
+ -- Root type:
+ --       
+ --    *  Declared in package.
+ --       Declared in generic package.
+ --
+ -- Extended types:
+ --
+ --       Derived in parent location.
+ --       Derived in a nested package.
+ --       Derived in a nested subprogram.
+ --       Derived in a nested generic package.
+ --    *  Derived in a separate package.
+ --       Derived in a separate visible child package.
+ --       Derived in a separate private child package.
+ --
+ -- Primitive Operations:
+ --
+ --    *  Procedures with same parameter profile.
+ --       Procedures with different parameter profile.
+ --       Functions with same parameter profile.
+ --       Functions with different parameter profile.
+ --       Mixture of Procedures and Functions.
+ --
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         C392008_0.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      20 Nov 95   SAIC    C392B04 became C392008 for ACVC 2.0.1
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C392008_0
+ 
+ package C392008_0 is           -- package Bank
+ 
+   type Dollar_Amount is range -30_000..30_000; 
+  
+    type Account is tagged
+       record
+         Current_Balance: Dollar_Amount;
+       end record;
+ 
+    -- Primitive operations.
+ 
+    procedure Deposit        (A : in out Account; 
+                              X : in     Dollar_Amount);
+    procedure Withdrawal     (A : in out Account; 
+                              X : in     Dollar_Amount);
+    function  Balance        (A : in     Account) return Dollar_Amount;
+    procedure Service_Charge (A : in out Account);
+    procedure Add_Interest   (A : in out Account);
+    procedure Open           (A : in out Account);
+ 
+ end C392008_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C392008_0 is
+ 
+    -- Primitive operations for type Account.
+ 
+    procedure Deposit (A : in out Account; 
+                       X : in     Dollar_Amount) is
+    begin
+       A.Current_Balance := A.Current_Balance + X;
+    end Deposit;
+ 
+    procedure Withdrawal(A : in out Account; 
+                         X : in     Dollar_Amount) is
+    begin
+       A.Current_Balance := A.Current_Balance - X;
+    end Withdrawal;
+ 
+    function  Balance (A : in     Account) return Dollar_Amount is
+    begin
+       return (A.Current_Balance);
+    end Balance;
+ 
+    procedure Service_Charge (A : in out Account) is
+    begin
+       A.Current_Balance := A.Current_Balance - 5_00;
+    end Service_Charge;
+ 
+    procedure Add_Interest (A : in out Account) is
+       Interest_On_Account : Dollar_Amount := 0_00;
+    begin
+       A.Current_Balance := A.Current_Balance + Interest_On_Account;
+    end Add_Interest;
+ 
+    procedure Open (A : in out Account) is
+       Initial_Deposit : Dollar_Amount := 10_00;
+    begin
+       A.Current_Balance := Initial_Deposit;
+    end Open;
+ 
+ end C392008_0;
+ 
+ ----------------------------------------------------------------- C392008_1
+ 
+ with C392008_0;              -- package Bank
+ 
+ package C392008_1 is      -- package Checking
+ 
+    package Bank renames C392008_0;
+ 
+    type Account is new Bank.Account with 
+       record
+          Overdraft_Fee : Bank.Dollar_Amount;
+       end record;
+ 
+    -- Overridden primitive operation.
+ 
+    procedure Open (A : in out Account);
+ 
+    -- Inherited primitive operations.
+    -- procedure Deposit        (A : in out Account;
+    --                           X : in     Bank.Dollar_Amount);
+    -- procedure Withdrawal     (A : in out Account;
+    --                           X : in     Bank.Dollar_Amount);
+    -- function  Balance        (A : in     Account) return Bank.Dollar_Amount;
+    -- procedure Service_Charge (A : in out Account);
+    -- procedure Add_Interest   (A : in out Account);
+ 
+ end C392008_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C392008_1 is
+ 
+    -- Overridden primitive operation.
+ 
+    procedure Open (A : in out Account) is
+       Check_Guarantee : Bank.Dollar_Amount := 10_00;
+       Initial_Deposit : Bank.Dollar_Amount := 20_00;
+    begin
+       A.Current_Balance := Initial_Deposit;
+       A.Overdraft_Fee   := Check_Guarantee;
+    end Open;
+ 
+ end C392008_1;
+ 
+ ----------------------------------------------------------------- C392008_2
+ 
+ with C392008_0;             -- with Bank;
+ with C392008_1;          -- with Checking;
+ 
+ package C392008_2 is     -- package Interest_Checking
+ 
+    package Bank     renames C392008_0;
+    package Checking renames C392008_1;
+ 
+    subtype Interest_Rate is Bank.Dollar_Amount range 0..100; -- was digits 4;
+ 
+    Current_Rate : Interest_Rate := 0_02;
+ 
+    type Account is new Checking.Account with
+       record
+          Rate : Interest_Rate;
+       end record;
+ 
+    -- Overridden primitive operations.
+ 
+    procedure Add_Interest (A : in out Account);
+    procedure Open         (A : in out Account);
+ 
+    -- "Twice" inherited primitive operations (from Bank.Account)
+    -- procedure Deposit        (A : in out Account;
+    --                           X : in     Bank.Dollar_Amount);
+    -- procedure Withdrawal     (A : in out Account;
+    --                           X : in     Bank.Dollar_Amount);
+    -- function  Balance        (A : in     Account) return Bank.Dollar_Amount;
+    -- procedure Service_Charge (A : in out Account);
+ 
+ end C392008_2;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C392008_2 is
+ 
+    -- Overridden primitive operations.
+ 
+    procedure Add_Interest (A : in out Account) is
+       Interest_On_Account : Bank.Dollar_Amount
+         := Bank.Dollar_Amount( Bank."*"( A.Current_Balance, A.Rate ));
+    begin
+       A.Current_Balance := Bank."+"( A.Current_Balance, Interest_On_Account);
+    end Add_Interest;
+ 
+    procedure Open (A : in out Account) is
+       Initial_Deposit : Bank.Dollar_Amount := 30_00;
+    begin
+       Checking.Open (Checking.Account (A));
+       A.Current_Balance := Initial_Deposit;
+       A.Rate            := Current_Rate;
+    end Open;
+ 
+ end C392008_2;
+ 
+ ------------------------------------------------------------------- C392008
+ 
+ with C392008_0;    use C392008_0;          -- package Bank
+ with C392008_1;    use C392008_1;        -- package Checking;
+ with C392008_2;    use C392008_2;        -- package Interest_Checking;
+ with Report;
+ 
+ procedure C392008 is
+ 
+    package Bank              renames C392008_0;
+    package Checking          renames C392008_1;
+    package Interest_Checking renames C392008_2;
+ 
+    B_Acct  : Bank.Account;
+    C_Acct  : Checking.Account;
+    IC_Acct : Interest_Checking.Account;
+ 
+    --
+    -- Define procedures with class-wide formal parameters of mode IN OUT.
+    --
+ 
+    -- This procedure will perform a dispatching call on the
+    -- overridden primitive operation Open.
+ 
+    procedure New_Account (Acct : in out Bank.Account'Class) is
+    begin
+       Open (Acct);  -- Dispatch according to tag of class-wide parameter.
+    end New_Account;
+ 
+    -- This procedure will perform a dispatching call on the inherited
+    -- primitive operation (for all types derived from the root Bank.Account)
+    -- Service_Charge.
+ 
+    procedure Apply_Service_Charge (Acct: in out Bank.Account'Class) is
+    begin
+       Service_Charge (Acct);  -- Dispatch according to tag of class-wide parm.
+    end Apply_Service_Charge;
+ 
+    -- This procedure will perform a dispatching call on the 
+    -- inherited/overridden primitive operation Add_Interest.
+ 
+    procedure Annual_Interest (Acct: in out Bank.Account'Class) is
+    begin
+       Add_Interest (Acct);  -- Dispatch according to tag of class-wide parm.
+    end Annual_Interest;
+ 
+ begin
+ 
+    Report.Test ("C392008",  "Check that the use of a class-wide formal "    &
+                             "parameter allows for the proper dispatching "  &
+                             "of objects to the appropriate implementation " &
+                             "of a primitive operation");
+ 
+    -- Check the dispatch to primitive operations overridden for each 
+    -- extended type.
+    New_Account (B_Acct);
+    New_Account (C_Acct);
+    New_Account (IC_Acct);
+    
+    if (B_Acct.Current_Balance  /= 10_00) or
+       (C_Acct.Current_Balance  /= 20_00) or
+       (IC_Acct.Current_Balance /= 30_00) 
+    then
+       Report.Failed ("Failed dispatch to multiply overridden prim. oper.");
+    end if;
+ 
+ 
+    Annual_Interest (B_Acct);
+    Annual_Interest (C_Acct);
+    Annual_Interest (IC_Acct); -- Check the dispatch to primitive operation 
+                               -- overridden from a parent type which inherited
+                               -- the operation from the root type.  
+    if (B_Acct.Current_Balance  /= 10_00) or
+       (C_Acct.Current_Balance  /= 20_00) or
+       (IC_Acct.Current_Balance /= 90_00)
+    then
+       Report.Failed ("Failed dispatch to overridden primitive operation");
+    end if;
+ 
+ 
+    Apply_Service_Charge (Acct => B_Acct);
+    Apply_Service_Charge (Acct => C_Acct);
+    Apply_Service_Charge (Acct => IC_Acct); -- Check the dispatch to a  
+                                            -- primitive operation twice 
+                                            -- inherited from the root
+                                            -- tagged type.
+    if (B_Acct.Current_Balance  /=  5_00) or
+       (C_Acct.Current_Balance  /= 15_00) or
+       (IC_Acct.Current_Balance /= 85_00) 
+    then
+       Report.Failed ("Failed dispatch to Apply_Service_Charge");
+    end if;
+ 
+    Report.Result;
+ 
+ end C392008;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,512 ----
+ -- C392010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that a subprogram dispatches correctly with a controlling
+ --     access parameter. Check that a subprogram dispatches correctly
+ --     when it has access parameters that are not controlling.
+ --     Check with and without default expressions.
+ --
+ -- TEST DESCRIPTION:
+ --      The three packages define layers of tagged types.  The root tagged
+ --      type contains a character value used to check that the right object
+ --      got passed to the right routine.  Each subprogram has a unique
+ --      TCTouch tag, upper case values are used for subprograms, lower case
+ --      values are used for object values.
+ --
+ --      Notes on style: the "tagged" comment lines --I and --A represent
+ --      commentary about what gets inherited and what becomes abstract,
+ --      respectively.  The author felt these to be necessary with this test
+ --      to reduce some of the additional complexities.
+ --
+ --3.9.2(16,17,18,20);6.0
+ --
+ -- CHANGE HISTORY:
+ --      22 SEP 95   SAIC   Initial version
+ --      22 APR 96   SAIC   Revised for 2.1
+ --      05 JAN 98   EDS    Change return type of C392010_2.Func_W_Non to make
+ --                         it override.
+ --      21 JUN 00   RLB    Changed expected result to reflect the appropriate
+ --                         value of the default expression.
+ --      20 JUL 00   RLB    Removed entire call pending resolution by the ARG.
+ 
+ --!
+ 
+ ----------------------------------------------------------------- C392010_0
+ 
+ package C392010_0 is
+ 
+   -- define a root tagged type
+   type Tagtype_Level_0 is tagged record
+     Ch_Item : Character;
+   end record;
+ 
+   type Access_Procedure is access procedure( P: Tagtype_Level_0 );
+ 
+   procedure Proc_1( P: Tagtype_Level_0 );
+ 
+   procedure Proc_2( P: Tagtype_Level_0 );
+ 
+   function A_Default_Value return Tagtype_Level_0;
+ 
+   procedure Proc_w_Ap_and_Cp( AP : Access_Procedure;
+                               Cp : Tagtype_Level_0 );
+     -- has both access procedure and controlling parameter
+ 
+   procedure Proc_w_Ap_and_Cp_w_Def( AP : Access_Procedure := Proc_2'Access;
+                                     Cp : Tagtype_Level_0
+                                        := A_Default_Value );   ------------ z
+     -- has both access procedure and controlling parameter with defaults
+ 
+   -- for the objective:
+ --     Check that access parameters may be controlling.
+ 
+   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_0 );
+     -- has access parameter that is controlling
+ 
+   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_0 )
+            return Tagtype_Level_0;
+     -- has access parameter that is controlling, and controlling result
+ 
+   Level_0_Global_Object : aliased Tagtype_Level_0
+                         := ( Ch_Item => 'a' );  ---------------------------- a
+ 
+ end C392010_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body C392010_0 is
+ 
+   procedure Proc_1( P: Tagtype_Level_0 ) is
+   begin
+     TCTouch.Touch('A');  --------------------------------------------------- A
+     TCTouch.Touch(P.Ch_Item);  -- depends on the value passed -------------- ?
+   end Proc_1;
+ 
+   procedure Proc_2( P: Tagtype_Level_0 ) is
+   begin
+     TCTouch.Touch('B');  --------------------------------------------------- B
+     TCTouch.Touch(P.Ch_Item);  -- depends on the value passed -------------- ?
+   end Proc_2;
+ 
+   function A_Default_Value return Tagtype_Level_0 is
+   begin
+     return (Ch_Item => 'z');  ---------------------------------------------- z
+   end A_Default_Value;
+ 
+   procedure Proc_w_Ap_and_Cp( Ap : Access_Procedure;
+                               Cp : Tagtype_Level_0 ) is
+   begin
+     TCTouch.Touch('C');  --------------------------------------------------- C
+     Ap.all( Cp );
+   end Proc_w_Ap_and_Cp;
+ 
+   procedure Proc_w_Ap_and_Cp_w_Def( AP : Access_Procedure := Proc_2'Access;
+                                     Cp : Tagtype_Level_0
+                                        := A_Default_Value ) is
+   begin
+     TCTouch.Touch('D');  --------------------------------------------------- D
+     Ap.all( Cp );
+   end Proc_w_Ap_and_Cp_w_Def;
+ 
+   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_0 ) is
+   begin
+     TCTouch.Touch('E');  --------------------------------------------------- E
+     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+   end Proc_w_Cp_Ap;
+ 
+   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_0 )
+            return Tagtype_Level_0 is
+   begin
+     TCTouch.Touch('F');  --------------------------------------------------- F
+     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+     return ( Ch_Item => 'b' );  -------------------------------------------- b
+   end Func_w_Cp_Ap_and_Cr;
+ 
+ end C392010_0;
+ 
+ ----------------------------------------------------------------- C392010_1
+ 
+ with C392010_0;
+ package C392010_1 is
+ 
+   type Tagtype_Level_1 is new C392010_0.Tagtype_Level_0 with record
+     Int_Item : Integer;
+   end record;
+ 
+   type Access_Tagtype_Level_1 is access all Tagtype_Level_1'Class;
+ 
+   -- the following procedures are inherited by the above declaration:
+   --I   procedure Proc_1( P: Tagtype_Level_1 );
+   --I
+   --I   procedure Proc_2( P: Tagtype_Level_1 );
+   --I
+   --I   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+   --I                               Cp : Tagtype_Level_1 );
+   --I
+   --I   procedure Proc_w_Ap_and_Cp_w_Def
+   --I             ( AP : C392010_0.Access_Procedure := Proc_2'Access;
+   --I               Cp : Tagtype_Level_1 := A_Default_Value );
+   --I
+   --I   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 );
+   --I
+ 
+   -- the following functions become abstract due to the above declaration:
+   --A   function A_Default_Value return Tagtype_Level_1;
+   --A
+   --A   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
+   --A            return Tagtype_Level_1;
+ 
+   -- so, in the interest of testing dispatching, we override them all:
+      -- except Proc_1 and Proc_2
+ 
+   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+                               Cp : Tagtype_Level_1 );
+ 
+   function A_Default_Value return Tagtype_Level_1;
+ 
+   procedure Proc_w_Ap_and_Cp_w_Def(
+               AP : C392010_0.Access_Procedure := C392010_0.Proc_2'Access;
+               Cp : Tagtype_Level_1 := A_Default_Value );
+ 
+  procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 );
+ 
+   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
+            return Tagtype_Level_1;
+ 
+   -- to test the objective:
+ --     Check that a subprogram dispatches correctly when it has
+ --     access parameters that are not controlling.
+ 
+   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_1;
+                         NonCp_Ap : access C392010_0.Tagtype_Level_0
+                              := C392010_0.Level_0_Global_Object'Access );
+ 
+   function Func_w_Non( Cp_Ap : access Tagtype_Level_1;
+                     NonCp_Ap : access C392010_0.Tagtype_Level_0
+                              := C392010_0.Level_0_Global_Object'Access )
+            return Access_Tagtype_Level_1;
+ 
+   Level_1_Global_Object : aliased Tagtype_Level_1
+                         := ( Int_Item => 0,
+                              Ch_Item  => 'c' );  --------------------------- c
+ 
+ end C392010_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body C392010_1 is
+ 
+   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+                               Cp : Tagtype_Level_1 ) is
+   begin
+     TCTouch.Touch('G');  --------------------------------------------------- G
+     Ap.All( C392010_0.Tagtype_Level_0( Cp ) );
+   end Proc_w_Ap_and_Cp;
+ 
+   procedure Proc_w_Ap_and_Cp_w_Def(
+               AP : C392010_0.Access_Procedure := C392010_0.Proc_2'Access;
+               Cp : Tagtype_Level_1 := A_Default_Value )
+   is
+   begin
+     TCTouch.Touch('H');  --------------------------------------------------- H
+     Ap.All( C392010_0.Tagtype_Level_0( Cp ) );
+   end Proc_w_Ap_and_Cp_w_Def;
+ 
+   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 ) is
+   begin
+     TCTouch.Touch('I');  --------------------------------------------------- I
+     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+   end Proc_w_Cp_Ap;
+ 
+   function A_Default_Value return Tagtype_Level_1 is
+   begin
+     return ( Int_Item => 0, Ch_Item  => 'y' );  ---------------------------- y
+   end A_Default_Value;
+ 
+   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
+            return Tagtype_Level_1 is
+   begin
+     TCTouch.Touch('J');  --------------------------------------------------- J
+     TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+     return ( Int_Item => 2, Ch_Item => 'd' );  ----------------------------- d
+   end Func_w_Cp_Ap_and_Cr;
+ 
+   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_1;
+                         NonCp_Ap : access C392010_0.Tagtype_Level_0
+                           := C392010_0.Level_0_Global_Object'Access ) is
+   begin
+     TCTouch.Touch('K');  --------------------------------------------------- K
+     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+   end Proc_w_Non;
+ 
+   Own_Item : aliased Tagtype_Level_1 := ( Int_Item => 3, Ch_Item => 'e' );
+ 
+   function Func_w_Non( Cp_Ap : access Tagtype_Level_1;
+                     NonCp_Ap : access C392010_0.Tagtype_Level_0
+                              := C392010_0.Level_0_Global_Object'Access )
+            return Access_Tagtype_Level_1 is
+   begin
+     TCTouch.Touch('L');  --------------------------------------------------- L
+     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+     return Own_Item'Access;  ----------------------------------------------- e
+   end Func_w_Non;
+ 
+ end C392010_1;
+ 
+ 
+ 
+ ----------------------------------------------------------------- C392010_2
+ 
+ with C392010_0;
+ with C392010_1;
+ package C392010_2 is
+ 
+   Lev2_Level_0_Global_Object : aliased C392010_0.Tagtype_Level_0
+                         := ( Ch_Item => 'f' );  ---------------------------- f
+ 
+   type Tagtype_Level_2 is new C392010_1.Tagtype_Level_1 with record
+     Another_Int_Item : Integer;
+   end record;
+ 
+   type Access_Tagtype_Level_2 is access all Tagtype_Level_2;
+ 
+   -- the following procedures are inherited by the above declaration:
+   --I   procedure Proc_1( P: Tagtype_Level_2 );
+   --I
+   --I   procedure Proc_2( P: Tagtype_Level_2 );
+   --I
+   --I   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+   --I                               Cp : Tagtype_Level_2 );
+   --I
+   --I   procedure Proc_w_Ap_and_Cp_w_Def
+   --I             (AP: C392010_0.Access_Procedure := C392010_0. Proc_2'Access;
+   --I              CP: Tagtype_Level_2 := A_Default_Value );
+   --I
+   --I   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_2 );
+   --I
+   --I   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
+   --I                         NonCp_Ap : access C392010_0.Tagtype_Level_0
+   --I                           := C392010_0.Level_0_Global_Object'Access );
+ 
+   -- the following functions become abstract due to the above declaration:
+   --A   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
+   --A            return Tagtype_Level_2;
+   --A
+   --A   function A_Default_Value
+   --A            return Access_Tagtype_Level_2;
+ 
+   -- so we override the interesting ones to check the objective:
+ --     Check that a subprogram with parameters of distinct tagged types may
+ --     be primitive for only one type (i.e. the other tagged types must be
+ --     declared in other packages).  Check that the subprogram does not
+ --     dispatch for the other type(s).
+ 
+   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
+                         NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                    := Lev2_Level_0_Global_Object'Access );
+ 
+   function Func_w_Non( Cp_Ap : access Tagtype_Level_2;
+                     NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                       := Lev2_Level_0_Global_Object'Access )
+            return C392010_1.Access_Tagtype_Level_1;
+ 
+   -- and override the other abstract functions
+   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
+            return Tagtype_Level_2;
+ 
+   function A_Default_Value return Tagtype_Level_2;
+ 
+ end C392010_2;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ with Report;
+ package body C392010_2 is
+ 
+   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
+                           NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                    := Lev2_Level_0_Global_Object'Access ) is
+   begin
+     TCTouch.Touch('M');  --------------------------------------------------- M
+     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+   end Proc_w_Non;
+ 
+   function A_Default_Value return Tagtype_Level_2 is
+   begin
+      return ( Another_Int_Item | Int_Item => 0, Ch_Item  => 'x' );  -------- x
+   end A_Default_Value;
+ 
+   Own : aliased Tagtype_Level_2
+                  := ( Another_Int_Item | Int_Item => 4, Ch_Item => 'g' );
+ 
+   function Func_w_Non( Cp_Ap : access Tagtype_Level_2;
+                              NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                       := Lev2_Level_0_Global_Object'Access )
+            return C392010_1.Access_Tagtype_Level_1 is
+   begin
+     TCTouch.Touch('N');  --------------------------------------------------- N
+     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+     TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+     return Own'Access;  ---------------------------------------------------- g
+   end Func_w_Non;
+ 
+   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
+            return Tagtype_Level_2 is
+   begin
+     TCTouch.Touch('P');  --------------------------------------------------- P
+     TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+     return ( Another_Int_Item | Int_Item => 5, Ch_Item => 'h' );  ---------- h
+  end Func_w_Cp_Ap_and_Cr;
+ 
+ end C392010_2;
+ 
+ 
+ 
+ ------------------------------------------------------------------- C392010
+ 
+ with Report;
+ with TCTouch;
+ with C392010_0, C392010_1, C392010_2;
+ 
+ procedure C392010 is
+ 
+   type Access_Class_0 is access all C392010_0.Tagtype_Level_0'Class;
+ 
+   -- define an array of class-wide pointers:
+   type Zero_Dispatch_List is array(Natural range <>) of Access_Class_0;
+ 
+   Item_0 : aliased C392010_0.Tagtype_Level_0 := ( Ch_Item  => 'k' );  ------ k
+   Item_1 : aliased C392010_1.Tagtype_Level_1 := ( Ch_Item  => 'm',    ------ m
+                                                   Int_Item => 1 );
+   Item_2 : aliased C392010_2.Tagtype_Level_2 := ( Ch_Item  => 'n',    ------ n
+                                                   Int_Item => 1,
+                                                   Another_Int_Item => 1 );
+ 
+   Z: Zero_Dispatch_List(1..3) := (Item_0'Access,Item_1'Access,Item_2'Access);
+ 
+   procedure Subtest_1( Items: Zero_Dispatch_List ) is
+     -- there is little difference between the actions for _1 and _2 in
+     -- this subtest due to the nature of _2 inheriting most operations
+     --
+     -- this subtest checks operations available to Level_0'Class
+   begin
+     for I in Items'Range loop
+ 
+       C392010_0.Proc_w_Ap_and_Cp( C392010_0.Proc_1'Access, Items(I).all );
+       -- CAk, GAm, GAn
+       -- actual is class-wide, operation should dispatch
+ 
+       case I is  -- use defaults
+         when 1 => C392010_0.Proc_w_Ap_and_Cp_w_Def;
+                   -- DBz
+         when 2 => C392010_1.Proc_w_Ap_and_Cp_w_Def;
+                   -- HBy
+         when 3 => null; -- Removed following pending resolution by ARG
+                   -- (see AI-00239):
+                   -- C392010_2.Proc_w_Ap_and_Cp_w_Def;
+                   -- HBx
+         when others => Report.Failed("Unexpected loop value");
+       end case;
+ 
+       C392010_0.Proc_w_Ap_and_Cp_w_Def   -- override defaults
+                 ( C392010_0.Proc_1'Access, Items(I).all );
+       -- DAk, HAm, HAn
+ 
+       C392010_0.Proc_w_Cp_Ap( Items(I) );
+       -- Ek, Im, In
+ 
+       -- function return value is controlling for procedure call
+       C392010_0.Proc_w_Ap_and_Cp_w_Def( C392010_0.Proc_1'Access,
+                                   C392010_0.Func_w_Cp_Ap_and_Cr( Items(I) ) );
+       -- FkDAb, JmHAd, PnHAh
+       -- note that the function evaluates first
+ 
+     end loop;
+   end Subtest_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   type Access_Class_1 is access all C392010_1.Tagtype_Level_1'Class;
+ 
+   type One_Dispatch_List is array(Natural range <>) of Access_Class_1;
+ 
+   Object_1 : aliased C392010_1.Tagtype_Level_1 := ( Ch_Item  => 'p',   ----- p
+                                                     Int_Item => 1 );
+   Object_2 : aliased C392010_2.Tagtype_Level_2 := ( Ch_Item  => 'q',   ----- q
+                                                     Int_Item => 1,
+                                             Another_Int_Item => 1 );
+ 
+   D: One_Dispatch_List(1..2) := (Object_1'Access, Object_2'Access);
+ 
+   procedure Subtest_2( Items: One_Dispatch_List ) is
+     -- this subtest checks operations available to Level_1'Class,
+     -- specifically those operations that are not testable in subtest_1,
+     -- the operations with parameters of the two tagged type objects.
+   begin
+     for I in Items'Range loop
+ 
+        C392010_1.Proc_w_Non(                               -- t_1,   t_2
+          C392010_1.Func_w_Non( Items(I),
+            C392010_0.Tagtype_Level_0(Z(I).all)'Access ),   -- Lpk    Nqm
+            C392010_0.Tagtype_Level_0(Z(I+1).all)'Access ); -- Kem    Mgn
+ 
+     end loop;
+   end Subtest_2;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C392010", "Check that a subprogram dispatches correctly " &
+                           "with a controlling access parameter. " &
+                           "Check that a subprogram dispatches correctly " &
+                           "when it has access parameters that are not " &
+                           "controlling. Check with and without default " &
+                           "expressions" );
+ 
+   Subtest_1( Z );
+ 
+   -- Original result:
+   --TCTouch.Validate( "CAkDBzDAkEkFkDAb"
+   --                & "GAmHByHAmImJmHAd"
+   --                & "GAnHBxHAnInPnHAh", "Subtest 1" );
+ 
+   -- Result pending resultion of AI-239:
+   TCTouch.Validate( "CAkDBzDAkEkFkDAb"
+                   & "GAmHByHAmImJmHAd"
+                   & "GAnHAnInPnHAh", "Subtest 1" );
+ 
+   Subtest_2( D );
+ 
+   TCTouch.Validate( "LpkKem" & "NqmMgn", "Subtest 2" );
+ 
+   Report.Result;
+ 
+ end C392010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,299 ----
+ -- C392011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that if a function call with a controlling result is itself
+ --     a controlling operand of an enclosing call on a dispatching operation,
+ --     then its controlling tag value is determined by the controlling tag
+ --     value of the enclosing call.
+ --
+ -- TEST DESCRIPTION:
+ --      The test builds and traverses a "ragged" list; a linked list which
+ --      contains data elements of three different types (all rooted at
+ --      Level_0'Class).  The traversal of this list checks the objective
+ --      by calling the dispatching operation "Check" using an item from the
+ --      list, and calling the function create; thus causing the controlling
+ --      result of the function to be determined by evaluating the value of
+ --      the other controlling parameter to the two-parameter Check.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      22 SEP 95   SAIC   Initial version
+ --      23 APR 96   SAIC   Corrected commentary, differentiated integer.
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C392011_0
+ 
+ package C392011_0 is
+ 
+   type Level_0 is tagged record
+     Ch_Item : Character;
+   end record;
+ 
+   function Create return Level_0;
+     -- primitive dispatching function
+ 
+   procedure Check( Left, Right: in Level_0 );
+     -- has controlling parameters
+ 
+ end C392011_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with TCTouch;
+ package body C392011_0 is
+ 
+   The_Character : Character := 'A';
+ 
+   function Create return Level_0 is
+     Created_Item_0 : constant Level_0 := ( Ch_Item => The_Character );
+   begin
+     The_Character := Character'Succ(The_Character);
+     TCTouch.Touch('A'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- A
+     return Created_Item_0;
+   end Create;
+ 
+   procedure Check( Left, Right: in Level_0 ) is
+   begin
+     TCTouch.Touch('B'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- B
+   end Check;
+ 
+ end C392011_0;
+ 
+ ----------------------------------------------------------------- C392011_1
+ 
+ with C392011_0;
+ package C392011_1 is
+ 
+   type Level_1 is new C392011_0.Level_0 with record
+     Int_Item : Integer;
+   end record;
+   
+   -- note that Create becomes abstract upon this derivation hence:
+ 
+   function Create return Level_1;
+ 
+   procedure Check( Left, Right: in Level_1 );
+ 
+ end C392011_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body C392011_1 is
+ 
+   Integer_1 : Integer := 0;
+ 
+   function Create return Level_1 is
+     Created_Item_1 : constant Level_1
+                    := ( C392011_0.Create with Int_Item => Integer_1 );
+     -- note call to     ^--------------^   -- A
+   begin
+     Integer_1 := Integer'Succ(Integer_1);
+     TCTouch.Touch('C'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- C
+     return Created_Item_1;
+   end Create;
+ 
+   procedure Check( Left, Right: in Level_1 ) is
+   begin
+     TCTouch.Touch('D'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- D
+   end Check;
+ 
+ end C392011_1;
+ 
+ ----------------------------------------------------------------- C392011_2
+ 
+ with C392011_1;
+ package C392011_2 is
+ 
+   type Level_2 is new C392011_1.Level_1 with record
+     Another_Int_Item : Integer;
+   end record;
+   
+   -- note that Create becomes abstract upon this derivation hence:
+ 
+   function Create return Level_2;
+ 
+   procedure Check( Left, Right: in Level_2 );
+ 
+ end C392011_2;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body C392011_2 is
+ 
+   Integer_2 : Integer := 100;
+ 
+   function Create return Level_2 is
+     Created_Item_2 : constant Level_2
+                  := ( C392011_1.Create with Another_Int_Item => Integer_2 );
+     -- note call to   ^--------------^   -- AC
+   begin
+     Integer_2 := Integer'Succ(Integer_2);
+     TCTouch.Touch('E'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- E
+     return Created_Item_2;
+   end Create;
+ 
+   procedure Check( Left, Right: in Level_2 ) is
+   begin
+     TCTouch.Touch('F'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- F
+   end Check;
+ 
+ end C392011_2;
+ 
+ ------------------------------------------------------- C392011_2.C392011_3
+ 
+ with C392011_0;
+ package C392011_2.C392011_3 is
+ 
+   type Wide_Reference is access all C392011_0.Level_0'Class;
+ 
+   type Ragged_Element;
+ 
+   type List_Pointer is access Ragged_Element;
+ 
+   type Ragged_Element is record
+     Data : Wide_Reference;
+     Next : List_Pointer;
+   end record;
+ 
+   procedure Build_List;
+ 
+   procedure Traverse_List;
+ 
+ end C392011_2.C392011_3;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C392011_2.C392011_3 is
+ 
+   The_List : List_Pointer;
+ 
+   procedure Build_List is
+   begin
+ 
+     -- build a list that looks like:
+     -- Level_2, Level_1, Level_2, Level_1, Level_0
+     --
+     -- the mechanism is to create each object, "pushing" the existing list
+     -- onto the end: cons( new_item, car, cdr )
+ 
+     The_List := 
+         new Ragged_Element'( new C392011_0.Level_0'(C392011_0.Create), null );
+     -- Level_0                                                            >> A
+ 
+     The_List := 
+     new Ragged_Element'( new C392011_1.Level_1'(C392011_1.Create), The_List );
+     -- Level_1 -> Level_0                                                >> AC
+ 
+     The_List := 
+     new Ragged_Element'( new C392011_2.Level_2'(C392011_2.Create), The_List );
+     -- Level_2 -> Level_1 -> Level_0                                    >> ACE
+ 
+     The_List := 
+     new Ragged_Element'( new C392011_1.Level_1'(C392011_1.Create), The_List );
+     -- Level_1 -> Level_2 -> Level_1 -> Level_0                          >> AC
+ 
+     The_List := 
+     new Ragged_Element'( new C392011_2.Level_2'(C392011_2.Create), The_List );
+     -- Level_2 -> Level_1 -> Level_2 -> Level_1 -> Level_0              >> ACE
+ 
+   end Build_List;
+ 
+   procedure Traverse_List is
+ 
+     Next_Item : List_Pointer := The_List;
+ 
+   -- Check that if a function call with a controlling result is itself
+   -- a controlling operand of an enclosing call on a dispatching operation,
+   -- then its controlling tag value is determined by the controlling tag
+   -- value of the enclosing call.
+ 
+   -- Level_2 -> Level_1 -> Level_2 -> Level_1 -> Level_0
+ 
+   begin
+ 
+     while Next_Item /= null loop  -- here we go!
+       -- these calls better dispatch according to the value in the particular
+       -- list item; causing the call to create to dispatch accordingly.
+       -- why do it twice?  To make sure order makes no difference
+ 
+       C392011_0.Check(Next_Item.Data.all, C392011_0.Create);
+       -- Create will touch first, then Check touches
+ 
+       C392011_0.Check(C392011_0.Create, Next_Item.Data.all); 
+ 
+       -- Here's what's s'pos'd to 'appen:
+       -- Check( Lev_2, Create ) >> ACEF
+       -- Check( Create, Lev_2 ) >> ACEF
+       -- Check( Lev_1, Create ) >> ACD
+       -- Check( Create, Lev_1 ) >> ACD
+       -- Check( Lev_2, Create ) >> ACEF
+       -- Check( Create, Lev_2 ) >> ACEF
+       -- Check( Lev_1, Create ) >> ACD
+       -- Check( Create, Lev_1 ) >> ACD
+       -- Check( Lev_0, Create ) >> AB
+       -- Check( Create, Lev_0 ) >> AB
+ 
+       Next_Item := Next_Item.Next;   
+     end loop;
+   end Traverse_List;
+ 
+ end C392011_2.C392011_3;
+ 
+ ------------------------------------------------------------------- C392011
+ 
+ with Report;
+ with TCTouch;
+ with C392011_2.C392011_3;
+ 
+ procedure C392011 is
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C392011", "Check that if a function call with a " &
+                           "controlling result is itself a controlling " &
+                           "operand of an enclosing call on a dispatching " &
+                           "operation, then its controlling tag value is " &
+                           "determined by the controlling tag value of " &
+                           "the enclosing call" );
+ 
+   C392011_2.C392011_3.Build_List;
+   TCTouch.Validate( "A" & "AC" & "ACE" & "AC" & "ACE", "Build List" );
+ 
+   C392011_2.C392011_3.Traverse_List;
+   TCTouch.Validate( "ACEFACEF" & 
+                     "ACDACD" &  
+                     "ACEFACEF" &  
+                     "ACDACD" &  
+                     "ABAB",
+                     "Traverse List" );
+ 
+   Report.Result;
+ 
+ end C392011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,179 ----
+ -- C392013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that the "/=" implicitly declared with the declaration of "=" for
+ --    a tagged type is legal and can be used in a dispatching call.
+ --    (Defect Report 8652/0010, as reflected in Technical Corrigendum 1).
+ --
+ -- CHANGE HISTORY:
+ --    23 JAN 2001   PHL   Initial version.
+ --    16 MAR 2001   RLB   Readied for release; added identity and negative
+ --                        result cases.
+ --    24 MAY 2001   RLB   Corrected the result for the 9 vs. 9 case.
+ --!
+ with Report;
+ use Report;
+ procedure C392013 is
+ 
+     package P1 is
+         type T is tagged
+             record
+                 C1 : Integer;
+             end record;
+         function "=" (L, R : T) return Boolean;
+     end P1;
+ 
+     package P2 is
+         type T is new P1.T with private;
+         function Make (Ancestor : P1.T; X : Float) return T;
+     private
+         type T is new P1.T with
+             record
+                 C2 : Float;
+             end record;
+         function "=" (L, R : T) return Boolean;
+     end P2;
+ 
+     package P3 is
+         type T is new P2.T with
+             record
+                 C3 : Character;
+             end record;
+     private
+         function "=" (L, R : T) return Boolean;
+         function Make (Ancestor : P1.T; X : Float) return T;
+     end P3;
+ 
+ 
+     package body P1 is separate;
+     package body P2 is separate;
+     package body P3 is separate;
+ 
+ 
+     type Cwat is access P1.T'Class;
+     type Cwat_Array is array (Positive range <>) of Cwat;
+ 
+     A : constant Cwat_Array :=
+        (1 => new P1.T'(C1 => Ident_Int (3)),
+         2 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 4.0)),
+         3 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (-5)), X => 4.2)),
+         4 => new P1.T'(C1 => Ident_Int (-3)),
+         5 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 3.6)),
+         6 => new P1.T'(C1 => Ident_Int (4)),
+         7 => new P3.T'(P2.Make
+                           (Ancestor => (C1 => Ident_Int (4)), X => 1.2) with
+                        Ident_Char ('a')),
+         8 => new P3.T'(P2.Make
+                           (Ancestor => (C1 => Ident_Int (-4)), X => 1.3) with
+                        Ident_Char ('A')),
+         9 => new P3.T'(P2.Make
+                           (Ancestor => (C1 => Ident_Int (4)), X => 1.0) with
+                        Ident_Char ('B')));
+ 
+     type Truth is ('F', 'T');
+     type Truth_Table is array (Positive range <>, Positive range <>) of Truth;
+ 
+     Equality : constant Truth_Table (A'Range, A'Range) := ("TFFTFFFFF",
+                                                            "FTTFTFFFF",
+                                                            "FTTFFFFFF",
+                                                            "TFFTFFFFF",
+                                                            "FTFFTFFFF",
+                                                            "FFFFFTFFF",
+                                                            "FFFFFFTTF",
+                                                            "FFFFFFTTF",
+                                                            "FFFFFFFFT");
+ 
+ begin
+     Test ("C392013", "Check that the ""/="" implicitly declared " &
+                         "with the declaration of ""="" for a tagged " &
+                         "type is legal and can be used in a dispatching call");
+ 
+     for I in A'Range loop
+         for J in A'Range loop
+ 	    -- Test identity:
+             if P1."=" (A (I).all, A (J).all) /=
+                   (not P1."/=" (A (I).all, A (J).all)) then
+                 Failed ("Incorrect identity comparing objects" &
+                         Positive'Image (I) & " and" & Positive'Image (J));
+             end if;
+             -- Test the result of "/=":
+             if Equality (I, J) = 'T' then
+                 if P1."/=" (A (I).all, A (J).all) then
+                     Failed ("Incorrect result comparing objects" &
+                            Positive'Image (I) & " and" & Positive'Image (J) & " - T");
+                 end if;
+             else
+                 if not P1."/=" (A (I).all, A (J).all) then
+                     Failed ("Incorrect result comparing objects" &
+                            Positive'Image (I) & " and" & Positive'Image (J) & " - F");
+                 end if;
+             end if;
+         end loop;
+     end loop;
+ 
+     Result;
+ end C392013;
+ separate (C392013)
+ package body P1 is
+ 
+     function "=" (L, R : T) return Boolean is
+     begin
+         return abs L.C1 = abs R.C1;
+     end "=";
+ 
+ end P1;
+ separate (C392013)
+ package body P2 is
+ 
+     function "=" (L, R : T) return Boolean is
+     begin
+         return P1."=" (P1.T (L), P1.T (R)) and then abs (L.C2 - R.C2) <= 0.5;
+     end "=";
+ 
+ 
+     function Make (Ancestor : P1.T; X : Float) return T is
+     begin
+         return (Ancestor with X);
+     end Make;
+ 
+ end P2;
+ with Ada.Characters.Handling;
+ separate (C392013)
+ package body P3 is
+ 
+     function "=" (L, R : T) return Boolean is
+     begin
+         return P2."=" (P2.T (L), P2.T (R)) and then
+                   Ada.Characters.Handling.To_Upper (L.C3) =
+                      Ada.Characters.Handling.To_Upper (R.C3);
+     end "=";
+ 
+     function Make (Ancestor : P1.T; X : Float) return T is
+     begin
+         return (P2.Make (Ancestor, X) with ' ');
+     end Make;
+ 
+ end P3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392014.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392014.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392014.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,227 ----
+ -- C392014.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that objects designated by X'Access (where X is of a class-wide
+ --    type) and new T'Class'(...) are dynamically tagged and can be used in
+ --    dispatching calls.  (Defect Report 8652/0010).
+ --
+ -- CHANGE HISTORY:
+ --    18 JAN 2001   PHL   Initial version
+ --    15 MAR 2001   RLB   Readied for release.
+ --    03 JUN 2004   RLB   Removed constraint for S0, as the subtype has
+ --                        unknown discriminants.
+ 
+ --!
+ package C392014_0 is
+ 
+     type T (D : Integer) is abstract tagged private;
+ 
+     procedure P (X : access T) is abstract;
+     function Create (X : Integer) return T'Class;
+ 
+     Result : Natural := 0;
+ 
+ private
+     type T (D : Integer) is abstract tagged null record;
+ end C392014_0;
+ 
+ with C392014_0;
+ package C392014_1 is
+     type T is new C392014_0.T with private;
+     function Create (X : Integer) return T'Class;
+ private
+     type T is new C392014_0.T with
+ 	record
+ 	    C1 : Integer;
+ 	end record;
+     procedure P (X : access T);
+ end C392014_1;
+ 
+ package C392014_1.Child is
+     type T is new C392014_1.T with private;
+     procedure P (X : access T);
+     function Create (X : Integer) return T'Class;
+ private
+     type T is new C392014_1.T with
+ 	record
+ 	    C1C : Integer;
+ 	end record;
+ end C392014_1.Child;
+ 
+ with Report;
+ use Report;
+ with C392014_1.Child;
+ package body C392014_1 is
+ 
+     procedure P (X : access T) is
+     begin
+ 	C392014_0.Result := C392014_0.Result + X.D + X.C1;
+     end P;
+ 
+     function Create (X : Integer) return T'Class is
+     begin
+ 	case X mod Ident_Int (2) is
+ 	    when 0 =>
+ 		return C392014_1.Child.Create (X / Ident_Int (2));
+ 	    when 1 =>
+ 		declare
+ 		    Y : T (D => (X / Ident_Int (2)) mod Ident_Int (20));
+ 		begin
+ 		    Y.C1 := X / Ident_Int (40);
+ 		    return T'Class (Y);
+ 		end;
+ 	    when others =>
+ 		null;
+ 	end case;
+     end Create;
+ 
+ end C392014_1;
+ 
+ with C392014_0;
+ with C392014_1;
+ package C392014_2 is
+     type T is new C392014_0.T with private;
+     function Create (X : Integer) return T'Class;
+ private
+     type T is new C392014_1.T with
+ 	record
+ 	    C2 : Integer;
+ 	end record;
+     procedure P (X : access T);
+ end C392014_2;
+ 
+ with Report;
+ use Report;
+ with C392014_1.Child;
+ with C392014_2;
+ package body C392014_0 is
+ 
+     function Create (X : Integer) return T'Class is
+     begin
+ 	case X mod 3 is
+ 	    when 0 =>
+ 		return C392014_1.Create (X / Ident_Int (3));
+ 	    when 1 =>
+ 		return C392014_1.Child.Create (X / Ident_Int (3));
+ 	    when 2 =>
+ 		return C392014_2.Create (X / Ident_Int (3));
+ 	    when others =>
+ 		null;
+ 	end case;
+     end Create;
+ 
+ end C392014_0;
+ 
+ with Report;
+ use Report;
+ with C392014_0;
+ package body C392014_1.Child is
+ 
+     procedure P (X : access T) is
+     begin
+ 	C392014_0.Result := C392014_0.Result + X.D + X.C1 + X.C1C;
+     end P;
+ 
+     function Create (X : Integer) return T'Class is
+ 	Y : T (D => X mod Ident_Int (20));
+     begin
+ 	Y.C1 := (X / Ident_Int (20)) mod Ident_Int (20);
+ 	Y.C1C := X / Ident_Int (400);
+ 	return T'Class (Y);
+     end Create;
+ 
+ end C392014_1.Child;
+ 
+ with Report;
+ use Report;
+ package body C392014_2 is
+ 
+     procedure P (X : access T) is
+     begin
+ 	C392014_0.Result := C392014_0.Result + X.D + X.C2;
+     end P;
+ 
+     function Create (X : Integer) return T'Class is
+ 	Y : T (D => X mod Ident_Int (20));
+     begin
+ 	Y.C2 := X / Ident_Int (600);
+ 	return T'Class (Y);
+     end Create;
+ 
+ end C392014_2;
+ 
+ with Report;
+ use Report;
+ with C392014_0;
+ with C392014_1.Child;
+ with C392014_2;
+ procedure C392014 is
+ 
+     subtype S0 is C392014_0.T'Class;
+     subtype S1 is C392014_1.T'Class;
+ 
+     X0 : aliased C392014_0.T'Class := C392014_0.Create (Ident_Int (5218));
+     X1 : aliased C392014_1.T'Class := C392014_1.Create (Ident_Int (8253));
+ 
+     Y0 : aliased S0 := C392014_0.Create (Ident_Int (2693));
+     Y1 : aliased S1 := C392014_1.Create (Ident_Int (5622));
+ 
+     procedure TC_Check (Subtest : String; Expected : Integer) is
+     begin
+ 	if C392014_0.Result = Expected then
+ 	    Comment ("Subtest " & Subtest & " Passed");
+ 	else
+ 	    Failed ("Subtest " & Subtest & " Failed");
+ 	end if;
+ 	C392014_0.Result := Ident_Int (0);
+     end TC_Check;
+ 
+ begin
+     Test ("C392014",
+ 	  "Check that objects designated by X'Access " &
+ 	     "(where X is of a class-wide type) and New T'Class'(...) " &
+ 	     "are dynamically tagged and can be used in dispatching " &
+ 	     "calls");
+ 
+     C392014_0.P (X0'Access);
+     TC_Check ("X0'Access", Ident_Int (29));
+     C392014_0.P (new C392014_0.T'Class'(C392014_0.Create (Ident_Int (12850))));
+     TC_Check ("New C392014_0.T'Class", Ident_Int (27));
+     C392014_1.P (X1'Access);
+     TC_Check ("X1'Access", Ident_Int (212));
+     C392014_1.P (new C392014_1.T'Class'(C392014_1.Create (Ident_Int (2031))));
+     TC_Check ("New C392014_1.T'Class", Ident_Int (65));
+     C392014_0.P (Y0'Access);
+     TC_Check ("Y0'Access", Ident_Int (18));
+     C392014_0.P (new S0'(C392014_0.Create (Ident_Int (6893))));
+     TC_Check ("New S0", Ident_Int (20));
+     C392014_1.P (Y1'Access);
+     TC_Check ("Y1'Access", Ident_Int (18));
+     C392014_1.P (new S1'(C392014_1.Create (Ident_Int (1861))));
+     TC_Check ("New S1", Ident_Int (56));
+ 
+     Result;
+ end C392014;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,265 ----
+ -- C392A01.A
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- OBJECTIVE:
+  --      Check that the use of a class-wide formal parameter allows for the 
+  --      proper dispatching of objects to the appropriate implementation of 
+  --      a primitive operation.  Check this for the root tagged type defined
+  --      in a package, and the extended type is defined in that same package.
+  --
+  -- TEST DESCRIPTION:
+  --      Declare a root tagged type, and some associated primitive operations.
+  --      Extend the root type, and override one or more primitive operations, 
+  --      inheriting the other primitive operations from the root type.
+  --      Derive from the extended type, again overriding some primitive
+  --      operations and inheriting others (including some that the parent 
+  --      inherited).
+  --      Define a subprogram with a class-wide parameter, inside of which is a 
+  --      call on a dispatching primitive operation.  These primitive operations
+  --      modify global variables (the class-wide parameter has mode IN).
+  --     
+  --     
+  --     
+  -- The following hierarchy of tagged types and primitive operations is 
+  -- utilized in this test:
+  --
+  --    type Bank_Account (root)
+  --            |
+  --            | Operations
+  --            |   Increment_Bank_Reserve
+  --            |   Assign_Representative
+  --            |   Increment_Counters
+  --            |   Open
+  --            |
+  --    type Savings_Account (extended from Bank_Account)
+  --            |
+  --            | Operations
+  --            |   (Increment_Bank_Reserve) (inherited)
+  --            |   Assign_Representative    (overridden)
+  --            |   Increment_Counters       (overridden)
+  --            |   Open                     (overridden)
+  --            |
+  --    type Preferred_Account (extended from Savings_Account)
+  --            |
+  --            | Operations
+  --            |   (Increment_Bank_Reserve) (inherited twice - Bank_Acct.)
+  --            |   (Assign_Representative)  (inherited - Savings_Acct.)
+  --            |   Increment_Counters       (overridden)
+  --            |   Open                     (overridden)
+  -- 
+  --
+  -- In this test, we are concerned with the following selection of dispatching
+  -- calls, accomplished with the use of a Bank_Account'Class IN procedure 
+  -- parameter :
+  --
+  --                       \ Type
+  --               Prim. Op \  Bank_Account  Savings_Account Preferred_Account
+  --                         \------------------------------------------------ 
+  --   Increment_Bank_Reserve|      X               X               X
+  --   Assign_Representative |                      X
+  --   Increment_Counters    |      X               X               X
+  --
+  --
+  --
+  -- The location of the declaration and derivation of the root and extended
+  -- types will be varied over a series of tests.  Locations of declaration
+  -- and derivation for a particular test are marked with an asterisk (*).
+  --
+  -- Root type:
+  --       
+  --    *  Declared in package.
+  --       Declared in generic package.
+  --
+  -- Extended types:
+  --
+  --    *  Derived in parent location.
+  --       Derived in a nested package.
+  --       Derived in a nested subprogram.
+  --       Derived in a nested generic package.
+  --       Derived in a separate package.
+  --       Derived in a separate visible child package.
+  --       Derived in a separate private child package.
+  --
+  -- Primitive Operations:
+  --
+  --    *  Procedures with same parameter profile.
+  --       Procedures with different parameter profile.
+  --       Functions with same parameter profile.
+  --       Functions with different parameter profile.
+  --       Mixture of Procedures and Functions.
+  --
+  --
+  -- TEST FILES:
+  --      This test depends on the following foundation code:
+  --
+  --         F392A00.A
+  --
+  --      The following files comprise this test:
+  --
+  --      => C392A01.A
+  --
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  with F392A00;         -- package Accounts
+  with Report;
+  
+  procedure C392A01 is
+  
+     package Accounts renames F392A00;
+  
+     -- Declare account objects.
+  
+     B_Account : Accounts.Bank_Account;
+     S_Account : Accounts.Savings_Account;
+     P_Account : Accounts.Preferred_Account;
+  
+     -- Procedures to operate on accounts.
+     -- Each uses a class-wide IN parameter, as well as a call to a
+     -- dispatching operation.
+  
+     -- Procedure Tabulate_Account performs a dispatching call on a primitive
+     -- operation that has been overridden for each of the extended types.
+  
+     procedure Tabulate_Account (Acct : in Accounts.Bank_Account'Class) is
+     begin
+        Accounts.Increment_Counters (Acct);   -- Dispatch according to tag.
+     end Tabulate_Account;
+  
+  
+     -- Procedure Accumulate_Reserve performs a dispatching call on a
+     -- primitive operation that has been defined for the root type and 
+     -- inherited by each derived type.
+  
+     procedure Accumulate_Reserve (Acct : in Accounts.Bank_Account'Class) is
+     begin
+        Accounts.Increment_Bank_Reserve (Acct);   -- Dispatch according to tag.
+     end Accumulate_Reserve;
+  
+  
+     -- Procedure Resolve_Dispute performs a dispatching call on a primitive
+     -- operation that has been defined in the root type, overridden in the
+     -- first derived extended type, and inherited by the subsequent extended
+     -- type.
+  
+     procedure Resolve_Dispute (Acct : in Accounts.Bank_Account'Class) is
+     begin
+        Accounts.Assign_Representative (Acct);   -- Dispatch according to tag.
+     end Resolve_Dispute;
+  
+  
+  
+  begin  -- Main test procedure.
+  
+     Report.Test ("C392A01", "Check that the use of a class-wide parameter "   &
+                              "allows for proper dispatching where root type " &
+                              "and extended types are declared in the same "   &
+                              "package" );
+     
+     Bank_Account_Subtest:
+     declare
+       use Accounts;
+     begin
+        Accounts.Open (B_Account);
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been defined for this specific type.
+        Accumulate_Reserve (Acct => B_Account);
+        Tabulate_Account (B_Account);
+  
+        if (Accounts.Bank_Reserve /= Accounts.Opening_Balance) or
+           (Accounts.Number_Of_Accounts (Bank) /= 1)           or
+           (Accounts.Number_Of_Accounts (Total) /= 1)
+        then
+           Report.Failed ("Failed in Bank_Account_Subtest");
+        end if;
+  
+     end Bank_Account_Subtest;
+  
+  
+     Savings_Account_Subtest:
+     declare
+       use Accounts;
+     begin
+        Accounts.Open (Acct => S_Account);
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been inherited by this extended type.
+        Accumulate_Reserve (Acct => S_Account);
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been overridden for this extended type.
+        Resolve_Dispute  (Acct => S_Account);
+        Tabulate_Account (S_Account);
+  
+        if Accounts.Bank_Reserve /= (3.0 * Accounts.Opening_Balance) or
+           Accounts.Daily_Representative /= Accounts.Manager         or
+           Accounts.Number_Of_Accounts (Savings) /= 1                or
+           Accounts.Number_Of_Accounts (Total) /= 2
+        then
+           Report.Failed ("Failed in Savings_Account_Subtest");
+        end if;
+  
+     end Savings_Account_Subtest;
+  
+  
+     Preferred_Account_Subtest:
+     declare
+       use Accounts;
+     begin
+        Accounts.Open (P_Account);
+  
+        -- Verify that the correct implementation of Open (overridden) was 
+        -- used for the Preferred_Account object.
+        if not Accounts.Verify_Open (P_Account) then
+           Report.Failed ("Incorrect values for init. Preferred Acct object");
+        end if;
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been twice inherited by this extended type.
+        Accumulate_Reserve (Acct => P_Account);
+  
+        -- Demonstrate class-wide parameter allowing dispatch by a primitive
+        -- operation that has been overridden for this extended type (the
+        -- operation was overridden by its parent type as well).
+        Tabulate_Account (P_Account);
+        
+        if Accounts.Bank_Reserve /= 1300.00             or
+           Accounts.Number_Of_Accounts (Preferred) /= 1 or
+           Accounts.Number_Of_Accounts (Total) /= 3
+        then
+           Report.Failed ("Failed in Preferred_Account_Subtest");
+        end if;
+  
+     end Preferred_Account_Subtest;
+  
+  
+     Report.Result;
+  
+  end C392A01;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392c05.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392c05.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392c05.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392c05.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C392C05.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that for a call to a dispatching subprogram the subprogram
+ --     body which is executed is determined by the controlling tag for
+ --     the case where the call has statically tagged controlling operands
+ --     of the type T.  Check this for various operands of tagged types:
+ --     objects (declared or allocated), formal parameters, view conversions,
+ --     function calls (both primitive and non-primitive).
+ --
+ -- TEST DESCRIPTION:
+ --      This test uses foundation F392C00 to test the usages of statically
+ --      tagged objects and values.  The calls to Validate indicate the
+ --      expected sequence of procedure calls since the previous call to
+ --      Validate.  Static tags can be determined at compile time, and
+ --      hence this is a test of correct overload resolution for tagged types.
+ --      A clever compiler which unrolls loops and does path analysis on
+ --      access values will be able to perform the same kind of determination
+ --      for all of the code in this test.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F392C00.A   (foundation code)
+ --         C392C05.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --      24 Oct 95   SAIC    Updated for ACVC 2.0.1
+ --      13 Feb 97   PWB.CTA Corrected assumption that "or" operands are
+ --                          evaluated in textual order.
+ --!
+ 
+ with Report;
+ with TCTouch;
+ with F392C00_1;
+ procedure C392C05 is -- Hardware_Store
+ 
+   package Switch renames F392C00_1;
+ 
+   subtype Switch_Class is Switch.Toggle'Class;
+ 
+   type Reference is access all Switch_Class;
+ 
+   A_Switch   : aliased Switch.Toggle;
+   A_Dimmer   : aliased Switch.Dimmer;
+   An_Autodim : aliased Switch.Auto_Dimmer;
+ 
+   type Light_Bank is array(Positive range <>) of Reference;
+ 
+   Lamps : Light_Bank(1..3);
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C392C05", "Check that a dispatching subprogram call is "
+                         & "determined by the controlling tag for statically "
+                         & "tagged controlling operands" );
+ 
+ -- Check use of static tagged declared objects,
+ --   and static tagged formal parameters
+ -- Must call correct version of flip based on type of controlling op.
+ 
+ -- Turn on the lights!
+ 
+   Switch.Flip( A_Switch );
+   TCTouch.Validate( "A", "Declared Toggle" );
+ 
+   Switch.Flip( A_Dimmer );
+   TCTouch.Validate( "GBA", "Declared Dimmer" );
+ 
+   Switch.Flip( An_Autodim );
+   TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" );
+ 
+   Lamps(1) := new Switch.Toggle;
+   Lamps(2) := new Switch.Dimmer;
+   Lamps(3) := new Switch.Auto_Dimmer;
+ 
+ -- Check use of static tagged allocated objects,
+ --   and static tagged formal parameters in a loop which may dynamically
+ --   dispatch.  If an optimizer unrolls the loop, it may then be statically
+ --   determined, and no dispatching will occur.  Either interpretation is
+ --   correct.
+   for Knob in Lamps'Range loop
+     Switch.Flip( Lamps(Knob).all );
+   end loop;
+   TCTouch.Validate( "AGBAKGBA", "Allocated Objects" );
+ 
+ -- Check use of static tagged declared objects,
+ --   calling non-primitive functions.
+   if not Switch.TC_Non_Disp( A_Switch ) then
+     Report.Failed( "Bad Value 1" );
+   end if;
+   TCTouch.Validate( "X", "Nonprimitive Function" );
+ 
+   if not Switch.TC_Non_Disp( A_Dimmer ) then
+     Report.Failed( "Bad Value 2" );
+   end if;
+   TCTouch.Validate( "Y", "Nonprimitive Function" );
+ 
+   if not Switch.TC_Non_Disp( An_Autodim ) then
+     Report.Failed( "Bad Value 3" );
+   end if;
+   TCTouch.Validate( "Z", "Nonprimitive Function" );
+ 
+   A_Switch   := Switch.Create;
+   A_Dimmer   := Switch.Create;
+   An_Autodim := Switch.Create;
+   TCTouch.Validate( "123", "Primitive Function" );
+ 
+ -- View conversions
+   Switch.Brighten( An_Autodim, 50 ); 
+ 
+   Switch.Flip( Switch.Toggle( A_Switch ) );
+   Switch.Flip( Switch.Toggle( A_Dimmer ) );
+   Switch.Flip( Switch.Dimmer( An_Autodim ) );
+   TCTouch.Validate( "DAAGBA", "View Conversions" );
+ 
+ -- statically tagged controlling operands (specific types) provided to
+ -- class-wide functions
+   if Switch.On( A_Switch )
+      or Switch.On( A_Dimmer )
+      or Switch.On( An_Autodim ) then
+     Report.Failed( "Bad Value 4" );
+   end if;
+   TCTouch.Validate( "BBB", "Class-wide" );
+ 
+ -- statically tagged controlling operands qualified expressions provided to
+ -- primitive functions, also using context to determine call to a
+ -- class-wide function.
+   if Switch.Off( Switch.Toggle'( Switch.Create ) )
+      or else Switch.Off( Switch.Dimmer'( Switch.Create ) )
+      or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then
+     Report.Failed( "Bad Value 5" );
+   end if;
+   TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" );
+ 
+   Report.Result;
+ 
+ end C392C05;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392c07.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392c07.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392c07.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392c07.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,190 ----
+ -- C392C07.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that for a call to a dispatching subprogram the subprogram
+ --     body which is executed is determined by the controlling tag for
+ --     the case where the call has dynamic tagged controlling operands
+ --     of the type T.  Check for calls to these same subprograms where
+ --     the operands are of specific statically tagged types:
+ --     objects (declared or allocated), formal parameters, view
+ --     conversions, and function calls (both primitive and non-primitive).
+ --
+ -- TEST DESCRIPTION:
+ --      This test uses foundation F392C00 to test the usages of statically
+ --      tagged objects and values.  This test is derived in part from
+ --      C392C05.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      24 Oct 95   SAIC    Updated for ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with TCTouch;
+ with F392C00_1;
+ procedure C392C07 is -- Hardware_Store
+   package Switch renames F392C00_1;
+ 
+   subtype Switch_Class is Switch.Toggle'Class;
+ 
+   type Reference is access all Switch_Class;
+ 
+   A_Switch   : aliased Switch.Toggle;
+   A_Dimmer   : aliased Switch.Dimmer;
+   An_Autodim : aliased Switch.Auto_Dimmer;
+ 
+   type Light_Bank is array(Positive range <>) of Reference;
+ 
+   Lamps : Light_Bank(1..3);
+ 
+ -- dynamically tagged controlling operands : class wide formal parameters
+   procedure Clamp( Device : in out Switch_Class; On : Boolean := False ) is
+   begin
+     if Switch.On( Device ) /= On then                  
+       Switch.Flip( Device );                           
+     end if;
+   end Clamp;
+   function Class_Item(Bank_Pos: Positive) return Switch_Class is
+   begin
+     return Lamps(Bank_Pos).all;
+   end Class_Item;
+ 
+ begin  -- Main test procedure.
+   Report.Test ("C392C07", "Check that a dispatching subprogram call is "
+                         & "determined by the controlling tag for "
+                         & "dynamically tagged controlling operands" );
+ 
+   Lamps := ( A_Switch'Access, A_Dimmer'Access, An_Autodim'Access );
+ 
+ -- dynamically tagged operands referring to
+ -- statically tagged declared objects
+   for Knob in Lamps'Range loop
+     Clamp( Lamps(Knob).all, On => True );
+   end loop;
+   TCTouch.Validate( "BABGBABKGBA", "Clamping On Lamps" );
+ 
+   Lamps(1) := new Switch.Toggle;
+   Lamps(2) := new Switch.Dimmer;
+   Lamps(3) := new Switch.Auto_Dimmer;
+ 
+ -- turn the full bank of switches ON
+ -- dynamically tagged allocated objects
+   for Knob in Lamps'Range loop
+     Clamp( Lamps(Knob).all, On => True );
+   end loop;
+   TCTouch.Validate( "BABGBABKGBA", "Dynamic Allocated");
+ 
+ -- Double check execution correctness
+   if Switch.Off( Lamps(1).all )
+      or Switch.Off( Lamps(2).all )
+      or Switch.Off( Lamps(3).all ) then
+     Report.Failed( "Bad Value" );
+   end if;
+   TCTouch.Validate( "CCC", "Class-wide");
+ 
+ -- turn the full bank of switches OFF
+   for Knob in Lamps'Range loop
+     Switch.Flip( Lamps(Knob).all );
+   end loop;
+   TCTouch.Validate( "AGBAKGBA", "Dynamic Allocated, Primitive Ops");
+ 
+ -- check switches for OFF
+ -- a few function calls as operands
+   for Knob in Lamps'Range loop
+     if not Switch.Off( Class_Item(Knob) ) then
+       Report.Failed("At function tests, Switch not OFF");
+     end if;
+   end loop;
+   TCTouch.Validate( "CCC",
+                          "Using function returning class-wide type");
+ 
+ -- Switches are all OFF now.
+ -- dynamically tagged view conversion
+   Clamp( Switch_Class( A_Switch ) );         
+   Clamp( Switch_Class( A_Dimmer ) );         
+   Clamp( Switch_Class( An_Autodim ) );       
+   TCTouch.Validate( "BABGBABKGBA", "View Conversions" );
+ 
+ -- dynamically tagged controlling operands : declared class wide objects
+ --  calling primitive functions
+   declare
+     Dine_O_Might : Switch_Class := Switch.TC_CW_TI( 't' );  
+   begin
+     Switch.Flip( Dine_O_Might );                            
+     if Switch.On( Dine_O_Might ) then                       
+       Report.Failed( "Exploded at Dine_O_Might" );
+     end if;
+     TCTouch.Validate( "WAB", "Dispatching function 1" );
+   end;
+ 
+   declare
+     Dyne_A_Mite : Switch_Class := Switch.TC_CW_TI( 'd' );   
+   begin
+     Switch.Flip( Dyne_A_Mite );                             
+     if Switch.On( Dyne_A_Mite ) then                        
+       Report.Failed( "Exploded at Dyne_A_Mite" );
+     end if;
+     TCTouch.Validate( "WGBAB", "Dispatching function 2" );
+   end;
+ 
+   declare
+     Din_Um_Out : Switch_Class := Switch.TC_CW_TI( 'a' );    
+   begin
+     Switch.Flip( Din_Um_Out );                              
+     if Switch.Off( Din_Um_Out ) then                        
+       Report.Failed( "Exploded at Din_Um_Out" );
+     end if;
+     TCTouch.Validate( "WKCC", "Dispatching function 3" );
+ 
+ -- Non-dispatching function calls.
+     if not Switch.TC_Non_Disp( Switch.Toggle( Din_Um_Out ) ) then
+       Report.Failed( "Non primitive, via view conversion" );
+     end if;
+     TCTouch.Validate( "X", "View Conversion 1" );
+ 
+     if not Switch.TC_Non_Disp( Switch.Dimmer( Din_Um_Out ) ) then
+       Report.Failed( "Non primitive, via view conversion" );
+     end if;
+     TCTouch.Validate( "Y", "View Conversion 2" );
+   end;
+ 
+   -- a few more function calls as operands (oops)
+   if not Switch.On( Switch.Toggle'( Switch.Create ) ) then 
+     Report.Failed("Toggle did not create ""On""");
+   end if;
+ 
+   if Switch.Off( Switch.Dimmer'( Switch.Create ) ) then 
+     Report.Failed("Dimmer created ""Off""");
+   end if;
+ 
+   if Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then 
+     Report.Failed("Auto_Dimmer created ""Off""");
+   end if;
+ 
+   Report.Result;
+ end C392C07;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392d01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392d01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392d01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392d01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,324 ----
+ -- C392D01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for an implicitly declared dispatching operation that is
+ --      overridden, the body executed is the body for the overriding
+ --      subprogram, even if the overriding occurs in a private part.
+ --      Check that, for an implicitly declared dispatching operation that is
+ --      NOT overridden, the body executed is the body of the corresponding
+ --      subprogram of the parent type.
+ --
+ --      Check for the case where the overriding (and non-overriding) operations
+ --      are declared for a private extension (and its full type) in a public
+ --      child unit of the package declaring the ancestor type, and the ancestor
+ --      type is a tagged private type whose full view is itself a derived type.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      package Parent is
+ --         type Root is tagged ...
+ --         procedure Vis_Op (P: Root);
+ --      private
+ --         procedure Pri_Op (P: Root);                     -- (A)
+ --      end Parent;
+ --
+ --      package Intermediate is
+ --         type Mid is tagged private;
+ --      private
+ --         type Mid is new Parent.Root with record ...
+ --         -- Implicit Vis_Op (P: Mid) declared here.
+ --
+ --         procedure Vis_Op (P: Mid);                      -- (B)
+ --      end Intermediate;
+ --
+ --      package Intermediate.Child is
+ --         type Derived is new Mid with private; 
+ --
+ --         procedure Pri_Op (P: Derived);                  -- (C)
+ --         ...
+ --
+ --      private
+ --         type Derived is new Mid with record...
+ --         -- Implicit Vis_Op (P: Derived) declared here.
+ --         ...
+ --      end Intermediate.Child;
+ --
+ --      Type Derived inherits Vis_Op from the parent type Mid. Note, however,
+ --      that it is implicitly declared in the private part (inherited
+ --      subprograms for a derived_type_definition -- in this case, the full
+ --      type -- are implicitly declared at the  earliest place within the
+ --      immediate scope of the type_declaration where the corresponding
+ --      declaration from the parent is visible).
+ --
+ --      Because Parent.Pri_Op is never visible within the immediate scope
+ --      of Mid, it is not implicitly declared for Mid. Thus, it is also not
+ --      implicitly declared for Derived. As a result, the version of Pri_Op
+ --      declared at (C) above does not override an inherited version of
+ --      Parent.Pri_Op and is totally unrelated to it.
+ --
+ --      Dispatching calls with tag Mid will execute (A) and (B). Dispatching 
+ --      calls with tag Derived from Parent will execute the bodies of (B) 
+ --      and (A).  Dispatching calls with tag Derived from Parent.Child
+ --      will execute the bodies of (B) and (C).  
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F392D00.A
+ --         C392D01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with F392D00;
+ package C392D01_0 is
+ 
+    type Zoom_Camera is tagged private;
+ 
+    procedure Self_Test (C : in out Zoom_Camera'Class);
+ 
+    -- ...Additional operations.
+ 
+ 
+    function TC_Correct_Result (C : Zoom_Camera;
+                                D : F392D00.Depth_Of_Field;
+                                S : F392D00.Shutter_Speed) return Boolean;
+ 
+ private
+ 
+    type Magnification is (Low, Medium, High);
+ 
+    type Zoom_Camera is new F392D00.Remote_Camera with record
+       Mag : Magnification;
+    end record;
+ 
+    -- procedure Focus (C     : in out Zoom_Camera;               -- Implicitly
+    --                  Depth : in     Depth_Of_Field)            -- declared
+                                                                  -- here.
+ 
+    procedure Focus (C     : in out Zoom_Camera;                -- Overrides
+                     Depth : in     F392D00.Depth_Of_Field);    -- inherited op.
+ 
+    -- For the remote zoom camera, perhaps the focusing algorithm is different
+    -- in some way, so the original Focus operation is overridden here.
+ 
+    -- Since the partial view is not an extension, the overriding operation
+    -- must be declared after the full type. This version of Focus, although
+    -- not visible for type Zoom_Camera from outside the package, can still be
+    -- dispatched to.  
+ 
+ 
+    -- Note: F392D00.Set_Shutter_Speed is inherited by Zoom_Camera from
+    -- F392D00.Remote_Camera, but since the operation never becomes visible
+    -- within the immediate scope of Zoom_Camera, it is never implicitly
+    -- declared. 
+ 
+ end C392D01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C392D01_0 is
+ 
+    procedure Focus (C     : in out Zoom_Camera;
+                     Depth : in     F392D00.Depth_Of_Field) is
+    begin
+       -- Artificial for testing purposes.
+       C.DOF := 83;
+    end Focus;
+ 
+    -----------------------------------------------------------
+    -- Indirect call to F392D00.Self_Test since the main does not know 
+    -- that Zoom_Camera is a private extension of F392D00.Basic_Camera.
+    procedure Self_Test (C : in out Zoom_Camera'Class) is
+    begin
+       F392D00.Self_Test (C);
+       -- ...Additional self-testing.
+    end Self_Test;
+ 
+    -----------------------------------------------------------
+    function TC_Correct_Result (C : Zoom_Camera;
+                                D : F392D00.Depth_Of_Field;
+                                S : F392D00.Shutter_Speed) return Boolean is
+       use type F392D00.Depth_Of_Field;
+       use type F392D00.Shutter_Speed;
+    begin
+       return (C.DOF = D and C.Shutter = S);
+    end TC_Correct_Result;
+ 
+ end C392D01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F392D00;
+ package C392D01_0.C392D01_1 is
+ 
+    type Film_Speed is private;
+ 
+    type Auto_Speed is new Zoom_Camera with private;
+ 
+    -- Implicit function TC_Correct_Result (Auto_Speed) declared here.
+ 
+    procedure Set_Shutter_Speed (C     : in out Auto_Speed;     
+                                 Speed : in     F392D00.Shutter_Speed); 
+ 
+    -- This version of Set_Shutter_Speed does NOT override the operation
+    -- inherited from Zoom_Camera, because the inherited operation is never
+    -- visible (and thus, is never implicitly declared) within the immediate
+    -- scope of type Auto_Speed.
+ 
+    procedure Self_Test (C : in out Auto_Speed'Class);
+ 
+    -- ...Other operations.
+ 
+ private
+    type Film_Speed is (One_Hundred, Two_Hundred, Four_Hundred);
+ 
+    type Auto_Speed is new Zoom_Camera with record
+       ASA : Film_Speed;
+    end record;
+ 
+    -- procedure Focus (C     : in out Auto_Speed;                -- Implicitly
+    --                  Depth : in     F392D00.Depth_Of_Field);   -- declared
+                                                                  -- here.
+ 
+ end C392D01_0.C392D01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C392D01_0.C392D01_1 is
+ 
+    procedure Set_Shutter_Speed (C     : in out Auto_Speed;
+                                 Speed : in     F392D00.Shutter_Speed) is
+    begin
+       -- Artificial for testing purposes.
+       C.Shutter := F392D00.Two_Fifty;
+    end Set_Shutter_Speed;
+ 
+    -------------------------------------------------------
+    procedure Self_Test (C : in out Auto_Speed'Class) is
+    begin
+       -- Artificial for testing purposes.
+       Set_Shutter_Speed (C, F392D00.Thousand);
+       Focus (C, 27);
+    end Self_Test;
+ 
+ end C392D01_0.C392D01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F392D00;
+ with C392D01_0.C392D01_1;
+ 
+ with Report;
+ 
+ procedure C392D01 is
+    Zooming_Camera : C392D01_0.Zoom_Camera;
+    Auto_Camera1   : C392D01_0.C392D01_1.Auto_Speed;
+    Auto_Camera2   : C392D01_0.C392D01_1.Auto_Speed;
+ 
+    TC_Expected_Zoom_Depth : constant F392D00.Depth_Of_Field := 83;
+    TC_Expected_Auto_Depth : constant F392D00.Depth_Of_Field := 83;
+    TC_Expected_Depth      : constant F392D00.Depth_Of_Field := 83;
+    TC_Expected_Zoom_Speed : constant F392D00.Shutter_Speed 
+                           := F392D00.Thousand;
+    TC_Expected_Auto_Speed : constant F392D00.Shutter_Speed 
+                           := F392D00.Thousand;
+    TC_Expected_Speed      : constant F392D00.Shutter_Speed 
+                           := F392D00.Two_Fifty;
+ 
+    use type F392D00.Depth_Of_Field;
+    use type F392D00.Shutter_Speed;
+ 
+ begin
+    Report.Test ("C392D01", "Dispatching for overridden and non-overridden "   &
+                 "primitive subprograms: private extension declared in child " &
+                 "unit, parent is tagged private whose full view is derived  " &
+                 "type");
+ 
+ 
+ 
+ -- Call the class-wide operation (Self_Test) for Zoom_Camera'Class, which 
+ -- itself calls the class-wide operation for Remote_Camera'Class, which
+ -- in turn makes dispatching calls to Focus and Set_Shutter_Speed:
+ 
+ 
+    -- For an object of type Zoom_Camera, the dispatching call to Focus should
+    -- dispatch to the body explicitly declared for Zoom_Camera. The dispatching
+    -- to Set_Shutter_Speed should dispatch to the body declared for
+    -- Remote_Camera:
+      
+    C392D01_0.Self_Test(Zooming_Camera);
+ 
+    if not C392D01_0.TC_Correct_Result (Zooming_Camera,
+                                        TC_Expected_Zoom_Depth,
+                                        TC_Expected_Zoom_Speed)
+    then
+       Report.Failed ("Calls dispatched incorrectly for tagged private type");
+    end if;
+ 
+    -- For an object of type Auto_Speed, the dispatching call to Focus should
+    -- dispatch to the body explicitly declared for Zoom_Camera. The dispatching
+    -- call to Set_Shutter_Speed should dispatch to the body explicitly declared 
+    -- for Remote_Camera:
+      
+    C392D01_0.Self_Test(Auto_Camera1);
+ 
+    if not C392D01_0.C392D01_1.TC_Correct_Result (Auto_Camera1,
+                                                  TC_Expected_Auto_Depth,
+                                                  TC_Expected_Auto_Speed)
+    then
+       Report.Failed ("Calls dispatched incorrectly for private extension");
+    end if;
+ 
+    -- Call to Self_Test from C392D01_0.C392D01_1 invokes the dispatching call
+    -- to Focus which should dispatch to the body explicitly declared for 
+    -- Zoom_Camera. The dispatching call to Set_Shutter_Speed should dispatch 
+    -- to the body explicitly declared for Auto_Speed:
+ 
+    C392D01_0.C392D01_1.Self_Test(Auto_Camera2);
+ 
+    if not C392D01_0.C392D01_1.TC_Correct_Result (Auto_Camera2,
+                                                  TC_Expected_Depth,
+                                                  TC_Expected_Speed)
+    then
+       Report.Failed ("Call to explicit subprogram executed the wrong body");
+    end if;
+ 
+    Report.Result;
+ 
+ end C392D01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392d02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392d02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392d02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392d02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,185 ----
+ -- C392D02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a primitive procedure declared in a private part is not
+ --      overridden by a procedure explicitly declared at a place where the
+ --      primitive procedure in question is not visible.
+ --
+ --      Check for the case where the non-overriding operation is declared in a
+ --      separate (non-child) package from that declaring the parent type, and
+ --      the descendant type is a record extension.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      package P is
+ --         type Root is tagged ...
+ --      private
+ --         procedure Pri_Op (A: Root);
+ --      end P;
+ --
+ --      with P;
+ --      package Q is
+ --         type Derived is new P.Root with record...
+ --         procedure Pri_Op (A: Derived);  -- Does NOT override parent's Op.
+ --         ...
+ --      end Q;
+ --
+ --      Type Derived inherits Pri_Op from the parent type Root. However,
+ --      because P.Pri_Op is never visible within the immediate scope of
+ --      Derived, it is not implicitly declared for Derived. As a result,
+ --      the explicit Q.Pri_Op does not override P.Pri_Op and is totally
+ --      unrelated to it.
+ --
+ --      Dispatching calls to P.Pri_Op with operands of tag Derived will
+ --      not dispatch to Q.Pri_Op; the body executed will be that of P.Pri_Op.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F392D00.A
+ --         C392D02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with F392D00;
+ package C392D02_0 is
+ 
+    type Aperture is (Eight, Sixteen);     
+ 
+    type Auto_Speed is new F392D00.Remote_Camera with record
+       -- ...
+       FStop : Aperture;
+    end record;
+ 
+ 
+    procedure Set_Shutter_Speed (C     : in out Auto_Speed;     
+                                 Speed : in     F392D00.Shutter_Speed); 
+                                                    -- Does NOT override.
+ 
+    -- This version of Set_Shutter_Speed does NOT override the operation
+    -- inherited from the parent, because the inherited operation is never
+    -- visible (and thus, is never implicitly declared) within the immediate
+    -- scope of type Auto_Speed.
+ 
+    procedure Self_Test (C : in out Auto_Speed'Class);
+ 
+    -- ...Other operations.
+ 
+ end C392D02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C392D02_0 is
+ 
+    procedure Set_Shutter_Speed (C     : in out Auto_Speed;
+                                 Speed : in     F392D00.Shutter_Speed) is
+    begin
+       -- Artificial for testing purposes.
+       C.Shutter := F392D00.Four_Hundred;
+    end Set_Shutter_Speed;
+ 
+    ----------------------------------------------------
+    procedure Self_Test (C : in out Auto_Speed'Class) is
+    begin
+       -- Should dispatch to the Set_Shutter_Speed explicitly declared
+       -- for Auto_Speed.
+       Set_Shutter_Speed (C, F392D00.Two_Fifty);
+    end Self_Test;
+ 
+ end C392D02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F392D00;
+ with C392D02_0;
+ 
+ with Report;
+ 
+ procedure C392D02 is
+    Basic_Camera : F392D00.Remote_Camera;
+    Auto_Camera1 : C392D02_0.Auto_Speed;
+    Auto_Camera2 : C392D02_0.Auto_Speed;
+ 
+    TC_Expected_Basic_Speed : constant F392D00.Shutter_Speed 
+                            := F392D00.Thousand;
+    TC_Expected_Speed       : constant F392D00.Shutter_Speed 
+                            := F392D00.Four_Hundred;
+ 
+    use type F392D00.Shutter_Speed;
+ 
+ begin
+    Report.Test ("C392D02", "Dispatching for non-overridden primitive " &
+                 "subprograms: record extension declared in non-child " &
+                 "package, parent is tagged record");
+ 
+ -- Call the class-wide operation for Remote_Camera'Class, which dispatches
+ -- to Set_Shutter_Speed:
+ 
+    -- For an object of type Remote_Camera, the dispatching call should
+    -- dispatch to the body declared for the root type:
+      
+    F392D00.Self_Test(Basic_Camera);
+ 
+    if Basic_Camera.Shutter /= TC_Expected_Basic_Speed then
+       Report.Failed ("Call dispatched incorrectly for root type");
+    end if;
+ 
+ 
+    -- C392D02_0.Set_Shutter_Speed should never be called by F392D00.Self_Test,
+    -- since C392D02_0.Set_Shutter_Speed does not override
+    -- F392D00.Set_Shutter_Speed.
+ 
+    -- For an object of type Auto_Speed, the dispatching call should
+    -- also dispatch to the body declared for the root type:
+      
+    F392D00.Self_Test(Auto_Camera1);
+ 
+    if Auto_Camera1.Shutter /= TC_Expected_Basic_Speed then
+       Report.Failed ("Call dispatched incorrectly for derived type");
+    end if;
+ 
+    -- Call to Self_Test from C392D02_0 invokes the dispatching call to
+    -- Set_Shutter_Speed which should dispatch to the body explicitly declared 
+    -- for Auto_Speed:
+ 
+    C392D02_0.Self_Test(Auto_Camera2);
+ 
+    if Auto_Camera2.Shutter /= TC_Expected_Speed then
+       Report.Failed ("Call to explicit subprogram executed the wrong body");
+    end if;
+ 
+    Report.Result;
+ 
+ end C392D02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392d03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392d03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c392d03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c392d03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,248 ----
+ -- C392D03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for an inherited dispatching operation that is overridden,
+ --      the body executed is the body of the overriding subprogram, even if
+ --      the overriding occurs in a private part.
+ --
+ --      Check for the case where the overriding operation is declared in a
+ --      separate (non-child) package from that declaring the parent type, and
+ --      the descendant type is a record extension.
+ --
+ --      Check for both dispatching and nondispatching calls.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      package P is
+ --         type Root is tagged ...
+ --         procedure Op (A: Root);
+ --      end P;
+ --
+ --      with P;
+ --      package Q is
+ --         type Derived1 is new P.Root with record...
+ --         -- Implicit procedure Op (A: Derived1) declared here.
+ --         type Derived2 is new P.Root with private...
+ --         -- Implicit procedure Op (A: Derived2) declared here.
+ --         type New_Derived is new Derived1 with private...
+ --         -- Implicit procedure Op (A: New_Derived) declared here.
+ --      private
+ --         procedure Op (A: Derived1);  -- Overrides parent's Op.
+ --         type Derived2 is new P.Root with record...
+ --         procedure Op (A: Derived2);  -- Overrides parent's Op.
+ --         type New_Derived is new Derived1 with record...
+ --         ...
+ --      end Q;
+ --
+ --      Both type Derived1 and Derived2 inherit Op from the parent type Root. 
+ --      Type New_Derived inherits (inherited) Op from Derived1.  The inherited 
+ --      operation is implicitly declared immediately after the type extension.  
+ --      The inherited operation is overridden by an explicit declaration in 
+ --      the private part. Even though the overriding operation is private, 
+ --      calls to Op with an operand of tag Derived1, Derived2, or New_Derived
+ --      will execute the body of the overriding operation.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F392D00.A
+ --         C392D03.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with F392D00;
+ package C392D03_0 is
+ 
+    type Aperture is (Eight, Sixteen);     
+ 
+    type Auto_Focus is new F392D00.Remote_Camera with record
+       -- ...
+       FStop : Aperture;
+    end record;
+ 
+    -- Implicit procedure Focus (C     : in out Auto_Focus;
+    --                           Depth : in     Depth_Of_Field) declared here.
+ 
+    type Auto_Flashing is new F392D00.Remote_Camera with private;
+ 
+    -- Implicit procedure Focus (C     : in out Auto_Flashing;
+    --                           Depth : in     Depth_Of_Field) declared here.
+ 
+    type Special_Focus is new Auto_Focus with private;
+ 
+    -- Implicit procedure Focus (C     : in out Special_Focus;
+    --                           Depth : in     Depth_Of_Field) declared here.
+ 
+    -- ...Other operations.
+ 
+ private
+ 
+    procedure Focus (C     : in out Auto_Focus;              -- Overrides
+                     Depth : in     F392D00.Depth_Of_Field); -- parent's op.
+ 
+    -- For the improved remote camera, focus is set automatically, so it is
+    -- declared as a private operation.
+ 
+    type Auto_Flashing is new F392D00.Remote_Camera with null record;
+ 
+    procedure Focus (C     : in out Auto_Flashing;           -- Overrides
+                     Depth : in     F392D00.Depth_Of_Field); -- parent's op.
+ 
+    type Special_Focus is new Auto_Focus with null record;
+ 
+ end C392D03_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C392D03_0 is
+ 
+    procedure Focus (C     : in out Auto_Focus;
+                     Depth : in     F392D00.Depth_Of_Field) is
+    begin
+       -- Artificial for testing purposes.
+       C.DOF := 52;
+    end Focus;
+ 
+    -----------------------------------------------------------
+    procedure Focus (C     : in out Auto_Flashing;
+                     Depth : in     F392D00.Depth_Of_Field) is
+    begin
+       -- Artificial for testing purposes.
+       C.DOF := 91;
+    end Focus;
+ 
+ end C392D03_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F392D00;
+ with C392D03_0;
+ 
+ with Report;
+ 
+ procedure C392D03 is
+ 
+    type Focus_Ptr is access procedure 
+      (P1 : in out C392D03_0.Auto_Focus;
+       P2 : in F392D00.Depth_Of_Field);
+ 
+    Basic_Camera   : F392D00.Remote_Camera;
+    Auto_Camera1   : C392D03_0.Auto_Focus;
+    Auto_Camera2   : C392D03_0.Auto_Focus;
+    Flash_Camera1  : C392D03_0.Auto_Flashing;
+    Flash_Camera2  : C392D03_0.Auto_Flashing;
+    Special_Camera : C392D03_0.Special_Focus;
+    Auto_Depth     : F392D00.Depth_Of_Field := 78;
+ 
+    TC_Expected_Basic_Depth : constant F392D00.Depth_Of_Field := 46;
+    TC_Expected_Auto_Depth  : constant F392D00.Depth_Of_Field := 52;
+    TC_Expected_Depth       : constant F392D00.Depth_Of_Field := 91;
+ 
+    FP : Focus_Ptr := C392D03_0.Focus'Access;
+ 
+    use type F392D00.Depth_Of_Field;
+ 
+ begin
+    Report.Test ("C392D03", "Dispatching for overridden primitive " &
+                 "subprograms: record extension declared in non-child " &
+                 "package, parent is tagged record");
+ 
+ 
+ -- Call the class-wide operation for Remote_Camera'Class, which itself makes
+ -- a dispatching call to Focus:
+ 
+    -- For an object of type Remote_Camera, the dispatching call should
+    -- dispatch to the body declared for the root type:
+      
+    F392D00.Self_Test(Basic_Camera);
+ 
+    if Basic_Camera.DOF /= TC_Expected_Basic_Depth then
+       Report.Failed ("Call dispatched incorrectly for root type");
+    end if;
+ 
+ 
+    -- For an object of type Auto_Focus, the dispatching call should
+    -- dispatch to the body declared for the derived type:
+      
+    F392D00.Self_Test(Auto_Camera1);
+ 
+    if Auto_Camera1.DOF /= TC_Expected_Auto_Depth then
+       Report.Failed ("Call dispatched incorrectly for Auto_Focus type");
+    end if;
+ 
+ 
+    -- For an object of type Auto_Flash, the dispatching call should
+    -- also dispatch to the body declared for the derived type:
+ 
+    F392D00.Self_Test(Flash_Camera1);
+ 
+    if Flash_Camera1.DOF /= TC_Expected_Depth then
+       Report.Failed ("Call dispatched incorrectly for Auto_Flash type");
+    end if;
+ 
+    -- For an object of Auto_Flash type, a non-dispatching call to Focus should 
+    -- execute the body declared for the derived type (even through it is 
+    -- declared in the private part).
+ 
+    C392D03_0.Focus (Flash_Camera2, Auto_Depth);
+ 
+    if Flash_Camera2.DOF /= TC_Expected_Depth then
+       Report.Failed ("Non-dispatching call to privately overriding " &
+                      "subprogram executed the wrong body");
+    end if;
+ 
+    -- For an object of Auto_Focus type, a non-dispatching call to Focus should 
+    -- execute the body declared for the derived type (even through it is 
+    -- declared in the private part).
+ 
+    FP.all (Auto_Camera2, Auto_Depth);
+ 
+    if Auto_Camera2.DOF /= TC_Expected_Auto_Depth then
+       Report.Failed ("Non-dispatching call by using access to overriding " &
+                      "subprogram executed the wrong body");
+    end if;
+ 
+    -- For an object of type Special_Camera, the dispatching call should
+    -- also dispatch to the body declared for the derived type:
+ 
+    F392D00.Self_Test(Special_Camera);
+ 
+    if Special_Camera.DOF /= TC_Expected_Auto_Depth then
+       Report.Failed ("Call dispatched incorrectly for Special_Camera type");
+    end if;
+ 
+    Report.Result;
+ 
+ end C392D03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,407 ----
+ -- C393001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an abstract type can be declared, and in turn concrete
+ --      types can be derived from it.  Check that the definition of 
+ --      actual subprograms associated with the derived types dispatch
+ --      correctly.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares an abstract type Breaker in a package, and
+ --      then derives from it.  The type Basic_Breaker defines the least
+ --      possible in order to not be abstract.  The type Ground_Fault is
+ --      defined to inherit as much as possible, whereas type Special_Breaker
+ --      overrides everything it can.  The type Special_Breaker also includes
+ --      an embedded Basic_Breaker object.  The main program then utilizes
+ --      each of the three types of breaker, and to ascertain that the
+ --      overloading and tagging resolution are correct, each "Create"
+ --      procedure is called with a unique value.  The diagram below
+ --      illustrates the relationships.  This test is derived from C3A2001.
+ --
+ --              Abstract type:           Breaker
+ --                                           |
+ --                                    Basic_Breaker (Short)
+ --                                    /           \
+ --                     (Sharp) Ground_Fault    Special_Breaker (Shock)
+ --
+ --      Test structure is an array of class-wide objects, modeling a circuit
+ --      as a list of components.  The test then creates some values, and
+ --      traverses the list to determine correct operation.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      13 Nov 95   SAIC    Revised for 2.0.1
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C393001_1
+ 
+ with Report;
+ package C393001_1 is
+ 
+   type Breaker is abstract tagged private;
+   type Status  is ( Power_Off, Power_On, Tripped, Failed );
+ 
+   procedure Flip ( The_Breaker : in out Breaker ) is abstract;
+   procedure Trip ( The_Breaker : in out Breaker ) is abstract;
+   procedure Reset( The_Breaker : in out Breaker ) is abstract;
+   procedure Fail ( The_Breaker : in out Breaker );
+ 
+   procedure Set ( The_Breaker : in out Breaker'Class; To_State : Status );
+ 
+   function  Status_Of( The_Breaker : Breaker ) return Status;
+ 
+ private
+   type Breaker is abstract tagged record
+     State : Status := Power_Off;
+   end record;
+ end C393001_1;
+ 
+ with TCTouch;
+ package body C393001_1 is
+   procedure Fail( The_Breaker : in out Breaker ) is ------------------- a
+   begin
+     TCTouch.Touch( 'a' );
+     The_Breaker.State := Failed;
+   end Fail;
+ 
+   procedure Set( The_Breaker : in out Breaker'Class; To_State : Status ) is
+   begin
+     The_Breaker.State := To_State;
+   end Set;
+ 
+   function  Status_Of( The_Breaker : Breaker ) return Status is ------- b
+   begin
+     TCTouch.Touch( 'b' );
+     return The_Breaker.State;
+   end Status_Of;
+ end C393001_1;
+ 
+ ----------------------------------------------------------------- C393001_2
+ 
+ with C393001_1;
+ package C393001_2 is
+ 
+   type Basic_Breaker is new C393001_1.Breaker with private;
+ 
+   type Voltages is ( V12, V110, V220, V440 );
+   type Amps     is ( A1, A5, A10, A25, A100 );
+ 
+   function Construct( Voltage : Voltages; Amperage : Amps )
+     return Basic_Breaker;
+ 
+   procedure Flip ( The_Breaker : in out Basic_Breaker );
+   procedure Trip ( The_Breaker : in out Basic_Breaker );
+   procedure Reset( The_Breaker : in out Basic_Breaker );
+ private
+   type Basic_Breaker is new C393001_1.Breaker with record
+     Voltage_Level : Voltages := V110;
+     Amperage      : Amps;
+   end record;
+ end C393001_2;
+ 
+ with TCTouch;
+ package body C393001_2 is
+   function Construct( Voltage : Voltages; Amperage : Amps ) ----------- c
+     return Basic_Breaker is
+     It : Basic_Breaker;
+   begin
+     TCTouch.Touch( 'c' );
+     It.Amperage := Amperage;
+     It.Voltage_Level := Voltage;
+     C393001_1.Set( It, C393001_1.Power_Off );
+     return It;
+   end Construct;
+ 
+   procedure Flip ( The_Breaker : in out Basic_Breaker ) is ------------ d
+   begin
+     TCTouch.Touch( 'd' );
+     case Status_Of( The_Breaker ) is
+       when C393001_1.Power_Off =>
+         C393001_1.Set( The_Breaker, C393001_1.Power_On );
+       when C393001_1.Power_On =>
+         C393001_1.Set( The_Breaker, C393001_1.Power_Off );
+       when C393001_1.Tripped | C393001_1.Failed  => null;
+     end case;
+   end Flip;
+ 
+   procedure Trip ( The_Breaker : in out Basic_Breaker ) is ------------ e
+   begin
+     TCTouch.Touch( 'e' );
+     C393001_1.Set( The_Breaker, C393001_1.Tripped );
+   end Trip;
+ 
+   procedure Reset( The_Breaker : in out Basic_Breaker ) is ------------ f
+   begin
+     TCTouch.Touch( 'f' );
+     case Status_Of( The_Breaker ) is
+       when C393001_1.Power_Off | C393001_1.Tripped =>
+         C393001_1.Set( The_Breaker, C393001_1.Power_On );
+       when C393001_1.Power_On  | C393001_1.Failed  => null;
+     end case;
+   end Reset;
+ 
+ end C393001_2;
+ 
+ with C393001_1,C393001_2;
+ package C393001_3 is
+   
+   type Ground_Fault is new C393001_2.Basic_Breaker with private;
+ 
+   function Construct( Voltage : C393001_2.Voltages; Amperage : C393001_2.Amps
+ )
+     return Ground_Fault;
+ 
+   procedure Set_Trip( The_Breaker : in out Ground_Fault;
+                       Capacitance : in     Integer );
+ 
+ private
+   type Ground_Fault is new C393001_2.Basic_Breaker with record
+     Capacitance : Integer;
+   end record;
+ end C393001_3;
+ 
+ ----------------------------------------------------------------- C393001_3
+ 
+ with TCTouch;
+ package body C393001_3 is
+ 
+   function Construct( Voltage  : C393001_2.Voltages; ------------------ g
+                       Amperage : C393001_2.Amps )
+     return Ground_Fault is
+ 
+     It : Ground_Fault;
+ 
+     procedure Set_Root( It: in out C393001_2.Basic_Breaker ) is
+     begin
+       It := C393001_2.Construct( Voltage, Amperage );
+     end Set_Root;
+ 
+   begin
+     TCTouch.Touch( 'g' );
+     Set_Root( C393001_2.Basic_Breaker( It ) );
+     It.Capacitance := 0;
+     return It;
+   end Construct;
+ 
+   procedure Set_Trip( The_Breaker : in out Ground_Fault; -------------- h
+                       Capacitance : in     Integer ) is
+   begin
+     TCTouch.Touch( 'h' );
+     The_Breaker.Capacitance := Capacitance;
+   end Set_Trip;
+ 
+ end C393001_3;
+ 
+ ----------------------------------------------------------------- C393001_4
+ 
+ with C393001_1, C393001_2;
+ package C393001_4 is
+ 
+   type Special_Breaker is new C393001_2.Basic_Breaker with private;
+ 
+   function Construct( Voltage     : C393001_2.Voltages;
+                       Amperage    : C393001_2.Amps )
+     return Special_Breaker;
+ 
+   procedure Flip ( The_Breaker : in out Special_Breaker );
+   procedure Trip ( The_Breaker : in out Special_Breaker );
+   procedure Reset( The_Breaker : in out Special_Breaker );
+   procedure Fail ( The_Breaker : in out Special_Breaker );
+ 
+   function Status_Of( The_Breaker : Special_Breaker ) return C393001_1.Status;
+   function On_Backup( The_Breaker : Special_Breaker ) return Boolean;
+ 
+ private
+   type Special_Breaker is new C393001_2.Basic_Breaker with record
+     Backup : C393001_2.Basic_Breaker;
+   end record;
+ end C393001_4;
+ 
+ with TCTouch;
+ package body C393001_4 is
+ 
+   function Construct( Voltage     : C393001_2.Voltages; --------------- i
+                       Amperage    : C393001_2.Amps )
+     return Special_Breaker is
+     It: Special_Breaker;
+     procedure Set_Root( It: in out C393001_2.Basic_Breaker ) is
+     begin
+       It := C393001_2.Construct( Voltage, Amperage );
+     end Set_Root;
+   begin
+     TCTouch.Touch( 'i' );
+     Set_Root( C393001_2.Basic_Breaker( It ) );
+     Set_Root( It.Backup );
+     return It;
+   end Construct;
+ 
+   function Status_Of( It: C393001_1.Breaker ) return C393001_1.Status
+     renames C393001_1.Status_Of;
+ 
+   procedure Flip ( The_Breaker : in out Special_Breaker ) is ---------- j
+   begin
+     TCTouch.Touch( 'j' );
+     case Status_Of( C393001_1.Breaker( The_Breaker )) is
+       when C393001_1.Power_Off | C393001_1.Power_On =>
+         C393001_2.Flip( C393001_2.Basic_Breaker( The_Breaker ) );
+       when others =>
+         C393001_2.Flip( The_Breaker.Backup );
+     end case;
+   end Flip;
+ 
+   procedure Trip ( The_Breaker : in out Special_Breaker ) is ---------- k
+   begin
+     TCTouch.Touch( 'k' );
+     case Status_Of( C393001_1.Breaker( The_Breaker )) is
+       when C393001_1.Power_Off => null;
+       when C393001_1.Power_On  =>
+         C393001_2.Reset( The_Breaker.Backup );
+         C393001_2.Trip( C393001_2.Basic_Breaker( The_Breaker ) );
+       when others =>
+         C393001_2.Trip( The_Breaker.Backup );
+     end case;
+   end Trip;
+ 
+   procedure Reset( The_Breaker : in out Special_Breaker ) is ---------- l
+   begin
+     TCTouch.Touch( 'l' );
+     case Status_Of( C393001_1.Breaker( The_Breaker )) is
+       when C393001_1.Tripped  =>
+         C393001_2.Reset( C393001_2.Basic_Breaker( The_Breaker ));
+       when C393001_1.Failed  =>
+         C393001_2.Reset( The_Breaker.Backup );
+       when C393001_1.Power_On | C393001_1.Power_Off =>
+         null;
+     end case;
+   end Reset;
+ 
+   procedure Fail ( The_Breaker : in out Special_Breaker ) is ---------- m
+   begin
+     TCTouch.Touch( 'm' );
+     case Status_Of( C393001_1.Breaker( The_Breaker )) is
+       when C393001_1.Failed  =>
+         C393001_2.Fail( The_Breaker.Backup );
+       when others => 
+         C393001_2.Fail( C393001_2.Basic_Breaker( The_Breaker ));
+         C393001_2.Reset( The_Breaker.Backup );
+     end case;
+   end Fail;
+ 
+   function Status_Of( The_Breaker : Special_Breaker ) ----------------- n
+     return C393001_1.Status is
+   begin
+     TCTouch.Touch( 'n' );
+     case Status_Of( C393001_1.Breaker( The_Breaker )) is
+       when C393001_1.Power_On  => return C393001_1.Power_On;
+       when C393001_1.Power_Off => return C393001_1.Power_Off;
+       when others =>
+         return C393001_2.Status_Of( The_Breaker.Backup );
+     end case;
+   end Status_Of;
+ 
+   function On_Backup( The_Breaker : Special_Breaker ) return Boolean is
+     use C393001_2;
+     use type C393001_1.Status;
+   begin
+     return Status_Of(Basic_Breaker(The_Breaker)) = C393001_1.Tripped
+         or Status_Of(Basic_Breaker(The_Breaker)) = C393001_1.Failed;
+   end On_Backup;
+ 
+ end C393001_4;
+ 
+ ------------------------------------------------------------------- C393001
+ 
+ with Report, TCTouch;
+ with C393001_1, C393001_2, C393001_3, C393001_4;
+ procedure C393001 is
+  
+   procedure Flipper( The_Circuit : in out C393001_1.Breaker'Class ) is
+   begin
+       C393001_1.Flip( The_Circuit );
+   end Flipper;
+ 
+   procedure Tripper( The_Circuit : in out C393001_1.Breaker'Class ) is
+   begin
+       C393001_1.Trip( The_Circuit );
+   end Tripper;
+ 
+   procedure Restore( The_Circuit : in out C393001_1.Breaker'Class ) is
+   begin
+       C393001_1.Reset( The_Circuit );
+   end Restore;
+ 
+   procedure Failure( The_Circuit : in out C393001_1.Breaker'Class ) is
+   begin
+       C393001_1.Fail( The_Circuit );
+   end Failure;
+ 
+   Short : C393001_1.Breaker'Class -- Basic_Breaker
+           := C393001_2.Construct( C393001_2.V440, C393001_2.A5 );
+   Sharp : C393001_1.Breaker'Class -- Ground_Fault
+           := C393001_3.Construct( C393001_2.V110, C393001_2.A1 );
+   Shock : C393001_1.Breaker'Class -- Special_Breaker
+           := C393001_4.Construct( C393001_2.V12,  C393001_2.A100 );
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C393001", "Check that an abstract type can be declared " &
+                "and used.  Check actual subprograms dispatch correctly" );
+ 
+   TCTouch.Validate( "cgcicc", "Declaration" );
+ 
+   Flipper( Short );
+   TCTouch.Validate( "db", "Flipping Short" );
+   Flipper( Sharp );
+   TCTouch.Validate( "db", "Flipping Sharp" );
+   Flipper( Shock );
+   TCTouch.Validate( "jbdb", "Flipping Shock" );
+ 
+   Tripper( Short );
+   TCTouch.Validate( "e", "Tripping Short" );
+   Tripper( Sharp );
+   TCTouch.Validate( "e", "Tripping Sharp" );
+   Tripper( Shock );
+   TCTouch.Validate( "kbfbe", "Tripping Shock" );
+ 
+   Restore( Short );
+   TCTouch.Validate( "fb", "Restoring Short" );
+   Restore( Sharp );
+   TCTouch.Validate( "fb", "Restoring Sharp" );
+   Restore( Shock );
+   TCTouch.Validate( "lbfb", "Restoring Shock" );
+ 
+   Failure( Short );
+   TCTouch.Validate( "a", "Shock Failing" );
+   Failure( Sharp );
+   TCTouch.Validate( "a", "Shock Failing" );
+   Failure( Shock );
+   TCTouch.Validate( "mbafb", "Shock Failing" );
+ 
+   Report.Result;
+ 
+ end C393001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,157 ----
+ -- C393007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an extended type can be derived from an abstract type,
+ --      where the abstract type is defined in a package, and the type derived
+ --      from it is defined in a distinct library package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an private (abstract) type; declare two primitive operations 
+ --      of the type that are explicitly abstract.
+ --      Derive an extended type from the (private) abstract type, overriding 
+ --      both of the primitive operations.
+ --      This test also checks to see that name overloading between abstract
+ --      and non-abstract functions is resolved correctly.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+    package C393007_0 is
+         -- Alert_System
+  
+      type DT_Type is new Integer;
+  
+      type Alert_Type is abstract tagged record
+         Time_Of_Arrival : DT_Type;
+      end record;
+  
+      type Log_File_Type is range 0 .. 100;
+  
+      Procedure Handle (A : in out Alert_type) is abstract;
+        
+      procedure Log    (A : Alert_Type;                   
+                        L : in out Log_File_Type) is abstract;  
+    
+      procedure Set_Time (A : in out Alert_Type);
+  
+      function Correct_Time_Stamp (A : Alert_Type) return Boolean;
+        
+      Day_Time : DT_Type := 100;
+  
+    end C393007_0;
+     -- Alert_System;
+  
+  --=======================================================================--
+  
+    package body C393007_0 is
+              -- Alert_System
+  
+      function Time_Stamp return DT_Type is
+        begin
+          Day_Time := Day_Time + 1;
+          return Day_Time;
+        end Time_Stamp;
+  
+      procedure Set_Time (A : in out Alert_Type) is
+        begin
+          A.Time_Of_Arrival := Time_Stamp;
+        end Set_time;
+        
+      function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
+        begin
+          return (A.Time_Of_Arrival = Day_Time);
+        end Correct_Time_Stamp;
+  
+    end C393007_0;
+     -- Alert_System;
+  
+  --=======================================================================--
+  
+  with Report;
+  with C393007_0;
+    -- Alert_system;
+  
+  package C393007_1 is
+  
+    type Normal_Alert_Type is   
+      new C393007_0.Alert_Type
+      with null record;
+  
+    Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First;
+  
+    procedure Handle (A : in out Normal_Alert_Type);  -- Override is required
+  
+    procedure Log    (A : Normal_Alert_Type;          -- Override is required
+                      L : in out C393007_0.Log_File_Type);
+  end C393007_1;
+  
+  package body C393007_1 is
+    use type C393007_0.Log_File_Type;
+  
+    procedure Handle (A : in out Normal_Alert_Type) is   
+      begin
+        Set_Time (A);
+        Log (A, Log_File);
+      end Handle;
+  
+    procedure Log    (A : Normal_Alert_Type;      
+                      L : in out C393007_0.Log_File_Type) is
+       begin
+         L := C393007_0."+"(L, 1);
+       end Log;
+    
+  end C393007_1;
+  
+  with Report;
+  with C393007_0;
+  with C393007_1;
+    -- Alert_system;
+  
+  procedure C393007 is
+    use C393007_0;
+    use C393007_1;
+  
+    Alert_One : C393007_1.Normal_Alert_Type;
+  
+  begin
+    Report.Test ("C393007", "Check that an extended type can be derived " &
+                            "from an abstract type");
+  
+    Handle (Alert_One);
+    if not Correct_Time_Stamp (Alert_One) then
+      Report.Failed ("Wrong results from procedure Handle");
+    end if;
+  
+    if Log_File /=1 then 
+      Report.Failed ("Wrong results");
+    end if;
+  
+    Report.Result;
+  
+  end C393007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393008.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393008.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393008.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,204 ----
+ -- C393008.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an extended type can be derived from an abstract type.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a tagged record; declare an abstract 
+ --      primitive operation and a non-abstract primitive operation of the 
+ --      type.  Derive an extended type from it, including a new component.
+ --      Use the derived type, the overriding operation and the inherited 
+ --      operation to instantiate a generic package.  The overriding operation
+ --      calls a new primitive operation and an inherited operation [so the 
+ --      instantiation must get this sorted out correctly].
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with TCTouch;
+ procedure C393008 is
+ 
+ package C393008_0 is
+ 
+   type Status_Enum is (No_Status, Handled, Unhandled, Pending);
+ 
+   type Alert_Type is abstract tagged record
+       Status : Status_Enum;
+       Reply  : Boolean;
+       Urgent : Boolean;
+   end record;
+ 
+   subtype Serial_Number is Integer range 0..Integer'last;
+   Serial_Num : Serial_Number := 0;
+ 
+   procedure Handle   (A : in out Alert_Type) is abstract; 
+                                         -- abstract primitive operation
+ 
+   -- the procedure Init would be _nice_ have this procedure be non_abstract
+   -- and create a "base" object with a "null" constraint.  The language
+   -- will not allow this due to the restriction that an object of an
+   -- abstract type cannot be created.  Hence Init must be abstract,
+   -- requiring any type derived directly from Alert_Type to declare
+   -- an Init.
+   --
+   -- In light of this, I have changed init to a function to more closely
+   -- model the typical usage of OO features...
+ 
+   function  Init return Alert_Type is abstract;
+ 
+   procedure No_Reply (A : in out Alert_Type);
+ 
+ end C393008_0;
+ 
+ --=======================================================================--
+ 
+ package body C393008_0 is
+ 
+   procedure No_Reply (A : in out Alert_Type) is
+     begin                              -- primitive operation, not abstract
+       TCTouch.Touch('A');  ------------------------------------------------- A
+       if A.Status = Handled then
+         A.Reply  := False;
+       end if;
+     end No_Reply;
+ 
+ end C393008_0;
+ 
+ --=======================================================================--
+ 
+   generic
+                         -- pass in the Alert_Type object, including its 
+                         -- operations
+     type Data_Type is new C393008_0.Alert_Type with private; 
+                         -- note that Alert_Type is abstract, so it may not be
+                         -- used as an actual parameter
+     with procedure Update     (P : in out Data_Type) is <>;  -- generic formal
+     with function  Initialize return Data_Type is <>;        -- generic formal
+ 
+   package C393008_1 is
+        -- Utilities
+ 
+     procedure Modify (Item : in out Data_Type);
+ 
+   end C393008_1;
+    -- Utilities
+ 
+ --=======================================================================--
+ 
+   package body C393008_1 is
+             -- Utilities
+ 
+       procedure Modify (Item : in out Data_Type) is
+         begin
+           TCTouch.Touch('B');  --------------------------------------------- B
+           Item := Initialize;
+           Update (Item);
+         end Modify;
+ 
+   end C393008_1;
+ 
+ --=======================================================================--
+ 
+   package C393008_2 is
+ 
+     type Low_Alert_Type is new C393008_0.Alert_Type with record
+       Serial : C393008_0.Serial_Number;
+     end record;
+   
+     procedure Serialize (LA : in out Low_Alert_Type);
+   
+     -- inherit No_Reply
+ 
+     procedure Handle (LA : in out Low_Alert_Type);
+ 
+     function Init return Low_Alert_Type;
+   end C393008_2;
+ 
+   package body C393008_2 is
+     procedure Serialize (LA : in out Low_Alert_Type) is
+     begin                          -- new primitive operation
+       TCTouch.Touch('C');  ------------------------------------------------- C
+       C393008_0.Serial_Num := C393008_0.Serial_Num + 1;
+       LA.Serial := C393008_0.Serial_Num;
+     end Serialize;
+   
+   -- inherit No_Reply
+ 
+     function Init return Low_Alert_Type is
+       TA: Low_Alert_Type;
+     begin
+       TCTouch.Touch('D');  ------------------------------------------------- D
+       Serialize( TA );
+       TA.Status := C393008_0.No_Status;
+       return TA;
+     end Init;
+ 
+     procedure Handle (LA : in out Low_Alert_Type) is    
+     begin                          -- overrides abstract inherited Handle
+       TCTouch.Touch('E');  ------------------------------------------------- E
+       Serialize (LA);
+       LA.Reply := False;
+       LA.Status := C393008_0.Handled;
+       No_Reply (LA);
+     end Handle;
+ 
+   end C393008_2;
+ 
+   use C393008_2;
+   
+   package Alert_Utilities is new
+     C393008_1 (Data_Type   => Low_Alert_Type,
+                Update      => Handle,   -- Low_Alert's Handle
+                Initialize  => Init);    -- inherited from Alert
+ 
+   Item : Low_Alert_Type;
+ 
+   use type C393008_0.Status_Enum;
+ 
+ begin
+ 
+   Report.Test ("C393008", "Check that an extended type can be derived "&
+                           "from an abstract type");
+ 
+   Item := Init;
+   if (Item.Status /= C393008_0.No_Status) or (Item.Serial /=1)  then
+     Report.Failed ("Wrong initialization");
+   end if;
+   TCTouch.Validate("DC", "Initialization Call");
+ 
+   Alert_Utilities.Modify (Item);
+   if (Item.Status /= C393008_0.Handled) or (Item.Serial /= 3) then 
+     Report.Failed ("Wrong results from Modify");
+   end if;
+   TCTouch.Validate("BDCECA", "Generic Instance Call");
+ 
+   Report.Result;
+ 
+ end C393008;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393009.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393009.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393009.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C393009.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an extended type can be derived from an abstract type.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an abstract type in the specification of a generic package.
+ --      Instantiate the package and derive an extended type from the abstract
+ --      (instantiated) type; override all abstract operations; use all
+ --      inherited operations;
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      14 Oct 95   SAIC    Fixed for ACVC 2.0.1
+ --
+ --!
+   
+ with Report;
+ procedure C393009 is
+   
+   package Display_Devices is
+   
+     type Display_Device_Enum is (None, TTY, Console, Big_Screen);
+     Display : Display_Device_Enum := None;
+   
+   end Display_Devices;
+   
+ --=======================================================================--
+   
+   generic
+   
+     type Generic_Status is (<>);
+     
+     type Serial_Type is (<>);
+   
+   package Alert_System is
+   
+     type Alert_Type (Serial : Serial_Type) is abstract tagged record
+       Status : Generic_Status;
+     end record;
+     
+     Next_Serial_Number : Serial_Type := Serial_Type'First;
+   
+     procedure Handle (A : in out Alert_Type) is abstract;
+       -- abstract operation - must be overridden after instantiation
+   
+     procedure Display ( A : Alert_Type; 
+                        On : Display_Devices.Display_Device_Enum);
+               -- primitive operation of Alert_Type
+               -- not required to be overridden
+   
+     function Get_Serial_Number (A : Alert_Type) return Serial_Type;
+               -- primitive operation of Alert_Type
+               -- not required to be overridden
+   
+   end Alert_System;
+   
+ --=======================================================================--
+   
+   package body Alert_System is
+   
+     procedure Display ( A : in Alert_Type;
+                        On : Display_Devices.Display_Device_Enum) is
+       begin
+         Display_Devices.Display := On;
+       end Display;
+   
+     function Get_Serial_Number (A : Alert_Type) 
+       return Serial_Type is
+       begin
+         return A.Serial;
+       end Get_Serial_Number;
+   
+   end Alert_System;
+   
+ --=======================================================================--
+ 
+   package NCC_1701 is
+   
+     type Status_Kind is (Green, Yellow, Red);
+     type Serial_Number_Type is new Integer range 1..Integer'Last;
+     
+     subtype Msg_Str is String (1..16);
+     Alert_Msg : Msg_Str := "C393009  passed.";
+                         --  123456789A123456
+   
+     package Alert_Pkg is new Alert_System (Status_Kind, Serial_Number_Type);
+   
+     type New_Alert_Type(Serial : Serial_Number_Type) is
+       new Alert_Pkg.Alert_Type(Serial) with record
+       Message : Msg_Str;
+       end record;
+    
+     -- procedure Display is inherited by New_Alert_Type
+   
+     -- function Get_Serial_Number is inherited by New_Alert_Type
+     procedure Handle (NA : in out New_Alert_Type);  -- must be overridden
+     procedure Init   (NA : in out New_Alert_Type);  -- new primitive
+   
+     NA : New_Alert_Type(Alert_Pkg.Next_Serial_Number);
+          -- New_Alert_Type is not abstract, so an object of that
+          -- type may be declared
+   
+   end NCC_1701;
+   
+   package body NCC_1701 is
+   
+     procedure Handle (NA : in out New_Alert_Type) is
+     begin
+       NA.Message := Alert_Msg;
+       Display (NA, On => Display_Devices.TTY);
+       end Handle;
+   
+     procedure Init (NA : in out New_Alert_Type) is  -- new primitive operation
+     begin                                           -- for New_Alert_Type
+       NA := (Serial=> NA.Serial, Status => Green, Message => (others => ' '));
+     end Init;
+     
+    end NCC_1701;
+   
+    use NCC_1701;
+    use type Display_Devices.Display_Device_Enum;
+   
+ begin
+ 
+   Report.Test ("C393009", "Check that an extended type can be derived " &
+                           "from an abstract type");
+ 
+   Init (NA);
+   if (Get_Serial_Number (NA) /= 1)
+     or (NA.Status /= Green)
+     or (Display_Devices.Display /= Display_Devices.None) then
+       Report.Failed ("Wrong Initialization");
+   end if;
+   
+   Handle (NA);
+   if (Get_Serial_Number (NA) /= 1)
+     or (NA.Status /= Green)
+     or (NA.Message /= Alert_Msg) 
+     or (Display_Devices.Display /= Display_Devices.TTY) then
+       Report.Failed ("Wrong results from Handle");
+   end if;
+   
+   Report.Result;
+ 
+ end C393009;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,306 ----
+ -- C393010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an extended type can be derived from an abstract type and
+ --      that a call on an abstract operation is a dispatching operation.
+ --      Check that such a call can dispatch to an overriding operation
+ --      declared in the private part of a package.
+ --
+ -- TEST DESCRIPTION:
+ --      Taking from a classroom example of a typical usage: declare a basic
+ --      abstract type containing data germane to the entire class structure,
+ --      derive from that a type with specific data, and derive from that
+ --      another type merely providing a "secret" override.  The abstract type
+ --      provides a concrete procedure that itself "redispatches" to an
+ --      abstract procedure; the abstract procedure must be provided by one or
+ --      more of the concrete types derived from the abstract type, and hence
+ --      upon re-evaluating the actual type of the operand should dispatch
+ --      accordingly.
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Mar 96   SAIC    ACVC 2.1
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C393010_0
+ 
+ package C393010_0 is
+ 
+   type Ticket is abstract tagged record
+     Flight        : Natural;
+     Serial_Number : Natural;
+   end record;
+ 
+   function Issue return Ticket is abstract;
+   procedure Label( T: Ticket ) is abstract;
+ 
+   procedure Print( T: Ticket );
+ 
+ end C393010_0;
+ 
+ with TCTouch;
+ package body C393010_0 is
+ 
+   procedure Print( T: Ticket ) is
+   begin
+     -- Check that a call on an abstract operation is a dispatching operation
+     Label( Ticket'Class( T ) );
+     -- Appropriate_IO.Put( T.Flight & T.Serial_Number );
+     TCTouch.Touch('P'); -------------------------------------------------- P
+   end Print;
+ 
+ end C393010_0;
+ 
+ ----------------------------------------------------------------- C393010_1
+ 
+ with C393010_0;
+ package C393010_1 is
+ 
+   type Service_Classes is (First, Business, Coach);
+ 
+   type Menu is (Steak, Lobster, Fowl, Vegan);
+ 
+   -- Check that an extended type can be derived from an abstract type.
+   type Passenger_Ticket(Service : Service_Classes) is
+     new C393010_0.Ticket with record
+       Row_Seat : String(1..3);
+       case Service is
+         when First | Business => Meal : Menu;
+         when Coach => null;
+       end case;
+   end record;
+ 
+   function Issue return Passenger_Ticket;
+   function Issue( Service : Service_Classes;
+                    Flight : Natural;
+                      Seat : String;
+                      Meal : Menu := Fowl ) return Passenger_Ticket;
+ 
+   procedure Label( T: Passenger_Ticket );
+ 
+   procedure Print( T: Passenger_Ticket );
+ 
+ end C393010_1;
+ 
+ with TCTouch;
+ package body C393010_1 is
+ 
+   procedure Label( T: Passenger_Ticket ) is
+   begin
+     -- Appropriate_IO.Put( T.Service );
+     TCTouch.Touch('L'); -------------------------------------------------- L
+   end Label;
+ 
+   procedure Print( T: Passenger_Ticket ) is
+   begin
+     -- call parent print:
+     C393010_0.Print( C393010_0.Ticket( T ) );
+     case T.Service is
+       when First    => -- Appropriate_IO.Put( Meal );
+         TCTouch.Touch('F'); ---------------------------------------------- F
+       when Business => -- Appropriate_IO.Put( Meal );
+         TCTouch.Touch('B'); ---------------------------------------------- B
+       when Coach    => -- Appropriate_IO.Put( "BYO" & " peanuts" );
+         TCTouch.Touch('C'); ---------------------------------------------- C
+     end case;   
+   end Print;
+ 
+   Num : Natural := 1000;
+ 
+   function Issue( Service : Service_Classes;
+                    Flight : Natural;
+                      Seat : String;
+                      Meal : Menu := Fowl ) return Passenger_Ticket is
+   begin
+     Num := Num +1;
+     case Service is
+       when First =>
+         return Passenger_Ticket'(Service => First, Flight => Flight,
+                        Row_Seat => Seat, Meal => Meal, Serial_Number => Num );
+       when Business =>
+         return Passenger_Ticket'(Service => Business, Flight => Flight,
+                        Row_Seat => Seat, Meal => Meal, Serial_Number => Num );
+       when Coach =>
+         return Passenger_Ticket'(Service => Coach, Flight => Flight,
+                        Row_Seat => Seat, Serial_Number => Num );
+     end case;
+   end Issue;
+ 
+   function Issue return Passenger_Ticket is
+   begin
+     return Issue( Coach, 0, "non" );
+   end Issue;
+ 
+ end C393010_1;
+ 
+ ----------------------------------------------------------------- C393010_1
+ 
+ with C393010_1;
+ package C393010_2 is
+ 
+   type Charter is new C393010_1.Passenger_Ticket( C393010_1.Coach )
+     with private;
+ 
+   function Issue return Charter;
+ 
+   -- procedure Print( T: Passenger_Ticket );
+ 
+ private
+   type Charter is new C393010_1.Passenger_Ticket( C393010_1.Coach )
+     with null record;
+ 
+   -- Check that the dispatching call to the abstract operation will dispatch
+   -- to a procedure defined in the private part of a package.
+   procedure Label( T: Charter );
+ 
+   -- an example of a required function the users shouldn't see:
+   function Issue( Service : C393010_1.Service_Classes;
+                    Flight : Natural;
+                      Seat : String;
+                      Meal : C393010_1.Menu ) return Charter;
+ 
+ end C393010_2;
+ 
+ with TCTouch;
+ package body C393010_2 is
+ 
+   procedure Label( T: Charter ) is
+   begin
+     -- Appropriate_IO.Put( "Excursion Fare" );
+     TCTouch.Touch('X'); -------------------------------------------------- X
+   end Label;
+ 
+   Num : Natural := 4000;
+ 
+   function Issue return Charter is
+   begin
+     Num := Num +1;
+     return Charter'(Service => C393010_1.Coach, Flight => 1001,
+                        Row_Seat => "OPN", Serial_Number => Num );
+   end Issue;
+ 
+   function Issue( Service : C393010_1.Service_Classes;
+                    Flight : Natural;
+                      Seat : String;
+                      Meal : C393010_1.Menu ) return Charter is
+   begin
+     return Issue;
+   end Issue;
+ 
+ end C393010_2;
+ 
+ ----------------------------------------------------------------- C393010_1
+ 
+ with Report;
+ with TCTouch;
+ with C393010_0;
+ with C393010_1;
+ with C393010_2; -- Charter Tours
+ 
+ procedure C393010 is
+ 
+   type Agents_Handle is access all C393010_0.Ticket'Class;
+ 
+   type Itinerary;
+ 
+   type Next_Leg is access Itinerary;
+ 
+   type Itinerary is record
+     Leg  : Agents_Handle;
+     Next : Next_Leg;
+   end record;
+ 
+   function Travel_Agent_1 return Next_Leg is
+   begin
+     -- ORL -> JFK -> LAX -> SAN -> DFW -> ORL
+     return new Itinerary'(
+        -- ORL -> JFK 01   12  2A First, Lobster
+        new C393010_1.Passenger_Ticket'(
+          C393010_1.Issue(C393010_1.First, 12, " 2A", C393010_1.Lobster )),
+          new Itinerary'(
+        -- JFK -> LAX 02   18  2B First, Steak
+        new C393010_1.Passenger_Ticket'(
+          C393010_1.Issue(C393010_1.First, 18, " 2B", C393010_1.Steak )),
+          new Itinerary'(
+        -- LAX -> SAN 03 5225 34H Coach
+        new C393010_1.Passenger_Ticket'(
+          C393010_1.Issue(C393010_1.Coach, 5225, "34H")),
+          new Itinerary'(
+        -- SAN -> DFW 04   25 13A Business, Fowl
+        new C393010_1.Passenger_Ticket'(
+          C393010_1.Issue(C393010_1.Business, 25, "13A")),
+          new Itinerary'(
+        -- DFW -> ORL 05   15  1D First, Lobster
+        new C393010_1.Passenger_Ticket'(
+          C393010_1.Issue(C393010_1.First, 15, " 1D", C393010_1.Lobster )),
+          null          )))));
+   end Travel_Agent_1;
+ 
+   function Travel_Agent_2 return Next_Leg is
+   begin
+     -- LAX -> NRT -> SYD -> LAX
+     return new Itinerary'(
+        new C393010_2.Charter'( C393010_2.Issue ),
+          new Itinerary'(
+        new C393010_2.Charter'( C393010_2.Issue ),
+          new Itinerary'(
+        new C393010_2.Charter'( C393010_2.Issue ),
+          new Itinerary'(
+        new C393010_2.Charter'( C393010_2.Issue ),
+          null ))));
+   end Travel_Agent_2;
+ 
+   procedure Traveler( Pax_Tix : in Next_Leg ) is
+     Fly_Me : Next_Leg := Pax_Tix;
+   begin
+     -- a particularly consumptive process...
+     while Fly_Me /= null loop
+       C393010_0.Print( Fly_Me.Leg.all );  -- herein lies the test.
+       Fly_Me := Fly_Me.Next;
+     end loop;
+   end Traveler;
+ 
+ begin
+ 
+   Report.Test ("C393010", "Check that an extended type can be derived from "
+                         & "an abstract type and that a call on an abstract "
+                         & "operation is a dispatching operation.  Check "
+                         & "that such a call can dispatch to an overriding "
+                         & "operation declared in the private part of a "
+                         & "package" );
+ 
+   Traveler( Travel_Agent_1 );
+   TCTouch.Validate("LPFLPFLPCLPBLPF","First Trip");
+ 
+   Traveler( Travel_Agent_2 );
+   TCTouch.Validate("XPCXPCXPCXPC","Second Trip");
+ 
+   Report.Result;
+ 
+ end C393010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,220 ----
+ -- C393011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an abstract extended type can be derived from an abstract
+ --      type, and that a a non-abstract type may then be derived from the
+ --      second abstract type.
+ --
+ -- TEST DESCRIPTION:
+ --      Define an abstract type with three primitive operations, two of them
+ --      abstract.  Derive an extended type from it, inheriting the non-
+ --      abstract operation, overriding one of the abstract operations with
+ --      a non-abstract operation, and overriding the other abstract operation
+ --      with an abstract operation.  The extended type is therefore abstract;
+ --      derive an extended type from it.  Override the abstract operation with
+ --      a non-abstract operation; inherit one operation from the original
+ --      abstract type, and inherit one operation from the intermediate 
+ --      abstract type.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+  
+  Package C393011_0 is
+      -- Definitions
+  
+    type Status_Enum is (None, Unhandled, Pending, Handled);
+    type Serial_Type is new Integer range 0 .. Integer'Last;
+    subtype Priority_Type is Integer range 0..10;
+  
+    type Display_Enum is (Bit_Bucket, TTY, Console, Big_Screen);
+  
+    Next : Serial_Type := 1;
+    Display_Device : Display_Enum := Bit_Bucket;
+  
+  end C393011_0;
+  -- Definitions;
+  
+  --=======================================================================--
+  
+  with C393011_0;
+    -- Definitions
+  
+  Package C393011_1 is
+       -- Alert
+  
+    package Definitions renames C393011_0;
+  
+    type Alert_Type is abstract tagged record         
+      Status     : Definitions.Status_Enum := Definitions.None;  
+      Serial_Num : Definitions.Serial_Type := 0;
+      Priority   : Definitions.Priority_Type;
+    end record;
+                              -- Alert_Type is an abstract type with
+                              -- two operations to be overridden
+  
+    procedure Set_Status ( A : in out Alert_Type;          -- not abstract
+                          To : Definitions.Status_Enum);
+  
+    procedure Set_Serial ( A : in out Alert_Type) is abstract;
+    procedure Display    ( A : Alert_Type)        is abstract;
+   
+  end C393011_1;
+   -- Alert
+  
+  --=======================================================================--
+  
+  with C393011_0;
+  package body C393011_1 is
+            -- Alert
+    procedure Set_Status ( A : in out Alert_Type;
+                          To : Definitions.Status_Enum) is
+      begin
+        A.Status := To;
+      end Set_Status;
+  
+  end C393011_1;
+   -- Alert;
+  
+  --=======================================================================--
+  
+  with C393011_0,
+    -- Definitions, 
+       C393011_1,
+    -- Alert, 
+       Calendar;
+  
+  Package C393011_3 is
+       -- New_Alert
+  
+    type New_Alert_Type is abstract new C393011_1.Alert_Type with record
+      Display_Dev : C393011_0.Display_Enum := C393011_0.TTY;
+    end record;
+  
+    -- procedure Set_Status is inherited
+  
+    procedure Set_Serial ( A : in out New_Alert_Type);   -- override/see body
+  
+    procedure Display    ( A : New_Alert_Type) is abstract;
+                           -- override is abstract 
+                           -- still can't declare objects of New_Alert_Type
+  
+  end C393011_3;
+   -- New_Alert
+  
+  --=======================================================================--
+  
+  with C393011_0;
+  Package Body C393011_3 is 
+            -- New_Alert
+  
+    package Definitions renames C393011_0;
+  
+    procedure Set_Serial (A : in out New_Alert_Type) is
+      use type Definitions.Serial_Type;
+      begin
+        A.Serial_Num := Definitions.Next;
+        Definitions.Next := Definitions."+"( Definitions.Next, 1);
+      end Set_Serial;
+  
+  End C393011_3;
+   -- New_Alert;
+  
+  --=======================================================================--
+  
+  with C393011_0,
+    -- Definitions 
+       C393011_3;
+    -- New_Alert  -- package Alert is not visible
+  package C393011_4 is
+  
+    package New_Alert renames C393011_3;
+    package Definitions renames C393011_0;
+  
+    type Final_Alert_Type is new New_Alert.New_Alert_Type with null record;
+    -- inherits Set_Status including body
+    -- inherits Set_Serial including body
+    -- must override Display since inherited Display is abstract
+    procedure Display(FA : in     Final_Alert_Type);
+    procedure Handle (FA : in out Final_Alert_Type);
+  
+  end C393011_4;
+  
+  package body C393011_4 is
+  
+    procedure Display    (FA : in Final_Alert_Type) is 
+      begin
+        Definitions.Display_Device := FA.Display_Dev;
+      end Display;
+  
+    procedure Handle (FA : in out Final_Alert_Type) is
+      begin
+        Set_Status (FA, Definitions.Handled);
+        Set_Serial (FA);
+        Display (FA);
+      end Handle;
+  end C393011_4;
+  
+  with C393011_0,
+    -- Definitions 
+       C393011_3;
+    -- New_Alert  -- package Alert is not visible
+  with C393011_4;
+  with Report;
+  procedure C393011 is
+    use C393011_4;
+    use Definitions;
+  
+    FA : Final_Alert_Type;
+  
+  begin
+  
+    Report.Test ("C393011", "Check that an extended type can be derived " &
+                            "from an abstract type");
+  
+    if (Definitions.Display_Device /= Definitions.Bit_Bucket)
+        or (Definitions.Next /= 1)
+        or (FA.Status /= Definitions.None)
+        or (FA.Serial_Num /= 0)
+        or (FA.Display_Dev /= TTY) then
+      Report.Failed ("Incorrect initial conditions");
+    end if;
+  
+    Handle (FA);
+    if (Definitions.Display_Device /= Definitions.TTY)
+        or (Definitions.Next /= 2)
+        or (FA.Status /= Definitions.Handled)
+        or (FA.Serial_Num /= 1)
+        or (FA.Display_Dev /= TTY) then
+      Report.Failed ("Incorrect results from Handle");
+    end if;
+  
+    Report.Result;
+  
+  end C393011;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,221 ----
+ -- C393012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that a non-abstract subprogram of an abstract type can be
+ --     called with a controlling operand that is a type conversion to
+ --     the abstract type.
+ --
+ --     Check that converting to the class-wide type of an abstract type
+ --     inside an operation of that type causes a "redispatch" of the
+ --     called operation.
+ --
+ -- TEST DESCRIPTION:
+ --     This test defines an abstract type, and further derives types from it.
+ --     The key feature of this test is in the "Display" procedures where
+ --     the bodies of these procedures convert an object to the class-wide
+ --     type of the root abstract type, causing a "redispatch".
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Dec 94   SAIC    Add allocation to the object initializations
+ --
+ --!
+ 
+ package C393012_0 is
+ 
+   subtype Row_Number  is Positive  range 1..120;
+   subtype Seat_Letter is Character range 'A'..'M';
+ 
+   type Ticket is abstract tagged
+     record
+       Flight : Natural;
+       Row    : Row_Number;
+       Seat   : Seat_Letter;
+     end record;
+ 
+    function Display( T: Ticket ) return String;
+    function Service( T: Ticket ) return String is abstract;
+ 
+ end C393012_0;
+ 
+ with TCTouch;
+ package body C393012_0 is
+    function Display( T: Ticket ) return String is
+   begin
+     TCTouch.Touch('T');  --------------------------------------------------- T
+     return "Fl:" & Natural'Image(T.Flight)
+          & Service( Ticket'Class( T ) )   
+          & " Seat:" & Row_Number'Image(T.Row) & T.Seat;
+   end Display;
+ end C393012_0;
+ 
+ with C393012_0;
+ package C393012_1 is
+   type Economy is new C393012_0.Ticket with null record;
+   function Display( T: Economy ) return String;
+   function Service( T: Economy ) return String;
+ 
+   type Meal_Designator is ( B, L, D, V, SN );
+ 
+   type First is new C393012_0.Ticket with
+     record
+       Meal : Meal_Designator;
+     end record;
+   function Display( T: First ) return String;
+   function Service( T: First ) return String;
+   procedure Set_Meal( T: in out First; To_Meal : Meal_Designator );
+ 
+ end C393012_1;
+ 
+ with TCTouch;
+ package body C393012_1 is
+   function Display( T: Economy ) return String is
+   begin
+     TCTouch.Touch('E');  --------------------------------------------------- E
+     return C393012_0.Display( C393012_0.Ticket( T ) );  
+   end Display;                -- conversion to abstract type
+ 
+   function Service( T: Economy ) return String is
+   begin
+     TCTouch.Touch('e');  --------------------------------------------------- e
+     return " K";
+   end Service;
+ 
+   function Display( T: First ) return String is
+   begin
+     TCTouch.Touch('F');  --------------------------------------------------- F
+     return C393012_0.Display( C393012_0.Ticket( T ) );  
+   end Display;                -- conversion to abstract type
+ 
+   function Service( T: First ) return String is
+   begin
+     TCTouch.Touch('f');  --------------------------------------------------- f
+     return " F" & Meal_Designator'Image(T.Meal);
+   end Service;
+ 
+   procedure Set_Meal( T: in out First; To_Meal : Meal_Designator ) is
+   begin
+     T.Meal := To_Meal;
+   end Set_Meal;
+ 
+ end C393012_1;
+ 
+ with Report;
+ with TCTouch;
+ with C393012_0;
+ with C393012_1;
+ procedure C393012 is
+ 
+   package Rt renames C393012_0;
+   package Tx renames C393012_1;
+ 
+   type Tix is access Rt.Ticket'Class;
+   type Itinerary is array(Positive range 1..3) of Tix;
+ 
+ -- Outbound and Inbound itineraries provide different orderings of mixtures
+ -- of Economy and First_Class.  Not that that should make any difference...
+ 
+   Outbound : Itinerary := ( 1 => new Tx.Economy'( 5335,  5, 'B' ),
+                             2 => new Tx.First'  (   67,  1, 'J', Tx.L ),
+                             3 => new Tx.Economy'(  345, 37, 'C' ) );
+ 
+   Inbound  : Itinerary := ( 1 => new Tx.First'  (  456,  4, 'F', Tx.SN ),
+                             2 => new Tx.Economy'(   68, 12, 'D' ),
+                             3 => new Tx.Economy'( 5336,  6, 'A' ) );
+ 
+ -- Each call to Display uses a parameter that is a type conversion
+ -- to the abstract type Ticket.
+ 
+   procedure TC_Convert( I: Itinerary; Leg1,Leg2,Leg3: String ) is
+   begin
+     if Rt.Display( Rt.Ticket( I(1).all ) ) /= Leg1 then
+       Report.Failed( Rt.Display( Rt.Ticket( I(1).all ) ) & " /= " & Leg1 );
+     end if;
+     if Rt.Display( Rt.Ticket( I(2).all ) ) /= Leg2 then
+       Report.Failed( Rt.Display( Rt.Ticket( I(2).all ) ) & " /= " & Leg2 );
+     end if;
+     if Rt.Display( Rt.Ticket( I(3).all ) ) /= Leg3 then
+       Report.Failed( Rt.Display( Rt.Ticket( I(3).all ) ) & " /= " & Leg3 );
+     end if;
+   end TC_Convert;
+ 
+ -- Each call to Display uses a parameter that is not a type conversion
+ 
+   procedure TC_Match( I: Itinerary; Leg1,Leg2,Leg3: String ) is
+   begin
+     if Rt.Display( I(1).all ) /= Leg1 then
+       Report.Failed( Rt.Display( I(1).all ) & " /= " & Leg1 );
+     end if;
+     if Rt.Display( I(2).all ) /= Leg2 then
+       Report.Failed( Rt.Display( I(2).all ) & " /= " & Leg2 );
+     end if;
+     if Rt.Display( I(3).all ) /= Leg3 then
+       Report.Failed( Rt.Display( I(3).all ) & " /= " & Leg3 );
+     end if;
+   end TC_Match;
+ 
+ begin  -- Main test procedure.
+ 
+    Report.Test ("C393012", "Check that a non-abstract subprogram of an "
+                          & "abstract type can be called with a "
+                          & "controlling operand that is a type "
+                          & "conversion to the abstract type.  "
+                          & "Check that converting to the class-wide type "
+                          & "of an abstract type inside an operation of "
+                          & "that type causes a redispatch" );
+ 
+   -- Test conversions to abstract type
+ 
+    TC_Convert( Outbound, "Fl: 5335 K Seat: 5B",
+                          "Fl: 67 FL Seat: 1J",
+                          "Fl: 345 K Seat: 37C" );
+ 
+    TCTouch.Validate( "TeTfTe", "Outbound flight (converted)" );
+ 
+    TC_Convert( Inbound, "Fl: 456 FSN Seat: 4F",
+                         "Fl: 68 K Seat: 12D",
+                         "Fl: 5336 K Seat: 6A" );
+ 
+    TCTouch.Validate( "TfTeTe", "Inbound flight (converted)" );
+ 
+   -- Test without conversions to abstract type
+ 
+    TC_Match( Outbound, "Fl: 5335 K Seat: 5B",
+                        "Fl: 67 FL Seat: 1J",
+                        "Fl: 345 K Seat: 37C" );
+ 
+    TCTouch.Validate( "ETeFTfETe", "Outbound flight" );
+ 
+    TC_Match( Inbound, "Fl: 456 FSN Seat: 4F",
+                        "Fl: 68 K Seat: 12D",
+                        "Fl: 5336 K Seat: 6A" );
+ 
+    TCTouch.Validate( "FTfETeETe", "Inbound flight" );
+ 
+    Report.Result;
+ 
+ end C393012;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,213 ----
+ -- C393A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that a dispatching call to an abstract subprogram invokes
+ --     the correct subprogram body of a descendant type according to
+ --     the controlling tag.
+ --     Check that a subprogram can be declared with formal parameters
+ --     and result that are of an abstract type's associated class-wide
+ --     type and that such subprograms can be called. 3.4.1(4)
+ --
+ -- TEST DESCRIPTION:
+ --     This test declares several objects of types derived from the
+ --     abstract type as defined in the foundation F393A00.  It then calls
+ --     various dispatching and class-wide subprograms using those objects.
+ --     The packages in F393A00 are instrumented to trace the flow of
+ --     execution.
+ --     The test checks for the correct order of execution, as expected
+ --     by the various calls.
+ --
+ -- TEST FILES:
+ --     The following files comprise this test:
+ --
+ --        F393A00.A   (foundation code)
+ --        C393A02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --      05 APR 96   SAIC    Update RM references for 2.1
+ --
+ --!
+ 
+ with Report;
+ with F393A00_0;
+ with F393A00_1;
+ with F393A00_2;
+ with F393A00_3;
+ with F393A00_4;
+ procedure C393A02 is
+ 
+   A_Windmill : F393A00_2.Windmill;
+   A_Pump     : F393A00_3.Pump;
+   A_Mill     : F393A00_4.Mill;
+ 
+   A_Windmill_2 : F393A00_2.Windmill;
+   A_Pump_2     : F393A00_3.Pump;
+   A_Mill_2     : F393A00_4.Mill;
+ 
+   B_Windmill : F393A00_2.Windmill;
+   B_Pump     : F393A00_3.Pump;
+   B_Mill     : F393A00_4.Mill;
+ 
+   procedure Swapem( A,B: in out F393A00_2.Windmill'Class ) is
+   begin
+    F393A00_0.TC_Touch('x');
+    F393A00_2.Swap( A,B );
+   end Swapem;
+ 
+   function Zephyr( A: F393A00_2.Windmill'Class )
+            return F393A00_2.Windmill'Class is
+     Item : F393A00_2.Windmill'Class := A;
+   begin
+     F393A00_0.TC_Touch('y');
+     if not F393A00_1.Initialized( Item ) then  -- b
+       F393A00_2.Initialize( Item );            -- a
+     end if;
+     F393A00_2.Stop( Item );                    -- f / mff
+     F393A00_2.Add_Spin( Item, 10 );            -- e
+     return Item;
+   end Zephyr;
+ 
+   function Gale( It: F393A00_2.Windmill ) return F393A00_2.Windmill'Class is
+     Item : F393A00_2.Windmill'Class := It;
+   begin
+     F393A00_2.Stop( Item );                   -- f
+     F393A00_2.Add_Spin( Item, 40 );           -- e
+     return Item;
+   end Gale;
+ 
+   function Gale( It: F393A00_3.Pump ) return F393A00_2.Windmill'Class is
+     Item : F393A00_2.Windmill'Class := It;
+   begin 
+     F393A00_2.Stop( Item );                   -- f
+     F393A00_2.Add_Spin( Item, 50 );           -- e
+     return Item;
+   end Gale;
+ 
+   function Gale( It: F393A00_4.Mill ) return F393A00_2.Windmill'Class is
+     Item : F393A00_2.Windmill'Class := It;
+   begin 
+     F393A00_2.Stop( Item );                   -- mff
+     F393A00_2.Add_Spin( Item, 60 );           -- e
+     return Item;
+   end Gale;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C393A02", "Check that a dispatching call to an abstract "
+                          & "subprogram invokes the correct subprogram body. "
+                          & "Check that a subprogram declared with formal "
+                          & "parameters/result of an abstract type's "
+                          & "associated class-wide can be called" );
+ 
+   F393A00_0.TC_Validate( "hhh", "Mill declarations" );
+   A_Windmill := F393A00_2.Create;
+   F393A00_0.TC_Validate( "d", "Create A_Windmill" );
+ 
+   A_Pump     := F393A00_3.Create;
+   F393A00_0.TC_Validate( "h", "Create A_Pump" );
+ 
+   A_Mill     := F393A00_4.Create;
+   F393A00_0.TC_Validate( "hl", "Create A_Mill" );
+ 
+   --------------
+ 
+   Swapem( A_Windmill, A_Windmill_2 );
+   F393A00_0.TC_Validate( "xc", "Windmill Swap" );
+   
+   Swapem( A_Pump, A_Pump_2 );
+   F393A00_0.TC_Validate( "xc", "Pump Swap" );
+   
+   Swapem( A_Mill, A_Mill_2 );
+   F393A00_0.TC_Validate( "xk", "Pump Swap" );
+ 
+   F393A00_2.Initialize( A_Windmill_2 );  
+   F393A00_3.Initialize( A_Pump_2 );      
+   F393A00_4.Initialize( A_Mill_2 );      
+   B_Windmill := A_Windmill_2;
+   B_Pump     := A_Pump_2;
+   B_Mill     := A_Mill_2;                
+   F393A00_2.Add_Spin( B_Windmill, 123 ); 
+   F393A00_3.Set_Rate( B_Pump, 12.34 );   
+   F393A00_4.Add_Spin( B_Mill, 321 );     
+   F393A00_0.TC_Validate( "aaaeie", "Setting Values" );
+ 
+   declare
+     It : F393A00_2.Windmill'Class := Zephyr( B_Windmill ); -- ybfe
+     XX : F393A00_2.Windmill'Class := Gale( B_Windmill );   -- fe
+     use type F393A00_2.Rotational_Measurement;
+   begin
+     if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+ then
+       Report.Failed( "Copy to class-wide variable" );
+     end if;                                                -- bb
+     if F393A00_2.Spin( It ) /= 10                          -- g
+        or F393A00_2.Spin( XX ) /= 40 then                  -- g
+       Report.Failed( "Call to class-wide operation" );
+     end if;
+ 
+     F393A00_0.TC_Validate( "ybfefebbgg", "Windmill Zephyr" );
+   end;
+ 
+   declare
+     It : F393A00_2.Windmill'Class := Zephyr( B_Pump );     -- ybfe
+     XX : F393A00_2.Windmill'Class := Gale( B_Pump );       -- fe
+     use type F393A00_2.Rotational_Measurement;
+   begin
+     if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+ then
+       Report.Failed( "Bad copy to class-wide variable" );
+     end if;                                                -- bb
+     if F393A00_2.Spin( It ) /= 10                          -- g
+        or F393A00_2.Spin( XX ) /= 50 then                  -- g
+       Report.Failed( "Call to class-wide operation" );
+     end if;
+ 
+     F393A00_0.TC_Validate( "ybfefebbgg", "Pump Zephyr" );
+   end;
+ 
+   declare
+     It : F393A00_2.Windmill'Class := Zephyr( B_Mill );     -- ybmffe
+     XX : F393A00_2.Windmill'Class := Gale( B_Mill );       -- mffe
+     use type F393A00_2.Rotational_Measurement;
+   begin
+     if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+ then
+       Report.Failed( "Bad copy to class-wide variable" );
+     end if;                                                -- bb
+     if F393A00_2.Spin( It ) /= 10                          -- g
+        or F393A00_2.Spin( XX ) /= 60 then                  -- g
+       Report.Failed( "Call to class-wide operation" );
+     end if;
+ 
+     F393A00_0.TC_Validate( "ybmffemffebbgg", "Mill Zephyr" );
+   end;
+ 
+   Report.Result;
+ 
+ end C393A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,242 ----
+ -- C393A03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a non-abstract primitive subprogram of an abstract
+ --      type can be called as a dispatching operation and that the body
+ --      of this subprogram can make a dispatching call to an abstract
+ --      operation of the corresponding abstract type. 
+ --
+ -- TEST DESCRIPTION:
+ --      This test expands on the class family defined in foundation F393A00
+ --      by deriving a new abstract type from the root abstract type "Object".
+ --      The subprograms defined for the new abstract type are then
+ --      appropriately overridden, and the test ultimately calls various
+ --      mixtures of these subprograms to check that the dispatching occurs
+ --      correctly.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F393A00.A   (foundation code)
+ --         C393A03.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed ARM references from objective text.
+ --      23 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+ --
+ --!
+ 
+ ------------------------------------------------------------------- C393A03_0
+ 
+ with F393A00_1;
+ package C393A03_0 is
+ 
+   type Counting_Object is abstract new F393A00_1.Object with private;
+   -- inherits Initialize, Swap (abstract) and Create (abstract)
+ 
+   procedure Bump ( A_Counter: in out Counting_Object );
+   procedure Clear( A_Counter: in out Counting_Object ) is abstract;
+   procedure Zero ( A_Counter: in out Counting_Object );
+   function  Value( A_Counter: Counting_Object'Class ) return Natural;
+ 
+ private
+ 
+   type Counting_Object is abstract new F393A00_1.Object with
+     record
+       Tally : Natural :=0;
+     end record;
+ 
+ end C393A03_0;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with F393A00_0;
+ package body C393A03_0 is
+ 
+   procedure Bump ( A_Counter: in out Counting_Object ) is
+   begin
+     F393A00_0.TC_Touch('A');
+     A_Counter.Tally := A_Counter.Tally +1;
+   end Bump;
+ 
+   procedure Zero ( A_Counter: in out Counting_Object ) is
+   begin
+     F393A00_0.TC_Touch('B');
+ 
+  -- dispatching call to abstract operation of Counting_Object
+     Clear( Counting_Object'Class(A_Counter) );
+ 
+     A_Counter.Tally := 0;
+ 
+   end Zero;
+ 
+   function  Value( A_Counter: Counting_Object'Class ) return Natural is
+   begin
+     F393A00_0.TC_Touch('C');
+     return A_Counter.Tally;
+   end Value;
+ 
+ end C393A03_0;
+ 
+ ------------------------------------------------------------------- C393A03_1
+ 
+ with C393A03_0;
+ package C393A03_1 is
+ 
+   type Modular_Object is new C393A03_0.Counting_Object with private;
+   -- inherits Initialize, Bump, Zero and Value,
+   -- inherits abstract Swap, Create and Clear
+ 
+   procedure Swap( A,B: in out Modular_Object );
+   procedure Clear( It: in out Modular_Object );
+   procedure Set_Max( It : in out Modular_Object; Value : Natural );
+   function  Create return Modular_Object;
+ 
+ private
+ 
+   type Modular_Object is new C393A03_0.Counting_Object with
+     record
+       Max_Value : Natural;
+     end record;
+ 
+ end C393A03_1;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with F393A00_0;
+ package body C393A03_1 is
+ 
+   procedure Swap( A,B: in out Modular_Object ) is
+     T : constant Modular_Object := B;
+   begin
+     F393A00_0.TC_Touch('1');
+     B := A;
+     A := T;
+   end Swap;
+ 
+   procedure Clear( It: in out Modular_Object ) is
+   begin
+     F393A00_0.TC_Touch('2');
+     null;
+   end Clear;
+ 
+   procedure Set_Max( It : in out Modular_Object; Value : Natural ) is
+   begin
+     F393A00_0.TC_Touch('3');
+     It.Max_Value := Value;
+   end Set_Max;
+ 
+   function  Create return Modular_Object is
+     AMO : Modular_Object;
+   begin
+     F393A00_0.TC_Touch('4');
+     AMO.Max_Value := Natural'Last;
+     return AMO;
+   end Create;
+ 
+ end C393A03_1;
+ 
+ --------------------------------------------------------------------- C393A03
+ 
+ with Report;
+ with F393A00_0;
+ with F393A00_1;
+ with C393A03_0;
+ with C393A03_1;
+ procedure C393A03 is
+ 
+   A_Thing       : C393A03_1.Modular_Object;
+   Another_Thing : C393A03_1.Modular_Object;
+ 
+   procedure Initialize( It: in out C393A03_0.Counting_Object'Class ) is
+   begin
+     C393A03_0.Initialize( It );  -- dispatch to inherited procedure
+   end Initialize;
+ 
+   procedure Bump( It: in out C393A03_0.Counting_Object'Class ) is
+   begin
+     C393A03_0.Bump( It ); -- dispatch to non-abstract procedure
+   end Bump;
+ 
+   procedure Set_Max( It  : in out C393A03_1.Modular_Object'Class;
+                      Val : Natural) is
+   begin
+     C393A03_1.Set_Max( It, Val ); -- dispatch to non-abstract procedure
+   end Set_Max;
+ 
+   procedure Swap( A, B  : in out C393A03_0.Counting_Object'Class ) is
+   begin
+     C393A03_0.Swap( A, B ); -- dispatch to inherited abstract procedure
+   end Swap;
+ 
+   procedure Zero( It: in out C393A03_0.Counting_Object'Class ) is
+   begin
+     C393A03_0.Zero( It ); -- dispatch to non-abstract procedure
+   end Zero;
+ 
+ begin  -- Main test procedure.
+ 
+    Report.Test ("C393A03", "Check that a non-abstract primitive subprogram "
+ 			 & "of an abstract type can be called as a "
+ 			 & "dispatching operation and that the body of this "
+ 			 & "subprogram can make a dispatching call to an "
+ 			 & "abstract operation of the corresponding "
+ 			 & "abstract type" );
+ 
+    A_Thing := C393A03_1.Create; -- Max_Value = Natural'Last
+    F393A00_0.TC_Validate( "4", "Overridden primitive layer 2");
+ 
+    Initialize( A_Thing );
+    Initialize( Another_Thing );
+    F393A00_0.TC_Validate( "aa", "Non-abstract primitive layer 0");
+    
+    Bump( A_Thing ); -- Tally = 1
+    F393A00_0.TC_Validate( "A", "Non-abstract primitive layer 1");
+ 
+    Set_Max( A_Thing, 42 ); -- Max_Value = 42
+    F393A00_0.TC_Validate( "3", "Non-abstract normal layer 2");
+ 
+    if not F393A00_1.Initialized( A_Thing ) then
+      Report.Failed("Initialize didn't");
+    end if;
+    F393A00_0.TC_Validate( "b", "Class-wide layer 0");
+ 
+    Swap( A_Thing, Another_Thing );
+    F393A00_0.TC_Validate( "1", "Overridden abstract layer 2");
+ 
+    Zero( A_Thing );
+    F393A00_0.TC_Validate( "B2", "Non-abstract layer 0, calls dispatch");
+ 
+    if C393A03_0.Value( A_Thing ) /= 0 then
+      Report.Failed("Zero didn't");
+    end if;
+    F393A00_0.TC_Validate( "C", "Class-wide normal layer 2");
+ 
+    Report.Result;
+ 
+ end C393A03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a05.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a05.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a05.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a05.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,166 ----
+ -- C393A05.A
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- OBJECTIVE:
+  --      Check that for a nonabstract private extension, any inherited
+  --      abstract subprograms can be overridden in the private part of
+  --      the immediately enclosing package and that calls can be made to
+  --      private dispatching operations.
+  --
+  -- TEST DESCRIPTION:
+  --      This test builds an additional layer upon the foundation code to
+  --      provide the required "hidden" dispatching operation.  The procedure
+  --      Swap, a private subprogram, should be called by dispatch.
+  --
+  -- TEST FILES:
+  --      The following files comprise this test:
+  --
+  --         F393A00.A   (foundation code)
+  --         C393A05.A
+  --
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  with F393A00_4;
+  package C393A05_0 is
+    type Grinder is new F393A00_4.Mill with private;
+    type Coarseness is (Whole_Bean, Coarse, Medium, Fine, Espresso);
+  
+    procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness );
+    function  Grind( It: Grinder ) return Coarseness;
+  
+    function  Create return Grinder;
+  private
+    procedure Swap( A,B: in out Grinder );
+    type Grinder is new F393A00_4.Mill with
+      record
+        Grind : Coarseness := Whole_Bean;
+      end record;
+  end C393A05_0;
+  
+  with F393A00_0;
+  package body C393A05_0 is
+    procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness ) is
+    begin
+      F393A00_0.TC_Touch( 'A' );
+      It.Grind := The_Grind;
+    end Set_Grind;
+  
+    function  Grind( It: Grinder ) return Coarseness is
+    begin
+      F393A00_0.TC_Touch( 'B' );
+      return It.Grind;
+    end Grind;
+  
+    procedure Swap( A,B: in out Grinder ) is
+      T : constant Grinder := A;
+    begin
+      F393A00_0.TC_Touch( 'C' );
+      A := B;
+      B := T;
+    end Swap;
+  
+    function  Create return Grinder is
+      One: Grinder;  
+    begin
+      F393A00_0.TC_Touch( 'D' );
+      F393A00_4.Initialize( F393A00_4.Mill( One ) );
+      One.Grind := Fine;
+      return One;
+    end Create;
+  end C393A05_0;
+  
+  with Report;
+  with F393A00_0;
+  with C393A05_0;
+  procedure C393A05 is
+  
+    package Tracer renames F393A00_0;
+    package Coffee renames C393A05_0;
+    use type Coffee.Coarseness;
+  
+    Morning   : Coffee.Grinder;
+    Afternoon : Coffee.Grinder;
+  
+    Gritty    : Coffee.Coarseness;
+  
+    procedure Class_Swap( A, B: in out Coffee.Grinder'Class ) is
+    begin
+      Coffee.Swap( A, B ); -- dispatch
+    end Class_Swap;
+  
+  begin  -- Main test procedure.
+  
+    Report.Test ("C393A05",  "Check that nonabstract private extensions, "
+                           & "inherited abstract subprograms overridden "
+                           & "in the private part can be dispatched from "
+                           & "outside the package" );
+  
+    Tracer.TC_Validate( "hh", "Declarations" );
+  
+    Morning := Coffee.Create;
+    Tracer.TC_Validate( "hDa", "Creating Morning Coffee" );
+    Gritty  := Coffee.Grind( Morning );
+    Tracer.TC_Validate( "B", "Finding Morning Grind" );
+  
+    Afternoon := Coffee.Create;
+    Tracer.TC_Validate( "hDa", "Creating Afternoon Coffee" );
+    Coffee.Set_Grind( Afternoon, Coffee.Medium );
+    Tracer.TC_Validate( "A", "Setting Afternoon Grind" );
+  
+    Coffee.Swap( Morning, Afternoon );
+    Tracer.TC_Validate( "C", "Dispatching Swapping Coffees" );
+  
+    if Gritty /= Coffee.Grind( Afternoon )
+       or Coffee.Grind ( Afternoon ) /= Coffee.Fine then
+      Report.Failed ("Result of Swap");
+    end if;
+    Tracer.TC_Validate( "BB", "Finding Afternoon Grind" );
+  
+    Sunset: declare
+      Evening   : Coffee.Grinder'Class := Coffee.Create;
+    begin
+      Tracer.TC_Validate( "hDa", "Creating Evening Coffee" );
+  
+      Coffee.Set_Grind( Evening, Coffee.Espresso );
+      Tracer.TC_Validate( "A", "Setting Evening Grind" );
+  
+      Morning := Coffee.Grinder( Evening );
+      Class_Swap( Morning, Evening );
+      Tracer.TC_Validate( "C", "Swapping Coffees" );
+      if Coffee.Grind( Morning ) /= Coffee.Espresso then
+        Report.Failed ("Result of Assignment");
+      end if;
+    end Sunset;
+  
+    Report.Result;
+  
+  end C393A05;
+  
+  
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a06.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a06.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393a06.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393a06.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,201 ----
+ -- C393A06.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a type that inherits abstract operations but
+ --      overrides each of these operations is not required to be
+ --      abstract, and that objects of the type and its class-wide type
+ --      may be declared and passed in calls to the overriding
+ --      subprograms.
+ --
+ -- TEST DESCRIPTION:
+ --      This test derives a type from the root abstract type available
+ --      in foundation F393A00.  It declares subprograms as required by
+ --      the language to override the abstract subprograms, allowing the
+ --      derived type itself to be not abstract.  It also declares
+ --      operations on the new type, as well as on the associated class-
+ --      wide type.  The main program then uses two objects of the type
+ --      and two objects of the class-wide type as parameters for each of
+ --      the subprograms.  Correct execution is determined by path
+ --      analysis and value checking.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F393A00.A   (foundation code)
+ --         C393A06.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --
+ --!
+  
+  with F393A00_1;
+  package C393A06_0 is
+    type Organism is new F393A00_1.Object with private;
+    type Kingdoms is ( Animal, Vegetable, Unspecified );
+  
+    procedure Swap( A,B: in out Organism );
+    function  Create return Organism;
+  
+    procedure Initialize( The_Entity     : in out Organism;
+                          In_The_Kingdom : Kingdoms );
+    function  Kingdom( Of_The_Entity : Organism ) return Kingdoms;
+  
+    procedure TC_Check( An_Entity   : Organism'Class;
+                        In_Kingdom  : Kingdoms;
+                        Initialized : Boolean );
+  
+    Incompatible : exception;
+  
+  private
+    type Organism is new F393A00_1.Object with
+      record
+        In_Kingdom : Kingdoms;
+      end record;
+  end C393A06_0;
+  
+  with F393A00_0;
+  package body C393A06_0 is
+  
+    procedure Swap( A,B: in out Organism ) is
+    begin
+      F393A00_0.TC_Touch( 'A' );  ------------------------------------------- A
+      if A.In_Kingdom /= B.In_Kingdom then
+        F393A00_0.TC_Touch( 'X' );
+        raise Incompatible;
+      else
+        declare
+          T: constant Organism := A;
+        begin
+          A := B;
+          B := T;
+        end;
+      end if;
+    end Swap;
+  
+    function  Create return Organism is
+      Widget : Organism;
+    begin
+      F393A00_0.TC_Touch( 'B' ); ------------------------------------------- B
+      Initialize( Widget );
+      Widget.In_Kingdom := Unspecified;
+      return Widget;
+    end Create;
+  
+    procedure Initialize( The_Entity     : in out Organism;
+                          In_The_Kingdom : Kingdoms ) is
+    begin
+      F393A00_0.TC_Touch( 'C' ); ------------------------------------------- C
+      F393A00_1.Initialize( F393A00_1.Object( The_Entity ) );
+      The_Entity.In_Kingdom := In_The_Kingdom;
+    end Initialize;
+  
+    function  Kingdom( Of_The_Entity : Organism ) return Kingdoms is
+    begin
+      F393A00_0.TC_Touch( 'D' ); ------------------------------------------- D
+      return Of_The_Entity.In_Kingdom;
+    end Kingdom;
+  
+    procedure TC_Check( An_Entity   : Organism'Class;
+                        In_Kingdom  : Kingdoms;
+                        Initialized : Boolean ) is
+    begin
+      if F393A00_1.Initialized( An_Entity ) /= Initialized then
+        F393A00_0.TC_Touch( '-' ); ------------------------------------------- -
+      elsif An_Entity.In_Kingdom /= In_Kingdom then
+        F393A00_0.TC_Touch( '!' ); ------------------------------------------- !
+      else
+        F393A00_0.TC_Touch( '+' ); ------------------------------------------- +
+      end if;
+    end TC_Check;
+  
+  end C393A06_0;
+  
+  with Report;
+  
+  with C393A06_0;
+  with F393A00_0;
+  with F393A00_1;
+  procedure C393A06 is
+  
+    package Darwin  renames C393A06_0;
+    package Tagger  renames F393A00_0;
+    package Objects renames F393A00_1;
+  
+    Lion      : Darwin.Organism;
+    Tigerlily : Darwin.Organism;
+    Bear      : Darwin.Organism'Class := Darwin.Create;
+    Sunflower : Darwin.Organism'Class := Darwin.Create;
+  
+    use type Darwin.Kingdoms;
+  
+  begin  -- Main test procedure.
+  
+     Report.Test ("C393A06", "Check that a type that inherits abstract "
+                           & "operations but overrides each of these "
+                           & "operations is not required to be abstract. "
+                           & "Check that objects of the type and its "
+                           & "class-wide type may be declared and passed "
+                           & "in calls to the overriding subprograms" );
+  
+    Tagger.TC_Validate( "BaBa", "Declaration Initializations" );
+  
+    Darwin.Initialize( Lion,      Darwin.Animal );
+    Darwin.Initialize( Tigerlily, Darwin.Vegetable );
+    Darwin.Initialize( Bear,      Darwin.Animal );
+    Darwin.Initialize( Sunflower, Darwin.Vegetable );
+  
+    Tagger.TC_Validate( "CaCaCaCa", "Initialization sequence" );
+  
+    Oh_My: begin
+      Darwin.Swap( Lion, Darwin.Organism( Bear ) );
+      Darwin.Swap( Lion, Tigerlily );
+      Report.Failed("Exception not raised");
+    exception
+      when Darwin.Incompatible => null;
+    end Oh_My;
+  
+    Tagger.TC_Validate( "AAX", "Swap sequence" );
+  
+    if Darwin.Kingdom( Darwin.Create ) = Darwin.Unspecified then
+      Darwin.Swap( Sunflower, Darwin.Organism'Class( Tigerlily ) );
+    end if;
+  
+    Tagger.TC_Validate( "BaDA", "Vegetable swap sequence" );
+  
+    Darwin.TC_Check( Lion,      Darwin.Animal,    True );
+    Darwin.TC_Check( Tigerlily, Darwin.Vegetable, True );
+    Darwin.TC_Check( Bear,      Darwin.Animal,    True );
+    Darwin.TC_Check( Sunflower, Darwin.Vegetable, True );
+  
+    Tagger.TC_Validate( "b+b+b+b+", "Final sequence" );
+  
+    Report.Result;
+  
+  end C393A06;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393b12.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393b12.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393b12.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393b12.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,131 ----
+ -- C393B12.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an extended type can be derived in the specification of a
+ --      generic package when the parent is an abstract type in a library
+ --      package.
+ --
+ -- TEST DESCRIPTION:
+ --      Extend an abstract type in the visible part of a generic package.
+ --      Make all of the procedures which override abstract procedures
+ --      available as part of the generic interface.  Instantiate the generic.
+ --
+ -- TEST FILES: 
+ --      This test depends on the following foundation code:
+ --
+ --         F393B00.A  Package Alert_Foundation
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      14 Oct 95   SAIC    Update and repair for ACVC 2.0.1
+ --      27 Feb 97   PWB.CTA Add pragma Elaborate for C393B12_0.
+ --!
+ 
+ ----------------------------------------------------------------- C393B12_0
+ 
+ with F393B00;
+   -- Alert_Foundation
+ generic 
+   type Generic_Status_Enum is (<>);
+ 
+ package C393B12_0 is
+      -- Alert_Functions
+ 
+   type Generic_Alert_Type is new F393B00.Alert with record
+     Status : Generic_Status_Enum := Generic_Status_Enum'First;
+   end record;
+                                      -- extension of an abstract type
+ 
+   procedure Handle (GA : in out Generic_Alert_Type);
+                                      -- override of abstract procedure
+ 
+   function Query_Status (GA : Generic_Alert_Type)
+     return Generic_Status_Enum;      -- new primitive operation for
+                                      -- Generic_Alert_Type
+ end C393B12_0;
+  -- Alert_Functions
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C393B12_0 is
+           -- Alert_Functions
+ 
+   procedure Handle (GA : in out Generic_Alert_Type) is
+     begin
+       GA.Status := Generic_Status_Enum'Last;
+     end Handle;
+ 
+   function Query_Status (GA : Generic_Alert_Type) 
+     return Generic_Status_Enum is
+     begin
+       return GA.Status;
+     end Query_Status;
+ 
+ end C393B12_0;
+ 
+ ----------------------------------------------------------------- C393B12_1
+ 
+ package C393B12_1 is
+   type Status is (Low, Medium, High);
+ end C393B12_1;
+ 
+ ------------------------------------------------------- C393B12_1.C393B12_2
+ 
+ with C393B12_0;
+ pragma Elaborate (C393B12_0);
+ package C393B12_1.C393B12_2 is new C393B12_0 
+                         -- Alert_Functions
+                  (Generic_Status_Enum => Status);
+ 
+ ------------------------------------------------------------------- C393B12
+ 
+ with C393B12_1.C393B12_2;
+ with Report;
+ procedure C393B12 is
+ 
+   use type C393B12_1.Status;
+ 
+   package Alt_Alert renames C393B12_1.C393B12_2;
+ 
+   GA : Alt_Alert.Generic_Alert_Type;
+ 
+ begin
+   Report.Test ("C393B12",  "Check that an extended type can be derived " &
+                            "from an abstract type");
+ 
+   if Alt_Alert.Query_Status (GA) /= C393B12_1.Low then
+     Report.Failed ("Wrong initialization");
+   end if;
+ 
+   Alt_Alert.Handle (GA);
+   if Alt_Alert.Query_Status (GA) /= C393B12_1.High then
+     Report.Failed ("Wrong results from Handle");
+   end if;
+ 
+   Report.Result;
+ 
+ end C393B12;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393b13.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393b13.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393b13.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393b13.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C393B13.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an extended type can be derived from an abstract type
+ --      when that derivation is declared in a child package.
+ --
+ -- TEST DESCRIPTION:
+ --      Add a visible child to Alert_Foundation.  Using the abstract type
+ --      Alert as parent, declare an extended type with discriminant and new
+ --      record components.  Override the Handle procedure.
+ --  
+ -- TEST FILES: 
+ --      This test depends on the following foundation code:
+ --
+ --         F393B00.A  Package Alert_Foundation
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+ --
+ --!
+ 
+ package F393B00.C393B13_0 is
+      -- Alert_Foundation.Public_Child
+ 
+   subtype Msg_Length_Range is integer range 0 .. 240;
+   Max_Msg_Length : constant Msg_Length_Range := 80;
+   Message : String := "Test Passed";
+ 
+   type Child_Alert (Length : Msg_Length_Range) 
+     is new Alert with record        -- abstract type is in parent package
+       Times_Handled : Natural := 0;
+       Msg           : String (1..Length);
+     end record;
+ 
+   procedure Handle (CA : in out Child_Alert);  -- required override
+   
+ end F393B00.C393B13_0;
+  -- Alert_Foundation.Public_Child;
+ 
+ --=======================================================================--
+ 
+ package body F393B00.C393B13_0 is
+           -- Alert_Foundation.Public_Child
+   
+   procedure Handle (CA : in out Child_Alert) is
+     begin
+       CA.Msg(1..Message'Length) := Message;
+       CA.Times_Handled := CA.Times_Handled + 1;
+     end;
+   
+ end F393B00.C393B13_0;
+  -- Alert_Foundation.Public_Child
+ 
+ --=======================================================================--
+   
+ with Report;
+ with F393B00.C393B13_0;
+   -- Alert_foundation.Public_Child;
+ procedure C393B13 is
+   package Child renames F393B00.C393B13_0;
+   CA : Child.Child_Alert(Child.Message'Length);
+  
+ begin
+ 
+   Report.Test ("C393B13", "Check that an extended type can be derived " &
+                           "from an abstract type");
+ 
+   if CA.Times_Handled /= 0 then
+     Report.Failed ("Wrong initialization");
+   end if;
+ 
+   Child.Handle (CA);
+   if (CA.Times_Handled /= 1)
+   or (CA.Msg /= Child.Message) then
+     Report.Failed ("Wrong results from Handle");
+   end if;
+   
+   Report.Result;
+ 
+ end C393B13;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393b14.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393b14.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c393b14.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c393b14.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- C393B14.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an extended type can be derived in a private child package
+ --      from an abstract type defined in a library package.
+ --
+ -- TEST DESCRIPTION:
+ --      Add a private child package to Alert_Foundation.  Using Private_Alert
+ --      as parent type, declare an extended type adding a new record component.
+ --      Override procedure Handle.  Declare an object of the new type in the
+ --      child specification. Use type definitions from the private part of the
+ --      parent in the body of the child.
+ --
+ -- TEST FILES: 
+ --      This test depends on the following foundation code:
+ --
+ --         F393B00.A  Package Alert_Foundation
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ private package F393B00.C393B14_0 is
+              -- Alert_Foundation.Private_Child
+ 
+   type Implementation_Specific_Alert_Type is new Private_Alert with record
+     New_Private_Field : Implementation_Detail 
+                         := Implementation_Detail'Last;
+   end record;
+ 
+   procedure Handle (PA : in out Implementation_Specific_Alert_Type);
+                              -- overrides abstract Handle, as required
+   PA : Implementation_Specific_Alert_Type;
+ 
+ end F393B00.C393B14_0;
+  -- Alert_Foundation.Private_Child
+ 
+ --=======================================================================--
+ 
+ package body F393B00.C393B14_0 is
+                   -- Alert_Foundation.Private_Child
+ 
+   procedure Handle (PA : in out Implementation_Specific_Alert_Type) is
+     begin
+       PA.Private_Field := 1;
+       PA.New_Private_Field := PA.Private_Field + 1;
+     end;
+ 
+ end F393B00.C393B14_0;
+  -- Alert_Foundation.Private_Child
+ 
+ --=======================================================================--
+ 
+ package F393B00.C393B14_1 is
+      -- Alert_Foundation.Public_Child
+ 
+   type Timing is (Before, After);
+   procedure Init;
+   procedure Modify;
+   function Check_Before return Boolean;
+   function Check_After  return Boolean;
+ 
+ end F393B00.C393B14_1;
+  -- Alert_Foundation.Public_Child
+ 
+ --=======================================================================--
+ 
+ with F393B00.C393B14_0;               -- private sibling is visible in the
+   -- Alert_Foundation.Private_Child   -- body of a public sibling
+ package body F393B00.C393B14_1 is
+      -- Alert_Foundation.Public_Child
+   package Priv renames F393B00.C393B14_0;
+ 
+   procedure Init is
+     begin
+       Priv.PA.Private_Field     := 5;
+       Priv.PA.New_Private_Field := 10;
+     end Init;
+ 
+   procedure Modify is
+     begin 
+       Priv.Handle (Priv.PA);
+     end Modify;
+ 
+   function Check_Before return Boolean is
+     begin
+       return ((Priv.PA.Private_Field = 5) 
+                and (Priv.PA.New_Private_Field =10));
+     end Check_Before;
+ 
+   function Check_After return Boolean is
+     begin
+       return ((Priv.PA.Private_Field = 1)
+                and (Priv.PA.New_Private_Field = 2));
+     end Check_After;
+ 
+ end F393B00.C393B14_1;
+  -- Alert_Foundation.Public_Child
+ 
+ --=======================================================================--
+ 
+ with Report;
+ with F393B00.C393B14_1;
+ procedure C393B14 is
+  -- Alert_Foundation.Public_Child;
+ 
+ begin
+   Report.Test ("C393B14", "Check that an extended type can be derived " &
+                           "from an abstract type");
+ 
+   F393B00.C393B14_1.Init;
+   if not F393B00.C393B14_1.Check_Before then 
+     Report.Failed ("Wrong initialization");
+   end if;
+ 
+   F393B00.C393B14_1.Modify;
+   if not F393B00.C393B14_1.Check_After then
+     Report.Failed ("Wrong results from Handle");
+   end if;
+ 
+   Report.Result;
+ end C393B14;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- C3A0001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that access to subprogram type can be used to select and
+ --      invoke functions with appropriate arguments dynamically.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an access to function type in a package specification.  
+ --      Declare three different sine functions that can be referred to by 
+ --      the access to function type.  
+ --      
+ --      In the main program, call each function indirectly by dereferencing 
+ --      the access value.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C3A0001_0 is
+    
+    TC_Call_Tag : Natural := 0;
+ 
+    -- Type accesses to any sine function
+    type Sine_Function_Ptr is access function   
+       (Angle : in Float) return Float;
+ 
+ -- Three 'Sine' functions that model an application situation in which
+ -- one function might be chosen when speed is important, another (using
+ -- a different algorithm) might be chosen when accuracy is important,
+ -- and so on.
+ 
+    function Sine_Calc_Fast  (Angle : in Float) return Float;         
+ 
+    function Sine_Calc_Acc   (Angle : in Float) return Float;        
+ 
+    function Sine_Calc_Table (Angle : in Float) return Float;        
+ 
+ end C3A0001_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body C3A0001_0 is
+ 
+    function Sine_Calc_Fast (Angle : in Float) return Float is
+    begin
+       TC_Call_Tag := 1;
+       return 1.0;
+    end Sine_Calc_Fast;
+ 
+ 
+    function Sine_Calc_Acc (Angle : in Float) return Float is
+    begin
+       TC_Call_Tag := 2;
+       return 0.0;
+    end Sine_Calc_Acc;
+ 
+ 
+    function Sine_Calc_Table (Angle : in Float) return Float is
+    begin
+       TC_Call_Tag := 3;
+       return -1.0;         
+    end Sine_Calc_Table;
+ 
+ end C3A0001_0;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with Report;
+ with C3A0001_0;
+ 
+ procedure C3A0001 is
+ 
+    Sine_Access : C3A0001_0.Sine_Function_Ptr;
+    X, Theta    : Float := 0.0;
+ 
+ begin
+ 
+    Report.Test ("C3A0001", "Check that access to subprogram can be " &
+                 "used to select and invoke an operation with " &
+                 "appropriate arguments dynamically");
+ 
+    Sine_Access := C3A0001_0.Sine_Calc_Fast'Access;
+ 
+    -- Invoking Sine function designated by access value
+    X := Sine_Access(Theta);
+ 
+    If C3A0001_0.TC_Call_Tag /= 1 then
+       Report.Failed ("Incorrect Sine_Calc_Fast result");
+    end if;
+ 
+    Sine_Access := C3A0001_0.Sine_Calc_Acc'Access;
+ 
+    -- Invoking Sine function designated by access value
+    X := Sine_Access(Theta);
+ 
+    If C3A0001_0.TC_Call_Tag /= 2 then
+       Report.Failed ("Incorrect Sine_Calc_Acc result");
+    end if;
+ 
+    Sine_Access := C3A0001_0.Sine_Calc_Table'Access;
+ 
+    -- Invoking Sine function designated by access value
+    X := Sine_Access(Theta);
+ 
+    If C3A0001_0.TC_Call_Tag /= 3 then
+       Report.Failed ("Incorrect Sine_Calc_Table result");
+    end if;
+ 
+    Report.Result;
+ 
+ end C3A0001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C3A0002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that access to subprogram type can be used to select and 
+ --      invoke procedures with appropriate arguments dynamically.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an access to procedure type in a package specification.  
+ --      Declare three different log procedures that can be referred to by 
+ --      the access to procedure type.  
+ -- 
+ --      In the main program, call each procedure indirectly by dereferencing 
+ --      the access value.
+ -- 
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      05 APR 96   SAIC    RM reference change for 2.1
+ --
+ --
+ --!
+ 
+ 
+ package C3A0002_0 is
+ 
+    TC_Call_Tag : Natural := 0;
+ 
+    Return_Num          : Float   := 0.0;
+ 
+    -- Type accesses to any log procedure
+    type Log_Procedure_Ptr is access procedure   
+       (Angle : in Float);
+ 
+    procedure Log_Calc_Fast  (Angle : in Float);         
+ 
+    procedure Log_Calc_Acc   (Angle : in Float);        
+ 
+    procedure Log_Calc_Table (Angle : in Float);
+ 
+ end C3A0002_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body C3A0002_0 is
+ 
+    procedure Log_Calc_Fast (Angle : in Float) is
+    begin
+       TC_Call_Tag := 1;
+       Return_Num := Angle;
+    end Log_Calc_Fast;
+ 
+ 
+    procedure Log_Calc_Acc (Angle : in Float) is
+    begin
+       TC_Call_Tag  := 2;
+       Return_Num := Angle;
+    end Log_Calc_Acc;
+ 
+ 
+    procedure Log_Calc_Table (Angle : in Float) is
+    begin
+       TC_Call_Tag := 3;
+       Return_Num := Angle;
+    end Log_Calc_Table;
+ 
+ end C3A0002_0;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with Report;
+ with C3A0002_0; 
+ 
+ procedure C3A0002 is
+ 
+    Log_Access : C3A0002_0.Log_Procedure_Ptr;
+    Theta      : Float := 0.0;
+ 
+ begin
+ 
+    Report.Test ("C3A0002", "Check that access to subprogram type can be "
+                          & "used to select and invoke procedures with "
+                          & "appropriate arguments dynamically" );
+ 
+    Log_Access := C3A0002_0.Log_Calc_Fast'Access;
+ 
+    -- Invoking Log procedure designated by access value
+    Log_Access (Theta);
+ 
+    If C3A0002_0.TC_Call_Tag /= 1 or C3A0002_0.Return_Num /= 0.0 then
+       Report.Failed ("Incorrect Log_Calc_Fast result");
+    end if;
+ 
+    Theta := 1.0;
+ 
+    Log_Access := C3A0002_0.Log_Calc_Acc'Access;
+ 
+    -- Invoking Log procedure designated by access value
+    Log_Access (Theta);
+ 
+    If C3A0002_0.TC_Call_Tag /= 2 or C3A0002_0.Return_Num /= 1.0 then
+       Report.Failed ("Incorrect Log_Calc_Acc result");
+    end if;
+ 
+    Theta := -1.0;
+ 
+    Log_Access := C3A0002_0.Log_Calc_Table'Access;
+ 
+    -- Invoking Log procedure designated by access value
+    Log_Access (Theta);
+ 
+    If C3A0002_0.TC_Call_Tag /= 3 or C3A0002_0.Return_Num /= -1.0 then
+       Report.Failed ("Incorrect Log_Calc_Table result");
+    end if;
+ 
+    Report.Result;
+ 
+ end C3A0002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- C3A0003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a function in a generic instance can be called using
+ --      an access-to-subprogram value.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a numeric type in the visible part of a generic package.
+ --      Declare an access to function type.  Declare three different sine 
+ --      functions that can be referred to by the access to function type.  
+ --
+ --      In the main program, instantiate the generic.  Call each function 
+ --      indirectly by dereferencing the access value.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ generic
+    type Real_Num is digits <>;
+ 
+ package C3A0003_0 is
+    
+    TC_Call_Tag : Natural := 0;
+ 
+    -- Type accesses to any sine function
+    type Sine_Function_Ptr is access function   
+       (Angle : in Real_Num) return Real_Num;
+ 
+    function Sine_Calc_Fast  (Angle : in Real_Num) return Real_Num;         
+ 
+    function Sine_Calc_Acc   (Angle : in Real_Num) return Real_Num;        
+ 
+    function Sine_Calc_Table (Angle : in Real_Num) return Real_Num;        
+ 
+ end C3A0003_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body C3A0003_0 is
+ 
+    function Sine_Calc_Fast (Angle : in Real_Num) return Real_Num is
+       Sine_Num : Real_Num := 1.0;
+    begin
+       TC_Call_Tag := 1;
+       return Sine_Num;
+    end Sine_Calc_Fast;
+ 
+ 
+    function Sine_Calc_Acc (Angle : in Real_Num) return Real_Num is
+       Sine_Num : Real_Num := 0.0;
+    begin
+       TC_Call_Tag := 2;
+       return Sine_Num;
+    end Sine_Calc_Acc;
+ 
+ 
+    function Sine_Calc_Table (Angle : in Real_Num) return Real_Num is
+       Sine_Num : Real_Num := -1.0;
+    begin
+       TC_Call_Tag := 3;
+       return Sine_Num;
+    end Sine_Calc_Table;
+ 
+ end C3A0003_0;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with Report;
+ with C3A0003_0;
+ 
+ procedure C3A0003 is
+ 
+    type Real is digits 5;
+ 
+    Subtype Trig_Float is Real range -1.0 .. 1.0;
+ 
+    package Trig is new C3A0003_0 (Real_Num => Trig_Float);
+ 
+    Sine_Access : Trig.Sine_Function_Ptr;
+    X, Theta    : Trig_Float := 0.0;
+ 
+ begin
+ 
+    Report.Test ("C3A0003", "Check that a function in a generic instance can "
+                          & "be called using an access-to-subprogram value");
+ 
+    Sine_Access := Trig.Sine_Calc_Fast'Access;
+ 
+    -- Invoking Sine function designated by access value
+    X := Sine_Access.all(Theta);
+ 
+    If Trig.TC_Call_Tag /= 1 then
+       Report.Failed ("Incorrect Sine_Calc_Fast result");
+    end if;
+ 
+    Sine_Access := Trig.Sine_Calc_Acc'Access;
+ 
+    -- Invoking Sine function designated by access value
+    X := Sine_Access.all(Theta);
+ 
+    If Trig.TC_Call_Tag /= 2 then
+       Report.Failed ("Incorrect Sine_Calc_Acc result");
+    end if;
+ 
+    Sine_Access := Trig.Sine_Calc_Table'Access;
+ 
+    -- Invoking Sine function designated by access value
+    X := Sine_Access.all(Theta);
+ 
+    If Trig.TC_Call_Tag /= 3 then
+       Report.Failed ("Incorrect Sine_Calc_Table result");
+    end if;
+ 
+    Report.Result;
+ 
+ end C3A0003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- C3A0004.A
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- OBJECTIVE: 
+  --      Check that access to subprogram may be stored within array 
+  --      objects, and that the access to subprogram can subsequently 
+  --      be called. 
+  -- 
+  -- TEST DESCRIPTION:
+  --      Declare an access to procedure type in a package specification.  
+  --      Declare an array of the access type.  Declare three different 
+  --      procedures that can be referred to by the access to procedure type.  
+  --
+  --      In the main program, build the array by dereferencing the access 
+  --      value.
+  --
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  with Report;
+  
+  procedure C3A0004 is
+  
+     Left_Turn   : Integer  := 1;
+  
+     Right_Turn  : Integer  := 1;
+  
+     Center_Turn : Integer  := 1;
+  
+     -- Type accesses to any procedure
+     type Action_Ptr is access procedure;
+     
+     -- Array of access to procedure
+     type Action_Array is array (Integer range <>) of Action_Ptr;
+  
+  
+     procedure Rotate_Left is
+     begin
+        Left_Turn := 2;
+     end Rotate_Left;
+  
+  
+     procedure Rotate_Right is
+     begin
+        Right_Turn := 3;
+     end Rotate_Right;
+  
+  
+     procedure Center is
+     begin
+        Center_Turn := 0;
+     end Center;
+  
+  
+  begin
+  
+     Report.Test ("C3A0004", "Check that access to subprogram may be "
+                           & "stored within data structures, and that the "
+                           & "access to subprogram can subsequently be called");
+  
+     ------------------------------------------------------------------------
+  
+     declare
+        Total_Actions   : constant := 3;
+        Action_Sequence : Action_Array (1 .. Total_Actions);
+  
+     begin
+  
+        -- Build the action sequence
+        Action_Sequence := (Rotate_Left'Access, Center'Access,
+                            Rotate_Right'Access);
+  
+        -- Assign actions by invoking subprogram designated by access value
+        for I in Action_Sequence'Range loop
+           Action_Sequence(I).all;
+        end loop;
+  
+        If Left_Turn /= 2 or Right_Turn /= 3
+           or Center_Turn /= 0 then
+              Report.Failed ("Incorrect Action sequence result");
+        end if;
+  
+      end;
+  
+     ------------------------------------------------------------------------
+  
+     Report.Result;
+  
+  end C3A0004;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- C3A0005.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that access to subprogram may be stored within record 
+ --      objects, and that the access to subprogram can subsequently 
+ --      be called. 
+ -- 
+ -- TEST DESCRIPTION:
+ --      Declare an access to procedure type in a package specification.  
+ --      Declare two different procedures that can be referred to by the 
+ --      access to procedure type.  Declare a record with the access to 
+ --      procedure type as a component.  Use the access to procedure type to 
+ --      initialize the component of a record.  
+ --
+ --      In the main program, declare an operation.  An access value 
+ --      designating this operation is passed as a parameter to be 
+ --      stored in the record.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C3A0005_0 is
+ 
+    Default_Call   : Boolean := False;
+ 
+    type Button;
+ 
+ 
+    -- Type accesses to procedures Push and Default_Response
+    type Button_Response_Ptr is access procedure
+       (B : access Button);
+ 
+    procedure Push (B : access Button);
+ 
+    procedure Set_Response (B : access Button;
+                            R : in Button_Response_Ptr);
+ 
+    procedure Default_Response  (B : access Button);
+ 
+    Emergency_Call : Boolean := False;
+ 
+    procedure Emergency (B : access C3A0005_0.Button);
+ 
+    type Button is
+       record
+          Response :  Button_Response_Ptr
+                   := Default_Response'Access;   
+       end record;
+ 
+ end C3A0005_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ with TCTouch;
+ package body C3A0005_0 is
+ 
+    procedure Push (B : access Button) is
+    begin
+       TCTouch.Touch( 'P' ); --------------------------------------------- P
+       -- Invoking subprogram designated by access value
+       B.Response (B);
+    end Push;
+ 
+ 
+    procedure Set_Response (B : access Button;
+                            R : in     Button_Response_Ptr) is
+    begin
+       TCTouch.Touch( 'S' ); --------------------------------------------- S
+       -- Set procedure value in record
+       B.Response := R;
+    end Set_Response;
+ 
+ 
+    procedure Default_Response (B : access Button) is
+    begin
+       TCTouch.Touch( 'D' ); --------------------------------------------- D
+       Default_Call := True;
+    end Default_Response;
+ 
+ 
+    procedure Emergency (B : access C3A0005_0.Button) is
+    begin
+       TCTouch.Touch( 'E' ); --------------------------------------------- E
+       Emergency_Call := True;
+    end Emergency;
+ 
+ end C3A0005_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ with TCTouch;
+ with Report;
+ 
+ with C3A0005_0;
+ 
+ procedure C3A0005 is
+ 
+    Big_Red_Button : aliased C3A0005_0.Button;
+ 
+ begin
+ 
+    Report.Test ("C3A0005", "Check that access to subprogram may be "
+                          & "stored within data structures, and that the "
+                          & "access to subprogram can subsequently be called");
+ 
+    C3A0005_0.Push (Big_Red_Button'Access);
+    TCTouch.Validate("PD", "Using default value");
+    TCTouch.Assert( C3A0005_0.Default_Call, "Default Call" );
+ 
+    -- set Emergency value in Button.Response
+    C3A0005_0.Set_Response(Big_Red_Button'Access, C3A0005_0.Emergency'Access);
+ 
+    C3A0005_0.Push (Big_Red_Button'Access);
+    TCTouch.Validate("SPE", "After set to Emergency value");
+    TCTouch.Assert( C3A0005_0.Emergency_Call, "Emergency Call");
+ 
+    Report.Result;
+ 
+ end C3A0005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- C3A0006.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that access to subprogram may be stored within data 
+ --      structures, and that the access to subprogram can subsequently 
+ --      be called. 
+ -- 
+ -- TEST DESCRIPTION:
+ --      Declare an access to function type in a package specification.  
+ --      Declare an array of the access type.  Declare three different 
+ --      functions that can be referred to by the access to function type.  
+ --      
+ --      In the main program, declare a key function that builds the array 
+ --      by calling each function indirectly through the access value.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package C3A0006_0 is
+ 
+    TC_Sine_Call  : Integer := 0;
+    TC_Cos_Call   : Integer := 0;
+    TC_Tan_Call   : Integer := 0;
+ 
+    Sine_Value    : Float :=  4.0;
+    Cos_Value     : Float :=  8.0;
+    Tan_Value     : Float := 10.0;
+ 
+    -- Type accesses to any function
+    type Trig_Function_Ptr is access function        
+       (Angle : in Float) return Float;
+ 
+    function Sine (Angle : in Float) return Float;         
+ 
+    function Cos  (Angle : in Float) return Float;        
+ 
+    function Tan  (Angle : in Float) return Float;         
+ 
+ end C3A0006_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body C3A0006_0 is
+ 
+    function Sine (Angle : in Float) return Float is
+    begin
+      TC_Sine_Call := TC_Sine_Call + 1;
+      Sine_Value := Sine_Value + Angle;
+      return Sine_Value;
+    end Sine;
+ 
+ 
+    function Cos  (Angle: in Float) return Float is
+    begin
+      TC_Cos_Call := TC_Cos_Call + 1;
+      Cos_Value := Cos_Value - Angle;
+      return Cos_Value;
+    end Cos;
+ 
+ 
+    function Tan (Angle : in Float) return Float is
+    begin
+      TC_Tan_Call := TC_Tan_Call + 1;
+      Tan_Value := (Tan_Value + (Tan_Value * Angle));
+      return Tan_Value;
+    end Tan;
+ 
+ 
+ end C3A0006_0;
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ with Report;
+ 
+ with C3A0006_0; 
+ 
+ procedure C3A0006 is
+ 
+    Trig_Value, Theta  : Float := 0.0;
+ 
+    Total_Routines     : constant := 3;
+ 
+    Sine_Total         : constant := 7.0;
+    Cos_Total          : constant := 5.0;
+    Tan_Total          : constant := 75.0;
+ 
+    Trig_Table : array (1 .. Total_Routines) of C3A0006_0.Trig_Function_Ptr;
+ 
+ 
+    -- Key function to build the table
+    function Call_Trig_Func (Func : C3A0006_0.Trig_Function_Ptr;
+                             Operand : Float) return Float is 
+    begin
+       return (Func(Operand));
+    end Call_Trig_Func;
+ 
+ 
+ begin
+ 
+    Report.Test ("C3A0006", "Check that access to subprogram may be " &
+                 "stored within data structures, and that the access " &
+                 "to subprogram can subsequently be called");
+ 
+    Trig_Table := (C3A0006_0.Sine'Access, C3A0006_0.Cos'Access, 
+                   C3A0006_0.Tan'Access);
+ 
+    -- increase the value of Theta to build the table
+    for I in 1 .. Total_Routines loop
+       Theta := Theta + 0.5;
+       for J in 1 .. Total_Routines loop
+          Trig_Value     := Call_Trig_Func (Trig_Table(J), Theta);
+       end loop;
+    end loop;
+ 
+    if C3A0006_0.TC_Sine_Call /= Total_Routines 
+      or C3A0006_0.TC_Cos_Call /= Total_Routines
+      or C3A0006_0.TC_Tan_Call /= Total_Routines then
+         Report.Failed ("Incorrect subprograms result");
+    end if;
+ 
+    if C3A0006_0.Sine_Value /= Sine_Total
+      or C3A0006_0.Cos_Value /= Cos_Total
+      or C3A0006_0.Tan_Value /= Tan_Total then
+         Report.Failed ("Incorrect values returned from subprograms");
+    end if;
+ 
+    if Trig_Value /= Tan_Total then
+         Report.Failed ("Incorrect call order.");
+    end if;
+ 
+    Report.Result;
+ 
+ end C3A0006;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,234 ----
+ -- C3A0007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a call to a subprogram via an access-to-subprogram value
+ --      stored in a data structure will correctly dispatch according to the
+ --      tag of the class-wide parameter passed via that call.
+ -- 
+ -- TEST DESCRIPTION:
+ --      Declare an access to procedure type in a package specification. 
+ --      Declare a root tagged type with the access to procedure type as a 
+ --      component.  Declare three primitive procedures for the type that 
+ --      can be referred to by the access to procedure type.  Use the access 
+ --      to procedure type to initialize the component of a record.
+ --
+ --      Extend the root type with a record extension in another package
+ --      specification. Declare a new primitive procedure for the extension
+ --      (in addition to its three inherited subprograms).
+ --
+ --      In the main program, declare an operation for the root tagged type 
+ --      which can be passed as an access value to change the initial value
+ --      of the component.  Call the inherited operation indirectly by 
+ --      dereferencing the access value to check on the initial value of the 
+ --      extension.  Call inherited operations indirectly by dereferencing 
+ --      the access value to replace the initial value.  Call the primitive 
+ --      procedure indirectly by dereferencing the access value to modify the 
+ --      extension.
+ --
+ --          type Button
+ --            procedure Push(Button)
+ --            procedure Set_Response(Button,Button_Response_Ptr)
+ --            procedure Default_Response(Button)
+ --
+ --          type Priority_Button (new Button)
+ --            procedures Push, Set_Response inherited
+ --            procedure Default_Response
+ --            procedure Set_Priority
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C3A0007_0 is
+ 
+    Default_Call   : Boolean := False;
+ 
+    type Button is tagged private;
+ 
+    type Button_Response_Ptr is access procedure
+       (B : in out Button'Class);
+ 
+    procedure Push (B : in out Button);               -- to be inherited
+ 
+    procedure Set_Response (B : in out Button;        -- to be inherited
+                            R : in Button_Response_Ptr);
+ 
+    procedure Response  (B : in out Button);          -- to be inherited
+ 
+ private
+    procedure Default_Response(B: in out Button'Class);
+    type Button is tagged                             -- root tagged type
+       record
+          Action :  Button_Response_Ptr 
+                   := Default_Response'Access;   
+       end record;
+ end C3A0007_0;
+ 
+ with C3A0007_0;
+ package C3A0007_1 is
+ 
+    type Priority_Button is new C3A0007_0.Button
+      with record
+         Priority : Integer := 0;
+       end record;
+ 
+    -- Inherits procedure Push from Button
+    -- Inherits procedure Set_Response from Button
+ 
+    -- Override procedure Response from Button
+    procedure Response (B : in out Priority_Button);
+ 
+    -- Primitive operation of the extension
+    procedure Set_Priority (B : in out Priority_Button);
+ 
+ end C3A0007_1;
+ 
+ with C3A0007_0;
+ package C3A0007_2 is
+ 
+    Emergency_Call : Boolean := False;
+ 
+    procedure Emergency (B : in out C3A0007_0.Button'Class);
+ end C3A0007_2;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with TCTouch;
+ package body C3A0007_0 is
+ 
+    procedure Push (B : in out Button) is
+    begin
+       TCTouch.Touch( 'P' ); --------------------------------------------- P
+       -- Invoking subprogram designated by access value
+       B.Action (B);
+    end Push;
+ 
+ 
+    procedure Set_Response (B : in out Button;
+                            R : in     Button_Response_Ptr) is
+    begin
+       TCTouch.Touch( 'S' ); --------------------------------------------- S
+       -- Set procedure value in record
+       B.Action := R;
+    end Set_Response;
+ 
+ 
+    procedure Response (B : in out Button) is
+    begin
+       TCTouch.Touch( 'D' ); --------------------------------------------- D
+       Default_Call := True;
+    end Response;
+ 
+    procedure Default_Response (B : in out Button'Class) is
+    begin
+       TCTouch.Touch( 'C' ); --------------------------------------------- C
+       Response(B);
+    end Default_Response;
+ 
+ end C3A0007_0;
+ 
+ with TCTouch;
+ package body C3A0007_1 is
+ 
+    procedure Set_Priority (B : in out Priority_Button) is
+    begin
+       TCTouch.Touch( 's' ); --------------------------------------------- s
+       B.Priority := 1;
+    end Set_Priority;
+ 
+    procedure Response (B : in out Priority_Button) is
+    begin
+       TCTouch.Touch( 'd' ); --------------------------------------------- d
+    end Response;
+ 
+ end C3A0007_1;
+ 
+ with TCTouch;
+ package body C3A0007_2 is
+    procedure Emergency (B : in out C3A0007_0.Button'Class) is
+       begin
+         TCTouch.Touch( 'E' ); ------------------------------------------- E
+         Emergency_Call := True;
+       end Emergency;
+ end C3A0007_2;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with Report;
+ with TCTouch;
+ 
+ with C3A0007_0; 
+ with C3A0007_1; 
+ with C3A0007_2;
+ procedure C3A0007 is
+ 
+    Pink_Button  : C3A0007_0.Button;
+    Green_Button : C3A0007_1.Priority_Button;
+ 
+ begin
+ 
+    Report.Test ("C3A0007", "Check that a call to a subprogram via an "
+                          & "access-to-subprogram value stored in a data "
+                          & "structure will correctly dispatch according to "
+                          & "the tag of the class-wide parameter passed "
+                          & "via that call" );
+ 
+    -- Call inherited operation Push to set Default_Response value 
+    -- in the extension.
+ 
+    C3A0007_1.Push (Green_Button);
+    TCTouch.Validate("PCd", "First Green Button Push");
+ 
+    TCTouch.Assert_Not(C3A0007_0.Default_Call,
+                          "Incorrect Green Default_Response");
+ 
+    C3A0007_0.Push (Pink_Button);
+    TCTouch.Validate("PCD", "First Pink Button Push");
+ 
+    -- Call inherited operations Set_Response and Push to set 
+    -- Emergency value in the extension.
+    C3A0007_1.Set_Response (Green_Button, C3A0007_2.Emergency'Access);  
+    C3A0007_1.Push (Green_Button);
+    TCTouch.Validate("SPE", "Second Green Button Push");
+ 
+    TCTouch.Assert(C3A0007_2.Emergency_Call, "Incorrect Green Emergency");
+ 
+    C3A0007_0.Set_Response (Pink_Button, C3A0007_2.Emergency'Access);  
+    C3A0007_0.Push (Pink_Button);
+    TCTouch.Validate("SPE", "Second Pink Button Push");
+ 
+    -- Call primitive operation to set priority value 
+    -- in the extension.
+    C3A0007_1.Set_Priority (Green_Button);
+    TCTouch.Validate("s", "Green Button Priority");
+ 
+    TCTouch.Assert(Green_Button.Priority = 1, "Incorrect Set_Priority");
+ 
+    Report.Result;
+ 
+ end C3A0007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0008.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0008.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0008.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,150 ----
+ -- C3A0008.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that subprogram references may be passed as parameters using 
+ --      access-to-subprogram types. Check that the passed subprograms may 
+ --      be invoked from within the called subprogram.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an access to function type in a package specification.  
+ --      Declare three different trig functions that can be referred to by 
+ --      the access to function type.  
+ --
+ --      In the main program, call each function indirectly by passing the 
+ --      access to subprogram value as parameter.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package Integrate_Lookup is
+ 
+   TC_Log_Call  : Boolean := False;
+ 
+   TC_Cos_Call  : Boolean := False;
+ 
+   TC_Sine_Call : Boolean := False;
+ 
+   -- Type accesses to functions Log, Sine, or Cos
+   type Integrand_Ptr is access function        
+      (Angle : Float) return Float;
+ 
+   function Log  (Angle : in Float) return Float;        
+ 
+   function Sine (Angle : in Float) return Float;         
+ 
+   function Cos  (Angle : in Float) return Float;        
+ 
+   function Integrate  (Func : Integrand_Ptr; From, To: Float) 
+     return Float;
+ 
+ end Integrate_Lookup;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body Integrate_Lookup is
+ 
+ 
+   function Log (Angle : in Float) return Float is
+   begin
+      TC_Log_Call := True;
+      return 0.1;
+   end Log;
+ 
+ 
+   function Sine (Angle : in Float) return Float is
+   begin
+      TC_Sine_Call := True;
+      return 0.0;
+   end Sine;
+ 
+ 
+   function Cos  (Angle : in Float) return Float is
+   begin
+      TC_Cos_Call := True;
+      return 1.0;
+   end Cos;
+ 
+ 
+   function Integrate (Func : Integrand_Ptr; From, To: Float) 
+     return Float is
+      Theta : Float;
+   begin
+      -- calls the actual subprogram passed as parameter
+      Theta := Func (From) + Func (To);
+      return Theta;
+   end Integrate;
+ 
+ end Integrate_Lookup;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ with Report;
+ 
+ with Integrate_Lookup; 
+ 
+ procedure C3A0008 is
+ 
+   Area : Float := 0.0;
+ 
+ begin
+ 
+   Report.Test ("C3A0008", "Check that subprogram references may be passed "
+                         & "as parameters using access-to-subprogram types. " 
+                        & "Check that the passed subprograms may be invoked "
+                         & "from within the called subprogram");
+ 
+   Area := Integrate_Lookup.Integrate
+             (Integrate_Lookup.Log'Access, 1.0, 2.0);
+ 
+   If not Integrate_Lookup.TC_Log_Call or Area /= 0.2 then
+      Report.Failed ("Incorrect Log result");
+   end if;
+ 
+   Area := Integrate_Lookup.Integrate
+             (Integrate_Lookup.Sine'Access, 1.0, 2.0);
+ 
+   If not Integrate_Lookup.TC_Sine_Call or Area /= 0.0 then
+      Report.Failed ("Incorrect Sine result");
+   end if;
+ 
+   Area := Integrate_Lookup.Integrate
+             (Integrate_Lookup.Cos'Access, 1.0, 2.0);
+ 
+   If not Integrate_Lookup.TC_Cos_Call or Area /= 2.0 then
+      Report.Failed ("Incorrect Cos result");
+   end if;
+ 
+   Report.Result;
+ 
+ end C3A0008;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0009.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0009.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0009.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,219 ----
+ -- C3A0009.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that subprogram references may be passed as parameters using 
+ --      access-to-subprogram types. Check that the passed subprograms may 
+ --      be invoked from within the called subprogram.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an access to procedure type in a package specification. 
+ --      Declare a root tagged type with the access to procedure type as a 
+ --      component.  Declare three primitive procedures for the type that 
+ --      can be referred to by the access to procedure type.  Use the access 
+ --      to procedure type to initialize the component of a record.
+ --
+ --      Extend the root type with a private extension in the same package
+ --      specification. Declare two new primitive subprograms for the extension
+ --      (in addition to its three inherited subprograms).
+ --
+ --      In the main program, declare an operation for the root tagged type 
+ --      which can be passed as an access value to change the initial value
+ --      of the component.  Call the inherited operations indirectly by 
+ --      de-referencing the access value to set value in the extension.
+ --      Call the primitive function to modify the extension by passing 
+ --      the access value designating the primitive procedure as a parameter.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C3A0009_0 is -- Push_Buttons
+ 
+    type Button is tagged private;
+ 
+    -- Type accesses to procedures Push and Default_Response
+    type Button_Response_Ptr is access procedure
+       (B : in out Button);
+ 
+    procedure Push (B : in out Button);               -- to be inherited
+ 
+    procedure Set_Response (B : in out Button;        -- to be inherited
+                            R : in Button_Response_Ptr);
+ 
+    procedure Default_Response  (B : in out Button);  -- to be inherited
+ 
+    type Alert_Button is new Button with private;  -- private extension of
+                                                   -- root tagged type
+    -- Inherits procedure Push from Button
+    -- Inherits procedure Set_Response from Button
+    -- Inherits procedure Default_Response from Button
+ 
+    procedure Replace_Action( B: in out Alert_Button );
+ 
+    -- type accesses to procedure Default_Action
+    type Button_Action_Ptr is access procedure;
+ 
+    -- The following function is needed to set value in the
+    -- extension's private component.
+    function Alert (B : in Alert_Button) return Button_Action_Ptr;
+ 
+ private
+ 
+    type Button is tagged                             -- root tagged type
+       record
+          Response :  Button_Response_Ptr 
+                   := Default_Response'Access;   
+       end record;
+ 
+    procedure Default_Action;
+ 
+    type Alert_Button is new Button with record
+         Action :  Button_Action_Ptr 
+                := Default_Action'Access;
+       end record;
+ 
+ end C3A0009_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ with TCTouch;
+ package body C3A0009_0 is
+ 
+    procedure Push (B : in out Button) is
+    begin
+       TCTouch.Touch( 'P' ); --------------------------------------------- P
+       -- Invoking subprogram designated by access value
+       B.Response (B);
+    end Push;
+ 
+ 
+    procedure Set_Response (B : in out Button;
+                            R : in     Button_Response_Ptr) is
+    begin
+       TCTouch.Touch( 'S' ); --------------------------------------------- S
+       -- Set procedure value in record
+       B.Response := R;
+    end Set_Response;
+ 
+ 
+    procedure Default_Response (B : in out Button) is
+    begin
+       TCTouch.Touch( 'D' ); --------------------------------------------- D
+    end Default_Response;
+ 
+ 
+    procedure Default_Action is
+    begin
+       TCTouch.Touch( 'd' ); --------------------------------------------- d
+    end Default_Action;
+ 
+    procedure Replacement_Action is
+    begin
+       TCTouch.Touch( 'r' ); --------------------------------------------- r
+    end Replacement_Action;
+ 
+    procedure Replace_Action( B: in out Alert_Button ) is
+    begin
+       TCTouch.Touch( 'R' ); --------------------------------------------- R
+       B.Action := Replacement_Action'Access;
+    end Replace_Action;
+ 
+    function Alert (B : in Alert_Button) return Button_Action_Ptr is
+    begin
+       TCTouch.Touch( 'A' ); --------------------------------------------- A
+       return (B.Action);
+    end Alert;
+ 
+ end C3A0009_0;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with C3A0009_0;
+ package C3A0009_1 is -- Emergency_Items
+    package Push_Buttons renames C3A0009_0;
+ 
+    procedure Emergency (B : in out Push_Buttons.Button);
+ end C3A0009_1;
+ 
+ with TCTouch;
+ package body C3A0009_1 is -- Emergency_Items
+    procedure Emergency (B : in out Push_Buttons.Button) is
+       begin
+         TCTouch.Touch( 'E' ); ------------------------------------------- E
+       end Emergency;
+ end C3A0009_1;
+ -----------------------------------------------------------------------------
+ 
+ with Report;
+ 
+ with C3A0009_0, C3A0009_1; 
+ with TCTouch;
+ procedure C3A0009 is
+ 
+    package Push_Buttons    renames C3A0009_0;
+    package Emergency_Items renames C3A0009_1;
+       
+    Black_Button : Push_Buttons.Alert_Button;
+    Alert_Ptr    : Push_Buttons.Button_Action_Ptr;
+ 
+ begin
+ 
+    Report.Test ("C3A0009", "Check that subprogram references may be passed "
+                          & "as parameters using access-to-subprogram types. "
+                          & "Check that the passed subprograms may be "
+                          & "invoked from within the called subprogram");
+ 
+ 
+    Push_Buttons.Push( Black_Button );
+    Push_Buttons.Alert( Black_Button ).all;
+ 
+    TCTouch.Validate( "PDAd", "Default operation set" );
+ 
+    -- Call inherited operations Set_Response and Push to set 
+    -- Emergency value in the extension.
+    Push_Buttons.Set_Response (Black_Button, Emergency_Items.Emergency'Access);
+  
+ 
+    Push_Buttons.Push( Black_Button );
+    Push_Buttons.Alert( Black_Button ).all;
+ 
+    TCTouch.Validate( "SPEAd", "Altered Response set" );
+ 
+    -- Call primitive operation to set action value in the extension.
+    Push_Buttons.Replace_Action( Black_Button );
+ 
+ 
+    Push_Buttons.Push( Black_Button );
+    Push_Buttons.Alert( Black_Button ).all;
+ 
+    TCTouch.Validate( "RPEAr", "Altered Action set" );
+ 
+    Report.Result;
+ end C3A0009;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C3A0010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an access-to-subprogram type in a generic instance may be
+ --      used to declare access-to-subprogram objects which invoke subprograms
+ --      in the instance.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a numeric type in the visible part of a generic package.
+ --      Declare two different math procedures that can be referred to by 
+ --      the access to procedure type.  
+ --
+ --      In the main program, instantiate the generic.  Declare an access 
+ --      to procedure type.  Call each procedure indirectly by dereferencing 
+ --      the access value.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      05 APR 96   SAIC    Header correction for 2.1
+ --
+ --!
+ 
+ generic
+    type Real_Num is digits <>;
+ 
+ package C3A0010_0 is
+ 
+    -- Type accesses to any math procedure
+    type Math_Procedure_Ptr is access procedure   
+        (First_Num, Second_Num : in  Real_Num;
+         Result_Num            : out Real_Num);
+ 
+    procedure Add      (First_Num, Second_Num : in  Real_Num;
+                        Result_Num            : out Real_Num);
+ 
+    procedure Subtract (First_Num, Second_Num : in  Real_Num;
+                        Result_Num            : out Real_Num);
+ 
+ end C3A0010_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body C3A0010_0 is
+ 
+    procedure Add (First_Num, Second_Num : in  Real_Num;
+                   Result_Num            : out Real_Num) is
+    begin
+       Result_Num := First_Num + Second_Num;
+    end Add;
+ 
+ 
+    procedure Subtract (First_Num, Second_Num : in  Real_Num;
+                        Result_Num            : out Real_Num) is
+    begin
+       Result_Num := First_Num - Second_Num;
+    end Subtract;
+ 
+ end C3A0010_0;
+ 
+ -----------------------------------------------------------------------------
+ 
+ with Report;
+ with C3A0010_0; 
+ 
+ procedure C3A0010 is
+ 
+    type Real is digits 2;
+ 
+    subtype Math_Float is Real range -10.0 .. 10.0;
+ 
+    package Math_Pk is new C3A0010_0 (Real_Num => Math_Float);
+ 
+    Math_Access : Math_Pk.Math_Procedure_Ptr;
+ 
+    Total_Num   : Math_Float := 0.0;
+    First_Num   : Math_Float := 1.0;
+    Second_Num  : Math_Float := 2.0;
+ 
+    procedure Max( A_Num, B_Num: in Math_Float; Result : out Math_Float ) is
+    begin
+       if A_Num > B_Num then
+         Result := A_Num;
+       else
+         Result := B_Num;
+       end if;
+    end Max;
+ 
+    procedure Due_Process( Process: Math_Pk.Math_Procedure_Ptr ) is
+    begin
+      Process(First_Num, Second_Num, Total_Num);
+    end Due_Process;
+ 
+ begin
+ 
+    Report.Test ("C3A0010", "Check that an access-to-subprogram type in a "
+                          & "generic instance may be used to declare "
+                          & "access-to-subprogram objects which invoke "
+                          & "subprograms in the instance");
+ 
+ -- Check for correct defaulting
+    if Math_Pk."/="( Math_Access, null) then
+      Report.Failed("subprogram access type object not initialized to null");
+    end if;
+ 
+    Math_Access := Math_Pk.Add'Access;
+ 
+    -- Invoking Add procedure designated by access value
+    Due_Process( Math_Access );
+ 
+    If Total_Num /= 3.0 then
+       Report.Failed ("Incorrect Add result");
+    end if;
+ 
+    Math_Access := Math_Pk.Subtract'Access;
+ 
+    Due_Process( Math_Access );
+ 
+    If Total_Num /= -1.0 then
+       Report.Failed ("Incorrect Subtract result");
+    end if;
+ 
+    Math_Access := Max'Access;
+ 
+    Due_Process( Math_Access );
+ 
+    If Total_Num /= 2.0 then
+       Report.Failed ("Incorrect Max result");
+    end if;
+ 
+    Report.Result;
+ 
+ end C3A0010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- C3A0011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that an access-to-subprogram object whose type is declared in a
+ --      parent package, may be used to invoke subprograms in a child package.
+ --      Check that such access objects may be stored in a data structure and
+ --      that subprograms may be called by walking the data structure.
+ -- 
+ -- TEST DESCRIPTION:
+ --      In the package, declare an access to procedure type.  Declare an 
+ --      array of the access type.  Declare three different procedures that 
+ --      can be referred to by the access to procedure type.           
+ --
+ --      In the visible child package, declare two procedures that can be 
+ --      referred to by the access to procedure type of the parent.  Build 
+ --      the array by calling each procedure indirectly through the access 
+ --      value.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Dec 94   SAIC    Improved visibility of "/=" in main body
+ --
+ --!
+ 
+ package C3A0011_0 is -- Interpreter
+    
+    type Compass_Point is mod 360;
+ 
+    function Heading return Compass_Point;
+ 
+    -- Type accesses to any procedure
+    type Action_Ptr is access procedure;
+    
+    -- Array of access to procedure
+    type Action_Array is array (Natural range <>) of Action_Ptr;
+ 
+    procedure Rotate_Left;
+ 
+    procedure Rotate_Right;
+ 
+    procedure Center;
+ 
+ private
+    The_Heading : Compass_Point := Compass_Point'First;
+ 
+ end C3A0011_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body C3A0011_0 is
+ 
+    function Heading return Compass_Point is
+    begin
+      return The_Heading;
+    end Heading;
+ 
+    procedure Rotate_Left is
+    begin
+       The_Heading := The_Heading - 90;
+    end Rotate_Left;
+ 
+ 
+    procedure Rotate_Right is
+    begin
+       The_Heading := The_Heading + 90;
+    end Rotate_Right;
+ 
+ 
+    procedure Center is
+    begin
+       The_Heading := 0;
+    end Center;
+ 
+ end C3A0011_0;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package C3A0011_0.Action is
+ 
+    procedure Rotate_Front;
+ 
+    procedure Rotate_Back;
+ 
+ end C3A0011_0.Action;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ package body C3A0011_0.Action is
+ 
+    procedure Rotate_Front is
+    begin
+       The_Heading := The_Heading + 5;
+    end Rotate_Front;
+ 
+ 
+    procedure Rotate_Back is
+    begin
+       The_Heading := The_Heading - 5;
+    end Rotate_Back;
+ 
+ end C3A0011_0.Action;
+ 
+ 
+ -----------------------------------------------------------------------------
+ 
+ 
+ with C3A0011_0.Action;
+ 
+ with Report;
+ 
+ procedure C3A0011 is
+ 
+    Total_Actions   : constant := 6;
+ 
+    Action_Sequence : C3A0011_0.Action_Array (1 .. Total_Actions);
+ 
+    type Result_Array is array (Natural range <>) of C3A0011_0.Compass_Point;
+ 
+    Action_Results  : Result_Array(1 .. Total_Actions);
+ 
+    package IA renames C3A0011_0.Action;
+    
+ begin
+ 
+    Report.Test ("C3A0011", "Check that an access-to-subprogram object whose "
+                          & "type is declared in a parent package, may be "
+                          & "used to invoke subprograms in a child package. "
+                          & "Check that such access objects may be stored in "
+                          & "a data structure and that subprograms may be "
+                          & "called by walking the data structure");
+ 
+    -- Build the action sequence
+    Action_Sequence := (C3A0011_0.Rotate_Left'Access, 
+                        C3A0011_0.Center'Access,
+                        C3A0011_0.Rotate_Right'Access, 
+                        IA.Rotate_Front'Access,
+                        C3A0011_0.Center'Access,
+                        IA.Rotate_Back'Access);
+ 
+    -- Build the expected result
+    Action_Results := ( 270, 0, 90, 95, 0, 355 );
+ 
+    -- Assign actions by invoking subprogram designated by access value
+    for I in Action_Sequence'Range loop
+       Action_Sequence(I).all;
+       if C3A0011_0."/="( C3A0011_0.Heading, Action_Results(I) ) then
+         Report.Failed ("Expecting "
+                        & C3A0011_0.Compass_Point'Image(Action_Results(I))
+                        & " Got"
+                        & C3A0011_0.Compass_Point'Image(C3A0011_0.Heading));
+       end if;
+    end loop;
+ 
+    Report.Result;
+ 
+ end C3A0011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a00120.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a00120.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a00120.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a00120.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C3A00120.A
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- OBJECTIVE:
+  --      See file C3A00122.AM
+  --
+  -- TEST DESCRIPTION:
+  --      See file C3A00122.AM
+  -- 
+  -- TEST FILES:
+  --      The following files comprise this test:
+  --
+  --      => C3A00120.A
+  --         C3A00121.A
+  --         C3A00122.AM
+  --
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  package C3A0012_0 is
+  
+        type Call_Kind is (No_Call_Made, Fast_Call, Accurate_Call, 
+                           Table_Lookup_Call);
+  
+        Log_Result : Float := 0.0;
+  
+        -- Type accesses to any log procedure
+        type Log_Procedure_Ptr is access procedure   
+           (Angle : in Float; Log_Call : out Call_Kind);
+  
+        procedure Log_Calc_Fast  (Angle      : in  Float; 
+                                  Method     : out Call_Kind);
+  
+        procedure Log_Calc_Acc   (Angle      : in  Float;
+                                  Method     : out Call_Kind);
+  
+        procedure Log_Calc_Table (Angle      : in  Float; 
+                                  Method     : out Call_Kind);
+  
+  end C3A0012_0;
+  
+  
+  --=======================================================================--
+  
+  
+  package body C3A0012_0 is
+  
+     procedure Log_Calc_Fast  (Angle      : in  Float; 
+                               Method     : out Call_Kind) is separate;
+  
+     procedure Log_Calc_Acc   (Angle      : in  Float; 
+                               Method     : out Call_Kind) is separate;
+  
+     procedure Log_Calc_Table (Angle      : in  Float; 
+                               Method     : out Call_Kind) is separate;
+  
+  end C3A0012_0;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a00121.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a00121.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a00121.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a00121.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,76 ----
+ -- C3A00121.A
+  --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+  --
+  -- OBJECTIVE:
+  --      See file C3A00122.AM
+  --
+  -- TEST DESCRIPTION:
+  --      See file C3A00122.AM
+  -- 
+  -- TEST FILES:
+  --      The following files comprise this test:
+  --
+  --         C3A00120.A
+  --      => C3A00121.A
+  --         C3A00122.AM
+  --
+  --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+  --!
+  
+  Separate (C3A0012_0)
+  procedure Log_Calc_Fast (Angle     : in  Float;
+                           Method    : out Call_Kind) is
+  begin
+     C3A0012_0.Log_Result := Angle;
+     Method := Fast_Call;
+  end Log_Calc_Fast;
+  
+  
+  --=======================================================================--
+  
+  
+  Separate (C3A0012_0)
+  procedure Log_Calc_Acc (Angle    : in  Float;
+                          Method   : out Call_Kind) is
+  begin
+     C3A0012_0.Log_Result := Angle;
+     Method := Accurate_Call;
+  end Log_Calc_Acc;
+  
+  
+  --=======================================================================--
+  
+  
+  Separate (C3A0012_0)
+  procedure Log_Calc_Table (Angle      : in  Float;
+                            Method     : out Call_Kind) is
+  begin
+     C3A0012_0.Log_Result := Angle;
+     Method := Table_Lookup_Call;
+  end Log_Calc_Table;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a00122.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a00122.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a00122.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a00122.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C3A00122.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an access-to-subprogram object can be used to invoke a
+ --      subprogram when the subprogram body had been declared and implemented
+ --      as a subunit.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an access to procedure type in a main program.  Declare 
+ --      three different log subprogram body stubs that can be referred to by 
+ --      the access to procedure type.
+ --
+ --      Complete bodies of the log procedures.
+ --
+ --      In the main program, each procedure will be called indirectly by 
+ --      dereferencing the access value.
+ -- 
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         C3A00120.A
+ --         C3A00121.A
+ --      => C3A00122.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+  
+  with Report;
+  
+  with C3A0012_0; 
+  
+  procedure C3A00122 is
+  
+     function "="( A,B: C3A0012_0.Call_Kind ) return Boolean
+              renames C3A0012_0."=";
+  
+     Log_Access  : C3A0012_0.Log_Procedure_Ptr;
+     Theta       : Float := 0.0;
+     Method      : C3A0012_0.Call_Kind := C3A0012_0.No_Call_Made;
+  
+  
+  
+    function Due_Process( LA: C3A0012_0.Log_Procedure_Ptr )
+             return C3A0012_0.Call_Kind is
+      Result : C3A0012_0.Call_Kind := C3A0012_0.No_Call_Made;
+    begin
+      LA( Theta, Result );
+      return Result;
+    end Due_Process;
+  
+  begin
+  
+     Report.Test ("C3A0012", "Check that an access to a subprogram object " &
+                  "can be used to select and invoke an operation with " &
+                  "appropriate arguments");
+  
+     Log_Access := C3A0012_0.Log_Calc_Fast'Access;
+  
+     -- Invoking Log procedure designated by access value
+     Method := Due_Process( Log_Access );
+  
+     If Method /= C3A0012_0.Fast_Call then
+        Report.Failed ("Incorrect Log_Calc_Fast result");
+     end if;
+  
+     Log_Access := C3A0012_0.Log_Calc_Acc'Access;
+  
+     -- Invoking Log procedure designated by access value
+     Method := Due_Process( Log_Access );
+  
+     If Method /= C3A0012_0.Accurate_Call then
+        Report.Failed ("Incorrect Log_Calc_Acc result");
+     end if;
+  
+     Log_Access := C3A0012_0.Log_Calc_Table'Access;
+  
+     -- Invoking Log procedure designated by access value
+     Method := Due_Process( Log_Access );
+  
+     If Method /= C3A0012_0.Table_Lookup_Call then
+        Report.Failed ("Incorrect Log_Calc_Table result");
+     end if;
+  
+     Report.Result;
+  
+  end C3A00122;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,347 ----
+ -- C3A0013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a general access type object may reference allocated
+ --      pool objects as well as aliased objects. (3,4)
+ --      Check that formal parameters of tagged types are implicitly
+ --      defined as aliased; check that the 'Access of these formal
+ --      parameters designates the correct object with the correct
+ --      tag. (5)
+ --      Check that the current instance of a limited type is defined as
+ --      aliased. (5)
+ --
+ -- TEST DESCRIPTION:
+ --      This test takes from the hierarchy defined in C390003; making
+ --      the root type Vehicle limited private.  It also shifts the
+ --      abstraction to include the notion of a transmission, an object
+ --      which is contained within any vehicle.  Using an access
+ --      discriminant, any subprogram which operates on a transmission
+ --      may also reference the vehicle in which it is installed.
+ --
+ --      Class Hierarchy:
+ --              Vehicle         Transmission
+ --               /   \
+ --           Truck    Car
+ --
+ --      Contains:
+ --                Vehicle( Transmission )
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Dec 94   SAIC    Fixed accessibility problems
+ --
+ --!
+ 
+ package C3A0013_1 is
+   type Vehicle is tagged limited private;
+   type Vehicle_ID is access all Vehicle'Class;
+ 
+   -- Constructors
+   procedure Create     ( It : in out Vehicle; 
+                          Wheels : Natural := 4 );
+   -- Modifiers
+   procedure Accelerate ( It : in out Vehicle );
+   procedure Decelerate ( It : in out Vehicle );
+   procedure Up_Shift   ( It : in out Vehicle );
+   procedure Stop       ( It : in out Vehicle );
+ 
+   -- Selectors
+   function  Speed      ( It : Vehicle ) return Natural;
+   function  Wheels     ( It : Vehicle ) return Natural;
+   function  Gear_Factor( It : Vehicle ) return Natural;
+ 
+   -- TC_Ops
+   procedure TC_Validate( It : in out Vehicle; Speed_Trap : Natural );
+ 
+   -- dispatching procedure used to check tag correctness
+   procedure TC_Validate( It     : Vehicle;
+                          TC_ID  : Character);
+ 
+ private
+ 
+   type Transmission(Within: access Vehicle'Class) is limited record
+     Engaged : Boolean := False;
+     Gear    : Integer range -1..5 := 0;
+   end record;
+ 
+   -- Current instance of a limited type is defined as aliased
+ 
+   type Vehicle is tagged limited record
+     Wheels: Natural;
+     Speed : Natural;
+     Power_Train: Transmission( Vehicle'Access );
+   end record;
+ end C3A0013_1;
+ 
+ with C3A0013_1;
+ package C3A0013_2 is
+   type Car is new C3A0013_1.Vehicle with private;
+   procedure TC_Validate( It     : Car;
+                          TC_ID  : Character);
+   function  Gear_Factor( It : Car ) return Natural;
+ private
+   type Car is new C3A0013_1.Vehicle with record
+     Displacement : Natural;
+   end record;
+ end C3A0013_2;
+ 
+ with C3A0013_1;
+ package C3A0013_3 is
+   type Truck is new C3A0013_1.Vehicle with private;
+   procedure TC_Validate( It     : Truck;
+                          TC_ID  : Character);
+   function  Gear_Factor( It : Truck ) return Natural;
+ private
+   type Truck is new C3A0013_1.Vehicle with record
+     Displacement : Natural;
+   end record;
+ end C3A0013_3;
+ 
+ with Report;
+ package body C3A0013_1 is
+ 
+   procedure Create    ( It : in out Vehicle; 
+                         Wheels : Natural := 4 ) is
+   begin
+     It.Wheels   := Wheels;
+     It.Speed    := 0;
+   end Create;
+ 
+   procedure Accelerate( It : in out Vehicle ) is
+   begin
+     It.Speed := It.Speed + Gear_Factor( It.Power_Train.Within.all );
+   end Accelerate;
+ 
+   procedure Decelerate( It : in out Vehicle ) is
+   begin
+     It.Speed := It.Speed - Gear_Factor( It.Power_Train.Within.all );
+   end Decelerate;
+ 
+   procedure Stop      ( It : in out Vehicle ) is
+   begin
+     It.Speed := 0;
+     It.Power_Train.Engaged := False;
+   end Stop;
+ 
+   function  Gear_Factor( It : Vehicle ) return Natural is
+   begin
+     return It.Power_Train.Gear;
+   end Gear_Factor;
+ 
+   function  Speed     ( It : Vehicle ) return Natural is
+   begin
+     return It.Speed;
+   end Speed;
+ 
+   function  Wheels     ( It : Vehicle ) return Natural is
+   begin
+     return It.Wheels;
+   end Wheels;
+ 
+   -- formal tagged parameters are implicitly aliased
+ 
+   procedure TC_Validate( It : in out Vehicle; Speed_Trap : Natural ) is
+     License: Vehicle_ID := It'Unchecked_Access;
+   begin
+     if Speed( License.all ) /= Speed_Trap then
+       Report.Failed("Speed Trap: expected: " & Natural'Image(Speed_Trap));
+     end if;
+   end TC_Validate;
+ 
+   procedure TC_Validate( It     : Vehicle;
+                          TC_ID  : Character) is
+   begin
+     if TC_ID /= 'V' then
+       Report.Failed("Dispatched to Vehicle");
+     end if;
+     if Wheels( It ) /= 1 then
+       Report.Failed("Not a Vehicle");
+     end if;
+   end TC_Validate;
+ 
+   procedure Up_Shift( It: in out Vehicle ) is
+   begin
+     It.Power_Train.Gear    := It.Power_Train.Gear +1;
+     It.Power_Train.Engaged := True;
+     Accelerate( It );
+   end Up_Shift;
+ end C3A0013_1;
+ 
+ with Report;
+ package body C3A0013_2 is
+ 
+   procedure TC_Validate( It     : Car;
+                          TC_ID  : Character ) is
+   begin
+     if TC_ID /= 'C' then
+       Report.Failed("Dispatched to Car");
+     end if;
+     if Wheels( It ) /= 4 then
+       Report.Failed("Not a Car");
+     end if;
+   end TC_Validate;
+ 
+   function  Gear_Factor( It : Car ) return Natural is
+   begin
+     return C3A0013_1.Gear_Factor( C3A0013_1.Vehicle( It ) )*2;
+   end Gear_Factor;
+ 
+ end C3A0013_2;
+ 
+ with Report;
+ package body C3A0013_3 is
+ 
+   procedure TC_Validate( It     : Truck;
+                          TC_ID  : Character) is
+   begin
+     if TC_ID /= 'T' then
+       Report.Failed("Dispatched to Truck");
+     end if;
+     if Wheels( It ) /= 3 then
+       Report.Failed("Not a Truck");
+     end if;
+   end TC_Validate;
+ 
+   function  Gear_Factor( It : Truck ) return Natural is
+   begin
+     return C3A0013_1.Gear_Factor( C3A0013_1.Vehicle( It ) )*3;
+   end Gear_Factor;
+ 
+ end C3A0013_3;
+ 
+ package C3A0013_4 is
+   procedure Perform_Tests;
+ end C3A0013_4;
+ 
+ with Report;
+ with C3A0013_1;
+ with C3A0013_2;
+ with C3A0013_3;
+ package body C3A0013_4 is
+   package Root   renames C3A0013_1;
+   package Cars   renames C3A0013_2;
+   package Trucks renames C3A0013_3;
+ 
+   type Car_Pool is array(1..4) of aliased Cars.Car;
+   Commuters : Car_Pool;
+ 
+   My_Car      : aliased Cars.Car;
+   Company_Car : Root.Vehicle_ID;
+   Repair_Shop : Root.Vehicle_ID;
+ 
+   The_Vehicle : Root.Vehicle;
+   The_Car     : Cars.Car;
+   The_Truck   : Trucks.Truck;
+ 
+   procedure TC_Dispatch( Ptr   : Root.Vehicle_ID;
+                          Char  : Character ) is
+   begin
+     Root.TC_Validate( Ptr.all, Char );
+   end TC_Dispatch;
+ 
+   procedure TC_Check_Formal_Access( Item: in out Root.Vehicle'Class;
+                                     Char: Character) is
+   begin
+     TC_Dispatch( Item'Unchecked_Access, Char );
+   end TC_Check_Formal_Access;
+ 
+   procedure Perform_Tests is
+   begin  -- Main test procedure.
+ 
+   for Lane in Commuters'Range loop
+     Cars.Create( Commuters(Lane) );
+     for Excitement in 1..Lane loop
+       Cars.Up_Shift( Commuters(Lane) );
+     end loop;
+   end loop;
+ 
+   Cars.Create( My_Car );
+   Cars.Up_Shift( My_Car );
+   Cars.TC_Validate( My_Car, 2 );
+ 
+   Root.Create( The_Vehicle, 1 );
+   Cars.Create( The_Car    , 4 );
+   Trucks.Create( The_Truck, 3 );
+ 
+   TC_Check_Formal_Access( The_Vehicle, 'V' );
+   TC_Check_Formal_Access( The_Car,     'C' );
+   TC_Check_Formal_Access( The_Truck,   'T' );
+ 
+   Root.Up_Shift( The_Vehicle );
+   Cars.Up_Shift( The_Car );
+   Trucks.Up_Shift( The_Truck );
+ 
+   Root.TC_Validate( The_Vehicle, 1 ); 
+   Cars.TC_Validate( The_Car, 2 ); 
+   Trucks.TC_Validate( The_Truck, 3 ); 
+ 
+   --  general access type may reference allocated objects
+ 
+   Company_Car := new Cars.Car;
+   Root.Create( Company_Car.all );
+   Root.Up_Shift( Company_Car.all );
+   Root.Up_Shift( Company_Car.all );
+   Root.TC_Validate( Company_Car.all, 6 );
+ 
+   --  general access type may reference aliased objects
+ 
+   Repair_Shop := My_Car'Access;
+   Root.TC_Validate( Repair_Shop.all, 2 );
+ 
+   --  general access type may reference aliased objects
+ 
+   Construction: declare
+     type Speed_List is array(Commuters'Range) of Natural;
+     Accelerations : constant Speed_List := (2, 6, 12, 20);
+   begin
+     for Rotation in Commuters'Range loop
+       Repair_Shop := Commuters(Rotation)'Access;
+       Root.TC_Validate( Repair_Shop.all, Accelerations(Rotation) );
+     end loop;
+   end Construction;
+ 
+ end Perform_Tests;
+ 
+ end C3A0013_4;
+ 
+ with C3A0013_4;
+ with Report;
+ procedure C3A0013 is
+ begin
+ 
+   Report.Test ("C3A0013", "Check general access types.  Check aliased "
+                         & "nature of formal tagged type parameters.  "
+                         & "Check aliased nature of the current "
+                         & "instance of a limited type.  Check the "
+                         & "constraining of actual subtypes for "
+                         & "discriminated objects" );
+ 
+   C3A0013_4.Perform_Tests;
+ 
+   Report.Result;
+ end C3A0013;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0014.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0014.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0014.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,453 ----
+ -- C3A0014.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the view defined by an object declaration is aliased,
+ --      and the type of the object has discriminants, then the object is
+ --      constrained by its initial value even if its nominal subtype is
+ --      unconstrained.
+ --
+ --      Check that the attribute A'Constrained returns True if A is a formal
+ --      out or in out parameter, or dereference thereof, and A denotes an
+ --      aliased view of an object.
+ --
+ -- TEST DESCRIPTION:
+ --      These rules apply to objects of a record type with defaulted
+ --      discriminants, which may be unconstrained variables. If such a
+ --      variable is declared to be aliased, then it is constrained by its
+ --      initial value, and the value of the discriminant cannot be changed
+ --      for the life of the variable.
+ --
+ --      The rules do not apply to aliased component types because if such
+ --      types are discriminated they must be constrained.
+ --
+ --      A'Constrained returns True if A denotes a constant, value, or
+ --      constrained variable. Since aliased objects are constrained, it must
+ --      return True if the actual parameter corresponding to a formal
+ --      parameter A is an aliased object. The objective only mentions formal
+ --      parameters of mode out and in out, since parameters of mode in are
+ --      by definition constant, and would result in True anyway.
+ --
+ --      This test declares aliased objects of a nominally unconstrained
+ --      record subtype, both with and without initialization expressions.
+ --      It also declares access values which point to such objects. It then
+ --      checks that Constraint_Error is raised if an attempt is made to
+ --      change the discriminant value of an aliased object, either directly
+ --      or via a dereference of an access value. For aliased objects, this
+ --      check is also performed for subprogram parameters of mode out.
+ --
+ --      The test also passes aliased objects and access values which point
+ --      to such objects as actuals to subprograms and verifies, for parameter
+ --      modes out and in out, that P'Constrained returns true if P is the
+ --      corresponding formal parameter or a dereference thereof.
+ --
+ --      Additionally, the test declares a generic package which declares a
+ --      an aliased object of a formal derived unconstrained type, which is
+ --      is initialized with the value of a formal object of that type.
+ --      procedure declared within the generic assigns a value to the object
+ --      which has the same discriminant value as the formal derived type's
+ --      ancestor type. The generic is instantiated with various actuals
+ --      for the formal object, and the procedure is called. The test verifies
+ --      that Constraint_Error is raised if the discriminant values of the
+ --      actual corresponding to the formal object and the value assigned
+ --      by the procedure are not equal.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected numerous errors.
+ --
+ --!
+ 
+ package C3A0014_0 is
+ 
+    subtype Reasonable is Integer range 1..10;
+                                           -- Unconstrained (sub)type.
+    type UC (D: Reasonable := 2) is record -- Discriminant default.
+       S: String (1 .. D) := "Hi";         -- Default value.
+    end record;
+ 
+    type AUC is access all UC;
+ 
+    -- Nominal subtype is unconstrained for the following:
+ 
+    Obj0 :         UC;                  -- An unconstrained object.
+ 
+    Obj1 :         UC := (5, "Hello");  -- Non-aliased with initialization,
+                                        -- an unconstrained object.
+ 
+    Obj2 : aliased UC := (5, "Hello");  -- Aliased with initialization,
+                                        -- a constrained object.
+ 
+    Obj3 :         UC renames Obj2;     -- Aliased (renaming of aliased view),
+                                        -- a constrained object.
+    Obj4 : aliased UC;                  -- Aliased without initialization, Obj4
+                                        -- constrained here to initial value
+                                        -- taken from default for type.
+ 
+    Ptr1 : AUC := new UC'(Obj1);
+    Ptr2 : AUC := new UC;
+    Ptr3 : AUC := Obj3'Access;
+    Ptr4 : AUC := Obj4'Access;
+ 
+ 
+    procedure NP_Proc (A:    out UC);
+    procedure NP_Cons (A: in out UC;  B: out Boolean);
+    procedure P_Cons  (A:    out AUC; B: out Boolean);
+ 
+ 
+    generic
+       type FT is new UC;
+       FObj : in out FT;
+    package Gen is
+       F  : aliased FT := FObj;     -- Constrained if FT has discriminants.
+       procedure Proc;
+    end Gen;
+ 
+ 
+    procedure Avoid_Optimization_and_Fail ( P : UC; Msg : String );
+ 
+ 
+ end C3A0014_0;
+ 
+ 
+   --=======================================================================--
+ 
+ with Report;
+ 
+ package body C3A0014_0 is
+ 
+    procedure NP_Proc (A: out UC) is
+    begin
+       A := (3, "Bye");
+    end NP_Proc;
+ 
+    procedure NP_Cons (A: in out UC; B: out Boolean) is
+    begin
+       B := A'Constrained; 
+    end NP_Cons;
+ 
+    procedure P_Cons (A: out AUC; B: out Boolean) is
+    begin
+       B := A.all'Constrained; 
+    end P_Cons;
+ 
+ 
+    package body Gen is
+      
+       procedure Proc is
+       begin
+          F := (2, "Fi");
+       end Proc;
+ 
+    end Gen;
+ 
+ 
+    procedure Avoid_Optimization_and_Fail ( P : UC; Msg : String ) is
+       Default : UC := (1, "!"); -- Unique value.
+    begin                       
+       if P = Default then       -- Both If branches can't do the same thing.
+          Report.Failed  (Msg & ": Constraint_Error not raised");
+       else                      -- Subtests should always select this path.
+          Report.Failed ("Constraint_Error not raised " & Msg);
+       end if;
+    end Avoid_Optimization_and_Fail;
+ 
+ 
+ end C3A0014_0;
+ 
+ 
+   --=======================================================================--
+ 
+ 
+ with C3A0014_0;  use C3A0014_0;
+ with Report;
+ 
+ procedure C3A0014 is
+ begin
+ 
+    Report.Test("C3A0014", "Check that if the view defined by an object "   &
+                           "declaration is aliased, and the type of the "   &
+                           "object has discriminants, then the object is "  &
+                           "constrained by its initial value even if its "  &
+                           "nominal subtype is unconstrained.  Check that " &
+                           "the attribute A'Constrained returns True if A " &
+                           "is a formal out or in out parameter, or "       &
+                           "dereference thereof, and A denotes an aliased " &
+                           "view of an object");
+ 
+    Non_Pointer_Block:
+    begin
+ 
+       begin
+          Obj0 := (3, "Bye");              -- OK: Obj0 not constrained.
+          if Obj0 /= (3, "Bye") then
+             Report.Failed 
+               ("Wrong value after aggregate assignment - Subtest 1");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 1");
+       end;
+ 
+ 
+       begin
+          Obj1 := (3, "Bye");              -- OK: Obj1 not constrained.
+          if Obj1 /= (3, "Bye") then
+             Report.Failed
+               ("Wrong value after aggregate assignment - Subtest 2");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 2");
+       end;
+ 
+ 
+       begin
+          Obj2 := (3, "Bye");              -- C_E: Obj2 is constrained (D=>5).
+          Avoid_Optimization_and_Fail (Obj2, "Subtest 3");
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+ 
+       begin
+          Obj3 := (3, "Bye");              -- C_E: Obj3 is constrained (D=>5).
+          Avoid_Optimization_and_Fail (Obj3, "Subtest 4");
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+ 
+       begin
+          Obj4 := (3, "Bye");              -- C_E: Obj4 is constrained (D=>2).
+          Avoid_Optimization_and_Fail (Obj4, "Subtest 5");
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+    exception
+       when others => Report.Failed("Unexpected exception: Non_Pointer_Block");
+    end Non_Pointer_Block;
+ 
+ 
+    Pointer_Block:
+    begin
+    
+       begin
+          Ptr1.all := (3, "Bye");        -- C_E: Ptr1.all is constrained (D=>5).
+          Avoid_Optimization_and_Fail (Ptr1.all, "Subtest 6");
+       exception
+          when Constraint_Error => null; -- Exception is expected.
+       end;
+ 
+ 
+       begin
+          Ptr2.all := (3, "Bye");        -- C_E: Ptr2.all is constrained (D=>2).
+          Avoid_Optimization_and_Fail (Ptr2.all, "Subtest 7");
+       exception
+          when Constraint_Error => null; -- Exception is expected. 
+       end;
+ 
+ 
+       begin
+          Ptr3.all := (3, "Bye");        -- C_E: Ptr3.all is constrained (D=>5).
+          Avoid_Optimization_and_Fail (Ptr3.all, "Subtest 8");
+       exception
+          when Constraint_Error => null; -- Exception is expected. 
+       end;
+ 
+ 
+       begin
+          Ptr4.all := (3, "Bye");        -- C_E: Ptr4.all is constrained (D=>2).
+          Avoid_Optimization_and_Fail (Ptr4.all, "Subtest 9");
+       exception
+          when Constraint_Error => null; -- Exception is expected. 
+       end;
+ 
+    exception
+       when others => Report.Failed("Unexpected exception: Pointer_Block");
+    end Pointer_Block;
+ 
+ 
+    Subprogram_Block:
+    declare
+       Is_Constrained : Boolean;
+    begin
+ 
+       begin
+          NP_Proc (Obj0);                 -- OK: Obj0 not constrained, can
+          if Obj0 /= (3, "Bye") then      -- change discriminant value.
+             Report.Failed 
+               ("Wrong value after aggregate assignment - Subtest 10");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 10");
+       end;
+ 
+ 
+       begin
+          NP_Proc (Obj2);                 -- C_E: Obj2 is constrained (D=>5).
+          Avoid_Optimization_and_Fail (Obj2, "Subtest 11");      
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+ 
+       begin
+          NP_Proc (Obj3);                 -- C_E: Obj3 is constrained (D=>5).
+          Avoid_Optimization_and_Fail (Obj3, "Subtest 12");
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+ 
+       begin
+          NP_Proc (Obj4);                 -- C_E: Obj4 is constrained (D=>2).
+          Avoid_Optimization_and_Fail (Obj4, "Subtest 13");
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+ 
+ 
+       begin
+          Is_Constrained := True;
+          NP_Cons (Obj1, Is_Constrained);  -- Should return False, since Obj1
+          if Is_Constrained then           -- is not constrained.
+             Report.Failed ("Wrong result from 'Constrained - Subtest 14");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 14");
+       end;
+ 
+ 
+       begin
+          Is_Constrained := False;
+          NP_Cons (Obj2, Is_Constrained);  -- Should return True, Obj2 is
+          if not Is_Constrained then       -- constrained.
+             Report.Failed ("Wrong result from 'Constrained - Subtest 15");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 15");
+       end;
+ 
+ 
+ 
+ 
+       begin
+          Is_Constrained := False;
+          P_Cons (Ptr2, Is_Constrained);   -- Should return True, Ptr2.all
+          if not Is_Constrained then       -- is constrained.
+             Report.Failed ("Wrong result from 'Constrained - Subtest 16");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 16");
+       end;
+ 
+ 
+       begin
+          Is_Constrained := False;
+          P_Cons (Ptr3, Is_Constrained);   -- Should return True, Ptr3.all
+          if not Is_Constrained then       -- is constrained.
+             Report.Failed ("Wrong result from 'Constrained - Subtest 17");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 17");
+       end;
+ 
+ 
+    exception
+       when others => Report.Failed("Exception raised in Subprogram_Block");
+    end Subprogram_Block;
+ 
+ 
+    Generic_Block:
+    declare
+ 
+       type NUC is new UC;
+ 
+       Obj : NUC;
+ 
+ 
+       package Instance_A is new Gen (NUC, Obj);
+       package Instance_B is new Gen (UC, Obj2);
+       package Instance_C is new Gen (UC, Obj3);
+       package Instance_D is new Gen (UC, Obj4);
+ 
+    begin
+ 
+       begin
+          Instance_A.Proc;                -- OK: Obj.D = 2.
+          if Instance_A.F /= (2, "Fi") then
+             Report.Failed 
+               ("Wrong value after aggregate assignment - Subtest 18");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 18");
+       end;
+ 
+ 
+       begin
+          Instance_B.Proc;                -- C_E: Obj2.D = 5.
+          Avoid_Optimization_and_Fail (Obj2, "Subtest 19");
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+ 
+       begin
+          Instance_C.Proc;                -- C_E: Obj3.D = 5.
+          Avoid_Optimization_and_Fail (Obj3, "Subtest 20");
+       exception
+          when Constraint_Error => null;  -- Exception is expected.
+       end;
+ 
+ 
+       begin
+          Instance_D.Proc;                -- OK: Obj4.D = 2.
+          if Instance_D.F /= (2, "Fi") then
+             Report.Failed 
+               ("Wrong value after aggregate assignment - Subtest 21");
+          end if;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception raised - Subtest 21");
+       end;
+ 
+    exception
+       when others => Report.Failed("Exception raised in Generic_Block");
+    end Generic_Block;
+ 
+ 
+    Report.Result;
+ 
+ end C3A0014;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0015.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a0015.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a0015.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- C3A0015.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that a derived access type has the same storage pool as its
+ --    parent.  (Defect Report 8652/0012, Technical Corrigendum 3.10(7/1)).
+ --
+ -- CHANGE HISTORY:
+ --    24 JAN 2001   PHL   Initial version.
+ --    29 JUN 2001   RLB   Reformatted for ACATS.
+ --
+ --!
+ with System.Storage_Elements;
+ use System.Storage_Elements;
+ with System.Storage_Pools;
+ use System.Storage_Pools;
+ package C3A0015_0 is
+ 
+     type Pool (Storage_Size : Storage_Count) is new Root_Storage_Pool with
+ 	record
+ 	    First_Free : Storage_Count := 1;
+ 	    Contents : Storage_Array (1 .. Storage_Size);
+ 	end record;
+ 
+     procedure Allocate (Pool : in out C3A0015_0.Pool;
+ 			Storage_Address : out System.Address;
+ 			Size_In_Storage_Elements : in Storage_Count;
+ 			Alignment : in Storage_Count);
+ 
+     procedure Deallocate (Pool : in out C3A0015_0.Pool;
+ 			  Storage_Address : in System.Address;
+ 			  Size_In_Storage_Elements : in Storage_Count;
+ 			  Alignment : in Storage_Count);
+ 
+     function Storage_Size (Pool : in C3A0015_0.Pool) return Storage_Count;
+ 
+ end C3A0015_0;
+ 
+ package body C3A0015_0 is
+ 
+     use System;
+ 
+     procedure Allocate (Pool : in out C3A0015_0.Pool;
+ 			Storage_Address : out System.Address;
+ 			Size_In_Storage_Elements : in Storage_Count;
+ 			Alignment : in Storage_Count) is
+ 	Unaligned_Address : constant System.Address :=
+ 	   Pool.Contents (Pool.First_Free)'Address;
+ 	Unalignment : Storage_Count;
+     begin
+ 	Unalignment := Unaligned_Address mod Alignment;
+ 	if Unalignment = 0 then
+ 	    Storage_Address := Unaligned_Address;
+ 	    Pool.First_Free := Pool.First_Free + Size_In_Storage_Elements;
+ 	else
+ 	    Storage_Address :=
+ 	       Pool.Contents (Pool.First_Free + Alignment - Unalignment)'
+ 		  Address;
+ 	    Pool.First_Free := Pool.First_Free + Size_In_Storage_Elements +
+ 				  Alignment - Unalignment;
+ 	end if;
+     end Allocate;
+ 
+     procedure Deallocate (Pool : in out C3A0015_0.Pool;
+ 			  Storage_Address : in System.Address;
+ 			  Size_In_Storage_Elements : in Storage_Count;
+ 			  Alignment : in Storage_Count) is
+     begin
+ 	if Storage_Address + Size_In_Storage_Elements =
+ 	   Pool.Contents (Pool.First_Free)'Address then
+ 	    -- Only deallocate if the block is at the end.
+ 	    Pool.First_Free := Pool.First_Free - Size_In_Storage_Elements;
+ 	end if;
+     end Deallocate;
+ 
+     function Storage_Size (Pool : in C3A0015_0.Pool) return Storage_Count is
+     begin
+ 	return Pool.Storage_Size;
+     end Storage_Size;
+ 
+ end C3A0015_0;
+ 
+ with Ada.Exceptions;
+ use Ada.Exceptions;
+ with Ada.Unchecked_Deallocation;
+ with Report;
+ use Report;
+ with System.Storage_Elements;
+ use System.Storage_Elements;
+ with C3A0015_0;
+ procedure C3A0015 is
+ 
+     type Standard_Pool is access Float;
+     type Derived_Standard_Pool is new Standard_Pool;
+     type Derived_Derived_Standard_Pool is new Derived_Standard_Pool;
+ 
+     type User_Defined_Pool is access Integer;
+     type Derived_User_Defined_Pool is new User_Defined_Pool;
+     type Derived_Derived_User_Defined_Pool is new Derived_User_Defined_Pool;
+ 
+     My_Pool : C3A0015_0.Pool (1024);
+     for User_Defined_Pool'Storage_Pool use My_Pool;
+ 
+     generic
+ 	type Designated is private;
+ 	Value : Designated;
+ 	type Acc is access Designated;
+ 	type Derived_Acc is new Acc;
+     procedure Check (Subtest : String; User_Defined_Pool : Boolean);
+ 
+     procedure Check (Subtest : String; User_Defined_Pool : Boolean) is
+ 
+ 	procedure Deallocate is
+ 	   new Ada.Unchecked_Deallocation (Object => Designated,
+ 					   Name => Acc);
+ 	procedure Deallocate is
+ 	   new Ada.Unchecked_Deallocation (Object => Designated,
+ 					   Name => Derived_Acc);
+ 
+ 	First_Free : Storage_Count;
+ 	X : Acc;
+ 	Y : Derived_Acc;
+     begin
+ 	if User_Defined_Pool then
+ 	    First_Free := My_Pool.First_Free;
+ 	end if;
+ 	X := new Designated'(Value);
+ 	if User_Defined_Pool and then First_Free >= My_Pool.First_Free then
+ 	    Failed (Subtest &
+ 		    " - Allocation didn't consume storage in the pool - 1");
+ 	else
+ 	    First_Free := My_Pool.First_Free;
+ 	end if;
+ 
+ 	Y := Derived_Acc (X);
+ 	if User_Defined_Pool and then First_Free /= My_Pool.First_Free then
+ 	    Failed (Subtest &
+ 		    " - Conversion did consume storage in the pool - 1");
+ 	end if;
+ 	if Y.all /= Value then
+ 	    Failed (Subtest &
+ 		    " - Incorrect allocation/conversion of access values - 1");
+ 	end if;
+ 
+ 	Deallocate (Y);
+ 	if User_Defined_Pool and then First_Free <= My_Pool.First_Free then
+ 	    Failed (Subtest &
+ 		    " - Deallocation didn't release storage from the pool - 1");
+ 	else
+ 	    First_Free := My_Pool.First_Free;
+ 	end if;
+ 
+ 	Y := new Designated'(Value);
+ 	if User_Defined_Pool and then First_Free >= My_Pool.First_Free then
+ 	    Failed (Subtest &
+ 		    " - Allocation didn't consume storage in the pool - 2");
+ 	else
+ 	    First_Free := My_Pool.First_Free;
+ 	end if;
+ 
+ 	X := Acc (Y);
+ 	if User_Defined_Pool and then First_Free /= My_Pool.First_Free then
+ 	    Failed (Subtest &
+ 		    " - Conversion did consume storage in the pool - 2");
+ 	end if;
+ 	if X.all /= Value then
+ 	    Failed (Subtest &
+ 		    " - Incorrect allocation/conversion of access values - 2");
+ 	end if;
+ 
+ 	Deallocate (X);
+ 	if User_Defined_Pool and then First_Free <= My_Pool.First_Free then
+ 	    Failed (Subtest &
+ 		    " - Deallocation didn't release storage from the pool - 2");
+ 	end if;
+     exception
+ 	when E: others =>
+ 	    Failed (Subtest & " - Exception " & Exception_Name (E) &
+ 		    " raised - " & Exception_Message (E));
+     end Check;
+ 
+ 
+ begin
+     Test ("C3A0015", "Check that a dervied access type has the same " &
+ 			"storage pool as its parent");
+ 
+     Comment ("Access types using the standard storage pool");
+ 
+     Std:
+ 	declare
+ 	    procedure Check1 is
+ 	       new Check (Designated => Float,
+ 			  Value => 3.0,
+ 			  Acc => Standard_Pool,
+ 			  Derived_Acc => Derived_Standard_Pool);
+ 	    procedure Check2 is
+ 	       new Check (Designated => Float,
+ 			  Value => 4.0,
+ 			  Acc => Standard_Pool,
+ 			  Derived_Acc => Derived_Derived_Standard_Pool);
+ 	    procedure Check3 is
+ 	       new Check (Designated => Float,
+ 			  Value => 5.0,
+ 			  Acc => Derived_Standard_Pool,
+ 			  Derived_Acc => Derived_Derived_Standard_Pool);
+ 	begin
+ 	    Check1 ("Standard_Pool/Derived_Standard_Pool",
+ 		    User_Defined_Pool => False);
+ 	    Check2 ("Standard_Pool/Derived_Derived_Standard_Pool",
+ 		    User_Defined_Pool => False);
+ 	    Check3 ("Derived_Standard_Pool/Derived_Derived_Standard_Pool",
+ 		    User_Defined_Pool => False);
+ 	end Std;
+ 
+     Comment ("Access types using a user-defined storage pool");
+ 
+     User:
+ 	declare
+ 	    procedure Check1 is
+ 	       new Check (Designated => Integer,
+ 			  Value => 17,
+ 			  Acc => User_Defined_Pool,
+ 			  Derived_Acc => Derived_User_Defined_Pool);
+ 	    procedure Check2 is
+ 	       new Check (Designated => Integer,
+ 			  Value => 18,
+ 			  Acc => User_Defined_Pool,
+ 			  Derived_Acc => Derived_Derived_User_Defined_Pool);
+ 	    procedure Check3 is
+ 	       new Check (Designated => Integer,
+ 			  Value => 19,
+ 			  Acc => Derived_User_Defined_Pool,
+ 			  Derived_Acc => Derived_Derived_User_Defined_Pool);
+ 	begin
+ 	    Check1 ("User_Defined_Pool/Derived_User_Defined_Pool",
+ 		    User_Defined_Pool => True);
+ 	    Check2 ("User_Defined_Pool/Derived_Derived_User_Defined_Pool",
+ 		    User_Defined_Pool => True);
+ 	    Check3
+ 	       ("Derived_User_Defined_Pool/Derived_Derived_User_Defined_Pool",
+ 		User_Defined_Pool => True);
+ 	end User;
+ 
+     Result;
+ end C3A0015;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a1001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a1001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a1001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a1001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,315 ----
+ -- C3A1001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the full type completing a type with no discriminant part
+ --      or an unknown discriminant part may have explicitly declared or
+ --      inherited discriminants.
+ --      Check for cases where the types are records and protected types.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare two groups of incomplete types: one group with no discriminant 
+ --      part and one group with unknown discriminant part.  Both groups of 
+ --      incomplete types are completed with both explicit and inherited 
+ --      discriminants.  Discriminants for record and protected types are 
+ --      declared with default and non default values.
+ --      In the main program, verify that objects of both groups of incomplete 
+ --      types can be created by default values or by assignments.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      11 Oct 95   SAIC    Initial prerelease version.
+ --      11 Nov 96   SAIC    Revised for version 2.1.
+ --
+ --!
+ 
+ package C3A1001_0 is
+ 
+    type Incomplete1 (<>);                          -- unknown discriminant
+ 
+    type Incomplete2;                               -- no discriminant
+ 
+    type Incomplete3 (<>);                          -- unknown discriminant
+ 
+    type Incomplete4;                               -- no discriminant
+ 
+    type Incomplete5 (<>);                          -- unknown discriminant
+ 
+    type Incomplete6;                               -- no discriminant
+ 
+    type Incomplete8;                               -- no discriminant
+ 
+    subtype Small_Int is Integer range 1 .. 10;
+ 
+    type Enu_Type is (M, F);
+ 
+    type Incomplete1 (Disc : Enu_Type) is           -- unknown discriminant/
+      record                                        -- explicit discriminant 
+         case Disc is
+            when M => MInteger : Small_Int := 3;
+            when F => FInteger : Small_Int := 8;
+         end case;
+      end record;
+ 
+    type Incomplete2 (Disc : Small_Int := 8) is     -- no discriminant/  
+      record                                        -- explicit discriminant 
+         ID : String (1 .. Disc) := "Plymouth";
+      end record;
+ 
+    type Incomplete3 is new Incomplete2;            -- unknown discriminant/
+                                                    -- inherited discriminant
+ 
+    type Incomplete4 is new Incomplete2;            -- no discriminant/  
+                                                    -- inherited discriminant   
+                                                    
+    protected type Incomplete5                      -- unknown discriminant/
+      (Disc : Enu_Type) is                          -- explicit discriminant
+         function Get_Priv_Val return Enu_Type;     
+    private
+       Enu_Obj : Enu_Type := Disc;
+    end Incomplete5;    
+ 
+    protected type Incomplete6                      -- no discriminant/  
+      (Disc : Small_Int := 1) is                    -- explicit discriminant
+         function Get_Priv_Val return Small_Int;    -- with default
+    private
+       Num : Small_Int := Disc;
+    end Incomplete6;
+ 
+    type Incomplete8 (Disc : Small_Int) is          -- no discriminant/  
+      record                                        -- explicit discriminant
+        Str : String (1 .. Disc);                   -- no default
+      end record;
+ 
+    type Incomplete9 is new Incomplete8;
+ 
+    function Return_String (S : String) return String;
+ 
+ end C3A1001_0;
+ 
+      --==================================================================--
+ 
+ with Report;
+ 
+ package body C3A1001_0 is
+ 
+    protected body Incomplete5 is    
+ 
+       function Get_Priv_Val return Enu_Type is
+       begin
+          return Enu_Obj;
+       end Get_Priv_Val; 
+ 
+     end Incomplete5; 
+ 
+    ----------------------------------------------------------------------
+    protected body Incomplete6 is                                             
+             
+       function Get_Priv_Val return Small_Int is
+       begin
+          return Num;
+       end Get_Priv_Val; 
+ 
+     end Incomplete6; 
+ 
+    ----------------------------------------------------------------------
+    function Return_String (S : String) return String is
+    begin
+       if Report.Ident_Bool(True) = True then
+          return S;
+       end if;
+ 
+       return S;
+    end Return_String;
+    
+ end C3A1001_0;
+ 
+      --==================================================================--
+ 
+ with Report;
+ 
+ with C3A1001_0;
+ use  C3A1001_0;
+ 
+ procedure C3A1001 is
+ 
+    -- Discriminant value comes from default.
+ 
+    Incomplete2_Obj_1 :  Incomplete2;                
+ 
+    Incomplete4_Obj_1 :  Incomplete4;
+ 
+    Incomplete6_Obj_1 :  Incomplete6;                
+ 
+    -- Discriminant value comes from explicit constraint.
+ 
+    Incomplete1_Obj_1 :  Incomplete1 (F);              
+ 
+    Incomplete5_Obj_1 :  Incomplete5 (M);               
+ 
+    Incomplete6_Obj_2 :  Incomplete6 (2);           
+ 
+    -- Discriminant value comes from assignment.        
+ 
+    Incomplete3_Obj_1 :  Incomplete3 := (Disc => 6, ID => "Sentra");       
+ 
+    Incomplete1_Obj_2 :  Incomplete1 := (Disc => M, MInteger => 9);    
+                                   
+    Incomplete2_Obj_2 :  Incomplete2 := (Disc => 5, ID => "Buick");    
+                                   
+ begin
+ 
+    Report.Test ("C3A1001", "Check that the full type completing a type " &
+                 "with no discriminant part or an unknown discriminant "  &
+                 "part may have explicitly declared or inherited "        &
+                 "discriminants.  Check for cases where the types are "   &
+                 "records and protected types");
+ 
+    -- Check the initial values.
+ 
+    if (Incomplete2_Obj_1.Disc /= 8) or
+       (Incomplete2_Obj_1.ID   /= "Plymouth") then
+          Report.Failed ("Wrong initial values for Incomplete2_Obj_1");
+    end if;
+ 
+    if (Incomplete4_Obj_1.Disc /= 8) or
+       (Incomplete4_Obj_1.ID   /= "Plymouth") then
+          Report.Failed ("Wrong initial values for Incomplete4_Obj_1");
+    end if;
+ 
+    if (Incomplete6_Obj_1.Disc         /= 1) or
+       (Incomplete6_Obj_1.Get_Priv_Val /= 1) then
+          Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
+    end if;
+ 
+    -- Check the explicit values.
+ 
+    if (Incomplete1_Obj_1.Disc     /= F) or 
+       (Incomplete1_Obj_1.FInteger /= 8) then
+          Report.Failed ("Wrong values for Incomplete1_Obj_1");
+    end if;
+ 
+    if (Incomplete5_Obj_1.Disc         /= M) or  
+       (Incomplete5_Obj_1.Get_Priv_Val /= M) then
+          Report.Failed ("Wrong value for Incomplete5_Obj_1");
+    end if;
+ 
+    if (Incomplete6_Obj_2.Disc         /= 2) or
+       (Incomplete6_Obj_2.Get_Priv_Val /= 2) then
+          Report.Failed ("Wrong value for Incomplete6_Obj_2");
+    end if;
+ 
+    -- Check the assigned values.
+ 
+    if (Incomplete3_Obj_1.Disc /= 6) or 
+       (Incomplete3_Obj_1.ID   /= "Sentra") then
+          Report.Failed ("Wrong values for Incomplete3_Obj_1");
+    end if;
+ 
+    if (Incomplete1_Obj_2.Disc     /= M) or
+       (Incomplete1_Obj_2.MInteger /= 9) then
+          Report.Failed ("Wrong values for Incomplete1_Obj_2");
+    end if;
+ 
+    if (Incomplete2_Obj_2.Disc /= 5) or 
+       (Incomplete2_Obj_2.ID   /= "Buick") then
+          Report.Failed ("Wrong values for Incomplete2_Obj_2");
+    end if;
+ 
+    -- Make sure that assignments work without problems.
+ 
+    Incomplete1_Obj_1.FInteger := 1;
+ 
+    -- Avoid optimization (dead variable removal of FInteger):
+ 
+    if Incomplete1_Obj_1.FInteger /= Report.Ident_Int(1) 
+       then  
+          Report.Failed ("Wrong value stored in Incomplete1_Obj_1.FInteger");
+    end if;
+ 
+    Incomplete2_Obj_1.ID       := Return_String ("12345678");
+ 
+    -- Avoid optimization (dead variable removal of ID)
+ 
+    if Incomplete2_Obj_1.ID /= Return_String ("12345678")
+      then   
+         Report.Failed ("Wrong values for Incomplete8_Obj_1.ID");
+    end if;
+ 
+    Incomplete4_Obj_1.ID       := Return_String ("87654321");
+ 
+    -- Avoid optimization (dead variable removal of ID)
+ 
+    if Incomplete4_Obj_1.ID /= Return_String ("87654321")
+      then   
+         Report.Failed ("Wrong values for Incomplete4_Obj_1.ID");
+    end if;
+ 
+ 
+    Test1:
+    declare
+    
+       Incomplete8_Obj_1 :  Incomplete8 (10);
+ 
+    begin
+       Incomplete8_Obj_1.Str := "Merry Xmas";
+ 
+       -- Avoid optimization (dead variable removal of Str):
+ 
+       if Return_String (Incomplete8_Obj_1.Str) /= "Merry Xmas"
+         then   
+            Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
+       end if;
+ 
+    exception
+       when Constraint_Error =>
+           Report.Failed ("Constraint_Error raised in Incomplete8_Obj_1");
+ 
+    end Test1;
+ 
+    Test2:
+    declare
+ 
+       Incomplete8_Obj_2 :  Incomplete8 (5);
+ 
+    begin
+       Incomplete8_Obj_2.Str := "Happy";       
+ 
+       -- Avoid optimization (dead variable removal of Str):
+ 
+       if Return_String (Incomplete8_Obj_2.Str) /= "Happy"               
+         then   
+            Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
+       end if;
+ 
+    exception
+       when Constraint_Error =>
+           Report.Failed ("Constraint_Error raised in Incomplete8_Obj_2");
+ 
+    end Test2;
+ 
+    Report.Result;
+ 
+ end C3A1001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a1002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a1002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a1002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a1002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,251 ----
+ -- C3A1002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the full type completing a type with no discriminant part
+ --      or an unknown discriminant part may have explicitly declared or
+ --      inherited discriminants.
+ --      Check for cases where the types are tagged records and task types.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare two groups of incomplete types: one group with no discriminant 
+ --      part and one group with unknown discriminant part.  Both groups of 
+ --      incomplete types are completed with both explicit and inherited 
+ --      discriminants.  Discriminants for task types are declared with both 
+ --      default and non default values.  Discriminants for tagged types are 
+ --      only declared without default values.  
+ --      In the main program, verify that objects of both groups of incomplete 
+ --      types can be created by default values or by assignments.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      23 Oct 95   SAIC    Initial prerelease version.
+ --      19 Oct 96   SAIC    ACVC 2.1: modified test description.  Initialized
+ --                          Int_Val.
+ --
+ --!
+ 
+ package C3A1002_0 is
+ 
+    subtype Small_Int is Integer range 1 .. 15;
+ 
+    type Enu_Type is (M, F);
+ 
+    type Tag_Type is tagged         
+      record                                          
+         I : Small_Int := 1;
+      end record;
+ 
+    type NTag_Type (D : Small_Int) is new Tag_Type with
+      record                                          
+         S : String (1 .. D) := "Aloha";  
+      end record;
+ 
+    type Incomplete1;                               -- no discriminant
+ 
+    type Incomplete2 (<>);                          -- unknown discriminant
+ 
+    type Incomplete3;                               -- no discriminant
+ 
+    type Incomplete4 (<>);                          -- unknown discriminant
+ 
+    type Incomplete5;                               -- no discriminant
+ 
+    type Incomplete6 (<>);                          -- unknown discriminant
+ 
+    type Incomplete1 (D1 : Enu_Type) is tagged      -- no discriminant/  
+      record                                        -- explicit discriminant
+         case D1 is
+            when M => MInteger : Small_Int := 9;
+            when F => FInteger : Small_Int := 8;
+         end case;
+      end record;
+ 
+    type Incomplete2 (D2 : Small_Int) is new       -- unknown discriminant/
+      Incomplete1 (D1 => F) with record            -- explicit discriminant
+         ID : String (1 .. D2) := "ACVC95";
+      end record;
+ 
+    type Incomplete3 is new                         -- no discriminant/
+      NTag_Type with record                         -- inherited discriminant
+         E : Enu_Type := M;
+      end record;
+ 
+    type Incomplete4 is new                         -- unknown discriminant/
+      NTag_Type (D => 3) with record                -- inherited discriminant
+         E : Enu_Type := F;
+      end record;
+ 
+    task type Incomplete5 (D5 : Enu_Type) is      -- no discriminant/
+       entry Read_Disc (P : out Enu_Type);        -- explicit discriminant
+    end Incomplete5;
+ 
+    task type Incomplete6 
+      (D6 : Small_Int := 4) is                    -- unknown discriminant/
+       entry Read_Int (P : out Small_Int);        -- explicit discriminant
+    end Incomplete6;
+ 
+ end C3A1002_0;
+ 
+      --==================================================================--
+ 
+ package body C3A1002_0 is
+ 
+    task body Incomplete5 is  
+    begin
+       select 
+          accept Read_Disc (P : out Enu_Type) do  
+             P := D5;
+          end Read_Disc;
+       or
+          terminate;
+       end select;
+ 
+    end Incomplete5;
+ 
+    ----------------------------------------------------------------------
+    task body Incomplete6 is 
+    begin
+       select 
+          accept Read_Int (P : out Small_Int) do  
+             P := D6;
+          end Read_Int;
+       or
+          terminate;
+       end select;
+ 
+    end Incomplete6;
+ 
+ end C3A1002_0;
+ 
+      --==================================================================--
+ 
+ with Report;
+ 
+ with C3A1002_0;
+ use  C3A1002_0;
+ 
+ procedure C3A1002 is
+ 
+    Enum_Val : Enu_Type := M;
+ 
+    Int_Val  : Small_Int := 15;
+ 
+    -- Discriminant value comes from default.
+ 
+    Incomplete6_Obj_1  :  Incomplete6;
+ 
+    -- Discriminant value comes from explicit constraint.
+ 
+    Incomplete1_Obj_1  :  Incomplete1 (M);
+ 
+    Incomplete2_Obj_1  :  Incomplete2 (6);
+ 
+    Incomplete5_Obj_1  :  Incomplete5 (F);
+ 
+    Incomplete6_Obj_2  :  Incomplete6 (7);
+ 
+    -- Discriminant value comes from assignment.        
+ 
+    Incomplete1_Obj_2  :  Incomplete1
+                       := (F, 12);
+ 
+    Incomplete3_Obj_1  :  Incomplete3
+                       := (D => 2, S => "Hi", I => 10, E => F);
+ 
+    Incomplete4_Obj_1  :  Incomplete4
+                       := (E => M, D => 3, S => "Bye", I => 14);
+ 
+ begin
+ 
+    Report.Test ("C3A1002", "Check that the full type completing a type " &
+                 "with no discriminant part or an unknown discriminant "  &
+                 "part may have explicitly declared or inherited "        &
+                 "discriminants.  Check for cases where the types are "   &
+                 "tagged records and task types");
+ 
+    -- Check the initial values.
+ 
+    if (Incomplete6_Obj_1.D6 /= 4) then 
+       Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
+    end if;
+ 
+    -- Check the explicit values.
+ 
+    if (Incomplete1_Obj_1.D1       /= M) or 
+       (Incomplete1_Obj_1.MInteger /= 9) then
+         Report.Failed ("Wrong values for Incomplete1_Obj_1");
+    end if;
+ 
+    if (Incomplete2_Obj_1.D2       /= 6) or 
+       (Incomplete2_Obj_1.FInteger /= 8) or
+       (Incomplete2_Obj_1.ID       /= "ACVC95") then
+          Report.Failed ("Wrong values for Incomplete2_Obj_1");
+    end if;
+ 
+    if (Incomplete5_Obj_1.D5 /= F) then 
+       Report.Failed ("Wrong value for Incomplete5_Obj_1");
+    end if;
+ 
+    Incomplete5_Obj_1.Read_Disc (Enum_Val);
+ 
+    if (Enum_Val /= F) then 
+       Report.Failed ("Wrong value for Enum_Val");
+    end if;
+ 
+    if (Incomplete6_Obj_2.D6 /= 7) then 
+       Report.Failed ("Wrong value for Incomplete6_Obj_2");
+    end if;
+ 
+    Incomplete6_Obj_1.Read_Int (Int_Val);
+ 
+    if (Int_Val /= 4) then 
+       Report.Failed ("Wrong value for Int_Val");
+    end if;
+ 
+    -- Check the assigned values.
+ 
+    if (Incomplete1_Obj_2.D1       /= F)  or 
+       (Incomplete1_Obj_2.FInteger /= 12) then
+          Report.Failed ("Wrong values for Incomplete1_Obj_2");
+    end if;
+ 
+    if (Incomplete3_Obj_1.D /= 2 ) or 
+       (Incomplete3_Obj_1.I /= 10) or
+       (Incomplete3_Obj_1.E /= F ) or
+       (Incomplete3_Obj_1.S /= "Hi") then
+          Report.Failed ("Wrong values for Incomplete3_Obj_1");
+    end if;
+ 
+    if (Incomplete4_Obj_1.E /= M )      or 
+       (Incomplete4_Obj_1.D /= 3)       or
+       (Incomplete4_Obj_1.S /= "Bye")   or
+       (Incomplete4_Obj_1.I /= 14)      then
+          Report.Failed ("Wrong values for Incomplete4_Obj_1");
+    end if;
+ 
+    Report.Result;
+ 
+ end C3A1002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,460 ----
+ -- C3A2001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an access type may be defined to designate the
+ --      class-wide type of an abstract type.  Check that the access type
+ --      may then be used subsequently with types derived from the abstract
+ --      type.  Check that dispatching operations dispatch correctly, when
+ --      called using values designated by objects of the access type.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares an abstract type Breaker in a package, and
+ --      then derives from it.  The type Basic_Breaker defines the least
+ --      possible in order to not be abstract.  The type Ground_Fault is
+ --      defined to inherit as much as possible, whereas type Special_Breaker
+ --      overrides everything it can.  The type Special_Breaker also includes
+ --      an embedded Basic_Breaker object.  The main program then utilizes
+ --      each of the three types of breaker, and to ascertain that the
+ --      overloading and tagging resolution are correct, each "Create"
+ --      procedure is called with a unique value.  The diagram below
+ --      illustrates the relationships.
+ --
+ --              Abstract type:           Breaker(1)
+ --                                           |
+ --                                    Basic_Breaker(2)
+ --                                    /           \
+ --                           Ground_Fault(3)    Special_Breaker(4)
+ --
+ --      Test structure is a polymorphic linked list, modeling a circuit
+ --      as a list of components.  The type component is the access type
+ --      defined to designate Breaker'Class values.  The test then creates
+ --      some values, and traverses the list to determine correct operation.
+ --      This test is instrumented with a the trace facility found in
+ --      foundation F392C00 to simplify the verification process.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      10 Nov 95   SAIC    Checked compilation for ACVC 2.0.1
+ --      23 APR 96   SAIC    Added pragma Elaborate_All
+ --      26 NOV 96   SAIC    Elaborate_Body changed to Elaborate_All
+ --
+ --!
+ 
+ with Report;
+ with TCTouch;
+ package C3A2001_1 is
+ 
+   type Breaker is abstract tagged private;
+   type Status  is ( Power_Off, Power_On, Tripped, Failed );
+ 
+   procedure Flip ( The_Breaker : in out Breaker ) is abstract;
+   procedure Trip ( The_Breaker : in out Breaker ) is abstract;
+   procedure Reset( The_Breaker : in out Breaker ) is abstract;
+   procedure Fail ( The_Breaker : in out Breaker );
+ 
+   procedure Set ( The_Breaker : in out Breaker'Class; To_State : Status );
+ 
+   function  Status_Of( The_Breaker : Breaker ) return Status;
+ 
+ private
+   type Breaker is abstract tagged record
+     State : Status := Power_Off;
+   end record;
+ end C3A2001_1;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with TCTouch;
+ package body C3A2001_1 is
+   procedure Fail( The_Breaker : in out Breaker ) is
+   begin
+     TCTouch.Touch( 'a' ); --------------------------------------------- a
+     The_Breaker.State := Failed;
+   end Fail;
+ 
+   procedure Set( The_Breaker : in out Breaker'Class; To_State : Status ) is
+   begin
+     The_Breaker.State := To_State;
+   end Set;
+ 
+   function  Status_Of( The_Breaker : Breaker ) return Status is
+   begin
+     TCTouch.Touch( 'b' ); --------------------------------------------- b
+     return The_Breaker.State;
+   end Status_Of;
+ end C3A2001_1;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with C3A2001_1;
+ package C3A2001_2 is
+ 
+   type Basic_Breaker is new C3A2001_1.Breaker with private;
+ 
+   type Voltages is ( V12, V110, V220, V440 );
+   type Amps     is ( A1, A5, A10, A25, A100 );
+ 
+   function Construct( Voltage : Voltages; Amperage : Amps )
+     return Basic_Breaker;
+ 
+   procedure Flip ( The_Breaker : in out Basic_Breaker );
+   procedure Trip ( The_Breaker : in out Basic_Breaker );
+   procedure Reset( The_Breaker : in out Basic_Breaker );
+ private
+   type Basic_Breaker is new C3A2001_1.Breaker with record
+     Voltage_Level : Voltages := V110;
+     Amperage      : Amps;
+   end record;
+ end C3A2001_2;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with TCTouch;
+ package body C3A2001_2 is
+   function Construct( Voltage : Voltages; Amperage : Amps )
+     return Basic_Breaker is
+     It : Basic_Breaker;
+   begin
+     TCTouch.Touch( 'c' ); --------------------------------------------- c
+     It.Amperage := Amperage;
+     It.Voltage_Level := Voltage;
+     C3A2001_1.Set( It, C3A2001_1.Power_Off );
+     return It;
+   end Construct;
+ 
+   procedure Flip ( The_Breaker : in out Basic_Breaker ) is
+   begin
+     TCTouch.Touch( 'd' ); --------------------------------------------- d
+     case Status_Of( The_Breaker ) is
+       when C3A2001_1.Power_Off =>
+         C3A2001_1.Set( The_Breaker, C3A2001_1.Power_On );
+       when C3A2001_1.Power_On =>
+         C3A2001_1.Set( The_Breaker, C3A2001_1.Power_Off );
+       when C3A2001_1.Tripped | C3A2001_1.Failed  => null;
+     end case;
+   end Flip;
+ 
+   procedure Trip ( The_Breaker : in out Basic_Breaker ) is
+   begin
+     TCTouch.Touch( 'e' ); --------------------------------------------- e
+     C3A2001_1.Set( The_Breaker, C3A2001_1.Tripped );
+   end Trip;
+ 
+   procedure Reset( The_Breaker : in out Basic_Breaker ) is
+   begin
+     TCTouch.Touch( 'f' ); --------------------------------------------- f
+     case Status_Of( The_Breaker ) is
+       when C3A2001_1.Power_Off | C3A2001_1.Tripped =>
+         C3A2001_1.Set( The_Breaker, C3A2001_1.Power_On );
+       when C3A2001_1.Power_On  | C3A2001_1.Failed  => null;
+     end case;
+   end Reset;
+ 
+ end C3A2001_2;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with C3A2001_1,C3A2001_2;
+ package C3A2001_3 is
+   use type C3A2001_1.Status;
+ 
+   type Ground_Fault is new C3A2001_2.Basic_Breaker with private;
+ 
+   function Construct( Voltage  : C3A2001_2.Voltages;
+                       Amperage : C3A2001_2.Amps )
+     return Ground_Fault;
+ 
+   procedure Set_Trip( The_Breaker : in out Ground_Fault;
+                       Capacitance : in     Integer );
+ 
+ private
+   type Ground_Fault is new C3A2001_2.Basic_Breaker with record
+     Capacitance : Integer;
+   end record;
+ end C3A2001_3;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with TCTouch;
+ package body C3A2001_3 is
+ 
+   function Construct( Voltage  : C3A2001_2.Voltages;
+                       Amperage : C3A2001_2.Amps )
+     return Ground_Fault is
+   begin
+     TCTouch.Touch( 'g' ); --------------------------------------------- g
+     return ( C3A2001_2.Construct( Voltage, Amperage )
+              with Capacitance => 0 );
+   end Construct;
+ 
+ 
+   procedure Set_Trip( The_Breaker : in out Ground_Fault;
+                       Capacitance : in     Integer ) is
+   begin
+     TCTouch.Touch( 'h' ); --------------------------------------------- h
+     The_Breaker.Capacitance := Capacitance;
+   end Set_Trip;
+ 
+ end C3A2001_3;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with C3A2001_1, C3A2001_2;
+ package C3A2001_4 is
+ 
+   type Special_Breaker is new C3A2001_2.Basic_Breaker with private;
+ 
+   function Construct( Voltage     : C3A2001_2.Voltages;
+                       Amperage    : C3A2001_2.Amps )
+     return Special_Breaker;
+ 
+   procedure Flip ( The_Breaker : in out Special_Breaker );
+   procedure Trip ( The_Breaker : in out Special_Breaker );
+   procedure Reset( The_Breaker : in out Special_Breaker );
+   procedure Fail ( The_Breaker : in out Special_Breaker );
+ 
+   function Status_Of( The_Breaker : Special_Breaker ) return C3A2001_1.Status;
+   function On_Backup( The_Breaker : Special_Breaker ) return Boolean;
+ 
+ private
+   type Special_Breaker is new C3A2001_2.Basic_Breaker with record
+     Backup : C3A2001_2.Basic_Breaker;
+   end record;
+ end C3A2001_4;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with TCTouch;
+ package body C3A2001_4 is
+ 
+   function Construct( Voltage     : C3A2001_2.Voltages;
+                       Amperage    : C3A2001_2.Amps )
+     return Special_Breaker is
+     It: Special_Breaker;
+     procedure Set_Root( It: in out C3A2001_2.Basic_Breaker ) is
+     begin
+       It := C3A2001_2.Construct( Voltage, Amperage );
+     end Set_Root;
+   begin
+     TCTouch.Touch( 'i' ); --------------------------------------------- i
+     Set_Root( C3A2001_2.Basic_Breaker( It ) );
+     Set_Root( It.Backup );
+     return It;
+   end Construct;
+ 
+   function Status_Of( It: C3A2001_1.Breaker ) return C3A2001_1.Status
+     renames C3A2001_1.Status_Of;
+ 
+   procedure Flip ( The_Breaker : in out Special_Breaker ) is
+   begin
+     TCTouch.Touch( 'j' ); --------------------------------------------- j
+     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+       when C3A2001_1.Power_Off | C3A2001_1.Power_On =>
+         C3A2001_2.Flip( C3A2001_2.Basic_Breaker( The_Breaker ) );
+       when others =>
+         C3A2001_2.Flip( The_Breaker.Backup );
+     end case;
+   end Flip;
+ 
+   procedure Trip ( The_Breaker : in out Special_Breaker ) is
+   begin
+     TCTouch.Touch( 'k' ); --------------------------------------------- k
+     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+       when C3A2001_1.Power_Off => null;
+       when C3A2001_1.Power_On  =>
+         C3A2001_2.Reset( The_Breaker.Backup );
+         C3A2001_2.Trip( C3A2001_2.Basic_Breaker( The_Breaker ) );
+       when others =>
+         C3A2001_2.Trip( The_Breaker.Backup );
+     end case;
+   end Trip;
+ 
+   procedure Reset( The_Breaker : in out Special_Breaker ) is
+   begin
+     TCTouch.Touch( 'l' ); --------------------------------------------- l
+     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+       when C3A2001_1.Tripped  =>
+         C3A2001_2.Reset( C3A2001_2.Basic_Breaker( The_Breaker ));
+       when C3A2001_1.Failed  =>
+         C3A2001_2.Reset( The_Breaker.Backup );
+       when C3A2001_1.Power_On | C3A2001_1.Power_Off =>
+         null;
+     end case;
+   end Reset;
+ 
+   procedure Fail ( The_Breaker : in out Special_Breaker ) is
+   begin
+     TCTouch.Touch( 'm' ); --------------------------------------------- m
+     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+       when C3A2001_1.Failed  =>
+         C3A2001_2.Fail( The_Breaker.Backup );
+       when others => 
+         C3A2001_2.Fail( C3A2001_2.Basic_Breaker( The_Breaker ));
+         C3A2001_2.Reset( The_Breaker.Backup );
+     end case;
+   end Fail;
+ 
+   function Status_Of( The_Breaker : Special_Breaker )
+     return C3A2001_1.Status is
+   begin
+     TCTouch.Touch( 'n' ); --------------------------------------------- n
+     case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+       when C3A2001_1.Power_On  => return C3A2001_1.Power_On;
+       when C3A2001_1.Power_Off => return C3A2001_1.Power_Off;
+       when others =>
+         return C3A2001_2.Status_Of( The_Breaker.Backup );
+     end case;
+   end Status_Of;
+ 
+   function On_Backup( The_Breaker : Special_Breaker ) return Boolean is
+     use C3A2001_2;
+     use type C3A2001_1.Status;
+   begin
+     return Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Tripped
+         or Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Failed;
+   end On_Backup;
+ 
+ end C3A2001_4;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with C3A2001_1;
+ package C3A2001_5 is
+ 
+   type Component is access C3A2001_1.Breaker'Class;
+ 
+   type Circuit;
+   type Connection is access Circuit;
+ 
+   type Circuit is record
+     The_Gadget : Component;
+     Next : Connection;
+   end record;
+ 
+   procedure Flipper( The_Circuit : Connection );
+   procedure Tripper( The_Circuit : Connection );
+   procedure Restore( The_Circuit : Connection );
+   procedure Failure( The_Circuit : Connection );
+ 
+   Short : Connection := null;
+ 
+ end C3A2001_5;
+ 
+ ----------------------------------------------------------------------------
+ with Report;
+ with TCTouch;
+ with C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4;
+ 
+ pragma Elaborate_All( Report, TCTouch,
+                       C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4 );
+ 
+ package body C3A2001_5 is
+ 
+   function Neww( Breaker: in C3A2001_1.Breaker'Class )
+     return Component is
+   begin
+     return new C3A2001_1.Breaker'Class'( Breaker );
+   end Neww;
+ 
+   procedure Add( Gadget     : in     Component;
+                  To_Circuit : in out Connection) is
+   begin
+     To_Circuit := new Circuit'(Gadget,To_Circuit);
+   end Add;
+ 
+   procedure Flipper( The_Circuit : Connection ) is
+     Probe : Connection := The_Circuit;
+   begin
+     while Probe /= null loop
+       C3A2001_1.Flip( Probe.The_Gadget.all );
+       Probe := Probe.Next;
+     end loop;
+   end Flipper;
+ 
+   procedure Tripper( The_Circuit : Connection ) is
+     Probe : Connection := The_Circuit;
+   begin
+     while Probe /= null loop
+       C3A2001_1.Trip( Probe.The_Gadget.all );
+       Probe := Probe.Next;
+     end loop;
+   end Tripper;
+ 
+   procedure Restore( The_Circuit : Connection ) is
+     Probe : Connection := The_Circuit;
+   begin
+     while Probe /= null loop
+       C3A2001_1.Reset( Probe.The_Gadget.all );
+       Probe := Probe.Next;
+     end loop;
+   end Restore;
+ 
+   procedure Failure( The_Circuit : Connection ) is
+     Probe : Connection := The_Circuit;
+   begin
+     while Probe /= null loop
+       C3A2001_1.Fail( Probe.The_Gadget.all );
+       Probe := Probe.Next;
+     end loop;
+   end Failure;
+ 
+ begin
+   Add( Neww( C3A2001_2.Construct( C3A2001_2.V440, C3A2001_2.A5   )), Short );
+   Add( Neww( C3A2001_3.Construct( C3A2001_2.V110, C3A2001_2.A1   )), Short );
+   Add( Neww( C3A2001_4.Construct( C3A2001_2.V12,  C3A2001_2.A100 )), Short );
+ end C3A2001_5;
+ 
+ ----------------------------------------------------------------------------
+ 
+ with Report;
+ with TCTouch;
+ with C3A2001_5;
+ procedure C3A2001 is
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C3A2001", "Check that an abstract type can be declared " &
+                "and used.  Check actual subprograms dispatch correctly" );
+ 
+   -- This Validate call must be _after_ the call to Report.Test
+   TCTouch.Validate( "cgcicc", "Adding" );
+ 
+   C3A2001_5.Flipper( C3A2001_5.Short );
+   TCTouch.Validate( "jbdbdbdb", "Flipping" );
+ 
+   C3A2001_5.Tripper( C3A2001_5.Short );
+   TCTouch.Validate( "kbfbeee", "Tripping" );
+ 
+   C3A2001_5.Restore( C3A2001_5.Short );
+   TCTouch.Validate( "lbfbfbfb", "Restoring" );
+ 
+   C3A2001_5.Failure( C3A2001_5.Short );
+   TCTouch.Validate( "mbafbaa", "Circuits Failing" );
+ 
+   Report.Result;
+ 
+ end C3A2001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,295 ----
+ -- C3A2002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for X'Access of a general access type A, Program_Error is
+ --      raised if the accessibility level of X is deeper than that of A.
+ --      Check for the case where X denotes a view that is a dereference of an
+ --      access parameter, or a rename thereof.
+ --      
+ --      Check for cases where the actual corresponding to X is:
+ --         (a) An allocator.
+ --         (b) An expression of a named access type.
+ --         (c) Obj'Access.
+ --      
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the designated
+ --      object X must be at the same or a less deep nesting level than the
+ --      general access type A -- X must "live" as long as A. Nesting
+ --      levels are the run-time nestings of masters: block statements;
+ --      subprogram, task, and entry bodies; and accept statements. Packages
+ --      are invisible to accessibility rules.
+ --
+ --      This test declares subprograms with access parameters, within which
+ --      'Access is attempted on a dereference of the access parameter, and
+ --      assigned to an access object whose type A is declared at some nesting
+ --      level. The test verifies that Program_Error is raised if the actual
+ --      corresponding to the access parameter is:
+ --
+ --         (1) an allocator, and the accessibility level of the execution
+ --             of the called subprogram is deeper than that of the access
+ --             type A. 
+ --
+ --         (2) an expression of a named access type, and the accessibility
+ --             level of the named access type is deeper than that of the
+ --             access type A. 
+ --
+ --         (3) a reference to the Access attribute (e.g., X'Access), and
+ --             the accessibility level of X is deeper than that of the
+ --             access type A. 
+ --
+ --      Note that the static nesting level of the actual corresponding to the
+ --      access parameter can be deeper than that of the type A -- it is
+ --      the run-time nesting that matters for accessibility rules. Consider
+ --      the case where the access type A is declared within the called
+ --      subprogram. The accessibility check will never fail, even if the
+ --      actual happens to have a deeper static nesting level:
+ --
+ --         procedure P (X: access T) is
+ --            type A is access all T;   -- Static level = 2, e.g.
+ --            Acc : A := X.all'Access;  -- Check should never fail.
+ --         begin null; end;
+ --         . . .
+ --         declare
+ --            Actual : aliased T;       -- Static level = 3, e.g.
+ --         begin
+ --            P (Actual'Access);
+ --         end;
+ --
+ --         For the execution of P, the accessibility level of type A will
+ --         always be deeper than that of Actual, so there is no danger of a
+ --         dangling reference arising from the assignment to Acc. Thus,
+ --         X.all'Access is safe, even though the static nesting level of
+ --         Actual is deeper than that of A.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C3A2002_0 is
+ 
+    type Desig is array (1 .. 10) of Integer;
+ 
+    X0 : aliased Desig;                                            -- Level = 0.
+ 
+    type Acc_L0 is access all Desig;                               -- Level = 0.
+    A0 : Acc_L0;
+ 
+    type Result_Kind is (OK, P_E, O_E);
+ 
+    procedure A_Is_Level_0 (X: access Desig; R : out Result_Kind);
+    procedure Never_Fails  (X: access Desig; R : out Result_Kind);
+ 
+ end C3A2002_0;
+ 
+ 
+      --==================================================================--
+ 
+ package body C3A2002_0 is
+ 
+    procedure A_Is_Level_0 (X : access Desig;
+                            R : out Result_Kind) is
+    begin
+       -- The accessibility level of the type of A0 is 0.
+       A0 := X.all'Access;
+       R  := OK;
+    exception
+       when Program_Error =>    
+          R := P_E;
+       when others        =>    
+          R := O_E;
+    end A_Is_Level_0;
+ 
+    -----------------------------------------------
+    procedure Never_Fails (X: access Desig;
+                           R : out Result_Kind) is
+       type Acc_Local is access all Desig;
+       AL : Acc_Local;
+    begin
+       -- X.all'Access below will always be safe, since the accessibility
+       -- level (although not necessarily the static nesting depth) of the
+       -- type of AL will always be deeper than or the same as that of the 
+       -- actual corresponding to Y. 
+       AL := X.all'Access;
+       R  := OK;
+    exception
+       when Program_Error =>    
+          R := P_E;
+       when others        =>    
+          R := O_E;
+    end Never_Fails;
+ 
+ end C3A2002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C3A2002_0;
+ with Report;
+ 
+ procedure C3A2002 is
+ 
+    X1 : aliased C3A2002_0.Desig;                                  -- Level = 1.
+ 
+    type Acc_L1 is access all C3A2002_0.Desig;                     -- Level = 1.
+    A1 : Acc_L1;
+ 
+    Expr_L0 : C3A2002_0.Acc_L0 := C3A2002_0.X0'Access;
+    Expr_L1 : Acc_L1           := X1'Access;
+ 
+    Res : C3A2002_0.Result_Kind;
+ 
+    use type C3A2002_0.Result_Kind;
+ 
+    -----------------------------------------------
+    procedure A_Is_Level_1 (X : access C3A2002_0.Desig;
+                            R : out C3A2002_0.Result_Kind) is
+       -- Dereference of an access_to_object value is aliased.
+       Ren : C3A2002_0.Desig renames X.all;      -- Renaming of a dereference
+    begin                                        -- of an access parameter.
+       -- The accessibility level of the type of A1 is 1.
+       A1 := Ren'Access;
+       R  := C3A2002_0.OK;
+    exception
+       when Program_Error =>    
+          R := C3A2002_0.P_E;
+       when others        =>    
+          R := C3A2002_0.O_E;
+    end A_Is_Level_1;
+ 
+    -----------------------------------------------
+    procedure Display_Results (Result  : in C3A2002_0.Result_Kind;
+                               Expected: in C3A2002_0.Result_Kind;
+                               Message : in String) is
+    begin
+       if Result /= Expected then
+          case Result is
+             when C3A2002_0.OK  => Report.Failed ("No exception raised: "  & 
+                                                  Message);
+             when C3A2002_0.P_E => Report.Failed ("Program_Error raised: " & 
+                                                  Message);
+             when C3A2002_0.O_E => Report.Failed ("Unexpected exception "  &
+                                                  "raised: " & Message);
+          end case;
+       end if;
+    end Display_Results;
+ 
+ begin -- C3A2002 
+ 
+    Report.Test ("C3A2002", "Check that, for X'Access of general access "   &
+                 "type A, Program_Error is raised if the accessibility "    &
+                 "level of X is deeper than that of A: X is an access "     &
+                 "parameter; corresponding actual is an allocator, "        &
+                 "expression of a named access type, Obj'Access, or a "     &
+                 "rename thereof");
+ 
+ 
+    -- Actual is X'Access:
+ 
+    C3A2002_0.Never_Fails (C3A2002_0.X0'Access, Res);
+    Display_Results (Res, C3A2002_0.OK, "X0'Access, local access type");
+ 
+    C3A2002_0.A_Is_Level_0 (C3A2002_0.X0'Access, Res);
+    Display_Results (Res, C3A2002_0.OK, "X0'Access, level 0 access type");
+ 
+    C3A2002_0.A_Is_Level_0 (X1'Access, Res);
+    Display_Results (Res, C3A2002_0.P_E, "X1'Access, level 0 access type");
+ 
+    A_Is_Level_1 (X1'Access, Res);
+    Display_Results (Res, C3A2002_0.OK, "X1'Access, level 1 access type");
+ 
+ 
+    -- Actual is expression of a named access type:
+ 
+    C3A2002_0.Never_Fails (Expr_L1, Res);
+    Display_Results (Res, C3A2002_0.OK, "Expr_L1, local access type");
+ 
+    C3A2002_0.A_Is_Level_0 (Expr_L1, Res);
+    Display_Results (Res, C3A2002_0.P_E, "Expr_L1, level 0 access type");
+ 
+    A_Is_Level_1 (Expr_L0, Res);
+    Display_Results (Res, C3A2002_0.OK, "Expr_L0, level 1 access type");
+ 
+    A_Is_Level_1 (Expr_L1, Res);
+    Display_Results (Res, C3A2002_0.OK, "Expr_L1, level 1 access type");
+ 
+    -- Actual is allocator (level of execution = 2):
+ 
+    C3A2002_0.Never_Fails (new C3A2002_0.Desig, Res);
+    Display_Results (Res, C3A2002_0.OK, "Allocator level 2, " &
+                                        "local access type");
+ 
+    -- Since actual is an allocator, its accessibility level is that of
+    -- the execution of the called subprogram, i.e., level 2.
+ 
+    C3A2002_0.A_Is_Level_0 (new C3A2002_0.Desig, Res);
+    Display_Results (Res, C3A2002_0.P_E, "Allocator level 2, " &
+                                         "level 0 access type");
+ 
+    A_Is_Level_1 (new C3A2002_0.Desig, Res);
+    Display_Results (Res, C3A2002_0.P_E, "Allocator level 2, " &
+                                         "level 1 access type");
+ 
+ 
+    Block_L2:
+    declare
+       X2 : aliased C3A2002_0.Desig;                               -- Level = 2.
+       type Acc_L2 is access all C3A2002_0.Desig;                  -- Level = 2.
+       Expr_L2 : Acc_L2 := X1'Access;
+    begin
+ 
+       -- Actual is X'Access:
+ 
+       C3A2002_0.Never_Fails (X2'Access, Res);
+       Display_Results (Res, C3A2002_0.OK, "X2'Access, local access type");
+ 
+       C3A2002_0.A_Is_Level_0 (X2'Access, Res);
+       Display_Results (Res, C3A2002_0.P_E, "X2'Access, level 0 access type");
+ 
+ 
+       -- Actual is expression of a named access type:
+ 
+       A_Is_Level_1 (Expr_L2, Res);
+       Display_Results (Res, C3A2002_0.P_E, "Expr_L2, level 1 access type");
+ 
+ 
+       -- Actual is allocator (level of execution = 3):
+ 
+       C3A2002_0.Never_Fails (new C3A2002_0.Desig, Res);
+       Display_Results (Res, C3A2002_0.OK, "Allocator level 3, " &
+                                           "local access type");
+ 
+       A_Is_Level_1 (new C3A2002_0.Desig, Res);
+       Display_Results (Res, C3A2002_0.P_E, "Allocator level 3, " &
+                                            "level 1 access type");
+ 
+    end Block_L2;
+ 
+    Report.Result;
+ 
+ end C3A2002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,329 ----
+ -- C3A2003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for X'Access of a general access type A, Program_Error is
+ --      raised if the accessibility level of X is deeper than that of A.
+ --      Check for the case where X denotes a view that is a dereference of an
+ --      access parameter, or a rename thereof. Check for the case where X is
+ --      an access parameter and the corresponding actual is another access
+ --      parameter.
+ --
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the designated
+ --      object X must be at the same or a less deep nesting level than the
+ --      general access type A -- X must "live" as long as A. Nesting
+ --      levels are the run-time nestings of masters: block statements;
+ --      subprogram, task, and entry bodies; and accept statements. Packages
+ --      are invisible to accessibility rules.
+ --
+ --      This test declares subprograms with access parameters, within which
+ --      'Access is attempted on a dereference of an access parameter, and
+ --      assigned to an access object whose type A is declared at some nesting
+ --      level. The test verifies that Program_Error is raised if the actual
+ --      corresponding to the access parameter is another access parameter,
+ --      and the actual corresponding to this second access parameter is:
+ --
+ --         (1) an expression of a named access type, and the accessibility
+ --             level of the named access type is deeper than that of the
+ --             access type A.
+ --
+ --         (2) a reference to the Access attribute (e.g., X'Access), and
+ --             the accessibility level of X is deeper than that of the
+ --             access type A.
+ --
+ --      Note that the static nesting level of the actual corresponding to the
+ --      access parameter can be deeper than that of the type A -- it is
+ --      the run-time nesting that matters for accessibility rules. Consider
+ --      the case where the access type A is declared within the called
+ --      subprogram. The accessibility check will never fail, even if the
+ --      actual happens to have a deeper static nesting level:
+ --
+ --         procedure P (X: access T) is
+ --            type A is access all T;   -- Static level = 2, e.g.
+ --            Acc : A := X.all'Access;  -- Check should never fail.
+ --         begin null; end;
+ --         . . .
+ --         procedure Q (Y: access T) is
+ --         begin
+ --            P(Y);
+ --         end;
+ --         . . .
+ --         declare
+ --            Actual : aliased T;       -- Static level = 3, e.g.
+ --         begin
+ --            Q (Actual'Access);
+ --         end;
+ --
+ --         For the execution of Q (and hence P), the accessibility level of
+ --         type A will always be deeper than that of Actual, so there is no
+ --         danger of a dangling reference arising from the assignment to
+ --         Acc. Thus, X.all'Access is safe, even though the static nesting
+ --         level of Actual is deeper than that of A.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC   ACVC 2.0
+ --      15 Jul 98   EDS    Avoid optimization.
+ --      28 Jun 02   RLB    Added pragma Elaborate_All (Report);.
+ --!
+ 
+ with report; use report; pragma Elaborate_All (report);
+ package C3A2003_0 is
+ 
+    type Desig is array (1 .. 10) of Integer;
+ 
+    X0 : aliased Desig := (Desig'Range => Ident_Int(3));           -- Level = 0.
+ 
+    type Acc_L0 is access all Desig;                               -- Level = 0.
+    A0 : Acc_L0;
+ 
+    type Result_Kind is (OK, P_E, O_E);
+ 
+    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind);
+    procedure Never_Fails_Nest       (Y: access Desig; S: out Result_Kind);
+    procedure Never_Fails_Same       (Y: access Desig; S: out Result_Kind);
+ 
+ end C3A2003_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C3A2003_0 is
+ 
+    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind) is
+ 
+ 
+       -- This procedure utilizes 'Access on a dereference of an access
+       -- parameter, and assigned to an access object whose type A is
+       -- declared at some nesting level.  Program_Error is raised if
+       -- the accessibility level of the operand type is deeper than that
+       -- of the target type.
+ 
+       procedure Nested (X: access Desig; R: out Result_Kind) is
+          -- Dereference of an access_to_object value is aliased.
+          Ren : Desig renames X.all;                -- Renaming of a dereference
+       begin                                        -- of an access parameter.
+          -- The accessibility level of type A0 is 0.
+          A0 := Ren'Access;
+          R  := OK;
+       exception
+          when Program_Error =>
+             R := P_E;
+          when others        =>
+             R := O_E;
+       end Nested;
+ 
+    begin   -- Target_Is_Level_0_Nest
+       Nested (Y, S);
+    end Target_Is_Level_0_Nest;
+ 
+    ------------------------------------------------------------------
+ 
+    procedure Never_Fails_Nest (Y: access Desig; S: out Result_Kind) is
+ 
+       type Acc_Deeper is access all Desig;
+       AD : Acc_Deeper;
+ 
+       function Nested (X: access Desig) return Result_Kind is
+       begin
+          -- X.all'Access below will always be safe, since the accessibility
+          -- level (although not necessarily the static nesting depth) of the
+          -- type of AD will always be deeper than or the same as that of the
+          -- actual corresponding to Y.
+          AD := X.all'Access;
+          if Ident_Int (AD(4)) /= 3 then            --Avoid Optimization of AD
+            FAILED ("Initial Values not correct.");
+          end if;
+          return OK;
+       exception
+          when Program_Error =>
+             return P_E;
+          when others        =>
+             return O_E;
+       end Nested;
+ 
+    begin  -- Never_Fails_Nest
+       S := Nested (Y);
+    end Never_Fails_Nest;
+ 
+    ------------------------------------------------------------------
+ 
+    procedure Called_By_Never_Fails_Same
+      (X: access Desig; R: out Result_Kind) is
+       type Acc_Local is access all Desig;
+       AL : Acc_Local;
+ 
+       -- Dereference of an access_to_object value is aliased.
+       Ren : Desig renames X.all;                   -- Renaming of a dereference
+    begin                                           -- of an access parameter.
+       -- Ren'Access below will always be safe, since the accessibility
+       -- level (although not necessarily the static nesting depth) of
+       -- type of AL will always be deeper than or the same as that of the
+       -- actual corresponding to Y.
+       AL := Ren'Access;
+       if Ident_Int (AL(4)) /= 3 then       --Avoid Optimization of AL
+         FAILED ("Initial Values not correct.");
+       end if;
+       R  := OK;
+    exception
+       when Program_Error =>
+          R := P_E;
+       when others        =>
+          R := O_E;
+    end Called_By_Never_Fails_Same;
+ 
+    ------------------------------------------------------------------
+ 
+    procedure Never_Fails_Same (Y: access Desig; S: out Result_Kind) is
+    begin
+       Called_By_Never_Fails_Same (Y, S);
+    end Never_Fails_Same;
+ 
+ end C3A2003_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C3A2003_0;
+ use  C3A2003_0;
+ 
+ with Report; use report;
+ 
+ procedure C3A2003 is
+ 
+    type Acc_L1 is access all Desig;                               -- Level = 1.
+    A1  : Acc_L1;
+    X1 : aliased Desig := (Desig'Range => Ident_Int(3));
+    Res : Result_Kind;
+ 
+ 
+    procedure Called_By_Target_L1 (X: access Desig; R: out Result_Kind) is
+    begin
+       -- The accessibility level of the type of A1 is 1.
+       A1 := X.all'Access;
+       if IDENT_INT (A1(4)) /= 3 then       --Avoid optimization of A1
+         FAILED ("Initial values not correct.");
+       end if;
+       R  := OK;
+    exception
+       when Program_Error =>
+          R := P_E;
+       when others        =>
+          R := O_E;
+    end Called_By_Target_L1;
+ 
+    ------------------------------------------------------------------
+ 
+    function Target_Is_Level_1_Same (Y: access Desig) return Result_Kind is
+       S : Result_Kind;
+    begin
+       Called_By_Target_L1 (Y, S);
+       return S;
+    end Target_Is_Level_1_Same;
+ 
+    ------------------------------------------------------------------
+ 
+    procedure Display_Results (Result  : in Result_Kind;
+                               Expected: in Result_Kind;
+                               Msg     : in String) is
+    begin
+       if Result /= Expected then
+          case Result is
+             when OK  => Report.Failed ("No exception raised: "         & Msg);
+             when P_E => Report.Failed ("Program_Error raised: "        & Msg);
+             when O_E => Report.Failed ("Unexpected exception raised: " & Msg);
+          end case;
+       end if;
+    end Display_Results;
+ 
+ begin -- C3A2003
+ 
+    Report.Test ("C3A2003", "Check that, for X'Access of general access "   &
+                 "type A, Program_Error is raised if the accessibility "    &
+                 "level of X is deeper than that of A: X is an access "     &
+                 "parameter; corresponding actual is another access "       &
+                 "parameter");
+ 
+ 
+    -- Accessibility level of actual is 0 (actual is X'Access):
+ 
+    Never_Fails_Same (X0'Access, Res);
+    Display_Results (Res, OK, "Never_Fails_Same, level 0 actual");
+ 
+    Never_Fails_Nest (X0'Access, Res);
+    Display_Results (Res, OK, "Target_L1_Nest, level 0 actual");
+ 
+    Target_Is_Level_0_Nest (X0'Access, Res);
+    Display_Results (Res, OK, "Target_L0_Nest, level 0 actual");
+ 
+    Res := Target_Is_Level_1_Same (X0'Access);
+    Display_Results (Res, OK, "Target_L1_Same, level 0 actual");
+ 
+ 
+    -- Accessibility level of actual is 1 (actual is X'Access):
+ 
+    Never_Fails_Same (X1'Access, Res);
+    Display_Results (Res, OK, "Never_Fails_Same, level 1 actual");
+ 
+    Never_Fails_Nest (X1'Access, Res);
+    Display_Results (Res, OK, "Target_L1_Nest, level 1 actual");
+ 
+    Target_Is_Level_0_Nest (X1'Access, Res);
+    Display_Results (Res, P_E, "Target_L0_Nest, level 1 actual");
+ 
+    Res := Target_Is_Level_1_Same (X1'Access);
+    Display_Results (Res, OK, "Target_L1_Same, level 1 actual");
+ 
+ 
+    Block_L2:
+    declare
+       X2 : aliased Desig := (Desig'Range => Ident_Int(3));
+       type Acc_L2 is access all Desig;                            -- Level = 2.
+       Expr_L2 : Acc_L2 := X2'Access;
+    begin
+ 
+       -- Accessibility level of actual is 2 (actual is expression of named
+       -- access type):
+ 
+       Never_Fails_Same (Expr_L2, Res);
+       Display_Results (Res, OK, "Never_Fails_Same, level 2 actual");
+ 
+       Never_Fails_Nest (Expr_L2, Res);
+       Display_Results (Res, OK, "Target_L1_Nest, level 2 actual");
+ 
+       Target_Is_Level_0_Nest (Expr_L2, Res);
+       Display_Results (Res, P_E, "Target_L0_Nest, level 2 actual");
+ 
+       Res := Target_Is_Level_1_Same (Expr_L2);
+       Display_Results (Res, P_E, "Target_L1_Same, level 2 actual");
+ 
+    end Block_L2;
+ 
+    Report.Result;
+ 
+ end C3A2003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,367 ----
+ -- C3A2A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for X'Access of a general access type A, Program_Error is
+ --      raised if the accessibility level of X is deeper than that of A.
+ --      Check for cases where X'Access occurs in an instance body, and A
+ --      is passed as an actual during instantiation.
+ --
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the designated
+ --      object X must be at the same or a less deep nesting level than the
+ --      general access type A -- X must "live" as long as A. Nesting
+ --      levels are the run-time nestings of masters: block statements;
+ --      subprogram, task, and entry bodies; and accept statements. Packages
+ --      are invisible to accessibility rules.
+ --
+ --      This test declares three generic units, each of which has a formal
+ --      general access type:
+ --
+ --         (1) A generic package, in which X is declared in the specification,
+ --             and X'Access occurs within the declarative part of the body.
+ --
+ --         (2) A generic package, in which X is a formal in out object of a
+ --             tagged formal derived type, and X'Access occurs in the sequence
+ --             of statements of a nested subprogram.
+ --
+ --         (3) A generic procedure, in which X is a dereference of an access
+ --             parameter, and X'Access occurs in the sequence of statements.
+ --
+ --      The test verifies the following:
+ --
+ --         For (1), Program_Error is raised upon instantiation if the generic
+ --         package is instantiated at a deeper level than that of the general
+ --         access type passed as an actual. The exception is propagated to the
+ --         innermost enclosing master.
+ --
+ --         For (2), Program_Error is raised when the nested subprogram is
+ --         called if the object passed as an actual during instantiation of
+ --         the generic package has an accessibility level deeper than that of
+ --         the general access type passed as an actual. The exception is
+ --         handled within the nested subprogram. Also, check that
+ --         Program_Error is not raised if the level of the actual access type
+ --         is deeper than that of the actual object.
+ --
+ --         For (3), Program_Error is raised when the instance subprogram is
+ --         called if the object pointed to by the actual corresponding to
+ --         the access parameter has an accessibility level deeper than that of
+ --         the general access type passed as an actual during instantiation.
+ --         The exception is handled within the instance subprogram. Also,
+ --         check that Program_Error is not raised if the level of the actual
+ --         access type is deeper than that of the actual corresponding to the
+ --         access parameter.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F3A2A00.A
+ --      -> C3A2A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      12 May 95   SAIC    Initial prerelease version.
+ --      10 Jul 95   SAIC    Modified code to avoid dead variable optimization.
+ --
+ --!
+ 
+ with F3A2A00;
+ generic
+    type FD  is new F3A2A00.Array_Type;
+    type FAF is access all FD;
+ package C3A2A01_0 is
+    X : aliased FD;
+ 
+    procedure Dummy;  -- Needed to allow package body.
+ end C3A2A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C3A2A01_0 is
+    Ptr   : FAF     := X'Access;
+    Index : Integer := F3A2A00.Array_Type'First;
+ 
+    procedure Dummy is
+    begin
+       null;
+    end Dummy;
+ begin
+    -- Avoid optimization (dead variable removal of Ptr):
+ 
+    if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
+       Report.Failed ("Unexpected error in C3A2A01_0 instance");
+    end if;
+ end C3A2A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F3A2A00;
+ generic
+    type FD  is new F3A2A00.Tagged_Type with private;
+    type FAF is access all FD;
+    FObj : in out FD;
+ package C3A2A01_1 is
+    procedure Handle (R: out F3A2A00.TC_Result_Kind);
+ end C3A2A01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C3A2A01_1 is
+ 
+    procedure Handle (R: out F3A2A00.TC_Result_Kind) is
+       Ptr : FAF;
+    begin
+       Ptr := FObj'Access;
+       R   := F3A2A00.OK;
+ 
+       -- Avoid optimization (dead variable removal of Ptr):
+ 
+       if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
+          Report.Failed ("Unexpected error in Handle");
+       end if;
+    exception
+       when Program_Error => R := F3A2A00.P_E;
+       when others        => R := F3A2A00.O_E;
+    end Handle;
+ 
+ end C3A2A01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F3A2A00;
+ generic
+    type FD  is new F3A2A00.Array_Type;
+    type FAF is access all FD;
+ procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind) is
+    Ptr   : FAF;
+    Index : Integer := F3A2A00.Array_Type'First;
+ begin
+    Ptr := P.all'Access;
+    R   := F3A2A00.OK;
+ 
+    -- Avoid optimization (dead variable removal of Ptr):
+ 
+    if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
+       Report.Failed ("Unexpected error in C3A2A01_2 instance");
+    end if;
+ exception
+    when Program_Error => R := F3A2A00.P_E;
+    when others        => R := F3A2A00.O_E;
+ end C3A2A01_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F3A2A00;
+ with C3A2A01_0;
+ with C3A2A01_1;
+ with C3A2A01_2;
+ 
+ with Report;
+ procedure C3A2A01 is
+ begin -- C3A2A01.                                              -- [ Level = 1 ]
+ 
+    Report.Test ("C3A2A01", "Run-time accessibility checks: instance " &
+                 "bodies. Type of X'Access is passed as actual to instance");
+ 
+ 
+    SUBTEST1:
+    declare                                                     -- [ Level = 2 ]
+       Result : F3A2A00.TC_Result_Kind;
+    begin -- SUBTEST1.
+ 
+       declare                                                  -- [ Level = 3 ]
+          type AccArr_L3 is access all F3A2A00.Array_Type;
+       begin
+          declare                                               -- [ Level = 4 ]
+             -- The accessibility level of Pack.X is that of the instantiation
+             -- (4). The accessibility level of the actual access type used to
+             -- instantiate Pack is 3. Therefore, the X'Access in Pack
+             -- propagates Program_Error when the instance body is elaborated:
+ 
+             package Pack is new C3A2A01_0 (F3A2A00.Array_Type, AccArr_L3);
+          begin
+             Result := F3A2A00.OK;
+          end;
+       exception
+          when Program_Error => Result := F3A2A00.P_E;       -- Expected result.
+          when others        => Result := F3A2A00.O_E;
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #1");
+ 
+    end SUBTEST1;
+ 
+ 
+ 
+    SUBTEST2:
+    declare                                                     -- [ Level = 2 ]
+       Result : F3A2A00.TC_Result_Kind;
+    begin -- SUBTEST2.
+ 
+       declare                                                  -- [ Level = 3 ]
+          -- The instantiation of C3A2A01_1 should NOT result in any
+          -- exceptions.
+ 
+          type AccTag_L3 is access all F3A2A00.Tagged_Type;
+ 
+          package Pack_OK is new C3A2A01_1 (F3A2A00.Tagged_Type,
+                                            AccTag_L3,
+                                            F3A2A00.X_L0);
+       begin
+          -- The accessibility level of the actual object used to instantiate
+          -- Pack_OK is 0. The accessibility level of the actual access type
+          -- used to instantiate Pack_OK is 3. Therefore, the FObj'Access in
+          -- Pack_OK.Handle does not raise an exception when the subprogram is
+          -- called. If an exception is (incorrectly) raised, however, it is
+          -- handled within the subprogram:
+ 
+          Pack_OK.Handle (Result);
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result, F3A2A00.OK, "SUBTEST #2");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #2: Program_Error incorrectly raised " &
+                         "during instantiation of generic");
+       when others        =>
+          Report.Failed ("SUBTEST #2: Unexpected exception raised " &
+                         "during instantiation of generic");
+    end SUBTEST2;
+ 
+ 
+ 
+    SUBTEST3:
+    declare                                                     -- [ Level = 2 ]
+       Result : F3A2A00.TC_Result_Kind;
+    begin -- SUBTEST3.
+ 
+       declare                                                  -- [ Level = 3 ]
+          -- The instantiation of C3A2A01_1 should NOT result in any
+          -- exceptions.
+ 
+          X_L3: F3A2A00.Tagged_Type;
+ 
+          package Pack_PE is new C3A2A01_1 (F3A2A00.Tagged_Type,
+                                            F3A2A00.AccTag_L0,
+                                            X_L3);
+       begin
+          -- The accessibility level of the actual object used to instantiate
+          -- Pack_PE is 3. The accessibility level of the actual access type
+          -- used to instantiate Pack_PE is 0. Therefore, the FObj'Access in
+          -- Pack_OK.Handle raises Program_Error when the subprogram is
+          -- called. The exception is handled within the subprogram:
+ 
+          Pack_PE.Handle (Result);
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #3");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #3: Program_Error incorrectly raised " &
+                         "during instantiation of generic");
+       when others        =>
+          Report.Failed ("SUBTEST #3: Unexpected exception raised " &
+                         "during instantiation of generic");
+    end SUBTEST3;
+ 
+ 
+ 
+    SUBTEST4:
+    declare                                                     -- [ Level = 2 ]
+       Result1 : F3A2A00.TC_Result_Kind;
+       Result2 : F3A2A00.TC_Result_Kind;
+    begin -- SUBTEST4.
+ 
+       declare                                                  -- [ Level = 3 ]
+          -- The instantiation of C3A2A01_2 should NOT result in any
+          -- exceptions.
+ 
+          X_L3: aliased F3A2A00.Array_Type;
+          type AccArr_L3 is access all F3A2A00.Array_Type;
+ 
+          procedure Proc is new C3A2A01_2 (F3A2A00.Array_Type, AccArr_L3);
+       begin
+          -- The accessibility level of Proc.P.all is that of the corresponding
+          -- actual during the call (in this case 3). The accessibility level of
+          -- the access type used to instantiate Proc is also 3. Therefore, the
+          -- P.all'Access in Proc does not raise an exception when the
+          -- subprogram is called. If an exception is (incorrectly) raised,
+          -- however, it is handled within the subprogram:
+ 
+          Proc (X_L3'Access, Result1);
+ 
+          F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
+                                      "SUBTEST #4: same levels");
+ 
+          declare                                               -- [ Level = 4 ]
+             X_L4: aliased F3A2A00.Array_Type;
+          begin
+             -- Within this block, the accessibility level of the actual
+             -- corresponding to Proc.P.all is 4. Therefore, the P.all'Access
+             -- in Proc raises Program_Error when the subprogram is called. The
+             -- exception is handled within the subprogram:
+ 
+             Proc (X_L4'Access, Result2);
+ 
+             F3A2A00.TC_Display_Results (Result2, F3A2A00.P_E,
+                                         "SUBTEST #4: object at deeper level");
+          end;
+ 
+       end;
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #4: Program_Error incorrectly raised " &
+                         "during instantiation of generic");
+       when others        =>
+          Report.Failed ("SUBTEST #4: Unexpected exception raised " &
+                         "during instantiation of generic");
+    end SUBTEST4;
+ 
+ 
+    Report.Result;
+ 
+ end C3A2A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c3/c3a2a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c3/c3a2a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,396 ----
+ -- C3A2A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for X'Access of a general access type A, Program_Error is
+ --      raised if the accessibility level of X is deeper than that of A.
+ --      Check for cases where X'Access occurs in an instance body, and A
+ --      is a type either declared inside the instance, or declared outside
+ --      the instance but not passed as an actual during instantiation.
+ --
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the designated
+ --      object X must be at the same or a less deep nesting level than the
+ --      general access type A -- X must "live" as long as A. Nesting
+ --      levels are the run-time nestings of masters: block statements;
+ --      subprogram, task, and entry bodies; and accept statements. Packages
+ --      are invisible to accessibility rules.
+ --
+ --      This test declares three generic packages:
+ --
+ --         (1) One in which X is of a formal tagged derived type and declared
+ --             in the body, A is a type declared outside the instance, and
+ --             X'Access occurs in the declarative part of a nested subprogram.
+ --
+ --         (2) One in which X is a formal object of a tagged type, A is a
+ --             type declared outside the instance, and X'Access occurs in the
+ --             declarative part of the body.
+ --
+ --         (3) One in which there are two X's and two A's. In the first pair,
+ --             X is a formal in object of a tagged type, A is declared in the
+ --             specification, and X'Access occurs in the declarative part of
+ --             the body. In the second pair, X is of a formal derived type,
+ --             X and A are declared in the specification, and X'Access occurs
+ --             in the sequence of statements of the body.
+ --
+ --      The test verifies the following:
+ --
+ --         For (1), Program_Error is raised when the nested subprogram is
+ --         called, if the generic package is instantiated at a deeper level
+ --         than that of A. The exception is propagated to the innermost
+ --         enclosing master. Also, check that Program_Error is not raised
+ --         if the instantiation is at the same level as that of A.
+ --
+ --         For (2), Program_Error is raised upon instantiation if the object
+ --         passed as an actual during instantiation has an accessibility level
+ --         deeper than that of A. The exception is propagated to the innermost
+ --         enclosing master. Also, check that Program_Error is not raised if
+ --         the level of the actual object is not deeper than that of A.
+ --
+ --         For (3), Program_Error is not raised, for actual objects at
+ --         various accessibility levels (since A will have at least the same
+ --         accessibility level as X in all cases, no exception should ever
+ --         be raised).
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F3A2A00.A
+ --      -> C3A2A02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      12 May 95   SAIC    Initial prerelease version.
+ --      10 Jul 95   SAIC    Modified code to avoid dead variable optimization.
+ --      26 Jun 98   EDS     Added pragma Elaborate (C3A2A02_0) to package
+ --                          package C3A2A02_3, in order to avoid possible
+ --                          instantiation error.
+ --!
+ 
+ with F3A2A00;
+ generic
+    type FD is new F3A2A00.Tagged_Type with private;
+ package C3A2A02_0 is
+    procedure Proc;
+ end C3A2A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C3A2A02_0 is
+    X : aliased FD;
+ 
+    procedure Proc is
+       Ptr : F3A2A00.AccTagClass_L0 := X'Access;
+    begin
+       -- Avoid optimization (dead variable removal of Ptr):
+ 
+       if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
+          Report.Failed ("Unexpected error in Proc");
+       end if;
+    end Proc;
+ end C3A2A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F3A2A00;
+ generic
+    FObj : in out F3A2A00.Tagged_Type;
+ package C3A2A02_1 is
+    procedure Dummy; -- Needed to allow package body.
+ end C3A2A02_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C3A2A02_1 is
+    Ptr : F3A2A00.AccTag_L0 := FObj'Access;
+ 
+    procedure Dummy is
+    begin
+       null;
+    end Dummy;
+ begin
+    -- Avoid optimization (dead variable removal of Ptr):
+ 
+    if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
+       Report.Failed ("Unexpected error in C3A2A02_1 instance");
+    end if;
+ end C3A2A02_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F3A2A00;
+ generic
+    type FD is new F3A2A00.Array_Type;
+    FObj : in F3A2A00.Tagged_Type;
+ package C3A2A02_2 is
+    type GAF is access all FD;
+    type GAO is access constant F3A2A00.Tagged_Type;
+    XG    : aliased FD;
+    PtrF  : GAF;
+    Index : Integer := FD'First;
+ 
+    procedure Dummy; -- Needed to allow package body.
+ end C3A2A02_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C3A2A02_2 is
+    PtrO : GAO := FObj'Access;
+ 
+    procedure Dummy is
+    begin
+       null;
+    end Dummy;
+ begin
+    PtrF := XG'Access;
+ 
+    -- Avoid optimization (dead variable removal of PtrO and/or PtrF):
+ 
+    if not Report.Equal (PtrO.C, PtrO.C) then                -- Always false.
+       Report.Failed ("Unexpected error in C3A2A02_2 instance: PtrO");
+    end if;
+ 
+    if not Report.Equal (PtrF(Index).C, PtrF(Index).C) then  -- Always false.
+       Report.Failed ("Unexpected error in C3A2A02_2 instance: PtrF");
+    end if;
+ end C3A2A02_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- The instantiation of C3A2A02_0 should NOT result in any exceptions.
+ 
+ with F3A2A00;
+ with C3A2A02_0;
+ pragma Elaborate (C3A2A02_0);
+ package C3A2A02_3 is new C3A2A02_0 (F3A2A00.Tagged_Type);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F3A2A00;
+ with C3A2A02_0;
+ with C3A2A02_1;
+ with C3A2A02_2;
+ with C3A2A02_3;
+ 
+ with Report;
+ procedure C3A2A02 is
+ begin -- C3A2A02.                                              -- [ Level = 1 ]
+ 
+    Report.Test ("C3A2A02", "Run-time accessibility checks: instance " &
+                 "bodies. Type of X'Access is local or global to instance");
+ 
+ 
+    SUBTEST1:
+    declare                                                     -- [ Level = 2 ]
+       Result1 : F3A2A00.TC_Result_Kind;
+       Result2 : F3A2A00.TC_Result_Kind;
+    begin -- SUBTEST1.
+ 
+       declare                                                  -- [ Level = 3 ]
+          package Pack_Same_Level renames C3A2A02_3;
+       begin
+          -- The accessibility level of Pack_Same_Level.X is that of the
+          -- instance (0), not that of the renaming declaration. The level of
+          -- the type of Pack_Same_Level.X'Access (F3A2A00.AccTagClass_L0) is
+          -- 0. Therefore, the X'Access in Pack_Same_Level.Proc does not raise
+          -- an exception when the subprogram is called. The level of execution
+          -- of the subprogram is irrelevant:
+ 
+          Pack_Same_Level.Proc;
+          Result1 := F3A2A00.OK;                             -- Expected result.
+       exception
+          when Program_Error => Result1 := F3A2A00.P_E;
+          when others        => Result1 := F3A2A00.O_E;
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
+                                   "SUBTEST #1 (same level)");
+ 
+ 
+       declare                                                  -- [ Level = 3 ]
+          -- The instantiation of C3A2A02_0 should NOT result in any
+          -- exceptions.
+ 
+          package Pack_Deeper_Level is new C3A2A02_0 (F3A2A00.Tagged_Type);
+       begin
+          -- The accessibility level of Pack_Deeper_Level.X is that of the
+          -- instance (3). The level of the type of Pack_Deeper_Level.X'Access
+          -- (F3A2A00.AccTagClass_L0) is 0. Therefore, the X'Access in
+          -- Pack_Deeper_Level.Proc propagates Program_Error when the
+          -- subprogram is called:
+ 
+          Pack_Deeper_Level.Proc;
+          Result2 := F3A2A00.OK;
+       exception
+          when Program_Error => Result2 := F3A2A00.P_E;      -- Expected result.
+          when others        => Result2 := F3A2A00.O_E;
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result2, F3A2A00.P_E,
+                                   "SUBTEST #1: deeper level");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #1: Program_Error incorrectly raised " &
+                         "during instantiation of generic");
+       when others        =>
+          Report.Failed ("SUBTEST #1: Unexpected exception raised " &
+                         "during instantiation of generic");
+    end SUBTEST1;
+ 
+ 
+ 
+    SUBTEST2:
+    declare                                                     -- [ Level = 2 ]
+       Result1 : F3A2A00.TC_Result_Kind;
+       Result2 : F3A2A00.TC_Result_Kind;
+    begin -- SUBTEST2.
+ 
+       declare                                                  -- [ Level = 3 ]
+          X_L3 : F3A2A00.Tagged_Type;
+       begin
+          declare                                               -- [ Level = 4 ]
+             -- The accessibility level of the actual object corresponding to
+             -- FObj in Pack_PE is 3. The level of the type of FObj'Access
+             -- (F3A2A00.AccTag_L0) is 0. Therefore, the FObj'Access in Pack_PE
+             -- propagates Program_Error when the instance body is elaborated:
+ 
+             package Pack_PE is new C3A2A02_1 (X_L3);
+          begin
+             Result1 := F3A2A00.OK;
+          end;
+       exception
+          when Program_Error => Result1 := F3A2A00.P_E;      -- Expected result.
+          when others        => Result1 := F3A2A00.O_E;
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result1, F3A2A00.P_E,
+                                   "SUBTEST #2: deeper level");
+ 
+ 
+       begin                                                    -- [ Level = 3 ]
+          declare                                               -- [ Level = 4 ]
+             -- The accessibility level of the actual object corresponding to
+             -- FObj in Pack_OK is 0. The level of the type of FObj'Access
+             -- (F3A2A00.AccTag_L0) is also 0. Therefore, the FObj'Access in
+             -- Pack_OK does not raise an exception when the instance body is
+             -- elaborated:
+ 
+             package Pack_OK is new C3A2A02_1 (F3A2A00.X_L0);
+          begin
+             Result2 := F3A2A00.OK;                          -- Expected result.
+          end;
+       exception
+          when Program_Error => Result2 := F3A2A00.P_E;
+          when others        => Result2 := F3A2A00.O_E;
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result2, F3A2A00.OK,
+                                   "SUBTEST #2: same level");
+ 
+    end SUBTEST2;
+ 
+ 
+ 
+    SUBTEST3:
+    declare                                                     -- [ Level = 2 ]
+       Result1 : F3A2A00.TC_Result_Kind;
+       Result2 : F3A2A00.TC_Result_Kind;
+    begin -- SUBTEST3.
+ 
+       declare                                                  -- [ Level = 3 ]
+          X_L3 : F3A2A00.Tagged_Type;
+       begin
+          declare                                               -- [ Level = 4 ]
+             -- Since the accessibility level of the type of X'Access in
+             -- both cases within Pack_OK1 is that of the instance, and since
+             -- X is either passed as an actual (in which case its level will
+             -- not be deeper than that of the instance) or is declared within
+             -- the instance (in which case its level is the same as that of
+             -- the instance), no exception should be raised when the instance
+             -- body is elaborated:
+ 
+             package Pack_OK1 is new C3A2A02_2 (F3A2A00.Array_Type, X_L3);
+          begin
+             Result1 := F3A2A00.OK;                          -- Expected result.
+          end;
+       exception
+          when Program_Error => Result1 := F3A2A00.P_E;
+          when others        => Result1 := F3A2A00.O_E;
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
+                                   "SUBTEST #3: 1st okay case");
+ 
+ 
+       declare                                                  -- [ Level = 3 ]
+          type My_Array is new F3A2A00.Array_Type;
+       begin
+          declare                                               -- [ Level = 4 ]
+             -- Since the accessibility level of the type of X'Access in
+             -- both cases within Pack_OK2 is that of the instance, and since
+             -- X is either passed as an actual (in which case its level will
+             -- not be deeper than that of the instance) or is declared within
+             -- the instance (in which case its level is the same as that of
+             -- the instance), no exception should be raised when the instance
+             -- body is elaborated:
+ 
+             package Pack_OK2 is new C3A2A02_2 (My_Array, F3A2A00.X_L0);
+          begin
+             Result2 := F3A2A00.OK;                          -- Expected result.
+          end;
+       exception
+          when Program_Error => Result2 := F3A2A00.P_E;
+          when others        => Result2 := F3A2A00.O_E;
+       end;
+ 
+       F3A2A00.TC_Display_Results (Result2, F3A2A00.OK,
+                                   "SUBTEST #3: 2nd okay case");
+ 
+ 
+    end SUBTEST3;
+ 
+ 
+ 
+    Report.Result;
+ 
+ end C3A2A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c410001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c410001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c410001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c410001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,303 ----
+ -- C410001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that evaluating an access to subprogram variable containing
+ --      the value null causes the exception Constraint_Error.
+ --      Check that the default value for objects of access to subprogram
+ --      types is null.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines a few simple access_to_subprogram types, and
+ --      objects of those types.  It checks that the default values for
+ --      these objects is null, and that an attempt to make a subprogram
+ --      call via one of this objects containing a null value causes the
+ --      predefined exception Constraint_Error.  The check is performed
+ ---     both with the default null value, and with an explicitly assigned
+ --      null value, after the object has been used to successfully designate
+ --      and call a subprogram.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      05 APR 96   SAIC   Initial version
+ --      04 NOV 96   SAIC   Revised for 2.1 release
+ --      26 FEB 97   PWB.CTA Initialized variable before passing to function
+ --!
+ 
+ ----------------------------------------------------------------- C410001_0
+ 
+ package C410001_0 is
+ 
+   -- used to "switch state" in the software
+   Expect_Exception : Boolean;
+ 
+   -- define a minimal mixture of access_to_subprogram types
+ 
+   type Proc_Ref is access procedure;
+ 
+   type Func_Ref is access function(I:Integer) return Integer;
+ 
+   type Proc_Para_Ref is access procedure(P:Proc_Ref);
+ 
+   type Func_Para_Ref is access function(F:Func_Ref) return Integer;
+ 
+   type Prot_Proc_Ref is access protected procedure;
+ 
+   type Prot_Func_Ref is access protected function return Boolean;
+ 
+   -- define some subprograms for them to reference
+ 
+   procedure Proc;
+ 
+   function Func(I:Integer) return Integer;
+ 
+   procedure Proc_Para( Param : Proc_Ref );
+ 
+   function Func_Para( Param : Func_Ref ) return Integer;
+ 
+   protected Prot_Obj is
+     procedure Prot_Proc;
+     function Prot_Func return Boolean;
+   end Prot_Obj;
+ 
+ end C410001_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C410001_0 is
+ 
+   -- Note that some failing cases will cause duplicate failure messages;
+   -- rather than have the procedure/function bodies be null, the error
+   -- checking code makes for a reasonable anti-optimization feature.
+ 
+   procedure Proc is
+   begin
+     if Expect_Exception then
+       Report.Failed("Expected exception did not occur: Proc");
+     end if;
+   end Proc;
+ 
+   function Func(I:Integer) return Integer is
+   begin
+     if Expect_Exception then
+       Report.Failed("Expected exception did not occur: Func");
+     end if;
+     return Report.Ident_Int(I);
+   end Func;
+ 
+   procedure Proc_Para( Param : Proc_Ref ) is
+   begin
+ 
+     Param.all;        -- call by explicit dereference
+ 
+     if Expect_Exception then
+       Report.Failed("Expected exception did not occur: Proc_Para");
+     end if;
+ 
+   exception
+     when Constraint_Error =>
+       if not Expect_Exception then
+         Report.Failed("Unexpected Constraint_Error: Proc_Para");
+       end if;  -- else null; expected the exception
+     when others => Report.Failed("Unexpected exception: Proc_Para");
+   end Proc_Para;
+ 
+   function Func_Para( Param : Func_Ref ) return Integer is
+   begin
+ 
+     return Param(1);  -- call by implicit dereference
+ 
+     if Expect_Exception then
+       Report.Failed("Expected exception did not occur: Func_Para");
+     end if;
+     return 1;  -- really just to avoid warnings
+ 
+   exception
+     when Constraint_Error =>
+       if not Expect_Exception then
+         Report.Failed("Unexpected Constraint_Error: Func_Para");
+         return 0;
+       else
+         return 1995;  -- any value other than this is unexpected
+       end if;
+     when others => Report.Failed("Unexpected exception: Func_Para");
+                    return -42;
+   end Func_Para;
+ 
+   protected body Prot_Obj is
+ 
+     procedure Prot_Proc is
+     begin
+       if Expect_Exception then
+         Report.Failed("Expected exception did not occur: Prot_Proc");
+       end if;
+     end Prot_Proc;
+ 
+     function Prot_Func return Boolean is
+     begin
+       if Expect_Exception then
+         Report.Failed("Expected exception did not occur: Prot_Func");
+       end if;
+       return Report.Ident_Bool( True );
+     end Prot_Func;
+ 
+   end Prot_Obj;
+ 
+ end C410001_0;
+ 
+ ------------------------------------------------------------------- C410001
+ 
+ with Report;
+ with TCTouch;
+ with C410001_0;
+ procedure C410001 is
+ 
+   Proc_Ref_Var : C410001_0.Proc_Ref;
+ 
+   Func_Ref_Var : C410001_0.Func_Ref;
+ 
+   Proc_Para_Ref_Var : C410001_0.Proc_Para_Ref;
+ 
+   Func_Para_Ref_Var : C410001_0.Func_Para_Ref;
+ 
+   type Enclosure is record
+     Prot_Proc_Ref_Var : C410001_0.Prot_Proc_Ref;
+     Prot_Func_Ref_Var : C410001_0.Prot_Func_Ref;
+   end record;
+ 
+   Enclosed : Enclosure;
+ 
+   Valid_Proc : C410001_0.Proc_Ref := C410001_0.Proc'Access;
+ 
+   Valid_Func : C410001_0.Func_Ref := C410001_0.Func'Access;
+ 
+   procedure Make_Calls( Expecting_Exceptions : Boolean ) is
+     type Case_Numbers is range 1..6;
+     Some_Integer : Integer := 0;
+   begin
+     for Cases in Case_Numbers loop
+       Catch_Exception : begin
+         case Cases is
+           when 1 => Proc_Ref_Var.all;
+           when 2 => Some_Integer := Func_Ref_Var.all( Some_Integer );
+           when 3 => Proc_Para_Ref_Var( Valid_Proc );
+           when 4 => Some_Integer := Func_Para_Ref_Var( Valid_Func );
+           when 5 => Enclosed.Prot_Proc_Ref_Var.all;
+           when 6 => TCTouch.Assert( Enclosed.Prot_Func_Ref_Var.all
+                                     /= Expecting_Exceptions,
+                                     "Case 6");
+         end case;
+         if Expecting_Exceptions then
+           Report.Failed("Exception expected: Case"
+                         & Case_Numbers'Image(Cases) );
+         end if;
+       exception
+         when Constraint_Error =>
+           if not Expecting_Exceptions then
+             Report.Failed("Constraint_Error not expected: Case"
+                           & Case_Numbers'Image(Cases) );
+           end if;
+         when others =>
+           Report.Failed("Wrong/Bad Exception: Case"
+                         & Case_Numbers'Image(Cases) );
+       end Catch_Exception;
+     end loop;
+   end Make_Calls;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C410001", "Check that evaluating an access to subprogram " &
+                           "variable containing the value null causes the " &
+                           "exception Constraint_Error. Check that the " &
+                           "default value for objects of access to " &
+                           "subprogram types is null" );
+    
+   -- check that the default values are null
+   declare
+     use C410001_0; -- make all "="'s visible for all types
+   begin
+     TCTouch.Assert( Proc_Ref_Var = null, "Proc_Ref_Var = null" );
+ 
+     TCTouch.Assert( Func_Ref_Var = null, "Func_Ref_Var = null" );
+ 
+     TCTouch.Assert( Proc_Para_Ref_Var = null, "Proc_Para_Ref_Var = null" );
+ 
+     TCTouch.Assert( Func_Para_Ref_Var = null, "Func_Para_Ref_Var = null" );
+ 
+     TCTouch.Assert( Enclosed.Prot_Proc_Ref_Var = null,
+                    "Enclosed.Prot_Proc_Ref_Var = null" );
+ 
+     TCTouch.Assert( Enclosed.Prot_Func_Ref_Var = null,
+                    "Enclosed.Prot_Func_Ref_Var = null" );
+   end;
+ 
+   -- check that calls via the default values cause Constraint_Error
+ 
+   C410001_0.Expect_Exception := True;
+ 
+   Make_Calls( Expecting_Exceptions => True );
+ 
+   -- assign non-null values to the objects
+ 
+   Proc_Ref_Var      := C410001_0.Proc'Access;
+   Func_Ref_Var      := C410001_0.Func'Access;
+   Proc_Para_Ref_Var := C410001_0.Proc_Para'Access;
+   Func_Para_Ref_Var := C410001_0.Func_Para'Access;
+   Enclosed          := (C410001_0.Prot_Obj.Prot_Proc'Access,
+                         C410001_0.Prot_Obj.Prot_Func'Access);
+ 
+   -- check that the calls perform normally
+ 
+   C410001_0.Expect_Exception := False;
+ 
+   Make_Calls( Expecting_Exceptions => False );
+ 
+   -- check that a passed null value causes Constraint_Error
+ 
+   C410001_0.Expect_Exception := True;
+ 
+   Proc_Para_Ref_Var( null );
+ 
+   TCTouch.Assert( Func_Para_Ref_Var( null ) = 1995,
+                  "Func_Para_Ref_Var( null )");
+ 
+   -- assign the null value to the objects
+ 
+   Proc_Ref_Var      := null;
+   Func_Ref_Var      := null;
+   Proc_Para_Ref_Var := null;
+   Func_Para_Ref_Var := null;
+   Enclosed          := (null,null);
+ 
+   -- check that calls now again cause Constraint_Error
+ 
+   C410001_0.Expect_Exception := True;
+ 
+   Make_Calls( Expecting_Exceptions => True );
+ 
+   Report.Result;
+ 
+ end C410001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41101d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41101d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41101d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41101d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C41101D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR INDEXED COMPONENTS OF THE FORM F(...), CHECK THAT 
+ --   THE NUMBER OF INDEX VALUES, THE TYPE OF THE INDEX
+ --   VALUES, AND THE REQUIRED TYPE OF THE INDEXED COMPONENT
+ --   ARE USED TO RESOLVE AN OVERLOADING OF F.
+ 
+ -- WKB 8/12/81
+ -- JBG 10/12/81
+ -- SPS 11/1/82
+ 
+ WITH REPORT;
+ PROCEDURE C41101D IS
+ 
+      USE REPORT;
+ 
+      TYPE T1 IS ARRAY (1..10) OF INTEGER;
+      TYPE T2 IS ARRAY (1..10, 1..10) OF INTEGER;
+      I : INTEGER;
+ 
+      TYPE U1 IS (MON,TUE,WED,THU,FRI);
+      TYPE U2 IS ARRAY (U1 RANGE MON..THU) OF INTEGER;
+ 
+      TYPE V1 IS ARRAY (1..10) OF BOOLEAN;
+      B : BOOLEAN;
+ 
+      FUNCTION F RETURN T1 IS
+      BEGIN
+           RETURN (1..10 => 1);
+      END F;
+ 
+      FUNCTION F RETURN T2 IS
+      BEGIN
+           RETURN (1..10 => (1..10 => 2));
+      END F;
+ 
+      FUNCTION G RETURN U2 IS
+      BEGIN
+           RETURN (MON..THU => 3);
+      END G;
+ 
+      FUNCTION G RETURN T1 IS
+      BEGIN
+           RETURN (1..10 => 4);
+      END G;
+ 
+      FUNCTION H RETURN T1 IS
+      BEGIN
+           RETURN (1..10 => 5);
+      END H;
+ 
+      FUNCTION H RETURN V1 IS
+      BEGIN
+           RETURN (1..10 => FALSE);
+      END H;
+ 
+ BEGIN
+ 
+      TEST ("C41101D", "WHEN INDEXING FUNCTION RESULTS, INDEX TYPE, " &
+                       "NUMBER OF INDICES, AND COMPONENT TYPE ARE " &
+                       "USED FOR OVERLOADING RESOLUTION");
+ 
+      I := F(7);              -- NUMBER OF INDEX VALUES.
+      IF I /= IDENT_INT(1) THEN
+           FAILED ("WRONG VALUE - 1");
+      END IF;
+ 
+      I := G(3);              -- INDEX TYPE.
+      IF I /= IDENT_INT(4) THEN
+           FAILED ("WRONG VALUE - 2");
+      END IF;
+ 
+      B := H(5);              -- COMPONENT TYPE.
+      IF B /= IDENT_BOOL(FALSE) THEN
+           FAILED ("WRONG VALUE - 3");
+      END IF;
+ 
+      RESULT;
+ 
+ END C41101D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41103a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41103a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41103a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,239 ----
+ -- C41103A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NAME IN AN INDEXED_COMPONENT MAY BE:
+ --   AN IDENTIFIER DENOTING AN ARRAY OBJECT - N1;
+ --   AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+ --        DESIGNATES AN ARRAY OBJECT - N2;
+ --   A FUNCTION CALL DELIVERING AN ARRAY OBJECT USING
+ --        A PREDEFINED FUNCTION - &,
+ --        A USER-DEFINED FUNCTION - F1;
+ --   A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+ --        DESIGNATES AN ARRAY - F2;
+ --   A SLICE (CHECKING UPPER AND LOWER BOUND COMPONENTS) - N3;
+ --   AN INDEXED COMPONENT DENOTING AN ARRAY OBJECT
+ --        (ARRAY OF ARRAYS) - N4;
+ --   AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+ --        ENCLOSING ITS DECLARATION - C41103A.N1;
+ --   A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+ --        ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+ -- CHECK THAT THE APPROPRIATE COMPONENT IS ACCESSED (FOR
+ --   STATIC INDICES).
+ 
+ -- WKB 7/27/81
+ -- JRK 7/28/81
+ -- SPS 10/26/82
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41103A IS
+ 
+      TYPE A1 IS ARRAY (INTEGER RANGE 1..4) OF INTEGER;
+      N1 : A1 := (1,2,3,4);
+ 
+ BEGIN
+      TEST ("C41103A", "CHECK THAT AN INDEXED_COMPONENT MAY BE OF " &
+                       "CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                       "COMPONENT IS ACCESSED (FOR STATIC INDICES)");
+ 
+      DECLARE
+ 
+           TYPE A2 IS ARRAY (INTEGER RANGE 1..4) OF BOOLEAN;
+           TYPE A3 IS ACCESS A1;
+           TYPE A4 IS ARRAY (INTEGER RANGE 1..4) OF A1;
+           TYPE R (LENGTH : INTEGER) IS 
+                RECORD
+                     S : STRING (1..LENGTH);
+                END RECORD;
+ 
+           N2 : A3 := NEW A1' (1,2,3,4);
+           N3 : ARRAY (1..7) OF INTEGER := (1,2,3,4,5,6,7);
+           N4 : A4 := (1 => (1,2,3,4), 2 => (5,6,7,8),
+                       3 => (9,10,11,12), 4 => (13,14,15,16));
+           N5 : R(4) := (LENGTH => 4, S => "ABCD");
+ 
+           FUNCTION F1 RETURN A2 IS
+           BEGIN
+                RETURN (FALSE,FALSE,TRUE,FALSE);
+           END F1;
+ 
+           FUNCTION F2 RETURN A3 IS
+           BEGIN
+                RETURN N2;
+           END F2;
+ 
+           PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
+                         Z : OUT INTEGER; W : IN STRING) IS
+           BEGIN
+                IF X /= 2 THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+                END IF;
+                IF Y /= 3 THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+                END IF;
+                Y := 8;
+                Z := 9;
+           END P1;
+ 
+           PROCEDURE P2 (X : CHARACTER) IS
+           BEGIN
+                IF X /= 'C' THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+                END IF;
+           END P2;
+ 
+           PROCEDURE P3 (X : BOOLEAN) IS
+           BEGIN
+                IF X /= TRUE THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+                END IF;
+           END P3;
+ 
+           PROCEDURE P5 (X : IN CHARACTER; Y : IN OUT CHARACTER;
+                         Z : OUT CHARACTER) IS
+           BEGIN 
+                IF X /= 'A' THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+                END IF;
+                IF Y /= 'D' THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+                END IF;
+                Y := 'Y';
+                Z := 'Z';
+           END P5;
+ 
+      BEGIN
+ 
+           IF N1(2) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+           END IF;
+           N1(2) := 7;
+           IF N1 /= (1,7,3,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+           END IF;
+           N1 := (1,2,3,4);
+           P1 (N1(2), N1(3), N1(1), "N1");
+           IF N1 /= (9,2,8,4) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+           END IF;
+ 
+           IF N2(3) /= 3 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+           END IF;
+           N2(3) := 7;
+           IF N2.ALL /= (1,2,7,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+           END IF;
+           N2.ALL := (2,1,4,3);
+           P1 (N2(1), N2(4), N2(2), "N2");
+           IF N2.ALL /= (2,9,4,8) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+           END IF;
+ 
+           IF "&" (STRING'("AB"), STRING'("CDEF"))(5) /= CHARACTER'('E') THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+           END IF;
+           P2 ("&" ("AB", "CD")(3));
+ 
+           IF F1(3) /= TRUE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+           END IF;
+           P3 (F1(3));
+ 
+           N2 := NEW A1' (1,2,3,4);
+           IF F2(2) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+           END IF;
+           F2(3) := 7;
+           IF N2.ALL /= (1,2,7,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+           END IF;
+           N2.ALL := (1,2,3,4);
+           P1 (F2(2), F2(3), F2(1), "F2");
+           IF N2.ALL /= (9,2,8,4) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+           END IF;
+ 
+           IF N3(2..5)(5) /= 5 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N3");
+           END IF;
+           N3(2..5)(2) := 8;
+           IF N3 /= (1,8,3,4,5,6,7) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+           END IF;
+           N3 := (5,3,4,2,1,6,7);
+           P1 (N3(2..5)(4), N3(2..5)(2), N3(2..5)(5), "N3");
+           IF N3 /= (5,8,4,2,9,6,7) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+           END IF;
+ 
+           IF N4(1)(2) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+           END IF;
+           N4(3)(1) := 20;
+           IF N4 /= ((1,2,3,4),(5,6,7,8),(20,10,11,12),
+                     (13,14,15,16)) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+           END IF;
+           N4 := (1 => (0,6,4,2), 2 => (10,11,12,13),
+                  3 => (14,15,16,17), 4 => (7,5,3,1));
+           P1 (N4(1)(4), N4(4)(3), N4(2)(1), "N4");
+           IF N4 /= ((0,6,4,2),(9,11,12,13),(14,15,16,17),
+                     (7,5,8,1)) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+           END IF;
+ 
+           N1 := (1,2,3,4);
+           IF C41103A.N1(2) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - C41103A.N1");
+           END IF;
+           C41103A.N1(2) := 7;
+           IF N1 /= (1,7,3,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41103A.N1");
+           END IF;
+           N1 := (1,2,3,4);
+           P1 (C41103A.N1(2), C41103A.N1(3), C41103A.N1(1),
+               "C41103A.N1");
+           IF N1 /= (9,2,8,4) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                       "- C41103A.N1");
+           END IF;
+ 
+           IF N5.S(3) /= 'C' THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+           END IF;
+           N5.S(4) := 'X';
+           IF N5.S /= "ABCX" THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+           END IF;
+           N5.S := "ABCD";
+           P5 (N5.S(1), N5.S(4), N5.S(2));
+           IF N5.S /= "AZCY" THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C41103A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41103b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41103b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41103b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,366 ----
+ -- C41103B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE NAME IN AN INDEXED_COMPONENT MAY BE:
+ --        AN IDENTIFIER DENOTING AN ARRAY OBJECT - N1;
+ --        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+ --           DESIGNATES AN ARRAY OBJECT - N2;
+ --        A FUNCTION CALL DELIVERING AN ARRAY OBJECT USING
+ --           PREDEFINED FUNCTIONS - &, AND THE LOGICAL OPERATORS
+ --        A USER-DEFINED FUNCTION - F1;
+ --        A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+ --           DESIGNATES AN ARRAY - F2;
+ --        A SLICE (CHECKING UPPER AND LOWER BOUND COMPONENTS) - N3;
+ --        AN INDEXED COMPONENT DENOTING AN ARRAY OBJECT
+ --           (ARRAY OF ARRAYS) - N4;
+ --        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+ --           ENCLOSING ITS DECLARATION - C41103B.N1;
+ --        A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+ --           ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+ --     CHECK THAT THE APPROPRIATE COMPONENT IS ACCESSED (FOR
+ --     DYNAMIC INDICES).
+ 
+ -- HISTORY:
+ --     WKB 08/05/81  CREATED ORIGINAL TEST.
+ --     SPS 10/26/82
+ --     BCB 08/02/88  MODIFIED HEADER FORMAT AND ADDED CALLS TO THE
+ --                   LOGICAL OPERATORS.
+ --     BCB 04/16/90  MODIFIED SLICE TEST TO INCLUDE A READING OF THE
+ --                   COMPONENT DESIGNATED BY THE LOWER BOUND OF THE
+ --                   SLICE.  ADDED TEST FOR PREFIX OF INDEXED COMPONENT
+ --                   HAVING A LIMITED TYPE.
+ --     PWN 11/30/94  SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41103B IS
+ 
+      TYPE A1 IS ARRAY (INTEGER RANGE 1..4) OF INTEGER;
+      N1 : A1 := (1,2,3,4);
+ 
+ BEGIN
+      TEST ("C41103B", "CHECK THAT AN INDEXED_COMPONENT MAY BE OF " &
+                       "CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                       "COMPONENT IS ACCESSED (FOR DYNAMIC INDICES)");
+ 
+      DECLARE
+ 
+           TYPE A2 IS ARRAY (INTEGER RANGE 1..4) OF BOOLEAN;
+           TYPE A3 IS ACCESS A1;
+           TYPE A4 IS ARRAY (INTEGER RANGE 1..4) OF A1;
+           TYPE R (LENGTH : INTEGER) IS
+                RECORD
+                     S : STRING (1..LENGTH);
+                END RECORD;
+ 
+           N2 : A3 := NEW A1' (1,2,3,4);
+           N3 : ARRAY (1..7) OF INTEGER := (1,2,3,4,5,6,7);
+           N4 : A4 := (1 => (1,2,3,4), 2 => (5,6,7,8),
+                       3 => (9,10,11,12), 4 => (13,14,15,16));
+           N5 : R(4) := (LENGTH => 4, S => "ABCD");
+ 
+           M2A : A2 := (TRUE,FALSE,TRUE,FALSE);
+           M2B : A2 := (TRUE,TRUE,FALSE,FALSE);
+ 
+           FUNCTION F1 RETURN A2 IS
+           BEGIN
+                RETURN (FALSE,FALSE,TRUE,FALSE);
+           END F1;
+ 
+           FUNCTION F2 RETURN A3 IS
+           BEGIN
+                RETURN N2;
+           END F2;
+ 
+           PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
+                         Z : OUT INTEGER; W : IN STRING) IS
+           BEGIN
+                IF X /= 2 THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+                END IF;
+                IF Y /= 3 THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+                END IF;
+                Y := 8;
+                Z := 9;
+           END P1;
+ 
+           PROCEDURE P2 (X : CHARACTER) IS
+           BEGIN
+                IF X /= 'C' THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+                END IF;
+           END P2;
+ 
+           PROCEDURE P3 (X : BOOLEAN) IS
+           BEGIN
+                IF X /= TRUE THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+                END IF;
+           END P3;
+ 
+           PROCEDURE P5 (X : IN CHARACTER; Y : IN OUT CHARACTER;
+                         Z : OUT CHARACTER) IS
+           BEGIN
+                IF X /= 'A' THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+                END IF;
+                IF Y /= 'D' THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+                END IF;
+                Y := 'Y';
+                Z := 'Z';
+           END P5;
+ 
+           PROCEDURE P6 (X : BOOLEAN) IS
+           BEGIN
+                IF X /= TRUE THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - NOT");
+                END IF;
+           END P6;
+ 
+           PROCEDURE P7 (X : BOOLEAN) IS
+           BEGIN
+                IF X /= TRUE THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - AND");
+                END IF;
+           END P7;
+ 
+           PROCEDURE P8 (X : BOOLEAN) IS
+           BEGIN
+                IF X /= TRUE THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - OR");
+                END IF;
+           END P8;
+ 
+           PROCEDURE P9 (X : BOOLEAN) IS
+           BEGIN
+                IF X /= TRUE THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - XOR");
+                END IF;
+           END P9;
+ 
+      BEGIN
+ 
+           IF N1(IDENT_INT(2)) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+           END IF;
+           N1(IDENT_INT(2)) := 7;
+           IF N1 /= (1,7,3,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+           END IF;
+           N1 := (1,2,3,4);
+           P1 (N1(IDENT_INT(2)), N1(IDENT_INT(3)),
+               N1(IDENT_INT(1)), "N1");
+           IF N1 /= (9,2,8,4) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+           END IF;
+ 
+           IF N2(IDENT_INT(3)) /= 3 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+           END IF;
+           N2(IDENT_INT(3)) := 7;
+           IF N2.ALL /= (1,2,7,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+           END IF;
+           N2.ALL := (2,1,4,3);
+           P1 (N2(IDENT_INT(1)), N2(IDENT_INT(4)),
+               N2(IDENT_INT(2)), "N2");
+           IF N2.ALL /= (2,9,4,8) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+           END IF;
+ 
+           IF "&" (STRING'("AB"), STRING'("CDEF"))(IDENT_INT(5)) 
+              /= CHARACTER'('E') THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+           END IF;
+           P2 ("&" ("AB", "CD")(IDENT_INT(3)));
+ 
+           IF "NOT" (M2A)(IDENT_INT(4)) /= TRUE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'NOT'");
+           END IF;
+           P6 ("NOT" (M2A)(IDENT_INT(4)));
+ 
+           IF "AND" (M2A,M2B)(IDENT_INT(3)) /= FALSE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'AND'");
+           END IF;
+           P7 ("AND" (M2A,M2B)(IDENT_INT(1)));
+ 
+           IF "OR" (M2A,M2B)(IDENT_INT(3)) /= TRUE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'OR'");
+           END IF;
+           P8 ("OR" (M2A,M2B)(IDENT_INT(3)));
+ 
+           IF "XOR" (M2A,M2B)(IDENT_INT(1)) /= FALSE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'XOR'");
+           END IF;
+           P9 ("XOR" (M2A,M2B)(IDENT_INT(3)));
+ 
+           IF F1(IDENT_INT(3)) /= TRUE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+           END IF;
+           P3 (F1(IDENT_INT(3)));
+ 
+           N2 := NEW A1'(1,2,3,4);
+           IF F2(IDENT_INT(2)) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+           END IF;
+           F2(IDENT_INT(3)) := 7;
+           IF N2.ALL /= (1,2,7,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+           END IF;
+           N2.ALL := (1,2,3,4);
+           P1 (F2(IDENT_INT(2)), F2(IDENT_INT(3)),
+               F2(IDENT_INT(1)), "F2");
+           IF N2.ALL /= (9,2,8,4) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+           END IF;
+ 
+           IF N3(2..5)(IDENT_INT(2)) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION (LOWER BOUND) - N3");
+           END IF;
+           IF N3(2..5)(IDENT_INT(5)) /= 5 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION (UPPER BOUND) - N3");
+           END IF;
+           N3(2..5)(IDENT_INT(2)) := 8;
+           IF N3 /= (1,8,3,4,5,6,7) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+           END IF;
+           N3 := (5,3,4,2,1,6,7);
+           P1 (N3(2..5)(IDENT_INT(4)), N3(2..5)(IDENT_INT(2)),
+               N3(2..5)(IDENT_INT(5)), "N3");
+           IF N3 /= (5,8,4,2,9,6,7) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+           END IF;
+ 
+           IF N4(1)(IDENT_INT(2)) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+           END IF;
+           N4(3)(IDENT_INT(1)) := 20;
+           IF N4 /= ((1,2,3,4),(5,6,7,8),(20,10,11,12),
+                     (13,14,15,16)) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+           END IF;
+           N4 := (1 => (0,6,4,2), 2 => (10,11,12,13),
+                  3 => (14,15,16,17), 4 => (7,5,3,1));
+           P1 (N4(1)(IDENT_INT(4)), N4(4)(IDENT_INT(3)),
+               N4(2)(IDENT_INT(1)), "N4");
+           IF N4 /= ((0,6,4,2),(9,11,12,13),(14,15,16,17),
+                     (7,5,8,1)) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+           END IF;
+ 
+           N1 := (1,2,3,4);
+           IF C41103B.N1(IDENT_INT(2)) /= 2 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - C41103B.N1");
+           END IF;
+           C41103B.N1(IDENT_INT(2)) := 7;
+           IF N1 /= (1,7,3,4) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41103B.N1");
+           END IF;
+           N1 := (1,2,3,4);
+           P1 (C41103B.N1(IDENT_INT(2)), C41103B.N1(IDENT_INT(3)),
+               C41103B.N1(IDENT_INT(1)), "C41103B.N1");
+           IF N1 /= (9,2,8,4) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                        "- C41103B.N1");
+           END IF;
+ 
+           IF N5.S(IDENT_INT(3)) /= 'C' THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+           END IF;
+           N5.S(IDENT_INT(4)) := 'X';
+           IF N5.S /= "ABCX" THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+           END IF;
+           N5.S := "ABCD";
+           P5 (N5.S(IDENT_INT(1)), N5.S(IDENT_INT(4)),
+               N5.S(IDENT_INT(2)));
+           IF N5.S /= "AZCY" THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+           END IF;
+ 
+           DECLARE
+                PACKAGE P IS
+                     TYPE LIM IS LIMITED PRIVATE;
+                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER);
+                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM);
+                     FUNCTION "=" (ONE,TWO : LIM) RETURN BOOLEAN;
+                PRIVATE
+                     TYPE LIM IS ARRAY(1..3) OF INTEGER;
+                END P;
+ 
+                USE P;
+ 
+                TYPE A IS ARRAY(1..3) OF LIM;
+ 
+                H : A;
+ 
+                N6 : LIM;
+ 
+                PACKAGE BODY P IS
+                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER) IS
+                     BEGIN
+                          V := (X,Y,Z);
+                     END INIT;
+ 
+                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM) IS
+                     BEGIN
+                          ONE := TWO;
+                     END ASSIGN;
+ 
+                     FUNCTION "=" (ONE,TWO : LIM) RETURN BOOLEAN IS
+                     BEGIN
+                          IF ONE(1) = TWO(1) AND ONE(2) = TWO(2) AND
+                            ONE(3) = TWO(3) THEN
+                               RETURN TRUE;
+                          ELSE
+                               RETURN FALSE;
+                          END IF;
+                     END "=";
+                END P;
+ 
+                FUNCTION FR RETURN A IS
+                BEGIN
+                     RETURN H;
+                END FR;
+ 
+           BEGIN
+                INIT (H(1),1,2,3);
+                INIT (H(2),4,5,6);
+                INIT (H(3),7,8,9);
+                INIT (N6,0,0,0);
+ 
+                ASSIGN (N6,FR(2));
+ 
+                IF N6 /= FR(2) THEN
+                     FAILED ("WRONG VALUE FROM LIMITED COMPONENT TYPE");
+                END IF;
+ 
+           END;
+      END;
+ 
+      RESULT;
+ END C41103B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41104a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41104a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41104a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,240 ----
+ -- C41104A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN EXPRESSION GIVES AN INDEX
+ -- VALUE OUTSIDE THE RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND ACCESS
+ -- TYPES.
+ 
+ -- TBN  9/12/86
+ -- EDS  8/03/98  AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41104A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+      SUBTYPE BOOL IS BOOLEAN RANGE TRUE .. TRUE;
+      SUBTYPE CHAR IS CHARACTER RANGE 'W' .. 'Z';
+      TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
+      TYPE ARRAY2 IS ARRAY (3 .. 1) OF INTEGER;
+      TYPE ARRAY3 IS ARRAY (BOOL RANGE <>) OF INTEGER;
+      TYPE ARRAY4 IS ARRAY (CHAR RANGE <>) OF INTEGER;
+ 
+      TYPE REC (D : INT) IS
+           RECORD
+                A : ARRAY1 (1 .. D);
+           END RECORD;
+ 
+      TYPE B_REC (D : BOOL) IS
+           RECORD
+                A : ARRAY3 (TRUE .. D);
+           END RECORD;
+ 
+      TYPE NULL_REC (D : INT) IS
+           RECORD
+                A : ARRAY1 (D .. 1);
+           END RECORD;
+ 
+      TYPE NULL_CREC (D : CHAR) IS
+           RECORD
+                A : ARRAY4 (D .. 'W');
+           END RECORD;
+ 
+ BEGIN
+      TEST ("C41104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN " &
+                       "EXPRESSION GIVES AN INDEX VALUE OUTSIDE THE " &
+                       "RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND " &
+                       "ACCESS TYPES");
+ 
+      DECLARE
+           ARA1 : ARRAY1 (1 .. 5) := (1, 2, 3, 4, 5);
+      BEGIN
+           ARA1 (IDENT_INT(0)) := 1;
+ 
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                         INTEGER'IMAGE(ARA1 (1)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 1");
+      END;
+ ------------------------------------------------------------------------
+      DECLARE
+           TYPE ACC_ARRAY IS ACCESS ARRAY3 (TRUE .. TRUE);
+           ACC_ARA : ACC_ARRAY := NEW ARRAY3'(TRUE => 2);
+      BEGIN
+           ACC_ARA (IDENT_BOOL(FALSE)) := 2;
+ 
+           BEGIN
+ 
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                         INTEGER'IMAGE(ACC_ARA (TRUE)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 2");
+      END;
+ ------------------------------------------------------------------------
+      DECLARE
+           ARA2 : ARRAY4 ('Z' .. 'Y');
+      BEGIN
+           ARA2 (IDENT_CHAR('Y')) := 3;
+ 
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
+ 
+           BEGIN
+                COMMENT ("ARA2 (Y) IS " & INTEGER'IMAGE(ARA2 ('Y')));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 3");
+      END;
+ ------------------------------------------------------------------------
+      DECLARE
+           TYPE ACC_ARRAY IS ACCESS ARRAY2;
+           ACC_ARA : ACC_ARRAY := NEW ARRAY2;
+      BEGIN
+           ACC_ARA (IDENT_INT(4)) := 4;
+ 
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
+ 
+           BEGIN
+                COMMENT ("ACC_ARA (4) IS " & INTEGER'IMAGE(ACC_ARA (4)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 4");
+      END;
+ ------------------------------------------------------------------------
+      DECLARE
+           REC1 : B_REC (TRUE) := (TRUE, A => (TRUE => 5));
+      BEGIN
+           REC1.A (IDENT_BOOL (FALSE)) := 1;
+ 
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                        INTEGER'IMAGE(REC1.A (TRUE)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 5");
+      END;
+ ------------------------------------------------------------------------
+      DECLARE
+           TYPE ACC_REC IS ACCESS REC (3);
+           ACC_REC1 : ACC_REC := NEW REC'(3, (4, 5, 6));
+      BEGIN
+           ACC_REC1.A (IDENT_INT(4)) := 4;
+ 
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                         INTEGER'IMAGE(ACC_REC1.A (3)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 6");
+      END;
+ ------------------------------------------------------------------------
+      DECLARE
+           REC1 : NULL_REC (2);
+      BEGIN
+           REC1.A (IDENT_INT(2)) := 1;
+ 
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
+ 
+           BEGIN
+                COMMENT ("REC1.A (2) IS " & INTEGER'IMAGE(REC1.A (2)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 7");
+      END;
+ ------------------------------------------------------------------------
+      DECLARE
+           TYPE ACC_REC IS ACCESS NULL_CREC ('Z');
+           ACC_REC1 : ACC_REC := NEW NULL_CREC ('Z');
+      BEGIN
+           ACC_REC1.A (IDENT_CHAR('A')) := 4;
+ 
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
+           BEGIN
+                COMMENT ("ACC_REC1.A (A) IS " &
+                          INTEGER'IMAGE(ACC_REC1.A ('A')));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - 8");
+      END;
+ ------------------------------------------------------------------------
+ 
+      RESULT;
+ END C41104A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41105a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41105a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41105a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C41105A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE NAME PART OF AN
+ --     INDEXED COMPONENT DENOTES AN ACCESS OBJECT WHOSE VALUE IS NULL,
+ --     AND ALSO IF THE NAME IS A FUNCTION CALL DELIVERING NULL.
+ 
+ -- HISTORY:
+ --     WKB 07/29/81  CREATED ORIGINAL TEST.
+ --     SPS 10/26/82
+ --     JET 01/05/88  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
+ --                   OPTIMIZATION.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41105A IS
+ 
+ BEGIN
+      TEST ("C41105A", "CONSTRAINT_ERROR FROM NAMES DENOTING A NULL " &
+                       "ACCESS OBJECT AND A FUNCTION CALL DELIVERING " &
+                       "NULL");
+ 
+      DECLARE
+ 
+           TYPE T1 IS ARRAY (1..2) OF INTEGER;
+           TYPE A1 IS ACCESS T1;
+           B : A1 := NEW T1' (1,2);
+           I : INTEGER;
+ 
+      BEGIN
+ 
+           IF EQUAL (3,3) THEN
+                B := NULL;
+           END IF;
+ 
+           I := B(1);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
+ 
+           IF EQUAL (I,I) THEN
+                COMMENT ("NO EXCEPTION RAISED");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
+ 
+      END;
+ 
+ 
+      DECLARE
+ 
+           TYPE T2 IS ARRAY (1..2) OF INTEGER;
+           TYPE A2 IS ACCESS T2;
+           I : INTEGER;
+ 
+           FUNCTION F RETURN A2 IS
+           BEGIN
+                IF EQUAL (3,3) THEN
+                     RETURN NULL;
+                END IF;
+                RETURN NEW T2' (1,2);
+           END F;
+ 
+      BEGIN
+ 
+           I := F(1);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
+ 
+           IF EQUAL (I,I) THEN
+                COMMENT ("NO EXCEPTION RAISED");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
+ 
+      END;
+ 
+      RESULT;
+ END C41105A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41107a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41107a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41107a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C41107A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR AN ARRAY HAVING BOTH POSITIVE AND NEGATIVE
+ --   INDEX VALUES, THE PROPER COMPONENT IS SELECTED - A.
+ -- CHECK THAT FOR AN ARRAY INDEXED WITH AN ENUMERATION TYPE,
+ --   APPROPRIATE COMPONENTS CAN BE SELECTED - B.
+ -- CHECK THAT SUBSCRIPT EXPRESSIONS CAN BE OF COMPLEXITY GREATER
+ --   THAN VARIABLE + - CONSTANT - C.
+ -- CHECK THAT MULTIPLY DIMENSIONED ARRAYS ARE PROPERLY INDEXED - D.
+ 
+ -- WKB 7/29/81
+ -- JBG 8/21/83
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41107A IS
+ 
+      TYPE T1 IS ARRAY (INTEGER RANGE -2..2) OF INTEGER;
+      A : T1 := (1,2,3,4,5);
+ 
+      TYPE COLOR IS (RED,ORANGE,YELLOW,GREEN,BLUE);
+      TYPE T2 IS ARRAY (COLOR RANGE RED..BLUE) OF INTEGER;
+      B : T2 := (5,4,3,2,1);
+ 
+      C : STRING (1..7) := "ABCDEFG";
+ 
+      TYPE T4 IS ARRAY (1..4,1..3) OF INTEGER;
+      D : T4 := (1 => (1,2,3), 2 => (4,5,6), 3 => (7,8,9),
+                 4 => (0,-1,-2));
+ 
+      V1 : INTEGER := IDENT_INT (1);
+      V2 : INTEGER := IDENT_INT (2);
+      V3 : INTEGER := IDENT_INT (3);
+ 
+      PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
+                    Z : OUT INTEGER; W : STRING) IS
+      BEGIN
+           IF X /= 1 THEN
+                FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+           END IF;
+           IF Y /= 4 THEN
+                FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+           END IF;
+           Y := 11;
+           Z := 12;
+      END P1;
+ 
+      PROCEDURE P2 (X : IN CHARACTER; Y : IN OUT CHARACTER;
+                    Z : OUT CHARACTER) IS
+      BEGIN
+           IF X /= 'D' THEN
+                FAILED ("WRONG VALUE FOR IN PARAMETER - C");
+           END IF;
+           IF Y /= 'F' THEN
+                FAILED ("WRONG VALUE FOR IN OUT PARAMETER - C");
+           END IF;
+           Y := 'Y';
+           Z := 'Z';
+      END P2;
+ 
+ BEGIN
+      TEST ("C41107A", "CHECK THAT THE PROPER COMPONENT IS SELECTED " &
+                       "FOR ARRAYS WITH POS AND NEG INDICES, " &  
+                       "ENUMERATION INDICES, COMPLEX SUBSCRIPT " &
+                       "EXPRESSIONS, AND MULTIPLE DIMENSIONS");
+ 
+      IF A(IDENT_INT(1)) /= 4 THEN 
+           FAILED ("WRONG VALUE FOR EXPRESSION - A");
+      END IF;
+      A(IDENT_INT(-2)) := 10;
+      IF A /= (10,2,3,4,5) THEN
+           FAILED ("WRONG TARGET FOR ASSIGNMENT - A");
+      END IF;
+      A := (2,1,0,3,4);
+      P1 (A(-1), A(2), A(-2), "A");
+      IF A /= (12,1,0,3,11) THEN
+           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - A");
+      END IF;
+ 
+      IF B(GREEN) /= 2 THEN
+           FAILED ("WRONG VALUE FOR EXPRESSION - B");
+      END IF;
+      B(YELLOW) := 10;
+      IF B /= (5,4,10,2,1) THEN
+           FAILED ("WRONG TARGET FOR ASSIGNMENT - B");
+      END IF;
+      B := (1,4,2,3,5);
+      P1 (B(RED), B(ORANGE), B(BLUE), "B");
+      IF B /= (1,11,2,3,12) THEN
+           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - B");
+      END IF;
+ 
+      IF C(3..6)(3**2 / 3 * (2-1) - 6 / 3 + 2) /= 'C' THEN
+           FAILED ("WRONG VALUE FOR EXPRESSION - C");
+      END IF;
+      C(3..6)(V3**2 / V1 * (V3-V2) + IDENT_INT(4) - V3 * V2 - V1) := 'W';
+      IF C /= "ABCDEWG" THEN
+           FAILED ("WRONG TARGET FOR ASSIGNMENT - C");
+      END IF;
+      C := "ABCDEFG";
+      P2 (C(3..6)(V3+V1), C(3..6)(V3*V2), C(3..6)((V1+V2)*V1));
+      IF C /= "ABZDEYG" THEN
+           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - C");
+      END IF;
+ 
+      IF D(IDENT_INT(1),IDENT_INT(3)) /= 3 THEN
+           FAILED ("WRONG VALUE FOR EXPRESSION - D");
+      END IF;
+      D(IDENT_INT(4),IDENT_INT(2)) := 10;
+      IF D /= ((1,2,3),(4,5,6),(7,8,9),(0,10,-2)) THEN
+           FAILED ("WRONG TARGET FOR ASSIGNMENT - D");
+      END IF;
+      D := (1 => (0,2,3), 2 => (4,5,6), 3 => (7,8,9), 4 => (1,-1,-2));
+      P1 (D(4,1), D(2,1), D(3,2), "D");
+      IF D /= ((0,2,3),(11,5,6),(7,12,9),(1,-1,-2)) THEN
+           FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - D");
+      END IF;
+ 
+      RESULT;
+ END C41107A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41201d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41201d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41201d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41201d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C41201D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR SLICED COMPONENTS OF THE FORM F(...), CHECK THAT 
+ --   THE REQUIREMENT FOR A ONE-DIMENSIONAL ARRAY AND THE
+ --   TYPE OF THE INDEX ARE USED TO RESOLVE AN OVERLOADING OF F.
+ 
+ -- WKB 8/11/81
+ -- JBG 10/12/81
+ -- SPS 11/1/82
+ 
+ WITH REPORT;
+ PROCEDURE C41201D IS
+ 
+      USE REPORT;
+ 
+      TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      SUBTYPE T1 IS T(1..10);
+      TYPE T2 IS ARRAY (1..10, 1..10) OF INTEGER;
+      TT : T(1..3);
+ 
+      SUBTYPE U1 IS T(1..10);
+      TYPE U2 IS (MON,TUE,WED,THU,FRI);
+      SUBTYPE SU2 IS U2 RANGE MON .. THU;
+      TYPE U3 IS ARRAY (SU2) OF INTEGER;
+      UU : T(1..3);
+ 
+      TYPE V IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
+      SUBTYPE V1 IS V(1..10);
+      SUBTYPE V2 IS T(1..10);
+      VV : V(2..5);
+ 
+      FUNCTION F RETURN T1 IS
+      BEGIN
+           RETURN (1,1,1,1,5,6,7,8,9,10);
+      END F;
+ 
+      FUNCTION F RETURN T2 IS
+      BEGIN
+           RETURN (1..10 => (1,2,3,4,5,6,7,8,9,10));
+      END F;
+ 
+      FUNCTION G RETURN U1 IS
+      BEGIN
+           RETURN (3,3,3,3,5,6,7,8,9,10);
+      END G;
+ 
+      FUNCTION G RETURN U3 IS
+      BEGIN
+           RETURN (0,1,2,3);
+      END G;
+ 
+      FUNCTION H RETURN V1 IS
+      BEGIN
+           RETURN (1|3..10 => FALSE, 2 => IDENT_BOOL(TRUE));
+      END H;
+ 
+      FUNCTION H RETURN V2 IS
+      BEGIN
+           RETURN (1..10 => 5);
+      END H;
+ 
+ BEGIN
+ 
+      TEST ("C41201D", "WHEN SLICING FUNCTION RESULTS, TYPE OF " &
+                       "RESULT IS USED FOR OVERLOADING RESOLUTION");
+ 
+      IF F(1..3) /=
+         F(IDENT_INT(2)..IDENT_INT(4)) THEN -- NUMBER OF DIMENSIONS.
+           FAILED ("WRONG VALUE - 1");
+      END IF;
+ 
+      IF G(1..3) /=
+         G(IDENT_INT(2)..IDENT_INT(4)) THEN -- INDEX TYPE.
+           FAILED ("WRONG VALUE - 2");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(H(2..3)(2)) THEN    -- COMPONENT TYPE.
+           FAILED ("WRONG VALUE - 3");
+      END IF;
+ 
+      RESULT;
+ 
+ END C41201D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41203a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41203a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41203a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,241 ----
+ -- C41203A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NAME PART OF A SLICE MAY BE:
+ --   AN IDENTIFIER DENOTING A ONE DIMENSIONAL ARRAY OBJECT - N1;
+ --   AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+ --        DESIGNATES A ONE DIMENSIONAL ARRAY OBJECT - N2;
+ --   A FUNCTION CALL DELIVERING A ONE DIMENSIONAL ARRAY OBJECT USING
+ --        A PREDEFINED FUNCTION - &,
+ --        A USER-DEFINED FUNCTION - F1;
+ --   A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+ --        DESIGNATES A ONE DIMENSIONAL ARRAY - F2;
+ --   A SLICE - N3;
+ --   AN INDEXED COMPONENT DENOTING A ONE DIMENSIONAL ARRAY OBJECT
+ --        (ARRAY OF ARRAYS) - N4;
+ --   AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+ --        ENCLOSING ITS DECLARATION - C41203A.N1;
+ --   A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+ --        ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+ -- CHECK THAT THE APPROPRIATE SLICE IS ACCESSED (FOR
+ --   STATIC INDICES).
+ 
+ -- WKB 8/5/81
+ -- SPS 11/1/82
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41203A IS		
+ 
+      TYPE T1 IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      SUBTYPE A1 IS T1 (1..6);
+      N1 : A1 := (1,2,3,4,5,6);
+ 
+ BEGIN
+      TEST ("C41203A", "CHECK THAT THE NAME PART OF A SLICE MAY BE " &
+                       "OF CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                       "SLICE IS ACCESSED (FOR STATIC INDICES)");
+ 
+      DECLARE
+ 
+           TYPE T2 IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
+           SUBTYPE A2 IS T2 (1..6);
+           TYPE A3 IS ACCESS A1;
+           SUBTYPE SI IS INTEGER RANGE 1 .. 3;
+           TYPE A4 IS ARRAY (SI) OF A1;
+           TYPE R (LENGTH : INTEGER) IS
+                RECORD
+                     S : STRING (1..LENGTH);
+                END RECORD;
+ 
+           N2 : A3 := NEW A1' (1,2,3,4,5,6);
+           N3 : T1 (1..7) := (1,2,3,4,5,6,7);
+           N4 : A4 := (1 => (1,2,3,4,5,6), 2 => (7,8,9,10,11,12),
+                       3 => (13,14,15,16,17,18));
+           N5 : R(6) := (LENGTH => 6, S => "ABCDEF");
+ 
+           FUNCTION F1 RETURN A2 IS
+           BEGIN
+                RETURN (FALSE,FALSE,TRUE,FALSE,TRUE,TRUE);
+           END F1;
+ 
+           FUNCTION F2 RETURN A3 IS
+           BEGIN
+                RETURN N2;
+           END F2;
+ 
+           PROCEDURE P1 (X : IN T1; Y : IN OUT T1;
+                         Z : OUT T1; W : IN STRING) IS
+           BEGIN
+                IF X /= (1,2) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+                END IF;
+                IF Y /= (3,4) THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+                END IF;
+                Y := (10,11);
+                Z := (12,13);
+           END P1;
+ 
+           PROCEDURE P2 (X : STRING) IS
+           BEGIN
+                IF X /= "BC" THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+                END IF;
+           END P2;
+ 
+           PROCEDURE P3 (X : T2) IS
+           BEGIN
+                IF X /= (FALSE,TRUE,FALSE) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+                END IF;
+           END P3;
+ 
+           PROCEDURE P5 (X : IN STRING; Y : IN OUT STRING;
+                         Z : OUT STRING) IS
+           BEGIN 
+                IF X /= "EF" THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+                END IF;
+                IF Y /= "CD" THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+                END IF;
+                Y := "XY";
+                Z := "WZ";
+           END P5;
+ 
+      BEGIN
+ 
+           IF N1(1..2) /= (1,2) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+           END IF;
+           N1(1..2) := (7,8);
+           IF N1 /= (7,8,3,4,5,6) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+           END IF;
+           N1 := (1,2,3,4,5,6);
+           P1 (N1(1..2), N1(3..4), N1(5..6), "N1");
+           IF N1 /= (1,2,10,11,12,13) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+           END IF;
+ 
+           IF N2(4..6) /= (4,5,6) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+           END IF;
+           N2(4..6) := (7,8,9);
+           IF N2.ALL /= (1,2,3,7,8,9) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+           END IF;
+           N2.ALL := (1,2,5,6,3,4);
+           P1 (N2(1..2), N2(5..6), N2(3..4), "N2");
+           IF N2.ALL /= (1,2,12,13,10,11) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+           END IF;
+ 
+           IF "&" (STRING'("AB"), STRING'("CDEF"))(4..6) /= STRING'("DEF") THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+           END IF;
+           P2 ("&" ("AB", "CD")(2..3));
+ 
+           IF F1(1..2) /= (FALSE,FALSE) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+           END IF;
+           P3 (F1(2..4));
+ 
+           N2 := NEW A1' (1,2,3,4,5,6);
+           IF F2(2..6) /= (2,3,4,5,6) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+           END IF;
+           F2(3..3) := (5 => 7);
+           IF N2.ALL /= (1,2,7,4,5,6) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+           END IF;
+           N2.ALL := (5,6,1,2,3,4);
+           P1 (F2(3..4), F2(5..6), F2(1..2), "F2");
+           IF N2.ALL /= (12,13,1,2,10,11) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+           END IF;
+ 
+           IF N3(2..7)(2..4) /= (2,3,4) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N3");
+           END IF;
+           N3(2..7)(4..5) := (8,9);
+           IF N3 /= (1,2,3,8,9,6,7) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+           END IF;
+           N3 := (5,3,4,1,2,6,7);
+           P1 (N3(2..7)(4..5), N3(2..7)(2..3), N3(2..7)(6..7), "N3");
+           IF N3 /= (5,10,11,1,2,12,13) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+           END IF;
+ 
+           IF N4(1)(3..5) /= (3,4,5) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+           END IF;
+           N4(2)(1..3) := (21,22,23);
+           IF N4 /= ((1,2,3,4,5,6),(21,22,23,10,11,12),
+                     (13,14,15,16,17,18)) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+           END IF;
+           N4 := (1 => (18,19,20,21,22,23), 2 => (17,16,15,1,2,14),
+                  3 => (7,3,4,5,6,8));
+           P1 (N4(2)(4..5), N4(3)(2..3), N4(1)(5..6), "N4");
+           IF N4 /= ((18,19,20,21,12,13),(17,16,15,1,2,14),
+                     (7,10,11,5,6,8)) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+           END IF;
+ 
+           N1 := (1,2,3,4,5,6);
+           IF C41203A.N1(1..2) /= (1,2) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - C41203A.N1");
+           END IF;
+           C41203A.N1(1..2) := (7,8);
+           IF N1 /= (7,8,3,4,5,6) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41203A.N1");
+           END IF;
+           N1 := (1,2,3,4,5,6);
+           P1 (C41203A.N1(1..2), C41203A.N1(3..4), C41203A.N1(5..6),
+               "C41203A.N1");
+           IF N1 /= (1,2,10,11,12,13) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                        "- C41203A.N1");
+           END IF;
+ 
+           IF N5.S(1..5) /= "ABCDE" THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+           END IF;
+           N5.S(4..6) := "PQR";
+           IF N5.S /= "ABCPQR" THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+           END IF;
+           N5.S := "ABCDEF";
+           P5 (N5.S(5..6), N5.S(3..4), N5.S(1..2));
+           IF N5.S /= "WZXYEF" THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C41203A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41203b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41203b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41203b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,378 ----
+ -- C41203B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE NAME PART OF A SLICE MAY BE:
+ --        AN IDENTIFIER DENOTING A ONE DIMENSIONAL ARRAY OBJECT - N1;
+ --        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+ --           DESIGNATES A ONE DIMENSIONAL ARRAY OBJECT - N2;
+ --        A FUNCTION CALL DELIVERING A ONE DIMENSIONAL ARRAY OBJECT
+ --           USING PREDEFINED FUNCTIONS - &, AND THE LOGICAL OPERATORS
+ --        A USER-DEFINED FUNCTION - F1;
+ --        A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+ --           DESIGNATES A ONE DIMENSIONAL ARRAY - F2;
+ --        A SLICE - N3;
+ --        AN INDEXED COMPONENT DENOTING A ONE DIMENSIONAL ARRAY OBJECT
+ --           (ARRAY OF ARRAYS) - N4;
+ --        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+ --           ENCLOSING ITS DECLARATION - C41203B.N1;
+ --        A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+ --           ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+ --     CHECK THAT THE APPROPRIATE SLICE IS ACCESSED (FOR
+ --     DYNAMIC INDICES).
+ 
+ -- HISTORY:
+ --     WKB 08/05/81  CREATED ORIGINAL TEST.
+ --     SPS 02/04/83
+ --     BCB 08/02/88  MODIFIED HEADER FORMAT AND ADDED CALLS TO THE
+ --                   LOGICAL OPERATORS.
+ --     BCB 04/16/90  ADDED TEST FOR PREFIX OF INDEXED COMPONENT HAVING
+ --                   A LIMITED TYPE.
+ --     PWN 11/30/94  SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41203B IS
+ 
+      TYPE T1 IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+      SUBTYPE A1 IS T1 (1..6);
+      N1 : A1 := (1,2,3,4,5,6);
+ 
+ BEGIN
+      TEST ("C41203B", "CHECK THAT THE NAME PART OF A SLICE MAY BE " &
+                       "OF CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                       "SLICE IS ACCESSED (FOR DYNAMIC INDICES)");
+ 
+      DECLARE
+ 
+           TYPE T2 IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
+           SUBTYPE A2 IS T2 (1..6);
+           TYPE A3 IS ACCESS A1;
+           TYPE A4 IS ARRAY (INTEGER RANGE 1..3 ) OF A1;
+           TYPE R (LENGTH : INTEGER) IS
+                RECORD
+                     S : STRING (1..LENGTH);
+                END RECORD;
+ 
+           N2 : A3 := NEW A1'(1,2,3,4,5,6);
+           N3 : T1(1..7) := (1,2,3,4,5,6,7);
+           N4 : A4 := (1 => (1,2,3,4,5,6), 2 => (7,8,9,10,11,12),
+                       3 => (13,14,15,16,17,18));
+           N5 : R(6) := (LENGTH => 6, S => "ABCDEF");
+ 
+           M2A : A2 := (TRUE,TRUE,TRUE,FALSE,FALSE,FALSE);
+           M2B : A2 := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+ 
+           FUNCTION F1 RETURN A2 IS
+           BEGIN
+                RETURN (FALSE,FALSE,TRUE,FALSE,TRUE,TRUE);
+           END F1;
+ 
+           FUNCTION F2 RETURN A3 IS
+           BEGIN
+                RETURN N2;
+           END F2;
+ 
+           PROCEDURE P1 (X : IN T1; Y : IN OUT T1;
+                         Z : OUT T1; W : IN STRING) IS
+           BEGIN
+                IF X /= (1,2) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+                END IF;
+                IF Y /= (3,4) THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+                END IF;
+                Y := (10,11);
+                Z := (12,13);
+           END P1;
+ 
+           PROCEDURE P2 (X : STRING) IS
+           BEGIN
+                IF X /= "BC" THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+                END IF;
+           END P2;
+ 
+           PROCEDURE P3 (X : T2) IS
+           BEGIN
+                IF X /= (FALSE,TRUE,FALSE) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+                END IF;
+           END P3;
+ 
+           PROCEDURE P5 (X : IN STRING; Y : IN OUT STRING;
+                         Z : OUT STRING) IS
+           BEGIN
+                IF X /= "EF" THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+                END IF;
+                IF Y /= "CD" THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+                END IF;
+                Y := "XY";
+                Z := "WZ";
+           END P5;
+ 
+           PROCEDURE P6 (X : T2) IS
+           BEGIN
+                IF X /= (FALSE,FALSE,TRUE) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - NOT");
+                END IF;
+           END P6;
+ 
+           PROCEDURE P7 (X : T2) IS
+           BEGIN
+                IF X /= (FALSE,TRUE,FALSE) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - AND");
+                END IF;
+           END P7;
+ 
+           PROCEDURE P8 (X : T2) IS
+           BEGIN
+                IF X /= (FALSE,TRUE,FALSE) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - OR");
+                END IF;
+           END P8;
+ 
+           PROCEDURE P9 (X : T2) IS
+           BEGIN
+                IF X /= (FALSE,TRUE,FALSE) THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - XOR");
+                END IF;
+           END P9;
+ 
+      BEGIN
+ 
+           IF N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+           END IF;
+           N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8);
+           IF N1 /= (7,8,3,4,5,6) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+           END IF;
+           N1 := (1,2,3,4,5,6);
+           P1 (N1(IDENT_INT(1)..IDENT_INT(2)),
+               N1(IDENT_INT(3)..IDENT_INT(4)),
+               N1(IDENT_INT(5)..IDENT_INT(6)), "N1");
+           IF N1 /= (1,2,10,11,12,13) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+           END IF;
+ 
+           IF N2(IDENT_INT(4)..IDENT_INT(6)) /= (4,5,6) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+           END IF;
+           N2(IDENT_INT(4)..IDENT_INT(6)) := (7,8,9);
+           IF N2.ALL /= (1,2,3,7,8,9) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+           END IF;
+           N2.ALL := (1,2,5,6,3,4);
+           P1 (N2(IDENT_INT(1)..IDENT_INT(2)),
+               N2(IDENT_INT(5)..IDENT_INT(6)),
+               N2(IDENT_INT(3)..IDENT_INT(4)), "N2");
+           IF N2.ALL /= (1,2,12,13,10,11) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+           END IF;
+ 
+           IF "&" (STRING'("AB"),STRING'("CDEF"))(IDENT_INT(4)..IDENT_INT(6)) 
+             /= STRING'("DEF") THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+           END IF;
+           P2 ("&" ("AB","CD")(IDENT_INT(2)..IDENT_INT(3)));
+ 
+           IF "NOT" (M2A)(IDENT_INT(3)..IDENT_INT(5)) /=
+              (FALSE,TRUE,TRUE) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'NOT'");
+           END IF;
+           P6 ("NOT" (M2A)(IDENT_INT(2)..IDENT_INT(4)));
+ 
+           IF "AND" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
+              (TRUE,FALSE,FALSE) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'AND'");
+           END IF;
+           P7 ("AND" (M2A,M2B)(IDENT_INT(2)..IDENT_INT(4)));
+ 
+           IF "OR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
+              (TRUE,FALSE,TRUE) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'OR'");
+           END IF;
+           P8 ("OR" (M2A,M2B)(IDENT_INT(4)..IDENT_INT(6)));
+ 
+           IF "XOR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
+              (FALSE,FALSE,TRUE) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - 'XOR'");
+           END IF;
+           P9 ("XOR" (M2A,M2B)(IDENT_INT(1)..IDENT_INT(3)));
+ 
+           IF F1(IDENT_INT(1)..IDENT_INT(2)) /= (FALSE,FALSE) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+           END IF;
+           P3 (F1(IDENT_INT(2)..IDENT_INT(4)));
+ 
+           N2 := NEW A1'(1,2,3,4,5,6);
+           IF F2(IDENT_INT(2)..IDENT_INT(6)) /= (2,3,4,5,6) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+           END IF;
+           F2(IDENT_INT(3)..IDENT_INT(3)) := (5 => 7);
+           IF N2.ALL /= (1,2,7,4,5,6) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+           END IF;
+           N2.ALL := (5,6,1,2,3,4);
+           P1 (F2(IDENT_INT(3)..IDENT_INT(4)),
+               F2(IDENT_INT(5)..IDENT_INT(6)),
+               F2(IDENT_INT(1)..IDENT_INT(2)), "F2");
+           IF N2.ALL /= (12,13,1,2,10,11) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+           END IF;
+ 
+           IF N3(2..7)(IDENT_INT(2)..IDENT_INT(4)) /= (2,3,4) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N3");
+           END IF;
+           N3(2..7)(IDENT_INT(4)..IDENT_INT(5)) := (8,9);
+           IF N3 /= (1,2,3,8,9,6,7) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+           END IF;
+           N3 := (5,3,4,1,2,6,7);
+           P1 (N3(2..7)(IDENT_INT(4)..IDENT_INT(5)),
+               N3(2..7)(IDENT_INT(2)..IDENT_INT(3)),
+               N3(2..7)(IDENT_INT(6)..IDENT_INT(7)), "N3");
+           IF N3 /= (5,10,11,1,2,12,13) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+           END IF;
+ 
+           IF N4(1)(IDENT_INT(3)..IDENT_INT(5)) /= (3,4,5) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+           END IF;
+           N4(2)(IDENT_INT(1)..IDENT_INT(3)) := (21,22,23);
+           IF N4 /= ((1,2,3,4,5,6),(21,22,23,10,11,12),
+                     (13,14,15,16,17,18)) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+           END IF;
+           N4 := (1 => (18,19,20,21,22,23), 2 => (17,16,15,1,2,14),
+                  3 => (7,3,4,5,6,8));
+           P1 (N4(2)(IDENT_INT(4)..IDENT_INT(5)),
+               N4(3)(IDENT_INT(2)..IDENT_INT(3)),
+               N4(1)(IDENT_INT(5)..IDENT_INT(6)), "N4");
+           IF N4 /= ((18,19,20,21,12,13),(17,16,15,1,2,14),
+                     (7,10,11,5,6,8)) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+           END IF;
+ 
+           N1 := (1,2,3,4,5,6);
+           IF C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - C41203B.N1");
+           END IF;
+           C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8);
+           IF N1 /= (7,8,3,4,5,6) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41203B.N1");
+           END IF;
+           N1 := (1,2,3,4,5,6);
+           P1 (C41203B.N1(IDENT_INT(1)..IDENT_INT(2)),
+               C41203B.N1(IDENT_INT(3)..IDENT_INT(4)),
+               C41203B.N1(IDENT_INT(5)..IDENT_INT(6)), "C41203B.N1");
+           IF N1 /= (1,2,10,11,12,13) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                        "- C41203B.N1");
+           END IF;
+ 
+           IF N5.S(IDENT_INT(1)..IDENT_INT(5)) /= "ABCDE" THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+           END IF;
+           N5.S(IDENT_INT(4)..IDENT_INT(6)) := "PQR";
+           IF N5.S /= "ABCPQR" THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+           END IF;
+           N5.S := "ABCDEF";
+           P5 (N5.S(IDENT_INT(5)..IDENT_INT(6)),
+               N5.S(IDENT_INT(3)..IDENT_INT(4)),
+               N5.S(IDENT_INT(1)..IDENT_INT(2)));
+           IF N5.S /= "WZXYEF" THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+           END IF;
+ 
+           DECLARE
+                PACKAGE P IS
+                     TYPE LIM IS LIMITED PRIVATE;
+                     TYPE A IS ARRAY(INTEGER RANGE <>) OF LIM;
+                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER);
+                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM);
+                     FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN;
+                PRIVATE
+                     TYPE LIM IS ARRAY(1..3) OF INTEGER;
+                END P;
+ 
+                USE P;
+ 
+                H : A(1..5);
+ 
+                N6 : A(1..3);
+ 
+                PACKAGE BODY P IS
+                     PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER) IS
+                     BEGIN
+                          V := (X,Y,Z);
+                     END INIT;
+ 
+                     PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM) IS
+                     BEGIN
+                          ONE := TWO;
+                     END ASSIGN;
+ 
+                     FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN IS
+                     BEGIN
+                          IF ONE(1) = TWO(2) AND ONE(2) = TWO(3) AND
+                            ONE(3) = TWO(4) THEN
+                               RETURN TRUE;
+                          ELSE
+                               RETURN FALSE;
+                          END IF;
+                     END "=";
+                END P;
+ 
+                FUNCTION FR RETURN A IS
+                BEGIN
+                     RETURN H;
+                END FR;
+ 
+           BEGIN
+                INIT (H(1),1,2,3);
+                INIT (H(2),4,5,6);
+                INIT (H(3),7,8,9);
+                INIT (H(4),10,11,12);
+                INIT (H(5),13,14,15);
+                INIT (N6(1),0,0,0);
+                INIT (N6(2),0,0,0);
+                INIT (N6(3),0,0,0);
+ 
+                ASSIGN (N6(1),H(2));
+                ASSIGN (N6(2),H(3));
+                ASSIGN (N6(3),H(4));
+ 
+                IF N6 /= FR(2..4) THEN
+                     FAILED ("WRONG VALUE FROM LIMITED COMPONENT TYPE");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END C41203B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41204a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41204a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41204a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C41204A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF A SLICE'S DISCRETE
+ --   RANGE IS NOT NULL, AND ITS LOWER OR UPPER BOUND IS NOT A
+ --   POSSIBLE INDEX FOR THE NAMED ARRAY.
+ 
+ -- WKB 8/4/81
+ -- EDS 7/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41204A IS
+ 
+ BEGIN
+      TEST ("C41204A", "ILLEGAL UPPER OR LOWER BOUNDS FOR A " &
+                       "SLICE RAISES CONSTRAINT_ERROR");
+ 
+      DECLARE
+ 
+           TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+           A : T (10..15) := (10,11,12,13,14,15);
+           B : T (-20..30);
+ 
+      BEGIN
+ 
+           BEGIN
+                B (IDENT_INT(9)..12) := A (IDENT_INT(9)..12);
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1" &
+                        INTEGER'IMAGE(B(10)));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
+           END;
+ 
+           BEGIN
+                B (IDENT_INT(-12)..14) := A (IDENT_INT(-12)..14);
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2" &
+                        INTEGER'IMAGE(B(10)));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
+           END;
+ 
+           BEGIN
+                B (11..IDENT_INT(16)) := A (11..IDENT_INT(16));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3" &
+                        INTEGER'IMAGE(B(15)));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 3");
+           END;
+ 
+           BEGIN
+                B (17..20) := A (IDENT_INT(17)..IDENT_INT(20));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 4" &
+                        INTEGER'IMAGE(B(17)));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 4");
+           END;
+      END;
+ 
+      RESULT;
+ END C41204A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41205a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41205a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41205a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C41205A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE NAME PART OF A
+ --   SLICE DENOTES AN ACCESS OBJECT WHOSE VALUE IS NULL, AND
+ --   ALSO IF THE NAME IS A FUNCTION CALL DELIVERING NULL.
+ 
+ -- WKB 8/6/81
+ -- SPS 10/26/82
+ -- EDS 07/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41205A IS
+ 
+ BEGIN
+      TEST ("C41205A", "CONSTRAINT_ERROR WHEN THE NAME PART OF A " &
+                       "SLICE DENOTES A NULL ACCESS OBJECT OR A " &
+                       "FUNCTION CALL DELIVERING NULL");
+ 
+      DECLARE
+ 
+           TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+           SUBTYPE T1 IS T (1..5);
+           TYPE A1 IS ACCESS T1;
+           B : A1 := NEW T1' (1,2,3,4,5);
+           I : T (2..3);
+ 
+      BEGIN
+ 
+           IF EQUAL (3,3) THEN
+                B := NULL;
+           END IF;
+ 
+           I := B(2..3);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & INTEGER'IMAGE(I(2)));
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+           SUBTYPE T2 IS T (1..5);
+           TYPE A2 IS ACCESS T2;
+           I : T (2..5);
+ 
+           FUNCTION F RETURN A2 IS
+           BEGIN
+                IF EQUAL (3,3) THEN
+                     RETURN NULL;
+                END IF;
+                RETURN NEW T2' (1,2,3,4,5);
+           END F;
+ 
+      BEGIN
+ 
+           I := F(2..5);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 2 " & INTEGER'IMAGE(I(2)));
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
+ 
+      END;
+ 
+      RESULT;
+ END C41205A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41206a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41206a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41206a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C41206A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RANGE L..R, WHERE L=SUCC(R) CAN BE USED TO FORM
+ --   A NULL SLICE FROM AN ARRAY WHEN:
+ --        BOTH L AND R SATISFY THE INDEX CONSTRAINT;
+ --        L SATISFIES THE INDEX CONSTRAINT, R DOES NOT (BUT IT
+ --             BELONGS TO THE BASE TYPE OF THE INDEX);
+ --        L SATISFIES THE CONSTRAINT IMPOSED BY THE TYPE MARK OF
+ --             THE INDEX, BUT NOT THE CONSTRAINT ASSOCIATED WITH
+ --             THE INDEX;
+ --        THE ARRAY IS NULL, AND L IS IN THE RANGE OF THE INDEX SUBTYPE.
+ 
+ -- WKB 8/10/81
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41206A IS
+ 
+      TYPE SMALL IS RANGE 1..100;
+      TYPE T IS ARRAY (SMALL RANGE <> ) OF INTEGER;
+      SUBTYPE T1 IS T(5..10);
+      A : T1 := (5,6,7,8,9,10);
+      B : T(8..7) := (8..7 => 1);
+ 
+ BEGIN
+      TEST ("C41206A", "USING A RANGE L..R, WHERE L=SUCC(R), " &
+                       "TO FORM A NULL SLICE FROM AN ARRAY");
+ 
+      BEGIN
+           IF A (7..6) /= B OR A (SMALL(IDENT_INT(7))..6) /= B THEN
+                FAILED ("SLICE NOT NULL - 1");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 1");
+      END;
+ 
+      BEGIN
+           IF A (5..4) /= B OR A (SMALL(IDENT_INT(5))..4) /= B THEN
+                FAILED ("SLICE NOT NULL - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 2");
+      END;
+ 
+      BEGIN
+           IF A (50..49) /= B OR A (SMALL(IDENT_INT(50))..49) /= B THEN
+                FAILED ("SLICE NOT NULL - 3");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 3");
+      END;
+ 
+      BEGIN
+           IF B (50..49) /= B OR B (SMALL(IDENT_INT(50))..49) /= B THEN
+                FAILED ("SLICE NOT NULL - 4");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RAISED - 4");
+      END;
+ 
+      RESULT;
+ END C41206A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41207a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41207a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41207a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41207a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- C41207A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE DISCRETE RANGE IN A SLICE CAN HAVE THE FORM
+ --     A'RANGE, WHERE A IS A CONSTRAINED ARRAY SUBTYPE OR AN ARRAY
+ --     OBJECT.
+ 
+ -- HISTORY:
+ --     BCB 07/13/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C41207A IS
+ 
+      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+ 
+      SUBTYPE A1 IS ARR(1..5);
+ 
+      ARR_VAR : ARR(1..10) := (90,91,92,93,94,95,96,97,98,99);
+ 
+      A2 : ARRAY(1..5) OF INTEGER := (80,81,82,83,84);
+ 
+ BEGIN
+      TEST ("C41207A", "CHECK THAT THE DISCRETE RANGE IN A SLICE CAN " &
+                       "HAVE THE FORM A'RANGE, WHERE A IS A " &
+                       "CONSTRAINED ARRAY SUBTYPE OR AN ARRAY OBJECT");
+ 
+      ARR_VAR (A1'RANGE) := (1,2,3,4,5);
+ 
+      IF NOT (EQUAL(ARR_VAR(1),1) AND EQUAL(ARR_VAR(2),2) AND
+          EQUAL(ARR_VAR(3),3) AND EQUAL(ARR_VAR(4),4) AND
+          EQUAL(ARR_VAR(5),5)) THEN
+           FAILED ("IMPROPER RESULT FROM SLICE ASSIGNMENT USING THE " &
+                   "RANGE OF A CONSTRAINED ARRAY SUBTYPE");
+      END IF;
+ 
+      ARR_VAR (A2'RANGE) := (6,7,8,9,10);
+ 
+      IF (NOT EQUAL(ARR_VAR(1),6) OR NOT EQUAL(ARR_VAR(2),7) OR
+          NOT EQUAL(ARR_VAR(3),8) OR NOT EQUAL(ARR_VAR(4),9) OR
+          NOT EQUAL(ARR_VAR(5),10)) THEN
+           FAILED ("IMPROPER RESULT FROM SLICE ASSIGNMENT USING THE " &
+                   "RANGE OF AN ARRAY OBJECT");
+      END IF;
+ 
+      RESULT;
+ END C41207A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41301a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41301a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41301a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,216 ----
+ -- C41301A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION L.R MAY BE USED TO DENOTE A RECORD COMPONENT,
+ --   WHERE R IS THE IDENTIFIER OF SUCH COMPONENT, AND L MAY BE ANY OF
+ --   THE FOLLOWING:
+ --        AN IDENTIFIER DENOTING A RECORD OBJECT - X2;
+ --        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE DESIGNATES
+ --           A RECORD OBJECT - X3;
+ --        A FUNCTION CALL DELIVERING A RECORD VALUE - F1;
+ --        A FUNCTION CALL DELIVERING AN ACCESS VALUE DESIGNATING A
+ --           RECORD OBJECT - F2;
+ --        AN INDEXED COMPONENT - X4;
+ --        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+ --           ENCLOSING THE IDENTIFIER'S DECLARATION - C41301A.X1;
+ --        A SELECTED COMPONENT DENOTING A RECORD (WHICH IS A COMPONENT
+ --           OF ANOTHER RECORD) - X5.
+ 
+ -- WKB 8/13/81
+ -- JRK 8/17/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41301A IS
+ 
+      TYPE T1 IS
+           RECORD
+                A : INTEGER;
+                B : BOOLEAN;
+                C : BOOLEAN;
+           END RECORD;
+      X1 : T1 := (A=>1, B=>TRUE, C=>FALSE);
+ 
+ BEGIN
+      TEST ("C41301A", "CHECK THAT THE NOTATION L.R MAY BE USED TO " &
+                       "DENOTE A RECORD COMPONENT, WHERE R IS THE " &
+                       "IDENTIFIER AND L MAY BE OF CERTAIN FORMS");
+ 
+      DECLARE
+ 
+           TYPE T2 (DISC : INTEGER := 0) IS
+                RECORD
+                     D : BOOLEAN;
+                     E : INTEGER;
+                     F : BOOLEAN;
+                     CASE DISC IS
+                          WHEN 1 =>
+                               G : BOOLEAN;
+                          WHEN 2 =>
+                               H : INTEGER;
+                          WHEN OTHERS =>
+                               NULL;
+                     END CASE;
+                END RECORD;
+           X2 : T2(2) := (DISC=>2, D=>TRUE, E=>3, F=>FALSE, H=>1);
+ 
+           TYPE T3 IS ACCESS T1;
+           X3 : T3 := NEW T1' (A=>1, B=>TRUE, C=>FALSE);
+ 
+           TYPE T4 IS ARRAY (1..3) OF T1;
+           X4 : T4 := (1 => (1, TRUE, FALSE),
+                       2 => (2, FALSE, TRUE),
+                       3 => (3, TRUE, FALSE));
+ 
+           TYPE T5 IS
+                RECORD
+                     I : INTEGER;
+                     J : T1;
+                END RECORD;
+           X5 : T5 := (I => 5, J => (6, FALSE, TRUE));
+ 
+           FUNCTION F1 RETURN T2 IS
+           BEGIN
+                RETURN (DISC=>1, D=>FALSE, E=>3, F=>TRUE, G=>FALSE);
+           END F1;
+ 
+           FUNCTION F2 RETURN T3 IS
+           BEGIN
+                RETURN X3;
+           END F2;
+ 
+           PROCEDURE P1 (X : IN BOOLEAN; Y : IN OUT INTEGER;
+                         Z : OUT BOOLEAN; W : STRING) IS
+           BEGIN
+                IF X /= TRUE THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+                END IF;
+                IF Y /= 1 THEN
+                     FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+                END IF;
+                Y := 10;
+                Z := TRUE;
+           END P1;
+ 
+           PROCEDURE P2 (X : IN INTEGER) IS
+           BEGIN
+                IF X /= 1 THEN
+                     FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+                END IF;
+           END P2;
+ 
+      BEGIN
+ 
+           IF X2.E /= 3 THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - X2");
+           END IF;
+           X2.E := 5;
+           IF X2 /= (2, TRUE, 5, FALSE, 1) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - X2");
+           END IF;
+           X2 := (DISC=>2, D=>TRUE, E=>3, F=>FALSE, H=>1);
+           P1 (X2.D, X2.H, X2.F, "X2");
+           IF X2 /= (2, TRUE, 3, TRUE, 10) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X2");
+           END IF;
+ 
+           IF X3.C /= FALSE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - X3");
+           END IF;
+           X3.A := 5;
+           IF X3.ALL /= (5, TRUE, FALSE) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - X3");
+           END IF;
+           X3 := NEW T1 '(A=>1, B=>TRUE, C=>FALSE);
+           P1 (X3.B, X3.A, X3.C, "X3");
+           IF X3.ALL /= (10, TRUE, TRUE) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X3");
+           END IF;
+ 
+           IF F1.G /= FALSE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+           END IF;
+           P2 (F1.DISC);
+ 
+           X3 := NEW T1' (A=>3, B=>FALSE, C=>TRUE);
+           IF F2.B /= FALSE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+           END IF;
+           F2.A := 4;
+           IF X3.ALL /= (4, FALSE, TRUE) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+           END IF;
+           X3 := NEW T1' (A=>1, B=>FALSE, C=>TRUE);
+           P1 (F2.C, F2.A, F2.B, "F2");
+           IF X3.ALL /= (10, TRUE, TRUE) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+           END IF;
+ 
+           IF X4(2).C /= TRUE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - X4");
+           END IF;
+           X4(3).A := 4;
+           IF X4 /= ((1,TRUE,FALSE), (2,FALSE,TRUE), (4,TRUE,FALSE)) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - X4");
+           END IF;
+           X4 := (1 => (2,TRUE,FALSE), 2 => (1,FALSE,TRUE),
+                  3 => (3,TRUE,FALSE));
+           P1 (X4(3).B, X4(2).A, X4(1).C, "X4");
+           IF X4 /= ((2,TRUE,TRUE), (10,FALSE,TRUE), (3,TRUE,FALSE)) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X4");
+           END IF;
+ 
+           X1 := (A=>1, B=>FALSE, C=>TRUE);
+           IF C41301A.X1.C /= TRUE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - C41301A.X1");
+           END IF;
+           C41301A.X1.B := TRUE;
+           IF X1 /= (1, TRUE, TRUE) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - C41301A.X1");
+           END IF;
+           X1 := (A=>1, B=>FALSE, C=>TRUE);
+           P1 (C41301A.X1.C, C41301A.X1.A, C41301A.X1.B, "C41301A.X1");
+           IF X1 /= (10, TRUE, TRUE) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - " &
+                        "C41301A.X1");
+           END IF;
+ 
+           IF X5.J.C /= TRUE THEN
+                FAILED ("WRONG VALUE FOR EXPRESSION - X5");
+           END IF;
+           X5.J.C := FALSE;
+           IF X5 /= (5, (6, FALSE, FALSE)) THEN
+                FAILED ("WRONG TARGET FOR ASSIGNMENT - X5");
+           END IF;
+           X5 := (I => 5, J => (A=>1, B=>TRUE, C=>FALSE));
+           P1 (X5.J.B, X5.J.A, X5.J.C, "X5");
+           IF X5 /= (5, (10, TRUE, TRUE)) THEN
+                FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X5");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C41301A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C41303A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||  XXXXXXXXX  |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303A IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303A" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ACCESS TO RECORD  ---------------------------
+ 
+      DECLARE
+ 
+           TYPE  REC  IS
+ 
+                RECORD
+                     A , B , C : INTEGER ;
+                END RECORD ;
+ 
+           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+           REC_VAR      :  REC  :=    REC_CONST  ;
+ 
+           TYPE  ACC_REC  IS  ACCESS REC ;
+ 
+           ACC_REC_VAR  :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
+ 
+      BEGIN
+ 
+           REC_VAR          :=  ACC_REC_VAR.ALL ;
+ 
+           IF  REC_VAR /= ( 17 , 18 , 19 )
+           THEN
+                FAILED( "ACC. RECORD, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_REC_VAR.ALL  :=  REC_CONST ;
+ 
+           IF  ACC_REC_VAR.ALL /= ( 7 , 8 , 9 )
+           THEN
+                FAILED( "ACC. RECORD, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C41303B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||  XXXXXXXXX  |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303B IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303B" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ACCESS TO ARRAY  ----------------------------
+ 
+      DECLARE
+ 
+           TYPE  ARR  IS  ARRAY(1..2) OF BOOLEAN ;
+ 
+           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+           ARR_VAR      :  ARR  :=    ARR_CONST  ;
+ 
+           TYPE  ACC_ARR  IS  ACCESS ARR ;
+ 
+           ACC_ARR_VAR  :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
+ 
+      BEGIN
+ 
+           ARR_VAR          :=  ACC_ARR_VAR.ALL ;
+ 
+           IF  ARR_VAR /= ( FALSE , TRUE )
+           THEN
+                FAILED( "ACC. ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_ARR_VAR.ALL  :=  ARR_CONST ;
+ 
+           IF  ACC_ARR_VAR.ALL /= ( TRUE , FALSE )
+           THEN
+                FAILED( "ACC. ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C41303C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||  XXXXXXXXX  |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303C IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303C" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ACCESS TO SCALAR  ---------------------------
+ 
+      DECLARE
+ 
+           TYPE  NEWINT  IS  NEW INTEGER ;
+ 
+           NEWINT_CONST    :  NEWINT  :=  813 ;
+           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+ 
+           TYPE  ACC_NEWINT  IS  ACCESS NEWINT ;
+ 
+           ACC_NEWINT_VAR  :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
+ 
+      BEGIN
+ 
+           NEWINT_VAR          :=  ACC_NEWINT_VAR.ALL ;
+ 
+           IF  NEWINT_VAR /= ( 707 )
+           THEN
+                FAILED( "ACC. NEWINT, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_NEWINT_VAR.ALL  :=  NEWINT_CONST ;
+ 
+           IF  ACC_NEWINT_VAR.ALL /= 813 
+           THEN
+                FAILED( "ACC. NEWINT, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C41303E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||  XXXXXXXXX  |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303E IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303E" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+ 
+      DECLARE
+ 
+           TYPE  REC  IS
+ 
+                RECORD
+                     A , B , C : INTEGER ;
+                END RECORD ;
+ 
+ 
+           TYPE  ACCREC  IS  ACCESS REC ;
+ 
+           ACCREC_CONST    :  ACCREC  :=  NEW REC'( 7 , 8 , 9 );
+           ACCREC_VAR      :  ACCREC  :=    ACCREC_CONST  ;
+           ACCREC_CONST2   :  ACCREC  :=  NEW REC'( 17 , 18 , 19 );
+ 
+           TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
+ 
+           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
+ 
+      BEGIN
+ 
+           ACCREC_VAR          :=  ACC_ACCREC_VAR.ALL ;
+ 
+           IF  ACCREC_VAR /= ACCREC_CONST2
+           THEN
+                FAILED( "ACC2 RECORD, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_ACCREC_VAR.ALL  :=  ACCREC_CONST ;
+ 
+           IF  ACCREC_CONST /= ACC_ACCREC_VAR.ALL 
+           THEN
+                FAILED( "ACC2 RECORD, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C41303F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||  XXXXXXXXX  |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303F IS
+ 
+ BEGIN
+ 
+      TEST ( "C41303F" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+ 
+      DECLARE
+ 
+           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+           TYPE  ACCARR  IS  ACCESS ARR ;
+ 
+           ACCARR_CONST    :  ACCARR  :=  NEW ARR'( TRUE , FALSE );
+           ACCARR_VAR      :  ACCARR  :=    ACCARR_CONST  ;
+           ACCARR_CONST2   :  ACCARR  :=  NEW ARR'( FALSE , TRUE );
+ 
+           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+ 
+           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
+ 
+      BEGIN
+ 
+           ACCARR_VAR          :=  ACC_ACCARR_VAR.ALL ;
+ 
+           IF  ACCARR_VAR /= ACCARR_CONST2
+           THEN
+                FAILED( "ACC2 ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_ACCARR_VAR.ALL  :=  ACCARR_CONST ;
+ 
+           IF  ACCARR_CONST /= ACC_ACCARR_VAR.ALL
+           THEN
+                FAILED( "ACC2 ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,121 ----
+ -- C41303G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||  XXXXXXXXX  |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303G IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303G" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+ 
+      DECLARE
+ 
+           TYPE  NEWINT  IS  NEW INTEGER ;
+ 
+           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+ 
+           ACCNEWINT_CONST    :  ACCNEWINT  :=  NEW NEWINT'( 813 );
+           ACCNEWINT_VAR      :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
+           ACCNEWINT_CONST2   :  ACCNEWINT  :=  NEW NEWINT'( 707 );
+ 
+           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+ 
+           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                        ACCNEWINT_CONST2
+                                                                 );
+ 
+      BEGIN
+ 
+           ACCNEWINT_VAR          :=  ACC_ACCNEWINT_VAR.ALL ;
+ 
+           IF  ACCNEWINT_VAR /= ACCNEWINT_CONST2
+           THEN
+                FAILED( "ACC2 NEWINT, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_ACCNEWINT_VAR.ALL  :=  ACCNEWINT_CONST ;
+ 
+           IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL
+           THEN
+                FAILED( "ACC2 NEWINT, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,127 ----
+ -- C41303I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||  XXXXXXXXX  |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303I IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303I" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                         " ACCEPTED" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+ 
+      DECLARE
+ 
+           TYPE  REC  IS
+ 
+                RECORD
+                     A , B , C : INTEGER ;
+                END RECORD ;
+ 
+ 
+           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+           REC_VAR      :  REC  :=    REC_CONST  ;
+           REC_CONST2   :  REC  :=  ( 17 , 18 , 19 );
+ 
+           TYPE  ACCREC  IS  ACCESS REC ;
+ 
+           TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
+ 
+           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'( 
+                                             NEW REC'( REC_CONST2 )
+                                                       );
+ 
+      BEGIN
+ 
+           REC_VAR          :=  ACC_ACCREC_VAR.ALL.ALL ;
+ 
+           IF  REC_VAR /= REC_CONST2
+           THEN
+                FAILED( "ACC2 RECORD,RIGHT SIDE OF ASSIGN., WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_ACCREC_VAR.ALL.ALL  :=  REC_CONST ;
+ 
+           IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR.ALL.ALL 
+           THEN
+                FAILED( "ACC2 RECORD, LEFT SIDE OF ASSIGN., WRONG VAL.");
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- C41303J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||  XXXXXXXXX  |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303J IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303J" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                         " ACCEPTED" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+ 
+      DECLARE
+ 
+           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+ 
+           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+           ARR_VAR      :  ARR  :=    ARR_CONST  ;
+           ARR_CONST2   :  ARR  :=  ( FALSE , TRUE );
+ 
+           TYPE  ACCARR  IS  ACCESS ARR ;
+ 
+           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+ 
+           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(
+                                             NEW ARR'( ARR_CONST2 )
+                                                       );
+ 
+      BEGIN
+ 
+           ARR_VAR          :=  ACC_ACCARR_VAR.ALL.ALL ;
+ 
+           IF  ARR_VAR /= ARR_CONST2
+           THEN
+                FAILED( "ACC2 ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_ACCARR_VAR.ALL.ALL  :=  ARR_CONST ;
+ 
+           IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR.ALL.ALL
+           THEN
+                FAILED( "ACC2 ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C41303K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||  XXXXXXXXX  |
+ --      ============================================================
+ 
+ 
+ -- RM  1/20/82
+ -- RM  1/25/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303K IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303K" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                         " ACCEPTED" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+ 
+      DECLARE
+ 
+           TYPE  NEWINT  IS  NEW INTEGER ;
+ 
+           NEWINT_CONST    :  NEWINT  :=  ( 813 );
+           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+           NEWINT_CONST2   :  NEWINT  :=  ( 707 );
+ 
+           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+ 
+           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+ 
+           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                    NEW NEWINT' ( 
+                                                    NEWINT_CONST2
+                                                               )
+                                                                 );
+ 
+      BEGIN
+ 
+           NEWINT_VAR          :=  ACC_ACCNEWINT_VAR.ALL.ALL ;
+ 
+           IF  NEWINT_VAR /= NEWINT_CONST2
+           THEN
+                FAILED( "ACC2 NEWINT,RIGHT SIDE OF ASSIGN., WRONG VAL.");
+           END IF;
+ 
+ 
+           ACC_ACCNEWINT_VAR.ALL.ALL  :=  NEWINT_CONST ;
+ 
+           IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL.ALL
+           THEN
+                FAILED( "ACC2 NEWINT,LEFT SIDE OF ASSIGN., WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,150 ----
+ -- C41303M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |     XXXXXXXXX
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/22/82
+ -- RM  1/26/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303M IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303M" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
+                       & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
+                       & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
+                       & " ACTUAL PARAMETER OF ANY MODE" );
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ACCESS TO RECORD  ---------------------------
+ 
+      DECLARE
+ 
+           TYPE  REC  IS
+ 
+                RECORD
+                     A , B , C : INTEGER ;
+                END RECORD ;
+ 
+           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+           REC_VAR      :  REC  :=    REC_CONST  ;
+           REC_VAR0     :  REC  :=    REC_CONST  ;
+ 
+           TYPE  ACC_REC  IS  ACCESS REC ;
+ 
+           ACC_REC_VAR  :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
+           ACC_REC_VAR0 :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
+ 
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      REC ;
+                                R_INOUT : IN OUT  REC )  IS
+           BEGIN
+                REC_VAR   :=  R_IN    ;
+                REC_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  REC ;
+                                L_INOUT : IN OUT  REC )  IS
+           BEGIN
+                L_OUT   :=  REC_CONST ;
+                L_INOUT :=  REC_CONST ;
+           END ;
+ 
+      BEGIN
+ 
+           R_ASSIGN( ACC_REC_VAR.ALL , ACC_REC_VAR0.ALL );
+ 
+           IF  REC_VAR /= ( 17 , 18 , 19 )
+           THEN
+                FAILED( "ACC. RECORD, RIGHT SIDE (1), WRONG VAL.");
+           END IF;
+ 
+           IF  REC_VAR0 /= ( 17 , 18 , 19 )
+           THEN
+                FAILED( "ACC. RECORD, RIGHT SIDE (2), WRONG VAL.");
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_REC_VAR.ALL , ACC_REC_VAR0.ALL );
+ 
+           IF  ACC_REC_VAR.ALL /= ( 7 , 8 , 9 )
+           THEN
+               FAILED( "ACC. RECORD, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+ 
+           IF  ACC_REC_VAR0.ALL /= ( 7 , 8 , 9 )
+           THEN
+                FAILED( "ACC. RECORD, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303n.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303n.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303n.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- C41303N.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |     XXXXXXXXX
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/22/82
+ -- RM  1/26/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303N IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303N" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
+                       & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
+                       & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
+                       & " ACTUAL PARAMETER OF ANY MODE" );
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ACCESS TO ARRAY  ----------------------------
+ 
+      DECLARE
+ 
+           TYPE  ARR  IS  ARRAY(1..2) OF BOOLEAN ;
+ 
+           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+           ARR_VAR      :  ARR  :=    ARR_CONST  ;
+           ARR_VAR0     :  ARR  :=    ARR_CONST  ;
+ 
+           TYPE  ACC_ARR  IS  ACCESS ARR ;
+ 
+           ACC_ARR_VAR  :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
+           ACC_ARR_VAR0 :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
+ 
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      ARR ;
+                                R_INOUT : IN OUT  ARR )  IS
+           BEGIN
+                ARR_VAR   :=  R_IN    ;
+                ARR_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ARR ;
+                                L_INOUT : IN OUT  ARR )  IS
+           BEGIN
+                L_OUT   :=  ARR_CONST ;
+                L_INOUT :=  ARR_CONST ;
+           END ;
+ 
+      BEGIN
+ 
+ 
+           R_ASSIGN( ACC_ARR_VAR.ALL , ACC_ARR_VAR0.ALL );
+ 
+           IF  ARR_VAR /= ( FALSE , TRUE )                   
+           THEN
+                FAILED( "ACC. ARRAY, RIGHT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ARR_VAR0 /= ( FALSE , TRUE )
+           THEN
+                FAILED( "ACC. ARRAY, RIGHT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_ARR_VAR.ALL , ACC_ARR_VAR0.ALL );
+ 
+           IF  ACC_ARR_VAR.ALL /= ( TRUE , FALSE )
+           THEN
+                FAILED( "ACC. ARRAY, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+ 
+           IF  ACC_ARR_VAR0.ALL /= ( TRUE , FALSE )
+           THEN
+                FAILED( "ACC. ARRAY, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C41303O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |     XXXXXXXXX
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/27/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303O IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303O" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
+                       & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
+                       & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
+                       & " ACTUAL PARAMETER OF ANY MODE" );
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ACCESS TO SCALAR  ---------------------------
+ 
+      DECLARE
+ 
+           TYPE  NEWINT  IS  NEW INTEGER ;
+ 
+           NEWINT_CONST    :  NEWINT  :=  813 ;
+           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+           NEWINT_VAR0     :  NEWINT  :=  NEWINT_CONST  ;
+ 
+           TYPE  ACC_NEWINT  IS  ACCESS NEWINT ;
+ 
+           ACC_NEWINT_VAR  :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
+           ACC_NEWINT_VAR0 :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
+ 
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      NEWINT ;
+                                R_INOUT : IN OUT  NEWINT )  IS
+           BEGIN
+                NEWINT_VAR   :=  R_IN    ;
+                NEWINT_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  NEWINT ;
+                                L_INOUT : IN OUT  NEWINT )  IS
+           BEGIN
+                L_OUT   :=  NEWINT_CONST ;
+                L_INOUT :=  NEWINT_CONST ;
+           END ;
+ 
+ 
+      BEGIN
+ 
+           R_ASSIGN( ACC_NEWINT_VAR.ALL , ACC_NEWINT_VAR0.ALL );
+ 
+           IF  NEWINT_VAR /= ( 707 )
+           THEN
+                FAILED( "ACC. NEWINT, RIGHT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  NEWINT_VAR0 /= ( 707 )
+           THEN
+                FAILED( "ACC. NEWINT, RIGHT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_NEWINT_VAR.ALL , ACC_NEWINT_VAR0.ALL );
+ 
+           IF  ACC_NEWINT_VAR.ALL /= 813 
+           THEN
+                FAILED( "ACC. NEWINT, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ACC_NEWINT_VAR0.ALL /= 813 
+           THEN
+                FAILED( "ACC. NEWINT, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303q.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303q.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303q.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C41303Q.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |     XXXXXXXXX
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/28/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303Q IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303Q" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+ 
+      DECLARE
+ 
+           TYPE  REC  IS
+ 
+                RECORD
+                     A , B , C : INTEGER ;
+                END RECORD ;
+ 
+ 
+           TYPE  ACCREC  IS  ACCESS REC ;
+ 
+           ACCREC_CONST    :  ACCREC  :=  NEW REC'( 7 , 8 , 9 );
+           ACCREC_VAR      :  ACCREC  :=    ACCREC_CONST ;
+           ACCREC_VAR0     :  ACCREC  :=    ACCREC_CONST ;
+           ACCREC_CONST2   :  ACCREC  :=  NEW REC'( 17 , 18 , 19 );
+ 
+           TYPE ACC_ACCREC  IS  ACCESS ACCREC ;
+ 
+           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
+           ACC_ACCREC_VAR0 :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      ACCREC ;
+                                R_INOUT : IN OUT  ACCREC )  IS
+           BEGIN
+                ACCREC_VAR   :=  R_IN    ;
+                ACCREC_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCREC ;
+                                L_INOUT : IN OUT  ACCREC )  IS
+           BEGIN
+                L_OUT   :=  ACCREC_CONST ;
+                L_INOUT :=  ACCREC_CONST ;
+           END ;
+ 
+ 
+      BEGIN
+ 
+ 
+           R_ASSIGN( ACC_ACCREC_VAR.ALL , ACC_ACCREC_VAR0.ALL );
+ 
+           IF  ACCREC_VAR /= ACCREC_CONST2
+           THEN
+                FAILED( "ACC. RECORD, RIGHT SIDE (1), WRONG VAL.");
+           END IF;
+ 
+           IF  ACCREC_VAR0 /= ACCREC_CONST2
+           THEN
+                FAILED( "ACC. RECORD, RIGHT SIDE (2), WRONG VAL.");
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_ACCREC_VAR.ALL , ACC_ACCREC_VAR0.ALL );
+ 
+           IF  ACCREC_CONST /= ACC_ACCREC_VAR.ALL 
+           THEN
+               FAILED( "ACC. RECORD, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ACCREC_CONST /= ACC_ACCREC_VAR0.ALL 
+           THEN
+                FAILED( "ACC. RECORD, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303Q;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303r.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303r.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303r.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C41303R.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |     XXXXXXXXX
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/28/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303R IS
+ 
+ BEGIN
+ 
+      TEST ( "C41303R" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+ 
+      DECLARE
+ 
+           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+           TYPE  ACCARR  IS  ACCESS ARR ;
+ 
+           ACCARR_CONST    :  ACCARR  :=  NEW ARR'( TRUE , FALSE );
+           ACCARR_VAR      :  ACCARR  :=    ACCARR_CONST  ;
+           ACCARR_VAR0     :  ACCARR  :=    ACCARR_CONST  ;
+           ACCARR_CONST2   :  ACCARR  :=  NEW ARR'( FALSE , TRUE );
+ 
+           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+ 
+           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
+           ACC_ACCARR_VAR0 :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
+ 
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      ACCARR ;
+                                R_INOUT : IN OUT  ACCARR )  IS
+           BEGIN
+                ACCARR_VAR   :=  R_IN    ;
+                ACCARR_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCARR ;
+                                L_INOUT : IN OUT  ACCARR )  IS
+           BEGIN
+                L_OUT   :=  ACCARR_CONST ;
+                L_INOUT :=  ACCARR_CONST ;
+           END ;
+ 
+ 
+      BEGIN
+ 
+           R_ASSIGN( ACC_ACCARR_VAR.ALL, ACC_ACCARR_VAR0.ALL );
+ 
+           IF  ACCARR_VAR /= ACCARR_CONST2
+           THEN
+                FAILED( "ACC2 ARRAY, RIGHT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ACCARR_VAR0 /= ACCARR_CONST2
+           THEN
+                FAILED( "ACC2 ARRAY, RIGHT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_ACCARR_VAR.ALL , ACC_ACCARR_VAR0.ALL );
+ 
+           IF  ACCARR_CONST /= ACC_ACCARR_VAR.ALL
+           THEN
+                FAILED( "ACC2. ARRAY, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ACCARR_CONST /= ACC_ACCARR_VAR0.ALL
+           THEN
+                FAILED( "ACC2. ARRAY, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303R;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303s.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303s.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303s.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303s.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- C41303S.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |     XXXXXXXXX
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/28/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303S IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303S" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                     &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                     &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+ 
+      DECLARE
+ 
+           TYPE  NEWINT  IS  NEW INTEGER ;
+ 
+           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+ 
+           ACCNEWINT_CONST    :  ACCNEWINT  :=  NEW NEWINT'( 813 );
+           ACCNEWINT_VAR      :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
+           ACCNEWINT_VAR0     :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
+           ACCNEWINT_CONST2   :  ACCNEWINT  :=  NEW NEWINT'( 707 );
+ 
+           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+ 
+           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                        ACCNEWINT_CONST2
+                                                                 );
+ 
+           ACC_ACCNEWINT_VAR0 :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                        ACCNEWINT_CONST2
+                                                                 );
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      ACCNEWINT ;
+                                R_INOUT : IN OUT  ACCNEWINT )  IS
+           BEGIN
+                ACCNEWINT_VAR   :=  R_IN    ;
+                ACCNEWINT_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCNEWINT ;
+                                L_INOUT : IN OUT  ACCNEWINT )  IS
+           BEGIN
+                L_OUT   :=  ACCNEWINT_CONST ;
+                L_INOUT :=  ACCNEWINT_CONST ;
+           END ;
+ 
+ 
+      BEGIN
+ 
+           R_ASSIGN( ACC_ACCNEWINT_VAR.ALL , ACC_ACCNEWINT_VAR0.ALL  );
+ 
+           IF  ACCNEWINT_VAR /= ACCNEWINT_CONST2
+           THEN
+                FAILED( "ACC. NEWINT, RIGHT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ACCNEWINT_VAR0 /= ACCNEWINT_CONST2
+           THEN
+                FAILED( "ACC. NEWINT, RIGHT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_ACCNEWINT_VAR.ALL , ACC_ACCNEWINT_VAR0.ALL  );
+ 
+           IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL
+           THEN
+                FAILED( "ACC. NEWINT, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR0.ALL
+           THEN
+                FAILED( "ACC. NEWINT, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303S;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303u.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303u.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303u.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303u.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C41303U.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |     XXXXXXXXX
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/29/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303U IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303U" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                         " ACCEPTED" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+ 
+      DECLARE
+ 
+              TYPE  REC  IS
+ 
+                RECORD
+                     A , B , C : INTEGER ;
+                END RECORD ;
+ 
+ 
+           REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+           REC_VAR      :  REC  :=    REC_CONST  ;
+           REC_VAR0     :  REC  :=    REC_CONST  ;
+           REC_CONST2   :  REC  :=  ( 17 , 18 , 19 );
+ 
+           TYPE  ACCREC  IS  ACCESS REC ;
+ 
+           TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
+ 
+           ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'( 
+                                             NEW REC'( REC_CONST2 )
+                                                       );
+ 
+           ACC_ACCREC_VAR0 :  ACC_ACCREC :=  NEW ACCREC'( 
+                                             NEW REC'( REC_CONST2 )
+                                                       );
+ 
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      REC ;
+                                R_INOUT : IN OUT  REC )  IS
+           BEGIN
+                REC_VAR   :=  R_IN    ;
+                REC_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  REC ;
+                                L_INOUT : IN OUT  REC )  IS
+           BEGIN
+                L_OUT   :=  REC_CONST ;
+                L_INOUT :=  REC_CONST ;
+           END ;
+ 
+ 
+      BEGIN
+ 
+           R_ASSIGN( ACC_ACCREC_VAR.ALL.ALL , ACC_ACCREC_VAR0.ALL.ALL );
+ 
+           IF  REC_VAR /= REC_CONST2
+           THEN
+                FAILED( "ACC2 RECORD, RIGHT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  REC_VAR0 /= REC_CONST2
+           THEN
+                FAILED( "ACC2 RECORD, RIGHT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_ACCREC_VAR.ALL.ALL , ACC_ACCREC_VAR0.ALL.ALL );
+ 
+           IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR.ALL.ALL 
+           THEN
+                FAILED( "ACC2 RECORD, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR0.ALL.ALL 
+           THEN
+                FAILED( "ACC2 RECORD, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303U;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303v.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303v.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303v.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303v.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,155 ----
+ -- C41303V.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |     XXXXXXXXX
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ============================================================
+ 
+ 
+ -- RM  1/29/82
+ -- SPS 12/2/82
+ 
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303V IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303V" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                         " ACCEPTED" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+ 
+      DECLARE
+ 
+           TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+ 
+           ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+           ARR_VAR      :  ARR  :=    ARR_CONST  ;
+           ARR_VAR0     :  ARR  :=    ARR_CONST  ;
+           ARR_CONST2   :  ARR  :=  ( FALSE , TRUE );
+ 
+           TYPE  ACCARR  IS  ACCESS ARR ;
+ 
+           TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+ 
+           ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(
+                                             NEW ARR'( ARR_CONST2 )
+                                                       );
+ 
+           ACC_ACCARR_VAR0 :  ACC_ACCARR :=  NEW ACCARR'(
+                                             NEW ARR'( ARR_CONST2 )
+                                                       );
+ 
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      ARR ;
+                                R_INOUT : IN OUT  ARR )  IS
+           BEGIN
+                ARR_VAR   :=  R_IN    ;
+                ARR_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ARR ;
+                                L_INOUT : IN OUT  ARR )  IS
+           BEGIN
+                L_OUT   :=  ARR_CONST ;
+                L_INOUT :=  ARR_CONST ;
+           END ;
+ 
+ 
+      BEGIN
+ 
+ 
+           R_ASSIGN( ACC_ACCARR_VAR.ALL.ALL , ACC_ACCARR_VAR0.ALL.ALL );
+ 
+           IF  ARR_VAR /= ARR_CONST2
+           THEN
+                FAILED( "ACC2 ARRAY, RIGHT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ARR_VAR0 /= ARR_CONST2
+           THEN
+                FAILED( "ACC2 ARRAY, RIGHT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_ACCARR_VAR.ALL.ALL , ACC_ACCARR_VAR0.ALL.ALL );
+ 
+           IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR.ALL.ALL
+           THEN
+                FAILED( "ACC2 ARRAY, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR0.ALL.ALL
+           THEN
+                FAILED( "ACC2 ARRAY, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303V;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303w.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303w.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41303w.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41303w.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- C41303W.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+ --     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+ --     ANOTHER ACCESS OBJECT.
+ -- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+ --     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+ --     ACCEPTED.
+ 
+ 
+ -- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+ --     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+ 
+ 
+ --                              ||   ASSIGNMT  |  PROC. PARAMETERS
+ --                              ||  ():=  :=() | IN   OUT    IN OUT
+ --      ========================||=============|====================
+ --                 ACC REC      ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ARR      ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC SCLR     ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       1 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |
+ --      ========================||=============|====================
+ --                 ACC ACC REC  ||             |
+ --                --------------||-------------|--------------------
+ --       2 '.ALL'  ACC ACC ARR  ||             |
+ --                --------------||-------------|--------------------
+ --                 ACC ACC SCLR ||             |     XXXXXXXXX
+ --      ============================================================
+ 
+ 
+ -- RM  1/29/82
+ -- SPS 12/2/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41303W IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41303W" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                         " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                         " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                         " ACCEPTED" );
+ 
+ 
+      -------------------------------------------------------------------
+      ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+ 
+      DECLARE
+ 
+           TYPE  NEWINT  IS  NEW INTEGER ;
+ 
+           NEWINT_CONST    :  NEWINT  :=  ( 813 );
+           NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+           NEWINT_VAR0     :  NEWINT  :=  NEWINT_CONST  ;
+           NEWINT_CONST2   :  NEWINT  :=  ( 707 );
+ 
+           TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+ 
+           TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+ 
+           ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                    NEW NEWINT' ( 
+                                                    NEWINT_CONST2
+                                                               )
+                                                                 );
+ 
+           ACC_ACCNEWINT_VAR0 :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                    NEW NEWINT' ( 
+                                                    NEWINT_CONST2
+                                                               )
+                                                                 );
+ 
+           PROCEDURE  R_ASSIGN( R_IN    : IN      NEWINT ;
+                                R_INOUT : IN OUT  NEWINT )  IS
+           BEGIN
+                NEWINT_VAR   :=  R_IN    ;
+                NEWINT_VAR0  :=  R_INOUT ;
+           END ;
+ 
+ 
+           PROCEDURE  L_ASSIGN( L_OUT   :    OUT  NEWINT ;
+                                L_INOUT : IN OUT  NEWINT )  IS
+           BEGIN
+                L_OUT   :=  NEWINT_CONST ;
+                L_INOUT :=  NEWINT_CONST ;
+           END ;
+ 
+ 
+      BEGIN
+ 
+ 
+           R_ASSIGN( ACC_ACCNEWINT_VAR.ALL.ALL  ,
+                     ACC_ACCNEWINT_VAR0.ALL.ALL );
+ 
+           IF  NEWINT_VAR /= NEWINT_CONST2
+           THEN
+                FAILED( "ACC2 NEWINT, RIGHT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  NEWINT_VAR0 /= NEWINT_CONST2
+           THEN
+                FAILED( "ACC2 NEWINT, RIGHT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+           L_ASSIGN( ACC_ACCNEWINT_VAR.ALL.ALL  ,
+                     ACC_ACCNEWINT_VAR0.ALL.ALL );
+ 
+           IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL.ALL
+           THEN
+                FAILED( "ACC2 NEWINT, LEFT SIDE (1), WRONG VAL." );
+           END IF;
+ 
+           IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR0.ALL.ALL
+           THEN
+                FAILED( "ACC2 NEWINT, LEFT SIDE (2), WRONG VAL." );
+           END IF;
+ 
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41303W;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41304a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41304a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41304a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- C41304A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT L.R RAISES CONSTRAINT_ERROR WHEN:
+ --       L DENOTES AN ACCESS OBJECT HAVING THE VALUE NULL.
+ --       L IS A FUNCTION CALL DELIVERING THE ACCESS VALUE NULL.
+ 
+ -- HISTORY:
+ --     WKB 08/14/81
+ --     JRK 08/17/81
+ --     SPS 10/26/82
+ --     TBN 03/26/86  PUT THE NON-EXISTENT COMPONENT CASES INTO C41304B.
+ --     JET 01/05/88  MODIFIED HEADER FORMAT AND ADDED CODE TO PREVENT
+ --                   OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41304A IS
+ 
+      TYPE R IS
+           RECORD
+                I : INTEGER;
+           END RECORD;
+ 
+      TYPE T IS ACCESS R;
+ 
+ BEGIN
+      TEST ("C41304A", "CONSTRAINT_ERROR WHEN L IN L.R DENOTES A NULL " &
+                       "ACCESS OBJECT OR A FUNCTION CALL DELIVERING " &
+                       "NULL");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           A : T := NEW R' (I => 1);
+           J : INTEGER;
+ 
+      BEGIN
+ 
+           IF EQUAL (4, 4) THEN
+                A := NULL;
+           END IF;
+ 
+           J := A.I;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A NULL ACCESS " &
+                   "OBJECT");
+ 
+           IF EQUAL (J,J) THEN
+                COMMENT ("NO EXCEPTION RAISED");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR A NULL ACCESS " &
+                        "OBJECT");
+ 
+      END;
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           J : INTEGER;
+ 
+           FUNCTION F RETURN T IS
+           BEGIN
+                IF EQUAL (4, 4) THEN
+                     RETURN NULL;
+                END IF;
+                RETURN NEW R' (I => 2);
+           END F;
+ 
+      BEGIN
+ 
+           J := F.I;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
+                   "DELIVERING A NULL ACCESS VALUE");
+ 
+           IF EQUAL (J,J) THEN
+                COMMENT ("NO EXCEPTION RAISED");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
+                        "DELIVERING A NULL ACCESS VALUE");
+ 
+      END;
+ 
+      RESULT;
+ END C41304A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41304b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41304b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41304b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41304b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,198 ----
+ -- C41304B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT L.R RAISES CONSTRAINT_ERROR WHEN:
+ --        L DENOTES A RECORD OBJECT SUCH THAT, FOR THE EXISTING
+ --           DISCRIMINANT VALUES, THE COMPONENT DENOTED BY R DOES
+ --           NOT EXIST.
+ --        L IS A FUNCTION CALL DELIVERING A RECORD VALUE SUCH THAT,
+ --           FOR THE EXISTING DISCRIMINANT VALUES, THE COMPONENT
+ --           DENOTED BY R DOES NOT EXIST.
+ --        L IS AN ACCESS OBJECT AND THE OBJECT DESIGNATED BY THE ACCESS
+ --           VALUE IS SUCH THAT COMPONENT R DOES NOT EXIST FOR THE
+ --           OBJECT'S CURRENT DISCRIMINANT VALUES.
+ --        L IS A FUNCTION CALL RETURNING AN ACCESS VALUE AND THE OBJECT
+ --           DESIGNATED BY THE ACCESS VALUE IS SUCH THAT COMPONENT R
+ --           DOES NOT EXIST FOR THE OBJECT'S CURRENT DISCRIMINANT
+ --           VALUES.
+ 
+ -- HISTORY:
+ --     TBN 05/23/86  CREATED ORIGINAL TEST.
+ --     JET 01/08/88  MODIFIED HEADER FORMAT AND ADDED CODE TO
+ --                   PREVENT OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41304B IS
+ 
+      TYPE V (DISC : INTEGER := 0) IS
+           RECORD
+                CASE DISC IS
+                     WHEN 1 =>
+                          X : INTEGER;
+                     WHEN OTHERS =>
+                          Y : INTEGER;
+                END CASE;
+           END RECORD;
+ 
+      TYPE T IS ACCESS V;
+ 
+ BEGIN
+      TEST ("C41304B", "CHECK THAT L.R RAISES CONSTRAINT_ERROR WHEN " &
+                       "THE COMPONENT DENOTED BY R DOES NOT EXIST");
+ 
+      DECLARE
+ 
+           VR : V := (DISC => 0, Y => 4);
+           J : INTEGER;
+ 
+      BEGIN
+ 
+           IF EQUAL (4, 4) THEN
+                VR := (DISC => 1, X => 3);
+           END IF;
+ 
+           J := VR.Y;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A RECORD OBJECT");
+ 
+           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+ 
+           IF EQUAL (J,3) THEN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR A RECORD OBJECT");
+ 
+      END;
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           J : INTEGER;
+ 
+           FUNCTION F RETURN V IS
+           BEGIN
+                IF EQUAL (4, 4) THEN
+                     RETURN (DISC => 2, Y => 3);
+                END IF;
+                RETURN (DISC => 1, X => 4);
+           END F;
+ 
+      BEGIN
+ 
+           J := F.X;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
+                   "DELIVERING A RECORD VALUE");
+ 
+           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+ 
+           IF EQUAL (J,3) THEN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
+                        "DELIVERING A RECORD VALUE");
+ 
+      END;
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           A : T := NEW V' (DISC => 0, Y => 4);
+           J : INTEGER;
+ 
+      BEGIN
+ 
+           IF EQUAL (4, 4) THEN
+                A := NEW V' (DISC => 1, X => 3);
+           END IF;
+ 
+           J := A.Y;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR AN ACCESS OBJECT");
+ 
+           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+ 
+           IF EQUAL (J,3) THEN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR AN ACCESS OBJECT");
+ 
+      END;
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           J : INTEGER;
+ 
+           FUNCTION F RETURN T IS
+           BEGIN
+                IF EQUAL (4, 4) THEN
+                     RETURN NEW V' (DISC => 2, Y => 3);
+                END IF;
+                RETURN NEW V' (DISC => 1, X => 4);
+           END F;
+ 
+      BEGIN
+ 
+           J := F.X;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
+                   "DELIVERING AN ACCESS VALUE");
+ 
+           -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+ 
+           IF EQUAL (J,3) THEN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
+                        "DELIVERING AN ACCESS VALUE");
+ 
+      END;
+ 
+      RESULT;
+ END C41304B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41306a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41306a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41306a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41306a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C41306A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF  F  IS A FUNCTION RETURNING A TASK OF A TYPE HAVING
+ --     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
+ --
+ --                           F.E
+ --
+ --     IS PERMITTED.
+ 
+ 
+ -- RM  2/2/82
+ -- ABW 7/16/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C41306A IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C41306A" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
+                         " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
+                         " ENTRY CALL OF THE FORM  F.E  IS PERMITTED");
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           X  : INTEGER  :=  0 ;
+ 
+           TASK TYPE  T  IS
+                ENTRY  E ;
+           END  T ;
+ 
+           T1 : T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  E  DO
+                     X := IDENT_INT(17) ;
+                END  E ;
+                ACCEPT  E  DO
+                     X := IDENT_INT(16) ;
+                END  E ;
+           END  T ;
+ 
+           FUNCTION  F1  RETURN  T  IS
+           BEGIN
+                RETURN  T1 ;
+           END  F1 ;
+ 
+           FUNCTION F2 (A,B : BOOLEAN) RETURN T IS
+           BEGIN
+                IF A AND B THEN NULL; END IF;
+                RETURN T1;
+           END F2;
+ 
+      BEGIN
+ 
+           F1.E ;                                  -- X SET TO 17.
+ 
+           IF  X /= 17 THEN
+                FAILED("WRONG VALUE FOR GLOBAL VARIABLE - 1");
+           END IF;
+ 
+           X := 0;
+           F2(TRUE,TRUE).E;                        -- X SET TO 16.
+                             -- X TO BE SET TO 16.
+ 
+           IF X /= 16 THEN
+                FAILED("WRONG VALUE FOR GLOBAL VARIABLE - 2");
+           END IF;
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ 
+ END C41306A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41306b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41306b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41306b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41306b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,217 ----
+ -- C41306B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF  F  IS A FUNCTION RETURNING AN ACCESS VALUE DESIGNATING
+ --     A TASK OF A TYPE HAVING
+ --     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
+ --
+ --                           F.ALL.E
+ --
+ --     IS PERMITTED.
+ 
+ -- RM  02/02/82
+ -- ABW 07/16/82
+ -- EG  05/28/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C41306B IS
+ 
+ BEGIN
+ 
+      TEST ( "C41306B" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
+                         " AN ACCESS VALUE DESIGNATING"              &
+                         " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
+                         " ENTRY CALL OF THE FORM  F.ALL.E  IS"       &
+                         " PERMITTED" );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           X  : INTEGER  :=  0 ;
+ 
+           TASK TYPE  T  IS
+                ENTRY  E ;
+           END  T ;
+ 
+           TYPE  A_T  IS  ACCESS T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  E  DO
+                     X := IDENT_INT(17) ;
+                END  E ;
+           END  T ;
+ 
+           FUNCTION  F1  RETURN  A_T  IS
+                A_T_VAR1 : A_T := NEW T ;
+           BEGIN
+                RETURN  A_T_VAR1 ;
+           END  F1 ;
+ 
+           FUNCTION F2 (A, B : BOOLEAN) RETURN A_T IS
+                A_T_VAR2 : A_T := NEW T;
+           BEGIN
+                IF A AND B THEN
+                     NULL;
+                END IF;
+                RETURN A_T_VAR2;
+           END F2;
+ 
+      BEGIN
+ 
+           F1.ALL.E ;  --  THE ELABOR. OF  F1 (BODY)  ACTIVATES THE TASK,
+                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                       --      BE CALLED.
+ 
+                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+ 
+           IF  X /= 17
+           THEN
+                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (1)" );
+           END IF;
+ 
+           X := 0;
+           F2(TRUE, TRUE).ALL.E;    -- THE ELABORATION OF F2 (BODY)
+                                    -- ACTIVATES THE TASK, WHICH 
+                                    -- PROCEEDS TO WAIT FOR THE
+                                    -- ENTRY E TO BE CALLED.
+ 
+                                    -- THE CALLED ENTRY CAUSES X TO BE 
+                                    -- SET TO 17.
+ 
+           IF X /= 17 THEN
+                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (2)");
+           END IF;
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           X  : INTEGER  :=  0 ;
+ 
+           TASK TYPE  T  IS
+                ENTRY  E ;
+           END  T ;
+ 
+           TYPE  A_T  IS  ACCESS T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  E  DO
+                     X := IDENT_INT(17) ;
+                END  E ;
+           END  T ;
+ 
+           FUNCTION  F3  RETURN  A_T  IS
+           BEGIN
+                RETURN  NEW T ;
+           END  F3;
+ 
+           FUNCTION F4 (C, D : BOOLEAN) RETURN A_T IS
+           BEGIN
+                IF C AND D THEN
+                     NULL;
+                END IF;
+                RETURN NEW T;
+           END F4;
+ 
+      BEGIN
+ 
+           F3.ALL.E ;  --  THE ELABOR. OF  F3 (BODY)  ACTIVATES THE TASK,
+                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                       --      BE CALLED.
+ 
+                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+ 
+           IF  X /= 17
+           THEN
+                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (3)" );
+           END IF;
+ 
+           X := 0;
+           F4(TRUE, TRUE).ALL.E;    -- THE ELABORATION OF F4 (BODY)
+                                    -- ACTIVATES THE TASK, WHICH
+                                    -- PROCEEDS TO WAIT FOR THE
+                                    -- ENTRY E TO BE CALLED.
+ 
+                                    -- THE CALLED ENTRY CAUSES X TO BE
+                                    -- SET TO 17.
+ 
+           IF X /= 17 THEN
+                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (4)");
+           END IF;
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           X  : INTEGER  :=  0 ;
+ 
+           TASK TYPE  T  IS
+                ENTRY  E ;
+           END  T ;
+ 
+           TYPE  A_T  IS  ACCESS T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  E  DO
+                     X := IDENT_INT(17) ;
+                END  E ;
+           END  T ;
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                F3 : A_T := NEW T;
+ 
+           BEGIN
+ 
+                F3.ALL.E;
+ 
+                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+ 
+                IF  X /= 17 THEN
+                     FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (5)" );
+                END IF;
+ 
+           END;
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ 
+ END C41306B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41306c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41306c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41306c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41306c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,215 ----
+ -- C41306C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF  F  IS A FUNCTION RETURNING AN ACCESS VALUE DESIGNATING
+ --     A TASK OF A TYPE HAVING
+ --     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
+ --
+ --                           F.E
+ --
+ --     IS PERMITTED.
+ 
+ 
+ -- RM  02/02/82
+ -- ABW 07/16/82
+ -- EG  05/28/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C41306C IS
+ 
+ BEGIN
+ 
+      TEST ( "C41306C" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
+                         " AN ACCESS VALUE DESIGNATING"              &
+                         " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
+                         " ENTRY CALL OF THE FORM  F.E  IS PERMITTED" );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           X  : INTEGER  :=  0 ;
+ 
+           TASK TYPE  T  IS
+                ENTRY  E ;
+           END  T ;
+ 
+           TYPE  A_T  IS  ACCESS T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  E  DO
+                     X := IDENT_INT(17) ;
+                END  E ;
+           END  T ;
+ 
+           FUNCTION  F1  RETURN  A_T  IS
+                A_T_VAR1 : A_T := NEW T ;
+           BEGIN
+                RETURN  A_T_VAR1 ;
+           END  F1 ;
+ 
+           FUNCTION F2 (A, B : BOOLEAN) RETURN A_T IS
+                A_T_VAR2 : A_T := NEW T;
+           BEGIN
+                IF A AND B THEN
+                     NULL;
+                END IF;
+                RETURN A_T_VAR2;
+           END F2;
+ 
+      BEGIN
+ 
+           F1.E ;      --  THE ELABOR. OF  F1 (BODY)  ACTIVATES THE TASK,
+                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                       --      BE CALLED.
+ 
+                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+ 
+           IF  X /= 17
+           THEN
+                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (1)" );
+           END IF;
+ 
+           X := 0;
+           F2(TRUE, TRUE).E;   -- THE ELABORATION OF F2 (BODY) ACTIVATES
+                               -- THE TASK, WHICH PROCEEDS TO WAIT FOR
+                               -- ENTRY E TO BE CALLED.
+ 
+                               -- THE CALLED ENTRY CAUSES X TO BE SET TO
+                               -- 17.
+ 
+           IF X /= 17 THEN
+                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (2)");
+           END IF;
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           X  : INTEGER  :=  0 ;
+ 
+           TASK TYPE  T  IS
+                ENTRY  E ;
+           END  T ;
+ 
+           TYPE  A_T  IS  ACCESS T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  E  DO
+                     X := IDENT_INT(17) ;
+                END  E ;
+           END  T ;
+ 
+           FUNCTION  F3  RETURN  A_T  IS
+           BEGIN
+                RETURN  NEW T ;
+           END  F3;
+ 
+           FUNCTION F4 (C, D : BOOLEAN) RETURN A_T IS
+           BEGIN
+                IF C AND D THEN
+                     NULL;
+                END IF;
+                RETURN NEW T;
+           END F4;
+ 
+      BEGIN
+ 
+           F3.E ;      --  THE ELABOR. OF  F3 (BODY)  ACTIVATES THE TASK,
+                       --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                       --      BE CALLED.
+ 
+                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+ 
+           IF  X /= 17
+           THEN
+                FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (3)" );
+           END IF;
+ 
+           X := 0;
+           F4(TRUE, TRUE).E;   -- THE ELABORATION OF F4 (BODY) ACTIVATES
+                               -- THE TASK WHICH PROCEEDS TO WAIT FOR
+                               -- ENTRY E TO BE CALLED.
+ 
+                               -- THE CALLED ENTRY CAUSES X TO BE SET TO
+                               -- 17.
+ 
+           IF X /= 17 THEN
+                FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (4)");
+           END IF;
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           X  : INTEGER  :=  0 ;
+ 
+           TASK TYPE  T  IS
+                ENTRY  E ;
+           END  T ;
+ 
+           TYPE  A_T  IS  ACCESS T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  E  DO
+                     X := IDENT_INT(17) ;
+                END  E ;
+           END  T ;
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                F3 : A_T := NEW T;
+ 
+           BEGIN
+ 
+                F3.E;
+ 
+                       --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+ 
+                IF  X /= 17 THEN
+                     FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (5)" );
+                END IF;
+ 
+           END;
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ 
+ END C41306C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41307d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41307d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41307d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41307d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,255 ----
+ -- C41307D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, GENERIC PACKAGE,
+ -- SUBPROGRAM, GENERIC SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT
+ -- STATEMENT NAMED L, IF R IS DECLARED INSIDE THE UNIT.
+ 
+ -- TBN 12/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41307D IS
+ 
+ BEGIN
+      TEST ("C41307D", "CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, " &
+                       "GENERIC PACKAGE, SUBPROGRAM, GENERIC " &
+                       "SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT " &
+                       "STATEMENT NAMED L, IF R IS DECLARED INSIDE " &
+                       "THE UNIT");
+      DECLARE
+           PACKAGE L IS
+                R : INTEGER := 5;
+                A : INTEGER := L.R;
+           END L;
+ 
+           PACKAGE BODY L IS
+                B : INTEGER := L.R + 1;
+           BEGIN
+                IF IDENT_INT(A) /= 5 OR IDENT_INT(B) /= 6 THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+                END IF;
+           END L;
+ 
+           GENERIC
+                S : INTEGER;
+           PACKAGE M IS
+                X : INTEGER := M.S;
+           END M;
+ 
+           PACKAGE BODY M IS
+                Y : INTEGER := M.S + 1;
+           BEGIN
+                IF IDENT_INT(X) /= 2 OR
+                   IDENT_INT(Y) /= 3 OR
+                   IDENT_INT(M.X) /= 2 THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+                END IF;
+           END M;
+ 
+           PACKAGE Q IS NEW M(2);
+      BEGIN
+           IF IDENT_INT(Q.X) /= 2 THEN
+                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+           END IF;
+      END;
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           CH : CHARACTER := '6';
+ 
+           PROCEDURE L (R : IN OUT CHARACTER) IS
+                A : CHARACTER := L.R;
+           BEGIN
+                IF IDENT_CHAR(L.A) /= '6' THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+                END IF;
+                L.R := IDENT_CHAR('7');
+           END L;
+ 
+           GENERIC
+                S : CHARACTER;
+           PROCEDURE M;
+ 
+           PROCEDURE M IS
+                T : CHARACTER := M.S;
+           BEGIN
+                IF IDENT_CHAR(T) /= '3' OR IDENT_CHAR(M.S) /= '3' THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+                END IF;
+           END M;
+ 
+           PROCEDURE P1 IS NEW M('3');
+ 
+      BEGIN
+           L (CH);
+           IF CH /= IDENT_CHAR('7') THEN
+                FAILED ("INCORRECT RESULTS RETURNED FROM PROCEDURE - 6");
+           END IF;
+           P1;
+      END;
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           INT : INTEGER := 3;
+ 
+           FUNCTION L (R : INTEGER) RETURN INTEGER IS
+                A : INTEGER := L.R;
+           BEGIN
+                IF IDENT_INT(L.A) /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+                END IF;
+                RETURN IDENT_INT(4);
+           END L;
+ 
+           GENERIC
+                S : INTEGER;
+           FUNCTION M RETURN INTEGER;
+ 
+           FUNCTION M RETURN INTEGER IS
+                T : INTEGER := M.S;
+           BEGIN
+                IF IDENT_INT(M.T) /= 4 OR M.S /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+                END IF;
+                RETURN IDENT_INT(1);
+           END M;
+ 
+           FUNCTION F1 IS NEW M(4);
+ 
+      BEGIN
+           IF L(INT) /= 4 OR F1 /= 1 THEN
+                FAILED ("INCORRECT RESULTS RETURNED FROM FUNCTION - 9");
+           END IF;
+      END;
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           TASK L IS
+                ENTRY E (A : INTEGER);
+           END L;
+ 
+           TASK TYPE M IS
+                ENTRY E1 (A : INTEGER);
+           END M;
+ 
+           T1 : M;
+ 
+           TASK BODY L IS
+                X : INTEGER := IDENT_INT(1);
+                R : INTEGER RENAMES X;
+                Y : INTEGER := L.R;
+           BEGIN
+                X := X + L.R;
+                IF X /= IDENT_INT(2) OR Y /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
+                             "10");
+                END IF;
+           END L;
+ 
+           TASK BODY M IS
+                X : INTEGER := IDENT_INT(2);
+                R : INTEGER RENAMES X;
+                Y : INTEGER := M.R;
+           BEGIN
+                ACCEPT E1 (A : INTEGER) DO
+                     X := X + M.R;
+                     IF X /= IDENT_INT(4) OR Y /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                  "NAME - 11");
+                     END IF;
+                     IF E1.A /= IDENT_INT(3) THEN
+                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                  "NAME - 12");
+                     END IF;
+                END E1;
+           END M;
+      BEGIN
+           T1.E1 (3);
+      END;
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           TASK T IS
+                ENTRY G (1..2) (A : INTEGER);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT G (1) (A : INTEGER) DO
+                     IF G.A /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                  "NAME - 13");
+                     END IF;
+                     BLK:
+                          DECLARE
+                               B : INTEGER := 7;
+                          BEGIN
+                               IF T.BLK.B /= IDENT_INT(7) THEN
+                                    FAILED ("INCORRECT RESULTS FROM " &
+                                            "EXPANDED NAME - 14");
+                               END IF;
+                          END BLK;
+                END G;
+                ACCEPT G (2) (A : INTEGER) DO
+                     IF G.A /= IDENT_INT(1) THEN
+                          FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                  "NAME - 15");
+                     END IF;
+                END G;
+           END T;
+      BEGIN
+           T.G (1) (2);
+           T.G (2) (1);
+      END;
+      -------------------------------------------------------------------
+ 
+      SWAP:
+           DECLARE
+                VAR : CHARACTER := '*';
+                RENAME_VAR : CHARACTER RENAMES VAR;
+                NEW_VAR : CHARACTER;
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     NEW_VAR := SWAP.RENAME_VAR;
+                END IF;
+                IF NEW_VAR /= IDENT_CHAR('*') THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
+                             "16");
+                END IF;
+                LP:  FOR I IN 1..2 LOOP
+                          IF SWAP.LP.I = IDENT_INT(2) OR
+                             LP.I = IDENT_INT(1) THEN
+                               GOTO SWAP.LAB1;
+                          END IF;
+                          NEW_VAR := IDENT_CHAR('+');
+                          <<LAB1>>
+                          NEW_VAR := IDENT_CHAR('-');
+                     END LOOP LP;
+                IF NEW_VAR /= IDENT_CHAR('-') THEN
+                     FAILED ("INCORRECT RESULTS FROM FOR LOOP - 17");
+                END IF;
+           END SWAP;
+ 
+      RESULT;
+ END C41307D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41309a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41309a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41309a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41309a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- C41309A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXPANDED NAME IS ALLOWED EVEN IF A USE CLAUSE MAKES THE
+ -- EXPANDED NAME UNNECESSARY.
+ 
+ -- TBN  12/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41309A IS
+ 
+ BEGIN
+      TEST ("C41309A", "CHECK THAT AN EXPANDED NAME IS ALLOWED EVEN " &
+                       "IF A USE CLAUSE MAKES THE EXPANDED NAME " &
+                       "UNNECESSARY");
+      DECLARE
+           PACKAGE P IS
+                PACKAGE Q IS
+                     PACKAGE R IS
+                          TYPE REC IS
+                               RECORD
+                                    A : INTEGER := 5;
+                                    B : BOOLEAN := TRUE;
+                               END RECORD;
+                          REC1 : REC;
+                     END R;
+ 
+                     USE R;
+ 
+                     REC2 : R.REC := R.REC1;
+                END Q;
+ 
+                USE Q; USE R;
+ 
+                REC3 : Q.R.REC := Q.REC2;
+           END P;
+ 
+           USE P; USE Q; USE R;
+ 
+           REC4 : P.Q.R.REC := P.REC3;
+      BEGIN
+           IF REC4 /= (IDENT_INT(5), IDENT_BOOL(TRUE)) THEN
+                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C41309A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41320a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41320a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41320a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41320a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C41320A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT IMPLICITLY DECLARED ENUMERATION LITERALS, CHARACTER
+ --    LITERALS, AND THE RELATIONAL OPERATORS CAN BE SELECTED FROM
+ --    OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR ENUMERATION TYPES.
+ 
+ -- HISTORY:
+ --    TBN 07/15/86  CREATED ORIGINAL TEST.
+ --    JET 08/04/87  ADDED TEST FOR OVERLOADED VARIABLES.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41320A IS
+ 
+      PACKAGE P IS
+           TYPE FLAG IS (RED, WHITE, BLUE);
+           TYPE ROMAN_DIGITS IS ('I', 'V', 'X', 'C', 'M');
+           TYPE TRAFFIC_LIGHT IS (RED, YELLOW, GREEN);
+           TYPE HEX IS ('A', 'B', 'C', 'D', 'E', 'F');
+           FLAG_COLOR_1 : FLAG := RED;
+           FLAG_COLOR_2 : FLAG := WHITE;
+           TRAFFIC_LIGHT_COLOR_1 : FLAG := RED;
+           HEX_3 : HEX := 'C';
+           ROMAN_1 : ROMAN_DIGITS := 'I';
+      END P;
+ 
+      USA_FLAG_1 : P.FLAG := P.RED;
+      USA_FLAG_3 : P.FLAG := P.BLUE;
+      HEX_CHAR_3 : P.HEX := P.'C';
+      ROMAN_DIGITS_4 : P.ROMAN_DIGITS := P.'C';
+      TRAFFIC_LIGHT_1 : P.TRAFFIC_LIGHT := P.RED;
+ 
+ BEGIN
+      TEST ("C41320A", "CHECK THAT IMPLICITLY DECLARED ENUMERATION " &
+                       "LITERALS, CHARACTER LITERALS, AND THE " &
+                       "RELATIONAL OPERATORS CAN BE SELECTED FROM " &
+                       "OUTSIDE THE PACKAGE USING AN EXPANDED NAME " &
+                       "FOR ENUMERATION TYPES");
+ 
+      IF P."/=" (USA_FLAG_1, P.FLAG_COLOR_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."=" (USA_FLAG_3, P.FLAG_COLOR_2) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      IF P."<" (HEX_CHAR_3, P.HEX_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+      END IF;
+ 
+      IF P.">" (P.ROMAN_1, ROMAN_DIGITS_4) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+      END IF;
+ 
+      IF P.">=" (TRAFFIC_LIGHT_1, P.TRAFFIC_LIGHT'PRED (P.GREEN)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+      END IF;
+ 
+      FOR J IN P.FLAG'(P.WHITE) .. P.FLAG'(P.WHITE) LOOP
+           IF P."<=" (P.FLAG'SUCC (P.WHITE), J) THEN
+                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+           END IF;
+      END LOOP;
+ 
+      IF P.">=" (P.RED, P.GREEN) THEN
+           FAILED ("INCORRECT RESULT FROM OVERLOADED VARIABLE NAME - 1");
+      END IF;
+ 
+      IF P."<=" (P.BLUE, P.RED) THEN
+           FAILED ("INCORRECT RESULT FROM OVERLOADED VARIABLE NAME - 2");
+      END IF;
+ 
+      RESULT;
+ END C41320A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41321a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41321a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41321a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41321a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- C41321A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS, LOGICAL 
+ -- OPERATORS, AND THE "NOT" OPERATOR MAY BE SELECTED FROM OUTSIDE
+ -- THE PACKAGE USING AN EXPANDED NAME, FOR A DERIVED BOOLEAN TYPE.
+ 
+ -- TBN  7/16/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41321A IS
+ 
+      PACKAGE P IS
+           TYPE DERIVED_BOOLEAN IS NEW BOOLEAN RANGE FALSE .. TRUE;
+           DERIVED_FALSE : DERIVED_BOOLEAN := FALSE;
+           DERIVED_TRUE : DERIVED_BOOLEAN := TRUE;
+      END P;
+ 
+      DBOOL_FALSE : P.DERIVED_BOOLEAN := P.FALSE;
+      DBOOL_TRUE : P.DERIVED_BOOLEAN := P.TRUE;
+ 
+ BEGIN
+      TEST ("C41321A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                       "OPERATORS, LOGICAL OPERATORS, AND THE 'NOT' " &
+                       "OPERATOR MAY BE SELECTED FROM OUTSIDE THE " &
+                       "PACKAGE USING AN EXPANDED NAME, FOR A DERIVED " &
+                       "BOOLEAN TYPE");
+ 
+      IF P."=" (DBOOL_FALSE, P.DERIVED_TRUE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."/=" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      IF P."<" (P.DERIVED_TRUE, P.DERIVED_FALSE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+      END IF;
+ 
+      IF P.">" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+      END IF;
+ 
+      IF P."<=" (P.DERIVED_TRUE, DBOOL_FALSE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+      END IF;
+ 
+      IF P."<=" (P.DERIVED_TRUE, DBOOL_TRUE) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+      END IF;
+ 
+      IF P.">=" (P.DERIVED_TRUE, DBOOL_TRUE) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+      END IF;
+ 
+      FOR J IN P.DERIVED_BOOLEAN'(P.TRUE) .. P.DERIVED_BOOLEAN'(P.TRUE)
+           LOOP
+                IF P.">=" (DBOOL_FALSE, J) THEN
+                     FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+                END IF;
+           END LOOP;
+ 
+      IF P."AND" (DBOOL_FALSE, P.DERIVED_TRUE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+      END IF;
+ 
+      IF P."OR" (DBOOL_FALSE, P.DERIVED_FALSE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+      END IF;
+ 
+      IF P."XOR" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+      END IF;
+ 
+      IF P."NOT" (P.DERIVED_TRUE) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+      END IF;
+ 
+      RESULT;
+ END C41321A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41322a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41322a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41322a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41322a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C41322A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
+ -- OPERATORS (+, -, *, /, **, ABS, MOD, REM) MAY BE SELECTED FROM
+ -- OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR AN INTEGER TYPE.
+ 
+ -- TBN  7/16/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41322A IS
+ 
+      PACKAGE P IS
+           TYPE INT IS RANGE -10 .. 10;
+           OBJ_INT_1 : INT := -10;
+           OBJ_INT_2 : INT := 1;
+           OBJ_INT_3 : INT := 10;
+      END P;
+ 
+      INT_VAR : P.INT;
+      INT_VAR_1 : P.INT := P."-"(P.INT'(10));
+      INT_VAR_2 : P.INT := P.INT'(1);
+      INT_VAR_3 : P.INT := P.INT'(10);
+ 
+ BEGIN
+      TEST ("C41322A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                       "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
+                       "/, **, ABS, MOD, REM) MAY BE SELECTED FROM " &
+                       "OUTSIDE THE PACKAGE USING AN EXPANDED NAME, " &
+                       "FOR AN INTEGER TYPE");
+ 
+      IF P."=" (INT_VAR_1, P.INT'(2)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."/=" (INT_VAR_1, P.OBJ_INT_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      IF P."<" (INT_VAR_2, 0) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+      END IF;
+ 
+      IF P.">" (INT_VAR_2, P.OBJ_INT_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+      END IF;
+ 
+      IF P."<=" (INT_VAR_3, P.INT'(9)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+      END IF;
+ 
+      FOR J IN P.INT'(4) .. P.INT'(4) LOOP
+           IF P.">=" (J, INT_VAR_3) THEN
+                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+           END IF;
+      END LOOP;
+ 
+      INT_VAR := P."+" (INT_VAR_1, P.INT'(2));
+      IF P."/=" (INT_VAR, P."-"(P.INT'(8))) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+      END IF;
+ 
+      INT_VAR := P."+" (P.INT'(2));
+      IF P."/=" (INT_VAR, P.INT'(2)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+      END IF;
+ 
+      INT_VAR := P."-" (INT_VAR_2, P.INT'(0));
+      IF P."/=" (INT_VAR, P.OBJ_INT_2) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+      END IF;
+ 
+      INT_VAR := P."*" (INT_VAR_2, P.INT'(5));
+      IF P."/=" (INT_VAR, P.INT'(5)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+      END IF;
+ 
+      INT_VAR := P."/" (INT_VAR_3, P.INT'(2));
+      IF P."/=" (INT_VAR, P.INT'(5)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+      END IF;
+ 
+      INT_VAR := P."**" (P.INT'(2), 3);
+      IF P."/=" (INT_VAR, P.INT'(8)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+      END IF;
+ 
+      INT_VAR := P."ABS" (INT_VAR_1);
+      IF P."/=" (INT_VAR, P.OBJ_INT_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+      END IF;
+ 
+      INT_VAR := P."MOD" (INT_VAR_1, P.INT'(3));
+      IF P."/=" (INT_VAR, P.INT'(2)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+      END IF;
+ 
+      INT_VAR := P."REM" (INT_VAR_1, P.INT'(3));
+      IF P."/=" (INT_VAR, P."-" (INT_VAR_2)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
+      END IF;
+ 
+      RESULT;
+ END C41322A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41323a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41323a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41323a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41323a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C41323A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
+ -- OPERATORS (+, -, *, /, **, ABS) MAY BE SELECTED FROM OUTSIDE THE
+ -- PACKAGE USING AN EXPANDED NAME, FOR A FLOATING POINT TYPE.
+ 
+ -- TBN  7/16/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41323A IS
+ 
+      PACKAGE P IS
+           TYPE FLOAT IS DIGITS 5 RANGE -1.0E1 .. 1.0E1;
+           OBJ_FLO_1 : FLOAT := -5.5;
+           OBJ_FLO_2 : FLOAT := 1.5;
+           OBJ_FLO_3 : FLOAT := 10.0;
+      END P;
+ 
+      FLO_VAR : P.FLOAT;
+      FLO_VAR_1 : P.FLOAT := P."-"(P.FLOAT'(5.5));
+      FLO_VAR_2 : P.FLOAT := P.FLOAT'(1.5);
+      FLO_VAR_3 : P.FLOAT := P.FLOAT'(1.0E1);
+ 
+ BEGIN
+      TEST ("C41323A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                       "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
+                       "/, **, ABS) MAY BE SELECTED FROM OUTSIDE THE " &
+                       "PACKAGE USING AN EXPANDED NAME, FOR A " &
+                       "FLOATING POINT TYPE");
+ 
+      IF P."=" (FLO_VAR_1, P."-"(P.FLOAT'(5.55))) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."/=" (FLO_VAR_1, P.OBJ_FLO_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      IF P."<" (FLO_VAR_2, P.OBJ_FLO_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+      END IF;
+ 
+      IF P.">" (FLO_VAR_2, P.OBJ_FLO_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+      END IF;
+ 
+      IF P."<=" (FLO_VAR_3, P.FLOAT'(9.9)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+      END IF;
+ 
+      IF P."<=" (FLO_VAR_3, P.FLOAT'(10.0)) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+      END IF;
+ 
+      IF P.">=" (P.OBJ_FLO_2, FLO_VAR_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+      END IF;
+ 
+      IF P.">=" (P.OBJ_FLO_3, FLO_VAR_3) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+      END IF;
+ 
+      FLO_VAR := P."+" (FLO_VAR_1, P.OBJ_FLO_2);
+      IF P."/=" (FLO_VAR, P."-"(P.FLOAT'(4.0))) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+      END IF;
+ 
+      FLO_VAR := P."+" (FLO_VAR_1);
+      IF P."/=" (FLO_VAR, P.OBJ_FLO_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+      END IF;
+ 
+      FLO_VAR := P."-" (FLO_VAR_2, P.OBJ_FLO_1);
+      IF P."/=" (FLO_VAR, P.FLOAT'(7.0)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+      END IF;
+ 
+      FLO_VAR := P."*" (FLO_VAR_2, P.FLOAT'(2.0));
+      IF P."/=" (FLO_VAR, P.FLOAT'(3.0)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+      END IF;
+ 
+      FLO_VAR := P."/" (FLO_VAR_3, P.FLOAT'(2.0));
+      IF P."/=" (FLO_VAR, P.FLOAT'(5.0)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+      END IF;
+ 
+      FLO_VAR := P."**" (P.FLOAT'(2.0), 3);
+      IF P."/=" (FLO_VAR, P.FLOAT'(8.0)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+      END IF;
+ 
+      FLO_VAR := P."ABS" (FLO_VAR_1);
+      IF P."/=" (FLO_VAR, P.FLOAT'(5.5)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
+      END IF;
+ 
+      RESULT;
+ END C41323A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41324a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41324a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41324a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41324a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C41324A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
+ -- OPERATORS (+, -, *, /, ABS) MAY BE SELECTED FROM OUTSIDE THE
+ -- PACKAGE USING AN EXPANDED NAME, FOR A FIXED POINT TYPE.
+ 
+ -- TBN  7/16/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41324A IS
+ 
+      PACKAGE P IS
+           TYPE FIXED IS DELTA 0.125 RANGE -1.0E1 .. 1.0E1;
+           OBJ_FIX_1 : FIXED := -5.5;
+           OBJ_FIX_2 : FIXED := 1.5;
+           OBJ_FIX_3 : FIXED := 10.0;
+      END P;
+ 
+      FIX_VAR : P.FIXED;
+      FIX_VAR_1 : P.FIXED := P."-"(P.FIXED'(5.5));
+      FIX_VAR_2 : P.FIXED := P.FIXED'(1.5);
+      FIX_VAR_3 : P.FIXED := P.FIXED'(1.0E1);
+ 
+ BEGIN
+      TEST ("C41324A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                       "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
+                       "/, ABS) MAY BE SELECTED FROM OUTSIDE THE " &
+                       "PACKAGE USING AN EXPANDED NAME, FOR A FIXED " &
+                       "POINT TYPE");
+ 
+      IF P."=" (FIX_VAR_1, P."-"(P.FIXED'(6.0))) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."/=" (FIX_VAR_1, P.OBJ_FIX_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      IF P."<" (FIX_VAR_2, P.OBJ_FIX_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+      END IF;
+ 
+      IF P.">" (FIX_VAR_2, P.OBJ_FIX_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+      END IF;
+ 
+      IF P."<=" (FIX_VAR_3, P.FIXED'(9.9)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+      END IF;
+ 
+      IF P."<=" (FIX_VAR_3, P.FIXED'(10.0)) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+      END IF;
+ 
+      IF P.">=" (P.OBJ_FIX_2, FIX_VAR_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+      END IF;
+ 
+      IF P.">=" (P.OBJ_FIX_2, FIX_VAR_2) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+      END IF;
+ 
+      FIX_VAR := P."+" (FIX_VAR_1, P.OBJ_FIX_2);
+      IF P."/=" (FIX_VAR, P."-"(P.FIXED'(4.0))) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+      END IF;
+ 
+      FIX_VAR := P."-" (FIX_VAR_2, P.OBJ_FIX_1);
+      IF P."/=" (FIX_VAR, P.FIXED'(7.0)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+      END IF;
+ 
+      FIX_VAR := P."*" (FIX_VAR_2, 2);
+      IF P."/=" (FIX_VAR, P.FIXED'(3.0)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+      END IF;
+ 
+      FIX_VAR := P."*" (3, FIX_VAR_2);
+      IF P."/=" (FIX_VAR, P.FIXED'(4.5)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+      END IF;
+ 
+      FIX_VAR := P."/" (FIX_VAR_3, 2);
+      IF P."/=" (FIX_VAR, P.FIXED'(5.0)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+      END IF;
+ 
+      FIX_VAR := P."ABS" (FIX_VAR_1);
+      IF P."/=" (FIX_VAR, P.FIXED'(5.5)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+      END IF;
+ 
+      RESULT;
+ END C41324A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41325a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41325a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41325a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41325a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,173 ----
+ -- C41325A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FOLLOWING IMPLICITLY DECLARED ENTITIES CAN BE SELECTED
+ -- FROM OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR AN ARRAY TYPE.
+ --     CASE 1: CHECK EQUALITY AND INEQUALITY WHEN COMPONENT TYPE IS
+ --               NON-LIMITED, FOR MULTIDIMENSIONAL ARRAYS.
+ --     CASE 2: FOR ONE DIMENSIONAL ARRAYS:
+ --               A) CHECK CATENATION, EQUALITY, AND INEQUALITY WHEN 
+ --                    COMPONENT TYPE IS NON-LIMITED.
+ --               B) CHECK RELATIONAL OPERATORS WHEN COMPONENT TYPE IS 
+ --                    DISCRETE.
+ --               C) CHECK THE "NOT" OPERATOR AND THE LOGICAL OPERATORS 
+ --                    WHEN COMPONENT TYPE IS BOOLEAN.
+ 
+ -- TBN  7/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41325A IS
+ 
+      PACKAGE P IS
+           TYPE CATARRAY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+           TYPE ARRAY_1 IS ARRAY (1..10) OF INTEGER;
+           TYPE ARRAY_2 IS ARRAY (1..4, 1..4) OF INTEGER;
+           TYPE ARRAY_3 IS ARRAY (1..2, 1..3, 1..4) OF INTEGER;
+           TYPE ARRAY_4 IS ARRAY (1..10) OF BOOLEAN;
+           TYPE ARRAY_5 IS ARRAY (1..4, 1..4) OF BOOLEAN;
+           TYPE ARRAY_6 IS ARRAY (1..2, 1..3, 1..4) OF BOOLEAN;
+ 
+           OBJ_ARA_1 : ARRAY_1 := (1..10 => IDENT_INT(0));
+           OBJ_ARA_2 : ARRAY_2 := (1..4 => (1..4 => IDENT_INT(0)));
+           OBJ_ARA_3 : ARRAY_3 := (1..2 => (1..3 =>
+                                                (1..4 => IDENT_INT(0))));
+           OBJ_ARA_4 : ARRAY_4 := (1..10 => IDENT_BOOL(FALSE));
+           OBJ_ARA_5 : ARRAY_5 := (1..4 => (1..4 => IDENT_BOOL(FALSE)));
+           OBJ_ARA_6 : ARRAY_6 := (1..2 => (1..3 =>
+                                           (1..4 => IDENT_BOOL(FALSE))));
+           OBJ_ARA_7 : CATARRAY (1..10) := (1..10 => IDENT_INT(0));
+           OBJ_ARA_20 : CATARRAY (1..20) := (1..10 => 1,
+                                                 11..20 => IDENT_INT(0));
+      END P;
+ 
+      VAR_ARA_1 : P.ARRAY_1 := (1..10 => IDENT_INT(1));
+      VAR_ARA_2 : P.ARRAY_2 := (1..4 => (1..4 => IDENT_INT(1)));
+      VAR_ARA_3 : P.ARRAY_3 := (1..2 => (1..3 =>
+                                                (1..4 => IDENT_INT(1))));
+      VAR_ARA_4 : P.ARRAY_4 := (1..10 => IDENT_BOOL(TRUE));
+      VAR_ARA_5 : P.ARRAY_5 := (1..4 => (1..4 => IDENT_BOOL(TRUE)));
+      VAR_ARA_6 : P.ARRAY_6 := (1..2 => (1..3 =>
+                                            (1..4 => IDENT_BOOL(TRUE))));
+      VAR_ARA_7 : P.CATARRAY (1..10) := (1..10 => IDENT_INT(1));
+      VAR_ARA_8 : P.ARRAY_4 := (1..10 => IDENT_BOOL(TRUE));
+      VAR_ARA_20 : P.CATARRAY (1..20) := (1..20 => IDENT_INT(0));
+ 
+ BEGIN
+      TEST ("C41325A", "CHECK THAT IMPLICITLY DECLARED ENTITIES CAN " &
+                       "BE SELECTED FROM OUTSIDE THE PACKAGE USING AN " &
+                       "EXPANDED NAME, FOR AN ARRAY TYPE");
+ 
+      -- CASE 1: MULTIDIMENSIONAL ARRAYS.
+ 
+      IF P."=" (VAR_ARA_2, P.OBJ_ARA_2) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."=" (VAR_ARA_5, P.OBJ_ARA_5) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      IF P."/=" (VAR_ARA_2, P.ARRAY_2'(1..4 => (1..4 => 1))) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+      END IF;
+ 
+      IF P."/=" (VAR_ARA_5, P.ARRAY_5'(1..4 => (1..4 => TRUE))) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+      END IF;
+ 
+      IF P."=" (VAR_ARA_3, P.OBJ_ARA_3) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+      END IF;
+ 
+      IF P."/=" (VAR_ARA_6, P.ARRAY_6'(1..2 =>(1..3 =>(1..4 => TRUE)))) 
+           THEN
+                FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+      END IF;
+ 
+      -- CASE 2: ONE DIMENSIONAL ARRAYS.
+ 
+      IF P."=" (VAR_ARA_1, P.OBJ_ARA_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+      END IF;
+ 
+      IF P."/=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+      END IF;
+ 
+      VAR_ARA_20 := P."&" (VAR_ARA_7, P.OBJ_ARA_7);
+      IF P."/=" (VAR_ARA_20, P.OBJ_ARA_20) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+      END IF;
+ 
+      IF P."<" (VAR_ARA_1, P.OBJ_ARA_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+      END IF;
+ 
+      IF P.">" (P.OBJ_ARA_1, VAR_ARA_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+      END IF;
+ 
+      IF P."<=" (VAR_ARA_1, P.OBJ_ARA_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+      END IF;
+ 
+      IF P."<=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+      END IF;
+ 
+      IF P.">=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 2)) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+      END IF;
+ 
+      IF P.">=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
+      END IF;
+ 
+      VAR_ARA_8 := P."NOT" (VAR_ARA_4);
+      IF P."/=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 16");
+      END IF;
+ 
+      VAR_ARA_8 := P."OR" (VAR_ARA_4, P.OBJ_ARA_4);
+      IF P."=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 17");
+      END IF;
+ 
+      VAR_ARA_8 := P."AND" (VAR_ARA_4, P.OBJ_ARA_4);
+      IF P."/=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 18");
+      END IF;
+ 
+      VAR_ARA_8 := P."XOR" (VAR_ARA_4, P.OBJ_ARA_4);
+      IF P."=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 19");
+      END IF;
+ 
+      RESULT;
+ END C41325A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41326a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41326a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41326a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41326a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C41326A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED EQUALITY AND INEQUALITY OPERATORS
+ -- MAY BE SELECTED FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR
+ -- AN ACCESS TYPE.
+ 
+ -- TBN  7/18/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41326A IS
+ 
+      PACKAGE P IS
+           TYPE CELL IS
+                RECORD
+                     VALUE : INTEGER;
+                END RECORD;
+           TYPE LINK IS ACCESS CELL;
+ 
+           OBJ_LINK_1 : LINK := NEW CELL'(VALUE => 1);
+           OBJ_LINK_2 : LINK := OBJ_LINK_1;
+      END P;
+ 
+      VAR_LINK_1 : P.LINK := NEW P.CELL'(VALUE => 1);
+      VAR_LINK_2 : P.LINK := NEW P.CELL'(VALUE => 2);
+ 
+ BEGIN
+      TEST ("C41326A", "CHECK THAT IMPLICITLY DECLARED EQUALITY AND " &
+                       "INEQUALITY OPERATORS MAY BE SELECTED FROM " &
+                       "OUTSIDE A PACKAGE USING AN EXPANDED NAME, " &
+                       "FOR AN ACCESS TYPE");
+ 
+      IF P."=" (VAR_LINK_1, P.OBJ_LINK_1) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."/=" (P.OBJ_LINK_1, P.OBJ_LINK_2) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      IF P."=" (VAR_LINK_2.ALL, P.OBJ_LINK_1.ALL) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+      END IF;
+ 
+      VAR_LINK_2.VALUE := 1;
+      IF P."/=" (VAR_LINK_2.ALL, P.OBJ_LINK_1.ALL) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+      END IF;
+ 
+      RESULT;
+ END C41326A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41327a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41327a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41327a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41327a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C41327A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED EQUALITY AND INEQUALITY OPERATORS
+ -- MAY BE SELECTED FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR
+ -- A PRIVATE TYPE.
+ 
+ -- TBN  7/18/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41327A IS
+ 
+      PACKAGE P IS
+           TYPE KEY IS PRIVATE;
+           TYPE CHAR IS PRIVATE;
+           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
+           FUNCTION INIT_CHAR (X : CHARACTER) RETURN CHAR;
+      PRIVATE
+           TYPE KEY IS NEW NATURAL;
+           TYPE CHAR IS NEW CHARACTER;
+      END P;
+ 
+      VAR_KEY_1 : P.KEY;
+      VAR_KEY_2 : P.KEY;
+      VAR_CHAR_1 : P.CHAR;
+      VAR_CHAR_2 : P.CHAR;
+ 
+      PACKAGE BODY P IS
+ 
+           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
+           BEGIN
+                RETURN (KEY (X));
+           END INIT_KEY;
+ 
+           FUNCTION INIT_CHAR (X : CHARACTER) RETURN CHAR IS
+           BEGIN
+                RETURN (CHAR (X));
+           END INIT_CHAR;
+ 
+      BEGIN
+           NULL;
+      END P;
+ 
+ BEGIN
+      TEST ("C41327A", "CHECK THAT IMPLICITLY DECLARED EQUALITY AND " &
+                       "INEQUALITY OPERATORS MAY BE SELECTED FROM " &
+                       "OUTSIDE A PACKAGE USING AN EXPANDED NAME, " &
+                       "FOR A PRIVATE TYPE");
+ 
+      VAR_KEY_1 := P.INIT_KEY (1);
+      VAR_KEY_2 := P.INIT_KEY (2);
+      VAR_CHAR_1 := P.INIT_CHAR ('A');
+      VAR_CHAR_2 := P.INIT_CHAR ('A');
+      IF P."=" (VAR_KEY_1, VAR_KEY_2) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+      END IF;
+ 
+      IF P."/=" (VAR_CHAR_1, VAR_CHAR_2) THEN
+           FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+      END IF;
+ 
+      RESULT;
+ END C41327A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41328a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41328a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41328a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41328a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C41328A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED DERIVED SUBPROGRAMS CAN BE SELECTED
+ -- FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR A DERIVED TYPE.
+ 
+ -- TBN  7/21/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41328A IS
+ 
+      PACKAGE P IS
+           PACKAGE Q IS
+                TYPE PAIR IS ARRAY (1..2) OF INTEGER;
+                FUNCTION INIT (INT : INTEGER) RETURN PAIR;
+                PROCEDURE SWAP (TWO : IN OUT PAIR);
+           END Q;
+           TYPE COUPLE IS NEW Q.PAIR;
+      END P;
+ 
+      VAR_1 : P.COUPLE;
+      VAR_2 : P.COUPLE;
+ 
+      PACKAGE BODY P IS
+ 
+           PACKAGE BODY Q IS
+ 
+                FUNCTION INIT (INT : INTEGER) RETURN PAIR IS
+                     A : PAIR;
+                BEGIN
+                     A (1) := INT;
+                     A (2) := INT + 1;
+                     RETURN (A);
+                END INIT;
+ 
+                PROCEDURE SWAP (TWO : IN OUT PAIR) IS
+                     TEMP : INTEGER;
+                BEGIN
+                     TEMP := TWO (1);
+                     TWO (1) := TWO (2);
+                     TWO (2) := TEMP;
+                END SWAP;
+ 
+           BEGIN
+                NULL;
+           END Q;
+ 
+      BEGIN
+           NULL;
+      END P;
+ 
+ BEGIN
+      TEST ("C41328A", "CHECK THAT IMPLICITLY DECLARED DERIVED " &
+                       "SUBPROGRAMS CAN BE SELECTED FROM OUTSIDE A " &
+                       "PACKAGE USING AN EXPANDED NAME, FOR A DERIVED " &
+                       "TYPE");
+ 
+      VAR_1 := P.INIT (IDENT_INT(1));
+      IF P."/=" (VAR_1, P.COUPLE'(1 => 1, 2 => 2)) THEN
+           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 1");
+      END IF;
+ 
+      VAR_2 := P.INIT (IDENT_INT(2));
+      IF P."=" (VAR_2, P.COUPLE'(1 => 1, 2 => 2)) THEN
+           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 2");
+      END IF;
+ 
+      P.SWAP (VAR_1);
+      IF P."=" (VAR_1, P.COUPLE'(1 => 1, 2 => 2)) THEN
+           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 3");
+      END IF;
+ 
+      P.SWAP (VAR_2);
+      IF P."/=" (VAR_2, P.COUPLE'(1 => 3, 2 => 2)) THEN
+           FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 4");
+      END IF;
+ 
+      RESULT;
+ END C41328A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41401a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41401a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41401a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41401a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,216 ----
+ -- C41401A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE PREFIX OF THE FOLLOWING
+ -- ATTRIBUTES HAS THE VALUE NULL:
+ --     A) 'CALLABLE AND 'TERMINATED FOR A TASK TYPE.
+ --     B) 'FIRST, 'FIRST(N), 'LAST, 'LAST(N), 'LENGTH, 'LENGTH(N),
+ --        'RANGE, AND 'RANGE(N) FOR AN ARRAY TYPE.
+ 
+ -- TBN  10/2/86
+ -- EDS  07/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41401A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TYPE ACC_TT IS ACCESS TT;
+ 
+      TYPE NULL_ARR1 IS ARRAY (2 .. 1) OF INTEGER;
+      TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
+      TYPE NULL_ARR2 IS ARRAY (3 .. 1, 2 .. 1) OF INTEGER;
+      TYPE ARRAY2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
+      TYPE ACC_NULL1 IS ACCESS NULL_ARR1;
+      TYPE ACC_ARR1 IS ACCESS ARRAY1;
+      TYPE ACC_NULL2 IS ACCESS NULL_ARR2;
+      TYPE ACC_ARR2 IS ACCESS ARRAY2;
+ 
+      PTR_TT : ACC_TT;
+      PTR_ARA1: ACC_NULL1;
+      PTR_ARA2 : ACC_ARR1 (1 .. 4);
+      PTR_ARA3 : ACC_NULL2;
+      PTR_ARA4 : ACC_ARR2 (1 .. 2, 2 .. 4);
+      BOOL_VAR : BOOLEAN := FALSE;
+      INT_VAR : INTEGER := 1;
+ 
+      TASK BODY TT IS
+      BEGIN
+           ACCEPT E;
+      END TT;
+ 
+ BEGIN
+      TEST ("C41401A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE " &
+                       "PREFIX HAS A VALUE OF NULL FOR THE FOLLOWING " &
+                       "ATTRIBUTES: 'CALLABLE, 'TERMINATED, 'FIRST, " &
+                       "'LAST, 'LENGTH, AND 'RANGE");
+ 
+      BEGIN
+           IF EQUAL (3, 2) THEN
+                PTR_TT := NEW TT;
+           END IF;
+           BOOL_VAR := IDENT_BOOL(PTR_TT'CALLABLE);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & BOOLEAN'IMAGE(BOOL_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+      BEGIN
+           IF EQUAL (1, 3) THEN
+                PTR_TT := NEW TT;
+           END IF;
+           BOOL_VAR := IDENT_BOOL(PTR_TT'TERMINATED);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 3 " & BOOLEAN'IMAGE(BOOL_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA1'FIRST);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 5 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA2'LAST);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 7 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA1'LENGTH);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 9 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 10");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A : ARRAY1 (PTR_ARA2'RANGE);
+           BEGIN
+                A (1) := IDENT_INT(1);
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 11 " & 
+                        INTEGER'IMAGE(A(1)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED - 11 ");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 12");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA3'FIRST(2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 13 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 14");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA4'LAST(2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 15 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 16");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA3'LENGTH(2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 17 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 18");
+      END;
+ 
+      BEGIN
+           DECLARE
+                A : ARRAY1 (PTR_ARA4'RANGE(2));
+           BEGIN
+                A (1) := IDENT_INT(1);
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 19 " & 
+                        INTEGER'IMAGE(A(1)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED - 19 ");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 20");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA4'LAST(1));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 21 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 22");
+      END;
+ 
+      BEGIN
+           INT_VAR := IDENT_INT(PTR_ARA3'LENGTH(1));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 23 " & INTEGER'IMAGE(INT_VAR));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 24");
+      END;
+ 
+      RESULT;
+ END C41401A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41402a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41402a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41402a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- C41402A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF THE PREFIX OF
+ --     'ADDRESS, 'SIZE, 'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE
+ --     VALUE NULL.
+ 
+ -- HISTORY:
+ --     TBN  10/02/86  CREATED ORIGINAL TEST.
+ --     CJJ  07/01/87  REMOVED TEST FOR 'STORAGE_SIZE, WHICH IS NO LONGER
+ --                    PART OF THE OBJECTIVE.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41402A IS
+ 
+      TYPE ARRAY1 IS ARRAY (1 .. 2) OF INTEGER;
+      TYPE ACC_ARA IS ACCESS ARRAY1;
+ 
+      PTR_ARA : ACC_ARA;
+      VAR1 : INTEGER;
+ 
+      TYPE REC1 IS
+           RECORD
+                A : INTEGER;
+           END RECORD;
+ 
+      TYPE ACC_REC1 IS ACCESS REC1;
+ 
+      TYPE REC2 IS
+           RECORD
+                P_AR : ACC_ARA;
+                P_REC : ACC_REC1;
+           END RECORD;
+ 
+      OBJ_REC : REC2;
+ 
+ 
+      PROCEDURE PROC (A : ADDRESS) IS
+      BEGIN
+           NULL;
+      END;
+ 
+ BEGIN
+      TEST ("C41402A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "THE PREFIX OF 'ADDRESS, 'SIZE, " &
+                       "'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE " &
+                       "VALUE NULL");
+ 
+      BEGIN
+           PROC (PTR_ARA'ADDRESS);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR 'ADDRESS");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED 'ADDRESS");
+      END;
+ 
+      BEGIN
+           VAR1 := PTR_ARA'SIZE;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR 'SIZE");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED 'SIZE");
+      END;
+ 
+      BEGIN
+           VAR1 := OBJ_REC.P_AR'FIRST_BIT;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR 'FIRST_BIT");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED 'FIRST_BIT");
+      END;
+ 
+      BEGIN
+           VAR1 := OBJ_REC.P_AR'LAST_BIT;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR 'LAST_BIT");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED 'LAST_BIT");
+      END;
+ 
+      BEGIN
+           VAR1 := OBJ_REC.P_REC'POSITION;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR 'POSITION");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED 'POSITION");
+      END;
+ 
+      RESULT;
+ END C41402A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41404a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41404a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c41404a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c41404a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C41404A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE PREFIX OF THE ARRAY ATTRIBUTES CAN BE THE VALUE OF AN
+ -- IMAGE ATTRIBUTE.
+ 
+ -- JBG 6/1/85
+ -- PWB 2/3/86  CORRECTED COMPARISON VALUES FOR 'LAST AND 'LENGTH.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C41404A IS
+ 
+      TYPE ENUM IS (ONE, FOUR, 'C');
+ 
+ BEGIN
+ 
+      TEST ("C41404A", "CHECK WHEN PREFIX OF AN ATTRIBUTE IS 'IMAGE");
+ 
+      IF ENUM'IMAGE(FOUR)'LENGTH /= IDENT_INT(4) THEN
+           FAILED ("WRONG VALUE FOR LENGTH - ENUM");
+      END IF;
+ 
+      IF ENUM'IMAGE('C')'LENGTH /= IDENT_INT(3) THEN
+           FAILED ("WRONG VALUE FOR LENGTH - ENUM: 'C'");
+      END IF;
+ 
+      IF INTEGER'IMAGE(IDENT_INT(56))'LENGTH /= IDENT_INT(3) THEN
+           FAILED ("WRONG VALUE FOR LENGTH - INTEGER: 56");
+      END IF;
+ 
+      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LENGTH /= IDENT_INT(3) THEN
+           FAILED ("WRONG VALUE FOR LENGTH - CHAR: 'B'");
+      END IF;
+ 
+      IF ENUM'IMAGE(FOUR)'FIRST /= IDENT_INT(1) THEN
+           FAILED ("WRONG VALUE FOR FIRST - ENUM");
+      END IF;
+ 
+      IF ENUM'IMAGE('C')'FIRST(1) /= IDENT_INT(1) THEN
+           FAILED ("WRONG VALUE FOR FIRST - ENUM: 'C'");
+      END IF;
+ 
+      IF INTEGER'IMAGE(IDENT_INT(56))'FIRST /= IDENT_INT(1) THEN
+           FAILED ("WRONG VALUE FOR FIRST - INTEGER: 56");
+      END IF;
+ 
+      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'FIRST /= IDENT_INT(1) THEN
+           FAILED ("WRONG VALUE FOR FIRST - CHAR: 'B'");
+      END IF;
+ 
+      IF ENUM'IMAGE(FOUR)'LAST /= IDENT_INT(4) THEN
+           FAILED ("WRONG VALUE FOR LAST - ENUM");
+      END IF;
+ 
+      IF ENUM'IMAGE('C')'LAST(1) /= IDENT_INT(3) THEN
+           FAILED ("WRONG VALUE FOR LAST - ENUM: 'C'");
+      END IF;
+ 
+      IF INTEGER'IMAGE(IDENT_INT(-56))'LAST /= IDENT_INT(3) THEN
+           FAILED ("WRONG VALUE FOR LAST - INTEGER: -56");
+      END IF;
+ 
+      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LAST /= IDENT_INT(3) THEN
+           FAILED ("WRONG VALUE FOR LAST - CHAR: 'B'");
+      END IF;
+ 
+      DECLARE
+ 
+           FOUR_VAR : STRING(ENUM'IMAGE(FOUR)'RANGE);
+           C_VAR    : STRING(ENUM'IMAGE('C')'RANGE);
+           VAR_101  : STRING(INTEGER'IMAGE(IDENT_INT(101))'RANGE);
+           CHAR_VAR : STRING(CHARACTER'IMAGE(IDENT_CHAR('B'))'RANGE);
+ 
+      BEGIN
+ 
+           IF FOUR_VAR'FIRST /= 1 OR
+              FOUR_VAR'LAST  /= 4 OR
+              FOUR_VAR'LENGTH /= 4 THEN
+                FAILED ("FOUR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
+                        INTEGER'IMAGE(FOUR_VAR'FIRST) & ".  LAST IS" &
+                        INTEGER'IMAGE(FOUR_VAR'LAST) & ".  LENGTH IS" &
+                        INTEGER'IMAGE(FOUR_VAR'LENGTH));
+           END IF;
+ 
+           IF C_VAR'FIRST /= 1 OR
+              C_VAR'LAST  /= 3 OR
+              C_VAR'LENGTH /= 3 THEN
+                FAILED ("C_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
+                        INTEGER'IMAGE(C_VAR'FIRST) & ".  LAST IS" &
+                        INTEGER'IMAGE(C_VAR'LAST) & ".  LENGTH IS" &
+                        INTEGER'IMAGE(C_VAR'LENGTH));
+           END IF;
+ 
+           IF VAR_101'FIRST /= 1 OR
+              VAR_101'LAST  /= 4 OR
+              VAR_101'LENGTH /= 4 THEN
+                FAILED ("VAR_101 ATTRIBUTES INCORRECT.  FIRST IS" &
+                        INTEGER'IMAGE(VAR_101'FIRST) & ".  LAST IS" &
+                        INTEGER'IMAGE(VAR_101'LAST) & ".  LENGTH IS" &
+                        INTEGER'IMAGE(VAR_101'LENGTH));
+           END IF;
+ 
+           IF CHAR_VAR'FIRST /= 1 OR
+              CHAR_VAR'LAST  /= 3 OR
+              CHAR_VAR'LENGTH /= 3 THEN
+                FAILED ("CHAR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
+                        INTEGER'IMAGE(CHAR_VAR'FIRST) & ".  LAST IS" &
+                        INTEGER'IMAGE(CHAR_VAR'LAST) & ".  LENGTH IS" &
+                        INTEGER'IMAGE(CHAR_VAR'LENGTH));
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C41404A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c420001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c420001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c420001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c420001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C420001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE
+ --     Check that if the index subtype of a string type is a modular subtype
+ --     whose lower bound is zero, then the evaluation of a null string_literal
+ --     raises Constraint_Error. This was confirmed by AI95-00138.
+ --
+ -- TEST DESCRIPTION
+ --     In this test, we have a generic formal modular type, and we have
+ --     several null string literals of that type.  Because the type is
+ --     generic formal, the string literals are not static, and therefore
+ --     the Constraint_Error should be detected at run time.
+ --
+ -- CHANGE HISTORY:
+ --      29 JUN 1999   RAD   Initial Version
+ --      23 SEP 1999   RLB   Improved comments and messages, renamed, issued.
+ --
+ --!
+ with Report; use Report; pragma Elaborate_All(Report);
+ with System;
+ procedure C420001 is
+     generic
+         type Modular is mod <>;
+     package Mod_Test is
+         type Str is array(Modular range <>) of Character;
+         procedure Test_String_Literal;
+     end Mod_Test;
+ 
+     package body Mod_Test is
+         procedure Test_String_Literal is
+         begin
+             begin
+                 declare
+                     Null_String: Str := ""; -- Should raise C_E.
+                 begin
+                     Comment(String(Null_String)); -- Avoid 11.6 issues.
+                 end;
+                 Failed("Null string didn't raise Constraint_Error");
+             exception
+                 when Exc: Constraint_Error =>
+                     null; -- Comment("Constraint_Error -- OK");
+                 when Exc2: others =>
+                     Failed("Null string raised wrong exception");
+             end;
+             begin
+                 Failed(String(Str'(""))); -- Should raise C_E, not do Failed.
+                 Failed("Null string didn't raise Constraint_Error");
+             exception
+                 when Exc: Constraint_Error =>
+                     null; -- Comment("Constraint_Error -- OK");
+                 when Exc2: others =>
+                     Failed("Null string raised wrong exception");
+             end;
+         end Test_String_Literal;
+     begin
+         Test_String_Literal;
+     end Mod_Test;
+ begin
+     Test("C420001", "Check that if the index subtype of a string type is a " &
+                     "modular subtype whose lower bound is zero, then the " &
+                     "evaluation of a null string_literal raises " &
+                     "Constraint_Error. ");
+     declare
+         type M1 is mod 1;
+         package Test_M1 is new Mod_Test(M1);
+         type M2 is mod 2;
+         package Test_M2 is new Mod_Test(M2);
+         type M3 is mod 3;
+         package Test_M3 is new Mod_Test(M3);
+         type M4 is mod 4;
+         package Test_M4 is new Mod_Test(M4);
+         type M5 is mod 5;
+         package Test_M5 is new Mod_Test(M5);
+         type M6 is mod 6;
+         package Test_M6 is new Mod_Test(M6);
+         type M7 is mod 7;
+         package Test_M7 is new Mod_Test(M7);
+         type M8 is mod 8;
+         package Test_M8 is new Mod_Test(M8);
+         type M_Max_Binary_Modulus is mod System.Max_Binary_Modulus;
+         package Test_M_Max_Binary_Modulus is new Mod_Test(M_Max_Binary_Modulus);
+         type M_Max_Nonbinary_Modulus is mod System.Max_Nonbinary_Modulus;
+         package Test_M_Max_Nonbinary_Modulus is new Mod_Test(M_Max_Nonbinary_Modulus);
+     begin
+         null;
+     end;
+     Result;
+ end C420001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c42006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c42006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c42006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c42006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C42006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A STRING LITERAL OF AN
+ -- ARRAY TYPE CONTAINS A CHARACTER THAT DOES NOT BELONG TO THE COMPONENT
+ -- SUBTYPE.
+ 
+ -- SPS 2/22/84
+ -- EDS 12/02/97  MODIFIED THE COMPONENT SUBTYPES SO THAT THEY ARE NON-STATIC.
+ -- EDS 7/14/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C42006A IS
+ BEGIN
+ 
+      TEST ("C42006A", "CHECK THAT THE VALUES OF STRING LITERALS MUST" &
+            " BELONG TO THE COMPONENT SUBTYPE.");
+ 
+      DECLARE
+ 
+           TYPE CHAR_COMP IS ('A', 'B', 'C', 'D', 'E', 'F');
+ 
+           ASCIINUL : CHARACTER := ASCII.NUL;
+           SUBTYPE NON_GRAPHIC_CHAR IS CHARACTER 
+                RANGE ASCIINUL .. ASCII.BEL;
+ 
+           BEE : CHAR_COMP := 'B';
+           TYPE CHAR_STRING IS ARRAY (POSITIVE RANGE <>) 
+                OF CHAR_COMP RANGE BEE..'C';
+           TYPE NON_GRAPHIC_CHAR_STRING IS ARRAY (POSITIVE RANGE <>)
+                OF NON_GRAPHIC_CHAR;
+ 
+           C_STR : CHAR_STRING (1 .. 1);
+           C_STR_5 : CHAR_STRING (1 .. 5) := "BBBBB";
+           N_G_STR : NON_GRAPHIC_CHAR_STRING (1 .. 1) := 
+                     (OTHERS => NON_GRAPHIC_CHAR'FIRST);
+ 
+      BEGIN
+ 
+           BEGIN
+                C_STR_5 := "BABCC";      -- 'A' NOT IN COMPONENT SUBTYPE.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & 
+                        CHAR_COMP'IMAGE(C_STR_5(1)));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("SOME EXCEPTION RAISED - 1");
+           END;
+ 
+           BEGIN
+                C_STR_5 := "BCBCD";      -- 'D' NOT IN COMPONENT SUBTYPE.
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2 " & 
+                        CHAR_COMP'IMAGE(C_STR_5(1)));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("SOME EXCEPTION RAISED - 2");
+           END;
+ 
+           BEGIN
+                N_G_STR := "Z";
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3 " & 
+                        INTEGER'IMAGE(CHARACTER'POS(N_G_STR(1))));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("SOME EXCEPTION RAISED - 3");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C42006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c42007e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c42007e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c42007e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c42007e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C42007E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A STRING LITERAL ARE DETERMINED CORRECTLY.
+ -- IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY 'FIRST OF THE
+ -- INDEX SUBTYPE WHEN THE STRING LITERAL IS USED AS:
+ 
+ --   E) THE LEFT OR RIGHT OPERAND OF "&".
+ 
+ -- TBN  7/28/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C42007E IS
+ 
+ BEGIN
+ 
+      TEST("C42007E", "CHECK THE BOUNDS OF A STRING LITERAL WHEN USED " &
+                      "AS THE LEFT OR RIGHT OPERAND OF THE CATENATION " &
+                      "OPERATOR");
+ 
+      BEGIN
+ 
+ CASE_E :  DECLARE
+ 
+                SUBTYPE STR_RANGE IS INTEGER RANGE 2 .. 10;
+                TYPE STR IS ARRAY (STR_RANGE RANGE <>) OF CHARACTER;
+ 
+                FUNCTION CONCAT1 RETURN STR IS
+                BEGIN
+                     RETURN ("ABC" & (7 .. 8 => 'D'));
+                END CONCAT1;
+ 
+                FUNCTION CONCAT2 RETURN STR IS
+                BEGIN
+                     RETURN ((IDENT_INT(4) .. 3 => 'A') & "BC");
+                END CONCAT2;
+ 
+                FUNCTION CONCAT3 RETURN STRING IS
+                BEGIN
+                     RETURN ("TEST" & (7 .. 8 => 'X'));
+                END CONCAT3;
+ 
+                FUNCTION CONCAT4 RETURN STRING IS
+                BEGIN
+                     RETURN ((8 .. 5 => 'A') & "DE");
+                END CONCAT4;
+ 
+           BEGIN
+ 
+                IF CONCAT1'FIRST /= IDENT_INT(2) THEN
+                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 1");
+                END IF;
+                IF CONCAT1'LAST /= 6 THEN
+                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 1");
+                END IF;
+                IF CONCAT1 /= "ABCDD" THEN
+                     FAILED ("STRING INCORRECTLY DETERMINED - 1");
+                END IF;
+ 
+                IF CONCAT2'FIRST /= IDENT_INT(2) THEN
+                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 2");
+                END IF;
+                IF CONCAT2'LAST /= 3 THEN
+                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 2");
+                END IF;
+                IF CONCAT2 /= "BC" THEN
+                     FAILED ("STRING INCORRECTLY DETERMINED - 2");
+                END IF;
+ 
+                IF CONCAT3'FIRST /= IDENT_INT(1) THEN
+                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 3");
+                END IF;
+                IF CONCAT3'LAST /= 6 THEN
+                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 3");
+                END IF;
+                IF CONCAT3 /= "TESTXX" THEN
+                     FAILED ("STRING INCORRECTLY DETERMINED - 3");
+                END IF;
+ 
+                IF CONCAT4'FIRST /= IDENT_INT(1) THEN
+                     FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 4");
+                END IF;
+                IF CONCAT4'LAST /= 2 THEN
+                     FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 4");
+                END IF;
+                IF CONCAT4 /= "DE" THEN
+                     FAILED ("STRING INCORRECTLY DETERMINED - 4");
+                END IF;
+ 
+           END CASE_E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C42007E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C43003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN INITIALIZING AN ARRAY OF ACCESS OBJECTS, WITH
+ -- AN AGGREGATE CONTAINING A SINGLE ALLOCATOR, ALL ELEMENTS
+ -- ARE INITIALIZED TO THE SAME INITIAL VALUE.
+ -- THAT IS, CHECK THAT ALL COMPONENTS OF THE ARRAY DESIGNATE
+ -- DISTINCT OBJECTS.
+ 
+ -- DAT 3/18/81
+ -- SPS 10/26/82
+ -- JBG 12/27/82
+ -- R. WILLIAMS 11/11/86     RENAMED FROM C38007A-B.ADA.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C43003A IS
+ 
+      TYPE AI IS ACCESS INTEGER;
+ 
+      TYPE AAI IS ARRAY (1..5) OF AI;
+ 
+      A : AAI := AAI'(OTHERS => NEW INTEGER '(2));
+ 
+ BEGIN
+      TEST ("C43003A", "CHECK THAT ALLOCATORS IN INITIALIZATIONS"
+           & " FOR ARRAYS OF ACCESS VALUES ARE EVALUATED ONCE" &
+           " FOR EACH COMPONENT");
+ 
+      FOR I IN 1..5
+      LOOP
+           FOR J IN I+1..5
+           LOOP
+                IF A(I) = A(J) THEN
+                     FAILED ("DID NOT EVALUATE ALLOCATOR FOR EACH " &
+                             "COMPONENT");
+                     EXIT;
+                END IF;
+           END LOOP;
+      END LOOP;
+ 
+      RESULT;
+ END C43003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,350 ----
+ -- C43004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF A VALUE FOR A
+ --     NON-DISCRIMINANT SCALAR COMPONENT OF AN AGGREGATE IS NOT
+ --     WITHIN THE RANGE OF THE COMPONENT'S SUBTYPE.
+ 
+ -- HISTORY:
+ --     BCB 01/22/88  CREATED ORIGINAL TEST.
+ --     RJW 06/27/90  CORRECTED CONSTRAINTS OF TYPE DFIX.
+ --     LDC 09/25/90  ADDED A BLOCK IN THE EXCEPTION HANDLER SO IT CAN
+ --                   NOT OPTIMIZE IT AWAY,  ALSO INITIALIZED EACH
+ --                   OBJECT TO VALID DATA BEFORE DOING THE INVALID,
+ --                   MADE 'IDENT_XXX' FUNCTIONS SO THE COMPILER CAN
+ --                   NOT JUST EVALUATE THE ASSIGNMENT AND PUT IN CODE
+ --                   FOR A CONSTRAINT ERROR IN IS PLACE.
+ --     JRL 06/07/96  Changed value in aggregate in subtest 4 to value
+ --                   guaranteed to be in the base range of the type FIX.
+ --                   Corrected typo.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C43004A IS
+ 
+      TYPE INT IS RANGE 1 .. 8;
+      SUBTYPE SINT IS INT RANGE 2 .. 7;
+ 
+      TYPE ENUM IS (VINCE, JOHN, TOM, PHIL, ROSA, JODIE, BRIAN, DAVE);
+      SUBTYPE SENUM IS ENUM RANGE JOHN .. BRIAN;
+ 
+      TYPE FL IS DIGITS 5 RANGE 0.0 .. 10.0;
+      SUBTYPE SFL IS FL RANGE 1.0 .. 9.0;
+ 
+      TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 8.0;
+      SUBTYPE SFIX IS FIX RANGE 1.0 .. 7.0;
+ 
+      TYPE DINT IS NEW INTEGER RANGE 1 .. 8;
+      SUBTYPE SDINT IS DINT RANGE 2 .. 7;
+ 
+      TYPE DENUM IS NEW ENUM RANGE VINCE .. DAVE;
+      SUBTYPE SDENUM IS DENUM RANGE JOHN .. BRIAN;
+ 
+      TYPE DFL IS NEW FLOAT RANGE 0.0 .. 10.0;
+      SUBTYPE SDFL IS DFL RANGE 1.0 .. 9.0;
+ 
+      TYPE DFIX IS NEW FIX RANGE 0.5 .. 7.5;
+      SUBTYPE SDFIX IS DFIX RANGE 1.0 .. 7.0;
+ 
+      TYPE REC1 IS RECORD
+            E1, E2, E3, E4, E5 : SENUM;
+      END RECORD;
+ 
+      TYPE REC2 IS RECORD
+            E1, E2, E3, E4, E5 : SFIX;
+      END RECORD;
+ 
+      TYPE REC3 IS RECORD
+            E1, E2, E3, E4, E5 : SDENUM;
+      END RECORD;
+ 
+      TYPE REC4 IS RECORD
+            E1, E2, E3, E4, E5 : SDFIX;
+      END RECORD;
+ 
+      ARRAY_OBJ : ARRAY(1..2) OF INTEGER;
+ 
+      A  : ARRAY(1..5) OF SINT;
+      B  : REC1;
+      C  : ARRAY(1..5) OF SFL;
+      D  : REC2;
+      E  : ARRAY(1..5) OF SDINT;
+      F  : REC3;
+      G  : ARRAY(1..5) OF SDFL;
+      H  : REC4;
+ 
+      GENERIC
+           TYPE GENERAL_PURPOSE IS PRIVATE;
+      FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN;
+ 
+      FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN ONE = TWO;
+           ELSE
+                RETURN ONE /= TWO;
+           END IF;
+      END GENEQUAL;
+ 
+      FUNCTION EQUAL IS NEW GENEQUAL(SENUM);
+      FUNCTION EQUAL IS NEW GENEQUAL(SFL);
+      FUNCTION EQUAL IS NEW GENEQUAL(SFIX);
+      FUNCTION EQUAL IS NEW GENEQUAL(SDENUM);
+      FUNCTION EQUAL IS NEW GENEQUAL(SDFL);
+      FUNCTION EQUAL IS NEW GENEQUAL(SDFIX);
+ 
+      GENERIC
+           TYPE GENERAL_PURPOSE IS PRIVATE;
+           WITH FUNCTION EQUAL_GENERAL(ONE, TWO : GENERAL_PURPOSE) 
+                    RETURN BOOLEAN;
+      FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
+      FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
+           BEGIN
+           IF EQUAL_GENERAL (X, X) THEN  -- ALWAYS EQUAL.
+                RETURN X;                -- ALWAYS EXECUTED.
+           END IF;
+                                         -- NEVER EXECUTED.
+           RETURN X;
+      END GEN_IDENT;
+ 
+      FUNCTION IDENT_FL    IS NEW GEN_IDENT(FL, EQUAL);
+      FUNCTION IDENT_FIX   IS NEW GEN_IDENT(FIX, EQUAL);
+      FUNCTION IDENT_DFL   IS NEW GEN_IDENT(DFL, EQUAL);
+      FUNCTION IDENT_DFIX  IS NEW GEN_IDENT(DFIX, EQUAL);
+ 
+ BEGIN
+      TEST ("C43004A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
+                       "VALUE FOR A NON-DISCRIMINANT SCALAR COMPONENT " &
+                       "OF AN AGGREGATE IS NOT WITHIN THE RANGE OF " &
+                       "THE COMPONENT'S SUBTYPE");
+ 
+      ARRAY_OBJ := (1, 2);
+ 
+      BEGIN
+           A  := (2,3,4,5,6);            -- OK
+ 
+           IF EQUAL (INTEGER (A(IDENT_INT(1))),
+                     INTEGER (A(IDENT_INT(2)))) THEN
+                COMMENT ("DON'T OPTIMIZE A");
+           END IF;
+ 
+           A := (SINT(IDENT_INT(1)),2,3,4,7);
+                                        -- CONSTRAINT_ERROR BY AGGREGATE
+                                        -- WITH INTEGER COMPONENTS.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
+           IF EQUAL (INTEGER (A(IDENT_INT(1))),
+                     INTEGER (A(IDENT_INT(1)))) THEN
+                COMMENT ("DON'T OPTIMIZE A");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 1");
+      END;
+ 
+      BEGIN
+           B := (JOHN,TOM,PHIL,ROSA,JOHN);  -- OK
+ 
+           IF EQUAL (B.E1, B.E2) THEN
+                COMMENT ("DON'T OPTIMIZE B");
+           END IF;
+ 
+           B := (ENUM'VAL(IDENT_INT(ENUM'POS(DAVE))), TOM, PHIL,
+                 ROSA, JODIE);
+                                        -- CONSTRAINT_ERROR BY AGGREGATE
+                                        -- WITH COMPONENTS OF AN
+                                        -- ENUMERATION TYPE.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
+           IF NOT EQUAL (B.E1, B.E1) THEN
+                COMMENT ("DON'T OPTIMIZE B");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 2");
+      END;
+      BEGIN
+           C := (2.0,3.0,4.0,5.0,6.0);  -- OK
+           IF EQUAL (C(IDENT_INT(1)), C(IDENT_INT(2))) THEN
+                COMMENT ("DON'T OPTIMIZE C");
+           END IF;
+ 
+           C := (IDENT_FL(1.0),2.0,3.0,4.0,IDENT_FL(10.0));
+                                       -- CONSTRAINT_ERROR BY AGGREGATE
+                                       -- WITH FLOATING POINT COMPONENTS.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
+           IF NOT EQUAL (C(IDENT_INT(1)), C(IDENT_INT(1))) THEN
+                COMMENT ("DON'T OPTIMIZE C");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 3");
+      END;
+ 
+      BEGIN
+           D := (2.2,3.3,4.4,5.5,6.6); -- OK
+           IF EQUAL (D.E1, D.E5) THEN
+                COMMENT ("DON'T OPTIMIZE D");
+           END IF;
+ 
+           D := (IDENT_FIX(1.0),2.1,3.3,4.4,IDENT_FIX(7.75));
+                                        -- CONSTRAINT_ERROR BY AGGREGATE
+                                        -- WITH FIXED POINT COMPONENTS.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
+           IF NOT EQUAL (D.E5, D.E5) THEN
+                COMMENT ("DON'T OPTIMIZE D");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 4");
+      END;
+ 
+      BEGIN
+           E := (2,3,4,5,6); -- OK
+           IF EQUAL (INTEGER (E(IDENT_INT(1))),
+                     INTEGER (E(IDENT_INT(2)))) THEN
+                COMMENT ("DON'T OPTIMIZE E");
+           END IF;
+ 
+           E := (SDINT(IDENT_INT(1)),2,3,4,7);
+                                      -- CONSTRAINT_ERROR BY AGGREGATE
+                                      -- WITH DERIVED INTEGER COMPONENTS.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 5");
+           IF NOT EQUAL (INTEGER (E(IDENT_INT(1))),
+                         INTEGER (E(IDENT_INT(1)))) THEN
+                COMMENT ("DON'T OPTIMIZE E");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 5");
+      END;
+ 
+      BEGIN
+           F := (JOHN,TOM,PHIL,ROSA,JOHN);  -- OK
+           IF EQUAL (F.E1, F.E2) THEN
+                COMMENT ("DON'T OPTIMIZE F");
+           END IF;
+ 
+           F := (DENUM'VAL(IDENT_INT(DENUM'POS(VINCE))), TOM, PHIL,
+                 ROSA, JODIE);
+                                        -- CONSTRAINT_ERROR BY AGGREGATE
+                                        -- WITH COMPONENTS OF A DERIVED
+                                        -- ENUMERATION TYPE.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 6");
+           IF NOT EQUAL (F.E1, F.E1) THEN
+                COMMENT ("DON'T OPTIMIZE F");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 6");
+      END;
+ 
+      BEGIN
+           G := (2.0,3.0,4.0,5.0,6.0); -- OK
+           IF EQUAL (G(IDENT_INT(1)), G(IDENT_INT(2))) THEN
+                COMMENT ("DON'T OPTIMIZE G");
+           END IF;
+ 
+           G := (IDENT_DFL(1.0),2.0,3.0,4.0,IDENT_DFL(10.0));
+                                        -- CONSTRAINT_ERROR BY AGGREGATE
+                                        -- WITH DERIVED FLOATING POINT
+                                        -- COMPONENTS.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
+           IF NOT EQUAL (G(IDENT_INT(1)), G(IDENT_INT(1))) THEN
+                COMMENT ("DON'T OPTIMIZE G");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 7");
+      END;
+ 
+      BEGIN
+           H := (2.2,3.3,4.4,5.5,6.6); -- OK
+           IF EQUAL (H.E1, H.E2) THEN
+                COMMENT ("DON'T OPTIMIZE H");
+           END IF;
+ 
+           H := (IDENT_DFIX(2.0),2.5,3.5,4.3,IDENT_DFIX(7.4));
+                                        -- CONSTRAINT_ERROR BY AGGREGATE
+                                        -- WITH DERIVED FIXED POINT
+                                        -- COMPONENTS.
+           FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
+           IF EQUAL (H.E1, H.E5) THEN
+                COMMENT ("DON'T OPTIMIZE H");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                          ARRAY_OBJ(IDENT_INT(2))) THEN
+                     COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                        "WAS RAISED - 8");
+      END;
+ 
+ 
+      RESULT;
+ END C43004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43004c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43004c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43004c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,230 ----
+ -- C43004C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE VALUE OF A
+ --     DISCRIMINANT OF A CONSTRAINED COMPONENT OF AN AGGREGATE DOES
+ --     NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE FOR THE
+ --     COMPONENT'S SUBTYPE.
+ 
+ -- HISTORY:
+ --     BCB 07/19/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C43004C IS
+ 
+      ZERO : INTEGER := 0;
+ 
+      TYPE REC (D : INTEGER := 0) IS RECORD
+           COMP1 : INTEGER;
+      END RECORD;
+ 
+      TYPE DREC (DD : INTEGER := ZERO) IS RECORD
+           DCOMP1 : INTEGER;
+      END RECORD;
+ 
+      TYPE REC1 IS RECORD
+           A : REC(0);
+      END RECORD;
+ 
+      TYPE REC2 IS RECORD
+           B : DREC(ZERO);
+      END RECORD;
+ 
+      TYPE REC3 (D3 : INTEGER := 0) IS RECORD
+           C : REC(D3);
+      END RECORD;
+ 
+      V : REC1;
+      W : REC2;
+      X : REC3;
+ 
+      PACKAGE P IS
+           TYPE PRIV1 (D : INTEGER := 0) IS PRIVATE;
+           TYPE PRIV2 (DD : INTEGER := ZERO) IS PRIVATE;
+           FUNCTION INIT (I : INTEGER) RETURN PRIV1;
+      PRIVATE
+           TYPE PRIV1 (D : INTEGER := 0) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           TYPE PRIV2 (DD : INTEGER := ZERO) IS RECORD
+                NULL;
+           END RECORD;
+      END P;
+ 
+      TYPE REC7 IS RECORD
+           H : P.PRIV1 (0);
+      END RECORD;
+ 
+      Y : REC7;
+ 
+      GENERIC
+           TYPE GP IS PRIVATE;
+      FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN;
+ 
+      FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN IS
+      BEGIN
+           RETURN X = Y;
+      END GEN_EQUAL;
+ 
+      PACKAGE BODY P IS
+           TYPE REC4 IS RECORD
+                E : PRIV1(0);
+           END RECORD;
+ 
+           TYPE REC5 IS RECORD
+                F : PRIV2(ZERO);
+           END RECORD;
+ 
+           TYPE REC6 (D6 : INTEGER := 0) IS RECORD
+                G : PRIV1(D6);
+           END RECORD;
+ 
+           VV : REC4;
+           WW : REC5;
+           XX : REC6;
+ 
+           FUNCTION REC4_EQUAL IS NEW GEN_EQUAL (REC4);
+           FUNCTION REC5_EQUAL IS NEW GEN_EQUAL (REC5);
+           FUNCTION REC6_EQUAL IS NEW GEN_EQUAL (REC6);
+ 
+           FUNCTION INIT (I : INTEGER) RETURN PRIV1 IS
+                VAR : PRIV1;
+           BEGIN
+                VAR := (D => I);
+                RETURN VAR;
+           END INIT;
+      BEGIN
+           TEST ("C43004C", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                            "IF THE VALUE OF A DISCRIMINANT OF A " &
+                            "CONSTRAINED COMPONENT OF AN AGGREGATE " &
+                            "DOES NOT EQUAL THE CORRESPONDING " &
+                             "DISCRIMINANT VALUE FOR THECOMPONENT'S " &
+                            "SUBTYPE");
+ 
+           BEGIN
+                VV := (E => (D => 1));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
+                IF REC4_EQUAL (VV,VV) THEN
+                     COMMENT ("DON'T OPTIMIZE VV");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("OTHER EXCEPTION RAISED - 1");
+           END;
+ 
+           BEGIN
+                WW := (F => (DD => 1));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
+                IF REC5_EQUAL (WW,WW) THEN
+                     COMMENT ("DON'T OPTIMIZE WW");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("OTHER EXCEPTION RAISED - 2");
+           END;
+ 
+           BEGIN
+                XX := (D6 => 1, G => (D => 5));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
+                IF REC6_EQUAL (XX,XX) THEN
+                     COMMENT ("DON'T OPTIMIZE XX");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("OTHER EXCEPTION RAISED - 3");
+           END;
+      END P;
+ 
+      USE P;
+ 
+      FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
+      FUNCTION REC2_EQUAL IS NEW GEN_EQUAL (REC2);
+      FUNCTION REC3_EQUAL IS NEW GEN_EQUAL (REC3);
+      FUNCTION REC7_EQUAL IS NEW GEN_EQUAL (REC7);
+ 
+ BEGIN
+ 
+      BEGIN
+           V := (A => (D => 1, COMP1 => 2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
+           IF REC1_EQUAL (V,V) THEN
+                COMMENT ("DON'T OPTIMIZE V");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 4");
+      END;
+ 
+      BEGIN
+           W := (B => (DD => 1, DCOMP1 => 2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 5");
+           IF REC2_EQUAL (W,W) THEN
+                COMMENT ("DON'T OPTIMIZE W");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 5");
+      END;
+ 
+      BEGIN
+           X := (D3 => 1, C => (D => 5, COMP1 => 2));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 6");
+           IF REC3_EQUAL (X,X) THEN
+                COMMENT ("DON'T OPTIMIZE X");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 6");
+      END;
+ 
+      BEGIN
+           Y := (H => INIT (1));
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - 7");
+           IF REC7_EQUAL (Y,Y) THEN
+                COMMENT ("DON'T OPTIMIZE Y");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 7");
+      END;
+ 
+      RESULT;
+ END C43004C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c431001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c431001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c431001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c431001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,464 ----
+ -- C431001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a record aggregate can be given for a nonprivate,
+ --      nonlimited record extension and that the tag of the aggregate 
+ --      values are initialized to the tag of the record extension.
+ --
+ -- TEST DESCRIPTION:
+ --      From an initial parent tagged type, several type extensions
+ --      are declared. Each type extension adds components onto
+ --      the existing record structure.
+ --
+ --      In the main procedure, aggregates are declared in two ways.
+ --      In the declarative part, aggregates are used to supply
+ --      initial values for objects of specific types. In the executable
+ --      part, aggregates are used directly as actual parameters to
+ --      a class-wide formal parameter.
+ --
+ --      The abstraction is for a catalog of recordings. A recording
+ --      can be a CD or a record (vinyl). Additionally, a CD may also
+ --      be a CD-ROM, containing both music and data. This type is declared
+ --      as an extension to a type extension, to test that the inclusion
+ --      of record components is transitive across multiple extensions.
+ --
+ --      That the aggregate has the correct tag is verify by feeding
+ --      it to a dispatching operation and confirming that the
+ --      expected subprogram is called as a result. To accomplish this,
+ --      an enumeration type is declared with an enumeration literal
+ --      representing each of the declared types in the hierarchy. A value
+ --      of this type is passed as a parameter to the dispatching
+ --      operation which passes it along to the dispatched subprogram.
+ --      Each dispatched subprogram verifies that it received the
+ --      expected enumeration literal.
+ --
+ --      Not quite fitting the above abstraction are several test cases
+ --      for null records. These tests verify that the new syntax for
+ --      null record aggregates, (null record), is supported. A type is
+ --      declared which extends a null tagged type and adds components.
+ --      Aggregates of this type should include associations for the
+ --      components of the type extension only. Finally, a type is
+ --      declared that adds a null type extension onto a non-null tagged
+ --      type. The aggregate associations should remain the same.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --
+ --!
+ --
+ package C431001_0 is
+ 
+    -- Values of TC_Type_ID are passed through to dispatched subprogram
+    -- calls so that it can be verified that the dispatching resulted in
+    -- the expected call.
+    type TC_Type_ID is (TC_Recording, TC_CD, TC_Vinyl, TC_CD_ROM);
+ 
+    type Genre is (Classical, Country, Jazz, Rap, Rock, World);
+ 
+    type Recording is tagged record
+       Artist     : String (1..20);
+       Category   : Genre;
+       Length     : Duration;
+       Selections : Positive;
+    end record;
+ 
+    function Summary (R       : in Recording;
+                      TC_Type : in TC_Type_ID) return String;
+ 
+    type Recording_Method is (Audio, Digital);
+    type CD is new Recording with record
+       Recorded : Recording_Method;
+       Mastered : Recording_Method;
+    end record;
+ 
+    function Summary (Disc    : in CD;
+                      TC_Type : in TC_Type_ID) return String;
+ 
+    type Playing_Speed is (LP_33, Single_45, Old_78);
+    type Vinyl is new Recording with record
+       Speed : Playing_Speed;
+    end record;
+ 
+    function Summary (Album   : in Vinyl;
+                      TC_Type : in TC_Type_ID)  return String;
+                        
+ 
+    type CD_ROM is new CD with record
+       Storage : Positive;
+    end record;
+ 
+    function Summary (Disk    : in CD_ROM;
+                      TC_Type : in TC_Type_ID)  return String;
+                        
+    function Catalog_Entry (R       : in Recording'Class;
+                            TC_Type : in TC_Type_ID) return String;
+ 
+    procedure Print (S : in String); -- provides somewhere for the
+                                     -- results of Catalog_Entry to
+                                     -- "go", so they don't get
+                                     -- optimized away.
+ 
+    -- The types and procedures declared below are not a continuation
+    -- of the Recording abstraction. These types are intended to test
+    -- support for null tagged types and type extensions. TC_Check mirrors
+    -- the operation of function Summary, above. Similarly, TC_Dispatch
+    -- mirrors the operation of Catalog_Entry.
+ 
+    type TC_N_Type_ID is
+       (TC_Null_Tagged, TC_Null_Extension,
+        TC_Extension_Of_Null, TC_Null_Extension_Of_Nonnull);
+ 
+    type Null_Tagged is tagged null record;
+    procedure TC_Check (N       : in Null_Tagged;
+                        TC_Type : in TC_N_Type_ID);
+ 
+    type Null_Extension is new Null_Tagged with null record;
+    procedure TC_Check (N       : in Null_Extension;
+                        TC_Type : in TC_N_Type_ID);
+    
+    type Extension_Of_Null is new Null_Tagged with record
+       New_Component1 : Boolean;
+       New_Component2 : Natural;
+    end record;
+    procedure TC_Check (N       : in Extension_Of_Null;
+                        TC_Type : in TC_N_Type_ID);
+ 
+    type Null_Extension_Of_Nonnull is new Extension_Of_Null
+       with null record;
+    procedure TC_Check (N       : in Null_Extension_Of_Nonnull;
+                        TC_Type : in TC_N_Type_ID);
+ 
+    procedure TC_Dispatch (N       : in Null_Tagged'Class;
+                           TC_Type : in TC_N_Type_ID);
+ 
+ end C431001_0;
+ 
+ with Report;
+ package body C431001_0 is
+ 
+    function Summary (R       : in Recording;
+                      TC_Type : in TC_Type_ID) return String is
+    begin
+ 
+       if TC_Type /= TC_Recording then
+          Report.Failed ("Did not dispatch on tag for tagged parent " &
+                         "type Recording");
+       end if;
+ 
+       return R.Artist (1..10)
+              & ' ' & Genre'Image (R.Category) (1..2)
+              & ' ' & Duration'Image (R.Length)
+              & ' ' & Integer'Image (R.Selections);
+ 
+    end Summary;
+ 
+    function Summary (Disc    : in CD;
+                      TC_Type : in TC_Type_ID) return String is
+    begin
+ 
+       if TC_Type /= TC_CD then
+          Report.Failed ("Did not dispatch on tag for type extension " &
+                         "CD");
+       end if;
+ 
+       return Summary (Recording (Disc), TC_Type => TC_Recording)
+          & ' ' & Recording_Method'Image(Disc.Recorded)(1)
+          & Recording_Method'Image(Disc.Mastered)(1);
+ 
+    end Summary;
+ 
+    function Summary (Album   : in Vinyl;
+                      TC_Type : in TC_Type_ID)  return String is
+    begin
+       if TC_Type /= TC_Vinyl then
+          Report.Failed ("Did not dispatch on tag for type extension " &
+                         "Vinyl");
+       end if;
+ 
+       case Album.Speed is
+       when LP_33 =>
+          return Summary (Recording (Album), TC_Type => TC_Recording)
+             & " 33";
+       when Single_45 =>
+          return Summary (Recording (Album), TC_Type => TC_Recording)      
+             & " 45";
+       when Old_78 =>
+          return Summary (Recording (Album), TC_Type => TC_Recording)      
+             & " 78";
+       end case;
+ 
+    end Summary;
+ 
+    function Summary (Disk    : in CD_ROM;
+                      TC_Type : in TC_Type_ID)  return String is
+    begin
+       if TC_Type /= TC_CD_ROM then
+          Report.Failed ("Did not dispatch on tag for type extension " &
+                         "CD_ROM. This is an extension of the type " &
+                         "extension CD");
+       end if;
+ 
+       return Summary (Recording(Disk), TC_Type => TC_Recording)
+          & ' ' & Integer'Image (Disk.Storage) & 'K';
+ 
+    end Summary;
+ 
+    function Catalog_Entry (R       : in Recording'Class;
+                            TC_Type : in TC_Type_ID) return String is
+    begin
+       return Summary (R, TC_Type); -- dispatched call
+    end Catalog_Entry;
+ 
+    procedure Print (S : in String) is
+       T : String (1..S'Length) := Report.Ident_Str (S);
+    begin
+       -- Ada.Text_IO.Put_Line (S);
+       null;
+    end Print;
+    
+    -- Bodies for null type checks
+    procedure TC_Check (N       : in Null_Tagged;
+                        TC_Type : in TC_N_Type_ID) is
+    begin
+       if TC_Type /= TC_Null_Tagged then
+          Report.Failed ("Did not dispatch on tag for null tagged " &
+                         "type Null_Tagged");
+       end if;
+    end TC_Check;
+ 
+    procedure TC_Check (N       : in Null_Extension;
+                        TC_Type : in TC_N_Type_ID) is
+    begin
+       if TC_Type /= TC_Null_Extension then
+          Report.Failed ("Did not dispatch on tag for null tagged " &
+                         "type extension Null_Extension");
+       end if;
+    end TC_Check;
+    
+    procedure TC_Check (N       : in Extension_Of_Null;
+                        TC_Type : in TC_N_Type_ID) is
+    begin
+       if TC_Type /= TC_Extension_Of_Null then
+          Report.Failed
+             ("Did not dispatch on tag for extension of null parent" &
+              "type");
+       end if;
+    end TC_Check;
+ 
+    procedure TC_Check (N       : in Null_Extension_Of_Nonnull;
+                        TC_Type : in TC_N_Type_ID) is
+    begin
+       if TC_Type /= TC_Null_Extension_Of_Nonnull then
+          Report.Failed
+             ("Did not dispatch on tag for null extension of nonnull " &
+              "parent type");
+       end if;
+    end TC_Check;
+ 
+    procedure TC_Dispatch (N       : in Null_Tagged'Class;
+                           TC_Type : in TC_N_Type_ID) is
+    begin
+       TC_Check (N, TC_Type); -- dispatched call
+    end TC_Dispatch;
+ 
+ end C431001_0;
+ 
+ 
+ with C431001_0;
+ with Report;
+ procedure C431001 is
+ 
+    -- Tagged type
+    -- Named component associations
+    DAT : C431001_0.Recording :=
+       (Artist     => "Aerosmith           ",
+        Category   => C431001_0.Rock,
+        Length     => 48.5,
+        Selections => 10);
+ 
+    -- Type extensions
+    -- Named component associations
+    Disc1 : C431001_0.CD :=
+       (Artist     => "London Symphony     ",
+        Category   => C431001_0.Classical,
+        Length     => 55.0,
+        Selections => 4,
+        Recorded   => C431001_0.Digital,
+        Mastered   => C431001_0.Digital);
+    
+    -- Named component associations with others
+    Disc2 : C431001_0.CD :=
+       (Artist     => "Pink Floyd          ",
+        Category   => C431001_0.Rock,
+        Length     => 51.8,
+        Selections => 5,
+        others     => C431001_0.Audio); -- Recorded
+                                        -- Mastered
+    
+    -- Positional component associations
+    Album1 : C431001_0.Vinyl :=
+       ("Hammer              ", -- Artist
+        C431001_0.Rap,          -- Category
+        46.2,                   -- Length
+        9,                      -- Selections
+        C431001_0.LP_33);       -- Speed
+    
+    -- Mixed positional and named component associations
+    -- Named component associations out of order
+    Album2 : C431001_0.Vinyl :=
+       ("Balinese Gamelan    ", -- Artist 
+        C431001_0.World,        -- Category
+        42.6,                   -- Length
+        14,                     -- Selections
+        C431001_0.LP_33);       -- Speed
+    
+    -- Type extension, parent is also type extension
+    -- Named notation, components out of order
+    Data : C431001_0.CD_ROM :=
+       (Storage    => 140,
+        Mastered   => C431001_0.Digital,
+        Category   => C431001_0.Rock,
+        Selections => 10,
+        Recorded   => C431001_0.Digital,
+        Artist     => "Black, Clint        ",
+        Length     => 48.5);
+ 
+    -- Null tagged type
+    Null_Rec : C431001_0.Null_Tagged := (null record);
+ 
+    -- Null type extension
+    Null_Ext : C431001_0.Null_Extension := (null record);
+ 
+    -- Nonnull extension of null parent
+    Ext_Of_Null : C431001_0.Extension_Of_Null := (True, 0);
+ 
+    -- Null extension of nonnull parent
+    Null_Ext_Of_Nonnull : C431001_0.Null_Extension_Of_Nonnull
+       := (False, 1);
+ 
+ begin
+ 
+    Report.Test ("C431001", "Aggregate values for type extensions");
+ 
+    C431001_0.Print (C431001_0.Catalog_Entry (DAT, C431001_0.TC_Recording));
+    C431001_0.Print (C431001_0.Catalog_Entry (Disc1, C431001_0.TC_CD));
+    C431001_0.Print (C431001_0.Catalog_Entry (Disc2, C431001_0.TC_CD));
+    C431001_0.Print (C431001_0.Catalog_Entry (Album1, C431001_0.TC_Vinyl));
+    C431001_0.Print (C431001_0.Catalog_Entry (Album2, C431001_0.TC_Vinyl));
+    C431001_0.Print (C431001_0.Catalog_Entry (Data, C431001_0.TC_CD_ROM));
+ 
+    C431001_0.TC_Dispatch (Null_Rec, C431001_0.TC_Null_Tagged);
+    C431001_0.TC_Dispatch (Null_Ext, C431001_0.TC_Null_Extension);
+    C431001_0.TC_Dispatch (Ext_Of_Null, C431001_0.TC_Extension_Of_Null);
+    C431001_0.TC_Dispatch
+       (Null_Ext_Of_Nonnull, C431001_0.TC_Null_Extension_Of_Nonnull);
+ 
+    -- Tagged type
+    -- Named component associations
+    C431001_0.Print (C431001_0.Catalog_Entry
+       (TC_Type => C431001_0.TC_Recording,
+        R => C431001_0.Recording'(Artist     => "Zappa, Frank        ",
+                                  Category   => C431001_0.Rock,
+                                  Length     => 70.0,
+                                  Selections => 38)));
+ 
+    -- Type extensions
+    -- Named component associations
+    C431001_0.Print (C431001_0.Catalog_Entry
+       (TC_Type => C431001_0.TC_CD,
+        R => C431001_0.CD'(Artist     => "Dog, Snoop Doggy    ",
+                           Category   => C431001_0.Rap,
+                           Length     => 37.3,
+                           Selections => 8,
+                           Recorded   => C431001_0.Audio,
+                           Mastered   => C431001_0.Digital)));
+ 
+    -- Named component associations with others
+    C431001_0.Print (C431001_0.Catalog_Entry
+       (TC_Type => C431001_0.TC_CD,
+        R => C431001_0.CD'(Artist     => "Judd, Winona        ",
+                           Category   => C431001_0.Country,
+                           Length     => 51.2,
+                           Selections => 11,
+                           others     => C431001_0.Digital))); -- Recorded
+                                                               -- Mastered
+ 
+    -- Positional component associations
+    C431001_0.Print (C431001_0.Catalog_Entry
+       (TC_Type => C431001_0.TC_Vinyl,
+        R => C431001_0.Vinyl'("Davis, Miles        ",  -- Artist
+                               C431001_0.Jazz,         -- Category
+                               50.4,                   -- Length
+                               10,                     -- Selections
+                               C431001_0.LP_33)));      -- Speed
+ 
+    -- Mixed positional and named component associations
+    -- Named component associations out of order
+    C431001_0.Print (C431001_0.Catalog_Entry
+       (TC_Type => C431001_0.TC_Vinyl,
+        R => C431001_0.Vinyl'("Zamfir              ",    -- Artist
+                               C431001_0.World,          -- Category
+                               Speed => C431001_0.LP_33,
+                               Selections => 14,
+                               Length => 56.5)));
+ 
+    -- Type extension, parent is also type extension
+    -- Named notation, components out of order
+    C431001_0.Print (C431001_0.Catalog_Entry
+       (TC_Type => C431001_0.TC_CD_ROM,
+        R => C431001_0.CD_ROM'(Storage         => 720,
+                               Category        => C431001_0.Classical,
+                               Recorded        => C431001_0.Digital,
+                               Artist          => "Baltimore Symphony  ",
+                               Length          => 68.9,
+                               Mastered        => C431001_0.Digital,
+                               Selections      => 5)));
+    
+    -- Null tagged type
+    C431001_0.TC_Dispatch
+       (TC_Type => C431001_0.TC_Null_Tagged,
+        N => C431001_0.Null_Tagged'(null record));
+ 
+    -- Null type extension
+    C431001_0.TC_Dispatch
+       (TC_Type => C431001_0.TC_Null_Extension,
+        N => C431001_0.Null_Extension'(null record));
+ 
+    -- Nonnull extension of null parent
+    C431001_0.TC_Dispatch
+       (TC_Type => C431001_0.TC_Extension_Of_Null,
+        N => C431001_0.Extension_Of_Null'(True, 3));
+ 
+    -- Null extension of nonnull parent
+    C431001_0.TC_Dispatch
+       (TC_Type => C431001_0.TC_Extension_Of_Null,
+        N => C431001_0.Extension_Of_Null'(False, 4));
+ 
+    Report.Result;
+ 
+ end C431001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43103a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43103a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43103a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,127 ----
+ -- C43103A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN A VARIANT PART,
+ -- ITS VALUE CAN BE GIVEN BY A NON-STATIC EXPRESSION.
+ 
+ -- EG  02/13/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43103A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43103A","CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN " &
+                     "A VARIANT PART, ITS VALUE CAN BE GIVEN BY A "  &
+                     "NON-STATIC EXPRESSION");
+ 
+      BEGIN
+ 
+           COMMENT ("CASE A : DISCRIMINANT THAT IS NOT USED INSIDE " &
+                    "THE RECORD");
+ 
+ CASE_A :  DECLARE
+ 
+                TYPE R1 (A : INTEGER) IS
+                     RECORD
+                          B : STRING(1 .. 2);
+                          C : INTEGER;
+                     END RECORD;
+ 
+                A1 : R1(IDENT_INT(5)) := (IDENT_INT(5), "AB", -2);
+ 
+           BEGIN
+ 
+                IF A1.A /= IDENT_INT(5) OR A1.B /= "AB" OR 
+                   A1.C /= -2 THEN
+                     FAILED ("CASE A : INCORRECT VALUES IN RECORD");
+                END IF;
+ 
+           END CASE_A;
+ 
+           COMMENT ("CASE B : DISCRIMINANT THAT IS USED AS AN ARRAY " &
+                    "INDEX BOUND");
+ 
+ CASE_B :  DECLARE
+ 
+                SUBTYPE STB IS INTEGER RANGE 1 .. 10;
+                TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
+                TYPE R2 (A : STB) IS
+                     RECORD
+                          B : TB(1 .. A);
+                          C : BOOLEAN;
+                     END RECORD;
+ 
+                B1 : R2(IDENT_INT(2)) := (IDENT_INT(2), (-1, -2), FALSE);
+ 
+           BEGIN
+ 
+                IF B1.B'LAST /= IDENT_INT(2) THEN
+                     FAILED ("CASE B : INCORRECT UPPER BOUND");
+                ELSIF B1.A /= IDENT_INT(2) OR B1.B /= (-1, -2) OR
+                      B1.C /= FALSE THEN
+                     FAILED ("CASE B : INCORRECT VALUES IN RECORD");
+                END IF;
+ 
+           END CASE_B;
+ 
+           COMMENT ("CASE C : DISCRIMINANT THAT IS USED IN A " &
+                    "DISCRIMINANT CONSTRAINT");
+ 
+ CASE_C :  DECLARE
+ 
+                SUBTYPE STC IS INTEGER RANGE 1 .. 10;
+                TYPE TC IS ARRAY(STC RANGE <>) OF INTEGER;
+                TYPE R3 (A : STC) IS
+                     RECORD
+                          B : TC(1 .. A);
+                          C : INTEGER := -4;
+                     END RECORD;
+                TYPE R4 (A : INTEGER) IS
+                     RECORD
+                          B : R3(A);
+                          C : INTEGER;
+                     END RECORD;
+ 
+                C1 : R4(IDENT_INT(3)) := (IDENT_INT(3), 
+                                          (IDENT_INT(3), (1, 2, 3), 4),
+                                          5);
+ 
+           BEGIN
+ 
+                IF C1.B.B /= (1, 2, 3) OR C1.B.C /= 4 OR
+                   C1.C   /= 5 THEN
+                     FAILED ("CASE C : INCORRECT VALUES IN RECORD");
+                END IF;
+ 
+           END CASE_C;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43103A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43103b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43103b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43103b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- C43103B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN A VARIANT PART, ITS
+ -- VALUE CAN BE GIVEN BY A NONSTATIC EXPRESSION.
+ -- ADDITIONAL CASES OF USE OF A DISCRIMINANT THAT IS USED AS AN
+ -- ARRAY INDEX BOUND.
+ 
+ -- PK  02/21/84
+ -- EG  05/30/84
+ -- EG  11/02/84
+ -- DN  12/01/95  REMOVED CONFORMANCE CHECKS WHERE RULES RELAXED.
+ -- PWN 10/25/96  RESTORED CHECK WITH ADA 95 EXPECTED RESULTS INCLUDED.
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE C43103B IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+ 
+      TYPE A2 IS ARRAY(INT RANGE <>, INT RANGE <>) OF INTEGER;
+ 
+      SUBTYPE DINT IS INTEGER RANGE 0 .. 10;
+           
+      TYPE REC(D, E : DINT := IDENT_INT(1)) IS RECORD
+           U : A2(1 .. D, E .. 3) := (1 .. D =>
+                                      (E .. 3 => IDENT_INT(1)));
+      END RECORD;
+ 
+ BEGIN
+ 
+      TEST("C43103B","CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN " &
+                     "A VARIANT PART, ITS VALUE CAN BE GIVEN BY A "  &
+                     "NONSTATIC EXPRESSION");
+ 
+ -- SIMPLE DECLARATIONS
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                L : REC(IDENT_INT(2), IDENT_INT(2));
+                K : REC(IDENT_INT(0), IDENT_INT(1));
+                M : REC(IDENT_INT(3), IDENT_INT(4));
+ 
+           BEGIN
+                IF L.U'FIRST(1) /= IDENT_INT(1) OR
+                   L.U'LAST(1)  /= IDENT_INT(2) OR
+                   L.U'FIRST(2) /= IDENT_INT(2) OR
+                   L.U'LAST(2)  /= IDENT_INT(3) THEN
+                     FAILED("1.1 - INCORRECT BOUNDS");
+                END IF;
+                IF K.U'FIRST(1) /= IDENT_INT(1) OR
+                   K.U'LAST(1)  /= IDENT_INT(0) OR
+                   K.U'FIRST(2) /= IDENT_INT(1) OR
+                   K.U'LAST(2)  /= IDENT_INT(3) THEN
+                     FAILED("1.2 - INCORRECT BOUNDS");
+                END IF;
+                IF M.U'FIRST(1) /= IDENT_INT(1) OR
+                   M.U'LAST(1)  /= IDENT_INT(3) OR
+                   M.U'FIRST(2) /= IDENT_INT(4) OR
+                   M.U'LAST(2)  /= IDENT_INT(3) THEN
+                     FAILED("1.3 - INCORRECT BOUNDS");
+                END IF;
+                IF M.U'LENGTH(1) /= 3 OR M.U'LENGTH(2) /= 0 THEN
+                     FAILED("1.4 - INCORRECT ARRAY LENGTH");
+                END IF;
+           END;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS => 
+                FAILED ("1.5 - EXCEPTION RAISED");
+ 
+      END;
+ 
+ -- EXPLICIT INITIAL VALUE - OK
+ 
+      BEGIN
+ 
+           DECLARE
+                O : CONSTANT REC := (IDENT_INT(2), IDENT_INT(2),
+                         ((1, IDENT_INT(2)), (IDENT_INT(2), 3)));
+           BEGIN
+                IF O.U'FIRST(1) /= IDENT_INT(1) OR
+                   O.U'LAST(1)  /= IDENT_INT(2) OR
+                   O.U'FIRST(2) /= IDENT_INT(2) OR
+                   O.U'LAST(2)  /= IDENT_INT(3) THEN
+                     FAILED("2.1 - INCORRECT BOUNDS");
+                END IF;
+           END;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS => 
+                FAILED ("2.2 - EXCEPTION RAISED");
+      END;
+ 
+ -- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS
+ 
+      BEGIN
+ 
+           DECLARE
+                P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
+                                     (IDENT_INT(3) .. IDENT_INT(0) =>
+                                      (IDENT_INT(2), 3)));
+           BEGIN
+                 NULL;
+           END;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("3.1 -  CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS => 
+                FAILED ("3.2 -  WRONG EXCEPTION RAISED");
+      END;
+  
+ -- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS
+ 
+      BEGIN
+ 
+           DECLARE
+                P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
+                                     (IDENT_INT(3) .. IDENT_INT(0) =>
+                                      (OTHERS => IDENT_INT(2))));
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => 
+                FAILED ("4.1 - CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS => 
+                FAILED ("4.2 - WRONG EXCEPTION RAISED");
+ 
+      END;
+ 
+ -- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS 2ND DIM.
+ 
+      BEGIN
+ 
+           DECLARE
+                P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
+                                     (IDENT_INT(1) .. IDENT_INT(0) =>
+                                      (IDENT_INT(1) .. IDENT_INT(2) =>
+                                       1)));
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => 
+                FAILED ("5.1 - CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS => 
+                FAILED ("5.2 - WRONG EXCEPTION RAISED");
+ 
+      END;
+               
+      RESULT;
+ 
+ END C43103B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43104a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43104a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43104a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C43104A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WITH THE TYPE OF THE AGGREGATE RESOLVED, THE
+ --     DISCRIMINANT MAY BE USED TO DECIDE TO WHICH OF THE VARIANT'S
+ --     SUBTYPES THE AGGREGATE BELONGS.
+ 
+ -- HISTORY:
+ --     DHH 08/08/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43104A IS
+ 
+      TYPE INT IS RANGE 0 .. 10;
+ 
+      TYPE VAR_REC(BOOL : BOOLEAN := TRUE) IS
+           RECORD
+                CASE BOOL IS
+                     WHEN TRUE =>
+                          X : INTEGER;
+                     WHEN FALSE =>
+                          Y : INT;
+                END CASE;
+           END RECORD;
+ 
+      SUBTYPE S_TRUE IS VAR_REC(TRUE);
+      SUBTYPE S_FALSE IS VAR_REC(FALSE);
+ 
+      PROCEDURE CHECK(P : IN S_TRUE) IS
+      BEGIN
+           IF P.BOOL = FALSE THEN
+                FAILED("WRONG PROCEDURE ENTERED");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
+ 
+      END CHECK;
+ 
+ BEGIN
+      TEST("C43104A", "CHECK THAT WITH THE TYPE OF THE AGGREGATE " &
+                      "RESOLVED, THE DISCRIMINANT MAY BE USED TO " &
+                      "DECIDE TO WHICH OF THE VARIANT'S SUBTYPES " &
+                      "THE AGGREGATE BELONGS");
+ 
+      CHECK((TRUE, 1));
+ 
+      BEGIN
+ 
+           CHECK((FALSE, 2));
+           FAILED("PROCEDURE CALL USING '(FALSE, 2)' DID NOT RAISE " &
+                  "EXCEPTION");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED("INCORRECT EXCEPTION RAISED ON PROCEDURE CALL " &
+                       "USING '(FALSE,2)'");
+      END;
+ 
+      RESULT;
+ END C43104A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43105a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43105a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43105a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C43105A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     IN A RECORD AGGREGATE, (X => E, Y => E), WHERE E IS AN OVERLOADED
+ --     ENUMERATION LITERAL, OVERLOADING RESOLUTION OCCURS SEPARATELY FOR
+ --     THE DIFFERENT OCCURRENCES OF E.
+ 
+ -- HISTORY:
+ --     DHH 08/10/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43105A IS
+ 
+ BEGIN
+      TEST("C43105A", "IN A RECORD AGGREGATE, (X => E, Y => E), WHERE " &
+                      "E IS AN OVERLOADED ENUMERATION LITERAL, " &
+                      "OVERLOADING RESOLUTION OCCURS SEPARATELY FOR " &
+                      "THE DIFFERENT OCCURRENCES OF E");
+ 
+      DECLARE
+           TYPE COLOR IS (RED, YELLOW, GREEN);
+           TYPE PALETTE IS (GREEN, YELLOW, RED);
+ 
+           TYPE REC IS
+                RECORD
+                     X : COLOR;
+                     Y : PALETTE;
+                END RECORD;
+ 
+           TYPE RECD IS
+                RECORD
+                     X : PALETTE;
+                     Y : COLOR;
+                END RECORD;
+ 
+           REC1 : REC;
+           REC2 : RECD;
+ 
+           FUNCTION IDENT_C(C : COLOR) RETURN COLOR IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN C;
+                ELSE
+                     RETURN GREEN;
+                END IF;
+           END IDENT_C;
+ 
+           FUNCTION IDENT_P(P : PALETTE) RETURN PALETTE IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN P;
+                ELSE
+                     RETURN RED;
+                END IF;
+           END IDENT_P;
+ 
+ 
+      BEGIN
+           REC1 := (X => YELLOW, Y => YELLOW);
+           REC2 := (X => YELLOW, Y => YELLOW);
+ 
+           IF REC1.X /= IDENT_C(REC2.Y) THEN
+                FAILED("COLOR RESOLUTION FAILED");
+           END IF;
+ 
+           IF REC1.Y /= IDENT_P(REC2.X) THEN
+                FAILED("PALETTE RESOLUTION FAILED");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C43105A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43105b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43105b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43105b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43105b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C43105B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     IN A RECORD AGGREGATE (X => E, Y => E), WHERE E IS AN OVERLOADED
+ --     FUNCTION CALL, OVERLOADING RESOLUTION OCCURS SEPARATELY FOR THE
+ --     DIFFERENT OCCURRENCES OF E.
+ 
+ -- HISTORY:
+ --     DHH 09/07/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43105B IS
+ BEGIN
+      TEST ("C43105B", "IN A RECORD AGGREGATE (X => E, Y => E), WHERE " &
+                       "E IS AN OVERLOADED FUNCTION CALL, OVERLOADING " &
+                       "RESOLUTION OCCURS SEPARATELY FOR THE " &
+                       "DIFFERENT OCCURRENCES OF E");
+ 
+      DECLARE
+           TYPE COLOR IS (RED, YELLOW, GREEN);
+           TYPE PALETTE IS (GREEN, YELLOW, RED);
+ 
+           TYPE REC IS
+                RECORD
+                     X : COLOR;
+                     Y : PALETTE;
+                END RECORD;
+ 
+           TYPE RECD IS
+                RECORD
+                     X : PALETTE;
+                     Y : COLOR;
+                END RECORD;
+ 
+           REC1 : REC;
+           REC2 : RECD;
+ 
+           FUNCTION IDENT_C(C : COLOR) RETURN COLOR IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN C;
+                ELSE
+                     RETURN GREEN;
+                END IF;
+           END IDENT_C;
+ 
+           FUNCTION IDENT_C(P : PALETTE) RETURN PALETTE IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN P;
+                ELSE
+                     RETURN RED;
+                END IF;
+           END IDENT_C;
+ 
+      BEGIN
+           REC1 := (X => IDENT_C(YELLOW), Y => IDENT_C(YELLOW));
+           REC2 := (X => IDENT_C(YELLOW), Y => IDENT_C(YELLOW));
+ 
+           IF REC1.X /= REC2.Y THEN
+                FAILED("COLOR FUNCTION RESOLUTION FAILED");
+           END IF;
+ 
+           IF REC1.Y /= REC2.X THEN
+                FAILED("PALETTE FUNCTION RESOLUTION FAILED");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("EXCEPTION RAISED");
+      END;
+      RESULT;
+ END C43105B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43106a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43106a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43106a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C43106A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT BOTH NAMED AND POSITIONAL NOTATIONS ARE PERMITTED
+ --     WITHIN THE SAME RECORD AGGREGATE, (PROVIDED THAT ALL POSITIONAL
+ --     ASSOCIATIONS APPEAR BEFORE ANY NAMED ASSOCIATION).
+ 
+ -- HISTORY:
+ --     DHH 08/10/88 CREATED ORIGIANL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43106A IS
+ 
+      TYPE REC IS
+           RECORD
+                A : INTEGER;
+                B : CHARACTER;
+                C : BOOLEAN;
+                D, E, F, G : INTEGER;
+                H, I, J, K : CHARACTER;
+                L, M, N, O : BOOLEAN;
+                P, Q, R, S : STRING(1 .. 3);
+                T, U, V, W, X, Y, Z : BOOLEAN;
+           END RECORD;
+      AGG : REC := (12, 'A', TRUE, 1, 2, 3, 4, 'B', 'C', 'D', 'E',
+                    P|R => "ABC", S|Q => "DEF", L|X|O|U => TRUE,
+                    OTHERS => FALSE);
+ 
+      FUNCTION IDENT_CHAR(X : CHARACTER) RETURN CHARACTER IS
+      BEGIN
+           IF EQUAL(3, 3) THEN
+                RETURN X;
+           ELSE
+                RETURN 'Z';
+           END IF;
+      END IDENT_CHAR;
+ 
+ BEGIN
+      TEST("C43106A", "CHECK THAT BOTH NAMED AND POSITIONAL NOTATIONS " &
+                      "ARE PERMITTED WITHIN THE SAME RECORD " &
+                      "AGGREGATE, (PROVIDED THAT ALL POSITIONAL " &
+                      "ASSOCIATIONS APPEAR BEFORE ANY NAMED " &
+                      "ASSOCIATION)");
+ 
+      IF NOT IDENT_BOOL(AGG.C) OR NOT IDENT_BOOL(AGG.L) OR
+         NOT IDENT_BOOL(AGG.X) OR NOT IDENT_BOOL(AGG.O) OR
+         NOT IDENT_BOOL(AGG.U) OR IDENT_BOOL(AGG.M) OR
+             IDENT_BOOL(AGG.N) OR IDENT_BOOL(AGG.T) OR
+             IDENT_BOOL(AGG.V) OR IDENT_BOOL(AGG.W) OR
+             IDENT_BOOL(AGG.Y) OR IDENT_BOOL(AGG.Z) THEN
+           FAILED("BOOLEANS NOT INITIALIZED TO AGGREGATE VALUES");
+      END IF;
+ 
+      IF IDENT_STR(AGG.P) /= IDENT_STR(AGG.R) OR
+         IDENT_STR(AGG.Q) /= IDENT_STR(AGG.S) THEN
+           FAILED("STRINGS NOT INITIALIZED CORRECTLY");
+      END IF;
+ 
+      IF IDENT_CHAR(AGG.B) /= IDENT_CHAR('A') OR
+         IDENT_CHAR(AGG.H) /= IDENT_CHAR('B') OR
+         IDENT_CHAR(AGG.I) /= IDENT_CHAR('C') OR
+         IDENT_CHAR(AGG.J) /= IDENT_CHAR('D') OR
+         IDENT_CHAR(AGG.K) /= IDENT_CHAR('E') THEN
+           FAILED("CHARACTERS NOT INITIALIZED CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C43106A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43107a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43107a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43107a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C43107A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXPRESSION ASSOCIATED WITH MORE THAN ONE RECORD
+ -- COMPONENT IS EVALUATED ONCE FOR EACH ASSOCIATED COMPONENT.
+ 
+ -- EG  02/14/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43107A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43107A","CHECK THAT AN EXPRESSION WITH MORE THAN ONE " &
+                     "RECORD COMPONENT IS EVALUATED ONCE FOR EACH " &
+                     "ASSOCIATED COMPONENT");
+ 
+      BEGIN
+ 
+ CASE_A :  DECLARE
+ 
+                TYPE T1 IS ARRAY(1 .. 2) OF INTEGER;
+                TYPE R1 IS
+                     RECORD
+                          A : T1;
+                          B : INTEGER;
+                          C : T1;
+                          D : INTEGER;
+                          E : INTEGER;
+                     END RECORD;
+ 
+                A1   : R1;
+                CNTR : INTEGER := 0;
+ 
+                FUNCTION FUN1 (A : T1) RETURN T1 IS
+                BEGIN
+                     CNTR := IDENT_INT(CNTR+1);
+                     RETURN A;
+                END FUN1;
+ 
+                FUNCTION FUN2 (A : INTEGER) RETURN INTEGER IS
+                BEGIN
+                     CNTR := CNTR+1;
+                     RETURN IDENT_INT(A);
+                END FUN2;
+ 
+           BEGIN
+ 
+                A1 := (A | C => FUN1((-1, -2)), OTHERS => FUN2(-3)+1);
+                IF CNTR /= 5 THEN
+                     FAILED ("CASE A : INCORRECT NUMBER OF EVALUATIONS" &
+                             " OF RECORD ASSOCIATED COMPONENTS");
+                END IF;
+                IF A1.A /= (-1, -2) OR A1.C /= (-1, -2) OR
+                   A1.B /= -2 OR A1.D /= -2 OR A1.E /= -2 THEN
+                     FAILED ("CASE A : INCORRECT VALUES IN RECORD");
+                END IF;
+ 
+           END CASE_A;
+ 
+ CASE_B :  DECLARE
+ 
+                TYPE T2 IS ACCESS INTEGER;
+                TYPE R2 IS
+                     RECORD
+                          A : T2;
+                          B : INTEGER;
+                          C : T2;
+                          D : INTEGER;
+                          E : INTEGER;
+                     END RECORD;
+ 
+                B1   : R2;
+                CNTR : INTEGER := 0;
+ 
+                FUNCTION FUN3 RETURN INTEGER IS
+                BEGIN
+                     CNTR := CNTR+1;
+                     RETURN IDENT_INT(2);
+                END FUN3;
+ 
+           BEGIN
+ 
+                B1 := (A | C => NEW INTEGER'(-1),
+                       B | D | E => FUN3);
+                IF B1.A = B1.C OR CNTR /= 3 THEN
+                     FAILED ("CASE B : INCORRECT NUMBER OF EVALUATION" &
+                             " OF RECORD ASSOCIATED COMPONENTS");
+                END IF;
+                IF B1.B /= 2 OR B1.D /= 2 OR B1.E /= 2 OR
+                   B1.A = NULL OR B1.C = NULL OR B1.A = B1.C THEN
+                     FAILED ("CASE B : INCORRECT VALUES IN RECORD");
+                END IF;
+ 
+           END CASE_B;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43107A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43108a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43108a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43108a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C43108A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IN A RECORD AGGREGATE THE VALUE OF A DISCRIMINANT IS
+ --     USED TO RESOLVE THE TYPE OF A COMPONENT THAT DEPENDS ON THE
+ --     DISCRIMINANT.
+ 
+ -- HISTORY:
+ --     DHH 09/08/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43108A IS
+ 
+ BEGIN
+      TEST ("C43108A", "CHECK THAT IN A RECORD AGGREGATE THE VALUE OF " &
+                       "A DISCRIMINANT IS USED TO RESOLVE THE TYPE OF " &
+                       "A COMPONENT THAT DEPENDS ON THE DISCRIMINANT");
+ 
+      DECLARE
+           A : INTEGER;
+ 
+           TYPE DIS(A : BOOLEAN) IS
+                RECORD
+                     CASE A IS
+                          WHEN TRUE =>
+                               B : BOOLEAN;
+                               C : INTEGER;
+                          WHEN FALSE =>
+                               D : INTEGER;
+                     END CASE;
+                END RECORD;
+ 
+           FUNCTION DIFF(PARAM : DIS) RETURN INTEGER IS
+           BEGIN
+                IF PARAM.B THEN
+                     RETURN PARAM.C;
+                ELSE
+                     RETURN PARAM.D;
+                END IF;
+           END DIFF;
+ 
+      BEGIN
+           A := DIFF((C => 3, OTHERS => TRUE));
+ 
+           IF A /= IDENT_INT(3) THEN
+                FAILED("STATIC OTHERS NOT DECIDED CORRECTLY");
+           END IF;
+      END;
+ 
+      DECLARE
+           GLOBAL : INTEGER := 0;
+           TYPE INT IS NEW INTEGER;
+ 
+           TYPE DIS(A : BOOLEAN) IS
+                RECORD
+                     CASE A IS
+                          WHEN TRUE =>
+                               I1 : INT;
+                          WHEN FALSE =>
+                               I2 : INTEGER;
+                     END CASE;
+                END RECORD;
+           FUNCTION F RETURN INT;
+           FUNCTION F RETURN INTEGER;
+ 
+           A : DIS(TRUE);
+ 
+           FUNCTION F RETURN INT IS
+           BEGIN
+                GLOBAL := 1;
+                RETURN 5;
+           END F;
+ 
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                GLOBAL := 2;
+                RETURN 5;
+           END F;
+ 
+      BEGIN
+           A := (TRUE, OTHERS => F);
+ 
+           IF GLOBAL /= 1 THEN
+                FAILED("NON_STATIC OTHERS NOT DECIDED CORRECTLY");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C43108A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,512 ----
+ -- C432001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --
+ --      Check that extension aggregates may be used to specify values
+ --      for types that are record extensions. Check that the
+ --      type of the ancestor expression may be any nonlimited type that
+ --      is a record extension, including private types and private
+ --      extensions. Check that the type for the aggregate is
+ --      derived from the type of the ancestor expression.
+ --
+ -- TEST DESCRIPTION:
+ --
+ --      Two progenitor nonlimited record types are declared, one
+ --      nonprivate and one private. Using these as parent types,
+ --      all possible combinations of record extensions are declared
+ --      (Nonprivate record extension of nonprivate type, private
+ --      extension of nonprivate type, nonprivate record extension of
+ --      private type, and private extension of private type). Finally,
+ --      each of these types is extended using nonprivate record
+ --      extensions.
+ --
+ --      Extension of private types is done in packages other than
+ --      the ones containing the parent declaration. This is done
+ --      to eliminate errors with extension of the partial view of
+ --      a type, which is not an objective of this test.
+ --
+ --      All components of private types and private extensions are given
+ --      default values. This eliminates the need for separate subprograms
+ --      whose sole purpose is to place a value into a private record type.
+ --
+ --      Types that have been extended are checked using an object of their
+ --      parent type as the ancestor expression. For those types that
+ --      have been extended twice, using only nonprivate record extensions,
+ --      a check is made using an object of their grandparent type as
+ --      the ancestor expression.
+ --      
+ --      For each type, a subprogram is defined which checks the contents
+ --      of the parameter, which is a value of the record extension.
+ --      Components of nonprivate record extensions are checked against
+ --      passed-in parameters of the component type. Components of private
+ --      extensions are checked to ensure that they maintain their initial
+ --      values.
+ --
+ --      To check that the aggregate's type is derived from its ancestor,
+ --      each Check subprogram in turn calls the Check subprogram for
+ --      its parent type. Explicit conversion is used to convert the
+ --      record extension to the parent type.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ package C432001_0 is
+ 
+    type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);
+ 
+    type N is tagged record
+       How_Long_Ago : Natural := Report.Ident_Int(1);
+       Era          : Eras := Cenozoic;
+    end record;
+ 
+    function Check (Rec : in N;
+                    N   : in Natural;
+                    E   : in Eras) return Boolean;
+ 
+    type P is tagged private;
+ 
+    function Check (Rec : in P) return Boolean;
+ 
+ private
+ 
+    type P is tagged record
+       How_Long_Ago : Natural := Report.Ident_Int(150);
+       Era          : Eras := Mesozoic;
+    end record;
+ 
+ end C432001_0;
+ 
+ package body C432001_0 is
+ 
+    function Check (Rec : in P) return Boolean is
+    begin
+       return Rec.How_Long_Ago = 150 and Rec.Era = Mesozoic;
+    end Check;
+ 
+    function Check (Rec : in N;
+                    N   : in Natural;
+                    E   : in Eras) return Boolean is
+    begin
+       return Rec.How_Long_Ago = N and Rec.Era = E;
+    end Check;
+ 
+ end C432001_0;
+ 
+ with C432001_0;
+ package C432001_1 is
+ 
+    type Periods is
+       (Aphebian, Helikian, Hadrynian,
+        Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,
+        Triassic, Jurassic, Cretaceous,
+        Tertiary, Quaternary);
+ 
+    type N_N is new C432001_0.N with record
+       Period : Periods := C432001_1.Quaternary;
+    end record;
+ 
+    function Check (Rec : in N_N;
+                    N   : in Natural;
+                    E   : in C432001_0.Eras;
+                    P   : in Periods) return Boolean;
+ 
+    type N_P is new C432001_0.N with private;
+ 
+    function Check (Rec : in N_P) return Boolean;
+ 
+    type P_N is new C432001_0.P with record
+       Period : Periods := C432001_1.Jurassic;
+    end record;
+ 
+    function Check (Rec : in P_N;
+                    P   : in Periods) return Boolean;
+ 
+    type P_P is new C432001_0.P with private;
+ 
+    function Check (Rec : in P_P) return Boolean;
+ 
+    type P_P_Null is new C432001_0.P with null record;  
+ 
+ private
+ 
+    type N_P is new C432001_0.N with record
+       Period : Periods := C432001_1.Quaternary;
+    end record;
+ 
+    type P_P is new C432001_0.P with record
+       Period : Periods := C432001_1.Jurassic;
+    end record;
+ 
+ end C432001_1;
+ 
+ with Report;
+ package body C432001_1 is
+ 
+    function Check (Rec : in N_N;
+                    N   : in Natural;
+                    E   : in C432001_0.Eras;
+                    P   : in Periods) return Boolean is
+    begin
+       if not C432001_0.Check (C432001_0.N (Rec), N, E) then
+          Report.Failed ("Conversion to parent type of " &
+                         "nonprivate portion of " &
+                         "nonprivate extension failed");
+       end if;
+       return Rec.Period = P;
+    end Check;
+    
+ 
+    function Check (Rec : in N_P) return Boolean is
+    begin
+       if not C432001_0.Check (C432001_0.N (Rec), 1, C432001_0.Cenozoic) then
+          Report.Failed ("Conversion to parent type of " &
+                         "nonprivate portion of " &
+                         "private extension failed");
+       end if;
+       return Rec.Period = C432001_1.Quaternary;
+    end Check;
+ 
+    function Check (Rec : in P_N;
+                    P   : in Periods) return Boolean is
+    begin
+       if not C432001_0.Check (C432001_0.P (Rec)) then
+          Report.Failed ("Conversion to parent type of " &
+                         "private portion of " &
+                         "nonprivate extension failed");
+       end if;
+       return Rec.Period = P;
+    end Check;
+ 
+    function Check (Rec : in P_P) return Boolean is
+    begin
+       if not C432001_0.Check (C432001_0.P (Rec)) then
+          Report.Failed ("Conversion to parent type of " &
+                         "private portion of " &
+                         "private extension failed");
+       end if;
+       return Rec.Period = C432001_1.Jurassic;
+    end Check;
+ 
+ end C432001_1;
+ 
+ with C432001_0;
+ with C432001_1;
+ package C432001_2 is
+ 
+    -- All types herein are nonprivate extensions, since aggregates
+    -- cannot be given for private extensions
+    
+    type N_N_N is new C432001_1.N_N with record
+       Sample_On_Loan : Boolean;
+    end record;
+ 
+    function Check (Rec : in N_N_N;
+                    N   : in Natural;
+                    E   : in C432001_0.Eras;
+                    P   : in C432001_1.Periods;
+                    B   : in Boolean) return Boolean;
+ 
+    type N_P_N is new C432001_1.N_P with record
+       Sample_On_Loan : Boolean;
+    end record;
+ 
+    function Check (Rec : in N_P_N;
+                    B   : Boolean) return Boolean;
+ 
+    type P_N_N is new C432001_1.P_N with record
+       Sample_On_Loan : Boolean;
+    end record;
+ 
+    function Check (Rec : in P_N_N;
+                    P   : in C432001_1.Periods;
+                    B   : Boolean) return Boolean;
+ 
+    type P_P_N is new C432001_1.P_P with record
+       Sample_On_Loan : Boolean;
+    end record;
+ 
+    function Check (Rec : in P_P_N;
+                    B   : Boolean) return Boolean;
+ 
+ end C432001_2;
+ 
+ with Report;
+ package body C432001_2 is
+ 
+    -- direct access to operator
+    use type C432001_1.Periods;
+ 
+ 
+    function Check (Rec : in N_N_N;
+                    N   : in Natural;
+                    E   : in C432001_0.Eras;
+                    P   : in C432001_1.Periods;
+                    B   : in Boolean) return Boolean is
+    begin
+       if not C432001_1.Check (C432001_1.N_N (Rec), N, E, P) then
+          Report.Failed ("Conversion to parent " &
+                         "nonprivate type extension " &
+                         "failed");
+       end if;
+       return Rec.Sample_On_Loan = B;
+    end Check;
+    
+ 
+    function Check (Rec : in N_P_N;
+                    B   : Boolean) return Boolean is
+    begin
+       if not C432001_1.Check (C432001_1.N_P (Rec)) then
+          Report.Failed ("Conversion to parent " &
+                         "private type extension " &
+                         "failed");
+       end if;
+       return Rec.Sample_On_Loan = B;
+    end Check;
+ 
+    function Check (Rec : in P_N_N;
+                    P   : in C432001_1.Periods;
+                    B   : Boolean) return Boolean is
+    begin
+       if not C432001_1.Check (C432001_1.P_N (Rec), P) then
+          Report.Failed ("Conversion to parent " &
+                         "nonprivate type extension " &
+                         "failed");
+       end if;
+       return Rec.Sample_On_Loan = B;
+    end Check;
+ 
+    function Check (Rec : in P_P_N;
+                    B   : Boolean) return Boolean is
+    begin
+       if not C432001_1.Check (C432001_1.P_P (Rec)) then
+          Report.Failed ("Conversion to parent " &
+                         "private type extension " &
+                         "failed");
+       end if;
+       return Rec.Sample_On_Loan = B;
+    end Check;
+ 
+ end C432001_2;
+ 
+ 
+ with C432001_0;
+ with C432001_1;
+ with C432001_2;
+ with Report;
+ procedure C432001 is
+ 
+    N_Object : C432001_0.N := (How_Long_Ago => Report.Ident_Int(375),
+                               Era          => C432001_0.Paleozoic);
+ 
+    P_Object : C432001_0.P; -- default value is (150,
+                            --                   C432001_0.Mesozoic)
+ 
+    N_N_Object : C432001_1.N_N :=
+       (N_Object with Period => C432001_1.Devonian);
+ 
+    P_N_Object : C432001_1.P_N :=
+       (P_Object with Period => C432001_1.Jurassic);
+ 
+    N_P_Object : C432001_1.N_P; -- default is (1,
+                                --             C432001_0.Cenozoic,
+                                --             C432001_1.Quaternary)
+ 
+    P_P_Object : C432001_1.P_P; -- default is (150,
+                                --             C432001_0.Mesozoic,
+                                --             C432001_1.Jurassic)
+ 
+    P_P_Null_Ob:C432001_1.P_P_Null := (P_Object with null record);
+ 
+    N_N_N_Object : C432001_2.N_N_N :=
+       (N_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
+ 
+    N_P_N_Object : C432001_2.N_P_N :=
+       (N_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
+ 
+    P_N_N_Object : C432001_2.P_N_N :=
+       (P_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
+ 
+    P_P_N_Object : C432001_2.P_P_N :=
+       (P_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
+ 
+    P_N_Object_2 : C432001_1.P_N := (C432001_0.P(P_N_N_Object)
+                                     with C432001_1.Carboniferous);
+ 
+    N_N_Object_2 : C432001_1.N_N := (C432001_0.N'(42,C432001_0.Precambrian)
+                                     with C432001_1.Carboniferous);
+ 
+ begin
+ 
+    Report.Test ("C432001", "Extension aggregates");
+ 
+    -- check ultimate ancestor types
+ 
+    if not C432001_0.Check (N_Object,
+                            375,
+                            C432001_0.Paleozoic) then
+       Report.Failed ("Object of " &
+                      "nonprivate type " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_0.Check (P_Object) then
+       Report.Failed ("Object of " &
+                      "private type " &
+                      "failed content check");
+    end if;
+ 
+    -- check direct type extensions
+ 
+    if not C432001_1.Check (N_N_Object,
+                            375,
+                            C432001_0.Paleozoic,
+                            C432001_1.Devonian) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension of nonprivate type " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_1.Check (N_P_Object) then
+       Report.Failed ("Object of " &
+                      "private extension of nonprivate type " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_1.Check (P_N_Object,
+                            C432001_1.Jurassic) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension of private type " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_1.Check (P_P_Object) then
+       Report.Failed ("Object of " &
+                      "private extension of private type " &
+                      "failed content check");
+    end if;
+ 
+     if not C432001_1.Check (P_P_Null_Ob) then
+       Report.Failed ("Object of " &
+                      "private type " &
+                      "failed content check");
+    end if;
+ 
+ 
+    -- check direct extensions of extensions
+ 
+    if not C432001_2.Check (N_N_N_Object,
+                            375,
+                            C432001_0.Paleozoic,
+                            C432001_1.Devonian,
+                            True) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension of nonprivate extension " &
+                      "(of nonprivate parent) " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_2.Check (N_P_N_Object, False) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension of private extension " &
+                      "(of nonprivate parent) " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_2.Check (P_N_N_Object,
+                            C432001_1.Jurassic,
+                            True) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension of nonprivate extension " &
+                      "(of private parent) " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_2.Check (P_P_N_Object, False) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension of private extension " &
+                      "(of private parent) " &
+                      "failed content check");
+    end if;
+ 
+    -- check that the extension aggregate may specify an expression of
+    -- a "grandparent" ancestor type
+ 
+    -- types tested are derived through nonprivate extensions only
+    -- (extension aggregates are not allowed if the path from the
+    -- ancestor type wanders through a private extension)
+    
+    N_N_N_Object :=
+       (N_Object with Period => C432001_1.Devonian,
+                      Sample_On_Loan => Report.Ident_Bool(True));
+ 
+    if not C432001_2.Check (N_N_N_Object,
+                            375,
+                            C432001_0.Paleozoic,
+                            C432001_1.Devonian,
+                            True) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension " &
+                      "of nonprivate ancestor " &
+                      "failed content check");
+    end if;
+ 
+    P_N_N_Object :=
+       (P_Object with Period => C432001_1.Jurassic,
+                      Sample_On_Loan => Report.Ident_Bool(True));
+ 
+    if not C432001_2.Check (P_N_N_Object,
+                            C432001_1.Jurassic,
+                            True) then
+       Report.Failed ("Object of " &
+                      "nonprivate extension " &
+                      "of private ancestor " &
+                      "failed content check");
+    end if;
+ 
+   -- Check additional cases
+    if not C432001_1.Check (P_N_Object_2,
+                            C432001_1.Carboniferous) then
+       Report.Failed ("Additional Object of " &
+                      "nonprivate extension of private type " &
+                      "failed content check");
+    end if;
+ 
+    if not C432001_1.Check (N_N_Object_2,
+                            42,
+                            C432001_0.Precambrian,
+                            C432001_1.Carboniferous) then
+       Report.Failed ("Additional Object of " &
+                      "nonprivate extension of nonprivate type " &
+                      "failed content check");
+    end if;
+ 
+    Report.Result;
+ 
+ end C432001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,764 ----
+ -- C432002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if an extension aggregate specifies a value for a record 
+ --      extension and the ancestor expression has discriminants that are
+ --      inherited by the record extension, then a check is made that each
+ --      discriminant has the value specified.
+ --
+ --      Check that if an extension aggregate specifies a value for a record 
+ --      extension and the ancestor expression has discriminants that are not
+ --      inherited by the record extension, then a check is made that each
+ --      such discriminant has the value specified for the corresponding
+ --      discriminant.
+ --
+ --      Check that the corresponding discriminant value may be specified
+ --      in the record component association list or in the derived type
+ --      definition for an ancestor.
+ --
+ --      Check the case of ancestors that are several generations removed.
+ --      Check the case where the value of the discriminant(s) in question
+ --      is supplied several generations removed.
+ --
+ --      Check the case of multiple discriminants.
+ --
+ --      Check that Constraint_Error is raised if the check fails.
+ --
+ -- TEST DESCRIPTION:
+ --      A hierarchy of tagged types is declared from a discriminated
+ --      root type. Each level declares two kinds of types: (1) a type
+ --      extension which constrains the discriminant of its parent to
+ --      the value of an expression and (2) a type extension that
+ --      constrains the discriminant of its parent to equal a new discriminant
+ --      of the type extension (These are the two categories of noninherited
+ --      discriminants).
+ --
+ --      Values for each type are declared within nested blocks. This is
+ --      done so that the instances that produce Constraint_Error may
+ --      be dealt with cleanly without forcing the program to exit.
+ --
+ --      Success and failure cases (which should raise Constraint_Error)
+ --      are set up for each kind of type. Additionally, for the first
+ --      level of the hierarchy, separate tests are done for ancestor
+ --      expressions specified by aggregates and those specified by
+ --      variables. Later tests are performed using variables only.
+ --
+ --      Additionally, the cases tested consist of the following kinds of
+ --      types:
+ --
+ --         Extensions of extensions, using both the parent and grandparent
+ --         types for the ancestor expression,
+ --
+ --         Ancestor expressions which are several generations removed
+ --         from the type of the aggregate,
+ --
+ --         Extensions of types with multiple discriminants, where the
+ --         extension declares a new discriminant which corresponds to
+ --         more than one discriminant of the ancestor types.
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --      20 Dec 94   SAIC    Repair confusion WRT overridden discriminants
+ --
+ --!
+ 
+ package C432002_0 is
+ 
+    subtype Length is Natural range 0..256;
+    type Discriminant (L : Length) is tagged
+       record
+          S1 : String (1..L);
+       end record;
+ 
+    procedure Do_Something (Rec : in out Discriminant);
+    -- inherited by all type extensions
+ 
+    -- Aggregates of Discriminant are of the form
+    --    (L, S1) where L= S1'Length
+ 
+    -- Discriminant of parent constrained to value of an expression
+    type Constrained_Discriminant_Extension is
+       new Discriminant (L => 10)
+       with record
+          S2 : String (1..20);
+       end record;
+ 
+    -- Aggregates of Constrained_Discriminant_Extension are of the form
+    --    (L, S1, S2), where L = S1'Length = 10, S2'Length = 20
+ 
+    type Once_Removed is new Constrained_Discriminant_Extension
+       with record
+          S3 : String (1..3);
+       end record;
+ 
+    type Twice_Removed is new Once_Removed
+       with record
+          S4 : String (1..8);
+       end record;
+ 
+    -- Aggregates of Twice_Removed are of the form
+    --    (L, S1, S2, S3, S4), where L = S1'Length = 10,
+    --                               S2'Length = 20,
+    --                               S3'Length = 3,
+    --                               S4'Length = 8
+ 
+    -- Discriminant of parent constrained to equal new discriminant
+    type New_Discriminant_Extension (N : Length) is
+       new Discriminant (L => N) with
+       record
+          S2 : String (1..N);
+       end record;
+ 
+    -- Aggregates of New_Discriminant_Extension are of the form
+    --   (N, S1, S2), where N = S1'Length = S2'Length
+ 
+    -- Discriminant of parent extension constrained to the value of
+    -- an expression
+    type Constrained_Extension_Extension is
+       new New_Discriminant_Extension (N => 20)
+       with record
+          S3 : String (1..5);
+       end record;
+ 
+    -- Aggregates of Constrained_Extension_Extension are of the form
+    --   (N, S1, S2, S3), where N = S1'Length = S2'Length = 20,
+    --                             S3'Length = 5
+ 
+    -- Discriminant of parent extension constrained to equal a new
+    -- discriminant
+    type New_Extension_Extension (I : Length) is
+       new New_Discriminant_Extension (N => I)
+       with record
+          S3 : String (1..I);
+       end record;
+ 
+    -- Aggregates of New_Extension_Extension are of the form
+    --    (I, S1, 2, S3), where
+    --       I = S1'Length = S2'Length = S3'Length
+ 
+    type Multiple_Discriminants (A, B : Length) is tagged
+       record
+          S1 : String (1..A);
+          S2 : String (1..B);
+       end record;
+ 
+    procedure Do_Something (Rec : in out Multiple_Discriminants);
+    -- inherited by type extension
+ 
+    -- Aggregates of Multiple_Discriminants are of the form
+    --    (A, B, S1, S2), where A = S1'Length, B = S2'Length
+ 
+    type Multiple_Discriminant_Extension (C : Length) is
+       new Multiple_Discriminants (A => C, B => C)
+       with record
+          S3 : String (1..C);
+       end record;
+ 
+    -- Aggregates of Multiple_Discriminant_Extension are of the form
+    --    (A, B, S1, S2, C, S3), where
+    --       A = B = C = S1'Length = S2'Length = S3'Length
+ 
+ end C432002_0;
+ 
+ with Report;
+ package body C432002_0 is
+ 
+    S : String (1..20) := "12345678901234567890";
+ 
+    procedure Do_Something (Rec : in out Discriminant) is
+    begin
+       Rec.S1 := Report.Ident_Str (S (1..Rec.L));
+    end Do_Something;
+ 
+    procedure Do_Something (Rec : in out Multiple_Discriminants) is
+    begin
+       Rec.S1 := Report.Ident_Str (S (1..Rec.A));
+    end Do_Something;
+ 
+ end C432002_0;
+ 
+ 
+ with C432002_0;
+ with Report;
+ procedure C432002 is
+ 
+    -- Various different-sized strings for variety
+    String_3  : String (1..3)  := Report.Ident_Str("123");
+    String_5  : String (1..5)  := Report.Ident_Str("12345");
+    String_8  : String (1..8)  := Report.Ident_Str("12345678");
+    String_10 : String (1..10) := Report.Ident_Str("1234567890");
+    String_11 : String (1..11) := Report.Ident_Str("12345678901");
+    String_20 : String (1..20) := Report.Ident_Str("12345678901234567890");
+ 
+ begin
+ 
+    Report.Test ("C432002",
+                 "Extension aggregates for discriminated types");
+ 
+    --------------------------------------------------------------------
+    -- Extension constrains parent's discriminant to value of expression
+    --------------------------------------------------------------------
+ 
+    -- Successful cases - value matches corresponding discriminant value
+ 
+    CD_Matched_Aggregate:
+    begin
+       declare
+          CD : C432002_0.Constrained_Discriminant_Extension :=
+             (C432002_0.Discriminant'(L  => 10,
+                                      S1 => String_10)
+                with S2 => String_20);
+       begin
+          C432002_0.Do_Something(CD); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is an aggregate");
+          Report.Failed ("Aggregate of extension " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end CD_Matched_Aggregate;
+    
+    CD_Matched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant(L => 10) :=
+             C432002_0.Discriminant'(L  => 10,
+                                     S1 => String_10);
+ 
+          CD : C432002_0.Constrained_Discriminant_Extension :=
+             (D with S2 => String_20);
+       begin
+          C432002_0.Do_Something(CD); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is a variable");
+          Report.Failed ("Aggregate of extension " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end CD_Matched_Variable;
+ 
+    
+    -- Unsuccessful cases - value does not match value of corresponding
+    --                      discriminant. Constraint_Error should be
+    --                      raised.
+ 
+    CD_Unmatched_Aggregate:
+    begin
+       declare
+          CD : C432002_0.Constrained_Discriminant_Extension :=
+             (C432002_0.Discriminant'(L  => 5,
+                                      S1 => String_5)
+                with S2 => String_20);
+       begin
+          Report.Comment ("Ancestor expression is an aggregate");
+          Report.Failed ("Aggregate of extension " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(CD); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise of Constraint_Error is expected
+    end CD_Unmatched_Aggregate;
+    
+    CD_Unmatched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant(L => 5) :=
+             C432002_0.Discriminant'(L  => 5,
+                                     S1 => String_5);
+ 
+          CD : C432002_0.Constrained_Discriminant_Extension :=
+             (D with S2 => String_20);
+       begin
+          Report.Comment ("Ancestor expression is an variable");
+          Report.Failed ("Aggregate of extension " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(CD); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise of Constraint_Error is expected
+    end CD_Unmatched_Variable;
+ 
+    -----------------------------------------------------------------------
+    -- Extension constrains parent's discriminant to equal new discriminant
+    -----------------------------------------------------------------------
+ 
+    -- Successful cases - value matches corresponding discriminant value
+ 
+    ND_Matched_Aggregate:
+    begin
+       declare
+          ND : C432002_0.New_Discriminant_Extension (N => 8) :=
+             (C432002_0.Discriminant'(L  => 8,
+                                      S1 => String_8)
+                with N  => 8,
+                     S2 => String_8);
+       begin
+          C432002_0.Do_Something(ND); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is an aggregate");
+          Report.Failed ("Aggregate of extension " &
+                         "with new discriminant: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end ND_Matched_Aggregate;
+    
+    ND_Matched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant(L => 3) :=
+             C432002_0.Discriminant'(L  => 3,
+                                     S1 => String_3);
+ 
+          ND : C432002_0.New_Discriminant_Extension (N => 3) :=
+             (D with N  => 3,
+                     S2 => String_3);
+       begin
+          C432002_0.Do_Something(ND); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is an variable");
+          Report.Failed ("Aggregate of extension " &
+                         "with new discriminant: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end ND_Matched_Variable;
+ 
+    
+    -- Unsuccessful cases - value does not match value of corresponding
+    --                      discriminant. Constraint_Error should be
+    --                      raised.
+    
+    ND_Unmatched_Aggregate:
+    begin
+       declare
+          ND : C432002_0.New_Discriminant_Extension (N => 20) :=
+             (C432002_0.Discriminant'(L  => 11,
+                                      S1 => String_11)
+                with N  => 20,
+                     S2 => String_20);
+       begin
+          Report.Comment ("Ancestor expression is an aggregate");
+          Report.Failed ("Aggregate of extension " &
+                         "with new discriminant: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(ND); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise is expected
+    end ND_Unmatched_Aggregate;
+    
+    ND_Unmatched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant(L => 5) :=
+             C432002_0.Discriminant'(L  => 5,
+                                     S1 => String_5);
+ 
+          ND : C432002_0.New_Discriminant_Extension (N => 20) :=
+             (D with N  => 20,
+                     S2 => String_20);
+       begin
+          Report.Comment ("Ancestor expression is an variable");
+          Report.Failed ("Aggregate of extension " &
+                         "with new discriminant: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(ND); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise is expected
+    end ND_Unmatched_Variable;
+ 
+    --------------------------------------------------------------------
+    -- Extension constrains parent's discriminant to value of expression
+    -- Parent is a discriminant extension
+    --------------------------------------------------------------------
+ 
+    -- Successful cases - value matches corresponding discriminant value
+ 
+    CE_Matched_Aggregate:
+    begin
+       declare
+          CE : C432002_0.Constrained_Extension_Extension :=
+             (C432002_0.Discriminant'(L  => 20,
+                                      S1 => String_20)
+                with N => 20,
+                     S2 => String_20,
+                     S3 => String_5);
+       begin
+          C432002_0.Do_Something(CE); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is an aggregate");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end CE_Matched_Aggregate;
+    
+    CE_Matched_Variable:
+    begin
+       declare
+          ND : C432002_0.New_Discriminant_Extension (N => 20) :=
+             C432002_0.New_Discriminant_Extension'
+                (N  => 20,
+                 S1 => String_20,
+                 S2 => String_20);
+ 
+          CE : C432002_0.Constrained_Extension_Extension :=
+             (ND with S3 => String_5);
+       begin
+          C432002_0.Do_Something(CE); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is a variable");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end CE_Matched_Variable;
+ 
+    
+    -- Unsuccessful cases - value does not match value of corresponding
+    --                      discriminant. Constraint_Error should be
+    --                      raised.
+ 
+    CE_Unmatched_Aggregate:
+    begin
+       declare
+          CE : C432002_0.Constrained_Extension_Extension :=
+             (C432002_0.New_Discriminant_Extension'
+                (N  => 11,
+                 S1 => String_11,
+                 S2 => String_11)
+             with S3 => String_5);
+       begin
+          Report.Comment ("Ancestor expression is an aggregate");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "Constraint_Error was not raised " &
+                         "with discriminant constrained: " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(CE); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise of Constraint_Error is expected
+    end CE_Unmatched_Aggregate;
+    
+    CE_Unmatched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant(L => 8) :=
+             C432002_0.Discriminant'(L  => 8,
+                                     S1 => String_8);
+ 
+          CE : C432002_0.Constrained_Extension_Extension :=
+             (D with N  => 8,
+                     S2 => String_8,
+                     S3 => String_5);
+       begin
+          Report.Comment ("Ancestor expression is a variable");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(CE); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise of Constraint_Error is expected
+    end CE_Unmatched_Variable;
+ 
+    -----------------------------------------------------------------------
+    -- Extension constrains parent's discriminant to equal new discriminant
+    -- Parent is a discriminant extension
+    -----------------------------------------------------------------------
+ 
+    -- Successful cases - value matches corresponding discriminant value
+ 
+    NE_Matched_Aggregate:
+    begin
+       declare
+          NE : C432002_0.New_Extension_Extension (I => 8) :=
+             (C432002_0.Discriminant'(L  => 8,
+                                      S1 => String_8)
+                with I  => 8,
+                     S2 => String_8,
+                     S3 => String_8);
+       begin
+          C432002_0.Do_Something(NE); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is an aggregate");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "with new discriminant: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end NE_Matched_Aggregate;
+    
+    NE_Matched_Variable:
+    begin
+       declare
+          ND : C432002_0.New_Discriminant_Extension (N => 3) :=
+             C432002_0.New_Discriminant_Extension'
+                (N  => 3,
+                 S1 => String_3,
+                 S2 => String_3);
+ 
+          NE : C432002_0.New_Extension_Extension (I => 3) :=
+             (ND with I  => 3,
+                      S3 => String_3);
+       begin
+          C432002_0.Do_Something(NE); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Comment ("Ancestor expression is a variable");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "with new discriminant: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end NE_Matched_Variable;
+ 
+    
+    -- Unsuccessful cases - value does not match value of corresponding
+    --                      discriminant. Constraint_Error should be
+    --                      raised.
+ 
+    NE_Unmatched_Aggregate:
+    begin
+       declare
+          NE : C432002_0.New_Extension_Extension (I => 8) :=
+             (C432002_0.New_Discriminant_Extension'
+                (C432002_0.Discriminant'(L  => 11,
+                                         S1 => String_11)
+                 with N  => 11,
+                      S2 => String_11)
+             with I  => 8,
+                  S3 => String_8);
+       begin
+          Report.Comment ("Ancestor expression is an extension aggregate");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "with new discriminant: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(NE); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise is expected
+    end NE_Unmatched_Aggregate;
+    
+    NE_Unmatched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant(L => 5) :=
+             C432002_0.Discriminant'(L  => 5,
+                                     S1 => String_5);
+ 
+          NE : C432002_0.New_Extension_Extension (I => 20) :=
+             (D with I  => 5,
+                     S2 => String_5,
+                     S3 => String_20);
+       begin
+          Report.Comment ("Ancestor expression is a variable");
+          Report.Failed ("Aggregate of extension (of extension) " &
+                         "with new discriminant: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(NE); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise is expected
+    end NE_Unmatched_Variable;
+ 
+    -----------------------------------------------------------------------
+    -- Corresponding discriminant is two levels deeper than aggregate
+    -----------------------------------------------------------------------
+ 
+    -- Successful case - value matches corresponding discriminant value
+ 
+    TR_Matched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant (L => 10) :=
+             C432002_0.Discriminant'(L  => 10,
+                                     S1 => String_10);
+ 
+          TR : C432002_0.Twice_Removed :=
+             C432002_0.Twice_Removed'(D with S2 => String_20,
+                                             S3 => String_3,
+                                             S4 => String_8);
+          -- N is constrained to a value in the derived_type_definition
+          -- of Constrained_Discriminant_Extension. Its omission from
+          -- the above record_component_association_list is allowed by
+          -- 4.3.2(6).
+ 
+       begin
+          C432002_0.Do_Something(TR); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Failed ("Aggregate of far-removed extension " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end TR_Matched_Variable;
+    
+    
+    -- Unsuccessful case - value does not match value of corresponding
+    --                      discriminant. Constraint_Error should be
+    --                      raised.
+ 
+    TR_Unmatched_Variable:
+    begin
+       declare
+          D : C432002_0.Discriminant (L => 5) :=
+             C432002_0.Discriminant'(L  => 5,
+                                     S1 => String_5);
+ 
+          TR : C432002_0.Twice_Removed :=
+             C432002_0.Twice_Removed'(D with S2 => String_20,
+                                             S3 => String_3,
+                                             S4 => String_8);
+ 
+       begin
+          Report.Failed ("Aggregate of far-removed extension " &
+                         "with discriminant constrained: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(TR); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise is expected
+    end TR_Unmatched_Variable;
+    
+    ------------------------------------------------------------------------
+    -- Parent has multiple discriminants.
+    -- Discriminant in extension corresponds to both parental discriminants.
+    ------------------------------------------------------------------------
+ 
+    -- Successful case - value matches corresponding discriminant value
+ 
+    MD_Matched_Variable:
+    begin
+       declare
+          MD : C432002_0.Multiple_Discriminants (A => 10, B => 10) :=
+             C432002_0.Multiple_Discriminants'(A  => 10,
+                                               B  => 10,
+                                               S1 => String_10,
+                                               S2 => String_10);
+          MDE : C432002_0.Multiple_Discriminant_Extension (C => 10) :=
+             (MD with C  => 10,
+                      S3 => String_10);
+ 
+       begin
+          C432002_0.Do_Something(MDE); -- success
+       end;
+    exception
+       when Constraint_Error =>
+          Report.Failed ("Aggregate of extension " &
+                         "of multiply-discriminated parent: " &
+                         "Constraint_Error was incorrectly raised " &
+                         "for value that matches corresponding " &
+                         "discriminant");
+    end MD_Matched_Variable;
+ 
+    
+    -- Unsuccessful case - value does not match value of corresponding
+    --                      discriminant. Constraint_Error should be
+    --                      raised.
+ 
+    MD_Unmatched_Variable:
+    begin
+       declare
+          MD : C432002_0.Multiple_Discriminants (A => 10, B => 8) :=
+             C432002_0.Multiple_Discriminants'(A  => 10,
+                                               B  => 8,
+                                               S1 => String_10,
+                                               S2 => String_8);
+          MDE : C432002_0.Multiple_Discriminant_Extension (C => 10) :=
+             (MD with C  => 10,
+                      S3 => String_10);
+ 
+       begin
+          Report.Failed ("Aggregate of extension " &
+                         "of multiply-discriminated parent: " &
+                         "Constraint_Error was not raised " &
+                         "for discriminant value that does not match " &
+                         "corresponding discriminant");
+          C432002_0.Do_Something(MDE); -- disallow unused var optimization
+       end;
+    exception
+       when Constraint_Error =>
+          null; -- raise is expected
+    end MD_Unmatched_Variable;
+ 
+    Report.Result;
+ 
+ end C432002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,594 ----
+ -- C432003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the type of the ancestor part of an extension aggregate
+ --      has discriminants that are not inherited by the type of the aggregate,
+ --      and the ancestor part is a subtype mark that denotes a constrained
+ --      subtype, Constraint_Error is raised if: 1) any discriminant of the
+ --      ancestor has a different value than that specified for a corresponding
+ --      discriminant in the derived type definition for some ancestor of the
+ --      type of the aggregate, or 2) the value for the discriminant in the
+ --      record association list is not the value of the corresponding 
+ --      discriminant.  Check that the components of the value of the
+ --      aggregate not given by the record component association list are
+ --      initialized by default as for an object of the ancestor type.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      type T (D1: ...) is tagged ...
+ --
+ --      type    DT is new T with ...
+ --      subtype ST is DT (D1 => 3);    -- Constrained subtype.
+ --
+ --      type NT1 (D2: ...) is new DT (D1 => D2) with null record;
+ --      type NT2 (D2: ...) is new DT (D1 => 6)  with null record;
+ --      type NT3           is new DT (D1 => 6)  with null record;
+ --
+ --      A: NT1 := (T  with D2 => 6); -- OK: T  is unconstrained.
+ --      B: NT1 := (DT with D2 => 6); -- OK: DT is unconstrained.
+ --      C: NT1 := (ST with D2 => 6); -- NO: ST.D1 /= D2.
+ --
+ --      D: NT2 := (T  with D2 => 4); -- OK: T  is unconstrained.
+ --      E: NT2 := (DT with D2 => 4); -- OK: DT is unconstrained.
+ --      F: NT2 := (ST with  . . . ); -- NO: ST.D1 /= DT.D1 as specified in NT2.
+ --
+ --      G: NT3 := (T  with D1 => 6); -- OK: T  is unconstrained.
+ --      H: NT3 := (DT with D1 => 6); -- OK: DT is unconstrained.
+ --      I: NT3 := (ST with D1 => 6); -- NO: ST.D1 /= DT.D1 as specified in NT3.
+ --
+ --      In A, B, D, E, G, and H the ancestor part is the name of an
+ --      unconstrained subtype, so this rule does not apply. In C, F, and I
+ --      the ancestor part (ST) is the name of a constrained subtype of DT,
+ --      which is itself a derived type of a discriminated tagged type T. ST
+ --      constrains the discriminant of DT (D1) to the value 3; thus, the
+ --      type of any extension aggregate for which ST is the ancestor part
+ --      must have an ancestor which also constrained D1 to 3. F and I raise
+ --      Constraint_Error because NT2 and NT3, respectively, constrain D1 to
+ --      6. C raises Constraint_Error because NT1 constrains D1 to the value
+ --      of D2, which is set to 6 in the record component association list of
+ --      the aggregate.
+ --
+ --      This test verifies each of the three scenarios above:
+ --
+ --         (1) Ancestor of type of aggregate constrains discriminant with
+ --             new discriminant.
+ --         (2) Ancestor of type of aggregate constrains discriminant with
+ --             value, and has a new discriminant part.
+ --         (3) Ancestor of type of aggregate constrains discriminant with
+ --             value, and has no discriminant part.
+ --
+ --      Verification is made for cases where the type of the aggregate is
+ --      once- and twice-removed from the type of the ancestor part.
+ --      
+ --      Additionally, a case is included where a new discriminant corresponds
+ --      to multiple discriminants of the type of the ancestor part.
+ --
+ --      To test the portion of the objective concerning "initialization by 
+ --      default," the test verifies that, after a successful aggregate
+ --      assignment, components not assigned an explicit value by the aggregate
+ --      contain the default values for the corresponding components of the
+ --      ancestor type.
+ --    
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Dec 94   SAIC    Removed discriminant defaults from tagged types.
+ --      17 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected subtype constraint
+ --                          for component NT_C3.Str2. Added missing component
+ --                          checks. Removed record component update from
+ --                          Avoid_Optimization. Fixed incorrect component
+ --                          checks.
+ --      02 Dec 95   SAIC    ACVC 2.0.1 fixes: Corrected Failed comment for
+ --                          Q case.
+ --
+ --!
+ 
+ package C432003_0 is
+ 
+    Default_String : constant String := "This is a default string"; -- len = 24
+    Another_String : constant String := "Another default string";   -- len = 22
+ 
+    subtype Length is Natural range 0..255;
+ 
+    type ROOT (D1 : Length) is tagged 
+       record
+          S1  : String (1..D1) := Default_String(1..D1);
+          Acc : Natural := 356;
+       end record;
+ 
+    procedure Avoid_Optimization (Rec : in out ROOT); -- Inherited by all type
+                                                      -- extensions.
+ 
+    type Unconstrained_Der is new ROOT with 
+       record
+          Str1 : String(1..5) := "abcde";
+       end record;
+ 
+    subtype Constrained_Subtype is Unconstrained_Der (D1 => 10);
+ 
+    type NT_A1 (D2 : Length) is new Unconstrained_Der (D1 => D2) with 
+       record
+          S2 : String(1..D2);         -- Inherited discrim. constrained by
+       end record;                    -- new discriminant.
+ 
+    type NT_A2 (D3 : Length) is new NT_A1 (D2 => D3) with 
+       record
+          S3 : String(1..D3);         -- Inherited discrim. constrained by
+       end record;                    -- new discriminant.
+ 
+ 
+    type NT_B1 (D2 : Length) is new Unconstrained_Der (D1 => 5) with 
+       record
+          S2 : String(1..D2);         -- Inherited discrim. constrained by
+       end record;                    -- explicit value.
+ 
+    type NT_B2 (D3 : Length) is new NT_B1 (D2 => 10) with 
+       record
+          S3 : String(1..D3);         -- Inherited discrim. constrained by
+       end record;                    -- explicit value.
+ 
+    type NT_B3 (D2 : Length) is new Unconstrained_Der (D1 => 10) with
+       record
+          S2 : String(1..D2);
+       end record;
+ 
+ 
+    type NT_C1 is new Unconstrained_Der (D1 => 5) with 
+       record
+          Str2 : String(1..5);         -- Inherited discrim. constrained
+       end record;                     -- No new value.
+ 
+    type NT_C2 (D2 : Length) is new NT_C1 with 
+       record
+          S2 : String(1..D2);          -- Inherited discrim. not further
+       end record;                     -- constrained, new discriminant.
+ 
+    type NT_C3 is new Unconstrained_Der(D1 => 10) with
+       record
+          Str2 : String(1..5);
+       end record;
+ 
+ 
+    type MULTI_ROOT (D1 : Length; D2 : Length) is tagged
+       record
+          S1 : String (1..D1) := Default_String(1..D1);
+          S2 : String (1..D2) := Another_String(1..D2);
+       end record;
+ 
+    procedure Avoid_Optimization (Rec : in out MULTI_ROOT); -- Inherited by all
+                                                            -- type extensions.
+                                                            
+    type Mult_Unconstr_Der is new MULTI_ROOT with
+       record
+          Str1 : String(1..8) := "AbCdEfGh";  -- Derived, no constraints.
+       end record;
+ 
+    -- Subtypes with constrained discriminants.
+    subtype Mult_Constr_Sub1 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have
+                                                  D2 => 20); -- diff values
+ 
+    subtype Mult_Constr_Sub2 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have
+                                                  D2 => 15); -- same value
+ 
+    type Mult_NT_A1 (D3 : Length) is 
+      new Mult_Unconstr_Der (D1 => D3, D2 => D3) with
+       record
+          S3 : String(1..D3);      -- Both inherited discriminants constrained
+       end record;                 -- by new discriminant.
+ 
+ end C432003_0;
+ 
+ 
+    --=====================================================================--
+ 
+ 
+ with Report;
+ package body C432003_0 is
+ 
+    procedure Avoid_Optimization (Rec : in out ROOT) is
+    begin
+       Rec.S1 := Report.Ident_Str(Rec.S1);
+    end Avoid_Optimization;
+ 
+    procedure Avoid_Optimization (Rec : in out MULTI_ROOT) is
+    begin
+       Rec.S1 := Report.Ident_Str(Rec.S1);
+    end Avoid_Optimization;
+ 
+ end C432003_0;
+ 
+ 
+    --=====================================================================--
+ 
+ 
+ with C432003_0;
+ with Report;
+ procedure C432003 is
+ begin
+ 
+    Report.Test("C432003", "Extension aggregates where ancestor part "      &
+                           "is a subtype mark that denotes a constrained "  &
+                           "subtype causing Constraint_Error if any "       &
+                           "discriminant of the ancestor has a different "  &
+                           "value than that specified for a corresponding " &
+                           "discriminant in the derived type definition "   &
+                           "for some ancestor of the type of the aggregate");
+ 
+    Test_Block:
+       declare
+ 
+          -- Variety of string object declarations.
+          String2  : String(1..2)  := Report.Ident_Str("12");
+          String5  : String(1..5)  := Report.Ident_Str("12345");
+          String8  : String(1..8)  := Report.Ident_Str("AbCdEfGh");
+          String10 : String(1..10) := Report.Ident_Str("1234567890");
+          String15 : String(1..15) := Report.Ident_Str("123456789012345");
+          String20 : String(1..20) := Report.Ident_Str("12345678901234567890");
+ 
+       begin
+ 
+ 
+          begin
+             declare
+                A : C432003_0.NT_A1 :=                                  -- OK
+                      (C432003_0.ROOT with D2   => 5,
+                                           Str1 => "cdefg",
+                                           S2   => String5);
+             begin
+                C432003_0.Avoid_Optimization(A);
+                if A.Acc  /= 356       or
+                   A.Str1 /= "cdefg"   or
+                   A.S2   /= String5   or 
+                   A.D2   /= 5         or
+                   A.S1   /= C432003_0.Default_String(1..5)
+                then
+                   Report.Failed("Incorrect object values for Object A");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object A");
+          end;
+ 
+ 
+          begin
+             declare
+                C: C432003_0.NT_A1 :=                                   -- OK
+                     (C432003_0.Constrained_Subtype with D2 => 10,
+                                                         S2 => String10);
+             begin
+                C432003_0.Avoid_Optimization(C);
+                if C.D2   /= 10        or  C.Acc /= 356      or
+                   C.Str1 /= "abcde"   or  C.S2  /= String10 or
+                   C.S1   /= C432003_0.Default_String(1..10)
+                then
+                   Report.Failed("Incorrect object values for Object C");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object C");
+          end;
+ 
+ 
+          begin
+             declare 
+                D: C432003_0.NT_A1 :=                                  -- C_E
+                     (C432003_0.Constrained_Subtype with 
+                        D2 => Report.Ident_Int(5),
+                        S2 => String5);
+             begin
+                C432003_0.Avoid_Optimization(D);
+                Report.Failed("Constraint_Error not raised for Object D");
+             end;
+          exception
+             when Constraint_Error =>
+                null;  -- Raise of Constraint_Error is expected.
+          end;
+ 
+ 
+          begin
+             declare
+                E: C432003_0.NT_A2 :=                                   -- OK
+                     (C432003_0.Constrained_Subtype with D3 => 10,
+                                                         S2 => String10,
+                                                         S3 => String10);
+             begin
+                C432003_0.Avoid_Optimization(E);
+                if E.D3   /= 10        or  E.Acc /= 356        or
+                   E.Str1 /= "abcde"   or  E.S2  /= String10   or
+                   E.S3   /= String10  or
+                   E.S1   /= C432003_0.Default_String(1..10)
+                then
+                   Report.Failed("Incorrect object values for Object E");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object E");
+          end;
+ 
+ 
+          begin
+             declare
+                F: C432003_0.NT_A2 :=                                  -- C_E
+                     (C432003_0.Constrained_Subtype with 
+                        D3 => Report.Ident_Int(5),  
+                        S2 => String5,
+                        S3 => String5);
+             begin
+                C432003_0.Avoid_Optimization(F);
+                Report.Failed("Constraint_Error not raised for Object F");
+             end;
+          exception
+             when Constraint_Error =>
+                null;  -- Raise of Constraint_Error is expected.
+          end;
+ 
+ 
+          begin
+             declare
+                G: C432003_0.NT_B2 :=                                  -- OK
+                     (C432003_0.ROOT with D3   => 5,     
+                                          Str1 => "cdefg",
+                                          S2   => String10,
+                                          S3   => String5);
+             begin
+                C432003_0.Avoid_Optimization(G);
+                if G.D3   /= 5         or  G.Acc /= 356       or
+                   G.Str1 /= "cdefg"   or  G.S2  /= String10  or
+                   G.S3   /= String5   or
+                   G.S1   /= C432003_0.Default_String(1..5)
+                then
+                   Report.Failed("Incorrect object values for Object G");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object G");
+          end;
+ 
+ 
+          begin
+             declare
+                H: C432003_0.NT_B3 :=                                    -- OK
+                     (C432003_0.Unconstrained_Der with D2 => 5,
+                                                       S2 => String5);
+             begin
+                C432003_0.Avoid_Optimization(H);
+                if H.D2   /= 5          or  H.Acc /= 356      or
+                   H.Str1 /= "abcde"    or  H.S2  /= String5  or
+                   H.S1   /= C432003_0.Default_String(1..10)
+                then
+                   Report.Failed("Incorrect object values for Object H");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object H");
+          end;
+ 
+ 
+          begin
+             declare
+                I: C432003_0.NT_B1 :=                                  -- C_E
+                     (C432003_0.Constrained_Subtype with 
+                         D2 => Report.Ident_Int(10),
+                         S2 => String10);
+             begin
+                C432003_0.Avoid_Optimization(I);
+                Report.Failed("Constraint_Error not raised for Object I");
+             end;
+          exception
+             when Constraint_Error =>
+                null;  -- Raise of Constraint_Error is expected.
+          end;
+ 
+ 
+          begin
+             declare
+                J: C432003_0.NT_B2 :=                                  -- C_E
+                     (C432003_0.Constrained_Subtype with 
+                        D3 => Report.Ident_Int(10),
+                        S2 => String10,
+                        S3 => String10);
+             begin
+                C432003_0.Avoid_Optimization(J);
+                Report.Failed("Constraint_Error not raised by Object J");
+             end;
+          exception
+             when Constraint_Error =>
+                null;  -- Raise of Constraint_Error is expected.
+          end;
+ 
+ 
+          begin
+             declare
+                K: C432003_0.NT_B3 :=                                   -- OK
+                     (C432003_0.Constrained_Subtype with D2 => 5,
+                                                         S2 => String5);
+             begin
+                C432003_0.Avoid_Optimization(K);
+                if K.D2   /= 5          or  K.Acc /= 356       or
+                   K.Str1 /= "abcde"    or  K.S2  /= String5   or
+                   K.S1   /= C432003_0.Default_String(1..10)
+                then
+                   Report.Failed("Incorrect object values for Object K");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object K");
+          end;
+ 
+ 
+          begin
+             declare
+                M: C432003_0.NT_C2 :=                                   -- OK
+                     (C432003_0.ROOT with D2   => 10,
+                                          Str1 => "cdefg",
+                                          Str2 => String5,
+                                          S2   => String10);
+             begin
+                C432003_0.Avoid_Optimization(M);
+                if M.D2   /= 10         or  M.Acc /= 356       or
+                   M.Str1 /= "cdefg"    or  M.S2  /= String10  or
+                   M.Str2 /= String5    or
+                   M.S1   /= C432003_0.Default_String(1..5)
+                then
+                   Report.Failed("Incorrect object values for Object M");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object M");
+          end;
+ 
+ 
+          begin
+             declare
+                O: C432003_0.NT_C1 :=                                  -- C_E
+                     (C432003_0.Constrained_Subtype with 
+                        Str2 => Report.Ident_Str(String5));
+             begin
+                C432003_0.Avoid_Optimization(O);
+                Report.Failed("Constraint_Error not raised for Object O");
+             end;
+          exception
+             when Constraint_Error =>
+                null;  -- Raise of Constraint_Error is expected.
+          end;
+ 
+ 
+          begin
+             declare
+                P: C432003_0.NT_C2 :=                                  -- C_E
+                     (C432003_0.Constrained_Subtype with 
+                        D2   => Report.Ident_Int(10),
+                        Str2 => String5,
+                        S2   => String10);
+             begin
+                C432003_0.Avoid_Optimization(P);
+                Report.Failed("Constraint_Error not raised by Object P");
+             end;
+          exception
+             when Constraint_Error =>
+                null;  -- Raise of Constraint_Error is expected.
+          end;
+ 
+ 
+          begin
+             declare
+                Q: C432003_0.NT_C3 := 
+                   (C432003_0.Constrained_Subtype with Str2 => String5);  -- OK
+             begin
+                C432003_0.Avoid_Optimization(Q);
+                if Q.Str2 /= String5  or  
+                   Q.Acc  /= 356      or  
+                   Q.Str1 /= "abcde"  or
+                   Q.D1   /= 10       or
+                   Q.S1   /= C432003_0.Default_String(1..10)
+                then
+                   Report.Failed("Incorrect object values for Object Q");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object Q");
+          end;
+ 
+ 
+          -- The following cases test where a new discriminant corresponds
+          -- to multiple discriminants of the type of the ancestor part.
+ 
+          begin
+             declare
+                S: C432003_0.Mult_NT_A1 :=                              -- OK
+                     (C432003_0.Mult_Unconstr_Der with D3 => 15,
+                                                       S3 => String15);
+             begin
+                C432003_0.Avoid_Optimization(S);
+                if S.S1   /= C432003_0.Default_String(1..15)  or  
+                   S.Str1 /= String8                          or
+                   S.S2   /= C432003_0.Another_String(1..15)  or  
+                   S.S3   /= String15                         or
+                   S.D3   /= 15
+                then
+                   Report.Failed("Incorrect object values for Object S");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object S");
+          end;
+ 
+ 
+          begin
+             declare
+                U: C432003_0.Mult_NT_A1 :=                             -- C_E
+                     (C432003_0.Mult_Constr_Sub1 with 
+                        D3 => Report.Ident_Int(15),
+                        S3 => String15);
+             begin
+                C432003_0.Avoid_Optimization(U);
+                Report.Failed("Constraint_Error not raised for Object U");
+             end;
+          exception
+             when Constraint_Error =>
+                null;  -- Raise of Constraint_Error is expected.
+          end;
+ 
+ 
+          begin
+             declare
+                V: C432003_0.Mult_NT_A1 :=                              -- OK
+                     (C432003_0.Mult_Constr_Sub2 with D3 => 15,
+                                                      S3 => String15);
+             begin
+                C432003_0.Avoid_Optimization(V);
+                if V.D3   /= 15        or  
+                   V.Str1 /= String8   or
+                   V.S3   /= String15  or
+                   V.S1   /= C432003_0.Default_String(1..15) or
+                   V.S2   /= C432003_0.Another_String(1..15)
+                then
+                   Report.Failed("Incorrect object values for Object V");
+                end if;
+             end;
+          exception
+             when Constraint_Error =>
+                Report.Failed("Constraint_Error raised for Object V");
+          end;
+ 
+ 
+       exception
+          when others => Report.Failed("Exception raised in Test_Block");
+       end Test_Block;
+ 
+       Report.Result;
+ 
+ end C432003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c432004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c432004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,319 ----
+ -- C432004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the type of an extension aggregate may be derived from the
+ --      type of the ancestor part through multiple record extensions. Check
+ --      for ancestor parts that are subtype marks. Check that the type of the
+ --      ancestor part may be abstract.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines the following type hierarchies:
+ --
+ --                (A)                           (F)
+ --              Abstract                      Abstract
+ --           Tagged record                 Tagged private
+ --            /         \                   /          \
+ --           /          (C)               (G)           \
+ --         (B)        Abstract         Abstract         (H)
+ --       Record       private          record         Private
+ --      extension     extension        extension     extension
+ --          |             |                |             |
+ --         (D)           (E)              (I)           (J)
+ --       Record        Record           Record        Record
+ --      extension     extension        extension     extension
+ --
+ --      Extension aggregates for B, D, E, I, and J are constructed using each
+ --      of its ancestor types as the ancestor part (except for E and J, for
+ --      which only the immediate ancestor is used, since using A and F,
+ --      respectively, as the ancestor part would be illegal).
+ --
+ --      X1 : B := (A with ...);
+ --      X2 : D := (A with ...);         X5 : I := (F with ...);
+ --      X3 : D := (B with ...);         X6 : I := (G with ...);
+ --      X4 : E := (C with ...);         X7 : J := (H with ...);
+ --
+ --      For each assignment of an aggregate, the value of the target object is
+ --      checked to ensure that the proper values for each component were
+ --      assigned.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C432004_0 is
+ 
+    type Drawers is record
+       Building : natural;
+    end record;
+ 
+    type Location is access Drawers;
+ 
+    type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);
+ 
+    type SampleType_A is abstract tagged record
+       Era : Eras := Cenozoic;
+       Loc : Location;
+    end record;
+ 
+    type SampleType_F is abstract tagged private;
+ 
+    -- The following function is needed to verify the values of the
+    -- private components.
+    function TC_Correct_Result (Rec : SampleType_F'Class;
+                                E   : Eras) return Boolean;
+ 
+ private
+    type SampleType_F is abstract tagged record
+       Era : Eras := Mesozoic;
+    end record;
+ 
+ end C432004_0;
+ 
+      --==================================================================--
+ 
+ package body C432004_0 is
+ 
+    function TC_Correct_Result (Rec : SampleType_F'Class;
+                                E   : Eras) return Boolean is
+    begin
+       return (Rec.Era = E);
+    end TC_Correct_Result;
+ 
+ end C432004_0;
+ 
+      --==================================================================--
+ 
+ with C432004_0;
+ package C432004_1 is
+ 
+    type Periods is
+       (Aphebian, Helikian, Hadrynian,
+        Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,
+        Triassic, Jurassic, Cretaceous,
+        Tertiary, Quaternary);
+ 
+    type SampleType_B is new C432004_0.SampleType_A with record
+       Period : Periods := Quaternary;
+    end record;
+ 
+    type SampleType_C is abstract new C432004_0.SampleType_A with private;
+ 
+    -- The following function is needed to verify the values of the
+    -- extension's private components.
+    function TC_Correct_Result (Rec : SampleType_C'Class;
+                                P   : Periods) return Boolean;
+ 
+    type SampleType_G is abstract new C432004_0.SampleType_F with record
+       Period : Periods := Jurassic;
+       Loc    : C432004_0.Location;
+    end record;
+ 
+    type SampleType_H is new C432004_0.SampleType_F with private;
+ 
+    -- The following function is needed to verify the values of the
+    -- extension's private components.
+    function TC_Correct_Result (Rec : SampleType_H'Class;
+                                P   : Periods;
+                                E   : C432004_0.Eras) return Boolean;
+ 
+ private
+    type SampleType_C is abstract new C432004_0.SampleType_A with record
+       Period : Periods := Quaternary;
+    end record;
+ 
+    type SampleType_H is new C432004_0.SampleType_F with record
+       Period : Periods := Jurassic;
+    end record;
+ 
+ end C432004_1;
+ 
+      --==================================================================--
+ 
+ package body C432004_1 is
+ 
+    function TC_Correct_Result (Rec : SampleType_C'Class;
+                                P   : Periods) return Boolean is
+    begin
+       return (Rec.Period = P);
+    end TC_Correct_Result;
+ 
+    -------------------------------------------------------------
+    function TC_Correct_Result (Rec : SampleType_H'Class;
+                                P   : Periods;
+                                E   : C432004_0.Eras) return Boolean is
+    begin
+       return (Rec.Period = P) and C432004_0.TC_Correct_Result (Rec, E);
+    end TC_Correct_Result;
+ 
+ end C432004_1;
+ 
+      --==================================================================--
+ 
+ with C432004_0;
+ with C432004_1;
+ package C432004_2 is
+ 
+    -- All types herein are record extensions, since aggregates
+    -- cannot be given for private extensions
+    
+    type SampleType_D is new C432004_1.SampleType_B with record
+       Sample_On_Loan : Boolean := False;
+    end record;
+ 
+    type SampleType_E is new C432004_1.SampleType_C 
+      with null record;
+ 
+    type SampleType_I is new C432004_1.SampleType_G with record
+       Sample_On_Loan : Boolean := True;
+    end record;
+ 
+    type SampleType_J is new C432004_1.SampleType_H with record
+       Sample_On_Loan : Boolean := True;
+    end record;
+ 
+ end C432004_2;
+ 
+ 
+      --==================================================================--
+ 
+ with Report;
+ with C432004_0;
+ with C432004_1;
+ with C432004_2;
+ use  C432004_1;
+ use  C432004_2;
+ 
+ procedure C432004 is
+ 
+    -- Variety of extension aggregates.
+ 
+    -- Default values for the components of SampleType_A 
+    -- (Era => Cenozoic, Loc => null).
+    Sample_B  :  SampleType_B 
+              := (C432004_0.SampleType_A with Period => Devonian);
+ 
+    -- Default values from SampleType_A (Era => Cenozoic, Loc => null).
+    Sample_D1 :  SampleType_D
+              := (C432004_0.SampleType_A with Period => Cambrian,
+                                      Sample_On_Loan => True);
+ 
+    -- Default values from SampleType_A and SampleType_B
+    -- (Era => Cenozoic, Loc => null, Period => Quaternary).
+    Sample_D2 :  SampleType_D
+              := (SampleType_B with Sample_On_Loan => True);
+ 
+    -- Default values from SampleType_A and SampleType_C
+    -- (Era => Cenozoic, Loc => null, Period => Quaternary).
+    Sample_E  :  SampleType_E
+              := (SampleType_C with null record);
+ 
+    -- Default value from SampleType_F (Era => Mesozoic).
+    Sample_I1 :  SampleType_I
+              := (C432004_0.SampleType_F with Period => Tertiary,
+                  Loc => new C432004_0.Drawers'(Building => 9),
+                  Sample_On_Loan => False);
+ 
+    -- Default values from SampleType_F and SampleType_G
+    -- (Era => Mesozoic, Period => Jurassic, Loc => null).
+    Sample_I2 :  SampleType_I
+              := (SampleType_G with Sample_On_Loan => False);
+ 
+    -- Default values from SampleType_H (Era => Mesozoic, Period => Jurassic).
+    Sample_J  :  SampleType_J
+              := (SampleType_H with Sample_On_Loan => False);
+ 
+    use type C432004_0.Eras;
+    use type C432004_0.Location;
+ 
+ begin
+ 
+    Report.Test ("C432004", "Check that the type of an extension aggregate "  &
+                 "may be derived from the type of the ancestor part through " &
+                 "multiple record extensions");
+ 
+    if Sample_B /= (C432004_0.Cenozoic, null, Devonian) then
+       Report.Failed ("Object of record extension of abstract ancestor, " &
+                      "SampleType_B, failed content check");
+    end if;
+ 
+    -------------------
+    if Sample_D1 /= (Era => C432004_0.Cenozoic, Loc => null, 
+                     Period => Cambrian, Sample_On_Loan => True) then
+       Report.Failed ("Object 1 of record extension of record extension, "  & 
+                      "of abstract ancestor, SampleType_D, failed content " &
+                      "check");
+    end if;
+ 
+    -------------------
+    if Sample_D2 /= (C432004_0.Cenozoic, null, Quaternary, True) then
+       Report.Failed ("Object 2 of record extension of record extension, "  & 
+                      "of abstract ancestor, SampleType_D, failed content " &
+                      "check");
+    end if;
+    -------------------
+    if Sample_E.Era /= C432004_0.Cenozoic or 
+       Sample_E.Loc /= null               or
+       not TC_Correct_Result (Sample_E, Quaternary) then
+          Report.Failed ("Object of record extension of abstract private " & 
+                         "extension of abstract ancestor, SampleType_E, "  &
+                         "failed content check");
+    end if;
+ 
+    -------------------
+    if not C432004_0.TC_Correct_Result (Sample_I1, C432004_0.Mesozoic) or
+      Sample_I1.Period         /= Tertiary                             or
+      Sample_I1.Loc.Building   /= 9                                    or
+      Sample_I1.Sample_On_Loan /= False                                then
+        Report.Failed ("Object 1 of record extension of abstract record " &
+                       "extension of abstract private ancestor, "         &
+                       "SampleType_I, failed content check");
+    end if;
+ 
+    -------------------
+    if not C432004_0.TC_Correct_Result (Sample_I2, C432004_0.Mesozoic) or  
+      Sample_I2.Period         /= Jurassic                             or
+      Sample_I2.Loc            /= null                                 or
+      Sample_I2.Sample_On_Loan /= False                                then
+        Report.Failed ("Object 2 of record extension of abstract record " &
+                       "extension of abstract private ancestor, "         &
+                       "SampleType_I, failed content check");
+    end if;
+ 
+    -------------------
+    if not TC_Correct_Result (Sample_J,
+                              Jurassic,
+                              C432004_0.Mesozoic) or
+      Sample_J.Sample_On_Loan /= False            then
+         Report.Failed ("Object of record extension of private extension " &
+                        "of abstract private ancestor, SampleType_J, "     &
+                        "failed content check");
+    end if;
+ 
+    Report.Result;
+ 
+ end C432004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C43204A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
+ --     (AND BOUNDS ARE DETERMINED CORRECTLY) AS AN ACTUAL PARAMETER OF
+ --     A SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS CONSTRAINED.
+ 
+ -- HISTORY:
+ --     JET 08/04/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43204A IS
+ 
+      TYPE ARR10 IS ARRAY(IDENT_INT(1)..IDENT_INT(0)) OF INTEGER;
+      TYPE ARR11 IS ARRAY(INTEGER RANGE -3..3) OF INTEGER;
+      TYPE ARR12 IS ARRAY(IDENT_INT(-3)..IDENT_INT(3)) OF INTEGER;
+ 
+      TYPE ARR20 IS ARRAY(IDENT_INT(1)..IDENT_INT(0),
+                          IDENT_INT(0)..IDENT_INT(-1)) OF INTEGER;
+      TYPE ARR21 IS ARRAY(INTEGER RANGE -1..1,
+                          INTEGER RANGE -1..1) OF INTEGER;
+      TYPE ARR22 IS ARRAY(IDENT_INT(-1)..IDENT_INT(1),
+                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+      TYPE ARR23 IS ARRAY(INTEGER'(-1)..1,
+                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+ 
+      PROCEDURE PROC10 (A : ARR10) IS
+      BEGIN
+           IF A'LENGTH /= IDENT_INT(0) THEN
+                FAILED ("PROC10 ARRAY IS NOT NULL");
+           END IF;
+      END PROC10;
+ 
+      PROCEDURE PROC11 (A : ARR11; C : INTEGER) IS
+      BEGIN
+           IF A'LENGTH /= IDENT_INT(7) OR
+              A'FIRST /= IDENT_INT(-3) OR
+              A'LAST /= IDENT_INT(3)   THEN
+                FAILED ("INCORRECT LENGTH IN PROC11 CALL NUMBER" &
+                        INTEGER'IMAGE(C));
+           END IF;
+ 
+           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+                IF IDENT_INT(A(I)) /= C THEN
+                     FAILED ("INCORRECT VALUE OF COMPONENT " &
+                             INTEGER'IMAGE(I) & ", PROC11 CALL NUMBER" &
+                             INTEGER'IMAGE(C));
+                END IF;
+           END LOOP;
+      END PROC11;
+ 
+      PROCEDURE PROC12 (A : ARR12) IS
+      BEGIN
+           IF A'LENGTH /= IDENT_INT(7) THEN
+                FAILED ("INCORRECT LENGTH IN PROC12");
+           END IF;
+ 
+           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+                IF IDENT_INT(A(I)) /= 3 THEN
+                     FAILED ("INCORRECT VALUE OF COMPONENT " &
+                             INTEGER'IMAGE(I) & ", PROC12");
+                END IF;
+           END LOOP;
+      END PROC12;
+ 
+      PROCEDURE PROC20 (A : ARR20) IS
+      BEGIN
+           IF A'LENGTH(1) /= IDENT_INT(0) OR
+              A'LENGTH(2) /= IDENT_INT(0) THEN
+                FAILED ("PROC20 ARRAY IS NOT NULL");
+           END IF;
+      END PROC20;
+ 
+      PROCEDURE PROC21 (A : ARR21; C : INTEGER) IS
+      BEGIN
+           FOR I IN INTEGER'(-1)..1 LOOP
+                FOR J IN INTEGER'(-1)..1 LOOP
+                     IF IDENT_INT(A(I,J)) /= C THEN
+                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                  INTEGER'IMAGE(I) & "," &
+                                  INTEGER'IMAGE(J) & "), PROC21 CALL " &
+                                  "NUMBER" & INTEGER'IMAGE(C));
+                     END IF;
+                END LOOP;
+           END LOOP;
+      END PROC21;
+ 
+      PROCEDURE PROC22 (A : ARR22) IS
+      BEGIN
+           FOR I IN INTEGER'(-1)..1 LOOP
+                FOR J IN INTEGER'(-1)..1 LOOP
+                     IF IDENT_INT(A(I,J)) /= 5 THEN
+                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                  INTEGER'IMAGE(I) & "," &
+                                  INTEGER'IMAGE(J) & "), PROC22");
+                     END IF;
+                END LOOP;
+           END LOOP;
+      END PROC22;
+ 
+      PROCEDURE PROC23 (A : ARR23) IS
+      BEGIN
+           FOR I IN INTEGER'(-1)..1 LOOP
+                FOR J IN INTEGER'(-1)..1 LOOP
+                     IF IDENT_INT(A(I,J)) /= 7 THEN
+                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                  INTEGER'IMAGE(I) & "," &
+                                  INTEGER'IMAGE(J) & "), PROC23");
+                     END IF;
+                END LOOP;
+           END LOOP;
+      END PROC23;
+ 
+ BEGIN
+      TEST ("C43204A", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
+                       "CHOICE CAN APPEAR (AND BOUNDS ARE DETERMINED " &
+                       "CORRECTLY) AS AN ACTUAL PARAMETER OF A " &
+                       "SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS " &
+                       "CONSTRAINED");
+ 
+      PROC11 ((1,1,1, OTHERS => 1), 1);
+      PROC11 ((2 => 2, 3 => 2, OTHERS => 2), 2);
+      PROC12 ((OTHERS => 3));
+      PROC10 ((OTHERS => 4));
+ 
+      PROC21 (((1,1,1), OTHERS => (1,1,1)), 1);
+      PROC21 ((1 => (2,2,2), OTHERS => (2,2,2)), 2);
+      PROC21 (((3,OTHERS => 3), (3,OTHERS => 3), (3,3,OTHERS => 3)), 3);
+      PROC21 (((-1 => 4, OTHERS => 4), (0 => 4, OTHERS => 4),
+               (1 => 4, OTHERS => 4)), 4);
+      PROC22 ((OTHERS => (OTHERS => 5)));
+      PROC20 ((OTHERS => (OTHERS => 6)));
+      PROC23 ((OTHERS => (7,7,7)));
+ 
+      RESULT;
+ END C43204A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,192 ----
+ -- C43204C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
+ --     (AND BOUNDS ARE DETERMINED CORRECTLY) AS AN ACTUAL PARAMETER OF
+ --     A GENERIC INSTANTIATION WHEN THE GENERIC FORMAL PARAMETER IS
+ --     CONSTRAINED.
+ 
+ -- HISTORY:
+ --     JET 08/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43204C IS
+ 
+      TYPE ARR10 IS ARRAY(IDENT_INT(1)..IDENT_INT(0)) OF INTEGER;
+      TYPE ARR11 IS ARRAY(INTEGER RANGE -3..3) OF INTEGER;
+      TYPE ARR12 IS ARRAY(IDENT_INT(-3)..IDENT_INT(3)) OF INTEGER;
+ 
+      TYPE ARR20 IS ARRAY(IDENT_INT(1)..IDENT_INT(0),
+                          IDENT_INT(0)..IDENT_INT(-1)) OF INTEGER;
+      TYPE ARR21 IS ARRAY(INTEGER RANGE -1..1,
+                          INTEGER RANGE -1..1) OF INTEGER;
+      TYPE ARR22 IS ARRAY(IDENT_INT(-1)..IDENT_INT(1),
+                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+      TYPE ARR23 IS ARRAY(INTEGER'(-1)..1,
+                          IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+ 
+      GENERIC
+           A : ARR10;
+      PROCEDURE GPROC10;
+ 
+      GENERIC
+           A : ARR11;
+      PROCEDURE GPROC11;
+ 
+      GENERIC
+           A : ARR12;
+      PROCEDURE GPROC12;
+ 
+      GENERIC
+           A : ARR20;
+      PROCEDURE GPROC20;
+ 
+      GENERIC
+           A : ARR21;
+      PROCEDURE GPROC21 (C : INTEGER);
+ 
+      GENERIC
+           A : ARR22;
+      PROCEDURE GPROC22;
+ 
+      GENERIC
+           A : ARR23;
+      PROCEDURE GPROC23;
+ 
+      PROCEDURE GPROC10 IS
+      BEGIN
+           IF A'LENGTH /= IDENT_INT(0) THEN
+                FAILED ("PROC10 ARRAY IS NOT NULL");
+           END IF;
+      END GPROC10;
+ 
+      PROCEDURE GPROC11 IS
+      BEGIN
+           IF A'LENGTH /= IDENT_INT(7) OR
+              A'FIRST /= IDENT_INT(-3) OR
+              A'LAST /= IDENT_INT(3)   THEN
+                FAILED ("INCORRECT LENGTH IN PROC11");
+           END IF;
+ 
+           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+                IF IDENT_INT(A(I)) /= 1 THEN
+                     FAILED ("INCORRECT VALUE OF COMPONENT " &
+                             INTEGER'IMAGE(I) & ", PROC11");
+                END IF;
+           END LOOP;
+      END GPROC11;
+ 
+      PROCEDURE GPROC12 IS
+      BEGIN
+           IF A'LENGTH /= IDENT_INT(7) THEN
+                FAILED ("INCORRECT LENGTH IN PROC12");
+           END IF;
+ 
+           FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+                IF IDENT_INT(A(I)) /= 2 THEN
+                     FAILED ("INCORRECT VALUE OF COMPONENT " &
+                             INTEGER'IMAGE(I) & ", PROC12");
+                END IF;
+           END LOOP;
+      END GPROC12;
+ 
+      PROCEDURE GPROC20 IS
+      BEGIN
+           IF A'LENGTH(1) /= IDENT_INT(0) OR
+              A'LENGTH(2) /= IDENT_INT(0) THEN
+                FAILED ("GPROC20 ARRAY IS NOT NULL");
+           END IF;
+      END GPROC20;
+ 
+      PROCEDURE GPROC21 (C : INTEGER) IS
+      BEGIN
+           FOR I IN INTEGER'(-1)..1 LOOP
+                FOR J IN INTEGER'(-1)..1 LOOP
+                     IF IDENT_INT(A(I,J)) /= C THEN
+                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                  INTEGER'IMAGE(I) & "," &
+                                  INTEGER'IMAGE(J) & "), GPROC21 CALL " &
+                                  "NUMBER" & INTEGER'IMAGE(C));
+                     END IF;
+                END LOOP;
+           END LOOP;
+      END GPROC21;
+ 
+      PROCEDURE GPROC22 IS
+      BEGIN
+           FOR I IN INTEGER'(-1)..1 LOOP
+                FOR J IN INTEGER'(-1)..1 LOOP
+                     IF IDENT_INT(A(I,J)) /= 3 THEN
+                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                  INTEGER'IMAGE(I) & "," &
+                                  INTEGER'IMAGE(J) & "), GPROC22");
+                     END IF;
+                END LOOP;
+           END LOOP;
+      END GPROC22;
+ 
+      PROCEDURE GPROC23 IS
+      BEGIN
+           FOR I IN INTEGER'(-1)..1 LOOP
+                FOR J IN INTEGER'(-1)..1 LOOP
+                     IF IDENT_INT(A(I,J)) /= 4 THEN
+                          FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                  INTEGER'IMAGE(I) & "," &
+                                  INTEGER'IMAGE(J) & "), GPROC23");
+                     END IF;
+                END LOOP;
+           END LOOP;
+      END GPROC23;
+ 
+      PROCEDURE PROC11 IS NEW GPROC11((1,1,1, OTHERS => 1));
+      PROCEDURE PROC12 IS NEW GPROC12((OTHERS => 2));
+      PROCEDURE PROC10 IS NEW GPROC10((OTHERS => 3));
+ 
+      PROCEDURE PROC21 IS NEW GPROC21(((1,1,1), OTHERS => (1,1,1)));
+      PROCEDURE PROC22 IS NEW GPROC21(((2,OTHERS => 2), (2,OTHERS => 2),
+                                       (2,2,OTHERS => 2)));
+      PROCEDURE PROC23 IS NEW GPROC22((OTHERS => (OTHERS => 3)));
+      PROCEDURE PROC24 IS NEW GPROC23((OTHERS => (4,4,4)));
+      PROCEDURE PROC20 IS NEW GPROC20((OTHERS => (OTHERS => 5)));
+ 
+ BEGIN
+      TEST ("C43204C", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
+                       "CHOICE CAN APPEAR (AND BOUNDS ARE DETERMINED " &
+                       "CORRECTLY) AS AN ACTUAL PARAMETER OF A " &
+                       "SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS " &
+                       "CONSTRAINED");
+ 
+      PROC11;
+      PROC12;
+      PROC10;
+ 
+      PROC21(1);
+      PROC22(2);
+      PROC23;
+      PROC24;
+      PROC20;
+ 
+      RESULT;
+ END C43204C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,179 ----
+ -- C43204E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
+ --     AS THE INITIALIZATION EXPRESSION OF A CONSTRAINED CONSTANT,
+ --     VARIABLE OBJECT DECLARATION, OR RECORD COMPONENT DECLARATION,
+ --     AND THAT THE BOUNDS OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+ 
+ -- HISTORY:
+ --     JET 08/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43204E IS
+ 
+      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           INTEGER RANGE -1 .. 1) OF INTEGER;
+      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+ 
+      CA11 : CONSTANT ARR11 := (1, OTHERS => IDENT_INT(2));
+      CA12 : CONSTANT ARR12 := (OTHERS => IDENT_INT(2));
+      CA13 : CONSTANT ARR13 := (OTHERS => IDENT_INT(2));
+      CA21 : CONSTANT ARR21 := (OTHERS => (-1..1 => IDENT_INT(2)));
+      CA22 : CONSTANT ARR22 := (OTHERS => (-1..1 => IDENT_INT(2)));
+      CA23 : CONSTANT ARR23 := (-1..1 => (OTHERS => IDENT_INT(2)));
+      CA24 : CONSTANT ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+ 
+      VA11 : ARR11 := (1,1, OTHERS => IDENT_INT(2));
+      VA12 : ARR12 := (OTHERS => IDENT_INT(2));
+      VA13 : ARR13 := (OTHERS => IDENT_INT(2));
+      VA21 : ARR21 := ((1,1,1), OTHERS => (-1..1 => IDENT_INT(2)));
+      VA22 : ARR22 := (-1 => (1,1,1), 0..1 => (OTHERS => IDENT_INT(2)));
+      VA23 : ARR23 := (OTHERS => (OTHERS => IDENT_INT(2)));
+      VA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+ 
+      TYPE REC IS RECORD
+           RA11 : ARR11 := (1,1,1, OTHERS => IDENT_INT(2));
+           RA12 : ARR12 := (OTHERS => IDENT_INT(2));
+           RA13 : ARR13 := (OTHERS => IDENT_INT(2));
+           RA21 : ARR21 := ((1,1,1), (1,1,1), OTHERS => (IDENT_INT(2),
+                            IDENT_INT(2), IDENT_INT(2)));
+           RA22 : ARR22 := (OTHERS => (OTHERS => IDENT_INT(2)));
+           RA23 : ARR23 := (-1 => (OTHERS => 1),
+                            0..1 => (OTHERS => IDENT_INT(2)));
+           RA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+      END RECORD;
+ 
+      R : REC;
+ 
+ BEGIN
+      TEST ("C43204E", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
+                       "CHOICE CAN APPEAR AS THE INITIALIZATION " &
+                       "EXPRESSION OF A CONSTRAINED CONSTANT, " &
+                       "VARIABLE OBJECT DECLARATION, OR RECORD " &
+                       "COMPONENT DECLARATION, AND THAT THE BOUNDS OF " &
+                       "THE AGGREGATE ARE DETERMINED CORRECTLY");
+ 
+      IF CA11 /= (1, 2, 2, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF CA11");
+      END IF;
+ 
+      IF CA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF CA12");
+      END IF;
+ 
+      IF CA13'LENGTH /= 0 THEN
+           FAILED("INCORRECT VALUE OF CA13");
+      END IF;
+ 
+      IF CA21 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF CA21");
+      END IF;
+ 
+      IF CA22 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF CA22");
+      END IF;
+ 
+      IF CA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF CA23");
+      END IF;
+ 
+      IF CA24'LENGTH /= 0 OR CA24'LENGTH(2) /= 3 THEN
+           FAILED("INCORRECT VALUE OF CA24");
+      END IF;
+ 
+      IF VA11 /= (1, 1, 2, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF VA11");
+      END IF;
+ 
+      IF VA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF VA12");
+      END IF;
+ 
+      IF VA13'LENGTH /= 0 THEN
+           FAILED("INCORRECT VALUE OF VA13");
+      END IF;
+ 
+      IF VA21 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF VA21");
+      END IF;
+ 
+      IF VA22 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF VA22");
+      END IF;
+ 
+      IF VA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF VA23");
+      END IF;
+ 
+      IF VA24'LENGTH /= 0 OR VA24'LENGTH(2) /= 3 THEN
+           FAILED("INCORRECT VALUE OF VA24");
+      END IF;
+ 
+      IF R.RA11 /= (1, 1, 1, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF RA11");
+      END IF;
+ 
+      IF R.RA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF RA12");
+      END IF;
+ 
+      IF R.RA13'LENGTH /= 0 THEN
+           FAILED("INCORRECT VALUE OF RA13");
+      END IF;
+ 
+      IF R.RA21 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF RA21");
+      END IF;
+ 
+      IF R.RA22 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF RA22");
+      END IF;
+ 
+      IF R.RA23 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF RA23");
+      END IF;
+ 
+      IF R.RA24'LENGTH /= 0 OR R.RA24'LENGTH(2) /= 3 THEN
+           FAILED("INCORRECT VALUE OF RA24");
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                   "RAISED");
+ 
+           RESULT;
+ END C43204E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- C43204F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
+ --     CONSTRAINED FORMAL PARAMETER OF A SUBPROGRAM AND THAT THE BOUNDS
+ --     OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+ 
+ -- HISTORY:
+ --     JET 08/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43204F IS
+ 
+      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           INTEGER RANGE -1 .. 1) OF INTEGER;
+      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+ 
+      PROCEDURE PROC (PA11 : ARR11 := (1,1,1,1,1,1,
+                                       OTHERS => IDENT_INT(2));
+                      PA12 : ARR12 := (OTHERS => IDENT_INT(2));
+                      PA13 : ARR13 := (OTHERS => IDENT_INT(2));
+                      PA21 : ARR21 := ((1,1,1), (1,1,1),
+                                       (1, OTHERS => IDENT_INT(2)));
+                      PA22 : ARR22 := ((1,1,1), (1,1,1),
+                                       (OTHERS => IDENT_INT(2)));
+                      PA23 : ARR23 := ((1,1,1), (1,1,1), (1,1,1),
+                                       OTHERS => (OTHERS =>
+                                       IDENT_INT(2)));
+                      PA24 : ARR24 := (OTHERS => (OTHERS =>
+                                       IDENT_INT(2)))) IS
+      BEGIN
+           IF PA11 /= (1, 1, 1, 1, 1, 1, 2) THEN
+                FAILED("INCORRECT VALUE OF PA11");
+           END IF;
+ 
+           IF PA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+                FAILED("INCORRECT VALUE OF PA12");
+           END IF;
+ 
+           IF PA13'LENGTH /= 0 THEN
+                FAILED("INCORRECT VALUE OF PA13");
+           END IF;
+ 
+           IF PA21 /= ((1,1,1), (1,1,1), (1,2,2)) THEN
+                FAILED("INCORRECT VALUE OF PA21");
+           END IF;
+ 
+           IF PA22 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+                FAILED("INCORRECT VALUE OF PA22");
+           END IF;
+ 
+           IF PA23 /= ((1,1,1), (1,1,1), (1,1,1)) THEN
+                FAILED("INCORRECT VALUE OF PA23");
+           END IF;
+ 
+           IF PA24'LENGTH /= 0 OR PA24'LENGTH(2) /= 3 THEN
+                FAILED("INCORRECT VALUE OF PA24");
+           END IF;
+      END PROC;
+ 
+ BEGIN
+      TEST ("C43204F", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                       "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
+                       "OF A SUBPROGRAM AND THAT THE BOUNDS OF THE " &
+                       "AGGREGATE ARE DETERMINED CORRECTLY");
+ 
+      PROC;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                   "RAISED");
+ 
+           RESULT;
+ END C43204F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C43204G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
+ --     CONSTRAINED FORMAL PARAMETER OF AN ENTRY, AND THAT THE BOUNDS
+ --     OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+ 
+ -- HISTORY:
+ --     JET 08/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43204G IS
+ 
+      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           INTEGER RANGE -1 .. 1) OF INTEGER;
+      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+ 
+      TASK T IS
+           ENTRY E (EA11 : ARR11 := (1,1,1,1, OTHERS => IDENT_INT(2));
+                    EA12 : ARR12 := (OTHERS => IDENT_INT(2));
+                    EA13 : ARR13 := (OTHERS => IDENT_INT(2));
+                    EA21 : ARR21 := ((1,1,1), (1,1,1), (1,1,1),
+                                     OTHERS => (-1..1 => IDENT_INT(2)));
+                    EA22 : ARR22 := ((OTHERS => IDENT_INT(2)), (1,1,1),
+                                     (1,1,1));
+                    EA23 : ARR23 := (-1..0 => (OTHERS => 1),
+                                     1 => (OTHERS => IDENT_INT(2)));
+                    EA24: ARR24 := (OTHERS => (OTHERS => IDENT_INT(2))));
+      END T;
+ 
+      TASK BODY T IS
+      BEGIN
+           ACCEPT E (EA11 : ARR11 := (1,1,1,1, OTHERS => IDENT_INT(2));
+                     EA12 : ARR12 := (OTHERS => IDENT_INT(2));
+                     EA13 : ARR13 := (OTHERS => IDENT_INT(2));
+                     EA21 : ARR21 := ((1,1,1), (1,1,1), (1,1,1),
+                                      OTHERS => (-1..1 => IDENT_INT(2)));
+                     EA22 : ARR22 := ((OTHERS => IDENT_INT(2)), (1,1,1),
+                                      (1,1,1));
+                     EA23 : ARR23 := (-1..0 => (OTHERS => 1),
+                                      1 => (OTHERS => IDENT_INT(2)));
+                     EA24 : ARR24 := (OTHERS => (OTHERS =>
+                                     IDENT_INT(2))))
+           DO
+                IF EA11 /= (1, 1, 1, 1, 2, 2, 2) THEN
+                     FAILED("INCORRECT VALUE OF EA11");
+                END IF;
+ 
+                IF EA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+                     FAILED("INCORRECT VALUE OF EA12");
+                END IF;
+ 
+                IF EA13'LENGTH /= 0 THEN
+                     FAILED("INCORRECT VALUE OF EA13");
+                END IF;
+ 
+                IF EA21 /= ((1,1,1), (1,1,1), (1,1,1)) THEN
+                     FAILED("INCORRECT VALUE OF EA21");
+                END IF;
+ 
+                IF EA22 /= ((2,2,2), (1,1,1), (1,1,1)) THEN
+                     FAILED("INCORRECT VALUE OF EA22");
+                END IF;
+ 
+                IF EA23 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+                     FAILED("INCORRECT VALUE OF EA23");
+                END IF;
+ 
+                IF EA24'LENGTH /= 0 OR EA24'LENGTH(2) /= 3 THEN
+                     FAILED("INCORRECT VALUE OF EA24");
+                END IF;
+           END E;
+      END T;
+ 
+ BEGIN
+      TEST ("C43204G", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                       "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
+                       "OF AN ENTRY, AND THAT THE BOUNDS OF THE " &
+                       "AGGREGATE ARE DETERMINED CORRECTLY");
+ 
+      T.E;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                   "RAISED");
+ 
+           IF T'CALLABLE THEN
+                T.E;
+           END IF;
+ 
+           RESULT;
+ END C43204G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- C43204H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
+ --     CONSTRAINED FORMAL PARAMETER OF A GENERIC UNIT, AND THAT THE
+ --     BOUNDS OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+ 
+ -- HISTORY:
+ --     JET 08/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43204H IS
+ 
+      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           INTEGER RANGE -1 .. 1) OF INTEGER;
+      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+ 
+      GENERIC
+           GA11 : ARR11 := (1,1,1,1,1, OTHERS => IDENT_INT(2));
+           GA12 : ARR12 := (OTHERS => IDENT_INT(2));
+           GA13 : ARR13 := (OTHERS => IDENT_INT(2));
+           GA21 : ARR21 := ((1,1,1), (1,1,1), (OTHERS => IDENT_INT(2)));
+           GA22 : ARR22 := ((1,1,1), (OTHERS => IDENT_INT(2)), (1,1,1));
+           GA23 : ARR23 := ((1,1,1), (OTHERS => IDENT_INT(2)), (1,1,1));
+           GA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+      PROCEDURE GEN;
+ 
+      PROCEDURE GEN IS
+      BEGIN
+           IF GA11 /= (1, 1, 1, 1, 1, 2, 2) THEN
+                FAILED("INCORRECT VALUE OF GA11");
+           END IF;
+ 
+           IF GA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+                FAILED("INCORRECT VALUE OF GA12");
+           END IF;
+ 
+           IF GA13'LENGTH /= 0 THEN
+                FAILED("INCORRECT VALUE OF GA13");
+           END IF;
+ 
+           IF GA21 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+                FAILED("INCORRECT VALUE OF GA21");
+           END IF;
+ 
+           IF GA22 /= ((1,1,1), (2,2,2), (1,1,1)) THEN
+                FAILED("INCORRECT VALUE OF GA22");
+           END IF;
+ 
+           IF GA23 /= ((1,1,1), (2,2,2), (1,1,1)) THEN
+                FAILED("INCORRECT VALUE OF GA23");
+           END IF;
+ 
+           IF GA24'LENGTH /= 0 OR GA24'LENGTH(2) /= 3 THEN
+                FAILED("INCORRECT VALUE OF GA24");
+           END IF;
+      END GEN;
+ 
+      PROCEDURE PROCG IS NEW GEN;
+ 
+ BEGIN
+      TEST ("C43204H", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                       "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
+                       "OF A GENERIC UNIT, AND THAT THE BOUNDS OF " &
+                       "THE AGGREGATE ARE DETERMINED CORRECTLY");
+ 
+      PROCG;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                   "RAISED");
+ 
+           RESULT;
+ END C43204H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43204i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43204i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- C43204I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS THE
+ --     EXPRESSION IN AN ASSIGNMENT STATEMENT, AND THAT THE BOUNDS OF
+ --     THE AGGREGATE ARE DETERMINED CORRECTLY.
+ 
+ -- HISTORY:
+ --     JET 08/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43204I IS
+ 
+      TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+      TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+      TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+      TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           INTEGER RANGE -1 .. 1) OF INTEGER;
+      TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+      TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                           IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+ 
+      VA11 : ARR11;
+      VA12 : ARR12;
+      VA13 : ARR13;
+      VA21 : ARR21;
+      VA22 : ARR22;
+      VA23 : ARR23;
+      VA24 : ARR24;
+ 
+ BEGIN
+      TEST ("C43204I", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                       "CAN APPEAR AS THE EXPRESSION IN AN ASSIGNMENT " &
+                       "STATEMENT, AND THAT THE BOUNDS OF THE " &
+                       "AGGREGATE ARE DETERMINED CORRECTLY");
+ 
+      VA11 := (1,1, OTHERS => IDENT_INT(2));
+      VA12 := (OTHERS => IDENT_INT(2));
+      VA13 := (OTHERS => IDENT_INT(2));
+      VA21 := ((1,1,1), OTHERS => (-1..1 => IDENT_INT(2)));
+      VA22 := (-1 => (1,1,1), 0..1 => (OTHERS => IDENT_INT(2)));
+      VA23 := (OTHERS => (OTHERS => IDENT_INT(2)));
+      VA24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+ 
+      IF VA11 /= (1, 1, 2, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF VA11");
+      END IF;
+ 
+      IF VA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+           FAILED("INCORRECT VALUE OF VA12");
+      END IF;
+ 
+      IF VA13'LENGTH /= 0 THEN
+           FAILED("INCORRECT VALUE OF VA13");
+      END IF;
+ 
+      IF VA21 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF VA21");
+      END IF;
+ 
+      IF VA22 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF VA22");
+      END IF;
+ 
+      IF VA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+           FAILED("INCORRECT VALUE OF VA23");
+      END IF;
+ 
+      IF VA24'LENGTH /= 0 OR VA24'LENGTH(2) /= 3 THEN
+           FAILED("INCORRECT VALUE OF VA24");
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                   "RAISED");
+ 
+           RESULT;
+ END C43204I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C43205A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+ 
+ --   A) AN ACTUAL PARAMETER IN A SUBPROGRAM OR ENTRY CALL, AND THE
+ --      FORMAL PARAMETER IS UNCONSTRAINED.
+ 
+ -- EG  01/26/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205A", "CASE A1 : SUBPROGRAM WITH UNCONSTRAINED " &
+                      "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+      CASE_A1 : DECLARE
+ 
+                     SUBTYPE STA IS INTEGER RANGE 11 .. 15;
+                     TYPE TA IS ARRAY (STA RANGE <>) OF INTEGER;
+ 
+                     PROCEDURE PROC1 (A : TA) IS
+                     BEGIN
+                          IF A'FIRST /= IDENT_INT(11) THEN
+                               FAILED ("CASE A1 : LOWER BOUND " &
+                                       "INCORRECTLY GIVEN BY 'FIRST");
+                          ELSIF A'LAST /= 15 THEN
+                               FAILED ("CASE A1 : UPPER BOUND " &
+                                       "INCORRECTLY GIVEN BY 'LAST");
+                          ELSIF A /= (6, 7, 8, 9, 10) THEN
+                               FAILED ("CASE A1 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                          END IF;
+                     END;
+ 
+                BEGIN
+ 
+                     PROC1 ((6, 7, 8, 9, IDENT_INT(10)));
+ 
+                END CASE_A1;
+ 
+                COMMENT ("CASE A2 : SUBPROGRAM WITH UNCONSTRAINED " &
+                         "TWO-DIMENSIONAL ARRAY FORMAL PARAMETER");
+ 
+      CASE_A2 : DECLARE
+ 
+                     SUBTYPE STA1 IS INTEGER RANGE 11 .. IDENT_INT(12);
+                     SUBTYPE STA2 IS INTEGER RANGE 10 .. 11;
+                     TYPE TA IS ARRAY (STA1 RANGE <>, STA2 RANGE <>)
+                                     OF INTEGER;
+ 
+                     PROCEDURE PROC1 (A : TA) IS
+                     BEGIN
+                          IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
+                               FAILED ("CASE A2 : LOWER BOUND " &
+                                       "INCORRECTLY GIVEN BY 'FIRST");
+                          ELSIF A'LAST(1) /= 12 OR 
+                                A'LAST(2) /= IDENT_INT(11) THEN
+                               FAILED ("CASE A2 : UPPER BOUND " &
+                                       "INCORRECTLY GIVEN BY 'LAST");
+                          ELSIF A /= ((1, 2), (3, 4)) THEN
+                               FAILED ("CASE A2 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                          END IF;
+                     END;
+ 
+                BEGIN
+ 
+                     PROC1 (((1, 2), (IDENT_INT(3), 4)));
+ 
+                END CASE_A2;
+ 
+           END CASE_A;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C43205B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+ 
+ --   B) AN ACTUAL PARAMETER IN A GENERIC INSTANTIATION, AND THE FORMAL
+ --      PARAMETER IS UNCONSTRAINED.
+ 
+ -- EG  01/26/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205B", "CASE B : UNCONSTRAINED ARRAY FORMAL GENERIC " &
+                       "PARAMETER");
+ 
+      BEGIN
+ 
+ CASE_B :  DECLARE
+ 
+                SUBTYPE STB IS INTEGER RANGE IDENT_INT(-8) .. -5;
+                TYPE TB IS ARRAY (STB RANGE <>) OF INTEGER;
+ 
+                GENERIC
+                     B1 : TB;
+                PROCEDURE PROC1;
+ 
+                PROCEDURE PROC1 IS
+                BEGIN
+                     IF B1'FIRST /= -8 THEN
+                          FAILED ("CASE B : LOWER BOUND INCORRECTLY " &
+                                  "GIVEN BY 'FIRST");
+                     ELSIF B1'LAST /= IDENT_INT(-5) THEN
+                          FAILED ("CASE B : UPPER BOUND INCORRECTLY " &
+                                  "GIVEN BY 'LAST");
+                     ELSIF B1 /= (7, 6, 5, 4) THEN
+                          FAILED ("CASE B : ARRAY DOES NOT " &
+                                  "CONTAIN THE CORRECT VALUES");
+                     END IF;
+                END;
+ 
+                PROCEDURE PROC2 IS NEW PROC1 ((7, 6, IDENT_INT(5), 4));
+ 
+           BEGIN
+ 
+                PROC2;
+ 
+           END CASE_B;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C43205C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+ 
+ --   C) THE RETURN EXPRESSION IN A FUNCTION WHOSE RETURN TYPE IS
+ --      UNCONSTRAINED.
+ 
+ -- EG  01/26/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205C", "CASE C : UNCONSTRAINED FUNCTION RESULT TYPE");
+ 
+      BEGIN
+ 
+ CASE_C :  DECLARE
+ 
+                SUBTYPE STC1 IS INTEGER RANGE -2 .. 3;
+                SUBTYPE STC2 IS INTEGER RANGE 7 .. 20;
+                TYPE TC IS ARRAY (STC1 RANGE <>, STC2 RANGE <>)
+                                                         OF INTEGER;
+ 
+                FUNCTION FUN1 (A : INTEGER) RETURN TC IS
+                BEGIN
+                     RETURN ((5, 4, 3), (2, IDENT_INT(1), 0));
+                END;
+ 
+           BEGIN
+ 
+                IF FUN1(5)'FIRST(1) /= -2 THEN
+                     FAILED ("CASE C : LOWER BOUND INCORRECTLY " &
+                             "GIVEN BY 'FIRST(1)");
+                ELSIF FUN1(5)'FIRST(2) /= 7 THEN
+                     FAILED ("CASE C : LOWER BOUND INCORRECTLY " &
+                             "GIVEN BY 'FIRST(2)");
+                ELSIF FUN1(5)'LAST(1) /= -1 THEN
+                     FAILED ("CASE C : UPPER BOUND INCORRECTLY " &
+                             "GIVEN BY 'LAST(1)");
+                ELSIF FUN1(5)'LAST(2) /= 9 THEN
+                     FAILED ("CASE C : UPPER BOUND INCORRECTLY " &
+                             "GIVEN BY 'LAST(2)");
+                ELSIF FUN1(5) /= ((5, 4, 3), (2, 1, 0)) THEN
+                     FAILED ("CASE C : FUNCTION DOES NOT " &
+                             "RETURN THE CORRECT VALUES");
+                END IF;
+ 
+           END CASE_C;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C43205D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+ 
+ --   D) THE INITIALIZATION EXPRESSION OF A CONSTANT WHOSE TYPE MARK
+ --      DENOTES AN UNCONSTRAINED ARRAY.
+ 
+ -- EG  01/26/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205D", "CASE D : INITIALIZATION OF UNCONSTRAINED " &
+                      "ARRAY CONSTANT");
+ 
+      BEGIN
+ 
+ CASE_D :  DECLARE
+ 
+                SUBTYPE STD IS INTEGER RANGE IDENT_INT(11) .. 13;
+                TYPE TD IS ARRAY (STD RANGE <>) OF INTEGER;
+ 
+                D1 : CONSTANT TD := (-1, -2, -3);
+ 
+           BEGIN
+ 
+                IF D1'FIRST /= 11 THEN
+                     FAILED ("CASE D : LOWER BOUND INCORRECTLY " &
+                             "GIVEN BY 'FIRST");
+                ELSIF D1'LAST /= 13 THEN
+                     FAILED ("CASE D : UPPER BOUND INCORRECTLY " &
+                             "GIVEN BY 'LAST");
+                ELSIF D1 /= (-1, -2, -3) THEN
+                     FAILED ("CASE D : ARRAY DOES NOT CONTAIN " &
+                             "THE CORRECT VALUES");
+                END IF;
+ 
+           END CASE_D;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C43205E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+ 
+ --   E) THE LEFT OR RIGHT OPERAND OF "&".
+ 
+ -- EG  01/26/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205E IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205E", "CASE E : OPERAND OF &");
+ 
+      BEGIN
+ 
+ CASE_E :  DECLARE
+ 
+                SUBTYPE STE IS INTEGER RANGE 2 .. 10;
+ 
+                TYPE COLOR IS (RED, GREEN, BLUE);
+                TYPE TE IS ARRAY (STE RANGE <>) OF COLOR;
+ 
+                FUNCTION CONCAT1 RETURN TE IS
+                BEGIN
+                     RETURN (RED, GREEN, BLUE) & (7 .. 8 => RED);
+                END;
+ 
+                FUNCTION CONCAT2 RETURN TE IS
+                BEGIN
+                     RETURN (IDENT_INT(4) .. 3 => RED) & (GREEN, BLUE);
+                END;
+ 
+                FUNCTION CONCAT3 RETURN STRING IS
+                BEGIN
+                     RETURN "TEST" & (7 .. 8 => 'X');
+                END;
+ 
+                FUNCTION CONCAT4 RETURN STRING IS
+                BEGIN
+                     RETURN (8 .. 5 => 'A') & "BC";
+                END;
+ 
+           BEGIN
+ 
+                IF CONCAT1'FIRST /= IDENT_INT(2) THEN
+                     FAILED ("CASE E1 : LOWER BOUND INCORRECTLY " &
+                             "GIVEN BY 'FIRST");
+                ELSIF CONCAT1'LAST /= 6 THEN
+                     FAILED ("CASE E1 : UPPER BOUND INCORRECTLY " &
+                             "GIVEN BY 'LAST");
+                ELSIF CONCAT1 /= (RED, GREEN, BLUE, RED, RED) THEN
+                     FAILED ("CASE E1 : INCORRECT VALUES PRODUCED");
+                END IF;
+                IF CONCAT2'FIRST /= IDENT_INT(2) THEN
+                     FAILED ("CASE E2 : LOWER BOUND INCORRECTLY " &
+                             "GIVEN BY 'FIRST");
+                ELSIF CONCAT2'LAST /= 3 THEN
+                     FAILED ("CASE E2 : UPPER BOUND INCORRECTLY " &
+                             "GIVEN BY 'LAST");
+                ELSIF CONCAT2 /= (GREEN, BLUE) THEN
+                     FAILED ("CASE E2 : INCORRECT VALUES PRODUCED");
+                END IF;
+                IF CONCAT3'FIRST /= IDENT_INT(1) THEN
+                     FAILED ("CASE E3 : LOWER BOUND INCORRECTLY " &
+                             "GIVEN BY 'FIRST");
+                ELSIF CONCAT3'LAST /= 6 THEN
+                     FAILED ("CASE E3 : UPPER BOUND INCORRECTLY " &
+                             "GIVEN BY 'LAST");
+                ELSIF CONCAT3 /= "TESTXX" THEN
+                     FAILED ("CASE E3 : INCORRECT VALUES PRODUCED");
+                END IF;
+                IF CONCAT4'FIRST /= IDENT_INT(1) THEN
+                     FAILED ("CASE E4 : LOWER BOUND INCORRECTLY " &
+                             "GIVEN BY 'FIRST");
+                ELSIF CONCAT4'LAST /= 2 THEN
+                     FAILED ("CASE E4 : UPPER BOUND INCORRECTLY " &
+                             "GIVEN BY 'LAST");
+                ELSIF CONCAT4 /= "BC" THEN
+                     FAILED ("CASE E4 : INCORRECT VALUES PRODUCED");
+                END IF;
+ 
+           END CASE_E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C43205G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+ -- POSITIONAL AGGREGATE IS USED AS:
+ 
+ -- AN ACTUAL PARAMETER IN A SUBPROGRAM, AND THE
+ -- FORMAL PARAMETER IS CONSTRAINED.
+ 
+ -- EG  01/27/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205G IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205G", "SUBPROGRAM WITH CONSTRAINED " &
+                      "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
+ 
+      BEGIN
+ 
+ CASE_G :  BEGIN
+ 
+      CASE_G1 : DECLARE
+ 
+                     TYPE TA IS ARRAY (IDENT_INT(11) .. 15) OF INTEGER;
+ 
+                     PROCEDURE PROC1 (A : TA) IS
+                     BEGIN
+                          IF A'FIRST /= 11 THEN
+                               FAILED ("CASE A1 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A'LAST /= 15 THEN
+                               FAILED ("CASE A1 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A /= (6, 7, 8, 9, 10) THEN
+                               FAILED ("CASE A1 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                          END IF;
+                     END;
+ 
+                BEGIN
+ 
+                     PROC1 ((6, 7, 8, IDENT_INT(9), 10));
+ 
+                END CASE_G1;
+ 
+      CASE_G2 : DECLARE
+ 
+                     TYPE TA IS ARRAY (11 .. 12, 
+                                       IDENT_INT(10) .. 11) OF INTEGER;
+ 
+                     PROCEDURE PROC1 (A : TA) IS
+                     BEGIN
+                          IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
+                               FAILED ("CASE A2 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A'LAST(1) /= 12 OR A'LAST(2) /= 11 THEN
+                               FAILED ("CASE A2 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A /= ((1, 2), (3, 4)) THEN
+                               FAILED ("CASE A2 : ARRAY DOES NOT " &
+                                       "CONTAIN THE CORRECT VALUES");
+                          END IF;
+                     END;
+ 
+                BEGIN
+ 
+                     PROC1 (((1, 2), (3, 4)));
+ 
+                END CASE_G2;
+ 
+           END CASE_G;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C43205H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+ -- POSITIONAL AGGREGATE IS USED AS:
+ 
+ -- AN ACTUAL PARAMETER IN A GENERIC INSTANTIATION, AND THE FORMAL
+ -- PARAMETER IS CONSTRAINED.
+ 
+ -- EG  01/27/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205H IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205H", "CONSTRAINED ARRAY FORMAL GENERIC " &
+                      "PARAMETER");
+ 
+      BEGIN
+ 
+ CASE_H :  DECLARE
+ 
+                SUBTYPE STH IS INTEGER RANGE -10 .. 0;
+                TYPE BASE IS ARRAY(STH RANGE <>) OF INTEGER;
+                SUBTYPE TB IS BASE(IDENT_INT(-8) .. -5);
+ 
+                GENERIC
+                     B1 : TB;
+                PROCEDURE PROC1;
+ 
+                PROCEDURE PROC1 IS
+                BEGIN
+                     IF B1'FIRST /= -8 THEN
+                          FAILED ("CASE B : LOWER BOUND INCORRECT");
+                     ELSIF B1'LAST /= -5 THEN
+                          FAILED ("CASE B : UPPER BOUND INCORRECT");
+                     ELSIF B1 /= (7, 6, 5, 4) THEN
+                          FAILED ("CASE B : ARRAY DOES NOT " &
+                                  "CONTAIN THE CORRECT VALUES");
+                     END IF;
+                END;
+ 
+                PROCEDURE PROC2 IS NEW PROC1 ((7, 6, 5, 4));
+ 
+           BEGIN
+ 
+                PROC2;
+ 
+           END CASE_H;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C43205I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+ -- POSITIONAL AGGREGATE IS USED AS:
+ 
+ -- THE RETURN EXPRESSION IN A FUNCTION WHOSE RETURN TYPE IS
+ -- CONSTRAINED.
+ 
+ -- EG  01/27/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205I IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205I", "CONSTRAINED FUNCTION RESULT TYPE");
+ 
+      BEGIN
+ 
+ CASE_I :  DECLARE
+ 
+                SUBTYPE STC IS INTEGER RANGE -2 .. 10;
+                TYPE BASE IS ARRAY(STC RANGE <>, STC RANGE <>)OF INTEGER;
+                SUBTYPE TC IS BASE(IDENT_INT(-1) .. 0, 7 .. 9);
+ 
+                FUNCTION FUN1 (A : INTEGER) RETURN TC IS
+                BEGIN
+                     RETURN ((5, 4, 3), (2, 1, 0));
+                END;
+ 
+           BEGIN
+ 
+                IF FUN1(5)'FIRST(1) /= -1 THEN
+                     FAILED ("CASE I : LOWER BOUND INCORRECT " &
+                             "FOR 'FIRST(1)");
+                ELSIF FUN1(5)'FIRST(2) /= 7 THEN
+                     FAILED ("CASE I : LOWER BOUND INCORRECT " &
+                             "FOR 'FIRST(2)");
+                ELSIF FUN1(5)'LAST(1) /= 0 THEN
+                     FAILED ("CASE I : UPPER BOUND INCORRECT " &
+                             "FOR 'LAST(1)");
+                ELSIF FUN1(5)'LAST(2) /= 9 THEN
+                     FAILED ("CASE I : UPPER BOUND INCORRECT " &
+                             "FOR 'LAST(2)");
+                ELSIF FUN1(5) /= ((5, 4, 3), (2, 1, 0)) THEN
+                     FAILED ("CASE I : FUNCTION DOES NOT " &
+                             "RETURN THE CORRECT VALUES");
+                END IF;
+ 
+           END CASE_I;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- C43205J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+ -- POSITIONAL AGGREGATE IS USED AS:
+ 
+ --   J) THE INITIALIZATION EXPRESSION OF A CONSTANT, VARIABLE, OR FORMAL
+ --      PARAMETER (OF A SUBPROGRAM, ENTRY, OR GENERIC UNIT) WHEN THE
+ --      TYPE OF THE CONSTANT, VARIABLE, OR PARAMETER IS CONSTRAINED.
+ 
+ -- EG  01/27/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205J IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205J", "CASE J : INITIALIZATION OF CONSTRAINED " &
+                      "ARRAY");
+ 
+      BEGIN
+ 
+ CASE_J :  BEGIN
+ 
+      CASE_J1 : DECLARE
+ 
+                     TYPE TD1 IS ARRAY (IDENT_INT(11) .. 13) OF INTEGER;
+ 
+                     D1 : CONSTANT TD1 := (-1, -2, -3);
+ 
+                BEGIN
+ 
+                     IF D1'FIRST /= 11 THEN
+                          FAILED ("CASE J1 : LOWER BOUND INCORRECT");
+                     ELSIF D1'LAST /= 13 THEN
+                          FAILED ("CASE J1 : UPPER BOUND INCORRECT");
+                     ELSIF D1 /= (-1, -2, -3) THEN
+                               FAILED ("CASE J1 : ARRAY DOES NOT " &
+                                       "CONTAINING THE CORRECT VALUES");
+                     END IF;
+ 
+                END CASE_J1;
+ 
+      CASE_J2 : DECLARE
+ 
+                     TYPE TD2 IS ARRAY(INTEGER RANGE -13 .. -11)
+                                                             OF INTEGER;
+                     D2 : TD2 := (3, 2, 1);
+ 
+                BEGIN
+ 
+                     IF D2'FIRST /= -13 THEN
+                          FAILED ("CASE J2 : LOWER BOUND INCORRECT");
+                     ELSIF D2'LAST /= -11 THEN
+                          FAILED ("CASE J2 : UPPER BOUND INCORRECT");
+                     ELSIF D2 /= (3, 2, 1) THEN
+                          FAILED ("CASE J2 : INCORRECT VALUES");
+                     END IF;
+ 
+                END CASE_J2;
+ 
+      CASE_J3 : DECLARE
+ 
+                     TYPE TD3 IS ARRAY(IDENT_INT(5) .. 7) OF INTEGER;
+ 
+                     PROCEDURE PROC1 (A : TD3 := (2, 3, 4)) IS
+                     BEGIN
+                          IF A'FIRST /= 5 THEN
+                               FAILED ("CASE J3 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A'LAST /= 7 THEN
+                               FAILED ("CASE J3 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A /= (2, 3, 4) THEN
+                               FAILED ("CASE J3 : INCORRECT VALUES");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                PROC1;
+ 
+                END CASE_J3;
+ 
+      CASE_J4 : DECLARE
+ 
+                     TYPE TD4 IS ARRAY(5 .. 8) OF INTEGER;
+ 
+                     GENERIC
+                          D4 : TD4 := (1, -2, 3, -4);
+                     PROCEDURE PROC1;
+ 
+                     PROCEDURE PROC1 IS
+                     BEGIN
+                          IF D4'FIRST /= 5 THEN
+                               FAILED ("CASE J4 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF D4'LAST /= 8 THEN
+                               FAILED ("CASE J4 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF D4 /= (1, -2, 3, -4) THEN
+                               FAILED ("CASE J4 : INCORRECT VALUES");
+                          END IF;
+                     END PROC1;
+ 
+                     PROCEDURE PROC2 IS NEW PROC1;
+ 
+                BEGIN
+ 
+                     PROC2;
+ 
+                END CASE_J4;
+ 
+           END CASE_J;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43205k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43205k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C43205K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A POSITIONAL AGGREGATE ARE DETERMINED
+ -- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+ -- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+ -- POSITIONAL AGGREGATE IS USED AS:
+ 
+ -- THE EXPRESSION OF AN ENCLOSING RECORD OR ARRAY AGGREGATE, AND
+ -- THE EXPRESSION GIVES THE VALUE OF A RECORD OR ARRAY COMPONENT
+ -- (WHICH IS NECESSARILY CONSTRAINED).
+ 
+ -- EG  01/27/84
+ -- JBG 3/30/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43205K IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43205K", "THE EXPRESSION OF AN ENCLOSING RECORD " &
+                      "OR ARRAY AGGREGATE, AND THE EXPRESSION GIVES "   &
+                      "THE VALUE OF A RECORD OR ARRAY COMPONENT");
+ 
+      BEGIN
+ 
+ CASE_K :  BEGIN
+ 
+      CASE_K1 : DECLARE
+ 
+                     SUBTYPE SK1 IS INTEGER RANGE 2 .. 6;
+                     TYPE BASE IS ARRAY(SK1 RANGE <>) OF INTEGER;
+                     SUBTYPE TE1 IS BASE(IDENT_INT(3) .. 5);
+                     TYPE TE2 IS ARRAY(1 .. 2) OF TE1;
+ 
+                     E1 : TE2;
+ 
+                BEGIN
+ 
+                     E1 := (1 .. 2 => (3, 2, 1));
+                     IF (E1'FIRST /= 1 OR E1'LAST /= 2) OR ELSE
+                        (E1(1)'FIRST /= 3 OR E1(1)'LAST /= 5 OR
+                         E1(2)'FIRST /= 3 OR E1(2)'LAST /= 5) THEN
+                          FAILED ("CASE K1 : INCORRECT BOUNDS");
+                     ELSE
+                          IF E1 /= (1 .. 2 => (3, 2, 1)) THEN
+                               FAILED ("CASE K1 : ARRAY DOES NOT " &
+                                       "CONTAIN THE CORRECT VALUES");
+                          END IF;
+                     END IF;
+ 
+                END CASE_K1;
+ 
+      CASE_K2 : DECLARE
+ 
+                     TYPE SK2 IS RANGE 2 .. 6;
+                     TYPE BASE IS ARRAY(SK2 RANGE <>) OF INTEGER;
+                     SUBTYPE TE1 IS BASE(3 .. 5);
+                     TYPE TER IS
+                          RECORD
+                               REC : TE1;
+                          END RECORD;
+ 
+                     E2 : TER;
+ 
+                BEGIN
+ 
+                     E2 := (REC => (3, 2, 1));
+                     IF E2.REC'FIRST /= 3 OR E2.REC'LAST /= 5 THEN
+                          FAILED ("CASE K2 : INCORRECT BOUNDS");
+                     ELSE
+                          IF E2.REC /= (3, 2, 1) THEN
+                               FAILED ("CASE K2 : ARRAY DOES NOT " &
+                                       "CONTAIN CORRECT VALUES");
+                          END IF;
+                     END IF;
+ 
+                END CASE_K2;
+ 
+           END CASE_K;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43205K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43206a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43206a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43206a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,242 ----
+ -- C43206A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED
+ -- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK
+ -- THAT:
+ 
+ --   A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF
+ --      THE LOWER BOUND.
+ 
+ --   B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE
+ --      INDEX SUBTYPE FOR NULL RANGES.
+ 
+ --   C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL
+ --      BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS 
+ --      RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE
+ --      INDEX SUBTYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- EG  02/02/84
+ -- JBG 12/6/84
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43206A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " &
+                      "DETERMINED BY THE BOUNDS SPECIFIED BY THE " &
+                      "CHOICES");
+ 
+      DECLARE
+ 
+           SUBTYPE ST1 IS INTEGER RANGE 10 .. 15;
+           SUBTYPE ST2 IS INTEGER RANGE 1 .. 5;
+ 
+           TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER;
+           TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER;
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+      CASE_A1 : DECLARE
+ 
+                     PROCEDURE PROC1 (A : T1) IS
+                     BEGIN
+                          IF A'FIRST /= 12 OR A'LAST /= 10 THEN
+                               FAILED ("CASE A1 : INCORRECT BOUNDS");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                     PROC1((12 .. 10 => -2));
+ 
+                EXCEPTION
+ 
+                     WHEN OTHERS =>
+                          FAILED ("CASE A1 : EXCEPTION RAISED");
+ 
+                END CASE_A1;
+ 
+      CASE_A2 : DECLARE
+ 
+                     PROCEDURE PROC1 (A : STRING) IS
+                     BEGIN
+                          IF A'FIRST /= 5 OR A'LAST /= 2 THEN
+                               FAILED ("CASE A2 : INCORRECT BOUNDS");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                     PROC1 ((5 .. 2 => 'E'));
+ 
+                EXCEPTION
+ 
+                     WHEN OTHERS =>
+                          FAILED ("CASE A2 : EXCEPTION RAISED");
+ 
+                END CASE_A2;
+ 
+           END CASE_A;
+ 
+ CASE_B :  BEGIN
+ 
+      CASE_B1 : DECLARE
+ 
+                     PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS
+                     BEGIN
+                          IF A'FIRST /= L OR A'LAST /= U THEN
+                               FAILED ("CASE B1 : INCORRECT BOUNDS");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                     BEGIN
+ 
+                          PROC1 ((5 .. INTEGER'FIRST => -2),
+                                  5, INTEGER'FIRST);
+ 
+                     EXCEPTION
+ 
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED ("CASE B1A : CONSTRAINT_ERROR " &
+                                       "RAISED FOR NULL RANGE");
+                          WHEN OTHERS =>
+                               FAILED ("CASE B1A : EXCEPTION RAISED");
+ 
+                     END;
+ 
+                     BEGIN
+ 
+                          PROC1 ((IDENT_INT(6) .. 3 => -2),6,3);
+ 
+                     EXCEPTION
+ 
+                          WHEN OTHERS =>
+                               FAILED ("CASE B1B : EXCEPTION RAISED");
+ 
+                     END;
+ 
+                END CASE_B1;
+ 
+      CASE_B2 : DECLARE
+ 
+                     PROCEDURE PROC1 (A : STRING) IS
+                     BEGIN
+                          IF A'FIRST /= 1 OR 
+                             A'LAST /= INTEGER'FIRST THEN
+                               FAILED ("CASE B2 : INCORRECT BOUNDS");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                     PROC1 ((1 .. INTEGER'FIRST => ' '));
+ 
+                EXCEPTION
+ 
+                     WHEN OTHERS =>
+                          FAILED ("CASE B2 : EXCEPTION RAISED");
+ 
+                END CASE_B2;
+ 
+           END CASE_B;
+ 
+ CASE_C :  BEGIN
+ 
+      CASE_C1 : DECLARE
+ 
+                     PROCEDURE PROC1 (A : T2) IS
+                     BEGIN
+                          IF A'FIRST(1) /=  5 OR A'LAST(1) /=  3 OR
+                             A'FIRST(2) /= INTEGER'LAST-1 OR
+                             A'LAST(2)  /= INTEGER'LAST THEN
+                               FAILED ("CASE C1 : INCORRECT BOUNDS");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                     PROC1 ((5 .. 3 => 
+                               (IDENT_INT(INTEGER'LAST-1) ..
+                                IDENT_INT(INTEGER'LAST) => -2)));
+                     FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED");
+ 
+                EXCEPTION
+ 
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+ 
+                     WHEN OTHERS =>
+                          FAILED ("CASE C1 : EXCEPTION RAISED");
+ 
+                END CASE_C1;
+ 
+      CASE_C2 : DECLARE
+ 
+                     PROCEDURE PROC1 (A : T2) IS
+                     BEGIN
+                          IF A'FIRST(1) /=  INTEGER'FIRST OR
+                             A'LAST(1)  /=  INTEGER'FIRST+1 OR
+                             A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN
+                               FAILED ("CASE C2 : INCORRECT BOUNDS");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                     PROC1 ((IDENT_INT(INTEGER'FIRST) ..
+                             IDENT_INT(INTEGER'FIRST+1) =>
+                                     (14 .. IDENT_INT(11) => -2)));
+                     FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED");
+ 
+                EXCEPTION
+ 
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+ 
+                     WHEN OTHERS =>
+                          FAILED ("CASE C2 : EXCEPTION RAISED");
+ 
+                END CASE_C2;
+ 
+           END CASE_C;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43206A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43207b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43207b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43207b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- C43207B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
+ -- CHECK THAT:
+ 
+ --     B) IF H..I IS A NULL RANGE, CONSTRAINT_ERROR IS RAISED IF
+ --        F..G IS NON-NULL AND F OR G DO NOT BELONG TO THE INDEX
+ --        SUBTYPE;
+ 
+ -- EG  01/18/84
+ -- BHS  7/13/84
+ -- JBG 12/6/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43207B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43207B", "CHECK THAT THE EVALUATION OF A MULTI" &
+                      "DIMENSIONAL AGGREGATE OF THE FORM "   &
+                      "(F..G => (H..I = J)) IS PERFORMED "   &
+                      "CORRECTLY");
+ 
+      DECLARE
+ 
+           TYPE CHOICE_INDEX IS (F, G, H, I, J);
+           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+ 
+           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+ 
+           SUBTYPE SINT IS INTEGER RANGE 1 .. 8;
+           TYPE T0 IS ARRAY(SINT RANGE <>, SINT RANGE <>) OF INTEGER;
+    
+           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                          RETURN INTEGER IS
+           BEGIN
+                CNTR(A) := CNTR(A) + 1;
+                RETURN IDENT_INT(B);
+           END CALC;
+ 
+      BEGIN
+ 
+ CASE_B :  DECLARE
+                PROCEDURE CHECK (A : T0; M : STRING) IS
+                BEGIN
+                     IF (A'FIRST(1) /= 1) OR (A'LAST(1) /= 9) OR
+                        (A'FIRST(2) /= 6) OR (A'LAST(2) /= 5) THEN
+                          FAILED("CASE B" & M & " : ARRAY NOT " &
+                                 "BOUNDED CORRECTLY");
+                     END IF;
+                END CHECK;
+           BEGIN
+ 
+      CASE_B1 : BEGIN
+                     CHECK ((1 .. 9 => (6 .. 5 => 2)),"1");
+                     FAILED ("CASE B1 : CONSTRAINT_ERROR NOT RAISED");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("CASE B1 : EXCEPTION RAISED");
+                END CASE_B1;
+ 
+      CASE_B2 : BEGIN
+                     CHECK ((CALC(F,1) .. CALC(G,9) => (6 .. 5 => 2)),
+                            "2");
+                     FAILED ("CASE B2 : CONSTRAINT_ERROR NOT RAISED");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("CASE B2 : EXCEPTION RAISED");
+                END CASE_B2;
+ 
+      CASE_B3 : BEGIN
+                     CHECK ((1 .. 9 => (CALC(H,6) .. CALC(I,5) => 2)),
+                            "3");
+                     FAILED ("CASE B3 : CONSTRAINT_ERROR NOT RAISED");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("CASE B3 : EXCEPTION RAISED");
+                END CASE_B3;
+ 
+           END CASE_B;
+ 
+      IF CNTR(F) /= 1 THEN
+           FAILED ("CASE B2 : F WAS NOT EVALUATED " &
+                   "ONCE.  F WAS EVALUATED"         & 
+                   INTEGER'IMAGE(CNTR(F)) & " TIMES");
+      END IF;
+      IF CNTR(G) /= 1 THEN
+           FAILED ("CASE B2 : G WAS NOT EVALUATED " &
+                   "ONCE.  G WAS EVALUATED"         &
+                   INTEGER'IMAGE(CNTR(G)) & " TIMES");
+      END IF;
+ 
+      IF CNTR(H) /= 0 AND CNTR(I) /= 0 THEN
+           COMMENT ("CASE B3 : ALL CHOICES " &
+                    "EVALUATED BEFORE CHECKING " &
+                    "INDEX SUBTYPE");
+      ELSIF CNTR(H) = 0 AND CNTR(I) = 0 THEN
+           COMMENT ("CASE B3 : SUBTYPE CHECKS "&
+                    "MADE AS CHOICES ARE EVALUATED");
+      END IF;
+                               
+      IF CNTR(H) > 1 THEN
+           FAILED("CASE B3 : H WAS NOT EVALUATED " &
+                  "AT MOST ONCE. H WAS EVALUATED" &
+                  INTEGER'IMAGE(CNTR(H)) & " TIMES");
+      END IF;
+ 
+      IF CNTR(I) > 1 THEN
+           FAILED("CASE B3 : I WAS NOT EVALUATED " &
+                  "AT MOST ONCE. I WAS EVALUATED" &
+                  INTEGER'IMAGE(CNTR(I)) & " TIMES");
+      END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43207B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43207d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43207d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43207d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43207d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,135 ----
+ -- C43207D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
+ -- CHECK THAT:
+ 
+ --     D) J IS EVALUATED ONCE FOR EACH COMPONENT (ZERO TIMES IF THE
+ --        ARRAY IS NULL).
+ 
+ -- EG  01/18/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43207D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43207D", "CHECK THAT THE EVALUATION OF A MULTI" &
+                      "DIMENSIONAL AGGREGATE OF THE FORM "   &
+                      "(F..G => (H..I = J)) IS PERFORMED "   &
+                      "CORRECTLY");
+ 
+      DECLARE
+ 
+           TYPE CHOICE_INDEX IS (F, G, H, I, J);
+           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+ 
+           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+ 
+           SUBTYPE SINT IS INTEGER RANGE 1 .. 8;
+           TYPE T0 IS ARRAY(SINT RANGE <>, SINT RANGE <>) OF INTEGER;
+    
+           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                          RETURN INTEGER IS
+           BEGIN
+                CNTR(A) := CNTR(A) + 1;
+                RETURN IDENT_INT(B);
+           END CALC;
+ 
+      BEGIN
+ 
+ CASE_D :  BEGIN
+ 
+      CASE_D1 : DECLARE
+                     D1 : T0(8 .. 4, 5 .. 1);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     D1 := (8 .. 4 => (5 .. 1 => CALC(J,2)));
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE D1 : INCORRECT NUMBER " &
+                                 "OF EVALUATIONS. J EVALUATED" &
+                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE D1 : EXCEPTION RAISED");
+                END CASE_D1;
+ 
+      CASE_D2 : DECLARE
+                     D2 : T0(8 .. 4, 5 .. 1);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     D2 := (CALC(F,8) .. CALC(G,4) =>
+                               (CALC(H,5) .. CALC(I,1) => CALC(J,2)));
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE D2 : INCORRECT NUMBER " &
+                                 "OF EVALUATIONS. J EVALUATED" &
+                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE D2 : EXCEPTION RAISED");
+                END CASE_D2;
+ 
+      CASE_D3 : DECLARE
+                     D3 : T0(3 .. 5, 1 .. 2);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     D3 := (3 .. 5 => (1 .. 2 => CALC(J,2)));
+                     IF CNTR(J) /= 6 THEN
+                          FAILED("CASE D3 : INCORRECT NUMBER " &
+                                 "OF EVALUATIONS. J EVALUATED" &
+                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE D3 : EXCEPTION RAISED");
+                END CASE_D3;
+ 
+      CASE_D4 : DECLARE
+                     D4 : T0(1 .. 2, 5 .. 7);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     D4 := (CALC(F,1) .. CALC(G,2) =>
+                               (CALC(H,5) .. CALC(I,7) => CALC(J,2)));
+                     IF CNTR(J) /= 6 THEN
+                          FAILED("CASE D4 : INCORRECT NUMBER " &
+                                 "OF EVALUATIONS. J EVALUATED" &
+                                 INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE D4 : EXCEPTION RAISED");
+                END CASE_D4;
+ 
+           END CASE_D;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43207D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43208a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43208a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43208a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43208a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,208 ----
+ -- C43208A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A ONE-DIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
+ -- CHECK THAT:
+ 
+ --     A) IF F..G IS A NULL RANGE, H, I, AND J ARE NOT EVALUATED.
+ 
+ --     B) IF F..G IS A NON-NULL RANGE, H AND I ARE EVALUATED G-F+1
+ --        TIMES, AND J IS EVALUATED (I-H+1)*(G-F+1) TIMES IF H..I
+ --        IS NON-NULL.
+ 
+ -- EG  01/19/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43208A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43208A", "CHECK THAT THE EVALUATION OF A ONE-" &
+                      "DIMENSIONAL AGGREGATE OF THE FORM "  &
+                      "(F..G => (H..I = J)) IS PERFORMED "  &
+                      "CORRECTLY");
+ 
+      DECLARE
+ 
+           TYPE CHOICE_INDEX IS (F, G, H, I, J);
+           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+ 
+           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+ 
+           TYPE T1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+    
+           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                          RETURN INTEGER IS
+           BEGIN
+                CNTR(A) := CNTR(A) + 1;
+                RETURN IDENT_INT(B);
+           END CALC;
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+      CASE_A1 : DECLARE
+                     A1 : ARRAY(4 .. 2) OF T1(1 .. 2);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     A1 := (4 .. 2 => 
+                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
+                     IF CNTR(H) /= 0 THEN
+                          FAILED("CASE A1 : H WAS EVALUATED");
+                     END IF;
+                     IF CNTR(I) /= 0 THEN
+                          FAILED("CASE A1 : I WAS EVALUATED");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE A1 : J WAS EVALUATED");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE A1 : EXCEPTION RAISED");
+                END CASE_A1;
+ 
+      CASE_A2 : DECLARE
+                     A2 : ARRAY(4 .. 2) OF T1(1 .. 2);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     A2 := (CALC(F,4) .. CALC(G,2) =>
+                                (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
+                     IF CNTR(H) /= 0 THEN
+                          FAILED("CASE A2 : H WAS EVALUATED");
+                     END IF;
+                     IF CNTR(I) /= 0 THEN
+                          FAILED("CASE A2 : I WAS EVALUATED");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE A2 : J WAS EVALUATED");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE A2 : EXCEPTION RAISED");
+                END CASE_A2;
+ 
+           END CASE_A;
+ 
+ CASE_B :  BEGIN
+ 
+      CASE_B1 : DECLARE
+                     B1 : ARRAY(2 .. 3) OF T1(1 .. 2);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B1 := (2 .. 3 =>
+                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
+                     IF CNTR(H) /= 2 THEN
+                          FAILED("CASE B1 : H NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(I) /= 2 THEN
+                          FAILED("CASE B1 : I NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(J) /= 4 THEN
+                          FAILED("CASE B1 : J NOT EVALUATED (I-H+1)*" &
+                                 "(G-F+1) TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B1 : EXECEPTION RAISED");
+                END CASE_B1;
+ 
+      CASE_B2 : DECLARE
+                     B2 : ARRAY(2 .. 3) OF T1(9 .. 10);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B2 := (CALC(F,2) .. CALC(G,3) =>
+                               (CALC(H,9) .. CALC(I,10) => CALC(J,2)));
+                     IF CNTR(H) /= 2 THEN
+                          FAILED("CASE B2 : H NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(I) /= 2 THEN
+                          FAILED("CASE B2 : I NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(J) /= 4 THEN
+                          FAILED("CASE B2 : J NOT EVALUATED (I-H+1)*" &
+                                 "(G-F+1) TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B2 : EXECEPTION RAISED");
+                END CASE_B2;
+ 
+      CASE_B3 : DECLARE
+                     B3 : ARRAY(2 .. 3) OF T1(2 .. 1);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B3 := (2 .. 3 =>
+                               (CALC(H,2) .. CALC(I,1) => CALC(J,2)));
+                     IF CNTR(H) /= 2 THEN
+                          FAILED("CASE B3 : H NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(I) /= 2 THEN
+                          FAILED("CASE B3 : I NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B3 : EXECEPTION RAISED");
+                END CASE_B3;
+ 
+      CASE_B4 : DECLARE
+                     B4 : ARRAY(2 .. 3) OF T1(2 .. 1);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B4 := (CALC(F,2) .. CALC(G,3) =>
+                               (CALC(H,2) .. CALC(I,1) => CALC(J,2)));
+                     IF CNTR(H) /= 2 THEN
+                          FAILED("CASE B4 : H NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(I) /= 2 THEN
+                          FAILED("CASE B4 : I NOT EVALUATED G-F+1 " &
+                                 "TIMES");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B4 : EXECEPTION RAISED");
+                END CASE_B4;
+ 
+           END CASE_B;
+       END;
+ 
+      RESULT;
+ 
+ END C43208A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43208b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43208b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43208b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43208b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,266 ----
+ -- C43208B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR AN AGGREGATE OF THE FORM:
+ --        (B..C => (D..E => (F..G => (H..I => J))))
+ -- WHOSE TYPE IS A TWO-DIMENSIONAL ARRAY TYPE THAT HAS A TWO-
+ -- DIMENSIONAL ARRAY COMPONENT TYPE, CHECK THAT:
+ 
+ --     A) IF B..C OR D..E IS A NULL RANGE, THEN F, G, H, I, AND J
+ --        ARE NOT EVALUATED.
+ 
+ --     B) IF B..C AND D..E ARE NON-NULL RANGES, THEN F, G, H AND I
+ --        ARE EVALUATED (C-B+1)*(E-D+1) TIMES, AND J IS EVALUATED
+ --        (C-B+1)*(E-D+1)*(G-F+1)*(I-H+1) TIMES IF F..G AND H..I
+ --        ARE NON-NULL.
+ 
+ -- EG  01/19/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43208B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43208B", "CHECK THAT THE EVALUATION OF A MULTI" &
+                      "DIMENSIONAL ARRAY TYPE THAT HAS AN "  &
+                      "ARRAY COMPONENT TYPE IS PERFORMED "   &
+                      "CORRECTLY");
+ 
+      DECLARE
+ 
+           TYPE CHOICE_INDEX IS (B, C, D, E, F, G, H, I, J);
+           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+ 
+           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+ 
+           TYPE T1 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                           OF INTEGER;
+    
+           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                          RETURN INTEGER IS
+           BEGIN
+                CNTR(A) := CNTR(A) + 1;
+                RETURN IDENT_INT(B);
+           END CALC;
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+      CASE_A1 : DECLARE
+                     A1 : ARRAY(4 .. 3, 3 .. 4) OF T1(2 .. 3, 1 .. 2);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     A1 := (4 .. 3 => (3 .. 4 => 
+                             (CALC(F,2) .. CALC(G,3) =>
+                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
+                     IF CNTR(F) /= 0 THEN
+                          FAILED("CASE A1 : F WAS EVALUATED");
+                     END IF;
+                     IF CNTR(G) /= 0 THEN
+                          FAILED("CASE A1 : G WAS EVALUATED");
+                     END IF;
+                     IF CNTR(H) /= 0 THEN
+                          FAILED("CASE A1 : H WAS EVALUATED");
+                     END IF;
+                     IF CNTR(I) /= 0 THEN
+                          FAILED("CASE A1 : I WAS EVALUATED");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE A1 : J WAS EVALUATED");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE A1 : EXCEPTION RAISED");
+                END CASE_A1;
+ 
+      CASE_A2 : DECLARE
+                     A2 : ARRAY(3 .. 4, 4 .. 3) OF T1(2 .. 3, 1 .. 2);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     A2 := (CALC(B,3) .. CALC(C,4) =>
+                            (CALC(D,4) .. CALC(E,3) =>
+                             (CALC(F,2) .. CALC(G,3) =>
+                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
+                     IF CNTR(F) /= 0 THEN
+                          FAILED("CASE A2 : F WAS EVALUATED");
+                     END IF;
+                     IF CNTR(G) /= 0 THEN
+                          FAILED("CASE A2 : G WAS EVALUATED");
+                     END IF;
+                     IF CNTR(H) /= 0 THEN
+                          FAILED("CASE A2 : H WAS EVALUATED");
+                     END IF;
+                     IF CNTR(I) /= 0 THEN
+                          FAILED("CASE A2 : I WAS EVALUATED");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE A2 : J WAS EVALUATED");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE A2 : EXCEPTION RAISED");
+                END CASE_A2;
+ 
+           END CASE_A;
+ 
+ CASE_B :  BEGIN
+ 
+      CASE_B1 : DECLARE
+                     B1 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B1 := (2 .. 3 => (1 .. 2 =>
+                             (CALC(F,1) .. CALC(G,2) =>
+                               (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
+                     IF CNTR(F) /= 4 THEN
+                          FAILED("CASE B1 : F NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(G) /= 4 THEN
+                          FAILED("CASE B1 : G NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(H) /= 4 THEN
+                          FAILED("CASE B1 : H NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(I) /= 4 THEN
+                          FAILED("CASE B1 : I NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(J) /= 16 THEN
+                          FAILED("CASE B1 : J NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B1 : EXECEPTION RAISED");
+                END CASE_B1;
+ 
+      CASE_B2 : DECLARE
+                     B2 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B2 := (CALC(B,2) .. CALC(C,3) =>
+                            (CALC(D,1) .. CALC(E,2) =>
+                             (CALC(F,1) .. CALC(G,2) =>
+                              (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
+                     IF CNTR(F) /= 4 THEN
+                          FAILED("CASE B2 : F NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(G) /= 4 THEN
+                          FAILED("CASE B2 : G NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(H) /= 4 THEN
+                          FAILED("CASE B2 : H NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(I) /= 4 THEN
+                          FAILED("CASE B2 : I NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(J) /= 16 THEN
+                          FAILED("CASE B2 : J NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B2 : EXECEPTION RAISED");
+                END CASE_B2;
+ 
+      CASE_B3 : DECLARE
+                     B3 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 2 .. 1);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B3 := (2 .. 3 => (1 .. 2 =>
+                             (CALC(F,1) .. CALC(G,2) =>
+                               (CALC(H,2) .. CALC(I,1) => CALC(J,2)))));
+                     IF CNTR(F) /= 4 THEN
+                          FAILED("CASE B3 : F NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(G) /= 4 THEN
+                          FAILED("CASE B3 : G NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(H) /= 4 THEN
+                          FAILED("CASE B3 : H NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(I) /= 4 THEN
+                          FAILED("CASE B3 : I NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B3 : EXECEPTION RAISED");
+                END CASE_B3;
+ 
+      CASE_B4 : DECLARE
+                     B4 : ARRAY(2 .. 3, 1 .. 2) OF T1(2 .. 1, 1 .. 2);
+                BEGIN
+                     CNTR := (CHOICE_INDEX => 0);
+                     B4 := (CALC(B,2) .. CALC(C,3) =>
+                            (CALC(D,1) .. CALC(E,2) =>
+                             (CALC(F,2) .. CALC(G,1) =>
+                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
+                     IF CNTR(F) /= 4 THEN
+                          FAILED("CASE B4 : F NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(G) /= 4 THEN
+                          FAILED("CASE B4 : G NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(H) /= 4 THEN
+                          FAILED("CASE B4 : H NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(I) /= 4 THEN
+                          FAILED("CASE B4 : I NOT EVALUATED (C-B+1)*" &
+                                 "(E-D+1) TIMES");
+                     END IF;
+                     IF CNTR(J) /= 0 THEN
+                          FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED("CASE B4 : EXECEPTION RAISED");
+                END CASE_B4;
+ 
+           END CASE_B;
+       END;
+ 
+      RESULT;
+ 
+ END C43208B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43209a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43209a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43209a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43209a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,135 ----
+ -- C43209A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A STRING LITERAL IS ALLOWED IN A MULTIDIMENSIONAL
+ --     ARRAY AGGREGATE AT THE PLACE OF A ONE DIMENSIONAL ARRAY OF
+ --     CHARACTER TYPE.
+ 
+ -- HISTORY:
+ --     DHH 08/12/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43209A IS
+ 
+      TYPE MULTI_ARRAY IS ARRAY(1 .. 2, 1 .. 3, 1 .. 6) OF CHARACTER;
+ 
+ BEGIN
+      TEST("C43209A", "CHECK THAT A STRING LITERAL IS ALLOWED IN A " &
+                      "MULTIDIMENSIONAL ARRAY AGGREGATE AT THE PLACE " &
+                      "OF A ONE DIMENSIONAL ARRAY OF CHARACTER TYPE");
+ 
+      DECLARE
+           X : MULTI_ARRAY := ((('A', 'B', 'C', 'D', 'E', 'F'),
+                               ('G', 'H', 'I', 'J', 'K', 'L'),
+                               ('M', 'N', 'O', 'P', 'Q', 'R')),
+                               (('S', 'T', 'U', 'V', 'W', 'X'),
+                               ('W', 'Z', 'A', 'B', 'C', 'D'),
+                               "WHOZAT"));
+ 
+           Y : MULTI_ARRAY := (("WHOZAT",
+                               ('A', 'B', 'C', 'D', 'E', 'F'),
+                               ('G', 'H', 'I', 'J', 'K', 'L')),
+                               (('M', 'N', 'O', 'P', 'Q', 'R'),
+                               ('S', 'T', 'U', 'V', 'W', 'X'),
+                               ('W', 'Z', 'A', 'B', 'C', 'D')));
+ 
+      BEGIN
+           IF X(IDENT_INT(2), IDENT_INT(3), IDENT_INT(6)) /=
+                   Y(IDENT_INT(1), IDENT_INT(1), IDENT_INT(6)) THEN
+                FAILED("INITIALIZATION FAILURE");
+           END IF;
+      END;
+ 
+      DECLARE
+           PROCEDURE FIX_AGG(T : MULTI_ARRAY) IS
+           BEGIN
+                IF T(IDENT_INT(2), IDENT_INT(2), IDENT_INT(5)) /=
+                        T(IDENT_INT(1), IDENT_INT(1), IDENT_INT(1)) THEN
+                     FAILED("SUBPROGRAM FAILURE");
+                END IF;
+           END;
+      BEGIN
+           FIX_AGG((("WHOZAT", ('A', 'B', 'C', 'D', 'E', 'F'),
+                               ('G', 'H', 'I', 'J', 'K', 'L')),
+                               (('M', 'N', 'O', 'P', 'Q', 'R'),
+                               ('S', 'T', 'U', 'V', 'W', 'X'),
+                               ('W', 'Z', 'A', 'B', 'C', 'D'))));
+ 
+      END;
+ 
+      DECLARE
+ 
+           Y : CONSTANT MULTI_ARRAY := (("WHOZAT",
+                               ('A', 'B', 'C', 'D', 'E', 'F'),
+                               ('G', 'H', 'I', 'J', 'K', 'L')),
+                               (('M', 'N', 'O', 'P', 'Q', 'R'),
+                               ('S', 'T', 'U', 'V', 'W', 'X'),
+                               ('W', 'Z', 'A', 'B', 'C', 'D')));
+ 
+      BEGIN
+           IF Y(IDENT_INT(2), IDENT_INT(2), IDENT_INT(5)) /=
+              Y(IDENT_INT(1), IDENT_INT(1), IDENT_INT(1)) THEN
+                FAILED("CONSTANT FAILURE");
+           END IF;
+      END;
+ 
+      DECLARE
+      BEGIN
+           IF MULTI_ARRAY'((1 =>(('A', 'B', 'C', 'D', 'E', 'F'),
+                ('G', 'H', 'I', 'J', 'K', 'L'),
+                ('M', 'N', 'O', 'P', 'Q', 'R')),
+               2 => (('S', 'T', 'U', 'V', 'W', 'X'),
+                ('W', 'Z', 'A', 'B', 'C', 'D'),
+                "WHOZAT"))) = MULTI_ARRAY'((1 =>(1 =>"WHOZAT",
+                              2 =>('A', 'B', 'C', 'D', 'E', 'F'),
+                              3 =>('G', 'H', 'I', 'J', 'K', 'L')),
+                             2 => (1 =>('M', 'N', 'O', 'P', 'Q', 'R'),
+                              2 =>('S', 'T', 'U', 'V', 'W', 'X'),
+                              3 => ('W', 'Z', 'A', 'B', 'C', 'D')))) THEN
+                FAILED("EQUALITY OPERATOR FAILURE");
+           END IF;
+      END;
+ 
+      DECLARE
+           SUBTYPE SM IS INTEGER RANGE 1 .. 10;
+           TYPE UNCONSTR IS ARRAY(SM RANGE <>, SM RANGE<>) OF CHARACTER;
+ 
+           FUNCTION FUNC(X : SM) RETURN UNCONSTR IS
+           BEGIN
+                IF EQUAL(X,X) THEN
+                     RETURN (1 => "WHEN", 2 => "WHAT");
+                ELSE
+                     RETURN ("    ", "    ");
+                END IF;
+           END FUNC;
+ 
+      BEGIN
+           IF FUNC(1) /= FUNC(2) THEN
+                FAILED("UNCONSTRAINED FUNCTION RETURN FAILURE");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C43209A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43210a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43210a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43210a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C43210A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A NON-AGGREGATE EXPRESSION IN A NAMED COMPONENT
+ -- ASSOCIATION IS EVALUATED ONCE FOR EACH COMPONENT SPECIFIED
+ -- BY THE ASSOCIATION.
+ 
+ -- EG  02/02/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43210A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43210A", "CHECK THAT A NON-AGGREGATE IN A NAMED "   &
+                      "COMPONENT ASSOCIATION IS EVALUATED ONCE " &
+                      "FOR EACH COMPONENT SPECIFIED BY THE "     &
+                      "ASSOCIATION");
+ 
+      DECLARE
+ 
+           TYPE T1 IS ARRAY(1 .. 10) OF INTEGER;
+           TYPE T2 IS ARRAY(1 .. 8, 1 .. 2) OF INTEGER;
+           TYPE T3 IS ARRAY(1 .. 2, 1 .. 8) OF INTEGER;
+           TYPE T4 IS ARRAY(1 .. 8, 1 .. 8) OF INTEGER;
+ 
+           A1 : T1;
+           A2 : T2;
+           A3 : T3;
+           A4 : T4;
+           CC : INTEGER;
+ 
+           FUNCTION CALC (A : INTEGER) RETURN INTEGER IS
+           BEGIN
+                CC := CC + 1;
+                RETURN IDENT_INT(A);
+           END CALC;
+ 
+           PROCEDURE CHECK (A : STRING; B : INTEGER) IS
+           BEGIN
+                IF CC /= B THEN
+                     FAILED ("CASE " & A & " : INCORRECT NUMBER OF " &
+                             "EVALUATIONS. NUMBER OF EVALUATIONS "   &
+                             "SHOULD BE " & INTEGER'IMAGE(B) & 
+                             ", BUT IS " & INTEGER'IMAGE(CC));
+                END IF;
+           END CHECK;
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+                CC := 0;
+                A1 := T1'(4 .. 5 => CALC(2), 6 .. 8 => CALC(4),
+                          OTHERS => 5);
+                CHECK ("A", 5);
+ 
+           END CASE_A;
+ 
+ CASE_B :  BEGIN
+ 
+                CC := 0;
+                A1 := T1'(1 | 4 .. 6 | 3 | 2 => CALC(-1), OTHERS => -2);
+                CHECK ("B", 6);
+ 
+           END CASE_B;
+ 
+ CASE_C :  BEGIN
+ 
+                CC := 0;
+                A1 := T1'(1 | 3 | 5 | 7 .. 9 => -1, OTHERS => CALC(-2));
+                CHECK ("C", 4);
+ 
+           END CASE_C;
+ 
+ CASE_D :  BEGIN
+ 
+                CC := 0;
+                A2 := T2'(4 .. 6 | 8 | 2 .. 3 => (1 .. 2 => CALC(1)),
+                          OTHERS => (1 .. 2 => -1));
+                CHECK ("D", 12);
+ 
+           END CASE_D;
+ 
+ CASE_E : BEGIN
+ 
+                CC := 0;
+                A3 := T3'(1 .. 2 => (2 | 4 | 6 .. 8 => CALC(-1),
+                                     OTHERS => -2));
+                CHECK ("E", 10);
+ 
+           END CASE_E;
+ 
+ CASE_F :  BEGIN
+ 
+                CC := 0;
+                A4 := T4'(7 .. 8 | 3 .. 5 => 
+                           (1 | 2 | 4 | 6 .. 8 => CALC(1), OTHERS => -2),
+                          OTHERS => (OTHERS => -2));
+                CHECK ("F", 30);
+ 
+           END CASE_F;
+ 
+ CASE_G :  BEGIN
+ 
+                CC := 0;
+                A4 := T4'(5 .. 8 | 3 | 1 => (7 | 1 .. 5 | 8 => -1,
+                                             OTHERS => CALC(-2)),
+                          OTHERS => (OTHERS => CALC(-2)));
+                CHECK ("G", 22);
+ 
+           END CASE_G;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43210A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43211a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43211a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43211a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C43211A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF A BOUND IN A NON-NULL
+ -- RANGE OF A NON-NULL AGGREGATE DOES NOT BELONG TO THE INDEX SUBTYPE.
+ 
+ -- EG  02/06/84
+ -- EG  05/08/85
+ -- EDS 07/15/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43211A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43211A","CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
+                     "BOUND IN A NON-NULL RANGE OF A NON-NULL "    &
+                     "AGGREGATE DOES NOT BELONG TO THE INDEX "     &
+                     "SUBTYPE");
+ 
+      DECLARE
+ 
+           SUBTYPE ST IS INTEGER RANGE 4 .. 8;
+           TYPE BASE IS ARRAY(ST RANGE <>, ST RANGE <>) OF INTEGER;
+           SUBTYPE T IS BASE(5 .. 7, 5 .. 7);
+ 
+           A    : T;
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+                A := (6 .. 8 => (4 .. 6 => 0));
+                IF A /= (6 .. 8 => (4 .. 6 => 0)) THEN
+                     FAILED ("CASE A : INCORRECT VALUES");
+                END IF;
+ 
+           EXCEPTION
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED: CASE A");
+ 
+           END CASE_A;
+ 
+ CASE_B :  BEGIN
+ 
+                A := (6 .. IDENT_INT(8) =>
+                      (IDENT_INT(4) .. 6 => 1));
+                IF A /= (6 .. IDENT_INT(8) =>
+                         (IDENT_INT(4) .. 6 => 1)) THEN
+                     FAILED ("CASE B : INCORRECT VALUES");
+                END IF;
+ 
+           EXCEPTION
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED: CASE B");
+ 
+           END CASE_B;
+ 
+ CASE_C :  BEGIN
+ 
+                A := (7 .. 9 => (5 .. 7 => IDENT_INT(2)));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE C " & 
+                 INTEGER'IMAGE(A(IDENT_INT(7),7)));
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED: CASE C");
+ 
+           END CASE_C;
+ 
+ CASE_D :  BEGIN
+ 
+                A := (5 .. 7 => (3 .. 5 => IDENT_INT(3)));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE D " &
+                 INTEGER'IMAGE(A(7,IDENT_INT(5))));
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED: CASE D");
+ 
+           END CASE_D;
+ 
+ CASE_E :  BEGIN
+ 
+                A := (7 .. IDENT_INT(9) => (5 .. 7 => IDENT_INT(4)));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE E " &
+                 INTEGER'IMAGE(A(IDENT_INT(7),7)));
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE E : EXCEPTION RAISED");
+ 
+           END CASE_E;
+ 
+ CASE_F :  BEGIN
+ 
+                A := (5 .. 7 => (IDENT_INT(3) .. 5 => IDENT_INT(5)));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE F " &
+                 INTEGER'IMAGE(A(7,IDENT_INT(5))));
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED: CASE F");
+ 
+           END CASE_F;
+ 
+ CASE_G :  BEGIN
+ 
+                A := (7 .. 8 => (5 .. 7 => IDENT_INT(6)),
+               9 => (5 .. 7 => IDENT_INT(6)));
+                FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE G " &
+                 INTEGER'IMAGE(A(7,IDENT_INT(7))));
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED: CASE G");
+ 
+           END CASE_G;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43211A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43212a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43212a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43212a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43212a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,154 ----
+ -- C43212A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL SUBAGGREGATES FOR A
+ -- PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS.
+ 
+ -- EG  02/06/1984
+ -- JBG 3/30/84
+ -- JRK 4/18/86   CORRECTED ERROR TO ALLOW CONSTRAINT_ERROR TO BE
+ --               RAISED EARLIER.
+ -- EDS 7/15/98   AVOID OPTIMIZATION.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43212A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C43212A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " &
+                       "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO "  &
+                       "NOT HAVE THE SAME BOUNDS");
+ 
+      DECLARE
+ 
+           TYPE CHOICE_INDEX IS (H, I);
+           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+ 
+           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+ 
+           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                                              RETURN INTEGER IS
+           BEGIN
+                CNTR(A) := CNTR(A) + 1;
+                RETURN IDENT_INT(B);
+           END CALC;
+ 
+      BEGIN
+ 
+ CASE_1 :  DECLARE
+ 
+                TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                                                    OF INTEGER;
+ 
+                A1 : T(1 .. 3, 2 .. 5) := (OTHERS => (OTHERS => 0));
+ 
+           BEGIN
+ 
+                CNTR := (CHOICE_INDEX => 0);
+                A1 := (1 => (CALC(H,2) .. CALC(I,5) => -4),
+                       2 => (CALC(H,3) .. CALC(I,6) => -5),
+                       3 => (CALC(H,2) .. CALC(I,5) => -3));
+                FAILED ("CASE 1 : CONSTRAINT_ERROR NOT RAISED" &
+                        INTEGER'IMAGE(A1(1,5)) );
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     IF CNTR(H) < 2 AND CNTR(I) < 2 THEN
+                          FAILED ("CASE 1 : BOUNDS OF SUBAGGREGATES " &
+                                  "NOT DETERMINED INDEPENDENTLY");
+                     END IF;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE 1 : WRONG EXCEPTION RAISED");
+ 
+           END CASE_1;
+ 
+ CASE_1A : DECLARE
+ 
+                TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                                                   OF INTEGER;
+ 
+                A1 : T(1 .. 3, 2 .. 3) := (1 .. 3 => (2 .. 3 => 1));
+ 
+           BEGIN
+ 
+                IF (1 .. 2 => (IDENT_INT(3) .. IDENT_INT(4) => 0),
+                         3 => (1, 2)) = A1 THEN
+                     BEGIN
+                          COMMENT(" IF SHOULD GENERATE CONSTRAINT_ERROR " & 
+                                  INTEGER'IMAGE(A1(1,2)) );
+                     EXCEPTION
+                          WHEN OTHERS =>
+                             FAILED ("CASE 1A : CONSTRAINT_ERROR NOT RAISED");
+                     END;
+                END IF;
+                     FAILED ("CASE 1A : CONSTRAINT_ERROR NOT RAISED");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE 1A : WRONG EXCEPTION RAISED");
+ 
+           END CASE_1A;
+ 
+ CASE_2 :  DECLARE
+ 
+                TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                                                    OF INTEGER;
+ 
+                A2 : T(1 .. 3, IDENT_INT(4) .. 2);
+ 
+           BEGIN
+ 
+                CNTR := (CHOICE_INDEX => 0);
+                A2 := (1 => (CALC(H,5) .. CALC(I,3) => -4),
+                       3 => (CALC(H,4) .. CALC(I,2) => -5),
+                       2 => (CALC(H,4) .. CALC(I,2) => -3));
+                FAILED ("CASE 2 : CONSTRAINT_ERROR NOT RAISED " &
+                        INTEGER'IMAGE(IDENT_INT(A2'FIRST(1))));
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     IF CNTR(H) < 2 AND CNTR(I) < 2 THEN
+                          FAILED ("CASE 2 : BOUNDS OF SUBAGGREGATES " &
+                                  "NOT DETERMINED INDEPENDENTLY");
+                     END IF;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE 2 : WRONG EXCEPTION RAISED");
+ 
+           END CASE_2;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43212A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43212c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43212c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43212c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43212c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C43212C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL SUBAGGREGATES FOR
+ -- A PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS.
+ -- ADDITIONAL CASES FOR THE THIRD DIMENSION AND FOR THE NULL ARRAYS.
+ 
+ -- PK  02/21/84
+ -- EG  05/30/84
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE C43212C IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+ 
+ BEGIN
+ 
+      TEST("C43212C","CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " &
+                     "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO "  &
+                     "NOT HAVE THE SAME BOUNDS");
+ 
+      DECLARE
+           TYPE A3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
+                          OF INTEGER;
+      BEGIN
+           IF A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
+                       (1 .. IDENT_INT(2) => IDENT_INT(1))),
+                      ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
+                       (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 
+             =
+              A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
+                       (1 .. IDENT_INT(2) => IDENT_INT(1))),
+                      ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
+                       (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 
+           THEN
+                 FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
+           END IF;
+           FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => 
+                FAILED ("A3 - WRONG EXCEPTION RAISED");
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE B3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
+                          OF INTEGER;
+ 
+      BEGIN
+ 
+           IF B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
+                       (2 .. IDENT_INT(1) => IDENT_INT(1))),
+                      ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
+                       (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 
+             =
+              B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
+                       (2 .. IDENT_INT(1) => IDENT_INT(1))),
+                      ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
+                       (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 
+           THEN
+                 FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
+           END IF;
+           FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS => 
+                 FAILED ("B3 - WRONG EXCEPTION RAISED");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43212C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C43214A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => ""), CHECK
+ -- THAT CONSTRAINT_ERROR IS RAISED IF F..G IS NON-NULL AND
+ -- F OR G DO NOT BELONG TO THE INDEX SUBTYPE.
+ 
+ -- EG  02/10/1984
+ -- JBG 12/6/84
+ -- EDS 07/15/98     AVOID OPTIMIZATION
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43214A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43214A", "FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM " &
+                      "(F..G => """"), CHECK THAT CONSTRAINT ERROR "  &
+                      "IS RAISED IF F..G IS NON-NULL AND NOT IN THE " &
+                      "INDEX SUBTYPE");
+ 
+      DECLARE
+ 
+           SUBTYPE STA IS INTEGER RANGE 4 .. 7;
+           TYPE TA IS ARRAY(STA RANGE 5 .. 6, 
+                            STA RANGE 6 .. IDENT_INT(4)) OF CHARACTER;
+ 
+           A : TA := (5 .. 6 => "");
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+                IF (6 .. IDENT_INT(8) => "") = A THEN
+                     FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED");
+                END IF;
+                FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED - 2");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE A : WRONG EXCEPTION RAISED");
+ 
+           END CASE_A;
+ 
+ CASE_B :  BEGIN
+ 
+                A := (IDENT_INT(3) .. 4 => "");
+                FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED");
+                BEGIN
+                   FAILED("ATTEMPT TO USE A " &
+                          CHARACTER'VAL(IDENT_INT(CHARACTER'POS(
+                             A(A'FIRST(1), A'FIRST(2)) ))) );
+                EXCEPTION
+                   WHEN OTHERS =>
+                      FAILED("CONSTRAINT_ERROR NOT RAISED AT PROPER PLACE");
+                END;
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE B : WRONG EXCEPTION RAISED");
+ 
+           END CASE_B;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43214A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C43214B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+ -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+ 
+ -- EG  02/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43214B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43214B", "SUBPROGRAM WITH CONSTRAINED ARRAY FORMAL " &
+                      "PARAMETER");
+ 
+      BEGIN
+ 
+ CASE_A :  BEGIN
+ 
+ --             COMMENT ("CASE A1 : SUBPROGRAM WITH CONSTRAINED " &
+ --                      "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
+ 
+      CASE_A1 : DECLARE
+ 
+                     SUBTYPE STA1 IS STRING(IDENT_INT(11) .. 15);
+ 
+                     PROCEDURE PROC1 (A : STA1) IS
+                     BEGIN
+                          IF A'FIRST /= 11 THEN
+                               FAILED ("CASE 1 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A'LAST /= 15 THEN
+                               FAILED ("CASE 1 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A /= "ABCDE" THEN
+                               FAILED ("CASE 1 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                          END IF;
+                     END;
+ 
+                BEGIN
+ 
+                     PROC1 ("ABCDE");
+ 
+                END CASE_A1;
+ 
+ --             COMMENT ("CASE A2 : SUBPROGRAM WITH CONSTRAINED " &
+ --                      "TWO-DIMENSIONAL ARRAY FORMAL PARAMETER");
+ 
+      CASE_A2 : DECLARE
+ 
+                     TYPE TA IS ARRAY (11 .. 12, 10 .. 11) OF CHARACTER;
+ 
+                     PROCEDURE PROC1 (A : TA) IS
+                     BEGIN
+                          IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
+                               FAILED ("CASE 2 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A'LAST(1) /= 12 OR A'LAST(2) /= 11 THEN
+                               FAILED ("CASE 2 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A /= ("AB", "CD") THEN
+                               FAILED ("CASE 2 : ARRAY DOES NOT " &
+                                       "CONTAIN THE CORRECT VALUES");
+                          END IF;
+                     END;
+ 
+                BEGIN
+ 
+                     PROC1 (("AB", "CD"));
+ 
+                END CASE_A2;
+ 
+           END CASE_A;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43214B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C43214C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+ -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+ 
+ -- EG  02/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43214C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43214C", "CONSTRAINED ARRAY FORMAL GENERIC " &
+                      "PARAMETER");
+ 
+      BEGIN
+ 
+ CASE_B :  DECLARE
+ 
+                SUBTYPE STB IS STRING(5 .. 8);
+ 
+                GENERIC
+                     B1 : STB;
+                PROCEDURE PROC1;
+ 
+                PROCEDURE PROC1 IS
+                BEGIN
+                     IF B1'FIRST /= 5 THEN
+                          FAILED ("LOWER BOUND INCORRECT");
+                     ELSIF B1'LAST /= 8 THEN
+                          FAILED ("UPPER BOUND INCORRECT");
+                     ELSIF B1 /= "ABCD" THEN
+                          FAILED ("ARRAY DOES NOT " &
+                                  "CONTAIN THE CORRECT VALUES");
+                     END IF;
+                END;
+ 
+                PROCEDURE PROC2 IS NEW PROC1 ("ABCD");
+ 
+           BEGIN
+ 
+                PROC2;
+ 
+           END CASE_B;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43214C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C43214D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+ -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+ 
+ -- EG  02/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43214D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43214D", "CONSTRAINED FUNCTION RESULT TYPE");
+ 
+      BEGIN
+ 
+ CASE_C :  DECLARE
+ 
+                TYPE TC IS ARRAY (INTEGER RANGE -1 .. 0, 
+                                  IDENT_INT(7) .. 9) OF CHARACTER;
+ 
+                FUNCTION FUN1 (A : INTEGER) RETURN TC IS
+                BEGIN
+                     RETURN ("ABC", "DEF");
+                END;
+ 
+           BEGIN
+ 
+                IF FUN1(5)'FIRST(1) /= -1 THEN
+                     FAILED ("LOWER BOUND INCORRECT " &
+                             "FOR 'FIRST(1)");
+                ELSIF FUN1(5)'FIRST(2) /= 7 THEN
+                     FAILED ("LOWER BOUND INCORRECT " &
+                             "FOR 'FIRST(2)");
+                ELSIF FUN1(5)'LAST(1) /= 0 THEN
+                     FAILED ("UPPER BOUND INCORRECT " &
+                             "FOR 'LAST(1)");
+                ELSIF FUN1(5)'LAST(2) /= 9 THEN
+                     FAILED ("UPPER BOUND INCORRECT " &
+                             "FOR 'LAST(2)");
+                ELSIF FUN1(5) /= ("ABC", "DEF") THEN
+                     FAILED ("FUNCTION DOES NOT " &
+                             "RETURN THE CORRECT VALUES");
+                END IF;
+ 
+           END CASE_C;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43214D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- C43214E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+ -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+ 
+ -- EG  02/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43214E IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43214E", "INITIALIZATION OF CONSTRAINED ARRAY");
+ 
+      BEGIN
+ 
+ CASE_D :  BEGIN
+ 
+ --             COMMENT ("CASE D1 : INITIALIZATION OF CONSTRAINED " &
+ --                      "ARRAY CONSTANT");
+ 
+      CASE_D1 : DECLARE
+ 
+                     D1 : CONSTANT STRING(11 .. 13) := "ABC";
+ 
+                BEGIN
+ 
+                     IF D1'FIRST /= 11 THEN
+                          FAILED ("CASE 1 : LOWER BOUND INCORRECT");
+                     ELSIF D1'LAST /= 13 THEN
+                          FAILED ("CASE 1 : UPPER BOUND INCORRECT");
+                     ELSIF D1 /= "ABC" THEN
+                               FAILED ("CASE 1 : ARRAY DOES NOT " &
+                                       "CONTAIN THE CORRECT VALUES");
+                     END IF;
+ 
+                END CASE_D1;
+ 
+ --             COMMENT ("CASE D2 : INITIALIZATION OF CONSTRAINED " &
+ --                      "ARRAY VARIABLE");
+ 
+      CASE_D2 : DECLARE
+ 
+                     D2 : STRING(11 .. 13) := "ABC";
+ 
+                BEGIN
+ 
+                     IF D2'FIRST /= 11 THEN
+                          FAILED ("CASE 2 : LOWER BOUND INCORRECT");
+                     ELSIF D2'LAST /= 13 THEN
+                          FAILED ("CASE 2 : UPPER BOUND INCORRECT");
+                     ELSIF D2 /= "ABC" THEN
+                          FAILED ("CASE 2 : INCORRECT VALUES");
+                     END IF;
+ 
+                END CASE_D2;
+ 
+ --             COMMENT ("CASE D3 : INITIALIZATION OF CONSTRAINED " &
+ --                      "ARRAY FORMAL PARAMETER OF A SUBPROGRAM");
+ 
+      CASE_D3 : DECLARE
+ 
+                     SUBTYPE STD3 IS STRING(IDENT_INT(5) .. 7);
+ 
+                     PROCEDURE PROC1 (A : STD3 := "ABC") IS
+                     BEGIN
+                          IF A'FIRST /= 5 THEN
+                               FAILED ("CASE 3 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A'LAST /= 7 THEN
+                               FAILED ("CASE 3 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF A /= "ABC" THEN
+                               FAILED ("CASE 3 : INCORRECT VALUES");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                PROC1;
+ 
+                END CASE_D3;
+ 
+ --             COMMENT ("CASE D4 : INITIALIZATION OF CONSTRAINED " &
+ --                      "ARRAY FORMAL PARAMETER OF A GENERIC UNIT");
+ 
+      CASE_D4 : DECLARE
+ 
+                     SUBTYPE STD4 IS STRING(5 .. 8);
+ 
+                     GENERIC
+                          D4 : STD4 := "ABCD";
+                     PROCEDURE PROC1;
+ 
+                     PROCEDURE PROC1 IS
+                     BEGIN
+                          IF D4'FIRST /= 5 THEN
+                               FAILED ("CASE 4 : LOWER BOUND " &
+                                       "INCORRECT");
+                          ELSIF D4'LAST /= 8 THEN
+                               FAILED ("CASE 4 : UPPER BOUND " &
+                                       "INCORRECT");
+                          ELSIF D4 /= "ABCD" THEN
+                               FAILED ("CASE 4 : INCORRECT VALUES");
+                          END IF;
+                     END PROC1;
+ 
+                     PROCEDURE PROC2 IS NEW PROC1;
+ 
+                BEGIN
+ 
+                     PROC2;
+ 
+                END CASE_D4;
+ 
+           END CASE_D;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43214E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43214f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43214f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- C43214F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+ -- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+ 
+ -- EG  02/10/84
+ -- JBG 3/30/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C43214F IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C43214F", "ARRAY COMPONENT EXPRESSION OF AN ENCLOSING " &
+                      "AGGREGATE");
+ 
+      BEGIN
+ 
+ CASE_E :  BEGIN
+ 
+ --             COMMENT ("CASE E1 : ARRAY COMPONENT EXPRESSION OF " &
+ --                      "AN ENCLOSING ARRAY AGGREGATE");
+ 
+      CASE_E1 : DECLARE
+ 
+                     TYPE TE2 IS ARRAY(1 .. 2) OF 
+                                 STRING(IDENT_INT(3) .. 5);
+ 
+                     E1 : TE2;
+ 
+                BEGIN
+ 
+                     E1 := (1 .. 2 => "ABC");
+                     IF (E1'FIRST /= 1 OR E1'LAST /= 2) OR ELSE
+                        (E1(1)'FIRST /= 3 OR E1(1)'LAST /= 5 OR
+                         E1(2)'FIRST /= 3 OR E1(2)'LAST /= 5) THEN
+                          FAILED ("CASE 1 : INCORRECT BOUNDS");
+                     ELSIF E1 /= (1 .. 2 => "ABC") THEN
+                          FAILED ("CASE 1 : ARRAY DOES NOT " &
+                                  "CONTAIN THE CORRECT VALUES");
+                     END IF;
+ 
+                END CASE_E1;
+ 
+ --             COMMENT ("CASE E2 : ARRAY COMPONENT EXPRESSION OF " &
+ --                      "AN ENCLOSING RECORD AGGREGATE");
+ 
+      CASE_E2 : DECLARE
+ 
+                     TYPE TER IS
+                          RECORD
+                               REC : STRING(3 .. 5);
+                          END RECORD;
+ 
+                     E2 : TER;
+ 
+                BEGIN
+ 
+                     E2 := (REC => "ABC");
+                     IF E2.REC'FIRST /= 3 OR E2.REC'LAST /= 5 THEN
+                          FAILED ("CASE 2 : INCORRECT BOUNDS");
+                     ELSIF E2.REC /= "ABC" THEN
+                          FAILED ("CASE 2 : ARRAY DOES NOT " &
+                                  "CONTAIN CORRECT VALUES");
+                     END IF;
+ 
+                END CASE_E2;
+ 
+ --             COMMENT ("CASE E3 : NULL LITERAL OF AN ENCLOSING " &
+ --                      "ARRAY AGGREGATE");
+ 
+      CASE_E3 : DECLARE
+ 
+                     TYPE TE2 IS ARRAY(1 .. 2) OF
+                                 STRING(3 .. IDENT_INT(2));
+ 
+                     E3 : TE2;
+ 
+                BEGIN
+ 
+                     E3 := (1 .. 2 => "");
+                     IF (E3'FIRST /= 1 OR E3'LAST /= 2) OR ELSE
+                        (E3(1)'FIRST /= 3 OR E3(1)'LAST /= 2 OR
+                         E3(2)'FIRST /= 3 OR E3(2)'LAST /= 2) THEN
+                          FAILED ("CASE 3 : INCORRECT BOUND");
+                     ELSIF E3 /= (1 .. 2 => "") THEN
+                          FAILED ("CASE 3 : ARRAY DOES NOT CONTAIN " &
+                                  "THE CORRECT VALUES");
+                     END IF;
+ 
+                END CASE_E3;
+ 
+ --             COMMENT ("CASE E4 : ARRAY COMPONENT EXPRESSION OF "  &
+ --                      "AN ENCLOSING RECORD AGGREGATE THAT HAS A " &
+ --                      "DISCRIMINANT AND THE DISCRIMINANT DETER"   &
+ --                      "MINES THE BOUNDS OF THE COMPONENT");
+ 
+      CASE_E4 : DECLARE
+ 
+                     SUBTYPE TEN IS INTEGER RANGE 1 .. 10;
+                     TYPE TER (A : TEN) IS
+                          RECORD
+                               REC : STRING(3 .. A);
+                          END RECORD;
+ 
+                     E4 : TER(5);
+ 
+                BEGIN
+ 
+                     E4 := (REC => "ABC", A => 5);
+                     IF E4.REC'FIRST /= 3 OR E4.REC'LAST /= 5 THEN
+                          FAILED ("CASE 4 : INCORRECT BOUNDS");
+                     ELSIF E4.REC /= "ABC" THEN
+                          FAILED ("CASE 4 : ARRAY DOES NOT CONTAIN " &
+                                  "CORRECT VALUES");
+                     END IF;
+ 
+                END CASE_E4;
+ 
+           END CASE_E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43214F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43215a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43215a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43215a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43215a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- C43215A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A POSITIONAL
+ -- ARRAY AGGREGATE WHOSE UPPER BOUND EXCEEDS THE UPPER BOUND
+ -- OF THE INDEX SUBTYPE BUT BELONGS TO THE INDEX BASE TYPE.
+ 
+ -- EG  02/13/84
+ 
+ WITH REPORT;
+ WITH SYSTEM;
+ 
+ PROCEDURE C43215A IS
+ 
+      USE REPORT;
+      USE SYSTEM;
+ 
+ BEGIN
+ 
+      TEST("C43215A","CHECK THAT CONSTRAINT_ERROR IS RAISED "      &
+                     "FOR A POSITIONAL ARRAY AGGREGATE WHOSE "     &
+                     "UPPER BOUND EXCEEDS THE UPPER BOUND OF THE " &
+                     "INDEX SUBTYPE BUT BELONGS TO THE INDEX "     &
+                     "BASE TYPE");
+ 
+      BEGIN
+ 
+ CASE_A :  DECLARE
+ 
+                LOWER_BOUND : CONSTANT  := MAX_INT-3;
+                UPPER_BOUND : CONSTANT  := MAX_INT-1;
+ 
+                TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND;
+ 
+                TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER;
+ 
+                A1 : TA(STA);
+                OK : EXCEPTION;
+ 
+                FUNCTION FUN1 RETURN TA IS
+                BEGIN
+                     RETURN (1, 2, 3, 4);
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                     BEGIN
+                          COMMENT ("CASE A : CONSTRAINT_ERROR RAISED");
+                          RAISE OK;
+                     END;
+                     WHEN OTHERS =>
+                     BEGIN
+                          FAILED ("CASE A : EXCEPTION RAISED IN FUN1");
+                          RAISE OK;
+                     END;
+                END FUN1;
+ 
+           BEGIN
+ 
+                A1 := FUN1;
+                FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED");
+ 
+           EXCEPTION
+ 
+                WHEN OK =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE A : EXCEPTION RAISED");
+ 
+           END CASE_A;
+ 
+ CASE_B :  DECLARE
+ 
+                TYPE ENUM IS (A, B, C, D);
+ 
+                SUBTYPE STB IS ENUM RANGE A .. C;
+ 
+                TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
+ 
+                B1 : TB(STB);
+                OK : EXCEPTION;
+ 
+                FUNCTION FUN1 RETURN TB IS
+                BEGIN
+                     RETURN (1, 2, 3, 4);
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                     BEGIN
+                          COMMENT ("CASE B : CONSTRAINT_ERROR RAISED");
+                          RAISE OK;
+                     END;
+                     WHEN OTHERS =>
+                     BEGIN
+                          FAILED ("CASE B : EXCEPTION RAISED IN FUN1");
+                          RAISE OK;
+                     END;
+                END FUN1;
+ 
+           BEGIN
+ 
+                B1 := FUN1;
+                FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED");
+ 
+           EXCEPTION
+ 
+                WHEN OK =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE B : EXCEPTION RAISED");
+ 
+           END CASE_B;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43215A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43215b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43215b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43215b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43215b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C43215B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE UPPER BOUND
+ -- OF A POSITIONAL AGGREGATE DOES NOT BELONG TO THE INDEX BASE TYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- EG  02/13/84
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT;
+ WITH SYSTEM;
+ 
+ PROCEDURE C43215B IS
+ 
+      USE REPORT;
+      USE SYSTEM;
+ 
+ BEGIN
+ 
+      TEST("C43215B","CHECK THAT CONSTRAINT_ERROR IS RAISED "   &
+                     "WHEN THE UPPER BOUND OF A POSITIONAL ARRAY " &
+                     "AGGREGATE DOES NOT BELONG TO THE INDEX "     &
+                     "BASE TYPE");
+ 
+      BEGIN
+ 
+ CASE_A :  DECLARE
+ 
+                LOWER_BOUND : CONSTANT := MAX_INT-3;
+                UPPER_BOUND : CONSTANT := MAX_INT-1;
+ 
+                TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND;
+ 
+                TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER;
+ 
+                A1 : TA(STA);
+                OK : EXCEPTION;
+ 
+                FUNCTION FUN1 RETURN TA IS
+                BEGIN
+                     RETURN (1, 2, 3, 4, 5);
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                     BEGIN
+                          COMMENT ("CASE A : CONSTRAINT_ERROR RAISED");
+                          RAISE OK;
+                     END;
+                     WHEN OTHERS =>
+                     BEGIN
+                          FAILED ("CASE A : EXCEPTION RAISED IN FUN1");
+                          RAISE OK;
+                     END;
+                END FUN1;
+ 
+           BEGIN
+ 
+                A1 := FUN1;
+                FAILED ("CASE A : CONSTRAINT OR NUMERIC ERROR WAS " &
+                        "NOT RAISED");
+ 
+           EXCEPTION
+ 
+                WHEN OK =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE A : WRONG EXCEPTION RAISED");
+ 
+           END CASE_A;
+ 
+ CASE_B :  DECLARE
+ 
+                TYPE ENUM IS (A, B, C, D);
+ 
+                SUBTYPE STB IS ENUM RANGE A .. C;
+ 
+                TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
+ 
+                B1 : TB(STB);
+                OK : EXCEPTION;
+ 
+                FUNCTION FUN1 RETURN TB IS
+                BEGIN
+                     RETURN (1, 2, 3, 4, 5);
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                     BEGIN
+                          COMMENT ("CASE B : CONSTRAINT_ERROR RAISED");
+                          RAISE OK;
+                     END;
+                     WHEN OTHERS =>
+                     BEGIN
+                          FAILED ("CASE B : EXCEPTION RAISED IN FUN1");
+                          RAISE OK;
+                     END;
+                END FUN1;
+ 
+           BEGIN
+ 
+                B1 := FUN1;
+                FAILED ("CASE B : CONSTRAINT ERROR WAS NOT RAISED");
+ 
+           EXCEPTION
+ 
+                WHEN OK =>
+                     NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("CASE B : WRONG EXCEPTION RAISED");
+ 
+           END CASE_B;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C43215B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43222a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43222a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43222a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43222a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,49 ----
+ -- C43222A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN ARRAY AGGREGATE NEED NOT BE RESOLVABLE TO A
+ --     CONSTRAINED SUBTYPE.
+ 
+ -- HISTORY:
+ --     DHH 08/12/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43222A IS
+ 
+ BEGIN
+      TEST("C43222A", "CHECK THAT AN ARRAY AGGREGATE NEED NOT BE " &
+                      "RESOLVABLE TO A CONSTRAINED SUBTYPE");
+ 
+      DECLARE
+           TYPE A IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           B : BOOLEAN := (1, 2, 3) = A'(1, 2, 3);
+      BEGIN
+           IF IDENT_BOOL(B) /= IDENT_BOOL(TRUE) THEN
+                FAILED("INITIALIZATION FAILURE");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C43222A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43224a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43224a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c43224a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c43224a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C43224A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A NON-STATIC CHOICE OF AN ARRAY AGGREGATE CAN BE A
+ --     'RANGE ATTRIBUTE.
+ 
+ -- HISTORY:
+ --     DHH 08/15/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C43224A IS
+ 
+      M, O : INTEGER := IDENT_INT(2);
+      N : INTEGER := IDENT_INT(3);
+ 
+      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+      TYPE D3_ARR IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>,
+                           INTEGER RANGE <>) OF INTEGER;
+ 
+      SUBTYPE ARR1 IS ARR(IDENT_INT(2) .. IDENT_INT(3));
+      SUBTYPE ARR2 IS D3_ARR(1 .. M, 1 .. N, 1 ..O);
+ 
+      SUB : ARR1;
+      SUB1 : ARR2;
+ 
+      PROCEDURE PROC(ARRY : IN OUT ARR) IS
+      BEGIN
+           ARRY := (ARR1'RANGE => IDENT_INT(7));
+           IF ARRY(IDENT_INT(ARRY'FIRST)) /= IDENT_INT(7) THEN
+                FAILED("RANGE NOT INITIALIZED - 1");
+           END IF;
+      END PROC;
+ 
+      PROCEDURE PROC1(ARRY : IN OUT D3_ARR) IS
+      BEGIN
+           ARRY := (ARR2'RANGE(1) => (ARRY'RANGE(2) =>
+                   (ARRY'RANGE(3) => IDENT_INT(7))));
+ 
+           IF ARRY(IDENT_INT(1), IDENT_INT(2), IDENT_INT(1)) /=
+                   IDENT_INT(7) THEN
+                FAILED("RANGE NOT INITIALIZED - 2");
+           END IF;
+      END PROC1;
+ 
+ BEGIN
+      TEST("C43224A", "CHECK THAT A NON-STATIC CHOICE OF AN ARRAY " &
+                      "AGGREGATE CAN BE A 'RANGE ATTRIBUTE");
+ 
+      PROC(SUB);
+      PROC1(SUB1);
+ 
+      RESULT;
+ END C43224A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c433001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c433001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c433001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c433001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,303 ----
+ -- C433001.A
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE
+ --     Check that an others choice is allowed in an array aggregate whose
+ --     applicable index constraint is dynamic. (This was an extension to
+ --     Ada 83). Check that index choices are within the applicable index
+ --     constraint for array aggregates with others choices.
+ --
+ -- TEST DESCRIPTION
+ --     In this test, we declare several unconstrained array types, and
+ --     several dynamic subtypes. We then test a variety of cases of using
+ --     appropriate aggregates. Some cases expect to raise Constraint_Error.
+ --
+ -- HISTORY:
+ --      16 DEC 1999   RLB   Initial Version.
+ --      20 JAN 2009   RLB   Corrected error messages.
+ 
+ with Report;
+ procedure C433001 is
+ 
+     type Color_Type is (Red, Orange, Yellow, Green, Blue, Indigo, Violet);
+ 
+     type Array_1 is array (Positive range <>) of Integer;
+ 
+     subtype Sub_1_1 is Array_1 (Report.Ident_Int(1) .. Report.Ident_Int(3));
+     subtype Sub_1_2 is Array_1 (Report.Ident_Int(3) .. Report.Ident_Int(5));
+     subtype Sub_1_3 is Array_1 (Report.Ident_Int(5) .. Report.Ident_Int(9));
+ 
+     type Array_2 is array (Color_Type range <>) of Integer;
+ 
+     subtype Sub_2_1 is Array_2 (Color_Type'Val(Report.Ident_Int(0)) ..
+                                 Color_Type'Val(Report.Ident_Int(2)));
+                                                  -- Red .. Yellow
+     subtype Sub_2_2 is Array_2 (Color_Type'Val(Report.Ident_Int(3)) ..
+                                 Color_Type'Val(Report.Ident_Int(6)));
+                                                  -- Green .. Violet
+     type Array_3 is array (Color_Type range <>, Positive range <>) of Integer;
+ 
+     subtype Sub_3_1 is Array_3 (Color_Type'Val(Report.Ident_Int(0)) ..
+                                 Color_Type'Val(Report.Ident_Int(2)),
+                                 Report.Ident_Int(3) .. Report.Ident_Int(5));
+                                                  -- Red .. Yellow, 3 .. 5
+     subtype Sub_3_2 is Array_3 (Color_Type'Val(Report.Ident_Int(1)) ..
+                                 Color_Type'Val(Report.Ident_Int(3)),
+                                 Report.Ident_Int(6) .. Report.Ident_Int(8));
+                                                  -- Orange .. Green, 6 .. 8
+ 
+     procedure Check_1 (Obj : Array_1; Low, High : Integer;
+                        First_Component, Second_Component,
+                            Last_Component : Integer;
+                        Test_Case : Character) is
+     begin
+         if Obj'First /= Low then
+            Report.Failed ("Low bound incorrect (" & Test_Case & ")");
+         end if;
+         if Obj'Last /= High then
+            Report.Failed ("High bound incorrect (" & Test_Case & ")");
+         end if;
+         if Obj(Low) /= First_Component then
+            Report.Failed ("First Component incorrect (" & Test_Case & ")");
+         end if;
+         if Obj(Low+1) /= Second_Component then
+            Report.Failed ("Second Component incorrect (" & Test_Case & ")");
+         end if;
+         if Obj(High) /= Last_Component then
+            Report.Failed ("Last Component incorrect (" & Test_Case & ")");
+         end if;
+     end Check_1;
+ 
+     procedure Check_2 (Obj : Array_2; Low, High : Color_Type;
+                        First_Component, Second_Component,
+                            Last_Component : Integer;
+                        Test_Case : Character) is
+     begin
+         if Obj'First /= Low then
+            Report.Failed ("Low bound incorrect (" & Test_Case & ")");
+         end if;
+         if Obj'Last /= High then
+            Report.Failed ("High bound incorrect (" & Test_Case & ")");
+         end if;
+         if Obj(Low) /= First_Component then
+            Report.Failed ("First Component incorrect (" & Test_Case & ")");
+         end if;
+         if Obj(Color_Type'Succ(Low)) /= Second_Component then
+            Report.Failed ("Second Component incorrect (" & Test_Case & ")");
+         end if;
+         if Obj(High) /= Last_Component then
+            Report.Failed ("Last Component incorrect (" & Test_Case & ")");
+         end if;
+     end Check_2;
+ 
+     procedure Check_3 (Test_Obj, Check_Obj : Array_3;
+                        Low_1, High_1 : Color_Type;
+                        Low_2, High_2 : Integer;
+                        Test_Case : Character) is
+     begin
+         if Test_Obj'First(1) /= Low_1 then
+            Report.Failed ("Low bound for dimension 1 incorrect (" &
+                 Test_Case & ")");
+         end if;
+         if Test_Obj'Last(1) /= High_1 then
+            Report.Failed ("High bound for dimension 1 incorrect (" &
+                 Test_Case & ")");
+         end if;
+         if Test_Obj'First(2) /= Low_2 then
+            Report.Failed ("Low bound for dimension 2 incorrect (" &
+                 Test_Case & ")");
+         end if;
+         if Test_Obj'Last(2) /= High_2 then
+            Report.Failed ("High bound for dimension 2 incorrect (" &
+                 Test_Case & ")");
+         end if;
+         if Test_Obj /= Check_Obj then
+            Report.Failed ("Components incorrect (" & Test_Case & ")");
+         end if;
+     end Check_3;
+ 
+     procedure Subtest_Check_1 (Obj : Sub_1_3;
+                                First_Component, Second_Component,
+                                         Last_Component : Integer;
+                                Test_Case : Character) is
+     begin
+         Check_1 (Obj, 5, 9, First_Component, Second_Component, Last_Component,
+                  Test_Case);
+     end Subtest_Check_1;
+ 
+     procedure Subtest_Check_2 (Obj : Sub_2_2;
+                                First_Component, Second_Component,
+                                         Last_Component : Integer;
+                                Test_Case : Character) is
+     begin
+         Check_2 (Obj, Green, Violet, First_Component, Second_Component,
+                  Last_Component, Test_Case);
+     end Subtest_Check_2;
+ 
+     procedure Subtest_Check_3 (Obj : Sub_3_2;
+                                Test_Case : Character) is
+     begin
+         Check_3 (Obj, Obj, Orange, Green, 6, 8, Test_Case);
+     end Subtest_Check_3;
+ 
+ begin
+ 
+     Report.Test ("C433001",
+                  "Check that an others choice is allowed in an array " &
+                  "aggregate whose applicable index constraint is dynamic. " &
+                  "Also check index choices are within the applicable index " &
+                  "constraint for array aggregates with others choices");
+ 
+     -- Check with a qualified expression:
+     Check_1 (Sub_1_1'(2, 3, others => 4), Low => 1, High => 3,
+              First_Component => 2, Second_Component => 3, Last_Component => 4,
+              Test_Case => 'A');
+ 
+     Check_2 (Sub_2_1'(1, others => Report.Ident_Int(6)),
+              Low => Red, High => Yellow,
+              First_Component => 1, Second_Component => 6, Last_Component => 6,
+              Test_Case => 'B');
+ 
+     Check_3 (Sub_3_1'((1, others => 3), others => (2, 4, others => 6)),
+              Check_Obj => ((1, 3, 3), (2, 4, 6), (2, 4, 6)),
+              Low_1 => Red, High_1 => Yellow, Low_2 => 3, High_2 => 5,
+              Test_Case => 'C');
+ 
+     -- Check that the others clause does not need to represent any components:
+     Check_1 (Sub_1_2'(5, 6, 8, others => 10), Low => 3, High => 5,
+              First_Component => 5, Second_Component => 6, Last_Component => 8,
+              Test_Case => 'D');
+ 
+     -- Check named choices are allowed:
+     Check_1 (Sub_1_1'(2 => Report.Ident_Int(-1), others => 8),
+              Low => 1, High => 3,
+              First_Component => 8, Second_Component => -1, Last_Component => 8,
+              Test_Case => 'E');
+ 
+     -- Check named choices and formal parameters:
+     Subtest_Check_1 ((6 => 4, 8 => 86, others => 1),
+              First_Component => 1, Second_Component => 4, Last_Component => 1,
+              Test_Case => 'F');
+ 
+     Subtest_Check_2 ((Green => Report.Ident_Int(88), Violet => 89,
+              Indigo => Report.Ident_Int(42), Blue => 0, others => -1),
+              First_Component => 88, Second_Component => 0, Last_Component => 89,
+              Test_Case => 'G');
+ 
+     Subtest_Check_3 ((Yellow => (7 => 0, others => 10), others => (1, 2, 3)),
+              Test_Case => 'H');
+ 
+     -- Check object declarations and assignment:
+     declare
+         Var : Sub_1_2 := (4, 36, others => 86);
+     begin
+         Check_1 (Var, Low => 3, High => 5,
+              First_Component => 4, Second_Component => 36,
+              Last_Component => 86,
+              Test_Case => 'I');
+         Var := (5 => 415, others => Report.Ident_Int(1522));
+         Check_1 (Var, Low => 3, High => 5,
+              First_Component => 1522, Second_Component => 1522,
+              Last_Component => 415,
+              Test_Case => 'J');
+     end;
+ 
+     -- Check positional aggregates that are too long:
+     begin
+         Subtest_Check_2 ((Report.Ident_Int(88), 89, 90, 91, 92, others => 93),
+              First_Component => 88, Second_Component => 89,
+              Last_Component => 91,
+              Test_Case => 'K');
+         Report.Failed ("Constraint_Error not raised by positional " &
+                        "aggregate with too many choices (K)");
+     exception
+         when Constraint_Error => null; -- Expected exception.
+     end;
+ 
+     begin
+         Subtest_Check_3 (((0, others => 10), (2, 3, others => 4),
+              (5, 6, 8, others => 10), (1, 4, 7),  others => (1, 2, 3)),
+              Test_Case => 'L');
+         Report.Failed ("Constraint_Error not raised by positional " &
+                        "aggregate with too many choices (L)");
+     exception
+         when Constraint_Error => null; -- Expected exception.
+     end;
+ 
+     -- Check named aggregates with choices in the index subtype but not in the
+     -- applicable index constraint:
+ 
+     begin
+         Subtest_Check_1 ((5 => Report.Ident_Int(88), 8 => 89,
+              10 => 66, -- 10 not in applicable index constraint
+              others => 93),
+              First_Component => 88, Second_Component => 93,
+              Last_Component => 93,
+              Test_Case => 'M');
+         Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                        "index outside of applicable index constraint (M)");
+     exception
+         when Constraint_Error => null; -- Expected exception.
+     end;
+ 
+     begin
+         Subtest_Check_2 (
+              (Yellow => 23, -- Yellow not in applicable index constraint.
+              Blue => 16, others => 77),
+              First_Component => 77, Second_Component => 16,
+              Last_Component => 77,
+              Test_Case => 'N');
+         Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                        "index outside of applicable index constraint (N)");
+     exception
+         when Constraint_Error => null; -- Expected exception.
+     end;
+ 
+     begin
+         Subtest_Check_3 ((Orange => (0, others => 10),
+              Blue => (2, 3, others => 4), -- Blue not in applicable index cons.
+              others => (1, 2, 3)),
+              Test_Case => 'P');
+         Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                        "index outside of applicable index constraint (P)");
+     exception
+         when Constraint_Error => null; -- Expected exception.
+     end;
+ 
+     begin
+         Subtest_Check_3 ((Orange => (6 => 0, others => Report.Ident_Int(10)),
+              Green => (8 => 2, 4 => 3, others => 7),
+                 -- 4 not in applicable index cons.
+              others => (1, 2, 3, others => Report.Ident_Int(10))),
+              Test_Case => 'Q');
+         Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                        "index outside of applicable index constraint (Q)");
+     exception
+         when Constraint_Error => null; -- Expected exception.
+     end;
+ 
+     Report.Result;
+ 
+ end C433001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c44003d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c44003d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c44003d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c44003d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,188 ----
+ -- C44003D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK FOR CORRECT PRECEDENCE OF PREDEFINED AND OVERLOADED
+ --     OPERATIONS ON PREDEFINED TYPE FLOAT, USER-DEFINED TYPES, AND
+ --     ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF TYPE FLOAT.
+ 
+ -- HISTORY:
+ --     RJW 10/13/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C44003D IS
+ 
+ BEGIN
+      TEST ("C44003D", "CHECK FOR CORRECT PRECEDENCE OF PREDEFINED " &
+                       "AND OVERLOADED OPERATIONS ON PREDEFINED TYPE " &
+                       "FLOAT, USER-DEFINED TYPES, AND ONE-DIMEN" &
+                       "SIONAL ARRAYS WITH COMPONENTS OF TYPE FLOAT");
+ 
+ ----- PREDEFINED FLOAT:
+ 
+      DECLARE
+           F1 : FLOAT := 1.0;
+           F2 : FLOAT := 2.0;
+           F5 : FLOAT := 5.0;
+ 
+           FUNCTION "OR" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+           BEGIN
+                RETURN 4.5;
+           END "OR";
+ 
+           FUNCTION "<" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+           BEGIN
+                RETURN 5.5;
+           END "<";
+ 
+           FUNCTION "-" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+           BEGIN
+                RETURN 6.5;
+           END "-";
+ 
+           FUNCTION "+" (RIGHT : FLOAT) RETURN FLOAT IS
+           BEGIN
+                RETURN 7.5;
+           END "+";
+ 
+           FUNCTION "*" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+           BEGIN
+                RETURN 8.5;
+           END "*";
+ 
+           FUNCTION "NOT" (RIGHT : FLOAT) RETURN FLOAT IS
+           BEGIN
+                RETURN 9.5;
+           END "NOT";
+ 
+      BEGIN
+           IF NOT (-ABS F1 + F2 / F1 + F5 ** 2 =  26.0 AND
+                   F1 > 0.0 AND
+                   - F2 * F2 ** 3 = -8.5) THEN
+                FAILED ("INCORRECT RESULT - 1");
+           END IF;
+ 
+           IF (F1 OR NOT F2 < F1 - F5 * F5 ** 3) /= 4.5 THEN
+                FAILED ("INCORRECT RESULT - 2");
+           END IF;
+      END;
+ 
+ ----- USER-DEFINED TYPE:
+ 
+      DECLARE
+           TYPE USR IS DIGITS 5;
+ 
+           F1 : USR := 1.0;
+           F2 : USR := 2.0;
+           F5 : USR := 5.0;
+ 
+           FUNCTION "AND" (LEFT, RIGHT : USR) RETURN USR IS
+           BEGIN
+                RETURN 4.5;
+           END "AND";
+ 
+           FUNCTION ">=" (LEFT, RIGHT : USR) RETURN USR IS
+           BEGIN
+                RETURN 5.5;
+           END ">=";
+ 
+           FUNCTION "+" (LEFT, RIGHT : USR) RETURN USR IS
+           BEGIN
+                RETURN 6.5;
+           END "+";
+ 
+           FUNCTION "-" (RIGHT : USR) RETURN USR IS
+           BEGIN
+                RETURN 7.5;
+           END "-";
+ 
+           FUNCTION "/" (LEFT, RIGHT : USR) RETURN USR IS
+           BEGIN
+                RETURN 8.5;
+           END "/";
+ 
+           FUNCTION "**" (LEFT, RIGHT : USR) RETURN USR IS
+           BEGIN
+                RETURN 9.5;
+           END "**";
+      BEGIN
+           IF +F5 - F2 * F1 ** 2 /= 3.0 OR
+              ABS F1 <= 0.0 OR
+              - F2 * F2 ** 3.0 /= 7.5 THEN
+                FAILED ("INCORRECT RESULT - 3");
+           END IF;
+ 
+           IF (F1 AND F2 >= F1 + F5 / F5 ** 3) /= 4.5 THEN
+                FAILED ("INCORRECT RESULT - 4");
+           END IF;
+      END;
+ 
+ ----- ARRAYS:
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF FLOAT;
+ 
+           SUBTYPE SARR IS ARR (1 .. 3);
+ 
+           F1 : SARR := (OTHERS => 1.0);
+           F2 : SARR := (OTHERS => 2.0);
+           F5 : SARR := (OTHERS => 5.0);
+ 
+           FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => 4.5);
+           END "XOR";
+ 
+           FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => 5.5);
+           END "<=";
+ 
+           FUNCTION "&" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => 6.5);
+           END "&";
+ 
+           FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => 8.5);
+           END "MOD";
+ 
+           FUNCTION "ABS" (RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => 9.5);
+           END "ABS";
+      BEGIN
+           IF (ABS F1 <= F2 & F5 MOD F1 XOR F1) /= (1 .. 3 => 4.5) THEN
+                FAILED ("INCORRECT RESULT - 5");
+           END IF;
+ 
+           IF (ABS F1 & F2) /= (1 .. 3 => 6.5) OR
+              (F1 MOD F2 <= F5) /= (1 .. 3 => 5.5) THEN
+                FAILED ("INCORRECT RESULT - 6");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C44003D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c44003f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c44003f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c44003f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c44003f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,143 ----
+ -- C44003F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED AND OVERLOADED
+ --     OPERATIONS ON ENUMERATION TYPES OTHER THAN BOOLEAN OR CHARACTER
+ --     AND ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF SUCH TYPES.
+ 
+ -- HISTORY:
+ --     RJW 10/13/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C44003F IS
+ 
+      TYPE ENUM IS (ZERO, ONE, TWO, THREE, FOUR, FIVE);
+ 
+ BEGIN
+      TEST ("C44003F", "CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED " &
+                       "AND OVERLOADED OPERATIONS ON ENUMERATION " &
+                       "TYPES OTHER THAN BOOLEAN OR CHARACTER AND " &
+                       "ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF " &
+                       "SUCH TYPES");
+ 
+ 
+ ----- ENUMERATION TYPE:
+ 
+      DECLARE
+           E1 : ENUM := ONE;
+           E2 : ENUM := TWO;
+           E5 : ENUM := FIVE;
+ 
+           FUNCTION "AND" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+           BEGIN
+                RETURN ZERO;
+           END "AND";
+ 
+           FUNCTION "<" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+           BEGIN
+                RETURN THREE;
+           END "<";
+ 
+           FUNCTION "-" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+           BEGIN
+                RETURN ENUM'VAL (ENUM'POS (LEFT) - ENUM'POS (RIGHT));
+           END "-";
+ 
+           FUNCTION "+" (RIGHT : ENUM) RETURN ENUM IS
+           BEGIN
+                RETURN RIGHT;
+           END "+";
+ 
+           FUNCTION "*" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+           BEGIN
+                RETURN ENUM'VAL (ENUM'POS (LEFT) * ENUM'POS (RIGHT));
+           END "*";
+ 
+           FUNCTION "**" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+           BEGIN
+                RETURN ENUM'VAL (ENUM'POS (LEFT) ** ENUM'POS (RIGHT));
+           END "**";
+ 
+      BEGIN
+           IF NOT (+E1 < E2) OR NOT (E2 >= +E2) OR NOT (E5 = +FIVE) THEN
+                FAILED ("INCORRECT RESULT - 1");
+           END IF;
+ 
+           IF (E5 ** E1 AND E2) /= (E5 - E1 * E5 ** E1) THEN
+                FAILED ("INCORRECT RESULT - 2");
+           END IF;
+ 
+      END;
+ 
+ ----- ARRAYS:
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF ENUM;
+ 
+           SUBTYPE SARR IS ARR (1 .. 3);
+ 
+           E1 : SARR := (OTHERS => ONE);
+           E2 : SARR := (OTHERS => TWO);
+           E5 : SARR := (OTHERS => FIVE);
+ 
+           FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => ZERO);
+           END "XOR";
+ 
+           FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => THREE);
+           END "<=";
+ 
+           FUNCTION "+" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => ZERO);
+           END "+";
+ 
+           FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => THREE);
+           END "MOD";
+ 
+           FUNCTION "**" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => FOUR);
+           END "**";
+      BEGIN
+           IF (E5 ** E1 <= E2 + E5 MOD E1 XOR E1) /= (1 .. 3 => ZERO)
+              THEN
+                FAILED ("INCORRECT RESULT - 3");
+           END IF;
+ 
+           IF (E5 ** E1 & E2) /= (FOUR, FOUR, FOUR, TWO, TWO, TWO) OR
+              (E1 MOD E2 <= E5) /= (1 .. 3 => THREE) THEN
+                FAILED ("INCORRECT RESULT - 4");
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C44003F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c44003g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c44003g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c44003g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c44003g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- C44003G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED AND OVERLOADED
+ --     OPERATIONS ON BOOLEAN TYPES AND ONE-DIMENSIONAL ARRAYS WITH
+ --     COMPONENTS OF TYPE BOOLEAN.
+ 
+ -- HISTORY:
+ --     RJW 10/13/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C44003G IS
+ 
+ BEGIN
+      TEST ("C44003G", "CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED " &
+                       "AND OVERLOADED OPERATIONS ON BOOLEAN TYPES " &
+                       "AND ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF " &
+                       "TYPE BOOLEAN");
+ 
+ ----- PREDEFINED BOOLEAN:
+ 
+      DECLARE
+           T : BOOLEAN := TRUE;
+           F : BOOLEAN := FALSE;
+ 
+           FUNCTION "AND" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN FALSE;
+           END "AND";
+ 
+           FUNCTION "<" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN TRUE;
+           END "<";
+ 
+           FUNCTION "-" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN TRUE;
+           END "-";
+ 
+           FUNCTION "+" (RIGHT : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN NOT RIGHT;
+           END "+";
+ 
+           FUNCTION "*" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN FALSE;
+           END "*";
+ 
+           FUNCTION "**" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN TRUE;
+           END "**";
+ 
+      BEGIN
+           IF NOT (+T = F) OR T /= +F OR (TRUE AND FALSE ** TRUE) OR
+              NOT (+T < F) OR NOT (T - F * T) OR (NOT T - F XOR + F - F)
+              THEN
+                FAILED ("INCORRECT RESULT - 1");
+           END IF;
+ 
+      END;
+ 
+ ----- ARRAYS:
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+ 
+           SUBTYPE SARR IS ARR (1 .. 3);
+ 
+           T : SARR := (OTHERS => TRUE);
+           F : SARR := (OTHERS => FALSE);
+ 
+           FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => FALSE);
+           END "XOR";
+ 
+           FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => TRUE);
+           END "<=";
+ 
+           FUNCTION "+" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => FALSE);
+           END "+";
+ 
+           FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => TRUE);
+           END "MOD";
+ 
+           FUNCTION "**" (LEFT, RIGHT : ARR) RETURN ARR IS
+           BEGIN
+                RETURN (1 .. 3 => FALSE);
+           END "**";
+      BEGIN
+           IF (F ** T <= F + T MOD T XOR T) /= (1 .. 3 => FALSE)
+              THEN
+                FAILED ("INCORRECT RESULT - 2");
+           END IF;
+ 
+           IF F ** T & T /= NOT T & T OR
+              (T MOD F <= T) /= (1 .. 3 => TRUE) THEN
+                FAILED ("INCORRECT RESULT - 3");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C44003G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c450001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c450001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c450001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c450001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,434 ----
+ -- C450001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that operations on modular types perform correctly.
+ --
+ --     Check that loops over the range of a modular type do not over or
+ --     under run the loop.
+ --
+ -- TEST DESCRIPTION:
+ --     Check logical and arithmetic operations.
+ --     (Attributes are tested elsewhere)
+ --     Checks to make sure that:
+ --        for X in Mod_Type loop
+ --     doesn't do something silly like infinite loop.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      20 SEP 95   SAIC   Initial version
+ --      20 FEB 96   SAIC   Added underrun cases for 2.1
+ --
+ --!
+ 
+ ----------------------------------------------------------------- C450001_0
+ 
+ package C450001_0 is
+ 
+   type Unsigned_8_Bit is mod 2**8;
+ 
+   Shy_By_One : constant := 2**8-1;
+ 
+   Heavy_By_Two : constant := 2**8+2;
+ 
+   type Unsigned_Edge_8 is mod Shy_By_One;
+ 
+   type Unsigned_Over_8 is mod Heavy_By_Two;
+ 
+   procedure Loop_Check;
+ 
+  -- embed some calls to Report.Ident_Int:
+ 
+   function ID( U8B: Unsigned_8_Bit )  return Unsigned_8_Bit;
+   function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8;
+   function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8;
+ 
+ end C450001_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C450001_0 is
+ 
+   procedure Loop_Check is
+     Counter_Check : Natural := 0;
+   begin
+     for Ever in Unsigned_8_Bit loop
+       Counter_Check := Report.Ident_Int(Counter_Check) + 1;
+       if Counter_Check > 2**8 then
+         Report.Failed("Unsigned_8_Bit loop overrun");
+         exit;
+       end if;
+     end loop;
+ 
+     if Counter_Check < 2**8 then
+       Report.Failed("Unsigned_8_Bit loop underrun");
+     end if;
+ 
+     Counter_Check := 0;
+ 
+     for Never in Unsigned_Edge_8 loop
+       Counter_Check := Report.Ident_Int(Counter_Check) + 1;
+       if Counter_Check > Shy_By_One then
+         Report.Failed("Unsigned_Edge_8 loop overrun");
+         exit;
+       end if;
+     end loop;
+ 
+     if Counter_Check < Shy_By_One then
+       Report.Failed("Unsigned_Edge_8 loop underrun");
+     end if;
+ 
+     Counter_Check := 0;
+ 
+     for Getful in reverse Unsigned_Over_8 loop
+       Counter_Check := Report.Ident_Int(Counter_Check) + 1;
+       if Counter_Check > Heavy_By_Two then
+         Report.Failed("Unsigned_Over_8 loop overrun");
+         exit;
+       end if;
+     end loop;
+ 
+     if Counter_Check < Heavy_By_Two then
+       Report.Failed("Unsigned_Over_8 loop underrun");
+     end if;
+ 
+   end Loop_Check;
+ 
+   function ID( U8B: Unsigned_8_Bit )  return Unsigned_8_Bit is
+   begin
+     return Unsigned_8_Bit(Report.Ident_Int(Integer(U8B)));
+   end ID;
+ 
+   function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8 is
+   begin
+     return Unsigned_Edge_8(Report.Ident_Int(Integer(UEB)));
+   end ID;
+ 
+   function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8 is
+   begin
+     return Unsigned_Over_8(Report.Ident_Int(Integer(UOB)));
+   end ID;
+ 
+ end C450001_0;
+ 
+ ------------------------------------------------------------------- C450001
+ 
+ with Report;
+ with C450001_0;
+ with TCTouch;
+ procedure C450001 is
+   use C450001_0;
+ 
+   BR : constant String := " produced the wrong result";
+ 
+   procedure Is_T(B:Boolean;S:String) renames TCTouch.Assert;
+   procedure Is_F(B:Boolean;S:String) renames TCTouch.Assert_Not;
+ 
+   Whole_8_A, Whole_8_B, Whole_8_C : C450001_0.Unsigned_8_Bit;
+ 
+   Short_8_A, Short_8_B, Short_8_C : C450001_0.Unsigned_Edge_8;
+ 
+   Over_8_A, Over_8_B, Over_8_C : C450001_0.Unsigned_Over_8;
+ 
+ begin  -- Main test procedure. C450001
+ 
+   Report.Test ("C450001", "Check that operations on modular types " &
+                           "perform correctly." );
+ 
+ 
+   -- the cases for the whole 8 bit type are pretty simple
+ 
+   Whole_8_A :=                             2#00000000#;
+   Whole_8_B :=                             2#11111111#;
+ 
+   Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00000000#,"8 bit and" & BR);
+   Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111111#,"8 bit  or" & BR);
+   Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11111111#,"8 bit xor" & BR);
+ 
+   Whole_8_A :=                             2#00001111#;
+   Whole_8_B :=                             2#11111111#;
+ 
+   Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00001111#,"8 bit and" & BR);
+   Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111111#,"8 bit  or" & BR);
+   Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11110000#,"8 bit xor" & BR);
+ 
+   Whole_8_A :=                             2#10101010#;
+   Whole_8_B :=                             2#11110000#;
+ 
+   Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#10100000#,"8 bit and" & BR);
+   Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111010#,"8 bit  or" & BR);
+   Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#01011010#,"8 bit xor" & BR);
+ 
+   -- the cases for the partial 8 bit type involve subtracting the modulus
+   -- from results that exceed the modulus.
+   -- hence, any of the following operations that exceed 2#11111110# must
+   -- have 2#11111111# subtracted from the result; i.e. where you would
+   -- expect to see 2#11111111# as in the above operations, the correct
+   -- result will be 2#00000000#.  Note that 2#11111111# is not a legal
+   -- value of type C450001_0.Unsigned_Edge_8.
+ 
+   Short_8_A :=                             2#11100101#;
+   Short_8_B :=                             2#00011111#;
+ 
+   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000101#,"8 short and 1" & BR);
+   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#00000000#,"8 short  or 1" & BR);
+   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#11111010#,"8 short xor 1" & BR);
+ 
+   Short_8_A :=                             2#11110000#;
+   Short_8_B :=                             2#11111110#;
+ 
+   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#11110000#,"8 short and 2" & BR);
+   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#11111110#,"8 short  or 2" & BR);
+   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00001110#,"8 short xor 2" & BR);
+ 
+   Short_8_A :=                             2#10101010#;
+   Short_8_B :=                             2#01010101#;
+ 
+   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000000#,"8 short and 3" & BR);
+   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#00000000#,"8 short  or 3" & BR);
+   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00000000#,"8 short xor 3" & BR);
+ 
+   Short_8_A :=                             2#10101010#;
+   Short_8_B :=                             2#11111110#;
+ 
+   Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#10101010#,"8 short and 4" & BR);
+   Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#11111110#,"8 short  or 4" & BR);
+   Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#01010100#,"8 short xor 4" & BR);
+ 
+   -- the cases for the over 8 bit type have similar issues to the short type
+   -- however the bit patterns are a little different.  The rule is to subtract
+   -- the modulus (258) from any resulting value equal or greater than the
+   -- modulus       -- note that 258 =    2#100000010#
+ 
+   Over_8_A :=                            2#100000000#;
+   Over_8_B :=                            2#011111111#;
+ 
+   Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000000#,"8 over and" & BR);
+   Is_T((ID(Over_8_A)  or ID(Over_8_B)) = 2#011111101#,"8 over  or" & BR);
+   Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111101#,"8 over xor" & BR);
+ 
+   Over_8_A :=                            2#100000001#;
+   Over_8_B :=                            2#011111111#;
+ 
+   Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000001#,"8 over and" & BR);
+   Is_T((ID(Over_8_A)  or ID(Over_8_B)) = 2#011111101#,"8 over  or" & BR);
+   Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111100#,"8 over xor" & BR);
+ 
+ 
+ 
+   Whole_8_A := 128;
+   Whole_8_B := 255;
+ 
+   Is_T(ID(Whole_8_A) /= ID(Whole_8_B), "8 /=" & BR);
+   Is_F(ID(Whole_8_A)  = ID(Whole_8_B), "8  =" & BR);
+ 
+   Is_T(ID(Whole_8_A) <= ID(Whole_8_B), "8 <=" & BR);
+   Is_T(ID(Whole_8_A) <  ID(Whole_8_B), "8 < " & BR);
+ 
+   Is_F(ID(Whole_8_A) >= ID(Whole_8_B), "8 >=" & BR);
+   Is_T(ID(Whole_8_A) >  ID(Whole_8_B + 7), "8 > " & BR);
+ 
+   Is_T(ID(Whole_8_A)     in ID(100)..ID(200), "8 in" & BR);
+   Is_F(ID(Whole_8_A) not in ID(100)..ID(200), "8 not in" & BR);
+ 
+   Is_F(ID(Whole_8_A)     in ID(200)..ID(250), "8 in" & BR);
+   Is_T(ID(Whole_8_A) not in ID(200)..ID(250), "8 not in" & BR);
+ 
+   Short_8_A := 127;
+   Short_8_B := 254;
+ 
+   Is_T(ID(Short_8_A) /= ID(Short_8_B), "short 8 /=" & BR);
+   Is_F(ID(Short_8_A)  = ID(Short_8_B), "short 8  =" & BR);
+ 
+   Is_T(ID(Short_8_A) <= ID(Short_8_B), "short 8 <=" & BR);
+   Is_T(ID(Short_8_A) <  ID(Short_8_B), "short 8 < " & BR);
+ 
+   Is_F(ID(Short_8_A) >= ID(Short_8_B), "short 8 >=" & BR);
+   Is_F(ID(Short_8_A) >  ID(Short_8_B), "short 8 > " & BR);
+ 
+   Is_T(ID(Short_8_A)     in ID(100)..ID(200), "8 in" & BR);
+   Is_F(ID(Short_8_A) not in ID(100)..ID(200), "8 not in" & BR);
+ 
+   Is_F(ID(Short_8_A)     in ID(200)..ID(250), "8 in" & BR);
+   Is_T(ID(Short_8_A) not in ID(200)..ID(250), "8 not in" & BR);
+ 
+ 
+   Whole_8_A := 1;
+   Whole_8_B := 254;
+   Short_8_A := 1;
+   Short_8_B := 2;
+ 
+   Whole_8_C := ID(Whole_8_A) + ID(Whole_8_B);
+   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 1" & BR);
+ 
+   Whole_8_C := Whole_8_C + ID(Whole_8_A);
+   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'First, "8 binary + 2" & BR);
+ 
+   Whole_8_C := ID(Whole_8_A) - ID(Whole_8_A);
+   Is_T(Whole_8_C = 0, "8 binary -" & BR);
+ 
+   Whole_8_C := Whole_8_C - ID(Whole_8_A);
+   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 3" & BR);
+ 
+   Short_8_C := ID(Short_8_A) + ID(C450001_0.Unsigned_Edge_8'Last);
+   Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'First, "Short binary + 1" & BR);
+ 
+   Short_8_C := Short_8_A + ID(Short_8_A);
+   Is_T(Short_8_C = ID(Short_8_B), "Short binary + 2" & BR);
+ 
+   Short_8_C := ID(Short_8_A) - ID(Short_8_A);
+   Is_T(Short_8_C = 0, "Short 8 binary -" & BR);
+ 
+   Short_8_C := Short_8_C - ID(Short_8_A);
+   Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short binary + 3" & BR);
+ 
+ 
+   Whole_8_C := ( + ID(Whole_8_B) );
+   Is_T(Whole_8_C = 254, "8 unary +" & BR);
+ 
+   Whole_8_C := ( - ID(Whole_8_A) );
+   Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 unary -" & BR);
+ 
+   Whole_8_C := ( - ID(0) );
+   Is_T(Whole_8_C = 0, "8 unary -0" & BR);
+ 
+   Short_8_C := ( + ID(C450001_0.Unsigned_Edge_8'Last) );
+   Is_T(Short_8_C = 254, "Short 8 unary +" & BR);
+ 
+   Short_8_C := ( - ID(Short_8_A) );
+   Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short 8 unary -" & BR);
+ 
+ 
+   Whole_8_A := 20;
+   Whole_8_B := 255;
+ 
+   Whole_8_C := ID(Whole_8_A) * ID(Whole_8_B); -- 5100 = 19*256 + 236 (256-20)
+   Is_T(Whole_8_C = 236, "8 *" & BR);
+ 
+   Short_8_A := 9;
+   Short_8_B := 254;
+ 
+   Short_8_C := ID(Short_8_A) * ID(Short_8_B); -- 2286 = 8*255 + 246 (255-9)
+   Is_T(Short_8_C = 246, "short 8 *" & BR);
+ 
+   Over_8_A := 12;
+   Over_8_B := 86;
+ 
+   Over_8_C := ID(Over_8_A) * ID(Over_8_B); -- 1032 = 4*258 + 0
+   Is_T(Over_8_C = 0, "over 8 *" & BR);
+ 
+ 
+   Whole_8_A := 255;
+   Whole_8_B := 4;
+ 
+   Whole_8_C := ID(Whole_8_A) / ID(Whole_8_B);
+   Is_T(Whole_8_C = 63, "8 /" & BR);
+ 
+   Short_8_A := 253;
+   Short_8_B := 127;
+ 
+   Short_8_C := ID(Short_8_A) / ID(Short_8_B);
+   Is_T(Short_8_C = 1, "short 8 / 1" & BR);
+ 
+   Short_8_C := ID(Short_8_A) / ID(126);
+   Is_T(Short_8_C = 2, "short 8 / 2" & BR);
+ 
+ 
+   Whole_8_A := 255;
+   Whole_8_B := 254;
+ 
+   Whole_8_C := ID(Whole_8_A) rem ID(Whole_8_B);
+   Is_T(Whole_8_C = 1, "8 rem" & BR);
+ 
+   Short_8_A := 222;
+   Short_8_B := 111;
+ 
+   Short_8_C := ID(Short_8_A) rem ID(Short_8_B);
+   Is_T(Short_8_C = 0, "short 8 rem" & BR);
+ 
+ 
+   Whole_8_A := 99;
+   Whole_8_B := 9;
+ 
+   Whole_8_C := ID(Whole_8_A) mod ID(Whole_8_B);
+   Is_T(Whole_8_C = 0, "8 mod" & BR);
+ 
+   Short_8_A := 254;
+   Short_8_B := 250;
+ 
+   Short_8_C := ID(Short_8_A) mod ID(Short_8_B);
+   Is_T(Short_8_C = 4, "short 8 mod" & BR);
+ 
+ 
+   Whole_8_A := 99;
+ 
+   Whole_8_C := abs Whole_8_A;
+   Is_T(Whole_8_C = ID(99), "8 abs" & BR);
+ 
+   Short_8_A := 254;
+ 
+   Short_8_C := ID( abs Short_8_A );
+   Is_T(Short_8_C = 254, "short 8 abs" & BR);
+ 
+ 
+   Whole_8_B :=        2#00001111#;
+ 
+   Whole_8_C := not Whole_8_B;
+   Is_T(Whole_8_C = ID(2#11110000#), "8 not" & BR);
+ 
+   Short_8_B :=     2#00001111#;                      -- 15
+ 
+   Short_8_C := ID( not Short_8_B );                  -- 254 - 15
+   Is_T(Short_8_C = 2#11101111#, "short 8 not" & BR); -- 239
+ 
+ 
+   Whole_8_A := 2;
+ 
+   Whole_8_C := Whole_8_A ** 7;
+   Is_T(Whole_8_C = ID(128), "2 ** 7, whole 8" & BR);
+ 
+   Whole_8_C := Whole_8_A ** 9;
+   Is_T(Whole_8_C = ID(0), "2 ** 9, whole 8" & BR);
+ 
+   Short_8_A := 4;
+ 
+   Short_8_C := ID( Short_8_A ) ** 4;
+   Is_T(Short_8_C = 1, "4 ** 4, short" & BR);
+ 
+   Over_8_A := 4;
+ 
+   Over_8_C := ID( Over_8_A ) ** 4;
+   Is_T(Over_8_C = 256, "4 ** 4, over" & BR);
+ 
+   Over_8_C := ID( Over_8_A ) ** 5; -- 1024 = 3*258 + 250
+   Is_T(Over_8_C = 250, "4 ** 5, over" & BR);
+ 
+ 
+   C450001_0.Loop_Check;
+ 
+   Report.Result;
+ 
+ end C450001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45112a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45112a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45112a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45112a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,233 ----
+ -- C45112A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION 
+ -- ARE THE BOUNDS OF THE LEFT OPERAND.
+ 
+ -- RJW 2/3/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45112A IS 
+      
+      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
+      A1 : ARR(IDENT_INT(3) .. IDENT_INT(4)) := (TRUE, FALSE);
+      A2 : ARR(IDENT_INT(1) .. IDENT_INT(2)) := (TRUE, FALSE);
+      SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
+ 
+      PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
+      BEGIN
+           IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
+                FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
+           END IF;
+      END CHECK;
+      
+ BEGIN
+ 
+      TEST ( "C45112A", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
+                        "ARRAY OPERATIONS" );
+ 
+      BEGIN
+           DECLARE
+                AAND : CONSTANT ARR := A1 AND A2;
+                AOR  : CONSTANT ARR := A1 OR A2;
+                AXOR : CONSTANT ARR := A1 XOR A2;          
+           BEGIN
+                CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ", 
+                             "'AND'" );
+ 
+                CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                             "'OR'" );
+      
+                CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                             "'XOR'" );
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
+                         "INTIALIZATIONS" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED DURING " &
+                         "INITIALIZATIONS" );
+      END;
+                               
+      DECLARE
+           PROCEDURE PROC (A : ARR; STR : STRING) IS
+           BEGIN
+                CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY", 
+                       STR);
+           END PROC;
+      BEGIN
+           PROC ((A1 AND A2), "'AND'" );
+           PROC ((A1 OR A2), "'OR'" );
+           PROC ((A1 XOR A2), "'XOR'" );
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
+                         "PARAMETERS" );
+      END;
+ 
+      DECLARE
+           FUNCTION FUNCAND RETURN ARR IS
+           BEGIN
+                RETURN A1 AND A2;
+           END FUNCAND;
+ 
+           FUNCTION FUNCOR RETURN ARR IS
+           BEGIN
+                RETURN A1 OR A2;
+           END FUNCOR;
+      
+           FUNCTION FUNCXOR RETURN ARR IS
+           BEGIN
+                RETURN A1 XOR A2;
+           END FUNCXOR;
+ 
+      BEGIN
+           CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
+           CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
+           CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
+      
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
+                         "FROM FUNCTION" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                GENERIC
+                    X : IN ARR;
+                PACKAGE PKG IS 
+                     FUNCTION G RETURN ARR;
+                END PKG;
+      
+                PACKAGE BODY PKG IS
+                     FUNCTION G RETURN ARR IS
+                     BEGIN
+                          RETURN X;
+                     END G;
+                END PKG;
+                          
+                PACKAGE PAND IS NEW PKG(X => A1 AND A2);
+                PACKAGE POR IS NEW PKG(X => A1 OR A2);
+                PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
+           BEGIN
+                CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
+                CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
+                CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING GENERIC " &
+                         "INSTANTIATION" );
+      END;
+ 
+      DECLARE
+           TYPE ACC IS ACCESS ARR;
+           AC : ACC;
+                
+      BEGIN
+           AC :=  NEW ARR'(A1 AND A2);
+           CHECK (AC.ALL, "ALLOCATION", "'AND'");
+           AC :=  NEW ARR'(A1 OR A2);
+           CHECK (AC.ALL, "ALLOCATION", "'OR'");
+           AC :=  NEW ARR'(A1 XOR A2);
+           CHECK (AC.ALL, "ALLOCATION", "'XOR'");
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
+      END;
+ 
+      BEGIN
+           CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
+           CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
+           CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
+      END;
+                
+      DECLARE
+           TYPE REC IS
+                RECORD
+                     RCA : CARR;
+                END RECORD;
+           R1 : REC;
+ 
+      BEGIN
+           R1 := (RCA => (A1 AND A2));
+           CHECK (R1.RCA, "AGGREGATE", "'AND'");
+           R1 := (RCA => (A1 OR A2));
+           CHECK (R1.RCA, "AGGREGATE", "'OR'");
+           R1 := (RCA => (A1 XOR A2));
+           CHECK (R1.RCA, "AGGREGATE", "'XOR'");
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
+      END;
+                     
+      BEGIN
+           DECLARE
+                TYPE RECDEF IS
+                     RECORD
+                          RCDF1 : CARR := A1 AND A2;
+                          RCDF2 : CARR := A1 OR A2;
+                          RCDF3 : CARR := A1 XOR A2;
+                     END RECORD;
+                RD : RECDEF;
+           BEGIN
+                CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
+                CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
+                CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
+                         "DEFAULT RECORD" );
+      END;
+                
+      DECLARE 
+           PROCEDURE PDEF (X : CARR := A1 AND A2; 
+                           Y : CARR := A1 OR A2; 
+                           Z : CARR := A1 XOR A2 ) IS
+           BEGIN
+                CHECK (X, "DEFAULT PARAMETER", "'AND'");
+                CHECK (Y, "DEFAULT PARAMETER", "'OR'");
+                CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
+           END PDEF;
+      
+      BEGIN
+           PDEF;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
+      END;
+ 
+      RESULT;
+ 
+ END C45112A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45112b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45112b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45112b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45112b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,234 ----
+ -- C45112B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION 
+ -- ARE THE BOUNDS OF THE LEFT OPERAND WHEN THE OPERANDS ARE NULL 
+ -- ARRAYS.
+ 
+ -- RJW 2/3/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45112B IS 
+      
+      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
+      A1 : ARR(IDENT_INT(4) .. IDENT_INT(3));
+      A2 : ARR(IDENT_INT(2) .. IDENT_INT(1));
+      SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
+ 
+      PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
+      BEGIN
+           IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
+                FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
+           END IF;
+      END CHECK;
+      
+ BEGIN
+ 
+      TEST ( "C45112B", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
+                        "ARRAY OPERATIONS ON NULL ARRAYS" );
+ 
+      BEGIN
+           DECLARE
+                AAND : CONSTANT ARR := A1 AND A2;
+                AOR  : CONSTANT ARR := A1 OR A2;
+                AXOR : CONSTANT ARR := A1 XOR A2;          
+           BEGIN
+                CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ", 
+                             "'AND'" );
+ 
+                CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                             "'OR'" );
+      
+                CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                             "'XOR'" );
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
+                         "INTIALIZATIONS" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED DURING " &
+                         "INITIALIZATIONS" );
+      END;
+                               
+      DECLARE
+           PROCEDURE PROC (A : ARR; STR : STRING) IS
+           BEGIN
+                CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY", 
+                       STR);
+           END PROC;
+      BEGIN
+           PROC ((A1 AND A2), "'AND'" );
+           PROC ((A1 OR A2), "'OR'" );
+           PROC ((A1 XOR A2), "'XOR'" );
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
+                         "PARAMETERS" );
+      END;
+ 
+      DECLARE
+           FUNCTION FUNCAND RETURN ARR IS
+           BEGIN
+                RETURN A1 AND A2;
+           END FUNCAND;
+ 
+           FUNCTION FUNCOR RETURN ARR IS
+           BEGIN
+                RETURN A1 OR A2;
+           END FUNCOR;
+      
+           FUNCTION FUNCXOR RETURN ARR IS
+           BEGIN
+                RETURN A1 XOR A2;
+           END FUNCXOR;
+ 
+      BEGIN
+           CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
+           CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
+           CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
+      
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
+                         "FROM FUNCTION" );
+      END;
+ 
+      BEGIN
+           DECLARE
+                GENERIC
+                    X : IN ARR;
+                PACKAGE PKG IS 
+                     FUNCTION G RETURN ARR;
+                END PKG;
+      
+                PACKAGE BODY PKG IS
+                     FUNCTION G RETURN ARR IS
+                     BEGIN
+                          RETURN X;
+                     END G;
+                END PKG;
+                          
+                PACKAGE PAND IS NEW PKG(X => A1 AND A2);
+                PACKAGE POR IS NEW PKG(X => A1 OR A2);
+                PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
+           BEGIN
+                CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
+                CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
+                CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING GENERIC " &
+                         "INSTANTIATION" );
+      END;
+ 
+      DECLARE
+           TYPE ACC IS ACCESS ARR;
+           AC : ACC;
+                
+      BEGIN
+           AC :=  NEW ARR'(A1 AND A2);
+           CHECK (AC.ALL, "ALLOCATION", "'AND'");
+           AC :=  NEW ARR'(A1 OR A2);
+           CHECK (AC.ALL, "ALLOCATION", "'OR'");
+           AC :=  NEW ARR'(A1 XOR A2);
+           CHECK (AC.ALL, "ALLOCATION", "'XOR'");
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
+      END;
+ 
+      BEGIN
+           CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
+           CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
+           CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
+      END;
+                
+      DECLARE
+           TYPE REC IS
+                RECORD
+                     RCA : CARR;
+                END RECORD;
+           R1 : REC;
+ 
+      BEGIN
+           R1 := (RCA => (A1 AND A2));
+           CHECK (R1.RCA, "AGGREGATE", "'AND'");
+           R1 := (RCA => (A1 OR A2));
+           CHECK (R1.RCA, "AGGREGATE", "'OR'");
+           R1 := (RCA => (A1 XOR A2));
+           CHECK (R1.RCA, "AGGREGATE", "'XOR'");
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
+      END;
+                     
+      BEGIN
+           DECLARE
+                TYPE RECDEF IS
+                     RECORD
+                          RCDF1 : CARR := A1 AND A2;
+                          RCDF2 : CARR := A1 OR A2;
+                          RCDF3 : CARR := A1 XOR A2;
+                     END RECORD;
+                RD : RECDEF;
+           BEGIN
+                CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
+                CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
+                CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
+           EXCEPTION
+                WHEN OTHERS => 
+                     FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
+                         "DEFAULT RECORD" );
+      END;
+                
+      DECLARE 
+           PROCEDURE PDEF (X : CARR := A1 AND A2; 
+                           Y : CARR := A1 OR A2; 
+                           Z : CARR := A1 XOR A2 ) IS
+           BEGIN
+                CHECK (X, "DEFAULT PARAMETER", "'AND'");
+                CHECK (Y, "DEFAULT PARAMETER", "'OR'");
+                CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
+           END PDEF;
+      
+      BEGIN
+           PDEF;
+      EXCEPTION
+           WHEN OTHERS => 
+                FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
+      END;
+ 
+      RESULT;
+ 
+ END C45112B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45113a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45113a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45113a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C45113A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE OPERANDS OF LOGICAL
+ -- OPERATORS HAVE DIFFERENT LENGTHS.
+ 
+ -- RJW  1/15/86
+ 
+ WITH REPORT; USE REPORT; 
+ 
+ PROCEDURE C45113A IS
+ 
+ BEGIN
+ 
+      TEST( "C45113A" , "CHECK ON LOGICAL OPERATORS WITH " &
+                        "OPERANDS OF DIFFERENT LENGTHS" );
+      
+      DECLARE
+ 
+           TYPE ARR IS ARRAY ( INTEGER RANGE <> ) OF BOOLEAN;
+      
+           A : ARR( IDENT_INT(1) .. IDENT_INT(2) ) := ( TRUE, FALSE );
+           B : ARR( IDENT_INT(1) .. IDENT_INT(3) ) := ( TRUE, FALSE, 
+                                                        TRUE );
+ 
+      BEGIN
+ 
+           BEGIN -- TEST FOR 'AND'.
+                IF (A AND B) = B THEN
+                     FAILED ( "A AND B = B" );
+                END IF;
+                FAILED ( "NO EXCEPTION RAISED FOR 'AND'" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR 'AND'" );
+           END;           
+ 
+ 
+           BEGIN -- TEST FOR 'OR'.
+                IF (A OR B) = B THEN
+                     FAILED ( "A OR B = B" );
+                END IF;
+                FAILED ( "NO EXCEPTION RAISED FOR 'OR'" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR 'OR'" );
+           END;           
+ 
+ 
+           BEGIN -- TEST FOR 'XOR'.
+                IF (A XOR B) = B THEN
+                     FAILED ( "A XOR B = B" );
+                END IF;
+                FAILED ( "NO EXCEPTION RAISED FOR 'XOR'" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR 'XOR'" );
+           END;           
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45113A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45114b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45114b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45114b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45114b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C45114B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LOGICAL OPERATORS ARE DEFINED FOR PACKED BOOLEAN ARRAYS.
+ 
+ --  RJW  1/17/86
+ 
+ WITH  REPORT; USE REPORT;
+ PROCEDURE  C45114B  IS
+ 
+ BEGIN
+ 
+      TEST( "C45114B" , "CHECK THAT LOGICAL OPERATORS ARE DEFINED " &
+                        "FOR PACKED BOOLEAN ARRAYS" );
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (1 .. 32) OF BOOLEAN;
+ 
+           PRAGMA PACK (ARR);
+ 
+           A : ARR := ( TRUE, TRUE, FALSE, FALSE, OTHERS => TRUE );
+           B : ARR := ( TRUE, FALSE, TRUE, FALSE, OTHERS => FALSE );
+ 
+           A_AND_B : ARR := ( TRUE, OTHERS => FALSE );
+           A_OR_B  : ARR := ARR'( 4 => FALSE, OTHERS => TRUE );
+           A_XOR_B : ARR := ARR'( 1|4 => FALSE, OTHERS => TRUE );
+           NOT_A   : ARR := ARR'( 3|4 => TRUE, OTHERS => FALSE );
+ 
+      BEGIN
+ 
+           IF ( A AND B ) /= A_AND_B THEN
+                FAILED ( "'AND' NOT CORRECTLY DEFINED" );
+           END IF;
+ 
+           IF ( A OR B ) /= A_OR_B THEN
+                FAILED ( "'OR' NOT CORRECTLY DEFINED" );
+           END IF;
+ 
+           IF ( A XOR B ) /= A_XOR_B THEN
+                FAILED ( "'XOR' NOT CORRECTLY DEFINED" );
+           END IF;
+ 
+           IF NOT A /= NOT_A THEN
+                FAILED ( "'NOT' NOT CORRECTLY DEFINED" );
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45114B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c452001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c452001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c452001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c452001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,707 ----
+ -- C452001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      For a type extension, check that predefined equality is defined in
+ --      terms of the primitive equals operator of the parent type and any
+ --      tagged components of the extension part.
+ --
+ --      For other composite types, check that the primitive equality operator
+ --      of any matching tagged components is used to determine equality of the
+ --      enclosing type.
+ --
+ --      For private types, check that predefined equality is defined in
+ --      terms of the user-defined (primitive) operator of the full type if
+ --      the full type is tagged. The partial view of the type may be
+ --      tagged or untagged. Check that predefined equality for a private
+ --      type whose full view is untagged is defined in terms of the
+ --      predefined equality operator of its full type.
+ --
+ -- TEST DESCRIPTION:
+ --      Tagged types are declared and used as components in several
+ --      differing composite type declarations, both tagged and untagged.
+ --      To differentiate between predefined and primitive equality
+ --      operations, user-defined equality operators are declared for
+ --      each component type that is to contribute to the equality
+ --      operator of the composite type that houses it. All user-defined
+ --      equality operations are designed to yield the opposite result
+ --      from the predefined operator, given the same component values.
+ --
+ --      For cases where primitive equality is to be incorporated into
+ --      equality for the enclosing composite type, values are assigned
+ --      to the component type so that user-defined equality will return
+ --      True. If predefined equality is to be used instead, then the
+ --      same strategy results in the equality operator returning False.
+ --
+ --      When equality for a type incorporates the user-defined equality
+ --      operator of one of its component types, the resulting operator
+ --      is considered to be the predefined operator of the composite type.
+ --      This case is confirmed by defining an tagged component of an
+ --      untagged composite type, then using the resulting untagged type
+ --      as a component of another composite type. The user-defined operator
+ --      for the lowest level should still be called.
+ --
+ --      Three cases are set up to test private types:
+ --
+ --                        Case 1        Case 2      Case 3
+ --         partial view:  tagged       untagged    untagged
+ --         full view:     tagged        tagged     untagged
+ --
+ --      Types are declared for each of the above cases and user-defined
+ --      (primitive) operators are declared following the full type
+ --      declaration of each type (i.e., in the private part).
+ --
+ --      Values are assigned into objects of these types using the same
+ --      strategy outlined above. Cases 1 and 2 should execute the
+ --      user-defined operator. Case 3 should ignore the user-defined
+ --      operator and user predefined equality for the type.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Removed RM references from objective text.
+ --      15 Nov 95   SAIC    Fixed for 2.0.1
+ --      04 NOV 96   SAIC    Typographical revision
+ --
+ --!
+ 
+ package c452001_0 is
+ 
+    type Point is
+       record
+          X : Integer := 0;
+          Y : Integer := 0;
+       end record;
+ 
+    type Circle is tagged
+       record
+          Center : Point;
+          Radius : Integer;
+       end record;
+ 
+    function "=" (L, R : Circle) return Boolean;
+ 
+    type Colors is (Red, Orange, Yellow, Green, Blue, Purple, Black, White);
+ 
+    type Colored_Circle is new Circle
+       with record
+          Color : Colors := White;
+       end record;
+ 
+    function "=" (L, R : Colored_Circle) return Boolean;
+    -- Override predefined equality for this tagged type. Predefined
+    -- equality should incorporate user-defined (primitive) equality
+    -- from type Circle. See C340001 for a test of that feature.
+ 
+    -- Equality is overridden to ensure that predefined equality 
+    -- incorporates this user-defined function for
+    -- any composite type with Colored_Circle as a component type.
+    -- (i.e., the type extension is recognized as a tagged type for
+    -- the purpose of defining predefined equality for the composite type).
+ 
+ end C452001_0;
+ 
+ package body c452001_0 is
+ 
+    function "=" (L, R : Circle) return Boolean is
+    begin
+       return L.Radius = R.Radius; -- circles are same size
+    end "=";
+ 
+    function "=" (L, R : Colored_Circle) return Boolean is
+    begin
+       return Circle(L) = Circle(R);
+    end "=";
+ 
+ end C452001_0;
+ 
+ with C452001_0;
+ package C452001_1 is
+ 
+    type Planet is tagged record
+       Name : String (1..15);
+       Representation : C452001_0.Colored_Circle;
+    end record;
+ 
+    -- Type Planet will be used to check that predefined equality
+    -- for a tagged type with a tagged component incorporates
+    -- user-defined equality for the component type.
+ 
+    type TC_Planet is new Planet with null record;
+ 
+    -- A "copy" of Planet. Used to create a type extension. An "="
+    -- operator will be defined for this type that should be
+    -- incorporated by the type extension.
+ 
+    function "=" (Arg1, Arg2 : in TC_Planet) return Boolean;
+ 
+    type Craters is array (1..3) of C452001_0.Colored_Circle;
+ 
+    -- An array type (untagged) with tagged components
+ 
+    type Moon is new TC_Planet
+      with record
+         Crater : Craters;
+      end record;
+      
+    -- A tagged record type. Extended component type is untagged,
+    -- but its predefined equality operator should incorporate
+    -- the user-defined operator of its tagged component type.
+ 
+ end C452001_1;
+ 
+ package body C452001_1 is
+ 
+    function "=" (Arg1, Arg2 : in TC_Planet) return Boolean is
+    begin
+       return Arg1.Name = Arg2.Name;
+    end "=";
+ 
+ end C452001_1;
+ 
+ package C452001_2 is
+ 
+    -- Untagged record types
+    -- Equality should not be incorporated
+ 
+    type Spacecraft_Design is (Mariner, Pioneer, Viking, Voyager);
+    type Spacecraft is record
+      Design      : Spacecraft_Design;
+      Operational : Boolean;
+    end record;
+ 
+    function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean;
+ 
+    type Mission is record
+       Craft       : Spacecraft;
+       Launch_Date : Natural;
+    end record;
+ 
+    type Inventory is array (Positive range <>) of Spacecraft;
+ 
+ end C452001_2;
+ 
+ package body C452001_2 is
+ 
+    function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean is
+    begin
+       return L.Design = R.Design;
+    end "=";
+ 
+ end C452001_2;
+ 
+ package C452001_3 is
+ 
+    type Tagged_Partial_Tagged_Full is tagged private;
+    procedure Change (Object : in out Tagged_Partial_Tagged_Full;
+                     Value  : in Boolean);
+ 
+    type Untagged_Partial_Tagged_Full is private;
+    procedure Change (Object : in out Untagged_Partial_Tagged_Full;
+                     Value  : in Integer);
+ 
+    type Untagged_Partial_Untagged_Full is private;
+    procedure Change (Object : in out Untagged_Partial_Untagged_Full;
+                     Value  : in Duration);
+ 
+ private
+ 
+    type Tagged_Partial_Tagged_Full is
+       tagged record
+          B : Boolean := True;
+          C : Character := ' ';
+       end record;
+    -- predefined equality checks that all components are equal
+ 
+    function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean;
+    -- primitive equality checks that records equate in component C only
+ 
+    type Untagged_Partial_Tagged_Full is
+       tagged record
+          I : Integer := 0;
+          P : Positive := 1;
+       end record;
+    -- predefined equality checks that all components are equal
+ 
+    function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean;
+    -- primitive equality checks that records equate in component P only
+ 
+    type Untagged_Partial_Untagged_Full is
+       record
+          D : Duration := 0.0;
+          S : String (1..12) := "Ada 9X rules";
+       end record;
+    -- predefined equality checks that all components are equal
+ 
+    function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean;
+    -- primitive equality checks that records equate in component S only
+ 
+ end C452001_3;
+    
+ with Report;
+ package body C452001_3 is
+ 
+    procedure Change (Object : in out Tagged_Partial_Tagged_Full;
+                     Value  : in Boolean) is
+    begin
+       Object := (Report.Ident_Bool(Value), Object.C);
+    end Change;
+ 
+    procedure Change (Object : in out Untagged_Partial_Tagged_Full;
+                     Value  : in Integer) is
+    begin
+       Object := (Report.Ident_Int(Value), Object.P);
+    end Change;
+ 
+    procedure Change (Object : in out Untagged_Partial_Untagged_Full;
+                     Value  : in Duration) is
+    begin
+       Object := (Value, Report.Ident_Str(Object.S));
+    end Change;
+ 
+    function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean is
+    begin
+       return L.C = R.C;
+    end "=";
+ 
+    function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean is
+    begin
+       return L.P = R.P;
+    end "=";
+ 
+    function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean is
+    begin
+       return R.S = L.S;
+    end "=";
+ 
+ end C452001_3;
+ 
+ 
+ with C452001_0;
+ with C452001_1;
+ with C452001_2;
+ with C452001_3;
+ with Report;
+ procedure C452001 is
+ 
+    Mars_Aphelion : C452001_1.Planet :=
+       (Name           => "Mars           ",
+        Representation => (Center => (Report.Ident_Int(20),
+                                      Report.Ident_Int(0)),
+                           Radius => Report.Ident_Int(4),
+                           Color  => C452001_0.Red));
+ 
+    Mars_Perihelion : C452001_1.Planet :=
+       (Name           => "Mars           ",
+        Representation => (Center => (Report.Ident_Int(-20),
+                                      Report.Ident_Int(0)),
+                           Radius => Report.Ident_Int(4),
+                           Color  => C452001_0.Red));
+ 
+    -- Mars_Perihelion = Mars_Aphelion if user-defined equality from
+    -- the tagged type Colored_Circle was incorporated into
+    -- predefined equality for the tagged type Planet. User-defined
+    -- equality for Colored_Circle checks only that the Radii are equal.
+ 
+    Blue_Mars : C452001_1.Planet :=
+       (Name           => "Mars           ",
+        Representation => (Center => (Report.Ident_Int(10),
+                                      Report.Ident_Int(10)),
+                           Radius => Report.Ident_Int(4),
+                           Color  => C452001_0.Blue));
+ 
+    -- Blue_Mars should equal Mars_Perihelion, because Names and
+    -- Radii are equal (all other components are not).
+ 
+    Green_Mars : C452001_1.Planet :=
+       (Name           => "Mars           ",
+        Representation => (Center => (Report.Ident_Int(10),
+                                      Report.Ident_Int(10)),
+                           Radius => Report.Ident_Int(4),
+                           Color  => C452001_0.Green));
+ 
+    -- Blue_Mars should equal Green_Mars. They differ only in the
+    -- Color component. All user-defined equality operations return
+    -- True, but records are not equal by predefined equality.
+ 
+    -- Blue_Mars should equal Mars_Perihelion, because Names and
+    -- Radii are equal (all other components are not).
+ 
+    Moon_Craters : C452001_1.Craters :=
+       ((Center => (Report.Ident_Int(9), Report.Ident_Int(11)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Black),
+        (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Black),
+        (Center => (Report.Ident_Int(11), Report.Ident_Int(9)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Black));
+ 
+    Alternate_Moon_Craters : C452001_1.Craters :=
+       ((Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Yellow),
+        (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Purple),
+        (Center => (Report.Ident_Int(11), Report.Ident_Int(11)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Purple));
+ 
+    -- Moon_Craters = Alternate_Moon_Craters if user-defined equality from
+    -- the tagged type Colored_Circle was incorporated into
+    -- predefined equality for the untagged type Craters. User-defined
+    -- equality checks only that the Radii are equal.
+ 
+    New_Moon : C452001_1.Moon := 
+       (Name           => "Moon           ",
+        Representation => (Center => (Report.Ident_Int(10),
+                                      Report.Ident_Int(8)),
+                           Radius => Report.Ident_Int(3),
+                           Color  => C452001_0.Black),
+        Crater         => Moon_Craters);
+ 
+    Full_Moon : C452001_1.Moon := 
+       (Name           => "Moon           ",
+        Representation => (Center => (Report.Ident_Int(10),
+                                      Report.Ident_Int(8)),
+                           Radius => Report.Ident_Int(3),
+                           Color  => C452001_0.Black),
+        Crater         => Alternate_Moon_Craters);
+ 
+    -- New_Moon = Full_Moon if user-defined equality from
+    -- the tagged type Colored_Circle was incorporated into
+    -- predefined equality for the untagged type Craters. This
+    -- equality test should call user-defined equality for type
+    -- TC_Planet (checks that Names are equal), then predefined
+    -- equality for Craters (ultimately calls user-defined equality
+    -- for type Circle, checking that Radii of craters are equal).
+ 
+    Mars_Moon : C452001_1.Moon := 
+       (Name           => "Phobos         ",
+        Representation => (Center => (Report.Ident_Int(10),
+                                      Report.Ident_Int(8)),
+                           Radius => Report.Ident_Int(3),
+                           Color  => C452001_0.Black),
+        Crater         => Alternate_Moon_Craters);
+ 
+    -- Mars_Moon /= Full_Moon since the Names differ.
+ 
+    Alternate_Moon_Craters_2 : C452001_1.Craters :=
+       ((Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Red),
+        (Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Red),
+        (Center => (Report.Ident_Int(10), Report.Ident_Int(9)),
+         Radius => Report.Ident_Int(1),
+         Color  => C452001_0.Red));
+ 
+    Harvest_Moon : C452001_1.Moon := 
+       (Name           => "Moon           ",
+        Representation => (Center => (Report.Ident_Int(11),
+                                      Report.Ident_Int(7)),
+                           Radius => Report.Ident_Int(4),
+                           Color  => C452001_0.Orange),
+        Crater         => Alternate_Moon_Craters_2);
+ 
+    -- Only the fields that are employed by the user-defined equality
+    -- operators are the same. Everything else differs. Equality should
+    -- still return True.
+ 
+    Viking_1_Orbiter : C452001_2.Mission :=
+       (Craft => (Design      => C452001_2.Viking,
+                  Operational => Report.Ident_Bool(False)),
+        Launch_Date => 1975);
+ 
+    Viking_1_Lander : C452001_2.Mission :=
+       (Craft => (Design      => C452001_2.Viking,
+                  Operational => Report.Ident_Bool(True)),
+        Launch_Date => 1975);
+ 
+    -- Viking_1_Orbiter /= Viking_1_Lander if predefined equality
+    -- from the untagged type Spacecraft is used for equality
+    -- of matching components in type Mission. If user-defined
+    -- equality for type Spacecraft is incorporated, which it
+    -- should not be by 4.5.2(21), then Viking_1_Orbiter = Viking_1_Lander.
+    
+    Voyagers : C452001_2.Inventory (1..2):=
+     ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
+      (C452001_2.Voyager, Operational => Report.Ident_Bool(False)));
+ 
+    Jupiter_Craft : C452001_2.Inventory (1..2):=
+     ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
+      (C452001_2.Voyager, Operational => Report.Ident_Bool(True)));
+    
+    -- Voyagers /= Jupiter_Craft if predefined equality
+    -- from the untagged type Spacecraft is used for equality
+    -- of matching components in type Inventory. If user-defined
+    -- equality for type Spacecraft is incorporated, which it
+    -- should not be by 4.5.2(21), then Voyagers = Jupiter_Craft.
+ 
+    TPTF_1 : C452001_3.Tagged_Partial_Tagged_Full;
+    TPTF_2 : C452001_3.Tagged_Partial_Tagged_Full;
+    
+    -- With differing values for Boolean component, user-defined
+    -- (primitive) equality returns True, predefined equality
+    -- returns False. Since full type is tagged, primitive equality
+    -- should be used.
+ 
+    UPTF_1 : C452001_3.Untagged_Partial_Tagged_Full;
+    UPTF_2 : C452001_3.Untagged_Partial_Tagged_Full;
+ 
+    -- With differing values for Boolean component, user-defined
+    -- (primitive) equality returns True, predefined equality
+    -- returns False. Since full type is tagged, primitive equality
+    -- should be used.
+ 
+    UPUF_1 : C452001_3.Untagged_Partial_Untagged_Full;
+    UPUF_2 : C452001_3.Untagged_Partial_Untagged_Full;
+ 
+    -- With differing values for Duration component, user-defined
+    -- (primitive) equality returns True, predefined equality
+    -- returns False. Since full type is untagged, predefined equality
+    -- should be used.
+ 
+    -- Use type clauses make "=" and "/=" operators directly visible
+    use type C452001_1.Planet;
+    use type C452001_1.Craters;
+    use type C452001_1.Moon;
+    use type C452001_2.Mission;
+    use type C452001_2.Inventory;
+    use type C452001_3.Tagged_Partial_Tagged_Full;
+    use type C452001_3.Untagged_Partial_Tagged_Full;
+    use type C452001_3.Untagged_Partial_Untagged_Full;
+ 
+ begin
+ 
+    Report.Test ("C452001", "Equality of private types and " &
+                            "composite types with tagged components");
+ 
+    -------------------------------------------------------------------
+    -- Tagged type with tagged component.
+    -------------------------------------------------------------------
+ 
+    if not (Mars_Aphelion = Mars_Perihelion) then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined equality " &
+                      "for enclosing tagged record type");
+    end if;
+ 
+    if Mars_Aphelion /= Mars_Perihelion then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined inequality " &
+                      "for enclosing tagged record type");
+    end if;
+ 
+    if not (Blue_Mars = Mars_Perihelion) then
+       Report.Failed ("Equality test for tagged record type " &
+                      "incorporates record components " &
+                      "other than those used by user-defined equality");
+    end if;
+ 
+    if Blue_Mars /= Mars_Perihelion then
+       Report.Failed ("Inequality test for tagged record type " &
+                      "incorporates record components " &
+                      "other than those used by user-defined equality");
+    end if;
+ 
+    if Blue_Mars /= Green_Mars then
+       Report.Failed ("Records are unequal even though they only differ " &
+                      "in a component not used by user-defined equality");
+    end if;
+ 
+    if not (Blue_Mars = Green_Mars) then
+       Report.Failed ("Records are not equal even though they only differ " &
+                      "in a component not used by user-defined equality");
+    end if;
+ 
+    -------------------------------------------------------------------
+    -- Untagged (array) type with tagged component.
+    -------------------------------------------------------------------
+ 
+    if not (Moon_Craters = Alternate_Moon_Craters) then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined equality " &
+                      "for enclosing array type");
+    end if;
+ 
+    if Moon_Craters /= Alternate_Moon_Craters then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined inequality " &
+                      "for enclosing array type");
+    end if;
+ 
+    -------------------------------------------------------------------
+    -- Tagged type with untagged composite component. Untagged
+    -- component itself has tagged components.
+    -------------------------------------------------------------------
+    if not (New_Moon = Full_Moon) then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined equality " &
+                      "for array component of tagged record type");
+    end if;
+ 
+    if New_Moon /= Full_Moon then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined inequality " &
+                      "for array component of tagged record type");
+    end if;
+ 
+    if Mars_Moon = Full_Moon then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined equality " &
+                      "for array component of tagged record type");
+    end if;
+ 
+    if not (Mars_Moon /= Full_Moon) then
+       Report.Failed ("User-defined equality for tagged component " &
+                      "was not incorporated into predefined inequality " &
+                      "for array component of tagged record type");
+    end if;
+ 
+    if not (Harvest_Moon = Full_Moon) then
+       Report.Failed ("Equality test for record with array of tagged " &
+                      "components incorporates record components " &
+                      "other than those used by user-defined equality");
+    end if;
+ 
+    if Harvest_Moon /= Full_Moon then
+       Report.Failed ("Inequality test for record with array of tagged " &
+                      "components incorporates record components " &
+                      "other than those used by user-defined equality");
+    end if;
+ 
+    -------------------------------------------------------------------
+    -- Untagged types with no tagged components.
+    -------------------------------------------------------------------
+ 
+    -- Record type
+ 
+    if Viking_1_Orbiter = Viking_1_Lander then
+       Report.Failed ("User-defined equality for untagged composite " &
+                      "component was incorporated into predefined " &
+                      "equality for " &
+                      "untagged record type");
+    end if;
+ 
+    if not (Viking_1_Orbiter /= Viking_1_Lander) then
+       Report.Failed ("User-defined equality for untagged composite " &
+                      "component was incorporated into predefined " &
+                      "inequality for " &
+                      "untagged record type");
+    end if;
+ 
+    -- Array type
+    
+    if Voyagers = Jupiter_Craft then
+       Report.Failed ("User-defined equality for untagged composite " &
+                      "component was incorporated into predefined " &
+                      "equality for " &
+                      "array type");
+    end if;
+ 
+    if not (Voyagers /= Jupiter_Craft) then
+       Report.Failed ("User-defined equality for untagged composite " &
+                      "component was incorporated into predefined " &
+                      "inequality for " &
+                      "array type");
+    end if;
+ 
+    -------------------------------------------------------------------
+    -- Private types tests.
+    -------------------------------------------------------------------
+ 
+    -- Make objects differ from one another
+ 
+    C452001_3.Change (TPTF_1, False);
+    C452001_3.Change (UPTF_1, 999);
+    C452001_3.Change (UPUF_1, 40.0);
+ 
+    -------------------------------------------------------------------
+    -- Partial type and full type are tagged. (Full type must be tagged
+    -- if partial type is tagged)
+    -------------------------------------------------------------------
+ 
+    if not (TPTF_1 = TPTF_2) then
+       Report.Failed ("Predefined equality for full type " &
+                      "was used to determine equality of " &
+                      "tagged private type " &
+                      "instead of user-defined (primitive) equality");
+    end if;
+ 
+    if TPTF_1 /= TPTF_2 then
+       Report.Failed ("Predefined equality for full type " &
+                      "was used to determine inequality of " &
+                      "tagged private type " &
+                      "instead of user-defined (primitive) equality");
+    end if;
+ 
+    -------------------------------------------------------------------
+    -- Partial type untagged, full type tagged.
+    -------------------------------------------------------------------
+ 
+    if not (UPTF_1 = UPTF_2) then
+       Report.Failed ("Predefined equality for full type " &
+                      "was used to determine equality of " &
+                      "private type (untagged partial view, " &
+                      "tagged full view) " &
+                      "instead of user-defined (primitive) equality");
+    end if;
+ 
+    if UPTF_1 /= UPTF_2 then
+       Report.Failed ("Predefined equality for full type " &
+                      "was used to determine inequality of " &
+                      "private type (untagged partial view, " &
+                      "tagged full view) " &
+                      "instead of user-defined (primitive) equality");
+    end if;
+ 
+    -------------------------------------------------------------------
+    -- Partial type and full type are both untagged.
+    -------------------------------------------------------------------
+ 
+    if UPUF_1 = UPUF_2 then
+       Report.Failed ("User-defined (primitive) equality for full type " &
+                      "was used to determine equality of " &
+                      "private type (untagged partial view, " &
+                      "untagged full view) " &
+                      "instead of predefined equality");
+    end if;
+ 
+    if not (UPUF_1 /= UPUF_2) then
+       Report.Failed ("User-defined (primitive) equality for full type " &
+                      "was used to determine inequality of " &
+                      "private type (untagged partial view, " &
+                      "untagged full view) " &
+                      "instead of predefined equality");
+    end if;
+ 
+    -------------------------------------------------------------------
+    Report.Result;
+ 
+ end C452001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45201a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45201a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45201a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,242 ----
+ -- C45201A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
+ --    ENUMERATION-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
+ --    DIFFERENT SUBTYPES).
+ 
+ -- THIS TEST'S FRAMEWORK IS FROM  C45201B.ADA , C45210A.ADA .
+ 
+ 
+ -- RM    20 OCTOBER 1980
+ -- JWC 7/8/85   RENAMED TO -AB
+ 
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45201A  IS
+ 
+      USE REPORT;
+ 
+      TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
+ 
+      --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
+      --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
+ 
+      SUBTYPE  T1  IS  T RANGE A..B ;
+      SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
+      SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
+      SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
+ 
+      MVAR  : T3 := T'(NUL ) ;
+      PVAR  : T2 := T'(PLIT) ;
+      RVAR  : T4 := T'('R' ) ;
+      SVAR  : T1 := T'(SLIT) ;
+ 
+      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+      FUNCTION  ITSELF( THE_ARGUMENT : T )  RETURN  T  IS
+      BEGIN
+           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+           ELSE  RETURN  A ;
+           END IF;
+      END ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C45201A" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
+                        " RESULTS ON ENUMERATION-TYPE LITERALS" ) ;
+ 
+      -- 128 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
+      --             2 (4)  OPERATORS (2, TWICE): '=' , '/=' , '=' , '/='
+      --                          (IN THE TABLE:   A  ,  B   ,  C  ,  D )
+      --                          (C45201B.ADA HAD  < <= > >= ; REVERSED)
+      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+      --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
+      --                         (IN THE TABLE:  VV = ALPHA ,
+      --                                         VL = BETA  ,
+      --                                         LV = GAMMA ,
+      --                                         LL = DELTA  ) RANDOMIZED
+      --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
+      --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
+ 
+      --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
+      --         LEFT
+      --       OPERAND:
+ 
+      --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
+      --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
+      --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
+      --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
+ 
+      --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
+      --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
+ 
+      -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
+      --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
+      --    ( VV , ALPHA ) FOR BOTH OPERATORS.
+ 
+     -----------------------------------------------------------------
+ 
+      -- PART 1
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+ 
+      IF  T'(SVAR) =  T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(SVAR) /= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(SLIT) =  T'(MVAR)  THEN  BUMP ;               END IF;
+      IF  T'(SLIT) /= T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+ 
+      IF  T'(PLIT) =  T'(SLIT)  THEN  BUMP ;               END IF;
+      IF  T'(PLIT) /= T'(PVAR)  THEN  BUMP ;               END IF;
+      IF  T'(PVAR) =  T'(NUL )  THEN  BUMP ;               END IF;
+      IF  T'(PVAR) /= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+ 
+      IF  T'(MVAR) /= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(MVAR) =  T'(PVAR)  THEN  BUMP ;               END IF;
+      IF  T'(NUL ) /= T'(NUL )  THEN  BUMP ;               END IF;
+      IF  T'(NUL ) =  T'(RVAR)  THEN  BUMP ;               END IF;
+ 
+      IF  T'('R' ) /= T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'('R' ) =  T'(PLIT)  THEN  BUMP ;               END IF;
+      IF  T'(RVAR) /= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(RVAR) =  T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+ 
+ 
+      IF  ERROR_COUNT /= 0  THEN
+           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE1" );
+      END IF;
+ 
+     -----------------------------------------------------------------
+ 
+      -- PART 2
+ 
+      --  'BUMP'  STILL MEANS  'BUMP THE ERROR COUNT'
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+           FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
+ 
+                IF  AVAR  = BVAR  THEN
+                     IF  AVAR /= BVAR  THEN  BUMP ;  END IF;
+                END IF;
+ 
+                IF  AVAR /= BVAR  THEN
+                     IF  AVAR  = BVAR  THEN  BUMP ;  END IF;
+                END IF;
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 0  THEN
+           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE2" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+ 
+           FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
+ 
+                IF ( AVAR /= BVAR ) /= ( T'POS(AVAR) /= T'POS(BVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+                IF ( AVAR  = BVAR ) /= ( T'POS(AVAR)  = T'POS(BVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+           END LOOP;
+ 
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 0  THEN
+           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE3" );
+      END IF;
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  IVAR IN  0..8  LOOP                      -- 9 VALUES
+ 
+           FOR  JVAR  IN  0..8   LOOP               -- 9 VALUES
+ 
+                IF ( IVAR /= JVAR ) /= ( T'VAL(IVAR) /= T'VAL(JVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+                IF ( IVAR  = JVAR ) /= ( T'VAL(IVAR)  = T'VAL(JVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+           END LOOP;
+ 
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 0  THEN
+           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE4" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP    -- 9 VALUES (THE DIAGONAL)
+ 
+           IF  AVAR  = ITSELF(AVAR)  THEN NULL;  ELSE BUMP;  END IF;
+           IF  AVAR /= ITSELF(AVAR)  THEN BUMP;              END IF;
+ 
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 0  THEN
+           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE5" );
+      END IF;
+ 
+ 
+      -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+           FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
+ 
+                IF  AVAR /= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 72
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 72  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE6" );
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ END C45201A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45201b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45201b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45201b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,236 ----
+ -- C45201B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ORDERING OF ENUMERATION LITERALS AS DEFINED BY THE
+ --    ORDERING OPERATORS IS THE SAME AS THE ORDER OF OCCURRENCE OF THE
+ --    LITERALS IN THE TYPE DEFINITION.
+ 
+ -- THIS TEST IS DERIVED FROM  C45210A.ADA .
+ 
+ 
+ -- RM    17 OCTOBER 1980
+ -- JWC 7/8/85   RENAMED TO -AB
+ 
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45201B  IS
+ 
+      USE REPORT;
+ 
+      TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
+ 
+      --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
+      --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
+ 
+      SUBTYPE  T1  IS  T RANGE A..B ;
+      SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
+      SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
+      SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
+ 
+      MVAR  : T3 := T'(NUL ) ;
+      PVAR  : T2 := T'(PLIT) ;
+      RVAR  : T4 := T'('R' ) ;
+      SVAR  : T1 := T'(SLIT) ;
+ 
+      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C45201B","CHECK THAT THE ORDERING OF ENUMERATION LITERALS "&
+                      " AS DEFINED BY THE ORDERING OPERATORS" &
+                      " IS THE SAME AS THE ORDER OF OCCURRENCE OF THE " &
+                      " LITERALS IN THE TYPE DEFINITION" ) ;
+ 
+      -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
+      --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
+      --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
+      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+      --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
+      --                         (IN THE TABLE:  VV = ALPHA ,
+      --                                         VL = BETA  ,
+      --                                         LV = GAMMA ,
+      --                                         LL = DELTA  ) RANDOMIZED
+      --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
+      --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
+ 
+      --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
+      --         LEFT
+      --       OPERAND:
+ 
+      --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
+      --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
+      --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
+      --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
+ 
+      --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
+      --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
+ 
+      -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
+      --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
+      --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
+ 
+     -----------------------------------------------------------------
+ 
+      -- PART 1
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+ 
+      IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
+      IF  T'(SVAR) <= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(SLIT) >  T'(MVAR)  THEN  BUMP ;               END IF;
+      IF  T'(SLIT) >= T'('R' )  THEN  BUMP ;               END IF;
+ 
+      IF  T'(PLIT) >  T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(PLIT) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(PVAR) <  T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+ 
+      IF  T'(MVAR) >= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(NUL ) <= T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(NUL ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+ 
+      IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
+      IF  T'('R' ) <  T'(PLIT)  THEN  BUMP ;               END IF;
+      IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
+ 
+ 
+      IF  ERROR_COUNT /= 0  THEN
+           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE1" );
+      END IF;
+ 
+     -----------------------------------------------------------------
+ 
+      -- PART 2
+ 
+      -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+ 
+                IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  6
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 6  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE2" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+ 
+                IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 10
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /=10  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE3" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+ 
+                IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 26
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /=26  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE4" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+ 
+                IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 30
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /=30  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE5" );
+      END IF;
+ 
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT' (AGAIN)
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+ 
+           FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
+ 
+                IF ( AVAR <  BVAR ) /= ( T'POS(AVAR) <  T'POS(BVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+                IF ( AVAR <= BVAR ) /= ( T'POS(AVAR) <= T'POS(BVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+                IF ( AVAR >  BVAR ) /= ( T'POS(AVAR) >  T'POS(BVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+                IF ( AVAR >= BVAR ) /= ( T'POS(AVAR) >= T'POS(BVAR) )THEN
+                     BUMP ;
+                END IF;
+ 
+           END LOOP;
+ 
+      END LOOP;
+ 
+ 
+      IF  ERROR_COUNT /= 0  THEN   -- REAL ERROR COUNT AGAIN
+           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE6" );
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ END C45201B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45202b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45202b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45202b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45202b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C45202B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK MEMBERSHIP OPERATIONS IN THE CASE IN WHICH A USER HAS 
+ -- REDEFINED THE ORDERING OPERATORS.
+ 
+ -- RJW 1/22/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45202B IS
+ 
+ 
+ BEGIN
+ 
+      TEST( "C45202B" , "CHECK MEMBERSHIP OPERATIONS IN WHICH A USER " &
+                        "HAS REDEFINED THE ORDERING OPERATORS" ) ;
+ 
+ 
+      DECLARE
+ 
+           TYPE  T  IS  ( AA, BB, CC, LIT, XX, YY, ZZ );    
+           SUBTYPE ST IS T RANGE AA .. LIT;     
+ 
+           VAR  :           T :=  LIT ;
+           CON  :  CONSTANT T :=  LIT ;
+ 
+           FUNCTION ">" ( L, R : T ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN T'POS(L) <= T'POS(R);
+           END;
+                     
+           FUNCTION ">=" ( L, R : T ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN T'POS(L) < T'POS(R);
+           END;
+ 
+           FUNCTION "<" ( L, R : T ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN T'POS(L) >= T'POS(R);
+           END;
+                     
+           FUNCTION "<=" ( L, R : T ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN T'POS(L) > T'POS(R);
+           END;
+                     
+ 
+      BEGIN
+ 
+           IF   LIT NOT IN ST      OR
+                VAR NOT IN ST      OR
+                CON NOT IN ST      OR
+                NOT (VAR IN ST)    OR
+                XX IN ST           OR
+                NOT (XX NOT IN ST) 
+           THEN
+                FAILED( "WRONG VALUES FOR 'IN ST'" );
+           END IF;
+ 
+           IF   LIT     IN AA ..CC       OR
+                VAR NOT IN LIT..ZZ       OR
+                CON     IN ZZ ..AA       OR
+                NOT (CC IN CC .. YY)     OR
+                NOT (BB NOT IN CC .. YY) 
+           THEN
+                FAILED( "WRONG VALUES FOR 'IN AA..CC'" );
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45202B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45210a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45210a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45210a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C45210A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ENUMERATION IMPOSING AN "UNNATURAL" ORDER ON ALPHABETIC
+ --    CHARACTERS CORRECTLY EVALUATES THE ORDERING OPERATORS.
+ 
+ 
+ -- RM    15 OCTOBER 1980
+ -- JWC 7/8/85   RENAMED TO -AB
+ 
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45210A  IS
+ 
+      USE REPORT;
+ 
+      TYPE  T  IS  ( 'S' , 'P' , 'M' , 'R' );
+ 
+      MVAR  : T := T'('M') ;
+      PVAR  : T := T'('P') ;
+      RVAR  : T := T'('R') ;
+      SVAR  : T := T'('S') ;
+ 
+      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT +1 ;
+      END BUMP ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C45210A" , "CHECK THAT AN ENUMERATION IMPOSING" &
+                        " AN ""UNNATURAL"" ORDER ON ALPHABETIC" &
+                        " CHARACTERS  CORRECTLY EVALUATES THE " &
+                        " ORDERING OPERATORS" ) ;
+ 
+      -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
+      --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
+      --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
+      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+      --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
+      --                         (IN THE TABLE:  VV = ALPHA ,
+      --                                         VL = BETA  ,
+      --                                         LV = GAMMA ,
+      --                                         LL = DELTA  ) RANDOMIZED
+      --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
+      --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
+ 
+      --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
+      --         LEFT
+      --       OPERAND:
+ 
+      --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
+      --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
+      --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
+      --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
+ 
+      --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
+      --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
+ 
+      -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
+      --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
+      --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
+ 
+     -----------------------------------------------------------------
+ 
+      -- PART 1
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+ 
+      IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
+      IF  T'(SVAR) <= T'('P' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'('S' ) >  T'(MVAR)  THEN  BUMP ;               END IF;
+      IF  T'('S' ) >= T'('R' )  THEN  BUMP ;               END IF;
+ 
+      IF  T'('P' ) >  T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'('P' ) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(PVAR) <  T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+ 
+      IF  T'(MVAR) >= T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'('M' ) <= T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'('M' ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+ 
+      IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
+      IF  T'('R' ) <  T'('P' )  THEN  BUMP ;               END IF;
+      IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+      IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
+ 
+ 
+      IF  ERROR_COUNT /= 0  THEN
+           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE1" );
+      END IF;
+ 
+     -----------------------------------------------------------------
+ 
+      -- PART 2
+ 
+      -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+ 
+                IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  1
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 1  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE2" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+ 
+                IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  3
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 3  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE3" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+ 
+                IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  5
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 5  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE4" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+           FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+ 
+                IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  7
+ 
+           END LOOP;
+      END LOOP;
+ 
+      IF  ERROR_COUNT /= 7  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                    --    ERROR COUNT
+           FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE5" );
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ END C45210A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45211a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45211a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45211a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- C45211A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK MEMBERSHIP TESTS FOR AN 'UNNATURAL' ORDERING OF CHARACTER
+ -- LITERALS.
+ 
+ -- RJW 1/22/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45211A IS
+ 
+      TYPE  T  IS  ( 'S' , 'Q' , 'P' , 'M' , 'R' );
+      SUBTYPE ST IS T RANGE 'P' .. 'R';
+ 
+      MVAR  : T := T'('M') ;
+      QVAR  : T := T'('Q') ;
+      MCON  : CONSTANT T := T'('M');
+      QCON  : CONSTANT T := T'('Q');
+ 
+ BEGIN
+ 
+      TEST( "C45211A" , "CHECK MEMBERSHIP TESTS FOR AN 'UNNATURAL' " &
+                        "ORDERING OF CHARACTER LITERALS" ) ;
+ 
+      IF QVAR IN T'('P') .. T'('R')  OR
+         'Q'  IN ST
+      THEN
+           FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 1" );
+      END IF;
+ 
+      IF MVAR NOT IN T'('P') .. T'('R')  OR
+         'M'  NOT IN ST
+      THEN
+           FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 2" );
+      END IF;
+ 
+      IF QCON IN T'('P') .. T'('R')  OR
+         MCON NOT IN ST
+      THEN
+           FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 3" );
+      END IF;
+ 
+      RESULT;
+ 
+ END C45211A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- C45220A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
+ --    BOOLEAN-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
+ --    DIFFERENT SUBTYPES).
+ 
+ -- THIS TEST IS DERIVED FROM  C45201A.ADA .
+ 
+ 
+ -- RM    27 OCTOBER 1980
+ -- JWC 7/8/85   RENAMED TO -AB
+ 
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45220A  IS
+ 
+ 
+      USE REPORT;
+ 
+      SUBTYPE  T1  IS  BOOLEAN RANGE FALSE..FALSE ;
+      SUBTYPE  T2  IS  BOOLEAN RANGE TRUE..TRUE ;
+      SUBTYPE  T3  IS  BOOLEAN RANGE FALSE..TRUE ;
+      SUBTYPE  T4  IS  T3 RANGE TRUE..TRUE ;
+ 
+      FVAR1  : T1 := FALSE ;
+      TVAR1  : T2 := TRUE ;
+      FVAR2  : T3 := FALSE ;
+      TVAR2  : T4 := TRUE ;
+ 
+      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST( "C45220A" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
+                        " RESULTS ON BOOLEAN-TYPE OPERANDS" ) ;
+ 
+      -- 32  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+      --               2    OPERATORS : '=' , '/=' ,
+      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+ 
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+ 
+      FVAR1  := IDENT_BOOL( FALSE ) ;
+      TVAR1  := IDENT_BOOL( TRUE ) ;
+      FVAR2  := IDENT_BOOL( FALSE ) ;
+      TVAR2  := IDENT_BOOL( TRUE ) ;
+ 
+      IF  FALSE =  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR1 =  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FALSE =  FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR2 =  FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  FALSE =  TRUE   THEN  BUMP ;                END IF;
+      IF  FVAR1 =  TRUE   THEN  BUMP ;                END IF;
+      IF  FALSE =  TVAR2  THEN  BUMP ;                END IF;
+      IF  FVAR2 =  TVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  TRUE  =  FALSE  THEN  BUMP ;                END IF;
+      IF  TRUE  =  FVAR1  THEN  BUMP ;                END IF;
+      IF  TVAR2 =  FALSE  THEN  BUMP ;                END IF;
+      IF  TVAR1 =  FVAR2  THEN  BUMP ;                END IF;
+ 
+      IF  TRUE  =  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR1 =  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TRUE  =  TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR2 =  TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+ 
+      IF  FALSE /= FALSE  THEN  BUMP ;                END IF;
+      IF  FVAR1 /= FALSE  THEN  BUMP ;                END IF;
+      IF  FALSE /= FVAR2  THEN  BUMP ;                END IF;
+      IF  FVAR2 /= FVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  FALSE /= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR1 /= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FALSE /= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR2 /= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  TRUE  /= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TRUE  /= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR2 /= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR1 /= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  TRUE  /= TRUE   THEN  BUMP ;                END IF;
+      IF  TVAR1 /= TRUE   THEN  BUMP ;                END IF;
+      IF  TRUE  /= TVAR2  THEN  BUMP ;                END IF;
+      IF  TVAR2 /= TVAR1  THEN  BUMP ;                END IF;
+ 
+ 
+      IF  ERROR_COUNT /=0  THEN
+           FAILED( "(IN)EQUALITY OF BOOLEAN VALUES - FAILURE1" );
+      END IF;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C45220A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C45220B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE CORRECT RESULTS ON
+ --    BOOLEAN-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
+ --    DIFFERENT SUBTYPES).
+ 
+ -- THIS TEST IS DERIVED FROM  C45220A.ADA .
+ 
+ 
+ -- RM    28 OCTOBER 1980
+ -- JWC 7/8/85   RENAMED TO -AB
+ 
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45220B  IS
+ 
+ 
+      USE REPORT;
+ 
+      SUBTYPE  T1  IS  BOOLEAN RANGE FALSE..FALSE ;
+      SUBTYPE  T2  IS  BOOLEAN RANGE TRUE..TRUE ;
+      SUBTYPE  T3  IS  BOOLEAN RANGE FALSE..TRUE ;
+      SUBTYPE  T4  IS  T3 RANGE TRUE..TRUE ;
+ 
+      FVAR1  : T1 := FALSE ;
+      TVAR1  : T2 := TRUE ;
+      FVAR2  : T3 := FALSE ;
+      TVAR2  : T4 := TRUE ;
+ 
+      ERROR_COUNT : INTEGER := 0 ;
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST( "C45220B" , "CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE" &
+                        " CORRECT RESULTS ON BOOLEAN-TYPE OPERANDS" ) ;
+ 
+      -- 64  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+      --               4    OPERATORS : '<' , <=' , '>' , '>='
+      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+ 
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+ 
+      FVAR1  := IDENT_BOOL( FALSE ) ;
+      TVAR1  := IDENT_BOOL( TRUE ) ;
+      FVAR2  := IDENT_BOOL( FALSE ) ;
+      TVAR2  := IDENT_BOOL( TRUE ) ;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  FALSE <  FALSE  THEN  BUMP ;                END IF;
+      IF  FVAR1 <  FALSE  THEN  BUMP ;                END IF;
+      IF  FALSE <  FVAR2  THEN  BUMP ;                END IF;
+      IF  FVAR2 <  FVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  FALSE <  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR1 <  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FALSE <  TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR2 <  TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  TRUE  <  FALSE  THEN  BUMP ;                END IF;
+      IF  TRUE  <  FVAR1  THEN  BUMP ;                END IF;
+      IF  TVAR2 <  FALSE  THEN  BUMP ;                END IF;
+      IF  TVAR1 <  FVAR2  THEN  BUMP ;                END IF;
+ 
+      IF  TRUE  <  TRUE   THEN  BUMP ;                END IF;
+      IF  TVAR1 <  TRUE   THEN  BUMP ;                END IF;
+      IF  TRUE  <  TVAR2  THEN  BUMP ;                END IF;
+      IF  TVAR2 <  TVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '<'" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  FALSE <= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR1 <= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FALSE <= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR2 <= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  FALSE <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR1 <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FALSE <= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR2 <= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  TRUE  <= FALSE  THEN  BUMP ;                END IF;
+      IF  TRUE  <= FVAR1  THEN  BUMP ;                END IF;
+      IF  TVAR2 <= FALSE  THEN  BUMP ;                END IF;
+      IF  TVAR1 <= FVAR2  THEN  BUMP ;                END IF;
+ 
+      IF  TRUE  <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR1 <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TRUE  <= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR2 <= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '<='" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  FALSE >  FALSE  THEN  BUMP ;                END IF;
+      IF  FVAR1 >  FALSE  THEN  BUMP ;                END IF;
+      IF  FALSE >  FVAR2  THEN  BUMP ;                END IF;
+      IF  FVAR2 >  FVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  FALSE >  TRUE   THEN  BUMP ;                END IF;
+      IF  FVAR1 >  TRUE   THEN  BUMP ;                END IF;
+      IF  FALSE >  TVAR2  THEN  BUMP ;                END IF;
+      IF  FVAR2 >  TVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  TRUE  >  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TRUE  >  FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR2 >  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR1 >  FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  TRUE  >  TRUE   THEN  BUMP ;                END IF;
+      IF  TVAR1 >  TRUE   THEN  BUMP ;                END IF;
+      IF  TRUE  >  TVAR2  THEN  BUMP ;                END IF;
+      IF  TVAR2 >  TVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '>'" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  FALSE >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR1 >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FALSE >= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  FVAR2 >= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  FALSE >= TRUE   THEN  BUMP ;                END IF;
+      IF  FVAR1 >= TRUE   THEN  BUMP ;                END IF;
+      IF  FALSE >= TVAR2  THEN  BUMP ;                END IF;
+      IF  FVAR2 >= TVAR1  THEN  BUMP ;                END IF;
+ 
+      IF  TRUE  >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TRUE  >= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR2 >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR1 >= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  TRUE  >= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR1 >= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TRUE  >= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  TVAR2 >= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '>='" );
+      END IF;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C45220B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- C45220C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
+ --    OPERANDS OF A TYPE DERIVED FROM THE TYPE 'BOOLEAN'
+ --    (IN PARTICULAR, FOR OPERANDS HAVING DIFFERENT SUBTYPES).
+ 
+ -- THIS TEST IS DERIVED FROM  C45220A.ADA .
+ 
+ 
+ -- RM    27 OCTOBER 1980
+ -- JWC 7/8/85   RENAMED TO -AB
+ 
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45220C  IS
+ 
+ 
+      USE REPORT;
+ 
+      TYPE  NB  IS  NEW BOOLEAN ;
+ 
+      SUBTYPE  T1  IS  NB RANGE NB'(FALSE)..NB'(FALSE) ;
+      SUBTYPE  T2  IS  NB RANGE NB'(TRUE )..NB'(TRUE );
+      SUBTYPE  T3  IS  NB RANGE NB'(FALSE)..NB'(TRUE );
+      SUBTYPE  T4  IS  T3 RANGE NB'(TRUE )..NB'(TRUE );
+ 
+      FVAR1   : T1 := NB'(FALSE) ;
+      TVAR1   : T2 := NB'(TRUE );
+      FVAR2   : T3 := NB'(FALSE) ;
+      TVAR2   : T4 := NB'(TRUE );
+ 
+      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+      FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
+      BEGIN
+           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+           ELSE  RETURN  NB'(FALSE) ;
+           END IF;
+      END ;
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST( "C45220C" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
+                        " RESULTS ON DERIVED-BOOLEAN-TYPE OPERANDS" ) ;
+ 
+      -- 32  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+      --               2    OPERATORS : '=' , '/=' ,
+      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+ 
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+ 
+      FVAR1   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+      TVAR1   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+      FVAR2   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+      TVAR2   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+ 
+      IF  NB'(FALSE) =  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR1  =  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(FALSE) =      FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR2  =      FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(FALSE) =  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF      FVAR1  =  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF  NB'(FALSE) =      TVAR2   THEN  BUMP ;                END IF;
+      IF      FVAR2  =      TVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(TRUE ) =  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF  NB'(TRUE ) =      FVAR1   THEN  BUMP ;                END IF;
+      IF      TVAR2  =  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF      TVAR1  =      FVAR2   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(TRUE ) =  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR1  =  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(TRUE ) =      TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR2  =      TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+ 
+      IF  NB'(FALSE) /= NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF      FVAR1  /= NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF  NB'(FALSE) /=     FVAR2   THEN  BUMP ;                END IF;
+      IF      FVAR2  /=     FVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(FALSE) /= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR1  /= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(FALSE) /=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR2  /=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(TRUE ) /= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(TRUE ) /=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR2  /= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR1  /=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(TRUE ) /= NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF      TVAR1  /= NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF  NB'(TRUE ) /=     TVAR2   THEN  BUMP ;                END IF;
+      IF      TVAR2  /=     TVAR1   THEN  BUMP ;                END IF;
+ 
+ 
+      IF  ERROR_COUNT /=0  THEN
+           FAILED( "(IN)EQUALITY OF N_BOOLEAN VALUES - FAILURE1" );
+      END IF;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C45220C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,200 ----
+ -- C45220D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE CORRECT RESULTS ON
+ --    OPERANDS OF A TYPE DERIVED FROM THE TYPE 'BOOLEAN'
+ --    (IN PARTICULAR, FOR OPERANDS HAVING DIFFERENT SUBTYPES).
+ 
+ -- THIS TEST IS DERIVED FROM  C45220B.ADA , C45220C.ADA .
+ 
+ 
+ -- RM    28 OCTOBER 1980
+ -- JWC 7/8/85   RENAMED TO -AB
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45220D  IS
+ 
+ 
+      USE REPORT;
+ 
+      TYPE  NB  IS  NEW BOOLEAN ;
+ 
+      SUBTYPE  T1  IS  NB RANGE NB'(FALSE)..NB'(FALSE) ;
+      SUBTYPE  T2  IS  NB RANGE NB'(TRUE )..NB'(TRUE );
+      SUBTYPE  T3  IS  NB RANGE NB'(FALSE)..NB'(TRUE );
+      SUBTYPE  T4  IS  T3 RANGE NB'(TRUE )..NB'(TRUE );
+ 
+      FVAR1   : T1 := NB'(FALSE) ;
+      TVAR1   : T2 := NB'(TRUE );
+      FVAR2   : T3 := NB'(FALSE) ;
+      TVAR2   : T4 := NB'(TRUE );
+ 
+      ERROR_COUNT : INTEGER := 0 ;
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+      FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
+      BEGIN
+           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+           ELSE  RETURN  NB'(FALSE) ;
+           END IF;
+      END ;
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST( "C45220D" , "CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE" &
+                        " CORRECT RESULTS ON DERIVED-BOOLEAN-TYPE" &
+                        " OPERANDS" ) ;
+ 
+      -- 64  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+      --               4    OPERATORS : '<' , <=' , '>' , '>='
+      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+      --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+ 
+ 
+      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+ 
+      FVAR1   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+      TVAR1   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+      FVAR2   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+      TVAR2   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  NB'(FALSE) <  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF      FVAR1  <  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF  NB'(FALSE) <      FVAR2   THEN  BUMP ;                END IF;
+      IF      FVAR2  <      FVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(FALSE) <  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR1  <  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(FALSE) <      TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR2  <      TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(TRUE ) <  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF  NB'(TRUE ) <      FVAR1   THEN  BUMP ;                END IF;
+      IF      TVAR2  <  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF      TVAR1  <      FVAR2   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(TRUE ) <  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF      TVAR1  <  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF  NB'(TRUE ) <      TVAR2   THEN  BUMP ;                END IF;
+      IF      TVAR2  <      TVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '<'" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  NB'(FALSE) <= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR1  <= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(FALSE) <=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR2  <=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(FALSE) <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR1  <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(FALSE) <=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR2  <=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(TRUE ) <= NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF  NB'(TRUE ) <=     FVAR1   THEN  BUMP ;                END IF;
+      IF      TVAR2  <= NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF      TVAR1  <=     FVAR2   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(TRUE ) <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR1  <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(TRUE ) <=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR2  <=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '<='" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  NB'(FALSE) >  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF      FVAR1  >  NB'(FALSE)  THEN  BUMP ;                END IF;
+      IF  NB'(FALSE) >      FVAR2   THEN  BUMP ;                END IF;
+      IF      FVAR2  >      FVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(FALSE) >  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF      FVAR1  >  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF  NB'(FALSE) >      TVAR2   THEN  BUMP ;                END IF;
+      IF      FVAR2  >      TVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(TRUE ) >  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(TRUE ) >      FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR2  >  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR1  >      FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(TRUE ) >  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF      TVAR1  >  NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF  NB'(TRUE ) >      TVAR2   THEN  BUMP ;                END IF;
+      IF      TVAR2  >      TVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '>'" );
+      END IF;
+ 
+ 
+      ERROR_COUNT := 0 ;
+ 
+      IF  NB'(FALSE) >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR1  >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(FALSE) >=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      FVAR2  >=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(FALSE) >= NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF      FVAR1  >= NB'(TRUE )  THEN  BUMP ;                END IF;
+      IF  NB'(FALSE) >=     TVAR2   THEN  BUMP ;                END IF;
+      IF      FVAR2  >=     TVAR1   THEN  BUMP ;                END IF;
+ 
+      IF  NB'(TRUE ) >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(TRUE ) >=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR2  >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR1  >=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  NB'(TRUE ) >= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR1  >= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF  NB'(TRUE ) >=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+      IF      TVAR2  >=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+ 
+      IF  ERROR_COUNT > 0  THEN
+           FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '>='" );
+      END IF;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C45220D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C45220E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THE PROPER OPERATION OF THE MEMBERSHIP OPERATORS  'IN'  AND
+ --    'NOT IN'  FOR BOOLEAN TYPES.
+ 
+ 
+ -- RM 03/20/81
+ -- SPS 10/26/82
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C45220E  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C45220E" , "CHECK THE PROPER OPERATION OF THE MEMBERSHIP" &
+                        " OPERATORS  'IN'  AND  'NOT IN'  FOR" &
+                        " BOOLEAN TYPES" );
+ 
+      DECLARE
+ 
+           SUBTYPE  SUBBOOL   IS  BOOLEAN RANGE FALSE..TRUE ;
+ 
+           VAR  :            BOOLEAN  :=  FALSE ;
+           CON  :   CONSTANT BOOLEAN  :=  FALSE ;
+ 
+      BEGIN
+ 
+           IF   TRUE NOT IN SUBBOOL  OR
+                VAR  NOT IN SUBBOOL  OR
+                CON  NOT IN SUBBOOL
+           THEN
+                FAILED( "WRONG VALUES FOR 'IN SUBBOOL'" );
+           END IF;
+ 
+           IF   FALSE   IN TRUE..FALSE  OR
+                VAR NOT IN FALSE..TRUE  OR
+                CON     IN TRUE..TRUE
+           THEN
+                FAILED( "WRONG VALUES FOR 'IN AAA..BBB'" );
+           END IF;
+ 
+ 
+           RESULT ;
+ 
+ 
+      END ;
+ 
+ 
+ END C45220E ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45220f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45220f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- C45220F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE MEMBERSHIP OPERATIONS WORK CORRECTLY FOR DERIVED
+ -- BOOLEAN TYPES.
+ 
+ -- GLH 08/01/85
+ 
+ WITH REPORT;
+ PROCEDURE  C45220F  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C45220F" , "CHECK MEMBERSHIP OPERATIONS FOR " &
+                        "DERIVED BOOLEAN");
+ 
+      DECLARE
+ 
+           TYPE NEWBOOL IS NEW BOOLEAN;
+ 
+           VAR  :          NEWBOOL  :=  FALSE ;
+           CON  : CONSTANT NEWBOOL  :=  FALSE ;
+ 
+      BEGIN
+ 
+           IF   TRUE NOT IN NEWBOOL  OR
+                VAR  NOT IN NEWBOOL  OR
+                CON  NOT IN NEWBOOL
+           THEN
+                FAILED( "WRONG VALUES FOR 'IN NEWBOOL'" );
+           END IF;
+ 
+           IF  NEWBOOL'(FALSE)   IN TRUE..FALSE  OR
+               VAR           NOT IN FALSE..TRUE  OR
+               CON               IN TRUE..TRUE
+           THEN
+                FAILED( "WRONG VALUES FOR 'IN AAA..BBB'" );
+           END IF;
+ 
+           RESULT ;
+ 
+      END ;
+ 
+ END C45220F ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,252 ----
+ -- C45231A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD CORRECT 
+ -- RESULTS FOR PREDEFINED TYPE INTEGER (INCLUDING THE CASE IN WHICH THE
+ -- RELATIONAL OPERATORS ARE REDEFINED).
+ 
+ -- SUBTESTS ARE:
+ --     (A). TESTS FOR RELATIONAL OPERATORS.
+ --     (B). TESTS FOR MEMBERSHIP OPERATORS.
+ --     (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE 
+ --          RELATIONAL OPERATORS ARE REDEFINED.
+ 
+ 
+ -- RJW 2/4/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45231A IS
+      
+      
+ BEGIN
+ 
+      TEST ( "C45231A", "CHECK THAT THE RELATIONAL AND " &
+                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                        "RESULTS FOR PREDEFINED TYPE INTEGER " &
+                        "(INCLUDING THE CASE IN WHICH THE " &
+                        "RELATIONAL OPERATORS ARE REDEFINED)" );
+ 
+      DECLARE -- (A)
+      
+           I1A, I1B   : INTEGER          := IDENT_INT (1);
+           I2         : INTEGER          := IDENT_INT (2);
+           CI2        : CONSTANT INTEGER := 2;
+ 
+ 
+      BEGIN -- (A)
+ 
+           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 1" );
+           END IF;
+ 
+           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 2" );
+           END IF;
+ 
+           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 3" );
+           END IF;
+ 
+           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 4");
+           END IF;
+ 
+           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 5" );
+           END IF;
+ 
+           IF (I1A >= I1B) AND (I1A <= I1B) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 6" );
+           END IF;
+ 
+           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 7" );
+           END IF;
+ 
+           IF "<" (LEFT => I1A, RIGHT => I2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 8" );
+           END IF;
+ 
+           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 9 ");
+           END IF;
+ 
+           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 10 ");
+           END IF;
+ 
+           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 11 ");
+           END IF;
+ 
+           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 12 ");
+           END IF;
+          
+      END; -- (A) 
+ 
+      ----------------------------------------------------------------
+ 
+      DECLARE -- (B)
+           
+           SUBTYPE ST IS INTEGER RANGE -10 .. 10;
+ 
+           I1 : INTEGER := IDENT_INT (1);
+           I5 : INTEGER := IDENT_INT (5);
+ 
+           CI2  : CONSTANT INTEGER := 2;
+           CI10 : CONSTANT INTEGER := 10;
+           
+           
+      BEGIN -- (B)
+      
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.1" );
+           END IF;
+ 
+           IF (IDENT_INT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT_INT (-11) IN ST) 
+              THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.3" );
+           END IF;
+      
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN 
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.5" );
+           END IF;
+ 
+      END; -- (B)
+ 
+      -------------------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE ST IS INTEGER RANGE -10 .. 10;
+ 
+           I1 : INTEGER := IDENT_INT (1);
+           I5 : INTEGER := IDENT_INT (5);
+ 
+           CI2  : CONSTANT INTEGER := 2;
+           CI10 : CONSTANT INTEGER := 10;
+           
+                     
+           FUNCTION ">" ( L, R : INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN INTEGER'POS (L) <= INTEGER'POS (R);
+           END;
+                     
+           FUNCTION ">=" ( L, R : INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN INTEGER'POS (L) < INTEGER'POS (R);
+           END;
+ 
+           FUNCTION "<" ( L, R : INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN  INTEGER'POS (L) >= INTEGER'POS (R);
+           END;
+                     
+           FUNCTION "<=" ( L, R : INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN INTEGER'POS (L) > INTEGER'POS (R);
+           END;
+                     
+      BEGIN -- (C)
+ 
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.1" );
+           END IF;
+ 
+           IF (IDENT_INT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT_INT (-11) IN ST) 
+              THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.3" );
+           END IF;
+      
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN 
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.5" );
+           END IF;
+ 
+      END; -- (C)
+ 
+      RESULT;
+ 
+ END C45231A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,265 ----
+ -- C45231B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD
+ --     CORRECT RESULTS FOR PREDEFINED TYPE SHORT_INTEGER (INCLUDING
+ --     THE CASE IN WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
+ 
+ --     SUBTESTS ARE:
+ --       (A). TESTS FOR RELATIONAL OPERATORS.
+ --       (B). TESTS FOR MEMBERSHIP OPERATORS.
+ --       (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
+ --            RELATIONAL OPERATORS ARE REDEFINED.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH
+ --     SUPPORT SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 02/04/86 CREATED ORIGINAL TEST.
+ --     DHH 01/08/87 ENTERED APPLICABILITY CRITERIA AND FORMATTED HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45231B IS
+ 
+      CHECK_SHORT : SHORT_INTEGER;                       -- N/A => ERROR.
+ 
+      FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ( "C45231B", "CHECK THAT THE RELATIONAL AND " &
+                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                        "RESULTS FOR PREDEFINED TYPE SHORT_INTEGER " &
+                        "(INCLUDING THE CASE IN WHICH THE " &
+                        "RELATIONAL OPERATORS ARE REDEFINED)" );
+ 
+      DECLARE -- (A)
+ 
+           I1A, I1B   : SHORT_INTEGER          := IDENT (1);
+           I2         : SHORT_INTEGER          := IDENT (2);
+           CI2        : CONSTANT SHORT_INTEGER := 2;
+ 
+ 
+      BEGIN -- (A)
+ 
+           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 1" );
+           END IF;
+ 
+           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 2" );
+           END IF;
+ 
+           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 3" );
+           END IF;
+ 
+           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 4");
+           END IF;
+ 
+           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 5" );
+           END IF;
+ 
+           IF (I1A >= I1B) AND (I1A <= I1B) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 6" );
+           END IF;
+ 
+           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 7" );
+           END IF;
+ 
+           IF "<" (LEFT => I1A, RIGHT => I2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 8" );
+           END IF;
+ 
+           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 9 ");
+           END IF;
+ 
+           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 10 ");
+           END IF;
+ 
+           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 11 ");
+           END IF;
+ 
+           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 12 ");
+           END IF;
+ 
+      END; -- (A)
+ 
+      ----------------------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
+ 
+           I1 : SHORT_INTEGER := IDENT (1);
+           I5 : SHORT_INTEGER := IDENT (5);
+ 
+           CI2  : CONSTANT SHORT_INTEGER := 2;
+           CI10 : CONSTANT SHORT_INTEGER := 10;
+ 
+ 
+      BEGIN -- (B)
+ 
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.1" );
+           END IF;
+ 
+           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.3" );
+           END IF;
+ 
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.5" );
+           END IF;
+ 
+      END; -- (B)
+ 
+      -------------------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
+ 
+           I1 : SHORT_INTEGER := IDENT (1);
+           I5 : SHORT_INTEGER := IDENT (5);
+ 
+           CI2  : CONSTANT SHORT_INTEGER := 2;
+           CI10 : CONSTANT SHORT_INTEGER := 10;
+ 
+ 
+           FUNCTION ">" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN SHORT_INTEGER'POS (L) <= SHORT_INTEGER'POS (R);
+           END;
+ 
+           FUNCTION ">=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN SHORT_INTEGER'POS (L) < SHORT_INTEGER'POS (R);
+           END;
+ 
+           FUNCTION "<" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN  SHORT_INTEGER'POS (L) >= SHORT_INTEGER'POS (R);
+           END;
+ 
+           FUNCTION "<=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN SHORT_INTEGER'POS (L) > SHORT_INTEGER'POS (R);
+           END;
+ 
+      BEGIN -- (C)
+ 
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.1" );
+           END IF;
+ 
+           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.3" );
+           END IF;
+ 
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.5" );
+           END IF;
+ 
+      END; -- (C)
+ 
+      RESULT;
+ 
+ END C45231B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,265 ----
+ -- C45231C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD
+ --     CORRECT RESULTS FOR PREDEFINED TYPE LONG_INTEGER (INCLUDING
+ --     THE CASE IN WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
+ 
+ --     SUBTESTS ARE:
+ --       (A). TESTS FOR RELATIONAL OPERATORS.
+ --       (B). TESTS FOR MEMBERSHIP OPERATORS.
+ --       (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
+ --            RELATIONAL OPERATORS ARE REDEFINED.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     LONG_INTEGER.
+ 
+ --     IF "LONG_INTEGER" IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     "CHECK_LONG" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 02/04/86 CREATED ORIGINAL TEST.
+ --     DHH 01/08/87 ENTERED APPLICABILITY CRITERIA AND FORMATTED HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45231C IS
+ 
+      CHECK_LONG : LONG_INTEGER;                        -- N/A => ERROR.
+ 
+      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ( "C45231C", "CHECK THAT THE RELATIONAL AND " &
+                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                        "RESULTS FOR PREDEFINED TYPE LONG_INTEGER " &
+                        "(INCLUDING THE CASE IN WHICH THE " &
+                        "RELATIONAL OPERATORS ARE REDEFINED)" );
+ 
+      DECLARE -- (A)
+ 
+           I1A, I1B   : LONG_INTEGER          := IDENT (1);
+           I2         : LONG_INTEGER          := IDENT (2);
+           CI2        : CONSTANT LONG_INTEGER := 2;
+ 
+ 
+      BEGIN -- (A)
+ 
+           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 1" );
+           END IF;
+ 
+           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 2" );
+           END IF;
+ 
+           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 3" );
+           END IF;
+ 
+           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 4");
+           END IF;
+ 
+           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 5" );
+           END IF;
+ 
+           IF (I1A >= I1B) AND (I1A <= I1B) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 6" );
+           END IF;
+ 
+           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 7" );
+           END IF;
+ 
+           IF "<" (LEFT => I1A, RIGHT => I2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 8" );
+           END IF;
+ 
+           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 9 ");
+           END IF;
+ 
+           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 10 ");
+           END IF;
+ 
+           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 11 ");
+           END IF;
+ 
+           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 12 ");
+           END IF;
+ 
+      END; -- (A)
+ 
+      ----------------------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           SUBTYPE ST IS LONG_INTEGER RANGE -10 .. 10;
+ 
+           I1 : LONG_INTEGER := IDENT (1);
+           I5 : LONG_INTEGER := IDENT (5);
+ 
+           CI2  : CONSTANT LONG_INTEGER := 2;
+           CI10 : CONSTANT LONG_INTEGER := 10;
+ 
+ 
+      BEGIN -- (B)
+ 
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.1" );
+           END IF;
+ 
+           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.3" );
+           END IF;
+ 
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.5" );
+           END IF;
+ 
+      END; -- (B)
+ 
+      -------------------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE ST IS LONG_INTEGER RANGE -10 .. 10;
+ 
+           I1 : LONG_INTEGER := IDENT (1);
+           I5 : LONG_INTEGER := IDENT (5);
+ 
+           CI2  : CONSTANT LONG_INTEGER := 2;
+           CI10 : CONSTANT LONG_INTEGER := 10;
+ 
+ 
+           FUNCTION ">" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN LONG_INTEGER'POS (L) <= LONG_INTEGER'POS (R);
+           END;
+ 
+           FUNCTION ">=" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN LONG_INTEGER'POS (L) < LONG_INTEGER'POS (R);
+           END;
+ 
+           FUNCTION "<" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN  LONG_INTEGER'POS (L) >= LONG_INTEGER'POS (R);
+           END;
+ 
+           FUNCTION "<=" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN LONG_INTEGER'POS (L) > LONG_INTEGER'POS (R);
+           END;
+ 
+      BEGIN -- (C)
+ 
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.1" );
+           END IF;
+ 
+           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.3" );
+           END IF;
+ 
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.5" );
+           END IF;
+ 
+      END; -- (C)
+ 
+      RESULT;
+ 
+ END C45231C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231d.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45231d.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45231d.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,274 ----
+ -- C45231D.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD CORRECT
+ --     RESULTS FOR PREDEFINED TYPE $NAME (INCLUDING THE CASE IN
+ --     WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
+ 
+ --     SUBTESTS ARE:
+ --         (A). TESTS FOR RELATIONAL OPERATORS.
+ --         (B). TESTS FOR MEMBERSHIP OPERATORS.
+ --         (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
+ --              RELATIONAL OPERATORS ARE REDEFINED.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT A
+ --     PREDEFINED INTEGER TYPE OTHER THAN INTEGER, SHORT_INTEGER, OR
+ --     LONG_INTEGER.
+ 
+ --     IF NO SUCH PREDEFINED INTEGER TYPE IS SUPPORTED, THEN THE
+ --     SPECIFICATION OF THE FUNCTION IDENT MUST BE REJECTED.
+ 
+ -- MACRO SUBSTITUTION:
+ --     $NAME IS A PREDEFINED INTEGER TYPE OTHER THAN INTEGER,
+ --     SHORT_INTEGER, AND LONG_INTEGER.
+ 
+ -- HISTORY:
+ --     RJW 02/04/86
+ --     THS 04/16/90  ADDED OMITTED "-- N/A => ERROR." MESSAGE AND
+ --                   MODIFIED HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45231D IS
+ 
+      FUNCTION IDENT (X : $NAME)
+           RETURN $NAME IS   -- N/A => ERROR.
+      BEGIN
+           RETURN $NAME (IDENT_INT (INTEGER (X)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ( "C45231D", "CHECK THAT THE RELATIONAL AND " &
+                        "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                        "RESULTS FOR PREDEFINED TYPE $NAME " &
+                        "(INCLUDING THE CASE IN WHICH THE " &
+                        "RELATIONAL OPERATORS ARE REDEFINED)" );
+ 
+      DECLARE -- (A)
+ 
+           I1A, I1B   : $NAME          := IDENT (1);
+           I2         : $NAME          := IDENT (2);
+           CI2        : CONSTANT $NAME := 2;
+ 
+ 
+      BEGIN -- (A)
+ 
+           IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 1" );
+           END IF;
+ 
+           IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 2" );
+           END IF;
+ 
+           IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 3" );
+           END IF;
+ 
+           IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 4");
+           END IF;
+ 
+           IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 5" );
+           END IF;
+ 
+           IF (I1A >= I1B) AND (I1A <= I1B) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 6" );
+           END IF;
+ 
+           IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 7" );
+           END IF;
+ 
+           IF "<" (LEFT => I1A, RIGHT => I2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 8" );
+           END IF;
+ 
+           IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 9 ");
+           END IF;
+ 
+           IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 10 ");
+           END IF;
+ 
+           IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 11 ");
+           END IF;
+ 
+           IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+                NULL;
+           ELSE
+                FAILED ( "RELATIONAL TEST - 12 ");
+           END IF;
+ 
+      END; -- (A)
+ 
+      ----------------------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           SUBTYPE ST IS $NAME RANGE -10 .. 10;
+ 
+           I1 : $NAME := IDENT (1);
+           I5 : $NAME := IDENT (5);
+ 
+           CI2  : CONSTANT $NAME := 2;
+           CI10 : CONSTANT $NAME := 10;
+ 
+ 
+      BEGIN -- (B)
+ 
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.1" );
+           END IF;
+ 
+           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.3" );
+           END IF;
+ 
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - B.5" );
+           END IF;
+ 
+      END; -- (B)
+ 
+      -------------------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE ST IS $NAME RANGE -10 .. 10;
+ 
+           I1 : $NAME := IDENT (1);
+           I5 : $NAME := IDENT (5);
+ 
+           CI2  : CONSTANT $NAME := 2;
+           CI10 : CONSTANT $NAME := 10;
+ 
+ 
+           FUNCTION ">" ( L, R : $NAME ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN $NAME'POS (L) <= 
+ 	              $NAME'POS (R);
+           END;
+ 
+           FUNCTION ">=" ( L, R : $NAME ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN $NAME'POS (L) < 
+                       $NAME'POS (R);
+           END;
+ 
+           FUNCTION "<" ( L, R : $NAME ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN  $NAME'POS (L) >= 
+                        $NAME'POS (R);
+           END;
+ 
+           FUNCTION "<=" ( L, R : $NAME ) RETURN BOOLEAN IS
+           BEGIN
+                RETURN $NAME'POS (L) > 
+                       $NAME'POS (R);
+           END;
+ 
+      BEGIN -- (C)
+ 
+           IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.1" );
+           END IF;
+ 
+           IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.2" );
+           END IF;
+ 
+           IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.3" );
+           END IF;
+ 
+           IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.4" );
+           END IF;
+ 
+           IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+                NULL;
+           ELSE
+                FAILED ( "MEMBERSHIP TEST - C.5" );
+           END IF;
+ 
+      END; -- (C)
+ 
+      RESULT;
+ 
+ END C45231D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45232b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45232b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45232b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45232b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,135 ----
+ -- C45232B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NO EXCEPTION IS RAISED WHEN AN INTEGER LITERAL IN
+ -- A COMPARISON  BELONGS TO THE BASE TYPE BUT IS OUTSIDE THE 
+ -- SUBTYPE OF THE OTHER OPERAND.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- P. BRASHEAR  08/21/86
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT, SYSTEM; USE REPORT;
+ PROCEDURE C45232B IS
+ 
+ BEGIN
+ 
+      TEST ("C45232B", "NO EXCEPTION IS RAISED WHEN AN INTEGER " & 
+                       "LITERAL IN A COMPARISON BELONGS TO THE BASE " &
+                       "TYPE BUT IS OUTSIDE THE SUBTYPE OF THE " &
+                       "OTHER OPERAND");
+ 
+      DECLARE
+ 
+            TYPE INT10 IS RANGE -10 .. 5;
+ 
+      BEGIN    
+ 
+           IF 7 > INT10'(-10) THEN
+                COMMENT ("NO EXCEPTION RAISED FOR '7 > " &
+                         "INT10'(-10)'");
+           ELSE
+                FAILED ("WRONG RESULT FOR '7 > INT10'(-10)'");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR '7 " &
+                        "> INT10'(-10)'");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR '7 > " &
+                        "INT10'(-10)'");
+      END;  
+ 
+      DECLARE
+ 
+            TYPE INT10 IS RANGE -10 .. 5;
+ 
+      BEGIN    
+ 
+           IF 7 NOT IN INT10 THEN
+                COMMENT ("NO EXCEPTION RAISED FOR '7 NOT IN " &
+                         "INT'");
+           ELSE
+                FAILED ("WRONG RESULT FOR '7 NOT IN INT'");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR '7 " &
+                        "NOT IN INT'");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR '7 NOT IN " &
+                        "INT'");
+      END;  
+ 
+      DECLARE
+ 
+            TYPE INT700 IS RANGE -700 .. 500;
+ 
+      BEGIN    
+           IF 600 > INT700'(5) THEN
+                COMMENT ("NO EXCEPTION RAISED FOR '600 > " &
+                         "INT700'(5)'");
+           ELSE
+                FAILED ("WRONG RESULT FOR '600 > INT700'(5)'");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR '600 " &
+                        "> INT700'(5)'");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR '600 > " &
+                        "INT700'(5)'");
+      END;  
+ 
+      DECLARE
+ 
+            TYPE INT700 IS RANGE -700 .. 500;
+ 
+      BEGIN    
+ 
+           IF 600 NOT IN INT700 THEN
+                COMMENT ("NO EXCEPTION RAISED FOR '600 NOT IN " &
+                         "INT700'");
+           ELSE
+                FAILED ("WRONG RESULT FOR '600 NOT IN INT700'");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR '600 " &
+                        "NOT IN INT700'");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR '600 NOT IN " &
+                        "INT700'");
+      END;  
+ 
+      RESULT;
+ 
+ END C45232B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45242b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45242b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45242b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45242b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- C45242B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT NO EXCEPTION IS RAISED WHEN A FLOATING POINT LITERAL
+ --     OPERAND IN A COMPARISON OR A FLOATING POINT LITERAL LEFT OPERAND
+ --     IN A MEMBERSHIP TEST BELONGS TO THE BASE TYPE BUT IS OUTSIDE
+ --     THE RANGE OF THE SUBTYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     PWB 09/04/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT, SYSTEM; USE REPORT;
+ PROCEDURE C45242B IS
+ 
+ BEGIN
+ 
+      TEST ("C45242B", "NO EXCEPTION IS RAISED WHEN A FLOATING " &
+                       "LITERAL USED IN A COMPARISON OR AS THE " &
+                       "LEFT OPERAND IN A MEMBERSHIP TEST " &
+                       "BELONGS TO THE BASE TYPE BUT IS OUTSIDE " &
+                       "THE RANGE OF THE SUBTYPE");
+ 
+      DECLARE
+           N : FLOAT := FLOAT (IDENT_INT (1));
+           SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
+           NUM : FLOAT_1 := N;
+      BEGIN    -- PRE-DEFINED FLOAT COMPARISON
+ 
+           IF EQUAL(3,3) THEN
+                NUM := FLOAT_1'(0.5);
+           END IF;
+ 
+           IF 2.0 > NUM THEN
+                COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
+                         "COMPARISON");
+           ELSE
+                FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
+                        "COMPARISON");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
+                        "FLOAT COMPARISON");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
+                        "FLOAT COMPARISON");
+      END;  -- PRE-DEFINED FLOAT COMPARISON
+ 
+      DECLARE
+           N : FLOAT := FLOAT (IDENT_INT (1));
+           SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
+      BEGIN    -- PRE-DEFINED FLOAT MEMBERSHIP
+ 
+           IF 2.0 IN FLOAT_1 THEN
+                FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
+                        "MEMBERSHIP");
+           ELSE
+                COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
+                         "MEMBERSHIP");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
+                        "FLOAT MEMBERSHIP");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
+                        "FLOAT MEMBERSHIP");
+      END;  -- PRE-DEFINED FLOAT MEMBERSHIP
+ 
+      DECLARE -- PRECISE FLOAT COMPARISON
+           TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
+           N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
+           SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
+           NUM : SUB_FINE := N;
+      BEGIN
+           IF EQUAL(3,3) THEN
+                NUM := 0.25;
+           END IF;
+ 
+           IF 0.75 > NUM THEN
+                COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
+                         "COMPARISON");
+           ELSE
+                FAILED ("WRONG RESULT FROM FINE_FLOAT COMPARISON");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                        "FINE_FLOAT COMPARISON");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                        "FINE_FLOAT COMPARISON");
+      END;  --  FINE_FLOAT COMPARISON
+ 
+      DECLARE -- PRECISE FLOAT MEMBERSHIP
+           TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
+           N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
+           SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
+      BEGIN
+ 
+           IF 0.75 IN SUB_FINE THEN
+                FAILED ("WRONG RESULT FROM FINE_FLOAT MEMBERSHIP");
+           ELSE
+                COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
+                         "MEMBERSHIP");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                        "FINE_FLOAT MEMBERSHIP");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                        "FINE_FLOAT MEMBERSHIP");
+      END;  --  FINE_FLOAT MEMBERSHIP
+ 
+      RESULT;
+ 
+ END C45242B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45251a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45251a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45251a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45251a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,178 ----
+ -- C45251A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR RELATIONAL OPERATIONS ON FIXED POINT TYPES THE
+ -- FOLLOWING HOLD:
+ --       (A) A /= B IS THE SAME AS NOT (A = B).
+ --       (B) A < B IS THE SAME AS NOT (A >= B).
+ --       (C) A > B IS THE SAME AS NOT (A <= B).
+ --       (D) ADJACENT MODEL NUMBERS GIVE CORRECT RESULTS.
+ --       (E) NON-MODEL NUMBERS WITH DISTINCT MODEL INTERVALS GIVE
+ --           CORRECT RESULTS.
+ --       (F) CASE WHERE MODEL INTERVALS INTERSECT IN A SINGLE MODEL
+ --           NUMBER GIVES CORRECT RESULT.
+ 
+ -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+ 
+ -- WRG 8/26/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45251A IS
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+ 
+ BEGIN
+ 
+      TEST ("C45251A", "CHECK RELATIONAL OPERATIONS FOR FIXED POINT " &
+                       "TYPES - BASIC TYPES");
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           A, B : LIKE_DURATION_M23 := 0.0;
+           C, D : DECIMAL_M4        := 0.0;
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 2#0.0000_0011#; -- JUST BELOW LIKE_DURATION'SMALL.
+                B := 2#0.0000_0101#; -- JUST ABOVE LIKE_DURATION'SMALL.
+           END IF;
+ 
+           -- (A)
+           IF A /= B XOR NOT (A = B) THEN
+                FAILED ("A /= B IS NOT THE SAME AS NOT (A = B)");
+           END IF;
+ 
+           -- (B)
+           IF A < B XOR NOT (A >= B) THEN
+                FAILED ("A < B IS NOT THE SAME AS NOT (A >= B)");
+           END IF;
+ 
+           -- (C)
+           IF A > B XOR NOT (A <= B) THEN
+                FAILED ("A > B IS NOT THE SAME AS NOT (A <= B)");
+           END IF;
+ 
+           -- (D)
+           IF EQUAL (3, 3) THEN
+                A := -(16#1_5180.00#); -- (-86_400.0)
+                B := -(16#1_517F.FC#); -- (-86_400.0 + 1.0/64)
+ 
+                C :=  64.0; -- DECIMAL_M4'SMALL.
+                D := 128.0; -- 2 * DECIMAL_M4'SMALL.
+           END IF;
+           IF "=" (LEFT => A, RIGHT => B) THEN
+                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                        "- (A = B)");
+           END IF;
+           IF NOT "/=" (LEFT => C, RIGHT => D) THEN
+                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                        "- (C /= D)");
+           END IF;
+           IF "<" (LEFT => B, RIGHT => A) THEN
+                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                        "- (B < A)");
+           END IF;
+           IF ">" (LEFT => C, RIGHT => D) THEN
+                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                        "- (C > D)");
+           END IF;
+           IF ">=" (LEFT => A, RIGHT => B) THEN
+                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                        "- (A >= B)");
+           END IF;
+           IF "<=" (LEFT => D, RIGHT => C) THEN
+                FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                        "- (D <= C)");
+           END IF;
+ 
+           -- (E)
+           IF EQUAL (3, 3) THEN
+                A :=  0.02;  -- INTERVAL IS  1.0/64 ..  2.0/64.
+                B := -0.02;  -- INTERVAL IS -2.0/64 .. -1.0/64.
+ 
+                C :=  800.0; -- INTERVAL IS 768.0 .. 832.0.
+                D :=  900.0; -- INTERVAL IS 896.0 .. 960.0.
+           END IF;
+           IF A = B THEN
+                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                        "INTERVALS GIVE INCORRECT RESULT - (A = B)");
+           END IF;
+           IF NOT (C /= D) THEN
+                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                        "INTERVALS GIVE INCORRECT RESULT - (C /= D)");
+           END IF;
+           IF A < B THEN
+                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                        "INTERVALS GIVE INCORRECT RESULT - (A < B)");
+           END IF;
+           IF C > D THEN
+                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                        "INTERVALS GIVE INCORRECT RESULT - (C > D)");
+           END IF;
+           IF B >= A THEN
+                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                        "INTERVALS GIVE INCORRECT RESULT - (B >= A)");
+           END IF;
+           IF D <= C THEN
+                FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                        "INTERVALS GIVE INCORRECT RESULT - (D <= C)");
+           END IF;
+ 
+           -- (F)
+           IF EQUAL (3, 3) THEN
+                B := 0.035;  -- INTERVAL IS 2.0/64 .. 3.0/64.
+ 
+                C := 850.0;  -- INTERVAL IS 832.0 .. 896.0.
+           END IF;
+           IF NOT (A <= B) THEN
+                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                        "COMMON MODEL INTERVAL END-POINT GIVES " &
+                        "INCORRECT RESULT - (A <= B)");
+           END IF;
+           IF A > B THEN
+                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                        "COMMON MODEL INTERVAL END-POINT GIVES " &
+                        "INCORRECT RESULT - (A > B)");
+           END IF;
+           IF NOT (D >= C) THEN
+                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                        "COMMON MODEL INTERVAL END-POINT GIVES " &
+                        "INCORRECT RESULT - (D >= C)");
+           END IF;
+           IF D < C THEN
+                FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                        "COMMON MODEL INTERVAL END-POINT GIVES " &
+                        "INCORRECT RESULT - (D < C)");
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ END C45251A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45252a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45252a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45252a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45252a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,200 ----
+ -- C45252A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR FIXED POINT TYPES, CHECK THAT
+ -- CONSTRAINT_ERROR IS RAISED WHEN A LITERAL USED IN A COMPARISON OR
+ -- MEMBERSHIP OPERATION (AS THE FIRST OPERAND) DOES NOT BELONG TO THE
+ -- BASE TYPE.
+ --
+ -- CHECK THAT NO EXCEPTION IS RAISED FOR A FIXED POINT RELATIONAL OR
+ -- MEMBERSHIP OPERATION IF LITERAL VALUES BELONG TO THE BASE TYPE.
+ 
+ -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- WRG 9/10/86
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45252A IS
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+ 
+ BEGIN
+ 
+      TEST ("C45252A", "CHECK RAISING OF EXCEPTIONS BY RELATIONAL " &
+                       "OPERATIONS FOR FIXED POINT TYPES - BASIC TYPES");
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           -- 2.0 ** 31 < 2.9E9 < 2.0 ** 32.
+           IF 2.9E9 <= LIKE_DURATION_M23'LAST THEN
+                FAILED ("2.9E9 <= LIKE_DURATION_M23'LAST");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                         """2.9E9 <= LIKE_DURATION_M23'LAST""");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY COMPARISON " &
+                        """2.9E9 <= LIKE_DURATION_M23'LAST""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           -- 2.0 ** 63 < 1.0E19 < 2.0 ** 64.
+           IF 1.0E19 IN LIKE_DURATION_M23 THEN
+                FAILED ("1.0E19 IN LIKE_DURATION_M23");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                         """1.0E19 IN LIKE_DURATION_M23""");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                        """1.0E19 IN LIKE_DURATION_M23""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           -- 2.0 ** 63 < 1.0E19 < 2.0 ** 64.
+           IF 1.0E19 <= MIDDLE_M3'LAST THEN
+                FAILED ("1.0E19 <= MIDDLE_M3'LAST");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                         """1.0E19 <= MIDDLE_M3'LAST""");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY COMPARISON " &
+                        """1.0E19 <= MIDDLE_M3'LAST""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           -- 2.0 ** 31 < 2.9E9 < 2.0 ** 32.
+           IF 2.9E9 IN MIDDLE_M3 THEN
+                FAILED ("2.9E9 IN MIDDLE_M3");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                         """2.9E9 IN MIDDLE_M3""");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                        """2.9E9 IN MIDDLE_M3""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           -- 3.5 IS A MODEL NUMBER OF THE TYPE MIDDLE_M3.
+           IF 3.5 <= MIDDLE_M3'LAST THEN
+                FAILED ("3.5 <= MIDDLE_M3'LAST");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                        """3.5 <= MIDDLE_M3'LAST""");
+           WHEN OTHERS =>
+                FAILED ("SOME EXCEPTION RAISED BY COMPARISON " &
+                        """3.5 <= MIDDLE_M3'LAST""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           IF 3.0 IN MIDDLE_M3 THEN
+                FAILED ("3.0 IN MIDDLE_M3");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                        """3.0 IN MIDDLE_M3""");
+           WHEN OTHERS =>
+                FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                        """3.0 IN MIDDLE_M3""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           IF 86_450.0 <= LIKE_DURATION_M23'LAST THEN
+                FAILED ("86_450.0 <= LIKE_DURATION_M23'LAST");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                        """86_450.0 <= LIKE_DURATION_M23'LAST""");
+           WHEN OTHERS =>
+                FAILED ("SOME EXCEPTION RAISED BY COMPARISON " &
+                        """86_450.0 <= LIKE_DURATION_M23'LAST""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           IF 86_500.0 IN LIKE_DURATION_M23 THEN
+                FAILED ("86_500.0 IN LIKE_DURATION_M23");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                        """86_500.0 IN LIKE_DURATION_M23""");
+           WHEN OTHERS =>
+                FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                        """86_500.0 IN LIKE_DURATION_M23""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      BEGIN
+           IF -86_450.0 IN LIKE_DURATION_M23 THEN
+                FAILED ("-86_450.0 IN LIKE_DURATION_M23");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                        """-86_450.0 IN LIKE_DURATION_M23""");
+           WHEN OTHERS =>
+                FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                        """-86_450.0 IN LIKE_DURATION_M23""");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ END C45252A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45252b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45252b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45252b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45252b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- C45252B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT NO EXCEPTION IS RAISED WHEN A FIXED POINT LITERAL
+ --     OPERAND IN A COMPARISON OR A FIXED POINT LITERAL LEFT OPERAND
+ --     IN A MEMBERSHIP TEST BELONGS TO THE BASE TYPE BUT IS OUTSIDE
+ --     THE RANGE OF THE SUBTYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     PWB 09/04/86 CREATED ORIGINAL TEST.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT, SYSTEM; USE REPORT;
+ PROCEDURE C45252B IS
+ 
+ BEGIN
+ 
+      TEST ("C45252B", "NO EXCEPTION IS RAISED WHEN A FIXED " &
+                       "LITERAL USED IN A COMPARISON OR AS THE " &
+                       "LEFT OPERAND IN A MEMBERSHIP TEST " &
+                       "BELONGS TO THE BASE TYPE BUT IS OUTSIDE " &
+                       "THE RANGE OF THE SUBTYPE");
+ 
+      DECLARE
+           TYPE FIXED IS DELTA 0.25 RANGE -10.0 .. 10.0;
+           SUBTYPE FIXED_1 IS FIXED RANGE -1.0 .. 1.0;
+           NUM : FIXED_1 := 0.0;
+      BEGIN    -- FIXED COMPARISON
+ 
+           IF EQUAL(3,3) THEN
+                NUM := FIXED_1'(0.5);
+           END IF;
+ 
+           IF 2.0 > NUM THEN
+                COMMENT ("NO EXCEPTION RAISED FOR FIXED " &
+                         "COMPARISON");
+           ELSE
+                FAILED ("WRONG RESULT FROM FIXED " &
+                        "COMPARISON");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                        "FIXED COMPARISON");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR " &
+                        "FIXED COMPARISON");
+      END;  -- FIXED COMPARISON
+ 
+      DECLARE
+           TYPE FIXED IS DELTA 0.25 RANGE -10.0 .. 10.0;
+           SUBTYPE FIXED_1 IS FIXED RANGE -1.0 .. 1.0;
+      BEGIN    -- FIXED MEMBERSHIP
+ 
+           IF 2.0 IN FIXED_1 THEN
+                FAILED ("WRONG RESULT FROM FIXED " &
+                        "MEMBERSHIP");
+           ELSE
+                COMMENT ("NO EXCEPTION RAISED FOR FIXED " &
+                         "MEMBERSHIP");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR  " &
+                        "FIXED MEMBERSHIP");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                        "FIXED MEMBERSHIP");
+      END;  -- FIXED MEMBERSHIP
+ 
+      DECLARE -- PRECISE FIXED COMPARISON
+           TYPE FINE_FIXED IS DELTA SYSTEM.FINE_DELTA RANGE -1.0 .. 1.0;
+           SUBTYPE SUB_FINE IS FINE_FIXED RANGE -0.5 .. 0.5;
+           NUM : SUB_FINE := 0.0;
+      BEGIN
+           IF EQUAL(3,3) THEN
+                NUM := 0.25;
+           END IF;
+ 
+           IF 0.75 > NUM THEN
+                COMMENT ("NO EXCEPTION RAISED FOR FINE_FIXED " &
+                         "COMPARISON");
+           ELSE
+                FAILED ("WRONG RESULT FROM FINE_FIXED COMPARISON");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                        "FINE_FIXED COMPARISON");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                        "FINE_FIXED COMPARISON");
+      END;  --  FINE_FIXED COMPARISON
+ 
+      DECLARE -- PRECISE FIXED MEMBERSHIP
+           TYPE FINE_FIXED IS DIGITS SYSTEM.MAX_DIGITS;
+           SUBTYPE SUB_FINE IS FINE_FIXED RANGE -0.5 .. 0.5;
+      BEGIN
+ 
+           IF 0.75 IN SUB_FINE THEN
+                FAILED ("WRONG RESULT FROM FINE_FIXED MEMBERSHIP");
+           ELSE
+                COMMENT ("NO EXCEPTION RAISED FOR FINE_FIXED " &
+                         "MEMBERSHIP");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                        "FINE_FIXED MEMBERSHIP");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                        "FINE_FIXED MEMBERSHIP");
+      END;  --  FINE_FIXED MEMBERSHIP
+ 
+      RESULT;
+ 
+ END C45252B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45253a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45253a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45253a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45253a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C45253A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES "A IN T" AND "A NOT IN T" GIVE
+ -- APPROPRIATE RESULTS, EVEN WHEN USER-DEFINED ORDERING OPERATORS EXIST
+ -- FOR T.
+ 
+ -- WRG 8/27/86
+ -- JRL 06/12/96  Added function The_Delta. Eliminated static expressions
+ --               outside the base range of type T.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45253A IS
+ 
+      TYPE FIXED IS DELTA 0.25 RANGE 0.0 .. 1000.0;
+      TYPE T IS NEW FIXED;
+ 
+      FUNCTION "<" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+      BEGIN
+           RETURN FIXED (LEFT) >= FIXED (RIGHT);
+      END "<";
+ 
+      FUNCTION "<=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+      BEGIN
+           RETURN FIXED (LEFT) > FIXED (RIGHT);
+      END "<=";
+ 
+      FUNCTION ">" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+      BEGIN
+           RETURN FIXED (LEFT) <= FIXED (RIGHT);
+      END ">";
+ 
+      FUNCTION ">=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+      BEGIN
+           RETURN FIXED (LEFT) < FIXED (RIGHT);
+      END ">=";
+ 
+      function The_Delta return T is
+      begin
+         return T'Delta;
+      end The_Delta;
+ 
+ BEGIN
+ 
+      TEST ("C45253A", "CHECK THAT FOR FIXED POINT TYPES ""A IN T"" " &
+                       "AND ""A NOT IN T"" GIVE APPROPRIATE RESULTS, " &
+                       "EVEN WHEN USER-DEFINED ORDERING OPERATORS " &
+                       "EXIST FOR T");
+ 
+      IF IDENT_INT (1) * 0.0 NOT IN T THEN
+           FAILED ("0.0 NOT IN T");
+      END IF;
+ 
+ -- 06/12/96      IF IDENT_INT (1) * 1000.0 NOT IN T THEN
+      if Ident_Int (2) * 500.0 not in T then
+           FAILED ("1000.0 NOT IN T");
+      END IF;
+ 
+ -- 06/12/96      IF IDENT_INT (1) * (-0.25) IN T THEN
+      if Ident_Int (1) * (-The_Delta) in T then
+           FAILED ("-0.25 IN T");
+      END IF;
+ 
+ -- 06/12/96      IF IDENT_INT (1) * 1000.25 IN T THEN
+      if Ident_Int (2) * 500.0 + The_Delta in T then
+           FAILED ("1000.25 IN T");
+      END IF;
+ 
+ -- 06/12/96      IF IDENT_INT (1) * (-1000.0) IN T THEN
+      if Ident_Int (2) * (-500.0) in T then
+           FAILED ("-1000.0 IN T");
+      END IF;
+ 
+      RESULT;
+ 
+ END C45253A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,214 ----
+ -- C45262A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+ -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS ARRAYS OF
+ -- INTEGERS.
+ 
+ -- JWC 8/19/85
+ -- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45262A IS
+ BEGIN
+      TEST ("C45262A", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                       "DISCRETE ARRAY TYPES - INTEGER COMPONENTS");
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY( INTEGER RANGE <> ) OF INTEGER;
+           ARR1 : ARR(1 .. IDENT_INT(0));
+           ARR2 : ARR(2 .. IDENT_INT(0));
+           ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 0);
+           ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 0);
+           ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 1);
+           ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => 0);
+           ARR7 : ARR(0 .. 4) := (0 .. 3 => 0, 4 => 1);
+           ARR8 : ARR(0 .. IDENT_INT(4)) := (0 .. IDENT_INT(4) => 0);
+           ARR9 : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => 0);
+           ARRA : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => 1);
+ 
+      BEGIN
+           IF ARR1 < ARR2 THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR1 <= ARR2) THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <=");
+           END IF;
+ 
+           IF ARR1 > ARR2 THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >");
+           END IF;
+ 
+           IF NOT ( ">=" (ARR1, ARR2) ) THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >=");
+           END IF;
+ 
+           IF ARR3 < ARR1 THEN
+                FAILED ("NON-NULL ARRAY ARR3 LESS THAN NULL ARR1");
+           END IF;
+ 
+           IF ARR3 <= ARR1 THEN
+                FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL ARR1");
+           END IF;
+ 
+           IF NOT ( ">" (ARR3, ARR1) ) THEN
+                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN NULL " &
+                        "ARR1");
+           END IF;
+ 
+           IF NOT (ARR3 >= ARR1) THEN
+                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN EQUAL " &
+                        "NULL ARR1");
+           END IF;
+ 
+           IF ARR3 < ARR4 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF NOT ( "<=" (ARR3, ARR4) ) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF ARR3 > ARR4 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (ARR3 >= ARR4) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF NOT ( "<" (ARR3, ARR5) ) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR3 <= ARR5) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <=");
+           END IF;
+ 
+           IF ARR3 > ARR5 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF ARR3 >= ARR5 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >=");
+           END IF;
+ 
+           IF NOT (ARR6 < ARR7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR6 <= ARR7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                        "<=");
+           END IF;
+ 
+           IF ARR6 > ARR7 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF ">=" (LEFT => ARR6, RIGHT => ARR7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                        ">=");
+           END IF;
+ 
+           IF ARR6 < ARR8 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR6 <= ARR8) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF ">" (RIGHT => ARR8, LEFT => ARR6) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (ARR6 >= ARR8) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF ARR8 < ARR9 THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF ARR8 <= ARR9 THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF NOT (ARR8 > ARR9) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (ARR8 >= ARR9) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF NOT (ARR8 < ARRA) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR8 <= ARRA) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <=");
+           END IF;
+ 
+           IF ARR8 > ARRA THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF ARR8 >= ARRA THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >=");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45262A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,219 ----
+ -- C45262B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+ -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS STRING TYPES.
+ 
+ -- JWC 9/9/85
+ -- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45262B IS
+ BEGIN
+      TEST ("C45262B", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                       "DISCRETE ARRAY TYPES - TYPE STRING");
+ 
+      DECLARE
+ 
+           STRING1 : STRING(2 .. IDENT_INT(1));
+           STRING2 : STRING(3 .. IDENT_INT(1));
+           STRING3 : STRING(2 .. IDENT_INT(2)) := (IDENT_INT(2) => 'A');
+           STRING4 : STRING(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 'A');
+           STRING5 : STRING(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 'B');
+           STRING6 : STRING(2 .. IDENT_INT(6)) :=
+                                              (2 .. IDENT_INT(6) => 'A');
+           STRING7 : STRING(1 .. 5) := (1 .. 4 => 'A', 5 => 'B');
+           STRING8 : STRING(1 .. IDENT_INT(5)) :=
+                                              (1 .. IDENT_INT(5) => 'A');
+           STRING9 : STRING(1 .. IDENT_INT(4)) :=
+                                              (1 .. IDENT_INT(4) => 'A');
+           STRINGA : STRING(1 .. IDENT_INT(4)) :=
+                                              (1 .. IDENT_INT(4) => 'B');
+ 
+      BEGIN
+           IF STRING1 < STRING2 THEN
+                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (STRING1 <= STRING2) THEN
+                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - " &
+                        "<=");
+           END IF;
+ 
+           IF STRING1 > STRING2 THEN
+                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - >");
+           END IF;
+ 
+           IF NOT ( ">=" (STRING1, STRING2) ) THEN
+                FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - " &
+                        ">=");
+           END IF;
+ 
+           IF STRING3 < STRING1 THEN
+                FAILED ("NON-NULL ARRAY STRING3 LESS THAN NULL STRING1");
+           END IF;
+ 
+           IF STRING3 <= STRING1 THEN
+                FAILED ("NON-NULL ARRAY STRING3 LESS THAN EQUAL NULL " &
+                         "STRING1");
+           END IF;
+ 
+           IF NOT ( ">" (STRING3, STRING1) ) THEN
+                FAILED ("NON-NULL ARRAY STRING3 NOT GREATER THAN NULL " &
+                        "STRING1");
+           END IF;
+ 
+           IF NOT (STRING3 >= STRING1) THEN
+                FAILED ("NON-NULL ARRAY STRING3 NOT GREATER THAN " &
+                        "EQUAL NULL STRING1");
+           END IF;
+ 
+           IF STRING3 < STRING4 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF NOT ( "<=" (STRING3, STRING4) ) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF STRING3 > STRING4 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (STRING3 >= STRING4) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF NOT ( "<" (STRING3, STRING5) ) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (STRING3 <= STRING5) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <=");
+           END IF;
+ 
+           IF STRING3 > STRING5 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF STRING3 >= STRING5 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >=");
+           END IF;
+ 
+           IF NOT (STRING6 < STRING7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (STRING6 <= STRING7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                        "<=");
+           END IF;
+ 
+           IF STRING6 > STRING7 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF ">=" (LEFT => STRING6, RIGHT => STRING7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                        ">=");
+           END IF;
+ 
+           IF STRING6 < STRING8 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF NOT (STRING6 <= STRING8) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF ">" (RIGHT => STRING8, LEFT => STRING6) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (STRING6 >= STRING8) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF STRING8 < STRING9 THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF STRING8 <= STRING9 THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF NOT (STRING8 > STRING9) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (STRING8 >= STRING9) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF NOT (STRING8 < STRINGA) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (STRING8 <= STRINGA) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <=");
+           END IF;
+ 
+           IF STRING8 > STRINGA THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF STRING8 >= STRINGA THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >=");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45262B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,216 ----
+ -- C45262C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+ -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS ARRAYS OF
+ -- AN ENUMERATION TYPE.
+ 
+ -- JWC 8/19/85
+ -- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45262C IS
+ BEGIN
+      TEST ("C45262C", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                       "DISCRETE ARRAY TYPES - ENUMERATED COMPONENTS");
+ 
+      DECLARE
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 5;
+           TYPE ENUM IS (E0, E1);
+           TYPE ARR IS ARRAY( SUBINT RANGE <> ) OF ENUM;
+           ARR1 : ARR(1 .. IDENT_INT(0));
+           ARR2 : ARR(2 .. IDENT_INT(0));
+           ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => E0);
+           ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => E0);
+           ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => E1);
+           ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => E0);
+           ARR7 : ARR(0 .. 4) := (0 .. 3 => E0, 4 => E1);
+           ARR8 : ARR(0 .. IDENT_INT(4)) := (0 .. IDENT_INT(4) => E0);
+           ARR9 : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => E0);
+           ARRA : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => E1);
+ 
+      BEGIN
+           IF ARR1 < ARR2 THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR1 <= ARR2) THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <=");
+           END IF;
+ 
+           IF ARR1 > ARR2 THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >");
+           END IF;
+ 
+           IF NOT ( ">=" (ARR1, ARR2) ) THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >=");
+           END IF;
+ 
+           IF ARR3 < ARR1 THEN
+                FAILED ("NON-NULL ARRAY ARR3 LESS THAN NULL ARR1");
+           END IF;
+ 
+           IF ARR3 <= ARR1 THEN
+                FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL ARR1");
+           END IF;
+ 
+           IF NOT ( ">" (ARR3, ARR1) ) THEN
+                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN NULL " &
+                        "ARR1");
+           END IF;
+ 
+           IF NOT (ARR3 >= ARR1) THEN
+                FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN EQUAL " &
+                        "NULL ARR1");
+           END IF;
+ 
+           IF ARR3 < ARR4 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF NOT ( "<=" (ARR3, ARR4) ) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF ARR3 > ARR4 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (ARR3 >= ARR4) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF NOT ( "<" (ARR3, ARR5) ) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR3 <= ARR5) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <=");
+           END IF;
+ 
+           IF ARR3 > ARR5 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF ARR3 >= ARR5 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >=");
+           END IF;
+ 
+           IF NOT (ARR6 < ARR7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR6 <= ARR7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                        "<=");
+           END IF;
+ 
+           IF ARR6 > ARR7 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF ">=" (LEFT => ARR6, RIGHT => ARR7) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                        ">=");
+           END IF;
+ 
+           IF ARR6 < ARR8 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR6 <= ARR8) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF ">" (RIGHT => ARR8, LEFT => ARR6) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (ARR6 >= ARR8) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF ARR8 < ARR9 THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <");
+           END IF;
+ 
+           IF ARR8 <= ARR9 THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - <=");
+           END IF;
+ 
+           IF NOT (ARR8 > ARR9) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (ARR8 >= ARR9) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >=");
+           END IF;
+ 
+           IF NOT (ARR8 < ARRA) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+           IF NOT (ARR8 <= ARRA) THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - <=");
+           END IF;
+ 
+           IF ARR8 > ARRA THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >");
+           END IF;
+ 
+           IF ARR8 >= ARRA THEN
+                FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >=");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45262C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45262d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45262d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C45262D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+ -- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST USES
+ -- USER-DEFINED ORDERING OPERATORS FOR THE DISCRETE COMPONENT TYPE.
+ 
+ -- JWC 8/19/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45262D IS
+ 
+      FUNCTION "<"(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN STANDARD.">="(LEFT, RIGHT);
+      END "<";
+ 
+      FUNCTION "<="(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN STANDARD.">"(LEFT, RIGHT);
+      END "<=";
+ 
+      FUNCTION ">"(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN STANDARD."<="(LEFT, RIGHT);
+      END ">";
+ 
+      FUNCTION ">="(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN STANDARD."<"(LEFT, RIGHT);
+      END ">=";
+ 
+ BEGIN
+      TEST ("C45262D", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                       "DISCRETE ARRAY TYPES");
+ 
+      DECLARE
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 5;
+           TYPE ARR IS ARRAY( SUBINT RANGE <> ) OF INTEGER;
+           ARR1 : ARR(1 .. IDENT_INT(0));
+           ARR2 : ARR(2 .. IDENT_INT(0));
+           ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 0);
+           ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 0);
+           ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 1);
+           ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => 0);
+           ARR7 : ARR(0 .. 4) := (0 .. 3 => 0, 4 => 1);
+ 
+      BEGIN
+ 
+           IF ARR1 < ARR2 THEN
+                FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
+           END IF;
+ 
+           IF ARR3 <= ARR1 THEN
+                FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL " &
+                        "ARR1");
+           END IF;
+ 
+           IF ARR3 > ARR4 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS EQUAL - >");
+           END IF;
+ 
+           IF NOT (ARR3(1) > ARR4(0)) THEN
+                FAILED ("REDEFINED COMPONENT COMPARISON - >");
+           END IF;
+ 
+           IF ARR3 >= ARR5 THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "COMPONENTS NOT EQUAL - >=");
+           END IF;
+ 
+           IF NOT ( "<" (ARR6, ARR7) ) THEN
+                FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                        "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45262D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45264a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45264a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45264a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45264a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C45264A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EQUALITY COMPARISONS YIELD CORRECT RESULTS FOR ONE
+ -- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES.
+ -- CASE THAT CHECKS THAT TWO NULL ARRAYS OF THE SAME TYPE ARE
+ -- ALWAYS EQUAL.
+ 
+ -- PK  02/21/84
+ -- EG  05/30/84
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE C45264A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+ 
+ BEGIN
+ 
+      TEST("C45264A","CHECK THAT EQUALITY COMPARISONS YIELD CORRECT " &
+                     "RESULTS FOR ONE DIMENSIONAL AND MULTI-"         &
+                     "DIMENSIONAL ARRAY TYPES");
+ 
+      DECLARE
+ 
+           TYPE A1 IS ARRAY(INT RANGE <>) OF INTEGER;
+ 
+      BEGIN
+ 
+           IF A1'(1 .. IDENT_INT(2) => IDENT_INT(1)) /=
+              A1'(IDENT_INT(2) .. 3 => IDENT_INT(1)) THEN
+                FAILED ("A1 - ARRAYS NOT EQUAL");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS => 
+                FAILED ("A1 - EXCEPTION RAISED");
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE A2 IS ARRAY(INT RANGE <>, INT RANGE <>) OF INTEGER;
+ 
+      BEGIN
+           IF A2'(1 .. IDENT_INT(2) => 
+                  (IDENT_INT(3) .. IDENT_INT(2) => IDENT_INT(1))) /=
+              A2'(IDENT_INT(2) .. 3 => 
+                  (IDENT_INT(2) .. IDENT_INT(1) =>  IDENT_INT(1))) THEN
+                 FAILED ("A2 - ARRAYS NOT EQUAL");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS => 
+                 FAILED ("A2 - EXCEPTION RAISED");
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE A3 IS 
+                ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>) OF
+                     INTEGER;
+ 
+      BEGIN
+ 
+           IF A3'(1 .. IDENT_INT(2) => 
+                  (IDENT_INT(1) .. IDENT_INT(3) => 
+                   (IDENT_INT(3) .. IDENT_INT(2) => IDENT_INT(1)))) /=
+              A3'(IDENT_INT(1) .. 3 => 
+                  (IDENT_INT(2) .. IDENT_INT(1) =>  
+                   (IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)))) THEN
+                 FAILED ("A3 - ARRAYS NOT EQUAL");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS => 
+                 FAILED ("A3 - EXCEPTION RAISED");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45264A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45264b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45264b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45264b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45264b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- C45264B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EQUALITY COMPARISONS YIELD CORRECT RESULTS FOR ONE
+ -- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES.
+ -- THIS TEST CHECKS THE CASE WHERE THE ARRAY HAS A BOUND THAT DEPENDS ON
+ -- A DISCRIMINANT WITH DEFAULTS.
+ 
+ -- JWC 11/18/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45264B IS
+ 
+ BEGIN
+ 
+      TEST("C45264B","CHECK THAT EQUALITY COMPARISONS YIELD CORRECT " &
+                     "RESULTS FOR ONE DIMENSIONAL AND MULTI-"         &
+                     "DIMENSIONAL ARRAY TYPES");
+ 
+      DECLARE
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 1 .. 5;
+           TYPE REC (DISC : SUBINT := 1) IS
+                RECORD
+                     COMP : STRING(IDENT_INT(3) .. DISC);
+                END RECORD;
+           TYPE ARR IS ARRAY (1 .. 3) OF REC;
+ 
+           A1, A2 : ARR;
+ 
+      BEGIN
+ 
+           IF A1 /= A2 THEN
+                FAILED ("NULL ARRAYS, RESULT NOT EQUAL");
+           END IF;
+ 
+           A1(2) := (5, "ABC");
+ 
+           IF A1 = A2 THEN
+                FAILED ("NON-NULL ARRAY AND NULL ARRAY, RESULT EQUAL");
+           END IF;
+ 
+           A2(2) := (5, "ABD");
+ 
+           IF A1 = A2 THEN
+                FAILED ("ARRAYS DIFFER BY LAST ELEMENT, RESULT EQUAL");
+           END IF;
+ 
+           A2(2) := (4, "AB");
+ 
+           IF A1 = A2 THEN
+                FAILED ("ARRAYS OF DIFFERENT LENGTH, RESULT EQUAL");
+           END IF;
+ 
+           A1(2) := (4, "AB");
+ 
+           IF A1 /= A2 THEN
+                FAILED ("DISCRIMINANTS AND COMPONENTS ARE THE SAME, " &
+                        "RESULT NOT EQUAL");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45264B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45264c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45264c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45264c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45264c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C45264C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT COMPARING ARRAYS OF DIFFERENT LENGTHS DOES NOT RAISE AN
+ -- EXCEPTION.
+ 
+ -- TBN  7/21/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45264C IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+      TYPE ARRAY_TYPE_1 IS ARRAY (INT RANGE <>) OF INTEGER;
+      TYPE ARRAY_TYPE_2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
+      TYPE ARRAY_TYPE_3 IS ARRAY (INT RANGE <>, INT RANGE <>,
+                                                INT RANGE <>) OF INTEGER;
+ 
+      ARRAY_1 : ARRAY_TYPE_1 (1..5) := (1..5 => 1);
+      ARRAY_2 : ARRAY_TYPE_1 (1..7) := (1..7 => 1);
+      ARRAY_3 : ARRAY_TYPE_2 (1..5, 1..4) := (1..5 => (1..4 => 1));
+      ARRAY_4 : ARRAY_TYPE_2 (1..2, 1..3) := (1..2 => (1..3 => 1));
+      ARRAY_5 : ARRAY_TYPE_3 (1..2, 1..3, 1..2) := (1..2 => (1..3 =>
+                                                   (1..2 => 2)));
+      ARRAY_6 : ARRAY_TYPE_3 (1..1, 1..2, 1..3) := (1..1 => (1..2 =>
+                                                   (1..3 => 2)));
+      ARRAY_7 : ARRAY_TYPE_2 (1..5, 1..4) := (1..5 => (1..4 => 3));
+      ARRAY_8 : ARRAY_TYPE_2 (1..5, 1..3) := (1..5 => (1..3 => 3));
+      ARRAY_9 : ARRAY_TYPE_2 (1..3, 1..2) := (1..3 => (1..2 => 4));
+      ARRAY_10 : ARRAY_TYPE_2 (1..2, 1..2) := (1..2 => (1..2 => 4));
+ 
+ BEGIN
+      TEST ("C45264C", "CHECK THAT COMPARING ARRAYS OF DIFFERENT " &
+                       "LENGTHS DOES NOT RAISE AN EXCEPTION");
+ 
+      BEGIN     -- (A)
+           IF "=" (ARRAY_1 (1..INTEGER'FIRST), ARRAY_2) THEN
+                FAILED ("INCORRECT RESULTS FROM COMPARING ONE " &
+                        "DIMENSIONAL ARRAYS - 1");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED EVALUATING - 1");
+      END;     -- (A)
+ 
+      BEGIN     -- (B)
+           IF ARRAY_1 /= ARRAY_2 THEN
+                NULL;
+           ELSE
+                FAILED ("INCORRECT RESULTS FROM COMPARING ONE " &
+                        "DIMENSIONAL ARRAYS - 2");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED EVALUATING - 2");
+      END;     -- (B)
+ 
+      BEGIN     -- (C)
+           IF ARRAY_3 = ARRAY_4 THEN
+                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                        "DIMENSIONAL ARRAYS - 3");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED EVALUATING - 3");
+      END;     -- (C)
+ 
+      BEGIN     -- (D)
+           IF "/=" (ARRAY_3, ARRAY_4) THEN
+                NULL;
+           ELSE
+                FAILED ("INCORRECT RESULTS FROM COMPARING MULT-" &
+                        "DIMENSIONAL ARRAYS - 4");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - 4");
+      END;     -- (D)
+ 
+      BEGIN     -- (E)
+           IF "=" (ARRAY_5, ARRAY_6) THEN
+                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                        "DIMENSIONAL ARRAYS - 5");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED EVALUATING - 5");
+      END;     -- (E)
+ 
+      BEGIN     -- (F)
+           IF ARRAY_6 /= ARRAY_5 THEN
+                NULL;
+           ELSE
+                FAILED ("INCORRECT RESULTS FROM COMPARING MULT-" &
+                        "DIMENSIONAL ARRAYS - 6");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - 6");
+      END;     -- (F)
+ 
+      BEGIN     -- (G)
+           IF ARRAY_7 = ARRAY_8 THEN
+                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                        "DIMENSIONAL ARRAYS - 7");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED EVALUATING - 7");
+      END;     -- (G)
+ 
+      BEGIN     -- (H)
+           IF ARRAY_9 /= ARRAY_10 THEN
+                NULL;
+           ELSE
+                FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                        "DIMENSIONAL ARRAYS - 8");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED EVALUATING - 8");
+      END;     -- (H)
+ 
+      RESULT;
+ END C45264C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45265a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45265a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45265a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45265a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,196 ----
+ -- C45265A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT MEMBERSHIP TESTS YIELD THE CORRECT RESULTS FOR ONE
+ -- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES WHEN:
+ --     A) THE SUBTYPE INDICATION DENOTES AN UNCONSTRAINED ARRAY.
+ --     B) THE SUBTYPE INDICATION DENOTES A CONSTRAINED ARRAY.
+ 
+ -- TBN  7/22/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45265A IS
+ 
+      PACKAGE P IS
+           TYPE KEY IS LIMITED PRIVATE;
+      PRIVATE
+           TYPE KEY IS NEW NATURAL;
+      END P;
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 20;
+      TYPE ARRAY_TYPE_1 IS ARRAY (INT RANGE <>) OF INTEGER;
+      TYPE ARRAY_TYPE_2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
+      TYPE ARRAY_TYPE_3 IS ARRAY (INT RANGE <>, INT RANGE <>,
+                                                INT RANGE <>) OF INTEGER;
+      TYPE ARRAY_TYPE_4 IS ARRAY (INT RANGE <>) OF P.KEY;
+      TYPE ARRAY_TYPE_5 IS ARRAY (INT RANGE <>, INT RANGE <>) OF P.KEY;
+ 
+      SUBTYPE ARRAY_SUB1 IS ARRAY_TYPE_1;
+      SUBTYPE ARRAY_SUB2 IS ARRAY_TYPE_2;
+      SUBTYPE ARRAY_SUB3 IS ARRAY_TYPE_3;
+      SUBTYPE ARRAY_SUB4 IS ARRAY_TYPE_4;
+      SUBTYPE ARRAY_SUB5 IS ARRAY_TYPE_5;
+      SUBTYPE CON_ARRAY1 IS ARRAY_TYPE_1 (1..5);
+      SUBTYPE CON_ARRAY2 IS ARRAY_TYPE_2 (1..2, 1..2);
+      SUBTYPE CON_ARRAY3 IS ARRAY_TYPE_3 (1..2, 1..3, 1..4);
+      SUBTYPE CON_ARRAY4 IS ARRAY_TYPE_4 (1..4);
+      SUBTYPE CON_ARRAY5 IS ARRAY_TYPE_5 (1..2, 1..3);
+      SUBTYPE NULL_ARRAY1 IS ARRAY_TYPE_1 (2 .. 1);
+ 
+      ARRAY1 : ARRAY_TYPE_1 (1..10);
+      ARRAY2 : ARRAY_SUB1 (11..20);
+      ARRAY3 : ARRAY_TYPE_2 (1..4, 1..3);
+      ARRAY4 : ARRAY_SUB2 (5..7, 5..8);
+      ARRAY5 : ARRAY_TYPE_3 (1..2, 1..3, 1..4);
+      ARRAY6 : ARRAY_SUB3 (1..3, 1..2, 1..4);
+      NULL_ARRAY_1 : ARRAY_TYPE_1 (3..2);
+      NULL_ARRAY_2 : ARRAY_SUB1 (2..1);
+      ARRAY7 : ARRAY_TYPE_1 (1..10) := (1..10 => 7);
+      ARRAY8 : CON_ARRAY1 := (1..5 => 8);
+      ARRAY9 : ARRAY_TYPE_2 (1..10, 1..10) := (1..10 => (1..10 => 9));
+      ARRAY10 : CON_ARRAY2 := (1..2 => (1..2 => 10));
+      ARRAY11 : ARRAY_TYPE_3 (1..10, 1..10, 1..10) := (1..10 =>
+                                               (1..10 => (1..10 => 11)));
+      ARRAY12 : CON_ARRAY3 := (1..2 => (1..3 => (1..4 => 12)));
+      ARRAY13 : ARRAY_TYPE_4 (1..2);
+      ARRAY14 : ARRAY_SUB4 (1..5);
+      ARRAY15 : ARRAY_TYPE_4 (1..6);
+      ARRAY16 : CON_ARRAY4;
+      ARRAY17 : ARRAY_TYPE_5 (1..3, 1..2);
+      ARRAY18 : ARRAY_SUB5 (1..2, 1..3);
+      ARRAY19 : ARRAY_TYPE_5 (1..4, 1..3);
+      ARRAY20 : CON_ARRAY5;
+ 
+ BEGIN
+      TEST ("C45265A", "CHECK THAT MEMBERSHIP TESTS YIELD THE CORRECT " &
+                       "RESULTS FOR ONE DIMENSIONAL AND MULTI-" &
+                       "DIMENSIONAL ARRAY TYPES");
+ 
+      ARRAY1 := (ARRAY1'RANGE => 1);
+      ARRAY2 := (ARRAY2'RANGE => 2);
+      ARRAY3 := (ARRAY3'RANGE(1) => (ARRAY3'RANGE(2) => 3));
+      ARRAY4 := (ARRAY4'RANGE(1) => (ARRAY4'RANGE(2) => 4));
+      ARRAY5 := (ARRAY5'RANGE(1) => (ARRAY5'RANGE(2) =>
+                                    (ARRAY5'RANGE(3) => 5)));
+      ARRAY6 := (ARRAY6'RANGE(1) => (ARRAY6'RANGE(2) =>
+                                    (ARRAY6'RANGE(3) => 6)));
+ 
+      IF ARRAY1 IN ARRAY_SUB1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 1");
+      END IF;
+      IF ARRAY2 NOT IN ARRAY_SUB1 THEN
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 2");
+      END IF;
+ 
+      IF ARRAY3 IN ARRAY_SUB2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 3");
+      END IF;
+      IF ARRAY4 NOT IN ARRAY_SUB2 THEN
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 4");
+      END IF;
+ 
+      IF ARRAY5 IN ARRAY_SUB3 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 5");
+      END IF;
+      IF ARRAY6 NOT IN ARRAY_SUB3 THEN
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 6");
+      END IF;
+ 
+      IF NULL_ARRAY_1 IN ARRAY_SUB1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 7");
+      END IF;
+      IF NULL_ARRAY_2 NOT IN ARRAY_SUB1 THEN
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 8");
+      END IF;
+ 
+      IF ARRAY7 IN CON_ARRAY1 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 9");
+      END IF;
+      IF ARRAY8 NOT IN CON_ARRAY1 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 10");
+      END IF;
+ 
+      IF ARRAY9 IN CON_ARRAY2 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 11");
+      END IF;
+      IF ARRAY10 NOT IN CON_ARRAY2 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 12");
+      END IF;
+ 
+      IF ARRAY11 IN CON_ARRAY3 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 13");
+      END IF;
+      IF ARRAY12 NOT IN CON_ARRAY3 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 14");
+      END IF;
+ 
+      IF ARRAY13 IN ARRAY_SUB4 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 15");
+      END IF;
+      IF ARRAY14 NOT IN ARRAY_SUB4 THEN
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 16");
+      END IF;
+ 
+      IF ARRAY15 IN CON_ARRAY4 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 17");
+      END IF;
+      IF ARRAY16 NOT IN CON_ARRAY4 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 18");
+      END IF;
+ 
+      IF ARRAY17 IN ARRAY_SUB5 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 19");
+      END IF;
+      IF ARRAY18 NOT IN ARRAY_SUB5 THEN
+           FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 20");
+      END IF;
+ 
+      IF ARRAY19 IN CON_ARRAY5 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 21");
+      END IF;
+      IF ARRAY20 NOT IN CON_ARRAY5 THEN
+           FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 22");
+      END IF;
+ 
+      IF NULL_ARRAY_1 IN NULL_ARRAY1 THEN
+           FAILED ("INCORRECT RESULTS FOR NULL ARRAYS - 23");
+      END IF;
+      IF NULL_ARRAY_2 NOT IN NULL_ARRAY1 THEN
+           FAILED ("INCORRECT RESULTS FOR NULL ARRAYS - 24");
+      END IF;
+ 
+      RESULT;
+ END C45265A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45271a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45271a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45271a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45271a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C45271A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR
+ -- RECORDS WHOSE COMPONENTS DO NOT HAVE CHANGEABLE DISCRIMINANTS.
+ 
+ -- TBN  8/6/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45271A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 20;
+      TYPE ARRAY_BOOL IS ARRAY (1 .. 5) OF BOOLEAN;
+ 
+      TYPE REC_TYPE1 IS
+           RECORD
+                BOOL : ARRAY_BOOL;
+                A : INTEGER;
+           END RECORD;
+ 
+      TYPE REC_TYPE2 (LEN : INT := 3) IS
+           RECORD
+                A : STRING (1 .. LEN);
+           END RECORD;
+ 
+      TYPE REC_TYPE3 (NUM : INT := 1) IS
+           RECORD
+                A : REC_TYPE1;
+           END RECORD;
+ 
+      REC1, REC2 : REC_TYPE1 := (A => 2, OTHERS => (OTHERS => TRUE));
+      REC3, REC4 : REC_TYPE2 (5) := (5, "WHERE");
+      REC5, REC6 : REC_TYPE2;
+      REC7, REC8 : REC_TYPE3;
+      REC9, REC10 : REC_TYPE3 (3) := (NUM => 3, A =>
+                                    (A => 5, BOOL => (OTHERS => FALSE)));
+ 
+ BEGIN
+      TEST ("C45271A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
+                       "EVALUATED CORRECTLY FOR RECORDS WHOSE " &
+                       "COMPONENTS DO NOT HAVE CHANGEABLE " &
+                       "DISCRIMINANTS");
+ 
+      IF "/=" (LEFT => REC1, RIGHT => REC2) THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
+      END IF;
+      REC1.A := IDENT_INT(1);
+      IF "=" (LEFT => REC2, RIGHT => REC1) THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
+      END IF;
+ 
+      IF REC3 /= REC4 THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
+      END IF;
+      REC4.A := IDENT_STR("12345");
+      IF REC3 = REC4 THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
+      END IF;
+ 
+      REC5.A := IDENT_STR("WHO");
+      REC6.A := IDENT_STR("WHY");
+      IF REC5 = REC6 THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
+      END IF;
+      REC5.A := "WHY";
+      IF REC6 /= REC5 THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
+      END IF;
+ 
+      REC7.A.A := IDENT_INT(1);
+      REC7.A.BOOL := (OTHERS => IDENT_BOOL(TRUE));
+      REC8.A.A := 1;
+      REC8.A.BOOL := (OTHERS => TRUE);
+      IF REC7 /= REC8 THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
+      END IF;
+      REC8.A.BOOL := (OTHERS => IDENT_BOOL(FALSE));
+      IF REC8 = REC7 THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 8");
+      END IF;
+ 
+      IF "/=" (LEFT => REC9, RIGHT => REC10) THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 9");
+      END IF;
+      REC9.A.A := IDENT_INT(1);
+      IF "=" (LEFT => REC9, RIGHT => REC10) THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 10");
+      END IF;
+ 
+      RESULT;
+ END C45271A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45272a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45272a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45272a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45272a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C45272A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR 
+ -- RECORDS WHOSE COMPONENTS HAVE CHANGEABLE DISCRIMINANTS, INCLUDING
+ -- RECORDS DESIGNATED BY ACCESS VALUES.
+ 
+ -- TBN  8/7/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45272A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0 .. 20;
+      TYPE VARSTR (LEN : INT := 0) IS
+           RECORD
+                VAL : STRING (1..LEN);
+           END RECORD;
+      TYPE VARREC IS
+           RECORD
+                A, B : VARSTR;
+           END RECORD;
+ 
+      TYPE CELL2;
+      TYPE LINK IS ACCESS CELL2;
+      TYPE CELL1 (NAM_LEN : INT := 0) IS
+           RECORD
+                NAME : STRING (1..NAM_LEN);
+           END RECORD;
+      TYPE CELL2 IS
+           RECORD
+                ONE : CELL1;
+                TWO : CELL1;
+                NEW_LINK : LINK;
+           END RECORD;
+ 
+      X, Y : VARREC;
+      FRONT : LINK := NEW CELL2'((5, "XXYZZ"), (5, "YYYZZ"), NULL);
+      BACK : LINK := NEW CELL2'((5, "XXYZZ"), (5, "YYYZZ"), NULL);
+ 
+ BEGIN
+      TEST ("C45272A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
+                       "EVALUATED CORRECTLY FOR RECORDS WHOSE " &
+                       "COMPONENTS HAVE CHANGEABLE DISCRIMINANTS");
+ 
+      X := ((5, "AAAXX"), (5, "BBBYY"));
+      Y := ((5, "AAAZZ"), (5, "BBBYY"));
+      IF X = Y THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
+      END IF;
+ 
+      X.A := (3, "HHH");
+      Y.A := (IDENT_INT(3), IDENT_STR("HHH"));
+      IF X /= Y THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
+      END IF;
+ 
+      IF FRONT.ALL /= BACK.ALL THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
+      END IF;
+ 
+      BACK.NEW_LINK := FRONT;
+      IF FRONT.ALL = BACK.ALL THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
+      END IF;
+ 
+      FRONT.NEW_LINK := FRONT;
+      IF FRONT.ALL /= BACK.ALL THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
+      END IF;
+ 
+      FRONT.ONE := (5, "XXXXX");
+      BACK.ONE := (5, "ZZZZZ");
+      IF FRONT.ALL = BACK.ALL THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
+      END IF;
+ 
+      FRONT.ONE := (3, "XXX");
+      BACK.ONE := (3, "XXX");
+      IF FRONT.ALL /= BACK.ALL THEN
+           FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
+      END IF;
+ 
+      RESULT;
+ END C45272A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45273a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45273a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45273a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45273a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- C45273A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR
+ --     RECORD OBJECTS HAVING DIFFERENT VALUES OF THE 'CONSTRAINED
+ --     ATTRIBUTE.
+ 
+ -- HISTORY:
+ --     TBN  08/07/86  CREATED ORIGINAL TEST.
+ --     VCL  10/27/87  MODIFIED THIS HEADER; RELOCATED THE CALL TO
+ --                    REPORT.TEST SO THAT IT COMES BEFORE ANY
+ --                    DECLARATIONS; CHANGED THE 'ELSEIF' CONDITION IN
+ --                    THE PROCEDURE 'PROC' SO THAT IT REFERS TO THE
+ --                    FORMAL PARAMETERS.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45273A IS
+ BEGIN
+      TEST ("C45273A", "EQUALITY AND INEQUALITY ARE " &
+                       "EVALUATED CORRECTLY FOR RECORD OBJECTS HAVING " &
+                       "DIFFERENT VALUES OF THE 'CONSTRAINED' " &
+                       " ATTRIBUTE");
+ 
+      DECLARE
+           SUBTYPE INT IS INTEGER RANGE 1 .. 20;
+           TYPE REC_TYPE1 IS
+                RECORD
+                     A : INTEGER;
+                END RECORD;
+ 
+           TYPE REC_TYPE2 (LEN : INT := 3) IS
+                RECORD
+                     A : STRING (1 .. LEN);
+                END RECORD;
+ 
+           TYPE REC_TYPE3 (NUM : INT := 1) IS
+                RECORD
+                     A : REC_TYPE1;
+                END RECORD;
+ 
+           REC1 : REC_TYPE2 (3) := (3, "WHO");
+           REC2 : REC_TYPE2;
+           REC3 : REC_TYPE2 (5) := (5, "WHERE");
+           REC4 : REC_TYPE3;
+           REC5 : REC_TYPE3 (1) := (1, A => (A => 5));
+ 
+           PROCEDURE PROC (PREC1 : REC_TYPE2;
+                           PREC2 : IN OUT REC_TYPE2) IS
+           BEGIN
+                IF NOT (PREC1'CONSTRAINED) OR PREC2'CONSTRAINED THEN
+                     FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                             "ATTRIBUTE - 6");
+                ELSIF PREC1 /= PREC2 THEN
+                     FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
+                END IF;
+                PREC2.A := "WHO";
+           END PROC;
+ 
+      BEGIN
+           REC2.A := "WHO";
+           IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
+                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                        "ATTRIBUTE - 1");
+           ELSIF REC1 /= REC2 THEN
+                FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
+           END IF;
+ 
+           IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
+                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                        "ATTRIBUTE - 2");
+           ELSIF REC2 = REC3 THEN
+                FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
+           END IF;
+ 
+           REC2 := (5, "WHERE");
+           IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
+                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                        "ATTRIBUTE - 3");
+           ELSIF REC2 /= REC3 THEN
+                FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
+           END IF;
+ 
+           REC4.A.A := 5;
+           IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
+                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                        "ATTRIBUTE - 4");
+           ELSIF REC4 /= REC5 THEN
+                FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
+           END IF;
+ 
+           REC5.A := (A => 6);
+           IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
+                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                        "ATTRIBUTE - 5");
+           ELSIF REC4 = REC5 THEN
+                FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
+           END IF;
+ 
+           REC1.A := "WHY";
+           REC2 := (3, "WHY");
+           PROC (REC1, REC2);
+           IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
+                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                        "ATTRIBUTE - 7");
+           ELSIF REC1 = REC2 THEN
+                FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C45273A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45274a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45274a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45274a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45274a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,222 ----
+ -- C45274A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
+ --     YIELDS  TRUE   (RESP.  FALSE )  FOR
+ --
+ -->> * RECORD TYPES WITHOUT DISCRIMINANTS;
+ -->> * PRIVATE TYPES WITHOUT DISCRIMINANTS;
+ -->> * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
+ --   * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS; 
+ --   * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
+ --   * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
+ 
+ 
+ -- RM  3/01/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C45274A IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C45274A" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
+                         "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
+                         " FOR RECORD TYPES WITHOUT DISCRIMINANTS," &
+                         " PRIVATE TYPES WITHOUT DISCRIMINANTS, AND" &
+                         " LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
+ 
+ 
+      -------------------------------------------------------------------
+      -----------------  RECORD TYPES WITHOUT DISCRIMINANTS  ------------
+ 
+      DECLARE
+ 
+           TYPE  REC  IS
+                RECORD
+                     A , B : INTEGER ;
+                END RECORD ;
+ 
+           X : REC := ( 19 , 91 );
+ 
+      BEGIN
+ 
+           IF  X  IN  REC  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 1" );
+           END IF;
+ 
+           IF  X  NOT IN  REC  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 1" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+      -----------------  PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  PRIV  IS PRIVATE;
+           PRIVATE
+                TYPE  PRIV  IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           X : PRIV ;
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+                X := ( 19 , 91 );
+           END  P ;
+ 
+      BEGIN
+ 
+           IF  X  IN  PRIV  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 2" );
+           END IF;
+ 
+           IF  X  NOT IN  PRIV  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 2" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+      -------------------------------------------------------------------
+      ---------  LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  LP  IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE  LP  IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           X : LP ;
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+                X := ( 19 , 91 );
+           END  P ;
+ 
+      BEGIN
+ 
+           IF  X  IN  LP  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 3" );
+           END IF;
+ 
+           IF  X  NOT IN  LP  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 3" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  LP  IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE  LP  IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           Y : LP ;
+ 
+      -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
+      BEGIN
+ 
+           IF  Y  IN  LP  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 3BIS" );
+           END IF;
+ 
+           IF  Y  NOT IN  LP  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
+                        "( 'NOT IN' )  RAISED AN EXCEPTION" );
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C45274A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45274b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45274b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45274b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45274b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,229 ----
+ -- C45274B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
+ --     YIELDS  TRUE   (RESP.  FALSE )  FOR
+ --
+ --   * RECORD TYPES WITHOUT DISCRIMINANTS;
+ --   * PRIVATE TYPES WITHOUT DISCRIMINANTS;
+ --   * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
+ -->> * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS; 
+ -->> * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
+ -->> * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
+ 
+ 
+ -- RM  3/03/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C45274B IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C45274B" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
+                         "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
+                         " FOR UNCONSTRAINED TYPES WITH DISCRIMINANTS" );
+ 
+ 
+      -------------------------------------------------------------------
+      --------  UNCONSTRAINED RECORD TYPES WITH DISCRIMINANTS  ----------
+ 
+      DECLARE
+ 
+           TYPE  REC ( DISCR : BOOLEAN ) IS
+                RECORD
+                     A , B : INTEGER ;
+                END RECORD ;
+ 
+           X : REC(FALSE) := ( FALSE , 19 , 81 );
+ 
+           TYPE  REC0 ( DISCR : BOOLEAN := FALSE ) IS
+                RECORD
+                     A , B : INTEGER ;
+                END RECORD ;
+ 
+           Y : REC0 := ( TRUE , 19 , 81 );
+ 
+      BEGIN
+ 
+           IF  X  IN  REC  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 1A" );
+           END IF;
+ 
+           IF  Y  NOT IN  REC0  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 1B" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+      -------  UNCONSTRAINED PRIVATE TYPES WITH DISCRIMINANTS  ----------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
+           PRIVATE
+                TYPE  PRIV ( DISCR : BOOLEAN ) IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           X : PRIV(FALSE) ;
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+                X := ( FALSE , 19 , 91 );
+           END  P ;
+ 
+      BEGIN
+ 
+           IF  X  IN  PRIV  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 2" );
+           END IF;
+ 
+           IF  X  NOT IN  PRIV  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 2" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+      ---------  UNCONSTRAINED LIM. PRIV. TYPES WITH DISCRIM.  ----------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           X : LP(TRUE) ;
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+                X := ( TRUE , 19 , 91 );
+           END  P ;
+ 
+      BEGIN
+ 
+           IF  X  IN  LP  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 3" );
+           END IF;
+ 
+           IF  X  NOT IN  LP  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 3" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           Y : LP(TRUE) ;
+ 
+      -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
+      BEGIN
+ 
+           IF  Y  IN  LP  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 3BIS" );
+           END IF;
+ 
+           IF  Y  NOT IN  LP  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
+                        "( 'NOT IN' )  RAISED AN EXCEPTION" );
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C45274B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45274c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45274c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45274c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45274c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,187 ----
+ -- C45274C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE MEMBERSHIP OPERATOR  IN   ( NOT IN )
+ --     YIELDS  TRUE  (RESP.  FALSE ) IF THE DISCRIMINANTS OF THE LEFT
+ --     VALUE EQUAL THE DISCRIMINANTS OF THE SUBTYPE INDICATION.
+ --
+ --
+ --   * RECORD TYPES WITH DISCRIMINANTS;
+ --   * PRIVATE TYPES WITH DISCRIMINANTS;
+ --   * LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
+ 
+ 
+ -- RM  3/01/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C45274C IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C45274C" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
+                         "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
+                         " IF THE DISCRIMINANTS OF THE LEFT VALUE" &
+                         " EQUAL THE DISCRIMINANTS OF THE SUBTYPE" &
+                         " INDICATION" );
+ 
+ 
+      -------------------------------------------------------------------
+      -----------------  RECORD TYPES WITH DISCRIMINANTS  ---------------
+ 
+      DECLARE
+ 
+           TYPE  REC ( DISCR : BOOLEAN := FALSE ) IS
+                RECORD
+                     A , B : INTEGER ;
+                END RECORD ;
+ 
+           SUBTYPE  RECTRUE  IS REC(TRUE) ;
+ 
+           X : REC  :=  ( TRUE , 19 , 91 );
+ 
+      BEGIN
+ 
+           IF  X  IN  RECTRUE  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 1" );
+           END IF;
+ 
+           IF  X  NOT IN  RECTRUE  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 1" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+      -----------------  PRIVATE TYPES WITH DISCRIMINANTS  --------------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
+           PRIVATE
+                TYPE  PRIV ( DISCR : BOOLEAN ) IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           SUBTYPE  PRIVTRUE  IS  PRIV( IDENT_BOOL(TRUE) );
+ 
+           X : PRIV(TRUE) ;
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+                X := ( TRUE , 19 , 91 );
+           END  P ;
+ 
+      BEGIN
+ 
+           IF  X  IN  PRIVTRUE  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'IN', 2" );
+           END IF;
+ 
+           IF  X  NOT IN  PRIVTRUE  THEN
+                FAILED( "WRONG VALUE: 'NOT IN', 2" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+      -------------------------------------------------------------------
+      ---------  LIMITED PRIVATE TYPES WITH DISCRIMINANTS  --------------
+ 
+      DECLARE
+ 
+           PACKAGE  P  IS
+                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
+                     RECORD
+                          A , B : INTEGER ;
+                     END RECORD ;
+           END  P ;
+ 
+           USE  P ;
+ 
+           SUBTYPE  LPFALSE  IS  LP(FALSE) ;
+ 
+           X : LP(TRUE) ;
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+                X := ( IDENT_BOOL(TRUE) , 19 , 91 );
+           END  P ;
+ 
+      BEGIN
+ 
+           IF  X  IN  LPFALSE  THEN
+                FAILED( "WRONG VALUE: 'IN', 3" );
+           ELSE 
+                NULL;
+           END IF;
+ 
+           IF  X  NOT IN  LPFALSE  THEN
+                NULL;
+           ELSE 
+                FAILED( "WRONG VALUE: 'NOT IN', 3" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS =>
+                FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C45274C ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45281a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45281a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45281a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45281a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C45281A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR ACCESS
+ -- TYPES.
+ 
+ -- TBN  8/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45281A IS
+ 
+      TYPE STR_NAME IS ACCESS STRING;
+ 
+      TYPE GENDER IS (F, M);
+      TYPE PERSON (SEX : GENDER) IS
+           RECORD
+                NAME : STRING (1..6) := "NONAME";
+           END RECORD;
+ 
+      TYPE PERSON_NAME IS ACCESS PERSON;
+      SUBTYPE MALE IS PERSON_NAME (M);
+      SUBTYPE FEMALE IS PERSON_NAME (F);
+ 
+      S : STR_NAME (1..10) := NEW STRING'("0123456789");
+      T : STR_NAME (1..10) := S;
+      A : MALE;
+      B : FEMALE;
+      C : PERSON_NAME;
+ 
+ BEGIN
+      TEST ("C45281A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
+                       "EVALUATED CORRECTLY FOR ACCESS TYPES");
+ 
+      IF "/=" (LEFT => S, RIGHT => T) THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 1");
+      END IF;
+      T := NEW STRING'("0123456789");
+      IF "=" (S, T) THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 2");
+      END IF;
+ 
+      IF A /= B THEN
+           FAILED ("INCORRECT RESULTS FOR NULL ACCESS VALUES - 3");
+      END IF;
+      IF A /= C THEN
+           FAILED ("INCORRECT RESULTS FOR NULL ACCESS VALUES - 4");
+      END IF;
+ 
+      A := NEW PERSON'(M, "THOMAS");
+      IF "=" (LEFT => A, RIGHT => B) THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 5");
+      END IF;
+      C := A;
+      IF C /= A THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 6");
+      END IF;
+      C := NEW PERSON'(M, "THOMAS");
+      IF A = C THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 7");
+      END IF;
+ 
+      RESULT;
+ END C45281A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45282a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45282a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45282a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45282a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C45282A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
+ --     A) ACCESS TO SCALAR TYPES;
+ --     B) ACCESS TO ARRAY TYPES (CONSTRAINED AND UNCONSTRAINED);
+ --     C) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT
+ --        DISCRIMINANTS;
+ 
+ -- TBN  8/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45282A IS
+ 
+      PACKAGE P IS
+           TYPE KEY IS PRIVATE;
+           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
+           TYPE NEWKEY IS LIMITED PRIVATE;
+           TYPE ACC_NKEY IS ACCESS NEWKEY;
+           PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY);
+      PRIVATE
+           TYPE KEY IS NEW NATURAL;
+           TYPE NEWKEY IS NEW KEY;
+      END P;
+ 
+      USE P;
+      SUBTYPE I IS INTEGER;
+      TYPE ACC_INT IS ACCESS I;
+      P_INT : ACC_INT;
+      SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+      TYPE ARRAY_TYPE1 IS ARRAY (INT RANGE <>) OF INTEGER;
+      TYPE ACC_ARA_1 IS ACCESS ARRAY_TYPE1;
+      SUBTYPE ACC_ARA_2 IS ACC_ARA_1 (1 .. 2);
+      SUBTYPE ACC_ARA_3 IS ACC_ARA_1 (1 .. 3);
+      ARA1 : ACC_ARA_1;
+      ARA2 : ACC_ARA_2;
+      ARA3 : ACC_ARA_3;
+      TYPE GREET IS
+           RECORD
+                NAME : STRING (1 .. 2);
+           END RECORD;
+      TYPE ACC_GREET IS ACCESS GREET;
+      INTRO : ACC_GREET;
+      TYPE ACC_KEY IS ACCESS KEY;
+      KEY1 : ACC_KEY;
+      KEY2 : ACC_NKEY;
+ 
+      PACKAGE BODY P IS
+           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
+           BEGIN
+                RETURN (KEY(X));
+           END INIT_KEY;
+ 
+           PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY) IS
+           BEGIN
+                Y.ALL := NEWKEY (1);
+           END ASSIGN_NEWKEY;
+      END P;
+ 
+ BEGIN
+ 
+      TEST ("C45282A", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
+                       "ACCESS TYPES TO SCALAR TYPES, ARRAY TYPES, " &
+                       "RECORD TYPES, PRIVATE TYPES, AND LIMITED " &
+                       "PRIVATE TYPES WITHOUT DISCRIMINANTS");
+ 
+ -- CASE A
+      IF P_INT NOT IN ACC_INT THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
+      END IF;
+      P_INT := NEW INT'(5);
+      IF P_INT IN ACC_INT THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
+      END IF;
+ 
+ -- CASE B
+      IF ARA1 NOT IN ACC_ARA_1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
+      END IF;
+      IF ARA1 NOT IN ACC_ARA_2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
+      END IF;
+      IF ARA1 IN ACC_ARA_3 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
+      END IF;
+      IF ARA2 IN ACC_ARA_1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
+      END IF;
+      IF ARA3 NOT IN ACC_ARA_1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
+      END IF;
+      ARA1 := NEW ARRAY_TYPE1'(1, 2, 3);
+      IF ARA1 IN ACC_ARA_1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
+      END IF;
+      IF ARA1 IN ACC_ARA_2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
+      END IF;
+      IF ARA1 NOT IN ACC_ARA_3 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
+      END IF;
+      ARA2 := NEW ARRAY_TYPE1'(1, 2);
+      IF ARA2 NOT IN ACC_ARA_1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
+      END IF;
+      IF ARA2 NOT IN ACC_ARA_2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
+      END IF;
+ 
+ -- CASE C
+      IF INTRO NOT IN ACC_GREET THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
+      END IF;
+      INTRO := NEW GREET'(NAME => "HI");
+      IF INTRO IN ACC_GREET THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
+      END IF;
+      IF KEY1 NOT IN ACC_KEY THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
+      END IF;
+      KEY1 := NEW KEY'(INIT_KEY (1));
+      IF KEY1 IN ACC_KEY THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
+      END IF;
+      IF KEY2 NOT IN ACC_NKEY THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
+      END IF;
+      KEY2 := NEW NEWKEY;
+      ASSIGN_NEWKEY (KEY2);
+      IF KEY2 IN ACC_NKEY THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
+      END IF;
+ 
+      RESULT;
+ END C45282A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45282b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45282b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45282b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45282b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,347 ----
+ -- C45282B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
+ --     D) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH
+ --        DISCRIMINANTS (WITH AND WITHOUT DEFAULT VALUES), WHERE THE 
+ --        TYPE MARK DENOTES A CONSTRAINED AND UNCONSTRAINED TYPE;
+ --     E) ACCESS TO TASK TYPES.
+ 
+ -- TBN  8/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45282B IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+ 
+      PACKAGE P IS
+           TYPE PRI_REC1 (D : INT) IS PRIVATE;
+           TYPE PRI_REC2 (D : INT := 2) IS PRIVATE;
+           FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1;
+           FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2;
+           TYPE LIM_REC1 (D : INT) IS LIMITED PRIVATE;
+           TYPE ACC_LIM1 IS ACCESS LIM_REC1;
+           SUBTYPE ACC_SUB_LIM1 IS ACC_LIM1 (2);
+           PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING);
+           TYPE LIM_REC2 (D : INT := 2) IS LIMITED PRIVATE;
+           TYPE ACC_LIM2 IS ACCESS LIM_REC2;
+           SUBTYPE ACC_SUB_LIM2 IS ACC_LIM2 (2);
+           PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING);
+      PRIVATE
+           TYPE PRI_REC1 (D : INT) IS
+                RECORD
+                     STR : STRING (1 .. D);
+                END RECORD;
+           TYPE PRI_REC2 (D : INT := 2) IS
+                RECORD
+                     STR : STRING (1 .. D);
+                END RECORD;
+           TYPE LIM_REC1 (D : INT) IS
+                RECORD
+                     STR : STRING (1 .. D);
+                END RECORD;
+           TYPE LIM_REC2 (D : INT := 2) IS
+                RECORD
+                     STR : STRING (1 .. D);
+                END RECORD;
+      END P;
+ 
+      USE P;
+ 
+      TYPE DIS_REC1 (D : INT) IS
+           RECORD
+                STR : STRING (1 .. D);
+           END RECORD;
+      TYPE DIS_REC2 (D : INT := 5) IS
+           RECORD
+                STR : STRING (D .. 8);
+           END RECORD;
+ 
+      TYPE ACC1_REC1 IS ACCESS DIS_REC1;
+      SUBTYPE ACC2_REC1 IS ACC1_REC1 (2);
+      TYPE ACC1_REC2 IS ACCESS DIS_REC2;
+      SUBTYPE ACC2_REC2 IS ACC1_REC2 (2);
+      REC1 : ACC1_REC1;
+      REC2 : ACC2_REC1;
+      REC3 : ACC1_REC2;
+      REC4 : ACC2_REC2;
+      TYPE ACC_PREC1 IS ACCESS PRI_REC1;
+      SUBTYPE ACC_SREC1 IS ACC_PREC1 (2);
+      REC5 : ACC_PREC1;
+      REC6 : ACC_SREC1;
+      TYPE ACC_PREC2 IS ACCESS PRI_REC2;
+      SUBTYPE ACC_SREC2 IS ACC_PREC2 (2);
+      REC7 : ACC_PREC2;
+      REC8 : ACC_SREC2;
+      REC9 : ACC_LIM1;
+      REC10 : ACC_SUB_LIM1;
+      REC11 : ACC_LIM2;
+      REC12 : ACC_SUB_LIM2;
+ 
+      TASK TYPE T IS
+           ENTRY E (X : INTEGER);
+      END T;
+ 
+      TASK BODY T IS
+      BEGIN
+           ACCEPT E (X : INTEGER) DO
+                IF X /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE PASSED TO TASK");
+                END IF;
+           END E;
+      END T;
+ 
+      PACKAGE BODY P IS
+           FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1 IS
+                REC : PRI_REC1 (A);
+           BEGIN
+                REC := (A, B);
+                RETURN (REC);
+           END INIT_PREC1;
+ 
+           FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2 IS
+                REC : PRI_REC2;
+           BEGIN
+                REC := (A, B);
+                RETURN (REC);
+           END INIT_PREC2;
+ 
+           PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING) IS
+           BEGIN
+                A.ALL := (B, C);
+           END ASSIGN_LIM1;
+ 
+           PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING) IS
+           BEGIN
+                A.ALL := (B, C);
+           END ASSIGN_LIM2;
+      END P;
+ 
+ BEGIN
+ 
+      TEST ("C45282B", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
+                       "ACCESS TYPES TO RECORD TYPES, PRIVATE TYPES, " &
+                       "LIMITED PRIVATE TYPES WITH DISCRIMINANTS, AND " &
+                       "TASK TYPES");
+ 
+ -- CASE D
+ ------------------------------------------------------------------------
+      IF REC1 NOT IN ACC1_REC1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
+      END IF;
+      IF REC1 IN ACC2_REC1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
+      END IF;
+      IF REC2 NOT IN ACC1_REC1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
+      END IF;
+      REC1 := NEW DIS_REC1'(5, "12345");
+      IF REC1 IN ACC1_REC1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
+      END IF;
+      IF REC1 IN ACC2_REC1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
+      END IF;
+      REC2 := NEW DIS_REC1'(2, "HI");
+      IF REC2 IN ACC1_REC1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
+      END IF;
+ 
+ ------------------------------------------------------------------------
+ 
+      IF REC3 IN ACC1_REC2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
+      END IF;
+      IF REC3 NOT IN ACC2_REC2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
+      END IF;
+      IF REC4 IN ACC1_REC2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
+      END IF;
+      REC3 := NEW DIS_REC2'(5, "5678");
+      IF REC3 IN ACC1_REC2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
+      END IF;
+      IF REC3 IN ACC2_REC2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
+      END IF;
+      REC4 := NEW DIS_REC2'(2, "2345678");
+      IF REC4 IN ACC1_REC2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
+      END IF;
+      IF REC4 NOT IN ACC2_REC2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
+      END IF;
+ 
+ ------------------------------------------------------------------------
+ 
+      IF REC5 NOT IN ACC_PREC1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
+      END IF;
+      IF REC5 NOT IN ACC_SREC1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
+      END IF;
+      IF REC6 NOT IN ACC_PREC1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
+      END IF;
+      REC5 := NEW PRI_REC1'(INIT_PREC1 (5, "12345"));
+      IF REC5 IN ACC_PREC1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
+      END IF;
+      IF REC5 IN ACC_SREC1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
+      END IF;
+      REC6 := NEW PRI_REC1'(INIT_PREC1 (2, "HI"));
+      IF REC6 IN ACC_PREC1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 19");
+      END IF;
+ 
+ ------------------------------------------------------------------------
+ 
+      IF REC7 NOT IN ACC_PREC2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 20");
+      END IF;
+      IF REC7 NOT IN ACC_SREC2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 21");
+      END IF;
+      IF REC8 NOT IN ACC_PREC2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 22");
+      END IF;
+      REC7 := NEW PRI_REC2'(INIT_PREC2 (5, "12345"));
+      IF REC7 IN ACC_PREC2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 23");
+      END IF;
+      IF REC7 IN ACC_SREC2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 24");
+      END IF;
+      REC8 := NEW PRI_REC2'(INIT_PREC2 (2, "HI"));
+      IF REC8 IN ACC_PREC2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 25");
+      END IF;
+ 
+ ------------------------------------------------------------------------
+ 
+      IF REC9 NOT IN ACC_LIM1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 26");
+      END IF;
+      IF REC9 NOT IN ACC_SUB_LIM1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 27");
+      END IF;
+      IF REC10 NOT IN ACC_LIM1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 28");
+      END IF;
+      REC9 := NEW LIM_REC1 (5);
+      ASSIGN_LIM1 (REC9, 5, "12345");
+      IF REC9 IN ACC_LIM1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 29");
+      END IF;
+      IF REC9 IN ACC_SUB_LIM1 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 30");
+      END IF;
+      REC10 := NEW LIM_REC1 (2);
+      ASSIGN_LIM1 (REC10, 2, "12");
+      IF REC10 IN ACC_LIM1 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 31");
+      END IF;
+ 
+ ------------------------------------------------------------------------
+ 
+      IF REC11 NOT IN ACC_LIM2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 32");
+      END IF;
+      IF REC11 NOT IN ACC_SUB_LIM2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 33");
+      END IF;
+      IF REC12 NOT IN ACC_LIM2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 34");
+      END IF;
+      REC11 := NEW LIM_REC2;
+      IF REC11 NOT IN ACC_SUB_LIM2 THEN
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 35");
+      END IF;
+      ASSIGN_LIM2 (REC11, 2, "12");
+      IF REC11 IN ACC_LIM2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 36");
+      END IF;
+      IF REC11 IN ACC_SUB_LIM2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 37");
+      END IF;
+      REC12 := NEW LIM_REC2;
+      ASSIGN_LIM2 (REC12, 2, "12");
+      IF REC12 IN ACC_LIM2 THEN
+           NULL;
+      ELSE
+           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
+      END IF;
+ 
+ -- CASE E
+ ------------------------------------------------------------------------
+      DECLARE
+           TYPE ACC_TASK IS ACCESS T;
+           T1 : ACC_TASK;
+      BEGIN
+           IF T1 NOT IN ACC_TASK THEN
+                FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 39");
+           END IF;
+           T1 := NEW T;
+           IF T1 IN ACC_TASK THEN
+                NULL;
+           ELSE
+                FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
+           END IF;
+           T1.E (1);
+      END;
+ 
+      RESULT;
+ END C45282B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45291a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45291a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45291a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45291a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C45291A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE MEMBERSHIP TESTS YIELD CORRECT RESULTS FOR TASK
+ --     TYPES, LIMITED PRIVATE TYPES, COMPOSITE LIMITED TYPES, AND
+ --     PRIVATE TYPES WITHOUT DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JET 08/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45291A IS
+ 
+      TASK TYPE TASK1 IS
+           ENTRY E;
+      END TASK1;
+ 
+      PACKAGE PACK IS
+           TYPE LIM_PRIV IS LIMITED PRIVATE;
+           TYPE LIM_COMP IS ARRAY (1..10) OF LIM_PRIV;
+           TYPE PRIV IS PRIVATE;
+           PROCEDURE INIT(LP : OUT LIM_PRIV;
+                          LC : IN OUT LIM_COMP;
+                          P  : OUT PRIV);
+      PRIVATE
+           TYPE LIM_PRIV IS RANGE -100..100;
+           TYPE PRIV IS RECORD
+                I : INTEGER;
+           END RECORD;
+      END PACK;
+ 
+      SUBTYPE SUB_TASK1 IS TASK1;
+      SUBTYPE SUB_LIM_PRIV IS PACK.LIM_PRIV;
+      SUBTYPE SUB_LIM_COMP IS PACK.LIM_COMP;
+      SUBTYPE SUB_PRIV IS PACK.PRIV;
+ 
+      T1 : TASK1;
+      LP : PACK.LIM_PRIV;
+      LC : PACK.LIM_COMP;
+      P  : PACK.PRIV;
+ 
+      TASK BODY TASK1 IS
+      BEGIN
+           ACCEPT E DO
+                NULL;
+           END E;
+      END TASK1;
+ 
+      PACKAGE BODY PACK IS
+           PROCEDURE INIT (LP : OUT LIM_PRIV;
+                           LC : IN OUT LIM_COMP;
+                           P  : OUT PRIV) IS
+           BEGIN
+                LP := 0;
+                LC := (OTHERS => 0);
+                P  := (I => 0);
+           END INIT;
+      END PACK;
+ 
+ BEGIN
+      TEST ("C45291A", "CHECK THAT THE MEMBERSHIP TESTS YIELD CORRECT " &
+                       "RESULTS FOR TASK TYPES, LIMITED PRIVATE TYPES," &
+                       " COMPOSITE LIMITED TYPES, AND PRIVATE TYPES " &
+                       "WITHOUT DISCRIMINANTS");
+ 
+      PACK.INIT(LP, LC, P);
+ 
+      IF NOT IDENT_BOOL(T1 IN TASK1) THEN
+           FAILED ("INCORRECT VALUE OF 'T1 IN TASK1'");
+      END IF;
+ 
+      IF IDENT_BOOL(T1 NOT IN TASK1) THEN
+           FAILED ("INCORRECT VALUE OF 'T1 NOT IN TASK1'");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(LP IN PACK.LIM_PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'LP IN LIM_PRIV'");
+      END IF;
+ 
+      IF IDENT_BOOL(LP NOT IN PACK.LIM_PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'LP NOT IN LIM_PRIV'");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(LC IN PACK.LIM_COMP) THEN
+           FAILED ("INCORRECT VALUE OF 'LC IN LIM_COMP'");
+      END IF;
+ 
+      IF IDENT_BOOL(LC NOT IN PACK.LIM_COMP) THEN
+           FAILED ("INCORRECT VALUE OF 'LC NOT IN LIM_COMP'");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(P IN PACK.PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'P IN PRIV'");
+      END IF;
+ 
+      IF IDENT_BOOL(P NOT IN PACK.PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'P NOT IN PRIV'");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(T1 IN SUB_TASK1) THEN
+           FAILED ("INCORRECT VALUE OF 'T1 IN SUB_TASK1'");
+      END IF;
+ 
+      IF IDENT_BOOL(T1 NOT IN SUB_TASK1) THEN
+           FAILED ("INCORRECT VALUE OF 'T1 NOT IN SUB_TASK1'");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(LP IN SUB_LIM_PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'LP IN SUB_LIM_PRIV'");
+      END IF;
+ 
+      IF IDENT_BOOL(LP NOT IN SUB_LIM_PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'LP NOT IN SUB_LIM_PRIV'");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(LC IN SUB_LIM_COMP) THEN
+           FAILED ("INCORRECT VALUE OF 'LC IN SUB_LIM_COMP'");
+      END IF;
+ 
+      IF IDENT_BOOL(LC NOT IN SUB_LIM_COMP) THEN
+           FAILED ("INCORRECT VALUE OF 'LC NOT IN SUB_LIM_COMP'");
+      END IF;
+ 
+      IF NOT IDENT_BOOL(P IN SUB_PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'P IN SUB_PRIV'");
+      END IF;
+ 
+      IF IDENT_BOOL(P NOT IN SUB_PRIV) THEN
+           FAILED ("INCORRECT VALUE OF 'P NOT IN SUB_PRIV'");
+      END IF;
+ 
+      T1.E;
+ 
+      RESULT;
+ 
+ END C45291A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c453001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c453001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c453001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c453001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,236 ----
+ -- C453001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --
+ --                                     Notice
+ --
+ --     The ACAA has created and maintains the Ada Conformity Assessment Test
+ --     Suite for the purpose of conformity assessments conducted in accordance
+ --     with the International Standard ISO/IEC 18009 - Ada: Conformity
+ --     assessment of a language processor. This test suite should not be used
+ --     to make claims of conformance unless used in accordance with
+ --     ISO/IEC 18009 and any applicable ACAA procedures.
+ --*
+ -- OBJECTIVES:
+ --     Check that overflow checking is not performed for adding operators of
+ --     modular types.
+ --
+ -- TEST DESCRIPTION:
+ --     Check that Constraint_Error is not raised by + or - when the result
+ --     is out of the range of the base type.
+ --     Also check that assignment to values in the upper half of the range
+ --     does not raise Constraint_Error.
+ --
+ --     We define modular types of various common sizes. We cannot
+ --     assume a binary modulus greater than 2**16 is supported by 3.5.4(23),
+ --     so the DWord type might be smaller on some targets. We also try
+ --     a small prime number as a modulus (these are often used for hashing).
+ --     We also the language-defined types
+ --     System.Storage_Elements.Storage_Element, Ada.Streams.Stream_Element,
+ --     and Ada.Containers.Hash_Type.
+ --
+ -- CHANGE HISTORY:
+ --      11 Feb 17   JAC   Initial pre-release version.
+ --      30 Mar 17   RLB   Renamed, removed non-modular test cases, removed
+ --                        types that aren't required to be supported, added
+ --                        other language-defined types, added key to locate
+ --                        failures, added additional test cases.
+ --      03 Apr 17   RLB   Removed Ada.Containers from the Ada 95 version of
+ --                        this test.
+ --
+ --!
+ with Report;
+ with System.Storage_Elements;
+ with Ada.Streams;
+ 
+ procedure C453001 is
+    type Unsigned_Byte_Type    is mod 16#100#; -- 256;
+ 
+    type Unsigned_Word_Type    is mod 16#1_0000#; -- 65536;
+ 
+    type Unsigned_DWord_Type   is mod
+                                 Natural'Min (2**32, System.Max_Binary_Modulus);
+ 
+    type Unsigned_NBM_Type     is mod System.Max_Nonbinary_Modulus;
+ 
+    type Biggest_Unsigned_Type is mod System.Max_Binary_Modulus;
+ 
+    type Prime_Type            is mod 23; -- Prime number for hashing.
+ 
+    generic
+       type Mod_Type is mod <>; -- Assume this is a base type.
+       Key : in String;
+    procedure Test_Operators;
+ 
+    procedure Test_Operators is
+ 
+       function Ident_Mod (Val : in Mod_Type) return Mod_Type is
+          -- Optimization breaker.
+       begin
+          if Report.Equal (4, 12) then -- Always False (but complex).
+             return 1;
+          else
+             return Val;
+          end if;
+       end Ident_Mod;
+ 
+    begin
+       if Mod_Type'First /= 0 then -- The First of a base type is always 0.
+          Report.Failed ("Not base type first - " & Key);
+       end if;
+       if Mod_Type'Last /= Mod_Type'Base'Last then
+          Report.Failed ("Not base type last - " & Key);
+       end if;
+ 
+       -- Note: Mod_Type'First always is 0.
+ 
+       -- Check addition
+       declare
+          M : constant Mod_Type := Mod_Type'Last;
+          V : Mod_Type;
+       begin
+          V := M + 1; -- Should wrap around
+          if Ident_Mod (V) /= 0 then
+             Report.Failed ("Addition didn't wrap round - " & Key);
+          end if;
+          V := Ident_Mod (M - 2) + 5; -- Should wrap around
+          if Ident_Mod (V) /= 2 then
+             Report.Failed ("Addition didn't wrap round again - " & Key);
+          end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised for addition - " & Key);
+          when others           =>
+             Report.Failed
+              ("Some even more unexpected exception raised for addition - " &
+                Key);
+       end;
+ 
+       -- Check subtraction
+       declare
+          M : constant Mod_Type := 0;
+          V : Mod_Type;
+       begin
+          V := M - 1; -- Should wrap around
+          if Ident_Mod (V) /= Mod_Type'Last then
+             Report.Failed ("Subtraction didn't wrap round - " & Key);
+          end if;
+          V := Ident_Mod (3) - 7; -- Should wrap around
+          if Ident_Mod (V) /= Mod_Type'Last-3 then
+             Report.Failed ("Subtraction didn't wrap round again - " & Key);
+          end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised for subtraction - " & Key);
+          when others           =>
+             Report.Failed
+              ("Some even more unexpected exception raised for subtraction - " &
+                 Key);
+       end;
+ 
+    end Test_Operators;
+ 
+    procedure Test_Unsigned_Byte_Operators    is new Test_Operators
+                                               (Unsigned_Byte_Type, "Byte");
+ 
+    procedure Test_Unsigned_Word_Operators    is new Test_Operators
+                                               (Unsigned_Word_Type, "Word");
+ 
+    procedure Test_Unsigned_DWord_Operators   is new Test_Operators
+                                               (Unsigned_DWord_Type, "DWord");
+ 
+    procedure Test_Unsigned_NBM_Operators     is new Test_Operators
+                                                  (Unsigned_NBM_Type, "NBM");
+ 
+    procedure Test_Biggest_Unsigned_Operators is new Test_Operators
+                                               (Biggest_Unsigned_Type, "Big");
+ 
+    procedure Test_Prime_Operators is new Test_Operators (Prime_Type, "Prime");
+ 
+    procedure Test_Storage_Element_Operators  is new Test_Operators
+                         (System.Storage_Elements.Storage_Element, "Storage");
+ 
+    procedure Test_Stream_Element_Operators   is new Test_Operators
+                                      (Ada.Streams.Stream_Element, "Stream");
+ 
+ begin
+ 
+    Report.Test
+      ("C453001",
+       "Check that overflow checking is not performed for adding operators " &
+       "of modular types");
+ 
+    -- Check assignment
+    declare
+       -- Define subtypes
+       subtype My_Unsigned_Byte_Type  is Unsigned_Byte_Type;
+       subtype My_Unsigned_Word_Type  is Unsigned_Word_Type;
+       subtype My_Unsigned_DWord_Type is Unsigned_DWord_Type;
+ 
+       -- Define constants in upper half of range
+       C1 : constant Unsigned_Byte_Type     := Unsigned_Byte_Type'Last;
+       C2 : constant My_Unsigned_Byte_Type  := 16#FE#;
+       C3 : constant Unsigned_Word_Type     := 16#FACE#;
+       C4 : constant My_Unsigned_Word_Type  := My_Unsigned_Word_Type'Last;
+       C5 : constant Unsigned_DWord_Type    := My_Unsigned_DWord_Type'Last;
+ 
+       -- Define variables
+       V1 : Unsigned_Byte_Type;
+       V2 : My_Unsigned_Byte_Type;
+       V3 : Unsigned_Word_Type;
+       V4 : My_Unsigned_Word_Type;
+       V5 : Unsigned_DWord_Type;
+    begin
+       V1 := C1;
+       V1 := C2;
+       V2 := C1;
+       V2 := C2;
+       V3 := C3;
+       V3 := C4;
+       V4 := C3;
+       V4 := C4;
+       V5 := C5;
+       if V1 /= C2 or V2 /= C2 or V3 /= C4 or V4 /= C4 or V5 /= C5 then
+          Report.Comment ("Don't optimize assignment!"); -- Optimization breaker
+       end if;
+    exception
+       when Constraint_Error =>
+          Report.Failed ("Constraint_Error raised for assignment");
+       when others           =>
+          Report.Failed ("Some even more unexpected exception raised " &
+                         "for assignment");
+    end;
+ 
+    Test_Unsigned_Byte_Operators;
+    Test_Unsigned_Word_Operators;
+    Test_Unsigned_DWord_Operators;
+    Test_Unsigned_NBM_Operators;
+    Test_Biggest_Unsigned_Operators;
+    Test_Prime_Operators;
+    Test_Storage_Element_Operators;
+    Test_Stream_Element_Operators;
+ 
+    Report.Result;
+ 
+ end C453001;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45303a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45303a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45303a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45303a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C45303A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ADDITION AND SUBTRACTION YIELD RESULTS BELONGING TO THE
+ -- BASE TYPE.
+ 
+ -- JBG 2/24/84
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ -- JRL 10/13/96 Fixed static expressions which contained values outside
+ --              the base range.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45303A IS
+ 
+      TYPE INT IS RANGE 1..10;
+ 
+      X, Y : INT := INT(IDENT_INT(9));
+ 
+ BEGIN
+ 
+      TEST ("C45303A", "CHECK SUBTYPE OF INTEGER ADDITION/SUBTRACTION");
+ 
+      BEGIN
+ 
+           IF X + Y - 10 /= INT(IDENT_INT(8)) THEN
+                FAILED ("INCORRECT RESULT - ADDITION");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                IF INT'POS(INT'BASE'LAST) >= 18 THEN
+                     FAILED ("ADDITION DOES NOT YIELD RESULT " &
+                             "BELONGING TO THE BASE TYPE");
+                ELSE
+                     COMMENT ("BASE TYPE HAS RANGE LESS THAN 18 - ADD");
+                END IF;
+      END;
+ 
+      BEGIN
+ 
+           IF 2 - X - INT(IDENT_INT(1)) /= INT'VAL(IDENT_INT(-8)) THEN
+                FAILED ("INCORRECT RESULT - SUBTRACTION");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                IF INT'POS(INT'BASE'FIRST) <= -8 THEN
+                     FAILED ("SUBTRACTION DOES NOT YIELD RESULT " &
+                             "BELONGING TO THE BASE TYPE");
+                ELSE
+                     COMMENT ("BASE TYPE HAS RANGE GREATER THAN -8 - SUB");
+                END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C45303A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45304a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45304a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45304a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C45304A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY
+ --     "+" AND "-" FOR PREDEFINED INTEGER WHEN THE RESULT IS OUTSIDE
+ --     THE RANGE OF THE BASE TYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     TBN 10/06/86  CREATED ORIGINAL TEST.
+ --     JET 12/29/87  FURTHER DEFEATED OPTIMIZATION.
+ --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45304A IS
+ 
+ BEGIN
+      TEST ("C45304A", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
+                       "INTEGER WHEN THE RESULT IS OUTSIDE THE RANGE " &
+                       "OF THE BASE TYPE");
+ 
+      DECLARE
+           B : INTEGER := INTEGER'LAST;
+      BEGIN
+           IF EQUAL (IDENT_INT(B)+1, 0) THEN
+                FAILED ("NO EXCEPTION FOR ADDITION -- ZERO RESULT");
+           ELSE
+                FAILED ("NO EXCEPTION FOR ADDITION -- NONZERO RESULT");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED FOR ADDITION");
+      END;
+ 
+      DECLARE
+           B : INTEGER := INTEGER'FIRST;
+      BEGIN
+           IF EQUAL (IDENT_INT(B)-1, 0) THEN
+                FAILED ("NO EXCEPTION FOR SUBTRACTION -- ZERO RESULT");
+           ELSE
+                FAILED ("NO EXCEPTION FOR SUBTRACTION -- " &
+                        "NONZERO RESULT");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED FOR SUBTRACTION");
+      END;
+ 
+      RESULT;
+ END C45304A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45304b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45304b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45304b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45304b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C45304B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY
+ --     "+" AND "-" FOR PREDEFINED SHORT_INTEGER WHEN THE RESULT IS
+ --     OUTSIDE THE RANGE OF THE BASE TYPE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE IF THE IMPLEMENTATION HAS A
+ --     PREDEFINED TYPE SHORT_INTEGER.
+ 
+ --     IF SHORT_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "TEST_VAR" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     TBN 10/07/86  CREATED ORIGINAL TEST.
+ --     JET 12/30/87  ADDED CODE TO PREVENT OPTIMIZATION.
+ --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45304B IS
+ 
+      TEST_VAR : SHORT_INTEGER;                 -- N/A => ERROR.
+ 
+      -- THESE FUNCTIONS ARE TO PREVENT OPTIMIZATION.
+ 
+      FUNCTION IDENT_SHORT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           ELSE
+                RETURN (0);
+           END IF;
+      END IDENT_SHORT;
+ 
+      FUNCTION SHORT_OK (X : SHORT_INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN EQUAL (INTEGER(X),INTEGER(X));
+      END SHORT_OK;
+ 
+ BEGIN
+      TEST ("C45304B", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
+                       "SHORT_INTEGER WHEN THE RESULT IS OUTSIDE THE " &
+                       "RANGE OF THE BASE TYPE");
+ 
+      DECLARE
+           B : SHORT_INTEGER := SHORT_INTEGER'LAST;
+      BEGIN
+           IF SHORT_OK (B + IDENT_SHORT(1)) THEN
+                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                        "SHORT_OK RETURNS TRUE");
+           ELSE
+                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                        "SHORT_OK RETURNS FALSE");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+      END;
+ 
+      DECLARE
+           B : SHORT_INTEGER := SHORT_INTEGER'FIRST;
+      BEGIN
+ 
+           IF SHORT_OK (B - IDENT_SHORT(1)) THEN
+                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION- " &
+                        "SHORT_OK RETURNS TRUE");
+           ELSE
+                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
+                        "SHORT_OK RETURNS FALSE");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+      RESULT;
+ END C45304B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45304c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45304c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45304c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45304c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C45304C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY
+ --     "+" AND "-" FOR PREDEFINED LONG_INTEGER WHEN THE RESULT IS
+ --     OUTSIDE THE RANGE OF THE BASE TYPE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE IF THE IMPLEMENTATION HAS A
+ --     PREDEFINED TYPE LONG_INTEGER.
+ 
+ --     IF LONG_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "TEST_VAR" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     TBN 10/07/86  CREATED ORIGINAL TEST.
+ --     JET 12/30/87  ADDED CODE TO PREVENT OPTIMIZATION.
+ --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45304C IS
+ 
+      TEST_VAR : LONG_INTEGER;               -- N/A => ERROR.
+ 
+      -- THESE FUNCTIONS ARE TO PREVENT OPTIMIZATION.
+ 
+      FUNCTION IDENT_LONG (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT_LONG;
+ 
+      FUNCTION LONG_OK (X : LONG_INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN X = IDENT_LONG(X);
+      END LONG_OK;
+ 
+ BEGIN
+      TEST ("C45304C", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
+                       "LONG_INTEGER WHEN THE RESULT IS OUTSIDE THE " &
+                       "RANGE OF THE BASE TYPE");
+ 
+      DECLARE
+           B : LONG_INTEGER := LONG_INTEGER'LAST;
+      BEGIN
+           IF LONG_OK (B + IDENT_LONG(1)) THEN
+                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                        "LONG_OK RETURNS TRUE");
+           ELSE
+                FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                        "LONG_OK RETURNS FALSE");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+      END;
+ 
+      DECLARE
+           B : LONG_INTEGER := LONG_INTEGER'FIRST;
+      BEGIN
+           IF LONG_OK (B - IDENT_LONG(1)) THEN
+                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
+                        "LONG_OK RETURNS TRUE");
+           ELSE
+                FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
+                        "LONG_OK RETURNS FALSE");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+      RESULT;
+ END C45304C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45322a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45322a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45322a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45322a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,196 ----
+ -- C45322A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF 
+ --     MACHINE_OVERFLOWS IS TRUE AND THE RESULT OF THE ADDITION OR 
+ --     SUBTRACTION LIES OUTSIDE OF THE RANGE OF THE BASE TYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     NPL 09/01/90  CREATED ORIGINAL TEST.
+ --     LDC 10/09/90  CHANGED THE STYLE OF THE TEST TO THE STANDARD
+ --                   ACVC FORMAT AND WRAPPED LINES WHICH WHERE LONGER
+ --                   THAN 71 CHARACTERS.
+ --     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45322A IS
+ 
+   TYPE FLOAT5 IS DIGITS 5;
+   F5 : FLOAT5;
+ 
+   FUNCTION IDENT (F : FLOAT5) RETURN FLOAT5 IS
+   BEGIN
+     RETURN F * FLOAT5(IDENT_INT(1));
+   END IDENT;
+ 
+   FUNCTION EQUAL (F,G : FLOAT5) RETURN BOOLEAN IS
+   BEGIN
+     RETURN F = G + FLOAT5(IDENT_INT(0));
+   END EQUAL;
+ 
+ BEGIN
+      TEST ("C45322A", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED IF MACHINE_OVERFLOWS IS TRUE AND " &
+                       "THE RESULT OF THE ADDITION OR SUBTRACTION " &
+                       "LIES OUTSIDE OF THE RANGE OF THE BASE TYPE");
+ 
+      IF NOT FLOAT5'MACHINE_OVERFLOWS THEN
+           NOT_APPLICABLE("MACHINE_OVERFLOWS IS FALSE");
+      ELSE
+ 
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'LAST;
+ 
+                FAILED("NO EXCEPTION RAISED BY LARGE '+'");
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '+'");
+           END;
+ 
+           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'LAST;
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR " &
+                            "RAISED BY INTERCHANGING LARGE '+'");
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                            "INTERCHANGING LARGE '+'");
+           END;
+ 
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'FIRST;
+ 
+                FAILED("NO EXCEPTION RAISED BY SMALL '+'");
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '+'");
+           END;
+ 
+           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'FIRST;
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR " &
+                            "RAISED BY INTERCHANGING SMALL '+'");
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                            "INTERCHANGING SMALL '+'");
+           END;
+ 
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'FIRST;
+ 
+                FAILED("NO EXCEPTION RAISED BY LARGE '-'");
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '-'");
+           END;
+ 
+           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'FIRST;
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR " &
+                            "RAISED BY INTERCHANGING LARGE '-'");
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                            "INTERCHANGING LARGE '-'");
+           END;
+ 
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'LAST;
+ 
+                FAILED("NO EXCEPTION RAISED BY SMALL '-'");
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '-'");
+           END;
+ 
+           -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+           BEGIN
+                F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'LAST;
+ 
+                IF NOT EQUAL(F5, F5) THEN
+                     COMMENT("DON'T OPTIMIZE F5");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR " &
+                            "RAISED BY INTERCHANGING SMALL '-'");
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                            "INTERCHANGING SMALL '-'");
+           END;
+ 
+      END IF;
+ 
+      RESULT;
+ 
+ END C45322A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45323a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45323a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45323a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45323a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- C45323A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE NONASSOCIATIVITY OF REAL ARITHMETIC IS PRESERVED
+ --     FOR FLOATING POINT PRECISION 5, EVEN WHEN OPTIMIZATION WOULD
+ --     BENEFIT IF FLOATING POINT ADDITION WERE ASSOCIATIVE.
+ 
+ -- HISTORY:
+ --     JET 08/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45323A IS
+ 
+      TYPE FLOAT5 IS DIGITS 5;
+ 
+      A, B, C, D, E : FLOAT5;
+ 
+      FUNCTION IDENT(F : FLOAT5) RETURN FLOAT5 IS
+      BEGIN
+           RETURN F * FLOAT5(IDENT_INT(1));
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C45323A", "CHECK THAT THE NONASSOCIATIVITY OF REAL " &
+                       "ARITHMETIC IS PRESERVED FOR FLOATING POINT " &
+                       "PRECISION 5, EVEN WHEN OPTIMIZATION WOULD " &
+                       "BENEFIT IF FLOATING POINT ADDITION WERE " &
+                       "ASSOCIATIVE");
+ 
+      B := 2#0.1010_1010_1010_1010_10#E3;
+      A := -B;
+      C := 2#0.1000_0000_0000_0000_00#E-18;
+      D := B + C;
+      E := A + B + C;
+ 
+      IF IDENT(A) + IDENT(B) /= 0.0 THEN
+           FAILED("INCORRECT VALUE OF A + B");
+      END IF;
+ 
+      IF IDENT(E) /= IDENT(C) THEN
+           FAILED("C DOES NOT EQUAL E");
+      END IF;
+ 
+      RESULT;
+ END C45323A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45331a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45331a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45331a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45331a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,357 ----
+ -- C45331A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES THE OPERATORS "+" AND "-" PRODUCE
+ -- CORRECT RESULTS WHEN:
+ --      (A) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS.
+ --      (B) A IS A MODEL NUMBER BUT B, A+B, AND A-B ARE NOT.
+ --      (C) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS WITH DIFFERENT
+ --          SUBTYPES.
+ 
+ -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+ 
+ -- WRG 8/27/86
+ -- KAS 11/14/95 REDUCE EXPECTATION FOR T'SMALL
+ -- KAS 11/30/95 ONE MORE CHANGE...
+ -- PWN 02/28/96 CLEANED COMMENTS FOR RELEASE
+ -- KAS 03/18/96 ELIDED TWO 'SMALL CASES FOR 2.1
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45331A IS
+ 
+      TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+           -- 'MANTISSA = 23.
+      SUBTYPE F     IS LIKE_DURATION DELTA 0.25 RANGE -1000.0 .. 1000.0;
+      SUBTYPE ST_F1 IS LIKE_DURATION DELTA 0.5  RANGE    -4.0 ..    3.0;
+      SUBTYPE ST_F2 IS LIKE_DURATION DELTA 1.0 / 16
+              RANGE -13.0 / 16 .. 5.0 + 1.0 / 16;
+ 
+ BEGIN
+ 
+      TEST ("C45331A", "CHECK THAT FOR FIXED POINT TYPES THE " &
+                       "OPERATORS ""+"" AND ""-"" PRODUCE CORRECT " &
+                       "RESULTS - BASIC TYPES");
+ 
+      -------------------------------------------------------------------
+ 
+ A:   DECLARE
+           SMALL, MAX, MIN, ZERO : F := 0.5;
+           X                     : F := 0.0;
+      BEGIN
+           -- INITIALIZE "CONSTANTS":
+           IF EQUAL (3, 3) THEN
+                SMALL := F'SMALL;
+                MAX   := F'LAST;  -- BECAUSE F'LAST < F'LARGE AND F'LAST
+                                  -- IS A MODEL NUMBER.
+                MIN   := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
+                ZERO  := 0.0;
+           END IF;
+ 
+           -- CHECK SMALL + OR - ZERO = SMALL:
+           IF "+"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
+              0.0 + SMALL /= SMALL THEN
+                FAILED ("F'SMALL + 0.0 /= F'SMALL");
+           END IF;
+           IF "-"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
+              SMALL - 0.0 /= SMALL THEN
+                FAILED ("F'SMALL - 0.0 /= F'SMALL");
+           END IF;
+ 
+           -- CHECK MAX + OR - ZERO = MAX:
+           IF MAX + ZERO /= MAX OR 0.0 + MAX /= MAX THEN
+                FAILED ("F'LAST + 0.0 /= F'LAST");
+           END IF;
+           IF MAX - ZERO /= MAX OR MAX - 0.0 /= MAX THEN
+                FAILED ("F'LAST - 0.0 /= F'LAST");
+           END IF;
+ 
+           -- CHECK SMALL - SMALL = 0.0:
+           IF EQUAL (3, 3) THEN
+                X := SMALL;
+           END IF;
+           IF SMALL - X /= 0.0 OR SMALL - SMALL /= 0.0 OR
+              F'SMALL - F'SMALL /= 0.0 THEN
+                FAILED ("F'SMALL - F'SMALL /= 0.0");
+           END IF;
+ 
+           -- CHECK MAX - MAX = 0.0:
+           IF EQUAL (3, 3) THEN
+                X := MAX;
+           END IF;
+           IF MAX - X /= 0.0 OR MAX - MAX /= 0.0 OR
+              F'LAST - F'LAST /= 0.0 THEN
+                FAILED ("F'LAST - F'LAST /= 0.0");
+           END IF;
+ 
+           -- CHECK ZERO - MAX = MIN, MIN - MIN = 0.0,
+           -- AND MIN + MAX = 0.0:
+           IF EQUAL (3, 3) THEN
+                X := ZERO - MAX;
+           END IF;
+           IF X /= MIN THEN
+                FAILED ("0.0 - 1000.0 /= -1000.0");
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := MIN;
+           END IF;
+           IF MIN - X /= 0.0 OR MIN - MIN /= 0.0 OR
+              F'FIRST - F'FIRST /= 0.0 THEN
+                FAILED ("F'FIRST - F'FIRST /= 0.0");
+           END IF;
+           IF MIN + MAX /= 0.0 OR MAX + MIN /= 0.0 OR
+              F'FIRST + F'LAST /= 0.0 THEN
+                FAILED ("-1000.0 + 1000.0 /= 0.0");
+           END IF;
+ 
+           -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
+           -- NUMBERS:
+           IF EQUAL (3, 3) THEN
+                X := 100.75;
+           END IF;
+           IF (X + SMALL) /= (SMALL + X) OR
+              (X + SMALL) > (X + 0.25) THEN -- X + SMALL SB <= X + DELTA
+                FAILED("X + SMALL DELIVERED BAD RESULT");
+           END IF;
+ 
+           -- CHECK (MAX - SMALL) + SMALL = MAX:
+           IF EQUAL (3, 3) THEN
+                X := MAX - SMALL;
+           END IF;
+           IF X + SMALL /= MAX THEN
+               FAILED("(MAX - SMALL) + SMALL /= MAX");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - A");
+      END A;
+ 
+      -------------------------------------------------------------------
+ 
+ B:   DECLARE
+           NON_MODEL_CONST : CONSTANT := 2.0 / 3;
+           NON_MODEL_VAR   : F        := 0.0;
+ 
+           SMALL, MAX, MIN, ZERO : F := 0.5;
+           X                     : F := 0.0;
+      BEGIN
+           -- INITIALIZE "CONSTANTS":
+           IF EQUAL (3, 3) THEN
+                SMALL         := F'SMALL;
+                MAX           := F'LAST;  -- BECAUSE F'LAST < F'LARGE AND
+                                          -- F'LAST  IS A MODEL NUMBER.
+                MIN           := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
+                ZERO          := 0.0;
+                NON_MODEL_VAR := NON_MODEL_CONST;
+           END IF;
+ 
+           -- CHECK VALUE OF NON_MODEL_VAR:
+           IF NON_MODEL_VAR NOT IN 0.5 .. 0.75 THEN
+                FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE");
+           END IF;
+ 
+           -- CHECK NON-MODEL VALUE + OR - ZERO:
+           IF NON_MODEL_VAR + ZERO NOT IN 0.5 .. 0.75 OR
+              F'(0.0) + NON_MODEL_CONST NOT IN 0.5 .. 0.75 THEN
+                FAILED ("(2.0 / 3) + 0.0 NOT IN 0.5 .. 0.75");
+           END IF;
+           IF NON_MODEL_VAR  - ZERO NOT IN 0.5 .. 0.75 OR
+              NON_MODEL_CONST - F'(0.0) NOT IN 0.5 .. 0.75 THEN
+                FAILED ("(2.0 / 3) - 0.0 NOT IN 0.5 .. 0.75");
+           END IF;
+ 
+           -- CHECK ZERO - NON-MODEL:
+           IF F'(0.0) - NON_MODEL_CONST NOT IN -0.75 .. -0.5 THEN
+                FAILED ("0.0 - (2.0 / 3) NOT IN -0.75 .. -0.5");
+           END IF;
+ 
+           IF F'(1.0) - NON_MODEL_CONST NOT IN 0.25 .. 0.5 THEN
+                FAILED ("1.0 - (2.0 / 3) NOT IN 0.25 .. 0.5");
+           END IF;
+ 
+           -- CHECK ADDITION AND SUBTRACTION OF NON-MODEL NEAR MIN AND
+           -- MAX:
+           IF MIN + NON_MODEL_VAR NOT IN -999.5 .. -999.25 OR
+              NON_MODEL_CONST + F'FIRST NOT IN -999.5 .. -999.25 THEN
+                FAILED ("-1000.0 + (2.0 / 3) NOT IN -999.5 .. -999.25");
+           END IF;
+           IF MAX - NON_MODEL_VAR NOT IN 999.25 .. 999.5 OR
+              F'LAST - NON_MODEL_CONST NOT IN 999.25 .. 999.5 THEN
+                FAILED ("1000.0 - (2.0 / 3) NOT IN 999.25 .. 999.5");
+           END IF;
+ 
+           -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
+           -- MODEL NUMBER WITH NON-MODEL:
+           IF EQUAL (3, 3) THEN
+                X := -213.25;
+           END IF;
+           IF X + NON_MODEL_CONST NOT IN -212.75 .. -212.5 THEN
+                FAILED ("-213.25 + (2.0 / 3) NOT IN -212.75 .. -212.5");
+           END IF;
+           IF NON_MODEL_VAR - X NOT IN 213.75 .. 214.0 THEN
+                FAILED ("(2.0 / 3) - (-213.25) NOT IN 213.75 .. 214.0");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - B");
+      END B;
+ 
+      -------------------------------------------------------------------
+ 
+ C:   DECLARE
+           A_SMALL, A_MAX, A_MIN : ST_F1 := 0.0;
+           B_SMALL, B_MAX, B_MIN : ST_F2 := 0.0;
+           X                     : F;
+      BEGIN
+           -- INITIALIZE "CONSTANTS":
+           IF EQUAL (3, 3) THEN
+                A_SMALL := ST_F1'SMALL;
+                A_MAX   := ST_F1'LAST;  -- BECAUSE 'LAST < 'LARGE AND
+                                        -- 'LAST  IS A MODEL NUMBER.
+                A_MIN   := ST_F1'FIRST; -- 'FIRST IS A MODEL NUMBER.
+ 
+                B_SMALL := ST_F2'SMALL;
+                B_MAX   := ST_F2'LAST;  -- BECAUSE 'LAST <= 'LARGE AND
+                                        -- 'LAST  IS A MODEL NUMBER.
+                B_MIN   := ST_F2'FIRST; -- 'FIRST IS A MODEL NUMBER.
+           END IF;
+ 
+           IF A_MIN + B_MIN /= -4.8125 THEN
+                FAILED ("-4.0 + (-0.8125) /= -4.8125");
+           END IF;
+ 
+           IF A_MIN - B_MIN /= -3.1875 THEN
+                FAILED ("-4.0 - (-0.8125) /= -3.1875");
+           END IF;
+ 
+           IF (A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375 THEN
+                FAILED ("(A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375");
+           END IF;
+ 
+           IF (A_MIN - B_SMALL) NOT IN -4.0625 .. -4.0 THEN
+               FAILED ("(A_MIN - B_SMALL) NOT IN -4.0 .. -4.0625");
+           END IF;
+ 
+           IF A_MIN + B_MAX /= 1.0625 THEN
+                FAILED ("-4.0 + 5.0625 /= 1.0625");
+           END IF;
+ 
+           IF A_MIN - B_MAX /= -9.0625 THEN
+                FAILED ("-4.0 - 5.0625 /= -9.0625");
+           END IF;
+ 
+           IF (A_SMALL + B_MIN) NOT IN  B_MIN..-0.3125 THEN
+                FAILED ("(A_SMALL + B_MIN) NOT IN  B_MIN..-0.3125");
+           END IF;
+ 
+           IF (A_SMALL - B_MIN) NOT IN +0.8125 .. 1.3125 THEN
+                FAILED ("(A_SMALL - B_MIN) NOT IN -0.8125 .. 1.3125");
+           END IF;
+ 
+ 
+ 
+           IF (A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625 THEN
+                FAILED ("(A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625");
+           END IF;
+ 
+           IF (A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625 THEN
+                FAILED ("(A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625");
+           END IF;
+ 
+           IF A_MAX + B_MIN /= 2.1875 THEN
+                FAILED ("3.0 + (-0.8125) /= 2.1875");
+           END IF;
+ 
+           IF A_MAX - B_MIN /= 3.8125 THEN
+                FAILED ("3.0 - (-0.8125) /= 3.8125");
+           END IF;
+ 
+           IF (A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625 THEN
+                FAILED ("(A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625");
+           END IF;
+ 
+           IF (A_MAX - B_SMALL) NOT IN 2.9375..3.0 THEN
+                FAILED ("(A_MAX - B_SMALL) NOT IN 2.9375..3.0");
+           END IF;
+ 
+           IF A_MAX + B_MAX /= 8.0625 THEN
+                FAILED ("3.0 + 5.0625 /= 8.0625");
+           END IF;
+ 
+           IF A_MAX - B_MAX /= -2.0625 THEN
+                FAILED ("3.0 - 5.0625 /= -2.0625");
+           END IF;
+ 
+           X := B_MIN - A_MIN;
+           IF X NOT IN 3.0 .. 3.25 THEN
+                FAILED ("-0.8125 - (-4.0) NOT IN RANGE");
+           END IF;
+ 
+           X := B_MIN - A_SMALL;
+           IF X NOT IN -1.3125 .. -0.8125 THEN
+                FAILED ("B_MIN - A_SMALL NOT IN RANGE");
+           END IF;
+ 
+           X := B_MIN - A_MAX;
+           IF X NOT IN -4.0 .. -3.75 THEN
+                FAILED ("-0.8125 - 3.0 NOT IN RANGE");
+           END IF;
+ 
+           X := B_SMALL - A_MIN;
+           IF X NOT IN 4.0 .. 4.0625 THEN
+                FAILED ("B_SMALL - A_MIN NOT IN RANGE");
+           END IF;
+ 
+ 
+           X := B_SMALL - A_MAX;
+           IF X NOT IN -3.0 .. -2.75 THEN
+                FAILED ("B_SMALL - A_MAX NOT IN RANGE");
+           END IF;
+ 
+           X := B_MAX - A_MIN;
+           IF X NOT IN 9.0 .. 9.25 THEN
+                FAILED ("5.0625 - (-4.0) NOT IN RANGE");
+           END IF;
+ 
+           X := B_MAX - A_SMALL;
+          IF X NOT IN 4.56 .. 5.0625 THEN
+                FAILED ("5.0625 - 0.5 NOT IN RANGE");
+           END IF;
+ 
+           X := B_MAX - A_MAX;
+           IF X NOT IN 2.0 .. 2.25 THEN
+                FAILED ("5.0625 - 3.0 NOT IN RANGE");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - C");
+      END C;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ END C45331A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45342a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45342a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45342a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45342a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C45342A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CATENATION OF TWO OR MORE NON-NULL OPERANDS YIELDS THE
+ -- CORRECT RESULT, WITH THE CORRECT BOUNDS, WHETHER BOUNDS ARE STATIC OR
+ -- DYNAMIC.
+ 
+ -- BHS 6/27/84
+ 
+ WITH REPORT;
+ PROCEDURE C45342A IS
+ 
+      USE REPORT;
+ 
+      SUBTYPE S IS INTEGER RANGE 1..100;
+      TYPE ARR IS ARRAY (S RANGE <>) OF INTEGER;
+      
+      A,B : ARR (2..9);
+ 
+      FUNCTION F (AR_VAR1, AR_VAR2, AR_VAR3 : ARR) RETURN ARR IS
+      BEGIN
+           RETURN AR_VAR1 & AR_VAR2 & AR_VAR3;
+      END F;
+ 
+      PROCEDURE CAT (A : ARR; I1,I2 : INTEGER; NUM : CHARACTER) IS
+      BEGIN
+           IF A'FIRST /= I1 OR A'LAST /= I2 THEN
+                FAILED ("INCORRECT CATENATION BOUNDS - " & NUM);
+           END IF;
+      END CAT;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C45342A", "CHECK THAT CATENATION OF NON-NULL OPERANDS " &
+                       "YIELDS CORRECT RESULT WITH CORRECT BOUNDS"); 
+ 
+      BEGIN
+           A := (1,2,3,4,5,6,7,8);
+           B := A(2..4) & A(2..5) & A(2..2);
+           IF B /= (1,2,3,1,2,3,4,1) THEN
+                FAILED ("INCORRECT CATENATION RESULT - 1");
+           END IF;
+ 
+           A := (8,7,6,5,4,3,2,1);
+           IF F(A(2..3), A(2..4), A(2..4)) /= (8,7,8,7,6,8,7,6) THEN 
+                FAILED ("INCORRECT CATENATION RESULT - 2");
+           END IF;
+ 
+           CAT ( A(3..5) & A(2..3), 3, 7, '3' );
+      END;
+ 
+ 
+      DECLARE
+           DYN2 : INTEGER := IDENT_INT(2);
+           DYN3 : INTEGER := IDENT_INT(3);
+           DYN4 : INTEGER := IDENT_INT(4);
+           DYN6 : INTEGER := IDENT_INT(6);
+           
+      BEGIN
+           A := (1,2,3,4,5,6,7,8);
+           B := A(DYN2..DYN3) & A(DYN2..DYN4) & A(DYN2..DYN4);
+           IF B /= (1,2,1,2,3,1,2,3) THEN
+                FAILED ("INCORRECT CATENATION RESULT - 4");
+           END IF;
+ 
+           A := (8,7,6,5,4,3,2,1);
+           IF F ( A(DYN2..DYN6), A(DYN2..DYN3), A(DYN2..DYN2) )
+                 /= (8,7,6,5,4,8,7,8) THEN
+                FAILED ("INCORRECT CATENATION RESULT - 5");
+           END IF;
+ 
+           CAT ( A(DYN3..5) & A(2..3), 3, 7, '6');
+      END;  
+ 
+      RESULT;
+ 
+ END C45342A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45343a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45343a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45343a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45343a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C45343A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CATENATION OF NULL OPERANDS YIELDS THE CORRECT RESULT,
+ -- WITH THE CORRECT BOUNDS.
+ 
+ -- BHS 6/29/84
+ 
+ WITH REPORT;
+ PROCEDURE C45343A IS
+ 
+      USE REPORT;
+ 
+      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+      SUBTYPE ARR_8 IS ARR (1..8);
+      A1, A2 : ARR_8;
+ 
+      PROCEDURE CAT (A : ARR; I1,I2 : INTEGER; NUM : CHARACTER) IS
+      BEGIN
+           IF A'FIRST /= I1 OR A'LAST /= I2 THEN
+                FAILED ("INCORRECT CATENATION - " & NUM);
+           END IF;
+      END CAT;
+ 
+ BEGIN
+ 
+      TEST ("C45343A", "CATENATION OF NULL OPERANDS"); 
+ 
+ 
+      A1 := (1,2,3,4,5,6,7,8);
+      A2 := A1(1..0) & A1(6..5) & A1(1..8);
+      IF A2 /= (1,2,3,4,5,6,7,8) THEN
+           FAILED ("INCORRECT CATENATION RESULT - 1");
+      END IF;
+ 
+      A1 := (1,2,3,4,5,6,7,8);
+      A2 := A1(2..8) & A1(1..0) & 9;
+      IF A2 /= (2,3,4,5,6,7,8,9) THEN
+           FAILED ("INCORRECT CATENATION RESULT - 2");
+      END IF;
+ 
+ 
+      CAT ( A1(1..0) & A1(IDENT_INT(2)..0), 2, 0, '3' );
+      CAT ( A1(IDENT_INT(1)..0) & A2(2..0), 2, 0, '4' );
+ 
+      CAT ( A1(1..0) & A1(6..5) & A1(2..8), 2, 8, '5' );
+      CAT ( A1(2..8) & A1(1..0), 2, 8, '6' );
+ 
+      CAT ( A2(1..0) & A2(6..5) & A2(IDENT_INT(2)..8), 2, 8, '7' );
+      CAT ( A2(IDENT_INT(2)..8) & A2(1..0), 2, 8, '8' );
+ 
+      RESULT;
+ 
+ END C45343A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45344a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45344a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45344a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45344a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C45344A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CORRECT RESULT IS PRODUCED WHEN A FUNCTION RETURNS 
+ -- THE RESULT OF A CATENATION WHOSE BOUNDS ARE NOT DEFINED STATICALLY.
+ 
+ -- R.WILLIAMS 9/1/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45344A IS
+ 
+ BEGIN
+      TEST ( "C45344A", "CHECK THAT THE CORRECT RESULT IS PRODUCED " &
+                        "WHEN A FUNCTION RETURNS THE RESULT OF A " &
+                        "CATENATION WHOSE BOUNDS ARE NOT DEFINED " &
+                        "STATICALLY" );
+ 
+      DECLARE
+           SUBTYPE INT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (30);
+ 
+           TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
+           SUBTYPE CARR IS ARR (1 .. 9);
+           C : CARR;
+           
+           AR1 : ARR (IDENT_INT (2) .. IDENT_INT (4)) :=
+                     (IDENT_INT (2) .. IDENT_INT (4) => 1);
+ 
+           AR2 : ARR (IDENT_INT (6) .. IDENT_INT (6)) :=
+                     (IDENT_INT (6) .. IDENT_INT (6) => 2);
+ 
+           AR3 : ARR (IDENT_INT (4) .. IDENT_INT (2));
+      
+           FUNCTION F (A, B : ARR; N : NATURAL) RETURN ARR IS
+           BEGIN
+                IF N = 0 THEN
+                     RETURN A & B;
+                ELSE
+                     RETURN F (A & B, B, N - 1);
+                END IF;
+           END F;
+      
+           FUNCTION G (A : INTEGER; B : ARR; N : NATURAL) RETURN ARR IS
+           BEGIN
+                IF N = 0 THEN
+                     RETURN A & B;
+                ELSE
+                     RETURN G (A, A & B, N - 1);
+                END IF;
+           END G;
+ 
+           FUNCTION H (A : ARR; B : INTEGER; N : NATURAL) RETURN ARR IS
+           BEGIN
+                IF N = 0 THEN
+                     RETURN A & B;
+                ELSE
+                     RETURN H (A & B, B, N - 1);
+                END IF;
+           END H;
+      
+           PROCEDURE CHECK (X, Y : ARR; F, L : INTEGER; STR : STRING) IS
+                OK : BOOLEAN := TRUE;
+           BEGIN
+                IF X'FIRST /= F AND X'LAST /= L THEN
+                     FAILED ( "INCORRECT RANGE FOR " & STR);
+                ELSE
+                     FOR I IN F .. L LOOP
+                          IF X (I) /= Y (I) THEN
+                               OK := FALSE;
+                          END IF;
+                     END LOOP;
+      
+                     IF NOT OK THEN
+                          FAILED ( "INCORRECT VALUE FOR " & STR);
+                     END IF;
+                END IF;
+           END CHECK;
+ 
+      BEGIN
+           C := (1 .. 4 => 1, 5 .. 9 => 2);
+           CHECK (F (AR1, AR2, IDENT_INT (3)), C, 2, 8, "F - 1" );
+           CHECK (F (AR3, AR2, IDENT_INT (3)), C, 6, 9, "F - 2" );
+           CHECK (F (AR2, AR3, IDENT_INT (3)), C, 6, 6, "F - 3" );
+ 
+           C := (1 ..4 => 5, 5 .. 9 => 1);
+           CHECK (G (5, AR1, IDENT_INT (3)), C, 1, 7, "G - 1" );
+           CHECK (G (5, AR3, IDENT_INT (3)), C, 1, 4, "G - 2" );
+ 
+           CHECK (H (AR3, 5, IDENT_INT (3)), C, 1, 4, "H - 1" );
+ 
+           C := (1 ..4 => 1, 5 .. 9 => 5);
+           CHECK (H (AR1, 5, IDENT_INT (3)), C, 2, 8, "H - 2" );
+      END;
+ 
+      RESULT;
+ END C45344A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45345b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45345b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45345b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45345b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- C45345B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT  CONSTRAINT_ERROR  IS NOT RAISED IF THE RESULT OF
+ --     CATENATION HAS PRECISELY THE MAXIMUM LENGTH PERMITTED BY THE
+ --     INDEX SUBTYPE.
+ 
+ 
+ -- RM  2/26/82
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C45345B IS
+ 
+ 
+ BEGIN
+ 
+      TEST ( "C45345B" , "CHECK THAT  CONSTRAINT_ERROR  IS NOT RAISED" &
+                         " IF THE RESULT OF CATENATION HAS PRECISELY" &
+                         " THE MAXIMUM LENGTH PERMITTED BY THE" &
+                         " INDEX SUBTYPE" );
+ 
+ 
+      -------------------------------------------------------------------
+      -----------------  STRG_VAR := STRG_LIT & STRG_LIT  ---------------
+ 
+      DECLARE
+ 
+           X : STRING(1..5) ;
+ 
+      BEGIN
+ 
+           X := "ABCD" & "E" ;
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+                FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
+ 
+           WHEN  OTHERS =>
+                FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
+ 
+      END;
+ 
+ 
+      -------------------------------------------------------------------
+      -----------------  STRG_VAR := STRG_LIT & CHARACTER  --------------
+ 
+      DECLARE
+ 
+           X : STRING(1..5) ;
+ 
+      BEGIN
+ 
+           X := "ABCD" & 'E' ;
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+                FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
+ 
+           WHEN  OTHERS =>
+                FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
+ 
+      END;
+ 
+      -------------------------------------------------------------------
+      -----------------  STRG_VAR := STRG_VAR & STRG_VAR  ---------------
+ 
+      DECLARE
+ 
+           X :          STRING(1..5) ;
+           A : CONSTANT STRING       := "A" ;
+           B :          STRING(1..4) := IDENT_STR("BCDE") ;
+ 
+      BEGIN
+ 
+           X :=  A & B ;
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+                FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
+ 
+           WHEN  OTHERS =>
+                FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
+ 
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ 
+ END C45345B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- C45347A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CATENATION IS DEFINED FOR RECORD TYPES AS COMPONENT TYPES.
+ 
+ -- JWC 11/15/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45347A IS
+ 
+ BEGIN
+ 
+      TEST ("C45347A", "CHECK THAT CATENATION IS DEFINED " &
+                       "FOR RECORD TYPES AS COMPONENT TYPES");
+ 
+      DECLARE
+ 
+           TYPE REC IS
+                RECORD
+                     X : INTEGER;
+                END RECORD;
+ 
+           SUBTYPE INT IS INTEGER RANGE 1 .. 4;
+           TYPE A IS ARRAY ( INT RANGE <>) OF REC;
+ 
+           R1 : REC := (X => 4);
+           R2 : REC := (X => 1);
+ 
+           A1 : A(1 .. 2) := ((X => 1), (X => 2));
+           A2 : A(1 .. 2) := ((X => 3), (X => 4));
+           A3 : A(1 .. 4) := ((X => 1), (X => 2), (X => 3), (X => 4));
+           A4 : A(1 .. 4);
+           A5 : A(1 .. 4) := ((X => 4), (X => 3), (X => 2), (X => 1));
+ 
+      BEGIN
+ 
+           A4 := A1 & A2;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF " &
+                        "RECORDS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := A1 & A2(1) & R1;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ARRAY OF RECORD, " &
+                        "AND RECORDS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := R2 & (A1(2) & A2);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR RECORDS, " &
+                        "AND ARRAY OF RECORDS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := R2 & A1(2) & (A2(1) & R1);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR RECORDS");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45347A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C45347B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CATENATION IS DEFINED FOR ARRAY TYPES AS COMPONENT TYPES.
+ 
+ -- JWC 11/15/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45347B IS
+ 
+ BEGIN
+ 
+      TEST ("C45347B", "CHECK THAT CATENATION IS DEFINED " &
+                       "FOR ARRAY TYPES AS COMPONENT TYPES");
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (1 .. 2) OF INTEGER;
+           TYPE A IS ARRAY ( INTEGER RANGE <>) OF ARR;
+ 
+           AR1 : ARR := (4,1);
+           AR2 : ARR := (1,1);
+ 
+           A1 : A(1 .. 2) := ((1,1), (2,1));
+           A2 : A(1 .. 2) := ((3,1), (4,1));
+           A3 : A(1 .. 4) := ((1,1), (2,1), (3,1), (4,1));
+           A4 : A(1 .. 4);
+           A5 : A(1 .. 4) := ((4,1), (3,1), (2,1), (1,1));
+ 
+      BEGIN
+ 
+           A4 := A1 & A2;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ARRAYS OF ARRAYS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := A1 & A2(1) & AR1;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ARRAY OF ARRAYS " &
+                        "WITH ARRAYS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := AR2 & (A1(2) & A2);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ARRAYS WITH ARRAYS " &
+                        "OF ARRAYS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := A'(AR2 & A1(2)) & A'(A2(1) & AR1);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ARRAYS");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45347B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C45347C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CATENATION IS DEFINED FOR PRIVATE TYPES AS COMPONENT
+ -- TYPES.
+ 
+ -- JWC 11/15/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45347C IS
+ 
+ BEGIN
+ 
+      TEST ("C45347C", "CHECK THAT CATENATION IS DEFINED " &
+                       "FOR PRIVATE TYPES AS COMPONENT TYPES");
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                TYPE PRIV IS PRIVATE;
+                ONE : CONSTANT PRIV;
+                TWO : CONSTANT PRIV;
+                THREE : CONSTANT PRIV;
+                FOUR : CONSTANT PRIV;
+           PRIVATE
+                TYPE PRIV IS NEW INTEGER;
+                ONE : CONSTANT PRIV := 1;
+                TWO : CONSTANT PRIV := 2;
+                THREE : CONSTANT PRIV := 3;
+                FOUR : CONSTANT PRIV := 4;
+           END PKG;
+ 
+           USE PKG;
+ 
+           SUBTYPE INT IS INTEGER RANGE 1 .. 4;
+           TYPE A IS ARRAY ( INT RANGE <>) OF PRIV;
+ 
+           P1 : PRIV := FOUR;
+           P2 : PRIV := ONE;
+ 
+           A1 : A(1 .. 2) := (ONE, TWO);
+           A2 : A(1 .. 2) := (THREE, FOUR);
+           A3 : A(1 .. 4) := (ONE, TWO, THREE, FOUR);
+           A4 : A(1 .. 4);
+           A5 : A(1 .. 4) := (FOUR, THREE, TWO, ONE);
+ 
+      BEGIN
+ 
+           A4 := A1 & A2;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF " &
+                        "PRIVATE");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := A1 & A2(1) & P1;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ARRAY OF PRIVATE, " &
+                        "AND PRIVATE");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := P2 & (A1(2) & A2);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR PRIVATE, AND ARRAY " &
+                        "OF PRIVATE");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := P2 & A1(2) & (A2(1) & P1);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR PRIVATE");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45347C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45347d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45347d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C45347D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CATENATION IS DEFINED FOR ACCESS TYPES AS COMPONENT TYPES.
+ 
+ -- JWC 11/15/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45347D IS
+ 
+ BEGIN
+ 
+      TEST ("C45347D", "CHECK THAT CATENATION IS DEFINED " &
+                       "FOR ACCESS TYPES AS COMPONENT TYPES");
+ 
+      DECLARE
+ 
+           SUBTYPE INT IS INTEGER RANGE 1 .. 4;
+           TYPE ACC IS ACCESS INT;
+           TYPE A IS ARRAY ( INT RANGE <>) OF ACC;
+ 
+           AC1 : ACC := NEW INT'(1);
+           AC2 : ACC := NEW INT'(2);
+           AC3 : ACC := NEW INT'(3);
+           AC4 : ACC := NEW INT'(4);
+ 
+           A1 : A(1 .. 2) := (AC1, AC2);
+           A2 : A(1 .. 2) := (AC3, AC4);
+           A3 : A(1 .. 4) := (AC1, AC2, AC3, AC4);
+           A4 : A(1 .. 4);
+           A5 : A(1 .. 4) := (AC4, AC3, AC2, AC1);
+ 
+      BEGIN
+ 
+           A4 := A1 & A2;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF ACCESS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := A1 & A2(1) & AC4;
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ARRAY OF ACCESS, " &
+                        "AND ACCESS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := AC1 & (A1(2) & A2);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ACCESS, AND ARRAY " &
+                        "OF ACCESS");
+           END IF;
+ 
+           A4 := A5;
+ 
+           A4 := AC1 & A1(2) & (A2(1) & AC4);
+ 
+           IF A3 /= A4 THEN
+                FAILED ("INCORRECT CATENATION FOR ACCESS");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45347D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C45411A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+ --     PREDEFINED INTEGER OPERANDS.
+ 
+ -- HISTORY:
+ --     JET 01/25/88  CREATED ORIGINAL TEST.
+ --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45411A IS
+ 
+      TYPE DT IS NEW INTEGER RANGE -3..3;
+      I1 : INTEGER := 1;
+      D1 : DT := 1;
+ 
+ BEGIN
+      TEST ("C45411A", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                       "CORRECT RESULTS FOR PREDEFINED INTEGER " &
+                       "OPERANDS");
+ 
+      FOR I IN (1-2)..INTEGER(1) LOOP
+           IF "-"(RIGHT => I1) /= IDENT_INT(I) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        INTEGER'IMAGE(I+2));
+           END IF;
+ 
+           IF +I1 /= IDENT_INT(I1) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        INTEGER'IMAGE(I+2));
+           END IF;
+           I1 := I1 - 1;
+      END LOOP;
+ 
+      FOR I IN (1-2)..INTEGER(1) LOOP
+           IF -I /= IDENT_INT(0)-I THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        INTEGER'IMAGE(I+5));
+           END IF;
+ 
+           IF "+"(RIGHT => IDENT_INT(I)) /= I THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        INTEGER'IMAGE(I+5));
+           END IF;
+      END LOOP;
+ 
+      IF -1 /= IDENT_INT(1)-2 THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 7");
+      END IF;
+ 
+      IF "-"(RIGHT => 0) /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 8");
+      END IF;
+ 
+      IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 9");
+      END IF;
+ 
+      IF "+"(RIGHT => 1) /= IDENT_INT(2)-1 THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 7");
+      END IF;
+ 
+      IF +0 /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 8");
+      END IF;
+ 
+      IF +(-1) /= IDENT_INT(1)-2 THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 9");
+      END IF;
+ 
+      FOR I IN (1-2)..INTEGER(1) LOOP
+           IF "-"(RIGHT => D1) /= DT(IDENT_INT(I)) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        INTEGER'IMAGE(I+11));
+           END IF;
+ 
+           IF +D1 /= DT(IDENT_INT(INTEGER(D1))) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        INTEGER'IMAGE(I+11));
+           END IF;
+           D1 := D1 - 1;
+      END LOOP;
+ 
+      IF INTEGER'LAST + INTEGER'FIRST = 0 THEN
+           IF IDENT_INT(-INTEGER'LAST) /= INTEGER'FIRST THEN
+                FAILED ("-INTEGER'LAST IS NOT EQUAL TO INTEGER'FIRST");
+           END IF;
+      ELSE
+           IF IDENT_INT(-INTEGER'LAST) /= INTEGER'FIRST+1 THEN
+                FAILED ("-INTEGER'LAST IS NOT EQUAL TO INTEGER'FIRST+1");
+           END IF;
+      END IF;
+ 
+      RESULT;
+ 
+ END C45411A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,123 ----
+ -- C45411B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+ --     PREDEFINED SHORT_INTEGER OPERANDS.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+ --     THE PREDEFINED SHORT_INTEGER TYPE.
+ 
+ --     IF THE TYPE SHORT_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION
+ --     OF TYPE "DT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     JET 07/11/88  CREATED ORIGINAL TEST.
+ --     KAS 01/12/95  DELETED INCOMPATIBLE SUBTEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45411B IS
+ 
+      TYPE DT IS NEW SHORT_INTEGER RANGE -3..3;          -- N/A => ERROR.
+      I1 : SHORT_INTEGER := 1;
+      D1 : DT := 1;
+ 
+      FUNCTION IDENT (A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           RETURN A * SHORT_INTEGER(IDENT_INT(1));
+      END;
+ 
+ BEGIN
+      TEST ("C45411B", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                       "CORRECT RESULTS FOR PREDEFINED SHORT_INTEGER " &
+                       "OPERANDS");
+ 
+      FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
+           IF "-"(RIGHT => I1) /= IDENT(I) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        SHORT_INTEGER'IMAGE(I+2));
+           END IF;
+ 
+           IF +I1 /= IDENT(I1) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        SHORT_INTEGER'IMAGE(I+2));
+           END IF;
+           I1 := I1 - 1;
+      END LOOP;
+ 
+      FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
+           IF -I /= IDENT(0)-I THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        SHORT_INTEGER'IMAGE(I+5));
+           END IF;
+ 
+           IF "+"(RIGHT => IDENT(I)) /= I THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        SHORT_INTEGER'IMAGE(I+5));
+           END IF;
+      END LOOP;
+ 
+      IF -1 /= IDENT(1)-2 THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 7");
+      END IF;
+ 
+      IF "-"(RIGHT => 0) /= IDENT(0) THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 8");
+      END IF;
+ 
+      IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT(1) THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 9");
+      END IF;
+ 
+      IF "+"(RIGHT => 1) /= IDENT(2)-1 THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 7");
+      END IF;
+ 
+      IF +0 /= IDENT(0) THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 8");
+      END IF;
+ 
+      IF +(-1) /= IDENT(1)-2 THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 9");
+      END IF;
+ 
+      FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
+           IF "-"(RIGHT => D1) /= DT(IDENT(I)) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        SHORT_INTEGER'IMAGE(I+11));
+           END IF;
+ 
+           IF +D1 /= DT(IDENT(SHORT_INTEGER(D1))) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        SHORT_INTEGER'IMAGE(I+11));
+           END IF;
+           D1 := D1 - 1;
+      END LOOP;
+ 
+ 
+      RESULT;
+ 
+ END C45411B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,123 ----
+ -- C45411C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+ --     PREDEFINED LONG_INTEGER OPERANDS.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+ --     THE PREDEFINED LONG_INTEGER TYPE.
+ 
+ --     IF THE TYPE LONG_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION
+ --     OF TYPE "DT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     JET 07/11/88  CREATED ORIGINAL TEST.
+ --     KAS 01/12/95  REMOVED INCOMPATIBLE SUBTEST
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45411C IS
+ 
+      TYPE DT IS NEW LONG_INTEGER RANGE -3..3;          -- N/A => ERROR.
+      I1 : LONG_INTEGER := 1;
+      D1 : DT := 1;
+ 
+      FUNCTION IDENT (A : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           RETURN A * LONG_INTEGER(IDENT_INT(1));
+      END;
+ 
+ BEGIN
+      TEST ("C45411C", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                       "CORRECT RESULTS FOR PREDEFINED LONG_INTEGER " &
+                       "OPERANDS");
+ 
+      FOR I IN (1-2)..LONG_INTEGER(1) LOOP
+           IF "-"(RIGHT => I1) /= IDENT(I) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        LONG_INTEGER'IMAGE(I+2));
+           END IF;
+ 
+           IF +I1 /= IDENT(I1) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        LONG_INTEGER'IMAGE(I+2));
+           END IF;
+           I1 := I1 - 1;
+      END LOOP;
+ 
+      FOR I IN (1-2)..LONG_INTEGER(1) LOOP
+           IF -I /= IDENT(0)-I THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        LONG_INTEGER'IMAGE(I+5));
+           END IF;
+ 
+           IF "+"(RIGHT => IDENT(I)) /= I THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        LONG_INTEGER'IMAGE(I+5));
+           END IF;
+      END LOOP;
+ 
+      IF -1 /= IDENT(1)-2 THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 7");
+      END IF;
+ 
+      IF "-"(RIGHT => 0) /= IDENT(0) THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 8");
+      END IF;
+ 
+      IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT(1) THEN
+           FAILED ("INCORRECT RESULT FOR ""-"" - 9");
+      END IF;
+ 
+      IF "+"(RIGHT => 1) /= IDENT(2)-1 THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 7");
+      END IF;
+ 
+      IF +0 /= IDENT(0) THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 8");
+      END IF;
+ 
+      IF +(-1) /= IDENT(1)-2 THEN
+           FAILED ("INCORRECT RESULT FOR ""+"" - 9");
+      END IF;
+ 
+      FOR I IN (1-2)..LONG_INTEGER(1) LOOP
+           IF "-"(RIGHT => D1) /= DT(IDENT(I)) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                        LONG_INTEGER'IMAGE(I+11));
+           END IF;
+ 
+           IF +D1 /= DT(IDENT(LONG_INTEGER(D1))) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                        LONG_INTEGER'IMAGE(I+11));
+           END IF;
+           D1 := D1 - 1;
+      END LOOP;
+ 
+ 
+      RESULT;
+ 
+ END C45411C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45411d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45411d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C45411D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+ --     OPERANDS OF DERIVED INTEGER TYPES.
+ 
+ -- HISTORY:
+ --     JET 07/11/88  CREATED ORIGINAL TEST.
+ --     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45411D IS
+ 
+      TYPE INT IS RANGE -100..100;
+ 
+      TYPE DT1 IS NEW INTEGER;
+      TYPE DT2 IS NEW INT;
+ 
+      D1 : DT1 := 1;
+      D2 : DT2 := 1;
+ 
+      FUNCTION IDENT (A : DT1) RETURN DT1 IS
+      BEGIN
+           RETURN A * DT1(IDENT_INT(1));
+      END IDENT;
+ 
+      FUNCTION IDENT (A : DT2) RETURN DT2 IS
+      BEGIN
+           RETURN A * DT2(IDENT_INT(1));
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C45411D", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                       "CORRECT RESULTS FOR OPERANDS OF DERIVED " &
+                       "INTEGER TYPES");
+ 
+      FOR I IN DT1'(1-2)..DT1'(1) LOOP
+           IF "-"(RIGHT => D1) /= IDENT(I) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" DT1 -" &
+                        DT1'IMAGE(I+2));
+           END IF;
+ 
+           IF +D1 /= IDENT(D1) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" DT1 -" &
+                        DT1'IMAGE(I+2));
+           END IF;
+           D1 := D1 - 1;
+      END LOOP;
+ 
+      IF DT1'LAST + DT1'FIRST = 0 THEN
+           IF IDENT(-DT1'LAST) /= DT1'FIRST THEN
+                FAILED ("-DT1'LAST IS NOT EQUAL TO DT1'FIRST");
+           END IF;
+      ELSE
+           IF IDENT(-DT1'LAST) /= DT1'FIRST+1 THEN
+                FAILED ("-DT1'LAST IS NOT EQUAL TO DT1'FIRST+1");
+           END IF;
+      END IF;
+ 
+      FOR I IN DT2'(1-2)..DT2'(1) LOOP
+           IF -D2 /= IDENT(I) THEN
+                FAILED ("INCORRECT RESULT FOR ""-"" DT2 -" &
+                        DT2'IMAGE(I+2));
+           END IF;
+ 
+           IF "+"(RIGHT => D2) /= IDENT(D2) THEN
+                FAILED ("INCORRECT RESULT FOR ""+"" DT2 -" &
+                        DT2'IMAGE(I+2));
+           END IF;
+           D2 := D2 - 1;
+      END LOOP;
+ 
+      RESULT;
+ 
+ END C45411D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45413a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45413a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45413a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45413a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C45413A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNARY MINUS YIELDS AND ACCEPTS RESULTS BELONGING TO
+ -- THE BASE TYPE.
+ 
+ -- JBG 2/24/84
+ -- JRL 10/13/96 Removed static expressions which contained values outside
+ --              the base range.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45413A IS
+ 
+      TYPE INT IS RANGE 1..10;
+ 
+      X : INT := INT(IDENT_INT(9));
+ 
+ BEGIN
+ 
+      TEST ("C45413A", "CHECK SUBTYPE OF UNARY PLUS/MINUS");
+ 
+      BEGIN
+ 
+           IF -X /= INT'VAL(-9) THEN
+                FAILED ("INCORRECT RESULT - UNARY MINUS");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("UNARY MINUS DOES NOT YIELD RESULT " &
+                        "BELONGING TO THE BASE TYPE");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 1");
+      END;
+ 
+      BEGIN
+ 
+           IF -(INT'VAL(-9)) /= 9 THEN
+                FAILED ("WRONG RESULT - UNARY MINUS");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("UNARY MINUS ARGUMENT NOT IN BASE TYPE");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 2");
+      END;
+ 
+      RESULT;
+ 
+ END C45413A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45431a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45431a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45431a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45431a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,212 ----
+ -- C45431A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR FIXED POINT TYPES +A = A AND THAT, FOR MODEL NUMBERS,
+ -- -(-A) = A.
+ 
+ -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+ 
+ -- WRG 8/28/86
+ -- PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45431A IS
+ 
+ BEGIN
+ 
+      TEST ("C45431A", "CHECK THAT FOR FIXED POINT TYPES +A = A AND " &
+                       "THAT, FOR MODEL NUMBERS, -(-A) = A " &
+                       "-- BASIC TYPES");
+ 
+      -------------------------------------------------------------------
+ 
+ A:   DECLARE
+           TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+ 
+           NON_MODEL_CONST : CONSTANT      := 2.0 / 3;
+           NON_MODEL_VAR   : LIKE_DURATION := 0.0;
+ 
+           SMALL, MAX, MIN, ZERO : LIKE_DURATION := 0.5;
+           X                     : LIKE_DURATION := 0.0;
+      BEGIN
+           -- INITIALIZE "CONSTANTS":
+           IF EQUAL (3, 3) THEN
+                NON_MODEL_VAR := NON_MODEL_CONST;
+                SMALL         := LIKE_DURATION'SMALL;
+                MAX           := LIKE_DURATION'LAST;
+                MIN           := LIKE_DURATION'FIRST;
+                ZERO          := 0.0;
+           END IF;
+ 
+           -- CHECK + OR - ZERO = ZERO:
+           IF "+"(RIGHT => ZERO) /= 0.0 OR
+              +LIKE_DURATION'(0.0) /= ZERO THEN
+                FAILED ("+0.0 /= 0.0");
+           END IF;
+           IF "-"(RIGHT => ZERO) /= 0.0 OR
+              -LIKE_DURATION'(0.0) /= ZERO THEN
+                FAILED ("-0.0 /= 0.0");
+           END IF;
+           IF -(-ZERO) /= 0.0 THEN
+                FAILED ("-(-0.0) /= 0.0");
+           END IF;
+ 
+           -- CHECK + AND - MAX:
+           IF EQUAL (3, 3) THEN
+                X := MAX;
+           END IF;
+           IF +X /= MAX OR +LIKE_DURATION'LAST /= MAX THEN
+                FAILED ("+LIKE_DURATION'LAST /= LIKE_DURATION'LAST");
+           END IF;
+           IF -(-X) /= MAX OR -(-LIKE_DURATION'LAST) /= MAX THEN
+                FAILED ("-(-LIKE_DURATION'LAST) /= LIKE_DURATION'LAST");
+           END IF;
+ 
+           -- CHECK + AND - MIN:
+           IF EQUAL (3, 3) THEN
+                X := MIN;
+           END IF;
+           IF +X /= MIN OR +LIKE_DURATION'FIRST /= MIN THEN
+                FAILED ("+LIKE_DURATION'FIRST /= LIKE_DURATION'FIRST");
+           END IF;
+           IF -(-X) /= MIN OR -(-LIKE_DURATION'FIRST) /= MIN THEN
+                FAILED("-(-LIKE_DURATION'FIRST) /= LIKE_DURATION'FIRST");
+           END IF;
+ 
+           -- CHECK + AND - SMALL:
+           IF EQUAL (3, 3) THEN
+                X := SMALL;
+           END IF;
+           IF +X /= SMALL OR +LIKE_DURATION'SMALL /= SMALL THEN
+                FAILED ("+LIKE_DURATION'SMALL /= LIKE_DURATION'SMALL");
+           END IF;
+           IF -(-X) /= SMALL OR -(-LIKE_DURATION'SMALL) /= SMALL THEN
+                FAILED("-(-LIKE_DURATION'SMALL) /= LIKE_DURATION'SMALL");
+           END IF;
+ 
+           -- CHECK ARBITRARY MID-RANGE NUMBERS:
+           IF EQUAL (3, 3) THEN
+                X := 1000.984_375;
+           END IF;
+           IF +X /= 1000.984_375 OR +1000.984_375 /= X THEN
+                FAILED ("+1000.984_375 /= 1000.984_375");
+           END IF;
+           IF -(-X) /= 1000.984_375 OR -(-1000.984_375) /= X THEN
+                FAILED ("-(-1000.984_375) /= 1000.984_375");
+           END IF;
+ 
+           -- CHECK "+" AND "-" FOR NON-MODEL NUMBER:
+           IF +LIKE_DURATION'(NON_MODEL_CONST) NOT IN 0.656_25 ..
+                                                      0.671_875 OR
+              +NON_MODEL_VAR NOT IN 0.656_25 .. 0.671_875 THEN
+                FAILED ("+LIKE_DURATION'(2.0 / 3) NOT IN 0.656_25 .. " &
+                        "0.671_875");
+           END IF;
+           IF -LIKE_DURATION'(NON_MODEL_CONST) NOT IN -0.671_875 ..
+                                                      -0.656_25 OR
+              -NON_MODEL_VAR NOT IN -0.671_875 .. -0.656_25 THEN
+                FAILED ("-LIKE_DURATION'(2.0 / 3) NOT IN -0.671_875 " &
+                        ".. -0.656_25");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED -- A");
+      END A;
+ 
+      -------------------------------------------------------------------
+ 
+ B:   DECLARE
+           TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
+ 
+           NON_MODEL_CONST : CONSTANT   := 2.0 / 3;
+           NON_MODEL_VAR   : DECIMAL_M4 := 0.0;
+ 
+           SMALL, MAX, MIN, ZERO : DECIMAL_M4 := -128.0;
+           X                     : DECIMAL_M4 :=    0.0;
+      BEGIN
+           -- INITIALIZE "CONSTANTS":
+           IF EQUAL (3, 3) THEN
+                NON_MODEL_VAR :=  NON_MODEL_CONST;
+                SMALL         :=  DECIMAL_M4'SMALL;
+                ZERO          :=  0.0;
+           END IF;
+ 
+           -- CHECK + OR - ZERO = ZERO:
+           IF +ZERO /= 0.0 OR +DECIMAL_M4'(0.0) /= ZERO THEN
+                FAILED ("+0.0 /= 0.0");
+           END IF;
+           IF -ZERO /= 0.0 OR -DECIMAL_M4'(0.0) /= ZERO THEN
+                FAILED ("-0.0 /= 0.0");
+           END IF;
+           IF -(-ZERO) /= 0.0 THEN
+                FAILED ("-(-0.0) /= 0.0");
+           END IF;
+ 
+           -- CHECK + AND - MAX:
+           IF EQUAL (3, 3) THEN
+                X := MAX;
+           END IF;
+           -- CHECK + AND - SMALL:
+           IF EQUAL (3, 3) THEN
+                X := SMALL;
+           END IF;
+           IF +X /= SMALL OR +DECIMAL_M4'SMALL /= SMALL THEN
+                FAILED ("+DECIMAL_M4'SMALL /= DECIMAL_M4'SMALL");
+           END IF;
+           IF -(-X) /= SMALL OR -(-DECIMAL_M4'SMALL) /= SMALL THEN
+                FAILED ("-(-DECIMAL_M4'SMALL) /= DECIMAL_M4'SMALL");
+           END IF;
+ 
+           -- CHECK ARBITRARY MID-RANGE NUMBERS:
+           IF EQUAL (3, 3) THEN
+                X := 256.0;
+           END IF;
+           IF +X /= 256.0 OR +256.0 /= X THEN
+                FAILED ("+256.0 /= 256.0");
+           END IF;
+           IF -(-X) /= 256.0 OR -(-256.0) /= X THEN
+                FAILED ("-(-256.0) /= 256.0");
+           END IF;
+ 
+           -- CHECK "+" AND "-" FOR NON-MODEL NUMBER:
+           IF +DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 OR
+              +NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN
+                FAILED ("+DECIMAL_M4'(2.0 / 3) NOT IN 0.0 .. 64.0");
+           END IF;
+           IF -DECIMAL_M4'(NON_MODEL_CONST) NOT IN -64.0 .. 0.0 OR
+              -NON_MODEL_VAR NOT IN -64.0 .. 0.0 THEN
+                FAILED ("-DECIMAL_M4'(2.0 / 3) NOT IN -64.0 .. 0.0");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED -- B");
+      END B;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ END C45431A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c455001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c455001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c455001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c455001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C455001.A
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that universal fixed multiplying operators can be used without
+ --     a conversion in contexts where the result type is determined.
+ --
+ --     Note: This is intended to check the changes made to these operators
+ --     in Ada 95; legacy tests should cover cases from Ada 83.
+ --
+ -- CHANGE HISTORY:
+ --      18 MAR 99   RLB    Initial version
+ --
+ --!
+ 
+ with Report; use Report;
+ 
+ procedure C455001 is
+ 
+      type F1 is delta 2.0**(-1) range 0.0 .. 8.0;
+ 
+      type F2 is delta 2.0**(-2) range 0.0 .. 4.0;
+ 
+      type F3 is delta 2.0**(-3) range 0.0 .. 2.0;
+ 
+      A : F1;
+      B : F2;
+      C : F3;
+ 
+      type Fixed_Record is record
+ 	D : F1;
+         E : F2;
+      end record;
+ 
+      R : Fixed_Record;
+ 
+      function Ident_Fix (X : F3) return F3 is
+      begin
+           if Equal(3,3) then
+                return X;
+           else
+                return 0.0;
+           end if;
+      end Ident_Fix;
+ 
+ begin
+      Test ("C455001", "Check that universal fixed multiplying operators " &
+                       "can be used without a conversion in contexts where " &
+                       "the result type is determined.");
+ 
+      A := 1.0; B := 1.0;
+      C := A * B; -- Assignment context.
+ 
+      if C /= Ident_Fix(1.0) then
+           Failed ("Incorrect results for multiplication (1) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      C := A / B;
+ 
+      if C /= Ident_Fix(1.0) then
+           Failed ("Incorrect results for division (1) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      A := 2.5;
+      C := A * 0.25;
+ 
+      if C /= Ident_Fix(0.625) then
+           Failed ("Incorrect results for multiplication (2) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      C := A / 4.0;
+ 
+      if C /= Ident_Fix(0.625) then
+           Failed ("Incorrect results for division (2) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      C := Ident_Fix(0.75);
+      C := C * 0.5;
+ 
+      if C /= Ident_Fix(0.375) then
+           Failed ("Incorrect results for multiplication (3) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      C := Ident_Fix(0.75);
+      C := C / 0.5;
+ 
+      if C /= Ident_Fix(1.5) then
+           Failed ("Incorrect results for division (3) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      A := 0.5; B := 0.3; -- Function parameter context.
+      if Ident_Fix(A * B) not in Ident_Fix(0.125) .. Ident_Fix(0.25) then
+           Failed ("Incorrect results for multiplication (4) - result is " &
+ 		  F3'Image(A * B)); -- Exact = 0.15
+      end if;
+ 
+      B := 0.8;
+      if Ident_Fix(A / B) not in Ident_Fix(0.5) .. Ident_Fix(0.75) then
+           Failed ("Incorrect results for division (4) - result is " &
+ 		  F3'Image(A / B));
+ 		-- Exact = 0.625..., but B is only restricted to the range
+ 		-- 0.75 .. 1.0, so the result can be anywhere in the range
+ 		-- 0.5 .. 0.75.
+      end if;
+ 
+      C := 0.875; B := 1.5;
+      R := (D => C * 4.0, E => B / 0.5); -- Aggregate context.
+ 
+      if R.D /= 3.5 then
+           Failed ("Incorrect results for multiplication (5) - result is " &
+ 		  F1'Image(R.D));
+      end if;
+ 
+      if R.E /= 3.0 then
+           Failed ("Incorrect results for division (5) - result is " &
+ 		  F2'Image(R.E));
+      end if;
+ 
+      A := 0.5;
+      C := A * F1'(B * 2.0); -- Qualified expression context.
+ 
+      if C /= Ident_Fix(1.5) then
+           Failed ("Incorrect results for multiplication (6) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      A := 4.0;
+      C := F1'(B / 0.5) / A;
+ 
+      if C /= Ident_Fix(0.75) then
+           Failed ("Incorrect results for division (6) - result is " &
+ 		  F3'Image(C));
+      end if;
+ 
+      Result;
+ 
+ end C455001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45502b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45502b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45502b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45502b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,291 ----
+ -- C45502B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT MULTIPLICATION AND DIVISION YIELD CORRECT RESULTS WHEN
+ --     THE OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 09/01/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45502B IS
+ 
+      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+ 
+      FUNCTION IDENT (S : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (S)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C45502B", "CHECK THAT MULTIPLICATION AND DIVISION " &
+                        "YIELD CORRECT RESULTS WHEN THE OPERANDS " &
+                        "ARE OF PREDEFINED TYPE SHORT_INTEGER" );
+ 
+      DECLARE
+           I0  : SHORT_INTEGER := 0;
+           I1  : SHORT_INTEGER := 1;
+           I2  : SHORT_INTEGER := 2;
+           I3  : SHORT_INTEGER := 3;
+           I5  : SHORT_INTEGER := 5;
+           I10 : SHORT_INTEGER := 10;
+           I11 : SHORT_INTEGER := 11;
+           I12 : SHORT_INTEGER := 12;
+           I13 : SHORT_INTEGER := 13;
+           I14 : SHORT_INTEGER := 14;
+           N1  : SHORT_INTEGER := -1;
+           N2  : SHORT_INTEGER := -2;
+           N5  : SHORT_INTEGER := -5;
+           N10 : SHORT_INTEGER := -10;
+           N11 : SHORT_INTEGER := -11;
+           N12 : SHORT_INTEGER := -12;
+           N13 : SHORT_INTEGER := -13;
+           N14 : SHORT_INTEGER := -14;
+           N50 : SHORT_INTEGER := -50;
+ 
+      BEGIN
+           IF I0 * SHORT_INTEGER'FIRST /= 0 THEN
+                FAILED ( "INCORRECT RESULT FOR I0 * " &
+                         "SHORT_INTEGER'FIRST" );
+           END IF;
+ 
+           IF I0 * SHORT_INTEGER'LAST /= 0 THEN
+                FAILED ( "INCORRECT RESULT FOR I0 * " &
+                         "SHORT_INTEGER'LAST" );
+           END IF;
+ 
+           IF N1 * SHORT_INTEGER'LAST + SHORT_INTEGER'LAST /= 0 THEN
+                FAILED ( "INCORRECT RESULT FOR N1 * " &
+                         "SHORT_INTEGER'LAST" );
+           END IF;
+ 
+           IF I3 * I1 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR I3 * I1" );
+           END IF;
+ 
+           IF IDENT (I3) * IDENT (I1) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I3) * " &
+                         "IDENT (I1)" );
+           END IF;
+ 
+           IF I2 * N1 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I2 * N1" );
+           END IF;
+ 
+           IF "*" (LEFT => I2, RIGHT => N1) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I2, " &
+                         "RIGHT => N1)" );
+           END IF;
+ 
+           IF IDENT (I2) * IDENT (N1) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I2) * " &
+                         "IDENT (N1)" );
+           END IF;
+ 
+           IF I5 * I2 * N5 /= N50 THEN
+                FAILED ( "INCORRECT RESULT FOR I5 * I2 * N5" );
+           END IF;
+ 
+           IF IDENT (N1) * IDENT (N5) /= I5 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "*" (LEFT => IDENT (N1), RIGHT => IDENT (N5)) /=
+                  I5 THEN
+                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => " &
+                         "IDENT (N1), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF IDENT (N1) * IDENT (I2) * IDENT (N5) /= I10
+              THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                         "IDENT (I2) * IDENT (N5)" );
+           END IF;
+ 
+           IF (-IDENT (I0)) * IDENT (I10) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) * " &
+                         "IDENT (I10)" );
+           END IF;
+ 
+           IF I0 * I10 /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR I0 * I10" );
+           END IF;
+ 
+           IF "*" (LEFT => I0, RIGHT => I10) /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I0, " &
+                         "RIGHT => I10)" );
+           END IF;
+ 
+           IF IDENT (I10) / IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I10) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF I11 / I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 / I5" );
+           END IF;
+ 
+           IF IDENT (I12) / IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I12) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF "/" (LEFT => IDENT (I12), RIGHT => IDENT (I5)) /=
+                  I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                         "IDENT (I12), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF I13 / I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 / I5" );
+           END IF;
+ 
+           IF IDENT (I14) / IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I14) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF I10 / N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 / N5" );
+           END IF;
+ 
+           IF "/" (LEFT => I10, RIGHT => N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I10, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT (I11) / IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I11) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF I12 / N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 / N5" );
+           END IF;
+ 
+           IF IDENT (I13) / IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I13) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF I14 / N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 / N5" );
+           END IF;
+ 
+           IF IDENT (N10) / IDENT (I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N10) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF "/" (LEFT => IDENT (N10), RIGHT => IDENT (I5)) /=
+                  N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                         "IDENT (N10), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF N11 / I5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 / I5" );
+           END IF;
+ 
+           IF IDENT (N12) / IDENT (I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N12) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF N13 / I5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 / I5" );
+           END IF;
+ 
+           IF "/" (LEFT => N13, RIGHT => I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N13, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (N14) / IDENT (I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N14) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF N10 / N5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 / N5" );
+           END IF;
+ 
+           IF IDENT (N11) / IDENT (N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N11) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF "/" (LEFT => IDENT (N11), RIGHT => IDENT (N5)) /=
+                  I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                         "IDENT (N11), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF N12 / N5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 / N5" );
+           END IF;
+ 
+ 
+           IF IDENT (N13) / IDENT (N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N13) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF N14 / N5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 / N5" );
+           END IF;
+ 
+           IF "/" (LEFT => N14, RIGHT => N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N14, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF I0 / I5 /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR I0 / I5" );
+           END IF;
+ 
+           IF "/" (LEFT => I0, RIGHT => I5) /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I0, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF (-IDENT (I0)) / IDENT (I5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) / " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C45502B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45502c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45502c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45502c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45502c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,295 ----
+ -- C45502C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT MULTIPLICATION AND DIVISION YIELD CORRECT RESULTS WHEN
+ --     THE OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     LONG_INTEGER.
+ 
+ --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_LONG" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 09/01/86
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45502C IS
+ 
+      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+ 
+      FUNCTION IDENT (S : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN S;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C45502C", "CHECK THAT MULTIPLICATION AND DIVISION " &
+                        "YIELD CORRECT RESULTS WHEN THE OPERANDS " &
+                        "ARE OF PREDEFINED TYPE LONG_INTEGER" );
+ 
+      DECLARE
+           I0  : LONG_INTEGER := 0;
+           I1  : LONG_INTEGER := 1;
+           I2  : LONG_INTEGER := 2;
+           I3  : LONG_INTEGER := 3;
+           I5  : LONG_INTEGER := 5;
+           I10 : LONG_INTEGER := 10;
+           I11 : LONG_INTEGER := 11;
+           I12 : LONG_INTEGER := 12;
+           I13 : LONG_INTEGER := 13;
+           I14 : LONG_INTEGER := 14;
+           N1  : LONG_INTEGER := -1;
+           N2  : LONG_INTEGER := -2;
+           N5  : LONG_INTEGER := -5;
+           N10 : LONG_INTEGER := -10;
+           N11 : LONG_INTEGER := -11;
+           N12 : LONG_INTEGER := -12;
+           N13 : LONG_INTEGER := -13;
+           N14 : LONG_INTEGER := -14;
+           N50 : LONG_INTEGER := -50;
+ 
+      BEGIN
+           IF I0 * LONG_INTEGER'FIRST /= 0 THEN
+                FAILED ( "INCORRECT RESULT FOR I0 * " &
+                         "LONG_INTEGER'FIRST" );
+           END IF;
+ 
+           IF I0 * LONG_INTEGER'LAST /= 0 THEN
+                FAILED ( "INCORRECT RESULT FOR I0 * " &
+                         "LONG_INTEGER'LAST" );
+           END IF;
+ 
+           IF N1 * LONG_INTEGER'LAST + LONG_INTEGER'LAST /= 0 THEN
+                FAILED ( "INCORRECT RESULT FOR N1 * " &
+                         "LONG_INTEGER'LAST" );
+           END IF;
+ 
+           IF I3 * I1 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR I3 * I1" );
+           END IF;
+ 
+           IF IDENT (I3) * IDENT (I1) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I3) * " &
+                         "IDENT (I1)" );
+           END IF;
+ 
+           IF I2 * N1 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I2 * N1" );
+           END IF;
+ 
+           IF "*" (LEFT => I2, RIGHT => N1) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I2, " &
+                         "RIGHT => N1)" );
+           END IF;
+ 
+           IF IDENT (I2) * IDENT (N1) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I2) * " &
+                         "IDENT (N1)" );
+           END IF;
+ 
+           IF I5 * I2 * N5 /= N50 THEN
+                FAILED ( "INCORRECT RESULT FOR I5 * I2 * N5" );
+           END IF;
+ 
+           IF IDENT (N1) * IDENT (N5) /= I5 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "*" (LEFT => IDENT (N1), RIGHT => IDENT (N5)) /=
+                  I5 THEN
+                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => " &
+                         "IDENT (N1), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF IDENT (N1) * IDENT (I2) * IDENT (N5) /= I10
+              THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                         "IDENT (I2) * IDENT (N5)" );
+           END IF;
+ 
+           IF (-IDENT (I0)) * IDENT (I10) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) * " &
+                         "IDENT (I10)" );
+           END IF;
+ 
+           IF I0 * I10 /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR I0 * I10" );
+           END IF;
+ 
+           IF "*" (LEFT => I0, RIGHT => I10) /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I0, " &
+                         "RIGHT => I10)" );
+           END IF;
+ 
+           IF IDENT (I10) / IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I10) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF I11 / I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 / I5" );
+           END IF;
+ 
+           IF IDENT (I12) / IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I12) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF "/" (LEFT => IDENT (I12), RIGHT => IDENT (I5)) /=
+                  I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                         "IDENT (I12), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF I13 / I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 / I5" );
+           END IF;
+ 
+           IF IDENT (I14) / IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I14) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF I10 / N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 / N5" );
+           END IF;
+ 
+           IF "/" (LEFT => I10, RIGHT => N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I10, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT (I11) / IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I11) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF I12 / N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 / N5" );
+           END IF;
+ 
+           IF IDENT (I13) / IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I13) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF I14 / N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 / N5" );
+           END IF;
+ 
+           IF IDENT (N10) / IDENT (I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N10) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF "/" (LEFT => IDENT (N10), RIGHT => IDENT (I5)) /=
+                  N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                         "IDENT (N10), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF N11 / I5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 / I5" );
+           END IF;
+ 
+           IF IDENT (N12) / IDENT (I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N12) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF N13 / I5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 / I5" );
+           END IF;
+ 
+           IF "/" (LEFT => N13, RIGHT => I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N13, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (N14) / IDENT (I5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N14) " &
+                         "/ IDENT (I5)" );
+           END IF;
+ 
+           IF N10 / N5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 / N5" );
+           END IF;
+ 
+           IF IDENT (N11) / IDENT (N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N11) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF "/" (LEFT => IDENT (N11), RIGHT => IDENT (N5)) /=
+                  I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                         "IDENT (N11), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF N12 / N5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 / N5" );
+           END IF;
+ 
+ 
+           IF IDENT (N13) / IDENT (N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N13) " &
+                         "/ IDENT (N5)" );
+           END IF;
+ 
+           IF N14 / N5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 / N5" );
+           END IF;
+ 
+           IF "/" (LEFT => N14, RIGHT => N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N14, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF I0 / I5 /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR I0 / I5" );
+           END IF;
+ 
+           IF "/" (LEFT => I0, RIGHT => I5) /= (-I0) THEN
+                FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I0, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF (-IDENT (I0)) / IDENT (I5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) / " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C45502C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45503a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45503a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45503a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45503a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,310 ----
+ -- C45503A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE OPERANDS 
+ -- ARE OF PREDEFINED TYPE INTEGER.
+ 
+ -- R.WILLIAMS 9/1/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45503A IS
+ 
+ BEGIN
+      TEST ( "C45503A", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
+                        "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
+                        "TYPE INTEGER" );
+ 
+      DECLARE
+           I0  : INTEGER := 0;
+           I1  : INTEGER := 1;
+           I2  : INTEGER := 2;
+           I3  : INTEGER := 3;
+           I4  : INTEGER := 4;
+           I5  : INTEGER := 5;    
+           I10 : INTEGER := 10;
+           I11 : INTEGER := 11;
+           I12 : INTEGER := 12;
+           I13 : INTEGER := 13;
+           I14 : INTEGER := 14;
+           N1  : INTEGER := -1;
+           N2  : INTEGER := -2;
+           N3  : INTEGER := -3;
+           N4  : INTEGER := -4;
+           N5  : INTEGER := -5;
+           N10 : INTEGER := -10;
+           N11 : INTEGER := -11;
+           N12 : INTEGER := -12;
+           N13 : INTEGER := -13;
+           N14 : INTEGER := -14;
+ 
+      BEGIN
+           IF I10 REM I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
+           END IF;
+ 
+           IF IDENT_INT (I11) REM IDENT_INT (I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I11) REM " &
+                         "IDENT_INT (I5)" );
+           END IF;
+  
+           IF I12 REM I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
+           END IF;
+ 
+           IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT_INT (I13) REM IDENT_INT (I5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I13) REM " &
+                         "IDENT_INT (I5)" );
+           END IF;
+ 
+           IF I14 REM I5 /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
+           END IF;
+ 
+           IF IDENT_INT (I10) REM IDENT_INT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I10) REM " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT_INT (I10), RIGHT => IDENT_INT (N5)) 
+                    /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT_INT (I10), RIGHT => IDENT_INT (N5))" );
+           END IF;
+ 
+           IF I11 REM N5 /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
+           END IF;
+ 
+           IF IDENT_INT (I12) REM IDENT_INT (N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I12) REM " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF I13 REM N5 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
+           END IF;
+ 
+           IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT_INT (I14) REM IDENT_INT (N5) /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I14) REM " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF N10 REM I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
+           END IF;
+ 
+           IF IDENT_INT (N11) REM IDENT_INT (I5) /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N11) REM " &
+                         "IDENT_INT (I5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT_INT (N11), RIGHT => IDENT_INT (I5)) 
+                    /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT_INT (N11), RIGHT => IDENT_INT (I5))" );
+           END IF;
+ 
+           IF N12 REM I5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
+           END IF;
+ 
+           IF IDENT_INT (N13) REM IDENT_INT (I5) /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N13) REM " &
+                         "IDENT_INT (I5)" );
+           END IF;
+ 
+           IF N14 REM I5 /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
+           END IF;
+ 
+           IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT_INT (N10) REM IDENT_INT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N10) REM " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF N11 REM N5 /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
+           END IF;
+ 
+           IF IDENT_INT (N12) REM IDENT_INT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N12) REM " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT_INT (N12), RIGHT => IDENT_INT (N5)) 
+                    /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT_INT (N12), RIGHT => IDENT_INT (N5))" );
+           END IF;
+ 
+           IF N13 REM N5 /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
+           END IF;
+ 
+           IF IDENT_INT (N14) REM IDENT_INT (N5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N14) REM " &
+                         "IDENT_INT (N5)" );
+           END IF;
+           
+           IF I10 MOD I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
+           END IF;
+ 
+           IF IDENT_INT (I11) MOD IDENT_INT (I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I11) MOD " &
+                         "IDENT_INT (I5)" );
+           END IF;
+  
+           IF I12 MOD I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT_INT (I13) MOD IDENT_INT (I5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I13) MOD " &
+                         "IDENT_INT (I5)" );
+           END IF;
+ 
+           IF I14 MOD I5 /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
+           END IF;
+ 
+           IF IDENT_INT (I10) MOD IDENT_INT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I10) MOD " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT_INT (I10), RIGHT => IDENT_INT (N5)) 
+                    /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT_INT (I10), RIGHT => IDENT_INT (N5))" );
+           END IF;
+ 
+           IF I11 MOD N5 /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
+           END IF;
+ 
+           IF IDENT_INT (I12) MOD IDENT_INT (N5) /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I12) MOD " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF I13 MOD N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT_INT (I14) MOD IDENT_INT (N5) /=  N1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (I14) MOD " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF N10 MOD I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
+           END IF;
+ 
+           IF IDENT_INT (N11) MOD IDENT_INT (I5) /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N11) MOD " &
+                         "IDENT_INT (I5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT_INT (N11), RIGHT => IDENT_INT (I5)) 
+                    /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT_INT (N11), RIGHT => IDENT_INT (I5))" );
+           END IF;
+ 
+           IF N12 MOD I5 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
+           END IF;
+ 
+           IF IDENT_INT (N13) MOD IDENT_INT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N13) MOD " &
+                         "IDENT_INT (I5)" );
+           END IF;
+ 
+           IF N14 MOD I5 /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT_INT (N10) MOD IDENT_INT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N10) MOD " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF N11 MOD N5 /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
+           END IF;
+ 
+           IF IDENT_INT (N12) MOD IDENT_INT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N12) MOD " &
+                         "IDENT_INT (N5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT_INT (N12), RIGHT => IDENT_INT (N5)) 
+                    /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT_INT (N12), RIGHT => IDENT_INT (N5))" );
+           END IF;
+ 
+           IF N13 MOD N5 /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
+           END IF;
+ 
+           IF IDENT_INT (N14) MOD IDENT_INT (N5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT_INT (N14) MOD " &
+                         "IDENT_INT (N5)" );
+           END IF;
+      END;
+           
+      RESULT;
+ END C45503A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45503b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45503b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45503b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45503b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,327 ----
+ -- C45503B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE
+ --     OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 09/01/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45503B IS
+ 
+      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+ 
+      FUNCTION IDENT (S : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (S)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C45503B", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
+                        "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
+                        "TYPE SHORT_INTEGER" );
+ 
+      DECLARE
+           I0  : SHORT_INTEGER := 0;
+           I1  : SHORT_INTEGER := 1;
+           I2  : SHORT_INTEGER := 2;
+           I3  : SHORT_INTEGER := 3;
+           I4  : SHORT_INTEGER := 4;
+           I5  : SHORT_INTEGER := 5;
+           I10 : SHORT_INTEGER := 10;
+           I11 : SHORT_INTEGER := 11;
+           I12 : SHORT_INTEGER := 12;
+           I13 : SHORT_INTEGER := 13;
+           I14 : SHORT_INTEGER := 14;
+           N1  : SHORT_INTEGER := -1;
+           N2  : SHORT_INTEGER := -2;
+           N3  : SHORT_INTEGER := -3;
+           N4  : SHORT_INTEGER := -4;
+           N5  : SHORT_INTEGER := -5;
+           N10 : SHORT_INTEGER := -10;
+           N11 : SHORT_INTEGER := -11;
+           N12 : SHORT_INTEGER := -12;
+           N13 : SHORT_INTEGER := -13;
+           N14 : SHORT_INTEGER := -14;
+ 
+      BEGIN
+           IF I10 REM I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
+           END IF;
+ 
+           IF IDENT (I11) REM IDENT (I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I11) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I12 REM I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
+           END IF;
+ 
+           IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (I13) REM IDENT (I5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I13) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I14 REM I5 /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
+           END IF;
+ 
+           IF IDENT (I10) REM IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I10) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                    /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT (I10), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF I11 REM N5 /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
+           END IF;
+ 
+           IF IDENT (I12) REM IDENT (N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I12) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF I13 REM N5 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
+           END IF;
+ 
+           IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT (I14) REM IDENT (N5) /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I14) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N10 REM I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
+           END IF;
+ 
+           IF IDENT (N11) REM IDENT (I5) /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N11) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                    /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT (N11), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF N12 REM I5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
+           END IF;
+ 
+           IF IDENT (N13) REM IDENT (I5) /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N13) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF N14 REM I5 /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
+           END IF;
+ 
+           IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (N10) REM IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N10) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N11 REM N5 /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
+           END IF;
+ 
+           IF IDENT (N12) REM IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N12) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                    /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT (N12), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF N13 REM N5 /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
+           END IF;
+ 
+           IF IDENT (N14) REM IDENT (N5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N14) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF I10 MOD I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
+           END IF;
+ 
+           IF IDENT (I11) MOD IDENT (I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I11) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I12 MOD I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (I13) MOD IDENT (I5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I13) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I14 MOD I5 /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
+           END IF;
+ 
+           IF IDENT (I10) MOD IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I10) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                    /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT (I10), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF I11 MOD N5 /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
+           END IF;
+ 
+           IF IDENT (I12) MOD IDENT (N5) /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I12) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF I13 MOD N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT (I14) MOD IDENT (N5) /=  N1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I14) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N10 MOD I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
+           END IF;
+ 
+           IF IDENT (N11) MOD IDENT (I5) /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N11) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                    /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT (N11), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF N12 MOD I5 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
+           END IF;
+ 
+           IF IDENT (N13) MOD IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N13) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF N14 MOD I5 /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (N10) MOD IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N10) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N11 MOD N5 /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
+           END IF;
+ 
+           IF IDENT (N12) MOD IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N12) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                    /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT (N12), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF N13 MOD N5 /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
+           END IF;
+ 
+           IF IDENT (N14) MOD IDENT (N5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N14) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C45503B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45503c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45503c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45503c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45503c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,331 ----
+ -- C45503C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE
+ --     OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     LONG_INTEGER.
+ 
+ --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_LONG" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 09/01/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45503C IS
+ 
+      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+ 
+      FUNCTION IDENT (L : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN L;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C45503C", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
+                        "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
+                        "TYPE LONG_INTEGER" );
+ 
+      DECLARE
+           I0  : LONG_INTEGER := 0;
+           I1  : LONG_INTEGER := 1;
+           I2  : LONG_INTEGER := 2;
+           I3  : LONG_INTEGER := 3;
+           I4  : LONG_INTEGER := 4;
+           I5  : LONG_INTEGER := 5;
+           I10 : LONG_INTEGER := 10;
+           I11 : LONG_INTEGER := 11;
+           I12 : LONG_INTEGER := 12;
+           I13 : LONG_INTEGER := 13;
+           I14 : LONG_INTEGER := 14;
+           N1  : LONG_INTEGER := -1;
+           N2  : LONG_INTEGER := -2;
+           N3  : LONG_INTEGER := -3;
+           N4  : LONG_INTEGER := -4;
+           N5  : LONG_INTEGER := -5;
+           N10 : LONG_INTEGER := -10;
+           N11 : LONG_INTEGER := -11;
+           N12 : LONG_INTEGER := -12;
+           N13 : LONG_INTEGER := -13;
+           N14 : LONG_INTEGER := -14;
+ 
+      BEGIN
+           IF I10 REM I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
+           END IF;
+ 
+           IF IDENT (I11) REM IDENT (I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I11) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I12 REM I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
+           END IF;
+ 
+           IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (I13) REM IDENT (I5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I13) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I14 REM I5 /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
+           END IF;
+ 
+           IF IDENT (I10) REM IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I10) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                    /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT (I10), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF I11 REM N5 /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
+           END IF;
+ 
+           IF IDENT (I12) REM IDENT (N5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I12) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF I13 REM N5 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
+           END IF;
+ 
+           IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT (I14) REM IDENT (N5) /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I14) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N10 REM I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
+           END IF;
+ 
+           IF IDENT (N11) REM IDENT (I5) /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N11) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                    /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT (N11), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF N12 REM I5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
+           END IF;
+ 
+           IF IDENT (N13) REM IDENT (I5) /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N13) REM " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF N14 REM I5 /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
+           END IF;
+ 
+           IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (N10) REM IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N10) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N11 REM N5 /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
+           END IF;
+ 
+           IF IDENT (N12) REM IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N12) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "REM" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                    /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                         "IDENT (N12), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF N13 REM N5 /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
+           END IF;
+ 
+           IF IDENT (N14) REM IDENT (N5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N14) REM " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF I10 MOD I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
+           END IF;
+ 
+           IF IDENT (I11) MOD IDENT (I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I11) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I12 MOD I5 /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (I13) MOD IDENT (I5) /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I13) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF I14 MOD I5 /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
+           END IF;
+ 
+           IF IDENT (I10) MOD IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I10) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                    /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT (I10), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF I11 MOD N5 /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
+           END IF;
+ 
+           IF IDENT (I12) MOD IDENT (N5) /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I12) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF I13 MOD N5 /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
+                         "RIGHT => N5)" );
+           END IF;
+ 
+           IF IDENT (I14) MOD IDENT (N5) /=  N1 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (I14) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N10 MOD I5 /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
+           END IF;
+ 
+           IF IDENT (N11) MOD IDENT (I5) /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N11) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                    /= I4 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT (N11), RIGHT => IDENT (I5))" );
+           END IF;
+ 
+           IF N12 MOD I5 /= I3 THEN
+                FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
+           END IF;
+ 
+           IF IDENT (N13) MOD IDENT (I5) /= I2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N13) MOD " &
+                         "IDENT (I5)" );
+           END IF;
+ 
+           IF N14 MOD I5 /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
+           END IF;
+ 
+           IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
+                         "RIGHT => I5)" );
+           END IF;
+ 
+           IF IDENT (N10) MOD IDENT (N5) /= I0 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N10) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF N11 MOD N5 /= N1 THEN
+                FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
+           END IF;
+ 
+           IF IDENT (N12) MOD IDENT (N5) /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N12) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+ 
+           IF "MOD" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                    /= N2 THEN
+                FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                         "IDENT (N12), RIGHT => IDENT (N5))" );
+           END IF;
+ 
+           IF N13 MOD N5 /= N3 THEN
+                FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
+           END IF;
+ 
+           IF IDENT (N14) MOD IDENT (N5) /= N4 THEN
+                FAILED ( "INCORRECT RESULT FOR IDENT (N14) MOD " &
+                         "IDENT (N5)" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C45503C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C45504A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A
+ --      PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF THE
+ --      OPERANDS ARE OF PREDEFINED TYPE INTEGER.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --      RJW 09/01/86  CREATED ORIGINAL TEST.
+ --      JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
+ --                    PREVENT OPTIMIZATION.
+ --      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45504A IS
+ 
+      F : INTEGER := IDENT_INT (INTEGER'FIRST);
+      L : INTEGER := IDENT_INT (INTEGER'LAST);
+ 
+ BEGIN
+      TEST ( "C45504A", "CHECK THAT CONSTRAINT_ERROR " &
+                        "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
+                        "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
+                        "OF PREDEFINED TYPE INTEGER" );
+ 
+      BEGIN
+           IF EQUAL (F*L,-100) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
+      END;
+ 
+      BEGIN
+           IF EQUAL (F*F,100) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
+      END;
+ 
+      BEGIN
+           IF EQUAL (L*L,100) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
+      END;
+ 
+      RESULT;
+ END C45504A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C45504B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN
+ --      A PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF
+ --      THE OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+ --      THE PREDEFINED TYPE "SHORT_INTEGER".
+ 
+ --      IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --      THE VARIABLE "F" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --      RJW 09/01/86  CREATED ORIGINAL TEST.
+ --      JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
+ --                    DEFEAT OPTIMIZATION.
+ --      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45504B IS
+ 
+      F : SHORT_INTEGER;                -- N/A => ERROR.
+      L : SHORT_INTEGER;
+ 
+      FUNCTION IDENT_SHORT(A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN A;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT_SHORT;
+ 
+      FUNCTION SHORT_OK(X : SHORT_INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN X = IDENT_SHORT(X);
+      END SHORT_OK;
+ 
+ BEGIN
+      TEST ( "C45504B", "CHECK THAT CONSTRAINT_ERROR " &
+                        "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
+                        "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
+                        "OF PREDEFINED TYPE SHORT_INTEGER" );
+ 
+      F := IDENT_SHORT(SHORT_INTEGER'FIRST);
+      L := IDENT_SHORT(SHORT_INTEGER'LAST);
+ 
+      BEGIN
+           IF SHORT_OK (F*L) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
+      END;
+ 
+      BEGIN
+           IF SHORT_OK (F * F) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
+      END;
+ 
+      BEGIN
+           IF SHORT_OK (L * L) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
+      END;
+ 
+      RESULT;
+ 
+ END C45504B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- C45504C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A
+ --      PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF THE
+ --      OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+ --      THE PREDEFINED TYPE "LONG_INTEGER".
+ 
+ --      IF SUCH A TYPE IS NOT SUPPORTED THEN THE DECLARATION OF THE
+ --      VARIABLE "F" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --      RJW 09/01/86  CREATED ORIGINAL TEST.
+ --      JET 12/30/87  UPDATED HEADER FORMAT AND DEFEATED OPTIMIZATION.
+ --      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45504C IS
+ 
+      F : LONG_INTEGER;                --  N/A => ERROR.
+      L : LONG_INTEGER;
+ 
+      FUNCTION IDENT_LONG(A : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN A;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT_LONG;
+ 
+      FUNCTION LONG_OK (X : LONG_INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN X = IDENT_LONG(X);
+      END;
+ 
+ BEGIN
+      TEST ( "C45504C", "CHECK THAT CONSTRAINT_ERROR " &
+                        "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
+                        "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
+                        "OF PREDEFINED TYPE LONG_INTEGER" );
+ 
+      F := IDENT_LONG(LONG_INTEGER'FIRST);
+      L := IDENT_LONG(LONG_INTEGER'LAST);
+ 
+      BEGIN
+           IF LONG_OK (F * L) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
+      END;
+ 
+      BEGIN
+           IF LONG_OK (F * F) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
+      END;
+ 
+      BEGIN
+           IF LONG_OK (L * L) THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
+      END;
+ 
+      RESULT;
+ 
+ END C45504C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,214 ----
+ -- C45504D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE SECOND
+ -- OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE OPERANDS ARE OF 
+ -- PREDEFINED TYPE INTEGER.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- R.WILLIAMS 9/1/86
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45504D IS
+ 
+      I0 : INTEGER := IDENT_INT (0);
+      I5 : INTEGER := IDENT_INT (5);
+      N5 : INTEGER := IDENT_INT (-5);
+ 
+ BEGIN
+      TEST ( "C45504D", "CHECK THAT CONSTRAINT_ERROR " &
+                        "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
+                        "'MOD', OR 'REM' EQUALS ZERO, IF THE " & 
+                        "OPERANDS ARE OF PREDEFINED TYPE INTEGER" );
+ 
+      BEGIN
+           IF I5 / I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 / I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 / I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 / I0 * I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 MOD I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 MOD I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 MOD I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
+                          "(I5 + I0) MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                          "(I5 + I0) MOD I0'" );
+      END;
+           
+      BEGIN
+           IF I5 REM I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 REM I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 REM I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 REM (-I0) = I5 REM I0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
+                          "= I5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                          "I5 REM I0'" );
+      END;
+           
+      RESULT;
+ END C45504D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504e.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504e.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504e.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504e.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,234 ----
+ -- C45504E.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE
+ --     SECOND OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE
+ --     OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     RJW 09/01/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     JRL 03/11/93 INITIALIZED VARIABLES TO DEFEAT OPTIMIZATION.
+ --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45504E IS
+ 
+      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+ 
+      I0 : SHORT_INTEGER := 1;
+      I5 : SHORT_INTEGER := 2;
+      N5 : SHORT_INTEGER := 3;
+ 
+ BEGIN
+      TEST ( "C45504E", "CHECK THAT CONSTRAINT_ERROR " &
+                        "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
+                        "'MOD', OR 'REM' EQUALS ZERO, IF THE " &
+                        "OPERANDS ARE OF PREDEFINED TYPE " &
+                        "SHORT_INTEGER" );
+ 
+      IF EQUAL (3, 3) THEN
+           I0 := 0;
+           I5 := 5;
+           N5 := -5;
+      END IF;
+ 
+      BEGIN
+           IF I5 / I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 / I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 / I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 / I0 * I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 MOD I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 MOD I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 MOD I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
+                          "(I5 + I0) MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                          "(I5 + I0) MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 REM I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 REM I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 REM I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 REM (-I0) = I5 REM I0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
+                          "= I5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                          "I5 REM I0'" );
+      END;
+ 
+      RESULT;
+ END C45504E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504f.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504f.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45504f.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45504f.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,234 ----
+ -- C45504F.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE
+ --     SECOND OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE
+ --     OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     LONG_INTEGER.
+ 
+ --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_LONG" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- HISTORY:
+ --     RJW 09/01/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     JRL 03/11/93 INITIALIZED VARIABLES TO DEFEAT OPTIMIZATION.
+ --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45504F IS
+ 
+      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+ 
+      I0 : LONG_INTEGER := 1;
+      I5 : LONG_INTEGER := 2;
+      N5 : LONG_INTEGER := 3;
+ 
+ BEGIN
+      TEST ( "C45504F", "CHECK THAT CONSTRAINT_ERROR " &
+                        "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
+                        "'MOD', OR 'REM' EQUALS ZERO, IF THE " &
+                        "OPERANDS ARE OF PREDEFINED TYPE " &
+                        "LONG_INTEGER" );
+ 
+      IF EQUAL (3, 3) THEN
+           I0 := 0;
+           I5 := 5;
+           N5 := -5;
+      END IF;
+ 
+      BEGIN
+           IF I5 / I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 / I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 / I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 / I0 * I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 MOD I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 MOD I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 MOD I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
+                          "(I5 + I0) MOD I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                          "(I5 + I0) MOD I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 REM I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF N5 REM I0 = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF I0 REM I0  = 0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
+      END;
+ 
+      BEGIN
+           IF I5 REM (-I0) = I5 REM I0 THEN
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0' - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0' - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
+                          "= I5 REM I0'" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                          "I5 REM I0'" );
+      END;
+ 
+      RESULT;
+ END C45504F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45505a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45505a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45505a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45505a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- C45505A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT MULTIPLICATION FOR INTEGER SUBTYPES YIELDS A RESULT
+ -- BELONGING TO THE BASE TYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ 
+ -- JBG 2/24/84
+ -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45505A IS
+ 
+      TYPE INT IS RANGE 1..10;
+ 
+      X, Y : INT := INT(IDENT_INT(5));
+ 
+ BEGIN
+ 
+      TEST ("C45505A", "CHECK SUBTYPE OF INTEGER MULTIPLICATION");
+ 
+      BEGIN
+ 
+           IF X * Y / 5 /= INT(IDENT_INT(5)) THEN
+                FAILED ("INCORRECT RESULT");
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                IF INT'BASE'LAST >= INT'VAL(25) THEN
+                     FAILED ("MULTIPLICATION DOES NOT YIELD RESULT " &
+                             "BELONGING TO THE BASE TYPE");
+                ELSE
+                     COMMENT ("BASE TYPE HAS RANGE LESS THAN 25");
+                END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C45505A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45523a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45523a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45523a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45523a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C45523A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR FLOATING POINT TYPES, IF MACHINE_OVERFLOWS IS TRUE AND
+ --     EITHER THE RESULT OF MULTIPLICATION LIES OUTSIDE THE RANGE OF THE
+ --     BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY ZERO, THEN
+ --     CONSTRAINT_ERROR IS RAISED.  THIS TESTS
+ --     DIGITS 5.
+ 
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     BCB 02/09/88  CREATED ORIGINAL TEST.
+ --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ --     KAS 11/14/95  DELETED USAGE OF 'SAFE_LARGE
+ --     KAS 11/30/95  GOT IT RIGHT THIS TIME
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45523A IS
+ 
+      TYPE FLT IS DIGITS 5;
+ 
+      F : FLT;
+ 
+      FUNCTION IDENT_FLT(X : FLT) RETURN FLT IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN X;
+           ELSE
+                RETURN 0.0;
+           END IF;
+      END IDENT_FLT;
+ 
+      FUNCTION EQUAL_FLT(ONE, TWO : FLT) RETURN BOOLEAN IS
+      BEGIN
+           RETURN ONE = TWO * FLT (IDENT_INT(1));
+      END EQUAL_FLT;
+ 
+ BEGIN
+      TEST ("C45523A", "FOR FLOATING POINT TYPES, IF MACHINE_" &
+                       "OVERFLOWS IS TRUE AND EITHER THE RESULT OF " &
+                       "MULTIPLICATION LIES OUTSIDE THE RANGE OF THE " &
+                       "BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY " &
+                       "ZERO, THEN CONSTRAINT_ERROR IS RAISED." &
+                       "THIS TESTS DIGITS 5");
+ 
+ 
+      IF FLT'MACHINE_OVERFLOWS THEN
+           BEGIN
+                F := (FLT'BASE'LAST) * IDENT_FLT (2.0);
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR MULTIPLICATION");
+                IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
+                     COMMENT ("DON'T OPTIMIZE F");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
+                              "MULTIPLICATION");
+                WHEN OTHERS =>
+                     FAILED ("AN EXCEPTION OTHER THAN " &
+                             "CONSTRAINT_ERROR WAS RAISED FOR " &
+                             "MULTIPLICATION");
+           END;
+           BEGIN
+                F := (FLT'LAST) / IDENT_FLT (0.0);
+                FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR DIVISION BY ZERO");
+                IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
+                     COMMENT ("DON'T OPTIMIZE F");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
+                              "DIVISION BY ZERO");
+                WHEN OTHERS =>
+                     FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                             "WAS RAISED FOR DIVISION BY ZERO");
+           END;
+      ELSE
+           NOT_APPLICABLE ("THIS TEST IS NOT APPLICABLE DUE TO " &
+                           "MACHINE_OVERFLOWS BEING FALSE");
+      END IF;
+ 
+      RESULT;
+ END C45523A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,182 ----
+ -- C45531A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531A IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531A", "MIXED FIXED POINT AND INTEGER ""*"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (0.125);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.125);                 -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A               : INTEGER   := 0;
+           B               : FX_2      := 0.0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_2 (DEL4 * FORTH + DEL1 );
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A               : FX_2      := 0.0;
+           B               : INTEGER   := 0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_2 (DEL4 * FORTH + DEL1 );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C45531B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531B IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL2            : CONSTANT := 2.0 * DEL1;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531B", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (DEL2 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (DEL2 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+                A := FX_1 (DEL2 * (3 * FORTH + 1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_2    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (DEL4 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (DEL4 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- C45531C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531C IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531C", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     &  "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (2.5);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_RNG1 := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_RNG1 (RNG1 * FORTH + 0.5);
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_RNG1 (RNG1 * FORTH + 0.5);
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C45531D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531D IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531D", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (FORTH + 1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,182 ----
+ -- C45531E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531E IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531E", "MIXED FIXED POINT AND INTEGER ""*"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (0.125);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.125);                 -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A               : INTEGER   := 0;
+           B               : FX_2      := 0.0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_2 (DEL4 * FORTH + DEL1 );
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A               : FX_2      := 0.0;
+           B               : INTEGER   := 0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_2 (DEL4 * FORTH + DEL1 );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C45531F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531F IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL2            : CONSTANT := 2.0 * DEL1;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531F", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (DEL2 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (DEL2 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+                A := FX_1 (DEL2 * (3 * FORTH + 1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_2    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (DEL4 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (DEL4 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- C45531G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531G IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531G", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     &  "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (2.5);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_RNG1 := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_RNG1 (RNG1 * FORTH + 0.5);
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_RNG1 (RNG1 * FORTH + 0.5);
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C45531H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531H IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531H", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (FORTH + 1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,182 ----
+ -- C45531I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531I IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531I", "MIXED FIXED POINT AND INTEGER ""*"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (0.125);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.125);                 -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A               : INTEGER   := 0;
+           B               : FX_2      := 0.0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_2 (DEL4 * FORTH + DEL1 );
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A               : FX_2      := 0.0;
+           B               : INTEGER   := 0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_2 (DEL4 * FORTH + DEL1 );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C45531J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45531J IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL2            : CONSTANT := 2.0 * DEL1;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531J", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (DEL2 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (DEL2 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+                A := FX_1 (DEL2 * (3 * FORTH + 1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_2    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (DEL4 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (DEL4 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,184 ----
+ -- C45531K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C45531K IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531K", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     &  "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (2.5);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_RNG1 := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_RNG1 (RNG1 * FORTH + 0.5);
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_RNG1 (RNG1 * FORTH + 0.5);
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,154 ----
+ -- C45531L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C45531L IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531L", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (FORTH + 1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531m.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531m.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531m.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531m.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,189 ----
+ -- C45531M.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C45531M IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+                                                         -- N/A => ERROR.
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531M", "MIXED FIXED POINT AND INTEGER ""*"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (0.125);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.125);                 -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A               : INTEGER   := 0;
+           B               : FX_2      := 0.0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_2 (DEL4 * FORTH + DEL1 );
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A               : FX_2      := 0.0;
+           B               : INTEGER   := 0;
+           RESULT_VALUE    : FX_2      := 0.0;
+           LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+           HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                       := FX_2 (DEL4 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                       := FX_2 (DEL4 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_2 (DEL4 * FORTH + DEL1 );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531n.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531n.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531n.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531n.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,160 ----
+ -- C45531N.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C45531N IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      DEL2            : CONSTANT := 2.0 * DEL1;
+      DEL4            : CONSTANT := 4.0 * DEL1;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+                                                         -- N/A => ERROR.
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45531N", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR RANGE <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (DEL2 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (DEL2 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+                A := FX_1 (DEL2 * (3 * FORTH + 1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_2    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (DEL4 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (DEL4 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531o.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531o.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531o.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531o.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,189 ----
+ -- C45531O.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ --       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ WITH REPORT;
+ PROCEDURE C45531O IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                         -- N/A => ERROR.
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531O", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     &  "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := 3;
+                B := FX_0P5 (2.5);               -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+                B := 6;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+ 
+ C:   DECLARE
+           A              : INTEGER := 0;
+           B              : FX_RNG1 := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+                A := 3;
+                B := FX_RNG1 (RNG1 * FORTH + 0.5);
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+ 
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+      -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+ 
+ D:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+           HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+                A := FX_RNG1 (RNG1 * FORTH + 0.5);
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A * B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END D;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531p.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531p.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45531p.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45531p.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- C45531P.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ --       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+ --       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ WITH REPORT;
+ PROCEDURE C45531P IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                         -- N/A => ERROR.
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45531P", "MIXED FIXED POINT AND INTEGER ""/"" "
+                      & "FOR DELTA <, =, > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+                B := 5;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER "
+                     &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+ 
+ B:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (FORTH + 1);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                     &  "NUMBER, RESULT NOT");
+ 
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : INTEGER := 0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * FORTH );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * (FORTH + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+                A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+                B := 3;
+           END IF;
+ 
+           RESULT_VALUE := A / B;
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45531P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C45532A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532A IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45532A", "FIXED POINT OPERATOR ""*"" "
+                      & "FOR RANGE <, =, AND > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_2    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.25);                -- A MODEL NUMBER
+                B := FX_2   (0.50);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- C45532B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532B IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;            -- MUST BE EVEN & >= 6
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                        0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                        1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                        2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45532B", "FIXED POINT OPERATOR ""/"" "
+                      & "FOR RANGE <, =, AND > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.125);               -- A MODEL NUMBER
+                B := FX_1   (0.25);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (2 * DEL1 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                             --                      / (6 * FORTH + 2);
+           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                             --                      / (6 * FORTH + 0);
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (DEL1 * HIGH_COUNT );
+      BEGIN
+           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+                A := FX_1 (DEL1 * (2 * FORTH + 1));
+                B := FX_1 (DEL1 * (6 * FORTH + 1));
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- C45532C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532C IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532C", "FIXED POINT OPERATOR ""*"" "
+                      & "FOR DELTA <, =, AND > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+           HIGHEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,150 ----
+ -- C45532D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532D IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 12;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532D", "FIXED POINT OPERATOR ""/"" "
+                      & "FOR DELTA <, =, AND > 1.0");
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (0.5 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+                B := FX_1    (3.0);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 ( RNG1 - 3.0);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 ( RNG1 + 4.0);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- C45532E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532E IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45532E", "FIXED POINT OPERATOR ""*""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_2    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.25);                -- A MODEL NUMBER
+                B := FX_2   (0.50);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C45532F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532F IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;            -- MUST BE EVEN & >= 6
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                       0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                       1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                       2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45532F", "FIXED POINT OPERATOR ""/""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.125);               -- A MODEL NUMBER
+                B := FX_1   (0.25);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (2 * DEL1 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                             --                      / (6 * FORTH + 2);
+           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                             --                      / (6 * FORTH + 0);
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (DEL1 * HIGH_COUNT );
+      BEGIN
+           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+                A := FX_1 (DEL1 * (2 * FORTH + 1));
+                B := FX_1 (DEL1 * (6 * FORTH + 1));
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,155 ----
+ -- C45532G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532G IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532G", "FIXED POINT OPERATOR ""*""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+           HIGHEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- C45532H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532H IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 16;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532H", "FIXED POINT OPERATOR ""/""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (0.5 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+                B := FX_1    (3.0);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 ( RNG1 - 3.0);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 ( RNG1 + 4.0);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C45532I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C45532I IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45532I", "FIXED POINT OPERATOR ""*""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_2    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.25);                -- A MODEL NUMBER
+                B := FX_2   (0.50);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C45532J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT;
+ PROCEDURE C45532J IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;            -- MUST BE EVEN & >= 6
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                       0.5 - DEL1 * 1;
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                       1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                       2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45532J", "FIXED POINT OPERATOR ""/""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.125);               -- A MODEL NUMBER
+                B := FX_1   (0.25);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (2 * DEL1 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                             --                      / (6 * FORTH + 2);
+           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                             --                      / (6 * FORTH + 0);
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (DEL1 * HIGH_COUNT );
+      BEGIN
+           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+                A := FX_1 (DEL1 * (2 * FORTH + 1));
+                B := FX_1 (DEL1 * (6 * FORTH + 1));
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- C45532K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C45532K IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532K", "FIXED POINT OPERATOR ""*""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+           HIGHEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,150 ----
+ -- C45532L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ --     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+ --                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C45532L IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 32;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532L", "FIXED POINT OPERATOR ""/""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (0.5 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+                B := FX_1    (3.0);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 ( RNG1 - 3.0);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 ( RNG1 + 4.0);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532m.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532m.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532m.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532m.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,157 ----
+ -- C45532M.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ WITH REPORT;
+ PROCEDURE C45532M IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+                                                         -- N/A => ERROR.
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+ 
+ BEGIN TEST ("C45532M", "FIXED POINT OPERATOR ""*""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_2    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+           HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.25);                -- A MODEL NUMBER
+                B := FX_2   (0.50);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+                B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                    := FX_2 (4 * DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                    := FX_2 (4 * DEL1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+                B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532n.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532n.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532n.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532n.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- C45532N.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ -- IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --    'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ WITH REPORT;
+ PROCEDURE C45532N IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;            -- MUST BE EVEN & >= 6
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+      TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                       0.5 - DEL1 * 1; -- N/A => ERROR.
+      TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                       1.0 - DEL1 * 2; -- N/A => ERROR.
+      TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                       2.0 - DEL1 * 4; -- N/A => ERROR.
+ 
+ BEGIN TEST ("C45532N", "FIXED POINT OPERATOR ""/""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_2    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+           HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.125);               -- A MODEL NUMBER
+                B := FX_1   (0.25);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_2 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 (2 * DEL1 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+                B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                             --                      / (6 * FORTH + 2);
+           HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                             --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                             --                      / (6 * FORTH + 0);
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (DEL1 * LOW_COUNT );
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (DEL1 * HIGH_COUNT );
+      BEGIN
+           IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+                A := FX_1 (DEL1 * (2 * FORTH + 1));
+                B := FX_1 (DEL1 * (6 * FORTH + 1));
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532o.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532o.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532o.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532o.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,161 ----
+ -- C45532O.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "*" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ --       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ WITH REPORT;
+ PROCEDURE C45532O IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      FORTH           : CONSTANT := FULL_SCALE / 4;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                         -- N/A => ERROR.
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532O", "FIXED POINT OPERATOR ""*""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOWEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+           HIGHEST_ACCEPTABLE_VALUE
+                          : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+                B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+ 
+ B:   DECLARE
+           A              : FX_0P5  := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_RNG1 := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+           HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+                B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A * B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_1    := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_RNG1    := 0.0;
+           LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+           HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * LOW_COUNT);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                    := FX_RNG1 (RNG1 * HIGH_COUNT);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+                B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_RNG1 (A * B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532p.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532p.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45532p.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45532p.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,155 ----
+ -- C45532P.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --OBJECTIVE:
+ --     CHECK THAT THE OPERATOR "/" PRODUCES CORRECT RESULTS
+ --     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+ --       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+ --       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+ --       EQUAL TO 0.5.
+ --
+ --     TEST CASES ARE:
+ --       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ --       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ --       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+ --
+ --     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+ --     WITH RANGE <, =, AND > THAN 1.0 AND
+ --     WITH DELTA <, =, AND > THAN 1.0.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+ --     'MAX_MANTISSA OF 47 OR GREATER.
+ 
+ --     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+ --     'TYPE FX_OP5' MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     NTW 09/08/86 CREATED ORIGINAL TEST.
+ --     RJW 11/05/86 REVISED COMMENTS.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+ 
+ WITH REPORT;
+ PROCEDURE C45532P IS
+ 
+      USE REPORT;
+ 
+      MIN_WORD_LENGTH : CONSTANT := 48;
+      FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+      A_THIRD         : CONSTANT := FULL_SCALE / 3;
+      RNG1            : CONSTANT := FULL_SCALE * 0.5;
+      TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                         -- N/A => ERROR.
+      TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+      TYPE FX_RNG1 IS DELTA RNG1
+                     RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+ 
+ BEGIN TEST ("C45532P", "FIXED POINT OPERATOR ""/""" );
+ 
+      --------------------------------------------------
+ 
+      -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+ 
+ A:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_0P5  := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+           HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+                B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+           END IF;
+      END A;
+ 
+      --------------------------------------------------
+ 
+      -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+ 
+ B:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_0P5  := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                    := FX_0P5 (0.5 * A_THIRD);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                    := FX_0P5 (0.5 * (A_THIRD + 1) );
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+                B := FX_1    (3.0);                -- A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_0P5 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN A, B MODEL NUMBERS A / B NOT");
+           END IF;
+      END B;
+ 
+      --------------------------------------------------
+ 
+      -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+ 
+ C:   DECLARE
+           A              : FX_RNG1 := 0.0;
+           B              : FX_1    := 0.0;
+           RESULT_VALUE   : FX_1    := 0.0;
+           LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                    := FX_1 ( RNG1 - 3.0);
+           HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                    := FX_1 ( RNG1 + 4.0);
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+                B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+           END IF;
+ 
+           RESULT_VALUE := FX_1 (A / B);
+ 
+           IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+              OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+                FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                     &  "WHEN USING NO MODEL NUMBERS");
+           END IF;
+      END C;
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ 
+ END C45532P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45534b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45534b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45534b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45534b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C45534B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A
+ --     FIXED POINT VALUE IS DIVIDED BY ZERO (EITHER AN INTEGER ZERO OR
+ --     A FIXED POINT ZERO).
+ 
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     BCB 07/14/88  CREATED ORIGINAL TEST.
+ --     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X CONSISTENCY
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45534B IS
+ 
+      TYPE FIX IS DELTA 2.0**(-1) RANGE -2.0 .. 2.0;
+      TYPE FIX2 IS DELTA 2.0**(-1) RANGE -3.0 .. 3.0;
+ 
+      A : FIX := 1.0;
+      B : FIX;
+      ZERO : FIX := 0.0;
+      ZERO2 : FIX2 := 0.0;
+ 
+      FUNCTION IDENT_FLT (ONE, TWO : FIX) RETURN BOOLEAN IS
+      BEGIN
+           RETURN ONE = FIX (TWO * FIX (IDENT_INT(1)));
+      END IDENT_FLT;
+ 
+ BEGIN
+      TEST ("C45534B", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                       "A FIXED POINT VALUE IS " &
+                       "DIVIDED BY ZERO (EITHER AN INTEGER ZERO OR A " &
+                       "FIXED POINT ZERO)");
+ 
+      BEGIN
+           B := A / IDENT_INT (0);
+           FAILED ("NO EXCEPTION RAISED FOR DIVISION BY INTEGER ZERO");
+           IF IDENT_FLT (B,B) THEN
+                COMMENT ("DON'T OPTIMIZE B");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+      END;
+ 
+      BEGIN
+           B := FIX (A / ZERO);
+           FAILED ("NO EXCEPTION RAISED FOR DIVISION BY FIXED POINT " &
+                   "ZERO - 1");
+           IF IDENT_FLT (B,B) THEN
+                COMMENT ("DON'T OPTIMIZE B");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+       END;
+ 
+      BEGIN
+           B := FIX (A / ZERO2);
+           FAILED ("NO EXCEPTION RAISED FOR DIVISION BY FIXED POINT " &
+                   "ZERO - 2");
+           IF IDENT_FLT (B,B) THEN
+                COMMENT ("DON'T OPTIMIZE B");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+       END;
+ 
+      RESULT;
+ END C45534B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45536a.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45536a.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45536a.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45536a.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C45536A.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK FIXED POINT MULTIPLICATION AND DIVISION WHEN 'SMALL OF
+ --     THE OPERANDS ARE NOT BOTH POWERS OF THE SAME BASE VALUE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+ --     REPRESENTATION CLAUSES FOR 'SMALL WHICH ARE NOT POWERS OF TWO.
+ 
+ --     IF SUCH REPRESENTATION CLAUSES ARE NOT SUPPORTED, THEN THE
+ --     REPRESENTATION CLAUSE FOR CHECK_TYPE MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     BCB 02/02/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45536A IS
+ 
+      TYPE CHECK_TYPE IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+      FOR CHECK_TYPE'SMALL USE 0.2;                     -- N/A => ERROR.
+ 
+      TYPE F1 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+      FOR F1'SMALL USE 0.5;
+ 
+      TYPE F2 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+      FOR F2'SMALL USE 0.2;
+ 
+      TYPE F3 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+      FOR F3'SMALL USE 0.1;
+ 
+      A : F1;
+      B : F2;
+      C : F3;
+ 
+      FUNCTION IDENT_FIX(X : F3) RETURN F3 IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN X;
+           ELSE
+                RETURN 0.0;
+           END IF;
+      END IDENT_FIX;
+ 
+ BEGIN
+      TEST ("C45536A", "CHECK FIXED POINT MULTIPLICATION AND DIVISION " &
+                       "WHEN 'SMALL OF THE OPERANDS ARE NOT BOTH " &
+                       "POWERS OF THE SAME BASE VALUE");
+ 
+      A := 1.0; B := 1.0; C := F3(A * B);
+ 
+      IF C /= IDENT_FIX(1.0) THEN
+           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 1");
+      END IF;
+ 
+      C := F3(A / B);
+ 
+      IF C /= IDENT_FIX(1.0) THEN
+           FAILED ("IMPROPER RESULTS FOR DIVISION - 1");
+      END IF;
+ 
+      A := 1.0; B := 0.3; C := F3(A * B);
+ 
+      IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
+           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 2");
+      END IF;
+ 
+      B := 0.25; C := F3(A / B);
+ 
+      IF C NOT IN IDENT_FIX(2.5) .. IDENT_FIX(5.0) THEN
+           FAILED ("IMPROPER RESULTS FOR DIVISION - 2");
+      END IF;
+ 
+      A := 0.5; B := 0.3; C := F3(A * B);
+ 
+      IF C NOT IN IDENT_FIX(0.1) .. IDENT_FIX(0.2) THEN
+           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 3");
+      END IF;
+ 
+      C := F3(A / B);
+ 
+      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
+           FAILED ("IMPROPER RESULTS FOR DIVISION - 3");
+      END IF;
+ 
+      B := 0.3; C := 0.2; A := F1(B * C);
+ 
+      IF A NOT IN F1(IDENT_FIX(0.0)) .. F1(IDENT_FIX(0.5)) THEN
+           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 4");
+      END IF;
+ 
+      A := 1.0; B := 1.6; C := F3(A / B);
+ 
+      IF C NOT IN IDENT_FIX(0.6) .. IDENT_FIX(0.7) THEN
+           FAILED ("IMPROPER RESULTS FOR DIVISION - 4");
+      END IF;
+ 
+      A := 0.75; B := 0.4; C := F3(A * B);
+ 
+      IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
+           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 5");
+      END IF;
+ 
+      A := 0.8; C := F3(A / B);
+ 
+      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
+           FAILED ("IMPROPER RESULTS FOR DIVISION - 5");
+      END IF;
+ 
+      A := 0.8; B := 0.4; C := F3(A * B);
+ 
+      IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
+           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 6");
+      END IF;
+ 
+      A := 0.75; C := F3(A / B);
+ 
+      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
+           FAILED ("IMPROPER RESULTS FOR DIVISION - 6");
+      END IF;
+ 
+      A := 0.7; B := 0.3; C := F3(A * B);
+ 
+      IF C NOT IN IDENT_FIX(0.1) .. IDENT_FIX(0.4) THEN
+           FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 7");
+      END IF;
+ 
+      C := F3(A / B);
+ 
+      IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(5.0) THEN
+           FAILED ("IMPROPER RESULTS FOR DIVISION - 7");
+      END IF;
+ 
+      RESULT;
+ END C45536A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c456001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c456001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c456001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c456001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C456001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --
+ --                                     Notice
+ --
+ --    The ACAA has created and maintains the Ada Conformity Assessment Test
+ --    Suite for the purpose of conformity assessments conducted in accordance
+ --    with the International Standard ISO/IEC 18009 - Ada: Conformity
+ --    assessment of a language processor. This test suite should not be used
+ --    to make claims of conformance unless used in accordance with
+ --    ISO/IEC 18009 and any applicable ACAA procedures.
+ --
+ --*
+ -- OBJECTIVE:
+ --     For exponentiation of floating point types, check that
+ --       Constraint_Error is raised (or, if no exception is raised and
+ --       Machine_Overflows is False, that a result is produced) if the
+ --       result is outside of the range of the base type.
+ --     This tests digits 5.
+ 
+ -- HISTORY:
+ --     04/30/03  RLB  Created test from old C45622A and C45624A.
+ 
+ with Report;
+ 
+ procedure C456001 is
+ 
+      type Flt is digits 5;
+ 
+      F : Flt;
+ 
+      function Equal_Flt (One, Two : Flt) return Boolean is
+          -- Break optimization.
+      begin
+           return One = Two * Flt (Report.Ident_Int(1));
+      end Equal_Flt;
+ 
+ begin
+      Report.Test ("C456001", "For exponentiation of floating point types, " &
+                       "check that Constraint_Error is raised (or, if " &
+                       "if no exception is raised and Machine_Overflows is " &
+                       "False, that a result is produced) if the result is " &
+                       "outside of the range of the base type.");
+ 
+      begin
+          F := (Flt'Base'Last)**Report.Ident_Int (2);
+          if Flt'Machine_Overflows Then
+              Report.Failed ("Constraint_Error was not raised for " &
+                        "exponentiation");
+          else
+              -- RM95 3.5.6(7) allows disobeying RM95 4.5(10) if
+              -- Machine_Overflows is False.
+              Report.Comment ("Constraint_Error was not raised for " &
+                        "exponentiation and Machine_Overflows is False");
+          end if;
+          if not Equal_Flt (F, F) then
+              -- Optimization breaker, F must be evaluated.
+              Report.Comment ("Don't optimize F");
+          end if;
+      exception
+          when Constraint_Error =>
+              Report.Comment ("Constraint_Error was raised for " &
+                              "exponentiation");
+          when others =>
+              Report.Failed ("An exception other than Constraint_Error " &
+                             "was raised for exponentiation");
+      end;
+ 
+      Report.Result;
+ end C456001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45611a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45611a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45611a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45611a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,123 ----
+ --  C45611A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  CHECK THAT EXPONENTIATION OF AN INTEGER TO AN INTEGER VALUE IS 
+ --  CORRECTLY EVALUATED.
+ 
+ --  H. TILTON 9/23/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45611A IS
+ 
+     I1,INT : INTEGER;
+    
+     BEGIN
+ 
+  
+          TEST ("C45611A", "CHECK THAT EXPONENTIATION OF AN INTEGER " &
+                           "VALUE IS CORRECTLY EVALUATED");
+ 
+          I1 := IDENT_INT(0) ** IDENT_INT(0);
+ 
+          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '0**0'" ); 
+          END IF;
+ 
+          INT := "**" (IDENT_INT(0),IDENT_INT(1));
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**1'" ); 
+          END IF;
+ 
+          I1 := IDENT_INT(6) ** IDENT_INT(0);
+ 
+          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '6**0'" ); 
+          END IF;
+ 
+          INT := IDENT_INT(156) ** IDENT_INT(1);
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(156) THEN
+               FAILED( "INCORRECT RESULT FOR '156**1'" ); 
+          END IF;
+ 
+          I1 := IDENT_INT(-3) ** IDENT_INT(0);
+ 
+          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-3)**0'" ); 
+          END IF;
+ 
+          INT := "**" (IDENT_INT(-7),IDENT_INT(1));
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(-7) THEN
+               FAILED( "INCORRECT RESULT FOR '(-7)**1'" ); 
+          END IF;
+ 
+          I1 := "**" (IDENT_INT(-1),IDENT_INT(2));
+ 
+          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
+          END IF;
+   
+   
+          INT := IDENT_INT(-1) ** 3;         
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(-1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
+          END IF;
+   
+          INT := "**" (IDENT_INT(0),IDENT_INT(2));
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**2'" );
+          END IF;
+ 
+          INT := IDENT_INT(0) ** IDENT_INT(10);
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**10'" );
+          END IF;
+   
+          INT := "**" (IDENT_INT(6),IDENT_INT(2));
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(36) THEN
+               FAILED( "INCORRECT RESULT FOR '6**2'" );
+          END IF;
+   
+          INT := "**" (IDENT_INT(2),IDENT_INT(2));
+ 
+          IF IDENT_INT(INT) /= IDENT_INT(4) THEN
+               FAILED( "INCORRECT RESULT FOR '2**2'" );
+          END IF;
+ 
+          I1 := "**" (IDENT_INT(1),IDENT_INT(10));
+ 
+          IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '1**10'" );
+          END IF;
+         
+          RESULT;
+ 
+     END C45611A;      
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45611b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45611b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45611b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45611b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,141 ----
+ --  C45611B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT EXPONENTIATION OF A SHORT_INTEGER TO AN INTEGER VALUE
+ --     IS CORRECTLY EVALUATED.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     HTG 09/23/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45611B IS
+ 
+     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+ 
+     I1,INT : SHORT_INTEGER;
+ 
+     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+ 
+     BEGIN
+ 
+ 
+          TEST ("C45611B", "CHECK THAT EXPONENTIATION OF A " &
+                           "SHORT_INTEGER VALUE IS CORRECTLY " &
+                           "EVALUATED");
+ 
+          I1 := IDENT(0) ** IDENT_INT(0);
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '0**0'" );
+          END IF;
+ 
+          INT := "**" (IDENT(0),IDENT_INT(1));
+ 
+          IF IDENT(INT) /= IDENT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**1'" );
+          END IF;
+ 
+          I1 := IDENT(6) ** IDENT_INT(0);
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '6**0'" );
+          END IF;
+ 
+          INT := IDENT(15) ** IDENT_INT(1);
+ 
+          IF IDENT(INT) /= IDENT(15) THEN
+               FAILED( "INCORRECT RESULT FOR '15**1'" );
+          END IF;
+ 
+          I1 := IDENT(-3) ** IDENT_INT(0);
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-3)**0'" );
+          END IF;
+ 
+          INT := "**" (IDENT(-7),IDENT_INT(1));
+ 
+          IF IDENT(INT) /= IDENT(-7) THEN
+               FAILED( "INCORRECT RESULT FOR '(-7)**1'" );
+          END IF;
+ 
+          I1 := "**" (IDENT(-1),IDENT_INT(2));
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
+          END IF;
+ 
+ 
+          INT := IDENT(-1) ** IDENT_INT(3);
+ 
+          IF IDENT(INT) /= IDENT(-1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
+          END IF;
+ 
+          INT := "**" (IDENT(0),IDENT_INT(2));
+ 
+          IF IDENT(INT) /= IDENT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**2'" );
+          END IF;
+ 
+          INT := IDENT(0) ** IDENT_INT(10);
+ 
+          IF IDENT(INT) /= IDENT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**10'" );
+          END IF;
+ 
+          INT := "**" (IDENT(6),IDENT_INT(2));
+ 
+          IF IDENT(INT) /= IDENT(36) THEN
+               FAILED( "INCORRECT RESULT FOR '6**2'" );
+          END IF;
+ 
+          INT := "**" (IDENT(2),IDENT_INT(2));
+ 
+          IF IDENT(INT) /= IDENT(4) THEN
+               FAILED( "INCORRECT RESULT FOR '2**2'" );
+          END IF;
+ 
+          I1 := "**" (IDENT(1),IDENT_INT(10));
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '1**10'" );
+          END IF;
+ 
+          RESULT;
+ 
+     END C45611B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45611c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45611c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45611c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45611c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,141 ----
+ --  C45611C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT EXPONENTIATION OF A LONG_INTEGER TO AN INTEGER VALUE
+ --     IS CORRECTLY EVALUATED.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     LONG_INTEGER.
+ 
+ --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_LONG" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     HTG 09/23/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45611C IS
+ 
+     CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+ 
+     I1,INT : LONG_INTEGER;
+ 
+     FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+ 
+     BEGIN
+ 
+ 
+          TEST ("C45611C", "CHECK THAT EXPONENTIATION OF A " &
+                           "LONG_INTEGER VALUE IS CORRECTLY " &
+                           "EVALUATED");
+ 
+          I1 := IDENT(0) ** IDENT_INT(0);
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '0**0'" );
+          END IF;
+ 
+          INT := "**" (IDENT(0),IDENT_INT(1));
+ 
+          IF IDENT(INT) /= IDENT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**1'" );
+          END IF;
+ 
+          I1 := IDENT(6) ** IDENT_INT(0);
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '6**0'" );
+          END IF;
+ 
+          INT := IDENT(156) ** IDENT_INT(1);
+ 
+          IF IDENT(INT) /= IDENT(156) THEN
+               FAILED( "INCORRECT RESULT FOR '156**1'" );
+          END IF;
+ 
+          I1 := IDENT(-3) ** IDENT_INT(0);
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-3)**0'" );
+          END IF;
+ 
+          INT := "**" (IDENT(-7),IDENT_INT(1));
+ 
+          IF IDENT(INT) /= IDENT(-7) THEN
+               FAILED( "INCORRECT RESULT FOR '(-7)**1'" );
+          END IF;
+ 
+          I1 := "**" (IDENT(-1),IDENT_INT(2));
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
+          END IF;
+ 
+ 
+          INT := IDENT(-1) ** IDENT_INT(3);
+ 
+          IF IDENT(INT) /= IDENT(-1) THEN
+               FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
+          END IF;
+ 
+          INT := "**" (IDENT(0),IDENT_INT(2));
+ 
+          IF IDENT(INT) /= IDENT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**2'" );
+          END IF;
+ 
+          INT := IDENT(0) ** IDENT_INT(10);
+ 
+          IF IDENT(INT) /= IDENT(0) THEN
+               FAILED( "INCORRECT RESULT FOR '0**10'" );
+          END IF;
+ 
+          INT := "**" (IDENT(6),IDENT_INT(2));
+ 
+          IF IDENT(INT) /= IDENT(36) THEN
+               FAILED( "INCORRECT RESULT FOR '6**2'" );
+          END IF;
+ 
+          INT := "**" (IDENT(2),IDENT_INT(2));
+ 
+          IF IDENT(INT) /= IDENT(4) THEN
+               FAILED( "INCORRECT RESULT FOR '2**2'" );
+          END IF;
+ 
+          I1 := "**" (IDENT(1),IDENT_INT(10));
+ 
+          IF IDENT(I1) /= IDENT(1) THEN
+               FAILED( "INCORRECT RESULT FOR '1**10'" );
+          END IF;
+ 
+          RESULT;
+ 
+     END C45611C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45613a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45613a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45613a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45613a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C45613A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED
+ -- BY "**" FOR INTEGERS WHEN THE RESULT EXCEEDS THE RANGE 
+ -- OF THE BASE TYPE.
+ 
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- H. TILTON 10/06/86
+ --      MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45613A IS
+  
+ BEGIN
+      TEST ("C45613A","CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED BY ""**"" FOR INTEGERS WHEN THE " &
+                      "RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
+ 
+      DECLARE
+           INT : INTEGER;
+      BEGIN
+           INT := IDENT_INT(INTEGER'LAST ** IDENT_INT(2));
+           FAILED ("NO EXCEPTION FOR SECOND POWER OF INTEGER'LAST");
+              
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS => 
+                     FAILED ("WRONG EXCEPTION RAISED FOR " &
+                             "SECOND POWER OF " &
+                             "INTEGER'LAST");
+      END;
+ 
+      DECLARE
+           INT : INTEGER;
+      BEGIN
+           INT := IDENT_INT(INTEGER'FIRST ** IDENT_INT(3));
+           FAILED ("NO EXCEPTION FOR THIRD POWER OF INTEGER'FIRST");
+                
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR " &
+                             "THIRD POWER OF " &
+                             "INTEGER'FIRST");
+             
+      END;
+ 
+      RESULT;
+    
+ END C45613A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45613b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45613b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45613b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45613b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C45613B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED
+ --     BY "**" FOR SHORT_INTEGER WHEN THE RESULT EXCEEDS THE RANGE
+ --     OF THE BASE TYPE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     HTG 10/06/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45613B IS
+ 
+     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+ 
+     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+ 
+ BEGIN
+      TEST ("C45613B","CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED BY ""**"" FOR SHORT_INTEGER WHEN " &
+                      "THE RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
+ 
+      DECLARE
+           INT : SHORT_INTEGER;
+      BEGIN
+           INT := IDENT(SHORT_INTEGER'LAST ** IDENT_INT(2));
+                  FAILED ("NO EXCEPTION FOR SECOND POWER OF " &
+                          "SHORT_INTEGER'LAST");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR " &
+                             "SECOND POWER OF " &
+                             "SHORT_INTEGER'LAST");
+      END;
+ 
+      DECLARE
+           INT : SHORT_INTEGER;
+      BEGIN
+           INT := IDENT(SHORT_INTEGER'FIRST ** IDENT_INT(3));
+           FAILED ("NO EXCEPTION FOR THIRD POWER OF " &
+                   "SHORT_INTEGER'FIRST");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR " &
+                             "THIRD POWER OF " &
+                             "SHORT_INTEGER'FIRST");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45613B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45613c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45613c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45613c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45613c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C45613C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED
+ --     BY "**" FOR LONG_INTEGER WHEN THE RESULT EXCEEDS THE RANGE
+ --     OF THE BASE TYPE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     LONG_INTEGER.
+ 
+ --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_LONG" MUST BE REJECTED.
+ 
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     HTG 10/06/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ --     MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45613C IS
+ 
+      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+ 
+      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C45613C","CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED BY ""**"" FOR LONG_INTEGER WHEN " &
+                      "THE RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
+ 
+      DECLARE
+           INT : LONG_INTEGER;
+      BEGIN
+           INT := IDENT(LONG_INTEGER'LAST ** IDENT_INT(2));
+           FAILED ("NO EXCEPTION FOR SECOND POWER OF " &
+                   "LONG_INTEGER'LAST");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR " &
+                             "SECOND POWER OF " &
+                             "LONG_INTEGER'LAST");
+      END;
+ 
+      DECLARE
+           INT : LONG_INTEGER;
+      BEGIN
+           INT := IDENT(LONG_INTEGER'FIRST ** IDENT_INT(3));
+                  FAILED ("NO EXCEPTION FOR THIRD POWER OF " &
+                          "LONG_INTEGER'FIRST");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR " &
+                             "THIRD POWER OF " &
+                             "LONG_INTEGER'FIRST");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45613C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45614a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45614a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45614a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45614a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C45614A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE EXPONENT VALUE IN 
+ -- AN INTEGER EXPONENTIATION IS NEGATIVE.
+ -- CHECK BOTH STATIC AND NONSTATIC EXPONENT VALUES.
+ 
+ -- AH  9/29/86
+ -- EDS 7/15/98    AVOID OPTIMIZATION
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45614A IS
+      INT : INTEGER :=1;
+      RES : INTEGER :=0;
+ BEGIN
+      TEST ("C45614A", "CONSTRAINT_ERROR IS RAISED FOR INTEGERS " & 
+                       "HAVING A NEGATIVE EXPONENT");
+ 
+      DECLARE
+           E1 : CONSTANT INTEGER := -5;
+      BEGIN
+           RES := INT ** E1;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - E1A " &
+                    INTEGER'IMAGE(RES));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - E1B");
+      END;
+ 
+      DECLARE
+           E2 : INTEGER := 5;
+      BEGIN
+           RES := INT ** (-E2);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - E2A " &
+                   INTEGER'IMAGE(RES));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - E2B");
+      END;
+ 
+      DECLARE
+           E3 : INTEGER;
+      BEGIN
+           E3 := IDENT_INT(-5);
+           RES := INT ** E3;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - E3A " &
+                   INTEGER'IMAGE(RES));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - E3B");
+      END;
+ 
+      DECLARE
+      BEGIN
+           RES := INT ** IDENT_INT(-5);
+           FAILED ("CONSTRAINT_ERROR NOT RAISED - E4A " &
+                   INTEGER'IMAGE(RES));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - E4B");
+      END;
+ 
+      RES := IDENT_INT(2);
+      RES := IDENT_INT(RES);
+      RESULT;
+ END C45614A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45614b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45614b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45614b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45614b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ --  C45614B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY PREDEFINED SHORT_INTEGER
+ --     "**" IF THE SECOND OPERAND HAS A NEGATIVE VALUE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     HTG 10/07/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45614B IS
+ 
+      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+ 
+      FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ("C45614B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                       "PREDEFINED SHORT_INTEGER ""**"" IF THE " &
+                       "SECOND OPERAND HAS A NEGATIVE VALUE");
+ 
+      DECLARE
+           A : INTEGER := -2;
+           B : SHORT_INTEGER := 3;
+           INT : SHORT_INTEGER := 0;
+      BEGIN
+           INT := IDENT(B ** IDENT_INT(A));
+           FAILED ("NO EXCEPTION FOR '3**(-2)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '3**(-2)'");
+      END;
+ 
+      DECLARE
+           A : INTEGER := -3;
+           B : SHORT_INTEGER := -5;
+           INT : SHORT_INTEGER := 0;
+      BEGIN
+           INT := IDENT(B ** IDENT_INT(A));
+           FAILED ("NO EXCEPTION FOR '(-5)**(-3)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '(-5)**(-3)'");
+      END;
+ 
+      DECLARE
+           B : SHORT_INTEGER := 0;
+           INT : SHORT_INTEGER := 0;
+      BEGIN
+           INT := IDENT(B ** IDENT_INT(-3));
+           FAILED ("NO EXCEPTION FOR '0**(-3)");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '0**(-3)'");
+      END;
+ 
+      DECLARE
+           INT : SHORT_INTEGER := 0;
+      BEGIN
+           INT := IDENT(-10 ** IDENT_INT(-2));
+           FAILED ("NO EXCEPTION FOR '(-10)**(-2)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '(-10)**(-2)'");
+      END;
+ 
+      DECLARE
+           INT : SHORT_INTEGER := 0;
+      BEGIN
+           INT := IDENT(6 ** IDENT_INT(-4));
+           FAILED ("NO EXCEPTION FOR '6**(-4)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '6**(-4)'");
+      END;
+ 
+      RESULT;
+ 
+ END C45614B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45614c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45614c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45614c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45614c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C45614C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED BY PREDEFINED
+ --     LONG_INTEGER "**" IF THE SECOND OPERAND HAS A NEGATIVE
+ --     VALUE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     IN ORDER FOR THIS TEST TO BE NOT-APPLICABLE THE COMPILER
+ --     MUST REJECT THE USE OF "LONG_INTEGER" AS AN UNDECLARED
+ --     IDENTIFIER.
+ 
+ -- HISTORY:
+ --     HT  10/07/86  CREATED ORIGINAL TEST.
+ --     JET 08/06/87  REMOVED BUG FROM FUNCTION IDENT (X).
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45614C IS
+ 
+      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ("C45614C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                       "PREDEFINED LONG_INTEGER ""**"" IF THE SECOND " &
+                       "OPERAND HAS A NEGATIVE VALUE");
+ 
+      DECLARE
+           A : INTEGER := -2;
+           B : LONG_INTEGER := 3;
+           INT : LONG_INTEGER := 0;
+      BEGIN
+           INT := IDENT(B ** IDENT_INT(A));
+           FAILED ("NO EXCEPTION FOR '3**(-2)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '3**(-2)'");
+      END;
+ 
+      DECLARE
+           A : INTEGER := -3;
+           B : LONG_INTEGER := -5;
+           INT : LONG_INTEGER := 0;
+      BEGIN
+           INT := IDENT(B ** IDENT_INT(A));
+           FAILED ("NO EXCEPTION FOR '(-5)**(-3)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '(-5)**(-3)'");
+      END;
+ 
+      DECLARE
+           B : LONG_INTEGER := 0;
+           INT : LONG_INTEGER := 0;
+      BEGIN
+           INT := IDENT(B ** IDENT_INT(-3));
+           FAILED ("NO EXCEPTION FOR '0**(-3)");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '0**(-3)'");
+      END;
+ 
+      DECLARE
+           INT : LONG_INTEGER := 0;
+      BEGIN
+           INT := IDENT(-10 ** IDENT_INT(-2));
+           FAILED ("NO EXCEPTION FOR '(-10)**(-2)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '(-10)**(-2)'");
+      END;
+ 
+      DECLARE
+           INT : LONG_INTEGER := 0;
+      BEGIN
+           INT := IDENT(6 ** IDENT_INT(-4));
+           FAILED ("NO EXCEPTION FOR '6**(-4)'");
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED FOR '6**(-4)'");
+      END;
+ 
+      RESULT;
+ 
+ END C45614C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45631a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45631a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45631a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45631a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C45631A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR TYPE INTEGER 'ABS A' EQUALS A IF A IS POSITIVE AND 
+ -- EQUALS -A IF A IS NEGATIVE.
+ 
+ -- RJW 2/10/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45631A IS
+      
+ BEGIN
+ 
+      TEST ( "C45631A", "CHECK THAT FOR TYPE INTEGER 'ABS A' " &
+                        "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " & 
+                        "A IS NEGATIVE" );
+ 
+      DECLARE 
+      
+           P : INTEGER := IDENT_INT (1);
+           N : INTEGER := IDENT_INT (-1);
+           Z : INTEGER := IDENT_INT (0);
+      BEGIN 
+ 
+           IF ABS P = P THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR P - 1" );
+           END IF;
+ 
+           IF ABS N = -N THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR N - 1" );
+           END IF;
+ 
+           IF ABS Z = Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS TEST FOR Z - 1" );
+           END IF;
+ 
+           IF ABS (Z) = -Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS TEST FOR Z - 2");
+           END IF;
+ 
+           IF "ABS" (RIGHT => P) = P THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR P - 2" );
+           END IF;
+ 
+           IF "ABS" (N) = -N THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR N - 2 " );
+           END IF;
+ 
+           IF "ABS" (Z) = Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR Z - 3" );
+           END IF;
+          
+           IF ABS (IDENT_INT (-INTEGER'LAST)) = INTEGER'LAST THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR -INTEGER'LAST" );
+           END IF;
+      END; 
+ 
+      RESULT;
+ 
+ END C45631A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45631b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45631b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45631b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45631b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C45631B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR TYPE SHORT_INTEGER 'ABS A' EQUALS A IF A IS
+ --     POSITIVE AND EQUALS -A IF A IS NEGATIVE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     SHORT_INTEGER.
+ 
+ --     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_SHORT" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 02/26/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45631B IS
+ 
+      CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+ 
+      FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ( "C45631B", "CHECK THAT FOR TYPE SHORT_INTEGER 'ABS A' " &
+                        "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " &
+                        "A IS NEGATIVE" );
+ 
+      DECLARE
+ 
+           P : SHORT_INTEGER := IDENT (1);
+           N : SHORT_INTEGER := IDENT (-1);
+           Z : SHORT_INTEGER := IDENT (0);
+      BEGIN
+ 
+           IF ABS P = P THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR P - 1" );
+           END IF;
+ 
+           IF ABS N = -N THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR N - 1" );
+           END IF;
+ 
+           IF ABS Z = Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS TEST FOR Z - 1" );
+           END IF;
+ 
+           IF ABS (Z) = -Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS TEST FOR Z - 2");
+           END IF;
+ 
+           IF "ABS" (RIGHT => P) = P THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR P - 2" );
+           END IF;
+ 
+           IF "ABS" (N) = -N THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR N - 2 " );
+           END IF;
+ 
+           IF "ABS" (Z) = Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR Z - 3" );
+           END IF;
+ 
+           IF ABS (IDENT (-SHORT_INTEGER'LAST)) = SHORT_INTEGER'LAST
+              THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR -SHORT_INTEGER'LAST" );
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C45631B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45631c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45631c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45631c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45631c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- C45631C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR TYPE LONG_INTEGER 'ABS A' EQUALS A IF A IS
+ --     POSITIVE AND EQUALS -A IF A IS NEGATIVE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+ --     LONG_INTEGER.
+ 
+ --     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+ --     "CHECK_LONG" MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RJW 02/26/86 CREATED ORIGINAL TEST.
+ --     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45631C IS
+ 
+      CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+ 
+      FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           IF X >= LONG_INTEGER (INTEGER'FIRST) AND
+              X <= LONG_INTEGER (INTEGER'LAST) THEN
+                RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+           ELSIF EQUAL (3, 3) THEN
+                RETURN X;
+           END IF;
+           RETURN 0;
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ( "C45631C", "CHECK THAT FOR TYPE LONG_INTEGER 'ABS A' " &
+                        "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " &
+                        "A IS NEGATIVE" );
+ 
+      DECLARE
+ 
+           P : LONG_INTEGER := IDENT (1);
+           N : LONG_INTEGER := IDENT (-1);
+           Z : LONG_INTEGER := IDENT (0);
+      BEGIN
+ 
+           IF ABS P = P THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR P - 1" );
+           END IF;
+ 
+           IF ABS N = -N THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR N - 1" );
+           END IF;
+ 
+           IF ABS Z = Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS TEST FOR Z - 1" );
+           END IF;
+ 
+           IF ABS (Z) = -Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS TEST FOR Z - 2");
+           END IF;
+ 
+           IF "ABS" (RIGHT => P) = P THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR P - 2" );
+           END IF;
+ 
+           IF "ABS" (N) = -N THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR N - 2 " );
+           END IF;
+ 
+           IF "ABS" (Z) = Z THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR Z - 3" );
+           END IF;
+ 
+           IF ABS (IDENT (-LONG_INTEGER'LAST)) = LONG_INTEGER'LAST
+              THEN
+                NULL;
+           ELSE
+                FAILED ( "'ABS' TEST FOR -LONG_INTEGER'LAST" );
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C45631C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45632a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45632a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45632a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45632a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,76 ----
+ -- C45632A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR PREDEFINED TYPE INTEGER, CONSTRAINT_ERROR
+ --     IS RAISED FOR ABS (INTEGER'FIRST) IF
+ --     -INTEGER'LAST > INTEGER'FIRST.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     RJW 02/10/86  CREATED ORIGINAL TEST.
+ --     JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
+ --                   PREVENT OPTIMIZATION.
+ --     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45632A IS
+ 
+      I : INTEGER := IDENT_INT (INTEGER'FIRST);
+ 
+ BEGIN
+ 
+      TEST ( "C45632A", "CHECK THAT FOR PREDEFINED TYPE INTEGER " &
+                        "CONSTRAINT_ERROR IS RAISED " &
+                        "FOR ABS (INTEGER'FIRST) IF -INTEGER'LAST > " &
+                        "INTEGER'FIRST" );
+ 
+      BEGIN
+           IF - INTEGER'LAST > INTEGER'FIRST THEN
+                BEGIN
+                     IF EQUAL (ABS I, I) THEN
+                          NULL;
+                     ELSE
+                          FAILED ( "WRONG RESULT FOR ABS" );
+                     END IF;
+                     FAILED ( "EXCEPTION NOT RAISED" );
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          COMMENT ( "CONSTRAINT_ERROR RAISED" );
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED" );
+                END;
+           ELSE
+                COMMENT ( "-INTEGER'LAST <= INTEGER'FIRST" );
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C45632A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45632b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45632b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45632b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45632b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C45632B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR PREDEFINED TYPE SHORT_INTEGER,
+ --     CONSTRAINT_ERROR IS RAISED FOR ABS (SHORT_INTEGER'FIRST)
+ --     IF -SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+ --     THE PREDEFINED TYPE "SHORT_INTEGER".
+ 
+ --     IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF THE
+ --     VARIABLE "TEST_VAR" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     RJW 02/20/86  CREATED ORIGINAL TEST.
+ --     JET 12/30/87  UPDATED HEADER FORMAT, ADDED CODE TO DEFEAT
+ --                   OPTIMIZATION.
+ --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45632B IS
+ 
+      TEST_VAR : SHORT_INTEGER;               -- N/A => ERROR.
+      I : SHORT_INTEGER;
+ 
+      FUNCTION IDENT_SHORT (A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN A;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT_SHORT;
+ 
+ BEGIN
+ 
+      TEST ( "C45632B", "CHECK THAT FOR PREDEFINED TYPE " &
+                        "SHORT_INTEGER CONSTRAINT_ERROR IS RAISED FOR " &
+                        "ABS (SHORT_INTEGER'FIRST) IF " &
+                        "-SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST");
+ 
+      BEGIN
+           I := IDENT_SHORT (SHORT_INTEGER'FIRST);
+ 
+           IF -SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST THEN
+                BEGIN
+                     IF IDENT_SHORT (ABS I) = IDENT_SHORT (I) THEN
+                          FAILED ("NO EXCEPTION -- EQUALITY TRUE");
+                     ELSE
+                          FAILED ("NO EXCEPTION -- EQUALITY FALSE");
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          COMMENT ( "CONSTRAINT_ERROR RAISED" );
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED" );
+                END;
+           ELSE
+                COMMENT ( "-SHORT_INTEGER'LAST <= SHORT_INTEGER'FIRST");
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C45632B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45632c.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45632c.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45632c.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45632c.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C45632C.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR PREDEFINED TYPE LONG_INTEGER,
+ --     CONSTRAINT_ERROR IS RAISED FOR ABS (LONG_INTEGER'FIRST)
+ --     IF -LONG_INTEGER'LAST > LONG_INTEGER'FIRST.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+ --     THE USE OF "LONG_INTEGER" AS A PREDEFINED DATA TYPE.
+ 
+ --     IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF THE
+ --     VARIABLE "TEST_VAR" MUST BE REJECTED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     RJW 02/20/86  CREATED ORIGINAL TEST.
+ --     JET 12/30/87  UPDATED HEADER FORMAT, ADDED CODE TO DEFEAT
+ --                   OPTIMIZATION.
+ --     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C45632C IS
+ 
+      TEST_VAR : LONG_INTEGER;                  -- N/A => ERROR.
+ 
+      FUNCTION IDENT_LONG (A : LONG_INTEGER) RETURN LONG_INTEGER IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN A;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT_LONG;
+ 
+ BEGIN
+ 
+      TEST ( "C45632C", "CHECK THAT FOR PREDEFINED TYPE " &
+                        "LONG_INTEGER CONSTRAINT_ERROR IS RAISED FOR " &
+                        "ABS (LONG_INTEGER'FIRST) IF " &
+                        "-LONG_INTEGER'LAST > LONG_INTEGER'FIRST" );
+ 
+      BEGIN
+           IF - LONG_INTEGER'LAST > LONG_INTEGER'FIRST THEN
+                DECLARE
+                     I : LONG_INTEGER := IDENT_LONG(LONG_INTEGER'FIRST);
+                BEGIN
+                     IF IDENT_LONG(ABS I) = IDENT_LONG(I) THEN
+                          FAILED ("NO EXCEPTION -- EQUALITY TRUE");
+                     ELSE
+                          FAILED ("NO EXCEPTION -- EQUALITY FALSE");
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          COMMENT ( "CONSTRAINT_ERROR RAISED" );
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED" );
+                END;
+           ELSE
+                COMMENT ( "-LONG_INTEGER'LAST <= " &
+                          "LONG_INTEGER'FIRST" );
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C45632C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45651a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45651a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45651a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45651a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,246 ----
+ -- C45651A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR FIXED POINT TYPES, CHECK:
+ --          (A) FOR MODEL NUMBERS A >= 0.0, THAT ABS A = A.
+ --          (B) FOR MODEL NUMBERS A <= 0.0. THAT ABS A = -A.
+ --          (C) FOR NON-MODEL NUMBERS A > 0.0, THAT ABS A VALUES ARE
+ --              WITHIN THE APPROPRIATE MODEL INTERVAL.
+ --          (D) FOR NON-MODEL NUMBERS A < 0.0, THAT ABS A VALUES ARE
+ --              WITHIN THE APPROPRIATE MODEL INTERVAL.
+ 
+ --     CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF
+ --     DURATION'BASE.
+ 
+ -- HISTORY:
+ --     WRG 9/11/86
+ --     PWB 3/31/88  CHANGED RANGE FOR MEMBERSHIP TEST INVOLVING
+ --                  ABS (DECIMAL_M4'FIRST + DECIMAL_M4'SMALL / 2).
+ --     RJW 8/21/89  REMOVED CHECKS INVOLVING HARD-CODED FIXED-POINT
+ --                  UPPER BOUNDS WHICH WERE INCORRECT FOR SOME
+ --                  IMPLEMENTATIONS.  REVISED HEADER.
+ --     PWN 02/02/95 REMOVED INCONSISTENCIES WITH ADA 9X.
+ --     KAS 11/14/95 REMOVED CASES THAT DEPEND ON SPECIFIC VALUE FOR 'SMALL
+ --     TMB 11/19/94 REMOVED CASES RELATING TO 3.5.9(8) RULES - SMALL
+ --                  MAY BE LESS THAN OR EQUAL TO DELTA FOR FIXED POINT.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C45651A IS
+ 
+      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+      -- 'MANTISSA VALUE.
+ 
+ BEGIN
+ 
+      TEST ("C45651A", "CHECK THAT, FOR FIXED POINT TYPES, THE ABS " &
+                       "OPERATOR PRODUCES CORRECT RESULTS - BASIC " &
+                       "TYPES");
+ 
+      -------------------------------------------------------------------
+ 
+ A:   DECLARE
+           TYPE LIKE_DURATION_M23 IS DELTA 0.020
+                RANGE -86_400.0 .. 86_400.0;
+ 
+           NON_MODEL_CONST : CONSTANT          := 2.0 / 3;
+           NON_MODEL_VAR   : LIKE_DURATION_M23 := 0.0;
+ 
+           SMALL, MAX, MIN, ZERO : LIKE_DURATION_M23 := 0.5;
+           X                     : LIKE_DURATION_M23 := 1.0;
+      BEGIN
+           -- INITIALIZE "CONSTANTS":
+           IF EQUAL (3, 3) THEN
+                SMALL         := LIKE_DURATION_M23'SMALL;
+                MAX           := LIKE_DURATION_M23'LAST;
+                MIN           := LIKE_DURATION_M23'FIRST;
+                ZERO          := 0.0;
+                NON_MODEL_VAR := NON_MODEL_CONST;
+           END IF;
+ 
+           -- (A)
+           IF EQUAL (3, 3) THEN
+                X := SMALL;
+           END IF;
+           IF ABS X /= SMALL OR X /= ABS LIKE_DURATION_M23'SMALL THEN
+                FAILED ("ABS (1.0 / 64) /= (1.0 / 64)");
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := MAX;
+           END IF;
+           IF ABS X /= MAX OR X /= ABS LIKE_DURATION_M23'LAST THEN
+                FAILED ("ABS 86_400.0 /= 86_400.0");
+           END IF;
+ 
+           -- (B)
+           IF EQUAL (3, 3) THEN
+                X := -SMALL;
+           END IF;
+           IF ABS X /= SMALL OR
+              ABS (-LIKE_DURATION_M23'SMALL) /= SMALL THEN
+                FAILED ("ABS -(1.0 / 64) /= (1.0 / 64)");
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := MIN;
+           END IF;
+           IF ABS X /= MAX OR ABS LIKE_DURATION_M23'FIRST /= MAX THEN
+                FAILED ("ABS -86_400.0 /= 86_400.0");
+           END IF;
+ 
+           -- (A) AND (B)
+           IF EQUAL (3, 3) THEN
+                X := 0.0;
+           END IF;
+           IF "ABS" (RIGHT => X) /= ZERO OR X /= ABS 0.0 THEN
+                FAILED ("ABS 0.0 /= 0.0 -- (LIKE_DURATION_M23)");
+           END IF;
+ 
+           -- CHECK THAT VALUE OF NON_MODEL_VAR IS IN THE RANGE
+           -- 42 * 'SMALL .. 43 * 'SMALL:
+           IF NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 THEN
+                FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
+                        "- A");
+           END IF;
+ 
+           -- (C)
+           IF ABS NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 OR
+              ABS LIKE_DURATION_M23'(NON_MODEL_CONST) NOT IN
+                  0.65625 .. 0.671875 THEN
+                FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - A");
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := 86_399.992_187_5;  -- LIKE_DURATION_M23'LAST -
+                                        -- 1.0 / 128.
+           END IF;
+           IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
+              ABS (LIKE_DURATION_M23'LAST - LIKE_DURATION_M23'SMALL / 2)
+                  NOT IN 86_399.984_375 .. 86_400.0 THEN
+                FAILED ("ABS (LIKE_DURATION_M23'LAST - " &
+                        "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
+                        "RANGE");
+           END IF;
+ 
+           -- (D)
+           IF EQUAL (3, 3) THEN
+                X := -NON_MODEL_CONST;
+           END IF;
+           IF ABS X NOT IN 0.65625 .. 0.671875 OR
+              ABS (-LIKE_DURATION_M23'(NON_MODEL_CONST)) NOT IN
+                  0.65625 .. 0.671875 THEN
+                FAILED ("ABS (-2.0 / 3) NOT IN CORRECT RANGE - A");
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := -86_399.992_187_5;  -- LIKE_DURATION_M23'FIRST +
+                                         -- 1.0 / 128.
+           END IF;
+           IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
+              ABS (LIKE_DURATION_M23'FIRST + LIKE_DURATION_M23'SMALL / 2)
+                  NOT IN 86_399.984_375 .. 86_400.0 THEN
+                FAILED ("ABS (LIKE_DURATION_M23'FIRST +" &
+                        "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
+                        "RANGE");
+           END IF;
+      END A;
+ 
+      -------------------------------------------------------------------
+ 
+ B:   DECLARE
+           TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
+ 
+           NON_MODEL_CONST : CONSTANT   := 2.0 / 3;
+           NON_MODEL_VAR   : DECIMAL_M4 := 0.0;
+ 
+           SMALL, MAX, MIN, ZERO : DECIMAL_M4 := 128.0;
+           X                     : DECIMAL_M4 :=   0.0;
+      BEGIN
+           -- INITIALIZE "CONSTANTS":
+           IF EQUAL (3, 3) THEN
+                SMALL         :=  DECIMAL_M4'SMALL;
+                ZERO          :=  0.0;
+                NON_MODEL_VAR := NON_MODEL_CONST;
+           END IF;
+ 
+           -- (A)
+           IF EQUAL (3, 3) THEN
+                X := SMALL;
+           END IF;
+           IF ABS X /= SMALL OR X /= ABS DECIMAL_M4'SMALL THEN
+                FAILED ("ABS 64.0 /= 64.0");
+           END IF;
+ 
+           -- (B)
+           IF EQUAL (3, 3) THEN
+                X := -SMALL;
+           END IF;
+           IF ABS X /= SMALL OR ABS (-DECIMAL_M4'SMALL) /= SMALL THEN
+                FAILED ("ABS -64.0 /= 64.0");
+           END IF;
+ 
+           -- (A) AND (B)
+           IF EQUAL (3, 3) THEN
+                X := 0.0;
+           END IF;
+           IF ABS X /= ZERO OR X /= ABS 0.0 THEN
+                FAILED ("ABS 0.0 /= 0.0 -- (DECIMAL_M4)");
+           END IF;
+ 
+           -- CHECK THE VALUE OF NON_MODEL_VAR:
+           IF NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN
+                FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
+                        "- B");
+           END IF;
+ 
+           -- (C)
+           IF ABS NON_MODEL_VAR NOT IN 0.0 .. 64.0 OR
+              ABS DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 THEN
+                FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - B");
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := 37.0;  -- INTERVAL IS 0.0 .. 64.0.
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := 928.0;
+           END IF;
+ 
+           -- (D)
+           IF EQUAL (3, 3) THEN
+                X := -NON_MODEL_CONST;
+           END IF;
+           IF ABS X NOT IN 0.0 .. 64.0 OR
+              ABS (-DECIMAL_M4'(NON_MODEL_CONST)) NOT IN 0.0 .. 64.0 THEN
+                FAILED ("ABS -(2.0 / 3) NOT IN CORRECT RANGE - B");
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := -37.0;  -- INTERVAL IS -SMALL .. 0.0.
+           END IF;
+           IF EQUAL (3, 3) THEN
+                X := -928.0;
+           END IF;
+      END B;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ 
+ END C45651A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45662a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45662a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45662a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45662a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C45662A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THE TRUTH TABLE FOR  'NOT' .
+ 
+ -- THE COMBINATIONS OF  'NOT'  WITH  'AND' , 'OR' , 'XOR'  ARE TESTED
+ --    IN C45101(A,G).
+ 
+ 
+ -- RM    28 OCTOBER 1980
+ -- TBN 10/21/85     RENAMED FROM C45401A.ADA.
+ 
+ 
+ WITH  REPORT ;
+ PROCEDURE  C45662A  IS
+ 
+      USE REPORT;
+ 
+      TVAR , FVAR , CVAR : BOOLEAN := FALSE ; -- INITIAL VALUE IRRELEVANT
+      ERROR_COUNT : INTEGER := 0 ;            -- INITIAL VALUE ESSENTIAL
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT  :=  ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+ BEGIN
+ 
+      TEST( "C45662A" , "CHECK THE TRUTH TABLE FOR  'NOT'" ) ;
+ 
+      FOR  A  IN  BOOLEAN  LOOP
+ 
+           CVAR  :=  NOT A ;
+ 
+           IF  NOT A  THEN
+                IF  A  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+           IF  CVAR  THEN
+                IF  A  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+           IF  NOT( NOT( NOT( NOT(   CVAR   ))))
+           THEN
+                IF  A  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+      END LOOP ;
+ 
+      FOR  I  IN  1..2  LOOP
+ 
+           CVAR  :=  NOT ( I > 1 ) ;
+ 
+           IF  NOT ( I > 1 )  THEN
+                IF  I>1  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+           IF  CVAR  THEN
+                IF  I>1  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+      END LOOP ;
+ 
+      IF  NOT TRUE   THEN  BUMP ;                END IF ;
+      IF  NOT FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF ;
+ 
+      TVAR := IDENT_BOOL( TRUE );
+      FVAR := IDENT_BOOL( FALSE );
+ 
+      IF  NOT TVAR  THEN  BUMP ;                END IF ;
+      IF  NOT FVAR  THEN  NULL ;  ELSE  BUMP ;  END IF ;
+ 
+ 
+      IF  ERROR_COUNT  /= 0  THEN  FAILED( "'NOT' TRUTH TABLE" );
+      END IF ;
+ 
+      RESULT;
+ 
+ END C45662A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45662b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45662b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45662b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45662b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C45662B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THE TRUTH TABLE FOR  'NOT'  ON DERIVED-BOOLEAN-TYPE OPERANDS.
+ 
+ -- THE COMBINATIONS OF  'NOT'  WITH  'AND' , 'OR' , 'XOR'  ARE TESTED
+ --    IN C45101K.
+ 
+ 
+ -- RM    28 OCTOBER 1980
+ -- TBN 10/21/85     RENAMED FROM C45401B-AB.ADA.  REMOVED DUPLICATED
+ --                  CODE NEAR END.
+ 
+ WITH  REPORT; USE REPORT;
+ PROCEDURE  C45662B  IS
+ 
+      TYPE  NB  IS  NEW BOOLEAN ;
+ 
+      TVAR , FVAR , CVAR : NB := NB'(FALSE) ; -- INITIAL VALUE IRRELEVANT
+      ERROR_COUNT : INTEGER := 0 ;            -- INITIAL VALUE ESSENTIAL
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           ERROR_COUNT := ERROR_COUNT + 1 ;
+      END BUMP ;
+ 
+      FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
+      BEGIN
+           IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+           ELSE  RETURN  NB'(FALSE) ;
+           END IF;
+      END ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C45662B" , "CHECK THE TRUTH TABLE FOR  'NOT'" &
+                        " ON DERIVED-BOOLEAN-TYPE OPERANDS" ) ;
+ 
+      FOR  A  IN  NB  LOOP
+ 
+           CVAR  :=  NOT A ;
+ 
+           IF  BOOLEAN( NOT A )  THEN
+                IF  BOOLEAN( A )  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+           IF  BOOLEAN( CVAR )  THEN
+                IF  BOOLEAN( A )  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+           IF  BOOLEAN(
+ 
+               NOT( NOT( NOT( NOT( NOT(
+               NOT( NOT( NOT( NOT( NOT(
+               NOT( NOT( NOT( NOT( NOT(
+               NOT( NOT( NOT( NOT( NOT(   CVAR  ))))) ))))) ))))) )))))
+                       )
+           THEN
+                IF  BOOLEAN( A )  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+      END LOOP ;
+ 
+      FOR  I  IN  1..2  LOOP
+ 
+           CVAR  :=  NOT( NB( I > 1 ) ) ;
+ 
+           IF  BOOLEAN(  NOT(  NB( I > 1 )))  THEN
+                IF  I>1  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+           IF  BOOLEAN( CVAR )  THEN
+                IF  I>1  THEN  BUMP ;
+                END IF ;
+           END IF;
+ 
+      END LOOP ;
+ 
+      IF  BOOLEAN( NOT( NB'(TRUE ))) THEN  BUMP ;                END IF ;
+      IF  BOOLEAN( NOT( NB'(FALSE))) THEN  NULL ;  ELSE  BUMP ;  END IF ;
+ 
+ 
+      TVAR := IDENT_NEW_BOOL( NB'(TRUE ) );
+      FVAR := IDENT_NEW_BOOL( NB'(FALSE) );
+ 
+      IF  BOOLEAN( NOT TVAR )  THEN  BUMP ;                END IF ;
+      IF  BOOLEAN( NOT FVAR )  THEN  NULL ;  ELSE  BUMP ;  END IF ;
+ 
+      IF  ERROR_COUNT  /= 0  THEN  FAILED( "'NOT' TRUTH TABLE" );
+      END IF ;
+ 
+      RESULT;
+ 
+ END C45662B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45672a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45672a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c45672a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c45672a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C45672A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT "NOT" YIELDS THE CORRECT RESULTS WHEN APPLIED TO
+ -- ONE-DIMENSIONAL BOOLEAN ARRAYS.
+ 
+ -- JWC 11/15/85
+ 
+ WITH REPORT;USE REPORT;
+ 
+ PROCEDURE C45672A IS
+ BEGIN
+ 
+      TEST ("C45672A", "CHECK THE UNARY OPERATOR 'NOT' APPLIED TO " &
+                       "ONE-DIMENSIONAL BOOLEAN ARRAYS");
+ 
+      DECLARE
+ 
+           TYPE ARR1 IS ARRAY (INTEGER RANGE 1 .. 4) OF BOOLEAN;
+           TYPE ARR2 IS ARRAY (INTEGER RANGE 1 .. 40) OF BOOLEAN;
+           TYPE ARR3 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+           TYPE ARR4 IS ARRAY (INTEGER RANGE 1 .. 4) OF BOOLEAN;
+           TYPE ARR5 IS ARRAY (INTEGER RANGE 1 .. 40) OF BOOLEAN;
+ 
+           PRAGMA PACK (ARR4);
+           PRAGMA PACK (ARR5);
+ 
+           A1 : ARR1 := ARR1'(1 | 3 => TRUE, OTHERS => FALSE);
+           A2 : ARR2 := ARR2'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37 => TRUE,
+                              OTHERS => FALSE);
+           A3 : ARR3(IDENT_INT(3) .. IDENT_INT(4)) := ARR3'(TRUE, FALSE);
+           A4 : ARR4 := ARR4'(1 | 3 => TRUE, OTHERS => FALSE);
+           A5 : ARR5 := ARR5'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37 => TRUE,
+                              OTHERS => FALSE);
+           A6 : ARR3 (IDENT_INT(9) .. IDENT_INT(7));
+ 
+           PROCEDURE P (A : ARR3; F : INTEGER; L : INTEGER) IS
+           BEGIN
+                IF A'FIRST /= F OR A'LAST /= L THEN
+                     FAILED ("'NOT' YIELDED THE WRONG BOUNDS");
+                END IF;
+           END P;
+ 
+      BEGIN
+ 
+           P (NOT A3, 3, 4);
+           P (NOT A6, 9, 7);
+ 
+           IF NOT A1 /= ARR1'(1 | 3 => FALSE, OTHERS => TRUE) THEN
+                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                        "TO SMALL ARRAY");
+           END IF;
+ 
+           IF NOT A2 /= ARR2'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37
+                              => FALSE, OTHERS => TRUE) THEN
+                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                        "TO LARGE ARRAY");
+           END IF;
+ 
+           IF NOT A4 /= ARR4'(1 | 3 => FALSE, OTHERS => TRUE) THEN
+                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                        "TO SMALL PACKED ARRAY");
+           END IF;
+ 
+           IF NOT A5 /= ARR5'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37
+                              => FALSE, OTHERS => TRUE) THEN
+                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                        "TO LARGE PACKED ARRAY");
+           END IF;
+ 
+           IF "NOT" (RIGHT => A1) /= ARR1'(1 | 3 => FALSE,
+                                           OTHERS => TRUE) THEN
+                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                        "TO SMALL ARRAY USING NAMED NOTATION");
+           END IF;
+ 
+           IF "NOT" (RIGHT => A5) /= ARR5'(1 | 14 .. 18 | 30 .. 33 |
+                                           35 .. 37 => FALSE,
+                                           OTHERS => TRUE) THEN
+                FAILED ("WRONG RESULT WHEN 'NOT' APPLIED TO LARGE " &
+                        "PACKED ARRAY USING NAMED NOTATION");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C45672A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,300 ----
+ -- C460001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the target type of a type conversion is a general
+ --      access type, Program_Error is raised if the accessibility level
+ --      of the operand type is deeper than that of the target type.
+ --      Check for the case where the operand is an access parameter.
+ --      
+ --      Check for cases where the actual corresponding to the access
+ --      parameter is:
+ --         (a) An allocator.
+ --         (b) An expression of a named access type.
+ --         (c) Obj'Access.
+ --      
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the operand type
+ --      must be at the same or a less deep nesting level than the target
+ --      type -- the operand type must "live" as long as the target type.
+ --      Nesting levels are the run-time nestings of masters: block statements;
+ --      subprogram, task, and entry bodies; and accept statements. Packages
+ --      are invisible to accessibility rules.
+ --
+ --      This test declares subprograms with access parameters, within which
+ --      a type conversion is attempted on the access parameter to an access
+ --      type A declared at some nesting level. The test verifies that
+ --      Program_Error is raised if the actual corresponding to the access
+ --      parameter is:
+ --
+ --         (1) an allocator, and the accessibility level of the execution
+ --             of the called subprogram is deeper than that of the access
+ --             type A. 
+ --
+ --         (2) an expression of a named access type, and the accessibility
+ --             level of the named access type is deeper than that of the
+ --             access type A. 
+ --
+ --         (3) a reference to the Access attribute (e.g., X'Access), and
+ --             the accessibility level of X is deeper than that of the
+ --             access type A. 
+ --
+ --      Note that the static nesting level of the actual corresponding to the
+ --      access parameter can be deeper than that of the target type -- it is
+ --      the run-time nesting that matters for accessibility rules. Consider
+ --      the case where the access type A is declared within the called
+ --      subprogram. The accessibility check will never fail, even if the
+ --      actual happens to have a deeper static nesting level:
+ --
+ --         procedure P (X: access T) is
+ --            type A is access all T;   -- Static level = 2, e.g.
+ --            Acc : A := A(X);          -- Check should never fail.
+ --         begin null; end;
+ --         . . .
+ --         declare
+ --            Actual : aliased T;       -- Static level = 3, e.g.
+ --         begin
+ --            P (Actual'Access);
+ --         end;
+ --
+ --         For the execution of P, the accessibility level of type A will
+ --         always be deeper than that of Actual, so there is no danger of a
+ --         dangling reference arising from the assignment to Acc. Thus, the
+ --         type conversion is safe, even though the static nesting level of
+ --         Actual is deeper than that of A.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C460001_0 is
+ 
+    type Desig is array (1 .. 10) of Integer;
+ 
+    X0 : aliased Desig;                                            -- Level = 0.
+ 
+    type Acc_L0 is access all Desig;                               -- Level = 0.
+    A0 : Acc_L0;
+ 
+    type Result_Kind is (OK, P_E, O_E);
+ 
+    procedure Target_Is_Level_0 (X: access Desig; R : out Result_Kind);
+    procedure Never_Fails       (X: access Desig; R : out Result_Kind);
+ 
+ end C460001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460001_0 is
+ 
+    procedure Target_Is_Level_0 (X : access Desig;
+                                 R : out Result_Kind) is
+    begin
+       -- The accessibility level of type Acc_L0 is 0.
+       A0 := Acc_L0(X);
+       R  := OK;
+    exception
+       when Program_Error =>    
+          R := P_E;
+       when others        =>    
+          R := O_E;
+    end Target_Is_Level_0;
+ 
+    -----------------------------------------------
+    procedure Never_Fails (X: access Desig;
+                           R : out Result_Kind) is
+       type Acc_Local is access all Desig;
+       AL : Acc_Local;
+    begin
+       -- The type conversion below will always be safe, since the
+       -- accessibility level (although not necessarily the static nesting
+       -- depth) of Acc_Local will always be deeper than or the same as that 
+       -- of the actual corresponding to X. 
+       AL := Acc_Local(X);
+       R  := OK;
+    exception
+       when Program_Error =>    
+          R := P_E;
+       when others        =>    
+          R := O_E;
+    end Never_Fails;
+ 
+ end C460001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C460001_0;
+ with Report;
+ 
+ procedure C460001 is
+ 
+    X1 : aliased C460001_0.Desig;                                  -- Level = 1.
+ 
+    type Acc_L1 is access all C460001_0.Desig;                     -- Level = 1.
+    A1 : Acc_L1;
+ 
+    Expr_L0 : C460001_0.Acc_L0 := C460001_0.X0'Access;
+    Expr_L1 : Acc_L1           := X1'Access;
+ 
+    Res : C460001_0.Result_Kind;
+ 
+    use type C460001_0.Result_Kind;
+ 
+    -----------------------------------------------
+    procedure Target_Is_Level_1 (X : access C460001_0.Desig;
+                                 R : out C460001_0.Result_Kind) is
+    begin
+       -- The accessibility level of type Acc_L1 is 1.
+       A1 := Acc_L1(X);
+       R  := C460001_0.OK;
+    exception
+       when Program_Error =>    
+          R := C460001_0.P_E;
+       when others        =>    
+          R := C460001_0.O_E;
+    end Target_Is_Level_1;
+ 
+    -----------------------------------------------
+    procedure Display_Results (Result  : in C460001_0.Result_Kind;
+                               Expected: in C460001_0.Result_Kind;
+                               Message : in String) is
+    begin
+       if Result /= Expected then
+          case Result is
+             when C460001_0.OK  => Report.Failed ("No exception raised: "  & 
+                                                  Message);
+             when C460001_0.P_E => Report.Failed ("Program_Error raised: " & 
+                                                  Message);
+             when C460001_0.O_E => Report.Failed ("Unexpected exception "  &
+                                                  "raised: " & Message);
+          end case;
+       end if;
+    end Display_Results;
+ 
+ begin -- C460001
+ 
+    Report.Test ("C460001", "Check that if the target type of a type "      &
+                 "conversion is a general access type, Program_Error is "   &
+                 "raised if the accessibility level of the operand type "   &
+                 "is deeper than that of the target type: operand is an "   &
+                 "access parameter; corresponding actual is an allocator, " &
+                 "expression of a named access type, Obj'Access");
+ 
+ 
+    -- Actual is X'Access:
+ 
+    C460001_0.Never_Fails (X1'Access, Res);
+    Display_Results (Res, C460001_0.OK, "X1'Access, local access type");
+ 
+    C460001_0.Target_Is_Level_0 (X1'Access, Res);
+    Display_Results (Res, C460001_0.P_E, "X1'Access, level 0 access type");
+ 
+    Target_Is_Level_1 (C460001_0.X0'Access, Res);
+    Display_Results (Res, C460001_0.OK, "X0'Access, level 1 access type");
+ 
+    Target_Is_Level_1 (X1'Access, Res);
+    Display_Results (Res, C460001_0.OK, "X1'Access, level 1 access type");
+ 
+    C460001_0.Target_Is_Level_0 (C460001_0.X0'Access, Res);
+    Display_Results (Res, C460001_0.OK, "X0'Access, level 0 access type");
+ 
+ 
+    -- Actual is expression of a named access type:
+ 
+    C460001_0.Never_Fails (Expr_L0, Res);
+    Display_Results (Res, C460001_0.OK, "Expr_L0, local access type");
+ 
+    C460001_0.Target_Is_Level_0 (Expr_L0, Res);
+    Display_Results (Res, C460001_0.OK, "Expr_L0, level 0 access type");
+ 
+    C460001_0.Target_Is_Level_0 (Expr_L1, Res);
+    Display_Results (Res, C460001_0.P_E, "Expr_L1, level 0 access type");
+ 
+    Target_Is_Level_1 (Expr_L1, Res);
+    Display_Results (Res, C460001_0.OK, "Expr_L1, level 1 access type");
+ 
+    Target_Is_Level_1 (Expr_L0, Res);
+    Display_Results (Res, C460001_0.OK, "Expr_L0, level 1 access type");
+ 
+    -- Actual is allocator (level of execution = 2):
+ 
+    C460001_0.Never_Fails (new C460001_0.Desig, Res);
+    Display_Results (Res, C460001_0.OK, "Allocator level 2, " &
+                                        "local access type");
+ 
+    C460001_0.Target_Is_Level_0 (new C460001_0.Desig, Res);
+    Display_Results (Res, C460001_0.P_E, "Allocator level 2, " &
+                                         "level 0 access type");
+ 
+    Target_Is_Level_1 (new C460001_0.Desig, Res);
+    Display_Results (Res, C460001_0.P_E, "Allocator level 2, " &
+                                         "level 1 access type");
+ 
+ 
+    Block_L2:
+    declare
+       X2 : aliased C460001_0.Desig;                               -- Level = 2.
+       type Acc_L2 is access all C460001_0.Desig;                  -- Level = 2.
+       Expr_L2 : Acc_L2 := X1'Access;
+    begin
+ 
+       -- Actual is X'Access:
+ 
+       C460001_0.Never_Fails (X2'Access, Res);
+       Display_Results (Res, C460001_0.OK, "X2'Access, local access type");
+ 
+       Target_Is_Level_1 (X2'Access, Res);
+       Display_Results (Res, C460001_0.P_E, "X2'Access, level 1 access type");
+ 
+       -- Actual is expression of a named access type:
+ 
+       C460001_0.Never_Fails (Expr_L2, Res);
+       Display_Results (Res, C460001_0.OK, "Expr_L2, local access type");
+ 
+       C460001_0.Target_Is_Level_0 (Expr_L2, Res);
+       Display_Results (Res, C460001_0.P_E, "Expr_L2, level 0 access type");
+ 
+ 
+       -- Actual is allocator (level of execution = 3):
+ 
+       C460001_0.Never_Fails (new C460001_0.Desig, Res);
+       Display_Results (Res, C460001_0.OK, "Allocator level 3, " &
+                                           "local access type");
+ 
+       Target_Is_Level_1 (new C460001_0.Desig, Res);
+       Display_Results (Res, C460001_0.P_E, "Allocator level 3, " &
+                                            "level 1 access type");
+ 
+    end Block_L2;
+ 
+    Report.Result;
+ 
+ end C460001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,330 ----
+ -- C460002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the target type of a type conversion is a general
+ --      access type, Program_Error is raised if the accessibility level
+ --      of the operand type is deeper than that of the target type.
+ --      Check for the case where the operand is an access parameter,
+ --      and the actual corresponding to the access parameter is another
+ --      access parameter.
+ --
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the operand type
+ --      must be at the same or a less deep nesting level than the target
+ --      type -- the operand type must "live" as long as the target type.
+ --      Nesting levels are the run-time nestings of masters: block statements;
+ --      subprogram, task, and entry bodies; and accept statements. Packages
+ --      are invisible to accessibility rules.
+ --
+ --      This test declares subprograms with access parameters, within which
+ --      a type conversion is attempted on the access parameter to an access
+ --      type A declared at some nesting level. The test verifies that
+ --      Program_Error is raised if the actual corresponding to the access
+ --      parameter is another access parameter, and the actual corresponding
+ --      to this second access parameter is:
+ --
+ --         (1) an expression of a named access type, and the accessibility
+ --             level of the named access type is deeper than that of the
+ --             access type A.
+ --
+ --         (2) a reference to the Access attribute (e.g., X'Access), and
+ --             the accessibility level of X is deeper than that of the
+ --             access type A.
+ --
+ --      Note that the static nesting level of the actual corresponding to the
+ --      access parameter can be deeper than that of the target type -- it is
+ --      the run-time nesting that matters for accessibility rules. Consider
+ --      the case where the access type A is declared within the called
+ --      subprogram. The accessibility check will never fail, even if the
+ --      actual happens to have a deeper static nesting level:
+ --
+ --         procedure P (X: access T) is
+ --            type A is access all T;   -- Static level = 2, e.g.
+ --            Acc : A := A(X);          -- Check should never fail.
+ --         begin null; end;
+ --         . . .
+ --         procedure Q (Y: access T) is
+ --         begin
+ --            P(Y);
+ --         end;
+ --         . . .
+ --         declare
+ --            Actual : aliased T;       -- Static level = 3, e.g.
+ --         begin
+ --            Q (Actual'Access);
+ --         end;
+ --
+ --         For the execution of Q (and hence P), the accessibility level of
+ --         type A will always be deeper than that of Actual, so there is no
+ --         danger of a dangling reference arising from the assignment to
+ --         Acc. Thus, the type conversion is safe, even though the static
+ --         nesting level of Actual is deeper than that of A.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Changed maintenance documentation.
+ --      15 Jul 98   EDS     Avoid Optimization
+ --      28 Jun 02   RLB     Added pragma Elaborate_All.
+ --!
+ 
+ with Report; use Report; pragma Elaborate_All (Report);
+ package C460002_0 is
+ 
+    type Component is array (1 .. 10) of Natural;
+ 
+    type Desig is record
+       C: Component;
+    end record;
+ 
+    X0 : aliased Desig := (C=>(others => Ident_Int(3)));    -- Level = 0.
+ 
+    type Acc_L0 is access all Desig;                               -- Level = 0.
+    A0 : Acc_L0;
+ 
+    type Result_Kind is (OK, P_E, O_E);
+ 
+    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind);
+    procedure Never_Fails_Nest       (Y: access Desig; S: out Result_Kind);
+    procedure Never_Fails_Same       (Y: access Desig; S: out Result_Kind);
+ 
+ end C460002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460002_0 is
+ 
+    procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind) is
+ 
+       procedure Nested (X: access Desig; R: out Result_Kind) is
+       -- This procedure attempts a type conversion on the access parameter to
+       -- an access type declared at some nesting level.  Program_Error is
+       -- raised if the accessibility level of the operand type is deeper than
+       -- that of the target type.
+ 
+       begin
+          -- The accessibility level of type Acc_L0 is 0.
+          A0 := Acc_L0(X);
+          R  := OK;
+       exception
+          when Program_Error =>
+             R := P_E;
+          when others        =>
+             R := O_E;
+       end Nested;
+ 
+    begin
+       Nested (Y, S);
+    end Target_Is_Level_0_Nest;
+ 
+    -------------------------------------------------------------
+ 
+    procedure Never_Fails_Nest (Y: access Desig; S: out Result_Kind) is
+ 
+       type Acc_Deeper is access all Desig;
+       AD : Acc_Deeper;
+ 
+       function Nested (X: access Desig) return Result_Kind is
+       begin
+          -- The type conversion below will always be safe, since the
+          -- accessibility level (although not necessarily the static nesting
+          -- depth) of Acc_Deeper will always be deeper than or the same as that
+          -- of the actual corresponding to Y.
+          AD := Acc_Deeper(X);
+          if Natural(Ident_Int(AD.C(1))) /= 3 then            --Avoid Optimization of AD
+            Report.Failed ("Initial Values not correct.");
+          end if;
+          return OK;
+       exception
+          when Program_Error =>
+             return P_E;
+          when others        =>
+             return O_E;
+       end Nested;
+ 
+    begin
+       S := Nested (Y);
+    end Never_Fails_Nest;
+ 
+    -------------------------------------------------------------
+ 
+    procedure Called_By_Never_Fails_Same
+      (X: access Desig; R: out Result_Kind) is
+       type Acc_Local is access all Desig;
+       AL : Acc_Local;
+    begin
+       -- The type conversion below will always be safe, since the
+       -- accessibility level (although not necessarily the static nesting
+       -- depth) of Acc_Local will always be deeper than or the same as that
+       -- of the actual corresponding to X.
+       AL := Acc_Local(X);
+       if Natural(Ident_Int(AL.C(1))) /= 3 then       --Avoid Optimization of AL
+         Report.Failed ("Initial Values not correct.");
+       end if;
+       R  := OK;
+    exception
+       when Program_Error =>
+          R := P_E;
+       when others        =>
+          R := O_E;
+    end Called_By_Never_Fails_Same;
+ 
+    -------------------------------------------------------------
+ 
+    procedure Never_Fails_Same (Y: access Desig; S: out Result_Kind) is
+    begin
+       Called_By_Never_Fails_Same (Y, S);
+    end Never_Fails_Same;
+ 
+ end C460002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C460002_0;
+ use  C460002_0;
+ 
+ with Report; use Report;
+ 
+ procedure C460002 is
+ 
+    type Acc_L1 is access all Desig;                               -- Level = 1.
+    A1 : Acc_L1;
+    X1 : aliased Desig := (C=>(others => Ident_Int(3)));
+    Res : Result_Kind;
+ 
+ 
+ 
+    procedure Called_By_Target_L1 (X: access Desig; R: out Result_Kind) is
+    begin
+       -- The accessibility level of type Acc_L1 is 1.
+       A1 := Acc_L1(X);
+       if Natural(Ident_Int(A1.C(1))) /= 3 then       --Avoid Optimization of A1
+         Report.Failed ("Initial Values not correct.");
+       end if;
+       R  := OK;
+    exception
+       when Program_Error =>
+          R := P_E;
+       when others        =>
+          R := O_E;
+    end Called_By_Target_L1;
+ 
+    -------------------------------------------------------------
+ 
+    function Target_Is_Level_1_Same (Y: access Desig) return Result_Kind is
+       S : Result_Kind;
+    begin
+       Called_By_Target_L1 (Y, S);
+       return S;
+    end Target_Is_Level_1_Same;
+ 
+    -------------------------------------------------------------
+ 
+    procedure Display_Results (Result  : in Result_Kind;
+                               Expected: in Result_Kind;
+                               Msg     : in String) is
+    begin
+       if Result /= Expected then
+          case Result is
+             when OK  => Report.Failed ("No exception raised: "         & Msg);
+             when P_E => Report.Failed ("Program_Error raised: "        & Msg);
+             when O_E => Report.Failed ("Unexpected exception raised: " & Msg);
+          end case;
+       end if;
+    end Display_Results;
+ 
+ begin -- C460002.
+ 
+    Report.Test ("C460002", "Check that if the target type of a type "      &
+                 "conversion is a general access type, Program_Error is "   &
+                 "raised if the accessibility level of the operand type "   &
+                 "is deeper than that of the target type: operand is an "   &
+                 "access parameter; corresponding actual is another "       &
+                 "access parameter");
+ 
+ 
+    -- Accessibility level of actual is 0 (actual is X'Access):
+ 
+    Never_Fails_Same (X0'Access, Res);
+    Display_Results (Res, OK, "Never_Fails_Same, level 0 actual");
+ 
+    Never_Fails_Nest (X0'Access, Res);
+    Display_Results (Res, OK, "Target_L1_Nest, level 0 actual");
+ 
+    Target_Is_Level_0_Nest (X0'Access, Res);
+    Display_Results (Res, OK, "Target_L0_Nest, level 0 actual");
+ 
+    Res := Target_Is_Level_1_Same (X0'Access);
+    Display_Results (Res, OK, "Target_L1_Same, level 0 actual");
+ 
+ 
+    -- Accessibility level of actual is 1 (actual is X'Access):
+ 
+    Never_Fails_Same (X1'Access, Res);
+    Display_Results (Res, OK, "Never_Fails_Same, level 1 actual");
+ 
+    Never_Fails_Nest (X1'Access, Res);
+    Display_Results (Res, OK, "Target_L1_Nest, level 1 actual");
+ 
+    Target_Is_Level_0_Nest (X1'Access, Res);
+    Display_Results (Res, P_E, "Target_L0_Nest, level 1 actual");
+ 
+    Res := Target_Is_Level_1_Same (X1'Access);
+    Display_Results (Res, OK, "Target_L1_Same, level 1 actual");
+ 
+ 
+    Block_L2:
+    declare
+       X2 : aliased Desig := (C=>(others => Ident_Int(3)));
+       type Acc_L2 is access all Desig;                            -- Level = 2.
+       Expr_L2 : Acc_L2 := X2'Access;
+    begin
+ 
+       -- Accessibility level of actual is 2 (actual is expression of named
+       -- access type):
+ 
+       Never_Fails_Same (Expr_L2, Res);
+       Display_Results (Res, OK, "Never_Fails_Same, level 2 actual");
+ 
+       Never_Fails_Nest (Expr_L2, Res);
+       Display_Results (Res, OK, "Target_L1_Nest, level 2 actual");
+ 
+       Target_Is_Level_0_Nest (Expr_L2, Res);
+       Display_Results (Res, P_E, "Target_L0_Nest, level 2 actual");
+ 
+       Res := Target_Is_Level_1_Same (Expr_L2);
+       Display_Results (Res, P_E, "Target_L1_Same, level 2 actual");
+ 
+    end Block_L2;
+ 
+ 
+    Report.Result;
+ 
+ end C460002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,335 ----
+ -- C460004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the operand type of a type conversion is class-wide,
+ --      Constraint_Error is raised if the tag of the operand does not
+ --      identify a specific type that is covered by or descended from the
+ --      target type.
+ --
+ -- TEST DESCRIPTION:
+ --      View conversions of class-wide operands to specific types are
+ --      placed on the right and left sides of assignment statements, and
+ --      conversions of class-wide operands to class-wide types are used
+ --      as actual parameters to dispatching operations. In all cases, a
+ --      check is made that Constraint_Error is raised if the tag of the
+ --      operand does not identify a specific type covered by or descended
+ --      from the target type, and not raised otherwise.
+ --      
+ --      A specific type is descended from itself and from those types it is
+ --      directly or indirectly derived from. A specific type is covered by
+ --      itself and each class-wide type to whose class it belongs.
+ --      
+ --      A class-wide type T'Class is descended from T and those types which
+ --      T is descended from. A class-wide type is covered by each class-wide
+ --      type to whose class it belongs.
+ --      
+ --
+ -- CHANGE HISTORY:
+ --      19 Jul 95   SAIC    Initial prerelease version.
+ --      18 Apr 96   SAIC    ACVC 2.1: Added a check for correct tag.
+ --
+ --!
+ package C460004_0 is
+ 
+    type Tag_Type is tagged record
+       C1 : Natural;
+    end record;
+ 
+    procedure Proc (X : in out Tag_Type);
+ 
+ 
+    type DTag_Type is new Tag_Type with record
+       C2 : String (1 .. 5);
+    end record;
+ 
+    procedure Proc (X : in out DTag_Type);
+ 
+ 
+    type DDTag_Type is new DTag_Type with record
+       C3 : String (1 .. 5);
+    end record;
+ 
+    procedure Proc (X : in out DDTag_Type);
+ 
+    procedure NewProc (X : in DDTag_Type);
+ 
+    function CWFunc (X : Tag_Type'Class) return Tag_Type'Class;
+ 
+ end C460004_0;
+ 
+ 
+      --==================================================================--
+ 
+ with Report;
+ package body C460004_0 is
+ 
+    procedure Proc (X : in out Tag_Type) is
+    begin
+       X.C1 := 25;
+    end Proc;
+ 
+    -----------------------------------------
+    procedure Proc (X : in out DTag_Type) is
+    begin
+       Proc ( Tag_Type(X) );
+       X.C2 := "Earth";
+    end Proc;
+ 
+    -----------------------------------------
+    procedure Proc (X : in out DDTag_Type) is
+    begin
+       Proc ( DTag_Type(X) );
+       X.C3 := "Orbit";
+    end Proc;
+ 
+    -----------------------------------------
+    procedure NewProc (X : in DDTag_Type) is
+       Y : DDTag_Type := X;
+    begin
+       Proc (Y);
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in NewProc");
+    end NewProc;
+ 
+    -----------------------------------------
+    function CWFunc (X : Tag_Type'Class) return Tag_Type'Class is
+       Y : Tag_Type'Class := X;
+    begin
+       Proc (Y);
+       return Y;
+    end CWFunc;
+ 
+ end C460004_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C460004_0;
+ use  C460004_0;
+ 
+ with Report;
+ procedure C460004 is
+ 
+    Tag_Type_Init    :  constant Tag_Type   := (C1 => 0);
+    DTag_Type_Init   :  constant DTag_Type  := (Tag_Type_Init with "Hello");
+    DDTag_Type_Init  :  constant DDTag_Type := (DTag_Type_Init with "World");
+ 
+    Tag_Type_Value   :  constant Tag_Type   := (C1 => 25);
+    DTag_Type_Value  :  constant DTag_Type  := (Tag_Type_Value  with "Earth");
+    DDTag_Type_Value :  constant DDTag_Type := (DTag_Type_Value with "Orbit");
+ 
+ begin
+ 
+    Report.Test ("C460004", "Check that for a view conversion of a "      &
+                 "class-wide operand, Constraint_Error is raised if the " &
+                 "tag of the operand does not identify a specific type "  &
+                 "covered by or descended from the target type");
+ 
+ --
+ -- View conversion to specific type:
+ --
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Target : Tag_Type := Tag_Type_Init;     
+       begin
+          Target := Tag_Type(P);                      
+          if (Target /= Tag_Type_Value) then
+             Report.Failed ("Target has wrong value: #01");
+          end if;
+       exception
+          when Constraint_Error => 
+             Report.Failed ("Constraint_Error raised: #01");
+          when others           => 
+             Report.Failed ("Unexpected exception: #01");
+       end CW_Proc;
+ 
+    begin
+       CW_Proc (DDTag_Type_Value);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       Target : DTag_Type := DTag_Type_Init;           
+    begin
+       Target := DTag_Type(CWFunc(DDTag_Type_Value));  
+       if (Target /= DTag_Type_Value) then
+          Report.Failed ("Target has wrong value: #02");
+       end if;
+    exception
+       when Constraint_Error => Report.Failed ("Constraint_Error raised: #02");
+       when others           => Report.Failed ("Unexpected exception: #02");
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       Target : DDTag_Type;
+    begin
+       Target := DDTag_Type(CWFunc(Tag_Type_Value));
+                 -- CWFunc returns a Tag_Type; its tag is preserved through 
+                 -- the view conversion.  Constraint_Error should be raised.
+ 
+       Report.Failed ("Constraint_Error not raised: #03"); 
+ 
+    exception
+       when Constraint_Error => null;                 -- expected exception
+       when others           => Report.Failed ("Unexpected exception: #03");
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+       begin
+          NewProc (DDTag_Type(P));
+          Report.Failed ("Constraint_Error not raised: #04"); 
+                                                          
+       exception
+          when Constraint_Error => null;              -- expected exception
+          when others           => Report.Failed ("Unexpected exception: #04");
+       end CW_Proc;
+  
+    begin
+       CW_Proc (DTag_Type_Value);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Target : DDTag_Type := DDTag_Type_Init; 
+       begin
+          Target := DDTag_Type(P);
+          if (Target /= DDTag_Type_Value) then
+             Report.Failed ("Target has wrong value: #05");
+          end if;
+ 
+       exception
+          when Constraint_Error => 
+             Report.Failed ("Constraint_Error raised: #05");
+          when others           
+             => Report.Failed ("Unexpected exception: #05");
+       end CW_Proc;
+  
+    begin
+       CW_Proc (DDTag_Type_Value);
+    end;
+ 
+ 
+ --
+ -- View conversion to class-wide type:
+ --
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;
+       begin
+          Proc( DTag_Type'Class(Operand) );
+          Report.Failed ("Constraint_Error not raised: #06");
+ 
+       exception
+          when Constraint_Error => null;              -- expected exception
+          when others           => Report.Failed ("Unexpected exception: #06");
+       end CW_Proc;
+  
+    begin
+       CW_Proc (Tag_Type_Init);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;
+       begin
+          Proc( DDTag_Type'Class(Operand) );
+          Report.Failed ("Constraint_Error not raised: #07");
+ 
+       exception
+          when Constraint_Error => null;              -- expected exception
+          when others           => Report.Failed ("Unexpected exception: #07");
+       end CW_Proc;
+  
+    begin
+       CW_Proc (Tag_Type_Init);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;
+       begin
+          Proc( DTag_Type'Class(Operand) );  
+          if Operand not in DTag_Type then
+             Report.Failed ("Operand has wrong tag: #08");
+          elsif (Operand /= Tag_Type'Class (DTag_Type_Value)) then
+             Report.Failed ("Operand has wrong value: #08");
+          end if;
+ 
+       exception
+          when Constraint_Error => 
+             Report.Failed ("Constraint_Error raised: #08");
+          when others           => 
+             Report.Failed ("Unexpected exception: #08");
+       end CW_Proc;
+  
+    begin
+       CW_Proc (DTag_Type_Init);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;
+       begin
+          Proc( Tag_Type'Class(Operand) );
+          if Operand not in DDTag_Type then
+             Report.Failed ("Operand has wrong tag: #09");
+          elsif (Operand /= Tag_Type'Class (DDTag_Type_Value)) then
+             Report.Failed ("Operand has wrong value: #09");
+          end if;
+ 
+       exception
+          when Constraint_Error => 
+             Report.Failed ("Constraint_Error raised: #09");
+          when others           => 
+             Report.Failed ("Unexpected exception: #09");
+       end CW_Proc;
+  
+    begin
+       CW_Proc (DDTag_Type_Init);
+    end;
+ 
+ 
+    Report.Result;
+ 
+ end C460004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,260 ----
+ -- C460005.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for a view conversion of a tagged type that is the left 
+ --      side of an assignment statement, the assignment assigns to the 
+ --      corresponding part of the object denoted by the operand.
+ --
+ -- TEST DESCRIPTION:
+ --      View conversions of class-wide operands to specific types are
+ --      placed on the right and left sides of assignment statements, and
+ --      conversions of class-wide operands to class-wide types are used
+ --      as actual parameters to dispatching operations. In all cases, a
+ --      check is made that Constraint_Error is raised if the tag of the
+ --      operand does not identify a specific type covered by or descended
+ --      from the target type, and not raised otherwise.
+ --
+ --      For the cases where the view conversion is the left side of an
+ --      assignment statement, and Constraint_Error should not be raised,
+ --      an additional check is made that only the corresponding portion
+ --      of the operand is updated by the assignment. For example:
+ --
+ --         type T is tagged record
+ --            C1 : Integer := 0;
+ --         end record;
+ --
+ --         type DT is new T with record
+ --            C2 : Integer := 0;
+ --         end record;
+ --
+ --         A    : T       := (C1 => 5);
+ --         B    : DT      := (C1 => 0, C2 => 10);
+ --         CWDT : T'Class := B;
+ --
+ --         T(CWDT) := A;  -- Updates component C1; C2 remains unchanged.
+ --                        -- Value of CWDT is (C1 => 5, C2 => 10).
+ --
+ --
+ -- CHANGE HISTORY:
+ --      31 Jul 95   SAIC    Initial prerelease version.
+ --      22 Apr 96   SAIC    ACVC 2.1: Added a check for correct tag.
+ --      08 Sep 96   SAIC    ACVC 2.1: Modified Report.Test. 
+ --
+ --!
+ 
+ package C460005_0 is
+ 
+    type Tag_Type is tagged record
+       C1 : Natural;
+    end record;
+ 
+    procedure Proc (X : in out Tag_Type);
+ 
+ 
+    type DTag_Type is new Tag_Type with record
+       C2 : String (1 .. 5);
+    end record;
+ 
+    procedure Proc (X : in out DTag_Type);
+ 
+ 
+    type DDTag_Type is new DTag_Type with record
+       C3 : String (1 .. 5);
+    end record;
+ 
+    procedure Proc (X : in out DDTag_Type);
+ 
+ end C460005_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460005_0 is
+ 
+    procedure Proc (X : in out Tag_Type) is
+    begin
+       X.C1 := 25;
+    end Proc;
+ 
+    -----------------------------------------
+    procedure Proc (X : in out DTag_Type) is
+    begin
+       Proc ( Tag_Type(X) );
+       X.C2 := "Earth";
+    end Proc;
+ 
+    -----------------------------------------
+    procedure Proc (X : in out DDTag_Type) is
+    begin
+       Proc ( DTag_Type(X) );
+       X.C3 := "Orbit";
+    end Proc;
+ 
+ end C460005_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C460005_0;
+ use  C460005_0;
+ 
+ with Report;
+ procedure C460005 is
+ 
+    Tag_Type_Init    :  constant Tag_Type   := (C1 => 0);
+    DTag_Type_Init   :  constant DTag_Type  := (Tag_Type_Init with "Hello");
+    DDTag_Type_Init  :  constant DDTag_Type := (DTag_Type_Init with "World");
+ 
+    Tag_Type_Value   :  constant Tag_Type   := (C1 => 25);
+    DTag_Type_Value  :  constant DTag_Type  := (Tag_Type_Value  with "Earth");
+    DDTag_Type_Value :  constant DDTag_Type := (DTag_Type_Value with "Orbit");
+ 
+    Tag_Type_Res     :  constant Tag_Type   := (C1 => 25);
+    DTag_Type_Res    :  constant DTag_Type  := (Tag_Type_Res  with "Hello");
+    DDTag_Type_Res   :  constant DDTag_Type := (DTag_Type_Res with "World");
+ 
+ begin
+ 
+    Report.Test ("C460005", "Check that, for a view conversion of a tagged " &
+                 "type that is the left side of an assignment statement, "   &
+                 "the assignment assigns to the corresponding part of the "  &
+                 "object denoted by the operand");
+ 
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;               
+       begin
+          Tag_Type(Operand) := Tag_Type_Value;         
+ 
+          if (Operand /= Tag_Type'Class (Tag_Type_Value)) then
+             Report.Failed ("Operand has wrong value: #01");
+          end if;
+ 
+       exception
+          when Constraint_Error => 
+             Report.Failed ("Constraint_Error raised: #01");
+          when others           => 
+             Report.Failed ("Unexpected exception: #01");
+       end CW_Proc;
+ 
+    begin
+       CW_Proc (Tag_Type_Init);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;               
+       begin
+          DTag_Type(Operand) := DTag_Type_Value;
+          Report.Failed ("Constraint_Error not raised: #02"); 
+ 
+       exception
+          when Constraint_Error => null;              -- expected exception
+          when others           => Report.Failed ("Unexpected exception: #02");
+       end CW_Proc;
+ 
+    begin
+       CW_Proc (Tag_Type_Init);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;               
+       begin
+          DDTag_Type(Operand) := DDTag_Type_Value;
+          Report.Failed ("Constraint_Error not raised: #03"); 
+ 
+       exception
+          when Constraint_Error => null;              -- expected exception
+          when others           => Report.Failed ("Unexpected exception: #03");
+       end CW_Proc;
+ 
+    begin
+       CW_Proc (Tag_Type_Init);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;
+       begin
+          Tag_Type(Operand) := Tag_Type_Value;  
+ 
+          if Operand not in DTag_Type then
+             Report.Failed ("Operand has wrong tag: #04");
+          elsif (Operand /= Tag_Type'Class (DTag_Type_Res)) 
+          then                                              -- Check to make 
+            Report.Failed ("Operand has wrong value: #04"); -- sure that C2 was
+          end if;                                           -- not modified.
+ 
+       exception
+          when Constraint_Error => 
+             Report.Failed ("Constraint_Error raised: #04");
+          when others           => 
+             Report.Failed ("Unexpected exception: #04");
+       end CW_Proc;
+ 
+    begin
+       CW_Proc (DTag_Type_Init);
+    end;
+ 
+    ----------------------------------------------------------------------
+ 
+    declare
+       procedure CW_Proc (P : Tag_Type'Class) is
+          Operand : Tag_Type'Class := P;
+       begin
+          Tag_Type(Operand) := Tag_Type_Value;         
+ 
+          if Operand not in DDTag_Type then
+             Report.Failed ("Operand has wrong tag: #05");
+          elsif (Operand /= Tag_Type'Class (DDTag_Type_Res)) 
+          then                                              -- Check to make 
+            Report.Failed ("Operand has wrong value: #05"); -- sure that C2, C3
+          end if;                                           -- were not changed.
+ 
+       exception
+          when Constraint_Error => 
+             Report.Failed ("Constraint_Error raised: #05");
+          when others           => 
+             Report.Failed ("Unexpected exception: #05");
+       end CW_Proc;
+ 
+    begin
+       CW_Proc (DDTag_Type_Init);
+    end;
+ 
+    Report.Result;
+ 
+ end C460005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,378 ----
+ -- C460006.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a view conversion to a tagged type is permitted in the 
+ --      prefix of a selected component, an object renaming declaration, and 
+ --      (if the operand is a variable) on the left side of an assignment 
+ --      statement. Check that such a renaming or assignment does not change 
+ --      the tag of the operand.
+ --
+ --      Check that, for a view conversion of a tagged type, each
+ --      nondiscriminant component of the new view denotes the matching
+ --      component of the operand object. Check that reading the value of the
+ --      view yields the result of converting the value of the operand object
+ --      to the target subtype.
+ --
+ -- TEST DESCRIPTION:
+ --      The fact that the tag of an object is not changed is verified by
+ --      making calls to primitive operations which in turn make (re)dispatching
+ --      calls, and confirming that the proper bodies are executed.
+ --
+ --      Selected components are checked in three contexts: as the object name
+ --      in an object renaming declaration, as the left operand of an inequality
+ --      operation, and as the left side of an assignment statement.
+ --
+ --      View conversions of an object of a 2nd level type extension are
+ --      renamed as objects of an ancestor type and of a class-wide type. In
+ --      one case the operand of the conversion is itself a renaming of an
+ --      object.
+ --
+ --      View conversions of an object of a 2nd level type extension are
+ --      checked for equality with record aggregates of various ancestor types.
+ --      In one case, the view conversion is to a class-wide type, and it is
+ --      checked for equality with the result of a class-wide function with
+ --      the following structure:
+ --
+ --         function F return T'Class is
+ --            A : DDT     := Expected_Value;
+ --            X : T'Class := T(A);
+ --         begin
+ --            return X;
+ --
+ --         end F;
+ --
+ --         ...
+ --
+ --         Var : DDT := Expected_Value;
+ --
+ --         if (T'Class(Var) /= F) then    -- Condition should yield FALSE.
+ --            FAIL;
+ --         end if;
+ --
+ --      The view conversion to which X is initialized does not affect the
+ --      value or tag of the operand; the tag of X is that of type DDT (not T),
+ --      and the components are those of A. The result of this function
+ --      should equal the value of an object of type DDT initialized to the
+ --      same value as F.A.
+ --
+ --      To check that assignment to a view conversion does not change the tag
+ --      of the operand, an assignment is made to a conversion of an object,
+ --      and the object is then passed as an actual to a dispatching operation.
+ --      Conversions to both specific and class-wide types are checked.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      20 Jul 95   SAIC    Initial prerelease version.
+ --      24 Apr 96   SAIC    Added type conversions.
+ --
+ --!
+ 
+ package C460006_0 is
+ 
+    type Call_ID_Kind is (None, Parent_Outer,     Parent_Inner,
+                                Child_Outer,      Child_Inner,
+                                Grandchild_Outer, Grandchild_Inner);
+ 
+    type Root_Type is abstract tagged record
+       First_Call  : Call_ID_Kind := None;
+       Second_Call : Call_ID_Kind := None;
+    end record;
+ 
+    procedure Inner_Proc (X : in out Root_Type) is abstract;
+    procedure Outer_Proc (X : in out Root_Type) is abstract;
+ 
+ end C460006_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package C460006_0.C460006_1 is
+ 
+    type Parent_Type is new Root_Type with record
+       C1 : Integer := 0;
+    end record;
+ 
+    procedure Inner_Proc (X : in out Parent_Type);
+    procedure Outer_Proc (X : in out Parent_Type);
+ 
+ end C460006_0.C460006_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460006_0.C460006_1 is
+ 
+    procedure Inner_Proc (X : in out Parent_Type) is
+    begin
+       X.Second_Call := Parent_Inner;
+    end Inner_Proc;
+ 
+    -------------------------------------------------
+    procedure Outer_Proc (X : in out Parent_Type) is
+    begin
+       X.First_Call := Parent_Outer;
+       Inner_Proc ( Parent_Type'Class(X) );
+    end Outer_Proc;
+ 
+ end C460006_0.C460006_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package C460006_0.C460006_1.C460006_2 is
+ 
+    type Child_Type is new Parent_Type with record
+       C2 : String(1 .. 5) := "-----";
+    end record;
+ 
+    procedure Inner_Proc (X : in out Child_Type);
+    procedure Outer_Proc (X : in out Child_Type);
+ 
+ end C460006_0.C460006_1.C460006_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460006_0.C460006_1.C460006_2 is
+ 
+    procedure Inner_Proc (X : in out Child_Type) is
+    begin
+       X.Second_Call := Child_Inner;
+    end Inner_Proc;
+ 
+    -------------------------------------------------
+    procedure Outer_Proc (X : in out Child_Type) is
+    begin
+       X.First_Call := Child_Outer;
+       Inner_Proc ( Parent_Type'Class(X) );
+    end Outer_Proc;
+ 
+ end C460006_0.C460006_1.C460006_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package C460006_0.C460006_1.C460006_2.C460006_3 is
+ 
+    type Grandchild_Type is new Child_Type with record
+       C3: String(1 .. 5) := "-----";
+    end record;
+ 
+    procedure Inner_Proc (X : in out Grandchild_Type);
+    procedure Outer_Proc (X : in out Grandchild_Type);
+ 
+ 
+    function ClassWide_Func return Parent_Type'Class;
+ 
+ 
+    Grandchild_Value : constant Grandchild_Type := (First_Call  => None,
+                                                    Second_Call => None,
+                                                    C1          => 15,
+                                                    C2          => "Hello",
+                                                    C3          => "World");
+ 
+ end C460006_0.C460006_1.C460006_2.C460006_3;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460006_0.C460006_1.C460006_2.C460006_3 is
+ 
+    procedure Inner_Proc (X : in out Grandchild_Type) is
+    begin
+       X.Second_Call := Grandchild_Inner;
+    end Inner_Proc;
+ 
+    -------------------------------------------------
+    procedure Outer_Proc (X : in out Grandchild_Type) is
+    begin
+       X.First_Call := Grandchild_Outer;
+       Inner_Proc ( Parent_Type'Class(X) );
+    end Outer_Proc;
+ 
+    -------------------------------------------------
+    function ClassWide_Func return Parent_Type'Class is
+       A : Grandchild_Type   := Grandchild_Value;
+       X : Parent_Type'Class := Parent_Type(A); -- Value of X is still that of A.
+    begin
+       return X;
+    end ClassWide_Func;
+ 
+ end C460006_0.C460006_1.C460006_2.C460006_3;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C460006_0.C460006_1.C460006_2.C460006_3;
+ 
+ with Report;
+ procedure C460006 is
+ 
+    package Root_Package       renames C460006_0;
+    package Parent_Package     renames C460006_0.C460006_1;
+    package Child_Package      renames C460006_0.C460006_1.C460006_2;
+    package Grandchild_Package renames C460006_0.C460006_1.C460006_2.C460006_3;
+ 
+ begin
+    Report.Test ("C460006", "Check that a view conversion to a tagged type " &
+                 "is permitted in the prefix of a selected component, an "   &
+                 "object renaming declaration, and (if the operand is a "    &
+                 "variable) on the left side of an assignment statement.  "  &
+                 "Check that such a renaming or assignment does not change " &
+                 " the tag of the operand");
+ 
+ 
+    --
+    -- Check conversion as prefix of selected component:
+    --
+ 
+    Selected_Component_Subtest:
+    declare
+       use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
+ 
+       Var    : Grandchild_Type   := Grandchild_Value;
+       CW_Var : Parent_Type'Class := Var;
+ 
+       Ren    : Integer renames Parent_Type(Var).C1;
+ 
+    begin
+       if Ren /= 15 then
+          Report.Failed ("Wrong value: selected component in renaming");
+       end if;
+ 
+       if Child_Type(Var).C2 /= "Hello" then
+          Report.Failed ("Wrong value: selected component in IF");
+       end if;
+ 
+       Grandchild_Type(CW_Var).C3(2..4) := "eir";
+       if CW_Var /= Parent_Type'Class
+                    (Grandchild_Type'(None, None, 15, "Hello", "Weird"))
+       then
+          Report.Failed ("Wrong value: selected component in assignment");
+       end if;
+    end Selected_Component_Subtest;
+ 
+ 
+    --
+    -- Check conversion in object renaming:
+    --
+ 
+    Object_Renaming_Subtest:
+    declare
+       use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
+ 
+       Var : Grandchild_Type := Grandchild_Value;
+       Ren1 : Parent_Type       renames Parent_Type(Var);
+       Ren2 : Child_Type        renames Child_Type(Var);
+       Ren3 : Parent_Type'Class renames Parent_Type'Class(Var);
+       Ren4 : Parent_Type       renames Parent_Type(Ren2); -- Rename of rename.
+    begin
+       Outer_Proc (Ren1);
+       if Ren1 /= (Parent_Outer, Grandchild_Inner, 15) then
+          Report.Failed ("Value or tag not preserved by object renaming: Ren1");
+       end if;
+ 
+       Outer_Proc (Ren2);
+       if Ren2 /= (Child_Outer, Grandchild_Inner, 15, "Hello") then
+          Report.Failed ("Value or tag not preserved by object renaming: Ren2");
+       end if;
+ 
+       Outer_Proc (Ren3);
+       if Ren3 /= Parent_Type'Class
+                  (Grandchild_Type'(Grandchild_Outer,
+                                    Grandchild_Inner,
+                                    15,
+                                    "Hello",
+                                    "World"))
+       then
+          Report.Failed ("Value or tag not preserved by object renaming: Ren3");
+       end if;
+ 
+       Outer_Proc (Ren4);
+       if Ren4 /= (Parent_Outer, Grandchild_Inner, 15) then
+          Report.Failed ("Value or tag not preserved by object renaming: Ren4");
+       end if;
+    end Object_Renaming_Subtest;
+ 
+ 
+    --
+    -- Check reading view conversion, and conversion as left side of assignment:
+    --
+ 
+    View_Conversion_Subtest:
+    declare
+       use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
+ 
+       Var : Grandchild_Type := Grandchild_Value;
+       Specific  : Child_Type;
+       ClassWide : Parent_Type'Class := Var;   -- Grandchild_Type tag.
+    begin
+       if Parent_Type(Var) /= (None, None, 15) then
+          Report.Failed ("View has wrong value: #1");
+       end if;
+ 
+       if Child_Type(Var) /= (None, None, 15, "Hello") then
+          Report.Failed ("View has wrong value: #2");
+       end if;
+ 
+       if Parent_Type'Class(Var) /= ClassWide_Func then
+          Report.Failed ("Upward view conversion did not preserve " &
+                         "extension's components");
+       end if;
+ 
+ 
+       Parent_Type(Specific) := (None, None, 26); -- Assign to view.
+       Outer_Proc (Specific);                     -- Call dispatching op.
+ 
+       if Specific /= (Child_Outer, Child_Inner, 26, "-----") then
+          Report.Failed ("Value or tag not preserved by assignment: Specific");
+       end if;
+ 
+ 
+       Parent_Type(ClassWide) := (None, None, 44); -- Assign to view.
+       Outer_Proc (ClassWide);                     -- Call dispatching op.
+ 
+       if ClassWide /= Parent_Type'Class
+                       (Grandchild_Type'(Grandchild_Outer,
+                                         Grandchild_Inner,
+                                         44,
+                                         "Hello",
+                                         "World"))
+       then
+          Report.Failed ("Value or tag not preserved by assignment: ClassWide");
+       end if;
+    end View_Conversion_Subtest;
+ 
+    Report.Result;
+ 
+ end C460006;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,239 ----
+ -- C460007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, in a numeric type conversion, if the target type is an
+ --      integer type and the operand type is real, the result is rounded
+ --      to the nearest integer, and away from zero if the result is exactly
+ --      halfway between two integers. Check for static and non-static type
+ --      conversions.
+ --
+ -- TEST DESCRIPTION:
+ --      The following cases are considered:
+ --
+ --          X.5    X.5 + delta   -X.5 + delta
+ --         -X.5    X.5 - delta   -X.5 - delta
+ --
+ --      Both zero and non-zero values are used for X. The value of delta is
+ --      chosen to be a very small increment (on the order of 1.0E-10). For
+ --      fixed and floating point cases, the value of delta is chosen such that
+ --      "(-)X.5 +(-) delta" is a multiple of the small, or a machine number,
+ --      respectively.
+ --
+ --      The following type conversions are performed:
+ --
+ --      ID   Real operand            Cases          Target integer subtype
+ --      ------------------------------------------------------------------
+ --       1   Real named number        X.5           Nonstatic
+ --       2                            X.5 - delta   Nonstatic
+ --       3                           -X.5 - delta   Static
+ --       4   Real literal            -X.5           Static
+ --       5                            X.5 + delta   Static
+ --       6                           -X.5 + delta   Nonstatic
+ --       7   Floating point object   -X.5 - delta   Nonstatic
+ --       8                            X.5 - delta   Static
+ --       9   Fixed point object       X.5           Static
+ --      10                            X.5 + delta   Static
+ --      11                           -X.5 + delta   Nonstatic
+ --      The conversion is either assigned to a variable of the target subtype
+ --      or passed as a parameter to a subprogram (both nonstatic contexts).
+ --
+ --      The subprogram Equal is used to circumvent potential optimizations.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      03 Oct 95   SAIC    Initial prerelease version.
+ --
+ --!
+ 
+ with System;
+ package C460007_0 is
+ 
+ --
+ -- Target integer subtype (static):
+ --
+ 
+    type Static_Integer_Subtype is range -32_000 .. 32_000;
+ 
+    Static_Target : Static_Integer_Subtype;
+ 
+    function Equal (L, R: Static_Integer_Subtype) return Boolean;
+ 
+ 
+ --
+ -- Named numbers:
+ --
+ 
+    NN_Half      : constant := 0.5000000000;
+    NN_Less_Half : constant := 126.4999999999;
+    NN_More_Half : constant := -NN_Half - 0.0000000001;
+ 
+ 
+ --
+ -- Floating point:
+ --
+ 
+    type My_Float is digits System.Max_Digits;
+ 
+    Flt_Rnd_Toward_Zero :          My_Float := My_Float'Pred(NN_Half);
+    Flt_Rnd_Away_Zero   : constant My_Float := My_Float'Pred(-113.5);
+ 
+ 
+ --
+ -- Fixed point:
+ --
+ 
+    type My_Fixed is delta 0.1 range -5.0 .. 5.0;
+ 
+    Fix_Half            :          My_Fixed := 0.5;
+    Fix_Rnd_Away_Zero   :          My_Fixed := Fix_Half + My_Fixed'Small;
+    Fix_Rnd_Toward_Zero : constant My_Fixed := -3.5 + My_Fixed'Small;
+ 
+ end C460007_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460007_0 is
+ 
+    function Equal (L, R: Static_Integer_Subtype) return Boolean is
+    begin
+       return (L = R);
+    end Equal;
+ 
+ end C460007_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C460007_0;
+ use  C460007_0;
+ 
+ with Report;
+ procedure C460007 is
+ 
+ --
+ -- Target integer subtype (nonstatic):
+ --
+ 
+    Limit : Static_Integer_Subtype :=
+            Static_Integer_Subtype(Report.Ident_Int(128));
+ 
+    subtype Nonstatic_Integer_Subtype is Static_Integer_Subtype
+      range -Limit .. Limit;
+ 
+    Nonstatic_Target : Static_Integer_Subtype;
+ 
+ begin
+ 
+    Report.Test ("C460007", "Rounding for type conversions of real operand " &
+                 "to integer target");
+ 
+ 
+    -- --------------------------
+    -- Named number/literal cases:
+    -- --------------------------
+ 
+    Nonstatic_Target := Nonstatic_Integer_Subtype(NN_Half);
+    
+    if not Equal(Nonstatic_Target, 1) then                           -- Case 1.
+       Report.Failed ("Wrong result for named number operand" &
+                      "(case 1), nonstatic target subtype");
+    end if;
+ 
+    if not Equal(Nonstatic_Integer_Subtype(NN_Less_Half), 126) then  -- Case 2. 
+       Report.Failed ("Wrong result for named number operand" &
+                      "(case 2), nonstatic target subtype");
+    end if;
+ 
+    Static_Target := Static_Integer_Subtype(NN_More_Half);
+    
+    if not Equal(Static_Target, -1) then                             -- Case 3.
+       Report.Failed ("Wrong result for named number operand" &
+                      "(case 3), static target subtype");
+    end if;
+ 
+    if not Equal(Static_Integer_Subtype(-0.50), -1) then             -- Case 4.
+       Report.Failed ("Wrong result for literal operand" &
+                      "(case 4), static target subtype");
+    end if;
+ 
+    if not Equal(Static_Integer_Subtype(29_546.5001), 29_547) then   -- Case 5.
+       Report.Failed ("Wrong result for literal operand" &
+                      "(case 5), static target subtype");
+    end if;
+ 
+    if not Equal(Nonstatic_Integer_Subtype(-66.499), -66) then       -- Case 6.
+       Report.Failed ("Wrong result for literal operand" &
+                      "(case 6), nonstatic target subtype");
+    end if;
+ 
+ 
+    -- --------------------
+    -- Floating point cases:
+    -- --------------------
+ 
+    Nonstatic_Target := Nonstatic_Integer_Subtype(Flt_Rnd_Away_Zero);
+ 
+    if not Equal(Nonstatic_Target, -114) then                        -- Case 7.
+       Report.Failed ("Wrong result for floating point operand" &
+                      "(case 7), nonstatic target subtype");
+    end if;
+                                                                     -- Case 8.
+    if not Equal(Static_Integer_Subtype(Flt_Rnd_Toward_Zero), 0) then
+       Report.Failed ("Wrong result for floating point operand" &
+                      "(case 8), static target subtype");
+    end if;
+ 
+ 
+    -- -----------------
+    -- Fixed point cases:
+    -- -----------------
+ 
+    Static_Target := Static_Integer_Subtype(Fix_Half);
+ 
+    if not Equal(Static_Target, 1) then                              -- Case 9.
+       Report.Failed ("Wrong result for fixed point operand" &
+                      "(case 9), static target subtype");
+    end if;
+ 
+    if not Equal(Static_Integer_Subtype(Fix_Rnd_Away_Zero), 1) then  -- Case 10.
+       Report.Failed ("Wrong result for fixed point operand" &
+                      "(case 10), static target subtype");
+    end if;
+ 
+    Nonstatic_Target := Nonstatic_Integer_Subtype(Fix_Rnd_Toward_Zero);
+ 
+    if not Equal(Nonstatic_Target, -3) then                          -- Case 11.
+       Report.Failed ("Wrong result for fixed point operand" &
+                      "(case 11), nonstatic target subtype");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C460007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460008.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460008.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460008.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,286 ----
+ -- C460008.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that conversion to a modular type raises Constraint_Error
+ --     when the operand value is outside the base range of the modular type.
+ --
+ -- TEST DESCRIPTION:
+ --      Test conversion from integer, float, fixed and decimal types to
+ --      modular types.  Test conversion to mod 255, mod 256 and mod 258
+ --      to test the boundaries of 8 bit (+/-) unsigned numbers.
+ --      Test operand values that are negative, the value of the mod,
+ --      and greater than the value of the mod.
+ --      Declare a generic test procedure and instantiate it for each of the
+ --      unsigned types for each operand type.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      04 OCT 95   SAIC   Initial version
+ --      15 MAY 96   SAIC   Revised for 2.1
+ --      24 NOV 98   RLB    Moved decimal cases into new test, C460011, to
+ --                         prevent this test from being inapplicable to
+ --                         implementations not supporting decimal types.
+ --
+ --!
+ 
+ ------------------------------------------------------------------- C460008
+ 
+ with Report;
+ 
+ procedure C460008 is
+ 
+   Shy_By_One   : constant := 2**8-1;
+   Heavy_By_Two : constant := 2**8+2;
+ 
+   type Unsigned_Edge_8 is mod Shy_By_One;
+   type Unsigned_8_Bit  is mod 2**8;
+   type Unsigned_Over_8 is mod Heavy_By_Two;
+ 
+   NPC : constant String := " not properly converted";
+ 
+   procedure Assert( Truth: Boolean; Message: String ) is
+   begin
+     if not Truth then
+       Report.Failed(Message);
+     end if;
+   end Assert;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   generic
+     type Source is range <>;
+     type Target is mod <>;
+   procedure Integer_Conversion_Check( For_The_Value : Source;
+                                       Message       : String );
+ 
+   procedure Integer_Conversion_Check( For_The_Value : Source;
+                                       Message       : String ) is
+ 
+     Item : Target;
+ 
+   begin
+     Item := Target( For_The_Value );
+     Report.Failed("Int expected Constraint_Error " & Message);
+     -- the call to Comment is to make the otherwise dead assignment to
+     -- Item live.
+     -- To avoid invoking C_E on a call to 'Image in Report.Failed that
+     -- could cause a false pass
+    Report.Comment("Value of" & Target'Image(Item) & NPC);
+   exception
+     when Constraint_Error => null; -- expected case
+     when others => Report.Failed("Int Raised wrong exception " & Message);
+   end Integer_Conversion_Check;
+ 
+   procedure Int_To_Short is
+     new Integer_Conversion_Check( Integer, Unsigned_Edge_8 );
+ 
+   procedure Int_To_Eight is
+     new Integer_Conversion_Check( Integer, Unsigned_8_Bit );
+ 
+   procedure Int_To_Wide is
+     new Integer_Conversion_Check( Integer, Unsigned_Over_8 );
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   generic
+     type Source is digits <>;
+     type Target is mod <>;
+   procedure Float_Conversion_Check( For_The_Value : Source;
+                                     Message       : String );
+ 
+   procedure Float_Conversion_Check( For_The_Value : Source;
+                                     Message       : String ) is
+ 
+     Item : Target;
+ 
+   begin
+     Item := Target( For_The_Value );
+     Report.Failed("Flt expected Constraint_Error " & Message);
+     Report.Comment("Value of" & Target'Image(Item) & NPC);
+   exception
+     when Constraint_Error => null; -- expected case
+     when others => Report.Failed("Flt raised wrong exception " & Message);
+   end Float_Conversion_Check;
+ 
+   procedure Float_To_Short is
+     new Float_Conversion_Check( Float, Unsigned_Edge_8 );
+ 
+   procedure Float_To_Eight is
+     new Float_Conversion_Check( Float, Unsigned_8_Bit );
+ 
+   procedure Float_To_Wide is
+     new Float_Conversion_Check( Float, Unsigned_Over_8 );
+ 
+   function Identity( Root_Beer: Float ) return Float is
+     -- a knockoff of Report.Ident_Int for type Float
+     Nothing : constant Float := 0.0;
+   begin
+     if Report.Ident_Bool( Root_Beer = Nothing ) then
+       return Nothing;
+     else
+       return Root_Beer;
+     end if;
+   end Identity;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   generic
+     type Source is delta <>;
+     type Target is mod <>;
+   procedure Fixed_Conversion_Check( For_The_Value : Source;
+                                     Message       : String );
+ 
+   procedure Fixed_Conversion_Check( For_The_Value : Source;
+                                     Message       : String ) is
+ 
+     Item : Target;
+ 
+   begin
+     Item := Target( For_The_Value );
+     Report.Failed("Fix expected Constraint_Error " & Message);
+     Report.Comment("Value of" & Target'Image(Item) & NPC);
+   exception
+     when Constraint_Error => null; -- expected case
+     when others => Report.Failed("Fix raised wrong exception " & Message);
+   end Fixed_Conversion_Check;
+ 
+   procedure Fixed_To_Short is
+     new Fixed_Conversion_Check( Duration, Unsigned_Edge_8 );
+ 
+   procedure Fixed_To_Eight is
+     new Fixed_Conversion_Check( Duration, Unsigned_8_Bit );
+ 
+   procedure Fixed_To_Wide is
+     new Fixed_Conversion_Check( Duration, Unsigned_Over_8 );
+ 
+   function Identity( A_Stitch: Duration ) return Duration is
+     Threadbare : constant Duration := 0.0;
+   begin
+     if Report.Ident_Bool( A_Stitch = Threadbare ) then
+       return Threadbare;
+     else
+       return A_Stitch;
+     end if;
+   end Identity;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C460008", "Check that conversion to " &
+                           "a modular type raises Constraint_Error when " &
+                           "the operand value is outside the base range " &
+                           "of the modular type" );
+ 
+ 
+   -- Integer Error cases
+ 
+   Int_To_Short( Report.Ident_Int( -1 ), "I2S Dynamic, Negative" );
+   Int_To_Short( Report.Ident_Int( Shy_By_One ), "I2S Dynamic, At_Mod" );
+   Int_To_Short( Report.Ident_Int( Heavy_By_Two+1 ), "I2S Dynamic, Over_Mod" );
+ 
+   Int_To_Eight( -Shy_By_One, "I28 Static,  Negative" );
+   Int_To_Eight( 2**8, "I28 Static,  At_Mod" );
+   Int_To_Eight( Heavy_By_Two+1, "I28 Static,  Over_Mod" );
+ 
+   Int_To_Wide ( Report.Ident_Int( -(Heavy_By_Two*2) ),
+                 "I2W Dynamic, Negative" );
+   Int_To_Wide ( Heavy_By_Two, "I2W Static,  At_Mod" );
+   Int_To_Wide ( Report.Ident_Int( Heavy_By_Two*2 ), "I2W Dynamic, Over_Mod" );
+ 
+   -- Float Error cases
+ 
+   Float_To_Short( -13.31, "F2S Static,  Negative" );
+   Float_To_Short( Identity ( Float(Shy_By_One)), "F2S Dynamic, At_Mod" );
+   Float_To_Short( 6378.388, "F2S Static,  Over_Mod" );
+ 
+   Float_To_Eight( Identity( -99.3574 ), "F28 Dynamic, Negative" );
+   Float_To_Eight( 2.0**8, "F28 Static,  At_Mod" );
+   Float_To_Eight( 2.0**9, "F28 Static,  Over_Mod" );
+ 
+   Float_To_Wide ( -0.54953_93129_81644, "FTW Static,  Negative" );
+   Float_To_Wide ( Identity( 2.0**8 +2.0 ), "FTW Dynamic, At_Mod" );
+   Float_To_Wide ( Identity( 2.0**8 +2.5001 ), "FTW Dynamic, Over_Mod" );
+   Float_To_Wide ( Identity( Float'Last ), "FTW Dynamic, Over_Mod" );
+ 
+   -- Fixed Error cases
+ 
+   Fixed_To_Short( Identity( -5.00 ), "D2S Dynamic, Negative" );
+   Fixed_To_Short( Shy_By_One * 1.0, "D2S Static,  At_Mod" );
+   Fixed_To_Short( 1995.9, "D2S Static,  Over_Mod" );
+ 
+   Fixed_To_Eight( -0.5, "D28 Static, Negative" );
+   Fixed_To_Eight( 2.0*128, "D28 Static,  At_Mod" );
+   Fixed_To_Eight( Identity( 2001.2 ), "D28 Dynamic, Over_Mod" );
+ 
+   Fixed_To_Wide ( Duration'First, "D2W Static,  Negative" );
+   Fixed_To_Wide ( Identity( 2*128.0 +2.0 ), "D2W Dynamic, At_Mod" );
+   Fixed_To_Wide ( Duration'Last, "D2W Static,  Over_Mod" );
+ 
+   -- having made it this far, the rest is downhill...
+   -- check a few, correct, edge cases, and we're done
+ 
+   Eye_Dew: declare
+     A_Float   : Float    := 0.0;
+     Your_Time : Duration := 0.0;
+     Number    : Integer  := 0;
+ 
+     Little   : Unsigned_Edge_8;
+     Moderate : Unsigned_8_Bit;
+     Big      : Unsigned_Over_8;
+ 
+   begin
+     Little := Unsigned_Edge_8(A_Float);
+     Assert( Little = 0, "Float => Little, 0");
+ 
+ 
+     Moderate := Unsigned_8_Bit (Your_Time);
+     Assert( Moderate = 0, "Your_Time => Moderate, 0");
+ 
+     Big := Unsigned_Over_8 (Number);
+     Assert( Big = 0, "Number => Big, 0");
+ 
+     A_Float   := 2.0**8-2.0;
+     Your_Time := 2.0*128-2.0;
+     Number    := 2**8;
+ 
+     Little := Unsigned_Edge_8(A_Float);
+     Assert( Little = 254, "Float => Little, 254");
+ 
+     Little := Unsigned_Edge_8(Your_Time);
+     Assert( Little = 254, "Your_Time => Little, 254");
+ 
+     Big := Unsigned_Over_8 (A_Float + 2.0);
+     Assert( Big = 256, "Sense => Big, 256");
+ 
+     Big := Unsigned_Over_8 (Number);
+     Assert( Big = 256, "Number => Big, 256");
+ 
+   end Eye_Dew;
+ 
+   Report.Result;
+ 
+ end C460008;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460009.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460009.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460009.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,467 ----
+ -- C460009.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that Constraint_Error is raised in cases of null arrays when:
+ --     1.  an assignment is made to a null array if the length of each
+ --         dimension of the operand does not match the length of 
+ --         the corresponding dimension of the target subtype.
+ --     2.  an array actual parameter does not match the length of
+ --         corresponding dimensions of the formal in out parameter where
+ --         the actual parameter has the form of a type conversion.     
+ --     3.  an array actual parameter does not match the length of
+ --         corresponding dimensions of the formal out parameter where
+ --         the actual parameter has the form of a type conversion.     
+ --
+ -- TEST DESCRIPTION:
+ --      This transition test creates examples where array of null ranges 
+ --      raises Constraint_Error if any of the lengths mismatch.
+ --
+ --      Inspired by C52103S.ADA, C64105E.ADA, and C64105F.ADA.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      21 Mar 96   SAIC    Initial version for ACVC 2.1.
+ --      21 Sep 96   SAIC    ACVC 2.1: Added new case.
+ --
+ --!
+ 
+ with Report;
+ 
+ procedure C460009 is
+ 
+    subtype Int is Integer range 1 .. 3;
+ 
+ begin
+ 
+    Report.Test("C460009","Check that Constraint_Error is raised in "  &
+                "cases of null arrays if any of the lengths mismatch " & 
+                "in assignments and parameter passing");
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Arr_Int1 is array (Int range <>) of Integer;
+       Arr_Obj1 : Arr_Int1 (2 .. Report.Ident_Int(1));     -- null array object
+ 
+    begin
+ 
+       -- Same lengths, no Constraint_Error raised.
+       Arr_Obj1 := (Report.Ident_Int(3) .. 2 => Report.Ident_Int(1));
+ 
+       Report.Comment ("Dead assignment prevention in Arr_Obj1 => " &
+                        Integer'Image (Arr_Obj1'Last));
+ 
+    exception
+ 
+       when Constraint_Error => 
+         Report.Failed ("Arr_Obj1 - Constraint_Error exception raised");
+       when others           => 
+         Report.Failed ("Arr_Obj1 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Arr_Int2 is array (Int range <>, Int range <>) of Integer;
+       Arr_Obj2 : Arr_Int2 (1 .. Report.Ident_Int(2), 
+                            Report.Ident_Int(3) .. Report.Ident_Int(2));
+                                                            -- null array object
+    begin
+ 
+       -- Same lengths, no Constraint_Error raised.
+       Arr_Obj2 := Arr_Int2'(Report.Ident_Int(2) .. 3 => 
+                   (Report.Ident_Int(2) .. Report.Ident_Int(1) =>  
+                    Report.Ident_Int(1)));
+ 
+       Report.Comment ("Dead assignment prevention in Arr_Obj2 => " &
+                        Integer'Image (Arr_Obj2'Last));
+ 
+    exception
+ 
+       when Constraint_Error => 
+         Report.Failed ("Arr_Obj2 - Constraint_Error exception raised");
+       when others           => 
+         Report.Failed ("Arr_Obj2 - others exception raised");
+ 
+    end;
+    
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Arr_Int3 is array (Int range <>, Int range <>) of Integer;
+       Arr_Obj3 : Arr_Int3 (1 .. Report.Ident_Int(2), 
+                            Report.Ident_Int(3) .. Report.Ident_Int(2));
+                                                            -- null array object
+ 
+    begin
+ 
+       -- Lengths mismatch, Constraint_Error raised.
+       Arr_Obj3 := Arr_Int3'(Report.Ident_Int(3) .. 2 => 
+                   (Report.Ident_Int(1) .. Report.Ident_Int(3) =>  
+                    Report.Ident_Int(1)));
+ 
+       Report.Comment ("Dead assignment prevention in Arr_Obj3 => " &
+                        Integer'Image (Arr_Obj3'Last));
+ 
+       Report.Failed ("Constraint_Error not raised in Arr_Obj3");
+ 
+    exception
+ 
+       when Constraint_Error => null;      -- exception expected.
+       when others           => 
+         Report.Failed ("Arr_Obj3 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Arr_Int4 is array (Int range <>, Int range <>, Int range <>) of 
+         Integer;
+       Arr_Obj4 : Arr_Int4 (1 .. Report.Ident_Int(2), 
+                            Report.Ident_Int(1) .. Report.Ident_Int(3),
+                            Report.Ident_Int(3) .. Report.Ident_Int(2));
+                                                            -- null array object
+    begin
+ 
+       -- Lengths mismatch, Constraint_Error raised.
+       Arr_Obj4 := Arr_Int4'(Report.Ident_Int(1) .. 3 => 
+                   (Report.Ident_Int(1) .. Report.Ident_Int(2) =>  
+                    (Report.Ident_Int(3) .. Report.Ident_Int(2) =>  
+                    Report.Ident_Int(1))));
+ 
+       Report.Comment ("Dead assignment prevention in Arr_Obj4 => " &
+                        Integer'Image (Arr_Obj4'Last));
+ 
+       Report.Failed ("Constraint_Error not raised in Arr_Obj4");
+ 
+    exception
+ 
+       when Constraint_Error => null;      -- exception expected.
+       when others           => 
+         Report.Failed ("Arr_Obj4 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Arr_Int5 is array (Int range <>) of Integer;
+       Arr_Obj5 : Arr_Int5 (2 .. Report.Ident_Int(1));     -- null array object
+ 
+    begin
+ 
+       -- Only lengths of two null ranges are different, no Constraint_Error 
+       -- raised.
+       Arr_Obj5 := (Report.Ident_Int(3) .. 1 => Report.Ident_Int(1));
+ 
+       Report.Comment ("Dead assignment prevention in Arr_Obj5 => " &
+                        Integer'Image (Arr_Obj5'Last));
+ 
+    exception
+ 
+       when Constraint_Error => 
+         Report.Failed ("Arr_Obj5 - Constraint_Error exception raised");
+       when others           => 
+         Report.Failed ("Arr_Obj5 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+       subtype Str is String (Report.Ident_Int(5) .. 4);  
+                                                             -- null string
+       Str_Obj : Str;
+ 
+    begin
+ 
+       -- Same lengths, no Constraint_Error raised.
+       Str_Obj := (Report.Ident_Int(1) .. 0 => 'Z');
+       Str_Obj(2 .. 1) := "";
+       Str_Obj(4 .. 2) := (others => 'X');
+       Str_Obj(Report.Ident_Int(6) .. 3) := "";
+       Str_Obj(Report.Ident_Int(0) .. Report.Ident_Int(-1)) := (others => 'Y');
+ 
+    exception
+ 
+       when Constraint_Error => 
+         Report.Failed ("Str_Obj - Constraint_Error exception raised");
+       when others           => 
+         Report.Failed ("Str_Obj - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Arr_Char5 is array (Int range <>, Int range <>) of Character;
+       subtype Formal is Arr_Char5 
+         (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));  
+       Arr_Obj5 : Arr_Char5 (Report.Ident_Int(2) .. Report.Ident_Int(1),
+                             Report.Ident_Int(1) .. Report.Ident_Int(2))
+                := (Report.Ident_Int(2) .. Report.Ident_Int(1) =>
+                   (Report.Ident_Int(1) .. Report.Ident_Int(2) => ' ')); 
+ 
+       procedure Proc5 (P : in out Formal) is
+       begin
+          Report.Failed ("No exception raised in Proc5");
+ 
+       exception       
+ 
+          when Constraint_Error => 
+            Report.Failed ("Constraint_Error exception raised in Proc5");
+          when others           => 
+            Report.Failed ("Others exception raised in Proc5");
+       end;            
+ 
+    begin
+ 
+       -- Lengths mismatch in the type conversion, Constraint_Error raised.
+       Proc5 (Formal(Arr_Obj5));
+ 
+       Report.Failed ("Constraint_Error not raised in the call Proc5");
+ 
+    exception
+ 
+       when Constraint_Error => null;      -- exception expected.
+       when others           => 
+         Report.Failed ("Arr_Obj5 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Formal is array 
+         (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
+ 
+       type Actual is array 
+         (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
+ 
+       Arr_Obj6 : Actual := (5 .. 3 => (3 .. 5 => ' '));
+ 
+       procedure Proc6 (P : in out Formal) is
+       begin
+          Report.Failed ("No exception raised in Proc6");
+ 
+       exception       
+ 
+          when Constraint_Error => 
+            Report.Failed ("Constraint_Error exception raised in Proc6");
+          when others           => 
+            Report.Failed ("Others exception raised in Proc6");
+       end;            
+ 
+    begin
+ 
+       -- Lengths mismatch in the type conversion, Constraint_Error raised.
+       Proc6 (Formal(Arr_Obj6));
+ 
+       Report.Failed ("Constraint_Error not raised in the call Proc6");
+ 
+    exception
+ 
+       when Constraint_Error => null;      -- exception expected.
+       when others           => 
+         Report.Failed ("Arr_Obj6 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Formal is array (Int range <>, Int range <>) of Character;
+       type Actual is array (Positive range 5 .. 2,
+                             Positive range 1 .. 3) of Character;
+ 
+       Arr_Obj7 : Actual := (5 .. 2 => (1 .. 3 => ' '));
+ 
+       procedure Proc7 (P : in out Formal) is
+       begin
+          if P'Last /= 2 and P'Last(2) /= 3 then
+             Report.Failed ("Wrong bounds passed for Arr_Obj7");
+          end if;
+ 
+          -- Lengths mismatch, Constraint_Error raised.
+          P := (1 .. 3 => (3 .. 0 => ' '));
+ 
+          Report.Comment ("Dead assignment prevention in Proc7 => " &
+                           Integer'Image (P'Last));
+ 
+          Report.Failed ("No exception raised in Proc7");
+ 
+       exception       
+ 
+          when Constraint_Error => null;      -- exception expected.
+          when others           => 
+            Report.Failed ("Others exception raised in Proc7");
+       end;            
+ 
+    begin
+ 
+       -- Same lengths, no Constraint_Error raised.
+       Proc7 (Formal(Arr_Obj7));
+ 
+       if Arr_Obj7'Last /= 2 and Arr_Obj7'Last(2) /= 3 then
+          Report.Failed ("Bounds changed for Arr_Obj7");
+       end if;
+ 
+    exception
+ 
+       when Constraint_Error => 
+         Report.Failed ("Constraint_Error exception raised after call Proc7");
+       when others           => 
+         Report.Failed ("Arr_Obj7 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Arr_Char8 is array (Int range <>, Int range <>) of Character;
+       subtype Formal is Arr_Char8 
+         (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));  
+       Arr_Obj8 : Arr_Char8 (Report.Ident_Int(2) .. Report.Ident_Int(1),
+                             Report.Ident_Int(1) .. Report.Ident_Int(2));
+ 
+       procedure Proc8 (P : out Formal) is
+       begin
+          Report.Failed ("No exception raised in Proc8");
+ 
+       exception       
+ 
+          when Constraint_Error => 
+            Report.Failed ("Constraint_Error exception raised in Proc8");
+          when others           => 
+            Report.Failed ("Others exception raised in Proc8");
+       end;            
+ 
+    begin
+ 
+       -- Lengths mismatch in the type conversion, Constraint_Error raised.
+       Proc8 (Formal(Arr_Obj8));
+ 
+       Report.Failed ("Constraint_Error not raised in the call Proc8");
+ 
+    exception
+ 
+       when Constraint_Error => null;      -- exception expected.
+       when others           => 
+         Report.Failed ("Arr_Obj8 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Formal is array 
+         (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
+ 
+       type Actual is array 
+         (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
+ 
+       Arr_Obj9 : Actual;
+ 
+       procedure Proc9 (P : out Formal) is
+       begin
+          Report.Failed ("No exception raised in Proc9");
+ 
+       exception       
+ 
+          when Constraint_Error => 
+            Report.Failed ("Constraint_Error exception raised in Proc9");
+          when others           => 
+            Report.Failed ("Others exception raised in Proc9");
+       end;            
+ 
+    begin
+ 
+       -- Lengths mismatch in the type conversion, Constraint_Error raised.
+       Proc9 (Formal(Arr_Obj9));
+ 
+       Report.Failed ("Constraint_Error not raised in the call Proc9");
+ 
+    exception
+ 
+       when Constraint_Error => null;      -- exception expected.
+       when others           => 
+         Report.Failed ("Arr_Obj9 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    declare
+ 
+       type Formal is array (Int range <>, Int range <>) of Character;
+       type Actual is array (Positive range 5 .. 2,
+                             Positive range 1 .. 3) of Character;
+ 
+       Arr_Obj10 : Actual;
+ 
+       procedure Proc10 (P : out Formal) is
+       begin
+          if P'Last /= 2 and P'Last(2) /= 3 then
+             Report.Failed ("Wrong bounds passed for Arr_Obj10");
+          end if;
+ 
+          -- Lengths mismatch, Constraint_Error raised.
+          P := (1 .. 3 => (3 .. 1 => ' '));
+ 
+          Report.Comment ("Dead assignment prevention in Proc10 => " &
+                           Integer'Image (P'Last));
+ 
+          Report.Failed ("No exception raised in Proc10");
+ 
+       exception       
+ 
+          when Constraint_Error => null;      -- exception expected.
+          when others           => 
+            Report.Failed ("Others exception raised in Proc10");
+       end;            
+ 
+    begin
+ 
+       -- Same lengths, no Constraint_Error raised.
+       Proc10 (Formal(Arr_Obj10));
+ 
+       if Arr_Obj10'Last /= 2 and Arr_Obj10'Last(2) /= 3 then
+          Report.Failed ("Bounds changed for Arr_Obj10");
+       end if;
+ 
+    exception
+ 
+       when Constraint_Error => 
+         Report.Failed ("Constraint_Error exception raised after call Proc10");
+       when others           => 
+         Report.Failed ("Arr_Obj10 - others exception raised");
+ 
+    end;
+ 
+    ---------------------------------------------------------------------------
+    Report.Result;
+ 
+ end C460009;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,354 ----
+ -- C460010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for an array aggregate without an others choice assigned
+ --      to an object of a constrained array subtype, Constraint_Error is not
+ --      raised if the length of each dimension of the aggregate equals the
+ --      length of the corresponding dimension of the target object, even if
+ --      the bounds of the corresponding index ranges do not match.
+ --
+ -- TEST DESCRIPTION:
+ --      The test verifies that sliding of array bounds is performed on array
+ --      aggregates that are part of a larger aggregate, where the bounds of
+ --      the corresponding index ranges do not match but the lengths of the
+ --      corresponding dimensions are the same. Both aggregates containing
+ --      named associations and positional associations are checked. Cases
+ --      involving static and nonstatic index constraints, as well as pre-
+ --      defined and modular integer index subtypes, are included.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      15 Apr 96   SAIC    Prerelease version for ACVC 2.1.
+ --      20 Oct 96   SAIC    Removed unnecessary parentheses and type
+ --                          conversions.
+ --
+ --!
+ 
+ with Report;
+ pragma Elaborate (Report);
+ 
+ package C460010_0 is
+ 
+   type Modular_Type is mod 10;  -- Range 0 .. 9.
+ 
+ 
+   Two  : Modular_Type := Modular_Type (Report.Ident_Int(2));
+   Four : Modular_Type := Modular_Type (Report.Ident_Int(4));
+ 
+   type Array_Modular_Index is array (Modular_Type range <>) of Integer;
+ 
+   subtype Array_Static_Modular_Constraint    is Array_Modular_Index(2..4);
+   subtype Array_Nonstatic_Modular_Constraint is Array_Modular_Index(Two..Four);
+ 
+ end C460010_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ pragma Elaborate (Report);
+ 
+ package C460010_1 is
+ 
+   One  : Integer := Report.Ident_Int(1);
+   Ten  : Integer := Report.Ident_Int(10);
+ 
+   subtype Integer_Subtype is Integer range One .. Ten;
+ 
+ 
+   Two  : Integer := Report.Ident_Int(2);
+   Four : Integer := Report.Ident_Int(4);
+ 
+   type Array_Integer_Index is array (Integer_Subtype range <>) of Boolean;
+ 
+   subtype Array_Static_Integer_Constraint    is Array_Integer_Index(2..4);
+   subtype Array_Nonstatic_Integer_Constraint is Array_Integer_Index(Two..Four);
+ 
+ end C460010_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- Generic equality function:
+ 
+ generic
+    type Operand_Type is private;
+ function C460010_2 (L, R : Operand_Type) return Boolean;
+ 
+ 
+ function C460010_2 (L, R : Operand_Type) return Boolean is
+ begin
+    return L = R;
+ end C460010_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C460010_0;
+ with C460010_1;
+ with C460010_2;
+ 
+ with Report;
+ 
+ procedure C460010 is
+ 
+    generic function Generic_Equality renames C460010_2;
+ 
+ begin
+    Report.Test ("C460010", "Check that Constraint_Error is not raised if " &
+                 "an array aggregate without an others choice is assigned " &
+                 "to an object of a constrained array subtype, and the "    &
+                 "length of each dimension of the aggregate equals the "    &
+                 "length of the corresponding dimension of the target object");
+ 
+ 
+                ---=---=---=---=---=---=---=---=---=---=---
+ 
+ 
+    declare
+      type Arr is array (1..1) of C460010_0.Array_Static_Modular_Constraint;
+      function Equals is new Generic_Equality (Arr);
+      Target : Arr;
+    begin
+                        ---=---=---=---=---=---=---
+      CASE_1:
+      begin
+         Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 1");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 1");
+       end CASE_1;
+ 
+                        ---=---=---=---=---=---=---
+ 
+      CASE_2:
+      begin
+         Target := (1 => (5, 10, 15));  -- Positional associations.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 2");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 2");
+       end CASE_2;
+ 
+                        ---=---=---=---=---=---=---
+    end;
+ 
+ 
+                ---=---=---=---=---=---=---=---=---=---=---
+ 
+ 
+    declare
+      type Rec (Disc : C460010_0.Modular_Type := 4) is record
+        Arr : C460010_0.Array_Modular_Index(2 .. Disc);
+      end record;
+ 
+      function Equals is new Generic_Equality (Rec);
+      Target : Rec;
+    begin
+                        ---=---=---=---=---=---=---
+      CASE_3:
+      begin
+         Target := (Disc => 4, Arr => (1 => 1, 2 => 2, 3 => 3));  -- Named.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 3");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 3");
+       end CASE_3;
+ 
+                        ---=---=---=---=---=---=---
+ 
+      CASE_4:
+      begin
+         Target := (Disc => 4, Arr => (1 ,2, 3));    -- Positional.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 4");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 4");
+       end CASE_4;
+ 
+                        ---=---=---=---=---=---=---
+    end;
+ 
+ 
+                ---=---=---=---=---=---=---=---=---=---=---
+ 
+ 
+    declare
+      type Arr is array (1..1) of C460010_0.Array_Nonstatic_Modular_Constraint;
+      function Equals is new Generic_Equality (Arr);
+      Target : Arr;
+    begin
+                        ---=---=---=---=---=---=---
+      CASE_5:
+      begin
+         Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 5");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 5");
+       end CASE_5;
+ 
+                        ---=---=---=---=---=---=---
+ 
+      CASE_6:
+      begin
+         Target := (1 => ((5, 10, 15)));  -- Positional associations.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 6");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 6");
+       end CASE_6;
+ 
+                        ---=---=---=---=---=---=---
+    end;
+ 
+ 
+                ---=---=---=---=---=---=---=---=---=---=---
+ 
+ 
+    declare
+      type Arr is array (1..1) of C460010_1.Array_Static_Integer_Constraint;
+      function Equals is new Generic_Equality (Arr);
+      Target : Arr;
+    begin
+                        ---=---=---=---=---=---=---
+      CASE_7:
+      begin
+         Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 7");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 7");
+       end CASE_7;
+ 
+                        ---=---=---=---=---=---=---
+ 
+      CASE_8:
+      begin
+         Target := (1 => ((False, False, True)));  -- Positional.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 8");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 8");
+       end CASE_8;
+ 
+                        ---=---=---=---=---=---=---
+    end;
+ 
+ 
+                ---=---=---=---=---=---=---=---=---=---=---
+ 
+ 
+    declare
+      type Arr is array (1..1) of C460010_1.Array_Nonstatic_Integer_Constraint;
+      function Equals is new Generic_Equality (Arr);
+      Target : Arr;
+    begin
+                        ---=---=---=---=---=---=---
+      CASE_9:
+      begin
+         Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 9");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 9");
+       end CASE_9;
+ 
+                        ---=---=---=---=---=---=---
+ 
+      CASE_10:
+      begin
+         Target := (1 => (False, False, True));      -- Positional.
+ 
+         if not Equals (Target, Target) then
+              Report.Failed ("Avoid optimization");  -- Never executed.
+         end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Constraint_Error raised: Case 10");
+          when others           =>
+             Report.Failed ("Unexpected exception raised: Case 10");
+       end CASE_10;
+ 
+                        ---=---=---=---=---=---=---
+    end;
+ 
+ 
+                ---=---=---=---=---=---=---=---=---=---=---
+ 
+ 
+      Report.Result;
+ 
+ end C460010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,210 ----
+ -- C460011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are 
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release, 
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that conversion of a decimal type to a modular type raises
+ --     Constraint_Error when the operand value is outside the base range
+ --     of the modular type.
+ --     Check that a conversion of a decimal type to an integer type
+ --     rounds correctly.
+ --
+ -- TEST DESCRIPTION:
+ --      Test conversion from decimal types to modular types.  Test
+ --      conversion to mod 255, mod 256 and mod 258 to test the boundaries
+ --      of 8 bit (+/-) unsigned numbers.
+ --      Test operand values that are negative, the value of the mod,
+ --      and greater than the value of the mod.
+ --      Declare a generic test procedure and instantiate it for each of the
+ --      unsigned types for each operand type.
+ --      Check that the operand is properly rounded during the conversion.
+ --
+ -- APPLICABILITY CRITERIA:
+ --      This test is applicable to all implementations which support
+ --      decimal types.
+ --
+ -- CHANGE HISTORY:
+ --      24 NOV 98   RLB  Split decimal cases from C460008 into this
+ --                       test, added conversions to integer types.
+ --      18 JAN 99   RLB  Repaired errors in test.
+ --
+ --!
+ 
+ ------------------------------------------------------------------- C460011
+ 
+ with Report;
+ 
+ procedure C460011 is
+ 
+   Shy_By_One   : constant := 2**8-1;
+   Heavy_By_Two : constant := 2**8+2;
+ 
+   type Unsigned_Edge_8 is mod Shy_By_One;
+   type Unsigned_8_Bit  is mod 2**8;
+   type Unsigned_Over_8 is mod Heavy_By_Two;
+ 
+   type Signed_8_Bit is range -128 .. 127;
+   type Signed_Over_8 is range -200 .. 200;
+ 
+   NPC : constant String := " not properly converted";
+ 
+   procedure Assert( Truth: Boolean; Message: String ) is
+   begin
+     if not Truth then
+       Report.Failed(Message);
+     end if;
+   end Assert;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   type Decim is delta 0.1 digits 5;    -- N/A => ERROR.
+ 
+   generic
+     type Source is delta <> digits <>;
+     type Target is mod <>;
+   procedure Decimal_Conversion_Check( For_The_Value : Source;
+                                       Message       : String );
+ 
+   procedure Decimal_Conversion_Check( For_The_Value : Source;
+                                       Message       : String ) is
+ 
+     Item : Target;
+ 
+   begin  
+     Item := Target( For_The_Value );
+     Report.Failed("Deci expected Constraint_Error " & Message);
+     Report.Comment("Value of" & Target'Image(Item) & NPC);
+   exception
+     when Constraint_Error => null; -- expected case
+     when others => Report.Failed("Deci raised wrong exception " & Message);
+   end Decimal_Conversion_Check;
+ 
+   procedure Decim_To_Short is
+     new Decimal_Conversion_Check( Decim, Unsigned_Edge_8 );
+ 
+   procedure Decim_To_Eight is
+     new Decimal_Conversion_Check( Decim, Unsigned_8_Bit );
+ 
+   procedure Decim_To_Wide is
+     new Decimal_Conversion_Check( Decim, Unsigned_Over_8 );
+ 
+   function Identity( Launder: Decim ) return Decim is
+     Flat_Broke : constant Decim := 0.0;
+   begin
+     if Report.Ident_Bool( Launder = Flat_Broke ) then
+       return Flat_Broke;
+     else
+       return Launder;
+     end if;
+   end Identity;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C460011", "Check that conversion to " &
+                           "a modular type raises Constraint_Error when " &
+                           "the operand value is outside the base range " &
+                           "of the modular type" );
+    
+   -- Decimal Error cases
+ 
+   Decim_To_Short( Identity( -5.00 ), "M2S Dynamic, Negative" );
+   Decim_To_Short( Shy_By_One * 1.0, "M2S Static,  At_Mod" );
+   Decim_To_Short( 1995.9, "M2S Static,  Over_Mod" );
+ 
+   Decim_To_Eight( -0.5, "M28 Static, Negative" );
+   Decim_To_Eight( 2.0*128, "M28 Static,  At_Mod" );
+   Decim_To_Eight( Identity( 2001.2 ), "M28 Dynamic, Over_Mod" );
+ 
+   Decim_To_Wide ( Decim'First, "M2W Static,  Negative" );
+   Decim_To_Wide ( Identity( 2*128.0 +2.0 ), "M2W Dynamic, At_Mod" );
+   Decim_To_Wide ( Decim'Last, "M2W Static,  Over_Mod" );
+ 
+   -- Check a few, correct, edge cases, for modular types.
+ 
+   Eye_Dew: declare
+     Sense     : Decim    := 0.00;
+ 
+     Little   : Unsigned_Edge_8;
+     Moderate : Unsigned_8_Bit;
+     Big      : Unsigned_Over_8;
+ 
+   begin
+     Moderate := Unsigned_8_Bit (Sense);
+     Assert( Moderate = 0, "Sense => Moderate, 0");
+ 
+     Sense     := 2*128.0;
+ 
+     Big := Unsigned_Over_8 (Sense);
+     Assert( Big = 256, "Sense => Big, 256");
+ 
+   end Eye_Dew;
+ 
+   Rounding: declare
+     Easy     : Decim  := Identity ( 2.0);
+     Simple   : Decim  := Identity ( 2.1);
+     Halfway  : Decim  := Identity ( 2.5);
+     Upward   : Decim  := Identity ( 2.8);
+     Chop     : Decim  := Identity (-2.2);
+     Neg_Half : Decim  := Identity (-2.5);
+     Downward : Decim  := Identity (-2.7);
+ 
+     Little   : Unsigned_Edge_8;
+     Moderate : Unsigned_8_Bit;
+     Big      : Unsigned_Over_8;
+ 
+     Also_Little:Signed_8_Bit;
+     Also_Big : Signed_Over_8;
+     
+   begin
+     Little := Unsigned_Edge_8 (Easy);
+     Assert( Little = 2, "Easy => Little, 2");
+ 
+     Moderate := Unsigned_8_Bit (Simple);
+     Assert( Moderate = 2, "Simple => Moderate, 2");
+ 
+     Big := Unsigned_Over_8 (Halfway); -- Rounds up by 4.6(33).
+     Assert( Big = 3, "Halfway => Big, 3");
+ 
+     Little := Unsigned_Edge_8 (Upward);
+     Assert( Little = 3, "Upward => Little, 3");
+ 
+     Also_Big := Signed_Over_8 (Halfway); -- Rounds up by 4.6(33).
+     Assert( Also_Big = 3, "Halfway => Also_Big, 3");
+ 
+     Also_Little := Signed_8_Bit (Chop);
+     Assert( Also_Little = -2, "Chop => Also_Little, -2");
+ 
+     Also_Big := Signed_Over_8 (Neg_Half); -- Rounds down by 4.6(33).
+     Assert( Also_Big = -3, "Halfway => Also_Big, -3");
+ 
+     Also_Little := Signed_8_Bit (Downward);
+     Assert( Also_Little = -3, "Downward => Also_Little, -3");
+ 
+   end Rounding;
+ 
+ 
+   Report.Result;
+ 
+ end C460011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C460012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that the view created by a view conversion is constrained if the
+ --    target subtype is indefinite.  (Defect Report 8652/0017, Technical
+ --    Corrigendum 4.6(54/1)).
+ --
+ -- CHANGE HISTORY:
+ --    25 JAN 2001   PHL   Initial version.
+ --    29 JUN 2001   RLB   Reformatted for ACATS. Added optimization blocking.
+ --    02 JUL 2001   RLB   Fixed discriminant reference.
+ --
+ --!
+ with Ada.Exceptions;
+ use Ada.Exceptions;
+ with Report;
+ use Report;
+ procedure C460012 is
+ 
+     subtype Index is Positive range 1 .. 10;
+ 
+     type Definite_Parent (D1 : Index := 6) is
+ 	record
+ 	    F : String (1 .. D1) := (others => 'a');
+ 	end record;
+ 
+     type Indefinite_Child (D2 : Index) is new Definite_Parent (D1 => D2);
+ 
+     Y : Definite_Parent;
+ 
+     procedure P (X : in out Indefinite_Child) is
+ 	C : Character renames X.F (3);
+     begin
+ 	X := (1, "a");
+         if C /= 'a' then
+             Failed ("No exception raised when changing the " &
+ 		    "discriminant of a view conversion, value of C changed");
+         elsif X.D2 /= 1 then
+             Failed ("No exception raised when changing the " &
+ 		    "discriminant of a view conversion, discriminant not " &
+                     "changed");
+             -- This check primarily exists to prevent X from being optimized by
+             -- 11.6 permissions, or the Failed call being made before the assignment.
+         else
+             Failed ("No exception raised when changing the " &
+ 		    "discriminant of a view conversion, discriminant changed");
+         end if;
+     exception
+ 	when Constraint_Error =>
+ 	    null;
+ 	when E: others =>
+ 	    Failed ("Wrong exception " & Exception_Name (E) & " raised - " &
+ 		    Exception_Message (E));
+     end P;
+ 
+ begin
+     Test ("C460012",
+              "Check that the view created by a view conversion " &
+ 	     "is constrained if the target subtype is indefinite");
+ 
+     P (Indefinite_Child (Y));
+ 
+     if Y.D1 /= Ident_Int(6) then
+ 	Failed ("Discriminant of indefinite view changed");
+         -- This check exists mainly to prevent Y from being optimized away.
+     end if;
+ 
+     Result;
+ end C460012;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,188 ----
+ -- C460013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that if the target subtype excludes null, the value is not
+ --    null. Check access parameters, which null-excluding if:
+ --     (1) not null is given in their definition;
+ --     (2) the access parameter is controlling;
+ --     (3) an Ada 95 compiler is in use.
+ --
+ --    Note that the not null syntax is required even for Ada 95 compilers
+ --    (see AI95-00447).
+ --
+ -- CHANGE HISTORY:
+ --    18 DEC 2006   RLB   Initial version.
+ --    05 JAN 2007   RLB   Corrected syntax error.
+ --
+ --!
+ with Ada.Exceptions;
+ use Ada.Exceptions;
+ with Report;
+ use Report;
+ procedure C460013 is
+ 
+ 
+     package Nest1 is
+         type Doggie is tagged record
+             Cnt : Natural;
+         end record;
+         type Doggie_Access is access all Doggie;
+ 
+         procedure Controlled (P : access Doggie); -- Always null-excluding.
+     end Nest1;
+ 
+     package Nest2 is
+         type Kitty is record
+             Cnt : Natural;
+         end record;
+         type Kitty_Access is access all Kitty;
+ 
+         procedure Include (P : access Kitty); -- Null-excluding only in Ada 95.
+         procedure Exclude (P : not null access Kitty); -- Always null-excluding.
+     end Nest2;
+ 
+ 
+     package body Nest1 is
+         procedure Controlled (P : access Doggie) is
+         begin
+             if P.Cnt /= Ident_Int(4) then
+                 Failed ("Bad value in null-excluding controlling parameter");
+             -- else OK
+             end if;
+         exception
+             when Constraint_Error => -- Dereference of null
+                 Failed ("Null allowed in null-excluding controlling parameter");
+         end Controlled;
+     end Nest1;
+ 
+     package body Nest2 is
+         procedure Include (P : access Kitty) is
+         begin
+             if P.Cnt /= Ident_Int(31) then
+                 Failed ("Bad value in access parameter");
+             -- else OK
+             end if;
+         exception
+             when Constraint_Error => -- Dereference of null
+                 null;
+                 --Comment ("Null allowed in access parameter - Ada 2005 semantics");
+         end Include;
+ 
+         procedure Exclude (P : not null access Kitty) is
+         begin
+             if P.Cnt /= Ident_Int(80) then
+                 Failed ("Bad value in explicit null-excluding parameter");
+             -- else OK
+             end if;
+         exception
+             when Constraint_Error => -- Dereference of null
+                 Failed ("Null allowed in explicit null-excluding parameter");
+         end Exclude;
+     end Nest2;
+ 
+     Shep : aliased Nest1.Doggie := (Cnt => 4);
+     Frisky : aliased Nest2.Kitty := (Cnt => 80);
+     Snuggles : aliased Nest2.Kitty := (Cnt => 31);
+ 
+ begin
+     Test ("C460013",
+           "Check that if the target subtype excludes null, the value is not" &
+           " null - access parameter cases");
+ 
+     declare
+         Ptr : Nest1.Doggie_Access := Shep'Access;
+     begin
+         begin
+             Nest1.Controlled (Ptr); -- OK.
+         exception
+ 	    when A: others =>
+ 	        Failed ("Unexpected exception " & Exception_Name (A) &
+                         " raised (1A) - " & Exception_Message (A));
+         end;
+         Ptr := null;
+         begin
+             Nest1.Controlled (Ptr);
+ 	    Failed ("Null allowed for null-excluding controlling access parameter (1)");
+         exception
+             when Constraint_Error =>
+                 null;
+ 	    when B: others =>
+ 	        Failed ("Unexpected exception " & Exception_Name (B) &
+                         " raised (1B) - " & Exception_Message (B));
+         end;
+     end;
+ 
+     declare
+         Ptr : Nest2.Kitty_Access := Frisky'Access;
+     begin
+         begin
+             Nest2.Exclude (Ptr); -- OK.
+         exception
+ 	    when C: others =>
+ 	        Failed ("Unexpected exception " & Exception_Name (C) &
+                         " raised (2A) - " & Exception_Message (C));
+         end;
+         Ptr := null;
+         begin
+             Nest2.Exclude (Ptr);
+ 	    Failed ("Null allowed for null-excluding access parameter (2)");
+         exception
+             when Constraint_Error =>
+                 null;
+ 	    when D: others =>
+ 	        Failed ("Unexpected exception " & Exception_Name (D) &
+                         " raised (2B) - " & Exception_Message (D));
+         end;
+     end;
+ 
+     declare
+         Ptr : Nest2.Kitty_Access := Snuggles'Access;
+     begin
+         begin
+             Nest2.Include (Ptr); -- OK.
+         exception
+ 	    when E: others =>
+ 	        Failed ("Unexpected exception " & Exception_Name (E) &
+                         " raised (3A) - " & Exception_Message (E));
+         end;
+         Ptr := null;
+         begin
+             Nest2.Include (Ptr);
+             Comment ("Null allowed for normal access parameter - " &
+                      "Ada 2005 semantics");
+         exception
+             when Constraint_Error =>
+                 Comment ("Null not allowed for normal access parameter - " &
+                          "Ada 95 semantics");
+ 	    when F: others =>
+ 	        Failed ("Unexpected exception " & Exception_Name (F) &
+                         " raised (3B) - " & Exception_Message (F));
+         end;
+     end;
+ 
+     Result;
+ end C460013;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460014.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460014.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460014.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,289 ----
+ -- C460014.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --
+ --                                     Notice
+ --
+ --     The ACAA has created and maintains the Ada Conformity Assessment Test
+ --     Suite for the purpose of conformity assessments conducted in accordance
+ --     with the International Standard ISO/IEC 18009 - Ada: Conformity
+ --     assessment of a language processor. This test suite should not be used
+ --     to make claims of conformance unless used in accordance with
+ --     ISO/IEC 18009 and any applicable ACAA procedures.
+ --*
+ -- OBJECTIVES:
+ --      Check that if the operand type of a type conversion is
+ --      access-to-class-wide, Constraint_Error is raised if the tag of the
+ --      object designated by the operand does not identify a specific type
+ --      that is covered by or descended from the target type.
+ --
+ -- TEST DESCRIPTION:
+ --      Attempt to convert a parameter of a type that designates a class-wide
+ --      type to an object of a type that designates a specific member of that
+ --      class, for both an actual with a different tag and an actual with a
+ --      matching tag.
+ --
+ --      This test checks 4.6(42) as required by 4.6(50).
+ --
+ -- CHANGE HISTORY:
+ --      19 Aug 16   JAC     Initial pre-release version.
+ --      19 Jan 17   RLB     Readied for release: replaced objective, renamed
+ --                          to appropriate number, added class-wide cases,
+ --                          eliminated 11.6 problems, added third level of
+ --                          types, and checks on null.
+ --
+ --!
+ package C460014_1 is
+    type Root_Facade_Type is tagged record
+       Error_Code : Integer;
+    end record;
+ 
+    type Root_Facade_Ptr_Type is access all Root_Facade_Type;
+ 
+    type Facade_Class_Ptr_Type is access all Root_Facade_Type'Class;
+ 
+    type Data_A_Type is
+    record
+       A : Boolean;
+    end record;
+ 
+    type Facade_A_Type is new Root_Facade_Type with
+    record
+       Data_A : Data_A_Type;
+    end record;
+ 
+    type Facade_A_Ptr_Type is access all Facade_A_Type;
+ 
+    type Facade_A_Class_Ptr_Type is access all Facade_A_Type'Class;
+ 
+    type Facade_B_Type is new Facade_A_Type with
+    record
+       B : Character;
+    end record;
+ 
+    type Facade_B_Ptr_Type is access all Facade_B_Type;
+ 
+    type Facade_B_Class_Ptr_Type is access all Facade_B_Type'Class;
+ 
+    procedure Define_Construct
+      (Facade_Class_Ptr : in Facade_Class_Ptr_Type);
+ 
+    procedure Define_Class_Construct
+      (Facade_Class_Ptr : in Facade_Class_Ptr_Type);
+ 
+    function Init_Root_Facade_Ptr return Root_Facade_Ptr_Type;
+ 
+    function Init_Facade_A_Ptr     return Facade_A_Ptr_Type;
+ 
+    function Init_Facade_B_Ptr     return Facade_B_Ptr_Type;
+ 
+    function Init_Facade_Class_Ptr_with_Root return Facade_Class_Ptr_Type;
+ 
+    function Init_Facade_Class_Ptr_with_A return Facade_Class_Ptr_Type;
+ 
+    function Init_Facade_Class_Ptr_with_B return Facade_Class_Ptr_Type;
+ 
+ end C460014_1;
+ 
+ with Report;
+ package body C460014_1 is
+ 
+    procedure Define_Construct
+     (Facade_Class_Ptr : in Facade_Class_Ptr_Type) is
+ 
+       Facade_A_Ptr : constant Facade_A_Ptr_Type :=
+                                          Facade_A_Ptr_Type (Facade_Class_Ptr);
+ 
+       My_A : Data_A_Type renames Facade_A_Ptr.Data_A;
+    begin
+       if not My_A.A then
+          Report.Comment ("Wrong value"); -- So My_A is not dead by 11.6(5).
+       end if;
+    end Define_Construct;
+ 
+    procedure Define_Class_Construct
+     (Facade_Class_Ptr : in Facade_Class_Ptr_Type) is
+ 
+       Facade_Class_A_Ptr : constant Facade_A_Class_Ptr_Type :=
+                                   Facade_A_Class_Ptr_Type (Facade_Class_Ptr);
+ 
+    begin
+       if Facade_Class_A_Ptr /= null and then
+          (not Facade_Class_A_Ptr.Data_A.A) then
+          Report.Comment ("Wrong value"); -- So the ptr is not dead by 11.6(5).
+       end if;
+    end Define_Class_Construct;
+ 
+    Dummy_Root_Facade : aliased Root_Facade_Type := (Error_Code => 123);
+ 
+    function Init_Root_Facade_Ptr return Root_Facade_Ptr_Type is
+    begin
+       return Dummy_Root_Facade'Access;
+    end Init_Root_Facade_Ptr;
+ 
+    Dummy_Facade_A    : aliased Facade_A_Type := (Error_Code => 123,
+                                                  Data_A     => (A => True));
+ 
+    function Init_Facade_A_Ptr     return Facade_A_Ptr_Type is
+    begin
+       return Dummy_Facade_A'Access;
+    end Init_Facade_A_Ptr;
+ 
+    Dummy_Facade_B    : aliased Facade_B_Type := (Error_Code => 234,
+                                                  Data_A     => (A => True),
+                                                  B          => 'P');
+ 
+    function Init_Facade_B_Ptr     return Facade_B_Ptr_Type is
+    begin
+       return Dummy_Facade_B'Access;
+    end Init_Facade_B_Ptr;
+ 
+    function Init_Facade_Class_Ptr_with_Root return Facade_Class_Ptr_Type is
+    begin
+       return Dummy_Root_Facade'Access;
+    end Init_Facade_Class_Ptr_with_Root;
+ 
+    function Init_Facade_Class_Ptr_with_A return Facade_Class_Ptr_Type is
+    begin
+       return Dummy_Facade_A'Access;
+    end Init_Facade_Class_Ptr_with_A;
+ 
+    function Init_Facade_Class_Ptr_with_B return Facade_Class_Ptr_Type is
+    begin
+       return Dummy_Facade_B'Access;
+    end Init_Facade_Class_Ptr_with_B;
+ 
+ end C460014_1;
+ 
+ 
+ with C460014_1;
+ with Report;
+ 
+ procedure C460014 is
+ 
+    My_Root_Facade_Ptr : constant C460014_1.Facade_Class_Ptr_Type :=
+                                     C460014_1.Init_Facade_Class_Ptr_with_Root;
+ 
+    My_Facade_A_Ptr    : constant C460014_1.Facade_Class_Ptr_Type :=
+                                     C460014_1.Init_Facade_Class_Ptr_with_A;
+ 
+    My_Facade_B_Ptr    : constant C460014_1.Facade_Class_Ptr_Type :=
+                                     C460014_1.Init_Facade_Class_Ptr_with_B;
+ 
+    My_Null_Facade_B_Ptr    : constant C460014_1.Facade_B_Ptr_Type := null;
+ 
+    Constraint_Error_Raised : Boolean;
+ 
+    procedure Test_Define_Construct
+     (Facade_Class_Ptr : in C460014_1.Facade_Class_Ptr_Type) is
+    begin
+       Constraint_Error_Raised := False;
+       -- Should fail Tag_Check and therefore raise Constraint_Error if
+       -- parameter doesn't designate an object of Facade_A_Type
+       -- or Facade_B_Type.
+       C460014_1.Define_Construct (Facade_Class_Ptr => Facade_Class_Ptr);
+    exception
+       when Constraint_Error =>
+          Constraint_Error_Raised := True;
+    end Test_Define_Construct;
+ 
+ 
+    procedure Test_Define_Class_Construct
+     (Facade_Class_Ptr : in C460014_1.Facade_Class_Ptr_Type) is
+    begin
+       Constraint_Error_Raised := False;
+       -- Should fail Tag_Check and therefore raise Constraint_Error if
+       -- parameter doesn't designate an object of Facade_A_Type
+       -- or Facade_B_Type.
+       C460014_1.Define_Class_Construct (Facade_Class_Ptr => Facade_Class_Ptr);
+    exception
+       when Constraint_Error =>
+          Constraint_Error_Raised := True;
+    end Test_Define_Class_Construct;
+ 
+ begin
+ 
+    Report.Test
+      ("C460014",
+       "Check that if the operand type of a type conversion is " &
+       "access-to-class-wide, Constraint_Error is raised if the tag of the " &
+       "object designated by the operand does not identify a specific type " &
+       "that is covered by or descended from the target type");
+ 
+    Test_Define_Construct (Facade_Class_Ptr => My_Root_Facade_Ptr);
+ 
+    if not Constraint_Error_Raised then
+       Report.Failed ("Didn't get expected Constraint_Error (1)");
+    end if;
+ 
+    Test_Define_Construct
+      (Facade_Class_Ptr => My_Facade_A_Ptr);
+ 
+    if Constraint_Error_Raised then
+       Report.Failed ("Unexpected Constraint_Error (2)");
+    end if;
+ 
+    Test_Define_Construct
+      (Facade_Class_Ptr => My_Facade_B_Ptr);
+ 
+    if Constraint_Error_Raised then
+       Report.Failed ("Unexpected Constraint_Error (3)");
+    end if;
+ 
+    Test_Define_Class_Construct (Facade_Class_Ptr => My_Root_Facade_Ptr);
+ 
+    if not Constraint_Error_Raised then
+       Report.Failed ("Didn't get expected Constraint_Error (4)");
+    end if;
+ 
+    Test_Define_Class_Construct
+      (Facade_Class_Ptr => My_Facade_A_Ptr);
+ 
+    if Constraint_Error_Raised then
+       Report.Failed ("Unexpected Constraint_Error (5)");
+    end if;
+ 
+    Test_Define_Class_Construct
+      (Facade_Class_Ptr => My_Facade_B_Ptr);
+ 
+    if Constraint_Error_Raised then
+       Report.Failed ("Unexpected Constraint_Error (6)");
+    end if;
+ 
+    -- Check that it is OK to pass null and that does not cause some failure.
+    Test_Define_Class_Construct (Facade_Class_Ptr => null);
+ 
+    if Constraint_Error_Raised then
+       Report.Failed ("Unexpected Constraint_Error (7)");
+    end if;
+ 
+    Test_Define_Class_Construct (Facade_Class_Ptr =>
+       C460014_1.Facade_Class_Ptr_Type (My_Null_Facade_B_Ptr));
+ 
+    if Constraint_Error_Raised then
+       Report.Failed ("Unexpected Constraint_Error (8)");
+    end if;
+ 
+    Report.Result;
+ 
+ end C460014;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C46011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INTEGER CONVERSIONS ARE PERFORMED CORRECTLY WHEN THE 
+ -- TARGET AND OPERAND TYPES ARE BOTH INTEGER TYPES.
+ 
+ -- R.WILLIAMS 9/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46011A IS
+ 
+      TYPE INT1 IS RANGE -100 .. 100;
+      I1 : INT1 := INT1'VAL (IDENT_INT (10));
+      F1 : INT1 := INT1'VAL (IDENT_INT (-100));
+      L1 : INT1 := INT1'VAL (IDENT_INT (100));
+ 
+      TYPE INT2 IS RANGE -100 .. 100;
+      I2 : INT2 := INT2'VAL (IDENT_INT (10));
+      F2 : INT2 := INT2'VAL (IDENT_INT (-100));
+      L2 : INT2 := INT2'VAL (IDENT_INT (100));
+ 
+      
+      TYPE NEWINTEGER IS NEW INTEGER;
+      N1 : NEWINTEGER := 
+           NEWINTEGER'VAL (IDENT_INT (10));
+ 
+      T1 : INTEGER := IDENT_INT (10);
+ 
+      U1 : CONSTANT := INTEGER'POS (10);
+ BEGIN
+      TEST ( "C46011A", "CHECK THAT INTEGER CONVERSIONS ARE " &
+                        "PERFORMED CORRECTLY WHEN THE TARGET AND " &
+                        "OPERAND TYPES ARE BOTH INTEGER TYPES" );
+      
+      IF INT1 (U1) /= U1 THEN 
+           FAILED ( "INCORRECT CONVERSION OF 'INT1 (U1)'" );
+      END IF;
+ 
+      IF INT1 (I1) /= I1 THEN 
+           FAILED ( "INCORRECT CONVERSION OF 'INT1 (I1)'" );
+      END IF;
+ 
+      IF INT1 (N1) /= I1 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT1 (N1)'" );
+      END IF;
+ 
+      IF INT1 (10) /= I1 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT1 (10)'" );
+      END IF;
+ 
+      IF INT1 (T1) /= I1 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT1 (T1)'" );
+      END IF;
+ 
+      IF INT1 (F2) /= F1 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT1 (F2)'" );
+      END IF;
+ 
+      IF INT1 (L2) /= L1 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT1 (L2)'" );
+      END IF;
+ 
+      IF INT2 (I1) /= I2 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT2 (I1)'" );
+      END IF;
+ 
+      IF INT2 (T1) /= 10 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT2 (T1)'" );
+      END IF;
+ 
+      IF INT2 (F1) /= -100 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT2 (F1)'" );
+      END IF;
+ 
+      IF INT2 (L1) /= 100 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INT2 (L1)'" );
+      END IF;
+ 
+      IF NEWINTEGER (I1) /= N1 THEN 
+           FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (I1)'" );
+      END IF;
+ 
+      IF NEWINTEGER (N1) /= N1 THEN 
+           FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (N1)'" );
+      END IF;
+ 
+      IF NEWINTEGER (T1) /= N1 THEN 
+           FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (T1)'" );
+      END IF;
+ 
+      IF NEWINTEGER (INTEGER (N1)) /= N1 THEN 
+           FAILED ( "INCORRECT CONVERSION OF " &
+                    "'NEWINTEGER (INTEGER (N1))'" );
+      END IF;
+ 
+      IF NEWINTEGER (INTEGER (N1 + 1)) /= 11 THEN 
+           FAILED ( "INCORRECT CONVERSION OF " &
+                    "'NEWINTEGER (INTEGER (N1 + 1))'" );
+      END IF;
+ 
+      IF INTEGER (10) /= T1 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (10)'" );
+      END IF;
+ 
+      IF INTEGER (N1) /= 10 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (N1)'" );
+      END IF;
+      
+      IF INTEGER (I1) /= T1 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (I1)'" );
+      END IF;     
+ 
+      IF INTEGER (INT1 (NEWINTEGER (INT1 (I1)))) /= T1 THEN
+           FAILED ( "INCORRECT CONVERSION OF " &
+                    "'INTEGER (INT1 (NEWINTEGER (INT1 (I1)))'" );
+      END IF;     
+ 
+      
+      IF INTEGER (I1 + 1) /= 11 THEN
+           FAILED ( "INCORRECT CONVERSION OF 'INTEGER (I1 + 1)'" );
+      END IF;     
+ 
+      RESULT;
+ END C46011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46013a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46013a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46013a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,260 ----
+ -- C46013A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT INTEGER CONVERSIONS ARE PERFORMED CORRECTLY WHEN THE
+ --     OPERAND TYPE IS A FIXED POINT TYPE.
+ 
+ -- HISTORY:
+ --     JET 02/09/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C46013A IS
+ 
+      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+      TYPE FIX4 IS NEW FIX1;
+ 
+      F1 : FIX1 := 7.75;
+      F2 : FIX2 := -111.25;
+      F3 : FIX3 := 0.875;
+      F4 : FIX4 := -15.25;
+ 
+      TYPE INT IS RANGE -512 .. 512;
+ 
+      FUNCTION IDENT (I : INT) RETURN INT IS
+      BEGIN
+           RETURN I * INT(IDENT_INT(1));
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C46013A", "CHECK THAT INTEGER CONVERSIONS ARE PERFORMED " &
+                       "CORRECTLY WHEN THE OPERAND TYPE IS A FIXED " &
+                       "POINT TYPE");
+ 
+      IF INTEGER(FIX1'(-7.25)) /= IDENT_INT(-7) THEN
+           FAILED ("INCORRECT VALUE (1)");
+      END IF;
+ 
+      IF INTEGER(FIX1'(6.75)) /= IDENT_INT(7) THEN
+           FAILED ("INCORRECT VALUE (2)");
+      END IF;
+ 
+      IF INTEGER(F1) /= IDENT_INT(8) THEN
+           FAILED ("INCORRECT VALUE (3)");
+      END IF;
+ 
+      IF INT(FIX1'(-7.25)) /= IDENT(-7) THEN
+           FAILED ("INCORRECT VALUE (4)");
+      END IF;
+ 
+      IF INTEGER(FIX1'(3.33)) /= IDENT_INT(3) AND
+         INTEGER(FIX1'(3.33)) /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE (5)");
+      END IF;
+ 
+      IF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
+         INTEGER(FIX1'(-1.5)) = IDENT_INT(-1) AND
+         INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
+         INTEGER(FIX1'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX1 HALF VALUES ROUND UP");
+      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX1'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX1 HALF VALUES ROUND DOWN");
+      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX1 HALF VALUES ROUND TO EVEN");
+      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX1'(-1.5)) = IDENT_INT(-1) AND
+            INTEGER(FIX1'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX1 HALF VALUES ROUND TOWARD ZERO");
+      ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX1'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX1 HALF VALUES ROUND AWAY FROM ZERO");
+      ELSE
+           COMMENT ("FIX1 HALF VALUES ROUND ERRATICALLY");
+      END IF;
+ 
+      IF INTEGER(FIX2'(-127.9375)) /= IDENT_INT(-128) THEN
+           FAILED ("INCORRECT VALUE (6)");
+      END IF;
+ 
+      IF INTEGER(FIX2'(127.0625)) /= IDENT_INT(127) THEN
+           FAILED ("INCORRECT VALUE (7)");
+      END IF;
+ 
+      IF INTEGER(F2) /= IDENT_INT(-111) THEN
+           FAILED ("INCORRECT VALUE (8)");
+      END IF;
+ 
+      IF INT(FIX2'(-0.25)) /= IDENT(0) THEN
+           FAILED ("INCORRECT VALUE (9)");
+      END IF;
+ 
+      IF INTEGER(FIX2'(66.67)) /= IDENT_INT(67) AND
+         INTEGER(FIX2'(66.67)) /= IDENT_INT(66) THEN
+           FAILED ("INCORRECT VALUE (10)");
+      END IF;
+ 
+      IF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
+         INTEGER(FIX2'(-1.5)) = IDENT_INT(-1) AND
+         INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
+         INTEGER(FIX2'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX2 HALF VALUES ROUND UP");
+      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX2'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX2 HALF VALUES ROUND DOWN");
+      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX2 HALF VALUES ROUND TO EVEN");
+      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX2'(-1.5)) = IDENT_INT(-1) AND
+            INTEGER(FIX2'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX2 HALF VALUES ROUND TOWARD ZERO");
+      ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX2'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX2 HALF VALUES ROUND AWAY FROM ZERO");
+      ELSE
+           COMMENT ("FIX2 HALF VALUES ROUND ERRATICALLY");
+      END IF;
+ 
+      IF INTEGER(FIX3'(-0.25)) /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE (11)");
+      END IF;
+ 
+      IF INTEGER(FIX3'(511.75)) /= IDENT_INT(512) THEN
+           FAILED ("INCORRECT VALUE (12)");
+      END IF;
+ 
+      IF INTEGER(F3) /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE (13)");
+      END IF;
+ 
+      IF INT(FIX3'(-7.0)) /= IDENT(-7) THEN
+           FAILED ("INCORRECT VALUE (14)");
+      END IF;
+ 
+      IF INTEGER(FIX3'(-66.67)) /= IDENT_INT(-67) AND
+         INTEGER(FIX3'(-66.67)) /= IDENT_INT(-66) THEN
+           FAILED ("INCORRECT VALUE (15)");
+      END IF;
+ 
+      IF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
+         INTEGER(FIX3'(-1.5)) = IDENT_INT(-1) AND
+         INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
+         INTEGER(FIX3'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX3 HALF VALUES ROUND UP");
+      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX3'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX3 HALF VALUES ROUND DOWN");
+      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX3 HALF VALUES ROUND TO EVEN");
+      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX3'(-1.5)) = IDENT_INT(-1) AND
+            INTEGER(FIX3'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX3 HALF VALUES ROUND TOWARD ZERO");
+      ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX3'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX3 HALF VALUES ROUND AWAY FROM ZERO");
+      ELSE
+           COMMENT ("FIX3 HALF VALUES ROUND ERRATICALLY");
+      END IF;
+ 
+      IF INTEGER(FIX4'(-7.25)) /= IDENT_INT(-7) THEN
+           FAILED ("INCORRECT VALUE (16)");
+      END IF;
+ 
+      IF INTEGER(FIX4'(6.75)) /= IDENT_INT(7) THEN
+           FAILED ("INCORRECT VALUE (17)");
+      END IF;
+ 
+      IF INTEGER(F4) /= IDENT_INT(-15) THEN
+           FAILED ("INCORRECT VALUE (18)");
+      END IF;
+ 
+      IF INT(FIX4'(-31.75)) /= IDENT(-32) THEN
+           FAILED ("INCORRECT VALUE (19)");
+      END IF;
+ 
+      IF INTEGER(FIX4'(3.33)) /= IDENT_INT(3) AND
+         INTEGER(FIX4'(3.33)) /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE (20)");
+      END IF;
+ 
+      IF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
+         INTEGER(FIX4'(-1.5)) = IDENT_INT(-1) AND
+         INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
+         INTEGER(FIX4'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX4 HALF VALUES ROUND UP");
+      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX4'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX4 HALF VALUES ROUND DOWN");
+      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX4 HALF VALUES ROUND TO EVEN");
+      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX4'(-1.5)) = IDENT_INT(-1) AND
+            INTEGER(FIX4'(1.5)) = IDENT_INT(1) AND
+            INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
+           COMMENT ("FIX4 HALF VALUES ROUND TOWARD ZERO");
+      ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-3) AND
+            INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
+            INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
+            INTEGER(FIX4'(2.5)) = IDENT_INT(3) THEN
+           COMMENT ("FIX4 HALF VALUES ROUND AWAY FROM ZERO");
+      ELSE
+           COMMENT ("FIX4 HALF VALUES ROUND ERRATICALLY");
+      END IF;
+ 
+      RESULT;
+ 
+ END C46013A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46014a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46014a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46014a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,287 ----
+ -- C46014A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR PREDEFINED TYPE INTEGER, CHECK THAT
+ --     CONSTRAINT_ERROR IS RAISED IF THE OPERAND VALUE OF A
+ --     CONVERSION LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S BASE
+ --     TYPE. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE
+ --     OPERAND VALUE LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S
+ --     SUBTYPE BUT WITHIN THE RANGE OF THE BASE TYPE.
+ 
+ -- HISTORY:
+ --     RJW 09/08/86  CREATED ORIGINAL TEST.
+ --     RJW 11/13/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
+ --     JET 12/30/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
+ --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ --     JRL 12/08/96  Changed usages of System.Max_Int and System.Min_Int to
+ --                   Integer'Base'Last and Integer'Base'First in first two
+ --                   subtests.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46014A IS
+ 
+      SUBTYPE SMALL IS INTEGER RANGE -100 .. 100;
+      S1 : SMALL;
+ 
+      TYPE INT IS RANGE -100 .. 100;
+      T1 : INT;
+ 
+      TYPE NEWINTEGER IS NEW INTEGER;
+      N1 : NEWINTEGER;
+ 
+      SUBTYPE SUBNEW IS NEWINTEGER RANGE -100 .. 100;
+      SN : SUBNEW;
+ 
+      I1 : INTEGER;
+      P1 : POSITIVE;
+      L1 : NATURAL;
+ 
+      FUNCTION IDENT (I : INTEGER) RETURN INT IS
+      BEGIN
+           RETURN INT'VAL (IDENT_INT (I));
+      END IDENT;
+ 
+      FUNCTION IDENT (I : NEWINTEGER) RETURN NEWINTEGER IS
+      BEGIN
+           RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (I)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C46014A", "FOR PREDEFINED TYPE INTEGER, CHECK THAT " &
+                        "CONSTRAINT_ERROR IS RAISED IF " &
+                        "THE OPERAND VALUE OF A CONVERSION LIES " &
+                        "OUTSIDE OF THE RANGE OF THE TARGET TYPE'S " &
+                        "BASE TYPE. ALSO, CHECK THAT " &
+                        "CONSTRAINT_ERROR IS RAISED IF THE OPERAND " &
+                        "VALUE LIES OUTSIDE OF THE RANGE OF THE " &
+                        "TARGET TYPE'S SUBTYPE BUT WITHIN THE " &
+                        "RANGE OF THE BASE TYPE" );
+ 
+      BEGIN
+           I1 := Integer'Base'Last + Ident_Int(1);
+           Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
+           IF EQUAL (I1, I1) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'LAST + 1");
+           WHEN OTHERS =>
+                Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
+      END;
+ 
+      BEGIN
+           I1 := Integer'Base'First - Ident_Int(1);
+           Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
+           IF EQUAL (I1, I1) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'FIRST - 1");
+           WHEN OTHERS =>
+                Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
+      END;
+ 
+      BEGIN
+           I1 := INTEGER (IDENT_INT (INTEGER'FIRST) - 1);
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "INTEGER (IDENT_INT (INTEGER'FIRST) - 1)" );
+           IF EQUAL (I1, I1) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
+                          "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
+      END;
+ 
+      BEGIN
+           N1 := NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1);
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1)" );
+           IF EQUAL (INTEGER (N1), INTEGER (N1)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
+                          "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
+      END;
+ 
+      BEGIN
+           T1 := INT (INT'BASE'FIRST - IDENT (1));
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "INT (INT'BASE'FIRST - IDENT (1))" );
+           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
+                          "INT (INT'BASE'FIRST - IDENT (1))" );
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "INT (INT'BASE'FIRST - IDENT (1))" );
+      END;
+ 
+      BEGIN
+           T1 := IDENT (-101);
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "T1 := -101" );
+           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "T1 := -101" );
+      END;
+ 
+      BEGIN
+           T1 := INTEGER'POS (IDENT_INT (101));
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "T1 := INTEGER'POS (IDENT_INT (101))" );
+           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "T1 := INTEGER'POS (IDENT_INT (101));" );
+      END;
+ 
+      BEGIN
+           T1 := INT (IDENT (INTEGER (INT'FIRST)) - 1);
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "INT (INT'FIRST - 1)" );
+           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "INT (INT'FIRST - 1)" );
+      END;
+ 
+      BEGIN
+           T1 := INT (IDENT_INT (101));
+           FAILED ( "NO EXCEPTION RAISED FOR INT (101)" );
+           IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INT (101)" );
+      END;
+ 
+      BEGIN
+           S1 := SMALL (IDENT_INT (101));
+           FAILED ( "NO EXCEPTION RAISED FOR SMALL (101)" );
+           IF EQUAL (S1, S1) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR SMALL (101)" );
+      END;
+ 
+      BEGIN
+           SN := SUBNEW (IDENT_INT (-101));
+           FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (-101)" );
+           IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (-101)" );
+      END;
+ 
+      BEGIN
+           P1 := IDENT_INT (101);
+           SN := SUBNEW (P1);
+           FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (P1)" );
+           IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (P1)" );
+      END;
+ 
+      BEGIN
+           SN := IDENT (0);
+           P1 := POSITIVE (SN);
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "POSITIVE (SN)" );
+           IF EQUAL (P1, P1) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "POSITIVE (SN)" );
+      END;
+ 
+      BEGIN
+           N1 := IDENT (-1);
+           L1 := NATURAL (N1);
+           FAILED ( "NO EXCEPTION RAISED FOR " &
+                    "NATURAL (N1)" );
+           IF EQUAL (L1, L1) THEN
+                COMMENT ("SHOULDN'T GET HERE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                         "NATURAL (N1)" );
+      END;
+ 
+      RESULT;
+ END C46014A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46021a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46021a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46021a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46021a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,210 ----
+ -- C46021A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FLOATING POINT CONVERSIONS ARE PERFORMED CORRECTLY
+ --     WHEN THE OPERAND TYPE IS AN INTEGER TYPE, FOR 5-DIGIT PRECISION.
+ 
+ -- HISTORY:
+ --     JET 02/12/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C46021A IS
+ 
+      TYPE FLOAT5 IS DIGITS 5;
+      TYPE INT IS RANGE -32768..32767;
+ 
+      TYPE NFLOAT5 IS NEW FLOAT5;
+ 
+      FUNCTION IDENT (A : FLOAT5) RETURN FLOAT5 IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN A;
+           ELSE
+                RETURN 0.0;
+           END IF;
+      END IDENT;
+ 
+      FUNCTION IDENT (A : NFLOAT5) RETURN NFLOAT5 IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN A;
+           ELSE
+                RETURN 0.0;
+           END IF;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C46021A", "CHECK THAT FLOATING POINT CONVERSIONS ARE " &
+                       "PERFORMED CORRECTLY WHEN THE OPERAND TYPE " &
+                       "IS AN INTEGER TYPE, FOR 5-DIGIT PRECISION");
+ 
+      IF FLOAT5(IDENT_INT(-7)) /= -7.0 THEN
+           FAILED ("INCORRECT VALUE (1)");
+      END IF;
+ 
+      IF FLOAT5(IDENT_INT(3)) /= 3.0 THEN
+           FAILED ("INCORRECT VALUE (2)");
+      END IF;
+ 
+      IF FLOAT5(IDENT_INT(-999)) /= -999.0 THEN
+           FAILED ("INCORRECT VALUE (3)");
+      END IF;
+ 
+      IF FLOAT5(IDENT_INT(101)) /= 101.0 THEN
+           FAILED ("INCORRECT VALUE (4)");
+      END IF;
+ 
+      IF FLOAT5(IDENT_INT(-32767)) /= -32767.0 THEN
+           FAILED ("INCORRECT VALUE (5)");
+      END IF;
+ 
+      IF FLOAT5(IDENT_INT(32767)) /= 32767.0 THEN
+           FAILED ("INCORRECT VALUE (6)");
+      END IF;
+ 
+      IF FLOAT5(-7) /= IDENT(-7.0) THEN
+           FAILED ("INCORRECT VALUE (7)");
+      END IF;
+ 
+      IF FLOAT5(3) /= IDENT(3.0) THEN
+           FAILED ("INCORRECT VALUE (8)");
+      END IF;
+ 
+      IF FLOAT5(-999) /= IDENT(-999.0) THEN
+           FAILED ("INCORRECT VALUE (9)");
+      END IF;
+ 
+      IF FLOAT5(101) /= IDENT(101.0) THEN
+           FAILED ("INCORRECT VALUE (10)");
+      END IF;
+ 
+      IF FLOAT5(-32767) /= IDENT(-32767.0) THEN
+           FAILED ("INCORRECT VALUE (11)");
+      END IF;
+ 
+      IF FLOAT5(32767) /= IDENT(32767.0) THEN
+           FAILED ("INCORRECT VALUE (12)");
+      END IF;
+ 
+      IF FLOAT5(INT'(-7)) /= IDENT(-7.0) THEN
+           FAILED ("INCORRECT VALUE (13)");
+      END IF;
+ 
+      IF FLOAT5(INT'(3)) /= IDENT(3.0) THEN
+           FAILED ("INCORRECT VALUE (14)");
+      END IF;
+ 
+      IF FLOAT5(INT'(-999)) /= IDENT(-999.0) THEN
+           FAILED ("INCORRECT VALUE (15)");
+      END IF;
+ 
+      IF FLOAT5(INT'(101)) /= IDENT(101.0) THEN
+           FAILED ("INCORRECT VALUE (16)");
+      END IF;
+ 
+      IF FLOAT5(INT'(-32767)) /= IDENT(-32767.0) THEN
+           FAILED ("INCORRECT VALUE (17)");
+      END IF;
+ 
+      IF FLOAT5(INT'(32767)) /= IDENT(32767.0) THEN
+           FAILED ("INCORRECT VALUE (18)");
+      END IF;
+ 
+      IF NFLOAT5(IDENT_INT(-7)) /= -7.0 THEN
+           FAILED ("INCORRECT VALUE (19)");
+      END IF;
+ 
+      IF NFLOAT5(IDENT_INT(3)) /= 3.0 THEN
+           FAILED ("INCORRECT VALUE (20)");
+      END IF;
+ 
+      IF NFLOAT5(IDENT_INT(-999)) /= -999.0 THEN
+           FAILED ("INCORRECT VALUE (21)");
+      END IF;
+ 
+      IF NFLOAT5(IDENT_INT(101)) /= 101.0 THEN
+           FAILED ("INCORRECT VALUE (22)");
+      END IF;
+ 
+      IF NFLOAT5(IDENT_INT(-32767)) /= -32767.0 THEN
+           FAILED ("INCORRECT VALUE (23)");
+      END IF;
+ 
+      IF NFLOAT5(IDENT_INT(32767)) /= 32767.0 THEN
+           FAILED ("INCORRECT VALUE (24)");
+      END IF;
+ 
+      IF NFLOAT5(-7) /= IDENT(-7.0) THEN
+           FAILED ("INCORRECT VALUE (25)");
+      END IF;
+ 
+      IF NFLOAT5(3) /= IDENT(3.0) THEN
+           FAILED ("INCORRECT VALUE (26)");
+      END IF;
+ 
+      IF NFLOAT5(-999) /= IDENT(-999.0) THEN
+           FAILED ("INCORRECT VALUE (27)");
+      END IF;
+ 
+      IF NFLOAT5(101) /= IDENT(101.0) THEN
+           FAILED ("INCORRECT VALUE (28)");
+      END IF;
+ 
+      IF NFLOAT5(-32767) /= IDENT(-32767.0) THEN
+           FAILED ("INCORRECT VALUE (29)");
+      END IF;
+ 
+      IF NFLOAT5(32767) /= IDENT(32767.0) THEN
+           FAILED ("INCORRECT VALUE (30)");
+      END IF;
+ 
+      IF NFLOAT5(INT'(-7)) /= IDENT(-7.0) THEN
+           FAILED ("INCORRECT VALUE (31)");
+      END IF;
+ 
+      IF NFLOAT5(INT'(3)) /= IDENT(3.0) THEN
+           FAILED ("INCORRECT VALUE (32)");
+      END IF;
+ 
+      IF NFLOAT5(INT'(-999)) /= IDENT(-999.0) THEN
+           FAILED ("INCORRECT VALUE (33)");
+      END IF;
+ 
+      IF NFLOAT5(INT'(101)) /= IDENT(101.0) THEN
+           FAILED ("INCORRECT VALUE (34)");
+      END IF;
+ 
+      IF NFLOAT5(INT'(-32767)) /= IDENT(-32767.0) THEN
+           FAILED ("INCORRECT VALUE (35)");
+      END IF;
+ 
+      IF NFLOAT5(INT'(32767)) /= IDENT(32767.0) THEN
+           FAILED ("INCORRECT VALUE (36)");
+      END IF;
+ 
+      RESULT;
+ 
+ END C46021A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46024a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46024a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46024a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46024a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C46024A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK FLOATING POINT CONVERSIONS WHEN THE TARGET TYPE IS A
+ --     FIXED POINT TYPE, FOR DIGITS 5.
+ 
+ -- HISTORY:
+ --     JET 02/19/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C46024A IS
+ 
+      TYPE FLOAT5 IS DIGITS 5;
+      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+ 
+      F5, F5A, F5B : FLOAT5;
+ 
+      GENERIC
+           TYPE F IS DELTA <>;
+      FUNCTION IDENTG (A : F) RETURN F;
+ 
+      FUNCTION IDENTG (A : F) RETURN F IS
+      BEGIN
+           RETURN A + F(IDENT_INT(0));
+      END IDENTG;
+ 
+      FUNCTION IDENT1 IS NEW IDENTG(FIX1);
+      FUNCTION IDENT2 IS NEW IDENTG(FIX2);
+      FUNCTION IDENT3 IS NEW IDENTG(FIX3);
+ 
+ BEGIN
+      TEST ("C46024A", "CHECK FLOATING POINT CONVERSIONS WHEN THE " &
+                       "TARGET TYPE IS A FIXED POINT TYPE, FOR " &
+                       "5-DIGIT PRECISION");
+ 
+      IF FIX1(FLOAT5'(2#0.1000_0000_0000_0000_00#E-1)) /=
+         IDENT1(2#0.01#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+      END IF;
+ 
+      IF FIX1(FLOAT5'(-2#0.1111_1110_0000_0000_00#E5)) /=
+         IDENT1(-2#1_1111.11#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+      END IF;
+ 
+      IF FIX1(FLOAT5'(-2#0.1010_0111_1111_1111_11#E4)) <
+         IDENT1(-2#1010.10#) OR
+         FIX1(FLOAT5'(-2#0.1010_0111_1111_1111_11#E4)) >
+         IDENT1(-2#1010.01#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+      END IF;
+ 
+      IF FIX2(FLOAT5'(-2#0.1000_0000_0000_0000_00#E-3)) /=
+         IDENT2(-2#0.0001#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+      END IF;
+ 
+      IF FIX2(FLOAT5'(2#0.1111_1111_1110_0000_00#E7)) /=
+         IDENT2(2#111_1111.1111#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+      END IF;
+ 
+      F5 := 2#0.1010_1010_1010_1010_10#E5;
+      IF FIX2(F5) < IDENT2(2#1_0101.0101#) OR
+         FIX2(F5) > IDENT2(2#1_0101.0110#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+      END IF;
+ 
+      IF FIX3(FLOAT5'(2#0.1000_0000_0000_0000_00#E-5)) /=
+         IDENT3(2#0.000001#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
+      END IF;
+ 
+      IF FIX3(FLOAT5'(-2#0.1111_1111_1111_1110_00#E9)) /=
+         IDENT3(-2#1_1111_1111.1111_11#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
+      END IF;
+ 
+      F5 := -2#0.1010_1010_1010_1010_10#E8;
+      IF FIX3(F5) < IDENT3(-2#1010_1010.1010_11#) OR
+         FIX3(F5) > IDENT3(-2#1010_1010.1010_10#) THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
+      END IF;
+ 
+      F5A := 2#0.1010_1010_1010_1010_10#E4;
+      F5B := 2#0.1010_1010_1010_1010_10#E5;
+ 
+      IF FIX1(F5A) = IDENT1(2#1010.11#)   AND
+         FIX1(-F5A) = IDENT1(-2#1010.11#) AND
+         FIX1(F5B) = IDENT1(2#1_0101.01#) AND
+         FIX1(-F5B) = IDENT1(-2#1_0101.01#) THEN
+           COMMENT ("CONVERSION ROUNDS TO NEAREST");
+      ELSIF FIX1(F5A) = IDENT1(2#1010.10#) AND
+            FIX1(-F5B) = IDENT1(-2#1_0101.10#) THEN
+           COMMENT ("CONVERSION ROUNDS TO LEAST FIXED-POINT VALUE");
+      ELSIF FIX1(F5B) = IDENT1(2#1_0101.10#) AND
+            FIX1(-F5A) = IDENT1(-2#1010.10#) THEN
+           COMMENT ("CONVERSION ROUNDS TO GREATEST FIXED-POINT VALUE");
+      ELSIF FIX1(F5A) = IDENT1(2#1010.10#) AND
+            FIX1(-F5A) = IDENT1(-2#1010.10#) THEN
+           COMMENT ("CONVERSION ROUNDS TOWARD ZERO");
+      ELSIF FIX1(F5B) = IDENT1(2#1_0101.10#) AND
+            FIX1(-F5B) = IDENT1(-2#1_0101.10#) THEN
+           COMMENT ("CONVERSION ROUNDS AWAY FROM ZERO");
+      ELSE
+           COMMENT ("UNABLE TO DETERMINE CONVERSION PATTERN");
+      END IF;
+ 
+      RESULT;
+ 
+ END C46024A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46031a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46031a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46031a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46031a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C46031A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
+ --     IS AN INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     JET 07/11/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46031A IS
+ 
+      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+ 
+      TYPE NEW_INT IS NEW INTEGER RANGE -16#200# .. 16#200#;
+ 
+      I : INTEGER;
+      J : NEW_INT;
+ 
+      FUNCTION IDENT_NEW (X : NEW_INT) RETURN NEW_INT IS
+      BEGIN
+           RETURN X * NEW_INT(IDENT_INT(1));
+      END IDENT_NEW;
+ 
+ BEGIN
+      TEST ("C46031A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
+                       "THE OPERAND TYPE IS AN INTEGER TYPE");
+ 
+      I := IDENT_INT(-16#1F#);
+      IF FIX1(I) /= -16#1F.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+      END IF;
+ 
+      J := IDENT_NEW(0);
+      IF FIX1(J) /= 0.0 THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+      END IF;
+ 
+      I := IDENT_INT(16#7F#);
+      IF FIX2(I) /= 16#7F.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+      END IF;
+ 
+      J := IDENT_NEW(16#1#);
+      IF FIX2(J) /= 16#1.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+      END IF;
+ 
+      I := IDENT_INT(-16#55#);
+      IF FIX3(I) /= -16#55.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+      END IF;
+ 
+      J := IDENT_NEW(-16#1#);
+      IF FIX3(J) /= -16#1.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+      END IF;
+ 
+      RESULT;
+ 
+ END C46031A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46032a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46032a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46032a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46032a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C46032A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
+ --     IS A FLOATING POINT TYPE OF 5 DIGITS PRECISION.
+ 
+ -- HISTORY:
+ --     JET 07/11/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46032A IS
+ 
+      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+ 
+      TYPE FLOAT5 IS DIGITS 5;
+ 
+      F5 : FLOAT5;
+ 
+      FUNCTION IDENT5 (X : FLOAT5) RETURN FLOAT5 IS
+      BEGIN
+           RETURN X * FLOAT5(IDENT_INT(1));
+      END IDENT5;
+ 
+ BEGIN
+      TEST ("C46032A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
+                       "THE OPERAND TYPE IS A FLOATING POINT TYPE " &
+                       "OF 5 DIGITS PRECISION");
+ 
+      F5 := IDENT5(2#0.1100_0000_0000_0000_00#E0);
+      IF FIX1(F5) /= 16#0.C# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+      END IF;
+ 
+      F5 := IDENT5(2#0.1111_1110_0000_0000_00#E5);
+      IF FIX1(F5) /= 16#1F.C# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+      END IF;
+ 
+      F5 := IDENT5(-2#0.1010_1010_1010_1010_10#E2);
+      IF FIX1(F5) < -16#2.C# OR
+         FIX1(F5) > -16#2.8# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+      END IF;
+ 
+      F5 := IDENT5(2#0.1111_0000_0000_0000_00#E0);
+      IF FIX2(F5) /= 16#0.F# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+      END IF;
+ 
+      F5 := IDENT5(-2#0.1111_1110_0000_0000_00#E7);
+      IF FIX2(F5) /= -16#7F.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+      END IF;
+ 
+      F5 := IDENT5(2#0.1111_1111_1101_0000_00#E7);
+      IF FIX2(F5) < 16#7F.E# OR
+         FIX2(F5) > 16#7F.F# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+      END IF;
+ 
+      F5 := IDENT5(2#0.1000_0000_0000_0000_00#E-5);
+      IF FIX3(F5) /= 16#0.04# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
+      END IF;
+ 
+      F5 := -IDENT5(2#0.1010_1010_1010_1010_00#E9);
+      IF FIX3(F5) /= -16#155.54# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
+      END IF;
+ 
+      F5 := IDENT5(2#0.1000_0000_0000_0010_11#E9);
+      IF FIX3(F5) < 16#100.04# OR
+         FIX3(F5) > 16#100.08# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
+      END IF;
+ 
+      RESULT;
+ 
+ END C46032A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46033a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46033a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46033a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46033a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C46033A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
+ --     IS ANOTHER FIXED POINT TYPE.
+ 
+ -- HISTORY:
+ --     JET 07/12/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46033A IS
+ 
+      TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+      TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+      TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+ 
+      F1 : FIX1;
+      F2 : FIX2;
+      F3 : FIX3;
+ 
+      GENERIC
+           TYPE F IS DELTA <>;
+      FUNCTION IDENT_G (X : F) RETURN F;
+ 
+      FUNCTION IDENT_G (X : F) RETURN F IS
+      BEGIN
+           RETURN X + F(IDENT_INT(0));
+      END IDENT_G;
+ 
+      FUNCTION IDENT IS NEW IDENT_G(FIX1);
+      FUNCTION IDENT IS NEW IDENT_G(FIX2);
+      FUNCTION IDENT IS NEW IDENT_G(FIX3);
+ 
+ BEGIN
+      TEST ("C46033A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
+                       "THE OPERAND TYPE IS ANOTHER FIXED POINT TYPE");
+ 
+      F1 := IDENT(-16#1F.C#);
+      IF FIX1(F1) /= -16#1F.C# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+      END IF;
+ 
+      F1 := IDENT(16#0.4#);
+      IF FIX2(F1) /= 16#0.4# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+      END IF;
+ 
+      F1 := IDENT(-16#10.4#);
+      IF FIX3(F1) /= -16#10.4# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+      END IF;
+ 
+      F2 := IDENT(16#3.3#);
+      IF FIX1(F2) < 16#3.0# OR
+         FIX1(F2) > 16#3.4# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+      END IF;
+ 
+      F2 := IDENT(-16#40.1#);
+      IF FIX2(F2) /= -16#40.1# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+      END IF;
+ 
+      F2 := IDENT(16#0.0#);
+      IF FIX3(F2) /= 16#0.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+      END IF;
+ 
+      F3 := IDENT(-16#0.04#);
+      IF FIX1(F3) < -16#0.4# OR
+         FIX1(F3) > -16#0.0# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
+      END IF;
+ 
+      F3 := -IDENT(16#55.A8#);
+      IF FIX2(F3) < -16#55.B# OR
+         FIX2(F3) > -16#55.A# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
+      END IF;
+ 
+      F3 := IDENT(16#101.84#);
+      IF FIX3(F3) /= 16#101.84# THEN
+           FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
+      END IF;
+ 
+      RESULT;
+ 
+ END C46033A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46041a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46041a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46041a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46041a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,141 ----
+ -- C46041A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK ARRAY CONVERSIONS WHEN THE TARGET TYPE IS AN UNCONSTRAINED 
+ -- ARRAY TYPE AND THE OPERAND TYPE REQUIRES CONVERSION OF THE INDEX
+ -- BOUNDS.
+ 
+ -- R.WILLIAMS 9/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46041A IS
+      
+      TYPE INT IS RANGE -100 .. 100;
+      TYPE NEWINTEGER IS NEW INTEGER;
+ 
+      TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+ 
+      TYPE NDAY1 IS NEW DAY RANGE SUN .. FRI;
+      TYPE NDAY2 IS NEW DAY RANGE MON .. SAT;
+      
+      TYPE NNDAY1 IS NEW NDAY1;
+ 
+      FUNCTION IDENT (X : INT) RETURN INT IS
+      BEGIN
+           RETURN INT'VAL (IDENT_INT (INT'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS
+      BEGIN
+           RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS
+      BEGIN
+           RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS
+      BEGIN
+           RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS
+      BEGIN
+           RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C46041A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " &
+                        "TYPE IS AN UNCONSTRAINED ARRAY TYPE AND " &
+                        "THE OPERAND TYPE REQUIRES CONVERSION OF " &
+                        "THE INDEX BOUNDS" );
+ 
+      DECLARE
+ 
+           TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+      
+           TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>) 
+                OF INTEGER;
+      
+           TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER;
+           A1 : ARR1 (IDENT (11) .. IDENT (20)) := 
+                     (IDENT (11) .. IDENT (20) => 0);
+ 
+           TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>) 
+                OF INTEGER;
+           A2 : ARR2 (IDENT (11) .. IDENT (20), 
+                      IDENT (TUE) .. IDENT (THU)) :=
+                     (IDENT (11) .. IDENT (20) => 
+                     (IDENT (TUE) .. IDENT (THU) => 0));
+      
+           TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>)
+                OF INTEGER;
+           A3 : ARR3 (IDENT (11) .. IDENT (20),
+                      IDENT (TUE) .. IDENT (THU)) :=
+                     (IDENT (11) .. IDENT (20) => 
+                     (IDENT (TUE) .. IDENT (THU) => 0));
+ 
+           PROCEDURE CHECK (A : UNARR1) IS
+           BEGIN
+                IF A'FIRST /= 11 OR A'LAST /= 20 THEN
+                     FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" );
+                END IF;
+           END CHECK;
+ 
+           PROCEDURE CHECK (A : UNARR2; STR : STRING) IS
+           BEGIN
+                IF A'FIRST (1) /= 11 OR A'LAST /= 20 OR
+                   A'FIRST (2) /= TUE OR A'LAST (2) /= THU THEN
+                     FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" & 
+                               STR & ")" );
+                END IF;
+           END CHECK;
+ 
+      BEGIN
+           BEGIN
+                CHECK (UNARR1 (A1));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED BY 'UNARR1 (A1)'" );
+           END;
+                              
+           BEGIN
+                CHECK (UNARR2 (A2), "2");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED BY 'UNARR2 (A2)'" );
+           END;
+                              
+           BEGIN
+                CHECK (UNARR2 (A3), "3");                             
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED BY 'UNARR2 (A3)'" );
+           END;
+                              
+      END;
+ 
+      RESULT;
+ END C46041A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46042a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46042a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46042a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46042a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- C46042A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK ARRAY CONVERSIONS WHEN THE TARGET TYPE IS A CONSTRAINED 
+ -- ARRAY TYPE AND THE OPERAND TYPE HAS BOUNDS THAT DO NOT BELONG TO
+ -- THE BASE TYPE OF THE TARGET TYPE'S INDEX SUBTYPE.
+ 
+ -- R.WILLIAMS 9/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46042A IS
+      
+      TYPE INT IS RANGE -100 .. 100;
+ 
+      TYPE NEWINTEGER IS NEW INTEGER;
+ 
+      TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+ 
+      TYPE NDAY1 IS NEW DAY RANGE MON .. FRI;
+      TYPE NDAY2 IS NEW DAY RANGE MON .. FRI;
+      
+      TYPE NNDAY1 IS NEW NDAY1;
+ 
+      FUNCTION IDENT (X : INT) RETURN INT IS
+      BEGIN
+           RETURN INT'VAL (IDENT_INT (INT'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS
+      BEGIN
+           RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS
+      BEGIN
+           RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS
+      BEGIN
+           RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X)));
+      END IDENT;
+ 
+      FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS
+      BEGIN
+           RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C46042A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " &
+                        "TYPE IS A CONSTRAINED ARRAY TYPE AND THE " &
+                        "OPERAND TYPE HAS BOUNDS THAT DO NOT " &
+                        "BELONG TO THE BASE TYPE OF THE TARGET " &
+                        "TYPE'S INDEX SUBTYPE" );
+ 
+      DECLARE
+ 
+           TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           SUBTYPE CONARR1 IS UNARR1 (IDENT_INT (1) .. IDENT_INT (10));
+ 
+           TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>) 
+                OF INTEGER;
+           SUBTYPE CONARR2 IS UNARR2 (IDENT_INT (1) .. IDENT_INT (10),
+                                      IDENT (MON) .. IDENT (TUE));
+           
+           TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER;
+           A1 : ARR1 (IDENT (11) .. IDENT (20)) := 
+                     (IDENT (11) .. IDENT (20) => 0);
+ 
+           TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>) 
+                OF INTEGER;
+           A2 : ARR2 (IDENT (11) .. IDENT (20), 
+                      IDENT (WED) .. IDENT (THU)) :=
+                     (IDENT (11) .. IDENT (20) =>
+                     (IDENT (WED) .. IDENT (THU) => 0));
+      
+           TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>)
+                OF INTEGER;
+           A3 : ARR3 (IDENT (11) .. IDENT (20),
+                      IDENT (WED) .. IDENT (THU)) :=
+                     (IDENT (11) .. IDENT (20) =>
+                     (IDENT (WED) .. IDENT (THU) => 0));
+ 
+           PROCEDURE CHECK (A : UNARR1) IS
+           BEGIN
+                IF A'FIRST /= 1 OR A'LAST /= 10 THEN
+                     FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" );
+                END IF;
+           END CHECK;
+ 
+           PROCEDURE CHECK (A : UNARR2; STR : STRING) IS
+           BEGIN
+                IF A'FIRST (1) /= 1 OR A'LAST /= 10 OR
+                   A'FIRST (2) /= MON OR A'LAST (2) /= TUE THEN
+                     FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" & 
+                               STR & ")" );
+                END IF;
+           END CHECK;
+ 
+      BEGIN
+           BEGIN
+                CHECK (CONARR1 (A1));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED BY 'CONARR1 (A1)'" );
+           END;
+                              
+           BEGIN
+                CHECK (CONARR2 (A2), "2");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A2)'" );
+           END;
+                              
+           BEGIN
+                CHECK (CONARR2 (A3), "3");                             
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A3)'" );
+           END;
+                              
+      END;
+ 
+      RESULT;
+ END C46042A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46043b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46043b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46043b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46043b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- C46043B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO AN 
+ -- UNCONSTRAINED ARRAY TYPE IF, FOR A NON-NULL DIMENSION OF THE 
+ -- OPERAND TYPE, ONE BOUND DOES NOT BELONG TO THE CORRESPONDING INDEX
+ -- SUBTYPE OF THE TARGET TYPE.
+ 
+ -- R.WILLIAMS 9/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46043B IS
+           
+      SUBTYPE SUBINT IS INTEGER RANGE IDENT_INT (0) .. IDENT_INT (9);
+ 
+ BEGIN
+      TEST ( "C46043B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                        "CONVERSION TO AN UNCONSTRAINED ARRAY TYPE " &
+                        "IF, FOR A NON-NULL DIMENSION OF THE OPERAND " &
+                        "TYPE, ONE BOUND DOES NOT BELONG TO THE " &
+                        "CORRESPONDING INDEX SUBTYPE OF THE TARGET " &
+                        "TYPE" );
+ 
+      DECLARE
+           TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10));
+ 
+           TYPE ARR2 IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+           
+           PROCEDURE CHECK (A : ARR2) IS
+           BEGIN               
+                FAILED ( "NO EXCEPTION RAISED WITH ONE DIMENSIONAL " &
+                         "ARRAYS" );
+           END CHECK;
+                
+      BEGIN
+           A1 := (A1'RANGE => 0);
+           CHECK (ARR2 (A1));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WITH ONE " &
+                         "DIMENSIONAL ARRAYS" );
+      END;
+ 
+      DECLARE
+           TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+                INTEGER;
+           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
+                      IDENT_INT (1) .. IDENT_INT (1));
+ 
+           TYPE ARR2 IS ARRAY (SUBINT RANGE <>, INTEGER RANGE <>) OF 
+                INTEGER;
+           
+           PROCEDURE CHECK (A : ARR2) IS
+           BEGIN               
+                FAILED ( "NO EXCEPTION RAISED WITH TWO DIMENSIONAL " &
+                         "ARRAYS" );
+           END CHECK;
+                
+      BEGIN
+           A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
+           CHECK (ARR2 (A1));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WITH TWO " &
+                         "DIMENSIONAL ARRAYS" );
+      END;
+ 
+      DECLARE
+           TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+                INTEGER;
+           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
+                      IDENT_INT (1) .. IDENT_INT (0));
+ 
+           TYPE ARR2 IS ARRAY (SUBINT RANGE <>, INTEGER RANGE <>) OF 
+                INTEGER;
+           
+           PROCEDURE CHECK (A : ARR2) IS
+           BEGIN               
+                FAILED ( "NO EXCEPTION RAISED WITH NULL ARRAYS - 1" );
+           END CHECK;
+                
+      BEGIN
+           A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
+           CHECK (ARR2 (A1));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " & 
+                         "WITH NULL ARRAYS - 1" );
+      END;
+ 
+      DECLARE
+           TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+                INTEGER;
+           A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
+                      IDENT_INT (1) .. IDENT_INT (0));
+ 
+           SUBTYPE NOINT IS INTEGER 
+                RANGE IDENT_INT (1) .. IDENT_INT (0);
+ 
+           TYPE ARR2 IS ARRAY (SUBINT RANGE <>, NOINT RANGE <>) OF 
+                INTEGER;
+           
+           PROCEDURE CHECK (A : ARR2) IS
+           BEGIN               
+                FAILED ( "NO EXCEPTION RAISED WITH NULL ARRAYS - 2" );
+           END CHECK;
+                
+      BEGIN
+           A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
+           CHECK (ARR2 (A1));
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED " & 
+                         "WITH NULL ARRAYS - 2" );
+      END;
+ 
+      RESULT;
+ END C46043B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46044b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46044b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46044b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46044b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,235 ----
+ -- C46044B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT ERROR IS RAISED FOR CONVERSION TO A  
+ -- CONSTRAINED ARRAY TYPE IF THE TARGET TYPE IS NON-NULL AND
+ -- CORRESPONDING DIMENSIONS OF THE TARGET AND OPERAND DO NOT HAVE
+ -- THE SAME LENGTH. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF
+ -- THE TARGET TYPE IS NULL AND THE OPERAND TYPE IS NON-NULL.
+ 
+ -- R.WILLIAMS 9/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46044B IS
+ 
+      TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+      SUBTYPE CARR1A IS ARR1 (IDENT_INT (1) .. IDENT_INT (6));
+      C1A : CARR1A := (CARR1A'RANGE => 0);
+ 
+      SUBTYPE CARR1B IS ARR1 (IDENT_INT (2) .. IDENT_INT (5));
+      C1B : CARR1B := (CARR1B'RANGE => 0);
+ 
+      SUBTYPE CARR1N IS ARR1 (IDENT_INT (1) .. IDENT_INT (0));
+      C1N : CARR1N := (CARR1N'RANGE => 0);
+ 
+      TYPE ARR2 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+           INTEGER;
+ 
+      SUBTYPE CARR2A IS ARR2 (IDENT_INT (1) .. IDENT_INT (2),
+                              IDENT_INT (1) .. IDENT_INT (2));
+      C2A : CARR2A := (CARR2A'RANGE (1) => (CARR2A'RANGE (2) => 0));
+ 
+      SUBTYPE CARR2B IS ARR2 (IDENT_INT (0) .. IDENT_INT (2),
+                              IDENT_INT (0) .. IDENT_INT (2));
+      C2B : CARR2B := (CARR2B'RANGE (1) => (CARR2B'RANGE (2) => 0));
+ 
+      SUBTYPE CARR2N IS ARR2 (IDENT_INT (2) .. IDENT_INT (1),
+                              IDENT_INT (1) .. IDENT_INT (2));
+      C2N : CARR2N := (CARR2N'RANGE (1) => (CARR2N'RANGE (2) => 0));
+      
+      PROCEDURE CHECK1 (A : ARR1; STR : STRING) IS
+      BEGIN
+           FAILED ( "NO EXCEPTION RAISED - " & STR );
+      END CHECK1;
+ 
+      PROCEDURE CHECK2 (A : ARR2; STR : STRING) IS
+      BEGIN
+           FAILED ( "NO EXCEPTION RAISED - " & STR );
+      END CHECK2;
+ 
+ BEGIN
+      TEST ( "C46044B", "CHECK THAT CONSTRAINT ERROR IS RAISED FOR " &
+                        "CONVERSION TO A CONSTRAINED ARRAY TYPE " &
+                        "IF THE TARGET TYPE IS NON-NULL AND " &
+                        "CORRESPONDING DIMENSIONS OF THE TARGET AND " &
+                        "OPERAND DO NOT HAVE THE SAME LENGTH. " &
+                        "ALSO, CHECK THAT CONSTRAINT_ERROR IS " &
+                        "RAISED IF THE TARGET TYPE IS NULL AND " &
+                        "THE OPERAND TYPE IS NON-NULL" );
+ 
+      BEGIN -- (A).
+           C1A := C1B;
+           CHECK1 (C1A, "(A)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (A)" );
+      END;
+ 
+      BEGIN -- (B).
+           CHECK1 (CARR1A (C1B), "(B)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (B)" );
+      END; 
+ 
+      BEGIN -- (C).
+           C1B := C1A;
+           CHECK1 (C1B, "(C)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (C)" );
+      END;
+ 
+      BEGIN -- (D).
+           CHECK1 (CARR1B (C1A), "(D)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (D)" );
+      END;
+ 
+      BEGIN -- (E).
+           C1A := C1N;
+           CHECK1 (C1A, "(E)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (E)" );
+      END;
+ 
+      BEGIN -- (F).
+           CHECK1 (CARR1A (C1N), "(F)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (F)" );
+      END;
+ 
+      BEGIN -- (G).
+           C2A := C2B;
+           CHECK2 (C2A, "(G)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (G)" );
+      END;
+ 
+      BEGIN -- (H).
+           CHECK2 (CARR2A (C2B), "(H)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (H)" );
+      END;
+ 
+      BEGIN -- (I).
+           C2B := C2A;
+           CHECK2 (C2B, "(I)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (I)" );
+      END;
+ 
+      BEGIN -- (J).
+           CHECK2 (CARR2A (C2B), "(J)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (J)" );
+      END;
+ 
+      BEGIN -- (K).
+           C2A := C2N;
+           CHECK2 (C2A, "(K)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (K)" );
+      END;
+ 
+      BEGIN -- (L).
+           CHECK2 (CARR2A (C2N), "(L)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (L)" );
+      END;
+ 
+      BEGIN -- (M).
+           C1N := C1A;
+           CHECK1 (C1N, "(M)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (M)" );
+      END;
+ 
+      BEGIN -- (N).
+           CHECK1 (CARR1N (C1A), "(N)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (N)" );
+      END;
+ 
+      BEGIN -- (O).
+           C2N := C2A;
+           CHECK2 (C2N, "(O)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (O)" );
+      END;
+ 
+      BEGIN -- (P).
+           CHECK2 (CARR2N (C2A), "(P)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED - (P)" );
+      END;
+ 
+      RESULT;
+ END C46044B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46051a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46051a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46051a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46051a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,414 ----
+ -- C46051A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ENUMERATION, RECORD, ACCESS, PRIVATE, AND TASK VALUES CAN
+ -- BE CONVERTED IF THE OPERAND AND TARGET TYPES ARE RELATED BY 
+ -- DERIVATION.
+ 
+ -- R.WILLIAMS 9/8/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46051A IS
+      
+ BEGIN
+      TEST ( "C46051A", "CHECK THAT ENUMERATION, RECORD, ACCESS, " &
+                        "PRIVATE, AND TASK VALUES CAN BE CONVERTED " &
+                        "IF THE OPERAND AND TARGET TYPES ARE " &
+                        "RELATED BY DERIVATION" );
+ 
+      DECLARE
+           TYPE ENUM IS (A, AB, ABC, ABCD);
+           E : ENUM := ABC;
+ 
+           TYPE ENUM1 IS NEW ENUM;
+           E1 : ENUM1 := ENUM1'VAL (IDENT_INT (2));
+ 
+           TYPE ENUM2 IS NEW ENUM;
+           E2 : ENUM2 := ABC;
+ 
+           TYPE NENUM1 IS NEW ENUM1;
+           NE : NENUM1 := NENUM1'VAL (IDENT_INT (2));
+      BEGIN
+           IF ENUM (E) /= E THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" );
+           END IF;
+ 
+           IF ENUM (E1) /= E THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" );
+           END IF;
+ 
+           IF ENUM1 (E2) /= E1 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" );
+           END IF;
+                               
+           IF ENUM2 (NE) /= E2 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (NE)'" );
+           END IF;
+ 
+           IF NENUM1 (E) /= NE THEN
+                FAILED ( "INCORRECT CONVERSION OF 'NENUM (E)'" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                         "ENUMERATION TYPES" );
+      END;
+ 
+      DECLARE
+           TYPE REC IS 
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           R : REC;
+ 
+           TYPE REC1 IS NEW REC;
+           R1 : REC1;
+ 
+           TYPE REC2 IS NEW REC;
+           R2 : REC2;
+ 
+           TYPE NREC1 IS NEW REC1;
+           NR : NREC1;
+      BEGIN
+           IF REC (R) /= R THEN
+                FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" );
+           END IF;
+ 
+           IF REC (R1) /= R THEN
+                FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" );
+           END IF;
+ 
+           IF REC1 (R2) /= R1 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" );
+           END IF;
+                               
+           IF REC2 (NR) /= R2 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'REC2 (NR)'" );
+           END IF;
+ 
+           IF NREC1 (R) /= NR THEN
+                FAILED ( "INCORRECT CONVERSION OF 'NREC (R)'" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                         "RECORD TYPES" );
+      END;
+ 
+      DECLARE
+           TYPE REC (D : INTEGER) IS 
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           SUBTYPE CREC IS REC (3);
+           R : CREC;
+ 
+           TYPE CREC1 IS NEW REC (3);
+           R1 : CREC1;
+ 
+           TYPE CREC2 IS NEW REC (3);
+           R2 : CREC2;
+ 
+           TYPE NCREC1 IS NEW CREC1;
+           NR : NCREC1;
+      BEGIN
+           IF CREC (R) /= R THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CREC (R)'" );
+           END IF;
+ 
+           IF CREC (R1) /= R THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CREC (R1)'" );
+           END IF;
+ 
+           IF CREC1 (R2) /= R1 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CREC1 (R2)'" );
+           END IF;
+                               
+           IF CREC2 (NR) /= R2 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CREC2 (NR)'" );
+           END IF;
+ 
+           IF NCREC1 (R) /= NR THEN
+                FAILED ( "INCORRECT CONVERSION OF 'NCREC (R)'" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                         "RECORD TYPES WITH DISCRIMINANTS" );
+      END;
+ 
+      DECLARE
+           TYPE REC IS 
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACCREC IS ACCESS REC;
+           AR : ACCREC;
+ 
+           TYPE ACCREC1 IS NEW ACCREC;
+           AR1 : ACCREC1;
+ 
+           TYPE ACCREC2 IS NEW ACCREC;
+           AR2 : ACCREC2;
+ 
+           TYPE NACCREC1 IS NEW ACCREC1;
+           NAR : NACCREC1;
+ 
+           FUNCTION F (A : ACCREC) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (0);
+           END F;
+ 
+           FUNCTION F (A : ACCREC1) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (1);
+           END F;
+ 
+           FUNCTION F (A : ACCREC2) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (2);
+           END F;
+ 
+           FUNCTION F (A : NACCREC1) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (3);
+           END F;
+ 
+      BEGIN
+           IF F (ACCREC (AR)) /= 0 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR)'" );
+           END IF;
+ 
+           IF F (ACCREC (AR1)) /= 0 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR1)'" );
+           END IF;
+ 
+           IF F (ACCREC1 (AR2)) /= 1 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ACCREC1 (AR2)'" );
+           END IF;
+                               
+           IF F (ACCREC2 (NAR)) /= 2 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'ACCREC2 (NAR)'" );
+           END IF;
+ 
+           IF F (NACCREC1 (AR)) /= 3 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'NACCREC (AR)'" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                         "ACCESS TYPES" );
+      END;
+ 
+      DECLARE
+           TYPE REC (D : INTEGER) IS 
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACCR IS ACCESS REC;
+ 
+           SUBTYPE CACCR IS ACCR (3);
+           AR : CACCR;
+ 
+           TYPE CACCR1 IS NEW ACCR (3);
+           AR1 : CACCR1;
+ 
+           TYPE CACCR2 IS NEW ACCR (3);
+           AR2 : CACCR2;
+ 
+           TYPE NCACCR1 IS NEW CACCR1;
+           NAR : NCACCR1;
+ 
+           FUNCTION F (A : CACCR) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (0);
+           END F;
+ 
+           FUNCTION F (A : CACCR1) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (1);
+           END F;
+ 
+           FUNCTION F (A : CACCR2) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (2);
+           END F;
+ 
+           FUNCTION F (A : NCACCR1) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (3);
+           END F;
+ 
+      BEGIN
+           IF F (CACCR (AR)) /= 0 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR)'" );
+           END IF;
+ 
+           IF F (CACCR (AR1)) /= 0 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR1)'" );
+           END IF;
+ 
+           IF F (CACCR1 (AR2)) /= 1 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CACCR1 (AR2)'" );
+           END IF;
+                               
+           IF F (CACCR2 (NAR)) /= 2 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'CACCR2 (NAR)'" );
+           END IF;
+ 
+           IF F (NCACCR1 (AR)) /= 3 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'NCACCR (AR)'" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                         "CONSTRAINED ACCESS TYPES" );
+      END;
+ 
+      DECLARE
+           PACKAGE PKG1 IS
+                TYPE PRIV IS PRIVATE;
+           PRIVATE
+                TYPE PRIV IS 
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PKG1;
+ 
+           USE PKG1;
+ 
+           PACKAGE PKG2 IS
+                R : PRIV;
+ 
+                TYPE PRIV1 IS NEW PRIV;
+                R1 : PRIV1;
+ 
+                TYPE PRIV2 IS NEW PRIV;
+                R2 : PRIV2;
+           END PKG2;
+      
+           USE PKG2;
+ 
+           PACKAGE PKG3 IS
+                TYPE NPRIV1 IS NEW PRIV1;
+                NR : NPRIV1;
+           END PKG3;
+ 
+           USE PKG3;
+      BEGIN
+           IF PRIV (R) /= R THEN
+                FAILED ( "INCORRECT CONVERSION OF 'PRIV (R)'" );
+           END IF;
+ 
+           IF PRIV (R1) /= R THEN
+                FAILED ( "INCORRECT CONVERSION OF 'PRIV (R1)'" );
+           END IF;
+ 
+           IF PRIV1 (R2) /= R1 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'PRIV1 (R2)'" );
+           END IF;
+                               
+           IF PRIV2 (NR) /= R2 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'PRIV2 (NR)'" );
+           END IF;
+ 
+           IF NPRIV1 (R) /= NR THEN
+                FAILED ( "INCORRECT CONVERSION OF 'NPRIV (R)'" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                         "PRIVATE TYPES" );
+      END;
+ 
+      DECLARE
+           TASK TYPE TK;
+           T : TK;
+ 
+           TYPE TK1 IS NEW TK;
+           T1 : TK1; 
+ 
+           TYPE TK2 IS NEW TK;
+           T2 : TK2;
+ 
+           TYPE NTK1 IS NEW TK1;
+           NT : NTK1;
+           
+           TASK BODY TK IS
+           BEGIN
+                NULL;
+           END;
+ 
+           FUNCTION F (T : TK) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (0);
+           END F;
+ 
+           FUNCTION F (T : TK1) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (1);
+           END F;
+ 
+           FUNCTION F (T : TK2) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (2);
+           END F;
+ 
+           FUNCTION F (T : NTK1) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT (3);
+           END F;
+ 
+      BEGIN
+           IF F (TK (T)) /= 0 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'TK (T))'" );
+           END IF;
+ 
+           IF F (TK (T1)) /= 0 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'TK (T1))'" );
+           END IF;
+ 
+           IF F (TK1 (T2)) /= 1 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'TK1 (T2))'" );
+           END IF;
+                               
+           IF F (TK2 (NT)) /= 2 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'TK2 (NT))'" );
+           END IF;
+ 
+           IF F (NTK1 (T)) /= 3 THEN
+                FAILED ( "INCORRECT CONVERSION OF 'NTK (T))'" );
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                         "TASK TYPES" );
+      END;
+ 
+      RESULT;
+ END C46051A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46051b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46051b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46051b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46051b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C46051B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ENUMERATION VALUES CAN BE CONVERTED IF THE OPERAND
+ --     AND TARGET TYPES ARE RELATED BY DERIVATION, EVEN IF THE OPERAND
+ --     AND TARGET TYPES HAVE DIFFERENT REPRESENTATIONS.
+ 
+ -- HISTORY:
+ --     JET 07/13/88  CREATED ORIGINAL TEST.
+ --     RJW 08/28/89  REMOVED APPLICABILITY CRITERIA AND CHANGED
+ --                   EXTENSION TO 'ADA'.  CHANGED THE CODES IN SECOND
+ --                   ENUMERATION REPRESENTATION CLAUSE.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46051B IS
+ 
+      TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
+ 
+      TYPE ENUM1 IS NEW ENUM;
+      FOR ENUM1 USE
+           (WE => -1, LOVE => 0, WRITING => 3, TESTS => 9);
+ 
+      TYPE ENUM2 IS NEW ENUM;
+      FOR ENUM2 USE
+           (WE => 10, LOVE => 15, WRITING => 16, TESTS => 19);
+ 
+      TYPE ENUM3 IS NEW ENUM1;
+ 
+      E : ENUM := ENUM'VAL (IDENT_INT (0));
+      E1 : ENUM1 := ENUM1'VAL (IDENT_INT (1));
+      E2 : ENUM2 := ENUM2'VAL (IDENT_INT (2));
+      E3 : ENUM3 := ENUM3'VAL (IDENT_INT (3));
+ 
+ BEGIN
+      TEST ( "C46051B", "CHECK THAT ENUMERATION VALUES CAN BE " &
+                        "CONVERTED IF THE OPERAND AND TARGET TYPES " &
+                        "ARE RELATED BY DERIVATION, EVEN IF THE " &
+                        "OPERAND AND TARGET TYPES HAVE DIFFERENT " &
+                        "REPRESENTATIONS");
+ 
+      IF ENUM1 (E) /= WE THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E)'" );
+      END IF;
+ 
+      IF ENUM (E1) /= LOVE THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" );
+      END IF;
+ 
+      IF ENUM1 (E2) /= WRITING THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" );
+      END IF;
+ 
+      IF ENUM2 (E3) /= TESTS THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (E3)'" );
+      END IF;
+ 
+      IF ENUM (E) /= WE THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" );
+      END IF;
+ 
+      IF ENUM2 (E1) /= LOVE THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (E1)'" );
+      END IF;
+ 
+      IF ENUM3 (E2) /= WRITING THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM3 (E2)'" );
+      END IF;
+ 
+      IF ENUM (E3) /= TESTS THEN
+           FAILED ( "INCORRECT CONVERSION OF 'ENUM (E3)'" );
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                    "ENUMERATION TYPES" );
+           RESULT;
+ END C46051B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46051c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46051c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46051c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46051c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C46051C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT RECORD VALUES CAN BE CONVERTED IF THE OPERAND
+ --     AND TARGET TYPES ARE RELATED BY DERIVATION, EVEN IF THE OPERAND
+ --     AND TARGET TYPES HAVE DIFFERENT REPRESENTATIONS.
+ 
+ -- HISTORY:
+ --     JET 07/13/88  CREATED ORIGINAL TEST.
+ --     RJW 08/28/89  REMOVED APPLICABILITY CRITERIA AND CHANGED
+ --                   EXTENSION TO 'ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM;
+ 
+ PROCEDURE C46051C IS
+ 
+      UNITS_PER_INTEGER : CONSTANT :=
+           (INTEGER'SIZE+SYSTEM.STORAGE_UNIT-1) / SYSTEM.STORAGE_UNIT;
+ 
+      TYPE ARR IS ARRAY (1..2) OF INTEGER;
+ 
+      TYPE REC IS RECORD
+           F1 : INTEGER;
+           F2 : INTEGER;
+           F3 : INTEGER;
+      END RECORD;
+ 
+      TYPE REC1 IS NEW REC;
+      FOR REC1 USE
+           RECORD
+                F1 AT 0 RANGE 0 .. INTEGER'SIZE - 1;
+                F2 AT 1*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+                F3 AT 3*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+           END RECORD;
+ 
+      TYPE REC2 IS NEW REC;
+      FOR REC2 USE
+           RECORD
+                F1 AT 0 RANGE 0 .. INTEGER'SIZE - 1;
+                F2 AT 2*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+                F3 AT 3*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+           END RECORD;
+ 
+      TYPE REC3 IS NEW REC1;
+ 
+      R  : REC  := (IDENT_INT (0), 1, 2);
+      R1 : REC1 := (IDENT_INT (1), 2, 3);
+      R2 : REC2 := (IDENT_INT (2), 3, 4);
+      R3 : REC3 := (IDENT_INT (3), 4, 5);
+ 
+ BEGIN
+      TEST ( "C46051C", "CHECK THAT RECORD VALUES CAN BE " &
+                        "CONVERTED IF THE OPERAND AND TARGET TYPES " &
+                        "ARE RELATED BY DERIVATION, EVEN IF THE " &
+                        "OPERAND AND TARGET TYPES HAVE DIFFERENT " &
+                        "REPRESENTATIONS");
+ 
+      IF REC1(R) /= (0,1,2) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC1 (R)'" );
+      END IF;
+ 
+      IF REC (R1) /= (1,2,3) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" );
+      END IF;
+ 
+      IF REC1 (R2) /= (2,3,4) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" );
+      END IF;
+ 
+      IF REC2 (R3) /= (3,4,5) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC2 (R3)'" );
+      END IF;
+ 
+      IF REC (R) /= (0,1,2) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" );
+      END IF;
+ 
+      IF REC2 (R1) /= (1,2,3) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC2 (R1)'" );
+      END IF;
+ 
+      IF REC3 (R2) /= (2,3,4) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC3 (R2)'" );
+      END IF;
+ 
+      IF REC (R3) /= (3,4,5) THEN
+           FAILED ( "INCORRECT CONVERSION OF 'REC (R3)'" );
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                    "RECORD TYPES" );
+           RESULT;
+ END C46051C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46052a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46052a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46052a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46052a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C46052A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO AN 
+ -- ENUMERATION TYPE IF THE VALUE OF THE OPERAND DOES NOT BELONG TO THE
+ -- RANGE OF ENUMERATION VALUES FOR THE TARGET SUBTYPE.
+ 
+ -- R.WILLIAMS 9/9/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46052A IS
+      
+      TYPE ENUM IS (A, AB, ABC, ABCD);
+      E : ENUM := ENUM'VAL (IDENT_INT (0));
+      
+      FUNCTION IDENT (E : ENUM) RETURN ENUM IS
+      BEGIN
+           RETURN ENUM'VAL (IDENT_INT (ENUM'POS (E)));
+      END IDENT;
+ 
+ BEGIN
+      TEST ( "C46052A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                        "CONVERSION TO AN ENUMERATION TYPE IF THE " &
+                        "VALUE OF THE OPERAND DOES NOT BELONG TO " &
+                        "THE RANGE OF ENUMERATION VALUES FOR THE " &
+                        "TARGET SUBTYPE" );
+ 
+      DECLARE
+           SUBTYPE SENUM IS ENUM RANGE AB .. ABCD;
+      BEGIN
+           E := IDENT (SENUM (E));
+           FAILED ( "NO EXCEPTION RAISED FOR 'SENUM (E)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'SENUM (E)'" );
+      END;
+ 
+      DECLARE
+           SUBTYPE NOENUM IS ENUM RANGE ABCD .. AB;
+      BEGIN
+           E := IDENT (NOENUM (E));
+           FAILED ( "NO EXCEPTION RAISED FOR 'NOENUM (E)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'NOENUM (E)'" );
+      END;
+ 
+      DECLARE
+           SUBTYPE SCHAR IS CHARACTER RANGE 'C' .. 'R';
+           A : CHARACTER := IDENT_CHAR ('A');
+      BEGIN
+           A := IDENT_CHAR (SCHAR (A));
+           FAILED ( "NO EXCEPTION RAISED FOR 'SCHAR (A)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'SCHAR (A)'" );
+      END;
+ 
+      DECLARE
+           SUBTYPE FRANGE IS BOOLEAN RANGE FALSE .. FALSE;
+           T : BOOLEAN := IDENT_BOOL (TRUE);
+      BEGIN
+           T := IDENT_BOOL (FRANGE (T));
+           FAILED ( "NO EXCEPTION RAISED FOR 'FRANGE (T)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'FRANGE (T)'" );
+      END;
+ 
+      RESULT;
+ END C46052A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46053a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46053a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46053a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46053a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,139 ----
+ -- C46053A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO A 
+ -- CONSTRAINED RECORD, PRIVATE, OR LIMITED PRIVATE SUBTYPE IF THE 
+ -- DISCRIMINANTS OF THE TARGET SUBTYPE DO NOT EQUAL THOSE OF THE 
+ -- OPERAND.
+ 
+ -- R.WILLIAMS 9/9/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46053A IS
+      
+ BEGIN
+      TEST ( "C46053A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                        "CONVERSION TO A CONSTRAINED RECORD, " &
+                        "PRIVATE, OR LIMITED PRIVATE SUBTYPE IF " &
+                        "THE DISCRIMINANTS OF THE TARGET SUBTYPE DO " &
+                        "NOT EQUAL THOSE OF THE OPERAND" );
+ 
+      DECLARE
+           TYPE REC (D : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           
+           SUBTYPE REC3 IS REC (IDENT_INT (3));
+           R : REC (IDENT_INT (1));
+ 
+           PROCEDURE PROC (R : REC) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (R.D);
+           END PROC;
+                
+      BEGIN
+           PROC (REC3 (R));
+           FAILED ( "NO EXCEPTION RAISED FOR 'REC3 (R)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'REC3 (R)'" );
+      END;
+ 
+      DECLARE
+           PACKAGE PKG1 IS
+                TYPE PRIV (D : INTEGER) IS PRIVATE;
+                SUBTYPE PRIV3 IS PRIV (IDENT_INT (3));
+           PRIVATE
+                TYPE PRIV  (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PKG1;
+           
+           USE PKG1;
+ 
+           PACKAGE PKG2 IS
+                P : PRIV (IDENT_INT (0));
+           END PKG2;
+ 
+           USE PKG2;
+ 
+           PROCEDURE PROC (P : PRIV) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (P.D);
+           END PROC;
+                
+      BEGIN
+           PROC (PRIV3 (P));
+           FAILED ( "NO EXCEPTION RAISED FOR 'PRIV3 (P)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'PRIV3 (P)'" );
+      END;
+ 
+      DECLARE
+           PACKAGE PKG1 IS
+                TYPE LIM (D : INTEGER) IS LIMITED PRIVATE;
+                SUBTYPE LIM3 IS LIM (IDENT_INT (3));
+           PRIVATE
+                TYPE LIM  (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PKG1;
+           
+           USE PKG1;
+ 
+           PACKAGE PKG2 IS
+                L : LIM (IDENT_INT (0));
+                I : INTEGER;
+           END PKG2;
+ 
+           USE PKG2;
+ 
+           PROCEDURE PROC (L : LIM) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (L.D);
+           END PROC;
+                
+      BEGIN
+           PROC (LIM3 (L));
+           FAILED ( "NO EXCEPTION RAISED FOR 'LIM3 (L)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'LIM3 (L)'" );
+      END;
+ 
+      RESULT;
+ END C46053A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46054a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46054a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c46054a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c46054a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C46054A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO AN 
+ -- ACCESS SUBTYPE IF THE OPERAND VALUE IS NOT NULL AND THE 
+ -- DISCRIMINANTS OR INDEX BOUNDS OF THE DESIGNATED OBJECT DO NOT
+ -- MATCH THOSE OF THE TARGET TYPE.
+ 
+ -- R.WILLIAMS 9/9/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C46054A IS
+      
+ BEGIN
+      TEST ( "C46054A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                        "CONVERSION TO AN ACCESS SUBTYPE IF THE " &
+                        "OPERAND VALUE IS NOT NULL AND THE " &
+                        "DISCRIMINANTS OR INDEX BOUNDS OF THE " &
+                        "DESIGNATED OBJECT DO NOT MATCH THOSE OF " &
+                        "THE TARGET TYPE" );
+ 
+      DECLARE
+           TYPE REC (D : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           
+           TYPE ACREC IS ACCESS REC;
+           A : ACREC (IDENT_INT (0)) := NEW REC (IDENT_INT (0));
+ 
+           SUBTYPE ACREC3 IS ACREC (IDENT_INT (3));
+ 
+           PROCEDURE PROC (A : ACREC) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (A.D);
+           END PROC;
+ 
+      BEGIN
+           PROC (ACREC3 (A));
+           FAILED ( "NO EXCEPTION RAISED FOR 'ACREC3 (A)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACREC3 (A)'" );
+      END;
+ 
+      DECLARE
+           TYPE REC (D1, D2 : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           
+           TYPE ACREC IS ACCESS REC;
+ 
+           A : ACREC (IDENT_INT (3), IDENT_INT (1)) := 
+               NEW REC (IDENT_INT (3), IDENT_INT (1));
+ 
+           SUBTYPE ACREC13 IS ACREC (IDENT_INT (1), IDENT_INT (3));
+ 
+           PROCEDURE PROC (A : ACREC) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (A.D1);
+           END PROC;
+ 
+      BEGIN
+           PROC (ACREC13 (A));
+           FAILED ( "NO EXCEPTION RAISED FOR 'ACREC13 (A)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACREC13 (A)'" );
+      END;
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           
+           TYPE ACARR IS ACCESS ARR;
+           A : ACARR (IDENT_INT (0) .. IDENT_INT (1)) := 
+               NEW ARR'(IDENT_INT (0) .. IDENT_INT (1) => 0);
+ 
+           SUBTYPE ACARR02 IS ACARR (IDENT_INT (0) .. IDENT_INT (2));
+ 
+           PROCEDURE PROC (A : ACARR) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (A'LAST);
+           END PROC;
+ 
+      BEGIN
+           PROC (ACARR02 (A));
+           FAILED ( "NO EXCEPTION RAISED FOR 'ACARR02 (A)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACARR02 (A)'" );
+      END;
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+                INTEGER;
+           
+           TYPE ACARR IS ACCESS ARR;
+           A : ACARR (IDENT_INT (1) .. IDENT_INT (0),
+                      IDENT_INT (4) .. IDENT_INT (5)) := 
+               NEW ARR'(IDENT_INT (1) .. IDENT_INT (0) =>
+                       (IDENT_INT (4) .. IDENT_INT (5) => 0));
+ 
+           SUBTYPE NACARR IS ACARR (IDENT_INT (0) .. IDENT_INT (1),
+                                    IDENT_INT (5) .. IDENT_INT (4));
+ 
+           PROCEDURE PROC (A : NACARR) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (A'LAST (1));
+           END PROC;
+ 
+      BEGIN
+           PROC (NACARR (A));
+           FAILED ( "NO EXCEPTION RAISED FOR 'NACARR (A)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'NACARR (A)'" );
+      END;
+ 
+      DECLARE
+           PACKAGE PKG1 IS
+                TYPE PRIV (D : INTEGER) IS PRIVATE;
+                TYPE ACPRV IS ACCESS PRIV;
+                SUBTYPE ACPRV3 IS ACPRV (IDENT_INT (3));
+ 
+           PRIVATE
+                TYPE PRIV (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                END RECORD;
+           END PKG1;
+           
+           USE PKG1;
+           
+           PACKAGE PKG2 IS
+                A : ACPRV (IDENT_INT (0)) := NEW PRIV (IDENT_INT (0));
+           END PKG2;
+ 
+           USE PKG2;
+ 
+           PROCEDURE PROC (A : ACPRV) IS
+                I : INTEGER;
+           BEGIN
+                I := IDENT_INT (A.D);
+           END PROC;
+ 
+      BEGIN
+           PROC (ACPRV3 (A));
+           FAILED ( "NO EXCEPTION RAISED FOR 'ACPRV3 (A)'" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR 'ACPRV3 (A)'" );
+      END;
+ 
+      RESULT;
+ END C46054A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,408 ----
+ -- C460A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the target type of a type conversion is a general
+ --      access type, Program_Error is raised if the accessibility level of
+ --      the operand type is deeper than that of the target type. Check for
+ --      cases where the type conversion occurs in an instance body, and
+ --      the operand type is passed as an actual during instantiation.
+ --
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the operand type must
+ --      be at the same or a less deep nesting level than the target type -- the
+ --      operand type must "live" as long as the target type. Nesting levels
+ --      are the run-time nestings of masters: block statements; subprogram,
+ --      task, and entry bodies; and accept statements. Packages are invisible
+ --      to accessibility rules.
+ --
+ --      This test checks for cases where the operand is a subprogram formal
+ --      parameter.
+ --
+ --      The test declares three generic packages, each containing an access
+ --      type conversion in which the operand type is a formal type:
+ --
+ --         (1) One in which the target type is declared within the
+ --             specification, and the conversion occurs within a nested
+ --             function.
+ --
+ --         (2) One in which the target type is also a formal type, and
+ --             the conversion occurs within a nested function.
+ --
+ --         (3) One in which the target type is declared outside the
+ --             generic, and the conversion occurs within a nested
+ --             procedure.
+ --
+ --      The test verifies the following:
+ --
+ --         For (1), Program_Error is not raised when the nested function is
+ --         called. Since the actual corresponding to the formal operand type
+ --         must always have the same or a less deep level than the target
+ --         type declared within the instance, the access type conversion is
+ --         always safe.
+ --
+ --         For (2), Program_Error is raised when the nested function is
+ --         called if the operand type passed as an actual during instantiation
+ --         has an accessibility level deeper than that of the target type
+ --         passed as an actual, and that no exception is raised otherwise.
+ --         The exception is propagated to the innermost enclosing master.
+ --
+ --         For (3), Program_Error is raised when the nested procedure is
+ --         called if the operand type passed as an actual during instantiation
+ --         has an accessibility level deeper than that of the target type.
+ --         The exception is handled within the nested procedure.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F460A00.A
+ --      => C460A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      09 May 95   SAIC    Initial prerelease version.
+ --      24 Apr 96   SAIC    Added code to avoid dead variable optimization.
+ --      13 Feb 97   PWB.CTA Removed 'Class from qual expression at line 342.
+ --!
+ 
+ generic
+    type Designated_Type is tagged private;
+    type Operand_Type is access Designated_Type;
+ package C460A01_0 is
+    type Target_Type is access all Designated_Type;
+    function Convert (P : Operand_Type) return Target_Type;
+ end C460A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460A01_0 is
+    function Convert (P : Operand_Type) return Target_Type is
+    begin
+       return Target_Type(P); -- Never fails.
+    end Convert;
+ end C460A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ generic
+    type Designated_Type is tagged private;
+    type Operand_Type is access all Designated_Type;
+    type Target_Type  is access all Designated_Type;
+ package C460A01_1 is
+    function Convert (P : Operand_Type) return Target_Type;
+ end C460A01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460A01_1 is
+    function Convert (P : Operand_Type) return Target_Type is
+    begin
+       return Target_Type(P);
+    end Convert;
+ end C460A01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F460A00;
+ generic
+    type Designated_Type (<>) is new F460A00.Tagged_Type with private;
+    type Operand_Type is access Designated_Type;
+ package C460A01_2 is
+    procedure Proc (P   : Operand_Type; 
+                    Res : out F460A00.TC_Result_Kind);
+ end C460A01_2;
+ 
+ 
+      --==================================================================--
+ 
+ with Report;
+ package body C460A01_2 is
+    procedure Proc (P   : Operand_Type; 
+                    Res : out F460A00.TC_Result_Kind) is
+       Ptr : F460A00.AccTag_L0;
+    begin
+       Ptr := F460A00.AccTag_L0(P);
+ 
+       -- Avoid optimization (dead variable removal of Ptr):
+       if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
+          Report.Failed ("Unexpected error in C460A01_2 instance");
+       end if;
+ 
+       Res := F460A00.OK;
+    exception
+       when Program_Error => Res := F460A00.PE_Exception;
+       when others        => Res := F460A00.Others_Exception;
+    end Proc;
+ end C460A01_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F460A00;
+ with C460A01_0;
+ with C460A01_1;
+ with C460A01_2;
+ 
+ with Report;
+ procedure C460A01 is
+ begin -- C460A01.                                              -- [ Level = 1 ]
+ 
+    Report.Test ("C460A01", "Run-time accessibility checks: instance " &
+                 "bodies. Operand type of access type conversion is "  &
+                 "passed as actual to instance");
+ 
+ 
+    SUBTEST1:
+    declare                                                     -- [ Level = 2 ]
+       type AccTag_L2 is access all F460A00.Tagged_Type;
+       Operand: AccTag_L2 := new F460A00.Tagged_Type;
+ 
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST1.
+ 
+       declare                                                  -- [ Level = 3 ]
+          -- The instantiation of C460A01_0 should NOT result in any
+          -- exceptions.
+ 
+          package Pack_OK is new C460A01_0 (F460A00.Tagged_Type, AccTag_L2);
+          Target : Pack_OK.Target_Type;
+       begin
+          -- The accessibility level of Pack_OK.Target_Type will always be at
+          -- least as deep as the operand type passed as an actual. Thus,
+          -- a call to Pack_OK.Convert does not propagate an exception:
+ 
+          Target := Pack_OK.Convert(Operand);
+ 
+          -- Avoid optimization (dead variable removal of Target):
+          if not Report.Equal (Target.C, Target.C) then      -- Always false.
+             Report.Failed ("Unexpected error in SUBTEST #1");
+          end if;
+ 
+          Result := F460A00.OK;                              -- Expected result.
+       exception
+          when Program_Error => Result := F460A00.PE_Exception;
+          when others        => Result := F460A00.Others_Exception;
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #1: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #1: Unexpected exception raised");
+    end SUBTEST1;
+ 
+ 
+ 
+    SUBTEST2:
+    declare                                                     -- [ Level = 2 ]
+       type AccTag_L2 is access all F460A00.Tagged_Type;
+       Operand : AccTag_L2 := new F460A00.Tagged_Type;
+ 
+       Result  : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST2.
+ 
+       declare                                                  -- [ Level = 3 ]
+ 
+          type AccTag_L3 is access all F460A00.Tagged_Type;
+          Target : AccTag_L3;
+ 
+          -- The instantiation of C460A01_1 should NOT result in any
+          -- exceptions.
+ 
+          package Pack_OK is new C460A01_1
+            (Designated_Type => F460A00.Tagged_Type,
+             Operand_Type    => AccTag_L2,
+             Target_Type     => AccTag_L3);
+       begin
+          -- The accessibility level of the actual passed as the operand type
+          -- in Pack_OK is 2. The accessibility level of the actual passed as
+          -- the target type is 3. Therefore, the access type conversion in
+          -- Pack_OK.Convert does not raise an exception when the subprogram is
+          -- called. If an exception is (incorrectly) raised, it is propagated 
+          -- to the innermost enclosing master:
+ 
+          Target := Pack_OK.Convert(Operand);
+ 
+          -- Avoid optimization (dead variable removal of Target):
+          if not Report.Equal (Target.C, Target.C) then      -- Always false.
+             Report.Failed ("Unexpected error in SUBTEST #2");
+          end if;
+ 
+          Result := F460A00.OK;                              -- Expected result.
+       exception
+          when Program_Error => Result := F460A00.PE_Exception;
+          when others        => Result := F460A00.Others_Exception;
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #2");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #2: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #2: Unexpected exception raised");
+    end SUBTEST2;
+ 
+ 
+ 
+    SUBTEST3:
+    declare                                                     -- [ Level = 2 ]
+       type AccTag_L2 is access all F460A00.Tagged_Type;
+       Target : AccTag_L2;
+ 
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST3.
+ 
+       declare                                                  -- [ Level = 3 ]
+ 
+          type AccTag_L3 is access all F460A00.Tagged_Type;
+          Operand : AccTag_L3 := new F460A00.Tagged_Type;
+ 
+          -- The instantiation of C460A01_1 should NOT result in any
+          -- exceptions.
+ 
+          package Pack_PE is new C460A01_1
+            (Designated_Type => F460A00.Tagged_Type,
+             Operand_Type    => AccTag_L3,
+             Target_Type     => AccTag_L2);
+       begin
+          -- The accessibility level of the actual passed as the operand type
+          -- in Pack_PE is 3. The accessibility level of the actual passed as
+          -- the target type is 2. Therefore, the access type conversion in
+          -- Pack_PE.Convert raises Program_Error when the subprogram is
+          -- called. The exception is propagated to the innermost enclosing
+          -- master:
+ 
+          Target := Pack_PE.Convert(Operand);
+ 
+          -- Avoid optimization (dead variable removal of Target):
+          if not Report.Equal (Target.C, Target.C) then      -- Always false.
+             Report.Failed ("Unexpected error in SUBTEST #3");
+          end if;
+ 
+          Result := F460A00.OK;
+       exception
+          when Program_Error => Result := F460A00.PE_Exception; 
+                                                           -- Expected result.
+          when others        => Result := F460A00.Others_Exception;
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #3");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #3: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #3: Unexpected exception raised");
+    end SUBTEST3;
+ 
+ 
+ 
+    SUBTEST4:
+    declare                                                     -- [ Level = 2 ]
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST4.
+ 
+       declare                                                  -- [ Level = 3 ]
+ 
+          TType   :  F460A00.Tagged_Type;
+          Operand :  F460A00.AccTagClass_L0 
+                  := new F460A00.Tagged_Type'(TType);
+ 
+          -- The instantiation of C460A01_2 should NOT result in any
+          -- exceptions.
+ 
+          package Pack_OK is new C460A01_2 (F460A00.Tagged_Type'Class,
+                                            F460A00.AccTagClass_L0);
+       begin
+          -- The accessibility level of the actual passed as the operand type
+          -- in Pack_OK is 0. The accessibility level of the target type
+          -- (F460A00.AccTag_L0) is also 0. Therefore, the access type
+          -- conversion in Pack_OK.Proc does not raise an exception when the
+          -- subprogram is called. If an exception is (incorrectly) raised, 
+          -- it is handled within the subprogram:
+ 
+          Pack_OK.Proc(Operand, Result);
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #4");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #4: Unexpected exception raised");
+    end SUBTEST4;
+ 
+ 
+ 
+    SUBTEST5:
+    declare                                                     -- [ Level = 2 ]
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST5.
+ 
+       declare                                                  -- [ Level = 3 ]
+ 
+          type AccDerTag_L3 is access all F460A00.Derived_Tagged_Type;
+          Operand : AccDerTag_L3 := new F460A00.Derived_Tagged_Type;
+ 
+          -- The instantiation of C460A01_2 should NOT result in any
+          -- exceptions.
+ 
+          package Pack_PE is new C460A01_2 (F460A00.Derived_Tagged_Type,
+                                            AccDerTag_L3);
+       begin
+          -- The accessibility level of the actual passed as the operand type
+          -- in Pack_PE is 3. The accessibility level of the target type
+          -- (F460A00.AccTag_L0) is 0. Therefore, the access type conversion
+          -- in Pack_PE.Proc raises Program_Error when the subprogram is
+          -- called. The exception is handled within the subprogram:
+ 
+          Pack_PE.Proc(Operand, Result);
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #5");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #5: Unexpected exception raised");
+    end SUBTEST5;
+ 
+    Report.Result;
+ 
+ end C460A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c460a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c460a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,413 ----
+ -- C460A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the target type of a type conversion is a general
+ --      access type, Program_Error is raised if the accessibility level of
+ --      the operand type is deeper than that of the target type. Check for
+ --      cases where the type conversion occurs in an instance body, and
+ --      the operand type is declared inside the instance or is the anonymous
+ --      access type of an access parameter or access discriminant.
+ --
+ -- TEST DESCRIPTION:
+ --      In order to satisfy accessibility requirements, the operand type must
+ --      be at the same or a less deep nesting level than the target type -- the
+ --      operand type must "live" as long as the target type. Nesting levels
+ --      are the run-time nestings of masters: block statements; subprogram,
+ --      task, and entry bodies; and accept statements. Packages are invisible
+ --      to accessibility rules.
+ --
+ --      This test checks for cases where the operand is a component of a
+ --      generic formal object, a stand-alone object, and an access parameter.
+ --
+ --      The test declares three generic units, each containing an access
+ --      type conversion in which the target type is a formal type:
+ --
+ --         (1) A generic package in which the operand type is the anonymous
+ --             access type of an access discriminant, and the conversion
+ --             occurs within the declarative part of the body.
+ --
+ --         (2) A generic package in which the operand type is declared within
+ --             the specification, and the conversion occurs within the
+ --             sequence of statements of the body.
+ --
+ --         (3) A generic procedure in which the operand type is the anonymous
+ --             access type of an access parameter, and the conversion occurs
+ --             within the sequence of statements.
+ --
+ --      The test verifies the following:
+ --
+ --         For (1), Program_Error is raised when the package is instantiated
+ --         if the actual passed through the formal object has an accessibility
+ --         level deeper than that of the target type passed as an actual, and
+ --         that no exception is raised otherwise. The exception is propagated
+ --         to the innermost enclosing master.
+ --
+ --         For (2), Program_Error is raised when the package is instantiated
+ --         if the package is instantiated at a level deeper than that of the
+ --         target type passed as an actual, and that no exception is raised
+ --         otherwise. The exception is handled within the package body.
+ --
+ --         For (3), Program_Error is raised when the instance procedure is
+ --         called if the actual passed through the access parameter has an
+ --         accessibility level deeper than that of the target type passed as
+ --         an actual, and that no exception is raised otherwise. The exception
+ --         is handled within the instance procedure.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F460A00.A
+ --      => C460A02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      10 May 95   SAIC    Initial prerelease version.
+ --      24 Apr 96   SAIC    Changed the target type formal to be 
+ --                          access-to-constant; Modified code to avoid dead 
+ --                          variable optimization.
+ --
+ --!
+ 
+ with F460A00;
+ generic
+    type Target_Type is access all F460A00.Tagged_Type;
+    FObj: in out F460A00.Composite_Type;
+ package C460A02_0 is
+    procedure Dummy; -- Needed to allow package body.
+ end C460A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ with Report;
+ package body C460A02_0 is
+    Ptr: Target_Type := Target_Type(FObj.D);
+ 
+    procedure Dummy is
+    begin
+       null;
+    end Dummy;
+ 
+ begin
+    -- Avoid optimization (dead variable removal of Ptr):
+    if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
+       Report.Failed ("Unexpected error in C460A02_0 instance");
+    end if;
+ 
+ end C460A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F460A00;
+ generic
+    type Designated_Type is private;
+    type Target_Type is access all Designated_Type;
+    FObj : in out Target_Type;
+    FRes : in out F460A00.TC_Result_Kind;
+ package C460A02_1 is
+    type Operand_Type is access Designated_Type;
+    Ptr : Operand_Type := new Designated_Type;
+ 
+    procedure Dummy; -- Needed to allow package body.
+ end C460A02_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C460A02_1 is
+    procedure Dummy is
+    begin
+       null;
+    end Dummy;
+ begin
+    FRes := F460A00.UN_Init;
+    FObj := Target_Type(Ptr);
+    FRes := F460A00.OK;
+ exception
+    when Program_Error => FRes := F460A00.PE_Exception;
+    when others        => FRes := F460A00.Others_Exception;
+ end C460A02_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F460A00;
+ generic
+    type Designated_Type is new F460A00.Tagged_Type with private;
+    type Target_Type is access constant Designated_Type;
+ procedure C460A02_2 (P   : access Designated_Type'Class;
+                      Res : out    F460A00.TC_Result_Kind);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ procedure C460A02_2 (P   : access Designated_Type'Class;
+                      Res : out    F460A00.TC_Result_Kind) is
+    Ptr : Target_Type;
+ begin
+    Res := F460A00.UN_Init;
+    Ptr := Target_Type(P);
+ 
+    -- Avoid optimization (dead variable removal of Ptr):
+    if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
+       Report.Failed ("Unexpected error in C460A02_2 instance");
+    end if;
+    Res := F460A00.OK;
+ exception
+    when Program_Error => Res := F460A00.PE_Exception;
+    when others        => Res := F460A00.Others_Exception;
+ end C460A02_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F460A00;
+ with C460A02_0;
+ with C460A02_1;
+ with C460A02_2;
+ 
+ with Report;
+ procedure C460A02 is
+ begin -- C460A02.                                              -- [ Level = 1 ]
+ 
+    Report.Test ("C460A02", "Run-time accessibility checks: instance " &
+                 "bodies. Operand type of access type conversion is "  &
+                 "declared inside instance or is anonymous");
+ 
+ 
+    SUBTEST1:
+    declare                                                     -- [ Level = 2 ]
+       type AccTag_L2 is access all F460A00.Tagged_Type;
+       PTag_L2    : AccTag_L2 := new F460A00.Tagged_Type;
+       Operand_L2 : F460A00.Composite_Type(PTag_L2);
+ 
+       Result     : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST1.
+ 
+       begin                                                    -- [ Level = 3 ]
+          declare                                               -- [ Level = 4 ]
+             -- The accessibility level of the actual passed as the target type
+             -- in Pack_OK is 2. The accessibility level of the composite actual
+             -- (and thus, the level of the anonymous type of the access
+             -- discriminant, which is the same as that of the containing 
+             -- object) is also 2. Therefore, the access type conversion in 
+             -- Pack_OK does not raise an exception upon instantiation:
+ 
+             package Pack_OK is new C460A02_0 
+               (Target_Type => AccTag_L2, FObj => Operand_L2);
+          begin
+             Result := F460A00.OK;                           -- Expected result.
+          end;
+       exception
+          when Program_Error => Result := F460A00.PE_Exception;
+          when others        => Result := F460A00.Others_Exception;
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
+ 
+    end SUBTEST1;
+ 
+ 
+ 
+    SUBTEST2:
+    declare                                                     -- [ Level = 2 ]
+       type AccTag_L2 is access all F460A00.Tagged_Type;
+       PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;
+ 
+       Result  : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST2.
+ 
+       declare                                                  -- [ Level = 3 ]
+          Operand_L3 : F460A00.Composite_Type(PTag_L2);
+       begin
+          declare                                               -- [ Level = 4 ]
+             -- The accessibility level of the actual passed as the target type
+             -- in Pack_PE is 2. The accessibility level of the composite actual
+             -- (and thus, the level of the anonymous type of the access
+             -- discriminant, which is the same as that of the containing 
+             -- object) is 3. Therefore, the access type conversion in Pack_PE 
+             -- propagates Program_Error upon instantiation:
+ 
+             package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3);
+          begin
+             Result := F460A00.OK;
+          end;
+       exception
+          when Program_Error => Result := F460A00.PE_Exception;       
+                                                           -- Expected result.
+          when others        => Result := F460A00.Others_Exception;
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2");
+ 
+    end SUBTEST2;
+ 
+ 
+ 
+    SUBTEST3:
+    declare                                                     -- [ Level = 2 ]
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST3.
+ 
+       declare                                                  -- [ Level = 3 ]
+          type AccArr_L3 is access all F460A00.Array_Type;
+          Target: AccArr_L3;
+ 
+          -- The accessibility level of the actual passed as the target type
+          -- in Pack_OK is 3. The accessibility level of the operand type is
+          -- that of the instance, which is also 3. Therefore, the access type
+          -- conversion in Pack_OK does not raise an exception upon
+          -- instantiation. If an exception is (incorrectly) raised, it is 
+          -- handled within the instance:
+ 
+          package Pack_OK is new C460A02_1
+            (Designated_Type => F460A00.Array_Type,
+             Target_Type     => AccArr_L3,
+             FObj            => Target,
+             FRes            => Result);
+       begin
+          null;
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated");
+       when others        =>
+          Report.Failed ("SUBTEST #3: Unexpected exception propagated");
+    end SUBTEST3;
+ 
+ 
+ 
+    SUBTEST4:
+    declare                                                     -- [ Level = 2 ]
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST4.
+ 
+       declare                                                  -- [ Level = 3 ]
+          Target: F460A00.AccArr_L0;
+ 
+          -- The accessibility level of the actual passed as the target type
+          -- in Pack_PE is 0. The accessibility level of the operand type is
+          -- that of the instance, which is 3. Therefore, the access type
+          -- conversion in Pack_PE raises Program_Error upon instantiation.
+          -- The exception is handled within the instance:
+ 
+          package Pack_PE is new C460A02_1
+            (Designated_Type => F460A00.Array_Type,
+             Target_Type     => F460A00.AccArr_L0,
+             FObj            => Target,
+             FRes            => Result);
+       begin
+          null;
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #4: Unexpected exception raised");
+    end SUBTEST4;
+ 
+ 
+ 
+    SUBTEST5:
+    declare                                                     -- [ Level = 2 ]
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST5.
+ 
+       declare                                                  -- [ Level = 3 ]
+          -- The instantiation of C460A02_2 should NOT result in any
+          -- exceptions.
+ 
+          procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
+                                           F460A00.AccTag_L0);
+       begin
+          -- The accessibility level of the actual passed to Proc is 0. The
+          -- accessibility level of the actual passed as the target type is
+          -- also 0. Therefore, the access type conversion in Proc does not
+          -- raise an exception when the subprogram is called. If an exception
+          -- is (incorrectly) raised, it is handled within the subprogram:
+ 
+          Proc (F460A00.PTagClass_L0, Result);
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #5: Unexpected exception raised");
+    end SUBTEST5;
+ 
+ 
+ 
+    SUBTEST6:
+    declare                                                     -- [ Level = 2 ]
+       Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+    begin -- SUBTEST6.
+ 
+       declare                                                  -- [ Level = 3 ]
+          -- The instantiation of C460A02_2 should NOT result in any
+          -- exceptions.
+ 
+          procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
+                                           F460A00.AccTag_L0);
+       begin
+          -- In the call to (instantiated) procedure Proc, the first actual
+          -- parameter is an allocator. Its accessibility level is that of 
+          -- the level of execution of Proc, which is 3. The accessibility 
+          -- level of the actual passed as the target type is 0.  Therefore, 
+          -- the access type conversion in Proc raises Program_Error when the
+          -- subprogram is called. The exception is handled within the
+          -- subprogram:
+ 
+          Proc (new F460A00.Tagged_Type, Result);
+       end;
+ 
+       F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6");
+ 
+    exception
+       when Program_Error =>
+          Report.Failed ("SUBTEST #6: Program_Error incorrectly raised");
+       when others        =>
+          Report.Failed ("SUBTEST #6: Unexpected exception raised");
+    end SUBTEST6;
+ 
+    Report.Result;
+ 
+ end C460A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- C47002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+ -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+ -- THIS TEST IS FOR DISCRETE TYPES.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47002A IS
+ 
+ BEGIN
+ 
+      TEST( "C47002A", "CHECK THAT VALUES HAVING DISCRETE TYPES " &
+                       "CAN BE WRITTEN AS THE OPERANDS OF " &
+                       "QUALIFIED EXPRESSIONS" );
+ 
+      DECLARE  -- ENUMERATION TYPES.
+           
+           TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+           TYPE WEEKEND IS (SAT, SUN);
+ 
+           TYPE CHAR IS ('B', 'A');
+ 
+           TYPE MYBOOL IS (TRUE, FALSE);
+           
+           TYPE NBOOL IS NEW BOOLEAN;
+ 
+      BEGIN
+           IF WEEKEND'(SAT) >= SUN THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE WEEKEND" );
+           END IF;
+ 
+           IF CHAR'('B') >= 'A' THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE CHAR" );
+           END IF;
+ 
+           IF MYBOOL'(TRUE) >= FALSE THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE MYBOOL" );
+           END IF;
+ 
+           IF NBOOL'(TRUE) <= FALSE THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE NBOOL" );
+           END IF;
+      END;
+ 
+      DECLARE -- INTEGER TYPES.
+ 
+           TYPE RESULTS IS (INT1, INT2, INT3);
+    
+           TYPE NEWINT IS NEW INTEGER;
+           
+           TYPE INT IS RANGE -10 .. 10;
+ 
+           FUNCTION F (I : NEWINT) RETURN RESULTS IS
+           BEGIN
+                RETURN INT1;
+           END F;
+ 
+           FUNCTION F (I : INT) RETURN RESULTS IS
+           BEGIN
+                RETURN INT2;
+           END F;
+ 
+           FUNCTION F (I : INTEGER) RETURN RESULTS IS
+           BEGIN
+                RETURN INT3;
+           END F;
+ 
+      BEGIN
+           IF F (NEWINT'(5)) /= INT1 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE NEWINT" );
+           END IF;
+ 
+           IF F (INT'(5)) /= INT2 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE INT" );
+           END IF;
+ 
+           IF F (INTEGER'(5)) /= INT3 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE INTEGER" );
+           END IF;
+      END;
+ 
+      RESULT;
+ END C47002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- C47002B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+ -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+ -- THIS TEST IS FOR REAL TYPES.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47002B IS
+ 
+ BEGIN
+ 
+      TEST( "C47002B", "CHECK THAT VALUES HAVING REAL TYPES " &
+                       "CAN BE WRITTEN AS THE OPERANDS OF " &
+                       "QUALIFIED EXPRESSIONS" );
+ 
+      DECLARE -- FLOATING POINT TYPES.
+      
+           TYPE RESULTS IS (FL1, FL2, FL3);
+ 
+           TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
+ 
+           TYPE NFLT IS NEW FLOAT;
+ 
+           FUNCTION F (FL : FLT) RETURN RESULTS IS 
+           BEGIN
+                RETURN FL1;
+           END F;
+ 
+           FUNCTION F (FL : NFLT) RETURN RESULTS IS
+           BEGIN
+                RETURN FL2;
+           END F;
+ 
+           FUNCTION F (FL : FLOAT) RETURN RESULTS IS
+           BEGIN
+                RETURN FL3;
+           END F;
+ 
+      BEGIN
+           IF F (FLT'(0.0)) /= FL1 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE FLT" );
+           END IF;
+ 
+           IF F (NFLT'(0.0)) /= FL2 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE NFLT" );
+           END IF;
+ 
+           IF F (FLOAT'(0.0)) /= FL3 THEN 
+                FAILED ( "INCORRECT RESULTS FOR TYPE FLOAT" );
+           END IF;
+      END;   
+      
+      DECLARE -- FIXED POINT TYPES.
+      
+           TYPE RESULTS IS (FI1, FI2, FI3);
+ 
+           TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
+ 
+           TYPE NFIX IS NEW FIXED;
+ 
+           FUNCTION F (FI : FIXED) RETURN RESULTS IS 
+           BEGIN
+                RETURN FI1;
+           END F;
+ 
+           FUNCTION F (FI : NFIX) RETURN RESULTS IS
+           BEGIN
+                RETURN FI2;
+           END F;
+ 
+           FUNCTION F (FI : DURATION) RETURN RESULTS IS
+           BEGIN
+                RETURN FI3;
+           END F;
+ 
+      BEGIN
+           IF F (FIXED'(0.0)) /= FI1 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE FIXED" );
+           END IF;
+ 
+           IF F (NFIX'(0.0)) /= FI2 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE NFIX" );
+           END IF;
+ 
+           IF F (DURATION'(0.0)) /= FI3 THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE DURATION" );
+           END IF;
+      END;   
+      
+      RESULT;
+ END C47002B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,212 ----
+ -- C47002C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+ -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+ -- THIS TEST IS FOR ARRAY, RECORD, AND ACCESS TYPES.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47002C IS
+ 
+ BEGIN
+ 
+      TEST( "C47002C", "CHECK THAT VALUES HAVING ARRAY, RECORD, AND " &
+                       "ACCESS TYPES CAN BE WRITTEN AS THE OPERANDS " &
+                       "OF QUALIFIED EXPRESSIONS" );
+ 
+      DECLARE -- ARRAY TYPES.
+      
+           TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           SUBTYPE ARR1 IS ARR (1 .. 1);
+           SUBTYPE ARR5 IS ARR (1 .. 5);
+ 
+           TYPE NARR IS NEW ARR;
+           SUBTYPE NARR2 IS NARR (2 .. 2);
+ 
+           TYPE TARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 
+                OF INTEGER;
+           SUBTYPE TARR15 IS TARR (1 .. 1, 1 .. 5);
+           SUBTYPE TARR51 IS TARR (1 .. 5, 1 .. 1);
+ 
+           TYPE NTARR IS NEW TARR;
+           SUBTYPE NTARR26 IS NTARR (2 .. 6, 2 .. 6);
+ 
+           FUNCTION F (X : ARR) RETURN ARR IS
+           BEGIN
+                RETURN X;
+           END;
+ 
+           FUNCTION F (X : NARR) RETURN NARR IS
+           BEGIN
+                RETURN X;
+           END;
+ 
+           FUNCTION F (X : TARR) RETURN TARR IS
+           BEGIN
+                RETURN X;
+           END;
+ 
+           FUNCTION F (X : NTARR) RETURN NTARR IS
+           BEGIN
+                RETURN X;
+           END;
+ 
+      BEGIN
+           IF F (ARR1'(OTHERS => 0))'LAST /= 1 THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR1" );
+           END IF;
+ 
+           IF F (ARR5'(OTHERS => 0))'LAST /= 5 THEN 
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR5" );
+           END IF;
+ 
+           IF F (NARR2'(OTHERS => 0))'FIRST /= 2 OR 
+              F (NARR2'(OTHERS => 0))'LAST /= 2 THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE NARR2" );
+           END IF;
+ 
+           IF F (TARR15'(OTHERS => (OTHERS => 0)))'LAST /= 1 OR 
+              F (TARR15'(OTHERS => (OTHERS => 0)))'LAST (2) /= 5 THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR15" );
+           END IF;
+ 
+           IF F (TARR51'(OTHERS => (OTHERS => 0)))'LAST /= 5 OR 
+              F (TARR51'(OTHERS => (OTHERS => 0)))'LAST (2) /= 1 THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR51" );
+           END IF;
+ 
+           IF F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST /= 2 OR 
+              F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST /= 6 OR
+              F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST (2) /= 2 OR 
+              F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST (2) /= 6 THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE NTARR26" );
+           END IF;
+ 
+      END;   
+      
+      DECLARE -- RECORD TYPES.
+ 
+           TYPE GENDER IS (MALE, FEMALE, NEUTER);
+           
+           TYPE MAN IS
+                RECORD
+                     AGE : POSITIVE;
+                END RECORD;
+ 
+           TYPE WOMAN IS
+                RECORD
+                     AGE : POSITIVE;
+                END RECORD;
+ 
+           TYPE ANDROID IS NEW MAN;
+           
+           FUNCTION F (X: WOMAN) RETURN GENDER IS
+           BEGIN
+                RETURN FEMALE;
+           END F;
+ 
+           FUNCTION F (X: MAN) RETURN GENDER IS
+           BEGIN
+                RETURN MALE;
+           END F;
+           
+           FUNCTION F (X : ANDROID) RETURN GENDER IS
+           BEGIN
+                RETURN NEUTER;
+           END F;
+ 
+      BEGIN
+           IF F (MAN'(AGE => 23)) /= MALE THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE MAN" );
+           END IF;
+ 
+           IF F (WOMAN'(AGE => 38)) /= FEMALE THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE WOMAN" );
+           END IF;
+ 
+           IF F (ANDROID'(AGE => 2001)) /= NEUTER THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE ANDRIOD" );
+           END IF;
+      END;     
+                     
+      DECLARE -- ACCESS TYPES.
+ 
+           TYPE CODE IS (OLD, BRANDNEW, WRECK);
+           
+           TYPE CAR (D : CODE) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE KEY IS ACCESS CAR;
+ 
+           TYPE KEY_OLD IS ACCESS CAR (OLD);
+           KO : KEY_OLD := NEW CAR'(D => OLD);          
+ 
+           TYPE KEY_WRECK IS ACCESS CAR (WRECK);
+ 
+           TYPE KEY_CARD IS NEW KEY;
+           KC : KEY_CARD := NEW CAR'(D => BRANDNEW);          
+  
+           FUNCTION F (X : KEY_OLD) RETURN CODE IS
+           BEGIN
+                RETURN OLD;
+           END F;
+ 
+           FUNCTION F (X : KEY_WRECK) RETURN CODE IS
+           BEGIN
+                RETURN WRECK;
+           END F;
+ 
+           FUNCTION F (X : KEY_CARD) RETURN CODE IS
+           BEGIN
+                RETURN BRANDNEW;
+           END F;
+      BEGIN
+           IF KEY_OLD'(KO) /= KO THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE KEY_OLD - 1" );
+           END IF;
+ 
+           IF KEY_CARD'(KC) /= KC THEN 
+                FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 1" );
+           END IF;
+ 
+ 
+           IF F (KEY_OLD'(NULL)) /= OLD THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_OLD - 2" );
+           END IF;
+ 
+           IF F (KEY_WRECK'(NULL)) /= WRECK THEN
+                FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_WRECK" );
+           END IF;
+ 
+           IF F (KEY_CARD'(NULL)) /= BRANDNEW THEN
+                FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 2" );
+           END IF;
+      END;
+           
+      RESULT;
+ END C47002C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47002d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47002d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,273 ----
+ -- C47002D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+ -- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+ -- THIS TEST IS FOR PRIVATE AND LIMITED PRIVATE TYPES.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47002D IS
+ 
+ BEGIN
+ 
+      TEST( "C47002D", "CHECK THAT VALUES HAVING PRIVATE AND LIMITED " &
+                       "PRIVATE TYPES CAN BE WRITTEN AS THE OPERANDS " &
+                       "OF QUALIFIED EXPRESSIONS" );
+ 
+      DECLARE -- PRIVATE TYPES.
+ 
+           TYPE RESULTS IS (P1, P2, P3, P4, P5);
+ 
+           PACKAGE PKG1 IS
+                TYPE PINT IS PRIVATE;
+                TYPE PCHAR IS PRIVATE;
+                TYPE PARR IS PRIVATE;
+                TYPE PREC (D : INTEGER) IS PRIVATE;
+                TYPE PACC IS PRIVATE;
+ 
+                FUNCTION F RETURN PINT;
+                FUNCTION F RETURN PCHAR;
+                FUNCTION F RETURN PARR;
+                FUNCTION F RETURN PREC;
+                FUNCTION F RETURN PACC;
+ 
+           PRIVATE
+                TYPE PINT IS NEW INTEGER;
+                TYPE PCHAR IS NEW CHARACTER;
+                TYPE PARR IS ARRAY (1 .. 2) OF NATURAL;
+ 
+                TYPE PREC (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+      
+                TYPE PACC IS ACCESS PREC;
+ 
+           END PKG1;
+           
+           PACKAGE BODY PKG1 IS
+                FUNCTION F RETURN PINT IS
+                BEGIN
+                     RETURN 1;
+                END F;
+                     
+                FUNCTION F RETURN PCHAR IS
+                BEGIN
+                     RETURN 'B';
+                END F;
+ 
+                FUNCTION F RETURN PARR IS
+                BEGIN
+                     RETURN PARR'(OTHERS => 3);
+                END F;
+ 
+                FUNCTION F RETURN PREC IS
+                BEGIN
+                     RETURN PREC'(D => 4);
+                END F;
+ 
+                FUNCTION F RETURN PACC IS
+                BEGIN
+                     RETURN NEW PREC'(F);
+                END F;
+ 
+           END PKG1;
+                     
+           PACKAGE PKG2 IS END PKG2;
+ 
+           PACKAGE BODY PKG2 IS
+                USE PKG1;
+ 
+                FUNCTION CHECK (P : PINT) RETURN RESULTS IS
+                BEGIN
+                     RETURN  P1;
+                END CHECK;
+      
+                FUNCTION CHECK (P : PCHAR) RETURN RESULTS IS
+                BEGIN
+                     RETURN  P2;
+                END CHECK;
+      
+                FUNCTION CHECK (P : PARR) RETURN RESULTS IS
+                BEGIN
+                     RETURN  P3;
+                END CHECK;
+      
+                FUNCTION CHECK (P : PREC) RETURN RESULTS IS
+                BEGIN
+                     RETURN  P4;
+                END CHECK;
+ 
+                FUNCTION CHECK (P : PACC) RETURN RESULTS IS
+                BEGIN
+                     RETURN  P5;
+                END CHECK;
+           
+           BEGIN              
+                IF CHECK (PINT'(F)) /= P1 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE PINT" );
+                END IF;
+ 
+                IF CHECK (PCHAR'(F)) /= P2 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE PCHAR" );
+                END IF;
+                  
+                IF CHECK (PARR'(F)) /= P3 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE PARR" );
+                END IF;
+                  
+                IF CHECK (PREC'(F)) /= P4 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE PREC" );
+                END IF;
+ 
+                IF CHECK (PACC'(F)) /= P5 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE PACC" );
+                END IF;
+                  
+           END PKG2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE -- LIMITED PRIVATE TYPES.
+ 
+           TYPE RESULTS IS (LP1, LP2, LP3, LP4, LP5);
+ 
+           PACKAGE PKG1 IS
+                TYPE LPINT IS LIMITED PRIVATE;
+                TYPE LPCHAR IS LIMITED PRIVATE;
+                TYPE LPARR IS LIMITED PRIVATE;
+                TYPE LPREC (D : INTEGER) IS LIMITED PRIVATE;
+                TYPE LPACC IS LIMITED PRIVATE;
+ 
+                FUNCTION F RETURN LPINT;
+                FUNCTION F RETURN LPCHAR;
+                FUNCTION F RETURN LPARR;
+                FUNCTION F RETURN LPREC;
+                FUNCTION F RETURN LPACC;
+ 
+           PRIVATE
+                TYPE LPINT IS NEW INTEGER;
+                TYPE LPCHAR IS NEW CHARACTER;
+                TYPE LPARR IS ARRAY (1 .. 2) OF NATURAL;
+ 
+                TYPE LPREC (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+      
+                TYPE LPACC IS ACCESS LPREC;
+ 
+           END PKG1;
+           
+           PACKAGE BODY PKG1 IS
+                FUNCTION F RETURN LPINT IS
+                BEGIN
+                     RETURN 1;
+                END F;
+                     
+                FUNCTION F RETURN LPCHAR IS
+                BEGIN
+                     RETURN 'B';
+                END F;
+ 
+                FUNCTION F RETURN LPARR IS
+                BEGIN
+                     RETURN LPARR'(OTHERS => 3);
+                END F;
+ 
+                FUNCTION F RETURN LPREC IS
+                BEGIN
+                     RETURN LPREC'(D => 4);
+                END F;
+ 
+                FUNCTION F RETURN LPACC IS
+                BEGIN
+                     RETURN NEW LPREC'(F);
+                END F;
+ 
+           END PKG1;
+                     
+           PACKAGE PKG2 IS END PKG2;
+ 
+           PACKAGE BODY PKG2 IS
+                USE PKG1;
+ 
+                FUNCTION CHECK (LP : LPINT) RETURN RESULTS IS
+                BEGIN
+                     RETURN  LP1;
+                END CHECK;
+      
+                FUNCTION CHECK (LP : LPCHAR) RETURN RESULTS IS
+                BEGIN
+                     RETURN  LP2;
+                END CHECK;
+      
+                FUNCTION CHECK (LP : LPARR) RETURN RESULTS IS
+                BEGIN
+                     RETURN  LP3;
+                END CHECK;
+      
+                FUNCTION CHECK (LP : LPREC) RETURN RESULTS IS
+                BEGIN
+                     RETURN  LP4;
+                END CHECK;
+ 
+                FUNCTION CHECK (LP : LPACC) RETURN RESULTS IS
+                BEGIN
+                     RETURN  LP5;
+                END CHECK;
+           
+           BEGIN              
+                IF CHECK (LPINT'(F)) /= LP1 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE LPINT" );
+                END IF;
+ 
+                IF CHECK (LPCHAR'(F)) /= LP2 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE LPCHAR" );
+                END IF;
+                  
+                IF CHECK (LPARR'(F)) /= LP3 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE LPARR" );
+                END IF;
+                  
+                IF CHECK (LPREC'(F)) /= LP4 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE LPREC" );
+                END IF;
+ 
+                IF CHECK (LPACC'(F)) /= LP5 THEN
+                     FAILED ( "INCORRECT RESULTS FOR TYPE LPACC" );
+                END IF;
+                  
+           END PKG2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C47002D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- C47003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN 
+ -- ENUMERATION TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE 
+ -- VALUE OF THE OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47003A IS
+ 
+ BEGIN
+ 
+      TEST( "C47003A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                       "EXPRESSION DENOTES AN ENUMERATION " &
+                       "TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
+                       "WITHIN THE RANGE OF THE TYPE MARK" );
+ 
+      DECLARE  
+           
+           TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+           SUBTYPE MIDWEEK IS WEEK RANGE TUE .. THU;
+ 
+           FUNCTION IDENT (W : WEEK) RETURN WEEK IS
+           BEGIN
+                RETURN WEEK'VAL (IDENT_INT (WEEK'POS (W)));
+           END IDENT;
+ 
+      BEGIN
+           IF MIDWEEK'(IDENT (SUN)) = TUE THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE MIDWEEK - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE MIDWEEK - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE MIDWEEK" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE CHAR IS CHARACTER RANGE 'C' .. 'R';
+ 
+      BEGIN
+           IF CHAR'(IDENT_CHAR ('A')) = 'C' THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE CHAR - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE CHAR - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE CHAR" );
+      END;
+ 
+      DECLARE  
+ 
+           TYPE NBOOL IS NEW BOOLEAN;
+           SUBTYPE NFALSE IS NBOOL RANGE FALSE .. FALSE;
+ 
+           FUNCTION IDENT (B : NBOOL) RETURN NBOOL IS
+           BEGIN
+                RETURN NBOOL (IDENT_BOOL (BOOLEAN (B)));
+           END IDENT;
+ 
+      BEGIN
+           IF NFALSE'(IDENT (TRUE)) = FALSE THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE NFALSE - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE NFALSE - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE NFALSE" );
+      END;
+ 
+      RESULT;
+ END C47003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- C47004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN INTEGER 
+ -- TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE OF THE 
+ -- OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47004A IS
+ 
+ BEGIN
+ 
+      TEST( "C47004A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                       "EXPRESSION DENOTES AN INTEGER " &
+                       "TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
+                       "WITHIN THE RANGE OF THE TYPE MARK" );
+ 
+      DECLARE  
+           
+           TYPE INT IS RANGE -10 .. 10;
+           SUBTYPE SINT IS INT RANGE -5 .. 5;
+           
+           FUNCTION IDENT (I : INT) RETURN INT IS
+           BEGIN
+                RETURN INT (IDENT_INT (INTEGER (I)));
+           END;
+ 
+      BEGIN
+           IF SINT'(IDENT (10)) = 5 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SINT - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SINT - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SINT" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE SINTEGER IS INTEGER RANGE -10 .. 10;
+           
+      BEGIN
+           IF SINTEGER'(IDENT_INT (20)) = 15 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SINTEGER - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SINTEGER - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SINTEGER" );
+      END;
+ 
+      DECLARE  
+           
+           TYPE NINTEGER IS NEW INTEGER;
+           SUBTYPE SNINT IS NINTEGER RANGE -10 .. 10;
+           
+           FUNCTION IDENT (I : NINTEGER) RETURN NINTEGER IS
+           BEGIN
+                RETURN NINTEGER (IDENT_INT (INTEGER (I)));
+           END;
+ 
+      BEGIN
+           IF SNINT'(IDENT (-20)) = -10 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SNINT - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SNINT - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SNINT" );
+      END;
+ 
+      RESULT;
+ END C47004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C47005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FLOATING
+ --     POINT TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE
+ --     OF THE OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+ 
+ -- HISTORY:
+ --     RJW 07/23/86  CREATED ORIGINAL TEST.
+ --     BCB 08/19/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  ADDED
+ --                   TEST FOR UPPER SIDE OF RANGE.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C47005A IS
+ 
+ BEGIN
+ 
+      TEST( "C47005A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
+                       "DENOTES A FLOATING POINT TYPE, CHECK THAT " &
+                       "CONSTRAINT_ERROR IS RAISED WHEN THE VALUE " &
+                       "OF THE OPERAND DOES NOT LIE WITHIN THE " &
+                       "RANGE OF THE TYPE MARK" );
+ 
+      DECLARE
+ 
+           SUBTYPE SFLOAT IS FLOAT RANGE -1.0 .. 1.0;
+ 
+           FUNCTION IDENT (F : FLOAT) RETURN FLOAT IS
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RETURN F;
+                ELSE
+                     RETURN 0.0;
+                END IF;
+           END IDENT;
+ 
+      BEGIN
+           IF SFLOAT'(IDENT (-2.0)) = -1.0 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SFLOAT - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SFLOAT - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SFLOAT" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
+           SUBTYPE SFLT IS FLT RANGE -1.0 .. 1.0;
+ 
+           FUNCTION IDENT (F : FLT) RETURN FLT IS
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RETURN F;
+                ELSE
+                     RETURN 0.0;
+                END IF;
+           END IDENT;
+ 
+      BEGIN
+           IF SFLT'(IDENT (-2.0)) = -1.0 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SFLT - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SFLT - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SFLT" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE NFLT IS NEW FLOAT;
+           SUBTYPE SNFLT IS NFLT RANGE -1.0 .. 1.0;
+ 
+           FUNCTION IDENT (F : NFLT) RETURN NFLT IS
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RETURN F;
+                ELSE
+                     RETURN 0.0;
+                END IF;
+           END IDENT;
+ 
+      BEGIN
+           IF SNFLT'(IDENT (2.0)) = 1.0 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SNFLT 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SNFLT 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SNFLT" );
+      END;
+ 
+      RESULT;
+ END C47005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C47006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FIXED POINT 
+ -- TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE OF THE 
+ -- OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47006A IS
+ 
+      TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
+ 
+ BEGIN
+ 
+      TEST( "C47006A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                       "EXPRESSION DENOTES A FIXED POINT TYPE, " &
+                       "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
+                       "WITHIN THE RANGE OF THE TYPE MARK" );
+ 
+      DECLARE  
+ 
+           SUBTYPE SFIXED IS FIXED RANGE -2.0 .. 2.0;
+ 
+           FUNCTION IDENT (X : FIXED) RETURN FIXED IS
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RETURN X;
+                ELSE
+                     RETURN 0.0;
+                END IF;
+           END IDENT;
+ 
+      BEGIN
+           IF SFIXED'(IDENT (-5.0)) = -2.0 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SFIXED - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SFIXED - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SFIXED" );
+      END;
+ 
+      DECLARE  
+ 
+           TYPE NFIX IS NEW FIXED;
+           SUBTYPE SNFIX IS NFIX RANGE -2.0 .. 2.0;
+ 
+           FUNCTION IDENT (X : NFIX) RETURN NFIX IS
+           BEGIN
+                RETURN NFIX (IDENT_INT (INTEGER (X)));
+           END IDENT;
+ 
+      BEGIN
+           IF SNFIX'(IDENT (-5.0)) = -2.0 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SNFIX - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                         "SUBTYPE SNFIX - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                         "OF SUBTYPE SNFIX" );
+      END;
+ 
+      RESULT;
+ END C47006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C47007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A CONSTRAINED 
+ -- ARRAY TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE BOUNDS 
+ -- OF THE OPERAND ARE NOT THE SAME AS THE BOUNDS OF THE TYPE MARK.
+ 
+ -- RJW 7/23/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C47007A IS
+ 
+      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+ 
+      TYPE TARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 
+           OF INTEGER;
+ 
+      TYPE NARR IS NEW ARR;
+ 
+      TYPE NTARR IS NEW TARR;
+ 
+ BEGIN
+ 
+      TEST( "C47007A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
+                       "DENOTES A CONSTRAINED ARRAY TYPE, CHECK THAT " &
+                       "CONSTRAINT_ERROR IS RAISED WHEN THE BOUNDS " &
+                       "OF THE OPERAND ARE NOT THE SAME AS THE " &
+                       "BOUNDS OF THE TYPE MARK" );
+ 
+      DECLARE  
+           
+           SUBTYPE SARR IS ARR (IDENT_INT (1) .. IDENT_INT (1));
+           A : ARR (IDENT_INT (2) .. IDENT_INT (2));
+      BEGIN
+           A := SARR'(A'RANGE => 0);
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE SARR" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE SARR" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE NULLA IS ARR (IDENT_INT (1) .. IDENT_INT (0));
+           A : ARR (IDENT_INT (2) .. IDENT_INT (1));
+ 
+      BEGIN
+           A := NULLA'(A'FIRST .. A'LAST => 0);
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE NULLA" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE NULLA" );
+      END;
+ 
+      DECLARE  
+ 
+           SUBTYPE STARR IS TARR (IDENT_INT (1) .. IDENT_INT (1), 
+                                  IDENT_INT (1) .. IDENT_INT (5));
+           A : TARR (IDENT_INT (2) .. IDENT_INT (6),
+                     IDENT_INT (1) .. IDENT_INT (1));
+      BEGIN
+           A := STARR'(A'RANGE => (A'RANGE (2) => 0));
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE STARR" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE STARR" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE NULLT IS TARR (IDENT_INT (1) .. IDENT_INT (5), 
+                                  IDENT_INT (1) .. IDENT_INT (0));
+ 
+           A : TARR (IDENT_INT (1) .. IDENT_INT (5),
+                     IDENT_INT (2) .. IDENT_INT (1));
+      BEGIN
+           A := NULLT'(A'FIRST .. A'LAST  => 
+                      (A'FIRST (2) .. A'LAST (2) => 0));
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE NULLT" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE NULLT" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE SNARR IS NARR (IDENT_INT (1) .. IDENT_INT (1));
+           A : NARR (IDENT_INT (2) .. IDENT_INT (2));
+ 
+      BEGIN
+           A := SNARR'(A'RANGE => 0);
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE SNARR" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE SNARR" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE NULLNA IS NARR (IDENT_INT (1) .. IDENT_INT (0));
+           A : NARR (IDENT_INT (2) .. IDENT_INT (1));
+ 
+      BEGIN
+           A := NULLNA'(A'RANGE => 0);
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE NULLNA" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE NULLNA" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE SNTARR IS NTARR (IDENT_INT (1) .. IDENT_INT (1), 
+                                    IDENT_INT (1) .. IDENT_INT (5));
+ 
+           A : NTARR (IDENT_INT (2) .. IDENT_INT (2),
+                      IDENT_INT (1) .. IDENT_INT (5));
+      BEGIN
+           A := SNTARR'(A'RANGE => (A'RANGE (2) => 0));
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE SNTARR" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE SNTARR" );
+      END;
+ 
+      DECLARE  
+           
+           SUBTYPE NULLNT IS NTARR (IDENT_INT (1) .. IDENT_INT (5), 
+                                    IDENT_INT (1) .. IDENT_INT (0));
+ 
+           A : NTARR (IDENT_INT (1) .. IDENT_INT (5),
+                     IDENT_INT (1) .. IDENT_INT (1));
+      BEGIN
+           A := NULLNT'(A'RANGE => (A'RANGE (2) => 0));
+           FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                    "THOSE OF SUBTYPE NULLNT" );
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                         "THE SAME AS THOSE OF SUBTYPE NULLNT" );
+      END;
+ 
+      RESULT;
+ END C47007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,299 ----
+ -- C47008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A
+ --     CONSTRAINED RECORD, PRIVATE, OR LIMITED PRIVATE TYPE, CHECK THAT
+ --     CONSTRAINT_ERROR IS RAISED WHEN THE DISCRIMINANTS OF THE OPERAND
+ --     DO NOT EQUAL THOSE OF THE TYPE MARK.
+ 
+ -- HISTORY:
+ --     RJW 07/23/86
+ --     DWC 07/24/87  CHANGED CODE TO TEST FOR FIRST DISCRIMINANT
+ --                   AND LAST DISCRIMINANT MISMATCH.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C47008A IS
+ 
+      TYPE GENDER IS (MALE, FEMALE, NEUTER);
+ 
+      FUNCTION IDENT (G : GENDER) RETURN GENDER IS
+      BEGIN
+           RETURN GENDER'VAL (IDENT_INT (GENDER'POS (G)));
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST( "C47008A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                       "EXPRESSION DENOTES A CONSTRAINED RECORD, " &
+                       "PRIVATE, OR LIMITED PRIVATE TYPE, CHECK " &
+                       "THAT CONSTRAINT_ERROR IS RAISED WHEN THE " &
+                       "DISCRIMANTS OF THE OPERAND DO NOT EQUAL " &
+                       "THOSE OF THE TYPE MARK" );
+ 
+      DECLARE
+ 
+           TYPE PERSON (SEX : GENDER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           SUBTYPE WOMAN IS PERSON (IDENT (FEMALE));
+           TOM : PERSON (MALE) := (SEX => IDENT (MALE));
+ 
+      BEGIN
+           IF WOMAN'(TOM) = PERSON'(SEX => MALE) THEN
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE WOMAN - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE WOMAN - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                         "DISC NOT EQUAL TO THOSE OF SUBTYPE WOMAN" );
+      END;
+ 
+      DECLARE
+           TYPE PAIR (SEX1, SEX2 : GENDER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           SUBTYPE COUPLE IS PAIR (IDENT (FEMALE), IDENT (MALE));
+           JONESES : PAIR (IDENT (MALE), IDENT (FEMALE));
+ 
+      BEGIN
+           IF COUPLE'(JONESES) = PAIR'(SEX1 => MALE, SEX2 => FEMALE)
+              THEN
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE COUPLE - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE COUPLE - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                         "DISC NOT EQUAL TO THOSE OF SUBTYPE COUPLE" );
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                TYPE PERSON (SEX : GENDER) IS PRIVATE;
+                SUBTYPE MAN IS PERSON (IDENT (MALE));
+ 
+                TESTWRITER : CONSTANT PERSON;
+ 
+           PRIVATE
+                TYPE PERSON (SEX : GENDER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TESTWRITER : CONSTANT PERSON := (SEX => FEMALE);
+ 
+           END PKG;
+ 
+           USE PKG;
+ 
+           ROSA : PERSON (IDENT (FEMALE));
+ 
+      BEGIN
+           IF MAN'(ROSA) = TESTWRITER THEN
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE MAN - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE MAN - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                         "DISC NOT EQUAL TO THOSE OF SUBTYPE MAN" );
+      END;
+ 
+      DECLARE
+           PACKAGE PKG IS
+                TYPE PAIR (SEX1, SEX2 : GENDER) IS PRIVATE;
+                SUBTYPE FRIENDS IS PAIR (IDENT (FEMALE), IDENT (MALE));
+ 
+                ALICE_AND_JERRY : CONSTANT FRIENDS;
+ 
+           PRIVATE
+                TYPE PAIR (SEX1, SEX2 : GENDER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                ALICE_AND_JERRY : CONSTANT FRIENDS :=
+                                  (IDENT (FEMALE), IDENT (MALE));
+ 
+           END PKG;
+ 
+           USE PKG;
+ 
+           DICK_AND_JOE : PAIR (IDENT (MALE), IDENT (MALE));
+ 
+      BEGIN
+           IF FRIENDS'(DICK_AND_JOE) = ALICE_AND_JERRY THEN
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE FRIENDS - 1");
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                         "NOT EQUAL TO THOSE OF SUBTYPE FRIENDS - 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                         "DISC NOT EQUAL TO THOSE OF SUBTYPE FRIENDS" );
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE PKG1 IS
+                TYPE PERSON (SEX : GENDER) IS LIMITED PRIVATE;
+                SUBTYPE ANDROID IS PERSON (IDENT (NEUTER));
+ 
+                FUNCTION F RETURN PERSON;
+                FUNCTION "=" (A, B : PERSON) RETURN BOOLEAN;
+           PRIVATE
+                TYPE PERSON (SEX : GENDER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+           END PKG1;
+ 
+           PACKAGE BODY PKG1 IS
+ 
+                FUNCTION F RETURN PERSON IS
+                BEGIN
+                     RETURN PERSON'(SEX => (IDENT (MALE)));
+                END F;
+ 
+                FUNCTION "=" (A, B : PERSON) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN A.SEX = B.SEX;
+                END;
+ 
+           END PKG1;
+ 
+           PACKAGE PKG2 IS END PKG2;
+ 
+           PACKAGE BODY PKG2 IS
+                USE PKG1;
+ 
+           BEGIN
+                IF ANDROID'(F) = F THEN
+                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                              "ANDROID - 1");
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                              "ANDROID - 2");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND " &
+                              "WITH DISC NOT EQUAL TO THOSE OF " &
+                              "SUBTYPE ANDROID" );
+           END PKG2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE
+           PACKAGE PKG1 IS
+                TYPE PAIR (SEX1, SEX2 : GENDER) IS LIMITED PRIVATE;
+                SUBTYPE LOVERS IS PAIR (IDENT (FEMALE), IDENT (MALE));
+ 
+                FUNCTION F RETURN PAIR;
+                FUNCTION "=" (A, B : PAIR) RETURN BOOLEAN;
+           PRIVATE
+                TYPE PAIR (SEX1, SEX2 : GENDER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PKG1;
+ 
+           PACKAGE BODY PKG1 IS
+ 
+                FUNCTION F RETURN PAIR IS
+                BEGIN
+                     RETURN PAIR'(SEX1 => (IDENT (FEMALE)),
+                                    SEX2 => (IDENT (FEMALE)));
+                END F;
+ 
+                FUNCTION "=" (A, B : PAIR) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN A.SEX1 = B.SEX2;
+                END;
+ 
+           END PKG1;
+ 
+           PACKAGE PKG2 IS END PKG2;
+ 
+           PACKAGE BODY PKG2 IS
+                USE PKG1;
+ 
+           BEGIN
+                IF LOVERS'(F) = F THEN
+                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                              "LOVERS - 1");
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                              "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                              "LOVERS - 2");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND " &
+                              "WITH DISC NOT EQUAL TO THOSE OF " &
+                              "SUBTYPE LOVERS" );
+           END PKG2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C47008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,254 ----
+ -- C47009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A
+ --     CONSTRAINED ACCESS TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED
+ --     WHEN THE VALUE OF THE OPERAND IS NOT NULL AND THE DESIGNATED
+ --     OBJECT HAS INDEX BOUNDS OR DISCRIMINANT VALUES THAT DO NOT EQUAL
+ --     THOSE SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT.
+ 
+ -- HISTORY:
+ --     RJW 7/23/86
+ --     DWC 07/24/87  REVISED TO MAKE THE ACCESS TYPE UNCONSTRAINED
+ --                   AND TO PREVENT DEAD VARIABLE OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C47009A IS
+ 
+ BEGIN
+ 
+      TEST( "C47009A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
+                       "DENOTES A CONSTRAINED ACCESS TYPE, CHECK " &
+                       "THAT CONSTRAINT_ERROR IS RAISED WHEN THE " &
+                       "VALUE OF THE OPERAND IS NOT NULL AND THE " &
+                       "DESIGNATED OBJECT HAS INDEX BOUNDS OR " &
+                       "DISCRIMINANT VALUES THAT DO NOT EQUAL THOSE " &
+                       "SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT" );
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+           TYPE ACC1 IS ACCESS ARR;
+           SUBTYPE ACC1S IS ACC1 (IDENT_INT (1) .. IDENT_INT (5));
+           A : ACC1;
+           B : ARR (IDENT_INT (2) .. IDENT_INT (6));
+ 
+      BEGIN
+           A := ACC1S'(NEW ARR'(B'FIRST .. B'LAST => 0));
+           IF A'FIRST = 1 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC1 - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC1 - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC1" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
+                OF INTEGER;
+           TYPE ACC2 IS ACCESS ARR;
+           SUBTYPE ACC2S IS ACC2 (IDENT_INT (1) .. IDENT_INT (5),
+                                    IDENT_INT (1) .. IDENT_INT (1));
+           A : ACC2;
+           B : ARR (IDENT_INT (1) .. IDENT_INT (5),
+                    IDENT_INT (2) .. IDENT_INT (2));
+ 
+      BEGIN
+           A := ACC2S'(NEW ARR'(B'RANGE => (B'RANGE (2) => 0)));
+           IF A'FIRST = 1 THEN
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC2 - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC2 - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC2" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE REC (D : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACC3 IS ACCESS REC;
+           SUBTYPE ACC3S IS ACC3 (IDENT_INT (3));
+           A : ACC3;
+           B : REC (IDENT_INT (5)) := (D => (IDENT_INT (5)));
+ 
+      BEGIN
+           A := ACC3S'(NEW REC'(B));
+           IF A = NULL THEN
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC3 - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC3 - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC3" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE REC (D1,D2 : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACC4 IS ACCESS REC;
+           SUBTYPE ACC4S IS ACC4 (IDENT_INT (4), IDENT_INT (5));
+           A : ACC4;
+           B : REC (IDENT_INT (5), IDENT_INT (4)) :=
+               (D1 => (IDENT_INT (5)), D2 => (IDENT_INT (4)));
+ 
+      BEGIN
+           A := ACC4S'(NEW REC'(B));
+           IF A = NULL THEN
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC4 - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC4 - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC4" );
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                TYPE REC (D : INTEGER) IS PRIVATE;
+ 
+                B : CONSTANT REC;
+           PRIVATE
+                TYPE REC (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                B : CONSTANT REC := (D => (IDENT_INT (4)));
+           END PKG;
+ 
+           USE PKG;
+ 
+           TYPE ACC5 IS ACCESS REC;
+           SUBTYPE ACC5S IS ACC5 (IDENT_INT (3));
+           A : ACC5;
+ 
+      BEGIN
+           A := ACC5S'(NEW REC'(B));
+           IF A = NULL THEN
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC5 - 1" );
+           ELSE
+                FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC5 - 2" );
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
+                         "DIFFERENT FROM THOSE OF TYPE ACC5" );
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE PKG1 IS
+                TYPE REC (D : INTEGER) IS LIMITED PRIVATE;
+                TYPE ACC6 IS ACCESS REC;
+                SUBTYPE ACC6S IS ACC6 (IDENT_INT (6));
+ 
+                FUNCTION F RETURN ACC6;
+           PRIVATE
+                TYPE REC (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PKG1;
+ 
+           PACKAGE BODY PKG1 IS
+ 
+                FUNCTION F RETURN ACC6 IS
+                BEGIN
+                     RETURN NEW REC'(D => IDENT_INT (5));
+                END F;
+ 
+           END PKG1;
+ 
+           PACKAGE PKG2 IS END PKG2;
+ 
+           PACKAGE BODY PKG2 IS
+                USE PKG1;
+ 
+                A : ACC6;
+ 
+           BEGIN
+                A := ACC6S'(F);
+                IF A = NULL THEN
+                     FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                              "DIFFERENT FROM THOSE OF TYPE ACC6 - 1" );
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                              "DIFFERENT FROM THOSE OF TYPE ACC6 - 2" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED FOR DISC " &
+                              "VALUES DIFFERENT FROM THOSE OF TYPE " &
+                              "ACC6" );
+           END PKG2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C47009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47009b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c47009b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c47009b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,282 ----
+ -- C47009B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN ACCESS
+ --     TYPE, CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE VALUE
+ --     OF THE OPERAND IS NULL.
+ 
+ -- HISTORY:
+ --     RJW 07/23/86  CREATED ORIGINAL TEST.
+ --     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
+ --                   CONSTRAINTS OF B SUBTYPES TO VALUES WHICH ARE
+ --                   CLOSER TO THE VALUES OF THE A SUBTYPES.  INDENTED
+ --                   THE EXCEPTION STATEMENTS IN SUBTEST 11.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C47009B IS
+ 
+ BEGIN
+ 
+      TEST( "C47009B", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                       "EXPRESSION DENOTES AN ACCESS TYPE, " &
+                       "CHECK THAT CONSTRAINT_ERROR IS NOT " &
+                       "RAISED WHEN THE VALUE OF THE OPERAND IS NULL" );
+ 
+      DECLARE
+ 
+           TYPE ACC1 IS ACCESS BOOLEAN;
+           A : ACC1;
+ 
+      BEGIN
+           A := ACC1'(NULL);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC1" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC1" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE ACC2 IS ACCESS INTEGER;
+           A : ACC2;
+ 
+      BEGIN
+           A := ACC2'(NULL);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC2" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC2" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE CHAR IS ('A', 'B');
+           TYPE ACC3 IS ACCESS CHAR;
+           A : ACC3;
+ 
+      BEGIN
+           A := ACC3'(NULL);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC3" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC3" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE FLOAT1 IS DIGITS 5 RANGE -1.0 .. 1.0;
+           TYPE ACC4 IS ACCESS FLOAT1;
+           A : ACC4;
+ 
+      BEGIN
+           A := ACC4'(NULL);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC4" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC4" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE FIXED IS DELTA 0.5 RANGE -1.0 .. 1.0;
+           TYPE ACC5 IS ACCESS FIXED;
+           A : ACC5;
+ 
+      BEGIN
+           A := ACC5'(NULL);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC5" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC5" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+           TYPE ACC6 IS ACCESS ARR;
+           SUBTYPE ACC6A IS ACC6 (IDENT_INT (1) .. IDENT_INT (5));
+           SUBTYPE ACC6B IS ACC6 (IDENT_INT (2) .. IDENT_INT (10));
+           A : ACC6A;
+           B : ACC6B;
+ 
+      BEGIN
+           A := ACC6A'(B);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC6" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC6" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
+                OF INTEGER;
+           TYPE ACC7 IS ACCESS ARR;
+           SUBTYPE ACC7A IS ACC7 (IDENT_INT (1) .. IDENT_INT (5),
+                                  IDENT_INT (1) .. IDENT_INT (1));
+           SUBTYPE ACC7B IS ACC7 (IDENT_INT (1) .. IDENT_INT (15),
+                                  IDENT_INT (1) .. IDENT_INT (10));
+           A : ACC7A;
+           B : ACC7B;
+ 
+      BEGIN
+           A := ACC7A'(B);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC7" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC7" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE REC (D : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACC8 IS ACCESS REC;
+           SUBTYPE ACC8A IS ACC8 (IDENT_INT (5));
+           SUBTYPE ACC8B IS ACC8 (IDENT_INT (6));
+           A : ACC8A;
+           B : ACC8B;
+ 
+      BEGIN
+           A := ACC8A'(B);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC8" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC8" );
+      END;
+ 
+      DECLARE
+ 
+           TYPE REC (D1,D2 : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACC9 IS ACCESS REC;
+           SUBTYPE ACC9A IS ACC9 (IDENT_INT (4), IDENT_INT (5));
+           SUBTYPE ACC9B IS ACC9 (IDENT_INT (5), IDENT_INT (4));
+           A : ACC9A;
+           B : ACC9B;
+ 
+      BEGIN
+           A := ACC9A'(B);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC9" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC9" );
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                TYPE REC (D : INTEGER) IS PRIVATE;
+ 
+           PRIVATE
+                TYPE REC (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+           END PKG;
+ 
+           USE PKG;
+ 
+           TYPE ACC10 IS ACCESS REC;
+           SUBTYPE ACC10A IS ACC10 (IDENT_INT (10));
+           SUBTYPE ACC10B IS ACC10 (IDENT_INT (9));
+           A : ACC10A;
+           B : ACC10B;
+ 
+      BEGIN
+           A := ACC10A'(B);
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC10" );
+           WHEN OTHERS =>
+                FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                         "TYPE ACC10" );
+      END;
+ 
+      DECLARE
+ 
+           PACKAGE PKG1 IS
+                TYPE REC (D : INTEGER) IS LIMITED PRIVATE;
+ 
+           PRIVATE
+                TYPE REC (D : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PKG1;
+ 
+           PACKAGE PKG2 IS END PKG2;
+ 
+           PACKAGE BODY PKG2 IS
+                USE PKG1;
+ 
+                TYPE ACC11 IS ACCESS REC;
+                SUBTYPE ACC11A IS ACC11 (IDENT_INT (11));
+                SUBTYPE ACC11B IS ACC11 (IDENT_INT (12));
+                A : ACC11A;
+                B : ACC11B;
+ 
+           BEGIN
+                A := ACC11A'(B);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF" &
+                              " TYPE ACC11" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                              "TYPE ACC11" );
+           END PKG2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C47009B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- C48004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A SCALAR SUBTYPE.
+ 
+ -- RM  01/12/80
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  C48004A  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48004A","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF " &
+                     "T IS A SCALAR SUBTYPE");
+ 
+      DECLARE
+ 
+           SUBTYPE TA IS INTEGER RANGE 1 .. 7;
+           TYPE ATA IS ACCESS TA;
+           VA : ATA;
+ 
+      BEGIN
+ 
+           VA := NEW TA;
+           VA.ALL := IDENT_INT(6);
+           IF VA.ALL /= 6 THEN
+                FAILED ("INCORRECT VALUE");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,140 ----
+ -- C48004B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A CONSTRAINED
+ -- RECORD, PRIVATE, OR LIMITED PRIVATE TYPE.
+ 
+ -- RM  01/12/80
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48004B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48004B","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF " &
+                     "T IS A CONSTRAINED RECORD, PRIVATE, OR "      &
+                     "LIMITED PRIVATE TYPE");
+ 
+      DECLARE
+ 
+           TYPE  TB0(A , B : INTEGER )  IS
+                RECORD
+                     C : INTEGER := 7;
+                END RECORD;
+           SUBTYPE  TB  IS  TB0( 2 , 3 );
+           TYPE ATB IS ACCESS TB0;
+           VB : ATB;
+ 
+           TYPE  TBB0(  A , B : INTEGER := 5 )  IS
+                RECORD
+                     C : INTEGER := 6;
+                END RECORD;
+           SUBTYPE  TBB  IS  TBB0( 4 , 5 );
+           TYPE ATBB IS ACCESS TBB0;
+           VBB : ATBB;
+ 
+           PACKAGE  P  IS
+                TYPE   PRIV0( A , B : INTEGER )  IS PRIVATE;
+                TYPE  LPRIV0( A , B : INTEGER := 1 )  IS LIMITED PRIVATE;
+                FUNCTION FUN(LP : LPRIV0) RETURN INTEGER;
+           PRIVATE
+                TYPE  PRIV0( A , B : INTEGER )  IS
+                     RECORD
+                          Q : INTEGER;
+                     END RECORD;
+                TYPE  LPRIV0( A , B : INTEGER := 1 )  IS
+                     RECORD
+                          Q : INTEGER := 7;
+                     END RECORD;
+           END P;
+      
+           USE P;
+ 
+           SUBTYPE  PRIV  IS  P.PRIV0( 12 , 13 );
+           TYPE  A_PRIV  IS  ACCESS P.PRIV0;
+           VP : A_PRIV;
+ 
+           TYPE  A_LPRIV  IS  ACCESS LPRIV0;
+           VLP : A_LPRIV;
+ 
+           TYPE LCR(A, B : INTEGER := 4) IS
+                RECORD
+                     C : P.LPRIV0;
+                END RECORD;
+           SUBTYPE SLCR IS LCR(1, 2);
+           TYPE A_SLCR IS ACCESS SLCR;
+           VSLCR : A_SLCR;
+ 
+           PACKAGE BODY P IS
+                FUNCTION FUN(LP : LPRIV0) RETURN INTEGER IS
+                BEGIN
+                     RETURN LP.Q;
+                END FUN;
+           END P;
+ 
+      BEGIN
+ 
+           VB  :=  NEW TB;
+           IF ( VB.A /= IDENT_INT(2)  OR
+                VB.B /= 3  OR
+                VB.C /= 7 )  THEN FAILED( "WRONG VALUES  -  B1" );
+           END IF;
+ 
+           VBB  :=  NEW TBB0;
+           IF ( VBB.A /= IDENT_INT(5)  OR
+                VBB.B /= 5  OR
+                VBB.C /= 6 )  THEN
+                FAILED( "WRONG VALUES  -  B2" );
+           END IF;
+           
+           VP  :=  NEW PRIV;
+           IF ( VP.A /= IDENT_INT(12)  OR
+                VP.B /= 13 )  THEN 
+                FAILED( "WRONG VALUES  -  B3" );
+           END IF;
+           
+           VLP  :=  NEW LPRIV0;
+           IF ( VLP.A /= IDENT_INT(1)  OR
+                VLP.B /= 1 OR
+                P.FUN(VLP.ALL) /= IDENT_INT(7) )  THEN 
+                FAILED( "WRONG VALUES  -  B4" );
+           END IF;
+ 
+           VSLCR := NEW SLCR;
+           IF ( VSLCR.A /= IDENT_INT(1) OR
+                VSLCR.B /= IDENT_INT(2) OR
+                P.FUN(VSLCR.C) /= IDENT_INT(7) ) THEN
+                FAILED ("WRONG VALUES - B5");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48004B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C48004C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS AN UNCONSTRAINED
+ -- RECORD, PRIVATE, OR LIMITED TYPE WHOSE DISCRIMINANTS HAVE DEFAULT
+ -- VALUES.
+ 
+ -- EG  08/03/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48004C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48004C","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF "   &
+                     "T IS AN UNCONSTRAINED RECORD, PRIVATE, OR "     &
+                     "LIMITED TYPE WHOSE DISCRIMINANTS HAVE DEFAULT " &
+                     "VALUES");
+ 
+      DECLARE
+ 
+           TYPE  UR(A : INTEGER := 1; B : INTEGER := 2)  IS
+                RECORD
+                     C : INTEGER := 7;
+                END RECORD;
+ 
+           PACKAGE  P  IS
+ 
+                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS PRIVATE;
+                TYPE UL(A, B : INTEGER := 1) IS LIMITED PRIVATE;
+ 
+           PRIVATE
+ 
+                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
+                     RECORD
+                          Q : INTEGER;
+                     END RECORD;
+                TYPE UL(A, B : INTEGER := 1) IS
+                     RECORD
+                          Q : INTEGER;
+                     END RECORD;
+ 
+           END P;
+      
+           USE P;
+ 
+           TYPE A_UR IS ACCESS UR;
+           TYPE A_UP IS ACCESS UP;
+           TYPE A_UL IS ACCESS UL;
+ 
+           V_UR : A_UR;
+           V_UP : A_UP;
+           V_UL : A_UL;
+ 
+      BEGIN
+ 
+           V_UR := NEW UR;
+           IF ( V_UR.A /= IDENT_INT(1) OR V_UR.B /= 2 OR
+                V_UR.C /= 7 ) THEN 
+                FAILED("WRONG VALUES - UR");
+           END IF;
+ 
+           V_UP := NEW UP;
+           IF ( V_UP.A /= IDENT_INT(12) OR V_UP.B /= 13 ) THEN
+                FAILED("WRONG VALUES - UP");
+           END IF;
+           
+           V_UL := NEW UL;
+           IF ( V_UL.A /= IDENT_INT(1) OR V_UL.B /= 1 ) THEN
+                FAILED("WRONG VALUES - UL");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48004C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C48004D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A RECORD, PRIVATE,
+ -- OR LIMITED TYPE WITHOUT DISCRIMINANTS.
+ 
+ -- RM  01/12/80
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48004D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48004D","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
+                     "IS A RECORD, PRIVATE, OR LIMITED TYPE WITHOUT " &
+                     "DISCRIMINANTS");
+ 
+      DECLARE
+ 
+           TYPE  TC  IS
+                RECORD
+                     C : INTEGER := 18;
+                END RECORD;
+           TYPE ATC IS ACCESS TC;
+           VC : ATC;
+ 
+           PACKAGE  P  IS
+                TYPE   PRIV  IS PRIVATE;
+                TYPE  LPRIV  IS LIMITED PRIVATE;
+                TYPE A_PRIV  IS  ACCESS PRIV;
+                TYPE A_LPRIV  IS  ACCESS LPRIV;
+                PROCEDURE   CHECK( X: A_PRIV  );
+                PROCEDURE  LCHECK( X: A_LPRIV );
+                PROCEDURE LRCHECK( X: LPRIV );
+           PRIVATE
+                TYPE   PRIV  IS
+                     RECORD
+                          Q : INTEGER := 19;
+                     END RECORD;
+                TYPE  LPRIV  IS
+                     RECORD
+                          Q : INTEGER := 20;
+                     END RECORD;
+           END P;
+ 
+      
+           VP  :  P.A_PRIV;
+           VLP : P.A_LPRIV;
+ 
+           TYPE LCR IS
+                RECORD
+                     C : P.LPRIV;
+                END RECORD;
+           TYPE A_LCR IS ACCESS LCR;
+           VLCR : A_LCR;
+ 
+           PACKAGE BODY  P  IS
+ 
+                PROCEDURE  CHECK( X: A_PRIV )  IS
+                BEGIN
+                     IF  X.Q /= 19  THEN  FAILED( "WRONG VALUES - C2" );
+                     END IF;
+                END CHECK;
+      
+                PROCEDURE  LCHECK( X: A_LPRIV )  IS
+                BEGIN
+                     IF  X.Q /= 20  THEN  FAILED( "WRONG VALUES - C3" );
+                     END IF;
+                END LCHECK;
+ 
+                PROCEDURE LRCHECK (X : LPRIV) IS
+                BEGIN
+                     IF X.Q /= 20 THEN
+                          FAILED ("WRONG VALUES - C4");
+                     END IF;
+                END LRCHECK;
+ 
+           END P;
+ 
+      BEGIN
+ 
+           VC  :=  NEW TC;
+           IF  VC.C /= 18  THEN FAILED( "WRONG VALUES  -  C1" );
+           END IF;
+           
+           VP  :=  NEW P.PRIV;
+           P.CHECK( VP );
+           VLP :=  NEW P.LPRIV;
+           P.LCHECK( VLP );
+ 
+           VLCR := NEW LCR;
+           P.LRCHECK( VLCR.ALL.C );
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48004D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- C48004E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS A CONSTRAINED ARRAY
+ -- TYPE.
+ 
+ -- RM  01/12/80
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  C48004E  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48004E","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
+                     "IS A CONSTRAINED ARRAY TYPE");
+ 
+      DECLARE
+ 
+           TYPE ARR0 IS ARRAY( INTEGER RANGE <> ) OF BOOLEAN;
+           SUBTYPE ARR IS ARR0(1 .. 10);
+           TYPE  A_ARR  IS  ACCESS ARR;
+           VARR : A_ARR;
+ 
+           PACKAGE P IS
+                TYPE LPRIV IS LIMITED PRIVATE;
+                FUNCTION CHECK (X : LPRIV) RETURN INTEGER;
+           PRIVATE
+                TYPE LPRIV IS
+                     RECORD
+                          Q : INTEGER := 20;
+                     END RECORD;
+           END P;
+ 
+           TYPE LPARR IS ARRAY(1 .. 2) OF P.LPRIV;
+           TYPE A_LPARR IS ACCESS LPARR;
+ 
+           V_A_LPARR : A_LPARR;
+ 
+           PACKAGE BODY P IS
+                FUNCTION CHECK (X : LPRIV) RETURN INTEGER IS
+                BEGIN
+                     RETURN X.Q;
+                END CHECK;
+           END P;
+           
+      BEGIN
+ 
+           VARR := NEW ARR;
+           IF  ( VARR'FIRST /= IDENT_INT(1)  OR
+                 VARR'LAST /= 10 )  THEN FAILED("WRONG BOUNDS - CASE 1");
+           END IF;
+ 
+           V_A_LPARR := NEW LPARR;
+           IF ( P.CHECK(V_A_LPARR.ALL(1)) /= IDENT_INT(20) OR
+                P.CHECK(V_A_LPARR.ALL(2)) /= IDENT_INT(20) ) THEN
+                FAILED ("WRONG VALUES - CASE 2");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48004E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48004f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48004f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C48004F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE FORM "NEW T" IS PERMITTED IF T IS AN ACCESS TYPE.
+ 
+ -- RM  01/12/80
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48004F  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48004F","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
+                     "IS AN ACCESS TYPE");
+ 
+      DECLARE
+ 
+           TYPE AINT IS ACCESS INTEGER;
+           TYPE A_AINT IS ACCESS AINT;
+           VA_AINT : A_AINT;
+ 
+           TYPE AST IS ACCESS STRING;
+           SUBTYPE CAST_4 IS AST(1 .. 4);
+           TYPE A_AST IS ACCESS AST;
+           TYPE ACAST_3 IS ACCESS AST(1 .. 3);
+           V_AAST : A_AST;
+           V_ACAST_3 : ACAST_3;
+ 
+           TYPE UR(A, B : INTEGER) IS
+                RECORD
+                     C : INTEGER;
+                END RECORD;
+           SUBTYPE CR IS UR(1, 2);
+           TYPE A_CR IS ACCESS CR;
+           TYPE AA_CR IS ACCESS A_CR;
+           V_AA_CR : AA_CR;
+ 
+      BEGIN
+ 
+           VA_AINT := NEW AINT;
+           IF VA_AINT.ALL /= NULL THEN
+                FAILED ("VARIABLE IS NOT NULL - CASE 1");
+           END IF;
+ 
+           BEGIN
+ 
+                V_ACAST_3 := NEW CAST_4;
+                IF V_ACAST_3.ALL /= NULL THEN
+                     FAILED ("VARIABLE IS NOT NULL - CASE 2");
+                END IF;
+ 
+           EXCEPTION
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - CASE 2");
+ 
+           END;
+ 
+           V_AAST := NEW AST;
+           IF V_AAST.ALL /= NULL THEN
+                FAILED ("VARIABLE IS NOT NULL - CASE 3");
+           END IF;
+ 
+           V_AA_CR := NEW A_CR;
+           IF V_AA_CR.ALL /= NULL THEN
+                FAILED ("VARIABLE IS NOT NULL - CASE 4");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48004F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,121 ----
+ -- C48005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T X" ALLOCATES A NEW OBJECT
+ -- EACH TIME IT IS EXECUTED AND THAT IF T IS AN UNCONSTRAINED RECORD,
+ -- PRIVATE, OR LIMITED TYPE, THE ALLOCATED OBJECT HAS THE DISCRIMINANT
+ -- VALUES SPECIFIED BY X.
+ 
+ -- EG  08/08/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48005A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48005A","CHECK THAT THE FORM 'NEW T X' ALLOCATES A " &
+                     "NEW OBJECT AND THAT IF T IS AN UNCONSTRAINED " &
+                     "RECORD, PRIVATE, OR LIMITED TYPE, THE " &
+                     "ALLOCATED OBJECT HAS THE DISCRIMINANT " &
+                     "VALUES SPECIFIED BY X");
+ 
+      DECLARE
+ 
+           TYPE UR1(A : INTEGER) IS
+                RECORD
+                     B : INTEGER := 7;
+                     C : INTEGER := 4;
+                END RECORD;
+           TYPE UR2(A : INTEGER) IS
+                RECORD
+                     CASE A IS
+                          WHEN 1 =>
+                               A1 : INTEGER := 4;
+                          WHEN 2 =>
+                               A2 : INTEGER := 5;
+                          WHEN OTHERS =>
+                               NULL;
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A_UR1 IS ACCESS UR1;
+           TYPE A_UR2 IS ACCESS UR2;
+ 
+           V1AUR1 : A_UR1;
+           V1AUR2, V2AUR2 : A_UR2;
+ 
+           TYPE REC (A : INTEGER) IS
+                RECORD
+                     B : INTEGER;
+                END RECORD;
+ 
+           TYPE A_REC IS ACCESS REC;
+ 
+           V_A_REC : A_REC;
+ 
+           TYPE ARR IS ARRAY(1 .. 1) OF INTEGER;
+ 
+           TYPE RECVAL IS
+                RECORD
+                     A : INTEGER;
+                     B : ARR;
+                END RECORD;
+ 
+           FUNCTION FUN (A : INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT(A);
+           END FUN;
+           FUNCTION FUN (A : INTEGER) RETURN RECVAL IS
+           BEGIN
+                FAILED ("WRONG OVERLOADED FUNCTION CALLED");
+                RETURN (1, (1 => 2));
+           END FUN;
+ 
+      BEGIN
+ 
+           V1AUR1 := NEW UR1(3);
+           IF ( V1AUR1.A /= 3 OR V1AUR1.B /= 7 OR
+                V1AUR1.C /= IDENT_INT(4) ) THEN
+                FAILED("WRONG VALUES - V1UAR1");
+           END IF;
+ 
+           V1AUR2 := NEW UR2(IDENT_INT(2));
+           IF ( V1AUR2.A /= 2 OR V1AUR2.A2 /= IDENT_INT(5) ) THEN
+                FAILED("WRONG VALUES - V1AUR2");
+           END IF;
+ 
+           V2AUR2 := NEW UR2(IDENT_INT(3));
+           IF ( V2AUR2.A /= IDENT_INT(3) ) THEN
+                FAILED("WRONG VALUES - V2AUR2");
+           END IF;
+ 
+           V_A_REC := NEW REC(FUN(2));
+      END;
+ 
+      RESULT;
+ 
+ END C48005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- C48005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T X" ALLOCATES A NEW OBJECT
+ -- EACH TIME IT IS EXECUTED AND THAT IF X IS AN INDEX CONSTRAINT AND T
+ -- AN UNCONSTRAINED ARRAY TYPE, THE ALLOCATED OBJECT HAS THE INDEX
+ -- BOUNDS SPECIFIED BY X.
+ 
+ -- EG  08/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48005B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48005B","CHECK THAT THE FORM 'NEW T X' ALLOCATES A " &
+                     "NEW OBJECT AND THAT IF X IS AN INDEX "      &
+                     "CONSTRAINT AND T AN UNCONSTRAINED ARRAY "   &
+                     "TYPE, THE ALLOCATED OBJECT HAS THE INDEX "  &
+                     "BOUND SPECIFIED BY X");
+ 
+      DECLARE
+ 
+           TYPE UA1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           TYPE UA2 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                               OF INTEGER;
+ 
+           TYPE A_UA1 IS ACCESS UA1;
+           TYPE A_UA2 IS ACCESS UA2;
+ 
+           V_A_UA1 : A_UA1;
+           V_A_UA2 : A_UA2;
+ 
+      BEGIN
+ 
+           V_A_UA1 := NEW UA1(4 .. 7);
+           IF ( V_A_UA1'FIRST /= IDENT_INT(4) OR
+                V_A_UA1'LAST  /= IDENT_INT(7) ) THEN
+                FAILED("WRONG ARRAY BOUNDS - V_A_UA1");
+           END IF;
+ 
+           V_A_UA2 := NEW UA2(2 .. 3, 4 .. 6);
+           IF ( V_A_UA2'FIRST(1) /= IDENT_INT(2) OR
+                V_A_UA2'LAST(1)  /= IDENT_INT(3) OR
+                V_A_UA2'FIRST(2) /= IDENT_INT(4) OR
+                V_A_UA2'LAST(2)  /= IDENT_INT(6) ) THEN
+                FAILED("WRONG ARRAY BOUNDS - V_A_UA2");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- C48006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW 
+ -- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A SCALAR OR ACCESS
+ -- TYPE, THE ALLOCATED OBJECT HAS THE VALUE OF X.
+ 
+ -- RM  01/14/80
+ -- RM  01/O1/82
+ -- SPS 10/27/82
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48006A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48006A","CHECK THAT THE FORM 'NEW T'(X)' " &
+                     "ALLOCATES A NEW OBJECT " &
+                     "AND THAT IF T IS A SCALAR OR ACCESS TYPE, THE "   &
+                     "ALLOCATED OBJECT HAS THE VALUE OF X");
+ 
+      DECLARE
+ 
+           TYPE ATA IS ACCESS INTEGER;
+           TYPE AATA IS ACCESS ATA;
+           VA1, VA2, VA3 : ATA;
+           VAA1, VAA2, VAA3 : AATA;
+ 
+      BEGIN
+ 
+           VA1 := NEW INTEGER'(5 + 7);
+           IF VA1.ALL /= IDENT_INT(12) THEN
+                FAILED("WRONG VALUES - VA1");
+           END IF;
+ 
+           VA2 := NEW INTEGER'(1 + 2);
+           IF (VA1.ALL /= IDENT_INT(12) OR
+               VA2.ALL /= IDENT_INT( 3)) THEN
+                FAILED("WRONG VALUES - VA2");
+           END IF;
+ 
+           VA3 := NEW INTEGER'(IDENT_INT(3) + IDENT_INT(4));
+           IF (VA1.ALL /= IDENT_INT(12) OR
+               VA2.ALL /= IDENT_INT( 3) OR
+               VA3.ALL /= IDENT_INT( 7)) THEN
+                FAILED("WRONG VALUES - VA3");
+           END IF;
+ 
+           VAA1 := NEW ATA'(NEW INTEGER'(3));
+           IF VAA1.ALL.ALL /= IDENT_INT(3) THEN
+                FAILED ("WRONG VALUES - VAA1");
+           END IF;
+ 
+           VAA2 := NEW ATA'(NEW INTEGER'(IDENT_INT(5)));
+           IF (VAA1.ALL.ALL /= 3 OR
+               VAA2.ALL.ALL /= 5 ) THEN
+                FAILED ("WRONG VALUES - VAA2");
+           END IF;
+ 
+           VAA3 := NEW ATA'(NEW INTEGER'(IDENT_INT(6)));
+           IF (VAA1.ALL.ALL /= 3 OR
+               VAA2.ALL.ALL /= 5 OR
+               VAA3.ALL.ALL /= 6 ) THEN
+                FAILED ("WRONG VALUES - VAA3");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48006b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48006b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48006b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,236 ----
+ -- C48006B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW
+ -- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A RECORD, ARRAY, OR
+ -- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED), THE ALLOCATED OBJECT HAS
+ -- THE VALUE OF (X).
+ 
+ -- RM  01/14/80
+ -- RM  01/O1/82
+ -- SPS 10/27/82
+ -- EG  07/05/84
+ -- JBG 11/08/85 AVOID CONFLICT WITH AI-7 OR AI-275
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48006B IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("C48006B","CHECK THAT THE FORM 'NEW T'(X)' " &
+                     "ALLOCATES A NEW OBJECT " &
+                     "AND THAT IF T IS A RECORD, ARRAY, OR PRIVATE "    &
+                     "TYPE, THE ALLOCATED OBJECT HAS THE VALUE (X)");
+ 
+      -- RECORD OR ARRAY TYPE (CONSTRAINED OR UNCONSTRAINED)
+ 
+      DECLARE
+ 
+           TYPE  TB0(  A , B : INTEGER )  IS
+                RECORD
+                     C : INTEGER := 7 ;
+                END RECORD;
+           SUBTYPE  TB  IS  TB0( 2 , 3 );
+           TYPE ATB  IS  ACCESS TB  ;
+           TYPE ATB0 IS  ACCESS TB0 ;
+           VB1  ,  VB2  : ATB  ;
+           VB01 , VB02  : ATB0 ;
+ 
+           TYPE  ARR0  IS  ARRAY( INTEGER RANGE <> ) OF INTEGER ;
+           SUBTYPE  ARR  IS ARR0( 1..4 );
+           TYPE  A_ARR   IS  ACCESS ARR  ;
+           TYPE  A_ARR0  IS  ACCESS ARR0 ;
+           VARR1  , VARR2  : A_ARR  ;
+           VARR01 , VARR02 : A_ARR0 ;
+ 
+      BEGIN
+ 
+           VB1  :=  NEW TB'( 2 , 3 , 5 );
+           IF ( VB1.A /=IDENT_INT( 2)  OR
+                VB1.B /=IDENT_INT( 3)  OR
+                VB1.C /=IDENT_INT( 5) )
+           THEN FAILED( "WRONG VALUES  -  B1 1" );
+           END IF;
+ 
+           VB2  :=  NEW TB'( IDENT_INT(2), IDENT_INT(3), IDENT_INT(6));
+           IF ( VB2.A /= 2  OR
+                VB2.B /= 3  OR
+                VB2.C /= 6  OR
+                VB1.A /= 2  OR
+                VB1.B /= 3  OR
+                VB1.C /= 5 )
+           THEN FAILED( "WRONG VALUES  -  B1 2" );
+           END IF;
+ 
+           VB01  :=  NEW TB0'( 1 , 2 , 3 );
+           IF ( VB01.A /=IDENT_INT( 1)  OR
+                VB01.B /=IDENT_INT( 2)  OR
+                VB01.C /=IDENT_INT( 3) )
+           THEN FAILED( "WRONG VALUES  -  B2 1" );
+           END IF;
+ 
+           VB02  :=  NEW TB0'( IDENT_INT(4) , IDENT_INT(5) ,
+                                                       IDENT_INT(6) );
+           IF ( VB02.A /=IDENT_INT( 4)  OR
+                VB02.B /=IDENT_INT( 5)  OR
+                VB02.C /=IDENT_INT( 6)  OR
+                VB01.A /=IDENT_INT( 1)  OR
+                VB01.B /=IDENT_INT( 2)  OR
+                VB01.C /=IDENT_INT( 3) )
+           THEN FAILED( "WRONG VALUES  -  B2 2" );
+           END IF;
+ 
+           VARR1 := NEW ARR'( 5 , 6 , 7 , 8 );
+           IF  ( VARR1(1) /=IDENT_INT( 5)  OR
+                 VARR1(2) /=IDENT_INT( 6)  OR
+                 VARR1(3) /=IDENT_INT( 7)  OR
+                 VARR1(4) /=IDENT_INT( 8) )
+           THEN FAILED( "WRONG VALUES  -  B3 1" );
+           END IF ;
+ 
+           VARR2 := NEW ARR'( IDENT_INT(1) , IDENT_INT(2) , IDENT_INT(3),
+                                                          IDENT_INT(4) );
+           IF  ( VARR2(1) /= 1  OR
+                 VARR2(2) /= 2  OR
+                 VARR2(3) /= 3  OR
+                 VARR2(4) /= 4  OR
+                 VARR1(1) /= 5  OR
+                 VARR1(2) /= 6  OR
+                 VARR1(3) /= 7  OR
+                 VARR1(4) /= 8 )
+           THEN FAILED( "WRONG VALUES  -  B3 2" );
+           END IF ;
+ 
+           VARR01 := NEW ARR0'( 11 , 12 , 13 );
+           IF  ( VARR01(INTEGER'FIRST) /= IDENT_INT(11)  OR
+                 VARR01(INTEGER'FIRST + 1) /= IDENT_INT(12)  OR
+                 VARR01(INTEGER'FIRST + 2) /= IDENT_INT(13) )
+           THEN FAILED( "WRONG VALUES -  B4 1" );
+           END IF ;
+           IF  ( VARR01.ALL'FIRST /= IDENT_INT( INTEGER'FIRST )  OR
+                 VARR01.ALL'LAST  /= IDENT_INT( INTEGER'FIRST + 2 ) )
+           THEN FAILED( "WRONG VALUES -  B4 2" );
+           END IF ;
+ 
+           VARR02 := NEW ARR0'( 1 => IDENT_INT(14) , 2 => IDENT_INT(15));
+           IF  ( VARR02(1) /= 14  OR
+                 VARR02(2) /= 15  OR
+                 VARR01(INTEGER'FIRST) /= 11  OR
+                 VARR01(INTEGER'FIRST + 1) /= 12  OR
+                 VARR01(INTEGER'FIRST + 2) /= 13 )
+           THEN FAILED( "WRONG VALUES -  B4 3" );
+           END IF ;
+ 
+      END ;
+ 
+      -- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED)
+ 
+      DECLARE
+ 
+           PACKAGE P IS
+                TYPE UP(A, B : INTEGER) IS PRIVATE;
+ --             SUBTYPE CP IS UP(1, 2);
+ --             TYPE A_CP IS ACCESS CP;
+                TYPE A_UP IS ACCESS UP;
+                CONS1_UP : CONSTANT UP;
+                CONS2_UP : CONSTANT UP;
+                CONS3_UP : CONSTANT UP;
+                CONS4_UP : CONSTANT UP;
+ --             PROCEDURE CHECK1 (X : A_CP);
+ --             PROCEDURE CHECK2 (X, Y : A_CP);
+                PROCEDURE CHECK3 (X : A_UP);
+                PROCEDURE CHECK4 (X, Y : A_UP);
+           PRIVATE
+                TYPE UP(A, B : INTEGER) IS
+                     RECORD
+                          C : INTEGER;
+                     END RECORD;
+                CONS1_UP : CONSTANT UP := (1, 2, 3);
+                CONS2_UP : CONSTANT UP := (IDENT_INT(1), IDENT_INT(2),
+                                           IDENT_INT(4));
+                CONS3_UP : CONSTANT UP := (7, 8, 9);
+                CONS4_UP : CONSTANT UP := (IDENT_INT(10), IDENT_INT(11),
+                                           IDENT_INT(12));
+           END P;
+ 
+           USE P;
+ 
+ --        V_A_CP1, V_A_CP2 : A_CP;
+           V_A_UP1, V_A_UP2 : A_UP;
+ 
+           PACKAGE BODY P IS
+ --             PROCEDURE CHECK1 (X : A_CP) IS
+ --             BEGIN
+ --                  IF (X.A /= IDENT_INT(1) OR
+ --                      X.B /= IDENT_INT(2) OR
+ --                      X.C /= IDENT_INT(3)) THEN
+ --                       FAILED ("WRONG VALUES - CP1");
+ --                  END IF;
+ --             END CHECK1;
+ --             PROCEDURE CHECK2 (X, Y : A_CP) IS
+ --             BEGIN
+ --                  IF (X.A /= 1 OR X.B /= 2 OR X.C /= 3 OR
+ --                      Y.A /= 1 OR Y.B /= 2 OR Y.C /= 4) THEN
+ --                       FAILED ("WRONG VALUES - CP2");
+ --                  END IF;
+ --             END CHECK2;
+                PROCEDURE CHECK3 (X : A_UP) IS
+                BEGIN
+                     IF (X.A /= IDENT_INT(7) OR
+                         X.B /= IDENT_INT(8) OR
+                         X.C /= IDENT_INT(9)) THEN
+                          FAILED ("WRONG VALUES - UP1");
+                     END IF;
+                END CHECK3;
+                PROCEDURE CHECK4 (X, Y : A_UP) IS
+                BEGIN
+                     IF (X.A /=  7 OR X.B /=  8 OR X.C /=  9 OR
+                         Y.A /= 10 OR Y.B /= 11 OR Y.C /= 12) THEN
+                          FAILED ("WRONG VALUES - UP2");
+                     END IF;
+                END CHECK4;
+           END P;
+ 
+      BEGIN
+ 
+ --        V_A_CP1 := NEW CP'(CONS1_UP);
+ --        CHECK1(V_A_CP1);
+ 
+ --        V_A_CP2 := NEW CP'(CONS2_UP);
+ --        CHECK2(V_A_CP1, V_A_CP2);
+ 
+           V_A_UP1 := NEW P.UP'(CONS3_UP);
+           CHECK3(V_A_UP1);
+ 
+           V_A_UP2 := NEW P.UP'(CONS4_UP);
+           CHECK4(V_A_UP1, V_A_UP2);
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48006B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- C48007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
+ -- RAISED IF T IS AN UNCONSTRAINED TYPE WITH DEFAULT DISCRIMINANTS
+ -- (RECORD, PRIVATE OR LIMITED) AND ONE DEFAULT DISCRIMINANT VALUE DOES
+ -- NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE ALLOCATOR'S BASE
+ -- TYPE.
+ 
+ -- EG  08/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48007A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48007A","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
+                     "APPROPRIATE - UNCONSTRAINED TYPE WITH "    &
+                     "DEFAULT DISCRIMINANTS");
+ 
+      DECLARE
+ 
+           TYPE UR(A : INTEGER := 1; B : INTEGER := 2) IS
+                RECORD
+                     C : INTEGER := 7;
+                END RECORD;
+ 
+           PACKAGE P IS
+ 
+                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
+                     PRIVATE;
+                TYPE UL(A, B : INTEGER := 4) IS LIMITED PRIVATE;
+ 
+           PRIVATE
+ 
+                TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
+                     RECORD
+                          C : INTEGER := 8;
+                     END RECORD;
+                TYPE UL(A, B : INTEGER := 4) IS
+                     RECORD
+                          C : INTEGER := 9;
+                     END RECORD;
+ 
+           END P;
+ 
+           USE P;
+ 
+           TYPE A_UR IS ACCESS UR(1, 9);
+           TYPE A_UP IS ACCESS UP(9, 13);
+           TYPE A_UL IS ACCESS UL(4, 9);
+ 
+           VUR : A_UR;
+           VUP : A_UP;
+           VUL : A_UL;
+ 
+      BEGIN
+ 
+           BEGIN -- UR
+ 
+                VUR := NEW UR;
+                FAILED("NO EXCEPTION RAISED - UR");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - UR");
+ 
+           END;
+ 
+           BEGIN -- UP
+ 
+                VUP := NEW UP;
+                FAILED("NO EXCEPTION RAISED - UP");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - UP");
+ 
+           END;
+ 
+           BEGIN -- UL
+ 
+                VUL := NEW UL;
+                FAILED("NO EXCEPTION RAISED - UL");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - UL");
+ 
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48007b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48007b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48007b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- C48007B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
+ -- RAISED IF T IS A CONSTRAINED TYPE WITH DISCRIMINANTS (RECORD, PRIVATE
+ -- OR LIMITED) AND AT LEAST ONE DISCRIMINANT VALUE SPECIFIED FOR T DOES
+ -- NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE ALLOCATOR'S BASE
+ -- TYPE.
+ 
+ -- EG  08/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48007B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48007B","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
+                     "APPROPRIATE - CONSTRAINED TYPE WITH "      &
+                     "DISCRIMINANT");
+ 
+      DECLARE
+ 
+           TYPE UR(A, B : INTEGER) IS
+                RECORD
+                     C : INTEGER;
+                END RECORD;
+ 
+           PACKAGE P IS
+ 
+                TYPE UP(A, B : INTEGER) IS PRIVATE;
+                TYPE UL(A, B : INTEGER) IS LIMITED PRIVATE;
+ 
+           PRIVATE
+ 
+                TYPE UP(A, B : INTEGER) IS
+                     RECORD
+                          C : INTEGER;
+                     END RECORD;
+                TYPE UL(A, B : INTEGER) IS
+                     RECORD
+                          C : INTEGER;
+                     END RECORD;
+ 
+           END P;
+ 
+           USE P;
+ 
+           SUBTYPE CR IS UR(1, 2);
+           SUBTYPE CP IS UP(12, 13);
+           SUBTYPE CL IS UL(4, 4);
+ 
+           TYPE A_UR IS ACCESS UR(1, 9);
+           TYPE A_UP IS ACCESS UP(9, 13);
+           TYPE A_UL IS ACCESS UL(4, 9);
+ 
+           VUR : A_UR;
+           VUP : A_UP;
+           VUL : A_UL;
+ 
+      BEGIN
+ 
+           BEGIN -- CR
+ 
+                VUR := NEW CR;
+                FAILED("NO EXCEPTION RAISED - CR");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - CR");
+ 
+           END;
+ 
+           BEGIN -- CP
+ 
+                VUP := NEW CP;
+                FAILED("NO EXCEPTION RAISED - CP");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - CP");
+ 
+           END;
+ 
+           BEGIN -- CL
+ 
+                VUL := NEW CL;
+                FAILED("NO EXCEPTION RAISED - CL");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - CL");
+ 
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48007B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48007c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48007c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48007c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48007c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,162 ----
+ -- C48007C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
+ -- RAISED IF T IS A CONSTRAINED ARRAY TYPE AND AT LEAST ONE INDEX BOUND
+ -- FOR T DOES NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE
+ -- ALLOCATOR'S BASE TYPE.
+ 
+ -- EG  08/10/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48007C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48007C","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
+                     "APPROPRIATE - CONSTRAINED ARRAY TYPE");
+ 
+      DECLARE
+ 
+           TYPE UA1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           TYPE UA2 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) OF
+                          INTEGER;
+           TYPE UA3 IS ARRAY(INTEGER RANGE <>) OF UA1(1 .. 2);
+ 
+           SUBTYPE CA11 IS UA1(1 .. 3);
+           SUBTYPE CA12 IS UA1(3 .. 2);
+           SUBTYPE CA21 IS UA2(1 .. 2, 1 .. 2);
+           SUBTYPE CA22 IS UA2(1 .. 2, 2 .. 0);
+           SUBTYPE CA31 IS UA3(1 .. 2);
+           SUBTYPE CA32 IS UA3(4 .. 1);
+ 
+           TYPE A_UA11 IS ACCESS UA1(2 .. 4);
+           TYPE A_UA12 IS ACCESS UA1(4 .. 3);
+           TYPE A_UA21 IS ACCESS UA2(1 .. 3, 1 .. 2);
+           TYPE A_UA22 IS ACCESS UA2(1 .. 2, 2 .. 1);
+           TYPE A_UA31 IS ACCESS UA3(1 .. 3);
+           TYPE A_UA32 IS ACCESS UA3(3 .. 1);
+ 
+           V11 : A_UA11;
+           V12 : A_UA12;
+           V21 : A_UA21;
+           V22 : A_UA22;
+           V31 : A_UA31;
+           V32 : A_UA32;
+ 
+      BEGIN
+ 
+           BEGIN -- V11
+ 
+                V11 := NEW CA11;
+                FAILED("NO EXCEPTION RAISED - V11");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - V11");
+ 
+           END;
+ 
+           BEGIN -- V12
+ 
+                V12 := NEW CA12;
+                FAILED("NO EXCEPTION RAISED - V12");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - V12");
+ 
+           END;
+ 
+           BEGIN -- V21
+ 
+                V21 := NEW CA21;
+                FAILED("NO EXCEPTION RAISED - V21");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - V21");
+ 
+           END;
+ 
+           BEGIN -- V22
+ 
+                V22 := NEW CA22;
+                FAILED("NO EXCEPTION RAISED - V22");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - V22");
+ 
+           END;
+ 
+           BEGIN -- V31
+ 
+                V31 := NEW CA31;
+                FAILED("NO EXCEPTION RAISED - V31");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - V31");
+ 
+           END;
+ 
+           BEGIN -- V32
+ 
+                V32 := NEW CA32;
+                FAILED("NO EXCEPTION RAISED - V32");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED - V32");
+ 
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48007C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,345 ----
+ -- C48008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T X", CHECK THAT CONSTRAINT_ERROR IS
+ -- RAISED IF T IS AN UNCONSTRAINED RECORD, PRIVATE, OR LIMITED TYPE, X
+ -- IS A DISCRIMINANT CONSTRAINT, AND
+ --   1) ONE OF THE VALUES OF X IS OUTSIDE THE RANGE OF THE CORRESPONDING
+ --      DISCRIMINANT;
+ --   2) ONE OF THE DISCRIMINANT VALUES IS NOT COMPATIBLE WITH A
+ --      CONSTRAINT OF A SUBCOMPONENT IN WHICH IT IS USED;
+ --   3) ONE OF THE DISCRIMINANT VALUES DOES NOT EQUAL THE CORRESPONDING
+ --      VALUE OF THE ALLOCATOR'S BASE TYPE;
+ --   4) A DEFAULT INITIALIZATION RAISES AN EXCEPTION.
+ 
+ -- RM  01/08/80
+ -- NL  10/13/81
+ -- SPS 10/26/82
+ -- JBG 03/02/83
+ -- EG  07/05/84
+ -- PWB 02/05/86  CORRECTED TEST ERROR:
+ --               CHANGED "FAILED" TO "COMMENT" IN PROCEDURE INCR_CHECK,
+ --               SO AS NOT TO PROHIBIT EVAL OF DEFLT EXPR (AI-00397/01)
+ --               ADDED COMMENTS FOR CASES.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  C48008A  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C48008A" , "FOR ALLOCATORS OF THE FORM 'NEW T X', " &
+                        "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                        "APPROPRIATE - UNCONSTRAINED RECORD AND " &
+                        "PRIVATE TYPES");
+ 
+      DECLARE
+ 
+           DISC_FLAG : BOOLEAN := FALSE;
+           INCR_VAL : INTEGER;
+           FUNCTION INCR(A : INTEGER) RETURN INTEGER;
+ 
+           SUBTYPE I1_7 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(7);
+           SUBTYPE I1_10 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(10);
+           SUBTYPE I2_9 IS INTEGER RANGE IDENT_INT(2)..IDENT_INT(9);
+ 
+           TYPE REC (A : I2_9) IS
+                RECORD
+                     B : INTEGER := INCR(2);
+                END RECORD;
+ 
+           TYPE ARR IS ARRAY (I2_9 RANGE <>) OF INTEGER;
+ 
+           TYPE T_REC (C : I1_10) IS
+                RECORD
+                     D : REC(C);
+                END RECORD;
+ 
+           TYPE T_ARR (C : I1_10) IS
+                RECORD
+                     D : ARR(2..C);
+                     E : ARR(C..9);
+                END RECORD;
+ 
+           TYPE T_REC_REC (A : I1_10) IS
+                RECORD
+                     B : T_REC(A);
+                END RECORD;
+ 
+           TYPE T_REC_ARR (A : I1_10) IS
+                RECORD
+                     B : T_ARR(A);
+                END RECORD;
+ 
+           TYPE  TB (  A : I1_7 )  IS
+                RECORD
+                     R : INTEGER := INCR(1);
+                END RECORD;
+ 
+           TYPE UR (A : INTEGER) IS
+                RECORD
+                     B : I2_9 := INCR(1);
+                END RECORD;
+ 
+           TYPE A_T_REC_REC IS ACCESS T_REC_REC;
+           TYPE A_T_REC_ARR IS ACCESS T_REC_ARR;
+           TYPE ATB IS ACCESS TB;
+           TYPE ACTB IS ACCESS TB(3);
+           TYPE A_UR IS ACCESS UR;
+ 
+           VA_T_REC_REC : A_T_REC_REC;
+           VA_T_REC_ARR : A_T_REC_ARR;
+           VB  : ATB;
+           VCB : ACTB;
+           V_A_UR : A_UR;
+ 
+           BOOL : BOOLEAN;
+ 
+           FUNCTION DISC (A : INTEGER) RETURN INTEGER;
+ 
+ 
+           PACKAGE  P  IS
+                TYPE  PRIV( A : I1_10 := DISC(8) )  IS PRIVATE;
+                CONS_PRIV : CONSTANT PRIV;
+           PRIVATE
+                TYPE  PRIV( A : I1_10 := DISC(8) )  IS
+                     RECORD
+                          R : INTEGER := INCR(1);
+                     END RECORD;
+                CONS_PRIV : CONSTANT PRIV := (2, 3);
+           END P;
+ 
+           TYPE  A_PRIV  IS  ACCESS P.PRIV;
+           TYPE  A_CPRIV IS  ACCESS P.PRIV (3);
+ 
+           VP  : A_PRIV;
+           VCP : A_CPRIV;
+ 
+           PROCEDURE PREC_REC (X : A_T_REC_REC) IS
+           BEGIN
+                NULL;
+           END PREC_REC;
+ 
+           PROCEDURE PREC_ARR (X : A_T_REC_ARR) IS
+           BEGIN
+                NULL;
+           END PREC_ARR;
+ 
+           PROCEDURE PB (X : ATB) IS
+           BEGIN
+                NULL;
+           END PB;
+ 
+           PROCEDURE PCB (X : ACTB) IS
+           BEGIN
+                NULL;
+           END PCB;
+ 
+           PROCEDURE PPRIV (X : A_PRIV) IS
+           BEGIN
+                NULL;
+           END PPRIV;
+ 
+           PROCEDURE PCPRIV (X : A_CPRIV) IS
+           BEGIN
+                NULL;
+           END PCPRIV;
+ 
+           FUNCTION DISC (A : INTEGER) RETURN INTEGER IS
+           BEGIN
+                DISC_FLAG := TRUE;
+                RETURN A;
+           END DISC;
+ 
+           FUNCTION INCR(A : INTEGER) RETURN INTEGER IS
+           BEGIN
+                INCR_VAL := IDENT_INT(INCR_VAL+1);
+                RETURN A;
+           END INCR;
+ 
+           PROCEDURE INCR_CHECK(CASE_ID : STRING) IS
+           BEGIN
+                IF INCR_VAL /= IDENT_INT(0) THEN
+                     COMMENT ("DEFAULT INITIAL VALUE WAS EVALUATED - " &
+                              "CASE " & CASE_ID);
+                END IF;
+           END INCR_CHECK;
+ 
+      BEGIN
+ 
+           BEGIN  -- A1A: 0 ILLEGAL FOR TB.A.
+                INCR_VAL := 0;
+                VB  :=  NEW TB (A => 0);
+                FAILED ("NO EXCEPTION RAISED - CASE A1A");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>
+                     INCR_CHECK("A1A");
+                WHEN  OTHERS            =>
+                     FAILED( "WRONG EXCEPTION RAISED - CASE A1A" );
+           END;   -- A1A
+ 
+           BEGIN  -- A1B: 8 ILLEGAL IN I1_7.
+                INCR_VAL := 0;
+                VB  :=  NEW TB (A => I1_7'(IDENT_INT(8)));
+                FAILED ("NO EXCEPTION RAISED - CASE A1B");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>
+                     INCR_CHECK("A1B");
+                WHEN  OTHERS            =>
+                     FAILED( "WRONG EXCEPTION RAISED - CASE A1B");
+           END;   -- A1B
+ 
+           BEGIN  -- A1C: 8 ILLEGAL FOR TB.A.
+                INCR_VAL := 0;
+                PB(NEW TB (A => 8));
+                FAILED ("NO EXCEPTION RAISED - CASE A1C");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>
+                     INCR_CHECK("A1C");
+                WHEN  OTHERS            =>
+                     FAILED( "WRONG EXCEPTION RAISED - CASE A1C");
+           END;   --A1C
+ 
+           BEGIN  --A1D: 0 ILLEGAL FOR TB.A.
+                INCR_VAL := 0;
+                BOOL := ATB'(NEW TB(A => 0)) = NULL;
+                FAILED ("NO EXCEPTION RAISED - CASE A1D");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>
+                     INCR_CHECK("A1D");
+                WHEN  OTHERS            =>
+                     FAILED( "WRONG EXCEPTION RAISED - CASE A1D");
+           END;   --A1D
+ 
+           BEGIN  --A1E: 11 ILLEGAL FOR PRIV.A.
+                DISC_FLAG := FALSE;
+                INCR_VAL := 0;
+                VP := NEW P.PRIV(11);
+                FAILED("NO EXCEPTION RAISED - CASE A1E");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF DISC_FLAG THEN
+                          FAILED ("DISCR DEFAULT EVALUATED WHEN " &
+                                  "EXPLICIT VALUE WAS PROVIDED - A1E");
+                     END IF;
+                     INCR_CHECK("A1E");
+                WHEN OTHERS           =>
+                     FAILED("WRONG EXCEPTION RAISED - CASE A1E");
+           END;   -- A1E
+ 
+           BEGIN  -- A2A: 1 ILLEGAL FOR REC.A.
+                INCR_VAL := 0;
+                VA_T_REC_REC := NEW T_REC_REC(A => I1_10'(IDENT_INT(1)));
+                FAILED ("NO EXCEPTION RAISED - CASE A2A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     INCR_CHECK("A2A");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A2A");
+           END;   -- A2A
+ 
+           BEGIN  --A2B: 10 ILLEGAL FOR REC.A.
+                INCR_VAL := 0;
+                VA_T_REC_REC := NEW T_REC_REC (10);
+                FAILED ("NO EXCEPTION RAISED - CASE A2B");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     INCR_CHECK("A2B");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A2B");
+           END;   -- A2B
+ 
+           BEGIN  -- A2C: 1 ILLEGAL FOR T.ARR.E'FIRST.
+                INCR_VAL := 0;
+                PREC_ARR (NEW T_REC_ARR (1));
+                FAILED ("NO EXCEPTION RAISED - CASE A2C");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     INCR_CHECK ("A2C");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A2C");
+           END;   -- A2C
+ 
+           BEGIN  -- A2D: 10 ILLEGAL FOR T_ARR.D'LAST.
+                INCR_VAL := 0;
+                BOOL := NEW T_REC_ARR (IDENT_INT(10)) = NULL;
+                FAILED ("NO EXCEPTION RAISED - CASE A2D");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     INCR_CHECK ("A2D");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A2D");
+           END;   -- A2D
+ 
+           BEGIN -- A3A: ASSIGNMENT VIOLATES CONSTRAINT ON VCB'S SUBTYPE.
+                INCR_VAL := 0;
+                VCB := NEW TB (4);
+                FAILED ("NO EXCEPTION RAISED - CASE A3A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     INCR_CHECK("A3A");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A3A");
+           END;   -- A3A
+ 
+           BEGIN  -- A3B: PARM ASSOC VIOLATES CONSTRAINT ON PARM SUBTYPE.
+                INCR_VAL := 0;
+                PCB (NEW TB (4));
+                FAILED ("NO EXCEPTION RAISED - CASE A3B");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     INCR_CHECK("A3B");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A3B");
+           END;   -- A3B
+ 
+           BEGIN  -- A3C: 2 VIOLATES CONSTRAINT ON SUBTYPE ACTB.
+                INCR_VAL := 0;
+                BOOL := ACTB'(NEW TB (IDENT_INT(2))) = NULL;
+                FAILED ("NO EXCEPTION RAISED - CASE A3C");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     INCR_CHECK("A3C");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A3C");
+           END;   -- A3C
+ 
+           BEGIN  -- A4A: EVALUATION OF DEFAULT RAISES EXCEPTION.
+                INCR_VAL := 0;
+                V_A_UR := NEW UR(4);
+                FAILED ("NO EXCEPTION RAISED - CASE A4A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE A4A");
+           END;   -- A4A
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48008c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48008c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48008c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48008c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C48008C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T X", CHECK THAT CONSTRAINT_ERROR IS
+ -- RAISED IF T IS AN UNCONSTRAINED ARRAY TYPE WITH INDEX SUBTYPE(S) S, X
+ -- IS AN INDEX CONSTRAINT, AND THE BOUNDS OF X ARE NOT COMPATIBLE WITH
+ -- AN INDEX SUBTYPE OF T.
+ 
+ -- RM 01/08/80
+ -- NL 10/13/81
+ -- EG 07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48008C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48008C","FOR ALLOCATORS OF THE FORM 'NEW T X', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                     "APPROPRIATE - UNCONSTRAINED ARRAY TYPE");
+ 
+      DECLARE
+ 
+           SUBTYPE  TWO  IS  INTEGER RANGE 1..2;
+           TYPE  TF IS ARRAY( TWO RANGE <> ,  TWO RANGE <> ) OF INTEGER;
+           TYPE  ATF  IS  ACCESS TF;
+           VF  : ATF;
+ 
+      BEGIN
+ 
+           BEGIN
+                VF  :=  NEW TF ( 0..1 , 1..2 );
+                FAILED ("NO EXCEPTION RAISED - CASE 1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>  
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 1");
+           END;
+ 
+           BEGIN
+                VF := NEW TF(1 .. 2, 2 .. IDENT_INT(3));
+                FAILED ("NO EXCEPTION RAISED - CASE 2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 2");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48008C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C48009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS A SCALAR SUBTYPE AND X IS OUTSIDE THE RANGE OF T,
+ -- OR IS WITHIN T'S RANGE AND OUTSIDE OF THE RANGE OF VALUES PERMITTED
+ -- FOR OBJECTS DESIGNATED BY VALUES OF THE ALLOCATOR'S BASE TYPE.
+ 
+ -- RM  01/08/80
+ -- NL  10/13/81
+ -- SPS 10/26/82
+ -- JBG 03/02/83
+ -- EG  07/05/84
+ -- EDS 12/01/97  ADDED IDENT_INT TO MAKE EXPRESSION NON-STATIC.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  C48009A  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C48009A" , "FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK" &
+                        " THAT CONSTRAINT_ERROR IS RAISED WHEN" &
+                        " APPROPRIATE - SCALAR TYPES");
+      DECLARE        -- A1
+ 
+           SUBTYPE  TA  IS  INTEGER RANGE 1..7;
+           TYPE ATA IS ACCESS TA;
+           VA : ATA;
+ 
+      BEGIN
+ 
+           VA  :=  NEW TA'( IDENT_INT(0) );
+           FAILED ("NO EXCEPTION RAISED - 1");
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR  =>  NULL;
+           WHEN  OTHERS      =>  FAILED ( "WRONG EXCEPTION RAISED - 1" );
+ 
+      END;  -- A1
+ 
+      DECLARE        -- A2
+ 
+           SUBTYPE T1_7 IS INTEGER RANGE 1..7;
+           TYPE AT2_6 IS ACCESS INTEGER RANGE 2..6;
+           VAT2_6 : AT2_6;
+ 
+      BEGIN
+ 
+           BEGIN
+ 
+                VAT2_6 := NEW T1_7'(1);
+                FAILED ("NO EXCEPTION RAISED - 2");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => 
+                     FAILED ("WRONG EXCEPTION RAISED - 2");
+ 
+           END;
+ 
+           BEGIN
+ 
+                VAT2_6 := NEW T1_7'(7);
+                FAILED ("NO EXCEPTION RAISED - 3");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 3");
+ 
+           END;
+ 
+      END; -- A2
+ 
+      RESULT;
+ 
+ END C48009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,255 ----
+ -- C48009B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS AN UNCONSTRAINED RECORD OR PRIVATE TYPE, (X) IS AN
+ -- AGGREGATE OR A VALUE OF TYPE T, AND ONE OF THE DISCRIMINANT VALUES IN
+ -- X:
+ --   1) DOES NOT SATISFY THE RANGE CONSTRAINT FOR THE CORRESPONDING
+ --      DISCRIMINANT OF T.
+ --   2) DOES NOT EQUAL THE DISCRIMINANT VALUE SPECIFIED IN THE
+ --      DECLARATION OF THE ALLOCATOR'S BASE TYPE.
+ --   3) A DISCRIMINANT VALUE IS COMPATIBLE WITH A DISCRIMINANT'S SUBTYPE
+ --      BUT DOES NOT PROVIDE A COMPATIBLE INDEX OR DISCRIMINANT
+ --      CONSTRAINT FOR A SUBCOMPONENT DEPENDENT ON THE DISCRIMINANT.
+ 
+ -- RM  01/08/80
+ -- NL  10/13/81
+ -- SPS 10/26/82
+ -- JBG 03/02/83
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  C48009B  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C48009B" , "FOR ALLOCATORS OF THE FORM 'NEW T '(X)', " &
+                        "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                        "APPROPRIATE - UNCONSTRAINED RECORD AND " &
+                        "PRIVATE TYPES");
+ 
+      DECLARE
+ 
+           SUBTYPE I1_7 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(7);
+           SUBTYPE I1_10 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(10);
+           SUBTYPE I2_9 IS INTEGER RANGE IDENT_INT(2)..IDENT_INT(9);
+ 
+           TYPE REC (A : I2_9) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ARR IS ARRAY (I2_9 RANGE <>) OF INTEGER;
+ 
+           TYPE T_REC (C : I1_10) IS
+                RECORD
+                     D : REC(C);
+                END RECORD;
+ 
+           TYPE T_ARR (C : I1_10) IS
+                RECORD
+                     D : ARR(2..C);
+                     E : ARR(C..9);
+                END RECORD;
+ 
+           TYPE T_REC_REC (A : I1_10) IS
+                RECORD
+                     B : T_REC(A);
+                END RECORD;
+ 
+           TYPE T_REC_ARR (A : I1_10) IS
+                RECORD
+                     B : T_ARR(A);
+                END RECORD;
+ 
+           TYPE  TB (  A : I1_7 )  IS
+                RECORD
+                     R : INTEGER;
+                END RECORD;
+ 
+           TYPE A_T_REC_REC IS ACCESS T_REC_REC;
+           TYPE A_T_REC_ARR IS ACCESS T_REC_ARR;
+           TYPE ATB IS ACCESS TB;
+           TYPE ACTB IS ACCESS TB(3);
+ 
+           VA_T_REC_REC : A_T_REC_REC;
+           VA_T_REC_ARR : A_T_REC_ARR;
+           VB  : ATB;
+           VCB : ACTB;
+ 
+           PACKAGE  P  IS
+                TYPE  PRIV( A : I1_10 )  IS PRIVATE;
+                CONS_PRIV : CONSTANT PRIV;
+           PRIVATE
+                TYPE  PRIV( A : I1_10 )  IS
+                     RECORD
+                          R : INTEGER;
+                     END RECORD;
+                CONS_PRIV : CONSTANT PRIV := (2, 3);
+           END P;
+ 
+           USE P;
+ 
+           TYPE  A_PRIV  IS  ACCESS P.PRIV;
+           TYPE  A_CPRIV IS  ACCESS P.PRIV (3);
+      
+           VP  : A_PRIV;
+           VCP : A_CPRIV;
+ 
+           FUNCTION ALLOC1(X : P.PRIV) RETURN A_CPRIV IS
+           BEGIN
+                IF EQUAL(1, 1) THEN
+                     RETURN NEW P.PRIV'(X);
+                ELSE
+                     RETURN NULL;
+                END IF;
+           END ALLOC1;
+           FUNCTION ALLOC2(X : TB) RETURN ACTB IS
+           BEGIN
+                IF EQUAL(1, 1) THEN
+                     RETURN NEW TB'(X);
+                ELSE
+                     RETURN NULL;
+                END IF;
+           END ALLOC2;
+ 
+      BEGIN
+ 
+           BEGIN     -- B1
+                VB  :=  NEW TB'(A => IDENT_INT(0), R => 1);
+                FAILED ("NO EXCEPTION RAISED - CASE 1A");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>  NULL;
+                WHEN  OTHERS            =>
+                     FAILED( "WRONG EXCEPTION RAISED - CASE 1A" );
+           END;
+ 
+           BEGIN     
+                VB  :=  NEW TB'(A => 8, R => 1);
+                FAILED ("NO EXCEPTION RAISED - CASE 1B");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>  NULL;
+                WHEN  OTHERS            =>
+                     FAILED( "WRONG EXCEPTION RAISED - CASE 1B");
+           END; -- B1
+ 
+           BEGIN     -- B2
+                VCB := NEW TB'(2, 3);
+                FAILED ("NO EXCEPTION RAISED - CASE 2A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 2A");
+           END;
+ 
+           BEGIN
+                IF ALLOC2((IDENT_INT(4), 3)) = NULL THEN
+                     FAILED ("IMPOSSIBLE - CASE 2B");
+                END IF;
+                FAILED ("NO EXCEPTION RAISED - CASE 2B");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 2B");
+           END;
+ 
+           BEGIN
+ 
+                IF ALLOC1(CONS_PRIV) = NULL THEN
+                     FAILED ("IMPOSSIBLE - CASE 2C");
+                END IF;
+                FAILED ("NO EXCEPTION RAISED - CASE 2C");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 2C");
+ 
+           END; -- B2
+ 
+           BEGIN     -- B3
+ 
+                VA_T_REC_REC := NEW T_REC_REC'(1, (1, (A => 1)));
+                FAILED ("NO EXCEPTION RAISED - CASE 3A");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
+ 
+           END;
+ 
+           BEGIN
+ 
+                VA_T_REC_REC := NEW T_REC_REC'(10, 
+                                              (10, (A => 10)));
+                FAILED ("NO EXCEPTION RAISED - CASE 3B");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
+ 
+           END;
+ 
+           BEGIN
+ 
+                VA_T_REC_ARR := NEW T_REC_ARR'(1, (1, (OTHERS => 1),
+                                                      (OTHERS => 2)));
+                FAILED ("NO EXCEPTION RAISED - CASE 3C");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3C");
+ 
+           END;
+ 
+           BEGIN
+ 
+                VA_T_REC_ARR := NEW T_REC_ARR'(10, (10, (OTHERS => 1),
+                                                        (OTHERS => 2)));
+                FAILED ("NO EXCEPTION RAISED - CASE 3D");
+ 
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3D");
+ 
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C48009C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS A CONSTRAINED RECORD OR PRIVATE TYPE, (X) IS AN
+ -- AGGREGATE OR A VALUE OF TYPE T, AND ONE OF THE DISCRIMINANT VALUES IN
+ -- X:
+ --   1) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE FOR T.
+ --   2) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE SPECIFIED
+ --      IN THE DECLARATION OF THE ALLOCATOR'S BASE TYPE.
+ --   3) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE IN THE
+ --      ACCESS TO ACCESS CASE.
+ 
+ -- RM  01/08/80
+ -- NL  10/13/81
+ -- SPS 10/26/82
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48009C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48009C","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                     "APPROPRIATE - CONSTRAINED RECORD TYPES");
+ 
+      DECLARE
+ 
+           TYPE TC0(A, B : INTEGER) IS
+                RECORD
+                     C : INTEGER RANGE 1 .. 7;
+                END RECORD;
+           SUBTYPE TC IS TC0(2, 3);
+           TYPE ATC IS ACCESS TC0(2, 3);
+           SUBTYPE TC4_5 IS TC0(IDENT_INT(4), IDENT_INT(5));
+           VC : ATC;
+ 
+      BEGIN
+ 
+           BEGIN
+                VC := NEW TC'(102, 3, 4);
+                FAILED ("NO EXCEPTION RAISED - CASE 1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS           =>  
+                     FAILED("WRONG EXCEPTION RAISED - CASE 1");
+           END;
+ 
+           BEGIN
+                VC := NEW TC4_5'(IDENT_INT(4), IDENT_INT(5), 1);
+                FAILED ("NO EXCEPTION RAISED - CASE 2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS           =>  
+                     FAILED("WRONG EXCEPTION RAISED - CASE 2");
+           END;
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE UR(A : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           TYPE A_UR IS ACCESS UR;
+           SUBTYPE CA_UR IS A_UR(2);
+           TYPE A_CA_UR IS ACCESS CA_UR;
+ 
+           V : A_CA_UR;
+ 
+      BEGIN
+ 
+           V := NEW CA_UR'(NEW UR'(A => IDENT_INT(3)));
+           FAILED ("NO EXCEPTION RAISED - CASE 3");
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - CASE 3");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C48009D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS AN UNCONSTRAINED ARRAY TYPE WITH INDEX SUBTYPE(S)
+ -- S,
+ --   1) X HAS TOO MANY VALUES FOR S;
+ --   2) A NAMED NON-NULL BOUND OF X LIES OUTSIDE S'S RANGE;
+ --   3) THE BOUND'S OF X ARE NOT EQUAL TO BOUNDS SPECIFIED FOR THE
+ --      ALLOCATOR'S DESIGNATED BASE TYPE. (THEY ARE EQUAL TO THE BOUNDS
+ --      SPECIFIED FOR T).
+ 
+ -- RM  01/08/80
+ -- NL  10/13/81
+ -- SPS 10/26/82
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+ -- KAS 11/14/95 FOR SLIDING ASSIGNMENT, CHANGED FAIL TO COMMENT ON LANGUAGE
+ -- KAS 12/02/95 INCLUDED SECOND CASE
+ -- PWN 05/03/96 Enforced Ada 95 sliding rules
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  C48009D  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("C48009D","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                     "APPROPRIATE - UNCONSTRAINED ARRAY TYPES");
+      DECLARE
+ 
+           SUBTYPE TWO  IS INTEGER RANGE 1 .. 2;
+           SUBTYPE TWON IS INTEGER RANGE IDENT_INT(1) .. IDENT_INT(2);
+           TYPE UA  IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           TYPE TD  IS ARRAY(TWO  RANGE <>) OF INTEGER RANGE 1 .. 7;
+           TYPE TDN IS ARRAY(TWON RANGE <>) OF INTEGER RANGE 1 .. 7;
+           TYPE ATD  IS ACCESS TD;
+           TYPE ATDN IS ACCESS TDN;
+           TYPE A_UA IS ACCESS UA;
+           TYPE A_CA IS ACCESS UA(3 .. 4);
+           TYPE A_CAN IS ACCESS UA(4 .. 3);
+           VD  : ATD;
+           VDN : ATDN;
+           V_A_CA : A_CA;
+           V_A_CAN : A_CAN;
+ 
+      BEGIN
+ 
+           BEGIN
+                VD := NEW TD'(3, 4, 5);
+                FAILED ("NO EXCEPTION RAISED - CASE 1A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>  
+                     NULL;
+                WHEN OTHERS =>  
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 1A");
+           END;
+ 
+           BEGIN
+                VDN := NEW TDN'(3, 4, 5);
+                FAILED ("NO EXCEPTION RAISED - CASE 1B");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 1B");
+           END;
+ 
+           BEGIN
+                VD := NEW TD'(IDENT_INT(0) .. 2 => 6);
+                FAILED ("NO EXCEPTION RAISED - CASE 2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     NULL;
+                WHEN OTHERS =>  
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 2");
+           END;
+ 
+           BEGIN
+                V_A_CA := NEW UA'(2 .. 3 => 3);
+                COMMENT ("ADA 95 SLIDING ASSIGNMENT - CASE 3A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("ADA 83 NON SLIDING ASSIGNMENT - CASE 3A");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
+           END;
+ 
+           BEGIN
+                V_A_CAN := NEW UA'(IDENT_INT(3) .. IDENT_INT(2) => 3);
+                COMMENT ("ADA 95 SLIDING ASSIGNMENT - CASE 3B");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("ADA 83 NON SLIDING ASSIGNMENT - CASE 3B");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,224 ----
+ -- C48009E.ADA
+  
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS A CONSTRAINED ARRAY TYPE AND:
+ --   1) A NAMED NULL OR NON-NULL BOUND FOR X DOES NOT EQUAL THE
+ --      CORRESPONDING BOUND FOR T;
+ --   2) A BOUND OF T DOES NOT EQUAL THE CORRESPONDING VALUE SPECIFIED IN
+ --      THE DECLARATION OF THE ALLOCATOR'S BASE TYPE; 
+ --   3) A POSITIONAL AGGREGATE DOES NOT HAVE THE NUMBER OF COMPONENTS
+ --      REQUIRED BY T OR BY THE ALLOCATOR'S BASE TYPE. 
+  
+  -- RM  01/08/80
+  -- NL  10/13/81
+  -- SPS 10/26/82
+  -- JBG 03/03/83
+  -- EG  07/05/84
+  -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+  -- KAS 11/14/95 CHANGED FAILURE AT SLIDING ASSIGNMENT TO COMMENT ON LANGUAGE
+  -- KAS 11/30/95 REINSTRUMENTED CASES TO SELECT LANGUAGE SEMANTICS
+  -- PWN 05/03/96 Enforced Ada 95 sliding rules
+  -- PWN 10/24/96 Adjusted expected results for Ada 95.
+  -- TMB 11/19/96 BACKED OUT CHANGE FOR SLIDING WITH ACCESS TYPES
+  -- MRM 12/16/96 Removed problem code from withdrawn version of test, and
+  --              implemented a dereference-index check to ensure Ada95
+  --              required behavior.
+  -- PWB.CTA 03/07/97 Restored checks from 1.11 in 2 cases where sliding does
+  --                  not occur 
+  WITH REPORT;
+  
+  PROCEDURE  C48009E  IS
+  
+       USE REPORT ;
+  
+  BEGIN
+  
+       TEST("C48009E","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                      "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                      "APPROPRIATE - CONSTRAINED ARRAY TYPES");
+       DECLARE
+  
+            TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+            TYPE CA3_2 IS ARRAY(3 .. 2) OF INTEGER;
+            TYPE SA1_3 IS ARRAY(1 .. 3) OF INTEGER;
+            TYPE NA1_3 IS ARRAY(1 .. IDENT_INT(3)) OF INTEGER;
+            SUBTYPE CA2_6 IS UA(2 .. 6);
+            SUBTYPE CA1_4 IS UA(1 .. 4);
+            SUBTYPE CA1_6 IS UA(1 .. 6);
+            SUBTYPE CA4_1 IS UA(4 .. 1);
+            SUBTYPE CA4_2 IS UA(4 .. 2);
+  
+            TYPE A_CA3_2 IS ACCESS CA3_2;
+            TYPE A_SA1_3 IS ACCESS SA1_3;
+            TYPE A_NA1_3 IS ACCESS NA1_3;
+            TYPE A_CA1_5 IS ACCESS UA(1 .. 5);
+            TYPE A_CA4_2 IS ACCESS CA4_2;
+  
+            V_A_CA3_2 : A_CA3_2;
+            V_A_SA1_3 : A_SA1_3;
+            V_A_NA1_3 : A_NA1_3;
+            V_A_CA1_5 : A_CA1_5;
+  
+            FUNCTION ALLOC1(X : CA2_6) RETURN A_CA1_5 IS
+            BEGIN
+                 IF EQUAL(1, 1) THEN
+                      RETURN NEW CA2_6'(X);
+                 ELSE
+                      RETURN NULL;
+                 END IF;
+            END ALLOC1;
+            FUNCTION ALLOC2(X : CA4_1) RETURN A_CA4_2 IS
+            BEGIN
+                 IF EQUAL(1, 1) THEN
+                      RETURN NEW CA4_1'(X);
+                 ELSE
+                      RETURN NULL;
+                 END IF;
+            END ALLOC2;
+  
+       BEGIN
+  
+           BEGIN
+                V_A_CA3_2 := NEW CA3_2'(IDENT_INT(4) .. IDENT_INT(2)
+                                        => 5);
+                FAILED ("NO EXCEPTION RAISED - CASE 1A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 1A");
+           END;
+  
+            BEGIN
+                 V_A_NA1_3 := NEW NA1_3'(1 .. IDENT_INT(2) => 4);
+                 FAILED ("NO EXCEPTION RAISED - CASE 1B");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>
+                      NULL;
+                 WHEN OTHERS =>
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 1B");
+            END;
+  
+            BEGIN
+                 -- note that ALLOC1 returns A_CA1_5, so both
+                 -- (1) and (5) are valid index references!
+                 IF ALLOC1((2 .. 6 => 2))(5) /= 2 THEN
+                      FAILED ("Wrong Value Returned - CASE 2A");
+                 ELSIF ALLOC1((2 .. 6 => 3))(1) /= 3 THEN
+                      FAILED ("Unlikely Index Case - CASE 2A");
+                 END IF;
+            EXCEPTION
+                 WHEN OTHERS =>
+                      FAILED ("EXCEPTION RAISED - CASE 2A");
+            END;
+  
+            BEGIN
+                 IF ALLOC2((4 .. 1 => 3)) = NULL THEN
+                      FAILED ("IMPOSSIBLE - CASE 2B");
+                 END IF;
+                 COMMENT ("ADA 95 SLIDING ASSIGNMENT");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>
+                      FAILED ("ADA 83 NON-SLIDING ASSIGNMENT");
+                 WHEN OTHERS =>
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 2B");
+            END;
+  
+            BEGIN
+                 V_A_SA1_3 := NEW SA1_3'(1, 2);
+                 FAILED ("NO EXCEPTION RAISED - CASE 3A");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>  
+                      NULL;
+                 WHEN OTHERS =>  
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
+            END;
+  
+            BEGIN
+                 V_A_SA1_3 := NEW SA1_3'(3, 4, 5, 6);
+                 FAILED ("NO EXCEPTION RAISED - CASE 3B");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>  
+                      NULL;
+                 WHEN OTHERS =>  
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
+            END;
+  
+            BEGIN
+                 V_A_NA1_3 := NEW NA1_3'(1, 2);
+                 FAILED ("NO EXCEPTION RAISED - CASE 3C");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>  
+                      NULL;
+                 WHEN OTHERS =>  
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 3C");
+            END;
+  
+            BEGIN -- SATISFIES T BUT NOT BASE TYPE.
+                 V_A_CA1_5 := NEW CA1_4'(1, 2, 3, 4);
+                 FAILED ("NO EXCEPTION RAISED - CASE 3D");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>  
+                      NULL;
+                 WHEN OTHERS =>  
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 3D");
+            END;
+  
+            BEGIN -- SATISFIES T BUT NOT BASE TYPE.
+                 V_A_CA1_5 := NEW CA1_6'(1, 2, 3, 4, 5, 6);
+                 FAILED ("NO EXCEPTION RAISED - CASE 3E");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>
+                      NULL;
+                 WHEN OTHERS =>
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 3E");
+            END;
+  
+            BEGIN -- SATISFIES BASE TYPE BUT NOT T.
+                 V_A_CA1_5 := NEW CA1_4'(1, 2, 3, 4, 5);
+                 FAILED ("NO EXCEPTION RAISED - CASE 3F");
+            EXCEPTION
+                 WHEN CONSTRAINT_ERROR =>
+                      NULL;
+                 WHEN OTHERS =>
+                      FAILED ("WRONG EXCEPTION RAISED - CASE 3F");
+            END;
+  
+           BEGIN -- SATISFIES BASE TYPE BUT NOT T.
+                V_A_CA1_5 := NEW CA1_6'(1, 2, 3, 4, 5);
+                FAILED ("NO EXCEPTION RAISED - CASE 3G");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3G");
+           END;
+  
+       END ;
+  
+       RESULT ;
+  
+  END C48009E ;
+  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C48009F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS A CONSTRAINED OR UNCONSTRAINED MULTI-DIMENSIONAL
+ -- ARRAY TYPE AND ALL COMPONENTS OF X DO NOT HAVE THE SAME LENGTH OR
+ -- BOUNDS. 
+ 
+ -- RM  01/08/80
+ -- NL  10/13/81
+ -- SPS 10/26/82
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  C48009F  IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48009F","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                     "X IS AN ILL-FORMED MULTIDIMENSIONAL AGGREGATE");
+ 
+      DECLARE
+ 
+           TYPE  TG00  IS  ARRAY( 4..2 ) OF  INTEGER;
+           TYPE  TG10  IS  ARRAY( 1..2 ) OF  INTEGER;
+           TYPE  TG20  IS  ARRAY( INTEGER RANGE <> ) OF  INTEGER;
+ 
+           TYPE  TG0  IS  ARRAY( 3..2 ) OF  TG00;
+           TYPE  TG1  IS  ARRAY( 1..2 ) OF  TG10;
+           TYPE  TG2  IS  ARRAY( INTEGER RANGE <> ) OF  TG20(1..3);
+ 
+           TYPE  ATG0  IS  ACCESS TG0;
+           TYPE  ATG1  IS  ACCESS TG1;
+           TYPE  ATG2  IS  ACCESS TG2;
+ 
+           VG0  : ATG0;
+           VG1  : ATG1;
+           VG2  : ATG2;
+ 
+      BEGIN
+ 
+           BEGIN
+                VG0  :=  NEW TG0 '( 5..4 => ( 3..1 => 2 ) );
+                FAILED ("NO EXCEPTION RAISED - CASE 0");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>  NULL;
+                WHEN  OTHERS            =>
+                     FAILED( "WRONG EXCEPTION RAISED - CASE 0" );
+           END;
+ 
+           BEGIN
+                VG1  :=  NEW TG1 '( ( 1 , 2 ) , ( 3 , 4 , 5 ) );
+                FAILED ("NO EXCEPTION RAISED - CASE 1");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>  NULL;
+                WHEN  OTHERS            =>  
+                     FAILED( "WRONG EXCEPTION RAISED - CASE 1" );
+           END;
+ 
+           BEGIN
+                VG2 := NEW TG2'( 1 => ( 1..2 => 7) , 2 => ( 1..3 => 7));
+                FAILED ("NO EXCEPTION RAISED - CASE 2");
+           EXCEPTION
+                WHEN  CONSTRAINT_ERROR  =>  NULL;
+                WHEN  OTHERS            =>  
+                     FAILED( "WRONG EXCEPTION RAISED - CASE 2" );
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,209 ----
+ -- C48009G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT
+ --     CONSTRAINT_ERROR IS RAISED IF T IS A CONSTRAINED ACCESS
+ --     TYPE AND THE OBJECT DESIGNATED BY X DOES NOT HAVE DISCRIMINANTS
+ --     OR INDEX BOUNDS THAT EQUAL THE CORRESPONDING VALUES FOR T.
+ 
+ -- HISTORY:
+ --     EG  08/30/84  CREATED ORIGINAL TEST.
+ --     JET 01/05/87  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
+ --                   OPTIMIZATION.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48009G IS
+ 
+      USE REPORT;
+ 
+      GENERIC
+           TYPE G_TYPE IS PRIVATE;
+      FUNCTION EQUAL_G (X : G_TYPE; Y : G_TYPE) RETURN BOOLEAN;
+ 
+      FUNCTION EQUAL_G (X : G_TYPE; Y : G_TYPE) RETURN BOOLEAN IS
+      BEGIN
+           IF (IDENT_INT(3) = 3) AND (X = Y) THEN
+                RETURN TRUE;
+           ELSE
+                RETURN FALSE;
+           END IF;
+      END EQUAL_G;
+ 
+ BEGIN
+ 
+      TEST("C48009G","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                     "APPROPRIATE - CONSTRAINED ACCESS TYPE");
+ 
+      DECLARE
+ 
+           TYPE INT IS RANGE 1 .. 5;
+ 
+           TYPE UR(A : INT) IS
+                RECORD
+                     B : INTEGER;
+                END RECORD;
+           TYPE UA IS ARRAY(INT RANGE <>) OF INTEGER;
+ 
+           PACKAGE P IS
+                TYPE UP(A, B : INT) IS PRIVATE;
+                TYPE UL(A, B : INT) IS LIMITED PRIVATE;
+                CONS_UP : CONSTANT UP;
+           PRIVATE
+                TYPE UP(A, B : INT) IS
+                     RECORD
+                          C : INTEGER;
+                     END RECORD;
+                TYPE UL(A, B : INT) IS
+                     RECORD
+                          C : INTEGER;
+                     END RECORD;
+                CONS_UP : CONSTANT UP := (2, 2, (IDENT_INT(3)));
+           END P;
+ 
+           TYPE A_UR IS ACCESS UR;
+           TYPE A_UA IS ACCESS UA;
+           TYPE A_UP IS ACCESS P.UP;
+           TYPE A_UL IS ACCESS P.UL;
+ 
+           SUBTYPE CA_UR IS A_UR(2);
+           SUBTYPE CA_UA IS A_UA(2 .. 3);
+           SUBTYPE CA_UP IS A_UP(3, 2);
+           SUBTYPE CA_UL IS A_UL(2, 4);
+ 
+           TYPE A_CA_UR IS ACCESS CA_UR;
+           TYPE A_CA_UA IS ACCESS CA_UA;
+           TYPE A_CA_UP IS ACCESS CA_UP;
+           TYPE A_CA_UL IS ACCESS CA_UL;
+ 
+           V_A_CA_UR : A_CA_UR;
+           V_A_CA_UA : A_CA_UA;
+           V_A_CA_UP : A_CA_UP;
+           V_A_CA_UL : A_CA_UL;
+ 
+           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UR);
+           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UA);
+           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UP);
+           FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UL);
+ 
+      BEGIN
+ 
+           BEGIN
+                V_A_CA_UR := NEW CA_UR'(NEW UR'(1,(IDENT_INT(2))));
+ 
+                IF EQUAL (V_A_CA_UR, V_A_CA_UR) THEN
+                     FAILED ("NO EXCEPTION RAISED - UR");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UR");
+           END;
+ 
+           BEGIN
+                V_A_CA_UA := NEW CA_UA'(NEW UA'(1 => 2,
+                                                2 => IDENT_INT(3)));
+ 
+                IF EQUAL (V_A_CA_UA, V_A_CA_UA) THEN
+                     FAILED ("NO EXCEPTION RAISED - UA");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UA");
+           END;
+ 
+           BEGIN
+                V_A_CA_UP := NEW CA_UP'(NEW P.UP'(P.CONS_UP));
+ 
+                IF EQUAL (V_A_CA_UP, V_A_CA_UP) THEN
+                     FAILED ("NO EXCEPTION RAISED - UP");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UP");
+           END;
+ 
+           BEGIN
+                V_A_CA_UR := NEW CA_UR'(NULL);
+ 
+                IF NOT EQUAL (V_A_CA_UR, V_A_CA_UR) THEN
+                     COMMENT ("NO EXCEPTION RAISED - UR");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - UR");
+           END;
+ 
+           BEGIN
+                V_A_CA_UA := NEW CA_UA'(NULL);
+ 
+                IF NOT EQUAL (V_A_CA_UA, V_A_CA_UA) THEN
+                     COMMENT ("NO EXCEPTION RAISED - UA");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - UA");
+           END;
+ 
+           BEGIN
+                V_A_CA_UP := NEW CA_UP'(NULL);
+ 
+                IF NOT EQUAL (V_A_CA_UP, V_A_CA_UP) THEN
+                     COMMENT ("NO EXCEPTION RAISED - UP");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - UP");
+           END;
+ 
+           BEGIN
+                V_A_CA_UL := NEW CA_UL'(NULL);
+ 
+                IF NOT EQUAL (V_A_CA_UL, V_A_CA_UL) THEN
+                     COMMENT ("NO EXCEPTION RAISED - UL");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - UL");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- C48009H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS AN (UNCONSTRAINED) ACCESS TYPE, THE DESIGNATED TYPE
+ -- FOR T'BASE IS CONSTRAINED, AND THE OBJECT DESIGNATED BY X DOES NOT
+ -- HAVE DISCRIMINANTS OR INDEX BOUNDS THAT EQUAL THE CORRESPONDING
+ -- VALUES FOR T'S DESIGNATED TYPE.
+ 
+ -- EG  08/30/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48009H IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48009H","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                     "APPROPRIATE - UNCONSTRAINED ACCESS TYPE OF A " &
+                     "CONSTRAINED TYPE");
+ 
+      DECLARE
+ 
+           TYPE UR(A : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+ 
+           PACKAGE P IS
+                TYPE UP(A : INTEGER) IS PRIVATE;
+                TYPE UL(A : INTEGER) IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE UP(A : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+                TYPE UL(A : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END P;
+ 
+           TYPE A_CR IS ACCESS UR(IDENT_INT(2));
+           TYPE A_CA IS ACCESS UA(2 .. IDENT_INT(4));
+           TYPE A_CP IS ACCESS P.UP(3);
+           TYPE A_CL IS ACCESS P.UL(4);
+ 
+           TYPE AA_CR IS ACCESS A_CR;
+           TYPE AA_CA IS ACCESS A_CA;
+           TYPE AA_CP IS ACCESS A_CP;
+           TYPE AA_CL IS ACCESS A_CL;
+ 
+           V_AA_CR : AA_CR;
+           V_AA_CA : AA_CA;
+           V_AA_CP : AA_CP;
+           V_AA_CL : AA_CL;
+ 
+      BEGIN
+ 
+           BEGIN
+                V_AA_CR := NEW A_CR'(NEW UR(3));
+                FAILED ("NO EXCEPTION RAISED - CR");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CR");
+           END;
+ 
+           BEGIN
+                V_AA_CA := NEW A_CA'(NEW UA(IDENT_INT(3) .. 5));
+                FAILED ("NO EXCEPTION RAISED - CA");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CA");
+           END;
+ 
+           BEGIN
+                V_AA_CP := NEW A_CP'(NEW P.UP(IDENT_INT(4)));
+                FAILED ("NO EXCEPTION RAISED - CP");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CP");
+           END;
+ 
+           BEGIN
+                V_AA_CL := NEW A_CL'(NEW P.UL(5));
+                FAILED ("NO EXCEPTION RAISED - CL");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CL");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C48009I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF THE DESIGNATED TYPE FOR "NEW T'(X)" IS A CONSTRAINED
+ -- ACCESS TYPE, CA, T IS CA'BASE, AND A DISCRIMINANT OR INDEX VALUE OF X
+ -- DOES NOT EQUAL A VALUE SPECIFIED FOR CA.
+ 
+ -- EG  08/30/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48009I IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48009I","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                     "APPROPRIATE - ACCESS TYPE OF CONSTRAINED " &
+                     "ACCESS TYPE");
+ 
+      DECLARE
+ 
+           TYPE UR(A : INTEGER) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           
+           PACKAGE P IS
+                TYPE UP(A : INTEGER) IS PRIVATE;
+                TYPE UL(A : INTEGER) IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE UP(A : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+                TYPE UL(A : INTEGER) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END P;
+ 
+           TYPE A_UR IS ACCESS UR;
+           TYPE A_UA IS ACCESS UA;
+           TYPE A_UP IS ACCESS P.UP;
+           TYPE A_UL IS ACCESS P.UL;
+ 
+           TYPE AC_A_UR IS ACCESS A_UR(2);
+           TYPE AC_A_UA IS ACCESS A_UA(2 .. 4);
+           TYPE AC_A_UP IS ACCESS A_UP(3);
+           TYPE AC_A_UL IS ACCESS A_UL(4);
+ 
+           V_AC_A_UR : AC_A_UR;
+           V_AC_A_UA : AC_A_UA;
+           V_AC_A_UP : AC_A_UP;
+           V_AC_A_UL : AC_A_UL;
+ 
+      BEGIN
+ 
+           BEGIN
+                V_AC_A_UR := NEW A_UR'(NEW UR(3));
+                FAILED ("NO EXCEPTION RAISED - UR");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UR");
+           END;
+ 
+           BEGIN
+                V_AC_A_UA := NEW A_UA'(NEW UA(3 .. 5));
+                FAILED ("NO EXCEPTION RAISED - UA");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UA");
+           END;
+ 
+           BEGIN
+                V_AC_A_UP := NEW A_UP'(NEW P.UP(IDENT_INT(4)));
+                FAILED ("NO EXCEPTION RAISED - UP");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UP");
+           END;
+ 
+           BEGIN
+                V_AC_A_UL := NEW A_UL'(NEW P.UL(IDENT_INT(5)));
+                FAILED ("NO EXCEPTION RAISED - UL");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UL");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48009j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48009j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- C48009J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+ -- IS RAISED IF T IS AN UNCONSTRAINED ACCESS TYPE, ITS DESIGNATED TYPE
+ -- IS ALSO UNCONSTRAINED, AND A DISCRIMINANT VALUE FOR X LIES OUTSIDE
+ -- THE RANGE OF THE CORRESPONDING DISCRIMINANT SPECIFICATION FOR THE
+ -- DESIGNATED TYPE, OR A NON-NULL INDEX BOUND LIES OUTSIDE THE RANGE OF
+ -- AN INDEX SUBTYPE OF THE DESIGNATED TYPE.
+ 
+ -- EG  08/30/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48009J IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48009J","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                     "APPROPRIATE - ACCESS TYPE OF UNCONSTRAINED " &
+                     "ACCESS TYPE");
+ 
+      DECLARE
+ 
+           TYPE INT IS RANGE 1 .. 5;
+ 
+           TYPE UR(A : INT) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           TYPE UA IS ARRAY(INT RANGE <>) OF INTEGER;
+ 
+           PACKAGE P IS
+                TYPE UP(A : INT) IS PRIVATE;
+                TYPE UL(A : INT) IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE UP(A : INT) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+                TYPE UL(A : INT) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END P;
+ 
+           TYPE A_UR IS ACCESS UR;
+           TYPE A_UA IS ACCESS UA;
+           TYPE A_UP IS ACCESS P.UP;
+           TYPE A_UL IS ACCESS P.UL;
+ 
+           TYPE AA_UR IS ACCESS A_UR;
+           TYPE AA_UA IS ACCESS A_UA;
+           TYPE AA_UP IS ACCESS A_UP;
+           TYPE AA_UL IS ACCESS A_UL;
+ 
+           V_AA_UR : AA_UR;
+           V_AA_UA : AA_UA;
+           V_AA_UP : AA_UP;
+           V_AA_UL : AA_UL;
+ 
+      BEGIN
+ 
+           BEGIN
+                V_AA_UR := NEW A_UR'(NEW UR(INT(IDENT_INT(6))));
+                FAILED ("NO EXCEPTION RAISED - UR");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UR");
+           END;
+ 
+           BEGIN
+                V_AA_UA := NEW A_UA'(NEW UA(4 .. 7));
+                FAILED ("NO EXCEPTION RAISED - UA");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UA");
+           END;
+ 
+           BEGIN
+                V_AA_UP := NEW A_UP'(NEW P.UP(0));
+                FAILED ("NO EXCEPTION RAISED - UP");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UP");
+           END;
+ 
+           BEGIN
+                V_AA_UL := NEW A_UL'(NEW P.UL(INT(IDENT_INT(0))));
+                FAILED ("NO EXCEPTION RAISED - UL");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - UL");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48009J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C48010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NULL ARRAYS AND NULL RECORDS CAN BE ALLOCATED.
+ 
+ -- EG  08/30/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48010A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48010A","CHECK THAT NULL ARRAYS AND NULL RECORDS CAN " &
+                     "BE ALLOCATED");
+ 
+      DECLARE
+ 
+           TYPE CA IS ARRAY(4 .. 3) OF INTEGER;
+           TYPE CR IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE A_CA IS ACCESS CA;
+           TYPE A_CR IS ACCESS CR;
+ 
+           TYPE AA_CA IS ACCESS A_CA;
+           TYPE AA_CR IS ACCESS A_CR;
+ 
+           V_A_CA  : A_CA;
+           V_A_CR  : A_CR;
+           V_AA_CA : AA_CA;
+           V_AA_CR : AA_CR;
+ 
+      BEGIN
+ 
+           V_A_CA := NEW CA;
+           IF V_A_CA = NULL THEN
+                FAILED ("NULL ARRAY WAS NOT ALLOCATED - CA");
+           ELSIF V_A_CA.ALL'FIRST /= 4 AND V_A_CA.ALL'LAST /= 3 THEN
+                FAILED ("NULL ARRAY BOUNDS ARE INCORRECT - CA");
+           END IF;
+ 
+           V_A_CR := NEW CR;
+           IF V_A_CR = NULL THEN
+                FAILED ("NULL RECORD WAS NOT ALLOCATED - CR");
+           END IF;
+ 
+           V_AA_CA := NEW A_CA'(NEW CA);
+           IF V_AA_CA.ALL = NULL THEN
+                FAILED ("NULL ARRAY WAS NOT ALLOCATED - A_CA");
+           ELSIF V_AA_CA.ALL.ALL'FIRST /= 4 AND 
+                 V_AA_CA.ALL.ALL'LAST /= 3 THEN
+                FAILED ("NULL ARRAY BOUNDS ARE INCORRECT - A_CA");
+           END IF;
+ 
+           V_AA_CR := NEW A_CR'(NEW CR);
+           IF (V_AA_CR = NULL OR V_AA_CR.ALL = NULL) THEN
+                FAILED ("NULL RECORD WAS NOT ALLOCATED - A_CR");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C48011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OVERLOADED ALLOCATORS ARE DETERMINED TO HAVE THE
+ --     APPROPRIATE TYPE.
+ 
+ -- HISTORY:
+ --     JET 08/17/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C48011A IS
+ 
+      TYPE ACC1 IS ACCESS INTEGER;
+      TYPE ACC2 IS ACCESS INTEGER;
+ 
+      A1 : ACC1 := NULL;
+      A2 : ACC2 := NULL;
+ 
+      TYPE REC1 IS RECORD
+           A : INTEGER;
+      END RECORD;
+ 
+      TYPE REC2 IS RECORD
+           A : ACC2;
+      END RECORD;
+ 
+      TYPE AREC1 IS ACCESS REC1;
+      TYPE AREC2 IS ACCESS REC2;
+ 
+      PROCEDURE PROC(A : ACC1) IS
+      BEGIN
+           IF A.ALL /= 1 THEN
+                FAILED("INCORRECT CALL OF FIRST PROC");
+           END IF;
+      END PROC;
+ 
+      PROCEDURE PROC(A : INTEGER) IS
+      BEGIN
+           IF A /= 2 THEN
+                FAILED("INCORRECT CALL OF SECOND PROC");
+           END IF;
+      END PROC;
+ 
+      FUNCTION FUNC(I : INTEGER) RETURN AREC1 IS
+      BEGIN
+           IF I /= 1 THEN
+                FAILED("INCORRECT CALL OF FIRST FUNC");
+           END IF;
+           RETURN NEW REC1'(A => 0);
+      END FUNC;
+ 
+      FUNCTION FUNC(I : INTEGER) RETURN AREC2 IS
+      BEGIN
+           IF I /= 2 THEN
+                FAILED("INCORRECT CALL OF SECOND FUNC");
+           END IF;
+           RETURN NEW REC2'(A => NULL);
+      END FUNC;
+ 
+ BEGIN
+      TEST ("C48011A", "CHECK THAT OVERLOADED ALLOCATORS ARE " &
+                       "DETERMINED TO HAVE THE APPROPRIATE TYPE");
+ 
+      IF A1 = NEW INTEGER'(1) THEN
+           FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 1");
+      END IF;
+ 
+      IF A2 = NEW INTEGER'(2) THEN
+           FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 2");
+      END IF;
+ 
+      FUNC(1).A := INTEGER'(1);
+      FUNC(IDENT_INT(2)).A := NEW INTEGER'(2);
+ 
+      PROC(NEW INTEGER'(IDENT_INT(1)));
+      PROC(IDENT_INT(2));
+ 
+      RESULT;
+ END C48011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48012a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c48012a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c48012a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C48012A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DISCRIMINANTS GOVERNING VARIANT PARTS NEED NOT BE
+ -- SPECIFIED WITH STATIC VALUES IN AN ALLOCATOR OF THE FORM 
+ -- "NEW T X".
+ 
+ -- EG  08/30/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C48012A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C48012A","CHECK THAT DISCRIMINANTS GOVERNING VARIANT " &
+                     "PARTS NEED NOT BE SPECIFIED WITH STATIC "    &
+                     "VALUES IN AN ALLOCATOR OF THE FORM 'NEW T X'");
+ 
+      DECLARE
+ 
+           TYPE INT IS RANGE 1 .. 5;
+           TYPE ARR IS ARRAY(INT RANGE <>) OF INTEGER;
+ 
+           TYPE UR(A : INT) IS
+                RECORD
+                     CASE A IS
+                          WHEN 1 =>
+                               NULL;
+                          WHEN OTHERS =>
+                               B : ARR(1 .. A);
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A_UR IS ACCESS UR;
+ 
+           V_A_UR : A_UR;
+ 
+      BEGIN
+ 
+           V_A_UR := NEW UR(A => INT(IDENT_INT(2)));
+           IF V_A_UR.A /= 2 THEN
+                FAILED ("WRONG DISCRIMINANT VALUE");
+           ELSIF V_A_UR.B'FIRST /= 1 AND V_A_UR.B'LAST /= 2 THEN
+                FAILED ("WRONG BOUNDS IN VARIANT PART");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C48012A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c490001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c490001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c490001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c490001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,215 ----
+ -- C490001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for a real static expression that is not part of a larger
+ --      static expression, and whose expected type T is a floating point type
+ --      that is not a descendant of a formal scalar type, the value is rounded
+ --      to the nearest machine number of T if T'Machine_Rounds is true, and is
+ --      truncated otherwise. Check that if rounding is performed, and the value
+ --      is exactly halfway between two machine numbers, one of the two machine
+ --      numbers is used.
+ --
+ -- TEST DESCRIPTION:
+ --      The test obtains a machine number M1 for a floating point subtype S by
+ --      passing a real literal to S'Machine. It then obtains an adjacent
+ --      machine number M2 by using S'Succ (or S'Pred). It then constructs
+ --      values which lie between these two machine numbers: one (A) which is
+ --      closer to M1, one (B) which is exactly halfway between M1 and M2, and
+ --      one (C) which is closer to M2. This is done for both positive and
+ --      negative machine numbers.
+ --
+ --      Let M1 be closer to zero than M2. Then if S'Machine_Rounds is true,
+ --      C must be rounded to M2, A must be rounded to M1, and B must be rounded
+ --      to either M1 or M2. If S'Machine_Rounds is false, all the values must
+ --      be truncated to M1.
+ --
+ --      A, B, and C are constructed using the following static expressions:
+ --
+ --         A: constant S := M1 + (M2 - M1)*Z; -- Z slightly less than 0.5.
+ --         B: constant S := M1 + (M2 - M1)*Z; -- Z equals 0.5.
+ --         C: constant S := M1 + (M2 - M1)*Z; -- Z slightly more than 0.5.
+ --
+ --      Since these are static expressions, they must be evaluated exactly,
+ --      and no rounding may occur until the final result is calculated.
+ --
+ --      The checks for equality between the members of (A, B, C) and (M1, M2)
+ --      are performed at run-time within the body of a subprogram.
+ --
+ --      The test performs additional checks that the rounding performed on
+ --      real literals is consistent for a floating point subtype. A literal is
+ --      assigned to a constant of a floating point subtype S. The same literal
+ --      is then passed to a subprogram, along with the constant, and an
+ --      equality check is performed within the body of the subprogram.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      25 Sep 95   SAIC    Initial prerelease version.
+ --      25 May 01   RLB     Repaired to work with the repeal of the round away
+ --                          rule by AI-268.
+ --
+ --!
+ 
+ with System;
+ package C490001_0 is
+ 
+    type My_Flt is digits System.Max_Digits;
+ 
+    procedure Float_Subtest (A, B: in My_Flt; Msg: in String);
+ 
+    procedure Float_Subtest (A, B, C: in My_Flt; Msg: in String);
+ 
+ 
+ --
+ -- Positive cases:
+ --
+ 
+    --  |----|-------------|-----------------|-------------------|-----------|
+    --  |    |             |                 |                   |           |
+    --  0   P_M1  Less_Pos_Than_Half  Pos_Exactly_Half  More_Pos_Than_Half  P_M2
+ 
+ 
+    Positive_Float : constant My_Flt := 12.440193950021943;
+ 
+    -- The literal value 12.440193950021943 is rounded up or down to the
+    -- nearest machine number of My_Flt when Positive_Float is initialized.
+    -- The value of Positive_Float should therefore be a machine number, and
+    -- the use of 'Machine in the initialization of P_M1 will be redundant for
+    -- a correct implementation. It's done anyway to make certain that P_M1 is
+    -- a machine number, independent of whether an implementation correctly
+    -- performs rounding.
+ 
+    P_M1 : constant My_Flt := My_Flt'Machine(Positive_Float);
+    P_M2 : constant My_Flt := My_Flt'Succ(P_M1);
+ 
+    -- P_M1 and P_M2 are adjacent machine numbers. Note that because it is not
+    -- certain whether 12.440193950021943 is a machine number, nor whether
+    -- 'Machine rounds it up or down, 12.440193950021943 may not lie between
+    -- P_M1 and P_M2. The test does not depend on this information, however;
+    -- the literal is only used as a "seed" to obtain the machine numbers.
+ 
+ 
+    -- The following entities are used to verify that rounding is performed
+    -- according to the value of 'Machine_Rounds. If language rules are
+    -- obeyed, the intermediate expressions in the following static
+    -- initialization expressions will not be rounded; all calculations will
+    -- be performed exactly. The final result, however, will be rounded to
+    -- a machine number (either P_M1 or P_M2, depending on the value of
+    -- My_Flt'Machine_Rounds). Thus, the value of each constant below will
+    -- equal that of P_M1 or P_M2.
+ 
+    Less_Pos_Than_Half : constant My_Flt := P_M1 + ((P_M2 - P_M1)*2.9/6.0);
+    Pos_Exactly_Half   : constant My_Flt := P_M1 + ((P_M2 - P_M1)/2.0);
+    More_Pos_Than_Half : constant My_Flt := P_M1 + ((P_M2 - P_M1)*4.6/9.0);
+ 
+ 
+ --
+ -- Negative cases:
+ --
+ 
+    --  -|-------------|-----------------|-------------------|-----------|----|
+    --   |             |                 |                   |           |    |
+    --  N_M2  More_Neg_Than_Half  Neg_Exactly_Half  Less_Neg_Than_Half  N_M1  0
+ 
+ 
+    -- The descriptions for the positive cases above apply to the negative
+    -- cases below as well. Note that, for N_M2, 'Pred is used rather than
+    -- 'Succ. Thus, N_M2 is further from 0.0 (i.e. more negative) than N_M1.
+ 
+    Negative_Float : constant My_Flt := -0.692074550952117;
+ 
+ 
+    N_M1 : constant My_Flt := My_Flt'Machine(Negative_Float);
+    N_M2 : constant My_Flt := My_Flt'Pred(N_M1);
+ 
+    More_Neg_Than_Half : constant My_Flt := N_M1 + ((N_M2 - N_M1)*4.1/8.0);
+    Neg_Exactly_Half   : constant My_Flt := N_M1 + ((N_M2 - N_M1)/2.0);
+    Less_Neg_Than_Half : constant My_Flt := N_M1 + ((N_M2 - N_M1)*2.4/5.0);
+ 
+ end C490001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with TCTouch;
+ package body C490001_0 is
+ 
+    procedure Float_Subtest (A, B: in My_Flt; Msg: in String) is
+    begin
+        TCTouch.Assert (A = B, Msg);
+    end Float_Subtest;
+ 
+    procedure Float_Subtest (A, B, C: in My_Flt; Msg: in String) is
+    begin
+        TCTouch.Assert (A = B or A = C, Msg);
+    end Float_Subtest;
+ 
+ end C490001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C490001_0;  -- Floating point support.
+ use  C490001_0;
+ 
+ with Report;
+ procedure C490001 is
+ begin
+    Report.Test ("C490001", "Rounding of real static expressions: " &
+                 "floating point subtypes");
+ 
+ 
+    -- Check that rounding direction is consistent for literals:
+ 
+    Float_Subtest (12.440193950021943, P_M1, "Positive Float: literal");
+    Float_Subtest (-0.692074550952117, N_M1, "Negative Float: literal");
+ 
+ 
+    -- Now check that rounding is performed correctly for values between
+    -- machine numbers, according to the value of 'Machine_Rounds:
+ 
+    if My_Flt'Machine_Rounds then
+       Float_Subtest (Pos_Exactly_Half,   P_M1, P_M2, "Positive Float: = half");
+       Float_Subtest (More_Pos_Than_Half, P_M2, "Positive Float: > half");
+       Float_Subtest (Less_Pos_Than_Half, P_M1, "Positive Float: < half");
+ 
+       Float_Subtest (Neg_Exactly_Half,   N_M1, N_M2, "Negative Float: = half");
+       Float_Subtest (More_Neg_Than_Half, N_M2, "Negative Float: > half");
+       Float_Subtest (Less_Neg_Than_Half, N_M1, "Negative Float: < half");
+    else
+       Float_Subtest (Pos_Exactly_Half,   P_M1, "Positive Float: = half");
+       Float_Subtest (More_Pos_Than_Half, P_M1, "Positive Float: > half");
+       Float_Subtest (Less_Pos_Than_Half, P_M1, "Positive Float: < half");
+ 
+       Float_Subtest (Neg_Exactly_Half,   N_M1, "Negative Float: = half");
+       Float_Subtest (More_Neg_Than_Half, N_M1, "Negative Float: > half");
+       Float_Subtest (Less_Neg_Than_Half, N_M1, "Negative Float: < half");
+    end if;
+ 
+ 
+    Report.Result;
+ end C490001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c490002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c490002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c490002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c490002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,239 ----
+ -- C490002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for a real static expression that is not part of a larger
+ --      static expression, and whose expected type T is an ordinary fixed
+ --      point type that is not a descendant of a formal scalar type, the value
+ --      is rounded to the nearest integral multiple of the small of T if
+ --      T'Machine_Rounds is true, and is truncated otherwise. Check that if
+ --      rounding is performed, and the value is exactly halfway between two
+ --      multiples of the small, one of the two multiples of small is used.
+ --
+ -- TEST DESCRIPTION:
+ --      The test obtains an integral multiple M1 of the small of an ordinary
+ --      fixed point subtype S by dividing a real literal by S'Small, and then
+ --      truncating the result using 'Truncation. It then obtains an adjacent
+ --      multiple M2 of the small by using S'Succ (or S'Pred). It then
+ --      constructs values which lie between these multiples: one (A) which is
+ --      closer to M1, one (B) which is exactly halfway between M1 and M2, and
+ --      one (C) which is closer to M2. This is done for both positive and
+ --      negative multiples of the small.
+ --
+ --      Let M1 be closer to zero than M2. Then if S'Machine_Rounds is true,
+ --      C must be rounded to M2, A must be rounded to M1, and B must be rounded
+ --      to either M1 or M2. If S'Machine_Rounds is false, all the values must
+ --      be truncated to M1.
+ --
+ --      A, B, and C are constructed using the following static expressions:
+ --
+ --         A: constant S := M1 + (M2 - M1)/Z; -- Z slightly more than 2.0.
+ --         B: constant S := M1 + (M2 - M1)/Z; -- Z equals 2.0.
+ --         C: constant S := M1 + (M2 - M1)/Z; -- Z slightly less than 2.0.
+ --
+ --      Since these are static expressions, they must be evaluated exactly,
+ --      and no rounding may occur until the final result is calculated.
+ --
+ --      The checks for equality between the members of (A, B, C) and (M1, M2)
+ --      are performed at run-time within the body of a subprogram.
+ --
+ --      The test performs additional checks that the rounding performed on
+ --      real literals is consistent for ordinary fixed point subtypes. A
+ --      named number (initialized with a literal) is assigned to a constant of
+ --      a fixed point subtype S. The same literal is then passed to a
+ --      subprogram, along with the constant, and an equality check is
+ --      performed within the body of the subprogram.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      26 Sep 95   SAIC    Initial prerelease version.
+ --
+ --!
+ 
+ package C490002_0 is
+ 
+    type My_Fix is delta 0.0625 range -1000.0 .. 1000.0;
+ 
+    Small : constant := My_Fix'Small;                      -- Named number.
+ 
+    procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String);
+ 
+    procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String);
+ 
+ 
+ --
+ -- Positive cases:
+ --
+ 
+    --  |----|-------------|-----------------|-------------------|-----------|
+    --  |    |             |                 |                   |           |
+    --  0   P_M1  Less_Pos_Than_Half  Pos_Exactly_Half  More_Pos_Than_Half  P_M2
+ 
+ 
+    Positive_Real  : constant := 0.11433;          -- Named number.
+    Pos_Multiplier : constant := Float'Truncation(Positive_Real/Small);
+ 
+    -- Pos_Multiplier is the number of integral multiples of small contained
+    -- in Positive_Real. P_M1 is thus the largest integral multiple of
+    -- small less than or equal to Positive_Real. Note that since Positive_Real
+    -- is a named number and not a fixed point object, P_M1 is generated
+    -- without assuming that rounding is performed correctly for fixed point
+    -- subtypes.
+ 
+    Positive_Fixed : constant My_Fix := Positive_Real;
+ 
+    P_M1 : constant My_Fix := Pos_Multiplier * Small;
+    P_M2 : constant My_Fix := My_Fix'Succ(P_M1);
+ 
+    -- P_M1 and P_M2 are adjacent multiples of the small of My_Fix. Note that
+    -- 0.11433 either equals P_M1 (if it is an integral multiple of the small)
+    -- or lies between P_M1 and P_M2 (since truncation was forced in
+    -- generating Pos_Multiplier). It is not certain, however, exactly where
+    -- it lies between them (halfway, less than halfway, more than halfway).
+    -- This fact is irrelevant to the test.
+ 
+ 
+    -- The following entities are used to verify that rounding is performed
+    -- according to the value of 'Machine_Rounds. If language rules are
+    -- obeyed, the intermediate expressions in the following static
+    -- initialization expressions will not be rounded; all calculations will
+    -- be performed exactly. The final result, however, will be rounded to
+    -- an integral multiple of the small (either P_M1 or P_M2, depending on the
+    -- value of My_Fix'Machine_Rounds). Thus, the value of each constant below
+    -- will equal that of P_M1 or P_M2.
+ 
+    Less_Pos_Than_Half : constant My_Fix := P_M1 + ((P_M2 - P_M1)/2.050);
+    Pos_Exactly_Half   : constant My_Fix := P_M1 + ((P_M2 - P_M1)/2.000);
+    More_Pos_Than_Half : constant My_Fix := P_M1 + ((P_M2 - P_M1)/1.975);
+ 
+ 
+ --
+ -- Negative cases:
+ --
+ 
+    --  -|-------------|-----------------|-------------------|-----------|----|
+    --   |             |                 |                   |           |    |
+    --  N_M2  More_Neg_Than_Half  Neg_Exactly_Half  Less_Neg_Than_Half  N_M1  0
+ 
+ 
+    -- The descriptions for the positive cases above apply to the negative
+    -- cases below as well. Note that, for N_M2, 'Pred is used rather than
+    -- 'Succ. Thus, N_M2 is further from 0.0 (i.e. more negative) than N_M1.
+ 
+    Negative_Real  : constant := -467.13988;       -- Named number.
+    Neg_Multiplier : constant := Float'Truncation(Negative_Real/Small);
+ 
+    Negative_Fixed : constant My_Fix := Negative_Real;
+ 
+    N_M1 : constant My_Fix := Neg_Multiplier * Small;
+    N_M2 : constant My_Fix := My_Fix'Pred(N_M1);
+ 
+    More_Neg_Than_Half : constant My_Fix := N_M1 + ((N_M2 - N_M1)/1.980);
+    Neg_Exactly_Half   : constant My_Fix := N_M1 + ((N_M2 - N_M1)/2.000);
+    Less_Neg_Than_Half : constant My_Fix := N_M1 + ((N_M2 - N_M1)/2.033);
+ 
+ end C490002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with TCTouch;
+ package body C490002_0 is
+ 
+    procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String) is
+    begin
+        TCTouch.Assert (A = B, Msg);
+    end Fixed_Subtest;
+ 
+    procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String) is
+    begin
+        TCTouch.Assert (A = B or A = C, Msg);
+    end Fixed_Subtest;
+ 
+ end C490002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C490002_0;  -- Fixed point support.
+ use  C490002_0;
+ 
+ with Report;
+ procedure C490002 is
+ begin
+    Report.Test ("C490002", "Rounding of real static expressions: " &
+                 "ordinary fixed point subtypes");
+ 
+ 
+    -- Literal cases: If the named numbers used to initialize Positive_Fixed
+    -- and Negative_Fixed are rounded to an integral multiple of the small
+    -- prior to assignment (as expected), then Positive_Fixed and
+    -- Negative_Fixed are already integral multiples of the small, and
+    -- equal either P_M1 or P_M2 (resp., N_M1 or N_M2). An equality check
+    -- can determine in which direction rounding occurred. For example:
+    --
+    --        if (Positive_Fixed = P_M1) then -- Rounding was toward 0.0.
+    --
+    -- Check here that the rounding direction is consistent for literals:
+ 
+    if (Positive_Fixed = P_M1) then
+       Fixed_Subtest (0.11433, P_M1, "Positive Fixed: literal");
+    else
+       Fixed_Subtest (0.11433, P_M2, "Positive Fixed: literal");
+    end if;
+ 
+    if (Negative_Fixed = N_M1) then
+       Fixed_Subtest (-467.13988, N_M1, "Negative Fixed: literal");
+    else
+       Fixed_Subtest (-467.13988, N_M2, "Negative Fixed: literal");
+    end if;
+ 
+ 
+    -- Now check that rounding is performed correctly for values between
+    -- multiples of the small, according to the value of 'Machine_Rounds:
+ 
+    if My_Fix'Machine_Rounds then
+       Fixed_Subtest (Pos_Exactly_Half,   P_M1, P_M2, "Positive Fixed: = half");
+       Fixed_Subtest (More_Pos_Than_Half, P_M2, "Positive Fixed: > half");
+       Fixed_Subtest (Less_Pos_Than_Half, P_M1, "Positive Fixed: < half");
+ 
+       Fixed_Subtest (Neg_Exactly_Half,   N_M1, N_M2, "Negative Fixed: = half");
+       Fixed_Subtest (More_Neg_Than_Half, N_M2, "Negative Fixed: > half");
+       Fixed_Subtest (Less_Neg_Than_Half, N_M1, "Negative Fixed: < half");
+    else
+       Fixed_Subtest (Pos_Exactly_Half,   P_M1, "Positive Fixed: = half");
+       Fixed_Subtest (More_Pos_Than_Half, P_M1, "Positive Fixed: > half");
+       Fixed_Subtest (Less_Pos_Than_Half, P_M1, "Positive Fixed: < half");
+ 
+       Fixed_Subtest (Neg_Exactly_Half,   N_M1, "Negative Fixed: = half");
+       Fixed_Subtest (More_Neg_Than_Half, N_M1, "Negative Fixed: > half");
+       Fixed_Subtest (Less_Neg_Than_Half, N_M1, "Negative Fixed: < half");
+    end if;
+ 
+ 
+    Report.Result;
+ end C490002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c490003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c490003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c490003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c490003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,215 ----
+ -- C490003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a static expression is legal if its evaluation fails
+ --      no language-defined check other than Overflow_Check. Check that such
+ --      a static expression is legal if it is part of a larger static
+ --      expression, even if its value is outside the base range of the
+ --      expected type.
+ --
+ --      Check that if a static expression is part of the right operand of a
+ --      short circuit control form whose value is determined by its left
+ --      operand, it is not evaluated.
+ --
+ --      Check that a static expression in a non-static context is evaluated
+ --      exactly.
+ --
+ -- TEST DESCRIPTION:
+ --      The first part of the objective is tested by constructing static
+ --      expressions which involve predefined operations of integer, floating
+ --      point, and fixed point subtypes. Intermediate expressions within the
+ --      static expressions have values outside the base range of the expected
+ --      type. In one case, the extended-range intermediates are compared as
+ --      part of a boolean expression. In the remaining two cases, further
+ --      predefined operations on the intermediates bring the final result
+ --      within the base range. An implementation which compiles these static
+ --      expressions satisfies this portion of the objective. A check is
+ --      performed at run-time to ensure that the static expressions evaluate
+ --      to values within the base range of their respective expected types.
+ --
+ --      The second part of the objective is tested by constructing
+ --      short-circuit control forms whose left operands have the values
+ --      shown below:
+ --
+ --         (TRUE)  or else  (...)
+ --         (FALSE) and then (...)
+ --    
+ --      In both cases the left operand determines the value of the condition.
+ --      In the test each right operand involves a division by zero, which will
+ --      raise Constraint_Error if evaluated. A check is made that no exception
+ --      is raised when each short-circuit control form is evaluated, and that
+ --      the value of the condition is that of the left operand.
+ --    
+ --      The third part of the objective is tested by evaluating static
+ --      expressions involving many operations in contexts which do not
+ --      require a static expression, and verifying that the exact
+ --      mathematical results are calculated.
+ --    
+ --
+ -- CHANGE HISTORY:
+ --      15 Sep 95   SAIC    Initial prerelease version for ACVC 2.1.
+ --      20 Oct 96   SAIC    Modified expressions in C490003_0 to avoid
+ --                          the use of universal operands.
+ --
+ --!
+ 
+ with System;
+ package C490003_0 is
+ 
+    type My_Flt is digits System.Max_Digits;
+ 
+    Flt_Range_Diff : My_Flt := (My_Flt'Base'Last - My_Flt'Base'First) -
+                               (My_Flt'Last - My_Flt'First);           -- OK.
+ 
+ 
+    type My_Fix is delta 0.125 range -128.0 .. 128.0;
+ 
+    Symmetric : Boolean := (My_Fix'Base'Last - My_Fix'Base'First) = 
+                           (My_Fix'Base'Last + My_Fix'Base'Last);      -- OK.
+ 
+ 
+    Center : constant Integer := Integer'Base'Last -
+                                  (Integer'Base'Last -
+                                   Integer'Base'First) / 2;            -- OK.
+ 
+ end C490003_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Ada.Numerics;
+ package C490003_1 is
+ 
+    Zero       : constant := 0.0;
+    Pi         : constant := Ada.Numerics.Pi;
+ 
+    Two_Pi     : constant := 2.0 * Pi;
+    Half_Pi    : constant := Pi/2.0;
+ 
+    Quarter    : constant := 90.0;
+    Half       : constant := 180.0;
+    Full       : constant := 360.0;
+ 
+    Deg_To_Rad : constant := Half_Pi/90;
+    Rad_To_Deg : constant := 1.0/Deg_To_Rad;
+    
+ end C490003_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C490003_0;
+ with C490003_1;
+ 
+ with Report;
+ procedure C490003 is
+ begin
+    Report.Test ("C490003", "Check that static expressions failing "          &
+                 "Overflow_Check are legal if part of a larger static "       &
+                 "expression. Check that static expressions as right "        &
+                 "operands of short-circuit control forms are not "           &
+                 "evaluated if value of control form is determined by "       &
+                 "left operand. Check that static expressions in non-static " &
+                 "contexts are evaluated exactly");
+ 
+ 
+ --
+ -- Static expressions within larger static expressions:
+ --
+ 
+ 
+    if C490003_0.Flt_Range_Diff not in C490003_0.My_Flt'Base'Range then
+       Report.Failed ("Error evaluating static expression: floating point");
+    end if;
+ 
+    if C490003_0.Symmetric not in Boolean'Range then
+       Report.Failed ("Error evaluating static expression: fixed point");
+    end if;
+ 
+    if C490003_0.Center not in Integer'Base'Range then
+       Report.Failed ("Error evaluating static expression: integer");
+    end if;
+ 
+ 
+ --
+ -- Short-circuit control forms:
+ --
+ 
+    declare
+       N : constant := 0.0;
+    begin
+ 
+       begin
+          if not ( (N = 0.0) or else (1.0/N > 0.5) ) then
+             Report.Failed ("Error evaluating OR ELSE");
+          end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Right side of OR ELSE was evaluated");
+          when others           =>
+             Report.Failed ("OR ELSE: unexpected exception raised");
+       end;
+ 
+       begin
+          if (N /= 0.0) and then (1.0/N <= 0.5) then
+             Report.Failed ("Error evaluating AND THEN");
+          end if;
+       exception
+          when Constraint_Error =>
+             Report.Failed ("Right side of AND THEN was evaluated");
+          when others           =>
+             Report.Failed ("AND THEN: unexpected exception raised");
+       end;
+ 
+    end;
+ 
+ 
+ --
+ -- Exact evaluation of static expressions:
+ --
+ 
+ 
+    declare
+       use C490003_1;
+ 
+       Left  : constant := 6.0 + 0.3125*( (Full*0.375) + (Half/2.4) -
+                              ((Quarter + 36.0)/3.0) )/10.0;            -- 11.25
+       Right : constant := (Pi/3.0) * 1.2 * (15.0/96.0);                -- Pi/16
+    begin
+       if Deg_To_Rad*Left /= Right then
+          Report.Failed ("Static expressions not evaluated exactly: #1");
+       end if;
+ 
+       if ((Pi*Rad_To_Deg)*2.0 + 4.0*Quarter)/16.0 /= Rad_To_Deg*(Pi/4.0) then
+          Report.Failed ("Static expressions not evaluated exactly: #2");
+       end if;
+    end;
+ 
+ 
+    Report.Result;
+ end C490003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49020a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49020a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49020a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49020a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C49020A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ENUMERATION LITERALS (INCLUDING CHARACTER LITERALS) CAN BE
+ -- USED IN STATIC EXPRESSIONS TOGETHER WITH RELATIONAL AND EQUALITY 
+ -- OPERATORS.
+ 
+ -- L.BROWN   09/30/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  C49020A  IS
+ 
+      CAS_BOL : BOOLEAN := TRUE;
+      OBJ1 : INTEGER := 4;
+      TYPE ENUM IS (RED,GREEN,BLUE,OFF,ON,'A','B');
+ 
+ BEGIN
+      TEST("C49020A","ENUMERATION LITERALS (INCLUDING CHARACTER "&
+                     "LITERALS) TOGETHER WITH RELATIONAL OPERATORS "&
+                     "CAN BE USED IN STATIC EXPRESSION");
+ 
+      CASE CAS_BOL IS
+           WHEN (RED <= BLUE) =>
+                OBJ1 := 5;
+           WHEN (BLUE = GREEN) =>
+                FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
+                       "EXPRESSION 1");
+      END CASE;
+ 
+      CAS_BOL := TRUE;
+ 
+      CASE CAS_BOL IS
+           WHEN (GREEN >= ON) =>
+                FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
+                       "EXPRESSION 2");
+           WHEN (ENUM'('A') < ENUM'('B')) =>
+                OBJ1 := 6;
+      END CASE;
+ 
+      CAS_BOL := TRUE;
+ 
+      CASE CAS_BOL IS
+           WHEN (BLUE > 'B') =>
+                FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
+                       "EXPRESSION 3");
+           WHEN (OFF /= 'A') =>
+                OBJ1 := 7;
+      END CASE;
+ 
+      RESULT;
+ 
+ END C49020A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49021a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49021a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49021a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49021a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C49021A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT BOOLEAN LITERALS CAN BE USED IN STATIC EXPRESSIONS 
+ -- TOGETHER WITH THE LOGICAL OPERATORS, THE NOT OPERATOR, AND THE
+ -- RELATIONAL AND EQUALITY OPERATORS.
+ 
+ -- L.BROWN  09/25/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  C49021A  IS
+ 
+      CAS_BOL : BOOLEAN := TRUE;
+      X1 : CONSTANT := BOOLEAN'POS((TRUE AND FALSE)OR(TRUE AND TRUE));
+      X2 : CONSTANT := BOOLEAN'POS((TRUE <= FALSE)AND(FALSE >= FALSE));
+ 
+ BEGIN
+      TEST("C49021A","BOOLEAN LITERALS TOGETHER WITH CERTAIN OPERATORS,"&
+                     "CAN BE USED IN STATIC EXPRESSIONS.");
+      IF X1 /= 1  THEN
+           FAILED("INCORRECT VALUE RETURNED BY BOOLEAN EXPRESSION 1");
+      END IF;
+ 
+      IF X2 /= 0  THEN
+           FAILED("INCORRECT VALUE RETURNED BY BOOLEAN EXPRESSION 2");
+      END IF;
+ 
+      CASE CAS_BOL IS
+           WHEN ((TRUE AND FALSE) XOR (TRUE XOR TRUE)) =>
+                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                       "EXPRESSION 2");
+           WHEN OTHERS =>
+                CAS_BOL := TRUE;
+      END CASE;
+ 
+      CASE CAS_BOL IS
+           WHEN ((TRUE > FALSE) OR (FALSE <= TRUE)) =>
+                CAS_BOL := TRUE;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                       "EXPRESSION 3");
+      END CASE;
+ 
+      CASE CAS_BOL IS
+           WHEN NOT((TRUE OR FALSE) = (FALSE AND TRUE)) =>
+                CAS_BOL := TRUE;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                       "EXPRESSION 4");
+      END CASE;
+ 
+      CASE CAS_BOL IS
+           WHEN (((TRUE = FALSE) OR (FALSE AND TRUE)) /= (TRUE < TRUE))=>
+                FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                       "EXPRESSION 5");
+           WHEN OTHERS =>
+                CAS_BOL := TRUE;
+      END CASE;
+ 
+      RESULT;
+ 
+ END C49021A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49022a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49022a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49022a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49022a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C49022A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NAMED NUMBER DECLARATIONS (INTEGER) MAY USE EXPRESSIONS
+ -- WITH INTEGERS.
+ 
+ -- BAW 29 SEPT 80
+ -- TBN 10/28/85     RENAMED FROM C4A001A.ADA. ADDED RELATIONAL
+ --                  OPERATORS AND USE OF NAMED NUMBERS.
+ 
+ WITH REPORT;
+ PROCEDURE C49022A IS
+ 
+      USE REPORT;
+ 
+      ADD1 : CONSTANT :=   1   +  1;
+      ADD2 : CONSTANT :=   1   + (-1);
+      ADD3 : CONSTANT := (-1)  +   1;
+      ADD4 : CONSTANT := (-1)  + (-1);
+      SUB1 : CONSTANT :=   1   -   1;
+      SUB2 : CONSTANT :=   1   - (-1);
+      SUB3 : CONSTANT := (-1)  -   1;
+      SUB4 : CONSTANT := (-1)  - (-1);
+      MUL1 : CONSTANT :=   1   *   1;
+      MUL2 : CONSTANT :=   1   * (-1);
+      MUL3 : CONSTANT := (-1)  *   1;
+      MUL4 : CONSTANT := (-1)  * (-1);
+      DIV1 : CONSTANT :=   1   /   1;
+      DIV2 : CONSTANT :=   1   / (-1);
+      DIV3 : CONSTANT := (-1)  /   1;
+      DIV4 : CONSTANT := (-1)  / (-1);
+      REM1 : CONSTANT :=  14  REM  5;
+      REM2 : CONSTANT :=  14  REM(-5);
+      REM3 : CONSTANT :=(-14) REM  5;
+      REM4 : CONSTANT :=(-14) REM(-5);
+      MOD1 : CONSTANT :=   4  MOD   3;
+      MOD2 : CONSTANT :=   4  MOD (-3);
+      MOD3 : CONSTANT := (-4) MOD   3;
+      MOD4 : CONSTANT := (-4) MOD (-3);
+      EXP1 : CONSTANT :=   1  ** 1;
+      EXP2 : CONSTANT := (-1) ** 1;
+      ABS1 : CONSTANT := ABS( - 10 );
+      ABS2 : CONSTANT := ABS( + 10 );
+      TOT1 : CONSTANT := ADD1 + SUB1 - MUL1 + DIV1 - REM3 + MOD2 - EXP1;
+      LES1 : CONSTANT := BOOLEAN'POS (1 < 2);
+      LES2 : CONSTANT := BOOLEAN'POS (1 < (-2));
+      LES3 : CONSTANT := BOOLEAN'POS ((-1) < (-2));
+      LES4 : CONSTANT := BOOLEAN'POS (ADD1 < SUB1);
+      GRE1 : CONSTANT := BOOLEAN'POS (2 > 1);
+      GRE2 : CONSTANT := BOOLEAN'POS ((-1) > 2);
+      GRE3 : CONSTANT := BOOLEAN'POS ((-1) > (-2));
+      GRE4 : CONSTANT := BOOLEAN'POS (ADD1 > SUB1);
+      LEQ1 : CONSTANT := BOOLEAN'POS (1 <= 1);
+      LEQ2 : CONSTANT := BOOLEAN'POS ((-1) <= 1);
+      LEQ3 : CONSTANT := BOOLEAN'POS ((-1) <= (-2));
+      LEQ4 : CONSTANT := BOOLEAN'POS (ADD2 <= SUB3);
+      GEQ1 : CONSTANT := BOOLEAN'POS (2 >= 1);
+      GEQ2 : CONSTANT := BOOLEAN'POS ((-2) >= 1);
+      GEQ3 : CONSTANT := BOOLEAN'POS ((-2) >= (-1));
+      GEQ4 : CONSTANT := BOOLEAN'POS (ADD2 >= SUB3);
+      EQU1 : CONSTANT := BOOLEAN'POS (2 = 2);
+      EQU2 : CONSTANT := BOOLEAN'POS ((-2) = 2);
+      EQU3 : CONSTANT := BOOLEAN'POS ((-2) = (-2));
+      EQU4 : CONSTANT := BOOLEAN'POS (ADD2 = SUB3);
+      NEQ1 : CONSTANT := BOOLEAN'POS (2 /= 2);
+      NEQ2 : CONSTANT := BOOLEAN'POS ((-2) /= 1);
+      NEQ3 : CONSTANT := BOOLEAN'POS ((-2) /= (-2));
+      NEQ4 : CONSTANT := BOOLEAN'POS (ADD2 /= SUB3);
+ 
+ 
+ BEGIN
+      TEST("C49022A","CHECK THAT NAMED NUMBER DECLARATIONS (INTEGER) " &
+                     "MAY USE EXPRESSIONS WITH INTEGERS");
+ 
+      IF ADD1 /= 2 OR ADD2 /= 0 OR ADD3 /= 0 OR ADD4 /= -2 THEN
+           FAILED("ERROR IN THE ADDING OPERATOR +");
+      END IF;
+ 
+      IF SUB1 /= 0 OR SUB2 /= 2 OR SUB3 /= -2 OR SUB4 /= 0 THEN
+           FAILED("ERROR IN THE ADDING OPERATOR -");
+      END IF;
+ 
+      IF MUL1 /= 1 OR MUL2 /= -1 OR MUL3 /= -1 OR MUL4 /= 1 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+      END IF;
+ 
+      IF DIV1 /= 1 OR DIV2 /= -1 OR DIV3 /= -1 OR DIV4 /= 1 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
+      END IF;
+ 
+      IF REM1 /= 4 OR REM2 /=  4 OR REM3 /= -4 OR REM4 /= -4 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR REM");
+      END IF;
+ 
+      IF MOD1 /= 1 OR MOD2 /= -2 OR MOD3 /= 2 OR MOD4 /= -1 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR MOD");
+      END IF;
+ 
+      IF EXP1 /= 1 OR EXP2 /= -1 THEN
+           FAILED("ERROR IN THE EXPONENTIATING OPERATOR");
+      END IF;
+ 
+      IF ABS1 /= 10 OR ABS2 /= 10 THEN
+           FAILED("ERROR IN THE ABS OPERATOR");
+      END IF;
+ 
+      IF TOT1 /= 3 THEN
+           FAILED("ERROR IN USING NAMED NUMBERS WITH OPERATORS");
+      END IF;
+ 
+      IF LES1 /= 1 OR LES2 /= 0 OR LES3 /= 0 OR LES4 /= 0 THEN
+           FAILED("ERROR IN THE LESS THAN OPERATOR");
+      END IF;
+ 
+      IF GRE1 /= 1 OR GRE2 /= 0 OR GRE3 /= 1 OR GRE4 /= 1 THEN
+           FAILED("ERROR IN THE GREATER THAN OPERATOR");
+      END IF;
+ 
+      IF LEQ1 /= 1 OR LEQ2 /= 1 OR LEQ3 /= 0 OR LEQ4 /= 0 THEN
+           FAILED("ERROR IN THE LESS THAN EQUAL OPERATOR");
+      END IF;
+ 
+      IF GEQ1 /= 1 OR GEQ2 /= 0 OR GEQ3 /= 0 OR GEQ4 /= 1 THEN
+           FAILED("ERROR IN THE GREATER THAN EQUAL OPERATOR");
+      END IF;
+ 
+      IF EQU1 /= 1 OR EQU2 /= 0 OR EQU3 /= 1 OR EQU4 /= 0 THEN
+           FAILED("ERROR IN THE EQUAL OPERATOR");
+      END IF;
+ 
+      IF NEQ1 /= 0 OR NEQ2 /= 1 OR NEQ3 /= 0 OR NEQ4 /= 1 THEN
+           FAILED("ERROR IN THE NOT EQUAL OPERATOR");
+      END IF;
+ 
+      RESULT;
+ 
+ END C49022A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49022b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49022b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49022b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49022b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C49022B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN NUMBER DECLARATIONS, IDENTIFIERS CORRECTLY REPRESENT
+ -- VALUES OF OTHER LITERALS.
+ 
+ -- BAW 29 SEPT 80
+ -- TBN 10/22/85     RENAMED FROM C4A003A.ADA AND ADDED RELATIONAL 
+ --                  OPERATORS USING NAMED NUMBERS.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C49022B IS
+ 
+      USE REPORT;
+ 
+      A : CONSTANT := 10;                     -- A =  10
+      B : CONSTANT := 25 - (2 * A);           -- B =   5
+      C : CONSTANT := A / B;                  -- C =   2
+      D : CONSTANT := (C * A) - (B - C);      -- D =  17
+      E : CONSTANT := D ** C;                 -- E = 289
+      F : CONSTANT := (E MOD A) + 1;          -- F =  10
+      G : CONSTANT := A REM B + C + D + E + ABS(-F);  -- G = 318
+      H : CONSTANT := BOOLEAN'POS (A > B);    -- H = 1
+      I : CONSTANT := BOOLEAN'POS (A < B);    -- I = 0
+      J : CONSTANT := BOOLEAN'POS (C >= A);   -- J = 0
+      K : CONSTANT := BOOLEAN'POS (B <= B);   -- K = 1
+      L : CONSTANT := BOOLEAN'POS (D = A);    -- L = 0
+      M : CONSTANT := BOOLEAN'POS (A /= F);   -- M = 0
+ 
+ BEGIN
+      TEST("C49022B","CHECK THAT IN NUMBER DECLARATIONS, IDENTIFIERS " &
+                     "CORRECTLY REPRESENT VALUES OF OTHER LITERALS");
+ 
+      IF G /= 318 THEN
+           FAILED("USE OF OTHER NUMBER DECLARATIONS GIVES " &
+                  "WRONG RESULTS");
+      END IF;
+ 
+      IF H /= 1 OR I /= 0 OR J /= 0 OR K /= 1 THEN
+           FAILED("USE OF NAMED NUMBERS AND RELATIONAL OPERATORS " &
+                  "GIVES WRONG RESULTS");
+      END IF;
+ 
+      IF L /= 0 OR M /= 0 THEN
+           FAILED("USE OF NAMED NUMBERS AND EQUALITY OPERATORS " &
+                  "GIVES WRONG RESULTS");
+      END IF;
+ 
+      RESULT;
+ 
+ END C49022B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49022c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49022c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49022c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49022c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C49022C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NAMED NUMBER DECLARATIONS (REAL) MAY USE EXPRESSIONS
+ -- WITH REALS.
+ 
+ -- BAW 29 SEPT 80
+ -- TBN 10/24/85     RENAMED FROM C4A011A.ADA. ADDED RELATIONAL
+ --                  OPERATORS AND NAMED NUMBERS.
+ 
+ WITH REPORT;
+ PROCEDURE C49022C IS
+ 
+      USE REPORT;
+ 
+      ADD1 : CONSTANT :=   2.5  +   1.5;
+      ADD2 : CONSTANT :=   2.5  + (-1.5);
+      ADD3 : CONSTANT := (-2.5) +   1.5;
+      ADD4 : CONSTANT := (-2.5) + (-1.5);
+      SUB1 : CONSTANT :=   2.5  -   1.5;
+      SUB2 : CONSTANT :=   2.5  - (-1.5);
+      SUB3 : CONSTANT := (-2.5) -   1.5;
+      SUB4 : CONSTANT := (-2.5) - (-1.5);
+      MUL1 : CONSTANT :=   2.5  *   1.5;
+      MUL2 : CONSTANT :=   2.5  * (-1.5);
+      MUL3 : CONSTANT := (-2.5) *   1.5;
+      MUL4 : CONSTANT := (-2.5) * (-1.5);
+      MLR1 : CONSTANT :=   2    *   1.5;
+      MLR2 : CONSTANT := (-2)   *   1.5;
+      MLR3 : CONSTANT :=   2    * (-1.5);
+      MLR4 : CONSTANT := (-2)   * (-1.5);
+      MLL1 : CONSTANT :=  1.5   *    2 ;
+      MLL2 : CONSTANT :=  1.5   *  (-2);
+      MLL3 : CONSTANT :=(-1.5)  *    2 ;
+      MLL4 : CONSTANT :=(-1.5)  *  (-2);
+      DIV1 : CONSTANT :=   3.75  /   2.5;
+      DIV2 : CONSTANT :=   3.75  / (-2.5);
+      DIV3 : CONSTANT := (-3.75) /   2.5;
+      DIV4 : CONSTANT := (-3.75) / (-2.5);
+      DVI1 : CONSTANT :=   3.0   /   2;
+      DVI2 : CONSTANT := (-3.0)  /   2;
+      DVI3 : CONSTANT :=   3.0   / (-2);
+      DVI4 : CONSTANT := (-3.0)  / (-2);
+      EXP1 : CONSTANT :=   2.0  **   1;
+      EXP2 : CONSTANT :=   2.0  ** (-1);
+      EXP3 : CONSTANT := (-2.0) **   1;
+      EXP4 : CONSTANT := (-2.0) ** (-1);
+      ABS1 : CONSTANT := ABS( - 3.75 );
+      ABS2 : CONSTANT := ABS( + 3.75 );
+      TOT1 : CONSTANT := ADD1 + SUB4 - MUL1 + DIV1 - EXP2 + ABS1;
+      LES1 : CONSTANT := BOOLEAN'POS (1.5 < 2.0);
+      LES2 : CONSTANT := BOOLEAN'POS (1.5 < (-2.0));
+      LES3 : CONSTANT := BOOLEAN'POS ((-1.5) < (-2.0));
+      LES4 : CONSTANT := BOOLEAN'POS (ADD2 < SUB1);
+      GRE1 : CONSTANT := BOOLEAN'POS (2.0 > 1.5);
+      GRE2 : CONSTANT := BOOLEAN'POS ((-2.0) > 1.5);
+      GRE3 : CONSTANT := BOOLEAN'POS ((-2.0) > (-1.5));
+      GRE4 : CONSTANT := BOOLEAN'POS (ADD1 > SUB1);
+      LEQ1 : CONSTANT := BOOLEAN'POS (1.5 <= 2.0);
+      LEQ2 : CONSTANT := BOOLEAN'POS (1.5 <= (-2.0));
+      LEQ3 : CONSTANT := BOOLEAN'POS ((-1.5) <= (-2.0));
+      LEQ4 : CONSTANT := BOOLEAN'POS (ADD2 <= SUB1);
+      GEQ1 : CONSTANT := BOOLEAN'POS (2.0 >= 1.5);
+      GEQ2 : CONSTANT := BOOLEAN'POS ((-2.0) >= 1.5);
+      GEQ3 : CONSTANT := BOOLEAN'POS ((-2.0) >= (-1.5));
+      GEQ4 : CONSTANT := BOOLEAN'POS (ADD1 >= SUB2);
+      EQU1 : CONSTANT := BOOLEAN'POS (1.5 = 2.0);
+      EQU2 : CONSTANT := BOOLEAN'POS ((-1.5) = 2.0);
+      EQU3 : CONSTANT := BOOLEAN'POS ((-1.5) = (-1.5));
+      EQU4 : CONSTANT := BOOLEAN'POS (ADD1 = SUB2);
+      NEQ1 : CONSTANT := BOOLEAN'POS (1.5 /= 1.5);
+      NEQ2 : CONSTANT := BOOLEAN'POS ((-1.5) /= 1.5);
+      NEQ3 : CONSTANT := BOOLEAN'POS ((-1.5) /= (-2.0));
+      NEQ4 : CONSTANT := BOOLEAN'POS (ADD1 /= SUB2);
+ 
+ 
+ BEGIN
+      TEST("C49022C","CHECK THAT NAMED NUMBER DECLARATIONS (REAL) " &
+                     "MAY USE EXPRESSIONS WITH REALS.");
+ 
+      IF ADD1 /= 4.0 OR ADD2 /= 1.0 OR ADD3 /= -1.0 OR ADD4 /= -4.0 THEN
+           FAILED("ERROR IN THE ADDING OPERATOR +");
+      END IF;
+ 
+      IF SUB1 /= 1.0 OR SUB2 /= 4.0 OR SUB3 /= -4.0 OR SUB4 /= -1.0 THEN
+           FAILED("ERROR IN THE ADDING OPERATOR -");
+      END IF;
+ 
+      IF MUL1 /= 3.75 OR MUL2 /= -3.75 OR
+         MUL3 /= -3.75 OR MUL4 /= 3.75 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+      END IF;
+ 
+      IF MLR1 /= 3.0 OR MLR2 /= -3.0 OR
+         MLR3 /= -3.0 OR MLR4 /= 3.0 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+      END IF;
+ 
+      IF MLL1 /= 3.0 OR MLL2 /= -3.0 OR MLL3 /= -3.0 OR MLL4 /= 3.0 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+      END IF;
+ 
+      IF DIV1 /= 1.5 OR DIV2 /= -1.5 OR DIV3 /= -1.5 OR DIV4 /= 1.5 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
+      END IF;
+ 
+      IF DVI1 /= 1.5 OR DVI2 /= -1.5 OR DVI3 /= -1.5 OR DVI4 /= 1.5 THEN
+           FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
+      END IF;
+ 
+      IF EXP1 /= 2.0 OR EXP2 /= 0.5 OR EXP3 /= -2.0 OR EXP4 /= -0.5 THEN
+           FAILED("ERROR IN THE EXPONENTIATING OPERATOR");
+      END IF;
+ 
+      IF ABS1 /= 3.75 OR ABS2 /= 3.75 THEN
+           FAILED("ERROR IN THE ABS OPERATOR");
+      END IF;
+ 
+      IF TOT1 /= 4.00 THEN
+           FAILED("ERROR IN USE OF NAMED NUMBERS WITH OPERATORS");
+      END IF;
+ 
+      IF LES1 /= 1 OR LES2 /= 0 OR LES3 /= 0 OR LES4 /= 0 THEN
+           FAILED("ERROR IN THE LESS THAN OPERATOR");
+      END IF;
+ 
+      IF GRE1 /= 1 OR GRE2 /= 0 OR GRE3 /= 0 OR GRE4 /= 1 THEN
+           FAILED("ERROR IN THE GREATER THAN OPERATOR");
+      END IF;
+ 
+      IF LEQ1 /= 1 OR LEQ2 /= 0 OR LEQ3 /= 0 OR LEQ4 /= 1 THEN
+           FAILED("ERROR IN THE LESS THAN EQUAL OPERATOR");
+      END IF;
+ 
+      IF GEQ1 /= 1 OR GEQ2 /= 0 OR GEQ3 /= 0 OR GEQ4 /= 1 THEN
+           FAILED("ERROR IN THE GREATER THAN EQUAL OPERATOR");
+      END IF;
+ 
+      IF EQU1 /= 0 OR EQU2 /= 0 OR EQU3 /= 1 OR EQU4 /= 1 THEN
+           FAILED("ERROR IN THE EQUAL OPERATOR");
+      END IF;
+ 
+      IF NEQ1 /= 0 OR NEQ2 /= 1 OR NEQ3 /= 1 OR NEQ4 /= 0 THEN
+           FAILED("ERROR IN THE NOT EQUAL OPERATOR");
+      END IF;
+ 
+      RESULT;
+ 
+ END C49022C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49023a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49023a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49023a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49023a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C49023A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CONSTANT DECLARED BY AN OBJECT DECLARATION CAN BE USED
+ -- IN A STATIC EXPRESSION IF THE CONSTANT WAS DECLARED WITH A STATIC
+ -- SUBTYPE AND INITIALIZED WITH A STATIC EXPRESSION.
+ 
+ -- L.BROWN  10/01/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  C49023A  IS
+ 
+ BEGIN
+      TEST("C49023A","A CONSTANT DECLARED BY AN OBJECT DECLARATION "&
+                     "UNDER CERTAIN CONDITIONS CAN BE USED IN A "&
+                     "STATIC EXPRESSION");
+      DECLARE
+           TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
+           SUBTYPE SENUM IS ENUM RANGE RED .. BLUE;
+           CONEN : CONSTANT SENUM := GREEN;
+           TYPE INT IS RANGE 1 .. 10;
+           SUBTYPE SINT IS INT RANGE 1 .. 5;
+           CONIN : CONSTANT SINT := 3;
+           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
+           SUBTYPE SFLT IS FLT RANGE 10.0 .. 20.0;
+           CONFL : CONSTANT SFLT := 11.0;
+           TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 25.0;
+           SUBTYPE SFIX IS FIX RANGE 0.0 .. 12.0;
+           CONFI : CONSTANT SFIX := 0.25;
+           CAS_EN : ENUM := CONEN;
+           TYPE ITEG IS RANGE 1 .. CONIN;
+           TYPE FLTY IS DIGITS CONIN;
+           TYPE FIXY IS DELTA CONFI RANGE 0.0 .. 10.0;
+           TYPE REAL IS DELTA 0.25 RANGE 0.0 .. 11.0;
+           TYPE FIXTY IS DELTA 0.25 RANGE 0.0 .. CONFL;
+ 
+           FUNCTION IDENT_REAL (X : REAL) RETURN REAL;
+ 
+           PACKAGE P IS
+                TYPE T IS PRIVATE;
+                CON1 : CONSTANT T;
+           PRIVATE
+                TYPE T IS NEW INTEGER;
+                CON1 : CONSTANT T := 10;
+                TYPE NINT IS RANGE 1 .. CON1;
+           END P;
+           PACKAGE BODY P IS
+                TYPE CON2 IS RANGE CON1 .. 50;
+           BEGIN
+                IF NINT'LAST /= NINT(IDENT_INT(10)) THEN
+                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 1");
+                END IF;
+                IF CON2'FIRST /= CON2(IDENT_INT(10)) THEN
+                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 2");
+                END IF;
+           END P;
+ 
+           FUNCTION IDENT_REAL (X : REAL) RETURN REAL IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN X;
+                ELSE
+                     RETURN 0.0;
+                END IF;
+           END IDENT_REAL;
+ 
+      BEGIN
+ 
+           IF ITEG'LAST /= ITEG(IDENT_INT(3))  THEN
+                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 3");
+           END IF;
+ 
+           IF FLTY'DIGITS /= IDENT_INT(3)  THEN
+                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 4");
+           END IF;
+ 
+           IF FIXY'DELTA /= IDENT_REAL(0.25)  THEN
+                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 5");
+           END IF;
+ 
+           IF FIXTY'LAST /= FIXTY(IDENT_REAL(11.0)) THEN
+                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 6");
+           END IF;
+ 
+           CASE CAS_EN IS
+                WHEN CONEN =>
+                     CAS_EN := RED;
+                WHEN OTHERS =>
+                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 7");
+           END CASE;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C49023A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49024a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49024a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49024a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49024a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- C49024A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A FUNCTION CALL CAN APPEAR IN A STATIC EXPRESSION IF THE
+ -- FUNCTION NAME DENOTES A PREDEFINED OPERATOR AND HAS THE FORM OF AN
+ -- OPERATOR SYMBOL OR AN EXPANDED NAME WHOSE SELECTOR IS AN OPERATOR
+ -- SYMBOL.
+ 
+ -- L.BROWN  10/02/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  C49024A  IS
+ 
+      PACKAGE P IS
+           TYPE TY IS NEW INTEGER;
+      END P;
+ 
+      CON1 : CONSTANT P.TY := 3;
+      CON2 : CONSTANT P.TY := 4;
+      TYPE INT1 IS RANGE 1 .. P."+"(CON1,CON2);
+      CON3 : CONSTANT := 5;
+      CON4 : CONSTANT := 7;
+      TYPE FLT IS DIGITS "-"(CON4,CON3);
+      TYPE FIX1 IS DELTA 1.0 RANGE 0.0 .. 25.0;
+      CON5 : CONSTANT := 3.0;
+      CON6 : CONSTANT := 6.0;
+      TYPE FIX2 IS DELTA 1.0 RANGE 0.0 .. "/"(CON6,CON5);
+      TYPE ENUM IS (RED,BLUE,GREEN,BLACK);
+      CON7 : CONSTANT BOOLEAN := TRUE;
+      CON8 : CONSTANT ENUM := BLUE;
+      CAS_INT1 : CONSTANT := 10;
+      CAS_INT2 : CONSTANT := 2;
+      OBJ1 : INTEGER := 10;
+      CAS_BOL : BOOLEAN := TRUE;
+      CON9 : CONSTANT ENUM := BLACK;
+      CON10 : CONSTANT FIX1 := 2.0;
+      CON11 : CONSTANT FIX1 := 10.0;
+      TYPE FIX3 IS DELTA "+"(CON10) RANGE 0.0 .. 20.0;
+      TYPE INT2 IS RANGE 0 .. "ABS"("-"(CON4));
+      CON12 : CONSTANT CHARACTER := 'D';
+      CON13 : CONSTANT CHARACTER := 'B';
+      CON14 : CONSTANT BOOLEAN := FALSE;
+      CON15 : CONSTANT := 10;
+ 
+ BEGIN
+ 
+      TEST("C49024A","A FUNCTION CALL CAN BE IN A STATIC EXPRESSION "&
+                     "IF THE FUNCTION NAME DENOTES A PREDEFINED "&
+                     "OPERATOR AND HAS THE FORM OF AN OPERATOR SYMBOL");
+ 
+      CASE CAS_BOL IS
+           WHEN ("NOT"(CON7)) =>
+                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                       "OPERATORS 1");
+           WHEN ("/="(CON8,CON9)) =>
+                OBJ1 := 2;
+      END CASE;
+      CAS_BOL := TRUE;
+ 
+      CASE CAS_BOL IS
+           WHEN ("*"(CON3,CON4) = CAS_INT1) =>
+                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                       "OPERATORS 2");
+           WHEN ("ABS"(CON15) = CAS_INT1) =>
+                OBJ1 := 3;
+      END CASE;
+      CAS_BOL := TRUE;
+ 
+      CASE CAS_BOL IS
+           WHEN ("<"(CON11,CON10)) =>
+                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                       "OPERATORS 3");
+           WHEN ("<="(CON13,CON12)) =>
+                OBJ1 := 4;
+      END CASE;
+      CAS_BOL := TRUE;
+ 
+      CASE CAS_BOL IS
+           WHEN ("REM"(CON4,CON3) = CAS_INT2) =>
+                OBJ1 := 5;
+           WHEN ("**"(CON3,CON4) = CAS_INT2) =>
+                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                       "OPERATORS 4");
+      END CASE;
+ 
+      CASE CAS_BOL IS
+           WHEN (P.">"(CON1,CON2)) =>
+                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                       "OPERATORS 5");
+           WHEN ("OR"(CON7,CON14)) =>
+                OBJ1 := 6;
+      END CASE;
+      CAS_BOL := TRUE;
+ 
+      CASE CAS_BOL IS
+           WHEN ("MOD"(CON4,CON3) = CAS_INT2) =>
+                OBJ1 := 7;
+           WHEN ("ABS"(CON4) = CAS_INT2) =>
+                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                       "OPERATORS 6");
+      END CASE;
+ 
+      CASE CAS_BOL IS
+           WHEN ("AND"(CON7,CON14)) =>
+                FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                       "OPERATORS 7");
+           WHEN (">="(CON12,CON13)) =>
+                OBJ1 := 9;
+      END CASE;
+ 
+      RESULT;
+ 
+ END C49024A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49025a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49025a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49025a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49025a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C49025A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CERTAIN ATTRIBUTES CAN BE USED IN STATIC EXPRESSIONS
+ -- SUCH AS: 'SUCC, 'PRED, 'POS, 'VAL, 'AFT, 'DELTA, 'DIGITS, 'FIRST,
+ --'FORE, 'LAST, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_MANTISSA, 
+ --'MACHINE_OVERFLOWS, 'MACHINE_RADIX, 'MACHINE_ROUNDS, 'SIZE, 'SMALL, 'WIDTH.
+ 
+ -- L.BROWN  10/07/86
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C49025A  IS
+ 
+      TYPE ENUM IS (RED,BLUE,GREEN,BLACK);
+      TYPE FIX IS DELTA 0.125 RANGE 0.0 .. 20.0;
+      TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
+      TYPE INT IS RANGE 1 .. 100;
+      TYPE TINT1 IS RANGE 1 .. ENUM'POS(BLUE);
+      TYPE TFLT IS DIGITS FIX'AFT RANGE 0.0 .. 10.0;
+      TYPE TFIX2 IS DELTA FIX'DELTA RANGE 0.0 .. 5.0;
+      TYPE TFLT1 IS DIGITS FLT'DIGITS;
+      TYPE ITN IS RANGE 0 .. INT'FIRST;
+      TYPE TINT2 IS RANGE 1 .. FIX'FORE;
+      TYPE TFLT3 IS DIGITS 3 RANGE 5.0 .. FLT'LAST;
+      CON3 : CONSTANT := FLT'MACHINE_EMAX;
+      TYPE TINT3 IS RANGE FLT'MACHINE_EMIN .. 1;
+      CON4 : CONSTANT := FLT'MACHINE_MANTISSA;
+      TYPE TINT4 IS RANGE 1 .. FLT'MACHINE_RADIX;
+      CON6 : CONSTANT := INT'SIZE;
+      TYPE TFIX5 IS DELTA 0.125 RANGE 0.0 .. FIX'SMALL;
+      TYPE TINT6 IS RANGE 1 .. ENUM'WIDTH;
+      OBJ1 : INTEGER := 1;
+      CAS_OBJ : BOOLEAN := TRUE;
+ 
+ BEGIN
+ 
+      TEST("C49025A","CHECK THAT CERTAIN ATTRIBUTES CAN "&
+                     "BE USED IN STATIC EXPRESSIONS.");
+ 
+      CASE CAS_OBJ IS
+           WHEN (ENUM'PRED(BLUE) = ENUM'(RED)) =>
+                OBJ1 := 2;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 1");
+      END CASE;
+      CAS_OBJ := TRUE;
+ 
+      CASE CAS_OBJ IS
+           WHEN (ENUM'SUCC(RED) = ENUM'(BLUE)) =>
+                OBJ1 := 3;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 2");
+      END CASE;
+      CAS_OBJ := TRUE;
+ 
+      CASE CAS_OBJ IS
+           WHEN (ENUM'VAL(3) = ENUM'(BLACK)) =>
+                OBJ1 := 4;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 3");
+      END CASE;
+      CAS_OBJ := TRUE;
+ 
+      CASE CAS_OBJ IS
+           WHEN (TRUE OR FLT'MACHINE_OVERFLOWS) =>
+                OBJ1 := 5;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 4");
+      END CASE;
+      CAS_OBJ := FALSE;
+ 
+      CASE CAS_OBJ IS
+           WHEN (FALSE AND FIX'MACHINE_ROUNDS) =>
+                OBJ1 := 6;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 5");
+      END CASE;
+ 
+      RESULT;
+ 
+ END C49025A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49026a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49026a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c49026a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c49026a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- C49026A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A QUALIFIED EXPRESSION CAN APPEAR IN A STATIC EXPRESSION.
+ 
+ -- L.BROWN  10/07/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  C49026A  IS
+ 
+      TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
+      TYPE INT1 IS RANGE 1 .. 50;
+      TYPE FLT1 IS DIGITS 3 RANGE 1.0 .. 5.0;
+      TYPE FIX1 IS DELTA 0.125 RANGE 0.0 .. 10.0;
+      TYPE INT2 IS RANGE 1 .. INT1'(25);
+      TYPE FLT2 IS DIGITS 3 RANGE 1.0 .. FLT1'(2.0);
+      TYPE FIX2 IS DELTA 0.125 RANGE 0.0 .. FIX1'(5.0);
+      TYPE FLT3 IS DIGITS INT1'(3);
+      TYPE FIX3 IS DELTA FIX1'(0.125) RANGE 0.0 .. 5.0;
+      OBJ1 : INTEGER := 2;
+      CAS_OBJ : ENUM := GREEN;
+ 
+ BEGIN
+ 
+      TEST("C49026A","QUALIFIED EXPRESSIONS CAN APPEAR IN STATIC "&
+                     "EXPRESSIONS");
+ 
+      CASE CAS_OBJ IS
+           WHEN ENUM'(GREEN) =>
+                OBJ1 := 3;
+           WHEN OTHERS =>
+                FAILED("INCORRECT VALUE FOR QUALIFIED EXPRESSION 1");
+      END CASE;
+ 
+      RESULT;
+ 
+ END C49026A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C4A005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A NONSTATIC UNIVERSAL INTEGER EXPRESSION RAISES
+ -- CONSTRAINT_ERROR IF DIVISION BY ZERO IS ATTEMPTED
+ -- OR IF THE SECOND OPERAND OF REM OR MOD IS ZERO.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- JBG 5/2/85
+ -- EG  10/24/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --               AI-00387; PREVENT DEAD VARIABLE OPTIMIZATION
+ -- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C4A005B IS
+ BEGIN
+      TEST("C4A005B", "CHECK CONSTRAINT_ERROR FOR " &
+                      "NONSTATIC UNIVERSAL " &
+                      "INTEGER EXPRESSIONS - DIVISION BY ZERO");
+      BEGIN
+           DECLARE
+                X : BOOLEAN := 1 = 1/INTEGER'POS(IDENT_INT(0));
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - DIV");
+                IF X /= IDENT_BOOL(X) THEN
+                     FAILED ("WRONG RESULT - DIV");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION IN WRONG PLACE - DIV");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED FOR / BY 0");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - DIV");
+      END;
+ 
+      BEGIN
+           DECLARE
+                X : BOOLEAN := 1 = 1 REM INTEGER'POS(IDENT_INT(0));
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - REM");
+                IF X /= IDENT_BOOL(X) THEN
+                     FAILED ("WRONG RESULT - REM");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION IN WRONG PLACE - REM");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED FOR REM BY 0");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - REM");
+      END;
+ 
+      BEGIN
+           DECLARE
+                X : BOOLEAN := 1 = INTEGER'POS(IDENT_INT(1)) MOD 0;
+           BEGIN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED - MOD");
+                IF X /= IDENT_BOOL(X) THEN
+                     FAILED ("WRONG RESULT - MOD");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION IN WRONG PLACE - MOD");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED FOR MOD BY 0");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - MOD");
+      END;
+ 
+      RESULT;
+ 
+ END C4A005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,61 ----
+ -- C4A006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A UNIVERSAL_INTEGER 
+ -- EXPRESSION CONTAINING AN EXPONENTIATION OPERATOR IF THE EXPONENT
+ -- HAS A NEGATIVE VALUE.
+ 
+ -- BAW 9/29/80
+ -- SPS 4/7/82
+ -- TBN 10/23/85     RENAMED FROM B4A006A-B.ADA. REVISED TO CHECK FOR
+ --                  CONSTRAINT_ERROR WHEN EXPONENT IS NEGATIVE IN
+ --                  A NONSTATIC CONTEXT.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C4A006A IS
+ 
+ BEGIN 
+      TEST ("C4A006A", "CHECK THAT A NEGATIVE EXPONENT IN " &
+                       "UNIVERSAL_INTEGER EXPONENTIATION RAISES " &
+                       "CONSTRAINT_ERROR");
+ 
+      DECLARE
+           B : BOOLEAN;
+      BEGIN
+ 
+           B := (1 ** IDENT_INT(-1)) = 1;
+           FAILED ("EXCEPTION NOT RAISED");
+           IF NOT B THEN
+                FAILED ("(1 ** (-1)) /= 1");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;     
+ 
+      RESULT;
+ END C4A006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a007a.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a007a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a007a.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a007a.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,47 ----
+ -- C4A007A.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- USE OF MAX_INT IN NUMBER DECLARATION
+ 
+ -- BAW 29 SEPT 80
+ 
+ WITH REPORT;
+ PROCEDURE C4A007A IS
+ 
+      USE REPORT;
+ 
+      X : CONSTANT := $MAX_INT - ($MAX_INT MOD 2);
+      Y : CONSTANT := ($MAX_INT / 2) * 2;
+ 
+ BEGIN TEST("C4A007A","USING THE INTEGER VALUE  MAX_INT IN NUMBER " &
+            " DECLARATIONS ");
+ 
+       IF X /= Y
+       THEN FAILED("USING THE INTEGER VALUE MAX_INT GIVES " &
+                   " GIVES WRONG RESULTS ");
+       END IF;
+ 
+       RESULT;
+ 
+ END C4A007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C4A010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT STATIC UNIVERSAL_REAL EXPRESSIONS ARE EVALUATED EXACTLY.
+ 
+ -- SMALL RATIONAL NUMBERS ARE USED IN THIS TEST.
+ 
+ -- JBG 5/3/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C4A010A IS
+ 
+      C13 : CONSTANT := 1.0/3.0;
+      C47 : CONSTANT := 4.0/7.0;
+      C112: CONSTANT := 13.0/12.0;
+      HALF: CONSTANT := 3.5/7.0;
+ 
+ BEGIN
+ 
+      TEST ("C4A010A", "CHECK STATIC UNIVERSAL_REAL ACCURACY FOR " &
+                       "SMALL RATIONAL NUMBERS");
+ 
+      IF C13 - C47 /= -5.0/21.0 THEN
+           FAILED ("REAL SUBTRACTION RESULT INCORRECT");
+      END IF;
+ 
+      IF C47 + C112 = 1.0 + 55.0/84.0 THEN
+           NULL;
+      ELSE
+           FAILED ("REAL ADDITION RESULT INCORRECT");
+      END IF;
+ 
+      IF C112 - C13 /= 6.0/8.0 THEN
+           FAILED ("LCD NOT FOUND");
+      END IF;
+ 
+      IF 0.1 * 0.1 /= 0.01 THEN
+           FAILED ("REAL MULTIPLICATION RESULT INCORRECT");
+      END IF;
+ 
+      IF C112/C13 /= 13.0/4 THEN
+           FAILED ("REAL QUOTIENT RESULT INCORRECT");
+      END IF;
+ 
+      IF 0.1 ** 4 /= 0.0001 THEN
+           FAILED ("POSITIVE EXPONENTIATION RESULT INCORRECT");
+      END IF;
+ 
+      IF C13 ** (-3) /= 27.0 * 0.5 * 2 THEN
+           FAILED ("NEGATIVE EXPONENTIATION RESULT INCORRECT");
+      END IF;
+ 
+      IF HALF /= 0.1/0.2 THEN
+           FAILED ("FRACTIONAL NUMERATOR AND DENOMINATOR");
+      END IF;
+ 
+      RESULT;
+ 
+ END C4A010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a010b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a010b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a010b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a010b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C4A010B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT STATIC UNIVERSAL REAL EXPRESSIONS ARE EVALUATED 
+ -- EXACTLY.  IN PARTICULAR, CHECK THAT THE CASCADING USE OF FRACTIONAL
+ -- VALUES DOES NOT RESULT IN THE LOSS OF PRECISION.
+ 
+ -- RJW 7/31/86
+ 
+ WITH REPORT; USE REPORT; 
+ PROCEDURE C4A010B IS
+ 
+ 
+ BEGIN
+ 
+      TEST( "C4A010B", "CHECK THAT STATIC UNIVERSAL REAL EXPRESSIONS " &
+                       "ARE EVALUATED EXACTLY.  IN PARTICULAR, CHECK " &
+                       "THAT THE CASCADING USE OF FRACTIONAL VALUES " &
+                       "DOES NOT RESULT IN THE LOSS OF PRECISION" );
+ 
+      DECLARE
+           B : CONSTANT := 2.0/3.0;
+           
+           X0 : CONSTANT := 1.0;
+           X1 : CONSTANT := X0 + B;
+           X2 : CONSTANT := X1 + B ** 2;
+           X3 : CONSTANT := X2 + B ** 3;
+           X4 : CONSTANT := X3 + B ** 4;
+           X5 : CONSTANT := X4 + B ** 5;
+           X6 : CONSTANT := X5 + B ** 6;
+           X7 : CONSTANT := X6 + B ** 7;
+           X8 : CONSTANT := X7 + B ** 8;
+           X9 : CONSTANT := X8 + B ** 9;
+      
+           Y1 : CONSTANT := B ** 10;
+           Y2 : CONSTANT := 1.0;
+           Y3 : CONSTANT := Y1 - Y2;
+           Y4 : CONSTANT := B;
+           Y5 : CONSTANT := Y4 - Y2;
+           Y6 : CONSTANT := Y3 / Y5;
+ 
+      BEGIN
+           IF X9 /= 58025.0/19683.0 THEN
+                FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
+                         "NUMBERS  - 1" );
+           END IF;
+           
+           IF Y6 /= 58025.0/19683.0 THEN
+                FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
+                         "NUMBERS  - 2" );
+           END IF;
+           
+           IF X9 /= Y6 THEN
+                FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
+                         "NUMBERS  - 3" );
+           END IF;
+           
+      END;   
+      
+      RESULT;
+ END C4A010B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,334 ----
+ -- C4A011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NONSTATIC UNIVERSAL REAL EXPRESSIONS ARE EVALUATED WITH
+ -- THE ACCURACY OF THE MOST PRECISE PREDEFINED FLOATING POINT TYPE
+ -- (I. E., THE TYPE FOR WHICH 'DIGITS EQUALS SYSTEM.MAX_DIGITS).
+ 
+ -- RJW 8/4/86
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C4A011A IS
+ 
+      TYPE MAX_FLOAT IS DIGITS MAX_DIGITS;
+ 
+      C5L : CONSTANT := 16#0.AAAA8#;
+      C5U : CONSTANT := 16#0.AAAAC#;
+ 
+      C6L : CONSTANT := 16#0.AAAAA8#;
+      C6U : CONSTANT := 16#0.AAAAB0#;
+ 
+      C7L : CONSTANT := 16#0.AAAAAA8#;
+      C7U : CONSTANT := 16#0.AAAAAB0#;
+ 
+      C8L : CONSTANT := 16#0.AAAAAAA#;
+      C8U : CONSTANT := 16#0.AAAAAAB#;
+ 
+      C9L : CONSTANT := 16#0.AAAAAAAA#;
+      C9U : CONSTANT := 16#0.AAAAAAAC#;
+ 
+      C10L : CONSTANT := 16#0.AAAAAAAAA#;
+      C10U : CONSTANT := 16#0.AAAAAAAAC#;
+ 
+      C11L : CONSTANT := 16#0.AAAAAAAAA8#;
+      C11U : CONSTANT := 16#0.AAAAAAAAAC#;
+ 
+      C12L : CONSTANT := 16#0.AAAAAAAAAA8#;
+      C12U : CONSTANT := 16#0.AAAAAAAAAB0#;
+ 
+      C13L : CONSTANT := 16#0.AAAAAAAAAAA8#;
+      C13U : CONSTANT := 16#0.AAAAAAAAAAB0#;
+ 
+      C14L : CONSTANT := 16#0.AAAAAAAAAAAA#;
+      C14U : CONSTANT := 16#0.AAAAAAAAAAAB#;
+ 
+      C15L : CONSTANT := 16#0.AAAAAAAAAAAAA#;
+      C15U : CONSTANT := 16#0.AAAAAAAAAAAAC#;
+ 
+      C16L : CONSTANT := 16#0.AAAAAAAAAAAAAA#;
+      C16U : CONSTANT := 16#0.AAAAAAAAAAAAAC#;
+ 
+      C17L : CONSTANT := 16#0.AAAAAAAAAAAAAA8#;
+      C17U : CONSTANT := 16#0.AAAAAAAAAAAAAAC#;
+ 
+      C18L : CONSTANT := 16#0.AAAAAAAAAAAAAAA8#;
+      C18U : CONSTANT := 16#0.AAAAAAAAAAAAAAB0#;
+ 
+      C19L : CONSTANT := 16#0.AAAAAAAAAAAAAAAA8#;
+      C19U : CONSTANT := 16#0.AAAAAAAAAAAAAAAB0#;
+ 
+      C20L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAA#;
+      C20U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAB#;
+ 
+      C21L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAA#;
+      C21U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAC#;
+ 
+      C22L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAA#;
+      C22U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAC#;
+ 
+      C23L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAA8#;
+      C23U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAC#;
+ 
+      C24L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAA8#;
+      C24U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAB0#;
+ 
+      C25L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAA8#;
+      C25U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAB0#;
+ 
+      C26L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAA#;
+      C26U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAB#;
+ 
+      C27L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAA#;
+      C27U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAC#;
+ 
+      C28L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAA#;
+      C28U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAC#;
+ 
+      C29L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAA8#;
+      C29U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAC#;
+ 
+      C30L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAA8#;
+      C30U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAB0#;
+ 
+      C31L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAA#;
+      C31U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAB#;
+ 
+      C32L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAA#;
+      C32U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAB#;
+ 
+      C33L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAA#;
+      C33U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
+ 
+      C34L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAA8#;
+      C34U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
+ 
+      C35L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAA8#;
+      C35U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
+ 
+ BEGIN
+ 
+      TEST ( "C4A011A", "CHECK THAT NONSTATIC UNIVERSAL REAL " & 
+                        "EXPRESSIONS ARE EVALUATED WITH THE " &
+                        "ACCURACY OF THE MOST PRECISE PREDEFINED " &
+                        "FLOATING POINT TYPE (I. E., THE TYPE FOR " &
+                        "WHICH 'DIGITS EQUALS SYSTEM.MAX_DIGITS" );
+ 
+      CASE MAX_DIGITS IS
+           WHEN 5 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C5L ..  C5U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 5" );
+                END IF;
+           WHEN 6 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C6L ..  C6U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 6" );
+                END IF;
+           WHEN 7 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C7L ..  C7U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 7" );
+                END IF;
+           WHEN 8 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C8L ..  C8U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 8" );
+                END IF;
+           WHEN 9 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C9L ..  C9U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 9" );
+                END IF;
+           WHEN 10 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C10L ..  C10U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 10" );
+                END IF;
+           WHEN 11 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C11L ..  C11U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 11" );
+                END IF;
+           WHEN 12 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C12L ..  C12U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 12" );
+                END IF;
+           WHEN 13 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C13L ..  C13U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 13" );
+                END IF;
+           WHEN 14 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C14L ..  C14U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 14" );
+                END IF;
+           WHEN 15 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C15L ..  C15U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 15" );
+                END IF;
+           WHEN 16 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C16L ..  C16U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 16" );
+                END IF;
+           WHEN 17 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C17L ..  C17U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 17" );
+                END IF;
+           WHEN 18 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C18L ..  C18U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 18" );
+                END IF;
+           WHEN 19 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C19L ..  C19U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 19" );
+                END IF;
+           WHEN 20 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C20L ..  C20U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 20" );
+                END IF;
+           WHEN 21 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C21L ..  C21U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 21" );
+                END IF;
+           WHEN 22 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C22L ..  C22U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 22" );
+                END IF;
+           WHEN 23 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C23L ..  C23U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 23" );
+                END IF;
+           WHEN 24 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C24L ..  C24U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 24" );
+                END IF;
+           WHEN 25 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C25L ..  C25U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 25" );
+                END IF;
+           WHEN 26 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C26L ..  C26U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 26" );
+                END IF;
+           WHEN 27 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C27L ..  C27U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 27" );
+                END IF;
+           WHEN 28 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C28L ..  C28U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 28" );
+                END IF;
+           WHEN 29 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C29L ..  C29U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 29" );
+                END IF;
+           WHEN 30 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C30L ..  C30U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 30" );
+                END IF;
+           WHEN 31 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C31L ..  C31U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 31" );
+                END IF;
+           WHEN 32 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C32L ..  C32U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 32" );
+                END IF;
+           WHEN 33 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C33L ..  C33U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 33" );
+                END IF;
+           WHEN 34 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C34L ..  C34U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 34" );
+                END IF;
+           WHEN 35 =>
+                IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                   C35L ..  C35U THEN
+                     FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                              "VALUE OF 35" );
+                END IF;
+           WHEN OTHERS =>
+                NOT_APPLICABLE ( "MAX_DIGITS OUT OF RANGE OF TEST.  " &
+                                 "MAX_DIGITS = " & 
+                                  INTEGER'IMAGE (MAX_DIGITS));
+      END CASE;
+ 
+      RESULT;
+ 
+ END C4A011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a012b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a012b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a012b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a012b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,184 ----
+ -- C4A012B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR
+ --     A UNIVERSAL_REAL EXPRESSION IF DIVISION BY ZERO IS ATTEMPTED.
+ 
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR
+ --     0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT VALUE).
+ 
+ -- HISTORY:
+ --     RJW 09/04/86  CREATED ORIGINAL TEST.
+ --     CJJ 09/04/87  ADDED PASS MESSAGE FOR RAISING NUMERIC_ERROR;
+ --                   MODIFIED CODE TO PREVENT COMPILER OPTIMIZING
+ --                   OUT THE TEST.
+ --     JET 12/31/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
+ --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ --     JRL 02/29/96  Added code to check for value of Machine_Overflows; if
+ --                   False, test is inapplicable.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C4A012B IS
+ 
+      F : FLOAT;
+ 
+      I3 : INTEGER := -3;
+ 
+      SUBTYPE SINT IS INTEGER RANGE -10 .. 10;
+      SI5 : CONSTANT SINT := -5;
+ 
+      FUNCTION IDENT (X:FLOAT) RETURN FLOAT IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN X;
+           ELSE
+                RETURN 1.0;
+           END IF;
+      END IDENT;
+ 
+ BEGIN
+ 
+      TEST ( "C4A012B", "CHECK THAT CONSTRAINT_ERROR " &
+                        "IS RAISED FOR " &
+                        "0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT " &
+                        "VALUE)" );
+ 
+      IF FLOAT'MACHINE_OVERFLOWS = FALSE THEN
+         REPORT.NOT_APPLICABLE ("Float'Machine_Overflows = False");
+      ELSE
+ 
+         BEGIN
+              F := IDENT (0.0) ** (-1);
+              FAILED ( "THE EXPRESSION '0.0 ** (-1)' DID NOT RAISE " &
+                       "AN EXCEPTION" );
+              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                   COMMENT ("SHOULDN'T BE HERE!");
+              END IF;
+         EXCEPTION
+              WHEN CONSTRAINT_ERROR =>
+                   COMMENT ("CONSTRAINT_ERROR RAISED - 1");
+              WHEN OTHERS =>
+                   FAILED ( "THE EXPRESSION '0.0 ** (-1)' RAISED THE " &
+                            "WRONG EXCEPTION" );
+         END;
+ 
+         BEGIN
+              F := 0.0 ** (IDENT_INT (-1));
+              FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' DID " &
+                        "NOT RAISE AN EXCEPTION" );
+              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                   COMMENT ("SHOULDN'T BE HERE!");
+              END IF;
+         EXCEPTION
+              WHEN CONSTRAINT_ERROR =>
+                   COMMENT ("CONSTRAINT_ERROR RAISED - 2");
+              WHEN OTHERS =>
+                   FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' " &
+                            "RAISED THE WRONG EXCEPTION" );
+         END;
+ 
+         BEGIN
+              F := 0.0 ** (INTEGER'POS (IDENT_INT (-1)));
+              FAILED ( "THE EXPRESSION '0.0 ** " &
+                       "(INTEGER'POS (IDENT_INT (-1)))' DID " &
+                       "NOT RAISE AN EXCEPTION" );
+              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                   COMMENT ("SHOULDN'T BE HERE!");
+              END IF;
+         EXCEPTION
+              WHEN CONSTRAINT_ERROR =>
+                   COMMENT ("CONSTRAINT_ERROR RAISED - 3");
+              WHEN OTHERS =>
+                   FAILED ( "THE EXPRESSION '0.0 ** " &
+                            "(INTEGER'POS (IDENT_INT (-1)))' RAISED " &
+                            "THE WRONG EXCEPTION" );
+         END;
+ 
+         BEGIN
+              F := IDENT(0.0) ** I3;
+              FAILED ( "THE EXPRESSION '0.0 ** I3' DID NOT RAISE " &
+                        "AN EXCEPTION" );
+              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                   COMMENT ("SHOULDN'T BE HERE!");
+              END IF;
+         EXCEPTION
+              WHEN CONSTRAINT_ERROR =>
+                   COMMENT ("CONSTRAINT_ERROR RAISED - 4");
+              WHEN OTHERS =>
+                   FAILED ( "THE EXPRESSION '0.0 ** I3' RAISED THE " &
+                            "WRONG EXCEPTION" );
+         END;
+ 
+         BEGIN
+              F := 0.0 ** (IDENT_INT (I3));
+              FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' DID " &
+                       "NOT RAISE AN EXCEPTION" );
+              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                   COMMENT ("SHOULDN'T BE HERE!");
+              END IF;
+         EXCEPTION
+              WHEN CONSTRAINT_ERROR =>
+                   COMMENT ("CONSTRAINT_ERROR RAISED - 5");
+              WHEN OTHERS =>
+                   FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' " &
+                             "RAISED THE WRONG EXCEPTION" );
+         END;
+ 
+         BEGIN
+              F := IDENT (0.0) ** SI5;
+              FAILED ( "THE EXPRESSION '0.0 ** SI5' DID NOT RAISE " &
+                        "AN EXCEPTION" );
+              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                   COMMENT ("SHOULDN'T BE HERE!");
+              END IF;
+         EXCEPTION
+              WHEN CONSTRAINT_ERROR =>
+                   COMMENT ("CONSTRAINT_ERROR RAISED - 6");
+              WHEN OTHERS =>
+                   FAILED ( "THE EXPRESSION '0.0 ** SI5' RAISED THE " &
+                            "WRONG EXCEPTION" );
+         END;
+ 
+         BEGIN
+              F := 0.0 ** (IDENT_INT (SI5));
+              FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' DID " &
+                       "NOT RAISE AN EXCEPTION" );
+              IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                   COMMENT ("SHOULDN'T BE HERE!");
+              END IF;
+         EXCEPTION
+              WHEN CONSTRAINT_ERROR =>
+                   COMMENT ("CONSTRAINT_ERROR RAISED - 7");
+              WHEN OTHERS =>
+                   FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' " &
+                             "RAISED THE WRONG EXCEPTION" );
+         END;
+ 
+      END IF;
+ 
+      RESULT;
+ 
+ END C4A012B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a013a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a013a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a013a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C4A013A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A NONSTATIC
+ -- UNIVERSAL_REAL EXPRESSION IF THE VALUE WOULD LIE OUTSIDE THE RANGE OF
+ -- THE BASE TYPE OF THE MOST ACCURATE PREDEFINED FLOATING POINT TYPE AND
+ -- MACHINE_OVERFLOWS IS TRUE FOR THAT TYPE.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- BAW 29 SEPT 80
+ -- TBN 10/30/85     RENAMED FROM C4A013A.ADA.
+ -- JRK 1/13/86      COMPLETELY REVISED TO CHECK NONSTATIC UNIVERSAL_REAL
+ --                  EXPRESSIONS WHOSE RESULTS OVERFLOW.  REVISED
+ --                  NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --                  AI-00387.
+ -- MRM 03/30/93     REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH SYSTEM, REPORT;
+ USE SYSTEM, REPORT;
+ 
+ PROCEDURE C4A013A IS
+ 
+      TYPE F IS DIGITS MAX_DIGITS;
+ 
+      B : BOOLEAN;
+ 
+ BEGIN
+      TEST ("C4A013A", "CHECK NONSTATIC UNIVERSAL_REAL EXPRESSIONS " &
+                       "WHOSE RESULTS OVERFLOW");
+ 
+      BEGIN
+           B := 1.0 < 1.0 / (1.0 * INTEGER'POS (IDENT_INT (0)));
+ 
+           IF F'MACHINE_OVERFLOWS THEN
+                FAILED ("MACHINE_OVERFLOWS IS TRUE, BUT NO EXCEPTION " &
+                        "WAS RAISED");
+           ELSE COMMENT ("MACHINE_OVERFLOWS IS FALSE AND NO EXCEPTION " &
+                         "WAS RAISED");
+           END IF;
+ 
+           IF NOT B THEN  -- USE B TO PREVENT DEAD VARIABLE OPTIMIZATION.
+                COMMENT ("1.0 < 1.0 / 0.0 YIELDS FALSE");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ END C4A013A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a014a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c4/c4a014a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c4/c4a014a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C4A014A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ROUNDING IS DONE CORRECTLY FOR STATIC UNIVERSAL REAL
+ -- EXPRESSIONS.
+ 
+ -- JBG 5/3/85
+ -- JBG 11/3/85   DECLARE INTEGER CONSTANTS INSTEAD OF UNIVERSAL INTEGER
+ -- DTN 11/27/91  DELETED SUBPART (B).
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C4A014A IS
+ 
+      C15  : CONSTANT := 1.5;
+      C25  : CONSTANT := 2.5;
+      CN15 : CONSTANT := -1.5;
+      CN25 : CONSTANT := -2.5;
+ 
+      C15R  : CONSTANT INTEGER := INTEGER(C15);
+      C25R  : CONSTANT INTEGER := INTEGER(C25);
+      CN15R : CONSTANT INTEGER := INTEGER(CN15);
+      CN25R : CONSTANT INTEGER := INTEGER(CN25);
+ 
+      C15_1   : BOOLEAN := 1 = C15R;
+      C15_2   : BOOLEAN := 2 = C15R;
+      C25_2   : BOOLEAN := 2 = C25R;
+      C25_3   : BOOLEAN := 3 = C25R;
+ 
+      CN15_N1 : BOOLEAN := -1 = CN15R;
+      CN15_N2 : BOOLEAN := -2 = CN15R;
+      CN25_N2 : BOOLEAN := -2 = CN25R;
+      CN25_N3 : BOOLEAN := -3 = CN25R;
+ 
+ BEGIN
+ 
+      TEST ("C4A014A", "CHECK ROUNDING TO INTEGER FOR UNIVERSAL REAL " &
+                       "EXPRESSIONS");
+ 
+      IF 1 /= INTEGER(1.4) THEN
+           FAILED ("INTEGER(1.4) DOES NOT EQUAL 1");
+      END IF;
+ 
+      IF 2 /= INTEGER(1.6) THEN
+           FAILED ("INTEGER(1.6) DOES NOT EQUAL 2");
+      END IF;
+ 
+      IF -1 /= INTEGER(-1.4) THEN
+           FAILED ("INTEGER(-1.4) DOES NOT EQUAL -1");
+      END IF;
+ 
+      IF -2 /= INTEGER(-1.6) THEN
+           FAILED ("INTEGER(-1.6) DOES NOT EQUAL -2");
+      END IF;
+ 
+      IF NOT (C15_1 OR C15_2) OR (NOT (C25_2 OR C25_3)) THEN
+           FAILED ("ROUNDING OF POSITIVE VALUES NOT CORRECT");
+      END IF;
+ 
+      IF NOT (CN15_N1 OR CN15_N2) OR (NOT (CN25_N2 OR CN25_N3)) THEN
+           FAILED ("ROUNDING OF NEGATIVE VALUES NOT CORRECT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C4A014A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c51004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c51004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c51004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c51004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,261 ----
+ -- C51004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LABELS, LOOP IDENTIFIERS, AND BLOCK IDENTIFIERS ARE
+ -- IMPLICITLY DECLARED AT THE END OF THE DECLARATIVE PART.  PRIOR TO
+ -- THE END OF THE DECLARATIVE PART, THEY MAY BE USED TO REFERENCE
+ -- ENTITIES IN AN ENCLOSING SCOPE.  SUBTESTS ARE:
+ --        (A) BLOCK.
+ --        (B) PROCEDURE BODY.
+ --        (C) PACKAGE BODY.
+ --        (D) GENERIC FUNCTION BODY.
+ --        (E) GENERIC PACKAGE BODY.
+ --        (F) TASK BODY.
+ 
+ -- CPP  6/1/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C51004A IS
+ 
+ BEGIN
+      TEST("C51004A", "CHECK THAT LABELS, LOOP IDENTIFIERS, AND BLOCK " &
+           "IDENTIFIERS MAY BE USED PRIOR TO THEIR IMPLICIT " &
+           "DECLARATION");
+ 
+ OUTER: DECLARE
+ 
+           TYPE IDN1 IS NEW INTEGER;
+           IDN2 : CONSTANT INTEGER := 2;
+           TYPE IDN3 IS ACCESS INTEGER;
+ 
+      BEGIN     -- OUTER
+ 
+      -----------------------------------------------
+ 
+      A :  DECLARE
+ 
+                A1 : IDN1;
+                A2 : CONSTANT INTEGER := IDN2;
+                A3 : IDN3;
+ 
+                TEMP : INTEGER;
+ 
+           BEGIN     -- A
+ 
+            <<IDN1>> TEMP := 0;
+ 
+              IDN2 : FOR I IN 1..1 LOOP
+                          TEMP := A2;
+                     END LOOP IDN2;
+ 
+              IDN3 : BEGIN
+                          NULL;
+                     END IDN3;
+ 
+           END A;
+ 
+      -----------------------------------------------
+ 
+      B :  DECLARE
+ 
+                PROCEDURE P (TEMP : OUT INTEGER) IS
+ 
+                     B1 : IDN1;
+                     B2 : CONSTANT INTEGER := IDN2 + 2;
+                     B3 : IDN3;
+ 
+                BEGIN     -- P
+                
+           <<L>> <<IDN1>> TEMP := 0;
+ 
+                   IDN2 : WHILE B2 < 0 LOOP
+                               TEMP := 0;
+                          END LOOP IDN2;
+ 
+                   IDN3 : DECLARE
+                          BEGIN
+                               NULL;
+                          END IDN3;
+ 
+                END P;
+ 
+           BEGIN     -- B
+                NULL;
+           END B;
+ 
+      -----------------------------------------------
+ 
+      C :  DECLARE
+ 
+                PACKAGE PKG IS
+                END PKG;
+ 
+                PACKAGE BODY PKG IS
+ 
+                     C1 : IDN1;
+                     C2 : CONSTANT INTEGER := 2 * IDN2;
+                     C3 : IDN3;
+ 
+                     TEMP : INTEGER;
+ 
+                BEGIN
+ 
+                 <<IDN1>> TEMP := 0;
+ 
+                   IDN2 : LOOP
+                               TEMP := 0;
+                               EXIT;          
+                          END LOOP IDN2;
+ 
+                   IDN3 : BEGIN
+                               NULL;
+                          END IDN3;
+ 
+                END PKG;
+ 
+           BEGIN     -- C
+                NULL;
+           END C;
+ 
+      ---------------------------------------------------
+ 
+      D :  DECLARE
+ 
+                GENERIC
+                     TYPE Q IS (<>);
+                FUNCTION FN RETURN INTEGER;
+ 
+                FUNCTION FN RETURN INTEGER IS
+ 
+                     D1 : IDN1;
+                     D2 : CONSTANT INTEGER := IDN2;
+                     D3 : IDN3;
+ 
+                     TEMP : INTEGER;
+ 
+                BEGIN     
+ 
+                 <<IDN1>> TEMP := 0;
+ 
+                   IDN2 : FOR I IN 1..5 LOOP
+                               TEMP := 0;
+                          END LOOP IDN2;
+ 
+                   IDN3 : BEGIN
+                               NULL;
+                          END IDN3;  
+                     
+                          RETURN TEMP;
+ 
+                END FN;
+ 
+           BEGIN
+                NULL;
+           END D;
+ 
+      -----------------------------------------------
+ 
+      E :  DECLARE
+ 
+                GENERIC
+ 
+                     TYPE ELEMENT IS (<>);
+                     ITEM : ELEMENT;
+ 
+                PACKAGE PKG IS
+                END PKG;
+ 
+                PACKAGE BODY PKG IS
+ 
+                     E1 : IDN1 RANGE 1..5;
+                     E2 : CONSTANT INTEGER := IDN2;
+                     E3 : IDN3;
+ 
+                     TEMP : ELEMENT;
+ 
+                BEGIN
+ 
+           <<IDN1>> <<L>> TEMP := ITEM;
+ 
+                   IDN2 : WHILE TEMP /= ITEM LOOP
+                               TEMP := ITEM;
+                          END LOOP IDN2;
+ 
+                   IDN3 : DECLARE
+                          BEGIN
+                               NULL;
+                          END IDN3;
+ 
+                END PKG;
+           
+           BEGIN     -- E
+ 
+                DECLARE
+                     PACKAGE P1 IS NEW PKG (INTEGER, 0);
+                BEGIN
+                     NULL;
+                END;
+                
+           END E;
+ 
+      -----------------------------------------------
+ 
+      F :  DECLARE
+ 
+                TASK T;
+ 
+                TASK BODY T IS
+ 
+                     F1 : IDN1 RANGE -4..2;
+                     F2 : CONSTANT INTEGER := IDN2;
+                     F3 : IDN3;
+ 
+                     TEMP : INTEGER;
+ 
+                BEGIN
+ 
+                 <<IDN1>> TEMP := 1;
+ 
+                   IDN2 : LOOP
+                               TEMP := TEMP + 1;
+                               EXIT;
+                          END LOOP IDN2;
+ 
+                   IDN3 : DECLARE
+                          BEGIN
+                               TEMP := TEMP + 1;
+                          END IDN3;
+ 
+                END T;
+ 
+           BEGIN     -- F
+                NULL;
+           END F;
+ 
+      -----------------------------------------------
+ 
+      END OUTER;
+ 
+      RESULT;
+ END C51004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,177 ----
+ -- C52005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED WHEN A STATIC
+ --    EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE OF INTEGER, BOOLEAN,
+ --    CHARACTER, AND ENUMERATION ASSIGNMENT TARGET VARIABLES.
+ 
+ -- DCB 2/5/80
+ -- JRK 7/21/80
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52005A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C52005A", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED "
+          & "ON STATIC OUT OF RANGE INTEGER, BOOLEAN, CHARACTER, " &
+            "AND ENUMERATION ASSIGNMENTS");
+ 
+ -------------------------
+ 
+      DECLARE
+           I1 : INTEGER RANGE 0..10 := 5;
+ 
+      BEGIN
+           I1 := 11;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE INT ASSNMT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF I1 /= 5 THEN
+                FAILED ("VALUE ALTERED BEFORE INT RANGE" &
+                        "EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           I2 : INTEGER RANGE 0..10 := 5;
+ 
+      BEGIN
+           I2 := 10;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL INTEGER ASSIGNMENT");
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           B1 : BOOLEAN RANGE TRUE..TRUE := TRUE;
+ 
+      BEGIN
+           B1 := FALSE;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE BOOL ASSNMT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF B1 /= TRUE THEN
+                FAILED ("VALUE ALTERED BEFORE BOOLEAN RANGE EXCEPTION");
+           END IF;
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           B2 : BOOLEAN := TRUE;
+ 
+      BEGIN
+           B2 := FALSE;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL BOOLEAN ASSNMNT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           C1 : CHARACTER RANGE 'B'..'Z' := 'M';
+ 
+      BEGIN
+           C1 := 'A';
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE CHAR ASSNMNT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF C1 /= 'M' THEN
+                FAILED ("VALUE ALTERED BEFORE CHARACTER RANGE " &
+                        "EXCEPTION");
+           END IF; 
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           C2 : CHARACTER RANGE 'B'..'Z' := 'M';
+ 
+      BEGIN
+           C2 := 'B';
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED OF LEGAL CHARACTER ASSNMNT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+           WORKDAY : DAY RANGE MON..FRI := TUE;
+ 
+      BEGIN
+           WORKDAY := SUN;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE ENUM. " &
+                   "ASSIGNMENT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF WORKDAY /= TUE THEN
+                FAILED ("VALUE ALTERED BEFORE ENUM. RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+           WORKDAY : DAY RANGE MON..FRI := TUE;
+ 
+      BEGIN
+           WORKDAY := FRI;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL ENUM. ASSNMNT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      RESULT;
+ END C52005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- C52005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
+ --    WHEN A STATIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+ --    OF FLOATING POINT ASSIGNMENTS.
+ 
+ -- DCB 2/6/80
+ -- JRK 7/21/80
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52005B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C52005B", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+          & " ON STATIC OUT OF RANGE FLOATING POINT ASSIGNMENTS");
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+           FL1 : FLT RANGE 0.0 .. 100.0 := 50.0;
+ 
+      BEGIN
+           FL1 := 101.0;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLT1 PT " &
+                   "ASSIGNMENT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF FL1 /= 50.0 THEN
+                FAILED ("VALUE ALTERED BEFORE FLT1 PT RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+           FL2 : FLT RANGE 0.0 .. 100.0 := 50.0;
+ 
+ 
+      BEGIN
+           FL2 := 100.0;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING1 PT" &
+                   "ASSIGNMENT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           FL1 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+ 
+      BEGIN
+           FL1 := -0.001;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLTG PT " &
+                   "ASSIGNMENT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF FL1 /= 50.0 THEN
+                FAILED ("VALUE ALTERED BEFORE FLTG PT RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           FL2 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+ 
+      BEGIN
+           FL2 := 0.0;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING PT ASSNMT");
+ 
+      END;
+ 
+ ----------------------
+ 
+      RESULT;
+ END C52005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C52005C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
+ --    WHEN A STATIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+ --    OF FIXED POINT ASSIGNMENTS.
+ 
+ -- DCB 2/6/80
+ -- JRK 7/21/80
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52005C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C52005C", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+          & " ON STATIC OUT OF RANGE FIXED POINT ASSIGNMENTS");
+ 
+ -----------------------
+ 
+      DECLARE
+           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+           FX1 : REAL RANGE 0.00 .. 7.00 := 4.50;
+ 
+      BEGIN
+           FX1 := 7.01;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FIXED ASSNMT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF FX1 /= 4.50 THEN
+                FAILED ("VALUE ALTERED BEFORE FIXED PT RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+           FX2 : REAL RANGE 0.00 .. 7.00 := 4.50;
+ 
+      BEGIN
+           FX2 := 7.00;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL FIXED PT ASSNMT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      RESULT;
+ END C52005C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,182 ----
+ -- C52005D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED WHEN A DYNAMIC
+ --    EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE OF INTEGER, BOOLEAN,
+ --    CHARACTER, AND ENUMERATION ASSIGNMENT TARGET VARIABLES.
+ 
+ -- JRK 7/21/80
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52005D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C52005D", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED "
+          & "ON DYNAMIC OUT OF RANGE INTEGER, BOOLEAN, CHARACTER, " &
+            "AND ENUMERATION ASSIGNMENTS");
+ 
+ -------------------------
+ 
+      DECLARE
+           I1 : INTEGER RANGE 0..10 := 5;
+ 
+      BEGIN
+           I1 := IDENT_INT(11);
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE INT ASSNMT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF I1 /= 5 THEN
+                FAILED ("VALUE ALTERED BEFORE INT RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           I2 : INTEGER RANGE 0..10 := 5;
+ 
+      BEGIN
+           I2 := IDENT_INT(10);
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL INTEGER ASSIGNMENT");
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           B1 : BOOLEAN RANGE TRUE..TRUE := TRUE;
+ 
+      BEGIN
+           B1 := IDENT_BOOL(FALSE);
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE BOOL ASSNMT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF B1 /= TRUE THEN
+                FAILED ("VALUE ALTERED BEFORE BOOLEAN RANGE EXCEPTION");
+           END IF;
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           B2 : BOOLEAN := TRUE;
+ 
+      BEGIN
+           B2 := IDENT_BOOL(FALSE);
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL BOOLEAN ASSNMNT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           C1 : CHARACTER RANGE 'B'..'Z' := 'M';
+ 
+      BEGIN
+           C1 := IDENT_CHAR('A');
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE CHAR ASSNMNT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF C1 /= 'M' THEN
+                FAILED ("VALUE ALTERED BEFORE CHARACTER RANGE " &
+                        "EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           C2 : CHARACTER RANGE 'B'..'Z' := 'M';
+ 
+      BEGIN
+           C2 := IDENT_CHAR('B');
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED OF LEGAL CHARACTER ASSNMNT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+           ALLDAYS : DAY := TUE;
+           WORKDAY : DAY RANGE MON..FRI := TUE;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                ALLDAYS := SUN;
+           END IF;
+           WORKDAY := ALLDAYS;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE ENUM. " &
+                   "ASSIGNMENT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF WORKDAY /= TUE THEN
+                FAILED ("VALUE ALTERED BEFORE ENUM. RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+           ALLDAYS : DAY := TUE;
+           WORKDAY : DAY RANGE MON..FRI := TUE;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                ALLDAYS := FRI;
+           END IF;
+           WORKDAY := ALLDAYS;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL ENUM. ASSNMNT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      RESULT;
+ END C52005D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- C52005E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
+ --    WHEN A DYNAMIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+ --    OF FLOATING POINT ASSIGNMENTS.
+ 
+ -- JRK 7/21/80
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52005E IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C52005E", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+         &  " ON DYNAMIC OUT OF RANGE FLOATING POINT ASSIGNMENTS");
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+           FL : FLT := 50.0;
+           FL1 : FLT RANGE 0.0 .. 100.0 := 50.0;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                FL := 101.0;
+           END IF;
+           FL1 := FL;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLT1 PT " &
+                   "ASSIGNMENT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF FL1 /= 50.0 THEN
+                FAILED ("VALUE ALTERED BEFORE FLT1 PT RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+           FL : FLT := 50.0;
+           FL2 : FLT RANGE 0.0 .. 100.0 := 50.0;
+ 
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                FL := 100.0;
+           END IF;
+           FL2 := FL;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING1 PT ASSNMT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           FL : FLOAT := 50.0;
+           FL1 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                FL := -0.001;
+           END IF;
+           FL1 := FL;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLTG PT " &
+                   "ASSIGNMENT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF FL1 /= 50.0 THEN
+                FAILED ("VALUE ALTERED BEFORE FLTG PT RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           FL : FLOAT := 50.0;
+           FL2 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                FL := 0.0;
+           END IF;
+           FL2 := FL;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL FLOATING PT ASSNMT");
+ 
+      END;
+ 
+ ----------------------
+ 
+      RESULT;
+ END C52005E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52005f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52005f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C52005F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CONSTRAINT_ERROR EXCEPTION IS RAISED
+ --    WHEN A DYNAMIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+ --    OF FIXED POINT ASSIGNMENTS.
+ 
+ -- JRK 7/21/80
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52005F IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C52005F", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+          & " ON DYNAMIC OUT OF RANGE FIXED POINT ASSIGNMENTS");
+ 
+ -----------------------
+ 
+      DECLARE
+           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+           FX : REAL := 4.50;
+           FX1 : REAL RANGE 0.00 .. 7.00 := 4.50;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                FX := 7.01;
+           END IF;
+           FX1 := FX;
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FIXED ASSNMT");
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           IF FX1 /= 4.50 THEN
+                FAILED ("VALUE ALTERED BEFORE FIXED PT RANGE EXCEPTION");
+           END IF;
+ 
+      END;
+ 
+ -------------------------
+ 
+      DECLARE
+           TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+           FX : REAL := 4.50;
+           FX2 : REAL RANGE 0.00 .. 7.00 := 4.50;
+ 
+      BEGIN
+           IF EQUAL(3,3) THEN
+                FX := 7.00;
+           END IF;
+           FX2 := FX;
+ 
+      EXCEPTION
+      WHEN CONSTRAINT_ERROR =>
+           FAILED ("EXCEPTION RAISED ON LEGAL FIXED PT ASSNMT");
+ 
+      END;
+ 
+ -------------------------
+ 
+      RESULT;
+ END C52005F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C52008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RECORD VARIABLE CONSTRAINED BY A SPECIFIED DISCRIMINANT
+ -- VALUE CANNOT HAVE ITS DISCRIMINANT VALUE ALTERED BY ASSIGNMENT.  
+ -- ASSIGNING AN ENTIRE RECORD VALUE WITH A DIFFERENT DISCRIMINANT VALUE
+ -- SHOULD RAISE CONSTRAINT_ERROR AND LEAVE THE TARGET VARIABLE 
+ -- UNALTERED.  THIS TEST USES STATIC DISCRIMINANT VALUES.
+  
+ -- ASL 6/25/81
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52008A IS
+  
+      USE REPORT;
+  
+      TYPE REC(DISC : INTEGER) IS
+           RECORD
+                COMP : INTEGER;
+           END RECORD;
+  
+      R : REC(5) := (5,0);
+  
+ BEGIN
+  
+      TEST ("C52008A", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " &
+                       "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " &
+                       "STATIC DISCRIMINANT VALUE");
+  
+      BEGIN
+           R := (DISC => 5, COMP => 3);
+           IF R /= (5,3) THEN
+                FAILED ("LEGAL ASSIGNMENT FAILED");
+           END IF;
+           R := (DISC => 4, COMP => 2);
+           FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
+                   "VALUE");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF R /= (5,3) THEN
+                     FAILED ("TARGET RECORD VALUE ALTERED BY " &
+                             "ASSIGNMENT TO VALUE WITH DIFFERENT " &
+                             "DISCRIMINANT VALUE EVEN AFTER " &
+                             "CONSTRAINT_ERROR RAISED");
+                END IF;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+      END;
+  
+      RESULT;
+  
+ END C52008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52008b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52008b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52008b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C52008B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A RECORD VARIABLE DECLARED WITH A SPECIFIED
+ --     DISCRIMINANT CONSTRAINT CANNOT HAVE A DISCRIMINANT VALUE ALTERED
+ --     BY ASSIGNMENT.  ASSIGNING AN ENTIRE RECORD VALUE WITH A
+ --     DIFFERENT DISCRIMINANT VALUE SHOULD RAISE CONSTRAINT_ERROR AND
+ --     LEAVE THE TARGET VARIABLE UNALTERED.  THIS TEST USES NON-STATIC
+ --     DISCRIMINANT VALUES.
+ 
+ -- HISTORY:
+ --     ASL  6/25/81  CREATED ORIGINAL TEST
+ --     JRK 11/18/82
+ --     RJW  8/17/89  ADDED SUBTYPE 'SUBINT'.
+ 
+ WITH REPORT;
+ PROCEDURE C52008B IS
+ 
+      USE REPORT;
+ 
+      TYPE REC1(D1,D2 : INTEGER) IS
+           RECORD
+                COMP1 : STRING(D1..D2);
+           END RECORD;
+ 
+      TYPE AR_REC1 IS ARRAY (NATURAL RANGE <>) OF REC1(IDENT_INT(3),
+                                                       IDENT_INT(5));
+ 
+      SUBTYPE SUBINT IS INTEGER RANGE -128 .. 127;
+ 
+      TYPE REC2(D1,D2,D3,D4 : SUBINT := 0) IS
+           RECORD
+                COMP1 : STRING(1..D1);
+                COMP2 : STRING(D2..D3);
+                COMP5 : AR_REC1(1..D4);
+                COMP6 : REC1(D3,D4);
+           END RECORD;
+ 
+      STR : STRING(IDENT_INT(3)..IDENT_INT(5)) := "ZZZ";
+ 
+      R1A : REC1(IDENT_INT(3),IDENT_INT(5)) := (3,5,STR);
+      R1C : REC1(5,6) := (5,6,COMP1 => (5..6 => 'K'));
+ 
+      Q,R : REC2(IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6));
+      TEMP : REC2(2,3,5,6);
+ 
+      W : REC2(1,4,6,8);
+      OK : BOOLEAN := FALSE;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C52008B", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " &
+                       "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " &
+                       "(DYNAMIC) DISCRIMINANT VALUE");
+ 
+      BEGIN
+           R1A := (IDENT_INT(3),5,"XYZ");
+ 
+           R := (IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6),
+                 "AB",
+                 STR,
+                 (1..6 => R1A),
+                 R1C);
+ 
+           TEMP := R;
+           Q := TEMP;
+           R.COMP1 := "YY";
+           OK := TRUE;
+           W := R;
+           FAILED ("ASSIGNMENT MADE USING INCORRECT DISCRIMINANT " &
+                   "VALUES");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT OK
+                OR Q /= TEMP
+                OR R = TEMP
+                OR R = Q
+                OR W.D4 /= 8 THEN
+                     FAILED ("LEGITIMATE ASSIGNMENT FAILED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION");
+      END;
+ 
+      RESULT;
+ 
+ END C52008B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C52009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RECORD VARIABLE DESIGNATED BY AN ACCESS VALUE CANNOT
+ -- HAVE ITS DISCRIMINANT ALTERED, EVEN BY A COMPLETE RECORD
+ -- ASSIGNMENT, AND EVEN THOUGH THE THE TARGET ACCESS VARIABLE IS NOT 
+ -- CONSTRAINED TO A SPECIFIC DISCRIMINANT VALUE.  ATTEMPTING TO
+ -- CHANGE THE TARGET'S DISCRIMINANT RAISES CONSTRAINT_ERROR AND LEAVES 
+ -- THE TARGET RECORD UNALTERED.  THIS  TEST USES STATIC DISCRIMINANT 
+ -- VALUES.
+  
+ -- ASL 6/25/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C52009A IS
+  
+      USE REPORT;
+  
+      TYPE REC (DISC : INTEGER) IS
+           RECORD
+                COMP : INTEGER;
+           END RECORD;
+  
+      TYPE REC_NAME IS ACCESS REC;
+  
+      HR : REC_NAME := NEW REC'(5,0);
+  
+ BEGIN
+  
+      TEST ("C52009A", "CANNOT CHANGE, THROUGH ASSIGNMENT, THE " &
+            "(STATIC) DISCRIMINANT VALUE OF A RECORD DESIGNATED " &
+            "BY AN ACCESS VALUE");
+  
+      BEGIN
+           HR.ALL := (DISC => 5, COMP => 3);
+           IF HR.ALL /= (5,3) THEN
+                FAILED ("LEGAL ASSIGNMENT FAILED");
+           END IF;
+           HR.ALL := (DISC => 4, COMP => 2);
+           FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
+                   "VALUE");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF HR.ALL /= (5,3) THEN
+                     FAILED ("TARGET RECORD VALUE ALTERED BY " &
+                             "ASSIGNMENT WITH A DIFFERENT " &
+                             "DISCRIMINANT VALUE EVEN AFTER " &
+                             "CONSTRAINT_ERROR RAISED");
+                END IF;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+      END;
+  
+      RESULT;
+  
+ END C52009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52009b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52009b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52009b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52009b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C52009B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RECORD VARIABLE DESIGNATED BY AN ACCESS VALUE CANNOT
+ -- HAVE ITS DISCRIMINANT ALTERED, EVEN BY A COMPLETE RECORD
+ -- ASSIGNMENT, AND EVEN THOUGH THE THE TARGET ACCESS VARIABLE IS NOT 
+ -- CONSTRAINED TO A SPECIFIC DISCRIMINANT VALUE.  ATTEMPTING TO
+ -- CHANGE THE TARGET'S DISCRIMINANT RAISES CONSTRAINT_ERROR AND LEAVES 
+ -- THE TARGET RECORD UNALTERED.  THIS TEST USES NON-STATIC DISCRIMINANT 
+ -- VALUES AND A TYPE WITH DEFAULT DISCRIMINANTS.
+  
+ -- ASL 7/6/81
+ -- SPS 10/26/82
+ -- JBG 1/10/84
+ 
+ WITH REPORT;
+ PROCEDURE C52009B IS
+  
+      USE REPORT;
+  
+      TYPE REC(DISC : INTEGER := 5) IS
+           RECORD
+                COMP : INTEGER := 0;
+           END RECORD;
+  
+      TYPE REC_NAME IS ACCESS REC;
+  
+      HR : REC_NAME := NEW REC;
+  
+ BEGIN
+  
+      TEST ("C52009B", "CANNOT CHANGE, THROUGH ASSIGNMENT, THE " &
+            "(DYNAMIC) DISCRIMINANT VALUE OF A RECORD DESIGNATED " &
+            "BY AN ACCESS VALUE");
+  
+      BEGIN
+           HR.ALL := (DISC => IDENT_INT(5), COMP => 3);
+           IF HR.ALL /= (IDENT_INT(5),3) THEN
+                FAILED ("LEGAL ASSIGNMENT FAILED");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => 
+                FAILED ("CONSTRAINT_ERROR RAISED WHEN DISCRIMINANT " &
+                        "VALUE NOT CHANGED");
+      END;
+ 
+      BEGIN
+           HR.ALL := (DISC => IDENT_INT(4), COMP => 2);
+           FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
+                   "VALUE");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("DETECTED ATTEMPT TO CHANGE DISCRIMINANT " &
+                         "VALUE");
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+      END;
+  
+      RESULT;
+  
+ END C52009B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- C52010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT RECORD ASSIGNMENTS USE "COPY" SEMANTICS. (PART I).
+ 
+ 
+ -- FACTORS AFFECTING THE SITUATION TO BE TESTED:
+ --
+ --        COMPONENT TYPE                     * INTEGER
+ --                                           * BOOLEAN (OMITTED)
+ --                                           * CHARACTER (OMITTED)
+ --                                           * USER-DEFINED ENUMERATION
+ --
+ --        DERIVED VS. NON-DERIVED
+ --
+ --        TYPE VS. SUBTYPE
+ --
+ --        ORDER OF COMPONENT ASSIGNMENTS     * LEFT-TO-RIGHT
+ --                                           * RIGHT-TO-LEFT
+ --                                           * INSIDE-OUT
+ --                                           * OUTSIDE IN
+ 
+ 
+ -- RM 02/23/80
+ -- SPS 3/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C52010A IS
+ 
+      USE REPORT;
+ 
+      TYPE  ENUM  IS  ( AA , BB , CC , DD , EE , FF , GG , HH ,
+                        II , JJ , KK , LL , MM , NN , PP , QQ ,
+                                  TT , UU , VV , WW , XX , YY );
+ 
+ BEGIN
+ 
+      TEST ( "C52010A" ,  "CHECK THAT RECORD ASSIGNMENTS USE ""COPY""" &
+                          " SEMANTICS" );
+ 
+ 
+      DECLARE
+           TYPE  REC  IS
+                RECORD
+                     X , Y  :  INTEGER ;
+                END RECORD;
+           R  :  REC ;
+      BEGIN
+ 
+           R  :=  ( 5 , 8 ) ;
+           R  :=  ( X => 1 , Y => R.X ) ;
+           IF  R  /=  ( 1 , 5 )  THEN
+                FAILED ( "WRONG VALUE  (1)" );
+           END IF;
+ 
+           R  :=  ( 5 , 8 ) ;
+           R  :=  ( Y => 1 , X => R.Y ) ;
+           IF  R  /=  ( 8 , 1 )  THEN
+                FAILED ( "WRONG VALUE  (2)" );
+           END IF;
+ 
+           R  :=  ( 5 , 8 ) ;
+           R  :=  ( R.Y+1 , R.X+1 ) ;
+           IF  R  /=  ( 9 , 6 ) THEN
+                FAILED ( "WRONG VALUE  (3)" );
+           END IF;
+ 
+      END;
+ 
+      DECLARE
+           TYPE  REC3  IS
+                RECORD
+                     DEEP0     :  INTEGER   ;
+                     DEEP      :  INTEGER   ;
+                END RECORD;
+           TYPE  REC2  IS
+                RECORD
+                     YX        :  REC3      ;
+                     MODERATE  :  INTEGER   ;
+                END RECORD;
+           TYPE  REC  IS
+                RECORD
+                     SHALLOW   :  INTEGER   ;
+                     YZ        :  REC2      ;
+                END RECORD;
+           R  :  REC ;
+      BEGIN
+           R  :=  ( 0              , ((5,  1         ), 2             ));
+           R  :=  ( R.YZ.MODERATE+8, ((7, R.SHALLOW+1),R.YZ.YX.DEEP+99));
+           IF R/= (              10, ((7,           1),            100))
+           THEN
+                FAILED ( "WRONG VALUE  (4)" );
+           END IF;
+      END;
+ 
+ 
+      DECLARE
+           TYPE  SUB_ENUM  IS  NEW ENUM RANGE  AA..DD ;
+           TYPE  REC  IS
+                RECORD
+                     X , Y  :  SUB_ENUM ;
+                END RECORD;
+           R  :  REC ;
+      BEGIN
+           R  :=  ( AA , CC ) ;
+           R  :=  ( X => BB , Y => R.X ) ;
+           IF  R  /=  ( BB , AA )  THEN
+                FAILED ( "WRONG VALUE  (5)" );
+           END IF;
+ 
+           R  :=  ( AA , CC ) ;
+           R  :=  ( Y => BB , X => R.Y ) ;
+           IF  R  /=  ( CC , BB )  THEN
+                FAILED ( "WRONG VALUE  (6)" );
+           END IF;
+ 
+           R  :=  ( AA , CC ) ;
+           R  :=  ( SUB_ENUM'SUCC( R.Y ) , SUB_ENUM'SUCC( R.X ) ) ;
+           IF  R /= ( DD , BB )  THEN
+                FAILED ( "WRONG VALUE  (7)" );
+           END IF;
+ 
+      END;
+ 
+ 
+      DECLARE
+           TYPE  REC3  IS
+                RECORD
+                     DEEP0      :  ENUM ;
+                     DEEP       :  ENUM ;
+                END RECORD;     
+           TYPE  REC2  IS
+                RECORD
+                     YX         :  REC3 ;
+                     MODERATE   :  ENUM ;
+                END RECORD;
+           TYPE  REC  IS
+                RECORD
+                     SHALLOW    :  ENUM ;
+                     YZ         :  REC2 ;
+                END RECORD;
+           R  :  REC ;
+      BEGIN
+ 
+           R  :=  (    TT ,
+                    (( YY , II ) ,
+                       AA ) ) ;
+ 
+           R  :=  (    ENUM'SUCC(ENUM'SUCC( R.YZ.MODERATE )) ,
+                    (( AA , ENUM'SUCC( R.SHALLOW ) ) ,
+                     ( ENUM'SUCC(ENUM'SUCC(ENUM'SUCC(ENUM'SUCC(
+                                 R.YZ.YX.DEEP )))) ) ) ) ;
+ 
+           IF R/= (    CC ,
+                    (( AA , UU ) ,
+                       MM ) )
+           THEN
+                FAILED ( "WRONG VALUE  (8)" );
+           END IF;
+ 
+      END;
+ 
+      RESULT ;
+ 
+ END C52010A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C52011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK INDEX CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES.
+ -- SPECIFICALLY, CHECK THAT:
+ 
+ -- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT
+ -- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED
+ -- IS NULL.
+ 
+ -- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED
+ -- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE.
+ 
+ -- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS
+ -- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES.
+ 
+ -- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT
+ -- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS
+ -- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER
+ -- FROM THOSE ON THE SUBTYPE.
+ 
+ -- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED
+ -- SUBTYPES OF THIS TYPE.
+ 
+ -- ASL 6/29/81
+ --  RM 6/17/82
+ -- SPS 10/26/82
+ -- RLB  6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION.
+ 
+ WITH REPORT;
+ PROCEDURE C52011A IS
+ 
+      USE REPORT;
+ 
+      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+      TYPE ARR_NAME IS ACCESS ARR;
+      SUBTYPE S1 IS ARR_NAME(IDENT_INT(1)..IDENT_INT(10));
+      SUBTYPE S2 IS ARR_NAME(IDENT_INT(3)..IDENT_INT(6));
+ 
+      W : ARR_NAME := NULL;                    -- E.
+      X1,X2 : S1 := NULL;                      -- E.
+      Y1,Y2 : S2 := NULL;                      -- E.
+ 
+      W_NONNULL  : ARR_NAME := NEW ARR'(3..5=>7) ;
+      X1_NONNULL : S1       := NEW ARR'(IDENT_INT(1)..IDENT_INT(10)=>7);
+      Y1_NONNULL : S2       := NEW ARR'(IDENT_INT(3)..IDENT_INT( 6)=>7);
+ 
+      TOO_EARLY : BOOLEAN := TRUE;
+ 
+ BEGIN
+ 
+      TEST ("C52011A", "INDEX CONSTRAINTS ON ACCESS SUBTYPE OBJECTS " &
+                       "MUST BE SATISFIED FOR ASSIGNMENT");
+ 
+      BEGIN
+ 
+           IF EQUAL(3,3) THEN
+                W_NONNULL := X1;               -- A.
+           END IF;
+           IF W_NONNULL /= X1 THEN
+                FAILED ("ASSIGNMENT FAILED - 1");
+           END IF;
+ 
+           IF EQUAL(3,3) THEN
+                X1_NONNULL := X2;              -- A.
+           END IF;
+           IF X1_NONNULL /= X2 THEN
+                FAILED ("ASSIGNMENT FAILED - 2");
+           END IF;
+ 
+           IF EQUAL(3,3) THEN
+                X1_NONNULL := Y1;              -- A.
+           END IF;
+           IF X1 /= Y1 THEN
+                FAILED ("ASSIGNMENT FAILED - 3");
+           END IF;
+ 
+           X1 := NEW ARR'(1..IDENT_INT(10) => 5);
+           IF EQUAL(3,3) THEN
+                X2 := X1;                      -- B.
+           END IF;
+           IF X2 /= X1 THEN
+                FAILED ("ASSIGNMENT FAILED - 4");
+           END IF;
+ 
+           IF EQUAL(3,3) THEN
+                W := X1;                       -- B.
+           END IF;
+           IF W /= X1 THEN
+                FAILED ("ASSIGNMENT FAILED - 5");
+           END IF;
+ 
+           BEGIN
+                Y1 := X1;                      -- C.
+                IF Y1'FIRST /= REPORT.IDENT_INT(3) THEN
+                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                      "AND CONSTRAINT IS CHANGED");
+                ELSE
+                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                      "AND CONSTRAINT IS NOT CHANGED");
+                END IF;
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION - 1");
+ 
+           END;
+ 
+           W := NEW ARR'(IDENT_INT(3)..IDENT_INT(6) => 3);
+ 
+           BEGIN
+                X1 := W;                            -- D.
+                IF X1'FIRST /= REPORT.IDENT_INT(1) THEN
+                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                           "AND CONSTRAINT IS CHANGED");
+                ELSE
+                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                           "AND CONSTRAINT IS NOT CHANGED");
+                END IF;
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL ;
+ 
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION - 2");
+ 
+           END;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED");
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END C52011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52011b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52011b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52011b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,180 ----
+ -- C52011B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK DISCRIMINANT CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES.
+ -- SPECIFICALLY, CHECK THAT:
+ 
+ -- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT
+ -- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED
+ -- IS NULL.
+ 
+ -- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED
+ -- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE.
+ 
+ -- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS
+ -- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES.
+ 
+ -- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT
+ -- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS
+ -- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER
+ -- FROM THOSE ON THE SUBTYPE.
+ 
+ -- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED
+ -- SUBTYPES OF THIS TYPE.
+ 
+ -- ASL 7/06/81
+ --  RM 6/17/82
+ -- RLB 6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION.
+ 
+ WITH REPORT;
+ PROCEDURE C52011B IS
+ 
+      USE REPORT;
+ 
+      TYPE REC(DISC : INTEGER := -1 ) IS
+           RECORD
+                NULL;
+           END RECORD;
+ 
+      TYPE REC_NAME IS ACCESS REC;
+      SUBTYPE S1 IS REC_NAME(IDENT_INT(5));
+      SUBTYPE S2 IS REC_NAME(IDENT_INT(3));
+ 
+      W : REC_NAME := NULL;                    -- E.
+      X1,X2 : S1 := NULL;                      -- E.
+      Y1,Y2 : S2 := NULL;                      -- E.
+ 
+      W_NONNULL  : REC_NAME := NEW REC(7) ;
+      X1_NONNULL : S1       := NEW REC(IDENT_INT(5));
+      Y1_NONNULL : S2       := NEW REC(IDENT_INT(3));
+ 
+      TOO_EARLY : BOOLEAN := TRUE;
+ 
+ BEGIN
+ 
+      TEST ("C52011B", "DISCRIMINANT CONSTRAINTS ON ACCESS SUBTYPE " &
+                       "OBJECTS MUST BE SATISFIED FOR ASSIGNMENT");
+ 
+      BEGIN
+ 
+           IF EQUAL(3,3) THEN
+                W_NONNULL := X1;               -- A.
+           END IF;
+           IF W_NONNULL /= X1 THEN
+                FAILED ("ASSIGNMENT FAILED - 1");
+           END IF;
+ 
+           IF EQUAL(3,3) THEN
+                W := Y1;                       -- A.
+           END IF;
+           IF W /= Y1 THEN
+                FAILED ("ASSIGNMENT FAILED - 2");
+           END IF;
+ 
+           IF EQUAL(3,3) THEN
+                X1_NONNULL := Y1;              -- A.
+           END IF;
+           IF X1_NONNULL /= Y1 THEN
+                FAILED ("ASSIGNMENT FAILED - 3");
+           END IF;
+ 
+           IF EQUAL(3,3) THEN
+                Y1_NONNULL := Y2;              -- A.
+           END IF;
+           IF Y1_NONNULL /= Y2 THEN
+                FAILED ("ASSIGNMENT FAILED - 4");
+           END IF;
+ 
+           X1 := NEW REC(IDENT_INT(5));
+           IF EQUAL(3,3) THEN
+                X2 := X1;                      -- B.
+           END IF;
+           IF X1 /= X2 THEN
+                FAILED ("ASSIGNMENT FAILED - 5");
+           END IF;
+ 
+           IF EQUAL(3,3) THEN
+                W := X1;                       -- B.
+           END IF;
+           IF W /= X1 THEN
+                FAILED ("ASSIGNMENT FAILED - 6");
+           END IF;
+ 
+           BEGIN
+                Y1 := X1;                      -- C.
+                IF Y1.DISC /= REPORT.IDENT_INT(3) THEN
+                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                      "AND CONSTRAINT IS CHANGED");
+                ELSE
+                   FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                      "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                      "AND CONSTRAINT IS NOT CHANGED");
+                END IF;
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+ 
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION - 1");
+ 
+           END;
+ 
+           W := NEW REC(IDENT_INT(3));
+ 
+           BEGIN
+                X1 := W;                            -- D.
+                IF X1.DISC /= REPORT.IDENT_INT(5) THEN
+                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                           "AND CONSTRAINT IS CHANGED");
+                ELSE
+                   FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                           "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                           "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                           "AND CONSTRAINT IS NOT CHANGED");
+                END IF;
+           EXCEPTION
+ 
+                WHEN CONSTRAINT_ERROR =>
+                     NULL ;
+ 
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION - 2");
+ 
+           END;
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED");
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END C52011B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52101a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52101a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52101a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52101a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C52101A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAY SUBTYPE CONVERSION IS APPLIED AFTER AN ARRAY VALUE
+ -- IS DETERMINED.
+ 
+ -- BHS 6/22/84
+ 
+ WITH REPORT;
+ PROCEDURE C52101A IS
+ 
+      USE REPORT;
+ 
+      TYPE DAY IS (MON, TUE, WED, THU, FRI, SAT, SUN);
+      SUBTYPE WEEKDAY IS DAY RANGE MON..FRI;
+ 
+      TYPE ARR IS ARRAY  (WEEKDAY RANGE <>) OF INTEGER;
+      TYPE ARR_DAY IS ARRAY (DAY RANGE <>) OF INTEGER;
+ 
+      NORM     : ARR (MON..FRI);          -- INDEX SUBTYPE WEEKDAY
+      NORM_DAY : ARR_DAY (MON..FRI);      -- INDEX SUBTYPE DAY
+ 
+ BEGIN
+      TEST ("C52101A", "CHECK THAT ARRAY SUBTYPE CONVERSION " &
+                       "APPLIED AFTER ARRAY VAL. DETERMINED");
+ 
+      BEGIN   -- ILLEGAL CASE
+           NORM := (WED..SUN => 0);        -- ERROR: INDEX SUBTYPE
+ 
+           FAILED ("EXCEPTION NOT RAISED FOR INDEX SUBTYPE ERROR");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("IMPROPER AGGREGATE BOUNDS DETECTED");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+ 
+      END;
+ 
+ 
+      BEGIN    -- LEGAL CASE
+           NORM_DAY := (WED..FRI => 0, SAT..SUN => 1);
+           IF NORM_DAY /= ( 0, 0, IDENT_INT(0), IDENT_INT(1),
+                                                IDENT_INT(1)) THEN
+                FAILED ("INCORRECT ASSIGNMENT IN LEGAL CASE");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED ON LEGAL INDEX " &
+                        "SUBTYPE CONVERSION");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED IN LEGAL CASE");
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ END C52101A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,251 ----
+ -- C52102A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+ --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+ --    THE SEMANTICS OF "COPY" ASSIGNMENT.  (THIS TEST IS IN TWO PARTS,
+ --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+ 
+ -- PART 1:  STATIC BOUNDS
+ 
+ 
+ -- RM 02/25/80
+ -- SPS 2/18/83
+ -- JBG 8/21/83
+ -- JBG 5/8/84
+ -- JBG 6/09/84
+ 
+ WITH REPORT;
+ PROCEDURE  C52102A  IS
+ 
+      USE  REPORT; 
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST( "C52102A" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                        "ASSIGNMENT (PART 1: STATIC BOUNDS)" );
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF INTEGERS  -------------------------
+ 
+      DECLARE
+           A   :    ARRAY( 1..4 ) OF INTEGER; 
+ 
+      BEGIN
+           A   :=   (  11  ,  12  ,  13  ,  14  );
+           A   :=   (  1   , A(1) , A(2) , A(1) );
+           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+                FAILED( "WRONG VALUES  -  I1" );
+           END IF;
+ 
+           A   :=   (  11  ,  12  ,  13  ,  14  );
+           A   :=   ( A(4) , A(3) , A(4) ,  1   );
+           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+                FAILED( "WRONG VALUES  -  I2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( INTEGER RANGE -4..4 ) OF INTEGER; 
+ 
+      BEGIN
+           A   :=  (  -4 , -3 , -2 , -1 , 100 , 1 , 2 , 3 , 4 );
+           A(-4..0)  :=  A(0..4); 
+           IF  A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
+           THEN
+                FAILED( "WRONG VALUES  -  I3" );
+           END IF;
+ 
+           A   :=  ( -4 , -3 , -2 , -1 , 100 ,  1 ,  2 ,  3 ,  4 );
+           A(0..4)   :=  A(-4..0); 
+           IF  A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+           THEN
+                FAILED( "WRONG VALUES  -  I4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           A  :  INT_ARR (1..10);
+ 
+      BEGIN
+           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+           A   :=  0  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+           IF  A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+           THEN
+                FAILED( "WRONG VALUES  -  I5" );
+           END IF;
+ 
+           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+           A   :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  0  &  0; 
+           IF  A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+           THEN
+                FAILED( "WRONG VALUES  -  I6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF BOOLEANS  -------------------------
+ 
+      DECLARE
+           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A   :=   (  FALSE , TRUE , TRUE , FALSE );
+           A   :=   (  TRUE  , A(1) , A(2) , A(1)  );
+           IF  A /= (  TRUE , FALSE , TRUE , FALSE )
+           THEN
+                FAILED( "WRONG VALUES  -  B1" );
+           END IF;
+ 
+           A   :=   (  FALSE , TRUE , TRUE , FALSE );
+           A   :=   (  A(4)  , A(3) , A(4) ,  TRUE );
+           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+           THEN
+                FAILED( "WRONG VALUES  -  B2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( INTEGER RANGE -4..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A  := (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE, TRUE, TRUE,TRUE);
+           A(-4..0)  :=  A(0..4); 
+           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B3" );
+           END IF;
+ 
+           A  := (FALSE,FALSE,FALSE,FALSE, TRUE,TRUE, TRUE, TRUE,TRUE);
+           A(0..4)   :=  A(-4..0); 
+           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+           A  :  B_ARR (1..10); 
+ 
+      BEGIN
+           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+           A :=  FALSE  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B5" );
+           END IF;
+ 
+           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+           A :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  FALSE  &  TRUE; 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  CHARACTER STRINGS  --------------------------
+ 
+      DECLARE
+           A   :    STRING( 1..4 ); 
+ 
+      BEGIN
+           A   :=   "ARGH"; 
+           A   :=   (  'Q' , A(1) , A(2) , A(1) );
+           IF  A /= "QARA"  THEN
+                FAILED( "WRONG VALUES  -  C1" );
+           END IF;
+ 
+           A   :=   "ARGH"; 
+           A   :=   ( A(4) , A(3) , A(4) , 'X' );
+           IF  A /= "HGHX"  THEN
+                FAILED( "WRONG VALUES  -  C2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    STRING( 96..104 );
+ 
+      BEGIN
+           A  :=  "APHRODITE"; 
+           A(96..100)  :=  A(100..104); 
+           IF  A  /=  "ODITEDITE"   THEN
+                FAILED( "WRONG VALUES  -  C3" );
+           END IF;
+ 
+           A  :=  "APHRODITE"; 
+           A(100..104) :=  A(96..100) ; 
+           IF  A  /=  "APHRAPHRO"   THEN
+                FAILED( "WRONG VALUES  -  C4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+           A  :  CH_ARR (1..9);
+ 
+      BEGIN
+           A   :=  "CAMBRIDGE"; 
+           A   :=  'S'  &  A(1..2)  &  A(1..2)  &  A(1..4); 
+           IF  A  /=  "SCACACAMB"  THEN
+                FAILED( "WRONG VALUES  -  C5" );
+           END IF;
+ 
+           A   :=  "CAMBRIDGE"; 
+           A   :=  A(8..8)  &  A(6..8)  &  A(6..8)  &  "EA"; 
+           IF  A  /=  "GIDGIDGEA"  THEN
+                FAILED( "WRONG VALUES  -  C6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      RESULT; 
+ 
+ 
+ END C52102A; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,278 ----
+ -- C52102B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+ --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+ --    THE SEMANTICS OF "COPY" ASSIGNMENT.  (THIS TEST IS IN TWO PARTS,
+ --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+ 
+ -- PART 2:  DYNAMIC BOUNDS
+ 
+ 
+ -- RM 02/27/80
+ -- SPS 2/18/83
+ -- JBG 3/15/84
+ -- JBG 6/9/84
+ 
+ WITH REPORT;
+ PROCEDURE  C52102B  IS
+ 
+      USE  REPORT; 
+      IDENT_INT_0 : INTEGER := IDENT_INT(0);
+      IDENT_INT_1 : INTEGER := IDENT_INT (1);
+      IDENT_INT_2 : INTEGER := IDENT_INT (2);
+      IDENT_INT_3 : INTEGER := IDENT_INT (3);
+      IDENT_INT_4 : INTEGER := IDENT_INT (4);
+      IDENT_INT_5 : INTEGER := IDENT_INT (5);
+      IDENT_INT_6 : INTEGER := IDENT_INT (6);
+      IDENT_INT_8 : INTEGER := IDENT_INT (8);
+      IDENT_INT_9 : INTEGER := IDENT_INT (9);
+ 
+ BEGIN
+ 
+ 
+      TEST( "C52102B" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                        "ASSIGNMENT (PART 2: DYNAMIC BOUNDS)" );
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF INTEGERS  -------------------------
+ 
+      DECLARE
+           A   :   ARRAY( 1..IDENT_INT_4 ) OF INTEGER; 
+ 
+      BEGIN
+           A   :=   (  11  ,  12  ,  13  ,  14  );
+           A   :=   (  1   , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                               A(IDENT_INT_1) );
+           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+                FAILED( "WRONG VALUES  -  I1" );
+           END IF;
+ 
+           A   :=   (  11  ,  12  ,  13  ,  14  );
+           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                                        A(IDENT_INT_4) ,  1   );
+           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+                FAILED( "WRONG VALUES  -  I2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( -4..IDENT_INT_4 ) OF INTEGER; 
+ 
+      BEGIN
+           A         :=  (  -4 , -3 , -2 , -1 , 100 , 1 , 2 , 3 , 4 );
+           A(-4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+           IF    A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
+           THEN
+                FAILED( "WRONG VALUES  -  I3" );
+           END IF;
+ 
+           A   :=  ( -4 , -3 , -2 , -1 , 100 ,  1 ,  2 ,  3 ,  4 );
+           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+           IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+           THEN
+                FAILED( "WRONG VALUES  -  I4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           A   :  ARR (1..10);
+ 
+      BEGIN
+           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+           A   :=  0  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                         A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_5); 
+           IF   A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+           THEN
+                FAILED( "WRONG VALUES  -  I5" );
+           END IF;
+ 
+           A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+           A   :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                   A(IDENT_INT_8..IDENT_INT_9)  &
+                   A(IDENT_INT_8..IDENT_INT_9)  &  0  &  0; 
+           IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+           THEN
+                FAILED( "WRONG VALUES  -  I6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF BOOLEANS  -------------------------
+ 
+      DECLARE
+           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A   :=   (  FALSE , TRUE , TRUE , FALSE );
+           A   :=   (  TRUE  , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                                 A(IDENT_INT_1)  );
+           IF  A /= (  TRUE , FALSE , TRUE , FALSE )
+           THEN
+                FAILED( "WRONG VALUES  -  B1" );
+           END IF;
+ 
+           A   :=   (  FALSE , TRUE , TRUE , FALSE );
+           A   :=   (  A(IDENT_INT_4)  , A(IDENT_INT_3) ,
+                                          A(IDENT_INT_4) ,  TRUE );
+           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+           THEN
+                FAILED( "WRONG VALUES  -  B2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( -IDENT_INT_4..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A  := (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE, TRUE, TRUE,TRUE);
+           A(-IDENT_INT_4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B3" );
+           END IF;
+ 
+           A  := (FALSE,FALSE,FALSE,FALSE, TRUE,TRUE, TRUE, TRUE,TRUE);
+           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+           A  :  B_ARR (1..10); 
+ 
+      BEGIN
+           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+           A :=  FALSE  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                           A(IDENT_INT_1..IDENT_INT_2)  &
+                           A(IDENT_INT_1..IDENT_INT_5); 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B5" );
+           END IF;
+ 
+           A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+           A :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                 A(IDENT_INT_8..IDENT_INT_9)  &
+                 A(IDENT_INT_8..IDENT_INT_9)  &      FALSE  &  TRUE; 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  CHARACTER STRINGS  --------------------------
+ 
+      DECLARE
+           A   :    STRING( 1..4 ); 
+ 
+      BEGIN
+           A   :=   "ARGH"; 
+           A   :=   (  'Q' , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                               A(IDENT_INT_1) );
+           IF  A /= "QARA"  THEN
+                FAILED( "WRONG VALUES  -  C1" );
+           END IF;
+ 
+           A   :=   "ARGH"; 
+           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                      A(IDENT_INT_4) , 'X' );
+           IF  A /= "HGHX"  THEN
+                FAILED( "WRONG VALUES  -  C2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    STRING( IDENT_INT(96)..104 );
+ 
+      BEGIN
+           A   :=  "APHRODITE"; 
+           A(IDENT_INT(96)..IDENT_INT(100))  :=  A(IDENT_INT(100)..
+                                                   IDENT_INT(104)); 
+           IF  A  /=  "ODITEDITE"   THEN
+                FAILED( "WRONG VALUES  -  C3" );
+           END IF;
+ 
+           A   :=  "APHRODITE"; 
+           A(IDENT_INT(100)..IDENT_INT(104)) :=  A(IDENT_INT(96)..
+                                                   IDENT_INT(100)) ; 
+           IF  A  /=  "APHRAPHRO"   THEN
+                FAILED( "WRONG VALUES  -  C4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+           A  :  CH_ARR (IDENT_INT_1..9); 
+ 
+      BEGIN
+           A   :=  "CAMBRIDGE"; 
+           A   :=  'S'  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                           A(IDENT_INT_1..IDENT_INT_2)  &
+                           A(IDENT_INT_1..IDENT_INT_4); 
+           IF  A  /=  "SCACACAMB"  THEN
+                FAILED( "WRONG VALUES  -  C5" );
+           END IF;
+ 
+           A   :=  "CAMBRIDGE"; 
+           A   :=  A(IDENT_INT_8..IDENT_INT_8)  &
+                   A(IDENT_INT_6..IDENT_INT_8)  &
+                   A(IDENT_INT_6..IDENT_INT_8)  &  "EA"; 
+           IF  A  /=  "GIDGIDGEA"  THEN
+                FAILED( "WRONG VALUES  -  C6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      RESULT; 
+ 
+ 
+ END C52102B; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,280 ----
+ -- C52102C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+ --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+ --    THE SEMANTICS OF "COPY" ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES
+ --    REQUIRE RUN-TIME EVALUATION.   (THIS TEST IS IN TWO PARTS,
+ --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+ 
+ -- PART 1:  STATIC BOUNDS
+ 
+ 
+ -- RM 02/25/80
+ -- SPS 2/18/83
+ -- JBG 8/21/83
+ -- JBG 5/8/84
+ -- JBG 6/09/84
+ -- BHS 6/26/84
+ 
+ WITH REPORT;
+ PROCEDURE  C52102C  IS
+ 
+      USE  REPORT; 
+ 
+      FUNCTION ID_I (X : INTEGER) RETURN INTEGER RENAMES IDENT_INT;
+      FUNCTION ID_B (X : BOOLEAN) RETURN BOOLEAN RENAMES IDENT_BOOL;
+ 
+ BEGIN
+ 
+ 
+      TEST( "C52102C" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                        "ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES " &
+                        "ARE DYNAMIC  (PART 1: STATIC BOUNDS)" );
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF INTEGERS  -------------------------
+ 
+      DECLARE
+           A   :    ARRAY( 1..4 ) OF INTEGER; 
+ 
+      BEGIN
+           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
+           A   :=   (  1   , A(1) , A(2) , A(1) );
+           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+                FAILED( "WRONG VALUES  -  I1" );
+           END IF;
+ 
+           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
+           A   :=   ( A(4) , A(3) , A(4) ,  1   );
+           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+                FAILED( "WRONG VALUES  -  I2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( INTEGER RANGE -4..4 ) OF INTEGER; 
+ 
+      BEGIN
+           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+                      ID_I(100), ID_I(1),ID_I(2), ID_I(3), ID_I(4) );
+           A(-4..0)  :=  A(0..4); 
+           IF    A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
+           THEN
+                FAILED( "WRONG VALUES  -  I3" );
+           END IF;
+ 
+           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+                ID_I(100),  ID_I(1), ID_I(2),  ID_I(3),  ID_I(4) );
+           A(0..4)   :=  A(-4..0); 
+           IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+           THEN
+                FAILED( "WRONG VALUES  -  I4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           A  :  INT_ARR (1..10);
+ 
+      BEGIN
+           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                      ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
+           A   :=  0  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+           IF   A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+           THEN
+                FAILED( "WRONG VALUES  -  I5" );
+           END IF;
+ 
+           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
+           A   :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  0  &  0; 
+           IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+           THEN
+                FAILED( "WRONG VALUES  -  I6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF BOOLEANS  -------------------------
+ 
+      DECLARE
+           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+           A   :=   (  TRUE  , A(1) , A(2) , A(1)  );
+           IF  A /= (  TRUE  ,FALSE , TRUE , FALSE )
+           THEN
+                FAILED( "WRONG VALUES  -  B1" );
+           END IF;
+ 
+           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+           A   :=   (  A(4)  , A(3) , A(4) ,  TRUE );
+           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+           THEN
+                FAILED( "WRONG VALUES  -  B2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( INTEGER RANGE -4..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                   ID_B(FALSE), ID_B(TRUE), ID_B(TRUE),
+                   ID_B(TRUE), ID_B(TRUE));
+           A(-4..0)  :=  A(0..4); 
+           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B3" );
+           END IF;
+ 
+           A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                   ID_B(TRUE), ID_B(TRUE), ID_B(TRUE),
+                   ID_B(TRUE), ID_B(TRUE));
+           A(0..4)   :=  A(-4..0); 
+           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+           A  :  B_ARR (1..10); 
+ 
+      BEGIN
+           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
+                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), 
+                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+           A :=  FALSE  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B5" );
+           END IF;
+ 
+           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
+                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
+                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+           A :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  FALSE  &  TRUE; 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  CHARACTER STRINGS  --------------------------
+ 
+      DECLARE
+           A   :    STRING( 1..4 ); 
+ 
+      BEGIN
+           IF EQUAL (3,3) THEN
+                A   :=   "ARGH"; 
+           END IF;
+           A   :=   (  'Q' , A(1) , A(2) , A(1) );
+           IF  A /= "QARA"  THEN
+                FAILED( "WRONG VALUES  -  C1" );
+           END IF;
+ 
+           IF EQUAL (3,3) THEN
+                A   :=   "ARGH"; 
+           END IF;
+           A   :=   ( A(4) , A(3) , A(4) , 'X' );
+           IF  A /= "HGHX"  THEN
+                FAILED( "WRONG VALUES  -  C2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    STRING( 96..104 );
+ 
+      BEGIN
+           IF EQUAL (3,3) THEN
+                A      :=  "APHRODITE"; 
+           END IF;
+           A(96..100)  :=  A(100..104); 
+           IF  A  /=  "ODITEDITE"   THEN
+                FAILED( "WRONG VALUES  -  C3" );
+           END IF;
+ 
+           IF EQUAL (3,3) THEN
+                A      :=  "APHRODITE"; 
+           END IF;
+           A(100..104) :=  A(96..100) ; 
+           IF  A  /=  "APHRAPHRO"   THEN
+                FAILED( "WRONG VALUES  -  C4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+           A  :  CH_ARR (1..9); 
+ 
+      BEGIN
+           IF EQUAL (3,3) THEN
+                A   :=  "CAMBRIDGE"; 
+           END IF;
+           A   :=  'S'  &  A(1..2)  &  A(1..2)  &  A(1..4); 
+           IF  A  /=  "SCACACAMB"  THEN
+                FAILED( "WRONG VALUES  -  C5" );
+           END IF;
+ 
+           IF EQUAL (3,3) THEN
+                A   :=  "CAMBRIDGE"; 
+           END IF;
+           A   :=  A(8..8)  &  A(6..8)  &  A(6..8)  &  "EA"; 
+           IF  A  /=  "GIDGIDGEA"  THEN
+                FAILED( "WRONG VALUES  -  C6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      RESULT; 
+ 
+ 
+ END C52102C; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52102d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52102d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,307 ----
+ -- C52102D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+ --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+ --    THE SEMANTICS OF "COPY" ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES
+ --    REQUIRE RUN-TIME EVALUATION.   (THIS TEST IS IN TWO PARTS,
+ --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+ 
+ -- PART 2:  DYNAMIC BOUNDS
+ 
+ 
+ -- RM 02/27/80
+ -- SPS 2/18/83
+ -- JBG 3/15/84
+ -- JBG 6/9/84
+ -- BHS 6/26/84
+ 
+ WITH REPORT;
+ PROCEDURE  C52102D  IS
+ 
+      USE  REPORT; 
+      IDENT_INT_0 : INTEGER := IDENT_INT(0);
+      IDENT_INT_1 : INTEGER := IDENT_INT (1);
+      IDENT_INT_2 : INTEGER := IDENT_INT (2);
+      IDENT_INT_3 : INTEGER := IDENT_INT (3);
+      IDENT_INT_4 : INTEGER := IDENT_INT (4);
+      IDENT_INT_5 : INTEGER := IDENT_INT (5);
+      IDENT_INT_6 : INTEGER := IDENT_INT (6);
+      IDENT_INT_8 : INTEGER := IDENT_INT (8);
+      IDENT_INT_9 : INTEGER := IDENT_INT (9);
+ 
+      FUNCTION ID_I (X : INTEGER) RETURN INTEGER RENAMES IDENT_INT;
+      FUNCTION ID_B (X : BOOLEAN) RETURN BOOLEAN RENAMES IDENT_BOOL;
+ 
+ BEGIN
+ 
+ 
+      TEST( "C52102D" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                        "ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES " &
+                        "ARE DYNAMIC  (PART 2: DYNAMIC BOUNDS)" );
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF INTEGERS  -------------------------
+ 
+      DECLARE
+           A   :    ARRAY( 1..IDENT_INT_4 ) OF INTEGER; 
+ 
+      BEGIN
+           A   :=   ( ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14) );
+           A   :=   (  1   , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                               A(IDENT_INT_1) );
+           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+                FAILED( "WRONG VALUES  -  I1" );
+           END IF;
+ 
+           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14) );
+           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                                        A(IDENT_INT_4) ,  1   );
+           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+                FAILED( "WRONG VALUES  -  I2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( -4..IDENT_INT_4 ) OF INTEGER; 
+ 
+      BEGIN
+           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+                     ID_I(100), ID_I(1), ID_I(2), ID_I(3), ID_I(4));
+           A(-4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+           IF    A   /=  ( 100 , 1 , 2 , 3 , 4 , 1 , 2 , 3 , 4 )
+           THEN
+                FAILED( "WRONG VALUES  -  I3" );
+           END IF;
+ 
+           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+                     ID_I(100), ID_I(1), ID_I(2), ID_I(3), ID_I(4));
+           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+           IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+           THEN
+                FAILED( "WRONG VALUES  -  I4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           A   :  INT_ARR (1..10);
+ 
+      BEGIN
+           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10));
+           A   :=  0  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                         A(IDENT_INT_1..IDENT_INT_2)  &
+                         A(IDENT_INT_1..IDENT_INT_5); 
+           IF     A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+           THEN
+                FAILED( "WRONG VALUES  -  I5" );
+           END IF;
+ 
+           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10));
+           A   :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                   A(IDENT_INT_8..IDENT_INT_9)  &
+                   A(IDENT_INT_8..IDENT_INT_9)  &  0  &  0; 
+           IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+           THEN
+                FAILED( "WRONG VALUES  -  I6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  ARRAYS OF BOOLEANS  -------------------------
+ 
+      DECLARE
+           A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+           A   :=   (  TRUE  , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                                 A(IDENT_INT_1)  );
+           IF  A /= (  TRUE  ,FALSE , TRUE , FALSE )
+           THEN
+                FAILED( "WRONG VALUES  -  B1" );
+           END IF;
+ 
+           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+           A   :=   (  A(IDENT_INT_4)  , A(IDENT_INT_3) ,
+                                          A(IDENT_INT_4) ,  TRUE );
+           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+           THEN
+                FAILED( "WRONG VALUES  -  B2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    ARRAY( -IDENT_INT_4..4 ) OF BOOLEAN; 
+ 
+      BEGIN
+           A  := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                  ID_B(FALSE), ID_B(TRUE), ID_B(TRUE),
+                  ID_B(TRUE), ID_B(TRUE));
+           A(-IDENT_INT_4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B3" );
+           END IF;
+ 
+           A  := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                  ID_B(TRUE), ID_B(TRUE), ID_B(TRUE),
+                  ID_B(TRUE), ID_B(TRUE));
+           A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+           A  :  B_ARR (1..10); 
+ 
+      BEGIN
+           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE), 
+                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), 
+                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+           A :=  FALSE  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                           A(IDENT_INT_1..IDENT_INT_2)  &
+                           A(IDENT_INT_1..IDENT_INT_5); 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B5" );
+           END IF;
+ 
+           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
+                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
+                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+           A :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                 A(IDENT_INT_8..IDENT_INT_9)  &
+                 A(IDENT_INT_8..IDENT_INT_9)  &  FALSE  &  TRUE; 
+           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+           THEN
+                FAILED( "WRONG VALUES  -  B6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+      --------------------  CHARACTER STRINGS  --------------------------
+ 
+      DECLARE
+           A   :    STRING( 1..4 ); 
+ 
+      BEGIN
+           IF EQUAL (3,3) THEN          
+                A   :=   "ARGH"; 
+           END IF;
+           A   :=   (  'Q' , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                               A(IDENT_INT_1) );
+           IF  A /= "QARA"  THEN
+                FAILED( "WRONG VALUES  -  C1" );
+           END IF;
+ 
+           IF EQUAL (3,3) THEN
+                A   :=   "ARGH"; 
+           END IF;
+           A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                      A(IDENT_INT_4) , 'X' );
+           IF  A /= "HGHX"  THEN
+                FAILED( "WRONG VALUES  -  C2" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           A   :    STRING( IDENT_INT(96)..104 );
+ 
+      BEGIN
+           IF EQUAL (3,3) THEN
+                A  :=  "APHRODITE"; 
+           END IF;
+           A(IDENT_INT(96)..IDENT_INT(100))  :=  A(IDENT_INT(100)..
+                                                   IDENT_INT(104)); 
+           IF   A  /=  "ODITEDITE"   THEN
+                FAILED( "WRONG VALUES  -  C3" );
+           END IF;
+ 
+           IF EQUAL (3,3) THEN
+                A  :=  "APHRODITE"; 
+           END IF;
+           A(IDENT_INT(100)..IDENT_INT(104)) :=  A(IDENT_INT(96)..
+                                                   IDENT_INT(100)) ; 
+           IF   A  /=  "APHRAPHRO"   THEN
+                FAILED( "WRONG VALUES  -  C4" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      DECLARE
+           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+           A  :  CH_ARR (IDENT_INT_1..9); 
+ 
+      BEGIN
+           IF EQUAL (3,3) THEN
+                A  :=  "CAMBRIDGE"; 
+           END IF;
+           A  :=  'S'  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_4); 
+           IF  A  /=  "SCACACAMB"  THEN
+                FAILED( "WRONG VALUES  -  C5" );
+           END IF;
+ 
+           IF EQUAL (3,3) THEN
+                A  :=  "CAMBRIDGE"; 
+           END IF;
+           A  :=  A(IDENT_INT_8..IDENT_INT_8)  &
+                  A(IDENT_INT_6..IDENT_INT_8)  &
+                  A(IDENT_INT_6..IDENT_INT_8)  &  "EA"; 
+           IF  A  /=  "GIDGIDGEA"  THEN
+                FAILED( "WRONG VALUES  -  C6" );
+           END IF;
+ 
+      END; 
+ 
+ 
+      RESULT; 
+ 
+ 
+ END C52102D; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,385 ----
+ -- C52103A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 2/18/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52103A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103A" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+      --                                AND PRECISELY 5 CASES FROM THE
+      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+      --                                                  10-11-12-13-14)
+      --
+      --                              ( IN THE CURRENT DIVISION, THE 5
+      --                                FLOATING SELECTIONS ARE 2-11-4-
+      --                                -13-6 ; THUS THE 8 SELECTIONS ARE
+      --                                2-11-4-13-6-7-8-9 (IN THIS ORDER)
+      --                                .)
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+      --
+      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+      --        IN THE SAME DECLARATION.)
+      --
+      --
+      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+      --        USING AGGREGATES
+      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+      --                SEE  (5) )
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+      --                TO THE TYPEMARK OF  ARR ),
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --        (SINCE WE ARE NOT USING AGGREGATES
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+      --
+      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+      --        ALSO WHEN NO SLIDING IS INVOLVED.)
+      --
+      --
+      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TA21  IS  ARRAY( INTEGER RANGE 1..5 , INTEGER RANGE 0..7
+                                )  OF INTEGER ;
+ 
+           SUBTYPE  TA22  IS  TA21 ;
+ 
+           ARR21  :  TA21 ;
+           ARR22  :  TA22 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+ 
+                FOR  J  IN  0..7  LOOP
+                     ARR21( I , J )  :=   I * I * J  ;
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARR22 := ARR21 ;
+ 
+           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+           FOR  I  IN  1..5  LOOP
+ 
+                FOR  J  IN  0..7  LOOP
+ 
+                     IF  ARR22( I , J )  /=  ( I-0 ) * ( I-0 ) * ( J-0 )
+                     THEN
+                          FAILED( "ARRAY ASSIGNMENT NOT CORRECT" );
+                     END IF;
+ 
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 2" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
+ 
+           ARRX11  :  TABOX11 ;
+           ARRX12  :  TABOX1( 5..9 );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+                ARRX11( I )  :=   I * I  ;
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX12 := ARRX11 ;
+ 
+           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+           FOR  I  IN  5..9  LOOP
+ 
+                IF  ARRX12( I )  /=  ( I-4 ) * ( I-4 )
+                THEN
+                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (11)" );
+                END IF;
+ 
+           END LOOP;
+ 
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 11" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TA42  IS  ARRAY( INTEGER RANGE 1..5 )  OF BOOLEAN ;
+ 
+           SUBTYPE  TA41  IS  TA42 ;
+ 
+           ARR41  :  TA41 ;
+           ARR42  :  TA42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+                ARR41( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+           END LOOP;
+ 
+           ARR41(2) := TRUE ;
+ 
+           ARR41(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+ 
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR42( 1 )  :=  TRUE ;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARR42(2..5) := ARR41(1..4) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           FOR  I  IN  2..5  LOOP
+ 
+                IF  ARR42( I )  /=  FALSE  AND  I /= 3
+                THEN
+                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+                ELSIF  ARR42( I ) /= TRUE  AND  I  = 3
+                THEN
+                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+                END IF;
+ 
+           END LOOP;
+ 
+           IF  ARR42( 1 )  /=  TRUE
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (SLIDING)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 4" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,139 ----
+ -- C52103B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE SECOND FILE IN
+ --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 2/18/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52103B  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103B" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           ARRX31  :  TABOX3( 11..15 );
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARRX31 :=  "QUINC" ; -- "QUINC"(1..5)  SLIDES TO 11..15
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+           IF  ARRX31           /=  "QUINC"  OR
+               ARRX31( 11..15 ) /=  "QUINC"
+           THEN
+                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 13" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+ 
+      DECLARE
+ 
+           TYPE  TA61  IS  ARRAY( INTEGER RANGE 11..15 )  OF CHARACTER ;
+ 
+           ARR61  :  TA61 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR61( 11..11 )  :=  "Q"  ;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARR61( 12..15 ) :=  "UINC" ; -- "UINC"(1..4)  SLIDES TO 12..15
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR61           /=  "QUINC"  OR
+               ARR61( 11..15 ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (6)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 6" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,178 ----
+ -- C52103C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ 
+ 
+ PROCEDURE  C52103C  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103C" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( 1..5 )  := "ABCDE" ;
+           ARR72  :  STRING( 5..9 )  := "FGHIJ" ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+           IF  ARR72 /= "ABCDE"
+           THEN
+                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( 5..9 ) ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR82( 5..5 )  :=  "Q"  ;
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( 5..9 )( 6..9 ) :=  "BCDE" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR82           /=  "QBCDE"  OR
+               ARR82(  5..9  ) /=  "QBCDE"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+ 
+           ARR91  :  STRING( 1..5 )  := "ABCDE" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR92( 5..5 )  :=  "Q"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( 5..9 )( 6..9 ) :=  ARR91( 1..5 )(2..5 )( 2..5 ) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR92           /=  "QBCDE"  OR
+               ARR92(  5..9  ) /=  "QBCDE"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,338 ----
+ -- C52103F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52103F  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103F" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+      --                                AND PRECISELY 5 CASES FROM THE
+      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+      --                                                  10-11-12-13-14)
+      --
+      --                              ( IN THE CURRENT DIVISION, THE 5
+      --                                FLOATING SELECTIONS ARE 10-3-12-
+      --                                -5-14 ; THUS THE 8 SELECTIONS ARE
+      --                                10-3-12-5-14-7-8-9 (IN THIS ORDER
+      --                                ).)
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+      --
+      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+      --        IN THE SAME DECLARATION.)
+      --
+      --
+      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+      --        USING AGGREGATES
+      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+      --                SEE  (5) )
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+      --                TO THE TYPEMARK OF  ARR ),
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --        (SINCE WE ARE NOT USING AGGREGATES
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+      --
+      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+      --        ALSO WHEN NO SLIDING IS INVOLVED.)
+      --
+      --
+      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                  )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX01  IS  TABOX0( 1..0 ,  0..7  );
+           SUBTYPE  TABOX02  IS  TABOX0 ;
+ 
+           ARRX01  :  TABOX01 ;
+           ARRX02  :  TABOX02( 7..6 , 20..27 );
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX02 := ARRX01 ;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 10" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TA3  IS  ARRAY( INTEGER RANGE 100..99 )  OF INTEGER ;
+ 
+           SUBTYPE  TA31  IS  TA3 ;
+           SUBTYPE  TA32  IS  TA3 ;
+ 
+           ARR31  :  TA31 ;
+           ARR32  :  TA32 ;
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARR32 := ARR31 ;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 3" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+ 
+           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
+ 
+           ARRX51  :  TABOX51 ;
+           ARRX52  :  TABOX5( 5..9 );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+           END LOOP;
+ 
+           ARRX51(2) := TRUE ;
+ 
+           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  5..9  LOOP
+                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+           END LOOP;
+ 
+           ARRX52(6) := FALSE ;
+ 
+           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX52(6..5) := ARRX51(4..3) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARRX52( 5 )  /=  TRUE   OR
+               ARRX52( 6 )  /=  FALSE  OR
+               ARRX52( 7 )  /=  TRUE   OR
+               ARRX52( 8 )  /=  TRUE   OR
+               ARRX52( 9 )  /=  FALSE
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                 FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C52103G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE SECOND FILE IN
+ --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52103G  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103G" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+ 
+      DECLARE
+ 
+           TYPE  TA51  IS  ARRAY( INTEGER RANGE 11..10 )  OF CHARACTER ;
+ 
+           ARR51  :  TA51 ;
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARR51 :=  "" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+           IF  ARR51           /=  ""
+           THEN
+                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (5)" );
+           END IF;
+ 
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 5" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           SUBTYPE  TABOX42  IS  TABOX4( 11..15 );
+ 
+           ARRX42  :  TABOX42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARRX42  :=  "QUINC"  ;
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX42( 13..12 ) :=  "" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARRX42           /=  "QUINC"  OR
+               ARRX42( 11..15 ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (14)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 14" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,175 ----
+ -- C52103H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52103H  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103H" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( 1..0 )  := "" ;
+           ARR72  :  STRING( 5..4 )  ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+           IF  ARR72 /= ""
+           THEN
+                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( 5..9 ) ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR82( 5..9 )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( 5..9 )( 6..9 )( 6..5 ) :=  "" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR82           /=  "QUINC"  OR
+               ARR82(  5..9  ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+ 
+           ARR91  :  STRING( 1..5 )  := "ABCDE" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR92( 5..9 )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( 5..9 )( 6..9 )( 8..7 ) :=  ARR91( 1..5 )( 5..4 ) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR92           /=  "QUINC"  OR
+               ARR92(  5..9  ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,393 ----
+ -- C52103K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+ --                   STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52103K  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+      --                                AND PRECISELY 5 CASES FROM THE
+      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+      --                                                  10-11-12-13-14)
+      --
+      --                              ( IN THE CURRENT DIVISION, THE 5
+      --                                FLOATING SELECTIONS ARE 2-11-4-
+      --                                -13-6 ; THUS THE 8 SELECTIONS ARE
+      --                                2-11-4-13-6-7-8-9 (IN THIS ORDER)
+      --                                .)
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+      --
+      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+      --        IN THE SAME DECLARATION.)
+      --
+      --
+      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+      --        USING AGGREGATES
+      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+      --                SEE  (5) )
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+      --                TO THE TYPEMARK OF  ARR ),
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --        (SINCE WE ARE NOT USING AGGREGATES
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+      --
+      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+      --        ALSO WHEN NO SLIDING IS INVOLVED.)
+      --
+      --
+      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TA21  IS  ARRAY(
+                INTEGER RANGE IDENT_INT(1)..IDENT_INT(5) ,
+                INTEGER RANGE IDENT_INT(0)..IDENT_INT(7)
+                                )  OF INTEGER ;
+ 
+           SUBTYPE  TA22  IS  TA21 ;
+ 
+           ARR21  :  TA21 ;
+           ARR22  :  TA22 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+ 
+                FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
+                     ARR21( I , J )  :=   I * I * J  ;
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARR22 := ARR21 ;
+ 
+           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+ 
+                FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
+ 
+                     IF  ARR22( I , J )  /=  ( I-0 ) * ( I-0 ) * ( J-0 )
+                     THEN
+                          FAILED( "ARRAY ASSIGNMENT NOT CORRECT" );
+                     END IF;
+ 
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 2" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ;
+ 
+           ARRX11  :  TABOX11 ;
+           ARRX12  :  TABOX1( IDENT_INT(5)..IDENT_INT(9) );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+                ARRX11( I )  :=   I * I  ;
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX12 := ARRX11 ;
+ 
+           -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+ 
+                IF  ARRX12( I )  /=  ( I-4 ) * ( I-4 )
+                THEN
+                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (11)" );
+                END IF;
+ 
+           END LOOP;
+ 
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 11" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TA42  IS  ARRAY(
+                INTEGER RANGE IDENT_INT(1)..IDENT_INT(5)
+                                )  OF BOOLEAN ;
+ 
+           SUBTYPE  TA41  IS  TA42 ;
+ 
+           ARR41  :  TA41 ;
+           ARR42  :  TA42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+                ARR41( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+           END LOOP;
+ 
+           ARR41(2) := TRUE ;
+ 
+           ARR41(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+ 
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR42( 1 )  :=  TRUE ;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARR42( IDENT_INT(2)..IDENT_INT(5) ) :=
+                ARR41(
+                  IDENT_INT(1)..IDENT_INT(4) ) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           FOR  I  IN  IDENT_INT(2)..IDENT_INT(5)  LOOP
+ 
+                IF  ARR42( I )  /=  FALSE  AND  I /= 3
+                THEN
+                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+                ELSIF  ARR42( I ) /= TRUE  AND  I  = 3
+                THEN
+                     FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+                END IF;
+ 
+           END LOOP;
+ 
+           IF  ARR42( 1 )  /=  TRUE
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (SLIDING)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 4" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C52103L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE SECOND FILE IN
+ --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+ --                   STATICALLY.
+ 
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52103L  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103L" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           ARRX31  :  TABOX3( IDENT_INT(11)..IDENT_INT(15) );
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARRX31 :=  "QUINC" ; -- "QUINC"(1..5)  SLIDES TO 11..15
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+           IF  ARRX31                                 /=  "QUINC"  OR
+               ARRX31( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
+           THEN
+                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 13" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+ 
+      DECLARE
+ 
+           TYPE  TA61  IS  ARRAY(
+                INTEGER RANGE IDENT_INT(11)..IDENT_INT(15)
+                                )  OF CHARACTER ;
+ 
+           ARR61  :  TA61 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR61( IDENT_INT(11)..IDENT_INT(11) )  :=  "Q"  ;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARR61( IDENT_INT(12)..IDENT_INT(15) ) :=  "UINC" ;
+                                    -- "UINC"(1..4)  SLIDES TO 12..15
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR61                                 /=  "QUINC"  OR
+               ARR61( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (6)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 6" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C52103L ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- C52103M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+ --                   STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52103M  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103M" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(9) )  := "FGHIJ" ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+           IF  ARR72 /= "ABCDE"
+           THEN
+                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR82( IDENT_INT(5)..IDENT_INT(5) )  :=  "Q"  ;
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) ) :=  "BCDE" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR82                                 /=  "QBCDE"  OR
+               ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QBCDE"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+ 
+           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(5) )  :=  "Q"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) ) :=
+                ARR91
+                ( IDENT_INT(1)..IDENT_INT(5) )
+                ( IDENT_INT(2)..IDENT_INT(5) )
+                ( IDENT_INT(2)..IDENT_INT(5) ) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR92                                 /=  "QBCDE"  OR
+               ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QBCDE"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C52103M ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,344 ----
+ -- C52103P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52103P  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103P" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+      --                                AND PRECISELY 5 CASES FROM THE
+      --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+      --                                                  10-11-12-13-14)
+      --
+      --                              ( IN THE CURRENT DIVISION, THE 5
+      --                                FLOATING SELECTIONS ARE 10-3-12-
+      --                                -5-14 ; THUS THE 8 SELECTIONS ARE
+      --                                10-3-12-5-14-7-8-9 (IN THIS ORDER
+      --                                ).)
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+      --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+      --
+      --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+      --        IN THE SAME DECLARATION.)
+      --
+      --
+      --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+      --        USING AGGREGATES
+      --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+      --                SEE  (5) )
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+      --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+      --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+      --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+      --                TO THE TYPEMARK OF  ARR ),
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --        (SINCE WE ARE NOT USING AGGREGATES
+      --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+      --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+      --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+      --
+      --
+      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+      --
+      --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+      --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+      --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+      --        ALSO WHEN NO SLIDING IS INVOLVED.)
+      --
+      --
+      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                  )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(0) ,
+                                         IDENT_INT(0)..IDENT_INT(7)  );
+           SUBTYPE  TABOX02  IS  TABOX0 ;
+ 
+           ARRX01  :  TABOX01 ;
+           ARRX02  :  TABOX02( IDENT_INT(7)..IDENT_INT(6) ,
+                               IDENT_INT(20)..IDENT_INT(27) );
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX02 := ARRX01 ;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 10" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TA3  IS  ARRAY(
+                INTEGER RANGE IDENT_INT(100)..IDENT_INT(99)
+                               )  OF INTEGER ;
+ 
+           SUBTYPE  TA31  IS  TA3 ;
+           SUBTYPE  TA32  IS  TA3 ;
+ 
+           ARR31  :  TA31 ;
+           ARR32  :  TA32 ;
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARR32 := ARR31 ;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 3" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+ 
+           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
+ 
+           ARRX51  :  TABOX51 ;
+           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+           END LOOP;
+ 
+           ARRX51(2) := TRUE ;
+ 
+           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+           END LOOP;
+ 
+           ARRX52(6) := FALSE ;
+ 
+           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX52( IDENT_INT(6)..IDENT_INT(5) ) :=
+                ARRX51(
+                   IDENT_INT(4)..IDENT_INT(3) ) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARRX52( 5 )  /=  TRUE   OR
+               ARRX52( 6 )  /=  FALSE  OR
+               ARRX52( 7 )  /=  TRUE   OR
+               ARRX52( 8 )  /=  TRUE   OR
+               ARRX52( 9 )  /=  FALSE
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                 FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103q.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103q.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103q.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,143 ----
+ -- C52103Q.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSWEWHERE.)
+ 
+ -- THIS IS THE SECOND FILE IN
+ --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 2/18/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52103Q  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103Q" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+ 
+      DECLARE
+ 
+           TYPE  TA51  IS  ARRAY(
+                INTEGER RANGE IDENT_INT(11)..IDENT_INT(10)
+                                )  OF CHARACTER ;
+ 
+           ARR51  :  TA51 ;
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARR51 :=  "" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+           IF  ARR51           /=  ""
+           THEN
+                FAILED( "ARRAY ASSIGNMENT NOT CORRECT (5)" );
+           END IF;
+ 
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 5" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(11)..IDENT_INT(15) );
+ 
+           ARRX42  :  TABOX42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARRX42  :=  "QUINC"  ;
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX42( IDENT_INT(13)..IDENT_INT(12) ) :=  "" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARRX42                                 /=  "QUINC"  OR
+               ARRX42( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (14)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 14" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103Q;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103r.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103r.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103r.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,181 ----
+ -- C52103R.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSWEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 2/18/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52103R  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103R" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(0) )  := "" ;
+           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(4) )  ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+           IF  ARR72 /= ""
+           THEN
+                FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR82( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(5) ) :=  "" ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR82                                 /=  "QUINC"  OR
+               ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+ 
+           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) )
+                ( IDENT_INT(8)..IDENT_INT(7) ) :=
+                ARR91
+                ( IDENT_INT(1)..IDENT_INT(5) )
+                ( IDENT_INT(5)..IDENT_INT(4) ) ;
+ 
+ 
+           -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+           IF  ARR92                                 /=  "QUINC"  OR
+               ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+           THEN
+                FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103R;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103x.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52103x.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52103x.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,241 ----
+ -- C52103X.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+ --    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+ --    ARE PERFORMED CORRECTLY.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS A SPECIAL CASE IN
+ 
+ --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+ --                   STATICALLY
+ 
+ -- WHICH TREATS ARRAYS OF LENGTH GREATER THAN  INTEGER'LAST .
+ --    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
+ --    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE
+ --    CONSTRAINT_ERROR TO BE RAISED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- RM  07/31/81
+ -- SPS 10/26/82
+ -- JBG 06/15/83
+ -- EG  11/02/84
+ -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --               AI-00387.
+ -- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
+ -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT;
+ PROCEDURE  C52103X  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52103X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
+                        "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
+                        "CHECK WHETHER CONSTRAINT_ERROR " &
+                        "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS" );
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+ CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
+                     -- FOR THE TYPE DECLARATION.
+      BEGIN
+ 
+ DCL_ARR:  DECLARE   -- THIS BLOCK DECLARES THE ARRAY TYPE
+ 
+                TYPE  TA42  IS  ARRAY(
+                     INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST)
+                                     )  OF BOOLEAN ;
+                -- CONSTRAINT_ERROR MAY BE RAISED BY THE
+                -- ARRAY TYPE DECLARATION.
+                PRAGMA PACK (TA42);
+ 
+                SUBTYPE  TA41  IS  TA42 ;
+ 
+           BEGIN
+ 
+                COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
+                         "WITH 'LENGTH = INTEGER'LAST + 3");
+ 
+ OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
+                          -- HAVE INTEGER'LAST + 3 COMPONENTS;
+                          -- STORAGE_ERROR MAY BE RAISED.
+                     ARR41  :  TA41 ;
+                     ARR42  :  TA42 ;
+ 
+                BEGIN
+ 
+                COMMENT ("NO STORAGE_ERROR OR CONSTRAINT_ERROR RAISED " &
+                         "WHEN ALLOCATING TWO BIG BOOLEAN ARRAYS");
+                -- INITIALIZATION OF RHS ARRAY:
+ 
+                -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
+                -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
+                -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
+                -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
+ 
+ NO_EXCP:       BEGIN     -- NO EXCEPTION SHOULD OCCUR HERE.
+                     FOR  I  IN  IDENT_INT(-2)..IDENT_INT(2)  LOOP
+                          ARR41(I)  :=  FALSE  ;  -- VALUES ARE:: FTFFT
+                     END LOOP;
+ 
+                     ARR41(-1) := TRUE ;
+ 
+                     ARR41( 2) := TRUE ;          -- RHS IS: F T F F T
+ 
+ 
+                     -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+ 
+                     ARR42( -2 )  :=  TRUE ;
+ 
+                EXCEPTION
+ 
+                     WHEN CONSTRAINT_ERROR =>
+                          FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
+                                  "ASSIGNING TO ARRAY COMPONENTS");
+                     WHEN OTHERS =>
+                          FAILED ("OTHER EXCEPTION RAISED - 1");
+ 
+                END NO_EXCP;
+ 
+ DO_SLICE:      BEGIN
+                     -- SLICE ASSIGNMENT:
+ 
+                     ARR42(  IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
+                          ARR41(
+                             IDENT_INT(-2)..IDENT_INT(INTEGER'LAST-1)) ;
+ 
+                     COMMENT ("NO EXCEPTION RAISED DURING SLICE " &
+                              "ASSIGNMENT");
+ 
+                     -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+      CHK_SLICE:     BEGIN
+                          FOR  I  IN  IDENT_INT(-1)..IDENT_INT(2)  LOOP
+ 
+                               IF  ARR42( I )  /=  FALSE  AND  I /= 0
+                               THEN
+                                    FAILED( "SLICE ASSIGNMENT NOT " &
+                                            "CORRECT (VALUES)" );
+                               ELSIF  ARR42( I ) /= TRUE  AND  I  = 0
+                               THEN
+                                    FAILED( "SLICE ASSIGNMENT NOT " &
+                                            "CORRECT (VALUES)" );
+                               END IF;
+ 
+                          END LOOP;
+ 
+                          IF  ARR42( -2 )  /=  TRUE
+                          THEN
+                               FAILED( "SLICE ASSIGNMENT NOT CORRECT " &
+                                       "(SLIDING)" );
+                          END IF;
+ 
+                     EXCEPTION
+ 
+                          WHEN OTHERS =>
+                               FAILED ("SOME EXCEPTION RAISED - 2");
+ 
+                     END CHK_SLICE;
+ 
+                EXCEPTION
+ 
+                     WHEN CONSTRAINT_ERROR =>
+                          COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
+                                   "SLICE ASSIGNMENT");
+                     WHEN STORAGE_ERROR =>
+                          COMMENT ("STORAGE_ERROR RAISED DURING SLICE " &
+                                   "ASSIGNMENT");
+                     WHEN OTHERS =>
+                          FAILED ("SOME EXCEPTION DURING SLICE " &
+                                  "ASSIGNMENT");
+                END DO_SLICE;
+ 
+           END OBJ_DCL;
+ 
+           EXCEPTION
+ 
+                WHEN STORAGE_ERROR =>
+                     COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
+                              "TWO PACKED BOOLEAN ARRAYS WITH " &
+                              "INTEGER'LAST + 3 COMPONENTS");
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
+                              "TWO PACKED BOOLEAN ARRAYS WITH " &
+                              "INTEGER'LAST + 3 COMPONENTS");
+                WHEN OTHERS =>
+                     FAILED ("SOME EXCEPTION RAISED - 3");
+ 
+           END DCL_ARR;
+ 
+      EXCEPTION
+ 
+ 
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
+                         "ARRAY TYPE WITH INTEGER'LAST + 3 COMPONENTS");
+ 
+           WHEN STORAGE_ERROR =>
+                FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
+ 
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 4");
+ 
+      END CONSTR_ERR;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52103X;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,343 ----
+ -- C52104A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52104A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104A" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+      --                                SERIES 10-11-12-13-14 FOLLOWED
+      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (1..6: NOT APPLICABLE)
+      --
+      --
+ 
+      -------------------------------------------------------------------
+ 
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                  )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX01  IS  TABOX0( 1..5 ,  0..7  );
+           SUBTYPE  TABOX02  IS  TABOX0( 0..5 ,  2..9  );
+ 
+           ARRX01  :  TABOX01 ;
+           ARRX02  :  TABOX02 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+ 
+                FOR  J  IN  0..7  LOOP
+                     ARRX01( I , J )  :=   I * I * J  ;
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  0..5  LOOP
+ 
+                FOR  J  IN  2..9  LOOP
+                     ARRX02( I , J )  :=   I * I * J * 3  ;
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX02 := ARRX01 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+                FOR  I  IN  0..5  LOOP
+ 
+                     FOR  J  IN  2..9  LOOP
+ 
+                          IF  ARRX02( I , J )  /=   I * I * J * 3
+                          THEN
+                               FAILED( "ORIG. VALUE ALTERED (10)" );
+                          END IF;
+ 
+                     END LOOP;
+ 
+                END LOOP;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
+ 
+           ARRX11  :  TABOX11 ;
+           ARRX12  :  TABOX1( 6..9 );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+ 
+                ARRX11( I )  :=   I * I  ;
+ 
+           END LOOP;
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  6..9  LOOP
+                ARRX12( I )  :=   I * I * 3  ;
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX12 := ARRX11 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+                FOR  I  IN  6..9  LOOP
+ 
+                     IF  ARRX12( I )  /=   I * I * 3
+                     THEN
+                          FAILED( "ORIG. VALUE ALTERED (11)" );
+                     END IF;
+ 
+                END LOOP;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+ 
+           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
+ 
+           ARRX51  :  TABOX51 ;
+           ARRX52  :  TABOX5( 5..9 );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  5..9  LOOP
+                ARRX52( I )  :=  FALSE  ;
+           END LOOP;
+ 
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+                ARRX51( I )  :=  TRUE  ;
+           END LOOP;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARRX52(6..9) := ARRX51(3..3) ;
+           FAILED( "EXCEPTION NOT RAISED  (12)" );
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                FOR  I  IN  5..9  LOOP
+ 
+                     IF  ARRX52( I )  /=  FALSE
+                     THEN
+                          FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
+                     END IF;
+ 
+                END LOOP;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- C52104B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE SECOND FILE IN
+ --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52104B  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104B" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           ARRX31  :  TABOX3( 2..6 )  :=  "QUINC"  ;
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARRX31 :=  "ABCD" ;
+           FAILED( "NO EXCEPTION RAISED  (13)" );
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+                IF  ARRX31           /=  "QUINC"  OR
+                    ARRX31(  2..6  ) /=  "QUINC"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (13)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           SUBTYPE  TABOX42  IS  TABOX4( 5..9 );
+ 
+           ARRX42  :  TABOX42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARRX42  :=  "QUINC"  ;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARRX42( 6..9 )  :=  "ABCDEFGH"  ;
+           FAILED( "NO EXCEPTION RAISED  (14)" );
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+                IF  ARRX42           /=  "QUINC"  OR
+                    ARRX42(  5..9  ) /=  "QUINC"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (14)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,178 ----
+ -- C52104C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52104C  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104C" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( 1..5 )  := "ABCDE" ;
+           ARR72  :  STRING( 5..8 )  := "FGHI"  ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF  ARR72 /= "FGHI"
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( 5..9 )  :=  "QBCDE"  ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( 5..9 )( 6..9 ) :=  "EIN" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARR82           /=  "QBCDE"  OR
+                    ARR82(  5..9  ) /=  "QBCDE"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (8)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+ 
+           ARR91  :  STRING( 1..7 )  := "ABCDEFG" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR92( 5..9 )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( 5..9 )( 6..9 ) :=  ARR91( 1..7 )( 1..6 )( 1..6 ) ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARR92           /=  "QUINC"  OR
+                    ARR92(  5..9  ) /=  "QUINC"
+                THEN
+                     FAILED( "LHS VALUE ALTERED  (9)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,292 ----
+ -- C52104F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSWEWHERE.)
+ 
+ --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 10/27/82
+ 
+ WITH REPORT;
+ PROCEDURE  C52104F  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104F" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+      --                                SERIES 10-11-12-13-14 FOLLOWED
+      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (1 .. 6: NOT APPLICABLE)
+      --
+      --
+ 
+      -------------------------------------------------------------------
+ 
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                  )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX01  IS  TABOX0( 1..1 ,  0..7  );
+           SUBTYPE  TABOX02  IS  TABOX0 ;
+ 
+           ARRX01  :  TABOX01 ;
+           ARRX02  :  TABOX02( 1..0 , 0..7 );
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX02 := ARRX01 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                NULL ;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX11  IS  TABOX1( 4..5 ) ;
+ 
+           ARRX11  :  TABOX11 ;
+           ARRX12  :  TABOX1( 5..4 );
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX12 := ARRX11 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                NULL ;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+ 
+           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
+ 
+           ARRX51  :  TABOX51 ;
+           ARRX52  :  TABOX5( 5..9 );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  1..5  LOOP
+                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+           END LOOP;
+ 
+           ARRX51(2) := TRUE ;
+ 
+           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  5..9  LOOP
+                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+           END LOOP;
+ 
+           ARRX52(6) := FALSE ;
+ 
+           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX52( 6..5 ) := ARRX51( 4..4 ) ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+                IF  ARRX52( 5 )  /=  TRUE   OR
+                    ARRX52( 6 )  /=  FALSE  OR
+                    ARRX52( 7 )  /=  TRUE   OR
+                    ARRX52( 8 )  /=  TRUE   OR
+                    ARRX52( 9 )  /=  FALSE
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (12)" );
+                END IF;
+ 
+           WHEN  OTHERS =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- C52104G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE SECOND FILE IN
+ --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ -- JBG 4/24/84
+ 
+ WITH REPORT;
+ PROCEDURE  C52104G  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104G" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX3  IS  ARRAY( NATURAL RANGE <> )  OF CHARACTER ;
+ 
+           ARRX31  :  TABOX3( 11..10 )  :=  ""  ;
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARRX31 :=  "AZ" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 13" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARRX31  /=  ""
+                THEN
+                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+                END IF;
+ 
+           WHEN  OTHERS =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           SUBTYPE  TABOX42  IS  TABOX4( 11..15 );
+ 
+           ARRX42  :  TABOX42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARRX42  :=  "QUINC"  ;
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX42( 13..12 ) :=  "ABCD" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 14" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARRX42           /=  "QUINC"  OR
+                    ARRX42( 11..15 ) /=  "QUINC"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (14)" );
+                END IF;
+ 
+           WHEN  OTHERS =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- C52104H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52104H  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104H" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( 1..1 )  := "A" ;
+           ARR72  :  STRING( 5..4 )  := ""  ;
+ 
+      BEGIN
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF  ARR72 /= ""
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( 5..9 ) ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR82( 5..9 )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( 5..9 )( 6..9 )( 6..5 ) :=  "ABC" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF  ARR82           /=  "QUINC"  OR
+                    ARR82(  5..9  ) /=  "QUINC"
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (8)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+ 
+           ARR91  :  STRING( 1..5 )  := "ABCDE" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR92( 5..9 )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( 5..9 )( 6..9 )( 8..7 ) :=  ARR91( 1..5 )( 5..7 ) ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF ARR92           /=  "QUINC"  OR
+                   ARR92(  5..9  ) /=  "QUINC"
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (9)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,347 ----
+ -- C52104K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ --    DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52104K  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+      --                                SERIES 10-11-12-13-14 FOLLOWED
+      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+      --    (-) THE STATIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+      --        VISIONS A (FOR NON-NULL ARRAYS) AND B (FOR NULL ARRAYS).
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (1..6: NOT APPLICABLE)
+      --
+      --
+ 
+      -------------------------------------------------------------------
+ 
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                  )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(5) ,
+                                         IDENT_INT(0)..IDENT_INT(7) );
+           SUBTYPE  TABOX02  IS  TABOX0( IDENT_INT(0)..IDENT_INT(5) ,
+                                         IDENT_INT(2)..IDENT_INT(9) );
+ 
+           ARRX01  :  TABOX01 ;
+           ARRX02  :  TABOX02 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+ 
+                FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
+                     ARRX01( I , J )  :=   I * I * J  ;
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
+ 
+                FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
+                     ARRX02( I , J )  :=   I * I * J * 3  ;
+                END LOOP;
+ 
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX02 := ARRX01 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+                FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
+ 
+                     FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
+ 
+                          IF  ARRX02( I , J )  /=   I * I * J * 3
+                          THEN
+                               FAILED( "ORIG. VALUE ALTERED (10)" );
+                          END IF;
+ 
+                     END LOOP;
+ 
+                END LOOP;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ;
+ 
+           ARRX11  :  TABOX11 ;
+           ARRX12  :  TABOX1( IDENT_INT(6)..IDENT_INT(9) );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+ 
+                ARRX11( I )  :=   I * I  ;
+ 
+           END LOOP;
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
+                ARRX12( I )  :=   I * I * 3  ;
+           END LOOP;
+ 
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX12 := ARRX11 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+ 
+                FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
+ 
+                     IF  ARRX12( I )  /=   I * I * 3
+                     THEN
+                          FAILED( "ORIG. VALUE ALTERED (11)" );
+                     END IF;
+ 
+                END LOOP;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+ 
+           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
+ 
+           ARRX51  :  TABOX51 ;
+           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+                ARRX52( I )  :=  FALSE  ;
+           END LOOP;
+ 
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+                ARRX51( I )  :=  TRUE  ;
+           END LOOP;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARRX52( IDENT_INT(6)..IDENT_INT(9) ) :=
+                ARRX51(
+                   IDENT_INT(3)..IDENT_INT(3) ) ;
+           FAILED( "EXCEPTION NOT RAISED  (12)" );
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+ 
+                     IF  ARRX52( I )  /=  FALSE
+                     THEN
+                          FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
+                     END IF;
+ 
+                END LOOP;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- C52104L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --     MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --     ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --     INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --     (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --     ARE TREATED ELSEWHERE.)
+ 
+ --     THIS IS THE SECOND FILE IN
+ --     DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ -- HISTORY:
+ --     RM  07/20/81 CREATED ORIGINAL TEST.
+ --     SPS 03/22/83
+ --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT;
+ PROCEDURE  C52104L  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104L" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           ARRX31  :  TABOX3( IDENT_INT(2)..IDENT_INT(6) )  := "QUINC" ;
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARRX31 :=  "ABCD" ;
+           FAILED( "NO EXCEPTION RAISED  (13)" );
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+                IF  ARRX31                               /=  "QUINC"  OR
+                    ARRX31( IDENT_INT(2)..IDENT_INT(6) ) /=  "QUINC"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (13)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(5)..IDENT_INT(9) );
+ 
+           ARRX42  :  TABOX42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARRX42  :=  "QUINC"  ;
+ 
+ 
+           -- SLICE ASSIGNMENT:
+ 
+           ARRX42( IDENT_INT(6)..IDENT_INT(9) )  :=  "ABCDEFGH"  ;
+           FAILED( "NO EXCEPTION RAISED  (14)" );
+ 
+      EXCEPTION
+ 
+           WHEN CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+ 
+                IF  ARRX42                               /=  "QUINC"  OR
+                    ARRX42( IDENT_INT(5)..IDENT_INT(9) ) /=  "QUINC"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (14)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,184 ----
+ -- C52104M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52104M  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104M" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(8) )  := "FGHI"  ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF  ARR72 /= "FGHI"
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) )  :=  "QBCDE"  ;
+ 
+      BEGIN
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) ) :=  "EIN" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARR82                               /=  "QBCDE"  OR
+                    ARR82( IDENT_INT(5)..IDENT_INT(9) ) /=  "QBCDE"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (8)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+ 
+           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(7) )  := "ABCDEFG" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) ) :=
+                ARR91
+                ( IDENT_INT(1)..IDENT_INT(7) )
+                ( IDENT_INT(1)..IDENT_INT(6) )
+                ( IDENT_INT(1)..IDENT_INT(6) ) ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARR92                               /=  "QUINC"  OR
+                    ARR92( IDENT_INT(5)..IDENT_INT(9) ) /=  "QUINC"
+                THEN
+                     FAILED( "LHS VALUE ALTERED  (9)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104p.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104p.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104p.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104p.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,292 ----
+ -- C52104P.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C52104P  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104P" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+      --
+      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+      --                                SERIES 10-11-12-13-14 FOLLOWED
+      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+      --
+      --
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+      --
+      --
+      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+      --
+      --
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+      --
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+      --
+      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+      --
+      --
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+      --
+      --
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+      --
+      --
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+      --        BY THE TYPEMARK WILL NOT BE  1 .)
+      --
+      --
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+      --
+      --
+      --
+      --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+      --                                            ARRAYS ONLY,
+      --                                            DIVISIONS C AND D .)
+      --
+      --
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (1 .. 6: NOT APPLICABLE)
+      --
+      --
+ 
+      -------------------------------------------------------------------
+ 
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                  )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(1) ,
+                                         IDENT_INT(0)..IDENT_INT(7)  );
+           SUBTYPE  TABOX02  IS  TABOX0 ;
+ 
+           ARRX01  :  TABOX01 ;
+           ARRX02  :  TABOX02( IDENT_INT(1)..IDENT_INT(0) ,
+                               IDENT_INT(0)..IDENT_INT(7) );
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX02 := ARRX01 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                NULL ;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+ 
+           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(4)..IDENT_INT(5) ) ;
+ 
+           ARRX11  :  TABOX11 ;
+           ARRX12  :  TABOX1( IDENT_INT(5)..IDENT_INT(4) );
+ 
+      BEGIN
+ 
+           -- ARRAY ASSIGNMENT:
+ 
+           ARRX12 := ARRX11 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                NULL ;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+      DECLARE
+ 
+           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+ 
+           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
+ 
+           ARRX51  :  TABOX51 ;
+           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF RHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+           END LOOP;
+ 
+           ARRX51(2) := TRUE ;
+ 
+           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+           END LOOP;
+ 
+           ARRX52(6) := FALSE ;
+ 
+           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX52( IDENT_INT(6)..IDENT_INT(5) ) :=
+                ARRX51
+                 ( IDENT_INT(4)..IDENT_INT(4) ) ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+                IF  ARRX52( 5 )  /=  TRUE   OR
+                    ARRX52( 6 )  /=  FALSE  OR
+                    ARRX52( 7 )  /=  TRUE   OR
+                    ARRX52( 8 )  /=  TRUE   OR
+                    ARRX52( 9 )  /=  FALSE
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (12)" );
+                END IF;
+ 
+           WHEN  OTHERS =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104q.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104q.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104q.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- C52104Q.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE SECOND FILE IN
+ --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ -- JBG 4/24/84
+ 
+ WITH REPORT;
+ PROCEDURE  C52104Q  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104Q" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX3  IS  ARRAY( NATURAL RANGE <> )  OF CHARACTER ;
+ 
+           ARRX31  :  TABOX3( IDENT_INT(11)..IDENT_INT(10) )  :=  ""  ;
+ 
+      BEGIN
+ 
+ 
+           -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+ 
+           ARRX31 :=  "AZ" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 13" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARRX31  /=  ""
+                THEN
+                     FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+                END IF;
+ 
+           WHEN  OTHERS =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+ 
+      DECLARE
+ 
+           TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+ 
+           SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(11)..IDENT_INT(15) );
+ 
+           ARRX42  :  TABOX42 ;
+ 
+      BEGIN
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARRX42  :=  "QUINC"  ;
+ 
+ 
+           -- NULL SLICE ASSIGNMENT:
+ 
+           ARRX42( IDENT_INT(13)..IDENT_INT(12) ) :=  "ABCD" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 14" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+ 
+                IF  ARRX42                                 /= "QUINC"  OR
+                    ARRX42( IDENT_INT(11)..IDENT_INT(15) ) /= "QUINC"
+                THEN
+                     FAILED( "LHS ARRAY ALTERED  (14)" );
+                END IF;
+ 
+           WHEN  OTHERS =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104Q;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104r.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104r.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104r.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104r.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,190 ----
+ -- C52104R.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS THE THIRD FILE IN
+ --    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+ 
+ 
+ -- RM 07/20/81
+ -- SPS 3/22/83
+ 
+ WITH REPORT;
+ PROCEDURE  C52104R  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104R" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+ 
+ 
+      --                              ( EACH DIVISION COMPRISES 3 FILES,
+      --                                COVERING RESPECTIVELY THE FIRST
+      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+      --                                SELECTIONS FOR THE DIVISION.)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+ 
+      DECLARE
+ 
+           ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(1) )  := "A" ;
+           ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(4) )  := ""  ;
+ 
+      BEGIN
+ 
+           -- STRING ASSIGNMENT:
+ 
+           ARR72 := ARR71 ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF  ARR72 /= ""
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (7)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+      --        STRING LITERALS.
+      --
+ 
+      DECLARE
+ 
+           ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR82( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING LITERAL ASSIGNMENT:
+ 
+           ARR82( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(5) ) := "ABC" ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF  ARR82                                 /=  "QUINC"  OR
+                    ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (8)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+      --        THEMSELVES).
+      --
+ 
+      DECLARE
+ 
+           SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+ 
+           ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+           ARR92  :  TA92 ;
+ 
+      BEGIN
+ 
+ 
+           -- INITIALIZATION OF LHS ARRAY:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+ 
+ 
+           -- STRING SLICE ASSIGNMENT:
+ 
+           ARR92( IDENT_INT(5)..IDENT_INT(9) )
+                ( IDENT_INT(6)..IDENT_INT(9) )
+                ( IDENT_INT(8)..IDENT_INT(7) ) :=
+                ARR91
+                ( IDENT_INT(1)..IDENT_INT(5) )
+                ( IDENT_INT(5)..IDENT_INT(7) ) ;
+           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+ 
+      EXCEPTION
+ 
+           WHEN  CONSTRAINT_ERROR =>
+ 
+                -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+ 
+                IF ARR92                                 /=  "QUINC"  OR
+                   ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+                THEN
+                     FAILED( "ORIGINAL VALUE ALTERED (9)" );
+                END IF;
+ 
+           WHEN  OTHERS  =>
+ 
+                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C52104R;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104x.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104x.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104x.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,222 ----
+ -- C52104X.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS A SPECIAL CASE IN
+ 
+ --    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+ --                   STATICALLY
+ 
+ -- WHICH TREATS ARRAYS OF LENGTH GREATER THAN  INTEGER'LAST .
+ --    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
+ --    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE
+ --    CONSTRAINT_ERROR TO BE RAISED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- RM  07/31/81
+ -- SPS 02/07/83
+ -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --               AI-00387.
+ -- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
+ -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X INCOMPATIBILITY
+ 
+ WITH REPORT;
+ PROCEDURE  C52104X  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
+                        "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
+                        "CHECK WHETHER CONSTRAINT_ERROR " &
+                        "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS");
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+      --        WERE DEFINED USING THE "BOX" SYMBOL
+      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+ 
+ CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
+                     -- FOR THE SUBTYPE DECLARATION.
+      BEGIN
+ 
+ DCL_ARR:  DECLARE        -- THIS BLOCK DECLARES THE ARRAY SUBTYPE.
+ 
+                TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+                PRAGMA PACK (TABOX5);
+ 
+                SUBTYPE  TABOX51  IS  TABOX5
+                              (IDENT_INT(-6)..IDENT_INT(INTEGER'LAST-4));
+                -- CONSTRAINT_ERROR MAY BE RAISED BY THIS
+                -- SUBTYPE DECLARATION.
+ 
+           BEGIN
+ 
+                COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
+                         "WITH 'LENGTH = INTEGER'LAST + 3");
+ 
+ OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
+                          -- HAVE INTEGER'LAST + 3 COMPONENTS;
+                          -- STORAGE_ERROR MAY BE RAISED.
+                     ARRX51  :  TABOX51 ;
+                     ARRX52  :  TABOX5
+                              (IDENT_INT(-2)..IDENT_INT( INTEGER'LAST));
+ 
+                BEGIN
+ 
+                COMMENT ("NO STORAGE_ERROR OR " &
+                         "CONSTRAINT_ERROR RAISED WHEN ALLOCATING TWO " &
+                         "BIG BOOLEAN ARRAYS");
+ 
+                -- INITIALIZATION OF LHS ARRAY:
+ 
+ NO_EXCP:       BEGIN          -- NO EXCEPTION SHOULD OCCUR IN THIS BLOCK
+                     FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
+                          ARRX52( I )  :=  FALSE  ;
+                     END LOOP;
+ 
+ 
+                -- INITIALIZATION OF RHS ARRAY:
+ 
+                -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
+                -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
+                -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
+                -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
+ 
+                     FOR  I  IN  IDENT_INT(-6)..IDENT_INT(5)  LOOP
+                          ARRX51( I )  :=  TRUE  ;
+                     END LOOP;
+ 
+                EXCEPTION
+ 
+                     WHEN CONSTRAINT_ERROR =>
+                          FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
+                                  "ASSIGNING TO ARRAY COMPONENTS");
+                     WHEN OTHERS =>
+                          FAILED ("OTHER EXCEPTION RAISED - 1");
+ 
+                END NO_EXCP;
+ 
+ DO_SLICE:      BEGIN
+                -- SLICE ASSIGNMENT:
+ 
+                     ARRX52( IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
+                          ARRX51(
+                             IDENT_INT(-4)..IDENT_INT(INTEGER'LAST-4) ) ;
+                     FAILED( "EXCEPTION NOT RAISED  (12)" );
+ 
+                EXCEPTION
+ 
+                     WHEN CONSTRAINT_ERROR =>
+ 
+                          COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
+                                   "CHECK FOR SLICE ASSIGNMENT");
+ 
+                          -- CHECKING THE VALUES AFTER THE SLICE
+                          -- ASSIGNMENT:
+ 
+                          FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
+ 
+                               IF  ARRX52( I )  /=  FALSE
+                               THEN
+                                    FAILED( "LHS ARRAY ALTERED  (12A)");
+                               END IF;
+ 
+                          END LOOP;
+ 
+ 
+                     WHEN STORAGE_ERROR =>
+                          COMMENT ("STORAGE_ERROR RAISED DURING CHECK " &
+                                   "FOR SLICE ASSIGNMENT");
+ 
+                     WHEN OTHERS =>
+                          FAILED ("SOME EXCEPTION RAISED DURING SLICE");
+ 
+                END DO_SLICE;
+ 
+           END OBJ_DCL;
+ 
+           EXCEPTION
+ 
+                WHEN STORAGE_ERROR =>
+                     COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
+                              "TWO PACKED BOOLEAN ARRAYS WITH " &
+                              "INTEGER'LAST + 3 COMPONENTS");
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
+                              "TWO PACKED BOOLEAN ARRAYS WITH " &
+                              "INTEGER'LAST + 3 COMPONENTS");
+                WHEN OTHERS =>
+                     FAILED ("SOME EXCEPTION RAISED - 3");
+ 
+           END DCL_ARR;
+ 
+      EXCEPTION
+ 
+ 
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
+                         "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
+                         "COMPONENTS");
+ 
+           WHEN STORAGE_ERROR =>
+                FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
+ 
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED - 4");
+ 
+      END CONSTR_ERR;
+ 
+      RESULT ;
+ 
+ END C52104X;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104y.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104y.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c52104y.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c52104y.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,174 ----
+ -- C52104Y.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+ --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+ --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+ --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+ --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+ --    ARE TREATED ELSEWHERE.)
+ 
+ -- THIS IS A SPECIAL CASE IN
+ 
+ --    DIVISION  D :  NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+ --                   STATICALLY
+ 
+ -- WHICH (THE SPECIAL CASE) TREATS TWO-DIMENSIONAL ARRAYS WHOSE LENGTH
+ --    ALONG ONE DIMENSION IS GREATER THAN  INTEGER'LAST  AND WHOSE
+ --    LENGTH ALONG THE OTHER DIMENSION IS  0 .
+ --    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
+ --    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE  CONSTRAINT_ERROR
+ --    TO BE RAISED.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- RM  07/31/81
+ -- SPS 03/22/83
+ -- JBG 06/16/83
+ -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --               AI-00387.
+ -- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT;
+ PROCEDURE  C52104Y  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C52104Y" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                        " ASSIGNMENTS, THE LENGTHS MUST MATCH" );
+ 
+      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+      --
+      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+ 
+ 
+      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+      --    INTEGER , CHARACTER , BOOLEAN .)
+ 
+ 
+      -------------------------------------------------------------------
+ 
+      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+      --        (TWO-DIMENSIONAL ARRAYS OF BOOLEANS.)
+ 
+ CONSTR_ERR:
+      BEGIN          -- THIS BLOCK CATCHES CONSTRAINT_ERROR IF IT IS
+                     -- RAISED BY THE SUBTYPE DECLARATION.
+ 
+ DCL_ARR:  DECLARE
+ 
+                TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> ,
+                                         INTEGER RANGE <> )  OF BOOLEAN ;
+                PRAGMA PACK (TABOX5);
+ 
+                SUBTYPE  TABOX52  IS  TABOX5(
+                          IDENT_INT(13)..IDENT_INT(       13       ) ,
+                          IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
+ 
+           BEGIN
+ 
+                COMMENT ("NO CONSTRAINT_ERROR FOR NON-NULL ARRAY SUBTYPE " &
+                         "WHEN ONE DIMENSION HAS INTEGER'LAST + 3 " &
+                         "COMPONENTS");
+ 
+ OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES ONE NULL ARRAY AND ONE
+                          -- PACKED BOOLEAN ARRAY WITH INTEGER'LAST + 3
+                          -- COMPONENTS;  STORAGE ERROR MAY BE RAISED.
+ 
+                     ARRX51  :  TABOX5(
+                          IDENT_INT(13)..IDENT_INT(       12       ) ,
+                          IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
+                     ARRX52  :  TABOX52 ;     -- BIG ARRAY HERE.
+ 
+                BEGIN
+ 
+                     COMMENT ("NO CONSTRAINT OR STORAGE ERROR WHEN ARRAY "&
+                             "WITH INTEGER'LAST+3 COMPONENTS ALLOCATED");
+ 
+                -- NULL ARRAY ASSIGNMENT:
+ 
+                     ARRX52 := ARRX51 ;
+                     FAILED( "EXCEPTION NOT RAISED  (10)" );
+ 
+                EXCEPTION
+ 
+                     WHEN CONSTRAINT_ERROR =>
+                          COMMENT ("CONSTRAINT_ERROR RAISED WHEN " &
+                                   "CHECKING LENGTHS FOR ARRAY HAVING " &
+                                   "> INTEGER'LAST COMPONENTS ON ONE " &
+                                   "DIMENSION");
+ 
+ 
+                     WHEN  OTHERS  =>
+                          FAILED( "OTHER EXCEPTION RAISED - SUBTEST 10");
+ 
+                END OBJ_DCL;
+ 
+           EXCEPTION
+ 
+                WHEN STORAGE_ERROR =>
+                     COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING ONE "&
+                              "PACKED BOOLEAN ARRAY WITH INTEGER'LAST "&
+                              "+ 3 COMPONENTS");
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING "&
+                              "ONE PACKED BOOLEAN ARRAY WITH "&
+                              "INTEGER'LAST + 3 COMPONENTS");
+                WHEN OTHERS =>
+                     FAILED ("SOME EXCEPTION RAISED - 3");
+ 
+           END DCL_ARR;
+ 
+      EXCEPTION
+ 
+ 
+           WHEN CONSTRAINT_ERROR =>
+                COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
+                         "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
+                         "COMPONENTS");
+ 
+           WHEN STORAGE_ERROR =>
+                FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
+ 
+           WHEN  OTHERS  =>
+                FAILED( "OTHER EXCEPTION RAISED - 4");
+ 
+      END CONSTR_ERR;
+ 
+      RESULT ;
+ 
+ END C52104Y;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c53007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c53007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c53007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c53007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,139 ----
+ -- C53007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONTROL FLOWS CORRECTLY IN SIMPLE NESTED IF_STATEMENTS.
+ 
+ -- JRK 7/23/80
+ -- SPS 3/4/83
+ 
+ WITH REPORT;
+ PROCEDURE C53007A IS
+ 
+      USE REPORT;
+ 
+      CI1 : CONSTANT INTEGER := 1;
+      CI9 : CONSTANT INTEGER := 9;
+      CBT : CONSTANT BOOLEAN := TRUE;
+      CBF : CONSTANT BOOLEAN := FALSE;
+ 
+      VI1 : INTEGER := IDENT_INT(1);
+      VI9 : INTEGER := IDENT_INT(9);
+      VBT : BOOLEAN := IDENT_BOOL(TRUE);
+      VBF : BOOLEAN := IDENT_BOOL(FALSE);
+ 
+      FLOW_COUNT : INTEGER := 0;
+ 
+ BEGIN
+      TEST ("C53007A", "CHECK THAT CONTROL FLOWS CORRECTLY IN SIMPLE " &
+            "NESTED IF_STATEMENTS");
+ 
+      IF VBF THEN  -- (FALSE)
+           FAILED ("INCORRECT CONTROL FLOW 1");
+      ELSIF CI9 < 20 THEN  -- (TRUE)
+           FLOW_COUNT := FLOW_COUNT + 1;
+           IF VI1 /= 0 AND TRUE THEN  -- (TRUE)
+                FLOW_COUNT := FLOW_COUNT + 1;
+           ELSE FAILED ("INCORRECT CONTROL FLOW 2");
+           END IF;
+      ELSE FAILED ("INCORRECT CONTROL FLOW 3");
+      END IF;
+ 
+      IF CBF OR ELSE VI9 = 9 THEN  -- (TRUE)
+           IF VI1 + CI9 > 0 OR (CBF AND VBT) THEN  -- (TRUE)
+                FLOW_COUNT := FLOW_COUNT + 1;
+           END IF;
+      ELSIF VBF OR VI1 > 10 THEN  -- (FALSE)
+           FAILED ("INCORRECT CONTROL FLOW 4");
+      END IF;
+ 
+      IF NOT CBT AND THEN NOT VBT AND THEN CI9 < 0 THEN  -- (FALSE)
+           IF FALSE OR NOT TRUE THEN  -- (FALSE)
+                FAILED ("INCORRECT CONTROL FLOW 5");
+           ELSIF VI1 >= 0 THEN  -- (TRUE)
+                NULL;
+           ELSE FAILED ("INCORRECT CONTROL FLOW 6");
+           END IF;
+           FAILED ("INCORRECT CONTROL FLOW 7");
+      ELSIF (VI1 * CI9 + 3 < 0) OR (VBT AND NOT (CI1 < 0)) THEN -- (TRUE)
+           FLOW_COUNT := FLOW_COUNT + 1;
+           IF NOT CBT OR ELSE CI9 + 1 = 0 THEN  -- (FALSE)
+                FAILED ("INCORRECT CONTROL FLOW 8");
+           ELSE FLOW_COUNT := FLOW_COUNT + 1;
+                IF VI1 * 2 > 0 THEN  -- (TRUE)
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                ELSIF TRUE THEN  -- (TRUE)
+                     FAILED ("INCORRECT CONTROL FLOW 9");
+                ELSE NULL;
+                END IF;
+           END IF;
+      ELSIF FALSE AND CBF THEN  -- (FALSE)
+           FAILED ("INCORRECT CONTROL FLOW 10");
+      ELSE IF VBT THEN  -- (TRUE)
+                FAILED ("INCORRECT CONTROL FLOW 11");
+           ELSIF VI1 = 0 THEN  -- (FALSE)
+                FAILED ("INCORRECT CONTROL FLOW 12");
+           ELSE FAILED ("INCORRECT CONTROL FLOW 13");
+           END IF;
+      END IF;
+ 
+      IF 3 = 5 OR NOT VBT THEN  -- (FALSE)
+           FAILED ("INCORRECT CONTROL FLOW 14");
+           IF TRUE AND CBT THEN  -- (TRUE)
+                FAILED ("INCORRECT CONTROL FLOW 15");
+           ELSE FAILED ("INCORRECT CONTROL FLOW 16");
+           END IF;
+      ELSIF CBF THEN  -- (FALSE)
+           IF VI9 >= 0 OR FALSE THEN  -- (TRUE)
+                IF VBT THEN  -- (TRUE)
+                     FAILED ("INCORRECT CONTROL FLOW 17");
+                END IF;
+                FAILED ("INCORRECT CONTROL FLOW 18");
+           ELSIF VI1 + CI9 /= 0 THEN  -- (TRUE)
+                FAILED ("INCORRECT CONTROL FLOW 19");
+           END IF;
+           FAILED ("INCORRECT CONTROL FLOW 20");
+      ELSE IF VBT AND CI9 - 9 = 0 THEN  -- (TRUE)
+                IF FALSE THEN  -- (FALSE)
+                     FAILED ("INCORRECT CONTROL FLOW 21");
+                ELSIF NOT VBF AND THEN CI1 > 0 THEN  -- (TRUE)
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                ELSE FAILED ("INCORRECT CONTROL FLOW 22");
+                END IF;
+                FLOW_COUNT := FLOW_COUNT + 1;
+           ELSIF NOT CBF OR VI1 /= 0 THEN  -- (TRUE)
+                IF VBT THEN  -- (TRUE)
+                     NULL;
+                END IF;
+                FAILED ("INCORRECT CONTROL FLOW 23");
+           ELSE FAILED ("INCORRECT CONTROL FLOW 24");
+           END IF;
+           FLOW_COUNT := FLOW_COUNT + 1;
+      END IF;
+ 
+      IF FLOW_COUNT /= 9 THEN
+           FAILED ("INCORRECT FLOW_COUNT VALUE");
+      END IF;
+ 
+      RESULT;
+ END C53007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c540001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c540001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c540001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c540001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,410 ----
+ -- C540001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an expression in a case statement may be of a generic formal
+ --      type.  Check that a function call may be used as a case statement 
+ --      expression.  Check that a call to a generic formal function may be 
+ --      used as a case statement expression.  Check that a call to an inherited
+ --      function may be used as a case statement expression even if its result
+ --      type does not correspond to any nameable subtype.
+ --
+ -- TEST DESCRIPTION:
+ --      This transition test creates examples where expressions in a case
+ --      statement can be a generic formal object and a call to a generic formal
+ --      function.  This test also creates examples when either a function call,
+ --      a renaming of a function, or a call to an inherited function is used
+ --      in the case expressions, the choices of the case statement only need 
+ --      to cover the values in the result of the function.
+ --
+ --      Inspired by B54A08A.ADA.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      12 Feb 96   SAIC    Initial version for ACVC 2.1.
+ --
+ --!
+ 
+ package C540001_0 is 
+    type Int is range 1 .. 2;
+ 
+ end C540001_0;
+ 
+      --==================================================================--
+ 
+ with C540001_0;
+ package C540001_1 is 
+    type Enum_Type is (Eh, Bee, Sea, Dee); -- Range of Enum_Type'Val is 0..3.
+    type Mixed     is ('A','B', 'C', None); 
+    subtype Small_Num is Natural range 0 .. 10;
+    type Small_Int is range 1 .. 2;
+    function Get_Small_Int (P : Boolean) return Small_Int;
+    procedure Assign_Mixed (P1 : in     Boolean;
+                            P2 :    out Mixed);
+ 
+    type Tagged_Type is tagged
+      record
+         C1 : Enum_Type;
+      end record;
+    function Get_Tagged (P : Tagged_Type) return C540001_0.Int;
+ 
+ end C540001_1;
+ 
+      --==================================================================--
+ 
+ package body C540001_1 is 
+    function Get_Small_Int (P : Boolean) return Small_Int is
+    begin
+       if P then
+          return Small_Int'First;
+       else
+          return Small_Int'Last; 
+       end if;
+    end Get_Small_Int;
+ 
+    ---------------------------------------------------------------------
+    procedure Assign_Mixed (P1 : in     Boolean;
+                            P2 :    out Mixed) is
+    begin
+       case Get_Small_Int (P1) is          -- Function call as expression
+            when 1  => P2 := None;         -- in case statement.
+            when 2  => P2 := 'A';
+            -- No others needed.
+       end case;
+ 
+    end Assign_Mixed;
+ 
+    ---------------------------------------------------------------------
+    function Get_Tagged (P : Tagged_Type) return C540001_0.Int is
+    begin
+       return C540001_0.Int'Last;
+    end Get_Tagged;
+ 
+ end C540001_1;
+ 
+      --==================================================================--
+ 
+ generic               
+ 
+    type Formal_Scalar is range <>;  
+ 
+    FSO : Formal_Scalar;
+ 
+ package C540001_2 is              
+ 
+    type Enum is (Alpha, Beta, Theta);
+ 
+    procedure Assign_Enum (ET : out Enum);
+ 
+ end C540001_2;
+ 
+      --==================================================================--
+ 
+ package body C540001_2 is              
+ 
+    procedure Assign_Enum (ET : out Enum) is
+    begin
+       case FSO is                         -- Type of expression in case
+            when 1      => ET := Alpha;    -- statement is generic formal type.
+            when 2      => ET := Beta;
+            when others => ET := Theta;
+       end case;
+ 
+    end Assign_Enum;
+ 
+ end C540001_2;
+ 
+      --==================================================================--
+ 
+ with C540001_1;
+ generic               
+ 
+    type Formal_Enum_Type is new C540001_1.Enum_Type;
+ 
+    with function Formal_Func (P : C540001_1.Small_Num) 
+      return Formal_Enum_Type is <>;
+ 
+ function C540001_3 (P : C540001_1.Small_Num) return Formal_Enum_Type;
+ 
+      --==================================================================--
+ 
+ function C540001_3 (P : C540001_1.Small_Num) return Formal_Enum_Type is
+ 
+ begin
+    return Formal_Func (P);
+ end C540001_3;
+ 
+      --==================================================================--
+ 
+ with C540001_1;
+ generic               
+ 
+    type Formal_Int_Type is new C540001_1.Small_Int;
+ 
+    with function Formal_Func return Formal_Int_Type;
+ 
+ package C540001_4 is
+ 
+    procedure Gen_Assign_Mixed (P : out C540001_1.Mixed);
+ 
+ end C540001_4;
+ 
+      --==================================================================--
+ 
+ package body C540001_4 is
+ 
+    procedure Gen_Assign_Mixed (P : out C540001_1.Mixed) is
+    begin
+       case Formal_Func is                          -- Case expression is
+          when 1      => P := C540001_1.'A';        -- generic function.
+          when others => P := C540001_1.'B';
+       end case;
+ 
+    end Gen_Assign_Mixed;
+ 
+ end C540001_4;
+ 
+      --==================================================================--
+ 
+ with C540001_1;
+ package C540001_5 is
+    type New_Tagged is new C540001_1.Tagged_Type with
+       record
+          C2 : C540001_1.Mixed;
+       end record;
+ 
+     -- Inherits Get_Tagged (P : New_Tagged) return C540001_0.Int;
+     -- Note that the return type of the inherited function is not
+     -- nameable here.
+ 
+    procedure Assign_Tagged (P1 : in     New_Tagged;
+                             P2 :    out New_Tagged);
+ 
+ end C540001_5;
+ 
+      --==================================================================--
+ 
+ package body C540001_5 is
+ 
+    procedure Assign_Tagged (P1 : in     New_Tagged;
+                             P2 :    out New_Tagged) is
+    begin
+       case Get_Tagged (P1) is                      -- Case expression is
+                                                    -- inherited function.
+          when 2      => P2 := (C540001_1.Bee, 'B');       
+          when others => P2 := (C540001_1.Sea, C540001_1.None);
+       end case;
+ 
+    end Assign_Tagged;
+ 
+ end C540001_5;
+ 
+      --==================================================================--
+ 
+ with Report;
+ with C540001_1;
+ with C540001_2;
+ with C540001_3;
+ with C540001_4;
+ with C540001_5;
+ 
+ procedure C540001 is
+    type Value is range 1 .. 5;
+ 
+ begin
+    Report.Test ("C540001", "Check that an expression in a case statement " &
+                 "may be of a generic formal type.  Check that a function " &
+                 "call may be used as a case statement expression.  Check " &
+                 "that a call to a generic formal function may be used as " &
+                 "a case statement expression.  Check that a call to an "   &
+                 "inherited function may be used as a case statement "      &
+                 "expression");
+ 
+    Generic_Formal_Object_Subtest:
+    begin
+       declare
+          One  : Value := 1;
+          package One_Pck is new C540001_2 (Value, One);
+          use One_Pck;
+          EObj : Enum;
+       begin
+          Assign_Enum (EObj);
+          if EObj /= Alpha then
+             Report.Failed ("Incorrect result for value of one in generic" &
+                            "formal object subtest");
+          end if;
+       end;
+ 
+       declare
+          Five : Value := 5;
+          package Five_Pck is new C540001_2 (Value, Five);
+          use Five_Pck;
+          EObj : Enum;
+       begin
+          Assign_Enum (EObj);
+          if EObj /= Theta then
+             Report.Failed ("Incorrect result for value of five in generic" &
+                            "formal object subtest");
+          end if;
+       end;
+ 
+    end Generic_Formal_Object_Subtest;
+ 
+    Instantiated_Generic_Function_Subtest:
+    declare
+       type New_Enum_Type is new C540001_1.Enum_Type;
+ 
+       function Get_Enum_Value (P : C540001_1.Small_Num) 
+         return New_Enum_Type is
+       begin
+          return New_Enum_Type'Val (P);
+       end Get_Enum_Value;
+ 
+       function Val_Func is new C540001_3 
+         (Formal_Enum_Type => New_Enum_Type, 
+          Formal_Func      => Get_Enum_Value);
+ 
+       procedure Assign_Num (P : in out C540001_1.Small_Num) is
+       begin
+          case Val_Func (P) is                         -- Case expression is
+                                                       -- instantiated generic
+              when New_Enum_Type (C540001_1.Eh) |      -- function.
+                   New_Enum_Type (C540001_1.Sea)   => P := 4;
+              when New_Enum_Type (C540001_1.Bee)   => P := 7;
+              when others                          => P := 9;
+          end case;
+ 
+       end Assign_Num;
+ 
+       SNObj  : C540001_1.Small_Num;
+ 
+    begin
+       SNObj := 0;
+       Assign_Num (SNObj);       
+       if SNObj /= 4 then
+          Report.Failed ("Incorrect result for value of zero in call to " &
+                         "generic function subtest");
+       end if;
+ 
+       SNObj := 3;
+       Assign_Num (SNObj);       
+       if SNObj /= 9 then
+          Report.Failed ("Incorrect result for value of three in call to " &
+                         "generic function subtest");
+       end if;
+ 
+    end Instantiated_Generic_Function_Subtest;
+ 
+    -- When a function call, a renaming of a function, or a call to an 
+    -- inherited function is used in the case expressions, the choices 
+    -- of the case statement only need to cover the values in the result 
+    -- of the function.
+ 
+    Function_Call_Subtest:
+    declare
+       MObj : C540001_1.Mixed := 'B';
+       BObj : Boolean         := True;
+       use type C540001_1.Mixed;
+    begin
+       C540001_1.Assign_Mixed (BObj, MObj);
+       if MObj /= C540001_1.None then
+          Report.Failed ("Incorrect result for value of true in function" &
+                         "call subtest");
+          end if;
+ 
+       BObj := False;
+       C540001_1.Assign_Mixed (BObj, MObj);
+       if MObj /= C540001_1.'A' then
+          Report.Failed ("Incorrect result for value of false in function" &
+                         "call subtest");
+       end if;
+ 
+    end Function_Call_Subtest;
+ 
+    Function_Renaming_Subtest:
+    declare
+       use C540001_1;
+       function Rename_Get_Small_Int (P : Boolean) 
+         return Small_Int renames Get_Small_Int;
+       MObj : Mixed   := None;
+       BObj : Boolean := False;
+    begin
+       case Rename_Get_Small_Int (BObj) is
+           when 1 => MObj := 'A';
+           when 2 => MObj := 'B';
+           -- No others needed.
+       end case;
+ 
+       if MObj /= 'B' then
+          Report.Failed ("Incorrect result for value of false in function" &
+                         "renaming subtest");
+       end if;
+ 
+    end Function_Renaming_Subtest;
+ 
+    Call_To_Generic_Formal_Function_Subtest:
+    declare
+       type New_Small_Int is new C540001_1.Small_Int;
+ 
+       function Get_Int_Value return New_Small_Int is
+       begin
+          return New_Small_Int'First;
+       end Get_Int_Value;
+ 
+       package Int_Pck is new C540001_4 
+         (Formal_Int_Type => New_Small_Int, 
+          Formal_Func     => Get_Int_Value);
+ 
+       use type C540001_1.Mixed;
+       MObj : C540001_1.Mixed := C540001_1.None; 
+ 
+    begin
+       Int_Pck.Gen_Assign_Mixed (MObj); 
+       if MObj /= C540001_1.'A' then
+          Report.Failed ("Incorrect result in call to generic formal " &
+                         "function subtest");
+       end if;
+ 
+    end Call_To_Generic_Formal_Function_Subtest;
+ 
+    Call_To_Inherited_Function_Subtest:
+    declare
+       NTObj1 : C540001_5.New_Tagged := (C1 => C540001_1.Eh,
+                                         C2 => C540001_1.'A');
+       NTObj2 : C540001_5.New_Tagged := (C540001_1.Dee, C540001_1.'C');
+       use type C540001_1.Mixed;
+       use type C540001_1.Enum_Type;
+    begin
+       C540001_5.Assign_Tagged (NTObj1, NTObj2);
+       if NTObj2.C1 /= C540001_1.Bee or  
+          NTObj2.C2 /= C540001_1.'B' then
+          Report.Failed ("Incorrect result in inherited function subtest");
+       end if;
+ 
+    end Call_To_Inherited_Function_Subtest;
+ 
+    Report.Result;
+ 
+ end C540001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a03a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a03a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a03a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C54A03A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT BOOLEAN, CHARACTER, USER-DEFINED ENUMERATED, INTEGER,
+ --    AND DERIVED TYPES MAY BE USED IN A CASE EXPRESSION.
+ 
+ -- DAT 1/22/81
+ -- PWB 4/22/86  RENAME TO -AB;
+ --              REMOVE EXTRANEOUS <CR> FROM BEGINNING OF LINE 45.
+ 
+ WITH REPORT;
+ PROCEDURE C54A03A IS
+ 
+      USE REPORT;
+ 
+      TYPE D_INT IS NEW INTEGER RANGE 1 .. 2;
+      TYPE D_BOOL IS NEW BOOLEAN;
+      TYPE D_BOOL_2 IS NEW D_BOOL;
+      TYPE M_ENUM IS (FIRST, SECOND, THIRD);
+      TYPE M_CHAR IS NEW CHARACTER RANGE ASCII.NUL .. 'Z';
+      TYPE M_ENUM_2 IS NEW M_ENUM;
+ 
+      I : INTEGER := 1;
+      D_I : D_INT := 1;
+      B : BOOLEAN := TRUE;
+      D_B : D_BOOL := TRUE;
+      D_B_2 : D_BOOL_2 := FALSE;
+      E : M_ENUM := THIRD;
+      C : CHARACTER := 'A';
+      M_C : M_CHAR := 'Z';
+      D_E : M_ENUM_2 := SECOND;
+ 
+ BEGIN
+      TEST ("C54A03A", "CHECK VARIOUS DISCRETE TYPES " &
+                       "IN CASE EXPRESSIONS");
+ 
+      CASE I IS
+           WHEN 2 | 3 => FAILED ("WRONG CASE 1");
+           WHEN 1 => NULL;
+           WHEN OTHERS => FAILED ("WRONG CASE 2");
+      END CASE;
+ 
+      CASE D_I IS
+           WHEN 1 => NULL;
+           WHEN 2 => FAILED ("WRONG CASE 2A");
+      END CASE;
+ 
+      CASE B IS
+           WHEN TRUE => NULL;
+           WHEN FALSE => FAILED ("WRONG CASE 3");
+      END CASE;
+ 
+      CASE D_B IS
+           WHEN TRUE => NULL;
+           WHEN FALSE => FAILED ("WRONG CASE 4");
+      END CASE;
+ 
+      CASE D_B_2 IS
+           WHEN FALSE => NULL;
+           WHEN TRUE => FAILED ("WRONG CASE 5");
+      END CASE;
+ 
+      CASE E IS
+           WHEN SECOND | FIRST => FAILED ("WRONG CASE 6");
+           WHEN THIRD => NULL;
+      END CASE;
+ 
+      CASE C IS
+           WHEN 'A' .. 'Z' => NULL;
+           WHEN OTHERS => FAILED ("WRONG CASE 7");
+      END CASE;
+ 
+      CASE M_C IS
+           WHEN 'Z' => NULL;
+           WHEN OTHERS => FAILED ("WRONG CASE 8");
+      END CASE;
+ 
+      CASE D_E IS
+           WHEN FIRST => FAILED ("WRONG CASE 9");
+           WHEN SECOND | THIRD => NULL;
+      END CASE;
+ 
+      RESULT;
+ END C54A03A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a04a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a04a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a04a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a04a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C54A04A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PRIVATE (DISCRETE) TYPES MAY BE USED IN CASE EXPRESSIONS
+ --     WITHIN THE DEFINING PACKAGE.
+ 
+ -- DAT 1/29/81
+ 
+ WITH REPORT;
+ PROCEDURE C54A04A IS
+ 
+      USE REPORT;
+ 
+      PACKAGE P IS
+ 
+           TYPE T IS PRIVATE;
+           TYPE LT IS LIMITED PRIVATE;
+ 
+      PRIVATE
+ 
+           TYPE T IS ('Z', X);
+           TYPE LT IS NEW INTEGER RANGE 0 .. 1;
+ 
+      END P;
+ 
+      VT : P.T;
+      VLT : P.LT;
+ 
+      PACKAGE BODY P IS
+ 
+      BEGIN
+           TEST ("C54A04A", "PRIVATE DISCRETE TYPES MAY APPEAR IN " &
+                 "CASE EXPRESSIONS IN PACKAGE BODY");
+ 
+           VT := 'Z';
+           VLT := LT (IDENT_INT (1));
+ 
+           CASE VT IS
+                WHEN X => FAILED ("WRONG CASE 1");
+                WHEN 'Z' => NULL; -- OK
+           END CASE;
+ 
+           CASE VLT IS
+                WHEN 1 => NULL; -- OK
+                WHEN 0 => FAILED ("WRONG CASE 2");
+           END CASE;
+      END P;
+ 
+ BEGIN
+ 
+      -- TEST CALLED FROM PACKAGE BODY, ALREADY ELABORATED.
+ 
+      RESULT;
+ END C54A04A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a07a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a07a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a07a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a07a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C54A07A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A VARIABLE USED AS A CASE EXPRESSION IS NOT CONSIDERED
+ --    LOCAL TO THE CASE STATEMENT.  IN PARTICULAR, CHECK THAT THE
+ --    VARIABLE CAN BE ASSIGNED A NEW VALUE, AND THE ASSIGNMENT TAKES
+ --    EFFECT IMMEDIATELY (I.E. THE CASE STATEMENT DOES NOT USE A
+ --    COPY OF THE CASE EXPRESSION).
+ 
+ 
+ -- RM 01/21/80
+ 
+ 
+ WITH REPORT ;
+ PROCEDURE  C54A07A  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("C54A07A" , "CHECK THAT A VARIABLE USED AS A CASE" &
+                       " EXPRESSION IS NOT CONSIDERED LOCAL TO" &
+                       " THE CASE STATEMENT" );
+ 
+      DECLARE   -- A
+      BEGIN
+ 
+ B1 :      DECLARE
+ 
+                TYPE  VARIANT_REC( DISCR : BOOLEAN := TRUE )  IS
+                     RECORD
+                          A , B : INTEGER ;
+                          CASE  DISCR  IS
+                               WHEN  TRUE   =>  P , Q : CHARACTER ;
+                               WHEN  FALSE  =>  X , Y : INTEGER   ;
+                          END CASE;
+                     END RECORD ;
+ 
+                V : VARIANT_REC := ( TRUE , 1 , 2 ,
+                                            IDENT_CHAR( 'P' )   ,
+                                            IDENT_CHAR( 'Q' )   );
+ 
+           BEGIN
+ 
+                IF  EQUAL( 3 , 7 )  THEN  V := ( FALSE , 3 , 4 , 7 , 8 );
+                END IF;
+ 
+                CASE  V.DISCR  IS
+ 
+                     WHEN  TRUE    =>  
+ 
+                          IF  ( V.P /= 'P'  OR
+                                V.Q /= 'Q'  )
+                          THEN  FAILED( "WRONG VALUES  -  1" );
+                          END IF;
+ 
+                          B1.V  :=  ( FALSE , 3 , 4 ,
+                                              IDENT_INT( 5 )   ,
+                                              IDENT_INT( 6 )   );
+ 
+                          IF  V.DISCR  THEN FAILED( "WRONG DISCR." );
+                          END IF;
+ 
+                          IF  ( V.X /= 5  OR
+                                V.Y /= 6  )
+                          THEN  FAILED( "WRONG VALUES  -  2" );
+                          END IF;
+ 
+                     WHEN  FALSE   =>  
+                          FAILED( "WRONG BRANCH IN CASE STMT." );
+ 
+                END CASE;
+ 
+           EXCEPTION
+ 
+                WHEN  OTHERS  =>  FAILED("EXCEPTION RAISED");
+ 
+           END B1 ;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>  FAILED( "EXCEPTION RAISED BY DECLARATIONS");
+ 
+      END ;    -- A
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C54A07A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C54A13A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF A CASE EXPRESSION IS A DECLARED VARIABLE OR
+ --     CONSTANT, OR ONE OF THESE IN PARENTHESES, AND ITS SUBTYPE IS
+ --     NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
+ --     APPEAR AS A CHOICE.
+ 
+ -- HISTORY:
+ --     BCB 02/29/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C54A13A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE IDENT_INT(5) .. IDENT_INT(10);
+ 
+      A : INT := 8;
+      B : CONSTANT INT := 7;
+      C, D : INTEGER;
+ 
+      FUNCTION IDENT(X : INT) RETURN INT IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN X;
+           ELSE
+                RETURN 0;
+           END IF;
+      END IDENT;
+ 
+ BEGIN
+      TEST ("C54A13A", "CHECK THAT IF A CASE EXPRESSION IS A DECLARED " &
+                       "VARIABLE OR CONSTANT, OR ONE OF THESE IN " &
+                       "PARENTHESES, AND ITS SUBTYPE IS NONSTATIC, " &
+                       "THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE " &
+                       "MAY APPEAR AS A CHOICE");
+ 
+      CASE A IS
+           WHEN 0 => C := IDENT_INT(5);
+           WHEN 8 => C := IDENT_INT(10);
+           WHEN 30000 => C := IDENT_INT(15);
+           WHEN -30000 => C := IDENT_INT(20);
+           WHEN OTHERS => C := IDENT_INT(25);
+      END CASE;
+ 
+      IF C /= IDENT_INT(10) THEN
+           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 1");
+      END IF;
+ 
+      CASE B IS
+           WHEN 0 => D := IDENT_INT(5);
+           WHEN 100 => D := IDENT_INT(10);
+           WHEN 30000 => D := IDENT_INT(15);
+           WHEN -30000 => D := IDENT_INT(20);
+           WHEN OTHERS => D := IDENT_INT(25);
+      END CASE;
+ 
+      IF D /= IDENT_INT(25) THEN
+           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 2");
+      END IF;
+ 
+      CASE (A) IS
+           WHEN 0 => C := IDENT_INT(5);
+           WHEN 8 => C := IDENT_INT(10);
+           WHEN 30000 => C := IDENT_INT(15);
+           WHEN -30000 => C := IDENT_INT(20);
+           WHEN OTHERS => C := IDENT_INT(25);
+      END CASE;
+ 
+      IF C /= IDENT_INT(10) THEN
+           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 3");
+      END IF;
+ 
+      CASE (B) IS
+           WHEN 0 => D := IDENT_INT(5);
+           WHEN 110 => D := IDENT_INT(10);
+           WHEN 30000 => D := IDENT_INT(15);
+           WHEN -30000 => D := IDENT_INT(20);
+           WHEN OTHERS => D := IDENT_INT(25);
+      END CASE;
+ 
+      IF D /= IDENT_INT(25) THEN
+           FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 4");
+      END IF;
+ 
+      RESULT;
+ END C54A13A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C54A13B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF A CASE EXPRESSION IS A GENERIC "IN" OR "IN OUT"
+ --     PARAMETER WITH A NON-STATIC SUBTYPE OR ONE OF THESE IN
+ --     PARENTHESES, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
+ --     APPEAR AS A CHOICE.
+ 
+ -- HISTORY:
+ --     BCB 07/13/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C54A13B IS
+ 
+      L : INTEGER := IDENT_INT(1);
+      R : INTEGER := IDENT_INT(100);
+ 
+      SUBTYPE INT IS INTEGER RANGE L .. R;
+ 
+      GENERIC
+           IN_PAR : IN INT;
+           IN_OUT_PAR : IN OUT INT;
+      PROCEDURE GEN_PROC (I : IN OUT INTEGER);
+ 
+      IN_VAR : INT := IDENT_INT (10);
+      IN_OUT_VAR : INT := IDENT_INT (100);
+      CHECK_VAR : INT := IDENT_INT (1);
+ 
+      PROCEDURE GEN_PROC (I : IN OUT INTEGER) IS
+      BEGIN
+           CASE IN_PAR IS
+                WHEN 0 => I := I + IDENT_INT (2);
+                WHEN 10 => I := I + IDENT_INT (1);
+                WHEN -3000 => I := I + IDENT_INT (3);
+                WHEN OTHERS => I := I + IDENT_INT (4);
+           END CASE;
+ 
+           CASE IN_OUT_PAR IS
+                WHEN 0 => IN_OUT_PAR := IDENT_INT (0);
+                WHEN 100 => IN_OUT_PAR := IDENT_INT (50);
+                WHEN -3000 => IN_OUT_PAR := IDENT_INT (-3000);
+                WHEN OTHERS => IN_OUT_PAR := IDENT_INT (5);
+           END CASE;
+ 
+           CASE (IN_PAR) IS
+                WHEN 0 => I := I + IDENT_INT (2);
+                WHEN 10 => I := I + IDENT_INT (1);
+                WHEN -3000 => I := I + IDENT_INT (3);
+                WHEN OTHERS => I := I + IDENT_INT (4);
+           END CASE;
+ 
+           CASE (IN_OUT_PAR) IS
+                WHEN 0 => IN_OUT_PAR := IDENT_INT (200);
+                WHEN 50 => IN_OUT_PAR := IDENT_INT (25);
+                WHEN -3000 => IN_OUT_PAR := IDENT_INT (300);
+                WHEN OTHERS => IN_OUT_PAR := IDENT_INT (400);
+           END CASE;
+ 
+      END GEN_PROC;
+ 
+      PROCEDURE P IS NEW GEN_PROC (IN_VAR, IN_OUT_VAR);
+ 
+ BEGIN
+      TEST ("C54A13B", "CHECK THAT IF A CASE EXPRESSION IS A " &
+                       "GENERIC 'IN' OR 'IN OUT' PARAMETER WITH A " &
+                       "NON-STATIC SUBTYPE OR ONE OF " &
+                       "THESE IN PARENTHESES, THEN ANY VALUE OF " &
+                       "THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
+                       "A CHOICE");
+ 
+      P (CHECK_VAR);
+ 
+      IF NOT EQUAL (CHECK_VAR, IDENT_INT(3)) THEN
+           FAILED ("INCORRECT CHOICES MADE FOR IN PARAMETER IN CASE");
+      END IF;
+ 
+      IF NOT EQUAL (IN_OUT_VAR, IDENT_INT(25)) THEN
+           FAILED ("INCORRECT CHOICESMADE FOR IN OUT PARAMETER IN CASE");
+      END IF;
+ 
+      RESULT;
+ END C54A13B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C54A13C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF A CASE EXPRESSION IS A QUALIFIED EXPRESSION, A
+ --     TYPE CONVERSION, OR ONE OF THESE IN PARENTHESES, AND ITS
+ --     SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S
+ --     BASE TYPE MAY APPEAR AS A CHOICE.
+ 
+ -- HISTORY:
+ --     BCB 07/13/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C54A13C IS
+ 
+      L : INTEGER := 1;
+      R : INTEGER := 100;
+ 
+      SUBTYPE INT IS INTEGER RANGE L .. R;
+ 
+      A : INT := 50;
+ 
+      B : INTEGER := 50;
+ 
+      C : INTEGER;
+ 
+ BEGIN
+      TEST ("C54A13C", "CHECK THAT IF A CASE EXPRESSION IS A " &
+                       "QUALIFIED EXPRESSION, A TYPE CONVERSION, " &
+                       "OR ONE OF THESE IN PARENTHESES, AND ITS " &
+                       "SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE " &
+                       "EXPRESSION'S BASE TYPE MAY APPEAR AS A CHOICE");
+ 
+      CASE INT'(A) IS
+           WHEN 0 => C := IDENT_INT (5);
+           WHEN 50 => C := IDENT_INT (10);
+           WHEN -3000 => C := IDENT_INT (15);
+           WHEN OTHERS => C := IDENT_INT (20);
+      END CASE;
+ 
+      IF C /= IDENT_INT (10) THEN
+           FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
+                   "CASE");
+      END IF;
+ 
+      CASE INT(B) IS
+           WHEN 0 => C := IDENT_INT (5);
+           WHEN 50 => C := IDENT_INT (10);
+           WHEN -3000 => C := IDENT_INT (15);
+           WHEN OTHERS => C := IDENT_INT (20);
+      END CASE;
+ 
+      IF C /= IDENT_INT (10) THEN
+           FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN CASE");
+      END IF;
+ 
+      CASE (INT'(A)) IS
+           WHEN 0 => C := IDENT_INT (5);
+           WHEN 50 => C := IDENT_INT (10);
+           WHEN -3000 => C := IDENT_INT (15);
+           WHEN OTHERS => C := IDENT_INT (20);
+      END CASE;
+ 
+      IF C /= IDENT_INT (10) THEN
+           FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
+                   "PARENTHESES IN CASE");
+      END IF;
+ 
+      CASE (INT(B)) IS
+           WHEN 0 => C := IDENT_INT (5);
+           WHEN 50 => C := IDENT_INT (10);
+           WHEN -3000 => C := IDENT_INT (15);
+           WHEN OTHERS => C := IDENT_INT (20);
+      END CASE;
+ 
+      IF C /= IDENT_INT (10) THEN
+           FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN " &
+                   "PARENTHESES IN CASE");
+      END IF;
+ 
+      RESULT;
+ END C54A13C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a13d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a13d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- C54A13D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF A CASE EXPRESSION IS A FUNCTION INVOCATION,
+ --     ATTRIBUTE, STATIC EXPRESSION, OR ONE OF THESE IN PARENTHESES,
+ --     THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS A
+ --     CHOICE.
+ 
+ -- HISTORY:
+ --     BCB 07/19/88  CREATED ORIGINAL TEST.
+ --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ --     GJD 11/15/95  REMOVED ADA 95 INCOMPATIBLE ALTERNATIVE IN FIRST CASE.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C54A13D IS
+ 
+      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
+ 
+      CONS : CONSTANT INT := 0;
+ 
+      C : INT;
+ 
+      TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
+ 
+      SUBTYPE SUBENUM IS ENUM RANGE THREE .. FOUR;
+ 
+      FUNCTION FUNC RETURN INT IS
+      BEGIN
+           RETURN 0;
+      END FUNC;
+ 
+ BEGIN
+      TEST ("C54A13D", "CHECK THAT IF A CASE EXPRESSION IS A FUNCTION " &
+                       "INVOCATION, ATTRIBUTE, STATIC EXPRESSION, OR " &
+                       "ONE OF THESE IN PARENTHESES, THEN ANY VALUE " &
+                       "OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
+                       "A CHOICE");
+ 
+      CASE FUNC IS
+           WHEN 0 => C := IDENT_INT (5);
+           WHEN 100 => C := IDENT_INT (10);
+           WHEN OTHERS => C := IDENT_INT (20);
+      END CASE;
+ 
+      IF NOT EQUAL (C,5) THEN
+           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                   "FUNCTION INVOCATION - 1");
+      END IF;
+ 
+      CASE (FUNC) IS
+           WHEN 0 => C := IDENT_INT (25);
+           WHEN 100 => C := IDENT_INT (50);
+           WHEN -3000 => C := IDENT_INT (75);
+           WHEN OTHERS => C := IDENT_INT (90);
+      END CASE;
+ 
+      IF NOT EQUAL (C,25) THEN
+           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                   "FUNCTION INVOCATION - 2");
+      END IF;
+ 
+      CASE SUBENUM'FIRST IS
+           WHEN ONE => C := IDENT_INT (100);
+           WHEN TWO => C := IDENT_INT (99);
+           WHEN THREE => C := IDENT_INT (98);
+           WHEN FOUR => C := IDENT_INT (97);
+           WHEN FIVE => C := IDENT_INT (96);
+           WHEN SIX => C := IDENT_INT (95);
+      END CASE;
+ 
+      IF NOT EQUAL (C,98) THEN
+           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
+                   "ATTRIBUTE - 1");
+      END IF;
+ 
+      CASE (SUBENUM'FIRST) IS
+           WHEN ONE => C := IDENT_INT (90);
+           WHEN TWO => C := IDENT_INT (89);
+           WHEN THREE => C := IDENT_INT (88);
+           WHEN FOUR => C := IDENT_INT (87);
+           WHEN FIVE => C := IDENT_INT (86);
+           WHEN SIX => C := IDENT_INT (85);
+      END CASE;
+ 
+      IF NOT EQUAL (C,88) THEN
+           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
+                   "ATTRIBUTE - 2");
+      END IF;
+ 
+      CASE CONS * 1 IS
+           WHEN 0 => C := IDENT_INT (1);
+           WHEN 100 => C := IDENT_INT (2);
+           WHEN -3000 => C := IDENT_INT (3);
+           WHEN OTHERS => C := IDENT_INT (4);
+      END CASE;
+ 
+      IF NOT EQUAL (C,1) THEN
+           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                   "STATIC EXPRESSION - 1");
+      END IF;
+ 
+      CASE (CONS * 1) IS
+           WHEN 0 => C := IDENT_INT (10);
+           WHEN 100 => C := IDENT_INT (20);
+           WHEN -3000 => C := IDENT_INT (30);
+           WHEN OTHERS => C := IDENT_INT (40);
+      END CASE;
+ 
+      IF NOT EQUAL (C,10) THEN
+           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                   "STATIC EXPRESSION - 2");
+      END IF;
+ 
+      RESULT;
+ END C54A13D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a22a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a22a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a22a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a22a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,68 ----
+ -- C54A22A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK ALL FORMS OF CHOICE IN CASE CHOICES.
+ 
+ -- DAT 1/29/81
+ -- SPS 1/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C54A22A IS
+ 
+      USE REPORT;
+ 
+      TYPE T IS RANGE 1 .. 10;
+      C5 : CONSTANT T := 5;
+      SUBTYPE S1 IS T RANGE 1 .. 5;
+      SUBTYPE S2 IS T RANGE C5 + 1 .. 7;
+      SUBTYPE SN IS T RANGE C5 + 4 .. C5 - 4 + 7;  -- NULL RANGE.
+      SUBTYPE S10 IS T RANGE C5 + 5 .. T'LAST;
+ 
+ BEGIN
+      TEST ("C54A22A", "CHECK ALL FORMS OF CASE CHOICES");
+ 
+      CASE T'(C5 + 3) IS
+           WHEN SN                       -- 9..8
+           | S1 RANGE 1 .. 0             -- 1..0
+           | S2 RANGE C5 + 2 .. C5 + 1   -- 7..6
+           | 3 .. 2                      -- 3..2
+                => FAILED ("WRONG CASE 1");
+ 
+           WHEN  S1 RANGE 4 .. C5        -- 4..5
+           | S1 RANGE C5 - 4 .. C5 / 2   -- 1..2
+           | 3 .. 1 + C5 MOD 3           -- 3..3
+           | SN                          -- 9..8
+           | S1 RANGE 5 .. C5 - 1        -- 5..4
+           | 6 .. 7                      -- 6..7
+           | S10                         -- 10..10
+           | 9                           -- 9
+           | S10 RANGE 10 .. 9 =>        -- 10..9
+                FAILED ("WRONG CASE 2");
+ 
+           WHEN C5 + C5 - 2 .. 8         -- 8
+                => NULL;
+      END CASE;
+ 
+      RESULT;
+ END C54A22A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a23a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a23a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a23a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a23a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,49 ----
+ -- C54A23A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CASE CHOICES MAY BE CONSTANT NAMES
+ 
+ -- DAT 3/18/81
+ -- SPS 4/7/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C54A23A IS
+ 
+      C1 : CONSTANT INTEGER := 1;
+      C2 : CONSTANT INTEGER := 2;
+      C3 : CONSTANT INTEGER := 3;
+ 
+ BEGIN
+      TEST ("C54A23A", "CASE CHOICES MAY BE CONSTANTS");
+ 
+      CASE IDENT_INT (C3) IS
+           WHEN C1 | C2
+                => FAILED ("WRONG CASE CHOICE 1");
+           WHEN 3 => NULL;
+           WHEN OTHERS => FAILED ("WRONG CASE CHOICE 2");
+      END CASE;
+ 
+      RESULT;
+ END C54A23A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a24a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a24a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a24a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a24a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- C54A24A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NULL SUBRANGE CHOICES MAY OCCUR IN CASE STATEMENT, WITH
+ -- OUT-OF-BOUNDS RANGE BOUNDS, AND WHERE VACUOUS CHOICES ARE NULL.
+ -- CHECK THAT AN UNNEEDED OTHERS CHOICE IS PERMITTED.
+ 
+ -- DAT 1/29/81
+ -- JBG 8/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C54A24A IS
+ 
+      USE REPORT;
+ 
+      TYPE T IS RANGE 1 .. 1010;
+      SUBTYPE ST IS T RANGE 5 .. 7;
+ 
+      V : ST := 6;
+ 
+ BEGIN
+      TEST ("C54A24A", "CHECK NULL CASE SUBRANGE CHOICES, WITH " &
+            "OUTRAGEOUS BOUNDS");
+ 
+      CASE V IS
+           WHEN -1000 .. -1010 => NULL;
+           WHEN T RANGE -5 .. -6 => NULL;
+           WHEN 12 .. 11 | ST RANGE 1000 .. 99 => NULL;
+           WHEN ST RANGE -99 .. -999 => NULL;
+           WHEN ST RANGE 6 .. 6 => V := V - 1;
+           WHEN T RANGE ST'BASE'LAST .. ST'BASE'FIRST => NULL;
+           WHEN 5 | 7 => NULL;
+           WHEN ST RANGE T'BASE'LAST .. T'BASE'FIRST => NULL;
+           WHEN T'BASE'LAST .. T'BASE'FIRST => NULL;
+           WHEN OTHERS => V := V + 1;
+      END CASE;
+      IF V /= 5 THEN
+           FAILED ("IMPROPER CASE EXECUTION");
+      END IF;
+ 
+      RESULT;
+ END C54A24A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a24b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a24b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a24b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a24b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,58 ----
+ -- C54A24B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT NULL SUBTYPE RANGES ARE ACCEPTABLE CASE CHOICES,
+ --     WHERE THE BOUNDS ARE BOTH OUT OF THE SUBRANGE'S RANGE, AND
+ --     WHERE VACUOUS CHOICES HAVE NON-NULL STATEMENT SEQUENCES.
+ --     CHECK THAT AN UNNEEDED OTHERS CLAUSE IS PERMITTED.
+ 
+ -- HISTORY:
+ --     DAT 01/29/81 CREATED ORIGINAL TEST.
+ --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT;
+ PROCEDURE C54A24B IS
+ 
+      USE REPORT;
+ 
+      TYPE C IS NEW CHARACTER RANGE 'A' .. 'D';
+      X : C := 'B';
+ 
+ BEGIN
+      TEST ("C54A24B", "NULL CASE CHOICE SUBRANGES WITH VALUES " &
+            "OUTSIDE SUBRANGE");
+ 
+      CASE X IS
+           WHEN C RANGE C'BASE'LAST .. C'BASE'FIRST
+                | C RANGE 'Z' .. ' ' => X := 'A';
+           WHEN C => NULL;
+           WHEN OTHERS => X := 'C';
+      END CASE;
+      IF X /= 'B' THEN
+           FAILED ("WRONG CASE EXECUTION");
+      END IF;
+ 
+      RESULT;
+ END C54A24B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,173 ----
+ -- C54A42A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A  CASE_STATEMENT  MAY HANDLE A LARGE NUMBER OF
+ --    POTENTIAL VALUES GROUPED INTO A SMALL NUMBER OF ALTERNATIVES
+ --    AND THAT EACH TIME THE APPROPRIATE ALTERNATIVE IS EXECUTED.
+ 
+ -- (OPTIMIZATION TEST.)
+ 
+ 
+ -- RM 03/24/81
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C54A42A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C54A42A" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                        " A LARGE NUMBER OF POTENTIAL VALUES GROUPED"   &
+                        " INTO A SMALL NUMBER OF ALTERNATIVES" );
+ 
+      DECLARE
+ 
+           STATCON : CONSTANT CHARACTER := 'B' ;
+           STATVAR :          CHARACTER := 'Q' ;
+           DYNCON  : CONSTANT CHARACTER := IDENT_CHAR( 'Y' );
+           DYNVAR  :          CHARACTER := IDENT_CHAR( 'Z' );
+ 
+      BEGIN
+ 
+           CASE  CHARACTER'('A')  IS
+                WHEN  ASCII.NUL .. 'A'  =>  NULL ;
+                WHEN  'B'               =>  FAILED( "WRONG ALTERN. A2" );
+                WHEN  'P'               =>  FAILED( "WRONG ALTERN. A3" );
+                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. A4" );
+                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. A5" );
+                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. A6" );
+           END CASE;
+ 
+           CASE  STATCON  IS
+                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. B1" );
+                WHEN  'B'               =>  NULL ;
+                WHEN  'P'               =>  FAILED( "WRONG ALTERN. B3" );
+                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. B4" );
+                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. B5" );
+                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. B6" );
+           END CASE;
+ 
+           CASE  STATVAR  IS
+                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. C1" );
+                WHEN  'B'               =>  FAILED( "WRONG ALTERN. C2" );
+                WHEN  'P'               =>  FAILED( "WRONG ALTERN. C3" );
+                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. C4" );
+                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. C5" );
+                WHEN  OTHERS            =>  NULL ;
+           END CASE;
+ 
+           CASE  DYNCON  IS
+                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. D1" );
+                WHEN  'B'               =>  FAILED( "WRONG ALTERN. D2" );
+                WHEN  'P'               =>  FAILED( "WRONG ALTERN. D3" );
+                WHEN  'Y'               =>  NULL ;
+                WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. D5" );
+                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. D6" );
+           END CASE;
+ 
+           CASE  DYNVAR  IS
+                WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. E1" );
+                WHEN  'B'               =>  FAILED( "WRONG ALTERN. E2" );
+                WHEN  'P'               =>  FAILED( "WRONG ALTERN. E3" );
+                WHEN  'Y'               =>  FAILED( "WRONG ALTERN. E4" );
+                WHEN  'Z' .. ASCII.DEL  =>  NULL ;
+                WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. E6" );
+           END CASE;
+ 
+      END ;
+ 
+ 
+      DECLARE
+ 
+           NUMBER  : CONSTANT           := -100 ;
+           LITEXPR : CONSTANT           := 0 * NUMBER  + 16 ;
+           STATCON : CONSTANT INTEGER   := +100 ;
+           DYNVAR  :          INTEGER   := IDENT_INT( 102 ) ;
+           DYNCON  : CONSTANT INTEGER   := IDENT_INT(  17 ) ;
+ 
+      BEGIN
+ 
+           CASE  INTEGER'(-102)  IS
+                WHEN  INTEGER'FIRST..-101 => NULL ;
+                WHEN  -100                => FAILED("WRONG ALTERN. F2");
+                WHEN  17                  => FAILED("WRONG ALTERN. F2");
+                WHEN  100                 => FAILED("WRONG ALTERN. F4");
+                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. F5");
+                WHEN  OTHERS              => FAILED("WRONG ALTERN. F6");
+           END CASE;
+ 
+           CASE  IDENT_INT(NUMBER)  IS
+                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. G1");
+                WHEN  -100                => NULL ;
+                WHEN  17                  => FAILED("WRONG ALTERN. G3");
+                WHEN  100                 => FAILED("WRONG ALTERN. G4");
+                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. G5");
+                WHEN  OTHERS              => FAILED("WRONG ALTERN. G6");
+           END CASE;
+ 
+           CASE  IDENT_INT(LITEXPR)  IS
+                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. H1");
+                WHEN  -100                => FAILED("WRONG ALTERN. H2");
+                WHEN  17                  => FAILED("WRONG ALTERN. H3");
+                WHEN  100                 => FAILED("WRONG ALTERN. H4");
+                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. H5");
+                WHEN  OTHERS              => NULL ;
+           END CASE;
+ 
+           CASE  STATCON  IS
+                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. I1");
+                WHEN  -100                => FAILED("WRONG ALTERN. I2");
+                WHEN  17                  => FAILED("WRONG ALTERN. I3");
+                WHEN  100                 => NULL ;
+                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. I5");
+                WHEN  OTHERS              => FAILED("WRONG ALTERN. I6");
+           END CASE;
+ 
+           CASE  DYNVAR   IS
+                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. J1");
+                WHEN  -100                => FAILED("WRONG ALTERN. J2");
+                WHEN  17                  => FAILED("WRONG ALTERN. J3");
+                WHEN  100                 => FAILED("WRONG ALTERN. J4");
+                WHEN  101..INTEGER'LAST   => NULL ;
+                WHEN  OTHERS              => FAILED("WRONG ALTERN. J6");
+           END CASE;
+ 
+           CASE  DYNCON  IS
+                WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. K1");
+                WHEN  -100                => FAILED("WRONG ALTERN. K2");
+                WHEN  17                  => NULL ;
+                WHEN  100                 => FAILED("WRONG ALTERN. K4");
+                WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. K5");
+                WHEN  OTHERS              => FAILED("WRONG ALTERN. K6");
+           END CASE;
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C54A42A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,173 ----
+ -- C54A42B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES A SMALL RANGE OF
+ --    POTENTIAL VALUES GROUPED INTO A SMALL NUMBER OF ALTERNATIVES.
+ 
+ -- (OPTIMIZATION TEST -- JUMP TABLE.)
+ 
+ 
+ -- RM 03/26/81
+ -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C54A42B  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C54A42B" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                        " A SMALL NUMBER OF POTENTIAL VALUES GROUPED"   &
+                        " INTO A SMALL NUMBER OF ALTERNATIVES" );
+ 
+      DECLARE
+ 
+           STATCON : CONSTANT CHARACTER RANGE 'A'..'K' := 'J' ;
+           STATVAR :          CHARACTER RANGE 'A'..'K' := 'A' ;
+           DYNCON  : CONSTANT CHARACTER RANGE 'A'..'K' :=IDENT_CHAR('K');
+           DYNVAR  :          CHARACTER RANGE 'A'..'K' :=IDENT_CHAR('G');
+ 
+      BEGIN
+ 
+           CASE  STATVAR  IS
+                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE A1" );
+                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE A2" );
+                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE A3" );
+                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE A4" );
+                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE A5" );
+                WHEN  OTHERS         => NULL ;
+           END CASE;
+ 
+           CASE  CHARACTER'('B')  IS
+                WHEN  'B' | 'E'      => NULL ;
+                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE B2" );
+                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE B3" );
+                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE B4" );
+                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE B5" );
+                WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE B6" );
+           END CASE;
+ 
+           CASE  DYNVAR   IS
+                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE C1" );
+                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE C2" );
+                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE C3" );
+                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE C4" );
+                WHEN  'G'            => NULL ;
+                WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE C6" );
+           END CASE;
+ 
+           CASE  IDENT_CHAR(STATCON)  IS
+                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE D1" );
+                WHEN  'J' | 'C'      => NULL ;
+                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE D3" );
+                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE D4" );
+                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE D5" );
+                WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE D6" );
+           END CASE;
+ 
+           CASE  DYNCON   IS
+                WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE E1" );
+                WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE E2" );
+                WHEN  'F'            => FAILED( "WRONG ALTERNATIVE E3" );
+                WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE E4" );
+                WHEN  'G'            => FAILED( "WRONG ALTERNATIVE E5" );
+                WHEN  OTHERS         => NULL ;
+           END CASE;
+ 
+      END ;
+ 
+ 
+      DECLARE
+ 
+           NUMBER  : CONSTANT                      := 1 ;
+           LITEXPR : CONSTANT                      := NUMBER + 5 ;
+           STATCON : CONSTANT INTEGER RANGE 0..10  := 9 ;
+           DYNVAR  :          INTEGER RANGE 0..10  := IDENT_INT( 10 );
+           DYNCON  : CONSTANT INTEGER RANGE 0..10  := IDENT_INT(  2 );
+ 
+      BEGIN
+ 
+           CASE  INTEGER'(0)  IS
+                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE F1");
+                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE F2");
+                WHEN  5               =>  FAILED("WRONG ALTERNATIVE F3");
+                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE F4");
+                WHEN  6               =>  FAILED("WRONG ALTERNATIVE F5");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  INTEGER'(NUMBER)   IS
+                WHEN  1 | 4           =>  NULL ;
+                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE G2");
+                WHEN  5               =>  FAILED("WRONG ALTERNATIVE G3");
+                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE G4");
+                WHEN  6               =>  FAILED("WRONG ALTERNATIVE G5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
+           END CASE;
+ 
+           CASE  IDENT_INT(LITEXPR)  IS
+                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE H1");
+                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE H2");
+                WHEN  5               =>  FAILED("WRONG ALTERNATIVE H3");
+                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE H4");
+                WHEN  6               =>  NULL ;
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H6");
+           END CASE;
+ 
+           CASE  STATCON  IS
+                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE I1");
+                WHEN  9 | 2           =>  NULL ;
+                WHEN  5               =>  FAILED("WRONG ALTERNATIVE I3");
+                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE I4");
+                WHEN  6               =>  FAILED("WRONG ALTERNATIVE I5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
+           END CASE;
+ 
+           CASE  DYNVAR   IS
+                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE J1");
+                WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE J2");
+                WHEN  5               =>  FAILED("WRONG ALTERNATIVE J3");
+                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE J4");
+                WHEN  6               =>  FAILED("WRONG ALTERNATIVE J5");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  DYNCON  IS
+                WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE K1");
+                WHEN  9 | 2           =>  NULL ;
+                WHEN  5               =>  FAILED("WRONG ALTERNATIVE K3");
+                WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE K4");
+                WHEN  6               =>  FAILED("WRONG ALTERNATIVE K5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
+           END CASE;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C54A42B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,123 ----
+ -- C54A42C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A  CASE_STATEMENT  CORRECTLY HANDLES A SPARSE SET OF
+ --    POTENTIAL VALUES (OF TYPE INTEGER) IN A LARGE RANGE.
+ 
+ --    (OPTIMIZATION TEST)
+ 
+ 
+ -- RM 03/26/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C54A42C  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C54A42C" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                        " A SPARSE SET OF POTENTIAL VALUES IN A LARGE"  &
+                        " RANGE" );
+ 
+      DECLARE
+ 
+           NUMBER  : CONSTANT                           := 1001 ;
+           LITEXPR : CONSTANT                           := NUMBER + 998 ;
+           STATCON : CONSTANT INTEGER RANGE  1..INTEGER'LAST :=    1000 ;
+           DYNVAR  :          INTEGER RANGE  1..INTEGER'LAST :=
+                                            IDENT_INT( INTEGER'LAST-50 );
+           DYNCON  : CONSTANT INTEGER RANGE  1..INTEGER'LAST :=
+                                            IDENT_INT( 1000 );
+ 
+      BEGIN
+ 
+           CASE  INTEGER'( NUMBER )  IS
+                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE F1");
+                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE F2");
+                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE F3");
+                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE F4");
+                WHEN  INTEGER'LAST-100 ..
+                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE F5");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  IDENT_INT( 10 )  IS
+                WHEN  1 .. 10         =>  NULL ;
+                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE G2");
+                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE G3");
+                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE G4");
+                WHEN  INTEGER'LAST -100 ..
+                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE G5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
+           END CASE;
+ 
+           CASE  IDENT_INT(LITEXPR)  IS
+                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE H1");
+                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE H2");
+                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE H3");
+                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE H4");
+                WHEN  INTEGER'LAST -100 ..
+                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE H5");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  STATCON  IS
+                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE I1");
+                WHEN  1000            =>  NULL ;
+                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE I3");
+                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE I4");
+                WHEN  INTEGER'LAST -100 ..
+                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE I5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
+           END CASE;
+ 
+           CASE  DYNVAR   IS
+                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE J1");
+                WHEN  1000            =>  FAILED("WRONG ALTERNATIVE J2");
+                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE J3");
+                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE J4");
+                WHEN  INTEGER'LAST -100 ..
+                      INTEGER'LAST    =>  NULL ;
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE J6");
+           END CASE;
+ 
+           CASE  DYNCON  IS
+                WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE K1");
+                WHEN  1000            =>  NULL ;
+                WHEN  2000            =>  FAILED("WRONG ALTERNATIVE K3");
+                WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE K4");
+                WHEN  INTEGER'LAST -100 ..
+                      INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE K5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
+           END CASE;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C54A42C ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C54A42D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES A FEW ALTERNATIVES
+ --    COVERING A LARGE RANGE OF INTEGERS.
+ 
+ 
+ -- (OPTIMIZATION TEST.)
+ 
+ 
+ -- RM 03/30/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C54A42D  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C54A42D" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
+                        " A FEW ALTERNATIVES COVERING A LARGE RANGE" &
+                        " OF INTEGERS" );
+ 
+      DECLARE
+ 
+           NUMBER  : CONSTANT          := 2000 ;
+           LITEXPR : CONSTANT          := NUMBER + 2000 ;
+           STATCON : CONSTANT INTEGER  := 2001 ;
+           DYNVAR  :          INTEGER  := IDENT_INT( 0 );
+           DYNCON  : CONSTANT INTEGER  := IDENT_INT( 1 );
+ 
+      BEGIN
+ 
+           CASE  INTEGER'(-4000)  IS
+                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE F1");
+                WHEN  INTEGER'FIRST..0=>  NULL ;
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE F3");
+                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE F4");
+           END CASE;
+ 
+           CASE  INTEGER'(NUMBER)   IS
+                WHEN  1..2000         =>  NULL ;
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE G2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE G3");
+                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE G4");
+           END CASE;
+ 
+           CASE  IDENT_INT(LITEXPR)  IS
+                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE H1");
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE H2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE H3");
+                WHEN  2002..INTEGER'LAST=>NULL ;
+           END CASE;
+ 
+           CASE  STATCON  IS
+                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE I1");
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE I2");
+                WHEN  2001            =>  NULL ;
+                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE I4");
+           END CASE;
+ 
+           CASE  DYNVAR   IS
+                WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE J1");
+                WHEN  INTEGER'FIRST..0=>  NULL ;
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE J3");
+                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE J4");
+           END CASE;
+ 
+           CASE  DYNCON   IS
+                WHEN  1..2000         =>  NULL ;
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE K2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE K3");
+                WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE K4");
+           END CASE;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C54A42D ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C54A42E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A  CASE_STATEMENT  CORRECTLY HANDLES A SMALL RANGE OF
+ --    POTENTIAL VALUES OF TYPE INTEGER, SITUATED FAR FROM  0  AND
+ --    GROUPED INTO A SMALL NUMBER OF ALTERNATIVES.
+ 
+ -- (OPTIMIZATION TEST -- BIASED JUMP TABLE.)
+ 
+ 
+ -- RM 03/26/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C54A42E  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C54A42E" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                        " A SMALL, FAR RANGE OF POTENTIAL VALUES OF" &
+                        " TYPE INTEGER" );
+ 
+      DECLARE
+ 
+           NUMBER  : CONSTANT                           := 4001 ;
+           LITEXPR : CONSTANT                           := NUMBER + 5 ;
+           STATCON : CONSTANT INTEGER RANGE 4000..4010  := 4009 ;
+           DYNVAR  :          INTEGER RANGE 4000..4010  :=
+                                                       IDENT_INT( 4010 );
+           DYNCON  : CONSTANT INTEGER RANGE 4000..4010  :=
+                                                       IDENT_INT( 4002 );
+ 
+      BEGIN
+ 
+           CASE  INTEGER'(4000)  IS
+                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE F1");
+                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE F2");
+                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE F3");
+                WHEN  4003 |
+                      4007..4008      =>  FAILED("WRONG ALTERNATIVE F4");
+                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE F5");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  IDENT_INT(NUMBER)  IS
+                WHEN  4001 | 4004     =>  NULL ;
+                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE G2");
+                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE G3");
+                WHEN  4003 |
+                      4007..4008      =>  FAILED("WRONG ALTERNATIVE G4");
+                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE G5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
+           END CASE;
+ 
+           CASE  IDENT_INT(LITEXPR)  IS
+                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE H1");
+                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE H2");
+                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE H3");
+                WHEN  4003 |
+                      4007..4008      =>  FAILED("WRONG ALTERNATIVE H4");
+                WHEN  4006            =>  NULL ;
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H6");
+           END CASE;
+ 
+           CASE  STATCON  IS
+                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE I1");
+                WHEN  4009 | 4002     =>  NULL ;
+                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE I3");
+                WHEN  4003 |
+                      4007..4008      =>  FAILED("WRONG ALTERNATIVE I4");
+                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE I5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
+           END CASE;
+ 
+           CASE  DYNVAR   IS
+                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE J1");
+                WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE J2");
+                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE J3");
+                WHEN  4003 |
+                      4007..4008      =>  FAILED("WRONG ALTERNATIVE J4");
+                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE J5");
+                WHEN  OTHERS          =>  NULL ;
+ 
+           END CASE;
+ 
+           CASE  DYNCON  IS
+                WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE K1");
+                WHEN  4009 | 4002     =>  NULL ;
+                WHEN  4005            =>  FAILED("WRONG ALTERNATIVE K3");
+                WHEN  4003 |
+                      4007..4008      =>  FAILED("WRONG ALTERNATIVE K4");
+                WHEN  4006            =>  FAILED("WRONG ALTERNATIVE K5");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
+           END CASE;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C54A42E ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,126 ----
+ -- C54A42F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES SEVERAL SMALL,
+ --    NON-CONTIGUOUS RANGES OF INTEGERS COVERED BY A SINGLE  'OTHERS'
+ --    ALTERNATIVE.
+ 
+ 
+ -- (OPTIMIZATION TEST.)
+ 
+ 
+ -- RM 03/31/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C54A42F  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C54A42F" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
+                        " SEVERAL SMALL, NON-CONTIGUOUS ENUMERATION"    &
+                        " RANGES COVERED BY A SINGLE  'OTHERS'  "       &
+                        " ALTERNATIVE"  );
+ 
+      DECLARE
+ 
+           TYPE  DAY  IS (SUN , MON , TUE , WED , THU , FRI ,  SAT );
+ 
+           DYNVAR2 :          DAY  := MON ;
+           STATVAR :          DAY  := TUE ;
+           STATCON : CONSTANT DAY  := WED ;
+           DYNVAR  :          DAY  := THU ;
+           DYNCON  : CONSTANT DAY  :=     DAY'VAL( IDENT_INT(5) ); -- FRI
+ 
+      BEGIN
+ 
+           IF EQUAL(1,289) THEN
+                DYNVAR  := SUN ;
+                DYNVAR2 := SUN ;
+           END IF;
+ 
+           CASE  SUN  IS        --  SUN
+                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE F1");
+                WHEN  SUN       =>  NULL ;
+                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE F3");
+                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE F4");
+                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE F5");
+           END CASE;
+ 
+           CASE  DYNVAR2   IS   --  MON
+                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE G1");
+                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE G2");
+                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE G3");
+                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE G4");
+                WHEN  OTHERS    =>  NULL ;
+           END CASE;
+ 
+           CASE  STATVAR  IS    --  TUE
+                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE H1");
+                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE H2");
+                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE H3");
+                WHEN  TUE..WED  =>  NULL ;
+                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE H5");
+           END CASE;
+ 
+           CASE  STATCON  IS    --  WED
+                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE I1");
+                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE I2");
+                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE I3");
+                WHEN  TUE..WED  =>  NULL ;
+                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE I5");
+           END CASE;
+ 
+           CASE  DYNVAR   IS    --  THU
+                WHEN  THU       =>  NULL ;
+                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE J2");
+                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE J3");
+                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE J4");
+                WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE J5");
+           END CASE;
+ 
+           CASE  DYNCON   IS    --  FRI
+                WHEN  THU       =>  FAILED("WRONG ALTERNATIVE K1");
+                WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE K2");
+                WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE K3");
+                WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE K4");
+                WHEN  OTHERS    =>  NULL ;
+           END CASE;
+ 
+           CASE  DAY'SUCC( DYNCON )  IS   --  SAT
+                WHEN THU       =>  FAILED("WRONG ALTERNATIVE L1");
+                WHEN SUN       =>  FAILED("WRONG ALTERNATIVE L2");
+                WHEN SAT       =>  NULL ;
+                WHEN TUE..WED  =>  FAILED("WRONG ALTERNATIVE L4");
+                WHEN OTHERS    =>  FAILED("WRONG ALTERNATIVE L5");
+           END CASE;
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C54A42F ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c54a42g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c54a42g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- C54A42G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A  CASE_STATEMENT CORRECTLY HANDLES SEVERAL NON-CONTIGUOUS
+ --    RANGES OF INTEGERS COVERED BY A SINGLE  'OTHERS'  ALTERNATIVE.
+ 
+ 
+ -- (OPTIMIZATION TEST.)
+ 
+ 
+ -- RM 03/30/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C54A42G  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C54A42G" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
+                        " SEVERAL NON-CONTIGUOUS RANGES OF INTEGERS"    &
+                        " COVERED BY A SINGLE  'OTHERS'  ALTERNATIVE"  );
+ 
+      DECLARE
+ 
+           NUMBER  : CONSTANT          := 2000 ;
+           LITEXPR : CONSTANT          := NUMBER + 2000 ;
+           STATCON : CONSTANT INTEGER  := 2002 ;
+           DYNVAR  :          INTEGER  := IDENT_INT( 0 );
+           DYNCON  : CONSTANT INTEGER  := IDENT_INT( 1 );
+ 
+      BEGIN
+ 
+           CASE  INTEGER'(-4000)  IS
+                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE F1");
+                WHEN  INTEGER'FIRST..0=>  NULL ;
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE F3");
+                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE F4");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE F5");
+           END CASE;
+ 
+           CASE  IDENT_INT(NUMBER)   IS
+                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE G1");
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE G2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE G3");
+                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE G4");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  IDENT_INT(LITEXPR)  IS
+                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE H1");
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE H2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE H3");
+                WHEN  2100..INTEGER'LAST=>NULL ;
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H5");
+           END CASE;
+ 
+           CASE  IDENT_INT(STATCON)  IS
+                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE I1");
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE I2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE I3");
+                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE I4");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  DYNVAR   IS
+                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE J1");
+                WHEN  INTEGER'FIRST..0=>  NULL ;
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE J3");
+                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE J4");
+                WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE J5");
+           END CASE;
+ 
+           CASE  DYNCON   IS
+                WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE K1");
+                WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE K2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE K3");
+                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE K4");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+           CASE  IDENT_INT( -3900 )  IS
+                WHEN  -3000..1999     =>  FAILED("WRONG ALTERNATIVE X1");
+                WHEN  INTEGER'FIRST..
+                            -4000     =>  FAILED("WRONG ALTERNATIVE X2");
+                WHEN  2001            =>  FAILED("WRONG ALTERNATIVE X3");
+                WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE X4");
+                WHEN  OTHERS          =>  NULL ;
+           END CASE;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C54A42G ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b03a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b03a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b03a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- C55B03A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE LOOP_PARAMETER IS ASSIGNED VALUES IN ASCENDING ORDER 
+ --   IF REVERSE IS ABSENT, AND DESCENDING ORDER IF REVERSE IS PRESENT.
+ 
+ -- DAS 1/12/81
+ -- SPS 3/2/83
+ 
+ WITH REPORT;
+ PROCEDURE C55B03A IS
+ 
+      USE REPORT;
+      I1 : INTEGER;
+ 
+ BEGIN
+      TEST( "C55B03A" , "CHECK CORRECT ORDER OF VALUE SEQUENCING" & 
+            " FOR A LOOP_PARAMETER" );
+ 
+      I1 := 0;
+      FOR I IN IDENT_INT(1)..IDENT_INT(5) LOOP
+           I1 := I1 + 1;
+           IF ( I /= I1 ) THEN
+                FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY" );
+           END IF;
+      END LOOP;
+ 
+      I1 := 6;
+      FOR I IN REVERSE IDENT_INT(1)..IDENT_INT(5) LOOP
+           I1 := I1 - 1;
+           IF ( I /= I1 ) THEN
+                FAILED ( "LOOP_PARAMETER DESCENDING INCORRECTLY" );
+           END IF;
+      END LOOP;
+ 
+      RESULT;
+ 
+ END C55B03A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b04a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b04a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b04a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b04a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ --  C55B04A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A LOOP IS NOT ENTERED IF THE LOWER BOUND OF THE DISCRETE
+ --   RANGE IS GREATER THAN THE UPPER BOUND, WHETHER REVERSE IS PRESENT
+ --   OR NOT.
+ 
+ -- CHECK THAT LOOP BOUNDS ARE EVALUATED ONLY ONCE, UPON ENTRY TO 
+ --   THE LOOP.
+ 
+ -- DAS  01/12/81
+ -- SPS 3/2/83
+ -- JBG 8/21/83
+ 
+ WITH REPORT;
+ PROCEDURE C55B04A IS
+ 
+      USE REPORT;
+ 
+      C10 : CONSTANT INTEGER := 10;
+      I10 : INTEGER;
+ 
+ BEGIN
+      TEST ( "C55B04A", "CHECK OPERATION OF A FOR LOOP OVER A NULL " & 
+                        "DISCRETE RANGE" );
+ 
+      -- NOTE: EXIT STATEMENTS ARE INCLUDED TO AID IN RECOVERY FROM
+      --   TEST FAILURE.
+ 
+      -- SUBTESTS INVOLVING STATIC BOUNDS:
+ 
+      FOR I IN 10..1 LOOP
+           FAILED ( "LOOPING OVER NULL RANGE 10..1" );
+           EXIT;
+      END LOOP;
+ 
+      FOR I IN REVERSE INTEGER RANGE -1..-10 LOOP
+           FAILED ( "LOOPING OVER NULL RANGE -1..-10" );
+           EXIT;
+      END LOOP;
+ 
+      FOR I IN (C10 + 3)..(-3 * C10 + 27) LOOP     -- 13..-3
+           FAILED ("LOOPING OVER NULL RANGE (C10 + 3)..(-3 * C10 + 27)");
+           EXIT;
+      END LOOP;
+ 
+ 
+      -- SUBTESTS INVOLVING DYNAMIC BOUNDS:
+ 
+      I10 := IDENT_INT(10);
+ 
+      FOR I IN REVERSE I10..(I10-1) LOOP           -- 10..9
+           FAILED ( "LOOPING OVER NULL RANGE I10..(I10-1)");
+           EXIT;
+      END LOOP;
+ 
+ 
+      FOR I IN (C10 - I10)..(I10 - 11) LOOP        -- 0..-1
+           FAILED ( "LOOPING OVER NULL RANGE (C10 - I10)..(I10 - 11)" );
+           EXIT;
+      END LOOP;
+ 
+ 
+      -- SUBTEST OF BOUNDS EVALUTION ONLY AT ENTRY:
+ 
+      FOR I IN 1..I10 LOOP
+           I10 := I10 - 1;
+      END LOOP;
+      IF (I10 /= 0) THEN
+           FAILED ( "LOOP BOUNDS NOT FIXED AT LOOP ENTRY" );
+      END IF;
+ 
+      RESULT;
+ 
+ END C55B04A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b05a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b05a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b05a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C55B05A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LOOPS WITH BOUNDS INTEGER'LAST OR
+ -- INTEGER'FIRST DO NOT RAISE INVALID EXCEPTIONS.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- DAT 3/26/81
+ -- SPS 3/2/83
+ -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C55B05A IS
+ BEGIN
+      TEST ("C55B05A", "LOOPS WITH INTEGER'FIRST AND 'LAST AS BOUNDS");
+ 
+      DECLARE
+ 
+           COUNT : INTEGER := 0;
+ 
+           PROCEDURE C IS
+           BEGIN
+                COUNT := COUNT + 1;
+           END C;
+ 
+      BEGIN
+           FOR I IN INTEGER'LAST .. INTEGER'FIRST LOOP
+                FAILED ("WRONG NULL RANGE LOOP EXECUTION");
+                EXIT;
+           END LOOP;
+           FOR I IN INTEGER'FIRST .. INTEGER'FIRST LOOP
+                C;
+           END LOOP;
+           FOR I IN INTEGER'FIRST .. INTEGER'FIRST + 2 LOOP
+                C; C;
+           END LOOP;
+           FOR I IN INTEGER'FIRST + 1 .. INTEGER'FIRST LOOP
+                FAILED ("NULL RANGE ERROR 2");
+                EXIT;
+           END LOOP;
+           FOR I IN INTEGER'FIRST .. INTEGER'LAST LOOP
+                C;
+                EXIT;
+           END LOOP;
+           FOR I IN INTEGER LOOP
+                C;
+                EXIT;
+           END LOOP;
+           FOR I IN INTEGER'LAST - 2 .. INTEGER'LAST LOOP
+                C; C; C;
+           END LOOP;
+           FOR I IN INTEGER'LAST - 2 .. INTEGER'LAST - 1 LOOP
+                C;
+           END LOOP;
+           FOR I IN 0 .. INTEGER'FIRST LOOP
+                FAILED ("NULL LOOP ERROR 3");
+                EXIT;
+           END LOOP;
+           FOR I IN -1 .. INTEGER'FIRST LOOP
+                FAILED ("NULL LOOP ERROR 4");
+                EXIT;
+           END LOOP;
+           FOR I IN -3 .. IDENT_INT(0) LOOP
+                FOR J IN INTEGER'FIRST .. INTEGER'FIRST - I LOOP
+                     C; C; C; C;
+                END LOOP;
+                FOR J IN INTEGER'FIRST - I .. INTEGER'FIRST + 3 - I LOOP
+                     C; C; C; C;
+                END LOOP;
+                FOR J IN INTEGER'LAST - 3 .. INTEGER'LAST + I LOOP
+                     C; C; C; C;
+                END LOOP;
+                FOR J IN INTEGER'LAST + I .. INTEGER'LAST LOOP
+                     C; C; C; C;
+                END LOOP;
+           END LOOP;
+ 
+           FOR I IN REVERSE INTEGER'LAST .. INTEGER'FIRST LOOP
+                FAILED ("REVERSE WRONG NULL RANGE LOOP EXECUTION");
+                EXIT;
+           END LOOP;
+           FOR I IN REVERSE INTEGER'FIRST .. INTEGER'FIRST LOOP
+                C;
+           END LOOP;
+           FOR I IN REVERSE INTEGER'FIRST .. INTEGER'FIRST + 2 LOOP
+                C; C;
+           END LOOP;
+           FOR I IN REVERSE INTEGER'FIRST + 1 .. INTEGER'FIRST LOOP
+                FAILED ("NULL RANGE ERROR 8");
+                EXIT;
+           END LOOP;
+           FOR I IN REVERSE INTEGER'FIRST .. INTEGER'LAST LOOP
+                C;
+                EXIT;
+           END LOOP;
+           FOR I IN REVERSE INTEGER LOOP
+                C;
+                EXIT;
+           END LOOP;
+           FOR I IN REVERSE INTEGER'LAST - 2 .. INTEGER'LAST LOOP
+                C; C; C;
+           END LOOP;
+           FOR I IN REVERSE INTEGER'LAST - 2 .. INTEGER'LAST - 1 LOOP
+                C;
+           END LOOP;
+           FOR I IN REVERSE 0 .. INTEGER'FIRST LOOP
+                FAILED ("NULL LOOP ERROR 9");
+                EXIT;
+           END LOOP;
+           FOR I IN REVERSE -1 .. INTEGER'FIRST LOOP
+                FAILED ("NULL LOOP ERROR 7");
+                EXIT;
+           END LOOP;
+           FOR I IN REVERSE -3 .. IDENT_INT(0) LOOP
+                FOR J IN REVERSE INTEGER'FIRST .. INTEGER'FIRST - I LOOP
+                     C; C; C; C;
+                END LOOP;
+                FOR J IN REVERSE INTEGER'FIRST - I
+                     .. INTEGER'FIRST + 3 - I
+                LOOP
+                     C; C; C; C;
+                END LOOP;
+                FOR J IN REVERSE INTEGER'LAST - 3 .. INTEGER'LAST + I
+                LOOP
+                     C; C; C; C;
+                END LOOP;
+                FOR J IN REVERSE INTEGER'LAST + I .. INTEGER'LAST LOOP
+                     C; C; C; C;
+                END LOOP;
+           END LOOP;
+ 
+           IF COUNT /= 408 THEN
+                FAILED ("WRONG LOOP EXECUTION COUNT");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED INCORRECTLY");
+           WHEN OTHERS =>
+                FAILED ("UNKNOWN EXCEPTION RAISED INCORRECTLY");
+      END;
+ 
+      RESULT;
+ END C55B05A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b06a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b06a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b06a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b06a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,313 ----
+ -- C55B06A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LOOPS MAY BE SPECIFIED FOR BOOLEAN, INTEGER,
+ -- CHARACTER, ENUMERATION, AND DERIVED TYPES, INCLUDING
+ -- TYPES DERIVED FROM DERIVED TYPES. DERIVED BOOLEAN IS NOT
+ -- TESTED IN THIS TEST.
+ 
+ -- DAT 3/26/81
+ -- JBG 9/29/82
+ -- SPS 3/11/83
+ -- JBG 10/5/83
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C55B06A IS
+ 
+      TYPE ENUM IS ('A', 'B', 'D', 'C', Z, X, D, A, C);
+ 
+      TYPE D1 IS NEW CHARACTER RANGE 'A' .. 'Z';
+      TYPE D2 IS NEW INTEGER;
+      TYPE D3 IS NEW ENUM;
+      TYPE D4 IS NEW D1;
+      TYPE D5 IS NEW D2;
+      TYPE D6 IS NEW D3;
+ 
+      ONE : INTEGER := IDENT_INT(1);
+      COUNT : INTEGER := 0;
+      OLDCOUNT : INTEGER := 0;
+ 
+      PROCEDURE Q IS
+      BEGIN
+           COUNT := COUNT + ONE;
+      END Q;
+ 
+ BEGIN
+      TEST ("C55B06A", "TEST LOOPS FOR ALL DISCRETE TYPES");
+ 
+      FOR I IN BOOLEAN LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 1");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN FALSE .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 2");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN BOOLEAN RANGE FALSE .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 3");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN INTEGER LOOP
+           Q;
+           EXIT WHEN I = INTEGER'FIRST + 2;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+           FAILED ("LOOP 4");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN 3 .. IDENT_INT (5) LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+           FAILED ("LOOP 5");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN INTEGER RANGE -2 .. -1 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 6");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN INTEGER RANGE INTEGER'FIRST .. INTEGER'FIRST + 1 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 7");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN 'A' .. CHARACTER'('Z') LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+           FAILED ("LOOP 9");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN CHARACTER RANGE 'A' .. 'D' LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
+           FAILED ("LOOP 10");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN ENUM LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(9) /= COUNT THEN
+           FAILED ("LOOP 11");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN ENUM RANGE D .. C LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+           FAILED ("LOOP 12");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN 'A' .. ENUM'(Z) LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+           FAILED ("LOOP 13");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D1 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+           FAILED ("LOOP 14");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D1 RANGE 'A' .. 'Z' LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+           FAILED ("LOOP 15");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D1'('A') .. 'D' LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
+           FAILED ("LOOP 16");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D2 LOOP
+           Q;
+           IF I > D2'FIRST + 3 THEN
+                EXIT;
+           END IF;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+           FAILED ("LOOP 17");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D2 RANGE -100 .. -99 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 18");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D2'(1) .. 2 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 19");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D3 LOOP
+           IF I IN 'A' .. 'C' THEN
+                Q;        -- 4
+           ELSE
+                Q; Q;     -- 10
+           END IF;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(14) /= COUNT THEN
+           FAILED ("LOOP 20");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D3 RANGE 'A' .. Z LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+           FAILED ("LOOP 21");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN 'A' .. D3'(Z) LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+           FAILED ("LOOP 22");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D4 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+           FAILED ("LOOP 23");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D4'('A') .. 'Z' LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+           FAILED ("LOOP 24");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR I IN D4 RANGE 'B' .. 'D' LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+           FAILED ("LOOP 25");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR J IN D5 LOOP
+           Q;        -- 4
+           EXIT WHEN J = D5(INTEGER'FIRST) + 3;
+           Q;        -- 3
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(7) /= COUNT THEN
+           FAILED ("LOOP 26");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR J IN D5 RANGE -2 .. -1 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+           FAILED ("LOOP 27");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR  J IN D5'(-10) .. D5'(-6) LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+           FAILED ("LOOP 28");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR J IN D6 LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(9) /= COUNT THEN
+           FAILED ("LOOP 29");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR J IN D6 RANGE Z .. A LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
+           FAILED ("LOOP 30");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+      FOR J IN D6'('D') .. D LOOP
+           Q;
+      END LOOP;
+      IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+           FAILED ("LOOP 31");
+      END IF;
+      OLDCOUNT := COUNT;
+ 
+ 
+      RESULT;
+ END C55B06A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b06b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b06b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b06b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b06b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,188 ----
+ -- C55B06B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LOOPS MAY BE SPECIFIED FOR DERIVED BOOLEAN AND
+ -- DERIVED DERIVED BOOLEAN.
+ 
+ -- DAT 3/26/81
+ -- SPS 3/2/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C55B06B IS
+ 
+      TYPE E IS (FALSE, TRUE);
+      TYPE B1 IS NEW BOOLEAN;
+      TYPE B2 IS NEW B1;
+      TYPE B3 IS NEW E;
+ 
+      ONE : INTEGER := IDENT_INT (1);
+      COUNT : INTEGER := 0;
+      OLD_COUNT : INTEGER := 0;
+ 
+      PROCEDURE Q IS
+      BEGIN
+           COUNT := COUNT + 1;
+      END Q;
+ 
+ BEGIN
+      TEST ("C55B06B", "LOOPS OVER DERIVED BOOLEAN");
+ 
+      FOR I IN BOOLEAN LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 1");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN BOOLEAN RANGE FALSE .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 2");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN BOOLEAN'(FALSE) .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 3");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN E LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 4");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN E RANGE FALSE .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 5");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN FALSE .. E'(TRUE) LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 6");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN B1 LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 7");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN B1 RANGE FALSE .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 8");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN FALSE .. B1'(TRUE) LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 9");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN B2 LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 10");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN B2 RANGE FALSE .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 11");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN B2'(FALSE) .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 12");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN B3 LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 13");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN B3 RANGE FALSE .. TRUE LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 14");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      FOR I IN FALSE .. B3'(TRUE) LOOP
+           Q;
+      END LOOP;
+      IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+           FAILED ("LOOP 15");
+      ELSE
+           OLD_COUNT := COUNT;
+      END IF;
+ 
+      RESULT;
+  END C55B06B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b07a.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b07a.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b07a.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b07a.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,126 ----
+ -- C55B07A.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT LOOPS OVER RANGES OF TYPE LONG_INTEGER
+ --     CAN BE WRITTEN.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+ --     THE TYPE LONG_INTEGER.
+ --
+ --     IF THE TYPE LONG_INTEGER IS NOT SUPPORTED, THEN THE
+ --     DECLARATION OF CHECK MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RM  07/06/82  CREATED ORIGINAL TEST.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C55B07A IS
+ 
+      CHECK : LONG_INTEGER;                             -- N/A => ERROR.
+ 
+      TYPE  NEW_LONG_INTEGER  IS  NEW LONG_INTEGER ;
+ 
+      THE_COUNT : INTEGER := 777 ;   -- JUST A DUMMY...
+ 
+      LI_VAR   :           LONG_INTEGER      :=  1 ;
+      LI_CON   :  CONSTANT LONG_INTEGER      :=  1 ;
+ 
+      NLI_VAR  :           NEW_LONG_INTEGER  :=  1 ;
+      NLI_CON  :  CONSTANT NEW_LONG_INTEGER  :=  1 ;
+ 
+      SUBTYPE   LI_SEGMENT  IS  LONG_INTEGER RANGE
+                                LONG_INTEGER'LAST..LONG_INTEGER'LAST ;
+ 
+      SUBTYPE  NLI_SEGMENT  IS  NEW_LONG_INTEGER RANGE
+                                NEW_LONG_INTEGER'FIRST..
+                                NEW_LONG_INTEGER'FIRST ;
+ 
+      COUNT : INTEGER := 0;
+ 
+      PROCEDURE  BUMP ( DUMMY : INTEGER )  IS
+      BEGIN
+           COUNT := COUNT + 1;
+      END  BUMP;
+ 
+ BEGIN
+ 
+      TEST ( "C55B07A" , "LOOPS OVER RANGES OF TYPE  LONG_INTEGER " );
+ 
+      FOR  I  IN  1..LI_CON  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  NLI_VAR..1  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  1..LONG_INTEGER(1)  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  1..NEW_LONG_INTEGER(1)  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  LI_SEGMENT  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  REVERSE NLI_SEGMENT  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  LONG_INTEGER RANGE 1..1  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  NEW_LONG_INTEGER RANGE 1..1  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  LONG_INTEGER LOOP
+           BUMP(THE_COUNT) ;
+           EXIT WHEN  I = LONG_INTEGER'FIRST + 1;
+      END LOOP;
+ 
+      FOR  I  IN  NEW_LONG_INTEGER LOOP
+           BUMP(THE_COUNT) ;
+           EXIT WHEN  I = NEW_LONG_INTEGER'FIRST + 1;
+      END LOOP;
+ 
+ 
+      IF  COUNT /= 12  THEN
+           FAILED ("WRONG LOOP COUNT");
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C55B07A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b07b.dep gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b07b.dep
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b07b.dep	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b07b.dep	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,126 ----
+ -- C55B07B.DEP
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT LOOPS OVER RANGES OF TYPE SHORT_INTEGER
+ --     CAN BE WRITTEN.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+ --     THE TYPE SHORT_INTEGER.
+ --
+ --     IF THE TYPE SHORT_INTEGER IS NOT SUPPORTED, THEN THE
+ --     DECLARATION OF CHECK MUST BE REJECTED.
+ 
+ -- HISTORY:
+ --     RM  07/08/82  CREATED ORIGINAL TEST.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C55B07B IS
+ 
+      CHECK : SHORT_INTEGER;                            -- N/A => ERROR.
+ 
+      TYPE  NEW_SHORT_INTEGER  IS  NEW SHORT_INTEGER ;
+ 
+      THE_COUNT : INTEGER := 777 ;   -- JUST A DUMMY...
+ 
+      SI_VAR   :           SHORT_INTEGER      :=  1 ;
+      SI_CON   :  CONSTANT SHORT_INTEGER      :=  1 ;
+ 
+      NSI_VAR  :           NEW_SHORT_INTEGER  :=  1 ;
+      NSI_CON  :  CONSTANT NEW_SHORT_INTEGER  :=  1 ;
+ 
+      SUBTYPE   SI_SEGMENT  IS  SHORT_INTEGER RANGE
+                                SHORT_INTEGER'LAST..SHORT_INTEGER'LAST ;
+ 
+      SUBTYPE  NSI_SEGMENT  IS  NEW_SHORT_INTEGER RANGE
+                                NEW_SHORT_INTEGER'FIRST..
+                                NEW_SHORT_INTEGER'FIRST ;
+ 
+      COUNT : INTEGER := 0;
+ 
+      PROCEDURE  BUMP ( DUMMY : INTEGER )  IS
+      BEGIN
+           COUNT := COUNT + 1;
+      END  BUMP;
+ 
+ BEGIN
+ 
+      TEST ( "C55B07B" , "LOOPS OVER RANGES OF TYPE  SHORT_INTEGER " );
+ 
+      FOR  I  IN  1..SI_CON  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  NSI_VAR..1  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  1..SHORT_INTEGER(1)  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  1..NEW_SHORT_INTEGER(1)  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  SI_SEGMENT  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  REVERSE NSI_SEGMENT  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  SHORT_INTEGER RANGE 1..1  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  NEW_SHORT_INTEGER RANGE 1..1  LOOP
+           BUMP(THE_COUNT) ;
+      END LOOP;
+ 
+      FOR  I  IN  SHORT_INTEGER LOOP
+           BUMP(THE_COUNT) ;
+           EXIT WHEN  I = SHORT_INTEGER'FIRST + 1;
+      END LOOP;
+ 
+      FOR  I  IN  NEW_SHORT_INTEGER LOOP
+           BUMP(THE_COUNT) ;
+           EXIT WHEN  I = NEW_SHORT_INTEGER'FIRST + 1;
+      END LOOP;
+ 
+ 
+      IF  COUNT /= 12  THEN
+           FAILED ("WRONG LOOP COUNT");
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C55B07B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b10a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b10a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b10a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b10a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C55B10A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT, IN 'FOR I IN L .. R LOOP', IF EITHER L OR R IS AN
+ --     OVERLOADED ENUMERATION LITERAL, THE OVERLOADING IS CORRECTLY
+ --     RESOLVED AND THE LOOP PARAMETER HAS THE APPROPRIATE TYPE.
+ 
+ -- HISTORY:
+ --     DHH 08/15/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C55B10A IS
+ 
+      TYPE ENUM IS (ALPH, BET, NEITHER);
+ 
+      GLOBAL : ENUM := NEITHER;
+ 
+      TYPE ALPHA IS (A, B, C, D, E);
+      TYPE BETA IS (G, F, E, D, C);
+ 
+      PROCEDURE VAR(DEC : ALPHA) IS
+      BEGIN
+           IF EQUAL(3, 3) THEN
+                GLOBAL := ALPH;
+           END IF;
+      END;
+ 
+      PROCEDURE VAR(DEC : BETA) IS
+      BEGIN
+           IF EQUAL(3, 3) THEN
+                GLOBAL := BET;
+           END IF;
+      END;
+ 
+ BEGIN
+      TEST("C55B10A", "CHECK THAT, IN 'FOR I IN L .. R LOOP', IF " &
+                      "EITHER L OR R IS AN OVERLOADED ENUMERATION " &
+                      "LITERAL, THE OVERLOADING IS CORRECTLY RESOLVED " &
+                      "AND THE LOOP PARAMETER HAS THE APPROPRIATE TYPE");
+ 
+      FOR I IN A .. E LOOP
+           VAR(I);
+ 
+           IF GLOBAL /= ALPH THEN
+                FAILED("WRONG TYPE FOR ALPHA");
+           END IF;
+      END LOOP;
+ 
+      FOR I IN G .. E LOOP
+           VAR(I);
+ 
+           IF GLOBAL /= BET THEN
+                FAILED("WRONG TYPE FOR BETA");
+           END IF;
+      END LOOP;
+ 
+      RESULT;
+ END C55B10A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b11a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b11a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b11a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b11a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C55B11A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT, IN 'FOR IN ST RANGE L .. R LOOP', THE PARAMETER IS OF
+ --     THE TYPE ST'BASE; THAT IS THAT IT CAN BE ASSIGNED TO OTHER
+ --     VARIABLES DECLARED WITH SOME OTHER SUBTYPES OF ST.
+ 
+ -- HISTORY:
+ --     DHH 08/15/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C55B11A IS
+ 
+      TYPE ENUM IS (A, B, C, D, E, F, G, H);
+ 
+      SUBTYPE ONE IS ENUM RANGE A .. H;
+      SUBTYPE TWO IS ENUM RANGE B .. H;
+      SUBTYPE THREE IS ENUM RANGE C .. H;
+      SUBTYPE FOUR IS ENUM RANGE D .. H;
+ 
+      GLOBAL : INTEGER := 0;
+ 
+      VAR_1 : ONE;
+      VAR_2 : TWO;
+      VAR_3 : THREE;
+      VAR_4 : FOUR;
+ 
+      PROCEDURE CHECK_VAR(T : ENUM) IS
+      BEGIN
+           GLOBAL := GLOBAL + 1;
+           CASE T IS
+                WHEN D =>
+                     IF GLOBAL /= IDENT_INT(1) THEN
+                          FAILED("VAR_1 WRONG VALUE");
+                     END IF;
+ 
+                WHEN E =>
+                     IF GLOBAL /= IDENT_INT(2) THEN
+                          FAILED("VAR_2 WRONG VALUE");
+                     END IF;
+ 
+                WHEN F =>
+                     IF GLOBAL /= IDENT_INT(3) THEN
+                          FAILED("VAR_3 WRONG VALUE");
+                     END IF;
+ 
+                WHEN G =>
+                     IF GLOBAL /= IDENT_INT(4) THEN
+                          FAILED("VAR_4 WRONG VALUE");
+                     END IF;
+ 
+                WHEN OTHERS =>
+ 
+                    FAILED("WRONG VALUE TO PROCEDURE");
+           END CASE;
+      END CHECK_VAR;
+ 
+ BEGIN
+      TEST("C55B11A", "CHECK THAT, IN 'FOR IN ST RANGE L .. R LOOP', " &
+                      "THE PARAMETER IS OF THE TYPE ST'BASE; THAT IS " &
+                      "THAT IT CAN BE ASSIGNED TO OTHER VARIABLES " &
+                      "DECLARED WITH SOME OTHER SUBTYPES OF ST");
+ 
+      FOR I IN ONE RANGE D .. G LOOP
+           CASE I IS
+                WHEN D =>
+                     VAR_1 := I;
+                     CHECK_VAR(VAR_1);
+                WHEN E =>
+                     VAR_2 := I;
+                     CHECK_VAR(VAR_2);
+                WHEN F =>
+                     VAR_3 := I;
+                     CHECK_VAR(VAR_3);
+                WHEN G =>
+                     VAR_4 := I;
+                     CHECK_VAR(VAR_4);
+           END CASE;
+      END LOOP;
+ 
+      RESULT;
+ END C55B11A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b11b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b11b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b11b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b11b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C55B11B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE FORM 'FOR I IN ST RANGE L .. R LOOP' IS ACCEPTED
+ --     EVEN IF BOTH L AND R ARE OVERLOADED ENUMERATION LITERALS (SO
+ --     THAT L .. R WOULD BE ILLEGAL WITHOUT ST RANGE).
+ 
+ -- HISTORY:
+ --     DHH 09/07/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C55B11B IS
+      TYPE ST IS (A, B, C, D, E, F, G, H);
+      TYPE SI IS (A, B, C, D, F, E, G, H);
+ 
+      GLOBAL : INTEGER := 0;
+ 
+      PROCEDURE CHECK_VAR(T : ST) IS
+      BEGIN
+           GLOBAL := GLOBAL + 1;
+           CASE T IS
+                WHEN D =>
+                     IF GLOBAL /= IDENT_INT(1) THEN
+                          FAILED("1 WRONG VALUE");
+                     END IF;
+ 
+                WHEN E =>
+                     IF GLOBAL /= IDENT_INT(2) THEN
+                          FAILED("2 WRONG VALUE");
+                     END IF;
+ 
+                WHEN F =>
+                     IF GLOBAL /= IDENT_INT(3) THEN
+                          FAILED("3 WRONG VALUE");
+                     END IF;
+ 
+                WHEN G =>
+                     IF GLOBAL /= IDENT_INT(4) THEN
+                          FAILED("4 WRONG VALUE");
+                     END IF;
+ 
+                WHEN OTHERS =>
+                    FAILED("WRONG VALUE TO PROCEDURE");
+ 
+           END CASE;
+      END CHECK_VAR;
+ 
+      PROCEDURE CHECK_VAR(T : SI) IS
+      BEGIN
+           FAILED("WRONG PROCEDURE CALLED");
+      END CHECK_VAR;
+ 
+ BEGIN
+      TEST ("C55B11B", "CHECK THAT THE 'FORM FOR I IN ST RANGE L .. R " &
+                       "LOOP' IS ACCEPTED EVEN IF BOTH L AND R ARE " &
+                       "OVERLOADED ENUMERATION LITERALS (SO THAT L .. " &
+                       "R WOULD BE ILLEGAL WITHOUT ST RANGE)");
+ 
+      FOR I IN ST RANGE D .. G LOOP
+           CHECK_VAR(I);
+      END LOOP;
+ 
+      RESULT;
+ END C55B11B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b15a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b15a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b15a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b15a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,207 ----
+ -- C55B15A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A DISCRETE_RANGE OF THE FORM  'ST RANGE L..R'
+ --    RAISES AN EXCEPTION BECAUSE  L  OR  R  IS A NON-STATIC
+ --    EXPRESSION WHOSE VALUE IS OUTSIDE  THE RANGE OF VALUES
+ --    ASSOCIATED WITH  ST  (OR BECAUSE  ST'FIRST  IS NON-STATIC
+ --    AND  L  IS STATIC AND LESS THAN  ST'FIRST ; SIMILARLY FOR
+ --     ST'LAST  AND  R ), CONTROL DOES NOT ENTER THE LOOP.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- RM  04/13/81
+ -- SPS 11/01/82
+ -- BHS 07/13/84
+ -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --               AI-00387.
+ -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ -- GJD 11/15/95  REMOVED CASE OF POTENTIALLY STATICALLY INCOMPATIBLE RANGE.
+ 
+ WITH SYSTEM;
+ WITH REPORT;
+ PROCEDURE  C55B15A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C55B15A" , "WHEN  'FOR  I  IN  ST RANGE L..R  LOOP' "     &
+                        "RAISES AN EXCEPTION, CONTROL DOES NOT ENTER " &
+                        "THE BODY OF THE LOOP" );
+ 
+      -------------------------------------------------------------------
+      ----------------- STATIC (SUB)TYPE, DYNAMIC RANGE -----------------
+ 
+      DECLARE
+ 
+           SUBTYPE  ST  IS  INTEGER RANGE 1..4 ;
+ 
+           FIRST   :  CONSTANT INTEGER := IDENT_INT( 1) ;
+           SECOND  :  CONSTANT INTEGER := IDENT_INT( 2) ;
+           THIRD   :  CONSTANT INTEGER := IDENT_INT( 3) ;
+           FOURTH  :  CONSTANT INTEGER := IDENT_INT( 4) ;
+           FIFTH   :  CONSTANT INTEGER := IDENT_INT( 5) ;
+           TENTH   :  CONSTANT INTEGER := IDENT_INT(10) ;
+           ZEROTH  :  CONSTANT INTEGER := IDENT_INT( 0) ;
+ 
+      BEGIN
+ 
+           BEGIN
+ 
+                FOR  I  IN  ST RANGE 3..TENTH  LOOP
+                     FAILED( "EXCEPTION NOT RAISED (I1)" );
+                END LOOP;
+ 
+           EXCEPTION
+ 
+                WHEN  CONSTRAINT_ERROR => NULL ;
+                WHEN  OTHERS           =>
+                     FAILED( "WRONG EXCEPTION RAISED (I1)" );
+ 
+           END ;
+ 
+ 
+           BEGIN
+ 
+                FOR  I  IN  ST RANGE 0..THIRD  LOOP
+                     FAILED( "EXCEPTION NOT RAISED (I2)" );
+                END LOOP;
+ 
+           EXCEPTION
+ 
+                WHEN  CONSTRAINT_ERROR => NULL ;
+                WHEN  OTHERS           =>
+                     FAILED( "WRONG EXCEPTION RAISED (I2)" );
+ 
+           END ;
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+      ----------------- DYNAMIC (SUB)TYPE, STATIC RANGE -----------------
+ 
+      DECLARE
+ 
+           TYPE  ENUM   IS  ( AMINUS , A,B,C,D,E,  F,G,H,I,J );
+ 
+           SUBTYPE  ST  IS  ENUM RANGE ENUM'VAL( IDENT_INT( 1) ) ..
+                                       ENUM'VAL( IDENT_INT( 4) ) ;
+ 
+           FIRST   :  CONSTANT ENUM := A ;
+           SECOND  :  CONSTANT ENUM := B ;
+           THIRD   :  CONSTANT ENUM := C ;
+           FOURTH  :  CONSTANT ENUM := D ;
+           FIFTH   :  CONSTANT ENUM := E ;
+           TENTH   :  CONSTANT ENUM := J ;
+           ZEROTH  :  CONSTANT ENUM := AMINUS ;
+ 
+      BEGIN
+ 
+           BEGIN
+ 
+                FOR  I  IN  ST RANGE C..TENTH  LOOP
+                     FAILED( "EXCEPTION NOT RAISED (E1)" );
+                END LOOP;
+ 
+           EXCEPTION
+ 
+                WHEN  CONSTRAINT_ERROR => NULL ;
+                WHEN  OTHERS           =>
+                     FAILED( "WRONG EXCEPTION RAISED (E1)" );
+ 
+           END ;
+ 
+ 
+           BEGIN
+ 
+                FOR  I  IN  ST RANGE AMINUS..THIRD  LOOP
+                     FAILED( "EXCEPTION NOT RAISED (E2)" );
+                END LOOP;
+ 
+           EXCEPTION
+ 
+                WHEN  CONSTRAINT_ERROR => NULL ;
+                WHEN  OTHERS           =>
+                     FAILED( "WRONG EXCEPTION RAISED (E2)" );
+ 
+           END ;
+ 
+      END ;
+ 
+ 
+      DECLARE
+ 
+           SUBTYPE  ST  IS  CHARACTER RANGE IDENT_CHAR( 'A' ) ..
+                                            IDENT_CHAR( 'D' ) ;
+ 
+           FIRST   :  CONSTANT CHARACTER := 'A' ;
+           SECOND  :  CONSTANT CHARACTER := 'B' ;
+           THIRD   :  CONSTANT CHARACTER := 'C' ;
+           FOURTH  :  CONSTANT CHARACTER := 'D' ;
+           FIFTH   :  CONSTANT CHARACTER := 'E' ;
+           TENTH   :  CONSTANT CHARACTER := 'J' ;
+           ZEROTH  :  CONSTANT CHARACTER := '0' ;--ZERO; PRECEDES LETTERS
+ 
+      BEGIN
+ 
+           BEGIN
+ 
+                FOR  I  IN  ST RANGE 'C'..TENTH  LOOP
+                     FAILED( "EXCEPTION NOT RAISED (C1)" );
+                END LOOP;
+ 
+           EXCEPTION
+ 
+                WHEN  CONSTRAINT_ERROR => NULL ;
+                WHEN  OTHERS           =>
+                     FAILED( "WRONG EXCEPTION RAISED (C1)" );
+ 
+           END ;
+ 
+ 
+           BEGIN
+ 
+                FOR  I  IN  ST RANGE '0'..THIRD  LOOP -- ZERO..'C'
+                     FAILED( "EXCEPTION NOT RAISED (C2)" );
+                END LOOP;
+ 
+           EXCEPTION
+ 
+                WHEN  CONSTRAINT_ERROR => NULL ;
+                WHEN  OTHERS           =>
+                     FAILED( "WRONG EXCEPTION RAISED (C2)" );
+ 
+           END ;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C55B15A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b16a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b16a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55b16a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55b16a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C55B16A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THE PROCESSING OF ITERATIONS OVER AN ENUMERATION TYPE
+ --     WHOSE (USER-DEFINED) REPRESENTATION CONSISTS OF A NON-CONTIGUOUS
+ --     SET OF INTEGERS.
+ --
+ --     (INHERITANCE (AND SUBSEQUENT OVERRIDING) OF REPRESENTATION
+ --     SPECIFICATIONS WILL BE TESTED ELSEWHERE.)
+ 
+ -- HISTORY:
+ --     RM  08/06/82  CREATED ORIGINAL TEST.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE  C55B16A  IS
+ 
+      I1  :  INTEGER := 0 ;
+ 
+      TYPE  ENUM  IS  ( 'A' , 'B' , 'D' , 'C' , Z , X , D , A , C );
+      FOR   ENUM  USE ( -15 , -14 , -11 , -10 ,
+                          1 , 3 , 4 , 8 , 9 );
+ 
+ BEGIN
+ 
+      TEST ("C55B16A" , "TEST LOOPING OVER ENUMERATION TYPES WITH"  &
+                        " NON-CONTIGUOUS REPRESENTATION"            );
+ 
+      I1 := IDENT_INT(0) ;
+ 
+      FOR  X  IN ENUM LOOP
+ 
+           IF  X /= ENUM'VAL(I1)  OR
+               ENUM'POS(X) /= I1                               -- 0..8
+           THEN
+                FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY (1)" );
+           END IF;
+ 
+           I1 := I1 + IDENT_INT(1) ;
+ 
+      END LOOP;
+ 
+ 
+      I1 := IDENT_INT(6) ;
+ 
+      FOR  X  IN ENUM RANGE D .. C LOOP
+ 
+           IF  X /= ENUM'VAL(I1)  OR
+               ENUM'POS(X) /= I1                               -- 6..8
+           THEN
+                FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY (2)" );
+           END IF;
+ 
+           I1 := I1 + IDENT_INT(1) ;
+ 
+      END LOOP;
+ 
+ 
+      I1 := IDENT_INT(4) ;
+ 
+      FOR  X  IN REVERSE 'A'..ENUM'(Z) LOOP
+ 
+           IF  X /= ENUM'VAL(I1)  OR
+               ENUM'POS(X) /= I1                               -- 4..0
+           THEN
+                FAILED ( "LOOP_PARAMETER DESCENDING INCORRECTLY (3)" );
+           END IF;
+ 
+           I1 := I1 - IDENT_INT(1) ;
+ 
+      END LOOP;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C55B16A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55c02a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55c02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55c02a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55c02a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,49 ----
+ -- C55C02A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHILE LOOPS WITH FALSE CONDITIONS ARE NEVER EXECUTED.
+ 
+ -- DAT 1/29/81
+ -- DLD 8/06/82
+ 
+ WITH REPORT;
+ PROCEDURE C55C02A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C55C02A", "INITIAL FALSE CONDITIONS IN WHILE LOOPS");
+ 
+      WHILE FALSE LOOP
+           FAILED ("STATIC FALSE WHILE LOOP ENTERED");
+           EXIT;
+      END LOOP;
+ 
+      WHILE IDENT_BOOL (FALSE) LOOP
+           FAILED ("DYNAMIC FALSE WHILE LOOP ENTERED");
+           EXIT;
+      END LOOP;
+ 
+      RESULT;
+ END C55C02A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55c02b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55c02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c55c02b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c55c02b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- C55C02B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE WHILE CONDITION IS EVALUATED EACH TIME.
+ 
+ -- DAT 1/29/81
+ -- SPS 3/2/83
+ 
+ WITH REPORT;
+ PROCEDURE C55C02B IS
+ 
+      USE REPORT;
+ 
+      I : INTEGER := 0;
+ 
+      FT : ARRAY (FALSE .. TRUE) OF BOOLEAN 
+           := (IDENT_BOOL (FALSE), IDENT_BOOL (TRUE));
+ 
+ BEGIN
+      TEST ("C55C02B", "WHILE CONDITION IS EVALUATED EACH TIME THROUGH");
+ 
+      WHILE I /= 10 LOOP
+           I := I + 1;
+      END LOOP;
+      IF I /= 10 THEN
+           FAILED ("BAD LOOP FLOW - OPTIMIZABLE CONDITION");
+      END IF;
+ 
+      I := 10;
+      WHILE FT (IDENT_BOOL (I /= 14)) LOOP
+           I := I + 1;
+      END LOOP;
+      IF I /= 14 THEN
+           FAILED ("BAD LOOP FLOW - DYNAMIC CONDITION");
+      END IF;
+ 
+      RESULT;
+ END C55C02B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c56002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c56002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c56002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c56002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- C56002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT BLOCKS CAN HAVE DECLARATIVE PARTS AND THAT
+ --    THE EFFECT OF THESE DECLARATIONS IS LIMITED TO THE BLOCKS
+ --    IN WHICH THEY OCCUR.
+ 
+ 
+ -- RM 04/16/81
+ -- SPS 3/4/83
+ 
+ WITH REPORT;
+ PROCEDURE  C56002A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C56002A" , "BLOCKS CAN HAVE DECLARATIVE PARTS AND"         &
+                        " THE EFFECT OF THESE DECLARATIONS IS LIMITED"  &
+                        " TO THE BLOCKS IN WHICH THEY OCCUR" )          ;
+ 
+      DECLARE
+ 
+           FIRST   :  CONSTANT INTEGER := IDENT_INT( 1) ;
+           SECOND  :  CONSTANT INTEGER := IDENT_INT( 2) ;
+           THIRD   :  CONSTANT INTEGER := IDENT_INT( 3) ;
+           FOURTH  :  CONSTANT INTEGER := IDENT_INT( 4) ;
+           FIFTH   :  CONSTANT INTEGER := IDENT_INT( 5) ;
+           TENTH   :  CONSTANT INTEGER := IDENT_INT(10) ;
+           ZEROTH  :  CONSTANT INTEGER := IDENT_INT( 0) ;
+ 
+      BEGIN
+ 
+           IF   FIRST   /= 1  OR
+                SECOND  /= 2  OR
+                THIRD   /= 3  OR
+                FOURTH  /= 4  OR
+                FIFTH   /= 5  OR
+                TENTH   /=10  OR
+                ZEROTH  /= 0
+           THEN
+                FAILED( "WRONG VALUES  -  1" );
+           END IF;
+ 
+           DECLARE
+ 
+                TYPE  ENUM   IS  ( AMINUS , A,B,C,D,E,  F,G,H,I,J );
+ 
+                FIRST   :  CONSTANT ENUM := A ;
+                SECOND  :  CONSTANT ENUM := B ;
+                THIRD   :  CONSTANT ENUM := C ;
+                FOURTH  :  CONSTANT ENUM := D ;
+                FIFTH   :  CONSTANT ENUM := E ;
+                TENTH   :  CONSTANT ENUM := J ;
+                ZEROTH  :  CONSTANT ENUM := AMINUS ;
+ 
+           BEGIN
+ 
+                IF   FIRST   /= ENUM'VAL( IDENT_INT( 1 ) )  OR
+                     SECOND  /= ENUM'VAL( IDENT_INT( 2 ) )  OR
+                     THIRD   /= ENUM'VAL( IDENT_INT( 3 ) )  OR
+                     FOURTH  /= ENUM'VAL( IDENT_INT( 4 ) )  OR
+                     FIFTH   /= ENUM'VAL( IDENT_INT( 5 ) )  OR
+                     TENTH   /= ENUM'VAL( IDENT_INT(10 ) )  OR
+                     ZEROTH  /= ENUM'VAL( IDENT_INT( 0 ) )
+                THEN
+                     FAILED( "WRONG VALUES  -  2" );
+                END IF;
+ 
+           END ;
+ 
+           IF   FIRST   /= 1  OR
+                SECOND  /= 2  OR
+                THIRD   /= 3  OR
+                FOURTH  /= 4  OR
+                FIFTH   /= 5  OR
+                TENTH   /=10  OR
+                ZEROTH  /= 0
+           THEN
+                FAILED( "WRONG VALUES  -  3" );
+           END IF;
+ 
+           DECLARE
+ 
+                FIRST   :  CONSTANT CHARACTER := 'A' ;
+                SECOND  :  CONSTANT CHARACTER := 'B' ;
+                THIRD   :  CONSTANT CHARACTER := 'C' ;
+                FOURTH  :  CONSTANT CHARACTER := 'D' ;
+                FIFTH   :  CONSTANT CHARACTER := 'E' ;
+                TENTH   :  CONSTANT CHARACTER := 'J' ;
+                ZEROTH  :  CONSTANT CHARACTER := '0' ;--ZERO < ANY LETTER
+ 
+           BEGIN
+ 
+                IF   FIRST   /= IDENT_CHAR( 'A' )  OR
+                     SECOND  /= IDENT_CHAR( 'B' )  OR
+                     THIRD   /= IDENT_CHAR( 'C' )  OR
+                     FOURTH  /= IDENT_CHAR( 'D' )  OR
+                     FIFTH   /= IDENT_CHAR( 'E' )  OR
+                     TENTH   /= IDENT_CHAR( 'J' )  OR
+                     ZEROTH  /= IDENT_CHAR( '0' )
+                THEN
+                     FAILED( "WRONG VALUES  -  4" );
+                END IF;
+ 
+           END ;
+ 
+           IF   FIRST   /= 1  OR
+                SECOND  /= 2  OR
+                THIRD   /= 3  OR
+                FOURTH  /= 4  OR
+                FIFTH   /= 5  OR
+                TENTH   /=10  OR
+                ZEROTH  /= 0
+           THEN
+                FAILED( "WRONG VALUES  -  5" );
+           END IF;
+ 
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C56002A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c57003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c57003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c57003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c57003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,334 ----
+ -- C57003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE EXIT STATEMENT IS EVALUATED EACH TIME THROUGH A LOOP,
+ --    AND THAT IT IS EVALUATED CORRECTLY WHETHER POSITIONED AT THE
+ --    BEGINNING, MIDDLE, OR END OF THE LOOP.
+ 
+ 
+ 
+ -- EACH TEST IS A LOOP ON  J  WHERE THE EXIT CONDITIONS ARE TO EVALUATE
+ --    TO  'FALSE'  A CERTAIN NUMBER OF TIMES UNTIL, AT THE APPROPRIATE
+ --    TIME, ONE OF THEM EVALUATES TO  'TRUE'  AND CAUSES THE LOOP TO BE
+ --    EXITED.
+ --
+ --
+ --    THE TEST IS PERFORMED 30 TIMES FOR EACH OF THE FIRST TWO
+ --    DATA TYPES CONSIDERED ('INTEGER', USER-DEFINED ENUMERATION)
+ --    AND 26 TIMES FOR 'CHARACTER' (THUS 86 TIMES ALTOGETHER).
+ --
+ --
+ --    EACH DATA TYPE HAS ITS OWN SEPARATE SECTION OF CODE.  ALL SECTIONS
+ --    FOLLOW THE SAME TESTING ALGORITHM (MUTATIS MUTANDIS).  THE CALCU-
+ --    LATIONS WHICH KEEP TRACK OF THE FLOW OF CONTROL ARE ALL DONE IN
+ --    INTEGER ARITHMETIC.  THERE ARE THREE DATA TYPES, THUS THREE
+ --    SECTIONS.
+ --
+ --
+ --    FOR EACH DATA TYPE, THE 30 TESTS ARE DIVIDED INTO 3 "SEGMENTS"
+ --
+ --               << NOTE:  THE NUMBER OF SEGMENTS IS WRITTEN  " 3 "    ,
+ --                         THE NUMBER OF SECTIONS IS WRITTEN  "THREE" >>
+ --
+ --    (OF 10 TESTS EACH, EXCEPT 10,10,6 FOR 'CHARACTER'), NUMBERED
+ --     0 , 1 , 2  AND CORRESPONDING TO THE 3 SIGNIFICANTLY DIFFERENT
+ --    POSITIONS OF AN EXIT STATEMENT WITH RESPECT TO THE LOOP IT IS IN
+ --    ( "AT THE VERY TOP" , "AT THE VERY BOTTOM" , "ANYWHERE IN BETWEEN"
+ --    ).  AT THE BEGINNING OF EACH TEST, THE VARIABLE  WHICH_SEGMENT
+ --    IS UPDATED TO CONTAIN THE NEW VALUE OF THIS IDENTIFYING NUMBER
+ --    (FOR THE TEST ABOUT TO BEGIN):
+ --
+ --             EXIT AT THE TOP      ........   WHICH_SEGMENT = 0
+ --             EXIT FROM THE MIDDLE ........   WHICH_SEGMENT = 1
+ --             EXIT AT THE BOTTOM   ........   WHICH_SEGMENT = 2   .
+ --
+ --
+ --    WITHIN EACH SECTION, THE TESTS ARE NUMBERED  FROM  1  TO  30
+ --    (26 FOR 'CHARACTER').  THIS NUMBER IS STORED IN THE INTEGER
+ --    VARIABLE  INT_I  (EQUAL TO THE CURRENT VALUE OF THE OUTER-LOOP
+ --    INDEX WHEN THAT INDEX IS OF INTEGER TYPE), WHOSE APPROPRIATE VALUE
+ --    FOR EACH TEST IS SET AT THE BEGINNING OF THE TEST.
+ --
+ --
+ --    AS PART OF THE EVALUATION PROCESS, THE PROGRAM COMPUTES FOR EACH
+ --    TEST (I.E.  FOR EACH VALUE OF  I , OR OF  INT_I ) THE APPROPRIATE
+ --    NUMBER OF INNER-LOOP ITERATIONS REQUIRED BEFORE EXIT; THIS IS
+ --    THE EXPECTED VALUE OF  J  (EXPRESSED AS AN INTEGER IN THE RANGE
+ --     1..10 ) AND STORES IT IN  EXPECTED_J .  FOR EACH OF THE THREE
+ --    SECTIONS, THE TIME SEQUENCE OF THESE 30 VALUES IS
+ --
+ --             1   2   3   4   5   6   7   8   9  10     << SEGMENT 1 >>
+ --             6   6   7   7   8   8   9   9  10  10     << SEGMENT 2 >>
+ --             7   8   8   8   9   9   9  10  10  10     << SEGMENT 3 >>
+ --
+ --    (EACH SECTION GETS ALL 3 ROWS, NOT ONE ROW PER SECTION;
+ --    FOR 'CHARACTER', WHERE ONLY 26 VALUES ARE REQUIRED, THE LAST 4
+ --    VALUES ARE OMITTED).  THIS NUMBER IS COMPARED WITH THE ACTUAL
+ --    VALUE OF  J  (ACTUAL NUMBER OF INNER-LOOP ITERATIONS BEFORE THE
+ --    EXECUTION OF THE EXIT STATEMENT) AS SAVED JUST BEFORE THE EXIT
+ --    FROM THE LOOP (AGAIN IN THE FORM OF AN INTEGER IN THE RANGE
+ --     1..30 , IRRESPECTIVE OF THE DATA TYPE BEING TESTED),  I F
+ --    SUCH SAVED VALUE IS AVAILABLE.
+ --
+ --
+ --    THE ACTUAL VALUE OF INNER-LOOP ITERATIONS (AS SAVED IMMEDIATELY
+ --    BEFORE THE EXIT, AS OPPOSED TO A VALUE LEFT OVER FROM SOME
+ --    PREVIOUS ITERATION) IS AVAILABLE ONLY IF  WHICH_SEGMENT /= 0 ,
+ --    AND IS THEN STORED IN  SAVE_J .
+ --
+ --
+ --    FOR THE CASE  WHICH_SEGMENT = 0 , THE ITERATIONS ARE COUNTED IN
+ --    THE VARIABLE  COUNT , WHOSE VALUE AT THE COMPLETION OF THE
+ --    I-TH TEST ( I IN 1..10 ) MUST BE EQUAL TO  EXPECTED_J - 1 ,
+ --    AND THUS TO  I - 1  (METHODOLOGICALLY AS WELL AS COMPUTATIONALLY
+ --    THIS IS NO DIFFERENT FROM USING THE MOST RECENT VALUE OF  SAVE_J
+ --    WHEN A CURRENT ONE CANNOT BE OBTAINED).  AFTER BEING INCREMENTED
+ --    BY  1 ,  COUNT  IS CHECKED AGAINST  EXPECTED_J .
+ --
+ --
+ --    THIS CONCLUDES THE DESCRIPTION OF THE CASE  WHICH_SEGMENT = 0 ,
+ --    AND THUS OF THE ALGORITHM.  THE ONLY REASON FOR SPLITTING THE
+ --    CASE  WHICH_SEGMENT /= 0  INTO TWO IS THE DESIRE TO PROVIDE FOR
+ --    DISTINCT MESSAGES.
+ 
+ 
+ 
+ -- RM 04/23/81
+ -- SPS 3/7/83
+ 
+ WITH REPORT;
+ PROCEDURE  C57003A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C57003A" , "TEST THAT THE EXIT STATEMENT IS EVALUATED" &
+                        " EACH TIME THROUGH THE LOOP"               );
+ 
+      DECLARE
+ 
+           WHICH_SEGMENT  :  INTEGER RANGE 0..2   ;   -- BOUNDS ARE TIGHT
+           SAVE_J         :  INTEGER RANGE 1..10  ;
+           EXPECTED_J     :  INTEGER RANGE 1..10  ;
+           COUNT          :  INTEGER RANGE 0..100     := 0 ;
+           INT_I          :  INTEGER RANGE 1..30  ;
+ 
+           TYPE  ENUM  IS    ( CHANGE_THE_ORIGIN_FROM_0_TO_1 ,
+ 
+                A1 , A2 , A3 , A4 , A5 , A6 , A7 , A8 , A9 , A10 ,
+                A11, A12, A13, A14, A15, A16, A17, A18, A19, A20 ,
+                A21, A22, A23, A24, A25, A26, A27, A28, A29, A30 );
+ 
+      BEGIN
+ 
+ 
+           --------------------------------------------------------------
+           -----------------------  INTEGER  ----------------------------
+ 
+ 
+           FOR  I  IN  INTEGER RANGE 1..30  LOOP
+ 
+ 
+                WHICH_SEGMENT  :=  ( I - 1 ) / 10        ;
+                EXPECTED_J     :=  ( I + WHICH_SEGMENT ) /
+                                   ( WHICH_SEGMENT + 1 ) ;
+ 
+                COUNT  :=  0 ;
+ 
+ 
+                FOR  J  IN  INTEGER RANGE 1..10  LOOP
+ 
+                     --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
+ 
+                     EXIT WHEN  WHICH_SEGMENT = 0  AND
+                                1*J >= I ;--COUNT+:=1 ON NXT LINE INSTEAD
+                     COUNT := COUNT + 1 ;
+ 
+                     NULL ;
+                     NULL ;
+                     NULL ;
+                     SAVE_J := J ;
+                     EXIT WHEN  WHICH_SEGMENT = 1  AND
+                                2*J >= I ;
+ 
+                     NULL ;
+                     NULL ;
+                     NULL ;
+                     SAVE_J := J ;
+                     EXIT WHEN  WHICH_SEGMENT = 2  AND
+                                3*J >= I ;
+ 
+                END LOOP;
+ 
+ 
+                COUNT          :=  COUNT + 1             ;  -- SEE HEADER
+ 
+                CASE  WHICH_SEGMENT  IS
+                     WHEN  0  =>
+                          IF  COUNT  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT; INT, EXIT AT TOP" );
+                          END IF;
+                     WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
+                          IF  SAVE_J  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT; I,EXIT AT MIDDLE" );
+                          END IF;
+                     WHEN  2  =>
+                          IF  SAVE_J  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT; I,EXIT AT BOTTOM" );
+                          END IF;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+ 
+           --------------------------------------------------------------
+           ----------------------  CHARACTER  ---------------------------
+ 
+ 
+           FOR  I  IN  CHARACTER RANGE 'A'..'Z'  LOOP
+ 
+                INT_I  := CHARACTER'POS(I) - CHARACTER'POS('A') + 1;
+ 
+                WHICH_SEGMENT  :=  ( INT_I - 1 ) / 10        ;
+                EXPECTED_J     :=  ( INT_I + WHICH_SEGMENT ) /
+                                   ( WHICH_SEGMENT + 1 )     ;
+ 
+                COUNT  :=  0 ;
+ 
+ 
+                FOR  J  IN  CHARACTER RANGE 'A'..'J'  LOOP
+ 
+                     --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
+ 
+                     EXIT WHEN  WHICH_SEGMENT = 0  AND
+                                J >= I ; -- COUNT+:=1 ON NXT LINE INSTEAD
+                     COUNT := COUNT + 1 ;
+ 
+                     NULL ;
+                     NULL ;
+                     NULL ;
+                     SAVE_J := CHARACTER'POS(J) - CHARACTER'POS('A') + 1;
+                     EXIT WHEN  WHICH_SEGMENT = 1  AND
+                                2 * SAVE_J >= INT_I ;
+ 
+                     NULL ;
+                     NULL ;
+                     NULL ;
+                     EXIT WHEN  WHICH_SEGMENT = 2  AND
+                                3 * SAVE_J >= INT_I ;
+ 
+                END LOOP;
+ 
+ 
+                COUNT          :=    COUNT + 1               ;
+ 
+                CASE  WHICH_SEGMENT  IS
+                     WHEN  0  =>
+                          IF  COUNT  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT;CHAR, EXIT AT TOP" );
+                          END IF;
+                     WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
+                          IF  SAVE_J  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT; C,EXIT AT MIDDLE" );
+                          END IF;
+                     WHEN  2  =>
+                          IF  SAVE_J  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT; C,EXIT AT BOTTOM" );
+                          END IF;
+                END CASE;
+ 
+           END LOOP;
+ 
+ 
+ 
+           --------------------------------------------------------------
+           ---------------------  ENUMERATION  --------------------------
+ 
+ 
+           FOR  I  IN  ENUM RANGE A1..A30  LOOP
+ 
+ 
+                INT_I          :=    ENUM'POS(I) ;
+ 
+                WHICH_SEGMENT  :=  ( INT_I - 1 ) / 10        ;
+                EXPECTED_J     :=  ( INT_I + WHICH_SEGMENT ) /
+                                   ( WHICH_SEGMENT + 1 )     ;
+ 
+                COUNT  :=  0 ;
+ 
+ 
+                FOR  J  IN  ENUM RANGE A1..A10  LOOP
+ 
+                     --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
+ 
+                     EXIT WHEN  WHICH_SEGMENT = 0  AND
+                                J >= I ; -- COUNT+:=1 ON NXT LINE INSTEAD
+                     COUNT := COUNT + 1 ;
+ 
+                     NULL ;
+                     NULL ;
+                     NULL ;
+                     SAVE_J := ENUM'POS(J) ;
+                     EXIT WHEN  WHICH_SEGMENT = 1  AND
+                                2 * SAVE_J >= INT_I ;
+ 
+                     NULL ;
+                     NULL ;
+                     NULL ;
+                     EXIT WHEN  WHICH_SEGMENT = 2  AND
+                                3 * SAVE_J >= INT_I ;
+ 
+                END LOOP;
+ 
+ 
+                COUNT          :=    COUNT + 1               ;
+ 
+                CASE  WHICH_SEGMENT  IS
+                     WHEN  0  =>
+                          IF  COUNT  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT;ENUM, EXIT AT TOP" );
+                          END IF;
+                     WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
+                          IF  SAVE_J  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT; E,EXIT AT MIDDLE" );
+                          END IF;
+                     WHEN  2  =>
+                          IF  SAVE_J  /=  EXPECTED_J  THEN
+                               FAILED( "WRONG COUNT; E,EXIT AT BOTTOM" );
+                          END IF;
+                END CASE;
+ 
+           END LOOP;
+ 
+           --------------------------------------------------------------
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C57003A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c57004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c57004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c57004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c57004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,160 ----
+ -- C57004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXIT STATEMENT WITH A LOOP NAME TERMINATES EXECUTION
+ --    OF THE LOOP STATEMENT WHOSE NAME IT MENTIONS, AND OF ALL OTHER
+ --    LOOP STATEMENTS (IF ANY) INTERIOR TO THE FIRST LOOP AND ENCLOSING
+ --    THE EXIT STATEMENT.
+ 
+ -- CASE 1 :  UNCONDITIONAL EXITS.
+ 
+ 
+ -- RM 04/24/81
+ -- SPS 3/7/83
+ 
+ WITH REPORT;
+ PROCEDURE  C57004A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C57004A" , "CHECK THAT A NAMING EXIT STATEMENT TERMINATES" &
+                        " EXECUTION OF THE NAMED LOOP AND OF ALL LOOPS" &
+                        " SITUATED IN-BETWEEN"                         );
+ 
+      DECLARE
+ 
+           COUNT : INTEGER     := 0   ;
+ 
+      BEGIN
+ 
+           OUTERMOST :
+           FOR  X  IN  INTEGER RANGE 1..2  LOOP
+ 
+                FOR  Y  IN  INTEGER RANGE 1..2  LOOP
+ 
+                     COMMENT( "BEFORE 1" );
+ 
+                     LOOP1 :
+                     FOR  I  IN  1..10  LOOP
+                          COMMENT( "INSIDE 1" );
+                          EXIT  LOOP1 ;
+                          FAILED( "EXIT NOT OBEYED (1)" );
+                          FOR  J  IN  1..10  LOOP
+                               FAILED( "OUTER EXIT NOT OBEYED (1)" );
+                               EXIT ;
+                               FAILED( "BOTH EXITS IGNORED (1)" );
+                          END LOOP;
+                     END LOOP  LOOP1 ;
+ 
+ 
+                     COMMENT( "BEFORE 2" );
+                     COUNT := COUNT + 1 ;
+ 
+                     LOOP2 :
+                     FOR  A  IN  1..1  LOOP
+                          FOR  B  IN  1..1  LOOP
+ 
+                               FOR  I  IN  CHARACTER  LOOP
+                                    COMMENT( "INSIDE 2" );
+                                    EXIT  LOOP2 ;
+                                    FAILED( "EXIT NOT OBEYED (2)" );
+                                    FOR  J  IN  BOOLEAN  LOOP
+                                         FAILED( "OUTER EXIT NOT " &
+                                                 "OBEYED (2)");
+                                         EXIT ;
+                                         FAILED( "BOTH EXITS IGNORED " &
+                                                 "(2)");
+                                    END LOOP;
+                               END LOOP;
+ 
+                          END LOOP;
+                     END LOOP  LOOP2 ;
+ 
+ 
+                     COMMENT( "BEFORE 3" );
+                     COUNT := COUNT + 1 ;
+ 
+                     LOOP3 :
+                     FOR  A  IN  1..1  LOOP
+                          FOR  B  IN  1..1  LOOP
+ 
+                               FOR  I  IN  BOOLEAN  LOOP
+                                    COMMENT( "INSIDE 3" );
+                                    BEGIN
+                                         EXIT  LOOP3 ;
+                                         FAILED( "EXIT NOT OBEYED (3)" );
+                                    END ;
+                                    FAILED( "EXIT NOT OBEYED (3BIS)" );
+                               END LOOP;
+ 
+                          END LOOP;
+                     END LOOP  LOOP3 ;
+ 
+ 
+                     COMMENT( "BEFORE 4" );
+                     COUNT := COUNT + 1 ;
+ 
+                     LOOP4 :
+                     FOR  A  IN  1..1  LOOP
+                          FOR  B  IN  1..1  LOOP
+ 
+ 
+                               FOR  I  IN  INTEGER RANGE 1..10  LOOP
+                                    COMMENT( "INSIDE 4" );
+                                    CASE  A  IS
+                                         WHEN  1  =>
+                                              EXIT  LOOP4 ;
+                                              FAILED("EXIT NOT OBEYED " &
+                                                     "(4)" );
+                                    END CASE;
+                                    FAILED( "EXIT NOT OBEYED (4BIS)" );
+                               END LOOP;
+ 
+                          END LOOP;
+                     END LOOP  LOOP4 ;
+ 
+ 
+                     COMMENT( "AFTER 4" );
+                     COUNT := COUNT + 1 ;
+                     EXIT  OUTERMOST ;
+ 
+                END LOOP;
+ 
+                FAILED( "MISSED FINAL EXIT" );
+ 
+           END LOOP  OUTERMOST ;
+ 
+ 
+           IF  COUNT /= 4  THEN
+                FAILED( "WRONG FLOW OF CONTROL" );
+           END IF;
+ 
+      END ;
+ 
+      RESULT ;
+ 
+ 
+ END  C57004A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c57004b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c57004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c57004b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c57004b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,162 ----
+ -- C57004B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXIT STATEMENT WITH A LOOP NAME TERMINATES EXECUTION
+ --    OF THE LOOP STATEMENT WHOSE NAME IT MENTIONS, AND OF ALL OTHER
+ --    LOOP STATEMENTS (IF ANY) INTERIOR TO THE FIRST LOOP AND ENCLOSING
+ --    THE EXIT STATEMENT.
+ 
+ -- CASE 2 :  CONDITIONAL EXITS.
+ 
+ 
+ -- RM 04/27/81
+ -- SPS 3/7/83
+ 
+ WITH REPORT;
+ PROCEDURE  C57004B  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C57004B" , "CHECK THAT A NAMING EXIT STATEMENT TERMINATES" &
+                        " EXECUTION OF THE NAMED LOOP AND OF ALL LOOPS" &
+                        " SITUATED IN-BETWEEN"                         );
+ 
+      DECLARE
+ 
+           COUNT : INTEGER     := 0   ;
+ 
+      BEGIN
+ 
+           OUTERMOST :
+           FOR  X  IN  INTEGER RANGE 1..2  LOOP
+ 
+                FOR  Y  IN  INTEGER RANGE 1..2  LOOP
+ 
+                     COMMENT( "BEFORE 1" );
+ 
+                     LOOP1 :
+                     FOR  I  IN  1..10  LOOP
+                          COMMENT( "INSIDE 1" );
+                          EXIT  LOOP1  WHEN  EQUAL(1,1) ;
+                          FAILED( "EXIT NOT OBEYED (1)" );
+                          FOR  J  IN  1..10  LOOP
+                               FAILED( "OUTER EXIT NOT OBEYED (1)" );
+                               EXIT  WHEN EQUAL(1,1) ;
+                               FAILED( "BOTH EXITS IGNORED (1)" );
+                          END LOOP;
+                     END LOOP  LOOP1 ;
+ 
+ 
+                     COMMENT( "BEFORE 2" );
+                     COUNT := COUNT + 1 ;
+ 
+                     LOOP2 :
+                     FOR  A  IN  1..1  LOOP
+                          FOR  B  IN  1..1  LOOP
+ 
+                               FOR  I  IN  CHARACTER  LOOP
+                                    COMMENT( "INSIDE 2" );
+                                    EXIT  LOOP2  WHEN  EQUAL(1,1) ;
+                                    FAILED( "EXIT NOT OBEYED (2)" );
+                                    FOR  J  IN  BOOLEAN  LOOP
+                                         FAILED( "OUTER EXIT NOT " &
+                                                 "OBEYED (2)");
+                                         EXIT  WHEN EQUAL(1,1) ;
+                                         FAILED( "BOTH EXITS IGNORED " &
+                                                 "(2)");
+                                    END LOOP;
+                               END LOOP;
+ 
+                          END LOOP;
+                     END LOOP  LOOP2 ;
+ 
+ 
+                     COMMENT( "BEFORE 3" );
+                     COUNT := COUNT + 1 ;
+ 
+                     LOOP3 :
+                     FOR  A  IN  1..1  LOOP
+                          FOR  B  IN  1..1  LOOP
+ 
+                               FOR  I  IN  BOOLEAN  LOOP
+                                    COMMENT( "INSIDE 3" );
+                                    BEGIN
+                                         EXIT  LOOP3  WHEN  EQUAL(1,1) ;
+                                         FAILED( "EXIT NOT OBEYED (3)" );
+                                    END ;
+                                    FAILED( "EXIT NOT OBEYED (3BIS)" );
+                               END LOOP;
+ 
+                          END LOOP;
+                     END LOOP  LOOP3 ;
+ 
+ 
+                     COMMENT( "BEFORE 4" );
+                     COUNT := COUNT + 1 ;
+ 
+                     LOOP4 :
+                     FOR  A  IN  1..1  LOOP
+                          FOR  B  IN  1..1  LOOP
+ 
+ 
+                               FOR  I  IN  INTEGER RANGE 1..10  LOOP
+                                    COMMENT( "INSIDE 4" );
+                                    CASE  A  IS
+                                         WHEN  1  =>
+                                              EXIT LOOP4 WHEN EQUAL(1,1);
+                                              FAILED("EXIT NOT OBEYED " &
+                                                     "(4)" );
+                                    END CASE;
+                                    FAILED( "EXIT NOT OBEYED (4BIS)" );
+                               END LOOP;
+ 
+                          END LOOP;
+                     END LOOP  LOOP4 ;
+ 
+ 
+                     COMMENT( "AFTER 4" );
+                     COUNT := COUNT + 1 ;
+                     EXIT  OUTERMOST ;
+ 
+                END LOOP;
+ 
+                FAILED( "MISSED FINAL EXIT" );
+ 
+           END LOOP  OUTERMOST ;
+ 
+ 
+           IF  COUNT /= 4  THEN
+                FAILED( "WRONG FLOW OF CONTROL" );
+           END IF;
+ 
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C57004B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58004c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58004c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58004c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C58004C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE RETURN STATEMENT WORKS FOR RECURSIVE SUBPROGRAMS,
+ --    BOTH FUNCTIONS AND PROCEDURES.
+ 
+ -- DCB 2/8/80
+ -- SPS 3/7/83
+ -- JBG 5/17/83
+ 
+ WITH REPORT;
+ PROCEDURE C58004C IS
+ 
+      USE REPORT;
+ 
+      I1, I2 : INTEGER := 0;   -- INITIAL VALUE IS IMMATERIAL
+ 
+      PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER) IS
+ 
+      BEGIN
+           IF IP1 = 1 THEN
+                IP2 := 1;
+                RETURN;
+           ELSE FACTORIALP (IP1 - 1, IP2);
+                IP2 := IP1 * IP2;
+                RETURN;
+           END IF;
+ 
+           IP2 := 0;
+ 
+      END FACTORIALP;
+ 
+      FUNCTION FACTORIALF (IF1 : INTEGER) RETURN INTEGER IS
+ 
+      BEGIN
+           IF IF1 = 1 THEN RETURN (1);
+           END IF;
+ 
+           RETURN (IF1 * FACTORIALF(IF1 - 1) );
+ 
+      END FACTORIALF;
+ 
+ BEGIN
+      TEST ("C58004C", "CHECK THAT THE RETURN STATEMENT WORKS FOR" &
+            " RECURSIVE FUNCTIONS AND PROCEDURES");
+ 
+      I1 := FACTORIALF (5);
+ 
+      IF I1 /= 120 THEN
+            FAILED ("RETURN STATEMENT IN RECURSIVE FUNCTION NOT " &
+                    "WORKING");
+      END IF;
+ 
+      FACTORIALP (5, I2);
+ 
+      IF I2 = 0 THEN
+           FAILED ("RETURN STATEMENT IN RECURSIVE PROCEDURE NOT " &
+                   "WORKING");
+      ELSIF I2 /= 120 THEN
+           FAILED
+           ("RETURN STMT IN RECURSIVE PROCEDURE NOT WORKING CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C58004C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58004d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58004d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58004d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58004d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C58004D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RETURN STATEMENT TERMINATES EXECUTION
+ --    OF THE INNERMOST ENCLOSING SUBPROGRAM.
+ 
+ -- CHECKS GENERIC SUBPROGRAMS.
+ 
+ -- SPS 3/7/83
+ -- JRK 1/31/84
+ 
+ WITH REPORT;
+ PROCEDURE C58004D IS
+ 
+      USE REPORT;
+ 
+      I1, I2 : INTEGER;
+ 
+      GENERIC
+      PROCEDURE ADDM (IA1 : IN OUT INTEGER; IA2 : IN INTEGER);
+ 
+      PROCEDURE ADDM (IA1 : IN OUT INTEGER; IA2 : IN INTEGER) IS
+ 
+           GENERIC
+           PROCEDURE MULT (IM1 : IN OUT INTEGER; IM2 : IN INTEGER);
+ 
+           PROCEDURE MULT (IM1 : IN OUT INTEGER; IM2 : IN INTEGER) IS
+           BEGIN
+                IM1 := IM1 * IM2;
+ 
+                IF IM1 > 0 THEN RETURN;
+                END IF;
+ 
+                IM1 := 0;
+           END MULT;
+ 
+           PROCEDURE MLT IS NEW MULT;
+ 
+      BEGIN
+           MLT (IA1, IA2);
+           IA1 := IA1 + IA2;
+ 
+           IF IA1 > 0 THEN RETURN;
+           END IF;
+ 
+           IA1 := 0;
+      END ADDM;
+ 
+      PROCEDURE ADM IS NEW ADDM;
+ 
+ BEGIN
+      TEST ("C58004D","CHECK THAT RETURN TERMINATES EXECUTION OF ONLY" &
+            " THE INNERMOST ENCLOSING GENERIC SUBPROGRAM");
+ 
+      I1 := 2;
+      I2 := 3;
+      ADM (I1,I2);     -- SAME AS I1 := (I1 * I2) + I2
+ 
+      IF I1 = 0 THEN
+           FAILED ("RETURN DOES NOT TERMINATE SUBPROGRAM");
+      ELSIF I1 = 6 THEN
+           FAILED
+           ("RETURN TERMINATES ALL SUBPROGRAMS NOT JUST INNERMOST");
+      ELSIF I1 /= 9 THEN
+           FAILED ("RETURN STATEMENT NOT WORKING CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C58004D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58004g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58004g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58004g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58004g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C58004G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE RETURN STATEMENT WORKS FOR RECURSIVE SUBPROGRAMS,
+ --    BOTH FUNCTIONS AND PROCEDURES.
+ 
+ -- CHECK GENERIC SUBPROGRAMS.
+ 
+ -- SPS 3/7/83
+ -- JBG 9/13/83
+ 
+ WITH REPORT;
+ PROCEDURE C58004G IS
+ 
+      USE REPORT;
+ 
+      I1, I2 : INTEGER := 0;
+ 
+      GENERIC
+      PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER);
+ 
+      GENERIC
+      FUNCTION FACTORIALF (IF1: INTEGER) RETURN INTEGER;
+ 
+      PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER) IS
+      BEGIN
+           IF IP1 = 1 THEN
+                IP2 := 1;
+                RETURN;
+           ELSE FACTORIALP (IP1 - 1, IP2);
+                IP2 := IP1 * IP2;
+                RETURN;
+           END IF;
+ 
+           IP2 := 0;
+ 
+      END FACTORIALP;
+ 
+      FUNCTION FACTORIALF (IF1 : INTEGER) RETURN INTEGER IS
+ 
+      BEGIN
+           IF IF1 = 1 THEN RETURN (1);
+           END IF;
+ 
+           RETURN (IF1 * FACTORIALF(IF1 - 1) );
+ 
+      END FACTORIALF;
+ 
+      PROCEDURE FACTP IS NEW FACTORIALP;
+      FUNCTION FACTF IS NEW FACTORIALF;
+ 
+ BEGIN
+      TEST ("C58004G", "CHECK THAT THE RETURN STATEMENT WORKS FOR" &
+            " RECURSIVE GENERIC FUNCTIONS AND PROCEDURES");
+ 
+      I1 := FACTF (5);
+ 
+      IF I1 /= 120 THEN
+            FAILED ("RETURN STATEMENT IN RECURSIVE FUNCTION NOT " &
+                    "WORKING");
+      END IF;
+ 
+      FACTP (5, I2);
+ 
+      IF I2 = 0 THEN
+           FAILED ("RETURN STATEMENT IN RECURSIVE PROCEDURE NOT " &
+                   "WORKING");
+      ELSIF I2 /= 120 THEN
+           FAILED
+           ("RETURN STMT IN RECURSIVE PROCEDURE NOT WORKING CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C58004G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,121 ----
+ -- C58005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A FUNCTION IS READY TO RETURN CONTROL TO ITS INVOKER
+ --    THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT
+ --     CONSTRAINT ERROR  IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS
+ --    ARE NOT SATISFIED.
+ 
+ -- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE
+ --    CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION.  THE
+ --    PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED
+ --    ELSEWHERE.
+ 
+ 
+ -- RM 05/14/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE  C58005A  IS
+ 
+      USE  REPORT ;
+ 
+      INTVAR  :  INTEGER ;
+ 
+ BEGIN
+ 
+      TEST( "C58005A" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
+                        " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
+                        " VIOLATED" );
+ 
+ 
+      DECLARE
+           SUBTYPE I1 IS INTEGER RANGE -10..90;
+           SUBTYPE I2 IS INTEGER RANGE 1..10;
+           FUNCTION  FN1( X : I1 )
+                     RETURN  I2  IS
+           BEGIN
+                RETURN  0 ;
+           END  FN1 ;
+ 
+           FUNCTION  FN2( X : I1 )
+                     RETURN  I2  IS
+           BEGIN
+                RETURN  X + IDENT_INT(0) ;
+           END  FN2 ;
+ 
+           FUNCTION  FN3( X : I1  )
+                     RETURN  I2  IS
+                HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100) ;
+           BEGIN
+                RETURN  HUNDRED - 90 ;
+           END  FN3 ;
+ 
+      BEGIN
+ 
+           INTVAR := 0 ;
+ 
+           BEGIN
+                INTVAR := FN1( 0 ) + INTVAR ;  -- EXCEPTION.
+                FAILED( "EXCEPTION NOT RAISED  -  1" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ;
+                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" ) ;
+           END ;
+ 
+           BEGIN
+                INTVAR := FN2( 1 ) + INTVAR ; -- 10+1=11 -- NO EXCEPTION.
+                INTVAR := INTVAR + 100 ;   -- 11+100=111
+           EXCEPTION
+                WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  2" ) ;
+           END ;
+ 
+           BEGIN
+                INTVAR := FN2(11 ) + INTVAR ;  -- EXCEPTION.
+                FAILED( "EXCEPTION NOT RAISED  -  3" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ; -- 121
+                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  3" ) ;
+           END ;
+ 
+           BEGIN
+                INTVAR := FN3( 0 ) + INTVAR ;--121+10=131 --NO EXCEPTION.
+                INTVAR := INTVAR + 1000 ;-- 131+1000=1131
+           EXCEPTION
+                WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  4" ) ;
+           END ;
+ 
+ 
+      END ;
+ 
+ 
+      IF  INTVAR /= 1131  THEN
+           FAILED("WRONG FLOW OF CONTROL" );
+      END IF;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C58005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C58005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC FUNCTION IS READY TO RETURN CONTROL TO ITS 
+ --    INVOKER THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT
+ --    CONSTRAINT ERROR  IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS
+ --    ARE NOT SATISFIED.
+ 
+ -- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE
+ --    CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION.  THE
+ --    PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED
+ --    ELSEWHERE.
+ 
+ -- SPS 3/10/83
+ -- JBG 9/13/83
+ -- AH  8/29/86  ADDED CALLS TO "FAILED" AFTER "IF" STATEMENTS.
+ 
+ WITH REPORT;
+ PROCEDURE  C58005B  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C58005B" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
+                        " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
+                        " VIOLATED" );
+ 
+ 
+      DECLARE
+           SUBTYPE I1 IS INTEGER RANGE -10..90;
+           SUBTYPE I2 IS INTEGER RANGE 1..10;
+ 
+           GENERIC
+           FUNCTION FN1 ( X : I1 ) RETURN I2;
+ 
+           FUNCTION  FN1( X : I1 )
+                     RETURN  I2  IS
+           BEGIN
+                RETURN X;
+           END  FN1;
+ 
+           FUNCTION F1 IS NEW FN1;
+ 
+      BEGIN
+ 
+           BEGIN
+                IF F1(IDENT_INT(0)) IN I2 THEN
+                     FAILED( "EXCEPTION NOT RAISED  -  1A" );
+                ELSE
+                     FAILED( "EXCEPTION NOT RAISED  -  1B" );
+                END IF;          
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" );
+           END;
+ 
+           BEGIN
+                IF F1(IDENT_INT(11)) IN I2 THEN
+                     FAILED( "EXCEPTION NOT RAISED  -  2A" );
+                ELSE
+                     FAILED( "EXCEPTION NOT RAISED  -  2B" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  2" );
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C58005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58005h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58005h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58005h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58005h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,172 ----
+ -- C58005H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINTS ON THE RETURN VALUE OF A FUNCTION ARE
+ -- SATISIFIED WHEN THE FUNCTION RETURNS CONTROL TO ITS INVOKER.
+ 
+ -- THIS TESTS CHECKS FOR CONSTRAINTS ON CONSTRAINED ACCESS TYPES WITH
+ -- RECORD, ARRAY, PRIVATE AND LIMITED PRIVATE DESIGNATED TYPES.
+ 
+ -- SPS 3/10/83
+ -- RLB 6/29/01 - Repaired test to work in the face of aggressive optimizations.
+ --               The objects must be used, and must be tied somehow to the
+ --               calls to Failed.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C58005H IS
+ 
+      PACKAGE PACK IS
+           TYPE PV (D : NATURAL) IS PRIVATE;
+           TYPE LP (D : NATURAL) IS LIMITED PRIVATE;
+      PRIVATE
+           TYPE PV (D : NATURAL) IS RECORD
+                NULL;
+           END RECORD;
+           TYPE LP (D : NATURAL) IS RECORD
+                NULL;
+           END RECORD;
+      END PACK;
+ 
+      USE PACK;
+ 
+      TYPE ARR IS ARRAY (NATURAL RANGE <>) OF NATURAL;
+      TYPE REC (D : NATURAL) IS RECORD
+           NULL;
+      END RECORD;
+ 
+      TYPE ACC_REC IS ACCESS REC;
+      TYPE ACC_ARR IS ACCESS ARR;
+      TYPE ACC_PV IS ACCESS PV;
+      TYPE ACC_LP IS ACCESS LP;
+ 
+      SUBTYPE ACC_REC1 IS ACC_REC (D => 1);
+      SUBTYPE ACC_REC2 IS ACC_REC (D => 2);
+ 
+      SUBTYPE ACC_ARR1 IS ACC_ARR (1 .. 10);
+      SUBTYPE ACC_ARR2 IS ACC_ARR (2 .. 5);
+ 
+      SUBTYPE ACC_PV1 IS ACC_PV (D => 1);
+      SUBTYPE ACC_PV2 IS ACC_PV (D => 2);
+ 
+      SUBTYPE ACC_LP1 IS ACC_LP (D => 1);
+      SUBTYPE ACC_LP2 IS ACC_LP (D => 2);
+ 
+      VAR1 : ACC_REC1 := NEW REC(1);
+      VAR2 : ACC_REC2 := NEW REC(2);
+      VAA1 : ACC_ARR1 := NEW ARR(1 .. 10);
+      VAA2 : ACC_ARR2 := NEW ARR(2 .. 5);
+      VAP1 : ACC_PV1 := NEW PV(1);
+      VAP2 : ACC_PV2 := NEW PV(2);
+      VAL1 : ACC_LP1 := NEW LP(1);
+      VAL2 : ACC_LP2 := NEW LP(2);
+ 
+      FUNCTION FREC ( X : ACC_REC1) RETURN ACC_REC2 IS
+      BEGIN
+           RETURN X;
+      END FREC;
+ 
+      FUNCTION FARR ( X : ACC_ARR1) RETURN ACC_ARR2 IS
+      BEGIN
+           RETURN X;
+      END FARR;
+ 
+      FUNCTION FPV ( X : ACC_PV1) RETURN ACC_PV2 IS
+      BEGIN
+           RETURN X;
+      END FPV;
+ 
+      FUNCTION FLP ( X : ACC_LP1) RETURN ACC_LP2 IS
+      BEGIN
+           RETURN X;
+      END FLP;
+ 
+      PACKAGE BODY PACK IS
+           FUNCTION LF (X : LP) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT(3);
+           END LF;
+      BEGIN
+           NULL;
+      END PACK;
+ 
+ BEGIN
+ 
+      TEST ("C58005H", "CHECK ACCESS CONSTRAINTS ON RETURN VALUES " &
+                       "OF FUNCTIONS");
+ 
+      BEGIN
+           VAR2 := FREC (VAR1);
+           IF VAR2.D /= REPORT.IDENT_INT(2) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 1");
+           ELSE
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - REC");
+      END;
+ 
+      BEGIN
+           VAA2 := FARR (VAA1);
+           IF VAA2'FIRST /= REPORT.IDENT_INT(2) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 1");
+           ELSE
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - ARR");
+      END;
+ 
+      BEGIN
+           VAP2 := FPV (VAP1);
+           IF VAP2.D /= REPORT.IDENT_INT(2) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 1");
+           ELSE
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - PV");
+      END;
+ 
+      BEGIN
+           VAL2 := FLP (VAL1);
+           IF VAL2.D /= REPORT.IDENT_INT(2) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 1");
+           ELSE
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 2");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR => NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - LP");
+      END;
+ 
+      RESULT;
+ END C58005H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C58006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE EVALUATION OF A RETURN STATEMENT'S EXPRESSION
+ -- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
+ -- THE FUNCTION. 
+ 
+ -- RM 05/11/81
+ -- SPS 10/26/82
+ -- SPS 3/8/83
+ -- JBG 9/13/83
+ 
+ WITH REPORT;
+ PROCEDURE  C58006A  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C58006A" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
+                        " STATEMENT CAN BE HANDLED LOCALLY" );
+ 
+ 
+      DECLARE
+           SUBTYPE I1 IS INTEGER RANGE -10..90;
+           SUBTYPE I2 IS INTEGER RANGE 1..10; 
+ 
+           FUNCTION  FN1( X : I1 )
+                     RETURN  I2  IS
+           BEGIN
+                RETURN  0;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     COMMENT ("EXCEPTION RAISED - F1");
+                     RETURN 1;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - FN1");
+           END  FN1;
+ 
+           FUNCTION  FN2( X : I1 )
+                     RETURN  I2  IS
+           BEGIN
+                RETURN  X + IDENT_INT(0);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     COMMENT ("EXCEPTION RAISED - F2");
+                     RETURN 1;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - FN2");
+           END  FN2;
+ 
+           FUNCTION  FN3( X : I1 )
+                     RETURN  I2  IS
+                HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
+           BEGIN
+                RETURN  HUNDRED;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     COMMENT ("EXCEPTION RAISED - F3");
+                     RETURN 1;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - FN3");
+           END  FN3;
+ 
+      BEGIN
+ 
+           BEGIN
+                IF FN1( 0 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - FN1( 0 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - FN1( 0 )");
+           END;
+ 
+           BEGIN
+                IF FN2( 0 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - FN2( 0 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - FN2( 0 )");
+           END;
+ 
+           BEGIN
+                IF FN2(11 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - FN2(11 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - FN2(11 )");
+           END;
+ 
+           BEGIN
+                IF FN3( 0 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - FN3( 0 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - FN3( 0 )");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C58006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58006b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c58006b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c58006b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,141 ----
+ -- C58006B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE EVALUATION OF A RETURN STATEMENT'S EXPRESSION
+ -- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
+ -- THE FUNCTION. 
+ 
+ -- CHECKS GENERIC FUNCTIONS.
+ 
+ -- SPS 3/8/83
+ -- JBG 9/13/83
+ 
+ WITH REPORT;
+ PROCEDURE  C58006B  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C58006B" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
+                        " STATEMENT CAN BE HANDLED LOCALLY" );
+ 
+ 
+      DECLARE
+           SUBTYPE I1 IS INTEGER RANGE -10..90;
+           SUBTYPE I2 IS INTEGER RANGE 1..10; 
+ 
+           GENERIC
+           FUNCTION FN1 (X : I1) RETURN I2;
+ 
+           GENERIC
+           FUNCTION FN2 (X : I1) RETURN I2;
+ 
+           GENERIC
+           FUNCTION FN3 (X : I1) RETURN I2;
+ 
+           FUNCTION  FN1( X : I1 )
+                     RETURN  I2  IS
+           BEGIN
+                RETURN  0;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     COMMENT ("EXCEPTION RAISED - F1");
+                     RETURN 1;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - FN1");
+           END  FN1;
+ 
+           FUNCTION  FN2( X : I1 )
+                     RETURN  I2  IS
+           BEGIN
+                RETURN  X + IDENT_INT(0);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     COMMENT ("EXCEPTION RAISED - F2");
+                     RETURN 1;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - FN2");
+           END  FN2;
+ 
+           FUNCTION  FN3( X : I1 )
+                     RETURN  I2  IS
+                HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
+           BEGIN
+                RETURN  HUNDRED;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => 
+                     COMMENT ("EXCEPTION RAISED - F3");
+                     RETURN 1;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - FN3");
+           END  FN3;
+ 
+           FUNCTION F1 IS NEW FN1;
+           FUNCTION F2 IS NEW FN2;
+           FUNCTION F3 IS NEW FN3;
+ 
+      BEGIN
+ 
+           BEGIN
+                IF F1( 0 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - F1( 0 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - F1( 0 )");
+           END;
+ 
+           BEGIN
+                IF F2( 0 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - F2( 0 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - F2( 0 )");
+           END;
+ 
+           BEGIN
+                IF F2(11 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - F2(11 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - F2(11 )");
+           END;
+ 
+           BEGIN
+                IF F3( 0 ) /= IDENT_INT(1) THEN
+                     FAILED ("NO EXCEPTION RAISED - F3( 0 )");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION PROPAGATED - F3( 0 )");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C58006B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c59002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c59002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c59002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c59002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C59002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT JUMPS OUT OF AN EXCEPTION HANDLER CONTAINED IN A BLOCK
+ --    TO A STATEMENT IN AN ENCLOSING UNIT ARE ALLOWED AND ARE PERFORMED 
+ --    CORRECTLY.
+ 
+ 
+ -- RM 05/22/81
+ -- SPS 3/8/83
+ 
+ WITH REPORT;
+ PROCEDURE  C59002A  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C59002A" , "CHECK THAT JUMPS OUT OF EXCEPTION HANDLERS" &
+                        " ARE ALLOWED" );
+ 
+      DECLARE
+ 
+           FLOW : INTEGER := 1 ;
+           EXPON: INTEGER RANGE 0..3 := 0 ;
+ 
+      BEGIN
+ 
+           GOTO  START ;
+ 
+           FAILED( "'GOTO' NOT OBEYED" );
+ 
+           << BACK_LABEL >>
+           FLOW  := FLOW  * 3**EXPON ;                    -- 1*5*9
+           EXPON := EXPON + 1 ;
+           GOTO  FINISH ;
+ 
+           << START >>
+           FLOW  := FLOW  * 7**EXPON ;                    -- 1
+           EXPON := EXPON + 1 ;
+ 
+           DECLARE
+           BEGIN
+                RAISE  CONSTRAINT_ERROR ;
+                FAILED( "EXCEPTION NOT RAISED  -  1" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR  =>
+                     GOTO  FORWARD_LABEL ;
+           END ;
+ 
+           FAILED( "INNER 'GOTO' NOT OBEYED  -  1" );
+ 
+           << FORWARD_LABEL >>
+           FLOW  := FLOW  * 5**EXPON ;                    -- 1*5
+           EXPON := EXPON + 1 ;
+ 
+           DECLARE
+           BEGIN
+                RAISE  CONSTRAINT_ERROR ;
+                FAILED( "EXCEPTION NOT RAISED  -  2" );
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR  =>
+                     GOTO  BACK_LABEL ;
+           END ;
+ 
+           FAILED( "INNER 'GOTO' NOT OBETED  -  2" );
+ 
+           << FINISH >>
+           FLOW  := FLOW  * 2**EXPON ;                    -- 1*5*9*8
+ 
+           IF  FLOW /= 360  THEN
+                FAILED( "WRONG FLOW OF CONTROL" );
+           END IF;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C59002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c59002b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c59002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c59002b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c59002b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,209 ----
+ -- C59002B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT JUMPS OUT OF COMPOUND STATEMENTS (OTHER THAN
+ --    ACCEPT STATEMENTS) ARE POSSIBLE AND ARE CORRECTLY PERFORMED.
+ 
+ 
+ -- FLOW OF CONTROL:   A ->  B ->  C ->  D ->   E ->  F ->  G ->  H .
+ --                    |     |     |     |      |     |     |
+ --                    IF   LOOP   CASE  BLOCK  IF   LOOP   CASE
+ --                                             LOOP CASE   BLOCK
+ 
+ 
+ --          A : GOTO B              L111 -> L311
+ --          FAILURE                 L121
+ --          E : GOTO F              L131 -> L331
+ 
+ --          FAILURE                 L100
+ 
+ --          C : GOTO D              L211 -> L411
+ --          FAILURE                 L221
+ --          G : GOTO H              L231
+ 
+ --          FAILURE                 L200
+ 
+ --          B : GOTO C              L311 -> L211
+ --          FAILURE                 L321
+ --          F : GOTO G              L331
+ 
+ --          FAILURE                 L300
+ 
+ --          D : GOTO E              L411 -> L131
+ --          FAILURE                 L421
+ --          H :                     L431 -> (OUT)
+ 
+ --          PRINT RESULTS
+ 
+ 
+ -- RM 06/05/81
+ -- SPS 3/8/83
+ 
+ WITH REPORT;
+ PROCEDURE  C59002B  IS
+ 
+      USE  REPORT ;
+ 
+ BEGIN
+ 
+      TEST( "C59002B" , "CHECK THAT ONE CAN JUMP OUT OF COMPOUND STATE" &
+                        "MENTS" );
+ 
+ 
+      DECLARE
+ 
+           FLOW_STRING : STRING(1..8) := "XXXXXXXX" ;
+           INDEX       : INTEGER      :=  1 ;
+ 
+      BEGIN
+ 
+           << L111 >>
+ 
+           FLOW_STRING(INDEX) := 'A' ;
+           INDEX              := INDEX + 1 ;
+ 
+           IF  FALSE  THEN
+                FAILED( "WRONG 'IF' BRANCH" );
+           ELSE
+                GOTO  L311 ;
+           END IF;
+ 
+           << L121 >>
+ 
+           FAILED( "AT L121  -  WRONGLY" );
+ 
+           << L131 >>
+ 
+           FLOW_STRING(INDEX) := 'E' ;
+           INDEX              := INDEX + 1 ;
+ 
+           IF  FALSE  THEN
+                FAILED( "WRONG 'IF' BRANCH" );
+           ELSE
+                FOR  J  IN  1..1  LOOP
+                     GOTO  L331 ;
+                END LOOP;
+           END IF;
+ 
+           << L100 >>
+ 
+           FAILED( "AT L100  -  WRONGLY" );
+ 
+           << L211 >>
+ 
+           FLOW_STRING(INDEX) := 'C' ;
+           INDEX              := INDEX + 1 ;
+ 
+           CASE  2  IS
+                WHEN  1  =>
+                     FAILED( "WRONG 'CASE' BRANCH" );
+                WHEN  OTHERS  =>
+                     GOTO  L411 ;
+           END CASE;
+ 
+           << L221 >>
+ 
+           FAILED( "AT L221  -  WRONGLY" );
+ 
+           << L231 >>
+ 
+           FLOW_STRING(INDEX) := 'G' ;
+           INDEX              := INDEX + 1 ;
+ 
+           CASE  2  IS
+                WHEN  1  =>
+                     FAILED( "WRONG 'CASE' BRANCH" );
+                WHEN  OTHERS  =>
+                     DECLARE
+                     BEGIN
+                          GOTO  L431 ;
+                     END ;
+           END CASE;
+ 
+           << L200 >>
+ 
+           FAILED( "AT L200  -  WRONGLY" );
+ 
+           << L311 >>
+ 
+           FLOW_STRING(INDEX) := 'B' ;
+           INDEX              := INDEX + 1 ;
+ 
+           FOR  I  IN  1..1  LOOP
+                GOTO  L211 ;
+           END LOOP;
+ 
+           << L321 >>
+ 
+           FAILED( "AT L321  -  WRONGLY" );
+ 
+           << L331 >>
+ 
+           FLOW_STRING(INDEX) := 'F' ;
+           INDEX              := INDEX + 1 ;
+ 
+           FOR  I  IN  1..1  LOOP
+                CASE  2  IS
+                     WHEN  1  =>
+                          FAILED( "WRONG 'CASE' BRANCH" );
+                     WHEN  OTHERS  =>
+                          GOTO  L231 ;
+                END CASE;
+           END LOOP;
+ 
+           << L300 >>
+ 
+           FAILED( "AT L300  -  WRONGLY" );
+ 
+           << L411 >>
+ 
+           FLOW_STRING(INDEX) := 'D' ;
+           INDEX              := INDEX + 1 ;
+ 
+           DECLARE
+                K : INTEGER := 17 ;
+           BEGIN
+                GOTO  L131 ;
+           END;
+ 
+           << L421 >>
+ 
+           FAILED( "AT L421  -  WRONGLY" );
+ 
+           << L431 >>
+ 
+           FLOW_STRING(INDEX) := 'H' ;
+ 
+ 
+           IF  FLOW_STRING /= "ABCDEFGH"  THEN
+                FAILED("WRONG FLOW OF CONTROL" );
+           END IF;
+ 
+      END ;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C59002B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c59002c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c59002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c5/c59002c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c5/c59002c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,150 ----
+ -- C59002C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT JUMPS OUT OF SELECT STATEMENTS (OTHER THAN
+ --    FROM INSIDE  ACCEPT  BODIES IN SELECT_ALTERNATIVES)
+ --    ARE POSSIBLE AND ARE CORRECTLY PERFORMED.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES.
+ 
+ 
+ -- RM 08/15/82
+ -- SPS 12/13/82
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT;
+ WITH SYSTEM;
+ USE SYSTEM;
+ PROCEDURE  C59002C  IS
+ 
+      USE  REPORT ;
+ 
+      FLOW_STRING : STRING(1..2) := "XX" ;
+      INDEX       : INTEGER      :=  1 ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C59002C" , "CHECK THAT ONE CAN JUMP OUT OF SELECT STATE" &
+                        "MENTS" );
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           TASK  T  IS
+ 
+ 
+                ENTRY  E1 ;
+                ENTRY  E2 ;
+           END  T ;
+ 
+           TASK BODY T IS
+           BEGIN
+ 
+                WHILE  E2'COUNT <= 0  LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                SELECT 
+                     ACCEPT  E1  DO
+                          FAILED( " E1  ACCEPTED; NO ENTRY CALL (1)" );
+                     END ;
+                OR
+                     ACCEPT  E2 ;
+                     GOTO  L123 ;
+                     FAILED( "'GOTO' NOT OBEYED (1)" );
+                OR
+                     DELAY 10.0 * Impdef.One_Second;
+                     FAILED( "DELAY ALTERNATIVE SELECTED (1)" );
+                END SELECT;
+ 
+                FAILED( "WRONG DESTINATION FOR 'GOTO' (1)" );
+ 
+                << L123 >>
+ 
+                FLOW_STRING(INDEX) := 'A' ;
+                INDEX              := INDEX + 1 ;
+ 
+           END T;
+ 
+      BEGIN
+ 
+           T.E2 ;
+ 
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           TASK  T  IS
+                ENTRY  E1 ;
+                ENTRY  E2 ;
+           END  T ;
+ 
+           TASK BODY T IS
+           BEGIN
+ 
+                SELECT 
+                     ACCEPT  E1  DO
+                          FAILED( " E1  ACCEPTED; NO ENTRY CALL (2)" );
+                     END ;
+                OR
+                     ACCEPT  E2  DO
+                          FAILED( " E2  ACCEPTED; NO ENTRY CALL (2)" );
+                     END ;
+                OR
+                     DELAY 10.0 * Impdef.One_Second;
+                     GOTO  L321 ;
+                     FAILED( "'GOTO' NOT OBEYED (2)" );
+                END SELECT;
+ 
+                FAILED( "WRONG DESTINATION FOR 'GOTO' (2)" );
+ 
+                << L321 >>
+ 
+                FLOW_STRING(INDEX) := 'B' ;
+                INDEX              := INDEX + 1 ;
+ 
+           END T;
+ 
+      BEGIN
+ 
+           NULL ;
+ 
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      IF  FLOW_STRING /= "AB"  THEN
+           FAILED("WRONG FLOW OF CONTROL" );
+      END IF;
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C59002C ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c61008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c61008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c61008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c61008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,266 ----
+ -- C61008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF THE DEFAULT VALUE
+ -- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE 
+ -- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
+ -- THE DEFAULT IS USED.
+ 
+ --   SUBTESTS ARE:
+ --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+ --            INITIALIZED WITH A STATIC AGGREGATE.
+ --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+ --            INITIALIZED WITH A STATIC VALUE.
+ --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+ --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+ --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+ --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+ --            WITH A STATIC AGGREGATE.
+ --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+ --            INITIALIZED WITH A STATIC AGGREGATE.
+ 
+ -- DAS  1/20/81
+ -- SPS 10/26/82
+ -- VKG 1/13/83
+ -- SPS 2/9/83
+ -- BHS 7/9/84
+ 
+ WITH REPORT;
+ PROCEDURE C61008A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                       "CONSTRAINTS ON A FORMAL PARAMETER");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           PROCEDURE PA (I1, I2 : INTEGER) IS
+ 
+                TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
+ 
+                PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
+                BEGIN
+                     FAILED ("BODY OF PA1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN PA1");
+                END PA1;
+ 
+           BEGIN
+                PA1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - PA1");
+           END PA;
+ 
+      BEGIN   -- (A)
+           PA (IDENT_INT(1), IDENT_INT(10));
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN CALL TO PA");
+      END;    -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           PROCEDURE PB (I1, I2 : INTEGER) IS
+ 
+                SUBTYPE INT IS INTEGER RANGE I1..I2;
+ 
+                PROCEDURE PB1 (I : INT := -1) IS
+                BEGIN
+                     FAILED ("BODY OF PB1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN PB1");
+                END PB1;
+ 
+           BEGIN
+                PB1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - PB1");
+           END PB;
+ 
+      BEGIN   -- (B)
+           PB (IDENT_INT(0), IDENT_INT(63));
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN CALL TO PB");
+      END;    -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           PROCEDURE PC (I1, I2 : INTEGER) IS
+                TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2; 
+                TYPE REC IS
+                     RECORD
+                          I : INTEGER RANGE I1..I2;
+                          A : AR1 ;
+                     END RECORD;
+ 
+                PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
+                BEGIN
+                     FAILED ("BODY OF PC1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN PC1");
+                END PC1;
+ 
+           BEGIN
+                PC1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - PC1");
+           END PC;
+ 
+      BEGIN   -- (C)
+           PC (IDENT_INT(1), IDENT_INT(3));
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN CALL TO PC");
+      END;    -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D1)
+ 
+           PROCEDURE P1D (I1, I2 : INTEGER) IS
+ 
+                TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
+ 
+                PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
+                BEGIN
+                     FAILED ("BODY OF P1D1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN P1D1");
+                END P1D1;
+ 
+           BEGIN
+                P1D1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - P1D1");
+           END P1D;
+ 
+      BEGIN   -- (D1)
+           P1D (IDENT_INT(1), IDENT_INT(2));
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN CALL TO P1D");
+      END;    -- (D1)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D2)
+ 
+           PROCEDURE P2D (I1, I2 : INTEGER) IS
+                
+                TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
+ 
+                PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
+                BEGIN
+                     FAILED ("BODY OF P2D1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN P2D1");
+                END P2D1;
+ 
+           BEGIN
+                P2D1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - P2D1");
+           END P2D;
+ 
+      BEGIN  -- (D2)
+           P2D (IDENT_INT(1), IDENT_INT(2));
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN CALL TO P2D");
+      END;   -- (D2)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (E)
+ 
+           PROCEDURE PE (I1, I2 : INTEGER) IS
+                SUBTYPE INT IS INTEGER RANGE 0..10;
+                TYPE ARR IS ARRAY (1..3) OF INT;
+                TYPE REC (I : INT) IS
+                     RECORD
+                          A : ARR;
+                     END RECORD;
+ 
+                SUBTYPE REC4 IS REC(I1);
+ 
+                PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
+                BEGIN
+                     FAILED ("BODY OF PE1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN PE1");
+                END PE1;
+ 
+           BEGIN
+                PE1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - PE1");
+           END PE;
+ 
+      BEGIN   -- (E)
+           PE (IDENT_INT(4), IDENT_INT(10));
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN CALL TO PE");
+      END;    -- (E)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C61008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c61009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c61009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c61009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c61009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,160 ----
+ -- C61009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A STATIC EXPRESSION, CONSTANT NAME, ATTRIBUTE NAME,
+ --   VARIABLE, DEREFERENCED ACCESS, USER-DEFINED OPERATOR, USER-
+ --   DEFINED FUNCTION, OR ALLOCATOR CAN BE USED IN THE INITIALIZATION
+ --   EXPRESSION OF A FORMAL PARAMETER, AND THAT THE APPROPRIATE
+ --   VALUE IS USED AS A DEFAULT PARAMETER VALUE WHEN THE SUBPROGRAM
+ --   IS CALLED.
+ 
+ -- DAS  1/21/81
+ -- ABW  7/20/82
+ -- SPS  12/10/82
+ 
+ WITH REPORT;
+ PROCEDURE C61009A IS
+ 
+      USE REPORT;
+ 
+      TYPE INT IS RANGE 1 .. 10;
+ 
+      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+      TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+           RECORD
+                A : ARR (0..CONSTRAINT); 
+           END RECORD;
+ 
+      C7   : CONSTANT INTEGER  := 7;
+      V7   : INTEGER  := 7;
+      
+      TYPE  A_INT IS ACCESS INTEGER;
+      C_A  : CONSTANT A_INT  := NEW INTEGER'(7);
+ 
+      SUBTYPE RECTYPE1 IS RECTYPE (2 + 5);
+      SUBTYPE RECTYPE2 IS RECTYPE (C7);
+      SUBTYPE RECTYPE3 IS RECTYPE (V7);
+ 
+      FUNCTION "&" (X,Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN 10;
+      END "&";
+ 
+      FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN X;
+      END FUNC;
+ 
+      -- STATIC EXPRESSION
+ 
+      PROCEDURE PROC1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7))) IS
+      BEGIN
+           IF (REC /= (7,(0,1,2,3,4,5,6,7))) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC1 PARAMETER");
+           END IF;
+      END PROC1;
+ 
+      -- CONSTANT NAME
+ 
+      PROCEDURE PROC2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7))) IS
+      BEGIN
+           IF (REC /= (C7,(0,1,2,3,4,5,6,7))) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC2 PARAMETER");
+           END IF;
+      END PROC2;
+ 
+      -- ATTRIBUTE NAME
+ 
+      PROCEDURE PROC3 (P1 : INT := INT'LAST) IS
+      BEGIN
+           IF (P1 /= INT (10)) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC3 PARAMETER");
+           END IF;
+      END PROC3;
+ 
+      -- VARIABLE
+ 
+      PROCEDURE PROC4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7))) IS
+      BEGIN
+           IF (P4 /= (V7,(0,1,2,3,4,5,6,7))) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC4 PARAMETER");
+                END IF;
+           END PROC4;
+ 
+      --DEREFERENCED ACCESS
+ 
+      PROCEDURE PROC5 (P5 : INTEGER := C_A.ALL) IS
+      BEGIN
+           IF(P5 /= C_A.ALL) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC5 PARAMETER");
+           END IF;
+      END PROC5;
+ 
+      --USER-DEFINED OPERATOR
+ 
+      PROCEDURE PROC6 (P6 : INTEGER := 6&4) IS
+      BEGIN
+           IF (P6 /= IDENT_INT(10)) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC6 PARAMETER");
+           END IF;
+      END PROC6;
+ 
+      --USER-DEFINED FUNCTION
+ 
+      PROCEDURE PROC7 (P7 : INTEGER := FUNC(10)) IS
+      BEGIN
+           IF (P7 /= IDENT_INT(10)) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC7 PARAMETER");
+           END IF;
+      END PROC7;
+ 
+      -- ALLOCATOR
+ 
+      PROCEDURE PROC8 (P8 : A_INT := NEW INTEGER'(7)) IS
+      BEGIN
+           IF (P8.ALL /= IDENT_INT(7)) THEN
+                FAILED ("INCORRECT DEFAULT VALUE FOR PROC8 PARAMETER");
+           END IF;
+      END PROC8;
+ 
+ BEGIN
+      TEST ("C61009A", "CHECK USE OF STATIC EXPRESSIONS, CONSTANT " &
+                       "NAMES, ATTRIBUTE NAMES, VARIABLES, USER- " &
+                       "DEFINED OPERATORS, USER-DEFINED FUNCTIONS " &
+                       "DEREFERENCED ACCESSES, AND ALLOCATORS IN " &
+                       "THE FORMAL PART OF A SUBPROGRAM SPECIFICATION");
+ 
+      PROC1;
+      PROC2;
+      PROC3;
+      PROC4;
+      PROC5;
+      PROC6;
+      PROC7;
+      PROC8;
+ 
+      RESULT;
+ 
+ END C61009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c61010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c61010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c61010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c61010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,246 ----
+ -- C61010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN IN OR IN OUT FORMAL PARAMETER CAN BE DECLARED WITH A
+ -- LIMITED PRIVATE TYPE OR A LIMITED COMPOSITE TYPE.
+ 
+ -- DAS  1/22/81
+ -- JRK  1/20/84  TOTALLY REVISED.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C61010A IS
+ 
+      PACKAGE PKG IS
+ 
+           TYPE ITYPE IS LIMITED PRIVATE;
+ 
+           PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+ 
+           PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
+                                   M : STRING);
+ 
+           PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER);
+ 
+           SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
+           TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
+ 
+           PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                                 S : STRING; M : STRING);
+ 
+           PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                    I : INTEGER; S : STRING;
+                                    M : STRING);
+ 
+           PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
+                             S : STRING);
+ 
+      PRIVATE
+ 
+           TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
+ 
+           TYPE VRTYPE (C : INT_0_20 := 20) IS
+                RECORD
+                     I : INTEGER;
+                     S : STRING (1 .. C);
+                END RECORD;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      I1 : ITYPE;
+ 
+      TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
+ 
+      A1 : ATYPE;
+ 
+      VR1 : VRTYPE;
+ 
+      D : CONSTANT INT_0_20 := 10;
+ 
+      TYPE RTYPE IS
+           RECORD
+                J : ITYPE;
+                R : VRTYPE (D);
+           END RECORD;
+ 
+      R1 : RTYPE;
+ 
+      PACKAGE BODY PKG IS
+ 
+           PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
+           BEGIN
+                IF INTEGER (X) /= V THEN
+                     FAILED ("WRONG SCALAR VALUE - " & M);
+                END IF;
+           END LOOK_IN_I;
+ 
+           PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
+                                   M : STRING) IS
+           BEGIN
+                IF INTEGER (X) /= V THEN
+                     FAILED ("WRONG SCALAR VALUE - " & M);
+                END IF;
+           END LOOK_INOUT_I;
+ 
+           PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER) IS
+           BEGIN
+                X := ITYPE (IDENT_INT (V));
+           END SET_I;
+ 
+           PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                                 S : STRING; M : STRING) IS
+           BEGIN
+                IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
+                     FAILED ("WRONG COMPOSITE VALUE - " & M);
+                END IF;
+           END LOOK_IN_VR;
+ 
+           PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                    I : INTEGER; S : STRING;
+                                    M : STRING) IS
+           BEGIN
+                IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
+                     FAILED ("WRONG COMPOSITE VALUE - " & M);
+                END IF;
+           END LOOK_INOUT_VR;
+ 
+           PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
+                             S : STRING) IS
+           BEGIN
+                X := (IDENT_INT(C), IDENT_INT(I), IDENT_STR(S));
+           END SET_VR;
+ 
+      BEGIN
+           I1 := ITYPE (IDENT_INT(2));
+ 
+           FOR I IN A1'RANGE LOOP
+                A1 (I) := ITYPE (3 + IDENT_INT(I));
+           END LOOP;
+ 
+           VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
+ 
+           R1.J := ITYPE (IDENT_INT(6));
+           R1.R := (IDENT_INT(D), IDENT_INT(19),
+                    IDENT_STR("ABCDEFGHIJ"));
+      END PKG;
+ 
+      PROCEDURE CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
+      BEGIN
+           LOOK_IN_I (X, V, M);
+      END CHECK_IN_I;
+ 
+      PROCEDURE CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+                               NV : INTEGER; M : STRING) IS
+      BEGIN
+           LOOK_INOUT_I (X, OV, M & " - A");
+           SET_I (X, NV);
+           LOOK_INOUT_I (X, NV, M & " - B");
+           LOOK_IN_I (X, NV, M & " - C");
+      END CHECK_INOUT_I;
+ 
+      PROCEDURE CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) IS
+      BEGIN
+           FOR I IN X'RANGE LOOP
+                LOOK_IN_I (X(I), V+I, M & " -" & INTEGER'IMAGE (I));
+           END LOOP;
+      END CHECK_IN_A;
+ 
+      PROCEDURE CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+                               NV : INTEGER; M : STRING) IS
+      BEGIN
+           FOR I IN X'RANGE LOOP
+                LOOK_INOUT_I (X(I), OV+I, M & " - A" &
+                                          INTEGER'IMAGE (I));
+                SET_I (X(I), NV+I);
+                LOOK_INOUT_I (X(I), NV+I, M & " - B" &
+                                          INTEGER'IMAGE (I));
+                LOOK_IN_I (X(I), NV+I, M & " - C" & INTEGER'IMAGE (I));
+           END LOOP;
+      END CHECK_INOUT_A;
+ 
+      PROCEDURE CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                             S : STRING; M : STRING) IS
+      BEGIN
+           LOOK_IN_VR (X, C, I, S, M);
+      END CHECK_IN_VR;
+ 
+      PROCEDURE CHECK_INOUT_VR (X : IN OUT VRTYPE;
+                                OC : INTEGER; OI : INTEGER; OS : STRING;
+                                NC : INTEGER; NI : INTEGER; NS : STRING;
+                                M : STRING) IS
+      BEGIN
+           LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
+           SET_VR (X, NC, NI, NS);
+           LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
+           LOOK_IN_VR (X, NC, NI, NS, M & " - C");
+      END CHECK_INOUT_VR;
+ 
+      PROCEDURE CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+                            I : INTEGER; S : STRING; M : STRING) IS
+      BEGIN
+           LOOK_IN_I (X.J, J, M & " - A");
+           LOOK_IN_VR (X.R, C, I, S, M & " - B");
+      END CHECK_IN_R;
+ 
+      PROCEDURE CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+                               OC : INTEGER; OI : INTEGER; OS : STRING;
+                               NJ : INTEGER;
+                               NC : INTEGER; NI : INTEGER; NS : STRING;
+                               M : STRING) IS
+      BEGIN
+           LOOK_INOUT_I (X.J, OJ, M & " - A");
+           LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
+           SET_I (X.J, NJ);
+           SET_VR (X.R, NC, NI, NS);
+           LOOK_INOUT_I (X.J, NJ, M & " - C");
+           LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
+           LOOK_IN_I (X.J, NJ, M & " - E");
+           LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
+      END CHECK_INOUT_R;
+ 
+ BEGIN
+      TEST ("C61010A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
+                       "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
+ 
+      CHECK_IN_I (I1, 2, "IN I");
+ 
+      CHECK_INOUT_I (I1, 2, 5, "INOUT I");
+ 
+      CHECK_IN_A (A1, 3, "IN A");
+ 
+      CHECK_INOUT_A (A1, 3, 17, "INOUT A");
+ 
+      CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
+ 
+      CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
+                      "INOUT VR");
+ 
+      CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
+ 
+      CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, "ZYXWVUTSRQ",
+                     "INOUT R");
+ 
+      RESULT;
+ END C61010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c620001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c620001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c620001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c620001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,340 ----
+ -- C620001.A
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    Check that elementary parameters are passed by copy.
+ --
+ --    Part 1: Integer, float, and access types, procedures and functions.
+ --
+ -- TEST DESCRIPTION:
+ --    Subtests are:
+ --        (A) Scalar parameters to procedures.
+ --        (B) Scalar parameters to functions.
+ --        (C) Access parameters to procedures.
+ --        (D) Access parameters to functions.
+ --
+ --    For the procedure examples, we pass array elements indexed by dynamically
+ --    determined indexes. Doing this side-steps the check of 6.4.1(6.15/3) and
+ --    makes the test more realistic.
+ --
+ --    To completely test this objective, we should also try in out and out
+ --    parameters for functions (Ada 2012), in/in out/out parameters for
+ --    task and protected entries, and a variety of different scalar types
+ --    (enumeration, modular, fixed, decimal).
+ --
+ -- CHANGE HISTORY:
+ --    14 Jan 1980 DAS Created test.
+ --    26 Oct 1982 SPS
+ --    25 May 1984 CPP
+ --    29 Oct 1985 EG  Eliminate the use of Numeric_Error in the test.
+ --    14 Mar 2014 RLB Revised so test cases are legal for Ada 2012, modernized
+ --                    objective, converted to modern format, added float cases.
+ 
+ with Report;
+ procedure C620001 is
+ 
+      use Report;
+ 
+ begin
+      Test ("C620001", "Check that elementary parameters are passed by copy");
+ 
+      --------------------------------------------------
+ 
+      declare  -- (A)
+ 
+           I,J,K : Natural := Report.Ident_Int(1); -- Index values.
+           Arr   : array (1 .. 4) of Integer;
+           E     : exception;
+ 
+           procedure P (PI  : in     Integer;
+                        PO  :    out Integer;
+                        PIO : in out Integer) is
+ 
+                Tmp  : Integer;
+ 
+           begin
+ 
+                Tmp := PI;     -- Save value of PI at procedure entry.
+ 
+                PO := 10;
+                if (PI /= Tmp) then
+                     Failed ("Assignement to scalar out " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                     Tmp := PI;     -- Reset Tmp for next case.
+                end if;
+ 
+                PIO := PIO + 100;
+                if (PI /= Tmp) then
+                     Failed ("Assignment to scalar in out " &
+                             "parameter changes the value of " &
+                             "inputparameter");
+                     Tmp := PI;     -- Reset Tmp for next case.
+                end if;
+ 
+                Arr(I) := Arr(I) + 1;
+                if (PI /= Tmp) then
+                     Failed ("Assignment to scalar actual " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                end if;
+ 
+                raise E;  -- Check exception handling.
+           end P;
+ 
+      begin  -- (A)
+           Arr := (others => 0);
+           P (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - A");
+      exception
+           when E =>
+                if (Arr(I) /= 1) then
+                     case Arr(I) is
+                          when 11  =>
+                               Failed ("Out actual scalar parameter " &
+                                       "changed global value");
+                          when 101 =>
+                               Failed ("In out actual scalar " &
+                                       "parameter changed global value");
+                          when 111 =>
+                               Failed ("Out and in out actual scalar " &
+                                       "parameters changed global " &
+                                       "value");
+                          when others =>
+                               Failed ("Uundetermined change to global " &
+                                       "value");
+                     end case;
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - A");
+      end;  -- (A)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (B)
+ 
+           I,J  : Integer;
+ 
+           function F (FI : in Integer) return Integer is
+ 
+                Tmp  : Integer := FI;
+ 
+           begin
+ 
+                I := I + 1;
+                if (FI /= Tmp) then
+                     Failed ("Assignment to scalar actual function " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                end if;
+ 
+                return (100);
+           end F;
+ 
+      begin  -- (B)
+           I := 100;
+           J := F (I);
+      end;  -- (B)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (C)
+ 
+           type Acctype is access Integer;
+ 
+           I,J,K : Natural := Report.Ident_Int(2); -- Index values.
+           Arr   : array (1 .. 5) of Acctype;
+           E     : exception;
+ 
+           procedure P (PI  : in     Acctype;
+                        PO  :    out Acctype;
+                        PIO : in out Acctype) is
+ 
+                Tmp  : Acctype;
+ 
+           begin
+ 
+                Tmp := PI;     -- Save value of PI at procedure entry.
+ 
+                Arr(I) := new Integer'(101);
+                if (PI /= Tmp) then
+                     Failed ("Assignment to access actual " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                     Tmp := PI;     -- Reset Tmp for next case.
+                end if;
+ 
+                PO := new Integer'(1);
+                if (PI /= Tmp) then
+                     Failed ("Assignment to access out " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                     Tmp := PI;     -- Reset Tmp for next case.
+                end if;
+ 
+                PIO := new Integer'(10);
+                if (PI /= Tmp) then
+                     Failed ("Assignment to access in out " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                end if;
+ 
+                raise E;  -- Check exception handling.
+           end P;
+ 
+      begin  -- (C)
+           Arr(I) := new Integer'(100);
+           P (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - C");
+      exception
+           when E =>
+                if (Arr(I).all /= 101) then
+                     Failed ("Out or in out actual procedure " &
+                             "parameter value changed despite " &
+                             "raised exception");
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - C");
+      end;  -- (C)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (D)
+ 
+           Type Acctype is access Integer;
+ 
+           I,J  : Acctype;
+ 
+           function F (FI : in Acctype) return Acctype is
+ 
+                Tmp  : Acctype := FI;
+ 
+           begin
+ 
+                I := new Integer;
+                if (FI /= Tmp) then
+                     Failed ("Assignment to access actual function " &
+                             "parameter changes the value of " &
+                             "Input parameter");
+                end if;
+ 
+                return null;
+           end F;
+ 
+      begin  -- (D)
+           I := null;
+           J := F(I);
+      end;  -- (D)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (E)
+ 
+           I,J,K : Natural := Report.Ident_Int(3); -- Index values.
+           Arr   : array (1 .. 3) of Float;
+           E     : exception;
+ 
+           procedure P (PI  : in     Float;
+                        PO  :    out Float;
+                        PIO : in out Float) is
+ 
+                Tmp  : Float;
+ 
+           begin
+ 
+                Tmp := PI;     -- Save value of PI at procedure entry.
+ 
+                PO := 0.5;
+                if (PI /= Tmp) then
+                     Failed ("Assignement to float out " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                     Tmp := PI;     -- Reset Tmp for next case.
+                end if;
+ 
+                PIO := PIO + 0.25;
+                if (PI /= Tmp) then
+                     Failed ("Assignment to float in out " &
+                             "parameter changes the value of " &
+                             "inputparameter");
+                     Tmp := PI;     -- Reset Tmp for next case.
+                end if;
+ 
+                Arr(I) := Arr(I) + 1.0;
+                if (PI /= Tmp) then
+                     Failed ("Assignment to float actual " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                end if;
+ 
+                raise E;  -- Check exception handling.
+           end P;
+ 
+      begin  -- (E)
+           Arr := (others => 0.0);
+           P (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - E");
+      exception
+           when E =>
+                if (Arr(I) /= 1.0) then
+                     Failed ("Out or in out actual procedure " &
+                             "parameter value changed despite " &
+                             "raised exception");
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - E");
+      end;  -- (E)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (F)
+ 
+           I,J  : Float;
+ 
+           function F (FI : in Float) return Float is
+ 
+                Tmp  : Float := FI;
+ 
+           begin
+ 
+                I := I + 1.0;
+                if (FI /= Tmp) then
+                     Failed ("Assignment to float actual function " &
+                             "parameter changes the value of " &
+                             "input parameter");
+                end if;
+ 
+                return 100.0;
+           end F;
+ 
+      begin  -- (F)
+           I := 100.0;
+           J := F (I);
+      end;  -- (F)
+ 
+      --------------------------------------------------
+ 
+      Result;
+ 
+ end C620001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c620002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c620002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c620002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c620002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,509 ----
+ -- C620001.A
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    Check that elementary parameters are passed by copy.
+ --
+ --    Part 2: Integer, float, and access types, task and protected entries.
+ --
+ -- TEST DESCRIPTION:
+ --    Subtests are:
+ --        (A) Scalar parameters to task entries.
+ --        (B) Scalar parameters to protected entries.
+ --        (C) Access parameters to task entries.
+ --        (D) Access parameters to protected entries.
+ --
+ --    For all of these examples, we pass array elements indexed by dynamically
+ --    determined indexes. Doing this side-steps the check of 6.4.1(6.15/3) and
+ --    makes the test more realistic.
+ --
+ --    Note: This is based on legacy test C95072A.ADA (which was withdrawn).
+ --
+ -- CHANGE HISTORY:
+ --    22 Jul 1985 DAS Created test.
+ --    12 May 2020 RLB Revised so test cases are legal for Ada 2012, modernized
+ --                    objective, converted to modern format, added float 
+ --                    and protected cases.
+ 
+ with Report;
+ procedure C620002 is
+ 
+      use Report;
+ 
+ begin
+      Test ("C620002", "Check that elementary parameters are passed by copy," &
+                       " part 2 - task and protected entries");
+ 
+      --------------------------------------------------
+ 
+      declare  -- (A)
+ 
+           I,J,K : Natural := Report.Ident_Int (1); -- Index values.
+           Arr   : array (1 .. 4) of Integer;
+           E     : exception;
+ 
+           task TA is
+                entry EA (EI  : in     Integer;
+                          EO  :    out Integer;
+                          EIO : in out Integer);
+           end TA;
+ 
+           task body TA is
+ 
+                Tmp : Integer;
+ 
+           begin
+ 
+                accept EA (EI  : in     Integer;
+                           EO  :    out Integer;
+                           EIO : in out Integer) do
+ 
+                     Tmp := EI;     -- Save value of EI at accept.
+ 
+                     EO := 10;
+                     if EI /= Tmp then
+                          Failed ("Assignement to scalar out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - A");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EIO := EIO + 100;
+                     if EI /= Tmp then
+                          Failed ("Assignment to scalar in out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - A");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     Arr(I) := Arr(I) + 1;
+                     if EI /= Tmp then
+                          Failed ("Assignment to scalar actual " &
+                                  "parameter changes the value of " &
+                                  "input parameter - A");
+                     end if;
+  
+                     raise E;  -- Check exception handling.
+                end EA;
+ 
+           exception
+                when others => null;
+           end TA;
+ 
+      begin  -- (A)
+           Arr := (others => 0);
+           TA.EA (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - A");
+      exception
+           when E =>
+                if Arr(I) /= 1 then
+                     case Arr(I) is
+                          when 11  =>
+                               Failed ("Out actual scalar parameter " &
+                                       "changed global value - A");
+                          when 101 =>
+                               Failed ("In out actual scalar " &
+                                       "parameter changed global value - A");
+                          when 111 =>
+                               Failed ("Out and in out actual scalar " &
+                                       "parameters changed global " &
+                                       "value - A");
+                          when others =>
+                               Failed ("Undetermined change to global " &
+                                       "value - A");
+                     end case;
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - A");
+      end;  -- (A)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (B)
+ 
+           I,J,K : Natural := Report.Ident_Int (3); -- Index values.
+           Arr   : array (1 .. 5) of Integer;
+           E     : exception;
+ 
+           protected PA is
+                entry EA (EI  : in     Integer;
+                          EO  :    out Integer;
+                          EIO : in out Integer);
+           end PA;
+ 
+           protected body PA is
+ 
+                entry EA (EI  : in     Integer;
+                          EO  :    out Integer;
+                          EIO : in out Integer) when True is
+ 
+                    Tmp : Integer;
+ 
+                begin
+ 
+                     Tmp := EI;     -- Save value of EI at entry.
+ 
+                     EO := 10;
+                     if EI /= Tmp then
+                          Failed ("Assignement to scalar out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - B");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EIO := EIO + 100;
+                     if EI /= Tmp then
+                          Failed ("Assignment to scalar in out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - B");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     Arr(I) := Arr(I) + 1;
+                     if EI /= Tmp then
+                          Failed ("Assignment to scalar actual " &
+                                  "parameter changes the value of " &
+                                  "input parameter - B");
+                     end if;
+  
+                     raise E;  -- Check exception handling.
+                end EA;
+ 
+           end PA;
+ 
+      begin  -- (B)
+           Arr := (others => 0);
+           PA.EA (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - B");
+      exception
+           when E =>
+                if Arr(I) /= 1 then
+                     case Arr(I) is
+                          when 11  =>
+                               Failed ("Out actual scalar parameter " &
+                                       "changed global value - B");
+                          when 101 =>
+                               Failed ("In out actual scalar " &
+                                       "parameter changed global value - B");
+                          when 111 =>
+                               Failed ("Out and in out actual scalar " &
+                                       "parameters changed global " &
+                                       "value - B");
+                          when others =>
+                               Failed ("Undetermined change to global " &
+                                       "value - B");
+                     end case;
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - B");
+      end;  -- (B)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (C)
+ 
+           type Acctype is access Integer;
+ 
+           I,J,K : Natural := Report.Ident_Int (2); -- Index values.
+           Arr   : array (1 .. 5) of Acctype;
+           E     : exception;
+ 
+           task TB is
+                entry EB (EI  : in     Acctype;
+                          EO  :    out Acctype;
+                          EIO : in out Acctype);
+           end TB;
+ 
+           task body TB is
+ 
+                Tmp  : Acctype;
+ 
+           begin
+ 
+                accept EB (EI  : in     Acctype;
+                           EO  :    out Acctype;
+                           EIO : in out Acctype) do
+ 
+                     Tmp := EI;     -- Save value of EI at accept.
+ 
+                     Arr(I) := new Integer'(101);
+                     if EI /= Tmp then
+                          Failed ("Assignment to access actual " &
+                                  "parameter changes the value of " &
+                                  "input parameter - C");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EO := new Integer'(1);
+                     if EI /= Tmp then
+                          Failed ("Assignment to access out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - C");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EIO := new Integer'(10);
+                     if EI /= Tmp then
+                          Failed ("Assignment to access in out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - C");
+                     end if;
+ 
+                     raise E;  -- Check exception handling.
+               end EB;
+ 
+           exception
+                when others => null;
+           end TB;
+ 
+      begin  -- (C)
+           Arr(I) := new Integer'(100);
+           TB.EB (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - C");
+      exception
+           when E =>
+                if (Arr(I).all /= 101) then
+                     Failed ("Out or in out actual " &
+                             "parameter value changed despite " &
+                             "raised exception - C");
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - C");
+      end;  -- (C)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (D)
+ 
+           type Acctype is access Integer;
+ 
+           I,J,K : Natural := Report.Ident_Int (4); -- Index values.
+           Arr   : array (1 .. 6) of Acctype;
+           E     : exception;
+ 
+           protected PB is
+                entry EB (EI  : in     Acctype;
+                          EO  :    out Acctype;
+                          EIO : in out Acctype);
+           end PB;
+ 
+           protected body PB is
+ 
+                entry EB (EI  : in     Acctype;
+                          EO  :    out Acctype;
+                          EIO : in out Acctype) when True is
+ 
+                     Tmp  : Acctype;
+ 
+                begin
+                     Tmp := EI;     -- Save value of EI at entry.
+ 
+                     Arr(I) := new Integer'(101);
+                     if EI /= Tmp then
+                          Failed ("Assignment to access actual " &
+                                  "parameter changes the value of " &
+                                  "input parameter - D");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EO := new Integer'(1);
+                     if EI /= Tmp then
+                          Failed ("Assignment to access out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - D");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EIO := new Integer'(10);
+                     if EI /= Tmp then
+                          Failed ("Assignment to access in out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - D");
+                     end if;
+ 
+                     raise E;  -- Check exception handling.
+                end EB;
+ 
+           end PB;
+ 
+      begin  -- (D)
+           Arr(I) := new Integer'(100);
+           PB.EB (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - D");
+      exception
+           when E =>
+                if (Arr(I).all /= 101) then
+                     Failed ("Out or in out actual " &
+                             "parameter value changed despite " &
+                             "raised exception - D");
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - D");
+      end;  -- (D)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (E)
+ 
+           I,J,K : Natural := Report.Ident_Int (3); -- Index values.
+           Arr   : array (1 .. 3) of Float;
+           E     : exception;
+ 
+           task TC is
+                entry EC (EI  : in     Float;
+                          EO  :    out Float;
+                          EIO : in out Float);
+           end TC;
+ 
+           task body TC is
+ 
+                Tmp : Float;
+ 
+           begin
+ 
+                accept EC (EI  : in     Float;
+                           EO  :    out Float;
+                           EIO : in out Float) do
+ 
+                     Tmp := EI;     -- Save value of EI at accept.
+ 
+                     EO := 0.5;
+                     if EI /= Tmp then
+                          Failed ("Assignement to float out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - E");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EIO := EIO + 0.25;
+                     if EI /= Tmp then
+                          Failed ("Assignment to float in out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - E");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     Arr(I) := Arr(I) + 1.0;
+                     if EI /= Tmp then
+                          Failed ("Assignment to float actual " &
+                                  "parameter changes the value of " &
+                                  "input parameter - E");
+                     end if;
+  
+                     raise E;  -- Check exception handling.
+                end EC;
+ 
+           exception
+                when others => null;
+           end TC;
+ 
+      begin  -- (E)
+           Arr := (others => 0.0);
+           TC.EC (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - E");
+      exception
+           when E =>
+                if (Arr(I) /= 1.0) then
+                     Failed ("Out or in out actual procedure " &
+                             "parameter value changed despite " &
+                             "raised exception - E");
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - E");
+      end;  -- (E)
+ 
+      --------------------------------------------------
+ 
+      declare  -- (F)
+ 
+           I,J,K : Natural := Report.Ident_Int (6); -- Index values.
+           Arr   : array (1 .. 7) of Float;
+           E     : exception;
+ 
+           protected PC is
+                entry EC (EI  : in     Float;
+                          EO  :    out Float;
+                          EIO : in out Float);
+           end PC;
+ 
+           protected body PC is
+ 
+                entry EC (EI  : in     Float;
+                          EO  :    out Float;
+                          EIO : in out Float) when True is
+ 
+                     Tmp : Float;
+ 
+                begin
+ 
+                     Tmp := EI;     -- Save value of EI at entry.
+ 
+                     EO := 0.5;
+                     if EI /= Tmp then
+                          Failed ("Assignement to float out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - F");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     EIO := EIO + 0.25;
+                     if EI /= Tmp then
+                          Failed ("Assignment to float in out " &
+                                  "parameter changes the value of " &
+                                  "input parameter - F");
+                          Tmp := EI;     -- Reset Tmp for next case.
+                     end if;
+ 
+                     Arr(I) := Arr(I) + 1.0;
+                     if EI /= Tmp then
+                          Failed ("Assignment to float actual " &
+                                  "parameter changes the value of " &
+                                  "input parameter - F");
+                     end if;
+  
+                     raise E;  -- Check exception handling.
+                end EC;
+ 
+           end PC;
+ 
+      begin  -- (F)
+           Arr := (others => 0.0);
+           PC.EC (Arr(I), Arr(J), Arr(K));
+           Failed ("Exception not raised - F");
+      exception
+           when E =>
+                if (Arr(I) /= 1.0) then
+                     Failed ("Out or in out actual procedure " &
+                             "parameter value changed despite " &
+                             "raised exception - F");
+                end if;
+           when others =>
+                Failed ("Wrong exception raised - F");
+      end;  -- (F)
+ 
+      --------------------------------------------------
+ 
+      Result;
+ 
+ end C620002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,190 ----
+ -- C62002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE COMPONENTS OF ACCESS IN PARAMETERS CAN BE USED AS THE
+ --   TARGET OF AN ASSIGNMENT STATEMENT OR AS AN ACTUAL PARAMETER OF
+ --   ANY MODE.  SUBTESTS ARE:
+ --        (A) INTEGER ACCESS TYPE.
+ --        (B) ARRAY ACCESS TYPE.
+ --        (C) RECORD ACCESS TYPE.
+ 
+ -- DAS  1/23/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C62002A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C62002A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS" &
+                       " MAY BE USED IN ASSIGNMENT CONTEXTS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE   -- (A)
+ 
+           TYPE PTRINT IS ACCESS INTEGER;
+           PI   : PTRINT;
+ 
+           PROCEDURE PROCA (PI : IN PTRINT) IS
+ 
+                PROCEDURE PROCA1 (I : OUT INTEGER) IS
+                BEGIN
+                     I := 7;
+                END PROCA1;
+ 
+                PROCEDURE PROCA2 (I : IN OUT INTEGER) IS
+                BEGIN
+                     I := I + 1;
+                END PROCA2;
+           BEGIN
+ 
+                PROCA1 (PI.ALL);
+                PROCA2 (PI.ALL);
+                PI.ALL := PI.ALL + 1;
+                IF (PI.ALL /= 9) THEN
+                     FAILED ("ASSIGNMENT TO COMPONENT OF INTEGER" &
+                             " ACCESS PARAMETER FAILED");
+                END IF;
+           END PROCA;
+ 
+      BEGIN     -- (A)
+ 
+           PI := NEW INTEGER '(0);
+           PROCA (PI);
+ 
+      END;      -- (A)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (B)
+ 
+           TYPE TBL IS ARRAY (1..3) OF INTEGER;
+           TYPE PTRTBL IS ACCESS TBL;
+           PT   : PTRTBL;
+ 
+           PROCEDURE PROCB (PT : IN PTRTBL) IS
+ 
+                PROCEDURE PROCB1 (I : OUT INTEGER) IS
+                BEGIN
+                     I := 7;
+                END  PROCB1;
+ 
+                PROCEDURE PROCB2 (I : IN OUT INTEGER) IS
+                BEGIN
+                     I := I + 1;
+                END PROCB2;
+ 
+                PROCEDURE PROCB3 (T : OUT TBL) IS
+                BEGIN
+                     T := (1,2,3);
+                END PROCB3;
+ 
+                PROCEDURE PROCB4 (T : IN OUT TBL) IS
+                BEGIN
+                     T(3) := T(3) - 1;
+                END PROCB4;
+ 
+           BEGIN
+ 
+                PROCB3 (PT.ALL);         -- (1,2,3)
+                PROCB4 (PT.ALL);         -- (1,2,2)
+                PROCB1 (PT(2));          -- (1,7,2)
+                PROCB2 (PT(1));          -- (2,7,2)
+                PT(3) := PT(3) + 7;      -- (2,7,9)
+                IF (PT.ALL /= (2,7,9)) THEN
+                     FAILED ("ASSIGNMENT TO COMPONENT OF ARRAY" &
+                             " ACCESS PARAMETER FAILED");
+                END IF;
+           END PROCB;
+ 
+      BEGIN     -- (B)
+ 
+           PT := NEW TBL '(0,0,0);
+           PROCB (PT);
+ 
+      END;      -- (B)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (C)
+ 
+           TYPE REC IS
+                RECORD
+                     I1   : INTEGER;
+                     I2   : INTEGER;
+                     I3   : INTEGER;
+                END RECORD;
+           TYPE PTRREC IS ACCESS REC;
+           PR   : PTRREC;
+ 
+           PROCEDURE PROCC (PR : IN PTRREC) IS
+ 
+                PROCEDURE PROCC1 (I : OUT INTEGER) IS
+                BEGIN
+                     I := 7;
+                END  PROCC1;
+ 
+                PROCEDURE PROCC2 (I : IN OUT INTEGER) IS
+                BEGIN
+                     I := I + 1;
+                END PROCC2;
+ 
+                PROCEDURE PROCC3 (R : OUT REC) IS
+                BEGIN
+                     R := (1,2,3);
+                END PROCC3;
+ 
+                PROCEDURE PROCC4 (R : IN OUT REC) IS
+                BEGIN
+                     R.I3 := R.I3 - 1;
+                END PROCC4;
+ 
+           BEGIN
+ 
+                PROCC3 (PR.ALL);         -- (1,2,3)
+                PROCC4 (PR.ALL);         -- (1,2,2)
+                PROCC1 (PR.I2);          -- (1,7,2)
+                PROCC2 (PR.I1);          -- (2,7,2)
+                PR.I3 := PR.I3 + 7;      -- (2,7,9)
+                IF (PR.ALL /= (2,7,9)) THEN
+                     FAILED ("ASSIGNMENT TO COMPONENT OF RECORD" &
+                             " ACCESS PARAMETER FAILED");
+                END IF;
+           END PROCC;
+ 
+      BEGIN     -- (C)
+ 
+           PR := NEW REC '(0,0,0);
+           PROCC (PR);
+ 
+      END;      -- (C)
+ 
+      ---------------------------------------------
+ 
+      RESULT;
+ 
+ END C62002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,234 ----
+ -- C62003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SCALAR AND ACCESS PARAMETERS ARE COPIED.
+ --   SUBTESTS ARE:
+ --        (A) SCALAR PARAMETERS TO PROCEDURES.
+ --        (B) SCALAR PARAMETERS TO FUNCTIONS.
+ --        (C) ACCESS PARAMETERS TO PROCEDURES.
+ --        (D) ACCESS PARAMETERS TO FUNCTIONS.
+ 
+ -- DAS 01/14/80
+ -- SPS 10/26/82
+ -- CPP 05/25/84
+ -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ 
+ WITH REPORT;
+ PROCEDURE C62003A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C62003A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
+                       "COPIED");
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           I    : INTEGER;
+           E    : EXCEPTION;
+ 
+           PROCEDURE P (PI : IN INTEGER;  PO : OUT INTEGER;
+                        PIO : IN OUT INTEGER) IS
+ 
+                TMP  : INTEGER;
+ 
+           BEGIN
+ 
+                TMP := PI;     -- SAVE VALUE OF PI AT PROC ENTRY.
+ 
+                PO := 10;
+                IF (PI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO SCALAR OUT " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
+                END IF;
+ 
+                PIO := PIO + 100;
+                IF (PI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
+                END IF;
+ 
+                I := I + 1;
+                IF (PI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                END IF;
+ 
+                RAISE E;  -- CHECK EXCEPTION HANDLING.
+           END P;
+ 
+      BEGIN  -- (A)
+           I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
+           P (I, I, I);
+           FAILED ("EXCEPTION NOT RAISED - A");
+      EXCEPTION
+           WHEN E =>
+                IF (I /= 1) THEN
+                     CASE I IS
+                          WHEN 11  =>
+                               FAILED ("OUT ACTUAL SCALAR PARAMETER " &
+                                       "CHANGED GLOBAL VALUE");
+                          WHEN 101 =>
+                               FAILED ("IN OUT ACTUAL SCALAR " &
+                                       "PARAMETER CHANGED GLOBAL VALUE");
+                          WHEN 111 =>
+                               FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
+                                       "PARAMETERS CHANGED GLOBAL " &
+                                       "VALUE");
+                          WHEN OTHERS =>
+                               FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
+                                       "VALUE");
+                     END CASE;
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - A");
+      END;  -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           I,J  : INTEGER;
+ 
+           FUNCTION F (FI : IN INTEGER) RETURN INTEGER IS
+ 
+                TMP  : INTEGER := FI;
+ 
+           BEGIN
+ 
+                I := I + 1;
+                IF (FI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO SCALAR ACTUAL FUNCTION " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                END IF;
+ 
+                RETURN (100);
+           END F;
+ 
+      BEGIN  -- (B)
+           I := 100;
+           J := F(I);
+      END;  -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (C)
+ 
+           TYPE ACCTYPE IS ACCESS INTEGER;
+ 
+           I    : ACCTYPE;
+           E    : EXCEPTION;
+ 
+           PROCEDURE P (PI : IN ACCTYPE;  PO : OUT ACCTYPE;
+                        PIO : IN OUT ACCTYPE) IS
+ 
+                TMP  : ACCTYPE;
+ 
+           BEGIN
+ 
+                TMP := PI;     -- SAVE VALUE OF PI AT PROC ENTRY.
+ 
+                I := NEW INTEGER'(101);
+                IF (PI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
+                END IF;
+ 
+                PO := NEW INTEGER'(1);
+                IF (PI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO ACCESS OUT " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                     TMP := PI;     -- RESET TMP FOR NEXT CASE.
+                END IF;
+ 
+                PIO := NEW INTEGER'(10);
+                IF (PI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                END IF;
+ 
+                RAISE E;  -- CHECK EXCEPTION HANDLING.
+           END P;
+ 
+      BEGIN  -- (C)
+           I := NEW INTEGER'(100);
+           P (I, I, I);
+           FAILED ("EXCEPTION NOT RAISED - C");
+      EXCEPTION
+           WHEN E =>
+                IF (I.ALL /= 101) THEN
+                     FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
+                             "PARAMETER VALUE CHANGED DESPITE " &
+                             "RAISED EXCEPTION");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - C");
+      END;  -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (D)
+ 
+           TYPE ACCTYPE IS ACCESS INTEGER;
+ 
+           I,J  : ACCTYPE;
+ 
+           FUNCTION F (FI : IN ACCTYPE) RETURN ACCTYPE IS
+ 
+                TMP  : ACCTYPE := FI;
+ 
+           BEGIN
+ 
+                I := NEW INTEGER;
+                IF (FI /= TMP) THEN
+                     FAILED ("ASSIGNMENT TO ACCESS ACTUAL FUNCTION " &
+                             "PARAMETER CHANGES THE VALUE OF " &
+                             "INPUT PARAMETER");
+                END IF;
+ 
+                RETURN (NULL);
+           END F;
+ 
+      BEGIN  -- (D)
+           I := NULL;
+           J := F(I);
+      END;  -- (D)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C62003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62003b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62003b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62003b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,301 ----
+ -- C62003B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
+ --   PASSED BY COPY.
+ --   SUBTESTS ARE:
+ --        (A) PRIVATE SCALAR PARAMETERS TO PROCEDURES.
+ --        (B) PRIVATE SCALAR PARAMETERS TO FUNCTIONS.
+ --        (C) PRIVATE ACCESS PARAMETERS TO PROCEDURES.
+ --        (D) PRIVATE ACCESS PARAMETERS TO FUNCTIONS.
+ 
+ -- CPP 05/25/84
+ -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C62003B IS
+ 
+ BEGIN
+      TEST("C62003B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
+                      "PARAMETERS ARE COPIED");
+ 
+      ---------------------------------------------------
+ 
+ A_B: DECLARE
+ 
+           PACKAGE SCALAR_PKG IS
+ 
+                TYPE T IS PRIVATE;
+                C0 : CONSTANT T;
+                C1 : CONSTANT T;
+                C10 : CONSTANT T;
+                C100 : CONSTANT T;
+ 
+                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
+                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
+ 
+           PRIVATE
+                TYPE T IS NEW INTEGER;
+                C0 : CONSTANT T := 0;
+                C1 : CONSTANT T := 1;
+                C10 : CONSTANT T := 10;
+                C100 : CONSTANT T := 100;
+ 
+           END SCALAR_PKG;
+ 
+ 
+           PACKAGE BODY SCALAR_PKG IS
+ 
+                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
+                BEGIN     -- "+"
+                     RETURN T(INTEGER(OLD) + INTEGER(INCREMENT));
+                END "+";
+ 
+                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
+                BEGIN     -- CONVERT
+                     RETURN INTEGER(OLD_PRIVATE);
+                END CONVERT;
+ 
+           END SCALAR_PKG;
+ 
+           USE SCALAR_PKG;
+ 
+      ---------------------------------------------------
+ 
+      BEGIN     -- A_B
+ 
+       A : DECLARE
+ 
+                I : T;
+                E : EXCEPTION;
+ 
+                PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
+ 
+                     TEMP : T;
+ 
+                BEGIN  -- P
+ 
+                     TEMP := PI;    -- SAVE VALUE OF PI AT PROC ENTRY.
+ 
+                     PO := C10;
+                     IF (PI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) OUT " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                     END IF;
+ 
+                     PIO := PIO + C100;
+                     IF (PI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) IN " &
+                                  "OUT PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                     END IF;
+ 
+                     I := I + C1;
+                     IF (PI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
+                                  "ACTUAL PARAMETER CHANGES THE " &
+                                  "VALUE OF INPUT PARAMETER");
+                     END IF;
+ 
+                     RAISE E;  -- CHECK EXCEPTION HANDLING.
+                END P;
+ 
+           BEGIN  -- A
+                I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
+                          -- DETECTED.
+                P (I, I, I);
+                FAILED ("EXCEPTION NOT RAISED - A");
+           EXCEPTION
+                WHEN E =>
+                     IF (I /= C1) THEN
+                          CASE CONVERT(I) IS
+                               WHEN 11 =>
+                                    FAILED ("OUT ACTUAL PRIVATE " &
+                                            "(SCALAR) PARAMETER " &
+                                            "CHANGED GLOBAL VALUE");
+                               WHEN 101 =>
+                                    FAILED ("IN OUT ACTUAL PRIVATE " &
+                                            "(SCALAR) PARAMETER " &
+                                            "CHANGED GLOBAL VALUE");
+                               WHEN 111 =>
+                                    FAILED ("OUT AND IN OUT ACTUAL " &
+                                            "PRIVATE (SCALAR) " &
+                                            "PARAMETER CHANGED " &
+                                            "GLOBAL VALUE");
+                               WHEN OTHERS =>
+                                    FAILED ("UNDETERMINED CHANGE TO " &
+                                            "GLOBAL VALUE");
+                          END CASE;
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - A");
+           END A;
+ 
+      ---------------------------------------------------
+ 
+       B : DECLARE
+ 
+                I, J : T;
+ 
+                FUNCTION F (FI : IN T) RETURN T IS
+ 
+                     TEMP : T := FI;  -- SAVE VALUE OF FI AT FN ENTRY.
+ 
+                BEGIN  -- F
+ 
+                     I := I + C1;
+                     IF (FI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
+                                  "ACTUAL FUNCTION PARAMETER CHANGES " &
+                                  "THE VALUE OF INPUT PARAMETER ");
+                     END IF;
+ 
+                     RETURN C0;
+                END F;
+ 
+           BEGIN  -- B
+                I := C0;
+                J := F(I);
+           END B;
+ 
+      END A_B;
+ 
+      ---------------------------------------------------
+ 
+ C_D: DECLARE
+ 
+           PACKAGE ACCESS_PKG IS
+ 
+                TYPE T IS PRIVATE;
+                C_NULL : CONSTANT T;
+                C1 : CONSTANT T;
+                C10 : CONSTANT T;
+                C100 : CONSTANT T;
+                C101 : CONSTANT T;
+ 
+           PRIVATE
+                TYPE T IS ACCESS INTEGER;
+                C_NULL : CONSTANT T := NULL;
+                C1 : CONSTANT T := NEW INTEGER'(1);
+                C10 : CONSTANT T := NEW INTEGER'(10);
+                C100 : CONSTANT T := NEW INTEGER'(100);
+                C101 : CONSTANT T := NEW INTEGER'(101);
+ 
+           END ACCESS_PKG;
+ 
+           USE ACCESS_PKG;
+ 
+      ---------------------------------------------------
+ 
+      BEGIN     -- C_D;
+ 
+       C : DECLARE
+ 
+                I : T;
+                E : EXCEPTION;
+                PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
+ 
+                     TEMP : T;
+ 
+                BEGIN     -- P
+ 
+                     TEMP := PI;    -- SAVE VALUE OF PI AT PROC ENTRY.
+ 
+                     I := C101;
+                     IF (PI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) " &
+                                  "ACTUAL VARIABLE CHANGES THE VALUE " &
+                                  "OF INPUT PARAMETER");
+                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                     END IF;
+ 
+                     PO := C1;
+                     IF (PI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) OUT " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                          TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                     END IF;
+ 
+                     PIO := C10;
+                     IF (PI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) IN " &
+                                  "OUT PARAMETER CHANGES THE VALUE " &
+                                  "OF INPUT PARAMETER");
+                     END IF;
+ 
+                     RAISE E;  -- CHECK EXCEPTION HANDLING.
+                END P;
+ 
+           BEGIN     -- C
+                I := C100;
+                P (I, I, I);
+                FAILED ("EXCEPTION NOT RAISED - C");
+           EXCEPTION
+                WHEN E =>
+                     IF (I /= C101) THEN
+                          FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
+                                  "PARAMETER VALUE CHANGED DESPITE " &
+                                  "RAISED EXCEPTION");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - C");
+           END C;
+ 
+      ---------------------------------------------------
+ 
+       D : DECLARE
+ 
+                I, J : T;
+ 
+                FUNCTION F (FI : IN T) RETURN T IS
+ 
+                     TEMP : T := FI;     -- SAVE VALUE OF FI AT FN ENTRY.
+ 
+                BEGIN     -- F
+                     I := C100;
+                     IF (FI /= TEMP) THEN
+                          FAILED ("ASSIGNMENT TO PRIVATE " &
+                                  "(ACCESS) ACTUAL FUNCTION " &
+                                  "PARAMETER CHANGES THE VALUE " &
+                                  "OF INPUT PARAMETER");
+                     END IF;
+                     RETURN C_NULL;
+                END F;
+ 
+            BEGIN     -- D
+                I := C_NULL;
+                J := F(I);
+           END D;
+ 
+      END C_D;
+ 
+      ---------------------------------------------------
+ 
+      RESULT;
+ 
+ END C62003B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C62004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALIASING IS PERMITTED FOR PARAMETERS OF COMPOSITE TYPES,
+ --   E.G., THAT A MATRIX ADDITION PROCEDURE CAN BE CALLED WITH THREE
+ --   IDENTICAL ARGUMENTS.  (NOTE: ALIASING MAY NOT WORK FOR ARGUMENTS
+ --   TO ALL SUBROUTINES SINCE PARAMETER PASSING IS IMPLEMENTATION
+ --   DEPENDENT.  HOWEVER, THIS TEST IS NOT ERRONEOUS.)
+ 
+ -- DAS  1/26/81
+ 
+ WITH REPORT;
+ PROCEDURE C62004A IS
+ 
+      USE REPORT;
+ 
+      TYPE MATRIX IS ARRAY (1..3,1..3) OF INTEGER;
+ 
+      A    : MATRIX  := ((1,2,3),(4,5,6),(7,8,9));
+ 
+      PROCEDURE MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX) IS
+      BEGIN
+           FOR I IN 1..3 LOOP
+                FOR J IN 1..3 LOOP
+                     SUM(I,J) := X(I,J) + Y(I,J);
+                END LOOP;
+           END LOOP;
+      END MAT_ADD;
+ 
+ BEGIN
+ 
+      TEST ("C62004A", "CHECK THAT ALIASING IS PERMITTED FOR" &
+                       " PARAMETERS OF COMPOSITE TYPES");
+ 
+      MAT_ADD (A, A, A);
+ 
+      IF (A /= ((2,4,6),(8,10,12),(14,16,18))) THEN
+           FAILED ("THE RESULT OF THE MATRIX ADDITION IS INCORRECT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C62004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c62006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c62006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- C62006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE DISCRIMINANTS OF AN OUT FORMAL PARAMETER, AS WELL AS
+ -- THE DISCRIMINANTS OF THE SUBCOMPONENTS OF AN OUT FORMAL PARAMETER,
+ -- MAY BE READ INSIDE THE PROCEDURE.
+ 
+ -- SPS 2/17/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C62006A IS
+ BEGIN
+ 
+      TEST ("C62006A", "CHECK THAT THE DISCRIMINANTS OF AN OUT FORMAL " &
+            "PARAMETER CAN BE READ INSIDE THE PROCEDURE");
+ 
+      DECLARE
+ 
+           TYPE R1 (D1 : INTEGER) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           TYPE R2 (D2 : POSITIVE) IS RECORD
+                C : R1 (2);
+           END RECORD;
+ 
+           R : R2 (5);
+ 
+           PROCEDURE P (REC : OUT R2) IS
+           BEGIN
+ 
+                IF REC.D2 /= 5 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
+                             " OUT PARAMETER");
+                END IF;
+ 
+                IF REC.C.D1 /= 2 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                             " OF THE SUBCOMPONENT OF AN OUT PARAMETER");
+                END IF;
+           END P;
+ 
+      BEGIN
+           P (R);
+      END;
+ 
+      RESULT;
+ 
+ END C62006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c631001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c631001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c631001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c631001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- C631001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if different forms of a name are used in the default 
+ --      expression of a discriminant part, the selector may be an operator
+ --      symbol or a character literal.
+ --
+ -- TEST DESCRIPTION:
+ --      This transition test defines private types where their selectors in
+ --      the default expression of the discriminant parts at the full type 
+ --      declarations are an operator and a literal, respectively. 
+ --      The test also declares procedures that use an operator and a literal
+ --      as selectors in the formal parts. 
+ --
+ --      Inspired by B63102A.ADA.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      25 Mar 96   SAIC    Initial version for ACVC 2.1.
+ --      26 Feb 97   PWB.CTA Removed use of function called before elaboration
+ --!
+ 
+ with Report;
+ 
+ procedure C631001 is
+ 
+    package C631001_0 is 
+ 
+       type Int_Type is range 1 .. 100;
+       type Enu_Type is ('A', 'B', 'C', 'D');
+ 
+       type Private_Enu (D : Enu_Type := 'B')       is private;
+ 
+       function "+" (X, Y : Int_Type) return Int_Type;
+ 
+       procedure Int_Proc (P1 : in  Int_Type := "+" (10, 15);
+                           P2 : out Int_Type);
+                                     
+       procedure Enu_Proc (P1 : in  Enu_Type := 'C';
+                           P2 : out Enu_Type);
+ 
+    private
+ 
+       type Private_Enu (D : Enu_Type := C631001_0.'B') is              -- OK.
+         record
+            C2 : Enu_Type := D;
+         end record;
+ 
+       -----------------------------------------------------------------
+       PE_Obj  : C631001_0.Private_Enu;
+ 
+    end C631001_0;
+ 
+      --==================================================================--
+ 
+    package body C631001_0 is 
+ 
+       function "+" (X, Y : Int_Type) return Int_Type is
+       begin
+          return 10;
+       end "+";
+ 
+       -----------------------------------------------------------------
+       procedure Int_Proc (P1 : in  Int_Type := C631001_0."+" (10, 15); -- OK.
+                           P2 : out Int_Type) is
+                                     
+       begin
+          P2 := P1;
+       end Int_Proc;
+ 
+       -----------------------------------------------------------------
+       procedure Enu_Proc (P1 : in  Enu_Type := C631001_0.'C';          -- OK.
+                           P2 : out Enu_Type) is
+       begin
+          P2 := P1;
+       end Enu_Proc;
+ 
+       -----------------------------------------------------------------
+ 
+    end C631001_0;
+ 
+    ---------------------------------------------------------------------------
+    Int_Obj : C631001_0.Int_Type := 50;
+    Enu_Obj : C631001_0.Enu_Type := C631001_0.'D';
+ 
+    -- Direct visibility to operator symbols
+    use type C631001_0.Int_Type;
+    use type C631001_0.Enu_Type;
+ 
+ begin  -- main
+ 
+    Report.Test ("C631001", "Check that if different forms of a name are " &
+                 "used in the default expression of a discriminant part, " &
+                 "the selector may be an operator symbol or a character "  &
+                 "literal");
+ 
+    C631001_0.Int_Proc (P2 => Int_Obj);
+ 
+    if Int_Obj /= 10 then
+      Report.Failed ("Wrong result for Int_Obj");
+    end if;
+ 
+    C631001_0.Enu_Proc (P2 => Enu_Obj);
+ 
+    if Enu_Obj /= 'C' then
+      Report.Failed ("Wrong result for Enu_Obj");
+    end if;
+ 
+    Report.Result;
+ 
+ end C631001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c640001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c640001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c640001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c640001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,334 ----
+ -- C640001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the prefix of a subprogram call with an actual parameter
+ --      part may be an implicit dereference of an access-to-subprogram value.
+ --      Check that, for an access-to-subprogram type whose designated profile
+ --      contains parameters of a tagged generic formal type, an access-to-
+ --      subprogram value may designate dispatching and non-dispatching
+ --      operations, and that dereferences of such a value call the appropriate
+ --      subprogram.
+ --
+ -- TEST DESCRIPTION:
+ --      The test declares a tagged type (Table) with a dispatching operation
+ --      (Clear), as well as a derivative (Table2) which overrides that
+ --      operation. A subprogram with the same name and profile as Clear is
+ --      declared in a separate package -- it is therefore not a dispatching
+ --      operation of Table. For the purposes of the test, each version of Clear
+ --      modifies the components of its parameter in a unique way.
+ --
+ --      Additionally, an operation (Reset) of type Table is declared which
+ --      makes a re-dispatching call to Clear, i.e.,
+ --
+ --         procedure Reset (A: in out Table) is
+ --         begin
+ --            ...
+ --            Clear (Table'Class(A));  -- Re-dispatch based on tag of actual.
+ --            ...
+ --         end Reset;   
+ --
+ --      An access-to-subprogram type is declared within a generic package,
+ --      with a designated profile which declares a parameter of a generic
+ --      formal tagged private type.
+ --
+ --      The generic is instantiated with type Table. The instance defines an
+ --      array of access-to-subprogram values (which represents a table of
+ --      operations to be performed sequentially on a single operand).
+ --      Access values designating the dispatching version of Clear, the
+ --      non-dispatching version of Clear, and Reset (which re-dispatches to
+ --      Clear) are placed in this array.
+ --
+ --      In the instance, each subprogram in the array is called by implicitly
+ --      dereferencing the corresponding access value. For the dispatching and
+ --      non-dispatching versions of Clear, the actual parameter passed is of
+ --      type Table. For Reset, the actual parameter passed is a view conversion
+ --      of an object of type Table2 to type Table, i.e., Table(Table2_Obj).
+ --      Since the tag of the operand never changes, the call to Clear within
+ --      Reset should execute Table2's version of Clear.
+ --
+ --      The main program verifies that the appropriate version of Clear is
+ --      called in each case, by checking that the components of the actual are
+ --      updated as expected.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C640001_0 is
+ 
+    -- Data type artificial for testing purposes.
+ 
+    Row_Len : constant := 10;
+ 
+    T : constant Boolean := True;
+    F : constant Boolean := False;
+ 
+    type Row_Type is array (1 .. Row_Len) of Boolean;
+ 
+    function Is_True  (A : in Row_Type) return Boolean;
+    function Is_False (A : in Row_Type) return Boolean;
+ 
+ 
+    Init : constant Row_Type := (T, F, T, F, T, F, T, F, T, F);
+ 
+    type Table is tagged record                  -- Tagged type.
+       Row1 : Row_Type := Init;
+       Row2 : Row_Type := Init;
+    end record;
+ 
+    procedure Clear (A : in out Table);          -- Dispatching operation.
+ 
+    procedure Reset (A : in out Table);          -- Re-dispatching operation.
+ 
+    -- ...Other operations.
+ 
+ 
+    type Table2 is new Table with null record;   -- Extension of Table (but
+                                                 -- structurally identical).
+ 
+    procedure Clear (A : in out Table2);         -- Overrides parent's op.
+ 
+    -- ...Other operations.
+ 
+ 
+ end C640001_0;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body C640001_0 is
+ 
+    function Is_True (A : in Row_Type) return Boolean is
+    begin
+       for I in A'Range loop
+          if A(I) /= True then                  -- Return true if all elements
+             return False;                      -- of A are True.
+          end if;
+       end loop;
+       return True;
+    end Is_True;
+ 
+ 
+    function Is_False (A : in Row_Type) return Boolean is
+    begin
+       return A = Row_Type'(others => False);   -- Return true if all elements
+    end Is_False;                               -- of A are False.
+ 
+ 
+    procedure Clear (A : in out Table) is
+    begin
+       for I in Row_Type'Range loop             -- This version of Clear sets
+          A.Row1(I) := False;                   -- the elements of Row1 only
+       end loop;                                -- to False.
+    end Clear;
+ 
+ 
+    procedure Reset (A : in out Table) is
+    begin
+       Clear (Table'Class(A));                  -- Redispatch to appropriate
+       -- ... Other "reset" activities.         -- version of Clear.
+    end Reset;
+ 
+ 
+    procedure Clear (A : in out Table2) is
+    begin
+       for I in Row_Type'Range loop             -- This version of Clear sets
+          A.Row1(I) := True;                    -- the elements of Row1 only
+       end loop;                                -- to True.
+    end Clear;
+ 
+ 
+ end C640001_0;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with C640001_0;
+ package C640001_1 is
+ 
+    procedure Clear (T : in out C640001_0.Table);  -- Non-dispatching operation.
+ 
+ end C640001_1;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body C640001_1 is
+ 
+    procedure Clear (T : in out C640001_0.Table) is
+    begin
+       for I in C640001_0.Row_Type'Range loop   -- This version of Clear sets
+          T.Row2(I) := True;                    -- the elements of Row2 only
+       end loop;                                -- to True.
+    end Clear;
+ 
+ end C640001_1;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ -- This unit represents a support package for table-driven processing of
+ -- data objects. Process_Operand performs a set of operations are performed
+ -- sequentially on a single operand. Note that parameters are provided to
+ -- specify which subset of operations in the operations table are to be
+ -- performed (ordinarily these might be omitted, but the test requires that
+ -- each operation be called individually for a single operand).
+ 
+ generic
+    type Tag is tagged private;
+ package C640001_2 is
+ 
+    type Proc_Ptr is access procedure (P: in out Tag);
+ 
+    type Op_List is private;
+ 
+    procedure Add_Op (Op   : in     Proc_Ptr;                -- Add operation to
+                      List : in out Op_List);                -- to list of ops.
+ 
+    procedure Process_Operand (Operand  : in out Tag;        -- Execute a subset
+                               List     : in     Op_List;    -- of a list of
+                               First_Op : in     Positive;   -- operations using
+                               Last_Op  : in     Positive);  -- a given operand.
+ 
+    -- ...Other operations.
+ 
+ private
+    type Op_Array is array (1 .. 3) of Proc_Ptr;
+ 
+    type Op_List is record
+       Top : Natural := 0;
+       Ops : Op_Array;
+    end record;
+ end C640001_2;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body C640001_2 is
+ 
+    procedure Add_Op (Op   : in     Proc_Ptr;
+                      List : in out Op_List) is
+    begin
+       List.Top := List.Top + 1;  -- Artificial; no Constraint_Error protection.
+       List.Ops(List.Top) := Op;
+    end Add_Op;
+ 
+ 
+    procedure Process_Operand (Operand  : in out Tag;
+                               List     : in     Op_List;
+                               First_Op : in     Positive;
+                               Last_Op  : in     Positive) is
+    begin
+       for I in First_Op .. Last_Op loop
+          List.Ops(I)(Operand);       -- Implicit dereference of an
+       end loop;                      -- access-to-subprogram value.
+    end Process_Operand;
+ 
+ end C640001_2;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with C640001_0;
+ with C640001_1;
+ with C640001_2;
+ 
+ with Report;
+ procedure C640001 is
+ 
+    package Table_Support is new C640001_2 (C640001_0.Table);
+ 
+    Sub_Ptr   : Table_Support.Proc_Ptr;
+    My_List   : Table_Support.Op_List;
+    My_Table1 : C640001_0.Table;             -- Initial values of both Row1 &
+                                             -- Row2 are (T,F,T,F,T,F,T,F,T,F).
+    My_Table2 : C640001_0.Table2;            -- Initial values of both Row1 &
+                                             -- Row2 are (T,F,T,F,T,F,T,F,T,F).
+ begin
+    Report.Test ("C640001", "Check that, for an access-to-subprogram type " &
+                            "whose designated profile contains parameters " &
+                            "of a tagged generic formal type, an access-" &
+                            "to-subprogram value may designate dispatching " &
+                            "and non-dispatching operations");
+ 
+    --
+    -- Add subprogram access values to list:
+    --
+ 
+    Sub_Ptr := C640001_0.Clear'Access;       -- Designates dispatching op.
+    Table_Support.Add_Op (Sub_Ptr, My_List); -- (1st operation on My_List).
+ 
+    Sub_Ptr := C640001_1.Clear'Access;       -- Designates non-dispatching op.
+    Table_Support.Add_Op (Sub_Ptr, My_List); -- (2nd operation on My_List).
+ 
+    Sub_Ptr := C640001_0.Reset'Access;       -- Designates re-dispatching op.
+    Table_Support.Add_Op (Sub_Ptr, My_List); -- (3rd operation on My_List).
+ 
+ 
+    --
+    -- Call dispatching operation:
+    --
+ 
+    Table_Support.Process_Operand (My_Table1, My_List, 1, 1);   -- Call 1st op.
+    
+    if not C640001_0.Is_False (My_Table1.Row1) then
+       Report.Failed ("Wrong result after calling dispatching operation");
+    end if;
+ 
+ 
+    --
+    -- Call non-dispatching operation:
+    --
+ 
+    Table_Support.Process_Operand (My_Table1, My_List, 2, 2);   -- Call 2nd op.
+    
+    if not C640001_0.Is_True (My_Table1.Row2) then
+       Report.Failed ("Wrong result after calling non-dispatching operation");
+    end if;
+ 
+ 
+    --
+    -- Call re-dispatching operation:
+    --
+ 
+    Table_Support.Process_Operand (C640001_0.Table(My_Table2),  -- View conv.
+                                   My_List, 3, 3);              -- Call 3rd op.
+    
+    if not C640001_0.Is_True (My_Table2.Row1) then
+       Report.Failed ("Wrong result after calling re-dispatching operation");
+    end if;
+ 
+ 
+    Report.Result;
+ end C640001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64002b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64002b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64002b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- C64002B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PARAMETERLESS SUBPROGRAMS CAN BE CALLED WITH APPROPRIATE
+ --   NOTATION.
+ 
+ -- DAS  1/27/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64002B IS
+ 
+      USE REPORT;
+ 
+      I    : INTEGER := 1;
+ 
+      FUNCTION F0 RETURN INTEGER IS
+      BEGIN
+           RETURN 7;
+      END F0;
+ 
+      PROCEDURE P0 IS
+      BEGIN
+           I := 15;
+      END P0;
+ 
+ BEGIN
+ 
+      TEST ("C64002B", "CHECK THAT PARAMETERLESS SUBPROGRAMS CAN BE" &
+                       " CALLED");
+ 
+      IF (F0 /= 7) THEN
+           FAILED ("PARAMETERLESS FUNCTION CALL RETURNS BAD VALUE");
+      END IF;
+ 
+      P0;
+      IF (I /= 15) THEN
+           FAILED ("PARAMETERLESS PROCEDURE CALL YIELDS INCORRECT" &
+                   " RESULT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C64002B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64004g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64004g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64004g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64004g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C64004G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR CALLS TO SUBPROGRAMS HAVING AT LEAST ONE DEFAULT
+ --   PARAMETER, THE CORRECT ASSOCIATION IS MADE BETWEEN ACTUAL AND
+ --   FORMAL PARAMETERS.
+ 
+ -- DAS  1/27/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C64004G IS
+ 
+      USE REPORT;
+ 
+      Y1,Y2,Y3  : INTEGER := 0;
+      O1,O2     : INTEGER := 0;
+ 
+      PROCEDURE P (I1: INTEGER; I2: INTEGER := 2; I3: INTEGER := 3;
+                   O1,O2,O3: OUT INTEGER) IS
+      BEGIN
+           O1 := I1;
+           O2 := I2;
+           O3 := I3;
+      END P;
+ 
+      FUNCTION F (I1: INTEGER := 1; I2: INTEGER) RETURN INTEGER IS
+      BEGIN
+           C64004G.O1 := I1;
+           C64004G.O2 := I2;
+           RETURN 1;
+      END F;
+ 
+ BEGIN
+ 
+      TEST ("C64004G", "CHECK ASSOCIATIONS BETWEEN ACTUAL AND FORMAL" &
+                       " PARAMETERS (HAVING DEFAULT VALUES)");
+ 
+      P (I1=>11, I2=>12, I3=>13, O1=>Y1, O2=>Y2, O3=>Y3);
+      IF (Y1 /= 11) OR (Y2 /= 12) OR (Y3 /= 13) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 1");
+      END IF;
+ 
+      P (I1=>21, O1=>Y1, O2=>Y2, O3=>Y3);
+      IF (Y1 /= 21) OR (Y2 /= 2) OR (Y3 /= 3) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 2");
+      END IF;
+ 
+      P (O1=>Y1, O3=>Y3, I1=>31, I3=>33, O2=>Y2);
+      IF (Y1 /= 31) OR (Y2 /= 2) OR (Y3 /= 33) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 3");
+      END IF;
+ 
+      P (41, 42, O1=>Y1, O2=>Y2, O3=>Y3);
+      IF (Y1 /= 41) OR (Y2 /= 42) OR (Y3 /= 3) THEN
+           FAILED ("INCORRECT PARANETER ASSOCIATION - 4");
+      END IF;
+ 
+      P (51, O3=>Y3, O1=>Y1, O2=>Y2, I3=>53);
+      IF (Y1 /= 51) OR (Y2 /= 2) OR (Y3 /= 53) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 5");
+      END IF;
+ 
+      Y1 := F (I1=>61, I2=>62);
+      IF (O1 /= 61) OR (O2 /= 62) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 6");
+      END IF;
+ 
+      Y2 := F (I2=>72, I1=>71);
+      IF (O1 /= 71) OR (O2 /= 72) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 7");
+      END IF;
+ 
+      Y3 := F (I2=>82);
+      IF (O1 /= 1) OR (O2 /= 82) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 8");
+      END IF;
+ 
+      RESULT;
+ 
+ END C64004G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C64005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SUBPROGRAM CAN BE CALLED
+ -- RECURSIVELY AND THAT NON-LOCAL VARIABLES AND 
+ -- CONSTANTS ARE PROPERLY ACCESSED FROM WITHIN
+ -- RECURSIVE INVOCATIONS.
+ 
+ -- CVP 5/1/81
+ 
+ WITH REPORT;
+ PROCEDURE C64005A IS
+ 
+      USE REPORT;
+ 
+      TWENTY : CONSTANT INTEGER := 20;
+      C1 : CONSTANT INTEGER := 1;
+      I1, I2 : INTEGER := 0;
+ 
+      PROCEDURE RECURSE (I1A : INTEGER; I2 : IN OUT INTEGER) IS
+           C1 : CONSTANT INTEGER := 5;
+      BEGIN
+           IF I1A < TWENTY THEN
+                RECURSE (I1A+C1, I2);
+                I1 := I1 + C64005A.C1;
+                I2 := I2 + I1A;
+           END IF;
+      END RECURSE;
+ 
+ BEGIN
+      TEST ("C64005A", "RECURSIVE SUBPROGRAMS WITH " &
+            "NON-LOCAL DATA ACCESS");
+ 
+      RECURSE (0, I2);
+ 
+      IF I1 /= 4 OR I2 /= 30 THEN
+           FAILED ("RECURSIVE PROCEDURE INVOCATIONS " &
+                   "WITH GLOBAL DATA ACCESS NOT PERFORMED " &
+                   "CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C64005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C64005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SUBPROGRAM CAN BE CALLED RECURSIVELY AND THAT NON-LOCAL
+ -- VARIABLES AND CONSTANTS ARE PROPERLY ACCESSED FROM WITHIN RECURSIVE
+ -- INVOCATIONS.
+ 
+ -- CPP 7/2/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64005B IS
+ 
+      COUNT : INTEGER := 0;
+      TWENTY : CONSTANT INTEGER := 20;
+      C1 : CONSTANT INTEGER := 1;
+      G1, G2, G3 : INTEGER := 0;
+      G4, G5 : INTEGER := 0;
+ 
+      PROCEDURE R (A1 : INTEGER; A2 : IN OUT INTEGER; A3 : OUT INTEGER)
+      IS
+           C1 : CONSTANT INTEGER := 5;
+           TEN : CONSTANT INTEGER := 10;
+           J1, J2 : INTEGER := 1;
+           J3 : INTEGER := 0;
+ 
+           PROCEDURE RECURSE (P1 : INTEGER; P2 : IN OUT INTEGER) IS
+                C1 : INTEGER := 2;
+           BEGIN     -- RECURSE
+                C1 := IDENT_INT (10);
+                IF P1 < TWENTY THEN
+                     RECURSE (P1 + C1, G2);
+                     G1 := G1 + C64005B.C1;
+                     G3 := G3 + P1;
+                     P2 := P2 + IDENT_INT(2);
+                     A2 := A2 + IDENT_INT(1);
+                     J2 := J2 + R.C1;
+                END IF;
+           END RECURSE;
+ 
+      BEGIN     -- R
+           IF A2 < TEN THEN
+                A2 := A2 + C1;
+                RECURSE (0, J1);
+                J3 := J3 + TEN;
+                COUNT := COUNT + 1;
+                COMMENT ("ON PASS # " & INTEGER'IMAGE(COUNT));
+                COMMENT ("VALUE OF A2 IS " & INTEGER'IMAGE(A2));
+                COMMENT ("VALUE OF J3 IS " & INTEGER'IMAGE(J3));
+                R (0, A2, J3);
+                J3 := J3 + A2;
+           END IF;
+           A3 := J1 + J3;
+      END R;
+ 
+ BEGIN
+      TEST("C64005B", "RECURSIVE SUBPROGRAMS WITH ALL KINDS " &
+           "OF DATA ACCESS");
+ 
+      R (0, G4, G5);
+ 
+      IF (COUNT /=  2) OR (G1 /=  4) OR
+         (G2    /=  4) OR (G3 /= 20) OR
+         (G4    /= 14) OR (G5 /= 35) THEN
+           FAILED ("RECURSIVE INVOCATIONS' DATA ACCESS IS NOT" &
+                   " WORKING CORRECTLY");
+      END IF;
+ 
+      COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
+      COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
+      COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
+      COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
+      COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
+      COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN PROGRAM_ERROR =>
+           FAILED ("PROGRAM_ERROR RAISED");
+           COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
+           COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
+           COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
+           COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
+           COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
+           COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
+           RESULT;
+ 
+ END C64005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,330 ----
+ -- C64005C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT
+ -- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM
+ -- WITHIN RECURSIVE INVOCATIONS.  THIS TEST CHECKS THAT EVERY DISPLAY OR
+ -- STATIC CHAIN LEVEL CAN BE ACCESSED.
+ 
+ -- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES.
+ 
+ -- JRK 7/26/84
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C64005C IS
+ 
+      SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C';
+      SUBTYPE CALL IS CHARACTER RANGE '1' .. '3';
+ 
+      MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) -
+                            LEVEL'POS (LEVEL'FIRST) + 1;
+      T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV +
+                                        MAX_LEV*(MAX_LEV+1)/2*2)) + 1;
+      G_LEN : CONSTANT := 2 + 4 * MAX_LEV;
+ 
+      TYPE TRACE IS
+           RECORD
+                E : NATURAL := 0;
+                S : STRING (1 .. T_LEN);
+           END RECORD;
+ 
+      V : CHARACTER := IDENT_CHAR ('<');
+      L : CHARACTER := IDENT_CHAR ('>');
+      T : TRACE;
+      G : STRING (1 .. G_LEN);
+ 
+      PROCEDURE C64005CA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+ 
+           V : STRING (1..2);
+ 
+           M : CONSTANT NATURAL := LEVEL'POS (L) -
+                                   LEVEL'POS (LEVEL'FIRST) + 1;
+           N : CONSTANT NATURAL := 2 * M + 1;
+ 
+           PROCEDURE C64005CB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+ 
+                V : STRING (1..2);
+ 
+                M : CONSTANT NATURAL := LEVEL'POS (L) -
+                                        LEVEL'POS (LEVEL'FIRST) + 1;
+                N : CONSTANT NATURAL := 2 * M + 1;
+ 
+                PROCEDURE C64005CC (L : LEVEL; C : CALL;
+                                    T : IN OUT TRACE) IS
+ 
+                     V : STRING (1..2);
+ 
+                     M : CONSTANT NATURAL := LEVEL'POS (L) -
+                                             LEVEL'POS (LEVEL'FIRST) + 1;
+                     N : CONSTANT NATURAL := 2 * M + 1;
+ 
+                BEGIN
+ 
+                     V (1) := IDENT_CHAR (ASCII.LC_C);
+                     V (2) := C;
+ 
+                     -- APPEND ALL V TO T.
+                     T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
+                                             C64005CB.V & C64005CC.V;
+                     T.E := T.E + N;
+ 
+                     CASE C IS
+ 
+                          WHEN '1' =>
+                               C64005CA (IDENT_CHAR(LEVEL'FIRST),
+                                         IDENT_CHAR('2'), T);
+ 
+                          WHEN '2' =>
+                               C64005CC (L, IDENT_CHAR('3'), T);
+ 
+                          WHEN '3' =>
+                               -- APPEND MID-POINT SYMBOL TO T.
+                               T.S (T.E+1) := IDENT_CHAR ('=');
+                               T.E := T.E + 1;
+ 
+                               -- G := CATENATE ALL V, L, C;
+                               G := C64005C.V & C64005C.L &
+                                   C64005CA.V & C64005CA.L & C64005CA.C &
+                                   C64005CB.V & C64005CB.L & C64005CB.C &
+                                   C64005CC.V & C64005CC.L & C64005CC.C;
+                     END CASE;
+ 
+                     -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+                     T.S (T.E+1 .. T.E+N) := C64005CC.L & C64005CC.C &
+                                             C64005CB.L & C64005CB.C &
+                                             C64005CA.L & C64005CA.C &
+                                             C64005C.L;
+                     T.E := T.E + N;
+ 
+                END C64005CC;
+ 
+           BEGIN
+ 
+                V (1) := IDENT_CHAR (ASCII.LC_B);
+                V (2) := C;
+ 
+                -- APPEND ALL V TO T.
+                T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
+                                        C64005CB.V;
+                T.E := T.E + N;
+ 
+                CASE C IS
+ 
+                     WHEN '1' =>
+                          C64005CC (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+ 
+                     WHEN '2' =>
+                          C64005CB (L, IDENT_CHAR('3'), T);
+ 
+                     WHEN '3' =>
+                          C64005CC (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+                END CASE;
+ 
+                -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+                T.S (T.E+1 .. T.E+N) := C64005CB.L & C64005CB.C &
+                                        C64005CA.L & C64005CA.C &
+                                        C64005C.L;
+                T.E := T.E + N;
+ 
+           END C64005CB;
+ 
+      BEGIN
+ 
+           V (1) := IDENT_CHAR (ASCII.LC_A);
+           V (2) := C;
+ 
+           -- APPEND ALL V TO T.
+           T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V;
+           T.E := T.E + N;
+ 
+           CASE C IS
+ 
+                WHEN '1' =>
+                     C64005CB (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+ 
+                WHEN '2' =>
+                     C64005CA (L, IDENT_CHAR('3'), T);
+ 
+                WHEN '3' =>
+                     C64005CB (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+           END CASE;
+ 
+           -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+           T.S (T.E+1 .. T.E+N) := C64005CA.L & C64005CA.C & C64005C.L;
+           T.E := T.E + N;
+ 
+      END C64005CA;
+ 
+ BEGIN
+      TEST ("C64005C", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
+                       "PARAMETERS AT ALL LEVELS OF NESTED " &
+                       "RECURSIVE PROCEDURES ARE ACCESSIBLE");
+ 
+      -- APPEND V TO T.
+      T.S (T.E+1) := V;
+      T.E := T.E + 1;
+ 
+      C64005CA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T);
+ 
+      -- APPEND L TO T.
+      T.S (T.E+1) := L;
+      T.E := T.E + 1;
+ 
+      COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E));
+      COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E));
+      COMMENT ("GLOBAL SNAPSHOT IS: " & G);
+ 
+      -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY.
+ 
+      DECLARE
+           SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A ..
+                CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1);
+ 
+           CT : TRACE;
+           CG : STRING (1 .. G_LEN);
+      BEGIN
+           COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " &
+                    INTEGER'IMAGE(T_LEN));
+ 
+           IF T.E /= IDENT_INT (T_LEN) THEN
+                FAILED ("WRONG FINAL CALL TRACE LENGTH");
+ 
+           ELSE CT.S (CT.E+1) := '<';
+                CT.E := CT.E + 1;
+ 
+                FOR I IN LC_LEVEL LOOP
+                     CT.S (CT.E+1) := '<';
+                     CT.E := CT.E + 1;
+ 
+                     FOR J IN LC_LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '1';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+                END LOOP;
+ 
+                FOR I IN LC_LEVEL LOOP
+                     CT.S (CT.E+1) := '<';
+                     CT.E := CT.E + 1;
+ 
+                     FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := I;
+                     CT.S (CT.E+2) := '2';
+                     CT.E := CT.E + 2;
+ 
+                     CT.S (CT.E+1) := '<';
+                     CT.E := CT.E + 1;
+ 
+                     FOR J IN LC_LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+                END LOOP;
+ 
+                CT.S (CT.E+1) := '=';
+                CT.E := CT.E + 1;
+ 
+                FOR I IN REVERSE LEVEL LOOP
+                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := '>';
+                     CT.E := CT.E + 1;
+ 
+                     CT.S (CT.E+1) := I;
+                     CT.S (CT.E+2) := '2';
+                     CT.E := CT.E + 2;
+ 
+                     FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := '>';
+                     CT.E := CT.E + 1;
+                END LOOP;
+ 
+                FOR I IN REVERSE LEVEL LOOP
+                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '1';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := '>';
+                     CT.E := CT.E + 1;
+                END LOOP;
+ 
+                CT.S (CT.E+1) := '>';
+                CT.E := CT.E + 1;
+ 
+                IF CT.E /= IDENT_INT (T_LEN) THEN
+                     FAILED ("WRONG ITERATIVE TRACE LENGTH");
+ 
+                ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S);
+ 
+                     IF T.S /= CT.S THEN
+                          FAILED ("WRONG FINAL CALL TRACE");
+                     END IF;
+                END IF;
+           END IF;
+ 
+           DECLARE
+                E : NATURAL := 0;
+           BEGIN
+                CG (1..2) := "<>";
+                E := E + 2;
+ 
+                FOR I IN LEVEL LOOP
+                     CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) -
+                                               LEVEL'POS(LEVEL'FIRST) +
+                                               LC_LEVEL'POS
+                                                       (LC_LEVEL'FIRST));
+                     CG (E+2) := '3';
+                     CG (E+3) := I;
+                     CG (E+4) := '3';
+                     E := E + 4;
+                END LOOP;
+ 
+                COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG);
+ 
+                IF G /= CG THEN
+                     FAILED ("WRONG GLOBAL SNAPSHOT");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END C64005C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005d0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005d0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005d0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,219 ----
+ -- C64005D0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT
+ -- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM
+ -- WITHIN RECURSIVE INVOCATIONS.  THIS TEST CHECKS THAT EVERY DISPLAY OR
+ -- STATIC CHAIN LEVEL CAN BE ACCESSED.
+ 
+ -- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES (SEPARATELY
+ -- COMPILED AS SUBUNITS).
+ 
+ -- SEPARATE FILES ARE:
+ --   C64005D0M THE MAIN PROCEDURE.
+ --   C64005DA  A RECURSIVE PROCEDURE SUBUNIT OF C64005D0M.
+ --   C64005DB  A RECURSIVE PROCEDURE SUBUNIT OF C64005DA.
+ --   C64005DC  A RECURSIVE PROCEDURE SUBUNIT OF C64005DB.
+ 
+ -- JRK 7/30/84
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C64005D0M IS
+ 
+      SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C';
+      SUBTYPE CALL IS CHARACTER RANGE '1' .. '3';
+ 
+      MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) -
+                            LEVEL'POS (LEVEL'FIRST) + 1;
+      T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV +
+                                        MAX_LEV*(MAX_LEV+1)/2*2)) + 1;
+      G_LEN : CONSTANT := 2 + 4 * MAX_LEV;
+ 
+      TYPE TRACE IS
+           RECORD
+                E : NATURAL := 0;
+                S : STRING (1 .. T_LEN);
+           END RECORD;
+ 
+      V : CHARACTER := IDENT_CHAR ('<');
+      L : CHARACTER := IDENT_CHAR ('>');
+      T : TRACE;
+      G : STRING (1 .. G_LEN);
+ 
+      PROCEDURE C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+           SEPARATE;
+ 
+ BEGIN
+      TEST ("C64005D", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
+                       "PARAMETERS AT ALL LEVELS OF NESTED " &
+                       "RECURSIVE PROCEDURES ARE ACCESSIBLE (FOR " &
+                       "3 LEVELS OF SEPARATELY COMPILED SUBUNITS)");
+ 
+      -- APPEND V TO T.
+      T.S (T.E+1) := V;
+      T.E := T.E + 1;
+ 
+      C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T);
+ 
+      -- APPEND L TO T.
+      T.S (T.E+1) := L;
+      T.E := T.E + 1;
+ 
+      COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E));
+      COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E));
+      COMMENT ("GLOBAL SNAPSHOT IS: " & G);
+ 
+      -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY.
+ 
+      DECLARE
+           SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A ..
+                CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1);
+ 
+           CT : TRACE;
+           CG : STRING (1 .. G_LEN);
+      BEGIN
+           COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " &
+                    INTEGER'IMAGE(T_LEN));
+ 
+           IF T.E /= IDENT_INT (T_LEN) THEN
+                FAILED ("WRONG FINAL CALL TRACE LENGTH");
+ 
+           ELSE CT.S (CT.E+1) := '<';
+                CT.E := CT.E + 1;
+ 
+                FOR I IN LC_LEVEL LOOP
+                     CT.S (CT.E+1) := '<';
+                     CT.E := CT.E + 1;
+ 
+                     FOR J IN LC_LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '1';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+                END LOOP;
+ 
+                FOR I IN LC_LEVEL LOOP
+                     CT.S (CT.E+1) := '<';
+                     CT.E := CT.E + 1;
+ 
+                     FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := I;
+                     CT.S (CT.E+2) := '2';
+                     CT.E := CT.E + 2;
+ 
+                     CT.S (CT.E+1) := '<';
+                     CT.E := CT.E + 1;
+ 
+                     FOR J IN LC_LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+                END LOOP;
+ 
+                CT.S (CT.E+1) := '=';
+                CT.E := CT.E + 1;
+ 
+                FOR I IN REVERSE LEVEL LOOP
+                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := '>';
+                     CT.E := CT.E + 1;
+ 
+                     CT.S (CT.E+1) := I;
+                     CT.S (CT.E+2) := '2';
+                     CT.E := CT.E + 2;
+ 
+                     FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '3';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := '>';
+                     CT.E := CT.E + 1;
+                END LOOP;
+ 
+                FOR I IN REVERSE LEVEL LOOP
+                     FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                          CT.S (CT.E+1) := J;
+                          CT.S (CT.E+2) := '1';
+                          CT.E := CT.E + 2;
+                     END LOOP;
+ 
+                     CT.S (CT.E+1) := '>';
+                     CT.E := CT.E + 1;
+                END LOOP;
+ 
+                CT.S (CT.E+1) := '>';
+                CT.E := CT.E + 1;
+ 
+                IF CT.E /= IDENT_INT (T_LEN) THEN
+                     FAILED ("WRONG ITERATIVE TRACE LENGTH");
+ 
+                ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S);
+ 
+                     IF T.S /= CT.S THEN
+                          FAILED ("WRONG FINAL CALL TRACE");
+                     END IF;
+                END IF;
+           END IF;
+ 
+           DECLARE
+                E : NATURAL := 0;
+           BEGIN
+                CG (1..2) := "<>";
+                E := E + 2;
+ 
+                FOR I IN LEVEL LOOP
+                     CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) -
+                                               LEVEL'POS(LEVEL'FIRST) +
+                                               LC_LEVEL'POS
+                                                       (LC_LEVEL'FIRST));
+                     CG (E+2) := '3';
+                     CG (E+3) := I;
+                     CG (E+4) := '3';
+                     E := E + 4;
+                END LOOP;
+ 
+                COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG);
+ 
+                IF G /= CG THEN
+                     FAILED ("WRONG GLOBAL SNAPSHOT");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END C64005D0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005da.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005da.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005da.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005da.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- C64005DA.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- JRK 7/30/84
+ 
+ SEPARATE (C64005D0M)
+ 
+ PROCEDURE C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+ 
+      V : STRING (1..2);
+ 
+      M : CONSTANT NATURAL := LEVEL'POS (L) -
+                              LEVEL'POS (LEVEL'FIRST) + 1;
+      N : CONSTANT NATURAL := 2 * M + 1;
+ 
+      PROCEDURE C64005DB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+           SEPARATE;
+ 
+ BEGIN
+ 
+      V (1) := IDENT_CHAR (ASCII.LC_A);
+      V (2) := C;
+ 
+      -- APPEND ALL V TO T.
+      T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V;
+      T.E := T.E + N;
+ 
+      CASE C IS
+ 
+           WHEN '1' =>
+                C64005DB (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+ 
+           WHEN '2' =>
+                C64005DA (L, IDENT_CHAR('3'), T);
+ 
+           WHEN '3' =>
+                C64005DB (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+      END CASE;
+ 
+      -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+      T.S (T.E+1 .. T.E+N) := C64005DA.L & C64005DA.C & C64005D0M.L;
+      T.E := T.E + N;
+ 
+ END C64005DA;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005db.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005db.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005db.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005db.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- C64005DB.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- JRK 7/30/84
+ 
+ SEPARATE (C64005D0M.C64005DA)
+ 
+ PROCEDURE C64005DB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+ 
+      V : STRING (1..2);
+ 
+      M : CONSTANT NATURAL := LEVEL'POS (L) -
+                              LEVEL'POS (LEVEL'FIRST) + 1;
+      N : CONSTANT NATURAL := 2 * M + 1;
+ 
+      PROCEDURE C64005DC (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+           SEPARATE;
+ 
+ BEGIN
+ 
+      V (1) := IDENT_CHAR (ASCII.LC_B);
+      V (2) := C;
+ 
+      -- APPEND ALL V TO T.
+      T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V & C64005DB.V;
+      T.E := T.E + N;
+ 
+      CASE C IS
+ 
+           WHEN '1' =>
+                C64005DC (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+ 
+           WHEN '2' =>
+                C64005DB (L, IDENT_CHAR('3'), T);
+ 
+           WHEN '3' =>
+                C64005DC (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+      END CASE;
+ 
+      -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+      T.S (T.E+1 .. T.E+N) := C64005DB.L & C64005DB.C &
+                              C64005DA.L & C64005DA.C &
+                              C64005D0M.L;
+      T.E := T.E + N;
+ 
+ END C64005DB;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005dc.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005dc.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64005dc.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64005dc.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C64005DC.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- JRK 7/30/84
+ 
+ SEPARATE (C64005D0M.C64005DA.C64005DB)
+ 
+ PROCEDURE C64005DC (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+ 
+      V : STRING (1..2);
+ 
+      M : CONSTANT NATURAL := LEVEL'POS (L) -
+                              LEVEL'POS (LEVEL'FIRST) + 1;
+      N : CONSTANT NATURAL := 2 * M + 1;
+ 
+ BEGIN
+ 
+      V (1) := IDENT_CHAR (ASCII.LC_C);
+      V (2) := C;
+ 
+      -- APPEND ALL V TO T.
+      T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V & C64005DB.V &
+                              C64005DC.V;
+      T.E := T.E + N;
+ 
+      CASE C IS
+ 
+           WHEN '1' =>
+                C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('2'), T);
+ 
+           WHEN '2' =>
+                C64005DC (L, IDENT_CHAR('3'), T);
+ 
+           WHEN '3' =>
+                -- APPEND MID-POINT SYMBOL TO T.
+                T.S (T.E+1) := IDENT_CHAR ('=');
+                T.E := T.E + 1;
+ 
+                -- G := CATENATE ALL V, L, C;
+                G := C64005D0M.V & C64005D0M.L &
+                     C64005DA.V & C64005DA.L & C64005DA.C &
+                     C64005DB.V & C64005DB.L & C64005DB.C &
+                     C64005DC.V & C64005DC.L & C64005DC.C;
+      END CASE;
+ 
+      -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+      T.S (T.E+1 .. T.E+N) := C64005DC.L & C64005DC.C &
+                              C64005DB.L & C64005DB.C &
+                              C64005DA.L & C64005DA.C &
+                              C64005D0M.L;
+      T.E := T.E + N;
+ 
+ END C64005DC;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c641001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c641001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c641001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c641001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,281 ----
+ -- C641001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that actual parameters passed by reference are view converted
+ --      to the nominal subtype of the formal parameter.
+ --
+ -- TEST DESCRIPTION:
+ --      Check that sliding is allowed for formal parameters, especially
+ --      check cases that would have caused errors in Ada'83.
+ --      Check that length check for a formal parameter (esp out mode)
+ --      is performed before the call, not after.
+ --
+ --  notes: 6.2; by reference ::= tagged, task, protected,
+ --                       limited (nonprivate), or composite containing such
+ --         4.6; view conversion
+ --
+ --
+ -- CHANGE HISTORY:
+ --      26 JAN 96   SAIC   Initial version
+ --      04 NOV 96   SAIC   Commentary revision for release 2.1
+ --      27 FEB 97   PWB.CTA Corrected reference to the wrong string
+ --!
+ 
+ ----------------------------------------------------------------- C641001_0
+ 
+ package C641001_0 is
+ 
+   subtype String_10 is String(1..10);
+ 
+   procedure Check_String_10( S : out String_10; Start, Stop: Natural );
+ 
+   procedure Check_Illegal_Slice_Reference( Slice_Passed : in out String;
+                                            Index: Natural );
+ 
+   type Tagged_Data(Bound: Natural) is tagged record
+     Data_Item : String(1..Bound) := (others => '*');
+   end record;
+ 
+   type Tag_List is array(Natural range <>) of Tagged_Data(5);
+ 
+   subtype Tag_List_10 is Tag_List(1..10);
+ 
+   procedure Check_Tag_Slice( TL : in out Tag_List_10 );
+ 
+   procedure Check_Out_Tagged_Data( Formal : out Tagged_Data );
+ 
+ end C641001_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with TCTouch;
+ package body C641001_0 is
+ 
+   String_Data : constant String := "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+ 
+   procedure Check_String_10( S : out String_10; Start, Stop: Natural ) is
+   begin
+     if S'Length /= 10 then
+       Report.Failed("Length check not performed prior to execution");
+     end if;
+     S := String_Data(Start..Stop);
+   exception
+     when others => Report.Failed("Exception encountered in Check_String_10");
+   end Check_String_10;
+ 
+   procedure Check_Illegal_Slice_Reference( Slice_Passed : in out String;
+                                            Index: Natural ) is
+   begin
+     -- essentially "do-nothing" for optimization foilage...
+     if Slice_Passed(Index) in Character then
+     -- Intent is    ^^^^^  should raise Constraint_Error
+       Report.Failed("Illegal Slice provided legal character");
+     else
+       Report.Failed("Illegal Slice provided illegal character");
+     end if;
+   exception
+     when Constraint_Error =>
+       null; -- expected case
+     when others =>
+       Report.Failed("Wrong exception in Check_Illegal_Slice_Reference");
+   end Check_Illegal_Slice_Reference;
+ 
+   procedure Check_Tag_Slice( TL : in out Tag_List_10 ) is
+     -- if the view conversion is not performed, one of the following checks
+     -- will fail (given data passed as 0..9 and then 2..11)
+   begin
+     Check_Under_Index:  -- index 0 should raise C_E
+     begin
+       TCTouch.Assert( TL(Report.Ident_Int(0)).Data_Item = "*****",
+                       "Index 0 (illegal); bad data" );
+       Report.Failed("Index 0 did not raise Constraint_Error");
+     exception
+       when Constraint_Error =>
+         null; -- expected case
+       when others =>
+         Report.Failed("Wrong exception in Check_Under_Index ");
+     end Check_Under_Index;
+ 
+     Check_Over_Index:  -- index 11 should raise C_E
+     begin
+       TCTouch.Assert( TL(Report.Ident_Int(11)).Data_Item = "*****",
+                       "Index 11 (illegal); bad data" );
+       Report.Failed("Index 11 did not raise Constraint_Error");
+     exception
+       when Constraint_Error =>
+         null; -- expected case
+       when others =>
+         Report.Failed("Wrong exception in Check_Over_Index ");
+     end Check_Over_Index;
+ 
+   end Check_Tag_Slice;
+ 
+   procedure Check_Out_Tagged_Data( Formal : out Tagged_Data ) is
+   begin
+     TCTouch.Assert( Formal.Data_Item = "*****", "out formal data bad" );
+     Formal.Data_Item(1) := '!';
+   end Check_Out_Tagged_Data;
+ 
+ end C641001_0;
+ 
+ ------------------------------------------------------------------- C641001
+ 
+ with Report;
+ with TCTouch;
+ with C641001_0;
+ procedure C641001 is
+ 
+   function II( I: Integer ) return Integer renames Report.Ident_Int;
+         -- ^^ name chosen to allow embedding in calls
+ 
+   A_String_10 : C641001_0.String_10;
+   Slicable    : String(1..40);
+   Tag_Slices  : C641001_0.Tag_List(0..11);
+ 
+   Global_Data : String(1..26) := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+ 
+   procedure Check_Out_Sliding( Lo1, Hi1, Lo2, Hi2 : Natural ) is
+ 
+     subtype One_Constrained_String is String(Lo1..Hi1);   -- 1  5
+     subtype Two_Constrained_String is String(Lo2..Hi2);   -- 6 10
+ 
+     procedure Out_Param( Param : out One_Constrained_String ) is
+     begin
+       Param := Report.Ident_Str( Global_Data(Lo2..Hi2) );
+     end Out_Param;
+     Object : Two_Constrained_String;
+   begin
+     Out_Param( Object );
+     if Object /= Report.Ident_Str( Global_Data(Lo2..Hi2) ) then
+       Report.Failed("Bad result in Check_Out_Sliding");
+     end if;
+   exception
+     when others => Report.Failed("Exception in Check_Out_Sliding");
+   end Check_Out_Sliding;
+ 
+   procedure Check_Dynamic_Subtype_Cases(F_Lower,F_Upper: Natural;
+                                         A_Lower,A_Upper: Natural) is
+ 
+     subtype Dyn_String is String(F_Lower..F_Upper);
+ 
+     procedure Check_Dyn_Subtype_Formal_Out( Param : out Dyn_String ) is
+     begin
+       Param := Global_Data(11..20);
+     end Check_Dyn_Subtype_Formal_Out;
+ 
+     procedure Check_Dyn_Subtype_Formal_In( Param : in Dyn_String ) is
+     begin
+       if Param /= Global_Data(11..20) then
+         Report.Failed("Dynamic case, data mismatch");
+       end if;
+     end Check_Dyn_Subtype_Formal_In;
+ 
+     Stuff: String(A_Lower..A_Upper);
+ 
+   begin
+     Check_Dyn_Subtype_Formal_Out( Stuff );
+     Check_Dyn_Subtype_Formal_In( Stuff );
+   end Check_Dynamic_Subtype_Cases;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C641001", "Check that actual parameters passed by " &
+                           "reference are view converted to the nominal " &
+                           "subtype of the formal parameter" );
+ 
+   -- non error cases for string slices
+ 
+   C641001_0.Check_String_10( A_String_10, 1, 10 );
+   TCTouch.Assert( A_String_10 = "1234567890", "Nominal case" );
+ 
+   C641001_0.Check_String_10( A_String_10, 11, 20 );
+   TCTouch.Assert( A_String_10 = "ABCDEFGHIJ", "Sliding to subtype" );
+ 
+   C641001_0.Check_String_10( Slicable(1..10), 1, 10 );
+   TCTouch.Assert( Slicable(1..10) = "1234567890", "Slice, no sliding" );
+ 
+   C641001_0.Check_String_10( Slicable(1..10), 21, 30 );
+   TCTouch.Assert( Slicable(1..10) = "KLMNOPQRST", "Sliding to slice" );
+ 
+   C641001_0.Check_String_10( Slicable(11..20), 11, 20 );
+   TCTouch.Assert( Slicable(11..20) = "ABCDEFGHIJ", "Sliding to same" );
+ 
+   C641001_0.Check_String_10( Slicable(21..30), 11, 20 );
+   TCTouch.Assert( Slicable(21..30) = "ABCDEFGHIJ", "Sliding up" );
+ 
+   -- error cases for string slices
+ 
+   C641001_0.Check_Illegal_Slice_Reference( Slicable(21..30), 20 );
+ 
+   C641001_0.Check_Illegal_Slice_Reference( Slicable(1..15), Slicable'Last );
+ 
+   -- checks for view converting actuals to formals
+ 
+   -- catch low bound fault
+   C641001_0.Check_Tag_Slice( Tag_Slices(II(0)..9) );     -- II ::= Ident_Int
+   TCTouch.Assert( Tag_Slices'First = 0, "Tag_Slices'First = 0" );
+   TCTouch.Assert( Tag_Slices'Last = 11, "Tag_Slices'Last = 11" );
+ 
+   -- catch high bound fault
+   C641001_0.Check_Tag_Slice( Tag_Slices(2..II(11)) );
+   TCTouch.Assert( Tag_Slices'First = 0, "Tag_Slices'First = 0" );
+   TCTouch.Assert( Tag_Slices'Last = 11, "Tag_Slices'Last = 11" );
+ 
+   Check_Formal_Association_Check:
+   begin
+     C641001_0.Check_String_10( Slicable, 1, 10 ); -- catch length fault
+     Report.Failed("Exception not raised at Check_Formal_Association_Check");
+   exception
+     when Constraint_Error =>
+       null; -- expected case
+     when others =>
+       Report.Failed("Wrong exception at Check_Formal_Association_Check");
+   end Check_Formal_Association_Check;
+ 
+   -- check for constrained actual, unconstrained formal
+   C641001_0.Check_Out_Tagged_Data( Tag_Slices(5) );
+   TCTouch.Assert( Tag_Slices(5).Data_Item = "!****",
+                   "formal out returned bad result" );
+ 
+   -- additional checks for out mode formal parameters, dynamic subtypes
+ 
+   Check_Out_Sliding( II(1),II(5), II(6),II(10) );
+ 
+   Check_Out_Sliding( 21,25, 6,10 );
+ 
+   Check_Dynamic_Subtype_Cases(F_Lower => II(1), F_Upper => II(10),
+                               A_Lower => II(1), A_Upper => II(10));
+ 
+   Check_Dynamic_Subtype_Cases(F_Lower => II(21), F_Upper => II(30),
+                               A_Lower => II( 1), A_Upper => II(10));
+ 
+   Check_Dynamic_Subtype_Cases(F_Lower => II( 1), F_Upper => II(10),
+                               A_Lower => II(21), A_Upper => II(30));
+ 
+   Report.Result;
+ 
+ end C641001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,379 ----
+ -- C64103B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT, FOR IN-OUT PARAMETERS OF A SCALAR TYPE,
+ --     CONSTRAINT_ERROR IS RAISED:
+ --          BEFORE A SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL
+ --          PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL PARAMETER'S
+ --          SUBTYPE;
+ --          AFTER A SUBPROGRAM CALL WHEN THE CONVERTED FORMAL PARAMETER
+ --          IS OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S SUBTYPE.
+ 
+ -- HISTORY:
+ --     CPP  07/18/84  CREATED ORIGINAL TEST.
+ --     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
+ --                    REFERENCED THE ACTUAL PARAMETERS IN THE SECOND
+ --                    SUBTEST.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64103B IS
+ BEGIN
+      TEST ("C64103B", "FOR IN-OUT PARAMETERS OF A SCALAR TYPE, " &
+                       "CONSTRAINT_ERROR IS RAISED:  BEFORE A " &
+                       "SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL " &
+                       "PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL " &
+                       "PARAMETER'S SUBTYPE;  AFTER A SUBPROGRAM " &
+                       "CALL WHEN THE CONVERTED FORMAL PARAMETER IS " &
+                       "OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S " &
+                       "SUBTYPE");
+ 
+ 
+      DECLARE
+           A0 : INTEGER := -9;
+           A1 : INTEGER := IDENT_INT(-1);
+           TYPE SUBINT IS RANGE -8 .. -2;
+ 
+           TYPE FLOAT_TYPE IS DIGITS 3 RANGE 0.0 .. 3.0;
+           A2 : FLOAT_TYPE := 0.12;
+           A3 : FLOAT_TYPE := 2.5;
+           TYPE NEW_FLOAT IS DIGITS 3 RANGE 1.0 .. 2.0;
+ 
+           TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
+           A4 : FIXED_TYPE := -2.0;
+           A5 : FIXED_TYPE := 4.0;
+           TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
+ 
+           A6 : CHARACTER := 'A';
+           SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
+ 
+           TYPE COLOR IS (RED, BURGUNDY, LILAC, MAROON, MAGENTA);
+           SUBTYPE A_COLOR IS COLOR RANGE RED..LILAC;
+           SUBTYPE B_COLOR IS COLOR RANGE MAROON..MAGENTA;
+           A7 : B_COLOR := MAROON;
+ 
+           PROCEDURE P1 (X : IN OUT SUBINT;
+                         S :        STRING) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (A" &
+                        S & ")");
+           END P1;
+ 
+           PROCEDURE P2 (X : IN OUT NEW_FLOAT;
+                         S :        STRING)     IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A" &
+                        S & ")");
+           END P2;
+ 
+           PROCEDURE P3 (X : IN OUT NEW_FIXED;
+                         S :        STRING)     IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P3 (A" &
+                        S & ")");
+           END P3;
+ 
+           PROCEDURE P4 (X : IN OUT SUPER_CHAR;
+                         S :        STRING)     IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P4 (A" &
+                         S & ")");
+           END P4;
+ 
+           PROCEDURE P5 (X : IN OUT A_COLOR;
+                         S :        STRING) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P5 (A" &
+                        S & ")");
+           END P5;
+      BEGIN
+           BEGIN
+                P1 (SUBINT (A0), "1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (A1)");
+           END;
+ 
+           BEGIN
+                P1 (SUBINT (A1), "2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (A2)");
+           END;
+ 
+           BEGIN
+                P2 (NEW_FLOAT (A2), "1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P2 (A1)");
+           END;
+ 
+           BEGIN
+                P2 (NEW_FLOAT (A3), "2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P2 (A2)");
+           END;
+ 
+           BEGIN
+                P3 (NEW_FIXED (A4), "1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P3 (A1)");
+           END;
+ 
+           BEGIN
+                P3 (NEW_FIXED (A5), "2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P3 (A2)");
+           END;
+ 
+           BEGIN
+                P4 (SUPER_CHAR (A6),"1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P4 (A1)");
+           END;
+ 
+           BEGIN
+                P5 (A_COLOR (A7), "1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P5 (A1)");
+           END;
+      END;
+ 
+ 
+      DECLARE
+           CALLED : BOOLEAN;
+           TYPE SUBINT IS RANGE -8 .. -2;
+           A0 : SUBINT := -3;
+           A1 : INTEGER := -9;
+           A2 : INTEGER := -1;
+ 
+           TYPE FLOAT IS DIGITS 3 RANGE -1.0 .. 2.0;
+           TYPE A_FLOAT IS DIGITS 3 RANGE 0.0 .. 1.0;
+           A3 : A_FLOAT := 1.0;
+           A4 : FLOAT := -0.5;
+           A5 : FLOAT := 1.5;
+ 
+           TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
+           A6 : NEW_FIXED := 0.0;
+           TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
+           A7 : FIXED_TYPE := -2.0;
+           A8 : FIXED_TYPE := 4.0;
+ 
+           SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
+           A9  : SUPER_CHAR := 'C';
+           A10 : CHARACTER := 'A';
+           A11 : CHARACTER := 'R';
+ 
+           PROCEDURE P1 (X : IN OUT INTEGER; Y : INTEGER) IS
+           BEGIN
+                CALLED := TRUE;
+                X := IDENT_INT (Y);
+           END P1;
+ 
+           PROCEDURE P2 (X : IN OUT FLOAT; Y : FLOAT) IS
+           BEGIN
+                CALLED := TRUE;
+                X := Y;
+           END P2;
+ 
+           PROCEDURE P3 ( X : IN OUT FIXED_TYPE; Y : FIXED_TYPE) IS
+           BEGIN
+                CALLED := TRUE;
+                X := Y;
+           END P3;
+ 
+           PROCEDURE P4 (X : IN OUT CHARACTER; Y : CHARACTER) IS
+           BEGIN
+                CALLED := TRUE;
+                X := IDENT_CHAR(Y);
+           END P4;
+      BEGIN
+           BEGIN
+                CALLED := FALSE;
+                P1 (INTEGER(A0), A1);
+                IF A0 = -3 THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P1 (B1)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
+           END;
+ 
+           BEGIN
+                CALLED := FALSE;
+                P1 (INTEGER(A0), A2);
+                IF A0 = -3 THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B3)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B4)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P1 (B2)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
+           END;
+ 
+           BEGIN
+                CALLED := FALSE;
+                P2 (FLOAT (A3), A4);
+                IF A3 = 1.0 THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P2 (B1)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P2 (B1)");
+           END;
+ 
+           BEGIN
+                CALLED := FALSE;
+                P2 (FLOAT (A3), A5);
+                IF A3 = 1.0 THEN
+                     FAILED ("EXCEPTION NOT RAISED -P2 (B3)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED -P2 (B4)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P2 (B2)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P2 (B2)");
+           END;
+ 
+           BEGIN
+                CALLED := FALSE;
+                P3 (FIXED_TYPE (A6), A7);
+                IF A6 = 0.0 THEN
+                     FAILED ("EXCEPTION NOT RAISED -P3 (B1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED -P3 (B2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P3 (B1)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P3 (B1)");
+           END;
+ 
+           BEGIN
+                CALLED := FALSE;
+                P3 (FIXED_TYPE (A6), A8);
+                IF A6 = 0.0 THEN
+                     FAILED ("EXCEPTION NOT RAISED -P3 (B3)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED -P3 (B4)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P3 (B2)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P3 (B2)");
+           END;
+ 
+           BEGIN
+                CALLED := FALSE;
+                P4 (CHARACTER (A9), A10);
+                IF A9 = 'C' THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P4 (B1)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P4 (B1)");
+           END;
+ 
+           BEGIN
+                CALLED := FALSE;
+                P4 (CHARACTER (A9), A11);
+                IF A9 = 'C' THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B3)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B4)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P4 (B2)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P4 (B2)");
+           END;
+      END;
+ 
+      RESULT;
+ END C64103B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,230 ----
+ -- C64103C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
+ -- ON IN OUT ARRAY PARAMETERS.  IN PARTICULAR:
+ --   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
+ --       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
+ --       CONSTRAINTS.
+ --   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
+ --       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+ --       OUTSIDE OF A FORMAL INDEX SUBTYPE FOR A NON-NULL DIMENSION (SEE
+ --       AI-00313 FOR MULTIDIMENSIONAL CASE)
+ --   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
+ --       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
+ --       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
+ --   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
+ --       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+ --       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- CPP 07/19/84
+ -- JBG 06/05/85
+ -- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --               AI-00387.
+ -- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64103C IS
+ 
+      BEGIN
+      TEST ("C64103C", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
+            "TYPE CONVERSIONS OF IN OUT ARRAY PARAMETERS");
+ 
+      -----------------------------------------------
+ 
+      DECLARE   -- (A)
+      BEGIN     -- (A)
+ 
+           DECLARE
+                TYPE SUBINT IS RANGE 0..8;
+                TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+                A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
+ 
+                PROCEDURE P2 (X : IN OUT ARRAY_TYPE) IS
+                BEGIN
+                     NULL;
+                END P2;
+           BEGIN
+                P2 (ARRAY_TYPE (A0));                  -- OK.
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED -P2 (A)");
+           END;
+ 
+      END; -- (A)
+ 
+      -----------------------------------------------
+ 
+      DECLARE   -- (B1) NON-NULL ACTUAL PARAMETER
+ 
+           TYPE SUBINT IS RANGE 0..8;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+           TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+           A1 : AR1 (-1..7) := (-1..7 => TRUE);
+           A2 : AR1 (1..9) := (1..9 => TRUE);
+ 
+           PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
+           END P1;
+ 
+      BEGIN     -- (B1)
+ 
+           BEGIN
+                COMMENT ("CALL TO P1 (B1) ON A1");
+                P1 (ARRAY_TYPE (A1));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
+           END;
+ 
+           BEGIN
+                COMMENT ("CALL TO P1 (B1) ON A2");
+                P1 (ARRAY_TYPE (A2));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
+           END;
+ 
+      END; -- (B1)
+ 
+      DECLARE   -- (B2) NULL ACTUAL PARAMETER; MULTIDIMENSIONAL
+ 
+           TYPE SUBINT IS RANGE 0..8;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>,
+                                     SUBINT RANGE <>) OF BOOLEAN;
+           TYPE AR1 IS ARRAY (INTEGER RANGE <>,
+                              INTEGER RANGE <>)OF BOOLEAN;
+           A1 : AR1 (IDENT_INT(-1)..7, 5..4) :=
+                                            (OTHERS => (OTHERS => TRUE));
+           A2 : AR1 (5..4, 1..IDENT_INT(9)) :=
+                                            (OTHERS => (OTHERS => TRUE));
+           PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
+           END P1;
+ 
+      BEGIN     -- (B2)
+ 
+           BEGIN
+                COMMENT ("CALL TO P1 (B2) ON A1");
+                P1 (ARRAY_TYPE (A1));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
+           END;
+ 
+           BEGIN
+                COMMENT ("CALL TO P1 (B2) ON A2");
+                P1 (ARRAY_TYPE (A2));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
+           END;
+ 
+      END; -- (B2)
+ 
+      -----------------------------------------------
+ 
+      BEGIN     -- (C)
+ 
+           DECLARE
+                TYPE INDEX1 IS RANGE 1..3;
+                TYPE INDEX2 IS RANGE 1..4;
+                TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
+                A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
+ 
+                TYPE I1 IS RANGE 1..4;
+                TYPE I2 IS RANGE 1..3;
+                TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
+ 
+                PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
+                BEGIN
+                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
+                END P1;
+           BEGIN
+                P1 (ARRAY_TYPE (A0));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
+           END;
+ 
+      END; -- (C)
+ 
+      -----------------------------------------------
+ 
+      DECLARE   -- (D)
+      BEGIN     -- (D)
+ 
+           DECLARE
+                TYPE SM_INT IS RANGE 0..2;
+                TYPE LG IS RANGE 0 .. SYSTEM.MAX_INT;
+                SUBTYPE LG_INT IS LG RANGE SYSTEM.MAX_INT - 3 ..
+                                           SYSTEM.MAX_INT;
+                TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
+                TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
+                A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
+                     (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
+ 
+                PROCEDURE P1 (X : IN OUT AR_SMALL) IS
+                BEGIN
+                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
+                END P1;
+           BEGIN
+                IF LG (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
+                     P1 (AR_SMALL (A0));
+                ELSE
+                     COMMENT ("NOT APPLICABLE -P1 (D)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
+           END;
+ 
+      END; -- (D)
+ 
+      -----------------------------------------------
+ 
+      RESULT;
+ 
+ END C64103C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,187 ----
+ -- C64103D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
+ -- ON OUT ARRAY PARAMETERS.  IN PARTICULAR:
+ --   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
+ --       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
+ --       CONSTRAINTS.
+ --   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
+ --       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+ --       OUTSIDE OF A FORMAL INDEX SUBTYPE.
+ --   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
+ --       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
+ --       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
+ --   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
+ --       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+ --       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- CPP 07/19/84
+ -- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+ --               AI-00387.
+ -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64103D IS
+ 
+      BEGIN
+      TEST ("C64103D", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
+            "TYPE CONVERSIONS OF OUT ARRAY PARAMETERS");
+ 
+      -----------------------------------------------
+ 
+      DECLARE   -- (A)
+      BEGIN     -- (A)
+ 
+           DECLARE
+                TYPE SUBINT IS RANGE 0..8;
+                TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+                A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
+ 
+                PROCEDURE P2 (X : OUT ARRAY_TYPE) IS
+                BEGIN
+                     NULL;
+                END P2;
+           BEGIN
+                P2 (ARRAY_TYPE (A0));                  -- OK.
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED -P2 (A)");
+           END;
+ 
+      END; -- (A)
+ 
+      -----------------------------------------------
+ 
+      DECLARE   -- (B)
+ 
+           TYPE SUBINT IS RANGE 0..8;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+           TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+           A1 : AR1 (-1..7) := (-1..7 => TRUE);
+           A2 : AR1 (1..9) := (1..9 => TRUE);
+ 
+           PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
+           END P1;
+ 
+      BEGIN     -- (B)
+ 
+           BEGIN
+                COMMENT ("CALL TO P1 (B) ON A1");
+                P1 (ARRAY_TYPE (A1));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
+           END;
+ 
+           BEGIN
+                COMMENT ("CALL TO P1 (B) ON A2");
+                P1 (ARRAY_TYPE (A2));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
+           END;
+ 
+      END; -- (B)
+ 
+      -----------------------------------------------
+ 
+      DECLARE   -- (C)
+      BEGIN     -- (C)
+ 
+           DECLARE
+                TYPE INDEX1 IS RANGE 1..3;
+                TYPE INDEX2 IS RANGE 1..4;
+                TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
+                A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
+ 
+                TYPE I1 IS RANGE 1..4;
+                TYPE I2 IS RANGE 1..3;
+                TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
+ 
+                PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
+                BEGIN
+                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
+                END P1;
+           BEGIN
+                P1 (ARRAY_TYPE (A0));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
+           END;
+ 
+      END; -- (C)
+ 
+      -----------------------------------------------
+ 
+      DECLARE   -- (D)
+      BEGIN     -- (D)
+ 
+           DECLARE
+                TYPE SM_INT IS RANGE 0..2;
+                TYPE LG_INT IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
+                TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
+                TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
+                A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
+                     (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
+ 
+                PROCEDURE P1 (X : OUT AR_SMALL) IS
+                BEGIN
+                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
+                END P1;
+           BEGIN
+                IF LG_INT (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
+                     P1 (AR_SMALL (A0));
+                ELSE
+                     COMMENT ("NOT APPLICABLE -P1 (D)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
+           END;
+ 
+      END; -- (D)
+ 
+      -----------------------------------------------
+ 
+      RESULT;
+ 
+ END C64103D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,219 ----
+ -- C64103E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT, FOR IN-OUT PARAMETERS OF AN ACCESS TYPE,
+ --     CONSTRAINT_ERROR IS RAISED:
+ --          BEFORE A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
+ --          OF THE ACTUAL DESIGNATED PARAMETER ARE DIFFERENT FROM
+ --          THOSE OF THE FORMAL DESIGNATED PARAMETER;
+ --          AFTER A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
+ --          OF THE FORMAL DESIGNATED PARAMETER ARE DIFFERENT FROM
+ --          THOSE OF THE ACTUAL DESIGNATED PARAMETER.
+ 
+ -- HISTORY:
+ --     CPP  07/23/84  CREATED ORIGINAL TEST.
+ --     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
+ --                    REFERENCED THE ACTUAL PARAMETERS IN THE SECOND
+ --                    SUBTEST.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64103E IS
+ BEGIN
+      TEST ("C64103E", "FOR IN-OUT PARAMETERS OF AN ACCESS TYPE, " &
+                       "CONSTRAINT_ERROR IS RAISED:  BEFORE A " &
+                       "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
+                       "DISCRIMINANTS OF THE ACTUAL DESIGNATED " &
+                       "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
+                       "FORMAL DESIGNATED PARAMETER;  AFTER A " &
+                       "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
+                       "DISCRIMINANTS OF THE FORMAL DESIGNATED " &
+                       "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
+                       "ACTUAL DESIGNATED PARAMETER");
+ 
+ 
+      BEGIN
+           DECLARE
+                TYPE AST IS ACCESS STRING;
+                SUBTYPE AST_3 IS AST(1..3);
+                SUBTYPE AST_5 IS AST(3..5);
+                X_3 : AST_3 := NEW STRING(1..IDENT_INT(3));
+ 
+                PROCEDURE P1 (X : IN OUT AST_5) IS
+                BEGIN
+                     FAILED("EXCEPTION NOT RAISED BEFORE CALL -P1 (A)");
+                END P1;
+           BEGIN
+                P1 (AST_5 (X_3));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (A)");
+           END;
+ 
+           DECLARE
+                TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+                TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
+                SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
+                TYPE A2_ARRAY IS NEW A_ARRAY (2..4);
+                A0 : A1_ARRAY := NEW ARRAY_TYPE (1..3);
+ 
+                PROCEDURE P2 (X : IN OUT A2_ARRAY) IS
+                BEGIN
+                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A)");
+                END P2;
+           BEGIN
+                P2 (A2_ARRAY (A0));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P2 (A)");
+           END;
+ 
+           DECLARE
+                TYPE SUBINT IS RANGE 0..8;
+                TYPE REC1 (DISC : SUBINT := 8) IS
+                     RECORD
+                          FIELD : SUBINT := DISC;
+                     END RECORD;
+                TYPE A1_REC IS ACCESS REC1;
+                TYPE A2_REC IS NEW A1_REC(3);
+                A0 : A1_REC := NEW REC1(4);
+ 
+                PROCEDURE P3 (X : IN OUT A2_REC) IS
+                BEGIN
+                     FAILED ("EXCEPTION NOT RAISED BEFORE CALL " &
+                             "-P3 (A)");
+                END P3;
+ 
+           BEGIN
+                P3 (A2_REC (A0));
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P3 (A)");
+           END;
+ 
+      END;
+ 
+ 
+      BEGIN
+           DECLARE
+                TYPE AST IS ACCESS STRING;
+                SUBTYPE AST_3 IS AST(IDENT_INT(1)..IDENT_INT(3));
+                X_3 : AST_3 := NEW STRING'(1..IDENT_INT(3) => 'A');
+                CALLED : BOOLEAN := FALSE;
+ 
+                PROCEDURE P1 (X : IN OUT AST) IS
+                BEGIN
+                     CALLED := TRUE;
+                     X := NEW STRING'(3..5 => 'C');
+                END P1;
+           BEGIN
+                P1 (AST (X_3));
+                IF X_3.ALL = STRING'(1 .. 3 => 'A') THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL" &
+                                  "-P1 (B)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
+           END;
+ 
+           DECLARE
+                TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+                TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
+                SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
+                A0 : A1_ARRAY := NEW ARRAY_TYPE'(1..3 => TRUE);
+                CALLED : BOOLEAN := FALSE;
+ 
+                PROCEDURE P2 (X : IN OUT A_ARRAY) IS
+                BEGIN
+                     CALLED := TRUE;
+                     X := NEW ARRAY_TYPE'(2..4 => FALSE);
+                END P2;
+           BEGIN
+                P2 (A_ARRAY (A0));
+                IF A0.ALL = ARRAY_TYPE'(1 .. 3 => TRUE) THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL" &
+                                  "-P1 (B)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P2 (B)");
+           END;
+ 
+           DECLARE
+                TYPE SUBINT IS RANGE 0..8;
+                TYPE REC1 (DISC : SUBINT := 8) IS
+                     RECORD
+                          FIELD : SUBINT := DISC;
+                     END RECORD;
+                TYPE A1_REC IS ACCESS REC1;
+                TYPE A2_REC IS NEW A1_REC;
+                A0 : A1_REC(4) := NEW REC1(4);
+                CALLED : BOOLEAN := FALSE;
+ 
+                PROCEDURE P3 (X : IN OUT A2_REC) IS
+                BEGIN
+                     CALLED := TRUE;
+                     X := NEW REC1;
+                END P3;
+ 
+           BEGIN
+                P3 (A2_REC (A0));
+                IF A0.ALL = REC1'(4,4) THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (B1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (B2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL" &
+                                  "-P1 (B)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P3 (B)");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ END C64103E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64103f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64103f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- C64103F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT, FOR OUT PARAMETERS OF AN ACCESS TYPE,
+ --     CONSTRAINT_ERROR IS RAISED:
+ --          AFTER A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
+ --          OF THE FORMAL DESIGNATED PARAMETER ARE DIFFERENT FROM
+ --          THOSE OF THE ACTUAL DESIGNATED PARAMETER.
+ 
+ -- HISTORY:
+ --     CPP  07/23/84  CREATED ORIGINAL TEST.
+ --     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
+ --                    REFERENCE THE ACTUAL PARAMETERS.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64103F IS
+ BEGIN
+      TEST ("C64103F", "FOR OUT PARAMETERS OF AN ACCESS TYPE, " &
+                       "CONSTRAINT_ERROR IS RAISED:  AFTER A " &
+                       "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
+                       "DISCRIMINANTS OF THE FORMAL DESIGNATED " &
+                       "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
+                       "ACTUAL DESIGNATED PARAMETER");
+ 
+ 
+      BEGIN
+           DECLARE
+                TYPE AST IS ACCESS STRING;
+                SUBTYPE AST_3 IS AST(IDENT_INT(1)..IDENT_INT(3));
+                SUBTYPE AST_5 IS AST(3..5);
+                X_3 : AST_3 := NEW STRING'(1..IDENT_INT(3) => 'A');
+                CALLED : BOOLEAN := FALSE;
+ 
+                PROCEDURE P1 (X : OUT AST_5) IS
+                BEGIN
+                     CALLED := TRUE;
+                     X := NEW STRING'(3..5 => 'C');
+                END P1;
+           BEGIN
+                P1 (AST_5 (X_3));
+                IF X_3.ALL = STRING'(1 .. 3 => 'A') THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (A1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (A2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P1 (A)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P1 (A)");
+           END;
+ 
+           DECLARE
+                TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+                TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
+                SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
+                TYPE A2_ARRAY IS NEW A_ARRAY (2..4);
+                A0 : A1_ARRAY := NEW ARRAY_TYPE'(1..3 => TRUE);
+                CALLED : BOOLEAN := FALSE;
+ 
+                PROCEDURE P2 (X : OUT A2_ARRAY) IS
+                BEGIN
+                     CALLED := TRUE;
+                     X := NEW ARRAY_TYPE'(2..4 => FALSE);
+                END P2;
+           BEGIN
+                P2 (A2_ARRAY (A0));
+                IF A0.ALL = ARRAY_TYPE'(1 .. 3 => TRUE) THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (A1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (A2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P1 (A)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P2 (A)");
+           END;
+ 
+           DECLARE
+                TYPE SUBINT IS RANGE 0..8;
+                TYPE REC1 (DISC : SUBINT := 8) IS
+                     RECORD
+                          FIELD : SUBINT := DISC;
+                     END RECORD;
+                TYPE A1_REC IS ACCESS REC1;
+                TYPE A2_REC IS NEW A1_REC (3);
+                A0 : A1_REC(4) := NEW REC1(4);
+                CALLED : BOOLEAN := FALSE;
+ 
+                PROCEDURE P3 (X : OUT A2_REC) IS
+                BEGIN
+                     CALLED := TRUE;
+                     X := NEW REC1(3);
+                END P3;
+ 
+           BEGIN
+                P3 (A2_REC (A0));
+                IF A0.ALL = REC1'(4,4) THEN
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (A1)");
+                ELSE
+                     FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (A2)");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                  "-P1 (A)");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED -P3 (A)");
+           END;
+      END;
+ 
+      RESULT;
+ END C64103F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,215 ----
+ -- C64104A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT CONSTRAINT_ERROR IS RAISED FOR OUT OF RANGE SCALAR
+ --      ARGUMENTS.  SUBTESTS ARE:
+ --           (A) STATIC IN ARGUMENT.
+ --           (B) DYNAMIC IN ARGUMENT.
+ --           (C) IN OUT, OUT OF RANGE ON CALL.
+ --           (D) OUT, OUT OF RANGE ON RETURN.
+ --           (E) IN OUT, OUT OF RANGE ON RETURN.
+ 
+ -- HISTORY:
+ --    DAS  01/14/81
+ --    CPP  07/03/84
+ --    LB   11/20/86  ADDED CODE TO ENSURE IN SUBTESTS WHICH CHECK
+ --                     RETURNED VALUES, THAT SUBPROGRAMS ARE ACTUALLY
+ --                     CALLED.
+ --    JET  08/04/87  FIXED HEADER FOR STANDARD FORMAT.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64104A IS
+ 
+      SUBTYPE DIGIT IS INTEGER RANGE 0..9;
+ 
+      CALLED : BOOLEAN;
+      D    : DIGIT;
+      I    : INTEGER;
+      M1 : CONSTANT INTEGER := IDENT_INT(-1);
+      COUNT     : INTEGER := 0;
+      SUBTYPE SI IS INTEGER RANGE M1 .. 10;
+ 
+      PROCEDURE P1 (PIN : IN DIGIT; WHO : STRING) IS         -- (A), (B)
+      BEGIN
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P1 " & WHO);
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN P1 FOR " & WHO);
+      END P1;
+ 
+      PROCEDURE P2 (PINOUT : IN OUT DIGIT; WHO : STRING) IS  -- (C)
+      BEGIN
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P2 " & WHO);
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN P2 FOR " & WHO);
+      END P2;
+ 
+      PROCEDURE P3 (POUT : OUT SI; WHO : STRING) IS          -- (D)
+      BEGIN
+           IF WHO = "10" THEN
+                POUT := IDENT_INT(10);    -- (10 IS NOT A DIGIT)
+           ELSE
+                POUT := -1;
+           END IF;
+           CALLED := TRUE;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN P3 FOR " & WHO);
+      END P3;
+ 
+      PROCEDURE P4 (PINOUT : IN OUT INTEGER; WHO : STRING) IS     -- (E)
+      BEGIN
+           IF WHO = "10" THEN
+                PINOUT := 10;       -- (10 IS NOT A DIGIT)
+           ELSE
+                PINOUT := IDENT_INT(-1);
+           END IF;
+           CALLED := TRUE;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN P4 FOR" & WHO);
+      END P4;
+ 
+ BEGIN
+ 
+      TEST ("C64104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "FOR OUT OF RANGE SCALAR ARGUMENTS");
+ 
+      BEGIN  -- (A)
+           P1 (10, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P1 (10)");
+      END;  -- (A)
+ 
+      BEGIN  -- (B)
+           P1 (IDENT_INT (-1), "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (" &
+                   "IDENT_INT (-1))");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P1 (" &
+                        "IDENT_INT (-1))");
+      END;  --(B)
+ 
+      BEGIN  -- (C)
+           I := IDENT_INT (10);
+           P2 (I, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P2 (10)");
+      END;  -- (C)
+ 
+      BEGIN -- (C1)
+           I := IDENT_INT (-1);
+           P2 (I, "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (-1)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P2 (-1)");
+      END; -- (C1)
+ 
+      BEGIN  -- (D)
+           CALLED := FALSE;
+           D := IDENT_INT (1);
+           P3 (D, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                   " P3 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P3 (10)");
+      END;  -- (D)
+ 
+      BEGIN -- (D1)
+           CALLED := FALSE;
+           D := IDENT_INT (1);
+           P3 (D, "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                   " P3 (-1)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P3 (-1)");
+      END; -- (D1)
+ 
+      BEGIN  -- (E)
+           CALLED := FALSE;
+           D := 9;
+           P4 (D, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                   " P4 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P4 (10)");
+      END;  -- (E)
+ 
+      BEGIN -- (E1)
+           CALLED := FALSE;
+           D := 0;
+           P4 (D, "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                   " P4 (-1)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR P4 (-1)");
+      END; -- (E1)
+ 
+      IF (COUNT /= 8) THEN
+           FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
+      END IF;
+ 
+      RESULT;
+ 
+ END C64104A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C64104B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER APPROPRIATE CIRCUMSTANCES
+ --    WITH RESPECT TO PARAMETERS OF RECORD TYPES.  SUBTESTS INVOLVE 
+ --    ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT EQUAL 
+ --    TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
+ --        (A) IN PARAMETER, STATIC AGGREGATE.
+ --        (B) IN PARAMETER, DYNAMIC AGGREGATE.
+ --        (C) IN PARAMETER, VARIABLE.
+ --        (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
+ --        (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
+ 
+ -- DAS 2/11/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64104B IS
+ 
+      USE REPORT;
+      SUBTYPE INT IS INTEGER RANGE 0..10;
+      TYPE REC (N : INT := 0) IS
+           RECORD
+                A : STRING (1..N);
+           END RECORD;
+      SUBTYPE SREC IS REC(N=>3);
+      PROCEDURE P1 (R : IN SREC) IS
+      BEGIN
+           FAILED ("EXCEPTION NOT RAISED ON CALL TO P1");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+      END P1;
+ 
+      PROCEDURE P2 (R : IN OUT SREC) IS
+      BEGIN
+           FAILED ("EXCEPTION NOT RAISED ON CALL TO P2");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+      END P2;
+ 
+      PROCEDURE P3 (R : OUT SREC) IS
+      BEGIN
+           FAILED ("EXCEPTION NOT RAISED ON CALL TO P3");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+      END P3;
+ 
+ BEGIN
+ 
+      TEST ("C64104B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
+                       "PARAMETERS OF RECORD TYPES");
+ 
+      BEGIN     -- (A)
+           P1 ((2,"AA"));
+           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
+      END; -- (A)
+ 
+      BEGIN     -- (B)
+           P1 ((IDENT_INT(2), "AA"));
+           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
+      END; -- (B)
+ 
+      DECLARE   -- (C)
+           R : REC     := (IDENT_INT(2), "AA");
+      BEGIN     -- (C)
+           P1 (R);
+           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
+      END; -- (C)
+ 
+      DECLARE   -- (D)
+           R : REC     := (IDENT_INT(2), "AA");
+      BEGIN     -- (D)
+           P2 (R);
+           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
+      END; -- (D)
+ 
+ 
+      DECLARE   -- (E)
+           R  : REC;
+      BEGIN     -- (E)
+           P3 (R);
+           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
+      END; -- (E)
+ 
+      RESULT;
+ 
+ END C64104B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,200 ----
+ -- C64104C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE
+ --   APPROPRIATE CIRCUMSTANCES FOR ARRAY PARAMETERS, NAMELY
+ --   WHEN THE ACTUAL BOUNDS DON'T MATCH THE FORMAL BOUNDS
+ --   (BEFORE THE CALL FOR ALL MODES).
+ --   SUBTESTS ARE:
+ --      (A) IN MODE, ONE DIMENSION, STATIC AGGREGATE.
+ --      (B) IN MODE, TWO DIMENSIONS, DYNAMIC AGGREGATE.
+ --      (C) IN MODE, TWO DIMENSIONS, DYNAMIC VARIABLE.
+ --      (D) IN OUT MODE, THREE DIMENSIONS, STATIC VARIABLE.
+ --      (E) OUT MODE, ONE DIMENSION, DYNAMIC VARIABLE.
+ --      (F) IN OUT MODE, NULL STRING AGGREGATE.
+ --      (G) IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE (OK CASE).
+ --          IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE.
+ 
+ -- JRK 3/17/81
+ -- SPS 10/26/82
+ -- CPP 8/6/84
+ -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+ 
+ WITH REPORT;
+ PROCEDURE C64104C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+            "ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+           SUBTYPE ST IS STRING (1..3);
+ 
+           PROCEDURE P (A : ST) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (A)");
+           END P;
+ 
+      BEGIN -- (A)
+ 
+           P ("AB");
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (A)");
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..3;
+           TYPE T IS ARRAY (S,S) OF INTEGER;
+ 
+           PROCEDURE P (A : T) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (B)");
+           END P;
+ 
+      BEGIN -- (B)
+ 
+           P ((1..3 => (1..IDENT_INT(2) => 0)));
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (B)");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..5;
+           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
+           SUBTYPE ST IS T (1..3,1..3);
+           V : T (1..IDENT_INT(2), 1..3) :=
+                 (1..IDENT_INT(2) => (1..3 => 0));
+ 
+           PROCEDURE P (A :ST) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+           END P;
+ 
+      BEGIN -- (C)
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (C)");
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..5;
+           TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
+                     INTEGER;
+           SUBTYPE ST IS T (1..3, 1..3, 1..3);
+           V : T (1..3, 1..2, 1..3) :=
+                 (1..3 => (1..2 => (1..3 => 0)));
+ 
+           PROCEDURE P (A : IN OUT ST) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALLL - (D)");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+           END P;
+ 
+      BEGIN -- (D)
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (D)");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+ 
+      DECLARE -- (G)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..5;
+           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
+           SUBTYPE ST IS T (2..1, 2..1);
+           V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
+ 
+           PROCEDURE P (A : IN OUT ST) IS
+           BEGIN
+                COMMENT ("OK CASE CALLED CORRECTLY");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (G)");
+           END P;
+ 
+      BEGIN -- (G)
+ 
+           P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
+      END; -- (G)
+ 
+      --------------------------------------------------
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C64104C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C64104D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+ --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (A) BEFORE CALL, IN MODE, STATIC PRIVATE DISCRIMINANT.
+ 
+ -- JRK 3/18/81
+ -- NL 10/13/81
+ -- ABW 6/11/82
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64104D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104D", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2, E3);
+                TYPE T (D : E := E1) IS PRIVATE;
+                TYPE AR IS ARRAY (E1 .. E3) OF INTEGER;
+           PRIVATE
+                TYPE T (D : E := E1) IS
+                     RECORD
+                          I : INTEGER;
+                          A : AR;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE A1 IS A(E3);
+           V : A (E2) := NEW T (E2);
+ 
+           PROCEDURE P (X : A1) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALL");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      ------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C64104E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+ --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (B) BEFORE CALL, IN MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+ 
+ -- JRK 3/18/81
+ -- NL 10/13/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64104E IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104E", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE T IS ARRAY (BOOLEAN RANGE <>, CHARACTER RANGE <>) OF
+                     INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE A1 IS A(BOOLEAN, 'A'..'C');
+           V : A := NEW T (BOOLEAN, 'A'..IDENT_CHAR('B'));
+ 
+           PROCEDURE P (X : A1) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALL");
+           EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                 FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C64104F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+ --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (C) BEFORE CALL, IN OUT MODE, STATIC ONE DIMENSIONAL BOUNDS.
+ 
+ -- JRK 3/18/81
+ -- NL 10/13/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64104F IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104F", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE A IS ACCESS STRING;
+           SUBTYPE A1 IS A(1..3);
+           V : A (2..4) := NEW STRING (2..4);
+ 
+           PROCEDURE P (X : IN OUT A1) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALL");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C64104G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+ --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (D) BEFORE CALL, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+ 
+ -- JRK 3/18/81
+ -- NL 10/13/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64104G IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104G", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+           SUBTYPE INT IS INTEGER RANGE 0..10;
+           TYPE T (C : CHARACTER := 'A';
+                   B : BOOLEAN := FALSE;
+                   I : INT := 0
+                  ) IS
+                RECORD
+                     J : INTEGER;
+                     CASE B IS
+                          WHEN FALSE =>
+                               K : INTEGER;
+                          WHEN TRUE =>
+                               S : STRING (1 .. I);
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A ('Z', TRUE, 5);
+           V : A := NEW T ('Z', IDENT_BOOL(FALSE), 5);
+ 
+           PROCEDURE P (X : IN OUT SA ) IS
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED ON CALL");
+           EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C64104H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --         (E) AFTER RETURN, IN OUT MODE, STATIC LIMITED PRIVATE
+ --             DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --     JRK 03/18/81  CREATED ORIGINAL TEST.
+ --     NL  10/13/81
+ --     LB  11/25/86  ADDED CODE TO ENSURE THAT SUBPROGRAMS ARE
+ --                   ACTUALLY BEING CALLED.
+ --     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C64104H IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104H", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                SUBTYPE INT IS INTEGER RANGE 0..10;
+                SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'C';
+                TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                     LIMITED PRIVATE;
+           PRIVATE
+                TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                     RECORD
+                          J : INTEGER;
+                          CASE C IS
+                               WHEN 'A' =>
+                                    K : INTEGER;
+                               WHEN 'B' =>
+                                    S : STRING (1..I);
+                               WHEN OTHERS =>
+                                    NULL;
+                          END CASE;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           CALLED : BOOLEAN;
+           TYPE A IS ACCESS T;
+ 
+           V : A (2,'B') := NEW T (2,'B');
+ 
+           PROCEDURE P (X : IN OUT A) IS
+           BEGIN
+                CALLED := TRUE;
+                X := NEW T (2,'A');
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           CALLED := FALSE;
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C64104I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --         (F) AFTER RETURN, IN OUT MODE, DYNAMIC THREE DIMENSIONAL
+ --             BOUNDS.
+ 
+ -- HISTORY:
+ --     JRK 03/18/81  CREATED ORIGINAL TEST.
+ --     NL  10/13/81
+ --     LB  11/25/86  ADDED CODE TO ENSURE THAT SUBPROGRAMS ARE
+ --                   ACTUALLY BEING CALLED.
+ --     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.
+ 
+ 
+ WITH REPORT;
+ PROCEDURE C64104I IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104I", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN;
+ 
+           TYPE E IS (E1, E2, E3);
+ 
+           TYPE T IS ARRAY (CHARACTER RANGE <>,
+                            E RANGE <>,
+                            BOOLEAN RANGE <>
+                           ) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+ 
+           V : A ('A'..'Z', E1..E2, BOOLEAN) :=
+                     NEW T ('A'..'Z', E1..E2, BOOLEAN);
+ 
+           PROCEDURE P (X : IN OUT A) IS
+           BEGIN
+                CALLED := TRUE;
+                IF EQUAL (3,3) THEN
+                     X := NEW T ('A'..'Z', E2..E3, BOOLEAN);
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           CALLED := FALSE;
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- C64104J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --         (G) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, STATIC ONE
+ --             DIMENSIONAL BOUNDS.
+ 
+ -- HISTORY:
+ --     JRK 03/18/81  CREATED ORIGINAL TEST.
+ --     NL  10/13/81
+ --     BCB 11/12/87  CHANGED HEADING TO STANDARD FORMAT.  ADDED CODE TO
+ --                   ENSURE THAT SUBPROGRAMS ARE ACTUALLY CALLED.
+ 
+ WITH REPORT;
+ PROCEDURE C64104J IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104J", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE A IS ACCESS STRING;
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           V : A (1..3) := NEW STRING (1..3);
+ 
+           PROCEDURE P (X : OUT A) IS
+           BEGIN
+                CALLED := TRUE;
+                X := NEW STRING (2..3);
+           EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C64104K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ --     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --         (H) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, DYNAMIC
+ --             RECORD DISCRIMINANT.
+ 
+ -- HISTORY:
+ --     JRK 03/18/81  CREATED ORIGINAL TEST.
+ --     NL  10/13/81
+ --     SPS 10/26/82
+ --     BCB 11/12/87  CHANGED HEADING TO STANDARD FORMAT.  ADDED CODE TO
+ --                   ENSURE THAT SUBPROGRAMS ARE ACTUALLY CALLED.
+ 
+ WITH REPORT;
+ PROCEDURE C64104K IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104K", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (BOOLEAN RANGE <>) OF INTEGER;
+           TYPE T (B : BOOLEAN := FALSE) IS
+                RECORD
+                     I : INTEGER;
+                     A : ARR (FALSE..B);
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           V : A (IDENT_BOOL(FALSE)) := NEW T (IDENT_BOOL(FALSE));
+ 
+           PROCEDURE P (X : OUT A) IS
+           BEGIN
+                CALLED := TRUE;
+                X := NEW T (TRUE);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("SUBPROGRAM P WAS NOT CALLED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C64104L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+ --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (I) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, STATIC
+ --           PRIVATE DISCRIMINANTS.
+ 
+ -- JRK 3/18/81
+ -- NL 10/13/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64104L IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104L", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2, E3);
+                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                     PRIVATE;
+           PRIVATE
+                TYPE ARR IS ARRAY (E RANGE <>) OF INTEGER;
+                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                     RECORD
+                          I : INTEGER;
+                          CASE B IS
+                               WHEN FALSE =>
+                                    J : INTEGER;
+                               WHEN TRUE =>
+                                    A : ARR (E1 .. D);
+                          END CASE;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(E2, TRUE);
+           V : A (E2, FALSE) := NEW T (E2, FALSE);
+ 
+           ENTERED : BOOLEAN := FALSE;
+ 
+           PROCEDURE P (X : OUT SA ) IS
+           BEGIN
+                ENTERED := TRUE;
+                X := NEW T (E2, TRUE);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("CONSTRAINT_ERROR RAISED BEFORE " & 
+                             "CALL");
+                END IF;
+           WHEN OTHERS =>
+                IF NOT ENTERED THEN
+                    FAILED ("OTHER EXCEPTION RAISED BEFORE CALL");
+                ELSE FAILED ("WRONG EXCEPTION RAISED AFTER " & 
+                             "RETURN");
+                END IF;
+      END;
+ 
+      ------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C64104M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ --   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+ --   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ --   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ --   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+ --   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (J) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, DYNAMIC TWO
+ --           DIMENSIONAL BOUNDS.
+ 
+ -- JRK 3/18/81
+ -- NL 10/13/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64104M IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64104M", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+            "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE T IS ARRAY (INTEGER RANGE <>,
+                            CHARACTER RANGE <>
+                           ) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+ 
+           V : A (1..10, 'A'..'Z') := NEW T (1..10, 'A'..'Z');
+ 
+           ENTERED : BOOLEAN := FALSE;
+           Y : CONSTANT CHARACTER := IDENT_CHAR('Y');
+           SUBTYPE SA IS A(1..10, 'A'..Y);
+           PROCEDURE P (X : OUT SA ) IS
+           BEGIN
+                ENTERED := TRUE;
+                X := NEW T (1..10, 'A'..IDENT_CHAR('Y'));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+           END P;
+ 
+      BEGIN
+ 
+           P (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("CONSTRAINT_ERROR RAISED BEFORE " & 
+                             "CALL");
+                END IF;
+           WHEN OTHERS =>
+                IF NOT ENTERED THEN
+                     FAILED ("OTHER EXCEPTION RAISED BEFORE CALL");
+                ELSE FAILED ("WRONG EXCEPTION RAISED AFTER " & 
+                             "RETURN");
+                END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64104M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104n.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104n.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104n.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C64104N.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED AT THE PLACE OF THE CALL
+ --     FOR THE CASE OF A PRIVATE TYPE IMPLEMENTED AS A SCALAR TYPE
+ --     WHERE THE VALUE OF THE FORMAL PARAMETER DOES NOT BELONG TO THE
+ --     SUBTYPE OF THE ACTUAL PARAMETER.
+ 
+ -- HISTORY:
+ --     DAVID A. TAFFS
+ --     CPP 07/23/84
+ --     RDH 04/18/90  REVISED TO CHECK THAT SUBPROGRAM IS ACTUALLY
+ --                   CALLED.
+ --     THS 09/21/90  REWORDED COMMENT STATING THAT THE TEST DOES NOT
+ --                   ACCEPT THE LITERAL INTERPRETATION OF 6.4.1(9).
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C64104N IS
+ 
+ BEGIN
+      TEST ("C64104N", "CHECK THAT PRIVATE TYPE (SCALAR) RAISES " &
+            "CONSTRAINT_ERROR WHEN ACTUAL AND FORMAL PARAMETER " &
+            "BOUNDS DIFFER");
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           PACKAGE P IS
+                TYPE T IS PRIVATE;
+                DC : CONSTANT T;
+ 
+                GENERIC PACKAGE PP IS
+                END PP;
+           PRIVATE
+                TYPE T IS NEW INTEGER;
+                DC : CONSTANT T := -1;
+           END P;
+ 
+           PROCEDURE Q (X : IN OUT P.T) IS
+           BEGIN
+                CALLED := TRUE;
+                X := P.DC;
+                IF P. "=" (X, P.DC) THEN
+                     COMMENT("PROCEDURE Q WAS CALLED");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED("EXCEPTION RAISED INSIDE SUBPROGRAM");
+           END Q;
+ 
+           GENERIC
+                Y : IN OUT P.T;
+           PACKAGE CALL IS
+           END CALL;
+ 
+           PACKAGE BODY CALL IS
+           BEGIN
+                Q (Y);
+           END CALL;
+ 
+ -- NOTE CALL HAS VARIABLE OF A PRIVATE TYPE AS AN OUT PARAMETER.  
+ -- THIS TEST DOES NOT ACCEPT THE LITERAL INTERPRETATION OF 6.4.1(9).
+ -- REFER TO ADA IMPLEMENTOR'S GUIDE 6.4.1 SEMANTIC RAMIFICATION 19
+ -- AND AI-00025 FOR CLARIFICATION AS TO WHY THE LITERAL
+ -- INTERPRETATION IS REJECTED.
+ 
+           PACKAGE BODY P IS
+                Z : T RANGE 0..1 := 0;
+                PACKAGE BODY PP IS
+                     PACKAGE CALL_Q IS NEW CALL(Z);
+                END PP;
+           END P;
+ 
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE CALL_Q_NOW IS NEW P.PP;    -- EXCEPTION
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED("SUBPROGRAM Q WAS NOT CALLED");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED");
+           END;
+ 
+           RESULT;
+ 
+      END;
+ END C64104N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64104o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64104o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C64104O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE
+ --    CHECK THAT CONSTRAINT_ERROR IS RAISED AT THE PLACE OF THE CALL
+ --    FOR THE CASE OF A PRIVATE TYPE IMPLEMENTED AS AN ACCESS TYPE WHERE
+ --    THE ACTUAL BOUNDS OR DISCRIMINANTS OF THE DESIGNATED OBJECT DIFFER
+ --    FROM THOSE OF THE FORMAL.
+ 
+ -- HISTORY
+ --    CPP 7/23/84 CREATED ORIGINAL TEST.
+ --    DHH 8/31/87 ADDED COMMENT IN PROCEDURE Q SO THAT CODE WILL NOT BE
+ --                OPTIMIZED OUT OF EXISTENCE.
+ 
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64104O IS
+ 
+ BEGIN
+ 
+      TEST ("C64104O", "CHECK THAT PRIVATE TYPE (ACCESS) RAISES " &
+            "CONSTRAINT_ERROR WHEN ACTUAL AND FORMAL PARAMETER BOUNDS " &
+            "DIFFER");
+ 
+      DECLARE
+ 
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           PACKAGE P IS
+                TYPE T IS PRIVATE;
+                DC : CONSTANT T;
+                GENERIC PACKAGE PP IS
+                END PP;
+           PRIVATE
+                TYPE T IS ACCESS STRING;
+                DC : CONSTANT T := NEW STRING'("AAA");
+           END P;
+ 
+           PROCEDURE Q (X : IN OUT P.T) IS
+ 
+           BEGIN
+ 
+                CALLED := TRUE;
+                X := P.DC;
+                IF P. "=" (X, P.DC) THEN
+                     COMMENT("PROCEDURE Q WAS CALLED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED INSIDE SUBPROGRAM");
+           END Q;
+ 
+           GENERIC
+                Y : IN OUT P.T;
+           PACKAGE CALL IS
+           END CALL;
+ 
+           PACKAGE BODY CALL IS
+           BEGIN
+                Q(Y);
+           END CALL;
+ 
+           PACKAGE BODY P IS
+                Z : T(1..5) := NEW STRING'("CCCCC");
+                PACKAGE BODY PP IS
+                     PACKAGE CALL_Q IS NEW CALL(Z);
+                END PP;
+           END P;
+ 
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE CALL_Q_NOW IS NEW P.PP;
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("SUBPROGRAM Q WAS NOT CALLED");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED");
+           END;
+ 
+           RESULT;
+      END;
+ 
+ END C64104O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C64105A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED AT THE TIME OF CALL WHEN 
+ --   THE VALUE OF AN ACTUAL OUT SCALAR PARAMETER DOES NOT SATISFY THE 
+ --   RANGE CONSTRAINTS OF THE FORMAL PARAMETER.
+ 
+ -- DAS  1/29/81
+ -- CPP  8/6/84
+ 
+ WITH REPORT;
+ PROCEDURE C64105A IS
+ 
+      USE REPORT;
+ 
+      SUBTYPE SUBINT1 IS INTEGER RANGE -10..10;
+      SUBTYPE SUBINT2 IS INTEGER RANGE -20..20;
+ 
+      I10  : SUBINT1 := 10;
+      I20  : SUBINT2 := 20;
+ 
+      PROCEDURE P1 (I : OUT SUBINT1) IS
+      BEGIN
+           I := SUBINT1'FIRST;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+      END P1;
+ 
+ BEGIN
+ 
+      TEST ("C64105A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED" &
+                       " AT THE TIME OF CALL WHEN THE VALUE OF AN" &
+                       " ACTUAL OUT SCALAR PARAMETER DOES NOT" &
+                       " SATISFY THE RANGE CONSTRAINTS OF THE FORMAL" &
+                       " PARAMETER");
+ 
+      DECLARE
+      BEGIN
+           P1 (SUBINT1(I20));
+           IF I20 /= IDENT_INT(-10) THEN
+                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 1");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED ON CALL TO P1 - 1");
+      END;
+ 
+      DECLARE
+      BEGIN
+           I20 := IDENT_INT(20);
+           P1 (I20);
+           IF I20 /= IDENT_INT(-10) THEN
+                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED ON CALL TO P1 - 2");
+      END;
+ 
+      RESULT;
+ 
+ END C64105A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,184 ----
+ -- C64105B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
+ --   IN THE FOLLOWING CIRCUMSTANCES:
+ --       (1) BEFORE THE CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS
+ --           PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT 
+ --           FROM THE FORMAL PARAMETER.
+ --       (2)
+ --       (3)
+ --   SUBTESTS ARE:
+ --       (A) CASE 1, IN MODE, STATIC ONE DIMENSIONAL BOUNDS.
+ --       (B) CASE 1, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+ --       (C) CASE (A), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+ --       (D) CASE (B), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+ 
+ -- JRK 3/20/81
+ -- SPS 10/26/82
+ -- CPP 8/6/84
+ 
+ WITH REPORT;
+ PROCEDURE C64105B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64105B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "BEFORE THE CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS " &
+            "PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT " &
+            "FROM THE FORMAL PARAMETER" );
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           TYPE E IS (E1, E2, E3, E4);
+           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(E2..E4);
+           V : A (E1..E2) := NULL;
+ 
+           PROCEDURE P (X : SA ) IS
+           BEGIN
+                NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (A)");
+           END P;
+      
+      BEGIN -- (A)
+ 
+           P (V);
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (A)");
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN FALSE =>
+                               J : INTEGER;
+                          WHEN TRUE =>
+                               A : ARR ('A' .. C);
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(TRUE, 'C');
+           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+ 
+           PROCEDURE P (X : IN OUT SA ) IS
+           BEGIN
+                NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (B)");
+           END P;
+ 
+      BEGIN -- (B)
+ 
+           P (V);
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (B)");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           TYPE E IS (E1, E2, E3, E4);
+           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(E2..E4);
+           V : A (E1..E2) := NULL;
+ 
+           PROCEDURE P (X : SA ) IS
+           BEGIN
+                NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+           END P;
+      
+      BEGIN -- (C)
+ 
+           P (SA(V));
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (C)");
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN FALSE =>
+                               J : INTEGER;
+                          WHEN TRUE =>
+                               A : ARR ('A' .. C);
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(TRUE, 'C');
+           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+ 
+           PROCEDURE P (X : IN OUT SA ) IS
+           BEGIN
+                NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+           END P;
+ 
+      BEGIN -- (D)
+ 
+           P (SA(V));
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (D)");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C64105B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,230 ----
+ -- C64105C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
+ --   IN THE FOLLOWING CIRCUMSTANCES:
+ --       (1)
+ --       (2) AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL 
+ --           ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS 
+ --           DIFFERENT CONSTRAINTS.
+ --       (3)
+ --   SUBTESTS ARE:
+ --       (C) CASE 2, IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
+ --       (D) CASE 2, OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+ --       (E) SAME AS (C), WITH TYPE CONVERSION.
+ --       (F) SAME AS (D), WITH TYPE CONVERSION.
+ 
+ -- JRK 3/20/81
+ -- SPS 10/26/82
+ -- CPP 8/8/84
+ 
+ WITH REPORT;
+ PROCEDURE C64105C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64105C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL " &
+            "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
+            "DIFFERENT CONSTRAINTS" );
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2);
+                TYPE T (D : E := E1) IS PRIVATE;
+           PRIVATE
+                TYPE T (D : E := E1) IS
+                     RECORD
+                          I : INTEGER;
+                          CASE D IS
+                               WHEN E1 =>
+                                    B : BOOLEAN;
+                               WHEN E2 =>
+                                    C : CHARACTER;
+                          END CASE;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(E2);
+           V : A (E1) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           PROCEDURE P (X : IN OUT SA) IS
+           BEGIN
+                ENTERED := TRUE;
+                X := NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+           END P;
+ 
+      BEGIN -- (C)
+ 
+           P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (C)");
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                     INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           PROCEDURE P (X : OUT SA) IS
+           BEGIN
+                ENTERED := TRUE;
+                X := NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+           END P;
+ 
+      BEGIN -- (D)
+ 
+           P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (D)");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (E)
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2);
+                TYPE T (D : E := E1) IS PRIVATE;
+           PRIVATE
+                TYPE T (D : E := E1) IS
+                     RECORD
+                          I : INTEGER;
+                          CASE D IS
+                               WHEN E1 =>
+                                    B : BOOLEAN;
+                               WHEN E2 =>
+                                    C : CHARACTER;
+                          END CASE;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(E2);
+           V : A (E1) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           PROCEDURE P (X : IN OUT SA) IS
+           BEGIN
+                ENTERED := TRUE;
+                X := NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+           END P;
+ 
+      BEGIN -- (E)
+ 
+           P (SA(V));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (E)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (E)");
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (F)
+ 
+           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                     INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           PROCEDURE P (X : OUT SA) IS
+           BEGIN
+                ENTERED := TRUE;
+                X := NULL;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+           END P;
+ 
+      BEGIN -- (D)
+ 
+           P (SA(V));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (F)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (F)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (F)");
+      END; -- (F)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C64105C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64105d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64105d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- C64105D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
+ --   IN THE FOLLOWING CIRCUMSTANCES:
+ --       (1)
+ --       (2)
+ --       (3) BEFORE OR AFTER THE CALL, WHEN AN UNCONSTRAINED ACTUAL 
+ --           OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE
+ --           CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL
+ --           PARAMETER.
+ --   SUBTESTS ARE:
+ --       (G) CASE 3, STATIC LIMITED PRIVATE DISCRIMINANT.
+ --       (H) CASE 3, DYNAMIC ONE DIMENSIONAL BOUNDS.
+ 
+ -- JRK 3/20/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C64105D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64105D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "BEFORE AND AFTER THE CALL, WHEN AN UNCONSTRAINED ACTUAL " &
+            "OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE " &
+            "CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL " &
+            "PARAMETER" );
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (G)
+ 
+           PACKAGE PKG IS
+                SUBTYPE INT IS INTEGER RANGE 0..5;
+                TYPE T (I : INT := 0) IS LIMITED PRIVATE; 
+           PRIVATE          
+                TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+                TYPE T (I : INT := 0) IS 
+                     RECORD
+                          J : INTEGER;
+                          A : ARR (1..I);
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A(3);
+           V : A := NEW T (2);
+           CALLED : BOOLEAN := FALSE;
+ 
+           PROCEDURE P (X : OUT SA) IS
+           BEGIN
+                CALLED := TRUE;
+                X := NEW T (3);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (G)");
+           END P;
+ 
+      BEGIN -- (G)
+  
+           P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (G)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (G)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (G)");
+      END; -- (G)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (H)
+ 
+           TYPE A IS ACCESS STRING;
+           SUBTYPE SA IS A (1..2);
+           V : A := NEW STRING (IDENT_INT(5) .. IDENT_INT(7));
+           CALLED : BOOLEAN := FALSE;
+ 
+           PROCEDURE P (X : OUT SA) IS
+           BEGIN
+                CALLED := TRUE;
+                X := NEW STRING (IDENT_INT(1) .. IDENT_INT(2));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE - (H)");
+           END P;
+ 
+      BEGIN -- (H)
+ 
+           P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (H)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (H)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (H)");
+      END; -- (H)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C64105D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,351 ----
+ -- C64106A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
+ --   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
+ --   SUBTESTS ARE:
+ --        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
+ --        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
+ --        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
+ --        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
+ 
+ -- DAS  1/15/81
+ -- JBG  5/16/83
+ -- CPP  5/22/84
+ 
+ WITH REPORT;
+ PROCEDURE C64106A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C64106A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
+                       "UNCONSTRAINED FORMAL PARAMETERS");
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+               SUBTYPE INT IS INTEGER RANGE 0..100;
+ 
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+ 
+                REC1  : RECTYPE   := (10,10,"0123456789");
+                REC2  : RECTYPE   := (17,7,"C64106A..........");
+                REC3  : RECTYPE   := (1,1,"A");
+                REC4  : RECTYPE;  -- 80
+ 
+                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
+                                        REC2 : OUT RECTYPE;
+                                        REC3 : IN OUT RECTYPE);
+ 
+                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
+                                        REC2 : OUT RECTYPE;
+                                        REC3 : IN OUT RECTYPE) IS
+                BEGIN
+                     IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
+                          FAILED ("RECORD TYPE IN PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF ACTUAL");
+                     END IF;
+                     IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
+                          FAILED ("RECORD TYPE OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF ACTUAL");
+                     END IF;
+                     IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
+                          FAILED ("RECORD TYPE IN OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF ACTUAL");
+                     END IF;
+                     REC2 := PKG.REC2;
+                END CHK_RECTYPE1;
+ 
+                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
+                BEGIN
+                     IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
+                          FAILED ("RECORD TYPE OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF " &
+                                  "UNINITIALIZED ACTUAL");
+                     END IF;
+                     REC := (10,10,"9876543210");
+                END CHK_RECTYPE2;
+           END PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.CHK_RECTYPE1 (PKG.REC1, PKG.REC2, PKG.REC3);
+           PKG.CHK_RECTYPE2 (PKG.REC4);
+ 
+      END;   -- (A)
+ 
+      ---------------------------------------------
+ 
+ B :  DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INT IS INTEGER RANGE 0..100;
+ 
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
+ 
+ 
+                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                        REC2 : OUT RECTYPE;
+                                        REC3 : IN OUT RECTYPE);
+ 
+                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
+ 
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC1  : PKG.RECTYPE(10);
+           REC2  : PKG.RECTYPE(17);   
+           REC3  : PKG.RECTYPE(1);    
+           REC4  : PKG.RECTYPE(10);
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                        REC2 : OUT RECTYPE;
+                                        REC3 : IN OUT RECTYPE) IS
+                BEGIN
+                     IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
+                          FAILED ("PRIVATE TYPE IN PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF ACTUAL");
+                     END IF;
+                     IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
+                          FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF ACTUAL");
+                     END IF;
+                     IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
+                          FAILED ("PRIVATE TYPE IN OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF ACTUAL");
+                     END IF;
+                     REC2 := B.REC2;
+                END CHK_RECTYPE1;
+ 
+                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
+                BEGIN
+                     IF (REC.CONSTRAINT /= IDENT_INT(10)) THEN
+                          FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINT OF " &
+                                  "UNINITIALIZED ACTUAL");
+                     END IF;
+                     REC := (10,10,"9876543210");
+                END CHK_RECTYPE2;
+ 
+           BEGIN
+                REC1 := (10,10,"0123456789");
+                REC2 := (17,7,"C64106A..........");
+                REC3 := (1,1,"A");
+ 
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
+           PKG.CHK_RECTYPE2 (REC4);
+ 
+      END B;  -- (B)
+ 
+      ---------------------------------------------
+ 
+ C :  DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INT IS INTEGER RANGE 0..100;
+ 
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     LIMITED PRIVATE;
+ 
+                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                        REC2 : OUT RECTYPE;
+                                        REC3 : IN OUT RECTYPE);
+ 
+                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
+ 
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC1  : PKG.RECTYPE;     -- 10   
+           REC2  : PKG.RECTYPE;     -- 17
+           REC3  : PKG.RECTYPE;     --  1
+           REC4  : PKG.RECTYPE;     -- 80
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                        REC2 : OUT RECTYPE;
+                                        REC3 : IN OUT RECTYPE) IS
+                BEGIN
+                     IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
+                          FAILED ("LIMITED PRIVATE TYPE IN PARAMETER " &
+                                  "DID NOT USE CONSTRAINT OF " &
+                                  "ACTUAL");
+                     END IF;
+                     IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
+                          FAILED ("LIMITED PRIVATE TYPE OUT PARAMETER " &
+                                  "DID NOT USE CONSTRAINT OF " &
+                                  "ACTUAL");
+                     END IF;
+                     IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
+                          FAILED ("LIMITED PRIVATE TYPE IN OUT " &
+                                  "PARAMETER DID NOT USE " &
+                                  "CONSTRAINT OF ACTUAL");
+                     END IF;
+                     REC2 := C.REC2;
+                END CHK_RECTYPE1;
+ 
+                PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
+                BEGIN
+                     IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
+                          FAILED ("LIMITED PRIVATE TYPE OUT " &
+                                  "PARAMETER DID NOT USE " &
+                                  "CONSTRAINT OF UNINITIALIZED ACTUAL");
+                     END IF;
+                     REC := (10,10,"9876543210");
+                END CHK_RECTYPE2;
+ 
+           BEGIN
+                REC1 := (10,10,"0123456789");
+                REC2 := (17,7,"C64106A..........");
+                REC3 := (1,1,"A");
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
+           PKG.CHK_RECTYPE2 (REC4);
+ 
+      END C;   -- (C)
+ 
+      ---------------------------------------------
+ 
+ D :  DECLARE  -- (D)
+ 
+           TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
+                CHARACTER;
+ 
+           A1, A2, A3  : ATYPE(-1..1, 4..5)  := (('A','B'),
+                                                 ('C','D'),
+                                                 ('E','F'));
+ 
+           A4  : ATYPE(-1..1, 4..5);
+ 
+           CA1 : CONSTANT ATYPE(8..9, -7..INTEGER'FIRST) := 
+                               (8..9 => (-7..INTEGER'FIRST => 'A'));
+ 
+           S1  : STRING(1..INTEGER'FIRST) := "";
+           S2  : STRING(-5..-7) := "";
+           S3  : STRING(1..0) := "";
+ 
+           PROCEDURE CHK_ARRAY1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
+                                 A3 : IN OUT ATYPE) IS
+           BEGIN
+                IF ((A1'FIRST(1) /= IDENT_INT(-1)) OR
+                    (A1'LAST(1)  /= IDENT_INT(1)) OR
+                    (A1'FIRST(2) /= IDENT_INT(4)) OR
+                    (A1'LAST(2)  /= IDENT_INT(5))) THEN
+                     FAILED ("ARRAY TYPE IN PARAMETER DID NOT " &
+                             "USE CONSTRAINTS OF ACTUAL");
+                END IF;
+                IF ((A2'FIRST(1) /= IDENT_INT(-1)) OR
+                    (A2'LAST(1)  /= IDENT_INT(1)) OR
+                    (A2'FIRST(2) /= IDENT_INT(4)) OR
+                    (A2'LAST(2)  /= IDENT_INT(5))) THEN
+                     FAILED ("ARRAY TYPE OUT PARAMETER DID NOT USE" &
+                             "CONSTRAINTS OF ACTUAL");
+                END IF;
+                IF ((A3'FIRST(1) /= IDENT_INT(-1)) OR
+                    (A3'LAST(1)  /= IDENT_INT(1)) OR
+                    (A3'FIRST(2) /= IDENT_INT(4)) OR
+                    (A3'LAST(2)  /= IDENT_INT(5))) THEN
+                     FAILED ("ARRAY TYPE IN OUT PARAMETER DID NOT " &
+                             "USE CONSTRAINTS OF ACTUAL");
+                END IF;
+                A2 := D.A2;
+           END CHK_ARRAY1;
+ 
+           PROCEDURE CHK_ARRAY2 (A4 : OUT ATYPE) IS
+           BEGIN
+                IF ((A4'FIRST(1) /= IDENT_INT(-1)) OR
+                    (A4'LAST(1)  /= IDENT_INT(1)) OR
+                    (A4'FIRST(2) /= IDENT_INT(4)) OR
+                    (A4'LAST(2)  /= IDENT_INT(5))) THEN
+                     FAILED ("ARRAY TYPE OUT PARAMETER DID NOT " &
+                             "USE CONSTRAINTS OF UNINITIALIZED " &
+                             "ACTUAL");
+                END IF;
+                A4 := A2;
+           END CHK_ARRAY2;
+ 
+           PROCEDURE CHK_STRING (S1 : IN STRING;
+                                 S2 : IN OUT STRING;
+                                 S3 : OUT STRING) IS
+           BEGIN
+                IF ((S1'FIRST /= IDENT_INT(1)) OR
+                    (S1'LAST  /= IDENT_INT(INTEGER'FIRST))) THEN
+                     FAILED ("STRING TYPE IN PARAMETER DID NOT " &
+                             "USE CONSTRAINTS OF ACTUAL NULL " &
+                             "STRING");
+                END IF;
+                IF ((S2'FIRST /= IDENT_INT(-5)) OR
+                    (S2'LAST  /= IDENT_INT(-7))) THEN 
+                     FAILED ("STRING TYPE IN OUT PARAMETER DID NOT " &
+                             "USE CONSTRAINTS OF ACTUAL NULL STRING");
+                END IF;
+                IF ((S3'FIRST /= IDENT_INT(1)) OR
+                    (S3'LAST  /= IDENT_INT(0))) THEN
+                     FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
+                             "USE CONSTRAINTS OF ACTUAL NULL STRING");
+                END IF;
+                S3 := "";
+           END CHK_STRING;
+ 
+      BEGIN  -- (D)
+           CHK_ARRAY1 (A1, A2, A3);
+           CHK_ARRAY2 (A4);
+           CHK_STRING (S1, S2, S3);
+      END D;  -- (D)
+ 
+      RESULT;
+ END C64106A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,237 ----
+ -- C64106B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED RECORD,
+ --   PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT CONSTRAINTS
+ --   RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE THE 
+ --   CONSTRAINT OF THE ACTUAL PARAMETER.
+ --   SUBTESTS ARE:
+ --        (A) RECORD TYPE.
+ --        (B) PRIVATE TYPE.
+ --        (C) LIMITED PRIVATE TYPE.
+ 
+ -- DAS  1/15/81
+ -- CPP  8/9/84
+ 
+ WITH REPORT;
+ PROCEDURE C64106B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C64106B", "CHECK ASSIGNMENT TO FORMAL PARAMETERS OF " &
+                       "UNCONSTRAINED TYPE (WITH NO DEFAULT)");
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+ 
+                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                       REC6 : IN OUT RECTYPE);
+           END PKG;
+ 
+           REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
+                  (IDENT_INT(9), 9, "123456789");
+           REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
+                  (IDENT_INT(6), 5, "AEIOUY");
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                       REC6 : IN OUT RECTYPE) IS
+ 
+                     REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
+                            (IDENT_INT(4), 4, "OOPS"); 
+ 
+                BEGIN
+                     BEGIN  -- (A.1)
+                          REC9 := REC6;
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED - A.1");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION RAISED - A.1");
+                     END;   -- (A.1)
+ 
+                     BEGIN  -- (A.2)
+                          REC6 := REC4;
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED - A.2");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION RAISED - A.2");
+                     END;   -- (A.2)
+ 
+                     REC9 := (IDENT_INT(9), 9, "987654321");
+ 
+                END CHK_RECTYPE;
+           END PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.CHK_RECTYPE (REC9, REC6);
+           IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
+                FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
+           END IF;
+ 
+      END;   -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
+ 
+                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                       REC6 : IN OUT RECTYPE);
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC9 : PKG.RECTYPE(9);
+           REC6 : PKG.RECTYPE(6);
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                       REC6 : IN OUT RECTYPE) IS
+ 
+                     REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS"); 
+ 
+                BEGIN
+                     BEGIN  -- (B.1)
+                          REC9 := REC6;
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED - B.1");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION RAISED - B.1");
+                     END;   -- (B.1)
+ 
+                     BEGIN  -- (B.2)
+                          REC6 := REC4;
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED - B.2");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION RAISED - B.2");
+                     END;   -- (B.2)
+                END CHK_RECTYPE;
+ 
+           BEGIN
+                REC9 := (9, 9, "123456789");
+                REC6 := (6, 5, "AEIOUY");
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.CHK_RECTYPE (REC9, REC6);
+ 
+      END;   -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
+ 
+                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                       REC6 : IN OUT RECTYPE);
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC6 : PKG.RECTYPE(IDENT_INT(6));
+           REC9 : PKG.RECTYPE(IDENT_INT(9));
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                       REC6 : IN OUT RECTYPE) IS
+ 
+                     REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS"); 
+ 
+                BEGIN
+                     BEGIN  -- (C.1)
+                          REC9 := REC6;
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED - C.1");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION RAISED - C.1");
+                     END;   -- (C.1)
+ 
+                     BEGIN  -- (C.2)
+                          REC6 := REC4;
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED - C.2");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ("WRONG EXCEPTION RAISED - C.2");
+                     END;   -- (C.2)
+                END CHK_RECTYPE;
+ 
+           BEGIN
+                REC6 := (6, 5, "AEIOUY");
+                REC9 := (9, 9, "123456789");
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.CHK_RECTYPE (REC9, REC6);
+ 
+      END;   -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64106B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,309 ----
+ -- C64106C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED
+ --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+ --    CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS
+ --    CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING
+ --    ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER.  
+ 
+ --    SUBTESTS ARE:
+ --        (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+ --        (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+ --        (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+ 
+ -- DAS  1/16/81
+ -- VKG  1/7/83
+ -- CPP  8/9/84
+ 
+ WITH REPORT;
+ PROCEDURE C64106C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C64106C", "CHECK ASSIGNMENTS TO FORMAL PARAMETERS OF " &
+                       "UNCONSTRAINED TYPES (WITH DEFAULTS)");
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+ 
+                REC91,REC92,REC93  : RECTYPE(9);
+                REC_OOPS           : RECTYPE(4);
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE) IS
+ 
+                     PROCEDURE P1 (REC11 : IN RECTYPE;
+                                   REC12 : IN OUT RECTYPE;
+                                   REC13 : OUT RECTYPE) IS
+                     BEGIN
+                          IF (NOT REC11'CONSTRAINED) OR
+                             (REC11.CONSTRAINT /= IDENT_INT(9)) THEN
+                               FAILED ("CONSTRAINT ON RECORD " &
+                                       "TYPE IN PARAMETER " &
+                                       "NOT RECOGNIZED");
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                               REC12 := REC_OOPS;
+                               FAILED ("CONSTRAINT ERROR NOT RAISED - " &
+                                       "A.1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED - " &
+                                            "A.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                               REC13 := REC_OOPS;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                                       "A.2");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED - " &
+                                            "A.2");
+                          END;
+                     END P1;
+ 
+                BEGIN
+                     P1 (REC1, REC2, REC3);
+                END P;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.P (PKG.REC91, PKG.REC92, PKG.REC93);
+ 
+      END;   -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91, REC92, REC93  : PKG.RECTYPE(9);
+           REC_OOPS             : PKG.RECTYPE(4);
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE) IS
+ 
+                     PROCEDURE P1 (REC11 : IN RECTYPE;
+                                   REC12 : IN OUT RECTYPE;
+                                   REC13 : OUT RECTYPE) IS
+                     BEGIN
+                          IF (NOT REC11'CONSTRAINED) OR
+                             (REC11.CONSTRAINT /= IDENT_INT(9)) THEN
+                               FAILED ("CONSTRAINT ON PRIVATE " &
+                                       "TYPE IN PARAMETER " &
+                                       "NOT RECOGNIZED");
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                               REC12 := REC_OOPS;
+                               FAILED ("CONSTRAINT ERROR NOT RAISED - " &
+                                       "B.1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED - " &
+                                            "B.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                               REC13 := REC_OOPS;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                                       "B.2");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED - " &
+                                            "B.2");
+                          END;
+                     END P1;
+ 
+                BEGIN
+                     P1 (REC1, REC2, REC3);
+                END P;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.P (REC91, REC92, REC93);
+ 
+      END;   -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     LIMITED PRIVATE;
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91,REC92,REC93  : PKG.RECTYPE(9);
+           REC_OOPS           : PKG.RECTYPE(4);
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE) IS
+ 
+                     PROCEDURE P1 (REC11 : IN RECTYPE;
+                                   REC12 : IN OUT RECTYPE;
+                                   REC13 : OUT RECTYPE) IS
+                     BEGIN
+                          IF (NOT REC11'CONSTRAINED) OR
+                             (REC11.CONSTRAINT /= 9) THEN
+                               FAILED ("CONSTRAINT ON LIMITED PRIVATE " &
+                                       "TYPE IN PARAMETER " &
+                                       "NOT RECOGNIZED");
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                               REC12 := REC_OOPS;
+                               FAILED ("CONSTRAINT ERROR NOT RAISED - " &
+                                       "C.1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED - " &
+                                            "C.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                               REC13 := REC_OOPS;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                                       "C.2");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED - " &
+                                            "C.2");
+                          END;
+                     END P1;
+ 
+                BEGIN
+                     P1 (REC1, REC2, REC3);
+                END P;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.P (REC91, REC92, REC93);
+ 
+      END;   -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64106C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64106d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64106d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,280 ----
+ -- C64106D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED
+ --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+ --    CONSTRAINTS DO NOT RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER
+ --    IS UNCONSTRAINED, EVEN IF THE CONSTRAINT VALUES OF THE OBJECT 
+ --    BEING ASSIGNED ARE DIFFERENT THAN THOSE OF THE ACTUAL PARAMETER.  
+ 
+ --    SUBTESTS ARE:
+ --        (A) UNCONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+ --        (B) UNCONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+ --        (C) UNCONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+ 
+ -- JRK  4/16/81
+ -- CPP  8/9/84
+ -- JRK 11/28/84
+ 
+ WITH REPORT;
+ PROCEDURE C64106D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C64106D", "CHECK ASSIGNMENTS TO FORMAL PARAMETERS OF " &
+                       "UNCONSTRAINED TYPES WITH UNCONSTRAINED " &
+                       "ACTUAL PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+           END PKG;
+ 
+           REC91, REC92, REC93 : PKG.RECTYPE :=
+                (IDENT_INT(5), 5, IDENT_STR("12345"));
+           REC_OOPS            : PKG.RECTYPE;
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE) IS
+ 
+                     PROCEDURE P1 (REC11 : IN RECTYPE;
+                                   REC12 : IN OUT RECTYPE;
+                                   REC13 : OUT RECTYPE) IS
+                     BEGIN
+ 
+                          IF NOT REC11'CONSTRAINED THEN
+                               FAILED ("REC11 IS NOT CONSTRAINED - A.1");
+                          END IF;
+                          IF REC11.CONSTRAINT /= IDENT_INT(9) THEN
+                               FAILED ("REC11 CONSTRAINT IS NOT 9 " &
+                                       "- A.1");
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                               REC12 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ("EXCEPTION RAISED - A.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                               REC13 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ("EXCEPTION RAISED - A.2");
+                          END;
+                     END P1;
+ 
+                BEGIN
+                     P1 (REC1, REC2, REC3);
+                END P;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+           USE PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.P (REC91, REC92, REC93);
+           IF (REC92 /= REC_OOPS) OR (REC93 /= REC_OOPS) THEN
+                FAILED ("RESULTANT VALUE OF REC92 OR REC93 INCORRECT");
+           END IF;
+ 
+      END;   -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91, REC92, REC93  : PKG.RECTYPE;
+           REC_OOPS             : PKG.RECTYPE;
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE) IS
+ 
+                     PROCEDURE P1 (REC11 : IN RECTYPE;
+                                   REC12 : IN OUT RECTYPE;
+                                   REC13 : OUT RECTYPE) IS
+                     BEGIN
+ 
+                          IF REC3'CONSTRAINED THEN
+                               FAILED ("REC3 IS CONSTRAINED - B.1");
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                               REC12 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ("EXCEPTION RAISED - B.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                               REC13 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ("EXCEPTION RAISED - B.2");
+                          END;
+                     END P1;
+ 
+                BEGIN
+                     P1 (REC1, REC2, REC3);
+                END P;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.P (REC91, REC92, REC93);
+ 
+      END;   -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     LIMITED PRIVATE;
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91, REC92, REC93  : PKG.RECTYPE;
+           REC_OOPS             : PKG.RECTYPE;
+ 
+           PACKAGE BODY PKG IS
+ 
+                PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE) IS
+ 
+                     PROCEDURE P1 (REC11 : IN RECTYPE;
+                                   REC12 : IN OUT RECTYPE;
+                                   REC13 : OUT RECTYPE) IS
+                     BEGIN
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                               REC12 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ("EXCEPTION RAISED - C.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                               REC13 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ("EXCEPTION RAISED - C.2");
+                          END;
+                     END P1;
+ 
+                BEGIN
+                     P1 (REC1, REC2, REC3);
+                END P;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.P (REC91, REC92, REC93);
+ 
+      END;   -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C64106D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64107a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64107a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64107a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64107a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C64107A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ACTUAL PARAMETERS ARE EVALUATED AND IDENTIFIED AT THE
+ --   TIME OF CALL.
+ 
+ -- DAS  1/29/81
+ -- SPS 12/13/82
+ 
+ WITH REPORT;
+ PROCEDURE C64107A IS
+ 
+      USE REPORT;
+ 
+      TYPE VECTOR IS ARRAY (1..10) OF INTEGER;
+      TYPE PTRINT IS ACCESS INTEGER;
+ 
+      I    : INTEGER := 1;
+      A    : VECTOR  := (1,2,3,4,5,6,7,8,9,10);
+      P1   : PTRINT  := NEW INTEGER'(2);
+      P2   : PTRINT  := P1;
+ 
+      PROCEDURE PROC1 (I : OUT INTEGER; J : OUT INTEGER) IS
+      BEGIN
+           I := 10;
+           J := -1;
+      END PROC1;
+ 
+      PROCEDURE PROC2 (P : OUT PTRINT; I : OUT INTEGER) IS
+      BEGIN
+           P := NEW INTEGER'(3);
+           I := 5;
+      END PROC2;
+ 
+ BEGIN
+ 
+      TEST ("C64107A", "CHECK THAT ACTUAL PARAMETERS ARE EVALUATED" &
+                       " AND IDENTIFIED AT THE TIME OF CALL");
+ 
+      PROC1 (I, A(I));
+      IF (A /= (-1,2,3,4,5,6,7,8,9,10)) THEN
+           FAILED ("A(I) EVALUATED UPON RETURN");
+      END IF;
+ 
+      PROC2 (P1, P1.ALL);
+      IF (P2.ALL /= 5) THEN
+           FAILED ("P1.ALL EVALUATED UPON RETURN");
+      END IF;
+ 
+      RESULT;
+ 
+ END C64107A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64108a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64108a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64108a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- C64108A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL PERMITTED FORMS OF VARIABLE NAMES ARE PERMITTED
+ --   AS ACTUAL PARAMETERS.
+ 
+ -- DAS 2/10/81
+ -- SPS 10/26/82
+ -- SPS 11/5/82
+ 
+ WITH REPORT;
+ PROCEDURE C64108A IS
+ 
+      USE REPORT;
+      SUBTYPE INT IS INTEGER RANGE 1..3;
+      TYPE REC (N : INT) IS
+           RECORD
+                S : STRING (1..N);
+           END RECORD;
+      TYPE PTRSTR IS ACCESS STRING;
+ 
+      R1,R2,R3 : REC(3);
+      S1,S2,S3 : STRING (1..3);
+      PTRTBL   : ARRAY (1..3) OF PTRSTR;
+ 
+      PROCEDURE P1 (S1 : IN STRING; S2: IN OUT STRING; 
+                    S3 : OUT STRING) IS
+      BEGIN
+           S3 := S2;
+           S2 := S1;
+      END P1;
+ 
+      PROCEDURE P2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
+                    C3 : OUT CHARACTER) IS
+      BEGIN
+           C3 := C2;
+           C2 := C1;
+      END P2;
+ 
+      FUNCTION F1 (X : INT) RETURN PTRSTR IS
+      BEGIN
+           RETURN PTRTBL(X);
+      END F1;
+ 
+      FUNCTION "+" (S1,S2 : STRING) RETURN PTRSTR IS
+      BEGIN
+           RETURN PTRTBL(CHARACTER'POS(S1(1))-CHARACTER'POS('A')+1);
+      END "+";
+ 
+ BEGIN
+ 
+      TEST ("C64108A", "CHECK THAT ALL PERMITTED FORMS OF VARIABLE" &
+                       " NAMES ARE PERMITTED AS ACTUAL PARAMETERS");
+ 
+      S1 := "AAA";
+      S2 := "BBB";
+      P1 (S1, S2, S3);
+      IF (S2 /= "AAA") OR (S3 /= "BBB") THEN
+           FAILED ("SIMPLE VARIABLE AS AN ACTUAL PARAMETER NOT WORKING");
+      END IF;
+ 
+      S1 := "AAA";
+      S2 := "BBB";
+      S3 := IDENT_STR("CCC");
+      P2 (S1(1), S2(IDENT_INT(1)), S3(1));
+      IF (S2 /= "ABB") OR (S3 /= "BCC") THEN
+           FAILED ("INDEXED COMPONENT AS AN ACTUAL PARAMETER NOT " &
+                   "WORKING");
+      END IF;
+ 
+      R1.S := "AAA";
+      R2.S := "BBB";
+      P1 (R1.S, R2.S, R3.S);
+      IF (R2.S /= "AAA") OR (R3.S /= "BBB") THEN
+           FAILED ("SELECTED COMPONENT AS AN ACTUAL PARAMETER" &
+                   " NOT WORKING");
+      END IF;
+ 
+      S1 := "AAA";
+      S2 := "BBB";
+      P1 (S1(1..IDENT_INT(2)), S2(1..2), S3(IDENT_INT(1)..IDENT_INT(2)));
+      IF (S2 /= "AAB") OR (S3 /= "BBC") THEN
+           FAILED ("SLICE AS AN ACTUAL PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      P1 (F1(1).ALL, F1(2).ALL, F1(IDENT_INT(3)).ALL);
+      IF (PTRTBL(2).ALL /= "AAA") OR (PTRTBL(3).ALL /= "BBB") THEN
+           FAILED ("SELECTED COMPONENT OF FUNCTION VALUE AS AN ACTUAL" &
+                   " PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      S1 := IDENT_STR("AAA");
+      S2 := IDENT_STR("BBB");
+      S3 := IDENT_STR("CCC");
+      P1 ("+"(S1,S1).ALL, "+"(S2,S2).ALL, "+"(S3,S3).ALL);
+      IF (PTRTBL(2).ALL /= "AAA") OR (PTRTBL(3).ALL /= "BBB") THEN
+           FAILED ("SELECTED COMPONENT OF OVERLOADED OPERATOR FUNCTION" &
+                   " VALUE AS AN ACTUAL PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      P2 (F1(1)(1), F1(IDENT_INT(2))(1), F1(3)(IDENT_INT(1)));
+      IF (PTRTBL(2).ALL /= "ABB") OR (PTRTBL(3).ALL /= "BCC") THEN
+           FAILED ("INDEXED COMPONENT OF FUNCTION VALUE AS AN ACTUAL" &
+                   " PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      P1 (F1(1)(2..3), F1(2)(IDENT_INT(2)..3), F1(3)(2..IDENT_INT(3)));
+      IF (PTRTBL(2).ALL /= "BAA") OR (PTRTBL(3).ALL /= "CBB") THEN
+           FAILED ("SLICE OF FUNCTION VALUE AS AN ACTUAL PARAMETER" &
+                   " NOT WORKING");
+      END IF;
+ 
+      RESULT;
+ 
+ END C64108A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C64109A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+ -- TO SUBPROGRAMS.  SPECIFICALLY,
+ --   (A) CHECK ALL PARAMETER MODES.
+ 
+ -- CPP 8/20/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109A IS
+ 
+ BEGIN
+      TEST ("C64109A", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS");
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (A)
+ 
+           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
+           TYPE RECORD_TYPE IS
+                RECORD
+                     I : INTEGER;
+                     A : ARRAY_SUBTYPE;
+                END RECORD;
+           REC : RECORD_TYPE := (I => 23,
+                                 A => (1..3 => IDENT_INT(7), 4..5 => 9));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (7, 7, 7, 9, 9) THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(1) OR
+                   ARR'LAST /= IDENT_INT(5) THEN
+                     FAILED ("WRONG BOUNDS FOR IN PARAMETER");
+                END IF;
+           END P1;
+ 
+           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (7, 7, 7, 9, 9) THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY TO FN");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(1) OR
+                   ARR'LAST /= IDENT_INT(5) THEN
+                     FAILED ("WRONG BOUNDS FOR IN PARAMETER FOR FN");
+                END IF;
+ 
+                RETURN TRUE;
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (7, 7, 7, 9, 9) THEN
+                     FAILED ("IN OUT PARAMETER NOT PASSED " &
+                             "CORRECTLY");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(1) OR
+                   ARR'LAST /= IDENT_INT(5) THEN
+                     FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
+                END IF;
+                ARR := (ARR'RANGE => 5);
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR'FIRST /= IDENT_INT(1) OR
+                   ARR'LAST /= IDENT_INT(5) THEN
+                     FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
+                END IF;
+ 
+                ARR := (ARR'RANGE => 3);
+           END P3;
+ 
+      BEGIN     -- (A)
+ 
+           P1 (REC.A);
+           IF REC.A /= (7, 7, 7, 9, 9) THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE");
+           END IF;
+ 
+           BOOL := F1 (REC.A);
+           IF REC.A /= (7, 7, 7, 9, 9) THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION");
+           END IF;
+ 
+           P2 (REC.A);
+           IF REC.A /= (5, 5, 5, 5, 5) THEN
+                FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+           END IF;
+ 
+           P3 (REC.A);
+           IF REC.A /= (3, 3, 3, 3, 3) THEN
+                FAILED ("OUT PARAM RETURNED INCORRECTLY");
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------
+ 
+      RESULT;
+ END C64109A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,155 ----
+ -- C64109B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+ -- TO SUBPROGRAMS.  SPECIFICALLY,
+ --   (B) CHECK MULTIDIMENSIONAL ARRAYS.
+ 
+ -- CPP 8/20/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109B IS
+ 
+ BEGIN
+      TEST ("C64109B", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+            "MULTIDIMENSIONAL ARRAYS");
+ 
+      DECLARE   -- (B)
+ 
+           TYPE MULTI_TYPE IS ARRAY (POSITIVE RANGE <>, 
+                                     POSITIVE RANGE <>) OF BOOLEAN;
+           SUBTYPE MULTI_SUBTYPE IS MULTI_TYPE (1..2, 1..3);
+           TYPE RECORD_TYPE IS
+                RECORD
+                     I : BOOLEAN;
+                     A : MULTI_SUBTYPE;
+                END RECORD;
+           REC : RECORD_TYPE :=
+                     (I => FALSE,
+                      A => (1..2 => (1..3 => IDENT_BOOL(TRUE))));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : MULTI_TYPE) IS
+           BEGIN
+                IF ARR /= (1..2 => (1..3 => TRUE)) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                     FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER");
+                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                   THEN 
+                     FAILED ("2ND DIM NOT CORRECT - IN PARAMETER");
+                END IF;                  
+           END P1;
+ 
+           FUNCTION F1 (ARR : MULTI_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (1..2 => (1..3 => TRUE)) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+ 
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                     FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER FN");
+                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                   THEN 
+                     FAILED ("2ND DIM NOT CORRECT - IN PARAMETER FN");
+                END IF;                  
+                RETURN TRUE;
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT MULTI_TYPE) IS
+           BEGIN
+                IF ARR /= (1..2 => (1..3 => TRUE)) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                     FAILED ("FIRST DIM NOT CORRECT - IN OUT PARAMETER");
+                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                   THEN 
+                     FAILED ("2ND DIM NOT CORRECT - IN OUT PARAMETER");
+                END IF;                  
+                ARR := (ARR'RANGE(1) => (ARR'RANGE(2) => FALSE));
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT MULTI_TYPE) IS
+           BEGIN
+                FOR I IN 1 .. 2 LOOP
+                     FOR J IN 1 .. 3 LOOP
+                          IF (J MOD 2) = 0 THEN
+                               ARR(I, J) := TRUE;
+                          ELSE
+                               ARR(I, J) := FALSE;
+                          END IF;
+                     END LOOP;
+                END LOOP;
+ 
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                     FAILED ("FIRST DIM NOT CORRECT - OUT PARAMETER");
+                ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                   THEN 
+                     FAILED ("2ND DIM NOT CORRECT - OUT PARAMETER");
+                END IF;                  
+           END P3;
+ 
+      BEGIN     -- (B)
+ 
+           P1 (REC.A);
+           IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE");
+           END IF;
+ 
+           BOOL := F1 (REC.A);
+           IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION");
+           END IF;
+ 
+           P2 (REC.A);
+           IF REC.A /= (1..2 => (1..3 => FALSE)) THEN
+                FAILED ("IN OUT PARAM CHANGED BY PROCEDURE");
+           END IF;
+ 
+           P3 (REC.A);
+           FOR I IN 1 .. 2 LOOP
+                FOR J IN 1 .. 3 LOOP
+                     IF (J MOD 2) = 0 THEN
+                          IF REC.A(I, J) /= TRUE THEN
+                               FAILED ("OUT PARAM RETURNED " &
+                                       "INCORRECTLY - (B)");
+                          END IF;
+                     ELSE
+                          IF REC.A(I, J) /= FALSE THEN
+                               FAILED ("OUT PARAM RETURNED " &
+                                       "INCORRECTLY - (B)2");
+                          END IF;
+                     END IF;
+                END LOOP;
+           END LOOP;
+ 
+      END; -- (B)
+ 
+      RESULT;
+ END C64109B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,127 ----
+ -- C64109C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+ -- TO SUBPROGRAMS.  SPECIFICALLY,
+ --   (C) CHECK RECORDS HAVING A DISCRIMINANT, WITH MORE THAN ONE ARRAY
+ --       COMPONENT, WHERE THE BOUNDS OF THE ARRAY DEPEND ON THE
+ --       DISCRIMINANT.
+ 
+ -- CPP 8/20/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109C IS
+ 
+ BEGIN
+      TEST ("C64109C", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+            "RECORDS WITH DISCRIMINANTS");
+ 
+      DECLARE   -- (C)
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 1..6;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+           TYPE RECORD_TYPE (BOUND : INTEGER) IS
+                RECORD
+                     B : BOOLEAN;
+                     A : ARRAY_TYPE (1..BOUND);
+                     AA : ARRAY_TYPE (BOUND..6);
+                END RECORD;
+           REC : RECORD_TYPE (BOUND => IDENT_INT(4)) :=
+                                (BOUND => 4,
+                                 B => TRUE,
+                                 A => (1..IDENT_INT(4) => 6),
+                                 AA => (4..6 => 8));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (6, 6, 6, 6) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER");
+                END IF;
+           END P1;
+ 
+           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (6, 6, 6, 6) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+ 
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+                END IF;
+                RETURN TRUE;
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (8, 8, 8) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= 4 OR ARR'LAST /= IDENT_INT(6) THEN
+                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+                END IF;
+ 
+                ARR := (ARR'RANGE => 10);
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
+                END IF;
+                ARR := (ARR'RANGE => 4);
+           END P3;
+ 
+      BEGIN     -- (C)
+ 
+           P1 (REC.A);
+           IF REC.A /= (6, 6, 6, 6) THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE");
+           END IF;
+ 
+           BOOL := F1 (REC.A);
+           IF REC.A /= (6, 6, 6, 6) THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION");
+           END IF;
+ 
+           P2 (REC.AA);
+           IF REC.AA /= (10, 10, 10) THEN
+                FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+           END IF;
+ 
+           P3 (REC.A);
+           IF REC.A /= (4, 4, 4, 4) THEN
+                FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+           END IF;
+ 
+      END; -- (C)
+ 
+      RESULT;
+ END C64109C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C64109D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+ -- TO SUBPROGRAMS.  SPECIFICALLY,
+ --   (D) CHECK OBJECTS DESIGNATED BY ACCESS TYPES.
+ 
+ -- CPP 8/20/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109D IS
+ 
+ BEGIN
+      TEST ("C64109D", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+            "OBJECTS DESIGNATED BY ACCESS TYPES");
+ 
+      DECLARE   -- (D)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..3;
+           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>) OF INTEGER;
+           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(3));
+           TYPE NODE_TYPE;
+           TYPE ACCESS_TYPE IS ACCESS NODE_TYPE;
+           TYPE NODE_TYPE IS
+                RECORD
+                     A    : ARRAY_SUBTYPE;
+                     NEXT : ACCESS_TYPE;
+                END RECORD;
+           PTR : ACCESS_TYPE := NEW NODE_TYPE'
+                     (A => (IDENT_INT(1)..3 => IDENT_INT(5)),
+                      NEXT => NULL);
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (5, 5, 5) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER");
+                END IF;
+           END P1;
+ 
+           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (5, 5, 5) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+                END IF;
+ 
+                RETURN TRUE;
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_SUBTYPE) IS
+           BEGIN
+                IF ARR /= (5, 5, 5) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+                END IF;
+ 
+                ARR := (OTHERS => 6);
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+           BEGIN
+ 
+                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
+                END IF;
+ 
+                ARR := (ARR'RANGE => 7);
+           END P3;
+ 
+      BEGIN     -- (D)
+ 
+           P1 (PTR.A);
+           IF PTR.A /= (5, 5, 5) THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE");
+           END IF;
+ 
+           BOOL := F1 (PTR.A);
+           IF PTR.A /= (5, 5, 5) THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION");
+           END IF;
+ 
+           P2 (PTR.A);
+           IF PTR.A /= (6, 6, 6) THEN
+                FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+           END IF;
+ 
+           P3 (PTR.A);
+           IF PTR.A /= (7, 7, 7) THEN
+                FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+           END IF;
+ 
+      END; -- (D)
+ 
+      RESULT;
+ END C64109D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- C64109E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+ -- TO SUBPROGRAMS.  SPECIFICALLY,
+ --   (E) CHECK THE CASE WHERE THE FORMAL IS UNCONSTRAINED, AND ARRAYS
+ --       WITH DIFFERENT BOUNDS ARE PASSED AS ACTUALS.
+ 
+ -- CPP 8/20/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109E IS
+ 
+ BEGIN
+      TEST ("C64109E", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+            "ARRAYS WITH DIFFERENT BOUNDS PASSED TO UNCONSTRAINED " &
+            "FORMAL");
+ 
+      DECLARE   -- (E)
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 0..5;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+           TYPE RECORD_TYPE IS
+                RECORD
+                     A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(2));
+                     B : ARRAY_TYPE (1..3);
+                END RECORD;
+           REC : RECORD_TYPE := (A => (0..2 => IDENT_BOOL(TRUE)),
+                                 B => (1..3 => IDENT_BOOL(FALSE)));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS - 1");
+                END IF;
+                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
+                END IF;
+                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS - 2");
+                END IF;
+           END P1;
+ 
+           FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) 
+                RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
+                END IF;
+                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
+                END IF;
+                RETURN TRUE;
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
+                         ARR2 : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
+                END IF;
+                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
+                END IF;
+                ARR := (ARR'RANGE => FALSE);
+                ARR2 := (ARR2'RANGE => TRUE);
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                     FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
+                END IF;
+                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG OUT  PARAMETER BOUNDS - 2");
+                END IF;
+                ARR := (ARR'RANGE => FALSE);
+                ARR2 := (ARR2'RANGE => TRUE);
+           END P3;
+ 
+      BEGIN     -- (E)
+ 
+           P1 (REC.A, REC.B);
+           IF REC.A /= (TRUE, TRUE, TRUE) THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE");
+           END IF;
+           IF REC.B /= (FALSE, FALSE, FALSE) THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
+           END IF;
+ 
+           BOOL := F1 (REC.A, REC.B);
+           IF REC.A /= (TRUE, TRUE, TRUE) THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION");
+           END IF;
+           IF REC.B /= (FALSE, FALSE, FALSE) THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
+           END IF;
+ 
+           P2 (REC.A, REC.B);
+           IF REC.A /= (FALSE, FALSE, FALSE) THEN
+                FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+           END IF;
+           IF REC.B /= (TRUE, TRUE, TRUE) THEN
+                FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
+           END IF;
+ 
+           P3 (REC.A, REC.B);
+           IF REC.A /= (FALSE, FALSE, FALSE) THEN
+                FAILED ("OUT PARAM RETURNED INCORRECTLY");
+           END IF;
+           IF REC.B /= (TRUE, TRUE, TRUE) THEN
+                FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
+           END IF;
+ 
+      END; -- (E)
+ 
+      RESULT;
+ END C64109E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,126 ----
+ -- C64109F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+ -- TO SUBPROGRAMS.  SPECIFICALLY,
+ --   (F) CHECK THAT A FORMAL PARAMETER CAN BE USED AS AN ACTUAL IN
+ --       ANOTHER CALL.
+ 
+ -- CPP 8/20/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109F IS
+ 
+ BEGIN
+      TEST ("C64109F", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+            "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+            "FORMAL AS AN ACTUAL");
+ 
+      DECLARE   -- (F)
+ 
+           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           SUBTYPE ARRAY_SUBTYPE IS 
+                     ARRAY_TYPE (IDENT_INT(1)..IDENT_INT(5));
+           TYPE RECORD_TYPE IS
+                RECORD
+                     I : INTEGER;
+                     A : ARRAY_SUBTYPE;
+                END RECORD;
+           REC : RECORD_TYPE := (I => 23,
+                                 A => (1..3 => 7, 4..5 => 9));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P_CALLED (A : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF A /= (7, 7, 7, 9, 9) THEN
+                     FAILED ("IN OUT PARAM NOT RECEIVED CORRECTLY");
+                END IF;
+                IF A'FIRST /= 1 OR A'LAST /= 5 THEN
+                     FAILED ("BOUNDS WRONG - IN OUT");
+                END IF;
+                A := (6, 6, 6, 6, 6);
+           END P_CALLED;
+ 
+           PROCEDURE P (A : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                P_CALLED (A);
+           END P;
+ 
+           FUNCTION F_CALLED (A : ARRAY_SUBTYPE) RETURN BOOLEAN IS
+                GOOD : BOOLEAN;
+           BEGIN
+                GOOD := (A = (7, 7, 7, 9, 9));
+                IF NOT GOOD THEN
+                     FAILED ("IN PARAMETER NOT RECEIVED CORRECTLY");
+                END IF;
+                IF A'FIRST /= 1 OR A'LAST /= IDENT_INT(5) THEN
+                     FAILED ("BOUNDS WRONG - FUNCTION");
+                END IF;
+                RETURN GOOD;
+           END F_CALLED;
+ 
+           FUNCTION F (A : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                RETURN (F_CALLED (A));
+           END F;
+ 
+           PROCEDURE P_OUT_CALLED (A : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF A'FIRST /= 1 OR A'LAST /= 5 THEN
+                     FAILED ("BOUNDS WRONG - OUT");
+                END IF;
+                A := (8, 8, 8, 8, 8);
+           END P_OUT_CALLED;
+ 
+           PROCEDURE P_OUT (A : OUT ARRAY_TYPE) IS
+           BEGIN
+                P_OUT_CALLED (A);
+                A := (9, 9, 9, 9, 9);
+           END P_OUT;
+ 
+      BEGIN     -- (F)
+ 
+           P (REC.A);
+           IF REC.A /= (6, 6, 6, 6, 6) THEN
+                FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+           END IF;
+ 
+           REC.A := (7, 7, 7, 9, 9);
+           BOOL := F (REC.A);
+           IF NOT BOOL THEN
+                FAILED ("IN PARAM NOT RETURNED CORRECTLY");
+           END IF;
+ 
+           REC.A := (7, 7, 7, 9, 9);
+           P_OUT (REC.A);
+           IF REC.A /= (9, 9, 9, 9, 9) THEN
+                FAILED ("OUT PARAM NOT RETURNED CORRECTLY - 2");
+           END IF;
+ 
+      END; -- (F)
+ 
+      --------------------------------------------
+ 
+      RESULT;
+ END C64109F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C64109G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SLICES OF ARRAYS ARE PASSED CORRECTLY TO SUBPROGRAMS.
+ -- SPECIFICALLY,
+ --   (A) CHECK ALL PARAMETER MODES.
+ 
+ -- CPP 8/28/84
+ -- PWN 05/31/96  Corrected spelling problem.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109G IS
+ 
+ BEGIN
+      TEST ("C64109G", "CHECK THAT SLICES OF ARRAYS ARE PASSED " &
+            "CORRECTLY TO SUBPROGRAMS");
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (A)
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 1..5;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+           ARR : ARRAY_TYPE (1..5) := (1..3 => 7, 4..5 => 9);
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (S : ARRAY_TYPE) IS
+           BEGIN
+                IF S(IDENT_INT(3)) /= 7 THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)");
+                END IF;
+                IF S(4) /= 9 THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)2");
+                END IF;
+           END P1;
+ 
+           FUNCTION F1 (S : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF S(3) /= 7 THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)");
+                END IF;
+                IF S(IDENT_INT(4)) /= 9 THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)2");
+                END IF;
+                RETURN TRUE;
+           END F1;
+ 
+           PROCEDURE P2 (S : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF S(3) /= 7 THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY - (A)");
+                END IF;
+                IF S(4) /= 9 THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY - (A)2");
+                END IF;
+                FOR I IN 3 .. 4 LOOP
+                     S(I) := 5;
+                END LOOP;
+           END P2;
+ 
+           PROCEDURE P3 (S : OUT ARRAY_TYPE) IS
+           BEGIN
+                FOR I IN 3 .. 4 LOOP
+                     S(I) := 3;
+                END LOOP;
+           END P3;
+ 
+      BEGIN     -- (A)
+ 
+           P1 (ARR(3..4));
+           IF ARR(3) /= 7 THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE - (A)");
+           END IF;
+           IF ARR(4) /= 9 THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE - (A)2");
+           END IF;
+ 
+           BOOL := F1 (ARR(IDENT_INT(3)..IDENT_INT(4)));
+           IF ARR(3) /= 7 THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION - (A)");
+           END IF;
+           IF ARR(4) /= 9 THEN
+                FAILED ("IN PARAM CHANGED BY FUNCTION - (A)2");
+           END IF;
+ 
+           P2 (ARR(3..4));
+           FOR I IN 3 .. 4 LOOP
+                IF ARR(I) /= 5 THEN
+                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY - (A)");
+                END IF;
+           END LOOP;
+ 
+           P3 (ARR(IDENT_INT(3)..4));
+           FOR I IN 3 .. 4 LOOP
+                IF ARR(I) /= 3 THEN
+                     FAILED ("OUT PARAM RETURNED INCORRECTLY - (A)");
+                END IF;
+           END LOOP;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C64109G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,160 ----
+ -- C64109H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+ --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+ --       (A) CHECK ALL PARAMETER MODES.
+ 
+ -- HISTORY:
+ --    TBN 07/11/86          CREATED ORIGINAL TEST.
+ --    JET 08/04/87          MODIFIED REC.A REFERENCES.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C64109H IS
+ 
+ BEGIN
+      TEST ("C64109H", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                       "TO SUBPROGRAMS");
+ 
+      DECLARE   -- (A)
+ 
+           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
+           TYPE RECORD_TYPE IS
+                RECORD
+                     I : INTEGER;
+                     A : ARRAY_SUBTYPE;
+                END RECORD;
+           REC : RECORD_TYPE := (I => 23,
+                                 A => (1..3 => IDENT_INT(7), 4..5 => 9));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (7, 9, 9) THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(3) OR
+                   ARR'LAST /= IDENT_INT(5) THEN
+                     FAILED ("WRONG BOUNDS FOR IN PARAMETER");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+           END P1;
+ 
+           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (7, 7, 9) THEN
+                     FAILED ("IN PARAMETER NOT PASSED CORRECTLY TO FN");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(2) OR
+                   ARR'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG BOUNDS FOR IN PARAMETER FOR FN");
+                END IF;
+ 
+                RETURN TRUE;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (7, 7, 7, 9) THEN
+                     FAILED ("IN OUT PARAMETER NOT PASSED " &
+                             "CORRECTLY");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(1) OR
+                   ARR'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
+                END IF;
+                ARR := (ARR'RANGE => 5);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR'FIRST /= IDENT_INT(3) OR
+                   ARR'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
+                END IF;
+ 
+                ARR := (ARR'RANGE => 3);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+           END P3;
+ 
+      BEGIN     -- (A)
+ 
+           BEGIN     -- (B)
+                P1 (REC.A (3..5));
+                IF REC.A /= (7, 7, 7, 9, 9) THEN
+                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+           END;     -- (B)
+ 
+           BEGIN     -- (C)
+                BOOL := F1 (REC.A (2..4));
+                IF REC.A /= (7, 7, 7, 9, 9) THEN
+                     FAILED ("IN PARAM CHANGED BY FUNCTION");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+           END;     -- (C)
+ 
+           BEGIN     -- (D)
+                P2 (REC.A (1..4));
+                IF REC.A /= (5, 5, 5, 5, 9) THEN
+                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+           END;     -- (D)
+ 
+           BEGIN     -- (E)
+                P3 (REC.A (3..4));
+                IF REC.A /= (5, 5, 3, 3, 9) THEN
+                     FAILED ("OUT PARAM RETURNED INCORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+           END;     -- (E)
+ 
+      END; -- (A)
+ 
+      RESULT;
+ END C64109H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- C64109I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+ --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+ --    (C) CHECK RECORDS HAVING A DISCRIMINANT, WITH MORE THAN ONE ARRAY
+ --       COMPONENT, WHERE THE BOUNDS OF THE ARRAY DEPEND ON THE
+ --       DISCRIMINANT.
+ 
+ -- HISTORY:
+ --    TBN 07/10/86          CREATED ORIGINAL TEST.
+ --    JET 08/04/87          REMOVED PARTIAL ARRAY REFERENCES IN
+ --                          RECORD FIELDS.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109I IS
+ 
+ BEGIN
+      TEST ("C64109I", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                       "TO SUBPROGRAMS - RECORDS WITH DISCRIMINANTS");
+ 
+      DECLARE   -- (C)
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 1..6;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+           TYPE RECORD_TYPE (BOUND : INTEGER) IS
+                RECORD
+                     B : BOOLEAN;
+                     A : ARRAY_TYPE (1..BOUND);
+                     AA : ARRAY_TYPE (BOUND..6);
+                END RECORD;
+           REC : RECORD_TYPE (BOUND => IDENT_INT(4)) :=
+                                (BOUND => 4,
+                                 B => TRUE,
+                                 A => (1..IDENT_INT(4) => 6),
+                                 AA => (4..6 => 8));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (6, 6, 6) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+           END P1;
+ 
+           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (6, 6, 6) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+ 
+                IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+                END IF;
+                RETURN TRUE;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (8, 8) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= 4 OR ARR'LAST /= IDENT_INT(5) THEN
+                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+                END IF;
+ 
+                ARR := (ARR'RANGE => 10);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
+                END IF;
+                ARR := (ARR'RANGE => 4);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+           END P3;
+ 
+      BEGIN     -- (C)
+ 
+           BEGIN     -- (D)
+                P1 (REC.A (1..3));
+                IF REC.A /= (6, 6, 6, 6) THEN
+                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+           END;     -- (D)
+ 
+           BEGIN     -- (E)
+                BOOL := F1 (REC.A (2..4));
+                IF REC.A /= (6, 6, 6, 6) THEN
+                     FAILED ("IN PARAM CHANGED BY FUNCTION");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+           END;     -- (E)
+ 
+           BEGIN     -- (F)
+                P2 (REC.AA (4..5));
+                IF REC.AA /= (10, 10, 8) THEN
+                     FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+           END;     -- (F)
+ 
+           BEGIN     -- (G)
+                P3 (REC.A (2..3));
+                IF REC.A /= (6, 4, 4, 6) THEN
+                     FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+           END;     -- (G)
+ 
+      END; -- (C)
+ 
+      RESULT;
+ END C64109I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C64109J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+ --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+ --      (D) CHECK OBJECTS DESIGNATED BY ACCESS TYPES.
+ 
+ -- HISTORY:
+ --    TBN 07/10/86          CREATED ORIGINAL TEST.
+ --    JET 08/04/87          MODIFIED PTR.A REFERENCES.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C64109J IS
+ 
+ BEGIN
+      TEST ("C64109J", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                       "TO SUBPROGRAMS - OBJECTS DESIGNATED BY ACCESS " &
+                       "TYPES");
+ 
+      DECLARE   -- (D)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..5;
+           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>) OF INTEGER;
+           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
+           TYPE NODE_TYPE;
+           TYPE ACCESS_TYPE IS ACCESS NODE_TYPE;
+           TYPE NODE_TYPE IS
+                RECORD
+                     A    : ARRAY_SUBTYPE;
+                     NEXT : ACCESS_TYPE;
+                END RECORD;
+           PTR : ACCESS_TYPE := NEW NODE_TYPE'
+                     (A => (IDENT_INT(1)..5 => IDENT_INT(5)),
+                      NEXT => NULL);
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (5, 5, 5) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+           END P1;
+ 
+           FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (5, 5, 5) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
+                     FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+                END IF;
+ 
+                RETURN TRUE;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (5, 5, 5) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+ 
+                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                     FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+                END IF;
+ 
+                ARR := (ARR'RANGE => 6);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+           BEGIN
+ 
+                IF ARR'FIRST /= IDENT_INT(3) OR ARR'LAST /= 5 THEN
+                     FAILED ("WRONG BOUNDS - OUT PARAMETER");
+                END IF;
+ 
+                ARR := (ARR'RANGE => 7);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+           END P3;
+ 
+      BEGIN     -- (D)
+ 
+           BEGIN     -- (E)
+                P1 (PTR.A (1..3));
+                IF PTR.A /= (5, 5, 5, 5, 5) THEN
+                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+           END;     -- (E)
+ 
+           BEGIN     -- (F)
+                BOOL := F1 (PTR.A (2..4));
+                IF PTR.A /= (5, 5, 5, 5, 5) THEN
+                     FAILED ("IN PARAM CHANGED BY FUNCTION");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+           END;     -- (F)
+ 
+           BEGIN     -- (G)
+                P2 (PTR.A (1..3));
+                IF PTR.A /= (6, 6, 6, 5, 5) THEN
+                     FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+           END;     -- (G)
+ 
+           BEGIN     -- (H)
+                P3 (PTR.A (3..5));
+                IF PTR.A /= (6, 6, 7, 7, 7) THEN
+                     FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+           END;     -- (H)
+ 
+      END; -- (D)
+ 
+      RESULT;
+ END C64109J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- C64109K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+ --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+ --    (E) CHECK THE CASE WHERE THE FORMAL IS UNCONSTRAINED, AND ARRAYS
+ --       WITH DIFFERENT BOUNDS ARE PASSED AS ACTUALS.
+ 
+ -- HISTORY:
+ --    TBN 07/11/86          CREATED ORIGINAL TEST.
+ --    JET 08/04/87          MODIFIED REC.A REFERENCES.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C64109K IS
+ 
+ BEGIN
+      TEST ("C64109K", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                       "TO SUBPROGRAMS - ARRAYS WITH DIFFERENT BOUNDS " &
+                       "PASSED TO UNCONSTRAINED FORMAL");
+ 
+      DECLARE   -- (E)
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 0..5;
+           TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+           TYPE RECORD_TYPE IS
+                RECORD
+                     A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(4));
+                     B : ARRAY_TYPE (1..5);
+                END RECORD;
+           REC : RECORD_TYPE := (A => (0..4 => IDENT_BOOL(TRUE)),
+                                 B => (1..5 => IDENT_BOOL(FALSE)));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS - 1");
+                END IF;
+                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
+                END IF;
+                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS - 2");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+           END P1;
+ 
+           FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE)
+                RETURN BOOLEAN IS
+           BEGIN
+                IF ARR /= (TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
+                END IF;
+                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+                END IF;
+                IF ARR2'FIRST /= 3 OR ARR2'LAST /= IDENT_INT(5) THEN
+                     FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
+                END IF;
+                RETURN TRUE;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+           END F1;
+ 
+           PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
+                         ARR2 : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR /= (TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+                IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
+                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
+                END IF;
+                IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+                END IF;
+                IF ARR2'FIRST /= 2 OR ARR2'LAST /= IDENT_INT(4) THEN
+                     FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
+                END IF;
+                ARR := (ARR'RANGE => FALSE);
+                ARR2 := (ARR2'RANGE => TRUE);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+           END P2;
+ 
+           PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                     FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
+                END IF;
+                IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                     FAILED ("WRONG OUT  PARAMETER BOUNDS - 2");
+                END IF;
+                ARR := (ARR'RANGE => FALSE);
+                ARR2 := (ARR2'RANGE => TRUE);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+           END P3;
+ 
+      BEGIN     -- (E)
+ 
+           BEGIN     -- (F)
+                P1 (REC.A (0..2), REC.B (1..3));
+                IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN PARAM CHANGED BY PROCEDURE");
+                END IF;
+                IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+           END;     -- (F)
+ 
+           BEGIN     -- (G)
+                BOOL := F1 (REC.A (1..3), REC.B (3..5));
+                IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
+                     FAILED ("IN PARAM CHANGED BY FUNCTION");
+                END IF;
+                IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+           END;     -- (G)
+ 
+           BEGIN     -- (H)
+                P2 (REC.A (2..4), REC.B (2..4));
+                IF REC.A /= (TRUE, TRUE, FALSE, FALSE, FALSE) THEN
+                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+                END IF;
+                IF REC.B /= (FALSE, TRUE, TRUE, TRUE, FALSE) THEN
+                     FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+           END;     -- (H)
+ 
+           BEGIN     -- (I)
+                P3 (REC.A (0..2), REC.B (1..3));
+                IF REC.A /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
+                     FAILED ("OUT PARAM RETURNED INCORRECTLY");
+                END IF;
+                IF REC.B /= (TRUE, TRUE, TRUE, TRUE, FALSE) THEN
+                     FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+           END;     -- (I)
+ 
+      END; -- (E)
+ 
+      RESULT;
+ END C64109K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64109l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64109l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C64109L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+ --    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+ --       (F) CHECK THAT A FORMAL PARAMETER CAN BE USED AS AN ACTUAL IN
+ --       ANOTHER SUBPROGRAM CALL.
+ 
+ -- HISTORY:
+ --    TBN 07/11/86          CREATED ORIGINAL TEST.
+ --    JET 08/04/87          MODIFIED REC.A REFERENCES.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C64109L IS
+ 
+ BEGIN
+      TEST ("C64109L", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                       "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                       "TO SUBPROGRAMS - FORMAL AS AN ACTUAL");
+ 
+      DECLARE   -- (F)
+ 
+           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           SUBTYPE ARRAY_SUBTYPE IS
+                     ARRAY_TYPE (IDENT_INT(1)..IDENT_INT(5));
+           TYPE RECORD_TYPE IS
+                RECORD
+                     I : INTEGER;
+                     A : ARRAY_SUBTYPE;
+                END RECORD;
+           REC : RECORD_TYPE := (I => 23,
+                                 A => (1..3 => 7, 4..5 => 9));
+           BOOL : BOOLEAN;
+ 
+           PROCEDURE P_CALLED (A : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                IF A /= (7, 7, 7) THEN
+                     FAILED ("IN OUT PARAM NOT RECEIVED CORRECTLY");
+                END IF;
+                IF A'FIRST /= 1 OR A'LAST /= IDENT_INT(3) THEN
+                     FAILED ("BOUNDS WRONG - IN OUT");
+                END IF;
+                A := (A'RANGE => 6);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P_CALLED");
+           END P_CALLED;
+ 
+           PROCEDURE P (A : IN OUT ARRAY_TYPE) IS
+           BEGIN
+                P_CALLED (A);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P");
+           END P;
+ 
+           FUNCTION F_CALLED (A : ARRAY_TYPE) RETURN BOOLEAN IS
+                GOOD : BOOLEAN;
+           BEGIN
+                GOOD := (A = (6, 9, 9));
+                IF NOT GOOD THEN
+                     FAILED ("IN PARAMETER NOT RECEIVED CORRECTLY");
+                END IF;
+                IF A'FIRST /= 3 OR A'LAST /= IDENT_INT(5) THEN
+                     FAILED ("BOUNDS WRONG - FUNCTION");
+                END IF;
+                RETURN GOOD;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN FUNCTION F_CALLED");
+           END F_CALLED;
+ 
+           FUNCTION F (A : ARRAY_TYPE) RETURN BOOLEAN IS
+           BEGIN
+                RETURN (F_CALLED (A));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN FUNCTION F");
+           END F;
+ 
+           PROCEDURE P_OUT_CALLED (A : OUT ARRAY_TYPE) IS
+           BEGIN
+                IF A'FIRST /= IDENT_INT(2) OR A'LAST /= 4 THEN
+                     FAILED ("BOUNDS WRONG - OUT");
+                END IF;
+                A := (8, 8, 8);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE " &
+                                  "P_OUT_CALLED");
+           END P_OUT_CALLED;
+ 
+           PROCEDURE P_OUT (A : OUT ARRAY_TYPE) IS
+           BEGIN
+                P_OUT_CALLED (A);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE P_OUT");
+           END P_OUT;
+ 
+      BEGIN     -- (F)
+ 
+           BEGIN     -- (G)
+                P (REC.A (1..3));
+                IF REC.A /= (6, 6, 6, 9, 9) THEN
+                     FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P");
+           END;     -- (G)
+ 
+           BEGIN     -- (H)
+                BOOL := F (REC.A (3..5));
+                IF NOT BOOL THEN
+                     FAILED ("IN PARAM NOT RETURNED CORRECTLY");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF F");
+           END;     -- (H)
+ 
+           BEGIN     -- (I)
+                P_OUT (REC.A (2..4));
+                IF REC.A /= (6, 8, 8, 8, 9) THEN
+                     FAILED ("OUT PARAM NOT RETURNED CORRECTLY - 2");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED DURING CALL OF P_OUT");
+           END;     -- (I)
+ 
+      END; -- (F)
+ 
+      RESULT;
+ END C64109L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64201b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64201b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64201b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C64201B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INITALIZATION OF IN PARAMETERS OF A TASK
+ -- TYPE IS PERMITTED.
+ -- (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
+ 
+ -- CVP 5/14/81
+ -- ABW 7/1/82
+ -- BHS 7/9/84
+ 
+ WITH REPORT;
+ PROCEDURE C64201B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C64201B" , "CHECK THAT INITIALIZATION OF IN PARAMETERS " &
+                        "OF A TASK TYPE IS PERMITTED" );
+ 
+      DECLARE
+ 
+           GLOBAL : INTEGER := 10;
+ 
+           TASK TYPE T_TYPE IS
+                ENTRY E (X : IN OUT INTEGER);
+           END;
+ 
+           TSK1, TSK2 : T_TYPE;
+ 
+           TASK BODY T_TYPE IS
+           BEGIN
+                ACCEPT E (X : IN OUT INTEGER) DO
+                     X := X - 1;
+                END E;
+                ACCEPT E (X : IN OUT INTEGER) DO
+                     X := X + 1;
+                END E;
+           END T_TYPE;
+ 
+ 
+           PROCEDURE PROC1 (T : T_TYPE := TSK1) IS
+           BEGIN
+                T.E (X => GLOBAL);
+           END PROC1;
+ 
+           PROCEDURE PROC2 (T : T_TYPE := TSK1) IS
+           BEGIN
+                T.E (X => GLOBAL);
+                IF (GLOBAL /= IDENT_INT(8)) THEN
+                     FAILED( "TASK NOT PASSED IN PROC1, " &
+                             "DEFAULT TSK1 EMPLOYED" );
+                END IF;
+           END PROC2;
+ 
+           PROCEDURE TERM (T : T_TYPE; NUM : CHARACTER) IS
+           BEGIN
+                IF NOT T'TERMINATED THEN
+                     ABORT T;
+                     COMMENT ("ABORTING TASK " & NUM);
+                END IF;
+           END TERM;
+ 
+      BEGIN
+ 
+           PROC1(TSK2);
+           IF GLOBAL /= 9 THEN
+                FAILED ("INCORRECT GLOBAL VALUE AFTER PROC1");
+           ELSE
+                PROC2;
+           END IF;
+ 
+           TERM(TSK1, '1');
+           TERM(TSK2, '2');
+      END;
+ 
+      RESULT;
+ 
+ END C64201B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64201c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64201c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64201c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64201c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,196 ----
+ -- C64201C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INITIALIZATION OF IN PARAMETERS OF A COMPOSITE
+ --   TYPE HAVING AT LEAST ONE COMPONENT (INCLUDING COMPONENTS
+ --   OF COMPONENTS) OF A TASK TYPE IS PERMITTED.
+ --  (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
+ 
+ -- CVP 5/14/81
+ -- ABW 7/1/82
+ -- BHS 7/9/84
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C64201C IS
+ 
+ 
+      GLOBAL : INTEGER := 10;
+ 
+ 
+      TASK TYPE T IS
+           ENTRY E (X : IN OUT INTEGER);
+      END;
+ 
+      TYPE REC_T IS
+           RECORD
+                TT : T;
+                BB : BOOLEAN := TRUE;
+           END RECORD;
+ 
+      TYPE REC_REC_T IS
+           RECORD
+                RR : REC_T;
+           END RECORD;
+ 
+      TYPE ARR_T IS ARRAY (1 .. 2) OF T;
+ 
+      TYPE ARR_REC_T IS ARRAY (1 .. 2) OF REC_T;
+ 
+      RT1, RT2   : REC_T;
+      RRT1, RRT2 : REC_REC_T;
+      AT1, AT2   : ARR_T;
+      ART1, ART2 : ARR_REC_T;
+ 
+      
+      TASK BODY T IS
+      BEGIN
+           ACCEPT E (X : IN OUT INTEGER) DO
+                X := X - 1;
+           END E;
+           ACCEPT E (X : IN OUT INTEGER) DO
+                X := X + 1;
+           END E;
+      END T;
+ 
+ 
+      PROCEDURE PROC1A (P1X : REC_T := RT1) IS
+      BEGIN
+           IF P1X.BB THEN                 -- EXPECT RT2 PASSED.
+                FAILED( "RECORD OF TASK NOT PASSED, DEFAULT EMPLOYED" );
+           END IF;
+      END PROC1A;
+ 
+      PROCEDURE PROC1B (P1X : REC_T := RT1) IS
+      BEGIN
+           IF NOT P1X.BB THEN             -- EXPECT DEFAULT USED.
+                FAILED( "DEFAULT RECORD OF TASK NOT EMPLOYED" );
+           END IF;
+      END PROC1B;
+ 
+ 
+      PROCEDURE PROC2A (P2X : REC_REC_T := RRT1) IS
+      BEGIN
+           IF P2X.RR.BB THEN             -- EXPECT RRT2 PASSED.
+                FAILED( "RECORD OF RECORD OF TASK NOT PASSED, " &
+                        "DEFAULT EMPLOYED" );
+           END IF;
+      END PROC2A;
+ 
+      PROCEDURE PROC2B (P2X : REC_REC_T := RRT1) IS
+      BEGIN
+           IF NOT P2X.RR.BB THEN         -- EXPECT DEFAULT USED.
+                FAILED( "DEFAULT RECORD OF RECORD OF TASK " &
+                        "NOT EMPLOYED" );
+           END IF;
+      END PROC2B;
+ 
+ 
+      PROCEDURE PROC3 (P3X : ARR_T := AT1) IS
+      BEGIN
+           P3X(1).E (X => GLOBAL);        -- CALL TO AT2(1).E,
+                                          -- GLOBAL => GLOBAL - 1.
+      END PROC3;
+ 
+      PROCEDURE PROC4 (P4X : ARR_T := AT1) IS
+      BEGIN
+           P4X(1).E (X => GLOBAL);     -- CALL TO DEFAULT AT1(1).E,
+                                       -- GLOBAL => GLOBAL - 1.
+           IF GLOBAL /= IDENT_INT(8) THEN
+                FAILED( "ARRAY OF TASKS NOT PASSED " &
+                        "CORRECTLY IN PROC3" );
+           END IF;
+      END PROC4;
+ 
+      PROCEDURE PROC5 (P5X : ARR_REC_T := ART1) IS
+      BEGIN
+           P5X(1).TT.E (X => GLOBAL);      -- CALL TO ART2(1).TT.E,
+                                           -- GLOBAL => GLOBAL - 1.
+      END PROC5;
+ 
+      PROCEDURE PROC6 (P6X : ARR_REC_T := ART1) IS
+      BEGIN
+           P6X(1).TT.E (X => GLOBAL);      -- CALL DEFAULT ART1(1).TT.E,
+                                           -- GLOBAL => GLOBAL - 1.
+           IF GLOBAL /= IDENT_INT(8) THEN
+                FAILED( "ARRAY OF RECORDS OF TASKS NOT " &
+                        "PASSED IN PROC5" );
+           END IF;
+      END PROC6;
+ 
+      PROCEDURE TERM (TSK : T; NUM : CHARACTER) IS
+      BEGIN
+           IF NOT TSK'TERMINATED THEN
+                ABORT TSK;
+                COMMENT ("ABORTING TASK " & NUM);
+           END IF;
+      END TERM;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C64201C" , "CHECK THAT INITIALIZATION OF IN " &
+                        "PARAMETERS OF A COMPOSITE TYPE " &
+                        "IS PERMITTED" );
+ 
+      RT2.BB := FALSE;
+      RRT2.RR.BB := FALSE;
+ 
+      PROC1A(RT2);                               -- NO ENTRY CALL
+      PROC1B;                                    -- NO ENTRY CALL
+      PROC2A(RRT2);                              -- NO ENTRY CALL
+      PROC2B;                                    -- NO ENTRY CALL
+ 
+      PROC3(AT2);                                -- CALL AT2(1).E
+      IF GLOBAL /= 9 THEN
+           FAILED ("INCORRECT GLOBAL VALUE AFTER PROC3");
+      ELSE
+           PROC4;                                -- CALL AT1(1).E
+      END IF;
+ 
+      GLOBAL := 10;
+      PROC5(ART2);                              -- CALL ART2(1).TT.E
+      IF GLOBAL /= 9 THEN
+           FAILED ("INCORRECT GLOBAL VALUE AFTER PROC5");
+      ELSE
+           PROC6;                               -- CALL ART1(1).TT.E
+      END IF;
+ 
+ -- MAKE SURE ALL TASKS TERMINATED
+      TERM (RT1.TT, '1');
+      TERM (RT2.TT, '2');
+      TERM (RRT1.RR.TT, '3');
+      TERM (RRT2.RR.TT, '4');
+      TERM (AT1(1), '5');
+      TERM (AT2(1), '6');
+      TERM (AT1(2), '7');
+      TERM (AT2(2), '8');
+      TERM (ART1(1).TT, '9');
+      TERM (ART2(1).TT, 'A');
+      TERM (ART1(2).TT, 'B');
+      TERM (ART2(2).TT, 'C');
+ 
+      RESULT;
+ 
+ END C64201C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64202a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c64202a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c64202a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C64202A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE DEFAULT EXPRESSIONS OF FORMAL PARAMETERS ARE EVALUATED
+ -- EACH TIME THEY ARE NEEDED.
+ 
+ -- SPS 2/22/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C64202A IS
+ BEGIN
+ 
+      TEST ("C64202A", "CHECK THAT THE DEFAULT EXPRESSION IS EVALUATED" &
+            " EACH TIME IT IS NEEDED");
+ 
+      DECLARE
+           X : INTEGER := 1;
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                X := X + 1;
+                RETURN X;
+           END F;
+ 
+           PROCEDURE P (CALL : POSITIVE; X, Y : INTEGER := F) IS 
+           BEGIN
+                IF CALL = 1 THEN
+                     IF X = Y OR Y /= 2 THEN
+                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - 1" &
+                                  " X =" & INTEGER'IMAGE(X) & " Y =" &
+                                  INTEGER'IMAGE(Y));
+                     END IF;
+                ELSIF CALL = 2 THEN
+                     IF X = Y OR 
+                        NOT ((X = 3 AND Y = 4) OR (X = 4 AND Y = 3)) THEN
+                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - 2" &
+                                  " X =" & INTEGER'IMAGE(X) & " Y =" &
+                                  INTEGER'IMAGE(Y));
+                     END IF;
+                END IF;
+           END P;
+ 
+      BEGIN
+           COMMENT ("FIRST CALL");
+           P (1, 3);
+           COMMENT ("SECOND CALL");
+           P(2);
+      END;
+ 
+      RESULT;
+ 
+ END C64202A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c650001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c650001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c650001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c650001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,412 ----
+ -- C650001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for a function result type that is a return-by-reference
+ --      type, Program_Error is raised if the return expression is a name that
+ --      denotes an object view whose accessibility level is deeper than that
+ --      of the master that elaborated the function body.
+ --      
+ --      Check for cases where the result type is:
+ --         (a) A tagged limited type.
+ --         (b) A task type.
+ --         (c) A protected type.
+ --         (d) A composite type with a subcomponent of a
+ --             return-by-reference type (task type).
+ --      
+ -- TEST DESCRIPTION:
+ --      The accessibility level of the master that elaborates the body of a
+ --      return-by-reference function will always be less deep than that of
+ --      the function (which is itself a master). 
+ --
+ --      Thus, the return object may not be any of the following, since each
+ --      has an accessibility level at least as deep as that of the function:
+ --
+ --         (1) An object declared local to the function. 
+ --         (2) The result of a local function.           
+ --         (3) A parameter of the function.              
+ --
+ --      Verify that Program_Error is raised within the return-by-reference
+ --      function if the return object is any of (1)-(3) above, for various
+ --      subsets of the return types (a)-(d) above. Include cases where (1)-(3)
+ --      are operands of parenthesized expressions.
+ --
+ --      Verify that no exception is raised if the return object is any of the
+ --      following:
+ --
+ --         (4) An object declared at a less deep level than that of the
+ --             master that elaborated the function body.
+ --         (5) The result of a function declared at the same level as the
+ --             original function (assuming the new function is also legal).
+ --         (6) A parameter of the master that elaborated the function body.
+ --
+ --      For (5), pass the new function as an actual via an access-to-
+ --      subprogram parameter of the original function. Check for cases where
+ --      the new function does and does not raise an exception.
+ --
+ --      Since the functions to be tested cannot be part of an assignment
+ --      statement (since they return values of a limited type), pass each
+ --      function result as an actual parameter to a dummy procedure, e.g.,
+ --
+ --         Dummy_Proc ( Function_Call );
+ --
+ --
+ -- CHANGE HISTORY:
+ --      03 May 95   SAIC    Initial prerelease version.
+ --      08 Feb 99   RLB     Removed subcase with two errors.
+ --
+ --!
+ 
+ package C650001_0 is
+ 
+    type Tagged_Limited is tagged limited record
+       C: String (1 .. 10);
+    end record;
+ 
+    task type Task_Type;
+ 
+    protected type Protected_Type is
+       procedure Op;
+    end Protected_Type;
+ 
+    type Task_Array is array (1 .. 10) of Task_Type;
+ 
+    type Variant_Record (Toggle: Boolean) is record
+       case Toggle is
+          when True  =>
+             T: Task_Type;  -- Return-by-reference component.
+          when False =>
+             I: Integer;    -- Non-return-by-reference component.
+       end case;
+    end record;
+ 
+    -- Limited type even though variant contains no limited components:
+    type Non_Task_Variant is new Variant_Record (Toggle => False);
+ 
+ end C650001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C650001_0 is
+ 
+    task body Task_Type is
+    begin
+       null;
+    end Task_Type;
+ 
+    protected body Protected_Type is
+       procedure Op is
+       begin
+          null;
+       end Op;
+    end Protected_Type;
+ 
+ end C650001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C650001_0;
+ package C650001_1 is
+ 
+    type TC_Result_Kind is (OK, P_E, O_E);
+ 
+    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
+                                  Expected: in TC_Result_Kind;
+                                  Message : in String);
+ 
+    -- Dummy procedures:
+ 
+    procedure Check_Tagged    (P: C650001_0.Tagged_Limited);
+    procedure Check_Task      (P: C650001_0.Task_Type);
+    procedure Check_Protected (P: C650001_0.Protected_Type);
+    procedure Check_Composite (P: C650001_0.Non_Task_Variant);
+ 
+ end C650001_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C650001_1 is
+ 
+    procedure TC_Display_Results (Actual  : in TC_Result_Kind;
+                                  Expected: in TC_Result_Kind;
+                                  Message : in String) is
+    begin
+       if Actual /= Expected then
+          case Actual is
+             when OK  =>
+                Report.Failed ("No exception raised: "         & Message);
+             when P_E =>
+                Report.Failed ("Program_Error raised: "        & Message);
+             when O_E =>
+                Report.Failed ("Unexpected exception raised: " & Message);
+          end case;
+       end if;
+    end TC_Display_Results;
+ 
+ 
+    procedure Check_Tagged (P: C650001_0.Tagged_Limited) is
+    begin
+       null;
+    end;
+ 
+    procedure Check_Task (P: C650001_0.Task_Type) is
+    begin
+       null;
+    end;
+ 
+    procedure Check_Protected (P: C650001_0.Protected_Type) is
+    begin
+       null;
+    end;
+ 
+    procedure Check_Composite (P: C650001_0.Non_Task_Variant) is
+    begin
+       null;
+    end;
+ 
+ end C650001_1;
+ 
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C650001_0;
+ with C650001_1;
+ 
+ with Report;
+ procedure C650001 is
+ begin
+ 
+    Report.Test ("C650001", "Check that, for a function result type that " &
+                 "is a return-by-reference type, Program_Error is raised " &
+                 "if the return expression is a name that denotes an "     &
+                 "object view whose accessibility level is deeper than "   &
+                 "that of the master that elaborated the function body");
+ 
+ 
+ 
+    SUBTEST1:
+    declare
+ 
+       Result: C650001_1.TC_Result_Kind;
+       PO    : C650001_0.Protected_Type;
+ 
+       function Return_Prot (P: C650001_0.Protected_Type)
+         return C650001_0.Protected_Type is
+       begin
+          Result := C650001_1.OK;
+          return P;                                     -- Formal parameter (3).
+       exception
+          when Program_Error =>
+             Result := C650001_1.P_E;                        -- Expected result.
+             return PO;
+          when others        =>
+             Result := C650001_1.O_E;
+             return PO;
+       end Return_Prot;
+ 
+    begin  -- SUBTEST1.
+       C650001_1.Check_Protected ( Return_Prot(PO) );
+       C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #1");
+    exception
+       when others =>
+          Report.Failed ("SUBTEST #1: Unexpected exception in outer block");
+    end SUBTEST1;
+ 
+ 
+ 
+    SUBTEST2:
+    declare
+ 
+       Result: C650001_1.TC_Result_Kind;
+       Comp  : C650001_0.Non_Task_Variant;
+ 
+       function Return_Composite return C650001_0.Non_Task_Variant is
+          Local: C650001_0.Non_Task_Variant;
+       begin
+          Result := C650001_1.OK;
+          return (Local);                     -- Parenthesized local object (1).
+       exception
+          when Program_Error =>
+             Result := C650001_1.P_E;                        -- Expected result.
+             return Comp;
+          when others        =>
+             Result := C650001_1.O_E;
+             return Comp;
+       end Return_Composite;
+ 
+    begin -- SUBTEST2.
+       C650001_1.Check_Composite ( Return_Composite );
+       C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #2");
+    exception
+       when others =>
+          Report.Failed ("SUBTEST #2: Unexpected exception in outer block");
+    end SUBTEST2;
+ 
+ 
+ 
+    SUBTEST3:
+    declare
+ 
+       Result: C650001_1.TC_Result_Kind;
+       Tsk   : C650001_0.Task_Type;
+       TskArr: C650001_0.Task_Array;
+ 
+       function Return_Task (P: C650001_0.Task_Array)
+         return C650001_0.Task_Type is
+ 
+          function Inner return C650001_0.Task_Type is
+          begin
+             return P(P'First);           -- OK: should not raise exception (6).
+          exception
+             when Program_Error =>
+                Report.Failed ("SUBTEST #3: Program_Error incorrectly " &
+                               "raised within function Inner");
+                return Tsk;
+             when others        =>
+                Report.Failed ("SUBTEST #3: Unexpected exception " &
+                               "raised within function Inner");
+                return Tsk;
+          end Inner;
+ 
+       begin -- Return_Task.
+          Result := C650001_1.OK;
+          return Inner;                           -- Call to local function (2).
+       exception
+          when Program_Error =>
+             Result := C650001_1.P_E;                        -- Expected result.
+             return Tsk;
+          when others        =>
+             Result := C650001_1.O_E;
+             return Tsk;
+       end Return_Task;
+ 
+    begin -- SUBTEST3.
+       C650001_1.Check_Task ( Return_Task(TskArr) );
+       C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #3");
+    exception
+       when others =>
+          Report.Failed ("SUBTEST #3: Unexpected exception in outer block");
+    end SUBTEST3;
+ 
+ 
+ 
+    SUBTEST4:
+    declare
+ 
+       Result: C650001_1.TC_Result_Kind;
+       TagLim: C650001_0.Tagged_Limited;
+ 
+       function Return_TagLim (P: C650001_0.Tagged_Limited'Class)
+         return C650001_0.Tagged_Limited is
+       begin
+          Result := C650001_1.OK;
+          return C650001_0.Tagged_Limited(P); -- Conversion of formal param (3).
+       exception
+          when Program_Error =>
+             Result := C650001_1.P_E;                        -- Expected result.
+             return TagLim;
+          when others        =>
+             Result := C650001_1.O_E;
+             return TagLim;
+       end Return_TagLim;
+ 
+    begin -- SUBTEST4.
+       C650001_1.Check_Tagged ( Return_TagLim(TagLim) );
+       C650001_1.TC_Display_Results (Result, C650001_1.P_E,
+                                     "SUBTEST #4 (root type)");
+    exception
+       when others =>
+          Report.Failed ("SUBTEST #4: Unexpected exception in outer block");
+    end SUBTEST4;
+ 
+ 
+ 
+    SUBTEST5:
+    declare
+       Tsk : C650001_0.Task_Type;
+    begin  -- SUBTEST5.
+ 
+       declare
+          Result: C650001_1.TC_Result_Kind;
+ 
+          type AccToFunc is access function return C650001_0.Task_Type;
+ 
+          function Return_Global return C650001_0.Task_Type is
+          begin
+             return Tsk;                  -- OK: should not raise exception (4).
+          end Return_Global;
+ 
+          function Return_Local return C650001_0.Task_Type is
+             Local : C650001_0.Task_Type;
+          begin
+             return Local;                           -- Propagate Program_Error.
+          end Return_Local;
+ 
+ 
+          function Return_Func (P: AccToFunc) return C650001_0.Task_Type is
+          begin
+             Result := C650001_1.OK;
+             return P.all;                                 -- Function call (5).
+          exception
+             when Program_Error =>
+                Result := C650001_1.P_E;
+                return Tsk;
+             when others        =>
+                Result := C650001_1.O_E;
+                return Tsk;
+          end Return_Func;
+ 
+          RG : AccToFunc := Return_Global'Access;
+          RL : AccToFunc := Return_Local'Access;
+ 
+       begin
+          C650001_1.Check_Task ( Return_Func(RG) );
+          C650001_1.TC_Display_Results (Result, C650001_1.OK,
+                                        "SUBTEST #5 (global task)");
+ 
+          C650001_1.Check_Task ( Return_Func(RL) );
+          C650001_1.TC_Display_Results (Result, C650001_1.P_E,
+                                        "SUBTEST #5 (local task)");
+       exception
+          when others =>
+             Report.Failed ("SUBTEST #5: Unexpected exception in outer block");
+       end;
+ 
+    end SUBTEST5;
+ 
+ 
+ 
+    Report.Result;
+ 
+ end C650001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c65003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c65003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c65003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c65003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C65003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF NO RETURN STATEMENT IS EXECUTED, A FUNCTION RAISES
+ -- PROGRAM_ERROR.  DETERMINE WHERE THE EXCEPTION IS RAISED.
+ 
+ -- THIS LACK OF AN EXECUTABLE RETURN IS DETECTABLE AT COMPILE TIME IN
+ -- THIS TEST.
+ 
+ -- JBG 10/14/83
+ -- SPS 2/22/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C65003A IS
+ 
+      EXCEPTION_RAISED : BOOLEAN := FALSE;
+      FUNCTION RETURN_IN_EXCEPTION RETURN INTEGER IS
+      BEGIN
+           IF FALSE THEN
+                RETURN 5;
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED IN FUNCTION BODY - " &
+                         "RETURN_IN_EXCEPTION");
+                EXCEPTION_RAISED := TRUE;
+                RETURN 5;
+      END RETURN_IN_EXCEPTION;
+ 
+      FUNCTION NO_RETURN RETURN INTEGER IS
+           NO_RETURN_EXCEPTION : EXCEPTION;
+      BEGIN
+           RAISE NO_RETURN_EXCEPTION;
+           RETURN 5;
+      EXCEPTION
+           WHEN NO_RETURN_EXCEPTION =>
+                NULL;
+      END NO_RETURN;
+ 
+ BEGIN
+ 
+      TEST ("C65003A", "CHECK THAT PROGRAM_ERROR IS RAISED IF A " &
+                       "FUNCTION RETURNS WITHOUT EXECUTING A RETURN " &
+                       "STATEMENT");
+ 
+      BEGIN
+ 
+           IF RETURN_IN_EXCEPTION = RETURN_IN_EXCEPTION THEN
+                IF NOT EXCEPTION_RAISED THEN
+                     FAILED ("PROGRAM_ERROR NOT RAISED - " &
+                             "RETURN_IN_EXCEPTION");
+                END IF;
+           END IF;
+ 
+      EXCEPTION
+      
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED AT POINT OF CALL " &
+                         "- RETURN_IN_EXCEPTION");
+ 
+      END;
+ 
+ 
+      BEGIN
+ 
+           IF NO_RETURN = NO_RETURN THEN
+                FAILED ("PROGRAM_ERROR NOT RAISED - NO_RETURN");
+           END IF;
+ 
+      EXCEPTION
+      
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED WHEN NO RETURN IN " &
+                         "EXCEPTION HANDLER");
+      END;
+ 
+      RESULT;
+ 
+ END C65003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c65003b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c65003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c65003b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c65003b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C65003B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF NO RETURN STATEMENT IS EXECUTED, A FUNCTION RAISES
+ -- PROGRAM_ERROR.  DETERMINE WHERE THE EXCEPTION IS RAISED.
+ 
+ -- THIS LACK OF AN EXECUTABLE RETURN IS NOT DETECTABLE AT COMPILE TIME.
+ 
+ -- JBG 10/14/83
+ -- SPS 2/22/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C65003B IS
+ 
+      EXCEPTION_RAISED : BOOLEAN := FALSE;
+ 
+      FUNCTION RETURN_IN_EXCEPTION RETURN INTEGER IS
+      BEGIN
+           WHILE NOT EQUAL (1, 1) LOOP
+                RETURN 5;
+           END LOOP;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED IN FUNCTION BODY");
+                EXCEPTION_RAISED := TRUE;
+                RETURN 5;
+      END RETURN_IN_EXCEPTION;
+ 
+ BEGIN
+ 
+      TEST ("C65003B", "CHECK THAT PROGRAM_ERROR IS RAISED IF A " &
+                       "FUNCTION RETURNS WITHOUT EXECUTING A RETURN " &
+                       "STATEMENT");
+ 
+      BEGIN
+ 
+           IF RETURN_IN_EXCEPTION = RETURN_IN_EXCEPTION THEN
+                IF NOT EXCEPTION_RAISED THEN
+                     FAILED ("PROGRAM_ERROR NOT RAISED");
+                END IF;
+           END IF;
+ 
+      EXCEPTION
+      
+           WHEN PROGRAM_ERROR =>
+                COMMENT ("PROGRAM_ERROR RAISED AT POINT OF CALL");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C65003B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C66002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (A) ONE SUBPROGRAM IS A FUNCTION; THE OTHER IS A PROCEDURE.
+ 
+ -- CVP 5/4/81
+ -- JRK 5/8/81
+ -- NL 10/13/81
+ -- SPS 11/2/82
+ 
+ WITH REPORT;
+ PROCEDURE C66002A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C66002A", "SUBPROGRAM OVERLOADING WITH " &
+            "MINIMAL DIFFERENCES ALLOWED");
+ 
+      --------------------------------------------------
+ 
+      -- ONE SUBPROGRAM IS A PROCEDURE; THE OTHER IS
+      -- A FUNCTION. BOTH PARAMETERIZED AND PARAMETERLESS
+      -- SUBPROGRAMS ARE TESTED.
+ 
+      DECLARE
+           I, J, K : INTEGER := 0;
+           S : STRING (1..2) := "12";
+ 
+           PROCEDURE P1 (I1, I2 : INTEGER) IS
+           BEGIN
+                S(1) := 'A';
+           END P1;
+ 
+           FUNCTION P1 (I1, I2 : INTEGER) RETURN INTEGER IS
+           BEGIN
+                S(2) := 'B';
+                RETURN I1; -- RETURNED VALUE IS IRRELEVENT.
+           END P1;
+ 
+           PROCEDURE P2 IS
+           BEGIN
+                S(1) := 'C';
+           END P2;
+ 
+           FUNCTION P2 RETURN INTEGER IS
+           BEGIN
+                S(2) := 'D';
+                RETURN I; -- RETURNED VALUE IS IRRELEVENT.
+           END P2;
+ 
+      BEGIN
+           P1 (I, J);
+           K := P1 (I, J);
+ 
+           IF S /= "AB" THEN
+                FAILED ("PARAMETERIZED OVERLOADED " &
+                        "SUBPROGRAMS, ONE A PROCEDURE AND " &
+                        "THE OTHER A FUNCTION, CAUSED " &
+                        "CONFUSION");
+           END IF;
+ 
+           S := "12";
+           P2;
+           K := P2 ;
+ 
+           IF S /= "CD" THEN 
+                FAILED ("PARAMETERLESS OVERLOADED " &
+                        "SUBPROGRAMS, ONE A PROCEDURE AND " &
+                        "THE OTHER A FUNCTION, CAUSED " &
+                        "CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C66002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C66002C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (C) ONE SUBPROGRAM HAS ONE LESS PARAMETER THAN THE OTHER.
+ 
+ -- CVP 5/4/81
+ -- JRK 5/8/81
+ -- NL 10/13/81
+ 
+ WITH REPORT;
+ PROCEDURE C66002C IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C66002C", "SUBPROGRAM OVERLOADING WITH " &
+            "MINIMAL DIFFERENCES ALLOWED");
+ 
+      --------------------------------------------------
+ 
+      -- ONE PROCEDURE HAS ONE MORE PARAMETER
+      -- THAN THE OTHER.  THIS IS TESTED IN THE
+      -- CASE IN WHICH THAT PARAMETER HAS A DEFAULT
+      -- VALUE, AND THE CASE IN WHICH IT DOES NOT.
+ 
+      DECLARE
+           I, J : INTEGER := 0;
+           B : BOOLEAN := TRUE;
+           S : STRING (1..2) := "12";
+ 
+           PROCEDURE P1 (I1, I2 : INTEGER; B1 : IN OUT BOOLEAN) IS
+           BEGIN
+                S(1) := 'A';
+           END P1;
+ 
+           PROCEDURE P1 (I1, I2 : INTEGER) IS
+           BEGIN
+                S(2) := 'B';
+           END P1;
+ 
+           PROCEDURE P2 (B1 : IN OUT BOOLEAN; I1 : INTEGER := 0) IS
+           BEGIN
+                S(1) := 'C';
+           END P2;
+ 
+           PROCEDURE P2 (B1 : IN OUT BOOLEAN) IS
+           BEGIN
+                S(2) := 'D';
+           END P2;
+ 
+      BEGIN
+           P1 (I, J, B);
+           P1 (I, J);
+ 
+           IF S /= "AB" THEN
+                FAILED ("PROCEDURES DIFFERING ONLY IN " &
+                        "NUMBER OF PARAMETERS (NO DEFAULTS) " &
+                        "CAUSED CONFUSION");
+           END IF;
+ 
+           S := "12";
+           P2 (B, I);
+           -- NOTE THAT A CALL TO P2 WITH ONLY
+           -- ONE PARAMETER IS AMBIGUOUS.
+ 
+           IF S /= "C2" THEN
+                FAILED ("PROCEDURES DIFFERING ONLY IN " &
+                        "EXISTENCE OF ONE PARAMETER (WITH " &
+                        "DEFAULT) CAUSED CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C66002C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C66002D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (D) THE BASE TYPE OF A PARAMETER IS DIFFERENT FROM THAT
+ --         OF THE CORRESPONDING ONE.
+ 
+ -- CVP 5/4/81
+ -- JRK 5/8/81
+ -- NL 10/13/81
+ 
+ WITH REPORT;
+ PROCEDURE C66002D IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C66002D", "SUBPROGRAM OVERLOADING WITH " &
+            "MINIMAL DIFFERENCES ALLOWED");
+ 
+      --------------------------------------------------
+ 
+      -- THE BASE TYPE OF ONE PARAMETER IS
+      -- DIFFERENT FROM THAT OF THE CORRESPONDING
+      -- ONE.
+ 
+      DECLARE
+           I, J, K : INTEGER := 0;
+           B : BOOLEAN;
+           S : STRING (1..2) := "12";
+ 
+           PROCEDURE P (I1 : INTEGER; BI : OUT BOOLEAN;
+                        I2 : IN OUT INTEGER) IS
+           BEGIN
+                S(1) := 'A';
+                BI := TRUE; -- THIS VALUE IS IRRELEVENT.
+           END P;
+ 
+           PROCEDURE P (I1 : INTEGER; BI : OUT INTEGER;
+                I2 : IN OUT INTEGER) IS
+           BEGIN
+                S(2) := 'B';
+                BI := 0; -- THIS VALUE IS IRRELEVENT.
+           END P;
+ 
+      BEGIN
+           P (I, B, K);
+           P (I, J, K);
+ 
+           IF S /= "AB" THEN
+                FAILED ("PROCEDURES DIFFERING ONLY BY " &
+                        "THE BASE TYPE OF A PARAMETER " &
+                        "CAUSED CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C66002D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C66002E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (E) ONE SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
+ --         PART, THE OTHER IN AN INNER PART, AND THE PARAMETERS ARE 
+ --         ORDERED DIFFERENTLY.
+ 
+ -- CVP 5/4/81
+ -- JRK 5/8/81
+ -- NL 10/13/81
+ 
+ WITH REPORT;
+ PROCEDURE C66002E IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C66002E", "SUBPROGRAM OVERLOADING WITH " &
+            "MINIMAL DIFFERENCES ALLOWED");
+ 
+      --------------------------------------------------
+ 
+      -- ONE SUBPROGRAM IS DECLARED IN AN OUTER
+      -- DECLARATIVE PART, THE OTHER IN AN INNER
+      -- PART, AND THE PARAMETERS ARE ORDERED
+      -- DIFFERENTLY.
+ 
+      DECLARE
+           S : STRING (1..2) := "12";
+ 
+           PROCEDURE P (I1 : INTEGER; I2 : IN OUT INTEGER;
+                        B1 : BOOLEAN) IS
+           BEGIN
+                S(1) := 'A';
+           END P;
+ 
+      BEGIN
+           DECLARE
+                I : INTEGER := 0;
+ 
+                PROCEDURE P (B1 : BOOLEAN; I1 : INTEGER;
+                             I2 : IN OUT INTEGER) IS
+                BEGIN
+                     S(2) := 'B';
+                END P;
+ 
+           BEGIN
+                P (5, I, TRUE);
+                P (TRUE, 5, I);
+                -- NOTE THAT A CALL IN WHICH ALL ACTUAL PARAMETERS 
+                -- ARE NAMED_ASSOCIATIONS IS AMBIGUOUS.
+ 
+                IF S /= "AB" THEN
+                     FAILED ("PROCEDURES IN " &
+                             "ENCLOSING-ENCLOSED SCOPES " &
+                             "DIFFERING ONLY IN PARAMETER " &
+                             "TYPE ORDER CAUSED CONFUSION");
+                END IF;
+           END;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C66002E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C66002F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (F) ONE SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE PART,
+ --         THE OTHER IN AN INNER PART, AND ONE HAS ONE MORE PARAMETER
+ --         THAN THE OTHER; THE OMITTED PARAMETER HAS A DEFAULT VALUE.
+ 
+ -- CVP 5/4/81
+ -- JRK 5/8/81
+ -- NL 10/13/81
+ 
+ WITH REPORT;
+ PROCEDURE C66002F IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C66002F", "SUBPROGRAM OVERLOADING WITH " &
+            "MINIMAL DIFFERENCES ALLOWED");
+ 
+      --------------------------------------------------
+ 
+      -- ONE SUBPROGRAM IS IN AN OUTER DECLARATIVE 
+      -- PART, THE OTHER IN AN INNER PART, AND ONE
+      -- HAS ONE MORE PARAMETER (WITH A DEFAULT
+      -- VALUE) THAN THE OTHER.
+ 
+      BF : 
+      DECLARE
+           S : STRING (1..3) := "123";
+ 
+           PROCEDURE P (I1, I2, I3 : INTEGER := 1) IS
+                C : CONSTANT STRING := "CXA";
+           BEGIN
+                S(I3) := C(I3);
+           END P;
+ 
+           PROCEDURE ENCLOSE IS
+  
+                PROCEDURE P (I1, I2 : INTEGER := 1) IS
+                BEGIN
+                     S(2) := 'B';
+                END P;
+ 
+           BEGIN -- ENCLOSE
+                P (1, 2, 3);
+                ENCLOSE.P (1, 2); -- NOTE THAT THESE CALLS
+                BF.P (1, 2);      -- MUST BE DISAMBIGUATED.
+ 
+                IF S /= "CBA" THEN
+                     FAILED ("PROCEDURES IN ENCLOSING-" &
+                             "ENCLOSED SCOPES DIFFERING " &
+                             "ONLY IN EXISTENCE OF ONE " &
+                             "DEFAULT-VALUED PARAMETER CAUSED " &
+                             "CONFUSION");
+                END IF;
+           END ENCLOSE;
+ 
+      BEGIN
+           ENCLOSE;
+      END BF;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C66002F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c66002g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c66002g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C66002G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (G) THE RESULT TYPE OF TWO FUNCTION DECLARATIONS IS DIFFERENT.
+ 
+ -- CVP 5/4/81
+ -- JRK 5/8/81
+ -- NL 10/13/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT;
+ PROCEDURE C66002G IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C66002G", "SUBPROGRAM OVERLOADING WITH " &
+            "MINIMAL DIFFERENCES ALLOWED");
+ 
+      --------------------------------------------------
+ 
+      -- THE RESULT TYPES OF TWO FUNCTION
+      -- DECLARATIONS ARE DIFFERENT.
+ 
+      DECLARE
+           I : INTEGER;
+           B : BOOLEAN;
+           S : STRING (1..2) := "12";
+ 
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                S(1) := 'A';
+                RETURN IDENT_INT (0); -- THIS VALUE IS IRRELEVENT.
+           END F;
+ 
+           FUNCTION F RETURN BOOLEAN IS
+           BEGIN
+                S(2) := 'B';
+                RETURN IDENT_BOOL (TRUE); -- THIS VALUE IS IRRELEVANT.
+           END F;
+ 
+      BEGIN
+           I := F;
+           B := F;
+ 
+           IF S /= "AB" THEN
+                FAILED ("FUNCTIONS DIFFERING ONLY IN " &
+                        "BASE TYPE OF RETURNED VALUE " &
+                        "CAUSED CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C66002G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,426 ----
+ -- C67002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+ --   FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+ --   SUBTESTS ARE:
+ --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+ --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+ --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+ --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+ --             WITH ONE PARAMETER.
+ 
+ -- CVP 5/7/81
+ -- JRK 6/1/81
+ -- CPP 6/25/84
+ 
+ WITH REPORT;
+ PROCEDURE C67002A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C67002A", "USE OF OPERATOR SYMBOLS IN " &
+            "(OVERLOADED) FUNCTION SPECIFICATIONS");
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (A)
+           PACKAGE EQU IS
+                TYPE  LP IS LIMITED PRIVATE;
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+           PRIVATE
+                TYPE LP IS NEW INTEGER;
+           END EQU;
+           USE EQU;
+ 
+           LP1, LP2 : LP;
+ 
+           PACKAGE BODY EQU IS
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN LPA > LPB;
+                END "=";
+           BEGIN
+                LP1 := LP (IDENT_INT (7));
+                LP2 := LP (IDENT_INT (8));
+           END EQU;
+ 
+      BEGIN -- (A)
+           IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+              (LP1 = LP1) OR (LP2 /= LP1) THEN
+                FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (A)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (B)
+           FUNCTION "AND" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "AND";
+ 
+      BEGIN -- (B)
+           IF (IDENT_INT (10) AND 1) /= 'G' OR
+              (5 AND 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (B)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (C)
+           FUNCTION "OR" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "OR";
+ 
+      BEGIN -- (C)
+           IF (IDENT_INT (10) OR 1) /= 'G' OR
+              (5 OR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (C)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (D)
+           FUNCTION "XOR" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "XOR";
+ 
+      BEGIN -- (D)
+           IF (IDENT_INT (10) XOR 1) /= 'G' OR
+              (5 XOR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (D)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (E)
+           FUNCTION "<" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "<";
+ 
+      BEGIN -- (E)
+           IF (IDENT_INT (10) < 1) /= 'G' OR
+              (5 < 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (E)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (F)
+           FUNCTION "<=" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "<=";
+ 
+      BEGIN -- (F)
+           IF (IDENT_INT (10) <= 1) /= 'G' OR
+              (5 <= 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (F)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (G)
+           FUNCTION ">" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END ">";
+ 
+      BEGIN -- (G)
+           IF (IDENT_INT (10) > 1) /= 'G' OR
+              (5 > 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (G)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (H)
+           FUNCTION ">=" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END ">=";
+ 
+      BEGIN -- (H)
+           IF (IDENT_INT (10) >= 1) /= 'G' OR
+              (5 >= 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (H)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (I)
+           FUNCTION "&" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "&";
+ 
+      BEGIN -- (I)
+           IF (IDENT_INT (10) & 1) /= 'G' OR
+              (5 & 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (I)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (J)
+           FUNCTION "*" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "*";
+ 
+      BEGIN -- (J)
+           IF (IDENT_INT (10) * 1) /= 'G' OR
+              (5 * 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (J)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (K)
+           FUNCTION "/" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "/";
+ 
+      BEGIN -- (K)
+           IF (IDENT_INT (10) / 1) /= 'G' OR
+              (5 / 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (K)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (L)
+           FUNCTION "MOD" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "MOD";
+ 
+      BEGIN -- (L)
+           IF (IDENT_INT (10) MOD 1) /= 'G' OR
+              (5 MOD 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (L)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (M)
+           FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "REM";
+ 
+      BEGIN -- (M)
+           IF (IDENT_INT (10) REM 1) /= 'G' OR
+              (5 REM 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (M)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (N)
+           FUNCTION "**" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "**";
+ 
+      BEGIN -- (N)
+           IF (IDENT_INT (10) ** 1) /= 'G' OR
+              (5 ** 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (N)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (O)
+           FUNCTION "+" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "+";
+ 
+      BEGIN -- (O)
+           IF (IDENT_INT (10) + 1) /= 'G' OR
+              (5 + 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (O)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (P)
+           FUNCTION "-" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "-";
+ 
+      BEGIN -- (P)
+           IF (IDENT_INT (10) - 1) /= 'G' OR
+              (5 - 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (P)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (Q)
+           FUNCTION "+" (I1 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 < IDENT_INT (0) THEN
+                     RETURN 'N';
+                ELSE RETURN 'P';
+                END IF;
+           END "+";
+ 
+      BEGIN -- (Q)
+           IF (+ IDENT_INT(25) /= 'P') OR
+              (+ (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""+"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (Q)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (R)
+           FUNCTION "-" (I1 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 < IDENT_INT (0) THEN
+                     RETURN 'N';
+                ELSE RETURN 'P';
+                END IF;
+           END "-";
+ 
+      BEGIN -- (R)
+           IF (- IDENT_INT(25) /= 'P') OR
+              (- (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""-"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (R)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (S)
+           FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 < IDENT_INT (0) THEN
+                     RETURN 'N';
+                ELSE RETURN 'P';
+                END IF;
+           END "NOT";
+ 
+      BEGIN -- (S)
+           IF (NOT IDENT_INT(25) /= 'P') OR
+              (NOT (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""NOT"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (S)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (T)
+           FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 < IDENT_INT (0) THEN
+                     RETURN 'N';
+                ELSE RETURN 'P';
+                END IF;
+           END "ABS";
+ 
+      BEGIN -- (T)
+           IF (ABS IDENT_INT(25) /= 'P') OR
+              (ABS (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""ABS"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (T)
+ 
+      -------------------------------------------------
+ 
+      RESULT;
+ END C67002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,176 ----
+ -- C67002B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+ --   FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+ --   THIS TEST CHECKS THE CASE OF CERTAIN OPERATOR SYMBOLS.
+ --   SUBTESTS ARE:
+ --        (A) THROUGH (E): "AND", "OR", "XOR", "MOD", "REM"
+ --            RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+ --        (F) AND (G): "NOT" AND "ABS", RESPECTIVELY,
+ --             WITH ONE PARAMETER.
+ 
+ -- CPP 6/26/84
+ 
+ WITH REPORT;
+ PROCEDURE C67002B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+      TEST ("C67002B", "USE OF OPERATOR SYMBOLS IN " &
+            "(OVERLOADED) FUNCTION SPECIFICATIONS");
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (A)
+           FUNCTION "And" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "And";
+ 
+      BEGIN -- (A)
+           IF (IDENT_INT (10) AND 1) /= 'G' OR
+              (5 AnD 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""And"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (A)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (B)
+           FUNCTION "or" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "or";
+ 
+      BEGIN -- (B)
+           IF (IDENT_INT (10) Or 1) /= 'G' OR
+              (5 OR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""or"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (B)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (C)
+           FUNCTION "xOR" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "xOR";
+ 
+      BEGIN -- (C)
+           IF (IDENT_INT (10) XoR 1) /= 'G' OR
+              (5 xOR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""xOR"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (C)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (D)
+           FUNCTION "mOd" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "mOd";
+ 
+      BEGIN -- (D)
+           IF (IDENT_INT (10) MoD 1) /= 'G' OR
+              (5 moD 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""mOd"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (D)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (E)
+           FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 > I2 THEN
+                     RETURN 'G';
+                ELSE RETURN 'L';
+                END IF;
+           END "REM";
+ 
+      BEGIN -- (E)
+           IF (IDENT_INT (10) rem 1) /= 'G' OR
+              (5 Rem 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (E)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (F)
+           FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 < IDENT_INT (0) THEN
+                     RETURN 'N';
+                ELSE RETURN 'P';
+                END IF;
+           END "NOT";
+ 
+      BEGIN -- (F)
+           IF (Not IDENT_INT(25) /= 'P') OR
+              (noT (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""NOT"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (F)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (G)
+           FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER IS
+           BEGIN
+                IF I1 < IDENT_INT (0) THEN
+                     RETURN 'N';
+                ELSE RETURN 'P';
+                END IF;
+           END "ABS";
+ 
+      BEGIN -- (G)
+           IF (abs IDENT_INT(25) /= 'P') OR
+              (Abs (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""ABS"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (T)
+ 
+      -------------------------------------------------
+ 
+      RESULT;
+ END C67002B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,548 ----
+ -- C67002C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+ -- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+ -- THIS TEST CHECKS FORMAL SUBPROGRAM PARAMETERS.
+ --   SUBTESTS ARE:
+ --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+ --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+ --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+ --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+ --             WITH ONE PARAMETER.
+ 
+ -- CPP 6/26/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C67002C IS
+ 
+      FUNCTION TWO_PARAMS (I1, I2 : INTEGER) RETURN CHARACTER IS
+      BEGIN
+           IF I1 > I2 THEN
+                RETURN 'G';
+           ELSE RETURN 'L';
+           END IF;
+      END TWO_PARAMS;
+ 
+      FUNCTION ONE_PARAM (I1 : INTEGER) RETURN CHARACTER IS
+      BEGIN
+           IF I1 < IDENT_INT(0) THEN
+                RETURN 'N';
+           ELSE RETURN 'P';
+           END IF;
+      END ONE_PARAM;
+ 
+ BEGIN
+      TEST ("C67002C", "USE OF OPERATOR SYMBOLS IN " &
+            "(OVERLOADED) FUNCTION SPECIFICATIONS");
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           PACKAGE EQU IS
+                TYPE  LP IS LIMITED PRIVATE;
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+           PRIVATE
+                TYPE LP IS NEW INTEGER;
+           END EQU;
+           USE EQU;
+ 
+           LP1, LP2 : LP;
+ 
+           PACKAGE BODY EQU IS
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN LPA > LPB;
+                END "=";
+           BEGIN
+                LP1 := LP (IDENT_INT (7));
+                LP2 := LP (IDENT_INT (8));
+           END EQU;
+ 
+           GENERIC
+                WITH FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+                   (LP1 = LP1) OR (LP2 /= LP1) THEN
+                     FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE EQUAL IS NEW PKG ("=" => EQU."=");
+ 
+      BEGIN -- (A)
+           NULL;
+      END; -- (A)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           GENERIC
+                WITH FUNCTION "AND" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) AND 1) /= 'G' OR
+                   (5 AND 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("AND" => TWO_PARAMS);
+ 
+      BEGIN -- (B)
+           NULL;
+      END; -- (B)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           GENERIC
+                WITH FUNCTION "OR" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) OR 1) /= 'G' OR
+                   (5 OR 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("OR" => TWO_PARAMS);
+ 
+      BEGIN -- (C)
+           NULL;
+      END; -- (C)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           GENERIC
+                WITH FUNCTION "XOR" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) XOR 1) /= 'G' OR
+                   (5 XOR 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("XOR" => TWO_PARAMS);
+ 
+      BEGIN -- (D)
+           NULL;
+      END; -- (D)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (E)
+ 
+           GENERIC
+                WITH FUNCTION "<" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) < 1) /= 'G' OR
+                   (5 < 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("<" => TWO_PARAMS);
+ 
+      BEGIN -- (E)
+           NULL;
+      END; -- (E)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (F)
+ 
+           GENERIC
+                WITH FUNCTION "<=" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) <= 1) /= 'G' OR
+                   (5 <= 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("<=" => TWO_PARAMS);
+ 
+      BEGIN -- (F)
+           NULL;
+      END; -- (F)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (G)
+ 
+           GENERIC
+                WITH FUNCTION ">" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) > 1) /= 'G' OR
+                   (5 > 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG (">" => TWO_PARAMS);
+ 
+      BEGIN -- (G)
+           NULL;
+      END; -- (G)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (H)
+ 
+           GENERIC
+                WITH FUNCTION ">=" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) >= 1) /= 'G' OR
+                   (5 >= 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG (">=" => TWO_PARAMS);
+ 
+      BEGIN -- (H)
+           NULL;
+      END; -- (H)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (I)
+ 
+           GENERIC
+                WITH FUNCTION "&" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) & 1) /= 'G' OR
+                   (5 & 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("&" => TWO_PARAMS);
+ 
+      BEGIN -- (I)
+           NULL;
+      END; -- (I)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (J)
+ 
+           GENERIC
+                WITH FUNCTION "*" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) * 1) /= 'G' OR
+                   (5 * 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("*" => TWO_PARAMS);
+ 
+      BEGIN -- (J)
+           NULL;
+      END; -- (J)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (K)
+ 
+           GENERIC
+                WITH FUNCTION "/" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) / 1) /= 'G' OR
+                   (5 / 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("/" => TWO_PARAMS);
+ 
+      BEGIN -- (K)
+           NULL;
+      END; -- (K)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (L)
+ 
+           GENERIC
+                WITH FUNCTION "MOD" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) MOD 1) /= 'G' OR
+                   (5 MOD 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("MOD" => TWO_PARAMS);
+ 
+      BEGIN -- (L)
+           NULL;
+      END; -- (L)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (M)
+ 
+           GENERIC
+                WITH FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) REM 1) /= 'G' OR
+                   (5 REM 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("REM" => TWO_PARAMS);
+ 
+      BEGIN -- (M)
+           NULL;
+      END; -- (M)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (N)
+ 
+           GENERIC
+                WITH FUNCTION "**" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) ** 1) /= 'G' OR
+                   (5 ** 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("**" => TWO_PARAMS);
+ 
+      BEGIN -- (N)
+           NULL;
+      END; -- (N)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (O)
+ 
+           GENERIC
+                WITH FUNCTION "+" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) + 1) /= 'G' OR
+                   (5 + 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("+" => TWO_PARAMS);
+ 
+      BEGIN -- (O)
+           NULL;
+      END; -- (O)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (P)
+ 
+           GENERIC
+                WITH FUNCTION "-" (I1, I2 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (IDENT_INT (10) - 1) /= 'G' OR
+                   (5 - 10) /= 'L' THEN
+                     FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("-" => TWO_PARAMS);
+ 
+      BEGIN -- (P)
+           NULL;
+      END; -- (P)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (Q)
+ 
+           GENERIC
+                WITH FUNCTION "+" (I1 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (+ IDENT_INT(25) /= 'P') OR
+                   (+ (0-25) /= 'N') THEN
+                     FAILED ("OVERLOADING OF ""+"" " &
+                             "OPERATOR (ONE OPERAND) DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("+" => ONE_PARAM);
+ 
+      BEGIN -- (Q)
+           NULL;
+      END; -- (Q)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (R)
+ 
+           GENERIC
+                WITH FUNCTION "-" (I1 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (- IDENT_INT(25) /= 'P') OR
+                   (- (0-25) /= 'N') THEN
+                     FAILED ("OVERLOADING OF ""-"" " &
+                             "OPERATOR (ONE OPERAND) DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("-" => ONE_PARAM);
+ 
+      BEGIN -- (R)
+           NULL;
+      END; -- (R)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (S)
+ 
+           GENERIC
+                WITH FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (NOT IDENT_INT(25) /= 'P') OR
+                   (NOT (0-25) /= 'N') THEN
+                     FAILED ("OVERLOADING OF ""NOT"" " &
+                             "OPERATOR (ONE OPERAND) DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("NOT" => ONE_PARAM);
+ 
+      BEGIN -- (S)
+           NULL;
+      END; -- (S)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (T)
+ 
+           GENERIC
+                WITH FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER;
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF (ABS IDENT_INT(25) /= 'P') OR
+                   (ABS (0-25) /= 'N') THEN
+                     FAILED ("OVERLOADING OF ""ABS"" " &
+                             "OPERATOR (ONE OPERAND) DEFECTIVE");
+                END IF;
+           END PKG;
+ 
+           PACKAGE PACK IS NEW PKG ("ABS" => ONE_PARAM);
+ 
+      BEGIN -- (T)
+           NULL;
+      END; -- (T)
+ 
+      -------------------------------------------------
+ 
+      RESULT;
+ END C67002C;
+   
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,354 ----
+ -- C67002D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+ -- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+ -- THIS TEST CHECKS GENERIC INSTANTIATIONS FOR THESE FUNCTIONS.
+ --   SUBTESTS ARE:
+ --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+ --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+ --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+ --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+ --             WITH ONE PARAMETER.
+ 
+ -- CPP 6/25/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C67002D IS
+ 
+      GENERIC
+           TYPE ELEMENT IS (<>);
+      FUNCTION TWO_PARAMS (I1, I2 : ELEMENT) RETURN CHARACTER;
+      FUNCTION TWO_PARAMS (I1, I2 : ELEMENT) RETURN CHARACTER IS
+      BEGIN
+           IF I1 > I2 THEN
+                RETURN 'G';
+           ELSE RETURN 'L';
+           END IF;
+      END TWO_PARAMS;
+ 
+      GENERIC
+           TYPE ELEMENT IS (<>);
+      FUNCTION ONE_PARAM (I1 : ELEMENT) RETURN CHARACTER;
+      FUNCTION ONE_PARAM (I1 : ELEMENT) RETURN CHARACTER IS
+      BEGIN
+           IF I1 < ELEMENT'VAL(IDENT_INT(0)) THEN
+                RETURN 'N';
+           ELSE RETURN 'P';
+           END IF;
+      END ONE_PARAM;
+      
+ BEGIN
+      TEST ("C67002D", "USE OF OPERATOR SYMBOLS IN " &
+            "(OVERLOADED) FUNCTION SPECIFICATIONS");
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (A)
+           GENERIC
+                TYPE LP IS LIMITED PRIVATE;
+                WITH FUNCTION ">" (L, R : LP) RETURN BOOLEAN IS <>;
+           PACKAGE PKG IS
+                LP1, LP2 : LP;
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN LPA > LPB;
+                END "=";
+           END PKG;
+ 
+      BEGIN -- (A)
+           DECLARE
+                PACKAGE PACK IS NEW PKG (LP => INTEGER);
+                USE PACK;
+                FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN
+                     RENAMES PACK."=";
+           BEGIN
+                LP1 := IDENT_INT(7);
+                LP2 := IDENT_INT(8);
+                IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+                   (LP1 = LP1) OR (LP2 /= LP1) THEN
+                     FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+                END IF;
+           END;
+      END; -- (A)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (B)
+           FUNCTION "AND" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (B)
+           IF (IDENT_INT (10) AND 1) /= 'G' OR
+              (5 AND 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (B)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (C)
+           FUNCTION "OR" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (C)
+           IF (IDENT_INT (10) OR 1) /= 'G' OR
+              (5 OR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (C)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (D)
+           FUNCTION "XOR" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (D)
+           IF (IDENT_INT (10) XOR 1) /= 'G' OR
+              (5 XOR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (D)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (E)
+           FUNCTION "<" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (E)
+           IF (IDENT_INT (10) < 1) /= 'G' OR
+              (5 < 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (E)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (F)
+           FUNCTION "<=" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (F)
+           IF (IDENT_INT (10) <= 1) /= 'G' OR
+              (5 <= 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (F)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (G)
+           FUNCTION ">" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (G)
+           IF (IDENT_INT (10) > 1) /= 'G' OR
+              (5 > 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (G)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (H)
+           FUNCTION ">=" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (H)
+           IF (IDENT_INT (10) >= 1) /= 'G' OR
+              (5 >= 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (H)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (I)
+           FUNCTION "&" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (I)
+           IF (IDENT_INT (10) & 1) /= 'G' OR
+              (5 & 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (I)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (J)
+           FUNCTION "*" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (J)
+           IF (IDENT_INT (10) * 1) /= 'G' OR
+              (5 * 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (J)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (K)
+           FUNCTION "/" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (K)
+           IF (IDENT_INT (10) / 1) /= 'G' OR
+              (5 / 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (K)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (L)
+           FUNCTION "MOD" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (L)
+           IF (IDENT_INT (10) MOD 1) /= 'G' OR
+              (5 MOD 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (L)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (M)
+           FUNCTION "REM" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (M)
+           IF (IDENT_INT (10) REM 1) /= 'G' OR
+              (5 REM 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (M)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (N)
+           FUNCTION "**" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (N)
+           IF (IDENT_INT (10) ** 1) /= 'G' OR
+              (5 ** 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (N)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (O)
+           FUNCTION "+" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (O)
+           IF (IDENT_INT (10) + 1) /= 'G' OR
+              (5 + 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (O)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (P)
+           FUNCTION "-" IS NEW TWO_PARAMS
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (P)
+           IF (IDENT_INT (10) - 1) /= 'G' OR
+              (5 - 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (P)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (Q)
+           FUNCTION "+" IS NEW ONE_PARAM
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (Q)
+           IF (+ IDENT_INT(25) /= 'P') OR
+              (+ (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""+"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (Q)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (R)
+           FUNCTION "-" IS NEW ONE_PARAM
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (R)
+           IF (- IDENT_INT(25) /= 'P') OR
+              (- (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""-"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (R)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (S)
+           FUNCTION "NOT" IS NEW ONE_PARAM
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (S)
+           IF (NOT IDENT_INT(25) /= 'P') OR
+              (NOT (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""NOT"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (S)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (T)
+           FUNCTION "ABS" IS NEW ONE_PARAM
+                (ELEMENT => INTEGER);
+ 
+      BEGIN -- (T)
+           IF (ABS IDENT_INT(25) /= 'P') OR
+              (ABS (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""ABS"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (T)
+ 
+      -------------------------------------------------
+ 
+      RESULT;
+ END C67002D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67002e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67002e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,348 ----
+ -- C67002E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+ -- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+ -- THIS TEST CHECKS RENAMING DECLARATIONS FOR THESE FUNCTIONS.
+ --   SUBTESTS ARE:
+ --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+ --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+ --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+ --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+ --             WITH ONE PARAMETER.
+ 
+ -- CPP 6/26/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C67002E IS
+ 
+      FUNCTION TWO_PARAMS (I1, I2 : INTEGER) RETURN CHARACTER IS
+      BEGIN
+           IF I1 > I2 THEN
+                RETURN 'G';
+           ELSE RETURN 'L';
+           END IF;
+      END TWO_PARAMS;
+ 
+      FUNCTION ONE_PARAM (I1 : INTEGER) RETURN CHARACTER IS
+      BEGIN
+           IF I1 < IDENT_INT(0) THEN
+                RETURN 'N';
+           ELSE RETURN 'P';
+           END IF;
+      END ONE_PARAM;
+ 
+ BEGIN
+      TEST ("C67002E", "USE OF OPERATOR SYMBOLS IN " &
+            "(OVERLOADED) FUNCTION SPECIFICATIONS");
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           PACKAGE PKG IS
+                TYPE LP IS LIMITED PRIVATE;
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+           PRIVATE
+                TYPE LP IS NEW INTEGER;
+           END PKG;
+           USE PKG;
+ 
+           LP1, LP2 : LP;
+ 
+           FUNCTION "=" (LPA, LPB : LP)
+                RETURN BOOLEAN RENAMES PKG."=";
+ 
+           PACKAGE BODY PKG IS
+                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN LPA > LPB;
+                END "=";
+           BEGIN
+                LP1 := LP (IDENT_INT (7));
+                LP2 := LP (IDENT_INT (8));
+           END PKG;
+ 
+      BEGIN -- (A)
+           IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+              (LP1 = LP1) OR (LP2 /= LP1) THEN
+                FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (A)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (B)
+           FUNCTION "AND" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (B)
+           IF (IDENT_INT (10) AND 1) /= 'G' OR
+              (5 AND 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (B)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (C)
+           FUNCTION "OR" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (C)
+           IF (IDENT_INT (10) OR 1) /= 'G' OR
+              (5 OR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (C)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (D)
+           FUNCTION "XOR" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (D)
+           IF (IDENT_INT (10) XOR 1) /= 'G' OR
+              (5 XOR 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (D)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (E)
+           FUNCTION "<" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (E)
+           IF (IDENT_INT (10) < 1) /= 'G' OR
+              (5 < 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (E)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (F)
+           FUNCTION "<=" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (F)
+           IF (IDENT_INT (10) <= 1) /= 'G' OR
+              (5 <= 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (F)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (G)
+           FUNCTION ">" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (G)
+           IF (IDENT_INT (10) > 1) /= 'G' OR
+              (5 > 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (G)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (H)
+           FUNCTION ">=" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (H)
+           IF (IDENT_INT (10) >= 1) /= 'G' OR
+              (5 >= 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (H)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (I)
+           FUNCTION "&" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (I)
+           IF (IDENT_INT (10) & 1) /= 'G' OR
+              (5 & 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (I)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (J)
+           FUNCTION "*" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (J)
+           IF (IDENT_INT (10) * 1) /= 'G' OR
+              (5 * 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (J)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (K)
+           FUNCTION "/" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (K)
+           IF (IDENT_INT (10) / 1) /= 'G' OR
+              (5 / 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (K)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (L)
+           FUNCTION "MOD" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (L)
+           IF (IDENT_INT (10) MOD 1) /= 'G' OR
+              (5 MOD 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (L)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (M)
+           FUNCTION "REM" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (M)
+           IF (IDENT_INT (10) REM 1) /= 'G' OR
+              (5 REM 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (M)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (N)
+           FUNCTION "**" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (N)
+           IF (IDENT_INT (10) ** 1) /= 'G' OR
+              (5 ** 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (N)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (O)
+           FUNCTION "+" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (O)
+           IF (IDENT_INT (10) + 1) /= 'G' OR
+              (5 + 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (O)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (P)
+           FUNCTION "-" (I1, I2 : INTEGER)
+                RETURN CHARACTER RENAMES TWO_PARAMS;
+ 
+      BEGIN -- (P)
+           IF (IDENT_INT (10) - 1) /= 'G' OR
+              (5 - 10) /= 'L' THEN
+                FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+           END IF;
+      END; -- (P)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (Q)
+           FUNCTION "+" (I1 : INTEGER)
+                RETURN CHARACTER RENAMES ONE_PARAM;
+ 
+      BEGIN -- (Q)
+           IF (+ IDENT_INT(25) /= 'P') OR
+              (+ (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""+"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (Q)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (R)
+           FUNCTION "-" (I1 : INTEGER)
+                RETURN CHARACTER RENAMES ONE_PARAM;
+ 
+      BEGIN -- (R)
+           IF (- IDENT_INT(25) /= 'P') OR
+              (- (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""-"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (R)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (S)
+           FUNCTION "NOT" (I1 : INTEGER)
+                RETURN CHARACTER RENAMES ONE_PARAM;
+ 
+      BEGIN -- (S)
+           IF (NOT IDENT_INT(25) /= 'P') OR
+              (NOT (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""NOT"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (S)
+ 
+      -------------------------------------------------
+ 
+      DECLARE -- (T)
+           FUNCTION "ABS" (I1 : INTEGER)
+                RETURN CHARACTER RENAMES ONE_PARAM;
+ 
+      BEGIN -- (T)
+           IF (ABS IDENT_INT(25) /= 'P') OR
+              (ABS (0-25) /= 'N') THEN
+                FAILED ("OVERLOADING OF ""ABS"" " &
+                        "OPERATOR (ONE OPERAND) DEFECTIVE");
+           END IF;
+      END; -- (T)
+ 
+      -------------------------------------------------
+ 
+      RESULT;
+ END C67002E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67003f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67003f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67003f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67003f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,319 ----
+ -- C67003F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE PREDEFINED OPERATORS FOR THE PREDEFINED TYPES CAN BE 
+ --   REDEFINED.
+ -- CHECK THAT THE REDEFINED OPERATOR IS INVOKED WHEN INFIX OR PREFIX
+ --   NOTATION IS USED.
+ 
+ -- HISTORY:
+ --   WMC 03/21/92   TEST CREATED FROM CONSOLIDATION OF C67003[A-E].ADA
+ 
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C67003F IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C67003F", "CHECK THAT REDEFINITION OF " &
+            "OPERATORS FOR PREDEFINED TYPES WORKS");
+ 
+      DECLARE     -- INTEGER OPERATORS.
+ 
+           -- INTEGER INFIX OPERATORS.
+ 
+           FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF X /= Y THEN
+                     RETURN 1;
+                ELSE RETURN 0;
+                END IF;
+           END "*";
+ 
+           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF X /= Y THEN
+                     RETURN 2;
+                ELSE RETURN 0;
+                END IF;
+           END "+";
+      
+           FUNCTION "REM" (X, Y : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF X /= Y THEN
+                     RETURN 3;
+                ELSE RETURN 0;
+                END IF;
+           END "REM";
+      
+           -- INTEGER PREFIX OPERATORS.
+ 
+           FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF X /= 0 THEN
+                     RETURN 4;
+                ELSE RETURN 0;
+                END IF;
+           END "+";
+ 
+           FUNCTION "ABS" (X : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF X /= 0 THEN
+                     RETURN 5;
+                ELSE RETURN 0;
+                END IF;
+           END "ABS";
+ 
+           -- INTEGER RELATIONAL OPERATOR.
+ 
+           FUNCTION "<" (X, Y : INTEGER) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END "<";
+ 
+      BEGIN
+ 
+           IF IDENT_INT (3) * IDENT_INT (5) /= 1 THEN
+                FAILED ("REDEFINITION OF INTEGER ""*"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_INT (1) + IDENT_INT (30) /= 2 THEN
+                FAILED ("REDEFINITION OF INTEGER ""+"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_INT (7) REM IDENT_INT (8) /= 3 THEN
+                FAILED ("REDEFINITION OF ""REM"" IS DEFECTIVE");
+           END IF;
+ 
+           IF + (IDENT_INT (10)) /= 4 THEN
+                FAILED ("REDEFINITION OF INTEGER UNARY ""+"" IS DEFECTIVE");
+           END IF;
+ 
+           IF ABS (IDENT_INT (2)) /= 5 THEN
+                FAILED ("REDEFINITION OF INTEGER ""ABS"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_INT (7) < IDENT_INT (8) THEN
+                FAILED ("REDEFINITION OF INTEGER ""<"" IS DEFECTIVE");
+           END IF;
+ 
+      END;
+ 
+      DECLARE   -- FLOAT OPERATORS.
+ 
+           -- NOTE THAT ALL LITERAL VALUES USED SHOULD BE
+           --   REPRESENTABLE EXACTLY.
+ 
+           FUNCTION IDENT_FLOAT (X : FLOAT) RETURN FLOAT IS
+              I : INTEGER := INTEGER (X);
+           BEGIN
+              IF EQUAL (I, I) THEN          -- ALWAYS EQUAL.
+                   RETURN X;
+              END IF;
+              RETURN 0.0;
+           END IDENT_FLOAT;
+ 
+           -- FLOAT INFIX OPERATORS.
+ 
+           FUNCTION "-" (X, Y : FLOAT) RETURN FLOAT IS
+           BEGIN
+                IF X /= Y THEN
+                     RETURN 1.0;
+                ELSE RETURN 0.0;
+                END IF;
+           END "-";
+ 
+           FUNCTION "/" (X, Y : FLOAT) RETURN FLOAT IS
+           BEGIN
+                IF X /= Y THEN
+                     RETURN 2.0;
+                ELSE RETURN 0.0;
+                END IF;
+           END "/";
+ 
+           FUNCTION "**" (X : FLOAT; Y : INTEGER) RETURN FLOAT IS
+           BEGIN
+                IF INTEGER (X) /= Y THEN
+                     RETURN 3.0;
+                ELSE RETURN 0.0;
+                END IF;
+           END "**";
+ 
+           -- FLOAT PREFIX OPERATOR.
+ 
+           FUNCTION "-" (X : FLOAT) RETURN FLOAT IS
+           BEGIN
+                IF X /= 0.0 THEN
+                     RETURN 4.0;
+                ELSE RETURN 0.0;
+                END IF;
+           END "-";
+ 
+           -- FLOAT RELATIONAL OPERATOR.
+ 
+           FUNCTION "<=" (X, Y : FLOAT) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END "<=";
+ 
+      BEGIN
+ 
+           IF IDENT_FLOAT (50.0) - IDENT_FLOAT (100.0) /= 1.0 THEN
+                FAILED ("REDEFINITION OF FLOAT ""-"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_FLOAT (5.0) / IDENT_FLOAT (1.0) /= 2.0 THEN
+                FAILED ("REDEFINITION OF FLOAT ""/"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_FLOAT (3.0) ** IDENT_INT (2) /= 3.0 THEN
+                FAILED ("REDEFINITION OF FLOAT ""**"" IS DEFECTIVE");
+           END IF;
+ 
+           IF -(IDENT_FLOAT (5.0)) /= 4.0 THEN
+                FAILED ("REDEFINITION OF FLOAT UNARY ""-"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_FLOAT (1.0) <= IDENT_FLOAT (5.0) THEN
+                FAILED ("REDEFINITION OF FLOAT ""<="" IS DEFECTIVE");
+           END IF;
+ 
+      END;
+ 
+      DECLARE     -- BOOLEAN OPERATORS.
+ 
+           -- BOOLEAN LOGICAL OPERATORS.
+ 
+           FUNCTION "AND" (X, Y : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                IF X AND THEN Y THEN
+                     RETURN FALSE;
+                ELSE RETURN TRUE;
+                END IF;
+           END "AND";
+ 
+           FUNCTION "XOR" (X, Y : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END "XOR";
+ 
+           -- BOOLEAN RELATIONAL OPERATOR.
+ 
+           FUNCTION ">" (X, Y : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END ">";
+ 
+      BEGIN
+ 
+           IF IDENT_BOOL (TRUE) AND IDENT_BOOL (TRUE) THEN
+                FAILED ("REDEFINITION OF ""AND"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_BOOL (TRUE) XOR IDENT_BOOL (FALSE) THEN
+                FAILED ("REDEFINITION OF ""XOR"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_BOOL (TRUE) > IDENT_BOOL (FALSE) THEN
+                FAILED ("REDEFINITION OF BOOLEAN "">"" IS DEFECTIVE");
+           END IF;
+ 
+      END;
+     
+      DECLARE     -- STRING OPERATORS.
+ 
+           S1 : STRING (1..2) := "A" & IDENT_CHAR ('B');
+           S2 : STRING (1..2) := "C" & IDENT_CHAR ('D');
+ 
+           FUNCTION "&" (X, Y : STRING) RETURN STRING IS
+                Z : STRING (1 .. X'LENGTH + Y'LENGTH);
+           BEGIN
+                Z (1 .. Y'LENGTH) := Y;
+                Z (Y'LENGTH + 1 .. Z'LAST) := X;
+                RETURN Z;
+           END "&";
+ 
+           FUNCTION "&" (X : CHARACTER; Y : STRING) RETURN STRING IS
+                Z : STRING (1 .. Y'LENGTH + 1);
+           BEGIN
+                Z (1 .. Y'LENGTH) := Y;
+                Z (Z'LAST) := X;
+                RETURN Z;
+           END "&";
+ 
+           -- STRING RELATIONAL OPERATOR.
+ 
+           FUNCTION ">=" (X, Y : STRING) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END ">=";
+ 
+      BEGIN
+ 
+           IF S1 & S2 /= "CDAB" THEN
+                FAILED ("BAD REDEFINITION OF ""&"" (S,S)");
+           END IF;
+ 
+           IF IDENT_CHAR ('C') & S1 /= "ABC" THEN
+                FAILED ("BAD REDEFINITION OF ""&"" (C,S)");
+           END IF;
+ 
+           IF S2 >= S1 THEN
+                FAILED ("BAD REDEFINITION OF STRING "">=""");
+           END IF;
+ 
+      END;
+ 
+      DECLARE      -- CHARACTER OPERATORS.
+ 
+           -- CHARACTER RELATIONAL OPERATORS.
+ 
+           FUNCTION ">" (X, Y : CHARACTER) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END ">";
+ 
+           FUNCTION "<=" (X, Y : CHARACTER) RETURN BOOLEAN IS
+           BEGIN
+                RETURN X = Y;
+           END "<=";
+ 
+      BEGIN
+ 
+           IF IDENT_CHAR ('C') > IDENT_CHAR ('B') THEN
+                FAILED ("REDEFINITION OF CHARACTER "">"" IS DEFECTIVE");
+           END IF;
+ 
+           IF IDENT_CHAR ('A') <= IDENT_CHAR ('E') THEN
+                FAILED ("REDEFINITION OF CHARACTER ""<="" IS DEFECTIVE");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C67003F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- C67005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK IF A RENAMING DECLARATION DECLARES AN EQUALITY OPERATOR, THE
+ -- TYPES OF THE PARAMETERS NEED NOT BE LIMITED TYPES. 
+ 
+ -- JBG 9/28/83
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C67005A IS
+ BEGIN
+      TEST ("C67005A", "CHECK THAT AN EQUALITY OPERATOR DECLARED BY " &
+                       "A RENAMING DECLARATION NEED NOT HAVE " &
+                       "PARAMETERS OF A LIMITED TYPE");
+      DECLARE
+           GENERIC
+                TYPE LP IS LIMITED PRIVATE;
+                WITH FUNCTION EQUAL (L, R : LP) RETURN BOOLEAN;
+           PACKAGE EQUALITY_OPERATOR IS
+                FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
+           END EQUALITY_OPERATOR;
+ 
+           PACKAGE BODY EQUALITY_OPERATOR IS
+                FUNCTION "=" (L, R : LP) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN EQUAL(L, R);
+                END "=";
+           END EQUALITY_OPERATOR;
+ 
+           PACKAGE POLAR_COORDINATES IS
+                TYPE POLAR_COORD IS
+                     RECORD
+                          R     : INTEGER;
+                          THETA : INTEGER;
+                     END RECORD;
+                FUNCTION EQUAL (L, R : POLAR_COORD) RETURN BOOLEAN;
+                PACKAGE POLAR_EQUAL IS NEW EQUALITY_OPERATOR
+                          (POLAR_COORD, EQUAL);
+                FUNCTION "=" (L, R : POLAR_COORD) RETURN BOOLEAN
+                          RENAMES POLAR_EQUAL."=";
+           END POLAR_COORDINATES;
+ 
+           PACKAGE BODY POLAR_COORDINATES IS
+                FUNCTION EQUAL (L, R : POLAR_COORD) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN (L.THETA MOD 360) = (R.THETA MOD 360) AND
+                            L.R = R.R;
+                END EQUAL;
+           END POLAR_COORDINATES;
+ 
+           USE POLAR_COORDINATES;
+ 
+           PACKAGE VARIABLES IS
+                P270 : POLAR_COORD := (R => 3, THETA => 270);
+                P360 : POLAR_COORD := (R => 3, THETA => IDENT_INT(360));
+           END VARIABLES;
+ 
+           USE VARIABLES;
+ 
+      BEGIN
+ 
+           IF P270 /= (3, -90) THEN
+                FAILED ("INCORRECT INEQUALITY OPERATOR");
+           END IF;
+ 
+           IF P360 = (3, 0) THEN
+                NULL;
+           ELSE
+                FAILED ("INCORRECT EQUALITY OPERATOR");
+           END IF;
+ 
+           RESULT;
+ 
+      END;
+ END C67005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C67005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF EQUALITY IS REDEFINED FOR A SCALAR TYPE, CASE
+ -- STATEMENTS STILL USE THE PREDEFINED EQUALITY OPERATION.
+ 
+ -- JBG 9/28/83
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C67005B IS
+ 
+      GENERIC
+           TYPE LP IS LIMITED PRIVATE;
+           WITH FUNCTION EQUAL (L, R : LP) RETURN BOOLEAN;
+      PACKAGE EQUALITY_OPERATOR IS
+           FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
+      END EQUALITY_OPERATOR;
+      
+      PACKAGE BODY EQUALITY_OPERATOR IS
+           FUNCTION "=" (L, R : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN EQUAL(L, R);
+           END "=";
+      END EQUALITY_OPERATOR;
+ 
+ BEGIN
+      TEST ("C67005B", "CHECK THAT REDEFINING EQUALITY FOR A " &
+                       "SCALAR TYPE DOES NOT AFFECT CASE STATEMENTS");
+ 
+      DECLARE
+           TYPE MY IS NEW INTEGER;
+           CHECK : MY;
+ 
+           VAR : INTEGER RANGE 1..3 := 3;
+ 
+           PACKAGE INTEGER_EQUALS IS
+                FUNCTION EQUAL (L, R : INTEGER) RETURN BOOLEAN;
+                PACKAGE INTEGER_EQUAL IS NEW EQUALITY_OPERATOR
+                          (INTEGER, EQUAL);
+           END INTEGER_EQUALS;
+ 
+           FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN RENAMES
+                        INTEGER_EQUALS.INTEGER_EQUAL."=";
+ 
+           PACKAGE BODY INTEGER_EQUALS IS
+                FUNCTION EQUAL (L, R : INTEGER) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN FALSE;
+                END EQUAL;
+           END INTEGER_EQUALS;
+ 
+      BEGIN
+ 
+           IF VAR = 3 THEN
+                FAILED ("DID NOT USE REDEFINED '=' - 1");
+           END IF;
+ 
+           IF VAR /= 3 THEN
+                NULL;
+           ELSE
+                FAILED ("DID NOT USE REDEFINED '/=' - 1");
+           END IF;
+ 
+           IF VAR = IDENT_INT(3) THEN
+                FAILED ("DID NOT USE REDEFINED '=' - 2");
+           END IF;
+ 
+           IF VAR /= IDENT_INT(3) THEN
+                NULL;
+           ELSE
+                FAILED ("DID NOT USE REDEFINED '/=' - 2");
+           END IF;
+ 
+           CHECK := MY(IDENT_INT(0));
+           IF CHECK /= 0 THEN
+                FAILED ("USING WRONG EQUALITY FOR DERIVED TYPE");
+           END IF;
+ 
+           CASE VAR IS
+                WHEN 1..3 => CHECK := MY(IDENT_INT(1));
+                WHEN OTHERS => NULL;
+           END CASE;
+ 
+           IF CHECK /= 1 THEN
+                FAILED ("DID NOT USE PREDEFINED EQUALS IN CASE - 1");
+           END IF;
+ 
+           CASE IDENT_INT(VAR) IS
+                WHEN 1 => CHECK := 4;
+                WHEN 2 => CHECK := 5;
+                WHEN 3 => CHECK := 6;
+                WHEN OTHERS => CHECK := 7;
+           END CASE;
+ 
+           IF CHECK /= 6 THEN
+                FAILED ("DID NOT USE PREDEFINED EQUALS IN CASE - 2");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C67005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C67005C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A DECLARATION OF "=" NEED NOT HAVE PARAMETERS
+ -- OF A LIMITED TYPE IN A RENAMING DECLARATION. THIS TEST CHECKS
+ -- ACCESS TYPES.
+ 
+ -- BRYCE BARDIN (HUGHES AIRCRAFT) 7/2/84
+ -- CPP 7/12/84
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C67005C IS
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+           WITH FUNCTION EQUAL (LEFT, RIGHT : T) RETURN BOOLEAN IS <>;
+      PACKAGE EQUALITY IS
+           FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN;
+           -- PRAGMA INLINE ("=");
+      END EQUALITY;
+ 
+      PACKAGE BODY EQUALITY IS
+           FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+           BEGIN
+                RETURN EQUAL (LEFT, RIGHT);
+           END "=";
+      END EQUALITY;
+ 
+      PACKAGE STARTER IS
+           TYPE INT IS PRIVATE;
+           FUNCTION VALUE_OF (I : INTEGER) RETURN INT;
+           FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN;
+      PRIVATE
+           TYPE INT IS ACCESS INTEGER;
+      END STARTER;
+ 
+      PACKAGE BODY STARTER IS
+           FUNCTION VALUE_OF (I : INTEGER) RETURN INT IS
+           BEGIN
+                RETURN NEW INTEGER'(I);
+           END VALUE_OF;
+ 
+           FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN IS
+           BEGIN
+                RETURN LEFT.ALL = RIGHT.ALL;
+           END EQUAL;
+      END STARTER;
+ 
+      PACKAGE ABSTRACTION IS
+           TYPE INT IS NEW STARTER.INT;
+           PACKAGE INT_EQUALITY IS NEW EQUALITY (INT, EQUAL);
+           FUNCTION "=" (LEFT, RIGHT : INT) RETURN BOOLEAN
+                RENAMES INT_EQUALITY."=";
+      END ABSTRACTION;    
+      USE ABSTRACTION;
+ 
+ BEGIN
+ 
+      TEST ("C67005C", "RENAMING OF EQUALITY OPERATOR WITH " &
+            "NON-LIMITED PARAMETERS");
+ 
+      DECLARE
+ 
+           I : INT := VALUE_OF(1);
+           J : INT := VALUE_OF(0);
+ 
+           PROCEDURE CHECK (B : BOOLEAN) IS
+           BEGIN
+                IF I = J AND B THEN
+                     COMMENT ("I = J");
+                ELSIF I /= J AND NOT B THEN
+                     COMMENT ("I /= J");
+                ELSE
+                     FAILED ("WRONG ""="" OPERATOR");
+                END IF;
+           END CHECK;
+ 
+      BEGIN
+ 
+           CHECK(FALSE);
+           I := VALUE_OF(0);
+           CHECK(TRUE);
+      
+           RESULT;
+ 
+      END;
+ 
+ END C67005C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c6/c67005d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c6/c67005d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- C67005D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EQUALITY CAN BE REDEFINED FOR AN ARBITRARY TYPE BY USING A
+ -- SEQUENCE OF RENAMING DECLARATIONS.
+ 
+ -- JBG 9/11/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C67005D IS
+ 
+      FUNCTION MY_EQUALS  (L, R : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN FALSE;
+      END MY_EQUALS;
+ 
+      GENERIC
+           TYPE LP IS LIMITED PRIVATE;
+           WITH FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
+      PACKAGE EQUALITY_OPERATOR IS
+           PACKAGE INNER IS
+                FUNCTION "=" (L, R : LP) RETURN BOOLEAN RENAMES
+                              EQUALITY_OPERATOR."=";
+           END INNER;
+      END EQUALITY_OPERATOR;
+ 
+ BEGIN
+      TEST ("C67005D", "CHECK REDEFINITION OF ""="" BY RENAMING");
+ 
+      DECLARE
+ 
+           CHK1 : BOOLEAN := 3 = IDENT_INT(3);     -- PREDEFINED "="
+ 
+           -- REDEFINE INTEGER "=".
+ 
+           PACKAGE INT_EQUALITY IS NEW
+                EQUALITY_OPERATOR (INTEGER, MY_EQUALS);
+           FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN RENAMES
+                INT_EQUALITY.INNER."=";
+ 
+           CHK2 : BOOLEAN := 3 = IDENT_INT(3);     -- REDEFINED "=".
+ 
+      BEGIN
+ 
+           IF NOT CHK1 THEN
+                FAILED ("PREDEFINED ""="" NOT USED");
+           END IF;
+ 
+           IF CHK2 THEN
+                FAILED ("REDEFINED ""="" NOT USED");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C67005D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c72001b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c72001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c72001b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c72001b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- C72001B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A PACKAGE BODY CAN BE PROVIDED FOR A PACKAGE SPECIFICATION
+ --    THAT DOES NOT CONTAIN ANY SUBPROGRAM OR TASK DECLARATIONS AND THAT
+ --    STATEMENTS WITHIN THE PACKAGE BODIES CAN BE USED TO INITIALIZE
+ --    VARIABLES VISIBLE WITHIN THE PACKAGE BODY.
+ 
+ -- RM 04/30/81
+ -- RM 05/07/81 (TO INCORPORATE OLD TEST OBJECTIVE  7.1/T1 )
+ -- ABW 6/10/82
+ -- SPS 11/4/82
+ -- JBG 9/15/83
+ 
+ WITH REPORT;
+ PROCEDURE  C72001B  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C72001B" , "CHECK: PACKAGE BODIES CAN INITIALIZE VISIBLE" &
+                        " VARIABLES" );
+ 
+      DECLARE
+ 
+ 
+           PACKAGE  P5  IS
+ 
+                A : CHARACTER := 'B';
+                B : BOOLEAN   := FALSE;
+ 
+                PACKAGE  P6  IS
+                     I : INTEGER := IDENT_INT(6);
+                END  P6;
+ 
+           END  P5;
+ 
+ 
+           PACKAGE BODY  P5  IS
+                PACKAGE BODY  P6  IS
+                BEGIN
+                     A := 'C';
+                     I := 17;
+                     B := IDENT_BOOL(TRUE);
+                END  P6;
+           BEGIN
+                A := 'A';
+           END  P5;
+ 
+ 
+           USE  P5;
+           USE  P6;
+ 
+      BEGIN
+ 
+           IF A /= 'A' THEN
+                FAILED ("INITIALIZATIONS NOT CORRECT - 1");
+           END IF;
+ 
+           IF B /= TRUE THEN
+                FAILED ("INITIALIZATIONS NOT CORRECT - 2");
+           END IF;
+ 
+           IF I /= 17 THEN
+                FAILED ("INITIALIZATIONS NOT CORRECT - 3");
+           END IF;
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END C72001B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c72002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c72002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c72002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c72002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,229 ----
+ -- C72002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE SPECIFICATION ARE
+ --     ELABORATED IN THE ORDER DECLARED.
+ 
+ -- HISTORY:
+ --     DHH 03/09/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C72002A IS
+ 
+      A : INTEGER := 0;
+      TYPE ORDER_ARRAY IS ARRAY(1 .. 14) OF INTEGER;
+      OBJECT_ARRAY : ORDER_ARRAY;
+      TYPE REAL IS DIGITS 4;
+      TYPE ENUM IS (RED,YELLOW,BLUE);
+ 
+      TYPE ARR IS ARRAY(1 ..2) OF BOOLEAN;
+      D : ARR := (TRUE, TRUE);
+      E : ARR := (FALSE, FALSE);
+ 
+      TYPE REC IS
+           RECORD
+                I : INTEGER;
+           END RECORD;
+      B : REC := (I => IDENT_INT(1));
+      C : REC := (I => IDENT_INT(2));
+ 
+      FUNCTION GIVEN_ORDER(X : INTEGER) RETURN INTEGER IS
+           Y : INTEGER;
+      BEGIN
+           Y := X + 1;
+           RETURN Y;
+      END GIVEN_ORDER;
+ 
+      FUNCTION BOOL(X : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           IF X = IDENT_INT(1) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN TRUE;
+           ELSIF X = IDENT_INT(8) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN FALSE;
+           END IF;
+      END BOOL;
+ 
+      FUNCTION INT(X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           IF X = IDENT_INT(2) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN IDENT_INT(1);
+           ELSIF X = IDENT_INT(9) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN IDENT_INT(2);
+           END IF;
+      END INT;
+ 
+      FUNCTION FLOAT(X : INTEGER) RETURN REAL IS
+      BEGIN
+           IF X = IDENT_INT(3) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN 1.0;
+           ELSIF X = IDENT_INT(10) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN 2.0;
+           END IF;
+      END FLOAT;
+ 
+      FUNCTION CHAR(X : INTEGER) RETURN CHARACTER IS
+      BEGIN
+           IF X = IDENT_INT(4) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN 'A';
+           ELSIF X = IDENT_INT(11) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN 'Z';
+           END IF;
+      END CHAR;
+ 
+      FUNCTION ENUMR(X : INTEGER) RETURN ENUM IS
+      BEGIN
+           IF X = IDENT_INT(5) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN RED;
+           ELSIF X = IDENT_INT(12) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN YELLOW;
+           END IF;
+      END ENUMR;
+ 
+      FUNCTION ARRY(X : INTEGER) RETURN ARR IS
+      BEGIN
+           IF X = IDENT_INT(6) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN D;
+           ELSIF X = IDENT_INT(13) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN E;
+           END IF;
+      END ARRY;
+ 
+      FUNCTION RECOR(X : INTEGER) RETURN REC IS
+      BEGIN
+           IF X = IDENT_INT(7) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN B;
+           ELSIF X = IDENT_INT(14) THEN
+                A := GIVEN_ORDER(A);
+                OBJECT_ARRAY(X) := A;
+                RETURN C;
+           END IF;
+      END RECOR;
+ 
+      PACKAGE PACK IS
+           A : BOOLEAN   := BOOL(1);
+           B : INTEGER   := INT(2);
+           C : REAL      := FLOAT(3);
+           D : CHARACTER := CHAR(4);
+           E : ENUM      := ENUMR(5);
+           F : ARR       := ARRY(6);
+           G : REC       := RECOR(7);
+           H : BOOLEAN   := BOOL(8);
+           I : INTEGER   := INT(9);
+           J : REAL      := FLOAT(10);
+           K : CHARACTER := CHAR(11);
+           L : ENUM      := ENUMR(12);
+           M : ARR       := ARRY(13);
+           N : REC       := RECOR(14);
+      END PACK;
+ 
+ BEGIN
+      TEST("C72002A", "CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE " &
+                      "SPECIFICATION ARE ELABORATED IN THE ORDER " &
+                      "DECLARED");
+ 
+      IF OBJECT_ARRAY(1) /= IDENT_INT(1) THEN
+           FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(2) /= IDENT_INT(2) THEN
+           FAILED("INTEGER 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(3) /= IDENT_INT(3) THEN
+           FAILED("REAL 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(4) /= IDENT_INT(4) THEN
+           FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(5) /= IDENT_INT(5) THEN
+           FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(6) /= IDENT_INT(6) THEN
+           FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(7) /= IDENT_INT(7) THEN
+           FAILED("RECORD 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(8) /= IDENT_INT(8) THEN
+           FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(9) /= IDENT_INT(9) THEN
+           FAILED("INTEGER 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(10) /= IDENT_INT(10) THEN
+           FAILED("REAL 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(11) /= IDENT_INT(11) THEN
+           FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(12) /= IDENT_INT(12) THEN
+           FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(13) /= IDENT_INT(13) THEN
+           FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF OBJECT_ARRAY(14) /= IDENT_INT(14) THEN
+           FAILED("RECORD 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      RESULT;
+ END C72002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,437 ----
+ -- C730001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the full view of a private extension may be derived
+ --      indirectly from the ancestor type (i.e., the parent type of the full
+ --      type may be any descendant of the ancestor type). Check that, for
+ --      a primitive subprogram of the private extension that is inherited from
+ --      the ancestor type and not overridden, the formal parameter names and
+ --      default expressions come from the corresponding primitive subprogram
+ --      of the ancestor type, while the body comes from that of the parent
+ --      type.  Check both dispatching and non-dispatching cases.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      package P is
+ --         type Ancestor is tagged ...
+ --         procedure Op (P1: Ancestor; P2: Boolean := True);
+ --      end P;
+ --
+ --      with P;
+ --      package Q is
+ --         type Derived is new P.Ancestor with ...
+ --         procedure Op (X: Ancestor; Y: Boolean := False);
+ --      end Q;
+ --
+ --      with P, Q;
+ --      package R is
+ --         type Priv_Ext is new P.Ancestor with private;   -- (A)
+ --         -- Inherits procedure Op (P1: Priv_Ext; P2: Boolean := True);
+ --         -- But body executed is that of Q.Op.
+ --      private
+ --         type Priv_Ext is new Q.Derived with record ...  -- (B)
+ --      end R;
+ --
+ --      The ancestor type in (A) differs from the parent type in (B); the
+ --      parent of the full type is descended from the ancestor type of the
+ --      private extension. For a call to Op (from outside the scope of the
+ --      full view) with an operand of type Priv_Ext, the formal parameter
+ --      names and default expression come from that of P.Op (the ancestor
+ --      type's version), but the body executed will be that of 
+ --      Q.Op (the parent type's version)
+ --
+ --      One half of the test mirrors the above template, where an inherited
+ --      subprogram (Set_Display) is called using the formal parameter 
+ --      name (C) and default parameter expression of the ancestor type's 
+ --      version (type Clock), but the version of the body executed is from
+ --      the parent type.
+ --
+ --      The test also includes an examination of the dynamic evaluation
+ --      case, where correct body associations are required through dispatching 
+ --      calls.  As described for the non-dispatching case above, the formal
+ --      parameter name and default values of the ancestor type's (Phone) 
+ --      version of the inherited subprogram (Answer) are used in the 
+ --      dispatching call, but the body executed is from the parent type.
+ --      
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C730001_0 is
+ 
+    type Display_Kind      is (None, Analog, Digital);
+    type Illumination_Type is (None, Light, Phosphorescence);
+    type Capability_Type   is (Available, In_Use, Call_Waiting, Conference);
+    type Indicator_Type    is (None, Light, Bell, Buzzer, Click, Modem);
+ 
+    type Clock is abstract tagged record           -- ancestor type associated
+       Display      : Display_Kind      := None;   -- with non-dispatching case.
+       Illumination : Illumination_Type := None;
+    end record;
+ 
+    type Phone is tagged record                    -- ancestor type associated
+       Status    : Capability_Type := Available;   -- with dispatching case.
+       Indicator : Indicator_Type  := None;
+    end record;
+ 
+    -- The Set_Display procedure for type Clock implements a basic, no-frills
+    -- clock display.
+    procedure Set_Display (C   : in out Clock;
+                           Disp: in     Display_Kind := Digital);
+ 
+    -- The Answer procedure for type Phone implements a phone status change
+    -- operation.
+    procedure Answer (The_Phone : in out Phone;
+                      Ind       : in     Indicator_Type := Light);
+    -- ...Other general clock and/or phone operations (not specified in this
+    -- test scenario).
+ 
+ end C730001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C730001_0 is
+ 
+    procedure Set_Display (C   : in out Clock;
+                           Disp: in     Display_Kind := Digital) is
+    begin
+       C.Display      := Disp;
+       C.Illumination := Light;
+    end Set_Display;
+ 
+    procedure Answer (The_Phone : in out Phone;
+                      Ind       : in     Indicator_Type := Light) is
+    begin
+       The_Phone.Status    := In_Use;
+       The_Phone.Indicator := Ind;
+    end Answer;
+ 
+ end C730001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C730001_0; use C730001_0;
+ package C730001_1 is
+ 
+    type Power_Supply_Type is (Spring, Battery, AC_Current);
+    type Speaker_Type      is (None, Present, Adjustable, Stereo);
+ 
+    type Wall_Clock is new Clock with record
+       Power_Source : Power_Supply_Type := Spring;
+    end record;
+ 
+    type Office_Phone is new Phone with record
+       Speaker : Speaker_Type := Present;
+    end record;
+ 
+    -- Note: Both procedures below, parameter names and defaults differ from
+    --       parent's version.
+ 
+    -- The Set_Display procedure for type Wall_Clock improves upon the
+    -- basic Set_Display procedure of type Clock.
+ 
+    procedure Set_Display (WC: in out Wall_Clock;
+                           D : in     Display_Kind := Analog);
+ 
+    procedure Answer (OP : in out Office_Phone;
+                      OI : in     Indicator_Type := Buzzer);
+ 
+    -- ...Other wall clock and/or Office_Phone operations (not specified in
+    -- this test scenario).
+ 
+ end C730001_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C730001_1 is
+ 
+    -- Note: This body is the one that should be executed in the test block
+    --       below, not the version of the body corresponding to type Clock.
+ 
+    procedure Set_Display (WC: in out Wall_Clock;
+                           D : in     Display_Kind := Analog) is
+    begin
+       WC.Display      := D;
+       WC.Illumination := Phosphorescence;
+    end Set_Display;
+ 
+ 
+    procedure Answer (OP : in out Office_Phone;
+                      OI : in     Indicator_Type := Buzzer) is
+    begin
+       OP.Status    := Call_Waiting;
+       OP.Indicator := OI;
+    end Answer;
+ 
+ end C730001_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C730001_0; use C730001_0;
+ with C730001_1; use C730001_1;
+ package C730001_2 is
+ 
+    type Alarm_Type  is (Buzzer, Radio, Both);
+    type Video_Type  is (None, TV_Monitor, Wall_Projection);
+ 
+    type Alarm_Clock is new Clock with private;
+    -- Inherits proc Set_Display (C   : in out Clock;
+    --                            Disp: in     Display_Kind := Digital); -- (A)
+    --
+    -- Would also inherit other general clock operations (if present).
+ 
+ 
+    type Conference_Room_Phone is new Office_Phone with record
+       Display : Video_Type := TV_Monitor;
+    end record;
+ 
+    procedure Answer (CP : in out Conference_Room_Phone;
+                      CI : in     Indicator_Type := Modem);
+ 
+ 
+    function TC_Get_Display              (C: Alarm_Clock) return Display_Kind;
+    function TC_Get_Display_Illumination (C: Alarm_Clock) 
+      return Illumination_Type;
+ 
+ private
+ 
+    -- ...however, certain of the wall clock's operations (Set_Display, in 
+    -- this example) improve on the implementations provided for the general
+    -- clock. We want to call the improved implementations, so we
+    -- derive from Wall_Clock in the private part.
+ 
+    type Alarm_Clock is new Wall_Clock with record
+       Alarm : Alarm_Type := Buzzer;
+    end record;
+ 
+    -- Inherits proc Set_Display (WC: in out Wall_Clock;
+    --                            D : in     Display_Kind := Analog);    -- (B)
+ 
+    -- The implicit Set_Display at (B) overrides the implicit Set_Display at 
+    -- (A), but only within the scope of the full view. 
+    --
+    -- Outside the scope of the full view, only (A) is visible, so calls
+    -- from outside the scope will get the formal parameter names and default
+    -- from (A). Both inside and outside the scope, however, the body executed
+    -- will be that corresponding to Set_Display of the parent type.
+ 
+ end C730001_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C730001_2 is
+ 
+    procedure Answer (CP : in out Conference_Room_Phone;
+                      CI : in     Indicator_Type := Modem)is
+    begin
+       CP.Status    := Conference;
+       CP.Indicator := CI;
+    end Answer;
+ 
+ 
+    function TC_Get_Display (C: Alarm_Clock) return Display_Kind is
+    begin
+       return C.Display;
+    end TC_Get_Display;
+ 
+ 
+    function TC_Get_Display_Illumination (C: Alarm_Clock) 
+      return Illumination_Type is
+    begin
+       return C.Illumination;
+    end TC_Get_Display_Illumination;
+ 
+ end C730001_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C730001_0; use C730001_0;
+ with C730001_1; use C730001_1;
+ with C730001_2; use C730001_2;
+ 
+ package C730001_3 is
+ 
+    -- Types extended from the ancestor (Phone) type in the specification.
+ 
+    type Secure_Phone_Type     is new Phone with private;
+    type Auditorium_Phone_Type is new Phone with private;
+    -- Inherit versions of Answer from ancestor (Phone).
+ 
+    function TC_Get_Phone_Status (P : Phone'Class) return Capability_Type;
+    function TC_Get_Indicator    (P : Phone'Class) return Indicator_Type;
+ 
+ private
+ 
+    -- Types extended from descendents of Phone_Type in the private part.
+ 
+    type Secure_Phone_Type is new Office_Phone with record
+       Scrambled_Communication : Boolean := True;
+    end record;
+ 
+    type Auditorium_Phone_Type is new Conference_Room_Phone with record
+       Volume_Control : Boolean := True;
+    end record;
+ 
+ end C730001_3;
+ 
+      --==================================================================--
+ 
+ package body C730001_3 is
+ 
+    function TC_Get_Phone_Status (P : Phone'Class) return Capability_Type is
+    begin
+       return P.Status;
+    end TC_Get_Phone_Status;
+ 
+    function TC_Get_Indicator (P : Phone'Class) return Indicator_Type is
+    begin
+       return P.Indicator;
+    end TC_Get_Indicator;
+ 
+ end C730001_3;
+ 
+      --==================================================================--
+ 
+ with C730001_0; use C730001_0;
+ with C730001_1; use C730001_1;
+ with C730001_2; use C730001_2;
+ with C730001_3; use C730001_3;
+ 
+ with Report;
+ 
+ procedure C730001 is
+ begin
+ 
+    Report.Test ("C730001","Check that the full view of a private extension " &
+                           "may be derived indirectly from the ancestor "     &
+                           "type. Check that, for a primitive subprogram "    &
+                           "of the private extension that is inherited from " &
+                           "the ancestor type and not overridden, the "       &
+                           "formal parameter names and default expressions "  &
+                           "come from the corresponding primitive "           &
+                           "subprogram of the ancestor type, while the body " &
+                           "comes from that of the parent type");
+ 
+    Test_Block:
+    declare
+ 
+       Alarm                : Alarm_Clock;
+       Hot_Line             : Secure_Phone_Type;
+       TeleConference_Phone : Auditorium_Phone_Type;
+ 
+    begin
+ 
+    -- Evaluate non-dispatching case:
+ 
+       -- Call Set_Display using formal parameter name from 
+       -- C730001_0.Set_Display.
+       -- Give no 2nd parameter so that default expression must be used.
+ 
+       Set_Display (C => Alarm);
+     
+       -- The value of the Display component should equal Digital, which is
+       -- the default value from the ancestor's version of Set_Display,
+       -- and not the default value from the parent's version of Set_Display.
+ 
+       if TC_Get_Display (Alarm) /= Digital then
+          Report.Failed ("Default expression for ancestor op not used " &
+                         "in non-dispatching case");
+       end if;
+ 
+       -- However, the value of the Illumination component should equal
+       -- Phosphorescence, which is assigned in the parent type's version of
+       -- the body of Set_Display.
+ 
+       if TC_Get_Display_Illumination (Alarm) /= Phosphorescence then
+          Report.Failed ("Wrong body was executed in non-dispatching case");
+       end if;
+ 
+ 
+    -- Evaluate dispatching case:
+       declare
+ 
+          Hot_Line             : Secure_Phone_Type;
+          TeleConference_Phone : Auditorium_Phone_Type;
+ 
+          procedure Answer_The_Phone (P : in out Phone'Class) is
+          begin
+             -- Give no 2nd parameter so that default expression must be used.
+             Answer (P);
+          end Answer_The_Phone;
+ 
+       begin
+ 
+          Answer_The_Phone (Hot_Line);
+          Answer_The_Phone (TeleConference_Phone);
+ 
+          -- The value of the Indicator field shold equal "Light", the default
+          -- value from the ancestor's version of Answer, and not the default
+          -- from either of the parent versions of Answer.
+ 
+          if TC_Get_Indicator(Hot_Line)             /= Light   or
+             TC_Get_Indicator(TeleConference_Phone) /= Light
+          then
+             Report.Failed("Default expression from ancestor operation " &
+                           "not used in dispatching case");
+          end if;
+ 
+          -- However, the value of the Status component should equal
+          -- Call_Waiting or Conference respectively, based on the assignment
+          -- in the parent type's version of the body of Answer.
+ 
+          if TC_Get_Phone_Status(Hot_Line)  /=  Call_Waiting then
+             Report.Failed("Wrong body executed in dispatching case - 1");
+          end if;
+ 
+          if TC_Get_Phone_Status(TeleConference_Phone) /= Conference then
+             Report.Failed("Wrong body executed in dispatching case - 2");
+          end if;
+ 
+       end;
+ 
+    exception
+       when others => Report.Failed ("Exception raised in Test_Block");
+    end Test_Block;
+ 
+ 
+    Report.Result;
+ 
+ end C730001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,383 ----
+ -- C730002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the full view of a private extension may be derived
+ --      indirectly from the ancestor type (i.e., the parent type of the full
+ --      type may be any descendant of the ancestor type). Check that, for
+ --      a primitive subprogram of the private extension that is inherited from
+ --      the ancestor type and not overridden, the formal parameter names and
+ --      default expressions come from the corresponding primitive subprogram
+ --      of the ancestor type, while the body comes from that of the parent
+ --      type.
+ --      Check for a case where the parent type is derived from the ancestor
+ --      type through a series of types produced by generic instantiations.
+ --      Examine both the static and dynamic binding cases.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      package P is
+ --         type Ancestor is tagged ...
+ --         procedure Op (P1: Ancestor; P2: Boolean := True);
+ --      end P;
+ --
+ --      with P;
+ --      generic
+ --         type T is new P.Ancestor with private;  
+ --      package Gen1 is
+ --         type Enhanced is new T with private;
+ --         procedure Op (A: Enhanced; B: Boolean := True);
+ --         -- other specific procedures...
+ --      private
+ --         type Enhanced is new T with ...
+ --      end Gen1;
+ --
+ --      with P, Gen1;
+ --      package N is new Gen1 (P.Ancestor);
+ --
+ --      with N;
+ --      generic
+ --         type T is new N.Enhanced with private;
+ --      package Gen2 is
+ --         type Enhanced_Again is new T with private;
+ --         procedure Op (X: Enhanced_Again; Y: Boolean := False);
+ --         -- other specific procedures...
+ --      private
+ --         type Enhanced_Again is new T with ...
+ --      end Gen2;
+ --
+ --      with N, Gen2;
+ --      package Q is new Gen2 (N.Enhanced);
+ --
+ --      with P, Q;
+ --      package R is
+ --         type Priv_Ext is new P.Ancestor with private;         -- (A)
+ --         -- Inherits procedure Op (P1: Priv_Ext; P2: Boolean := True);
+ --         -- But body executed is that of Q.Op.
+ --      private
+ --         type Priv_Ext is new Q.Enhanced_Again with record ... -- (B)
+ --      end R;
+ --
+ --      The ancestor type in (A) differs from the parent type in (B); the
+ --      parent of the full type is descended from the ancestor type of the
+ --      private extension, in this case through a series of types produced
+ --      by generic instantiations.  Gen1 redefines the implementation of Op
+ --      for any type that has one.  N is an instance of Gen1 for the ancestor
+ --      type. Gen2 again redefines the implementation of Op for any type that
+ --      has one. Q is an instance of Gen2 for the extension of the P.Ancestor
+ --      declared in N.  Both N and Q could define other operations which we
+ --      don't want to be available in R.  For a call to Op (from outside the
+ --      scope of the full view) with an operand of type R.Priv_Ext, the body
+ --      executed will be that of Q.Op (the parent type's version), but the
+ --      formal parameter names and default expression come from that of P.Op
+ --      (the ancestor type's version).
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      27 Feb 97   CTA.PWB Added elaboration pragmas.
+ --!
+ 
+ package C730002_0 is
+ 
+    type Hours_Type      is range 0..1000;
+    type Personnel_Type  is range 0..10;
+    type Specialist_ID is (Manny, Moe, Jack, Curly, Joe, Larry);
+ 
+    type Engine_Type is tagged record
+       Ave_Repair_Time    : Hours_Type     := 0;     -- Default init. for
+       Personnel_Required : Personnel_Type := 0;     -- component fields.
+       Specialist         : Specialist_ID  := Manny;
+    end record;
+ 
+    procedure Routine_Maintenance (Engine     : in out Engine_Type ; 
+                                   Specialist : in     Specialist_ID := Moe);
+ 
+    -- The Routine_Maintenance procedure implements the processing required
+    -- for an engine.
+ 
+ end C730002_0;
+ 
+      --==================================================================--
+ 
+ package body C730002_0 is
+ 
+    procedure Routine_Maintenance (Engine     : in out Engine_Type ; 
+                                   Specialist : in     Specialist_ID := Moe) is
+    begin
+       Engine.Ave_Repair_Time     := 3;
+       Engine.Personnel_Required  := 1;
+       Engine.Specialist := Specialist;
+    end Routine_Maintenance;
+ 
+ end C730002_0;
+ 
+      --==================================================================--
+ 
+ with C730002_0; use C730002_0;
+ generic
+    type T is new C730002_0.Engine_Type with private;
+ package C730002_1 is
+ 
+    -- This generic package contains types/procedures specific to engines 
+    -- of the diesel variety.
+ 
+    type Repair_Facility_Type is (On_Site, Repair_Shop, Factory);
+ 
+    type Diesel_Series is new T with private;
+ 
+    procedure Routine_Maintenance (Eng      : in out Diesel_Series;
+                                   Spec_Req : in     Specialist_ID := Jack);
+   
+    -- Other diesel specific operations... (not required in this test).
+ 
+ private
+ 
+    type Diesel_Series is new T with record
+       Repair_Facility_Required : Repair_Facility_Type := On_Site;
+    end record;
+ 
+ end C730002_1;
+ 
+      --==================================================================--
+ 
+ package body C730002_1 is
+ 
+    procedure Routine_Maintenance (Eng      : in out Diesel_Series;
+                                   Spec_Req : in     Specialist_ID := Jack) is
+    begin
+       Eng.Ave_Repair_Time          := 6;
+       Eng.Personnel_Required       := 2;
+       Eng.Specialist               := Spec_Req;
+       Eng.Repair_Facility_Required := On_Site;
+    end Routine_Maintenance;
+ 
+ end C730002_1;
+ 
+      --==================================================================--
+ 
+ with C730002_0;
+ with C730002_1;
+ pragma Elaborate (C730002_1);
+ package C730002_2 is new C730002_1 (C730002_0.Engine_Type);
+ 
+      --==================================================================--
+ 
+ with C730002_0; use C730002_0;
+ with C730002_2; use C730002_2;
+ generic
+   type T is new C730002_2.Diesel_Series with private;
+ package C730002_3 is
+ 
+    type Time_Of_Operation_Type is range 0..100_000;
+ 
+    type Electric_Series is new T with private;
+ 
+    procedure Routine_Maintenance (E  : in out Electric_Series;
+                                   SR : in     Specialist_ID := Curly);
+ 
+    -- Other electric specific operations... (not required in this test).
+ 
+ private
+ 
+    type Electric_Series is new T with record
+       Mean_Time_Between_Repair : Time_Of_Operation_Type := 0;
+    end record; 
+ 
+ end C730002_3;
+ 
+      --==================================================================--
+ 
+ package body C730002_3 is
+ 
+    procedure Routine_Maintenance (E  : in out Electric_Series;
+                                   SR : in     Specialist_ID := Curly) is
+    begin
+       E.Ave_Repair_Time          := 9;
+       E.Personnel_Required       := 3;
+       E.Specialist               := SR;
+       E.Mean_Time_Between_Repair := 1000;
+    end Routine_Maintenance;
+ 
+ end C730002_3;
+ 
+      --==================================================================--
+ 
+ with C730002_2;
+ with C730002_3;
+ pragma Elaborate (C730002_3);
+ package C730002_4 is new C730002_3 (C730002_2.Diesel_Series);
+ 
+      --==================================================================--
+ 
+ with C730002_0;  use C730002_0;
+ with C730002_4;  use C730002_4;
+ 
+ package C730002_5 is
+ 
+    type Inspection_Type is (AAA, MIL_STD, NRC);
+ 
+    type Nuclear_Series is new Engine_Type with private;              -- (A)
+ 
+    -- Inherits procedure Routine_Maintenance from ancestor; does not override.
+    --                      (Engine     : in out Nuclear_Series; 
+    --                       Specialist : in     Specialist_ID := Moe);
+    -- But body executed will be that of C730002_4.Routine_Maintenance, 
+    -- the parent type.
+ 
+    function TC_Specialist         (E : Nuclear_Series) return Specialist_ID;
+    function TC_Personnel_Required (E : Nuclear_Series) return Personnel_Type;
+    function TC_Time_Required      (E : Nuclear_Series) return Hours_Type;
+ 
+    -- Dispatching subprogram.
+    procedure Maintain_The_Engine (The_Engine : in out Engine_Type'Class);
+ 
+ private
+ 
+    type Nuclear_Series is new Electric_Series with record           -- (B)
+       Inspector_Rep : Inspection_Type := NRC;
+    end record;
+ 
+    -- The ancestor type is used in the type extension (A), while the parent
+    -- of the full type (B) is a descendent of the ancestor type, through a
+    -- series of types produced by generic instantiation.
+ 
+ end C730002_5;
+ 
+      --==================================================================--
+ 
+ package body C730002_5 is
+ 
+    function TC_Specialist (E : Nuclear_Series) return Specialist_ID is
+    begin
+       return E.Specialist;
+    end TC_Specialist;
+ 
+    function TC_Personnel_Required (E : Nuclear_Series) 
+      return Personnel_Type is
+    begin
+       return E.Personnel_Required;
+    end TC_Personnel_Required;
+ 
+    function TC_Time_Required (E : Nuclear_Series) return Hours_Type is
+    begin
+       return E.Ave_Repair_Time;
+    end TC_Time_Required;
+ 
+    -- Dispatching subprogram.
+    procedure Maintain_The_Engine (The_Engine : in out Engine_Type'Class) is
+    begin
+       Routine_Maintenance (The_Engine);
+    end Maintain_The_Engine;
+ 
+ 
+ end C730002_5;
+ 
+      --==================================================================--
+ 
+ with Report;
+ with C730002_0;  use C730002_0;
+ with C730002_2;  use C730002_2;
+ with C730002_4;  use C730002_4;
+ with C730002_5;  use C730002_5;
+ 
+ procedure C730002 is
+ begin
+ 
+    Report.Test ("C730002", "Check that the full view of a private "        &
+                            "extension may be derived indirectly from "     &
+                            "the ancestor type.  Check for a case where "   &
+                            "the parent type is derived from the ancestor " &
+                            "type through a series of types produced by "   &
+                            "generic instantiations");
+ 
+    Test_Block:
+    declare
+       Nuclear_Drive : Nuclear_Series;
+       Warp_Drive    : Nuclear_Series;
+    begin
+ 
+       -- Non-Dispatching Case:
+       -- Call Routine_Maintenance using formal parameter name from
+       -- C730002_0.Routine_Maintenance (ancestor version).
+       -- Give no second parameter so that the default expression must be
+       -- used.
+ 
+       Routine_Maintenance (Engine => Nuclear_Drive);
+ 
+       -- The value of the Specialist component should equal "Moe",
+       -- which is the default value from the ancestor's version of
+       -- Routine_Maintenance, and not the default value from the parent's
+       -- version of Routine_Maintenance.
+ 
+       if TC_Specialist (Nuclear_Drive) /= Moe then
+          Report.Failed
+            ("Default expression for ancestor op not used " &
+             " - non-dispatching case");
+       end if;
+ 
+       -- However the value of the Ave_Repair_Time and Personnel_Required 
+       -- components should be those assigned in the parent type's version 
+       -- of the body of Routine_Maintenance.
+       -- Note: Only components associated with the ancestor type are
+       --       evaluated for the purposes of this test.
+ 
+       if TC_Personnel_Required (Nuclear_Drive) /= 3  or
+          TC_Time_Required (Nuclear_Drive)      /= 9
+       then
+          Report.Failed("Wrong body was executed - non-dispatching case");
+       end if;
+ 
+       -- Dispatching Case:
+       -- Use a dispatching subprogram to ensure that the correct body is 
+       -- used at runtime.
+ 
+       Maintain_The_Engine (Warp_Drive);
+ 
+       -- The resulting assignments to the fields of the Warp_Drive variable
+       -- should be the same as those of the Nuclear_Drive above, indicating
+       -- that the body of the parent version of the inherited subprogram
+       -- was used.
+ 
+       if TC_Specialist (Warp_Drive) /= Moe then
+          Report.Failed
+            ("Default expression for ancestor op not used - dispatching case");
+       end if;
+ 
+       if TC_Personnel_Required (Nuclear_Drive) /= 3  or
+          TC_Time_Required (Nuclear_Drive)      /= 9
+       then
+          Report.Failed("Wrong body was executed - dispatching case");
+       end if;
+ 
+ 
+    exception
+       when others => Report.Failed("Exception raised in Test_Block");
+    end Test_Block;
+ 
+    Report.Result;
+ 
+ end C730002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,283 ----
+ -- C730003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the characteristics of a type derived from a private
+ --      extension (outside the scope of the full view) are those defined by
+ --      the partial view of the private extension.
+ --      In particular, check that a component of the derived type may be
+ --      explicitly declared with the same name as a component declared for
+ --      the full view of the private extension.
+ --      Check that a component defined in the private extension of a type
+ --      may be updated through a view conversion of a type derived from
+ --      the type.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider:
+ --
+ --      package Parent is
+ --         type T is tagged record
+ --            ...
+ --         end record;
+ --
+ --         type DT is new T with private;
+ --         procedure Op1 (P: in out DT);
+ --
+ --      private
+ --         type DT is new T with record
+ --            Y: ...;                                             -- (A)
+ --         end record;
+ --      end Parent;
+ --
+ --      package body Parent is
+ --         function Op1 (P: in DT) return ... is
+ --         begin
+ --            return P.Y;
+ --         end Op1;
+ --      end Parent;
+ --
+ --      package Unrelated is
+ --         type Intermediate is new DT with record
+ --            Y: ...;  -- Note: same name as component of         -- (B)
+ --                     --       parent's full view.
+ --         end record;
+ --      end Unrelated;
+ --
+ --      package Parent.Child is
+ --         type DDT is new Intermediate with null record;
+ --         -- Implicit declared Op1 (P.DDT);                      -- (C)
+ --
+ --         procedure Op2 (P: in out DDT);
+ --      end Parent.Child;
+ --
+ --      package body Parent.Child is
+ --         procedure Op2 (P: in out DDT) is
+ --            Obj : DT renames DT(P);
+ --         begin
+ --            ...
+ --            P.Y := ...;      -- Updates DDT's Y.                -- (D)
+ --            DT(P).Y := ...;  -- Updates DT's Y.                 -- (E)
+ --            Obj.Y := ...;    -- Updates DT's Y.                 -- (F)
+ --         end Op2;
+ --      end Parent.Child;
+ --
+ --      Types DT and DDT both declare a component Y at (A) and (B),
+ --      respectively. The component Y of the full view of DT is not visible
+ --      at the place where DDT is declared. Therefore, it is invisible for
+ --      all views of DDT (although it still exists for objects of DDT), and
+ --      it is legal to declare another component for DDT with the same name.
+ --
+ --      DDT inherits the primitive subprogram Op1 from DT at (C). Op1 returns
+ --      the component Y; for calls with an operand of type DDT, Op1 returns
+ --      the Y inherited from DT, not the new Y explicitly declared for DDT,
+ --      even though the inherited Y is not visible for any view of DDT.
+ --
+ --      Within the body of Op2, the assignment statement at (D) updates the
+ --      Y explicitly declared for DDT. At (E) and (F), however, a view
+ --      conversion denotes a new view of P as an object of type DT, which
+ --      enables access to the Y from the full view of DT. Thus, the
+ --      assignment statements at (E) and (F) update the (invisible) Y from DT.
+ --
+ --      Note that the above analysis would be wrong if the new component Y
+ --      were declared directly in Child.  In that case, the two same-named
+ --      components would be illegal -- see AI-150.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 1994   SAIC    ACVC 2.0
+ --      29 JUN 1999   RAD     Declare same-named component in an
+ --                            unrelated package -- see AI-150.
+ --
+ --!
+ 
+ package C730003_0 is
+ 
+    type Suit_Kind is (Clubs, Diamonds, Hearts, Spades);
+    type Face_Kind is (Up, Down);
+ 
+    type Playing_Card is tagged record
+       Face: Face_Kind;
+       Suit: Suit_Kind;
+    end record;
+ 
+    procedure Turn_Over_Card (Card : in out Playing_Card);
+ 
+    type Disp_Card is new Playing_Card with private;
+ 
+    subtype ASCII_Representation is Natural range 1..14;
+ 
+    function Get_Private_View (A_Card : Disp_Card) return ASCII_Representation;
+ 
+ private
+ 
+    type Disp_Card is new Playing_Card with record
+       View: ASCII_Representation;                                       -- (A)
+    end record;
+ 
+ end C730003_0;
+ 
+ --==================================================================--
+ 
+ package body C730003_0 is
+ 
+    procedure Turn_Over_Card (Card: in out Playing_Card) is
+    begin
+       Card.Face := Up;
+    end Turn_Over_Card;
+ 
+    function Get_Private_View (A_Card : Disp_Card)
+      return ASCII_Representation is
+    begin
+       return A_Card.View;
+    end Get_Private_View;
+ 
+ end C730003_0;
+ 
+ --==================================================================--
+ 
+ with C730003_0; use C730003_0;
+ package C730003_1 is
+ 
+    subtype Graphic_Representation is String (1 .. 2);
+ 
+    type Graphic_Card is new Disp_Card with record
+       View : Graphic_Representation;                                    -- (B)
+                                           -- "Duplicate" component field name.
+    end record;
+ 
+ end C730003_1;
+ 
+ --==================================================================--
+ 
+ with C730003_1; use C730003_1;
+ package C730003_0.C730003_2 is
+ 
+    Queen_Of_Spades   : constant C730003_0.ASCII_Representation := 12;
+    Ace_Of_Hearts     : constant String := "AH";
+    Close_To_The_Vest : constant C730003_0.ASCII_Representation := 14;
+    Read_Em_And_Weep  : constant String := "AA";
+ 
+    type Graphic_Card is new C730003_1.Graphic_Card with null record;
+ 
+    -- Implicit function Get_Private_View                                -- (C)
+    --           (A_Card : Graphic_Card) return C730003_0.ASCII_Representation;
+ 
+    function  Get_View       (Card : Graphic_Card) return String;
+    procedure Update_View    (Card : in out Graphic_Card);
+    procedure Hide_From_View (Card : in out Graphic_Card);
+ 
+ end C730003_0.C730003_2;
+ 
+ --==================================================================--
+ 
+ package body C730003_0.C730003_2 is
+ 
+    function Get_View (Card : Graphic_Card) return String is
+    begin
+       return Card.View;
+    end Get_View;
+ 
+    procedure Update_View (Card : in out Graphic_Card) is
+       ASCII_View      : Disp_Card renames Disp_Card(Card); -- View conversion.
+    begin
+       ASCII_View.View := Queen_Of_Spades;                               -- (F)
+                                               -- Assignment to "hidden" field.
+       Card.View       := Ace_Of_Hearts;                                 -- (D)
+                                  -- Assignment to Graphic_Card declared field.
+    end Update_View;
+ 
+    procedure Hide_From_View (Card : in out Graphic_Card) is
+    begin
+       -- Update both of Card's View components.
+       Disp_Card(Card).View := Close_To_The_Vest;                        -- (E)
+                                               -- Assignment to "hidden" field.
+       Card.View            := Read_Em_And_Weep;                         -- (D)
+                                  -- Assignment to Graphic_Card declared field.
+    end Hide_From_View;
+ 
+ end C730003_0.C730003_2;
+ 
+ --==================================================================--
+ 
+ with C730003_0;
+ with C730003_0.C730003_2;
+ with Report;
+ 
+ procedure C730003 is
+ begin
+ 
+    Report.Test ("C730003", "Check that the characteristics of a type "   &
+                            "derived from a private extension (outside "  &
+                            "the scope of the full view) are those "      &
+                            "defined by the partial view of the private " &
+                            "extension");
+ 
+    Check_Your_Cards:
+    declare
+       use C730003_0;
+       use C730003_0.C730003_2;
+ 
+       Top_Card_On_The_Deck : Graphic_Card;
+ 
+    begin
+ 
+       -- Update value in the components of the card.  There are two
+       -- component fields named View, although one is not visible for
+       -- any view of a Graphic_Card.
+ 
+       Update_View(Top_Card_On_The_Deck);
+ 
+       -- Verify that both "View" components of the card have been updated.
+ 
+       if Get_View(Top_Card_On_The_Deck) /= Ace_Of_Hearts then
+          Report.Failed ("Incorrect value in visible component - 1");
+       end if;
+ 
+       if Get_Private_View(Top_Card_On_The_Deck) /= Queen_Of_Spades
+       then
+          Report.Failed ("Incorrect value in non-visible component - 1");
+       end if;
+ 
+       -- Again, update the components of the card (to blank values).
+ 
+       Hide_From_View(Top_Card_On_The_Deck);
+ 
+       -- Verify that both components have been updated.
+ 
+       if Get_View(Top_Card_On_The_Deck) /= Read_Em_And_Weep then
+          Report.Failed ("Incorrect value in visible component - 2");
+       end if;
+ 
+       if Get_Private_View(Top_Card_On_The_Deck) /= Close_To_The_Vest
+       then
+          Report.Failed ("Incorrect value in non-visible component - 2");
+       end if;
+ 
+    exception
+       when others => Report.Failed("Exception raised in test block");
+    end Check_Your_Cards;
+ 
+    Report.Result;
+ 
+ end C730003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,327 ----
+ -- C730004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that for a type declared in a package, descendants of the package
+ --      use the full view of type.  Specifically check that full view of the
+ --      limited type is visible only in private descendants (children) and in
+ --      the private parts and bodies of public descendants (children).
+ --      Check that a limited type may be used as an out parameter outside
+ --      the package that defines the type.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines a parent package containing limited private type 
+ --      definitions. Children packages are defined (one public, one private) 
+ --      that use the nonlimited full view of the types defined in the private 
+ --      part of the parent specification.
+ --      The main declares a procedure with an out parameter that was defined
+ --      as limited in the specification of the parent package.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      15 Sep 95   SAIC    Initial prerelease version.
+ --      23 Apr 96   SAIC    Added prefix for parameter in Call_Modify_File.
+ --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue and Test.Report. 
+ --
+ --!
+ 
+ package C730004_0 is 
+ 
+    -- Full views of File_Descriptor, File_Mode, File_Name, and File_Type are
+    -- are nonlimited.
+ 
+    type File_Descriptor is limited private;
+ 
+    type File_Mode is limited private;
+ 
+    Active_Mode  : constant File_Mode;
+ 
+    type File_Name is limited private;
+ 
+    type File_Type is limited private;
+ 
+    function Next_Available_File return File_Descriptor;
+ 
+ private
+ 
+    type File_Descriptor is new Integer;
+ 
+    Null_File    : constant File_Descriptor := 0;
+    First_File   : constant File_Descriptor := 1;
+ 
+    type File_Mode is 
+      (Read_Only, Write_Only, Read_Write, Archived, Corrupt, Lost);
+ 
+    Default_Mode : constant File_Mode       := Read_Only;
+    Active_Mode  : constant File_Mode       := Read_Write;
+ 
+    type File_Name is array (1 .. 6) of Character;
+ 
+    Null_String : File_Name := "      ";
+    String1     : File_Name := "ACVC  ";
+    String2     : File_Name := "  1995";
+ 
+    type File_Type is 
+      record
+         Descriptor : File_Descriptor := Null_File;
+         Mode       : File_Mode       := Default_Mode;
+         Name       : File_Name       := Null_String;
+      end record;
+ 
+ end C730004_0;       
+ 
+      --=================================================================--
+ 
+ package body C730004_0 is     
+ 
+    File_Count : Integer := 0;
+ 
+    function Next_Available_File return File_Descriptor is
+    begin
+       File_Count := File_Count + 1;
+       return (File_Descriptor(File_Count));    -- Type conversion.
+    end Next_Available_File;
+ 
+ end C730004_0;     
+ 
+      --=================================================================--
+ 
+ private
+ package C730004_0.C730004_1 is                             -- private child
+ 
+    -- Since full view of the nontagged File_Name is nonlimited in the parent 
+    -- package, it is not limited in the private child, so concatenation is 
+    -- available.
+ 
+    System_File_Name :  constant File_Name
+                     := String1(1..4) & String2(5..6);
+ 
+    -- Since full view of the nontagged File_Type is nonlimited in the parent 
+    -- package, it is not limited in the private child, so a default expression
+    -- is available.
+ 
+    function New_File_Validated (File :  File_Type 
+                                      := (Descriptor => First_File,
+                                          Mode       => Active_Mode,
+                                          Name       => System_File_Name))
+      return Boolean;
+ 
+    -- Since full view of the nontagged File_Type is nonlimited in the parent 
+    -- package, it is not limited in the private child, so initialization
+    -- expression in an object declaration is available.
+ 
+    System_File      :  File_Type 
+                     := (Null_File, Read_Only, System_File_Name);
+ 
+ 
+ end C730004_0.C730004_1;    
+ 
+      --=================================================================--
+ 
+ package body C730004_0.C730004_1 is 
+ 
+    function New_File_Validated (File :  File_Type 
+                                      := (Descriptor => First_File,
+                                          Mode       => Active_Mode,
+                                          Name       => System_File_Name))
+      return Boolean is                                   
+       Result : Boolean := False;                         
+    begin                                                 
+       if (File.Descriptor > System_File.Descriptor) and  
+          (File.Mode in Read_Only .. Read_Write) and (File.Name = "ACVC95")
+       then
+          Result := True;
+       end if;
+ 
+       return (Result);
+ 
+    end New_File_Validated;
+ 
+ end C730004_0.C730004_1;       
+ 
+      --=================================================================--
+ 
+ package C730004_0.C730004_2 is                   -- public child
+ 
+    -- File_Type is limited here.
+ 
+    procedure Create_File (File : out File_Type);    
+                           
+    procedure Modify_File (File : out File_Type);
+ 
+    type File_Dir is limited private;
+ 
+    -- The following three validation functions provide the capability to 
+    -- check the limited private types defined in the parent and the
+    -- private child package from within the client program.
+                                    
+    function  Validate_Create (File : in File_Type) return Boolean;
+ 
+    function  Validate_Modification (File : in File_Type) 
+      return Boolean;
+ 
+    function  Validate_Dir (Dir : in File_Dir) return Boolean;
+ 
+ private
+ 
+    -- Since full view of the nontagged File_Type is nonlimited in the parent 
+    -- package, it is not limited in the private part of the public child, so 
+    -- aggregates are available.
+ 
+    Child_File :  File_Type 
+               := File_Type'(Descriptor => Null_File, 
+                             Mode       => Write_Only,
+                             Name       => String2);
+                      
+    -- Since full view of the nontagged component File_Type is nonlimited in 
+    -- the parent package, it is not limited in the private part of the public 
+    -- child, so default expressions are available.
+ 
+    type File_Dir is 
+      record
+         Comp : File_Type := Child_File;
+      end record;
+ 
+ end C730004_0.C730004_2;             
+ 
+      --=================================================================--
+ 
+ with C730004_0.C730004_1;
+ 
+ package body C730004_0.C730004_2 is  
+ 
+    procedure Create_File (File : out File_Type) is
+       New_File : File_Type;
+ 
+    begin
+       New_File.Descriptor := Next_Available_File;       
+       New_File.Mode       := Default_Mode;
+       New_File.Name       := C730004_0.C730004_1.System_File_Name;
+ 
+       if C730004_0.C730004_1.New_File_Validated (New_File) then
+          File := New_File;
+       else 
+          File := (Null_File, Lost, "MISSED");
+       end if;
+ 
+    end Create_File;
+ 
+    --------------------------------------------------------------
+    procedure Modify_File (File : out File_Type) is
+    begin
+       File.Descriptor := Next_Available_File;      
+       File.Mode       := Active_Mode;
+       File.Name       := String1;
+    end Modify_File;     
+ 
+    --------------------------------------------------------------
+    function  Validate_Create (File : in File_Type) return Boolean is
+    begin
+       if ((File.Descriptor /= Child_File.Descriptor) and
+           (File.Mode = Read_Only) and (File.Name = "ACVC95"))
+       then
+          return True;
+       else
+          return False;
+       end if;
+    end Validate_Create;
+   
+    ------------------------------------------------------------------------
+    function  Validate_Modification (File : in File_Type) 
+       return Boolean is      
+    begin
+       if ((File.Descriptor /= C730004_0.C730004_1.System_File.Descriptor) and 
+           (File.Mode = Read_Write) and (File.Name = "ACVC  "))
+       then
+          return True;
+       else
+          return False;
+       end if;
+    end Validate_Modification;
+ 
+    ------------------------------------------------------------------------
+    function  Validate_Dir (Dir : in File_Dir) return Boolean is      
+    begin
+       if ((Dir.Comp.Descriptor = C730004_0.C730004_1.System_File.Descriptor) 
+         and (Dir.Comp.Mode = Write_Only) and (Dir.Comp.Name = String2))
+       then
+          return True;
+       else
+          return False;
+       end if;
+    end Validate_Dir;
+ 
+ end C730004_0.C730004_2;
+ 
+      --=================================================================--
+ 
+ with C730004_0.C730004_2; 
+ with Report;
+ 
+ procedure C730004 is
+ 
+    package File      renames C730004_0;
+    package File_Ops  renames C730004_0.C730004_2;            
+ 
+    Validation_File : File.File_Type;     
+ 
+    Validation_Dir  : File_Ops.File_Dir;
+ 
+    ------------------------------------------------------------------------ 
+    -- Limited File_Type is allowed as an out parameter outside package File.
+ 
+    procedure Call_Modify_File (Modified_File : out File.File_Type) is
+    begin
+       File_Ops.Modify_File (Modified_File);
+    end Call_Modify_File;     
+   
+ begin
+ 
+    Report.Test ("C730004", "Check that for a type declared in a package, "   &
+                            "descendants of the package use the full view "   &
+                            "of the type.  Specifically check that full "     &
+                            "view of the limited type is visible only in "    &
+                            "private children and in the private parts and "  &
+                            "bodies of public children");
+ 
+    File_Ops.Create_File (Validation_File);
+ 
+    if not File_Ops.Validate_Create (Validation_File) then
+       Report.Failed ("Incorrect creation of file");
+    end if;
+ 
+    Call_Modify_File (Validation_File);
+ 
+    if not File_Ops.Validate_Modification (Validation_File) then 
+       Report.Failed ("Incorrect modification of file");
+    end if;
+ 
+    if not File_Ops.Validate_Dir (Validation_Dir) then
+       Report.Failed ("Incorrect creation of directory");
+    end if;
+ 
+    Report.Result;
+ 
+ end C730004; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c73002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c73002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c73002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c73002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C73002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE STATEMENTS IN A PACKAGE BODY ARE EXECUTED AFTER THE
+ --    ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).
+ 
+ 
+ -- RM 05/15/81
+ -- JBG 9/21/83
+ 
+ WITH REPORT;
+ PROCEDURE  C73002A  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C73002A" , "CHECK: EXECUTION OF STATEMENTS IN A PACKAGE " &
+                        "BODY FOLLOWS ELABORATION OF THE DECLARATIONS");
+ 
+      DECLARE
+ 
+           PACKAGE  P1  IS
+ 
+                A : INTEGER := IDENT_INT(7);
+ 
+                PACKAGE  P2  IS
+                     B : INTEGER := IDENT_INT(11);
+                END  P2;
+ 
+           END  P1;
+ 
+ 
+           PACKAGE BODY  P1  IS               --   A  AA   B  BB
+ 
+                AA : INTEGER := IDENT_INT(7); --   7   7  11 (11)
+ 
+                PACKAGE BODY  P2  IS
+                     BB : INTEGER := IDENT_INT(11);--  7  11  11
+                BEGIN
+ 
+                     B  := 2*B ;             --   7   7  22  11
+                     BB := 2*BB;             --   7   7  22  22
+                     A  := 5*A ;             --  35   7  22  22
+                     AA := 2*AA;             --  35  14  22  22
+ 
+                     IF  BB /=  22  OR
+                         AA /=  14  OR
+                         A  /=  35  OR
+                         B  /=  22
+                     THEN
+                          FAILED( "ASSIGNED VALUES INCORRECT  -  1" );
+                     END IF;
+ 
+                END  P2;
+ 
+           BEGIN
+ 
+                A  :=  A  + 20;              --  55  14  22  22
+                AA :=  AA + 20;              --  55  34  22  22
+ 
+                IF  AA /=  34  OR
+                    A  /=  55  OR
+                    P2.B /=  22
+                THEN
+                     FAILED( "ASSIGNED VALUES INCORRECT  -  2" );
+                END IF;
+ 
+           END  P1;
+ 
+ 
+           USE  P1;
+           USE  P2;
+ 
+      BEGIN
+ 
+           IF  A  /=  55  OR
+               B  /=  22
+           THEN
+                FAILED( "ASSIGNED VALUES INCORRECT  -  3" );
+           END IF;
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END C73002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,176 ----
+ -- C730A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a tagged type declared in a package specification
+ --      may be passed as a generic formal (tagged) private type to a generic
+ --      package declaration. Check that the formal type may be extended with
+ --      a private extension in the generic package.
+ --
+ --      Check that, in the instance, the private extension inherits the
+ --      user-defined primitive subprograms of the tagged actual.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a tagged type and an associated primitive subprogram in a
+ --      package specification (foundation code). Declare a generic package
+ --      which takes a tagged type as a formal parameter, and then extends
+ --      it with a private extension (foundation code).
+ --      
+ --      Instantiate the generic package with the tagged type from the first
+ --      package (the "generic" extension should now have inherited
+ --      the primitive subprogram of the tagged type from the first
+ --      package).
+ -- 
+ --      In the main program, call the primitive subprogram inherited by the
+ --      "generic" extension, and verify the correctness of the components.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F730A000.A
+ --         F730A001.A
+ --      => C730A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with F730A001;        -- Book definitions.
+ package C730A01_0 is  -- Raw data to be used in creating book elements.
+ 
+ 
+    Book_Count : constant := 3;
+ 
+    subtype Number_Of_Books is Integer range 1 .. Book_Count;
+ 
+    type Data_List is array (Number_Of_Books) of F730A001.Text_Ptr;
+ 
+    Title_List  : Data_List := (new String'("Wuthering Heights"),
+                                new String'("Heart of Darkness"),
+                                new String'("Ulysses"));
+ 
+    Author_List : Data_List := (new String'("Bronte, Emily"),
+                                new String'("Conrad, Joseph"),
+                                new String'("Joyce, James"));
+ 
+ end C730A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- Library-level instantiation. Actual parameter is tagged record.
+ 
+ with F730A001;  -- Book definitions.
+ with F730A000;  -- Singly-linked list abstraction.
+ package C730A01_1 is new F730A000 (Parent_Type => F730A001.Book_Type);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with F730A001;   -- Book definitions.
+ with C730A01_0;  -- Raw book data.
+ with C730A01_1;  -- Instance.
+ 
+ use  F730A001;   -- Primitive operations of Book_Type directly visible.
+ use  C730A01_1;  -- Operations inherited by Node_Type directly visible.
+ 
+ procedure C730A01 is
+ 
+ 
+    List_Of_Books : Priv_Node_Ptr := null;  -- Head of linked list of books.
+ 
+ 
+           --========================================================--
+ 
+ 
+    procedure Create_List (Title, Author : in     C730A01_0.Data_List;
+                           Head          : in out Priv_Node_Ptr) is
+ 
+       Book     : Priv_Node_Type;  -- Object of extended type.
+       Book_Ptr : Priv_Node_Ptr;
+ 
+    begin
+       for I in C730A01_0.Number_Of_Books loop
+          Create_Book (Title (I), Author (I), Book);    -- Call inherited
+                                                        -- operation.
+          Book_Ptr := new Priv_Node_Type'(Book);
+          Add (Book_Ptr, Head);
+       end loop;
+    end Create_List;
+ 
+ 
+           --========================================================--
+ 
+ 
+    function Bad_List_Contents return Boolean is
+       Book1_Ptr : Priv_Node_Ptr;
+       Book2_Ptr : Priv_Node_Ptr;
+       Book3_Ptr : Priv_Node_Ptr;
+    begin
+       Remove (List_Of_Books, Book1_Ptr);
+       Remove (List_Of_Books, Book2_Ptr);
+       Remove (List_Of_Books, Book3_Ptr);
+       return (Book1_Ptr.Title.all  /= "Ulysses"           or   -- Inherited
+               Book1_Ptr.Author.all /= "Joyce, James"      or   -- components
+               Book2_Ptr.Title.all  /= "Heart of Darkness" or   -- should still
+               Book2_Ptr.Author.all /= "Conrad, Joseph"    or   -- be visible in
+               Book3_Ptr.Title.all  /= "Wuthering Heights" or   -- private
+               Book3_Ptr.Author.all /= "Bronte, Emily");        -- extension.
+ 
+    end Bad_List_Contents;
+ 
+ 
+           --========================================================--
+ 
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C730A01", "Inheritance of primitive operations: private " &
+                 "extension of formal tagged private type; actual is " &
+                 "an ultimate ancestor type");
+ 
+    -- Create linked list using inherited operation:
+    Create_List (C730A01_0.Title_List, C730A01_0.Author_List, List_Of_Books);
+ 
+    -- Verify results:
+    if Bad_List_Contents then
+       Report.Failed ("Wrong values after call to inherited operation");
+    end if;
+ 
+    Report.Result;
+ 
+ end C730A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c730a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c730a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,252 ----
+ -- C730A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a private extension (declared in a package specification) of
+ --      a tagged type (declared in a different package specification) may be
+ --      passed as a generic formal (tagged) private type to a generic package
+ --      declaration. Check that the formal type may be further extended with a
+ --      private extension in the generic package.
+ --
+ --      Check that the (visible) components inherited by the "generic"
+ --      extension are visible outside the generic package.
+ --
+ --      Check that, in the instance, the private extension inherits the
+ --      user-defined primitive subprograms of the tagged actual, including
+ --      those inherited by the actual from its parent.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a tagged type and an associated primitive subprogram in a
+ --      package specification (foundation code). Declare a private extension
+ --      of the tagged type and an associated primitive subprogram in a second
+ --      package specification. Declare a generic package which takes a tagged
+ --      type as a formal parameter, and then extends it with a private
+ --      extension (foundation code).
+ --      
+ --      Instantiate the generic package with the private extension from the
+ --      second package (the "generic" extension should now have inherited
+ --      the primitive subprograms of the private extension from the second
+ --      package).
+ -- 
+ --      In the main program, call the primitive subprograms inherited by the
+ --      "generic" extension. There are two: (1) Create_Book, declared for
+ --      the root tagged type in the first package (inherited by the private
+ --      extension of the second package, and then in turn by the "generic"
+ --      extension), and (2) Update_Pages, declared for the private extension
+ --      in the second package. Verify the correctness of the components.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F730A000.A
+ --         F730A001.A
+ --      => C730A02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with F730A001;        -- Book definitions.
+ package C730A02_0 is  -- Extended book abstraction.
+ 
+ 
+    type Detailed_Book_Type is new F730A001.Book_Type          -- Private ext.
+      with private;                                            -- of root tagged
+                                                               -- type.
+ 
+    -- Inherits Create_Book from Book_Type.
+ 
+    procedure Update_Pages (Book  : in out Detailed_Book_Type; -- Primitive op.
+                            Pages : in     Natural);           -- of extension.
+ 
+ 
+    -- The following function is needed to verify the value of the
+    -- extension's private component. It will be inherited by extensions
+    -- of Detailed_Book_Type.
+ 
+    function Get_Pages (Book : in Detailed_Book_Type) return Natural;
+                                                    
+ private
+ 
+    type Detailed_Book_Type is new F730A001.Book_Type with record
+       Pages : Natural;
+    end record;
+ 
+ end C730A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C730A02_0 is
+ 
+ 
+    procedure Update_Pages (Book  : in out Detailed_Book_Type;
+                            Pages : in     Natural) is
+    begin
+       Book.Pages := Pages;
+    end Update_Pages;
+ 
+ 
+    function Get_Pages (Book : in Detailed_Book_Type) return Natural is
+    begin
+       return (Book.Pages);
+    end Get_Pages;
+ 
+ 
+ end C730A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with F730A001;        -- Book definitions. 
+ package C730A02_1 is  -- Raw data to be used in creating book elements.
+ 
+ 
+    Book_Count : constant := 3;
+ 
+    subtype Number_Of_Books is Integer range 1 .. Book_Count;
+ 
+    type Data_List   is array (Number_Of_Books) of F730A001.Text_Ptr;
+    type Page_Counts is array (Number_Of_Books) of Natural;
+ 
+    Title_List  : Data_List   := (new String'("Wuthering Heights"),
+                                  new String'("Heart of Darkness"),
+                                  new String'("Ulysses"));
+ 
+    Author_List : Data_List   := (new String'("Bronte, Emily"),
+                                  new String'("Conrad, Joseph"),
+                                  new String'("Joyce, James"));
+ 
+    Page_List   : Page_Counts := (237, 215, 456);
+ 
+ end C730A02_1;
+ 
+ 
+ -- No body for C730A02_1.
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- Library-level instantiation. Actual parameter is private extension.
+ 
+ with C730A02_0;  -- Extended book abstraction.
+ with F730A000;   -- Singly-linked list abstraction.
+ package C730A02_2 is new F730A000
+   (Parent_Type => C730A02_0.Detailed_Book_Type);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with C730A02_0; -- Extended book abstraction.
+ with C730A02_1; -- Raw book data.
+ with C730A02_2; -- Instance.
+ 
+ use  C730A02_0; -- Primitive operations of Detailed_Book_Type directly visible.
+ use  C730A02_2; -- Operations inherited by Priv_Node_Type directly visible.
+ 
+ procedure C730A02 is
+ 
+ 
+    List_Of_Books : Priv_Node_Ptr := null;  -- Head of linked list of books.
+ 
+ 
+           --========================================================--
+ 
+ 
+    procedure Create_List (Title, Author : in     C730A02_1.Data_List;
+                           Pages         : in     C730A02_1.Page_Counts;
+                           Head          : in out Priv_Node_Ptr) is
+ 
+       Book     : Priv_Node_Type;  -- Object of extended type.
+       Book_Ptr : Priv_Node_Ptr;
+ 
+    begin
+       for I in C730A02_1.Number_Of_Books loop
+          Create_Book (Title (I), Author (I), Book);    -- Call twice-inherited
+                                                        -- operation.
+          Update_Pages (Book, Pages (I));               -- Call inherited op.
+          Book_Ptr := new Priv_Node_Type'(Book);
+          Add (Book_Ptr, Head);
+       end loop;
+    end Create_List;
+ 
+ 
+           --========================================================--
+ 
+ 
+    function Bad_List_Contents return Boolean is
+       Book1_Ptr : Priv_Node_Ptr;
+       Book2_Ptr : Priv_Node_Ptr;
+       Book3_Ptr : Priv_Node_Ptr;
+    begin
+ 
+       Remove (List_Of_Books, Book1_Ptr);
+       Remove (List_Of_Books, Book2_Ptr);
+       Remove (List_Of_Books, Book3_Ptr);
+ 
+       return (Book1_Ptr.Title.all   /= "Ulysses"           or   -- Inherited
+               Book1_Ptr.Author.all  /= "Joyce, James"      or   -- components
+               Book2_Ptr.Title.all   /= "Heart of Darkness" or   -- should still
+               Book2_Ptr.Author.all  /= "Conrad, Joseph"    or   -- be visible
+               Book3_Ptr.Title.all   /= "Wuthering Heights" or   -- in private
+               Book3_Ptr.Author.all  /= "Bronte, Emily"     or   -- "generic"
+                                                                 -- extension.
+               -- Call inherited operations using dereferenced pointers.
+               Get_Pages (Book1_Ptr.all) /= 456             or
+               Get_Pages (Book2_Ptr.all) /= 215             or
+               Get_Pages (Book3_Ptr.all) /= 237);
+ 
+    end Bad_List_Contents;
+ 
+ 
+           --========================================================--
+ 
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C730A02", "Inheritance of primitive operations: private " &
+                 "extension of formal tagged private type; actual is " &
+                 "a private extension");
+ 
+    -- Create linked list using inherited operation:
+    Create_List (C730A02_1.Title_List, C730A02_1.Author_List,
+                 C730A02_1.Page_List,  List_Of_Books);
+ 
+    -- Verify results:
+    if Bad_List_Contents then
+       Report.Failed ("Wrong values after call to inherited operations");
+    end if;
+ 
+    Report.Result;
+ 
+ end C730A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c731001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c731001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c731001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c731001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,407 ----
+ -- C731001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE
+ --     Check that inherited operations can be overridden, even when they are
+ --     inherited in a body.
+ --     The test cases here are inspired by the AARM examples given in
+ --     the discussion of AARM-7.3.1(7.a-7.v).
+ --     This discussion was confirmed by AI95-00035.
+ --
+ -- TEST DESCRIPTION
+ --     See AARM-7.3.1.
+ --
+ -- CHANGE HISTORY:
+ --      29 JUN 1999   RAD   Initial Version
+ --      23 SEP 1999   RLB   Improved comments, renamed, issued.
+ --      20 AUG 2001   RLB   Corrected 'verbose' flag.
+ --
+ --!
+ 
+ with Report; use Report; pragma Elaborate_All(Report);
+ package C731001_1 is
+     pragma Elaborate_Body;
+ private
+     procedure Check_String(X, Y: String);
+     function Check_String(X, Y: String) return String;
+         -- This one is a function, so we can call it in package specs.
+ end C731001_1;
+ 
+ package body C731001_1 is
+ 
+     Verbose: Boolean := False;
+ 
+     procedure Check_String(X, Y: String) is
+     begin
+         if Verbose then
+             Comment("""" & X & """ = """ & Y & """?");
+         end if;
+         if X /= Y then
+             Failed("""" & X & """ should be """ & Y & """");
+         end if;
+     end Check_String;
+ 
+     function Check_String(X, Y: String) return String is
+     begin
+         Check_String(X, Y);
+         return X;
+     end Check_String;
+ 
+ end C731001_1;
+ 
+ private package C731001_1.Parent is
+ 
+     procedure Call_Main;
+ 
+     type Root is tagged null record;
+     subtype Renames_Root is Root;
+     subtype Root_Class is Renames_Root'Class;
+     function Make return Root;
+     function Op1(X: Root) return String;
+     function Call_Op2(X: Root'Class) return String;
+ private
+     function Op2(X: Root) return String;
+ end C731001_1.Parent;
+ 
+ procedure C731001_1.Parent.Main;
+ 
+ with C731001_1.Parent.Main;
+ package body C731001_1.Parent is
+ 
+     procedure Call_Main is
+     begin
+         Main;
+     end Call_Main;
+ 
+     function Make return Root is
+         Result: Root;
+     begin
+         return Result;
+     end Make;
+ 
+     function Op1(X: Root) return String is
+     begin
+         return "Parent.Op1 body";
+     end Op1;
+ 
+     function Op2(X: Root) return String is
+     begin
+         return "Parent.Op2 body";
+     end Op2;
+ 
+     function Call_Op2(X: Root'Class) return String is
+     begin
+         return Op2(X);
+     end Call_Op2;
+ 
+ begin
+ 
+     Check_String(Op1(Root'(Make)), "Parent.Op1 body");
+     Check_String(Op1(Root_Class(Root'(Make))), "Parent.Op1 body");
+ 
+     Check_String(Op2(Root'(Make)), "Parent.Op2 body");
+     Check_String(Op2(Root_Class(Root'(Make))), "Parent.Op2 body");
+ 
+ end C731001_1.Parent;
+ 
+ with C731001_1.Parent; use C731001_1.Parent;
+ private package C731001_1.Unrelated is
+ 
+     type T2 is new Root with null record;
+     subtype T2_Class is T2'Class;
+     function Make return T2;
+     function Op2(X: T2) return String;
+ end C731001_1.Unrelated;
+ 
+ with C731001_1.Parent; use C731001_1.Parent;
+     pragma Elaborate(C731001_1.Parent);
+ package body C731001_1.Unrelated is
+ 
+     function Make return T2 is
+         Result: T2;
+     begin
+         return Result;
+     end Make;
+ 
+     function Op2(X: T2) return String is
+     begin
+         return "Unrelated.Op2 body";
+     end Op2;
+ begin
+ 
+     Check_String(Op1(T2'(Make)), "Parent.Op1 body");
+     Check_String(Op1(T2_Class(T2'(Make))), "Parent.Op1 body");
+     Check_String(Op1(Root_Class(T2'(Make))), "Parent.Op1 body");
+ 
+     Check_String(Op2(T2'(Make)), "Unrelated.Op2 body");
+     Check_String(Op2(T2_Class(T2'(Make))), "Unrelated.Op2 body");
+     Check_String(Call_Op2(T2'(Make)), "Parent.Op2 body");
+     Check_String(Call_Op2(T2_Class(T2'(Make))), "Parent.Op2 body");
+     Check_String(Call_Op2(Root_Class(T2'(Make))), "Parent.Op2 body");
+ 
+ end C731001_1.Unrelated;
+ 
+ package C731001_1.Parent.Child is
+     pragma Elaborate_Body;
+ 
+     type T3 is new Root with null record;
+     subtype T3_Class is T3'Class;
+     function Make return T3;
+ 
+     T3_Obj: T3;
+     T3_Class_Obj: T3_Class := T3_Obj;
+     T3_Root_Class_Obj: Root_Class := T3_Obj;
+ 
+     X3: constant String :=
+       Check_String(Op1(T3_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
+ 
+       Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+ 
+     package Nested is
+         type T4 is new Root with null record;
+         subtype T4_Class is T4'Class;
+         function Make return T4;
+ 
+         T4_Obj: T4;
+         T4_Class_Obj: T4_Class := T4_Obj;
+         T4_Root_Class_Obj: Root_Class := T4_Obj;
+ 
+         X4: constant String :=
+           Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+           Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+           Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+ 
+           Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+           Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+           Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+     private
+ 
+         XX4: constant String :=
+           Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+           Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+           Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+ 
+           Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+           Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+           Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+     end Nested;
+ 
+     use Nested;
+ 
+     XXX4: constant String :=
+       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+ 
+       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+ private
+ 
+     XX3: constant String :=
+       Check_String(Op1(T3_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
+ 
+       Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
+ 
+       Check_String(Op2(T3_Obj), "Parent.Op2 body") &
+       Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
+       Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+ 
+     XXXX4: constant String :=
+       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+ 
+       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+ 
+       Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+ end C731001_1.Parent.Child;
+ 
+ with C731001_1.Unrelated; use C731001_1.Unrelated;
+     pragma Elaborate(C731001_1.Unrelated);
+ package body C731001_1.Parent.Child is
+ 
+     XXX3: constant String :=
+       Check_String(Op1(T3_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
+ 
+       Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
+ 
+       Check_String(Op2(T3_Obj), "Parent.Op2 body") &
+       Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
+       Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+ 
+     XXXXX4: constant String :=
+       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+ 
+       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+ 
+       Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+     function Make return T3 is
+         Result: T3;
+     begin
+         return Result;
+     end Make;
+ 
+     package body Nested is
+         function Make return T4 is
+             Result: T4;
+         begin
+             return Result;
+         end Make;
+ 
+         XXXXXX4: constant String :=
+           Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+           Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+           Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+ 
+           Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+           Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+           Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+ 
+           Check_String(Op2(T4_Obj), "Parent.Op2 body") &
+           Check_String(Op2(T4_Class_Obj), "Parent.Op2 body") &
+           Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+     end Nested;
+ 
+     type T5 is new T2 with null record;
+     subtype T5_Class is T5'Class;
+     function Make return T5;
+ 
+     function Make return T5 is
+         Result: T5;
+     begin
+         return Result;
+     end Make;
+ 
+     XXXXXXX4: constant String :=
+       Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+       Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+ 
+       Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+       Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+ 
+       Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+ end C731001_1.Parent.Child;
+ 
+ procedure C731001_1.Main;
+ 
+ with C731001_1.Parent;
+ procedure C731001_1.Main is
+ begin
+     C731001_1.Parent.Call_Main;
+ end C731001_1.Main;
+ 
+ with C731001_1.Parent.Child;
+     use C731001_1.Parent;
+     use C731001_1.Parent.Child;
+     use C731001_1.Parent.Child.Nested;
+ with C731001_1.Unrelated; use C731001_1.Unrelated;
+ procedure C731001_1.Parent.Main is
+ 
+     Root_Obj: Root := Make;
+     Root_Class_Obj: Root_Class := Root'(Make);
+ 
+     T2_Obj: T2 := Make;
+     T2_Class_Obj: T2_Class := T2_Obj;
+     T2_Root_Class_Obj: Root_Class := T2_Class_Obj;
+ 
+     T3_Obj: T3 := Make;
+     T3_Class_Obj: T3_Class := T3_Obj;
+     T3_Root_Class_Obj: Root_Class := T3_Obj;
+ 
+     T4_Obj: T4 := Make;
+     T4_Class_Obj: T4_Class := T4_Obj;
+     T4_Root_Class_Obj: Root_Class := T4_Obj;
+ 
+ begin
+     Test("C731001_1", "Check that inherited operations can be overridden, even"
+                     & " when they are inherited in a body");
+ 
+     Check_String(Op1(Root_Obj), "Parent.Op1 body");
+     Check_String(Op1(Root_Class_Obj), "Parent.Op1 body");
+ 
+     Check_String(Call_Op2(Root_Obj), "Parent.Op2 body");
+     Check_String(Call_Op2(Root_Class_Obj), "Parent.Op2 body");
+ 
+     Check_String(Op1(T2_Obj), "Parent.Op1 body");
+     Check_String(Op1(T2_Class_Obj), "Parent.Op1 body");
+     Check_String(Op1(T2_Root_Class_Obj), "Parent.Op1 body");
+ 
+     Check_String(Op2(T2_Obj), "Unrelated.Op2 body");
+     Check_String(Op2(T2_Class_Obj), "Unrelated.Op2 body");
+     Check_String(Call_Op2(T2_Obj), "Parent.Op2 body");
+     Check_String(Call_Op2(T2_Class_Obj), "Parent.Op2 body");
+     Check_String(Call_Op2(T2_Root_Class_Obj), "Parent.Op2 body");
+ 
+     Check_String(Op1(T3_Obj), "Parent.Op1 body");
+     Check_String(Op1(T3_Class_Obj), "Parent.Op1 body");
+     Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body");
+ 
+     Check_String(Call_Op2(T3_Obj), "Parent.Op2 body");
+     Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body");
+     Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+ 
+     Check_String(Op1(T4_Obj), "Parent.Op1 body");
+     Check_String(Op1(T4_Class_Obj), "Parent.Op1 body");
+     Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body");
+ 
+     Check_String(Call_Op2(T4_Obj), "Parent.Op2 body");
+     Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body");
+     Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+ 
+     Result;
+ end C731001_1.Parent.Main;
+ 
+ with C731001_1.Main;
+ procedure C731001 is
+ begin
+     C731001_1.Main;
+ end C731001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,375 ----
+ -- C74004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OPERATIONS DEPENDING ON THE FULL DECLARATION OF A
+ --     PRIVATE TYPE ARE AVAILABLE WITHIN THE PACKAGE BODY.
+ 
+ -- HISTORY:
+ --     BCB 04/05/88  CREATED ORIGINAL TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74004A IS
+ 
+      PACKAGE P IS
+           TYPE PR IS PRIVATE;
+           TYPE ARR1 IS LIMITED PRIVATE;
+           TYPE ARR2 IS PRIVATE;
+           TYPE REC (D : INTEGER) IS PRIVATE;
+           TYPE ACC IS PRIVATE;
+           TYPE TSK IS LIMITED PRIVATE;
+           TYPE FLT IS LIMITED PRIVATE;
+           TYPE FIX IS LIMITED PRIVATE;
+ 
+           TASK TYPE T IS
+                ENTRY ONE(V : IN OUT INTEGER);
+           END T;
+ 
+           PROCEDURE CHECK (V : ARR2);
+      PRIVATE
+           TYPE PR IS NEW INTEGER;
+ 
+           TYPE ARR1 IS ARRAY(1..5) OF INTEGER;
+ 
+           TYPE ARR2 IS ARRAY(1..5) OF BOOLEAN;
+ 
+           TYPE REC (D : INTEGER) IS RECORD
+                COMP1 : INTEGER;
+                COMP2 : BOOLEAN;
+           END RECORD;
+ 
+           TYPE ACC IS ACCESS INTEGER;
+ 
+           TYPE TSK IS NEW T;
+ 
+           TYPE FLT IS DIGITS 5;
+ 
+           TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
+      END P;
+ 
+      PACKAGE BODY P IS
+           X1, X2, X3 : PR;
+           BOOL : BOOLEAN := IDENT_BOOL(FALSE);
+           VAL : INTEGER := IDENT_INT(0);
+           FVAL : FLOAT := 0.0;
+           ST : STRING(1..2);
+           O1 : ARR1 := (1,2,3,4,5);
+           Y1 : ARR2 := (FALSE,TRUE,FALSE,TRUE,FALSE);
+           Y2 : ARR2 := (OTHERS => TRUE);
+           Y3 : ARR2 := (OTHERS => FALSE);
+           Z1 : REC(0) := (0,1,FALSE);
+           W1, W2 : ACC := NEW INTEGER'(0);
+           V1 : TSK;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT ONE(V : IN OUT INTEGER) DO
+                     V := IDENT_INT(10);
+                END ONE;
+           END T;
+ 
+           PROCEDURE CHECK (V : ARR2) IS
+           BEGIN
+                IF V /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
+                     FAILED ("IMPROPER VALUE PASSED AS AGGREGATE");
+                END IF;
+           END CHECK;
+      BEGIN
+           TEST ("C74004A", "CHECK THAT OPERATIONS DEPENDING ON THE " &
+                            "FULL DECLARATION OF A PRIVATE TYPE ARE " &
+                            "AVAILABLE WITHIN THE PACKAGE BODY");
+ 
+           X1 := 10;
+           X2 := 5;
+ 
+           X3 := X1 + X2;
+ 
+           IF X3 /= 15 THEN
+                FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
+           END IF;
+ 
+           X3 := X1 - X2;
+ 
+           IF X3 /= 5 THEN
+                FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
+           END IF;
+ 
+           X3 := X1 * X2;
+ 
+           IF X3 /= 50 THEN
+                FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
+           END IF;
+ 
+           X3 := X1 / X2;
+ 
+           IF X3 /= 2 THEN
+                FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
+           END IF;
+ 
+           X3 := X1 ** 2;
+ 
+           IF X3 /= 100 THEN
+                FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
+           END IF;
+ 
+           BOOL := X1 < X2;
+ 
+           IF BOOL THEN
+                FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
+           END IF;
+ 
+           BOOL := X1 > X2;
+ 
+           IF NOT BOOL THEN
+                FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
+           END IF;
+ 
+           BOOL := X1 <= X2;
+ 
+           IF BOOL THEN
+                FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
+                        "OPERATOR");
+           END IF;
+ 
+           BOOL := X1 >= X2;
+ 
+           IF NOT BOOL THEN
+                FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
+                        "TO OPERATOR");
+           END IF;
+ 
+           X3 := X1 MOD X2;
+ 
+           IF X3 /= 0 THEN
+                FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
+           END IF;
+ 
+           X3 := X1 REM X2;
+ 
+           IF X3 /= 0 THEN
+                FAILED ("IMPROPER RESULT FROM REM OPERATOR");
+           END IF;
+ 
+           X3 := ABS(X1);
+ 
+           IF X3 /= 10 THEN
+                FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 1");
+           END IF;
+ 
+           X1 := -10;
+ 
+           X3 := ABS(X1);
+ 
+           IF X3 /= 10 THEN
+                FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 2");
+           END IF;
+ 
+           X3 := PR'BASE'FIRST;
+ 
+           IF X3 /= PR(INTEGER'FIRST) THEN
+                FAILED ("IMPROPER RESULT FROM 'BASE'FIRST");
+           END IF;
+ 
+           X3 := PR'FIRST;
+ 
+           IF X3 /= PR(INTEGER'FIRST) THEN
+                FAILED ("IMPROPER RESULT FROM 'FIRST");
+           END IF;
+ 
+           VAL := PR'WIDTH;
+ 
+           IF NOT EQUAL(VAL,INTEGER'WIDTH) THEN
+                FAILED ("IMPROPER RESULT FROM 'WIDTH");
+           END IF;
+ 
+           VAL := PR'POS(X3);
+ 
+           IF NOT EQUAL(VAL,INTEGER'FIRST) THEN
+                FAILED ("IMPROPER RESULT FROM 'POS");
+           END IF;
+ 
+           X3 := PR'VAL(VAL);
+ 
+           IF X3 /= PR(INTEGER'FIRST) THEN
+                FAILED ("IMPROPER RESULT FROM 'VAL");
+           END IF;
+ 
+           X3 := PR'SUCC(X2);
+ 
+           IF X3 /= 6 THEN
+                FAILED ("IMPROPER RESULT FROM 'SUCC");
+           END IF;
+ 
+           X3 := PR'PRED(X2);
+ 
+           IF X3 /= 4 THEN
+                FAILED ("IMPROPER RESULT FROM 'PRED");
+           END IF;
+ 
+           ST := PR'IMAGE(X3);
+ 
+           IF ST /= INTEGER'IMAGE(INTEGER(X3)) THEN
+                FAILED ("IMPROPER RESULT FROM 'IMAGE");
+           END IF;
+ 
+           X3 := PR'VALUE(ST);
+ 
+           IF X3 /= PR(INTEGER'VALUE(ST)) THEN
+                FAILED ("IMPROPER RESULT FROM 'VALUE");
+           END IF;
+ 
+           CHECK ((TRUE,FALSE,TRUE,FALSE,TRUE));
+ 
+           IF O1(2) /= IDENT_INT(2) THEN
+                FAILED ("IMPROPER VALUE FROM INDEXING");
+           END IF;
+ 
+           IF O1(2..4) /= (2,3,4) THEN
+                FAILED ("IMPROPER VALUES FROM SLICING");
+           END IF;
+ 
+           IF VAL IN O1'RANGE THEN
+                FAILED ("IMPROPER RESULT FROM 'RANGE");
+           END IF;
+ 
+           VAL := O1'LENGTH;
+ 
+           IF NOT EQUAL(VAL,5) THEN
+                FAILED ("IMPROPER RESULT FROM 'LENGTH");
+           END IF;
+ 
+           Y3 := Y1(1..2) & Y2(3..5);
+ 
+           IF Y3 /= (FALSE,TRUE,TRUE,TRUE,TRUE) THEN
+                FAILED ("IMPROPER RESULT FROM CATENATION");
+           END IF;
+ 
+           Y3 := NOT Y1;
+ 
+           IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
+                FAILED ("IMPROPER RESULT FROM NOT OPERATOR");
+           END IF;
+ 
+           Y3 := Y1 AND Y2;
+ 
+           IF Y3 /= (FALSE,TRUE,FALSE,TRUE,FALSE) THEN
+                FAILED ("IMPROPER RESULT FROM AND OPERATOR");
+           END IF;
+ 
+           Y3 := Y1 OR Y2;
+ 
+           IF Y3 /= (TRUE,TRUE,TRUE,TRUE,TRUE) THEN
+                FAILED ("IMPROPER RESULT FROM OR OPERATOR");
+           END IF;
+ 
+           Y3 := Y1 XOR Y2;
+ 
+           IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
+                FAILED ("IMPROPER RESULT FROM XOR OPERATOR");
+           END IF;
+ 
+           VAL := Z1.COMP1;
+ 
+           IF NOT EQUAL(VAL,1) THEN
+                FAILED ("IMPROPER RESULT FROM SELECTION OF RECORD " &
+                        "COMPONENTS");
+           END IF;
+ 
+           W1 := NEW INTEGER'(0);
+ 
+           IF NOT EQUAL(W1.ALL,0) THEN
+                FAILED ("IMPROPER RESULT FROM ALLOCATION");
+           END IF;
+ 
+           W1 := NULL;
+ 
+           IF W1 /= NULL THEN
+                FAILED ("IMPROPER RESULT FROM NULL LITERAL");
+           END IF;
+ 
+           VAL := W2.ALL;
+ 
+           IF NOT EQUAL(VAL,0) THEN
+                FAILED ("IMPROPER RESULT FROM SELECTED COMPONENT");
+           END IF;
+ 
+           BOOL := V1'CALLABLE;
+ 
+           IF NOT BOOL THEN
+                FAILED ("IMPROPER RESULT FROM 'CALLABLE");
+           END IF;
+ 
+           BOOL := V1'TERMINATED;
+ 
+           IF BOOL THEN
+                FAILED ("IMPROPER RESULT FROM 'TERMINATED");
+           END IF;
+ 
+           V1.ONE(VAL);
+ 
+           IF NOT EQUAL(VAL,10) THEN
+                FAILED ("IMPROPER RESULT RETURNED FROM ENTRY SELECTION");
+           END IF;
+ 
+           IF NOT (FLT(1.0) IN FLT) THEN
+                FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
+           END IF;
+ 
+           VAL := FLT'DIGITS;
+ 
+           IF NOT EQUAL(VAL,5) THEN
+                FAILED ("IMPROPER RESULT FROM 'DIGITS");
+           END IF;
+ 
+           BOOL := FLT'MACHINE_ROUNDS;
+ 
+           BOOL := FLT'MACHINE_OVERFLOWS;
+ 
+           VAL := FLT'MACHINE_RADIX;
+ 
+           VAL := FLT'MACHINE_MANTISSA;
+ 
+           VAL := FLT'MACHINE_EMAX;
+ 
+           VAL := FLT'MACHINE_EMIN;
+ 
+           FVAL := FIX'DELTA;
+ 
+           IF FVAL /= 2.0**(-1) THEN
+                FAILED ("IMPROPER RESULT FROM 'DELTA");
+           END IF;
+ 
+           VAL := FIX'FORE;
+ 
+           VAL := FIX'AFT;
+ 
+      END P;
+ 
+      USE P;
+ 
+ BEGIN
+      RESULT;
+ END C74004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74203a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74203a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74203a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,263 ----
+ -- C74203A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT MEMBERSHIP TESTS, QUALIFICATION, AND EXPLICIT
+ --     CONVERSION ARE AVAILABLE FOR LIMITED AND NON-LIMITED PRIVATE
+ --     TYPES.  INCLUDE TYPES WITH DISCRIMINANTS AND TYPES
+ --     WITH LIMITED COMPONENTS.
+ 
+ -- HISTORY:
+ --     BCB 03/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74203A IS
+ 
+      PACKAGE PP IS
+           TYPE LIM IS LIMITED PRIVATE;
+           PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER);
+ 
+           TYPE A IS PRIVATE;
+           SUBTYPE SUBA IS A;
+           A1 : CONSTANT A;
+ 
+           TYPE B IS LIMITED PRIVATE;
+           B1 : CONSTANT B;
+ 
+           TYPE C IS PRIVATE;
+           C1 : CONSTANT C;
+ 
+           TYPE D IS LIMITED PRIVATE;
+           D1 : CONSTANT D;
+ 
+           TYPE E (DISC1 : INTEGER := 5) IS PRIVATE;
+           SUBTYPE SUBE IS E;
+           E1 : CONSTANT E;
+ 
+           TYPE F (DISC2 : INTEGER := 15) IS LIMITED PRIVATE;
+           F1 : CONSTANT F;
+ 
+           TYPE G (DISC3 : INTEGER) IS PRIVATE;
+           G1 : CONSTANT G;
+ 
+           TYPE H (DISC4 : INTEGER) IS LIMITED PRIVATE;
+           H1 : CONSTANT H;
+ 
+           TYPE I IS RECORD
+                COMPI : LIM;
+           END RECORD;
+           SUBTYPE SUBI IS I;
+ 
+           TYPE J IS ARRAY(1..5) OF LIM;
+           SUBTYPE SUBJ IS J;
+ 
+           TYPE S1 IS (VINCE, TOM, PHIL, JODIE, ROSA, TERESA);
+           TYPE S2 IS (THIS, THAT, THESE, THOSE, THEM);
+           TYPE S3 IS RANGE 1 .. 100;
+           TYPE S4 IS RANGE 1 .. 100;
+      PRIVATE
+           TYPE LIM IS RANGE 1 .. 100;
+ 
+           TYPE A IS (RED, BLUE, GREEN, YELLOW, BLACK, WHITE);
+           A1 : CONSTANT A := BLUE;
+ 
+           TYPE B IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
+           B1 : CONSTANT B := THREE;
+ 
+           TYPE C IS RANGE 1 .. 100;
+           C1 : CONSTANT C := 50;
+ 
+           TYPE D IS RANGE 1 .. 100;
+           D1 : CONSTANT D := 50;
+ 
+           TYPE E (DISC1 : INTEGER := 5) IS RECORD
+                COMPE : S1;
+           END RECORD;
+           E1 : CONSTANT E := (DISC1 => 5, COMPE => TOM);
+ 
+           TYPE F (DISC2 : INTEGER := 15) IS RECORD
+                COMPF : S2;
+           END RECORD;
+           F1 : CONSTANT F := (DISC2 => 15, COMPF => THAT);
+ 
+           TYPE G (DISC3 : INTEGER) IS RECORD
+                COMPG : S3;
+           END RECORD;
+           G1 : CONSTANT G := (DISC3 => 25, COMPG => 50);
+ 
+           TYPE H (DISC4 : INTEGER) IS RECORD
+                COMPH : S4;
+           END RECORD;
+           H1 : CONSTANT H := (DISC4 => 30, COMPH => 50);
+      END PP;
+ 
+      USE PP;
+ 
+      AVAR : SUBA := A1;
+      EVAR : SUBE := E1;
+ 
+      IVAR : SUBI;
+      JVAR : SUBJ;
+ 
+      PACKAGE BODY PP IS
+           PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER) IS
+           BEGIN
+                Z1 := LIM (Z2);
+           END INIT;
+      BEGIN
+           NULL;
+      END PP;
+ 
+      PROCEDURE QUAL_PRIV (W : A) IS
+      BEGIN
+           NULL;
+      END QUAL_PRIV;
+ 
+      PROCEDURE QUAL_LIM_PRIV (X : B) IS
+      BEGIN
+           NULL;
+      END QUAL_LIM_PRIV;
+ 
+      PROCEDURE EXPL_CONV_PRIV_1 (Y : C) IS
+      BEGIN
+           NULL;
+      END EXPL_CONV_PRIV_1;
+ 
+      PROCEDURE EXPL_CONV_LIM_PRIV_1 (Z : D) IS
+      BEGIN
+           NULL;
+      END EXPL_CONV_LIM_PRIV_1;
+ 
+      PROCEDURE EXPL_CONV_PRIV_2 (Y2 : G) IS
+      BEGIN
+           NULL;
+      END EXPL_CONV_PRIV_2;
+ 
+      PROCEDURE EXPL_CONV_LIM_PRIV_2 (Z2 : H) IS
+      BEGIN
+           NULL;
+      END EXPL_CONV_LIM_PRIV_2;
+ 
+      PROCEDURE EXPL_CONV_PRIV_3 (Y3 : I) IS
+      BEGIN
+           NULL;
+      END EXPL_CONV_PRIV_3;
+ 
+      PROCEDURE EXPL_CONV_PRIV_4 (Y4 : J) IS
+      BEGIN
+           NULL;
+      END EXPL_CONV_PRIV_4;
+ 
+ BEGIN
+      TEST ("C74203A", "CHECK THAT MEMBERSHIP TESTS, QUALIFICATION, " &
+                       "AND EXPLICIT CONVERSION ARE AVAILABLE FOR " &
+                       "LIMITED AND NON-LIMITED PRIVATE TYPES.  " &
+                       "INCLUDE TYPES WITH DISCRIMINANTS AND " &
+                       "TYPES WITH LIMITED COMPONENTS");
+ 
+      INIT (IVAR.COMPI, 50);
+ 
+      FOR K IN IDENT_INT (1) .. IDENT_INT (5) LOOP
+           INIT (JVAR(K), 25);
+      END LOOP;
+ 
+      IF NOT (AVAR IN A) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                   "PRIVATE TYPE - 1");
+      END IF;
+ 
+      IF (AVAR NOT IN A) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                   "PRIVATE TYPE - 1");
+      END IF;
+ 
+      IF NOT (B1 IN B) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                   "LIMITED PRIVATE TYPE - 1");
+      END IF;
+ 
+      IF (B1 NOT IN B) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                   "LIMITED PRIVATE TYPE - 1");
+      END IF;
+ 
+      QUAL_PRIV (A'(AVAR));
+ 
+      QUAL_LIM_PRIV (B'(B1));
+ 
+      EXPL_CONV_PRIV_1 (C(C1));
+ 
+      EXPL_CONV_LIM_PRIV_1 (D(D1));
+ 
+      IF NOT (EVAR IN E) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                   "PRIVATE TYPE - 2");
+      END IF;
+ 
+      IF (EVAR NOT IN E) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                   "PRIVATE TYPE - 2");
+      END IF;
+ 
+      IF NOT (F1 IN F) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                   "LIMITED PRIVATE TYPE - 2");
+      END IF;
+ 
+      IF (F1 NOT IN F) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                   "LIMITED PRIVATE TYPE - 2");
+      END IF;
+ 
+      EXPL_CONV_PRIV_2 (G(G1));
+ 
+      EXPL_CONV_LIM_PRIV_2 (H(H1));
+ 
+      IF NOT (IVAR IN I) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                   "PRIVATE TYPE - 3");
+      END IF;
+ 
+      IF (IVAR NOT IN I) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                   "PRIVATE TYPE - 3");
+      END IF;
+ 
+      EXPL_CONV_PRIV_3 (I(IVAR));
+ 
+      IF NOT (JVAR IN J) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                   "PRIVATE TYPE - 4");
+      END IF;
+ 
+      IF (JVAR NOT IN J) THEN
+           FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                   "PRIVATE TYPE - 4");
+      END IF;
+ 
+      EXPL_CONV_PRIV_4 (J(JVAR));
+ 
+      RESULT;
+ END C74203A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74206a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74206a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74206a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74206a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,144 ----
+ -- C74206A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A COMPOSITE TYPE IS DECLARED IN THE PACKAGE AS A
+ -- PRIVATE TYPE AND CONTAINS A COMPONENT OF THE PRIVATE TYPE, OPERATIONS
+ -- OF THE COMPOSITE TYPE WHICH DO NOT DEPEND ON CHARACTERISTICS OF THE
+ -- PRIVATE TYPE ARE AVAILABLE AFTER THE FULL DECLARATION OF THE PRIVATE
+ -- TYPE, BUT BEFORE THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
+ -- DECLARATION OF THE COMPOSITE TYPE THAT IS AFTER THE FULL DECLARATION
+ -- OF THE PRIVATE TYPE.  IN PARTICULAR, CHECK FOR THE FOLLOWING :
+ 
+ --   'FIRST, 'LAST, 'RANGE, AND 'LENGTH FOR ARRAY TYPES
+ --   SELECTED COMPONENTS FOR DISCRIMINANTS AND COMPONENTS OF RECORDS
+ --   INDEXED COMPONENTS AND SLICES FOR ARRAYS
+ 
+ -- DSJ 5/5/83
+ -- JBG 3/8/84
+ 
+ WITH REPORT; 
+ PROCEDURE C74206A IS
+ 
+      USE REPORT; 
+ 
+ BEGIN
+ 
+      TEST("C74206A", "CHECK THAT ADDITIONAL OPERATIONS FOR "
+                    & "COMPOSITE TYPES OF PRIVATE TYPES ARE "
+                    & "AVAILABLE AT THE EARLIEST PLACE AFTER THE "
+                    & "FULL DECLARATION OF THE PRIVATE TYPE EVEN "
+                    & "IF BEFORE THE EARLIEST PLACE WITHIN THE "
+                    & "IMMEDIATE SCOPE OF THE COMPOSITE TYPE"); 
+ 
+      DECLARE
+ 
+           PACKAGE PACK1 IS
+                TYPE P1  IS PRIVATE; 
+                TYPE LP1 IS LIMITED PRIVATE; 
+ 
+                PACKAGE PACK_LP IS
+                     TYPE LP_ARR IS ARRAY (1 .. 2) OF LP1; 
+                     TYPE LP_REC (D : INTEGER) IS
+                          RECORD
+                               C1, C2 : LP1; 
+                          END RECORD; 
+                END PACK_LP; 
+ 
+                PACKAGE PACK2 IS
+                     TYPE ARR IS ARRAY ( 1 .. 2 ) OF P1; 
+                     TYPE REC (D : INTEGER) IS
+                          RECORD
+                               C1, C2 : P1; 
+                          END RECORD; 
+                END PACK2; 
+           PRIVATE
+                TYPE P1  IS NEW BOOLEAN; 
+                TYPE LP1 IS NEW BOOLEAN; 
+           END PACK1; 
+ 
+           PACKAGE BODY PACK1 IS
+ 
+                USE PACK_LP; 
+                USE PACK2; 
+ 
+                A1 : ARR; 
+                L1 : LP_ARR; 
+ 
+                N1 : INTEGER := ARR'FIRST;           -- LEGAL
+                N2 : INTEGER := ARR'LAST;            -- LEGAL
+                N3 : INTEGER := A1'LENGTH;           -- LEGAL
+                N4 : INTEGER := LP_ARR'FIRST;        -- LEGAL
+                N5 : INTEGER := LP_ARR'LAST;         -- LEGAL
+                N6 : INTEGER := L1'LENGTH;           -- LEGAL
+                B1 : BOOLEAN := 1 IN ARR'RANGE;      -- LEGAL
+                B2 : BOOLEAN := 5 IN LP_ARR'RANGE;   -- LEGAL
+ 
+                N7 : INTEGER := A1(1)'SIZE;          -- LEGAL: A1(1)
+                N8 : INTEGER := L1(2)'SIZE;          -- LEGAL: L1(2)
+ 
+                R1 : REC(1); 
+                Q1 : LP_REC(1); 
+ 
+                K1 : INTEGER := R1.D'SIZE;           -- LEGAL: R1.D
+                K2 : INTEGER := R1.C1'SIZE;          -- LEGAL: R1.C1
+                K3 : INTEGER := Q1.D'SIZE;           -- LEGAL: Q1.D
+                K4 : INTEGER := Q1.C2'SIZE;          -- LEGAL: Q1.C2
+ 
+           BEGIN
+ 
+                IF N1 /= 1 OR N4 /= 1 THEN
+                     FAILED ("WRONG VALUE FOR 'FIRST"); 
+                END IF; 
+ 
+                IF N2 /= 2 OR N5 /= 2 THEN
+                     FAILED ("WRONG VALUE FOR 'LAST"); 
+                END IF; 
+ 
+                IF N3 /= 2 OR N6 /= 2 THEN
+                     FAILED ("WRONG VALUE FOR 'LENGTH"); 
+                END IF; 
+ 
+                IF B1 /= TRUE OR B2 /= FALSE THEN
+                     FAILED ("INCORRECT RANGE TEST"); 
+                END IF; 
+ 
+                IF N7 /= N8 THEN
+                     FAILED ("INCORRECT INDEXED COMPONENTS"); 
+                END IF; 
+ 
+                IF K1 /= K3 OR K2 /= K4 THEN
+                     FAILED ("INCORRECT COMPONENT SELECTION"); 
+                END IF; 
+ 
+           END PACK1; 
+ 
+      BEGIN
+ 
+           NULL; 
+ 
+      END; 
+ 
+      RESULT; 
+ 
+ END C74206A; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74207b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74207b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74207b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C74207B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'CONSTRAINED CAN BE APPLIED AFTER THE FULL DECLARATION OF
+ -- A PRIVATE TYPE THAT IS DERIVED FROM A PRIVATE TYPE.
+ 
+ -- BHS 6/18/84
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE C74207B IS
+ BEGIN
+      TEST ("C74207B", "AFTER THE FULL DECLARATION OF A PRIVATE " &
+                       "TYPE DERIVED FROM A PRIVATE TYPE, " &
+                       "'CONSTRAINED MAY BE APPLIED");
+ 
+      DECLARE
+           PACKAGE P1 IS
+                TYPE PREC (D : INTEGER) IS PRIVATE;
+                TYPE P IS PRIVATE;
+           PRIVATE
+                TYPE PREC (D : INTEGER) IS RECORD
+                          NULL; 
+                     END RECORD;
+                TYPE P IS NEW INTEGER;
+           END P1;
+ 
+           PACKAGE P2 IS
+                TYPE LP1 IS LIMITED PRIVATE;
+                TYPE LP2 IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE LP1 IS NEW P1.PREC(3);
+                TYPE LP2 IS NEW P1.P;
+                B1 : BOOLEAN := LP1'CONSTRAINED;
+                B2 : BOOLEAN := LP2'CONSTRAINED;
+           END P2;
+ 
+           PACKAGE BODY P2 IS
+           BEGIN
+                IF NOT IDENT_BOOL(B1) THEN
+                     FAILED ("WRONG VALUE FOR LP1'CONSTRAINED");
+                END IF;
+                IF NOT IDENT_BOOL(B2) THEN
+                     FAILED ("WRONG VALUE FOR LP2'CONSTRAINED");
+                END IF;
+           END P2;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END C74207B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74208a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74208a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74208a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74208a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C74208A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'SIZE AND 'ADDRESS FOR OBJECTS OF LIMITED AND
+ --     NON-LIMITED TYPES ARE AVAILABLE BOTH INSIDE AND OUTSIDE THE
+ --     PACKAGE DECLARING THE TYPES.
+ 
+ -- HISTORY:
+ --     BCB 03/14/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ 
+ PROCEDURE C74208A IS
+ 
+      PACKAGE P IS
+           TYPE T IS PRIVATE;
+           TYPE U IS LIMITED PRIVATE;
+      PRIVATE
+           TYPE T IS RANGE 1 .. 100;
+           TYPE U IS RANGE 1 .. 100;
+      END P;
+ 
+      A : P.T;
+      B : P.U;
+      ASIZE, BSIZE : INTEGER;
+      AADDRESS, BADDRESS : ADDRESS;
+ 
+      FUNCTION IDENT_ADR(X : ADDRESS) RETURN ADDRESS IS
+           Y : P.T;
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN X;
+           END IF;
+           RETURN Y'ADDRESS;
+      END IDENT_ADR;
+ 
+      PACKAGE BODY P IS
+           X : T;
+           Y : U;
+           XSIZE, YSIZE : INTEGER;
+           XADDRESS, YADDRESS : ADDRESS;
+      BEGIN
+           TEST ("C74208A", "CHECK THAT 'SIZE AND 'ADDRESS FOR " &
+                            "OBJECTS OF LIMITED AND NON-LIMITED TYPES " &
+                            "ARE AVAILABLE BOTH INSIDE AND OUTSIDE " &
+                            "THE PACKAGE DECLARING THE TYPES");
+ 
+           XSIZE := X'SIZE;
+           YSIZE := Y'SIZE;
+           XADDRESS := X'ADDRESS;
+           YADDRESS := Y'ADDRESS;
+ 
+           IF NOT EQUAL(XSIZE,X'SIZE) THEN
+                FAILED ("IMPROPER VALUE FOR X'SIZE");
+           END IF;
+ 
+           IF XADDRESS /= IDENT_ADR(X'ADDRESS) THEN
+                FAILED ("IMPROPER VALUE FOR X'ADDRESS");
+           END IF;
+ 
+           IF NOT EQUAL(YSIZE,Y'SIZE) THEN
+                FAILED ("IMPROPER VALUE FOR Y'SIZE");
+           END IF;
+ 
+           IF YADDRESS /= IDENT_ADR(Y'ADDRESS) THEN
+                FAILED ("IMPROPER VALUE FOR Y'ADDRESS");
+           END IF;
+      END P;
+ 
+ BEGIN
+      ASIZE := A'SIZE;
+      BSIZE := B'SIZE;
+      AADDRESS := A'ADDRESS;
+      BADDRESS := B'ADDRESS;
+ 
+      IF NOT EQUAL(ASIZE,A'SIZE) THEN
+           FAILED ("IMPROPER VALUE FOR A'SIZE");
+      END IF;
+ 
+      IF AADDRESS /= IDENT_ADR(A'ADDRESS) THEN
+           FAILED ("IMPROPER VALUE FOR A'ADDRESS");
+      END IF;
+ 
+      IF NOT EQUAL(BSIZE,B'SIZE) THEN
+           FAILED ("IMPROPER VALUE FOR B'SIZE");
+      END IF;
+ 
+      IF BADDRESS /= IDENT_ADR(B'ADDRESS) THEN
+           FAILED ("IMPROPER VALUE FOR B'ADDRESS");
+      END IF;
+ 
+      RESULT;
+ END C74208A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74208b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74208b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74208b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74208b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- C74208B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT 'CONSTRAINED FOR OBJECTS OF A PRIVATE TYPE WITH
+ --     VISIBLE DISCRIMINANTS IS AVAILABLE OUTSIDE THE PACKAGE DECLARING
+ --     THE TYPE AND IS AVAILABLE BEFORE AND AFTER THE FULL DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 07/14/88  CREATED ORIGINAL TEST.
+ --     GJD 11/15/95  MOVED REC2_VAR OUT OF P DUE TO ADA 95 FREEZING RULES.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74208B IS
+ 
+      PACKAGE P IS
+           TYPE REC (D : INTEGER := 0) IS PRIVATE;
+           R1 : CONSTANT REC;
+           TYPE REC2 IS RECORD
+                COMP : BOOLEAN := R1'CONSTRAINED;
+           END RECORD;
+      PRIVATE
+           TYPE REC (D : INTEGER := 0) IS RECORD
+                NULL;
+           END RECORD;
+           R1 : CONSTANT REC := (D => 5);
+           R2 : REC := (D => 0);
+           R2A : REC(3);
+           R2CON : CONSTANT REC := (D => 3);
+           C : BOOLEAN := R2'CONSTRAINED;
+           D : BOOLEAN := R2A'CONSTRAINED;
+           E : BOOLEAN := R2CON'CONSTRAINED;
+      END P;
+ 
+      REC2_VAR : P.REC2;
+      
+      R3 : P.REC(0);
+      R3A : P.REC;
+ 
+      A : BOOLEAN := R3'CONSTRAINED;
+      B : BOOLEAN := R3A'CONSTRAINED;
+ 
+      PACKAGE BODY P IS
+      BEGIN
+           TEST ("C74208B", "CHECK THAT 'CONSTRAINED FOR OBJECTS OF A " &
+                            "PRIVATE TYPE WITH VISIBLE DISCRIMINANTS " &
+                            "IS AVAILABLE OUTSIDE THE PACKAGE " &
+                            "DECLARING THE TYPE AND IS AVAILABLE " &
+                            "BEFORE AND AFTER THE FULL DECLARATION");
+ 
+           IF NOT REC2_VAR.COMP THEN
+                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED BEFORE THE " &
+                        "FULL DECLARATION OF THE PRIVATE TYPE");
+           END IF;
+ 
+           IF C THEN
+                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
+                        "FULL DECLARATION OF THE PRIVATE TYPE - 1");
+           END IF;
+ 
+           IF NOT D THEN
+                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
+                        "FULL DECLARATION OF THE PRIVATE TYPE - 2");
+           END IF;
+ 
+           IF NOT E THEN
+                FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
+                        "FULL DECLARATION OF THE PRIVATE TYPE - 3");
+           END IF;
+      END P;
+ 
+ BEGIN
+      IF NOT A THEN
+           FAILED ("IMPROPER VALUE FOR 'CONSTRAINED OUTSIDE THE " &
+                   "PACKAGE DECLARING THE PRIVATE TYPE - 1");
+      END IF;
+ 
+      IF B THEN
+           FAILED ("IMPROPER VALUE FOR 'CONSTRAINED OUTSIDE THE " &
+                   "PACKAGE DECLARING THE PRIVATE TYPE - 2");
+      END IF;
+ 
+      RESULT;
+ END C74208B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74209a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74209a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74209a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74209a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,224 ----
+ -- C74209A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OUTSIDE A PACKAGE WHICH DEFINES PRIVATE TYPES AND LIMITED
+ --    PRIVATE TYPES  IT IS POSSIBLE TO DECLARE SUBPROGRAMS WHICH USE
+ --    THOSE TYPES AS TYPES FOR PARAMETERS (OF ANY MODE EXCEPT OUT FOR A
+ --    LIMITED TYPE) OR AS THE TYPE FOR THE RESULT (FOR FUNCTION
+ --    SUBPROGRAMS). 
+ 
+ -- RM 07/14/81
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C74209A  IS
+ 
+      USE  REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C74209A" , "CHECK THAT PROCEDURE SIGNATURES CAN USE " &
+                        "PRIVATE TYPES" );
+ 
+      DECLARE
+ 
+           PACKAGE  PACK  IS
+ 
+                TYPE  LIM_PRIV  IS LIMITED PRIVATE;
+                TYPE  PRIV      IS         PRIVATE;
+                PRIV_CONST_IN   :  CONSTANT  PRIV;
+                PRIV_CONST_OUT  :  CONSTANT  PRIV;
+                FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV;
+                FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN ;
+                PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV );
+ 
+           PRIVATE
+ 
+                TYPE  LIM_PRIV  IS NEW INTEGER;
+                TYPE  PRIV      IS NEW STRING( 1..5 );
+                PRIV_CONST_IN   :  CONSTANT  PRIV :=  "ABCDE";
+                PRIV_CONST_OUT  :  CONSTANT  PRIV :=  "FGHIJ";
+ 
+           END  PACK;
+ 
+ 
+           PRIV_VAR_1 ,     PRIV_VAR_2      :  PACK.PRIV;
+           LIM_PRIV_VAR_1 , LIM_PRIV_VAR_2  :  PACK.LIM_PRIV;
+ 
+ 
+           USE  PACK;
+ 
+ 
+           PACKAGE BODY  PACK  IS
+ 
+                FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV  IS
+                BEGIN
+                     RETURN  LIM_PRIV(X);
+                END  PACKAGED;
+ 
+                FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN  IS
+                BEGIN
+                     RETURN  X = Y ;
+                END  EQUALS;
+ 
+                PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV) IS
+                BEGIN
+                     Y := X;
+                END  ASSIGN;
+ 
+           END  PACK;
+ 
+ 
+           PROCEDURE  PROC1( X : IN OUT PACK.PRIV;
+                             Y : IN     PACK.PRIV := PACK.PRIV_CONST_IN;
+                             Z : OUT    PACK.PRIV;
+                             U :        PACK.PRIV )  IS
+           BEGIN
+ 
+                IF  X /= PACK.PRIV_CONST_IN  OR
+                    Y /= PACK.PRIV_CONST_IN  OR
+                    U /= PACK.PRIV_CONST_IN
+                THEN
+                     FAILED( "WRONG INPUT VALUES  -  PROC1" );
+                END IF;
+ 
+                X := PACK.PRIV_CONST_OUT;
+                Z := PACK.PRIV_CONST_OUT;
+ 
+           END  PROC1;
+ 
+ 
+           PROCEDURE  PROC2( X : IN OUT LIM_PRIV;
+                             Y : IN     LIM_PRIV;
+                             Z : IN OUT LIM_PRIV;
+                             U :        LIM_PRIV )  IS
+           BEGIN
+ 
+                IF  NOT(EQUALS( X , PACKAGED(17) ))  OR
+                    NOT(EQUALS( Y , PACKAGED(17) ))  OR
+                    NOT(EQUALS( U , PACKAGED(17) ))
+                THEN
+                     FAILED( "WRONG INPUT VALUES  -  PROC2" );
+                END IF;
+ 
+                ASSIGN( PACKAGED(13) , X );
+                ASSIGN( PACKAGED(13) , Z );
+ 
+           END  PROC2;
+ 
+ 
+           FUNCTION  FUNC1( Y : IN  PRIV  :=  PRIV_CONST_IN;
+                            U :     PRIV  )   RETURN  PRIV  IS
+           BEGIN
+ 
+                IF  Y /= PRIV_CONST_IN  OR
+                    U /= PRIV_CONST_IN
+                THEN
+                     FAILED( "WRONG INPUT VALUES  -  FUNC1" );
+                END IF;
+ 
+                RETURN  PRIV_CONST_OUT;
+ 
+           END  FUNC1;
+ 
+ 
+           FUNCTION  FUNC2( Y : IN  LIM_PRIV;
+                            U :     LIM_PRIV )  RETURN  LIM_PRIV  IS
+           BEGIN
+ 
+                IF  NOT(EQUALS( Y , PACKAGED(17) ))  OR
+                    NOT(EQUALS( U , PACKAGED(17) ))
+                THEN
+                     FAILED( "WRONG INPUT VALUES  -  FUNC2" );
+                END IF;
+ 
+                RETURN  PACKAGED(13);
+ 
+           END  FUNC2;
+ 
+ 
+      BEGIN
+ 
+           --------------------------------------------------------------
+ 
+           PRIV_VAR_1 := PRIV_CONST_IN;
+           PRIV_VAR_2 := PRIV_CONST_IN;
+ 
+           PROC1( PRIV_VAR_1 , Z => PRIV_VAR_2 , U => PRIV_CONST_IN );
+ 
+           IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT  OR
+               PRIV_VAR_2 /= PACK.PRIV_CONST_OUT
+           THEN
+                FAILED( "WRONG OUTPUT VALUES  -  PROC1" );
+           END IF;
+ 
+           --------------------------------------------------------------
+ 
+           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
+           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
+ 
+           PROC2( LIM_PRIV_VAR_1 , PACKAGED(17) ,
+                  LIM_PRIV_VAR_2 , PACKAGED(17) );
+ 
+           IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))  OR
+               NOT(EQUALS( LIM_PRIV_VAR_2 , PACKAGED(13) ))
+           THEN
+                FAILED( "WRONG OUTPUT VALUES  -  PROC2" );
+           END IF;
+ 
+           --------------------------------------------------------------
+ 
+           PRIV_VAR_1 := PRIV_CONST_IN;
+           PRIV_VAR_2 := PRIV_CONST_IN;
+ 
+           PRIV_VAR_1 :=
+               FUNC1( PRIV_VAR_1 , U => PRIV_CONST_IN );
+ 
+           IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT  
+           THEN
+                FAILED( "WRONG OUTPUT VALUES  -  FUNC1" );
+           END IF;
+ 
+           --------------------------------------------------------------
+ 
+           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
+           ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
+ 
+           ASSIGN( FUNC2( LIM_PRIV_VAR_1 , PACKAGED(17)) ,
+                   LIM_PRIV_VAR_1 );
+ 
+           IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))
+           THEN
+                FAILED( "WRONG OUTPUT VALUES  -  FUNC2" );
+           END IF;
+ 
+           --------------------------------------------------------------
+ 
+      END;
+ 
+ 
+      RESULT;
+ 
+ 
+ END C74209A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74210a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74210a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74210a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74210a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C74210A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OPERATOR SYMBOLS OVERLOADED IN A PACKAGE ARE
+ --   USED AND DERIVED IN PREFERENCE TO THOSE OF THE PARENT OF A DERIVED
+ --   PRIVATE TYPE. 
+ 
+ -- CHECK THAT OPERATOR DEFINITIONS FOR A PRIVATE TYPE MAY BE
+ --   OVERLOADED OUTSIDE THE PACKAGE.
+ 
+ -- CHECK THAT EQUALITY CAN BE DEFINED FOR LIMITED TYPES AND COMPOSITE
+ --   TYPES WITH LIMITED COMPONENTS. 
+ 
+ -- DAT 5/11/81
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74210A IS
+ BEGIN
+      TEST ("C74210A", "OVERLOADED OPERATORS FOR PRIVATE TYPES");
+ 
+      DECLARE
+           PACKAGE P IS
+                TYPE T IS PRIVATE;
+                FUNCTION "+" (X, Y : T) RETURN T;
+                ONE, TWO : CONSTANT T;
+ 
+                TYPE L IS LIMITED PRIVATE;
+                TYPE A IS ARRAY (0 .. 0) OF L;
+                TYPE R IS RECORD
+                     C : L;
+                END RECORD;
+                FUNCTION "=" (X, Y : L) RETURN BOOLEAN;
+           PRIVATE
+                TYPE T IS NEW INTEGER;
+                ONE : CONSTANT T := T(IDENT_INT(1));
+                TWO : CONSTANT T := T(IDENT_INT(2));
+                TYPE L IS (ENUM);
+           END P;
+           USE P;
+ 
+           VR : R;
+           VA : A;
+ 
+           PACKAGE BODY P IS
+                FUNCTION "+" (X, Y : T) RETURN T IS
+                BEGIN
+                     RETURN 1;
+                END "+";
+ 
+                FUNCTION "=" (X, Y : L) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN IDENT_BOOL(FALSE);
+                END "=";
+           BEGIN
+                VR := (C => ENUM);
+                VA := (0 => VR.C);
+           END P;
+      BEGIN
+           IF ONE + TWO /= ONE THEN
+                FAILED ("WRONG ""+"" OPERATOR");
+           END IF;
+ 
+           DECLARE
+                TYPE NEW_T IS NEW T;
+ 
+                FUNCTION "=" (X, Y : A) RETURN BOOLEAN;
+                FUNCTION "=" (X, Y : R) RETURN BOOLEAN;
+ 
+                FUNCTION "+" (X, Y : T) RETURN T IS
+                BEGIN
+                     RETURN TWO;
+                END "+";
+ 
+                FUNCTION "=" (X, Y : A) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN X(0) = Y(0);
+                END "=";
+ 
+                FUNCTION "=" (X, Y : R) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN X.C = Y.C;
+                END "=";
+           BEGIN
+                IF ONE + TWO /= TWO THEN
+                     FAILED ("WRONG DERIVED ""+"" OPERATOR");
+                END IF;
+ 
+                IF VR = VR OR VA = VA THEN
+                     FAILED ("CANNOT OVERLOAD ""="" CORRECTLY");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END C74210A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74211a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74211a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74211a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74211a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C74211A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WITHIN THE PACKAGE SPECIFICATION AND BODY, ANY EXPLICIT
+ -- DECLARATIONS OF OPERATORS AND SUBPROGRAMS HIDE ANY OPERATIONS WHICH
+ -- ARE IMPLICITLY DECLARED AT THE POINT OF THE FULL DECLARATION,
+ -- REGARDLESS OF THE ORDER OF OCCURENCE OF THE DECLARATIONS.
+ 
+ -- CHECK THAT IMPLICITLY DECLARED DERIVED SUBPROGRAMS HIDE IMPLICITLY
+ -- DECLARED PREDEFINED OPERATORS, REGARDLESS OF THE ORDER OF OCCURENCE
+ -- OF THE DECLARATIONS.
+ 
+ -- DSJ 4/28/83
+ -- JBG 9/23/83
+ 
+ --   A) EXPLICIT DECLARATION HIDES LATER IMPLICIT DECL OF PREDEFINED OP.
+ --   B)     "        "         "   LATER     "      "  "  DERIVED OP.
+ --   C)     "        "         "   EARLIER   "      "  "  PREDEFINED OP.
+ --   D)     "        "         "   EARLIER   "      "  "  DERIVED OP.
+ 
+ WITH REPORT;
+ PROCEDURE C74211A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST ("C74211A", "CHECK THAT HIDING OF IMPLICITLY DECLARED " &
+                       "OPERATORS AND DERIVED SUBPROGRAMS IS DONE " &
+                       "CORRECTLY REGARDLESS OF ORDER OF DECL'S");
+ 
+      DECLARE
+ 
+           PACKAGE P1 IS 
+                TYPE T1 IS RANGE 1 .. 50;
+                C1 : CONSTANT T1 := T1(IDENT_INT(2));
+                D1 : CONSTANT T1 := C1 + C1;        -- PREDEFINED "+"
+                FUNCTION "+" (L, R : T1) RETURN T1; -- C) FOR "+".
+                FUNCTION "-" (L, R : T1) RETURN T1; -- C) FOR "-".
+                FUNCTION "/" (L, R : T1) RETURN T1; 
+           END P1;
+ 
+           USE P1;
+ 
+           PACKAGE BODY P1 IS
+                A,B : T1 := 3;
+ 
+                FUNCTION "+" (L, R : T1) RETURN T1 IS
+                BEGIN
+                     IF L = R THEN
+                          RETURN 1;
+                     ELSE RETURN 2;
+                     END IF;
+                END "+";
+ 
+                FUNCTION "-" (L, R : T1) RETURN T1 IS
+                BEGIN
+                     IF L = R THEN
+                          RETURN 3;
+                     ELSE RETURN 4;
+                     END IF;
+                END "-";
+ 
+                FUNCTION "/" (L, R : T1) RETURN T1 IS
+                BEGIN
+                     IF L = R THEN
+                          RETURN T1(IDENT_INT(INTEGER(L)));
+                     ELSE
+                          RETURN T1(IDENT_INT(50));
+                     END IF;
+                END "/";
+ 
+           BEGIN
+                IF D1 /= 4 THEN
+                     FAILED ("WRONG PREDEFINED OPERATION - '+' ");
+                END IF;
+ 
+                IF D1 + C1 /= 2 THEN
+                     FAILED ("IMPLICIT '+' NOT HIDDEN BY EXPLICIT '+'");
+                END IF;
+ 
+                IF A + B /= 1 THEN
+                     FAILED ("IMPLICIT DECLARATION NOT HIDDEN " &
+                             "BY EXPLICIT DECLARATION - '+' ");
+                END IF;
+ 
+                IF A - B /= 3 THEN
+                     FAILED ("IMPLICIT DECLARATION NOT HIDDEN " &
+                             "BY EXPLICIT DECLARATION - '-' ");
+                END IF;
+ 
+                IF A * B /= 9 THEN
+                     FAILED ("WRONG PREDEFINED OPERATION - '*' ");
+                END IF;
+ 
+                IF B / A  /=  T1(IDENT_INT(3)) THEN
+                     FAILED ("NOT REDEFINED '/' ");
+                END IF;
+           END P1;
+ 
+           PACKAGE P2 IS
+                TYPE T2 IS PRIVATE;
+                X , Y : CONSTANT T2;
+                FUNCTION "+" (L, R : T2) RETURN T2;     -- B)
+                FUNCTION "*" (L, R : T2) RETURN T2;     -- A)
+           PRIVATE
+                TYPE T2 IS NEW T1;                 -- B) +; A) *
+                Z : T2 := T2(IDENT_INT(3))/4;      -- Z = 50 USING
+                                                   -- DERIVED /
+                FUNCTION "/" (L, R : T2) RETURN T2;  -- D) FOR /
+                X , Y : CONSTANT T2 := 3;
+           END P2;
+ 
+           PACKAGE BODY P2 IS
+                FUNCTION "+" (L, R : T2) RETURN T2 IS
+                BEGIN
+                     IF L = R THEN
+                          RETURN T2(IDENT_INT(5));
+                     ELSE RETURN T2(IDENT_INT(6));
+                     END IF;
+                END "+";
+ 
+                FUNCTION "*" (L, R : T2) RETURN T2 IS
+                BEGIN
+                     IF L = R THEN
+                          RETURN T2(IDENT_INT(7));
+                     ELSE RETURN T2(IDENT_INT(8));
+                     END IF;
+                END "*";
+ 
+                FUNCTION "/" (L, R : T2) RETURN T2 IS
+                BEGIN
+                     IF L = R THEN
+                          RETURN T2(IDENT_INT(9));
+                     ELSE RETURN T2(IDENT_INT(10));
+                     END IF;
+                END "/";
+           BEGIN
+                IF X + Y /= 5 THEN
+                          FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
+                                  "EXPLICIT DECLARATION - '+' ");
+                END IF;
+ 
+                IF Y - X /= 3 THEN
+                          FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                                  "DERIVED SUBPROGRAM - '-' ");
+                END IF;
+ 
+                IF X * Y /= 7 THEN
+                          FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                                  "EXPLICIT DECLARATION - '*' ");
+                END IF;
+ 
+                IF Y / X /= T2(IDENT_INT(9)) THEN
+                          FAILED ("DERIVED OPERATOR NOT HIDDEN BY " &
+                                  "EXPLICIT DECLARATION - '/' ");
+                END IF;
+ 
+                IF Z /= 50 THEN
+                     FAILED ("DERIVED OPERATOR HIDDEN PREMATURELY " &
+                             " BY REDECLARED OPERATOR");
+                END IF;
+ 
+           END P2;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C74211A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74211b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74211b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74211b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74211b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- C74211B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IMPLICITLY DECLARED INEQUALITY WHICH ACCOMPANIES AN
+ -- EXPLICIT DECLARATION OF EQUALITY HIDES OTHER IMPLICITLY DECLARED
+ -- HOMOGRAPHS, AND THAT DERIVED INEQUALITY HIDES PREDEFINED INEQUALITY.
+ 
+ -- DSJ 4/29/83
+ -- JBG 9/23/83
+ 
+ WITH REPORT;
+ PROCEDURE C74211B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C74211B", "CHECK THAT HIDING OF IMPLICITLY DECLARED " &
+                       "OPERATORS AND DERIVED SUBPROGRAMS IS DONE " &
+                       "CORRECTLY REGARDLESS OF ORDER OF DECL'S");
+ 
+      DECLARE
+ 
+           PACKAGE P1 IS 
+                TYPE LT1 IS LIMITED PRIVATE;
+                FUNCTION "="(L, R : LT1) RETURN BOOLEAN;
+                FUNCTION LT1_VALUE_2 RETURN LT1;
+                FUNCTION LT1_VALUE_4 RETURN LT1;
+                TYPE LT2 IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE LT1 IS RANGE 1 .. 10;
+                TYPE LT2 IS RANGE 1 .. 10;
+           END P1;
+ 
+           USE P1;
+ 
+           PACKAGE P2 IS
+                TYPE LT3 IS LIMITED PRIVATE;
+                TYPE LT4 IS NEW LT1;
+           PRIVATE
+                FUNCTION "=" (L, R : LT3) RETURN BOOLEAN;
+                TYPE LT3 IS NEW LT1;
+           END P2;
+ 
+           USE P2;
+ 
+           PACKAGE BODY P1 IS
+                A , B : CONSTANT LT1 := 4;
+                C , D : CONSTANT LT2 := 6;
+ 
+                FUNCTION "=" (L, R : LT1) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN INTEGER(L) /= INTEGER(R);
+                END "=";
+ 
+                FUNCTION LT1_VALUE_2 RETURN LT1 IS
+                BEGIN
+                     RETURN 2;
+                END LT1_VALUE_2;
+ 
+                FUNCTION LT1_VALUE_4 RETURN LT1 IS
+                BEGIN
+                     RETURN 4;
+                END LT1_VALUE_4;
+ 
+           BEGIN
+                IF A = B THEN
+                     FAILED ("PREDEFINED EQUALITY NOT HIDDEN BY " &
+                             "EXPLICIT DECLARATION - LT1");
+                END IF;
+ 
+                IF C /= D  THEN
+                     FAILED ("WRONG PREDEFINED OPERATION - T2");
+                END IF;
+           END P1;
+ 
+           PACKAGE BODY P2 IS
+                FUNCTION U RETURN LT3 IS
+                BEGIN
+                     RETURN LT1_VALUE_2;
+                END U;
+ 
+                FUNCTION V RETURN LT3 IS
+                BEGIN
+                     RETURN LT1_VALUE_4;
+                END V;
+ 
+                FUNCTION W RETURN LT4 IS
+                BEGIN
+                     RETURN LT1_VALUE_2;
+                END W;
+ 
+                FUNCTION X RETURN LT4 IS
+                BEGIN
+                     RETURN LT1_VALUE_4;
+                END X;
+ 
+                FUNCTION "=" (L, R : LT3) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN NOT (LT1(L) = LT1(R));
+                END "=";
+ 
+           BEGIN
+                IF NOT (U /= V) THEN
+                     FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
+                             "IMPLICITLY DECLARED INEQUALITY " &
+                             "FROM EXPLICITLY DECLARED EQUALITY"); 
+                END IF;
+ 
+                IF NOT (LT3(W) = U) THEN
+                     FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
+                             "EXPLICIT DECLARATION - '=' ");
+                END IF;
+ 
+                IF W /= X THEN
+                     FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                             "DERIVED SUBPROGRAM - '/=' ");
+                END IF;
+ 
+                IF NOT ( X = W ) THEN
+                     FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                             "DERIVED SUBPROGRAM - '=' ");
+                END IF;
+ 
+           END P2;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C74211B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74302a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74302a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74302a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C74302A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT MULTIPLE DECLARATIONS MAY BE USED FOR DEFERRED CONSTANT
+ -- DECLARATIONS, EVEN IF THE FULL DECLARATIONS ARE GIVEN INDIVIDUALLY.
+ 
+ -- CHECK THAT MULTIPLE DECLARATIONS MAY BE USED FOR THE FULL
+ -- DECLARATIONS, EVEN IF THE DEFERRED CONSTANT DECLARATIONS ARE GIVEN
+ -- INDIVIDUALLY.
+ 
+ 
+ -- DSJ  5/09/83
+ -- SPS 10/24/83
+ -- EG  12/19/83
+ -- JRK 12/20/83
+ 
+ -- DTN 11/19/91     DELETED SUBPART (C).
+ 
+ WITH REPORT;
+ PROCEDURE C74302A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C74302A", "CHECK THAT MULTIPLE DECLARATIONS MAY BE USED " &
+                      "FOR DEFERRED CONSTANT DECLARATIONS");
+ 
+      DECLARE
+ 
+           PACKAGE PACK1 IS
+ 
+                TYPE T IS PRIVATE;
+ 
+                B, E : CONSTANT T;
+ 
+                F : CONSTANT T;
+           PRIVATE
+ 
+                TYPE T IS NEW INTEGER;
+ 
+                E : CONSTANT T := T(IDENT_INT(4));
+ 
+                B, F : CONSTANT T := T(IDENT_INT(2));
+ 
+           END PACK1;
+ 
+           USE PACK1;
+ 
+      BEGIN
+ 
+           IF B/=F THEN
+                FAILED("VALUES OF DEFERRED CONSTANTS B AND F NOT EQUAL");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C74302A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74302b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74302b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74302b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74302b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,308 ----
+ -- C74302B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WHEN THE FULL DECLARATION OF A DEFERRED CONSTANT IS
+ --     GIVEN AS A MULTIPLE DECLARATION, THE INITIALIZATION EXPRESSION
+ --     IS EVALUATED ONCE FOR EACH DEFERRED CONSTANT.  (USE ENUMERATION,
+ --     INTEGER, FIXED POINT, FLOATING POINT, ARRAY, RECORD (INCLUDING
+ --     USE OF DEFAULT EXPRESSIONS FOR COMPONENTS), ACCESS, AND PRIVATE
+ --     TYPES AS FULL DECLARATION OF PRIVATE TYPE)
+ 
+ -- HISTORY:
+ --     BCB 07/25/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74302B IS
+ 
+      TYPE ARR_RAN IS RANGE 1..2;
+ 
+      BUMP : INTEGER := IDENT_INT(0);
+ 
+      GENERIC
+           TYPE DT IS (<>);
+      FUNCTION F1 RETURN DT;
+ 
+      GENERIC
+           TYPE FE IS DELTA <>;
+      FUNCTION F2 RETURN FE;
+ 
+      GENERIC
+           TYPE FLE IS DIGITS <>;
+      FUNCTION F3 RETURN FLE;
+ 
+      GENERIC
+           TYPE CA IS ARRAY(ARR_RAN) OF INTEGER;
+      FUNCTION F4 RETURN CA;
+ 
+      GENERIC
+           TYPE GP IS LIMITED PRIVATE;
+      FUNCTION F5 (V : GP) RETURN GP;
+ 
+      GENERIC
+           TYPE GP1 IS LIMITED PRIVATE;
+      FUNCTION F6 (V1 : GP1) RETURN GP1;
+ 
+      GENERIC
+           TYPE AC IS ACCESS INTEGER;
+      FUNCTION F7 RETURN AC;
+ 
+      GENERIC
+           TYPE PP IS PRIVATE;
+      FUNCTION F8 (P1 : PP) RETURN PP;
+ 
+      FUNCTION F1 RETURN DT IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN DT'VAL(BUMP);
+      END F1;
+ 
+      FUNCTION F2 RETURN FE IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN FE(BUMP);
+      END F2;
+ 
+      FUNCTION F3 RETURN FLE IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN FLE(BUMP);
+      END F3;
+ 
+      FUNCTION F4 RETURN CA IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN ((BUMP,BUMP-1));
+      END F4;
+ 
+      FUNCTION F5 (V : GP) RETURN GP IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN V;
+      END F5;
+ 
+      FUNCTION F6 (V1 : GP1) RETURN GP1 IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN V1;
+      END F6;
+ 
+      FUNCTION F7 RETURN AC IS
+           VAR : AC;
+      BEGIN
+           BUMP := BUMP + 1;
+           VAR := NEW INTEGER'(BUMP);
+           RETURN VAR;
+      END F7;
+ 
+      FUNCTION F8 (P1 : PP) RETURN PP IS
+      BEGIN
+           BUMP := BUMP + 1;
+           RETURN P1;
+      END F8;
+ 
+      PACKAGE PACK IS
+           TYPE SP IS PRIVATE;
+           CONS : CONSTANT SP;
+      PRIVATE
+           TYPE SP IS RANGE 1 .. 100;
+           CONS : CONSTANT SP := 50;
+      END PACK;
+ 
+      USE PACK;
+ 
+      PACKAGE P IS
+           TYPE INT IS PRIVATE;
+           TYPE ENUM IS PRIVATE;
+           TYPE FIX IS PRIVATE;
+           TYPE FLT IS PRIVATE;
+           TYPE CON_ARR IS PRIVATE;
+           TYPE REC IS PRIVATE;
+           TYPE REC1 IS PRIVATE;
+           TYPE ACC IS PRIVATE;
+           TYPE PRIV IS PRIVATE;
+ 
+           GENERIC
+                TYPE LP IS PRIVATE;
+           FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN;
+ 
+           I1, I2, I3, I4 : CONSTANT INT;
+           E1, E2, E3, E4 : CONSTANT ENUM;
+           FI1, FI2, FI3, FI4 : CONSTANT FIX;
+           FL1, FL2, FL3, FL4 : CONSTANT FLT;
+           CA1, CA2, CA3, CA4 : CONSTANT CON_ARR;
+           R1, R2, R3, R4 : CONSTANT REC;
+           R1A, R2A, R3A, R4A : CONSTANT REC1;
+           A1, A2, A3, A4 : CONSTANT ACC;
+           PR1, PR2, PR3, PR4 : CONSTANT PRIV;
+      PRIVATE
+           TYPE INT IS RANGE 1 .. 100;
+ 
+           TYPE ENUM IS (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);
+ 
+           TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
+ 
+           TYPE FLT IS DIGITS 5 RANGE -100.0 .. 100.0;
+ 
+           TYPE CON_ARR IS ARRAY(ARR_RAN) OF INTEGER;
+ 
+           TYPE REC IS RECORD
+                COMP1 : INTEGER;
+                COMP2 : INTEGER;
+                COMP3 : BOOLEAN;
+           END RECORD;
+ 
+           TYPE REC1 IS RECORD
+                COMP1 : INTEGER := 10;
+                COMP2 : INTEGER := 20;
+                COMP3 : BOOLEAN := FALSE;
+           END RECORD;
+ 
+           TYPE ACC IS ACCESS INTEGER;
+ 
+           TYPE PRIV IS NEW SP;
+ 
+           FUNCTION DDT IS NEW F1 (INT);
+           FUNCTION EDT IS NEW F1 (ENUM);
+           FUNCTION FDT IS NEW F2 (FIX);
+           FUNCTION FLDT IS NEW F3 (FLT);
+           FUNCTION CADT IS NEW F4 (CON_ARR);
+           FUNCTION RDT IS NEW F5 (REC);
+           FUNCTION R1DT IS NEW F6 (REC1);
+           FUNCTION ADT IS NEW F7 (ACC);
+           FUNCTION PDT IS NEW F8 (PRIV);
+ 
+           REC_OBJ : REC := (1,2,TRUE);
+           REC1_OBJ : REC1 := (3,4,FALSE);
+ 
+           I1, I2, I3, I4 : CONSTANT INT := DDT;
+           E1, E2, E3, E4 : CONSTANT ENUM := EDT;
+           FI1, FI2, FI3, FI4 : CONSTANT FIX := FDT;
+           FL1, FL2, FL3, FL4 : CONSTANT FLT := FLDT;
+           CA1, CA2, CA3, CA4 : CONSTANT CON_ARR := CADT;
+           R1, R2, R3, R4 : CONSTANT REC := RDT(REC_OBJ);
+           R1A, R2A, R3A, R4A : CONSTANT REC1 := R1DT(REC1_OBJ);
+           A1, A2, A3, A4 : CONSTANT ACC := ADT;
+           PR1, PR2, PR3, PR4 : CONSTANT PRIV := PDT(PRIV(CONS));
+      END P;
+ 
+      PACKAGE BODY P IS
+           AVAR1 : ACC := NEW INTEGER'(29);
+           AVAR2 : ACC := NEW INTEGER'(30);
+           AVAR3 : ACC := NEW INTEGER'(31);
+           AVAR4 : ACC := NEW INTEGER'(32);
+ 
+           FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN Z1 = Z2;
+           END GEN_EQUAL;
+ 
+           FUNCTION INT_EQUAL IS NEW GEN_EQUAL (INT);
+           FUNCTION ENUM_EQUAL IS NEW GEN_EQUAL (ENUM);
+           FUNCTION FIX_EQUAL IS NEW GEN_EQUAL (FIX);
+           FUNCTION FLT_EQUAL IS NEW GEN_EQUAL (FLT);
+           FUNCTION ARR_EQUAL IS NEW GEN_EQUAL (CON_ARR);
+           FUNCTION REC_EQUAL IS NEW GEN_EQUAL (REC);
+           FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
+           FUNCTION ACC_EQUAL IS NEW GEN_EQUAL (INTEGER);
+           FUNCTION PRIV_EQUAL IS NEW GEN_EQUAL (PRIV);
+      BEGIN
+           TEST ("C74302B", "CHECK THAT WHEN THE FULL DECLARATION OF " &
+                            "A DEFERRED CONSTANT IS GIVEN AS A " &
+                            "MULTIPLE DECLARATION, THE INITIALIZATION " &
+                            "EXPRESSION IS EVALUATED ONCE FOR EACH " &
+                            "DEFERRED CONSTANT");
+ 
+           IF NOT EQUAL(BUMP,36) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED CONSTANTS IN A MULIPLE DECLARATION");
+           END IF;
+ 
+           IF NOT INT_EQUAL(I1,1) OR NOT INT_EQUAL(I2,2) OR
+              NOT INT_EQUAL(I3,3) OR NOT INT_EQUAL(I4,4) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED INTEGER CONSTANTS");
+           END IF;
+ 
+           IF NOT ENUM_EQUAL(E1,SIX) OR NOT ENUM_EQUAL(E2,SEVEN) OR
+              NOT ENUM_EQUAL(E3,EIGHT) OR NOT ENUM_EQUAL(E4,NINE) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED ENUMERATION CONSTANTS");
+           END IF;
+ 
+           IF NOT FIX_EQUAL(FI1,9.0) OR NOT FIX_EQUAL(FI2,10.0) OR
+              NOT FIX_EQUAL(FI3,11.0) OR NOT FIX_EQUAL(FI4,12.0) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED FIXED POINT CONSTANTS");
+           END IF;
+ 
+           IF NOT FLT_EQUAL(FL1,13.0) OR NOT FLT_EQUAL(FL2,14.0) OR
+              NOT FLT_EQUAL(FL3,15.0) OR NOT FLT_EQUAL(FL4,16.0) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED FLOATING POINT CONSTANTS");
+           END IF;
+ 
+           IF NOT ARR_EQUAL(CA1,(17,16)) OR NOT ARR_EQUAL(CA2,(18,17))
+            OR NOT ARR_EQUAL(CA3,(19,18)) OR NOT ARR_EQUAL(CA4,(20,19))
+                THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                             "DEFERRED ARRAY CONSTANTS");
+           END IF;
+ 
+           IF NOT REC_EQUAL(R1,REC_OBJ) OR NOT REC_EQUAL(R2,REC_OBJ)
+              OR NOT REC_EQUAL(R3,REC_OBJ) OR NOT REC_EQUAL(R4,REC_OBJ)
+                THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                             "DEFERRED RECORD CONSTANTS");
+           END IF;
+ 
+           IF NOT REC1_EQUAL(R1A,REC1_OBJ) OR NOT REC1_EQUAL(R2A,
+              REC1_OBJ) OR NOT REC1_EQUAL(R3A,REC1_OBJ) OR NOT
+              REC1_EQUAL(R4A,REC1_OBJ) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED RECORD CONSTANTS WITH DEFAULT " &
+                        "EXPRESSIONS");
+           END IF;
+ 
+           IF NOT ACC_EQUAL(A1.ALL,AVAR1.ALL) OR NOT ACC_EQUAL(A2.ALL,
+              AVAR2.ALL) OR NOT ACC_EQUAL(A3.ALL,AVAR3.ALL) OR NOT
+              ACC_EQUAL(A4.ALL,AVAR4.ALL) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED ACCESS CONSTANTS");
+           END IF;
+ 
+           IF NOT PRIV_EQUAL(PR1,PRIV(CONS)) OR NOT PRIV_EQUAL(PR2,
+              PRIV(CONS)) OR NOT PRIV_EQUAL(PR3,PRIV(CONS)) OR NOT
+              PRIV_EQUAL(PR4,PRIV(CONS)) THEN
+                FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                        "DEFERRED PRIVATE CONSTANTS");
+           END IF;
+ 
+           RESULT;
+      END P;
+ 
+      USE P;
+ 
+ BEGIN
+      NULL;
+ END C74302B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74305a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74305a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74305a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,160 ----
+ -- C74305A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --    CHECK THAT A DEFERRED CONSTANT CAN BE USED AS A DEFAULT
+ --    INITIALIZATION FOR A PARAMETER OR AS A DEFAULT INITIA-
+ --    LIZATION FOR A COMPONENT (NON GENERIC CASE).
+ 
+ -- DAT  4/06/81
+ -- RM   5/21/81
+ -- SPS  8/23/82
+ -- SPS  2/10/83
+ -- SPS 10/20/83
+ -- EG  12/20/83
+ -- GJD 11/15/95  REMOVED ADA 95 INCOMPATIBILITY.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C74305A IS
+ 
+      USE REPORT;
+ 
+      PACKAGE PK IS
+           TYPE T1 IS PRIVATE;
+           TYPE T2 IS PRIVATE; 
+           C1 : CONSTANT T1;                   -- OK.
+ 
+           PROCEDURE P1 (P : T1 := C1);        -- OK.                
+ 
+           TYPE R1 IS RECORD
+                C : T1 := C1;                  -- OK.                
+           END RECORD;
+      PRIVATE
+           PROCEDURE PROC2 (P : T1 := C1);     -- OK.                
+ 
+           TYPE R2 IS RECORD
+                C : T1 := C1;                  -- OK.                
+                D : INTEGER := C1'SIZE;        -- OK.                
+           END RECORD;
+ 
+           FUNCTION F1 (P : T1) RETURN T1;
+ 
+           TYPE T1 IS NEW INTEGER;
+           TYPE T2 IS ARRAY (1..2) OF INTEGER; -- OK.
+ 
+           FUNCTION F2 (P : T1) RETURN T1;
+ 
+           PROCEDURE P3 (P : T1 := C1+1);      -- OK.
+ 
+           PROCEDURE P4 (P : T1 := F1(C1));
+   
+           TYPE R5 IS RECORD
+                C : T1 := F2(C1);
+           END RECORD;
+ 
+           PROCEDURE P5 (P : T1 := C1+2) RENAMES P3;
+ 
+           TYPE R3 IS RECORD
+                C : T1 := C1;                  -- OK.
+           END RECORD;
+ 
+           C1 : CONSTANT T1 := 1;              -- OK.
+           C2 : CONSTANT T2 := (1,1);          -- OK. 
+      END PK;
+ 
+      USE PK;
+ 
+      PACKAGE BODY PK IS
+ 
+           R11 : R1;
+ 
+           PROCEDURE P1 (P : T1 := C1) IS
+           BEGIN
+                IF ( P /= 1 ) THEN
+                     FAILED ("PARAMETER DEFAULT OF P1 NOT PROPERLY " &
+                             "INITIALIZED");
+                END IF;
+           END P1;
+ 
+           PROCEDURE PROC2 (P : T1 := C1) IS
+           BEGIN NULL; END PROC2;
+ 
+           PROCEDURE P3 (P : T1 := C1+1) IS
+           BEGIN
+                IF ( P /= 3 ) THEN
+                     FAILED ("PARAMETER DEFAULT OF P5 NOT PROPERLY " &
+                             "INITIALIZED");
+                END IF;
+           END P3;
+ 
+           FUNCTION F1 (P : T1) RETURN T1 IS
+           BEGIN
+                RETURN P+10;
+           END F1;
+ 
+           PROCEDURE P4 (P : T1 := F1(C1)) IS
+           BEGIN
+                IF ( P /= 11 ) THEN
+                     FAILED ("WRONG ACTUAL PARAMETER RECEIVED");
+                END IF;
+           END P4;
+ 
+           FUNCTION F2 (P : T1) RETURN T1 IS
+           BEGIN
+                RETURN P+20;
+           END F2;
+ 
+      BEGIN -- PK BODY.
+ 
+           DECLARE
+ 
+                R55 : R5;
+ 
+           BEGIN
+                TEST ("C74305A","CHECK THAT A DEFERRED CONSTANT CAN " &
+                                "BE USED AS A DEFAULT INITIALIZATION " &
+                                "FOR A PARAMETER OR AS A DEFAULT " &
+                                "INITIALIZATION FOR A COMPONENT (NON " &
+                                "GENERIC CASE)");
+ 
+                IF ( R11.C /= 1 ) THEN
+                     FAILED ("RECORD R11 NOT PROPERLY INITIALIZED");
+                END IF;
+ 
+                P4;
+ 
+                IF ( R55.C /= 21 ) THEN
+                     FAILED ("RECORD R55 NOT PROPERLY INITIALIZED");
+                END IF;
+ 
+                P5;
+           END;
+      END PK;
+ 
+ BEGIN
+ 
+      P1;
+ 
+      RESULT;
+ END C74305A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74305b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74305b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74305b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74305b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C74305B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --    CHECK THAT A DEFERRED CONSTANT CAN BE USED AS A DEFAULT
+ --    INITIALIZATION FOR A PARAMETER OR AS A DEFAULT INITIA-
+ --    LIZATION FOR A COMPONENT (GENERIC CASE).
+ 
+ -- EG  12/20/83
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C74305B IS
+ 
+      USE REPORT;
+ 
+      PACKAGE PK IS
+           TYPE TD IS PRIVATE;
+           CD : CONSTANT TD;
+           DD : CONSTANT TD;
+ 
+           GENERIC
+                TYPE T1 IS PRIVATE;
+                C1 : T1;
+                WITH PROCEDURE P2 (A1 : T1 := C1; A2 : TD := CD);
+           PROCEDURE P1 (A1 : TD := CD);
+ 
+      PRIVATE
+           TYPE TD IS NEW INTEGER;
+           CD : CONSTANT TD := 2;
+           DD : CONSTANT TD := 3;
+      END PK;
+ 
+      USE PK;
+ 
+      PACKAGE BODY PK IS
+ 
+           PROCEDURE P1 (A1 : TD := CD) IS
+           BEGIN
+               IF ( A1 /= 2 ) THEN
+                    FAILED ("WRONG ACTUAL PARAMETER RECEIVED (1)");
+               END IF;
+               P2;
+           END P1;
+ 
+           PROCEDURE P3 (X : TD := DD; Y : TD := DD) IS
+           BEGIN
+               IF ( X /= 2 ) THEN
+                    FAILED ("WRONG ACTUAL PARAMETER RECEIVED (2)");
+               END IF;
+               IF ( Y /= 2 ) THEN
+                    FAILED ("WRONG ACTUAL PARAMETER RECEIVED (3)");
+               END IF;
+           END P3;
+ 
+           PROCEDURE P4 IS NEW P1 (TD,CD,P3);
+ 
+      BEGIN
+           TEST ("C74305B","CHECK THAT A DEFERRED CONSTANT CAN BE "    &
+                           "USED AS A DEFAULT INITIALIZATION FOR A "   &
+                           "PARAMETER OR AS A DEFAULT INITIALIZATION " &
+                           "FOR A COMPONENT (GENERIC CASE)");
+           P4;
+      END PK;
+ 
+      PROCEDURE P5 (X : TD := DD; Y : TD := DD) IS
+      BEGIN
+           IF ( X /= CD ) THEN
+                FAILED ("WRONG ACTUAL PARAMETER RECEIVED (4)");
+           END IF;
+           IF ( Y /= CD ) THEN
+                FAILED ("WRONG ACTUAL PARAMETER RECEIVED (5)");
+           END IF;
+      END P5;
+ 
+      PROCEDURE P6 IS NEW P1 (TD,CD,P5);
+ 
+ BEGIN
+      P6;
+      RESULT;
+ END C74305B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74306a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74306a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74306a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74306a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,279 ----
+ -- C74306A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     AFTER THE FULL DECLARATION OF A DEFERRED CONSTANT, THE VALUE OF
+ --     THE CONSTANT MAY BE USED IN ANY EXPRESSION, PARTICULARLY
+ --     EXPRESSIONS IN WHICH THE USE WOULD BE ILLEGAL BEFORE THE FULL
+ --     DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 03/14/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74306A IS
+ 
+      GENERIC
+           TYPE GENERAL_PURPOSE IS LIMITED PRIVATE;
+           Y : IN OUT GENERAL_PURPOSE;
+      FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
+ 
+      FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN X;
+           END IF;
+           RETURN Y;
+      END IDENT;
+ 
+      PACKAGE P IS
+           TYPE T IS PRIVATE;
+           C : CONSTANT T;
+      PRIVATE
+           TYPE T IS RANGE 1 .. 100;
+ 
+           TYPE A IS ARRAY(1..2) OF T;
+ 
+           TYPE B IS ARRAY(INTEGER RANGE <>) OF T;
+ 
+           TYPE D (DISC : T) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           C : CONSTANT T := 50;
+ 
+           PARAM : T := 99;
+ 
+           FUNCTION IDENT_T IS NEW IDENT (T, PARAM);
+ 
+           FUNCTION F (X : T := C) RETURN T;
+ 
+           SUBTYPE RAN IS T RANGE 1 .. C;
+ 
+           SUBTYPE IND IS B(1..INTEGER(C));
+ 
+           SUBTYPE DIS IS D (DISC => C);
+ 
+           OBJ : T := C;
+ 
+           CON : CONSTANT T := C;
+ 
+           ARR : A := (5, C);
+ 
+           PAR : T := IDENT_T (C);
+ 
+           RANOBJ : T RANGE 1 .. C := C;
+ 
+           INDOBJ : B(1..INTEGER(C));
+ 
+           DIS_VAL : DIS;
+ 
+           REN : T RENAMES C;
+ 
+           GENERIC
+                FOR_PAR : T := C;
+           PACKAGE GENPACK IS
+                VAL : T;
+           END GENPACK;
+ 
+           GENERIC
+                IN_PAR : IN T;
+           PACKAGE NEWPACK IS
+                IN_VAL : T;
+           END NEWPACK;
+      END P;
+ 
+      USE P;
+ 
+      PACKAGE BODY P IS
+           TYPE A1 IS ARRAY(1..2) OF T;
+ 
+           TYPE B1 IS ARRAY(INTEGER RANGE <>) OF T;
+ 
+           TYPE D1 (DISC1 : T) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           SUBTYPE RAN1 IS T RANGE 1 .. C;
+ 
+           SUBTYPE IND1 IS B1(1..INTEGER(C));
+ 
+           SUBTYPE DIS1 IS D1 (DISC1 => C);
+ 
+           OBJ1 : T := C;
+ 
+           FUNCVAR : T;
+ 
+           CON1 : CONSTANT T := C;
+ 
+           ARR1 : A1 := (5, C);
+ 
+           PAR1 : T := IDENT_T (C);
+ 
+           RANOBJ1 : T RANGE 1 .. C := C;
+ 
+           INDOBJ1 : B1(1..INTEGER(C));
+ 
+           DIS_VAL1 : DIS1;
+ 
+           REN1 : T RENAMES C;
+ 
+           FUNCTION F (X : T := C) RETURN T IS
+           BEGIN
+                RETURN C;
+           END F;
+ 
+           PACKAGE BODY GENPACK IS
+           BEGIN
+                VAL := FOR_PAR;
+           END GENPACK;
+ 
+           PACKAGE BODY NEWPACK IS
+           BEGIN
+                IN_VAL := IN_PAR;
+           END NEWPACK;
+ 
+           PACKAGE PACK IS NEW GENPACK (FOR_PAR => C);
+ 
+           PACKAGE NPACK IS NEW NEWPACK (IN_PAR => C);
+      BEGIN
+           TEST ("C74306A", "AFTER THE FULL DECLARATION OF A DEFERRED " &
+                            "CONSTANT, THE VALUE OF THE CONSTANT MAY " &
+                            "BE USED IN ANY EXPRESSION, PARTICULARLY " &
+                            "EXPRESSIONS IN WHICH THE USE WOULD BE " &
+                            "ILLEGAL BEFORE THE FULL DECLARATION");
+ 
+           IF OBJ /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR OBJ");
+           END IF;
+ 
+           IF CON /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR CON");
+           END IF;
+ 
+           IF ARR /= (IDENT_T(5), IDENT_T(50)) THEN
+                FAILED ("IMPROPER VALUES FOR ARR");
+           END IF;
+ 
+           IF PAR /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR PAR");
+           END IF;
+ 
+           IF OBJ1 /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR OBJ1");
+           END IF;
+ 
+           IF CON1 /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR CON1");
+           END IF;
+ 
+           IF ARR1 /= (IDENT_T(5), IDENT_T(50)) THEN
+                FAILED ("IMPROPER VALUES FOR ARR1");
+           END IF;
+ 
+           IF PAR1 /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR PAR1");
+           END IF;
+ 
+           IF PACK.VAL /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR PACK.VAL");
+           END IF;
+ 
+           IF NPACK.IN_VAL /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR NPACK.IN_VAL");
+           END IF;
+ 
+           IF RAN'LAST /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR RAN'LAST");
+           END IF;
+ 
+           IF RANOBJ /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR RANOBJ");
+           END IF;
+ 
+           IF IND'LAST /= IDENT_INT(50) THEN
+                FAILED ("IMPROPER VALUE FOR IND'LAST");
+           END IF;
+ 
+           IF INDOBJ'LAST /= IDENT_INT(50) THEN
+                FAILED ("IMPROPER VALUE FOR INDOBJ'LAST");
+           END IF;
+ 
+           IF DIS_VAL.DISC /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR DIS_VAL.DISC");
+           END IF;
+ 
+           IF REN /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR REN");
+           END IF;
+ 
+           IF RAN1'LAST /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR RAN1'LAST");
+           END IF;
+ 
+           IF RANOBJ1 /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR RANOBJ1");
+           END IF;
+ 
+           IF IND1'LAST /= IDENT_INT(50) THEN
+                FAILED ("IMPROPER VALUE FOR IND1'LAST");
+           END IF;
+ 
+           IF INDOBJ1'LAST /= IDENT_INT(50) THEN
+                FAILED ("IMPROPER VALUE FOR INDOBJ1'LAST");
+           END IF;
+ 
+           IF DIS_VAL1.DISC1 /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR DIS_VAL1.DISC1");
+           END IF;
+ 
+           IF REN1 /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR REN1");
+           END IF;
+ 
+           FUNCVAR := F(C);
+ 
+           IF FUNCVAR /= IDENT_T(50) THEN
+                FAILED ("IMPROPER VALUE FOR FUNCVAR");
+           END IF;
+ 
+           RESULT;
+      END P;
+ 
+ BEGIN
+      DECLARE
+           TYPE ARR IS ARRAY(1..2) OF T;
+ 
+           VAL1 : T := C;
+ 
+           VAL2 : ARR := (C, C);
+ 
+           VAL3 : T RENAMES C;
+      BEGIN
+           NULL;
+      END;
+ 
+      NULL;
+ END C74306A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74307a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74307a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74307a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74307a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,58 ----
+ -- C74307A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN EXPLICIT CONSTRAINT MAY BE GIVEN IN THE SUBTYPE
+ --     INDICATION OF THE FULL DECLARATION OF A DEFERRED CONSTANT.
+ 
+ -- HISTORY:
+ --     BCB 03/14/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74307A IS
+ 
+      PACKAGE P IS
+           TYPE T (D : INTEGER) IS PRIVATE;
+           C : CONSTANT T;
+      PRIVATE
+           TYPE T (D : INTEGER) IS RECORD
+                NULL;
+           END RECORD;
+           C : CONSTANT T(2) := (D => 2);
+      END P;
+ 
+      USE P;
+ 
+ BEGIN
+      TEST ("C74307A", "CHECK THAT AN EXPLICIT CONSTRAINT MAY BE " &
+                       "GIVEN IN THE SUBTYPE INDICATION OF THE FULL " &
+                       "DECLARATION OF A DEFERRED CONSTANT");
+ 
+      IF C.D /= 2 THEN
+           FAILED ("IMPROPER RESULTS FOR C.D");
+      END IF;
+ 
+      RESULT;
+ END C74307A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C74401D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN OUT PARAMETER HAVING A LIMITED TYPE IS ALLOWED FOR
+ -- FORMAL SUBPROGRAM PARAMETERS.  (ONLY THE CASE OF PRACTICAL INTEREST,
+ -- NAMELY, LIMITED PRIVATE TYPES, IS CHECKED HERE.)
+ 
+ -- CHECK THAT AN OUT PARAMETER IN A RENAMING DECLARATION CAN HAVE A
+ -- LIMITED PRIVATE TYPE WHEN IT RENAMES A GENERIC FORMAL SUBPROGRAM.
+ 
+ -- JBG 5/1/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C74401D IS
+ 
+      PACKAGE P IS
+           TYPE LP IS LIMITED PRIVATE;
+           PROCEDURE P1 (X : OUT LP);
+           PROCEDURE P2 (X : OUT LP);
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+           VAL1 : CONSTANT LP;
+           VAL2 : CONSTANT LP;
+      PRIVATE
+           TYPE LP IS NEW INTEGER;
+           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+           VAL2 : CONSTANT LP := LP(IDENT_INT(-3));
+      END P;
+ 
+      PACKAGE BODY P IS
+           PROCEDURE P1 (X : OUT LP) IS
+           BEGIN
+                X := 3;
+           END P1;
+ 
+           PROCEDURE P2 (X : OUT LP) IS
+           BEGIN
+                X := -3;
+           END P2;
+ 
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN L = R;
+           END EQ;
+      END P;
+ 
+      GENERIC
+           WITH PROCEDURE P3 (Y : OUT P.LP);
+           TYPE GLP IS LIMITED PRIVATE;
+           WITH PROCEDURE P4 (Y : OUT GLP);
+           VAL_P3 : IN OUT P.LP;
+           VAL_P4 : IN OUT GLP;
+      PACKAGE GPACK IS
+           PROCEDURE RENAMED (X : OUT GLP) RENAMES P4;   -- OK. RENAMING.
+      END GPACK;
+ 
+      PACKAGE BODY GPACK IS
+      BEGIN
+           P3 (VAL_P3);
+           P4 (VAL_P4);
+      END GPACK;
+ 
+ BEGIN
+ 
+      TEST ("C74401D", "CHECK THAT GENERIC FORMAL SUBPROGRAMS CAN HAVE "&
+                       "LIMITED PRIVATE OUT PARAMETERS");
+ 
+      DECLARE
+           VAR1 : P.LP;
+           VAR2 : P.LP;
+           PACKAGE PACK IS NEW GPACK (P.P1, P.LP, P.P2, VAR1, VAR2);
+      BEGIN
+           IF NOT P.EQ (VAR1, P.VAL1) THEN
+                FAILED ("P1 INVOCATION INCORRECT");
+           END IF;
+ 
+           IF NOT P.EQ (VAR2, P.VAL2) THEN
+                FAILED ("P2 INVOCATION INCORRECT");
+           END IF;
+ 
+           P.P1 (VAR2);        -- RESET VALUE OF VAR2.
+           PACK.RENAMED (VAR2);
+ 
+           IF NOT P.EQ (VAR2, P.VAL2) THEN
+                FAILED ("RENAMED INVOCATION INCORRECT");
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C74401D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,120 ----
+ -- C74401E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OUT PARAMETERS HAVING A LIMITED PRIVATE TYPE CAN BE
+ -- DECLARED IN A PACKAGE SPECIFICATION, INCLUDING WITHIN PACKAGES
+ -- NESTED IN A VISIBLE PART.
+ 
+ -- CHECK THAT A RENAMING DECLARATION CAN RENAME A PROCEDURE DECLARED
+ -- WITH AN OUT PARAMETER.
+ 
+ -- JBG 5/1/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C74401E IS
+ 
+      PACKAGE PKG IS
+           TYPE LP IS LIMITED PRIVATE;
+           PROCEDURE P20 (X : OUT LP);        -- OK.
+           PROCEDURE RESET (X : OUT LP);
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+           VAL1 : CONSTANT LP;
+ 
+           PACKAGE NESTED IS
+                PROCEDURE NEST1 (X : OUT LP);
+           PRIVATE
+                PROCEDURE NEST2 (X : OUT LP);
+           END NESTED;
+      PRIVATE
+           TYPE LP IS NEW INTEGER;
+           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+      END PKG;
+ 
+      VAR : PKG.LP;
+ 
+      PACKAGE BODY PKG IS
+           PROCEDURE P20 (X : OUT LP) IS
+           BEGIN
+                X := 3;
+           END P20;
+ 
+           PROCEDURE RESET (X : OUT LP) IS
+           BEGIN
+                X := LP(IDENT_INT(0));
+           END RESET;
+ 
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN L = R;
+           END EQ;
+ 
+           PACKAGE BODY NESTED IS
+                PROCEDURE NEST1 (X : OUT LP) IS
+                BEGIN
+                     X := 3;
+                END NEST1;
+ 
+                PROCEDURE NEST2 (X : OUT LP) IS
+                BEGIN
+                     X := LP(IDENT_INT(3));
+                END NEST2;
+           END NESTED;
+      BEGIN
+           VAR := LP(IDENT_INT(0));
+      END PKG;
+ 
+      PACKAGE PKG1 IS
+           PROCEDURE P21 (X : OUT PKG.LP) RENAMES PKG.P20;   -- OK:
+                                                             -- RENAMING.
+      END PKG1;
+ 
+ BEGIN
+ 
+      TEST ("C74401E", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
+                       "PARAMETER WITH A LIMITED PRIVATE TYPE");
+ 
+      PKG.RESET (VAR);
+      PKG.P20 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("DIRECT CALL NOT CORRECT");
+      END IF;
+ 
+      PKG.RESET (VAR);
+      PKG1.P21 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("RENAMED CALL NOT CORRECT");
+      END IF;
+ 
+      PKG.RESET (VAR);
+      PKG.NESTED.NEST1 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("NESTED CALL NOT CORRECT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C74401E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C74401K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OUT PARAMETERS OF AN ENTRY DECLARATION CAN HAVE A LIMITED
+ -- PRIVATE TYPE IF THE ENTRY DECLARATION OCCURS IN THE VISIBLE PART OF A
+ -- PACKAGE SPECIFICATION, INCLUDING WITHIN PACKAGES NESTED IN A VISIBLE
+ -- PART.
+ 
+ -- CHECK THAT A RENAMING DECLARATION CAN RENAME AN ENTRY DECLARED
+ -- WITH AN OUT PARAMETER.
+ 
+ -- JBG 5/1/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C74401K IS
+ 
+      PACKAGE PKG IS
+           TYPE LP IS LIMITED PRIVATE;
+           TASK P20 IS
+                ENTRY TP20 (X : OUT LP);        -- OK.
+                ENTRY RESET (X : OUT LP);
+           END P20;
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+           VAL1 : CONSTANT LP;
+ 
+           PACKAGE NESTED IS
+                TASK NEST1 IS
+                     ENTRY TNEST1 (X : OUT LP);
+                END NEST1;
+           PRIVATE
+                TASK NEST2 IS
+                     ENTRY TNEST2 (X : OUT LP);
+                END NEST2;
+           END NESTED;
+      PRIVATE
+           TYPE LP IS NEW INTEGER;
+           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+      END PKG;
+ 
+      VAR : PKG.LP;
+ 
+      PACKAGE BODY PKG IS
+           TASK BODY P20 IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT TP20 (X : OUT LP) DO
+                               X := 3;
+                          END TP20;
+                     OR   
+                          ACCEPT RESET (X : OUT LP) DO
+                               X := 0;
+                          END RESET;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END P20;
+ 
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN L = R;
+           END EQ;
+ 
+           PACKAGE BODY NESTED IS
+                TASK BODY NEST1 IS
+                BEGIN
+                     ACCEPT TNEST1 (X : OUT LP) DO
+                          X := 3;
+                     END TNEST1;
+                END NEST1;
+ 
+                TASK BODY NEST2 IS
+                BEGIN
+                     NULL;
+                END NEST2;
+           END NESTED;
+      BEGIN
+           VAR := LP(IDENT_INT(0));
+      END PKG;
+ 
+      PACKAGE PKG1 IS
+           PROCEDURE P21 (X : OUT PKG.LP) RENAMES PKG.P20.TP20;   -- OK:
+                                                             -- RENAMING.
+      END PKG1;
+ 
+ BEGIN
+ 
+      TEST ("C74401K", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
+                       "PARAMETER WITH A LIMITED PRIVATE TYPE");
+ 
+      PKG.P20.RESET (VAR);
+      PKG.P20.TP20 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("DIRECT CALL NOT CORRECT");
+      END IF;
+ 
+      PKG.P20.RESET (VAR);
+      PKG1.P21 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("RENAMED CALL NOT CORRECT");
+      END IF;
+ 
+      PKG.P20.RESET (VAR);
+      PKG.NESTED.NEST1.TNEST1 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("NESTED CALL NOT CORRECT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C74401K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401q.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401q.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74401q.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74401q.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- C74401Q.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OUT PARAMETERS HAVING A LIMITED PRIVATE TYPE CAN BE
+ -- DECLARED FOR A GENERIC SUBPROGRAM IN A PACKAGE SPECIFICATION,
+ -- INCLUDING WITHIN PACKAGES NESTED IN A VISIBLE PART.
+ 
+ -- JBG 5/1/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C74401Q IS
+ 
+      PACKAGE PKG IS
+           TYPE LP IS LIMITED PRIVATE;
+ 
+           GENERIC
+           PROCEDURE P20 (X : OUT LP);        -- OK.
+           PROCEDURE RESET (X : OUT LP);
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+           VAL1 : CONSTANT LP;
+ 
+           PACKAGE NESTED IS
+                GENERIC
+                PROCEDURE NEST1 (X : OUT LP);
+           PRIVATE
+                GENERIC
+                PROCEDURE NEST2 (X : OUT LP);
+           END NESTED;
+      PRIVATE
+           TYPE LP IS NEW INTEGER;
+           VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+      END PKG;
+ 
+      VAR : PKG.LP;
+ 
+      PACKAGE BODY PKG IS
+           PROCEDURE P20 (X : OUT LP) IS
+           BEGIN
+                X := 3;
+           END P20;
+ 
+           PROCEDURE RESET (X : OUT LP) IS
+           BEGIN
+                X := 0;
+           END RESET;
+ 
+           FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN L = R;
+           END EQ;
+ 
+           PACKAGE BODY NESTED IS
+                PROCEDURE NEST1 (X : OUT LP) IS
+                BEGIN
+                     X := 3;
+                END NEST1;
+ 
+                PROCEDURE NEST2 (X : OUT LP) IS
+                BEGIN
+                     X := LP(IDENT_INT(3));
+                END NEST2;
+           END NESTED;
+      BEGIN
+           VAR := LP(IDENT_INT(0));
+      END PKG;
+ 
+      PACKAGE INSTANCES IS
+           PROCEDURE NP20 IS NEW PKG.P20;
+           PROCEDURE NNEST1 IS NEW PKG.NESTED.NEST1;
+      END INSTANCES;
+      USE INSTANCES;
+ 
+      PACKAGE PKG1 IS
+           PROCEDURE P21 (X : OUT PKG.LP) RENAMES INSTANCES.NP20;
+      END PKG1;
+ 
+ BEGIN
+ 
+      TEST ("C74401Q", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
+                       "PARAMETER WITH A LIMITED PRIVATE TYPE");
+ 
+      PKG.RESET (VAR);
+      NP20 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("DIRECT CALL NOT CORRECT");
+      END IF;
+ 
+      PKG.RESET (VAR);
+      PKG1.P21 (VAR);
+ 
+      IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+           FAILED ("RENAMED CALL NOT CORRECT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C74401Q;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74402a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74402a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74402a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74402a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,154 ----
+ -- C74402A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED TYPE MAY HAVE A
+ -- DEFAULT EXPRESSION, EVEN IF THE SUBPROGRAM IS DECLARED OUTSIDE
+ -- THE PACKAGE THAT DECLARES THE LIMITED TYPE.
+ -- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
+ 
+ -- DSJ 5/6/83
+ -- SPS 10/24/83
+ 
+ WITH REPORT;
+ PROCEDURE C74402A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C74402A", "CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED " &
+                      "TYPE MAY HAVE A DEFAULT EXPRESSION, EVEN IF "    &
+                      "THE SUBPROGRAM IS DECLARED OUTSIDE THE PACKAGE " &
+                      "THAT DECLARES THE LIMITED TYPE");
+ 
+      DECLARE
+ 
+           PACKAGE PACK1 IS
+ 
+                TYPE LP1 IS LIMITED PRIVATE;
+                TYPE LP2 IS ARRAY (1 .. 2) OF LP1;
+                TYPE LP3 IS
+                     RECORD
+                          C1, C2 : LP2;
+                     END RECORD;
+ 
+                FUNCTION F1 RETURN LP1;
+                FUNCTION F2 RETURN LP2;
+                FUNCTION F3 RETURN LP3;
+ 
+                PROCEDURE G1 (X : LP1 := F1);      -- LEGAL
+                PROCEDURE G2 (X : LP2 := F2);      -- LEGAL
+                PROCEDURE G3 (X : LP3 := F3);      -- LEGAL
+ 
+           PRIVATE
+ 
+                TYPE LP1 IS NEW INTEGER;
+ 
+           END PACK1;
+ 
+           PACKAGE BODY PACK1 IS
+ 
+                FUNCTION F1 RETURN LP1 IS
+                BEGIN
+                     RETURN LP1'(1);
+                END F1;
+ 
+                FUNCTION F2 RETURN LP2 IS
+                BEGIN
+                     RETURN LP2'(2,3);
+                END F2;
+ 
+                FUNCTION F3 RETURN LP3 IS
+                BEGIN
+                     RETURN LP3'((4,5),(6,7));
+                END F3;
+ 
+                PROCEDURE G1 (X : LP1 := F1) IS
+                BEGIN
+                     IF X /= LP1'(1) THEN
+                          FAILED("WRONG DEFAULT VALUE - LP1");
+                     END IF;
+                END G1;
+ 
+                PROCEDURE G2 (X : LP2 := F2) IS
+                BEGIN
+                     IF X /= LP2'(2,3) THEN
+                          FAILED("WRONG DEFAULT VALUE - LP2");
+                     END IF;
+                END G2;
+ 
+                PROCEDURE G3 (X : LP3 := F3) IS
+                BEGIN
+                     IF X /= LP3'((4,5),(6,7)) THEN
+                          FAILED("WRONG DEFAULT VALUE - LP3");
+                     END IF;
+                END G3;
+ 
+           BEGIN
+ 
+                G1;            -- LEGAL, DEFAULT USED
+                G2;            -- LEGAL, DEFAULT USED
+                G3;            -- LEGAL, DEFAULT USED
+ 
+                G1(F1);        -- LEGAL
+                G2(F2);        -- LEGAL
+                G3(F3);        -- LEGAL
+ 
+           END PACK1;
+ 
+           USE PACK1;
+ 
+           PROCEDURE G4 (X : LP1 := F1) IS
+           BEGIN
+                G1;            -- LEGAL, DEFAULT USED
+                G1(X);
+           END G4;
+ 
+           PROCEDURE G5 (X : LP2 := F2) IS
+           BEGIN
+                G2;            -- LEGAL, DEFAULT USED
+                G2(X);
+           END G5;
+ 
+           PROCEDURE G6 (X : LP3 := F3) IS
+           BEGIN
+                G3;            -- DEFAULT USED
+                G3(X);
+           END G6;
+ 
+      BEGIN
+ 
+           G4;                 -- LEGAL, DEFAULT USED
+           G5;                 -- LEGAL, DEFAULT USED
+           G6;                 -- LEGAL, DEFAULT USED
+ 
+           G4(F1);             -- LEGAL
+           G5(F2);             -- LEGAL
+           G6(F3);             -- LEGAL
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C74402A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74402b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74402b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74402b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74402b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C74402B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INITIALIZATION OF IN PARAMETERS THAT ARE OF
+ -- LIMITED PRIVATE TYPE IS PERMITTED.
+ -- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
+ 
+ -- DAS  1/21/81
+ -- ABW  6/30/82
+ -- BHS  7/10/84
+ 
+ WITH REPORT;
+ PROCEDURE C74402B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST( "C74402B" , "CHECK THAT INITIALIZATION OF IN PARAMETERS " &
+                        "OF LIMITED PRIVATE TYPE IS PERMITTED" );
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+ 
+                TYPE LPTYPE IS LIMITED PRIVATE;
+                CLP : CONSTANT LPTYPE;
+                XLP : CONSTANT LPTYPE;
+                FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN;
+                FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN;
+ 
+           PRIVATE
+ 
+                TYPE LPTYPE IS NEW INTEGER RANGE 0..127;
+                CLP : CONSTANT LPTYPE := 127;
+                XLP : CONSTANT LPTYPE := 0;
+ 
+           END;
+ 
+           PACKAGE BODY PKG IS
+ 
+                FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN (L = CLP);
+                END EQCLP;
+ 
+                FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN (L = XLP);
+                END EQXLP;
+ 
+           END PKG;
+ 
+           USE PKG;
+ 
+           PROCEDURE PROC1 (Y : IN LPTYPE := CLP) IS
+           BEGIN
+                IF (EQCLP (Y)) THEN
+                     FAILED( "LIMITED PRIVATE NOT PASSED, " &
+                             "DEFAULT CLP EMPLOYED" );
+                ELSIF (NOT EQXLP (Y)) THEN
+                     FAILED( "NO LIMITED PRIVATE FOUND" );
+                END IF;
+           END PROC1;
+ 
+           PROCEDURE PROC2 (Y : IN LPTYPE := CLP) IS
+           BEGIN
+                IF (NOT EQCLP(Y)) THEN
+                     FAILED( "DEFAULT NOT EMPLOYED" );
+                END IF;
+           END PROC2;
+ 
+      BEGIN
+ 
+           PROC1(XLP);
+           PROC2;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C74402B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74406a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74406a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74406a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74406a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- C74406A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE FULL DECLARATION OF A LIMITED PRIVATE TYPE CAN
+ --     DECLARE A TASK TYPE, A TYPE DERIVED FROM A LIMITED PRIVATE TYPE,
+ --     AND A COMPOSITE TYPE WITH A COMPONENT OF A LIMITED TYPE.
+ 
+ -- HISTORY:
+ --     BCB 03/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74406A IS
+ 
+      PACKAGE TP IS
+           TYPE T IS LIMITED PRIVATE;
+           PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER);
+           FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN;
+      PRIVATE
+           TYPE T IS RANGE 1 .. 100;
+      END TP;
+ 
+      PACKAGE BODY TP IS
+           PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER) IS
+           BEGIN
+                Z1 := T (Z2);
+           END INIT;
+ 
+           FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN ONE = TWO;
+                ELSE
+                     RETURN ONE /= TWO;
+                END IF;
+           END EQUAL_T;
+      BEGIN
+           NULL;
+      END TP;
+ 
+      USE TP;
+ 
+      PACKAGE P IS
+           TYPE T1 IS LIMITED PRIVATE;
+           TYPE T2 IS LIMITED PRIVATE;
+           TYPE T3 IS LIMITED PRIVATE;
+           TYPE T4 IS LIMITED PRIVATE;
+      PRIVATE
+           TASK TYPE T1 IS
+                ENTRY HERE(VAL1 : IN OUT INTEGER);
+           END T1;
+ 
+           TYPE T2 IS NEW T;
+ 
+           TYPE T3 IS RECORD
+                INT : T;
+           END RECORD;
+ 
+           TYPE T4 IS ARRAY(1..5) OF T;
+      END P;
+ 
+      PACKAGE BODY P IS
+           X1 : T1;
+           X3 : T3;
+           X4 : T4;
+           VAR : INTEGER := 25;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT HERE(VAL1 : IN OUT INTEGER) DO
+                     VAL1 := VAL1 * 2;
+                END HERE;
+           END T1;
+ 
+      BEGIN
+           TEST ("C74406A", "CHECK THAT THE FULL DECLARATION OF A " &
+                            "LIMITED PRIVATE TYPE CAN DECLARE A TASK " &
+                            "TYPE, A TYPE DERIVED FROM A LIMITED " &
+                            "PRIVATE TYPE, AND A COMPOSITE TYPE WITH " &
+                            "A COMPONENT OF A LIMITED TYPE");
+ 
+           X1.HERE(VAR);
+ 
+           IF NOT EQUAL(VAR,IDENT_INT(50)) THEN
+                FAILED ("IMPROPER VALUE FOR VAL");
+           END IF;
+ 
+           INIT (X3.INT, 50);
+ 
+           IF X3.INT NOT IN T THEN
+                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+           END IF;
+ 
+           INIT (X4(3), 17);
+ 
+           IF NOT EQUAL_T(T'(X4(3)),T(X4(3))) THEN
+                FAILED ("IMPROPER RESULT FROM QUALIFICATION AND " &
+                        "EXPLICIT CONVERSION");
+           END IF;
+ 
+           RESULT;
+      END P;
+ 
+      USE P;
+ 
+ BEGIN
+      NULL;
+ END C74406A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74407b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74407b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74407b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74407b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C74407B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, FOR A LIMITED PRIVATE TYPE, THAT PRE-DEFINED EQUALITY AND
+ --     ASSIGNMENT ARE DEFINED AND AVAILABLE WITHIN THE PRIVATE PART AND
+ --     THE BODY OF A PACKAGE, AFTER THE FULL DECLARATION, IF THE FULL
+ --     DECLARATION IS NOT LIMITED.
+ 
+ -- HISTORY:
+ --     BCB 07/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C74407B IS
+ 
+      PACKAGE PP IS
+           TYPE PRIV IS PRIVATE;
+           C1 : CONSTANT PRIV;
+           C2 : CONSTANT PRIV;
+      PRIVATE
+           TYPE PRIV IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
+           C1 : CONSTANT PRIV := ONE;
+           C2 : CONSTANT PRIV := TWO;
+      END PP;
+ 
+      USE PP;
+ 
+      PACKAGE P IS
+           TYPE INT IS LIMITED PRIVATE;
+           TYPE COMP IS LIMITED PRIVATE;
+           TYPE DER IS LIMITED PRIVATE;
+      PRIVATE
+           TYPE INT IS RANGE 1 .. 100;
+           TYPE COMP IS ARRAY(1..5) OF INTEGER;
+           TYPE DER IS NEW PRIV;
+           D, E : INT := 10;
+           F : INT := 20;
+           CONS_INT1 : CONSTANT INT := 30;
+           G : BOOLEAN := D = E;
+           H : BOOLEAN := D /= F;
+           CONS_BOOL1 : CONSTANT BOOLEAN := D = E;
+           CONS_BOOL2 : CONSTANT BOOLEAN := D /= F;
+           I : COMP := (1,2,3,4,5);
+           CONS_COMP1 : CONSTANT COMP := (6,7,8,9,10);
+           J : DER := DER(C1);
+           CONS_DER1 : CONSTANT DER := DER(C2);
+      END P;
+ 
+      PACKAGE BODY P IS
+           A, B, C : INT;
+           X, Y, Z : COMP;
+           L, M, N : DER;
+           CONS_INT2 : CONSTANT INT := 10;
+           CONS_COMP2 : CONSTANT COMP := (1,2,3,4,5);
+           CONS_DER2 : CONSTANT DER := DER(C1);
+      BEGIN
+           TEST ("C74407B", "CHECK, FOR A LIMITED PRIVATE TYPE, THAT " &
+                            "PRE-DEFINED EQUALITY AND ASSIGNMENT ARE " &
+                            "DEFINED AND AVAILABLE WITHIN THE PRIVATE " &
+                            "PART AND THE BODY OF A PACKAGE, AFTER " &
+                            "THE FULL DECLARATION, IF THE FULL " &
+                            "DECLARATION IS NOT LIMITED");
+ 
+           A := 10;
+ 
+           B := 10;
+ 
+           C := 20;
+ 
+           IF A = C THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 1");
+           END IF;
+ 
+           IF A /= B THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 1");
+           END IF;
+ 
+           IF CONS_INT2 = C THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 2");
+           END IF;
+ 
+           IF CONS_INT2 /= B THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 2");
+           END IF;
+ 
+           IF NOT G THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                        "PACKAGE - 1");
+           END IF;
+ 
+           IF NOT H THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                        "PACKAGE - 1");
+           END IF;
+ 
+           IF NOT CONS_BOOL1 THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                        "PACKAGE - 2");
+           END IF;
+ 
+           IF NOT CONS_BOOL2 THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                        "PACKAGE - 2");
+           END IF;
+ 
+           X := (1,2,3,4,5);
+ 
+           Y := (1,2,3,4,5);
+ 
+           Z := (5,4,3,2,1);
+ 
+           IF X = Z THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 3");
+           END IF;
+ 
+           IF X /= Y THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 3");
+           END IF;
+ 
+           IF CONS_COMP2 = Z THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 4");
+           END IF;
+ 
+           IF CONS_COMP2 /= Y THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 4");
+           END IF;
+ 
+           L := DER(C1);
+ 
+           M := DER(C1);
+ 
+           N := DER(C2);
+ 
+           IF L = N THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 5");
+           END IF;
+ 
+           IF L /= M THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 5");
+           END IF;
+ 
+           IF CONS_DER2 = N THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 6");
+           END IF;
+ 
+           IF CONS_DER2 /= M THEN
+                FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                        "OPERATION WITHIN THE PACKAGE BODY - 6");
+           END IF;
+ 
+           RESULT;
+      END P;
+ 
+      USE P;
+ 
+ BEGIN
+      NULL;
+ END C74407B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74409b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74409b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c74409b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c74409b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C74409B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A COMPOSITE TYPE IS DECLARED IN THE SAME PACKAGE 
+ -- AS A LIMITED PRIVATE TYPE AND HAS A COMPONENT OF THAT TYPE, 
+ -- THE COMPOSITE TYPE IS TREATED AS A LIMITED TYPE UNTIL THE 
+ -- EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE DECLARATION 
+ -- OF THE COMPOSITE TYPE AND AFTER THE FULL DECLARATION OF THE 
+ -- LIMITED PRIVATE TYPE
+ 
+ -- DSJ 5/5/83
+ -- JBG 9/23/83
+ 
+ WITH REPORT;
+ PROCEDURE C74409B IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C74409B", "CHECK THAT A COMPOSITE TYPE WITH A LIMITED " &
+                      "PRIVATE COMPONENT IS TREATED AS A LIMITED " &
+                      "TYPE UNTIL ASSIGNMENT AND EQUALITY ARE BOTH " &
+                      "AVAILABLE FOR THE COMPOSITE TYPE");
+ 
+      DECLARE
+ 
+           PACKAGE P IS
+                TYPE LP IS LIMITED PRIVATE;
+                PACKAGE Q IS
+                     TYPE LP_ARRAY IS ARRAY (1 .. 2) OF LP;
+                END Q;
+           PRIVATE
+                TYPE LP IS NEW INTEGER;
+           END P;
+ 
+           PACKAGE BODY P IS
+                USE Q;
+                FUNCTION "=" (L,R : LP_ARRAY) RETURN BOOLEAN IS  -- LEGAL
+                BEGIN
+                     RETURN TRUE;
+                END;
+ 
+                GENERIC
+                     TYPE T IS PRIVATE;     -- NOTE: NOT LIMITED PRIVATE
+                     C, D : T;
+                PACKAGE A IS
+                     -- IRRELEVANT DETAILS
+                END A;
+ 
+                PACKAGE BODY A IS
+                BEGIN
+                     IF C = D THEN
+                          FAILED ("USED WRONG EQUALITY OPERATOR");
+                     END IF;
+                END A;
+ 
+                PACKAGE BODY Q IS
+                     PACKAGE ANOTHER_NEW_A IS 
+                          NEW A (LP_ARRAY, (2,3), (4,5)); -- LEGAL
+                END Q;
+           END P;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C74409B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,390 ----
+ -- C760001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that Initialize is called for objects and components of
+ --      a controlled type when the objects and components are not
+ --      assigned explicit initial values.  Check this for "simple" controlled
+ --      objects, controlled record components and arrays with controlled
+ --      components.
+ --
+ --      Check that if an explicit initial value is assigned to an object
+ --      or component of a controlled type then Initialize is not called.
+ --
+ -- TEST DESCRIPTION:
+ --      This test derives a type for Ada.Finalization.Controlled, and
+ --      overrides the Initialize and Adjust operations for the type.  The
+ --      intent of the type is that it should carry incremental values
+ --      indicating the ordering of events with respect to these (and default
+ --      initialization) operations.  The body of the test uses these values
+ --      to determine that the implicit calls to these subprograms happen
+ --      (or don't) at the appropriate times.
+ --
+ --      The test further derives types from this "root" type, which are the
+ --      actual types used in the test.  One of the types is "simply" derived
+ --      from the "root" type, the other contains a component of the first
+ --      type, thus nesting a controlled object as a record component in
+ --      controlled objects.
+ --
+ --      The main program declares objects of these types and checks the
+ --      values of the components to ascertain that they have been touched
+ --      as expected.
+ --
+ --      Note that Finalization procedures are provided.  This test does not
+ --      test that the calls to Finalization are made correctly.  The
+ --      Finalization procedures are provided to catch an implementation that
+ --      calls Finalization at an incorrect time.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      10 Oct 95   SAIC    Update and repair for ACVC 2.0.1
+ --
+ --!
+ 
+ ---------------------------------------------------------------- C760001_0
+ 
+ with Ada.Finalization;
+ package C760001_0 is
+   subtype Unique_ID is Natural;
+   function Unique_Value return Unique_ID;
+   -- increments each time it's called
+ 
+   function Most_Recent_Unique_Value return Unique_ID;
+   -- returns the same value as the most recent call to Unique_Value
+ 
+   type Root_Controlled is new Ada.Finalization.Controlled with record
+     My_ID      : Unique_ID := Unique_Value;
+     My_Init_ID : Unique_ID := Unique_ID'First;
+     My_Adj_ID  : Unique_ID := Unique_ID'First;
+   end record;
+ 
+   procedure Initialize( R: in out Root_Controlled );
+   procedure Adjust    ( R: in out Root_Controlled );
+ 
+   TC_Initialize_Calls_Is_Failing : Boolean := False;
+ 
+ end C760001_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C760001_0 is
+ 
+   Global_Unique_Counter : Unique_ID := 0;
+   
+   function Unique_Value return Unique_ID is
+   begin
+     Global_Unique_Counter := Global_Unique_Counter +1;
+     return Global_Unique_Counter;
+   end Unique_Value;
+   
+   function Most_Recent_Unique_Value return Unique_ID is
+   begin
+     return Global_Unique_Counter;
+   end Most_Recent_Unique_Value;
+   
+   procedure Initialize( R: in out Root_Controlled ) is
+   begin
+     if TC_Initialize_Calls_Is_Failing then
+       Report.Failed("Initialized incorrectly called");
+     end if;
+     R.My_Init_ID := Unique_Value;
+   end Initialize;
+ 
+   procedure Adjust( R: in out Root_Controlled ) is
+   begin
+     R.My_Adj_ID := Unique_Value;
+   end Adjust;
+ 
+ end C760001_0;
+ 
+ ---------------------------------------------------------------- C760001_1
+ 
+ with Ada.Finalization;
+ with C760001_0;
+ package C760001_1 is
+ 
+   type Proc_ID is (None, Init, Adj, Fin);
+ 
+   type Test_Controlled is new C760001_0.Root_Controlled with record
+     Last_Proc_Called: Proc_ID := None;
+   end record;
+ 
+   procedure Initialize( TC: in out Test_Controlled );
+   procedure Adjust    ( TC: in out Test_Controlled );
+   procedure Finalize  ( TC: in out Test_Controlled );
+ 
+   type Nested_Controlled is new C760001_0.Root_Controlled with record
+     Nested : C760001_0.Root_Controlled;
+     Last_Proc_Called: Proc_ID := None;
+   end record;
+ 
+   procedure Initialize( TC: in out Nested_Controlled );
+   procedure Adjust    ( TC: in out Nested_Controlled );
+   procedure Finalize  ( TC: in out Nested_Controlled );
+ 
+ end C760001_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C760001_1 is
+ 
+   procedure Initialize( TC: in out Test_Controlled ) is
+   begin
+     if TC.Last_Proc_Called /= None then
+       Report.Failed("Initialize for Test_Controlled");
+     end if;
+     TC.Last_Proc_Called := Init;
+     C760001_0.Initialize(C760001_0.Root_Controlled(TC));
+   end Initialize;
+ 
+   procedure Adjust    ( TC: in out Test_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Adj;
+     C760001_0.Adjust(C760001_0.Root_Controlled(TC));
+   end Adjust;
+ 
+   procedure Finalize  ( TC: in out Test_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Fin;
+   end Finalize;
+ 
+   procedure Initialize( TC: in out Nested_Controlled ) is
+   begin
+     if TC.Last_Proc_Called /= None then
+       Report.Failed("Initialize for Nested_Controlled");
+     end if;
+     TC.Last_Proc_Called := Init;
+     C760001_0.Initialize(C760001_0.Root_Controlled(TC));
+   end Initialize;
+ 
+   procedure Adjust    ( TC: in out Nested_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Adj;
+     C760001_0.Adjust(C760001_0.Root_Controlled(TC));
+   end Adjust;
+ 
+   procedure Finalize  ( TC: in out Nested_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Fin;
+   end Finalize;
+ 
+ end C760001_1;
+ 
+ ---------------------------------------------------------------- C760001
+ 
+ with Report;
+ with TCTouch;
+ with C760001_0;
+ with C760001_1;
+ with Ada.Finalization;
+ procedure C760001 is
+ 
+   use type C760001_1.Proc_ID;
+ 
+   -- in the first test, test the simple case.  Check that a controlled object
+   -- causes a call to the procedure Initialize.
+   -- Also check that assignment causes a call to Adjust.
+ 
+   procedure Check_Simple_Objects is
+     S,T : C760001_1.Test_Controlled;
+   begin
+     TCTouch.Assert(S.My_ID < S.My_Init_ID,"Default before dispatch");
+     TCTouch.Assert((S.Last_Proc_Called = C760001_1.Init) and
+                                         (T.Last_Proc_Called = C760001_1.Init),
+                    "Initialize for simple object");
+     S := T;
+     TCTouch.Assert((S.Last_Proc_Called = C760001_1.Adj),
+                    "Adjust for simple object");
+     TCTouch.Assert((S.My_ID = T.My_ID),
+                    "Simple object My_ID's don't match");
+     TCTouch.Assert((S.My_Init_ID = T.My_Init_ID),
+                    "Simple object My_Init_ID's don't match");
+     TCTouch.Assert((S.My_Adj_ID > T.My_Adj_ID),
+                    "Simple object My_Adj_ID's in wrong order");
+   end Check_Simple_Objects;
+ 
+   -- in the second test, test a more complex case, check that a controlled
+   -- component of a controlled object gets processed correctly
+ 
+   procedure Check_Nested_Objects is
+     NO1 : C760001_1.Nested_Controlled;
+   begin
+     TCTouch.Assert((NO1.My_ID < NO1.My_Init_Id),
+                    "Default value order incorrect");
+     TCTouch.Assert((NO1.My_Init_Id > NO1.Nested.My_Init_ID),
+                    "Initialization call order incorrect");
+   end Check_Nested_Objects;
+ 
+   -- check that objects assigned an initial value at declaration are Adjusted
+   -- and NOT Initialized
+ 
+   procedure Check_Objects_With_Initial_Values is
+ 
+     TC_Now : constant C760001_0.Unique_ID := C760001_0.Unique_Value;
+ 
+     A: C760001_1.Test_Controlled := 
+       ( Ada.Finalization.Controlled
+         with TC_Now,
+              TC_Now,
+              TC_Now,
+              C760001_1.None);
+ 
+     B: C760001_1.Nested_Controlled := 
+       ( Ada.Finalization.Controlled
+         with TC_Now,
+              TC_Now,
+              TC_Now,
+              C760001_0.Root_Controlled(A),
+              C760001_1.None);
+ 
+   begin
+     -- the implementation may or may not call Adjust for the values
+     -- assigned into A and B,
+     -- but should NOT call Initialize.
+     -- if the value used in the aggregate is overwritten by Initialize,
+     -- this indicates failure
+     TCTouch.Assert(A.My_Init_Id = TC_Now,
+                    "Initialize was called for A with initial value");
+     TCTouch.Assert(B.My_Init_Id = TC_Now,
+                    "Initialize was called for B with initial value");
+     TCTouch.Assert(B.Nested.My_Init_ID = TC_Now,
+                    "Initialize was called for B.Nested initial value");
+   end Check_Objects_With_Initial_Values;
+ 
+   procedure Check_Array_Case is
+     type Array_Simple is array(1..4) of C760001_1.Test_Controlled;
+     type Array_Nested is array(1..4) of C760001_1.Nested_Controlled;
+ 
+     Simple_Array_Default : Array_Simple;
+ 
+     Nested_Array_Default : Array_Nested;
+ 
+     TC_A_Bit_Later : C760001_0.Unique_ID;
+ 
+   begin
+     TC_A_Bit_Later := C760001_0.Unique_Value;
+     for N in 1..4 loop
+       TCTouch.Assert(Simple_Array_Default(N).Last_Proc_Called
+                      = C760001_1.Init,
+                      "Initialize for array initial value");
+ 
+       TCTouch.Assert( (Simple_Array_Default(N).My_Init_ID
+                        > C760001_0.Unique_ID'First)
+                       and (Simple_Array_Default(N).My_Init_ID
+                        < TC_A_Bit_Later),
+                      "Initialize timing for simple array");
+ 
+       TCTouch.Assert( (Nested_Array_Default(N).My_Init_ID
+                        > C760001_0.Unique_ID'First)
+                       and (Nested_Array_Default(N).My_Init_ID
+                        < TC_A_Bit_Later),
+                      "Initialize timing for container array");
+ 
+       TCTouch.Assert(Nested_Array_Default(N).Last_Proc_Called
+                      = C760001_1.Init,
+                      "Initialize for nested array (outer) initial value");
+ 
+       TCTouch.Assert( (Nested_Array_Default(N).Nested.My_Init_ID
+                        > C760001_0.Unique_ID'First)
+                       and (Nested_Array_Default(N).Nested.My_Init_ID
+                        < Nested_Array_Default(N).My_Init_ID),
+                      "Initialize timing for array content");
+     end loop;
+   end Check_Array_Case;
+ 
+   procedure Check_Array_Case_With_Initial_Values is
+ 
+     TC_Now : constant C760001_0.Unique_ID := C760001_0.Unique_Value;
+ 
+     type Array_Simple is array(1..4) of C760001_1.Test_Controlled;
+     type Array_Nested is array(1..4) of C760001_1.Nested_Controlled;
+ 
+     Simple_Array_Explicit : Array_Simple := ( 1..4 => (
+         Ada.Finalization.Controlled
+         with TC_Now,
+              TC_Now,
+              TC_Now,
+              C760001_1.None                 )         );
+ 
+     A : constant C760001_0.Root_Controlled := 
+       ( Ada.Finalization.Controlled
+         with others => TC_Now);
+ 
+     Nested_Array_Explicit : Array_Nested := ( 1..4 => (
+         Ada.Finalization.Controlled
+         with TC_Now,
+              TC_Now,
+              TC_Now,
+              A,
+              C760001_1.None                 )         );
+ 
+   begin
+     -- the implementation may or may not call Adjust for the values
+     -- assigned into Simple_Array_Explicit and Nested_Array_Explicit,
+     -- but should NOT call Initialize.
+     -- if the value used in the aggregate is overwritten by Initialize,
+     -- this indicates failure
+     for N in 1..4 loop
+       TCTouch.Assert(Simple_Array_Explicit(N).My_Init_ID
+                      = TC_Now,
+                      "Initialize was called for array with initial value");
+       TCTouch.Assert(Nested_Array_Explicit(N).My_Init_ID
+                      = TC_Now,
+         "Initialize was called for nested array (outer) with initial value");
+       TCTouch.Assert(Nested_Array_Explicit(N).Nested.My_Init_ID = TC_Now,
+         "Initialize was called for nested array (inner) with initial value");
+     end loop;
+   end Check_Array_Case_With_Initial_Values;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C760001", "Check that Initialize is called for objects " &
+                           "and components of a controlled type when the " &
+                           "objects and components are not assigned " &
+                           "explicit initial values.  Check that if an " &
+                           "explicit initial value is assigned to an " &
+                           "object or component of a controlled type " &
+                           "then Initialize is not called" );
+ 
+   Check_Simple_Objects;
+ 
+   Check_Nested_Objects;
+ 
+   Check_Array_Case;
+ 
+   C760001_0.TC_Initialize_Calls_Is_Failing := True;
+ 
+   Check_Objects_With_Initial_Values;
+ 
+   Check_Array_Case_With_Initial_Values;
+ 
+   Report.Result;
+ 
+ end C760001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,489 ----
+ -- C760002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that assignment to an object of a (non-limited) controlled
+ --      type causes the Adjust operation of the type to be called.
+ --      Check that Adjust is called after copying the value of the
+ --      source expression to the target object.
+ --
+ --      Check that Adjust is called for all controlled components when
+ --      the containing object is assigned.  (Test this for the cases
+ --      where the type of the containing object is controlled and
+ --      noncontrolled; test this for initialization as well as
+ --      assignment statements.)
+ --
+ --      Check that for an object of a controlled type with controlled
+ --      components, Adjust for each of the components is called before
+ --      the containing object is adjusted.
+ --
+ --      Check that an Adjust procedure for a Limited_Controlled type is
+ --      not called by the implementation.
+ --
+ -- TEST DESCRIPTION:
+ --      This test is loosely "derived" from C760001.
+ --
+ --      Visit Tags:
+ --        D - Default value at declaration
+ --        d - Default value at declaration, limited root
+ --        I - initialize at root controlled
+ --        i - initialize at root limited controlled
+ --        A - adjust at root controlled
+ --        X,Y,Z,x,y,z - used in test body
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Correct test assertion logic for Sinister case
+ --
+ --!
+ 
+ ---------------------------------------------------------------- C760002_0
+ 
+ with Ada.Finalization;
+ package C760002_0 is
+   subtype Unique_ID is Natural;
+   function Unique_Value return Unique_ID;
+   -- increments each time it's called
+ 
+   function Most_Recent_Unique_Value return Unique_ID;
+   -- returns the same value as the most recent call to Unique_Value
+ 
+   type Root is tagged record
+     My_ID      : Unique_ID := Unique_Value;
+     Visit_Tag  : Character := 'D';  -- Default
+   end record;
+ 
+   procedure Initialize( R: in out Root );
+   procedure Adjust    ( R: in out Root );
+ 
+   type Root_Controlled is new Ada.Finalization.Controlled with record
+     My_ID      : Unique_ID := Unique_Value;
+     Visit_Tag  : Character := 'D'; ---------------------------------------- D
+   end record;
+ 
+   procedure Initialize( R: in out Root_Controlled );
+   procedure Adjust    ( R: in out Root_Controlled );
+ 
+   type Root_Limited_Controlled is
+        new Ada.Finalization.Limited_Controlled with record
+     My_ID      : Unique_ID := Unique_Value;
+     Visit_Tag  : Character := 'd'; ---------------------------------------- d
+   end record;
+ 
+   procedure Initialize( R: in out Root_Limited_Controlled );
+   procedure Adjust    ( R: in out Root_Limited_Controlled );
+ 
+ end C760002_0;
+ 
+ with Report;
+ package body C760002_0 is
+ 
+   Global_Unique_Counter : Unique_ID := 0;
+   
+   function Unique_Value return Unique_ID is
+   begin
+     Global_Unique_Counter := Global_Unique_Counter +1;
+     return Global_Unique_Counter;
+   end Unique_Value;
+   
+   function Most_Recent_Unique_Value return Unique_ID is
+   begin
+     return Global_Unique_Counter;
+   end Most_Recent_Unique_Value;
+ 
+   procedure Initialize( R: in out Root ) is
+   begin
+     Report.Failed("Initialize called for Non_Controlled type");
+   end Initialize;
+ 
+   procedure Adjust    ( R: in out Root ) is
+   begin
+     Report.Failed("Adjust called for Non_Controlled type");
+   end Adjust;
+ 
+   procedure Initialize( R: in out Root_Controlled ) is
+   begin
+     R.Visit_Tag := 'I'; --------------------------------------------------- I
+   end Initialize;
+ 
+   procedure Adjust( R: in out Root_Controlled ) is
+   begin
+     R.Visit_Tag := 'A'; --------------------------------------------------- A
+   end Adjust;
+ 
+   procedure Initialize( R: in out Root_Limited_Controlled ) is
+   begin
+     R.Visit_Tag := 'i'; --------------------------------------------------- i
+   end Initialize;
+ 
+   procedure Adjust( R: in out Root_Limited_Controlled ) is
+   begin
+     Report.Failed("Adjust called for Limited_Controlled type");
+   end Adjust;
+ 
+ end C760002_0;
+ 
+ ---------------------------------------------------------------- C760002_1
+ 
+ with Ada.Finalization;
+ with C760002_0;
+ package C760002_1 is
+ 
+   type Proc_ID is (None, Init, Adj, Fin);
+ 
+   type Test_Controlled is new C760002_0.Root_Controlled with record
+     Last_Proc_Called: Proc_ID := None;
+   end record;
+ 
+   procedure Initialize( TC: in out Test_Controlled );
+   procedure Adjust    ( TC: in out Test_Controlled );
+   procedure Finalize  ( TC: in out Test_Controlled );
+ 
+   type Nested_Controlled is new C760002_0.Root_Controlled with record
+     Nested : C760002_0.Root_Controlled;
+     Last_Proc_Called: Proc_ID := None;
+   end record;
+ 
+   procedure Initialize( TC: in out Nested_Controlled );
+   procedure Adjust    ( TC: in out Nested_Controlled );
+   procedure Finalize  ( TC: in out Nested_Controlled );
+ 
+   type Test_Limited_Controlled is
+        new C760002_0.Root_Limited_Controlled with record
+     Last_Proc_Called: Proc_ID := None;
+   end record;
+ 
+   procedure Initialize( TC: in out Test_Limited_Controlled );
+   procedure Adjust    ( TC: in out Test_Limited_Controlled );
+   procedure Finalize  ( TC: in out Test_Limited_Controlled );
+ 
+   type Nested_Limited_Controlled is
+        new C760002_0.Root_Limited_Controlled with record
+     Nested : C760002_0.Root_Limited_Controlled;
+     Last_Proc_Called: Proc_ID := None;
+   end record;
+ 
+   procedure Initialize( TC: in out Nested_Limited_Controlled );
+   procedure Adjust    ( TC: in out Nested_Limited_Controlled );
+   procedure Finalize  ( TC: in out Nested_Limited_Controlled );
+ 
+ end C760002_1;
+ 
+ with Report;
+ package body C760002_1 is
+ 
+   procedure Initialize( TC: in out Test_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Init;
+     C760002_0.Initialize(C760002_0.Root_Controlled(TC));
+   end Initialize;
+ 
+   procedure Adjust    ( TC: in out Test_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Adj;
+     C760002_0.Adjust(C760002_0.Root_Controlled(TC));
+   end Adjust;
+ 
+   procedure Finalize  ( TC: in out Test_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Fin;
+   end Finalize;
+ 
+   procedure Initialize( TC: in out Nested_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Init;
+     C760002_0.Initialize(C760002_0.Root_Controlled(TC));
+   end Initialize;
+ 
+   procedure Adjust    ( TC: in out Nested_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Adj;
+     C760002_0.Adjust(C760002_0.Root_Controlled(TC));
+   end Adjust;
+ 
+   procedure Finalize  ( TC: in out Nested_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Fin;
+   end Finalize;
+ 
+   procedure Initialize( TC: in out Test_Limited_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Init;
+     C760002_0.Initialize(C760002_0.Root_Limited_Controlled(TC));
+   end Initialize;
+ 
+   procedure Adjust    ( TC: in out Test_Limited_Controlled ) is
+   begin
+     Report.Failed("Adjust called for Test_Limited_Controlled");
+   end Adjust;
+ 
+   procedure Finalize  ( TC: in out Test_Limited_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Fin;
+   end Finalize;
+ 
+   procedure Initialize( TC: in out Nested_Limited_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Init;
+     C760002_0.Initialize(C760002_0.Root_Limited_Controlled(TC));
+   end Initialize;
+ 
+   procedure Adjust    ( TC: in out Nested_Limited_Controlled ) is
+   begin
+     Report.Failed("Adjust called for Nested_Limited_Controlled");
+   end Adjust;
+ 
+   procedure Finalize  ( TC: in out Nested_Limited_Controlled ) is
+   begin
+     TC.Last_Proc_Called := Fin;
+   end Finalize;
+ 
+ end C760002_1;
+ 
+ ---------------------------------------------------------------- C760002
+ 
+ with Report;
+ with TCTouch;
+ with C760002_0;
+ with C760002_1;
+ with Ada.Finalization;
+ procedure C760002 is
+ 
+   use type C760002_1.Proc_ID;
+ 
+   -- in the first test, test the simple cases.
+   -- Also check that assignment causes a call to Adjust for a controlled
+   -- object.  Check that assignment of a non-controlled object does not call
+   -- an Adjust procedure.
+ 
+   procedure Check_Simple_Objects is
+ 
+     A,B : C760002_0.Root;
+     S,T : C760002_1.Test_Controlled;
+     Q   : C760002_1.Test_Limited_Controlled;  -- Adjust call shouldn't happen
+   begin
+ 
+     S := T;
+ 
+     TCTouch.Assert((S.Last_Proc_Called = C760002_1.Adj),
+                    "Adjust for simple object");
+     TCTouch.Assert((S.My_ID = T.My_ID),
+                    "Assignment failed for simple object");
+ 
+     -- Check that adjust was called
+     TCTouch.Assert((S.Visit_Tag = 'A'), "Adjust timing incorrect");
+ 
+     -- Check that Adjust has not been called
+     TCTouch.Assert_Not((T.Visit_Tag = 'A'), "Adjust incorrectly called");
+ 
+     -- Check that Adjust does not get called
+     A.My_ID := A.My_ID +1;
+     B := A;  -- see: Adjust: Report.Failed
+ 
+   end Check_Simple_Objects;
+ 
+   -- in the second test, test a more complex case, check that a controlled
+   -- component of a controlled object gets processed correctly
+ 
+   procedure Check_Nested_Objects is
+     NO1 : C760002_1.Nested_Controlled;
+     NO2 : C760002_1.Nested_Controlled := NO1;
+ 
+   begin
+ 
+     -- NO2 should be flagged with adjust markers
+     TCTouch.Assert((NO2.Last_Proc_Called = C760002_1.Adj),
+                    "Adjust not called for NO2 enclosure declaration");
+     TCTouch.Assert((NO2.Nested.Visit_Tag = 'A'),
+                    "Adjust not called for NO2 enclosed declaration");
+ 
+     NO2.Visit_Tag := 'x';
+     NO2.Nested.Visit_Tag := 'y';
+ 
+     NO1 := NO2;
+ 
+     -- NO1 should be flagged with adjust markers
+     TCTouch.Assert((NO1.Visit_Tag = 'A'),
+                    "Adjust not called for NO1 enclosure declaration");
+     TCTouch.Assert((NO1.Nested.Visit_Tag = 'A'),
+                    "Adjust not called for NO1 enclosed declaration");
+ 
+   end Check_Nested_Objects;
+ 
+   procedure Check_Array_Case is
+     type Array_Simple is array(1..4) of C760002_1.Test_Controlled;
+     type Array_Nested is array(1..4) of C760002_1.Nested_Controlled;
+ 
+     Left,Right      : Array_Simple;
+     Overlap         : Array_Simple := Left;
+ 
+     Sinister,Dexter : Array_Nested;
+     Underlap        : Array_Nested := Sinister;
+ 
+     Now : Natural;
+ 
+   begin
+ 
+     -- get a current unique value since initializations
+     Now := C760002_0.Unique_Value;
+ 
+     -- check results of declarations
+     for N in 1..4 loop
+       TCTouch.Assert(Left(N).My_Id < Now,
+                      "Initialize for array initial value");
+       TCTouch.Assert(Overlap(N).My_Id < Now,
+                      "Adjust for nested array (outer) initial value");
+       TCTouch.Assert(Sinister(N).Nested.My_Id < Now,
+                      "Initialize for nested array (inner) initial value");
+       TCTouch.Assert(Sinister(N).My_Id < Sinister(N).Nested.My_Id,
+                      "Initialize for enclosure should be after enclosed");
+       TCTouch.Assert(Overlap(N).Visit_Tag = 'A',"Adjust at declaration");
+       TCTouch.Assert(Underlap(N).Nested.Visit_Tag = 'A',
+                      "Adjust at declaration, nested object");
+     end loop;
+ 
+     -- set visit tags
+     for O in 1..4 loop
+       Overlap(O).Visit_Tag         := 'X';
+       Underlap(O).Visit_Tag        := 'Y';
+       Underlap(O).Nested.Visit_Tag := 'y';
+     end loop;
+ 
+     -- check that overlapping assignments don't cause odd grief
+     Overlap(1..3)  := Overlap(2..4);
+     Underlap(2..4) := Underlap(1..3);
+ 
+     for M in 2..3 loop
+       TCTouch.Assert(Overlap(M).Last_Proc_Called = C760002_1.Adj,
+                      "Adjust for overlap");
+       TCTouch.Assert(Overlap(M).Visit_Tag = 'A',
+                      "Adjust for overlap ID");
+       TCTouch.Assert(Underlap(M).Last_Proc_Called = C760002_1.Adj,
+                      "Adjust for Underlap");
+       TCTouch.Assert(Underlap(M).Nested.Visit_Tag = 'A',
+                      "Adjust for Underlaps nested ID");
+     end loop;
+ 
+   end Check_Array_Case;
+ 
+   procedure Check_Access_Case is
+     type TC_Ref is access C760002_1.Test_Controlled;
+     type NC_Ref is access C760002_1.Nested_Controlled;
+     type TL_Ref is access C760002_1.Test_Limited_Controlled;
+     type NL_Ref is access C760002_1.Nested_Limited_Controlled;
+ 
+     A,B : TC_Ref;
+     C,D : NC_Ref;
+     E   : TL_Ref;
+     F   : NL_Ref;
+ 
+   begin
+ 
+     A := new C760002_1.Test_Controlled;
+     B := new C760002_1.Test_Controlled'( A.all );
+ 
+     C := new C760002_1.Nested_Controlled;
+     D := new C760002_1.Nested_Controlled'( C.all );
+ 
+     E := new C760002_1.Test_Limited_Controlled;
+     F := new C760002_1.Nested_Limited_Controlled;
+ 
+     TCTouch.Assert(A.Visit_Tag = 'I',"TC Allocation");
+     TCTouch.Assert(B.Visit_Tag = 'A',"TC Allocation, with value");
+ 
+     TCTouch.Assert(C.Visit_Tag = 'I',"NC Allocation");
+     TCTouch.Assert(C.Nested.Visit_Tag = 'I',"NC Allocation, Nested");
+     TCTouch.Assert(D.Visit_Tag = 'A',"NC Allocation, with value");
+     TCTouch.Assert(D.Nested.Visit_Tag = 'A',
+                    "NC Allocation, Nested, with value");
+ 
+     TCTouch.Assert(E.Visit_Tag = 'i',"TL Allocation");
+     TCTouch.Assert(F.Visit_Tag = 'i',"NL Allocation");
+ 
+     A.all := B.all;
+     C.all := D.all;
+ 
+     TCTouch.Assert(A.Visit_Tag = 'A',"TC Assignment");
+     TCTouch.Assert(C.Visit_Tag = 'A',"NC Assignment");
+     TCTouch.Assert(C.Nested.Visit_Tag = 'A',"NC Assignment, Nested");
+ 
+   end Check_Access_Case;
+ 
+   procedure Check_Access_Limited_Array_Case is
+     type Array_Simple is array(1..4) of C760002_1.Test_Limited_Controlled;
+     type AS_Ref is access Array_Simple;
+     type Array_Nested is array(1..4) of C760002_1.Nested_Limited_Controlled;
+     type AN_Ref is access Array_Nested;
+ 
+     Simple_Array_Limited : AS_Ref;
+ 
+     Nested_Array_Limited : AN_Ref;
+ 
+   begin
+ 
+     Simple_Array_Limited := new Array_Simple;
+ 
+     Nested_Array_Limited := new Array_Nested;
+     
+     for N in 1..4 loop
+       TCTouch.Assert(Simple_Array_Limited(N).Last_Proc_Called
+                      = C760002_1.Init,  
+                      "Initialize for array initial value");
+       TCTouch.Assert(Nested_Array_Limited(N).Last_Proc_Called
+                      = C760002_1.Init,
+                      "Initialize for nested array (outer) initial value");
+       TCTouch.Assert(Nested_Array_Limited(N).Nested.Visit_Tag = 'i',
+                      "Initialize for nested array (inner) initial value");
+     end loop;
+   end Check_Access_Limited_Array_Case;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C760002", "Check that assignment causes the Adjust " &
+                           "operation of the type to be called.  Check " &
+                           "that Adjust is called after copying the " &
+                           "value of the source expression to the target " &
+                           "object.  Check that Adjust is called for all " &
+                           "controlled components when the containing " &
+                           "object is assigned.  Check that Adjust is " &
+                           "called for components before the containing " &
+                           "object is adjusted.  Check that Adjust is not " &
+                           "called for a Limited_Controlled type by the " &
+                           "implementation" );
+ 
+   Check_Simple_Objects;
+ 
+   Check_Nested_Objects;
+ 
+   Check_Array_Case;
+ 
+   Check_Access_Case;
+ 
+   Check_Access_Limited_Array_Case;
+ 
+   Report.Result;
+ 
+ end C760002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,247 ----
+ -- C760007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that Adjust is called for the execution of a return
+ --      statement for a function returning a result of a (non-limited)
+ --      controlled type.
+ --
+ --      Check that Adjust is called when evaluating an aggregate
+ --      component association for a controlled component.
+ --
+ --      Check that Adjust is called for the assignment of the ancestor
+ --      expression of an extension aggregate when the type of the
+ --      aggregate is controlled.
+ --
+ -- TEST DESCRIPTION:
+ --      A type is derived from Ada.Finalization.Controlled; the dispatching
+ --      procedure Adjust is defined for the new type.  Structures and
+ --      subprograms to model the test objectives are used to check that
+ --      Adjust is called at the right time.  For the sake of simplicity,
+ --      globally accessible data is used to check that the calls are made.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 DEC 94   SAIC    ACVC 2.0
+ --      14 OCT 95   SAIC    Update and repair for ACVC 2.0.1
+ --      05 APR 96   SAIC    Add RM reference
+ --      06 NOV 96   SAIC    Reduce adjust requirement
+ --      25 NOV 97   EDS     Allowed zero calls to adjust at line 144
+ --!
+ 
+ ---------------------------------------------------------------- C760007_0
+ 
+ with Ada.Finalization;
+ package C760007_0 is
+ 
+   type Controlled is new Ada.Finalization.Controlled with record
+     TC_ID : Natural := Natural'Last;
+   end record;
+   procedure Adjust( Object: in out Controlled );
+ 
+   type Structure is record
+     Controlled_Component : Controlled;
+   end record;
+ 
+   type Child is new Controlled with record
+     TC_XX : Natural := Natural'Last;
+   end record;
+   procedure Adjust( Object: in out Child );
+ 
+   Adjust_Count       : Natural := 0;
+   Child_Adjust_Count : Natural := 0;
+ 
+ end C760007_0;
+  
+ package body C760007_0 is
+ 
+   procedure Adjust( Object: in out Controlled ) is
+   begin
+     Adjust_Count := Adjust_Count +1;
+   end Adjust;
+ 
+   procedure Adjust( Object: in out Child ) is
+   begin
+     Child_Adjust_Count := Child_Adjust_Count +1;
+   end Adjust;
+ 
+ end C760007_0;
+ 
+ ------------------------------------------------------------------ C760007
+ 
+ with Report;
+ with C760007_0;
+ procedure C760007 is
+ 
+   procedure Check_Adjust_Count(Message: String;
+                                Min: Natural := 1;
+                                Max: Natural := 2) is
+   begin
+ 
+      -- in order to allow for the anonymous objects referred to in
+      -- the reference manual, the check for calls to Adjust must be
+      -- in a range.  This number must then be further adjusted
+      -- to allow for the optimization that does not call for an adjust
+      -- of an aggregate initial value built directly in the object
+ 
+      if C760007_0.Adjust_Count not in Min..Max then
+        Report.Failed(Message
+                    & " = " & Natural'Image(C760007_0.Adjust_Count));
+      end if;
+      C760007_0.Adjust_Count := 0;
+   end Check_Adjust_Count;
+ 
+   procedure Check_Child_Adjust_Count(Message: String;
+                                      Min: Natural := 1;
+                                      Max: Natural := 2) is
+   begin
+      -- ditto above
+ 
+      if C760007_0.Child_Adjust_Count not in Min..Max then
+        Report.Failed(Message
+                    & " = " & Natural'Image(C760007_0.Child_Adjust_Count));
+      end if;
+      C760007_0.Child_Adjust_Count := 0;
+   end Check_Child_Adjust_Count;
+ 
+   Object : C760007_0.Controlled;
+ 
+ --      Check that Adjust is called for the execution of a return
+ --      statement for a function returning a result of a (non-limited)
+ --      controlled type or a result of a noncontrolled type with
+ --      controlled components.
+ 
+   procedure Subtest_1 is
+     function Create return C760007_0.Controlled is
+       New_Object : C760007_0.Controlled;
+     begin
+       return New_Object;
+     end Create;
+ 
+     procedure Examine( Thing : in C760007_0.Controlled ) is
+     begin
+       Check_Adjust_Count("Function call passed as parameter",0);
+     end Examine;
+ 
+   begin
+     -- this assignment must call Adjust:
+     --   1: on the value resulting from the function
+     --      ** unless this is optimized out by building the result directly
+     --         in the target object.
+     --   2: on Object once it's been assigned
+     -- may call adjust
+     --   1: for a anonymous object created in the evaluation of the function
+     --   2: for a anonymous object created in the assignment operation
+ 
+     Object := Create;
+ 
+     Check_Adjust_Count("Function call",1,4);
+ 
+     Examine( Create );
+ 
+   end Subtest_1;
+ 
+ --      Check that Adjust is called when evaluating an aggregate
+ --      component association for a controlled component.
+ 
+   procedure Subtest_2 is
+     S : C760007_0.Structure;
+ 
+     procedure Examine( Thing : in C760007_0.Structure ) is
+     begin
+       Check_Adjust_Count("Aggregate passed as parameter");
+     end Examine;
+ 
+   begin
+     -- this assignment must call Adjust:
+     --   1: on the value resulting from the aggregate
+     --      ** unless this is optimized out by building the result directly
+     --         in the target object.
+     --   2: on Object once it's been assigned
+     -- may call adjust
+     --   1: for a anonymous object created in the evaluation of the aggregate
+     --   2: for a anonymous object created in the assignment operation
+     S := ( Controlled_Component => Object );
+     Check_Adjust_Count("Aggregate and Assignment", 1, 4);
+ 
+     Examine( C760007_0.Structure'(Controlled_Component => Object) );
+   end Subtest_2;
+ 
+ --      Check that Adjust is called for the assignment of the ancestor
+ --      expression of an extension aggregate when the type of the
+ --      aggregate is controlled.
+ 
+   procedure Subtest_3 is
+     Bambino : C760007_0.Child;
+ 
+     procedure Examine( Thing : in C760007_0.Child ) is
+     begin
+       Check_Adjust_Count("Extension aggregate as parameter (ancestor)", 0, 2);
+       Check_Child_Adjust_Count("Extension aggregate as parameter", 0, 4);
+     end Examine;
+ 
+   begin
+     -- implementation permissions make all of the following calls to adjust
+     -- optional:
+     -- these assignments may call Adjust:
+     --   1: on the value resulting from the aggregate
+     --   2: on Object once it's been assigned
+     --   3: for a anonymous object created in the evaluation of the aggregate
+     --   4: for a anonymous object created in the assignment operation
+     Bambino := ( Object with TC_XX => 10 );
+     Check_Adjust_Count("Ancestor (expression) part of aggregate", 0, 2);
+     Check_Child_Adjust_Count("Child aggregate assignment 1", 0, 4 );
+ 
+     Bambino := ( C760007_0.Controlled with TC_XX => 11 );
+     Check_Adjust_Count("Ancestor (subtype_mark) part of aggregate", 0, 2);
+     Check_Child_Adjust_Count("Child aggregate assignment 2", 0, 4 );
+ 
+     Examine( ( Object with TC_XX => 21 ) );
+ 
+     Examine( ( C760007_0.Controlled with TC_XX => 37 ) );
+ 
+   end Subtest_3;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C760007", "Check that Adjust is called for the " &
+                           "execution of a return statement for a " &
+                           "function returning a result containing a " &
+                           "controlled type.  Check that Adjust is " &
+                           "called when evaluating an aggregate " &
+                           "component association for a controlled " &
+                           "component.  " &
+                           "Check that Adjust is called for the " &
+                           "assignment of the ancestor expression of an " &
+                           "extension aggregate when the type of the " &
+                           "aggregate is controlled" );
+ 
+   Subtest_1;
+   Subtest_2;
+   Subtest_3;
+ 
+   Report.Result;
+ 
+ end C760007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760009.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760009.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760009.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,533 ----
+ -- C760009.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that for an extension_aggregate whose ancestor_part is a
+ --      subtype_mark (i.e. Typemark'( Subtype with Field => x, etc.) )
+ --      Initialize is called on all controlled subcomponents of the
+ --      ancestor part; if the type of the ancestor part is itself controlled,
+ --      the Initialize procedure of the ancestor type is called, unless that
+ --      Initialize procedure is abstract.
+ --
+ --      Check that the utilization of a controlled type for a generic actual
+ --      parameter supports the correct behavior in the instantiated package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declares a generic package instantiated to check that controlled
+ --      types are not impacted by the "generic boundary."
+ --      This instance is then used to perform the tests of various
+ --      aggregate formations of the controlled type.  After each operation
+ --      in the main program that should cause implicit calls, the "state" of
+ --      the software is checked.  The "state" of the software is maintained in
+ --      several variables which count the calls to the Initialize, Adjust and
+ --      Finalize procedures in each context.  Given the nature of the
+ --      language rules, the test specifies a minimum number of times that
+ --      these subprograms should have been called.  The test also checks cases
+ --      where the subprograms should not have been called.
+ --     
+ --      As per the example in AARM 7.6(11a..d);6.0, the distinctions between
+ --      the presence/absence of default values is tested.
+ --
+ -- DATA STRUCTURES
+ --
+ --      C760009_3.Master_Control is derived from
+ --        C760009_2.Control is derived from
+ --          Ada.Finalization.Controlled
+ --
+ --      C760009_1.Simple_Control is derived from
+ --        Ada.Finalization.Controlled
+ --
+ --      C760009_3.Master_Control contains
+ --        Standard.Integer
+ --
+ --      C760009_2.Control contains
+ --        C760009_1.Simple_Control (default value)
+ --        C760009_1.Simple_Control (default initialized)
+ --
+ --
+ -- CHANGE HISTORY:
+ --      01 MAY 95   SAIC    Initial version
+ --      19 FEB 96   SAIC    Fixed elaboration Initialize count
+ --      14 NOV 96   SAIC    Allowed for 7.6(21) optimizations
+ --      13 FEB 97   PWB.CTA Initialized counters at lines 127-129
+ --      26 JUN 98   EDS     Added pragma Elaborate_Body to C760009_0
+ --                          to avoid possible instantiation error
+ --!
+ 
+ ---------------------------------------------------------------- C760009_0
+ 
+ with Ada.Finalization;
+ generic
+ 
+   type Private_Formal is private;
+ 
+   with procedure TC_Validate( APF: in out Private_Formal );
+ 
+ package C760009_0 is -- Check_1
+ 
+   pragma Elaborate_Body;
+   procedure TC_Check_1( APF: in     Private_Formal );
+   procedure TC_Check_2( APF:    out Private_Formal );
+   procedure TC_Check_3( APF: in out Private_Formal );
+ 
+ end C760009_0;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C760009_0 is -- Check_1
+ 
+     procedure TC_Check_1( APF: in     Private_Formal ) is
+       Local : Private_Formal;
+     begin
+       Local := APF;
+       TC_Validate( Local );
+     end TC_Check_1;
+ 
+     procedure TC_Check_2( APF:    out Private_Formal ) is
+       Local : Private_Formal;  -- initialized by virtue of actual being
+                                -- Controlled
+     begin
+       APF := Local;
+       TC_Validate( APF );
+     end TC_Check_2;
+ 
+     procedure TC_Check_3( APF: in out Private_Formal ) is
+       Local : Private_Formal;
+     begin
+       Local := APF;
+       TC_Validate( Local );
+     end TC_Check_3;
+ 
+ end C760009_0;
+  
+ ---------------------------------------------------------------- C760009_1
+ 
+ with Ada.Finalization;
+ package C760009_1 is
+ 
+   Initialize_Called : Natural := 0;
+   Adjust_Called     : Natural := 0;
+   Finalize_Called   : Natural := 0;
+ 
+   procedure Reset_Counters;
+ 
+   type Simple_Control is new Ada.Finalization.Controlled with private;
+ 
+   procedure Initialize( AV: in out Simple_Control );
+   procedure Adjust    ( AV: in out Simple_Control );
+   procedure Finalize  ( AV: in out Simple_Control );
+   procedure Validate  ( AV: in out Simple_Control );
+ 
+   function Item( AV: Simple_Control'Class ) return String;
+ 
+   Empty : constant Simple_Control;
+ 
+   procedure TC_Trace( Message: String );
+ 
+ private
+   type Simple_Control is new Ada.Finalization.Controlled with record
+     Item: Natural;
+   end record;
+ 
+   Empty : constant Simple_Control := ( Ada.Finalization.Controlled with 0 );
+ 
+ end C760009_1;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C760009_1 is
+ 
+   -- Maintenance_Mode and TC_Trace are for the test writers and compiler
+   -- developers to get more information from this test as it executes.
+   -- Maintenance_Mode is always False for validation purposes.
+ 
+   Maintenance_Mode : constant Boolean := False;
+ 
+   procedure TC_Trace( Message: String ) is
+   begin
+     if Maintenance_Mode then
+       Report.Comment( Message );
+     end if;
+   end TC_Trace;
+ 
+   procedure Reset_Counters is
+   begin
+     Initialize_Called := 0;
+     Adjust_Called     := 0;
+     Finalize_Called   := 0;
+   end Reset_Counters;
+ 
+   Master_Count : Natural := 100;  -- Help distinguish values
+ 
+   procedure Initialize( AV: in out Simple_Control ) is
+   begin
+     Initialize_Called := Initialize_Called +1;
+     AV.Item := Master_Count;
+     Master_Count := Master_Count +100;
+     TC_Trace( "Initialize _1.Simple_Control" );
+   end Initialize;
+ 
+   procedure Adjust    ( AV: in out Simple_Control ) is
+   begin
+     Adjust_Called := Adjust_Called +1;
+     AV.Item := AV.Item +1;
+     TC_Trace( "Adjust _1.Simple_Control" );
+   end Adjust;
+ 
+   procedure Finalize  ( AV: in out Simple_Control ) is
+   begin
+     Finalize_Called := Finalize_Called +1;
+     AV.Item := AV.Item +1;
+     TC_Trace( "Finalize _1.Simple_Control" );
+   end Finalize;
+ 
+   procedure Validate  ( AV: in out Simple_Control ) is
+   begin
+     Report.Failed("Attempt to Validate at Simple_Control level");
+   end Validate;
+ 
+   function Item( AV: Simple_Control'Class ) return String is
+   begin
+     return Natural'Image(AV.Item);
+   end Item;
+ 
+ end C760009_1;
+  
+ ---------------------------------------------------------------- C760009_2
+ 
+ with C760009_1;
+ with Ada.Finalization;
+ package C760009_2 is
+ 
+   type Control is new Ada.Finalization.Controlled with record
+     Element_1 : C760009_1.Simple_Control;
+     Element_2 : C760009_1.Simple_Control := C760009_1.Empty;
+   end record;
+ 
+   procedure Initialize( AV: in out Control );
+   procedure Finalize  ( AV: in out Control );
+ 
+   Initialized : Natural := 0;
+   Finalized   : Natural := 0;
+ 
+ end C760009_2;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C760009_2 is
+ 
+   procedure Initialize( AV: in out Control ) is
+   begin
+     Initialized := Initialized +1;
+     C760009_1.TC_Trace( "Initialize _2.Control" );
+   end Initialize;
+ 
+   procedure Finalize  ( AV: in out Control ) is
+   begin
+     Finalized := Finalized +1;
+     C760009_1.TC_Trace( "Finalize _2.Control" );
+   end Finalize;
+ 
+ end C760009_2;
+  
+ ---------------------------------------------------------------- C760009_3
+ 
+ with C760009_0;
+ with C760009_2;
+ package C760009_3 is
+ 
+   type Master_Control is new C760009_2.Control with record
+     Data: Integer;
+   end record;
+ 
+   procedure Initialize( AC: in out Master_Control );
+   -- calls C760009_2.Initialize
+   -- embedded data causes 1 call to C760009_1.Initialize
+ 
+   -- Adjusting operation will
+   -- make 1 call to C760009_2.Adjust 
+   -- make 2 call to C760009_1.Adjust 
+ 
+   -- Finalize operation will
+   -- make 1 call to C760009_2.Finalize 
+   -- make 2 call to C760009_1.Finalize 
+ 
+   procedure Validate( AC: in out Master_Control );
+ 
+   package Check_1 is
+     new C760009_0(Master_Control, Validate);
+ 
+ end C760009_3;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with C760009_1;
+ package body C760009_3 is
+ 
+   procedure Initialize( AC: in out Master_Control ) is
+   begin
+     AC.Data := 42;
+     C760009_2.Initialize(C760009_2.Control(AC));
+     C760009_1.TC_Trace( "Initialize Master_Control" );
+   end Initialize;
+ 
+   procedure Validate( AC: in out Master_Control ) is
+   begin
+     if AC.Data not in 0..1000 then
+       Report.Failed("C760009_3.Control did not Initialize" );
+     end if;
+   end Validate;
+ 
+ end C760009_3;
+  
+ --------------------------------------------------------------------- C760009
+ 
+ with Report;
+ with C760009_1;
+ with C760009_2;
+ with C760009_3;
+ procedure C760009 is
+ 
+   -- Comment following declaration indicates expected calls in the order:
+   -- Initialize of a C760009_2 value
+   -- Finalize   of a C760009_2 value
+   -- Initialize of a C760009_1 value
+   -- Adjust     of a C760009_1 value
+   -- Finalize   of a C760009_1 value
+ 
+   Global_Control : C760009_3.Master_Control;
+   -- 1, 0, 1, 1, 0
+ 
+   Parent_Control : C760009_2.Control;
+   -- 1, 0, 1, 1, 0
+ 
+   -- Global_Control is a derived tagged type, the parent type
+   --   of Master_Control, Control, is derived from Controlled, and contains
+   --   two components of a Controlled type, Simple_Control.  One of these
+   --   components has a default value, the other does not.
+ 
+   procedure Fail( Which: String; Expect, Got: Natural ) is
+   begin
+     Report.Failed(Which & " Expected" & Natural'Image(Expect)
+                         & " got" & Natural'Image(Got) );
+   end Fail;
+ 
+   procedure Master_Assertion( Layer_2_Inits   : Natural;
+                               Layer_2_Finals  : Natural;
+                               Layer_1_Inits   : Natural;
+                               Layer_1_Adjs    : Natural;
+                               Layer_1_Finals  : Natural;
+                               Failing_Message : String ) is
+ 
+   begin
+ 
+ 
+ 
+    if C760009_2.Initialized /= Layer_2_Inits then
+      Fail("C760009_2.Initialize " & Failing_Message,
+           Layer_2_Inits, C760009_2.Initialized );
+    end if;
+ 
+    if C760009_2.Finalized not in Layer_2_Finals..Layer_2_Finals*2 then
+      Fail("C760009_2.Finalize " & Failing_Message,
+            Layer_2_Finals, C760009_2.Finalized );
+    end if;
+ 
+    if C760009_1.Initialize_Called /= Layer_1_Inits then
+      Fail("C760009_1.Initialize " & Failing_Message,
+            Layer_1_Inits,
+           C760009_1.Initialize_Called );
+    end if;
+ 
+    if C760009_1.Adjust_Called not in Layer_1_Adjs..Layer_1_Adjs*2 then
+      Fail("C760009_1.Adjust " & Failing_Message,
+            Layer_1_Adjs, C760009_1.Adjust_Called );
+    end if;
+ 
+    if C760009_1.Finalize_Called not in Layer_1_Finals..Layer_1_Finals*2 then
+      Fail("C760009_1.Finalize " & Failing_Message,
+            Layer_1_Finals, C760009_1.Finalize_Called );
+    end if;
+ 
+    C760009_1.Reset_Counters;
+    C760009_2.Initialized := 0;
+    C760009_2.Finalized   := 0;
+ 
+   end Master_Assertion;
+ 
+   procedure Lesser_Assertion( Layer_2_Inits   : Natural;
+                               Layer_2_Finals  : Natural;
+                               Layer_1_Inits   : Natural;
+                               Layer_1_Adjs    : Natural;
+                               Layer_1_Finals  : Natural;
+                               Failing_Message : String ) is
+   begin
+ 
+ 
+    if C760009_2.Initialized > Layer_2_Inits then
+      Fail("C760009_2.Initialize " & Failing_Message,
+            Layer_2_Inits, C760009_2.Initialized );
+    end if;
+ 
+    if C760009_2.Finalized < Layer_2_Inits 
+       or C760009_2.Finalized > Layer_2_Finals*2 then
+      Fail("C760009_2.Finalize " & Failing_Message,
+            Layer_2_Finals, C760009_2.Finalized );
+    end if;
+ 
+    if C760009_1.Initialize_Called > Layer_1_Inits then
+      Fail("C760009_1.Initialize " & Failing_Message,
+            Layer_1_Inits,
+           C760009_1.Initialize_Called );
+    end if;
+ 
+    if C760009_1.Adjust_Called > Layer_1_Adjs*2 then
+      Fail("C760009_1.Adjust " & Failing_Message,
+            Layer_1_Adjs, C760009_1.Adjust_Called );
+    end if;
+ 
+    if C760009_1.Finalize_Called < Layer_1_Inits
+       or C760009_1.Finalize_Called > Layer_1_Finals*2 then
+      Fail("C760009_1.Finalize " & Failing_Message,
+            Layer_1_Finals, C760009_1.Finalize_Called );
+    end if;
+ 
+    C760009_1.Reset_Counters;
+    C760009_2.Initialized := 0;
+    C760009_2.Finalized   := 0;
+ 
+   end Lesser_Assertion;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C760009", "Check that for an extension_aggregate whose " &
+                           "ancestor_part is a subtype_mark, Initialize " &
+                           "is called on all controlled subcomponents of " &
+                           "the ancestor part.  Also check that the " &
+                           "utilization of a controlled type for a generic " &
+                           "actual parameter supports the correct behavior " &
+                           "in the instantiated software" );
+ 
+   C760009_1.TC_Trace( "=====> Case 0 <=====" );
+ 
+   C760009_1.Reset_Counters;
+   C760009_2.Initialized := 0;
+   C760009_2.Finalized   := 0;
+ 
+   C760009_3.Validate( Global_Control ); -- check that it Initialized correctly
+ 
+   C760009_1.TC_Trace( "=====> Case 1 <=====" );
+ 
+   C760009_3.Check_1.TC_Check_1( ( C760009_2.Control with Data => 1 ) );
+   Lesser_Assertion( 2, 3, 2, 3, 6, "Check_1.TC_Check_1" );
+   --                |  |  |  |  + Finalize 2 embedded in aggregate
+   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_1
+   --                |  |  |  |  + Finalize 2 embedded in local variable
+   --                |  |  |  + Adjust 2 caused by assignment in TC_Check_1
+   --                |  |  |  + Adjust at declaration in TC_Check_1
+   --                |  |  + Initialize at declaration in TC_Check_1
+   --                |  |  + Initialize of aggregate object
+   --                |  + Finalize of assignment target
+   --                |  + Finalize of local variable
+   --                |  + Finalize of aggregate object
+   --               + Initialize of aggregate object
+   --               + Initialize of local variable
+ 
+ 
+   C760009_1.TC_Trace( "=====> Case 2 <=====" );
+ 
+   C760009_3.Check_1.TC_Check_2( Global_Control );
+   Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_2" );
+   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_2
+   --                |  |  |  |  + Finalize 2 embedded in local variable
+   --                |  |  |  + Adjust 2 caused by assignment in TC_Check_2
+   --                |  |  |  + Adjust at declaration in TC_Check_2
+   --                |  |  + Initialize at declaration in TC_Check_2
+   --                |  + Finalize of assignment target
+   --                |  + Finalize of local variable
+   --               + Initialize of local variable
+ 
+ 
+   C760009_1.TC_Trace( "=====> Case 3 <=====" );
+ 
+   Global_Control := ( C760009_2.Control with Data => 2 );
+   Lesser_Assertion( 1, 1, 1, 3, 2, "Aggregate -> object" );
+   --                |  |  |  |  + Finalize 2 by assignment
+   --                |  |  |  + Adjust 2 caused by assignment
+   --                |  |  |  + Adjust in aggregate creation
+   --                |  |  + Initialize of aggregate object
+   --                |  + Finalize of assignment target
+   --               + Initialize of aggregate object
+ 
+ 
+   C760009_1.TC_Trace( "=====> Case 4 <=====" );
+ 
+   C760009_3.Check_1.TC_Check_3( Global_Control );
+   Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_3" );
+   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_3
+   --                |  |  |  |  + Finalize 2 embedded in local variable
+   --                |  |  |  + Adjust 2 at assignment in TC_Check_3
+   --                |  |  |  + Adjust in local variable creation
+   --                |  |  + Initialize of local variable in TC_Check_3
+   --                |  + Finalize of assignment target
+   --                |  + Finalize of local variable
+   --               + Initialize of local variable
+ 
+ 
+   C760009_1.TC_Trace( "=====> Case 5 <=====" );
+ 
+   Global_Control := ( Parent_Control with Data => 3 );
+   Lesser_Assertion( 1, 1, 1, 3, 2, "Object Aggregate -> object" );
+   --                |  |  |  |  + Finalize 2 by assignment
+   --                |  |  |  + Adjust 2 caused by assignment
+   --                |  |  |  + Adjust in aggregate creation
+   --                |  |  + Initialize of aggregate object
+   --                |  + Finalize of assignment target
+   --               + Initialize of aggregate object
+ 
+ 
+ 
+   C760009_1.TC_Trace( "=====> Case 6 <=====" );
+ 
+   -- perform this check a second time to make sure nothing is "remembered"
+ 
+   C760009_3.Check_1.TC_Check_3( Global_Control );
+   Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_3 second time" );
+   --                |  |  |  |  + Finalize 2 at assignment in TC_Check_3
+   --                |  |  |  |  + Finalize 2 embedded in local variable
+   --                |  |  |  + Adjust 2 at assignment in TC_Check_3
+   --                |  |  |  + Adjust in local variable creation
+   --                |  |  + Initialize of local variable in TC_Check_3
+   --                |  + Finalize of assignment target
+   --                |  + Finalize of local variable
+   --               + Initialize of local variable
+ 
+ 
+   Report.Result;
+ 
+ end C760009;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,418 ----
+ -- C760010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that explicit calls to Initialize, Adjust and Finalize
+ --      procedures that raise exceptions propagate the exception raised,
+ --      not Program_Error.  Check this for both a user defined exception
+ --      and a language defined exception.  Check that implicit calls to
+ --      initialize procedures that raise an exception propagate the
+ --      exception raised, not Program_Error;
+ --
+ --      Check that the utilization of a controlled type as the actual for
+ --      a generic formal tagged private parameter supports the correct
+ --      behavior in the instantiated software.
+ --
+ -- TEST DESCRIPTION:
+ --      Declares a generic package instantiated to check that controlled
+ --      types are not impacted by the "generic boundary."
+ --      This instance is then used to perform the tests of various calls to
+ --      the procedures.  After each operation in the main program that should
+ --      cause implicit calls where an exception is raised, the program handles
+ --      Program_Error.  After each explicit call, the program handles the
+ --      Expected_Error.  Handlers for the opposite exception are provided to
+ --      catch the obvious failure modes.  The predefined exception
+ --      Tasking_Error is used to be certain that some other reason has not
+ --      raised a predefined exception.
+ --
+ --     
+ -- DATA STRUCTURES
+ --
+ --      C760010_1.Simple_Control is derived from
+ --        Ada.Finalization.Controlled
+ --
+ --      C760010_2.Embedded_Derived is derived from C760010_1.Simple_Control
+ --        by way of generic instantiation
+ --
+ --
+ -- CHANGE HISTORY:
+ --      01 MAY 95   SAIC    Initial version
+ --      23 APR 96   SAIC    Fix visibility problem for 2.1
+ --      14 NOV 96   SAIC    Revisit for 2.1 release
+ --      26 JUN 98   EDS     Added pragma Elaborate_Body to
+ --                          package C760010_0.Check_Formal_Tagged
+ --                          to avoid possible instantiation error
+ --!
+ 
+ ---------------------------------------------------------------- C760010_0
+ 
+ package C760010_0 is
+ 
+   User_Defined_Exception : exception;
+ 
+   type Actions is ( No_Action,
+                     Init_Raise_User_Defined, Init_Raise_Standard,
+                     Adj_Raise_User_Defined,  Adj_Raise_Standard,
+                     Fin_Raise_User_Defined,  Fin_Raise_Standard );
+ 
+   Action : Actions := No_Action;
+ 
+   function Unique return Natural;
+ 
+ end C760010_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C760010_0 is
+ 
+   Value : Natural := 101;
+ 
+   function Unique return Natural is
+   begin
+     Value := Value +1;
+     return Value;
+   end Unique;
+ 
+ end C760010_0;
+ 
+ ---------------------------------------------------------------- C760010_0
+ ------------------------------------------------------ Check_Formal_Tagged
+ 
+ generic
+ 
+   type Formal_Tagged is tagged private;
+ 
+ package C760010_0.Check_Formal_Tagged is
+ 
+   pragma Elaborate_Body;
+ 
+   type Embedded_Derived is new Formal_Tagged with record
+     TC_Meaningless_Value : Natural := Unique;
+   end record;
+ 
+   procedure Initialize( ED: in out Embedded_Derived );
+   procedure Adjust    ( ED: in out Embedded_Derived );
+   procedure Finalize  ( ED: in out Embedded_Derived );
+ 
+ end C760010_0.Check_Formal_Tagged;
+ 
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C760010_0.Check_Formal_Tagged is
+ 
+ 
+   procedure Initialize( ED: in out Embedded_Derived ) is
+   begin
+     ED.TC_Meaningless_Value := Unique;
+     case Action is
+       when Init_Raise_User_Defined => raise User_Defined_Exception;
+       when Init_Raise_Standard     => raise Tasking_Error;
+       when others                  => null;
+     end case;
+   end Initialize;
+ 
+   procedure Adjust    ( ED: in out Embedded_Derived ) is
+   begin
+     ED.TC_Meaningless_Value := Unique;
+     case Action is
+       when Adj_Raise_User_Defined => raise User_Defined_Exception;
+       when Adj_Raise_Standard     => raise Tasking_Error;
+       when others                 => null;
+     end case;
+   end Adjust;
+ 
+   procedure Finalize  ( ED: in out Embedded_Derived ) is
+   begin
+     ED.TC_Meaningless_Value := Unique;
+     case Action is
+       when Fin_Raise_User_Defined => raise User_Defined_Exception;
+       when Fin_Raise_Standard     => raise Tasking_Error;
+       when others                 => null;
+     end case;
+   end Finalize;
+ 
+ end C760010_0.Check_Formal_Tagged;
+  
+ ---------------------------------------------------------------- C760010_1
+ 
+ with Ada.Finalization;
+ package C760010_1 is
+ 
+   procedure Check_Counters(Init,Adj,Fin : Natural; Message: String);
+   procedure Reset_Counters;
+ 
+   type Simple_Control is new Ada.Finalization.Controlled with record
+     Item: Integer;
+   end record;
+   procedure Initialize( AV: in out Simple_Control );
+   procedure Adjust    ( AV: in out Simple_Control );
+   procedure Finalize  ( AV: in out Simple_Control );
+ 
+ end C760010_1;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C760010_1 is
+ 
+   Initialize_Called : Natural;
+   Adjust_Called     : Natural;
+   Finalize_Called   : Natural;
+ 
+   procedure Check_Counters(Init,Adj,Fin : Natural; Message: String) is
+   begin
+     if Init /= Initialize_Called then
+       Report.Failed("Initialize mismatch " & Message);
+     end if;
+     if Adj /= Adjust_Called then
+       Report.Failed("Adjust mismatch " & Message);
+     end if;
+     if Fin /= Finalize_Called then
+       Report.Failed("Finalize mismatch " & Message);
+     end if;
+   end Check_Counters;
+ 
+   procedure Reset_Counters is
+   begin
+     Initialize_Called := 0;
+     Adjust_Called     := 0;
+     Finalize_Called   := 0;
+   end Reset_Counters;
+ 
+   procedure Initialize( AV: in out Simple_Control ) is
+   begin
+     Initialize_Called := Initialize_Called +1;
+     AV.Item := 0;
+   end Initialize;
+ 
+   procedure Adjust    ( AV: in out Simple_Control ) is
+   begin
+     Adjust_Called := Adjust_Called +1;
+     AV.Item := AV.Item +1;
+   end Adjust;
+ 
+   procedure Finalize  ( AV: in out Simple_Control ) is
+   begin
+     Finalize_Called := Finalize_Called +1;
+     AV.Item := AV.Item +1;
+   end Finalize;
+ 
+ end C760010_1;
+  
+ ---------------------------------------------------------------- C760010_2
+ 
+ with C760010_0.Check_Formal_Tagged;
+ with C760010_1;
+ package C760010_2 is
+   new C760010_0.Check_Formal_Tagged(C760010_1.Simple_Control);
+  
+ ---------------------------------------------------------------------------
+ 
+ with Report;
+ with C760010_0;
+ with C760010_1;
+ with C760010_2;
+ procedure C760010 is
+ 
+   use type C760010_0.Actions;
+ 
+   procedure Case_Failure(Message: String) is
+   begin
+     Report.Failed(Message & " for case "
+                   & C760010_0.Actions'Image(C760010_0.Action) );
+   end Case_Failure;
+ 
+   procedure Check_Implicit_Initialize is
+     Item   : C760010_2.Embedded_Derived;  -- exception here propagates to
+     Gadget : C760010_2.Embedded_Derived;  -- caller
+   begin
+     if C760010_0.Action
+        in C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard
+     then
+       Case_Failure("Anticipated exception at implicit init");
+     end if;
+     begin
+       Item := Gadget;                     -- exception here handled locally
+       if C760010_0.Action in C760010_0.Adj_Raise_User_Defined
+                                    .. C760010_0.Fin_Raise_Standard then
+         Case_Failure ("Anticipated exception at assignment");
+       end if;
+     exception
+       when Program_Error =>
+         if C760010_0.Action not in C760010_0.Adj_Raise_User_Defined
+                                    .. C760010_0.Fin_Raise_Standard then
+           Report.Failed("Program_Error in Check_Implicit_Initialize");
+         end if;
+       when Tasking_Error =>
+         Report.Failed("Tasking_Error in Check_Implicit_Initialize");
+       when C760010_0.User_Defined_Exception =>
+         Report.Failed("User_Error in Check_Implicit_Initialize");
+       when others =>
+         Report.Failed("Wrong exception Check_Implicit_Initialize");
+     end;
+   end Check_Implicit_Initialize;
+ 
+ ---------------------------------------------------------------------------
+ 
+   Global_Item : C760010_2.Embedded_Derived;
+ 
+ ---------------------------------------------------------------------------
+ 
+   procedure Check_Explicit_Initialize is
+   begin
+     begin
+       C760010_2.Initialize( Global_Item );
+     if C760010_0.Action
+        in C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard
+     then
+       Case_Failure("Anticipated exception at explicit init");
+     end if;
+     exception
+       when Program_Error =>
+         Report.Failed("Program_Error in Check_Explicit_Initialize");
+       when Tasking_Error =>
+         if C760010_0.Action /= C760010_0.Init_Raise_Standard then
+           Report.Failed("Tasking_Error in Check_Explicit_Initialize");
+         end if;
+       when C760010_0.User_Defined_Exception =>
+         if C760010_0.Action /= C760010_0.Init_Raise_User_Defined then
+           Report.Failed("User_Error in Check_Explicit_Initialize");
+         end if;
+       when others =>
+         Report.Failed("Wrong exception in Check_Explicit_Initialize");
+     end;
+   end Check_Explicit_Initialize;
+ 
+ ---------------------------------------------------------------------------
+ 
+   procedure Check_Explicit_Adjust is
+   begin
+     begin
+       C760010_2.Adjust( Global_Item );
+     if C760010_0.Action
+        in C760010_0.Adj_Raise_User_Defined..C760010_0.Adj_Raise_Standard
+     then
+       Case_Failure("Anticipated exception at explicit Adjust");
+     end if;
+     exception
+       when Program_Error =>
+         Report.Failed("Program_Error in Check_Explicit_Adjust");
+       when Tasking_Error =>
+         if C760010_0.Action /= C760010_0.Adj_Raise_Standard then
+           Report.Failed("Tasking_Error in Check_Explicit_Adjust");
+         end if;
+       when C760010_0.User_Defined_Exception =>
+         if C760010_0.Action /= C760010_0.Adj_Raise_User_Defined then
+           Report.Failed("User_Error in Check_Explicit_Adjust");
+         end if;
+       when others =>
+         Report.Failed("Wrong exception in Check_Explicit_Adjust");
+     end;
+   end Check_Explicit_Adjust;
+ 
+ ---------------------------------------------------------------------------
+ 
+   procedure Check_Explicit_Finalize is
+   begin
+     begin
+       C760010_2.Finalize( Global_Item );
+     if C760010_0.Action
+        in C760010_0.Fin_Raise_User_Defined..C760010_0.Fin_Raise_Standard
+     then
+       Case_Failure("Anticipated exception at explicit Finalize");
+     end if;
+     exception
+       when Program_Error =>
+         Report.Failed("Program_Error in Check_Explicit_Finalize");
+       when Tasking_Error =>
+         if C760010_0.Action /= C760010_0.Fin_Raise_Standard then
+           Report.Failed("Tasking_Error in Check_Explicit_Finalize");
+         end if;
+       when C760010_0.User_Defined_Exception =>
+         if C760010_0.Action /= C760010_0.Fin_Raise_User_Defined then
+           Report.Failed("User_Error in Check_Explicit_Finalize");
+         end if;
+       when others =>
+         Report.Failed("Wrong exception in Check_Explicit_Finalize");
+     end;
+   end Check_Explicit_Finalize;
+ 
+ ---------------------------------------------------------------------------
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C760010", "Check that explicit calls to finalization " &
+                           "procedures that raise exceptions propagate " &
+                           "the exception raised.  Check the utilization " &
+                           "of a controlled type as the actual for a " &
+                           "generic formal tagged private parameter" );
+ 
+   for Act in C760010_0.Actions loop
+     C760010_1.Reset_Counters;
+     C760010_0.Action := Act;
+ 
+     begin
+       Check_Implicit_Initialize;
+       if Act in
+          C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard then
+         Case_Failure("No exception at Check_Implicit_Initialize");
+       end if;
+     exception
+       when Tasking_Error =>
+         if Act /= C760010_0.Init_Raise_Standard then
+           Case_Failure("Tasking_Error at Check_Implicit_Initialize");
+         end if;
+       when C760010_0.User_Defined_Exception =>
+         if Act /= C760010_0.Init_Raise_User_Defined then
+           Case_Failure("User_Error at Check_Implicit_Initialize");
+         end if;
+       when Program_Error =>
+          -- If finalize raises an exception, all other object are finalized
+          -- first and Program_Error is raised upon leaving the master scope.
+          -- 7.6.1:14
+          if Act not in C760010_0.Fin_Raise_User_Defined..
+                        C760010_0.Fin_Raise_Standard then
+             Case_Failure("Program_Error at Check_Implicit_Initialize");
+          end if;
+       when others =>
+         Case_Failure("Wrong exception at Check_Implicit_Initialize");
+     end;
+ 
+     Check_Explicit_Initialize;
+     Check_Explicit_Adjust;
+     Check_Explicit_Finalize;
+ 
+     C760010_1.Check_Counters(0,0,0, C760010_0.Actions'Image(Act));
+ 
+   end loop;
+ 
+   -- Set to No_Action to avoid exception in finalizing Global_Item
+   C760010_0.Action := C760010_0.No_Action;
+ 
+   Report.Result;
+ 
+ end C760010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,291 ----
+ -- C760011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the anonymous objects of a controlled type associated with
+ --      function results and aggregates are finalized no later than the
+ --      end of the innermost enclosing declarative_item or statement.  Also
+ --      check this for function calls and aggregates of a noncontrolled type
+ --      with controlled components.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines a controlled type with a discriminant, the
+ --      discriminant is use as an index into a global table to indicate that
+ --      the object has been finalized.  The controlled type is used as the
+ --      component of a non-controlled type, and the non-controlled type is
+ --      used for the same set of tests.  Following is a table of the tests
+ --      performed and their associated tag character.
+ --
+ --      7.6(21) allows for the optimizations that remove these temporary
+ --      objects from ever existing.  As such this test checks that in the
+ --      case the object was initialized (the only access we have to
+ --      determining if it ever existed) it must subsequently be finalized.
+ --
+ -- CASE TABLE:
+ --      A - aggregate test, controlled
+ --      B - aggregate test, controlled
+ --      C - aggregate test, non_controlled
+ --      D - function test, controlled
+ --      E - function test, non_controlled
+ --      F - formal parameter function test, controlled
+ --      G - formal parameter aggregate test, controlled
+ --      H - formal parameter function test, non_controlled
+ --      I - formal parameter aggregate test, non_controlled
+ --
+ --      X - scratch object, not consequential to the objective
+ --      Y - scratch object, not consequential to the objective
+ --      Z - scratch object, not consequential to the objective
+ --
+ --
+ -- CHANGE HISTORY:
+ --      22 MAY 95   SAIC    Initial version
+ --      24 APR 96   SAIC    Minor doc fixes, visibility patch
+ --      14 NOV 96   SAIC    Revised for release 2.1
+ --
+ --!
+ 
+ ------------------------------------------------------------------- C760011_0
+ 
+ with Ada.Finalization;
+ package C760011_0 is
+   type Tracking_Array is array(Character range 'A'..'Z') of Boolean;
+ 
+   Initialized : Tracking_Array := (others => False);
+   Finalized   : Tracking_Array := (others => False);
+ 
+   type Controlled_Type(Tag : Character) is
+     new Ada.Finalization.Controlled with record
+       TC_Component : String(1..4) := "ACVC";
+     end record;
+   procedure Initialize( It: in out Controlled_Type );
+   procedure Finalize  ( It: in out Controlled_Type );
+   function Create(With_Tag: Character) return Controlled_Type;
+ 
+   type Non_Controlled(Tag : Character := 'Y') is record
+     Controlled_Component : Controlled_Type(Tag);
+   end record;
+   procedure Initialize( It: in out Non_Controlled );
+   procedure Finalize  ( It: in out Non_Controlled );
+   function Create(With_Tag: Character) return Non_Controlled;
+ 
+   Under_Debug : constant Boolean := False;  -- construction lines
+ 
+ end C760011_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body C760011_0 is
+ 
+   procedure Initialize( It: in out Controlled_Type ) is
+   begin
+     It.TC_Component := (others => It.Tag);
+     if It.Tag in Tracking_Array'Range then 
+       Initialized(It.Tag) := True;
+     end if;
+     if Under_Debug then
+       Report.Comment("Initializing Tag: " & It.Tag );
+     end if;
+   end Initialize;
+   
+   procedure Finalize( It: in out Controlled_Type ) is
+   begin
+     if Under_Debug then
+       Report.Comment("Finalizing for Tag: " & It.Tag );
+     end if;
+     if It.Tag in Finalized'Range then 
+       Finalized(It.Tag) := True;
+     end if;
+   end Finalize;
+ 
+   function Create(With_Tag: Character) return Controlled_Type is
+   begin
+     return Controlled_Type'(Ada.Finalization.Controlled
+                             with Tag          => With_Tag,
+                                  TC_Component => "*CON" );
+   end Create;
+ 
+   procedure Initialize( It: in out Non_Controlled ) is
+   begin
+     Report.Failed("Called Initialize for Non_Controlled");
+   end Initialize;
+   
+   procedure Finalize( It: in out Non_Controlled ) is
+   begin
+     Report.Failed("Called Finalize for Non_Controlled");
+   end Finalize;
+ 
+   function Create(With_Tag: Character) return Non_Controlled is
+   begin
+     return Non_Controlled'(Tag => With_Tag, Controlled_Component => (
+                                   Ada.Finalization.Controlled
+                                     with Tag          => With_Tag,
+                                          TC_Component => "#NON" ) );
+   end Create;
+ 
+ end C760011_0;
+ 
+ --------------------------------------------------------------------- C760011
+ 
+ with Report;
+ with TCTouch;
+ with C760011_0;
+ with Ada.Finalization; -- needed to be able to create extension aggregates
+ procedure C760011 is
+ 
+   use type C760011_0.Controlled_Type;
+   use type C760011_0.Controlled_Type'Class;
+   use type C760011_0.Non_Controlled;
+ 
+   subtype AFC is Ada.Finalization.Controlled;
+ 
+   procedure Check_Result( Tag : Character; Message : String ) is
+   -- make allowance for 7.6(21) optimizations
+   begin
+     if C760011_0.Initialized(Tag) then
+       TCTouch.Assert(C760011_0.Finalized(Tag),Message);
+     elsif C760011_0.Under_Debug then
+       Report.Comment("Optimized away: " & Tag );
+     end if;
+   end Check_Result;
+ 
+   procedure Subtest_1 is
+ 
+ 
+     procedure Subtest_1_Local_1 is
+       An_Object : C760011_0.Controlled_Type'Class
+                 := C760011_0.Controlled_Type'(AFC with 'X', "ONE*");
+                    -- initialize An_Object
+     begin
+       if C760011_0.Controlled_Type(An_Object)   
+          = C760011_0.Controlled_Type'(AFC with 'A', "ONE*") then
+         Report.Failed("Comparison bad");  -- A = X !!!
+       end if;
+     end Subtest_1_Local_1;
+     -- An_Object must be Finalized by this point.
+ 
+     procedure Subtest_1_Local_2 is
+       An_Object : C760011_0.Controlled_Type('B');
+     begin
+       An_Object := (AFC with 'B',  "TWO!" );
+       if Report.Ident_Char(An_Object.Tag) /= 'B' then
+         Report.Failed("Subtest_1_Local_2 Optimization Foil: Bad Data!");
+       end if;
+     exception
+       when others => Report.Failed("Bad controlled assignment");
+     end Subtest_1_Local_2;
+     -- An_Object must be Finalized by this point.
+ 
+     procedure Subtest_1_Local_3 is
+       An_Object : C760011_0.Non_Controlled('C');
+     begin
+       TCTouch.Assert_Not(C760011_0.Finalized('C'),
+                            "Non_Controlled declaration C");
+       An_Object := C760011_0.Non_Controlled'('C', Controlled_Component
+                                      => (AFC with 'C', "TEE!"));
+       if Report.Ident_Char(An_Object.Tag) /= 'C' then
+         Report.Failed("Subtest_1_Local_3 Optimization Foil: Bad Data!");
+       end if;
+     end Subtest_1_Local_3;
+     -- Only controlled components of An_Object must be finalized; it is an
+     -- error to call Finalize for An_Object
+ 
+   begin
+     Subtest_1_Local_1;
+     Check_Result( 'A', "Aggregate in subprogram 1" );
+ 
+     Subtest_1_Local_2;
+     Check_Result( 'B', "Aggregate in subprogram 2" );
+ 
+     Subtest_1_Local_3;
+     Check_Result( 'C', "Embedded aggregate in subprogram 3" );
+   end Subtest_1;
+ 
+ 
+   procedure Subtest_2 is
+     -- using 'Z' for both evades order issues
+     Con_Object : C760011_0.Controlled_Type('Z');
+     Non_Object : C760011_0.Non_Controlled('Z');
+   begin
+     if Report.Ident_Bool( Con_Object = C760011_0.Create('D') ) then
+       Report.Failed("Con_Object catastrophe");
+     end if;
+      -- Controlled function result should be finalized by now
+     Check_Result( 'D', "Function Result" );
+ 
+     if Report.Ident_Bool( Non_Object = C760011_0.Create('E') ) then
+       Report.Failed("Non_Object catastrophe");
+     end if;
+      -- Controlled component of function result should be finalized by now
+     Check_Result( 'E', "Function Result" );
+   end Subtest_2;
+ 
+ 
+   procedure Subtest_3(Con : in C760011_0.Controlled_Type) is
+   begin
+     if Con.Tag not in 'F'..'G' then  
+       Report.Failed("Bad value passed to subtest 3 " & Con.Tag & ' ' 
+                     & Report.Ident_Str(Con.TC_Component));
+     end if;
+   end Subtest_3;
+ 
+ 
+   procedure Subtest_4(Non : in C760011_0.Non_Controlled) is
+   begin
+     if Non.Tag not in 'H'..'I' then  
+       Report.Failed("Bad value passed to subtest 4 "
+                    & Non.Tag & ' ' 
+                    & Report.Ident_Str(Non.Controlled_Component.TC_Component));
+     end if;
+   end Subtest_4;
+ 
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C760011", "Check that anonymous objects of controlled " &
+                           "types or types containing controlled types " &
+                           "are finalized no later than the end of the " &
+                           "innermost enclosing declarative_item or " &
+                           "statement" );
+ 
+   Subtest_1;
+ 
+   Subtest_2;
+ 
+   Subtest_3(C760011_0.Create('F'));
+   Check_Result( 'F', "Function as formal F" );
+ 
+   Subtest_3(C760011_0.Controlled_Type'(AFC with 'G',"GIGI"));
+   Check_Result( 'G', "Aggregate as formal G" );
+ 
+   Subtest_4(C760011_0.Create('H'));
+   Check_Result( 'H', "Function as formal H" );
+ 
+   Subtest_4(C760011_0.Non_Controlled'('I', (AFC with 'I',"IAGO")));
+   Check_Result( 'I', "Aggregate as formal I" );
+ 
+   Report.Result;
+ 
+ end C760011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,256 ----
+ -- C760012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that record components that have per-object access discriminant
+ --      constraints are initialized in the order of their component
+ --      declarations, and after any components that are not so constrained.
+ --
+ --      Check that record components that have per-object access discriminant
+ --      constraints are finalized in the reverse order of their component
+ --      declarations, and before any components that are not so constrained.
+ --
+ -- TEST DESCRIPTION:
+ --      The type List_Item is the "container" type.  It holds two fields that
+ --      have per-object access discriminant constraints, and two fields that
+ --      are not discriminated.  These four fields are all controlled types.
+ --      A fifth field is a pointer used to maintain a linked list of these
+ --      data objects.  Each component is of a unique type which allows for
+ --      the test to simply track the order of initialization and finalization.
+ --
+ --      The types and their purpose are:
+ --        Constrained_First  - a controlled discriminated type
+ --        Constrained_Second - a controlled discriminated type
+ --        Simple_First       - a controlled type with no discriminant
+ --        Simple_Second      - a controlled type with no discriminant
+ --
+ --      The required order of operations:
+ --        Initialize
+ --          ( Simple_First | Simple_Second )   -- no "internal order" required
+ --          Constrained_First
+ --          Constrained_Second
+ --        Finalize
+ --          Constrained_Second
+ --          Constrained_First
+ --          ( Simple_First | Simple_Second )   -- must be inverse of init.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      23 MAY 95   SAIC    Initial version
+ --      02 MAY 96   SAIC    Reorganized for 2.1
+ --      05 DEC 96   SAIC    Simplified for 2.1; added init/fin ordering check
+ --      31 DEC 97   EDS     Remove references to and uses of
+ --                          Initialization_Sequence
+ --!
+ 
+ ---------------------------------------------------------------- C760012_0
+ 
+ with Ada.Finalization;
+ with Ada.Unchecked_Deallocation;
+ package C760012_0 is
+ 
+   type List_Item;
+ 
+   type List is access all List_Item;
+ 
+   package Firsts is  -- distinguish first from second
+     type Constrained_First(Container : access List_Item) is 
+            new Ada.Finalization.Limited_Controlled with null record;
+     procedure Initialize( T : in out Constrained_First );
+     procedure Finalize  ( T : in out Constrained_First );
+ 
+     type Simple_First is new Ada.Finalization.Controlled with
+       record
+         My_Init_Seq_Number : Natural;
+       end record;
+     procedure Initialize( T : in out Simple_First );
+     procedure Finalize  ( T : in out Simple_First );
+ 
+   end Firsts;
+ 
+   type Constrained_Second(Container : access List_Item) is
+          new Ada.Finalization.Limited_Controlled with null record;
+   procedure Initialize( T : in out Constrained_Second );
+   procedure Finalize  ( T : in out Constrained_Second );
+ 
+   type Simple_Second is new Ada.Finalization.Controlled with
+     record
+       My_Init_Seq_Number : Natural;
+     end record; 
+   procedure Initialize( T : in out Simple_Second );
+   procedure Finalize  ( T : in out Simple_Second );
+ 
+   -- by 3.8(18);6.0 the following type contains components constrained
+   -- by per-object expressions
+ 
+ 
+   type List_Item is new Ada.Finalization.Limited_Controlled
+     with record
+       ContentA : Firsts.Constrained_First( List_Item'Access ); -- C S
+       SimpleA  : Firsts.Simple_First;                          -- A T
+       SimpleB  : Simple_Second;                                -- A T
+       ContentB : Constrained_Second( List_Item'Access );       -- D R
+       Next     : List;                                         -- | |
+     end record;                                                -- | |
+   procedure Initialize( L : in out List_Item ); ------------------+ |
+   procedure Finalize  ( L : in out List_Item ); --------------------+
+ 
+   -- the tags are the same for SimpleA and SimpleB due to the fact that
+   -- the language does not specify an ordering with respect to this
+   -- component pair. 7.6(12) does specify the rest of the ordering.
+ 
+   procedure Deallocate is new Ada.Unchecked_Deallocation(List_Item,List);
+ 
+ end C760012_0;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body C760012_0 is
+ 
+   package body Firsts is
+ 
+     procedure Initialize( T : in out Constrained_First ) is
+     begin
+       TCTouch.Touch('C');   ----------------------------------------------- C
+     end Initialize;
+ 
+     procedure Finalize  ( T : in out Constrained_First ) is
+     begin
+       TCTouch.Touch('S');   ----------------------------------------------- S
+     end Finalize;
+ 
+     procedure Initialize( T : in out Simple_First ) is
+     begin
+       T.My_Init_Seq_Number := 0;
+       TCTouch.Touch('A');   ----------------------------------------------- A
+     end Initialize;
+ 
+     procedure Finalize  ( T : in out Simple_First ) is
+     begin
+       TCTouch.Touch('T');   ----------------------------------------------- T
+     end Finalize;
+ 
+   end Firsts;
+ 
+   procedure Initialize( T : in out Constrained_Second ) is
+   begin
+     TCTouch.Touch('D');   ------------------------------------------------- D
+   end Initialize;
+ 
+   procedure Finalize  ( T : in out Constrained_Second ) is
+   begin
+     TCTouch.Touch('R');   ------------------------------------------------- R
+   end Finalize;
+ 
+ 
+   procedure Initialize( T : in out Simple_Second ) is
+   begin
+     T.My_Init_Seq_Number := 0;
+     TCTouch.Touch('A');   ------------------------------------------------- A
+   end Initialize;
+ 
+   procedure Finalize  ( T : in out Simple_Second ) is
+   begin
+     TCTouch.Touch('T');   ------------------------------------------------- T
+   end Finalize;
+ 
+   procedure Initialize( L : in out List_Item ) is
+   begin
+     TCTouch.Touch('F');   ------------------------------------------------- F
+   end Initialize;
+ 
+   procedure Finalize  ( L : in out List_Item ) is
+   begin
+     TCTouch.Touch('Q');   ------------------------------------------------- Q
+   end Finalize;
+ 
+ end C760012_0;
+  
+ --------------------------------------------------------------------- C760012
+ 
+ with Report;
+ with TCTouch;
+ with C760012_0;
+ procedure C760012 is
+ 
+   use type C760012_0.List;
+ 
+   procedure Subtest_1 is
+   -- by 3.8(18);6.0 One_Of_Them is constrained by per-object constraints
+   -- 7.6.1(9);6.0 dictates the order of finalization of the components
+ 
+     One_Of_Them : C760012_0.List_Item;
+   begin
+     if One_Of_Them.Next /= null then  -- just to hold the subtest in place
+       Report.Failed("No default value for Next");
+     end if;
+   end Subtest_1;
+ 
+   List : C760012_0.List;
+ 
+   procedure Subtest_2 is
+   begin
+ 
+     List := new C760012_0.List_Item;
+ 
+     List.Next := new C760012_0.List_Item;
+ 
+   end Subtest_2;
+ 
+   procedure Subtest_3 is
+   begin
+ 
+     C760012_0.Deallocate( List.Next );
+ 
+     C760012_0.Deallocate( List );
+ 
+   end Subtest_3;
+   
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C760012", "Check that record components that have " &
+                           "per-object access discriminant constraints " &
+                           "are initialized in the order of their " &
+                           "component declarations, and after any " &
+                           "components that are not so constrained.  " &
+                           "Check that record components that have " &
+                           "per-object access discriminant constraints " &
+                           "are finalized in the reverse order of their " &
+                           "component declarations, and before any " &
+                           "components that are not so constrained" );
+ 
+   Subtest_1;
+   TCTouch.Validate("AACDFQRSTT", "One object");
+ 
+   Subtest_2;
+   TCTouch.Validate("AACDFAACDF", "Two objects dynamically allocated");
+ 
+   Subtest_3;
+   TCTouch.Validate("QRSTTQRSTT", "Two objects deallocated");
+ 
+   Report.Result;
+ 
+ end C760012;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c760013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c760013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C760013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that Initialize is not called for default-initialized subcomponents
+ --    of the ancestor type of an extension aggregate.  (Defect Report
+ --    8652/0021, Technical Corrigendum 7.6(11/1)).
+ --
+ -- CHANGE HISTORY:
+ --    25 JAN 2001   PHL   Initial version.
+ --    29 JUN 2001   RLB   Reformatted for ACATS.
+ --
+ --!
+ with Ada.Finalization;
+ use Ada.Finalization;
+ package C760013_0 is
+ 
+     type Ctrl1 is new Controlled with
+ 	record
+ 	    C : Integer := 0;
+ 	end record;
+     type Ctrl2 is new Controlled with
+ 	record
+ 	    C : Integer := 0;
+ 	end record;
+ 
+     procedure Initialize (Obj1 : in out Ctrl1);
+     procedure Initialize (Obj2 : in out Ctrl2);
+ 
+ end C760013_0;
+ 
+ with Report;
+ use Report;
+ package body C760013_0 is
+ 
+     procedure Initialize (Obj1 : in out Ctrl1) is
+     begin
+ 	Obj1.C := Ident_Int (47);
+     end Initialize;
+ 
+     procedure Initialize (Obj2 : in out Ctrl2) is
+     begin
+ 	Failed ("Initialize called for type Ctrl2");
+     end Initialize;
+ 
+ end C760013_0;
+ 
+ with Ada.Finalization;
+ with C760013_0;
+ use C760013_0;
+ with Report;
+ use Report;
+ procedure C760013 is
+ 
+     type T is tagged
+ 	record
+ 	    C1 : Ctrl1;
+ 	    C2 : Ctrl2 := (Ada.Finalization.Controlled with
+ 			   C => Ident_Int (23));
+ 	end record;
+ 
+     type Nt is new T with
+ 	record
+ 	    C3 : Float;
+ 	end record;
+ 
+     X : Nt;
+ 
+ begin
+     Test ("C760013",
+ 	  "Check that Initialize is not called for " &
+ 	     "default-initialized subcomponents of the ancestor type of an " &
+ 	     "extension aggregate");
+ 
+     X := (T with C3 => 5.0);
+ 
+     if X.C1.C /= Ident_Int (47) then
+ 	Failed ("Initialize not called for type Ctrl1");
+     end if;
+     if X.C2.C /= Ident_Int (23) then
+ 	Failed ("Initial value not assigned for type Ctrl2");
+     end if;
+ 
+     Result;
+ end C760013;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C761001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that controlled objects declared immediately within a library
+ --      package are finalized following the completion of the environment
+ --      task (and prior to termination of the program).
+ --
+ -- TEST DESCRIPTION:
+ --      This test derives a type from Ada.Finalization.Controlled, and
+ --      declares an object of that type in the body of a library package.
+ --      The dispatching procedure Finalize is redefined for the derived
+ --      type to perform a check that it has been called only once, and in
+ --      turn calls Report.Result.  This test may fail by not calling
+ --      Report.Result.  This test may also fail by calling Report.Result
+ --      twice, the first call will report a false pass.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      13 Nov 95   SAIC    Updated for ACVC 2.0.1
+ --
+ --!
+ 
+ with Ada.Finalization;
+ package C761001_0 is
+ 
+   type Global is new Ada.Finalization.Controlled with null record;
+   procedure Finalize( It: in out Global );
+ 
+ end C761001_0;
+ 
+ package C761001_1 is
+ 
+   task Library_Task is
+     entry Never_Called;
+   end Library_Task;
+ 
+ end C761001_1;
+ 
+ with Report;
+ with C761001_1;
+ package body C761001_0 is
+ 
+   My_Object : Global;
+ 
+   Done : Boolean := False;
+ 
+   procedure Finalize( It: in out Global ) is
+   begin
+     if not C761001_1.Library_Task'Terminated then
+       Report.Failed("Library task not terminated before finalize");
+     end if;
+     if Done then  -- checking included "just in case"
+       Report.Comment("Test FAILED, even if previously reporting passed");
+       Report.Failed("Unwarranted multiple call to finalize");
+     end if;
+     Report.Result;
+     Done := True;
+   end Finalize;
+ 
+ end C761001_0;
+ 
+ with Report;
+ package body C761001_1 is
+ 
+   task body Library_Task is
+   begin
+     if Report.Ident_Int( 1 ) /= 1 then
+       Report.Failed( "Baseline failure in Library_Task");
+     end if;
+   end Library_Task;
+ 
+ end C761001_1;
+ 
+ with Report;
+ with C761001_0;
+ 
+ procedure C761001 is
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C761001", "Check that controlled objects declared "
+                         & "immediately within a library package are "
+                         & "finalized following the completion of the "
+                         & "environment task (and prior to termination "
+                         & "of the program)");
+ 
+   -- note that if the test DOES call report twice, the first will report a
+   -- false pass, the second call will correctly fail the test.
+ 
+   -- not calling Report.Result;
+   -- Result is called as part of the finalization of C761001_0.My_Object.
+ 
+ end C761001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,245 ----
+ -- C761002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that objects of a controlled type that are created
+ --      by an allocator are finalized at the appropriate time.  In 
+ --      particular, check that such objects are not finalized due to 
+ --      completion of the master in which they were allocated if the 
+ --      corresponding access type is declared outside of that master.
+ --
+ --      Check that Unchecked_Deallocation of a controlled 
+ --      object causes finalization of that object.
+ --
+ -- TEST DESCRIPTION:
+ --      This test derives a type from Ada.Finalization.Controlled, and
+ --      declares access types to that type in various scope scenarios.
+ --      The dispatching procedure Finalize is redefined for the derived
+ --      type to perform a check that it has been called at the 
+ --      correct time.  This is accomplished using a global variable 
+ --      which indicates what state the software is currently 
+ --      executing.  The test utilizes the TCTouch facilities to 
+ --      verify that Finalize is called the correct number of times, at 
+ --      the correct times.  Several calls are made to validate passing 
+ --      the null string to check that Finalize has NOT been called at 
+ --      that point.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Ada.Finalization;
+ package C761002_0 is
+   type Global is new Ada.Finalization.Controlled with null record;
+   procedure Finalize( It: in out Global );
+   
+   type Second is new Ada.Finalization.Limited_Controlled with null record;
+   procedure Finalize( It: in out Second );
+ end C761002_0;
+ 
+ with Report;
+ with TCTouch;
+ package body C761002_0 is
+ 
+   procedure Finalize( It: in out Global ) is
+   begin
+     TCTouch.Touch('F');  ------------------------------------------------- F
+   end Finalize;
+ 
+   procedure Finalize( It: in out Second ) is
+   begin
+     TCTouch.Touch('S');  ------------------------------------------------- S
+   end Finalize;
+ end C761002_0;
+ 
+ with Report;
+ with TCTouch;
+ with C761002_0;
+ with Unchecked_Deallocation;
+ procedure C761002 is
+ 
+   -- check the straightforward case
+   procedure Subtest_1 is
+     type Access_1 is access C761002_0.Global;
+     V1 : Access_1;
+     procedure Allocate is
+       V2 : Access_1;
+     begin
+       V2 := new C761002_0.Global;
+       V1 := V2;  -- "dead" assignment must not be optimized away due to
+                  -- finalization "side effects", many more of these follow
+     end Allocate;
+   begin
+     Allocate;
+     -- no calls to Finalize should have occurred at this point
+     TCTouch.Validate("","Allocated nested, retained");
+   end Subtest_1;
+   
+   -- check Unchecked_Deallocation
+   procedure Subtest_2 is
+     type Access_2 is access C761002_0.Global;
+     procedure Free is
+               new Unchecked_Deallocation(C761002_0.Global, Access_2);
+     V1 : Access_2;
+     V2 : Access_2;
+ 
+     procedure Allocate is
+     begin
+       V1 := new C761002_0.Global;
+       V2 := new C761002_0.Global;
+     end Allocate;
+ 
+   begin
+     Allocate;
+     -- no calls to Finalize should have occurred at this point.
+     TCTouch.Validate("","Allocated nested, non-local");
+     
+     Free(V1); -- instance of Unchecked_Deallocation
+     -- should cause the finalization of V1.all
+     TCTouch.Validate("F","Unchecked Deallocation");
+   end Subtest_2; -- leaving this scope should cause the finalization of V2.all
+   
+   -- check various master-exit scenarios
+   -- the "Fake" parameters are used to avoid unwanted optimizations
+   procedure Subtest_3 is
+     procedure With_Local_Block is
+       type Access_3 is access C761002_0.Global;
+       V1 : Access_3;
+     begin
+       declare
+         V2 : Access_3 := new C761002_0.Global;
+       begin
+         V1 := V2;
+       end;
+       TCTouch.Validate("","Local Block, normal exit");
+       -- the allocated object should be finalized on leaving this scope
+     end With_Local_Block;
+     
+     procedure With_Local_Block_Return(Fake: Integer) is
+       type Access_4 is access C761002_0.Global;
+       V1 : Access_4 := new C761002_0.Global;
+     begin
+       if Fake = 0 then
+         declare
+           V2 : Access_4;
+         begin
+           V2 := new C761002_0.Global;
+           return; -- the two allocated objects should be finalized
+         end;      -- upon leaving this scope
+       else
+         V1 := null;
+       end if;
+     end With_Local_Block_Return;
+ 
+     procedure With_Goto(Fake: Integer) is
+       type Access_5 is access C761002_0.Global;
+       V1 : Access_5 := new C761002_0.Global;
+       V2 : Access_5;
+       V3 : Access_5;
+     begin
+       if Fake = 0 then
+         declare
+           type Access_6 is access C761002_0.Second;
+           V6 : Access_6;
+         begin
+           V6 := new C761002_0.Second;
+           goto check;
+         end;
+       else
+         V2 := V1;
+       end if;
+       V3 := V2;
+ <<check>>
+       TCTouch.Validate("S","goto past master end");
+      end With_Goto;
+ 
+   begin
+     With_Local_Block;
+     TCTouch.Validate("F","Local Block, normal exit, after master");
+ 
+     With_Local_Block_Return( Report.Ident_Int(0) );
+     TCTouch.Validate("FF","Local Block, return from block");
+ 
+     With_Goto( Report.Ident_Int(0) );
+     TCTouch.Validate("F","With Goto");
+ 
+   end Subtest_3;
+ 
+   procedure Subtest_4 is
+ 
+     Oops : exception;
+     
+     procedure Alley( Fake: Integer ) is
+       type Access_1 is access C761002_0.Global;
+       V1 : Access_1;
+     begin
+       V1 := new C761002_0.Global;
+       if Fake = 1 then
+         raise Oops;
+       end if;
+       V1 := null;
+     end Alley;
+   
+   begin
+     Catch: begin
+       Alley( Report.Ident_Int(1) );
+     exception
+       when Oops   => TCTouch.Validate("F","leaving via exception");
+       when others => Report.Failed("Wrong exception");
+     end Catch;
+   end Subtest_4;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C761002", "Check that objects of a controlled type created "
+                         & "by an allocator are finalized appropriately. " 
+                         & "Check that Unchecked_Deallocation of a "
+                         & "controlled object causes finalization " 
+                         & "of that object" );
+   
+   Subtest_1;
+   -- leaving the scope of the access type should finalize the 
+   -- collection
+   TCTouch.Validate("F","Allocated nested, Subtest 1");
+   
+   Subtest_2;
+   -- Unchecked_Deallocation already finalized one of the two 
+   -- objects allocated, the other should be the only one finalized 
+   -- at leaving the scope of the access type.
+   TCTouch.Validate("F","Allocated non-local");
+ 
+   Subtest_3;
+   -- there should be no remaining finalizations from this subtest
+   TCTouch.Validate("","Localized objects");
+ 
+   Subtest_4;
+   -- there should be no remaining finalizations from this subtest
+   TCTouch.Validate("","Exception testing");
+ 
+   Report.Result;
+ 
+ end C761002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,447 ----
+ -- C761003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an object of a controlled type is finalized when the
+ --      enclosing master is complete.
+ --      Check this for controlled types where the derived type has a
+ --      discriminant.
+ --      Check this for subprograms of abstract types derived from the
+ --      types in Ada.Finalization.
+ --
+ --      Check that finalization of controlled objects is
+ --      performed in the correct order.  In particular, check that if
+ --      multiple objects of controlled types are declared immediately
+ --      within the same declarative part then type are finalized in the
+ --      reverse order of their creation.
+ --
+ -- TEST DESCRIPTION:
+ --      This test checks these conditions for subprograms and
+ --      block statements; both variables and constants of controlled
+ --      types; cases of a controlled component of a record type, as
+ --      well as an array with controlled components.
+ --
+ --      The base controlled types used for the test are defined
+ --      with a character discriminant.  The initialize procedure for
+ --      the types will record the order of creation in a globally
+ --      accessible array, the finalize procedure for the types will call
+ --      TCTouch with that tag character.  The test can then check that
+ --      the order of finalization is indeed the reverse of the order of
+ --      creation (assuming that the implementation calls Initialize in
+ --      the order that the objects are created).
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      02 Nov 95   SAIC    ACVC 2.0.1
+ --
+ --!
+ 
+ ------------------------------------------------------------ C761003_Support
+ 
+ package C761003_Support is
+   
+   function Pick_Char return Character;
+   -- successive calls to Pick_Char return distinct characters which may
+   -- be assigned to objects to track an order sequence.  These characters
+   -- are then used in calls to TCTouch.Touch.
+ 
+   procedure Validate(Initcount   : Natural;
+                      Testnumber  : Natural;
+                      Check_Order : Boolean := True);
+   -- does a little extra processing prior to calling TCTouch.Validate,
+   -- specifically, it reverses the stored string of characters, and checks
+   -- for a correct count.
+ 
+   Inits_Order  : String(1..255);
+   Inits_Called : Natural := 0;
+ 
+ end C761003_Support;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with TCTouch;
+ package body C761003_Support is
+   type Pick_Rotation is mod 52;
+   type Pick_String is array(Pick_Rotation) of Character;
+ 
+   From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                 & "abcdefghijklmnopqrstuvwxyz";
+   Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
+ 
+   function Pick_Char return Character is
+   begin
+     Recent_Pick := Recent_Pick +1;
+     return From(Recent_Pick);
+   end Pick_Char;
+ 
+   function Invert(S:String) return String is
+     T: String(1..S'Length);
+   begin
+     for SI in reverse S'Range loop
+       T(S'Last - SI + 1) := S(SI);
+     end loop;
+     return T;
+   end Invert;
+ 
+   procedure Validate(Initcount   : Natural;
+                      Testnumber  : Natural;
+                      Check_Order : Boolean := True) is
+     Number : constant String := Natural'Image(Testnumber);
+   begin
+     if Inits_Called /= Initcount then
+       Report.Failed("Got" & Natural'Image(Inits_Called) & " inits, expected"
+                     & Natural'Image(Initcount) & ", Subtest " & Number);
+       TCTouch.Flush;
+     else
+       TCTouch.Validate(
+         Invert(Inits_Order(1..Inits_Called)),
+                "Subtest " & Number, Order_Meaningful => Check_Order );
+     end if;
+     Inits_Called := 0;  -- reset for the next batch
+   end Validate;
+ 
+ end C761003_Support;
+ 
+ ------------------------------------------------------------------ C761003_0
+ 
+ with Ada.Finalization;
+ package C761003_0 is
+ 
+   type Global(Tag: Character) is new Ada.Finalization.Controlled
+     with null record;
+ 
+   procedure Initialize( It: in out Global );
+   procedure Finalize  ( It: in out Global );
+ 
+   Null_Global : Global('1') := (Ada.Finalization.Controlled with Tag => '1');
+ 
+   type Second(Tag: Character) is new Ada.Finalization.Limited_Controlled
+     with null record;
+ 
+   procedure Initialize( It: in out Second );
+   procedure Finalize  ( It: in out Second );
+ 
+ end C761003_0;
+ 
+ ------------------------------------------------------------------ C761003_1
+ 
+ with Ada.Finalization;
+ package C761003_1 is
+ 
+   type Global is abstract new Ada.Finalization.Controlled with record
+     Tag: Character;
+   end record;
+ 
+   procedure Initialize( It: in out Global );
+   procedure Finalize  ( It: in out Global );
+ 
+   type Second is abstract new Ada.Finalization.Limited_Controlled with record
+     Tag: Character;
+   end record;
+ 
+   procedure Initialize( It: in out Second );
+   procedure Finalize  ( It: in out Second );
+ 
+ end C761003_1;
+ 
+ ------------------------------------------------------------------ C761003_2
+ 
+ with C761003_1;
+ package C761003_2 is
+ 
+   type Global is new C761003_1.Global with null record;
+   -- inherits Initialize and Finalize
+ 
+   type Second is new C761003_1.Second with null record;
+   -- inherits Initialize and Finalize
+ 
+ end C761003_2;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --  C761003_0
+ 
+ with TCTouch;
+ with C761003_Support;
+ package body C761003_0 is
+ 
+   package Sup renames C761003_Support;
+ 
+   procedure Initialize( It: in out Global ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+ 
+   procedure Finalize( It: in out Global ) is
+   begin
+     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+   end Finalize;
+ 
+   procedure Initialize( It: in out Second ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+ 
+   procedure Finalize( It: in out Second ) is
+   begin
+     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+   end Finalize;
+ 
+ end C761003_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --  C761003_1
+ 
+ with TCTouch;
+ with C761003_Support;
+ package body C761003_1 is
+ 
+   package Sup renames C761003_Support;
+ 
+   procedure Initialize( It: in out Global ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     It.Tag := Sup.Pick_Char;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+ 
+   procedure Finalize( It: in out Global ) is
+   begin
+     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+   end Finalize;
+ 
+   procedure Initialize( It: in out Second ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     It.Tag := Sup.Pick_Char;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+ 
+   procedure Finalize( It: in out Second ) is
+   begin
+     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+   end Finalize;
+ 
+ end C761003_1;
+ 
+ -------------------------------------------------------------------- C761003
+ 
+ with Report;
+ with TCTouch;
+ with C761003_0;
+ with C761003_2;
+ with C761003_Support;
+ procedure C761003 is
+ 
+   package Sup renames C761003_Support;
+ 
+ ---------------------------------------------------------------- Subtest_1
+ 
+   Subtest_1_Inits_Expected : constant := 5;  -- includes 1 previous
+ 
+   procedure Subtest_1 is
+ 
+     -- the constant will take its constraint from the value.
+     -- must be declared first to be finalized last (and take the
+     -- initialize from before calling subtest_1)
+     Item_1 : constant C761003_0.Global := C761003_0.Null_Global;
+ 
+     -- Item_2, declared second, should be finalized second to last.
+     Item_2 : C761003_0.Global(Sup.Pick_Char);
+ 
+     -- Item_3 and Item_4 will be created in the order of the
+     -- list.
+     Item_3, Item_4 : C761003_0.Global(Sup.Pick_Char);
+ 
+    -- Item_5 will be finalized first.
+     Item_5 : C761003_0.Second(Sup.Pick_Char);
+ 
+   begin
+     if Item_3.Tag >= Item_4.Tag then
+       Report.Failed("Controlled objects created by list in wrong order");
+     end if;
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 1 body");
+   end Subtest_1;
+ 
+ ---------------------------------------------------------------- Subtest_2
+ 
+   -- These declarations should cause calls to initialize and
+   -- finalize.  The expected operations are the subprograms associated
+   -- with the abstract types.  Note that for these objects, the
+   -- Initialize and Finalize are visible only by inheritance.
+ 
+   Subtest_2_Inits_Expected : constant := 4;
+ 
+   procedure Subtest_2 is
+ 
+     Item_1 : C761003_2.Global;
+     Item_2, Item_3 : C761003_2.Global;
+     Item_4 : C761003_2.Second;
+ 
+   begin
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 2 body");
+   end Subtest_2;
+ 
+ ---------------------------------------------------------------- Subtest_3
+ 
+   -- Test for controlled objects embedded in arrays.  Using structures
+   -- that will cause a checkable order.
+ 
+   Subtest_3_Inits_Expected : constant := 8;
+ 
+   procedure Subtest_3 is
+ 
+     type Global_List is array(Natural range <>)
+                           of C761003_0.Global(Sup.Pick_Char);
+ 
+     Items : Global_List(1..4);  -- components have the same tag
+ 
+     type Second_List is array(Natural range <>)
+                           of C761003_0.Second(Sup.Pick_Char);
+ 
+     Second_Items : Second_List(1..4);  -- components have the same tag,
+                                        -- distinct from the tag used in Items
+ 
+   begin
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 3 body");
+   end Subtest_3;
+ 
+ ---------------------------------------------------------------- Subtest_4
+ 
+   -- These declarations should cause dispatching calls to initialize and
+   -- finalize.  The expected operations are the subprograms associated
+   -- with the abstract types.
+ 
+   Subtest_4_Inits_Expected : constant := 2;
+ 
+   procedure Subtest_4 is
+ 
+     type Global_Rec is record
+       Item1: C761003_0.Global(Sup.Pick_Char);
+     end record;
+ 
+     type Second_Rec is record
+       Item2: C761003_2.Second;
+     end record;
+ 
+     G : Global_Rec;
+     S : Second_Rec;
+ 
+   begin
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 4 body");
+   end Subtest_4;
+ 
+ ---------------------------------------------------------------- Subtest_5
+ 
+   -- Test for controlled objects embedded in arrays.  In these cases, the
+   -- order of the finalization of the components is not defined by the
+   -- language.
+ 
+   Subtest_5_Inits_Expected : constant := 8;
+ 
+   procedure Subtest_5 is
+ 
+ 
+     type Another_Global_List is array(Natural range <>)
+                           of C761003_2.Global;
+ 
+     More_Items : Another_Global_List(1..4);
+ 
+     type Another_Second_List is array(Natural range <>)
+                           of C761003_2.Second;
+ 
+     Second_More_Items : Another_Second_List(1..4);
+ 
+   begin
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 5 body");
+   end Subtest_5;
+ 
+ ---------------------------------------------------------------- Subtest_6
+ 
+   -- These declarations should cause dispatching calls to initialize and
+   -- finalize.  The expected operations are the subprograms associated
+   -- with the abstract types.
+ 
+   Subtest_6_Inits_Expected : constant := 2;
+ 
+   procedure Subtest_6 is
+ 
+     type Global_Rec is record
+      Item2: C761003_2.Global;
+     end record;
+ 
+     type Second_Rec is record
+       Item1: C761003_0.Second(Sup.Pick_Char);
+    end record;
+ 
+     G : Global_Rec;
+     S : Second_Rec;
+ 
+   begin
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 6 body");
+   end Subtest_6;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C761003", "Check that an object of a controlled type "
+                         & "is finalized when the enclosing master is "
+                         & "complete, left by a transfer of control, "
+                         & "and performed in the correct order" );
+ 
+   -- adjust for optional adjusts and initializes for C761003_0.Null_Global
+   TCTouch.Flush; -- clear the optional adjust
+   if Sup.Inits_Called /= 1 then
+     -- C761003_0.Null_Global did not get "initialized"
+     C761003_0.Initialize(C761003_0.Null_Global);  -- prime the pump
+   end if;
+ 
+   Subtest_1;
+   Sup.Validate(Subtest_1_Inits_Expected, 1);
+ 
+   Subtest_2;
+   Sup.Validate(Subtest_2_Inits_Expected, 2);
+ 
+   Subtest_3;
+   Sup.Validate(Subtest_3_Inits_Expected, 3);
+ 
+   Subtest_4;
+   Sup.Validate(Subtest_4_Inits_Expected, 4);
+ 
+   Subtest_5;
+   Sup.Validate(Subtest_5_Inits_Expected, 5, Check_Order => False);
+ 
+   Subtest_6;
+   Sup.Validate(Subtest_6_Inits_Expected, 6);
+ 
+   Report.Result;
+ 
+ end C761003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,305 ----
+ -- C761004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an object of a controlled type is finalized with the
+ --      enclosing master is complete.
+ --      Check that finalization occurs in the case where the master is
+ --      left by a transfer of control.
+ --      Specifically check for types where the derived types do not have
+ --      discriminants.
+ --      
+ --      Check that finalization of controlled objects is 
+ --      performed in the correct order.  In particular, check that if 
+ --      multiple objects of controlled types are declared immediately 
+ --      within the same declarative part then they are finalized in the 
+ --      reverse order of their creation.
+ --
+ -- TEST DESCRIPTION:
+ --      This test checks these conditions for subprograms and 
+ --      block statements; both variables and constants of controlled 
+ --      types; cases of a controlled component of a record type, as 
+ --      well as an array with controlled components.
+ --
+ --      The base controlled types used for the test are defined 
+ --      with a character discriminant.  The initialize procedure for 
+ --      the types will record the order of creation in a globally 
+ --      accessible array, the finalize procedure for the types will call
+ --      TCTouch with that tag character.  The test can then check that 
+ --      the order of finalization is indeed the reverse of the order of 
+ --      creation (assuming that the implementation calls Initialize in 
+ --      the order that the objects are created).
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1
+ --
+ --! 
+ 
+ package C761004_Support is
+   
+   function Pick_Char return Character;
+   -- successive calls to Pick_Char return distinct characters which may
+   -- be assigned to objects to track an order sequence.  These characters
+   -- are then used in calls to TCTouch.Touch.
+ 
+   procedure Validate(Initcount: Natural; Testnumber:Natural);
+   -- does a little extra processing prior to calling TCTouch.Validate,
+   -- specifically, it reverses the stored string of characters, and checks
+   -- for a correct count.
+ 
+   Inits_Order  : String(1..255);
+   Inits_Called : Natural := 0;
+ 
+ end C761004_Support;
+ 
+ with Report;
+ with TCTouch;
+ package body C761004_Support is
+   type Pick_Rotation is mod 52;
+   type Pick_String is array(Pick_Rotation) of Character;
+ 
+   From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                 & "abcdefghijklmnopqrstuvwxyz";
+   Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
+ 
+   function Pick_Char return Character is
+   begin
+     Recent_Pick := Recent_Pick +1;
+     return From(Recent_Pick);
+   end Pick_Char;
+ 
+   function Invert(S:String) return String is
+     T: String(1..S'Length);
+     TI: Positive := 1;
+   begin
+     for SI in reverse S'Range loop
+       T(TI) := S(SI);
+       TI := TI +1;
+     end loop;
+     return T;
+   end Invert;
+ 
+   procedure Validate(Initcount: Natural; Testnumber:Natural) is
+     Number : constant String := Natural'Image(Testnumber);
+   begin
+     if Inits_Called /= Initcount then
+       Report.Failed("Wrong number of inits, Subtest " & Number);
+       TCTouch.Flush;
+     else
+       TCTouch.Validate(
+         Invert(Inits_Order(1..Inits_Called)),
+                "Subtest " & Number, True);
+     end if;
+   end Validate;
+ 
+ end C761004_Support;
+ 
+ ----------------------------------------------------------------- C761004_0
+ 
+ with Ada.Finalization;
+ package C761004_0 is
+   type Global is new Ada.Finalization.Controlled with record
+     Tag : Character;
+   end record;
+   procedure Initialize( It: in out Global );
+   procedure Finalize  ( It: in out Global );
+ 
+   type Second is new Ada.Finalization.Limited_Controlled with record
+     Tag : Character;
+   end record;
+   procedure Initialize( It: in out Second );
+   procedure Finalize  ( It: in out Second );
+ 
+ end C761004_0;
+ 
+ with TCTouch;
+ with C761004_Support;
+ package body C761004_0 is
+   
+   package Sup renames C761004_Support;
+ 
+   procedure Initialize( It: in out Global ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     It.Tag := Sup.Pick_Char;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+   
+   procedure Finalize( It: in out Global ) is
+   begin
+     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+   end Finalize;
+ 
+   procedure Initialize( It: in out Second ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     It.Tag := Sup.Pick_Char;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+   
+   procedure Finalize( It: in out Second ) is
+   begin
+     TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+   end Finalize;
+ end C761004_0;
+ 
+ ------------------------------------------------------------------- C761004
+ 
+ with Report;
+ with TCTouch;
+ with C761004_0;
+ with C761004_Support;
+ with Ada.Finalization; -- needed to be able to create extension aggregates
+ procedure C761004 is
+ 
+   Verbose : constant Boolean := False;
+ 
+   package Sup renames C761004_Support;
+ 
+   -- Subtest 1, general case.  Check that several objects declared in a
+   -- subprogram are created, and finalized in opposite order.
+ 
+   Subtest_1_Expected_Inits : constant := 3;
+ 
+   procedure Subtest_1 is
+     Item_1 : C761004_0.Global;
+     Item_2, Item_3 : C761004_0.Global;
+  begin
+     if Item_2.Tag = Item_3.Tag then  -- not germane to the test
+       Report.Failed("Duplicate tag");-- but helps prevent code elimination
+     end if;
+   end Subtest_1;
+ 
+   -- Subtest 2, extension of the general case.  Check that several objects
+   -- created identically on the stack (via a recursive procedure) are
+   -- finalized in the opposite order of their creation.
+   Subtest_2_Expected_Inits : constant := 12;
+   User_Exception : exception;
+   
+   procedure Subtest_2 is
+     
+     Item_1 : C761004_0.Global;
+ 
+     -- combine recursion and exit by exception:
+ 
+     procedure Nested(Recurs: Natural) is
+       Item_3 : C761004_0.Global;
+     begin
+       if Verbose then
+         Report.Comment("going in: " & Item_3.Tag);
+       end if;
+       if Recurs = 1 then
+         raise User_Exception;
+       else
+         Nested(Recurs -1);
+       end if;
+     end Nested;
+     
+     Item_2 : C761004_0.Global;
+   
+   begin
+     Nested(10);
+   end Subtest_2;
+ 
+   -- subtest 3, check the case of objects embedded in structures:
+   -- an array
+   -- a record
+   Subtest_3_Expected_Inits : constant := 3;
+   procedure Subtest_3 is
+     type G_List is array(Positive range <>) of C761004_0.Global;
+     type Pandoras_Box is record
+       G : G_List(1..1);
+     end record;
+ 
+     procedure Nested(Recursions: Natural) is
+       Merlin : Pandoras_Box;
+     begin
+       if Recursions > 1 then
+         Nested(Recursions-1);
+       else
+         TCTouch.Validate("","Final Nested call");
+       end if;
+     end Nested;
+ 
+   begin
+     Nested(3);
+   end Subtest_3;
+ 
+   -- subtest 4, check the case of objects embedded in structures:
+   -- an array
+   -- a record
+   Subtest_4_Expected_Inits : constant := 3;
+   procedure Subtest_4 is
+     type S_List is array(Positive range <>) of C761004_0.Second;
+     type Pandoras_Box is record
+       S : S_List(1..1);
+     end record;
+ 
+     procedure Nested(Recursions: Natural) is
+       Merlin : Pandoras_Box;
+     begin
+       if Recursions > 1 then
+         Nested(Recursions-1);
+       else
+         TCTouch.Validate("","Final Nested call");
+       end if;
+     end Nested;
+ 
+   begin
+     Nested(3);
+   end Subtest_4;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C761004", "Check that an object of a controlled type "
+                         & "is finalized when the enclosing master is "
+                         & "complete, left by a transfer of control, "
+                         & "and performed in the correct order" );
+ 
+   Subtest_1;
+   Sup.Validate(Subtest_1_Expected_Inits,1); 
+ 
+   Subtest_2_Frame: begin
+     Sup.Inits_Called := 0;
+     Subtest_2;
+   exception           
+     when User_Exception => null;
+     when others => Report.Failed("Wrong Exception, Subtest 2");
+   end Subtest_2_Frame;
+   Sup.Validate(Subtest_2_Expected_Inits,2);
+   
+   Sup.Inits_Called := 0;
+   Subtest_3;
+   Sup.Validate(Subtest_3_Expected_Inits,3);
+   
+   Sup.Inits_Called := 0;
+   Subtest_4;
+   Sup.Validate(Subtest_4_Expected_Inits,4);
+   
+   Report.Result;
+ 
+ end C761004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,288 ----
+ -- C761005.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that deriving abstract types from the types in Ada.Finalization
+ --      does not negatively impact the implicit operations.
+ --      Check that an object of a controlled type is finalized when the
+ --      enclosing master is complete.
+ --      Check that finalization occurs in the case where the master is
+ --      left by a transfer of control.
+ --      Check this for controlled types where the derived type has a
+ --      discriminant.
+ --      Check this for cases where the type is defined as private,  
+ --      and the full type is derived from the types in Ada.Finalization.
+ --      
+ --      Check that finalization of controlled objects is 
+ --      performed in the correct order.  In particular, check that if 
+ --      multiple objects of controlled types are declared immediately 
+ --      within the same declarative part then type are finalized in the 
+ --      reverse order of their creation.
+ --
+ -- TEST DESCRIPTION:
+ --      This test checks these conditions for subprograms and 
+ --      block statements; both variables and constants of controlled 
+ --      types; cases of a controlled component of a record type, as 
+ --      well as an array with controlled components.
+ --
+ --      The base controlled types used for the test are defined 
+ --      with a character discriminant.  The initialize procedure for 
+ --      the types will record the order of creation in a globally 
+ --      accessible array, the finalize procedure for the types will call
+ --      TCTouch with that tag character.  The test can then check that 
+ --      the order of finalization is indeed the reverse of the order of 
+ --      creation (assuming that the implementation calls Initialize in 
+ --      the order that the objects are created).
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      10 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+ --
+ --!
+ 
+ package C761005_Support is  
+   
+   function Pick_Char return Character;
+   procedure Validate(Initcount: Natural; Testnumber:Natural);
+ 
+   Inits_Order  : String(1..255);
+   Inits_Called : Natural := 0;
+ 
+ end C761005_Support;
+ 
+ with Report;
+ with TCTouch;
+ package body C761005_Support is
+   type Pick_Rotation is mod 52;
+   type Pick_String is array(Pick_Rotation) of Character;
+ 
+   From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                 & "abcdefghijklmnopqrstuvwxyz";
+   Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
+ 
+   function Pick_Char return Character is
+   begin
+     Recent_Pick := Recent_Pick +1;
+     return From(Recent_Pick);
+   end Pick_Char;
+ 
+   function Invert(S:String) return String is
+     T: String(1..S'Length);
+     TI: Positive := 1;
+   begin
+     for SI in reverse S'Range loop
+       T(TI) := S(SI);
+       TI := TI +1;
+     end loop;
+     return T;
+   end Invert;
+ 
+   procedure Validate(Initcount: Natural; Testnumber:Natural) is
+     Number : constant String := Natural'Image(Testnumber);
+   begin
+     if Inits_Called /= Initcount then
+       Report.Failed("Wrong number of inits, Subtest " & Number);
+     else
+       TCTouch.Validate(
+         Invert(Inits_Order(1..Inits_Called)),
+                "Subtest " & Number, True);
+     end if;
+     Inits_Called := 0;
+   end Validate;
+ 
+ end C761005_Support;
+ 
+ -----------------------------------------------------------------------------
+ with Ada.Finalization;
+ package C761005_0 is
+   type Final_Root(Tag: Character) is private;
+ 
+   type Ltd_Final_Root(Tag: Character) is limited private; 
+   
+   Inits_Order  : String(1..255);
+   Inits_Called : Natural := 0;
+ private
+   type Final_Root(Tag: Character) is new Ada.Finalization.Controlled 
+     with null record;
+   procedure Initialize( It: in out Final_Root );
+   procedure Finalize  ( It: in out Final_Root );
+   
+   type Ltd_Final_Root(Tag: Character) is new
+ Ada.Finalization.Limited_Controlled 
+     with null record;
+   procedure Initialize( It: in out Ltd_Final_Root );
+   procedure Finalize  ( It: in out Ltd_Final_Root );
+ end C761005_0;
+ 
+ -----------------------------------------------------------------------------
+ with Ada.Finalization;
+ package C761005_1 is
+   type Final_Abstract is abstract tagged private;
+ 
+   type Ltd_Final_Abstract_Child is abstract tagged limited private;
+   
+   Inits_Order  : String(1..255);
+   Inits_Called : Natural := 0;
+ 
+ private
+   type Final_Abstract is abstract new Ada.Finalization.Controlled with record
+     Tag: Character;
+   end record;
+   procedure Initialize( It: in out Final_Abstract );
+   procedure Finalize  ( It: in out Final_Abstract );
+ 
+   type Ltd_Final_Abstract_Child is
+        abstract new Ada.Finalization.Limited_Controlled with record
+     Tag: Character;
+   end record;
+   procedure Initialize( It: in out Ltd_Final_Abstract_Child );
+   procedure Finalize  ( It: in out Ltd_Final_Abstract_Child );
+ 
+ end C761005_1;
+ 
+ -----------------------------------------------------------------------------
+ with C761005_1;
+ package C761005_2 is
+   
+   type Final_Child is new C761005_1.Final_Abstract with null record;
+   type Ltd_Final_Child is
+        new C761005_1.Ltd_Final_Abstract_Child with null record;
+ 
+ end C761005_2;
+ 
+ -----------------------------------------------------------------------------
+ with Report;        
+ with TCTouch;
+ with C761005_Support;
+ package body C761005_0 is
+ 
+   package Sup renames C761005_Support;
+ 
+   procedure Initialize( It: in out Final_Root ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+   
+   procedure Finalize( It: in out Final_Root ) is
+   begin
+     TCTouch.Touch(It.Tag);
+   end Finalize;
+ 
+   procedure Initialize( It: in out Ltd_Final_Root ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+   
+   procedure Finalize( It: in out Ltd_Final_Root ) is
+   begin
+     TCTouch.Touch(It.Tag);
+   end Finalize;
+ end C761005_0;
+ 
+ -----------------------------------------------------------------------------
+ with Report;        
+ with TCTouch;
+ with C761005_Support;
+ package body C761005_1 is
+ 
+   package Sup renames C761005_Support;
+ 
+   procedure Initialize( It: in out Final_Abstract ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     It.Tag := Sup.Pick_Char;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+   
+   procedure Finalize( It: in out Final_Abstract ) is
+   begin
+     TCTouch.Touch(It.Tag);
+   end Finalize;
+ 
+   procedure Initialize( It: in out Ltd_Final_Abstract_Child ) is
+   begin
+     Sup.Inits_Called := Sup.Inits_Called +1;
+     It.Tag := Sup.Pick_Char;
+     Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+   end Initialize;
+   
+   procedure Finalize( It: in out Ltd_Final_Abstract_Child ) is
+   begin
+     TCTouch.Touch(It.Tag);
+   end Finalize;
+ end C761005_1;
+ 
+ -----------------------------------------------------------------------------
+ with Report;
+ with TCTouch;
+ with C761005_0;
+ with C761005_2;
+ with C761005_Support;
+ procedure C761005 is
+ 
+   package Sup renames C761005_Support;
+ 
+   Subtest_1_Inits_Expected : constant := 4;
+   procedure Subtest_1 is
+     Item_1 : C761005_0.Final_Root(Sup.Pick_Char);
+     Item_2, Item_3 : C761005_0.Final_Root(Sup.Pick_Char);
+     Item_4 : C761005_0.Ltd_Final_Root(Sup.Pick_Char);
+   begin
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 1 body");
+   end Subtest_1;
+ 
+   -- These declarations should cause calls to initialize and
+   -- finalize.  The expected operations are the subprograms associated
+   -- with the abstract types.
+   Subtest_2_Inits_Expected : constant := 4;
+   procedure Subtest_2 is
+     Item_1 : C761005_2.Final_Child;
+     Item_2, Item_3 : C761005_2.Final_Child;
+     Item_4 : C761005_2.Ltd_Final_Child;
+   begin
+     -- check that nothing has happened yet!
+     TCTouch.Validate("","Subtest 2 body");
+   end Subtest_2;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C761005", "Check that an object of a controlled type "
+                         & "is finalized when the enclosing master is "
+                         & "complete, left by a transfer of control, "
+                         & "and performed in the correct order" );
+ 
+   Subtest_1;
+   Sup.Validate(Subtest_1_Inits_Expected,1); 
+   
+   Subtest_2;
+   Sup.Validate(Subtest_2_Inits_Expected,2);
+ 
+   Report.Result;
+ 
+ end C761005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,446 ----
+ -- C761006.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that Program_Error is raised when:
+ --        * an exception is raised if Finalize invoked as part of an
+ --          assignment operation; or
+ --        * an exception is raised if Adjust invoked as part of an assignment
+ --          operation, after any other adjustment due to be performed are
+ --          performed; or
+ --        * an exception is raised if Finalize invoked as part of a call on
+ --          Unchecked_Deallocation, after any other finalizations to be
+ --          performed are performed.
+ --
+ -- TEST DESCRIPTION:
+ --      This test defines these four controlled types:
+ --        Good
+ --        Bad_Initialize
+ --        Bad_Adjust
+ --        Bad_Finalize
+ --      The type name conveys the associated failure.  The operations in type
+ --      good will "touch" the boolean array indicating correct path
+ --      utilization for the purposes of checking "other <operations> are
+ --      performed", where <operations> ::= initialization, adjusting, and
+ --      finalization
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      12 APR 94   SAIC   Initial version
+ --      02 MAY 96   SAIC   Visibility fixed for 2.1
+ --      13 FEB 97   PWB.CTA Corrected value of Events_Occurring at line 286
+ --      01 DEC 97   EDS    Made correction wrt RM 7.6(21)
+ --      16 MAR 01   RLB    Corrected Adjust cases to avoid problems with
+ --                         RM 7.6.1(16/1) from Technical Corrigendum 1.
+ --      05 JUL 12   RLB    Redid Unchecked_Deallocation case to handle
+ --                         the fact that the behavior is unspecified (see
+ --                         AI95-0179-1). Also fixed indentation.
+ --
+ --!
+ 
+ ------------------------------------------------------------- C761006_Support
+ 
+ package C761006_Support is
+ 
+   type Events is ( Good_Initialize, Good_Adjust, Good_Finalize );
+ 
+   type Event_Array is array(Events) of Boolean;
+ 
+   Events_Occurring : Event_Array := (others => False);
+ 
+   Propagating_Exception : exception;
+ 
+   procedure Raise_Propagating_Exception(Do_It: Boolean);
+ 
+   function Unique_Value return Natural;
+ 
+ end C761006_Support;
+ 
+ ------------------------------------------------------------- C761006_Support
+ 
+ with Report;
+ package body C761006_Support is
+ 
+   procedure Raise_Propagating_Exception(Do_It: Boolean) is
+   begin
+      if Report.Ident_Bool(Do_It) then
+        raise Propagating_Exception;
+      end if;
+   end Raise_Propagating_Exception;
+ 
+   Seed : Natural := 0;
+ 
+   function Unique_Value return Natural is
+   begin
+     Seed := Seed +1;
+     return Seed;
+   end Unique_Value;
+ 
+ end C761006_Support;
+ 
+ ------------------------------------------------------------------- C761006_0
+ 
+ with Ada.Finalization;
+ with C761006_Support;
+ package C761006_0 is
+ 
+   type Good is new Ada.Finalization.Controlled
+     with record
+       Initialized : Boolean := False;
+       Adjusted    : Boolean := False;
+       Unique      : Natural := C761006_Support.Unique_Value;
+     end record;
+ 
+   procedure Initialize( It: in out Good );
+   procedure Adjust    ( It: in out Good );
+   procedure Finalize  ( It: in out Good );
+ 
+   type Bad_Initialize is private;
+ 
+   type Bad_Adjust     is private;
+ 
+   type Bad_Finalize   is private;
+ 
+   Inits_Order  : String(1..255);
+   Inits_Called : Natural := 0;
+ private
+   type Bad_Initialize is new Ada.Finalization.Controlled
+                                              with null record;
+   procedure Initialize( It: in out Bad_Initialize );
+ 
+   type Bad_Adjust is new Ada.Finalization.Controlled
+                                          with null record;
+   procedure Adjust    ( It: in out Bad_Adjust );
+ 
+   type Bad_Finalize is
+        new Ada.Finalization.Controlled with null record;
+   procedure Finalize  ( It: in out Bad_Finalize );
+ end C761006_0;
+ 
+ ------------------------------------------------------------------- C761006_1
+ 
+ with Ada.Finalization;
+ with C761006_0;
+ package C761006_1 is
+ 
+   type Init_Check_Root is new Ada.Finalization.Controlled with record
+     Good_Component : C761006_0.Good;
+     Init_Fails     : C761006_0.Bad_Initialize;
+   end record;
+ 
+   type Adj_Check_Root is new Ada.Finalization.Controlled with record
+     Good_Component : C761006_0.Good;
+     Adj_Fails      : C761006_0.Bad_Adjust;
+   end record;
+ 
+   type Fin_Check_Root is new Ada.Finalization.Controlled with record
+     Good_Component : C761006_0.Good;
+     Fin_Fails      : C761006_0.Bad_Finalize;
+   end record;
+ 
+ end C761006_1;
+ 
+ ------------------------------------------------------------------- C761006_2
+ 
+ with C761006_1;
+ package C761006_2 is
+ 
+   type Init_Check is new C761006_1.Init_Check_Root with null record;
+   type Adj_Check is  new C761006_1.Adj_Check_Root  with null record;
+   type Fin_Check is  new C761006_1.Fin_Check_Root  with null record;
+ 
+ end C761006_2;
+ 
+ ------------------------------------------------------------------- C761006_0
+ 
+ with Report;
+ with C761006_Support;
+ package body C761006_0 is
+ 
+   package Sup renames C761006_Support;
+ 
+   procedure Initialize( It: in out Good ) is
+   begin
+     Sup.Events_Occurring( Sup.Good_Initialize ) := True;
+     It.Initialized := True;
+   end Initialize;
+ 
+   procedure Adjust    ( It: in out Good ) is
+   begin
+     Sup.Events_Occurring( Sup.Good_Adjust ) := True;
+     It.Adjusted := True;
+     It.Unique := C761006_Support.Unique_Value;
+   end Adjust;
+ 
+   procedure Finalize  ( It: in out Good ) is
+   begin
+     Sup.Events_Occurring( Sup.Good_Finalize ) := True;
+   end Finalize;
+ 
+   procedure Initialize( It: in out Bad_Initialize ) is
+   begin
+     Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
+   end Initialize;
+ 
+   procedure Adjust( It: in out Bad_Adjust ) is
+   begin
+     Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
+   end Adjust;
+ 
+   procedure Finalize( It: in out Bad_Finalize ) is
+   begin
+     Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
+   end Finalize;
+ 
+ end C761006_0;
+ 
+ --------------------------------------------------------------------- C761006
+ 
+ with Report;
+ with C761006_0;
+ with C761006_2;
+ with C761006_Support;
+ with Ada.Exceptions;
+ with Ada.Finalization;
+ with Unchecked_Deallocation;
+ procedure C761006 is
+ 
+   package Sup renames C761006_Support;
+   use type Sup.Event_Array;
+ 
+   type Procedure_Handle is access procedure;
+ 
+   type Test_ID is ( Simple, Initialize, Adjust, Finalize );
+ 
+   Sub_Tests : array(Test_ID) of Procedure_Handle;
+ 
+   procedure Simple_Test is
+     A_Good_Object : C761006_0.Good; -- should call Initialize
+   begin
+     if not A_Good_Object.Initialized then
+       Report.Failed("Good object not initialized");
+     end if;
+ 
+     -- should call Adjust
+     A_Good_Object := ( Ada.Finalization.Controlled
+                        with Unique => 0, others => False );
+     if not A_Good_Object.Adjusted then
+       Report.Failed("Good object not adjusted");
+     end if;
+ 
+     -- should call Finalize before end of scope
+   end Simple_Test;
+ 
+   procedure Initialize_Test is
+   begin
+     declare
+       This_Object_Fails_In_Initialize : C761006_2.Init_Check;
+     begin
+       Report.Failed("Exception in Initialize did not occur");
+     exception
+       when others =>
+         Report.Failed("Initialize caused exception at wrong lex");
+     end;
+ 
+     Report.Failed("Error in execution sequence");
+ 
+   exception
+     when Sup.Propagating_Exception => -- this is correct
+       if not Sup.Events_Occurring(Sup.Good_Initialize) then
+         Report.Failed("Initialization of Good Component did not occur");
+       end if;
+   end Initialize_Test;
+ 
+   procedure Adjust_Test is
+     This_Object_OK     : C761006_2.Adj_Check;
+     This_Object_Target : C761006_2.Adj_Check;
+   begin
+ 
+     Check_Adjust_Due_To_Assignment: begin
+       This_Object_Target := This_Object_OK;
+       Report.Failed("Adjust did not propagate any exception");
+     exception
+       when Program_Error =>  -- expected case
+              if not This_Object_Target.Good_Component.Adjusted then
+                Report.Failed("other adjustment not performed");
+              end if;
+       when others =>
+              Report.Failed("Adjust propagated wrong exception");
+     end Check_Adjust_Due_To_Assignment;
+ 
+     C761006_Support.Events_Occurring := (True, False, False);
+ 
+     Check_Adjust_Due_To_Initial_Assignment: declare
+       Another_Target : C761006_2.Adj_Check := This_Object_OK;
+     begin
+       Report.Failed("Adjust did not propagate any exception");
+     exception
+       when others => Report.Failed("Adjust caused exception at wrong lex");
+     end Check_Adjust_Due_To_Initial_Assignment;
+ 
+   exception
+     when Program_Error =>  -- expected case
+            if Sup.Events_Occurring(Sup.Good_Finalize) /=
+               Sup.Events_Occurring(Sup.Good_Adjust) then
+               -- RM 7.6.1(16/1) says that the good Adjust may or may not
+               -- be performed; but if it is, then the Finalize must be
+               -- performed; and if it is not, then the Finalize must not
+               -- performed.
+               if Sup.Events_Occurring(Sup.Good_Finalize) then
+                  Report.Failed("Good adjust not performed with bad adjust, " &
+                                "but good finalize was");
+               else
+                  Report.Failed("Good adjust performed with bad adjust, " &
+                                "but good finalize was not");
+               end if;
+            end if;
+     when others =>
+            Report.Failed("Adjust propagated wrong exception");
+   end Adjust_Test;
+ 
+   procedure Finalize_Test is
+ 
+     Fin_Not_Perf : constant String := "other finalizations not performed";
+ 
+     procedure Finalize_15 is
+       Item   : C761006_2.Fin_Check;
+       Target : C761006_2.Fin_Check;
+     begin
+ 
+       Item := Target;
+       -- finalization of Item should cause PE
+       -- ARM7.6:21 allows the implementation to omit the assignment of the
+       -- value into an anonymous object, which is the point at which Adjust
+       -- is normally called.  However, this would result in Program_Error's
+       -- being raised before the call to Adjust, with the consequence that
+       -- Adjust is never called.
+ 
+     exception
+       when Program_Error => -- expected case
+              if not Sup.Events_Occurring(Sup.Good_Finalize) then
+                Report.Failed("Assignment: " & Fin_Not_Perf);
+              end if;
+       when others =>
+              Report.Failed("Other exception in Finalize_15");
+ 
+     -- finalization of Item/Target should cause PE
+     end Finalize_15;
+ 
+     -- check failure in finalize due to Unchecked_Deallocation
+ 
+     procedure Finalize_17_Outer is
+       -- This procedure exists to make Shark local, so everything allocated
+       -- on it will be finalized when this routine exits.
+ 
+       type Shark is access C761006_2.Fin_Check;
+ 
+       procedure Catch is
+         new Unchecked_Deallocation( C761006_2.Fin_Check, Shark );
+ 
+       procedure Finalize_17_Inner is
+         White : Shark := new C761006_2.Fin_Check;
+       begin
+         Catch (White);
+           -- Note: It is unspecified if Catch deallocates the memory
+           -- of the allocated object, and if it ceases to exist.
+           -- As such, it is possible that it will be finalized when
+           -- the scope of the access type is exited. We check for this
+           -- case below.
+       exception
+         when Program_Error =>
+            if not Sup.Events_Occurring(Sup.Good_Finalize) then
+              Report.Failed("Unchecked_Deallocation: " & Fin_Not_Perf);
+            end if;
+       end Finalize_17_Inner;
+ 
+     begin
+        Finalize_17_Inner;
+     exception
+       when others =>
+         Report.Failed("Unchecked_Deallocation check, unwanted exception in Outer");
+     end Finalize_17_Outer;
+ 
+   begin
+ 
+     Exception_In_Finalization: begin
+       Finalize_15;
+     exception
+       when Program_Error => null; -- anticipated
+     end Exception_In_Finalization;
+ 
+     Use_Of_Unchecked_Deallocation: begin
+       Finalize_17_Outer;
+     exception
+       when Program_Error =>
+         Report.Comment("Unchecked_Deallocation check, double finalization occurred");
+       when others =>
+         Report.Failed("Unchecked_Deallocation check, unwanted exception in caller");
+     end Use_Of_Unchecked_Deallocation;
+ 
+   end Finalize_Test;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C761006", "Check that exceptions raised in Initialize, " &
+                           "Adjust and Finalize are processed correctly" );
+ 
+   Sub_Tests := (Simple_Test'Access, Initialize_Test'Access,
+                 Adjust_Test'Access, Finalize_Test'Access);
+ 
+   for Test in Sub_Tests'Range loop
+     begin
+ 
+       Sup.Events_Occurring := (others => False);
+ 
+       Sub_Tests(Test).all;
+ 
+       case Test is
+         when Simple | Adjust =>
+           if Sup.Events_Occurring /= Sup.Event_Array ' ( others => True ) then
+             Report.Failed ( "Other operation missing in " &
+                             Test_ID'Image ( Test ) );
+           end if;
+         when  Initialize =>
+           null;
+         when Finalize  =>
+           -- Note that for Good_Adjust, we may get either True or False
+           if Sup.Events_Occurring ( Sup.Good_Initialize ) = False or
+              Sup.Events_Occurring ( Sup.Good_Finalize ) = False
+           then
+             Report.Failed ( "Other operation missing in " &
+                             Test_ID'Image ( Test ) );
+           end if;
+       end case;
+ 
+     exception
+        when How: others => Report.Failed( Ada.Exceptions.Exception_Name( How )
+                                         & " from " & Test_ID'Image( Test ) );
+     end;
+   end loop;
+ 
+   Report.Result;
+ 
+ end C761006;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,419 ----
+ -- C761007.A
+ --
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a finalize procedure invoked by a transfer of control
+ --      due to selection of a terminate alternative attempts to propagate an
+ --      exception, the exception is ignored, but any other finalizations due
+ --      to be performed are performed.
+ --
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares a nested controlled data type, and embeds an object
+ --      of that type within a protected type.  Objects of the protected type
+ --      are created and destroyed, and the actions of the embedded controlled
+ --      object are checked.  The container controlled type causes an exception
+ --      as the last part of it's finalization operation.
+ --
+ --      This test utilizes several tasks to accomplish the objective.  The
+ --      tasks contain delays to ensure that the expected order of processing
+ --      is indeed accomplished.
+ --
+ --      Subtest 1:
+ --        local task object runs to normal completion
+ --
+ --      Subtest 2:
+ --        local task aborts a nested task to cause finalization
+ --
+ --      Subtest 3: 
+ --        local task sleeps long enough to allow procedure started
+ --        asynchronously to go into infinite loop.  Procedure is then aborted
+ --        via ATC, causing finalization of objects.
+ --
+ --      Subtest 4:
+ --        local task object takes terminate alternative, causing finalization
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 JUN 95   SAIC    Initial version
+ --      05 APR 96   SAIC    Documentation changes
+ --      03 MAR 97   PWB.CTA Allowed two finalization orders for ATC test
+ --      02 DEC 97   EDS     Remove duplicate characters from check string.
+ --!
+ 
+ ---------------------------------------------------------------- C761007_0
+ 
+ with Ada.Finalization;
+ package C761007_0 is
+ 
+   type Internal is new Ada.Finalization.Controlled
+     with record
+       Effect : Character;
+     end record;
+ 
+   procedure Finalize( I: in out Internal );
+ 
+   Side_Effect : String(1..80);  -- way bigger than needed
+   Side_Effect_Finger : Natural := 0;
+ 
+ end C761007_0;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body C761007_0 is
+ 
+   procedure Finalize( I : in out Internal ) is
+     Previous_Side_Effect : Boolean := False;
+   begin
+     -- look to see if this character has been finalized yet
+     for SEI in 1..Side_Effect_Finger loop
+       Previous_Side_Effect := Previous_Side_Effect
+                               or Side_Effect(Side_Effect_Finger) = I.Effect;
+     end loop;
+ 
+     -- if not, then tack it on to the string, and touch the character
+     if not Previous_Side_Effect then
+       Side_Effect_Finger := Side_Effect_Finger +1;
+       Side_Effect(Side_Effect_Finger) := I.Effect;
+       TCTouch.Touch(I.Effect);
+     end if;
+ 
+   end Finalize;
+ 
+ end C761007_0;
+ 
+ ---------------------------------------------------------------- C761007_1
+ 
+ with C761007_0;
+ with Ada.Finalization;
+ package C761007_1 is
+ 
+   type Container is new Ada.Finalization.Controlled
+     with record
+       Effect   : Character;
+       Content  : C761007_0.Internal;
+     end record;
+ 
+   procedure Finalize( C: in out Container );
+ 
+   Side_Effect : String(1..80);  -- way bigger than needed
+   Side_Effect_Finger : Natural := 0;
+ 
+   This_Exception_Is_Supposed_To_Be_Ignored : exception;
+ 
+ end C761007_1;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with TCTouch;
+ package body C761007_1 is
+ 
+   procedure Finalize( C: in out Container ) is
+     Previous_Side_Effect : Boolean := False;
+   begin
+     -- look to see if this character has been finalized yet
+     for SEI in 1..Side_Effect_Finger loop
+       Previous_Side_Effect := Previous_Side_Effect
+                               or Side_Effect(Side_Effect_Finger) = C.Effect;
+     end loop;
+ 
+     -- if not, then tack it on to the string, and touch the character
+     if not Previous_Side_Effect then
+       Side_Effect_Finger := Side_Effect_Finger +1;
+       Side_Effect(Side_Effect_Finger) := C.Effect;
+       TCTouch.Touch(C.Effect);
+     end if;
+ 
+     raise This_Exception_Is_Supposed_To_Be_Ignored;
+ 
+   end Finalize;
+ 
+ end C761007_1;
+  
+ ---------------------------------------------------------------- C761007_2
+ with C761007_1;
+ package C761007_2 is
+ 
+   protected type Prot_W_Fin_Obj is
+     procedure Set_Effects( Container, Filling: Character );
+   private
+     The_Data_Under_Test : C761007_1.Container;
+     -- finalization for this will occur when the Prot_W_Fin_Obj object
+     --  "goes out of existence" for whatever reason.
+   end Prot_W_Fin_Obj;
+ 
+ end C761007_2;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ package body C761007_2 is
+ 
+   protected body Prot_W_Fin_Obj is
+     procedure Set_Effects( Container, Filling: Character ) is
+     begin
+       The_Data_Under_Test.Effect := Container;           -- A, etc.
+       The_Data_Under_Test.Content.Effect := Filling;     -- B, etc.
+     end Set_Effects;
+   end Prot_W_Fin_Obj;
+ 
+ end C761007_2;
+ 
+ ------------------------------------------------------------------ C761007
+ 
+ with Report;
+ with Impdef;
+ with TCTouch;
+ with C761007_0;
+ with C761007_1;
+ with C761007_2;
+ procedure C761007 is
+ 
+   task type Subtests( Outer, Inner : Character) is
+     entry Ready;
+     entry Complete;
+   end Subtests;
+ 
+   task body Subtests is
+     Local_Prot_W_Fin_Obj : C761007_2.Prot_W_Fin_Obj;
+   begin
+     Local_Prot_W_Fin_Obj.Set_Effects( Outer, Inner );
+ 
+     accept Ready;
+ 
+     select
+       accept Complete;
+     or terminate;       -- used in Subtest 4
+     end select;
+   exception
+     -- the exception caused by the finalization of Local_Prot_W_Fin_Obj
+     --  should never be visible to this scope.
+     when others => Report.Failed("Exception in a Subtest object "
+                                  & Outer & Inner);
+   end Subtests;
+ 
+   procedure Subtest_1 is
+     -- check the case where "nothing special" happens.
+ 
+     This_Subtest : Subtests( 'A', 'B' );
+   begin
+ 
+     This_Subtest.Ready;
+     This_Subtest.Complete;
+ 
+     while not This_Subtest'Terminated loop -- wait for finalization
+       delay Impdef.Clear_Ready_Queue;
+     end loop;
+ 
+     -- in the finalization of This_Subtest, the controlled object embedded in
+     -- the Prot_W_Fin_Obj will finalize.  An exception is raised in the
+     -- container object, after "touching" it's tag character.
+     -- The finalization of the contained controlled object must be performed.
+ 
+ 
+     TCTouch.Validate( "AB", "Item embedded in task" );
+ 
+ 
+   exception
+     when others => Report.Failed("Undesirable exception in Subtest_1");
+ 
+   end Subtest_1;
+ 
+   procedure Subtest_2 is
+     -- check for explicit abort
+ 
+     task Subtest_Task is
+       entry Complete;
+     end Subtest_Task;
+ 
+     task body Subtest_Task is
+ 
+       task Nesting;
+       task body Nesting is
+         Deep_Nesting : Subtests( 'E', 'F' );
+       begin
+         if Report.Ident_Bool( True ) then
+           -- controlled objects have been created in the elaboration of
+           -- Deep_Nesting.  Deep_Nesting must call the Set_Effects operation
+           -- in the Prot_W_Fin_Obj, and then hang waiting for the Complete
+           -- entry call.
+           Deep_Nesting.Ready;
+           abort Deep_Nesting;
+         else
+           Report.Failed("Dead code in Nesting");
+         end if;
+       exception
+         when others => Report.Failed("Exception in Subtest_Task.Nesting");
+       end Nesting;
+ 
+       Local_2 : C761007_2.Prot_W_Fin_Obj;
+ 
+     begin
+       -- Nesting has activated at this point, which implies the activation
+       -- of Deep_Nesting as well.
+ 
+       Local_2.Set_Effects( 'C', 'D' );
+ 
+       -- wait for Nesting to terminate
+ 
+       while not Nesting'Terminated loop
+         delay Impdef.Clear_Ready_Queue;
+       end loop;
+ 
+       accept Complete;
+ 
+     exception
+       when others => Report.Failed("Exception in Subtest_Task");
+     end Subtest_Task;
+ 
+   begin
+ 
+     -- wait for everything in Subtest_Task to happen
+     Subtest_Task.Complete;
+ 
+     while not Subtest_Task'Terminated loop -- wait for finalization
+       delay Impdef.Clear_Ready_Queue;
+     end loop;
+ 
+     TCTouch.Validate( "EFCD", "Aborted nested task" );
+ 
+   exception
+     when others => Report.Failed("Undesirable exception in Subtest_2");
+   end Subtest_2;
+ 
+   procedure Subtest_3 is
+     -- check abort caused by asynchronous transfer of control
+ 
+     task Subtest_3_Task is
+       entry Complete;
+     end Subtest_3_Task;
+ 
+     procedure Check_Atc_Operation is
+       Check_Atc : C761007_2.Prot_W_Fin_Obj;
+     begin
+ 
+       Check_Atc.Set_Effects( 'G', 'H' );
+ 
+ 
+       while Report.Ident_Bool( True ) loop -- wait to be aborted
+         if Report.Ident_Bool( True ) then
+           Impdef.Exceed_Time_Slice;
+           delay Impdef.Switch_To_New_Task;
+         else
+           Report.Failed("Optimization prevention");
+         end if;
+       end loop;
+ 
+       Report.Failed("Check_Atc_Operation loop completed");
+ 
+     end Check_Atc_Operation;
+ 
+     task body Subtest_3_Task is
+       task Nesting is
+         entry Complete;
+       end Nesting;
+ 
+       task body Nesting is
+         Nesting_3 : C761007_2.Prot_W_Fin_Obj;
+       begin
+         Nesting_3.Set_Effects( 'G', 'H' );
+ 
+         -- give Check_Atc_Operation sufficient time to perform it's
+         -- Set_Effects on it's local Prot_W_Fin_Obj object
+         delay Impdef.Clear_Ready_Queue;
+ 
+         accept Complete;
+       exception
+         when others => Report.Failed("Exception in Subtest_3_Task.Nesting");
+       end Nesting;
+ 
+       Local_3 : C761007_2.Prot_W_Fin_Obj;
+ 
+     begin -- Subtest_3_Task
+ 
+       Local_3.Set_Effects( 'I', 'J' );
+ 
+       select
+         Nesting.Complete;
+       then abort ---------------------------------------------------- cause KL
+         Check_ATC_Operation;
+       end select;
+ 
+       accept Complete;
+ 
+     exception
+       when others => Report.Failed("Exception in Subtest_3_Task");
+     end Subtest_3_Task;
+ 
+   begin -- Subtest_3
+     Subtest_3_Task.Complete;
+ 
+     while not Subtest_3_Task'Terminated loop -- wait for finalization
+       delay Impdef.Clear_Ready_Queue;
+     end loop;
+ 
+     TCTouch.Validate( "GHIJ", "Asynchronously aborted operation" );
+ 
+   exception
+     when others => Report.Failed("Undesirable exception in Subtest_3");
+   end Subtest_3;
+ 
+   procedure Subtest_4 is
+     -- check the case where transfer is caused by terminate alternative
+     -- highly similar to Subtest_1
+ 
+     This_Subtest : Subtests( 'M', 'N' );
+   begin
+ 
+     This_Subtest.Ready;
+     -- don't call This_Subtest.Complete;
+ 
+   exception
+     when others => Report.Failed("Undesirable exception in Subtest_4");
+ 
+   end Subtest_4;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C761007", "Check that if a finalize procedure invoked by " &
+                           "a transfer of control or selection of a " &
+                           "terminate alternative attempts to propagate " &
+                           "an exception, the exception is ignored, but " &
+                           "any other finalizations due to be performed " &
+                           "are performed" );
+ 
+   Subtest_1;  -- checks internal
+ 
+   Subtest_2;  -- checks internal
+ 
+   Subtest_3;  -- checks internal
+ 
+   Subtest_4;
+   TCTouch.Validate( "MN", "transfer due to terminate alternative" );
+ 
+   Report.Result;
+ 
+ end C761007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,447 ----
+ -- C761010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE
+ --     Check the requirements of the new 7.6(17.1/1) from Technical
+ --     Corrigendum 1 (originally discussed as AI95-00083).
+ --     This new paragraph requires that the initialization of an object with
+ --     an aggregate does not involve calls to Adjust.
+ --
+ -- TEST DESCRIPTION
+ --     We include several cases of initialization:
+ --        - Explicit initialization of an object declared by an
+ --          object declaration.
+ --        - Explicit initialization of a heap object.
+ --        - Default initialization of a record component.
+ --        - Initialization of a formal parameter during a call.
+ --        - Initialization of a formal parameter during a call with
+ --          a defaulted parameter.
+ --        - Lots of nested records, arrays, and pointers.
+ --     In this test, Initialize should never be called, because we
+ --     never declare a default-initialized controlled object (although
+ --     we do declare default-initialized records containing controlled
+ --     objects, with default expressions for the components).
+ --     Adjust should never be called, because every initialization
+ --     is via an aggregate.  Finalize is called, because the objects
+ --     themselves need to be finalized.
+ --     Thus, Initialize and Adjust call Failed.
+ --     In some of the cases, these procedures will not yet be elaborated,
+ --     anyway.
+ --
+ -- CHANGE HISTORY:
+ --      29 JUN 1999   RAD   Initial Version
+ --      23 SEP 1999   RLB   Improved comments, renamed, issued.
+ --      10 APR 2000   RLB   Corrected errors in comments and text, fixed
+ --                          discriminant error. Fixed so that Report.Test
+ --                          is called before any Report.Failed call. Added
+ --                          a marker so that the failed subtest can be
+ --                          determined.
+ --      26 APR 2000   RAD   Try to defeat optimizations.
+ --      04 AUG 2000   RLB   Corrected error in Check_Equal.
+ --      18 AUG 2000   RLB   Removed dubious main subprogram renames (see AI-172).
+ --      19 JUL 2002   RLB   Fixed to avoid calling comment after Report.Result.
+ --
+ --!
+ 
+ with Ada; use Ada;
+ with Report; use Report; pragma Elaborate_All(Report);
+ with Ada.Finalization;
+ package C761010_1 is
+     pragma Elaborate_Body;
+     function Square(X: Integer) return Integer;
+ private
+     type TC_Control is new Ada.Finalization.Limited_Controlled with null record;
+     procedure Initialize (Object : in out TC_Control);
+     procedure Finalize (Object : in out TC_Control);
+     TC_Finalize_Called : Boolean := False;
+ end C761010_1;
+ 
+ package body C761010_1 is
+     function Square(X: Integer) return Integer is
+     begin
+         return X**2;
+     end Square;
+ 
+     procedure Initialize (Object : in out TC_Control) is
+     begin
+         Test("C761010_1",
+              "Check that Adjust is not called"
+               & " when aggregates are used to initialize objects");
+     end Initialize;
+ 
+     procedure Finalize (Object : in out TC_Control) is
+     begin
+         if not TC_Finalize_Called then
+             Failed("Var_Strings Finalize never called");
+         end if;
+         Result;
+     end Finalize;
+ 
+     TC_Test : TC_Control; -- Starts test; finalization ends test.
+ end C761010_1;
+ 
+ with Ada.Finalization;
+ package C761010_1.Var_Strings is
+     type Var_String(<>) is private;
+ 
+     Some_String: constant Var_String;
+ 
+     function "=" (X, Y: Var_String) return Boolean;
+ 
+     procedure Check_Equal(X, Y: Var_String);
+         -- Calls to this are used to defeat optimizations
+         -- that might otherwise defeat the purpose of the
+         -- test.  I'm talking about the optimization of removing
+         -- unused controlled objects.
+ 
+ private
+ 
+     type String_Ptr is access constant String;
+ 
+     type Var_String(Length: Natural) is new Finalization.Controlled with
+         record
+             Comp_1: String_Ptr := new String'(2..Square(Length)-1 => 'x');
+             Comp_2: String_Ptr(1..Length) := null;
+             Comp_3: String(Length..Length) := (others => '.');
+             TC_Lab: Character := '1';
+         end record;
+     procedure Initialize(X: in out Var_String);
+     procedure Adjust(X: in out Var_String);
+     procedure Finalize(X: in out Var_String);
+ 
+     Some_String: constant Var_String
+       := (Finalization.Controlled with Length => 1,
+           Comp_1 => null,
+           Comp_2 => null,
+           Comp_3 => "x",
+           TC_Lab => 'A');
+ 
+     Another_String: constant Var_String
+       := (Finalization.Controlled with Length => 10,
+           Comp_1 => Some_String.Comp_2,
+           Comp_2 => new String'("1234567890"),
+           Comp_3 => "x",
+           TC_Lab => 'B');
+ 
+ end C761010_1.Var_Strings;
+ 
+ package C761010_1.Var_Strings.Types is
+ 
+     type Ptr is access all Var_String;
+     Ptr_Const: constant Ptr;
+ 
+     type Ptr_Arr is array(Positive range <>) of Ptr;
+     Ptr_Arr_Const: constant Ptr_Arr;
+ 
+     type Ptr_Rec(N_Strings: Natural) is
+         record
+             Ptrs: Ptr_Arr(1..N_Strings);
+         end record;
+     Ptr_Rec_Const: constant Ptr_Rec;
+ 
+ private
+ 
+     Ptr_Const: constant Ptr := new Var_String'
+       (Finalization.Controlled with
+        Length => 1,
+        Comp_1 => null,
+        Comp_2 => null,
+        Comp_3 => (others => ' '),
+        TC_Lab => 'C');
+ 
+     Ptr_Arr_Const: constant Ptr_Arr :=
+       (1 => new Var_String'
+        (Finalization.Controlled with
+         Length => 1,
+         Comp_1 => new String'("abcdefghij"),
+         Comp_2 => null,
+         Comp_3 => (2..2 => ' '),
+         TC_Lab => 'D'));
+ 
+     Ptr_Rec_Var: Ptr_Rec :=
+       (3,
+        (1..2 => null,
+         3 => new Var_String'
+         (Finalization.Controlled with
+          Length => 2,
+          Comp_1 => new String'("abcdefghij"),
+          Comp_2 => null,
+          Comp_3 => (2..2 => ' '),
+          TC_Lab => 'E')));
+ 
+     Ptr_Rec_Const: constant Ptr_Rec :=
+       (3,
+        (1..2 => null,
+         3 => new Var_String'
+         (Finalization.Controlled with
+          Length => 2,
+          Comp_1 => new String'("abcdefghij"),
+          Comp_2 => null,
+          Comp_3 => (2..2 => ' '),
+          TC_Lab => 'F')));
+ 
+     type Arr is array(Positive range <>) of Var_String(Length => 2);
+ 
+     Arr_Var: Arr :=
+       (1 => (Finalization.Controlled with
+          Length => 2,
+          Comp_1 => new String'("abcdefghij"),
+          Comp_2 => null,
+          Comp_3 => (2..2 => ' '),
+          TC_Lab => 'G'));
+ 
+     type Rec(N_Strings: Natural) is
+         record
+             Ptrs: Ptr_Rec(N_Strings);
+             Strings: Arr(1..N_Strings) :=
+               (others =>
+                  (Finalization.Controlled with
+                   Length => 2,
+                   Comp_1 => new String'("abcdefghij"),
+                   Comp_2 => null,
+                   Comp_3 => (2..2 => ' '),
+                   TC_Lab => 'H'));
+         end record;
+ 
+     Default_Init_Rec_Var: Rec(N_Strings => 10);
+     Empty_Default_Init_Rec_Var: Rec(N_Strings => 0);
+ 
+     Rec_Var: Rec(N_Strings => 2) :=
+       (N_Strings => 2,
+        Ptrs =>
+          (2,
+           (1..1 => null,
+            2 => new Var_String'
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'J'))),
+        Strings =>
+          (1 =>
+             (Finalization.Controlled with
+              Length => 2,
+              Comp_1 => new String'("abcdefghij"),
+              Comp_2 => null,
+              Comp_3 => (2..2 => ' '),
+              TC_Lab => 'K'),
+           others =>
+             (Finalization.Controlled with
+              Length => 2,
+              Comp_1 => new String'("abcdefghij"),
+              Comp_2 => null,
+              Comp_3 => (2..2 => ' '),
+              TC_Lab => 'L')));
+ 
+     procedure Check_Equal(X, Y: Rec);
+ 
+ end C761010_1.Var_Strings.Types;
+ 
+ package body C761010_1.Var_Strings.Types is
+ 
+     -- Check that parameter passing doesn't create new objects,
+     -- and therefore doesn't need extra Adjusts or Finalizes.
+ 
+     procedure Check_Equal(X, Y: Rec) is
+         -- We assume that the arguments should be equal.
+         -- But we cannot assume that pointer values are the same.
+     begin
+         if X.N_Strings /= Y.N_Strings then
+             Failed("Records should be equal (1)");
+         else
+             for I in 1 .. X.N_Strings loop
+                 if X.Ptrs.Ptrs(I) /= Y.Ptrs.Ptrs(I) then
+                     if X.Ptrs.Ptrs(I) = null or else
+                        Y.Ptrs.Ptrs(I) = null or else
+                        X.Ptrs.Ptrs(I).all /= Y.Ptrs.Ptrs(I).all then
+                        Failed("Records should be equal (2)");
+                     end if;
+                 end if;
+                 if X.Strings(I) /= Y.Strings(I) then
+                     Failed("Records should be equal (3)");
+                 end if;
+             end loop;
+         end if;
+     end Check_Equal;
+ 
+     procedure My_Check_Equal
+               (X: Rec := Rec_Var;
+                Y: Rec :=
+       (N_Strings => 2,
+        Ptrs =>
+          (2,
+           (1..1 => null,
+            2 => new Var_String'
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'M'))),
+        Strings =>
+          (1 =>
+             (Finalization.Controlled with
+              Length => 2,
+              Comp_1 => new String'("abcdefghij"),
+              Comp_2 => null,
+              Comp_3 => (2..2 => ' '),
+              TC_Lab => 'N'),
+           others =>
+             (Finalization.Controlled with
+              Length => 2,
+              Comp_1 => new String'("abcdefghij"),
+              Comp_2 => null,
+              Comp_3 => (2..2 => ' '),
+              TC_Lab => 'O'))))
+               renames Check_Equal;
+ begin
+ 
+     My_Check_Equal;
+ 
+     Check_Equal(Rec_Var,
+       (N_Strings => 2,
+        Ptrs =>
+          (2,
+           (1..1 => null,
+            2 => new Var_String'
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'P'))),
+        Strings =>
+          (1 =>
+             (Finalization.Controlled with
+              Length => 2,
+              Comp_1 => new String'("abcdefghij"),
+              Comp_2 => null,
+              Comp_3 => (2..2 => ' '),
+              TC_Lab => 'Q'),
+           others =>
+             (Finalization.Controlled with
+              Length => 2,
+              Comp_1 => new String'("abcdefghij"),
+              Comp_2 => null,
+              Comp_3 => (2..2 => ' '),
+              TC_Lab => 'R'))));
+ 
+     -- Use the objects to avoid optimizations.
+ 
+     Check_Equal(Ptr_Const.all, Ptr_Const.all);
+     Check_Equal(Ptr_Arr_Const(1).all, Ptr_Arr_Const(1).all);
+     Check_Equal(Ptr_Rec_Const.Ptrs(Ptr_Rec_Const.N_Strings).all,
+                 Ptr_Rec_Const.Ptrs(Ptr_Rec_Const.N_Strings).all);
+     Check_Equal(Ptr_Rec_Var.Ptrs(Ptr_Rec_Var.N_Strings).all,
+                 Ptr_Rec_Var.Ptrs(Ptr_Rec_Var.N_Strings).all);
+ 
+     if Report.Equal (3, 2) then
+        -- Can't get here.
+        Check_Equal (Arr_Var(1), Default_Init_Rec_Var.Strings(1));
+        Check_Equal (Arr_Var(1), Empty_Default_Init_Rec_Var.Strings(1));
+     end if;
+ 
+ end C761010_1.Var_Strings.Types;
+ 
+ with C761010_1.Var_Strings;
+ with C761010_1.Var_Strings.Types;
+ procedure C761010_1.Main is
+ begin
+     -- Report.Test is called by the elaboration of C761010_1, and
+     -- Report.Result is called by the finalization of C761010_1.
+     -- This will happen before any objects are created, and after any
+     -- are finalized.
+     null;
+ end C761010_1.Main;
+ 
+ with C761010_1.Main;
+ procedure C761010 is
+ begin
+     C761010_1.Main;
+ end C761010;
+ 
+ package body C761010_1.Var_Strings is
+ 
+     Some_Error: exception;
+ 
+     procedure Initialize(X: in out Var_String) is
+     begin
+         Failed("Initialize should never be called");
+         raise Some_Error;
+     end Initialize;
+ 
+     procedure Adjust(X: in out Var_String) is
+     begin
+         Failed("Adjust should never be called - case " & X.TC_Lab);
+         raise Some_Error;
+     end Adjust;
+ 
+     procedure Finalize(X: in out Var_String) is
+     begin
+         Comment("Finalize called - case " & X.TC_Lab);
+ 	C761010_1.TC_Finalize_Called := True;
+     end Finalize;
+ 
+     function "=" (X, Y: Var_String) return Boolean is
+         -- Don't check the TC_Lab component, but do check the contents of the
+ 	-- access values.
+     begin
+         if X.Length /= Y.Length then
+             return False;
+         end if;
+         if X.Comp_3 /= Y.Comp_3 then
+             return False;
+         end if;
+         if X.Comp_1 /= Y.Comp_1 then
+             -- Still OK if the values are the same.
+             if X.Comp_1 = null or else
+                Y.Comp_1 = null or else
+                X.Comp_1.all /= Y.Comp_1.all then
+                return False;
+             --else OK.
+             end if;
+         end if;
+         if X.Comp_2 /= Y.Comp_2 then
+             -- Still OK if the values are the same.
+             if X.Comp_2 = null or else
+                Y.Comp_2 = null or else
+                X.Comp_2.all /= Y.Comp_2.all then
+                return False;
+             end if;
+         end if;
+         return True;
+     end "=";
+ 
+     procedure Check_Equal(X, Y: Var_String) is
+     begin
+         if X /= Y then
+             Failed("Check_Equal of Var_String");
+         end if;
+     end Check_Equal;
+ 
+ begin
+     Check_Equal(Another_String, Another_String);
+ end C761010_1.Var_Strings;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,410 ----
+ -- C761011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that if a Finalize propagates an exception, other Finalizes due
+ --    to be performed are performed.
+ --        Case 1: A Finalize invoked due to the end of execution of
+ --        a master. (Defect Report 8652/0023, as reflected in Technical
+ --        Corrigendum 1).
+ --        Case 2: A Finalize invoked due to finalization of an anonymous
+ --        object. (Defect Report 8652/0023, as reflected in Technical
+ --        Corrigendum 1).
+ --        Case 3: A Finalize invoked due to the transfer of control
+ --        due to an exit statement.
+ --        Case 4: A Finalize invoked due to the transfer of control
+ --        due to a goto statement.
+ --        Case 5: A Finalize invoked due to the transfer of control
+ --        due to a return statement.
+ --        Case 6: A Finalize invoked due to the transfer of control
+ --        due to raises an exception.
+ --
+ --
+ -- CHANGE HISTORY:
+ --    29 JAN 2001   PHL   Initial version
+ --    15 MAR 2001   RLB   Readied for release; added optimization blockers.
+ --                        Added test cases for paragraphs 18 and 19 of the
+ --                        standard (the previous tests were withdrawn).
+ --
+ --!
+ with Ada.Finalization;
+ use Ada.Finalization;
+ package C761011_0 is
+ 
+     type Ctrl (D : Boolean) is new Ada.Finalization.Controlled with
+         record
+             Finalized : Boolean := False;
+             case D is
+                 when False =>
+                     C1 : Integer;
+                 when True =>
+                     C2 : Float;
+             end case;
+         end record;
+ 
+     function Create (Id : Integer) return Ctrl;
+     procedure Finalize (Obj : in out Ctrl);
+     function Was_Finalized (Id : Integer) return Boolean;
+     procedure Use_It (Obj : in Ctrl);
+        -- Use Obj to prevent optimization.
+ 
+ end C761011_0;
+ 
+ with Report;
+ use Report;
+ package body C761011_0 is
+ 
+     User_Error : exception;
+ 
+     Finalize_Called : array (0 .. 50) of Boolean := (others => False);
+ 
+     function Create (Id : Integer) return Ctrl is
+         Obj : Ctrl (Boolean'Val (Id mod Ident_Int (2)));
+     begin
+         case Obj.D is
+             when False =>
+                 Obj.C1 := Ident_Int (Id);
+             when True =>
+                 Obj.C2 := Float (Ident_Int (Id + Ident_Int (Id)));
+         end case;
+         return Obj;
+     end Create;
+ 
+     procedure Finalize (Obj : in out Ctrl) is
+     begin
+         if not Obj.Finalized then
+             Obj.Finalized := True;
+             if Obj.D then
+                 if Integer (Obj.C2 / 2.0) mod Ident_Int (10) =
+                    Ident_Int (3) then
+                     raise User_Error;
+                 else
+                     Finalize_Called (Integer (Obj.C2) / 2) := True;
+                 end if;
+             else
+                 if Obj.C1 mod Ident_Int (10) = Ident_Int (0) then
+                     raise Tasking_Error;
+                 else
+                     Finalize_Called (Obj.C1) := True;
+                 end if;
+             end if;
+         end if;
+     end Finalize;
+ 
+     function Was_Finalized (Id : Integer) return Boolean is
+     begin
+         return Finalize_Called (Ident_Int (Id));
+     end Was_Finalized;
+ 
+     procedure Use_It (Obj : in Ctrl) is
+        -- Use Obj to prevent optimization.
+     begin
+         case Obj.D is
+             when True =>
+                 if not Equal (Boolean'Pos(Obj.Finalized),
+                               Boolean'Pos(Obj.Finalized)) then
+                     Failed ("Identity check - 1");
+                 end if;
+             when False =>
+                 if not Equal (Obj.C1, Obj.C1) then
+                     Failed ("Identity check - 2");
+                 end if;
+         end case;
+     end Use_It;
+ 
+ end C761011_0;
+ 
+ with Ada.Exceptions;
+ use Ada.Exceptions;
+ with Ada.Finalization;
+ with C761011_0;
+ use C761011_0;
+ with Report;
+ use Report;
+ procedure C761011 is
+ begin
+     Test
+        ("C761011",
+         " Check that if a finalize propagates an exception, other finalizes " &
+          "due to be performed are performed");
+ 
+     Normal: -- Case 1
+         begin
+             declare
+                 Obj1 : Ctrl := Create (Ident_Int (1));
+                 Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                          D => False,
+                                          Finalized => Ident_Bool (False),
+                                          C1 => Ident_Int (2));
+                 Obj3 : Ctrl :=
+                    (Ada.Finalization.Controlled with
+                     D => True,
+                     Finalized => Ident_Bool (False),
+                     C2 => 2.0 * Float (Ident_Int
+                                           (3))); -- Finalization: User_Error
+                 Obj4 : Ctrl := Create (Ident_Int (4));
+             begin
+                 Comment ("Finalization of normal object");
+                 Use_It (Obj1); -- Prevent optimization of Objects.
+                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                 Use_It (Obj3);
+                 Use_It (Obj4);
+             end;
+             Failed ("No exception raised by finalization of normal object");
+         exception
+             when Program_Error =>
+                 if not Was_Finalized (Ident_Int (1)) or
+                    not Was_Finalized (Ident_Int (2)) or
+                    not Was_Finalized (Ident_Int (4)) then
+                     Failed ("Missing finalizations - 1");
+                 end if;
+             when E: others =>
+                 Failed ("Exception " & Exception_Name (E) &
+                         " raised - " & Exception_Message (E) & " - 1");
+         end Normal;
+ 
+     Anon: -- Case 2
+         begin
+             declare
+                 Obj1 : Ctrl := (Ada.Finalization.Controlled with
+                                 D => True,
+                                 Finalized => Ident_Bool (False),
+                                 C2 => 2.0 * Float (Ident_Int (5)));
+                 Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                          D => False,
+                                          Finalized => Ident_Bool (False),
+                                          C1 => Ident_Int (6));
+                 Obj3 : Ctrl := (Ada.Finalization.Controlled with
+                                 D => True,
+                                 Finalized => Ident_Bool (False),
+                                 C2 => 2.0 * Float (Ident_Int (7)));
+                 Obj4 : Ctrl := Create (Ident_Int (8));
+             begin
+                 Comment ("Finalization of anonymous object");
+ 
+                 -- The finalization of the anonymous object below will raise
+                 -- Tasking_Error.
+                 if Create (Ident_Int (10)).C1 /= Ident_Int (10) then
+                     Failed ("Incorrect construction of an anonymous object");
+                 end if;
+                 Failed ("Anonymous object not finalized at the end of the " &
+                         "enclosing statement");
+                 Use_It (Obj1); -- Prevent optimization of Objects.
+                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                 Use_It (Obj3);
+                 Use_It (Obj4);
+             end;
+             Failed ("No exception raised by finalization of an anonymous " &
+                     "object of a function");
+         exception
+             when Program_Error =>
+                 if not Was_Finalized (Ident_Int (5)) or
+                    not Was_Finalized (Ident_Int (6)) or
+                    not Was_Finalized (Ident_Int (7)) or
+                    not Was_Finalized (Ident_Int (8)) then
+                     Failed ("Missing finalizations - 2");
+                 end if;
+             when E: others =>
+                 Failed ("Exception " & Exception_Name (E) &
+                         " raised - " & Exception_Message (E) & " - 2");
+         end Anon;
+ 
+     An_Exit: -- Case 3
+         begin
+             for Counter in 1 .. 4 loop
+                 declare
+                     Obj1 : Ctrl := Create (Ident_Int (11));
+                     Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                              D => False,
+                                              Finalized => Ident_Bool (False),
+                                              C1 => Ident_Int (12));
+                     Obj3 : Ctrl :=
+                         (Ada.Finalization.Controlled with
+                          D => True,
+                          Finalized => Ident_Bool (False),
+                          C2 => 2.0 * Float (
+                                Ident_Int(13))); -- Finalization: User_Error
+                     Obj4 : Ctrl := Create (Ident_Int (14));
+                 begin
+                     Comment ("Finalization because of exit of loop");
+ 
+                     Use_It (Obj1); -- Prevent optimization of Objects.
+                     Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                     Use_It (Obj3);
+                     Use_It (Obj4);
+ 
+                     exit when not Ident_Bool (Obj2.D);
+ 
+                     Failed ("Exit not taken");
+                 end;
+             end loop;
+             Failed ("No exception raised by finalization on exit");
+         exception
+             when Program_Error =>
+                 if not Was_Finalized (Ident_Int (11)) or
+                    not Was_Finalized (Ident_Int (12)) or
+                    not Was_Finalized (Ident_Int (14)) then
+                     Failed ("Missing finalizations - 3");
+                 end if;
+             when E: others =>
+                 Failed ("Exception " & Exception_Name (E) &
+                         " raised - " & Exception_Message (E) & " - 3");
+         end An_Exit;
+ 
+     A_Goto: -- Case 4
+         begin
+             declare
+                 Obj1 : Ctrl := Create (Ident_Int (15));
+                 Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                          D => False,
+                                          Finalized => Ident_Bool (False),
+                                          C1 => Ident_Int (0));
+                              -- Finalization: Tasking_Error
+                 Obj3 : Ctrl := Create (Ident_Int (16));
+                 Obj4 : Ctrl := (Ada.Finalization.Controlled with
+                                 D => True,
+                                 Finalized => Ident_Bool (False),
+                                 C2 => 2.0 * Float (Ident_Int (17)));
+             begin
+                 Comment ("Finalization because of goto statement");
+ 
+                 Use_It (Obj1); -- Prevent optimization of Objects.
+                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                 Use_It (Obj3);
+                 Use_It (Obj4);
+ 
+                 if Ident_Bool (Obj4.D) then
+                    goto Continue;
+                 end if;
+ 
+                 Failed ("Goto not taken");
+             end;
+          <<Continue>>
+             Failed ("No exception raised by finalization on goto");
+         exception
+             when Program_Error =>
+                 if not Was_Finalized (Ident_Int (15)) or
+                    not Was_Finalized (Ident_Int (16)) or
+                    not Was_Finalized (Ident_Int (17)) then
+                     Failed ("Missing finalizations - 4");
+                 end if;
+             when E: others =>
+                 Failed ("Exception " & Exception_Name (E) &
+                         " raised - " & Exception_Message (E) & " - 4");
+         end A_Goto;
+ 
+     A_Return: -- Case 5
+         declare
+             procedure Do_Something is
+                 Obj1 : Ctrl := Create (Ident_Int (18));
+                 Obj2 : Ctrl := (Ada.Finalization.Controlled with
+                                 D => True,
+                                 Finalized => Ident_Bool (False),
+                                 C2 => 2.0 * Float (Ident_Int (19)));
+                 Obj3 : constant Ctrl := (Ada.Finalization.Controlled with
+                                          D => False,
+                                          Finalized => Ident_Bool (False),
+                                          C1 => Ident_Int (20));
+                              -- Finalization: Tasking_Error
+             begin
+                 Comment ("Finalization because of return statement");
+ 
+                 Use_It (Obj1); -- Prevent optimization of Objects.
+                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                 Use_It (Obj3);
+ 
+                 if not Ident_Bool (Obj3.D) then
+                    return;
+                 end if;
+ 
+                 Failed ("Return not taken");
+             end Do_Something;
+         begin
+             Do_Something;
+             Failed ("No exception raised by finalization on return statement");
+         exception
+             when Program_Error =>
+                 if not Was_Finalized (Ident_Int (18)) or
+                    not Was_Finalized (Ident_Int (19)) then
+                     Failed ("Missing finalizations - 5");
+                 end if;
+             when E: others =>
+                 Failed ("Exception " & Exception_Name (E) &
+                         " raised - " & Exception_Message (E) & " - 5");
+         end A_Return;
+ 
+     Except: -- Case 6
+         declare
+             Funky_Error : exception;
+ 
+             procedure Do_Something is
+                 Obj1 : Ctrl :=
+                     (Ada.Finalization.Controlled with
+                      D => True,
+                      Finalized => Ident_Bool (False),
+                      C2 => 2.0 * Float (
+                            Ident_Int(23))); -- Finalization: User_Error
+                 Obj2 : Ctrl := Create (Ident_Int (24));
+                 Obj3 : Ctrl := Create (Ident_Int (25));
+                 Obj4 : constant Ctrl := (Ada.Finalization.Controlled with
+                                          D => False,
+                                          Finalized => Ident_Bool (False),
+                                          C1 => Ident_Int (26));
+             begin
+                 Comment ("Finalization because of exception propagation");
+ 
+                 Use_It (Obj1); -- Prevent optimization of Objects.
+                 Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                 Use_It (Obj3);
+                 Use_It (Obj4);
+ 
+                 if not Ident_Bool (Obj4.D) then
+                    raise Funky_Error;
+                 end if;
+ 
+                 Failed ("Exception not raised");
+             end Do_Something;
+         begin
+             Do_Something;
+             Failed ("No exception raised by finalization on exception " &
+                     "propagation");
+         exception
+             when Program_Error =>
+                 if not Was_Finalized (Ident_Int (24)) or
+                    not Was_Finalized (Ident_Int (25)) or
+                    not Was_Finalized (Ident_Int (26)) then
+                     Failed ("Missing finalizations - 6");
+                 end if;
+             when Funky_Error =>
+                 Failed ("Wrong exception propagated");
+                     -- Should be Program_Error (7.6.1(19)).
+             when E: others =>
+                 Failed ("Exception " & Exception_Name (E) &
+                         " raised - " & Exception_Message (E) & " - 6");
+         end Except;
+ 
+     Result;
+ end C761011;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c7/c761012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c7/c761012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- C761012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that an anonymous object is finalized with its enclosing master if
+ --    a transfer of control or exception occurs prior to performing its normal
+ --    finalization.  (Defect Report 8652/0023, as reflected in
+ --    Technical Corrigendum 1, RM95 7.6.1(13.1/1)).
+ --
+ -- CHANGE HISTORY:
+ --    29 JAN 2001   PHL   Initial version.
+ --     5 DEC 2001   RLB   Reformatted for ACATS.
+ --
+ --!
+ with Ada.Finalization;
+ use Ada.Finalization;
+ package C761012_0 is
+ 
+     type Ctrl (D : Boolean) is new Controlled with
+         record
+             case D is
+                 when False =>
+                     C1 : Integer;
+                 when True =>
+                     C2 : Float;
+             end case;
+         end record;
+ 
+     function Create return Ctrl;
+     procedure Finalize (Obj : in out Ctrl);
+     function Finalize_Was_Called return Boolean;
+ 
+ end C761012_0;
+ 
+ with Report;
+ use Report;
+ package body C761012_0 is
+ 
+     Finalization_Flag : Boolean := False;
+ 
+     function Create return Ctrl is
+         Obj : Ctrl (Ident_Bool (True));
+     begin
+         Obj.C2 := 3.0;
+         return Obj;
+     end Create;
+ 
+     procedure Finalize (Obj : in out Ctrl) is
+     begin
+         Finalization_Flag := True;
+     end Finalize;
+ 
+     function Finalize_Was_Called return Boolean is
+     begin
+         if Finalization_Flag then
+             Finalization_Flag := False;
+             return True;
+         else
+             return False;
+         end if;
+     end Finalize_Was_Called;
+ 
+ end C761012_0;
+ 
+ with Ada.Exceptions;
+ use Ada.Exceptions;
+ with C761012_0;
+ use C761012_0;
+ with Report;
+ use Report;
+ procedure C761012 is
+ begin
+     Test ("C761012",
+           "Check that an anonymous object is finalized with its enclosing " &
+              "master if a transfer of control or exception occurs prior to " &
+              "performing its normal finalization");
+ 
+     Excep:
+         begin
+ 
+             declare
+                 I : Integer := Create.C1; -- Raises Constraint_Error
+             begin
+                 Failed
+                    ("Improper component selection did not raise Constraint_Error, I =" &
+                     Integer'Image (I));
+             exception
+                 when Constraint_Error =>
+                     Failed ("Constraint_Error caught by the wrong handler");
+             end;
+ 
+             Failed ("Transfer of control did not happen correctly");
+ 
+         exception
+             when Constraint_Error =>
+                 if not Finalize_Was_Called then
+                     Failed ("Finalize wasn't called when the master was left " &
+                             "- Constraint_Error");
+                 end if;
+             when E: others =>
+                 Failed ("Exception " & Exception_Name (E) &
+                         " raised - " & Exception_Information (E));
+         end Excep;
+ 
+     Transfer:
+         declare
+             Finalize_Was_Called_Before_Leaving_Exit : Boolean;
+         begin
+ 
+             begin
+                 loop
+                     exit when Create.C2 = 3.0;
+                 end loop;
+                 Finalize_Was_Called_Before_Leaving_Exit := Finalize_Was_Called;
+                 if Finalize_Was_Called_Before_Leaving_Exit then
+                     Comment ("Finalize called before the transfer of control");
+                 end if;
+             end;
+ 
+             if not Finalize_Was_Called and then
+                not Finalize_Was_Called_Before_Leaving_Exit then
+                 Failed ("Finalize wasn't called when the master was left " &
+                         "- transfer of control");
+             end if;
+         end Transfer;
+ 
+     Result;
+ end C761012;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C83007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A FORMAL PARAMETER OF A SUBPROGRAM DECLARED BY A
+ --     RENAMING DECLARATION CAN HAVE THE SAME IDENTIFIER AS A
+ --     DECLARATION IN THE BODY OF THE RENAMED SUBPROGRAM.
+ 
+ -- HISTORY:
+ --     VCL  02/18/88  CREATED ORIGINAL TEST.
+ 
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C83007A IS
+ BEGIN
+      TEST ("C83007A", "A FORMAL PARAMETER OF A SUBPROGRAM DECLARED " &
+                       "BY A RENAMING DECLARATION CAN HAVE THE SAME " &
+                       "IDENTIFIER AS A DECLARATION IN THE BODY OF " &
+                       "THE RENAMED SUBPROGRAM");
+      DECLARE
+           PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING);
+ 
+           PROCEDURE R (D1 : INTEGER;
+                        D2 : FLOAT;
+                        D3 : STRING)  RENAMES P;
+ 
+           PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING) IS
+                TYPE D1 IS RANGE 1..10;
+                I : D1 := D1(IDENT_INT (7));
+ 
+                D2 : FLOAT;
+ 
+                FUNCTION D3 RETURN STRING IS
+                BEGIN
+                     RETURN "D3";
+                END D3;
+ 
+                FUNCTION IDENT_FLOAT (VAL : FLOAT) RETURN FLOAT IS
+                BEGIN
+                     IF EQUAL (3, 3) THEN
+                          RETURN VAL;
+                     ELSE
+                          RETURN 0.0;
+                     END IF;
+                END IDENT_FLOAT;
+ 
+           BEGIN
+                IF ONE /= 5 THEN
+                     FAILED ("INCORRECT VALUE FOR PARAMETER ONE");
+                END IF;
+                IF TWO /= 4.5 THEN
+                     FAILED ("INCORRECT VALUE FOR PARAMETER TWO");
+                END IF;
+                IF THREE /= "R1" THEN
+                     FAILED ("INCORRECT VALUE FOR PARAMETER THREE");
+                END IF;
+ 
+                IF I /= 7 THEN
+                     FAILED ("INCORRECT VALUE FOR OBJECT I");
+                END IF;
+                D2 := IDENT_FLOAT (3.5);
+                IF D2 /= 3.5 THEN
+                     FAILED ("INCORRECT VALUE FOR OBJECT D2");
+                END IF;
+                IF D3 /= "D3" THEN
+                     FAILED ("INCORRECT VALUE FOR FUNCTION D3");
+                END IF;
+           END P;
+      BEGIN
+           R (D1=>5, D2=>4.5, D3=>"R1");
+      END;
+ 
+      RESULT;
+ END C83007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83012d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83012d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83012d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83012d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C83012D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WITHIN A GENERIC PACKAGE INSTANTIATION, A DECLARATION
+ --     HAVING THE SAME IDENTIFIER AS THE PACKAGE IS VISIBLE BY
+ --     SELECTION.
+ 
+ -- HISTORY:
+ --     JET 08/11/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83012D IS
+ 
+      PACKAGE PACK IS
+           SUBTYPE PACK1 IS INTEGER;
+           PACK2 : INTEGER := 2;
+      END PACK;
+ 
+      TYPE REC IS RECORD
+           PACK3 : INTEGER;
+           PACK4 : INTEGER;
+      END RECORD;
+ 
+      R : REC := (PACK3 => 3, PACK4 => 1);
+ 
+      GENERIC
+           TYPE T IS RANGE <>;
+      PACKAGE GEN1 IS
+           J : INTEGER := IDENT_INT(1);
+      END GEN1;
+ 
+      GENERIC
+           I : INTEGER;
+      PACKAGE GEN2 IS
+           J : INTEGER := IDENT_INT(I);
+      END GEN2;
+ 
+      GENERIC
+           R : REC;
+      PACKAGE GEN3 IS
+           J : INTEGER := IDENT_INT(R.PACK4);
+      END GEN3;
+ 
+      GENERIC
+           PACK6 : INTEGER;
+      PACKAGE GEN4 IS
+           J : INTEGER := IDENT_INT(PACK6);
+      END GEN4;
+ 
+      FUNCTION FUNC (PACK5: INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN IDENT_INT(PACK5);
+      END FUNC;
+ 
+      PACKAGE PACK1 IS NEW GEN1(PACK.PACK1);
+      PACKAGE PACK2 IS NEW GEN2(PACK.PACK2);
+      PACKAGE PACK3 IS NEW GEN2(R.PACK3);
+      PACKAGE PACK4 IS NEW GEN3((1, PACK4 => 4));
+      PACKAGE PACK5 IS NEW GEN2(FUNC(PACK5 => 5));
+      PACKAGE PACK6 IS NEW GEN4(PACK6 => 6);
+ 
+ BEGIN
+      TEST ("C83012D", "CHECK THAT WITHIN A GENERIC PACKAGE " &
+                       "INSTANTIATION, A DECLARATION HAVING THE SAME " &
+                       "IDENTIFIER AS THE PACKAGE IS VISIBLE BY " &
+                       "SELECTION");
+ 
+      IF PACK1.J /= 1 THEN
+           FAILED ("INCORRECT VALUE OF PACK1.J");
+      END IF;
+ 
+      IF PACK2.J /= 2 THEN
+           FAILED ("INCORRECT VALUE OF PACK2.J");
+      END IF;
+ 
+      IF PACK3.J /= 3 THEN
+           FAILED ("INCORRECT VALUE OF PACK3.J");
+      END IF;
+ 
+      IF PACK4.J /= 4 THEN
+           FAILED ("INCORRECT VALUE OF PACK4.J");
+      END IF;
+ 
+      IF PACK5.J /= 5 THEN
+           FAILED ("INCORRECT VALUE OF PACK5.J");
+      END IF;
+ 
+      IF PACK6.J /= 6 THEN
+           FAILED ("INCORRECT VALUE OF PACK6.J");
+      END IF;
+ 
+      RESULT;
+ 
+ END C83012D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83022a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83022a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83022a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83022a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,338 ----
+ -- C83022A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A SUBPROGRAM FORMAL PART OR BODY
+ --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+ --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+ --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+ --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAH DECLARATION.
+ 
+ -- HISTORY:
+ --     TBN 08/01/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83022A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83022A", "CHECK THAT A DECLARATION IN A SUBPROGRAM " &
+                       "FORMAL PART OR BODY HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE                      -- SUBPROGRAM DECLARATIVE REGION.
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER) IS
+                C : INTEGER := A;
+                A : INTEGER := IDENT_INT(3);
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+                END IF;
+                IF ONE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+                END IF;
+                IF ONE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+                END IF;
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+                END IF;
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 5");
+                END IF;
+                IF EQUAL(1,1) THEN
+                     X := A;
+                ELSE
+                     X := ONE.A;
+                END IF;
+           END INNER;
+ 
+      BEGIN  -- ONE
+           INNER (A);
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 6");
+           END IF;
+      END ONE;
+ 
+      TWO:
+      DECLARE                     -- FORMAL PARAMETER OF SUBPROGRAM.
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+           OBJ : INTEGER := IDENT_INT(3);
+ 
+           PROCEDURE INNER (X : IN INTEGER := A;
+                            A : IN OUT INTEGER) IS
+                C : INTEGER := A;
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+                END IF;
+                IF TWO.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+                END IF;
+                IF TWO.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+                END IF;
+                IF C /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+                END IF;
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 14");
+                END IF;
+                IF EQUAL(1,1) THEN
+                     A := IDENT_INT(4);
+                ELSE
+                     A := 1;
+                END IF;
+           END INNER;
+ 
+      BEGIN  -- TWO
+           INNER (A => OBJ);
+           IF OBJ /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 15");
+           END IF;
+      END TWO;
+ 
+      THREE:
+      DECLARE            -- AFTER THE SPECIFICATION OF SUBPROGRAM.
+           A : INTEGER := IDENT_INT(2);
+ 
+           FUNCTION INNER (X : INTEGER) RETURN INTEGER;
+ 
+           B : INTEGER := A;
+ 
+           FUNCTION INNER (X : INTEGER) RETURN INTEGER IS
+                C : INTEGER := A;
+                A : INTEGER := IDENT_INT(3);
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+                END IF;
+                IF THREE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+                END IF;
+                IF THREE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+                END IF;
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+                END IF;
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 24");
+                END IF;
+                IF EQUAL(1,1) THEN
+                     RETURN A;
+                ELSE
+                     RETURN X;
+                END IF;
+           END INNER;
+ 
+      BEGIN  -- THREE
+           IF INNER(A) /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 25");
+           END IF;
+      END THREE;
+ 
+      FOUR:
+      DECLARE                              -- RENAMING DECLARATION.
+           A : INTEGER := IDENT_INT(2);
+ 
+           PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                               Y : IN OUT INTEGER);
+ 
+           PROCEDURE INNER (Z : IN INTEGER := A;
+                            A : IN OUT INTEGER) RENAMES TEMPLATE;
+ 
+           B : INTEGER := A;
+           OBJ : INTEGER := 5;
+ 
+           PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                               Y : IN OUT INTEGER) IS
+           BEGIN  -- TEMPLATE
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FOR VARIABLE - 30");
+                END IF;
+                IF Y /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT RESULTS FOR VARIABLE - 31");
+                END IF;
+                Y := IDENT_INT(2 * X);
+                IF FOUR.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FOR OUTER HOMOGRAPH - " &
+                             "32");
+                END IF;
+           END TEMPLATE;
+ 
+      BEGIN  -- FOUR
+           IF B /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 32");
+           END IF;
+           INNER (A => OBJ);
+           IF OBJ /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 33");
+           END IF;
+      END FOUR;
+ 
+      FIVE:
+      DECLARE                         -- GENERIC FORMAL SUBPROGRAM.
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER);
+ 
+           GENERIC
+                WITH PROCEDURE SUBPR (Y : IN OUT INTEGER) IS <>;
+           PACKAGE P IS
+                PAC_VAR : INTEGER := 1;
+           END P;
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER) IS
+                C : INTEGER := A;
+                A : INTEGER := IDENT_INT(3);
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 41");
+                END IF;
+                IF FIVE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 42");
+                END IF;
+                IF FIVE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 43");
+                END IF;
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 44");
+                END IF;
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 45");
+                END IF;
+                IF EQUAL(1,1) THEN
+                     X := A;
+                ELSE
+                     X := FIVE.A;
+                END IF;
+           END INNER;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                SUBPR (A);
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE PASSED OUT - 46");
+                END IF;
+                IF PAC_VAR /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE FOR PAC_VAR - 47");
+                END IF;
+           END P;
+ 
+           PACKAGE NEW_P IS NEW P (INNER);
+ 
+      BEGIN  -- FIVE
+           NULL;
+      END FIVE;
+ 
+      SIX:
+      DECLARE                              -- GENERIC INSTANTIATION.
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+           OBJ : INTEGER := IDENT_INT(3);
+ 
+           GENERIC
+           PROCEDURE INNER (X : IN INTEGER := A;
+                            A : IN OUT INTEGER);
+ 
+           PROCEDURE INNER (X : IN INTEGER := SIX.A;
+                            A : IN OUT INTEGER) IS
+                C : INTEGER := A;
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -50");
+                END IF;
+                IF SIX.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 51");
+                END IF;
+                IF SIX.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 52");
+                END IF;
+                IF C /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 53");
+                END IF;
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 54");
+                END IF;
+                IF EQUAL(1,1) THEN
+                     A := IDENT_INT(4);
+                ELSE
+                     A := 1;
+                END IF;
+           END INNER;
+ 
+           PROCEDURE SUBPR IS NEW INNER;
+ 
+      BEGIN  -- SIX
+           SUBPR (A => OBJ);
+           IF OBJ /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 55");
+           END IF;
+      END SIX;
+ 
+      SEVEN:
+      DECLARE                 --  OVERLOADING OF FUNCTIONS.
+ 
+           OBJ : INTEGER := 1;
+           FLO : FLOAT := 5.0;
+ 
+           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT);
+ 
+           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS
+           BEGIN
+                X := INTEGER(F);
+           END INNER;
+ 
+      BEGIN
+           FLO := 6.25;
+           INNER (OBJ, FLO);
+           IF OBJ /= IDENT_INT(6) THEN
+                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
+           END IF;
+      END SEVEN;
+ 
+ 
+      RESULT;
+ END C83022A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83022g0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83022g0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83022g0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83022g0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C83022G0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A SUBPROGRAM FORMAL PART OR BODY
+ --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+ --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+ --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+ --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAPH DECLARATION, IF THE SUBPROGRAM BODY IS COMPILED
+ --     SEPARATELY AS A SUBUNIT.
+ 
+ -- SEPARATE FILES ARE:
+ --     C83022G0M.ADA - (THIS FILE) MAIN PROGRAM.
+ --     C83022G1.ADA -- SUBPROGRAM BODIES.
+ 
+ -- HISTORY:
+ --     BCB 08/26/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C83022G0M IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      A : INTEGER := IDENT_INT(2);
+      B : INTEGER := A;
+ 
+      OBJ : INTEGER := IDENT_INT(3);
+ 
+      FLO : FLOAT := 5.0;
+ 
+      PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                          Y : IN OUT INTEGER);
+ 
+      PROCEDURE INNER4 (Z : IN INTEGER := A;
+                        A : IN OUT INTEGER) RENAMES TEMPLATE;
+ 
+      PROCEDURE INNER (X : IN OUT INTEGER) IS SEPARATE;
+ 
+      PROCEDURE INNER2 (X : IN INTEGER := A;
+                        A : IN OUT INTEGER) IS SEPARATE;
+ 
+      FUNCTION INNER3 (X : INTEGER) RETURN INTEGER IS SEPARATE;
+ 
+      PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                          Y : IN OUT INTEGER) IS SEPARATE;
+ 
+      PROCEDURE INNER5 (X : IN OUT INTEGER) IS SEPARATE;
+ 
+      GENERIC
+           WITH PROCEDURE SUBPR (Y : IN OUT INTEGER) IS <>;
+      PACKAGE P IS
+           PAC_VAR : INTEGER := 1;
+      END P;
+ 
+      PACKAGE BODY P IS
+      BEGIN
+           SUBPR (A);
+ 
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 1");
+           END IF;
+ 
+           IF PAC_VAR /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE FOR PAC_VAR - 2");
+           END IF;
+      END P;
+ 
+      PACKAGE NEW_P IS NEW P (INNER5);
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+      FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+      PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT);
+ 
+      FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+      PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT) IS SEPARATE;
+ 
+ BEGIN
+      TEST ("C83022G", "CHECK THAT A DECLARATION IN A SUBPROGRAM " &
+                       "FORMAL PART OR BODY HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      A := IDENT_INT(2);
+      B := A;
+ 
+      INNER (A);
+ 
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 3");
+      END IF;
+ 
+      A := IDENT_INT(2);
+ 
+      INNER2 (A => OBJ);
+ 
+      IF OBJ /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 4");
+      END IF;
+ 
+      A := IDENT_INT(2);
+ 
+      B := A;
+ 
+      IF INNER3(A) /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 5");
+      END IF;
+ 
+      A := IDENT_INT(2);
+ 
+      B := A;
+      OBJ := 5;
+ 
+      IF B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 6");
+      END IF;
+ 
+      INNER4 (A => OBJ);
+ 
+      IF OBJ /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 7");
+      END IF;
+ 
+      OBJ := 1;
+ 
+      FLO := 6.25;
+ 
+      INNER6 (OBJ, FLO);
+ 
+      IF OBJ /= IDENT_INT(6) THEN
+           FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 8");
+      END IF;
+ 
+      RESULT;
+ END C83022G0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83022g1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83022g1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83022g1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83022g1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,189 ----
+ -- C83022G1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A SUBPROGRAM FORMAL PART OR BODY
+ --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+ --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+ --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+ --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAPH DECLARATION, IF THE SUBPROGRAM BODY IS COMPILED
+ --     SEPARATELY AS A SUBUNIT.
+ 
+ -- HISTORY:
+ --     BCB 08/26/88  CREATED ORIGINAL TEST.
+ 
+ SEPARATE (C83022G0M)
+ PROCEDURE INNER (X : IN OUT INTEGER) IS
+      C : INTEGER := A;
+      A : INTEGER := IDENT_INT(3);
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+      END IF;
+ 
+      IF C83022G0M.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+      END IF;
+ 
+      IF C83022G0M.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+      END IF;
+ 
+      IF C /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 5");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           X := A;
+      ELSE
+           X := C83022G0M.A;
+      END IF;
+ END INNER;
+ 
+ SEPARATE (C83022G0M)
+ PROCEDURE INNER2 (X : IN INTEGER := C83022G0M.A;
+                   A : IN OUT INTEGER) IS
+      C : INTEGER := A;
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+      END IF;
+ 
+      IF C83022G0M.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+      END IF;
+ 
+      IF C83022G0M.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+      END IF;
+ 
+      IF C /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 14");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           A := IDENT_INT(4);
+      ELSE
+           A := 1;
+      END IF;
+ END INNER2;
+ 
+ SEPARATE (C83022G0M)
+ FUNCTION INNER3 (X : INTEGER) RETURN INTEGER IS
+      C : INTEGER := A;
+      A : INTEGER := IDENT_INT(3);
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+      END IF;
+ 
+      IF C83022G0M.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+      END IF;
+ 
+      IF C83022G0M.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+      END IF;
+ 
+      IF C /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 24");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           RETURN A;
+      ELSE
+           RETURN X;
+      END IF;
+ END INNER3;
+ 
+ SEPARATE (C83022G0M)
+ PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                     Y : IN OUT INTEGER) IS
+ BEGIN  -- TEMPLATE
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT RESULTS FOR VARIABLE - 30");
+      END IF;
+ 
+      IF Y /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT RESULTS FOR VARIABLE - 31");
+      END IF;
+ 
+      Y := IDENT_INT(2 * X);
+ 
+      IF C83022G0M.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT RESULTS FOR OUTER HOMOGRAPH - " &
+                   "32");
+      END IF;
+ END TEMPLATE;
+ 
+ SEPARATE (C83022G0M)
+ PROCEDURE INNER5 (X : IN OUT INTEGER) IS
+      C : INTEGER := A;
+      A : INTEGER := IDENT_INT(3);
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 41");
+      END IF;
+ 
+      IF C83022G0M.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 42");
+      END IF;
+ 
+      IF C83022G0M.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 43");
+      END IF;
+ 
+      IF C /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 44");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 45");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           X := A;
+      ELSE
+           X := C83022G0M.A;
+      END IF;
+ END INNER5;
+ 
+ SEPARATE (C83022G0M)
+ PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT) IS
+ BEGIN
+      X := INTEGER(F);
+ END INNER6;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83023a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83023a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83023a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83023a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,194 ----
+ -- C83023A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A DECLARATIVE REGION OF A TASK
+ --     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+ --     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+ --     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+ --     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAPH DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 08/29/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83023A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83023A", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
+                       "REGION OF A TASK HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE                      -- DECLARATIVE REGION.
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+ 
+           TASK INNER IS
+                ENTRY HERE (X : IN OUT INTEGER);
+           END INNER;
+ 
+           TASK BODY INNER IS
+                C : INTEGER := A;
+                A : INTEGER := IDENT_INT(3);
+           BEGIN
+                ACCEPT HERE (X : IN OUT INTEGER) DO
+                     IF A /= IDENT_INT(3) THEN
+                          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH" &
+                                  " - 1");
+                     END IF;
+ 
+                     IF ONE.A /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH" &
+                                  " - 2");
+                     END IF;
+ 
+                     IF ONE.B /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE " &
+                                  "- 3");
+                     END IF;
+ 
+                     IF C /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE FOR INNER VARIABLE " &
+                                  "- 4");
+                     END IF;
+ 
+                     IF X /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE PASSED IN - 5");
+                     END IF;
+ 
+                     IF EQUAL(1,1) THEN
+                          X := A;
+                     ELSE
+                          X := ONE.A;
+                     END IF;
+                END HERE;
+           END INNER;
+ 
+      BEGIN  -- ONE
+           INNER.HERE(A);
+ 
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 6");
+           END IF;
+      END ONE;
+ 
+      TWO:
+      DECLARE            -- AFTER THE SPECIFICATION OF TASK.
+           TASK INNER IS
+                ENTRY HERE (X : IN OUT INTEGER);
+           END INNER;
+ 
+           A : INTEGER := IDENT_INT(2);
+ 
+           B : INTEGER := A;
+ 
+           TASK BODY INNER IS
+                C : INTEGER := A;
+                A : INTEGER := IDENT_INT(3);
+           BEGIN
+                ACCEPT HERE (X : IN OUT INTEGER) DO
+                     IF A /= IDENT_INT(3) THEN
+                          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH" &
+                                  " - 10");
+                     END IF;
+ 
+                     IF TWO.A /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH" &
+                                  " - 11");
+                     END IF;
+ 
+                     IF TWO.B /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE " &
+                                  "- 12");
+                     END IF;
+ 
+                     IF C /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE FOR INNER VARIABLE " &
+                                  "- 13");
+                     END IF;
+ 
+                     IF X /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE PASSED IN - 14");
+                     END IF;
+ 
+                     IF EQUAL(1,1) THEN
+                          X := A;
+                     ELSE
+                          NULL;
+                     END IF;
+                END HERE;
+           END INNER;
+ 
+      BEGIN  -- TWO
+           INNER.HERE(A);
+ 
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 15");
+           END IF;
+      END TWO;
+ 
+      THREE:
+      DECLARE                 --  OVERLOADING OF FUNCTIONS.
+ 
+           OBJ : INTEGER := 1;
+           FLO : FLOAT := 5.0;
+ 
+           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+           TASK INNER IS
+                ENTRY HERE (X : IN OUT INTEGER);
+           END INNER;
+ 
+           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+           TASK BODY INNER IS
+                F : FLOAT := 6.25;
+           BEGIN
+                ACCEPT HERE (X : IN OUT INTEGER) DO
+                     X := INTEGER(F);
+                END HERE;
+           END INNER;
+ 
+      BEGIN
+           INNER.HERE (OBJ);
+ 
+           IF OBJ /= IDENT_INT(6) THEN
+                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 20");
+           END IF;
+      END THREE;
+ 
+      RESULT;
+ END C83023A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83024a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83024a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83024a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83024a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,185 ----
+ -- C83024A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A DECLARATIVE REGION FOR A GENERIC
+ --     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+ --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+ --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+ --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAH DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 08/30/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C83024A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83024A", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
+                       "REGION FOR A GENERIC PACKAGE HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+           OBJ : INTEGER := IDENT_INT(3);
+ 
+           GENERIC
+                X : IN INTEGER := A;
+                A : IN OUT INTEGER;
+           PACKAGE INNER IS
+                C : INTEGER := A;
+           END INNER;
+ 
+           PACKAGE BODY INNER IS
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+                END IF;
+ 
+                IF ONE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+                END IF;
+ 
+                IF ONE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+                END IF;
+ 
+                IF C /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+                END IF;
+ 
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 14");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     A := IDENT_INT(4);
+                ELSE
+                     A := 1;
+                END IF;
+           END INNER;
+ 
+           PACKAGE NEW_INNER IS NEW INNER (A => OBJ);
+ 
+      BEGIN  -- ONE
+           IF OBJ /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 15");
+           END IF;
+      END ONE;
+ 
+      TWO:
+      DECLARE            -- AFTER THE SPECIFICATION OF PACKAGE.
+           A : INTEGER := IDENT_INT(2);
+ 
+           GENERIC
+                X : IN OUT INTEGER;
+           PACKAGE INNER IS
+                A : INTEGER := IDENT_INT(3);
+           END INNER;
+ 
+           B : INTEGER := A;
+ 
+           PACKAGE BODY INNER IS
+                C : INTEGER := TWO.A;
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+                END IF;
+ 
+                IF TWO.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+                END IF;
+ 
+                IF TWO.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+                END IF;
+ 
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+                END IF;
+ 
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 24");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     X := A;
+                ELSE
+                     NULL;
+                END IF;
+           END INNER;
+ 
+           PACKAGE NEW_INNER IS NEW INNER (A);
+ 
+      BEGIN  -- TWO
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 25");
+           END IF;
+      END TWO;
+ 
+      THREE:
+      DECLARE                 --  OVERLOADING OF FUNCTIONS.
+ 
+           OBJ : INTEGER := 1;
+           FLO : FLOAT := 6.25;
+ 
+           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+           GENERIC
+                X : IN OUT INTEGER;
+                F : IN FLOAT;
+           PACKAGE INNER IS
+           END INNER;
+ 
+           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+           PACKAGE BODY INNER IS
+           BEGIN
+                X := INTEGER(F);
+           END INNER;
+ 
+           PACKAGE NEW_INNER IS NEW INNER (OBJ, FLO);
+ 
+      BEGIN
+           IF OBJ /= IDENT_INT(6) THEN
+                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
+           END IF;
+      END THREE;
+ 
+      RESULT;
+ END C83024A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83024e0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83024e0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83024e0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83024e0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C83024E0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN THE DECLARATIVE REGION OF A GENERIC
+ --     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+ --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+ --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+ --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAPH DECLARATION, IF THE GENERIC PACKAGE BODY IS SEPARATELY
+ --     COMPILED, BUT NOT AS A SUBUNIT.
+ 
+ -- HISTORY:
+ --     BCB 08/30/88  CREATED ORIGINAL TEST.
+ -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ GENERIC
+      TYPE T IS PRIVATE;
+      X : T;
+ FUNCTION C83024E_GEN_FUN RETURN T;
+ 
+ FUNCTION C83024E_GEN_FUN RETURN T IS
+ BEGIN
+      RETURN X;
+ END C83024E_GEN_FUN;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE(REPORT);
+ PACKAGE C83024E_P1 IS
+      A : INTEGER := IDENT_INT(2);
+      B : INTEGER := A;
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+      GENERIC
+           X : IN OUT INTEGER;
+      PACKAGE C83024E_PACK1 IS
+           C : INTEGER := A;
+           A : INTEGER := IDENT_INT(3);
+      END C83024E_PACK1;
+ END C83024E_P1;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE(REPORT);
+ PACKAGE C83024E_P2 IS
+      A : INTEGER := IDENT_INT(2);
+      B : INTEGER := A;
+      OBJ : INTEGER := IDENT_INT(3);
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+      GENERIC
+           X : IN INTEGER := A;
+           A : IN OUT INTEGER;
+      PACKAGE C83024E_PACK2 IS
+           C : INTEGER := A;
+      END C83024E_PACK2;
+ END C83024E_P2;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE(REPORT);
+ PACKAGE C83024E_P3 IS
+      A : INTEGER := IDENT_INT(2);
+      B : INTEGER := A;
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+      GENERIC
+           X : IN OUT INTEGER;
+      PACKAGE C83024E_PACK3 IS
+      END C83024E_PACK3;
+ END C83024E_P3;
+ 
+ WITH REPORT; USE REPORT;
+ WITH C83024E_GEN_FUN;
+ PRAGMA ELABORATE(REPORT,C83024E_GEN_FUN);
+ PACKAGE C83024E_P4 IS
+      OBJ : INTEGER := IDENT_INT(1);
+      FLO : FLOAT := 6.25;
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+      FUNCTION F IS NEW C83024E_GEN_FUN (INTEGER, OBJ);
+      FUNCTION F IS NEW C83024E_GEN_FUN (FLOAT, FLO);
+ 
+      GENERIC
+           X : IN OUT INTEGER;
+           F : IN FLOAT;
+      PACKAGE C83024E_PACK4 IS
+      END C83024E_PACK4;
+ END C83024E_P4;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83024e1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83024e1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83024e1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83024e1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,220 ----
+ -- C83024E1M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN THE DECLARATIVE REGION OF A GENERIC
+ --     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+ --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+ --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+ --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAPH DECLARATION, IF THE GENERIC PACKAGE BODY IS SEPARATELY
+ --     COMPILED, BUT NOT AS A SUBUNIT.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT SEPARATE
+ --     COMPILATIONS OF GENERIC SPECIFICATIONS AND BODIES.
+ 
+ -- SEPARATE FILES ARE:
+ --     C83024E0.ADA -- GENERIC PACKAGE SPECIFICATIONS.
+ --     C83024E1M.ADA - (THIS FILE) GENERIC PACKAGE BODIES AND
+ --                     MAIN PROGRAM.
+ 
+ -- HISTORY:
+ --     BCB 08/30/88  CREATED ORIGINAL TEST.
+ -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ PACKAGE BODY C83024E_P1 IS
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+        NULL;
+      END;
+ 
+      PACKAGE BODY C83024E_PACK1 IS
+      BEGIN
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+           END IF;
+ 
+           IF C83024E_P1.A /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+           END IF;
+ 
+           IF C83024E_P1.B /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+           END IF;
+ 
+           IF C /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+           END IF;
+ 
+           IF X /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE PASSED IN - 5");
+           END IF;
+ 
+           IF EQUAL(1,1) THEN
+                X := A;
+           ELSE
+                X := C83024E_P1.A;
+           END IF;
+      END C83024E_PACK1;
+ END C83024E_P1;
+ 
+ PACKAGE BODY C83024E_P2 IS
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+        NULL;
+      END;
+ 
+      PACKAGE BODY C83024E_PACK2 IS
+      BEGIN
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+           END IF;
+ 
+           IF C83024E_P2.A /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+           END IF;
+ 
+           IF C83024E_P2.B /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+           END IF;
+ 
+           IF C /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+           END IF;
+ 
+           IF X /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE PASSED IN - 14");
+           END IF;
+ 
+           IF EQUAL(1,1) THEN
+                A := IDENT_INT(4);
+           ELSE
+                A := 1;
+           END IF;
+      END C83024E_PACK2;
+ END C83024E_P2;
+ 
+ PACKAGE BODY C83024E_P3 IS
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+        NULL;
+      END;
+ 
+      PACKAGE BODY C83024E_PACK3 IS
+           C : INTEGER := A;
+           A : INTEGER := IDENT_INT(3);
+      BEGIN
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+           END IF;
+ 
+           IF C83024E_P3.A /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+           END IF;
+ 
+           IF C83024E_P3.B /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+           END IF;
+ 
+           IF C /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+           END IF;
+ 
+           IF X /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE PASSED IN - 24");
+           END IF;
+ 
+           IF EQUAL(1,1) THEN
+                X := A;
+           ELSE
+                NULL;
+           END IF;
+      END C83024E_PACK3;
+ END C83024E_P3;
+ 
+ PACKAGE BODY C83024E_P4 IS
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+        NULL;
+      END;
+ 
+      PACKAGE BODY C83024E_PACK4 IS
+      BEGIN
+           X := INTEGER(F);
+      END C83024E_PACK4;
+ END C83024E_P4;
+ 
+ WITH REPORT; USE REPORT;
+ WITH C83024E_P1; WITH C83024E_P2;
+ WITH C83024E_P3; WITH C83024E_P4;
+ USE C83024E_P1; USE C83024E_P2;
+ USE C83024E_P3; USE C83024E_P4;
+ PROCEDURE C83024E1M IS
+ 
+ BEGIN
+      TEST ("C83024E", "CHECK THAT A DECLARATION IN THE DECLARATIVE " &
+                       "REGION OF A GENERIC PACKAGE HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      DECLARE
+           PACKAGE NEW_C83024E_PACK1 IS NEW C83024E_PACK1 (C83024E_P1.A);
+      BEGIN
+           IF C83024E_P1.A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 6");
+           END IF;
+      END;
+ 
+      DECLARE
+           PACKAGE NEW_C83024E_PACK2 IS
+                NEW C83024E_PACK2 (A => C83024E_P2.OBJ);
+      BEGIN
+           IF C83024E_P2.OBJ /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 15");
+           END IF;
+      END;
+ 
+      DECLARE
+           PACKAGE NEW_C83024E_PACK3 IS NEW C83024E_PACK3 (C83024E_P3.A);
+      BEGIN
+           IF C83024E_P3.A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 25");
+           END IF;
+      END;
+ 
+      DECLARE
+           PACKAGE NEW_C83024E_PACK4 IS
+                NEW C83024E_PACK4 (C83024E_P4.OBJ, FLO);
+      BEGIN
+           IF C83024E_P4.OBJ /= IDENT_INT(6) THEN
+                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C83024E1M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83025a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83025a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83025a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83025a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,283 ----
+ -- C83025A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN THE DECLARATIVE REGION OF A GENERIC
+ --     SUBPROGRAM HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+ --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+ --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+ --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAPH DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 08/31/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C83025A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83025A", "CHECK THAT A DECLARATION IN THE DECLARATIVE " &
+                       "REGION OF A GENERIC SUBPROGRAM HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE                      -- SUBPROGRAM DECLARATIVE REGION.
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+ 
+           GENERIC
+           PROCEDURE INNER (X : IN OUT INTEGER);
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER) IS
+                C : INTEGER := A;
+                A : INTEGER := IDENT_INT(3);
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+                END IF;
+ 
+                IF ONE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+                END IF;
+ 
+                IF ONE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+                END IF;
+ 
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+                END IF;
+ 
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 5");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     X := A;
+                ELSE
+                     X := ONE.A;
+                END IF;
+           END INNER;
+ 
+           PROCEDURE NEW_INNER IS NEW INNER;
+ 
+      BEGIN  -- ONE
+           NEW_INNER (A);
+ 
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 6");
+           END IF;
+      END ONE;
+ 
+      TWO:
+      DECLARE               -- FORMAL PARAMETER OF GENERIC SUBPROGRAM.
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+           OBJ : INTEGER := IDENT_INT(3);
+ 
+           GENERIC
+           PROCEDURE INNER (X : IN INTEGER := A;
+                            A : IN OUT INTEGER);
+ 
+           PROCEDURE INNER (X : IN INTEGER := TWO.A;
+                            A : IN OUT INTEGER) IS
+                C : INTEGER := A;
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+                END IF;
+ 
+                IF TWO.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+                END IF;
+ 
+                IF TWO.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+                END IF;
+ 
+                IF C /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+                END IF;
+ 
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 14");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     A := IDENT_INT(4);
+                ELSE
+                     A := 1;
+                END IF;
+           END INNER;
+ 
+           PROCEDURE NEW_INNER IS NEW INNER;
+ 
+      BEGIN  -- TWO
+           NEW_INNER (A => OBJ);
+ 
+           IF OBJ /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 15");
+           END IF;
+      END TWO;
+ 
+      THREE:
+      DECLARE      -- AFTER THE SPECIFICATION OF GENERIC SUBPROGRAM.
+           GENERIC
+                A : INTEGER := IDENT_INT(3);
+           FUNCTION INNER (X : INTEGER) RETURN INTEGER;
+ 
+           A : INTEGER := IDENT_INT(2);
+ 
+           B : INTEGER := A;
+ 
+           FUNCTION INNER (X : INTEGER) RETURN INTEGER IS
+                C : INTEGER := THREE.A;
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+                END IF;
+ 
+                IF THREE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+                END IF;
+ 
+                IF THREE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+                END IF;
+ 
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+                END IF;
+ 
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 24");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     RETURN A;
+                ELSE
+                     RETURN X;
+                END IF;
+           END INNER;
+ 
+           FUNCTION NEW_INNER IS NEW INNER;
+ 
+      BEGIN  -- THREE
+           IF NEW_INNER(A) /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 25");
+           END IF;
+      END THREE;
+ 
+      FOUR:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+ 
+           GENERIC
+                A : INTEGER;
+                B : INTEGER := A;
+           PROCEDURE INNER (X : IN OUT INTEGER);
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER) IS
+                C : INTEGER := FOUR.A;
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 30");
+                END IF;
+ 
+                IF B /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 31");
+                END IF;
+ 
+                IF FOUR.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 32");
+                END IF;
+ 
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 33");
+                END IF;
+ 
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 34");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     X := A;
+                ELSE
+                     X := FOUR.A;
+                END IF;
+           END INNER;
+ 
+           PROCEDURE NEW_INNER IS NEW INNER (A => IDENT_INT(3));
+ 
+      BEGIN
+           NEW_INNER (A);
+ 
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 35");
+           END IF;
+      END FOUR;
+ 
+      FIVE:
+      DECLARE                 --  OVERLOADING OF FUNCTIONS.
+ 
+           OBJ : INTEGER := 1;
+           FLO : FLOAT := 5.0;
+ 
+           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+           GENERIC
+           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT);
+ 
+           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS
+           BEGIN
+                X := INTEGER(F);
+           END INNER;
+ 
+           PROCEDURE NEW_INNER IS NEW INNER;
+ 
+      BEGIN  -- FIVE
+           FLO := 6.25;
+ 
+           NEW_INNER (OBJ, FLO);
+ 
+           IF OBJ /= IDENT_INT(6) THEN
+                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 40");
+           END IF;
+      END FIVE;
+ 
+      RESULT;
+ END C83025A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83025c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83025c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83025c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83025c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,345 ----
+ -- C83025C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A DECLARATIVE REGION OF A GENERIC
+ --     SUBPROGRAM HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+ --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+ --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+ --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+ --     HOMOGRAPH DECLARATION, IF THE GENERIC SUBPROGRAM BODY IS COMPILED
+ --     AS A SUBUNIT IN THE SAME COMPILATION.
+ 
+ -- HISTORY:
+ --     BCB 09/01/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE(REPORT);
+ PACKAGE C83025C_PACK IS
+      Y : INTEGER := IDENT_INT(5);
+      Z : INTEGER := Y;
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      A : INTEGER := IDENT_INT(2);
+      B : INTEGER := A;
+ 
+      OBJ : INTEGER := IDENT_INT(3);
+ 
+      FLO : FLOAT := 5.0;
+ 
+      TYPE ENUM IS (ONE, TWO, THREE, FOUR);
+ 
+      EOBJ : ENUM := ONE;
+ 
+      GENERIC
+           Y : FLOAT := 2.0;
+      PROCEDURE INNER (X : IN OUT INTEGER);
+ 
+      GENERIC
+           Y : BOOLEAN := TRUE;
+      PROCEDURE INNER2 (X : IN INTEGER := A;
+                        A : IN OUT INTEGER);
+ 
+      GENERIC
+           Y : ENUM := ONE;
+      FUNCTION INNER3 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER;
+ 
+      GENERIC
+           Y : ENUM;
+      FUNCTION INNER4 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER;
+ 
+      GENERIC
+           Y : CHARACTER := 'A';
+      PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
+                        Z : CHARACTER := Y);
+ END C83025C_PACK;
+ 
+ PACKAGE BODY C83025C_PACK IS
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+      FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+      FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+      PROCEDURE INNER (X : IN OUT INTEGER) IS SEPARATE;
+ 
+      PROCEDURE INNER2 (X : IN INTEGER := C83025C_PACK.A;
+                        A : IN OUT INTEGER) IS SEPARATE;
+ 
+      FUNCTION INNER3 (X : INTEGER;
+                       Z : ENUM := Y) RETURN INTEGER IS SEPARATE;
+ 
+      FUNCTION INNER4 (X : INTEGER;
+                       Z : ENUM := Y) RETURN INTEGER IS SEPARATE;
+ 
+      PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
+                        Z : CHARACTER := Y) IS SEPARATE;
+ END C83025C_PACK;
+ 
+ SEPARATE (C83025C_PACK)
+ PROCEDURE INNER (X : IN OUT INTEGER) IS
+      C : INTEGER := A;
+      A : INTEGER := IDENT_INT(3);
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+      END IF;
+ 
+      IF C83025C_PACK.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+      END IF;
+ 
+      IF C83025C_PACK.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+      END IF;
+ 
+      IF C /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 5");
+      END IF;
+ 
+      IF Y /= 2.0 THEN
+           FAILED ("INCORRECT VALUE INNER HOMOGRAPH - 6");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           X := A;
+      ELSE
+           X := C83025C_PACK.A;
+      END IF;
+ END INNER;
+ 
+ SEPARATE (C83025C_PACK)
+ PROCEDURE INNER2 (X : IN INTEGER := C83025C_PACK.A;
+                  A : IN OUT INTEGER) IS
+      C : INTEGER := A;
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+      END IF;
+ 
+      IF C83025C_PACK.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+      END IF;
+ 
+      IF C83025C_PACK.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+      END IF;
+ 
+      IF C /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 14");
+      END IF;
+ 
+      IF Y /= TRUE THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 15");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           A := IDENT_INT(4);
+      ELSE
+           A := 1;
+      END IF;
+ END INNER2;
+ 
+ SEPARATE (C83025C_PACK)
+ FUNCTION INNER3 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER IS
+      C : INTEGER := A;
+      A : INTEGER := IDENT_INT(3);
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+      END IF;
+ 
+      IF C83025C_PACK.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+      END IF;
+ 
+      IF C83025C_PACK.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+      END IF;
+ 
+      IF C /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 24");
+      END IF;
+ 
+      IF Y /= ONE THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 25");
+      END IF;
+ 
+      IF Z /= ONE THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 26");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           RETURN A;
+      ELSE
+           RETURN X;
+      END IF;
+ END INNER3;
+ 
+ SEPARATE (C83025C_PACK)
+ FUNCTION INNER4 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER IS
+      C : INTEGER := A;
+      A : INTEGER := IDENT_INT(3);
+ BEGIN
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 30");
+      END IF;
+ 
+      IF C83025C_PACK.A /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 31");
+      END IF;
+ 
+      IF C83025C_PACK.B /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 32");
+      END IF;
+ 
+      IF C /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 33");
+      END IF;
+ 
+      IF X /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE PASSED IN - 34");
+      END IF;
+ 
+      IF Y /= ONE THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 35");
+      END IF;
+ 
+      IF Z /= ONE THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 36");
+      END IF;
+ 
+      IF EQUAL(1,1) THEN
+           RETURN A;
+      ELSE
+           RETURN X;
+      END IF;
+ END INNER4;
+ 
+ SEPARATE (C83025C_PACK)
+ PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
+                   Z : CHARACTER := Y) IS
+ BEGIN
+      X := INTEGER(F);
+ 
+      IF Y /= 'A' THEN
+           FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 40");
+      END IF;
+ 
+      IF Z /= 'A' THEN
+           FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 41");
+      END IF;
+ END INNER5;
+ 
+ WITH REPORT; USE REPORT;
+ WITH C83025C_PACK; USE C83025C_PACK;
+ PROCEDURE C83025C IS
+ 
+      PROCEDURE NEW_INNER IS NEW INNER;
+ 
+      PROCEDURE NEW_INNER2 IS NEW INNER2;
+ 
+      FUNCTION NEW_INNER3 IS NEW INNER3;
+ 
+      FUNCTION NEW_INNER4 IS NEW INNER4 (Y => EOBJ);
+ 
+      PROCEDURE NEW_INNER5 IS NEW INNER5;
+ 
+ BEGIN
+      TEST ("C83025C", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
+                       "REGION OF A GENERIC SUBPROGRAM HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      A := IDENT_INT(2);
+      B := A;
+ 
+      NEW_INNER (A);
+ 
+      IF A /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 7");
+      END IF;
+ 
+      A := IDENT_INT(2);
+ 
+      NEW_INNER2 (A => OBJ);
+ 
+      IF OBJ /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 16");
+      END IF;
+ 
+      A := IDENT_INT(2);
+ 
+      B := A;
+ 
+      IF NEW_INNER3(A) /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 27");
+      END IF;
+ 
+      A := IDENT_INT(2);
+ 
+      B := A;
+ 
+      IF NEW_INNER4(A) /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE PASSED OUT - 37");
+      END IF;
+ 
+      OBJ := 1;
+ 
+      FLO := 6.25;
+ 
+      NEW_INNER5 (OBJ, FLO);
+ 
+      IF OBJ /= IDENT_INT(6) THEN
+           FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 42");
+      END IF;
+ 
+      IF Y /= 5 THEN
+           FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 50");
+      END IF;
+ 
+      IF Z /= 5 THEN
+           FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 51");
+      END IF;
+ 
+      RESULT;
+ END C83025C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83027a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83027a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83027a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83027a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,188 ----
+ -- C83027A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A RECORD DECLARATION HIDES AN OUTER
+ --     DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION
+ --     IS DIRECTLY VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE
+ --     DECLARATION OF THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS
+ --     VISIBLE BY SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 09/02/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83027A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83027A", "CHECK THAT A DECLARATION IN A RECORD " &
+                       "DECLARATION HIDES AN OUTER DECLARATION OF " &
+                       "A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+           OBJ : INTEGER := IDENT_INT(3);
+ 
+           TYPE INNER2 (A : INTEGER := IDENT_INT(3)) IS RECORD
+                C : INTEGER := ONE.A;
+                D : INTEGER := A;
+           END RECORD;
+ 
+           E : INTEGER := A;
+ 
+           RECVAR : INNER2;
+ 
+      BEGIN  -- ONE
+           IF A /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 1");
+           END IF;
+ 
+           IF RECVAR.A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 2");
+           END IF;
+ 
+           IF E /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+           END IF;
+ 
+           IF RECVAR.C /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+           END IF;
+ 
+           IF RECVAR.D /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 5");
+           END IF;
+ 
+           IF EQUAL(1,1) THEN
+                OBJ := RECVAR.A;
+           ELSE
+                OBJ := 1;
+           END IF;
+ 
+           IF OBJ /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 6");
+           END IF;
+      END ONE;
+ 
+      TWO:
+      DECLARE
+ 
+           GENERIC
+                A : INTEGER := IDENT_INT(2);
+                B : INTEGER := A;
+           PACKAGE P IS
+                TYPE INNER (C : INTEGER := A;
+                            A : INTEGER := IDENT_INT(3)) IS RECORD
+                     D : INTEGER := A;
+                END RECORD;
+           END P;
+ 
+           PACKAGE BODY P IS
+                RECVAR : INNER;
+           BEGIN
+                IF RECVAR.A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+                END IF;
+ 
+                IF A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+                END IF;
+ 
+                IF B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+                END IF;
+ 
+                IF RECVAR.C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+                END IF;
+ 
+                IF RECVAR.D /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 14");
+                END IF;
+           END P;
+ 
+           PACKAGE PACK IS NEW P;
+ 
+      BEGIN  -- TWO
+           NULL;
+      END TWO;
+ 
+      THREE:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+           OBJ : INTEGER := IDENT_INT(3);
+ 
+           TYPE INNER4 (C : INTEGER := A;
+                        A : INTEGER := IDENT_INT(3);
+                        X : INTEGER := THREE.A) IS RECORD
+                D : INTEGER := A;
+           END RECORD;
+ 
+           RECVAR : INNER4;
+ 
+      BEGIN  -- THREE
+           IF A /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 20");
+           END IF;
+ 
+           IF RECVAR.A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 21");
+           END IF;
+ 
+           IF RECVAR.C /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 22");
+           END IF;
+ 
+           IF RECVAR.D /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+           END IF;
+ 
+           IF RECVAR.X /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 24");
+           END IF;
+ 
+           IF EQUAL(1,1) THEN
+                OBJ := RECVAR.A;
+           ELSE
+                OBJ := 1;
+           END IF;
+ 
+           IF OBJ /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 25");
+           END IF;
+      END THREE;
+ 
+      RESULT;
+ END C83027A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83027c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83027c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83027c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83027c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,157 ----
+ -- C83027C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION WITHIN THE DISCRIMINANT PART OF A
+ --     PRIVATE TYPE DECLARATION, AN INCOMPLETE TYPE DECLARATION, AND A
+ --     GENERIC FORMAL TYPE DECLARATION HIDES AN OUTER DECLARATION OF A
+ --     HOMOGRAPH.  ALSO, CHECK THAT THE OUTER DECLARATION IS DIRECTLY
+ --     VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE
+ --     INNER HOMOGRAPH AND THE OUTER DECLARATION IS VISIBLE BY SELECTION
+ --     AFTER THE INNER HOMOGRAPH DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 09/06/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83027C IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83027C", "CHECK THAT A DECLARATION IN THE DISCRIMINANT " &
+                       "PART OF A PRIVATE TYPE DECLARATION, AN " &
+                       "INCOMPLETE TYPE DECLARATION, AND A GENERIC " &
+                       "FORMAL TYPE DECLARATION HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+ 
+           D : INTEGER := IDENT_INT(2);
+ 
+           G : INTEGER := IDENT_INT(2);
+           H : INTEGER := G;
+ 
+           TYPE REC (Z : INTEGER) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           GENERIC
+                TYPE INNER3 (G : INTEGER) IS PRIVATE;
+           PACKAGE P_ONE IS
+                TYPE INNER (X : INTEGER := A;
+                            A : INTEGER := IDENT_INT(3);
+                            C : INTEGER := ONE.A) IS PRIVATE;
+                TYPE INNER2 (Y : INTEGER := D;
+                             D : INTEGER := IDENT_INT(3);
+                             F : INTEGER := ONE.D);
+                TYPE INNER2 (Y : INTEGER := D;
+                             D : INTEGER := IDENT_INT(3);
+                             F : INTEGER := ONE.D) IS RECORD
+                     E : INTEGER := D;
+                END RECORD;
+           PRIVATE
+                TYPE INNER (X : INTEGER := A;
+                            A : INTEGER := IDENT_INT(3);
+                            C : INTEGER := ONE.A) IS RECORD
+                     B : INTEGER := A;
+                END RECORD;
+           END P_ONE;
+ 
+           PACKAGE BODY P_ONE IS
+                RECVAR : INNER;
+                RECVAR2 : INNER2;
+                RECVAR3 : INNER3(3);
+           BEGIN
+                IF RECVAR.A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+                END IF;
+ 
+                IF A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+                END IF;
+ 
+                IF RECVAR.B /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 3");
+                END IF;
+ 
+                IF RECVAR.C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+                END IF;
+ 
+                IF RECVAR.X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 5");
+                END IF;
+ 
+                IF RECVAR2.D /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 6");
+                END IF;
+ 
+                IF D /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 7");
+                END IF;
+ 
+                IF RECVAR2.E /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 8");
+                END IF;
+ 
+                IF RECVAR2.F /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 9");
+                END IF;
+ 
+                IF RECVAR2.Y /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 10");
+                END IF;
+ 
+                IF RECVAR3.G /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 11");
+                END IF;
+ 
+                IF G /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 12");
+                END IF;
+ 
+                IF H /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 13");
+                END IF;
+           END P_ONE;
+ 
+           PACKAGE NEW_P_ONE IS NEW P_ONE (REC);
+ 
+      BEGIN  -- ONE
+           NULL;
+      END ONE;
+ 
+      RESULT;
+ END C83027C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83028a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83028a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83028a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83028a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- C83028A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DECLARATION IN A BLOCK STATEMENT HIDES AN OUTER
+ --     DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION
+ --     IS DIRECTLY VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE
+ --     DECLARATION OF THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS
+ --     VISIBLE BY SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 09/06/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83028A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83028A", "CHECK THAT A DECLARATION IN A BLOCK " &
+                       "STATEMENT HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+ 
+      BEGIN  -- ONE
+           DECLARE
+                C : INTEGER := A;
+                A : INTEGER := IDENT_INT(3);
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+                END IF;
+ 
+                IF ONE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+                END IF;
+ 
+                IF ONE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+                END IF;
+ 
+                IF C /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     ONE.A := A;
+                END IF;
+           END;
+ 
+           IF A /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 6");
+           END IF;
+      END ONE;
+ 
+      TWO:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+           OBJ : INTEGER := IDENT_INT(3);
+ 
+      BEGIN  -- TWO
+           DECLARE
+                X : INTEGER := A;
+                A : INTEGER := OBJ;
+                C : INTEGER := A;
+           BEGIN
+                IF A /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+                END IF;
+ 
+                IF TWO.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+                END IF;
+ 
+                IF TWO.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+                END IF;
+ 
+                IF C /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+                END IF;
+ 
+                IF X /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE PASSED IN - 14");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     TWO.OBJ := IDENT_INT(4);
+                ELSE
+                     TWO.OBJ := 1;
+                END IF;
+           END;
+ 
+           IF OBJ /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 15");
+           END IF;
+      END TWO;
+ 
+      THREE:
+      DECLARE                 --  OVERLOADING OF FUNCTIONS.
+ 
+           OBJ : INTEGER := 1;
+           FLO : FLOAT := 5.0;
+ 
+           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+      BEGIN
+           DECLARE
+                F : FLOAT := 6.25;
+           BEGIN
+                THREE.OBJ := INTEGER(F);
+           END;
+ 
+           IF OBJ /= IDENT_INT(6) THEN
+                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 20");
+           END IF;
+      END THREE;
+ 
+      RESULT;
+ END C83028A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83029a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83029a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83029a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83029a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C83029A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A LOOP PARAMETER HIDES AN OUTER DECLARATION OF A
+ --     HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION IS DIRECTLY
+ --     VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE DECLARATION OF
+ --     THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS VISIBLE BY
+ --     SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
+ 
+ -- HISTORY:
+ --     BCB 09/06/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83029A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           X : T;
+      FUNCTION GEN_FUN RETURN T;
+ 
+      FUNCTION GEN_FUN RETURN T IS
+      BEGIN
+           RETURN X;
+      END GEN_FUN;
+ 
+ BEGIN
+      TEST ("C83029A", "CHECK THAT A LOOP PARAMETER HIDES AN OUTER " &
+                       "DECLARATION OF A HOMOGRAPH");
+ 
+      ONE:
+      DECLARE
+           A : INTEGER := IDENT_INT(2);
+           B : INTEGER := A;
+           C : INTEGER;
+ 
+      BEGIN  -- ONE
+ 
+           FOR A IN 1 .. 1 LOOP
+                C := A;
+ 
+                IF A /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+                END IF;
+ 
+                IF ONE.A /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+                END IF;
+ 
+                IF ONE.B /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+                END IF;
+ 
+                IF C /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+                END IF;
+ 
+                IF EQUAL(1,1) THEN
+                     ONE.A := A;
+                END IF;
+           END LOOP;
+ 
+           IF A /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE PASSED OUT - 6");
+           END IF;
+      END ONE;
+ 
+      TWO:
+      DECLARE                 --  OVERLOADING OF FUNCTIONS.
+ 
+           OBJ : INTEGER := 1;
+           FLO : FLOAT := 5.0;
+ 
+           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+ 
+           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+ 
+      BEGIN
+           FOR F IN 1 .. 1 LOOP
+                OBJ := INTEGER(F);
+           END LOOP;
+ 
+           IF OBJ /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE RETURNED - 10");
+           END IF;
+      END TWO;
+ 
+      RESULT;
+ END C83029A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83030a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83030a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83030a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83030a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,234 ----
+ -- C83030A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY, NO SUBPROGRAM
+ --     DECLARED IN AN OUTER DECLARATIVE REGION IS HIDDEN (UNLESS THE
+ --     SUBPROGRAM IS A HOMOGRAPH OF THE GENERIC SUBPROGRAM).
+ 
+ -- HISTORY:
+ --     TBN 08/03/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83030A IS
+ 
+      GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
+      SWITCH1 : BOOLEAN := TRUE;
+ 
+      PROCEDURE P IS
+      BEGIN
+           GLOBAL := IDENT_INT(1);
+      END P;
+ 
+      PROCEDURE P (X : INTEGER) IS
+      BEGIN
+           GLOBAL := IDENT_INT(X);
+      END P;
+ 
+ BEGIN
+      TEST ("C83030A", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY, " &
+                       "NO SUBPROGRAM DECLARED IN AN OUTER " &
+                       "DECLARATIVE REGION IS HIDDEN " &
+                       "(UNLESS THE SUBPROGRAM IS A HOMOGRAPH OF THE " &
+                       "GENERIC SUBPROGRAM)");
+ 
+      ONE:
+      DECLARE
+           GENERIC
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+                A : INTEGER := IDENT_INT(2);
+           BEGIN
+                IF SWITCH1 THEN
+                     SWITCH1 := FALSE;
+                     P;
+                     IF GLOBAL /= IDENT_INT(3) THEN
+                          FAILED ("INCORRECT VALUE FOR PROCEDURE CALL " &
+                                  "- 1");
+                     END IF;
+                END IF;
+                P(A);
+                IF GLOBAL /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
+                END IF;
+                GLOBAL := IDENT_INT(3);
+           END P;
+ 
+           PROCEDURE NEW_P IS NEW P;
+ 
+      BEGIN
+           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+                FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
+           END IF;
+           NEW_P;
+           IF GLOBAL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
+           END IF;
+      END ONE;
+ 
+ 
+      TWO:
+      DECLARE
+           GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
+           SWITCH : BOOLEAN := TRUE;
+ 
+           GENERIC
+                TYPE T IS (<>);
+           PROCEDURE P (X : T);
+ 
+           PROCEDURE P (X : T) IS
+                A : T := T'FIRST;
+           BEGIN
+                IF SWITCH THEN
+                     SWITCH := FALSE;
+                     P (X);
+                     IF GLOBAL /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE FOR PROCEDURE CALL " &
+                                  "- 20");
+                     END IF;
+                     GLOBAL := IDENT_INT(3);
+                ELSE
+                     GLOBAL := IDENT_INT(2);
+                END IF;
+           END P;
+ 
+           PROCEDURE NEW_P IS NEW P (INTEGER);
+ 
+      BEGIN
+           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+                FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
+           END IF;
+           NEW_P (1);
+           IF GLOBAL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
+           END IF;
+      END TWO;
+ 
+ 
+      THREE:
+      DECLARE
+           SWITCH : BOOLEAN := TRUE;
+ 
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT(1);
+           END F;
+ 
+           FUNCTION F RETURN BOOLEAN IS
+           BEGIN
+                RETURN IDENT_BOOL(FALSE);
+           END F;
+ 
+           FUNCTION F (X : INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT(X);
+           END F;
+ 
+      BEGIN
+           DECLARE
+                GENERIC
+                FUNCTION F RETURN INTEGER;
+ 
+                FUNCTION F RETURN INTEGER IS
+                     A : INTEGER := INTEGER'LAST;
+                BEGIN
+                     IF SWITCH THEN
+                          SWITCH := FALSE;
+                          IF F /= IDENT_INT(3) THEN
+                               FAILED ("INCORRECT VALUE FROM FUNCTION " &
+                                       "CALL - 30");
+                          END IF;
+                     END IF;
+                     IF F(A) /= IDENT_INT(INTEGER'LAST) THEN
+                          FAILED ("INCORRECT VALUE FROM FUNCTION CALL " &
+                                  "- 31");
+                     END IF;
+                     IF F THEN
+                          FAILED ("INCORRECT VALUE FROM FUNCTION CALL " &
+                                  "- 32");
+                     END IF;
+                     RETURN IDENT_INT(3);
+                END F;
+ 
+                FUNCTION NEW_F IS NEW F;
+ 
+           BEGIN
+                IF NEW_F /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
+                END IF;
+           END;
+      END THREE;
+ 
+ 
+      FOUR:
+      DECLARE
+           SWITCH : BOOLEAN := TRUE;
+ 
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT(1);
+           END F;
+ 
+           FUNCTION F RETURN BOOLEAN IS
+           BEGIN
+                RETURN IDENT_BOOL(FALSE);
+           END F;
+ 
+      BEGIN
+           DECLARE
+                GENERIC
+                     TYPE T IS (<>);
+                FUNCTION F RETURN T;
+ 
+                FUNCTION F RETURN T IS
+                     A : T := T'LAST;
+                BEGIN
+                     IF SWITCH THEN
+                          SWITCH := FALSE;
+                          IF F /= T'LAST THEN
+                               FAILED ("INCORRECT VALUE FROM FUNCTION " &
+                                       "CALL - 40");
+                          END IF;
+                          RETURN T'FIRST;
+                     ELSE
+                          IF F THEN
+                               FAILED ("INCORRECT VALUE FROM FUNCTION " &
+                                       "CALL - 41");
+                          END IF;
+                          RETURN T'LAST;
+                     END IF;
+                END F;
+ 
+                FUNCTION NEW_F IS NEW F (INTEGER);
+ 
+           BEGIN
+                IF NEW_F /= IDENT_INT(INTEGER'FIRST) THEN
+                     FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
+                END IF;
+           END;
+      END FOUR;
+ 
+      RESULT;
+ END C83030A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83030c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83030c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83030c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83030c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,263 ----
+ -- C83030C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY COMPILED AS A SUBUNIT
+ --     IN THE SAME COMPILATION, NON-HOMOGRAPH SUBPROGRAMS DECLARED
+ --     OUTSIDE THE GENERIC UNIT, AND HAVING THE SAME IDENTIFIER, ARE NOT
+ --     HIDDEN.
+ 
+ -- HISTORY:
+ --     JET 10/17/88  CREATED ORIGINAL TEST.
+ --     BCB 10/03/90  ADDED "PRAGMA ELABORATE (REPORT);".
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE C83030C_DECL1 IS
+      GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
+      SWITCH : BOOLEAN := TRUE;
+ 
+      PROCEDURE C83030C_PROC1;
+      PROCEDURE C83030C_PROC1 (X : INTEGER);
+      PROCEDURE C83030C_PROC2;
+      PROCEDURE C83030C_PROC2 (X : INTEGER);
+      FUNCTION C83030C_FUNC3 RETURN INTEGER;
+      FUNCTION C83030C_FUNC3 RETURN BOOLEAN;
+      FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER;
+      FUNCTION C83030C_FUNC4 RETURN INTEGER;
+      FUNCTION C83030C_FUNC4 RETURN BOOLEAN;
+ END C83030C_DECL1;
+ 
+ WITH REPORT; USE REPORT;
+ WITH C83030C_DECL1; USE C83030C_DECL1;
+ PACKAGE C83030C_DECL2 IS
+      GENERIC
+      PROCEDURE C83030C_PROC1;
+ 
+      GENERIC
+           TYPE T IS (<>);
+      PROCEDURE C83030C_PROC2 (X : T);
+ 
+      GENERIC
+      FUNCTION C83030C_FUNC3 RETURN INTEGER;
+ 
+      GENERIC
+           TYPE T IS (<>);
+      FUNCTION C83030C_FUNC4 RETURN T;
+ END C83030C_DECL2;
+ 
+ WITH REPORT; USE REPORT;
+ PACKAGE BODY C83030C_DECL1 IS
+      PROCEDURE C83030C_PROC1 IS
+      BEGIN
+           GLOBAL := IDENT_INT(1);
+      END C83030C_PROC1;
+ 
+      PROCEDURE C83030C_PROC1 (X : INTEGER) IS
+      BEGIN
+           GLOBAL := IDENT_INT(X);
+      END C83030C_PROC1;
+ 
+      PROCEDURE C83030C_PROC2 IS
+      BEGIN
+           GLOBAL := IDENT_INT(1);
+      END C83030C_PROC2;
+ 
+      PROCEDURE C83030C_PROC2 (X : INTEGER) IS
+      BEGIN
+           GLOBAL := IDENT_INT(X);
+      END C83030C_PROC2;
+ 
+      FUNCTION C83030C_FUNC3 RETURN INTEGER IS
+      BEGIN
+           RETURN IDENT_INT(1);
+      END C83030C_FUNC3;
+ 
+      FUNCTION C83030C_FUNC3 RETURN BOOLEAN IS
+      BEGIN
+           RETURN IDENT_BOOL(FALSE);
+      END C83030C_FUNC3;
+ 
+      FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN IDENT_INT(X);
+      END C83030C_FUNC3;
+ 
+      FUNCTION C83030C_FUNC4 RETURN INTEGER IS
+      BEGIN
+           RETURN IDENT_INT(1);
+      END C83030C_FUNC4;
+ 
+      FUNCTION C83030C_FUNC4 RETURN BOOLEAN IS
+      BEGIN
+           RETURN IDENT_BOOL(FALSE);
+      END C83030C_FUNC4;
+ END C83030C_DECL1;
+ 
+ WITH REPORT; USE REPORT;
+ WITH C83030C_DECL1; USE C83030C_DECL1;
+ PACKAGE BODY C83030C_DECL2 IS
+      PROCEDURE C83030C_PROC1 IS SEPARATE;
+      PROCEDURE C83030C_PROC2 (X : T) IS SEPARATE;
+      FUNCTION C83030C_FUNC3 RETURN INTEGER IS SEPARATE;
+      FUNCTION C83030C_FUNC4 RETURN T IS SEPARATE;
+ END C83030C_DECL2;
+ 
+ SEPARATE (C83030C_DECL2)
+ PROCEDURE C83030C_PROC1 IS
+      A : INTEGER := IDENT_INT(2);
+ BEGIN
+      IF SWITCH THEN
+           SWITCH := FALSE;
+           C83030C_PROC1;
+           IF GLOBAL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 1");
+           END IF;
+      END IF;
+      C83030C_PROC1(A);
+      IF GLOBAL /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
+      END IF;
+      GLOBAL := IDENT_INT(3);
+ END C83030C_PROC1;
+ 
+ SEPARATE (C83030C_DECL2)
+ PROCEDURE C83030C_PROC2 (X : T) IS
+      A : T := T'FIRST;
+ BEGIN
+      IF SWITCH THEN
+           SWITCH := FALSE;
+           C83030C_PROC2 (X);
+           IF GLOBAL /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 20");
+           END IF;
+           GLOBAL := IDENT_INT(3);
+      ELSE
+           GLOBAL := IDENT_INT(2);
+      END IF;
+ END C83030C_PROC2;
+ 
+ SEPARATE (C83030C_DECL2)
+ FUNCTION C83030C_FUNC3 RETURN INTEGER IS
+      A : INTEGER := INTEGER'LAST;
+ BEGIN
+      IF SWITCH THEN
+           SWITCH := FALSE;
+           IF C83030C_FUNC3 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 30");
+           END IF;
+      END IF;
+      IF C83030C_FUNC3(A) /= IDENT_INT(INTEGER'LAST) THEN
+           FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 31");
+      END IF;
+      IF C83030C_FUNC3 THEN
+           FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 32");
+      END IF;
+      RETURN IDENT_INT(3);
+ END C83030C_FUNC3;
+ 
+ SEPARATE (C83030C_DECL2)
+ FUNCTION C83030C_FUNC4 RETURN T IS
+      A : T := T'LAST;
+ BEGIN
+      IF SWITCH THEN
+           SWITCH := FALSE;
+           IF C83030C_FUNC4 /= T'LAST THEN
+                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 40");
+           END IF;
+           RETURN T'FIRST;
+      ELSE
+           IF C83030C_FUNC4 THEN
+                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 41");
+           END IF;
+           RETURN T'LAST;
+      END IF;
+ END C83030C_FUNC4;
+ 
+ WITH REPORT; USE REPORT;
+ WITH C83030C_DECL1, C83030C_DECL2; USE C83030C_DECL1, C83030C_DECL2;
+ PROCEDURE C83030C IS
+ BEGIN
+      TEST ("C83030C", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY " &
+                       "COMPILED AS A SUBUNIT IN THE SAME COMPILATION," &
+                       " NON-HOMOGRAPH SUBPROGRAMS DECLARED OUTSIDE " &
+                       "THE GENERIC UNIT, AND HAVING THE SAME " &
+                       "IDENTIFIER, ARE NOT HIDDEN");
+ 
+      ONE:
+      DECLARE
+           PROCEDURE PROC1 IS NEW C83030C_DECL2.C83030C_PROC1;
+      BEGIN
+           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+                FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
+           END IF;
+           PROC1;
+           IF GLOBAL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
+           END IF;
+ 
+           GLOBAL := IDENT_INT(INTEGER'FIRST);
+           SWITCH := TRUE;
+      END ONE;
+ 
+      TWO:
+      DECLARE
+           PROCEDURE PROC2 IS NEW C83030C_DECL2.C83030C_PROC2(INTEGER);
+      BEGIN
+           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+                FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
+           END IF;
+           PROC2 (1);
+           IF GLOBAL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
+           END IF;
+ 
+           SWITCH := TRUE;
+      END TWO;
+ 
+      THREE:
+      DECLARE
+           FUNCTION FUNC3 IS NEW C83030C_DECL2.C83030C_FUNC3;
+      BEGIN
+           IF FUNC3 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
+           END IF;
+ 
+           SWITCH := TRUE;
+      END THREE;
+ 
+      FOUR:
+      DECLARE
+           FUNCTION FUNC4 IS NEW C83030C_DECL2.C83030C_FUNC4 (INTEGER);
+      BEGIN
+           IF FUNC4 /= IDENT_INT(INTEGER'FIRST) THEN
+                FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
+           END IF;
+ 
+           GLOBAL := INTEGER'FIRST;
+           SWITCH := TRUE;
+      END FOUR;
+ 
+      RESULT;
+ END C83030C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83031a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83031a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83031a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83031a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- C83031A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
+ --     AN ENUMERATION LITERAL IS HIDDEN BY A SUBPROGRAM DECLARATION OR
+ --     A RENAMING DECLARATION WHICH DECLARES A HOMOGRAPH OF THE
+ --     OPERATOR OR LITERAL.
+ 
+ -- HISTORY:
+ --     VCL  08/10/88  CREATED ORIGINAL TEST.
+ --     JRL  03/20/92  ELIMINATED REDUNDANT TESTING.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C83031A IS
+ BEGIN
+      TEST ("C83031A", "AN IMPLICIT DECLARATION OF A PREDEFINED " &
+                       "OPERATOR OR AN ENUMERATION LITERAL IS HIDDEN " &
+                       "BY A SUBPROGRAM DECLARATION OR A RENAMING " &
+                       "DECLARATION WHICH DECLARES A HOMOGRAPH OF THE " &
+                       "OPERATOR OR LITERAL");
+ 
+      DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
+           PACKAGE P IS
+                TYPE INT IS RANGE -20 .. 20;
+ 
+                M : INT := 3 * INT(IDENT_INT(3));
+                N : INT := 4 + INT(IDENT_INT(4));
+ 
+                FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT;
+                TYPE INT2 IS PRIVATE;
+                FUNCTION "+" (LEFT, RIGHT : INT2) RETURN INT2;
+           PRIVATE
+                FUNCTION "+" (LEFT, RIGHT : INT) RETURN INT
+                             RENAMES "/" ;
+ 
+                TYPE INT2 IS RANGE -20 .. 20;
+           END P;
+           USE P;
+ 
+           PACKAGE BODY P IS
+                FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT IS
+                BEGIN
+                     RETURN LEFT / RIGHT;
+                END "*";
+ 
+                FUNCTION "+" (LEFT, RIGHT : INT2) RETURN INT2 IS
+                BEGIN
+                     RETURN LEFT - RIGHT;
+                END "+";
+ 
+           BEGIN
+                IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+                     FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                             "EXPLICIT '*' OPERATOR - 1");
+                END IF;
+ 
+                IF N /= 8 THEN
+                     FAILED ("INCORRECT INITIAL VALUE FOR N - 1");
+                END IF;
+                N := 2 + 2;
+                IF N /= INT(IDENT_INT (1)) THEN
+                FAILED ("INCORRECT VALUE FOR N AFTER CALL TO " &
+                        "EXPLICIT '+' OPERATOR - 1");
+                END IF;
+ 
+                DECLARE
+                     Q : INT2 := 8 + 9;
+                BEGIN
+                     IF Q /= -1 THEN
+                          FAILED ("INCORRECT VALUE FOR Q");
+                     END IF;
+                END;
+           END P;
+      BEGIN
+           IF M /= 9 THEN
+                FAILED ("INCORRECT INITIAL VALUE FOR M - 2");
+           END IF;
+           IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+                FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                        "EXPLICIT '*' OPERATOR - 2");
+           END IF;
+ 
+           N := 2 + 2;
+           IF N /= INT(IDENT_INT (4)) THEN
+                FAILED ("INCORRECT VALUE FOR N AFTER CALL TO " &
+                        "IMPLICIT '+' OPERATOR - 2");
+           END IF;
+ 
+      END;
+ 
+      DECLARE   -- CHECK SUBPROGRAM DECLARATIONS OF ENUMERATION LITERALS.
+ 
+           PACKAGE P1 IS
+                TYPE ENUM1 IS (E11, E12, E13);
+                TYPE PRIV1 IS PRIVATE;
+                FUNCTION E11 RETURN PRIV1;
+           PRIVATE
+                TYPE PRIV1 IS NEW ENUM1;
+                FUNCTION E12 RETURN PRIV1 RENAMES E13;
+           END P1;
+           USE P1;
+ 
+           E13 : INTEGER := IDENT_INT (5);
+ 
+           FUNCTION E12 RETURN ENUM1 RENAMES E11 ;
+ 
+           FUNCTION CHECK (E: ENUM1) RETURN INTEGER IS
+           BEGIN
+                RETURN ENUM1'POS (E);
+           END CHECK;
+ 
+           FUNCTION CHECK (E: INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN INTEGER'POS (E);
+           END CHECK;
+ 
+           PACKAGE BODY P1 IS
+                FUNCTION E11 RETURN PRIV1 IS
+                BEGIN
+                     RETURN E13;
+                END E11;
+           BEGIN
+                IF PRIV1'(E11) /= E13 THEN
+                     FAILED ("INCORRECT VALUE FOR E11");
+                END IF;
+ 
+                IF E12 /= PRIV1'LAST THEN
+                     FAILED ("INCORRECT VALUE FOR E12 - 1");
+                END IF;
+           END P1;
+      BEGIN
+           IF E12 /= ENUM1'FIRST THEN
+                FAILED ("INCORRECT VALUE FOR E12 - 2");
+           END IF;
+ 
+           IF CHECK (E13) /= 5 THEN
+                FAILED ("INCORRECT VALUE FOR E13");
+           END IF;
+      END;
+      RESULT;
+ END C83031A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83031c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83031c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83031c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83031c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C83031C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
+ --     ENUMERATION LITERAL IS HIDDEN BY A GENERIC INSTANTIATION WHICH
+ --     DECLARES A HOMOGRAPH OF THE OPERATOR OR LITERAL.
+ 
+ -- HISTORY:
+ --     BCB 09/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83031C IS
+ 
+ BEGIN
+      TEST ("C83031C", "CHECK THAT AN IMPLICIT DECLARATION OF A " &
+                       "PREDEFINED OPERATOR OR ENUMERATION LITERAL IS " &
+                       "HIDDEN BY A GENERIC INSTANTIATION WHICH " &
+                       "DECLARES A HOMOGRAPH OF THE OPERATOR OR " &
+                       "LITERAL");
+ 
+      DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
+           PACKAGE P IS
+                TYPE INT IS RANGE -20 .. 20;
+ 
+                GENERIC
+                     TYPE X IS RANGE <>;
+                FUNCTION GEN_FUN (LEFT, RIGHT : X) RETURN X;
+           END P;
+           USE P;
+ 
+           PACKAGE BODY P IS
+                FUNCTION GEN_FUN (LEFT, RIGHT : X) RETURN X IS
+                BEGIN
+                     RETURN LEFT / RIGHT;
+                END GEN_FUN;
+ 
+                FUNCTION "*" IS NEW GEN_FUN (INT);
+           BEGIN
+                IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+                     FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                             "EXPLICIT '*' OPERATOR - 1");
+                END IF;
+           END P;
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE   -- CHECK SUBPROGRAM DECLARATIONS OF ENUMERATION LITERALS.
+ 
+           PACKAGE P1 IS
+                TYPE ENUM1 IS (E11, E12, E13);
+                TYPE PRIV1 IS PRIVATE;
+ 
+                GENERIC
+                     TYPE X IS (<>);
+                FUNCTION GEN_FUN RETURN X;
+           PRIVATE
+                TYPE PRIV1 IS NEW ENUM1;
+           END P1;
+           USE P1;
+ 
+           PACKAGE BODY P1 IS
+                FUNCTION GEN_FUN RETURN X IS
+                BEGIN
+                     RETURN X'LAST;
+                END GEN_FUN;
+ 
+                FUNCTION E11 IS NEW GEN_FUN (PRIV1);
+           BEGIN
+                IF PRIV1'(E11) /= E13 THEN
+                     FAILED ("INCORRECT VALUE FOR E11");
+                END IF;
+           END P1;
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C83031C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83031e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83031e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83031e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83031e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- C83031E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR IS
+ --     HIDDEN BY A GENERIC FORMAL SUBPROGRAM DECLARATION WHICH DECLARES
+ --     A HOMOGRAPH OF THE OPERATOR.
+ 
+ -- HISTORY:
+ --     BCB 09/19/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C83031E IS
+ 
+ BEGIN
+      TEST ("C83031E", "CHECK THAT AN IMPLICIT DECLARATION OF A " &
+                       "PREDEFINED OPERATOR IS HIDDEN BY A GENERIC " &
+                       "FORMAL SUBPROGRAM DECLARATION WHICH DECLARES " &
+                       "A HOMOGRAPH OF THE OPERATOR");
+ 
+      DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
+           TYPE INT IS RANGE -20 .. 20;
+ 
+           GENERIC
+                WITH FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT;
+           PACKAGE P IS
+           END P;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+                     FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                             "EXPLICIT '*' OPERATOR - 1");
+                END IF;
+           END P;
+ 
+           FUNCTION MULT (X, Y : INT) RETURN INT IS
+           BEGIN
+                RETURN X / Y;
+           END MULT;
+ 
+           PACKAGE NEW_P IS NEW P (MULT);
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C83031E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83032a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83032a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83032a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83032a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C83032A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
+ --     AN ENUMERATION LITERAL IS HIDDEN BY A DERIVED SUBPROGRAM
+ --     HOMOGRAPH.
+ 
+ -- HISTORY:
+ --     VCL  08/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83032A IS
+ BEGIN
+      TEST ("C83032A", "AN IMPLICIT DECLARATION OF A PREDEFINED " &
+                       "OPERATOR OR AN ENUMERATION LITERAL IS HIDDEN " &
+                       "BY A DERIVED SUBPROGRAM HOMOGRAPH");
+ 
+      DECLARE             -- CHECK PREDEFINED OPERATOR.
+           PACKAGE P IS
+                TYPE INT IS RANGE -20 .. 20;
+                FUNCTION "ABS" (X : INT) RETURN INT;
+           END P;
+           USE P;
+ 
+           TYPE NINT IS NEW INT;
+ 
+           I2 : NINT := -5;
+ 
+           PACKAGE BODY P IS
+                I1 : NINT := 5;
+ 
+                FUNCTION "ABS" (X : INT) RETURN INT IS
+                BEGIN
+                     RETURN INT (- (ABS (INTEGER (X))));
+                END "ABS";
+ 
+           BEGIN
+                IF "ABS"(I1) /= -5 THEN
+                     FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
+                             "TO DERIVED ""ABS"" - 1");
+                END IF;
+ 
+                I1 := ABS (-10);
+                IF ABS I1 /= NINT(IDENT_INT (-10)) THEN
+                     FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
+                             "TO DERIVED ""ABS"" - 2");
+                END IF;
+           END P;
+      BEGIN
+           IF "ABS"(I2) /= -5 THEN
+                FAILED ("INCORRECT VALUE FOR 'I2' AFTER CALL " &
+                     "TO DERIVED ""ABS"" - 1");
+           END IF;
+ 
+           I2 := ABS (10);
+           IF ABS I2 /= NINT (IDENT_INT (-10)) THEN
+                FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
+                         "TO DERIVED ""ABS"" - 2");
+           END IF;
+      END;
+ 
+      DECLARE   -- CHECK ENUMERATION LITERALS.
+ 
+           PACKAGE P1 IS
+                TYPE ENUM1 IS (E11, E12, E13);
+                TYPE PRIV1 IS PRIVATE;
+                FUNCTION E11 RETURN PRIV1;
+           PRIVATE
+                TYPE PRIV1 IS NEW ENUM1;
+                TYPE NPRIV1 IS NEW PRIV1;
+           END P1;
+           USE P1;
+ 
+           PACKAGE BODY P1 IS
+                FUNCTION E11 RETURN PRIV1 IS
+                BEGIN
+                     RETURN E13;
+                END E11;
+           BEGIN
+                IF NPRIV1'(E11) /= E13 THEN
+                     FAILED ("INCORRECT VALUE FOR E11");
+                END IF;
+           END P1;
+ 
+      BEGIN
+           NULL;
+      END;
+      RESULT;
+ END C83032A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83033a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83033a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83033a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83033a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- C83033A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK NAME, A LOOP NAME,
+ --     OR A STATEMENT LABEL HIDES THE DECLARATION OF AN ENUMERATION
+ --     LITERAL OR OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED TYPE
+ --     DEFINITION.
+ 
+ -- HISTORY:
+ --     DHH 09/21/88  CREATED ORIGINAL TEST.
+ --     WMC 03/25/92  REMOVED TEST REDUNDANCIES.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C83033A IS
+ 
+      PACKAGE BASE_P IS
+           TYPE A IS (RED, BLUE, YELO);
+           FUNCTION RED(T : INTEGER; X : A) RETURN A;
+           FUNCTION BLUE(T : INTEGER; X : A) RETURN A;
+      END BASE_P;
+ 
+      PACKAGE BODY BASE_P IS
+           FUNCTION RED(T : INTEGER; X : A) RETURN A IS
+           BEGIN
+                IF EQUAL(T, T) THEN
+                     RETURN X;
+                ELSE
+                     RETURN YELO;
+                END IF;
+           END RED;
+ 
+           FUNCTION BLUE(T : INTEGER; X : A) RETURN A IS
+           BEGIN
+                IF EQUAL(T, T) THEN
+                     RETURN X;
+                ELSE
+                     RETURN YELO;
+                END IF;
+           END BLUE;
+ 
+      END BASE_P;
+ BEGIN
+      TEST ("C83033A", "CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK " &
+                       "NAME, A LOOP NAME, OR A STATEMENT LABEL HIDES " &
+                       "THE DECLARATION OF AN ENUMERATION LITERAL OR " &
+                       "OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED " &
+                       "TYPE DEFINITION");
+ 
+      B1:
+      DECLARE
+           TYPE STMT2 IS NEW BASE_P.A;
+      BEGIN
+ 
+           DECLARE
+                C, D : STMT2;
+           BEGIN
+                C := C83033A.B1.RED(3, C83033A.B1.RED);
+                D := C83033A.B1.RED;
+ 
+                GOTO RED;              -- DEMONSTRATES USE OF STATEMENT LABEL.
+                FAILED("STATEMENT LABEL - 1");
+ 
+      <<RED>>   IF C /= D THEN
+                   FAILED("STATEMENT LABEL - 2");
+                END IF;
+           END;
+      END B1;
+ 
+      B2:
+      DECLARE
+           TYPE STMT2 IS NEW BASE_P.A;
+      BEGIN
+ 
+           DECLARE
+                A : STMT2 := BLUE;
+                B : STMT2 := BLUE(3, BLUE);
+           BEGIN
+ 
+                BLUE:
+                FOR I IN 1 .. 1 LOOP
+                     IF A /= B THEN
+                          FAILED("LOOP NAME - 1");
+                     END IF;
+                     EXIT BLUE;                -- DEMONSTRATES USE OF LOOP LABEL.
+                     FAILED("LOOP NAME - 2");
+                END LOOP BLUE;
+           END;
+      END B2;
+ 
+      B4:
+      DECLARE
+           PACKAGE P IS
+                GLOBAL : INTEGER := 1;
+                TYPE ENUM IS (GREEN, BLUE);
+                TYPE PRIV IS PRIVATE;
+                FUNCTION GREEN RETURN PRIV;
+           PRIVATE
+                TYPE PRIV IS NEW ENUM;
+           END P;
+ 
+           PACKAGE BODY P IS
+                FUNCTION GREEN RETURN PRIV IS
+                BEGIN
+                     GLOBAL := GLOBAL + 1;
+                     RETURN BLUE;
+                END GREEN;
+           BEGIN
+                NULL;
+           END P;
+           USE P;
+      BEGIN
+           GREEN:
+           DECLARE
+                COLOR : PRIV := C83033A.B4.P.GREEN;
+           BEGIN
+                IF GREEN.COLOR /= C83033A.B4.P.GREEN OR ELSE GLOBAL /= 3 THEN
+                   FAILED("BLOCK NAME");
+                END IF;
+           END GREEN;
+      END B4;
+ 
+      RESULT;
+ END C83033A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83051a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83051a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83051a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83051a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,397 ----
+ -- C83051A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT DECLARATIONS IN THE VISIBLE PART OF A PACKAGE NESTED
+ --     WITHIN THE VISIBLE PART OF A PACKAGE ARE VISIBLE BY SELECTION
+ --     FROM OUTSIDE THE OUTERMOST PACKAGE.
+ 
+ -- HISTORY:
+ --     GMT 09/07/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C83051A IS
+ 
+ BEGIN
+      TEST ("C83051A", "CHECK THAT DECLARATIONS IN THE VISIBLE " &
+                       "PART OF A PACKAGE NESTED WITHIN THE VISIBLE " &
+                       "PART OF A PACKAGE ARE VISIBLE BY SELECTION " &
+                       "FROM OUTSIDE THE OUTERMOST PACKAGE");
+      A_BLOCK:
+      DECLARE
+           PACKAGE APACK IS
+                PACKAGE BPACK  IS
+                     TYPE    T1  IS (RED,GREEN);
+                     TYPE    T2A IS ('A', 'B', 'C', 'D');
+                     TYPE    T3  IS NEW BOOLEAN;
+                     TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
+                     TYPE    T5  IS DIGITS 5;
+                     TYPE    T67 IS DELTA 0.5 RANGE -2.0 .. 10.0;
+                     TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
+                     SUBTYPE T9B IS T9A (1..10);
+                     TYPE    T9C IS ACCESS T9B;
+                     TYPE    T10 IS PRIVATE;
+                     V1       : T3 := FALSE;
+                     ZERO     : CONSTANT T4 := 0;
+                     A_FLT    : T5 := 3.0;
+                     A_FIX    : T67 := -1.0;
+                     ARY      : T9A(1..4) := (TRUE,TRUE,TRUE,FALSE);
+                     P1 : T9C := NEW T9B'( 1..5  => T3'(TRUE),
+                                           6..10 => T3'(FALSE) );
+                     C1 : CONSTANT T10;
+ 
+                     FUNCTION RET_T1 (X : T1) RETURN T1;
+ 
+                     FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
+ 
+                     GENERIC
+                     PROCEDURE DO_NOTHING (X : IN OUT T3);
+                PRIVATE
+                     TYPE T10 IS NEW CHARACTER;
+                     C1 : CONSTANT T10 := 'J';
+                END BPACK;
+           END APACK;
+ 
+      PACKAGE BODY APACK IS
+           PACKAGE BODY BPACK IS
+                FUNCTION RET_T1 (X : T1) RETURN T1 IS
+                BEGIN
+                     IF X = RED THEN
+                          RETURN GREEN;
+                     ELSE
+                          RETURN RED;
+                     END IF;
+                END RET_T1;
+ 
+                FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
+                BEGIN
+                     RETURN T10(X);
+                END RET_CHAR;
+ 
+                PROCEDURE DO_NOTHING (X : IN OUT T3) IS
+                BEGIN
+                     IF X = TRUE THEN
+                          X := FALSE;
+                     ELSE
+                          X := TRUE;
+                     END IF;
+                END DO_NOTHING;
+           END BPACK;
+      END APACK;
+ 
+      PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING;
+ 
+      BEGIN
+ 
+           -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS
+ 
+           IF  APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN
+                FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " &
+                        "LITERAL BAD - A1");
+           END IF;
+ 
+ 
+           -- A2: VISIBILITY FOR OVERLOADED
+           --     ENUMERATION CHARACTER LITERALS
+ 
+           IF  APACK.BPACK."<"(APACK.BPACK.T2A'(APACK.BPACK.'C'),
+                               APACK.BPACK.T2A'(APACK.BPACK.'B')) THEN
+                FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " &
+                        "LITERAL BAD - A2");
+           END IF;
+ 
+ 
+           -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE
+ 
+           IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK.BPACK.TRUE),
+                              APACK.BPACK.FALSE) THEN
+                FAILED ("VISIBILITY FOR DERIVED BOOLEAN BAD - A3");
+           END IF;
+ 
+ 
+           -- A4: VISIBILITY FOR AN INTEGER TYPE
+ 
+           IF APACK.BPACK."/="(APACK.BPACK."MOD"(6,2),APACK.BPACK.ZERO)
+                THEN FAILED ("VISIBILITY FOR INTEGER TYPE BAD - A4");
+           END IF;
+ 
+ 
+           -- A5: VISIBILITY FOR A FLOATING POINT TYPE
+ 
+           IF APACK.BPACK.">"(APACK.BPACK.T5'(2.7),APACK.BPACK.A_FLT)
+                THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5");
+           END IF;
+ 
+ 
+           -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS
+ 
+           IF APACK.BPACK."<"(APACK.BPACK.A_FIX,APACK.BPACK.T67'
+                             (APACK.BPACK."-"(1.5))) THEN
+                FAILED ("VISIBILITY FOR FIXED POINT WITH UNARY MINUS " &
+                        "BAD - A6");
+           END IF;
+ 
+ 
+           -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER
+ 
+           IF APACK.BPACK."/="(APACK.BPACK.T67(-0.5),APACK.BPACK."/"
+                              (APACK.BPACK.A_FIX,2)) THEN
+                FAILED ("VISIBILITY FOR FIXED POINT DIVIDED BY " &
+                        "INTEGER BAD - A7");
+           END IF;
+ 
+ 
+           -- A8: VISIBILITY FOR ARRAY EQUALITY
+ 
+           IF APACK.BPACK."/="(APACK.BPACK.ARY,(APACK.BPACK.T3(TRUE),
+              APACK.BPACK.T3(TRUE),APACK.BPACK.T3(TRUE),
+              APACK.BPACK.T3(FALSE))) THEN
+                FAILED ("VISIBILITY FOR ARRAY EQUALITY BAD - A8");
+           END IF;
+ 
+ 
+           -- A9: VISIBILITY FOR ACCESS EQUALITY
+ 
+           IF APACK.BPACK."/="(APACK.BPACK.P1(3),
+                               APACK.BPACK.T3(IDENT_BOOL(TRUE)))
+                THEN FAILED ("VISIBILITY FOR ACCESS EQUALITY BAD - A9");
+           END IF;
+ 
+ 
+           -- A10: VISIBILITY FOR PRIVATE TYPE
+ 
+           IF APACK.BPACK."/="(APACK.BPACK.C1,
+                               APACK.BPACK.RET_CHAR('J')) THEN
+                FAILED ("VISIBILITY FOR PRIVATE TYPE BAD - A10");
+           END IF;
+ 
+ 
+           -- A11: VISIBILITY FOR DERIVED SUBPROGRAM
+ 
+           IF APACK.BPACK."/="(APACK.BPACK.RET_T1(APACK.BPACK.RED),
+                               APACK.BPACK.GREEN) THEN
+                FAILED ("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11");
+           END IF;
+ 
+           -- A12: VISIBILITY FOR GENERIC SUBPROGRAM
+ 
+           NEW_DO_NOTHING (APACK.BPACK.V1);
+ 
+           IF APACK.BPACK."/="(APACK.BPACK.V1,APACK.BPACK.T3(TRUE)) THEN
+                FAILED ("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12");
+           END IF;
+ 
+      END A_BLOCK;
+ 
+      B_BLOCK:
+      DECLARE
+           GENERIC
+                TYPE T1 IS (<>);
+           PACKAGE GENPACK IS
+                PACKAGE APACK IS
+                     PACKAGE BPACK  IS
+                          TYPE    T1  IS (ORANGE,GREEN);
+                          TYPE    T2A IS ('E', 'F', 'G');
+                          TYPE    T3  IS NEW BOOLEAN;
+                          TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
+                          TYPE    T5  IS DIGITS 5;
+                          TYPE    T67 IS DELTA 0.5 RANGE -3.0 .. 25.0;
+                          TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
+                          SUBTYPE T9B IS T9A (2 .. 8);
+                          TYPE    T9C IS ACCESS T9B;
+                          TYPE    T10 IS PRIVATE;
+                          V1    : T3 := TRUE;
+                          SIX   : T4 := 6;
+                          B_FLT : T5 := 4.0;
+                          ARY   : T9A(1..4) := (TRUE,FALSE,TRUE,FALSE);
+                          P1    : T9C := NEW T9B'( 2..4 => T3'(FALSE),
+                                                   5..8 => T3'(TRUE));
+                          K1 : CONSTANT T10;
+ 
+                          FUNCTION RET_T1 (X : T1) RETURN T1;
+ 
+                          FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
+ 
+                          GENERIC
+                          PROCEDURE DO_NOTHING (X : IN OUT T3);
+                     PRIVATE
+                          TYPE T10 IS NEW CHARACTER;
+                          K1 : CONSTANT T10 := 'V';
+                     END BPACK;
+                END APACK;
+           END GENPACK;
+ 
+           PACKAGE BODY GENPACK IS
+                PACKAGE BODY APACK IS
+                     PACKAGE BODY BPACK IS
+                          FUNCTION RET_T1 (X : T1) RETURN T1 IS
+                          BEGIN
+                               IF X = ORANGE THEN
+                                    RETURN GREEN;
+                               ELSE
+                                    RETURN ORANGE;
+                               END IF;
+                          END RET_T1;
+ 
+                          FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
+                          BEGIN
+                               RETURN T10(X);
+                          END RET_CHAR;
+ 
+                          PROCEDURE DO_NOTHING (X : IN OUT T3) IS
+                          BEGIN
+                               IF X = TRUE THEN
+                                    X := FALSE;
+                               ELSE
+                                    X := TRUE;
+                               END IF;
+                          END DO_NOTHING;
+                     END BPACK;
+                END APACK;
+           END GENPACK;
+ 
+           PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER);
+ 
+           PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING;
+ 
+      BEGIN
+ 
+           -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL
+ 
+           IF MYPACK.APACK.BPACK."<"(MYPACK.APACK.BPACK.GREEN,
+                                     MYPACK.APACK.BPACK.ORANGE) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
+                        "UNOVERLOADED ENUMERATION LITERAL BAD - B1");
+           END IF;
+ 
+ 
+           -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL
+ 
+           IF  MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK.
+              APACK.BPACK.'F'),MYPACK.APACK.BPACK.T2A'(MYPACK.APACK.
+              BPACK.'G')) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
+                        "OVERLOADED ENUMERATION LITERAL BAD - B2");
+           END IF;
+ 
+ 
+           -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK.
+              APACK.BPACK.T3'(MYPACK.APACK.BPACK.TRUE)),MYPACK.APACK.
+              BPACK.FALSE) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
+                        "BOOLEAN BAD - B3");
+           END IF;
+ 
+ 
+           -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."MOD"(MYPACK.
+              APACK.BPACK.SIX,2),0) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF INTEGER " &
+                        "BAD - B4");
+           END IF;
+ 
+ 
+           -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT
+ 
+           IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T5'(1.9),MYPACK.
+              APACK.BPACK.B_FLT) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FLOATING " &
+                        "POINT BAD - B5");
+           END IF;
+ 
+ 
+           -- B6: VISIBILITY FOR GENERIC INSTANCE OF
+           --     FIXED POINT UNARY PLUS
+ 
+           IF MYPACK.APACK.BPACK."<"(2.5,MYPACK.APACK.BPACK.T67'(MYPACK.
+              APACK.BPACK."+"(1.75))) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
+                        "POINT UNARY PLUS BAD - B6");
+           END IF;
+ 
+ 
+           -- B7: VISIBILITY FOR GENERIC INSTANCE OF
+           --     FIXED POINT DIVIDED BY INTEGER
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."/"(2.5,4),
+              0.625) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
+                        "POINT DIVIDED BY INTEGER BAD - B7");
+           END IF;
+ 
+ 
+           -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.ARY,(MYPACK.
+              APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE),MYPACK.
+              APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE))) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ARRAY " &
+                        "EQUALITY BAD - B8");
+           END IF;
+ 
+ 
+           -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.P1(3),MYPACK.
+              APACK.BPACK.T3(IDENT_BOOL(FALSE))) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ACCESS " &
+                        "EQUALITY BAD - B9");
+           END IF;
+ 
+ 
+           -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.K1,MYPACK.APACK.
+              BPACK.RET_CHAR('V')) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF PRIVATE " &
+                        "EQUALITY BAD - B10");
+           END IF;
+ 
+ 
+           -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.RET_T1(MYPACK.
+              APACK.BPACK.ORANGE),MYPACK.APACK.BPACK.GREEN) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
+                        "SUBPROGRAM BAD - B11");
+           END IF;
+ 
+           -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM
+ 
+           MY_DO_NOTHING (MYPACK.APACK.BPACK.V1);
+ 
+           IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.V1,
+                                      MYPACK.APACK.BPACK.T3(FALSE)) THEN
+                FAILED ("VISIBILITY FOR GENERIC INSTANCE OF GENERIC " &
+                        "SUBPROGRAM BAD - B12");
+           END IF;
+ 
+      END B_BLOCK;
+ 
+      RESULT;
+ END C83051A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83b02a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83b02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83b02a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83b02a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C83B02A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NESTED LOOPS CAN HAVE IDENTICALLY NAMED PARAMETERS,
+ --    AND REFERENCES IN THE INNERMOST LOOP ARE ASSOCIATED WITH THE
+ --    INNERMOST PARAMETER, ETC.
+ 
+ 
+ --    RM     4 JUNE 1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83B02A  IS
+ 
+      USE REPORT;
+ 
+      I , J , K : INTEGER := 1 ;
+ 
+ BEGIN
+ 
+      TEST ( "C83B02A" ,
+             "CHECK THAT NESTED LOOPS CAN HAVE IDENTICALLY NAMED" &
+             " PARAMETERS" );
+ 
+                                                         --   I    J    K
+      FOR  LOOP_PAR  IN  2..2  LOOP
+           I := I * LOOP_PAR ;                           --   2    1    1
+           FOR  LOOP_PAR  IN  3..3  LOOP
+                I := I * LOOP_PAR ;                      --   6    1    1
+                FOR  LOOP_PAR  IN  5..5  LOOP
+                     I := I * LOOP_PAR ;                 --  30    1    1
+                     FOR  SECOND_LOOP_PAR  IN  7..7  LOOP
+                          J := J * SECOND_LOOP_PAR ;     --  30    7    1
+                          FOR  SECOND_LOOP_PAR  IN  11..11  LOOP
+                               J := J * SECOND_LOOP_PAR ;--  30   77    1
+                               FOR  SECOND_LOOP_PAR  IN  13..13  LOOP
+                                    J := J *
+                                         SECOND_LOOP_PAR;--  30 1001    1
+                               END LOOP;
+                               K := K * LOOP_PAR ;       --  30 1001    5
+                          END LOOP;
+                          K := K * LOOP_PAR ;            --  30 1001   25
+                     END LOOP;
+                     K := K * LOOP_PAR ;                 --  30 1001  125
+                END LOOP;
+                K := K * LOOP_PAR ;                      --  30 1001  375
+           END LOOP;
+           K := K * LOOP_PAR ;                           --  30 1001  750
+      END LOOP;
+ 
+      IF  I /= 30 OR J /= 1001 OR K /= 750  THEN
+            FAILED ( "DID NOT ACCESS INNERMOST ENCLOSING IDENTICALLY " &
+                     "NAMED LOOP PARAMETER IN NESTED LOOPS" );
+      END IF;
+ 
+      RESULT;
+ 
+ END C83B02A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83b02b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83b02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83b02b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83b02b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C83B02B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NON-NESTED LOOPS CAN HAVE IDENTICALLY NAMED PARAMETERS,
+ --    AND REFERENCES IN EACH LOOP ARE ASSOCIATED WITH THAT LOOP'S
+ --    LOOP PARAMETER.  (THIS IS PART  B  OF THE OBJECTIVE.)
+ -- CHECK ALSO THAT A LOOP PARAMETER CAN HAVE THE SAME IDENTIFIER
+ --    AS A VARIABLE DECLARED IN THE SCOPE IMMEDIATELY CONTAINING
+ --    THE LOOP.  (THIS IS PART  C  OF THE OBJECTIVE.)
+ 
+ 
+ 
+ --    RM     6 JUNE 1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83B02B  IS
+ 
+      USE REPORT;
+ 
+      I , J : INTEGER := 1 ;
+ 
+ BEGIN
+ 
+      TEST ( "C83B02B" ,
+             "CHECK THAT NON-NESTED LOOPS CAN HAVE IDENTICALLY NAMED" &
+             " PARAMETERS" );
+ 
+      COMMENT ( "THE NAME MAY BE THE SAME AS THAT OF A VARIABLE" &
+                " KNOWN OUTSIDE THE LOOP" );
+ 
+      -- CHECK PART B OF THE OBJECTIVE
+      DECLARE
+           TYPE  WEEKDAY  IS  ( MON , TUE , WED , THU , FRI );
+      BEGIN
+ 
+           FOR  LOOP_PAR  IN  3..3  LOOP
+                I := I * LOOP_PAR ;              --    3
+           END LOOP;
+ 
+           FOR  LOOP_PAR  IN  FRI..FRI  LOOP
+                I := I * WEEKDAY'POS(LOOP_PAR) ; --   12
+           END LOOP;
+ 
+           FOR  LOOP_PAR  IN  7..7  LOOP
+                I := I * LOOP_PAR ;              --  84
+           END LOOP;
+ 
+      END;
+ 
+      IF I /= 84 THEN
+           FAILED ("DID NOT ACCESS ENCLOSING IDENTICALLY NAMED " &
+                   "LOOP PARAMETER IN NON-NESTED LOOPS");
+      END IF;
+ 
+      -- CHECK PART C OF THE OBJECTIVE
+      DECLARE
+           LOOP_PAR : INTEGER := 2 ;
+      BEGIN
+ 
+           J := J * LOOP_PAR ;                          --    2
+ 
+           FOR  LOOP_PAR  IN  3..3  LOOP
+                J := J * LOOP_PAR ;                     --    6
+           END LOOP;
+ 
+           J := J * LOOP_PAR ;                          --   12
+ 
+           FOR  LOOP_PAR  IN  5..5  LOOP
+                J := J * LOOP_PAR ;                     --   60
+           END LOOP;
+ 
+           J := J * LOOP_PAR ;                          --  120
+ 
+           FOR  LOOP_PAR  IN  7..7  LOOP
+                J := J * LOOP_PAR ;                     --  840
+           END LOOP;
+ 
+           J := J * LOOP_PAR ;                          -- 1680
+ 
+      END;
+ 
+      IF J /= 1680 THEN
+           FAILED ("DID NOT ACCESS IDENTICALLY NAMED LOOP PARAMETER " &
+                   "INSIDE NON-NESTED LOOPS OR IDENTICALLY NAMED " &
+                   "VARIABLE OUTSIDE LOOPS");
+      END IF;
+ 
+      RESULT;
+ 
+ END C83B02B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83e02a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83e02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83e02a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83e02a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C83E02A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WITHIN THE BODY OF A SUBPROGRAM A FORMAL PARAMETER CAN BE
+ --    USED DIRECTLY IN A RANGE CONSTRAINT, A DISCRIMINANT CONSTRAINT,
+ --    AND AN INDEX CONSTRAINT.
+ 
+ --    RM    8 JULY 1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83E02A  IS
+ 
+      USE REPORT;
+ 
+      Z : INTEGER := 0 ;
+ 
+      PROCEDURE  P1 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
+           X : INTEGER RANGE A+1..1+B ;
+      BEGIN
+           X := A + 1 ;
+           C := X * B + B * X * A ;         -- 4*3+3*4*3=48
+      END ;
+ 
+      PROCEDURE  P2 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
+           TYPE  T (MAX : INTEGER)  IS
+                RECORD
+                     VALUE : INTEGER RANGE 1..3 ;
+                END RECORD ;
+           X : T(A);
+      BEGIN
+           X := ( MAX => 4 , VALUE => B ) ; -- ( 4 , 3 )
+           C := 10*C + X.VALUE + 2 ;        -- 10*48+3+2=485
+      END ;
+ 
+      FUNCTION  F3 ( A , B : INTEGER )  RETURN INTEGER  IS
+           TYPE  TABLE  IS  ARRAY( A..B ) OF INTEGER ;
+           X : TABLE ;
+           Y : ARRAY( A..B ) OF INTEGER ;
+      BEGIN
+           X(A) := A ;                      -- 5
+           Y(B) := B ;                      -- 6
+           RETURN X(A)-Y(B)+4 ;             -- 3
+      END ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C83E02A" , "CHECK THAT WITHIN THE BODY OF A SUBPROGRAM " &
+                        " A FORMAL PARAMETER CAN BE USED DIRECTLY IN" &
+                        " A RANGE CONSTRAINT, A DISCRIMINANT CONSTRAINT"&
+                        ", AND AN INDEX CONSTRAINT" ) ;
+ 
+      P1 ( 3 , 3 , Z );                     --  Z  BECOMES  48
+      P2 ( 4 , F3( 5 , 6 ) , Z );           --  Z  BECOMES 485
+ 
+      IF  Z /= 485  THEN
+           FAILED( "ACCESSING ERROR OR COMPUTATION ERROR" );
+      END IF;
+ 
+      RESULT;
+ 
+ END C83E02A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83e02b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83e02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83e02b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83e02b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- C83E02B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WITHIN THE BODY OF A SUBPROGRAM A FORMAL PARAMETER CAN BE
+ --    USED IN AN EXCEPTION HANDLER.
+ 
+ --    RM   10 JULY 1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83E02B  IS
+ 
+      USE REPORT;
+ 
+      Z : INTEGER := 0 ;
+ 
+      PROCEDURE  P1 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
+           E : EXCEPTION ;
+      BEGIN
+           RAISE  E ;
+           FAILED( "FAILURE TO RAISE  E " );
+      EXCEPTION
+           WHEN  E  =>
+                C := A + B ;
+           WHEN  OTHERS  =>
+                FAILED( "WRONG EXCEPTION RAISED" );
+      END ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C83E02B" , "CHECK THAT WITHIN THE BODY OF A SUBPROGRAM " &
+                        " A FORMAL PARAMETER CAN BE USED IN AN EXCEP" &
+                        "TION HANDLER" ) ;
+ 
+      P1 ( 3 , 14 , Z );
+ 
+      IF  Z /= 17  THEN
+           FAILED( "ACCESSING ERROR OR COMPUTATION ERROR" );
+      END IF;
+ 
+      RESULT;
+ 
+ END C83E02B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83e03a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83e03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83e03a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83e03a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C83E03A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A FORMAL PARAMETER IN A NAMED PARAMETER ASSOCIATION
+ --    IS NOT CONFUSED WITH AN ACTUAL PARAMETER IDENTIFIER  HAVING THE
+ --    SAME SPELLING.
+ 
+ 
+ --    RM    23 JULY 1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83E03A  IS
+ 
+      USE REPORT;
+ 
+      P : INTEGER RANGE 1..23 := 17 ;
+      FLOW_INDEX : INTEGER := 0 ;
+ 
+ BEGIN
+ 
+      TEST( "C83E03A" , "CHECK THAT A FORMAL PARAMETER IN A NAMED" &
+                        " PARAMETER ASSOCIATION  IS NOT CONFUSED" &
+                        " WITH AN ACTUAL PARAMETER HAVING THE" &
+                        " SAME SPELLING" );
+ 
+      DECLARE
+ 
+           PROCEDURE  BUMP  IS
+           BEGIN
+                FLOW_INDEX := FLOW_INDEX + 1 ;
+           END BUMP ;
+ 
+           PROCEDURE  P1 ( P : INTEGER )  IS
+           BEGIN
+                IF  P = 17  THEN  BUMP ; END IF ;
+           END ;
+ 
+           FUNCTION  F1 ( P : INTEGER ) RETURN INTEGER  IS
+           BEGIN
+                RETURN  P ;
+           END ;
+ 
+      BEGIN
+ 
+           P1 ( P );
+           P1 ( P => P );
+ 
+           IF  F1 ( P + 1 )      = 17 + 1  THEN  BUMP ;  END IF;
+           IF  F1 ( P => P + 1 ) = 17 + 1  THEN  BUMP ;  END IF;
+ 
+      END ;
+ 
+      IF  FLOW_INDEX /= 4  THEN
+           FAILED( "INCORRECT ACCESSING OR INCORRECT FLOW" );
+      END IF;
+ 
+      RESULT;
+ 
+ END C83E03A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C83F01A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INSIDE A PACKAGE BODY,  AN ATTEMPT TO REFERENCE AN IDENTI-
+ --    FIER DECLARED IN THE CORRESPONDING PACKAGE SPECIFICATION
+ --    IS SUCCESSFUL, EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+ --    ENVIRONMENT SURROUNDING THE PACKAGE BODY.
+ 
+ -- NESTED PACKAGE BODIES ARE TESTED IN  C83F01B , C83F01C , C83F01D
+ 
+ 
+ --    RM    05 AUGUST 1980
+ --    JRK   13 NOV    1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83F01A  IS
+ 
+      USE REPORT;
+ 
+      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+ 
+      TYPE  T1  IS  ( A , B , C) ;
+ 
+      Z : T1 := A ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C83F01A" , "CHECK THAT INSIDE A PACKAGE BODY, " &
+                        "AN ATTEMPT TO REFERENCE AN IDENTIFIER " &
+                        "DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                        "FICATION IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                        "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
+                        "ING THE PACKAGE BODY" ) ;
+ 
+      COMMENT( "NESTED PACKAGE BODIES ARE TESTED IN  C83F01B , -C , -D");
+ 
+ 
+      DECLARE
+ 
+ 
+           PACKAGE  P  IS
+ 
+                X1 : BOOLEAN := FALSE ;
+                X2 : INTEGER RANGE 1..23 := 11 ;
+                Y1 : BOOLEAN := TRUE ;
+                Y2 : INTEGER := 5 ;
+                T1 : INTEGER := 6 ;
+                Z  : INTEGER := 7 ;
+ 
+           END  P ;
+ 
+ 
+           Y1 , Y2 : INTEGER := 13 ;
+ 
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+ 
+                X1 := X1 OR Y1 ;
+                Z  :=  Z + T1 ;
+                Y2 := X2 * Y2 ;
+ 
+                -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+                --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+                --    COMPILE TIME AS TYPE ERRORS.
+ 
+           END P ;
+ 
+ 
+      BEGIN
+ 
+           IF  X1 /= 17  OR
+               Z  /= A   OR
+               Y2 /= 13   OR
+               NOT P.X1    OR
+               P.Z  /= 13  OR
+               P.Y2 /= 55
+           THEN  FAILED( "INCORRECT ACCESSING" );
+           END IF;
+ 
+      END ;
+ 
+ 
+      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+ 
+ END C83F01A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- C83F01B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN ANOTHER PACKAGE BODY
+ --    AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
+ --    CORRESPONDING PACKAGE SPECIFICATION
+ --    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+ --    OUTER PACKAGE (SPECIFICATION OR BODY)  OR  IN THE
+ --    ENVIRONMENT SURROUNDING THE OUTER PACKAGE BODY.
+ 
+ -- INTERACTIONS WITH SEPARATE COMPILATION ARE TESTED IN  C83F01C ,
+ --    C83F01D .
+ 
+ 
+ --    RM    08 AUGUST 1980
+ --    JRK   13 NOV    1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83F01B  IS
+ 
+      USE REPORT;
+ 
+      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+ 
+      TYPE  T1  IS  ( A , B , C) ;
+ 
+      Z : T1 := A ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C83F01B" , "CHECK THAT INSIDE A NESTED PACKAGE BODY" &
+                        " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
+                        " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                        "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                        "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
+                        "ING THE PACKAGE BODY" ) ;
+ 
+      COMMENT("SEPARATELY COMPILED PACKAGES ARE TESTED IN  C83F01C, -D");
+ 
+ 
+      DECLARE
+ 
+ 
+           Y1 , Y2 : INTEGER := 100 ;
+ 
+ 
+           PACKAGE  OUTER  IS
+ 
+                Y3 : INTEGER := 100 ;
+ 
+                PACKAGE  P  IS
+ 
+                     X1 : BOOLEAN := FALSE ;
+                     X2 : INTEGER RANGE 1..23 := 11 ;
+                     Y1 , Y3 : BOOLEAN := TRUE ;
+                     Y2 , Y4 : INTEGER := 5 ;
+                     T1 : INTEGER := 6 ;
+                     Z  : INTEGER := 7 ;
+ 
+                END  P ;
+ 
+           END  OUTER ;
+ 
+ 
+           X2 : INTEGER := 100 ;
+ 
+ 
+           PACKAGE BODY  OUTER  IS
+ 
+                Y4 : INTEGER := 200 ;
+ 
+                PACKAGE BODY  P  IS
+                BEGIN
+ 
+                     X1 :=  NOT X1  AND  Y1  AND  Y3 ;
+                     Z  :=  Z + T1 ;
+                     Y2 := X2 * Y2 ;
+                     Y4 := X2 * Y4 ;
+ 
+                     -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+                     --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+                     --    COMPILE TIME AS TYPE ERRORS
+ 
+                END P ;
+ 
+           END OUTER ;
+ 
+ 
+      BEGIN
+ 
+           IF  X1 /= 17   OR
+               Z  /= A    OR
+               Y2 /= 100  OR
+               NOT OUTER.P.X1    OR
+               OUTER.P.Z  /= 13  OR
+               OUTER.P.Y2 /= 55  OR
+               OUTER.P.Y4 /= 55
+           THEN FAILED( "INCORRECT ACCESSING" );
+           END IF;
+ 
+      END ;
+ 
+ 
+      RESULT;   --  POSSIBLE ERROR DURING ELABORATION OF  P
+ 
+ END C83F01B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,55 ----
+ -- C83F01C0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F01C2M
+ 
+ -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+ --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F01D0M ,
+ --    C83F01D1 ). THE PRESENT FILE CONTAINS THE SPECIFICATION
+ --    OF THE PACKAGE. THE BODY IS IN FILE C83F01C1.
+ 
+ 
+ --    RM    13 AUGUST 1980
+ --    RM    22 AUGUST 1980
+ -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ 
+ PACKAGE  C83F01C0  IS
+ 
+      Y3 : INTEGER := 100 ;
+ 
+      PACKAGE  P  IS
+      
+           X1 : BOOLEAN := FALSE ;
+           X2 : INTEGER RANGE 1..23 := 11 ;
+           Y1 , Y3 : BOOLEAN := TRUE ;
+           Y2 , Y4 : INTEGER := 5 ;
+           T1 : INTEGER := 6 ;
+           Z  : INTEGER := 7 ;
+      
+      END  P ;
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+ END  C83F01C0 ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- C83F01C1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F01C2M
+ 
+ -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+ --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F01D0M ,
+ --    C83F01D1 ). THE PRESENT FILE CONTAINS THE BODY OF THE PACKAGE.
+ 
+ -- FOR THIS FILE, THE FILE NAME AND THE UNIT NAME ARE NOT THE SAME.
+ 
+ 
+ --    RM    13 AUGUST 1980
+ --    RM    22 AUGUST 1980
+ --    RM    28 AUGUST 1980  ('FAILED(.)' MOVED TO MAIN)
+ -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ 
+ PACKAGE BODY  C83F01C0  IS
+ 
+      Y4 : INTEGER := 200 ;
+ 
+      PACKAGE BODY  P  IS
+      BEGIN
+ 
+           X1 :=  NOT X1  AND  Y1  AND  Y3 ;
+           Z  :=  Z + T1 ;
+           Y2 := X2 * Y2 ;
+           Y4 := X2 * Y4 ;
+ 
+           -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+           --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+           --    COMPILE TIME AS TYPE ERRORS.
+ 
+           -- ALL 4 ASSIGNMENTS ARE TESTED IN THE MAIN PROGRAM (RATHER
+           --    THAN HERE) TO PRECLUDE FALSE NEGATIVES (WHERE THE LACK
+           --    OF ELABORATION-TIME ERROR MESSAGES SIMPLY MEANS THAT THE
+           --    PACKAGE WAS NOT ELABORATED).
+ 
+ 
+      END P ;
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+        NULL;
+      END;
+ 
+ END C83F01C0 ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01c2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01c2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01c2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- C83F01C2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE
+ --    ( C83F01C0 ; SPECIFICATION IN  C83F01C0.ADA ,
+ --                 BODY IN           C83F01C1.ADA )
+ 
+ -- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN A SEPARATELY COMPILED
+ --    PACKAGE BODY AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
+ --    CORRESPONDING PACKAGE SPECIFICATION
+ --    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+ --    OUTER PACKAGE (SPECIFICATION OR BODY).
+ 
+ -- CASE 1:  PACKAGE IS A FULL-FLEDGED COMPILATION UNIT
+ 
+ 
+ --    RM    11 AUGUST 1980
+ --    RM    22 AUGUST 1980
+ --    RM    29 AUGUST 1980 (MOVED 'FAILED(.)' FROM C83F01C1.ADA TO HERE)
+ 
+ 
+ WITH REPORT , C83F01C0 ;
+ PROCEDURE  C83F01C2M  IS
+ 
+      USE  REPORT , C83F01C0 ;
+ 
+ BEGIN
+ 
+      TEST( "C83F01C" , "CHECK THAT INSIDE A  PACKAGE BODY" &
+                        " NESTED WITHIN A SEPARATELY" &
+                        " COMPILED PACKAGE BODY LIBRARY UNIT," &
+                        " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
+                        " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                        "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                        "TIFIER IS DECLARED IN THE OUTER PACKAGE" &
+                        " (SPECIFICATION OR BODY)" ) ;
+ 
+      IF  NOT P.X1    OR
+          P.Z  /= 13  OR
+          P.Y2 /= 55  OR
+          P.Y4 /= 55
+      THEN FAILED( "INCORRECT ACCESSING" );
+      END IF;
+ 
+      RESULT ;
+ 
+ 
+ END C83F01C2M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01d0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01d0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01d0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C83F01D0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE BODY SUBUNIT
+ --    ( C83F01D1.ADA )
+ 
+ -- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN A SEPARATELY COMPILED
+ --    PACKAGE BODY AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
+ --    CORRESPONDING PACKAGE SPECIFICATION
+ --    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+ --    OUTER PACKAGE (SPECIFICATION OR BODY).
+ 
+ -- CASE 2:  PACKAGE BODY IS A COMPILATION SUBUNIT
+ 
+ 
+ --    RM    13 AUGUST 1980
+ --    RM    29 AUGUST 1980
+ --    JRK   13 NOV    1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83F01D0M  IS
+ 
+      USE REPORT ;
+ 
+      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+      Y1      : INTEGER := 157 ;
+ 
+      TYPE  T1  IS  ( A , B , C) ;
+ 
+      Z : T1 := A ;
+ 
+ 
+      PACKAGE  C83F01D1  IS
+ 
+           Y3 : INTEGER := 100 ;
+ 
+           PACKAGE  P  IS
+ 
+                X1 : BOOLEAN := FALSE ;
+                X2 : INTEGER RANGE 1..23 := 11 ;
+                Y1 , Y3 : BOOLEAN := TRUE ;
+                Y2 , Y4 : INTEGER := 5 ;
+                T1 : INTEGER := 23 ;
+                Z  : INTEGER := 0 ;
+ 
+           END  P ;
+ 
+      END  C83F01D1 ;
+ 
+ 
+      Y2 : INTEGER := 200 ;
+ 
+ 
+      PACKAGE BODY  C83F01D1  IS SEPARATE ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C83F01D" , "CHECK THAT INSIDE A  PACKAGE BODY" &
+                        " NESTED WITHIN A SEPARATELY" &
+                        " COMPILED PACKAGE BODY SUBUNIT," &
+                        " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
+                        " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                        "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                        "TIFIER IS DECLARED IN THE OUTER PACKAGE" &
+                        " (SPECIFICATION OR BODY)" ) ;
+ 
+      IF  X1 /= 17   OR
+          Z  /= A    OR
+          Y2 /= 200  OR
+          NOT C83F01D1.P.X1    OR
+          C83F01D1.P.Z  /= 23  OR
+          C83F01D1.P.Y2 /= 55  OR
+          C83F01D1.P.Y4 /= 55
+      THEN FAILED( "INCORRECT ACCESSING" );
+      END IF;
+ 
+      RESULT ;
+ 
+ 
+ END C83F01D0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01d1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f01d1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f01d1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,57 ----
+ -- C83F01D1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATELY COMPILED PACKAGE BODY FOR USE WITH  C83F01D0M
+ 
+ 
+ --    RM    13 AUGUST 1980
+ --    RM    29 AUGUST 1980
+ 
+ 
+ 
+ SEPARATE (C83F01D0M)
+ PACKAGE BODY  C83F01D1  IS
+ 
+      Y4 : INTEGER := 200 ;
+ 
+      PACKAGE BODY  P  IS
+      BEGIN
+ 
+           X1 :=  NOT X1  AND  Y1  AND  Y3 ;
+           Z  :=  Z + T1 ;
+           Y2 := X2 * Y2 ;
+           Y4 := X2 * Y4 ;
+ 
+           -- ALL 4 ASSIGNMENTS ARE TESTED IN THE MAIN PROGRAM (RATHER
+           --    THAN HERE) TO PRECLUDE FALSE NEGATIVES (WHERE THE LACK
+           --    OF ELABORATION-TIME ERROR MESSAGES SIMPLY MEANS THAT THE
+           --    PACKAGE WAS NOT ELABORATED).
+ 
+           -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+           --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+           --    COMPILE TIME AS TYPE ERRORS.
+ 
+      END P ;
+ 
+ END C83F01D1 ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C83F03A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INSIDE A PACKAGE BODY  AN ATTEMPT TO PLACE AND REFERENCE
+ --    A LABEL IS SUCCESSFUL EVEN IF ITS IDENTIFIER IS DECLARED IN THE
+ --    ENVIRONMENT SURROUNDING THE PACKAGE BODY.
+ 
+ -- NESTED PACKAGE BODIES ARE TESTED IN  C83F03B , C83F03C , C83F03D
+ 
+ 
+ --    RM    03 SEPTEMBER 1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83F03A  IS
+ 
+      USE REPORT;
+ 
+      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+ 
+      TYPE  T1  IS  ( A , B , C) ;
+ 
+      Z : T1 := A ;
+ 
+      FLOW_INDEX : INTEGER := 0 ;
+ 
+ BEGIN
+ 
+      TEST( "C83F03A" , "CHECK THAT INSIDE A PACKAGE BODY " &
+                        " AN ATTEMPT TO PLACE AND REFERENCE A LABEL" &
+                        " IS SUCCESSFUL EVEN IF ITS IDEN" &
+                        "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
+                        "ING THE PACKAGE BODY" ) ;
+ 
+ 
+      DECLARE
+ 
+ 
+           Y1 , Y2 : INTEGER := 13 ;
+ 
+ 
+           PROCEDURE  BUMP  IS
+           BEGIN
+                FLOW_INDEX := FLOW_INDEX + 1 ;
+           END BUMP ;
+ 
+ 
+           PACKAGE  P  IS
+ 
+                AA : BOOLEAN := FALSE ;
+ 
+           END  P ;
+ 
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+ 
+                GOTO  X1 ;
+ 
+                BUMP ;
+                BUMP ;
+ 
+                <<X1>>   BUMP ;  GOTO  X2 ;
+                BUMP ;
+                <<T1>>   BUMP ;  GOTO  Z ;
+                BUMP ;
+                <<Y1>>   BUMP ;  GOTO  Y2 ;
+                BUMP ;
+                <<Y2>>   BUMP ;  GOTO  T1 ;
+                BUMP ;
+                <<X2>>   BUMP ;  GOTO  Y1 ;
+                BUMP ;
+                <<Z >>   BUMP ;  GOTO  ENDING ;
+                BUMP ;
+ 
+                << ENDING >>  NULL;
+ 
+           END P ;
+ 
+ 
+      BEGIN
+ 
+           IF  FLOW_INDEX /= 6
+           THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+           END IF;
+ 
+      END ;
+ 
+ 
+      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+ 
+ END C83F03A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,157 ----
+ -- C83F03B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE ANOTHER PACKAGE BODY
+ --    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
+ --    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY, TO AN IDENTI-
+ --    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION,
+ --    OR TO A LABEL IDENTIFIER OR OTHER IDENTIFIER IN THE
+ --    ENVIRONMENT SURROUNDING THE OUTER PACKAGE BODY.
+ 
+ 
+ -- INTERACTIONS WITH SEPARATE COMPILATION ARE TESTED IN  C83F03C ,
+ --    C83F03D .
+ 
+ 
+ --    RM    04 SEPTEMBER 1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83F03B  IS
+ 
+      USE REPORT;
+ 
+      X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+ 
+      TYPE  T1  IS  ( A , B , C) ;
+ 
+      Z : T1 := A ;
+ 
+      FLOW_INDEX : INTEGER := 0 ;
+ 
+ BEGIN
+ 
+      TEST( "C83F03B" , "CHECK THAT IF A PACKAGE BODY IS NESTED" &
+                        " INSIDE ANOTHER PACKAGE BODY, THE INNER" &
+                        " PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER" &
+                        " IDENTICAL TO A LABEL IDENTIFIER IN THE OUTER" &
+                        " PACKAGE BODY, TO AN IDENTIFIER DECLARED IN" &
+                        " THE OUTER PACKAGE BODY OR IN ITS SPECIFICA" &
+                        "TION, OR TO A LABEL IDENTIFIER OR OTHER" &
+                        " IDENTIFIER IN THE ENVIRONMENT SURROUNDING" &
+                        " THE OUTER PACKAGE BODY" ) ;
+ 
+ 
+      DECLARE
+ 
+ 
+           Y1 , Y2 : INTEGER := 100 ;
+ 
+           X2 : INTEGER := 100 ;
+ 
+ 
+           PROCEDURE  BUMP  IS
+           BEGIN
+                FLOW_INDEX := FLOW_INDEX + 1 ;
+           END BUMP ;
+ 
+ 
+           PACKAGE  OUTER  IS
+ 
+                Y3 : INTEGER := 100 ;
+ 
+                TYPE  T3  IS  ( D , E , F ) ;
+ 
+                PACKAGE  P  IS
+                     AA : BOOLEAN := FALSE ;
+                END  P ;
+ 
+           END  OUTER ;
+ 
+ 
+           PACKAGE BODY  OUTER  IS
+ 
+                Y4 : INTEGER := 200 ;
+ 
+                TYPE  T4  IS  ( G , H , I ) ;
+ 
+                PACKAGE BODY  P  IS
+                BEGIN
+ 
+ 
+                     GOTO  X1 ;
+ 
+                     BUMP ;
+                     BUMP ;
+ 
+                     <<X1>>   BUMP ;  GOTO  X2 ;
+                     BUMP ;
+                     <<T1>>   BUMP ;  GOTO  Z ;
+                     BUMP ;
+                     <<Y1>>   BUMP ;  GOTO  Y2 ;
+                     BUMP ;
+                     <<Y2>>   BUMP ;  GOTO  T1 ;
+                     BUMP ;
+                     <<X2>>   BUMP ;  GOTO  Y1 ;
+                     BUMP ;
+                     <<Z >>   BUMP ;  GOTO  T3 ;
+                     BUMP ;
+                     <<T3>>   BUMP ;  GOTO  T4 ;
+                     BUMP ;
+                     <<LABEL_IN_OUTER>>   BUMP ;  GOTO  LABEL_IN_MAIN ;
+                     BUMP ;
+                     <<Y3>>   BUMP ;  GOTO  Y4 ;
+                     BUMP ;
+                     <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
+                     BUMP ;
+                     <<T4>>   BUMP ;  GOTO  Y3 ;
+                     BUMP ;
+                     <<LABEL_IN_MAIN >>   BUMP ;  GOTO  ENDING ;
+                     BUMP ;
+ 
+                     << ENDING >>  NULL;
+ 
+                END P ;
+ 
+           BEGIN
+ 
+                << LABEL_IN_OUTER >>  NULL ;
+ 
+           END OUTER ;
+ 
+ 
+      BEGIN
+ 
+           << LABEL_IN_MAIN >>
+ 
+           IF  FLOW_INDEX /= 12
+           THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+           END IF;
+ 
+      END ;
+ 
+ 
+      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+ 
+ END C83F03B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- C83F03C0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F03C2M
+ 
+ -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+ --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F03D0M ,
+ --    C83F03D1 ). THE PRESENT FILE CONTAINS THE SPECIFICATION
+ --    OF THE PACKAGE.  THE PACKAGE BODY IS IN  C83F03C1.ADA .
+ 
+ 
+ --    RM    04 SEPTEMBER 1980
+ -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ 
+ PACKAGE  C83F03C0  IS
+ 
+      Y3 : INTEGER := 100 ;
+ 
+      TYPE  T3  IS  ( D , E , F ) ;
+ 
+      FLOW_INDEX : INTEGER := 0 ;
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+      PACKAGE  P  IS
+      
+           AA : BOOLEAN := FALSE ;
+      
+      END  P ;
+ 
+ END  C83F03C0 ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C83F03C1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F03C2M
+ 
+ -- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+ --    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F03D0M ,
+ --    C83F03D1 ). THE PRESENT FILE CONTAINS THE BODY OF THE PACKAGE.
+ 
+ -- FOR THIS FILE, THE FILE NAME AND THE UNIT NAME ARE NOT THE SAME.
+ 
+ 
+ --    RM    05 SEPTEMBER 1980
+ -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ 
+ PACKAGE BODY  C83F03C0  IS
+ 
+      Y4 : INTEGER := 200 ;
+ 
+      TYPE  T4  IS  ( G , H , I ) ;
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           FLOW_INDEX := FLOW_INDEX + 1 ;
+      END BUMP ;
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+        NULL;
+      END;
+ 
+      PACKAGE BODY  P  IS
+      BEGIN
+ 
+           GOTO  T3 ;
+ 
+           BUMP ;
+           BUMP ;
+ 
+           <<T3>>   BUMP ;  GOTO  T4 ;
+           BUMP ;
+           <<LABEL_IN_OUTER>>   BUMP ;  GOTO  ENDING ;
+           BUMP ;
+           <<Y3>>   BUMP ;  GOTO  Y4 ;
+           BUMP ;
+           <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
+           BUMP ;
+           <<T4>>   BUMP ;  GOTO  Y3 ;
+           BUMP ;
+ 
+           << ENDING >>  NULL;
+ 
+      END P ;
+ 
+ BEGIN
+ 
+      << LABEL_IN_OUTER >>  NULL ;
+ 
+ END  C83F03C0 ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03c2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03c2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03c2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C83F03C2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE
+ --    ( C83F03C0 ; SPECIFICATION IN  C83F03C0.ADA ,
+ --                 BODY IN           C83F03C1.ADA )
+ 
+ -- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE A SEPARATELY COMPILED
+ --    PACKAGE BODY
+ --    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
+ --    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY OR TO AN IDENTI-
+ --    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION.
+ 
+ -- CASE 1:  PACKAGE IS A FULL-FLEDGED COMPILATION UNIT
+ 
+ 
+ --    RM    05 SEPTEMBER 1980
+ 
+ 
+ WITH REPORT , C83F03C0 ;
+ PROCEDURE  C83F03C2M  IS
+ 
+      USE  REPORT , C83F03C0 ;
+ 
+ BEGIN
+ 
+      TEST( "C83F03C" , "CHECK THAT IF A PACKAGE BODY IS NESTED" &
+                        " INSIDE A SEPARATELY COMPILED PACKAGE BODY" &
+                        " LIBRARY UNIT, THE INNER" &
+                        " PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER" &
+                        " IDENTICAL TO A LABEL IDENTIFIER IN THE OUTER" &
+                        " PACKAGE BODY OR TO AN IDENTIFIER DECLARED IN" &
+                        " THE OUTER PACKAGE BODY OR IN ITS SPECIFICA" &
+                        "TION" ) ;
+ 
+      IF  FLOW_INDEX /= 5
+      THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+      END IF;
+ 
+      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+ 
+ 
+ END C83F03C2M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03d0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03d0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03d0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03d0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- C83F03D0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE BODY SUBUNIT
+ --    ( C83F03D1.ADA )
+ 
+ -- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE A SEPARATELY COMPILED
+ --    PACKAGE BODY
+ --    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
+ --    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY OR TO AN IDENTI-
+ --    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION
+ --    OR IN ITS ENVIRONMENT.
+ 
+ -- CASE 2:  PACKAGE BODY IS A COMPILATION SUBUNIT
+ 
+ 
+ --    RM    08 SEPTEMBER 1980
+ --    JRK   14 NOVEMBER  1980
+ 
+ 
+ WITH REPORT;
+ PROCEDURE  C83F03D0M  IS
+ 
+      USE REPORT ;
+ 
+      X1 : INTEGER := 17 ;
+ 
+      TYPE  T1  IS  ( A, B, C ) ;
+ 
+      Z : T1 := A ;
+ 
+      FLOW_INDEX : INTEGER := 0 ;
+ 
+ 
+      PACKAGE  C83F03D1  IS
+ 
+           Y3 : INTEGER := 100 ;
+ 
+           TYPE  T3  IS  ( D , E , F ) ;
+ 
+           PACKAGE  P  IS
+                AA : BOOLEAN := FALSE ;
+           END  P ;
+ 
+      END  C83F03D1 ;
+ 
+ 
+      Y1 : INTEGER := 100 ;
+ 
+ 
+      PACKAGE BODY  C83F03D1  IS SEPARATE ;
+ 
+ 
+ BEGIN
+ 
+      TEST( "C83F03D" , "CHECK THE RECOGNITION OF LABELS IN NESTED" &
+                        " PACKAGES SEPARATELY COMPILED AS SUBUNITS" );
+ 
+      << LABEL_IN_MAIN >>
+ 
+      IF  FLOW_INDEX /= 10
+      THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+      END IF;
+ 
+      RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+ 
+ 
+ END C83F03D0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03d1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03d1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c83f03d1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c83f03d1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C83F03D1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATELY COMPILED PACKAGE BODY FOR USE WITH  C83F03D0M
+ 
+ 
+ --    RM    08 SEPTEMBER 1980
+ --    JRK   14 NOVEMBER  1980
+ 
+ 
+ 
+ SEPARATE (C83F03D0M)
+ PACKAGE BODY  C83F03D1  IS
+ 
+      Y4 : INTEGER := 200 ;
+ 
+      TYPE  T4  IS  ( G , H , I ) ;
+ 
+      PROCEDURE  BUMP  IS
+      BEGIN
+           FLOW_INDEX := FLOW_INDEX + 1 ;
+      END BUMP ;
+ 
+      PACKAGE BODY  P  IS
+      BEGIN
+ 
+           GOTO  X1 ;
+ 
+           BUMP ;
+           BUMP ;
+ 
+           <<LABEL_IN_MAIN>>   BUMP ;  GOTO  T3 ;
+           BUMP ;
+           <<T1>>   BUMP ;  GOTO  Z ;
+           BUMP ;
+           <<Y1>>   BUMP ;  GOTO  LABEL_IN_MAIN ;
+           BUMP ;
+           <<X1>>   BUMP ;  GOTO  T1 ;
+           BUMP ;
+           <<Z>>    BUMP ;  GOTO  Y1 ;
+           BUMP ;
+           <<T3>>   BUMP ;  GOTO  T4 ;
+           BUMP ;
+           <<LABEL_IN_OUTER>>   BUMP ;  GOTO  ENDING ;
+           BUMP ;
+           <<Y3>>   BUMP ;  GOTO  Y4 ;
+           BUMP ;
+           <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
+           BUMP ;
+           <<T4>>   BUMP ;  GOTO  Y3 ;
+           BUMP ;
+ 
+           << ENDING >>  NULL;
+ 
+      END P ;
+ 
+ BEGIN
+ 
+      << LABEL_IN_OUTER >>  NULL ;
+ 
+ END C83F03D1 ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c840001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c840001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c840001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c840001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,257 ----
+ -- C840001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for the type determined by the subtype mark of a use type
+ --      clause, the declaration of each primitive operator is use-visible
+ --      within the scope of the clause, even if explicit operators with the
+ --      same names as the type's operators are declared for the subtype. Check
+ --      that a call to such an operator executes the body of the type's
+ --      operation.
+ --
+ -- TEST DESCRIPTION:
+ --      A type may declare a primitive operator, and a subtype of that type
+ --      may overload the operator. If a use type clause names the subtype,
+ --      it is the primitive operator of the type (not the subtype) which
+ --      is made directly visible, and the primitive operator may be called
+ --      unambiguously. Such a call executes the body of the type's operation.
+ --
+ --      In a package, declare a type for which a predefined operator is
+ --      overridden.  In another package, declare a subtype of the type in the
+ --      previous package.  Declare another version of the predefined operator
+ --      for the subtype.
+ --
+ --      The main program declares objects of both the type and the explicit
+ --      subtype, and uses the "**" operator for both.  In all cases, the
+ --      operator declared for the 1st subtype should be the one executed,
+ --      since it is the primitive operators of the *type* that are made
+ --      visible; the operators which were declared for the explicit subtype
+ --      are not primitive operators of the type, since they were declared in
+ --      a separate package from the original type.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      23 Sep 99   RLB     Added test case where operator made visible is
+ --                          not visible by selection (as in AI-00122).
+ --
+ --!
+ 
+ package C840001_0 is
+ -- Usage scenario: the predefined operators for a floating point type
+ -- are overridden in order to take advantage of improved algorithms.
+ 
+    type Precision_Float is new Float range -100.0 .. 100.0;
+    -- Implicit: function "**" (Left: Precision_Float; Right: Integer'Base)
+    -- return Precision_Float;
+ 
+    function "**" (Left: Precision_Float; Right: Integer'Base)
+      return Precision_Float;
+    -- Overrides predefined operator.
+ 
+    function "+" (Right: Precision_Float)
+      return Precision_Float;
+    -- Overrides predefined operator.
+ 
+    -- ... Other overridden operations.
+ 
+    TC_Expected : constant Precision_Float := 68.0;
+ 
+ end C840001_0;
+ 
+ 
+      --==================================================================--
+ 
+ package body C840001_0 is
+ 
+    function "**" (Left: Precision_Float; Right: Integer'Base)
+      return Precision_Float is
+    begin
+       -- ... Utilize desired algorithm.
+       return (TC_Expected);  -- Artificial for testing purposes.
+    end "**";
+ 
+    function "+" (Right: Precision_Float)
+      return Precision_Float is
+    -- Overrides predefined operator.
+    begin
+       return Right*2.0;
+    end "+";
+ 
+ end C840001_0;
+ 
+ 
+      --==================================================================--
+ 
+ -- Take advantage of some even better algorithms designed for positive
+ -- floating point values.
+ 
+ with C840001_0;
+ package C840001_1 is
+ 
+    subtype Precision_Pos_Float is C840001_0.Precision_Float
+      range 0.0 .. 100.0;
+ 
+ -- This is not a new type, so it has no primitives of it own. However, it
+ -- can declare another version of the operator and call it as long as both it
+ -- and the corresponding operator of the 1st subtype are not directly visible
+ -- in the same place.
+ 
+    function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
+      return Precision_Pos_Float;           -- Accepts only positive exponent.
+ 
+ end C840001_1;
+ 
+ 
+      --==================================================================--
+ 
+ package body C840001_1 is
+ 
+    function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
+      return Precision_Pos_Float is
+    begin
+       -- ... Utilize some other algorithms.
+       return 57.0;           -- Artificial for testing purposes.
+    end "**";
+ 
+ end C840001_1;
+ 
+ 
+      --==================================================================--
+ 
+ with Report;
+ with C840001_1;
+ procedure C840001_2 is
+ 
+    -- Note that C840001_0 and it's contents is not visible in any form here.
+ 
+    TC_Operand   : C840001_1.Precision_Pos_Float := 41.0;
+ 
+    TC_Operand2  : C840001_1.Precision_Pos_Float;
+ 
+    use type C840001_1.Precision_Pos_Float;
+       -- Makes the operators of its parent type directly visible, even though
+       -- the parent type and operators are not otherwise visible at all.
+ 
+ begin
+ 
+    TC_Operand2 := +TC_Operand; -- Overridden operator is visible and called.
+ 
+    if TC_Operand2 /= 82.0 then -- Predefined equality.
+       Report.Failed ("3rd test: type's overridden operation not called for " &
+                      "operand of 1st subtype");
+    end if;
+    if TC_Operand + 3.0 >= TC_Operand2 - 13.0 then -- Various predefined operators.
+       Report.Failed ("3rd test: wrong result from predefined operators");
+    end if;
+ 
+ end C840001_2;
+ 
+      --==================================================================--
+ 
+ 
+ with C840001_0;
+ with C840001_1;
+ with C840001_2;
+ 
+ with Report;
+ 
+ procedure C840001 is
+ 
+ begin
+    Report.Test ("C840001", "Check that, for the type determined by the "   &
+                 "subtype mark of a use type clause, the declaration of "   &
+                 "each primitive operator is use-visible within the scope " &
+                 "of the clause, even if explicit operators with the same " &
+                 "names as the type's operators are declared for the subtype");
+ 
+ 
+    Use_Type_Precision_Pos_Float:
+    declare
+       TC_Operand          : C840001_0.Precision_Float
+                           := C840001_0.Precision_Float(-2.0);
+       TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  6.0;
+ 
+       TC_Actual_Type      : C840001_0.Precision_Float;
+       TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
+ 
+       use type C840001_1.Precision_Pos_Float;
+       -- Both calls to "**" should return 68.0 (that is, Precision_Float's
+       -- operation should be called).
+ 
+    begin
+ 
+       TC_Actual_Type := TC_Operand**2;
+ 
+       if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
+          Report.Failed ("1st block: type's operation not called for " &
+                         "operand of 1st subtype");
+       end if;
+ 
+       TC_Actual_Subtype := TC_Positive_Operand**2;
+ 
+       if not (C840001_0."="
+              (TC_Actual_Subtype, C840001_0.TC_Expected)) then
+          Report.Failed ("1st block: type's operation not called for " &
+                         "operand of explicit subtype");
+       end if;
+ 
+    end Use_Type_Precision_Pos_Float;
+ 
+    Use_Type_Precision_Float:
+    declare
+       TC_Operand          : C840001_0.Precision_Float
+                           := C840001_0.Precision_Float(4.0);
+       TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  7.0;
+ 
+       TC_Actual_Type      : C840001_0.Precision_Float;
+       TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
+ 
+       use type C840001_0.Precision_Float;
+       -- Again, both calls to "**" should return 68.0.
+ 
+   begin
+ 
+       TC_Actual_Type := TC_Operand**2;
+ 
+       if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
+          Report.Failed ("2nd block: type's operation not called for " &
+                         "operand of 1st subtype");
+       end if;
+ 
+       TC_Actual_Subtype := TC_Positive_Operand**2;
+ 
+       if not C840001_0."=" (TC_Actual_Subtype, C840001_0.TC_Expected) then
+          Report.Failed ("2nd block: type's operation not called for " &
+                         "operand of explicit subtype");
+       end if;
+ 
+    end Use_Type_Precision_Float;
+ 
+    C840001_2; -- 3rd test.
+ 
+    Report.Result;
+ 
+ end C840001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- C84002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT:
+ 
+ --   A) IF A USE CLAUSE NAMES AN ENCLOSING PACKAGE, THE USE CLAUSE
+ --      HAS NO EFFECT.
+ 
+ --   B) IF A DECLARATION IS DIRECTLY VISIBLE PRIOR TO THE OCCURRENCE
+ --      OF A USE CLAUSE, AND IS NOT IN THE SET OF POTENTIALLY
+ --      VISIBLE DECLARATIONS, IT REMAINS DIRECTLY VISIBLE AFTER THE
+ --      USE CLAUSE.
+ 
+ --   C) IF A HOMOGRAPH FOR A POTENTIALLY VISIBLE SUBPROGRAM OR
+ --      OBJECT IS DECLARED AFTER A USE CLAUSE, THE POTENTIALLY
+ --      VISIBLE ENTITY IS NO LONGER VISIBLE.
+ 
+ -- EG  02/16/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C84002A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C84002A","CHECK THAT DECLARATIONS DIRECTLY VISIBLE PRIOR " &
+                     "TO THE USE CLAUSE REMAIN VISIBLE AFTERWARDS");
+ 
+      BEGIN
+ 
+           COMMENT ("CASE A : CHECK THAT IF A USE CLAUSE NAMES AN " &
+                    "ENCLOSING PACKAGE, THE USE CLAUSE HAS NO EFFECT");
+ 
+ CASE_A :  DECLARE
+ 
+                PACKAGE P1 IS
+                     X : FLOAT := 1.5;
+                END P1;
+                PACKAGE P2 IS
+                     X : INTEGER := 15;
+ 
+                     USE P1;
+                     USE P2;
+ 
+                     A : INTEGER := X;
+                END P2;
+                PACKAGE BODY P1 IS
+                BEGIN
+                     NULL;
+                END P1;
+                PACKAGE BODY P2 IS
+                BEGIN
+                     IF X /= IDENT_INT(15) OR X /= P2.X OR
+                        A /= P2.X THEN
+                          FAILED ("CASE A : USE CLAUSE HAS AN EFFECT");
+                     END IF;
+                END P2;
+ 
+           BEGIN
+ 
+                NULL;
+ 
+           END CASE_A;
+ 
+           COMMENT ("CASE B : CHECK THAT IF A DECLARATION IS DIRECTLY " &
+                    "VISIBLE PRIOR TO THE OCCURRENCE OF A USE CLAUSE, " &
+                    "AND IS NOT IN THE SET OF POTENTIALLY VISIBLE "     &
+                    "DECLARATIONS, IT REMAINS DIRECTLY VISIBLE");
+ 
+ CASE_B :  BEGIN
+ 
+      CASE_B1 : DECLARE
+ 
+                     PACKAGE P1 IS
+                          Y : FLOAT := 1.5;
+                     END P1;
+                     PACKAGE P2 IS
+                          X : INTEGER := 15;
+ 
+                          USE P1;
+ 
+                          A : INTEGER := X;
+                     END P2;
+ 
+                     PACKAGE BODY P1 IS
+                     BEGIN
+                          NULL;
+                     END P1;
+                     PACKAGE BODY P2 IS
+                     BEGIN
+                          IF X /= IDENT_INT(15) OR X /= P2.X OR
+                             A /= P2.X THEN
+                               FAILED ("CASE B1 : DECLARATION NO " &
+                                       "LONGER DIRECTLY VISIBLE");
+                          END IF;
+                     END P2;
+ 
+                BEGIN
+ 
+                     NULL;
+ 
+                END CASE_B1;
+ 
+      CASE_B2 : DECLARE
+ 
+                     PROCEDURE PROC1 (X : STRING) IS
+                     BEGIN
+                          NULL;
+                     END PROC1;
+ 
+                     PACKAGE P1 IS
+                          PROCEDURE PROC1 (X : STRING);
+                     END P1;
+                     PACKAGE BODY P1 IS
+                          PROCEDURE PROC1 (X : STRING) IS
+                          BEGIN
+                               FAILED ("CASE B2 : WRONG PROCEDURE " &
+                                       "DIRECTLY VISIBLE");
+                          END PROC1;
+                     END P1;
+ 
+                     USE P1;
+ 
+                BEGIN
+ 
+                     PROC1 ("ABC");
+ 
+                END CASE_B2;
+ 
+      CASE_B3 : DECLARE
+ 
+                     PROCEDURE PROC1 (X : STRING) IS
+                     BEGIN
+                          NULL;
+                     END PROC1;
+ 
+                     PACKAGE P1 IS
+                          PROCEDURE PROC1 (Y : STRING);
+                     END P1;
+                     PACKAGE BODY P1 IS
+                          PROCEDURE PROC1 (Y : STRING) IS
+                          BEGIN
+                               FAILED ("CASE B3 : WRONG PROCEDURE " &
+                                       "DIRECTLY VISIBLE");
+                          END PROC1;
+                     END P1;
+ 
+                     USE P1;
+ 
+                BEGIN
+ 
+                     PROC1 ("ABC");
+ 
+                END CASE_B3;
+ 
+           END CASE_B;
+ 
+           COMMENT ("CASE C : IF A HOMOGRAPH FOR A POTENTIALLY "      &
+                    "VISIBLE SUBPROGRAM OR OBJECT IS DECLARED AFTER " &
+                    "A USE CLAUSE, THE POTENTIALLY VISIBLE ENTITY "   &
+                    "IS NO LONGER VISIBLE");
+ 
+ CASE_C :  BEGIN
+ 
+      CASE_C1 : DECLARE
+ 
+                     PACKAGE P1 IS
+                          PROCEDURE PROC1 (X : FLOAT);
+                     END P1;
+ 
+                     USE P1;
+ 
+                     PACKAGE BODY P1 IS
+                          PROCEDURE PROC1 (X : FLOAT) IS
+                          BEGIN
+                               IF X = -1.5 THEN
+                                    FAILED ("CASE C1 : WRONG PROCEDURE" &
+                                            " CALLED (A)");
+                               ELSIF X /= 1.5 THEN
+                                    FAILED ("CASE C1 : WRONG VALUE " &
+                                            "PASSED (A)");
+                               END IF;
+                          END PROC1;
+                     BEGIN
+                          NULL;
+                     END P1;
+ 
+                     PROCEDURE PROC2 IS
+                     BEGIN
+                          PROC1 (1.5);
+                     END PROC2;
+ 
+                     PROCEDURE PROC1 (X : FLOAT) IS
+                     BEGIN
+                          IF X = 1.5 THEN
+                               FAILED ("CASE C1 : WRONG PROCEDURE" &
+                                       " CALLED (B)");
+                          ELSIF X /= -1.5 THEN
+                               FAILED ("CASE C1 : WRONG VALUE " &
+                                       "PASSED (B)");
+                          END IF;
+                     END PROC1;
+ 
+                BEGIN
+ 
+                     PROC2;
+                     PROC1 (-1.5);
+ 
+                END CASE_C1;
+ 
+      CASE_C2 : DECLARE
+ 
+                     PACKAGE P1 IS
+                          X : INTEGER := 15;
+                     END P1;
+ 
+                     USE P1;
+ 
+                     A : INTEGER := X;
+ 
+                     X : BOOLEAN := TRUE;
+ 
+                     B : BOOLEAN := X;
+ 
+                BEGIN
+ 
+                     IF A /= IDENT_INT(15) THEN
+                          FAILED ("CASE C2 : VARIABLE A DOES NOT " &
+                                  "CONTAIN THE CORRECT VALUE");
+                     END IF;
+                     IF B /= IDENT_BOOL(TRUE) THEN
+                          FAILED ("CASE C2 : VARIABLE B DOES NOT " &
+                                  "CONTAIN THE CORRECT VALUE");
+                     END IF;
+ 
+                END CASE_C2;
+ 
+           END CASE_C;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C84002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C84005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT TWO POTENTIALLY VISIBLE HOMOGRAPHS OF A SUBPROGRAM
+ --     IDENTIFIER CAN BE MADE DIRECTLY VISIBLE BY A USE CLAUSE, AND THAT
+ --     WHEN DIFFERENT FORMAL PARAMETER NAMES ARE USED THE SUBPROGRAMS
+ --     ARE REFERENCED CORRECTLY.
+ 
+ -- HISTORY:
+ --     JET 03/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C84005A IS
+ 
+      PACKAGE PACK1 IS
+           FUNCTION FUNK(A : INTEGER) RETURN INTEGER;
+           PROCEDURE PROK(A : INTEGER; B : OUT INTEGER);
+      END PACK1;
+ 
+      PACKAGE PACK2 IS
+           FUNCTION FUNK(X : INTEGER) RETURN INTEGER;
+           PROCEDURE PROK(X : INTEGER; Y : OUT INTEGER);
+      END PACK2;
+ 
+      USE PACK1, PACK2;
+      VAR1, VAR2 : INTEGER;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION FUNK(A : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF EQUAL (A,A) THEN
+                     RETURN (1);
+                ELSE
+                     RETURN (0);
+                END IF;
+           END FUNK;
+ 
+           PROCEDURE PROK(A : INTEGER; B : OUT INTEGER) IS
+           BEGIN
+                IF EQUAL (A,A) THEN
+                     B := 1;
+                ELSE
+                     B := 0;
+                END IF;
+           END PROK;
+      END PACK1;
+ 
+      PACKAGE BODY PACK2 IS
+           FUNCTION FUNK(X : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF EQUAL (X,X) THEN
+                     RETURN (2);
+                ELSE
+                     RETURN (0);
+                END IF;
+           END FUNK;
+ 
+           PROCEDURE PROK(X : INTEGER; Y : OUT INTEGER) IS
+           BEGIN
+                IF EQUAL (X,X) THEN
+                     Y := 2;
+                ELSE
+                     Y := 0;
+                END IF;
+           END PROK;
+      END PACK2;
+ 
+ BEGIN
+      TEST ("C84005A", "CHECK THAT TWO POTENTIALLY VISIBLE HOMOGRAPHS " &
+                       "OF A SUBPROGRAM IDENTIFIER CAN BE MADE " &
+                       "DIRECTLY VISIBLE BY A USE CLAUSE, AND THAT " &
+                       "WHEN DIFFERENT FORMAL PARAMETER NAMES ARE " &
+                       "USED, THE SUBPROGRAMS ARE REFERENCED CORRECTLY");
+ 
+      IF FUNK(A => 3) /= IDENT_INT(1) THEN
+           FAILED("PACK1.FUNK RETURNS INCORRECT RESULT");
+      END IF;
+ 
+      IF FUNK(X => 3) /= IDENT_INT(2) THEN
+           FAILED("PACK2.FUNK RETURNS INCORRECT RESULT");
+      END IF;
+ 
+      PROK(A => 3, B => VAR1);
+      PROK(X => 3, Y => VAR2);
+ 
+      IF VAR1 /= IDENT_INT(1) THEN
+           FAILED("PACK1.PROK RETURNS INCORRECT RESULT");
+      END IF;
+ 
+      IF VAR2 /= IDENT_INT(2) THEN
+           FAILED("PACK2.PROK RETURNS INCORRECT RESULT");
+      END IF;
+ 
+      RESULT;
+ END C84005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C84008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE NAMES MADE VISIBLE BY A USE CLAUSE IN THE VISIBLE
+ --     PART OF A PACKAGE ARE VISIBLE IN THE PRIVATE PART AND BODY OF
+ --     THE PACKAGE.
+ 
+ -- HISTORY:
+ --     JET 03/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C84008A IS
+ 
+      PACKAGE PACK1 IS
+           TYPE A IS RANGE 0..100;
+           TYPE B IS RANGE -100..0;
+      END PACK1;
+ 
+      PACKAGE PACK2 IS
+           USE PACK1;
+           TYPE C IS PRIVATE;
+           PROCEDURE PROC (X : OUT A; Y : OUT B);
+      PRIVATE
+           TYPE C IS NEW A RANGE 0..9;
+      END PACK2;
+ 
+      VAR1 : PACK1.A;
+      VAR2 : PACK1.B;
+ 
+      PACKAGE BODY PACK2 IS
+           PROCEDURE PROC (X : OUT A; Y : OUT B) IS
+                SUBTYPE D IS B RANGE -9..0;
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     X := A'(2);
+                     Y := D'(-2);
+                ELSE
+                     X := A'(0);
+                     Y := D'(0);
+                END IF;
+           END PROC;
+      END PACK2;
+ 
+ BEGIN
+      TEST ("C84008A", "CHECK THAT THE NAMES MADE VISIBLE BY A USE " &
+                       "CLAUSE IN THE VISIBLE PART OF A PACKAGE ARE " &
+                       "VISIBLE IN THE PRIVATE PART AND BODY OF " &
+                       "THE PACKAGE");
+ 
+      PACK2.PROC (VAR1,VAR2);
+ 
+      IF PACK1."/=" (VAR1, 2) THEN
+           FAILED("INCORRECT RETURN VALUE FOR VAR1");
+      END IF;
+ 
+      IF PACK1."/=" (VAR2, PACK1."-"(2)) THEN
+           FAILED("INCORRECT RETURN VALUE FOR VAR2");
+      END IF;
+ 
+      RESULT;
+ END C84008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c84009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c84009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C84009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A USE CLAUSE MAKES AN IMPLICITLY OR EXPLICITLY
+ --     DECLARED OPERATOR DIRECTLY VISIBLE IF NO HOMOGRAPH OF THE
+ --     OPERATOR IS ALREADY DIRECTLY VISIBLE.
+ 
+ -- HISTORY:
+ --     JET 03/10/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C84009A IS
+ 
+      TYPE INT IS NEW INTEGER RANGE -100 .. 100;
+ 
+      PACKAGE PACK IS
+           FUNCTION "+" (LEFT : INTEGER; RIGHT : INT) RETURN INTEGER;
+           FUNCTION "-" (LEFT, RIGHT : INT) RETURN INT;
+           FUNCTION "-" (RIGHT : INT) RETURN INTEGER;
+           FUNCTION "+" (RIGHT : INT) RETURN INTEGER;
+      END PACK;
+ 
+      FUNCTION "+" (RIGHT : INT) RETURN INTEGER IS
+      BEGIN
+           RETURN INTEGER'(1) + INTEGER(RIGHT);
+      END "+";
+ 
+      PACKAGE BODY PACK IS
+           FUNCTION "+" (LEFT : INTEGER; RIGHT : INT) RETURN INTEGER IS
+           BEGIN
+                RETURN LEFT + INTEGER(RIGHT);
+           END "+";
+ 
+           FUNCTION "-" (LEFT, RIGHT : INT) RETURN INT IS
+           BEGIN
+                FAILED ("BINARY ""-"" ALREADY VISIBLE FOR TYPE INT");
+                RETURN LEFT + (-RIGHT);
+           END "-";
+ 
+           FUNCTION "-" (RIGHT : INT) RETURN INTEGER IS
+           BEGIN
+                RETURN INTEGER'(0) - INTEGER(RIGHT);
+           END "-";
+ 
+           FUNCTION "+" (RIGHT : INT) RETURN INTEGER IS
+           BEGIN
+                FAILED ("UNARY ""+"" ALREADY VISIBLE FOR TYPE INT");
+                RETURN INTEGER'(0) + INTEGER(RIGHT);
+           END "+";
+      END PACK;
+ 
+      USE PACK;
+ 
+ BEGIN
+      TEST ("C84009A", "CHECK THAT A USE CLAUSE MAKES AN IMPLICITLY " &
+                       "OR EXPLICITLY DECLARED OPERATOR DIRECTLY " &
+                       "VISIBLE IF NO HOMOGRAPH OF THE OPERATOR IS " &
+                       "ALREADY DIRECTLY VISIBLE");
+ 
+      IF INTEGER'(10) + INT'(10) /= IDENT_INT(20) THEN
+           FAILED ("INCORRECT RESULT FROM BINARY ""+""");
+      END IF;
+ 
+      IF INT'(5) - INT'(3) /= INT'(2) THEN
+           FAILED ("INCORRECT RESULT FROM BINARY ""-""");
+      END IF;
+ 
+      IF -INT'(20) /= IDENT_INT(-INTEGER'(20)) THEN
+           FAILED ("INCORRECT RESULT FROM UNARY ""-""");
+      END IF;
+ 
+      IF +INT'(20) /= IDENT_INT(+INTEGER'(21)) THEN
+           FAILED ("INCORRECT RESULT FROM UNARY ""+""");
+      END IF;
+ 
+      RESULT;
+ END C84009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85004b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85004b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85004b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C85004B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A RENAMED CONSTANT OBJECT, "IN" PARAMETER OF A
+ --     SUBPROGRAM OR ENTRY, "IN" FORMAL GENERIC, RECORD DISCRIMINANT,
+ --     LOOP PARAMETER, DEFERRED CONSTANT, OR RENAMED CONSTANT HAS THE
+ --     CORRECT VALUE.
+ 
+ -- HISTORY:
+ --     JET 07/25/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85004B IS
+ 
+      TYPE A IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      SUBTYPE P IS POSITIVE RANGE 1 .. 10;
+ 
+      C1 : CONSTANT INTEGER := 1;
+      X1 : INTEGER RENAMES C1;
+      X2 : INTEGER RENAMES X1;
+ 
+      TYPE REC (D : P := 1) IS
+           RECORD
+                I : A(1..D);
+           END RECORD;
+      TYPE ACCREC1 IS ACCESS REC;
+      TYPE ACCREC2 IS ACCESS REC(10);
+ 
+      R1 : REC;
+      R2 : REC(10);
+      AR1 : ACCREC1 := NEW REC;
+      AR2 : ACCREC2 := NEW REC(10);
+ 
+      X3 : P RENAMES R1.D;
+      X4 : P RENAMES R2.D;
+      X5 : P RENAMES AR1.D;
+      X6 : P RENAMES AR2.D;
+ 
+      C2 : CONSTANT A(1..3) := (1, 2, 3);
+      X7 : INTEGER RENAMES C2(1);
+ 
+      GENERIC
+           K1 : IN INTEGER;
+      PACKAGE GENPKG IS
+           TYPE K IS PRIVATE;
+           K2 : CONSTANT K;
+      PRIVATE
+           TYPE K IS RANGE 1..100;
+           K2 : CONSTANT K := 5;
+      END GENPKG;
+ 
+      TASK FOOEY IS
+           ENTRY ENT1 (I : IN INTEGER);
+      END FOOEY;
+ 
+      TASK BODY FOOEY IS
+      BEGIN
+           ACCEPT ENT1 (I : IN INTEGER) DO
+                DECLARE
+                     TX1 : INTEGER RENAMES I;
+                BEGIN
+                     IF TX1 /= IDENT_INT(2) THEN
+                          FAILED ("INCORRECT VALUE");
+                     END IF;
+                END;
+           END ENT1;
+      END FOOEY;
+ 
+      PACKAGE BODY GENPKG IS
+           KX1 : INTEGER RENAMES K1;
+           KX2 : K RENAMES K2;
+      BEGIN
+           IF KX1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF KX1");
+           END IF;
+ 
+           IF KX2 /= K(IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF KX2");
+           END IF;
+      END GENPKG;
+ 
+      PROCEDURE PROC (I : IN INTEGER) IS
+           PX1 : INTEGER RENAMES I;
+      BEGIN
+           IF PX1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF PX1");
+           END IF;
+      END PROC;
+ 
+      PACKAGE PKG IS NEW GENPKG(4);
+ 
+ BEGIN
+      TEST ("C85004B", "CHECK THAT A RENAMED CONSTANT OBJECT, 'IN' " &
+            "PARAMETER OF A SUBPROGRAM OR ENTRY, 'IN' FORMAL GENERIC, " &
+            "RECORD DISCRIMINANT, LOOP PARAMETER, DEFERRED CONSTANT, " &
+            "OR RENAMED CONSTANT HAS THE CORRECT VALUE");
+ 
+      FOOEY.ENT1(2);
+ 
+      PROC(3);
+ 
+      IF X1 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF X1");
+      END IF;
+ 
+      IF X2 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF X2");
+      END IF;
+ 
+      IF X3 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF X3");
+      END IF;
+ 
+      IF X4 /= IDENT_INT(10) THEN
+           FAILED ("INCORRECT VALUE OF X4");
+      END IF;
+ 
+      IF X5 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF X5");
+      END IF;
+ 
+      IF X6 /= IDENT_INT(10) THEN
+           FAILED ("INCORRECT VALUE OF X6");
+      END IF;
+ 
+      IF X7 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF X7");
+      END IF;
+ 
+      FOR I IN 1..IDENT_INT(2) LOOP
+           DECLARE
+                X8 : INTEGER RENAMES I;
+           BEGIN
+                IF X8 /= IDENT_INT(I) THEN
+                     FAILED ("INCORRECT VALUE OF X8");
+                END IF;
+           END;
+      END LOOP;
+ 
+      RESULT;
+ 
+ END C85004B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,391 ----
+ -- C85005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A VARIABLE CREATED BY AN OBJECT DECLARATION CAN BE
+ --     RENAMED AND HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN
+ --     BE USED IN AN ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL
+ --     SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN
+ --     ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF
+ --     THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED
+ --     BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85005A IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           K1 : INTEGER := 0;
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      TASK TYPE TASK2 IS
+           ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                         TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                         TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
+                         TK1 : IN OUT INTEGER);
+      END TASK2;
+ 
+      I1 : INTEGER := 0;
+      A1 : ARRAY1(1..3) := (OTHERS => 0);
+      R1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+      P1 : POINTER1 := NEW INTEGER'(0);
+      V1 : PACK1.PRIVY := PACK1.ZERO;
+      T1 : TASK1;
+ 
+      XI1 : INTEGER RENAMES I1;
+      XA1 : ARRAY1 RENAMES A1;
+      XR1 : RECORD1 RENAMES R1;
+      XP1 : POINTER1 RENAMES P1;
+      XV1 : PACK1.PRIVY RENAMES V1;
+      XT1 : TASK1 RENAMES T1;
+      XK1 : INTEGER RENAMES PACK1.K1;
+ 
+      I : INTEGER;
+      CHK_TASK : TASK2;
+ 
+      GENERIC
+           GI1 : IN OUT INTEGER;
+           GA1 : IN OUT ARRAY1;
+           GR1 : IN OUT RECORD1;
+           GP1 : IN OUT POINTER1;
+           GV1 : IN OUT PACK1.PRIVY;
+           GT1 : IN OUT TASK1;
+           GK1 : IN OUT INTEGER;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                       PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
+                       PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
+                       PK1 : OUT INTEGER) IS
+ 
+      BEGIN
+           PI1 := PI1 + 1;
+           PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+           PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+           PP1 := NEW INTEGER'(P1.ALL + 1);
+           PV1 := PACK1.NEXT(V1);
+           PT1.NEXT;
+           PK1 := PACK1.K1 + 1;
+      END PROC1;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GI1 := GI1 + 1;
+           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+           GR1 := (D => 1, FIELD1 => GR1.FIELD1+1);
+           GP1 := NEW INTEGER'(GP1.ALL + 1);
+           GV1 := PACK1.NEXT(GV1);
+           GT1.NEXT;
+           GK1 := GK1 + 1;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+      TASK BODY TASK2 IS
+      BEGIN
+           ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                          TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                          TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
+                          TK1 : IN OUT INTEGER) DO
+ 
+                TI1 := I1 + 1;
+                TA1 := (A1(1)+1, A1(2)+1, A1(3)+1);
+                TR1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
+                TP1 := NEW INTEGER'(TP1.ALL + 1);
+                TV1 := PACK1.NEXT(TV1);
+                TT1.NEXT;
+                TK1 := TK1 + 1;
+           END ENTRY1;
+      END TASK2;
+ 
+ BEGIN
+      TEST ("C85005A", "CHECK THAT A VARIABLE CREATED BY AN OBJECT " &
+                       "DECLARATION CAN BE RENAMED AND HAS THE " &
+                       "CORRECT VALUE, AND THAT THE NEW NAME CAN " &
+                       "BE USED IN AN ASSIGNMENT STATEMENT " &
+                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                       "VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           PACKAGE GENPACK1 IS NEW
+                GENERIC1 (XI1, XA1, XR1, XP1, XV1, XT1, XK1);
+      BEGIN
+           NULL;
+      END;
+ 
+      IF XI1 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF XI1 (1)");
+      END IF;
+ 
+      IF XA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+           FAILED ("INCORRECT VALUE OF XA1 (1)");
+      END IF;
+ 
+      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+           FAILED ("INCORRECT VALUE OF XR1 (1)");
+      END IF;
+ 
+      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF XP1 (1)");
+      END IF;
+ 
+      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.ONE)) THEN
+           FAILED ("INCORRECT VALUE OF XV1 (1)");
+      END IF;
+ 
+      XT1.VALU(I);
+      IF I /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (1)");
+      END IF;
+ 
+      IF XK1 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF XK1 (1)");
+      END IF;
+ 
+      PROC1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
+ 
+      IF XI1 /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE OF XI1 (2)");
+      END IF;
+ 
+      IF XA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+           FAILED ("INCORRECT VALUE OF XA1 (2)");
+      END IF;
+ 
+      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+           FAILED ("INCORRECT VALUE OF XR1 (2)");
+      END IF;
+ 
+      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE OF XP1 (2)");
+      END IF;
+ 
+      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.TWO)) THEN
+           FAILED ("INCORRECT VALUE OF XV1 (2)");
+      END IF;
+ 
+      XT1.VALU(I);
+      IF I /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT RETURN VALUE FROM XT1.VALU (2)");
+      END IF;
+ 
+      IF XK1 /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE OF XK1 (2)");
+      END IF;
+ 
+      CHK_TASK.ENTRY1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
+ 
+      IF XI1 /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE OF XI1 (3)");
+      END IF;
+ 
+      IF XA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+           FAILED ("INCORRECT VALUE OF XA1 (3)");
+      END IF;
+ 
+      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+           FAILED ("INCORRECT VALUE OF XR1 (3)");
+      END IF;
+ 
+      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE OF XP1 (3)");
+      END IF;
+ 
+      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.THREE)) THEN
+           FAILED ("INCORRECT VALUE OF XV1 (3)");
+      END IF;
+ 
+      XT1.VALU(I);
+      IF I /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (3)");
+      END IF;
+ 
+      IF XK1 /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE OF XK1 (3)");
+      END IF;
+ 
+      XI1 := XI1 + 1;
+      XA1 := (XA1(1)+1, XA1(2)+1, XA1(3)+1);
+      XR1 := (D => 1, FIELD1 => XR1.FIELD1 + 1);
+      XP1 := NEW INTEGER'(XP1.ALL + 1);
+      XV1 := PACK1.NEXT(XV1);
+      XT1.NEXT;
+      XK1 := XK1 + 1;
+ 
+      IF XI1 /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE OF XI1 (4)");
+      END IF;
+ 
+      IF XA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+           FAILED ("INCORRECT VALUE OF XA1 (4)");
+      END IF;
+ 
+      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+           FAILED ("INCORRECT VALUE OF XR1 (4)");
+      END IF;
+ 
+      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE OF XP1 (4)");
+      END IF;
+ 
+      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FOUR)) THEN
+           FAILED ("INCORRECT VALUE OF XV1 (4)");
+      END IF;
+ 
+      XT1.VALU(I);
+      IF I /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (4)");
+      END IF;
+ 
+      IF XK1 /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE OF XK1 (4)");
+      END IF;
+ 
+      I1 := I1 + 1;
+      A1 := (A1(1)+1, A1(2)+1, A1(3)+1);
+      R1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
+      P1 := NEW INTEGER'(P1.ALL + 1);
+      V1 := PACK1.NEXT(V1);
+      T1.NEXT;
+      PACK1.K1 := PACK1.K1 + 1;
+ 
+      IF XI1 /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT VALUE OF XI1 (5)");
+      END IF;
+ 
+      IF XA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+           FAILED ("INCORRECT VALUE OF XA1 (5)");
+      END IF;
+ 
+      IF XR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+           FAILED ("INCORRECT VALUE OF XR1 (5)");
+      END IF;
+ 
+      IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT VALUE OF XP1 (5)");
+      END IF;
+ 
+      IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FIVE)) THEN
+           FAILED ("INCORRECT VALUE OF XV1 (5)");
+      END IF;
+ 
+      XT1.VALU(I);
+      IF I /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (5)");
+      END IF;
+ 
+      IF XK1 /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT VALUE OF XK1 (5)");
+      END IF;
+ 
+      T1.STOP;
+ 
+      RESULT;
+ END C85005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,366 ----
+ -- C85005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM 'IN OUT' FORMAL
+ --     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
+ --     THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
+ --     ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
+ --     AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
+ --     VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
+ --     REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85005B IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      DI1 : INTEGER := 0;
+      DA1 : ARRAY1(1..3) := (OTHERS => 0);
+      DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+      DP1 : POINTER1 := NEW INTEGER'(0);
+      DV1 : PACK1.PRIVY := PACK1.ZERO;
+      DT1 : TASK1;
+ 
+      I : INTEGER;
+ 
+      GENERIC
+           GI1 : IN OUT INTEGER;
+           GA1 : IN OUT ARRAY1;
+           GR1 : IN OUT RECORD1;
+           GP1 : IN OUT POINTER1;
+           GV1 : IN OUT PACK1.PRIVY;
+           GT1 : IN OUT TASK1;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GI1 := GI1 + 1;
+           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+           GP1 := NEW INTEGER'(GP1.ALL + 1);
+           GV1 := PACK1.NEXT(GV1);
+           GT1.NEXT;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+      PROCEDURE PROC (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                      PR1 : IN OUT RECORD1; PP1 : IN OUT POINTER1;
+                      PV1 : IN OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
+           XPI1 : INTEGER RENAMES PI1;
+           XPA1 : ARRAY1 RENAMES PA1;
+           XPR1 : RECORD1 RENAMES PR1;
+           XPP1 : POINTER1 RENAMES PP1;
+           XPV1 : PACK1.PRIVY RENAMES PV1;
+           XPT1 : TASK1 RENAMES PT1;
+ 
+           TASK TYPE TASK2 IS
+                ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                              TV1 : IN OUT PACK1.PRIVY;
+                              TT1 : IN OUT TASK1);
+           END TASK2;
+ 
+           CHK_TASK : TASK2;
+ 
+           PROCEDURE PROC1 (PPI1 : IN OUT INTEGER; PPA1 : IN OUT ARRAY1;
+                            PPR1 : IN OUT RECORD1; PPP1 : OUT POINTER1;
+                            PPV1 : OUT PACK1.PRIVY;
+                            PPT1 : IN OUT TASK1) IS
+           BEGIN
+                PPI1 := PPI1 + 1;
+                PPA1 := (PPA1(1)+1, PPA1(2)+1, PPA1(3)+1);
+                PPR1 := (D => 1, FIELD1 => PPR1.FIELD1 + 1);
+                PPP1 := NEW INTEGER'(PP1.ALL + 1);
+                PPV1 := PACK1.NEXT(PV1);
+                PPT1.NEXT;
+           END PROC1;
+ 
+           TASK BODY TASK2 IS
+           BEGIN
+                ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                               TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                               TV1 : IN OUT PACK1.PRIVY;
+                               TT1 : IN OUT TASK1)
+                DO
+                     TI1 := PI1 + 1;
+                     TA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+                     TR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+                     TP1 := NEW INTEGER'(TP1.ALL + 1);
+                     TV1 := PACK1.NEXT(TV1);
+                     TT1.NEXT;
+                END ENTRY1;
+           END TASK2;
+ 
+           PACKAGE GENPACK1 IS NEW GENERIC1
+                (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
+ 
+      BEGIN
+           IF XPI1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XPI1 (1)");
+           END IF;
+ 
+           IF XPA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XPA1 (1)");
+           END IF;
+ 
+           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XPR1 (1)");
+           END IF;
+ 
+           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XPP1 (1)");
+           END IF;
+ 
+           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.ONE)) THEN
+                FAILED ("INCORRECT VALUE OF XPV1 (1)");
+           END IF;
+ 
+           XPT1.VALU(I);
+           IF I /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (1)");
+           END IF;
+ 
+           PROC1(XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
+ 
+           IF XPI1 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XPI1 (2)");
+           END IF;
+ 
+           IF XPA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XPA1 (2)");
+           END IF;
+ 
+           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XPR1 (2)");
+           END IF;
+ 
+           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XPP1 (2)");
+           END IF;
+ 
+           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.TWO)) THEN
+                FAILED ("INCORRECT VALUE OF XPV1 (2)");
+           END IF;
+ 
+           XPT1.VALU(I);
+           IF I /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XPT1.VALU (2)");
+           END IF;
+ 
+           CHK_TASK.ENTRY1 (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
+ 
+           IF XPI1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XPI1 (3)");
+           END IF;
+ 
+           IF XPA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XPA1 (3)");
+           END IF;
+ 
+           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XPR1 (3)");
+           END IF;
+ 
+           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XPP1 (3)");
+           END IF;
+ 
+           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.THREE)) THEN
+                FAILED ("INCORRECT VALUE OF XPV1 (3)");
+           END IF;
+ 
+           XPT1.VALU(I);
+           IF I /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (3)");
+           END IF;
+ 
+           XPI1 := XPI1 + 1;
+           XPA1 := (XPA1(1)+1, XPA1(2)+1, XPA1(3)+1);
+           XPR1 := (D => 1, FIELD1 => XPR1.FIELD1 + 1);
+           XPP1 := NEW INTEGER'(XPP1.ALL + 1);
+           XPV1 := PACK1.NEXT(XPV1);
+           XPT1.NEXT;
+ 
+           IF XPI1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XPI1 (4)");
+           END IF;
+ 
+           IF XPA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XPA1 (4)");
+           END IF;
+ 
+           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XPR1 (4)");
+           END IF;
+ 
+           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XPP1 (4)");
+           END IF;
+ 
+           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FOUR)) THEN
+                FAILED ("INCORRECT VALUE OF XPV1 (4)");
+           END IF;
+ 
+           XPT1.VALU(I);
+           IF I /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (4)");
+           END IF;
+ 
+           PI1 := PI1 + 1;
+           PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+           PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+           PP1 := NEW INTEGER'(PP1.ALL + 1);
+           PV1 := PACK1.NEXT(PV1);
+           PT1.NEXT;
+ 
+           IF XPI1 /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XPI1 (5)");
+           END IF;
+ 
+           IF XPA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XPA1 (5)");
+           END IF;
+ 
+           IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XPR1 (5)");
+           END IF;
+ 
+           IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XPP1 (5)");
+           END IF;
+ 
+           IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FIVE)) THEN
+                FAILED ("INCORRECT VALUE OF XPV1 (5)");
+           END IF;
+ 
+           XPT1.VALU(I);
+           IF I /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (5)");
+           END IF;
+      END PROC;
+ 
+ BEGIN
+      TEST ("C85005B", "CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM " &
+                       "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
+                       "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
+                       "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
+                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                       "VALUE OF THE NEW NAME");
+ 
+      PROC (DI1, DA1, DR1, DP1, DV1, DT1);
+ 
+      DT1.STOP;
+ 
+      RESULT;
+ END C85005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,416 ----
+ -- C85005C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A VARIABLE CREATED BY AN ENTRY 'IN OUT' FORMAL
+ --     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
+ --     THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
+ --     ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
+ --     AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
+ --     VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
+ --     REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85005C IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      DI1 : INTEGER := 0;
+      DA1 : ARRAY1(1..3) := (OTHERS => 0);
+      DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+      DP1 : POINTER1 := NEW INTEGER'(0);
+      DV1 : PACK1.PRIVY := PACK1.ZERO;
+      DT1 : TASK1;
+ 
+      I : INTEGER;
+ 
+      GENERIC
+           GI1 : IN OUT INTEGER;
+           GA1 : IN OUT ARRAY1;
+           GR1 : IN OUT RECORD1;
+           GP1 : IN OUT POINTER1;
+           GV1 : IN OUT PACK1.PRIVY;
+           GT1 : IN OUT TASK1;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GI1 := GI1 + 1;
+           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+           GP1 := NEW INTEGER'(GP1.ALL + 1);
+           GV1 := PACK1.NEXT(GV1);
+           GT1.NEXT;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+ BEGIN
+      TEST ("C85005C", "CHECK THAT A VARIABLE CREATED BY AN ENTRY " &
+                       "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
+                       "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
+                       "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
+                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                       "VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           TASK MAIN_TASK IS
+                ENTRY START (TI1 : IN OUT INTEGER; TA1 : IN OUT ARRAY1;
+                             TR1 : IN OUT RECORD1; TP1 : IN OUT POINTER1;
+                             TV1 : IN OUT PACK1.PRIVY;
+                             TT1 : IN OUT TASK1);
+           END MAIN_TASK;
+ 
+           TASK BODY MAIN_TASK IS
+           BEGIN
+                ACCEPT START (TI1: IN OUT INTEGER; TA1: IN OUT ARRAY1;
+                              TR1: IN OUT RECORD1; TP1: IN OUT POINTER1;
+                              TV1: IN OUT PACK1.PRIVY;
+                              TT1: IN OUT TASK1) DO
+                     DECLARE
+                          XTI1 : INTEGER RENAMES TI1;
+                          XTA1 : ARRAY1 RENAMES TA1;
+                          XTR1 : RECORD1 RENAMES TR1;
+                          XTP1 : POINTER1 RENAMES TP1;
+                          XTV1 : PACK1.PRIVY RENAMES TV1;
+                          XTT1 : TASK1 RENAMES TT1;
+ 
+                          TASK TYPE TASK2 IS
+                               ENTRY ENTRY1 (TTI1 : OUT INTEGER;
+                                             TTA1 : OUT ARRAY1;
+                                             TTR1 : OUT RECORD1;
+                                             TTP1 : IN OUT POINTER1;
+                                             TTV1 : IN OUT PACK1.PRIVY;
+                                             TTT1 : IN OUT TASK1);
+                          END TASK2;
+ 
+                          CHK_TASK : TASK2;
+ 
+                          PROCEDURE PROC1 (PTI1 : IN OUT INTEGER;
+                                           PTA1 : IN OUT ARRAY1;
+                                           PTR1 : IN OUT RECORD1;
+                                           PTP1 : OUT POINTER1;
+                                           PTV1 : OUT PACK1.PRIVY;
+                                           PTT1 : IN OUT TASK1) IS
+                          BEGIN
+                               PTI1 := PTI1 + 1;
+                               PTA1 := (PTA1(1)+1, PTA1(2)+1, PTA1(3)+1);
+                               PTR1 := (D => 1,
+                                        FIELD1 => PTR1.FIELD1 + 1);
+                               PTP1 := NEW INTEGER'(TP1.ALL + 1);
+                               PTV1 := PACK1.NEXT(TV1);
+                               PTT1.NEXT;
+                          END PROC1;
+ 
+                          TASK BODY TASK2 IS
+                          BEGIN
+                               ACCEPT ENTRY1 (TTI1 : OUT INTEGER;
+                                              TTA1 : OUT ARRAY1;
+                                              TTR1 : OUT RECORD1;
+                                              TTP1 : IN OUT POINTER1;
+                                              TTV1 : IN OUT PACK1.PRIVY;
+                                              TTT1 : IN OUT TASK1)
+                               DO
+                                    TTI1 := TI1 + 1;
+                                    TTA1 := (TA1(1)+1,
+                                    TA1(2)+1, TA1(3)+1);
+                                    TTR1 := (D => 1,
+                                             FIELD1 => TR1.FIELD1 + 1);
+                                    TTP1 := NEW INTEGER'(TTP1.ALL + 1);
+                                    TTV1 := PACK1.NEXT(TTV1);
+                                    TTT1.NEXT;
+                               END ENTRY1;
+                          END TASK2;
+ 
+                          PACKAGE GENPACK1 IS NEW GENERIC1
+                               (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
+                     BEGIN
+                          IF XTI1 /= IDENT_INT(1) THEN
+                               FAILED ("INCORRECT VALUE OF XTI1 (1)");
+                          END IF;
+ 
+                          IF XTA1 /= (IDENT_INT(1),IDENT_INT(1),
+                                      IDENT_INT(1)) THEN
+                               FAILED ("INCORRECT VALUE OF XTA1 (1)");
+                          END IF;
+ 
+                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(1))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTR1 (1)");
+                          END IF;
+ 
+                          IF XTP1 /= IDENT(TP1) OR
+                             XTP1.ALL /= IDENT_INT(1) THEN
+                               FAILED ("INCORRECT VALUE OF XTP1 (1)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.ONE))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTV1 (1)");
+                          END IF;
+ 
+                          XTT1.VALU(I);
+                          IF I /= IDENT_INT(1) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XTT1.VALU (1)");
+                          END IF;
+ 
+                          PROC1(XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
+ 
+                          IF XTI1 /= IDENT_INT(2) THEN
+                               FAILED ("INCORRECT VALUE OF XTI1 (2)");
+                          END IF;
+ 
+                          IF XTA1 /= (IDENT_INT(2),IDENT_INT(2),
+                                      IDENT_INT(2)) THEN
+                               FAILED ("INCORRECT VALUE OF XTA1 (2)");
+                          END IF;
+ 
+                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(2))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTR1 (2)");
+                          END IF;
+ 
+                          IF XTP1 /= IDENT(TP1) OR
+                             XTP1.ALL /= IDENT_INT(2) THEN
+                               FAILED ("INCORRECT VALUE OF XTP1 (2)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.TWO))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTV1 (2)");
+                          END IF;
+ 
+                          XTT1.VALU(I);
+                          IF I /= IDENT_INT(2) THEN
+                               FAILED ("INCORRECT RETURN VALUE FROM " &
+                                       "XTT1.VALU (2)");
+                          END IF;
+ 
+                          CHK_TASK.ENTRY1
+                               (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
+ 
+                          IF XTI1 /= IDENT_INT(3) THEN
+                               FAILED ("INCORRECT VALUE OF XTI1 (3)");
+                          END IF;
+ 
+                          IF XTA1 /= (IDENT_INT(3),IDENT_INT(3),
+                                      IDENT_INT(3)) THEN
+                               FAILED ("INCORRECT VALUE OF XTA1 (3)");
+                          END IF;
+ 
+                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(3))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTR1 (3)");
+                          END IF;
+ 
+                          IF XTP1 /= IDENT(TP1) OR
+                             XTP1.ALL /= IDENT_INT(3) THEN
+                               FAILED ("INCORRECT VALUE OF XTP1 (3)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.THREE))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTV1 (3)");
+                          END IF;
+ 
+                          XTT1.VALU(I);
+                          IF I /= IDENT_INT(3) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XTT1.VALU (3)");
+                          END IF;
+ 
+                          XTI1 := XTI1 + 1;
+                          XTA1 := (XTA1(1)+1, XTA1(2)+1, XTA1(3)+1);
+                          XTR1 := (D => 1, FIELD1 => XTR1.FIELD1 + 1);
+                          XTP1 := NEW INTEGER'(XTP1.ALL + 1);
+                          XTV1 := PACK1.NEXT(XTV1);
+                          XTT1.NEXT;
+ 
+                          IF XTI1 /= IDENT_INT(4) THEN
+                               FAILED ("INCORRECT VALUE OF XTI1 (4)");
+                          END IF;
+ 
+                          IF XTA1 /= (IDENT_INT(4),IDENT_INT(4),
+                                      IDENT_INT(4)) THEN
+                               FAILED ("INCORRECT VALUE OF XTA1 (4)");
+                          END IF;
+ 
+                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(4))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTR1 (4)");
+                          END IF;
+ 
+                          IF XTP1 /= IDENT(TP1) OR
+                             XTP1.ALL /= IDENT_INT(4) THEN
+                               FAILED ("INCORRECT VALUE OF XTP1 (4)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FOUR))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTV1 (4)");
+                          END IF;
+ 
+                          XTT1.VALU(I);
+                          IF I /= IDENT_INT(4) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XTT1.VALU (4)");
+                          END IF;
+ 
+                          TI1 := TI1 + 1;
+                          TA1 := (TA1(1)+1, TA1(2)+1, TA1(3)+1);
+                          TR1 := (D => 1, FIELD1 => TR1.FIELD1 + 1);
+                          TP1 := NEW INTEGER'(TP1.ALL + 1);
+                          TV1 := PACK1.NEXT(TV1);
+                          TT1.NEXT;
+ 
+                          IF XTI1 /= IDENT_INT(5) THEN
+                               FAILED ("INCORRECT VALUE OF XTI1 (5)");
+                          END IF;
+ 
+                          IF XTA1 /= (IDENT_INT(5),IDENT_INT(5),
+                                      IDENT_INT(5)) THEN
+                               FAILED ("INCORRECT VALUE OF XTA1 (5)");
+                          END IF;
+ 
+                          IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(5))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTR1 (5)");
+                          END IF;
+ 
+                          IF XTP1 /= IDENT(TP1) OR
+                             XTP1.ALL /= IDENT_INT(5) THEN
+                               FAILED ("INCORRECT VALUE OF XTP1 (5)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FIVE))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XTV1 (5)");
+                          END IF;
+ 
+                          XTT1.VALU(I);
+                          IF I /= IDENT_INT(5) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XTT1.VALU (5)");
+                          END IF;
+                     END;
+                END START;
+           END MAIN_TASK;
+ 
+      BEGIN
+           MAIN_TASK.START (DI1, DA1, DR1, DP1, DV1, DT1);
+      END;
+ 
+      DT1.STOP;
+ 
+      RESULT;
+ END C85005C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,378 ----
+ -- C85005D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A VARIABLE CREATED BY A GENERIC 'IN OUT' FORMAL
+ --     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND
+ --     THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND
+ --     PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
+ --     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+ --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+ --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85005D IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      DI1 : INTEGER := 0;
+      DA1 : ARRAY1(1..3) := (OTHERS => 0);
+      DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+      DP1 : POINTER1 := NEW INTEGER'(0);
+      DV1 : PACK1.PRIVY := PACK1.ZERO;
+      DT1 : TASK1;
+ 
+      I : INTEGER;
+ 
+      GENERIC
+           GI1 : IN OUT INTEGER;
+           GA1 : IN OUT ARRAY1;
+           GR1 : IN OUT RECORD1;
+           GP1 : IN OUT POINTER1;
+           GV1 : IN OUT PACK1.PRIVY;
+           GT1 : IN OUT TASK1;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+           XGI1 : INTEGER RENAMES GI1;
+           XGA1 : ARRAY1 RENAMES GA1;
+           XGR1 : RECORD1 RENAMES GR1;
+           XGP1 : POINTER1 RENAMES GP1;
+           XGV1 : PACK1.PRIVY RENAMES GV1;
+           XGT1 : TASK1 RENAMES GT1;
+ 
+           TASK TYPE TASK2 IS
+                ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                              TV1 : IN OUT PACK1.PRIVY;
+                              TT1 : IN OUT TASK1);
+           END TASK2;
+ 
+           G_CHK_TASK : TASK2;
+ 
+           GENERIC
+                GGI1 : IN OUT INTEGER;
+                GGA1 : IN OUT ARRAY1;
+                GGR1 : IN OUT RECORD1;
+                GGP1 : IN OUT POINTER1;
+                GGV1 : IN OUT PACK1.PRIVY;
+                GGT1 : IN OUT TASK1;
+           PACKAGE GENERIC2 IS
+           END GENERIC2;
+ 
+           PACKAGE BODY GENERIC2 IS
+           BEGIN
+                GGI1 := GGI1 + 1;
+                GGA1 := (GGA1(1)+1, GGA1(2)+1, GGA1(3)+1);
+                GGR1 := (D => 1, FIELD1 => GGR1.FIELD1 + 1);
+                GGP1 := NEW INTEGER'(GGP1.ALL + 1);
+                GGV1 := PACK1.NEXT(GGV1);
+                GGT1.NEXT;
+           END GENERIC2;
+ 
+           TASK BODY TASK2 IS
+           BEGIN
+                ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                               TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                               TV1 : IN OUT PACK1.PRIVY;
+                               TT1 : IN OUT TASK1)
+                DO
+                     TI1 := GI1 + 1;
+                     TA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+                     TR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+                     TP1 := NEW INTEGER'(TP1.ALL + 1);
+                     TV1 := PACK1.NEXT(TV1);
+                     TT1.NEXT;
+                END ENTRY1;
+           END TASK2;
+ 
+           PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                            PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
+                            PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
+           BEGIN
+                PI1 := PI1 + 1;
+                PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+                PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+                PP1 := NEW INTEGER'(GP1.ALL + 1);
+                PV1 := PACK1.NEXT(GV1);
+                PT1.NEXT;
+           END PROC1;
+ 
+           PACKAGE GENPACK2 IS NEW GENERIC2
+                (XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
+ 
+      BEGIN
+           IF XGI1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XGI1 (1)");
+           END IF;
+ 
+           IF XGA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XGA1 (1)");
+           END IF;
+ 
+           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XGR1 (1)");
+           END IF;
+ 
+           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XGP1 (1)");
+           END IF;
+ 
+           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.ONE)) THEN
+                FAILED ("INCORRECT VALUE OF XGV1 (1)");
+           END IF;
+ 
+           XGT1.VALU(I);
+           IF I /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (1)");
+           END IF;
+ 
+           PROC1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
+ 
+           IF XGI1 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XGI1 (2)");
+           END IF;
+ 
+           IF XGA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XGA1 (2)");
+           END IF;
+ 
+           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XGR1 (2)");
+           END IF;
+ 
+           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XGP1 (2)");
+           END IF;
+ 
+           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.TWO)) THEN
+                FAILED ("INCORRECT VALUE OF XGV1 (2)");
+           END IF;
+ 
+           XGT1.VALU(I);
+           IF I /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (2)");
+           END IF;
+ 
+           G_CHK_TASK.ENTRY1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
+ 
+           IF XGI1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XGI1 (3)");
+           END IF;
+ 
+           IF XGA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XGA1 (3)");
+           END IF;
+ 
+           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XGR1 (3)");
+           END IF;
+ 
+           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XGP1 (3)");
+           END IF;
+ 
+           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.THREE)) THEN
+                FAILED ("INCORRECT VALUE OF XGV1 (3)");
+           END IF;
+ 
+           XGT1.VALU(I);
+           IF I /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (3)");
+           END IF;
+ 
+           XGI1 := XGI1 + 1;
+           XGA1 := (XGA1(1)+1, XGA1(2)+1, XGA1(3)+1);
+           XGR1 := (D => 1, FIELD1 => XGR1.FIELD1 + 1);
+           XGP1 := NEW INTEGER'(XGP1.ALL + 1);
+           XGV1 := PACK1.NEXT(XGV1);
+           XGT1.NEXT;
+ 
+           IF XGI1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XGI1 (4)");
+           END IF;
+ 
+           IF XGA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XGA1 (4)");
+           END IF;
+ 
+           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XGR1 (4)");
+           END IF;
+ 
+           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XGP1 (4)");
+           END IF;
+ 
+           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FOUR)) THEN
+                FAILED ("INCORRECT VALUE OF XGV1 (4)");
+           END IF;
+ 
+           XGT1.VALU(I);
+           IF I /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (4)");
+           END IF;
+ 
+           GI1 := GI1 + 1;
+           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+           GP1 := NEW INTEGER'(GP1.ALL + 1);
+           GV1 := PACK1.NEXT(GV1);
+           GT1.NEXT;
+ 
+           IF XGI1 /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XGI1 (5)");
+           END IF;
+ 
+           IF XGA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XGA1 (5)");
+           END IF;
+ 
+           IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XGR1 (5)");
+           END IF;
+ 
+           IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XGP1 (5)");
+           END IF;
+ 
+           IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FIVE)) THEN
+                FAILED ("INCORRECT VALUE OF XGV1 (5)");
+           END IF;
+ 
+           XGT1.VALU(I);
+           IF I /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (5)");
+           END IF;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+ BEGIN
+      TEST ("C85005D", "CHECK THAT A VARIABLE CREATED BY A GENERIC " &
+                       "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
+                       "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
+                       "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
+                       "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                       "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                       "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                       "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                       "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                       "VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           PACKAGE GENPACK1 IS NEW
+                GENERIC1 (DI1, DA1, DR1, DP1, DV1, DT1);
+      BEGIN
+           NULL;
+      END;
+ 
+      DT1.STOP;
+ 
+      RESULT;
+ END C85005D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,397 ----
+ -- C85005E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR CAN BE RENAMED AND
+ --     HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN
+ --     ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR
+ --     ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC
+ --     'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED
+ --     VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF
+ --     THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85005E IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PACKACC IS ACCESS INTEGER;
+           AK1 : PACKACC := NEW INTEGER'(0);
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      GENERIC
+           GI1 : IN OUT INTEGER;
+           GA1 : IN OUT ARRAY1;
+           GR1 : IN OUT RECORD1;
+           GP1 : IN OUT POINTER1;
+           GV1 : IN OUT PACK1.PRIVY;
+           GT1 : IN OUT TASK1;
+           GK1 : IN OUT INTEGER;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GI1 := GI1 + 1;
+           GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+           GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+           GP1 := NEW INTEGER'(GP1.ALL + 1);
+           GV1 := PACK1.NEXT(GV1);
+           GT1.NEXT;
+           GK1 := GK1 + 1;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+ BEGIN
+      TEST ("C85005E", "CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR " &
+                       "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
+                       "THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT" &
+                       " STATEMENT AND PASSED ON AS AN ACTUAL " &
+                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE " &
+                       "IS REFLECTED BY THE VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           TYPE ACCINT IS ACCESS INTEGER;
+           TYPE ACCARR IS ACCESS ARRAY1;
+           TYPE ACCREC IS ACCESS RECORD1;
+           TYPE ACCPTR IS ACCESS POINTER1;
+           TYPE ACCPVT IS ACCESS PACK1.PRIVY;
+           TYPE ACCTSK IS ACCESS TASK1;
+ 
+           AI1 : ACCINT := NEW INTEGER'(0);
+           AA1 : ACCARR := NEW ARRAY1'(0, 0, 0);
+           AR1 : ACCREC := NEW RECORD1'(D => 1, FIELD1 => 0);
+           AP1 : ACCPTR := NEW POINTER1'(NEW INTEGER'(0));
+           AV1 : ACCPVT := NEW PACK1.PRIVY'(PACK1.ZERO);
+           AT1 : ACCTSK := NEW TASK1;
+ 
+           XAI1 : INTEGER RENAMES AI1.ALL;
+           XAA1 : ARRAY1 RENAMES AA1.ALL;
+           XAR1 : RECORD1 RENAMES AR1.ALL;
+           XAP1 : POINTER1 RENAMES AP1.ALL;
+           XAV1 : PACK1.PRIVY RENAMES AV1.ALL;
+           XAK1 : INTEGER RENAMES PACK1.AK1.ALL;
+           XAT1 : TASK1 RENAMES AT1.ALL;
+ 
+           TASK TYPE TASK2 IS
+                ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                              TV1 : IN OUT PACK1.PRIVY;
+                              TT1 : IN OUT TASK1; TK1 : IN OUT INTEGER);
+           END TASK2;
+ 
+           I : INTEGER;
+           A_CHK_TASK : TASK2;
+ 
+           PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                            PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
+                            PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
+                            PK1 : OUT INTEGER) IS
+ 
+           BEGIN
+                PI1 := PI1 + 1;
+                PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+                PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+                PP1 := NEW INTEGER'(AP1.ALL.ALL + 1);
+                PV1 := PACK1.NEXT(AV1.ALL);
+                PT1.NEXT;
+                PK1 := PACK1.AK1.ALL + 1;
+           END PROC1;
+ 
+           TASK BODY TASK2 IS
+           BEGIN
+                ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                               TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                               TV1 : IN OUT PACK1.PRIVY;
+                               TT1 : IN OUT TASK1;
+                               TK1 : IN OUT INTEGER) DO
+                     TI1 := AI1.ALL + 1;
+                     TA1 := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
+                     TR1 := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
+                     TP1 := NEW INTEGER'(TP1.ALL + 1);
+                     TV1 := PACK1.NEXT(TV1);
+                     TT1.NEXT;
+                     TK1 := TK1 + 1;
+                END ENTRY1;
+           END TASK2;
+ 
+           PACKAGE GENPACK2 IS NEW
+                GENERIC1 (XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
+ 
+      BEGIN
+           IF XAI1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XAI1 (1)");
+           END IF;
+ 
+           IF XAA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1 (1)");
+           END IF;
+ 
+           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1 (1)");
+           END IF;
+ 
+           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XAP1 (1)");
+           END IF;
+ 
+           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.ONE)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1 (1)");
+           END IF;
+ 
+           XAT1.VALU(I);
+           IF I /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (1)");
+           END IF;
+ 
+           IF XAK1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XAK1 (1)");
+           END IF;
+ 
+           PROC1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
+ 
+           IF XAI1 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XAI1 (2)");
+           END IF;
+ 
+           IF XAA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1 (2)");
+           END IF;
+ 
+           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1 (2)");
+           END IF;
+ 
+           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XAP1 (2)");
+           END IF;
+ 
+           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.TWO)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1 (2)");
+           END IF;
+ 
+           XAT1.VALU(I);
+           IF I /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (2)");
+           END IF;
+ 
+           IF XAK1 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XAK1 (2)");
+           END IF;
+ 
+           A_CHK_TASK.ENTRY1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
+ 
+           IF XAI1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XAI1 (3)");
+           END IF;
+ 
+           IF XAA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1 (3)");
+           END IF;
+ 
+           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1 (3)");
+           END IF;
+ 
+           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XAP1 (3)");
+           END IF;
+ 
+           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.THREE)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1 (3)");
+           END IF;
+ 
+           XAT1.VALU(I);
+           IF I /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (3)");
+           END IF;
+ 
+           IF XAK1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XAK1 (3)");
+           END IF;
+ 
+           XAI1 := XAI1 + 1;
+           XAA1 := (XAA1(1)+1, XAA1(2)+1, XAA1(3)+1);
+           XAR1 := (D => 1, FIELD1 => XAR1.FIELD1 + 1);
+           XAP1 := NEW INTEGER'(XAP1.ALL + 1);
+           XAV1 := PACK1.NEXT(XAV1);
+           XAT1.NEXT;
+           XAK1 := XAK1 + 1;
+ 
+           IF XAI1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XAI1 (4)");
+           END IF;
+ 
+           IF XAA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1 (4)");
+           END IF;
+ 
+           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1 (4)");
+           END IF;
+ 
+           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XAP1 (4)");
+           END IF;
+ 
+           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FOUR)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1 (4)");
+           END IF;
+ 
+           XAT1.VALU(I);
+           IF I /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (4)");
+           END IF;
+ 
+           IF XAK1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XAK1 (4)");
+           END IF;
+ 
+           AI1.ALL := AI1.ALL + 1;
+           AA1.ALL := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
+           AR1.ALL := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
+           AP1.ALL := NEW INTEGER'(AP1.ALL.ALL + 1);
+           AV1.ALL := PACK1.NEXT(AV1.ALL);
+           AT1.NEXT;
+           PACK1.AK1.ALL := PACK1.AK1.ALL + 1;
+ 
+           IF XAI1 /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XAI1 (5)");
+           END IF;
+ 
+           IF XAA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1 (5)");
+           END IF;
+ 
+           IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1 (5)");
+           END IF;
+ 
+           IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XAP1 (5)");
+           END IF;
+ 
+           IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FIVE)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1 (5)");
+           END IF;
+ 
+           XAT1.VALU(I);
+           IF I /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (5)");
+           END IF;
+ 
+           IF XAK1 /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XAK1 (5)");
+           END IF;
+ 
+           AT1.STOP;
+      END;
+ 
+      RESULT;
+ END C85005E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C85005F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT, FOR A RENAMED VARIABLE DESIGNATED BY AN ACCESS VALUE,
+ --     A CHANGE IN THE ACCESS VALUE DOES NOT AFFECT WHICH VARIABLE IS
+ --     DENOTED BY THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 07/26/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85005F IS
+      TYPE ACC IS ACCESS INTEGER;
+ 
+      BUMP : INTEGER := 0;
+ 
+      A : ACC := NULL;
+ 
+      FUNCTION GET_POINTER RETURN ACC IS
+      BEGIN
+           BUMP := IDENT_INT(BUMP) + 1;
+           RETURN NEW INTEGER'(BUMP);
+      END GET_POINTER;
+ 
+ BEGIN
+      TEST ("C85005F", "CHECK THAT, FOR A RENAMED VARIABLE DESIGNATED " &
+                       "BY AN ACCESS VALUE, A CHANGE IN THE ACCESS " &
+                       "VALUE DOES NOT AFFECT WHICH VARIABLE IS " &
+                       "DENOTED BY THE NEW NAME");
+ 
+      A := GET_POINTER;
+ 
+      DECLARE
+           X1 : INTEGER RENAMES A.ALL;
+           X2 : INTEGER RENAMES GET_POINTER.ALL;
+      BEGIN
+           A := GET_POINTER;
+ 
+           IF X1 /= 1 THEN
+                FAILED("CHANGING ACCESS VALUE CHANGED RENAMED VARIABLE");
+           END IF;
+ 
+           IF X2 /= 2 THEN
+                FAILED("INCORRECT RESULT FROM FUNCTION AS PREFIX");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C85005F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85005g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85005g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C85005G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY THE TYPE MARK USED
+ --     IN THE RENAMING DECLARATION IS IGNORED, AND THE SUBTYPE
+ --     CONSTRAINT ASSOCIATED WITH THE RENAMED VARIABLE IS USED INSTEAD.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     JET 07/26/88  CREATED ORIGINAL TEST.
+ --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85005G IS
+ 
+      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
+ 
+      I : INTEGER := IDENT_INT(INTEGER'LAST);
+      J : INT := IDENT_INT(INT'LAST);
+ 
+      DG1 : INTEGER := IDENT_INT(INTEGER'LAST);
+      DG2 : INT := IDENT_INT(INT'LAST);
+ 
+      XI : INT RENAMES I;
+      XJ : INTEGER RENAMES J;
+ 
+      GENERIC
+           G1 : IN OUT INT;
+           G2 : IN OUT INTEGER;
+      PROCEDURE GEN;
+ 
+      PROCEDURE GEN IS
+           XG1 : INT RENAMES G1;
+           XG2 : INTEGER RENAMES G2;
+      BEGIN
+           IF XG1 /= INTEGER'LAST THEN
+                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G1");
+           END IF;
+ 
+           XG1 := IDENT_INT(INTEGER'FIRST);
+ 
+           IF XG1 /= INTEGER'FIRST THEN
+                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G2");
+           END IF;
+ 
+           IF XG2 /= INT'LAST THEN
+                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G3");
+           END IF;
+ 
+           XG2 := IDENT_INT(INT'FIRST);
+ 
+           IF XG2 /= INT'FIRST THEN
+                FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G4");
+           END IF;
+ 
+           BEGIN
+                XG2 := IDENT_INT(INTEGER'LAST);
+                FAILED ("NO EXCEPTION RAISED BY XG2 := INTEGER'LAST");
+                IF NOT EQUAL(XG2,XG2) THEN
+                     COMMENT ("DON'T OPTIMIZE XG2");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION (G)");
+           END;
+      END GEN;
+ 
+      PROCEDURE PROC IS NEW GEN(DG1, DG2);
+ 
+ BEGIN
+      TEST ("C85005G", "CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY " &
+                       "THE TYPE MARK USED IN THE RENAMING " &
+                       "DECLARATION IS IGNORED, AND THE SUBTYPE " &
+                       "CONSTRAINT ASSOCIATED WITH THE RENAMED " &
+                       "VARIABLE IS USED INSTEAD");
+ 
+      IF XI /= INTEGER'LAST THEN
+           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 1");
+      END IF;
+ 
+      XI := IDENT_INT(INTEGER'FIRST);
+ 
+      IF XI /= INTEGER'FIRST THEN
+           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 2");
+      END IF;
+ 
+      IF XJ /= INT'LAST THEN
+           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 3");
+      END IF;
+ 
+      XJ := IDENT_INT(INT'FIRST);
+ 
+      IF XJ /= INT'FIRST THEN
+           FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 4");
+      END IF;
+ 
+      BEGIN
+           XJ := IDENT_INT(INTEGER'LAST);
+           FAILED ("NO EXCEPTION RAISED BY XJ := INTEGER'LAST");
+           IF NOT EQUAL(XJ,XJ) THEN
+                COMMENT ("DON'T OPTIMIZE XJ");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                 NULL;
+           WHEN OTHERS =>
+                 FAILED ("UNEXPECTED EXCEPTION - 1");
+      END;
+ 
+      PROC;
+ 
+      RESULT;
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED("UNEXPECTED EXCEPTION - 2");
+           RESULT;
+ END C85005G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,681 ----
+ -- C85006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY AN
+ --     OBJECT DECLARATION CAN BE RENAMED AND HAS THE CORRECT VALUE,
+ --     AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT
+ --     AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
+ --     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+ --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+ --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/22/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85006A IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+ 
+      TASK TYPE TASK2 IS
+           ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                         TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                         TRV1 : IN OUT PACK1.PRIVY; TRT1 : IN OUT TASK1;
+                         TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                         TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                         TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK);
+      END TASK2;
+ 
+      TYPE REC_TYPE IS RECORD
+           RI1 : INTEGER := 0;
+           RA1 : ARRAY1(1..3) := (OTHERS => 0);
+           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+           RP1 : POINTER1 := NEW INTEGER'(0);
+           RV1 : PACK1.PRIVY := PACK1.ZERO;
+           RT1 : TASK1;
+      END RECORD;
+ 
+      REC : REC_TYPE;
+ 
+      AI1 : ARR_INT(1..8) := (OTHERS => 0);
+      AA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+      AR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+      AP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+      AV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+      AT1 : ARR_TSK(1..8);
+ 
+      XRI1 : INTEGER RENAMES REC.RI1;
+      XRA1 : ARRAY1 RENAMES REC.RA1;
+      XRR1 : RECORD1 RENAMES REC.RR1;
+      XRP1 : POINTER1 RENAMES REC.RP1;
+      XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+      XRT1 : TASK1 RENAMES REC.RT1;
+      XAI1 : ARR_INT RENAMES AI1(1..3);
+      XAA1 : ARR_ARR RENAMES AA1(2..4);
+      XAR1 : ARR_REC RENAMES AR1(3..5);
+      XAP1 : ARR_PTR RENAMES AP1(4..6);
+      XAV1 : ARR_PVT RENAMES AV1(5..7);
+      XAT1 : ARR_TSK RENAMES AT1(6..8);
+ 
+      I : INTEGER;
+      CHK_TASK : TASK2;
+ 
+      GENERIC
+           GRI1 : IN OUT INTEGER;
+           GRA1 : IN OUT ARRAY1;
+           GRR1 : IN OUT RECORD1;
+           GRP1 : IN OUT POINTER1;
+           GRV1 : IN OUT PACK1.PRIVY;
+           GRT1 : IN OUT TASK1;
+           GAI1 : IN OUT ARR_INT;
+           GAA1 : IN OUT ARR_ARR;
+           GAR1 : IN OUT ARR_REC;
+           GAP1 : IN OUT ARR_PTR;
+           GAV1 : IN OUT ARR_PVT;
+           GAT1 : IN OUT ARR_TSK;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                       PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                       PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                       PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                       PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                       PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+ 
+      BEGIN
+           PRI1 := PRI1 + 1;
+           PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+           PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+           PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+           PRV1 := PACK1.NEXT(REC.RV1);
+           PRT1.NEXT;
+           PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+           PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+           PAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (PAR1(PAR1'FIRST).FIELD1 + 1)));
+           PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+           FOR J IN PAV1'RANGE LOOP
+                PAV1(J) := PACK1.NEXT(AV1(J));
+           END LOOP;
+           FOR J IN PAT1'RANGE LOOP
+                PAT1(J).NEXT;
+           END LOOP;
+      END PROC1;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GRI1 := GRI1 + 1;
+           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+           GRV1 := PACK1.NEXT(GRV1);
+           GRT1.NEXT;
+           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+           GAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+           FOR J IN GAV1'RANGE LOOP
+                GAV1(J) := PACK1.NEXT(GAV1(J));
+           END LOOP;
+           FOR J IN GAT1'RANGE LOOP
+                GAT1(J).NEXT;
+           END LOOP;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+      TASK BODY TASK2 IS
+      BEGIN
+           ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                          TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                          TRV1 : IN OUT PACK1.PRIVY; TRT1: IN OUT TASK1;
+                          TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                          TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                          TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK)
+           DO
+                TRI1 := REC.RI1 + 1;
+                TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+                TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+                TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                TRV1 := PACK1.NEXT(TRV1);
+                TRT1.NEXT;
+                TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                TAA1 := (OTHERS => (OTHERS => AA1(TAA1'FIRST)(1) + 1));
+                TAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1)));
+                TAP1 := (OTHERS => NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+                FOR J IN TAV1'RANGE LOOP
+                     TAV1(J) := PACK1.NEXT(TAV1(J));
+                END LOOP;
+                FOR J IN TAT1'RANGE LOOP
+                     TAT1(J).NEXT;
+                END LOOP;
+           END ENTRY1;
+      END TASK2;
+ 
+ BEGIN
+      TEST ("C85006A", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                       "CREATED BY AN OBJECT DECLARATION CAN BE " &
+                       "RENAMED AND HAS THE CORRECT VALUE, AND THAT " &
+                       "THE NEW NAME CAN BE USED IN AN ASSIGNMENT " &
+                       "STATEMENT AND PASSED ON AS AN ACTUAL " &
+                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                       "REFLECTED BY THE VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           PACKAGE GENPACK1 IS NEW
+                GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+      BEGIN
+           NULL;
+      END;
+ 
+      IF XRI1 /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF XRI1 (1)");
+      END IF;
+ 
+      IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+           FAILED ("INCORRECT VALUE OF XRA1 (1)");
+      END IF;
+ 
+      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+           FAILED ("INCORRECT VALUE OF XRR1 (1)");
+      END IF;
+ 
+      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT VALUE OF XRP1 (1)");
+      END IF;
+ 
+      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+           FAILED ("INCORRECT VALUE OF XRV1 (1)");
+      END IF;
+ 
+      XRT1.VALU(I);
+      IF I /= IDENT_INT(1) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+      END IF;
+ 
+      FOR J IN XAI1'RANGE LOOP
+           IF XAI1(J) /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                        ") (1)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAA1'RANGE LOOP
+           IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                        ") (1)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAR1'RANGE LOOP
+           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                        ") (1)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAP1'RANGE LOOP
+           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(1)
+           THEN
+                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                        ") (1)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAV1'RANGE LOOP
+           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                        ") (1)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAT1'RANGE LOOP
+           XAT1(J).VALU(I);
+           IF I /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                        INTEGER'IMAGE(J) & ").VALU (1)");
+           END IF;
+      END LOOP;
+ 
+      PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+             XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+      IF XRI1 /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE OF XRI1 (2)");
+      END IF;
+ 
+      IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+           FAILED ("INCORRECT VALUE OF XRA1 (2)");
+      END IF;
+ 
+      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+           FAILED ("INCORRECT VALUE OF XRR1 (2)");
+      END IF;
+ 
+      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT VALUE OF XRP1 (2)");
+      END IF;
+ 
+      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+           FAILED ("INCORRECT VALUE OF XRV1 (2)");
+      END IF;
+ 
+      XRT1.VALU(I);
+      IF I /= IDENT_INT(2) THEN
+           FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+      END IF;
+ 
+      FOR J IN XAI1'RANGE LOOP
+           IF XAI1(J) /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                        ") (2)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAA1'RANGE LOOP
+           IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                        ") (2)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAR1'RANGE LOOP
+           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                        ") (2)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAP1'RANGE LOOP
+           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(2)
+           THEN
+                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                        ") (2)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAV1'RANGE LOOP
+           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                        ") (2)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAT1'RANGE LOOP
+           XAT1(J).VALU(I);
+           IF I /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                        INTEGER'IMAGE(J) & ").VALU (2)");
+           END IF;
+      END LOOP;
+ 
+      CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                      XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+      IF XRI1 /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE OF XRI1 (3)");
+      END IF;
+ 
+      IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+           FAILED ("INCORRECT VALUE OF XRA1 (3)");
+      END IF;
+ 
+      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+           FAILED ("INCORRECT VALUE OF XRR1 (3)");
+      END IF;
+ 
+      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT VALUE OF XRP1 (3)");
+      END IF;
+ 
+      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+           FAILED ("INCORRECT VALUE OF XRV1 (3)");
+      END IF;
+ 
+      XRT1.VALU(I);
+      IF I /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+      END IF;
+ 
+      FOR J IN XAI1'RANGE LOOP
+           IF XAI1(J) /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                        ") (3)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAA1'RANGE LOOP
+           IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                        ") (3)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAR1'RANGE LOOP
+           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                        ") (3)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAP1'RANGE LOOP
+           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(3)
+           THEN
+                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                        ") (3)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAV1'RANGE LOOP
+           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                        ") (3)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAT1'RANGE LOOP
+           XAT1(J).VALU(I);
+           IF I /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                        INTEGER'IMAGE(J) & ").VALU (3)");
+           END IF;
+      END LOOP;
+ 
+      XRI1 := XRI1 + 1;
+      XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+      XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+      XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+      XRV1 := PACK1.NEXT(XRV1);
+      XRT1.NEXT;
+      XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+      XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+      XAR1 := (OTHERS => (D => 1,
+                          FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+      XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+      FOR J IN XAV1'RANGE LOOP
+           XAV1(J) := PACK1.NEXT(XAV1(J));
+      END LOOP;
+      FOR J IN XAT1'RANGE LOOP
+           XAT1(J).NEXT;
+      END LOOP;
+ 
+      IF XRI1 /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE OF XRI1 (4)");
+      END IF;
+ 
+      IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+           FAILED ("INCORRECT VALUE OF XRA1 (4)");
+      END IF;
+ 
+      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+           FAILED ("INCORRECT VALUE OF XRR1 (4)");
+      END IF;
+ 
+      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT VALUE OF XRP1 (4)");
+      END IF;
+ 
+      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+           FAILED ("INCORRECT VALUE OF XRV1 (4)");
+      END IF;
+ 
+      XRT1.VALU(I);
+      IF I /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+      END IF;
+ 
+      FOR J IN XAI1'RANGE LOOP
+           IF XAI1(J) /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                        ") (4)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAA1'RANGE LOOP
+           IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                        ") (4)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAR1'RANGE LOOP
+           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                        ") (4)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAP1'RANGE LOOP
+           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(4)
+           THEN
+                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                        ") (4)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAV1'RANGE LOOP
+           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                        ") (4)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAT1'RANGE LOOP
+           XAT1(J).VALU(I);
+           IF I /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                        INTEGER'IMAGE(J) & ").VALU (4)");
+           END IF;
+      END LOOP;
+ 
+      REC.RI1 := REC.RI1 + 1;
+      REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+      REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+      REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+      REC.RV1 := PACK1.NEXT(REC.RV1);
+      REC.RT1.NEXT;
+      AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
+      AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+      AR1 := (OTHERS => (D => 1,
+                         FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+      AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+      FOR J IN XAV1'RANGE LOOP
+           AV1(J) := PACK1.NEXT(AV1(J));
+      END LOOP;
+      FOR J IN XAT1'RANGE LOOP
+           AT1(J).NEXT;
+      END LOOP;
+ 
+      IF XRI1 /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT VALUE OF XRI1 (5)");
+      END IF;
+ 
+      IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+           FAILED ("INCORRECT VALUE OF XRA1 (5)");
+      END IF;
+ 
+      IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+           FAILED ("INCORRECT VALUE OF XRR1 (5)");
+      END IF;
+ 
+      IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT VALUE OF XRP1 (5)");
+      END IF;
+ 
+      IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+           FAILED ("INCORRECT VALUE OF XRV1 (5)");
+      END IF;
+ 
+      XRT1.VALU(I);
+      IF I /= IDENT_INT(5) THEN
+           FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+      END IF;
+ 
+      FOR J IN XAI1'RANGE LOOP
+           IF XAI1(J) /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                        ") (5)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAA1'RANGE LOOP
+           IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                        ") (5)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAR1'RANGE LOOP
+           IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                        ") (5)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAP1'RANGE LOOP
+           IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(5)
+           THEN
+                FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                        ") (5)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAV1'RANGE LOOP
+           IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+                FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                        ") (5)");
+           END IF;
+      END LOOP;
+ 
+      FOR J IN XAT1'RANGE LOOP
+           XAT1(J).VALU(I);
+           IF I /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                        INTEGER'IMAGE(J) & ").VALU (5)");
+           END IF;
+      END LOOP;
+ 
+      REC.RT1.STOP;
+ 
+      FOR I IN AT1'RANGE LOOP
+           AT1(I).STOP;
+      END LOOP;
+ 
+      RESULT;
+ END C85006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,699 ----
+ -- C85006B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY A
+ --     SUBPROGRAM 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE
+ --     CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
+ --     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT'
+ --     OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+ --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+ --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/22/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85006B IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+ 
+      TYPE REC_TYPE IS RECORD
+           RI1 : INTEGER := 0;
+           RA1 : ARRAY1(1..3) := (OTHERS => 0);
+           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+           RP1 : POINTER1 := NEW INTEGER'(0);
+           RV1 : PACK1.PRIVY := PACK1.ZERO;
+           RT1 : TASK1;
+      END RECORD;
+ 
+      DREC : REC_TYPE;
+ 
+      DAI1 : ARR_INT(1..8) := (OTHERS => 0);
+      DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+      DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+      DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+      DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+      DAT1 : ARR_TSK(1..8);
+ 
+      GENERIC
+           GRI1 : IN OUT INTEGER;
+           GRA1 : IN OUT ARRAY1;
+           GRR1 : IN OUT RECORD1;
+           GRP1 : IN OUT POINTER1;
+           GRV1 : IN OUT PACK1.PRIVY;
+           GRT1 : IN OUT TASK1;
+           GAI1 : IN OUT ARR_INT;
+           GAA1 : IN OUT ARR_ARR;
+           GAR1 : IN OUT ARR_REC;
+           GAP1 : IN OUT ARR_PTR;
+           GAV1 : IN OUT ARR_PVT;
+           GAT1 : IN OUT ARR_TSK;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GRI1 := GRI1 + 1;
+           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+           GRV1 := PACK1.NEXT(GRV1);
+           GRT1.NEXT;
+           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+           GAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+           FOR J IN GAV1'RANGE LOOP
+                GAV1(J) := PACK1.NEXT(GAV1(J));
+           END LOOP;
+           FOR J IN GAT1'RANGE LOOP
+                GAT1(J).NEXT;
+           END LOOP;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+      PROCEDURE PROC (REC : IN OUT REC_TYPE;
+                      AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
+                      AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
+                      AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK) IS
+ 
+           XRI1 : INTEGER RENAMES REC.RI1;
+           XRA1 : ARRAY1 RENAMES REC.RA1;
+           XRR1 : RECORD1 RENAMES REC.RR1;
+           XRP1 : POINTER1 RENAMES REC.RP1;
+           XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+           XRT1 : TASK1 RENAMES REC.RT1;
+           XAI1 : ARR_INT RENAMES AI1(1..3);
+           XAA1 : ARR_ARR RENAMES AA1(2..4);
+           XAR1 : ARR_REC RENAMES AR1(3..5);
+           XAP1 : ARR_PTR RENAMES AP1(4..6);
+           XAV1 : ARR_PVT RENAMES AV1(5..7);
+           XAT1 : ARR_TSK RENAMES AT1(6..8);
+ 
+           TASK TYPE TASK2 IS
+                ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                              TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                              TRV1 : IN OUT PACK1.PRIVY;
+                              TRT1 : IN OUT TASK1;
+                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                              TAV1 : IN OUT ARR_PVT;
+                              TAT1 : IN OUT ARR_TSK);
+           END TASK2;
+ 
+           I : INTEGER;
+           CHK_TASK : TASK2;
+ 
+           TASK BODY TASK2 IS
+           BEGIN
+                ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                               TRR1 : OUT RECORD1;
+                               TRP1 : IN OUT POINTER1;
+                               TRV1 : IN OUT PACK1.PRIVY;
+                               TRT1: IN OUT TASK1;
+                               TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                               TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                               TAV1 : IN OUT ARR_PVT;
+                               TAT1 : IN OUT ARR_TSK)
+                DO
+                     TRI1 := REC.RI1 + 1;
+                     TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+                     TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+                     TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                     TRV1 := PACK1.NEXT(TRV1);
+                     TRT1.NEXT;
+                     TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                     TAA1 := (OTHERS => (OTHERS =>
+                                         AA1(TAA1'FIRST)(1) + 1));
+                     TAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1)));
+                     TAP1 := (OTHERS =>
+                               NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+                     FOR J IN TAV1'RANGE LOOP
+                          TAV1(J) := PACK1.NEXT(TAV1(J));
+                     END LOOP;
+                     FOR J IN TAT1'RANGE LOOP
+                          TAT1(J).NEXT;
+                     END LOOP;
+                END ENTRY1;
+           END TASK2;
+ 
+           PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                            PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                            PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                            PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                            PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                            PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+           BEGIN
+                PRI1 := PRI1 + 1;
+                PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+                PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+                PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+                PRV1 := PACK1.NEXT(REC.RV1);
+                PRT1.NEXT;
+                PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+                PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+                PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                    (PAR1(PAR1'FIRST).FIELD1 + 1)));
+                PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL+1));
+                FOR J IN PAV1'RANGE LOOP
+                     PAV1(J) := PACK1.NEXT(AV1(J));
+                END LOOP;
+                FOR J IN PAT1'RANGE LOOP
+                     PAT1(J).NEXT;
+                END LOOP;
+           END PROC1;
+ 
+           PACKAGE GENPACK1 IS NEW
+                GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+      BEGIN
+           IF XRI1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (1)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (1)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (1)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (1)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (1)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(1)
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (1)");
+                END IF;
+           END LOOP;
+ 
+           PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                  XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+           IF XRI1 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (2)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (2)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (2)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (2)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (2)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (2)");
+                END IF;
+           END LOOP;
+ 
+           CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                           XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+           IF XRI1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (3)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (3)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (3)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (3)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (3)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (3)");
+                END IF;
+           END LOOP;
+ 
+           XRI1 := XRI1 + 1;
+           XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+           XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+           XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+           XRV1 := PACK1.NEXT(XRV1);
+           XRT1.NEXT;
+           XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+           XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+           XAR1 := (OTHERS => (D => 1,
+                          FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+           XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+           FOR J IN XAV1'RANGE LOOP
+                XAV1(J) := PACK1.NEXT(XAV1(J));
+           END LOOP;
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).NEXT;
+           END LOOP;
+ 
+           IF XRI1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (4)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (4)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (4)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (4)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (4)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (4)");
+                END IF;
+           END LOOP;
+ 
+           REC.RI1 := REC.RI1 + 1;
+           REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+           REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+           REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+           REC.RV1 := PACK1.NEXT(REC.RV1);
+           REC.RT1.NEXT;
+           AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
+           AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+           AR1 := (OTHERS => (D => 1,
+                              FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+           AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+           FOR J IN XAV1'RANGE LOOP
+                AV1(J) := PACK1.NEXT(AV1(J));
+           END LOOP;
+           FOR J IN XAT1'RANGE LOOP
+                AT1(J).NEXT;
+           END LOOP;
+ 
+           IF XRI1 /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (5)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (5)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (5)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (5)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (5)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                XAP1(J).ALL /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (5)");
+                END IF;
+           END LOOP;
+ 
+      END PROC;
+ 
+ BEGIN
+      TEST ("C85006B", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                       "CREATED BY A SUBPROGRAM 'IN OUT' FORMAL " &
+                       "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " &
+                       "VALUE, AND THAT THE NEW NAME CAN BE USED IN " &
+                       "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " &
+                       "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                       "REFLECTED BY THE VALUE OF THE NEW NAME");
+ 
+      PROC (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
+ 
+      DREC.RT1.STOP;
+ 
+      FOR I IN DAT1'RANGE LOOP
+           DAT1(I).STOP;
+      END LOOP;
+ 
+      RESULT;
+ END C85006B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,778 ----
+ -- C85006C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY AN ENTRY
+ --     'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE CORRECT
+ --     VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
+ --     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY
+ --     'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT'
+ --     PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS
+ --     CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/22/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85006C IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+ 
+      TYPE REC_TYPE IS RECORD
+           RI1 : INTEGER := 0;
+           RA1 : ARRAY1(1..3) := (OTHERS => 0);
+           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+           RP1 : POINTER1 := NEW INTEGER'(0);
+           RV1 : PACK1.PRIVY := PACK1.ZERO;
+           RT1 : TASK1;
+      END RECORD;
+ 
+      DREC : REC_TYPE;
+ 
+      DAI1 : ARR_INT(1..8) := (OTHERS => 0);
+      DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+      DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+      DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+      DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+      DAT1 : ARR_TSK(1..8);
+ 
+      I : INTEGER;
+ 
+      GENERIC
+           GRI1 : IN OUT INTEGER;
+           GRA1 : IN OUT ARRAY1;
+           GRR1 : IN OUT RECORD1;
+           GRP1 : IN OUT POINTER1;
+           GRV1 : IN OUT PACK1.PRIVY;
+           GRT1 : IN OUT TASK1;
+           GAI1 : IN OUT ARR_INT;
+           GAA1 : IN OUT ARR_ARR;
+           GAR1 : IN OUT ARR_REC;
+           GAP1 : IN OUT ARR_PTR;
+           GAV1 : IN OUT ARR_PVT;
+           GAT1 : IN OUT ARR_TSK;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GRI1 := GRI1 + 1;
+           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+           GRV1 := PACK1.NEXT(GRV1);
+           GRT1.NEXT;
+           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+           GAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+           FOR J IN GAV1'RANGE LOOP
+                GAV1(J) := PACK1.NEXT(GAV1(J));
+           END LOOP;
+           FOR J IN GAT1'RANGE LOOP
+                GAT1(J).NEXT;
+           END LOOP;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+ BEGIN
+      TEST ("C85006C", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                       "CREATED BY AN ENTRY 'IN OUT' FORMAL PARAMETER " &
+                       "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
+                       "THAT THE NEW NAME CAN BE USED IN AN ASSIGN" &
+                       "MENT STATEMENT AND PASSED ON AS AN ACTUAL " &
+                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                       "REFLECTED BY THE VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           TASK MAIN_TASK IS
+                ENTRY START (REC : IN OUT REC_TYPE;
+                             AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
+                             AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
+                             AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK);
+           END MAIN_TASK;
+ 
+           TASK BODY MAIN_TASK IS
+           BEGIN
+              ACCEPT START (REC : IN OUT REC_TYPE;
+                            AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
+                            AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
+                            AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK)
+                 DO
+                 DECLARE
+                    XRI1 : INTEGER RENAMES REC.RI1;
+                    XRA1 : ARRAY1 RENAMES REC.RA1;
+                    XRR1 : RECORD1 RENAMES REC.RR1;
+                    XRP1 : POINTER1 RENAMES REC.RP1;
+                    XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+                    XRT1 : TASK1 RENAMES REC.RT1;
+                    XAI1 : ARR_INT RENAMES AI1(1..3);
+                    XAA1 : ARR_ARR RENAMES AA1(2..4);
+                    XAR1 : ARR_REC RENAMES AR1(3..5);
+                    XAP1 : ARR_PTR RENAMES AP1(4..6);
+                    XAV1 : ARR_PVT RENAMES AV1(5..7);
+                    XAT1 : ARR_TSK RENAMES AT1(6..8);
+ 
+                    TASK TYPE TASK2 IS
+                       ENTRY ENTRY1 (TRI1 : OUT INTEGER;
+                                     TRA1 : OUT ARRAY1;
+                                     TRR1 : OUT RECORD1;
+                                     TRP1 : IN OUT POINTER1;
+                                     TRV1 : IN OUT PACK1.PRIVY;
+                                     TRT1 : IN OUT TASK1;
+                                     TAI1 : OUT ARR_INT;
+                                     TAA1 : OUT ARR_ARR;
+                                     TAR1 : OUT ARR_REC;
+                                     TAP1 : IN OUT ARR_PTR;
+                                     TAV1 : IN OUT ARR_PVT;
+                                     TAT1 : IN OUT ARR_TSK);
+                    END TASK2;
+ 
+                    CHK_TASK : TASK2;
+ 
+                    TASK BODY TASK2 IS
+                    BEGIN
+                       ACCEPT ENTRY1 (TRI1 : OUT INTEGER;
+                                      TRA1 : OUT ARRAY1;
+                                      TRR1 : OUT RECORD1;
+                                      TRP1 : IN OUT POINTER1;
+                                      TRV1 : IN OUT PACK1.PRIVY;
+                                      TRT1: IN OUT TASK1;
+                                      TAI1 : OUT ARR_INT;
+                                      TAA1 : OUT ARR_ARR;
+                                      TAR1 : OUT ARR_REC;
+                                      TAP1 : IN OUT ARR_PTR;
+                                      TAV1 : IN OUT ARR_PVT;
+                                      TAT1 : IN OUT ARR_TSK)
+                       DO
+                          TRI1 := REC.RI1 + 1;
+                          TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
+                                   REC.RA1(3)+1);
+                          TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+                          TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                          TRV1 := PACK1.NEXT(TRV1);
+                          TRT1.NEXT;
+                          TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                          TAA1 := (OTHERS => (OTHERS =>
+                                              AA1(TAA1'FIRST)(1) + 1));
+                          TAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                         (AR1(TAR1'FIRST).FIELD1 + 1)));
+                          TAP1 := (OTHERS =>
+                                   NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+                          FOR J IN TAV1'RANGE LOOP
+                             TAV1(J) := PACK1.NEXT(TAV1(J));
+                          END LOOP;
+                          FOR J IN TAT1'RANGE LOOP
+                             TAT1(J).NEXT;
+                          END LOOP;
+                       END ENTRY1;
+                    END TASK2;
+ 
+                    PROCEDURE PROC1 (PRI1 : IN OUT INTEGER;
+                                     PRA1 : IN OUT ARRAY1;
+                                     PRR1 : IN OUT RECORD1;
+                                     PRP1 : OUT POINTER1;
+                                     PRV1 : OUT PACK1.PRIVY;
+                                     PRT1 : IN OUT TASK1;
+                                     PAI1 : IN OUT ARR_INT;
+                                     PAA1 : IN OUT ARR_ARR;
+                                     PAR1 : IN OUT ARR_REC;
+                                     PAP1 : OUT ARR_PTR;
+                                     PAV1 : OUT ARR_PVT;
+                                     PAT1 : IN OUT ARR_TSK) IS
+                    BEGIN
+                       PRI1 := PRI1 + 1;
+                       PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+                       PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+                       PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+                       PRV1 := PACK1.NEXT(REC.RV1);
+                       PRT1.NEXT;
+                       PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+                       PAA1 := (OTHERS => (OTHERS =>
+                                           PAA1(PAA1'FIRST)(1) + 1));
+                       PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                          (PAR1(PAR1'FIRST).FIELD1+1)));
+                       PAP1 := (OTHERS =>
+                                NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+                       FOR J IN PAV1'RANGE LOOP
+                          PAV1(J) := PACK1.NEXT(AV1(J));
+                       END LOOP;
+                       FOR J IN PAT1'RANGE LOOP
+                          PAT1(J).NEXT;
+                       END LOOP;
+                    END PROC1;
+ 
+                    PACKAGE GENPACK2 IS NEW GENERIC1
+                       (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                        XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+                 BEGIN
+                          IF XRI1 /= IDENT_INT(1) THEN
+                               FAILED ("INCORRECT VALUE OF XRI1 (1)");
+                          END IF;
+ 
+                          IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),
+                                      IDENT_INT(1)) THEN
+                               FAILED ("INCORRECT VALUE OF XRA1 (1)");
+                          END IF;
+ 
+                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRR1 (1)");
+                          END IF;
+ 
+                          IF XRP1 /= IDENT(REC.RP1) OR
+                             XRP1.ALL /= IDENT_INT(1) THEN
+                               FAILED ("INCORRECT VALUE OF XRP1 (1)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRV1 (1)");
+                          END IF;
+ 
+                          XRT1.VALU(I);
+                          IF I /= IDENT_INT(1) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XRT1.VALU (1)");
+                          END IF;
+ 
+                          FOR J IN XAI1'RANGE LOOP
+                               IF XAI1(J) /= IDENT_INT(1) THEN
+                                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                                            INTEGER'IMAGE(J) & ") (1)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAA1'RANGE LOOP
+                               IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),
+                                              IDENT_INT(1)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                                            INTEGER'IMAGE(J) & ") (1)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAR1'RANGE LOOP
+                               IF XAR1(J) /= (D => 1,
+                                       FIELD1 => IDENT_INT(1)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                                            INTEGER'IMAGE(J) & ") (1)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAP1'RANGE LOOP
+                               IF XAP1(J) /= IDENT(AP1(J)) OR
+                                  XAP1(J).ALL /= IDENT_INT(1) THEN
+                                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                                            INTEGER'IMAGE(J) & ") (1)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAV1'RANGE LOOP
+                               IF PACK1."/=" (XAV1(J),
+                                         PACK1.IDENT(PACK1.ONE)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                                            INTEGER'IMAGE(J) & ") (1)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAT1'RANGE LOOP
+                               XAT1(J).VALU(I);
+                               IF I /= IDENT_INT(1) THEN
+                                    FAILED ("INCORRECT RETURN VALUE " &
+                                       "FROM XAT1(" & INTEGER'IMAGE(J) &
+                                       ").VALU (1)");
+                               END IF;
+                          END LOOP;
+ 
+                          PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                                 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+                          IF XRI1 /= IDENT_INT(2) THEN
+                               FAILED ("INCORRECT VALUE OF XRI1 (2)");
+                          END IF;
+ 
+                          IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),
+                                      IDENT_INT(2)) THEN
+                               FAILED ("INCORRECT VALUE OF XRA1 (2)");
+                          END IF;
+ 
+                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRR1 (2)");
+                          END IF;
+ 
+                          IF XRP1 /= IDENT(REC.RP1) OR
+                             XRP1.ALL /= IDENT_INT(2) THEN
+                               FAILED ("INCORRECT VALUE OF XRP1 (2)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRV1 (2)");
+                          END IF;
+ 
+                          XRT1.VALU(I);
+                          IF I /= IDENT_INT(2) THEN
+                               FAILED ("INCORRECT RETURN VALUE FROM " &
+                                       "XRT1.VALU (2)");
+                          END IF;
+ 
+                          FOR J IN XAI1'RANGE LOOP
+                               IF XAI1(J) /= IDENT_INT(2) THEN
+                                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                                            INTEGER'IMAGE(J) & ") (2)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAA1'RANGE LOOP
+                               IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),
+                                              IDENT_INT(2)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                                            INTEGER'IMAGE(J) & ") (2)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAR1'RANGE LOOP
+                               IF XAR1(J) /= (D => 1,
+                                        FIELD1 => IDENT_INT(2)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                                            INTEGER'IMAGE(J) & ") (2)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAP1'RANGE LOOP
+                               IF XAP1(J) /= IDENT(AP1(J)) OR
+                                  XAP1(J).ALL /= IDENT_INT(2) THEN
+                                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                                            INTEGER'IMAGE(J) & ") (2)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAV1'RANGE LOOP
+                               IF PACK1."/=" (XAV1(J),
+                                       PACK1.IDENT(PACK1.TWO)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                                            INTEGER'IMAGE(J) & ") (2)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAT1'RANGE LOOP
+                               XAT1(J).VALU(I);
+                               IF I /= IDENT_INT(2) THEN
+                                    FAILED ("INCORRECT RETURN VALUE " &
+                                       "FROM XAT1(" & INTEGER'IMAGE(J) &
+                                       ").VALU (2)");
+                               END IF;
+                          END LOOP;
+ 
+                          CHK_TASK.ENTRY1
+                               (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                                XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+                          IF XRI1 /= IDENT_INT(3) THEN
+                               FAILED ("INCORRECT VALUE OF XRI1 (3)");
+                          END IF;
+ 
+                          IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),
+                                      IDENT_INT(3)) THEN
+                               FAILED ("INCORRECT VALUE OF XRA1 (3)");
+                          END IF;
+ 
+                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRR1 (3)");
+                          END IF;
+ 
+                          IF XRP1 /= IDENT(REC.RP1) OR
+                             XRP1.ALL /= IDENT_INT(3) THEN
+                               FAILED ("INCORRECT VALUE OF XRP1 (3)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRV1 (3)");
+                          END IF;
+ 
+                          XRT1.VALU(I);
+                          IF I /= IDENT_INT(3) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XRT1.VALU (3)");
+                          END IF;
+ 
+                          FOR J IN XAI1'RANGE LOOP
+                               IF XAI1(J) /= IDENT_INT(3) THEN
+                                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                                            INTEGER'IMAGE(J) & ") (3)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAA1'RANGE LOOP
+                               IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),
+                                              IDENT_INT(3))
+                               THEN
+                                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                                            INTEGER'IMAGE(J) & ") (3)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAR1'RANGE LOOP
+                               IF XAR1(J) /= (D => 1,
+                                       FIELD1 => IDENT_INT(3)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                                            INTEGER'IMAGE(J) & ") (3)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAP1'RANGE LOOP
+                               IF XAP1(J) /= IDENT(AP1(J)) OR
+                                  XAP1(J).ALL /= IDENT_INT(3) THEN
+                                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                                            INTEGER'IMAGE(J) & ") (3)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAV1'RANGE LOOP
+                               IF PACK1."/=" (XAV1(J),
+                                       PACK1.IDENT(PACK1.THREE)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                                            INTEGER'IMAGE(J) & ") (3)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAT1'RANGE LOOP
+                               XAT1(J).VALU(I);
+                               IF I /= IDENT_INT(3) THEN
+                                    FAILED ("INCORRECT RETURN VALUE " &
+                                       "FROM XAT1(" &
+                                       INTEGER'IMAGE(J) & ").VALU (3)");
+                               END IF;
+                          END LOOP;
+ 
+                          XRI1 := XRI1 + 1;
+                          XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+                          XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+                          XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+                          XRV1 := PACK1.NEXT(XRV1);
+                          XRT1.NEXT;
+                          XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+                          XAA1 := (OTHERS =>
+                                   (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+                          XAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                   (XAR1(XAR1'FIRST).FIELD1 + 1)));
+                          XAP1 := (OTHERS =>
+                               NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+                          FOR J IN XAV1'RANGE LOOP
+                               XAV1(J) := PACK1.NEXT(XAV1(J));
+                          END LOOP;
+                          FOR J IN XAT1'RANGE LOOP
+                               XAT1(J).NEXT;
+                          END LOOP;
+ 
+                          IF XRI1 /= IDENT_INT(4) THEN
+                               FAILED ("INCORRECT VALUE OF XRI1 (4)");
+                          END IF;
+ 
+                          IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),
+                                      IDENT_INT(4)) THEN
+                               FAILED ("INCORRECT VALUE OF XRA1 (4)");
+                          END IF;
+ 
+                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRR1 (4)");
+                          END IF;
+ 
+                          IF XRP1 /= IDENT(REC.RP1) OR
+                             XRP1.ALL /= IDENT_INT(4) THEN
+                               FAILED ("INCORRECT VALUE OF XRP1 (4)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRV1 (4)");
+                          END IF;
+ 
+                          XRT1.VALU(I);
+                          IF I /= IDENT_INT(4) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XRT1.VALU (4)");
+                          END IF;
+ 
+                          FOR J IN XAI1'RANGE LOOP
+                               IF XAI1(J) /= IDENT_INT(4) THEN
+                                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                                            INTEGER'IMAGE(J) & ") (4)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAA1'RANGE LOOP
+                               IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),
+                                              IDENT_INT(4)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                                            INTEGER'IMAGE(J) & ") (4)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAR1'RANGE LOOP
+                               IF XAR1(J) /= (D => 1, FIELD1 =>
+                                       IDENT_INT(4)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                                            INTEGER'IMAGE(J) & ") (4)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAP1'RANGE LOOP
+                               IF XAP1(J) /= IDENT(AP1(J)) OR
+                                  XAP1(J).ALL /= IDENT_INT(4) THEN
+                                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                                            INTEGER'IMAGE(J) & ") (4)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAV1'RANGE LOOP
+                               IF PACK1."/=" (XAV1(J),
+                                         PACK1.IDENT(PACK1.FOUR)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                                            INTEGER'IMAGE(J) & ") (4)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAT1'RANGE LOOP
+                               XAT1(J).VALU(I);
+                               IF I /= IDENT_INT(4) THEN
+                                    FAILED ("INCORRECT RETURN VALUE " &
+                                       "FROM XAT1(" &
+                                       INTEGER'IMAGE(J) & ").VALU (4)");
+                               END IF;
+                          END LOOP;
+ 
+                          REC.RI1 := REC.RI1 + 1;
+                          REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
+                                      REC.RA1(3)+1);
+                          REC.RR1 := (D => 1, FIELD1 =>
+                                         REC.RR1.FIELD1 + 1);
+                          REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+                          REC.RV1 := PACK1.NEXT(REC.RV1);
+                          REC.RT1.NEXT;
+                          AI1(XAI1'RANGE) := (OTHERS =>
+                                              AI1(XAI1'FIRST) + 1);
+                          AA1(XAA1'RANGE) := (OTHERS =>
+                                     (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+                          AR1(XAR1'RANGE) := (OTHERS => (D => 1,
+                                FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+                          AP1(XAP1'RANGE) := (OTHERS =>
+                                NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+                          FOR J IN XAV1'RANGE LOOP
+                               AV1(J) := PACK1.NEXT(AV1(J));
+                          END LOOP;
+                          FOR J IN XAT1'RANGE LOOP
+                               AT1(J).NEXT;
+                          END LOOP;
+ 
+                          IF XRI1 /= IDENT_INT(5) THEN
+                               FAILED ("INCORRECT VALUE OF XRI1 (5)");
+                          END IF;
+ 
+                          IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),
+                                      IDENT_INT(5)) THEN
+                               FAILED ("INCORRECT VALUE OF XRA1 (5)");
+                          END IF;
+ 
+                          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRR1 (5)");
+                          END IF;
+ 
+                          IF XRP1 /= IDENT(REC.RP1) OR
+                             XRP1.ALL /= IDENT_INT(5) THEN
+                               FAILED ("INCORRECT VALUE OF XRP1 (5)");
+                          END IF;
+ 
+                          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE))
+                          THEN
+                               FAILED ("INCORRECT VALUE OF XRV1 (5)");
+                          END IF;
+ 
+                          XRT1.VALU(I);
+                          IF I /= IDENT_INT(5) THEN
+                               FAILED ("INCORRECT RETURN VALUE OF " &
+                                       "XRT1.VALU (5)");
+                          END IF;
+ 
+                          FOR J IN XAI1'RANGE LOOP
+                               IF XAI1(J) /= IDENT_INT(5) THEN
+                                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                                            INTEGER'IMAGE(J) & ") (5)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAA1'RANGE LOOP
+                               IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),
+                                              IDENT_INT(5)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                                            INTEGER'IMAGE(J) & ") (5)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAR1'RANGE LOOP
+                               IF XAR1(J) /= (D => 1, FIELD1 =>
+                                       IDENT_INT(5)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                                            INTEGER'IMAGE(J) & ") (5)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAP1'RANGE LOOP
+                               IF XAP1(J) /= IDENT(AP1(J)) OR
+                                  XAP1(J).ALL /= IDENT_INT(5) THEN
+                                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                                            INTEGER'IMAGE(J) & ") (5)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAV1'RANGE LOOP
+                               IF PACK1."/=" (XAV1(J),
+                                            PACK1.IDENT(PACK1.FIVE)) THEN
+                                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                                            INTEGER'IMAGE(J) & ") (5)");
+                               END IF;
+                          END LOOP;
+ 
+                          FOR J IN XAT1'RANGE LOOP
+                               XAT1(J).VALU(I);
+                               IF I /= IDENT_INT(5) THEN
+                                    FAILED ("INCORRECT RETURN VALUE " &
+                                       "FROM XAT1(" &
+                                       INTEGER'IMAGE(J) & ").VALU (5)");
+                               END IF;
+                          END LOOP;
+                     END;
+                END START;
+           END MAIN_TASK;
+ 
+      BEGIN
+           MAIN_TASK.START (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
+      END;
+ 
+      DREC.RT1.STOP;
+ 
+      FOR I IN DAT1'RANGE LOOP
+           DAT1(I).STOP;
+      END LOOP;
+ 
+      RESULT;
+ END C85006C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,712 ----
+ -- C85006D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY A
+ --     GENERIC 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE
+ --     CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
+ --     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT'
+ --     OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+ --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+ --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/22/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85006D IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+ 
+      TYPE REC_TYPE IS RECORD
+           RI1 : INTEGER := 0;
+           RA1 : ARRAY1(1..3) := (OTHERS => 0);
+           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+           RP1 : POINTER1 := NEW INTEGER'(0);
+           RV1 : PACK1.PRIVY := PACK1.ZERO;
+           RT1 : TASK1;
+      END RECORD;
+ 
+      DREC : REC_TYPE;
+ 
+      DAI1 : ARR_INT(1..8) := (OTHERS => 0);
+      DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+      DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+      DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+      DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+      DAT1 : ARR_TSK(1..8);
+ 
+      GENERIC
+           REC : IN OUT REC_TYPE;
+           AI1 : IN OUT ARR_INT;
+           AA1 : IN OUT ARR_ARR;
+           AR1 : IN OUT ARR_REC;
+           AP1 : IN OUT ARR_PTR;
+           AV1 : IN OUT ARR_PVT;
+           AT1 : IN OUT ARR_TSK;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+           XRI1 : INTEGER RENAMES REC.RI1;
+           XRA1 : ARRAY1 RENAMES REC.RA1;
+           XRR1 : RECORD1 RENAMES REC.RR1;
+           XRP1 : POINTER1 RENAMES REC.RP1;
+           XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+           XRT1 : TASK1 RENAMES REC.RT1;
+           XAI1 : ARR_INT RENAMES AI1(1..3);
+           XAA1 : ARR_ARR RENAMES AA1(2..4);
+           XAR1 : ARR_REC RENAMES AR1(3..5);
+           XAP1 : ARR_PTR RENAMES AP1(4..6);
+           XAV1 : ARR_PVT RENAMES AV1(5..7);
+           XAT1 : ARR_TSK RENAMES AT1(6..8);
+ 
+           TASK TYPE TASK2 IS
+                ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                              TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                              TRV1 : IN OUT PACK1.PRIVY;
+                              TRT1 : IN OUT TASK1;
+                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                              TAV1 : IN OUT ARR_PVT;
+                              TAT1 : IN OUT ARR_TSK);
+           END TASK2;
+ 
+           CHK_TASK : TASK2;
+           I : INTEGER;
+ 
+           GENERIC
+                GRI1 : IN OUT INTEGER;
+                GRA1 : IN OUT ARRAY1;
+                GRR1 : IN OUT RECORD1;
+                GRP1 : IN OUT POINTER1;
+                GRV1 : IN OUT PACK1.PRIVY;
+                GRT1 : IN OUT TASK1;
+                GAI1 : IN OUT ARR_INT;
+                GAA1 : IN OUT ARR_ARR;
+                GAR1 : IN OUT ARR_REC;
+                GAP1 : IN OUT ARR_PTR;
+                GAV1 : IN OUT ARR_PVT;
+                GAT1 : IN OUT ARR_TSK;
+           PACKAGE GENERIC2 IS
+           END GENERIC2;
+ 
+           PACKAGE BODY GENERIC2 IS
+           BEGIN
+                GRI1 := GRI1 + 1;
+                GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+                GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+                GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+                GRV1 := PACK1.NEXT(GRV1);
+                GRT1.NEXT;
+                GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+                GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+                GAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+                GAP1 := (OTHERS =>
+                          NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+                FOR J IN GAV1'RANGE LOOP
+                     GAV1(J) := PACK1.NEXT(GAV1(J));
+                END LOOP;
+                FOR J IN GAT1'RANGE LOOP
+                     GAT1(J).NEXT;
+                END LOOP;
+           END GENERIC2;
+ 
+           PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                            PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                            PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                            PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                            PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                            PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+           BEGIN
+                PRI1 := PRI1 + 1;
+                PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+                PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+                PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+                PRV1 := PACK1.NEXT(REC.RV1);
+                PRT1.NEXT;
+                PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+                PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+                PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                    (PAR1(PAR1'FIRST).FIELD1 + 1)));
+                PAP1 := (OTHERS =>
+                         NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+                FOR J IN PAV1'RANGE LOOP
+                     PAV1(J) := PACK1.NEXT(AV1(J));
+                END LOOP;
+                FOR J IN PAT1'RANGE LOOP
+                     PAT1(J).NEXT;
+                END LOOP;
+           END PROC1;
+ 
+           TASK BODY TASK2 IS
+           BEGIN
+                ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                               TRR1 : OUT RECORD1;
+                               TRP1 : IN OUT POINTER1;
+                               TRV1 : IN OUT PACK1.PRIVY;
+                               TRT1: IN OUT TASK1;
+                               TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                               TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                               TAV1 : IN OUT ARR_PVT;
+                               TAT1 : IN OUT ARR_TSK)
+                DO
+                     TRI1 := REC.RI1 + 1;
+                     TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+                     TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+                     TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                     TRV1 := PACK1.NEXT(TRV1);
+                     TRT1.NEXT;
+                     TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                     TAA1 := (OTHERS => (OTHERS =>
+                                         AA1(TAA1'FIRST)(1) + 1));
+                     TAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                         (AR1(TAR1'FIRST).FIELD1 + 1)));
+                     TAP1 := (OTHERS =>
+                              NEW INTEGER'(TAP1(TAP1'FIRST).ALL + 1));
+                     FOR J IN TAV1'RANGE LOOP
+                          TAV1(J) := PACK1.NEXT(TAV1(J));
+                     END LOOP;
+                     FOR J IN TAT1'RANGE LOOP
+                          TAT1(J).NEXT;
+                     END LOOP;
+                END ENTRY1;
+           END TASK2;
+ 
+           PACKAGE GENPACK2 IS NEW
+                GENERIC2 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+      BEGIN
+           IF XRI1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (1)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (1)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (1)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (1)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (1)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(1)
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (1)");
+                END IF;
+           END LOOP;
+ 
+           PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                  XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+           IF XRI1 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (2)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (2)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (2)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (2)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (2)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (2)");
+                END IF;
+           END LOOP;
+ 
+           CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                           XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+           IF XRI1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (3)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (3)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (3)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (3)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (3)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (3)");
+                END IF;
+           END LOOP;
+ 
+           XRI1 := XRI1 + 1;
+           XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+           XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+           XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+           XRV1 := PACK1.NEXT(XRV1);
+           XRT1.NEXT;
+           XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+           XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+           XAR1 := (OTHERS => (D => 1,
+                          FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+           XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+           FOR J IN XAV1'RANGE LOOP
+                XAV1(J) := PACK1.NEXT(XAV1(J));
+           END LOOP;
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).NEXT;
+           END LOOP;
+ 
+           IF XRI1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (4)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (4)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (4)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (4)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (4)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (4)");
+                END IF;
+           END LOOP;
+ 
+           REC.RI1 := REC.RI1 + 1;
+           REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+           REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+           REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+           REC.RV1 := PACK1.NEXT(REC.RV1);
+           REC.RT1.NEXT;
+           AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
+           AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+           AR1 := (OTHERS => (D => 1,
+                              FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+           AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+           FOR J IN XAV1'RANGE LOOP
+                AV1(J) := PACK1.NEXT(AV1(J));
+           END LOOP;
+           FOR J IN XAT1'RANGE LOOP
+                AT1(J).NEXT;
+           END LOOP;
+ 
+           IF XRI1 /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (5)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (5)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (5)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (5)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (5)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                XAP1(J).ALL /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (5)");
+                END IF;
+           END LOOP;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+ BEGIN
+      TEST ("C85006D", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                       "CREATED BY A GENERIC 'IN OUT' FORMAL " &
+                       "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " &
+                       "VALUE, AND THAT THE NEW NAME CAN BE USED IN " &
+                       "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " &
+                       "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                       "REFLECTED BY THE VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           PACKAGE GENPACK IS NEW
+                GENERIC1 (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
+      BEGIN
+           NULL;
+      END;
+ 
+      DREC.RT1.STOP;
+ 
+      FOR I IN DAT1'RANGE LOOP
+           DAT1(I).STOP;
+      END LOOP;
+ 
+      RESULT;
+ END C85006D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,702 ----
+ -- C85006E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY AN
+ --     ALLOCATOR CAN BE RENAMED AND HAS THE CORRECT VALUE,
+ --     AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT
+ --     AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
+ --     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+ --     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+ --     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+ 
+ -- HISTORY:
+ --     JET 03/22/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85006E IS
+ 
+      TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+      TYPE RECORD1 (D : INTEGER) IS
+           RECORD
+                FIELD1 : INTEGER := 1;
+           END RECORD;
+      TYPE POINTER1 IS ACCESS INTEGER;
+ 
+      PACKAGE PACK1 IS
+           TYPE PRIVY IS PRIVATE;
+           ZERO : CONSTANT PRIVY;
+           ONE : CONSTANT PRIVY;
+           TWO : CONSTANT PRIVY;
+           THREE : CONSTANT PRIVY;
+           FOUR : CONSTANT PRIVY;
+           FIVE : CONSTANT PRIVY;
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+      PRIVATE
+           TYPE PRIVY IS RANGE 0..127;
+           ZERO : CONSTANT PRIVY := 0;
+           ONE : CONSTANT PRIVY := 1;
+           TWO : CONSTANT PRIVY := 2;
+           THREE : CONSTANT PRIVY := 3;
+           FOUR : CONSTANT PRIVY := 4;
+           FIVE : CONSTANT PRIVY := 5;
+      END PACK1;
+ 
+      TASK TYPE TASK1 IS
+           ENTRY ASSIGN (J : IN INTEGER);
+           ENTRY VALU (J : OUT INTEGER);
+           ENTRY NEXT;
+           ENTRY STOP;
+      END TASK1;
+ 
+      TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+      TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+      TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+      TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+      TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+      TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+ 
+      TYPE REC_TYPE IS RECORD
+           RI1 : INTEGER := 0;
+           RA1 : ARRAY1(1..3) := (OTHERS => 0);
+           RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+           RP1 : POINTER1 := NEW INTEGER'(0);
+           RV1 : PACK1.PRIVY := PACK1.ZERO;
+           RT1 : TASK1;
+      END RECORD;
+ 
+      GENERIC
+           GRI1 : IN OUT INTEGER;
+           GRA1 : IN OUT ARRAY1;
+           GRR1 : IN OUT RECORD1;
+           GRP1 : IN OUT POINTER1;
+           GRV1 : IN OUT PACK1.PRIVY;
+           GRT1 : IN OUT TASK1;
+           GAI1 : IN OUT ARR_INT;
+           GAA1 : IN OUT ARR_ARR;
+           GAR1 : IN OUT ARR_REC;
+           GAP1 : IN OUT ARR_PTR;
+           GAV1 : IN OUT ARR_PVT;
+           GAT1 : IN OUT ARR_TSK;
+      PACKAGE GENERIC1 IS
+      END GENERIC1;
+ 
+      FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+      BEGIN
+           IF EQUAL (3,3) THEN
+                RETURN P;
+           ELSE
+                RETURN NULL;
+           END IF;
+      END IDENT;
+ 
+      PACKAGE BODY PACK1 IS
+           FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN I;
+                ELSE
+                     RETURN PRIVY'(0);
+                END IF;
+           END IDENT;
+ 
+           FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+           BEGIN
+                RETURN I+1;
+           END NEXT;
+      END PACK1;
+ 
+      PACKAGE BODY GENERIC1 IS
+      BEGIN
+           GRI1 := GRI1 + 1;
+           GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+           GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+           GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+           GRV1 := PACK1.NEXT(GRV1);
+           GRT1.NEXT;
+           GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+           GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+           GAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+           GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+           FOR J IN GAV1'RANGE LOOP
+                GAV1(J) := PACK1.NEXT(GAV1(J));
+           END LOOP;
+           FOR J IN GAT1'RANGE LOOP
+                GAT1(J).NEXT;
+           END LOOP;
+      END GENERIC1;
+ 
+      TASK BODY TASK1 IS
+           TASK_VALUE : INTEGER := 0;
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ASSIGN (J : IN INTEGER) DO
+                          TASK_VALUE := J;
+                     END ASSIGN;
+                OR
+                     ACCEPT VALU (J : OUT INTEGER) DO
+                          J := TASK_VALUE;
+                     END VALU;
+                OR
+                     ACCEPT NEXT DO
+                          TASK_VALUE := TASK_VALUE + 1;
+                     END NEXT;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END TASK1;
+ 
+ BEGIN
+      TEST ("C85006E", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                       "CREATED BY AN ALLOCATOR CAN BE " &
+                       "RENAMED AND HAS THE CORRECT VALUE, AND THAT " &
+                       "THE NEW NAME CAN BE USED IN AN ASSIGNMENT " &
+                       "STATEMENT AND PASSED ON AS AN ACTUAL " &
+                       "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                       "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                       "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                       "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                       "REFLECTED BY THE VALUE OF THE NEW NAME");
+ 
+      DECLARE
+           TYPE AREC_TYPE IS ACCESS REC_TYPE;
+           AREC : AREC_TYPE := NEW REC_TYPE;
+ 
+           TYPE ACC_INT IS ACCESS ARR_INT;
+           TYPE ACC_ARR IS ACCESS ARR_ARR;
+           TYPE ACC_REC IS ACCESS ARR_REC;
+           TYPE ACC_PTR IS ACCESS ARR_PTR;
+           TYPE ACC_PVT IS ACCESS ARR_PVT;
+           TYPE ACC_TSK IS ACCESS ARR_TSK;
+ 
+           AI1 : ACC_INT := NEW ARR_INT'(1..8 => 0);
+           AA1 : ACC_ARR := NEW ARR_ARR'(1..8 => (OTHERS => 0));
+           AR1 : ACC_REC := NEW ARR_REC'(1..8 => (D => 1, FIELD1 => 0));
+           AP1 : ACC_PTR := NEW ARR_PTR'(1..8 => NEW INTEGER'(0));
+           AV1 : ACC_PVT := NEW ARR_PVT'(1..8 => PACK1.ZERO);
+           AT1 : ACC_TSK := NEW ARR_TSK(1..8);
+ 
+           XRI1 : INTEGER RENAMES AREC.RI1;
+           XRA1 : ARRAY1 RENAMES AREC.RA1;
+           XRR1 : RECORD1 RENAMES AREC.RR1;
+           XRP1 : POINTER1 RENAMES AREC.RP1;
+           XRV1 : PACK1.PRIVY RENAMES AREC.RV1;
+           XRT1 : TASK1 RENAMES AREC.RT1;
+           XAI1 : ARR_INT RENAMES AI1(1..3);
+           XAA1 : ARR_ARR RENAMES AA1(2..4);
+           XAR1 : ARR_REC RENAMES AR1(3..5);
+           XAP1 : ARR_PTR RENAMES AP1(4..6);
+           XAV1 : ARR_PVT RENAMES AV1(5..7);
+           XAT1 : ARR_TSK RENAMES AT1(6..8);
+ 
+           TASK TYPE TASK2 IS
+                ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                              TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                              TRV1 : IN OUT PACK1.PRIVY;
+                              TRT1 : IN OUT TASK1;
+                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                              TAV1 : IN OUT ARR_PVT;
+                              TAT1 : IN OUT ARR_TSK);
+           END TASK2;
+ 
+           I : INTEGER;
+           CHK_TASK : TASK2;
+ 
+           PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                            PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                            PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                            PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                            PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                            PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+           BEGIN
+                PRI1 := PRI1 + 1;
+                PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+                PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+                PRP1 := NEW INTEGER'(AREC.RP1.ALL + 1);
+                PRV1 := PACK1.NEXT(AREC.RV1);
+                PRT1.NEXT;
+                PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+                PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+                PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                    (PAR1(PAR1'FIRST).FIELD1 + 1)));
+                PAP1 := (OTHERS =>
+                         NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+                FOR J IN PAV1'RANGE LOOP
+                     PAV1(J) := PACK1.NEXT(AV1(J));
+                END LOOP;
+                FOR J IN PAT1'RANGE LOOP
+                     PAT1(J).NEXT;
+                END LOOP;
+           END PROC1;
+ 
+           TASK BODY TASK2 IS
+           BEGIN
+                ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                               TRR1 : OUT RECORD1;
+                               TRP1 : IN OUT POINTER1;
+                               TRV1 : IN OUT PACK1.PRIVY;
+                               TRT1: IN OUT TASK1;
+                               TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                               TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                               TAV1 : IN OUT ARR_PVT;
+                               TAT1 : IN OUT ARR_TSK)
+                DO
+                     TRI1 := AREC.RI1 + 1;
+                     TRA1 := (AREC.RA1(1)+1, AREC.RA1(2)+1,
+                              AREC.RA1(3)+1);
+                     TRR1 := (D => 1, FIELD1 => AREC.RR1.FIELD1 + 1);
+                     TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                     TRV1 := PACK1.NEXT(TRV1);
+                     TRT1.NEXT;
+                     TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                     TAA1 := (OTHERS => (OTHERS =>
+                                         AA1(TAA1'FIRST)(1) + 1));
+                     TAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                         (AR1(TAR1'FIRST).FIELD1 + 1)));
+                     TAP1 := (OTHERS =>
+                              NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+                     FOR J IN TAV1'RANGE LOOP
+                          TAV1(J) := PACK1.NEXT(TAV1(J));
+                     END LOOP;
+                     FOR J IN TAT1'RANGE LOOP
+                          TAT1(J).NEXT;
+                     END LOOP;
+                END ENTRY1;
+           END TASK2;
+ 
+           PACKAGE GENPACK2 IS NEW
+                GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+      BEGIN
+           IF XRI1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (1)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (1)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (1)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (1)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (1)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (1)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(1) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (1)");
+                END IF;
+           END LOOP;
+ 
+           PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                  XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+           IF XRI1 /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (2)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (2)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (2)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (2)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (2)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(2) THEN
+                FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (2)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (2)");
+                END IF;
+           END LOOP;
+ 
+           CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                           XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+ 
+           IF XRI1 /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (3)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (3)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (3)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (3)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (3)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(3) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (3)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (3)");
+                END IF;
+           END LOOP;
+ 
+           XRI1 := XRI1 + 1;
+           XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+           XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+           XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+           XRV1 := PACK1.NEXT(XRV1);
+           XRT1.NEXT;
+           XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+           XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+           XAR1 := (OTHERS => (D => 1,
+                               FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+           XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+           FOR J IN XAV1'RANGE LOOP
+                XAV1(J) := PACK1.NEXT(XAV1(J));
+           END LOOP;
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).NEXT;
+           END LOOP;
+ 
+           IF XRI1 /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (4)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (4)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (4)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (4)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (4)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(4) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (4)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (4)");
+                END IF;
+           END LOOP;
+ 
+           AREC.RI1 := AREC.RI1 + 1;
+           AREC.RA1 := (AREC.RA1(1)+1, AREC.RA1(2)+1, AREC.RA1(3)+1);
+           AREC.RR1 := (D => 1, FIELD1 => AREC.RR1.FIELD1 + 1);
+           AREC.RP1 := NEW INTEGER'(AREC.RP1.ALL + 1);
+           AREC.RV1 := PACK1.NEXT(AREC.RV1);
+           AREC.RT1.NEXT;
+           AI1(XAI1'RANGE) := (OTHERS => AI1(XAI1'FIRST) + 1);
+           AA1(XAA1'RANGE) := (OTHERS =>
+                         (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+           AR1(XAR1'RANGE) := (OTHERS => (D => 1,
+                         FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+           AP1(XAP1'RANGE) := (OTHERS =>
+                              NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+           FOR J IN XAV1'RANGE LOOP
+                AV1(J) := PACK1.NEXT(AV1(J));
+           END LOOP;
+           FOR J IN XAT1'RANGE LOOP
+                AT1(J).NEXT;
+           END LOOP;
+ 
+           IF XRI1 /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XRI1 (5)");
+           END IF;
+ 
+           IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XRA1 (5)");
+           END IF;
+ 
+           IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                FAILED ("INCORRECT VALUE OF XRR1 (5)");
+           END IF;
+ 
+           IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT VALUE OF XRP1 (5)");
+           END IF;
+ 
+           IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+                FAILED ("INCORRECT VALUE OF XRV1 (5)");
+           END IF;
+ 
+           XRT1.VALU(I);
+           IF I /= IDENT_INT(5) THEN
+                FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+           END IF;
+ 
+           FOR J IN XAI1'RANGE LOOP
+                IF XAI1(J) /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT VALUE OF XAI1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAA1'RANGE LOOP
+                IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
+                THEN
+                     FAILED ("INCORRECT VALUE OF XAA1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAR1'RANGE LOOP
+                IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                     FAILED ("INCORRECT VALUE OF XAR1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAP1'RANGE LOOP
+                IF XAP1(J) /= IDENT(AP1(J)) OR
+                   XAP1(J).ALL /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT VALUE OF XAP1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAV1'RANGE LOOP
+                IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+                     FAILED ("INCORRECT VALUE OF XAV1(" &
+                             INTEGER'IMAGE(J) & ") (5)");
+                END IF;
+           END LOOP;
+ 
+           FOR J IN XAT1'RANGE LOOP
+                XAT1(J).VALU(I);
+                IF I /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                             INTEGER'IMAGE(J) & ").VALU (5)");
+                END IF;
+           END LOOP;
+ 
+           AREC.RT1.STOP;
+ 
+           FOR I IN AT1'RANGE LOOP
+                AT1(I).STOP;
+           END LOOP;
+      END;
+ 
+      RESULT;
+ END C85006E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- C85006F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A RENAMED SLICE CAN BE SLICED AND INDEXED FOR PURPOSES
+ --     OF ASSIGNMENT AND TO READ THE VALUE.
+ 
+ -- HISTORY:
+ --     JET 07/26/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85006F IS
+ 
+      S : STRING(1..30) := "IT WAS A DARK AND STORMY NIGHT";
+ 
+      ADJECTIVES : STRING RENAMES S(10..24);
+ 
+ BEGIN
+      TEST ("C85006F", "CHECK THAT A RENAMED SLICE CAN BE SLICED AND " &
+                       "INDEXED FOR PURPOSES OF ASSIGNMENT AND TO " &
+                       "READ THE VALUE");
+ 
+      ADJECTIVES(19..24) := "STARRY";
+ 
+      IF ADJECTIVES /= IDENT_STR("DARK AND STARRY") THEN
+           FAILED ("INCORRECT VALUE OF SLICE AFTER ASSIGNMENT (1)");
+      END IF;
+ 
+      IF S /= IDENT_STR("IT WAS A DARK AND STARRY NIGHT") THEN
+           FAILED ("INCORRECT VALUE OF ORIGINAL STRING (1)");
+      END IF;
+ 
+      ADJECTIVES(17) := ''';
+ 
+      IF ADJECTIVES /= IDENT_STR("DARK AN' STARRY") THEN
+           FAILED ("INCORRECT VALUE OF SLICE AFTER ASSIGNMENT (2)");
+      END IF;
+ 
+      IF S /= IDENT_STR("IT WAS A DARK AN' STARRY NIGHT") THEN
+           FAILED ("INCORRECT VALUE OF ORIGINAL STRING (2)");
+      END IF;
+ 
+      IF ADJECTIVES(10..13) /= IDENT_STR("DARK") THEN
+           FAILED ("INCORRECT VALUE OF SLICE WHEN READING");
+      END IF;
+ 
+      RESULT;
+ 
+ END C85006F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85006g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85006g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C85006G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY THE TYPE MARK USED
+ --     IN THE SLICE RENAMING DECLARATION IS IGNORED, AND THAT THE
+ --     SUBTYPE CONSTRAINT ASSOCIATED WITH THE RENAMED VARIABLE IS
+ --     USED INSTEAD.
+ 
+ -- HISTORY:
+ --     JET 07/26/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85006G IS
+ 
+      SUBTYPE STR IS STRING(1..10);
+ 
+      S : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
+      T : STR := IDENT_STR("0123456789");
+ 
+      DG1 : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
+      DG2 : STR := IDENT_STR("0123456789");
+ 
+      XS : STR RENAMES S(10..24);
+      XT : STRING RENAMES T(1..5);
+ 
+      GENERIC
+           G1 : IN OUT STR;
+           G2 : IN OUT STRING;
+      PACKAGE GEN IS
+           XG1 : STR RENAMES G1(10..24);
+           XG2 : STRING RENAMES G2(1..5);
+      END GEN;
+ 
+      PACKAGE PACK IS NEW GEN(DG1, DG2);
+      USE PACK;
+ 
+ BEGIN
+      TEST ("C85006G", "CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY " &
+                       "THE TYPE MARK USED IN THE SLICE RENAMING " &
+                       "DECLARATION IS IGNORED, AND THAT THE SUBTYPE " &
+                       "CONSTRAINT ASSOCIATED WITH THE RENAMED " &
+                       "VARIABLE IS USED INSTEAD");
+ 
+      IF XS'FIRST /= IDENT_INT(10) OR
+         XS'LAST /= IDENT_INT(24) OR
+         XS'LENGTH /= IDENT_INT(15) THEN
+           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 1");
+      END IF;
+ 
+      IF XS /= "DARK AND STORMY" THEN
+           FAILED("INCORRECT VALUE OF RENAMING SLICE - 1");
+      END IF;
+ 
+      XS := IDENT_STR("STORMY AND DARK");
+ 
+      IF S /= "IT WAS A STORMY AND DARK NIGHT" THEN
+           FAILED("INCORRECT VALUE OF ORIGINAL STRING - 1");
+      END IF;
+ 
+      IF XT'FIRST /= IDENT_INT(1) OR
+         XT'LAST /= IDENT_INT(5) OR
+         XT'LENGTH /= IDENT_INT(5) THEN
+           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 2");
+      END IF;
+ 
+      IF XT /= "01234" THEN
+           FAILED("INCORRECT VALUE OF RENAMING SLICE - 2");
+      END IF;
+ 
+      XT := IDENT_STR("43210");
+ 
+      IF T /= "4321056789" THEN
+           FAILED("INCORRECT VALUE OF ORIGINAL STRING - 2");
+      END IF;
+ 
+      IF XG1'FIRST /= IDENT_INT(10) OR
+         XG1'LAST /= IDENT_INT(24) OR
+         XG1'LENGTH /= IDENT_INT(15) THEN
+           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G1");
+      END IF;
+ 
+      IF XG1 /= "DARK AND STORMY" THEN
+           FAILED("INCORRECT VALUE OF RENAMING SLICE - G1");
+      END IF;
+ 
+      XG1 := IDENT_STR("STORMY AND DARK");
+ 
+      IF DG1 /= "IT WAS A STORMY AND DARK NIGHT" THEN
+           FAILED("INCORRECT VALUE OF ORIGINAL STRING - G1");
+      END IF;
+ 
+      IF XG2'FIRST /= IDENT_INT(1) OR
+         XG2'LAST /= IDENT_INT(5) OR
+         XG2'LENGTH /= IDENT_INT(5) THEN
+           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G2");
+      END IF;
+ 
+      IF XG2 /= "01234" THEN
+           FAILED("INCORRECT VALUE OF RENAMING SLICE - G2");
+      END IF;
+ 
+      XG2 := IDENT_STR("43210");
+ 
+      IF DG2 /= "4321056789" THEN
+           FAILED("INCORRECT VALUE OF ORIGINAL STRING - G2");
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED("UNEXPECTED EXCEPTION RAISED");
+           RESULT;
+ END C85006G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- C85007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE DISCRIMINANTS OF A RENAMED OUT FORMAL PARAMETER, AS
+ -- WELL AS THE DISCRIMINANTS OF THE RENAMED SUBCOMPONENTS OF AN OUT
+ -- FORMAL PARAMETER, MAY BE READ INSIDE THE PROCEDURE.
+ 
+ -- SPS 02/17/84 (SEE C62006A-B.ADA)
+ -- EG  02/21/84
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C85007A IS
+ 
+ BEGIN
+ 
+      TEST ("C85007A", "CHECK THAT THE DISCRIMINANTS OF A RENAMED OUT " &
+            "FORMAL PARAMETER CAN BE READ INSIDE THE PROCEDURE");
+ 
+      DECLARE
+ 
+           TYPE R1 (D1 : INTEGER) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           TYPE R2 (D2 : POSITIVE) IS RECORD
+                C : R1 (2);
+           END RECORD;
+ 
+           SUBTYPE R1_2 IS R1(2);
+ 
+           R : R2 (5);
+ 
+           PROCEDURE PROC (REC : OUT R2) IS
+ 
+                REC1 : R2   RENAMES REC;
+                REC2 : R1_2 RENAMES REC.C;
+                REC3 : R2   RENAMES REC1;
+                REC4 : R1_2 RENAMES REC1.C;
+                REC5 : R1_2 RENAMES REC4;
+ 
+           BEGIN
+ 
+                IF REC1.D2 /= 5 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
+                             " A RENAMED OUT PARAMETER");
+                END IF;
+ 
+                IF REC1.C.D1 /= 2 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                             "OF THE SUBCOMPONENT OF A RENAMED OUT "  &
+                             "PARAMETER");
+                END IF;
+ 
+                IF REC2.D1 /= 2 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                             "OF A RENAMED SUBCOMPONENT OF AN OUT "   &
+                             "PARAMETER");
+                END IF;
+ 
+                IF REC3.D2 /= 5 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
+                             " A RENAME OF A RENAMED OUT PARAMETER");
+                END IF;
+ 
+                IF REC3.C.D1 /= 2 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                             "OF THE SUBCOMPONENT OF A RENAME OF A "  &
+                             "RENAMED OUT PARAMETER");
+                END IF;
+ 
+                IF REC4.D1 /= 2 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                             "OF A RENAMED SUBCOMPONENT OF A RENAMED" &
+                             " OUT PARAMETER");
+                END IF;
+ 
+                IF REC5.D1 /= 2 THEN
+                     FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                             "OF A RENAME OF RENAMED SUBCOMPONENT OF" &
+                             " A RENAMED OUT PARAMETER");
+                END IF;
+ 
+           END PROC;
+ 
+      BEGIN
+ 
+           PROC (R);
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C85007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85007e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85007e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85007e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85007e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C85007E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RENAMED OUT PARAMETER, OUT PARAMETER COMPONENT, OR
+ -- OUT PARAMETER SLICE CAN BE ASSIGNED TO.
+ 
+ -- EG  02/22/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C85007E IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C85007E","CHECK THAT A RENAMED OUT PARAMETER, PARAMETER " &
+                     "COMPONENT, OR PARAMETER SLICE CAN BE ASSIGNED TO");
+ 
+      DECLARE
+ 
+           TYPE AT1 IS ARRAY(1 .. 3) OF INTEGER;
+           TYPE RT (A : INTEGER) IS
+                RECORD
+                     B : AT1;
+                     C : INTEGER;
+                END RECORD;
+ 
+           A1, B1 : INTEGER;
+           A2, B2 : AT1;
+           A3, B3 : RT(1);
+ 
+           PROCEDURE PROC1 (A : OUT INTEGER;
+                            B : OUT AT1;
+                            C : OUT RT) IS
+ 
+                AA : INTEGER RENAMES A;
+                BB : AT1     RENAMES B;
+                CC : RT      RENAMES C;
+ 
+           BEGIN
+ 
+                AA := -1;
+                BB := (1 .. 3 => -2);
+                CC := (1, (2, 3, 4), 5);
+ 
+           END PROC1;
+ 
+           PROCEDURE PROC2 (X : OUT AT1;
+                            Y : OUT INTEGER;
+                            Z : OUT RT) IS
+ 
+                XX : AT1     RENAMES X;
+                YY : INTEGER RENAMES Y;
+                ZZ : RT      RENAMES Z;
+ 
+           BEGIN
+ 
+                PROC1 (YY, XX, ZZ);
+ 
+           END PROC2;
+ 
+      BEGIN
+ 
+           PROC1 (A1, A2, A3);
+           IF A1 /= IDENT_INT(-1) OR A2 /= (1 .. 3 => IDENT_INT(-2)) OR
+              A3 /= (1, (2, 3, 4), IDENT_INT(5)) THEN
+                FAILED ("CASE 1 : ERROR IN ASSIGNMENT");
+           END IF;
+ 
+           PROC2 (B2, B1, B3);
+           IF B1 /= IDENT_INT(-1) OR B2 /= (1 .. 3 => IDENT_INT(-2)) OR
+              B3 /= (1, (2, 3, 4), IDENT_INT(5)) THEN
+                FAILED ("CASE 2 : ERROR IN ASSIGNMENT");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C85007E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C85009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT PREDEFINED AND USER-DEFINED EXCEPTIONS CAN BE RENAMED
+ --     AND THAT HANDLERS REFERRING TO EITHER NAME ARE INVOKED WHEN THE
+ --     EXCEPTION IS RAISED, EVEN BY AN EXPLICIT 'RAISE' STATEMENT
+ --     REFERRING TO THE OTHER NAME.
+ 
+ -- HISTORY:
+ --     JET 03/24/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85009A IS
+ 
+      MY_EXCEPTION : EXCEPTION;
+ 
+      MY_EXCEPTION2 : EXCEPTION RENAMES MY_EXCEPTION;
+ 
+      CONSTRAINT_ERROR2 : EXCEPTION RENAMES CONSTRAINT_ERROR;
+ 
+      I : INTEGER := 1;
+ 
+ BEGIN
+      TEST ("C85009A", "CHECK THAT PREDEFINED AND USER-DEFINED " &
+                       "EXCEPTIONS CAN BE RENAMED AND THAT HANDLERS " &
+                       "REFERRING TO EITHER NAME ARE INVOKED WHEN " &
+                       "THE EXCEPTION IS RAISED, EVEN BY AN EXPLICIT " &
+                       "'RAISE' STATEMENT REFERRING TO THE OTHER NAME");
+ 
+      BEGIN
+           RAISE MY_EXCEPTION;
+           FAILED ("MY_EXCEPTION NOT RAISED");
+      EXCEPTION
+           WHEN MY_EXCEPTION2 =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY MY_EXCEPTION");
+      END;
+ 
+      BEGIN
+           RAISE MY_EXCEPTION2;
+           FAILED ("MY_EXCEPTION2 NOT RAISED");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY MY_EXCEPTION2");
+      END;
+ 
+      DECLARE
+           TYPE COLORS IS (RED, BLUE, YELLOW);
+           E : COLORS := RED;
+      BEGIN
+           E := COLORS'PRED(E);
+           IF NOT EQUAL(COLORS'POS(E),COLORS'POS(E)) THEN
+                COMMENT("DON'T OPTIMIZE E");
+           END IF;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED BY PRED(RED)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR2 =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY PRED(RED)");
+      END;
+ 
+      BEGIN
+           RAISE CONSTRAINT_ERROR;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR2 =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY CONSTRAINT_ERROR");
+      END;
+ 
+      BEGIN
+           RAISE CONSTRAINT_ERROR2;
+           FAILED ("CONSTRAINT_ERROR2 NOT RAISED");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY CONSTRAINT_ERROR2");
+      END;
+ 
+      RESULT;
+ END C85009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- C85011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A PACKAGE CAN BE RENAMED AND THE NEW NAME CAN APPEAR
+ --     IN A RENAMING DECLARATION, AND THAT A 'USE' CLAUSE CAN REFER TO
+ --     THE PACKAGE BY EITHER NAME, INCLUDING RENAMINGS OF GENERIC AND
+ --     NONGENERIC PACKAGES INSIDE THEMSELVES.
+ 
+ -- HISTORY:
+ --     JET 04/28/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85011A IS
+ 
+      PACKAGE PACK1 IS
+           I : NATURAL := 0;
+           PACKAGE PACKA RENAMES PACK1;
+      END PACK1;
+ 
+      GENERIC
+           TYPE T IS RANGE <>;
+      PACKAGE GPACK IS
+           J : T := T'FIRST;
+           PACKAGE PACKB RENAMES GPACK;
+      END GPACK;
+ 
+      PACKAGE PACK2 IS NEW GPACK(NATURAL);
+ 
+      PACKAGE PACK3 RENAMES PACK1;
+      PACKAGE PACK4 RENAMES PACK2;
+      PACKAGE PACK5 RENAMES PACK3;
+      PACKAGE PACK6 RENAMES PACK4;
+ 
+ BEGIN
+      TEST ("C85011A", "CHECK THAT A PACKAGE CAN BE RENAMED AND THE " &
+                       "NEW NAME CAN APPEAR IN A RENAMING " &
+                       "DECLARATION, AND THAT A 'USE' CLAUSE CAN " &
+                       "REFER TO THE PACKAGE BY EITHER NAME, " &
+                       "INCLUDING RENAMINGS OF GENERIC AND NONGENERIC " &
+                       "PACKAGES INSIDE THEMSELVES");
+ 
+      IF PACK1.I /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK1.I");
+      END IF;
+ 
+      IF PACK2.J /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK2.J");
+      END IF;
+ 
+      IF PACK3.I /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK3.I");
+      END IF;
+ 
+      IF PACK4.J /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK4.J");
+      END IF;
+ 
+      IF PACK5.I /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK5.I");
+      END IF;
+ 
+      IF PACK6.J /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK6.J");
+      END IF;
+ 
+      IF PACK1.PACKA.I /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK1.PACKA.I");
+      END IF;
+ 
+      IF PACK2.PACKB.J /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF PACK2.PACKB.J");
+      END IF;
+ 
+      DECLARE
+           USE PACK1, PACK2;
+      BEGIN
+           IF I /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF I (1)");
+           END IF;
+ 
+           IF J /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF J (1)");
+           END IF;
+      END;
+ 
+      DECLARE
+           USE PACK3, PACK4;
+      BEGIN
+           IF I /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF I (2)");
+           END IF;
+ 
+           IF J /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF J (2)");
+           END IF;
+      END;
+ 
+      DECLARE
+           USE PACK5, PACK6;
+      BEGIN
+           IF I /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF I (3)");
+           END IF;
+ 
+           IF J /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF J (3)");
+           END IF;
+      END;
+ 
+      DECLARE
+           USE PACK1.PACKA, PACK2.PACKB;
+      BEGIN
+           IF I /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF I (4)");
+           END IF;
+ 
+           IF J /= IDENT_INT(0) THEN
+                FAILED ("INCORRECT VALUE OF J (4)");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C85011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85013a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85013a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85013a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,150 ----
+ -- C85013A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT:
+ 
+ --   A) A SUBPROGRAM OR ENTRY CAN BE RENAMED WITH:
+ --        A1) DIFFERENT PARAMETER NAMES;
+ --        A2) DIFFERENT DEFAULT VALUES;
+ --        A3) DIFFERENT PARAMETERS HAVING DEFAULT VALUES;
+ --      AND THAT THE NEW NAMES/DEFAULTS ARE USED WHEN THE NEW NAME
+ --      IS USED IN A CALL.
+ 
+ --   B) FORMAL PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
+ --      FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
+ 
+ -- EG  02/22/84
+ 
+ WITH REPORT;
+ 
+ PROCEDURE C85013A IS
+ 
+      USE REPORT;
+ 
+ BEGIN
+ 
+      TEST("C85013A","CHECK THAT A SUBPROGRAM CAN BE RENAMED AND " &
+                     "THAT THE NEW NAMES/DEFAULTS ARE USED WITH "  &
+                     "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED" &
+                     " ENTITY");
+ 
+      DECLARE
+ 
+           TYPE TA IS ARRAY(1 .. 5) OF INTEGER;
+ 
+           FUNCTION PROC1 (A : INTEGER := 1;
+                           B : TA := (1 .. 5 => 1)) RETURN INTEGER;
+           FUNCTION PROCA (C : INTEGER := 1;
+                           D : TA := (1 .. 5 => 1)) RETURN INTEGER
+                           RENAMES PROC1;
+           FUNCTION PROCB (B : INTEGER := 1;
+                           A : TA := (1 .. 5 => 1)) RETURN INTEGER
+                           RENAMES PROC1;
+           FUNCTION PROCC (A : INTEGER := 2;
+                           B : TA := (1, 2, 3, 4, 5)) RETURN INTEGER
+                           RENAMES PROC1;
+           FUNCTION PROCD (C : INTEGER := 2;
+                           D : TA := (1, 2, 3, 4, 5))RETURN INTEGER
+                           RENAMES PROC1;
+ 
+           FUNCTION PROC1 (A : INTEGER := 1;
+                           B : TA := (1 .. 5 => 1)) RETURN INTEGER IS
+           BEGIN
+                FOR I IN 1 .. 5 LOOP
+                     IF A = B(I) THEN
+                          RETURN I;
+                     END IF;
+                END LOOP;
+                RETURN 0;
+           END PROC1;
+ 
+      BEGIN
+ 
+           IF PROC1 /= 1 THEN
+                FAILED ("CASE A : PARAMETERS NOT PROPERLY INITIALIZED");
+           END IF;
+           IF PROC1(A => 2) /= 0 THEN
+                FAILED ("CASE A : INCORRECT RESULT");
+           END IF;
+           IF PROCA /= 1 THEN
+                FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
+           END IF;
+           IF PROCA(D => (5, 4, 3, 2, 1)) /= 5 THEN
+                FAILED ("CASE A1 : INCORRECT RESULT");
+           END IF;
+           IF PROCB /= 1 THEN
+                FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
+           END IF;
+           IF PROCB(A => (5, 4, 3, 2, 1), B => 2) /= 4 THEN
+                FAILED ("CASE A1 : INCORRECT RESULT ");
+           END IF;
+           IF PROCC /= 2 THEN
+                FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
+           END IF;
+           IF PROCC(3) /= 3 THEN
+                FAILED ("CASE A2 : INCORRECT RESULT ");
+           END IF;
+           IF PROCD /= 2 THEN
+                FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
+           END IF;
+           IF PROCD(4) /= 4 THEN
+                FAILED ("CASE A2 : INCORRECT RESULT ");
+           END IF;
+ 
+      END;
+ 
+      DECLARE
+ 
+           TYPE TA IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           SUBTYPE STA1 IS TA(1 .. 5);
+           SUBTYPE STA2 IS TA(11 .. 15);
+ 
+           PROCEDURE PROC1 (A : STA1;
+                            ID : STRING);
+           PROCEDURE PROC2 (A : STA2;
+                            ID : STRING) RENAMES PROC1;
+ 
+           PROCEDURE PROC1 (A : STA1;
+                            ID : STRING) IS
+           BEGIN
+                IF A'FIRST /= IDENT_INT(1) THEN
+                     FAILED ("CASE B : INCORRECT LOWER BOUND " &
+                             "GENERATED BY " & ID);
+                END IF;
+                IF A'LAST /= IDENT_INT(5) THEN
+                     FAILED ("CASE B : INCORRECT UPPER BOUND " &
+                             "GENERATED BY " & ID);
+                END IF;
+           END PROC1;
+ 
+      BEGIN
+ 
+           PROC1 ((1, 2, 3, 4, 5),"PROC1");
+           PROC2 ((6, 7, 8, 9, 10),"PROC2");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C85013A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85014a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85014a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85014a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85014a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C85014A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE NUMBER OF FORMAL PARAMETERS IS USED TO DETERMINE
+ --     WHICH SUBPROGRAM OR ENTRY IS BEING RENAMED.
+ 
+ -- HISTORY:
+ --     JET 03/24/88  CREATED ORIGINAL TEST.
+ --     BCB 04/18/90  CORRECTED ERROR MESSAGE FOR ENTRY2.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85014A IS
+ 
+      TASK TYPE T1 IS
+           ENTRY ENTER (I1: IN OUT INTEGER);
+           ENTRY STOP;
+      END T1;
+ 
+      TASK TYPE T2 IS
+           ENTRY ENTER (I1, I2: IN OUT INTEGER);
+           ENTRY STOP;
+      END T2;
+ 
+      TASK1 : T1;
+      TASK2 : T2;
+ 
+      FUNCTION F RETURN T1 IS
+      BEGIN
+           RETURN TASK1;
+      END F;
+ 
+      FUNCTION F RETURN T2 IS
+      BEGIN
+           RETURN TASK2;
+      END F;
+ 
+      PROCEDURE PROC (I1: IN OUT INTEGER) IS
+      BEGIN
+           I1 := I1 + 1;
+      END PROC;
+ 
+      PROCEDURE PROC (I1, I2: IN OUT INTEGER) IS
+      BEGIN
+           I1 := I1 + 2;
+           I2 := I2 + 2;
+      END PROC;
+ 
+      TASK BODY T1 IS
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ENTER (I1 : IN OUT INTEGER) DO
+                          I1 := I1 + 1;
+                     END ENTER;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END T1;
+ 
+      TASK BODY T2 IS
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ENTER (I1, I2 : IN OUT INTEGER) DO
+                          I1 := I1 + 2;
+                          I2 := I2 + 2;
+                     END ENTER;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END T2;
+ 
+ BEGIN
+      TEST ("C85014A", "CHECK THAT THE NUMBER OF FORMAL PARAMETERS IS " &
+                       "USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY " &
+                       "IS BEING RENAMED");
+ 
+      DECLARE
+           PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC;
+           PROCEDURE PROC2 (J1, J2: IN OUT INTEGER) RENAMES PROC;
+ 
+           PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER;
+           PROCEDURE ENTRY2 (J1, J2: IN OUT INTEGER) RENAMES F.ENTER;
+ 
+           K1, K2 : INTEGER := 0;
+      BEGIN
+           PROC1(K1);
+           IF K1 /= IDENT_INT(1) THEN
+                FAILED("INCORRECT RETURN VALUE FROM PROC1");
+           END IF;
+ 
+           ENTRY1(K2);
+           IF K2 /= IDENT_INT(1) THEN
+                FAILED("INCORRECT RETURN VALUE FROM ENTRY1");
+           END IF;
+ 
+           PROC2(K1, K2);
+           IF K1 /= IDENT_INT(3) OR K2 /= IDENT_INT(3) THEN
+                FAILED("INCORRECT RETURN VALUE FROM PROC2");
+           END IF;
+ 
+           ENTRY2(K1, K2);
+           IF K1 /= IDENT_INT(5) OR K2 /= IDENT_INT(5) THEN
+                FAILED("INCORRECT RETURN VALUE FROM ENTRY2");
+           END IF;
+      END;
+ 
+      TASK1.STOP;
+      TASK2.STOP;
+ 
+      RESULT;
+ END C85014A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85014b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85014b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85014b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85014b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,192 ----
+ -- C85014B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE BASE TYPE OF THE FORMAL PARAMETER AND THE RESULT
+ --     TYPE ARE USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING
+ --     RENAMED.
+ 
+ -- HISTORY:
+ --     JET 03/24/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85014B IS
+ 
+      TYPE INT IS NEW INTEGER;
+      SUBTYPE SUBINT0 IS INT RANGE 0..INT'LAST;
+      SUBTYPE SUBINT1 IS INT RANGE 1..INT'LAST;
+ 
+      TASK TYPE T1 IS
+           ENTRY ENTER (I1: IN OUT INTEGER);
+           ENTRY STOP;
+      END T1;
+ 
+      TASK TYPE T2 IS
+           ENTRY ENTER (I1: IN OUT INT);
+           ENTRY STOP;
+      END T2;
+ 
+      TASK1 : T1;
+      TASK2 : T2;
+ 
+      FUNCTION F RETURN T1 IS
+      BEGIN
+           RETURN TASK1;
+      END F;
+ 
+      FUNCTION F RETURN T2 IS
+      BEGIN
+           RETURN TASK2;
+      END F;
+ 
+      PROCEDURE PROC (I1: IN OUT INTEGER) IS
+      BEGIN
+           I1 := I1 + 1;
+      END PROC;
+ 
+      PROCEDURE PROC (I1: IN OUT INT) IS
+      BEGIN
+           I1 := I1 + 2;
+      END PROC;
+ 
+      FUNCTION FUNK (I1: INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN I1 + 1;
+      END FUNK;
+ 
+      FUNCTION FUNK (I1: INTEGER) RETURN INT IS
+      BEGIN
+           RETURN INT(I1) + 2;
+      END FUNK;
+ 
+      FUNCTION FUNKX (N : NATURAL) RETURN POSITIVE IS
+      BEGIN
+           RETURN N + 1;
+      END FUNKX;
+ 
+      FUNCTION FUNKX (N : SUBINT0) RETURN SUBINT1 IS
+      BEGIN
+           RETURN N + 2;
+      END FUNKX;
+ 
+      TASK BODY T1 IS
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ENTER (I1 : IN OUT INTEGER) DO
+                          I1 := I1 + 1;
+                     END ENTER;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END T1;
+ 
+      TASK BODY T2 IS
+           ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+      BEGIN
+           WHILE ACCEPTING_ENTRIES LOOP
+                SELECT
+                     ACCEPT ENTER (I1 : IN OUT INT) DO
+                          I1 := I1 + 2;
+                     END ENTER;
+                OR
+                     ACCEPT STOP DO
+                          ACCEPTING_ENTRIES := FALSE;
+                     END STOP;
+                END SELECT;
+           END LOOP;
+      END T2;
+ 
+ BEGIN
+      TEST ("C85014B", "CHECK THAT THE BASE TYPE OF THE FORMAL " &
+                       "PARAMETER AND THE RESULT TYPE ARE USED TO " &
+                       "DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING " &
+                       "RENAMED");
+ 
+      DECLARE
+           PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC;
+           PROCEDURE PROC2 (J1: IN OUT INT) RENAMES PROC;
+ 
+           FUNCTION FUNK1 (J1: INTEGER) RETURN INTEGER RENAMES FUNK;
+           FUNCTION FUNK2 (J1: INTEGER) RETURN INT RENAMES FUNK;
+ 
+           PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER;
+           PROCEDURE ENTRY2 (J1: IN OUT INT) RENAMES F.ENTER;
+ 
+           FUNCTION FUNK3 (J1: POSITIVE) RETURN NATURAL RENAMES FUNKX;
+           FUNCTION FUNK4 (J1: SUBINT1) RETURN SUBINT0 RENAMES FUNKX;
+ 
+           K1 : INTEGER := 0;
+           K2 : INT := 0;
+      BEGIN
+           PROC1(K1);
+           IF K1 /= IDENT_INT(1) THEN
+                FAILED("INCORRECT RETURN VALUE FROM PROC1");
+           END IF;
+ 
+           K1 := FUNK1(K1);
+           IF K1 /= IDENT_INT(2) THEN
+                FAILED("INCORRECT RETURN VALUE FROM FUNK1");
+           END IF;
+ 
+           ENTRY1(K1);
+           IF K1 /= IDENT_INT(3) THEN
+                FAILED("INCORRECT RETURN VALUE FROM ENTRY1");
+           END IF;
+ 
+           K1 := FUNK3(K1);
+           IF K1 /= IDENT_INT(4) THEN
+                FAILED("INCORRECT RETURN VALUE FROM FUNK3");
+           END IF;
+ 
+           PROC2(K2);
+           IF INTEGER(K2) /= IDENT_INT(2) THEN
+                FAILED("INCORRECT RETURN VALUE FROM PROC2");
+           END IF;
+ 
+           K2 := FUNK2(INTEGER(K2));
+           IF INTEGER(K2) /= IDENT_INT(4) THEN
+                FAILED("INCORRECT RETURN VALUE FROM FUNK2");
+           END IF;
+ 
+           ENTRY2(K2);
+           IF INTEGER(K2) /= IDENT_INT(6) THEN
+                FAILED("INCORRECT RETURN VALUE FROM ENTRY2");
+           END IF;
+ 
+           K2 := FUNK4(K2);
+           IF INTEGER(K2) /= IDENT_INT(8) THEN
+                FAILED("INCORRECT RETURN VALUE FROM FUNK4");
+           END IF;
+      END;
+ 
+      TASK1.STOP;
+      TASK2.STOP;
+ 
+      RESULT;
+ END C85014B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85014c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85014c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85014c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85014c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- C85014C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE PRESENCE OR ABSENCE OF A RESULT TYPE IS USED TO
+ --     DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING RENAMED.
+ 
+ -- HISTORY:
+ --     JET 03/24/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85014C IS
+ 
+      I, J : INTEGER;
+ 
+      TASK TYPE T IS
+           ENTRY Q (I1 : INTEGER);
+      END T;
+ 
+      TASK0 : T;
+ 
+      PACKAGE FUNC IS
+           FUNCTION Q (I1 : INTEGER) RETURN INTEGER;
+           FUNCTION FUNC RETURN T;
+      END FUNC;
+      USE FUNC;
+ 
+      PROCEDURE PROC (I1: INTEGER) IS
+      BEGIN
+           I := I1;
+      END PROC;
+ 
+      FUNCTION PROC (I1: INTEGER) RETURN INTEGER IS
+      BEGIN
+           I := I1 + 1;
+           RETURN 0;
+      END PROC;
+ 
+      TASK BODY T IS
+      BEGIN
+           ACCEPT Q (I1 : INTEGER) DO
+                I := I1;
+           END Q;
+      END T;
+ 
+      PACKAGE BODY FUNC IS
+           FUNCTION Q (I1 : INTEGER) RETURN INTEGER IS
+           BEGIN
+                I := I1 + 1;
+                RETURN 0;
+           END Q;
+ 
+           FUNCTION FUNC RETURN T IS
+           BEGIN
+                RETURN TASK0;
+           END FUNC;
+      END FUNC;
+ 
+ BEGIN
+      TEST ("C85014C", "CHECK THAT THE PRESENCE OR ABSENCE OF A " &
+                       "RESULT TYPE IS USED TO DETERMINE WHICH " &
+                       "SUBPROGRAM OR ENTRY IS BEING RENAMED");
+ 
+      DECLARE
+           PROCEDURE PROC1 (J1: INTEGER) RENAMES PROC;
+ 
+           FUNCTION PROC2 (J1: INTEGER) RETURN INTEGER RENAMES PROC;
+      BEGIN
+           PROC1(1);
+           IF I /= IDENT_INT(1) THEN
+                FAILED("INCORRECT VALUE OF I AFTER PROC1");
+           END IF;
+ 
+           J := PROC2(1);
+           IF I /= IDENT_INT(2) THEN
+                FAILED("INCORRECT VALUE OF I AFTER PROC2");
+           END IF;
+      END;
+ 
+      DECLARE
+           PROCEDURE FUNC1 (J1 : INTEGER) RENAMES FUNC.FUNC.Q;
+ 
+           FUNCTION FUNC2 (J1 : INTEGER) RETURN INTEGER RENAMES FUNC.Q;
+      BEGIN
+           FUNC1(1);
+           IF I /= IDENT_INT(1) THEN
+                FAILED("INCORRECT VALUE OF I AFTER FUNC1");
+           END IF;
+ 
+           J := FUNC2(1);
+           IF I /= IDENT_INT(2) THEN
+                FAILED("INCORRECT VALUE OF I AFTER FUNC2");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C85014C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85017a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85017a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85017a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85017a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,61 ----
+ -- C85017A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT RENAMING A PREDEFINED OPERATION WITH AN IDENTIFIER
+ --     AND THEN RENAMING THE IDENTIFIER AS AN OPERATOR SYMBOL ALLOWS THE
+ --     NEW NAME TO BE USED IN A STATIC EXPRESSION.
+ 
+ -- HISTORY:
+ --     JET 03/24/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C85017A IS
+ 
+      FUNCTION PLUS (L,R : INTEGER) RETURN INTEGER RENAMES "+";
+      FUNCTION MINUS (L,R : INTEGER) RETURN INTEGER RENAMES "-";
+ 
+      FUNCTION "-" (L,R : INTEGER) RETURN INTEGER RENAMES PLUS;
+      FUNCTION "+" (L,R : INTEGER) RETURN INTEGER RENAMES MINUS;
+ 
+      I1 : CONSTANT INTEGER := 10 + 10;
+      I2 : CONSTANT INTEGER := 10 - 10;
+ 
+      TYPE INT IS RANGE I1 .. I2;
+ BEGIN
+      TEST("C85017A","CHECK THAT RENAMING A PREDEFINED OPERATION WITH " &
+                     "AN IDENTIFIER AND THEN RENAMING THE IDENTIFIER " &
+                     "AS AN OPERATOR SYMBOL ALLOWS THE NEW NAME TO BE " &
+                     "USED IN A STATIC EXPRESSION");
+ 
+      IF I1 /= IDENT_INT(0) THEN
+           FAILED ("INCORRECT VALUE OF I1: " & INTEGER'IMAGE(I1));
+      END IF;
+ 
+      IF I2 /= IDENT_INT(20) THEN
+           FAILED ("INCORRECT VALUE OF I2: " & INTEGER'IMAGE(I2));
+      END IF;
+ 
+      RESULT;
+ END C85017A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85018a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85018a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85018a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85018a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,140 ----
+ -- C85018A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ENTRY FAMILY MEMBER CAN BE RENAMED WITH:
+ --           1) DIFFERENT PARAMETER NAMES;
+ --           2) DIFFERENT DEFAULT VALUES;
+ --      AND THAT THE NEW NAMES/DEFAULTS ARE USED WHEN THE NEW NAME
+ --      IS USED IN A CALL.
+ 
+ -- RJW 6/3/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C85018A IS
+ 
+ BEGIN
+ 
+      TEST( "C85018A", "CHECK THAT AN ENTRY FAMILY MEMBER CAN BE " &
+                       "RENAMED AND THAT THE NEW NAMES/DEFAULTS ARE "  &
+                       "THOSE ASSOCIATED WITH THE RENAMED ENTITY" );
+ 
+      DECLARE
+ 
+           RESULTS : INTEGER;
+ 
+           TYPE TA IS ARRAY(1 .. 5) OF INTEGER;
+ 
+           TASK T IS 
+                ENTRY ENT1 (BOOLEAN)
+                     (A : INTEGER := 1; B : TA := (1 .. 5 => 1));
+           END T;
+ 
+           PROCEDURE ENTA (C : INTEGER := 1; D : TA := (1 .. 5 => 1))
+                           RENAMES T.ENT1 (TRUE);
+ 
+           PROCEDURE ENTB (B : INTEGER := 1; A : TA := (1 .. 5 => 1))
+                           RENAMES T.ENT1 (TRUE);
+ 
+           PROCEDURE ENTC (A : INTEGER := 2; B : TA := (1, 2, 3, 4, 5))
+                           RENAMES T.ENT1 (TRUE);
+ 
+           PROCEDURE ENTD (C : INTEGER := 2; D : TA := (1, 2, 3, 4, 5))
+                           RENAMES T.ENT1 (TRUE);
+ 
+           TASK BODY T IS 
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT ENT1 (IDENT_BOOL (TRUE)) 
+                                      (A : INTEGER := 1; 
+                                       B : TA := (1 .. 5 => 1)) DO
+                               IF A IN 1 .. 5 THEN
+                                    RESULTS := B(A);
+                               ELSE
+                                    RESULTS := 0;
+                               END IF;
+                          END;
+                     OR 
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+ 
+      BEGIN
+ 
+           T.ENT1 (TRUE);
+           IF RESULTS /= 1 THEN
+                FAILED ( "PARAMETERS NOT PROPERLY INITIALIZED" );
+           END IF;
+ 
+           T.ENT1 (TRUE) (A => 6);
+           IF RESULTS /= 0 THEN
+                FAILED ( "INCORRECT RESULTS" );
+           END IF;
+ 
+           ENTA;
+           IF RESULTS /= 1 THEN
+                FAILED ( "CASE 1 : INCORRECT RESULTS (DEFAULT)" );
+           END IF;
+ 
+           ENTA(D => (5, 4, 3, 2, 1));
+           IF RESULTS /= 5 THEN
+                FAILED ( "CASE 1 : INCORRECT RESULTS" );
+           END IF;
+ 
+           ENTB;
+           IF RESULTS /= 1 THEN
+                FAILED ( "CASE 1 : INCORRECT RESULTS (DEFAULT)" );
+           END IF;
+ 
+           ENTB(A => (5, 4, 3, 2, 1), B => 2);
+           IF RESULTS /= 4 THEN
+                FAILED ( "CASE 1 : INCORRECT RESULTS " );
+           END IF;
+ 
+           ENTC;
+           IF RESULTS /= 2 THEN
+                FAILED ( "CASE 2 : INCORRECT RESULTS (DEFAULT)" );
+           END IF;
+ 
+           ENTC(3);
+           IF RESULTS /= 3 THEN
+                FAILED ( "CASE 2 : INCORRECT RESULTS " );
+           END IF;
+ 
+           ENTD;
+           IF RESULTS /= 2 THEN
+                FAILED ( "CASE 2 : INCORRECT RESULTS (DEFAULT)" );
+           END IF;
+ 
+           ENTD(4);
+           IF RESULTS /= 4 THEN
+                FAILED ( "CASE 2 : INCORRECT RESULTS " );
+           END IF;
+ 
+      END;
+      RESULT;
+ 
+ END C85018A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85018b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85018b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85018b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85018b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,288 ----
+ -- C85018B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WHEN AN ENTRY FAMILY MEMBER IS RENAMED THE FORMAL
+ --     PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
+ --     FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
+ 
+ -- HISTORY:
+ --     RJW 06/03/86 CREATED ORIGINAL TEST.
+ --     DHH 10/15/87 CORRECTED RANGE ERRORS.
+ --     GJD 11/15/95 REMOVED ADA 95 INCOMPATIBILITY (INDEX CONSTRAINT).
+ --     PWN 10/24/96 RESTORED CHECKS WITH ADA 95 RESULTS NOW EXPECTED.
+ --     PWN 12/11/96 ADJUSTED VALUES FOR ADA 95 COMPATIBILITY.
+ --     PWB.CTA 2/17/97 CHANGED CALL TO ENT2 TO NOT EXPECT EXCEPTION
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C85018B IS
+ 
+ BEGIN
+ 
+      TEST( "C85018B", "CHECK THAT WHEN AN ENTRY FAMILY MEMBER IS " &
+                       "RENAMED THE FORMAL PARAMETER CONSTRAINTS "  &
+                       "FOR THE NEW NAME ARE IGNORED IN FAVOR OF " &
+                       "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED " &
+                       "ENTITY" );
+ 
+      DECLARE
+           TYPE INT IS RANGE 1 .. 10;
+           SUBTYPE INT1 IS INT RANGE 1 .. 5;
+           SUBTYPE INT2 IS INT RANGE 6 .. 10;
+ 
+           OBJ1 : INT1 := 5;
+           OBJ2 : INT2 := 6;
+ 
+           SUBTYPE SHORTCHAR IS CHARACTER RANGE 'A' .. 'C';
+ 
+           TASK T IS
+                ENTRY ENT1 (SHORTCHAR)
+                     (A : INT1; OK : BOOLEAN);
+           END T;
+ 
+           PROCEDURE ENT2 (A : INT2; OK : BOOLEAN)
+                RENAMES T.ENT1 ('C');
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT ENT1 ('C')
+                                      (A : INT1; OK : BOOLEAN) DO
+                               IF NOT OK THEN
+                                    FAILED ( "WRONG CALL EXECUTED " &
+                                             "WITH INTEGER TYPE" );
+                               END IF;
+                          END;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+      BEGIN
+           BEGIN
+                ENT2 (OBJ1, TRUE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR  =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                              "INTEGER TYPE" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "INTEGER TYPE - 1" );
+           END;
+ 
+           BEGIN
+                ENT2 (OBJ2, TRUE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "INTEGER TYPE - 2" );
+           END;
+      END;
+ 
+      DECLARE
+           TYPE REAL IS DIGITS 3;
+           SUBTYPE REAL1 IS REAL RANGE -2.0 .. 0.0;
+           SUBTYPE REAL2 IS REAL RANGE  0.0 .. 2.0;
+ 
+           OBJ1 : REAL1 := -0.25;
+           OBJ2 : REAL2 :=  0.25;
+ 
+           SUBTYPE SHORTINT IS INTEGER RANGE 9 .. 11;
+ 
+           TASK T IS
+                ENTRY ENT1 (SHORTINT)
+                     (A : REAL1; OK : BOOLEAN);
+           END T;
+ 
+           PROCEDURE ENT2 (A : REAL2; OK : BOOLEAN)
+                RENAMES T.ENT1 (10);
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT ENT1 (10)
+                                      (A : REAL1; OK : BOOLEAN) DO
+                               IF NOT OK THEN
+                                    FAILED ( "WRONG CALL EXECUTED " &
+                                             "WITH FLOATING POINT " &
+                                             "TYPE" );
+                               END IF;
+                          END;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+      BEGIN
+           BEGIN
+                ENT2 (OBJ1, TRUE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR  =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                              "FLOATING POINT " &
+                              "TYPE" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "FLOATING POINT " &
+                              "TYPE - 1" );
+           END;
+ 
+           BEGIN
+                ENT2 (OBJ2, FALSE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "FLOATING POINT " &
+                              "TYPE - 2" );
+           END;
+      END;
+ 
+      DECLARE
+           TYPE COLOR IS (RED, YELLOW, BLUE, GREEN);
+ 
+           TYPE FIXED IS DELTA  0.125 RANGE -1.0 .. 1.0;
+           SUBTYPE FIXED1 IS FIXED RANGE  0.0 .. 0.5;
+           SUBTYPE FIXED2 IS FIXED RANGE -0.5 .. 0.0;
+ 
+           OBJ1 : FIXED1 :=  0.125;
+           OBJ2 : FIXED2 := -0.125;
+ 
+           TASK T IS
+                ENTRY ENT1 (COLOR)
+                     (A : FIXED1; OK : BOOLEAN);
+           END T;
+ 
+           PROCEDURE ENT2 (A : FIXED2; OK : BOOLEAN)
+                RENAMES T.ENT1 (BLUE);
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT ENT1 (BLUE)
+                                      (A : FIXED1; OK : BOOLEAN) DO
+                               IF NOT OK THEN
+                                    FAILED ( "WRONG CALL EXECUTED " &
+                                             "WITH FIXED POINT " &
+                                             "TYPE" );
+                               END IF;
+                          END;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+      BEGIN
+           BEGIN
+                ENT2 (OBJ1, TRUE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR  =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                              "FIXED POINT " &
+                              "TYPE" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "FIXED POINT " &
+                              "TYPE - 1" );
+           END;
+ 
+           BEGIN
+                ENT2 (OBJ2, FALSE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "FIXED POINT " &
+                              "TYPE - 2" );
+           END;
+      END;
+ 
+      DECLARE
+           TYPE TA IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+           SUBTYPE STA1 IS TA(1 .. 5);
+           SUBTYPE STA2 IS TA(6 .. 10);
+ 
+           OBJ1 : STA1 := (1, 2, 3, 4, 5);
+           OBJ2 : STA2 := (6, 7, 8, 9, 10);
+ 
+           TASK T IS
+                ENTRY ENT1 (BOOLEAN)
+                     (A : STA1; OK : BOOLEAN);
+           END T;
+ 
+           PROCEDURE ENT2 (A : STA2; OK : BOOLEAN)
+                RENAMES T.ENT1 (FALSE);
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT ENT1 (FALSE)
+                                      (A : STA1; OK : BOOLEAN) DO
+                               IF NOT OK THEN
+                                    FAILED ( "WRONG CALL EXECUTED " &
+                                             "WITH CONSTRAINED " &
+                                             "ARRAY" );
+                               END IF;
+                          END;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+      BEGIN
+           BEGIN
+                ENT2 (OBJ1, TRUE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR  =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                              "CONSTRAINED ARRAY" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "CONSTRAINED ARRAY - 1" );
+           END;
+ 
+           BEGIN
+                ENT2 (OBJ2, TRUE);
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                              "CONSTRAINED ARRAY" );
+                WHEN OTHERS =>
+                     FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                              "CONSTRAINED ARRAY - 2" );
+           END;
+      END;
+ 
+      RESULT;
+ 
+ END C85018B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85019a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85019a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c85019a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c85019a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- C85019A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CHARACTER OR OTHER ENUMERATION LITERAL MAY BE RENAMED 
+ -- AS A FUNCTION.
+ 
+ -- RJW 6/4/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C85019A IS
+ 
+ BEGIN
+ 
+      TEST( "C85019A", "CHECK THAT A CHARACTER OR OTHER ENUMERATION " &
+                       "LITERAL MAY BE RENAMED AS A FUNCTION" );
+ 
+      DECLARE
+           FUNCTION SEA RETURN CHARACTER RENAMES 'C';
+ 
+           TYPE COLOR IS (RED, YELLOW, BLUE, GREEN);
+           
+           FUNCTION TEAL RETURN COLOR RENAMES BLUE;
+ 
+      BEGIN
+           IF SEA /= 'C' THEN
+                FAILED ( "SEA IS NOT EQUAL TO 'C'" );
+           END IF;
+ 
+           IF TEAL /= BLUE THEN
+                FAILED ( "TEAL IS NOT EQUAL TO BLUE" );
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C85019A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c854001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c854001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c854001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c854001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,277 ----
+ -- C854001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a subprogram declaration can be completed by a
+ --      subprogram renaming declaration. In particular, check that such a
+ --      renaming-as-body can be given in a package body to complete a
+ --      subprogram declared in the package specification. Check that calls
+ --      to the subprogram invoke the body of the renamed subprogram.  Check
+ --      that a renaming allows a copy of an inherited or predefined subprogram
+ --      before overriding it later.  Check that renaming a dispatching 
+ --      operation calls the correct body in case of overriding.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares a record type, an integer type, and a tagged type
+ --      with a set of operations in a package. A renaming of a predefined 
+ --      equality operation of a tagged type is also defined in this package.
+ --      The predefined operation is overridden in the private part. In a 
+ --      separate package, a subtype of the record type and integer type 
+ --      are declared.  Subset of the full set of operations for the record 
+ --      and types is reexported using renamings-as-bodies. Other operations 
+ --      are given explicit bodies.  The test verifies that the appropriate 
+ --      body is executed for each operation on the subtype.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      07 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --
+ --!
+ 
+ package C854001_0 is
+ 
+    type Component is (Op_Of_Type, Op_Of_Subtype, Initial_Value);
+ 
+    type Root is record
+       Called : Component := Op_Of_Subtype;
+    end record;
+ 
+    procedure Root_Proc (P: in out Root);
+    procedure Over_Proc (P: in out Root);
+ 
+    function Root_Func return Root;
+    function Over_Func return Root;
+ 
+    type Short_Int is range 1 .. 98;
+ 
+    function "+" (P1, P2 : Short_Int) return Short_Int;
+    function Name (P1, P2 : Short_Int) return Short_Int;
+ 
+    type Tag_Type is tagged record
+       C : Component := Initial_Value;
+    end record;
+    -- Inherits predefined operator "=" and others.
+ 
+    function Predefined_Equal (P1, P2 : Tag_Type) return Boolean
+      renames "=";             
+    -- Renames predefined operator "=" before overriding.
+ 
+ private
+    function "=" (P1, P2 : Tag_Type) 
+      return Boolean;                   -- Overrides predefined operator "=".
+ 
+ 
+ end C854001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C854001_0 is
+ 
+    procedure Root_Proc (P: in out Root) is
+    begin
+       P.Called := Initial_Value;
+    end Root_Proc;
+ 
+    ---------------------------------------
+    procedure Over_Proc (P: in out Root) is
+    begin
+       P.Called := Op_Of_Type;
+    end Over_Proc;
+ 
+    ---------------------------------------
+    function Root_Func return Root is
+    begin
+       return (Called => Op_Of_Type);
+    end Root_Func;
+  
+    ---------------------------------------
+    function Over_Func return Root is
+    begin
+       return (Called => Initial_Value);
+    end Over_Func;
+ 
+    ---------------------------------------
+    function "+" (P1, P2 : Short_Int) return Short_Int is
+    begin
+       return 15;
+    end "+";
+ 
+    ---------------------------------------
+    function Name (P1, P2 : Short_Int) return Short_Int is
+    begin
+       return 47;
+    end Name;
+ 
+    ---------------------------------------
+    function "=" (P1, P2 : Tag_Type) return Boolean is
+    begin
+       return False;
+    end "=";
+ 
+ end C854001_0;
+ 
+      --==================================================================--
+ 
+ 
+ with C854001_0;
+ package C854001_1 is
+ 
+    subtype Root_Subtype is C854001_0.Root;
+    subtype Short_Int_Subtype is C854001_0.Short_Int;
+    
+    procedure Ren_Proc  (P: in out Root_Subtype);       
+    procedure Same_Proc (P: in out Root_Subtype);       
+ 
+    function Ren_Func  return Root_Subtype;             
+    function Same_Func return Root_Subtype;             
+ 
+    function Other_Name (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype;
+    function "-" (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype;
+ 
+    function User_Defined_Equal (P1, P2 : C854001_0.Tag_Type) return Boolean 
+      renames C854001_0."=";                       -- Executes body of the
+                                                   -- overriding declaration in
+                                                   -- the private part.
+ end C854001_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with C854001_0;
+ package body C854001_1 is
+ 
+    --
+    -- Renaming-as-body for procedure:
+    --
+ 
+    procedure Ren_Proc  (P: in out Root_Subtype)  
+      renames C854001_0.Root_Proc;
+    procedure Same_Proc (P: in out Root_Subtype) 
+      renames C854001_0.Over_Proc;
+ 
+    --
+    -- Renaming-as-body for function:
+    --
+ 
+    function Ren_Func  return Root_Subtype renames C854001_0.Root_Func;
+    function Same_Func return Root_Subtype renames C854001_0.Over_Func;
+  
+    function Other_Name (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype
+      renames C854001_0."+";
+    function "-" (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype 
+      renames C854001_0.Name;
+ 
+ end C854001_1;
+ 
+ 
+      --==================================================================--
+ 
+ with C854001_0;
+ with C854001_1;  -- Subtype and associated operations.
+ use  C854001_1;
+ 
+ with Report;
+ 
+ procedure C854001 is
+    Operand1  : Root_Subtype;
+    Operand2  : Root_Subtype;
+    Operand3  : Root_Subtype;
+    Operand4  : Root_Subtype;
+    Operand5  : Short_Int_Subtype := 55;
+    Operand6  : Short_Int_Subtype := 46;
+    Operand7  : Short_Int_Subtype;
+    Operand8  : C854001_0.Tag_Type;         -- Both Operand8 & Operand9 have
+    Operand9  : C854001_0.Tag_Type;         -- the same default values.
+ 
+    -- Direct visibility to operator symbols
+    use type C854001_0.Component;
+    use type C854001_0.Short_Int;
+ 
+ begin
+    Report.Test ("C854001", "Check that a renaming-as-body can be given " &
+                            "in a package body to complete a subprogram " &
+                            "declared in the package specification. "     &
+                            "Check that calls to the subprogram invoke "  &
+                            "the body of the renamed subprogram");
+ 
+    --
+    -- Only operations of the subtype are available.
+    --
+ 
+    Ren_Proc  (Operand1);
+    if Operand1.Called /= C854001_0.Initial_Value then
+       Report.Failed ("Error calling procedure Ren_Proc");
+    end if;
+ 
+    ---------------------------------------
+    Same_Proc (Operand2);
+    if Operand2.Called /= C854001_0.Op_Of_Type then
+       Report.Failed ("Error calling procedure Same_Proc");
+    end if;
+ 
+    ---------------------------------------
+    Operand3 := Ren_Func;
+    if Operand3.Called /= C854001_0.Op_Of_Type then
+       Report.Failed ("Error calling function Ren_Func");
+    end if;
+ 
+    ---------------------------------------
+    Operand4 := Same_Func;
+    if Operand4.Called /= C854001_0.Initial_Value then
+       Report.Failed ("Error calling function Same_Func");
+    end if;
+    
+    ---------------------------------------
+    Operand7 := C854001_1."-" (Operand5, Operand6);
+    if Operand7 /= 47 then
+       Report.Failed ("Error calling function & ""-""");
+    end if;
+ 
+    ---------------------------------------
+    Operand7 := Other_Name (Operand5, Operand6);
+    if Operand7 /= 15 then
+       Report.Failed ("Error calling function Other_Name");
+    end if;
+ 
+    ---------------------------------------
+    -- Executes body of the overriding declaration in the private part
+    -- of C854001_0.
+    if User_Defined_Equal (Operand8, Operand9) then
+       Report.Failed ("Error calling function User_Defined_Equal");
+    end if;
+ 
+    ---------------------------------------
+    -- Executes predefined operation.
+    if not C854001_0.Predefined_Equal (Operand8, Operand9) then
+       Report.Failed ("Error calling function Predefined_Equal");
+    end if;
+ 
+    Report.Result;
+ 
+ end C854001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c854002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c854002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c854002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c854002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,185 ----
+ -- C854002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE
+ --     Check the requirements of the new 8.5.4(8.A) from Technical
+ --     Corrigendum 1 (originally discussed as AI95-00064).
+ --     This paragraph requires an elaboration check on renamings-as-body:
+ --     even if the body of the ultimately-called subprogram has been
+ --     elaborated, the check should fail if the renaming-as-body
+ --     itself has not yet been elaborated.
+ --
+ -- TEST DESCRIPTION
+ --     We declare two functions F and G, and ensure that they are
+ --     elaborated before anything else, by using pragma Pure.  Then we
+ --     declare two renamings-as-body: the renaming of F is direct, and
+ --     the renaming of G is via an access-to-function object.  We call
+ --     the renamings during elaboration, and check that they raise
+ --     Program_Error.  We then call them again after elaboration; this
+ --     time, they should work.
+ --
+ -- CHANGE HISTORY:
+ --      29 JUN 1999   RAD   Initial Version
+ --      23 SEP 1999   RLB   Improved comments, renamed, issued.
+ --      28 JUN 2002   RLB   Added pragma Elaborate_All for Report.
+ --!
+ 
+ package C854002_1 is
+     pragma Pure;
+     -- Empty.
+ end C854002_1;
+ 
+ package C854002_1.Pure is
+     pragma Pure;
+     function F return String;
+     function G return String;
+ end C854002_1.Pure;
+ 
+ with C854002_1.Pure;
+ package C854002_1.Renamings is
+ 
+     F_Result: constant String := C854002_1.Pure.F; -- Make sure we can call F.
+     function Renamed_F return String;
+ 
+     G_Result: constant String := C854002_1.Pure.G;
+     type String_Function is access function return String;
+     G_Pointer: String_Function := null;
+         -- Will be set to C854002_1.Pure.G'Access in the body.
+     function Renamed_G return String;
+ 
+ end C854002_1.Renamings;
+ 
+ package C854002_1.Caller is
+ 
+     -- These procedures call the renamings; when called during elaboration,
+     -- we pass Should_Fail => True, which checks that Program_Error is
+     -- raised.  Later, we use Should_Fail => False.
+ 
+     procedure Call_Renamed_F(Should_Fail: Boolean);
+     procedure Call_Renamed_G(Should_Fail: Boolean);
+ 
+ end C854002_1.Caller;
+ 
+ with Report; use Report; pragma Elaborate_All (Report);
+ with C854002_1.Renamings;
+ package body C854002_1.Caller is
+ 
+     Some_Error: exception;
+ 
+     procedure Call_Renamed_F(Should_Fail: Boolean) is
+     begin
+         if Should_Fail then
+             begin
+                 Failed(C854002_1.Renamings.Renamed_F);
+                 raise Some_Error;
+                     -- This raise statement is necessary, because the
+                     -- Report package has a bug -- if Failed is called
+                     -- before Test, then the failure is ignored, and the
+                     -- test prints "PASSED".
+                     -- Presumably, this raise statement will cause the
+                     -- program to crash, thus avoiding the PASSED message.
+             exception
+                 when Program_Error =>
+                     Comment("Program_Error -- OK");
+             end;
+         else
+             if C854002_1.Renamings.F_Result /= C854002_1.Renamings.Renamed_F then
+                 Failed("Bad result from renamed F");
+             end if;
+         end if;
+     end Call_Renamed_F;
+ 
+     procedure Call_Renamed_G(Should_Fail: Boolean) is
+     begin
+         if Should_Fail then
+             begin
+                 Failed(C854002_1.Renamings.Renamed_G);
+                 raise Some_Error;
+             exception
+                 when Program_Error =>
+                     Comment("Program_Error -- OK");
+             end;
+         else
+             if C854002_1.Renamings.G_Result /= C854002_1.Renamings.Renamed_G then
+                 Failed("Bad result from renamed G");
+             end if;
+         end if;
+     end Call_Renamed_G;
+ 
+ begin
+     -- At this point, the bodies of Renamed_F and Renamed_G have not yet
+     -- been elaborated, so calling them should raise Program_Error:
+     Call_Renamed_F(Should_Fail => True);
+     Call_Renamed_G(Should_Fail => True);
+ end C854002_1.Caller;
+ 
+ package body C854002_1.Pure is
+ 
+     function F return String is
+     begin
+         return "This is function F";
+     end F;
+ 
+     function G return String is
+     begin
+         return "This is function G";
+     end G;
+ 
+ end C854002_1.Pure;
+ 
+ with C854002_1.Pure;
+ with C854002_1.Caller; pragma Elaborate(C854002_1.Caller);
+     -- This pragma ensures that this package body (Renamings)
+     -- will be elaborated after Caller, so that when Caller calls
+     -- the renamings during its elaboration, the renamings will
+     -- not have been elaborated (although what the rename have been).
+ package body C854002_1.Renamings is
+ 
+     function Renamed_F return String renames C854002_1.Pure.F;
+ 
+     package Dummy is end; -- So we can insert statements here.
+     package body Dummy is
+     begin
+         G_Pointer := C854002_1.Pure.G'Access;
+     end Dummy;
+ 
+     function Renamed_G return String renames G_Pointer.all;
+ 
+ end C854002_1.Renamings;
+ 
+ with Report; use Report;
+ with C854002_1.Caller;
+ procedure C854002 is
+ begin
+     Test("C854002",
+          "An elaboration check is performed for a call to a subprogram"
+          & " whose body is given as a renaming-as-body");
+ 
+     -- By the time we get here, all library units have been elaborated,
+     -- so the following calls should not raise Program_Error:
+     C854002_1.Caller.Call_Renamed_F(Should_Fail => False);
+     C854002_1.Caller.Call_Renamed_G(Should_Fail => False);
+ 
+     Result;
+ end C854002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c854003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c854003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c854003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c854003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C854003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that a renaming-as-body used before the subprogram is frozen only
+ --    requires mode conformance.  (Defect Report 8652/0028, as reflected in
+ --    Technical Corrigendum 1, RM95 8.5.4(5/1)).
+ --
+ -- CHANGE HISTORY:
+ --    29 JAN 2001   PHL   Initial version.
+ --     5 DEC 2001   RLB   Reformatted for ACATS.
+ --
+ --!
+ with Report;
+ use Report;
+ procedure C854003 is
+ 
+     package P is
+         type T is private;
+         C1 : constant T;
+         C2 : constant T;
+     private
+         type T is new Integer'Base;
+         C1 : constant T := T (Ident_Int (1));
+         C2 : constant T := T (Ident_Int (1));
+     end P;
+ 
+     function Equals (X, Y : P.T) return Boolean;
+     function Equals (X, Y : P.T) return Boolean renames P."=";
+ 
+ begin
+     Test ("C854003",
+           "Check that a renaming-as-body used before the subprogram " &
+              "is frozen only requires mode conformance");
+ 
+     if not Equals (P.C1, P.C2) then
+         Failed ("Equality returned an unexpected result");
+     end if;
+ 
+     Result;
+ end C854003;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- C86003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT  'STANDARD'  IS NOT TREATED AS A RESERVED WORD IN
+ --    SELECTED COMPONENT NAMES.
+ 
+ -- RM  01/21/80
+ -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
+ 
+ WITH REPORT ;
+ PROCEDURE  C86003A  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("C86003A" , "CHECK THAT  'STANDARD'  IS NOT TREATED AS A" &
+                       " RESERVED WORD IN SELECTED COMPONENT NAMES" );
+ 
+      DECLARE    -- A
+      BEGIN
+ 
+           DECLARE
+ 
+                PACKAGE  STANDARD  IS
+                     CHARACTER      :  BOOLEAN ;
+                     TYPE  INTEGER  IS (FALSE, TRUE) ;
+                     CONSTRAINT_ERROR :  EXCEPTION ;
+                END  STANDARD ;
+ 
+                TYPE  REC2  IS
+                     RECORD
+                          AA , BB  :  BOOLEAN  := FALSE ;
+                     END RECORD;
+ 
+                TYPE  REC1  IS
+                     RECORD
+                          STANDARD : REC2 ;
+                     END RECORD;
+ 
+                A    :  REC1 ;
+                TYPE  ASI  IS  ACCESS STANDARD.INTEGER ;
+                VASI  :  ASI ;
+                VI : INTEGER RANGE 1 .. 10;   -- THE "REAL" STANDARD
+                                              -- TYPE 'INTEGER'
+ 
+           BEGIN
+ 
+                VASI  :=  NEW STANDARD.INTEGER'(STANDARD.FALSE);
+                STANDARD.CHARACTER  :=  A.STANDARD.BB ;
+ 
+                IF  STANDARD.CHARACTER  THEN FAILED( "RES. (VAR.)" );
+                END IF;
+ 
+                VI  :=  IDENT_INT(11);   -- TO CAUSE THE "REAL"
+                                         -- (PREDEFINED) CONSTRAINT_ERROR
+                                         -- EXCEPTION.
+                IF VI /= IDENT_INT(11) THEN
+                    FAILED ("WRONG VALUE - V1");
+                ELSE
+                    FAILED ("OUT OF RANGE VALUE - V1");
+                END IF;
+           EXCEPTION
+ 
+                WHEN STANDARD.CONSTRAINT_ERROR => FAILED ("RES. (EXC.)");
+ 
+                WHEN CONSTRAINT_ERROR => NULL;
+ 
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED - A");
+ 
+           END ;
+ 
+      EXCEPTION
+ 
+           WHEN  OTHERS  =>  FAILED( "EXCEPTION RAISED BY DECL. (A)" );
+ 
+      END ;    -- A
+ 
+ 
+      DECLARE    -- B
+ 
+           TYPE  REC  IS
+                RECORD
+                     INTEGER  :  BOOLEAN  := FALSE ;
+                END RECORD;
+ 
+           STANDARD :  REC ;
+ 
+      BEGIN
+ 
+           IF  STANDARD.INTEGER  THEN  FAILED( "RESERVED  -  REC.,INT.");
+           END IF;
+ 
+      END ;    -- B
+ 
+ 
+      RESULT ;
+ 
+ 
+ END C86003A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C86004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF A LIBRARY SUBPROGRAM DECLARATION IS PRECEDED BY A
+ --     "WITH" CLAUSE FOR A GENERIC LIBRARY PROCEDURE M, THEN IN THE
+ --     BODY OF THE SUBPROGRAM, "STANDARD.M" IS A LEGAL NAME
+ --     FOR THE GENERIC PROCEDURE.
+ 
+ -- HISTORY:
+ --     DHH 03/14/88 CREATED ORIGINAL TEST.
+ 
+ -- BEGIN BUILDING LIBRARY PROCEDURES
+ 
+ GENERIC
+      TYPE ITEM IS (<>);
+ PROCEDURE C86004A_SWAP(X,Y: IN OUT ITEM);
+ 
+ PROCEDURE C86004A_SWAP(X,Y: IN OUT ITEM) IS
+      T : ITEM;
+ BEGIN
+      T := X;
+      X := Y;
+      Y := T;
+ END C86004A_SWAP;
+ 
+ WITH C86004A_SWAP; WITH REPORT; USE REPORT;
+ PROCEDURE C86004A1 IS
+      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+      A : INT := IDENT_INT(10);
+      B : INT := IDENT_INT(0);
+      PROCEDURE SWITCH IS NEW STANDARD.C86004A_SWAP(INT);
+ BEGIN
+      SWITCH(A,B);
+ 
+      IF A /= IDENT_INT(0) THEN
+           FAILED("STANDARD.GENERIC PROCEDURE - 1");
+      END IF;
+ 
+      IF B /= IDENT_INT(10) THEN
+           FAILED("STANDARD.GENERIC PROCEDURE - 2");
+      END IF;
+ END C86004A1;
+ 
+ WITH C86004A_SWAP; WITH REPORT; USE REPORT;
+ PROCEDURE C86004A2;
+ 
+ PROCEDURE C86004A2 IS
+      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+      A : INT := IDENT_INT(10);
+      B : INT := IDENT_INT(0);
+ BEGIN
+      DECLARE
+           PROCEDURE SWITCH IS NEW STANDARD.C86004A_SWAP(INT);
+      BEGIN
+           SWITCH(A,B);
+      END;
+      IF A /= IDENT_INT(0) THEN
+           FAILED("STANDARD.GENERIC PROCEDURE - B-0");
+      END IF;
+      IF B /= IDENT_INT(10) THEN
+           FAILED("STANDARD.GENERIC PROCEDURE - B-10");
+      END IF;
+ END C86004A2;
+ 
+ WITH C86004A1; WITH C86004A2;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C86004A IS
+ BEGIN
+      TEST("C86004A", "CHECK THAT IF A LIBRARY SUBPROGRAM DECLARATION " &
+                      "IS PRECEDED BY A ""WITH"" CLAUSE FOR A GENERIC " &
+                      "LIBRARY PROCEDURE M, THEN IN THE BODY OF THE " &
+                      "SUBPROGRAM, ""STANDARD.M"" IS A " &
+                      "LEGAL NAME FOR THE GENERIC PROCEDURE");
+      C86004A1;
+      C86004A2;
+ 
+      RESULT;
+ END C86004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004b0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004b0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004b0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,44 ----
+ -- C86004B0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     INDEPENDENT FUNCTION AND SUBPROGRAM SPECIFICATION FOR C86004B
+ --     TEST.
+ 
+ -- HISTORY:
+ --     DHH 08/15/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ FUNCTION C86004B0(X : INTEGER) RETURN INTEGER IS
+ BEGIN
+      IF EQUAL(3,3) THEN
+           RETURN X;
+      ELSE
+           RETURN 0;
+      END IF;
+ END C86004B0;
+ 
+ WITH C86004B0;
+ WITH REPORT; USE REPORT;                          -- SPEC
+ PROCEDURE C86004B1(INTGR : INTEGER := STANDARD.C86004B0(4));
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004b1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004b1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004b1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- C86004B1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     LIBRARY SUBPROGRAM BODY FOR C86004B TEST.
+ 
+ -- HISTORY:
+ --     DHH 08/15/88 CREATED ORIGINAL TEST.
+ 
+ PROCEDURE C86004B1(INTGR : INTEGER := STANDARD.C86004B0(4)) IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+      A : INT := STANDARD.C86004B0(10);
+      B : INT := STANDARD.C86004B0(INTGR);
+ 
+ BEGIN
+      TEST("C86004B", "CHECK THAT IF THE SPECIFICATION OF A LIBRARY " &
+                      "SUBPROGRAM HAS A ""WITH"" CLAUSE FOR A LIBRARY " &
+                      "SUBPROGRAM M, THEN IN THE FORMAL PART AND IN " &
+                      "THE BODY (IN ANOTHER FILE), ""STANDARD.M"" IS " &
+                       "A LEGAL NAME FOR THE SUBPROGRAM M");
+ 
+      IF B /= STANDARD.C86004B0(0) THEN
+           FAILED("STANDARD.SUBPROGRAM - B");
+      END IF;
+ 
+      IF A /= STANDARD.C86004B0(10) THEN
+           FAILED("STANDARD.SUBPROGRAM - A");
+      END IF;
+ 
+      RESULT;
+ END C86004B1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004b2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004b2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004b2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,46 ----
+ -- C86004B2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF THE SPECIFICATION OF A LIBRARY SUBPROGRAM HAS A
+ --     "WITH" CLAUSE FOR A LIBRARY SUBPROGRAM M, THEN IN THE FORMAL PART
+ --     AND IN THE BODY (IN ANOTHER FILE), "STANDARD.M" IS A LEGAL NAME
+ --     FOR THE SUBPROGRAM M.
+ 
+ -- SEPARATE FILES ARE:
+ --     C86004B0  A LIBRARY FUNCTION AND A LIBRARY SUBPROGRAM
+ --               SPECIFICATION.
+ --     C86004B1  A LIBRARY SUBPROGRAM BODY FOR THE C86004B0
+ --               SPECIFICATION.
+ --     C86004B2M MAIN PROCEDURE USING THE SUBPROGRAM OF C86004B1.
+ 
+ -- HISTORY:
+ --     DHH 08/15/88 CREATED ORIGINAL TEST.
+ 
+ WITH C86004B1;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C86004B2M IS
+ BEGIN
+      C86004B1(IDENT_INT(0));
+ END C86004B2M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- C86004C0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     INDEPENDENT GENERIC FUNCTION AND SUBPROGRAM FOR C86004C TEST.
+ 
+ -- HISTORY:
+ --     DHH 09/14/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ GENERIC
+ FUNCTION C86004C0_GEN(X : INTEGER) RETURN INTEGER;
+ 
+ FUNCTION C86004C0_GEN(X : INTEGER) RETURN INTEGER IS
+ BEGIN
+      IF EQUAL(3,3) THEN
+           RETURN X;
+      ELSE
+           RETURN 0;
+      END IF;
+ END C86004C0_GEN;
+ 
+ WITH C86004C0_GEN;
+ PRAGMA ELABORATE(C86004C0_GEN);
+ FUNCTION C86004C0 IS NEW C86004C0_GEN;
+ 
+ WITH C86004C0;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C86004C01(INTGR : INTEGER := STANDARD.C86004C0(4)) IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+      A : INT := STANDARD.C86004C0(10);
+      B : INT := STANDARD.C86004C0(INTGR);
+ 
+      PROCEDURE C86004C1 IS SEPARATE;
+ 
+ BEGIN
+      C86004C1;
+ END;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- C86004C1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     SUBUNIT FOR THE C86004C01 PARENT.
+ 
+ -- HISTORY:
+ --     DHH 09/14/88 CREATED ORIGINAL TEST.
+ 
+ SEPARATE (C86004C01)
+ PROCEDURE C86004C1 IS
+ BEGIN
+      TEST("C86004C", "CHECK THAT IF THE SPECIFICATION OF A " &
+                      "SUBPROGRAM HAS A ""WITH"" CLAUSE FOR A GENERIC " &
+                      "SUBPROGRAM INSTANTIANTION M, THEN IN THE " &
+                      "FORMAL PART AND IN THE BODY (A SUBUNIT IN " &
+                      "ANOTHER FILE), ""STANDARD.M"" IS " &
+                      "A LEGAL NAME FOR THE SUBPROGRAM M");
+ 
+      IF B /= STANDARD.C86004C0(0) THEN
+           FAILED("STANDARD.SUBPROGRAM - B");
+      END IF;
+ 
+      IF A /= STANDARD.C86004C0(10) THEN
+           FAILED("STANDARD.SUBPROGRAM - A");
+      END IF;
+ 
+      RESULT;
+ END C86004C1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004c2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86004c2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86004c2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,45 ----
+ -- C86004C2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF THE SPECIFICATION OF A LIBRARY SUBPROGRAM HAS A
+ --     "WITH" CLAUSE FOR A GENERIC SUBPROGRAM INSTANTIATION M, THEN IN
+ --     THE FORMAL PART AND IN THE BODY (A SUBUNIT IN ANOTHER FILE),
+ --     "STANDARD.M" IS A LEGAL NAME FOR THE SUBPROGRAM M.
+ 
+ -- SEPARATE FILES ARE:
+ --     C86004C0  A GENERIC LIBRARY FUNCTION AND A LIBRARY SUBPROGRAM
+ --               DECLARING A SEPARATE SUBUNIT.
+ --     C86004C1  A SUBUNIT FOR THE C86004C0 PARENT.
+ --     C86004C2M MAIN PROCEDURE USING THE SUBPROGRAM OF C86004C0.
+ 
+ -- HISTORY:
+ --     DHH 09/14/88 CREATED ORIGINAL TEST.
+ 
+ WITH C86004C01;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C86004C2M IS
+ BEGIN
+      C86004C01(IDENT_INT(0));
+ END C86004C2M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86006i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86006i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86006i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86006i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C86006I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE IDENTIFIERS "BOOLEAN, TRUE, AND FALSE" AND THE 
+ --     IDENTIFIERS "INTEGER, NATURAL, AND POSITIVE" ARE DECLARED IN 
+ --     THE PACKAGE "STANDARD", ALONG WITH THE OPERATORS OF THE TYPE 
+ --     BOOLEAN AND THE TYPE INTEGER.                                          
+ 
+ -- HISTORY:
+ --     DTN 04/15/92 CONSOLIDATION OF C86006A AND C86006B.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C86006I IS
+      
+      ABOOL, BBOOL : STANDARD.BOOLEAN := STANDARD.FALSE;
+      CBOOL : STANDARD.BOOLEAN := STANDARD.TRUE;
+      INT1 : STANDARD.INTEGER := -2;
+      NAT1 : STANDARD.NATURAL := 0;
+      POS1, POS2 : STANDARD.POSITIVE := 2;
+ 
+ BEGIN
+ 
+      TEST("C86006I", "CHECK THAT THE IDENTIFIERS ""BOOLEAN, TRUE, AND " &
+                      "FALSE"" AND THE IDENTIFIERS ""INTEGER, NATURAL, " &
+                      "AND POSITIVE"" ARE DECLARED IN THE PACKAGE " &
+                      """STANDARD"", ALONG WITH THE OPERATORS OF THE " &
+                      "TYPE BOOLEAN AND THE TYPE INTEGER");
+ 
+      -- STANDARD.">" OPERATOR.
+ 
+      IF STANDARD.">"(ABOOL,BBOOL) THEN
+           FAILED("STANDARD.> FAILED FOR BOOLEAN TYPE");
+      END IF;
+ 
+      IF STANDARD.">"(INT1,NAT1) THEN
+           FAILED("STANDARD.> FAILED FOR INTEGER-NATURAL TYPE");
+      END IF;
+ 
+      -- STANDARD."/=" OPERATOR.
+ 
+      IF STANDARD."/="(ABOOL,BBOOL) THEN
+           FAILED("STANDARD./= FAILED FOR BOOLEAN TYPE");
+      END IF;
+ 
+      IF STANDARD."/="(POS1,POS2) THEN
+           FAILED("STANDARD./= FAILED FOR INTEGER-POSITIVE TYPE");
+      END IF;
+ 
+      -- STANDARD."AND" OPERATOR.
+ 
+      IF STANDARD."AND"(CBOOL,ABOOL) THEN
+           FAILED("STANDARD.AND FAILED");
+      END IF;
+ 
+      -- STANDARD."-" BINARY OPERATOR.
+ 
+      IF STANDARD."-"(INT1,POS1) /= IDENT_INT(-4) THEN
+           FAILED("STANDARD.- FAILED");
+      END IF;
+ 
+      -- STANDARD."-" UNARY OPERATOR.
+ 
+      IF STANDARD."-"(INT1) /= IDENT_INT(2) THEN
+           FAILED("STANDARD.UNARY - FAILED");
+      END IF;
+ 
+      -- STANDARD."REM" OPERATOR.
+ 
+      IF STANDARD."REM"(IDENT_INT(14),IDENT_INT(5)) /= IDENT_INT(4) THEN
+           FAILED("STANDARD.REM (++=+) FAILED");
+      END IF;
+ 
+      -- STANDARD."MOD" OPERATOR.
+ 
+      IF STANDARD."MOD"(IDENT_INT(14),IDENT_INT(-5)) /= IDENT_INT(-1) THEN
+           FAILED("STANDARD.MOD (+-=-) FAILED");
+      END IF;
+ 
+      RESULT;
+ 
+ END C86006I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c86007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c86007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C86007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN EXPANDED NAME FOR AN ENTITY DECLARED IN THE VISIBLE
+ --     PART OF A LIBRARY PACKAGE CAN START WITH THE NAME "STANDARD".
+ 
+ -- HISTORY:
+ --     DHH 03/15/88 CREATED ORIGINAL TEST.
+ --     RJW 10/26/89 ADDED "PRAGMA ELABORATE (REPORT);"
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE C86007A_PACK IS
+      SUBTYPE ITEM IS INTEGER RANGE 0 .. 10;
+      Y : STANDARD.C86007A_PACK.ITEM := IDENT_INT(5);
+      TYPE ACC IS ACCESS STANDARD.C86007A_PACK.ITEM;
+      PROCEDURE SWAP(X,Y: IN OUT ITEM);
+      PROCEDURE PROC;
+ END C86007A_PACK;
+ 
+ PACKAGE BODY C86007A_PACK IS
+      PROCEDURE SWAP(X,Y: IN OUT STANDARD.C86007A_PACK.ITEM) IS
+           T : STANDARD.C86007A_PACK.ITEM;
+      BEGIN
+           T := X;
+           X := Y;
+           Y := T;
+      END SWAP;
+ 
+      PROCEDURE PROC IS
+           X : STANDARD.C86007A_PACK.ITEM := IDENT_INT(10);
+           W : STANDARD.C86007A_PACK.ACC;
+      BEGIN
+ 
+           W := NEW STANDARD.C86007A_PACK.ITEM;
+           W.ALL := X;
+           STANDARD.C86007A_PACK.SWAP(X, STANDARD.C86007A_PACK.Y);
+           IF STANDARD.C86007A_PACK.Y /= IDENT_INT(10) THEN
+                FAILED("FAILED STANDARD.NAME CALL PROCEDURE - B-10");
+           END IF;
+           IF X /= IDENT_INT(5) THEN
+                FAILED("FAILED STANDARD.NAME CALL PROCEDURE - B-5");
+           END IF;
+      END PROC;
+ END C86007A_PACK;
+ 
+ WITH C86007A_PACK; WITH REPORT; USE REPORT;
+ PROCEDURE C86007A IS
+ BEGIN
+      TEST("C86007A", "CHECK THAT AN EXPANDED NAME FOR AN ENTITY " &
+                      "DECLARED IN THE VISIBLE PART OF A LIBRARY " &
+                      "PACKAGE CAN START WITH THE NAME ""STANDARD""");
+ 
+      STANDARD.C86007A_PACK.PROC;
+ 
+      RESULT;
+ END C86007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87a05a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87a05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87a05a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87a05a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C87A05A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FUNCTION CALLS AND INDEXED COMPONENT EXPRESSIONS CAN BE 
+ -- DISTINGUISHED BY THE RULES OF OVERLOADING RESOLUTION.
+ --
+ -- PART 1 : CORRECT RESOLUTION IS INDEXED COMPONENT EXPRESSION
+   
+ -- TRH  13 JULY 82
+ -- DSJ  09 JUNE 83
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87A05A IS
+      
+      OK : BOOLEAN := TRUE;
+      TYPE VECTOR IS ARRAY (1 .. 5) OF BOOLEAN;
+   
+      PROCEDURE P (ARG : BOOLEAN) IS          -- THIS IS CORRECT P
+      BEGIN 
+           OK := ARG;
+      END P;
+   
+      PROCEDURE P (ARG : CHARACTER) IS
+      BEGIN 
+           OK := FALSE;
+      END P;
+ 
+      FUNCTION Y RETURN VECTOR IS             -- THIS IS CORRECT Y
+      BEGIN
+           RETURN (VECTOR'RANGE => TRUE);
+      END Y;
+ 
+      FUNCTION Y (ARG : INTEGER) RETURN FLOAT IS
+      BEGIN 
+           OK := FALSE;
+           RETURN 0.0;
+      END Y;
+        
+      FUNCTION Y (ARG : CHARACTER) RETURN CHARACTER IS
+      BEGIN 
+           OK := FALSE;
+           RETURN 'A';
+      END Y;
+    
+      FUNCTION Y (ARG : FLOAT) RETURN FLOAT IS
+      BEGIN 
+           OK := FALSE;
+           RETURN 0.0;
+      END Y;
+        
+      FUNCTION Y RETURN BOOLEAN IS
+      BEGIN 
+           OK := FALSE;
+           RETURN FALSE;
+      END Y;
+        
+      FUNCTION Y (ARG : CHARACTER := 'A') RETURN BOOLEAN IS
+      BEGIN 
+           OK := FALSE;
+           RETURN FALSE;
+      END Y;
+     
+      FUNCTION Z RETURN INTEGER IS            -- THIS IS CORRECT Z
+      BEGIN 
+           RETURN 3;
+      END Z;
+        
+      FUNCTION Z RETURN FLOAT IS
+      BEGIN 
+           OK := FALSE;
+           RETURN 3.0;
+      END Z;
+    
+ BEGIN
+      TEST ("C87A05A","OVERLOADING RESOLUTION FOR DISTINGUISHING " &
+            "FUNCTION CALLS FROM INDEXED COMPONENTS WHERE INDEXED " &
+            "COMPONENTS ARE CORRECT");
+   
+      P (Y (Z) );
+   
+      IF NOT OK THEN 
+           FAILED ("RESOLUTION INCORRECT");
+      END IF;
+     
+      RESULT;
+ END C87A05A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87a05b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87a05b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87a05b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87a05b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- C87A05B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FUNCTION CALLS AND INDEXED COMPONENT EXPRESSIONS CAN BE 
+ -- DISTINGUISHED BY THE RULES OF OVERLOADING RESOLUTION.
+ --
+ -- PART 2 : CORRECT RESOLUTION IS FUNCTION CALL
+   
+ -- TRH  15 JULY 82
+ -- DSJ  09 JUNE 83
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87A05B IS
+      
+      OK : BOOLEAN := TRUE;
+      TYPE VECTOR IS ARRAY (1 .. 5) OF BOOLEAN;
+   
+      PROCEDURE P (ARG : CHARACTER := 'A') IS
+      BEGIN 
+           OK := FALSE;
+      END P;
+      
+      PROCEDURE P IS
+      BEGIN 
+           OK := FALSE;
+      END P;
+   
+      PROCEDURE P (ARG : INTEGER) IS               -- THIS IS CORRECT P
+      BEGIN 
+           OK := (ARG = 1);
+      END P;
+ 
+      FUNCTION Y RETURN VECTOR IS
+      BEGIN
+           OK := FALSE;
+           RETURN (VECTOR'RANGE => TRUE);
+      END Y;
+      
+      FUNCTION Y RETURN CHARACTER IS
+      BEGIN
+           OK := FALSE;
+           RETURN 'A';
+      END Y;
+        
+      FUNCTION Y (ARG : FLOAT) RETURN FLOAT IS
+      BEGIN 
+           OK := FALSE;
+           RETURN 0.0;
+      END Y;
+    
+      FUNCTION Y (ARG : CHARACTER) RETURN INTEGER IS
+      BEGIN 
+           OK := FALSE;
+           RETURN 0;
+      END Y;
+     
+      FUNCTION Y (ARG : FLOAT) RETURN INTEGER IS   -- THIS IS CORRECT Y
+      BEGIN 
+           RETURN 1;
+      END Y;
+        
+      FUNCTION Z RETURN INTEGER IS
+      BEGIN 
+           OK := FALSE;
+           RETURN 3;
+      END Z;
+        
+      FUNCTION Z RETURN FLOAT IS                   -- THIS IS CORRECT Z
+      BEGIN 
+           RETURN 3.0;
+      END Z;
+    
+ BEGIN
+      TEST ("C87A05B","OVERLOADING RESOLUTION FOR DISTINGUISHING " &
+            "FUNCTION CALLS FROM INDEXED COMPONENTS WHERE CORRECT " &
+            "RESOLUTION IS FUNCTION CALL");
+   
+      P (Y (Z) );
+   
+      IF NOT OK THEN 
+           FAILED ("RESOLUTION INCORRECT");
+      END IF;
+     
+      RESULT;
+ END C87A05B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b02a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b02a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b02a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b02a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C87B02A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A CONSTANT DECLARATION, THE TYPE OF THE INITIALIZATION
+ -- EXPRESSION MUST MATCH THE CONSTANT'S EXPLICIT TYPEMARK.
+ --      
+ -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+ -- 
+ --    (A): A CALL TO AN OVERLOADED FUNCTION.
+ --    (B): AN OVERLOADED OPERATOR SYMBOL.
+ --    (C): AN OVERLOADED (INFIX) OPERATOR.
+ --    (D): AN OVERLOADED ENUMERATION LITERAL.
+   
+ -- TRH  17 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B02A IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+      
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END F1;
+     
+      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B02A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+           " IN CONSTANT DECLARATIONS");
+      DECLARE
+ 
+           FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES F1;
+     
+           FUNCTION "*" (X, Y : WHOLE)   RETURN WHOLE
+                RENAMES F1;
+      
+           FUNCTION "*" (X, Y : INTEGER) RETURN HUE
+                RENAMES F1;
+    
+           FUNCTION "*" (X, Y : INTEGER) RETURN CITRUS
+                RENAMES F1;
+       
+           I1 : CONSTANT INTEGER := F1 (0, 0);
+           W1 : CONSTANT WHOLE   := F1 (0, 0);
+           C1 : CONSTANT CITRUS  := F1 (0, 0);
+           H1 : CONSTANT HUE     := F1 (0, 0);
+    
+           I2 : CONSTANT INTEGER := "*" (0, 0);
+           W2 : CONSTANT WHOLE   := "*" (0, 0);
+           C2 : CONSTANT CITRUS  := "*" (0, 0);
+           H2 : CONSTANT HUE     := "*" (0, 0);
+       
+           I3 : CONSTANT INTEGER := (0 * 0);
+           W3 : CONSTANT WHOLE   := (0 * 0);
+           C3 : CONSTANT CITRUS  := (0 * 0);
+           H3 : CONSTANT HUE     := (0 * 0);
+       
+           C4 : CONSTANT CITRUS  := ORANGE;
+           H4 : CONSTANT HUE     := ORANGE;
+ 
+      BEGIN
+           IF I1              /= -1 OR W1           /= 0 OR
+              CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+           END IF;
+     
+           IF I2              /= -1 OR W2           /= 0 OR
+              CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+           END IF;
+     
+           IF I3              /= -1 OR W3           /= 0 OR
+              CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+           END IF;
+     
+           IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B02A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b02b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b02b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b02b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b02b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C87B02B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A VARIABLE DECLARATION, THE TYPE OF THE INITIALIZATION
+ -- EXPRESSION MUST MATCH THE VARIABLE'S EXPLICIT TYPEMARK.
+ --      
+ -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+ -- 
+ --    (A): A CALL TO AN OVERLOADED FUNCTION.
+ --    (B): AN OVERLOADED OPERATOR SYMBOL.
+ --    (C): AN OVERLOADED (INFIX) OPERATOR.
+ --    (D): AN OVERLOADED ENUMERATION LITERAL.
+   
+ -- TRH  17 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B02B IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+      
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END F1;
+     
+      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B02B","OVERLOADED INITIALIZATION EXPRESSIONS" &
+            " IN VARIABLE DECLARATIONS");
+      DECLARE
+ 
+           FUNCTION "REM" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES F1;
+     
+           FUNCTION "REM" (X, Y : WHOLE)   RETURN WHOLE
+                RENAMES F1;
+      
+           FUNCTION "REM" (X, Y : INTEGER) RETURN HUE
+                RENAMES F1;
+    
+           FUNCTION "REM" (X, Y : INTEGER) RETURN CITRUS
+                RENAMES F1;
+       
+           I1 : INTEGER := F1 (0, 0);
+           W1 : WHOLE   := F1 (0, 0);
+           C1 : CITRUS  := F1 (0, 0);
+           H1 : HUE     := F1 (0, 0);
+    
+           I2 : INTEGER := "REM" (0, 0);
+           W2 : WHOLE   := "REM" (0, 0);
+           C2 : CITRUS  := "REM" (0, 0);
+           H2 : HUE     := "REM" (0, 0);
+       
+           I3 : INTEGER := (0 REM 0);
+           W3 : WHOLE   := (0 REM 0);
+           C3 : CITRUS  := (0 REM 0);
+           H3 : HUE     := (0 REM 0);
+       
+           C4 : CITRUS  := ORANGE;
+           H4 : HUE     := ORANGE;
+ 
+      BEGIN
+           IF I1              /= -1 OR W1           /= 0 OR
+              CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+           END IF;
+     
+           IF I2              /= -1 OR W2           /= 0 OR
+              CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+           END IF;
+     
+           IF I3              /= -1 OR W3           /= 0 OR
+              CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+           END IF;
+     
+           IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B02B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b03a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b03a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b03a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b03a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,61 ----
+ -- C87B03A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE EXPRESSION IN A NUMBER DECLARATION MUST BE EITHER OF THE TYPE
+ -- UNIVERSAL_INTEGER OR UNIVERSAL_REAL.
+    
+ -- TRH  16 JUNE 82
+      
+ WITH REPORT; USE REPORT;
+     
+ PROCEDURE C87B03A IS
+     
+ BEGIN
+      TEST ("C87B03A","OVERLOADED EXPRESSIONS IN NUMBER DECLARATIONS");
+   
+      DECLARE
+           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES STANDARD."-";
+            
+           FUNCTION "+" (X, Y : FLOAT)   RETURN FLOAT
+                RENAMES STANDARD."-";
+   
+           I1 : CONSTANT         := 1 + 1;
+           I2 : CONSTANT INTEGER := 1 + 1;
+    
+           R1 : CONSTANT       := 1.0 + 1.0;
+           R2 : CONSTANT FLOAT := 1.0 + 1.0;
+   
+      BEGIN
+           IF I1 /= 2   OR I2 /= 0   OR 
+              R1 /= 2.0 OR R2 /= 0.0 THEN
+              FAILED ("OVERLOADED EXPRESSIONS IN NUMBER DECLARATIONS" &
+                      " RESOLVED INCORRECTLY");
+           END IF;
+      END;
+    
+      RESULT;
+ END C87B03A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b04a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b04a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b04a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b04a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C87B04A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A RANGE CONSTRAINT OF A SUBTYPE INDICATION, THE EXPRESSIONS
+ -- FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE WITH THE SUBTYPE'S
+ -- EXPLICIT TYPEMARK.
+   
+ -- TRH  28 JUNE 82
+ -- JBG 3/8/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C87B04A IS
+   
+      TYPE AGE    IS NEW INTEGER RANGE 1 .. 120;
+      TYPE BASE10 IS NEW INTEGER RANGE 0 .. 9;
+      
+      FUNCTION F1 RETURN AGE IS
+      BEGIN
+           RETURN 18;
+      END F1;
+ 
+      FUNCTION F1 RETURN INTEGER IS
+      BEGIN
+           FAILED ("RESOLUTION INCORRECT - RANGE CONSTRAINT OF " &
+                   "SUBTYPE INDICATION");
+           RETURN 0;
+      END F1;
+     
+      FUNCTION "+" (X : INTEGER) RETURN BASE10 IS
+      BEGIN
+           RETURN 1;
+      END "+";
+ 
+      FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           FAILED ("RESOLUTION INCORRECT - RANGE CONSTRAINT OF " &
+                   "SUBTYPE INDICATION");
+           RETURN -X;
+      END "+";
+   
+ BEGIN
+      TEST ("C87B04A","OVERLOADED EXPRESSIONS IN RANGE CONTRAINTS" &
+            " OF SUBTYPE INDICATIONS");
+    
+      DECLARE
+           SUBTYPE MINOR IS AGE RANGE 1 .. F1;
+   
+      BEGIN
+           FOR I IN BASE10 RANGE +(INTEGER'(0)) .. 0 LOOP
+                FAILED ("RESOLUTION INCORRECT - SUBTYPE INDICATION " &
+                        " IN LOOP CONSTRUCT");
+           END LOOP;
+      END;
+     
+      RESULT;
+ END C87B04A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b04b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b04b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b04b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b04b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C87B04B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ 
+ --      IN AN ACCURACY CONSTRAINT OF A SUBTYPE INDICATION, THE
+ --      EXPRESSIONS FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE
+ --      WITH THE SUBTYPE'S EXPLICIT TYPEMARK.
+ 
+ -- HISTORY:
+ --      TRH 06/29/82  CREATED ORIGINAL TEST.
+ --      BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.  CORRECTED
+ --                    CONSTRAINT ERRORS.
+ --      KAS 11/24/95  DELETED SUBTYPE DIGITS CONSTRAINT
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C87B04B IS
+ 
+      TYPE EXACT IS DIGITS 5     RANGE -1.0 .. 1.0;
+      TYPE HEX IS DELTA  2.0 ** (-4) RANGE -1.0 .. 1.0;
+ 
+      FUNCTION F1 RETURN EXACT IS
+      BEGIN
+           RETURN 0.0;
+      END F1;
+ 
+      FUNCTION F1 RETURN FLOAT IS
+      BEGIN
+           FAILED ("RESOLUTION INCORRECT - ACCURACY CONSTRAINT OF " &
+                   "SUBTYPE INDICATION - F1");
+           RETURN 0.0;
+      END F1;
+ 
+      FUNCTION "+" (X : INTEGER) RETURN HEX IS
+      BEGIN
+           RETURN 0.0;
+      END "+";
+ 
+      FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
+      BEGIN
+           FAILED ("RESOLUTION INCORRECT - ACCURACY CONSTRAINT OF " &
+                   "SUBTYPE INDICATION - +");
+           RETURN 0.0;
+      END "+";
+ 
+ BEGIN
+      TEST ("C87B04B","OVERLOADED EXPRESSIONS IN ACCURACY CONTRAINTS" &
+            " OF FLOATING/FIXED POINT SUBTYPE INDICATIONS");
+ 
+      DECLARE
+           SUBTYPE CLOSE IS EXACT RANGE -1.0 .. F1;
+           SUBTYPE BIN IS HEX DELTA 2.0 ** (-1) RANGE "+" (0) .. 0.5;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C87B04B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b04c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b04c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b04c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b04c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- C87B04C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A RANGE CONSTRAINT OF A SUBTYPE INDICATION, THE EXPRESSIONS
+ -- FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE WITH THE SUBTYPE'S
+ -- EXPLICIT TYPEMARK.
+   
+ -- TRH  29 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B04C IS
+   
+      TYPE DAY IS (MON, TUE, WED, THU, FRI, SAT, SUN);
+      TYPE ORB IS (SUN, MOON, MARS, EARTH);
+   
+      TYPE GRADE IS ('A', 'B', 'C', 'D', 'F');
+      TYPE VOWEL IS ('C', 'E', 'A', 'O', 'I', 'U', 'Y');
+   
+ BEGIN
+      TEST ("C87B04C","OVERLOADED EXPRESSIONS IN RANGE CONSTRAINTS" &
+           " OF ENUMERATION SUBTYPE INDICATIONS");
+   
+      DECLARE
+           SUBTYPE PASSING IS GRADE RANGE 'A' .. 'C';
+           SUBTYPE DISTANT IS ORB   RANGE SUN .. MARS;
+   
+      BEGIN
+           IF DISTANT'POS (DISTANT'FIRST) /= 0 OR
+              PASSING'POS (PASSING'FIRST) /= 0 THEN 
+              FAILED ("RESOLUTION INCORRECT FOR OVERLOADED " &
+                      " ENUMERATION LITERALS");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B04C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b05a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b05a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b05a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b05a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- C87B05A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN AN INTEGER TYPE DEFINITION WITH A RANGE CONSTRAINT, THE BOUNDS
+ -- OF THE RANGE MUST BE OF SOME INTEGER TYPE.
+   
+ -- TRH  1 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B05A IS
+   
+      ERR : BOOLEAN := FALSE;
+      TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      TYPE AGE   IS NEW INTEGER RANGE 0 .. 120;
+      
+      FUNCTION "+" (X : WHOLE) RETURN FLOAT IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN 2.0;
+      END "+";
+ 
+      FUNCTION "-" (X : AGE) RETURN BOOLEAN IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN FALSE;
+      END "-";
+   
+ BEGIN
+      TEST ("C87B05A","OVERLOADED EXPRESSIONS IN RANGE BOUNDS " &
+            " OF INTEGER TYPE DEFINITIONS");
+    
+      DECLARE
+           TYPE ADULT IS RANGE 18 .. "+" (WHOLE'(120));
+           TYPE MINOR IS RANGE "-" (AGE'(0))  .. "+" (WHOLE'(17));
+           TYPE NEG10 IS RANGE "-" (AGE'(10)) .. "-" (AGE'(1));
+   
+      BEGIN
+           IF ERR THEN 
+                FAILED ("RESOLUTION INCORRECT - INTEGER TYPE " &
+                        "DEFINITIONS MUST HAVE INTEGER TYPE "  &
+                        "RANGE BOUNDS");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B05A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b06a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b06a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b06a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b06a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C87B06A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ --     FOR EACH INTEGER TYPE, THERE EXISTS AN IMPLICIT CONVERSION THAT
+ --     CONVERTS A UNIVERSAL INTEGER VALUE INTO THE CORRESPONDING VALUE
+ --     OF THE INTEGER TYPE. THIS TEST USES LITERALS AS UNIVERSAL INTEGER
+ --     VALUES.
+ 
+ -- HISTORY:
+ --     TRH 08/11/82 CREATED ORIGINAL TEST.
+ --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C87B06A IS
+ 
+      TYPE MINOR IS NEW INTEGER RANGE 0 .. 17;
+      TYPE FIXED IS NEW DURATION;
+      TYPE REAL  IS NEW FLOAT;
+ 
+      ERR : BOOLEAN := FALSE;
+ 
+      PROCEDURE P (X : BOOLEAN) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+      PROCEDURE P (X : FIXED) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+ 
+      PROCEDURE P (X : REAL) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+ 
+      PROCEDURE P (X : FLOAT) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+ 
+      PROCEDURE P (X : STRING) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+ 
+      PROCEDURE P (X : MINOR) IS
+      BEGIN
+           NULL;
+      END P;
+ 
+ BEGIN
+      TEST("C87B06A","OVERLOADING RESOLUTION WITH IMPLICIT CONVERSION " &
+           "OF UNIVERSAL INTEGER VALUES TO INTEGER VALUES. " &
+           "CONVERSIONS TO INTEGER VALUES EXISTS FOR ANY INTEGER TYPE");
+ 
+      P (2);
+      P (2 * 2 + 2);
+ 
+      IF ERR THEN
+           FAILED("INCORRECT IMPLICIT CONVERSION FROM UNIVERSAL " &
+                  " INTEGER VALUES TO INTEGER TYPE VALUES");
+      END IF;
+ 
+      RESULT;
+ END C87B06A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C87B07A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR THE ATTRIBUTE OF THE FORM T'POS (X), THE OPERAND X MUST 
+ -- BE A VALUE OF TYPE T. THE RESULT IS OF TYPE UNIVERSAL_INTEGER.
+   
+ -- TRH  13 SEPT 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B07A IS
+  
+      TYPE NATURAL IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+      TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      TYPE COLOR   IS (BROWN, RED, WHITE);
+      TYPE SCHOOL  IS (HARVARD, BROWN, YALE);
+      TYPE SUGAR   IS (DEXTROSE, CANE, BROWN);
+  
+      FUNCTION "+" (X, Y : NATURAL) RETURN NATURAL
+           RENAMES "*";
+      FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE
+           RENAMES "-";
+     
+ BEGIN
+      TEST ("C87B07A","OVERLOADED OPERANDS TO THE 'POS' ATTRIBUTE");
+   
+      IF NATURAL'POS (1 + 1) /= 1 OR COLOR'POS  (BROWN) /= 0 OR
+         WHOLE'POS   (1 + 1) /= 0 OR SCHOOL'POS (BROWN) /= 1 OR
+         INTEGER'POS (1 + 1) /= 2 OR SUGAR'POS  (BROWN) /= 2 THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERAND TO 'POS' ATTRIBUTE");
+      END IF;
+  
+      IF NATURAL'POS (3 + 3) + 1 /= 10 OR    -- SECOND "+" IS UNIVERSAL.
+         WHOLE'POS   (3 + 3) + 1 /=  1 OR    -- SECOND "+" IS UNIVERSAL.
+         INTEGER'POS (3 + 3) + 1 /=  7 THEN  -- SECOND "+" IS UNIVERSAL.
+         FAILED ("RESOLUTION INCORRECT - 'POS' ATTRIBUTE RETURNS " &
+                 "A UNIVERSAL_INTEGER VALUE");
+      END IF;
+ 
+      RESULT;
+ END C87B07A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C87B07B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR THE ATTRIBUTE OF THE FORM T'VAL (X), THE OPERAND X MAY
+ -- BE OF ANY INTEGER TYPE. THE RESULT IS OF TYPE T.
+   
+ -- TRH  15 SEPT 82
+ -- DSJ  06 JUNE 83
+ -- PWN  01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B07B IS
+  
+      TYPE NEW_INT IS NEW INTEGER;
+      TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      TYPE FLAG IS (PASS, FAIL);
+      
+      FUNCTION "+" (X, Y : NEW_INT) RETURN NEW_INT
+           RENAMES "-";
+      FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE
+           RENAMES "*";
+  
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("THE 'VAL' ATTRIBUTE TAKES AN OPERAND " &
+                        "OF AN INTEGER TYPE");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (CHARACTER, '1', FAIL);
+      FUNCTION F IS NEW F1 (DURATION,  1.0, FAIL);
+      FUNCTION F IS NEW F1 (FLOAT,     1.0, FAIL);
+      FUNCTION F IS NEW F1 (NEW_INT,   1,   PASS);
+     
+ BEGIN
+      TEST ("C87B07B","OVERLOADED OPERANDS TO THE 'VAL' ATTRIBUTE");
+     
+      IF (INTEGER'VAL (F) /= 1)          THEN
+           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                   "MUST RETURN A VALUE OF TYPE T - 1");
+      END IF;
+ 
+      IF (INTEGER'VAL (3 + 3) + 1 /= 7)  THEN
+           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                   "MUST RETURN A VALUE OF TYPE T - 2");
+      END IF;
+ 
+      IF (NEW_INT'VAL (F) /= 1)          THEN
+           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                   "MUST RETURN A VALUE OF TYPE T - 3");
+      END IF;
+ 
+      IF (NEW_INT'VAL  (3 + 3) + 1 /= 5) THEN
+           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                   "MUST RETURN A VALUE OF TYPE T - 4");
+      END IF;
+ 
+      IF (WHOLE'VAL    (F) /= 1)         THEN
+           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                   "MUST RETURN A VALUE OF TYPE T - 5");
+      END IF;
+ 
+      IF (WHOLE'VAL    (3 + 3) + 1 /= 6) THEN
+           FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                   "MUST RETURN A VALUE OF TYPE T - 6");
+      END IF;
+  
+      RESULT;
+ END C87B07B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C87B07C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR THE ATTRIBUTE OF THE FORM T'VALUE (X), THE OPERAND X MUST 
+ -- BE OF THE PREDEFINED TYPE STRING. THE RESULT IS OF TYPE T.
+   
+ -- TRH  13 SEPT 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B07C IS
+  
+      TYPE CHAR IS NEW CHARACTER;
+      TYPE LITS IS (' ', '+', '1');
+      TYPE WORD IS ARRAY (POSITIVE RANGE 1..4) OF CHARACTER;
+      TYPE LINE IS ARRAY (POSITIVE RANGE 1..4) OF CHAR;
+      TYPE LIST IS ARRAY (POSITIVE RANGE 1..4) OF LITS;
+      TYPE STR  IS ARRAY (POSITIVE RANGE 1..4) OF STRING (1 .. 1);
+      TYPE STR2 IS NEW STRING (1..4);
+      TYPE FLAG IS (PASS, FAIL);
+      SUBTYPE MY_STRING IS STRING (1..4);
+      
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("THE 'VALUE' ATTRIBUTE TAKES AN OPERAND" &
+                        " OF THE TYPE PREDEFINED STRING");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (STR2,   " +1 ",               FAIL);
+      FUNCTION F IS NEW F1 (LIST,   " +1 ",               FAIL);
+      FUNCTION F IS NEW F1 (WORD,   (' ', '+', '1', ' '), FAIL);
+      FUNCTION F IS NEW F1 (STR,    (" ", "+", "1", " "), FAIL);
+      FUNCTION F IS NEW F1 (LINE,   (' ', '+', '1', ' '), FAIL);
+      FUNCTION F IS NEW F1 (MY_STRING, " +1 ",               PASS);
+     
+ BEGIN
+      TEST ("C87B07C","OVERLOADED OPERANDS TO THE 'VALUE' ATTRIBUTE");
+     
+      DECLARE
+           TYPE INT IS NEW INTEGER;
+           FUNCTION "-" (X : INT) RETURN INT 
+                RENAMES "+";
+  
+      BEGIN
+           IF INT'VALUE (F) /= -1 THEN
+                FAILED ("THE ATTRIBUTE T'VALUE MUST RETURN A VALUE" &
+                        " OF TYPE T");
+           END IF;
+      END;
+  
+      RESULT;
+ END C87B07C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- C87B07D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE ATTRIBUTES OF THE FORM T'SUCC (X) AND T'PRED (X) TAKE AN
+ -- OPERAND X OF TYPE T AND RETURN A VALUE OF TYPE T.
+   
+ -- TRH  15 SEPT 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B07D IS
+  
+      TYPE NEW_INT IS NEW INTEGER;
+      TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+   
+      FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE 
+           RENAMES "*";
+      FUNCTION "+" (X, Y : NEW_INT) RETURN NEW_INT
+           RENAMES "-";
+     
+ BEGIN
+      TEST ("C87B07D","OVERLOADED OPERANDS TO THE ATTRIBUTES " &
+            "'PRED' AND 'SUCC'");
+     
+      IF INTEGER'SUCC (1 + 1) /= 3  OR INTEGER'SUCC (3 + 3) + 1 /= 8  OR
+         NEW_INT'SUCC (1 + 1) /= 1  OR NEW_INT'SUCC (3 + 3) + 1 /= 0  OR
+         WHOLE'SUCC   (1 + 1) /= 2  OR WHOLE'SUCC   (3 + 3) + 1 /= 10 OR
+         INTEGER'PRED (1 + 1) /= 1  OR INTEGER'PRED (3 + 3) + 1 /= 6  OR
+         NEW_INT'PRED (1 + 1) /= -1 OR NEW_INT'PRED (3 + 3) + 1 /= -2 OR
+         WHOLE'PRED   (1 + 1) /= 0  OR WHOLE'PRED   (3 + 3) + 1 /= 8  
+         THEN FAILED ("RESOLUTION INCORRECT FOR OPERAND OR RESULT OF" &
+                      " THE 'PRED' OR 'SUCC' ATTRIBUTE");
+      END IF;
+      
+      RESULT;
+ END C87B07D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b07e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b07e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- C87B07E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR THE ATTRIBUTE OF THE FORM T'IMAGE (X), THE OPERAND X MUST
+ -- BE OF TYPE T. THE RESULT IS OF THE PREDEFINED TYPE STRING.
+   
+ -- TRH  15 SEPT 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B07E IS
+  
+      TYPE NEW_INT IS NEW INTEGER;
+      TYPE NUMBER  IS NEW INTEGER;
+      TYPE NEW_STR IS NEW STRING;
+   
+      FUNCTION "+" (X : NEW_INT) RETURN NEW_INT
+           RENAMES "-";
+      FUNCTION "-" (X : NUMBER)  RETURN NUMBER
+           RENAMES "+";
+  
+      PROCEDURE P (X : NEW_STR) IS
+      BEGIN
+           FAILED ("THE IMAGE ATTRIBUTE MUST RETURN A VALUE OF THE" &
+                   " PREDEFINED TYPE STRING");
+      END P;
+  
+      PROCEDURE P (X : STRING) IS
+      BEGIN
+           NULL;
+      END P;
+     
+ BEGIN
+      TEST ("C87B07E","OVERLOADED OPERANDS TO THE IMAGE ATTRIBUTE");
+     
+      IF INTEGER'IMAGE (+12) & INTEGER'IMAGE (-12) &
+         NEW_INT'IMAGE (+12) & NEW_INT'IMAGE (-12) &
+         NUMBER'IMAGE  (+12) & NUMBER'IMAGE  (-12)  /=
+         " 12-12-12-12 12 12" THEN
+         FAILED ("RESOLUTION INCORRECT FOR THE 'IMAGE' ATTRIBUTE");
+      END IF;
+    
+      P (INTEGER'IMAGE (+1) & NEW_INT'IMAGE (+1) & NUMBER'IMAGE (-1));
+      
+      RESULT;
+ END C87B07E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b08a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b08a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b08a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b08a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C87B08A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR EACH REAL TYPE, THERE EXISTS AN IMPLICIT CONVERSION THAT
+ -- CONVERTS A UNIVERSAL REAL VALUE INTO THE CORRESPONDING VALUE 
+ -- OF THE REAL TYPE. THIS TEST USES LITERALS AS UNIVERSAL REAL
+ -- VALUES.
+   
+ -- TRH  16 AUG 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B08A IS
+  
+      TYPE FIXED IS DELTA 0.1 RANGE -2.0 .. 2.0;
+      TYPE FLT   IS DIGITS  2 RANGE -2.0 .. 2.0;
+      TYPE FLAG  IS (PASS, FAIL);
+  
+      GENERIC
+           TYPE T IS PRIVATE;
+           STAT : IN FLAG;
+      PROCEDURE P1 (X : T);
+   
+      PROCEDURE P1 (X : T) IS
+      BEGIN
+           IF STAT = FAIL THEN
+                FAILED ("INCORRECT IMPLICIT CONVERSION FROM UNIVERSAL" &
+                        " REAL VALUES TO REAL TYPE VALUES");
+           END IF;
+      END P1;
+  
+      PROCEDURE P IS NEW P1 (INTEGER,   FAIL);
+      PROCEDURE P IS NEW P1 (FLT,       PASS);
+      PROCEDURE Q IS NEW P1 (FIXED,     PASS);
+      PROCEDURE Q IS NEW P1 (BOOLEAN,   FAIL);
+      PROCEDURE Q IS NEW P1 (CHARACTER, FAIL);
+  
+ BEGIN
+      TEST ("C87B08A","IMPLICIT CONVERSION OF UNIVERSAL REAL " &
+            "VALUES TO REAL VALUES EXISTS FOR ANY REAL TYPE");
+     
+      P (0.0);
+      P (1.0 + 1.0);
+      Q (1.0);
+      Q (1.0 - 1.0);
+  
+      RESULT;
+ END C87B08A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b09a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b09a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b09a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b09a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,55 ----
+ -- C87B09A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A FLOATING POINT TYPE DEFINITION, THE DIGITS EXPRESSION MUST 
+ -- BE OF SOME INTEGER TYPE.
+   
+ -- TRH  30 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B09A IS
+      
+      FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
+      BEGIN 
+            FAILED ("DIGITS EXPRESSION MUST BE OF AN INTEGER TYPE");
+            RETURN 2.0;
+      END "+";
+ 
+ BEGIN
+      TEST ("C87B09A","OVERLOADED DIGITS EXPRESSIONS IN " &
+            "FLOATING POINT TYPE DEFINITIONS");
+    
+      DECLARE
+           TYPE EXACT IS DIGITS "+" (3);
+           TYPE CLOSE IS DIGITS "+" (1) RANGE -1.0 .. 1.0;
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B09A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b09c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b09c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b09c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b09c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C87B09C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A FLOATING POINT TYPE DEFINITION, THE DIGITS EXPRESSION MUST
+ -- BE OF SOME INTEGRAL TYPE. SIMILARLY, THE DELTA EXPRESSION IN A
+ -- FIXED POINT TYPE DEFINITION MUST BE OF SOME REAL TYPE.
+   
+ -- TRH  30 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B09C IS
+      
+      FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
+      BEGIN 
+            FAILED ("DIGITS EXPRESSION MUST BE OF AN INTEGRAL TYPE");
+            RETURN 2.0;
+      END "+";
+ 
+      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+      BEGIN 
+            FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
+            RETURN 2;
+      END "+";
+   
+ BEGIN
+      TEST ("C87B09C","OVERLOADED DIGITS/DELTA EXPRESSIONS IN " &
+            "REAL TYPE DEFINITIONS");
+    
+      DECLARE
+           TYPE EXACT IS DIGITS "+" (4);
+           TYPE CENTI IS DELTA  "+" (0.01) RANGE -2.0 .. 2.0;
+           TYPE CLOSE IS DIGITS "+" (2)    RANGE -1.0 .. 1.0;
+           TYPE DECI  IS DELTA  "+" (0.1)  RANGE -1.0 .. 1.0;
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B09C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b10a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b10a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b10a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b10a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C87B10A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A RANGE CONSTRAINT OF A FIXED POINT OR FLOATING POINT TYPE
+ -- DEFINITION, BOTH BOUNDS MUST BE OF SOME REAL TYPE, ALTHOUGH
+ -- THE TWO BOUNDS DO NOT HAVE TO BE OF THE SAME TYPE.
+   
+ -- TRH 7/28/82
+ -- DSJ 6/10/83
+ -- JBG 9/19/84
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B10A IS
+ 
+      SUBTYPE DUR IS DURATION;
+ 
+      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+      BEGIN
+           FAILED ("RANGE CONSTRAINT FOR REAL TYPE DEFINITIONS " &
+                   "MUST HAVE REAL BOUNDS");
+           RETURN -10;
+      END "+";
+ 
+      FUNCTION "+" (X, Y : FLOAT) RETURN INTEGER IS
+      BEGIN 
+           FAILED ("RANGE CONSTRAINT FOR REAL TYPE DEFINITIONS " &
+                   "MUST HAVE REAL BOUNDS");
+           RETURN -10;
+      END "+";
+   
+ BEGIN
+      TEST ("C87B10A","RANGE BOUNDS IN REAL TYPE DEFINITIONS MUST BE" &
+            " OF SOME (NOT NECESSARILY THE SAME) REAL TYPE");
+    
+      DECLARE
+           TYPE R1 IS DIGITS  2 RANGE 0.0 .. 1.0 + FLOAT'(1.0);
+           TYPE R2 IS DELTA 0.1 RANGE FLOAT'(1.0) + 1.0 .. DUR'(2.0);
+           TYPE R3 IS DIGITS  2 RANGE +1.0 .. "+" (FLOAT'(2.0), 2.0);
+           TYPE R4 IS DELTA 0.1 RANGE 0.0 + FLOAT'(0.0) .. +1.0;
+  
+   
+      BEGIN
+           IF 2.0 NOT IN R1 OR -1.0 IN R2 OR
+                -1.0 IN R3 OR -0.9 IN R4 THEN
+                FAILED ("RANGE BOUNDS IN REAL TYPE DEFINITIONS DO NOT "
+                     & "HAVE TO BE OF THE SAME REAL TYPE");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B10A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b11a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b11a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b11a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b11a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,55 ----
+ -- C87B11A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A FIXED POINT TYPE DEFINITION, THE DELTA EXPRESSION MUST
+ -- BE OF SOME REAL TYPE.
+   
+ -- TRH  30 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B11A IS
+      
+      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+      BEGIN 
+            FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
+            RETURN 2;
+      END "+";
+   
+ BEGIN
+      TEST ("C87B11A","OVERLOADED DELTA EXPRESSIONS IN " &
+            "FIXED POINT TYPE DEFINITIONS");
+    
+      DECLARE
+           TYPE SEMI IS DELTA "+" (0.5) RANGE -2.0 .. 2.0;
+           TYPE DECI IS DELTA "+" (0.1) RANGE -1.0 .. 1.0;
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B11A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b11b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b11b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b11b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b11b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,57 ----
+ -- C87B11B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A SUBTYPE INDICATION, THE DELTA EXPRESSION FOR A FIXED POINT
+ -- NUMBER MUST BE OF SOME REAL TYPE. 
+   
+ -- TRH  29 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B11B IS
+   
+      TYPE DELT3 IS DELTA 3.0 RANGE -30.0 .. 30.0;
+      
+      FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+      BEGIN 
+            FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
+            RETURN 2;
+      END "+";
+   
+ BEGIN
+      TEST ("C87B11B","OVERLOADED DELTA EXPRESSIONS IN " &
+            "FIXED POINT SUBTYPE INDICATIONS");
+    
+      DECLARE
+           SUBTYPE DELT2 IS DELT3 DELTA "+"(6.0);
+           SUBTYPE DELT1 IS DELT3 DELTA "+"(10.0) RANGE -10.0 .. 10.0;
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B11B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b13a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b13a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b13a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b13a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C87B13A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE LOWER AND UPPER BOUNDS OF AN INDEX CONSTRAINT IN A CONSTRAINED
+ -- ARRAY TYPE DEFINITION MUST BE DISCRETE AND OF THE SAME TYPE.
+   
+ -- TRH  1 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B13A IS
+      
+      TYPE CENTI IS DELTA 0.01 RANGE -1.0 .. 1.0;
+    
+      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+      BEGIN 
+           RETURN X;
+      END F1;
+ 
+      FUNCTION F1 (X : INTEGER) RETURN CENTI IS
+      BEGIN 
+           FAILED ("INDEX CONSTRAINT BOUNDS MUST BE DISCRETE AND " &
+                   " OF THE SAME TYPE");
+           RETURN 0.0;
+      END F1;
+   
+      FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
+      BEGIN 
+           FAILED ("INDEX CONSTRAINT BOUNDS MUST BE DISCRETE AND " &
+                   " OF THE SAME TYPE");
+           RETURN 1.0;
+      END F1;
+   
+ BEGIN
+      TEST ("C87B13A","OVERLOADED INDEX CONSTRAINTS IN " &
+            "CONSTRAINED ARRAY TYPE DEFINITIONS");
+    
+      DECLARE
+           TYPE A1 IS ARRAY (F1 (1) .. F1 (1)) OF BOOLEAN;
+           TYPE A2 IS ARRAY (1      .. F1 (2)) OF BOOLEAN;
+           TYPE A3 IS ARRAY (F1 (1) ..     2)  OF BOOLEAN;
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B13A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C87B14A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
+ -- BOUNDS MUST BE OF THE INDEX BASE TYPE.
+ --
+ -- TEST (A): INDEX CONSTRAINTS WITH OVERLOADED FUNCTIONS.
+   
+ -- TRH  30 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B14A IS
+      
+      SUBTYPE WHOLE  IS INTEGER RANGE 0 .. INTEGER'LAST;
+      SUBTYPE BASE10 IS INTEGER RANGE 0 .. 9;
+      TYPE LIST IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+      TYPE GRID IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF BOOLEAN;
+    
+      FUNCTION F1 RETURN WHOLE IS
+      BEGIN 
+           RETURN 1;
+      END F1;
+ 
+      FUNCTION F1 RETURN BOOLEAN IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                   " IN SUBTYPE INDICATIONS");
+           RETURN TRUE;
+      END F1;
+   
+      FUNCTION F2 RETURN BASE10 IS
+      BEGIN 
+           RETURN 2;
+      END F2;
+ 
+      FUNCTION F2 RETURN FLOAT IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                   " IN SUBTYPE INDICATIONS");
+           RETURN 2.0;
+      END F2;
+   
+ BEGIN
+      TEST ("C87B14A","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &
+            "OF SUBTYPE INDICATIONS");
+    
+      DECLARE
+           SUBTYPE LIST1 IS LIST (1  .. F1);
+           SUBTYPE LIST2 IS LIST (F1 ..  1);
+           SUBTYPE LIST3 IS LIST (F2 .. F2);
+           SUBTYPE LIST4 IS LIST (F1 .. F2);
+    
+           SUBTYPE GRID1 IS GRID (1  .. F1, F1 ..  1);
+           SUBTYPE GRID2 IS GRID (F1 ..  2, 2  .. F2);
+           SUBTYPE GRID3 IS GRID (F1 .. F1, F2 .. F2);
+           SUBTYPE GRID4 IS GRID (F1 .. F2, 1  ..  2);
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B14A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C87B14B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
+ -- BOUNDS MUST BE OF THE INDEX BASE TYPE.
+ --
+ -- TEST (B): INDEX CONSTRAINTS WITH OVERLOADED OPERATOR SYMBOLS.
+   
+ -- TRH  30 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B14B IS
+      
+      SUBTYPE CHAR IS CHARACTER;
+      SUBTYPE VAR  IS CHAR RANGE 'X' .. 'Z';
+      SUBTYPE NOTE IS CHAR RANGE 'A' .. 'G';
+      TYPE LIST IS ARRAY (CHAR RANGE <>) OF CHAR;
+      TYPE GRID IS ARRAY (CHAR RANGE <>, CHAR RANGE <>) OF CHAR;
+    
+      FUNCTION "*" (X, Y : INTEGER) RETURN VAR IS
+      BEGIN 
+           RETURN 'X';
+      END "*";
+ 
+      FUNCTION "*" (X, Y : INTEGER) RETURN BOOLEAN IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                   " IN SUBTYPE INDICATIONS");
+           RETURN TRUE;
+      END "*";
+   
+      FUNCTION "+" (X, Y : INTEGER) RETURN NOTE IS
+      BEGIN 
+           RETURN 'A';
+      END "+";
+ 
+      FUNCTION "+" (X, Y : INTEGER) RETURN FLOAT IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                   " IN SUBTYPE INDICATIONS");
+           RETURN 2.0;
+      END "+";
+   
+ BEGIN
+      TEST ("C87B14B","OVERLOADED OPERATOR SYMBOLS IN INDEX " &
+            "CONSTRAINTS OF SUBTYPE INDICATIONS");
+    
+      DECLARE
+ 
+           SUBTYPE LIST1 IS LIST ('W' .. "*" (0, 0));
+           SUBTYPE LIST2 IS LIST ("+" (0, 0) .. 'C');
+           SUBTYPE LIST3 IS LIST ("+" (0, 0) .. "*" (0, 0));
+           SUBTYPE LIST4 IS LIST ("*" (0, 0) .. "*" (0, 0));
+    
+           SUBTYPE GRID1 IS GRID ('V' .. "*" (0, 0), "*" (0, 0) .. 'Y');
+           SUBTYPE GRID2 IS GRID ("*" (0, 0) .. 'W', 'H' .. "+" (0, 0));
+           SUBTYPE GRID3 IS GRID
+               ("*" (0, 0) .. "*" (0, 0), "+" (0, 0) .. "+" (0, 0));
+           SUBTYPE GRID4 IS GRID ("+" (0, 0) .. "*" (0, 0),'L' .. 'N');
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B14B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- C87B14C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
+ -- BOUNDS MUST BE OF THE INDEX BASE TYPE.
+ --
+ -- TEST (C): INDEX CONSTRAINTS WITH OVERLOADED INFIX OPERATORS.
+   
+ -- TRH  30 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B14C IS
+      
+      TYPE DAY  IS (MON, TUE, WED, THU, FRI, SAT, SUN);
+      TYPE LIST IS ARRAY (DAY RANGE <>) OF BOOLEAN;
+      TYPE GRID IS ARRAY (DAY RANGE <>, DAY RANGE <>) OF BOOLEAN;
+      SUBTYPE WEEKEND IS DAY RANGE SAT .. SUN;
+      SUBTYPE WEEKDAY IS DAY RANGE MON .. FRI;
+    
+      FUNCTION "*" (X, Y : INTEGER) RETURN WEEKDAY IS
+      BEGIN 
+           RETURN MON;
+      END "*";
+ 
+      FUNCTION "*" (X, Y : INTEGER) RETURN BOOLEAN IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                   " IN SUBTYPE INDICATIONS");
+           RETURN TRUE;
+      END "*";
+   
+      FUNCTION "+" (X, Y : INTEGER) RETURN WEEKEND IS
+      BEGIN 
+           RETURN SAT;
+      END "+";
+ 
+      FUNCTION "+" (X, Y : INTEGER) RETURN FLOAT IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                   " IN SUBTYPE INDICATIONS");
+           RETURN 2.0;
+      END "+";
+   
+ BEGIN
+      TEST ("C87B14C","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &  
+            "OF SUBTYPE INDICATIONS");
+    
+      DECLARE
+           SUBTYPE LIST1 IS LIST (WED .. (0 + 0));
+           SUBTYPE LIST2 IS LIST ( 0 * 0 .. TUE);
+           SUBTYPE LIST3 IS LIST ((0 + 0) .. (0 + 0));
+           SUBTYPE LIST4 IS LIST ((0 * 0) .. (0 + 0));
+    
+           SUBTYPE GRID1 IS GRID (MON .. (0 * 0), (0 * 0) .. TUE);
+           SUBTYPE GRID2 IS GRID ((0 * 0) .. WED, FRI .. (0 + 0));
+           SUBTYPE GRID3 IS GRID
+               ((0 * 0) .. (0 * 0), (0 + 0) .. (0 + 0));
+           SUBTYPE GRID4 IS GRID ((0 * 0) .. (0 + 0), TUE .. THU);
+   
+      BEGIN
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B14C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b14d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b14d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- C87B14D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, IF A BOUND IS OF
+ -- TYPE UNIVERSAL_INTEGER, IT IS IMPLICITLY CONVERTED TO THE
+ -- INDEX BASE TYPE.
+   
+ -- TRH  7 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B14D IS
+      
+      TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      TYPE LIST  IS ARRAY (WHOLE RANGE <>) OF BOOLEAN;
+   
+ BEGIN
+      TEST ("C87B14D","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &
+            "OF SUBTYPE INDICATIONS WITH UNIVERSAL_INTEGER BOUNDS");
+    
+      DECLARE
+           FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE 
+                RENAMES "*";
+    
+           SUBTYPE LIST1 IS LIST (1 + 1 .. 1 + 1);
+           SUBTYPE LIST2 IS LIST (1     .. 3 + 3);
+           SUBTYPE LIST3 IS LIST (1 + 1 ..     2);
+   
+      BEGIN
+           IF LIST1'FIRST /= 1 OR LIST1'LAST /= 1 OR
+              LIST2'FIRST /= 1 OR LIST2'LAST /= 9 OR
+              LIST3'FIRST /= 1 OR LIST3'LAST /= 2 THEN 
+              FAILED ("RESOLUTION INCORRECT - IMPLICIT CONVERSION " &
+                      "OF UNIVERSAL_INTEGER TYPE TO INDEX CONSTRAINT " &
+                      "BASE TYPE");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B14D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b15a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b15a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b15a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b15a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C87B15A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE ARRAY ATTRIBUTES OF THE FORM: A'FIRST (N), A'LAST (N), 
+ -- A'RANGE (N) AND A'LENGTH (N) MUST HAVE A PARAMETER (N) WHICH IS OF
+ -- THE TYPE UNIVERSAL_INTEGER.
+   
+ -- TRH  26 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B15A IS
+  
+      FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+           RENAMES STANDARD."*";
+  
+      TYPE BOX IS ARRAY (0 .. 1, 3 .. 6, 5 .. 11) OF BOOLEAN;
+      B1 : BOX;
+  
+ BEGIN
+      TEST ("C87B15A","ARRAY ATTRIBUTES: FIRST (N), LAST (N), RANGE " &
+            "(N) AND LENGTH (N) TAKE UNIVERSAL_INTEGER OPERANDS");
+  
+      IF BOX'FIRST  (1 + 0) /= 0    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 1");
+      END IF;
+ 
+      IF B1'FIRST   (1 + 1) /= 3    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 2");
+      END IF;
+ 
+      IF B1'FIRST   (2 + 1) /= 5    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 3");
+      END IF;
+ 
+      IF BOX'LAST   (0 + 1) /= 1    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 4");
+      END IF;
+ 
+      IF B1'LAST    (1 + 1) /= 6    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 5");
+      END IF;
+ 
+      IF B1'LAST    (1 + 2) /= 11   THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 6");
+      END IF;
+ 
+      IF BOX'LENGTH (0 + 1) /= 2    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 7");
+      END IF;
+ 
+      IF B1'LENGTH  (1 + 1) /= 4    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 8");
+      END IF;
+ 
+      IF B1'LENGTH  (2 + 1) /= 7    THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 9");
+      END IF;
+ 
+      IF 1 NOT IN BOX'RANGE (0 + 1) THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 10");
+      END IF;
+ 
+      IF 4 NOT IN B1'RANGE  (1 + 1) THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 11");
+      END IF;
+ 
+      IF 9 NOT IN B1'RANGE  (2 + 1) THEN
+           FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                   "UNIVERSAL_INTEGER - 12");
+      END IF;
+ 
+      RESULT;
+ END C87B15A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b16a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b16a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b16a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b16a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- C87B16A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR A DEFAULT RECORD COMPONENT, THE TYPE OF THE INITIALIZATION
+ -- EXPRESSION MUST MATCH THE COMPONENTS'S EXPLICIT TYPEMARK.
+ --      
+ -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+ -- 
+ --    (A): A CALL TO AN OVERLOADED FUNCTION.
+ --    (B): AN OVERLOADED OPERATOR SYMBOL.
+ --    (C): AN OVERLOADED (INFIX) OPERATOR.
+ --    (D): AN OVERLOADED ENUMERATION LITERAL.
+   
+ -- TRH  23 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B16A IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+      
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END F1;
+     
+      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B16A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+            " IN DEFAULT RECORD COMPONENTS");
+      DECLARE
+ 
+           FUNCTION "-" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES F1;
+     
+           FUNCTION "-" (X, Y : WHOLE)   RETURN WHOLE
+                RENAMES F1;
+      
+           FUNCTION "-" (X, Y : INTEGER) RETURN HUE
+                RENAMES F1;
+    
+           FUNCTION "-" (X, Y : INTEGER) RETURN CITRUS
+                RENAMES F1;
+       
+           TYPE REC IS
+                RECORD
+                     I1 : INTEGER := F1  (0, 0);
+                     W1 : WHOLE   := F1  (0, 0);
+                     C1 : CITRUS  := F1  (0, 0);
+                     H1 : HUE     := F1  (0, 0);
+    
+                     I2 : INTEGER := "-" (0, 0);
+                     W2 : WHOLE   := "-" (0, 0);
+                     C2 : CITRUS  := "-" (0, 0);
+                     H2 : HUE     := "-" (0, 0);
+       
+                     I3 : INTEGER := (0 - 0);
+                     W3 : WHOLE   := (0 - 0);
+                     C3 : CITRUS  := (0 - 0);
+                     H3 : HUE     := (0 - 0);
+       
+                     C4 : CITRUS  := ORANGE;
+                     H4 : HUE     := ORANGE;
+                END RECORD;
+ 
+           R1 : REC;
+   
+      BEGIN
+           IF R1.I1              /= -1 OR R1.W1           /= 0 OR
+              CITRUS'POS (R1.C1) /=  2 OR HUE'POS (R1.H1) /= 1 THEN
+              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+           END IF;
+     
+           IF R1.I2              /= -1 OR R1.W2           /= 0 OR
+              CITRUS'POS (R1.C2) /=  2 OR HUE'POS (R1.H2) /= 1 THEN
+              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+           END IF;
+     
+           IF R1.I3              /= -1 OR R1.W3           /= 0 OR
+              CITRUS'POS (R1.C3) /=  2 OR HUE'POS (R1.H3) /= 1 THEN
+              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+           END IF;
+     
+           IF CITRUS'POS (R1.C4) /=  2 OR HUE'POS (R1.H4) /= 1 THEN
+              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B16A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b17a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b17a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b17a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b17a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- C87B17A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+   
+ -- THE INITIALIZATION EXPRESSION FOR A DEFAULT DISCRIMINANT
+ -- IN A TYPE DECLARATION MUST MATCH THE DISCRIMINANT'S EXPLICIT
+ -- TYPEMARK.
+ --
+ -- THE THREE KINDS OF TYPE DECLARATIONS TESTED HERE ARE:
+ --
+ --    (A): RECORD TYPE.
+ --    (B): PRIVATE TYPE.
+ --    (C): INCOMPLETE RECORD TYPE.
+     
+ -- TRH  18 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B17A IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+    
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END F1;
+     
+      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B17A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+            " IN DEFAULT DISCRIMINANTS");
+    
+      DECLARE
+ 
+           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES F1;
+     
+           FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE
+                RENAMES F1;
+      
+           FUNCTION "+" (X, Y : INTEGER) RETURN HUE
+                RENAMES F1;
+    
+           FUNCTION "+" (X, Y : INTEGER) RETURN CITRUS
+                RENAMES F1;
+ 
+           TYPE REC1 (I1 : INTEGER := 0 + 0; H1 : HUE := F1 (0, 0) ) IS
+                RECORD
+                     NULL;
+                END RECORD;
+     
+           PACKAGE PVT IS 
+                TYPE REC2 (H2 : HUE := ORANGE; W2 : WHOLE := 0 + 0 )
+                     IS PRIVATE;
+           PRIVATE
+                TYPE REC2 (H2 : HUE := ORANGE; W2 : WHOLE := 0 + 0 ) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+           END PVT;
+           USE PVT;
+   
+           TYPE REC3 (C1 : CITRUS := ORANGE; W1 : WHOLE := "+" (0, 0));
+   
+           TYPE LINK IS ACCESS REC3;
+    
+           TYPE REC3 (C1 : CITRUS := ORANGE; W1 : WHOLE := "+" (0, 0)) IS
+                RECORD
+                     NULL;
+                END RECORD;
+    
+           R1 : REC1;
+           R2 : REC2;
+           R3 : REC3;
+    
+      BEGIN
+           IF R1.I1 /= -1 OR HUE'POS (R1.H1) /= 1 THEN 
+              FAILED ("(A): RESOLUTION INCORRECT FOR RECORD TYPES");
+           END IF;
+    
+           IF HUE'POS (R2.H2) /=  1 OR R2.W2 /= 0 THEN
+              FAILED ("(B): RESOLUTION INCORRECT FOR PRIVATE TYPES");
+           END IF;
+   
+           IF CITRUS'POS (R3.C1) /= 2 OR R3.W1 /= 0 THEN
+              FAILED ("(C): RESOLUTION INCORRECT FOR INCOMPLETE" &
+                      " RECORD TYPES");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B17A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b18a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b18a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b18a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b18a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C87B18A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE TYPES OF THE EXPRESSIONS IN A DISCRIMINANT CONSTRAINT IN
+ -- A SUBTYPE INDICATION MUST MATCH THE DISCRIMINANT'S EXPLICIT
+ -- TYPEMARK.
+   
+ -- TRH  1 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B18A IS
+      
+      ERR : BOOLEAN := FALSE;
+  
+      FUNCTION F1 RETURN INTEGER IS
+      BEGIN 
+           RETURN 1;
+      END F1;
+ 
+      FUNCTION F1 RETURN FLOAT IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN 0.0;
+      END F1;
+  
+      FUNCTION F2 RETURN BOOLEAN IS
+      BEGIN
+           RETURN TRUE;
+      END F2;
+ 
+      FUNCTION F2 RETURN STRING IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN "STRING";
+      END F2;
+   
+ BEGIN
+      TEST ("C87B18A","OVERLOADED EXPRESSIONS IN DISCRIMINANT " &
+            "CONSTRAINTS");
+    
+      DECLARE
+           TYPE REC (X : INTEGER := 0; Y : BOOLEAN := TRUE) IS
+                RECORD
+                     NULL;
+                END RECORD;
+  
+           R1 : REC (F1, F2);
+           R2 : REC (Y => F2, X => F1);
+ 
+      BEGIN
+           IF ERR THEN 
+                FAILED ("RESOLUTION INCORRECT - DISCRIMINANT " &
+                        "CONSTRAINT MUST MATCH DISCRIMINANT TYPE");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B18A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b18b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b18b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b18b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b18b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C87B18B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE EXPRESSION IN A NAMED OR POSITIONAL DISCRIMINANT ASSOCIATION
+ -- MUST MATCH THE TYPE OF THE CORRESPONDING DISCRIMINANT.
+   
+ -- TRH  9 AUG 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B18B IS
+  
+      TYPE REC (W, X : CHARACTER; Y, Z : BOOLEAN) IS
+           RECORD
+                NULL;
+           END RECORD;
+  
+      TYPE FLAG IS (PASS, FAIL);
+      
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("DISCRIMINANT ASSOCIATION EXPRESSION MUST " &
+                        "MATCH THE TYPE OF THE CORRESPONDING " &
+                        "DISCRIMINANT");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (FLOAT,     2.0, FAIL);
+      FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
+      FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+      FUNCTION F IS NEW F1 (CHARACTER, 'E', PASS);
+  
+      FUNCTION G IS NEW F1 (FLOAT,     2.0, FAIL);
+      FUNCTION G IS NEW F1 (INTEGER,     5, FAIL);
+      FUNCTION G IS NEW F1 (BOOLEAN,  TRUE, PASS);
+      FUNCTION G IS NEW F1 (CHARACTER, 'E', FAIL);
+     
+ BEGIN
+      TEST ("C87B18B","OVERLOADED DISCRIMINANT ASSOCIATIONS");
+     
+      DECLARE
+           SUBTYPE R1 IS REC (F, F, G, G);
+           SUBTYPE R2 IS REC (X => F, Y => G, Z => G, W => F);
+           SUBTYPE R3 IS REC (F, F, Z => G, Y => G);
+    
+      BEGIN
+           NULL;
+      END;
+  
+      RESULT;
+ END C87B18B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b19a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b19a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b19a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b19a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,110 ----
+ -- C87B19A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ --     SIMPLE EXPRESSIONS AND RANGE BOUNDS OF VARIANT CHOICES MUST MATCH
+ --     THE TYPE OF THE DISCRIMINANT'S EXPLICIT TYPEMARK.
+ 
+ --HISTORY:
+ --     DSJ 06/15/83 CREATED ORIGINAL TEST.
+ --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C87B19A IS
+ 
+      TYPE COLOR  IS (YELLOW, RED, BLUE, GREEN, BROWN);
+      TYPE SCHOOL IS (YALE, HARVARD, PRINCETON, BROWN, STANFORD);
+      TYPE COOK   IS (BROIL, BAKE, BROWN, TOAST, FRY);
+      TYPE MIXED  IS (GREEN, BROWN, YALE, BAKE, BLUE, FRY);
+ 
+      RATING : INTEGER := 0;
+ 
+      FUNCTION OK RETURN BOOLEAN IS
+      BEGIN
+           RATING := RATING + 1;
+           RETURN FALSE;
+      END OK;
+ 
+      FUNCTION ERR RETURN BOOLEAN IS
+      BEGIN
+           FAILED ("VARIANT CHOICES MUST MATCH TYPE OF DISCRIMINANT");
+           RETURN FALSE;
+      END ERR;
+ 
+ BEGIN
+      TEST ("C87B19A","OVERLOADED EXPRESSIONS AND RANGE BOUNDS" &
+            " OF VARIANT CHOICES");
+      DECLARE
+ 
+           TYPE REC (X : MIXED := BROWN) IS
+                RECORD
+                     CASE X IS
+                          WHEN GREEN .. BROWN  => NULL;
+                          WHEN BLUE            => NULL;
+                          WHEN FRY             => NULL;
+                          WHEN YALE            => NULL;
+                          WHEN OTHERS          => NULL;
+                     END CASE;
+                END RECORD;
+ 
+           R1 : REC (X => FRY);
+           R2 : REC (X => BLUE);
+           R3 : REC (X => BAKE);
+           R4 : REC (X => YALE);
+           R5 : REC (X => BROWN);
+           R6 : REC (X => GREEN);
+ 
+      BEGIN
+           IF MIXED'POS(R1.X) /= 5 THEN
+              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                      "DISCRIMINANT-R1");
+           END IF;
+           IF MIXED'POS(R2.X) /= 4 THEN
+              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                      "DISCRIMINANT-R2");
+           END IF;
+           IF MIXED'POS(R3.X) /= 3 THEN
+              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                      "DISCRIMINANT-R3");
+           END IF;
+           IF MIXED'POS(R4.X) /= 2 THEN
+              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                      "DISCRIMINANT-R4");
+           END IF;
+           IF MIXED'POS(R5.X) /= 1 THEN
+              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                      "DISCRIMINANT-R5");
+           END IF;
+           IF MIXED'POS(R6.X) /= 0 THEN
+              FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                      "DISCRIMINANT-R6");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C87B19A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b23a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b23a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b23a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b23a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C87B23A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR AN INDEXED COMPONENT OF AN ARRAY, THE PREFIX MUST BE 
+ -- APPROPRIATE FOR AN ARRAY TYPE. EACH EXPRESSION FOR THE INDEXED 
+ -- COMPONENT MUST BE OF THE TYPE OF THE CORRESPONDING INDEX AND
+ -- THERE MUST BE ONE SUCH EXPRESSION FOR EACH INDEX POSITION OF THE 
+ -- ARRAY TYPE.
+   
+ -- TRH  15 SEPT 82
+ -- DSJ  07 JUNE 83
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B23A IS
+ 
+      SUBTYPE CHAR IS CHARACTER;
+      TYPE GRADE IS (A, B, C, D, F);
+      TYPE NOTE  IS (A, B, C, D, E, F, G);
+      TYPE INT   IS NEW INTEGER;
+      TYPE POS   IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+      TYPE NAT   IS NEW POS;
+      TYPE BOOL  IS NEW BOOLEAN;
+      TYPE BIT   IS NEW BOOL;
+      TYPE LIT   IS (FALSE, TRUE);
+      TYPE FLAG  IS (PASS, FAIL);
+ 
+      TYPE NUM2 IS DIGITS(2);
+      TYPE NUM3 IS DIGITS(2);
+      TYPE NUM4 IS DIGITS(2);
+ 
+      TYPE A1 IS ARRAY (POS'(1)..5, NOTE'(A)..D, BOOL'(FALSE)..TRUE)
+           OF FLOAT;
+      TYPE A2 IS ARRAY (INT'(1)..5, NOTE'(A)..D, BIT'(FALSE)..TRUE)
+           OF NUM2;
+      TYPE A3 IS ARRAY (POS'(1)..5, GRADE'(A)..D, BOOL'(FALSE)..TRUE)
+           OF NUM3;
+      TYPE A4 IS ARRAY (NAT'(1)..5, NOTE'(A)..D, LIT'(FALSE)..TRUE)
+           OF NUM4;
+      
+      OBJ1 : A1 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+      OBJ2 : A2 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+      OBJ3 : A3 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+      OBJ4 : A4 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("PREFIX OR INDEX IS NOT APPROPRIATE FOR" &
+                        " INDEXED COMPONENT");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION A IS NEW F1 (A1, OBJ1, PASS);
+      FUNCTION A IS NEW F1 (A2, OBJ2, FAIL);
+      FUNCTION A IS NEW F1 (A3, OBJ3, FAIL);
+      FUNCTION A IS NEW F1 (A4, OBJ4, FAIL);
+   
+ BEGIN
+      TEST ("C87B23A","OVERLOADED ARRAY INDEXES");
+     
+      DECLARE
+           F1 : FLOAT := A (3, C, TRUE);
+    
+      BEGIN
+           NULL;
+      END;
+  
+      RESULT;
+ END C87B23A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b24a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b24a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b24a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b24a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C87B24A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+     
+ -- THE PREFIX OF A SLICE MUST BE APPROPRIATE FOR A ONE DIMENSIONAL
+ -- ARRAY TYPE.
+   
+ -- TRH  26 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B24A IS
+  
+      TYPE LIST IS ARRAY (1 .. 5) OF INTEGER;
+      TYPE GRID IS ARRAY (1 .. 5, 1 .. 5) OF INTEGER;
+      TYPE CUBE IS ARRAY (1 .. 5, 1 .. 5, 1 .. 5) OF INTEGER;
+      TYPE HYPE IS ARRAY (1 .. 5, 1 .. 5, 1 .. 5, 1 .. 5) OF INTEGER;
+      TYPE FLAG IS (PASS, FAIL);
+    
+      L : LIST := (1 .. 5 => 0);
+      G : GRID := (1 .. 5 => (1 .. 5 => 0));
+      C : CUBE := (1 .. 5 => (1 .. 5 => (1 .. 5 => 0)));
+      H : HYPE := (1 .. 5 => (1 .. 5 => (1 .. 5 => (1 .. 5 => 0))));
+  
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN
+           IF STAT = FAIL THEN 
+              FAILED ("SLICE PREFIX MUST BE APPROPRIATE FOR ONE " &
+                      "DIMENSIONAL ARRAY");
+           END IF;
+           RETURN ARG;
+      END F1;
+  
+      FUNCTION F2 IS NEW F1 (LIST, L, PASS);
+      FUNCTION F2 IS NEW F1 (GRID, G, FAIL);
+      FUNCTION F2 IS NEW F1 (CUBE, C, FAIL);
+      FUNCTION F2 IS NEW F1 (HYPE, H, FAIL);
+     
+ BEGIN
+      TEST ("C87B24A","OVERLOADED PREFIX FOR SLICE RESOLVED TO " &
+            "ONE DIMENSIONAL ARRAY TYPE");
+  
+      DECLARE
+           S1 : INTEGER;
+  
+      BEGIN
+           S1 := F2 (2 .. 3)(2);
+      END;
+  
+      RESULT;
+ END C87B24A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b24b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b24b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b24b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b24b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C87B24B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+     
+ -- THE RANGE BOUNDS FOR A SLICE MUST BE DISCRETE AND OF THE SAME BASE
+ -- TYPE AS THE ARRAY INDEX.
+   
+ -- TRH  15 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B24B IS
+  
+      TYPE PIECE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+  
+      PI  : PIECE (1 .. 8) := (3, 1, 4, 1, 5, 9, 2, 6);
+      S1  : PIECE (1 .. 3);
+      S2  : PIECE (4 .. 8);
+      ERR : BOOLEAN := FALSE;
+        
+      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+      BEGIN 
+           RETURN X;
+      END F1;
+        
+      FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN 0.0;
+      END F1;
+     
+      FUNCTION F2 (X : INTEGER) RETURN INTEGER IS
+      BEGIN 
+           RETURN X;
+      END F2;
+     
+      FUNCTION F2 (X :INTEGER) RETURN CHARACTER IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN 'A';
+      END F2;
+     
+ BEGIN
+      TEST ("C87B24B","OVERLOADING RESOLUTION OF RANGE " &
+            "CONSTRAINTS FOR SLICES");
+  
+      DECLARE
+           FUNCTION "+" (X : INTEGER) RETURN INTEGER 
+                RENAMES F1;
+    
+           FUNCTION "+" (X : INTEGER) RETURN FLOAT 
+                RENAMES F1;
+    
+           FUNCTION "-" (X : INTEGER) RETURN INTEGER 
+                RENAMES F2;
+  
+           FUNCTION "-" (X : INTEGER) RETURN CHARACTER
+                RENAMES F2;
+   
+      BEGIN 
+           S1 := PI ("+" (3) .. "-" (5));
+           S1 := PI (F2  (2) .. "+" (4));
+           S1 := PI ("-" (6) .. F1  (8));
+           S1 := PI (F2  (1) .. F2  (3));
+           S2 := PI (F2  (4) .. F1  (8));
+           S2 := PI (2       .. "+" (6));
+           S2 := PI (F1  (1) ..       5);
+           S2 := PI ("+" (3) .. "+" (7));
+   
+           IF ERR THEN
+                FAILED (" OVERLOADING RESOLUTION INCORRECT FOR SLICES");
+           END IF;
+      END;
+  
+      RESULT;
+ END C87B24B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b26b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b26b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b26b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b26b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- C87B26B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'ADDRESS, 'CONSTRAINED, 'SIZE, AND 'STORAGE_SIZE MAY BE
+ -- USED WITH THE DESIGNATED OBJECTS OF ACCESS VALUES RETURNED FROM
+ -- OVERLOADED FUNCTIONS, AND THAT EXPLICIT DEREFERENCING IS USED BY
+ -- OVERLOADING RESOLUTION TO RESOLVE THE PREFIXES OF THE ATTRIBUTES.
+ 
+ -- DSJ 22 JUN 83
+ -- JBG 11/22/83
+ -- JBG 4/23/84
+ -- JBG 5/25/85
+ 
+ WITH REPORT;  WITH SYSTEM;
+ USE  REPORT;  USE  SYSTEM;
+ 
+ PROCEDURE C87B26B IS
+ 
+      TYPE REC (D : INTEGER) IS
+           RECORD
+                C1, C2 : INTEGER;
+           END RECORD;
+      TYPE P_REC IS ACCESS REC;
+ 
+      P_REC_OBJECT : P_REC := NEW REC'(1,1,1);
+ 
+      TYPE BIG_INT IS RANGE 0..SYSTEM.MAX_INT;
+      TASK TYPE TASK_TYPE IS
+           -- NOTHING AT ALL
+      END TASK_TYPE;
+ 
+      TYPE P_TASK IS ACCESS TASK_TYPE;
+ 
+      P_TASK_OBJECT : P_TASK;
+ 
+      TASK BODY TASK_TYPE IS
+      BEGIN
+           NULL;
+      END TASK_TYPE;
+ 
+      ------------------------------------------------------------
+ 
+      FUNCTION F RETURN REC IS
+      BEGIN
+           RETURN (0,0,0);
+      END F;
+ 
+      FUNCTION F RETURN P_REC IS
+      BEGIN
+           RETURN P_REC_OBJECT;
+      END F;
+ 
+      ------------------------------------------------------------
+ 
+      FUNCTION G RETURN TASK_TYPE IS
+           NEW_TASK : TASK_TYPE;
+      BEGIN
+           RETURN NEW_TASK;
+      END G;
+ 
+      FUNCTION G RETURN P_TASK IS
+      BEGIN
+           RETURN P_TASK_OBJECT;
+      END G;
+ 
+      ------------------------------------------------------------
+ 
+ BEGIN
+ 
+      TEST("C87B26B","CHECK THAT EXPLICIT DEREFERENCING IN AN " &
+           "ATTRIBUTE PREFIX IS USED IN OVERLOADING RESOLUTION " &
+           "WITH 'ADDRESS, 'CONSTRAINED, 'SIZE, AND 'STORAGE_SIZE");
+ 
+      DECLARE
+ 
+           A : ADDRESS;   -- FOR 'ADDRESS OF RECORD
+           B : BOOLEAN;   -- FOR 'CONSTRAINED OF RECORD
+           C : INTEGER;   -- FOR 'SIZE OF RECORD
+           D : ADDRESS;   -- FOR 'ADDRESS OF TASK
+           E : BIG_INT;   -- FOR 'STORAGE_SIZE OF TASK
+ 
+      BEGIN
+ 
+           P_TASK_OBJECT := NEW TASK_TYPE;
+           A := F.ALL'ADDRESS;
+           B := F.ALL'CONSTRAINED;
+           C := F.ALL'SIZE;
+           D := G.ALL'ADDRESS;
+           E := G.ALL'STORAGE_SIZE;
+ 
+           IF A /= P_REC_OBJECT.ALL'ADDRESS THEN
+                FAILED("INCORRECT RESOLUTION FOR 'ADDRESS - REC");
+           END IF;
+ 
+           IF B /= P_REC_OBJECT.ALL'CONSTRAINED THEN
+                FAILED("INCORRECT RESOLUTION FOR 'CONSTRAINED");
+           END IF;
+ 
+           IF C /= P_REC_OBJECT.ALL'SIZE THEN
+                FAILED("INCORRECT RESOLUTION FOR 'SIZE");
+           END IF;
+ 
+           IF D /= P_TASK_OBJECT.ALL'ADDRESS THEN
+                FAILED("INCORRECT RESOLUTION FOR 'ADDRESS - TASK");
+           END IF;
+ 
+           IF E /= P_TASK_OBJECT.ALL'STORAGE_SIZE THEN
+                FAILED("INCORRECT RESOLUTION FOR 'STORAGE_SIZE");
+           END IF;
+ 
+           IF A = P_REC_OBJECT'ADDRESS THEN
+                FAILED("INCORRECT DEREFERENCING FOR 'ADDRESS - REC");
+           END IF;
+ 
+           IF C = P_REC_OBJECT'SIZE AND C /= P_REC_OBJECT.ALL'SIZE THEN
+                FAILED("INCORRECT DEREFERENCING FOR 'SIZE");
+           END IF;
+ 
+           IF D = P_TASK_OBJECT'ADDRESS THEN
+                FAILED("INCORRECT DEREFERENCING FOR 'ADDRESS - TASK");
+           END IF;
+ 
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C87B26B; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b27a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b27a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b27a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b27a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C87B27A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE TYPE OF A STRING LITERAL MUST BE DETERMINED FROM THE FACT
+ -- THAT A STRING LITERAL IS A VALUE OF A ONE DIMENSIONAL ARRAY OF
+ -- CHARACTER COMPONENTS.
+   
+ -- TRH  18 AUG 82
+ -- DSJ  07 JUN 83
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B27A IS
+  
+      TYPE ENUMLIT   IS (A, B, C, D, E, F);
+      TYPE NEW_CHAR  IS NEW CHARACTER RANGE 'G' .. 'Z';
+      TYPE CHARS3    IS ('G','H','I','K','M','N','P','R','S','T');
+      TYPE CHARS4    IS ('S','T','R','I','N','G','Z','A','P');
+      TYPE NEW_STR   IS ARRAY  (A .. F) OF NEW_CHAR;
+      TYPE STRING3   IS ARRAY  (11..16) OF CHARS3;
+      TYPE STRING4   IS ARRAY  (21..26) OF CHARS4;
+      TYPE ENUM_VEC  IS ARRAY  (1 .. 6) OF ENUMLIT;
+      TYPE CHAR_GRID IS ARRAY  (D .. F, 1 .. 3) OF NEW_CHAR;
+      TYPE STR_LIST  IS ARRAY  (1 .. 6) OF STRING (1 .. 1);
+      ERR : BOOLEAN  := FALSE;
+  
+      PROCEDURE P (X : NEW_STR) IS
+      BEGIN
+           NULL;
+      END P;
+  
+      PROCEDURE P (X : ENUM_VEC) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+  
+      PROCEDURE P (X : CHAR_GRID) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+  
+      PROCEDURE P (X : STR_LIST) IS
+      BEGIN
+           ERR := TRUE;
+      END P;
+  
+ BEGIN
+      TEST ("C87B27A","OVERLOADING RESOLUTION OF STRING LITERALS");
+     
+      P ("STRING");
+  
+      IF ERR THEN
+           FAILED ("RESOLUTION INCORRECT FOR STRING LITERALS");
+      END IF;
+  
+      RESULT;
+ END C87B27A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b28a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b28a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b28a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b28a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C87B28A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE TYPE OF THE LITERAL "NULL" MUST BE DETERMINED FROM THE FACT 
+ -- THAT "NULL" IS A VALUE OF AN ACCESS TYPE.
+   
+ -- TRH  13 AUG 82
+ -- JRK 2/2/84
+ 
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B28A IS
+  
+      ERR : BOOLEAN := FALSE;
+  
+      TYPE A2 IS ACCESS BOOLEAN;
+      TYPE A3 IS ACCESS INTEGER;
+      TYPE A1 IS ACCESS A2;
+  
+      FUNCTION F RETURN A1 IS
+      BEGIN 
+           RETURN NEW A2;
+      END F;
+  
+      FUNCTION F RETURN A2 IS
+      BEGIN
+           ERR := TRUE;
+           RETURN NEW BOOLEAN;
+      END F;
+  
+      FUNCTION F RETURN A3 IS
+      BEGIN
+           ERR := TRUE;
+           RETURN (NEW INTEGER);
+      END F;
+  
+ BEGIN
+      TEST ("C87B28A", "OVERLOADING OF THE ACCESS TYPE LITERAL 'NULL'");
+     
+      F.ALL := NULL;
+  
+      IF ERR THEN
+           FAILED ("RESOLUTION INCORRECT FOR THE ACCESS TYPE LITERAL " &
+                   "'NULL'");
+      END IF;
+  
+      RESULT;
+ END C87B28A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b29a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b29a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b29a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b29a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C87B29A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- AGGREGATES CONTAINING A SINGLE COMPONENT ASSOCIATION MUST
+ -- USE ONLY NAMED NOTATION.
+   
+ -- TRH  4 AUG 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B29A IS
+      
+      TYPE VECTOR IS ARRAY (1 .. 1) OF INTEGER;
+  
+      TYPE REC IS
+           RECORD
+                X : INTEGER;
+           END RECORD;
+  
+      ERR : BOOLEAN := FALSE;
+  
+      PROCEDURE P1 (X : INTEGER) IS
+      BEGIN
+           NULL;
+      END P1;
+  
+      PROCEDURE P1 (X : VECTOR) IS
+      BEGIN
+           ERR := TRUE;
+      END P1;
+  
+      PROCEDURE P1 (X : REC) IS
+      BEGIN
+           ERR := TRUE;
+      END P1;
+  
+ BEGIN
+      TEST ("C87B29A","AGGREGATES CONTAINING A SINGLE COMPONENT " &
+            "ASSOCIATION MUST USE NAMED NOTATION");
+    
+      P1 ( (0) );  -- INTEGER PARAMETER, NOT AN AGGREGATE PARAMETER
+  
+      IF ERR THEN
+         FAILED ("RESOLUTION INCORRECT - AGGREGATES WITH A SINGLE " &
+                 "COMPONENT ASSOCIATION MUST USE NAMED NOTATION");
+      END IF;
+     
+      RESULT;
+ END C87B29A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b30a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b30a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b30a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b30a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C87B30A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE EXPRESSION OF A COMPONENT ASSOCIATION MUST MATCH THE TYPE OF THE 
+ -- ASSOCIATED RECORD COMPONENT.
+   
+ -- TRH  9 AUG 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B30A IS
+  
+      TYPE REC IS
+           RECORD
+                W, X : FLOAT;
+                Y, Z : INTEGER;
+           END RECORD;
+  
+      TYPE FLAG IS (PASS, FAIL);
+      
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("COMPONENT ASSOCIATION EXPRESSION MUST MATCH " &
+                        "RECORD COMPONENT TYPE");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (FLOAT,     2.0, PASS);
+      FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
+      FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+      FUNCTION F IS NEW F1 (CHARACTER, 'E', FAIL);
+  
+      FUNCTION G IS NEW F1 (FLOAT,     2.0, FAIL);
+      FUNCTION G IS NEW F1 (INTEGER,     5, PASS);
+      FUNCTION G IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+      FUNCTION G IS NEW F1 (CHARACTER, 'E', FAIL);
+     
+ BEGIN
+      TEST ("C87B30A","OVERLOADED EXPRESSIONS IN RECORD AGGREGATE " &
+            "COMPONENT ASSOCIATIONS");
+     
+      DECLARE
+           R1 : REC := (F, F, G, G);
+           R2 : REC := (X => F, Y => G, Z => G, W => F);
+           R3 : REC := (F, F, Z => G, Y => G);
+    
+      BEGIN
+           NULL;
+      END;
+  
+      RESULT;
+ END C87B30A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b31a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b31a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b31a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b31a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,137 ----
+ -- C87B31A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IF THE TYPE OF AN AGGREGATE IS A ONE-DIMENSIONAL ARRAY TYPE
+ -- THEN EACH CHOICE MUST SPECIFY VALUES OF THE INDEX TYPE, AND
+ -- THE EXPRESSION OF EACH COMPONENT ASSOCIATION MUST BE OF THE
+ -- COMPONENT TYPE.
+   
+ -- TRH  8 AUG 82
+ -- DSJ 15 JUN 83
+ -- JRK  2 FEB 84
+ -- JBG 4/23/84
+ 
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B31A IS
+  
+      TYPE LETTER  IS NEW CHARACTER RANGE 'A' .. 'Z';
+      TYPE NOTE    IS (A, B, C, D, E, F, G, H);
+      TYPE STR     IS NEW STRING (1 .. 1);
+      TYPE BIT     IS NEW BOOLEAN;
+      TYPE YES     IS NEW BOOLEAN RANGE TRUE  .. TRUE;
+      TYPE NO      IS NEW BOOLEAN RANGE FALSE .. FALSE;
+      TYPE BOOLEAN IS (FALSE, TRUE);
+      TYPE LIST    IS ARRAY (CHARACTER RANGE <>) OF BIT;
+      TYPE FLAG    IS (PASS,  FAIL);
+      
+      SUBTYPE LIST_A  IS LIST('A'..'A');
+      SUBTYPE LIST_E  IS LIST('E'..'E');
+      SUBTYPE LIST_AE IS LIST('A'..'E');
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("RESOLUTION INCORRECT FOR EXPRESSIONS " &
+                        "IN ARRAY AGGREGATES");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
+      FUNCTION F IS NEW F1 (YES,     TRUE,  FAIL);
+      FUNCTION F IS NEW F1 (NO,      FALSE, FAIL);
+      FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
+   
+      FUNCTION G IS NEW F1 (CHARACTER, 'A', PASS);
+      FUNCTION G IS NEW F1 (LETTER,    'A', FAIL);
+      FUNCTION G IS NEW F1 (STR,       "A", FAIL);
+   
+      FUNCTION H IS NEW F1 (CHARACTER, 'E', PASS);
+      FUNCTION H IS NEW F1 (LETTER,    'E', FAIL);
+      FUNCTION H IS NEW F1 (STR,       "E", FAIL);
+     
+ BEGIN
+      TEST ("C87B31A", "OVERLOADED EXPRESSIONS IN ARRAY AGGREGATES");
+     
+      DECLARE
+           L1, L2 : LIST_A :=  (OTHERS => FALSE);
+           L3, L4 : LIST_E :=  (OTHERS => FALSE);
+           L5, L6 : LIST_AE := (OTHERS => FALSE);
+           L7, L8 : LIST_AE := (OTHERS => FALSE);
+ 
+      BEGIN
+           L1 := ('A' => F);
+           L2 := ( G  => F);
+           L3 := ('E' => F);
+           L4 := ( H  => F);
+           L5 := ('A'..'E' => F);
+           L6 := (F,F,F,F,F);
+           L7 := (F,F,F, OTHERS => F);
+           L8 := LIST_AE'('E' => F, 'B' => F, OTHERS => F);
+   
+           IF L1 /= LIST_A'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L1");
+           END IF;
+           IF L2 /= LIST_A'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L2");
+           END IF;
+           IF L3 /= LIST_E'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L3");
+           END IF;
+           IF L4 /= LIST_E'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L4");
+           END IF;
+           IF L5 /= LIST_AE'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L5");
+           END IF;
+           IF L6 /= LIST_AE'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L6");
+           END IF;
+           IF L7 /= LIST_AE'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L7");
+           END IF;
+           IF L8 /= LIST_AE'(OTHERS => TRUE) THEN
+                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                          " EXPRESSIONS IN ARRAY AGGREGATES - L8");
+           END IF;
+      END;
+  
+      RESULT;
+ END C87B31A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b32a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b32a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b32a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b32a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,199 ----
+ -- C87B32A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE FOLLOWING RULES:
+     
+ -- FOR ATTRIBUTES OF THE FORM: T'SUCC (X), T'PRED (X), T'POS (X),
+ -- AND T'IMAGE (X) , THE OPERAND X MUST BE OF TYPE T.
+ --
+ -- FOR THE ATTRIBUTE OF THE FORM T'VAL (X), THE OPERAND X MUST BE
+ -- OF AN INTEGER TYPE.
+ --
+ -- FOR THE ATTRIBUTE OF THE FORM T'VALUE (X), THE OPERAND X MUST 
+ -- BE OF THE PREDEFINED TYPE STRING.
+   
+ -- TRH  13 SEPT 82
+ -- JRK  12 JAN  84
+ 
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B32A IS
+  
+      TYPE COLOR  IS (BROWN, RED, WHITE);
+      TYPE SCHOOL IS (HARVARD, BROWN, YALE);
+      TYPE COOK   IS (SIMMER, SAUTE, BROWN, BOIL);
+      TYPE SUGAR  IS (DEXTROSE, CANE, GLUCOSE, BROWN);
+      TYPE WHOLE  IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      TYPE LIT_CHAR IS ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7',
+                        '8', '9');
+      TYPE LIT_STRING IS ARRAY (POSITIVE RANGE <>) OF LIT_CHAR;
+ 
+      FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE 
+           RENAMES "*";
+  
+      FUNCTION F1 RETURN STRING IS
+      BEGIN 
+           RETURN "+10";
+      END F1;
+   
+      FUNCTION F1 RETURN LIT_STRING IS
+      BEGIN 
+           FAILED ("THE VALUE ATTRIBUTE TAKES A PREDEFINED STRING " &
+                   "OPERAND");
+           RETURN "+3";
+      END F1;
+   
+      FUNCTION F1 RETURN CHARACTER IS
+      BEGIN
+           FAILED ("THE VALUE ATTRIBUTE TAKES A STRING OPERAND");
+           RETURN '2';
+      END F1;
+    
+      FUNCTION F2 (X : INTEGER) RETURN FLOAT IS
+      BEGIN
+           FAILED ("THE VAL ATTRIBUTE TAKES AN INTEGER TYPE OPERAND");
+           RETURN 0.0;
+      END F2;
+   
+      FUNCTION F2 (X : INTEGER := 1) RETURN INTEGER IS
+      BEGIN 
+           RETURN X;
+      END F2;
+  
+ BEGIN
+      TEST ("C87B32A","OVERLOADED OPERANDS FOR THE ATTRIBUTES " &
+            "T'PRED, T'SUCC, T'POS, T'VAL, T'IMAGE AND T'VALUE");
+   
+      IF COLOR'POS   (BROWN) /= 0        THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 1");
+      END IF;
+  
+      IF SCHOOL'POS (BROWN) /= 1         THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 2");
+      END IF;
+  
+      IF COOK'POS    (BROWN) /= 2        THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 3");
+      END IF;
+  
+      IF SUGAR'POS  (BROWN) /= 3         THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 4");
+      END IF;
+  
+      IF SCHOOL'PRED (BROWN) /= HARVARD  THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 5");
+      END IF;
+  
+      IF COOK'PRED  (BROWN) /= SAUTE     THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 6");
+      END IF;
+  
+      IF SUGAR'PRED  (BROWN) /= GLUCOSE  THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 7");
+      END IF;
+  
+      IF COLOR'SUCC (BROWN) /= RED       THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 8");
+      END IF;
+  
+      IF SCHOOL'SUCC (BROWN) /= YALE     THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 9");
+      END IF;
+  
+      IF COOK'SUCC  (BROWN) /= BOIL      THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 10");
+      END IF;
+  
+      IF COLOR'VAL (F2 (0))  /= BROWN    THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 11");
+      END IF;
+  
+      IF SCHOOL'VAL (F2)    /= BROWN     THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 12");
+      END IF;
+  
+      IF COOK'VAL  (F2 (2))  /= BROWN    THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 13");
+      END IF;
+  
+      IF SUGAR'VAL  (F2)    /= CANE      THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 14");
+      END IF;
+  
+      IF WHOLE'POS   (1 + 1)   /= 1      THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 15");
+      END IF;
+  
+      IF WHOLE'VAL   (1 + 1) /= 2        THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 16");
+      END IF;
+  
+      IF WHOLE'SUCC  (1 + 1)   /= 2      THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 17");
+      END IF;
+  
+      IF WHOLE'PRED  (1 + 1) /= 0        THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 18");
+      END IF;
+  
+      IF WHOLE'VALUE ("+1") + 1 /= 1     THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 19");
+      END IF;
+  
+      IF WHOLE'IMAGE (1 + 1) /= " 1"     THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 20");
+      END IF;
+  
+      IF WHOLE'VALUE (F1) + 1  /= 10     THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 21");
+      END IF;
+  
+      IF WHOLE'VAL (1) + 1   /= 1        THEN
+         FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                 " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 22");
+      END IF;
+  
+      RESULT;
+ END C87B32A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b33a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b33a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b33a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b33a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C87B33A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE SHORT CIRCUIT CONTROL FORMS "AND THEN" AND "OR ELSE" ARE
+ -- DEFINED AS BINARY BOOLEAN OPERATORS WHICH RETURN A BOOLEAN VALUE
+ -- OF THE SAME TYPE AS THE OPERANDS.
+   
+ -- TRH  13 SEPT 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B33A IS
+      
+      TYPE ON   IS NEW BOOLEAN RANGE TRUE  .. TRUE;
+      TYPE OFF  IS NEW BOOLEAN RANGE FALSE .. FALSE;
+      TYPE YES  IS NEW ON;
+      TYPE NO   IS NEW OFF;
+      TYPE BIT  IS NEW BOOLEAN;
+      TYPE FLAG IS (PASS, FAIL);
+  
+      TYPE BOOLEAN IS (FALSE, TRUE);  -- STANDARD BOOLEAN HIDDEN.
+  
+      GENERIC 
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : FLAG;
+      FUNCTION F1 RETURN T;
+      
+      FUNCTION F1 RETURN T IS
+      BEGIN
+           IF STAT = FAIL THEN
+                FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT " &
+                        "CONTROL FORMS 'AND THEN' AND 'OR ELSE' ");
+           END IF;
+           RETURN ARG;
+      END F1;
+  
+      FUNCTION A IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+      FUNCTION A IS NEW F1 (NO,      FALSE, PASS);
+      FUNCTION A IS NEW F1 (ON,      TRUE,  FAIL);
+      FUNCTION A IS NEW F1 (YES,     TRUE,  FAIL);
+      FUNCTION B IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+      FUNCTION B IS NEW F1 (NO,      FALSE, FAIL);
+      FUNCTION B IS NEW F1 (OFF,     FALSE, FAIL);
+      FUNCTION B IS NEW F1 (BIT,     TRUE,  FAIL);
+      FUNCTION C IS NEW F1 (BOOLEAN, FALSE, FAIL);
+      FUNCTION C IS NEW F1 (YES,     TRUE,  PASS);
+      FUNCTION C IS NEW F1 (ON,      TRUE,  FAIL);
+      FUNCTION C IS NEW F1 (NO,      FALSE, FAIL);
+      FUNCTION D IS NEW F1 (BOOLEAN, FALSE, FAIL);
+      FUNCTION D IS NEW F1 (OFF,     FALSE, FAIL);
+      FUNCTION D IS NEW F1 (YES,     TRUE,  FAIL);
+      FUNCTION D IS NEW F1 (BIT,     TRUE,  FAIL);
+      FUNCTION E IS NEW F1 (BOOLEAN, FALSE, FAIL);
+      FUNCTION E IS NEW F1 (BIT,     TRUE,  PASS);
+      FUNCTION E IS NEW F1 (YES,     TRUE,  FAIL);
+      FUNCTION E IS NEW F1 (NO,      FALSE, FAIL);
+      FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
+      FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
+      FUNCTION F IS NEW F1 (ON,      TRUE,  FAIL);
+      FUNCTION F IS NEW F1 (OFF,     FALSE, FAIL);
+      FUNCTION G IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+      FUNCTION G IS NEW F1 (BIT,     FALSE, PASS);
+      FUNCTION G IS NEW F1 (NO,      FALSE, FAIL);
+      FUNCTION G IS NEW F1 (YES,     TRUE,  FAIL);
+      FUNCTION H IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+      FUNCTION H IS NEW F1 (BIT,     FALSE, PASS);
+      FUNCTION H IS NEW F1 (OFF,     FALSE, FAIL);
+      FUNCTION H IS NEW F1 (ON,      TRUE,  FAIL);
+  
+ BEGIN
+      TEST ("C87B33A","OVERLOADED OPERANDS FOR SHORT CIRCUIT CONTROL " &
+            "FORMS 'AND THEN' AND 'OR ELSE' ");
+     
+      IF (A AND THEN B)                        THEN
+           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - A&B");
+      END IF;
+ 
+      IF NOT (C OR ELSE D) THEN
+           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - C&D");
+      END IF;
+ 
+      IF NOT (E AND THEN F AND THEN E
+           AND THEN F AND THEN E AND THEN F)   THEN
+           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - E&F");
+      END IF;
+ 
+      IF (G OR ELSE H OR ELSE G
+           OR ELSE H OR ELSE G OR ELSE H)      THEN
+           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - G&H");
+      END IF;
+     
+      RESULT;
+ END C87B33A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b34a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b34a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b34a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b34a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,68 ----
+ -- C87B34A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE MEMBERSHIP TESTS "IN" AND "NOT IN" RESULT IN THE PREDEFINED
+ -- TYPE BOOLEAN. 
+   
+ -- TRH  4 AUG 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B34A IS
+      
+      TYPE BIT   IS NEW BOOLEAN;
+      TYPE FLAG  IS NEW BOOLEAN;
+  
+      ERR : BOOLEAN := FALSE;
+  
+      PROCEDURE P1 (X : BIT) IS
+      BEGIN
+           ERR := TRUE;
+      END P1;
+  
+      PROCEDURE P1 (X : FLAG) IS
+      BEGIN
+           ERR := TRUE;
+      END P1;
+  
+      PROCEDURE P1 (X : BOOLEAN) IS
+      BEGIN
+           NULL;
+      END P1;
+   
+ BEGIN
+      TEST ("C87B34A","MEMBERSHIP TESTS 'IN' AND 'NOT IN' RETURN " &
+            "TYPE PREDEFINED BOOLEAN");
+    
+      P1 (3 IN 1 .. 5);
+      P1 (3 NOT IN 1 .. 5);
+  
+      IF ERR THEN
+         FAILED ("MEMBERSHIP TESTS MUST RETURN PREDEFINED BOOLEAN TYPE");
+      END IF;
+     
+      RESULT;
+ END C87B34A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b34b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b34b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b34b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b34b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C87B34B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+     
+ -- THE "IN" (OR MEMBERSHIP) OPERATOR OF THE FORM:  X IN L .. R
+ -- REQUIRES THE OPERANDS X, L AND R TO BE OF THE SAME SCALAR TYPE.
+   
+ -- TRH  19 JULY 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B34B IS
+  
+      TYPE FLAG IS (PASS, FAIL);
+   
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+              FAILED ("RESOLUTION INCORRECT FOR 'IN' MEMBERSHIP TEST");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION X IS NEW F1 (FLOAT,     2.0, PASS);
+      FUNCTION L IS NEW F1 (FLOAT,    -1.0, PASS);
+      FUNCTION R IS NEW F1 (FLOAT,     1.0, PASS);
+      FUNCTION X IS NEW F1 (INTEGER,     5, FAIL);
+      FUNCTION L IS NEW F1 (INTEGER,     1, FAIL);
+      FUNCTION L IS NEW F1 (CHARACTER, 'A', FAIL);
+      FUNCTION R IS NEW F1 (CHARACTER, 'E', FAIL);
+      FUNCTION X IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+      FUNCTION R IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+     
+ BEGIN
+      TEST ("C87B34B","OVERLOADED MEMBERSHIP OPERANDS");
+  
+      IF X IN L .. R THEN 
+         FAILED ("RESOLUTION INCORRECT FOR MEMBERSHIP OPERATOR");
+      END IF;
+  
+      RESULT;
+ END C87B34B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b34c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b34c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b34c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b34c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C87B34C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+     
+ -- FOR A MEMBERSHIP RELATION WITH A TYPEMARK, THE TYPE OF THE
+ -- SIMPLE EXPRESSION MUST BE THE BASE TYPE OF THE TYPEMARK.
+   
+ -- TRH  15 SEPT 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B34C IS
+  
+      TYPE VOWEL IS (A, E, I, O, U, VOCALIC_Y);
+      TYPE ALPHA IS (A, 'A');
+      TYPE GRADE IS (A, B, C, D, F);
+      SUBTYPE BAD_GRADE IS GRADE RANGE D .. F;
+      SUBTYPE PASSING   IS GRADE RANGE A .. C;
+  
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - EXPRESSION IN MEMBER" &
+                   "SHIP TEST WITH TYPEMARK MUST MATCH TYPEMARK");
+           RETURN ARG;
+      END F1;
+  
+      FUNCTION F IS NEW F1 (CHARACTER, 'A');
+      FUNCTION F IS NEW F1 (DURATION,  1.0);
+      FUNCTION F IS NEW F1 (INTEGER,   -10);
+      FUNCTION F IS NEW F1 (BOOLEAN,   TRUE);
+      FUNCTION F IS NEW F1 (FLOAT,     1.0);
+      FUNCTION F IS NEW F1 (VOWEL,     A);
+      FUNCTION F IS NEW F1 (ALPHA,     A);
+     
+ BEGIN
+      TEST ("C87B34C","OVERLOADED EXPRESSION IN MEMBERSHIP TEST " &
+            "WITH A TYPEMARK");
+  
+      IF (F NOT IN GRADE) OR (F NOT IN BAD_GRADE)
+           OR (F IN PASSING) THEN 
+           FAILED ("RESOLUTION INCORRECT FOR MEMBERSHIP TEST " &
+                   "WITH TYPEMARK");
+      END IF;
+     
+      RESULT;
+  
+ END C87B34C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b35c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b35c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b35c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b35c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C87B35C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE EXPONENT OPERAND OF A FLOATING POINT EXPONENTIATION MUST BE
+ -- OF THE TYPE PREDEFINED INTEGER.
+   
+ -- TRH  4 AUG 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B35C IS
+  
+      TYPE FIXED IS DELTA 0.01 RANGE 0.0 .. 4.0;
+      ERR : BOOLEAN := FALSE;
+    
+      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+      BEGIN 
+           RETURN X;
+      END F1;
+        
+      FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN 1.0;
+      END F1;
+     
+      FUNCTION F1 (X : INTEGER) RETURN FIXED IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN 1.0;
+      END F1;
+  
+ BEGIN
+      TEST ("C87B35C","EXPONENT OPERAND FOR FLOATING POINT " &
+            "EXPONENTIATION MUST BE OF TYPE PREDEFINED INTEGER");
+   
+      DECLARE
+           FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES STANDARD."*";
+     
+      BEGIN
+           IF ( FLOAT'(2.0) ** F1(3)   /= 8.0 OR
+                FLOAT'(2.0) ** (3 + 1) /= 8.0 ) THEN
+                FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION "
+                     & "MUST BE PREDEFINED INTEGER (A)");
+           END IF;
+           IF ( 2.0 ** F1(3)   /= FLOAT'(8.0) OR
+                2.0 ** (3 + 1) /= FLOAT'(8.0) ) THEN
+                FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION"
+                     & "MUST BE PREDEFINED INTEGER (B)");
+           END IF;
+           IF ERR THEN
+                FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION"
+                     & "MUST BE PREDEFINED INTEGER (C)");
+           END IF;
+      END;
+  
+      RESULT;
+ END C87B35C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b38a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b38a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b38a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b38a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,76 ----
+ -- C87B38A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+     
+ -- IN A QUALIFIED EXPRESSION, THE OPERAND MUST HAVE THE SAME TYPE
+ -- AS THE BASE TYPE OF THE TYPEMARK.
+   
+ -- TRH  13 SEPT 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B38A IS
+  
+      SUBTYPE BOOL IS BOOLEAN;
+      TYPE YES  IS NEW BOOLEAN RANGE TRUE  .. TRUE;
+      TYPE NO   IS NEW BOOLEAN RANGE FALSE .. FALSE;
+      TYPE BIT  IS NEW BOOLEAN;
+      TYPE LIT  IS (FALSE, TRUE);   
+      TYPE FLAG IS (PASS,  FAIL);
+  
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("RESOLUTION INCORRECT FOR OVERLOADED " &
+                        " OPERANDS OF QUALIFIED EXPRESSIONS");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (LIT,     FALSE, FAIL);
+      FUNCTION F IS NEW F1 (BIT,     TRUE,  FAIL);
+      FUNCTION F IS NEW F1 (BOOLEAN, TRUE,  PASS);
+      FUNCTION F IS NEW F1 (YES,     TRUE,  FAIL);
+      FUNCTION F IS NEW F1 (NO,      FALSE, FAIL);
+     
+ BEGIN
+      TEST ("C87B38A","OVERLOADED OPERANDS IN QUALIFIED EXPRESSIONS ");
+  
+      DECLARE 
+           B : BOOL;
+  
+      BEGIN
+           B := BOOL' (F);
+           B := BOOL' ((NOT F) OR ELSE (F AND THEN F));
+      END;
+  
+      RESULT;
+ END C87B38A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b39a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b39a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b39a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b39a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- C87B39A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT:
+ 
+ --   A) AN OVERLOADED CALL CAN BE RESOLVED BECAUSE AN ALLOCATOR RETURNS
+ --      AN ACCESS TYPE WHOSE DESIGNATED TYPE IS THE TYPE REFERRED TO IN
+ --      THE ALLOCATOR.
+ --
+ --   B) IF THE NAME OF THE DESIGNATED TYPE IN AN ALLOCATOR DOES NOT
+ --      UNIQUELY DETERMINE THE ACCESS TYPE OF AN ALLOCATOR, THE CONTEXT
+ --      MUST DETERMINE THE TYPE.
+ 
+ -- JBG 1/30/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C87B39A IS
+ 
+      TYPE S IS (M, F);
+      TYPE R (D : S) IS
+           RECORD NULL; END RECORD;
+      SUBTYPE M1 IS R(M);
+      SUBTYPE M2 IS R(M);
+ 
+      TYPE ACC_M1 IS ACCESS M1;
+      TYPE ACC_M2 IS ACCESS M2;
+      TYPE ACC_BOOL IS ACCESS BOOLEAN;
+      TYPE ACC_ACC_M1 IS ACCESS ACC_M1;
+      
+      TYPE WHICH IS (IS_M1, IS_M2, IS_BOOL);
+ 
+      PROCEDURE P (X : ACC_M1; RESOLUTION : WHICH) IS
+      BEGIN
+           IF RESOLUTION /= IS_M1 THEN
+                FAILED ("INCORRECT RESOLUTION -- ACC_M1");
+           END IF;
+      END P;    -- ACC_M1
+ 
+      PROCEDURE P (X : ACC_M2; RESOLUTION : WHICH) IS
+      BEGIN
+           IF RESOLUTION /= IS_M2 THEN
+                FAILED ("INCORRECT RESOLUTION -- ACC_M2");
+           END IF;
+      END P;    -- ACC_M2
+ 
+      PROCEDURE P (X : ACC_BOOL; RESOLUTION : WHICH) IS
+      BEGIN
+           IF RESOLUTION /= IS_BOOL THEN
+                FAILED ("INCORRECT RESOLUTION -- ACC_BOOL");
+           END IF;
+      END P;    -- ACC_BOOL
+ 
+      PROCEDURE P (X : ACC_ACC_M1; RESOLUTION : WHICH) IS
+      BEGIN
+           FAILED ("INCORRECT RESOLUTION -- ACC_ACC_M1");
+      END P;    -- ACC_ACC_M1
+ 
+      PROCEDURE Q (X : ACC_M1) IS
+      BEGIN
+           NULL;
+      END Q;    -- ACC_M1
+ 
+      PROCEDURE Q (X : ACC_BOOL) IS
+      BEGIN
+           FAILED ("INCORRECT RESOLUTION -- ACC_BOOL: Q");
+      END Q;    -- ACC_BOOL
+ 
+ BEGIN
+ 
+      TEST ("C87B39A", "OVERLOADING RESOLUTION FOR ALLOCATORS");
+ 
+      P (ACC_M1'(NEW R(M)), IS_M1);    -- B
+ 
+      P (ACC_M2'(NEW M1), IS_M2);      -- B
+ 
+      P (NEW BOOLEAN'(TRUE), IS_BOOL); -- A
+ 
+      Q (NEW M2);              -- A
+      Q (NEW M1);              -- A
+      Q (NEW R(M));            -- A
+      Q (NEW R'(D => M));      -- A
+ 
+      RESULT;
+ 
+ END C87B39A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b40a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b40a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b40a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b40a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- C87B40A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE FOLLOWING RULES:
+ --
+ -- THE SAME OPERATIONS ARE PREDEFINED FOR THE TYPE UNIVERSAL_INTEGER
+ -- AS FOR ANY INTEGER TYPE. THE SAME OPERATIONS ARE PREDEFINED FOR THE
+ -- TYPE UNIVERSAL_REAL AS FOR ANY FLOATING POINT TYPE. IN ADDITION
+ -- THESE OPERATIONS INCLUDE THE FOLLOWING MULTIPLICATION AND DIVISION
+ -- OPERATORS:
+ --
+ --   "*" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
+ --   "*" (UNIVERSAL_INTEGER, UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
+ --   "*" (UNIVERSAL_REAL,    UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
+ --   "*" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
+ --   "/" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
+ --  "**" (UNIVERSAL_INTEGER, INTEGER) RETURN UNIVERSAL_INTEGER
+ --  "**" (UNIVERSAL_REAL, INTEGER) RETURN UNIVERSAL_REAL
+ -- "MOD" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
+ -- "DIV" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
+ -- "ABS" (UNIVERSAL_INTEGER) RETURN UNIVERSAL INTEGER
+ -- "ABS" (UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
+ 
+ -- TRH  15 SEPT 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B40A IS
+   
+      ERR : BOOLEAN := FALSE;
+      B : ARRAY (1 .. 12) OF BOOLEAN := (1 .. 12 => TRUE);
+ 
+      FUNCTION "-" (X : INTEGER) RETURN INTEGER
+           RENAMES STANDARD."+";
+ 
+      FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN X;
+      END "+";
+  
+      FUNCTION "+" (X : FLOAT) RETURN FLOAT IS
+      BEGIN 
+           ERR := TRUE;
+           RETURN X;
+      END "+";
+  
+ BEGIN
+      TEST ("C87B40A","OVERLOADING RESOLUTION OF UNIVERSAL " &
+            "EXPRESSIONS");
+  
+      B(1)  := 1.0 * (+1) IN 0.0 .. 0.0;       -- 1.0 * 1
+      B(2)  := (+1) * 1.0 IN 0.0 .. 0.0;       -- 1 * 1.0
+      B(3)  := 1.0 / (+1) IN 0.0 .. 0.0;       -- 1.0 / 1
+      B(4)  := (+1)  +  (+1) <= (+1)  -  (+1); -- 1+1< 1 - 1
+      B(5)  := (+1)  *  (+1) >  (+1)  /  (+1); -- 1*1 > 1/1
+      B(6)  := (+1) MOD (+1) /= (+1) REM (+1); -- 1 MOD 1 /= 1 REM 1
+ 
+      BEGIN
+           B(7)  := (+2) **  (-2) <  "-"  (-1);     -- 2**2 < 1
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED("INCORRECT RESOLUTION FOR INTEGER EXPONENT - 7");
+      END;
+ 
+      B(8)  := (+1) REM (+1) > "ABS" (+1);     -- 1 REM 1 > ABS 1
+      B(9)  := (+1.0)  +  (+1.0) <= (+1.0)  -  (+1.0); -- 2.0 <= 0.0
+      B(10) := (+1.0)  *  (+1.0) >  (+1.0)  /  (+1.0); -- 1.0 > 1.0
+      B(11) := (+2.0) **  (-1)   <  "-"  (-1.0);       -- 2.0 < 1.0
+      B(12) := (+2.0) **  (-1)  <= "ABS" (+1.0);       -- 2.0 <= 1.0
+ 
+      FOR I IN B'RANGE
+      LOOP
+           IF B(I) /= FALSE THEN
+                FAILED("RESOLUTION OR OPERATIONS INCORRECT FOR "
+                & "UNIVERSAL EXPRESSIONS - " & INTEGER'IMAGE(I) );
+           END IF;
+      END LOOP;
+  
+      IF ERR THEN 
+           FAILED ("RESOLUTION INCORRECT FOR UNIVERSAL EXPRESSIONS");
+      END IF;
+  
+      RESULT;
+ END C87B40A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b41a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b41a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b41a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b41a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C87B41A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE NAMED VARIABLE AND THE RIGHT HAND SIDE EXPRESSION
+ -- IN AN ASSIGNMENT STATEMENT MUST BE OF THE SAME TYPE. THIS TYPE
+ -- MUST NOT BE A LIMITED TYPE.
+   
+ -- TRH  15 SEPT 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B41A IS
+      
+      TYPE NOTE IS (A, B, C, D, E, F, G);
+      TYPE POSITIVE IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+      TYPE ACC_CHAR IS ACCESS CHARACTER;
+      TYPE ACC_DUR  IS ACCESS DURATION;
+      TYPE ACC_POS  IS ACCESS POSITIVE;
+      TYPE ACC_INT  IS ACCESS INTEGER;
+      TYPE ACC_BOOL IS ACCESS BOOLEAN;
+      TYPE ACC_STR  IS ACCESS STRING;
+      TYPE ACC_FLT  IS ACCESS FLOAT;
+      TYPE ACC_NOTE IS ACCESS NOTE;
+    
+      TYPE NEW_CHAR IS NEW CHARACTER;
+      TYPE NEW_DUR  IS NEW DURATION;
+      TYPE NEW_POS  IS NEW POSITIVE;
+      TYPE NEW_INT  IS NEW INTEGER;
+      TYPE NEW_BOOL IS NEW BOOLEAN;
+      TYPE NEW_FLT  IS NEW FLOAT;
+      TYPE NEW_NOTE IS NEW NOTE RANGE A .. F;
+      TASK TYPE T;
+    
+      TASK BODY T IS
+      BEGIN
+           NULL;
+      END T;
+   
+      FUNCTION G RETURN T IS
+           T1 : T;
+      BEGIN
+           FAILED ("LIMITED TYPES MAY NOT OCCUR IN ASSIGNMENT " &
+                   "STATEMENTS");
+           RETURN T1;
+      END G;
+   
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           FAILED ("RESOLUTION INCORRECT - RIGHT HAND SIDE OF " &
+                   "ASSIGNMENT STATEMENT MUST MATCH TYPE OF VARIABLE");
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (ACC_CHAR, NEW CHARACTER);
+      FUNCTION F IS NEW F1 (ACC_DUR,  NEW DURATION);
+      FUNCTION F IS NEW F1 (ACC_POS,  NEW POSITIVE);
+      FUNCTION F IS NEW F1 (ACC_INT,  NEW INTEGER);
+      FUNCTION F IS NEW F1 (ACC_BOOL, NEW BOOLEAN);
+      FUNCTION F IS NEW F1 (ACC_STR,  NEW STRING(1..2) );
+      FUNCTION F IS NEW F1 (ACC_FLT,  NEW FLOAT);
+ 
+      FUNCTION F RETURN ACC_NOTE IS
+      BEGIN
+           RETURN  (NEW NOTE);
+      END F;
+  
+      FUNCTION G IS NEW F1 (NEW_CHAR, 'G');
+      FUNCTION G IS NEW F1 (NEW_DUR,  1.0);
+      FUNCTION G IS NEW F1 (NEW_POS,  +10);
+      FUNCTION G IS NEW F1 (NEW_INT,  -10);
+      FUNCTION G IS NEW F1 (NEW_BOOL, TRUE);
+      FUNCTION G IS NEW F1 (NEW_FLT,  1.0);
+      FUNCTION G IS NEW F1 (NEW_NOTE, F);
+     
+ BEGIN
+      TEST ("C87B41A","OVERLOADED CONSTRUCTS ON BOTH SIDES OF THE " &
+            "ASSIGNMENT STATEMENT");
+  
+      F.ALL := G;
+     
+      RESULT;
+  
+ END C87B41A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b42a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b42a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b42a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b42a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C87B42A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- A CONDITIONAL EXPRESSION MUST BE OF A BOOLEAN TYPE.
+   
+ -- TRH  27 JULY 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B42A IS
+  
+      TYPE BIT     IS NEW BOOLEAN;
+      TYPE BOOLEAN IS (FALSE, TRUE);
+      TYPE LIT     IS (FALSE, TRUE);
+      TYPE FLAG    IS (PASS, FAIL);
+  
+      GENERIC 
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS 
+      BEGIN
+           IF STAT = FAIL THEN 
+                FAILED ("CONDITIONAL EXPRESSION MUST BE OF A BOOLEAN" &
+                        " TYPE");
+           END IF;
+           RETURN ARG;
+      END F1;
+  
+      FUNCTION F IS NEW F1 (BOOLEAN, FALSE,  FAIL);
+      FUNCTION F IS NEW F1 (BIT,     FALSE,  PASS);
+      FUNCTION F IS NEW F1 (LIT,     FALSE,  FAIL);
+      FUNCTION F IS NEW F1 (INTEGER,   -11,  FAIL);
+      FUNCTION F IS NEW F1 (FLOAT,    +0.0,  FAIL);
+     
+ BEGIN
+      TEST ("C87B42A","OVERLOADED CONDITIONAL EXPRESSIONS");
+  
+      WHILE (F OR NOT F)
+      LOOP
+           IF (F OR ELSE NOT F) THEN
+                NULL;
+           END IF;
+           EXIT WHEN (F AND NOT F);
+           EXIT WHEN (F OR  NOT F);
+           EXIT WHEN (F);
+           EXIT WHEN (NOT F);
+      END LOOP;
+  
+      RESULT;
+ END C87B42A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b43a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b43a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b43a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b43a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,60 ----
+ -- C87B43A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- IN A CASE STATEMENT, THE TYPE OF EACH CHOICE MUST MATCH THE TYPE 
+ -- OF THE EXPRESSION.
+   
+ -- TRH  3 AUG 82
+ -- DSJ 10 JUN 83
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B43A IS
+      
+      TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+  
+      FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER 
+           RENAMES "*";
+  
+      ERR : BOOLEAN := FALSE;
+      X   : WHOLE   := 6;
+   
+ BEGIN
+      TEST ("C87B43A","TYPE OF CASE CHOICE MUST MATCH TYPE OF " &
+            "EXPRESSION");
+    
+      CASE X IS
+           WHEN (2 + 3) => ERR := TRUE;
+           WHEN (3 + 3) => NULL; 
+           WHEN OTHERS  => ERR := TRUE;
+      END CASE;
+  
+      IF ERR THEN
+         FAILED ("CASE STATEMENT CHOICE MUST MATCH TYPE OF EXPRESSION");
+      END IF;
+     
+      RESULT;
+ END C87B43A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b44a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b44a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b44a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b44a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C87B44A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE TYPE OF THE EXPRESSION IN A RETURN STATEMENT MUST MATCH THE
+ -- EXPLICIT TYPEMARK IN THE RETURN CLAUSE OF THE FUNCTION'S
+ -- SPECIFICATION.
+ --
+ -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+ -- 
+ --    (A): A CALL TO AN OVERLOADED FUNCTION.
+ --    (B): AN OVERLOADED OPERATOR SYMBOL.
+ --    (C): AN OVERLOADED (INFIX) OPERATOR.
+ --    (D): AN OVERLOADED ENUMERATION LITERAL.
+   
+ -- TRH  25 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B44A IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+      
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION "*" (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END "*";
+     
+      FUNCTION "*" (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END "*";
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B44A","OVERLOADED EXPRESSIONS IN RETURN STATEMENTS");
+      DECLARE
+ 
+           FUNCTION F2 (X, Y : INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN F1 (X, Y);
+           END F2;
+    
+           FUNCTION F2 (X, Y : WHOLE) RETURN WHOLE IS
+           BEGIN
+                RETURN "*" (X, Y);
+           END F2;
+    
+           FUNCTION F2 (X, Y : INTEGER) RETURN HUE IS
+           BEGIN
+                RETURN (X * Y);
+           END F2;
+    
+           FUNCTION F2 (X, Y : INTEGER) RETURN CITRUS IS
+           BEGIN
+                RETURN ORANGE;
+           END F2;
+    
+ 
+      BEGIN
+           IF INTEGER'(F2 (0, 0)) /= -1 THEN
+              FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+           END IF;
+     
+           IF WHOLE'(F2 (0, 0)) /= 0 THEN
+              FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+           END IF;
+     
+           IF HUE'POS (F2 (0, 0)) /= 1 THEN 
+              FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+           END IF;
+     
+           IF CITRUS'POS (F2 (0, 0)) /= 2 THEN 
+              FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+           END IF;
+      END;
+     
+      RESULT;
+ END C87B44A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b45a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b45a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b45a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b45a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,126 ----
+ -- C87B45A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR A DEFAULT SUBPROGRAM PARAMETER, THE TYPE OF THE INITIALIZATION
+ -- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
+ --      
+ -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+ -- 
+ --    (A): A CALL TO AN OVERLOADED FUNCTION.
+ --    (B): AN OVERLOADED OPERATOR SYMBOL.
+ --    (C): AN OVERLOADED (INFIX) OPERATOR.
+ --    (D): AN OVERLOADED ENUMERATION LITERAL.
+   
+ -- TRH  24 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B45A IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+      
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END F1;
+     
+      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B45A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+            " IN DEFAULT SUBPROGRAM PARAMETERS");
+      DECLARE
+ 
+           FUNCTION "/" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES F1;
+     
+           FUNCTION "/" (X, Y : WHOLE)   RETURN WHOLE
+                RENAMES F1;
+      
+           FUNCTION "/" (X, Y : INTEGER) RETURN HUE
+                RENAMES F1;
+    
+           FUNCTION "/" (X, Y : INTEGER) RETURN CITRUS
+                RENAMES F1;
+       
+           PROCEDURE P1 (I1 : INTEGER := F1  (0, 0);
+                         W1 : WHOLE   := F1  (0, 0);
+                         C1 : CITRUS  := F1  (0, 0);
+                         H1 : HUE     := F1  (0, 0);
+                         I2 : INTEGER := "/" (0, 0);
+                         W2 : WHOLE   := "/" (0, 0);
+                         C2 : CITRUS  := "/" (0, 0);
+                         H2 : HUE     := "/" (0, 0);
+                         I3 : INTEGER := (0 / 0);
+                         W3 : WHOLE   := (0 / 0);
+                         C3 : CITRUS  := (0 / 0);
+                         H3 : HUE     := (0 / 0);
+                         C4 : CITRUS  := ORANGE;
+                         H4 : HUE     := ORANGE)  IS
+           BEGIN
+                IF I1              /= -1 OR W1           /= 0 OR
+                   CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+                   FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+                END IF;
+     
+                IF I2              /= -1 OR W2           /= 0 OR
+                   CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+                   FAILED ("(B): RESOLUTION INCORRECT " &
+                           "- OPERATOR SYMBOL");
+                END IF;
+     
+                IF I3              /= -1 OR W3           /= 0 OR
+                   CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+                   FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+                END IF;
+     
+                IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+                   FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION " &
+                           "LITERAL");
+                END IF;
+           END P1;
+ 
+      BEGIN
+           P1;
+      END;
+     
+      RESULT;
+ END C87B45A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b45c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b45c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b45c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b45c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- C87B45C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR A DEFAULT ENTRY PARAMETER, THE TYPE OF THE INITIALIZATION
+ -- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
+ --      
+ -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+ -- 
+ --    (A): A CALL TO AN OVERLOADED FUNCTION.
+ --    (B): AN OVERLOADED OPERATOR SYMBOL.
+ --    (C): AN OVERLOADED (INFIX) OPERATOR.
+ --    (D): AN OVERLOADED ENUMERATION LITERAL.
+   
+ -- TRH  7 JULY 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B45C IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+      
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END F1;
+     
+      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B45C","OVERLOADED INITIALIZATION EXPRESSIONS" &
+            " IN DEFAULT ENTRY PARAMETERS");
+      DECLARE
+ 
+           FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES F1;
+     
+           FUNCTION "*" (X, Y : WHOLE)   RETURN WHOLE
+                RENAMES F1;
+      
+           FUNCTION "*" (X, Y : INTEGER) RETURN HUE
+                RENAMES F1;
+    
+           FUNCTION "*" (X, Y : INTEGER) RETURN CITRUS
+                RENAMES F1;
+       
+           TASK T1 IS
+                ENTRY E1 (I1 : INTEGER := F1  (0, 0);
+                          W1 : WHOLE   := F1  (0, 0);
+                          C1 : CITRUS  := F1  (0, 0);
+                          H1 : HUE     := F1  (0, 0);
+                          I2 : INTEGER := "*" (0, 0);
+                          W2 : WHOLE   := "*" (0, 0);
+                          C2 : CITRUS  := "*" (0, 0);
+                          H2 : HUE     := "*" (0, 0);
+                          I3 : INTEGER := (0 * 0);
+                          W3 : WHOLE   := (0 * 0);
+                          C3 : CITRUS  := (0 * 0);
+                          H3 : HUE     := (0 * 0);
+                          C4 : CITRUS  := ORANGE;
+                          H4 : HUE     := ORANGE);  
+           END T1;
+     
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E1 (I1 : INTEGER := F1  (0, 0);
+                           W1 : WHOLE   := F1  (0, 0);
+                           C1 : CITRUS  := F1  (0, 0);
+                           H1 : HUE     := F1  (0, 0);
+                           I2 : INTEGER := "*" (0, 0);
+                           W2 : WHOLE   := "*" (0, 0);
+                           C2 : CITRUS  := "*" (0, 0);
+                           H2 : HUE     := "*" (0, 0);
+                           I3 : INTEGER := (0 * 0);
+                           W3 : WHOLE   := (0 * 0);
+                           C3 : CITRUS  := (0 * 0);
+                           H3 : HUE     := (0 * 0);
+                           C4 : CITRUS  := ORANGE;
+                           H4 : HUE     := ORANGE) DO
+     
+                     IF I1              /= -1 OR W1           /= 0 OR
+                        CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+                        FAILED ("(A): RESOLUTION INCORRECT - FUNCTION");
+                     END IF;
+     
+                     IF I2              /= -1 OR W2           /= 0 OR
+                        CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+                        FAILED ("(B): RESOLUTION INCORRECT " &
+                                "- OPERATOR SYMBOL");
+                     END IF;
+     
+                     IF I3              /= -1 OR W3           /= 0 OR
+                        CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+                        FAILED ("(C): RESOLUTION INCORRECT - INFIX " &
+                                "OPERATOR");
+                     END IF;
+     
+                     IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+                        FAILED ("(D): RESOLUTION INCORRECT - " &
+                           "ENUMERATION LITERAL");
+                     END IF;
+    
+                END E1;
+           END T1;
+ 
+      BEGIN
+           T1.E1;
+      END;
+     
+      RESULT;
+ END C87B45C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b47a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b47a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b47a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b47a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C87B47A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- ACTUAL PARAMETERS MUST MATCH THE EXPLICIT TYPEMARK OF THE
+ -- PARAMETER.
+   
+ -- TRH  8 AUG 82
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B47A IS
+  
+      TYPE FLAG IS (PASS, FAIL);
+      
+      GENERIC
+           TYPE T IS PRIVATE;
+           ARG  : IN T;
+           STAT : IN FLAG;
+      FUNCTION F1 RETURN T;
+  
+      FUNCTION F1 RETURN T IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+              FAILED ("ACTUAL PARAMETER MUST MATCH PARAMETER TYPE");
+           END IF;
+           RETURN ARG;
+      END F1;
+   
+      FUNCTION F IS NEW F1 (FLOAT,     2.0, PASS);
+      FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
+      FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+      FUNCTION F IS NEW F1 (DURATION,  1.0, FAIL);
+      FUNCTION F IS NEW F1 (CHARACTER, 'E', FAIL);
+     
+ BEGIN
+      TEST ("C87B47A","OVERLOADED ACTUAL PARAMETERS");
+     
+      DECLARE
+           PROCEDURE P (X : FLOAT) IS
+           BEGIN
+                NULL;
+           END P;
+    
+      BEGIN
+           P (F);
+           P (X => F);
+      END;
+  
+      RESULT;
+ END C87B47A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b48a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b48a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b48a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b48a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C87B48A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- NAMED ACTUAL PARAMETERS CAN RESOLVE OVERLOADING OF SUBPROGRAMS.
+ -- THIS TEST USES FUNCTIONS AND OPERATOR SYMBOLS ONLY.
+   
+ -- TRH  13 AUG 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B48A IS
+  
+      ERR, B1, B2 : BOOLEAN := FALSE;
+  
+      PACKAGE A IS
+           FUNCTION "-"    (X : BOOLEAN) RETURN BOOLEAN;
+           FUNCTION TOGGLE (X : BOOLEAN) RETURN BOOLEAN
+                RENAMES "-";
+      END A;
+      
+      PACKAGE BODY A IS
+           FUNCTION "-" (X : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                RETURN NOT X;
+           END "-";
+      END A;
+  
+      PACKAGE B IS
+           FUNCTION "-"    (Y : BOOLEAN) RETURN BOOLEAN;
+           FUNCTION TOGGLE (Y : BOOLEAN) RETURN BOOLEAN
+                RENAMES "-";
+      END B;
+      
+      PACKAGE BODY B IS
+           FUNCTION "-" (Y : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                ERR := TRUE;
+                RETURN NOT Y;
+           END "-";
+      END B;
+  
+      PACKAGE C IS
+           FUNCTION "-"    (Z : BOOLEAN) RETURN BOOLEAN;
+           FUNCTION TOGGLE (Z : BOOLEAN) RETURN BOOLEAN
+                RENAMES "-";
+      END C;
+      
+      PACKAGE BODY C IS
+           FUNCTION "-" (Z : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN
+                ERR := TRUE;
+                RETURN NOT Z;
+           END "-";
+      END C;
+    
+      USE A, B, C;
+  
+ BEGIN
+      TEST ("C87B48A","RESOLUTION OF OVERLOADED SUBPROGRAMS BY NAMED " &
+            "ACTUAL PARAMETERS");
+  
+      B1 := "-"    (X => FALSE);
+      B2 := TOGGLE (X => FALSE);
+    
+      IF ERR OR ELSE NOT B1 OR ELSE NOT B2 THEN 
+           FAILED ("RESOLUTION INCORRECT FOR OVERLOADED SUBPROGRAMS" &
+                   " WITH NAMED ACTUAL PARAMETERS");
+      END IF;
+  
+      RESULT;
+ END C87B48A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b48b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b48b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b48b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b48b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C87B48B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- POSITIONAL ACTUAL PARAMETERS CAN RESOLVE OVERLOADING OF SUBPROGRAMS.
+   
+ -- TRH  16 AUG 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B48B IS
+  
+      TYPE FLAG IS (PASS, FAIL);
+      TYPE INT  IS NEW INTEGER;
+      TYPE BIT  IS NEW BOOLEAN;
+      TYPE WHL  IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      
+      GENERIC
+           TYPE T1 IS PRIVATE;
+           TYPE T2 IS PRIVATE;
+           TYPE T3 IS PRIVATE;
+           TYPE T4 IS PRIVATE;
+           STAT : IN FLAG;
+      PROCEDURE P1 (W : T1; X : T2; Y : T3; Z : T4);
+  
+      PROCEDURE P1 (W : T1; X : T2; Y : T3; Z : T4) IS
+      BEGIN 
+           IF STAT = FAIL THEN 
+                FAILED ("RESOLUTION INCORRECT FOR OVERLOADED SUB" &
+                        "PROGRAMS WITH POSITIONAL ACTUAL PARAMETERS");
+           END IF;
+      END P1;
+   
+      PROCEDURE P IS NEW P1 (WHL, INT, WHL, BIT, PASS);
+      PROCEDURE P IS NEW P1 (WHL, WHL, BIT, INT, FAIL);
+      PROCEDURE P IS NEW P1 (WHL, INT, BIT, WHL, FAIL);
+      PROCEDURE P IS NEW P1 (INT, BIT, WHL, WHL, FAIL);
+      PROCEDURE P IS NEW P1 (BIT, WHL, WHL, INT, FAIL);
+      PROCEDURE P IS NEW P1 (BIT, INT, WHL, WHL, FAIL);
+     
+ BEGIN
+      TEST ("C87B48B","OVERLOADING RESOLUTION OF SUBPROGRAMS WITH" &
+            " POSITIONAL ACTUAL PARAMETERS");
+     
+      BEGIN
+           P (0, 0, 0, TRUE);
+      END;
+  
+      RESULT;
+ END C87B48B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b50a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b50a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b50a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b50a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- C87B50A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A FUNCTION RENAMING DECLARATION CAN RESOLVE AND RENAME AN
+ -- OVERLOADED ENUMERATION LITERAL.
+ 
+ -- GOM 11/29/84
+ -- JWC 7/12/85
+ -- PWB 03/06/86  CORRECTED ERROR: ADDED "USE" CLAUSE TO MAKE
+ --               "/=" VISIBLE.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C87B50A IS
+ 
+ BEGIN
+      TEST ("C87B50A", "CHECK THAT A FUNCTION RENAMING DECLARATION " &
+                       "CAN RESOLVE AND RENAME AN OVERLOADED " &
+                       "ENUMERATION LITERAL");
+ 
+      DECLARE
+ 
+           PACKAGE A IS
+                TYPE COLORS IS (RED,GREEN);
+                TYPE LIGHT  IS (BLUE,RED);
+           END A;
+ 
+           PACKAGE B IS
+                FUNCTION RED RETURN A.COLORS RENAMES A.RED;
+                FUNCTION GREEN RETURN A.COLORS RENAMES A.GREEN;
+           END B;
+ 
+           USE A;      -- TO MAKE /= VISIBLE.
+ 
+      BEGIN
+ 
+           IF (A.RED /= B.RED) OR (A.GREEN /= B.GREEN) THEN
+                FAILED ("RENAMED VALUES NOT EQUAL");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C87B50A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b54a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b54a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b54a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b54a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C87B54A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- THE ARGUMENT OF THE DELAY STATEMENT IS OF THE PREDEFINED FIXED 
+ -- POINT TYPE DURATION.
+   
+ -- TRH  7 SEPT 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B54A IS
+  
+      TYPE TEMPS  IS NEW DURATION;
+      TYPE REAL   IS NEW FLOAT;
+      TYPE TEMPUS IS DELTA 0.1 RANGE -1.0 .. 1.0;
+      ERR : BOOLEAN := FALSE;
+  
+      FUNCTION F (X : TEMPS) RETURN TEMPS IS
+      BEGIN
+           ERR := TRUE;
+           RETURN X;
+      END F;
+     
+      FUNCTION F (X : REAL) RETURN REAL IS
+      BEGIN
+           ERR := TRUE;
+           RETURN X;
+      END F;
+  
+      FUNCTION F (X : TEMPUS) RETURN TEMPUS IS
+      BEGIN
+           ERR := TRUE;
+           RETURN X;
+      END F;
+     
+      FUNCTION F (X : DURATION) RETURN DURATION IS
+      BEGIN
+           RETURN X;
+      END F;
+     
+ BEGIN
+      TEST ("C87B54A","OVERLOADED EXPRESSION WITHIN DELAY STATEMENT");
+     
+      DECLARE
+           TASK T IS
+                ENTRY E;
+           END T;
+   
+           TASK BODY T IS
+           BEGIN
+                DELAY F (0.0);
+                DELAY F (1.0);
+                DELAY F (-1.0);
+           END T;
+   
+      BEGIN
+           IF ERR THEN FAILED ("DELAY STATEMENT TAKES AN ARGUMENT OF " &
+                               "THE PREDEFINED FIXED POINT TYPE " &
+                               "DURATION");
+           END IF;
+      END;
+  
+      RESULT;
+ END C87B54A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b57a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b57a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b57a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b57a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- C87B57A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ -- FOR A DEFAULT GENERIC IN PARAMETER, THE TYPE OF THE INITIALIZATION
+ -- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
+ --      
+ -- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+ -- 
+ --    (A): A CALL TO AN OVERLOADED FUNCTION.
+ --    (B): AN OVERLOADED OPERATOR SYMBOL.
+ --    (C): AN OVERLOADED (INFIX) OPERATOR.
+ --    (D): AN OVERLOADED ENUMERATION LITERAL.
+   
+ -- TRH  25 JUNE 82
+   
+ WITH REPORT; USE REPORT;
+    
+ PROCEDURE C87B57A IS
+   
+      TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+      TYPE CITRUS IS (LEMON, LIME, ORANGE);
+      TYPE HUE    IS (RED, ORANGE, YELLOW);
+      
+      FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN -1;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+      BEGIN
+           RETURN 0;
+      END F1;
+     
+      FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+ 
+      FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+      BEGIN
+           RETURN ORANGE;
+      END F1;
+    
+ BEGIN
+      TEST ("C87B57A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+            " IN DEFAULT GENERIC IN PARAMETERS");
+      DECLARE
+ 
+           FUNCTION "/" (X, Y : INTEGER) RETURN INTEGER
+                RENAMES F1;
+     
+           FUNCTION "/" (X, Y : WHOLE)   RETURN WHOLE
+                RENAMES F1;
+      
+           FUNCTION "/" (X, Y : INTEGER) RETURN HUE
+                RENAMES F1;
+    
+           FUNCTION "/" (X, Y : INTEGER) RETURN CITRUS
+                RENAMES F1;
+       
+           GENERIC
+                I1 : INTEGER := F1  (0, 0);
+                W1 : WHOLE   := F1  (0, 0);
+                C1 : CITRUS  := F1  (0, 0);
+                H1 : HUE     := F1  (0, 0);
+                I2 : INTEGER := "/" (0, 0);
+                W2 : WHOLE   := "/" (0, 0);
+                C2 : CITRUS  := "/" (0, 0);
+                H2 : HUE     := "/" (0, 0);
+                I3 : INTEGER := (0 / 0);
+                W3 : WHOLE   := (0 / 0);
+                C3 : CITRUS  := (0 / 0);
+                H3 : HUE     := (0 / 0);
+                C4 : CITRUS  := ORANGE;
+                H4 : HUE     := ORANGE;
+  
+           PACKAGE P IS
+           END P;
+   
+           PACKAGE BODY P IS
+           BEGIN
+                IF I1              /= -1 OR W1           /= 0 OR
+                   CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+                   FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+                END IF;
+     
+                IF I2              /= -1 OR W2           /= 0 OR
+                   CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+                   FAILED ("(B): RESOLUTION INCORRECT " &
+                           "- OPERATOR SYMBOL");
+                END IF;
+     
+                IF I3              /= -1 OR W3           /= 0 OR
+                   CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+                   FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+                END IF;
+     
+                IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+                   FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION " &
+                           "LITERAL");
+                END IF;
+           END P;
+   
+           PACKAGE P1 IS NEW P;
+   
+      BEGIN 
+           NULL;
+      END;
+     
+      RESULT;
+ END C87B57A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- C87B62A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ --       IN A LENGTH CLAUSE THAT SPECIFIES 'SIZE,
+ --       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
+ 
+ -- HISTORY:
+ --     TRH 09/08/82  CREATED ORIGINAL TEST.
+ --     PWB 02/19/85  ADDED COMMENTS CLARIFYING NON-APPLICABILITY;
+ --                   DELETED TEXT NOT RELATED TO TEST OBJECTIVE.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C87B62A IS
+ 
+      TYPE POS_INT IS RANGE 1 .. INTEGER'LAST;
+      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+      ERR : BOOLEAN := FALSE;
+ 
+      FUNCTION "+" (X : POS_INT) RETURN POS_FIX IS
+      BEGIN
+           ERR := TRUE;
+           RETURN POS_FIX (X);
+      END "+";
+ 
+      FUNCTION "+" (X : POS_FIX) RETURN POS_INT IS
+      BEGIN
+           ERR := TRUE;
+           RETURN POS_INT (X);
+      END "+";
+ 
+ BEGIN
+      TEST ("C87B62A","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+            "- SPECIFICATION OF ATTRIBUTE T'SIZE");
+ 
+      DECLARE
+           TYPE DECEM IS NEW INTEGER RANGE    1 .. 10;
+           TYPE JUST_LIKE_DECEM IS NEW INTEGER RANGE 1 .. 10;
+           DECEM_SIZE :  CONSTANT  := JUST_LIKE_DECEM'SIZE;
+           TYPE CHECK IS NEW INTEGER RANGE 1 .. 10;
+ 
+           FOR CHECK'SIZE USE DECEM_SIZE;
+           FOR DECEM'SIZE        USE + DECEM_SIZE;
+ 
+      BEGIN
+           IF ERR THEN
+                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                        "LENGTH CLAUSE USING 'SIZE");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C87B62A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C87B62B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ --       IN A LENGTH CLAUSE THAT SPECIFIES 'STORAGE_SIZE,
+ --       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
+ --       ACCESS TYPES ARE HERE; TASK TYPES ARE IN C87B62D.DEP.
+ 
+ -- HISTORY:
+ --     TRH 09/08/82  CREATED ORIGINAL TEST.
+ --     EG  06/04/84
+ --     PWB 01/19/86  CLARIFIED COMMENTS REGARDING NON-APPLICABILITY;
+ --                   REMOVED TEXT NOT RELATED TO TEST OBJECTIVE
+ --                   MOVED TASK TYPES TO C87B62D.DEP.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C87B62B IS
+ 
+      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+      TYPE POS_INT IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      TYPE NUMERAL IS NEW CHARACTER RANGE '0' .. '9';
+      TYPE BASE_5  IS ('0', '1', '2', '3', '4');
+      ERR : BOOLEAN := FALSE;
+ 
+      FUNCTION F (X : INTEGER) RETURN NUMERAL IS
+      BEGIN
+           ERR := TRUE;
+           RETURN ('9');
+      END F;
+ 
+      FUNCTION F (X : INTEGER) RETURN BASE_5 IS
+      BEGIN
+           ERR := TRUE;
+           RETURN ('4');
+      END F;
+ 
+      FUNCTION F (X : INTEGER) RETURN POS_FIX IS
+      BEGIN
+           ERR := TRUE;
+           RETURN POS_FIX (X);
+      END F;
+ 
+      FUNCTION F (X : INTEGER) RETURN POS_INT IS
+      BEGIN
+           RETURN POS_INT (X);
+      END F;
+ 
+ BEGIN
+      TEST ("C87B62B","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+                      "- SPECIFICATION OF ATTRIBUTE T'STORAGE_SIZE " &
+                      "FOR ACCESS TYPES");
+ 
+      DECLARE
+ 
+           TYPE DECEM IS NEW INTEGER RANGE    1 .. 10;
+           TYPE LINK  IS ACCESS DECEM;
+ 
+           TYPE JUST_LIKE_LINK IS ACCESS DECEM;
+           TYPE CHECK IS ACCESS DECEM;
+ 
+           FOR CHECK'STORAGE_SIZE
+                USE 1024;
+           FOR LINK'STORAGE_SIZE USE F (1024);
+ 
+      BEGIN
+           IF ERR THEN
+                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                        "LENGTH CLAUSE USING 'STORAGE_SIZE");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C87B62B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C87B62C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ --       IN A LENGTH CLAUSE THAT SPECIFIES 'SMALL, THE EXPRESSION
+ --       MUST BE OF SOME REAL TYPE.
+ 
+ -- HISTORY:
+ --     TRH 09/08/82  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED COMMENTS TO CLARIFY NON-APPLICABILITY;
+ --                   REMOVED TEXT NOT RELATED TO TEST OBJECTIVE.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C87B62C IS
+ 
+      TYPE POS_INT IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+      ERR : BOOLEAN := FALSE;
+ 
+      FUNCTION "+" (X : POS_INT) RETURN POS_FIX IS
+      BEGIN
+           ERR := TRUE;
+           RETURN POS_FIX (X);
+      END "+";
+ 
+      FUNCTION "+" (X : POS_FIX) RETURN POS_INT IS
+      BEGIN
+           ERR := TRUE;
+           RETURN POS_INT (X);
+      END "+";
+ 
+ BEGIN
+      TEST ("C87B62C","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+            "- SPECIFICATION OF ATTRIBUTE T'SMALL");
+ 
+      DECLARE
+           TYPE JUST_LIKE_FIXED IS DELTA 0.1 RANGE -1.0 .. 1.0;
+           TYPE FIXED IS DELTA 0.1   RANGE -1.0 .. 1.0;
+ 
+           FIKST_SMALL : CONSTANT := JUST_LIKE_FIXED'SMALL;
+           TYPE CHECK IS DELTA 0.1 RANGE -1.0 .. 1.0;
+ 
+           FOR CHECK'SMALL USE FIKST_SMALL;
+           FOR FIXED'SMALL       USE + FIKST_SMALL;
+ 
+      BEGIN
+           IF ERR THEN
+                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                        "LENGTH CLAUSE USING 'SMALL");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C87B62C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62d.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62d.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c8/c87b62d.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c8/c87b62d.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C87B62D.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT OVERLOADING RESOLUTION USES THE RULE THAT:
+ --
+ --       IN A LENGTH CLAUSE THAT SPECIFIES 'STORAGE_SIZE,
+ --       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
+ --       TASK TYPE IS HERE; ACCESS TYPE IS IN C87B62B.DEP.
+ 
+ -- MACRO SUBSTITUTION:
+ --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+ --     THE ACTIVATION OF A TASK.
+ 
+ -- HISTORY:
+ --     TRH 09/08/82  CREATED ORIGINAL TEST.
+ --     EG  06/04/84
+ --     PWB 01/19/86  CREATED THIS TEST FILE FROM THE TASK TYPE PART
+ --                   OF THE OLD C87B62B;
+ --                   CLARIFIED COMMENTS REGARDING NON-APPLICABILITY.
+ --     BCB 01/04/88  MODIFIED HEADER.
+ --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.TST'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C87B62D IS
+ 
+      TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+ 
+      TYPE POS_INT IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+      TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+      TYPE NUMERAL IS NEW CHARACTER RANGE '0' .. '9';
+      TYPE BASE_5  IS ('0', '1', '2', '3', '4');
+      ERR : BOOLEAN := FALSE;
+ 
+      FUNCTION F (X : INTEGER) RETURN NUMERAL IS
+      BEGIN
+           ERR := TRUE;
+           RETURN ('9');
+      END F;
+ 
+      FUNCTION F (X : INTEGER) RETURN BASE_5 IS
+      BEGIN
+           ERR := TRUE;
+           RETURN ('4');
+      END F;
+ 
+      FUNCTION F (X : INTEGER) RETURN POS_FIX IS
+      BEGIN
+           ERR := TRUE;
+           RETURN POS_FIX (X);
+      END F;
+ 
+      FUNCTION F (X : INTEGER) RETURN POS_INT IS
+      BEGIN
+           RETURN POS_INT (X);
+      END F;
+ 
+ BEGIN
+      TEST ("C87B62D","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+            "- SPECIFICATION OF ATTRIBUTE T'STORAGE_SIZE " &
+            "FOR TASK TYPES ");
+ 
+      DECLARE
+ 
+           TASK TYPE TSK1  IS
+           END TSK1;
+ 
+           FOR TSK1'STORAGE_SIZE USE F (TASK_STORAGE_SIZE);
+ 
+           TASK BODY TSK1 IS
+           BEGIN
+                NULL;
+           END TSK1;
+ 
+      BEGIN
+           IF ERR THEN
+                FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                        "LENGTH CLAUSE USING 'STORAGE_SIZE");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C87B62D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c910001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c910001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c910001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c910001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,224 ----
+ -- C910001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that tasks may have discriminants.  Specifically, check where
+ --      the subtype of the discriminant is a discrete subtype and where it is
+ --      an access subtype.  Check the case where the default values of the
+ --      discriminants are used.
+ --
+ -- TEST DESCRIPTION:
+ --      A task is defined with two discriminants, one a discrete subtype and
+ --      another that is an access subtype.  Tasks are created with various
+ --      values for discriminants and code within the task checks that these
+ --      are passed in correctly.  One instance of a default is used.  The
+ --      values passed to the task as the discriminants are taken from an
+ --      array of test data and the values received are checked against the
+ --      same array.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ 
+ procedure C910001 is
+  
+ 
+    type App_Priority is range 1..10;
+    Default_Priority : App_Priority := 5;
+ 
+    type Message_ID is range 1..10_000; 
+ 
+    type TC_Number_of_Messages is range 1..5;
+ 
+    type TC_rec is record
+       TC_ID       : Message_ID;
+       A_Priority  : App_Priority;
+       TC_Checked  : Boolean;
+    end record;
+ 
+    -- This table is used to create the messages and to check them
+    TC_table : array (1..TC_Number_of_Messages'Last) of TC_Rec := 
+                               (  ( 10, 6, false ),
+                                  ( 20, 2, false ),
+                                  ( 30, 9, false ),
+                                  ( 40, 1, false ),
+                                  ( 50, Default_Priority, false ) );
+ 
+ begin -- C910001
+ 
+    Report.Test ("C910001", "Check that tasks may have discriminants");
+ 
+       
+    declare     -- encapsulate the test
+ 
+       type Transaction_Record is 
+          record
+             ID               : Message_ID;
+             Account_Number   : integer := 0;
+             Stock_Number     : integer := 0;
+             Quantity         : integer := 0;
+             Return_Value     : integer := 0;
+          end record;
+       -- 
+       type acc_Transaction_Record is access Transaction_Record;
+ 
+ 
+       task type Message_Task
+                    (In_Message  : acc_Transaction_Record := null;
+                     In_Priority : App_Priority := Default_Priority) is
+          entry Start;
+       end Message_Task;
+       type acc_Message_Task is access Message_Task;
+       --
+       --
+       task body Message_Task is
+          This_Message   : acc_Transaction_Record := In_Message;
+          This_Priority  : App_Priority           := In_Priority; 
+          TC_Match_Found : Boolean                := false;
+       begin 
+          accept Start;
+          -- In the example envisioned this task would then queue itself
+          -- upon some Distributor task which would send it off (requeue) to
+          -- the message processing tasks according to the priority of the 
+          -- message and the current load on the system.  For the test we
+          -- just verify the data passed in as discriminants and exit the task
+          -- 
+          -- Check for the special case of default discriminants
+          if This_Message = null then
+             -- The default In_Message has been passed, check that the
+             -- default priority was also passed
+             if This_Priority /= Default_Priority then
+                Report.Failed ("Incorrect Default Priority");
+             end if;
+             if TC_Table (TC_Number_of_Messages'Last).TC_Checked then
+                Report.Failed ("Duplicate Default messages");
+             else
+                -- Mark that default has been seen
+                TC_Table (TC_Number_of_Messages'Last).TC_Checked := True;
+             end if; 
+             TC_Match_Found := true;
+          else
+             -- Check the data against the table
+             for i in TC_Number_of_Messages loop
+                if TC_Table(i).TC_ID = This_Message.ID then
+                   -- this is the right slot in the table
+                   if TC_Table(i).TC_checked then
+                      -- Already checked
+                      Report.Failed ("Duplicate Data");
+                   else 
+                      TC_Table(i).TC_checked := true;
+                   end if;
+                   TC_Match_Found := true;
+                   if TC_Table(i).A_Priority /= This_Priority then
+                      Report.Failed ("ID/Priority mismatch");
+                   end if;
+                   exit;
+                end if;
+             end loop;
+          end if;
+ 
+          if not TC_Match_Found then
+             Report.Failed ("No ID match in table");
+          end if;
+ 
+          -- Allow the task to terminate
+ 
+       end Message_Task;
+ 
+ 
+       -- The Line Driver task accepts data from an external source and 
+       -- builds them into a transaction record.  It then generates a
+       -- message task.  This message "contains" the record and is given 
+       -- a priority according to the contents of the message.  The priority 
+       -- and transaction records are passed to the task as discriminants.
+       --    In this test we use a dummy record.  Only the ID is of interest 
+       --    so we pick that and the required priority from an array of 
+       --    test data.  We artificially limit the endless driver-loop to 
+       --    the number of messages required for the test and add a special
+       --    case to check the defaults.
+       --
+       task Driver_Task;
+       --
+       task body Driver_Task is
+       begin
+ 
+          -- Create all but one of the required tasks
+          --
+          for i in 1..TC_Number_of_Messages'Last - 1   loop
+             declare
+                -- Create a record for the next message
+                Next_Transaction : acc_Transaction_Record := 
+                                                 new Transaction_Record;
+                -- Create a task for the next message
+                Next_Message_Task : acc_Message_Task := 
+                                  new Message_Task( Next_Transaction,  
+                                                    TC_Table(i).A_Priority );
+ 
+             begin
+                -- Artificially plug the ID with the next from the table
+                --    In reality the whole record would be built here
+                Next_Transaction.ID := TC_Table(i).TC_ID;
+                
+                -- Ensure the task does not start executing till the 
+                -- transaction record is properly constructed
+                Next_Message_Task.Start;
+ 
+             end;  -- declare
+          end loop;
+ 
+          -- For this subtest create one task with the default discriminants
+          --
+          declare 
+ 
+             -- Create the task 
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+ 
+          begin
+             
+             Next_Message_Task.Start;
+ 
+          end; -- declare
+ 
+ 
+       end Driver_Task;
+ 
+    begin    
+       null;
+    end;     -- encapsulation
+ 
+    -- Now verify that all the tasks executed and checked in
+    for i in TC_Number_of_Messages loop
+       if not TC_Table(i).TC_Checked then 
+          Report.Failed 
+                  ("Task" & integer'image(integer (i) ) & " did not verify");
+       end if;
+    end loop; 
+    Report.Result;
+ 
+ end C910001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c910002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c910002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c910002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c910002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,143 ----
+ -- C910002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the contents of a task object include the values
+ --      of its discriminants.
+ --      Check that selected_component notation can be used to
+ --      denote a discriminant of a task.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares a task type that contains discriminants.
+ --      Objects of the task type are created with different values.
+ --      The task type has nested tasks that are used to check that
+ --      the discriminate values are the expected values.
+ --      Note that the names of the discriminants in the body of task
+ --      type DTT denote the current instance of the unit.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      12 OCT 95   SAIC    Initial release for 2.1
+ --       8 MAY 96   SAIC    Incorporated Reviewer comments.
+ --
+ --!
+ 
+ 
+ with Report;
+ procedure C910002 is
+   Verbose : constant Boolean := False;
+ begin
+   Report.Test ("C910002",
+                "Check that selected_component notation can be" &
+                " used to access task discriminants");
+   declare
+ 
+     task type DTT
+          (IA, IB : Integer;
+           CA, CB : Character) is
+       entry Check_Values (First_Int : Integer;
+                           First_Char : Character);
+     end DTT;
+ 
+     task body DTT is
+        Int1 : Integer;
+        Char1 : Character;
+ 
+        -- simple nested task to check the character values
+        task Check_Chars is
+           entry Start_Check;
+        end Check_Chars;
+        task body Check_Chars is
+        begin
+           accept Start_Check;
+           if DTT.CA /= Char1 or
+              DTT.CB /= Character'Succ (Char1) then
+             Report.Failed ("character check failed.  Expected: '" &
+                      Char1 & Character'Succ (Char1) &
+                      "' but found '" &
+                      DTT.CA & DTT.CB & "'");
+           elsif Verbose then
+             Report.Comment ("char check for " & Char1);
+           end if;
+        exception
+           when others => Report.Failed ("exception in Check_Chars");
+        end Check_Chars;
+ 
+        -- use a discriminated task to check the integer values
+        task type Check_Ints (First : Integer);
+        task body Check_Ints is
+        begin
+           if DTT.IA /= Check_Ints.First or
+              IB     /= First+1 then
+             Report.Failed ("integer check failed.  Expected:" &
+                      Integer'Image (Check_Ints.First) & 
+                      Integer'Image (First+1) &
+                      " but found" &
+                      Integer'Image (DTT.IA) & Integer'Image (IB) );
+           elsif Verbose then
+             Report.Comment ("int check for" & Integer'Image (First));
+           end if;
+        exception
+           when others => Report.Failed ("exception in Check_Ints");
+        end Check_Ints;
+     begin
+       accept Check_Values (First_Int : Integer;
+                            First_Char : Character) do
+         Int1 := First_Int;
+         Char1 := First_Char;
+       end Check_Values;
+ 
+       -- kick off the character check
+       Check_Chars.Start_Check;
+ 
+       -- do the integer check
+       declare
+          Int_Checker : Check_Ints (Int1);
+       begin
+         null;  -- let task do its thing
+       end;
+ 
+       -- do one test here too
+       if DTT.IA /= Int1 then
+         Report.Failed ("DTT check failed.  Expected:" &
+               Integer'Image (Int1) &
+               " but found:" &
+               Integer'Image (DTT.IA));
+       elsif Verbose then
+         Report.Comment ("DTT check for" & Integer'Image (Int1));
+       end if;
+     exception
+       when others => Report.Failed ("exception in DTT");
+     end DTT;
+ 
+     T1a : DTT (1,  2, 'a', 'b');
+     T9C : DTT (9, 10, 'C', 'D');
+   begin   -- test encapsulation
+     T1a.Check_Values (1, 'a');
+     T9C.Check_Values (9, 'C');
+   end;
+ 
+   Report.Result;
+ end C910002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c910003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c910003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c910003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c910003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,185 ----
+ -- C910003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that task discriminants that have an access subtype may be
+ --      dereferenced.
+ --
+ --      Note that discriminants in Ada 83 never can be dereferenced with
+ --      selection or indexing, as they cannot have an access type.
+ --
+ -- TEST DESCRIPTION:
+ --      A protected object is defined to create a simple buffer.
+ --      Two task types are defined, one to put values into the buffer,
+ --      and one to remove them. The tasks are passed a buffer object as
+ --      a discriminant with an access subtype. The producer task type includes
+ --      a discriminant to determine the values to product. The consumer task
+ --      type includes a value to save the results.
+ --      Two producer and one consumer tasks are declared, and the results
+ --      are checked.
+ --
+ -- CHANGE HISTORY:
+ --      10 Mar 99   RLB    Created test.
+ --
+ --!
+ 
+ package C910003_Pack is
+ 
+     type Item_Type is range 1 .. 100; -- In a real application, this probably
+                                       -- would be a record type.
+ 
+     type Item_Array is array (Positive range <>) of Item_Type;
+ 
+     protected type Buffer is
+        entry Put (Item  : in Item_Type);
+        entry Get (Item  : out Item_Type);
+        function TC_Items_Buffered return Item_Array;
+     private
+        Saved_Item : Item_Type;
+        Empty : Boolean := True;
+        TC_Items : Item_Array (1 .. 10);
+        TC_Last  : Natural := 0;
+     end Buffer;
+ 
+     type Buffer_Access_Type is access Buffer;
+ 
+     PRODUCE_COUNT : constant := 2; -- Number of items to produce.
+ 
+     task type Producer (Buffer_Access : Buffer_Access_Type;
+                         Start_At : Item_Type);
+         -- Produces PRODUCE_COUNT items. Starts when activated.
+ 
+     type TC_Item_Array_Access_Type is access Item_Array (1 .. PRODUCE_COUNT*2);
+ 
+     task type Consumer (Buffer_Access : Buffer_Access_Type;
+                         Results : TC_Item_Array_Access_Type) is
+         -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
+         -- activated.
+         entry Wait_until_Done;
+     end Consumer;
+ 
+ end C910003_Pack;
+ 
+ 
+ with Report;
+ package body C910003_Pack is
+ 
+     protected body Buffer is
+        entry Put (Item  : in Item_Type) when Empty is
+        begin
+            Empty := False;
+            Saved_Item := Item;
+            TC_Last := TC_Last + 1;
+            TC_Items(TC_Last) := Item;
+        end Put;
+ 
+        entry Get (Item  : out Item_Type) when not Empty is
+        begin
+            Empty := True;
+            Item := Saved_Item;
+        end Get;
+ 
+        function TC_Items_Buffered return Item_Array is
+        begin
+            return TC_Items(1..TC_Last);
+        end TC_Items_Buffered;
+ 
+     end Buffer;
+ 
+ 
+     task body Producer is
+         -- Produces PRODUCE_COUNT items. Starts when activated.
+     begin
+         for I in 1 .. Report.Ident_Int(PRODUCE_COUNT) loop
+            Buffer_Access.Put (Start_At + (Item_Type(I)-1)*2);
+         end loop;
+     end Producer;
+ 
+ 
+     task body Consumer is
+         -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
+         -- activated.
+     begin
+         for I in 1 .. Report.Ident_Int(PRODUCE_COUNT*2) loop
+             Buffer_Access.Get (Results (I));
+             -- Buffer_Access and Results are both dereferenced.
+         end loop;
+ 
+         -- Check the results (and function call with a prefix dereference).
+         if Results.all(Report.Ident_Int(1)) /= Buffer_Access.all.TC_Items_Buffered(Report.Ident_Int(1)) then
+            Report.Failed ("First item mismatch");
+         end if;
+         if Results(Report.Ident_Int(2)) /= Buffer_Access.TC_Items_Buffered(Report.Ident_Int(2)) then
+            Report.Failed ("Second item mismatch");
+         end if;
+         accept Wait_until_Done; -- Tell main that we're done.
+     end Consumer;
+ 
+ end C910003_Pack;
+ 
+ 
+ with Report;
+ with C910003_Pack;
+ 
+ procedure C910003 is
+ 
+ begin -- C910003
+ 
+    Report.Test ("C910003", "Check that tasks discriminants of access types can be dereferenced");
+ 
+ 
+    declare     -- encapsulate the test
+ 
+       Buffer_Access : C910003_Pack.Buffer_Access_Type :=
+          new C910003_Pack.Buffer;
+ 
+       TC_Results : C910003_Pack.TC_Item_Array_Access_Type :=
+          new C910003_Pack.Item_Array (1 .. C910003_Pack.PRODUCE_COUNT*2);
+ 
+       Producer_1 : C910003_Pack.Producer (Buffer_Access, 12);
+       Producer_2 : C910003_Pack.Producer (Buffer_Access, 23);
+ 
+       Consumer : C910003_Pack.Consumer (Buffer_Access, TC_Results);
+ 
+       use type C910003_Pack.Item_Array; -- For /=.
+ 
+    begin
+       Consumer.Wait_until_Done;
+       if TC_Results.all /= Buffer_Access.TC_Items_Buffered then
+            Report.Failed ("Different items buffered than returned - Main");
+       end if;
+       if (TC_Results.all /= (12, 14, 23, 25) and
+           TC_Results.all /= (12, 23, 14, 25) and
+           TC_Results.all /= (12, 23, 25, 14) and
+           TC_Results.all /= (23, 12, 14, 25) and
+           TC_Results.all /= (23, 12, 25, 14) and
+           TC_Results.all /= (23, 25, 12, 14)) then
+           -- Above are the only legal results.
+            Report.Failed ("Wrong results");
+       end if;
+    end;     -- encapsulation
+ 
+    Report.Result;
+ 
+ end C910003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91004b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91004b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91004b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C91004B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A TASK (TYPE) IDENTIFIER, WHEN USED WITHIN ITS OWN
+ --     BODY, REFERS TO THE EXECUTING TASK.
+ 
+ --      TEST USING IDENTIFIER IN ABORT STATEMENT, AS AN EXPRESSION IN
+ --      A MEMBERSHIP TEST, AND THE PREFIX OF 'CALLABLE AND
+ --      'TERMINATED.
+ 
+ -- HISTORY:
+ --     WEI  3/ 4/82  CREATED ORIGINAL TEST.
+ --     RJW 11/13/87  RENAMED TEST FROM C910BDA.ADA.  ADDED CHECKS FOR
+ --                   MEMBERSHIP TEST, AND 'CALLABLE AND 'TERMINATED
+ --                   ATTRIBUTES.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C91004B IS
+ 
+      TYPE I0 IS RANGE 0..1;
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      TASK TYPE TT1 IS
+           ENTRY E1 (P1 : IN I0; P2 : ARG);
+           ENTRY BYE;
+      END TT1;
+ 
+      SUBTYPE SUB_TT1 IS TT1;
+ 
+      OBJ_TT1 : ARRAY (NATURAL RANGE 1..2) OF TT1;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+      TASK BODY TT1 IS
+      BEGIN
+           IF TT1 NOT IN SUB_TT1 THEN
+                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST");
+           END IF;
+ 
+           IF NOT TT1'CALLABLE THEN
+                FAILED ("INCORRECT RESULTS FOR 'CALLABLE");
+           END IF;
+ 
+           IF TT1'TERMINATED THEN
+                FAILED ("INCORRECT RESULTS FOR 'TERMINATED");
+           END IF;
+ 
+           ACCEPT E1 (P1 : IN I0; P2 : ARG) DO
+                IF P1 = 1 THEN
+                     ABORT TT1;
+                     ACCEPT BYE;    -- WILL DEADLOCK IF NOT ABORTED.
+                END IF;
+                PSPY_NUMB (ARG (P2));
+           END E1;
+ 
+      END TT1;
+ 
+ BEGIN
+ 
+      TEST ("C91004B", "TASK IDENTIFIER IN OWN BODY");
+ 
+      BEGIN
+           OBJ_TT1 (1).E1 (1,1);
+           FAILED ("NO TASKING_ERROR RAISED");
+ -- ABORT DURING RENDEVOUS RAISES TASKING ERROR
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+      END;
+ 
+      OBJ_TT1 (2).E1 (0,2);
+ 
+      IF SPYNUMB /= 2 THEN
+           FAILED ("WRONG TASK OBJECT REFERENCED");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C91004B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91004c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91004c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91004c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C91004C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK (TYPE) IDENTIFIER, WHEN USED WITHIN ITS OWN BODY
+ -- REFERS TO THE EXECUTING TASK.
+ --
+ -- TEST USING CONDITIONAL ENTRY CALL.
+ 
+ -- WEI  3/ 4/82
+ -- TLB 10/30/87  RENAMED FROM C910BDB.ADA.
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C91004C IS
+ 
+      TASK TYPE TT1 IS
+           ENTRY E1;
+           ENTRY BYE;
+      END TT1;
+ 
+      OBJ_TT1 : ARRAY (NATURAL RANGE 1..2) OF TT1;
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+      TASK BODY TT1 IS
+      BEGIN
+           ACCEPT E1 DO
+                PSPY_NUMB (1);
+           END E1;
+ 
+           SELECT
+                TT1.E1;
+           ELSE
+                PSPY_NUMB (2);
+           END SELECT;
+ 
+           ACCEPT BYE;
+      END TT1;
+ 
+ BEGIN
+ 
+      TEST ("C91004C", "TASK IDENTIFIER IN OWN BODY");
+      OBJ_TT1 (1).E1;
+      OBJ_TT1 (1).BYE;
+ 
+      IF SPYNUMB /=12 THEN
+           FAILED ("WRONG TASK OBJECT REFERENCED");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      ABORT OBJ_TT1 (2);
+ 
+      RESULT;
+ 
+ END C91004C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C91006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IN A TASK SPECIFICATION ENTRY DECLARATIONS ARE ELABORATED
+ -- WHEN THE SPECIFICATION IS ELABORATED, AND IN TEXTUAL ORDER.
+ 
+ -- WEI  3/04/82
+ -- BHS  7/13/84
+ -- TBN 12/17/85     RENAMED FROM C910AHA-B.ADA;
+ --                  ADDED DECLARATIONS OF FIRST AND LAST.
+ -- PWB  5/15/86     MOVED DECLARATIONS OF FIRST, TASK T1, AND LAST
+ --                  INTO A DECLARE/BEGIN/END BLOCK.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C91006A IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      INDEX : INTEGER RANGE 0..5 := 0;
+      SPYNUMB : STRING(1..5) := (1..5 => ' ');
+ 
+      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+           TEMP : STRING(1..2);
+      BEGIN
+           TEMP := ARG'IMAGE(DIGT);
+           INDEX := INDEX + 1;
+           SPYNUMB(INDEX) := TEMP(2);
+           RETURN DIGT;
+      END FINIT_POS;
+ 
+ BEGIN
+      TEST ("C91006A", "CHECK THAT IN A TASK SPEC, ELABORATION IS IN " &
+                       "TEXTUAL ORDER");
+      DECLARE
+ 
+           FIRST : INTEGER := FINIT_POS (1);
+ 
+           TASK T1 IS
+                ENTRY E2 (NATURAL RANGE 1 .. FINIT_POS (2));
+                ENTRY E3 (NATURAL RANGE 1 .. FINIT_POS (3));
+                ENTRY E4 (NATURAL RANGE 1 .. FINIT_POS (4));
+           END T1;
+ 
+           LAST : INTEGER := FINIT_POS (5);
+ 
+           TASK BODY T1 IS
+           BEGIN
+                NULL;
+           END T1;
+ 
+      BEGIN
+            NULL;
+      END;
+ 
+      IF SPYNUMB /= "12345" THEN 
+           FAILED ("TASK SPEC T1 NOT ELABORATED IN TEXTUAL ORDER");
+           COMMENT ("ACTUAL ORDER WAS: " & SPYNUMB);
+      END IF;
+ 
+      RESULT;
+ 
+ END C91006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c91007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c91007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C91007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     IF THE ELABORATION OF AN ENTRY DECLARATION RAISES
+ --     "CONSTRAINT_ERROR", THEN NO TASKS ARE ACTIVATED, AND
+ --     "TASKING_ERROR" IS NOT RAISED.
+ 
+ -- HISTORY:
+ --     LDC 06/17/88  CREATED ORGINAL TEST
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE C91007A IS
+ 
+      TYPE ENUM IS (TERESA, BRIAN, PHIL, JOLEEN, LYNN, DOUG, JODIE,
+                    VINCE, TOM, DAVE, JOHN, ROSA);
+      SUBTYPE ENUM_SUB IS ENUM RANGE BRIAN..LYNN;
+ 
+ BEGIN
+      TEST("C91007A","IF THE ELABORATION OF AN ENTRY DECLARATION " &
+                     "RAISES 'CONSTRAINT_ERROR', THEN NO TASKS ARE " &
+                     "ACTIVATED, AND 'TASKING_ERROR' IS NOT RAISED");
+ 
+      BEGIN
+           DECLARE
+                TASK TYPE TSK1;
+                T1 : TSK1;
+                TASK BODY TSK1 IS
+                BEGIN
+                     FAILED("TSK1 WAS ACTIVATED");
+                END TSK1;
+ 
+ 
+                TASK TSK2 IS
+                     ENTRY ENT(ENUM_SUB RANGE TERESA..LYNN);
+                END TSK2;
+ 
+                TASK BODY TSK2 IS
+                BEGIN
+                     FAILED("TASK BODY WAS ACTIVATED");
+                END TSK2;
+ 
+                TASK TSK3;
+                TASK BODY TSK3 IS
+                BEGIN
+                     FAILED("TSK3 WAS ACTIVATED");
+                END TSK3;
+ 
+           BEGIN
+                NULL;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("CONSTRAINT_ERROR WAS RAISED IN THE " &
+                            "BEGIN BLOCK");
+                WHEN TASKING_ERROR =>
+                     FAILED("TASKING_ERROR WAS RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR IN THE BEGIN BLOCK");
+                WHEN OTHERS =>
+                     FAILED("OTHER EXCEPTION WAS RAISED IN " &
+                            "THE BEGIN BLOCK");
+           END;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN TASKING_ERROR =>
+                FAILED("TASKING_ERROR WAS RAISED INSTEAD OF " &
+                       "CONSTRAINT_ERROR");
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION WAS RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C91007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C92002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ASSIGNMENT TO A COMPONENT (FOR WHICH ASSIGNMENT IS
+ --   AVAILABLE) OF A RECORD CONTAINING A TASK IS AVAILABLE.
+ 
+ -- JRK 9/17/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C92002A IS
+ 
+ BEGIN
+      TEST ("C92002A", "CHECK THAT CAN ASSIGN TO ASSIGNABLE " &
+                       "COMPONENTS OF RECORDS WITH TASK " &
+                       "COMPONENTS");
+ 
+      DECLARE
+ 
+           TASK TYPE TT IS
+                ENTRY E;
+           END TT;
+ 
+           TYPE RT IS
+                RECORD
+                     I : INTEGER := 0;
+                     T : TT;
+                     J : INTEGER := 0;
+                END RECORD;
+ 
+           R : RT;
+ 
+           TASK BODY TT IS
+           BEGIN
+                NULL;
+           END TT;
+ 
+      BEGIN
+ 
+           R.I := IDENT_INT (7);
+           R.J := IDENT_INT (9);
+ 
+           IF R.I /= 7 AND R.J /= 9 THEN
+                FAILED ("WRONG VALUE(S) WHEN ASSIGNING TO " &
+                        "INTEGER COMPONENTS OF RECORDS WITH " &
+                        "TASK COMPONENTS");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C92002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C92003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK CAN BE PASSED AS AN ACTUAL IN OR IN OUT PARAMETER
+ -- IN A SUBPROGRAM CALL AND THAT THE ACTUAL AND FORMAL PARAMETERS DENOTE
+ -- THE SAME TASK OBJECT.
+ 
+ -- JRK  1/17/81
+ -- TBN 12/19/85  ADDED IN OUT PARAMETER CASE.
+ -- PWB  8/04/86  ADDED CHECK THAT FORMAL AND ACTUAL PARAMETERS DENOTE
+ --               THE SAME TASK OBJECT.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C92003A IS
+ 
+ BEGIN
+ 
+      TEST ("C92003A", "CHECK TASKS PASSED AS ACTUAL IN OR IN OUT " &
+                        "PARAMETERS TO SUBPROGRAMS");
+ 
+      DECLARE
+ 
+           TASK TYPE TT IS
+                ENTRY E (I : INTEGER);
+           END TT;
+ 
+           T, S : TT;
+ 
+           TASK BODY TT IS
+                SOURCE : INTEGER;
+           BEGIN
+ 
+                SELECT
+                     ACCEPT E (I : INTEGER) DO
+                          SOURCE := I;
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+ 
+                IF SOURCE /= 1 THEN
+                     FAILED ("EXPECTED 1, GOT " & INTEGER'IMAGE(SOURCE));
+                END IF;
+ 
+                SELECT
+                     ACCEPT E (I : INTEGER) DO
+                          SOURCE := I;
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+ 
+                IF SOURCE /= 2 THEN
+                     FAILED ("EXPECTED 2, GOT " & INTEGER'IMAGE(SOURCE));
+                END IF;
+ 
+                SELECT
+                     ACCEPT E (I : INTEGER) DO
+                          SOURCE := I;
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+ 
+                IF SOURCE /= 3 THEN
+                     FAILED ("EXPECTED 3, GOT " & INTEGER'IMAGE(SOURCE));
+                END IF;
+ 
+           END TT;
+ 
+           PROCEDURE P (T : TT) IS
+           BEGIN
+                T.E(2);
+           END P;
+ 
+           PROCEDURE Q (S : IN OUT TT) IS
+           BEGIN
+                S.E(2);
+           END Q;
+ 
+      BEGIN
+ 
+           T.E(1);                  -- FIRST CALL TO T.E
+           P(T);                    -- SECOND CALL TO T.E
+           T.E(3);                  -- THIRD CALL TO T.E
+ 
+           S.E(1);                  -- FIRST CALL TO S.E
+           Q(S);                    -- SECOND CALL TO S.E
+           S.E(3);                  -- THIRD CALL TO S.E
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C92003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,75 ----
+ -- C92005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR A NON-SINGLE TASK THE OBJECT VALUE IS SET DURING
+ -- ELABORATION OF THE CORRESPONDING OBJECT DECLARATION.
+ 
+ -- WEI  3/ 4/82
+ -- JBG 5/25/85
+ -- PWB  2/3/86    CORRECTED TEST ERROR; ADDED 'USE' CLAUSE TO MAKE "/="
+ --                FOR BIG_INT VISIBLE.
+ 
+ WITH REPORT, SYSTEM;
+  USE REPORT;
+ PROCEDURE C92005A IS
+ BEGIN
+ 
+      TEST ("C92005A", "TASK OBJECT VALUE DURING ELABORATION");
+ 
+      DECLARE
+           TASK TYPE TT1;
+ 
+           OBJ_TT1 : TT1;
+ 
+           PACKAGE PACK IS
+                TYPE BIG_INT IS RANGE 0 .. SYSTEM.MAX_INT;
+                I : BIG_INT;
+           END PACK;
+ 
+           PACKAGE BODY PACK IS
+           BEGIN
+                I := OBJ_TT1'STORAGE_SIZE;  -- O.K.
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("TASK OBJECT RAISED EXCEPTION");
+           END PACK;
+ 
+           USE PACK;
+ 
+           TASK BODY TT1 IS
+           BEGIN
+                NULL;
+           END TT1;
+ 
+      BEGIN
+           IF PACK.I /= OBJ_TT1'STORAGE_SIZE THEN
+                COMMENT ("STORAGE SIZE CHANGED AFTER TASK ACTIVATED");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY STORAGE_SIZE");
+      END;
+ 
+      RESULT;
+ END C92005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C92005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR A TASK OBJECT CREATED BY AN ALLOCATOR THE
+ -- OBJECT VALUE IS SET DURING EXECUTION OF THE ALLOCATOR.
+ 
+ -- WEI  3/ 4/82
+ -- JBG  5/25/85
+ -- RLB  1/ 7/05
+ 
+ WITH REPORT;
+  USE REPORT;
+ WITH SYSTEM;
+ PROCEDURE C92005B IS
+      TYPE BIG_INT IS RANGE 0..SYSTEM.MAX_INT;
+ BEGIN
+      TEST ("C92005B", "TASK VALUE SET BY EXECUTION OF ALLOCATOR");
+ 
+ BLOCK:
+      DECLARE
+           TASK TYPE TT1;
+ 
+           TYPE ATT1 IS ACCESS TT1;
+ 
+           TASK BODY TT1 IS
+           BEGIN
+                NULL;
+           END TT1;
+ 
+           PACKAGE PACK IS
+           END PACK;
+ 
+           PACKAGE BODY PACK IS
+                POINTER_TT1 : ATT1 := NEW TT1;
+                I : BIG_INT := POINTER_TT1.ALL'STORAGE_SIZE;
+           BEGIN
+                IF NOT EQUAL(INTEGER(I MOD 1024), INTEGER(I MOD 1024)) THEN
+                     FAILED ("UNEXPECTED PROBLEM");
+                END IF;
+           END PACK;
+      BEGIN
+           NULL;
+      EXCEPTION
+           WHEN PROGRAM_ERROR | CONSTRAINT_ERROR =>
+                FAILED ("TASK OBJECT VALUE NOT SET DURING " &
+                        "EXECUTION OF ALLOCATOR");
+      END BLOCK;
+ 
+      RESULT;
+ 
+ END C92005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c92006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c92006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C92006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT TASK OBJECTS CAN BE INTERCHANGED BY ASSIGNMENT OF
+ -- CORRESPONDING ACCESS TYPE OBJECTS.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C920BIA-B.ADA
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C92006A IS
+ 
+      TASK TYPE TT1 IS
+           ENTRY E1;
+           ENTRY E2;
+      END TT1;
+ 
+      TYPE ATT1 IS ACCESS TT1;
+      POINTER_TT1_1, POINTER_TT1_2 : ATT1;
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+      PROCEDURE PROC (P1, P2 : IN OUT ATT1) IS
+      -- SWAP TASK OBJECTS P1, P2.
+           SCRATCH : ATT1;
+      BEGIN
+           SCRATCH := P1;
+           P1 := P2;
+           P2 := SCRATCH;
+ 
+           P1.E2;  -- ENTRY2 SECOND OBJECT.
+           P2.E1;  -- VICE VERSA.
+ 
+      END PROC;
+ 
+      TASK BODY TT1 IS
+      BEGIN
+           ACCEPT E1 DO
+                PSPY_NUMB (1);
+           END E1;
+           ACCEPT E2 DO
+                PSPY_NUMB (2);
+           END E2;
+      END TT1;
+ 
+ BEGIN
+ 
+      TEST ("C92006A", "INTERCHANGING TASK OBJECTS");
+      POINTER_TT1_1 := NEW TT1;
+      POINTER_TT1_2 := NEW TT1;
+ 
+      POINTER_TT1_2.ALL.E1;
+      PROC (POINTER_TT1_1, POINTER_TT1_2);
+      POINTER_TT1_2.E2;        -- E2 OF FIRST OBJECT
+ -- EACH ENTRY OF EACH TASK OBJECT SHOULD HAVE BEEN CALLED.
+ 
+      IF SPYNUMB /= 1212 THEN
+           FAILED ("FAILURE TO SWAP TASK OBJECTS " &
+                   "IN PROCEDURE PROC");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C92006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c930001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c930001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c930001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c930001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- C930001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check when a dependent task and its master both
+ --      terminate as a result of a terminate alternative that
+ --      finalization is performed and that the finalization is
+ --      performed in the proper order.
+ --
+ -- TEST DESCRIPTION:
+ --      A controlled type with finalization is used to determine
+ --      the order in which finalization occurs.  The finalization
+ --      procedure records the identity of the object being
+ --      finalized.
+ --      Two tasks, one nested inside the other, both contain 
+ --      objects of the above finalization type.  These tasks
+ --      cooperatively terminate so the termination and finalization
+ --      order can be noted.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      08 Jan 96   SAIC    ACVC 2.1
+ --      09 May 96   SAIC    Addressed Reviewer comments.
+ --
+ --!
+ 
+ 
+ with Ada.Finalization;
+ package C930001_0 is
+     Verbose : constant Boolean := False;
+ 
+     type Ids is range 0..10;
+     Finalization_Order : array (Ids) of Ids := (Ids => 0);
+     Finalization_Cnt : Ids := 0;
+ 
+     protected Note is
+        -- serializes concurrent access to Finalization_* above
+        procedure Done (Id : Ids);
+     end Note;
+ 
+     -- Objects of the following type are used to note the order in
+     -- which finalization occurs.
+     type Has_Finalization is new Ada.Finalization.Limited_Controlled with
+           record
+              Id : Ids;
+           end record;
+     procedure Finalize (Object : in out Has_Finalization);
+ end C930001_0;
+ 
+ 
+ with Report;
+ package body C930001_0 is
+ 
+     protected body Note is
+         procedure Done (Id : Ids) is
+         begin
+             Finalization_Cnt := Finalization_Cnt + 1;
+             Finalization_Order (Finalization_Cnt) := Id;
+         end Done;
+     end Note;
+ 
+     procedure Finalize (Object : in out Has_Finalization) is
+     begin
+         Note.Done (Object.Id);
+         if Verbose then
+             Report.Comment ("in Finalize for" & Ids'Image (Object.Id));
+         end if;
+     end Finalize;
+ end C930001_0;
+ 
+ 
+ with Report;
+ with ImpDef;
+ with C930001_0;   use C930001_0;
+ procedure C930001 is
+ begin
+  
+     Report.Test ("C930001", "Check that dependent tasks are terminated" &
+                             " before the remaining finalization");
+ 
+     declare
+         task Level_1;
+         task body Level_1 is
+             V1a : C930001_0.Has_Finalization;        -------> 4
+             task Level_2 is
+                 entry Not_Taken;
+             end Level_2;
+             task body Level_2 is
+                 V2 : C930001_0.Has_Finalization;     -------> 2
+             begin
+                 V2.Id := 2;
+                 C930001_0.Note.Done (1);             -------> 1
+                 select
+                     accept Not_Taken;
+                 or
+                     terminate;
+                     -- cooperative termination at this point of
+                     -- both tasks
+                 end select;
+             end Level_2;
+ 
+             -- 7.6.1(11) requires that V1b be finalized before V1a
+             V1b : C930001_0.Has_Finalization;        -------> 3
+         begin
+             V1a.Id := 4;
+             V1b.Id := 3;
+         end Level_1;
+     begin  -- declare
+         while not Level_1'Terminated loop
+              delay ImpDef.Switch_To_New_Task;
+         end loop;
+         C930001_0.Note.Done (5);                     -------> 5
+         
+         -- now check the order
+         for I in Ids range 1..5 loop
+             if Verbose then
+                 Report.Comment (Ids'Image (I) & 
+                        Ids'Image (Finalization_Order (I)));
+             end if;
+             if Finalization_Order (I) /= I then
+                 Report.Failed ("Finalization occurred out of order" &
+                    " expected:" &
+                    Ids'Image (I) &
+                    " actual:" &
+                    Ids'Image (Finalization_Order (I)));
+             end if;
+         end loop;
+     end;
+ 
+     Report.Result;
+ end C930001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,296 ----
+ -- C93001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DECLARED TASK OBJECTS ARE NOT ACTIVATED BEFORE
+ --   THE END OF THE DECLARATIVE PART.
+ -- SUBTESTS ARE:
+ --   (A)  A SIMPLE TASK OBJECT, IN A BLOCK.
+ --   (B)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+ --   (C)  A RECORD OF TASK OBJECT, IN A PACKAGE SPECIFICATION.
+ --   (D)  A RECORD OF ARRAY OF TASK OBJECT, IN A PACKAGE BODY.
+ --   (E)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+ 
+ -- THIS TEST ASSUMES THAT ACTIVATION IS A SEQUENTIAL STEP
+ --   IN THE FLOW OF CONTROL OF THE PARENT (AS IS REQUIRED BY THE
+ --   ADA RM).  IF AN IMPLEMENTATION (ILLEGALLY) ACTIVATES A
+ --   TASK IN PARALLEL WITH ITS PARENT, THIS TEST
+ --   IS NOT GUARANTEED TO DETECT THE VIOLATION, DUE TO A
+ --   RACE CONDITION.
+ 
+ -- JRK 9/23/81
+ -- SPS 11/1/82
+ -- SPS 11/21/82
+ -- R.WILLIAMS 10/8/86  ADDED CHECKS ON INITIALIZATIONS OF NON-TASK
+ --                     COMPONENTS OF RECORD TYPES.
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93001A IS
+ 
+      GLOBAL : INTEGER;
+ 
+      FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           GLOBAL := IDENT_INT (I);
+           RETURN 0;
+      END SIDE_EFFECT;
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+           I : INTEGER := SIDE_EFFECT (1);
+      BEGIN
+           NULL;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C93001A", "CHECK THAT DECLARED TASK OBJECTS ARE NOT " &
+                       "ACTIVATED BEFORE THE END OF THE DECLARATIVE " &
+ 
+                       "PART");
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (A)
+ 
+           T : TT;
+           I : INTEGER := GLOBAL;
+ 
+      BEGIN -- (A)
+ 
+           IF I /= 0 THEN
+                FAILED ("A SIMPLE TASK OBJECT IN A BLOCK WAS " &
+                        "ACTIVATED TOO SOON - (A)");
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (B)
+ 
+           J : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                A : ARRAY (1..1) OF TT;
+                I : INTEGER := GLOBAL;
+           BEGIN
+                IF I /= 0 THEN
+                     FAILED ("AN ARRAY OF TASK OBJECT IN A FUNCTION " &
+                             "WAS ACTIVATED TOO SOON - (B)");
+                END IF;
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           J := F ;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C)
+ 
+           PACKAGE P IS
+ 
+                TYPE REC IS
+                     RECORD
+                          T  : TT;
+                          N1 : INTEGER := GLOBAL;
+                     END RECORD;
+ 
+                TYPE RT IS
+                     RECORD
+                          M : INTEGER := GLOBAL;
+                          T : TT;
+                          N : REC;
+                     END RECORD;
+                R : RT;
+                I : INTEGER := GLOBAL;
+           END P;
+ 
+           PACKAGE Q IS
+                J : INTEGER;
+           PRIVATE
+                TYPE RT IS
+                     RECORD
+                          N : P.REC;
+                          T : TT;
+                          M : INTEGER := GLOBAL;
+                     END RECORD;
+                R : RT;
+           END Q;
+ 
+           K : INTEGER := GLOBAL;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF R.M /= 0  OR R.N.N1 /= 0 THEN
+                     FAILED ( "NON-TASK COMPONENTS OF RECORD R NOT " &
+                              "INITIALIZED BEFORE TASKS ACTIVATED " &
+                              "- (C.1)" );
+                END IF;
+           END Q;
+ 
+      BEGIN -- (C)
+ 
+           IF P.R.M /= 0 OR P.R.N.N1 /= 0 THEN
+                FAILED ( "NON-TASK COMPONENTS OF RECORDS NOT " &
+                         "INITIALIZED BEFORE TASKS ACTIVATED " &
+                         "- (C.2)" );
+           END IF;
+ 
+           IF P.I /= 0 OR K /= 0 THEN
+                FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
+                        "SPECIFICATION WAS ACTIVATED TOO SOON - (C)");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (D)
+ 
+           PACKAGE P IS
+ 
+                TYPE GRADE IS (GOOD, FAIR, POOR);
+      
+                TYPE REC (G : GRADE) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TYPE ACCR IS ACCESS REC;
+                TYPE ACCI IS ACCESS INTEGER;
+ 
+                TYPE ARR IS ARRAY (1..1) OF TT;
+                TYPE RAT IS
+                     RECORD
+                          M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
+                          A : ARR;
+                          N : ACCI := NEW INTEGER'(GLOBAL);
+                     END RECORD;
+                RA1 : RAT;
+           PRIVATE
+                RA2 : RAT;
+           END P;
+ 
+           PACKAGE BODY P IS
+                RA3 : RAT;
+                I : INTEGER := GLOBAL;
+           BEGIN
+                IF RA1.M.G /= GOOD  OR RA1.N.ALL /= 0 THEN
+                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA1 NOT " &
+                              "INITIALIZED BEFORE TASKS ACTIVATED " &
+                              "- (D)" );
+                END IF;
+                
+                IF RA2.M.G /= GOOD  OR RA2.N.ALL /= 0 THEN
+                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA2 NOT " &
+                              "INITIALIZED BEFORE TASKS ACTIVATED " &
+                              "- (D)" );
+                END IF;
+                
+                IF RA3.M.G /= GOOD  OR RA3.N.ALL /= 0 THEN
+                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA3 NOT " &
+                              "INITIALIZED BEFORE TASKS ACTIVATED " &
+                              "- (D)" );
+                END IF;
+                
+                IF I /= 0 THEN
+                     FAILED ("A RECORD OF ARRAY OF TASK OBJECT IN A " &
+                             "PACKAGE SPEC OR BODY WAS ACTIVATED " &
+                             "TOO SOON - (D)");
+                END IF;
+           END P;
+ 
+      BEGIN -- (D)
+ 
+           NULL;
+ 
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (E)
+ 
+           TYPE REC IS
+                RECORD
+                     B : BOOLEAN := BOOLEAN'VAL (GLOBAL);
+                     T : TT;
+                     C :CHARACTER :=CHARACTER'VAL (GLOBAL);
+                END RECORD;
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+                TYPE RT IS
+                     RECORD
+                          M : REC;
+                          T : TT;
+                          N : REC;
+                     END RECORD;
+                AR : ARRAY (1..1) OF RT;
+                I : INTEGER := GLOBAL;
+           BEGIN
+                IF AR (1).M.B /= FALSE OR AR (1).M.C /= ASCII.NUL OR
+                   AR (1).N.B /= FALSE OR AR (1).N.C /= ASCII.NUL THEN
+                     FAILED ( "NON-TASK COMPONENTS OF RECORD RT NOT " &
+                              "INITIALIZED BEFORE TASKS ACTIVATED " &
+                              "- (E)" );
+                END IF;
+                
+                IF I /= 0 THEN
+                     FAILED ("AN ARRAY OF RECORD OF TASK OBJECT IN A " &
+                             "TASK BODY WAS ACTIVATED TOO SOON - (E)");
+                END IF;
+           END T;
+ 
+      BEGIN -- (E)
+ 
+           NULL;
+ 
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C93001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,231 ----
+ -- C93002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DECLARED TASK OBJECTS ARE ACTIVATED BEFORE EXECUTION
+ --   OF THE FIRST STATEMENT FOLLOWING THE DECLARATIVE PART.
+ -- SUBTESTS ARE:
+ --   (A)  A SIMPLE TASK OBJECT, IN A BLOCK.
+ --   (B)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+ --   (C)  A RECORD OF TASK OBJECT, IN A PACKAGE SPECIFICATION.
+ --   (D)  A RECORD OF ARRAY OF TASK OBJECT, IN A PACKAGE BODY.
+ --   (E)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+ 
+ -- JRK 9/28/81
+ -- SPS 11/1/82
+ -- SPS 11/21/82
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93002A IS
+ 
+      GLOBAL : INTEGER;
+ 
+      FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           GLOBAL := IDENT_INT (I);
+           RETURN 0;
+      END SIDE_EFFECT;
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+           I : INTEGER := SIDE_EFFECT (1);
+      BEGIN
+           NULL;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C93002A", "CHECK THAT DECLARED TASK OBJECTS ARE " &
+                       "ACTIVATED BEFORE EXECUTION OF THE FIRST " &
+                       "STATEMENT FOLLOWING THE DECLARATIVE PART");
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (A)
+ 
+           T : TT;
+ 
+      BEGIN -- (A)
+ 
+           IF GLOBAL /= 1 THEN
+                FAILED ("A SIMPLE TASK OBJECT IN A BLOCK WAS " &
+                        "ACTIVATED TOO LATE - (A)");
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (B)
+ 
+           J : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                A : ARRAY (1..1) OF TT;
+           BEGIN
+                IF GLOBAL /= 1 THEN
+                     FAILED ("AN ARRAY OF TASK OBJECT IN A FUNCTION " &
+                             "WAS ACTIVATED TOO LATE - (B)");
+                END IF;
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           J := F ;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C1)
+ 
+           PACKAGE P IS
+                TYPE ARR IS ARRAY (1..1) OF TT;
+                TYPE RT IS
+                     RECORD
+                          A : ARR;
+                     END RECORD;
+                R : RT;
+           END P;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                IF GLOBAL /= 1 THEN
+                     FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
+                             "SPECIFICATION WAS ACTIVATED TOO LATE " &
+                             "- (C1)");
+                END IF;
+           END P;
+ 
+      BEGIN -- (C1)
+ 
+           NULL;
+ 
+      END; -- (C1)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C2)
+ 
+           PACKAGE Q IS
+                J : INTEGER;
+           PRIVATE
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                R : RT;
+           END Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF GLOBAL /= 1 THEN
+                     FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
+                             "SPECIFICATION WAS ACTIVATED TOO LATE " &
+                             "- (C2)");
+                END IF;
+           END Q;
+ 
+      BEGIN -- (C2)
+ 
+           NULL;
+ 
+      END; -- (C2)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (D)
+ 
+           PACKAGE P IS
+                TYPE ARR IS ARRAY (1..1) OF TT;
+                TYPE RAT IS
+                     RECORD
+                          A : ARR;
+                     END RECORD;
+           END P;
+ 
+           PACKAGE BODY P IS
+                RA : RAT;
+           BEGIN
+                IF GLOBAL /= 1 THEN
+                     FAILED ("A RECORD OF ARRAY OF TASK OBJECT IN A " &
+                             "PACKAGE BODY WAS ACTIVATED " &
+                             "TOO LATE - (D)");
+                END IF;
+           END P;
+ 
+      BEGIN -- (D)
+ 
+           NULL;
+ 
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (E)
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                AR : ARRAY (1..1) OF RT;
+           BEGIN
+                IF GLOBAL /= 1 THEN
+                     FAILED ("AN ARRAY OF RECORD OF TASK OBJECT IN A " &
+                             "TASK BODY WAS ACTIVATED TOO LATE - (E)");
+                END IF;
+           END T;
+ 
+      BEGIN -- (E)
+ 
+           NULL;
+ 
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C93002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,351 ----
+ -- C93003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ACTIVATION OF TASKS CREATED BY ALLOCATORS PRESENT IN A
+ --   DECLARATIVE PART TAKES PLACE DURING ELABORATION OF THE
+ --   CORRESPONDING DECLARATION.
+ -- SUBTESTS ARE:
+ --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+ --   (B)  AN ARRAY OF TASK ALLOCATOR, IN A FUNCTION.
+ --   (C)  A RECORD OF TASK ALLOCATOR, IN A PACKAGE SPECIFICATION.
+ --   (D)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY.
+ --   (E)  AN ARRAY OF RECORD OF TASK ALLOCATOR, IN A TASK BODY.
+ 
+ -- JRK 9/28/81
+ -- SPS 11/11/82
+ -- SPS 11/21/82
+ -- RJW 8/4/86    ADDED CHECKS ON INITIALIZATIONS OF NON-TASK COMPONENTS
+ --               OF RECORD TYPES.
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93003A IS
+ 
+      GLOBAL : INTEGER;
+ 
+      FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           GLOBAL := IDENT_INT (I);
+           RETURN 0;
+      END SIDE_EFFECT;
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+           I : INTEGER := SIDE_EFFECT (1);
+      BEGIN
+           NULL;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C93003A", "CHECK THAT ACTIVATION OF TASKS CREATED BY " &
+                       "ALLOCATORS PRESENT IN A DECLARATIVE PART " &
+                       "TAKES PLACE DURING ELABORATION OF THE " &
+                       "CORRESPONDING DECLARATION");
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (A)
+ 
+           TYPE A IS ACCESS TT;
+           T1 : A := NEW TT;
+           I1 : INTEGER := GLOBAL;
+           J  : INTEGER := SIDE_EFFECT (0);
+           T2 : A := NEW TT;
+           I2 : INTEGER := GLOBAL;
+ 
+      BEGIN -- (A)
+ 
+           IF I1 /= 1 OR I2 /= 1 THEN
+                FAILED ("A SIMPLE TASK ALLOCATOR IN A BLOCK WAS " &
+                        "ACTIVATED TOO LATE - (A)");
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (B)
+ 
+           J : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+ 
+                TYPE A_T IS ARRAY (1 .. 1) OF TT;
+                TYPE A IS ACCESS A_T;
+                A1 : A := NEW A_T;
+                I1 : INTEGER := GLOBAL;
+                J  : INTEGER := SIDE_EFFECT (0);
+                A2 : A := NEW A_T;
+                I2 : INTEGER := GLOBAL;
+ 
+           BEGIN
+                IF I1 /= 1 OR I2 /= 1 THEN
+                     FAILED ("AN ARRAY OF TASK ALLOCATOR IN A " &
+                             "FUNCTION WAS ACTIVATED TOO LATE - (B)");
+                END IF;
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           J := F ;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C1)
+ 
+           PACKAGE P IS
+ 
+                TYPE INTREC IS
+                     RECORD
+                          N1 : INTEGER := GLOBAL;
+                     END RECORD;
+ 
+                TYPE RT IS
+                     RECORD
+                          M : INTEGER := GLOBAL;
+                          T : TT;
+                          N : INTREC;
+                     END RECORD;
+ 
+                TYPE A IS ACCESS RT;
+ 
+                R1 : A := NEW RT;
+                I1 : INTEGER := GLOBAL;
+                J  : INTEGER := SIDE_EFFECT (0);
+                R2 : A := NEW RT;
+                I2 : INTEGER := GLOBAL;
+ 
+           END P;
+ 
+      BEGIN -- (C1)
+ 
+           IF P.R1.M /= 0 OR P.R1.N.N1 /= 0 THEN 
+                FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
+                        "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
+           END IF;
+ 
+           IF P.R2.M /= 0 OR P.R2.N.N1 /= 0 THEN 
+                FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
+                        "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
+           END IF;
+ 
+           IF P.I1 /= 1 OR P.I2 /= 1 THEN
+                FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
+                        "SPECIFICATION WAS ACTIVATED TOO LATE - (C1)");
+           END IF;
+ 
+      END; -- (C1)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C2)
+ 
+           PACKAGE Q IS
+                J1 : INTEGER;
+           PRIVATE
+                
+                TYPE GRADE IS (GOOD, FAIR, POOR);
+      
+                TYPE REC (G : GRADE) IS
+                     RECORD
+                          NULL;
+                     END RECORD;
+ 
+                TYPE ACCR IS ACCESS REC;
+ 
+                TYPE ACCI IS ACCESS INTEGER;
+ 
+                TYPE RT IS
+                     RECORD
+                          M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
+                          T : TT;
+                          N : ACCI := NEW INTEGER'(GLOBAL);
+                     END RECORD;
+ 
+                TYPE A IS ACCESS RT;
+ 
+                R1 : A := NEW RT;
+                I1 : INTEGER := GLOBAL;
+                J2 : INTEGER := SIDE_EFFECT (0);
+                R2 : A := NEW RT;
+                I2 : INTEGER := GLOBAL;
+ 
+           END Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                IF R1.M.G /= GOOD OR R1.N.ALL /= 0 THEN 
+                     FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
+                             "INITIALIZED BEFORE TASK ACTIVATED " &
+                             "- (C2)" );
+                END IF;
+ 
+                IF R2.M.G /= GOOD OR R2.N.ALL /= 0 THEN 
+                     FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
+                             "INITIALIZED BEFORE TASK ACTIVATED " &
+                             "- (C2)" );
+                END IF;
+ 
+                IF I1 /= 1 OR I2 /= 1 THEN
+                     FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
+                             "SPECIFICATION WAS ACTIVATED TOO LATE " &
+                             "- (C2)");
+                END IF;
+           END Q;
+ 
+      BEGIN -- (C2)
+ 
+           NULL;
+ 
+      END; -- (C2)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (D)
+ 
+           PACKAGE P IS
+ 
+                TYPE ARR IS ARRAY (1 .. 1) OF TT;
+                TYPE INTARR IS ARRAY (1 .. 1) OF INTEGER;
+ 
+                TYPE RAT IS
+                     RECORD
+                          M : INTARR := (1 => GLOBAL);
+                          A : ARR;
+                          N : INTARR := (1 => GLOBAL);
+                     END RECORD;
+           END P;
+ 
+           PACKAGE BODY P IS
+ 
+                TYPE A IS ACCESS RAT;
+ 
+                RA1 : A := NEW RAT;
+                I1  : INTEGER := GLOBAL;
+                J   : INTEGER := SIDE_EFFECT (0);
+                RA2 : A := NEW RAT;
+                I2  : INTEGER := GLOBAL;
+ 
+           BEGIN
+                IF RA1.M (1) /= 0 OR RA1.N (1) /= 0 THEN 
+                     FAILED ("NON-TASK COMPONENTS OF RECORD RA1 NOT " &
+                             "INITIALIZED BEFORE TASK ACTIVATED " &
+                             "- (D)" );
+                END IF;
+ 
+                IF RA2.M (1) /= 0 OR RA2.N (1) /= 0 THEN 
+                     FAILED ("NON-TASK COMPONENTS OF RECORD RA2 NOT " &
+                             "INITIALIZED BEFORE TASK ACTIVATED " &
+                             "- (D)" );
+                END IF;
+ 
+                IF I1 /= 1 OR I2 /= 1 THEN
+                     FAILED ("A RECORD OF ARRAY OF TASK ALLOCATOR IN " &
+                             "A PACKAGE BODY WAS ACTIVATED " &
+                             "TOO LATE - (D)");
+                END IF;
+           END P;
+ 
+      BEGIN -- (D)
+ 
+           NULL;
+ 
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (E)
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+                TYPE RT IS
+                     RECORD
+                          M : BOOLEAN := BOOLEAN'VAL (GLOBAL);
+                          T : TT;
+                          N : CHARACTER := CHARACTER'VAL (GLOBAL);
+                     END RECORD;
+ 
+                TYPE ART IS ARRAY (1 .. 1) OF RT;
+                TYPE A IS ACCESS ART;
+ 
+                AR1 : A := NEW ART;
+                I1  : INTEGER := GLOBAL;
+                J   : INTEGER := SIDE_EFFECT (0);
+                AR2 : A := NEW ART;
+                I2  : INTEGER := GLOBAL;
+ 
+           BEGIN
+                IF AR1.ALL (1).M /= FALSE     OR 
+                   AR1.ALL (1).N /= ASCII.NUL THEN 
+                     FAILED ("NON-TASK COMPONENTS OF RECORD AR1 NOT " &
+                             "INITIALIZED BEFORE TASK ACTIVATED " &
+                             "- (E)" );
+                END IF;
+ 
+                IF AR2.ALL (1).M /= FALSE     OR 
+                   AR2.ALL (1).N /= ASCII.NUL THEN 
+                     FAILED ("NON-TASK COMPONENTS OF RECORD AR2 NOT " &
+                             "INITIALIZED BEFORE TASK ACTIVATED " &
+                             "- (E)" );
+                END IF;
+ 
+                IF I1 /= 1 OR I2 /= 1 THEN
+                     FAILED ("AN ARRAY OF RECORD OF TASK ALLOCATOR IN " &
+                             "A TASK BODY WAS ACTIVATED TOO LATE - (E)");
+                END IF;
+           END T;
+ 
+      BEGIN -- (E)
+ 
+           NULL;
+ 
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C93003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- C93004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK BECOMES COMPLETED WHEN AN EXCEPTION OCCURS DURING
+ -- ITS ACTIVATION.
+ 
+ -- WEI  3/ 4/82
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C93004A IS
+ BEGIN
+ 
+      TEST ("C93004A", "TASK COMPLETION CAUSED BY EXCEPTION");
+ 
+ BLOCK:
+      DECLARE
+           TYPE I0 IS RANGE 0..1;
+ 
+           TASK T1 IS
+                ENTRY BYE;
+           END T1;
+ 
+           TASK BODY T1 IS
+                SUBTYPE I1 IS I0 RANGE 0 .. 2;     -- CONSTRAINT ERROR.
+           BEGIN
+                ACCEPT BYE;
+           END T1;
+      BEGIN
+           FAILED ("NO EXCEPTION RAISED");
+           IF NOT T1'TERMINATED THEN 
+                FAILED ("TASK NOT TERMINATED");
+                T1.BYE;
+           END IF;
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                NULL;
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED");
+      END BLOCK;
+ 
+      RESULT;
+ 
+ END C93004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- C93004B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+ -- TASK, OTHER TASKS ARE UNAFFECTED.
+ 
+ -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+ 
+ -- CHECK THAT TASKS WAITING ON ENTRIES OF SUCH TASKS RECEIVE
+ -- TASKING_ERROR
+ 
+ -- JEAN-PIERRE ROSEN 09-MAR-1984
+ -- JBG 06/01/84
+ -- JBG 05/23/85
+ -- EG  10/29/85 ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93004B IS
+ 
+ BEGIN
+      TEST("C93004B", "EXCEPTIONS DURING ACTIVATION");
+ 
+      DECLARE
+ 
+           TASK TYPE T1 IS
+           END T1;
+ 
+           TASK TYPE T2 IS
+                ENTRY E;
+           END T2;
+ 
+           ARR_T2: ARRAY(INTEGER RANGE 1..1) OF T2;
+ 
+           TYPE AT1 IS ACCESS T1;
+ 
+           PACKAGE START_T1 IS  -- THIS PACKAGE TO AVOID ACCESS BEFORE
+           END START_T1;        -- ELABORATION ON T1.
+ 
+           TASK BODY T1 IS
+           BEGIN
+                DECLARE    -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
+                     TASK T1BIS IS
+                     END T1BIS;
+ 
+                     TASK BODY T1BIS IS
+                     BEGIN
+                          ARR_T2(IDENT_INT(1)).E;
+                          FAILED ("RENDEZVOUS COMPLETED - T1BIS");
+                     EXCEPTION
+                          WHEN TASKING_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("ABNORMAL EXCEPTION - T1BIS");
+                     END T1BIS;
+                BEGIN
+                     NULL;
+                END;
+ 
+                ARR_T2(IDENT_INT(1)).E;  -- ARR_T2(1) IS NOW TERMINATED.
+ 
+                FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+ 
+           EXCEPTION
+                WHEN TASKING_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("ABNORMAL EXCEPTION - T1");
+           END;
+ 
+           PACKAGE BODY START_T1 IS
+                V_AT1 : AT1 := NEW T1;
+           END START_T1;
+ 
+           TASK BODY T2 IS
+                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+           BEGIN
+                IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                     FAILED("T2 ACTIVATED OK");
+                END IF;
+           END T2;
+ 
+           TASK T3 IS
+                ENTRY E;
+           END T3;
+ 
+           TASK BODY T3 IS
+           BEGIN     -- T3 MUST BE ACTIVATED OK.
+                ACCEPT E;
+           END T3;
+ 
+      BEGIN
+           FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
+           T3.E;          -- CLEAN UP.
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                BEGIN
+                     T3.E;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          FAILED ("T3 NOT ACTIVATED");
+                END;
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
+           WHEN OTHERS =>
+                FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
+      END;
+ 
+      RESULT;
+ END C93004B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C93004C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+ -- TASK, OTHER TASKS ARE UNAFFECTED.
+ 
+ -- IF SEVERAL TASKS FAIL THEIR ACTIVATION, ONLY ONE TASKING_ERROR IS
+ -- RAISED.
+ 
+ -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+ 
+ -- CHECK THAT TASKS WAITING ON ENTRIES OF SUCH TASKS RECEIVE
+ -- TASKING_ERROR
+ 
+ -- JEAN-PIERRE ROSEN 09-MAR-1984
+ -- JBG 06/01/84
+ -- JBG 05/23/85
+ -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93004C IS
+ 
+ BEGIN
+      TEST("C93004C", "EXCEPTIONS DURING ACTIVATION");
+ 
+      DECLARE
+ 
+           TASK TYPE T1 IS
+           END T1;
+ 
+           TASK TYPE T2 IS
+                ENTRY E;
+           END T2;
+ 
+           ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2;
+ 
+           TYPE AT1 IS ACCESS T1;
+ 
+           PACKAGE START_T1 IS      -- THIS PACKAGE TO AVOID ACCESS
+           END START_T1;            -- BEFORE ELABORATION ON T1.
+ 
+           TASK BODY T1 IS
+           BEGIN
+                DECLARE   -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
+                     TASK T1BIS IS
+                     END T1BIS;
+ 
+                     TASK BODY T1BIS IS
+                     BEGIN
+                          ARR_T2(IDENT_INT(2)).E;
+                          FAILED ("RENDEZVOUS COMPLETED - T3");
+                     EXCEPTION
+                          WHEN TASKING_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("ABNORMAL EXCEPTION - T3");
+                     END T1BIS;
+                BEGIN
+                     NULL;
+                END;
+ 
+                ARR_T2(IDENT_INT(2)).E;   -- ARR_T2(2) IS NOW TERMINATED.
+ 
+                FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+ 
+           EXCEPTION
+                WHEN TASKING_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("ABNORMAL EXCEPTION - T1");
+           END;
+ 
+           PACKAGE BODY START_T1 IS
+                V_AT1 : AT1 := NEW T1;
+           END START_T1;
+ 
+           TASK BODY T2 IS
+                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+           BEGIN
+                IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                     FAILED("T2 ACTIVATED OK");
+                END IF;
+           END T2;
+ 
+           TASK T3 IS
+                ENTRY E;
+           END T3;
+ 
+           TASK BODY T3 IS
+           BEGIN     -- T3 MUST BE ACTIVATED OK.
+                ACCEPT E;
+           END T3;
+ 
+      BEGIN
+           FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
+           T3.E;          -- CLEAN UP.
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                BEGIN
+                     T3.E;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          FAILED ("T3 NOT ACTIVATED");
+                END;
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
+           WHEN OTHERS =>
+                FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
+      END;
+ 
+      RESULT;
+ 
+ END C93004C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C93004D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+ -- TASK, OTHER TASKS ARE UNAFFECTED.
+ 
+ -- THIS TEST CHECKS THE CASE IN WHICH SOME OF THE OTHER TASKS ARE 
+ -- PERHAPS ACTIVATED BEFORE THE EXCEPTION OCCURS AND SOME TASKS ARE 
+ -- PERHAPS ACTIVATED AFTER.
+ 
+ -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+ 
+ -- CHECK THAT TASKS WAITING FOR ENTRIES OF SUCH TASKS RECEIVE
+ -- TASKING_ERROR.
+ 
+ -- R. WILLIAMS 8/6/86
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C93004D IS
+ 
+           
+ BEGIN
+      TEST ( "C93004D", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
+                        "DURING ACTIVATION OF A TASK, OTHER TASKS " &
+                        "ARE NOT AFFECTED. IN THIS TEST, SOME OF THE " &
+                        "TASKS ARE PERHAPS ACTIVATED BEFORE THE " &
+                        "EXCEPTION OCCURS AND SOME PERHAPS AFTER" );
+ 
+ 
+      DECLARE
+ 
+           TASK T0 IS
+                ENTRY E;
+           END T0;
+ 
+           TASK TYPE T1 IS
+           END T1;
+ 
+           TASK TYPE T2 IS
+                ENTRY E;
+           END T2;     
+ 
+           ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2;
+ 
+           TYPE AT1 IS ACCESS T1;
+ 
+           TASK BODY T0 IS
+           BEGIN
+                ACCEPT E;
+           END T0;
+ 
+           PACKAGE START_T1 IS      -- THIS PACKAGE TO AVOID ACCESS
+           END START_T1;            -- BEFORE ELABORATION ON T1.
+ 
+           TASK BODY T1 IS
+           BEGIN
+                DECLARE   -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
+                     TASK T1BIS IS
+                     END T1BIS;
+ 
+                     TASK BODY T1BIS IS
+                     BEGIN
+                          ARR_T2(IDENT_INT(2)).E;
+                          FAILED ("RENDEZVOUS COMPLETED - T3");
+                     EXCEPTION
+                          WHEN TASKING_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("ABNORMAL EXCEPTION - T3");
+                     END T1BIS;
+                BEGIN
+                     NULL;
+                END;
+ 
+                ARR_T2(IDENT_INT(2)).E;   -- ARR_T2(2) IS NOW 
+                                          -- TERMINATED.
+ 
+                FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+ 
+           EXCEPTION
+                WHEN TASKING_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("ABNORMAL EXCEPTION - T1");
+           END;
+ 
+           PACKAGE BODY START_T1 IS
+                V_AT1 : AT1 := NEW T1;
+           END START_T1;
+ 
+           TASK BODY T2 IS
+                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+           BEGIN
+                IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                     FAILED("T2 ACTIVATED OK");
+                END IF;
+           END T2;
+ 
+           TASK T3 IS
+                ENTRY E;
+           END T3;
+ 
+           TASK BODY T3 IS
+           BEGIN     -- T3 MUST BE ACTIVATED OK.
+                ACCEPT E;
+           END T3;
+ 
+      BEGIN -- T0, ARR_T2 (1 .. 4), T3 ACTIVATED HERE.
+ 
+           FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
+           T3.E;          -- CLEAN UP.
+           T0.E;
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                BEGIN
+                     T3.E;
+                     T0.E;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          FAILED ("T0 OR T3 NOT ACTIVATED");
+                END;
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
+           WHEN OTHERS =>
+                FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
+      END;
+ 
+      RESULT;
+ END C93004D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93004f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93004f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- C93004F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+ -- TASK, OTHER TASKS ARE UNAFFECTED.
+ 
+ -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+ 
+ -- THIS TESTS CHECKS THE CASE IN WHICH THE TASKS ARE CREATED BY THE
+ -- ALLOCATION OF A RECORD OF TASKS OR AN ARRAY OF TASKS.
+ 
+ -- R. WILLIAMS 8/7/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C93004F IS
+ 
+ BEGIN
+      TEST ( "C93004F", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
+                        "DURING THE ACTIVATION OF A TASK, OTHER " &
+                        "TASKS ARE UNAFFECTED. IN THIS TEST, THE " &
+                        "TASKS ARE CREATED BY THE ALLOCATION OF A " &
+                        "RECORD OR AN ARRAY OF TASKS" );
+ 
+      DECLARE
+ 
+           TASK TYPE T IS 
+                ENTRY E;
+           END T;
+ 
+           TASK TYPE TT;
+ 
+           TASK TYPE TX IS 
+                ENTRY E;
+           END TX;
+ 
+           TYPE REC IS
+                RECORD
+                     TR : T;
+                END RECORD;
+ 
+           TYPE ARR IS ARRAY (IDENT_INT (1) .. IDENT_INT (1)) OF T;
+ 
+           TYPE RECX IS
+                RECORD 
+                     TTX1 : TX;
+                     TTT  : TT;
+                     TTX2 : TX;
+                END RECORD;
+ 
+           TYPE ACCR IS ACCESS REC;
+           AR : ACCR;
+ 
+           TYPE ACCA IS ACCESS ARR;
+           AA : ACCA;
+                
+           TYPE ACCX IS ACCESS RECX;
+           AX : ACCX;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E;
+           END T;
+ 
+           TASK BODY TT IS
+           BEGIN
+                AR.TR.E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "TASK AR.TR NOT ACTIVE" );
+           END TT;
+ 
+           TASK BODY TX IS
+                I : POSITIVE := IDENT_INT (0); -- RAISE 
+                                               -- CONSTRAINT_ERROR.
+           BEGIN
+                IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
+                     FAILED ( "TX ACTIVATED OK" );
+                END IF;
+           END TX;
+ 
+      BEGIN
+           AR := NEW REC;
+           AA := NEW ARR;
+           AX := NEW RECX;
+ 
+           FAILED ( "TASKING_ERROR NOT RAISED IN MAIN" );
+           
+           AA.ALL (1).E;        -- CLEAN UP.
+ 
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+ 
+                BEGIN
+                     AA.ALL (1).E;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          FAILED ( "AA.ALL (1) NOT ACTIVATED" );
+                END;
+ 
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ( "CONSTRAINT_ERROR RAISED IN MAIN" );
+           WHEN OTHERS =>
+                FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
+      END;
+ 
+      RESULT;
+ 
+ END C93004F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- C93005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN AN EXCEPTION IS RAISED IN A DECLARATIVE PART, A TASK
+ -- DECLARED IN THE SAME DECLARATIVE PART BECOMES TERMINATED.
+ 
+ -- CHECK THAT A TASK WAITING ON ENTRIES OF SUCH A
+ -- TERMINATED-BEFORE-ACTIVATION TASK RECEIVES TASKING_ERROR.
+ 
+ -- JEAN-PIERRE ROSEN 3/9/84
+ -- JBG 06/01/84
+ -- JBG 05/23/85
+ -- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93005A IS
+ 
+ BEGIN
+      TEST("C93005A", "EXCEPTIONS RAISED IN A DECLARATIVE PART " &
+                      "CONTAINING TASKS");
+ 
+      BEGIN
+ 
+           DECLARE
+                TASK TYPE T1 IS     -- CHECKS THAT T2 TERMINATES.
+                END T1;
+ 
+                TYPE AT1 IS ACCESS T1;
+ 
+                TASK T2 IS          -- WILL NEVER BE ACTIVATED.
+                     ENTRY E;
+                END T2;
+ 
+                PACKAGE RAISE_IT IS
+                END RAISE_IT;
+ 
+                TASK BODY T2 IS
+                BEGIN
+                     FAILED ("T2 ACTIVATED");
+                     -- IN CASE OF FAILURE
+                     LOOP
+                          SELECT
+                               ACCEPT E;
+                          OR
+                               TERMINATE;
+                          END SELECT;
+                     END LOOP;
+                END T2;
+ 
+                TASK BODY T1 IS
+                BEGIN
+                     DECLARE  -- THIS BLOCK TO CHECK THAT T3 TERMINATES.
+                          TASK T3 IS
+                          END T3;
+ 
+                          TASK BODY T3 IS
+                          BEGIN
+                               T2.E;
+                               FAILED ("RENDEZVOUS COMPLETED WITHOUT " &
+                                       "ERROR - T3");
+                          EXCEPTION
+                               WHEN TASKING_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED("ABNORMAL EXCEPTION - T3");
+                          END T3;
+                     BEGIN
+                          NULL;
+                     END;
+ 
+                     T2.E;    --T2 IS NOW TERMINATED
+ 
+                     FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+ 
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("ABNORMAL EXCEPTION - T1");
+                END;
+ 
+                PACKAGE BODY RAISE_IT IS
+                     PT1 : AT1 := NEW T1;
+                     I   : POSITIVE := IDENT_INT(0); -- RAISE
+                                                     -- CONSTRAINT_ERROR.
+                BEGIN
+                     IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                          FAILED ("PACKAGE DIDN'T RAISE EXCEPTION");
+                     END IF;
+                END RAISE_IT;
+ 
+           BEGIN     -- CAN'T LEAVE BLOCK UNTIL T1, T2, AND T3 ARE TERM.
+                FAILED ("EXCEPTION NOT RAISED");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR IN MAIN PROGRAM");
+           WHEN OTHERS =>
+                FAILED ("ABNORMAL EXCEPTION IN MAIN-1");
+      END;
+ 
+      RESULT;
+ 
+ END C93005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,273 ----
+ -- C93005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN AN EXCEPTION IS RAISED IN A DECLARATIVE PART, A TASK
+ -- DECLARED IN THE SAME DECLARATIVE PART BECOMES TERMINATED.
+ 
+ -- CHECK THAT A TASK WAITING ON ENTRIES OF SUCH A
+ -- TERMINATED-BEFORE-ACTIVATION TASK RECEIVES TASKING_ERROR.
+ 
+ -- THIS TEST CHECKS THE CASE IN WHICH SEVERAL TASKS ARE WAITING FOR
+ -- ACTIVATION WHEN THE EXCEPTION OCCURS.
+ 
+ -- R. WILLIAMS 8/7/86
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C93005B IS
+ 
+ 
+ BEGIN
+      TEST ( "C93005B", "CHECK THAT WHEN AN EXCEPTION IS RAISED IN A " &
+                        "DECLARATIVE PART, A TASK DECLARED IN THE " &
+                        "SAME DECLARATIVE PART BECOMES TERMINATED. " &
+                        "IN THIS CASE, SEVERAL TASKS ARE WAITING FOR " &
+                        "ACTIVATION WHEN THE EXCEPTION OCCURS" );
+  
+      BEGIN
+  
+           DECLARE
+                TASK TYPE TA IS      -- CHECKS THAT TX TERMINATES.
+                END TA;
+   
+                TYPE ATA IS ACCESS TA;
+  
+                TASK TYPE TB IS      -- CHECKS THAT TY TERMINATES.
+                END TB;
+                  
+                TYPE TBREC IS
+                     RECORD
+                          TTB: TB;
+                     END RECORD;
+   
+                TASK TX IS          -- WILL NEVER BE ACTIVATED.
+                     ENTRY E;
+                END TX;
+ 
+                TASK BODY TA IS
+                BEGIN
+                     DECLARE  -- THIS BLOCK TO CHECK THAT TAB 
+                              -- TERMINATES.
+                          TASK TAB IS
+                          END TAB;
+ 
+                          TASK BODY TAB IS
+                          BEGIN
+                               TX.E;
+                               FAILED ( "RENDEZVOUS COMPLETED " &
+                                        "WITHOUT ERROR - TAB" );
+                          EXCEPTION
+                               WHEN TASKING_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "ABNORMAL EXCEPTION " &
+                                             "- TAB" );
+                          END TAB;
+                     BEGIN
+                          NULL;
+                     END;
+   
+                     TX.E;    --TX IS NOW TERMINATED.
+  
+                     FAILED ( "RENDEZVOUS COMPLETED WITHOUT ERROR " &
+                              "- TA" );
+   
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "ABNORMAL EXCEPTION - TA" );
+                END TA;
+  
+                PACKAGE RAISE_IT IS 
+                     TASK TY IS             -- WILL NEVER BE ACTIVATED.
+                          ENTRY E;
+                     END TY;                                         
+                END RAISE_IT;
+  
+                TASK BODY TB IS
+                BEGIN
+                     DECLARE  -- THIS BLOCK TO CHECK THAT TBB 
+                              -- TERMINATES.
+                          TASK TBB IS
+                          END TBB;
+  
+                          TASK BODY TBB IS
+                          BEGIN
+                               RAISE_IT.TY.E;
+                               FAILED ( "RENDEZVOUS COMPLETED " &
+                                        "WITHOUT ERROR - TBB" );
+                          EXCEPTION
+                               WHEN TASKING_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "ABNORMAL EXCEPTION " &
+                                             "- TBB" );
+                          END TBB;
+                     BEGIN
+                          NULL;
+                     END;
+ 
+                     RAISE_IT.TY.E;    -- TY IS NOW TERMINATED.
+ 
+                     FAILED ( "RENDEZVOUS COMPLETED WITHOUT ERROR " &
+                              "- TB" );
+ 
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "ABNORMAL EXCEPTION - TB" );
+                END TB;
+ 
+                PACKAGE START_TC IS END START_TC;
+ 
+                TASK BODY TX IS
+                BEGIN
+                     FAILED ( "TX ACTIVATED" );
+                     -- IN CASE OF FAILURE.
+                     LOOP
+                          SELECT
+                               ACCEPT E;
+                          OR
+                               TERMINATE;
+                          END SELECT;
+                     END LOOP;
+                END TX;
+ 
+                PACKAGE START_TZ IS
+                     TASK TZ IS             -- WILL NEVER BE ACTIVATED.
+                          ENTRY E;
+                     END TZ;
+                END START_TZ;
+ 
+                PACKAGE BODY START_TC IS
+                     TBREC1 : TBREC;     -- CHECKS THAT TY TERMINATES.
+ 
+                     TASK TC IS -- CHECKS THAT TZ TERMINATES.
+                     END TC;
+                 
+                     TASK BODY TC IS
+                     BEGIN
+                          DECLARE  -- THIS BLOCK TO CHECK THAT TCB 
+                                   -- TERMINATES.
+  
+                               TASK TCB IS
+                               END TCB;
+           
+                               TASK BODY TCB IS
+                               BEGIN
+                                    START_TZ.TZ.E;
+                                    FAILED ( "RENDEZVOUS COMPLETED " &
+                                             "WITHOUT " &
+                                             "ERROR - TCB" );
+                               EXCEPTION
+                                    WHEN TASKING_ERROR =>
+                                         NULL;
+                                    WHEN OTHERS =>
+                                         FAILED ( "ABNORMAL " &
+                                                  "EXCEPTION - TCB" );
+                               END TCB;
+                          BEGIN
+                               NULL;
+                          END;
+ 
+                          START_TZ.TZ.E;    -- TZ IS NOW TERMINATED.
+       
+                          FAILED ( "RENDEZVOUS COMPLETED WITHOUT " &
+                                   "ERROR - TC" );
+       
+                     EXCEPTION
+                          WHEN TASKING_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED ( "ABNORMAL EXCEPTION - TC" );
+                     END TC;
+                END START_TC;     -- TBREC1 AND TC ACTIVATED HERE.
+                      
+                PACKAGE BODY RAISE_IT IS
+                     NTA : ATA := NEW TA;  -- NTA.ALL ACTIVATED HERE.
+  
+                     TASK BODY TY IS
+                     BEGIN
+                          FAILED ( "TY ACTIVATED" );
+                          -- IN CASE OF FAILURE.
+                          LOOP
+                               SELECT
+                                    ACCEPT E;
+                               OR
+                                    TERMINATE;
+                               END SELECT;
+                          END LOOP;
+                     END TY;
+  
+                     PACKAGE XCEPTION IS
+                          I : POSITIVE := IDENT_INT (0); -- RAISE
+                                                    -- CONSTRAINT_ERROR.
+                     END XCEPTION;
+                 
+                     USE XCEPTION;
+  
+                BEGIN   -- TY WOULD BE ACTIVATED HERE.
+ 
+                     IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
+                          FAILED ( "PACKAGE DIDN'T RAISE EXCEPTION" );
+                     END IF;
+                END RAISE_IT;
+  
+                PACKAGE BODY START_TZ IS
+                     TASK BODY TZ IS
+                     BEGIN
+                          FAILED ( "TZ ACTIVATED" );
+                          -- IN CASE OF FAILURE.
+                          LOOP
+                               SELECT
+                                    ACCEPT E;
+                               OR
+                                    TERMINATE;
+                               END SELECT;
+                          END LOOP;
+                     END TZ;
+                END START_TZ;    -- TZ WOULD BE ACTIVATED HERE.
+  
+           BEGIN     -- TX WOULD BE ACTIVATED HERE.
+                     -- CAN'T LEAVE BLOCK UNTIL TA, TB, AND TC ARE TERM.
+ 
+                FAILED ( "EXCEPTION NOT RAISED" );
+           END;
+  
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN TASKING_ERROR =>
+                FAILED ( "TASKING_ERROR IN MAIN PROGRAM" );
+           WHEN OTHERS =>
+                FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
+      END;
+  
+      RESULT;
+  
+ END C93005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,250 ----
+ -- C93005C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+ -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+ -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+ -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+ 
+ -- CASE 1: TASKS IN DECLARATIVE PART OF A BLOCK AND PACKAGE
+ -- SPECIFICATION.  THE TASKS DEPEND ON THE DECLARATIVE PART.
+ 
+ -- RAC 19-MAR-1985
+ -- JBG 06/03/85
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PRAGMA ELABORATE (REPORT);
+ 
+ with Impdef;
+ 
+ PACKAGE C93005C_PK1 IS
+ 
+      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+      TASK TYPE UNACTIVATED IS
+           ENTRY E;
+      END UNACTIVATED;
+ 
+      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+ 
+      -- *******************************************
+      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+      --
+      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+      -- DECREMENT).
+ 
+      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+      -- BY ANYONE BUT THEMSELVES.
+      --
+      TASK TYPE MNT_TASK IS
+      END MNT_TASK;
+ 
+      FUNCTION F RETURN INTEGER;
+ 
+      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+      -- COUNT.
+      --
+      TYPE MNT IS
+           RECORD
+                DUMMY : INTEGER :=  F;
+                T     : MNT_TASK;
+           END RECORD;
+ 
+      PROCEDURE CHECK;
+ 
+ 
+      -- *******************************************
+      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+ 
+ END C93005C_PK1;
+ 
+ 
+ PACKAGE BODY C93005C_PK1 IS
+ 
+ -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+ -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+ 
+      TASK T IS
+           ENTRY E;
+      END;
+ 
+      -- ***********************************************
+      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+ -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+ -- ARE STILL ACTIVE.
+ 
+      MNT_COUNT : INTEGER := 0;
+ 
+ -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+ 
+      TASK MNT_COUNTER IS
+           ENTRY INCR;
+           ENTRY DECR;
+      END MNT_COUNTER;
+ 
+ -- SYNCHRONIZING TASK
+ 
+      TASK BODY MNT_COUNTER IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT INCR DO
+                          MNT_COUNT := MNT_COUNT +1;
+                     END INCR;
+ 
+                OR  ACCEPT DECR DO
+                          MNT_COUNT := MNT_COUNT -1;
+                     END DECR;
+ 
+                OR  TERMINATE;
+ 
+                END SELECT;
+           END LOOP;
+      END MNT_COUNTER;
+ 
+ -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+ --
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           MNT_COUNTER.INCR;
+           RETURN 0;
+      END F;
+ 
+ -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+ -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+ -- ITSELF IS NOT TERMINATED.
+ --
+      PROCEDURE CHECK IS
+      BEGIN
+           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                        "TERMINATED");
+           END IF;
+ -- RESET THE COUNT FOR THE NEXT SUBTEST:
+           MNT_COUNT := 0;
+      END CHECK;
+ 
+ -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+ -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+ -- DECREMENT THE COUNTER.
+ --
+      TASK BODY MNT_TASK IS
+      BEGIN
+           DELAY 5.0 * Impdef.One_Second;
+           MNT_COUNTER.DECR;
+      END MNT_TASK;
+ 
+      -- ***********************************************
+      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E DO
+                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                     END E;
+ 
+                OR   TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T;
+ 
+      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+      --
+      TASK BODY UNACTIVATED IS
+      BEGIN
+           T.E;
+      END UNACTIVATED;
+ END C93005C_PK1;
+ 
+ WITH REPORT, C93005C_PK1;
+ USE  REPORT, C93005C_PK1;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93005C IS
+ 
+ 
+ BEGIN
+ 
+      TEST("C93005C", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                      "TASKS");
+ 
+      COMMENT("SUBTEST 1: TASKS IN DECL PART OF A BLOCK AND A PACKAGE " &
+              "SPEC");
+      COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
+ B1:  DECLARE
+           X : MNT;
+      BEGIN
+ B2:       BEGIN
+ B3:            DECLARE
+                     TYPE ACC_MNT IS ACCESS MNT;
+                     T1 : UNACTIVATED;
+                     M2 : ACC_MNT := NEW MNT;
+ 
+                     PACKAGE RAISES_EXCEPTION IS
+                          T2 : UNACTIVATED;
+                          M3 : ACC_MNT := NEW MNT;
+                          I  : POSITIVE := IDENT_INT(0); -- RAISE
+                                           -- CONSTRAINT_ERROR EXCEPTION
+                     END RAISES_EXCEPTION;
+                     USE RAISES_EXCEPTION;
+                BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
+                     IF EQUAL (I, I) THEN
+                          FAILED ("EXCEPTION NOT RAISED");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
+                END B3;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT ("SUBTEST 1 COMPLETED");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN B2");
+           END B2;
+      END B1;
+ 
+      CHECK;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("EXCEPTION NOT ABSORBED");
+           RESULT;
+ END C93005C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,289 ----
+ -- C93005D.ADA 
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+ -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+ -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+ -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+ 
+ -- CASE 2: TASKS IN DECLARATIVE PART OF A BLOCK AND PACKAGE
+ -- SPECIFICATION.  THE TASKS DEPEND ON THE DECLARATIVE PART.
+ -- OTHER TASKS HAVE BEEN QUEUED ON THE TASKS' ENTRIES.
+ 
+ -- RAC 19-MAR-1985
+ -- JBG 06/03/85
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ --               ADDED PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ with Impdef;
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE C93005D_PK1 IS
+ 
+      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+      TASK TYPE UNACTIVATED IS
+           ENTRY E;
+      END UNACTIVATED;
+ 
+      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+ 
+      -- *******************************************
+      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+      --
+      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+      -- DECREMENT).
+ 
+      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+      -- BY ANYONE BUT THEMSELVES.
+      --
+      TASK TYPE MNT_TASK IS
+      END MNT_TASK;
+ 
+      FUNCTION F RETURN INTEGER;
+ 
+      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+      -- COUNT.
+      --
+      TYPE MNT IS
+           RECORD
+                DUMMY : INTEGER :=  F;
+                T     : MNT_TASK;
+           END RECORD;
+ 
+      PROCEDURE CHECK;
+ 
+ 
+      -- *******************************************
+      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+ 
+ END C93005D_PK1;
+ 
+ 
+ PACKAGE BODY C93005D_PK1 IS
+ 
+ -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+ -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+ 
+      TASK T IS
+           ENTRY E;
+      END;
+ 
+      -- ***********************************************
+      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+ -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+ -- ARE STILL ACTIVE.
+ 
+      MNT_COUNT : INTEGER := 0;
+ 
+ -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+ 
+      TASK MNT_COUNTER IS
+           ENTRY INCR;
+           ENTRY DECR;
+      END MNT_COUNTER;
+ 
+ -- SYNCHRONIZING TASK
+ 
+      TASK BODY MNT_COUNTER IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT INCR DO
+                          MNT_COUNT := MNT_COUNT +1;
+                     END INCR;
+ 
+                OR  ACCEPT DECR DO
+                          MNT_COUNT := MNT_COUNT -1;
+                     END DECR;
+ 
+                OR  TERMINATE;
+ 
+                END SELECT;
+           END LOOP;
+      END MNT_COUNTER;
+ 
+ -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+ --
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           MNT_COUNTER.INCR;
+           RETURN 0;
+      END F;
+ 
+ -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+ -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+ -- ITSELF IS NOT TERMINATED.
+ --
+      PROCEDURE CHECK IS
+      BEGIN
+           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                        "TERMINATED");
+           END IF;
+ -- RESET THE COUNT FOR THE NEXT SUBTEST:
+           MNT_COUNT := 0;
+      END CHECK;
+ 
+ -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+ -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+ -- DECREMENT THE COUNTER.
+ --
+      TASK BODY MNT_TASK IS
+      BEGIN
+           DELAY 5.0 * Impdef.One_Second;
+           MNT_COUNTER.DECR;
+      END MNT_TASK;
+ 
+      -- ***********************************************
+      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E DO
+                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                     END E;
+ 
+                OR   TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T;
+ 
+      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+      --
+      TASK BODY UNACTIVATED IS
+      BEGIN
+           T.E;
+      END UNACTIVATED;
+ END C93005D_PK1;
+ 
+ WITH C93005D_PK1; USE C93005D_PK1;
+ PRAGMA ELABORATE (C93005D_PK1);
+ GENERIC
+      T1 : IN OUT UNACTIVATED;
+ PACKAGE C93005D_ENQUEUE IS
+      PROCEDURE REQUIRE_BODY;
+ END;
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY C93005D_ENQUEUE IS
+ 
+      TASK T3 IS
+      END T3;
+ 
+      TASK BODY T3 IS
+      BEGIN
+           T1.E;
+           FAILED ("ENQUEUED CALLER DID NOT GET EXCEPTION");
+      EXCEPTION
+           WHEN TASKING_ERROR => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED");
+      END T3;
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ BEGIN                    -- T3 CALLS T1 HERE
+      DELAY 1.0 * Impdef.One_Second;            -- ENSURE THAT T3 EXECUTES
+ END C93005D_ENQUEUE;
+ 
+ WITH REPORT, C93005D_PK1, C93005D_ENQUEUE;
+ USE  REPORT, C93005D_PK1;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93005D IS
+ 
+ 
+ BEGIN
+ 
+      TEST("C93005D", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                      "TASKS");
+ 
+      COMMENT("SUBTEST 2: TASKS IN DECL PART OF A BLOCK AND A PACKAGE " &
+              "SPEC");
+      COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
+      COMMENT("  OTHER TASKS HAVE BEEN ENQUEUED ON THE TASKS' ENTRIES");
+ B21: DECLARE
+           X : MNT;
+      BEGIN
+ B22:      BEGIN
+ B23:           DECLARE
+                     TYPE ACC_MNT IS ACCESS MNT;
+                     T1 : UNACTIVATED;
+                     Y  : ACC_MNT := NEW MNT;
+ 
+                     PACKAGE HAS_UNACTIVATED IS
+                          T2 : UNACTIVATED;
+                          Z  : ACC_MNT := NEW MNT;
+                          PACKAGE ENQUEUE1 IS NEW C93005D_ENQUEUE(T1);
+                          PACKAGE ENQUEUE2 IS NEW C93005D_ENQUEUE(T2);
+                          I : POSITIVE := IDENT_INT(0); -- RAISE
+                                          -- CONSTRAINT_ERROR EXCEPTION.
+                     -- TERMINATES T1 AND T2 AND INDIRECTLY THE 2 T3'S
+                     END HAS_UNACTIVATED;
+                     USE HAS_UNACTIVATED;
+                BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
+                     IF EQUAL (I, I) THEN
+                          FAILED ("EXCEPTION NOT RAISED");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
+                END B23;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT("SUBTEST 2 COMPLETED");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN B22");
+           END B22;
+      END B21;
+ 
+      CHECK;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("EXCEPTION NOT ABSORBED");
+           RESULT;
+ END C93005D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,247 ----
+ -- C93005E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+ -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+ -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+ -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+ 
+ -- CASE 3: TASKS IN PACKAGE SPECIFICATION.
+ --         THE TASKS DON'T DEPEND ON THE PACKAGE SPECIFICATION.
+ 
+ -- RAC 19-MAR-1985
+ -- JBG 06/03/85
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE C93005E_PK1 IS
+ 
+      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+      TASK TYPE UNACTIVATED IS
+           ENTRY E;
+      END UNACTIVATED;
+ 
+      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+ 
+      TYPE BAD_REC IS
+           RECORD
+                T : UNACTIVATED;
+                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+           END RECORD;
+ 
+      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+ 
+ 
+      -- *******************************************
+      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+      --
+      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+      -- DECREMENT).
+ 
+      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+      -- BY ANYONE BUT THEMSELVES.
+      --
+      TASK TYPE MNT_TASK IS
+      END MNT_TASK;
+ 
+      FUNCTION F RETURN INTEGER;
+ 
+      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+      -- COUNT.
+      --
+      TYPE MNT IS
+           RECORD
+                DUMMY : INTEGER :=  F;
+                T     : MNT_TASK;
+           END RECORD;
+ 
+      PROCEDURE CHECK;
+ 
+ 
+      -- *******************************************
+      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+ 
+ END C93005E_PK1;
+ 
+ with Impdef;
+ PACKAGE BODY C93005E_PK1 IS
+ 
+ -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+ -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+ 
+      TASK T IS
+           ENTRY E;
+      END;
+ 
+      -- ***********************************************
+      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+ -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+ -- ARE STILL ACTIVE.
+ 
+      MNT_COUNT : INTEGER := 0;
+ 
+ -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+ 
+      TASK MNT_COUNTER IS
+           ENTRY INCR;
+           ENTRY DECR;
+      END MNT_COUNTER;
+ 
+ -- SYNCHRONIZING TASK
+ 
+      TASK BODY MNT_COUNTER IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT INCR DO
+                          MNT_COUNT := MNT_COUNT +1;
+                     END INCR;
+ 
+                OR  ACCEPT DECR DO
+                          MNT_COUNT := MNT_COUNT -1;
+                     END DECR;
+ 
+                OR  TERMINATE;
+ 
+                END SELECT;
+           END LOOP;
+      END MNT_COUNTER;
+ 
+ -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+ --
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           MNT_COUNTER.INCR;
+           RETURN 0;
+      END F;
+ 
+ -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+ -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+ -- ITSELF IS NOT TERMINATED.
+ --
+      PROCEDURE CHECK IS
+      BEGIN
+           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                        "TERMINATED");
+           END IF;
+ -- RESET THE COUNT FOR THE NEXT SUBTEST:
+           MNT_COUNT := 0;
+      END CHECK;
+ 
+ -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+ -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+ -- DECREMENT THE COUNTER.
+ --
+      TASK BODY MNT_TASK IS
+      BEGIN
+           DELAY 5.0 * Impdef.One_Second;
+           MNT_COUNTER.DECR;
+      END MNT_TASK;
+ 
+      -- ***********************************************
+      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E DO
+                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                     END E;
+ 
+                OR   TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T;
+ 
+      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+      --
+      TASK BODY UNACTIVATED IS
+      BEGIN
+           T.E;
+      END UNACTIVATED;
+ END C93005E_PK1;
+ 
+ WITH REPORT, C93005E_PK1;
+ USE  REPORT, C93005E_PK1;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93005E IS
+ 
+ 
+ BEGIN
+ 
+      TEST("C93005E", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                      "TASKS");
+ 
+      COMMENT("SUBTEST 3: TASK IN DECL PART OF PACKAGE SPEC");
+      COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
+ B31: DECLARE
+           X : MNT;
+      BEGIN
+ B32:      BEGIN
+ B33:           DECLARE
+                     PACKAGE RAISES_EXCEPTION IS
+                          TYPE ACC_MNT IS ACCESS MNT;
+                          Y   : ACC_MNT := NEW MNT;
+                          PTR : ACC_BAD_REC := NEW BAD_REC;
+                     END RAISES_EXCEPTION;
+                BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
+                     FAILED("EXCEPTION NOT RAISED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
+                END B33;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     COMMENT("SUBTEST 3 COMPLETED");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN B32");
+           END B32;
+      END B31;
+ 
+      CHECK;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("EXCEPTION NOT ABSORBED");
+           RESULT;
+ END C93005E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,255 ----
+ -- C93005F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+ -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+ -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+ -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+ 
+ -- CASE 4: TASKS IN STATEMENT PART OF A BLOCK.  THE TASKS DEPEND ON THE
+ --         DECLARATIVE PART.
+ 
+ -- RAC 19-MAR-1985
+ -- JBG 06/03/85
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ -- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE C93005F_PK1 IS
+ 
+      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+      TASK TYPE UNACTIVATED IS
+           ENTRY E;
+      END UNACTIVATED;
+ 
+      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+ 
+      TYPE BAD_REC IS
+           RECORD
+                T : UNACTIVATED;
+                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+           END RECORD;
+ 
+      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+ 
+ 
+      -- *******************************************
+      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+      --
+      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+      -- DECREMENT).
+ 
+      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+      -- BY ANYONE BUT THEMSELVES.
+      --
+      TASK TYPE MNT_TASK IS
+      END MNT_TASK;
+ 
+      FUNCTION F RETURN INTEGER;
+ 
+      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+      -- COUNT.
+      --
+      TYPE MNT IS
+           RECORD
+                DUMMY : INTEGER :=  F;
+                T     : MNT_TASK;
+           END RECORD;
+ 
+      PROCEDURE CHECK;
+ 
+ 
+      -- *******************************************
+      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+ 
+ END C93005F_PK1;
+ 
+ with Impdef;
+ PACKAGE BODY C93005F_PK1 IS
+ 
+ -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+ -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+ 
+      TASK T IS
+           ENTRY E;
+      END;
+ 
+      -- ***********************************************
+      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+ -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+ -- ARE STILL ACTIVE.
+ 
+      MNT_COUNT : INTEGER := 0;
+ 
+ -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+ 
+      TASK MNT_COUNTER IS
+           ENTRY INCR;
+           ENTRY DECR;
+      END MNT_COUNTER;
+ 
+ -- SYNCHRONIZING TASK
+ 
+      TASK BODY MNT_COUNTER IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT INCR DO
+                          MNT_COUNT := MNT_COUNT +1;
+                     END INCR;
+ 
+                OR  ACCEPT DECR DO
+                          MNT_COUNT := MNT_COUNT -1;
+                     END DECR;
+ 
+                OR  TERMINATE;
+ 
+                END SELECT;
+           END LOOP;
+      END MNT_COUNTER;
+ 
+ -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+ --
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           MNT_COUNTER.INCR;
+           RETURN 0;
+      END F;
+ 
+ -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+ -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+ -- ITSELF IS NOT TERMINATED.
+ --
+      PROCEDURE CHECK IS
+      BEGIN
+           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                        "TERMINATED");
+           END IF;
+ -- RESET THE COUNT FOR THE NEXT SUBTEST:
+           MNT_COUNT := 0;
+      END CHECK;
+ 
+ -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+ -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+ -- DECREMENT THE COUNTER.
+ --
+      TASK BODY MNT_TASK IS
+      BEGIN
+           DELAY 5.0 * Impdef.One_Second;
+           MNT_COUNTER.DECR;
+      END MNT_TASK;
+ 
+      -- ***********************************************
+      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E DO
+                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                     END E;
+ 
+                OR   TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T;
+ 
+      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+      --
+      TASK BODY UNACTIVATED IS
+      BEGIN
+           T.E;
+      END UNACTIVATED;
+ END C93005F_PK1;
+ 
+ WITH REPORT, C93005F_PK1;
+ USE  REPORT, C93005F_PK1;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93005F IS
+ 
+ 
+ BEGIN
+ 
+      TEST("C93005F", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                      "TASKS");
+ 
+      COMMENT("SUBTEST 4: TASK IN STATEMENT PART OF BLOCK");
+      COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
+ B41: DECLARE
+           X : MNT;
+      BEGIN
+ B42:      DECLARE
+                TYPE LOCAL_ACC IS ACCESS BAD_REC;
+                Y : MNT;
+                PTR : LOCAL_ACC;
+ 
+                TYPE ACC_MNT IS ACCESS MNT;
+                Z : ACC_MNT;
+ 
+           BEGIN
+                Z  := NEW MNT;
+                PTR := NEW BAD_REC;
+                IF PTR.I /= REPORT.IDENT_INT(0) THEN
+                   FAILED ("EXCEPTION NOT RAISED, VALUE CHANGED");
+                ELSE
+                   FAILED ("EXCEPTION NOT RAISED, CONSTRAINT IGNORED");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION IN B42");
+           END B42;
+ 
+           COMMENT("SUBTEST 4: COMPLETED");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION NOT ABSORBED");
+      END B41;
+ 
+      CHECK;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("EXCEPTION NOT ABSORBED");
+           RESULT;
+ END C93005F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,245 ----
+ -- C93005G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+ -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+ -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+ -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+ 
+ -- CASE 5: TASKS IN STATEMENT PART OF A BLOCK.  THE TASKS DON'T DEPEND
+ --         ON THE DECLARATIVE PART.
+ 
+ -- RAC 19-MAR-1985
+ -- JBG 06/03/85
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE C93005G_PK1 IS
+ 
+      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+      TASK TYPE UNACTIVATED IS
+           ENTRY E;
+      END UNACTIVATED;
+ 
+      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+ 
+      TYPE BAD_REC IS
+           RECORD
+                T : UNACTIVATED;
+                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+           END RECORD;
+ 
+      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+ 
+ 
+      -- *******************************************
+      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+      --
+      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+      -- DECREMENT).
+ 
+      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+      -- BY ANYONE BUT THEMSELVES.
+      --
+      TASK TYPE MNT_TASK IS
+      END MNT_TASK;
+ 
+      FUNCTION F RETURN INTEGER;
+ 
+      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+      -- COUNT.
+      --
+      TYPE MNT IS
+           RECORD
+                DUMMY : INTEGER :=  F;
+                T     : MNT_TASK;
+           END RECORD;
+ 
+      PROCEDURE CHECK;
+ 
+ 
+      -- *******************************************
+      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+ 
+ END C93005G_PK1;
+ 
+ with Impdef;
+ PACKAGE BODY C93005G_PK1 IS
+ 
+ -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+ -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+ 
+      TASK T IS
+           ENTRY E;
+      END;
+ 
+      -- ***********************************************
+      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+ -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+ -- ARE STILL ACTIVE.
+ 
+      MNT_COUNT : INTEGER := 0;
+ 
+ -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+ 
+      TASK MNT_COUNTER IS
+           ENTRY INCR;
+           ENTRY DECR;
+      END MNT_COUNTER;
+ 
+ -- SYNCHRONIZING TASK
+ 
+      TASK BODY MNT_COUNTER IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT INCR DO
+                          MNT_COUNT := MNT_COUNT +1;
+                     END INCR;
+ 
+                OR  ACCEPT DECR DO
+                          MNT_COUNT := MNT_COUNT -1;
+                     END DECR;
+ 
+                OR  TERMINATE;
+ 
+                END SELECT;
+           END LOOP;
+      END MNT_COUNTER;
+ 
+ -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+ --
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           MNT_COUNTER.INCR;
+           RETURN 0;
+      END F;
+ 
+ -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+ -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+ -- ITSELF IS NOT TERMINATED.
+ --
+      PROCEDURE CHECK IS
+      BEGIN
+           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                        "TERMINATED");
+           END IF;
+ -- RESET THE COUNT FOR THE NEXT SUBTEST:
+           MNT_COUNT := 0;
+      END CHECK;
+ 
+ -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+ -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+ -- DECREMENT THE COUNTER.
+ --
+      TASK BODY MNT_TASK IS
+      BEGIN
+           DELAY 5.0 * Impdef.One_Second;
+           MNT_COUNTER.DECR;
+      END MNT_TASK;
+ 
+      -- ***********************************************
+      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E DO
+                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                     END E;
+ 
+                OR   TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T;
+ 
+      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+      --
+      TASK BODY UNACTIVATED IS
+      BEGIN
+           T.E;
+      END UNACTIVATED;
+ END C93005G_PK1;
+ 
+ WITH REPORT, C93005G_PK1;
+ USE  REPORT, C93005G_PK1;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93005G IS
+ 
+ 
+ BEGIN
+ 
+      TEST("C93005G", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                      "TASKS");
+ 
+      COMMENT("SUBTEST 5: TASK IN STATEMENT PART OF BLOCK");
+      COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
+ B51: DECLARE
+           X : MNT;
+      BEGIN
+ B52:      DECLARE
+                Y   : MNT;
+                PTR : ACC_BAD_REC;
+           BEGIN
+                PTR := NEW BAD_REC;
+                FAILED ("EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION IN B52");
+           END B52;
+ 
+           COMMENT ("SUBTEST 5: COMPLETED");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION NOT ABSORBED");
+      END B51;
+ 
+      CHECK;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("EXCEPTION NOT ABSORBED");
+           RESULT;
+ END C93005G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93005h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93005h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,250 ----
+ -- C93005H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+ -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+ -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+ -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+ 
+ -- CASE 6: TASK IN STATEMENT PART OF PACKAGE AND THE TASKS DON'T DEPEND
+ --         ON THE PACKAGE SPECIFICATION.
+ 
+ -- RAC 19-MAR-1985
+ -- JBG 06/03/85
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE C93005H_PK1 IS
+ 
+      -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+      TASK TYPE UNACTIVATED IS
+           ENTRY E;
+      END UNACTIVATED;
+ 
+      TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+ 
+      TYPE BAD_REC IS
+           RECORD
+                T : UNACTIVATED;
+                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+           END RECORD;
+ 
+      TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+ 
+ 
+      -- *******************************************
+      -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+      --
+      -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+      -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+      -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+      -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+      -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+      -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+      -- DECREMENT).
+ 
+      -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+      -- BY ANYONE BUT THEMSELVES.
+      --
+      TASK TYPE MNT_TASK IS
+      END MNT_TASK;
+ 
+      FUNCTION F RETURN INTEGER;
+ 
+      -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+      -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+      -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+      -- COUNT.
+      --
+      TYPE MNT IS
+           RECORD
+                DUMMY : INTEGER :=  F;
+                T     : MNT_TASK;
+           END RECORD;
+ 
+      PROCEDURE CHECK;
+ 
+ 
+      -- *******************************************
+      -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+      -- *******************************************
+ 
+ END C93005H_PK1;
+ 
+ with Impdef;
+ PACKAGE BODY C93005H_PK1 IS
+ 
+ -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+ -- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+ 
+      TASK T IS
+           ENTRY E;
+      END;
+ 
+      -- ***********************************************
+      -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+ -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+ -- ARE STILL ACTIVE.
+ 
+      MNT_COUNT : INTEGER := 0;
+ 
+ -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+ 
+      TASK MNT_COUNTER IS
+           ENTRY INCR;
+           ENTRY DECR;
+      END MNT_COUNTER;
+ 
+ -- SYNCHRONIZING TASK
+ 
+      TASK BODY MNT_COUNTER IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT INCR DO
+                          MNT_COUNT := MNT_COUNT +1;
+                     END INCR;
+ 
+                OR  ACCEPT DECR DO
+                          MNT_COUNT := MNT_COUNT -1;
+                     END DECR;
+ 
+                OR  TERMINATE;
+ 
+                END SELECT;
+           END LOOP;
+      END MNT_COUNTER;
+ 
+ -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+ --
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           MNT_COUNTER.INCR;
+           RETURN 0;
+      END F;
+ 
+ -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+ -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+ -- ITSELF IS NOT TERMINATED.
+ --
+      PROCEDURE CHECK IS
+      BEGIN
+           IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+                FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                        "TERMINATED");
+           END IF;
+ -- RESET THE COUNT FOR THE NEXT SUBTEST:
+           MNT_COUNT := 0;
+      END CHECK;
+ 
+ -- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+ -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+ -- DECREMENT THE COUNTER.
+ --
+      TASK BODY MNT_TASK IS
+      BEGIN
+           DELAY 5.0 * Impdef.One_Second;
+           MNT_COUNTER.DECR;
+      END MNT_TASK;
+ 
+      -- ***********************************************
+      -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+      -- ***********************************************
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E DO
+                          FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                     END E;
+ 
+                OR   TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T;
+ 
+      -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+      --
+      TASK BODY UNACTIVATED IS
+      BEGIN
+           T.E;
+      END UNACTIVATED;
+ END C93005H_PK1;
+ 
+ WITH REPORT, C93005H_PK1;
+ USE  REPORT, C93005H_PK1;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C93005H IS
+ 
+ 
+ BEGIN
+ 
+      TEST("C93005H", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                      "TASKS");
+ 
+      COMMENT("SUBTEST 6: TASK IN STATEMENT PART OF PACKAGE");
+      COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
+ B61: DECLARE
+           X : MNT;
+ 
+           PACKAGE P IS
+                Y : MNT;
+           END P;
+ 
+           PACKAGE BODY P IS
+                PTR : ACC_BAD_REC;
+                Z   : MNT;
+           BEGIN
+                PTR := NEW BAD_REC;
+                FAILED("EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN P");
+           END P;
+ 
+      BEGIN
+           COMMENT ("SUBTEST 6: COMPLETED");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION NOT ABSORBED");
+      END B61;
+ 
+      CHECK;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED ("EXCEPTION NOT ABSORBED");
+           RESULT;
+ END C93005H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,69 ----
+ -- C93006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK OBJECT DECLARED IN A LIBRARY PACKAGE SPEC IS
+ -- ACTIVATED EVEN IF THE PACKAGE HAS NO BODY.
+ 
+ -- JEAN-PIERRE ROSEN 16-MAR-1984
+ -- JBG 6/1/84
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ PACKAGE C93006A0 IS
+      TASK TYPE TT IS
+           ENTRY E;
+      END;
+ END C93006A0;
+ 
+ PACKAGE BODY C93006A0 IS
+      TASK BODY TT IS
+      BEGIN
+           ACCEPT E;
+      END;
+ END C93006A0;
+ 
+ WITH C93006A0; USE C93006A0;
+ PRAGMA ELABORATE(C93006A0);
+ PACKAGE C93006A1 IS
+      T : TT;
+ END C93006A1;
+ 
+ with Impdef;
+ WITH REPORT, C93006A1, SYSTEM;
+ USE  REPORT, C93006A1, SYSTEM;
+ PROCEDURE C93006A IS
+ BEGIN
+ 
+      TEST("C93006A", "CHECK ACTIVATION OF TASK DECLARED IN PACKAGE " &
+                      "SPECIFICATION");
+ 
+      SELECT
+           T.E;
+      OR 
+           DELAY 60.0 * Impdef.One_Second;
+           FAILED("RENDEZVOUS NOT ACCEPTED WITHIN 60 SECONDS");
+      END SELECT;
+ 
+      RESULT;
+ END C93006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C93007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF AN ATTEMPT IS MADE TO ACTIVATE A TASK BEFORE ITS
+ --     BODY HAS BEEN ELABORATED, THE TASK IS COMPLETED AND "PROGRAM_
+ --     ERROR" (RATHER THAN "TASKING_ERROR") IS RAISED.
+ 
+ -- HISTORY:
+ --     DHH 03/16/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C93007A IS
+ 
+ BEGIN
+ 
+      TEST("C93007A", "CHECK THAT IF AN ATTEMPT IS MADE TO ACTIVATE " &
+                      "A TASK BEFORE ITS BODY HAS BEEN ELABORATED, " &
+                      "THE TASK IS COMPLETED AND ""PROGRAM_ERROR"" " &
+                      "(RATHER THAN ""TASKING_ERROR"") IS RAISED");
+ 
+      DECLARE
+           TASK TYPE PROG_ERR IS
+                ENTRY START;
+           END PROG_ERR;
+ 
+           TYPE REC IS
+                RECORD
+                     B : PROG_ERR;
+                END RECORD;
+ 
+           TYPE ACC IS ACCESS PROG_ERR;
+ 
+           PACKAGE P IS
+                OBJ : REC;
+           END P;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                FAILED("EXCEPTION NOT RAISED - 1");
+                OBJ.B.START;
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     NULL;
+                WHEN TASKING_ERROR =>
+                     FAILED("TASKING ERROR RAISED INCORRECTLY");
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED");
+           END P;
+ 
+           PACKAGE Q IS
+                OBJ : ACC;
+           END Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                OBJ := NEW PROG_ERR;
+                FAILED("EXCEPTION NOT RAISED - 2");
+                OBJ.START;
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     NULL;
+                WHEN TASKING_ERROR =>
+                     FAILED("ACCESS TASKING ERROR RAISED INCORRECTLY");
+                WHEN OTHERS =>
+                     FAILED("ACCESS UNEXPECTED EXCEPTION RAISED");
+           END;
+ 
+           TASK BODY PROG_ERR IS
+           BEGIN
+                ACCEPT START DO
+                     IF TRUE THEN
+                          COMMENT("IRRELEVANT");
+                     END IF;
+                END START;
+           END PROG_ERR;
+      BEGIN
+           NULL;
+      END; -- DECLARE
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN PROGRAM_ERROR =>
+           FAILED("PROGRAM_ERROR RAISED AT INCORRECT POSITION");
+           RESULT;
+ 
+      WHEN OTHERS =>
+           FAILED("UNEXPECTED EXCEPTION RAISED");
+           RESULT;
+ 
+ END C93007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C93008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR A TASK CREATED BY AN OBJECT DECLARATION, EXECUTION 
+ -- DOES NOT PROCEED IN PARALLEL WITH ACTIVATION.
+ 
+ -- R.WILLIAMS 8/20/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C93008A IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      TASK T IS
+           ENTRY FINIT_POS (DIGT : IN ARG);
+      END T;
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT FINIT_POS (DIGT : IN ARG) DO
+                          SPYNUMB := 10*SPYNUMB+DIGT;
+                     END FINIT_POS;
+                OR
+                     TERMINATE;
+                END SELECT;          
+           END LOOP;
+      END T;
+ 
+ BEGIN
+ 
+      TEST ("C93008A", "CHECK THAT EXECUTION DOES NOT PROCEED IN  " &
+                       "PARALLEL WITH ACTIVATION OF A TASK CREATED " &
+                       "BY AN OBJECT DECLARATION");
+ 
+ BLOCK:
+      DECLARE
+ 
+           TASK TYPE TT1;
+ 
+           TASK TT2;
+ 
+           T1 : TT1;
+ 
+           TASK BODY TT1 IS
+                PACKAGE DUMMY IS
+                END DUMMY;
+ 
+                PACKAGE BODY DUMMY IS
+                BEGIN
+                     DELAY 2.0 * Impdef.One_Second;
+                     T.FINIT_POS(1);
+                END DUMMY;
+           BEGIN
+                NULL;
+           END TT1;
+ 
+           TASK BODY TT2 IS
+                PACKAGE DUMMY IS
+                END DUMMY;
+ 
+                PACKAGE BODY DUMMY IS
+                BEGIN
+                     DELAY 2.0 * Impdef.One_Second;
+                     T.FINIT_POS(2);
+                END DUMMY;
+           BEGIN
+                NULL;
+           END TT2;
+           
+ 
+      BEGIN               -- TASKS ACTIVATED NOW.
+ 
+           IF SPYNUMB = 12 OR SPYNUMB = 21 THEN
+                NULL;
+           ELSE
+                FAILED ("TASKS NOT ACTIVATED PROPERLY - SPYNUMB HAS " &
+                        "ACTUAL VALUE OF: " & INTEGER'IMAGE(SPYNUMB));
+           END IF;
+      END BLOCK;
+ 
+      RESULT;
+ 
+ END C93008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93008b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c93008b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c93008b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C93008B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AFTER CREATION OF A TASK OBJECT BY AN ALLOCATOR, ANY
+ -- OPERATION INVOLVING THE RESULT DELIVERED BY THE ALLOCATOR IS
+ -- EXECUTED ONLY AFTER THE ACTIVATION OF THE TASK HAS COMPLETED.
+ 
+ -- WEI  3/ 4/82
+ -- TBN 12/20/85     RENAMED FROM C930AJA-B.ADA. ADDED DELAY STATEMENT
+ --                  DURING TASK ACTIVATION.
+ -- RJW 4/11/86      ADDED PACKAGE DUMMY.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C93008B IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+           RETURN DIGT;
+      END FINIT_POS;
+ 
+ BEGIN
+ 
+      TEST ("C93008B", "USE OF RESULT AFTER CREATION OF " &
+                       "A TASK BY ALLOCATOR");
+ 
+ BLOCK:
+      DECLARE
+ 
+           TASK TYPE TT1;
+ 
+           TYPE ATT1 IS ACCESS TT1;
+           TYPE ARRAY_ATT1 IS ARRAY (NATURAL RANGE 2 .. 3) OF ATT1;
+           MY_ARRAY : ARRAY_ATT1;
+           POINTER_TT1 : ATT1;
+ 
+           TASK BODY TT1 IS
+                PACKAGE DUMMY IS
+                END DUMMY;
+ 
+                PACKAGE BODY DUMMY IS
+                BEGIN
+                     DELAY 2.0 * Impdef.One_Second;
+                     DECLARE
+                          IDUMMY1 : NATURAL := FINIT_POS (1);
+                     BEGIN
+                          NULL;
+                     END;
+                END DUMMY;
+           BEGIN
+                NULL;
+           END TT1;
+ 
+      BEGIN
+ 
+           MY_ARRAY := (2 => NEW TT1, 3 => NULL);  -- TASK ACTIVATED NOW.
+           POINTER_TT1 := MY_ARRAY (FINIT_POS (2));
+ 
+           MY_ARRAY (FINIT_POS (3)) := POINTER_TT1;
+ 
+           IF SPYNUMB /= 123 THEN
+                IF SPYNUMB = 132 OR SPYNUMB = 13 OR
+                   SPYNUMB = 12  OR SPYNUMB = 1  OR
+                   SPYNUMB = 0
+                THEN
+                     FAILED ("TASK ACTIVATION RIGHT IN TIME, " &
+                             "BUT OTHER ERROR");
+                ELSE
+                     FAILED ("RESULT OF ALLOCATOR ACCESSED BEFORE " &
+                             "TASK ACTIVATION HAS COMPLETED");
+                END IF;
+                COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+           END IF;
+      END BLOCK;
+ 
+      RESULT;
+ 
+ END C93008B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,212 ----
+ -- C940001.A
+ --
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a protected object provides coordinated access to
+ --      shared data.  Check that it can be used to sequence a number of tasks.
+ --      Use the protected object to control a single token for which three 
+ --      tasks compete.  Check that only one task is running at a time and that
+ --      all tasks get a chance to run sometime.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a protected type with two entries.  A task may call the Take
+ --      entry to get a token which allows it to continue processing.  If it 
+ --      has the token, it may call the Give entry to return it.  The tasks 
+ --      implement a discipline whereby only the task with the token may be 
+ --      active.  The test does not require any specific order for the tasks 
+ --      to run.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      07 Jul 96   SAIC    Fixed spelling nits.
+ --
+ --!
+ 
+ package C940001_0 is
+ 
+   type Token_Type is private;
+   True_Token : constant Token_Type;   -- Create a deferred constant in order 
+                                       -- to provide a component init for the
+                                       -- protected object
+ 
+   protected type Token_Mgr_Prot_Unit is
+     entry Take (T : out Token_Type);
+     entry Give (T : in out  Token_Type);
+   private
+     Token : Token_Type := True_Token;
+   end Token_Mgr_Prot_Unit;
+ 
+   function Init_Token return Token_Type;   -- call to initialize an 
+                                            -- object of Token_Type
+   function Token_Value (T : Token_Type) return Boolean;
+                                            -- call to inspect the value of an
+                                            -- object of Token_Type
+ private
+   type Token_Type is new boolean;
+   True_Token : constant Token_Type := true;
+ end C940001_0;
+ 
+ --=================================================================--
+ 
+ package body C940001_0 is
+   protected body  Token_Mgr_Prot_Unit is
+     entry Take (T : out Token_Type) when Token = true is
+       begin                   -- Calling task will Take the token, so
+         T := Token;           -- check first that token_mgr owns the
+         Token := false;       -- token to give, then give it to caller
+       end Take;
+ 
+     entry Give (T : in out Token_Type)  when Token = false is
+       begin                   -- Calling task will Give the token back,
+         if T = true then      -- so first check that token_mgr does not
+           Token := T;         -- own the token, then check that the task has
+           T := false;         -- the token to give, then take it from the
+         end if;               -- task
+                               -- if caller does not own the token, then
+       end Give;               -- it falls out of the entry body with no
+   end Token_Mgr_Prot_Unit;    -- action
+ 
+   function Init_Token return Token_Type is
+     begin
+       return false;
+     end Init_Token;
+ 
+   function Token_Value (T : Token_Type) return Boolean is
+     begin
+       return Boolean (T);
+     end Token_Value;
+ 
+ end C940001_0;
+ 
+ --===============================================================--
+ 
+ with Report;
+ with ImpDef;
+ with C940001_0;
+ 
+ procedure C940001 is
+ 
+   type TC_Int_Type is range 0..2;
+               -- range is very narrow so that erroneous execution may
+               -- raise Constraint_Error
+ 
+   type TC_Artifact_Type is record
+      TC_Int : TC_Int_Type := 1;
+      Number_of_Accesses : integer := 0;
+   end record;
+ 
+   TC_Artifact : TC_Artifact_Type;
+ 
+   Sequence_Mgr : C940001_0.Token_Mgr_Prot_Unit;
+     
+   procedure Bump (Item : in out TC_Int_Type) is
+     begin
+       Item := Item + 1;
+     exception
+       when Constraint_Error =>
+         Report.Failed ("Incremented without corresponding decrement");
+       when others =>
+         Report.Failed ("Bump raised Unexpected Exception");
+    end Bump;
+ 
+   procedure Decrement (Item : in out TC_Int_Type) is
+     begin
+       Item := Item - 1;
+     exception
+       when Constraint_Error =>
+         Report.Failed ("Decremented without corresponding increment");
+       when others =>
+         Report.Failed ("Decrement raised Unexpected Exception");
+     end Decrement;
+     
+     --==============--
+ 
+   task type Network_Node_Type;
+ 
+   task body Network_Node_Type is
+ 
+     Slot_for_Token : C940001_0.Token_Type := C940001_0.Init_Token;
+ 
+     begin
+  
+       -- Ask for token - if request is not granted, task will be queued
+       Sequence_Mgr.Take (Slot_for_Token);        
+ 
+       -- Task now has token and may perform its work
+ 
+       --==========================--
+       -- in this case, the work is to ensure that the test results
+       -- are the expected ones!
+       --==========================--
+       Bump (TC_Artifact.TC_Int);   -- increment when request is granted
+       TC_Artifact.Number_Of_Accesses := 
+         TC_Artifact.Number_Of_Accesses + 1;
+       if not C940001_0.Token_Value ( Slot_for_Token) then
+         Report.Failed ("Incorrect results from entry Take");
+       end if;
+  
+       -- give a chance for other tasks to (incorrectly) run
+       delay ImpDef.Minimum_Task_Switch;
+ 
+       Decrement (TC_Artifact.TC_Int); -- prepare to return token
+ 
+       -- Task has completed its work and will return token
+ 
+       Sequence_Mgr.Give (Slot_for_Token);   -- return token to sequence manager
+ 
+       if c940001_0.Token_Value (Slot_for_Token) then
+         Report.Failed ("Incorrect results from entry Give");
+       end if;
+ 
+     exception
+       when others => Report.Failed ("Unexpected exception raised in task");
+ 
+     end Network_Node_Type; 
+ 
+     --==============--
+ 
+ begin
+ 
+   Report.Test ("C940001", "Check that a protected object can control " &
+                           "tasks by coordinating access to shared data");
+ 
+   declare
+      Node_1, Node_2, Node_3 : Network_Node_Type;
+                            -- declare three tasks which will compete for
+                            -- a single token, managed by Sequence Manager
+ 
+   begin                    -- tasks start
+     null;
+   end; -- wait for all tasks to terminate before reporting result
+ 
+   if TC_Artifact.Number_of_Accesses /= 3 then
+     Report.Failed ("Not all tasks got through");
+   end if;
+ 
+   Report.Result;
+ 
+ end C940001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,309 ----
+ -- C940002.A
+ --
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a protected object provides coordinated access to shared 
+ --      data.  Check that it can implement a semaphore-like construct using a
+ --      parameterless procedure which allows a specific maximum number of tasks
+ --      to run and excludes all others
+ --
+ -- TEST DESCRIPTION:
+ --      Implement a counting semaphore type that can be initialized to a 
+ --      specific number of available resources.  Declare an entry for 
+ --      requesting a resource and a procedure for releasing it.  Declare an 
+ --      object of this type, initialized to two resources.  Declare and start 
+ --      three tasks each of which asks for a resource.  Verify that only two 
+ --      resources are granted and that the last task in is queued.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package C940002_0 is
+      -- Semaphores
+ 
+   protected type Semaphore_Type (Resources_Available : Integer :=1) is
+     entry Request;
+     procedure Release;
+     function Available return Integer;
+   private
+     Currently_Available : Integer := Resources_Available;
+   end Semaphore_Type;
+ 
+   Max_Resources : constant Integer := 2;
+   Resource      : Semaphore_Type (Max_Resources);
+ 
+ end C940002_0;
+  -- Semaphores;
+ 
+ 
+           --========================================================--
+ 
+ 
+ package body C940002_0 is
+           -- Semaphores
+ 
+   protected body Semaphore_Type is
+ 
+     entry Request when Currently_Available >0 is  -- when granted, secures
+     begin                                         -- a resource
+       Currently_Available := Currently_Available - 1;
+     end Request;
+ 
+     procedure Release is                          -- when called, releases
+     begin                                         -- a resource
+       Currently_Available := Currently_Available + 1;
+     end Release;
+ 
+     function Available return Integer is          -- returns number of
+     begin                                         -- available resources
+       return Currently_Available;
+     end Available;
+ 
+   end Semaphore_Type;
+ 
+ end C940002_0;
+  -- Semaphores;
+ 
+ 
+           --========================================================--
+ 
+ 
+ package C940002_1 is
+      -- Task_Pkg
+ 
+   task type Requesting_Task is
+      entry Done;                        -- call on Done instructs the task
+   end Requesting_Task;                  -- to release resource
+ 
+   type Task_Ptr is access Requesting_Task;
+ 
+   protected Counter is
+     procedure Increment;
+     procedure Decrement;
+     function Number return integer;
+   private
+     Count : Integer := 0;
+   end Counter;
+ 
+   protected Hold_Lock is
+     procedure Lock;
+     procedure Unlock;
+     function  Locked return Boolean;
+   private
+     Lock_State  : Boolean := true;        -- starts out locked
+   end Hold_Lock;
+ 
+ 
+ end C940002_1;
+  -- Task_Pkg
+ 
+ 
+           --========================================================--
+ 
+ 
+ with Report;
+ with C940002_0;
+   -- Semaphores;    
+ 
+ package body C940002_1 is
+           -- Task_Pkg is
+   
+   protected body Counter is
+ 
+     procedure Increment is
+       begin
+         Count := Count + 1;
+       end Increment;
+ 
+     procedure Decrement is
+       begin
+         Count := Count - 1;
+       end Decrement;
+ 
+     function Number return Integer is
+       begin
+         return Count;
+       end Number;
+ 
+   end Counter;
+ 
+ 
+   protected body Hold_Lock is
+ 
+     procedure Lock is 
+     begin
+       Lock_State := true;
+     end Lock;
+ 
+     procedure Unlock is 
+     begin
+       Lock_State := false;
+     end Unlock;
+ 
+     function  Locked return Boolean is 
+     begin
+       return Lock_State;
+     end Locked;
+ 
+   end Hold_Lock;
+ 
+ 
+   task body Requesting_Task is
+   begin
+     C940002_0.Resource.Request;        -- request a resource
+                                        -- if resource is not available, 
+                                        -- task will be queued to wait
+     Counter.Increment;                 -- add to count of resources obtained
+     Hold_Lock.Unlock;                  -- and unlock Lock - system is stable;
+                                        -- status may now be queried
+ 
+     accept Done do                     -- hold resource until Done is called
+       C940002_0.Resource.Release;      -- release the resource and
+       Counter.Decrement;               -- note release
+     end Done;                           
+ 
+   exception
+     when others => Report.Failed ("Unexpected Exception in Requesting_Task");
+   end Requesting_Task;
+ 
+ end C940002_1;
+  -- Task_Pkg;
+ 
+ 
+           --========================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ with C940002_0,
+   -- Semaphores, 
+      C940002_1;
+   -- Task_Pkg;
+ 
+ procedure C940002 is
+ 
+   package Semaphores renames C940002_0;
+   package Task_Pkg renames C940002_1;
+ 
+   Ptr1,
+   Ptr2, 
+   Ptr3 : Task_Pkg.Task_Ptr;
+   Num  : Integer;
+ 
+   procedure Spinlock is
+     begin
+       -- loop until unlocked
+       while Task_Pkg.Hold_Lock.Locked loop
+         delay ImpDef.Minimum_Task_Switch;   
+       end loop;
+       Task_Pkg.Hold_Lock.Lock;
+     end Spinlock;
+ 
+ begin
+ 
+   Report.Test ("C940002", "Check that a protected record can be used to " &
+                           "control access to resources");
+ 
+   if (Task_Pkg.Counter.Number /=0)
+   or (Semaphores.Resource.Available /= 2) then
+     Report.Failed ("Wrong initial conditions");
+   end if;
+                                   
+   Ptr1 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
+                                    -- resource; request for resource should 
+                                    -- be granted
+   Spinlock;                        -- ensure that task obtains resource
+ 
+                                    -- Task 1 waiting for call to Done
+                                    -- One resource assigned to task 1
+                                    -- One resource still available
+   if (Task_Pkg.Counter.Number /= 1) 
+   or (Semaphores.Resource.Available /= 1) then
+     Report.Failed ("Resource not assigned to task 1");
+   end if;
+ 
+   Ptr2 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
+                                    -- resource; request for resource should 
+                                    -- be granted
+   Spinlock;                        -- ensure that task obtains resource  
+ 
+                                    -- Task 1 waiting for call to Done
+                                    -- Task 2 waiting for call to Done
+                                    -- Resources held by tasks 1 and 2
+                                    -- No resources available
+   if (Task_Pkg.Counter.Number /= 2) 
+   or (Semaphores.Resource.Available /= 0) then
+     Report.Failed ("Resource not assigned to task 2");
+   end if;
+ 
+   Ptr3 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
+                                    -- resource; request for resource should 
+                                    -- be denied and task queued to wait for 
+                                    -- next available resource
+ 
+ 
+   Ptr1.all.Done;                   -- Task 1 releases resource and lock
+                                    -- Resource should be given to queued task
+   Spinlock;                        -- ensure that resource is released
+ 
+ 
+                                    -- Task 1 holds no resource
+                                    -- One resource still assigned to task 2
+                                    -- One resource assigned to task 3
+                                    -- No resources available
+   if (Task_Pkg.Counter.Number /= 2) 
+   or (Semaphores.Resource.Available /= 0) then
+     Report.Failed ("Resource not properly released/assigned to task 3");
+   end if;
+ 
+   Ptr2.all.Done;                   -- Task 2 releases resource and lock
+                                    -- No outstanding request for resource
+ 
+                                    -- Tasks 1 and 2 hold no resources
+                                    -- One resource assigned to task 3
+                                    -- One resource available
+   if (Task_Pkg.Counter.Number /= 1)
+   or (Semaphores.Resource.Available /= 1) then 
+     Report.Failed ("Resource not properly released from task 2");
+   end if;
+ 
+   Ptr3.all.Done;                   -- Task 3 releases resource and lock
+ 
+                                    -- All resources released
+                                    -- All tasks terminated (or close)
+                                    -- Two resources available
+   if (Task_Pkg.Counter.Number /=0) 
+   or (Semaphores.Resource.Available /= 2) then 
+     Report.Failed ("Resource not properly released from task 3");
+   end if;
+ 
+   Report.Result;
+ 
+ end C940002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,416 ----
+ -- C940004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that a protected record can be used to control access to
+ --      resources (data internal to the protected record).
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a resource descriptor tagged type.  Extend the type and
+ --      use the extended type in a protected data structure.
+ --      Implement a binary semaphore type.  Declare an entry for
+ --      requesting a specific resource and an procedure for releasing the
+ --      same resource.  Declare an object of this (protected) type.
+ --      Declare and start three tasks each of which asks for a resource
+ --      when directed to.  Verify that resources are properly allocated
+ --      and deallocated.
+ --
+ --
+ -- CHANGE HISTORY:
+ --
+ --      12 DEC 93   SAIC    Initial PreRelease version
+ --      23 JUL 95   SAIC    Second PreRelease version
+ --      16 OCT 95   SAIC    ACVC 2.1
+ --      13 MAR 03   RLB     Fixed race condition in test.
+ --
+ --!
+ 
+ package C940004_0 is
+ -- Resource_Pkg
+ 
+    type ID_Type is new Integer range 0..10;
+    type User_Descriptor_Type is tagged record
+       Id : ID_Type := 0;
+    end record;
+ 
+ end C940004_0; -- Resource_Pkg
+ 
+ --============================--
+ -- no body for C940004_0
+ --=============================--
+ 
+ with C940004_0; -- Resource_Pkg
+ 
+ -- This generic package implements a semaphore to control a single resource
+ 
+ generic
+ 
+   type Generic_Record_Type is new C940004_0.User_Descriptor_Type
+                                                          with private;
+ 
+ package C940004_1 is
+ -- Generic_Semaphore_Pkg
+                 -- generic package extends the tagged formal generic
+                 -- type with some implementation relevant details, and
+                 -- it provides a semaphore with operations that work
+                 -- on that type
+    type User_Rec_Type is new Generic_Record_Type with private;
+ 
+    protected type Semaphore_Type is
+       function  TC_Count return Integer;
+       entry     Request (R : in out User_Rec_Type);
+       procedure Release (R : in out User_Rec_Type);
+    private
+       In_Use : Boolean := false;
+    end Semaphore_Type;
+ 
+    function Has_Access (R : User_Rec_Type) return Boolean;
+ 
+ private
+ 
+    type User_Rec_Type is new Generic_Record_Type with record
+       Access_To_Resource : boolean := false;
+    end record;
+ 
+ end C940004_1;        -- Generic_Semaphore_Pkg
+ 
+ --===================================================--
+ 
+ package body C940004_1 is
+ -- Generic_Semaphore_Pkg
+ 
+    protected body Semaphore_Type is
+ 
+       function TC_Count return Integer is
+       begin
+          return Request'Count;
+       end TC_Count;
+ 
+       entry Request (R : in out User_Rec_Type)
+                                                when not In_Use is
+       begin
+          In_Use := true;
+          R.Access_To_Resource := true;
+       end Request;
+ 
+       procedure Release (R : in out User_Rec_Type) is
+       begin
+          In_Use := false;
+          R.Access_To_Resource := false;
+       end Release;
+ 
+    end Semaphore_Type;
+ 
+    function Has_Access (R : User_Rec_Type) return Boolean is
+    begin
+       return R.Access_To_Resource;
+    end Has_Access;
+ 
+ end C940004_1;       -- Generic_Semaphore_Pkg
+ 
+ --=============================================--
+ 
+ with Report;
+ with C940004_0; -- Resource_Pkg,
+ with C940004_1; -- Generic_Semaphore_Pkg;
+ 
+ package C940004_2 is
+ -- Printer_Mgr_Pkg
+ 
+    -- Instantiate the generic to get code to manage a single printer;
+    -- User processes contend for the printer, asking for it by a call
+    -- to Request, and relinquishing it by a call to Release
+ 
+    -- This package extends a tagged type to customize it for the printer
+    -- in question, then it uses the type to instantiate the generic and
+    -- declare a semaphore specific to the particular resource
+ 
+    package Resource_Pkg          renames C940004_0;
+ 
+    type User_Desc_Type is new Resource_Pkg.User_Descriptor_Type with record
+        New_Details : Integer := 0;    -- for example
+    end record;
+ 
+    package Instantiation is new C940004_1   -- Generic_Semaphore_Pkg
+                                    (Generic_Record_Type => User_Desc_Type);
+ 
+    Printer_Access_Mgr : Instantiation.Semaphore_Type;
+ 
+ 
+ end C940004_2; -- Printer_Mgr_Pkg
+ 
+ --============================--
+ -- no body for C940004_2
+ --============================--
+ 
+ with C940004_0; -- Resource_Pkg,
+ with C940004_2; -- Printer_Mgr_Pkg;
+ 
+ package C940004_3 is
+ -- User_Task_Pkg
+ 
+ -- This package models user tasks  that will request and release
+ -- the printer
+    package Resource_Pkg    renames C940004_0;
+    package Printer_Mgr_Pkg renames C940004_2;
+ 
+    task type User_Task_Type (ID : Resource_Pkg.ID_Type) is
+       entry Get_Printer;   -- instructs task to request resource
+ 
+       entry Release_Printer    -- instructs task to release printer
+           (Descriptor : in out Printer_Mgr_pkg.Instantiation.User_Rec_Type);
+ 
+       --==================--
+       -- Test management machinery
+       --==================--
+       entry TC_Get_Descriptor       -- returns descriptor
+             (Descriptor :  out Printer_Mgr_Pkg.Instantiation.User_Rec_Type);
+ 
+    end User_Task_Type;
+ 
+    --==================--
+    -- Test management machinery
+    --==================--
+    TC_Times_Obtained : Integer := 0;
+    TC_Times_Released : Integer := 0;
+ 
+ end C940004_3; -- User_Task_Pkg;
+ 
+ --==============================================--
+ 
+ with Report;
+ with C940004_0; -- Resource_Pkg,
+ with C940004_2; -- Printer_Mgr_Pkg,
+ 
+ package body C940004_3 is
+ -- User_Task_Pkg
+ 
+    task body User_Task_Type is
+       D : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
+    begin
+       D.Id := ID;
+             -----------------------------------
+       Main:
+       loop
+          select
+             accept Get_Printer;
+             Printer_Mgr_Pkg.Printer_Access_Mgr.Request (D);
+                       -- request resource; if resource is not available,
+                       -- task will be queued to wait
+             --===================--
+             -- Test management machinery
+             --===================--
+             TC_Times_Obtained := TC_Times_Obtained + 1;
+                       -- when request granted, note it and post a message
+ 
+          or
+            accept Release_Printer  (Descriptor : in out
+                              Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
+ 
+               Printer_Mgr_Pkg.Printer_Access_Mgr.Release (D);
+                           -- release the resource, note its release
+               TC_Times_Released := TC_Times_Released + 1;
+               Descriptor := D;
+            end Release_Printer;
+            exit Main;
+ 
+          or
+            accept TC_Get_Descriptor  (Descriptor : out
+                             Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
+ 
+               Descriptor := D;
+            end TC_Get_Descriptor;
+ 
+          end select;
+       end loop main;
+ 
+    exception
+       when others => Report.Failed ("exception raised in User_Task");
+    end User_Task_Type;
+ 
+ end C940004_3;   -- User_Task_Pkg;
+ 
+ --==========================================================--
+ 
+ with Report;
+ with ImpDef;
+ 
+ with C940004_0; -- Resource_Pkg,
+ with C940004_2; -- Printer_Mgr_Pkg,
+ with C940004_3; -- User_Task_Pkg;
+ 
+ procedure C940004 is
+    Verbose : constant Boolean := False;
+    package Resource_Pkg    renames C940004_0;
+    package Printer_Mgr_Pkg renames C940004_2;
+    package User_Task_Pkg   renames C940004_3;
+ 
+    Task1 : User_Task_Pkg.User_Task_Type (1);
+    Task2 : User_Task_Pkg.User_Task_Type (2);
+    Task3 : User_Task_Pkg.User_Task_Type (3);
+ 
+    User_Rec_1,
+    User_Rec_2,
+    User_Rec_3 : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
+ 
+ begin
+ 
+    Report.Test ("C940004", "Check that a protected record can be used to " &
+                            "control access to resources");
+ 
+    if    (User_Task_Pkg.TC_Times_Obtained /= 0)
+       or (User_Task_Pkg.TC_Times_Released /= 0)
+       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
+       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
+       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
+          Report.Failed ("Wrong initial conditions");
+    end if;
+ 
+    Task1.Get_Printer;           -- ask for resource
+                                 -- request for resource should be granted
+    Task1.TC_Get_Descriptor (User_Rec_1);-- wait here 'til task gets resource
+ 
+    if        (User_Task_Pkg.TC_Times_Obtained /= 1)
+       or     (User_Task_Pkg.TC_Times_Released /= 0)
+       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1) then
+          Report.Failed ("Resource not assigned to task 1");
+    end if;
+ 
+    Task2.Get_Printer;              -- ask for resource
+                                    -- request for resource should be denied
+                                    -- and task queued to wait
+ 
+    -- Task 1 still waiting to accept Release_Printer, still holds resource
+    -- Task 2 queued on Semaphore.Request
+ 
+    -- Ensure that Task2 is queued before continuing to make checks and queue
+    -- Task3. We use a for loop here to avoid hangs in broken implementations.
+    for TC_Cnt in 1 .. 20 loop
+       exit when Printer_Mgr_Pkg.Printer_Access_Mgr.TC_Count >= 1;
+       delay Impdef.Minimum_Task_Switch;
+    end loop;
+ 
+    if    (User_Task_Pkg.TC_Times_Obtained /= 1)
+       or (User_Task_Pkg.TC_Times_Released /= 0) then
+         Report.Failed ("Resource assigned to task 2");
+    end if;
+ 
+    Task3.Get_Printer;        -- ask for resource
+                              -- request for resource should be denied
+                              -- and task 3 queued on Semaphore.Request
+ 
+    Task1.Release_Printer (User_Rec_1);-- task 1 releases resource
+                                       -- released resource should be given to
+                                       -- queued task 2.
+ 
+    Task2.TC_Get_Descriptor (User_Rec_2);-- wait here for task 2
+ 
+    -- Task 1 has released resource and completed
+    -- Task 2 has seized the resource
+    -- Task 3 is queued on Semaphore.Request
+ 
+    if        (User_Task_Pkg.TC_Times_Obtained /= 2)
+       or     (User_Task_Pkg.TC_Times_Released /= 1)
+       or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
+       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2) then
+           Report.Failed ("Resource not properly released/assigned" &
+                          " to task 2");
+           if Verbose then
+              Report.Comment ("TC_Times_Obtained: " &
+                  Integer'Image (User_Task_Pkg.TC_Times_Obtained));
+              Report.Comment ("TC_Times_Released: " &
+                  Integer'Image (User_Task_Pkg.TC_Times_Released));
+              Report.Comment ("User 1 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_1)));
+              Report.Comment ("User 2 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_2)));
+           end if;
+    end if;
+ 
+    Task2.Release_Printer (User_Rec_2);-- task 2 releases resource
+ 
+    -- task 3 is released from queue, and is given resource
+ 
+    Task3.TC_Get_Descriptor (User_Rec_3);-- wait for task 3
+ 
+    if        (User_Task_Pkg.TC_Times_Obtained /= 3)
+       or     (User_Task_Pkg.TC_Times_Released /= 2)
+       or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
+       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
+         Report.Failed ("Resource not properly released/assigned " &
+                        "to task 3");
+           if Verbose then
+              Report.Comment ("TC_Times_Obtained: " &
+                 Integer'Image (User_Task_Pkg.TC_Times_Obtained));
+              Report.Comment ("TC_Times_Released: " &
+                 Integer'Image (User_Task_Pkg.TC_Times_Released));
+              Report.Comment ("User 1 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_1)));
+              Report.Comment ("User 2 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_2)));
+              Report.Comment ("User 3 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_3)));
+           end if;
+    end if;
+ 
+    Task3.Release_Printer (User_Rec_3);-- task 3 releases resource
+ 
+    if    (User_Task_Pkg.TC_Times_Obtained /=3)
+       or (User_Task_Pkg.TC_Times_Released /=3)
+       or Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
+          Report.Failed ("Resource not properly released by task 3");
+          if Verbose then
+              Report.Comment ("TC_Times_Obtained: " &
+                 Integer'Image (User_Task_Pkg.TC_Times_Obtained));
+              Report.Comment ("TC_Times_Released: " &
+                 Integer'Image (User_Task_Pkg.TC_Times_Released));
+              Report.Comment ("User 1 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_1)));
+              Report.Comment ("User 2 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_2)));
+              Report.Comment ("User 3 Has_Access:" &
+                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                                Has_Access (User_Rec_3)));
+          end if;
+ 
+    end if;
+ 
+    -- Ensure that all tasks have terminated before reporting the result
+    while not (Task1'terminated
+               and Task2'terminated
+               and Task3'terminated) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    Report.Result;
+ 
+ end C940004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,370 ----
+ -- C940005.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the body of a protected function can have internal calls
+ --      to other protected functions and that the body of a protected
+ --      procedure can have internal calls to protected procedures and to 
+ --      protected functions.
+ --
+ -- TEST DESCRIPTION:
+ --      Simulate a meter at a freeway on-ramp which, when real-time sensors
+ --      determine that the freeway is becoming saturated, triggers stop lights
+ --      which control the access of vehicles to prevent further saturation. 
+ --      Each on-ramp is represented by a protected object - in this case only
+ --      one is shown (Test_Ramp).  The routines to sample and alter the states
+ --      of the various sensors, to queue the vehicles on the meter and to
+ --      release them are all part of the  protected object and can be shared
+ --      by various tasks. Apart from the function/procedure tests this example
+ --      has a mix of other tasking features. 
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      13 Nov 95   SAIC    Updated and fixed bugs ACVC 2.0.1
+ --
+ --!
+ 
+ 
+ with Report;
+ with ImpDef;
+ with Ada.Calendar;
+                 
+ procedure C940005 is
+ 
+ begin
+ 
+    Report.Test ("C940005", "Check internal calls of protected functions" &
+                         " and procedures");
+ 
+    declare  -- encapsulate the test
+ 
+       function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                             return Ada.Calendar.Time renames Ada.Calendar."+";
+ 
+       -- Weighted load given to each potential problem area and accumulated
+       type Load_Factor is range 0..8;
+       Clear_Level    : constant Load_Factor := 0;
+       Minimum_Level  : constant Load_Factor := 1;
+       Moderate_Level : constant Load_Factor := 2;
+       Serious_Level  : constant Load_Factor := 4;
+       Critical_Level : constant Load_Factor := 6;
+ 
+       -- Weighted loads given to each  Sample Point (pure weights, not levels)
+       Local_Overload_wt         : constant Load_Factor := 1;
+       Next_Ramp_in_Overload_wt  : constant Load_Factor := 1;
+       Ramp_Junction_in_Overload_wt : constant Load_Factor :=2; --higher wght
+       -- ::::  other weighted loads
+           
+       TC_Multiplier : integer := 1;  -- changed half way through
+       TC_Expected_Passage_Total : constant integer := 486;
+ 
+       -- This is the time between synchronizing pulses to the ramps.
+       -- In reality one would expect a time of 5 to 10 seconds.  In
+       -- the interests of speeding up the test suite a shorter time
+       -- is used
+       Pulse_Time_Delta : constant duration := ImpDef.Long_Switch_To_New_Task;
+ 
+       -- control over stopping tasks
+       protected Control is
+          procedure Stop_Now;
+          function Stop return Boolean;
+       private
+          Halt : Boolean := False;
+       end Control;
+ 
+       protected body Control is
+          procedure Stop_Now is
+          begin
+             Halt := True;
+          end Stop_Now;
+ 
+          function Stop return Boolean is
+          begin
+             return Halt;
+          end Stop;
+       end Control;
+ 
+       task Pulse_Task;       -- task to generate a pulse for each ramp
+ 
+       -- Carrier task. One is created for each vehicle arriving at the ramp
+       task type Vehicle;      
+       type acc_Vehicle is access Vehicle;
+ 
+       --================================================================
+       protected Test_Ramp is
+          function Next_Ramp_in_Overload return Load_Factor;
+          function Local_Overload        return Load_Factor;
+          function Freeway_Overload      return Load_Factor;
+          function Freeway_Breakdown     return Boolean;
+          function Meter_in_use_State    return Boolean; 
+          procedure Set_Local_Overload;
+          procedure Add_Meter_Queue;
+          procedure Subtract_Meter_Queue;
+          procedure Time_Pulse_Received;
+          entry Wait_at_Meter;
+          procedure TC_Passage (Pass_Point : Integer);
+          function TC_Get_Passage_Total return integer;
+          -- ::::::::: many routines are not shown (for example none of the
+          --            clears, none of the real-time-sensor handlers)
+    
+       private
+ 
+          Release_One_Vehicle : Boolean := false;
+          Meter_in_Use        : Boolean := false;
+          Fwy_Break_State     : Boolean := false;
+                
+    
+          Ramp_Count : integer range 0..20 := 0;
+          Ramp_Count_Threshold : integer := 15;
+    
+          -- Current state of the various Sample Points
+          Local_State     : Load_Factor := Clear_Level;
+          Next_Ramp_State : Load_Factor := Clear_Level;
+             -- ::::  other Sample Point states not shown
+    
+          TC_Passage_Total : integer := 0;
+       end Test_Ramp;  
+       --================================================================
+       protected body Test_Ramp is
+    
+             procedure Start_Meter is
+             begin
+                Meter_in_Use := True;
+                null;  -- stub  :::: trigger the metering hardware
+             end Start_Meter;
+          
+          -- External call for Meter_in_Use
+          function Meter_in_Use_State return Boolean is
+          begin
+             return Meter_in_Use;
+          end Meter_in_Use_State;
+    
+          -- Trace the paths through the various routines by totaling the
+          -- weighted call parameters
+          procedure TC_Passage (Pass_Point : Integer) is
+          begin
+             TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
+          end TC_Passage;
+    
+          -- For the final check of the whole test
+          function TC_Get_Passage_Total return integer is
+          begin
+             return TC_Passage_Total;
+          end TC_Get_Passage_Total;
+    
+          -- These Set/Clear routines are triggered by real-time sensors that
+          -- reflect traffic state
+          procedure Set_Local_Overload is
+          begin
+             Local_State := Local_Overload_wt;
+             if not Meter_in_Use then
+                Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
+             end if;
+          end Set_Local_Overload;
+    
+          --::::: Set/Clear routines for all the other sensors not shown
+ 
+          function Local_Overload return Load_Factor is
+          begin
+             return Local_State;
+          end Local_Overload;
+    
+          function Next_Ramp_in_Overload return Load_Factor is
+          begin
+             return Next_Ramp_State;
+          end Next_Ramp_in_Overload;
+    
+          -- ::::::::  other overload factor states not shown
+    
+          -- return the summation of all the load factors
+          function Freeway_Overload return Load_Factor is
+          begin
+             return    Local_Overload                    -- EACH IS A CALL OF A
+                       -- + :::: others                  -- FUNCTION FROM WITHIN
+                       + Next_Ramp_in_Overload;          -- A FUNCTION
+          end Freeway_Overload;
+ 
+          -- Freeway Breakdown is defined as traffic moving < 5mph
+          function Freeway_Breakdown return Boolean is
+          begin
+             return Fwy_Break_State;
+          end Freeway_Breakdown;
+    
+          -- Keep count of vehicles currently on meter queue - we can't use
+          -- the 'count because we need the outcall trigger
+          procedure Add_Meter_Queue is
+             TC_Pass_Point : constant integer := 22;
+          begin
+             Ramp_Count := Ramp_Count + 1;  
+             TC_Passage ( TC_Pass_Point );  -- note passage through here
+             if Ramp_Count > Ramp_Count_Threshold then
+                null;  -- :::: stub, trigger surface street notification
+             end if;
+          end Add_Meter_Queue;  
+          --
+          procedure Subtract_Meter_Queue is
+             TC_Pass_Point : constant integer := 24;
+          begin
+             Ramp_Count := Ramp_Count - 1;  
+             TC_Passage ( TC_Pass_Point );  -- note passage through here
+          end Subtract_Meter_Queue;  
+    
+          -- Here each Vehicle task queues itself awaiting release
+          entry Wait_at_Meter when Release_One_Vehicle is
+          -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
+             TC_Pass_Point : constant integer := 23;
+          begin
+             TC_Passage ( TC_Pass_Point );   -- note passage through here
+             Release_One_Vehicle := false;   -- Consume the signal
+             -- Decrement number of vehicles on ramp 
+             Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY
+          end Wait_at_Meter;      
+    
+    
+          procedure Time_Pulse_Received is
+             Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL
+                                                     -- FUNCTION 
+                                                     -- FROM WITHIN PROCEDURE
+          begin
+             -- if broken down, no vehicles are released
+             if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE
+                if Load < Moderate_Level then
+                   Release_One_Vehicle := true;
+                end if;
+                null;    -- stub  ::: If other levels, release every other
+                         --           pulse, every third pulse  etc.
+             end if;
+          end Time_Pulse_Received;
+        
+       end Test_Ramp;  
+       --================================================================
+        
+ 
+       -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
+       -- generation of an accompanying carrier task
+       procedure New_Arrival is
+          Next_Vehicle_Task: acc_Vehicle := new Vehicle;
+          TC_Pass_Point : constant integer := 3; 
+       begin
+          Test_Ramp.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+          null;
+       end New_arrival;
+ 
+ 
+       -- Carrier task. One is created for each vehicle arriving at the ramp
+       task body Vehicle is
+          TC_Pass_point   : constant integer :=  1;
+          TC_Pass_Point_2 : constant integer := 21;
+          TC_Pass_Point_3 : constant integer :=  2;
+       begin
+          Test_Ramp.TC_Passage ( TC_Pass_Point );  -- note passage through here
+          if Test_Ramp.Meter_in_Use_State then  
+             Test_Ramp.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+             -- Increment count of number of vehicles on ramp 
+             Test_Ramp.Add_Meter_Queue;    -- CALL a protected PROCEDURE
+                                           -- which is also called from within
+             -- enter the meter queue
+             Test_Ramp.Wait_at_Meter;      -- CALL a protected ENTRY   
+          end if;
+          Test_Ramp.TC_Passage ( TC_Pass_Point_3 );  -- note passage thru here
+          null;  --:::: call to the first in the series of the Ramp_Sensors
+                 --     this "passes" the vehicle from one sensor to the next
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Vehicle Task");
+       end Vehicle;
+ 
+ 
+       -- Task transmits a synchronizing "pulse" to all ramps
+       --
+       task body Pulse_Task is
+          Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
+       begin
+          While not Control.Stop loop
+             delay until Pulse_Time;  
+             Test_Ramp.Time_Pulse_Received;  -- causes INTERNAL CALLS
+             -- ::::::::::  and to all the others
+             Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
+          end loop;
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Pulse_Task");
+       end Pulse_Task;
+ 
+ 
+    begin -- declare
+ 
+       -- Test driver.  This is ALL test control code
+ 
+       -- First simulate calls to the protected functions and procedures
+       -- from without the protected object
+       --
+       -- CALL FUNCTIONS
+       if Test_Ramp.Local_Overload /= Clear_Level then
+          Report.Failed ("External Call to Local_Overload incorrect");
+       end if;
+       if Test_Ramp.Next_Ramp_in_Overload /= Clear_Level then
+          Report.Failed ("External Call to Next_Ramp_in_Overload incorrect");
+       end if;
+       if Test_Ramp.Freeway_Overload /= Clear_Level then
+          Report.Failed ("External Call to Freeway_Overload incorrect");
+       end if;
+ 
+       -- Now Simulate the arrival of a vehicle to verify path through test
+       New_Arrival; 
+       delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
+ 
+       TC_Multiplier := 5;  -- change the weights for the paths for the next
+                            -- part of the test
+       
+       -- Simulate a real-time sensor reporting overload
+       Test_Ramp.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
+ 
+       -- CALL FUNCTIONS again
+       if Test_Ramp.Local_Overload /= Minimum_Level then
+          Report.Failed ("External Call to Local_Overload incorrect - 2");
+       end if;
+       if Test_Ramp.Freeway_Overload /= Minimum_Level then
+          Report.Failed ("External Call to Freeway_Overload incorrect -2");
+       end if;
+ 
+       -- Now Simulate the arrival of another vehicle again causing
+       -- INTERNAL CALLS but following different paths (queuing on the 
+       -- meter etc.)
+       New_Arrival; 
+       delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
+ 
+       Control.Stop_Now;  -- finish test
+ 
+       if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then
+          Report.Failed ("Unexpected paths taken");
+       end if;
+ 
+    end; -- declare
+ 
+    Report.Result;
+ 
+ end C940005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,223 ----
+ -- C940006.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the body of a protected function can have external calls
+ --      to other protected functions and that the body of a protected
+ --      procedure can have external calls to protected procedures and to 
+ --      protected functions.
+ --
+ -- TEST DESCRIPTION:
+ --      Use a subset of the simulation of the freeway on-ramp described in
+ --      c940005.  In this case two protected objects are used but only a
+ --      minimum of routines are shown in each.  Both objects are hard coded
+ --      and detail two adjacent on-ramps (Ramp_31 & Ramp_32) with routines in 
+ --      each which use external calls to the  other.  
+ 
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ 
+ procedure C940006 is
+ 
+ begin
+ 
+    Report.Test ("C940006", "Check external calls of protected functions" &
+                         " and procedures");
+ 
+    declare  -- encapsulate the test
+ 
+       -- Weighted load given to each potential problem area and accumulated
+       type Load_Factor is range 0..8;
+       -- 
+       Clear_Level    : constant Load_Factor := 0;
+       Minimum_Level  : constant Load_Factor := 1;
+       Moderate_Level : constant Load_Factor := 3;
+       Serious_Level  : constant Load_Factor := 4;
+       Critical_Level : constant Load_Factor := 6;
+ 
+       --================================================================
+       -- Only the Routines that are used in this test are shown
+       --
+       protected Ramp_31 is
+ 
+          function Local_Overload        return Load_Factor;
+          procedure Set_Local_Overload(Sensor_Level : Load_Factor);
+          procedure Notify;
+          function Next_Ramp_Overload    return Load_Factor;
+          function Freeway_Overload      return Load_Factor;
+          procedure Downstream_Ramps;
+          function Get_DSR_Accumulate    return Load_Factor;
+ 
+       private
+          Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
+ 
+          -- Current state of the various Sample Points
+          Local_State     : Load_Factor := Clear_Level;
+          -- Accumulated load for next three downstream ramps
+          DSR_Accumulate  : Load_Factor := Clear_Level;  
+    
+       end Ramp_31;  
+       --================================================================
+       -- Only the Routines that are used in this test are shown
+       --
+       protected Ramp_32 is
+       
+          function Local_Overload return Load_Factor;
+          procedure Set_Local_Overload (Sensor_Level : Load_Factor); 
+ 
+       private
+ 
+          Local_State : Load_Factor := Clear_Level;
+ 
+       end Ramp_32;  
+       --================================================================
+       protected body Ramp_31 is
+    
+          -- These Set/Clear routines are triggered by real-time sensors that
+          -- reflect traffic state
+          procedure Set_Local_Overload (Sensor_Level : Load_Factor) is
+          begin
+             -- Notify "previous" ramp to check this one for current state.
+             -- Subsequent changes in state will not send an alert 
+             null;   --::::: (see Ramp_32 for this code)
+             Local_State := Sensor_Level;
+             null;   --::::: Start local meter if not already started
+          end Set_Local_Overload;
+    
+          function Local_Overload return Load_Factor is
+          begin
+             return Local_State;
+          end Local_Overload;
+    
+          -- This is notification from the next ramp that it is in
+          -- overload.  With this provision we only need to sample the next
+          -- ramp during adverse conditions.  
+          procedure Notify is
+          begin
+             Next_Ramp_Alert := true;
+          end Notify;
+ 
+          function Next_Ramp_Overload return Load_Factor is
+          begin
+             if Next_Ramp_Alert then
+                -- EXTERNAL FUNCTION CALL FROM FUNCTION
+                -- Get next ramp's current state
+                return Ramp_32.Local_Overload;
+             else
+                return Clear_Level;  
+             end if;
+          end Next_Ramp_Overload;
+    
+          -- return the summation of all the load factors
+          function Freeway_Overload return Load_Factor is
+          begin
+             return    Local_Overload                   
+                       -- + :::: others                  
+                       + Next_Ramp_Overload;             
+          end Freeway_Overload;
+ 
+          -- Snapshot the states of the next three downstream ramps
+          procedure Downstream_Ramps is
+          begin
+             DSR_Accumulate := Ramp_32.Local_Overload;    -- EXTERNAL FUNCTION
+             -- ::::         + Ramp_33.Local_Overload     -- FROM  PROCEDURE
+             -- ::::         + Ramp_34.Local_Overload
+          end Downstream_Ramps;
+ 
+          -- Get last snapshot
+          function Get_DSR_Accumulate return Load_Factor is
+          begin
+             return DSR_Accumulate;
+          end Get_DSR_Accumulate;
+ 
+       end Ramp_31;  
+       --================================================================
+       protected body Ramp_32 is
+ 
+          function Local_Overload return Load_Factor is
+          begin
+             return Local_State;
+          end;
+    
+    
+          -- These Set/Clear routines are triggered by real-time sensors that
+          -- reflect traffic state
+          procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
+          begin
+             if Local_State = Clear_Level then
+                -- Notify "previous" ramp to check this one for current state.
+                -- Subsequent changes in state will not send an alert
+                -- When the situation clears another routine performs the 
+                -- all_clear notification. (not shown)
+                -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
+                Ramp_31.Notify;
+             end if;
+             Local_State := Sensor_Level;
+             null;   --::::: Start local meter if not already started
+          end;
+ 
+       end Ramp_32;  
+       --================================================================
+ 
+ 
+ 
+    begin -- declare
+ 
+       -- Test driver.  This is ALL test control code
+       -- Simulate calls to the protected functions and procedures
+       -- from without the protected object, these will, in turn make the
+       -- external calls.
+ 
+       -- Check initial conditions, exercising the simple calls
+       if not (Ramp_31.Local_Overload     = Clear_Level  and
+               Ramp_31.Next_Ramp_Overload = Clear_Level  and
+               Ramp_31.Freeway_Overload   = Clear_Level) and
+               Ramp_32.Local_Overload     = Clear_Level    then
+                   Report.Failed ("Initial Calls provided unexpected Results");
+       end if;
+       
+       -- Simulate real-time sensors reporting overloads at a hardware level
+       Ramp_31.Set_Local_Overload (1);
+       Ramp_32.Set_Local_Overload (3);
+      
+       Ramp_31.Downstream_Ramps;   -- take the current snapshot
+ 
+       if not (Ramp_31.Local_Overload     = Minimum_Level  and
+               Ramp_31.Get_DSR_Accumulate = Moderate_Level and
+               Ramp_31.Freeway_Overload   = Serious_Level)   then
+          Report.Failed ("Secondary Calls provided unexpected Results");
+       end if;
+       
+    end; -- declare
+ 
+    Report.Result;
+ 
+ end C940006;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,427 ----
+ -- C940007.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the body of a protected function declared as an object of a
+ --      given type can have internal calls to other protected functions and
+ --      that a protected procedure in such an object can have internal calls
+ --      to protected procedures and to  protected functions. 
+ --
+ -- TEST DESCRIPTION:
+ --      Simulate a meter at a freeway on-ramp which, when real-time sensors
+ --      determine that the freeway is becoming saturated, triggers stop lights
+ --      which control the access of vehicles to prevent further saturation. 
+ --      Each on-ramp is represented by a protected object of the type Ramp. 
+ --      The routines to sample and alter the states of the various sensors, to
+ --      queue the vehicles on the meter and to release them are all part of
+ --      the  protected object and can be shared by various tasks. Apart from
+ --      the function/procedure tests this example has a mix of other tasking
+ --      features.  In this test two objects representing two adjacent ramps
+ --      are created from the same type.  The same "traffic" is simulated for
+ --      each ramp.  The results should be identical.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      13 Nov 95   SAIC    Replaced shared global variable Pulse_Stop
+ --                          with a protected object.
+ --                          ACVC 2.0.1
+ --
+ --!
+ 
+ 
+ with Report;
+ with ImpDef;
+ with Ada.Calendar;
+         
+                 
+ procedure C940007 is
+ 
+ begin
+ 
+    Report.Test ("C940007", "Check internal calls of protected functions" &
+                         " and procedures in objects declared as a type");
+ 
+    declare  -- encapsulate the test
+ 
+       function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                           return Ada.Calendar.Time renames Ada.Calendar."+";
+ 
+       -- Weighted load given to each potential problem area and accumulated
+       type Load_Factor is range 0..8;
+       Clear_Level    : constant Load_Factor := 0;
+       Minimum_Level  : constant Load_Factor := 1;
+       Moderate_Level : constant Load_Factor := 2;
+       Serious_Level  : constant Load_Factor := 4;
+       Critical_Level : constant Load_Factor := 6;
+ 
+       -- Weighted loads given to each  Sample Point (pure weights, not levels)
+       Local_Overload_wt            : constant Load_Factor := 1;
+       Next_Ramp_in_Overload_wt     : constant Load_Factor := 1;
+       Ramp_Junction_in_Overload_wt : constant Load_Factor :=2; --higher wght
+       -- ::::  other weighted loads
+           
+       TC_Expected_Passage_Total : integer := 486;
+ 
+ 
+       -- This is the time between synchronizing pulses to the ramps.
+       -- In reality one would expect a time of 5 to 10 seconds.  In
+       -- the interests of speeding up the test suite a shorter time
+       -- is used
+       Pulse_Time_Delta : constant duration := ImpDef.Long_Switch_To_New_Task;
+ 
+ 
+       -- control over stopping tasks
+       protected Control is
+          procedure Stop_Now;
+          function Stop return Boolean;
+       private
+          Halt : Boolean := False;
+       end Control;
+ 
+       protected body Control is
+          procedure Stop_Now is
+          begin
+             Halt := True;
+          end Stop_Now;
+ 
+          function Stop return Boolean is
+          begin
+             return Halt;
+          end Stop;
+       end Control;
+ 
+ 
+       task Pulse_Task;       -- task to generate a pulse for each ramp
+ 
+       -- Carrier tasks. One is created for each vehicle arriving at each ramp
+       task type Vehicle_31;            -- For Ramp_31
+       type acc_Vehicle_31 is access Vehicle_31;
+       --
+       task type Vehicle_32;            -- For Ramp_32
+       type acc_Vehicle_32 is access Vehicle_32;
+                 
+       --================================================================
+       protected type Ramp is
+          function Next_Ramp_in_Overload return Load_Factor;
+          function Local_Overload        return Load_Factor;
+          function Freeway_Overload      return Load_Factor;
+          function Freeway_Breakdown     return Boolean;
+          function Meter_in_Use_State    return Boolean;
+          procedure Set_Local_Overload;
+          procedure Add_Meter_Queue;
+          procedure Subtract_Meter_Queue;
+          procedure Time_Pulse_Received;
+          entry Wait_at_Meter;
+          procedure TC_Passage (Pass_Point : Integer);
+          function TC_Get_Passage_Total return integer;
+          -- ::::::::: many routines are not shown (for example none of the
+          --            clears, none of the real-time-sensor handlers)
+    
+       private
+ 
+          Release_One_Vehicle : Boolean := false;
+          Meter_in_Use        : Boolean := false;
+          Fwy_Break_State     : Boolean := false;
+                
+    
+          Ramp_Count : integer range 0..20 := 0;
+          Ramp_Count_Threshold : integer := 15;
+    
+          -- Current state of the various Sample Points
+          Local_State     : Load_Factor := Clear_Level;
+          Next_Ramp_State : Load_Factor := Clear_Level;
+             -- ::::  other Sample Point states not shown
+    
+          TC_Multiplier    : integer := 1;  -- changed half way through
+          TC_Passage_Total : integer := 0;
+       end Ramp;  
+       --================================================================
+       protected body Ramp is
+    
+             procedure Start_Meter is
+             begin
+                Meter_in_Use := True;
+                null;  -- stub  :::: trigger the metering hardware
+             end Start_Meter;
+    
+          function Meter_in_Use_State return Boolean is
+          begin
+             return Meter_in_Use;
+          end Meter_in_Use_State;
+ 
+          -- Trace the paths through the various routines by totaling the
+          -- weighted call parameters
+          procedure TC_Passage (Pass_Point : Integer) is
+          begin
+             TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
+          end TC_Passage;
+    
+          -- For the final check of the whole test
+          function TC_Get_Passage_Total return integer is
+          begin
+             return TC_Passage_Total;
+          end TC_Get_Passage_Total;
+    
+          -- These Set/Clear routines are triggered by real-time sensors that
+          -- reflect traffic state
+          procedure Set_Local_Overload is
+          begin
+             Local_State := Local_Overload_wt;
+             if not Meter_in_Use then
+                Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
+             end if;
+             -- Change the weights for the paths for the next part of the test
+             TC_Multiplier :=5;
+          end Set_Local_Overload;
+    
+          --::::: Set/Clear routines for all the other sensors not shown
+ 
+          function Local_Overload return Load_Factor is
+          begin
+             return Local_State;
+          end Local_Overload;
+    
+          function Next_Ramp_in_Overload return Load_Factor is
+          begin
+             return Next_Ramp_State;
+          end Next_Ramp_in_Overload;
+    
+          -- ::::::::  other overload factor states not shown
+    
+          -- return the summation of all the load factors
+          function Freeway_Overload return Load_Factor is
+          begin
+             return    Local_Overload                    -- EACH IS A CALL OF A
+                       -- + :::: others                  -- FUNCTION FROM WITHIN
+                       + Next_Ramp_in_Overload;          -- A FUNCTION
+          end Freeway_Overload;
+ 
+          -- Freeway Breakdown is defined as traffic moving < 5mph
+          function Freeway_Breakdown return Boolean is
+          begin
+             return Fwy_Break_State;
+          end Freeway_Breakdown;
+    
+          -- Keep count of vehicles currently on meter queue - we can't use
+          -- the 'count because we need the outcall trigger
+          procedure Add_Meter_Queue is
+             TC_Pass_Point : constant integer := 22;
+          begin
+             Ramp_Count := Ramp_Count + 1;  
+             TC_Passage ( TC_Pass_Point );  -- note passage through here
+             if Ramp_Count > Ramp_Count_Threshold then
+                null;  -- :::: stub, trigger surface street notification
+             end if;
+          end Add_Meter_Queue;  
+          --
+          procedure Subtract_Meter_Queue is
+             TC_Pass_Point : constant integer := 24;
+          begin
+             Ramp_Count := Ramp_Count - 1;  
+             TC_Passage ( TC_Pass_Point );  -- note passage through here
+          end Subtract_Meter_Queue;  
+    
+          -- Here each Vehicle task queues itself awaiting release
+          entry Wait_at_Meter when Release_One_Vehicle is
+          -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
+             TC_Pass_Point : constant integer := 23;
+          begin
+             TC_Passage ( TC_Pass_Point );   -- note passage through here
+             Release_One_Vehicle := false;   -- Consume the signal
+             -- Decrement number of vehicles on ramp 
+             Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY
+          end Wait_at_Meter;      
+    
+    
+          procedure Time_Pulse_Received is
+             Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL FUNCTN 
+                                                     -- FROM WITHIN PROCEDURE
+          begin
+             -- if broken down, no vehicles are released
+             if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE
+                if Load < Moderate_Level then
+                   Release_One_Vehicle := true;
+                end if;
+                null;    -- stub  ::: If other levels, release every other
+                         --           pulse, every third pulse  etc.
+             end if;
+          end Time_Pulse_Received;
+        
+       end Ramp;  
+       --================================================================
+ 
+       -- Now create two Ramp objects from this type
+       Ramp_31 : Ramp;
+       Ramp_32 : Ramp;
+ 
+        
+ 
+       -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
+       -- and the generation of an accompanying carrier task
+       procedure New_Arrival_31 is
+          Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
+          TC_Pass_Point : constant integer := 3; 
+       begin
+          Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+          null;   --::: stub
+       end New_arrival_31;
+ 
+ 
+       -- Carrier task. One is created for each vehicle arriving at Ramp_31
+       task body Vehicle_31 is
+          TC_Pass_point   : constant integer :=  1;
+          TC_Pass_Point_2 : constant integer := 21;
+          TC_Pass_Point_3 : constant integer :=  2;
+       begin
+          Ramp_31.TC_Passage ( TC_Pass_Point );  -- note passage through here
+          if Ramp_31.Meter_in_Use_State then  
+             Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+             -- Increment count of number of vehicles on ramp 
+             Ramp_31.Add_Meter_Queue;    -- CALL a protected PROCEDURE
+                                           -- which is also called from within
+             -- enter the meter queue
+             Ramp_31.Wait_at_Meter;      -- CALL a protected ENTRY   
+          end if;
+          Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
+          null;  --:::: call to the first in the series of the Ramp_Sensors
+                 --     this "passes" the vehicle from one sensor to the next
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Vehicle Task");
+       end Vehicle_31;
+ 
+ 
+       -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
+       -- generation of an accompanying carrier task
+       procedure New_Arrival_32 is
+          Next_Vehicle_Task_32 : acc_Vehicle_32 := new Vehicle_32;
+          TC_Pass_Point : constant integer := 3; 
+       begin
+          Ramp_32.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+          null;  --::: stub
+       end New_arrival_32;
+ 
+ 
+       -- Carrier task. One is created for each vehicle arriving at Ramp_32
+       task body Vehicle_32 is
+          TC_Pass_point   : constant integer :=  1;
+          TC_Pass_Point_2 : constant integer := 21;
+          TC_Pass_Point_3 : constant integer :=  2;
+       begin
+          Ramp_32.TC_Passage ( TC_Pass_Point );  -- note passage through here
+          if Ramp_32.Meter_in_Use_State then  
+             Ramp_32.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+             -- Increment count of number of vehicles on ramp 
+             Ramp_32.Add_Meter_Queue;    -- CALL a protected PROCEDURE
+                                           -- which is also called from within
+             -- enter the meter queue
+             Ramp_32.Wait_at_Meter;      -- CALL a protected ENTRY   
+          end if;
+          Ramp_32.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
+          null;  --:::: call to the first in the series of the Ramp_Sensors
+                 --     this "passes" the vehicle from one sensor to the next
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Vehicle Task");
+       end Vehicle_32;
+ 
+ 
+       -- Task transmits a synchronizing "pulse" to all ramps
+       --
+       task body Pulse_Task is
+          Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
+       begin
+          While not Control.Stop loop
+             delay until Pulse_Time;  
+             Ramp_31.Time_Pulse_Received;    -- CALL OF PROCEDURE CAUSES
+             Ramp_32.Time_Pulse_Received;    -- INTERNAL CALLS
+             -- ::::::::::  and to all the others
+             Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
+          end loop;
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Pulse_Task");
+       end Pulse_Task;
+ 
+ 
+    begin -- declare
+ 
+       -- Test driver.  This is ALL test control code
+ 
+       -- First simulate calls to the protected functions and procedures
+       -- from without the protected object
+       --
+       -- CALL FUNCTIONS
+       if not ( Ramp_31.Local_Overload = Clear_Level and
+                Ramp_31.Next_Ramp_in_Overload = Clear_Level and
+                Ramp_31.Freeway_Overload = Clear_Level ) then
+          Report.Failed ("Initial Calls to Ramp_31 incorrect");
+       end if;
+       if not ( Ramp_32.Local_Overload = Clear_Level and
+                Ramp_32.Next_Ramp_in_Overload = Clear_Level and
+                Ramp_32.Freeway_Overload = Clear_Level ) then
+          Report.Failed ("Initial Calls to Ramp_32 incorrect");
+       end if;
+ 
+       -- Now Simulate the arrival of a vehicle at each ramp to verify 
+       -- basic paths through the test
+       New_Arrival_31; 
+       New_Arrival_32; 
+       delay Pulse_Time_Delta*2;  -- allow them to pass through the complex
+ 
+       -- Simulate real-time sensors reporting overload
+       Ramp_31.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
+       Ramp_32.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
+ 
+       -- CALL FUNCTIONS again
+       if not ( Ramp_31.Local_Overload = Minimum_Level and
+                Ramp_31.Freeway_Overload = Minimum_Level ) then
+          Report.Failed ("Secondary Calls to Ramp_31 incorrect");
+       end if;
+       if not ( Ramp_32.Local_Overload = Minimum_Level and
+                Ramp_32.Freeway_Overload = Minimum_Level ) then
+          Report.Failed ("Secondary Calls to Ramp_32 incorrect");
+       end if;
+ 
+       -- Now Simulate the arrival of another vehicle at each ramp again causing
+       -- INTERNAL CALLS but following different paths (queuing on the 
+       -- meter etc.)
+       New_Arrival_31; 
+       New_Arrival_32; 
+       delay Pulse_Time_Delta*2;  -- allow them to pass through the complex
+ 
+       Control.Stop_Now;  -- finish test
+ 
+       if not (TC_Expected_Passage_Total = Ramp_31.TC_Get_Passage_Total and
+               TC_Expected_Passage_Total = Ramp_32.TC_Get_Passage_Total) then
+          Report.Failed ("Unexpected paths taken");
+       end if;
+ 
+    end; -- declare
+ 
+    Report.Result;
+ 
+ end C940007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,269 ----
+ -- C940010.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if an exception is raised during the execution of an 
+ --      entry body it is propagated back to the caller
+ --
+ -- TEST DESCRIPTION:
+ --      Use a small fragment of code from the simulation of a freeway meter
+ --      used in c940007. Create three individual tasks which will be queued on
+ --      the entry as the barrier is set.  Release them one at a time.  A
+ --      procedure which is called within the entry has been modified for this
+ --      test to raise a different exception for each pass through.  Check that
+ --      all expected exceptions are raised and propagated.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with Report;
+ with ImpDef;
+                 
+ procedure C940010 is
+ 
+     TC_Failed_1 : Boolean := false; 
+ 
+ begin
+ 
+    Report.Test ("C940010", "Check that an exception raised in an entry " &
+                         "body is propagated back to the caller");
+ 
+    declare  -- encapsulate the test
+ 
+       TC_Defined_Error : Exception;    -- User defined exception
+       TC_Expected_Passage_Total : constant integer := 669;
+       TC_Int                    : constant integer := 5;
+ 
+       -- Carrier tasks. One is created for each vehicle arriving at each ramp
+       task type Vehicle_31;            -- For Ramp_31
+       type acc_Vehicle_31 is access Vehicle_31;
+ 
+ 
+       --================================================================
+       protected Ramp_31 is
+ 
+          function Meter_in_Use_State return Boolean;
+          procedure Add_Meter_Queue;
+          procedure Subtract_Meter_Queue;
+          entry Wait_at_Meter;
+          procedure Pulse;
+          --
+          procedure TC_Passage (Pass_Point : Integer);
+          function TC_Get_Passage_Total return integer;
+          function TC_Get_Current_Exception return integer;
+ 
+       private
+ 
+          Release_One_Vehicle : Boolean := false;
+          Meter_in_Use        : Boolean := true;  -- TC: set true for this test
+          --
+          TC_Multiplier       : integer := 1;
+          TC_Passage_Total    : integer := 0;
+          -- Use this to cycle through the required exceptions
+          TC_Current_Exception : integer range 0..3 := 0;
+ 
+       end Ramp_31;  
+       --================================================================
+       protected body Ramp_31 is
+                
+    
+          -- Trace the paths through the various routines by totaling the
+          -- weighted call parameters
+          procedure TC_Passage (Pass_Point : Integer) is
+          begin
+             TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
+          end TC_Passage;
+    
+          -- For the final check of the whole test
+          function TC_Get_Passage_Total return integer is
+          begin
+             return TC_Passage_Total;
+          end TC_Get_Passage_Total;
+ 
+          function TC_Get_Current_Exception return integer is
+          begin 
+             return TC_Current_Exception;
+          end TC_Get_Current_Exception;
+ 
+    
+          -----------------
+ 
+          function Meter_in_Use_State return Boolean is
+          begin
+             return Meter_in_Use;
+          end Meter_in_Use_State;
+        
+          -- Simulate the effects of the regular signal pulse 
+          procedure Pulse is
+          begin
+             Release_one_Vehicle := true;
+          end Pulse;
+ 
+          -- Keep count of vehicles currently on meter queue - we can't use
+          -- the 'count because we need the outcall trigger
+          procedure Add_Meter_Queue is
+          begin
+             null;    --::: stub
+          end Add_Meter_Queue;  
+ 
+          -- TC: This routine has been modified to raise the required 
+          --     exceptions
+          procedure Subtract_Meter_Queue is
+             TC_Pass_Point1 : constant integer := 10;
+             TC_Pass_Point2 : constant integer := 20;
+             TC_Pass_Point3 : constant integer := 30;
+             TC_Pass_Point9 : constant integer := 1000;  -- error
+          begin
+             -- Cycle through the required exceptions, one per call
+             TC_Current_Exception := TC_Current_Exception + 1;
+             case TC_Current_Exception is
+                when 1 => 
+                      TC_Passage (TC_Pass_Point1);  -- note passage through here
+                      raise Storage_Error;    -- PREDEFINED EXCEPTION
+                when 2 => 
+                      TC_Passage (TC_Pass_Point2);  -- note passage through here
+                      raise TC_Defined_Error;    -- USER DEFINED EXCEPTION
+                when 3 => 
+                      TC_Passage (TC_Pass_Point3);  -- note passage through here
+                      -- RUN TIME EXCEPTION (Constraint_Error)
+                      -- Add the value 3 to 5 then try to assign it to an object
+                      -- whose range is 0..3  - this causes the exception.
+                      -- Disguise the values which cause the Constraint_Error
+                      -- so that the optimizer will not eliminate this code
+                      --    Note: the variable is checked at the end to ensure
+                      --    that the actual assignment is attempted.  Also note
+                      --    the value remains at 3 as the assignment does not
+                      --    take place.  This is the value that is checked at
+                      --    the end of the test.
+                      -- Otherwise the optimizer could decide that the result 
+                      -- of the assignment was not used so why bother to do it?
+                      TC_Current_Exception := 
+                                Report.Ident_Int (TC_Current_Exception) + 
+                                Report.Ident_Int (TC_Int);
+                when others =>
+                      -- Set flag for Report.Failed which cannot be called from
+                      -- within a Protected Object 
+                      TC_Failed_1 := True;
+             end case;
+ 
+             TC_Passage ( TC_Pass_Point9 );  -- note passage through here
+          end Subtract_Meter_Queue;  
+    
+          -- Here each Vehicle task queues itself awaiting release
+          entry Wait_at_Meter when Release_One_Vehicle is
+          -- Example of entry with barriers and persistent signal
+             TC_Pass_Point : constant integer := 2;
+          begin
+             TC_Passage ( TC_Pass_Point );   -- note passage through here
+             Release_One_Vehicle := false;   -- Consume the signal
+             -- Decrement number of vehicles on ramp 
+             Subtract_Meter_Queue;  -- Call procedure from within entry body
+          end Wait_at_Meter;      
+    
+       end Ramp_31;  
+       --================================================================
+         
+       -- Carrier task. One is created for each vehicle arriving at Ramp_31
+       task body Vehicle_31 is
+          TC_Pass_Point_1 : constant integer := 100;
+          TC_Pass_Point_2 : constant integer := 200;
+          TC_Pass_Point_3 : constant integer := 300;
+       begin
+          if Ramp_31.Meter_in_Use_State then  
+             -- Increment count of number of vehicles on ramp 
+             Ramp_31.Add_Meter_Queue;    -- Call a protected procedure
+                                           -- which is also called from within
+             -- enter the meter queue
+             Ramp_31.Wait_at_Meter;      -- Call a protected entry   
+             Report.Failed ("Exception not propagated back");
+          end if;
+          null;  --:::: call to the first in the series of the Ramp_Sensors
+                 --     this "passes" the vehicle from one sensor to the next
+       exception
+          when Storage_Error =>
+                Ramp_31.TC_Passage ( TC_Pass_Point_1 );  -- note passage
+          when TC_Defined_Error =>  
+                Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+          when Constraint_Error =>
+                Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage
+          when others => 
+                Report.Failed ("Unexpected exception in Vehicle Task");
+       end Vehicle_31;
+ 
+       -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
+       -- and the generation of an accompanying carrier task
+       procedure New_Arrival_31 is
+          Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
+          TC_Pass_Point : constant integer := 1; 
+       begin
+          Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+          null;  --::: stub
+       end New_arrival_31;
+ 
+ 
+ 
+    begin -- declare
+ 
+       -- Test driver.  This is ALL test control code
+ 
+       -- Create three independent tasks which will queue themselves on the
+       -- entry.  Each task will get a different exception
+       New_Arrival_31;
+       New_Arrival_31;
+       New_Arrival_31;
+ 
+       delay ImpDef.Clear_Ready_Queue;
+ 
+       -- Set the barrier condition of the entry true, releasing one task
+       Ramp_31.Pulse; 
+       delay ImpDef.Clear_Ready_Queue;
+       
+       Ramp_31.Pulse; 
+       delay ImpDef.Clear_Ready_Queue;
+       
+       Ramp_31.Pulse; 
+       delay ImpDef.Clear_Ready_Queue;
+ 
+       if (TC_Expected_Passage_Total /= Ramp_31.TC_Get_Passage_Total)  or
+          -- Note: We are not really interested in this next check.  It is 
+          --       here to ensure the earlier statements which raised the 
+          --       Constraint_Error are not optimized out
+          (Ramp_31.TC_Get_Current_Exception /= 3) then
+             Report.Failed ("Unexpected paths taken");
+       end if;
+       
+    end; -- declare
+ 
+    if TC_Failed_1 then 
+       Report.Failed ("Bad path through Subtract_Meter_Queue");
+    end if;
+ 
+    Report.Result;
+ 
+ end C940010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,175 ----
+ -- C940011.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, in the body of a protected object created by the execution
+ --      of an allocator, external calls to other protected objects via 
+ --      the access type are correctly performed
+ --
+ -- TEST DESCRIPTION:
+ --      Use a subset of the simulation of the freeway on-ramp described in
+ --      c940005.  In this case an array of access types is built with pointers
+ --      to successive ramps.  The external calls within the protected
+ --      objects are made via the index into the array.  Routines which refer
+ --      to the "previous" ramp and the "next" ramp are exercised.  (Note: The
+ --      first and last ramps are assumed to be dummies and no first/last
+ --      condition code is included)
+ --      
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with Report;
+ 
+ 
+ procedure C940011 is
+ 
+    type Ramp;     
+    type acc_Ramp is access Ramp;
+ 
+    subtype Ramp_Index is integer range 1..4;
+    
+ 
+    -- Weighted load given to each potential problem area and accumulated
+    type Load_Factor is range 0..8;
+    Clear_Level    : constant Load_Factor := 0;
+    Moderate_Level : constant Load_Factor := 3;
+    
+    --================================================================
+    -- Only the Routines that are used in this test are shown
+    --
+    protected type Ramp is
+ 
+       procedure Set_Index (Index : Ramp_Index);
+       procedure Set_Local_Overload (Sensor_Level : Load_Factor);
+       function Local_Overload        return Load_Factor;
+       procedure Notify;
+       function Next_Ramp_Overload    return Load_Factor;
+ 
+    private
+ 
+       This_Ramp : Ramp_Index;
+ 
+       Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
+ 
+       -- Current state of the various Sample Points
+       Local_State     : Load_Factor := Clear_Level;
+    
+    end Ramp;
+    --================================================================
+ 
+    -- Build a set of Ramp objects and an array of pointers to them
+    --
+    Ramp_Array : array (Ramp_Index) of acc_Ramp := (Ramp_Index => new Ramp);
+ 
+    --================================================================
+    protected body Ramp is
+    
+       procedure Set_Index (Index : Ramp_Index) is
+       begin
+          This_Ramp := Index;            
+       end Set_Index;
+ 
+       -- These Set/Clear routines are triggered by real-time sensors that
+       -- reflect traffic state
+       procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
+       begin
+          if Local_State = Clear_Level then
+             -- Notify "previous" ramp to check this one for current state.
+             -- Subsequent changes in state will not send an alert
+             -- When the situation clears another routine performs the 
+             -- all_clear notification. (not shown)
+             -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
+             Ramp_Array(This_Ramp - 1).Notify;   -- index to previous ramp
+          end if;
+          Local_State := Sensor_Level;
+          null;   --::::: Start local meter if not already started
+       end Set_Local_Overload;
+ 
+       function Local_Overload return Load_Factor is
+       begin
+          return Local_State;
+       end Local_Overload;
+    
+       -- This is notification from the next ramp that it is in
+       -- overload.  With this provision we only need to sample the next
+       -- ramp during adverse conditions.  
+       procedure Notify is
+       begin
+          Next_Ramp_Alert := true;
+       end Notify;
+ 
+       function Next_Ramp_Overload return Load_Factor is
+       begin
+          if Next_Ramp_Alert then
+             -- EXTERNAL FUNCTION CALL FROM FUNCTION
+             -- Get next ramp's current state
+             return Ramp_Array(This_Ramp + 1).Local_Overload;
+          else
+             return Clear_Level;  
+          end if;
+       end Next_Ramp_Overload;
+    end Ramp;
+ 
+    --================================================================
+ 
+ 
+ begin
+ 
+ 
+    Report.Test ("C940011", "Protected Objects created by allocators: " &
+                      "external calls via access types");
+ 
+    -- Initialize each Ramp 
+    for i in Ramp_Index loop
+       Ramp_Array(i).Set_Index (i);
+    end loop;      
+ 
+    -- Test driver.  This is ALL test control code
+    
+    -- Simulate calls to the protected functions and procedures
+    -- external calls. (do not call the "dummy" end ramps)
+ 
+    -- Simple Call
+    if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then
+       Report.Failed ("Primary call incorrect");
+    end if;
+    
+    -- Call which results in an external procedure call via the array
+    -- index from within the protected object
+    Ramp_Array(3).Set_Local_Overload (Moderate_Level);
+    
+    -- Call which results in an external function call via the array
+    -- index from within the protected object
+    if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then
+       Report.Failed ("Secondary call incorrect");
+    end if;
+       
+    Report.Result;
+ 
+ end C940011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,174 ----
+ -- C940012.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a protected object can have discriminants
+ --
+ -- TEST DESCRIPTION:
+ --      Use a subset of the simulation of the freeway on-ramp described in
+ --      c940005.  In this case an array of access types is built with pointers
+ --      to successive ramps.  Each ramp has its Ramp_Number specified by 
+ --      discriminant and this corresponds to the index in the array.  The test
+ --      checks that the ramp numbers are assigned as expected then uses calls
+ --      to  procedures within the objects (ramps) to verify external calls to
+ --      ensure the structures are valid.  The external references within the
+ --      protected objects are made via the index into the array.  Routines
+ --      which refer to the "previous" ramp and the "next" ramp are exercised. 
+ --      (Note: The first and last ramps are assumed to be dummies and no
+ --      first/last condition code is included)
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with Report;
+ 
+ 
+ procedure C940012 is
+ 
+    type Ramp_Index is range 1..4;
+ 
+    type Ramp;
+    type a_Ramp is access Ramp;
+ 
+    Ramp_Array : array (Ramp_Index) of a_Ramp;
+ 
+    -- Weighted load given to each potential problem area and accumulated
+    type Load_Factor is range 0..8;
+    Clear_Level    : constant Load_Factor := 0;
+    Moderate_Level : constant Load_Factor := 3;
+    
+    --================================================================
+    -- Only the Routines that are used in this test are shown
+    --
+    protected type Ramp (Ramp_In : Ramp_Index) is
+ 
+       function Ramp_Number           return Ramp_Index;
+       function Local_Overload        return Load_Factor;
+       function Next_Ramp_Overload    return Load_Factor;
+       procedure Set_Local_Overload(Sensor_Level : Load_Factor);
+       procedure Notify;
+ 
+    private
+ 
+       Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
+ 
+       -- Current state of the various Sample Points
+       Local_State     : Load_Factor := Clear_Level;
+    
+    end Ramp;
+    --================================================================
+    protected body Ramp is
+    
+       function Ramp_Number return Ramp_Index is
+       begin
+          return Ramp_In;
+       end Ramp_Number;
+ 
+       -- These Set/Clear routines are triggered by real-time sensors that
+       -- reflect traffic state
+       procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
+       begin
+          if Local_State = Clear_Level then
+             -- Notify "previous" ramp to check this one for current state.
+             -- Subsequent changes in state will not send an alert
+             -- When the situation clears another routine performs the 
+             -- all_clear notification. (not shown)
+             Ramp_Array(Ramp_In - 1).Notify;   -- index to previous ramp
+          end if;
+          Local_State := Sensor_Level;
+          null;   --::::: Start local meter if not already started
+       end;
+ 
+       function Local_Overload return Load_Factor is
+       begin
+          return Local_State;
+       end Local_Overload;
+    
+       -- This is notification from the next ramp that it is in
+       -- overload.  With this provision we only need to sample the next
+       -- ramp during adverse conditions.  
+       procedure Notify is
+       begin
+          Next_Ramp_Alert := true;
+       end Notify;
+ 
+       function Next_Ramp_Overload return Load_Factor is
+       begin
+          if Next_Ramp_Alert then
+             -- Get next ramp's current state
+             return Ramp_Array(Ramp_In + 1).Local_Overload;
+          else
+             return Clear_Level;  
+          end if;
+       end Next_Ramp_Overload;
+    end Ramp;
+    --================================================================
+    
+ begin
+ 
+ 
+    Report.Test ("C940012", "Check that a protected object " &
+                         "can have discriminants");
+ 
+    -- Build the ramps and populate the ramp array
+    for i in Ramp_Index loop
+       Ramp_Array(i) := new Ramp (i);
+    end loop;      
+ 
+    -- Test driver.  This is ALL test control code
+ 
+    -- Check the assignment of the index
+    for i in Ramp_Index loop
+       if Ramp_Array(i).Ramp_Number /= i then
+          Report.Failed ("Ramp_Number assignment incorrect");
+       end if;
+    end loop;      
+ 
+    -- Simulate calls to the protected functions and procedures
+    -- external calls. (do not call the "dummy" end ramps)
+ 
+    -- Simple Call
+    if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then
+       Report.Failed ("Primary call incorrect");
+    end if;
+    
+    -- Call which results in an external procedure call via the array
+    -- index from within the protected object
+    Ramp_Array(3).Set_Local_Overload (Moderate_Level);
+       
+    -- Call which results in an external function call via the array
+    -- index from within the protected object
+    if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then
+       Report.Failed ("Secondary call incorrect");
+    end if;
+       
+       
+    Report.Result;
+ 
+ end C940012;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,379 ----
+ -- C940013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that items queued on a protected entry are handled FIFO and that
+ --      the  'count attribute of that entry reflects the length of the queue.
+ -- 
+ -- TEST DESCRIPTION:
+ --      Use a small subset of the freeway ramp simulation shown in other
+ --      tests.  With the timing pulse off (which prevents items from being
+ --      removed from the queue) queue up a small number of calls.  Start the
+ --      timing pulse and, at the first execution of the entry code, check the
+ --      'count attribute. Empty the queue.   Pass the items being removed from
+ --      the queue to the Ramp_Sensor_01 task; there check that the items are
+ --      arriving in FIFO order.  Check the final 'count value  
+ --      
+ --      Send another batch of items at a rate which will, if the delay timing
+ --      of the implementation is reasonable, cause the queue length to
+ --      fluctuate in both directions.   Again check that all items arrive
+ --      FIFO.  At the end check that the 'count returned to zero reflecting
+ --      the empty queue.  
+ --      
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ with Ada.Calendar;
+                 
+ procedure C940013 is
+ 
+    TC_Failed_1 : Boolean := false;
+ 
+ begin
+ 
+    Report.Test ("C940013", "Check that queues on protected entries are " &
+                            "handled FIFO and that 'count is correct");
+ 
+    declare  -- encapsulate the test
+ 
+       function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                             return Ada.Calendar.Time renames Ada.Calendar."+";
+ 
+       -- Weighted load given to each potential problem area and accumulated
+       type Load_Factor is range 0..8;
+       Clear_Level    : constant Load_Factor := 0;
+       Minimum_Level  : constant Load_Factor := 1;
+       Moderate_Level : constant Load_Factor := 2;
+       Serious_Level  : constant Load_Factor := 4;
+       Critical_Level : constant Load_Factor := 6;
+ 
+       TC_Expected_Passage_Total : constant integer := 624;
+ 
+       -- For this test give each vehicle an integer ID incremented
+       -- by one for each successive vehicle.  In reality this would be
+       -- a more complex alpha-numeric ID assigned at pickup time.
+       type Vehicle_ID is range 1..5000;
+       Next_ID : Vehicle_ID := Vehicle_ID'first;  
+ 
+       -- In reality this would be about 5 seconds. The default value of 
+       -- this constant in the implementation defined package is similar
+       -- but could, of course be considerably different - it would not 
+       -- affect the test 
+       -- 
+       Pulse_Time_Delta : duration := ImpDef.Clear_Ready_Queue;
+ 
+ 
+       task Pulse_Task;       -- task to generate a pulse for each ramp
+ 
+       -- Carrier task. One is created for each vehicle arriving at the ramp
+       task type Vehicle is
+          entry Get_ID (Input_ID : in Vehicle_ID);
+       end Vehicle;      
+       type acc_Vehicle is access Vehicle;
+ 
+       task Ramp_Sensor_01 is
+          entry  Accept_Vehicle (Input_ID : in Vehicle_ID);
+          entry  TC_First_Three_Handled;
+          entry  TC_All_Done;
+       end Ramp_Sensor_01;
+ 
+       protected Pulse_State is 
+          procedure Start_Pulse;
+          procedure Stop_Pulse;
+          function Pulsing return Boolean;
+       private
+          State : Boolean := false;   -- start test will pulse off
+       end Pulse_State;
+ 
+       protected body Pulse_State is 
+ 
+          procedure Start_Pulse is
+          begin
+             State := true;
+          end Start_Pulse;
+ 
+          procedure Stop_Pulse is
+          begin 
+             State := false;
+          end Stop_Pulse;
+ 
+          function Pulsing return Boolean is
+          begin 
+             return State;
+          end Pulsing;
+      
+       end Pulse_State;
+ 
+       --================================================================
+       protected Test_Ramp is 
+       
+          function Meter_in_use_State    return Boolean; 
+          procedure Time_Pulse_Received;
+          entry Wait_at_Meter;
+          procedure TC_Passage (Pass_Point : Integer);
+          function TC_Get_Passage_Total return integer;
+          function TC_Get_Count return integer;
+    
+       private
+ 
+          Release_One_Vehicle : Boolean := false;
+          -- For this test have Meter_in_Use already set
+          Meter_in_Use        : Boolean := true;
+ 
+          TC_Wait_at_Meter_First : Boolean := true;
+          TC_Entry_Queue_Count   : integer := 0; -- 'count of Wait_at_Meter
+          TC_Passage_Total       : integer := 0;
+          TC_Pass_Point_WAM      : integer := 23;
+ 
+       end Test_Ramp;  
+       --================================================================
+       protected body Test_Ramp is
+    
+          -- External call for Meter_in_Use
+          function Meter_in_Use_State return Boolean is
+          begin
+             return Meter_in_Use;
+          end Meter_in_Use_State;
+    
+          -- Trace the paths through the various routines by totalling the
+          -- weighted call parameters
+          procedure TC_Passage (Pass_Point : Integer) is
+          begin
+             TC_Passage_Total := TC_Passage_Total + Pass_Point;
+          end TC_Passage;
+    
+          -- For the final check of the whole test
+          function TC_Get_Passage_Total return integer is
+          begin
+             return TC_Passage_Total;
+          end TC_Get_Passage_Total;
+    
+          function TC_Get_Count return integer is
+          begin
+             return TC_Entry_Queue_Count;
+          end TC_Get_Count;
+    
+ 
+          -- Here each Vehicle task queues itself awaiting release
+          --
+          entry Wait_at_Meter when Release_One_Vehicle is
+          -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
+          begin
+             --
+             TC_Passage ( TC_Pass_Point_WAM );   -- note passage
+             -- For this test three vehicles are queued before the first
+             -- is released.  If the queueing mechanism is working correctly
+             -- the first time we pass through here the entry'count should
+             -- reflect this
+             if TC_Wait_at_Meter_First then
+                if Wait_at_Meter'count /= 2 then
+                   TC_Failed_1 := true;
+                end if;
+                TC_Wait_at_Meter_First := false;
+             end if;
+             TC_Entry_Queue_Count := Wait_at_Meter'count;  -- note for later
+                
+             Release_One_Vehicle := false;   -- Consume the signal
+             null; -- stub ::: Decrement count of number of vehicles on ramp 
+          end Wait_at_Meter;      
+ 
+    
+          procedure Time_Pulse_Received is
+             Load : Load_factor := Minimum_Level;   -- for this version of the 
+             Freeway_Breakdown : Boolean := false;  -- test, freeway is Minimum
+          begin
+             -- if broken down, no vehicles are released
+             if not Freeway_Breakdown then 
+                if Load < Moderate_Level then
+                   Release_One_Vehicle := true;
+                end if;
+                null;    -- stub  ::: If other levels, release every other
+                         --           pulse, every third pulse  etc.
+             end if;
+          end Time_Pulse_Received;
+        
+       end Test_Ramp;  
+       --================================================================
+ 
+       -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
+       -- generation of an accompanying carrier task
+       procedure New_Arrival is
+          Next_Vehicle_Task: acc_Vehicle := new Vehicle;
+          TC_Pass_Point : constant integer := 3; 
+       begin
+          Next_ID := Next_ID + 1;
+          Next_Vehicle_Task.Get_ID(Next_ID);
+          Test_Ramp.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+          null;
+       end New_arrival;
+ 
+ 
+       -- Carrier task. One is created for each vehicle arriving at the ramp
+       task body Vehicle is
+          This_ID : Vehicle_ID;
+          TC_Pass_Point_2 : constant integer := 21;
+       begin
+          accept Get_ID (Input_ID : in Vehicle_ID) do 
+             This_ID := Input_ID;
+          end Get_ID;
+ 
+          if Test_Ramp.Meter_in_Use_State then  
+             Test_Ramp.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+             null;  -- stub::: Increment count of number of vehicles on ramp 
+             Test_Ramp.Wait_at_Meter;      -- Queue on the meter entry
+          end if;
+ 
+          -- Call to the first in the series of the Ramp_Sensors
+          --     this "passes" the vehicle from one sensor to the next
+          --     Each sensor will requeue the call to the next thus this
+          --     rendezvous will only be completed as the vehicle is released
+          --     by the last sensor on the ramp.
+          Ramp_Sensor_01.Accept_Vehicle (This_ID);
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Vehicle Task");
+       end Vehicle;
+ 
+       task body Ramp_Sensor_01 is
+          TC_Pass_Point : constant integer := 31; 
+          This_ID    : Vehicle_ID;
+          TC_Last_ID : Vehicle_ID := Vehicle_ID'first;
+       begin
+          loop
+             select
+                accept Accept_Vehicle (Input_ID : in Vehicle_ID) do 
+                   null;   -- stub:::: match up with next Real-Time notification
+                           -- from the sensor.  Requeue to next ramp sensor
+                   This_ID := Input_ID;
+                   
+                   -- The following is all Test_Control code
+                   Test_Ramp.TC_Passage ( TC_Pass_Point );  -- note passage
+                   -- The items arrive in the order they are taken from
+                   -- the Wait_at_Meter entry queue
+                   if ( This_ID - TC_Last_ID ) /= 1 then
+                      -- The tasks are being queued (or unqueued) in the
+                      -- wrong order
+                      Report.Failed
+                               ("Queueing on the Wait_at_Meter queue failed");
+                   end if;
+                   TC_Last_ID := This_ID;    -- for the next check
+                   if TC_Last_ID = 4 then
+                      -- rendezvous with the test driver
+                      accept TC_First_Three_Handled;
+                   elsif TC_Last_ID = 9 then
+                      -- rendezvous with the test driver
+                      accept TC_All_Done;
+                   end if;
+                end Accept_Vehicle;
+             or
+                terminate;
+             end select;
+          end loop;
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Ramp_Sensor_01");
+       end Ramp_Sensor_01;
+ 
+ 
+       -- Task transmits a synchronizing "pulse" to all ramps
+       --
+       task body Pulse_Task is
+          Pulse_Time : Ada.Calendar.Time;
+       begin
+          While not Pulse_State.Pulsing loop
+             -- Starts up in the quiescent state
+             delay ImpDef.Minimum_Task_Switch; 
+          end loop;
+          Pulse_Time := Ada.Calendar.Clock;
+          While Pulse_State.Pulsing loop
+             delay until Pulse_Time;  
+             Test_Ramp. Time_Pulse_Received;   -- Transmit pulse to test_ramp
+             -- ::::::::::  and to all the other ramps
+             Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
+          end loop;
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Pulse_Task");
+       end Pulse_Task;
+ 
+ 
+    begin -- declare
+ 
+       -- Test driver.  This is ALL test control code
+ 
+       -- Arrange to queue three vehicles on the Wait_at_Meter queue.  The 
+       -- timing pulse is quiescent so the queue will build
+       for i in 1..3 loop
+          New_Arrival; 
+       end loop;
+ 
+       delay Pulse_Time_Delta;  -- ensure all is settled
+ 
+       Pulse_State.Start_Pulse;     -- Start the timing pulse, the queue will 
+                                    -- be serviced
+       
+       -- wait here until the first three are complete
+       Ramp_Sensor_01.TC_First_Three_Handled;
+ 
+       if Test_Ramp.TC_Get_Count /= 0 then
+          Report.Failed ("Intermediate Wait_at_Entry'count is incorrect");
+       end if;
+ 
+       -- generate new arrivals at a rate that will make the queue increase
+       -- and decrease "randomly"
+       for i in 1..5 loop
+          New_Arrival; 
+          delay Pulse_Time_Delta/2;
+       end loop;
+ 
+       -- wait here till all have been handled
+       Ramp_Sensor_01.TC_All_Done;
+ 
+       if Test_Ramp.TC_Get_Count /= 0 then
+          Report.Failed ("Final Wait_at_Entry'count is incorrect");
+       end if;
+ 
+       Pulse_State.Stop_Pulse;       -- finish test
+ 
+ 
+       if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then
+          Report.Failed ("Unexpected paths taken");
+       end if;
+ 
+ 
+    end; -- declare
+ 
+    if TC_Failed_1 then 
+       Report.Failed ("Wait_at_Meter'count incorrect");
+    end if;
+ 
+    Report.Result;
+ 
+ end C940013;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940014.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940014.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940014.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,177 ----
+ -- C940014.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that as part of the finalization of a protected object
+ --      each call remaining on an entry queue of the objet is removed
+ --      from its queue and Program_Error is raised at the place of
+ --      the corresponding entry_call_statement.
+ --
+ -- TEST DESCRIPTION:
+ --      The example in 9.4(20a-20f);6.0 demonstrates how to cause a
+ --      protected object to finalize while tasks are still waiting
+ --      on its entry queues.  The first part of this test mirrors
+ --      that example.  The second part of the test expands upon
+ --      the example code to add an object with finalization code
+ --      to the protected object.  The finalization code should be
+ --      executed after Program_Error is raised in the callers left
+ --      on the entry queues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      08 Jan 96   SAIC    Initial Release for 2.1
+ --      10 Jul 96   SAIC    Incorporated Reviewer comments to fix race 
+ --                          condition.
+ --
+ --!
+ 
+ 
+ with Ada.Finalization;
+ package C940014_0 is
+     Verbose : constant Boolean := False;
+     Finalization_Occurred : Boolean := False;
+ 
+     type Has_Finalization is new Ada.Finalization.Limited_Controlled with
+           record
+              Placeholder : Integer;
+           end record;
+     procedure Finalize (Object : in out Has_Finalization);
+ end C940014_0;
+ 
+ 
+ with Report;
+ with ImpDef;
+ package body C940014_0 is
+     procedure Finalize (Object : in out Has_Finalization) is
+     begin
+ 	delay ImpDef.Clear_Ready_Queue;
+         Finalization_Occurred := True;
+         if Verbose then
+             Report.Comment ("in Finalize");
+         end if;
+     end Finalize;
+ end C940014_0;
+ 
+ 
+ 
+ with Report;
+ with ImpDef;
+ with Ada.Finalization;
+ with C940014_0;
+ 
+ procedure C940014 is
+    Verbose : constant Boolean := C940014_0.Verbose;
+ 
+ begin
+  
+    Report.Test ("C940014", "Check that the finalization of a protected" &
+                            " object results in program_error being raised" &
+                            " at the point of the entry call statement for" &
+                            " any tasks remaining on any entry queue");
+ 
+    First_Check: declare
+        -- example from ARM 9.4(20a-f);6.0 with minor mods
+        task T is
+            entry E;
+        end T;
+        task body T is
+            protected PO is
+                entry Ee;
+            end PO;
+            protected body PO is
+                entry Ee when Report.Ident_Bool (False) is
+                begin
+                    null;
+                end Ee;
+            end PO;
+        begin
+            accept E do
+                 requeue PO.Ee;
+            end E;
+            if Verbose then
+                 Report.Comment ("task about to terminate");
+            end if;
+        end T;
+    begin  -- First_Check
+        begin
+            T.E;
+            delay ImpDef.Clear_Ready_Queue;
+            Report.Failed ("exception not raised in First_Check");
+        exception
+            when Program_Error =>
+                if Verbose then
+                    Report.Comment ("ARM Example passed");
+                end if;
+            when others =>
+                Report.Failed ("wrong exception in First_Check");
+        end;
+    end First_Check;
+  
+ 
+    Second_Check : declare
+       -- here we want to check that the raising of Program_Error
+       -- occurs before the other finalization actions.
+        task T is
+            entry E;
+        end T;
+        task body T is
+            protected PO is
+                entry Ee;
+            private
+                Component : C940014_0.Has_Finalization;
+            end PO;
+            protected body PO is
+                entry Ee when Report.Ident_Bool (False) is
+                begin
+                    null;
+                end Ee;
+            end PO;
+        begin
+            accept E do
+                 requeue PO.Ee;
+            end E;
+            if Verbose then
+                 Report.Comment ("task about to terminate");
+            end if;
+        end T;
+    begin  -- Second_Check
+        T.E;
+        delay ImpDef.Clear_Ready_Queue;
+        Report.Failed ("exception not raised in Second_Check");
+    exception
+        when Program_Error =>
+            if C940014_0.Finalization_Occurred then
+                Report.Failed ("wrong order for finalization");
+            elsif Verbose then
+                Report.Comment ("Second_Check passed");
+            end if;
+        when others =>
+            Report.Failed ("Wrong exception in Second_Check");
+    end Second_Check;
+ 
+ 
+    Report.Result;
+  
+ end C940014;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940015.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940015.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940015.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- C940015.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that the component_declarations of a protected_operation
+ --      are elaborated in the proper order.
+ --
+ -- TEST DESCRIPTION:
+ --      A discriminated protected object is declared with some
+ --      components that depend upon the discriminant and some that
+ --      do not depend upon the discriminant.  All the components
+ --      are initialized with a function call.  As a side-effect of
+ --      the function call the parameter passed to the function is
+ --      recorded in an elaboration order array.  
+ --      Two objects of the protected type are declared.  The 
+ --      elaboration order is recorded and checked against the
+ --      expected order.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      09 Jan 96   SAIC    Initial Version for 2.1
+ --      09 Jul 96   SAIC    Addressed reviewer comments.
+ --      13 Feb 97   PWB.CTA Removed doomed attempt to check per-object
+ --                          constraint elaborations.
+ --!
+ 
+ 
+ with Report;
+ 
+ procedure C940015 is
+     Verbose : constant Boolean := False;
+     Do_Display : Boolean := Verbose;
+      
+     type Index is range 0..10;
+ 
+     type List is array (1..10) of Integer;
+     Last : Natural range 0 .. List'Last := 0;
+     E_List : List := (others => 0);
+ 
+     function Elaborate (Id : Integer) return Index is
+     begin
+         Last := Last + 1;
+         E_List (Last) := Id;
+         if Verbose then
+             Report.Comment ("Elaborating" & Integer'Image (Id));
+         end if;
+         return Index(Id mod 10);
+     end Elaborate;
+ 
+     function Elaborate (Id, Per_Obj_Expr : Integer) return Index is
+     begin
+         return Elaborate (Id);
+     end Elaborate;
+ 
+ begin
+  
+     Report.Test ("C940015", "Check that the component_declarations of a" &
+                             " protected object are elaborated in the" &
+                             " proper order");
+     declare
+         -- an unprotected queue type
+         type Storage is array (Index range <>) of Integer;
+         type Queue (Size, Flag : Index := 1) is
+             record
+                 Head : Index := 1;
+                 Tail : Index := 1;
+                 Count : Index := 0;
+                 Buffer : Storage (1..Size);
+             end record;
+ 
+         -- protected group of queues type
+         protected type Prot_Queues (Size : Index := Elaborate (104)) is 
+             procedure Clear;
+             -- other needed procedures not provided at this time
+         private
+                -- elaborate at type elaboration
+             Fixed_Queue_1    : Queue (3,  
+                                       Elaborate (105));
+                -- elaborate at type elaboration
+             Fixed_Queue_2    : Queue (6,    
+                                       Elaborate (107));
+         end Prot_Queues;
+         protected body Prot_Queues is
+             procedure Clear is
+             begin 
+                 Fixed_Queue_1.Count := 0;
+                 Fixed_Queue_1.Head := 1;
+                 Fixed_Queue_1.Tail := 1;
+                 Fixed_Queue_2.Count := 0;
+                 Fixed_Queue_2.Head := 1;
+                 Fixed_Queue_2.Tail := 1;
+             end Clear;
+         end Prot_Queues;
+           
+         PO1 : Prot_Queues(9);
+         PO2 : Prot_Queues;
+ 
+         Expected_Elab_Order : List := (
+            -- from the elaboration of the protected type Prot_Queues
+            105, 107,
+            -- from the unconstrained object PO2
+            104,
+            others => 0);
+     begin
+         for I in List'Range loop
+             if E_List (I) /= Expected_Elab_Order (I) then
+                 Report.Failed ("wrong elaboration order"); 
+                 Do_Display := True;
+             end if;
+         end loop;
+         if Do_Display then
+             Report.Comment ("Expected  Actual");
+             for I in List'Range loop
+                 Report.Comment (
+                    Integer'Image (Expected_Elab_Order(I)) &
+                    Integer'Image (E_List(I)));
+             end loop;
+         end if;
+ 
+         -- make use of the protected objects
+         PO1.Clear;
+         PO2.Clear;
+     end;
+ 
+     Report.Result;
+  
+ end C940015;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940016.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940016.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940016.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,211 ----
+ -- C940016.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that an Unchecked_Deallocation of a protected object
+ --      performs the required finalization on the protected object.
+ --
+ -- TEST DESCRIPTION:
+ --      Test that finalization takes place when an Unchecked_Deallocation
+ --      deallocates a protected object with queued callers. 
+ --      Try protected objects that have no other finalization code and
+ --      protected objects with user defined finalization.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      16 Jan 96   SAIC    ACVC 2.1
+ --      10 Jul 96   SAIC    Fixed race condition noted by reviewers.
+ --
+ --!
+ 
+ 
+ with Ada.Finalization;
+ package C940016_0 is
+     Verbose : constant Boolean := False;
+     Finalization_Occurred : Boolean := False;
+ 
+     type Has_Finalization is new Ada.Finalization.Limited_Controlled with
+           record
+              Placeholder : Integer;
+           end record;
+     procedure Finalize (Object : in out Has_Finalization);
+ end C940016_0;
+ 
+ 
+ with Report;
+ with ImpDef;
+ package body C940016_0 is
+     procedure Finalize (Object : in out Has_Finalization) is
+     begin
+ 	delay ImpDef.Clear_Ready_Queue;
+         Finalization_Occurred := True;
+         if Verbose then
+             Report.Comment ("in Finalize");
+         end if;
+     end Finalize;
+ end C940016_0;
+ 
+ 
+ 
+ with Report;
+ with Ada.Finalization;
+ with C940016_0;
+ with Ada.Unchecked_Deallocation;
+ with ImpDef;
+ 
+ procedure C940016 is
+    Verbose : constant Boolean := C940016_0.Verbose;
+ 
+ begin
+  
+    Report.Test ("C940016", "Check that Unchecked_Deallocation of a" &
+                            " protected object finalizes the" &
+                            " protected object");
+ 
+    First_Check: declare
+        protected type Semaphore is
+            entry Wait;
+            procedure Signal;
+        private
+            Count : Integer := 0;
+        end Semaphore;
+        protected body Semaphore is
+            entry Wait when Count > 0 is
+            begin
+                Count := Count - 1;
+            end Wait;
+ 
+            procedure Signal is
+            begin
+               Count := Count + 1;
+            end Signal;
+        end Semaphore;
+ 
+        type pSem is access Semaphore;
+        procedure Zap_Semaphore is new 
+            Ada.Unchecked_Deallocation (Semaphore, pSem);
+        Sem_Ptr : pSem := new Semaphore;
+ 
+        -- positive confirmation that Blocker got the exception
+        Ok : Boolean := False;
+ 
+        task Blocker;
+ 
+        task body Blocker is
+        begin
+            Sem_Ptr.Wait;
+            Report.Failed ("Program_Error not raised in waiting task");
+        exception
+            when Program_Error =>
+                Ok := True;
+                if Verbose then
+                    Report.Comment ("Blocker received Program_Error");
+                end if;
+            when others =>
+                Report.Failed ("Wrong exception in Blocker");
+        end Blocker;
+ 
+    begin  -- First_Check
+        -- wait for Blocker to get blocked on the semaphore
+        delay ImpDef.Clear_Ready_Queue;
+        Zap_Semaphore (Sem_Ptr);
+        -- make sure Blocker has time to complete
+        delay ImpDef.Clear_Ready_Queue * 2;
+        if not Ok then
+            Report.Failed ("finalization not properly performed");
+            -- Blocker is probably hung so kill it
+            abort Blocker;
+        end if;
+    end First_Check;
+  
+ 
+    Second_Check : declare
+       -- here we want to check that the raising of Program_Error
+       -- occurs before the other finalization actions.
+        protected type Semaphore is
+            entry Wait;
+            procedure Signal;
+        private
+            Count : Integer := 0;
+            Component : C940016_0.Has_Finalization;
+        end Semaphore;
+        protected body Semaphore is
+            entry Wait when Count > 0 is
+            begin
+                Count := Count - 1;
+            end Wait;
+ 
+            procedure Signal is
+            begin
+               Count := Count + 1;
+            end Signal;
+        end Semaphore;
+ 
+        type pSem is access Semaphore;
+        procedure Zap_Semaphore is new 
+            Ada.Unchecked_Deallocation (Semaphore, pSem);
+        Sem_Ptr : pSem := new Semaphore;
+ 
+        -- positive confirmation that Blocker got the exception
+        Ok : Boolean := False;
+ 
+        task Blocker;
+ 
+        task body Blocker is
+        begin
+            Sem_Ptr.Wait;
+            Report.Failed ("Program_Error not raised in waiting task 2");
+        exception
+            when Program_Error =>
+                Ok := True;
+                if C940016_0.Finalization_Occurred then
+                    Report.Failed ("wrong order for finalization 2");
+                elsif Verbose then
+                    Report.Comment ("Blocker received Program_Error 2");
+                end if;
+            when others =>
+                Report.Failed ("Wrong exception in Blocker 2");
+        end Blocker;
+ 
+    begin  -- Second_Check
+        -- wait for Blocker to get blocked on the semaphore
+        delay ImpDef.Clear_Ready_Queue;
+        Zap_Semaphore (Sem_Ptr);
+        -- make sure Blocker has time to complete
+        delay ImpDef.Clear_Ready_Queue * 2;
+        if not Ok then
+            Report.Failed ("finalization not properly performed 2");
+            -- Blocker is probably hung so kill it
+            abort Blocker;
+        end if;
+        if not C940016_0.Finalization_Occurred then
+            Report.Failed ("user defined finalization didn't happen");
+        end if;
+    end Second_Check;
+  
+ 
+    Report.Result;
+  
+ end C940016;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,259 ----
+ -- C94001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A UNIT WITH DEPENDENT TASKS CREATED BY OBJECT
+ --   DECLARATIONS IS NOT TERMINATED UNTIL ALL DEPENDENT TASKS BECOME
+ --   TERMINATED.
+ -- SUBTESTS ARE:
+ --   (A, B)  A SIMPLE TASK OBJECT, IN A BLOCK.
+ --   (C, D)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+ --   (E, F)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+ 
+ -- JRK 10/2/81
+ -- SPS 11/21/82
+ -- JRK 11/29/82
+ -- TBN  8/22/86     REVISED; ADDED CASES THAT EXIT BY RAISING AN
+ --                  EXCEPTION.
+ -- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94001A IS
+ 
+      MY_EXCEPTION : EXCEPTION;
+      GLOBAL : INTEGER;
+ 
+      TASK TYPE TT IS
+           ENTRY E (I : INTEGER);
+      END TT;
+ 
+      TASK BODY TT IS
+           LOCAL : INTEGER;
+      BEGIN
+           ACCEPT E (I : INTEGER) DO
+                LOCAL := I;
+           END E;
+           DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
+                          -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
+                          -- TERMINATE IF THE ERROR IS PRESENT.
+           GLOBAL := LOCAL;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C94001A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
+                       "CREATED BY OBJECT DECLARATIONS IS NOT " &
+                       "TERMINATED UNTIL ALL DEPENDENT TASKS " &
+                       "BECOME TERMINATED");
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (A)
+ 
+           T : TT;
+ 
+      BEGIN -- (A)
+ 
+           T.E (IDENT_INT(1));
+ 
+      END; -- (A)
+ 
+      IF GLOBAL /= 1 THEN
+           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                   "BLOCK EXIT - 1");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      BEGIN -- (B)
+           DECLARE
+                T : TT;
+           BEGIN
+                T.E (IDENT_INT(1));
+                RAISE MY_EXCEPTION;
+           END;
+ 
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 1 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "BLOCK EXIT - 2");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - 2");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                A : ARRAY (1..1) OF TT;
+           BEGIN
+                A(1).E (IDENT_INT(2));
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (C)
+ 
+           I := F;
+ 
+           IF GLOBAL /= 2 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "FUNCTION EXIT - 3");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (D)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                A : ARRAY (1..1) OF TT;
+           BEGIN
+                A(1).E (IDENT_INT(2));
+                IF EQUAL (3, 3) THEN
+                     RAISE MY_EXCEPTION;
+                END IF;
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (D)
+           I := F;
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 2 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "FUNCTION EXIT - 4");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - 4");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (E)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                AR : ARRAY (1..1) OF RT;
+           BEGIN
+                AR(1).T.E (IDENT_INT(3));
+           END TSK;
+ 
+      BEGIN -- (E)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 1.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                        "HOUR - 5");
+           ELSIF GLOBAL /= 3 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "TASK EXIT - 5");
+           END IF;
+ 
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (F)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                AR : ARRAY (1..1) OF RT;
+           BEGIN
+                AR(1).T.E (IDENT_INT(3));
+                IF EQUAL (3, 3) THEN
+                     RAISE MY_EXCEPTION;
+                END IF;
+                FAILED ("EXCEPTION WAS NOT RAISED - 6");
+           END TSK;
+ 
+      BEGIN -- (F)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 1.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                        "HOUR - 6");
+           ELSIF GLOBAL /= 3 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "TASK EXIT - 6");
+           END IF;
+ 
+      END; -- (F)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C94001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,268 ----
+ -- C94001B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A UNIT WITH DEPENDENT TASKS CREATED BY AN OBJECT
+ -- DECLARATION OF LIMITED PRIVATE TYPE IS NOT TERMINATED UNTIL ALL
+ -- DEPENDENT TASKS BECOME TERMINATED.
+ -- SUBTESTS ARE:
+ --   (A, B)  A SIMPLE TASK OBJECT, IN A BLOCK.
+ --   (C, D)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+ --   (E, F)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+ 
+ -- TBN  8/22/86
+ -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94001B IS
+ 
+      PACKAGE P IS
+           MY_EXCEPTION : EXCEPTION;
+           GLOBAL : INTEGER;
+           TYPE TT IS LIMITED PRIVATE;
+           PROCEDURE CALL_ENTRY (A : TT; B : INTEGER);
+      PRIVATE
+           TASK TYPE TT IS
+                ENTRY E (I : INTEGER);
+           END TT;
+      END P;
+ 
+      PACKAGE BODY P IS
+ 
+           PROCEDURE CALL_ENTRY (A : TT; B : INTEGER) IS
+           BEGIN
+                A.E (B);
+           END CALL_ENTRY;
+ 
+           TASK BODY TT IS
+                LOCAL : INTEGER;
+           BEGIN
+                ACCEPT E (I : INTEGER) DO
+                     LOCAL := I;
+                END E;
+                DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER
+                               -- PRIORITY AT THIS POINT, IT WILL
+                               -- RECEIVE CONTROL AND TERMINATE IF
+                               -- THE ERROR IS PRESENT.
+                GLOBAL := LOCAL;
+           END TT;
+      END P;
+ 
+      USE P;
+ 
+ 
+ BEGIN
+      TEST ("C94001B", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
+                       "CREATED BY AN OBJECT DECLARATION OF LIMITED " &
+                       "PRIVATE TYPE IS NOT TERMINATED UNTIL ALL " &
+                       "DEPENDENT TASKS BECOME TERMINATED");
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (A)
+ 
+           T : TT;
+ 
+      BEGIN -- (A)
+ 
+           CALL_ENTRY (T, IDENT_INT(1));
+ 
+      END; -- (A)
+ 
+      IF GLOBAL /= 1 THEN
+           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                   "BLOCK EXIT - 1");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      BEGIN -- (B)
+           DECLARE
+                T : TT;
+           BEGIN
+                CALL_ENTRY (T, IDENT_INT(2));
+                RAISE MY_EXCEPTION;
+           END;
+ 
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 2 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "BLOCK EXIT - 2");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - 2");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                A : ARRAY (1..1) OF TT;
+           BEGIN
+                CALL_ENTRY (A(1), IDENT_INT(3));
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (C)
+ 
+           I := F;
+ 
+           IF GLOBAL /= 3 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "FUNCTION EXIT - 3");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (D)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                A : ARRAY (1..1) OF TT;
+           BEGIN
+                CALL_ENTRY (A(1), IDENT_INT(4));
+                IF EQUAL (3, 3) THEN
+                     RAISE MY_EXCEPTION;
+                END IF;
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (D)
+           I := F;
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 4 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "FUNCTION EXIT - 4");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - 4");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (E)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                AR : ARRAY (1..1) OF RT;
+           BEGIN
+                CALL_ENTRY (AR(1).T, IDENT_INT(5));
+           END TSK;
+ 
+      BEGIN -- (E)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 1.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                        "HOUR - 5");
+           ELSIF GLOBAL /= 5 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "TASK EXIT - 5");
+           END IF;
+ 
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (F)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                AR : ARRAY (1..1) OF RT;
+           BEGIN
+                CALL_ENTRY (AR(1).T, IDENT_INT(6));
+                IF EQUAL (3, 3) THEN
+                     RAISE MY_EXCEPTION;
+                END IF;
+                FAILED ("EXCEPTION WAS NOT RAISED - 6");
+           END TSK;
+ 
+      BEGIN -- (F)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 1.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                        "HOUR - 6");
+           ELSIF GLOBAL /= 6 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "TASK EXIT - 6");
+           END IF;
+ 
+      END; -- (F)
+ 
+      RESULT;
+ END C94001B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- C94001C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A UNIT WITH INDIRECT DEPENDENT TASKS CREATED BY OBJECT
+ -- DECLARATIONS IS NOT TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS
+ -- BECOME TERMINATED.
+ -- SUBTESTS ARE:
+ --   (A, B)  A BLOCK CONTAINING A SIMPLE TASK OBJECT, IN A BLOCK.
+ --   (C, D)  A FUNCTION CONTAINING AN ARRAY OF TASK OBJECT, IN A
+ --           FUNCTION.
+ --   (E, F)  A TASK CONTAINING AN ARRAY OF RECORD OF TASK OBJECT,
+ --           IN A TASK BODY.
+ --   CASES (B, D, F) EXIT BY RAISING AN EXCEPTION.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+ 
+ -- TBN  8/25/86
+ -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94001C IS
+ 
+      MY_EXCEPTION : EXCEPTION;
+      GLOBAL : INTEGER;
+ 
+      TASK TYPE TT IS
+           ENTRY E (I : INTEGER);
+      END TT;
+ 
+      TASK BODY TT IS
+           LOCAL : INTEGER;
+      BEGIN
+           ACCEPT E (I : INTEGER) DO
+                LOCAL := I;
+           END E;
+           DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
+                          -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
+                          -- TERMINATE IF THE ERROR IS PRESENT.
+           GLOBAL := LOCAL;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C94001C", "CHECK THAT A UNIT WITH INDIRECT DEPENDENT " &
+                       "TASKS CREATED BY OBJECT DECLARATIONS IS NOT " &
+                       "TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS " &
+                       "BECOME TERMINATED");
+ 
+      --------------------------------------------------
+      GLOBAL := IDENT_INT (0);
+ 
+      BEGIN -- (A)
+ 
+           DECLARE
+                T : TT;
+           BEGIN
+                T.E (IDENT_INT(1));
+           END;
+ 
+      END; -- (A)
+ 
+      IF GLOBAL /= 1 THEN
+           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                   "BLOCK EXIT - 1");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      BEGIN -- (B)
+           GLOBAL := IDENT_INT (0);
+ 
+           BEGIN
+                DECLARE
+                     T : TT;
+                BEGIN
+                     T.E (IDENT_INT(2));
+                     RAISE MY_EXCEPTION;
+                END;
+           END;
+ 
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 2 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "BLOCK EXIT - 2");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - 2");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C)
+ 
+           OBJ_INT : INTEGER;
+ 
+           FUNCTION F1 RETURN INTEGER IS
+                I : INTEGER;
+ 
+                FUNCTION F2 RETURN INTEGER IS
+                     A : ARRAY (1..1) OF TT;
+                BEGIN
+                     A(1).E (IDENT_INT(3));
+                     RETURN 0;
+                END F2;
+           BEGIN
+                I := F2;
+                RETURN (0);
+           END F1;
+ 
+      BEGIN -- (C)
+           OBJ_INT := F1;
+           IF GLOBAL /= 3 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "FUNCTION EXIT - 3");
+           END IF;
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           OBJ_INT : INTEGER;
+ 
+           FUNCTION F1 RETURN INTEGER IS
+                I : INTEGER;
+ 
+                FUNCTION F2 RETURN INTEGER IS
+                     A : ARRAY (1..1) OF TT;
+                BEGIN
+                     A(1).E (IDENT_INT(4));
+                     IF EQUAL (3, 3) THEN
+                          RAISE MY_EXCEPTION;
+                     END IF;
+                     RETURN 0;
+                END F2;
+           BEGIN
+                I := F2;
+                RETURN (0);
+           END F1;
+ 
+      BEGIN -- (D)
+           GLOBAL := IDENT_INT (0);
+           OBJ_INT := F1;
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 4 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "FUNCTION EXIT - 4");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - 4");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (E)
+           DELAY_COUNT : INTEGER := 0;
+           TASK OUT_TSK;
+ 
+           TASK BODY OUT_TSK IS
+ 
+                TASK TSK IS
+                     ENTRY ENT;
+                END TSK;
+ 
+                TASK BODY TSK IS
+                     TYPE RT IS
+                          RECORD
+                               T : TT;
+                          END RECORD;
+                     AR : ARRAY (1..1) OF RT;
+                BEGIN
+                     AR(1).T.E (IDENT_INT(5));
+                END TSK;
+ 
+           BEGIN
+                NULL;
+           END OUT_TSK;
+ 
+      BEGIN -- (E)
+           WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
+                DELAY 1.0 * Impdef.One_Long_Second;
+                DELAY_COUNT := DELAY_COUNT + 1;
+           END LOOP;
+           IF DELAY_COUNT = 60 THEN
+                FAILED ("OUT_TSK HAS NOT TERMINATED - 5");
+           ELSIF GLOBAL /= 5 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "BLOCK EXIT - 5");
+           END IF;
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE
+           DELAY_COUNT : INTEGER := 0;
+ 
+           TASK OUT_TSK;
+      
+           TASK BODY OUT_TSK IS
+ 
+                TASK TSK IS
+                     ENTRY ENT;
+                END TSK;
+ 
+                TASK BODY TSK IS
+                     TYPE RT IS
+                          RECORD
+                               T : TT;
+                          END RECORD;
+                     AR : ARRAY (1..1) OF RT;
+                BEGIN
+                     AR(1).T.E (IDENT_INT(6));
+                     RAISE MY_EXCEPTION;
+                END TSK;
+ 
+           BEGIN
+                RAISE MY_EXCEPTION;
+           END OUT_TSK;
+ 
+      BEGIN
+           WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
+                DELAY 1.0 * Impdef.One_Long_Second;
+                DELAY_COUNT := DELAY_COUNT + 1;
+           END LOOP;
+           IF DELAY_COUNT = 60 THEN
+                FAILED ("OUT_TSK HAS NOT TERMINATED - 6");
+           ELSIF GLOBAL /= 6 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "BLOCK EXIT - 6");
+           END IF;
+      END;
+ 
+      RESULT;
+ END C94001C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C94001E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK IS ALSO COMPLETED IF AN EXCEPTION IS RAISED BY
+ -- THE EXECUTION OF ITS SEQUENCE OF STATEMENTS.
+ -- THIS MUST HOLD FOR BOTH CASES WHERE A HANDLER IS PRESENT OR NOT.
+ --    VERSION WITH EXCEPTION HANDLER.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C940AGA-B.ADA
+ -- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C94001E IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+ BEGIN
+ 
+      TEST ("C94001E", "TASK COMPLETION BY EXCEPTION");
+ 
+ BLOCK:
+      DECLARE
+ 
+           TASK T1;
+ 
+           TASK BODY T1 IS
+                TYPE I1 IS RANGE 0 .. 1;
+                OBJ_I1 : I1;
+           BEGIN
+                OBJ_I1 := I1(IDENT_INT(2));  -- CONSTRAINT_ERROR.
+                IF OBJ_I1 /= I1(IDENT_INT(0)) THEN
+                   PSPY_NUMB (1);
+                ELSE
+                   PSPY_NUMB (2);
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+                WHEN OTHERS => FAILED ("OTHER EXCEPTION RAISED");
+           END T1;
+ 
+      BEGIN
+           NULL;
+      END BLOCK;
+ 
+      IF SPYNUMB /= 0 THEN
+           FAILED ("TASK T1 NOT COMPLETED AFTER EXCEPTION");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C94001E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- C94001F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK IS ALSO COMPLETED IF AN EXCEPTION IS RAISED BY
+ -- THE EXECUTION OF ITS SEQUENCE OF STATEMENTS.
+ -- THIS MUST HOLD FOR BOTH CASES WHERE A HANDLER IS PRESENT OR NOT.
+ --   VERSION WITHOUT EXCEPTION HANDLER.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C940AGB-B.ADA
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C94001F IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+ BEGIN
+ 
+      TEST ("C94001F", "TASK COMPLETION BY EXCEPTION -- NO HANDLER");
+ 
+ BLOCK:
+      DECLARE
+ 
+           TASK T1;
+ 
+           TASK BODY T1 IS
+                TYPE I1 IS RANGE 0 .. 1;
+                OBJ_I1 : I1;
+           BEGIN
+                OBJ_I1 := I1(IDENT_INT(2));  -- CONSTRAINT_ERROR.
+                PSPY_NUMB (1);
+           END T1;
+ 
+      BEGIN
+           NULL;          -- WAIT FOR TERMINATION.
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("PROPAGATED CONSTRAINT_ERROR OUT OF TASK");
+           WHEN TASKING_ERROR =>
+                FAILED ("RAISED TASKING_ERROR");
+           WHEN OTHERS =>
+                FAILED ("RAISED OTHER EXCEPTION");
+      END BLOCK;
+ 
+      IF SPYNUMB /= 0 THEN
+           FAILED ("TASK T1 NOT COMPLETED AFTER EXCEPTION IN SEQUENCE " &
+                   "OF STATEMENTS");
+      END IF;
+ 
+      RESULT;
+ 
+ END C94001F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94001g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94001g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C94001G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A COMPLETED TASK WITH DEPENDENT TASKS TERMINATES WHEN
+ -- A L L  DEPENDENT TASKS HAVE TERMINATED.
+ 
+ -- WEI  3/ 4/82
+ -- JBG 4/2/84
+ -- JWC 6/28/85   RENAMED FROM C940AIA-B.ADA
+ 
+ with Impdef;
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C94001G IS
+ 
+      PACKAGE SPY IS      -- PROVIDE PROTECTED ACCESS TO SPYNUMB
+           SUBTYPE ARG IS NATURAL RANGE 0..9;
+           FUNCTION SPYNUMB RETURN NATURAL;                      -- READ
+           FUNCTION FINIT_POS (DIGT : IN ARG) RETURN NATURAL;    -- WRITE
+           PROCEDURE PSPY_NUMB (DIGT : IN ARG);                  -- WRITE
+      END SPY;
+ 
+      USE SPY;
+ 
+      PACKAGE BODY SPY IS
+ 
+           TASK GUARD IS
+                ENTRY READ  (NUMB : OUT NATURAL);
+                ENTRY WRITE (NUMB : IN NATURAL);
+           END GUARD;
+ 
+           TASK BODY GUARD IS
+                SPYNUMB : NATURAL := 0;
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT READ (NUMB : OUT NATURAL) DO
+                               NUMB := SPYNUMB;
+                          END READ;
+                     OR   ACCEPT WRITE (NUMB : IN NATURAL) DO
+                               SPYNUMB := 10*SPYNUMB+NUMB;
+                          END WRITE;
+                     OR   TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END GUARD;
+ 
+           FUNCTION SPYNUMB RETURN NATURAL IS
+                TEMP : NATURAL;
+           BEGIN
+                GUARD.READ (TEMP);
+                RETURN TEMP;
+           END SPYNUMB;
+ 
+           FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+           BEGIN
+                GUARD.WRITE (DIGT);
+                RETURN DIGT;
+           END FINIT_POS;
+ 
+           PROCEDURE PSPY_NUMB (DIGT : IN ARG) IS
+           BEGIN
+                GUARD.WRITE (DIGT);
+           END PSPY_NUMB;
+      END SPY;
+ 
+ BEGIN
+      TEST ("C94001G", "TERMINATION WHEN ALL DEPENDENT TASKS " &
+                       "HAVE TERMINATED");
+ 
+ BLOCK:
+      DECLARE
+ 
+           TASK TYPE TT1;
+ 
+           TASK BODY TT1 IS
+           BEGIN
+                DELAY 1.0 * Impdef.One_Second;
+                PSPY_NUMB (1);
+           END TT1;
+ 
+           TASK T1 IS
+           END T1;
+ 
+           TASK BODY T1 IS
+                OBJ_TT1_1, OBJ_TT1_2, OBJ_TT1_3 : TT1;
+           BEGIN
+                NULL;
+           END T1;
+ 
+      BEGIN
+           NULL;
+      END BLOCK;               -- WAIT HERE FOR TERMINATION.
+ 
+      IF SPYNUMB /= 111 THEN
+           FAILED ("TASK T1 TERMINATED BEFORE " &
+                   "ALL DEPENDENT TASKS HAVE TERMINATED");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C94001G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,331 ----
+ -- C94002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A UNIT WITH DEPENDENT TASKS CREATED BY (LOCAL)
+ --   ALLOCATORS DOES NOT TERMINATE UNTIL ALL DEPENDENT TASKS ARE
+ --   TERMINATED.
+ -- SUBTESTS ARE:
+ --   (A, B)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+ --   (C, D)  A RECORD OF TASK ALLOCATOR, IN A FUNCTION.
+ --   (E, F)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+ 
+ -- JRK 10/2/81
+ -- SPS 11/2/82
+ -- SPS 11/21/82
+ -- JRK 11/29/82
+ -- TBN  8/25/86     REDUCED DELAYS; ADDED LIMITED PRIVATE TYPES; 
+ --                  INCLUDED EXITS BY RAISING AN EXCEPTION.
+ -- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94002A IS
+ 
+      PACKAGE P IS
+           MY_EXCEPTION : EXCEPTION;
+           GLOBAL : INTEGER;
+           TASK TYPE T1 IS
+                ENTRY E (I : INTEGER);
+           END T1;
+           TYPE T2 IS LIMITED PRIVATE;
+           PROCEDURE CALL_ENTRY (A : T2; B : INTEGER);
+      PRIVATE
+           TASK TYPE T2 IS
+                ENTRY E (I : INTEGER);
+           END T2;
+      END P;
+ 
+      PACKAGE BODY P IS
+           TASK BODY T1 IS
+                LOCAL : INTEGER;
+           BEGIN
+                ACCEPT E (I : INTEGER) DO
+                     LOCAL := I;
+                END E;
+                DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER
+                               -- PRIORITY AT THIS POINT, IT WILL
+                               -- RECEIVE CONTROL AND TERMINATE IF
+                               -- THE ERROR IS PRESENT.
+                GLOBAL := LOCAL;
+           END T1;
+ 
+           TASK BODY T2 IS
+                LOCAL : INTEGER;
+           BEGIN
+                ACCEPT E (I : INTEGER) DO
+                     LOCAL := I;
+                END E;
+                DELAY 30.0 * Impdef.One_Second;
+                GLOBAL := LOCAL;
+           END T2;
+ 
+           PROCEDURE CALL_ENTRY (A : T2; B : INTEGER) IS
+           BEGIN
+                A.E (B);
+           END CALL_ENTRY;
+      END P;
+ 
+      USE P;
+ 
+ 
+ BEGIN
+      TEST ("C94002A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
+                       "CREATED BY (LOCAL) ALLOCATORS DOES NOT " &
+                       "TERMINATE UNTIL ALL DEPENDENT TASKS " &
+                       "ARE TERMINATED");
+ 
+      --------------------------------------------------
+      GLOBAL := IDENT_INT (0);
+      BEGIN -- (A)
+           DECLARE
+                TYPE A_T IS ACCESS T1;
+                A : A_T;
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     A := NEW T1;
+                     A.ALL.E (IDENT_INT(1));
+                     RAISE MY_EXCEPTION;
+                END IF;
+           END;
+ 
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 1");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 1 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "BLOCK EXIT - 1");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (B)
+           TYPE A_T IS ACCESS T2;
+           A : A_T;
+      BEGIN -- (B)
+           IF EQUAL (3, 3) THEN
+                A := NEW T2;
+                CALL_ENTRY (A.ALL, IDENT_INT(2));
+           END IF;
+      END; -- (B)
+ 
+      IF GLOBAL /= 2 THEN
+           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                   "BLOCK EXIT - 2");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C)
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                TYPE RT;
+                TYPE ART IS ACCESS RT;
+                TYPE RT IS
+                     RECORD
+                          A : ART;
+                          T : T1;
+                     END RECORD;
+                LIST : ART;
+                TEMP : ART;
+           BEGIN
+                FOR I IN 1 .. IDENT_INT (1) LOOP
+                     TEMP := NEW RT;
+                     TEMP.A := LIST;
+                     LIST := TEMP;
+                     LIST.T.E (IDENT_INT(3));
+                END LOOP;
+                RETURN 0;
+           END F;
+      BEGIN -- (C)
+           I := F;
+ 
+           IF GLOBAL /= 3 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "FUNCTION EXIT - 3");
+           END IF;
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (D)
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+                TYPE RT;
+                TYPE ART IS ACCESS RT;
+                TYPE RT IS
+                     RECORD
+                          A : ART;
+                          T : T2;
+                     END RECORD;
+                LIST : ART;
+                TEMP : ART;
+           BEGIN
+                FOR I IN 1 .. IDENT_INT (1) LOOP
+                     TEMP := NEW RT;
+                     TEMP.A := LIST;
+                     LIST := TEMP;
+                     CALL_ENTRY (LIST.T, IDENT_INT(4));
+                     IF EQUAL (3, 3) THEN
+                          RAISE MY_EXCEPTION;
+                     END IF;
+                END LOOP;
+                RETURN 0;
+           END F;
+      BEGIN -- (D)
+           I := F;
+ 
+           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL /= 4 THEN
+                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                             "FUNCTION EXIT - 4");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (E)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+                TYPE ARR IS ARRAY (1..1) OF T1;
+                TYPE RAT;
+                TYPE ARAT IS ACCESS RAT;
+                TYPE RAT IS
+                     RECORD
+                          A : ARAT;
+                          T : ARR;
+                     END RECORD;
+                LIST : ARAT;
+                TEMP : ARAT;
+           BEGIN
+                FOR I IN 1 .. IDENT_INT (1) LOOP
+                     TEMP := NEW RAT;
+                     TEMP.A := LIST;
+                     LIST := TEMP;
+                     LIST.T(1).E (IDENT_INT(5));
+                     IF EQUAL (3, 3) THEN
+                          RAISE MY_EXCEPTION;
+                     END IF;
+                END LOOP;
+           END TSK;
+ 
+      BEGIN -- (E)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 1.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
+                        "MINUTES - 5");
+           END IF;
+ 
+           IF GLOBAL /= 5 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "TASK EXIT - 5");
+           END IF;
+ 
+      END; -- (E)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (F)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+                TYPE ARR IS ARRAY (1..1) OF T2;
+                TYPE RAT;
+                TYPE ARAT IS ACCESS RAT;
+                TYPE RAT IS
+                     RECORD
+                          A : ARAT;
+                          T : ARR;
+                     END RECORD;
+                LIST : ARAT;
+                TEMP : ARAT;
+           BEGIN
+                FOR I IN 1 .. IDENT_INT (1) LOOP
+                     TEMP := NEW RAT;
+                     TEMP.A := LIST;
+                     LIST := TEMP;
+                     CALL_ENTRY (LIST.T(1), IDENT_INT(6));
+                END LOOP;
+           END TSK;
+ 
+      BEGIN -- (F)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 1.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
+                        "MINUTES - 6");
+           END IF;
+ 
+           IF GLOBAL /= 6 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "TASK EXIT - 6");
+           END IF;
+ 
+      END; -- (F)
+ 
+      RESULT;
+ END C94002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,208 ----
+ -- C94002B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL ACCESS
+ --   TYPE MAY TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS TO
+ --   TERMINATE.
+ 
+ -- SUBTESTS ARE:
+ --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+ --   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+ --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+ 
+ -- JRK 10/8/81
+ -- SPS 11/2/82
+ -- SPS 11/21/82
+ -- JRK 11/29/82
+ -- TBN 1/20/86     REPLACED WITH C94006A-B.ADA AFTER LOWERING THE DELAY
+ --                 VALUES, AND MODIFYING THE COMMENTS.
+ -- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94002B IS
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+      BEGIN
+           ACCEPT E;
+           ACCEPT E;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C94002B", "CHECK THAT A MASTER UNIT, WHICH ALLOCATES " &
+                       "TASKS OF A GLOBAL ACCESS TYPE MAY TERMINATE " &
+                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                       "TERMINATE");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           TYPE A_T IS ACCESS TT;
+           A1 : A_T;
+ 
+      BEGIN -- (A)
+ 
+           DECLARE
+                A2 : A_T;
+           BEGIN
+                A2 := NEW TT;
+                A2.ALL.E;
+                A1 := A2;
+           END;
+ 
+           IF A1.ALL'TERMINATED THEN
+                FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
+           END IF;
+ 
+           A1.ALL.E;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+ 
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                TYPE ART IS ACCESS RT;
+                AR1 : ART;
+ 
+                PROCEDURE P (AR : OUT ART) IS
+                     AR2 : ART;
+                BEGIN
+                     AR2 := NEW RT;
+                     AR2.T.E;
+                     AR := AR2;
+                END P;
+ 
+           BEGIN
+                P (AR1);
+ 
+                IF AR1.T'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                             "- (B)");
+                END IF;
+ 
+                AR1.T.E;
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           I := F;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60;                -- DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+ 
+                LOOP_COUNT1 : INTEGER := 0;
+                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+ 
+                TYPE RAT;
+                TYPE ARAT IS ACCESS RAT;
+                TYPE ARR IS ARRAY (1..1) OF TT;
+                TYPE RAT IS
+                     RECORD
+                          A : ARAT;
+                          T : ARR;
+                     END RECORD;
+                ARA1 : ARAT;
+ 
+                TASK TSK1 IS
+                     ENTRY ENT1 (ARA : OUT ARAT);
+                END TSK1;
+ 
+                TASK BODY TSK1 IS
+                     ARA2 : ARAT;
+                BEGIN
+                     ARA2 := NEW RAT;
+                     ARA2.T(1).E;
+                     ACCEPT ENT1 (ARA : OUT ARAT) DO
+                          ARA := ARA2;
+                     END ENT1;
+                END TSK1;
+ 
+           BEGIN
+                TSK1.ENT1 (ARA1);
+ 
+                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
+                END LOOP;
+ 
+                IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                             "WITHIN ONE MINUTE - (C)");
+                END IF;
+ 
+                IF ARA1.T(1)'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                             "- (C)");
+                END IF;
+ 
+                ARA1.T(1).E;
+           END TSK;
+ 
+      BEGIN -- (C)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 2.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                        "TWO MINUTES - (C)");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C94002B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C94002D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK DOES  N O T  DEPEND ON A UNIT IF IT IS DESIGNATED
+ -- BY A LOCAL ACCESS VARIABLE (OF THIS UNIT) WHOSE TYPE IS DECLARED
+ -- OUTSIDE THIS UNIT.
+ 
+ -- WEI  3/ 4/82
+ -- JBG 2/20/84
+ -- TBN 11/25/85     RENAMED FROM C940ACB-B.ADA.
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C94002D IS
+ 
+      TASK TYPE TT1 IS
+           ENTRY E1;
+           ENTRY E2;
+      END TT1;
+ 
+      TYPE ATT1 IS ACCESS TT1;
+      OUTER_TT1 : ATT1;
+ 
+      TASK BODY TT1 IS
+      BEGIN
+           ACCEPT E1;
+           ACCEPT E2;
+      END TT1;
+ 
+ BEGIN
+      TEST ("C94002D", "DEPENDENCY IS INDEPENDENT OF WHERE ACCESS " &
+                       "VARIABLE IS DECLARED");
+ 
+ BLOCK1 :
+      DECLARE
+           POINTER_TT1 : ATT1 := NEW TT1;
+      BEGIN
+           OUTER_TT1 := POINTER_TT1;
+           POINTER_TT1.ALL.E1;
+      END BLOCK1;         -- MAY DEADLOCK HERE IF INCORRECT DEPENDENCY
+                          -- RULE IS IMPLEMENTED.
+ 
+      IF OUTER_TT1.ALL'TERMINATED THEN
+           FAILED ("NON-DEPENDENT TASK IS TERMINATED " &
+                   "IMMEDIATELY AFTER ENCLOSING UNIT HAS " &
+                   "BEEN COMPLETED");
+      END IF;
+ 
+      OUTER_TT1.E2;       -- RELEASE TASK
+ 
+      RESULT;
+ 
+ END C94002D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,207 ----
+ -- C94002E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
+ --   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
+ --   TO TERMINATE.
+ 
+ -- SUBTESTS ARE:
+ --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+ --   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+ --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+ 
+ -- JRK 10/8/81
+ -- SPS 11/2/82
+ -- SPS 11/21/82
+ -- JRK 11/29/82
+ -- TBN 1/20/86     RENAMED FROM C94006A-B.ADA.  LOWERED THE DELAY VALUES
+ --                 AND MODIFIED THE COMMENTS.
+ -- JRK 5/1/86      IMPROVED ERROR RECOVERY LOGIC.
+ -- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94002E IS
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+      BEGIN
+           ACCEPT E;
+           ACCEPT E;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C94002E", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
+                       "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
+                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                       "TERMINATE");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           TYPE A_T IS ACCESS TT;
+           A1 : A_T;
+ 
+      BEGIN -- (A)
+ 
+           DECLARE
+                A2 : A_T;
+           BEGIN
+                A2 := NEW TT;
+                A2.ALL.E;
+                A1 := A2;
+           END;
+ 
+           IF A1.ALL'TERMINATED THEN
+                FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
+           ELSE A1.ALL.E;
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+ 
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                TYPE ART IS ACCESS RT;
+                AR1 : ART;
+ 
+                PROCEDURE P (AR : OUT ART) IS
+                     AR2 : ART;
+                BEGIN
+                     AR2 := NEW RT;
+                     AR2.T.E;
+                     AR := AR2;
+                END P;
+ 
+           BEGIN
+                P (AR1);
+ 
+                IF AR1.T'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                             "- (B)");
+                ELSE AR1.T.E;
+                END IF;
+ 
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           I := F;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60;                -- DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+ 
+                LOOP_COUNT1 : INTEGER := 0;
+                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+ 
+                TYPE RAT;
+                TYPE ARAT IS ACCESS RAT;
+                TYPE ARR IS ARRAY (1..1) OF TT;
+                TYPE RAT IS
+                     RECORD
+                          A : ARAT;
+                          T : ARR;
+                     END RECORD;
+                ARA1 : ARAT;
+ 
+                TASK TSK1 IS
+                     ENTRY ENT1 (ARA : OUT ARAT);
+                END TSK1;
+ 
+                TASK BODY TSK1 IS
+                     ARA2 : ARAT;
+                BEGIN
+                     ARA2 := NEW RAT;
+                     ARA2.T(1).E;
+                     ACCEPT ENT1 (ARA : OUT ARAT) DO
+                          ARA := ARA2;
+                     END ENT1;
+                END TSK1;
+ 
+           BEGIN
+                TSK1.ENT1 (ARA1);
+ 
+                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
+                END LOOP;
+ 
+                IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                             "WITHIN ONE MINUTE - (C)");
+                END IF;
+ 
+                IF ARA1.T(1)'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                             "- (C)");
+                ELSE ARA1.T(1).E;
+                END IF;
+           END TSK;
+ 
+      BEGIN -- (C)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 2.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                        "TWO MINUTES - (C)");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C94002E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,227 ----
+ -- C94002F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
+ --   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
+ --   TO TERMINATE IF AN EXCEPTION IS RAISED AND HANDLED IN THE
+ --   NON-MASTER UNIT.
+ 
+ -- SUBTESTS ARE:
+ --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+ --   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+ --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+ 
+ -- TBN 1/20/86
+ -- JRK 5/1/86   IMPROVED ERROR RECOVERY.  FIXED EXCEPTION HANDLING.
+ -- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94002F IS
+ 
+      MY_EXCEPTION : EXCEPTION;
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+      BEGIN
+           ACCEPT E;
+           ACCEPT E;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C94002F", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
+                       "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
+                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                       "TERMINATE IF AN EXCEPTION IS RAISED AND " &
+                       "HANDLED IN THE NON-MASTER UNIT");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           TYPE A_T IS ACCESS TT;
+           A1 : A_T;
+ 
+      BEGIN -- (A)
+ 
+           DECLARE
+                A2 : A_T;
+           BEGIN
+                A2 := NEW TT;
+                A2.ALL.E;
+                A1 := A2;
+                RAISE MY_EXCEPTION;
+                FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
+           EXCEPTION
+                WHEN MY_EXCEPTION =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION IN (A)");
+           END;
+ 
+           IF A1.ALL'TERMINATED THEN
+                FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
+           ELSE A1.ALL.E;
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+ 
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                TYPE ART IS ACCESS RT;
+                AR1 : ART;
+ 
+                PROCEDURE P (AR : OUT ART) IS
+                     AR2 : ART;
+                BEGIN
+                     AR2 := NEW RT;
+                     AR2.T.E;
+                     AR := AR2;
+                     RAISE MY_EXCEPTION;
+                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
+                EXCEPTION
+                     WHEN MY_EXCEPTION =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION IN (B)");
+                END P;
+ 
+           BEGIN
+                P (AR1);
+ 
+                IF AR1.T'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                             "- (B)");
+                ELSE AR1.T.E;
+                END IF;
+ 
+                RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           I := F;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60;                -- DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+ 
+                LOOP_COUNT1 : INTEGER := 0;
+                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+ 
+                TYPE RAT;
+                TYPE ARAT IS ACCESS RAT;
+                TYPE ARR IS ARRAY (1..1) OF TT;
+                TYPE RAT IS
+                     RECORD
+                          A : ARAT;
+                          T : ARR;
+                     END RECORD;
+                ARA1 : ARAT;
+ 
+                TASK TSK1 IS
+                     ENTRY ENT1 (ARA : OUT ARAT);
+                END TSK1;
+ 
+                TASK BODY TSK1 IS
+                     ARA2 : ARAT;
+                BEGIN
+                     ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
+                     ARA2.T(1).E;
+                     ACCEPT ENT1 (ARA : OUT ARAT) DO
+                          ARA := ARA2;
+                     END ENT1;
+                     RAISE MY_EXCEPTION;
+                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
+                EXCEPTION
+                     WHEN MY_EXCEPTION =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION IN (C)");
+                END TSK1;
+ 
+           BEGIN
+                TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
+ 
+                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
+                END LOOP;
+ 
+                IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                             "WITHIN ONE MINUTE - (C)");
+                END IF;
+ 
+                IF ARA1.T(1)'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                             "- (C)");
+                ELSE ARA1.T(1).E;
+                END IF;
+           END TSK;
+ 
+      BEGIN -- (C)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 2.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                        "TWO MINUTES - (C)");
+           END IF;
+ 
+      END; -- (C)
+ 
+      ---------------------------------------------------------------
+ 
+      RESULT;
+ END C94002F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94002g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94002g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,350 ----
+ -- C94002G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
+ --     ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED
+ --     TASKS TO TERMINATE IF AN EXCEPTION IS RAISED BUT NOT HANDLED IN
+ --     THE NON-MASTER UNIT.
+ 
+ --     SUBTESTS ARE:
+ --        (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+ --        (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+ --        (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY, NOT
+ --             DURING RENDEZVOUS.
+ --        (D)  A LIMITED PRIVATE TASK ALLOCATOR, IN A TASK BODY, DURING
+ --             RENDEZVOUS.
+ 
+ -- HISTORY:
+ --     TBN 01/20/86  CREATED ORIGINAL TEST.
+ --      JRK 05/01/86  IMPROVED ERROR RECOVERY.  FIXED EXCEPTION
+ --                    HANDLING.  ADDED CASE (D).
+ --      BCB 09/24/87  ADDED A RETURN STATEMENT TO THE HANDLER FOR OTHERS
+ --                    IN FUNCTION F, CASE B.
+ --      PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94002G IS
+ 
+      MY_EXCEPTION : EXCEPTION;
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+      BEGIN
+           ACCEPT E;
+           ACCEPT E;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C94002G", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
+                       "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
+                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                       "TERMINATE IF AN EXCEPTION IS RAISED BUT NOT " &
+                       "HANDLED IN THE NON-MASTER UNIT");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           TYPE A_T IS ACCESS TT;
+           A1 : A_T;
+ 
+      BEGIN -- (A)
+ 
+           DECLARE
+                A2 : A_T;
+           BEGIN
+                A2 := NEW TT;
+                A2.ALL.E;
+                A1 := A2;
+                RAISE MY_EXCEPTION;
+                FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
+           END;
+ 
+           ABORT A1.ALL;
+ 
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF A1.ALL'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - " &
+                             "(A)");
+                ELSE A1.ALL.E;
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION IN (A)");
+                IF A1 /= NULL THEN
+                     ABORT A1.ALL;
+                END IF;
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+ 
+                TYPE RT IS
+                     RECORD
+                          T : TT;
+                     END RECORD;
+                TYPE ART IS ACCESS RT;
+                AR1 : ART;
+ 
+                PROCEDURE P IS
+                     AR2 : ART;
+                BEGIN
+                     AR2 := NEW RT;
+                     AR2.T.E;
+                     AR1 := AR2;
+                     RAISE MY_EXCEPTION;
+                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
+                END P;
+ 
+           BEGIN
+                P;
+                ABORT AR1.T;
+                RETURN 0;
+           EXCEPTION
+                WHEN MY_EXCEPTION =>
+                     IF AR1.T'TERMINATED THEN
+                          FAILED ("ALLOCATED TASK PREMATURELY " &
+                                  "TERMINATED - (B)");
+                     ELSE AR1.T.E;
+                     END IF;
+                     RETURN 0;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION IN (B)");
+                     IF AR1 /= NULL THEN
+                          ABORT AR1.T;
+                     END IF;
+                     RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           I := F;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60;                -- DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+ 
+                LOOP_COUNT1 : INTEGER := 0;
+                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+ 
+                TYPE RAT;
+                TYPE ARAT IS ACCESS RAT;
+                TYPE ARR IS ARRAY (1..1) OF TT;
+                TYPE RAT IS
+                     RECORD
+                          A : ARAT;
+                          T : ARR;
+                     END RECORD;
+                ARA1 : ARAT;
+ 
+                TASK TSK1 IS
+                     ENTRY ENT1 (ARA : OUT ARAT);
+                END TSK1;
+ 
+                TASK BODY TSK1 IS
+                     ARA2 : ARAT;
+                BEGIN
+                     ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
+                     ARA2.T(1).E;
+                     ACCEPT ENT1 (ARA : OUT ARAT) DO
+                          ARA := ARA2;
+                     END ENT1;
+                     RAISE MY_EXCEPTION;       -- NOT PROPOGATED.
+                     FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
+                END TSK1;
+ 
+           BEGIN
+                TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
+ 
+                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
+                END LOOP;
+ 
+                IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                             "WITHIN ONE MINUTE - (C)");
+                END IF;
+ 
+                IF ARA1.T(1)'TERMINATED THEN
+                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                             "- (C)");
+                ELSE ARA1.T(1).E;
+                END IF;
+           END TSK;
+ 
+      BEGIN -- (C)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 2.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                        "TWO MINUTES - (C)");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           LOOP_COUNT : INTEGER := 0;
+           CUT_OFF : CONSTANT := 60;                -- DELAY.
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+ 
+                LOOP_COUNT1 : INTEGER := 0;
+                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+ 
+                PACKAGE PKG IS
+                     TYPE LPT IS LIMITED PRIVATE;
+                     PROCEDURE CALL (X : LPT);
+                     PROCEDURE KILL (X : LPT);
+                     FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN;
+                PRIVATE
+                     TYPE LPT IS NEW TT;
+                END PKG;
+ 
+                USE PKG;
+ 
+                TYPE ALPT IS ACCESS LPT;
+                ALP1 : ALPT;
+ 
+                PACKAGE BODY PKG IS
+                     PROCEDURE CALL (X : LPT) IS
+                     BEGIN
+                          X.E;
+                     END CALL;
+ 
+                     PROCEDURE KILL (X : LPT) IS
+                     BEGIN
+                          ABORT X;
+                     END KILL;
+ 
+                     FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN IS
+                     BEGIN
+                          RETURN X'TERMINATED;
+                     END TERMINATED;
+                END PKG;
+ 
+                TASK TSK1 IS
+                     ENTRY ENT1 (ALP : OUT ALPT);
+                     ENTRY DIE;
+                END TSK1;
+ 
+                TASK BODY TSK1 IS
+                     ALP2 : ALPT;
+                BEGIN
+                     ALP2 := NEW LPT;         -- INITIATE TASK ALP2.ALL.
+                     CALL (ALP2.ALL);
+                     ACCEPT ENT1 (ALP : OUT ALPT) DO
+                          ALP := ALP2;
+                     END ENT1;
+                     ACCEPT DIE DO
+                          RAISE MY_EXCEPTION;       -- PROPOGATED.
+                          FAILED ("MY_EXCEPTION WAS NOT RAISED IN (D)");
+                     END DIE;
+                END TSK1;
+ 
+           BEGIN
+                TSK1.ENT1 (ALP1); -- ALP1.ALL BECOMES ALIAS FOR ALP2.ALL.
+                TSK1.DIE;
+                FAILED ("MY_EXCEPTION WAS NOT PROPOGATED TO CALLING " &
+                        "TASK - (D)");
+                KILL (ALP1.ALL);
+                ABORT TSK1;
+           EXCEPTION
+                WHEN MY_EXCEPTION =>
+                     WHILE NOT TSK1'TERMINATED AND
+                           LOOP_COUNT1 < CUT_OFF1 LOOP
+                          DELAY 1.0 * Impdef.One_Second;
+                          LOOP_COUNT1 := LOOP_COUNT1 + 1;
+                     END LOOP;
+ 
+                     IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                          FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                                  "WITHIN ONE MINUTE - (D)");
+                     END IF;
+ 
+                     IF TERMINATED (ALP1.ALL) THEN
+                          FAILED ("ALLOCATED TASK PREMATURELY " &
+                                  "TERMINATED - (D)");
+                     ELSE CALL (ALP1.ALL);
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION IN (D)");
+                     IF ALP1 /= NULL THEN
+                          KILL (ALP1.ALL);
+                     END IF;
+                     ABORT TSK1;
+           END TSK;
+ 
+      BEGIN -- (D)
+ 
+           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+                DELAY 2.0 * Impdef.One_Second;
+                LOOP_COUNT := LOOP_COUNT + 1;
+           END LOOP;
+ 
+           IF LOOP_COUNT >= CUT_OFF THEN
+                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                        "TWO MINUTES - (D)");
+           END IF;
+ 
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C94002G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C94004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
+ -- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
+ -- MAIN PROGRAM TERMINATION.
+ 
+ -- CASE A:  TASK OBJECT DECLARED IN LIBRARY PACKAGE USED BY MAIN
+ --          PROGRAM.
+ 
+ -- JRK 10/8/81
+ -- SPS 11/21/82
+ -- JBG 12/6/84
+ -- JRK 11/21/85  RENAMED FROM C94004A-B.ADA; REVISED ACCORDING TO
+ --               AI-00399.
+ -- JRK 10/24/86  RENAMED FROM E94004A-B.ADA; REVISED ACCORDING TO
+ --               REVISED AI-00399.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ PACKAGE C94004A_PKG IS
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+ END C94004A_PKG;
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY C94004A_PKG IS
+ 
+      TASK BODY TT IS
+           I : INTEGER := IDENT_INT (120);
+      BEGIN
+           ACCEPT E;
+           COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
+           DELAY DURATION(I) * Impdef.One_Second;
+           -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
+           RESULT;
+      END TT;
+ 
+ END C94004A_PKG;
+ 
+ WITH C94004A_PKG; USE C94004A_PKG;
+ PRAGMA ELABORATE (C94004A_PKG);
+ PACKAGE C94004A_TASK IS
+      T : TT;
+ END;
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ WITH C94004A_TASK;
+ PROCEDURE C94004A IS
+ 
+ 
+ BEGIN
+      TEST ("C94004A", "CHECK THAT A MAIN PROGRAM TERMINATES " &
+                       "WITHOUT WAITING FOR TASKS THAT DEPEND " &
+                       "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
+                       "CONTINUE TO EXECUTE");
+ 
+      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+ 
+      C94004A_TASK.T.E;      -- ALLOW TASK TO PROCEED.
+      IF C94004A_TASK.T'TERMINATED THEN
+           FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
+      END IF;
+ 
+      -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
+ 
+ END C94004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94004b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94004b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94004b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94004b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C94004B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
+ -- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
+ -- MAIN PROGRAM TERMINATION.
+ 
+ -- CASE B:  ACCESS TO TASK TYPE DECLARED IN LIBRARY PACKAGE; TASK
+ --          ACTIVATED IN MAIN PROGRAM.
+ 
+ -- JRK 10/8/81
+ -- SPS 11/21/82
+ -- JBG 12/6/84
+ -- JRK 11/21/85  RENAMED FROM C94004B-B.ADA; REVISED ACCORDING TO
+ --               AI-00399.
+ -- JRK 10/24/86  RENAMED FROM E94004B-B.ADA; REVISED ACCORDING TO
+ --               REVISED AI-00399.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ PACKAGE C94004B_PKG IS
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+ END C94004B_PKG;
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY C94004B_PKG IS
+ 
+      TASK BODY TT IS
+           I : INTEGER := IDENT_INT (120);
+      BEGIN
+           ACCEPT E;
+           COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
+           DELAY DURATION(I) * Impdef.One_Second;
+           -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
+           RESULT;
+      END TT;
+ 
+ END C94004B_PKG;
+ 
+ WITH C94004B_PKG; USE C94004B_PKG;
+ PRAGMA ELABORATE (C94004B_PKG);
+ PACKAGE C94004B_TASK IS
+      TYPE ACC_TASK IS ACCESS C94004B_PKG.TT;
+ END;
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ WITH C94004B_TASK; WITH C94004B_PKG;
+ PROCEDURE C94004B IS
+ 
+      T : C94004B_TASK.ACC_TASK;
+ 
+ BEGIN
+      TEST ("C94004B", "CHECK THAT A MAIN PROGRAM TERMINATES " &
+                       "WITHOUT WAITING FOR TASKS THAT DEPEND " &
+                       "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
+                       "CONTINUE TO EXECUTE");
+ 
+      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+ 
+      T := NEW C94004B_PKG.TT;
+      T.E;      -- ALLOW TASK TO PROCEED.
+      IF T'TERMINATED THEN
+           FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
+      END IF;
+ 
+      -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
+ 
+ END C94004B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94004c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94004c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94004c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94004c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C94004C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
+ -- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
+ -- MAIN PROGRAM TERMINATION.
+ 
+ -- CASE C:  TASK OBJECT DECLARED IN LIBRARY PACKAGE USED BY MAIN PROGRAM
+ --          AND WAITING AT A SELECTIVE WAIT WITH TERMINATE.
+ 
+ -- JRK 10/8/81
+ -- SPS 11/21/82
+ -- JBG 12/6/84
+ -- JRK 11/21/85  RENAMED FROM C94004C-B.ADA; REVISED ACCORDING TO
+ --               AI-00399.
+ -- JRK 10/24/86  RENAMED FROM E94004C-B.ADA; REVISED ACCORDING TO
+ --               REVISED AI-00399.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ PACKAGE C94004C_PKG IS
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+ END C94004C_PKG;
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY C94004C_PKG IS
+ 
+      TASK BODY TT IS
+           I : INTEGER := IDENT_INT (120);
+      BEGIN
+           ACCEPT E;
+           COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
+           DELAY DURATION(I) * Impdef.One_Second;
+           -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
+           RESULT;
+           -- USE LOOP FOR SELECTIVE WAIT WITH TERMINATE.
+           LOOP
+                SELECT
+                     ACCEPT E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           END LOOP;
+           -- FAILS IF JOB HANGS UP WITHOUT TERMINATING.
+      END TT;
+ 
+ END C94004C_PKG;
+ 
+ WITH C94004C_PKG; USE C94004C_PKG;
+ PRAGMA ELABORATE (C94004C_PKG);
+ PACKAGE C94004C_TASK IS
+      T : TT;
+ END;
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ WITH C94004C_TASK;
+ PROCEDURE C94004C IS
+ 
+ 
+ BEGIN
+      TEST ("C94004C", "CHECK THAT A MAIN PROGRAM TERMINATES " &
+                       "WITHOUT WAITING FOR TASKS THAT DEPEND " &
+                       "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
+                       "CONTINUE TO EXECUTE");
+ 
+      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+ 
+      C94004C_TASK.T.E;      -- ALLOW TASK TO PROCEED.
+      IF C94004C_TASK.T'TERMINATED THEN
+           FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
+      END IF;
+ 
+      -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
+ 
+ END C94004C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C94005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, A MAIN
+ --   PROGRAM THAT DECLARES OBJECTS OF THAT TYPE DOES WAIT FOR
+ --   TERMINATION OF SUCH OBJECTS.
+ 
+ -- THIS TEST CONTAINS RACE CONDITIONS.
+ 
+ -- JRK 10/8/81
+ -- SPS 11/21/82
+ -- JWC 11/15/85    MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005A_PKG.
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ 
+ WITH SYSTEM; USE SYSTEM;
+ PACKAGE C94005A_PKG IS
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+ END C94005A_PKG;
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PACKAGE BODY C94005A_PKG IS
+ 
+      TASK BODY TT IS
+           I : INTEGER := IDENT_INT (0);
+      BEGIN
+           ACCEPT E;
+           FOR J IN 1..60 LOOP
+                I := IDENT_INT (I);
+                DELAY 1.0 * Impdef.One_Second;
+           END LOOP;
+           RESULT;   -- FAILURE IF THIS MESSAGE IS NOT WRITTEN.
+      END TT;
+ 
+ END C94005A_PKG;
+ 
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ WITH C94005A_PKG;
+ PROCEDURE C94005A IS
+ 
+      T : C94005A_PKG.TT;
+ 
+ 
+ BEGIN
+      TEST ("C94005A", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
+                       "LIBRARY PACKAGE, A MAIN PROGRAM THAT " &
+                       "DECLARES OBJECTS OF THAT TYPE DOES WAIT FOR " &
+                       "TERMINATION OF SUCH OBJECTS");
+ 
+      COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+               "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+ 
+      T.E;
+ 
+      IF T'TERMINATED THEN
+           COMMENT ("TEST INCONCLUSIVE BECAUSE TASK T PREMATURELY " &
+                    "TERMINATED");
+      END IF;
+ 
+      -- TASK T SHOULD WRITE THE RESULT MESSAGE.
+ 
+ END C94005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,168 ----
+ -- C94005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, ANY
+ --   BLOCKS, SUBPROGRAMS, OR TASKS THAT DECLARE OBJECTS OF THAT TYPE
+ --   DO WAIT FOR TERMINATION OF SUCH OBJECTS.
+ -- SUBTESTS ARE:
+ --   (A)  IN A MAIN PROGRAM BLOCK.
+ --   (B)  IN A LIBRARY FUNCTION.
+ --   (C)  IN A MAIN PROGRAM TASK BODY.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+ 
+ -- JRK 10/8/81
+ -- SPS 11/2/82
+ -- SPS 11/21/82
+ -- JWC 11/15/85    MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005B_PKG.
+ -- PWN 01/31/95    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ 
+ WITH SYSTEM; USE SYSTEM;
+ PACKAGE C94005B_PKG IS
+ 
+      GLOBAL : INTEGER;
+ 
+      TASK TYPE TT IS
+           ENTRY E (I : INTEGER);
+      END TT;
+ 
+ END C94005B_PKG;
+ 
+ with Impdef;
+ PACKAGE BODY C94005B_PKG IS
+ 
+      TASK BODY TT IS
+           LOCAL : INTEGER;
+      BEGIN
+           ACCEPT E (I : INTEGER) DO
+                LOCAL := I;
+           END E;
+           DELAY 60.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
+                          -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
+                          -- TERMINATE IF THE ERROR IS PRESENT.
+           GLOBAL := LOCAL;
+      END TT;
+ 
+ END C94005B_PKG;
+ 
+ 
+ WITH REPORT; USE REPORT;
+ WITH C94005B_PKG; USE C94005B_PKG;
+ FUNCTION F RETURN INTEGER IS
+ 
+      T : TT;
+ 
+ BEGIN
+ 
+      T.E (IDENT_INT(2));
+      RETURN 0;
+ 
+ END F;
+ 
+ with Impdef;
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ WITH C94005B_PKG; USE C94005B_PKG;
+ WITH F;
+ PROCEDURE C94005B IS
+ 
+ 
+ BEGIN
+      TEST ("C94005B", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
+                       "LIBRARY PACKAGE, ANY BLOCKS, SUBPROGRAMS, OR " &
+                       "TASKS THAT DECLARE OBJECTS OF THAT TYPE DO " &
+                       "WAIT FOR TERMINATION OF SUCH OBJECTS");
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (A)
+ 
+           T : TT;
+ 
+      BEGIN -- (A)
+ 
+           T.E (IDENT_INT(1));
+ 
+      END; -- (A)
+ 
+      IF GLOBAL /= 1 THEN
+           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                   "BLOCK EXIT - (A)");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (B)
+ 
+           I : INTEGER;
+ 
+      BEGIN -- (B)
+ 
+           I := F ;
+ 
+           IF GLOBAL /= 2 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "FUNCTION EXIT - (B)");
+           END IF;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      GLOBAL := IDENT_INT (0);
+ 
+      DECLARE -- (C)
+ 
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           TASK BODY TSK IS
+                T : TT;
+           BEGIN
+                T.E (IDENT_INT(3));
+           END TSK;
+ 
+      BEGIN -- (C)
+ 
+           WHILE NOT TSK'TERMINATED LOOP
+                DELAY 0.1 * Impdef.One_Second;
+           END LOOP;
+ 
+           IF GLOBAL /= 3 THEN
+                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                        "TASK EXIT - (C)");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C94005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- C94006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A DECLARATION THAT RENAMES A TASK DOES NOT CREATE A NEW
+ -- MASTER FOR THE TASK.
+ 
+ -- TBN  9/17/86
+ -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94006A IS
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TASK BODY TT IS
+      BEGIN
+           SELECT
+                ACCEPT E;
+           OR
+                DELAY 30.0 * Impdef.One_Long_Second;
+           END SELECT;
+      END TT;
+ 
+ 
+ BEGIN
+      TEST ("C94006A", "CHECK THAT A DECLARATION THAT RENAMES A TASK " &
+                       "DOES NOT CREATE A NEW MASTER FOR THE TASK");
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           T1 : TT;
+      BEGIN
+           DECLARE
+                RENAME_TASK : TT RENAMES T1;
+           BEGIN
+                NULL;
+           END;
+           IF T1'TERMINATED THEN
+                FAILED ("TASK DEPENDENT ON WRONG UNIT - 1");
+           ELSE
+                T1.E;
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           T2 : TT;
+ 
+           PACKAGE P IS
+                Q : TT RENAMES T2;
+           END P;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                NULL;
+           END P;
+ 
+           USE P;
+      BEGIN
+           IF Q'TERMINATED THEN
+                FAILED ("TASK DEPENDENT ON WRONG UNIT - 2");
+           ELSE
+                Q.E;
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           TYPE ACC_TT IS ACCESS TT;
+           P1 : ACC_TT;
+      BEGIN
+           DECLARE
+                RENAME_ACCESS : ACC_TT RENAMES P1;
+           BEGIN
+                RENAME_ACCESS := NEW TT;
+           END;
+           IF P1'TERMINATED THEN
+                FAILED ("TASK DEPENDENT ON WRONG UNIT - 3");
+           ELSE
+                P1.E;
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           TYPE ACC_TT IS ACCESS TT;
+           P2 : ACC_TT;
+ 
+           PACKAGE Q IS
+                RENAME_ACCESS : ACC_TT RENAMES P2;
+           END Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                RENAME_ACCESS := NEW TT;
+           END Q;
+ 
+           USE Q;
+      BEGIN
+           IF RENAME_ACCESS'TERMINATED THEN
+                FAILED ("TASK DEPENDENT ON WRONG UNIT - 4");
+           ELSE
+                RENAME_ACCESS.E;
+           END IF;
+      END;
+ 
+      RESULT;
+ END C94006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,270 ----
+ -- C94007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE
+ --     (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
+ --     BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
+ --     OR TASK BODY.
+ --     SUBTESTS ARE:
+ --       (A)  A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK.
+ --       (B)  AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION.
+ --       (C)  AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY,
+ --            IN A TASK BODY.
+ 
+ -- HISTORY:
+ --     JRK 10/13/81
+ --     SPS 11/21/82
+ --     DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER
+ --                  BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A
+ --                  PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS.
+ --     PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94007A IS
+ 
+      TASK TYPE SYNC IS
+           ENTRY ID (C : CHARACTER);
+           ENTRY INNER;
+           ENTRY OUTER;
+      END SYNC;
+ 
+      TASK BODY SYNC IS
+           ID_C : CHARACTER;
+      BEGIN
+           ACCEPT ID (C : CHARACTER) DO
+                ID_C := C;
+           END ID;
+           DELAY 1.0 * Impdef.One_Second;
+           SELECT
+                ACCEPT OUTER;
+           OR
+                DELAY 120.0 * Impdef.One_Second;
+                FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
+           END SELECT;
+           ACCEPT INNER;
+      END SYNC;
+ 
+ 
+ BEGIN
+      TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " &
+                       "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
+                       "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
+                       "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
+                       "BODY, OR TASK BODY");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           S : SYNC;
+ 
+      BEGIN -- (A)
+ 
+           S.ID ('A');
+ 
+           DECLARE
+ 
+                PACKAGE PKG IS
+                     TASK T IS
+                          ENTRY E;
+                     END T;
+                END PKG;
+ 
+                PACKAGE BODY PKG IS
+                     TASK BODY T IS
+                     BEGIN
+                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                     END T;
+                END PKG;            -- PROBABLE OUTER BLOCK POINT.
+ 
+           BEGIN
+ 
+                S.OUTER;
+ 
+           EXCEPTION
+                WHEN TASKING_ERROR => NULL;
+           END;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED - A");
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           S : SYNC;
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+ 
+                PACKAGE PKG IS
+                PRIVATE
+                     TASK TYPE TT IS
+                          ENTRY E;
+                     END TT;
+                     A : ARRAY (1..1) OF TT;
+                END PKG;
+ 
+                PACKAGE BODY PKG IS
+                     TASK BODY TT IS
+                     BEGIN
+                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                     END TT;
+                END PKG;            -- PROBABLE OUTER BLOCK POINT.
+ 
+           BEGIN -- F
+ 
+                S.OUTER;
+                RETURN 0;
+ 
+           EXCEPTION
+                WHEN TASKING_ERROR => RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           S.ID ('B');
+           I := F;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED - B");
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           S : SYNC;
+ 
+      BEGIN -- (C)
+ 
+           S.ID ('C');
+ 
+           DECLARE
+ 
+                TASK TSK IS
+                END TSK;
+ 
+                TASK BODY TSK IS
+ 
+                     PACKAGE PKG IS
+                     END PKG;
+ 
+                     PACKAGE BODY PKG IS
+                          TASK TYPE TT IS
+                               ENTRY E;
+                          END TT;
+ 
+                          TYPE RT IS
+                               RECORD
+                                    T : TT;
+                               END RECORD;
+ 
+                          AR : ARRAY (1..1) OF RT;
+ 
+                          TASK BODY TT IS
+                          BEGIN
+                               S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                          END TT;
+                     END PKG;            -- PROBABLE OUTER BLOCK POINT.
+ 
+                BEGIN -- TSK
+ 
+                     S.OUTER;
+ 
+                EXCEPTION
+                     WHEN TASKING_ERROR => NULL;
+                END TSK;
+ 
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED - C");
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+      GLOBAL : INTEGER := IDENT_INT(5);
+ 
+      BEGIN -- (D)
+ 
+           DECLARE
+ 
+                PACKAGE PKG IS
+                     TASK T IS
+                          ENTRY E;
+                     END T;
+ 
+                     TASK T1 IS
+                     END T1;
+                END PKG;
+ 
+                PACKAGE BODY PKG IS
+                     TASK BODY T IS
+                     BEGIN
+                          ACCEPT E DO
+                               RAISE CONSTRAINT_ERROR;
+                          END E;
+                     END T;
+ 
+                     TASK BODY T1 IS
+                     BEGIN
+                          DELAY 120.0 * Impdef.One_Second;
+                          GLOBAL := IDENT_INT(1);
+                     END T1;
+ 
+                BEGIN
+                     T.E;
+ 
+                END PKG;
+                USE PKG;
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF GLOBAL /= IDENT_INT(1) THEN
+                     FAILED("TASK NOT COMPLETED");
+                END IF;
+ 
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED - D");
+      END; -- (D)
+ 
+      RESULT;
+ END C94007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94007b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94007b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94007b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,224 ----
+ -- C94007B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK THAT IS ALLOCATED IN A NON-LIBRARY PACKAGE
+ --   (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
+ --   BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
+ --   OR TASK BODY.
+ -- SUBTESTS ARE:
+ --   (A)  A SIMPLE TASK ALLOCATOR, IN A VISIBLE PART, IN A BLOCK.
+ --   (B)  A RECORD OF TASK ALLOCATOR, IN A PRIVATE PART, IN A FUNCTION.
+ --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY,
+ --           IN A TASK BODY.
+ 
+ -- JRK 10/16/81
+ -- SPS 11/2/82
+ -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94007B IS
+ 
+      TASK TYPE SYNC IS
+           ENTRY ID (C : CHARACTER);
+           ENTRY INNER;
+           ENTRY OUTER;
+      END SYNC;
+ 
+      TASK BODY SYNC IS
+           ID_C : CHARACTER;
+      BEGIN
+           ACCEPT ID (C : CHARACTER) DO
+                ID_C := C;
+           END ID;
+           DELAY 1.0 * Impdef.One_Second;
+           SELECT
+                ACCEPT OUTER;
+           OR
+                DELAY 120.0 * Impdef.One_Second;
+                FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
+           END SELECT;
+           ACCEPT INNER;
+      END SYNC;
+ 
+ 
+ BEGIN
+      TEST ("C94007B", "CHECK THAT A TASK THAT IS ALLOCATED IN A " &
+                       "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
+                       "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
+                       "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
+                       "BODY, OR TASK BODY");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           S : SYNC;
+ 
+      BEGIN -- (A)
+ 
+           S.ID ('A');
+ 
+           DECLARE
+ 
+                PACKAGE PKG IS
+                     TASK TYPE TT IS
+                          ENTRY E;
+                     END TT;
+                     TYPE A_T IS ACCESS TT;
+                     A : A_T;
+                END PKG;
+ 
+                PACKAGE BODY PKG IS
+                     TASK BODY TT IS
+                     BEGIN
+                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                     END TT;
+                BEGIN
+                     A := NEW TT;
+                END PKG;            -- PROBABLE OUTER BLOCK POINT.
+ 
+           BEGIN
+ 
+                S.OUTER;
+ 
+           EXCEPTION
+                WHEN TASKING_ERROR => NULL;
+           END;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           S : SYNC;
+ 
+           I : INTEGER;
+ 
+           FUNCTION F RETURN INTEGER IS
+ 
+                PACKAGE PKG IS
+                PRIVATE
+                     TASK TYPE TT IS
+                          ENTRY E;
+                     END TT;
+ 
+                     TYPE RT IS
+                          RECORD
+                               T : TT;
+                          END RECORD;
+ 
+                     TYPE ART IS ACCESS RT;
+ 
+                     AR : ART;
+                END PKG;
+ 
+                PACKAGE BODY PKG IS
+                     TASK BODY TT IS
+                     BEGIN
+                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                     END TT;
+                BEGIN
+                     AR := NEW RT;
+                END PKG;            -- PROBABLE OUTER BLOCK POINT.
+ 
+           BEGIN -- F
+ 
+                S.OUTER;
+                RETURN 0;
+ 
+           EXCEPTION
+                WHEN TASKING_ERROR => RETURN 0;
+           END F;
+ 
+      BEGIN -- (B)
+ 
+           S.ID ('B');
+           I := F ;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           S : SYNC;
+ 
+      BEGIN -- (C)
+ 
+           S.ID ('C');
+ 
+           DECLARE
+ 
+                TASK TSK IS
+                END TSK;
+ 
+                TASK BODY TSK IS
+ 
+                     PACKAGE PKG IS
+                     END PKG;
+ 
+                     PACKAGE BODY PKG IS
+                          TASK TYPE TT IS
+                               ENTRY E;
+                          END TT;
+                          
+                          TYPE ARR IS ARRAY (1..1) OF TT;
+                          TYPE RAT IS
+                               RECORD
+                                    T : ARR;
+                               END RECORD;
+ 
+                          TYPE ARAT IS ACCESS RAT;
+ 
+                          ARA : ARAT;
+ 
+                          TASK BODY TT IS
+                          BEGIN
+                               S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                          END TT;
+                     BEGIN
+                          ARA := NEW RAT;
+                     END PKG;            -- PROBABLE OUTER BLOCK POINT.
+ 
+                BEGIN -- TSK
+ 
+                     S.OUTER;
+ 
+                EXCEPTION
+                     WHEN TASKING_ERROR => NULL;
+                END TSK;
+ 
+           BEGIN
+                NULL;
+           END;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C94007B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,61 ----
+ -- C94008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK WAITING AT AN OPEN TERMINATE ALTERNATIVE
+ -- DOES  N O T  TERMINATE WHILE THE UNIT THE TASK DEPENDS ON
+ -- HAS NOT COMPLETED ITS EXECUTION.
+ 
+ -- WEI  3/ 4/82
+ -- TBN  11/25/85     RENAMED FROM C940BAA-B.ADA.
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C94008A IS
+ BEGIN
+      TEST ("C94008A", "TERMINATION WHILE WAITING AT " &
+                       "AN OPEN TERMINATE ALTERNATIVE");
+ 
+ BLOCK1 :
+      DECLARE
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                SELECT
+                     WHEN TRUE => TERMINATE;
+                     OR WHEN FALSE => ACCEPT E1;
+                END SELECT;
+           END T1;
+      BEGIN  -- BLOCK1
+           IF T1'TERMINATED THEN
+                FAILED ("TASK T1 TERMINATED BEFORE OUTER UNIT HAS " &
+                        "BEEN LEFT");
+           END IF;
+      END BLOCK1;
+ 
+      RESULT;
+ 
+ END C94008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C94008B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK WAITING AT AN OPEN TERMINATE ALTERNATIVE
+ -- DOES  N O T  TERMINATE UNTIL ALL OTHER TASKS DEPENDING ON THE SAME
+ -- UNIT EITHER ARE TERMINATED OR ARE WAITING AT AN OPEN TERMINATE.
+ 
+ -- WEI  3/ 4/82
+ -- TBN 11/25/85     RENAMED FROM C940BBA-B.ADA.
+ 
+ with Impdef;
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C94008B IS
+ BEGIN
+      TEST ("C94008B", "TERMINATION WHILE WAITING AT AN OPEN TERMINATE");
+ 
+ BLOCK1 :
+      DECLARE
+ 
+           TASK TYPE TT1 IS
+                ENTRY E1;
+           END TT1;
+ 
+           NUMB_TT1 : CONSTANT NATURAL := 3;
+           DELAY_TIME : DURATION := 0.0;
+           ARRAY_TT1 : ARRAY (1 .. NUMB_TT1) OF TT1;
+ 
+           TASK BODY TT1 IS
+           BEGIN
+                DELAY_TIME := DELAY_TIME + 1.0 * Impdef.One_Second;
+                DELAY DELAY_TIME;
+                FOR I IN 1 .. NUMB_TT1
+                LOOP
+                     IF ARRAY_TT1 (I)'TERMINATED THEN
+                          FAILED ("TOO EARLY TERMINATION OF " &
+                                  "TASK TT1 INDEX" & INTEGER'IMAGE(I));
+                     END IF;
+                END LOOP;
+ 
+                SELECT
+                     WHEN TRUE => TERMINATE;
+                  OR WHEN FALSE => ACCEPT E1;
+                END SELECT;
+           END TT1;
+ 
+      BEGIN  -- BLOCK1.
+           FOR I IN 1 .. NUMB_TT1
+           LOOP
+                IF ARRAY_TT1 (I)'TERMINATED THEN
+                     FAILED ("TERMINATION BEFORE OUTER " &
+                             "UNIT HAS BEEN LEFT OF TASK TT1 INDEX " &
+                             INTEGER'IMAGE(I));
+                END IF;
+           END LOOP;
+      END BLOCK1;
+ 
+      RESULT;
+ 
+ END C94008B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,265 ----
+ -- C94008C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
+ -- NESTED TASKS.
+ 
+ -- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
+ -- CONTAINS TASKS.
+ 
+ -- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
+ -- JRK 4/7/86
+ -- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94008C IS
+ 
+ 
+ -- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
+      GENERIC
+           TYPE HOLDER_TYPE IS PRIVATE;
+           TYPE VALUE_TYPE IS PRIVATE;
+           INITIAL_VALUE : HOLDER_TYPE;
+           WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
+                               VALUE  : IN  HOLDER_TYPE) IS <>;
+           WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
+                                  VALUE  : IN  VALUE_TYPE) IS <>;
+      PACKAGE SHARED IS
+           PROCEDURE SET (VALUE : IN HOLDER_TYPE);
+           PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
+           FUNCTION GET RETURN HOLDER_TYPE;
+      END SHARED;
+ 
+      PACKAGE BODY SHARED IS
+           TASK SHARE IS
+                ENTRY SET    (VALUE : IN HOLDER_TYPE);
+                ENTRY UPDATE (VALUE : IN VALUE_TYPE);
+                ENTRY READ   (VALUE : OUT HOLDER_TYPE);
+           END SHARE;
+ 
+           TASK BODY SHARE IS
+                VARIABLE : HOLDER_TYPE;
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
+                               SHARED.SET (VARIABLE, VALUE);
+                          END SET;
+                     OR
+                          ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
+                               SHARED.UPDATE (VARIABLE, VALUE);
+                          END UPDATE;
+                     OR
+                          ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
+                               VALUE := VARIABLE;
+                          END READ;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END SHARE;
+ 
+           PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
+           BEGIN
+                SHARE.SET (VALUE);
+           END SET;
+ 
+           PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
+           BEGIN
+                SHARE.UPDATE (VALUE);
+           END UPDATE;
+ 
+           FUNCTION GET RETURN HOLDER_TYPE IS
+                VALUE : HOLDER_TYPE;
+           BEGIN
+                SHARE.READ (VALUE);
+                RETURN VALUE;
+           END GET;
+ 
+      BEGIN
+           SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
+      END SHARED;
+ 
+      PACKAGE EVENTS IS
+ 
+           TYPE EVENT_TYPE IS
+                RECORD
+                     TRACE  : STRING (1..4) := "....";
+                     LENGTH : NATURAL := 0;
+                END RECORD;
+ 
+           PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
+           PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
+      END EVENTS;
+ 
+      PACKAGE COUNTER IS
+           PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
+           PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
+      END COUNTER;
+ 
+      PACKAGE BODY COUNTER IS
+           PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
+           BEGIN
+                VAR := VAR + VAL;
+           END UPDATE;
+ 
+           PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
+           BEGIN
+                VAR := VAL;
+           END SET;
+      END COUNTER;
+ 
+      PACKAGE BODY EVENTS IS
+           PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
+           BEGIN
+                VAR.LENGTH := VAR.LENGTH + 1;
+                VAR.TRACE(VAR.LENGTH) := VAL;
+           END UPDATE;
+ 
+           PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
+           BEGIN
+                VAR := VAL;
+           END SET;
+ 
+      END EVENTS;
+ 
+      USE EVENTS, COUNTER;
+ 
+      PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
+      PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
+ 
+      FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
+      BEGIN
+           TERMINATE_COUNT.UPDATE (1);
+           RETURN TRUE;
+      END ENTER_TERMINATE;
+ 
+ BEGIN -- C94008C
+ 
+      TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
+                       "TERMINATE ALTERNATIVE");
+ 
+      DECLARE
+ 
+           PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
+ 
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+ 
+           TASK BODY T1 IS
+ 
+                TASK T2 IS
+                     ENTRY E2;
+                END T2;
+ 
+                TASK BODY T2 IS
+ 
+                     TASK T3 IS
+                          ENTRY E3;
+                     END T3;
+ 
+                     TASK BODY T3 IS
+                     BEGIN
+                          SELECT
+                               ACCEPT E3;
+                          OR WHEN ENTER_TERMINATE => TERMINATE;
+                          END SELECT;
+                          EVENT ('D');
+                     END T3;
+ 
+                BEGIN -- T2
+ 
+                     SELECT
+                          ACCEPT E2;
+                     OR WHEN ENTER_TERMINATE => TERMINATE;
+                     END SELECT;
+ 
+                     DELAY 10.0 * Impdef.One_Second;
+ 
+                     IF TERMINATE_COUNT.GET /= 1 THEN
+                          DELAY 20.0 * Impdef.One_Long_Second;
+                     END IF;
+ 
+                     IF TERMINATE_COUNT.GET /= 1 THEN
+                          FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
+                     END IF;
+ 
+                     EVENT ('C');
+                     T1.E1;
+                     T3.E3;
+                END T2;
+ 
+           BEGIN -- T1;
+ 
+                SELECT
+                     ACCEPT E1;
+                OR WHEN ENTER_TERMINATE => TERMINATE;
+                END SELECT;
+ 
+                EVENT ('B');
+                TERMINATE_COUNT.SET (0);
+                T2.E2;
+ 
+                SELECT
+                     ACCEPT E1;
+                OR WHEN ENTER_TERMINATE => TERMINATE;
+                END SELECT;
+ 
+                SELECT
+                     ACCEPT E1;
+                OR TERMINATE;  -- ONLY THIS ONE EVER CHOSEN.
+                END SELECT;
+ 
+                FAILED ("TERMINATE NOT SELECTED IN T1");
+           END T1;
+ 
+      BEGIN
+ 
+           DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
+ 
+            IF TERMINATE_COUNT.GET /= 3 THEN
+                 DELAY 20.0 * Impdef.One_Long_Second;
+            END IF;
+ 
+            IF TERMINATE_COUNT.GET /= 3 THEN
+                 FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
+            END IF;
+ 
+           EVENT ('A');
+           T1.E1;
+ 
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
+      END;
+ 
+      IF TRACE.GET.TRACE /= "ABCD" THEN
+           FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
+      END IF;
+ 
+      RESULT;
+ END C94008C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94008d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94008d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,235 ----
+ -- C94008D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK CORRECT OPERATION OF SELECT WITH TERMINATE ALTERNATIVE WHEN
+ -- EXECUTED FROM AN INNER BLOCK WITH OUTER DEPENDING TASKS.
+ 
+ -- JEAN-PIERRE ROSEN 03-MAR-84
+ -- JRK 4/7/86
+ -- JBG 9/4/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT/SUBUNIT
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ -- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
+ GENERIC
+      TYPE HOLDER_TYPE IS PRIVATE;
+      TYPE VALUE_TYPE IS PRIVATE;
+      INITIAL_VALUE : HOLDER_TYPE;
+      WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
+                          VALUE  : IN  HOLDER_TYPE) IS <>;
+      WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
+                             VALUE  : IN  VALUE_TYPE) IS <>;
+ PACKAGE SHARED_C94008D IS
+      PROCEDURE SET (VALUE : IN HOLDER_TYPE);
+      PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
+      FUNCTION GET RETURN HOLDER_TYPE;
+ END SHARED_C94008D;
+ 
+ PACKAGE BODY SHARED_C94008D IS
+      TASK SHARE IS
+           ENTRY SET    (VALUE : IN HOLDER_TYPE);
+           ENTRY UPDATE (VALUE : IN VALUE_TYPE);
+           ENTRY READ   (VALUE : OUT HOLDER_TYPE);
+      END SHARE;
+ 
+      TASK BODY SHARE IS SEPARATE;
+ 
+      PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
+      BEGIN
+           SHARE.SET (VALUE);
+      END SET;
+ 
+      PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
+      BEGIN
+           SHARE.UPDATE (VALUE);
+      END UPDATE;
+ 
+      FUNCTION GET RETURN HOLDER_TYPE IS
+           VALUE : HOLDER_TYPE;
+      BEGIN
+           SHARE.READ (VALUE);
+           RETURN VALUE;
+      END GET;
+ 
+ BEGIN
+      SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
+ END SHARED_C94008D;
+ 
+ PACKAGE EVENTS_C94008D IS
+ 
+      TYPE EVENT_TYPE IS
+           RECORD
+                TRACE  : STRING (1..4) := "....";
+                LENGTH : NATURAL := 0;
+           END RECORD;
+ 
+      PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
+      PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
+ END EVENTS_C94008D;
+ 
+ PACKAGE COUNTER_C94008D IS
+      PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
+      PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
+ END COUNTER_C94008D;
+ 
+ PACKAGE BODY COUNTER_C94008D IS
+      PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
+      BEGIN
+           VAR := VAR + VAL;
+      END UPDATE;
+ 
+      PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
+      BEGIN
+           VAR := VAL;
+      END SET;
+ END COUNTER_C94008D;
+ 
+ PACKAGE BODY EVENTS_C94008D IS
+      PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
+      BEGIN
+           VAR.LENGTH := VAR.LENGTH + 1;
+           VAR.TRACE(VAR.LENGTH) := VAL;
+      END UPDATE;
+ 
+      PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
+      BEGIN
+           VAR := VAL;
+      END SET;
+ 
+ END EVENTS_C94008D;
+ 
+ SEPARATE (SHARED_C94008D)
+ TASK BODY SHARE IS
+      VARIABLE : HOLDER_TYPE;
+ BEGIN
+      LOOP
+           SELECT
+                ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
+                     SHARED_C94008D.SET (VARIABLE, VALUE);
+                END SET;
+           OR
+                ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
+                     SHARED_C94008D.UPDATE (VARIABLE, VALUE);
+                END UPDATE;
+           OR
+                ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
+                     VALUE := VARIABLE;
+                END READ;
+           OR
+                TERMINATE;
+           END SELECT;
+      END LOOP;
+ END SHARE;
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ WITH SHARED_C94008D, COUNTER_C94008D, EVENTS_C94008D;
+ USE  COUNTER_C94008D, EVENTS_C94008D;
+ PROCEDURE C94008D IS
+ 
+      PACKAGE TRACE IS
+           NEW SHARED_C94008D (EVENT_TYPE, CHARACTER, ("....", 0));
+      PACKAGE TERMINATE_COUNT IS
+           NEW SHARED_C94008D (INTEGER, INTEGER, 0);
+ 
+      PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
+ 
+      FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
+      BEGIN
+           TERMINATE_COUNT.UPDATE (1);
+           RETURN TRUE;
+      END ENTER_TERMINATE;
+ 
+ BEGIN
+      TEST ("C94008D", "CHECK CORRECT OPERATION OF SELECT WITH " &
+                       "TERMINATE ALTERNATIVE FROM AN INNER BLOCK");
+ 
+      DECLARE
+ 
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                DECLARE
+ 
+                     TASK T2 IS
+                          ENTRY E2;
+                     END T2;
+ 
+                     TASK BODY T2 IS
+                     BEGIN
+                          DELAY 10.0 * Impdef.One_Second;
+ 
+                          IF TERMINATE_COUNT.GET /= 1 THEN
+                               DELAY 20.0 * Impdef.One_Second;
+                          END IF;
+ 
+                          IF TERMINATE_COUNT.GET /= 1 THEN
+                               FAILED ("30 SECOND DELAY NOT ENOUGH");
+                          END IF;
+ 
+                          IF T1'TERMINATED OR NOT T1'CALLABLE THEN
+                               FAILED ("T1 PREMATURELY TERMINATED");
+                          END IF;
+ 
+                          EVENT ('A');
+ 
+                          SELECT
+                               ACCEPT E2;
+                          OR TERMINATE;
+                          END SELECT;
+ 
+                          FAILED ("TERMINATE NOT SELECTED IN T2");
+                     END T2;
+ 
+                BEGIN
+                     BEGIN
+                          EVENT ('B');
+ 
+                          SELECT
+                               ACCEPT E1;
+                          OR WHEN ENTER_TERMINATE => TERMINATE;
+                          END SELECT;
+ 
+                          FAILED ("TERMINATE NOT SELECTED IN T1");
+                     END;
+                END;
+           END T1;
+ 
+      BEGIN
+           EVENT ('C');
+      EXCEPTION
+           WHEN OTHERS => FAILED ("EXCEPTION RECEIVED IN MAIN");
+      END;
+ 
+      IF TRACE.GET.TRACE(3) = '.' OR TRACE.GET.TRACE(4) /= '.' THEN
+           FAILED ("ALL EVENTS NOT PROCESSED CORRECTLY");
+      END IF;
+ 
+      COMMENT ("EXECUTION ORDER WAS " & TRACE.GET.TRACE);
+ 
+      RESULT;
+ END C94008D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,243 ----
+ -- C94010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A GENERIC UNIT HAS A FORMAL LIMITED PRIVATE TYPE AND
+ -- DECLARES AN OBJECT OF THAT TYPE (OR HAS A SUBCOMPONENT OF THAT TYPE),
+ -- AND IF THE UNIT IS INSTANTIATED WITH A TASK TYPE OR AN OBJECT HAVING
+ -- A SUBCOMPONENT OF A TASK TYPE, THEN THE USUAL RULES APPLY TO THE
+ -- INSTANTIATED UNIT, NAMELY:
+ --     A) IF THE GENERIC UNIT IS A SUBPROGRAM, CONTROL CANNOT LEAVE THE
+ --        SUBPROGRAM UNTIL THE TASK CREATED BY THE OBJECT DECLARATION IS
+ --        TERMINATED.
+ 
+ -- THIS TEST CONTAINS RACE CONDITIONS AND SHARED VARIABLES.
+ 
+ -- TBN  9/22/86
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C94010A IS
+ 
+      GLOBAL_INT : INTEGER := 0;
+      MY_EXCEPTION : EXCEPTION;
+ 
+      PACKAGE P IS
+           TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
+      PRIVATE
+           TASK TYPE LIM_PRI_TASK IS
+           END LIM_PRI_TASK;
+      END P;
+ 
+      USE P;
+ 
+      TASK TYPE TT IS
+      END TT;
+ 
+      TYPE REC IS
+           RECORD
+                A : INTEGER := 1;
+                B : TT;
+           END RECORD;
+ 
+      TYPE LIM_REC IS
+           RECORD
+                A : INTEGER := 1;
+                B : LIM_PRI_TASK;
+           END RECORD;
+ 
+      PACKAGE BODY P IS
+           TASK BODY LIM_PRI_TASK IS
+           BEGIN
+                DELAY 30.0 * Impdef.One_Second;
+                GLOBAL_INT := IDENT_INT (2);
+           END LIM_PRI_TASK;
+      END P;
+ 
+      TASK BODY TT IS
+      BEGIN
+           DELAY 30.0 * Impdef.One_Second;
+           GLOBAL_INT := IDENT_INT (1);
+      END TT;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PROCEDURE PROC (A : INTEGER);
+ 
+      PROCEDURE PROC (A : INTEGER) IS
+           OBJ_T : T;
+      BEGIN
+           IF A = IDENT_INT (1) THEN
+                RAISE MY_EXCEPTION;
+           END IF;
+      END PROC;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      FUNCTION FUNC (A : INTEGER) RETURN INTEGER;
+ 
+      FUNCTION FUNC (A : INTEGER) RETURN INTEGER IS
+           OBJ_T : T;
+      BEGIN
+           IF A = IDENT_INT (1) THEN
+                RAISE MY_EXCEPTION;
+           END IF;
+           RETURN 1;
+      END FUNC;
+ 
+ 
+ BEGIN
+      TEST ("C94010A", "CHECK TERMINATION RULES FOR INSTANTIATIONS OF " &
+                       "GENERIC SUBPROGRAM UNITS WHICH CREATE TASKS");
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           PROCEDURE PROC1 IS NEW PROC (TT);
+      BEGIN
+           PROC1 (0);
+           IF GLOBAL_INT = IDENT_INT (0) THEN
+                FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
+                DELAY 35.0;
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           PROCEDURE PROC2 IS NEW PROC (REC);
+      BEGIN
+           PROC2 (1);
+           FAILED ("EXCEPTION WAS NOT RAISED - 2");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL_INT = IDENT_INT (0) THEN
+                     FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
+                     DELAY 35.0 * Impdef.One_Second;
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           PROCEDURE PROC3 IS NEW PROC (LIM_PRI_TASK);
+      BEGIN
+           PROC3 (1);
+           FAILED ("EXCEPTION WAS NOT RAISED - 3");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL_INT = IDENT_INT (0) THEN
+                     FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
+                     DELAY 35.0 * Impdef.One_Second;
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           PROCEDURE PROC4 IS NEW PROC (LIM_REC);
+      BEGIN
+           PROC4 (0);
+           IF GLOBAL_INT = IDENT_INT (0) THEN
+                FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
+                DELAY 35.0 * Impdef.One_Second;
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           A : INTEGER;
+           FUNCTION FUNC1 IS NEW FUNC (TT);
+      BEGIN
+           A := FUNC1 (1);
+           FAILED ("EXCEPTION NOT RAISED - 5");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL_INT = IDENT_INT (0) THEN
+                     FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
+                     DELAY 35.0 * Impdef.One_Second;
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           A : INTEGER;
+           FUNCTION FUNC2 IS NEW FUNC (REC);
+      BEGIN
+           A := FUNC2 (0);
+           IF GLOBAL_INT = IDENT_INT (0) THEN
+                FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
+                DELAY 35.0 * Impdef.One_Second;
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           A : INTEGER;
+           FUNCTION FUNC3 IS NEW FUNC (LIM_PRI_TASK);
+      BEGIN
+           A := FUNC3 (0);
+           IF GLOBAL_INT = IDENT_INT (0) THEN
+                FAILED ("TASK NOT DEPENDENT ON MASTER - 7");
+                DELAY 35.0 * Impdef.One_Second;
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           A : INTEGER;
+           FUNCTION FUNC4 IS NEW FUNC (LIM_REC);
+      BEGIN
+           A := FUNC4 (1);
+           FAILED ("EXCEPTION NOT RAISED - 8");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL_INT = IDENT_INT (0) THEN
+                     FAILED ("TASK NOT DEPENDENT ON MASTER - 8");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
+      END;
+ 
+      -------------------------------------------------------------------
+           
+      RESULT;
+ END C94010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,268 ----
+ -- C94011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A FORMAL ACCESS TYPE OF A GENERIC UNIT DESIGNATES A
+ -- FORMAL LIMITED PRIVATE TYPE, THEN WHEN THE UNIT IS INSTANTIATED WITH
+ -- A TASK TYPE OR A TYPE HAVING A SUBCOMPONENT OF A TASK TYPE, THE
+ -- MASTER FOR ANY TASKS ALLOCATED WITHIN THE INSTANTIATED UNIT IS
+ -- DETERMINED BY THE ACTUAL PARAMETER.
+ 
+ -- TBN  9/22/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C94011A IS
+ 
+      GLOBAL_INT : INTEGER := 0;
+      MY_EXCEPTION : EXCEPTION;
+ 
+      PACKAGE P IS
+           TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
+           PROCEDURE E (T : LIM_PRI_TASK);
+      PRIVATE
+           TASK TYPE LIM_PRI_TASK IS
+                ENTRY E;
+           END LIM_PRI_TASK;
+      END P;
+ 
+      USE P;
+ 
+      TASK TYPE TT IS
+           ENTRY E;
+      END TT;
+ 
+      TYPE REC IS
+           RECORD
+                A : INTEGER := 1;
+                B : TT;
+           END RECORD;
+ 
+      TYPE LIM_REC IS
+           RECORD
+                A : INTEGER := 1;
+                B : LIM_PRI_TASK;
+           END RECORD;
+ 
+      PACKAGE BODY P IS
+           TASK BODY LIM_PRI_TASK IS
+           BEGIN
+                ACCEPT E;
+                GLOBAL_INT := IDENT_INT (2);
+           END LIM_PRI_TASK;
+ 
+           PROCEDURE E (T : LIM_PRI_TASK) IS
+           BEGIN
+                T.E;
+           END E;
+      END P;
+ 
+      TASK BODY TT IS
+      BEGIN
+           ACCEPT E;
+           GLOBAL_INT := IDENT_INT (1);
+      END TT;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+           TYPE ACC_T IS ACCESS T;
+      PROCEDURE PROC (A : OUT ACC_T);
+ 
+      PROCEDURE PROC (A : OUT ACC_T) IS
+      BEGIN
+           A := NEW T;
+      END PROC;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+           TYPE ACC_T IS ACCESS T;
+      FUNCTION FUNC RETURN ACC_T;
+ 
+      FUNCTION FUNC RETURN ACC_T IS
+      BEGIN
+           RETURN NEW T;
+      END FUNC;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+           TYPE ACC_T IS ACCESS T;
+      PACKAGE PAC IS
+           PTR_T : ACC_T := NEW T;
+      END PAC;
+ 
+ BEGIN
+      TEST ("C94011A", "CHECK THAT IF A FORMAL ACCESS TYPE OF A " &
+                       "GENERIC UNIT DESIGNATES A FORMAL LIMITED " &
+                       "PRIVATE TYPE, THEN WHEN THE UNIT IS " &
+                       "INSTANTIATED, THE MASTER FOR ANY TASKS " &
+                       "ALLOCATED WITHIN THE INSTANTIATED UNIT IS " &
+                       "DETERMINED BY THE ACTUAL PARAMETER");
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           TYPE ACC_TT IS ACCESS TT;
+           ACC1 : ACC_TT;
+           PROCEDURE PROC1 IS NEW PROC (TT, ACC_TT);
+      BEGIN
+           PROC1 (ACC1);
+           ACC1.E;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("TASK DEPENDENT ON WRONG MASTER - 1");
+      END;
+      IF GLOBAL_INT = IDENT_INT (0) THEN
+           FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
+      END IF;
+      
+      -------------------------------------------------------------------
+      BEGIN
+           GLOBAL_INT := IDENT_INT (0);
+           DECLARE
+                TYPE ACC_REC IS ACCESS REC;
+                A : ACC_REC;
+                FUNCTION FUNC1 IS NEW FUNC (REC, ACC_REC);
+           BEGIN
+                A := FUNC1;
+                A.B.E;
+                RAISE MY_EXCEPTION;
+           EXCEPTION
+                WHEN MY_EXCEPTION =>
+                     RAISE MY_EXCEPTION;
+                WHEN OTHERS =>
+                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 2");
+           END;
+           FAILED ("MY_EXCEPTION NOT RAISED - 2");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL_INT = IDENT_INT (0) THEN
+                     FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+      END;
+      
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      BEGIN
+           DECLARE
+                TYPE ACC_LIM_TT IS ACCESS LIM_PRI_TASK;
+           BEGIN
+                DECLARE
+                     A : ACC_LIM_TT;
+                     FUNCTION FUNC2 IS NEW FUNC (LIM_PRI_TASK,
+                                                             ACC_LIM_TT);
+                BEGIN
+                     A := FUNC2;
+                     E (A.ALL);
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 3");
+           END;
+           IF GLOBAL_INT = IDENT_INT (0) THEN
+                FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      BEGIN
+           DECLARE
+                TYPE ACC_LIM_REC IS ACCESS LIM_REC;
+           BEGIN
+                DECLARE
+                     ACC2 : ACC_LIM_REC;
+                     PROCEDURE PROC2 IS NEW PROC (LIM_REC, ACC_LIM_REC);
+                BEGIN
+                     PROC2 (ACC2);
+                     E (ACC2.B);
+                END;
+                RAISE MY_EXCEPTION;
+           EXCEPTION
+                WHEN MY_EXCEPTION =>
+                     RAISE MY_EXCEPTION;
+                WHEN OTHERS =>
+                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 4");
+           END;
+           FAILED ("MY_EXCEPTION NOT RAISED - 4");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL_INT = IDENT_INT (0) THEN
+                     FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+      END;
+ 
+      -------------------------------------------------------------------
+      BEGIN
+            GLOBAL_INT := IDENT_INT (0);
+ 
+           DECLARE
+                TYPE ACC_TT IS ACCESS TT;
+                PACKAGE PAC1 IS NEW PAC (TT, ACC_TT);
+                USE PAC1; 
+           BEGIN
+                PTR_T.E;
+                RAISE MY_EXCEPTION;
+           EXCEPTION
+                WHEN MY_EXCEPTION =>
+                     RAISE MY_EXCEPTION;
+                WHEN OTHERS =>
+                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 5");
+           END;
+           FAILED ("MY_EXCEPTION NOT RAISED - 5");
+      EXCEPTION
+           WHEN MY_EXCEPTION =>
+                IF GLOBAL_INT = IDENT_INT (0) THEN
+                     FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+      END;
+      
+      -------------------------------------------------------------------
+      GLOBAL_INT := IDENT_INT (0);
+ 
+      DECLARE
+           TYPE ACC_LIM_REC IS ACCESS LIM_REC;
+      BEGIN
+           DECLARE
+                PACKAGE PAC2 IS NEW PAC (LIM_REC, ACC_LIM_REC);
+                USE PAC2;
+           BEGIN
+                E (PTR_T.B);
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("TASK DEPENDENT ON WRONG MASTER - 6");
+      END;
+      IF GLOBAL_INT = IDENT_INT (0) THEN
+           FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
+      END IF;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ END C94011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94020a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94020a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c94020a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c94020a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C94020A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE CONDITIONS FOR TERMINATION ARE RECOGNIZED WHEN THE
+ -- LAST MISSING TASK TERMINATES DUE TO AN ABORT
+ 
+ -- JEAN-PIERRE ROSEN 08-MAR-1984
+ -- JBG 6/1/84
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C94020A IS
+ 
+      TASK TYPE T2 IS
+      END T2;
+      
+      TASK TYPE T3 IS
+           ENTRY E;
+      END T3;
+      
+      TASK BODY T2 IS
+      BEGIN
+           COMMENT("T2");
+      END;
+      
+      TASK BODY T3 IS
+      BEGIN
+           COMMENT("T3");
+           SELECT
+                ACCEPT E;
+           OR TERMINATE;
+           END SELECT;
+           FAILED("T3 EXITED SELECT OR TERMINATE");
+      END;
+ 
+ BEGIN
+ 
+      TEST ("C94020A", "TEST OF TASK DEPENDENCES, TERMINATE, ABORT");
+ 
+      DECLARE
+           TASK TYPE T1 IS
+           END T1;
+           
+           V1 : T1;
+           TYPE A_T1 IS ACCESS T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ABORT T1;
+                DELAY 0.0;          --SYNCHRONIZATION POINT
+                FAILED("T1 NOT ABORTED");
+           END;
+           
+      BEGIN
+           DECLARE
+                V2 : T2;
+                A1 : A_T1;
+           BEGIN
+                DECLARE
+                     V3 : T3;
+                     TASK T4 IS
+                     END T4;
+                     TASK BODY T4 IS
+                          TASK T41 IS
+                          END T41;
+                          TASK BODY T41 IS
+                          BEGIN
+                               COMMENT("T41");
+                               ABORT T4;
+                               DELAY 0.0;       --SYNCHRONIZATION POINT
+                               FAILED("T41 NOT ABORTED");
+                          END;
+                     BEGIN  --T4
+                          COMMENT("T4");
+                     END;
+                BEGIN
+                     COMMENT("BLOC 3");
+                END;
+                COMMENT("BLOC 2");
+                A1 := NEW T1;
+           END;
+           COMMENT("BLOC 1");
+      EXCEPTION
+           WHEN OTHERS => FAILED("SOME EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C94020A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940a03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c940a03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c940a03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,350 ----
+ -- C940A03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a protected object provides coordinated access to
+ --      shared data.  Check that it can implement a semaphore-like construct
+ --      controlling access to shared data through procedure parameters to
+ --      allow a specific maximum number of tasks to run and exclude all
+ --      others.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a resource descriptor tagged type.  Extend the type and
+ --      use the extended type in a protected data structure.
+ --      Implement a counting semaphore type that can be initialized to a 
+ --      specific number of available resources.  Declare an entry for 
+ --      requesting a specific resource and an procedure for releasing the 
+ --      same resource it.  Declare an object of this (protected) type, 
+ --      initialized to two resources.  Declare and start three tasks each 
+ --      of which asks for a resource.  Verify that only two resources are 
+ --      granted and that the last task in is queued.
+ --
+ --      This test models a multi-user operating system that allows a limited
+ --      number of logins.  Users requesting login are modeled by tasks.
+ --
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F940A00
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      13 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1
+ --
+ --!
+ 
+ package C940A03_0 is
+       --Resource_Pkg
+ 
+   -- General type declarations that will be extended to model available
+   -- logins
+ 
+   type Resource_ID_Type is range 0..10;
+   type Resource_Type is tagged record 
+     Id : Resource_ID_Type := 0;
+   end record;
+ 
+ end C940A03_0;
+   --Resource_Pkg
+ 
+ --======================================--
+ -- no body for C940A3_0
+ --======================================--
+ 
+ with F940A00;     -- Interlock_Foundation
+ with C940A03_0;   -- Resource_Pkg;
+ 
+ package C940A03_1 is
+      -- Semaphores
+ 
+   -- Models a counting semaphore that will allow up to a specific 
+   -- number of logins
+   -- Users (tasks) request a login slot by calling the Request_Login
+   -- entry and logout by calling the Release_Login procedure
+ 
+   Max_Logins : constant Integer := 2;
+   
+ 
+   type Key_Type is range 0..100;
+                                       -- When a user requests a login, an
+                                       -- identifying key will be returned
+   Init_Key : constant Key_Type := 0;
+ 
+   type Login_Record_Type is new C940A03_0.Resource_Type with record
+     Key  : Key_Type := Init_Key;
+   end record;
+ 
+ 
+   protected type Login_Semaphore_Type (Resources_Available : Integer :=1) is
+ 
+     entry     Request_Login   (Resource_Key : in out Login_Record_Type);
+     procedure Release_Login;
+     function  Available return Integer;  -- how many logins are available?
+   private
+     Logins_Avail : Integer  := Resources_Available;
+     Next_Key     : Key_Type := Init_Key;
+ 
+   end Login_Semaphore_Type;
+ 
+   Login_Semaphore      : Login_Semaphore_Type (Max_Logins);
+ 
+   --====== machinery for the test, not the model =====--
+   TC_Control_Message : F940A00.Interlock_Type;    
+   function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer;
+ 
+ 
+ end C940A03_1;
+  -- Semaphores;
+ 
+ --=========================================================--
+ 
+ package body C940A03_1 is
+           -- Semaphores is
+ 
+   protected body Login_Semaphore_Type is
+ 
+     entry Request_Login (Resource_Key : in out Login_Record_Type)
+                                              when Logins_Avail > 0 is
+     begin
+       Next_Key := Next_Key + 1;        -- login process returns a key
+       Resource_Key.Key := Next_Key;     -- to the requesting user
+       Logins_Avail := Logins_Avail - 1;
+     end Request_Login;
+ 
+     procedure Release_Login is
+     begin
+       Logins_Avail := Logins_Avail + 1;
+     end Release_Login;
+ 
+     function Available return Integer is
+       begin
+         return Logins_Avail;
+       end Available;
+ 
+   end Login_Semaphore_Type;
+ 
+   function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer is
+     begin
+       return Integer (Login_Rec.Key);
+     end TC_Key_Val;
+ 
+ end C940A03_1;
+  -- Semaphores;
+ 
+ --=========================================================--
+ 
+ with C940A03_0;    -- Resource_Pkg,
+ with C940A03_1;    -- Semaphores;
+ 
+ package C940A03_2 is
+      -- Task_Pkg
+ 
+   package Semaphores renames C940A03_1;
+ 
+   task type User_Task_Type is
+ 
+      entry Login  (user_id : C940A03_0.Resource_Id_Type);
+                       -- instructs the task to ask for a login
+      entry Logout;    -- instructs the task to release the login
+      --=======================--
+      -- this entry is used to get information to verify test operation
+      entry Get_Status (User_Record : out Semaphores.Login_Record_Type);
+ 
+   end User_Task_Type;
+ 
+ end C940A03_2;
+  -- Task_Pkg
+ 
+ --=========================================================--
+ 
+ with Report;
+ with C940A03_0;   -- Resource_Pkg,
+ with C940A03_1;   -- Semaphores,
+ with F940A00;     -- Interlock_Foundation;
+     
+ package body C940A03_2 is
+           -- Task_Pkg 
+ 
+   -- This task models a user requesting a login from the system
+   -- For control of this test, we can ask the task to login, logout, or
+   -- give us the current user record (containing login information)
+ 
+   task body User_Task_Type is
+     Rec  : Semaphores.Login_Record_Type;
+   begin
+     loop
+       select
+         accept Login (user_id : C940A03_0.Resource_Id_Type) do
+           Rec.Id := user_id;
+         end Login;
+ 
+         Semaphores.Login_Semaphore.Request_Login (Rec);
+                       -- request a resource; if resource is not available, 
+                       -- task will be queued to wait
+ 
+         --== following is test control machinery ==--
+         F940A00.Counter.Increment;
+         Semaphores.TC_Control_Message.Post;   
+                -- after resource is obtained, post message
+ 
+       or
+         accept Logout do  
+           Semaphores.Login_Semaphore.Release_Login;
+                       -- release the resource
+           --== test control machinery ==--
+           F940A00.Counter.Decrement;
+         end Logout;
+         exit;
+ 
+       or
+         accept Get_Status (User_Record : out Semaphores.Login_Record_Type) do
+           User_Record := Rec;
+         end Get_Status;
+ 
+       end select;  
+     end loop;
+ 
+   exception
+     when others => Report.Failed ("Exception raised in model user task");
+   end User_Task_Type;
+ 
+ end C940A03_2;
+  -- Task_Pkg
+ 
+ --=========================================================--
+ 
+ with Report;
+ with ImpDef;
+ with C940A03_1;   -- Semaphores, 
+ with C940A03_2;   -- Task_Pkg,
+ with F940A00;     -- Interlock_Foundation;
+ 
+ procedure C940A03 is
+ 
+   package Semaphores renames C940A03_1;
+   package Users      renames C940A03_2;  
+ 
+   Task1, Task2, Task3 : Users.User_Task_Type;
+   User_Rec            : Semaphores.Login_Record_Type;
+ 
+ begin      -- Tasks start here
+ 
+   Report.Test ("C940A03", "Check that a protected object can coordinate " &
+                           "shared data access using procedure parameters");
+ 
+   if F940A00.Counter.Number /=0 then
+     Report.Failed ("Wrong initial conditions");
+   end if;
+                                  
+   Task1.Login (1);               -- request resource; request should be granted
+   Semaphores.TC_Control_Message.Consume;  
+                                  -- ensure that task obtains resource by
+                                  -- waiting for task to post message
+ 
+                                  -- Task 1 waiting for call to Logout
+                                  -- Others still available
+   Task1.Get_Status (User_Rec);
+   if (F940A00.Counter.Number /= 1)
+   or (Semaphores.Login_Semaphore.Available /=1)
+   or (Semaphores.TC_Key_Val (User_Rec) /= 1) then
+     Report.Failed ("Resource not assigned to task 1");
+   end if;
+  
+   Task2.Login (2);               -- Request for resource should be granted  
+   Semaphores.TC_Control_Message.Consume;  
+                                  -- ensure that task obtains resource by
+                                  -- waiting for task to post message
+  
+   Task2.Get_Status (User_Rec);
+   if (F940A00.Counter.Number /= 2)
+   or (Semaphores.Login_Semaphore.Available /=0)
+   or (Semaphores.TC_Key_Val (User_Rec) /= 2) then
+     Report.Failed ("Resource not assigned to task 2");
+   end if;
+  
+ 
+   Task3.Login (3);               -- request for resource should be denied
+                                  -- and task queued
+ 
+ 
+                                  -- Tasks 1 and 2 holds resources
+                                  -- and are waiting for a call to Logout
+                                  -- Task 3 is queued
+ 
+   if (F940A00.Counter.Number /= 2)
+   or (Semaphores.Login_Semaphore.Available /=0) then
+     Report.Failed ("Resource incorrectly assigned to task 3");
+   end if;
+ 
+   Task1.Logout;                  -- released resource should be given to
+                                  -- queued task
+   Semaphores.TC_Control_Message.Consume;  
+                                  -- wait for confirming message from task
+ 
+                                  -- Task 1 holds no resources
+                                  --   and is terminated (or will soon)
+                                  -- Tasks 2 and 3 hold resources
+                                  --   and are waiting for a call to Logout
+ 
+   Task3.Get_Status (User_Rec);
+   if (F940A00.Counter.Number /= 2)
+                       or (Semaphores.Login_Semaphore.Available /=0)
+                       or (Semaphores.TC_Key_Val (User_Rec) /= 3) then
+     Report.Failed ("Resource not properly released/assigned to task 3");
+   end if;
+ 
+   Task2.Logout;                  -- no outstanding request for released
+                                  -- resource
+                                  -- Tasks 1 and 2 hold no resources
+                                  -- Task 3 holds a resource
+                                  --   and is waiting for a call to Logout
+ 
+   if (F940A00.Counter.Number /= 1)
+                         or (Semaphores.Login_Semaphore.Available /=1) then
+     Report.Failed ("Resource not properly released from task 2");
+   end if;
+ 
+   Task3.Logout;
+ 
+                                  -- all resources have been returned
+                                  -- all tasks have terminated or will soon
+ 
+   if (F940A00.Counter.Number /=0)
+                           or (Semaphores.Login_Semaphore.Available /=2) then
+     Report.Failed ("Resource not properly released from task 3");
+   end if;
+ 
+   -- Ensure all tasks have terminated before calling Result
+   while not (Task1'terminated and     
+              Task2'terminated and
+              Task3'terminated)     loop
+     delay ImpDef.Minimum_Task_Switch;   
+   end loop;
+ 
+   Report.Result;
+ 
+ end C940A03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,426 ----
+ -- C95008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE EXCEPTION CONSTRAINT_ERROR IS RAISED FOR AN
+ --   OUT-OF-RANGE INDEX VALUE WHEN REFERENCING AN ENTRY FAMILY,
+ --   EITHER IN AN ACCEPT_STATEMENT OR IN AN ENTRY_CALL.
+ 
+ -- SUBTESTS ARE:
+ --   (A)  INTEGER TYPE, STATIC LOWER BOUND, NO PARAMETERS.
+ --   (B)  CHARACTER TYPE, DYNAMIC UPPER BOUND, NO PARAMETERS.
+ --   (C)  BOOLEAN TYPE, STATIC NULL RANGE, NO PARAMETERS.
+ --   (D)  USER-DEFINED ENUMERATED TYPE, DYNAMIC LOWER BOUND, ONE
+ --           PARAMETER.
+ --   (E)  DERIVED INTEGER TYPE, DYNAMIC NULL RANGE, ONE PARAMETER.
+ --   (F)  DERIVED USER-DEFINED ENUMERATED TYPE, STATIC UPPER BOUND,
+ --           ONE PARAMETER.
+ 
+ -- JRK 11/4/81
+ -- JBG 11/11/84
+ -- SAIC 11/14/95 fixed test for 2.0.1
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95008A IS
+ 
+      C_E_NOT_RAISED : BOOLEAN;
+      WRONG_EXC_RAISED : BOOLEAN;
+ 
+ BEGIN
+      TEST ("C95008A", "OUT-OF-RANGE ENTRY FAMILY INDICES IN " &
+                       "ACCEPT_STATEMENTS AND ENTRY_CALLS");
+ 
+      --------------------------------------------------
+ 
+      C_E_NOT_RAISED := FALSE;
+      WRONG_EXC_RAISED := FALSE;
+ 
+      DECLARE -- (A)
+ 
+           TASK T IS
+                ENTRY E (1..10);
+                ENTRY CONTINUE;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT CONTINUE;
+                SELECT
+                     ACCEPT E (0);
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                END SELECT;
+                C_E_NOT_RAISED := TRUE;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     WRONG_EXC_RAISED := TRUE;
+           END T;
+ 
+      BEGIN -- (A)
+ 
+           SELECT
+                T.E (0);
+           OR
+                DELAY 15.0 * Impdef.One_Second;
+           END SELECT;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ENTRY_CALL - (A)");
+           T.CONTINUE;
+ 
+      EXCEPTION -- (A)
+ 
+           WHEN CONSTRAINT_ERROR =>
+                T.CONTINUE;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN " &
+                        "ENTRY_CALL - (A)");
+                T.CONTINUE;
+ 
+      END; -- (A)
+ 
+      IF C_E_NOT_RAISED THEN
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ACCEPT_STATEMENT - (A)");
+      END IF;
+ 
+      IF WRONG_EXC_RAISED THEN
+           FAILED ("WRONG EXCEPTION RAISED IN " &
+                   "ACCEPT_STATEMENT - (A)");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      C_E_NOT_RAISED := FALSE;
+      WRONG_EXC_RAISED := FALSE;
+ 
+      DECLARE -- (B)
+ 
+           TASK T IS
+                ENTRY E (CHARACTER RANGE 'A'..'Y');
+                ENTRY CONTINUE;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT CONTINUE;
+                SELECT
+                     ACCEPT E (IDENT_CHAR('Z'));
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                END SELECT;
+                C_E_NOT_RAISED := TRUE;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     WRONG_EXC_RAISED := TRUE;
+           END T;
+ 
+      BEGIN -- (B)
+ 
+           SELECT
+                T.E (IDENT_CHAR('Z'));
+           OR
+                DELAY 15.0 * Impdef.One_Second;
+           END SELECT;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ENTRY_CALL - (B)");
+           T.CONTINUE;
+ 
+      EXCEPTION -- (B)
+ 
+           WHEN CONSTRAINT_ERROR =>
+                T.CONTINUE;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN " &
+                        "ENTRY_CALL - (B)");
+                T.CONTINUE;
+ 
+      END; -- (B)
+ 
+      IF C_E_NOT_RAISED THEN
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ACCEPT_STATEMENT - (B)");
+      END IF;
+ 
+      IF WRONG_EXC_RAISED THEN
+           FAILED ("WRONG EXCEPTION RAISED IN " &
+                   "ACCEPT_STATEMENT - (B)");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      C_E_NOT_RAISED := FALSE;
+      WRONG_EXC_RAISED := FALSE;
+ 
+      DECLARE -- (C)
+ 
+           TASK T IS
+                ENTRY E (TRUE..FALSE);
+                ENTRY CONTINUE;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT CONTINUE;
+                SELECT
+                     ACCEPT E (FALSE);
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                END SELECT;
+                C_E_NOT_RAISED := TRUE;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     WRONG_EXC_RAISED := TRUE;
+           END T;
+ 
+      BEGIN -- (C)
+ 
+           SELECT
+                T.E (TRUE);
+           OR
+                DELAY 15.0 * Impdef.One_Second;
+           END SELECT;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ENTRY_CALL - (C)");
+           T.CONTINUE;
+ 
+      EXCEPTION -- (C)
+ 
+           WHEN CONSTRAINT_ERROR =>
+                T.CONTINUE;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN " &
+                        "ENTRY_CALL - (C)");
+                T.CONTINUE;
+ 
+      END; -- (C)
+ 
+      IF C_E_NOT_RAISED THEN
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ACCEPT_STATEMENT - (C)");
+      END IF;
+ 
+      IF WRONG_EXC_RAISED THEN
+           FAILED ("WRONG EXCEPTION RAISED IN " &
+                   "ACCEPT_STATEMENT - (C)");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      C_E_NOT_RAISED := FALSE;
+      WRONG_EXC_RAISED := FALSE;
+ 
+      DECLARE -- (D)
+ 
+           TYPE ET IS (E0, E1, E2);
+           DLB : ET := ET'VAL (IDENT_INT(1));      -- E1.
+ 
+           TASK T IS
+                ENTRY E (ET RANGE DLB..E2) (I : INTEGER);
+                ENTRY CONTINUE;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT CONTINUE;
+                SELECT
+                     ACCEPT E (E0) (I : INTEGER);
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                END SELECT;
+                C_E_NOT_RAISED := TRUE;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     WRONG_EXC_RAISED := TRUE;
+           END T;
+ 
+      BEGIN -- (D)
+ 
+           SELECT
+                T.E (E0) (0);
+           OR
+                DELAY 15.0 * Impdef.One_Second;
+           END SELECT;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ENTRY_CALL - (D)");
+           T.CONTINUE;
+ 
+      EXCEPTION -- (D)
+ 
+           WHEN CONSTRAINT_ERROR =>
+                T.CONTINUE;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN " &
+                        "ENTRY_CALL - (D)");
+                T.CONTINUE;
+ 
+      END; -- (D)
+ 
+      IF C_E_NOT_RAISED THEN
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ACCEPT_STATEMENT - (D)");
+      END IF;
+ 
+      IF WRONG_EXC_RAISED THEN
+           FAILED ("WRONG EXCEPTION RAISED IN " &
+                   "ACCEPT_STATEMENT - (D)");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      C_E_NOT_RAISED := FALSE;
+      WRONG_EXC_RAISED := FALSE;
+ 
+      DECLARE -- (E)
+ 
+           TYPE D_I IS NEW INTEGER;
+           SUBTYPE DI IS D_I RANGE 3 .. D_I(IDENT_INT(2));
+ 
+           TASK T IS
+                ENTRY E (DI) (I : INTEGER);
+                ENTRY CONTINUE;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT CONTINUE;
+                SELECT
+                     ACCEPT E (D_I(3)) (I : INTEGER);
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                END SELECT;
+                C_E_NOT_RAISED := TRUE;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     WRONG_EXC_RAISED := TRUE;
+           END T;
+ 
+      BEGIN -- (E)
+ 
+           SELECT
+                T.E (D_I(2)) (0);
+           OR
+                DELAY 15.0 * Impdef.One_Second;
+           END SELECT;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ENTRY_CALL - (E)");
+           T.CONTINUE;
+ 
+      EXCEPTION -- (E)
+ 
+           WHEN CONSTRAINT_ERROR =>
+                T.CONTINUE;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN " &
+                        "ENTRY_CALL - (E)");
+                T.CONTINUE;
+ 
+      END; -- (E)
+ 
+      IF C_E_NOT_RAISED THEN
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ACCEPT_STATEMENT - (E)");
+      END IF;
+ 
+      IF WRONG_EXC_RAISED THEN
+           FAILED ("WRONG EXCEPTION RAISED IN " &
+                   "ACCEPT_STATEMENT - (E)");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      C_E_NOT_RAISED := FALSE;
+      WRONG_EXC_RAISED := FALSE;
+ 
+      DECLARE -- (F)
+ 
+           TYPE ET IS (E0, E1, E2);
+           TYPE D_ET IS NEW ET;
+ 
+           TASK T IS
+                ENTRY E (D_ET RANGE E0..E1) (I : INTEGER);
+                ENTRY CONTINUE;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT CONTINUE;
+                SELECT
+                     ACCEPT E (D_ET'(E2)) (I : INTEGER);
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                END SELECT;
+                C_E_NOT_RAISED := TRUE;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     WRONG_EXC_RAISED := TRUE;
+           END T;
+ 
+      BEGIN -- (F)
+ 
+           SELECT
+                T.E (D_ET'(E2)) (0);
+           OR
+                DELAY 15.0 * Impdef.One_Second;
+           END SELECT;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ENTRY_CALL - (F)");
+           T.CONTINUE;
+ 
+      EXCEPTION -- (F)
+ 
+           WHEN CONSTRAINT_ERROR =>
+                T.CONTINUE;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN " &
+                        "ENTRY_CALL - (F)");
+                T.CONTINUE;
+ 
+      END; -- (F)
+ 
+      IF C_E_NOT_RAISED THEN
+           FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                   "ACCEPT_STATEMENT - (F)");
+      END IF;
+ 
+      IF WRONG_EXC_RAISED THEN
+           FAILED ("WRONG EXCEPTION RAISED IN " &
+                   "ACCEPT_STATEMENT - (F)");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,121 ----
+ -- C95009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK OBJECT CAN CALL ENTRIES OF OTHER TASKS.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES.
+ 
+ -- JRK 11/5/81
+ -- JRK 8/3/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95009A IS
+ 
+      V1 : INTEGER := 0;
+      V2 : INTEGER := 0;
+ 
+      PI : INTEGER := 0;
+      PO : INTEGER := 0;
+ 
+ BEGIN
+      TEST ("C95009A", "CHECK THAT A TASK OBJECT CAN CALL ENTRIES " &
+                       "OF OTHER TASKS");
+ 
+      DECLARE
+ 
+           SUBTYPE INT IS INTEGER RANGE 1..5;
+ 
+           TASK T1 IS
+                ENTRY E1N;
+                ENTRY EF1P (INT) (I : OUT INTEGER);
+           END T1;
+ 
+           TASK TYPE T2T IS
+                ENTRY E2P (I : INTEGER);
+                ENTRY EF2N (INT);
+           END T2T;
+ 
+           TYPE AT2T IS ACCESS T2T;
+           AT2 : AT2T;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                V1 := 1;
+                ACCEPT E1N;
+                V1 := 2;
+                AT2.E2P (1);
+                V1 := 3;
+                ACCEPT EF1P (2) (I : OUT INTEGER) DO
+                     I := 2;
+                END EF1P;
+                V1 := 4;
+                AT2.EF2N (IDENT_INT(3));
+                V1 := 5;
+           END T1;
+ 
+           TASK BODY T2T IS
+           BEGIN
+                V2 := 1;
+                T1.E1N;
+                V2 := 2;
+                ACCEPT E2P (I : INTEGER) DO
+                     PI := I;
+                END E2P;
+                V2 := 3;
+                T1.EF1P (2) (PO);
+                V2 := 4;
+                ACCEPT EF2N (1+IDENT_INT(2));
+                V2 := 5;
+           END T2T;
+ 
+           PACKAGE DUMMY IS
+           END DUMMY;
+ 
+           PACKAGE BODY DUMMY IS
+           BEGIN
+                AT2 := NEW T2T;
+           END DUMMY;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      IF V1 /= 5 THEN
+           FAILED ("TASK T1 ONLY REACHED V1 = " & INTEGER'IMAGE(V1));
+      END IF;
+ 
+      IF V2 /= 5 THEN
+           FAILED ("TASK AT2 ONLY REACHED V2 = " & INTEGER'IMAGE(V2));
+      END IF;
+ 
+      IF PI /= 1 THEN
+           FAILED ("ENTRY IN PARAMETER NOT PASSED CORRECTLY");
+      END IF;
+ 
+      IF PO /= 2 THEN
+           FAILED ("ENTRY OUT PARAMETER NOT PASSED CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ END C95009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C95010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK MAY CONTAIN MORE THAN ONE ACCEPT_STATEMENT
+ --   FOR AN ENTRY.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES.
+ 
+ -- JRK 11/5/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95010A IS
+ 
+      V : INTEGER := 0;
+ 
+ BEGIN
+      TEST ("C95010A", "CHECK THAT A TASK MAY CONTAIN MORE THAN " &
+                       "ONE ACCEPT_STATEMENT FOR AN ENTRY");
+ 
+      DECLARE
+ 
+           SUBTYPE INT IS INTEGER RANGE 1..5;
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY EF (INT) (I : INTEGER);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                V := 1;
+                ACCEPT E;
+                V := 2;
+                ACCEPT E;
+                V := 3;
+                ACCEPT EF (2) (I : INTEGER) DO
+                     V := I;
+                END EF;
+                V := 5;
+                ACCEPT EF (2) (I : INTEGER) DO
+                     V := I;
+                END EF;
+                V := 7;
+           END T;
+ 
+      BEGIN
+ 
+           T.E;
+           T.E;
+           T.EF (2) (4);
+           T.EF (2) (6);
+ 
+      END;
+ 
+      IF V /= 7 THEN
+           FAILED ("WRONG CONTROL FLOW VALUE");
+      END IF;
+ 
+      RESULT;
+ END C95010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- C95011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK NEED NOT CONTAIN ANY ACCEPT_STATEMENTS FOR AN
+ --   ENTRY.
+ 
+ -- THIS TEST CONTAINS SHARED VARIABLES.
+ 
+ -- JRK 11/5/81
+ -- JWC 6/28/85   RENAMED TO -AB
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95011A IS
+ 
+      V : INTEGER := 0;
+ 
+ BEGIN
+      TEST ("C95011A", "CHECK THAT A TASK NEED NOT CONTAIN ANY " &
+                       "ACCEPT_STATEMENTS FOR AN ENTRY");
+ 
+      DECLARE
+ 
+           SUBTYPE INT IS INTEGER RANGE 1..5;
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY EF (INT) (I : INTEGER);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                V := 1;
+           END T;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      IF V /= 1 THEN
+           FAILED ("WRONG CONTROL FLOW VALUE");
+      END IF;
+ 
+      RESULT;
+ END C95011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95012a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95012a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95012a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- C95012A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CALL TO AN ENTRY OF A TASK THAT HAS NOT BEEN ACTIVATED
+ --   DOES NOT RAISE EXCEPTIONS.
+ 
+ -- THIS TEST CONTAINS RACE CONDITIONS.
+ 
+ -- JRK 11/6/81
+ -- SPS 11/21/82
+ -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C95012A IS
+ 
+      I : INTEGER := 0;
+ 
+ 
+ BEGIN
+      TEST ("C95012A", "CHECK THAT A CALL TO AN ENTRY OF A TASK " &
+                       "THAT HAS NOT BEEN ACTIVATED DOES NOT " &
+                       "RAISE EXCEPTIONS");
+ 
+      DECLARE
+ 
+           TASK T1 IS
+                ENTRY E1 (I : OUT INTEGER);
+           END T1;
+ 
+           TASK TYPE T2T IS
+                ENTRY E2 (I : OUT INTEGER);
+           END T2T;
+ 
+           TYPE AT2T IS ACCESS T2T;
+           AT2 : AT2T;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E1 (I : OUT INTEGER) DO
+                     I := IDENT_INT (1);
+                END E1;
+           END T1;
+ 
+           TASK BODY T2T IS
+                J : INTEGER := 0;
+           BEGIN
+                BEGIN
+                     T1.E1 (J);
+                EXCEPTION
+                     WHEN OTHERS =>
+                          J := -1;
+                END;
+                ACCEPT E2 (I : OUT INTEGER) DO
+                     I := J;
+                END E2;
+           END T2T;
+ 
+           PACKAGE PKG IS
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                AT2 := NEW T2T;
+                DELAY 60.0 * Impdef.One_Second;
+           END PKG;
+ 
+      BEGIN
+ 
+           AT2.ALL.E2 (I);
+ 
+           IF I = -1 THEN 
+                FAILED ("EXCEPTION RAISED");
+                T1.E1 (I);
+           END IF;
+ 
+           IF I /= 1 THEN
+                FAILED ("WRONG VALUE PASSED");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ END C95012A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95021a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95021a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95021a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95021a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,182 ----
+ -- C95021A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE.
+ 
+ -- JBG 2/22/84
+ -- DAS 10/8/90  ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO
+ --              DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE
+ --              IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM
+ --              FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR
+ --              AN ENTRY E).
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ -- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE.
+ --
+ -- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS
+ -- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY.  THE TEST
+ -- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD.  (IT IS
+ -- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO
+ -- THIS MORE COMPLICATED APPROACH IS NECESSARY.)
+ --
+ -- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO
+ -- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL.
+ --
+ -- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE
+ -- ENTRY IN THE TASK QUEUE.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM;
+ PROCEDURE C95021A IS
+ BEGIN
+ 
+      TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES");
+ 
+ -- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING.
+      FOR I IN 1..3 LOOP  
+           COMMENT ("ITERATION" & INTEGER'IMAGE(I));
+ 
+      DECLARE
+ 
+           TASK TYPE CALLERS IS
+                ENTRY NAME (N : NATURAL);
+           END CALLERS;
+ 
+           TASK QUEUE IS
+                ENTRY GO;
+                ENTRY E1 (NAME : NATURAL);
+           END QUEUE;
+ 
+           TASK DISPATCH IS
+                ENTRY READY;
+           END DISPATCH;
+ 
+           TASK BODY CALLERS IS
+                MY_NAME : NATURAL;
+           BEGIN
+ 
+ -- GET NAME OF THIS TASK OBJECT
+                ACCEPT NAME (N : NATURAL) DO
+                     MY_NAME := N;
+                END NAME;
+ 
+ -- PUT THIS TASK ON QUEUE FOR QUEUE.E1
+                QUEUE.E1 (MY_NAME);
+           END CALLERS;
+ 
+           TASK BODY DISPATCH IS
+                TYPE ACC_CALLERS IS ACCESS CALLERS;
+                OBJ : ACC_CALLERS;
+           BEGIN
+ 
+ -- FIRE UP TWO CALLERS FOR QUEUE.E1
+                OBJ := NEW CALLERS;
+                OBJ.NAME(1);
+                OBJ := NEW CALLERS;
+                OBJ.NAME(2);
+ 
+ -- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED).
+                QUEUE.GO;
+ 
+ -- WAIT TILL ONE CALL HAS BEEN PROCESSED.
+                ACCEPT READY;       -- CALLED FROM QUEUE
+ 
+ -- FIRE UP THIRD CALLER
+                OBJ := NEW CALLERS;
+                OBJ.NAME(3);
+ 
+           END DISPATCH;
+ 
+           TASK BODY QUEUE IS
+                NEXT : NATURAL;     -- NUMBER OF SECOND CALLER IN QUEUE.
+           BEGIN
+ 
+ -- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED.
+                ACCEPT GO;
+ 
+ -- WAIT FOR TWO CALLS TO BE AVAILABLE.  THIS WAIT ASSUMES THAT THE
+ -- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY
+ -- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD.
+                FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
+                LOOP
+                     EXIT WHEN E1'COUNT = 2;
+                     DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
+                END LOOP;
+ 
+                IF E1'COUNT /= 2 THEN
+                     FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
+                             "MINUTE - 1");
+                END IF;
+ 
+ -- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS.
+                ACCEPT E1 (NAME : NATURAL) DO
+ 
+ -- GET NAME OF NEXT CALLER
+                     CASE NAME IS
+                          WHEN 1 => 
+                               NEXT := 2;
+                          WHEN 2 => 
+                               NEXT := 1;
+                          WHEN OTHERS => 
+                               FAILED ("UNEXPECTED ERROR");
+                     END CASE;
+                END E1;
+ 
+ -- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE).
+                DISPATCH.READY;
+ 
+ -- WAIT FOR CALL TO ARRIVE.
+                FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
+                LOOP
+                     EXIT WHEN E1'COUNT = 2;
+                     DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
+                END LOOP;
+ 
+                IF E1'COUNT /= 2 THEN
+                     FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
+                             "MINUTE - 2");
+                END IF;
+ 
+ -- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE
+ -- CORRECT TASK.
+                ACCEPT E1 (NAME : NATURAL) DO
+                     IF NAME /= NEXT THEN
+                          FAILED ("FIFO DISCIPLINE NOT OBEYED");
+                     END IF;
+                END E1;
+ 
+ -- ACCEPT THE LAST CALLER
+                ACCEPT E1 (NAME : NATURAL);
+ 
+           END QUEUE;
+ 
+      BEGIN
+           NULL;
+      END;           -- ALL TASKS NOW TERMINATED.
+      END LOOP;
+ 
+      RESULT;
+ 
+ END C95021A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95022a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95022a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95022a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95022a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ --C95022A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --CHECK THAT IT IS POSSIBLE TO ACCEPT AN ENTRY CALL FROM INSIDE THE
+ --THE BODY OF AN ACCEPT STATEMENT.
+ 
+ --CHECK THE CASE OF NORMAL ENTRY TERMINATION.
+ 
+ -- JEAN-PIERRE ROSEN 25-FEB-1984
+ -- JBG 6/1/84
+ 
+ -- FOUR CLIENT TASKS CALL ONE SERVER TASK.  EACH CLIENT CALLS JUST ONE
+ -- ENTRY OF THE SERVER TASK.  THE TEST CHECKS TO BE SURE THAT CALLS FROM
+ -- DIFFERENT TASKS ARE NOT MIXED UP.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95022A IS
+ 
+ BEGIN
+      TEST("C95022A", "CHECK THAT EMBEDDED RENDEZVOUS ARE PROCESSED " &
+                      "CORRECTLY");
+      DECLARE
+ 
+           TASK TYPE CLIENT IS
+                ENTRY GET_ID (I : INTEGER);
+                ENTRY RESTART;
+           END CLIENT;
+      
+           T_ARR : ARRAY (1..4) OF CLIENT;
+      
+           TASK SERVER IS
+                ENTRY E1 (I : IN OUT INTEGER);
+                ENTRY E2 (I : IN OUT INTEGER);
+                ENTRY E3 (I : IN OUT INTEGER);
+                ENTRY E4 (I : IN OUT INTEGER);
+           END SERVER;
+      
+           TASK BODY SERVER IS
+           BEGIN
+      
+                ACCEPT E1 (I : IN OUT INTEGER) DO
+                     ACCEPT E2 (I : IN OUT INTEGER) DO
+                          I := IDENT_INT(I);
+                          ACCEPT E3 (I : IN OUT INTEGER) DO
+                               ACCEPT E4 (I : IN OUT INTEGER) DO
+                                    I := IDENT_INT(I);
+                               END E4;
+                               I := IDENT_INT(I);
+                          END E3;
+                     END E2;
+                     I := IDENT_INT(I);
+                END E1;
+      
+                FOR I IN 1 .. 4 LOOP
+                     T_ARR(I).RESTART;
+                END LOOP;
+           END SERVER;
+      
+           TASK BODY CLIENT IS
+                ID      : INTEGER;
+                SAVE_ID : INTEGER;
+           BEGIN
+                ACCEPT GET_ID (I : INTEGER) DO
+                     ID := I;
+                END GET_ID;
+      
+                SAVE_ID := ID;
+      
+                CASE ID IS
+                     WHEN 1      => SERVER.E1(ID);
+                     WHEN 2      => SERVER.E2(ID);
+                     WHEN 3      => SERVER.E3(ID);
+                     WHEN 4      => SERVER.E4(ID);
+                     WHEN OTHERS => FAILED("INCORRECT ID");
+                END CASE;
+ 
+                ACCEPT RESTART;  -- WAIT FOR ALL TASKS TO HAVE COMPLETED
+                                 -- RENDEZVOUS
+                IF ID /= SAVE_ID THEN
+                     FAILED("SCRAMBLED EMBEDDED RENDEZVOUS");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS => FAILED("EXCEPTION IN CLIENT");
+           END CLIENT;
+      
+      BEGIN
+           FOR I IN 1 .. 4 LOOP
+                T_ARR(I).GET_ID(I);
+           END LOOP;
+      END;
+ 
+      RESULT;
+ 
+ END C95022A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95022b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95022b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95022b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95022b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C95022B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IT IS POSSIBLE TO ACCEPT AN ENTRY CALL FROM INSIDE
+ -- THE BODY OF AN ACCEPT STATEMENT.
+ 
+ -- CHECK THE CASE OF ABORT DURING THE INNERMOST ACCEPT.
+ 
+ -- JEAN-PIERRE ROSEN 25-FEB-1984
+ -- JBG 6/1/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95022B IS
+ 
+ BEGIN
+ 
+      TEST("C95022B", "CHECK THAT EMBEDDED RENDEZVOUS ARE PROCESSED " &
+                      "CORRECTLY (ABORT CASE)");
+      DECLARE
+           TASK TYPE CLIENT IS
+                ENTRY GET_ID (I : INTEGER);
+           END CLIENT;
+      
+           T_ARR : ARRAY (1..4) OF CLIENT;
+      
+           TASK KILL IS
+                ENTRY ME;
+           END KILL;
+      
+           TASK SERVER IS
+                ENTRY E1;
+                ENTRY E2;
+                ENTRY E3;
+                ENTRY E4;
+           END SERVER;
+      
+           TASK BODY SERVER IS
+           BEGIN
+      
+                ACCEPT E1 DO
+                     ACCEPT E2 DO
+                          ACCEPT E3 DO
+                               ACCEPT E4 DO
+                                    KILL.ME;
+                                    E1;  -- WILL DEADLOCK UNTIL ABORT.
+                               END E4;
+                          END E3;
+                     END E2;
+                END E1;
+      
+           END SERVER;
+      
+           TASK BODY KILL IS
+           BEGIN
+                ACCEPT ME;
+                ABORT SERVER;
+           END;
+ 
+           TASK BODY CLIENT IS
+                ID : INTEGER;
+           BEGIN
+                ACCEPT GET_ID( I : INTEGER) DO
+                     ID := I;
+                END GET_ID;
+      
+                CASE ID IS
+                     WHEN 1      => SERVER.E1;
+                     WHEN 2      => SERVER.E2;
+                     WHEN 3      => SERVER.E3;
+                     WHEN 4      => SERVER.E4;
+                     WHEN OTHERS => FAILED ("INCORRECT ID");
+                END CASE;
+      
+                FAILED ("TASKING_ERROR NOT RAISED IN CLIENT" & 
+                        INTEGER'IMAGE(ID));
+      
+           EXCEPTION
+                WHEN TASKING_ERROR => 
+                     NULL;
+                WHEN OTHERS => 
+                     FAILED("EXCEPTION IN CLIENT" & INTEGER'IMAGE(ID));
+           END CLIENT;
+      BEGIN
+           FOR I IN 1 .. 4 LOOP
+                T_ARR(I).GET_ID(I);
+           END LOOP;
+      END;
+ 
+      RESULT;
+ 
+ END C95022B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95033a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95033a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95033a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95033a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C95033A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT - IN THE CASE OF AN ENTRY FAMILY - EXECUTION OF AN
+ -- ACCEPT STATEMENT STARTS WITH THE EVALUATION OF AN ENTRY INDEX.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C950BGA-B.ADA
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C95033A IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+           RETURN DIGT;
+      END FINIT_POS;
+ 
+      TASK T1 IS
+           ENTRY E1 (NATURAL RANGE 1 .. 2);
+           ENTRY BYE;
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1 (FINIT_POS (1)) DO
+                PSPY_NUMB (2);
+           END E1;
+           ACCEPT BYE;
+      END T1;
+ 
+ BEGIN
+      TEST ("C95033A", "EVALUATION OF ENTRY INDEX");
+ 
+      T1.E1 (1);
+      T1.BYE;
+      IF SPYNUMB /= 12 THEN
+           FAILED ("ENTRY INDEX NOT EVALUATED FIRST");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C95033A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95033b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95033b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95033b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95033b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- C95033B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EXECUTION OF AN ENTRY CALL STARTS WITH THE EVALUATION OF
+ -- ANY ENTRY INDEX, FOLLOWED BY THE EVALUATION OF ANY EXPRESSION IN
+ -- THE PARAMETER LIST.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C950BHA-B.ADA
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C95033B IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+           RETURN DIGT;
+      END FINIT_POS;
+ 
+      TASK T1 IS
+           ENTRY E1 (NATURAL RANGE 1 .. 2) (P1 : IN NATURAL);
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1 (1) (P1 : IN NATURAL);
+      END T1;
+ 
+ BEGIN
+ 
+      TEST ("C95033B", "EVALUATION OF ENTRY INDEX AND OF " &
+                       "EXPRESSIONS IN PARAMETER LIST");
+ 
+      T1.E1 (FINIT_POS (1)) (FINIT_POS (2));
+      IF SPYNUMB /= 12 THEN
+           FAILED ("ENTRY INDEX NOT EVALUATED FIRST");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C95033B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95034a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95034a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95034a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95034a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C95034A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CALLING TASK IS SUSPENDED IF THE RECEIVING TASK
+ -- HAS NOT REACHED A CORRESPONDING ACCEPT STATEMENT.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C950BJA-B.ADA
+ 
+ with Impdef;
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C95034A IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+      TASK T1 IS
+           ENTRY E1;
+           ENTRY E2;
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1 DO
+                PSPY_NUMB (1);
+                DELAY 1.0 * Impdef.One_Second;
+           END E1;
+           ACCEPT E2 DO
+                PSPY_NUMB (2);
+           END E2;
+      END T1;
+ 
+      TASK T2 IS
+           ENTRY BYE;
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           T1.E2;
+           PSPY_NUMB (3);
+           ACCEPT BYE;
+      END T2;
+ 
+ BEGIN
+ 
+      TEST ("C95034A", "SUSPENSION OF CALLING TASK");
+ 
+      T1.E1;
+      T2.BYE;
+ 
+      IF SPYNUMB /= 123 THEN
+           FAILED ("ERROR DURING TASK EXECUTION");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C95034A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95034b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95034b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95034b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95034b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- C95034B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CALLING TASK REMAINS SUSPENDED UNTIL THE ACCEPT
+ -- STATEMENT RECEIVING THIS ENTRY CALL HAS COMPLETED THE EXECUTION OF
+ -- ITS SEQUENCE OF STATEMENTS.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C950CBA-B.ADA
+ 
+ with Impdef;
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C95034B IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+      TASK T1 IS
+           ENTRY E1;
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1 DO
+                PSPY_NUMB (1);
+                DELAY 1.0 * Impdef.One_Second;
+                PSPY_NUMB (2);
+           END E1;
+      END T1;
+ 
+      TASK T2 IS
+           ENTRY BYE;
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           T1.E1;
+           PSPY_NUMB (3);
+           ACCEPT BYE;
+      END T2;
+ 
+ BEGIN
+ 
+      TEST ("C95034B", "TASK SUSPENSION UNTIL COMPLETION OF ACCEPT " &
+                       "STATEMENT");
+ 
+      T2.BYE;
+ 
+      IF SPYNUMB /= 123 THEN
+           FAILED ("ERROR DURING TASK EXECUTION");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C95034B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95035a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95035a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95035a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95035a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- C95035A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK IS SUSPENDED IF IT REACHES AN ACCEPT STATEMENT
+ -- PRIOR TO ANY CALL OF THE CORRESPONDING ENTRY.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C950CAA-B.ADA
+ 
+ with Impdef;
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C95035A IS
+ 
+      SUBTYPE ARG IS NATURAL RANGE 0..9;
+      SPYNUMB : NATURAL := 0;
+ 
+      PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+      BEGIN
+           SPYNUMB := 10*SPYNUMB+DIGT;
+      END PSPY_NUMB;
+ 
+      TASK T1 IS
+           ENTRY E1;
+           ENTRY BYE;
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1;
+           PSPY_NUMB (2);
+           ACCEPT BYE;
+      END T1;
+ 
+      TASK T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           DELAY 1.0 * Impdef.One_Second;
+           PSPY_NUMB (1);
+           T1.E1;
+      END T2;
+ 
+ BEGIN
+ 
+      TEST ("C95035A", "TASK SUSPENSION PRIOR TO ENTRY CALL");
+ 
+      T1.BYE;
+ 
+      IF SPYNUMB /= 12 THEN
+           FAILED ("ERROR DURING TASK EXECUTION");
+           COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+      END IF;
+ 
+      RESULT;
+ 
+ END C95035A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- C95040A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE EXCEPTION TASKING_ERROR IS RAISED IF AN ENTRY OF A
+ -- COMPLETED TASK IS CALLED.
+ 
+ -- WEI  3/ 4/82
+ -- JWC 6/28/85   RENAMED FROM C950CHA-B.ADA
+ 
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C95040A IS
+ BEGIN
+ 
+      TEST ("C95040A", "ENTRY CALL OF COMPLETED TASK");
+ 
+ BLOCK1 :
+      DECLARE
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E1;
+           END T1;
+      BEGIN  -- BLOCK1
+           T1.E1;
+           T1.E1;
+ 
+           FAILED ("DID NOT RAISE TASKING_ERROR");
+      EXCEPTION
+           WHEN TASKING_ERROR => NULL;
+      END BLOCK1;
+ 
+      RESULT;
+ 
+ END C95040A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- C95040B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE EXCEPTION TASKING_ERROR IS RAISED BY A TASK IF THE
+ -- TASK BECOMES COMPLETED OR ABNORMAL BEFORE ACCEPTING THE CALL.
+ 
+ -- WEI  3/ 4/82
+ -- TLB 10/30/87  RENAMED FROM C950CHC.ADA.
+ 
+ with Impdef;
+ WITH REPORT;
+  USE REPORT;
+ PROCEDURE C95040B IS
+ 
+      TASK T1 IS
+           ENTRY E1;
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           DELAY 1.0 * Impdef.One_Second;
+           IF EQUAL (1, 1) THEN
+                ABORT T1;
+           END IF;
+           ACCEPT E1;
+      END T1;
+ 
+ BEGIN
+ 
+      TEST ("C95040B", "TASK COMPLETION BEFORE ACCEPTING AN ENTRY CALL");
+ 
+      T1.E1;
+ 
+      FAILED ("NO EXCEPTION TASKING_ERROR RAISED");
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN TASKING_ERROR =>
+           RESULT;
+ 
+ END C95040B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,86 ----
+ -- C95040C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECKS THAT A TASK COMPLETED, BUT NOT TERMINATED (I.E. WAITING
+ -- FOR TERMINATION OF A DEPENDENT TASK) IS NEITHER 'TERMINATED NOR
+ -- 'CALLABLE.  CALLS TO ENTRIES BELONGING TO SUCH A TASK RAISE
+ -- TASKING_ERROR.
+ 
+ -- J.P. ROSEN, ADA PROJECT, NYU
+ -- JBG 6/1/84
+ -- JWC 6/28/85   RENAMED FROM C9A009A-B.ADA
+ -- PWN 9/11/94   REMOVED PRAGMA PRIORITY FOR ADA 9X
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C95040C IS
+ BEGIN
+ 
+      TEST ("C95040C", "TASKING_ERROR RAISED WHEN CALLING COMPLETED " &
+                       "BUT UNTERMINATED TASK");
+ 
+      DECLARE
+ 
+           TASK T1 IS
+                ENTRY E;
+           END T1;
+ 
+           TASK BODY T1 IS
+ 
+                TASK T2 IS
+                END T2;
+ 
+                TASK BODY T2 IS
+                BEGIN
+                     COMMENT ("BEGIN T2");
+                     T1.E;          -- T1 WILL COMPLETE BEFORE THIS CALL
+                                    -- OR WHILE WAITING FOR THIS CALL TO
+                                    -- BE ACCEPTED.  WILL DEADLOCK IF
+                                    -- TASKING_ERROR IS NOT RAISED.
+                     FAILED ("NO TASKING_ERROR RAISED");
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          IF T1'CALLABLE THEN
+                               FAILED ("T1 STILL CALLABLE");
+                          END IF;
+ 
+                          IF T1'TERMINATED THEN    -- T1 CAN'T TERMINATE
+                                                   -- UNTIL T2 HAS
+                                                   -- TERMINATED.
+                               FAILED ("T1 TERMINATED");
+                          END IF;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION");
+                END T2;
+           BEGIN
+                NULL;
+           END;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END C95040C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95040d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95040d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- C95040D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT TASKING_ERROR IS RAISED IN A CALLING
+ -- TASK WHEN THE TASK OWNING THE ENTRY TERMINATES BEFORE RENDEZVOUS
+ -- CAN OCCUR.
+ 
+ -- CHECK THAT RE-RAISING TASKING_ERROR, ONCE TRAPPED IN THE CALLER,
+ -- DOES NOT PROPAGATE OUTSIDE THE TASK BODY.
+ 
+ -- GOM 11/29/84
+ -- JWC 05/14/85
+ -- PWB 02/11/86  CORRECTED CALL TO TEST TO SHOW CORRECT TEST NAME.
+ -- RLB 12/15/99  REMOVED POTENTIALLY ERRONEOUS CALLS TO REPORT.COMMENT.
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE C95040D IS
+ 
+      PROCEDURE DRIVER IS
+ 
+           TASK NEST IS
+                ENTRY OUTER;
+                ENTRY INNER;
+           END NEST;
+ 
+           TASK SLAVE;
+ 
+           TASK BODY NEST IS
+           BEGIN
+                --COMMENT("AT TOP OF 'NEST' TASK WAITING ON 'OUTER' " &
+                --        "RENDEZVOUS");
+ 
+                ACCEPT OUTER DO
+                     --COMMENT("IN 'OUTER' RENDEZVOUS OF 'NEST' TASK " &
+                     --        "ABOUT TO 'RETURN'");
+ 
+                     RETURN;  -- CAUSES 'INNER' RENDEZVOUS TO BE SKIPPED.
+ 
+                     ACCEPT INNER DO
+                          FAILED("'INNER' RENDEZVOUS OF 'NEST' TASK " &
+                                 "SHOULD NEVER BE PERFORMED");
+                     END INNER;
+                END OUTER;
+ 
+                --COMMENT("'OUTER' RENDEZVOUS COMPLETED IN 'NEST' TASK " &
+                --        "AND NOW TERMINATING");
+           END NEST;
+ 
+           TASK BODY SLAVE IS
+           BEGIN
+                --COMMENT("AT TOP OF 'SLAVE' TASK. CALLING 'INNER' " &
+                --        "RENDEZVOUS");
+ 
+                NEST.INNER;
+ 
+                FAILED("SHOULD HAVE RAISED 'TASKING_ERROR' IN 'SLAVE' " &
+                       "TASK");
+           EXCEPTION
+                WHEN TASKING_ERROR =>
+                     --COMMENT("'SLAVE' TASK CORRECTLY TRAPPING " &
+                     --        "'TASKING_ERROR' AND RE-RAISING IT (BUT " &
+                     --        "SHOULD NOT BE PROPAGATED)");
+                     RAISE;
+           END SLAVE;
+ 
+      BEGIN  -- START OF DRIVER PROCEDURE.
+ 
+           --COMMENT("AT TOP OF 'DRIVER'. CALLING 'OUTER' ENTRY OF " &
+           --        "'NEST' TASK");
+ 
+           NEST.OUTER;
+ 
+           --COMMENT("'OUTER' RENDEZVOUS COMPLETED. 'DRIVER' AWAITING " &
+           --        "TERMINATION OF 'NEST' AND 'SLAVE' TASKS");
+ 
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                FAILED("'TASKING_ERROR' CAUGHT IN 'DRIVER' WHEN IT " &
+                       "SHOULD HAVE BEEN CAUGHT IN 'SLAVE' TASK, OR " &
+                       "'TASKING_ERROR' WAS INCORRECTLY PROPAGATED BY " &
+                       "'SLAVE' TASK");
+      END DRIVER;
+ 
+ BEGIN  -- START OF MAIN PROGRAM.
+ 
+      TEST("C95040D","CHECK THAT 'TASKING_ERROR' IS RAISED IN A " &
+                     "CALLER TASK WHEN TASK OWNING THE ENTRY CANNOT " &
+                     "PERFORM RENDEZVOUS. ALSO CHECK THAT " &
+                     "'TASKING_ERROR', ONCE RAISED, IS NOT PROPAGATED " &
+                     "OUTSIDE THE TASK BODY");
+ 
+      --COMMENT("MAIN PROGRAM CALLING 'DRIVER' PROCEDURE");
+ 
+      DRIVER;
+ 
+      --COMMENT("MAIN PROGRAM NOW TERMINATING");
+ 
+      RESULT;
+ END C95040D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95041a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95041a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95041a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95041a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C95041A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN ENTRY FAMILY INDEX CAN BE SPECIFIED WITH THE FORM
+ --     A'RANGE.
+ 
+ -- HISTORY:
+ --     DHH 03/17/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95041A IS
+ 
+      GLOBAL_A, GLOBAL_B : INTEGER;
+      GLOBAL_C, GLOBAL_D : INTEGER;
+      TYPE COLOR IS (RED, BLUE, YELLOW);
+      TYPE ARR IS ARRAY(COLOR RANGE RED .. BLUE) OF BOOLEAN;
+      ARRY : ARR;
+ 
+      TASK CHECK IS
+           ENTRY CHECK_LINK(ARR'RANGE)(I : INTEGER);
+      END CHECK;
+ 
+      TASK CHECK_OBJ IS
+           ENTRY CHECK_OBJ_LINK(ARRY'RANGE)(I : INTEGER);
+      END CHECK_OBJ;
+ 
+      TASK BODY CHECK IS
+      BEGIN
+                ACCEPT CHECK_LINK(RED)(I : INTEGER) DO
+                     GLOBAL_A := IDENT_INT(I);
+                END;
+ 
+                ACCEPT CHECK_LINK(BLUE)(I : INTEGER) DO
+                     GLOBAL_B := IDENT_INT(I);
+                END;
+      END CHECK;
+ 
+      TASK BODY CHECK_OBJ IS
+      BEGIN
+                ACCEPT CHECK_OBJ_LINK(RED)(I : INTEGER) DO
+                     GLOBAL_C := IDENT_INT(I);
+                END;
+ 
+                ACCEPT CHECK_OBJ_LINK(BLUE)(I : INTEGER) DO
+                     GLOBAL_D := IDENT_INT(I);
+                END;
+      END CHECK_OBJ;
+ 
+ BEGIN
+      TEST("C95041A", "CHECK THAT AN ENTRY FAMILY INDEX CAN BE " &
+                      "SPECIFIED WITH THE FORM A'RANGE");
+      CHECK.CHECK_LINK(RED)(10);
+      CHECK.CHECK_LINK(BLUE)(5);
+ 
+      CHECK_OBJ.CHECK_OBJ_LINK(RED)(10);
+      CHECK_OBJ.CHECK_OBJ_LINK(BLUE)(5);
+ 
+      IF GLOBAL_A /= IDENT_INT(10) THEN
+           FAILED("ENTRY CHECK_LINK(RED) HAS INCORRECT VALUE");
+      END IF;
+ 
+      IF GLOBAL_B /= IDENT_INT(5) THEN
+           FAILED("ENTRY CHECK_LINK(BLUE) HAS INCORRECT VALUE");
+      END IF;
+ 
+      IF GLOBAL_C /= IDENT_INT(10) THEN
+           FAILED("ENTRY CHECK_LINK(RED) HAS INCORRECT VALUE");
+      END IF;
+ 
+      IF GLOBAL_D /= IDENT_INT(5) THEN
+           FAILED("ENTRY CHECK_LINK(BLUE) HAS INCORRECT VALUE");
+      END IF;
+ 
+      RESULT;
+ END C95041A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C95065A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
+ -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+ -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+ -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+ 
+ -- CASE (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+ --          INITIALIZED WITH A STATIC AGGREGATE.
+ 
+ -- JWC 6/19/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95065A IS
+ 
+ BEGIN
+ 
+      TEST ("C95065A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                       "FORMAL PART IS ELABORATED");
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                TYPE A1 IS ARRAY (1 .. IDENT_INT(1), 1 .. IDENT_INT(10))
+                                 OF INTEGER;
+ 
+                TASK T IS
+                     ENTRY E1 (A : A1 := ((1, 0), (0, 1)));
+                END T;
+ 
+                TASK BODY T IS
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (A : A1 := ((1, 0), (0, 1))) DO
+                               FAILED ("ACCEPT E1 EXECUTED");
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN TASK T");
+                END T;
+ 
+           BEGIN
+                T.E1;
+                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - E1");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C95065A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C95065B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
+ -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+ -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+ -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+ 
+ -- CASE (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+ --          INITIALIZED WITH A STATIC VALUE.
+ 
+ -- JWC 6/19/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95065B IS
+ 
+ BEGIN
+ 
+      TEST ("C95065B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                       "FORMAL PART IS ELABORATED");
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                SUBTYPE INT IS INTEGER
+                               RANGE IDENT_INT(0) .. IDENT_INT(63);
+ 
+                TASK T IS
+                     ENTRY E1 (I : INT := -1);
+                END T;
+ 
+                TASK BODY T IS
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (I : INT := -1) DO
+                               FAILED ("ACCEPT E1 EXECUTED");
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN TASK T");
+                END T;
+ 
+           BEGIN
+                T.E1;
+                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - E1");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C95065B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C95065C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
+ -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+ -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+ -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+ 
+ -- CASE (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+ --          CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+ 
+ -- JWC 6/19/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95065C IS
+ 
+ BEGIN
+ 
+      TEST ("C95065C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                       "FORMAL PART IS ELABORATED");
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                TYPE A1 IS ARRAY (1 .. 3) OF INTEGER
+                                 RANGE IDENT_INT(1) .. IDENT_INT(3);
+ 
+                TYPE REC IS
+                     RECORD
+                          I : INTEGER RANGE IDENT_INT(1)..IDENT_INT(3);
+                          A : A1;
+                     END RECORD;
+ 
+                TASK T IS
+                     ENTRY E1 (R : REC := (-3,(0,2,3)));
+                END T;
+ 
+                TASK BODY T IS
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (R : REC := (-3,(0,2,3))) DO
+                               FAILED ("ACCEPT E1 EXECUTED");
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN TASK T");
+                END T;
+ 
+           BEGIN
+                T.E1;
+                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - E1");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C95065C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C95065D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
+ -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+ -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+ -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+ 
+ -- CASE (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON
+ --          SUBSCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+ --          WITH A STATIC AGGREGATE.
+ 
+ -- JWC 6/19/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95065D IS
+ 
+ BEGIN
+ 
+      TEST ("C95065D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                       "FORMAL PART IS ELABORATED");
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                TYPE A1 IS ARRAY (1 .. 2, 1 .. 2) OF INTEGER
+                                 RANGE IDENT_INT(1) .. IDENT_INT(2);
+ 
+                TASK T IS
+                     ENTRY E1 (A : A1 := ((1, -1), (1, 2)));
+                END T;
+ 
+                TASK BODY T IS
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (A : A1 := ((1, -1), (1, 2))) DO
+                               FAILED ("ACCEPT E1 EXECUTED");
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN TASK T");
+                END T;
+ 
+           BEGIN
+                T.E1;
+                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - E1");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C95065D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- C95065E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
+ -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+ -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+ -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+ 
+ -- CASE (E) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON
+ --          SUBSCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+ --          WITH A STATIC AGGREGATE.
+ 
+ -- JWC 6/19/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95065E IS
+ 
+ BEGIN
+ 
+      TEST ("C95065E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                       "FORMAL PART IS ELABORATED");
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                TYPE A1 IS ARRAY (1 .. 2, 1 .. 2) OF INTEGER
+                                 RANGE IDENT_INT(1) .. IDENT_INT(2);
+ 
+                TASK T IS
+                     ENTRY E1 (A : A1 := (3 .. 4 => (1, 2)));
+                END T;
+ 
+                TASK BODY T IS
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (A : A1 := (3 .. 4 => (1, 2))) DO
+                               FAILED ("ACCEPT E1 EXECUTED");
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN TASK T");
+                END T;
+ 
+           BEGIN
+                T.E1;
+                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - E1");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C95065E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95065f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95065f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C95065F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN AN ENTRY IS DECLARED
+ -- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+ -- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+ -- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+ 
+ -- CASE (F) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+ --          INITIALIZED WITH A STATIC AGGREGATE.
+ 
+ -- JWC 6/19/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95065F IS
+ 
+ BEGIN
+ 
+      TEST ("C95065F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                       "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                       "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                       "FORMAL PART IS ELABORATED");
+ 
+      BEGIN
+ 
+           DECLARE
+ 
+                SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+                TYPE A1 IS ARRAY (1 .. 3) OF INT;
+                TYPE REC (I : INT) IS
+                     RECORD
+                          A : A1;
+                     END RECORD;
+ 
+                SUBTYPE REC4 IS REC (IDENT_INT(4));
+ 
+                TASK T IS
+                     ENTRY E1 (R : REC4 := (3,(1,2,3)));
+                END T;
+ 
+                TASK BODY T IS
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (R : REC4 := (3,(1,2,3))) DO
+                               FAILED ("ACCEPT E1 EXECUTED");
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN TASK T");
+                END T;
+ 
+           BEGIN
+                T.E1;
+                FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - E1");
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION RAISED");
+      END;
+ 
+      RESULT;
+ 
+ END C95065F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95066a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95066a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95066a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95066a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,214 ----
+ -- C95066A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A STATIC EXPRESSION, CONSTANT NAME, ATTRIBUTE NAME,
+ -- VARIABLE, DEREFERENCED ACCESS, USER-DEFINED OPERATOR, USER-
+ -- DEFINED FUNCTION, OR ALLOCATOR CAN BE USED IN THE INITIALIZATION
+ -- EXPRESSION OF A FORMAL PARAMETER, AND THAT THE APPROPRIATE
+ -- VALUE IS USED AS A DEFAULT PARAMETER VALUE WHEN THE ENTRY
+ -- IS CALLED.
+ 
+ -- GLH  6/19/85
+ 
+ WITH REPORT;
+ PROCEDURE C95066A IS
+ 
+      USE REPORT;
+ 
+      TYPE INT IS RANGE 1 .. 10;
+ 
+      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+      TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+           RECORD
+                A : ARR (0..CONSTRAINT);
+           END RECORD;
+ 
+      C7   : CONSTANT INTEGER  := 7;
+      V7   : INTEGER  := 7;
+ 
+      TYPE  A_INT IS ACCESS INTEGER;
+      C_A  : CONSTANT A_INT  := NEW INTEGER'(7);
+ 
+      SUBTYPE RECTYPE1 IS RECTYPE (2 + 5);
+      SUBTYPE RECTYPE2 IS RECTYPE (C7);
+      SUBTYPE RECTYPE3 IS RECTYPE (V7);
+ 
+      FUNCTION "&" (X,Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN 10;
+      END "&";
+ 
+      FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN X;
+      END FUNC;
+ 
+       -- STATIC EXPRESSION.
+ 
+      TASK T1 IS
+           ENTRY E1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7)));
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7))) DO
+                IF (REC /= (7,(0,1,2,3,4,5,6,7))) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                             "E1 PARAMETER");
+                END IF;
+           END E1;
+      END T1;
+ 
+      -- CONSTANT NAME.
+ 
+      TASK T2 IS
+           ENTRY E2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7)));
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           ACCEPT E2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7))) DO
+                IF (REC /= (C7,(0,1,2,3,4,5,6,7))) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                             "E2 PARAMETER");
+                END IF;
+           END E2;
+      END T2;
+ 
+      -- ATTRIBUTE NAME.
+ 
+      TASK T3 IS
+           ENTRY E3 (P1 : INT := INT'LAST);
+      END T3;
+ 
+      TASK BODY T3 IS
+      BEGIN
+           ACCEPT E3 (P1 : INT := INT'LAST) DO
+                IF (P1 /= INT (10)) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                             "E3 PARAMETER");
+                END IF;
+           END E3;
+      END T3;
+ 
+      -- VARIABLE.
+ 
+      TASK T4 IS
+           ENTRY E4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7)));
+      END T4;
+ 
+      TASK BODY T4 IS
+      BEGIN
+           ACCEPT E4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7))) DO
+                IF (P4 /= (V7,(0,1,2,3,4,5,6,7))) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                             "E4 PARAMETER");
+                END IF;
+           END E4;
+      END T4;
+ 
+      -- DEREFERENCED ACCESS.
+ 
+      TASK T5 IS
+           ENTRY E5 (P5 : INTEGER := C_A.ALL);
+      END T5;
+ 
+      TASK BODY T5 IS
+      BEGIN
+           ACCEPT E5 (P5 : INTEGER := C_A.ALL) DO
+                IF (P5 /= C_A.ALL) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                             "E5 PARAMETER");
+                END IF;
+           END E5;
+      END T5;
+ 
+      -- USER-DEFINED OPERATOR.
+ 
+      TASK T6 IS
+           ENTRY E6 (P6 : INTEGER := 6&4);
+      END T6;
+ 
+      TASK BODY T6 IS
+      BEGIN
+           ACCEPT E6 (P6 : INTEGER := 6&4) DO
+                IF (P6 /= IDENT_INT(10)) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE " &
+                             "FOR E6 PARAMETER");
+                END IF;
+           END E6;
+      END T6;
+ 
+      -- USER-DEFINED FUNCTION.
+ 
+      TASK T7 IS
+           ENTRY E7 (P7 : INTEGER := FUNC(10));
+      END T7;
+ 
+      TASK BODY T7 IS
+      BEGIN
+           ACCEPT E7 (P7 : INTEGER := FUNC(10)) DO
+                IF (P7 /= IDENT_INT(10)) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                             "E7 PARAMETER");
+                END IF;
+           END E7;
+      END T7;
+ 
+      -- ALLOCATOR.
+ 
+      TASK T8 IS
+           ENTRY E8 (P8 : A_INT := NEW INTEGER'(7));
+      END T8;
+ 
+      TASK BODY T8 IS
+      BEGIN
+           ACCEPT E8 (P8 : A_INT := NEW INTEGER'(7)) DO
+                IF (P8.ALL /= IDENT_INT(7)) THEN
+                     FAILED ("INCORRECT DEFAULT VALUE " &
+                             "FOR E8 PARAMETER");
+                END IF;
+           END E8;
+      END T8;
+ 
+ BEGIN
+      TEST ("C95066A", "CHECK USE OF STATIC EXPRESSIONS, CONSTANT " &
+                       "NAMES, ATTRIBUTE NAMES, VARIABLES, USER- " &
+                       "DEFINED OPERATORS, USER-DEFINED FUNCTIONS, " &
+                       "DEREFERENCED ACCESSES, AND ALLOCATORS IN " &
+                       "THE FORMAL PART OF A TASK SPECIFICATION");
+ 
+      T1.E1;
+      T2.E2;
+      T3.E3;
+      T4.E4;
+      T5.E5;
+      T6.E6;
+      T7.E7;
+      T8.E8;
+ 
+      RESULT;
+ 
+ END C95066A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95067a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95067a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95067a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95067a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,302 ----
+ -- C95067A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
+ -- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
+ 
+ -- JWC 6/20/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95067A IS
+ 
+      PACKAGE PKG IS
+ 
+           TYPE ITYPE IS LIMITED PRIVATE;
+ 
+           TASK T1 IS
+ 
+                ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+ 
+                ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
+                                    M : STRING);
+ 
+                ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER);
+ 
+           END T1;
+ 
+           SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
+           TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
+ 
+           TASK T2 IS
+ 
+                ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
+                                  I : INTEGER; S : STRING; M : STRING);
+ 
+                ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                     I : INTEGER; S : STRING;
+                                     M : STRING);
+ 
+                ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER;
+                              I : INTEGER; S : STRING);
+ 
+           END T2;
+ 
+      PRIVATE
+ 
+           TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
+ 
+           TYPE VRTYPE (C : INT_0_20 := 20) IS
+                RECORD
+                     I : INTEGER;
+                     S : STRING (1 .. C);
+                END RECORD;
+ 
+      END PKG;
+ 
+      USE PKG;
+ 
+      I1 : ITYPE;
+ 
+      TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
+ 
+      A1 : ATYPE;
+ 
+      VR1 : VRTYPE;
+ 
+      D : CONSTANT INT_0_20 := 10;
+ 
+      TYPE RTYPE IS
+           RECORD
+                J : ITYPE;
+                R : VRTYPE (D);
+           END RECORD;
+ 
+      R1 : RTYPE;
+ 
+      PACKAGE BODY PKG IS
+ 
+           TASK BODY T1 IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER;
+                                            M : STRING) DO
+                               IF INTEGER (X) /= V THEN
+                                    FAILED ("WRONG SCALAR VALUE - " & M);
+                               END IF;
+                          END LOOK_IN_I;
+                     OR
+                          ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE;
+                                               V : INTEGER;
+                                               M : STRING) DO
+                               IF INTEGER (X) /= V THEN
+                                    FAILED ("WRONG SCALAR VALUE - " & M);
+                               END IF;
+                          END LOOK_INOUT_I;
+                     OR
+                          ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO
+                               X := ITYPE (IDENT_INT (V));
+                          END SET_I;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T1;
+ 
+           TASK BODY T2 IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
+                                             I : INTEGER; S : STRING;
+                                             M : STRING) DO
+                               IF (X.C /= C OR X.I /= I) OR ELSE
+                                  X.S /= S THEN
+                                    FAILED ("WRONG COMPOSITE VALUE - " &
+                                            M);
+                               END IF;
+                          END LOOK_IN_VR;
+                     OR
+                          ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE;
+                                                C : INTEGER; I : INTEGER;
+                                                S : STRING;
+                                                M : STRING) DO
+                               IF (X.C /= C OR X.I /= I) OR ELSE
+                                  X.S /= S THEN
+                                    FAILED ("WRONG COMPOSITE VALUE - " &
+                                            M);
+                               END IF;
+                          END LOOK_INOUT_VR;
+                     OR
+                          ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                         I : INTEGER; S : STRING) DO
+                               X := (IDENT_INT(C), IDENT_INT(I),
+                                     IDENT_STR(S));
+                          END SET_VR;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T2;
+ 
+      BEGIN
+           I1 := ITYPE (IDENT_INT(2));
+ 
+           FOR I IN A1'RANGE LOOP
+                A1 (I) := ITYPE (3 + IDENT_INT(I));
+           END LOOP;
+ 
+           VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
+ 
+           R1.J := ITYPE (IDENT_INT(6));
+           R1.R := (IDENT_INT(D), IDENT_INT(19),
+                    IDENT_STR("ABCDEFGHIJ"));
+      END PKG;
+ 
+      TASK T3 IS
+           ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+ 
+           ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+                                NV : INTEGER; M : STRING);
+ 
+           ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING);
+ 
+           ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+                                NV : INTEGER; M : STRING);
+ 
+           ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                              S : STRING; M : STRING);
+ 
+           ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE;
+                                OC : INTEGER; OI : INTEGER; OS : STRING;
+                                NC : INTEGER; NI : INTEGER; NS : STRING;
+                                M : STRING);
+ 
+           ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+                             I : INTEGER; S : STRING; M : STRING);
+ 
+           ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+                               OC : INTEGER; OI : INTEGER; OS : STRING;
+                               NJ : INTEGER;
+                               NC : INTEGER; NI : INTEGER; NS : STRING;
+                               M : STRING);
+      END T3;
+ 
+      TASK BODY T3 IS
+      BEGIN
+           ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO
+                T1.LOOK_IN_I (X, V, M);
+           END CHECK_IN_I;
+ 
+           ACCEPT CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+                                 NV : INTEGER; M : STRING) DO
+                T1.LOOK_INOUT_I (X, OV, M & " - A");
+                T1.SET_I (X, NV);
+                T1.LOOK_INOUT_I (X, NV, M & " - B");
+                T1.LOOK_IN_I (X, NV, M & " - C");
+           END CHECK_INOUT_I;
+ 
+           ACCEPT CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) DO
+                FOR I IN X'RANGE LOOP
+                     T1.LOOK_IN_I (X(I), V+I, M & " -" &
+                                              INTEGER'IMAGE (I));
+                END LOOP;
+           END CHECK_IN_A;
+ 
+           ACCEPT CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+                                 NV : INTEGER; M : STRING) DO
+                FOR I IN X'RANGE LOOP
+                     T1.LOOK_INOUT_I (X(I), OV+I, M & " - A" &
+                                                  INTEGER'IMAGE (I));
+                     T1.SET_I (X(I), NV+I);
+                     T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" &
+                                                  INTEGER'IMAGE (I));
+                     T1.LOOK_IN_I (X(I), NV+I, M & " - C" &
+                                               INTEGER'IMAGE (I));
+                END LOOP;
+           END CHECK_INOUT_A;
+ 
+           ACCEPT CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                               S : STRING; M : STRING) DO
+                T2.LOOK_IN_VR (X, C, I, S, M);
+           END CHECK_IN_VR;
+ 
+           ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE;
+                                  OC : INTEGER; OI : INTEGER;
+                                  OS : STRING;
+                                  NC : INTEGER; NI : INTEGER;
+                                  NS : STRING;
+                                  M : STRING) DO
+                T2.LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
+                T2.SET_VR (X, NC, NI, NS);
+                T2.LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
+                T2.LOOK_IN_VR (X, NC, NI, NS, M & " - C");
+           END CHECK_INOUT_VR;
+ 
+           ACCEPT CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+                              I : INTEGER; S : STRING; M : STRING) DO
+                T1.LOOK_IN_I (X.J, J, M & " - A");
+                T2.LOOK_IN_VR (X.R, C, I, S, M & " - B");
+           END CHECK_IN_R;
+ 
+           ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+                                 OC : INTEGER; OI : INTEGER; OS : STRING;
+                                 NJ : INTEGER;
+                                 NC : INTEGER; NI : INTEGER; NS : STRING;
+                                 M : STRING) DO
+                T1.LOOK_INOUT_I (X.J, OJ, M & " - A");
+                T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
+                T1.SET_I (X.J, NJ);
+                T2.SET_VR (X.R, NC, NI, NS);
+                T1.LOOK_INOUT_I (X.J, NJ, M & " - C");
+                T2.LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
+                T1.LOOK_IN_I (X.J, NJ, M & " - E");
+                T2.LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
+           END CHECK_INOUT_R;
+      END T3;
+ 
+ BEGIN
+      TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
+                       "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
+ 
+      T3.CHECK_IN_I (I1, 2, "IN I");
+ 
+      T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I");
+ 
+      T3.CHECK_IN_A (A1, 3, "IN A");
+ 
+      T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A");
+ 
+      T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
+ 
+      T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
+                         "INOUT VR");
+ 
+      T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
+ 
+      T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5,
+                        "ZYXWVUTSRQ", "INOUT R");
+ 
+      RESULT;
+ END C95067A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95071a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95071a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95071a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95071a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,230 ----
+ -- C95071A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN
+ -- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL
+ -- PARAMETER OF ANY MODE.  SUBTESTS ARE:
+ --        (A) INTEGER ACCESS TYPE.
+ --        (B) ARRAY ACCESS TYPE.
+ --        (C) RECORD ACCESS TYPE.
+ 
+ -- JWC 7/11/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95071A IS
+ 
+ BEGIN
+ 
+      TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &
+                       "MAY BE USED IN ASSIGNMENT CONTEXTS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE   -- (A)
+ 
+           TYPE PTRINT IS ACCESS INTEGER;
+           PI : PTRINT;
+ 
+           TASK TA IS
+                ENTRY EA (PI : IN PTRINT);
+           END TA;
+ 
+           TASK BODY TA IS
+           BEGIN
+                ACCEPT EA (PI : IN PTRINT) DO
+                     DECLARE
+                          TASK TA1 IS
+                               ENTRY EA1 (I : OUT INTEGER);
+                               ENTRY EA2 (I : IN OUT INTEGER);
+                          END TA1;
+ 
+                          TASK BODY TA1 IS
+                          BEGIN
+                               ACCEPT EA1 (I : OUT INTEGER) DO
+                                    I := 7;
+                               END EA1;
+ 
+                               ACCEPT EA2 (I : IN OUT INTEGER) DO
+                                    I := I + 1;
+                               END EA2;
+                          END TA1;
+ 
+                     BEGIN
+                          TA1.EA1 (PI.ALL);
+                          TA1.EA2 (PI.ALL);
+                          PI.ALL := PI.ALL + 1;
+                          IF (PI.ALL /= 9) THEN
+                               FAILED ("ASSIGNMENT TO COMPONENT OF " &
+                                       "INTEGER ACCESS PARAMETER " &
+                                       "FAILED");
+                          END IF;
+                     END;
+                END EA;
+           END TA;
+ 
+      BEGIN     -- (A)
+ 
+           PI := NEW INTEGER'(0);
+           TA.EA (PI);
+ 
+      END;      -- (A)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (B)
+ 
+           TYPE TBL IS ARRAY (1..3) OF INTEGER;
+           TYPE PTRTBL IS ACCESS TBL;
+           PT : PTRTBL;
+ 
+           TASK TB IS
+                ENTRY EB (PT : IN PTRTBL);
+           END TB;
+ 
+           TASK BODY TB IS
+           BEGIN
+                ACCEPT EB (PT : IN PTRTBL) DO
+                     DECLARE
+                          TASK TB1 IS
+                               ENTRY EB1 (T : OUT TBL);
+                               ENTRY EB2 (T : IN OUT TBL);
+                               ENTRY EB3 (I : OUT INTEGER);
+                               ENTRY EB4 (I : IN OUT INTEGER);
+                          END TB1;
+ 
+                          TASK BODY TB1 IS
+                          BEGIN
+                               ACCEPT EB1 (T : OUT TBL) DO
+                                    T := (1,2,3);
+                               END EB1;
+ 
+                               ACCEPT EB2 (T : IN OUT TBL) DO
+                                    T(3) := T(3) - 1;
+                               END EB2;
+ 
+                               ACCEPT EB3 (I : OUT INTEGER) DO
+                                    I := 7;
+                               END EB3;
+ 
+                               ACCEPT EB4 (I : IN OUT INTEGER) DO
+                                    I := I + 1;
+                               END EB4;
+                          END TB1;
+ 
+                     BEGIN
+                          TB1.EB1 (PT.ALL);         -- (1,2,3)
+                          TB1.EB2 (PT.ALL);         -- (1,2,2)
+                          TB1.EB3 (PT(2));          -- (1,7,2)
+                          TB1.EB4 (PT(1));          -- (2,7,2)
+                          PT(3) := PT(3) + 7;      -- (2,7,9)
+                          IF (PT.ALL /= (2,7,9)) THEN
+                               FAILED ("ASSIGNMENT TO COMPONENT OF " &
+                                       "ARRAY ACCESS PARAMETER FAILED");
+                          END IF;
+                     END;
+                END EB;
+           END TB;
+ 
+      BEGIN     -- (B)
+ 
+           PT := NEW TBL'(0,0,0);
+           TB.EB (PT);
+ 
+      END;      -- (B)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (C)
+ 
+           TYPE REC IS
+                RECORD
+                     I1   : INTEGER;
+                     I2   : INTEGER;
+                     I3   : INTEGER;
+                END RECORD;
+ 
+           TYPE PTRREC IS ACCESS REC;
+           PR : PTRREC;
+ 
+           TASK TC IS
+                ENTRY EC (PR : IN PTRREC);
+           END TC;
+ 
+           TASK BODY TC IS
+           BEGIN
+                ACCEPT EC (PR : IN PTRREC) DO
+                     DECLARE
+                          TASK TC1 IS
+                               ENTRY EC1 (R : OUT REC);
+                               ENTRY EC2 (R : IN OUT REC);
+                               ENTRY EC3 (I : OUT INTEGER);
+                               ENTRY EC4 (I : IN OUT INTEGER);
+                          END TC1;
+ 
+                          TASK BODY TC1 IS
+                          BEGIN
+                               ACCEPT EC1 (R : OUT REC) DO
+                                    R := (1,2,3);
+                               END EC1;
+ 
+                               ACCEPT EC2 (R : IN OUT REC) DO
+                                    R.I3 := R.I3 - 1;
+                               END EC2;
+ 
+                               ACCEPT EC3 (I : OUT INTEGER) DO
+                                    I := 7;
+                               END  EC3;
+ 
+                               ACCEPT EC4 (I : IN OUT INTEGER) DO
+                                    I := I + 1;
+                               END EC4;
+                          END TC1;
+ 
+                     BEGIN
+                          TC1.EC1 (PR.ALL);         -- (1,2,3)
+                          TC1.EC2 (PR.ALL);         -- (1,2,2)
+                          TC1.EC3 (PR.I2);          -- (1,7,2)
+                          TC1.EC4 (PR.I1);          -- (2,7,2)
+                          PR.I3 := PR.I3 + 7;       -- (2,7,9)
+                          IF (PR.ALL /= (2,7,9)) THEN
+                               FAILED ("ASSIGNMENT TO COMPONENT OF " &
+                                       "RECORD ACCESS PARAMETER " &
+                                       "FAILED");
+                          END IF;
+                     END;
+                END EC;
+           END TC;
+ 
+      BEGIN     -- (C)
+ 
+           PR := NEW REC'(0,0,0);
+           TC.EC (PR);
+ 
+      END;      -- (C)
+ 
+      ---------------------------------------------
+ 
+      RESULT;
+ 
+ END C95071A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95072a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95072a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95072a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95072a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,197 ----
+ -- C95072A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SCALAR AND ACCESS PARAMETERS ARE COPIED FOR ALL THREE
+ -- PARAMETER MODES.
+ -- SUBTESTS ARE:
+ --   (A)  SCALAR PARAMETERS TO ENTRIES.
+ --   (B)  ACCESS PARAMETERS TO ENTRIES.
+ 
+ -- JWC 7/22/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95072A IS
+ 
+ BEGIN
+      TEST ("C95072A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
+                       "COPIED");
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           I : INTEGER;
+           E : EXCEPTION;
+ 
+           TASK TA IS
+                ENTRY EA (EI : IN INTEGER; EO : OUT INTEGER;
+                          EIO : IN OUT INTEGER);
+           END TA;
+ 
+           TASK BODY TA IS
+ 
+                TMP : INTEGER;
+ 
+           BEGIN
+ 
+                ACCEPT EA (EI : IN INTEGER; EO : OUT INTEGER;
+                           EIO : IN OUT INTEGER) DO
+ 
+                     TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
+ 
+                     EO := 10;
+                     IF EI /= TMP THEN
+                          FAILED ("ASSIGNMENT TO SCALAR OUT " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                     END IF;
+ 
+                     EIO := EIO + 100;
+                     IF EI /= TMP THEN
+                          FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                     END IF;
+ 
+                     I := I + 1;
+                     IF EI /= TMP THEN
+                          FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                     END IF;
+ 
+                     RAISE E;            -- CHECK EXCEPTION HANDLING.
+                END EA;
+ 
+           EXCEPTION
+                WHEN OTHERS => NULL;
+           END TA;
+ 
+      BEGIN  -- (A)
+ 
+           I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
+           TA.EA (I, I, I);
+           FAILED ("EXCEPTION NOT RAISED - A");
+ 
+      EXCEPTION
+           WHEN E =>
+                IF I /= 1 THEN
+                     CASE I IS
+                          WHEN 11  =>
+                               FAILED ("OUT ACTUAL SCALAR PARAMETER " &
+                                       "CHANGED GLOBAL VALUE");
+                          WHEN 101 =>
+                               FAILED ("IN OUT ACTUAL SCALAR " &
+                                       "PARAMETER CHANGED GLOBAL VALUE");
+                          WHEN 111 =>
+                               FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
+                                       "PARAMETERS CHANGED GLOBAL " &
+                                       "VALUE");
+                          WHEN OTHERS =>
+                               FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
+                                       "VALUE");
+                     END CASE;
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - A");
+      END;  -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           TYPE ACCTYPE IS ACCESS INTEGER;
+ 
+           I : ACCTYPE;
+           E : EXCEPTION;
+ 
+           TASK TB IS
+                ENTRY EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
+                          EIO : IN OUT ACCTYPE);
+           END TB;
+ 
+           TASK BODY TB IS
+ 
+                TMP : ACCTYPE;
+ 
+           BEGIN
+ 
+                ACCEPT EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
+                           EIO : IN OUT ACCTYPE) DO
+ 
+                     TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
+ 
+                     I := NEW INTEGER'(101);
+                     IF EI /= TMP THEN
+                          FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                     END IF;
+ 
+                     EO := NEW INTEGER'(1);
+                     IF EI /= TMP THEN
+                          FAILED ("ASSIGNMENT TO ACCESS OUT " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                     END IF;
+ 
+                     EIO := NEW INTEGER'(10);
+                     IF EI /= TMP THEN
+                          FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
+                                  "PARAMETER CHANGES THE VALUE OF " &
+                                  "INPUT PARAMETER");
+                     END IF;
+ 
+                     RAISE E;            -- CHECK EXCEPTION HANDLING.
+                END EB;
+ 
+           EXCEPTION
+                WHEN OTHERS => NULL;
+           END TB;
+ 
+      BEGIN  -- (B)
+ 
+           I := NEW INTEGER'(100);
+           TB.EB (I, I, I);
+           FAILED ("EXCEPTION NOT RAISED - B");
+ 
+      EXCEPTION
+           WHEN E =>
+                IF I.ALL /= 101 THEN
+                     FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
+                             "PARAMETER VALUE CHANGED DESPITE " &
+                             "RAISED EXCEPTION");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - B");
+      END;  -- (B)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95072A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95072b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95072b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95072b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95072b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,278 ----
+ -- C95072B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
+ -- PASSED BY COPY FOR ALL MODES.
+ -- SUBTESTS ARE:
+ --   (A)  PRIVATE SCALAR PARAMETERS TO ENTRIES.
+ --   (B)  PRIVATE ACCESS PARAMETERS TO ENTRIES.
+ 
+ -- JWC 7/22/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95072B IS
+ 
+ BEGIN
+      TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
+                      "PARAMETERS ARE COPIED");
+ 
+      ---------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE SCALAR_PKG IS
+ 
+                TYPE T IS PRIVATE;
+                C0 : CONSTANT T;
+                C1 : CONSTANT T;
+                C10 : CONSTANT T;
+                C100 : CONSTANT T;
+ 
+                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
+                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
+ 
+           PRIVATE
+ 
+                TYPE T IS NEW INTEGER;
+                C0 : CONSTANT T := 0;
+                C1 : CONSTANT T := 1;
+                C10 : CONSTANT T := 10;
+                C100 : CONSTANT T := 100;
+ 
+           END SCALAR_PKG;
+ 
+           PACKAGE BODY SCALAR_PKG IS
+ 
+                FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
+                BEGIN
+                     RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
+                END "+";
+ 
+                FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
+                BEGIN
+                     RETURN INTEGER (OLD_PRIVATE);
+                END CONVERT;
+ 
+           END SCALAR_PKG;
+ 
+           USE SCALAR_PKG;
+ 
+      BEGIN  -- (A)
+ 
+           DECLARE  -- (A1)
+ 
+                I : T;
+                E : EXCEPTION;
+ 
+                TASK TA IS
+                     ENTRY EA (EI : IN T; EO : OUT T;
+                               EIO : IN OUT T);
+                END TA;
+ 
+                TASK BODY TA IS
+ 
+                     TEMP : T;
+ 
+                BEGIN
+ 
+                     ACCEPT EA (EI : IN T; EO : OUT T;
+                                EIO : IN OUT T) DO
+ 
+                          TEMP := EI;    -- SAVE VALUE OF EI AT ACCEPT.
+ 
+                          EO := C10;
+                          IF EI /= TEMP THEN
+                               FAILED ("ASSIGNMENT TO PRIVATE " &
+                                       "(SCALAR) OUT PARAMETER " &
+                                       "CHANGES THE VALUE OF INPUT " &
+                                       "PARAMETER");
+                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                          END IF;
+ 
+                          EIO := EIO + C100;
+                          IF EI /= TEMP THEN
+                               FAILED ("ASSIGNMENT TO PRIVATE " &
+                                       "(SCALAR) IN OUT PARAMETER " &
+                                       "CHANGES THE VALUE OF INPUT " &
+                                       "PARAMETER");
+                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                          END IF;
+ 
+                          I := I + C1;
+                          IF EI /= TEMP THEN
+                               FAILED ("ASSIGNMENT TO PRIVATE " &
+                                       "(SCALAR) ACTUAL PARAMETER " &
+                                       "CHANGES THE VALUE OF " &
+                                       "INPUT PARAMETER");
+                          END IF;
+ 
+                          RAISE E;              -- CHECK EXCEPTION
+                                                -- HANDLING.
+                     END EA;
+ 
+                EXCEPTION
+                     WHEN OTHERS => NULL;
+                END TA;
+ 
+           BEGIN    -- (A1)
+ 
+                I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
+                          -- DETECTED.
+                TA.EA (I, I, I);
+                FAILED ("EXCEPTION NOT RAISED - A");
+ 
+           EXCEPTION
+                WHEN E =>
+                     IF I /= C1 THEN
+                          CASE CONVERT (I) IS
+                               WHEN 11 =>
+                                    FAILED ("OUT ACTUAL PRIVATE " &
+                                            "(SCALAR) PARAMETER " &
+                                            "CHANGED GLOBAL VALUE");
+                               WHEN 101 =>
+                                    FAILED ("IN OUT ACTUAL PRIVATE " &
+                                            "(SCALAR) PARAMETER " &
+                                            "CHANGED GLOBAL VALUE");
+                               WHEN 111 =>
+                                    FAILED ("OUT AND IN OUT ACTUAL " &
+                                            "PRIVATE (SCALAR) " &
+                                            "PARAMETER CHANGED " &
+                                            "GLOBAL VALUE");
+                               WHEN OTHERS =>
+                                    FAILED ("UNDETERMINED CHANGE TO " &
+                                            "GLOBAL VALUE");
+                          END CASE;
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - A");
+           END;  -- (A1)
+ 
+      END;  -- (A)
+ 
+      ---------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           PACKAGE ACCESS_PKG IS
+ 
+                TYPE T IS PRIVATE;
+                C_NULL : CONSTANT T;
+                C1 : CONSTANT T;
+                C10 : CONSTANT T;
+                C100 : CONSTANT T;
+                C101 : CONSTANT T;
+ 
+           PRIVATE
+ 
+                TYPE T IS ACCESS INTEGER;
+                C_NULL : CONSTANT T := NULL;
+                C1 : CONSTANT T := NEW INTEGER'(1);
+                C10 : CONSTANT T := NEW INTEGER'(10);
+                C100 : CONSTANT T := NEW INTEGER'(100);
+                C101 : CONSTANT T := NEW INTEGER'(101);
+ 
+           END ACCESS_PKG;
+ 
+           USE ACCESS_PKG;
+ 
+      BEGIN    -- (B)
+ 
+           DECLARE  -- (B1)
+ 
+                I : T;
+                E : EXCEPTION;
+ 
+                TASK TB IS
+                     ENTRY EB (EI : IN T; EO : OUT T;
+                               EIO : IN OUT T);
+                END TB;
+ 
+                TASK BODY TB IS
+ 
+                     TEMP : T;
+ 
+                BEGIN
+ 
+                     ACCEPT EB (EI : IN T; EO : OUT T;
+                                EIO : IN OUT T) DO
+ 
+                          TEMP := EI;  -- SAVE VALUE OF EI AT ACCEPT.
+ 
+                          I := C101;
+                          IF EI /= TEMP THEN
+                               FAILED ("ASSIGNMENT TO PRIVATE " &
+                                       "(ACCESS) ACTUAL VARIABLE " &
+                                       "CHANGES THE VALUE OF INPUT " &
+                                       "PARAMETER");
+                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                          END IF;
+ 
+                          EO := C1;
+                          IF EI /= TEMP THEN
+                               FAILED ("ASSIGNMENT TO PRIVATE " &
+                                       "(ACCESS) OUT PARAMETER " &
+                                       "CHANGES THE VALUE OF INPUT " &
+                                       "PARAMETER");
+                               TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                          END IF;
+ 
+                          EIO := C10;
+                          IF EI /= TEMP THEN
+                               FAILED ("ASSIGNMENT TO PRIVATE " &
+                                       "(ACCESS) IN OUT PARAMETER " &
+                                       "CHANGES THE VALUE OF INPUT " &
+                                       "PARAMETER");
+                          END IF;
+ 
+                          RAISE E;                 -- CHECK EXCEPTION
+                                                   -- HANDLING.
+                     END EB;
+ 
+                EXCEPTION
+                     WHEN OTHERS => NULL;
+                END TB;
+ 
+           BEGIN     -- (B1)
+ 
+                I := C100;
+                TB.EB (I, I, I);
+                FAILED ("EXCEPTION NOT RAISED - B");
+ 
+           EXCEPTION
+                WHEN E =>
+                     IF I /= C101 THEN
+                          FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
+                                  "PARAMETER VALUE CHANGED DESPITE " &
+                                  "RAISED EXCEPTION");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - B");
+           END;  -- (B1)
+ 
+      END;  -- (B)
+ 
+      ---------------------------------------------------
+ 
+      RESULT;
+ END C95072B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95073a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95073a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95073a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95073a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- C95073A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALIASING IS PERMITTED FOR PARAMETERS OF COMPOSITE TYPES,
+ -- E.G., THAT A MATRIX ADDITION PROCEDURE CAN BE CALLED WITH THREE
+ -- IDENTICAL ARGUMENTS.
+ 
+ -- JWC 7/29/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95073A IS
+ 
+      TYPE MATRIX IS ARRAY (1..3, 1..3) OF INTEGER;
+ 
+      A : MATRIX := ((1,2,3), (4,5,6), (7,8,9));
+ 
+      TASK T IS
+           ENTRY MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX);
+      END T;
+ 
+      TASK BODY T IS
+      BEGIN
+           ACCEPT MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX) DO
+                FOR I IN 1..3 LOOP
+                     FOR J IN 1..3 LOOP
+                          SUM (I,J) := X (I,J) + Y (I,J);
+                     END LOOP;
+                END LOOP;
+           END MAT_ADD;
+      END T;
+ 
+ BEGIN
+ 
+      TEST ("C95073A", "CHECK THAT ALIASING IS PERMITTED FOR " &
+                       "PARAMETERS OF COMPOSITE TYPES");
+ 
+      T.MAT_ADD (A, A, A);
+ 
+      IF A /= ((2,4,6), (8,10,12), (14,16,18)) THEN
+           FAILED ("THE RESULT OF THE MATRIX ADDITION IS INCORRECT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C95073A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95074c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95074c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95074c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95074c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C95074C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT 'FIRST, 'LAST, 'LENGTH, AND 'RANGE, CAN BE APPLIED TO AN
+ -- OUT PARAMETER OR OUT PARAMETER SUBCOMPONENT THAT DOES NOT HAVE AN
+ -- ACCESS TYPE.
+ 
+ -- JWC 6/25/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95074C IS
+ 
+ BEGIN
+ 
+      TEST ("C95074C", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " &
+                       "NON-ACCESS FORMAL OUT PARAMETERS");
+ 
+      DECLARE
+ 
+           TYPE ARR IS ARRAY (1 .. 10) OF NATURAL;
+ 
+           TYPE REC IS RECORD
+                A : ARR;
+           END RECORD;
+ 
+           A1 : ARR;
+           R1 : REC;
+ 
+           TASK T1 IS
+                ENTRY E (A2 : OUT ARR; R2 : OUT REC);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E (A2 : OUT ARR; R2 : OUT REC) DO
+ 
+                     IF A2'FIRST /= 1 THEN
+                          FAILED ("WRONG VALUE FOR A2'FIRST");
+                     END IF;
+ 
+                     IF A2'LAST /= 10 THEN
+                          FAILED ("WRONG VALUE FOR A2'LAST");
+                     END IF;
+ 
+                     IF A2'LENGTH /= 10 THEN
+                          FAILED ("WRONG VALUE FOR A2'LENGTH");
+                     END IF;
+ 
+                     IF (1 NOT IN A2'RANGE) OR
+                        (10 NOT IN A2'RANGE) OR
+                        (0 IN A2'RANGE) OR
+                        (11 IN A2'RANGE) THEN
+                          FAILED ("WRONG VALUE FOR A2'RANGE");
+                     END IF;
+ 
+                     IF R2.A'FIRST /= 1 THEN
+                          FAILED ("WRONG VALUE FOR R2.A'FIRST");
+                     END IF;
+ 
+                     IF R2.A'LAST /= 10 THEN
+                          FAILED ("WRONG VALUE FOR R2.A'LAST");
+                     END IF;
+ 
+                     IF R2.A'LENGTH /= 10 THEN
+                          FAILED ("WRONG VALUE FOR R2.A'LENGTH");
+                     END IF;
+ 
+                     IF (1 NOT IN R2.A'RANGE) OR
+                        (10 NOT IN R2.A'RANGE) OR
+                        (0 IN R2.A'RANGE) OR
+                        (11 IN R2.A'RANGE) THEN
+                          FAILED ("WRONG VALUE FOR R2.A'RANGE");
+                     END IF;
+                END E;
+           END T1;
+ 
+      BEGIN
+           T1.E (A1,R1);
+      END;
+ 
+      RESULT;
+ END C95074C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95076a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95076a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95076a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95076a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C95076A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ACCEPT STATEMENT WITH AND WITHOUT A RETURN
+ -- STATEMENT RETURNS CORRECTLY.
+ 
+ -- GLH  7/11/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C95076A IS
+ 
+      I : INTEGER;
+ 
+      TASK T1 IS
+           ENTRY E1 (N : IN OUT INTEGER);
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1 (N : IN OUT INTEGER) DO
+                IF (N = 5) THEN
+                     N := N + 5;
+                ELSE
+                     N := 0;
+                END IF;
+           END E1;
+      END T1;
+ 
+      TASK T2 IS
+           ENTRY E2 (N : IN OUT INTEGER);
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           ACCEPT E2 (N : IN OUT INTEGER) DO
+                IF (N = 10) THEN
+                     N := N + 5;
+                     RETURN;
+                END IF;
+                N := 0;
+           END E2;
+      END T2;
+ 
+ BEGIN
+ 
+      TEST ("C95076A", "CHECK THAT AN ACCEPT STATEMENT WITH AND " &
+                       "WITHOUT A RETURN STATEMENT RETURNS CORRECTLY");
+ 
+      I := 5;
+      T1.E1 (I);
+      IF (I /= 10) THEN
+           FAILED ("INCORRECT RENDEVOUS WITHOUT A RETURN");
+      END IF;
+ 
+      I := 10;
+      T2.E2 (I);
+      IF (I /= 15) THEN
+           FAILED ("INCORRECT RENDEVOUS WITH A RETURN");
+      END IF;
+ 
+      RESULT;
+ 
+ END C95076A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95078a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95078a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95078a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95078a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- C95078A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN EXCEPTION RAISED DURING THE EXECUTION OF AN ACCEPT
+ --     STATEMENT CAN BE HANDLED WITHIN THE ACCEPT BODY.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- HISTORY:
+ --     DHH 03/21/88 CREATED ORIGINAL TEST.
+ --     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95078A IS
+ 
+ BEGIN
+ 
+      TEST("C95078A", "CHECK THAT AN EXCEPTION RAISED DURING THE " &
+                      "EXECUTION OF AN ACCEPT STATEMENT CAN BE " &
+                      "HANDLED WITHIN THE ACCEPT BODY");
+ 
+      DECLARE
+           O,PT,QT,R,S,TP,B,C,D :INTEGER := 0;
+           TASK TYPE PROG_ERR IS
+                ENTRY START(M,N,A : IN OUT INTEGER);
+                ENTRY STOP;
+           END PROG_ERR;
+ 
+           TASK T IS
+                ENTRY START(M,N,A : IN OUT INTEGER);
+                ENTRY STOP;
+           END T;
+ 
+           TYPE REC IS
+                RECORD
+                     B : PROG_ERR;
+                END RECORD;
+ 
+           TYPE ACC IS ACCESS PROG_ERR;
+ 
+           SUBTYPE X IS INTEGER RANGE 1 .. 10;
+ 
+           PACKAGE P IS
+                OBJ : REC;
+           END P;
+ 
+           TASK BODY PROG_ERR IS
+                FAULT : X;
+           BEGIN
+                ACCEPT START(M,N,A : IN OUT INTEGER) DO
+                     BEGIN
+                          M := IDENT_INT(1);
+                          FAULT := IDENT_INT(11);
+                          FAULT := IDENT_INT(FAULT);
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("UNEXPECTED ERROR RAISED - " &
+                                      "CONSTRAINT - TASK TYPE");
+                     END; -- EXCEPTION
+                     BEGIN
+                          N := IDENT_INT(1);
+                          FAULT := IDENT_INT(5);
+                          FAULT := FAULT/IDENT_INT(0);
+                          FAULT := IDENT_INT(FAULT);
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("UNEXPECTED ERROR RAISED - " &
+                                      "CONSTRAINT - TASK TYPE");
+                     END; -- EXCEPTION
+                     A := IDENT_INT(1);
+                END START;
+ 
+                ACCEPT STOP;
+           END PROG_ERR;
+ 
+           TASK BODY T IS
+                FAULT : X;
+           BEGIN
+                ACCEPT START(M,N,A : IN OUT INTEGER) DO
+                     BEGIN
+                          M := IDENT_INT(1);
+                          FAULT := IDENT_INT(11);
+                          FAULT := IDENT_INT(FAULT);
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("UNEXPECTED ERROR RAISED - " &
+                                      "CONSTRAINT - TASK");
+                     END; -- EXCEPTION
+                     BEGIN
+                          N := IDENT_INT(1);
+                          FAULT := IDENT_INT(5);
+                          FAULT := FAULT/IDENT_INT(0);
+                          FAULT := IDENT_INT(FAULT);
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("UNEXPECTED ERROR RAISED - " &
+                                      "CONSTRAINT - TASK");
+                     END; -- EXCEPTION
+                     A := IDENT_INT(1);
+                END START;
+ 
+                ACCEPT STOP;
+           END T;
+ 
+           PACKAGE BODY P IS
+           BEGIN
+                OBJ.B.START(O,PT,B);
+                OBJ.B.STOP;
+ 
+                IF O /= IDENT_INT(1) OR PT /= IDENT_INT(1) THEN
+                     FAILED("EXCEPTION HANDLER NEVER ENTERED " &
+                            "PROPERLY - TASK TYPE OBJECT");
+                END IF;
+ 
+                IF B /= IDENT_INT(1) THEN
+                     FAILED("TASK NOT EXITED PROPERLY - TASK TYPE " &
+                            "OBJECT");
+                END IF;
+           END P;
+ 
+           PACKAGE Q IS
+                OBJ : ACC;
+           END Q;
+ 
+           PACKAGE BODY Q IS
+           BEGIN
+                OBJ := NEW PROG_ERR;
+                OBJ.START(QT,R,C);
+                OBJ.STOP;
+ 
+                IF QT /= IDENT_INT(1) OR R /= IDENT_INT(1) THEN
+                     FAILED("EXCEPTION HANDLER NEVER ENTERED " &
+                            "PROPERLY - ACCESS TASK TYPE");
+                END IF;
+ 
+                IF C /= IDENT_INT(1) THEN
+                     FAILED("TASK NOT EXITED PROPERLY - ACCESS TASK " &
+                            "TYPE");
+                END IF;
+           END;
+ 
+      BEGIN
+           T.START(S,TP,D);
+           T.STOP;
+ 
+           IF S /= IDENT_INT(1) OR TP /= IDENT_INT(1) THEN
+                FAILED("EXCEPTION HANDLER NEVER ENTERED PROPERLY " &
+                       "- TASK");
+           END IF;
+ 
+           IF D /= IDENT_INT(1) THEN
+                FAILED("TASK NOT EXITED PROPERLY - TASK");
+           END IF;
+      END; -- DECLARE
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED("EXCEPTION NOT HANDLED INSIDE ACCEPT BODY");
+           RESULT;
+ END C95078A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95080b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95080b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95080b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95080b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C95080B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PARAMETERLESS ENTRIES CAN BE CALLED WITH THE APPROPRIATE
+ -- NOTATION.
+ 
+ -- JWC 7/15/85
+ -- JRK 8/21/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95080B IS
+ 
+      I : INTEGER := 1;
+ 
+      TASK T IS
+           ENTRY E;
+           ENTRY EF (1..3);
+      END T;
+ 
+      TASK BODY T IS
+      BEGIN
+           ACCEPT E DO
+                I := 15;
+           END E;
+           ACCEPT EF (2) DO
+                I := 20;
+           END EF;
+      END T;
+ 
+ BEGIN
+ 
+      TEST ("C95080B", "CHECK THAT PARAMETERLESS ENTRIES CAN BE " &
+                       "CALLED");
+ 
+      T.E;
+      IF I /= 15 THEN
+           FAILED ("PARAMETERLESS ENTRY CALL YIELDS INCORRECT " &
+                   "RESULT");
+      END IF;
+ 
+      I := 0;
+      T.EF (2);
+      IF I /= 20 THEN
+           FAILED ("PARAMETERLESS ENTRY FAMILY CALL YIELDS " &
+                   "INCORRECT RESULT");
+      END IF;
+ 
+      RESULT;
+ 
+ END C95080B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95082g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95082g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95082g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95082g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- C95082G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR CALLS TO ENTRIES HAVING AT LEAST ONE DEFAULT
+ -- PARAMETER, THE CORRECT ASSOCIATION IS MADE BETWEEN ACTUAL AND
+ -- FORMAL PARAMETERS.
+ 
+ -- JWC 7/17/85
+ 
+ WITH REPORT;USE REPORT;
+ PROCEDURE C95082G IS
+ 
+      Y1,Y2,Y3  : INTEGER := 0;
+ 
+      TASK T IS
+           ENTRY E (I1: INTEGER; I2: INTEGER := 2; I3: INTEGER := 3;
+                    O1,O2,O3: OUT INTEGER);
+      END T;
+ 
+      TASK BODY T IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E (I1: INTEGER; I2: INTEGER := 2;
+                               I3: INTEGER := 3;
+                               O1,O2,O3: OUT INTEGER) DO
+                          O1 := I1;
+                          O2 := I2;
+                          O3 := I3;
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C95082G", "CHECK ASSOCIATIONS BETWEEN ACTUAL AND FORMAL " &
+                       "PARAMETERS (HAVING DEFAULT VALUES)");
+ 
+      T.E (I1=>11, I2=>12, I3=>13, O1=>Y1, O2=>Y2, O3=>Y3);
+      IF (Y1 /= 11) OR (Y2 /= 12) OR (Y3 /= 13) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 1");
+      END IF;
+ 
+      T.E (I1=>21, O1=>Y1, O2=>Y2, O3=>Y3);
+      IF (Y1 /= 21) OR (Y2 /= 2) OR (Y3 /= 3) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 2");
+      END IF;
+ 
+      T.E (O1=>Y1, O3=>Y3, I1=>31, I3=>33, O2=>Y2);
+      IF (Y1 /= 31) OR (Y2 /= 2) OR (Y3 /= 33) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 3");
+      END IF;
+ 
+      T.E (41, 42, O1=>Y1, O2=>Y2, O3=>Y3);
+      IF (Y1 /= 41) OR (Y2 /= 42) OR (Y3 /= 3) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 4");
+      END IF;
+ 
+      T.E (51, O3=>Y3, O1=>Y1, O2=>Y2, I3=>53);
+      IF (Y1 /= 51) OR (Y2 /= 2) OR (Y3 /= 53) THEN
+           FAILED ("INCORRECT PARAMETER ASSOCIATION - 5");
+      END IF;
+ 
+      RESULT;
+ 
+ END C95082G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,279 ----
+ -- C95085A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR OUT OF RANGE SCALAR
+ -- ARGUMENTS.  SUBTESTS ARE:
+ --        (A) STATIC IN ARGUMENT.
+ --        (B) DYNAMIC IN ARGUMENT.
+ --        (C) IN OUT, OUT OF RANGE ON CALL.
+ --        (D) OUT, OUT OF RANGE ON RETURN.
+ --        (E) IN OUT, OUT OF RANGE ON RETURN.
+ 
+ -- GLH 7/15/85
+ -- JRK 8/23/85
+ -- JWC 11/15/85     ADDED VARIABLE "CALLED" TO ENSURE THAT THE ENTRY
+ --                  CALL WAS MADE FOR THOSE CASES THAT ARE APPLICABLE.
+ 
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C95085A IS
+ 
+      SUBTYPE DIGIT IS INTEGER RANGE 0..9;
+ 
+      D      : DIGIT;
+      I      : INTEGER;
+      M1     : CONSTANT INTEGER := IDENT_INT (-1);
+      COUNT  : INTEGER := 0;
+      CALLED : BOOLEAN;
+ 
+      SUBTYPE SI IS INTEGER RANGE M1 .. 10;
+ 
+      TASK T1 IS
+           ENTRY E1 (PIN : IN DIGIT; WHO : STRING);  -- (A), (B).
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           LOOP
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (PIN : IN DIGIT;
+                                     WHO : STRING) DO  -- (A), (B).
+                               FAILED ("EXCEPTION NOT RAISED BEFORE " &
+                                       "CALL - E1 " & WHO);
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN E1");
+                END;
+           END LOOP;
+      END T1;
+ 
+      TASK T2 IS
+           ENTRY E2 (PINOUT : IN OUT DIGIT; WHO : STRING);  -- (C).
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           LOOP
+                BEGIN
+                     SELECT
+                          ACCEPT E2 (PINOUT : IN OUT DIGIT;
+                                     WHO : STRING) DO  -- (C).
+                               FAILED ("EXCEPTION NOT RAISED BEFORE " &
+                                       "CALL - E2 " & WHO);
+                          END E2;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN E2");
+                END;
+           END LOOP;
+      END T2;
+ 
+      TASK T3 IS
+           ENTRY E3 (POUT : OUT SI; WHO : STRING);  -- (D).
+      END T3;
+ 
+      TASK BODY T3 IS
+      BEGIN
+           LOOP
+                BEGIN
+                     SELECT
+                          ACCEPT E3 (POUT : OUT SI;
+                                     WHO : STRING) DO  -- (D).
+                               CALLED := TRUE;
+                               IF WHO = "10" THEN
+                                    POUT := IDENT_INT (10);  -- 10 IS NOT
+                                                             -- A DIGIT.
+                               ELSE
+                                    POUT := -1;
+                               END IF;
+                          END E3;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN E3");
+                END;
+           END LOOP;
+      END T3;
+ 
+      TASK T4 IS
+           ENTRY E4 (PINOUT : IN OUT INTEGER; WHO : STRING);  -- (E).
+      END T4;
+ 
+      TASK BODY T4 IS
+      BEGIN
+           LOOP
+                BEGIN
+                     SELECT
+                          ACCEPT E4 (PINOUT : IN OUT INTEGER;
+                                     WHO : STRING) DO  -- (E).
+                               CALLED := TRUE;
+                               IF WHO = "10" THEN
+                                    PINOUT := 10;  -- 10 IS NOT A DIGIT.
+                               ELSE
+                                    PINOUT := IDENT_INT (-1);
+                               END IF;
+                          END E4;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN E4");
+                END;
+           END LOOP;
+      END T4;
+ 
+ BEGIN
+ 
+      TEST ("C95085A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "FOR OUT OF RANGE SCALAR ARGUMENTS");
+ 
+      BEGIN  -- (A)
+           T1.E1 (10, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E1 (10)");
+      END;  -- (A)
+ 
+      BEGIN  -- (B)
+           T1.E1 (IDENT_INT (-1), "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (" &
+                   "IDENT_INT (-1))");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E1 (" &
+                        "IDENT_INT (-1))");
+      END;  -- (B)
+ 
+      BEGIN  -- (C)
+           I := IDENT_INT (10);
+           T2.E2 (I, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E2 (10)");
+      END;  -- (C)
+ 
+      BEGIN -- (C1)
+           I := IDENT_INT (-1);
+           T2.E2 (I, "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (-1)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E2 (-1)");
+      END; -- (C1)
+ 
+      BEGIN  -- (D)
+           CALLED := FALSE;
+           D := IDENT_INT (1);
+           T3.E3 (D, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                   "E3 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                             "E3 (10)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E3 (10)");
+      END;  -- (D)
+ 
+      BEGIN -- (D1)
+           CALLED := FALSE;
+           D := IDENT_INT (1);
+           T3.E3 (D, "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                   "E3 (-1)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                             "E3 (-1)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E3 (-1)");
+      END; -- (D1)
+ 
+      BEGIN  -- (E)
+           CALLED := FALSE;
+           D := 9;
+           T4.E4 (D, "10");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                   "E4 (10)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                             "E4 (10)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E4 (10)");
+      END;  -- (E)
+ 
+      BEGIN -- (E1)
+           CALLED := FALSE;
+           D := 0;
+           T4.E4 (D, "-1");
+           FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                   "E4 (-1)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                COUNT := COUNT + 1;
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                             "E4 (-1)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED FOR E4 (-1)");
+      END; -- (E1)
+ 
+      IF COUNT /= 8 THEN
+           FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
+      END IF;
+ 
+      RESULT;
+ 
+ END C95085A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- C95085B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER APPROPRIATE CIRCUMSTANCES
+ -- WITH RESPECT TO PARAMETERS OF RECORD TYPES IN ENTRY CALLS.  SUBTESTS
+ -- INVOLVE ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT
+ -- EQUAL TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
+ --        (A) IN PARAMETER, STATIC AGGREGATE.
+ --        (B) IN PARAMETER, DYNAMIC AGGREGATE.
+ --        (C) IN PARAMETER, VARIABLE.
+ --        (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
+ --        (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
+ 
+ -- JWC 10/25/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085B IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0..10;
+ 
+      TYPE REC (N : INT := 0) IS
+           RECORD
+                A : STRING (1..N);
+           END RECORD;
+ 
+      SUBTYPE SREC IS REC(N=>3);
+ 
+ BEGIN
+ 
+      TEST ("C95085B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
+                       "PARAMETERS OF RECORD TYPES");
+ 
+      DECLARE
+ 
+           TASK TSK1 IS
+                ENTRY E (R : IN SREC);
+           END TSK1;
+ 
+           TASK BODY TSK1 IS
+           BEGIN
+                LOOP
+                     BEGIN
+                          SELECT
+                               ACCEPT E (R : IN SREC) DO
+                                    FAILED ("EXCEPTION NOT RAISED ON " &
+                                            "CALL TO TSK1");
+                               END E;
+                          OR
+                               TERMINATE;
+                          END SELECT;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("EXCEPTION RAISED IN TSK1");
+                     END;
+                END LOOP;
+           END TSK1;
+ 
+      BEGIN
+ 
+           BEGIN -- (A)
+                TSK1.E ((2,"AA"));
+                FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
+           END; -- (A)
+ 
+           BEGIN -- (B)
+                TSK1.E ((IDENT_INT(2), "AA"));
+                FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
+           END; -- (B)
+ 
+           DECLARE -- (C)
+                R : REC     := (IDENT_INT(2), "AA");
+           BEGIN -- (C)
+                TSK1.E (R);
+                FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
+           END; -- (C)
+ 
+      END;
+ 
+      DECLARE -- (D)
+ 
+           R : REC := (IDENT_INT(2), "AA");
+ 
+           TASK TSK2 IS
+                ENTRY E (R : IN OUT SREC);
+           END TSK2;
+ 
+           TASK BODY TSK2 IS
+           BEGIN
+                SELECT
+                     ACCEPT E (R : IN OUT SREC) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
+                                  "TSK2");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TSK2");
+           END TSK2;
+ 
+      BEGIN -- (D)
+           TSK2.E (R);
+           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
+      END; -- (D)
+ 
+      DECLARE -- (E)
+ 
+           R : REC;
+ 
+           TASK TSK3 IS
+                ENTRY E (R : OUT SREC);
+           END TSK3;
+ 
+           TASK BODY TSK3 IS
+           BEGIN
+                SELECT
+                     ACCEPT E (R : OUT SREC) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
+                                  "TSK3");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TSK3");
+           END TSK3;
+ 
+      BEGIN -- (E)
+           TSK3.E (R);
+           FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
+      END; -- (E)
+ 
+      RESULT;
+ 
+ END C95085B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,245 ----
+ -- C95085C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE
+ -- APPROPRIATE CIRCUMSTANCES FOR ARRAY PARAMETERS IN ENTRY CALLS,
+ -- NAMELY WHEN THE ACTUAL BOUNDS DON'T MATCH THE FORMAL BOUNDS
+ -- (BEFORE THE CALL FOR ALL MODES).
+ -- SUBTESTS ARE:
+ --      (A) IN MODE, ONE DIMENSION, STATIC AGGREGATE.
+ --      (B) IN MODE, TWO DIMENSIONS, DYNAMIC AGGREGATE.
+ --      (C) IN MODE, TWO DIMENSIONS, DYNAMIC VARIABLE.
+ --      (D) IN OUT MODE, THREE DIMENSIONS, STATIC VARIABLE.
+ --      (E) OUT MODE, ONE DIMENSION, DYNAMIC VARIABLE.
+ --      (F) IN OUT MODE, NULL STRING AGGREGATE.
+ --      (G) IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE (OK CASE).
+ --          IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE.
+ 
+ -- JWC 10/28/85
+ -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085C IS
+ 
+ BEGIN
+      TEST ("C95085C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                       "ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+           SUBTYPE ST IS STRING (1..3);
+ 
+           TASK TSK IS
+                ENTRY E (A : ST);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (A : ST) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
+           END TSK;
+ 
+      BEGIN -- (A)
+ 
+           TSK.E ("AB");
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (A)");
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..3;
+           TYPE T IS ARRAY (S,S) OF INTEGER;
+ 
+           TASK TSK IS
+                ENTRY E (A : T);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (A : T) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
+           END TSK;
+ 
+      BEGIN -- (B)
+ 
+           TSK.E ((1..3 => (1..IDENT_INT(2) => 0)));
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (B)");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..5;
+           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
+           SUBTYPE ST IS T (1..3,1..3);
+           V : T (1..IDENT_INT(2), 1..3) :=
+                 (1..IDENT_INT(2) => (1..3 => 0));
+ 
+           TASK TSK IS
+                ENTRY E (A :ST);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (A :ST) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
+           END TSK;
+ 
+      BEGIN -- (C)
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (C)");
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..5;
+           TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
+                     INTEGER;
+           SUBTYPE ST IS T (1..3, 1..3, 1..3);
+           V : T (1..3, 1..2, 1..3) :=
+                 (1..3 => (1..2 => (1..3 => 0)));
+ 
+           TASK TSK IS
+                ENTRY E (A : IN OUT ST);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (A : IN OUT ST) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL - (D)");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
+           END TSK;
+ 
+      BEGIN -- (D)
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED - (D)");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+ 
+      DECLARE -- (G)
+ 
+           SUBTYPE S IS INTEGER RANGE 1..5;
+           TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
+           SUBTYPE ST IS T (2..1, 2..1);
+           V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
+ 
+           TASK TSK IS
+                ENTRY E (A : IN OUT ST);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (A : IN OUT ST)  DO
+                          COMMENT ("OK CASE CALLED CORRECTLY");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (G)");
+           END TSK;
+ 
+      BEGIN -- (G)
+ 
+           TSK.E (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
+           WHEN OTHERS =>
+                FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
+      END; -- (G)
+ 
+      --------------------------------------------------
+ 
+ 
+      RESULT;
+ END C95085C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C95085D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (A) BEFORE CALL, IN MODE, STATIC PRIVATE DISCRIMINANT.
+ 
+ -- JWC 10/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085D IS
+ 
+ BEGIN
+      TEST ("C95085D", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2, E3);
+                TYPE T (D : E := E1) IS PRIVATE;
+                TYPE AR IS ARRAY (E1 .. E3) OF INTEGER;
+           PRIVATE
+                TYPE T (D : E := E1) IS
+                     RECORD
+                          I : INTEGER;
+                          A : AR;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE A1 IS A (E3);
+           V : A (E2) := NEW T (E2);
+ 
+           TASK TSK IS
+                ENTRY E (X : A1);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : A1) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      ------------------------------------------------
+ 
+      RESULT;
+ END C95085D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C95085E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (B) BEFORE CALL, IN MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+ 
+ -- JWC 10/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085E IS
+ 
+ BEGIN
+      TEST ("C95085E", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE T IS ARRAY (BOOLEAN RANGE <>, CHARACTER RANGE <>) OF
+                     INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE A1 IS A (BOOLEAN, 'A'..'C');
+           V : A := NEW T (BOOLEAN, 'A'..IDENT_CHAR('B'));
+ 
+           TASK TSK IS
+                ENTRY E (X : A1);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : A1) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                 FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C95085F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY
+ -- WHEN THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (C) BEFORE CALL, IN OUT MODE, STATIC ONE DIMENSIONAL BOUNDS.
+ 
+ -- JWC 10/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085F IS
+ 
+ BEGIN
+      TEST ("C95085F", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE A IS ACCESS STRING;
+           SUBTYPE A1 IS A (1..3);
+           V : A (2..4) := NEW STRING (2..4);
+ 
+           TASK TSK IS
+                ENTRY E (X : IN OUT A1);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : IN OUT A1) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C95085G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (D) BEFORE CALL, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+ 
+ -- JWC 10/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085G IS
+ 
+ BEGIN
+      TEST ("C95085G", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           SUBTYPE INT IS INTEGER RANGE 0..10;
+           TYPE T (C : CHARACTER := 'A';
+                   B : BOOLEAN := FALSE;
+                   I : INT := 0) IS
+                RECORD
+                     J : INTEGER;
+                     CASE B IS
+                          WHEN FALSE =>
+                               K : INTEGER;
+                          WHEN TRUE =>
+                               S : STRING (1 .. I);
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A ('Z', TRUE, 5);
+           V : A := NEW T ('Z', IDENT_BOOL(FALSE), 5);
+ 
+           TASK TSK IS
+                ENTRY E (X : IN OUT SA);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : IN OUT SA) DO
+                          FAILED ("EXCEPTION NOT RAISED ON CALL");
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                      FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- C95085H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (E) AFTER RETURN, IN OUT MODE, STATIC LIMITED PRIVATE
+ --           DISCRIMINANTS.
+ 
+ -- JWC 10/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085H IS
+ 
+ BEGIN
+      TEST ("C95085H", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           PACKAGE PKG IS
+                SUBTYPE INT IS INTEGER RANGE 0..10;
+                SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'C';
+                TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                     LIMITED PRIVATE;
+           PRIVATE
+                TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                     RECORD
+                          J : INTEGER;
+                          CASE C IS
+                               WHEN 'A' =>
+                                    K : INTEGER;
+                               WHEN 'B' =>
+                                    S : STRING (1..I);
+                               WHEN OTHERS =>
+                                    NULL;
+                          END CASE;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+ 
+           V : A (2,'B') := NEW T (2,'B');
+ 
+           TASK TSK IS
+                ENTRY E (X : IN OUT A);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : IN OUT A) DO
+                          CALLED := TRUE;
+                          X := NEW T (2,'A');
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C95085I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (F) AFTER RETURN, IN OUT MODE, DYNAMIC THREE DIMENSIONAL
+ --           BOUNDS.
+ 
+ -- JWC 10/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085I IS
+ 
+ BEGIN
+      TEST ("C95085I", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           TYPE E IS (E1, E2, E3);
+ 
+           TYPE T IS ARRAY (CHARACTER RANGE <>,
+                            E RANGE <>,
+                            BOOLEAN RANGE <>
+                           ) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+ 
+           V : A ('A'..'Z', E1..E2, BOOLEAN) :=
+                     NEW T ('A'..'Z', E1..E2, BOOLEAN);
+ 
+           TASK TSK IS
+                ENTRY E (X : IN OUT A);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : IN OUT A) DO
+                          CALLED := TRUE;
+                          IF EQUAL (3,3) THEN
+                               X := NEW T ('A'..'Z', E2..E3, BOOLEAN);
+                          END IF;
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085j.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085j.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085j.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085j.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C95085J.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (G) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, STATIC ONE
+ --           DIMENSIONAL BOUNDS.
+ 
+ -- JWC 10/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085J IS
+ 
+ BEGIN
+      TEST ("C95085J", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           TYPE A IS ACCESS STRING;
+ 
+           V : A (1..3) := NEW STRING (1..3);
+ 
+           TASK TSK IS
+                ENTRY E (X : OUT A);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : OUT A) DO
+                          CALLED := TRUE;
+                          X := NEW STRING (2..3);
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085J;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085k.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085k.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085k.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085k.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C95085K.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (H) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, DYNAMIC
+ --           RECORD DISCRIMINANT.
+ 
+ -- JWC 10/24/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085K IS
+ 
+ BEGIN
+      TEST ("C95085K", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           TYPE ARR IS ARRAY (BOOLEAN RANGE <>) OF INTEGER;
+           TYPE T (B : BOOLEAN := FALSE) IS
+                RECORD
+                     I : INTEGER;
+                     A : ARR (FALSE..B);
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+ 
+           V : A (IDENT_BOOL(FALSE)) := NEW T (IDENT_BOOL(FALSE));
+ 
+           TASK TSK IS
+                ENTRY E (X : OUT A);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : OUT A) DO
+                          CALLED := TRUE;
+                          X := NEW T (TRUE);
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085K;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085l.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085l.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085l.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085l.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,109 ----
+ -- C95085L.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+ -- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (I) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, STATIC
+ --           PRIVATE DISCRIMINANTS.
+ 
+ -- JWC 10/24/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085L IS
+ 
+ BEGIN
+      TEST ("C95085L", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2, E3);
+                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                     PRIVATE;
+           PRIVATE
+                TYPE ARR IS ARRAY (E RANGE <>) OF INTEGER;
+                TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                     RECORD
+                          I : INTEGER;
+                          CASE B IS
+                               WHEN FALSE =>
+                                    J : INTEGER;
+                               WHEN TRUE =>
+                                    A : ARR (E1 .. D);
+                          END CASE;
+                     END RECORD;
+           END PKG;
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (E2, TRUE);
+           V : A (E2, FALSE) := NEW T (E2, FALSE);
+ 
+           TASK TSK IS
+                ENTRY E (X : OUT SA);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : OUT SA) DO
+                          CALLED := TRUE;
+                          X := NEW T (E2, TRUE);
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      ------------------------------------------------
+ 
+      RESULT;
+ END C95085L;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085m.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085m.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085m.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085m.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,96 ----
+ -- C95085M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+ -- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN THE
+ -- ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+ -- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+ -- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+ -- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+ 
+ --       (J) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, DYNAMIC TWO
+ --           DIMENSIONAL BOUNDS.
+ 
+ -- JWC 10/24/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085M IS
+ 
+ BEGIN
+      TEST ("C95085M", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR ACCESS PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           TYPE T IS ARRAY (INTEGER RANGE <>,
+                            CHARACTER RANGE <>) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+ 
+           V : A (1..10, 'A'..'Z') := NEW T (1..10, 'A'..'Z');
+ 
+           Y : CONSTANT CHARACTER := IDENT_CHAR('Y');
+           SUBTYPE SA IS A (1..10, 'A'..Y);
+ 
+           TASK TSK IS
+                ENTRY E (X : OUT SA);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : OUT SA) DO
+                          CALLED := TRUE;
+                          X := NEW T (1..10, 'A'..IDENT_CHAR('Y'));
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+      BEGIN
+ 
+           TSK.E (V);
+           FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95085M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085n.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085n.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085n.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085n.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C95085N.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED AFTER AN ENTRY CALL FOR THE
+ -- CASE OF A PRIVATE TYPE IMPLEMENTED AS A SCALAR TYPE WHERE THE VALUE
+ -- OF THE FORMAL PARAMETER DOES NOT BELONG TO THE SUBTYPE OF THE ACTUAL
+ -- PARAMETER.
+ 
+ -- JWC 10/29/85
+ -- JRK 1/15/86      ENSURE THAT EXCEPTION RAISED AFTER CALL, NOT BEFORE
+ --                  CALL.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085N IS
+ 
+ BEGIN
+      TEST ("C95085N", "CHECK THAT PRIVATE TYPE (SCALAR) RAISES " &
+                       "CONSTRAINT_ERROR AFTER CALL WHEN FORMAL " &
+                       "PARAMETER VALUE IS NOT IN ACTUAL'S SUBTYPE");
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           PACKAGE P IS
+                TYPE T IS PRIVATE;
+                DC : CONSTANT T;
+ 
+                GENERIC PACKAGE PP IS
+                END PP;
+           PRIVATE
+                TYPE T IS NEW INTEGER;
+                DC : CONSTANT T := -1;
+           END P;
+ 
+           TASK TSK IS
+                ENTRY E (X : OUT P.T);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : OUT P.T) DO
+                          CALLED := TRUE;
+                          X := P.DC;
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+           GENERIC
+                Y : IN OUT P.T;
+           PACKAGE CALL IS
+           END CALL;
+ 
+           PACKAGE BODY CALL IS
+           BEGIN
+                TSK.E (Y);
+                FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED");
+           END CALL;
+ 
+           PACKAGE BODY P IS
+                Z : T RANGE 0..1 := 0;
+                PACKAGE BODY PP IS
+                     PACKAGE CALL_Q IS NEW CALL (Z);
+                END PP;
+           END P;
+ 
+      BEGIN
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE CALL_Q_NOW IS NEW P.PP;    -- START HERE.
+                BEGIN
+                     NULL;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER INVOKED");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ END C95085N;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085o.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085o.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95085o.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95085o.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- C95085O.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED AFTER AN ENTRY CALL FOR THE
+ -- CASE OF A PRIVATE TYPE IMPLEMENTED AS AN ACCESS TYPE WHERE THE VALUE
+ -- OF THE FORMAL PARAMETER DOES NOT BELONG TO THE SUBTYPE OF THE ACTUAL
+ -- PARAMETER.
+ 
+ -- JWC 10/30/85
+ -- JRK 1/15/86      ENSURE THAT EXCEPTION RAISED AFTER CALL, NOT BEFORE
+ --                  CALL.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95085O IS
+ 
+ BEGIN
+ 
+      TEST ("C95085O", "CHECK THAT PRIVATE TYPE (ACCESS) RAISES " &
+                       "CONSTRAINT_ERROR AFTER CALL WHEN FORMAL " &
+                       "PARAMETER VALUE IS NOT IN ACTUAL'S SUBTYPE");
+ 
+      DECLARE
+ 
+           CALLED : BOOLEAN := FALSE;
+ 
+           PACKAGE P IS
+                TYPE T IS PRIVATE;
+                DC : CONSTANT T;
+ 
+                GENERIC PACKAGE PP IS
+                END PP;
+           PRIVATE
+                TYPE T IS ACCESS STRING;
+                DC : CONSTANT T := NEW STRING'("AAA");
+           END P;
+ 
+           TASK TSK IS
+                ENTRY E (X : IN OUT P.T);
+           END TSK;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                SELECT
+                     ACCEPT E (X : IN OUT P.T) DO
+                          CALLED := TRUE;
+                          X := P.DC;
+                     END E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+           END TSK;
+ 
+           GENERIC
+                Y : IN OUT P.T;
+           PACKAGE CALL IS
+           END CALL;
+ 
+           PACKAGE BODY CALL IS
+           BEGIN
+                TSK.E (Y);
+                FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     IF NOT CALLED THEN
+                          FAILED ("EXCEPTION RAISED BEFORE CALL");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED");
+           END CALL;
+ 
+           PACKAGE BODY P IS
+                Z : T (1..5) := NEW STRING'("CCCCC");
+                PACKAGE BODY PP IS
+                     PACKAGE CALL_Q IS NEW CALL (Z);
+                END PP;
+           END P;
+ 
+      BEGIN
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE CALL_Q_NOW IS NEW P.PP;    -- START HERE.
+                BEGIN
+                     NULL;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER INVOKED");
+           END;
+ 
+      END;
+ 
+      RESULT;
+ END C95085O;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C95086A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED AT THE TIME OF CALL WHEN
+ -- THE VALUE OF AN ACTUAL OUT SCALAR PARAMETER DOES NOT SATISFY THE
+ -- RANGE CONSTRAINTS OF THE FORMAL PARAMETER.
+ 
+ -- GLH 7/16/85
+ -- JRK 8/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95086A IS
+ 
+      SUBTYPE SUBINT1 IS INTEGER RANGE -10..10;
+      SUBTYPE SUBINT2 IS INTEGER RANGE -20..20;
+ 
+      I10  : SUBINT1 := 10;
+      I20  : SUBINT2 := 20;
+ 
+      TASK T1 IS
+           ENTRY E1 (I : OUT SUBINT1);
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           LOOP
+                BEGIN
+                     SELECT
+                          ACCEPT E1 (I : OUT SUBINT1) DO
+                               I := SUBINT1'FIRST;
+                          END E1;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED IN ACCEPT E1");
+                END;
+           END LOOP;
+      END T1;
+ 
+ BEGIN
+ 
+      TEST ("C95086A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+                       "AT THE TIME OF CALL WHEN THE VALUE OF AN " &
+                       "ACTUAL OUT SCALAR PARAMETER DOES NOT " &
+                       "SATISFY THE RANGE CONSTRAINTS OF THE FORMAL " &
+                       "PARAMETER");
+ 
+      BEGIN
+           T1.E1 (SUBINT1(I20));
+           IF I20 /= IDENT_INT (-10) THEN
+                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 1");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED ON CALL TO E1 - 1");
+      END;
+ 
+      BEGIN
+           I20 := IDENT_INT (20);
+           T1.E1 (I20);
+           IF I20 /= IDENT_INT (-10) THEN
+                FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 2");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED ON CALL TO E1 - 2");
+      END;
+ 
+      RESULT;
+ 
+ END C95086A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,202 ----
+ -- C95086B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
+ --   BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS
+ --   PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT
+ --   FROM THE FORMAL PARAMETER.
+ --
+ --   SUBTESTS ARE:
+ --       (A) IN MODE, STATIC ONE DIMENSIONAL BOUNDS.
+ --       (B) IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+ --       (C) CASE (A), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+ --       (D) CASE (B), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+ 
+ -- RJW 1/27/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95086B IS
+ 
+ BEGIN
+      TEST ( "C95086B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+             "BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL " &
+             "ACCESS PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS " &
+             "DIFFERENT FROM THE FORMAL PARAMETER" );
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           TYPE E IS (E1, E2, E3, E4);
+           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (E2..E4);
+           V : A (E1..E2) := NULL;
+ 
+           TASK T1 IS
+                ENTRY P (X : SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : SA);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED IN TASK - (A)" );
+           END T1;
+ 
+      BEGIN -- (A)
+ 
+           T1.P (V);
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - (A)" );
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+ 
+           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN FALSE =>
+                               J : INTEGER;
+                          WHEN TRUE =>
+                               A : ARR ('A' .. C);
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (TRUE, 'C');
+           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+ 
+           TASK T1 IS
+                ENTRY P (X : IN OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : IN OUT SA) DO
+                     NULL;
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED IN TASK - (B)" );
+           END T1;
+ 
+      BEGIN -- (B)
+ 
+           T1.P (V);
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - (B)" );
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           TYPE E IS (E1, E2, E3, E4);
+           TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (E2..E4);
+           V : A (E1..E2) := NULL;
+ 
+           TASK T1 IS
+                ENTRY P (X : SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : SA) DO
+                     NULL;
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED IN TASK - (C)" );
+           END T1;
+ 
+      BEGIN -- (C)
+ 
+           T1.P (SA(V));
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - (C)" );
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+ 
+           TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+                RECORD
+                     I : INTEGER;
+                     CASE B IS
+                          WHEN FALSE =>
+                               J : INTEGER;
+                          WHEN TRUE =>
+                               A : ARR ('A' .. C);
+                     END CASE;
+                END RECORD;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (TRUE, 'C');
+           V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+ 
+           TASK T1 IS
+                ENTRY P (X : IN OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : IN OUT SA);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED IN TASK - (D)" );
+           END T1;
+ 
+      BEGIN -- (D)
+ 
+           T1.P (SA(V));
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ( "EXCEPTION RAISED - (D)" );
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95086B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,250 ----
+ -- C95086C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
+ --   AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL
+ --   ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS
+ --   DIFFERENT CONSTRAINTS.
+ --
+ --   SUBTESTS ARE:
+ --       (A) IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
+ --       (B) OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+ --       (C) SAME AS (A), WITH TYPE CONVERSION.
+ --       (D) SAME AS (B), WITH TYPE CONVERSION.
+ 
+ -- RJW 1/29/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95086C IS
+ 
+ BEGIN
+      TEST ("C95086C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL " &
+            "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
+            "DIFFERENT CONSTRAINTS" );
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2);
+                TYPE T (D : E := E1) IS PRIVATE;
+           PRIVATE
+                TYPE T (D : E := E1) IS
+                     RECORD
+                          I : INTEGER;
+                          CASE D IS
+                               WHEN E1 =>
+                                    B : BOOLEAN;
+                               WHEN E2 =>
+                                    C : CHARACTER;
+                          END CASE;
+                     END RECORD;
+           END PKG;
+ 
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (E2);
+           V : A (E1) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           TASK T1 IS
+                ENTRY P (X : IN OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : IN OUT SA) DO
+                     ENTERED := TRUE;
+                     X := NULL;
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
+           END T1;
+ 
+      BEGIN -- (A)
+ 
+           T1.P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (A)");
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                     INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           TASK T1 IS
+                ENTRY P (X : OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : OUT SA) DO
+                     ENTERED := TRUE;
+                     X := NULL;
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
+           END T1;
+ 
+      BEGIN -- (B)
+ 
+           T1.P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (B)");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           PACKAGE PKG IS
+                TYPE E IS (E1, E2);
+                TYPE T (D : E := E1) IS PRIVATE;
+           PRIVATE
+                TYPE T (D : E := E1) IS
+                     RECORD
+                          I : INTEGER;
+                          CASE D IS
+                               WHEN E1 =>
+                                    B : BOOLEAN;
+                               WHEN E2 =>
+                                    C : CHARACTER;
+                          END CASE;
+                     END RECORD;
+           END PKG;
+ 
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (E2);
+           V : A (E1) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           TASK T1 IS
+                ENTRY P (X : IN OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : IN OUT SA) DO
+                     ENTERED := TRUE;
+                     X := NULL;
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
+           END T1;
+ 
+      BEGIN -- (C)
+ 
+           T1.P (SA(V));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (C)");
+      END; -- (C)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                     INTEGER;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+           V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                  IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+           ENTERED : BOOLEAN := FALSE;
+ 
+           TASK T1 IS
+                ENTRY P (X : OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : OUT SA) DO
+                     ENTERED := TRUE;
+                     X := NULL;
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
+           END T1;
+ 
+      BEGIN -- (D)
+ 
+           T1.P (SA(V));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT ENTERED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (D)");
+      END; -- (D)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95086C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,142 ----
+ -- C95086D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED FOR ACCESS PARAMETERS
+ --    BEFORE OR AFTER THE ENTRY CALL, WHEN AN UNCONSTRAINED ACTUAL
+ --    OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE
+ --    ENTRY CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL
+ --    PARAMETER.
+ --
+ --   SUBTESTS ARE:
+ --       (A) STATIC LIMITED PRIVATE DISCRIMINANT.
+ --       (B) DYNAMIC ONE DIMENSIONAL BOUNDS.
+ 
+ -- RJW 2/3/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95086D IS
+ 
+ BEGIN
+      TEST ("C95086D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "BEFORE AND AFTER THE ENTRY CALL, WHEN AN UNCONSTRAINED " &
+            "ACTUAL OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR " &
+            "TO THE ENTRY CALL) WITH CONSTRAINTS DIFFERENT FROM THE " &
+            "FORMAL PARAMETER");
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           PACKAGE PKG IS
+                SUBTYPE INT IS INTEGER RANGE 0..5;
+                TYPE T (I : INT := 0) IS LIMITED PRIVATE;
+           PRIVATE
+                TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+                TYPE T (I : INT := 0) IS
+                     RECORD
+                          J : INTEGER;
+                          A : ARR (1..I);
+                     END RECORD;
+           END PKG;
+ 
+           USE PKG;
+ 
+           TYPE A IS ACCESS T;
+           SUBTYPE SA IS A (3);
+           V : A := NEW T (2);
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T1 IS
+                ENTRY P (X : OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : OUT SA) DO
+                     CALLED := TRUE;
+                     X := NEW T (3);
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
+           END T1;
+ 
+      BEGIN -- (A)
+ 
+           T1.P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (A)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (A)");
+      END; -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           TYPE A IS ACCESS STRING;
+           SUBTYPE SA IS A (1..2);
+           V : A := NEW STRING (IDENT_INT(5) .. IDENT_INT(7));
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T1 IS
+                ENTRY P (X : OUT SA);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT P (X : OUT SA) DO
+                     CALLED := TRUE;
+                     X := NEW STRING (IDENT_INT(1) .. IDENT_INT(2));
+                END P;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
+           END T1;
+ 
+      BEGIN -- (B)
+ 
+           T1.P (V);
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (B)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (B)");
+      END; -- (B)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95086D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,282 ----
+ -- C95086E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED BEFORE OR AFTER THE ENTRY
+ -- CALL FOR IN OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
+ -- FORM OF A TYPE CONVERSION.  THE FOLLOWING CASES ARE TESTED:
+ --   (A) OK CASE.
+ --   (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
+ --       COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
+ --       FORMAL INDEX SUBTYPE.
+ --   (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
+ --       COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
+ --       ARRAYS.
+ --   (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+ --       FORMAL INDEX SUBTYPE.
+ --   (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+ --       FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
+ 
+ -- RJW 2/3/86
+ -- TMB 11/15/95 ELIMINATED INCOMPATIBILITY WITH ADA95
+ -- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95086E IS
+ 
+ BEGIN
+      TEST ("C95086E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "BEFORE OR AFTER THE ENTRY CALL FOR IN OUT ARRAY " &
+            "PARAMETERS, WITH THE ACTUAL HAVING THE FORM OF A TYPE " &
+            "CONVERSION");
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..5;
+           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+                OF BOOLEAN;
+           SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
+           SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
+           AR : ACTUAL := (1..3 => (1..3 => TRUE));
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : IN OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : IN OUT FORMAL) DO
+                     CALLED := TRUE;
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
+           END T;
+ 
+      BEGIN -- (A)
+ 
+           T.E (FORMAL (AR));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (A)");
+      END; -- (A)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..3;
+           TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
+           TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
+           AR : ACTUAL := (3..5 => (3..5 => FALSE));
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : IN OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : IN OUT FORMAL) DO
+                     CALLED := TRUE;
+                     X(3, 3) := TRUE;
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
+           END T;
+ 
+      BEGIN -- (B)
+ 
+           T.E (FORMAL (AR));
+           IF AR(5, 5) /= TRUE THEN
+                FAILED ("INCORRECT RETURNED VALUE - (B)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (B)");
+      END; -- (B)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..5;
+           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+                OF CHARACTER;
+           SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
+           AR : ARRAY_TYPE (2..1, 1..3) := (2..1 => (1..3 => ' '));
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : IN OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : IN OUT FORMAL) DO
+                     IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
+                          FAILED ("WRONG BOUNDS PASSED - (C)");
+                     END IF;
+                     CALLED := TRUE;
+                     X := (2..0 => (1..3 => 'A'));
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
+           END T;
+ 
+      BEGIN -- (C)
+ 
+           T.E (FORMAL (AR));
+           IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
+                FAILED ("BOUNDS CHANGED - (C)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (C)");
+      END; -- (C)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..3;
+           TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
+                OF CHARACTER;
+           TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
+           AR : ACTUAL := (3..5 => (5..3 => ' '));
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : IN OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : IN OUT FORMAL) DO
+                     IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
+                          FAILED ("WRONG BOUNDS PASSED - (D)");
+                     END IF;
+                     CALLED := TRUE;
+                     X := (1..3 => (3..1 => 'A'));
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
+           END T;
+ 
+      BEGIN -- (D)
+ 
+           T.E (FORMAL (AR));
+           IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
+                FAILED ("BOUNDS CHANGED - (D)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (D)");
+      END; -- (D)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (E)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..3;
+           TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+                OF CHARACTER;
+           TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
+                                 POSITIVE RANGE 1..3) OF CHARACTER;
+           AR : ACTUAL := (5..2 => (1..3 => ' '));
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : IN OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : IN OUT FORMAL) DO
+                     IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
+                          FAILED ("WRONG BOUNDS PASSED - (E)");
+                     END IF;
+                     CALLED := TRUE;
+                     X := (3..1 => (1..3 => ' '));
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (E)");
+           END T;
+ 
+      BEGIN -- (E)
+ 
+           T.E (FORMAL (AR));
+           IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
+                FAILED ("BOUNDS CHANGED - (E)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (E)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (E)");
+      END; -- (E)
+ 
+      ---------------------------------------------
+ 
+      RESULT;
+ END C95086E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95086f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95086f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,282 ----
+ -- C95086F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED BEFORE OR AFTER THE ENTRY
+ -- CALL FOR OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
+ -- FORM OF A TYPE CONVERSION.  THE FOLLOWING CASES ARE TESTED:
+ --   (A) OK CASE.
+ --   (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
+ --       COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
+ --       FORMAL INDEX SUBTYPE.
+ --   (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
+ --       COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
+ --       ARRAYS.
+ --   (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+ --       FORMAL INDEX SUBTYPE.
+ --   (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+ --       FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
+ 
+ -- RJW 2/3/86
+ -- TMB 11/15/95 FIXED INCOMPATIBILITIES WITH ADA95
+ -- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95086F IS
+ 
+ BEGIN
+      TEST ("C95086F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "BEFORE OR AFTER THE ENTRY CALL FOR OUT ARRAY PARAMETERS, " &
+            "WITH THE ACTUAL HAVING THE FORM OF A TYPE CONVERSION");
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (A)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..5;
+           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+                OF BOOLEAN;
+           SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
+           SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
+           AR : ACTUAL;
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : OUT FORMAL) DO
+                     CALLED := TRUE;
+                     X := (1..3 => (1..3 => TRUE));
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (A)");
+           END T;
+ 
+      BEGIN -- (A)
+ 
+           T.E (FORMAL (AR));
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (A)");
+      END; -- (A)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (B)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..3;
+           TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
+           TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
+           AR : ACTUAL;
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : OUT FORMAL) DO
+                     CALLED := TRUE;
+                     X(3, 3) := TRUE;
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (B)");
+           END T;
+ 
+      BEGIN -- (B)
+ 
+           T.E (FORMAL (AR));
+           IF AR(5, 5) /= TRUE THEN
+                FAILED ("INCORRECT RETURNED VALUE - (B)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (B)");
+      END; -- (B)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (C)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..5;
+           TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+                OF CHARACTER;
+           SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
+           AR : ARRAY_TYPE (2..1, 1..3);
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : OUT FORMAL) DO
+                     IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
+                          FAILED ("WRONG BOUNDS PASSED - (C)");
+                     END IF;
+                     CALLED := TRUE;
+                     X := (2..0 => (1..3 => 'A'));
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (C)");
+           END T;
+ 
+      BEGIN -- (C)
+ 
+           T.E (FORMAL (AR));
+           IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
+                FAILED ("BOUNDS CHANGED - (C)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (C)");
+      END; -- (C)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (D)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..3;
+           TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
+                OF CHARACTER;
+           TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
+           AR : ACTUAL;
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : OUT FORMAL) DO
+                     IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
+                          FAILED ("WRONG BOUNDS PASSED - (D)");
+                     END IF;
+                     CALLED := TRUE;
+                     X := (1..3 => (3..1 => 'A'));
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (D)");
+           END T;
+ 
+      BEGIN -- (D)
+ 
+           T.E (FORMAL (AR));
+           IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
+                FAILED ("BOUNDS CHANGED - (D)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (D)");
+      END; -- (D)
+ 
+      ---------------------------------------------
+ 
+      DECLARE -- (E)
+ 
+           SUBTYPE INDEX IS INTEGER RANGE 1..3;
+           TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+                OF CHARACTER;
+           TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
+                                 POSITIVE RANGE 1..3) OF CHARACTER;
+           AR : ACTUAL;
+           CALLED : BOOLEAN := FALSE;
+ 
+           TASK T IS
+                ENTRY E (X : OUT FORMAL);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (X : OUT FORMAL) DO
+                     IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
+                          FAILED ("WRONG BOUNDS PASSED - (E)");
+                     END IF;
+                     CALLED := TRUE;
+                     X := (3..1 => (1..3 => ' ' ));
+                END E;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK - (E)");
+           END T;
+ 
+      BEGIN -- (E)
+ 
+           T.E (FORMAL (AR));
+           IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
+                FAILED ("BOUNDS CHANGED - (E)");
+           END IF;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                IF NOT CALLED THEN
+                     FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
+                ELSE
+                     FAILED ("EXCEPTION RAISED ON RETURN - (E)");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (E)");
+      END; -- (E)
+ 
+      ---------------------------------------------
+ 
+      RESULT;
+ END C95086F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,412 ----
+ -- C95087A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
+ --   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
+ --   SUBTESTS ARE:
+ --        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
+ --        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
+ --        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
+ --        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
+ 
+ -- GLH  7/19/85
+ -- JRK 8/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95087A IS
+ 
+ BEGIN
+      TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
+                       "UNCONSTRAINED FORMAL PARAMETERS");
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+               SUBTYPE INT IS INTEGER RANGE 0..100;
+ 
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     RECORD
+                          INTFIELD : INTEGER;
+                          STRFIELD : STRING (1..CONSTRAINT);
+                     END RECORD;
+ 
+                REC1 : RECTYPE := (10,10,"0123456789");
+                REC2 : RECTYPE := (17,7,"C95087A..........");
+                REC3 : RECTYPE := (1,1,"A");
+                REC4 : RECTYPE;  -- 80.
+ 
+                TASK T1 IS
+                     ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB");
+                               REC2 : OUT RECTYPE;
+                               REC3 : IN OUT RECTYPE);
+                END T1;
+ 
+                TASK T2 IS
+                     ENTRY E2 (REC : OUT RECTYPE);
+                END T2;
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T1 IS
+                BEGIN
+                     ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB");
+                                REC2 : OUT RECTYPE;
+                                REC3 : IN OUT RECTYPE) DO
+ 
+                          IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
+                               FAILED ("RECORD TYPE IN PARAMETER " &
+                                       "DID NOT USE CONSTRAINT " &
+                                       "OF ACTUAL");
+                          END IF;
+                          IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
+                               FAILED ("RECORD TYPE OUT " &
+                                       "PARAMETER DID NOT USE " &
+                                       "CONSTRAINT OF ACTUAL");
+                          END IF;
+                          IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
+                               FAILED ("RECORD TYPE IN OUT " &
+                                       "PARAMETER DID NOT USE " &
+                                       "CONSTRAINT OF ACTUAL");
+                          END IF;
+                          REC2 := PKG.REC2;
+                     END E1;
+                END T1;
+ 
+                TASK BODY T2 IS
+                BEGIN
+                     ACCEPT E2 (REC : OUT RECTYPE) DO
+                          IF REC.CONSTRAINT /= IDENT_INT (80) THEN
+                               FAILED ("RECORD TYPE OUT " &
+                                       "PARAMETER DID " &
+                                       "NOT USE CONSTRAINT OF " &
+                                       "UNINITIALIZED ACTUAL");
+                          END IF;
+                          REC := (10,10,"9876543210");
+                     END E2;
+                END T2;
+           END PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3);
+           PKG.T2.E2 (PKG.REC4);
+ 
+      END;   -- (A)
+ 
+      ---------------------------------------------
+ 
+ B :  DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INT IS INTEGER RANGE 0..100;
+ 
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
+ 
+ 
+                TASK T1 IS
+                     ENTRY E1 (REC1 : IN RECTYPE;
+                               REC2 : OUT RECTYPE;
+                               REC3 : IN OUT RECTYPE);
+                END T1;
+ 
+                TASK T2 IS
+                     ENTRY E2  (REC : OUT RECTYPE);
+                END T2;
+ 
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     RECORD
+                          INTFIELD : INTEGER;
+                          STRFIELD : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC1 : PKG.RECTYPE (10);
+           REC2 : PKG.RECTYPE (17);
+           REC3 : PKG.RECTYPE (1);
+           REC4 : PKG.RECTYPE (10);
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T1 IS
+                BEGIN
+                     ACCEPT E1 (REC1 : IN RECTYPE;
+                                REC2 : OUT RECTYPE;
+                                REC3 : IN OUT RECTYPE) DO
+                          IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
+                               FAILED ("PRIVATE TYPE IN " &
+                                       "PARAMETER DID " &
+                                       "NOT USE CONSTRAINT OF " &
+                                       "ACTUAL");
+                          END IF;
+                          IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
+                               FAILED ("PRIVATE TYPE OUT " &
+                                       "PARAMETER DID " &
+                                       "NOT USE CONSTRAINT OF " &
+                                       "ACTUAL");
+                          END IF;
+                          IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
+                               FAILED ("PRIVATE TYPE IN OUT " &
+                                       "PARAMETER DID " &
+                                       "NOT USE CONSTRAINT OF " &
+                                       "ACTUAL");
+                          END IF;
+                          REC2 := B.REC2;
+                     END E1;
+                END T1;
+ 
+                TASK BODY T2 IS
+                BEGIN
+                     ACCEPT E2 (REC : OUT RECTYPE) DO
+                          IF REC.CONSTRAINT /= IDENT_INT (10) THEN
+                               FAILED ("PRIVATE TYPE OUT " &
+                                       "PARAMETER DID " &
+                                       "NOT USE CONSTRAINT OF " &
+                                       "UNINITIALIZED ACTUAL");
+                          END IF;
+                          REC := (10,10,"9876543210");
+                     END E2;
+                END T2;
+ 
+           BEGIN
+                REC1 := (10,10,"0123456789");
+                REC2 := (17,7,"C95087A..........");
+                REC3 := (1,1,"A");
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.T1.E1 (REC1, REC2, REC3);
+           PKG.T2.E2 (REC4);
+ 
+      END B;  -- (B)
+ 
+      ---------------------------------------------
+ 
+ C :  DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INT IS INTEGER RANGE 0..100;
+ 
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     LIMITED PRIVATE;
+ 
+                TASK T1 IS
+                     ENTRY E1 (REC1 : IN RECTYPE;
+                               REC2 : OUT RECTYPE;
+                               REC3 : IN OUT RECTYPE);
+                END T1;
+ 
+                TASK T2 IS
+                     ENTRY E2 (REC : OUT RECTYPE);
+                END T2;
+ 
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                     RECORD
+                          INTFIELD : INTEGER;
+                          STRFIELD : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC1 : PKG.RECTYPE;     -- 10.
+           REC2 : PKG.RECTYPE;     -- 17.
+           REC3 : PKG.RECTYPE;     --  1.
+           REC4 : PKG.RECTYPE;     -- 80.
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T1 IS
+                BEGIN
+                     ACCEPT E1 (REC1 : IN RECTYPE;
+                                REC2 : OUT RECTYPE;
+                                REC3 : IN OUT RECTYPE) DO
+                          IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
+                               FAILED ("LIMITED PRIVATE TYPE IN " &
+                                       "PARAMETER DID NOT USE " &
+                                       "CONSTRAINT OF ACTUAL");
+                          END IF;
+                          IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
+                               FAILED ("LIMITED PRIVATE TYPE OUT " &
+                                       "PARAMETER DID NOT USE " &
+                                       "CONSTRAINT OF " &
+                                       "ACTUAL");
+                          END IF;
+                          IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
+                               FAILED ("LIMITED PRIVATE TYPE IN " &
+                                       "OUT PARAMETER DID NOT " &
+                                       "USE CONSTRAINT OF ACTUAL");
+                          END IF;
+                          REC2 := C.REC2;
+                     END E1;
+                END T1;
+ 
+                TASK BODY T2 IS
+                BEGIN
+                     ACCEPT E2 (REC : OUT RECTYPE) DO
+                          IF REC.CONSTRAINT /= IDENT_INT (80) THEN
+                               FAILED ("LIMITED PRIVATE TYPE OUT " &
+                                       "PARAMETER DID NOT USE " &
+                                       "CONSTRAINT OF UNINITIALIZED " &
+                                       "ACTUAL");
+                          END IF;
+                          REC := (10,10,"9876543210");
+                     END E2;
+                END T2;
+ 
+           BEGIN
+                REC1 := (10,10,"0123456789");
+                REC2 := (17,7,"C95087A..........");
+                REC3 := (1,1,"A");
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.T1.E1 (REC1, REC2, REC3);
+           PKG.T2.E2 (REC4);
+ 
+      END C;   -- (C)
+ 
+      ---------------------------------------------
+ 
+ D :  DECLARE  -- (D)
+ 
+           TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
+                CHARACTER;
+ 
+           A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'),
+                                                ('C','D'),
+                                                ('E','F'));
+ 
+           A4  : ATYPE (-1..1, 4..5);
+ 
+           CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) :=
+                                (8..9 => (-7..INTEGER'FIRST => 'A'));
+ 
+           S1  : STRING (1..INTEGER'FIRST) := "";
+           S2  : STRING (-5..-7)           := "";
+           S3  : STRING (1..0)             := "";
+ 
+           TASK T1 IS
+                ENTRY E1 (A1 : IN ATYPE := CA1;
+                          A2 : OUT ATYPE;
+                          A3 : IN OUT ATYPE);
+           END T1;
+ 
+           TASK T2 IS
+                ENTRY E2 (A4 : OUT ATYPE);
+           END T2;
+ 
+           TASK T3 IS
+                ENTRY E3 (S1 : IN STRING;
+                          S2 : IN OUT STRING;
+                          S3 : OUT STRING);
+           END T3;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
+                           A3 : IN OUT ATYPE) DO
+                     IF A1'FIRST(1) /= IDENT_INT (-1) OR
+                        A1'LAST(1)  /= IDENT_INT (1)  OR
+                        A1'FIRST(2) /= IDENT_INT (4)  OR
+                        A1'LAST(2)  /= IDENT_INT (5)  THEN
+                          FAILED ("ARRAY TYPE IN PARAMETER DID " &
+                                  "NOT USE CONSTRAINTS OF ACTUAL");
+                     END IF;
+                     IF A2'FIRST(1) /= IDENT_INT (-1) OR
+                        A2'LAST(1)  /= IDENT_INT (1)  OR
+                        A2'FIRST(2) /= IDENT_INT (4)  OR
+                        A2'LAST(2)  /= IDENT_INT (5)  THEN
+                          FAILED ("ARRAY TYPE OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINTS OF ACTUAL");
+                     END IF;
+                     IF A3'FIRST(1) /= IDENT_INT (-1) OR
+                        A3'LAST(1)  /= IDENT_INT (1)  OR
+                        A3'FIRST(2) /= IDENT_INT (4)  OR
+                        A3'LAST(2)  /= IDENT_INT (5)  THEN
+                          FAILED ("ARRAY TYPE IN OUT PARAMETER " &
+                                  "DID NOT USE CONSTRAINTS OF " &
+                                  "ACTUAL");
+                     END IF;
+                     A2 := D.A2;
+                END E1;
+           END T1;
+ 
+           TASK BODY T2 IS
+           BEGIN
+                ACCEPT E2 (A4 : OUT ATYPE) DO
+                     IF A4'FIRST(1) /= IDENT_INT (-1) OR
+                        A4'LAST(1)  /= IDENT_INT (1)  OR
+                        A4'FIRST(2) /= IDENT_INT (4)  OR
+                        A4'LAST(2)  /= IDENT_INT (5)  THEN
+                          FAILED ("ARRAY TYPE OUT PARAMETER DID " &
+                                  "NOT USE CONSTRAINTS OF " &
+                                  "UNINITIALIZED ACTUAL");
+                     END IF;
+                     A4 := A2;
+                END E2;
+           END T2;
+ 
+           TASK BODY T3 IS
+           BEGIN
+                ACCEPT E3 (S1 : IN STRING;
+                           S2 : IN OUT STRING;
+                           S3 : OUT STRING) DO
+                     IF S1'FIRST /= IDENT_INT (1) OR
+                        S1'LAST  /= IDENT_INT (INTEGER'FIRST) THEN
+                          FAILED ("STRING TYPE IN PARAMETER DID " &
+                                  "NOT USE CONSTRAINTS OF ACTUAL " &
+                                  "NULL STRING");
+                     END IF;
+                     IF S2'FIRST /= IDENT_INT (-5) OR
+                        S2'LAST  /= IDENT_INT (-7) THEN
+                          FAILED ("STRING TYPE IN OUT PARAMETER " &
+                                  "DID NOT USE CONSTRAINTS OF " &
+                                  "ACTUAL NULL STRING");
+                     END IF;
+                     IF S3'FIRST /= IDENT_INT (1) OR
+                        S3'LAST  /= IDENT_INT (0) THEN
+                          FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
+                                  "USE CONSTRAINTS OF ACTUAL NULL " &
+                                  "STRING");
+                     END IF;
+                     S3 := "";
+                END E3;
+           END T3;
+ 
+      BEGIN  -- (D)
+ 
+           T1.E1 (A1, A2, A3);
+           T2.E2 (A4);
+           T3.E3 (S1, S2, S3);
+ 
+      END D;  -- (D)
+ 
+      RESULT;
+ END C95087A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,267 ----
+ -- C95087B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
+ --   RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT
+ --   CONSTRAINTS RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE
+ --   THE CONSTRAINT OF THE ACTUAL PARAMETER.
+ --   SUBTESTS ARE:
+ --        (A) RECORD TYPE.
+ --        (B) PRIVATE TYPE.
+ --        (C) LIMITED PRIVATE TYPE.
+ 
+ -- RJW  1/10/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95087B IS
+ 
+ BEGIN
+ 
+      TEST ( "C95087B", "CHECK ASSIGNMENT TO ENTRY FORMAL PARAMETERS " &
+                        "OF UNCONSTRAINED TYPE (WITH NO DEFAULT)" );
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+ 
+                TASK T IS
+                     ENTRY E (REC9 : OUT RECTYPE;
+                              REC6 : IN OUT RECTYPE);
+                END T;
+ 
+           END PKG;
+ 
+           REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
+                  (IDENT_INT(9), 9, "123456789");
+           REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
+                  (IDENT_INT(6), 5, "AEIOUY");
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+ 
+                     REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
+                            (IDENT_INT(4), 4, "OOPS");
+ 
+                BEGIN
+                     ACCEPT E (REC9 : OUT RECTYPE;
+                               REC6 : IN OUT RECTYPE) DO
+ 
+                          BEGIN  -- (A.1)
+                               REC9 := REC6;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                       "- A.1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED " &
+                                            "- A.1");
+                          END;   -- (A.1)
+ 
+                          BEGIN  -- (A.2)
+                               REC6 := REC4;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                       "- A.2");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED " &
+                                            "- A.2");
+                          END;   -- (A.2)
+ 
+                          REC9 := (IDENT_INT(9), 9, "987654321");
+ 
+                     END E;
+                END T;
+           END PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.T.E (REC9, REC6);
+ 
+           IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
+                FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
+           END IF;
+ 
+      END;   -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
+ 
+                TASK T IS
+                     ENTRY  E (REC9 : OUT RECTYPE;
+                               REC6 : IN OUT RECTYPE);
+                END T;
+ 
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC9 : PKG.RECTYPE(9);
+           REC6 : PKG.RECTYPE(6);
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+ 
+                     REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
+ 
+                BEGIN
+                     ACCEPT E (REC9 : OUT RECTYPE;
+                               REC6 : IN OUT RECTYPE) DO
+ 
+                          BEGIN  -- (B.1)
+                               REC9 := REC6;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                       "- B.1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED " &
+                                            "- B.1");
+                          END;   -- (B.1)
+ 
+                          BEGIN  -- (B.2)
+                               REC6 := REC4;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                       "- B.2");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED " &
+                                            "- B.2");
+                          END;   -- (B.2)
+ 
+                     END E;
+                END T;
+ 
+           BEGIN
+                REC9 := (9, 9, "123456789");
+                REC6 := (6, 5, "AEIOUY");
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.T.E (REC9, REC6);
+ 
+      END;   -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
+ 
+                TASK T IS
+                     ENTRY  E (REC9 : OUT RECTYPE;
+                               REC6 : IN OUT RECTYPE);
+                END T;
+ 
+           PRIVATE
+                TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                     RECORD
+                          INTFIELD  : INTEGER;
+                          STRFIELD  : STRING (1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC6 : PKG.RECTYPE(IDENT_INT(6));
+           REC9 : PKG.RECTYPE(IDENT_INT(9));
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+ 
+                     REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
+ 
+                BEGIN
+                     ACCEPT E (REC9 : OUT RECTYPE;
+                               REC6 : IN OUT RECTYPE) DO
+ 
+                          BEGIN  -- (C.1)
+                               REC9 := REC6;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                       "- C.1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED " &
+                                            "- C.1");
+                          END;   -- (C.1)
+ 
+                          BEGIN  -- (C.2)
+                               REC6 := REC4;
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                       "- C.2");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ("WRONG EXCEPTION RAISED " &
+                                            "- C.2");
+                          END;   -- (C.2)
+ 
+                     END E;
+                END T;
+ 
+           BEGIN
+                REC6 := (6, 5, "AEIOUY");
+                REC9 := (9, 9, "123456789");
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.T.E (REC9, REC6);
+ 
+      END;   -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C95087B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,299 ----
+ -- C95087C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
+ --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+ --    CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS
+ --    CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING
+ --    ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER.
+ 
+ --    SUBTESTS ARE:
+ --        (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+ --        (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+ --        (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+ 
+ -- RJW  1/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95087C IS
+ 
+ BEGIN
+ 
+      TEST ( "C95087C", "CHECK ASSIGNMENTS TO ENTRY FORMAL " &
+                        "PARAMETERS OF UNCONSTRAINED TYPES " &
+                        "(WITH DEFAULTS)" );
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+ 
+                REC91,REC92,REC93  : RECTYPE(9);
+                REC_OOPS           : RECTYPE(4);
+ 
+                TASK T IS
+                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE);
+                END T;
+ 
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+                BEGIN
+                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                               REC3 : OUT RECTYPE) DO
+ 
+                          IF (NOT REC1'CONSTRAINED) OR
+                             (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
+                               FAILED ( "CONSTRAINT ON RECORD TYPE " &
+                                        "IN PARAMETER NOT RECOGNIZED" );
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                               REC2 := REC_OOPS;
+                               FAILED ( "CONSTRAINT_ERROR NOT " &
+                                        "RAISED - A.1" );
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "WRONG EXCEPTION " &
+                                             "RAISED - A.1" );
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                               REC3 := REC_OOPS;
+                               FAILED ( "CONSTRAINT_ERROR NOT " &
+                                        "RAISED - A.2" );
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "WRONG EXCEPTION " &
+                                             "RAISED - A.2" );
+                          END;
+ 
+                     END E;
+                END T;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.T.E (PKG.REC91, PKG.REC92, PKG.REC93);
+ 
+      END;   -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+ 
+                TASK T IS
+                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE);
+                END T;
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91, REC92, REC93  : PKG.RECTYPE(9);
+           REC_OOPS             : PKG.RECTYPE(4);
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+                BEGIN
+                      ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                                REC3 : OUT RECTYPE) DO
+ 
+                          IF (NOT REC1'CONSTRAINED) OR
+                             (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
+                               FAILED ( "CONSTRAINT ON PRIVATE TYPE " &
+                                        "IN PARAMETER NOT RECOGNIZED" );
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                               REC2 := REC_OOPS;
+                               FAILED ( "CONSTRAINT_ERROR NOT " &
+                                        "RAISED - B.1" );
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "WRONG EXCEPTION " &
+                                             "RAISED - B.1" );
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                               REC3 := REC_OOPS;
+                               FAILED ( "CONSTRAINT_ERROR NOT " &
+                                        "RAISED - B.2" );
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "WRONG EXCEPTION " &
+                                             "RAISED - B.2" );
+                          END;
+ 
+                     END E;
+               END T;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.T.E (REC91, REC92, REC93);
+ 
+      END;   -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     LIMITED PRIVATE;
+ 
+                TASK T IS
+                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE);
+                END T;
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91,REC92,REC93  : PKG.RECTYPE(9);
+           REC_OOPS           : PKG.RECTYPE(4);
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+                BEGIN
+                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                               REC3 : OUT RECTYPE) DO
+ 
+                          IF (NOT REC1'CONSTRAINED) OR
+                             (REC1.CONSTRAINT /= 9) THEN
+                               FAILED ( "CONSTRAINT ON LIMITED " &
+                                        "PRIVATE TYPE IN PARAMETER " &
+                                        "NOT RECOGNIZED" );
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                               REC2 := REC_OOPS;
+                               FAILED ( "CONSTRAINT_ERROR NOT " &
+                                        "RAISED - C.1" );
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "WRONG EXCEPTION " &
+                                             "RAISED - C.1" );
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                               REC3 := REC_OOPS;
+                               FAILED ( "CONSTRAINT_ERROR NOT RAISED " &
+                                        "- C.2" );
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR =>
+                                    NULL;
+                               WHEN OTHERS =>
+                                    FAILED ( "WRONG EXCEPTION " &
+                                             "RAISED - C.2" );
+                          END;
+ 
+                     END E;
+                END T;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.T.E (REC91, REC92, REC93);
+ 
+      END;   -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C95087C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95087d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95087d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,268 ----
+ -- C95087D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
+ --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+ --    CONSTRAINTS DO NOT RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER
+ --    IS UNCONSTRAINED, EVEN IF THE CONSTRAINT VALUES OF THE OBJECT
+ --    BEING ASSIGNED ARE DIFFERENT THAN THOSE OF THE ACTUAL PARAMETER.
+ 
+ --    SUBTESTS ARE:
+ --        (A) UNCONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+ --        (B) UNCONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+ --        (C) UNCONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+ 
+ -- RJW  1/17/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95087D IS
+ 
+ BEGIN
+ 
+      TEST ( "C95087D", "CHECK ASSIGNMENTS TO ENTRY FORMAL PARAMETERS " &
+                        "OF UNCONSTRAINED TYPES WITH UNCONSTRAINED " &
+                        "ACTUAL PARAMETERS");
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (A)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+ 
+                TASK T IS
+                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE);
+                END T;
+ 
+           END PKG;
+ 
+           REC91, REC92, REC93 : PKG.RECTYPE :=
+                (IDENT_INT(5), 5, IDENT_STR( "12345"));
+           REC_OOPS            : PKG.RECTYPE;
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+                BEGIN
+                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                               REC3 : OUT RECTYPE) DO
+ 
+                          IF NOT REC1'CONSTRAINED THEN
+                               FAILED ( "REC1 IS NOT CONSTRAINED - A.1");
+                          END IF;
+                          IF REC1.CONSTRAINT /= IDENT_INT(9) THEN
+                               FAILED ( "REC1 CONSTRAINT IS NOT 9 " &
+                                  "- A.1");
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                               REC2 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ( "EXCEPTION RAISED - A.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                               REC3 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ( "EXCEPTION RAISED - A.2");
+                          END;
+ 
+                     END E;
+                END T;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+           USE PKG;
+ 
+      BEGIN  -- (A)
+ 
+           PKG.T.E  (REC91, REC92, REC93);
+           IF (REC92 /= REC_OOPS) OR (REC93 /= REC_OOPS) THEN
+                FAILED ( "RESULTANT VALUE OF REC92 OR REC93 INCORRECT");
+           END IF;
+ 
+      END;   -- (A)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (B)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+ 
+                TASK T IS
+                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE);
+                END T;
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91, REC92, REC93  : PKG.RECTYPE;
+           REC_OOPS             : PKG.RECTYPE;
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+                BEGIN
+                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                               REC3 : OUT RECTYPE) DO
+ 
+                          IF REC3'CONSTRAINED THEN
+                               FAILED ( "REC3 IS CONSTRAINED - B.1");
+                          END IF;
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                               REC2 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ( "EXCEPTION RAISED - B.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                               REC3 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ( "EXCEPTION RAISED - B.2");
+                          END;
+ 
+                     END E;
+                END T;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (B)
+ 
+           PKG.T.E (REC91, REC92, REC93);
+ 
+      END;   -- (B)
+ 
+      --------------------------------------------------
+ 
+      DECLARE  -- (C)
+ 
+           PACKAGE PKG IS
+ 
+                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     LIMITED PRIVATE;
+ 
+                TASK T IS
+                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE);
+                END T;
+ 
+           PRIVATE
+ 
+                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                     RECORD
+                          INTFLD   : INTRANGE;
+                          STRFLD   : STRING(1..CONSTRAINT);
+                     END RECORD;
+           END PKG;
+ 
+           REC91, REC92, REC93  : PKG.RECTYPE;
+           REC_OOPS             : PKG.RECTYPE;
+ 
+           PACKAGE BODY PKG IS
+ 
+                TASK BODY T IS
+                BEGIN
+                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                               REC3 : OUT RECTYPE) DO
+ 
+                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                               REC2 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ( "EXCEPTION RAISED - C.1");
+                          END;
+ 
+                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                               REC3 := REC_OOPS;
+                          EXCEPTION
+                               WHEN OTHERS =>
+                                    FAILED ( "EXCEPTION RAISED - C.2");
+                          END;
+ 
+                     END E;
+                END T;
+ 
+           BEGIN
+ 
+                REC91 := (9, 9, "123456789");
+                REC92 := REC91;
+                REC93 := REC91;
+ 
+                REC_OOPS := (4, 4, "OOPS");
+ 
+           END PKG;
+ 
+      BEGIN  -- (C)
+ 
+           PKG.T.E (REC91, REC92, REC93);
+ 
+      END;   -- (C)
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C95087D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95088a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95088a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95088a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95088a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- C95088A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ACTUAL PARAMETERS ARE EVALUATED AND IDENTIFIED AT THE
+ --   TIME OF CALL.
+ 
+ -- GLH 7/10/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C95088A IS
+ 
+      TYPE VECTOR IS ARRAY (1..10) OF INTEGER;
+      TYPE PTRINT IS ACCESS INTEGER;
+ 
+      I    : INTEGER := 1;
+      A    : VECTOR  := (1,2,3,4,5,6,7,8,9,10);
+      P1   : PTRINT  := NEW INTEGER'(2);
+      P2   : PTRINT  := P1;
+ 
+      TASK T1 IS
+           ENTRY E1 (I : OUT INTEGER; J : OUT INTEGER);
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           ACCEPT E1 (I : OUT INTEGER; J : OUT INTEGER) DO
+                I := 10;
+                J := -1;
+           END E1;
+      END T1;
+ 
+      TASK T2 IS
+           ENTRY E2 (P : OUT PTRINT; I : OUT INTEGER);
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           ACCEPT E2 (P : OUT PTRINT; I : OUT INTEGER) DO
+                P := NEW INTEGER'(3);
+                I := 5;
+           END E2;
+      END T2;
+ 
+ BEGIN
+ 
+      TEST ("C95088A", "CHECK THAT ACTUAL PARAMETERS ARE EVALUATED " &
+                       "AND IDENTIFIED AT THE TIME OF CALL");
+ 
+      COMMENT ("FIRST CALL");
+      T1.E1 (I, A(I));
+      IF (A /= (-1,2,3,4,5,6,7,8,9,10)) THEN
+           FAILED ("A(I) EVALUATED UPON RETURN");
+      END IF;
+ 
+      COMMENT ("SECOND CALL");
+      T2.E2 (P1, P1.ALL);
+      IF (P2.ALL /= 5) THEN
+           FAILED ("P1.ALL EVALUATED UPON RETURN");
+      END IF;
+ 
+      RESULT;
+ 
+ END C95088A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95089a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95089a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95089a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95089a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,175 ----
+ -- C95089A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL PERMITTED FORMS OF VARIABLE NAMES ARE PERMITTED
+ -- AS ACTUAL PARAMETERS.
+ 
+ -- GLH 7/25/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95089A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1..3;
+ 
+      TYPE REC (N : INT) IS
+           RECORD
+                S : STRING (1..N);
+           END RECORD;
+ 
+      TYPE PTRSTR IS ACCESS STRING;
+ 
+      R1, R2, R3 : REC (3);
+      S1, S2, S3 : STRING (1..3);
+      PTRTBL     : ARRAY (1..3) OF PTRSTR;
+ 
+      TASK T1 IS
+           ENTRY E1 (S1 : IN STRING; S2: IN OUT STRING;
+                     S3 : OUT STRING);
+      END T1;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E1 (S1 : IN STRING; S2: IN OUT STRING;
+                                S3 : OUT STRING) DO
+                          S3 := S2;
+                          S2 := S1;
+                     END E1;
+                OR
+                     TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T1;
+ 
+      TASK T2 IS
+           ENTRY E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
+                     C3 : OUT CHARACTER);
+      END T2;
+ 
+      TASK BODY T2 IS
+      BEGIN
+           LOOP
+                SELECT
+                     ACCEPT E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
+                                C3 : OUT CHARACTER) DO
+                          C3 := C2;
+                          C2 := C1;
+                     END E2;
+                OR
+                     TERMINATE;
+                END SELECT;
+           END LOOP;
+      END T2;
+ 
+      FUNCTION F1 (X : INT) RETURN PTRSTR IS
+      BEGIN
+           RETURN PTRTBL (X);
+      END F1;
+ 
+      FUNCTION "+" (S1, S2 : STRING) RETURN PTRSTR IS
+      BEGIN
+           RETURN PTRTBL (CHARACTER'POS(S1(1))-CHARACTER'POS('A')+1);
+      END "+";
+ 
+ BEGIN
+ 
+      TEST ("C95089A", "CHECK THAT ALL PERMITTED FORMS OF VARIABLE " &
+                       "NAMES ARE PERMITTED AS ACTUAL PARAMETERS");
+ 
+      S1 := "AAA";
+      S2 := "BBB";
+      T1.E1 (S1, S2, S3);
+      IF S2 /= "AAA" OR S3 /= "BBB" THEN
+           FAILED ("SIMPLE VARIABLE AS AN ACTUAL PARAMETER NOT WORKING");
+      END IF;
+ 
+      S1 := "AAA";
+      S2 := "BBB";
+      S3 := IDENT_STR ("CCC");
+      T2.E2 (S1(1), S2(IDENT_INT(1)), S3(1));
+      IF S2 /= "ABB" OR S3 /= "BCC" THEN
+           FAILED ("INDEXED COMPONENT AS AN ACTUAL PARAMETER NOT " &
+                   "WORKING");
+      END IF;
+ 
+      R1.S := "AAA";
+      R2.S := "BBB";
+      T1.E1 (R1.S, R2.S, R3.S);
+      IF R2.S /= "AAA" OR R3.S /= "BBB" THEN
+           FAILED ("SELECTED COMPONENT AS AN ACTUAL PARAMETER " &
+                   "NOT WORKING");
+      END IF;
+ 
+      S1 := "AAA";
+      S2 := "BBB";
+      T1.E1 (S1(1..IDENT_INT(2)), S2(1..2),
+             S3(IDENT_INT(1)..IDENT_INT(2)));
+      IF S2 /= "AAB" OR S3 /= "BBC" THEN
+           FAILED ("SLICE AS AN ACTUAL PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      T1.E1 (F1(1).ALL, F1(2).ALL, F1(IDENT_INT(3)).ALL);
+      IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN
+           FAILED ("SELECTED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " &
+                   "PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      S1 := IDENT_STR("AAA");
+      S2 := IDENT_STR("BBB");
+      S3 := IDENT_STR("CCC");
+      T1.E1 ("+"(S1,S1).ALL, "+"(S2,S2).ALL, "+"(S3,S3).ALL);
+      IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN
+           FAILED ("SELECTED COMPONENT OF OVERLOADED OPERATOR " &
+                   "FUNCTION VALUE AS AN ACTUAL PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      T2.E2 (F1(1)(1), F1(IDENT_INT(2))(1), F1(3)(IDENT_INT(1)));
+      IF PTRTBL(2).ALL /= "ABB" OR PTRTBL(3).ALL /= "BCC" THEN
+           FAILED ("INDEXED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " &
+                   "PARAMETER NOT WORKING");
+      END IF;
+ 
+      PTRTBL(1) := NEW STRING'("AAA");
+      PTRTBL(2) := NEW STRING'("BBB");
+      PTRTBL(3) := NEW STRING'("CCC");
+      T1.E1 (F1(1)(2..3), F1(2)(IDENT_INT(2)..3),
+             F1(3)(2..IDENT_INT(3)));
+      IF PTRTBL(2).ALL /= "BAA" OR PTRTBL(3).ALL /= "CBB" THEN
+           FAILED ("SLICE OF FUNCTION VALUE AS AN ACTUAL PARAMETER " &
+                   "NOT WORKING");
+      END IF;
+ 
+      RESULT;
+ 
+ END C95089A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95090a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95090a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95090a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95090a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C95090A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+ -- TO ENTRIES.  SPECIFICALLY,
+ --   (A) CHECK ALL PARAMETER MODES.
+ 
+ -- GLH 7/25/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95090A IS
+ 
+ BEGIN
+      TEST ("C95090A", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+                       "RECORDS ARE PASSED CORRECTLY TO ENTRIES");
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (A)
+ 
+           TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE (1..IDENT_INT(5));
+ 
+           TYPE RECORD_TYPE IS
+                RECORD
+                     I : INTEGER;
+                     A : ARRAY_SUBTYPE;
+                END RECORD;
+ 
+           REC : RECORD_TYPE := (I => 23,
+                                 A => (1..3 => IDENT_INT(7), 4..5 => 9));
+           BOOL : BOOLEAN;
+ 
+           TASK T1 IS
+                ENTRY E1 (ARR : ARRAY_TYPE);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E1 (ARR : ARRAY_TYPE) DO
+                     IF ARR /= (7, 7, 7, 9, 9) THEN
+                          FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
+                     END IF;
+                     IF ARR'FIRST /= IDENT_INT (1) OR
+                        ARR'LAST /= IDENT_INT (5) THEN
+                          FAILED ("WRONG BOUNDS FOR IN PARAMETER");
+                     END IF;
+                END E1;
+           END T1;
+ 
+           TASK T2 IS
+                ENTRY E2 (ARR : IN OUT ARRAY_TYPE);
+           END T2;
+ 
+           TASK BODY T2 IS
+           BEGIN
+                ACCEPT E2 (ARR : IN OUT ARRAY_TYPE) DO
+                     IF ARR /= (7, 7, 7, 9, 9) THEN
+                          FAILED ("IN OUT PARAMETER NOT PASSED " &
+                                  "CORRECTLY");
+                     END IF;
+                     IF ARR'FIRST /= IDENT_INT (1) OR
+                        ARR'LAST /= IDENT_INT (5) THEN
+                          FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
+                     END IF;
+                     ARR := (ARR'RANGE => 5);
+                END E2;
+           END T2;
+ 
+           TASK T3 IS
+                ENTRY E3 (ARR : OUT ARRAY_TYPE);
+           END T3;
+ 
+           TASK BODY T3 IS
+           BEGIN
+                ACCEPT E3 (ARR : OUT ARRAY_TYPE) DO
+                     IF ARR'FIRST /= IDENT_INT (1) OR
+                        ARR'LAST /= IDENT_INT (5) THEN
+                          FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
+                     END IF;
+                     ARR := (ARR'RANGE => 3);
+                END E3;
+           END T3;
+ 
+      BEGIN     -- (A)
+ 
+           T1.E1 (REC.A);
+           IF REC.A /= (7, 7, 7, 9, 9) THEN
+                FAILED ("IN PARAM CHANGED BY PROCEDURE");
+           END IF;
+ 
+           T2.E2 (REC.A);
+           IF REC.A /= (5, 5, 5, 5, 5) THEN
+                FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+           END IF;
+ 
+           T3.E3 (REC.A);
+           IF REC.A /= (3, 3, 3, 3, 3) THEN
+                FAILED ("OUT PARAM RETURNED INCORRECTLY");
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------
+ 
+      RESULT;
+ END C95090A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95092a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95092a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95092a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95092a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,193 ----
+ -- C95092A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR ENTRIES OF TASKS, DEFAULT VALUES OF ALL TYPES CAN
+ --     BE GIVEN FOR A FORMAL PARAMETER.
+ 
+ -- HISTORY:
+ --     DHH 03/22/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95092A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 ..10;
+      TYPE FLT IS DIGITS 5;
+      TYPE FIX IS DELTA 0.125 RANGE 0.0 .. 10.0;
+      TYPE ENUM IS (RED, BLUE, YELLOW);
+      SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'F';
+      TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
+      TYPE REC IS
+           RECORD
+                A : INT;
+                B : ENUM;
+                C : CHAR;
+           END RECORD;
+ 
+      FUNCTION IDENT_FLT(E : FLT) RETURN FLT IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN E;
+           ELSE
+                RETURN 0.0;
+           END IF;
+      END IDENT_FLT;
+ 
+      FUNCTION IDENT_FIX(E : FIX) RETURN FIX IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN E;
+           ELSE
+                RETURN 0.0;
+           END IF;
+      END IDENT_FIX;
+ 
+      FUNCTION IDENT_ENUM(E : ENUM) RETURN ENUM IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN E;
+           ELSE
+                RETURN YELLOW;
+           END IF;
+      END IDENT_ENUM;
+ 
+      FUNCTION IDENT_CHAR(E : CHAR) RETURN CHAR IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN E;
+           ELSE
+                RETURN 'F';
+           END IF;
+      END IDENT_CHAR;
+ 
+      FUNCTION IDENT_ARR(E : ARR) RETURN ARR IS
+           Z : ARR := (3,2,1);
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN E;
+           ELSE
+                RETURN Z;
+           END IF;
+      END IDENT_ARR;
+ 
+      FUNCTION IDENT_REC(E : REC) RETURN REC IS
+           Z : REC := (10, YELLOW, 'F');
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RETURN E;
+           ELSE
+                RETURN Z;
+           END IF;
+      END IDENT_REC;
+ 
+      TASK TEST_DEFAULTS IS
+           ENTRY BOOL(G : BOOLEAN := TRUE);
+           ENTRY INTEGR(X : IN INT := 5);
+           ENTRY FLOAT(Y : IN FLT := 1.25);
+           ENTRY FIXED(Z : IN FIX := 1.0);
+           ENTRY ENUMERAT(A : IN ENUM := RED);
+           ENTRY CHARACTR(B : IN CHAR := 'A');
+           ENTRY ARRY(C : IN ARR := (1, 2, 3));
+           ENTRY RECD(D : IN REC := (5, RED, 'A'));
+      END TEST_DEFAULTS;
+ 
+      TASK BODY TEST_DEFAULTS IS
+      BEGIN
+ 
+           ACCEPT BOOL(G : BOOLEAN := TRUE) DO
+                IF G /= IDENT_BOOL(TRUE) THEN
+                     FAILED("BOOLEAN DEFAULT FAILED");
+                END IF;
+           END BOOL;
+ 
+           ACCEPT INTEGR(X : IN INT := 5) DO
+                IF X /= IDENT_INT(5) THEN
+                     FAILED("INTEGER DEFAULT FAILED");
+                END IF;
+           END INTEGR;
+ 
+           ACCEPT FLOAT(Y : IN FLT := 1.25) DO
+                IF Y /= IDENT_FLT(1.25) THEN
+                     FAILED("FLOAT DEFAULT FAILED");
+                END IF;
+           END FLOAT;
+ 
+           ACCEPT FIXED(Z : IN FIX := 1.0) DO
+                IF Z /= IDENT_FIX(1.0) THEN
+                     FAILED("FIXED DEFAULT FAILED");
+                END IF;
+           END FIXED;
+ 
+           ACCEPT ENUMERAT(A : IN ENUM := RED) DO
+                IF A /= IDENT_ENUM(RED) THEN
+                     FAILED("ENUMERATION DEFAULT FAILED");
+                END IF;
+           END ENUMERAT;
+ 
+           ACCEPT CHARACTR(B : IN CHAR := 'A') DO
+                IF B /= IDENT_CHAR('A') THEN
+                     FAILED("CHARACTER DEFAULT FAILED");
+                END IF;
+           END CHARACTR;
+ 
+           ACCEPT ARRY(C : IN ARR := (1, 2, 3)) DO
+                FOR I IN 1 ..3 LOOP
+                     IF C(I) /= IDENT_INT(I) THEN
+                          FAILED("ARRAY " & INTEGER'IMAGE(I) &
+                                 "DEFAULT FAILED");
+                     END IF;
+                END LOOP;
+           END ARRY;
+ 
+           ACCEPT RECD(D : IN REC := (5, RED, 'A')) DO
+                IF D.A /= IDENT_INT(5) THEN
+                     FAILED("RECORD INTEGER DEFAULT FAILED");
+                END IF;
+                IF D.B /= IDENT_ENUM(RED) THEN
+                     FAILED("RECORD ENUMERATION DEFAULT FAILED");
+                END IF;
+                IF D.C /= IDENT_CHAR('A') THEN
+                     FAILED("RECORD CHARACTER DEFAULT FAILED");
+                END IF;
+           END RECD;
+ 
+      END TEST_DEFAULTS;
+ 
+ BEGIN
+ 
+      TEST("C95092A", "CHECK THAT FOR ENTRIES OF TASKS, DEFAULT " &
+                      "VALUES OF ALL TYPES CAN BE GIVEN FOR A FORMAL " &
+                      "PARAMETER");
+ 
+           TEST_DEFAULTS.BOOL;
+           TEST_DEFAULTS.INTEGR;
+           TEST_DEFAULTS.FLOAT;
+           TEST_DEFAULTS.FIXED;
+           TEST_DEFAULTS.ENUMERAT;
+           TEST_DEFAULTS.CHARACTR;
+           TEST_DEFAULTS.ARRY;
+           TEST_DEFAULTS.RECD;
+ 
+      RESULT;
+ END C95092A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95093a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95093a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95093a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95093a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- C95093A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE DEFAULT EXPRESSIONS OF FORMAL PARAMETERS ARE EVALUATED
+ -- EACH TIME THEY ARE NEEDED.
+ 
+ -- GLH 7/2/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE C95093A IS
+ BEGIN
+ 
+      TEST ("C95093A", "CHECK THAT THE DEFAULT EXPRESSION IS " &
+                       "EVALUATED EACH TIME IT IS NEEDED");
+ 
+      DECLARE
+ 
+           X : INTEGER := 1;
+ 
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                X := X + 1;
+                RETURN X;
+           END F;
+ 
+           TASK T1 IS
+                ENTRY E1 (X, Y : INTEGER := F);
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+ 
+                ACCEPT E1 (X, Y : INTEGER := F) DO
+                     IF X = Y OR Y /= 2 THEN
+                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - " &
+                                  "1, X =" & INTEGER'IMAGE(X) &
+                                  ", Y =" & INTEGER'IMAGE(Y));
+                     END IF;
+                END E1;
+ 
+                ACCEPT E1 (X, Y : INTEGER := F) DO
+                     IF X = Y OR
+                        NOT ((X = 3 AND Y = 4) OR
+                             (X = 4 AND Y = 3)) THEN
+                          FAILED ("DEFAULT NOT EVALUATED CORRECTLY - " &
+                                  "2, X =" & INTEGER'IMAGE(X) &
+                                  ", Y =" & INTEGER'IMAGE(Y));
+                     END IF;
+                END E1;
+ 
+           END T1;
+ 
+      BEGIN
+ 
+           COMMENT ("FIRST CALL");
+           T1.E1 (3);
+ 
+           COMMENT ("SECOND CALL");
+           T1.E1;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C95093A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C95095A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (A) A FUNCTION AND AN ENTRY.
+ 
+ -- JWC 7/24/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95095A IS
+ 
+ BEGIN
+      TEST ("C95095A", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
+                       "MINIMAL DIFFERENCES");
+ 
+      --------------------------------------------------
+ 
+      -- BOTH PARAMETERIZED AND PARAMETERLESS SUBPROGRAMS AND ENTRIES
+      -- ARE TESTED.
+ 
+      DECLARE
+           I, J, K : INTEGER := 0;
+           S : STRING (1..2) := "12";
+ 
+           TASK T IS
+                ENTRY E1 (I1, I2 : INTEGER);
+                ENTRY E2;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT E1 (I1, I2 : INTEGER) DO
+                               S (1) := 'A';
+                          END E1;
+                     OR
+                          ACCEPT E2 DO
+                               S (1) := 'C';
+                          END E2;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+ 
+           FUNCTION E1 (I1, I2 : INTEGER) RETURN INTEGER IS
+           BEGIN
+                S (2) := 'B';
+                RETURN I1; -- RETURNED VALUE IS IRRELEVENT.
+           END E1;
+ 
+ 
+           FUNCTION E2 RETURN INTEGER IS
+           BEGIN
+                S (2) := 'D';
+                RETURN I; -- RETURNED VALUE IS IRRELEVENT.
+           END E2;
+ 
+      BEGIN
+           T.E1 (I, J);
+           K := E1 (I, J);
+ 
+           IF S /= "AB" THEN
+                FAILED ("PARAMETERIZED OVERLOADED " &
+                        "SUBPROGRAM AND ENTRY " &
+                        "CAUSED CONFUSION");
+           END IF;
+ 
+           S := "12";
+           T.E2;
+           K := E2;
+ 
+           IF S /= "CD" THEN
+                FAILED ("PARAMETERLESS OVERLOADED " &
+                        "SUBPROGRAM AND ENTRY " &
+                        "CAUSED CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95095A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- C95095B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED ENTRY DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (B) ONE ENTRY HAS ONE LESS PARAMETER THAN THE OTHER.
+ 
+ -- JWC 7/24/85
+ -- JRK 10/2/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95095B IS
+ 
+ BEGIN
+      TEST ("C95095B", "ENTRY OVERLOADING WITH " &
+                       "MINIMAL DIFFERENCES");
+ 
+      --------------------------------------------------
+ 
+      -- ONE ENTRY HAS ONE MORE PARAMETER
+      -- THAN THE OTHER.  THIS IS TESTED IN THE
+      -- CASE IN WHICH THAT PARAMETER HAS A DEFAULT
+      -- VALUE, AND THE CASE IN WHICH IT DOES NOT.
+ 
+      DECLARE
+           I, J : INTEGER := 0;
+           B : BOOLEAN := TRUE;
+           S : STRING (1..2) := "12";
+ 
+           TASK T IS
+                ENTRY E1 (I1, I2 : INTEGER; B1 : IN OUT BOOLEAN);
+                ENTRY E1 (I1, I2 : INTEGER);
+                ENTRY E2 (B1 : IN OUT BOOLEAN; I1 : INTEGER := 0);
+                ENTRY E2 (B1 : IN OUT BOOLEAN);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT E1 (I1, I2 : INTEGER;
+                                     B1 : IN OUT BOOLEAN) DO
+                               S (1) := 'A';
+                          END E1;
+                     OR
+                          ACCEPT E1 (I1, I2 : INTEGER) DO
+                               S (2) := 'B';
+                          END E1;
+                     OR
+                          ACCEPT E2 (B1 : IN OUT BOOLEAN;
+                                     I1 : INTEGER := 0) DO
+                               S (1) := 'C';
+                          END E2;
+                     OR
+                          ACCEPT E2 (B1 : IN OUT BOOLEAN) DO
+                               S (2) := 'D';
+                          END E2;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+ 
+      BEGIN
+           T.E1 (I, J, B);
+           T.E1 (I, J);
+ 
+           IF S /= "AB" THEN
+                FAILED ("ENTRIES DIFFERING ONLY IN " &
+                        "NUMBER OF PARAMETERS (NO DEFAULTS) " &
+                        "CAUSED CONFUSION");
+           END IF;
+ 
+           S := "12";
+           T.E2 (B, I);
+           -- NOTE THAT A CALL TO T.E2 WITH ONLY
+           -- ONE PARAMETER IS AMBIGUOUS.
+ 
+           IF S /= "C2" THEN
+                FAILED ("ENTRIES DIFFERING ONLY IN " &
+                        "EXISTENCE OF ONE PARAMETER (WITH " &
+                        "DEFAULT) CAUSED CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95095B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- C95095C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED ENTRY DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (C) THE BASE TYPE OF A PARAMETER IS DIFFERENT FROM THAT
+ --         OF THE CORRESPONDING ONE.
+ 
+ -- JWC 7/24/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95095C IS
+ 
+ BEGIN
+      TEST ("C95095C", "ENTRY OVERLOADING WITH " &
+                       "MINIMAL DIFFERENCES");
+ 
+      --------------------------------------------------
+ 
+      -- THE BASE TYPE OF ONE PARAMETER IS
+      -- DIFFERENT FROM THAT OF THE CORRESPONDING
+      -- ONE.
+ 
+      DECLARE
+ 
+           TYPE NEWINT IS NEW INTEGER;
+ 
+           I, J, K : INTEGER := 0;
+           N : NEWINT;
+           S : STRING (1..2) := "12";
+ 
+           TASK T IS
+                ENTRY E (I1 : INTEGER; N1 : OUT NEWINT;
+                         I2 : IN OUT INTEGER);
+                ENTRY E (I1 : INTEGER; N1 : OUT INTEGER;
+                         I2 : IN OUT INTEGER);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT E (I1 : INTEGER; N1 : OUT NEWINT;
+                                    I2 : IN OUT INTEGER) DO
+                               S (1) := 'A';
+                               N1 := 0; -- THIS VALUE IS IRRELEVENT.
+                          END E;
+                     OR
+                          ACCEPT E (I1 : INTEGER; N1 : OUT INTEGER;
+                                    I2 : IN OUT INTEGER) DO
+                               S (2) := 'B';
+                               N1 := 0; -- THIS VALUE IS IRRELEVENT.
+                          END E;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+ 
+      BEGIN
+           T.E (I, N, K);
+           T.E (I, J, K);
+ 
+           IF S /= "AB" THEN
+                FAILED ("ENTRIES DIFFERING ONLY BY " &
+                        "THE BASE TYPE OF A PARAMETER " &
+                        "CAUSED CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95095C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- C95095D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (D) A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
+ --         PART, AN ENTRY IS DECLARED IN A TASK, AND THE
+ --         PARAMETERS ARE ORDERED DIFFERENTLY.
+ 
+ -- JWC 7/24/85
+ -- JRK 10/2/85
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C95095D IS
+ 
+ 
+ BEGIN
+      TEST ("C95095D", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
+                       "MINIMAL DIFFERENCES");
+ 
+      --------------------------------------------------
+ 
+      -- A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
+      -- PART, AN ENTRY IS DECLARED IN A TASK, AND THE
+      -- PARAMETERS ARE ORDERED DIFFERENTLY.
+ 
+      DECLARE
+           S : STRING (1..2) := "12";
+ 
+           I : INTEGER := 0;
+ 
+           PROCEDURE E (I1 : INTEGER; I2 : IN OUT INTEGER;
+                        B1 : BOOLEAN) IS
+           BEGIN
+                S (1) := 'A';
+           END E;
+ 
+           TASK T IS
+                ENTRY E (B1 : BOOLEAN; I1 : INTEGER;
+                         I2 : IN OUT INTEGER);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                E (5, I, TRUE);          -- PROCEDURE CALL.
+                ACCEPT E (B1 : BOOLEAN; I1 : INTEGER;
+                          I2 : IN OUT INTEGER) DO
+                     S (2) := 'B';
+                END E;
+                E (TRUE, 5, I);          -- ENTRY CALL; SELF-BLOCKING.
+                -- NOTE THAT A CALL IN WHICH ALL ACTUAL PARAMETERS
+                -- ARE NAMED_ASSOCIATIONS IS AMBIGUOUS.
+                FAILED ("TASK DID NOT BLOCK ITSELF");
+           END T;
+ 
+      BEGIN
+ 
+           T.E (TRUE, 5, I);
+ 
+           DELAY 10.0 * Impdef.One_Second;
+           ABORT T;
+ 
+           IF S /= "AB" THEN
+                FAILED ("PROCEDURES/ENTRIES " &
+                        "DIFFERING ONLY IN PARAMETER " &
+                        "TYPE ORDER CAUSED CONFUSION");
+           END IF;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95095D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c95095e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c95095e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- C95095E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
+ -- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+ -- DIFFERENCE BETWEEN THE DECLARATIONS.
+ 
+ --     (E) A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE PART,
+ --         AN ENTRY IN A TASK, AND ONE HAS ONE MORE PARAMETER
+ --         THAN THE OTHER; THE OMITTED PARAMETER HAS A DEFAULT VALUE.
+ 
+ -- JWC 7/30/85
+ -- JRK 10/2/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C95095E IS
+ 
+ BEGIN
+      TEST ("C95095E", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
+                       "MINIMAL DIFFERENCES ALLOWED");
+ 
+      --------------------------------------------------
+ 
+      -- A SUBPROGRAM IS IN AN OUTER DECLARATIVE
+      -- PART, AN ENTRY IN A TASK, AND ONE
+      -- HAS ONE MORE PARAMETER (WITH A DEFAULT
+      -- VALUE) THAN THE OTHER.
+ 
+      DECLARE
+           S : STRING (1..3) := "123";
+ 
+           PROCEDURE E (I1, I2, I3 : INTEGER := 1) IS
+                C : CONSTANT STRING := "CXA";
+           BEGIN
+                S (I3) := C (I3);
+           END E;
+ 
+           TASK T IS
+                ENTRY E (I1, I2 : INTEGER := 1);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (I1, I2 : INTEGER := 1) DO
+                     S (2) := 'B';
+                END E;
+           END T;
+ 
+      BEGIN
+ 
+           E (1, 2, 3);
+           T.E (1, 2);
+           E (1, 2);
+ 
+           IF S /= "CBA" THEN
+                FAILED ("PROCEDURES/ENTRIES DIFFERING " &
+                        "ONLY IN EXISTENCE OF ONE " &
+                        "DEFAULT-VALUED PARAMETER CAUSED " &
+                        "CONFUSION");
+           END IF;
+ 
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END C95095E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c951001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c951001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c951001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c951001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,192 ----
+ -- C951001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that two procedures in a protected object will not be 
+ --      executed concurrently.
+ --
+ -- TEST DESCRIPTION:
+ --      A very simple example of two tasks calling two procedures in the same 
+ --      protected object is used.  Test control code has been added to the
+ --      procedures such that, whichever gets called first executes a lengthy
+ --      calculation giving sufficient time (on a multiprocessor or a
+ --      time-slicing machine) for the other task to get control and call the
+ --      other procedure.  The control code verifies that entry to the second
+ --      routine is postponed until the first is complete.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C951001 is
+ 
+    protected Ramp_31 is
+ 
+       procedure Add_Meter_Queue;
+       procedure Subtract_Meter_Queue;
+       function  TC_Failed return Boolean;
+    
+    private
+ 
+       Ramp_Count : integer range 0..20 := 4;  -- Start test with some
+                                               -- vehicles on the ramp
+    
+       TC_Add_Started       : Boolean := false;
+       TC_Subtract_Started  : Boolean := false;
+       TC_Add_Finished      : Boolean := false;
+       TC_Subtract_Finished : Boolean := false;
+       TC_Concurrent_Running: Boolean := false;
+       
+    end Ramp_31;
+ 
+    
+    protected body Ramp_31 is
+ 
+       function TC_Failed return Boolean is
+       begin
+          -- this indicator will have been set true if any instance
+          -- of concurrent running has been proved
+          return TC_Concurrent_Running;
+       end TC_Failed;
+ 
+ 
+       procedure Add_Meter_Queue is
+       begin
+          --==================================================
+          -- This section is all Test_Control code
+          TC_Add_Started := true;
+          if TC_Subtract_Started then 
+             if not TC_Subtract_Finished then
+                TC_Concurrent_Running := true;
+             end if;
+          else
+             -- Subtract has not started. 
+             -- Execute a lengthy routine to give it a chance to do so
+             ImpDef.Exceed_Time_Slice;
+ 
+             if TC_Subtract_Started then 
+                -- Subtract was able to start so we have concurrent 
+                -- running and the test has failed
+                TC_Concurrent_Running := true;
+             end if;
+          end if;
+          TC_Add_Finished := true;
+          --==================================================
+          Ramp_Count := Ramp_Count + 1;
+       end Add_Meter_Queue;
+ 
+       procedure Subtract_Meter_Queue is
+       begin
+          --==================================================
+          -- This section is all Test_Control code
+          TC_Subtract_Started := true;
+          if TC_Add_Started then 
+             if not TC_Add_Finished then
+                -- We already have concurrent running
+                TC_Concurrent_Running := true;
+             end if;
+          else
+             -- Add has not started. 
+             -- Execute a lengthy routine to give it a chance to do so
+             ImpDef.Exceed_Time_Slice;
+ 
+             if TC_Add_Started then 
+                -- Add was able to start so we have concurrent 
+                -- running and the test has failed
+                TC_Concurrent_Running := true;
+             end if;
+          end if;
+          TC_Subtract_Finished := true;
+          --==================================================
+          Ramp_Count := Ramp_Count - 1;
+       end Subtract_Meter_Queue;
+    
+    end Ramp_31;
+ 
+ begin
+ 
+    Report.Test ("C951001", "Check that two procedures in a protected" &
+                            " object will not be executed concurrently");
+ 
+    declare -- encapsulate the test
+ 
+       task Vehicle_1;
+       task Vehicle_2;
+ 
+ 
+       -- Vehicle_1 and Vehicle_2 are simulations of Instances of the task
+       -- of type Vehicle in different stages of execution
+ 
+       task body Vehicle_1 is
+       begin
+          null;  -- ::::: stub.  preparation code
+          
+          -- Add to the count of vehicles on the queue   
+          Ramp_31.Add_Meter_Queue;
+ 
+          null;  -- ::::: stub:  wait at the meter then pass to first sensor
+ 
+          -- Reduce the count of vehicles on the queue
+          null;  -- ::::: stub: Ramp_31.Subtract_Meter_Queue
+       exception
+          when others =>
+                Report.Failed ("Unexpected Exception in Vehicle_1 task");
+       end Vehicle_1;
+ 
+ 
+       task body Vehicle_2 is
+       begin
+          null;  -- ::::: stub.  preparation code
+          
+          -- Add to the count of vehicles on the queue   
+          null;  -- ::::: stub Ramp_31.Add_Meter_Queue;  
+ 
+          null;  -- ::::: stub:  wait at the meter then pass to first sensor
+ 
+          -- Reduce the count of vehicles on the queue
+          Ramp_31.Subtract_Meter_Queue;
+       exception
+          when others =>
+                Report.Failed ("Unexpected Exception in Vehicle_2 task");
+       end Vehicle_2;
+ 
+   
+ 
+    begin
+       null;
+    end;   -- encapsulation
+ 
+    if Ramp_31.TC_Failed then
+       Report.Failed ("Concurrent Running detected");
+    end if;
+ 
+    Report.Result;
+ 
+ end C951001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c951002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c951002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c951002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c951002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,334 ----
+ -- C951002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an entry and a procedure within the same protected object
+ --      will not be executed simultaneously.
+ --
+ -- TEST DESCRIPTION:
+ --      Two tasks are used.  The first calls an entry who's barrier is set
+ --      and is thus queued.  The second calls a procedure in the same 
+ --      protected object.  This procedure clears the entry barrier of the 
+ --      first then executes a lengthy compute bound procedure.  This is 
+ --      intended to allow a multiprocessor, or a time-slicing implementation 
+ --      of a uniprocessor, to (erroneously) permit the first task to continue
+ --      while the second is still computing.  Flags in each process in the 
+ --      PO are checked to ensure that they do not run out of sequence or in 
+ --      parallel.  
+ --      In the second part of the test another entry and procedure are used
+ --      but in this case the procedure is started first.  A different task
+ --      calls the entry AFTER the procedure has started.  If the entry 
+ --      completes before the procedure the test fails.
+ --
+ --      This test will not be effective on a uniprocessor without time-slicing
+ --      It is designed to increase the chances of failure on a multiprocessor,
+ --      or a uniprocessor with time-slicing, if the entry and procedure in a 
+ --      Protected Object are not forced to acquire a single execution 
+ --      resource.  It is not guaranteed to fail.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C951002 is
+    
+    -- These global error flags are used for failure conditions within
+    -- the protected object.  We cannot call Report.Failed (thus Text_io)
+    -- which would result in a bounded error.
+    --
+    TC_Error_01 : Boolean := false;
+    TC_Error_02 : Boolean := false;
+    TC_Error_03 : Boolean := false;
+    TC_Error_04 : Boolean := false;
+    TC_Error_05 : Boolean := false;
+    TC_Error_06 : Boolean := false;
+ 
+ begin
+ 
+    Report.Test ("C951002", "Check that a procedure and an entry body " &
+                            "in a protected object will not run concurrently");
+ 
+    declare -- encapsulate the test
+       
+       task Credit_Message is
+          entry TC_Start;
+       end Credit_Message;
+ 
+       task Credit_Task is
+          entry TC_Start;
+       end Credit_Task;
+ 
+       task Debit_Message is
+          entry TC_Start;
+       end Debit_Message;
+ 
+       task Debit_Task is
+          entry TC_Start;
+       end Debit_Task;
+ 
+       --====================================
+ 
+       protected Hold is
+ 
+          entry Wait_for_CR_Underload;
+          procedure Clear_CR_Overload;
+          entry Wait_for_DB_Underload;
+          procedure Set_DB_Overload;
+          procedure Clear_DB_Overload;
+          --
+          function TC_Message_is_Queued return Boolean;
+ 
+       private
+          Credit_Overloaded     : Boolean := true;  -- Test starts in overload
+          Debit_Overloaded      : Boolean := false; 
+          -- 
+          TC_CR_Proc_Finished   : Boolean := false;
+          TC_CR_Entry_Finished  : Boolean := false;
+          TC_DB_Proc_Finished   : Boolean := false;
+          TC_DB_Entry_Finished  : Boolean := false;
+       end Hold;
+       --====================
+       protected body Hold is
+    
+          entry Wait_for_CR_Underload when not Credit_Overloaded is
+          begin
+             -- The barrier must only be re-evaluated at the end of the 
+             -- of the execution of the procedure, also while the procedure
+             -- is executing this entry body must not be executed
+             if not TC_CR_Proc_Finished then
+                TC_Error_01 := true;  -- Set error indicator
+             end if;
+             TC_CR_Entry_Finished := true;
+          end Wait_for_CR_Underload ;
+    
+          -- This is the procedure which should NOT be able to run in 
+          -- parallel with the entry body
+          --
+          procedure Clear_CR_Overload is
+          begin
+ 
+             -- The entry body must not be executed until this procedure
+             -- is completed.  
+             if TC_CR_Entry_Finished then
+                TC_Error_02 := true;  -- Set error indicator
+             end if;
+             Credit_Overloaded := false;   -- clear the entry barrier
+ 
+             -- Execute an implementation defined compute bound routine which 
+             -- is designed to run long enough to allow a task switch on a
+             -- time-sliced uniprocessor, or for a multiprocessor to pick up
+             -- another task.
+             -- 
+             ImpDef.Exceed_Time_Slice;
+             
+             -- Again, the entry body must not be executed until the current 
+             -- procedure is completed.  
+             --
+             if TC_CR_Entry_Finished then
+                TC_Error_03 := true;  -- Set error indicator
+             end if;
+             TC_CR_Proc_Finished := true;
+ 
+          end Clear_CR_Overload;
+    
+          --============
+          -- The following subprogram and entry body are used in the second
+          -- part of the test
+          
+          entry Wait_for_DB_Underload when not Debit_Overloaded is
+          begin
+             -- By the time the task that calls this entry is allowed access to
+             -- the queue the barrier, which starts off as open, will be closed
+             -- by the Set_DB_Overload procedure.  It is only reopened 
+             -- at the end of the test
+             if not TC_DB_Proc_Finished then
+                TC_Error_04 := true;  -- Set error indicator
+             end if;
+             TC_DB_Entry_Finished := true;
+          end Wait_for_DB_Underload ;
+    
+    
+          procedure Set_DB_Overload is
+          begin
+             -- The task timing is such that this procedure should be started
+             -- before the entry is called.  Thus the entry should be blocked
+             -- until the end of this procedure which then sets the barrier
+             --
+             if TC_DB_Entry_Finished then
+                TC_Error_05 := true;  -- Set error indicator
+             end if;
+ 
+             -- Execute an implementation defined compute bound routine which 
+             -- is designed to run long enough to allow a task switch on a
+             -- time-sliced uniprocessor, or for a multiprocessor to pick up
+             -- another task
+             -- 
+             ImpDef.Exceed_Time_Slice;
+             
+             Debit_Overloaded := true;   -- set the entry barrier
+ 
+             if TC_DB_Entry_Finished then
+                TC_Error_06 := true;  -- Set error indicator
+             end if;
+             TC_DB_Proc_Finished := true;
+ 
+          end Set_DB_Overload;
+    
+          procedure Clear_DB_Overload is
+          begin
+             Debit_Overloaded := false;  -- open the entry barrier
+          end Clear_DB_Overload;
+ 
+          function TC_Message_is_Queued return Boolean is
+          begin
+    
+             -- returns true when one message arrives on the queue
+             return (Wait_for_CR_Underload'Count = 1);   
+                                                     
+          end TC_Message_is_Queued ;
+ 
+       end Hold;
+ 
+       --====================================
+ 
+       task body Credit_Message is
+       begin
+          accept TC_Start;
+          --::  some application processing.  Part of the process finds that
+          --    the Overload threshold has been exceeded for the Credit
+          --    application.  This message task queues itself on a queue
+          --    waiting till the overload in no longer in effect 
+          Hold.Wait_for_CR_Underload;
+       exception
+          when others =>
+             Report.Failed ("Unexpected Exception in Credit_Message Task");
+       end Credit_Message;
+ 
+       task body Credit_Task is
+       begin
+          accept TC_Start;
+          --  Application code here (not shown) determines that the
+          --  underload threshold has been reached
+          Hold.Clear_CR_Overload;
+       exception
+          when others =>
+             Report.Failed ("Unexpected Exception in Credit_Task");
+       end Credit_Task;
+ 
+       --============== 
+ 
+       -- The following two tasks are used in the second part of the test
+ 
+       task body Debit_Message is
+       begin
+          accept TC_Start;
+          --::  some application processing.  Part of the process finds that
+          --    the Overload threshold has been exceeded for the Debit 
+          --    application.  This message task queues itself on a queue
+          --    waiting till the overload is no longer in effect 
+          --
+          Hold.Wait_for_DB_Underload;
+       exception
+          when others =>
+             Report.Failed ("Unexpected Exception in Debit_Message Task");
+       end Debit_Message;
+ 
+       task body Debit_Task is
+       begin
+          accept TC_Start;
+          --  Application code here (not shown) determines that the
+          --  underload threshold has been reached
+          Hold.Set_DB_Overload;
+       exception
+          when others =>
+             Report.Failed ("Unexpected Exception in Debit_Task");
+       end Debit_Task;
+    
+    begin -- declare
+ 
+       Credit_Message.TC_Start;
+       
+       -- Wait until the message is queued on the entry before starting
+       -- the Credit_Task
+       while not Hold.TC_Message_is_Queued loop
+          delay ImpDef.Long_Minimum_Task_Switch;   
+       end loop;
+       --
+       Credit_Task.TC_Start;
+ 
+       -- Ensure the first part of the test is complete before continuing
+       while not (Credit_Message'terminated and Credit_Task'terminated) loop
+          delay ImpDef.Long_Minimum_Task_Switch;   
+       end loop;
+ 
+       --======================================================
+       -- Second part of the test
+ 
+ 
+       Debit_Task.TC_Start;
+       
+       -- Delay long enough to allow a task switch to the Debit_Task and
+       -- for it to reach the accept statement and call Hold.Set_DB_Overload
+       -- before starting Debit_Message
+       --
+       delay ImpDef.Long_Switch_To_New_Task;
+ 
+       Debit_Message.TC_Start;
+ 
+       while not Debit_Task'terminated loop
+          delay ImpDef.Long_Minimum_Task_Switch;   
+       end loop;    
+   
+       Hold.Clear_DB_Overload;  -- Allow completion 
+    
+    end; -- declare (encapsulation)
+ 
+    if TC_Error_01 then
+       Report.Failed ("Wait_for_CR_Underload executed out of sequence");
+    end if;
+    if TC_Error_02 then
+       Report.Failed ("Credit: Entry executed before procedure");
+    end if;
+    if TC_Error_03 then
+       Report.Failed ("Credit: Entry executed in parallel");
+    end if;
+    if TC_Error_04 then
+       Report.Failed ("Wait_for_DB_Underload executed out of sequence");
+    end if;
+    if TC_Error_05 then
+       Report.Failed ("Debit: Entry executed before procedure");
+    end if;
+    if TC_Error_06 then
+       Report.Failed ("Debit: Entry executed in parallel");
+    end if;
+    
+    Report.Result;
+ 
+ end C951002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c953001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c953001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c953001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c953001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,188 ----
+ -- C953001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the evaluation of an entry_barrier condition
+ --      propagates an exception, the exception Program_Error
+ --      is propagated to all current callers of all entries of the
+ --      protected object.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares a protected object (PO) with two entries and
+ --      a 5 element entry family.
+ --      All the entries are always closed.  However, one of the entries
+ --      (Oh_No) will get a constraint_error in its barrier_evaluation
+ --      whenever the global variable Blow_Up is true.
+ --      An array of tasks is created where the tasks wait on the various
+ --      entries of the protected object.  Once all the tasks are waiting
+ --      the main procedure calls the entry Oh_No and causes an exception
+ --      to be propagated to all the tasks.  The tasks record the fact 
+ --      that they got the correct exception in global variables that
+ --      can be checked after the tasks complete.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      19 OCT 95   SAIC    ACVC 2.1
+ --
+ --!
+ 
+ 
+ with Report;
+ with ImpDef;
+ procedure C953001 is
+     Verbose : constant Boolean := False;
+     Max_Tasks : constant := 12;
+ 
+       -- note status and error conditions
+     Blocked_Entry_Taken : Boolean := False;
+     In_Oh_No            : Boolean := False;
+     Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False);
+ 
+ begin
+   Report.Test ("C953001",
+                "Check that an exception in an entry_barrier condition" &
+                " causes Program_Error to be propagated to all current" &
+                " callers of all entries of the protected object");
+ 
+   declare -- test encapsulation
+     -- miscellaneous values
+     Cows : Integer := Report.Ident_Int (1);
+     Came_Home : Integer := Report.Ident_Int (2);
+ 
+     -- make the Barrier_Condition fail only when we want it to
+     Blow_Up : Boolean := False;
+ 
+     function Barrier_Condition return Boolean is
+     begin
+       if Blow_Up then
+          return 5 mod Report.Ident_Int(0) = 1;
+       else
+          return False;
+       end if;
+     end Barrier_Condition;
+ 
+     subtype Family_Index is Integer range 1..5;
+ 
+     protected PO is
+       entry Block1;
+       entry Oh_No;
+       entry Family (Family_Index);
+     end PO;
+ 
+     protected body PO is
+       entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is
+       begin
+         Blocked_Entry_Taken := True;
+       end Block1;
+ 
+       -- barrier will get a Constraint_Error (divide by 0)
+       entry Oh_No when Barrier_Condition is
+       begin
+         In_Oh_No := True;
+       end Oh_No;
+ 
+       entry Family (for Member in Family_Index) when Cows = Came_Home is
+       begin
+         Blocked_Entry_Taken := True;
+       end Family;
+     end PO;
+      
+ 
+     task type Waiter is
+       entry Take_Id (Id : Integer);
+     end Waiter;
+ 
+     Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;
+ 
+     task body Waiter is
+       Me : Integer;
+       Action : Integer;
+     begin
+       accept Take_Id (Id : Integer) do
+          Me := Id;
+       end Take_Id;
+ 
+       Action := Me mod (Family_Index'Last + 1);
+       begin
+         if Action = 0 then
+           PO.Block1; 
+         else
+           PO.Family (Action);
+         end if;
+         Report.Failed ("no exception for task" & Integer'Image (Me));
+       exception
+          when Program_Error =>
+            Task_Passed (Me) := True;
+            if Verbose then
+              Report.Comment ("pass for task" & Integer'Image (Me));
+            end if;
+          when others =>
+            Report.Failed ("wrong exception raised in task" &
+                           Integer'Image (Me));
+       end;
+     end Waiter;
+ 
+ 
+   begin   -- test encapsulation
+     for I in 1..Max_Tasks loop
+       Bunch_Of_Waiters(I).Take_Id (I);
+     end loop;
+ 
+     -- give all the Waiters time to get queued
+     delay 2*ImpDef.Clear_Ready_Queue;
+ 
+     -- cause the protected object to fail
+     begin
+       Blow_Up := True;
+       PO.Oh_No;
+       Report.Failed ("no exception in call to PO.Oh_No");
+     exception
+       when Constraint_Error =>
+          Report.Failed ("Constraint_Error instead of Program_Error");
+       when Program_Error =>
+          if Verbose then
+            Report.Comment ("main exception passed");
+          end if;
+       when others =>
+          Report.Failed ("wrong exception in main");
+     end;
+   end;    -- test encapsulation
+ 
+   -- all the tasks have now completed.
+   -- check the flags for pass/fail info
+   if Blocked_Entry_Taken then
+      Report.Failed ("blocked entry taken");
+   end if;
+   if In_Oh_No then
+      Report.Failed ("entry taken with exception in barrier");
+   end if;
+   for I in 1..Max_Tasks loop
+     if not Task_Passed (I) then
+       Report.Failed ("task" & Integer'Image (I) & " did not pass");
+     end if;
+   end loop;
+ 
+   Report.Result;
+ end C953001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c953002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c953002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c953002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c953002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,242 ----
+ -- C953002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the servicing of entry queues of a protected object 
+ --      continues until there are no open entries with queued calls
+ --      and that this takes place as part of a single protected 
+ --      operation.
+ --
+ -- TEST DESCRIPTION:
+ --      This test enqueues a bunch of tasks on the entries of the
+ --      protected object Main_PO.  At the same time another bunch of
+ --      of tasks are queued on the single entry of protected object
+ --      Holding_Pen.
+ --      Once all the tasks have had time to block, the main procedure
+ --      opens all the entries for Main_PO by calling the 
+ --      Start_Protected_Operation protected procedure.  This should
+ --      process all the pending callers as part of a single protected
+ --      operation.
+ --      During this protected operation, the entries of Main_PO release
+ --      the tasks blocked on Holding_Pen by calling the protected 
+ --      procedure Release.
+ --      Once released from Holding_Pen, the task immediately calls
+ --      an entry in Main_PO.
+ --      These new calls should not gain access to Main_PO until
+ --      the initial protected operation on that object completes.
+ --      The order in which the entry calls on Main_PO are taken is
+ --      recorded in a global array and checked after all the tasks
+ --      have terminated.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      25 OCT 95   SAIC    ACVC 2.1
+ --      15 JAN 95   SAIC    Fixed deadlock problem.
+ --
+ --!
+ 
+ with Report;
+ procedure C953002 is
+   Verbose : constant Boolean := False;
+ 
+   Half_Tasks : constant := 15;   -- how many tasks of each group 
+   Max_Tasks : constant := Half_Tasks * 2;  -- total number of tasks
+ 
+   Note_Order : array (1..Max_Tasks) of Integer := (1..Max_Tasks => 0);
+   Note_Cnt : Integer := 0;
+ begin
+   Report.Test ("C953002",
+                "Check that the servicing of entry queues handles all" &
+                " open entries as part of a single protected operation");
+   declare
+      task type Assault_PO is
+         entry Take_ID (Id : Integer);
+      end Assault_PO;
+ 
+      First_Wave  : array (1 .. Half_Tasks) of Assault_PO;
+      Second_Wave : array (1 .. Half_Tasks) of Assault_PO;
+ 
+      protected Main_PO is
+         entry E0 (Who : Integer);
+         entry E1 (Who : Integer);
+         entry E2 (Who : Integer);
+         entry E3 (Who : Integer);
+         entry All_Present;
+         procedure Start_Protected_Operation;
+      private
+         Open : Boolean := False;
+      end Main_PO;
+ 
+      protected Holding_Pen is
+         -- Note that Release is called by tasks executing in 
+         -- the protected object Main_PO.
+         entry Wait (Who : Integer);
+         entry All_Present;
+         procedure Release;
+      private
+         Open : Boolean := False;
+      end Holding_Pen;
+ 
+      
+      protected body Main_PO is
+         procedure Start_Protected_Operation is
+         begin
+            Open := True;
+            -- at this point all the First_Wave tasks are
+            -- waiting at the entries and all of them should
+            -- be processed as part of the protected operation.
+         end Start_Protected_Operation;
+ 
+         entry All_Present when E0'Count + E1'Count + E2'Count + E3'Count =
+                                Max_Tasks / 2  is
+         begin
+            null;   -- all tasks are waiting
+         end All_Present; 
+ 
+         entry E0 (Who : Integer) when Open is
+         begin
+            Holding_Pen.Release;
+            -- note the order in which entry calls are handled.
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+         end E0;
+ 
+         entry E1 (Who : Integer) when Open is
+         begin
+            Holding_Pen.Release;
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+         end E1;
+ 
+         entry E2 (Who : Integer) when Open is
+         begin
+            Holding_Pen.Release;
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+         end E2;
+ 
+         entry E3 (Who : Integer) when Open is
+         begin
+            Holding_Pen.Release;
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+         end E3;
+      end Main_PO;
+ 
+ 
+      protected body Holding_Pen is
+         procedure Release is
+         begin
+            Open := True;
+         end Release;
+ 
+         entry All_Present when Wait'Count = Max_Tasks / 2 is
+         begin
+            null;  -- all tasks waiting
+         end All_Present;
+ 
+         entry Wait (Who : Integer) when Open is
+         begin
+            null;  -- unblock the task
+         end Wait;
+      end Holding_Pen;
+ 
+      task body Assault_PO is
+         Me : Integer;
+      begin
+         accept Take_Id (Id : Integer) do
+            Me := Id;
+         end Take_Id;
+         if Me >= 200 then
+            Holding_Pen.Wait (Me);
+         end if;
+         case Me mod 4 is
+            when 0 => Main_PO.E0 (Me);
+            when 1 => Main_PO.E1 (Me);
+            when 2 => Main_PO.E2 (Me);
+            when 3 => Main_PO.E3 (Me);
+            when others => null;  -- cant happen
+         end case;
+         if Verbose then
+            Report.Comment ("task" & Integer'Image (Me) &
+                            " done");
+         end if;
+      exception
+         when others =>
+            Report.Failed ("exception in task");
+      end Assault_PO;
+ 
+   begin   -- test encapsulation
+      for I in First_Wave'Range loop
+         First_Wave (I).Take_ID (100 + I);
+      end loop;
+      for I in Second_Wave'Range loop
+         Second_Wave (I).Take_ID (200 + I);
+      end loop;
+      
+      -- let all the tasks get blocked
+      Main_PO.All_Present;
+      Holding_Pen.All_Present; 
+ 
+      -- let the games begin
+      if Verbose then
+         Report.Comment ("starting protected operation");
+      end if;
+      Main_PO.Start_Protected_Operation;
+ 
+      -- wait for all the tasks to complete
+      if Verbose then
+         Report.Comment ("waiting for tasks to complete");
+      end if;
+   end;
+ 
+   -- make sure all tasks registered their order
+   if Note_Cnt /= Max_Tasks then
+      Report.Failed ("task registration count wrong. " &
+                     Integer'Image (Note_Cnt));
+   end if;
+ 
+   -- check the order in which entries were handled.
+   -- all the 100 level items should be handled as part of the
+   -- first protected operation and thus should be completed
+   -- before any 200 level item.
+ 
+   if Verbose then
+      for I in 1..Max_Tasks loop
+         Report.Comment ("order" & Integer'Image (I) & " is" &
+                         Integer'Image (Note_Order (I))); 
+      end loop;
+   end if;
+   for I in 2 .. Max_Tasks loop
+      if Note_Order (I)   <  200 and
+         Note_Order (I-1) >= 200 then
+         Report.Failed ("protected operation failure" &
+                        Integer'Image (Note_Order (I-1)) &
+                        Integer'Image (Note_Order (I)));
+      end if;
+   end loop;
+   
+   Report.Result;
+ end C953002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c953003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c953003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c953003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c953003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,189 ----
+ -- C953003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the servicing of entry queues of a protected object 
+ --      continues until there are no open entries with queued (or 
+ --      requeued) calls and that internal requeues are handled 
+ --      as part of a single protected operation.
+ --
+ -- TEST DESCRIPTION:
+ --      A number of tasks are created and blocked on a protected object
+ --      so that they can all be released at one time.  When released,
+ --      these tasks make an entry call to an entry in the Main_PO 
+ --      protected object.  As part of the servicing of this entry
+ --      call the call is passed through the remaining entries of the
+ --      protected object by using internal requeues.  The protected
+ --      object checks that no other entry call is accepted until 
+ --      after all the internal requeuing has completed.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      12 JAN 96   SAIC    Initial version for 2.1
+ --
+ --!
+ 
+ with Report;
+ procedure C953003 is
+   Verbose : constant Boolean := False;
+ 
+   Order_Error : Boolean := False;
+ 
+   Max_Tasks : constant := 10;  -- total number of tasks
+   Max_Entries : constant := 4;  -- number of entries in Main_PO
+   Note_Cnt : Integer := 0;
+   Note_Order : array (1..Max_Tasks*Max_Entries) of Integer;
+ begin
+   Report.Test ("C953003",
+                "Check that the servicing of entry queues handles all" &
+                " open entries as part of a single protected operation," &
+                " including those resulting from an internal requeue");
+   declare
+      task type Assault_PO is
+         entry Take_ID (Id : Integer);
+      end Assault_PO;
+ 
+      Marines  : array (1 .. Max_Tasks) of Assault_PO;
+ 
+      protected Main_PO is
+         entry E0 (Who : Integer);
+      private
+         entry E3 (Who : Integer);
+         entry E2 (Who : Integer);
+         entry E1 (Who : Integer);
+         Expected_Next : Integer := 0;
+      end Main_PO;
+ 
+      
+      protected body Main_PO is
+ 
+         entry E0 (Who : Integer) when True is
+         begin
+            Order_Error := Order_Error or Expected_Next /= 0;
+            Expected_Next := 1;
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+            requeue E1;
+         end E0;
+ 
+         entry E1 (Who : Integer) when True is
+         begin
+            Order_Error := Order_Error or Expected_Next /= 1;
+            Expected_Next := 2;
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+            requeue E2;
+         end E1;
+ 
+         entry E3 (Who : Integer) when True is
+         begin
+            Order_Error := Order_Error or Expected_Next /= 3;
+            Expected_Next := 0;
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+            -- all done - return now
+         end E3;
+ 
+         entry E2 (Who : Integer) when True is
+         begin
+            Order_Error := Order_Error or Expected_Next /= 2;
+            Expected_Next := 3;
+            Note_Cnt := Note_Cnt + 1;
+            Note_Order (Note_Cnt) := Who;
+            requeue E3;
+         end E2;
+      end Main_PO;
+ 
+      protected Holding_Pen is
+         entry Wait_For_All_Present;
+         entry Wait;
+      private
+         Open : Boolean := False;
+      end Holding_Pen;
+ 
+      protected body Holding_Pen is
+         entry Wait_For_All_Present when Wait'Count = Max_Tasks is
+         begin
+            Open := True;
+         end Wait_For_All_Present;
+ 
+         entry Wait when Open is
+         begin
+            null;  -- just go
+         end Wait;
+      end Holding_Pen;
+ 
+ 
+      task body Assault_PO is
+         Me : Integer;
+      begin
+         accept Take_Id (Id : Integer) do
+            Me := Id;
+         end Take_Id;
+         Holding_Pen.Wait;
+         Main_PO.E0 (Me);
+         if Verbose then
+            Report.Comment ("task" & Integer'Image (Me) &
+                            " done");
+         end if;
+      exception
+         when others =>
+            Report.Failed ("exception in task");
+      end Assault_PO;
+ 
+   begin   -- test encapsulation
+      for I in Marines'Range loop
+         Marines (I).Take_ID (100 + I);
+      end loop;
+      
+      -- let all the tasks get blocked so we can release them all
+      -- at one time
+      Holding_Pen.Wait_For_All_Present; 
+ 
+      -- wait for all the tasks to complete
+      if Verbose then
+         Report.Comment ("waiting for tasks to complete");
+      end if;
+   end;
+ 
+   -- make sure all tasks registered their order
+   if Note_Cnt /= Max_Tasks * Max_Entries then
+      Report.Failed ("task registration count wrong. " &
+                     Integer'Image (Note_Cnt));
+   end if;
+ 
+   if Order_Error then
+      Report.Failed ("internal requeue not handled as part of operation");
+   end if;
+ 
+   if Verbose or Order_Error then
+      for I in 1..Max_Tasks * Max_Entries loop
+         Report.Comment ("order" & Integer'Image (I) & " is" &
+                         Integer'Image (Note_Order (I))); 
+      end loop;
+   end if;
+ 
+   Report.Result;
+ end C953003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,273 ----
+ -- C954001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a requeue statement within an entry_body with parameters
+ --      may requeue the entry call to a protected entry with a subtype-
+ --      conformant parameter profile. Check that, if the call is queued on the
+ --      new entry's queue, the original caller remains blocked after the
+ --      requeue, but the entry_body containing the requeue is completed.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a protected object which simulates a disk device. Declare an
+ --      entry that requeues the caller to a second entry if the disk head is
+ --      not in the proper location, but first sets the second entry's barrier
+ --      to false. Declare a procedure which sets the second entry's barrier
+ --      to true.
+ --
+ --      Declare a task which calls the first entry such that the requeue is
+ --      called. This task should be queued on the second entry and remain
+ --      blocked, and the first entry should be complete. Call the procedure
+ --      which releases the second entry's queue. The second entry should
+ --      complete, after which the task should complete.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C954001_0 is  -- Disk management abstraction.
+ 
+ 
+    -- Simulate a read-only disk device with a head that may be moved to
+    -- different tracks. If a read request is issued for the current
+    -- track, the request can be satisfied immediately. Otherwise, the head
+    -- must be moved to the correct track, during which time the calling task
+    -- is blocked. When the head reaches the correct track, the disk generates
+    -- an interrupt, after which the request can be satisfied, and the
+    -- calling task can proceed.
+ 
+    Buffer_Size : constant := 100;
+ 
+    type Disk_Buffer is new String (1 .. Buffer_Size);
+    type Disk_Track  is new Natural;
+ 
+    type Disk_Address is record
+       Track : Disk_Track;
+       -- Additional components.
+    end record;
+ 
+    Initial_Track : constant Disk_Track := 0;
+    New_Track     : constant Disk_Track := 5;
+ 
+                --==============================================--
+ 
+    protected Disk_Device is
+ 
+       entry Read (Where :     Disk_Address;            -- Read data from disk
+                   Data  : out Disk_Buffer);            -- track.
+ 
+       procedure Disk_Interrupt;                        -- Handle interrupt 
+                                                        -- from disk.
+ 
+       function TC_Track return Disk_Track;             -- Return current track.
+ 
+       function TC_Pending_Queued return Boolean;       -- True when there is
+                                                        -- an entry in queue
+ 
+    private
+ 
+       entry Pending_Read (Where :     Disk_Address;    -- Wait for head to 
+                           Data  : out Disk_Buffer);    -- move then read data.
+ 
+       Current_Track     : Disk_Track := Initial_Track; -- Current disk track.
+       Operation_Pending : Boolean    := False;         -- Vis.  entry barrier.
+       Disk_Interrupted  : Boolean    := False;         -- Priv. entry barrier.
+ 
+    end Disk_Device;
+ 
+ 
+ end C954001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body C954001_0 is  -- Disk management abstraction.
+ 
+ 
+    protected body Disk_Device is
+ 
+       entry Read (Where : Disk_Address; Data : out Disk_Buffer)
+         when not Operation_Pending is
+       begin
+          if (Where.Track = Current_Track) then      -- If the head is over the
+             -- Read data from disk...               -- requested track, read
+             null;                                   -- the data.
+ 
+          else                                       -- Otherwise, defer read
+             Operation_Pending := True;              -- while head is moved to
+                                                     -- correct track (signaled
+             --                        --            -- by a disk interrupt).
+             -- Requeue is tested here --
+             --                        --
+ 
+             requeue Pending_Read;                  
+ 
+          end if;
+       end Read;
+ 
+ 
+       procedure Disk_Interrupt is                   -- Called when the disk
+       begin                                         -- interrupts, indicating
+          Disk_Interrupted := True;                  -- that the head is over
+       end Disk_Interrupt;                           -- the correct track.
+ 
+ 
+       function TC_Track return Disk_Track is        -- Artifice required for
+       begin                                         -- testing purposes.
+          return (Current_Track);
+       end TC_Track;
+ 
+ 
+       entry Pending_Read (Where : Disk_Address; Data : out Disk_Buffer)
+         when Disk_Interrupted is
+       begin
+          Current_Track := Where.Track;              -- Head is now over the
+          -- Read data from disk...                  -- correct track; read
+          Operation_Pending := False;                -- the data.
+          Disk_Interrupted := False;
+       end Pending_Read;
+ 
+       function TC_Pending_Queued return Boolean is
+       begin
+          -- Return true when there is something on the Pending_Read queue
+          return (Pending_Read'Count /=0);   
+       end TC_Pending_Queued;
+ 
+    end Disk_Device;
+ 
+ 
+ end C954001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with C954001_0;  -- Disk management abstraction.
+ use  C954001_0;
+ 
+ procedure C954001 is
+ 
+ 
+    task type Read_Task is        -- an unusual (but legal) declaration
+    end Read_Task;
+    --
+    --
+    task body Read_Task is
+       Location : constant Disk_Address := (Track => New_Track);
+       Data     :          Disk_Buffer  := (others => ' ');
+    begin
+       Disk_Device.Read (Location, Data);   -- Invoke requeue statement.
+    exception
+       when others =>
+          Report.Failed ("Exception raised in task");
+    end Read_Task;
+ 
+                --==============================================--
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C954001", "Requeue from an entry within a P.O. " &
+                            "to a private entry within the same P.O.");
+ 
+ 
+    declare
+ 
+       IO_Request : Read_Task;                  -- Request a read from other
+                                                -- than the current track.
+                                                -- IO_Request will be requeued
+                                                -- from Read to Pending_Read.
+    begin
+ 
+       -- To pass this test, the following must be true:
+       --
+       --    (A) The Read entry call made by the task IO_Request must be
+       --        completed by the requeue.
+       --    (B) IO_Request must remain blocked following the requeue.
+       --    (C) IO_Request must be queued on the Pending_Read entry queue.
+       --    (D) IO_Request must continue execution after the Pending_Read
+       --        entry completes.
+       --
+       -- First, verify (A): that the Read entry call is complete.
+       --
+       -- Call a protected operation (Disk_Device.TC_Track). Since no two
+       -- protected actions may proceed concurrently unless both are protected
+       -- function calls, a call to a protected operation at this point can
+       -- proceed only if the Read entry call is already complete.
+       --
+       -- Note that if Read is NOT complete, the test will likely hang here.
+       --
+       -- Next, verify (B): that IO_Request remains blocked following the
+       -- requeue. Also verify that Pending_Read (the entry to which
+       -- IO_Request should have been queued) has not yet executed.
+ 
+       -- Wait until the task had made the call and the requeue has been
+       -- effected.  
+       while not Disk_Device.TC_Pending_Queued loop
+          delay ImpDef.Minimum_Task_Switch;
+       end loop;
+ 
+       if Disk_Device.TC_Track /= Initial_Track then
+          Report.Failed ("Target entry of requeue executed prematurely");
+       elsif IO_Request'Terminated then
+          Report.Failed ("Caller did not remain blocked after " &
+                         "the requeue or was never requeued");
+       else
+ 
+          -- Verify (C): that IO_Request is queued on the
+          -- Pending_Read entry queue.
+          --
+          -- Set the barrier for Pending_Read to true. Check that the
+          -- current track is updated and that IO_Request terminates.
+ 
+          Disk_Device.Disk_Interrupt;           -- Simulate a disk interrupt,
+                                                -- signaling that the head is
+                                                -- over the correct track.
+ 
+          -- The Pending_Read entry body will complete before the next
+          -- protected action is called (Disk_Device.TC_Track).
+ 
+          if Disk_Device.TC_Track /= New_Track then
+             Report.Failed ("Caller was not requeued on target entry");
+          end if;
+ 
+          -- Finally, verify (D): that Read_Task continues after Pending_Read
+          -- completes.
+          -- 
+          -- Note that the test will hang here if Read_Task does not continue
+          -- executing following the completion of the requeued entry call.
+ 
+       end if;
+ 
+    end;  -- We will not exit the declare block until the task completes
+ 
+    Report.Result;
+ 
+ end C954001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,286 ----
+ -- C954010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a requeue within an accept statement does not block.
+ --      This test uses: Requeue to an entry in a different task
+ --                      Parameterless call
+ --                      Requeue with abort
+ --
+ -- TEST DESCRIPTION:
+ --      In the Distributor task, requeue two successive calls on the entries
+ --      of two separate target tasks.  Verify that the target tasks are
+ --      run in parallel proving that the first requeue does not block
+ --      while the first target rendezvous takes place.                 
+ --
+ --      This series of tests uses a simulation of a transaction driven 
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then 
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system. The message tasks put themselves on the 
+ --      input queue of a Distributor which, from information in the 
+ --      transaction and/or system load conditions forwards them to other 
+ --      operating tasks. These in turn might forward the transactions to yet 
+ --      other tasks for further action.  The  routing is, in real life, 
+ --      dynamic and unpredictable at the time of message generation. All 
+ --      rerouting in this  model is done by means of requeues.
+ --
+ --      This test is directed towards the BLOCKING of the REQUEUE only
+ --      If the original caller does not block, the outcome of the test will
+ --      not be affected.  If the original caller does not continue after
+ --      the return, the test will not pass.  
+ --      If the requeue gets placed on the wrong entry a failing test could
+ --      pass (eg. if the first message is delivered to the second
+ --      computation task and the second message to the first) - a check for
+ --      this condition is made in other tests
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C954010 is
+ 
+    -- Mechanism to count the number of Message tasks completed
+    protected TC_Tasks_Completed is
+       procedure Increment;
+       function  Count return integer;
+    private
+       Number_Complete : integer := 0;
+    end TC_Tasks_Completed;
+    --
+    TC_Expected_To_Complete   : constant integer := 2;
+ 
+ 
+    task type Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is
+       entry Start;
+    end Line_Driver;
+ 
+    task Distributor is 
+       entry Input;
+    end Distributor;
+ 
+    task Credit_Computation is
+       entry Input;
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input;
+       entry TC_Artificial_Rendezvous_1;      -- test purposes only
+       entry TC_Artificial_Rendezvous_2;      -- test purposes only
+    end Debit_Computation;
+ 
+    
+    -- Mechanism to count the number of Message tasks completed
+    protected body TC_Tasks_Completed is
+       procedure Increment is
+       begin
+          Number_Complete := Number_Complete + 1;
+       end Increment;
+ 
+       function Count return integer is
+       begin
+          return Number_Complete;
+       end Count;
+    end TC_Tasks_Completed;
+ 
+ 
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each and sends this to a Distributor 
+    --   for appropriate disposal around the network of tasks
+    --      Such a task would normally be designed to loop continuously
+    --      creating the messages as input is received.  Simulate this 
+    --      but limit it to two dummy messages for this test and allow it
+    --      to terminate at that point
+    --
+    task body Line_Driver is
+ 
+    begin
+ 
+       accept Start;      -- Wait for trigger from main
+ 
+       for i in 1..2 loop
+          declare
+             -- create a new message task 
+             N : acc_Message_Task := new Message_Task; 
+          begin
+             -- preparation code
+             null; -- stub
+ 
+          end;   -- declare
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+ 
+    task body Message_Task is
+    begin
+       -- Queue up on Distributor's Input queue
+       Distributor.Input;
+       
+       -- After the required computations have been performed
+       -- return the message appropriately (probably to an output
+       -- line driver
+       null;            -- stub
+ 
+       -- Increment to show completion of this task
+       TC_Tasks_Completed.Increment;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Message_Task");
+ 
+    end Message_Task;
+ 
+ 
+    -- Dispose each input message to the appropriate computation tasks
+    --    Normally this would be according to some parameters in the entry
+    --    but this simple test is using parameterless entries.  
+    --
+    task body Distributor is
+      Last_was_for_Credit_Computation : Boolean := false;   -- switch
+    begin
+       loop
+          select
+             accept Input do
+                -- Determine to which task the message should be 
+                -- distributed
+                --      For this test arbitrarily send the first to 
+                --      Credit_Computation and the second to Debit_Computation
+                if Last_was_for_Credit_Computation then
+                   requeue Debit_Computation.Input with abort;
+                else 
+                   Last_was_for_Credit_Computation := true;
+                   requeue Credit_Computation.Input with abort;
+                end if;
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Distributor");
+    end Distributor;
+                                           
+                                                 
+    -- Computation task.  After the computation is performed the rendezvous
+    -- in the original message task is completed.                              
+    task body Credit_Computation is
+    begin
+       loop
+          select 
+             accept Input do
+                -- Perform the computations required for this message
+                --
+                null;     -- stub
+ 
+                --   For the test:
+                --   Artificially rendezvous with Debit_Computation.
+                --   If the first requeue in Distributor has blocked 
+                --   waiting for the current rendezvous to complete then the
+                --   second message will not be sent to Debit_Computation 
+                --   which will still be waiting on its Input accept.  
+                --   This task will HANG
+                --
+                Debit_Computation.TC_Artificial_Rendezvous_1;
+                --
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+                                                 
+    -- Computation task.  After the computation is performed the rendezvous
+    -- in the original message task is completed.                              
+    task body Debit_Computation is
+       Message_Count      : integer := 0;
+       TC_AR1_is_complete : Boolean := false;
+    begin
+       loop
+          select
+             accept Input do
+                -- Perform the computations required for this message
+                null;    -- stub
+             end Input;
+             Message_Count := Message_Count + 1;
+          or
+             -- Guard until the rendezvous with the message for this task
+             -- has completed
+             when Message_Count > 0 =>
+             accept TC_Artificial_Rendezvous_1;    -- see comments in
+                                                   -- Credit_Computation above
+             TC_AR1_is_complete := true; 
+          or
+             -- Completion rendezvous with the main procedure
+             when TC_AR1_is_complete =>
+             accept TC_Artificial_Rendezvous_2;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Debit_Computation");
+ 
+ 
+    end Debit_Computation;
+ 
+ 
+ begin -- c954010
+    Report.Test ("C954010", "Requeue in an accept body does not block");
+ 
+    Line_Driver.Start;
+ 
+    -- Ensure that both messages were delivered to the computation tasks
+    -- This shows that both requeues were effective.
+    -- 
+    Debit_Computation.TC_Artificial_Rendezvous_2;
+ 
+    -- Ensure that the message tasks completed
+    while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
+       delay ImpDef.Minimum_Task_Switch;   
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,384 ----
+ -- C954011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a requeue is placed on the correct entry; that the 
+ --      original caller waits for the completion of the requeued rendezvous;
+ --      that the original caller continues after the rendezvous.
+ --      Specifically, this test checks requeue to an entry in a different
+ --      task, requeue where the entry has parameters, and requeue with
+ --      abort.
+ --
+ -- TEST DESCRIPTION:
+ --      In the Distributor task, requeue two successive calls on the entries
+ --      of two separate target tasks.  Each task in each of the  paths adds 
+ --      identifying information in the transaction being passed.  This
+ --      information is checked by the Message tasks on completion ensuring that
+ --      the requeues have been placed on the correct queues.
+ --
+ --      This series of tests uses a simulation of a transaction driven 
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then 
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system. The message tasks put themselves on the 
+ --      input queue of a Distributor which, from information in the 
+ --      transaction and/or system load conditions forwards them to other 
+ --      operating tasks. These in turn might forward the transactions to yet 
+ --      other tasks for further action.  The routing is, in real life, 
+ --      dynamic and unpredictable at the time of message generation. All 
+ --      rerouting in this  model is done by means of requeues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      26 Nov 95   SAIC    Fixed problems with shared global variables
+ --                          for ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+          
+ procedure C954011 is
+  
+ 
+    -- Arbitrary test values
+    Credit_Return : constant := 1;
+    Debit_Return  : constant := 2;
+ 
+    type Transaction_Code is (Credit, Debit);
+ 
+    type Transaction_Record;
+    type acc_Transaction_Record is access Transaction_Record;
+    type Transaction_Record is 
+       record
+          ID               : integer := 0;
+          Code             : Transaction_Code := Debit;
+          Account_Number   : integer := 0;
+          Stock_Number     : integer := 0;
+          Quantity         : integer := 0;
+          Return_Value     : integer := 0;
+          TC_Message_Count : integer := 0;  
+          TC_Thru_Distrib  : Boolean := false;
+       end record;
+ 
+    protected type Message_Mgr is
+       procedure Mark_Complete;
+       function Is_Complete return Boolean;
+    private
+       Complete : Boolean := False;
+    end Message_Mgr;
+ 
+    protected body Message_Mgr is
+       procedure Mark_Complete is
+       begin
+          Complete := True;
+       end Mark_Complete;
+ 
+       Function Is_Complete return Boolean is
+       begin
+          return Complete;
+       end Is_Complete;
+    end Message_Mgr;
+ 
+    TC_Debit_Message  : Message_Mgr;
+    TC_Credit_Message : Message_Mgr;
+ 
+ 
+    task type Message_Task is 
+       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+    end Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is 
+       entry Start;
+    end Line_Driver;   
+ 
+    task Distributor is 
+       entry Input(Transaction : acc_Transaction_Record);
+    end Distributor;
+ 
+    task Credit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Debit_Computation;
+ 
+ 
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each. The message tasks remain extant
+    --   for the life of the messages in the system.
+    --      The Line Driver task would normally be designed to loop continuously
+    --      creating the messages as input is received.  Simulate this 
+    --      but limit it to two dummy messages for this test and allow it
+    --      to terminate at that point
+    --
+    task body Line_Driver is
+       Current_ID : integer := 1;
+       TC_Last_was_for_credit : Boolean := false;
+ 
+       procedure Build_Credit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 100;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Credit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Credit_Record;     
+ 
+ 
+       procedure Build_Debit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 200;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Debit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Debit_Record;     
+ 
+    begin
+ 
+       accept Start;      -- Wait for trigger from Main
+ 
+       for i in 1..2 loop  -- arbitrarily limit to two messages for the test
+          declare 
+             -- Create a task for the next message
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+             -- Create a record for it
+             Next_Transaction : acc_Transaction_Record 
+                                                  := new Transaction_Record;
+          begin
+             if TC_Last_was_for_credit then
+                Build_Debit_Record ( Next_Transaction );            
+             else
+                Build_Credit_Record( Next_Transaction );
+                TC_Last_was_for_credit := true;
+             end if;
+             Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+          end;   -- declare
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+    
+ 
+ 
+    task body Message_Task is
+ 
+       TC_Original_Transaction_Code : Transaction_Code;  
+       This_Transaction : acc_Transaction_Record := new Transaction_Record;
+ 
+    begin
+       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+          This_Transaction.all := In_Transaction.all;
+       end Accept_Transaction;
+ 
+       -- Note the original code to ensure correct return
+       TC_Original_Transaction_Code := This_Transaction.Code;
+  
+       -- Queue up on Distributor's Input queue
+       Distributor.Input ( This_Transaction );
+       -- This task will now wait for the requeued rendezvous 
+       -- to complete before proceeding
+ 
+       -- After the required computations have been performed
+       -- return the Transaction_Record appropriately (probably to an output
+       -- line driver)
+       null;            -- stub
+ 
+       
+       -- The following is all Test Control Code
+ 
+       -- Check that the return values are as expected
+       if TC_Original_Transaction_Code /= This_Transaction.Code then
+          -- Incorrect rendezvous
+          Report.Failed ("Message Task: Incorrect code returned");
+       end if;
+ 
+       if This_Transaction.Code = Credit then
+          if This_Transaction.Return_Value     /= Credit_Return or   
+             This_Transaction.TC_Message_Count /= 1             or not
+             This_Transaction.TC_Thru_Distrib     then
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Credit_Message.Mark_Complete;
+       else
+          if This_Transaction.Return_Value     /= Debit_Return or   
+             This_Transaction.TC_Message_Count /= 1             or not
+             This_Transaction.TC_Thru_Distrib      then
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Debit_Message.Mark_Complete;
+       end if;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Message_Task");
+ 
+    end Message_Task;
+ 
+ 
+ 
+    -- Dispose each input Transaction_Record to the appropriate
+    -- computation tasks
+    --
+    task body Distributor is
+ 
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Mark the message as having passed through the distributor
+                Transaction.TC_Thru_Distrib := true;
+ 
+                -- Pass this transaction on the appropriate computation
+                -- task
+                case Transaction.Code is 
+                   when Credit =>
+                      requeue Credit_Computation.Input with abort;
+                   when Debit => 
+                      requeue Debit_Computation.Input with abort;
+                end case;
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Distributor");
+    end Distributor;
+                                           
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    --                                           
+    task body Credit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select 
+             accept Input ( Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this transaction
+                null;      -- stub
+ 
+                -- For the test: 
+                if not Transaction.TC_Thru_Distrib then
+                   Report.Failed 
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Credit then
+                   Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Credit_Return;
+                -- one, and only one message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    --                                                
+    task body Debit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this message
+                null;      -- stub
+ 
+                -- For the test: 
+                if not Transaction.TC_Thru_Distrib then
+                   Report.Failed 
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Debit then
+                   Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Debit_Return;
+                -- one, and only one, message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Debit_Computation");
+ 
+ 
+    end Debit_Computation;
+ 
+ 
+ begin -- c954011
+ 
+    Report.Test ("C954011", "Requeue from task body to task entry");
+ 
+    Line_Driver.Start;        -- Start the test
+ 
+    -- Ensure that the message tasks complete before reporting the result
+    while not (TC_Credit_Message.Is_Complete and 
+               TC_Debit_Message.Is_Complete) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,496 ----
+ -- C954012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check a requeue within an accept body to another entry in the same task
+ --     Specifically, check a call with parameters and a requeue with abort.
+ --
+ -- TEST DESCRIPTION:
+ --      One transaction is sent through to check the paths. After
+ --      processing this the Credit task sets the "overloaded" indicator.  Once
+ --      this indicator is set the Distributor queues low priority transactions
+ --      on a Wait_for_Underload queue in the same task using a requeue.  The
+ --      Distributor still delivers high priority transactions.  After two high
+ --      priority transactions have been processed by the Credit task it clears
+ --      the overload condition.  The low priority transactions should now be
+ --      delivered.
+ --
+ --      This series of tests uses a simulation of a transaction driven
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system.  The message tasks put themselves on the
+ --      input queue of a Distributor which, from information in the
+ --      transaction and/or system load conditions forwards them to other
+ --      operating tasks. These in turn might forward the transactions to yet
+ --      other tasks for further action.  The routing is, in real life, dynamic
+ --      and unpredictable at the time of message generation.  All rerouting in
+ --      this  model is done by means of requeues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      25 Nov 95   SAIC    Fixed shared global variable problem for
+ --                          ACVC 2.0.1
+ --      14 Mar 03   RLB     Fixed a race condition and an incorrect termination
+ --                          condition in the test.
+ --!
+ 
+ with Report;
+ with ImpDef;
+ with Ada.Calendar;
+ 
+ procedure C954012 is
+ 
+    function "=" (X,Y: Ada.Calendar.Time) return Boolean
+                                                    renames Ada.Calendar."=";
+ 
+    -- Arbitrary test values
+    Credit_Return : constant := 1;
+    Debit_Return  : constant := 2;
+ 
+ 
+    -- This is used as an "initializing" time for the messages as they are
+    -- created.  As they pass through the Distributor they get a time_stamp
+    -- of the current time. An arbitrary base time is chosen.
+    --    TC: this fact is used, incidentally, to check that the messages have,
+    --    indeed, passed through the Distributor as expected.
+    --
+    Base_Time : Ada.Calendar.Time := Ada.Calendar.Time_of(1959,3,9);
+ 
+ 
+    -- Mechanism to count the number of Credit Message tasks completed
+    protected TC_Tasks_Completed is
+       procedure Increment;
+       function  Count return integer;
+    private
+       Number_Complete : integer := 0;
+    end TC_Tasks_Completed;
+ 
+    protected type Shared_Boolean (Initial_Value : Boolean := False) is
+       procedure Set_True;
+       procedure Set_False;
+       function  Value return Boolean;
+    private
+       Current_Value : Boolean := Initial_Value;
+    end Shared_Boolean;
+ 
+    protected body Shared_Boolean is
+       procedure Set_True is
+       begin
+          Current_Value := True;
+       end Set_True;
+ 
+       procedure Set_False is
+       begin
+          Current_Value := False;
+       end Set_False;
+ 
+       function Value return Boolean is
+       begin
+          return Current_Value;
+       end Value;
+    end Shared_Boolean;
+ 
+    TC_Debit_Message_Complete    : Shared_Boolean (False);
+    -- Handshaking mechanism between the Line Driver and the Credit task
+    TC_First_Message_Has_Arrived : Shared_Boolean (False);
+    Credit_Overloaded : Shared_Boolean (False);
+ 
+    TC_Credit_Messages_Expected  : constant integer := 5;
+ 
+    type Transaction_Code is (Credit, Debit);
+    type Transaction_Priority is (High, Low);
+ 
+    type Transaction_Record;
+    type acc_Transaction_Record is access Transaction_Record;
+    type Transaction_Record is
+       record
+          ID               : integer := 0;
+          Code             : Transaction_Code := Debit;
+          Priority         : Transaction_Priority := High;
+          Account_Number   : integer := 0;
+          Stock_Number     : integer := 0;
+          Quantity         : integer := 0;
+          Return_Value     : integer := 0;
+          Message_Count    : integer := 0;          -- for test
+          Time_Stamp       : Ada.Calendar.Time := Base_Time;
+       end record;
+ 
+ 
+    task type Message_Task is
+       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+    end Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is
+       entry Start;
+    end Line_Driver;
+ 
+    task Distributor is
+       entry Input (Transaction : acc_Transaction_Record);
+       entry Wait_for_Underload (Transaction : acc_Transaction_Record);
+       entry TC_Credit_OK;
+    end Distributor;
+ 
+    task Credit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Debit_Computation;
+ 
+ 
+    -- Mechanism to count the number of Message tasks completed (Credit)
+    protected body TC_Tasks_Completed is
+       procedure Increment is
+       begin
+          Number_Complete := Number_Complete + 1;
+       end Increment;
+ 
+       function Count return integer is
+       begin
+          return Number_Complete;
+       end Count;
+    end TC_Tasks_Completed;
+ 
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each. The message tasks remain extant
+    --   for the life of the messages in the system.
+    --      The Line Driver task would normally be designed to loop continuously
+    --      creating the messages as input is received.  Simulate this
+    --      but limit it to the required number of dummy messages needed for
+    --      this test and allow it to terminate at that point.  Artificially
+    --      alternate High and Low priority Credit transactions for this test.
+    --
+    task body Line_Driver is
+       Current_ID       : integer := 1;
+       Current_Priority : Transaction_Priority := High;
+ 
+       -- Artificial: number of messages required for this test
+       type TC_Trans_Range is range 1..6;
+ 
+       procedure Build_Credit_Record
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 100;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Credit;
+             Next_Transaction.Priority := Current_Priority;
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Credit_Record;
+ 
+ 
+       procedure Build_Debit_Record
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 200;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Debit;
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Debit_Record;
+ 
+    begin
+ 
+       accept Start;   -- Wait for trigger from Main
+ 
+       for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
+          declare
+             -- Create a task for the next message
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+             -- Create a record for it
+             Next_Transaction : acc_Transaction_Record
+                                                  := new Transaction_Record;
+          begin
+             if Transaction_Numb = TC_Trans_Range'first then
+                -- Send the first Credit message
+                Build_Credit_Record ( Next_Transaction );
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );
+                -- TC: Wait until the first message has been received by the
+                -- Credit task and it has set the Overload indicator for the
+                -- Distributor
+                while not TC_First_Message_Has_Arrived.Value loop
+                   delay ImpDef.Minimum_Task_Switch;
+                end loop;
+             elsif Transaction_Numb = TC_Trans_Range'last then
+                -- For this test send the last transaction to the Debit task
+                -- to improve the mix
+                Build_Debit_Record( Next_Transaction );
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );
+             else
+                -- TC: Alternate high and low priority transactions
+                if Current_Priority = High then
+                   Current_Priority := Low;
+                else
+                   Current_Priority := High;
+                end if;
+                Build_Credit_Record( Next_Transaction );
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );
+             end if;
+          end;   -- declare
+       end loop;
+ 
+       -- TC: Wait for Credit_Overloaded to be cleared, then insure that the
+       -- Distributor has evalated all tasks. Otherwise, some tasks may never
+       -- be evaluated.
+       while Credit_Overloaded.Value loop
+         delay ImpDef.Minimum_Task_Switch;
+       end loop;
+       Distributor.TC_Credit_OK;
+ 
+    exception
+       when others =>
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+ 
+ 
+ 
+    task body Message_Task is
+ 
+       TC_Original_Transaction_Code : Transaction_Code;
+       This_Transaction : acc_Transaction_Record := new Transaction_Record;
+ 
+    begin
+ 
+       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+          This_Transaction.all := In_Transaction.all;
+       end Accept_Transaction;
+ 
+       -- Note the original code to ensure correct return
+       TC_Original_Transaction_Code := This_Transaction.Code;
+ 
+       -- Queue up on Distributor's Input queue
+       Distributor.Input ( This_Transaction );
+       -- This task will now wait for the requeued rendezvous
+       -- to complete before proceeding
+ 
+       -- After the required computations have been performed
+       -- return the Transaction_Record appropriately (probably to an output
+       -- line driver)
+       null;            -- stub
+ 
+       -- For the test check that the return values are as expected
+       if TC_Original_Transaction_Code /= This_Transaction.Code then
+          -- Incorrect rendezvous
+          Report.Failed ("Message Task: Incorrect code returned");
+       end if;
+ 
+       if This_Transaction.Code = Credit then
+          if This_Transaction.Return_Value  /= Credit_Return or
+             This_Transaction.Time_Stamp     = Base_Time     then
+                Report.Failed ("Expected path not traversed");
+          end if;
+             TC_Tasks_Completed.Increment;
+       else
+          if This_Transaction.Return_Value  /= Debit_Return or
+             This_Transaction.Message_Count /= 1             or
+             This_Transaction.Time_Stamp     = Base_Time     then
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Debit_Message_Complete.Set_True;
+       end if;
+ 
+    exception
+       when others =>
+          Report.Failed ("Unexpected exception in Message_Task");
+ 
+    end Message_Task;
+ 
+ 
+ 
+ 
+    -- Dispose each input Transaction_Record to the appropriate
+    -- computation tasks
+    --
+    task body Distributor is
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Time_Stamp the messages with the current time
+                --    TC: Used, incidentally, by the test to check that the
+                --    message did pass through the Distributor Task
+                Transaction.Time_Stamp := Ada.Calendar.Clock;
+ 
+                -- Pass this transaction on to the appropriate computation
+                -- task but temporarily hold low-priority transactions under
+                -- overload conditions
+                case Transaction.Code is
+                   when Credit =>
+                      if Credit_Overloaded.Value and
+                         Transaction.Priority = Low then
+                         requeue Wait_for_Underload with abort;
+                      else
+                         requeue Credit_Computation.Input with abort;
+                      end if;
+                   when Debit =>
+                      requeue Debit_Computation.Input with abort;
+                end case;
+             end Input;
+          or
+             when not Credit_Overloaded.Value =>
+             accept Wait_for_Underload (Transaction : acc_Transaction_Record) do
+                requeue Credit_Computation.Input with abort;
+             end Wait_for_Underload;
+          or
+             accept TC_Credit_OK;
+                -- We need this to insure that we evaluate the guards at least
+                -- once when Credit_Overloaded is False. Otherwise, tasks
+                -- could stay queued on Wait_for_Underload forever (starvation).
+          or
+             terminate;
+          end select;
+       end loop;
+ 
+    exception
+       when others =>
+          Report.Failed ("Unexpected exception in Distributor");
+    end Distributor;
+ 
+ 
+ 
+    -- Computation task.  After the computation is performed the rendezvous
+    -- in the original message task is completed.
+    --
+    task body Credit_Computation is
+ 
+       Message_Count   : integer := 0;
+ 
+    begin
+       loop
+          select
+             accept Input ( Transaction : acc_Transaction_Record) do
+                if Credit_Overloaded.Value and
+                   Transaction.Priority = Low then
+                   -- We should not be getting any Low Priority messages. They
+                   -- should be waiting on the Distributor's Wait_for_Underload
+                   -- queue
+                   Report.Failed
+                      ("Credit Task: Low priority transaction during overload");
+                end if;
+                -- Perform the computations required for this transaction
+                null; -- stub
+ 
+                -- For the test:
+                if Transaction.Time_Stamp = Base_Time then
+                   Report.Failed
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Credit then
+                   Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- The following is all Test Control code:
+                Transaction.Return_Value := Credit_Return;
+                Message_Count := Message_Count + 1;
+                --
+                -- Now take special action depending on which Message
+                if Message_Count = 1 then
+                   -- After the first message :
+                   Credit_Overloaded.Set_True;
+                   -- Now flag the Line_Driver that the second and subsequent
+                   -- messages may now be sent
+                   TC_First_Message_Has_Arrived.Set_True;
+                end if;
+                if Message_Count = 3 then
+                   -- The two high priority transactions created subsequent
+                   -- to the overload have now been processed
+                   Credit_Overloaded.Set_False;
+                end if;
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others =>
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+ 
+ 
+    -- Computation task.  After the computation is performed the rendezvous
+    -- in the original message task is completed.
+    --
+    task body Debit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this message
+                null;      -- stub
+ 
+                -- For the test:
+                if Transaction.Time_Stamp = Base_Time then
+                   Report.Failed
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Debit then
+                   Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Debit_Return;
+                -- one, and only one, message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.Message_Count := Message_Count;
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others =>
+          Report.Failed ("Unexpected exception in Debit_Computation");
+ 
+ 
+    end Debit_Computation;
+ 
+ 
+ begin -- c954012
+    Report.Test ("C954012", "Requeue within an accept body" &
+                            " to another entry in the same task");
+ 
+    Line_Driver.Start;  -- Start the test
+ 
+    -- Ensure that the message tasks complete before reporting the result
+    while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected)
+          or (not TC_Debit_Message_Complete.Value) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954012;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,521 ----
+ -- C954013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a requeue is cancelled and that the requeuing task is
+ --      unaffected when the calling task is aborted. 
+ --      Specifically, check requeue to an entry in a different task,
+ --      requeue where the entry has parameters, and requeue with abort.
+ --
+ -- TEST DESCRIPTION:
+ --      Abort a task that has a call requeued to the entry queue of another
+ --      task.  We do this by sending two messages to the Distributor which 
+ --      requeues them to the Credit task.  In the accept body of the Credit 
+ --      task we wait for the second message to arrive then check that an 
+ --      abort of the second message task does result in the requeue being 
+ --      removed.  The Line Driver task which generates the messages and the 
+ --      Credit task communicate artificially in this test to arrange for the 
+ --      proper timing of the messages and the abort.  One extra message is 
+ --      sent to the Debit task to ensure that the Distributor is still viable
+ --      and has been unaffected by the abort.
+ --
+ --      This series of tests uses a simulation of a transaction driven 
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then 
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system.  The message tasks put themselves on the 
+ --      input queue of a Distributor which, from information in the 
+ --      transaction and/or system load conditions forwards them to other 
+ --      operating tasks. These in turn might forward the transactions to yet 
+ --      other tasks for further action.  The routing is, in real life, dynamic
+ --      and unpredictable at the time of message generation.  All rerouting in
+ --      this  model is done by means of requeues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      25 Nov 95   SAIC    Fixed shared global variable problems for
+ --                          ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+          
+ procedure C954013 is
+  
+ 
+    -- Arbitrary test values
+    Credit_Return : constant := 1;
+    Debit_Return  : constant := 2;
+ 
+ 
+    protected type Shared_Boolean (Initial_Value : Boolean := False) is
+       procedure Set_True;
+       procedure Set_False;
+       function  Value return Boolean;
+    private
+       Current_Value : Boolean := Initial_Value;
+    end Shared_Boolean;
+ 
+    protected body Shared_Boolean is
+       procedure Set_True is
+       begin
+          Current_Value := True;
+       end Set_True;
+ 
+       procedure Set_False is
+       begin
+          Current_Value := False;
+       end Set_False;
+ 
+       function Value return Boolean is
+       begin
+          return Current_Value;
+       end Value;
+    end Shared_Boolean;
+  
+ 
+    TC_Debit_Message_Complete  : Shared_Boolean (False);
+    TC_Credit_Message_Complete : Shared_Boolean (False);
+ 
+ 
+    type Transaction_Code is (Credit, Debit);
+ 
+    type Transaction_Record;
+    type acc_Transaction_Record is access Transaction_Record;
+    type Transaction_Record is 
+       record
+          ID               : integer := 0;
+          Code             : Transaction_Code := Debit;
+          Account_Number   : integer := 0;
+          Stock_Number     : integer := 0;
+          Quantity         : integer := 0;
+          Return_Value     : integer := 0;
+          TC_Message_Count : integer := 0;
+          TC_Thru_Dist     : Boolean := false;
+       end record;
+ 
+    
+    task type Message_Task is 
+       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+    end Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is
+       entry Start;   
+    end Line_Driver;
+ 
+    task Distributor is 
+       entry Input(Transaction : acc_Transaction_Record);
+    end Distributor;
+ 
+    task Credit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Debit_Computation;
+ 
+    -- This protected object is here for Test Control purposes only
+    protected TC_Prt is 
+       procedure Set_First_Has_Arrived;
+       procedure Set_Second_Has_Arrived;
+       procedure Set_Abort_Has_Completed;
+       function  First_Has_Arrived   return Boolean;
+       function  Second_Has_Arrived  return Boolean;
+       function  Abort_Has_Completed return Boolean;
+    private 
+       First_Flag, Second_Flag, Abort_Flag : Boolean := false;
+    end TC_Prt;
+ 
+    protected body TC_Prt is
+ 
+       Procedure Set_First_Has_Arrived is
+       begin
+          First_Flag := true;
+       end Set_First_Has_Arrived;
+ 
+       Procedure Set_Second_Has_Arrived is
+       begin
+          Second_Flag := true;
+       end Set_Second_Has_Arrived;
+ 
+       Procedure Set_Abort_Has_Completed is
+       begin
+          Abort_Flag := true;
+       end Set_Abort_Has_Completed;
+    
+       Function First_Has_Arrived return boolean is
+       begin
+          return First_Flag;
+       end First_Has_Arrived;
+ 
+       Function Second_Has_Arrived return boolean is
+       begin
+          return Second_Flag;
+       end Second_has_Arrived;
+ 
+       Function Abort_Has_Completed return boolean is
+       begin
+          return Abort_Flag;
+       end Abort_Has_Completed;
+    
+    end TC_PRT;
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each. The message tasks remain extant
+    --   for the life of the messages in the system.
+    --      TC: The Line Driver task would normally be designed to loop
+    --      continuously creating the messages as input is received.  Simulate
+    --      this  but limit it to three dummy messages for this test and use
+    --      special artificial checks to pace the messages out under controlled
+    --      conditions for the test; allow it to terminate at the end
+    --
+    task body Line_Driver is
+       Current_ID : integer := 1;
+       TC_First_message_sent: Boolean := false;
+ 
+       procedure Build_Credit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 100;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Credit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Credit_Record;     
+ 
+ 
+       procedure Build_Debit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 200;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Debit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Debit_Record;     
+ 
+    begin
+       
+       accept Start;       -- Wait for trigger from main
+ 
+       for i in 1..3 loop  -- TC: arbitrarily limit to two credit messages
+                           --     and one debit, then complete
+          declare 
+             -- Create a task for the next message
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+             -- Create a record for it
+             Next_Transaction : acc_Transaction_Record :=
+                                                        new Transaction_Record;
+          begin
+             if not TC_First_Message_Sent then
+                -- send out the first message to start up the Credit task
+                Build_Credit_Record ( Next_Transaction );            
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                TC_First_Message_Sent := true;
+             elsif not TC_Prt.Abort_Has_Completed then
+                -- We have not yet processed the second message
+                -- Wait to send the second message until we know the first
+                -- has arrived at the Credit task and that task is in the 
+                -- accept body 
+                while not TC_Prt.First_Has_Arrived loop
+                   delay ImpDef.Minimum_Task_Switch;   
+                end loop;
+ 
+                -- We can now send the second message
+                Build_Credit_Record( Next_Transaction );
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                
+                -- Now wait for the second to arrive on the Credit input queue
+                while not TC_Prt.Second_Has_Arrived loop
+                   delay ImpDef.Minimum_Task_Switch;   
+                end loop;
+                
+                -- At this point: The Credit task is in the accept block 
+                -- dealing with the first message and the second message is
+                -- is on the input queue
+                abort Next_Message_Task.all;  -- Note: we are still in the 
+                                              -- declare block for the 
+                                              -- second message task
+ 
+                -- Make absolutely certain that all the actions
+                -- associated with the abort have been completed, that the
+                -- task has gone from Abnormal right through to
+                -- Termination.  All requeues that are to going to be
+                -- cancelled will have been by the point of Termination.
+                while not Next_Message_Task.all'terminated loop
+                   delay ImpDef.Minimum_Task_Switch;   
+                end loop;
+ 
+ 
+                -- We now signal the Credit task that the abort has taken place
+                -- so that it can check that the entry queue is empty as the
+                -- requeue should have been cancelled
+                TC_Prt.Set_Abort_Has_Completed;
+             else
+                -- The main part of the test is complete. Send one Debit message
+                -- as further exercise of the Distributor to ensure it has not
+                -- been affected by the cancellation of the requeue.
+                Build_Debit_Record ( Next_Transaction );            
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+             end if;
+          end;   -- declare
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+    
+ 
+ 
+    task body Message_Task is
+ 
+       TC_Original_Transaction_Code : Transaction_Code;  
+       This_Transaction : acc_Transaction_Record := new Transaction_Record;
+ 
+    begin
+       
+       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+          This_Transaction.all := In_Transaction.all;
+       end Accept_Transaction;      
+ 
+       -- Note the original code to ensure correct return
+       TC_Original_Transaction_Code := This_Transaction.Code;
+                                                                   
+       -- Queue up on Distributor's Input queue
+       Distributor.Input ( This_Transaction );
+       -- This task will now wait for the requeued rendezvous 
+       -- to complete before proceeding
+                                              
+       -- After the required computations have been performed
+       -- return the Transaction_Record appropriately (probably to an output
+       -- line driver)
+       null;            -- stub
+       
+       -- For the test check that the return values are as expected
+       if TC_Original_Transaction_Code /= This_Transaction.Code then
+          -- Incorrect rendezvous
+          Report.Failed ("Message Task: Incorrect code returned");
+       end if;
+ 
+       if This_Transaction.Code = Credit then
+          if This_Transaction.Return_Value     /= Credit_Return or   
+             This_Transaction.TC_Message_Count /= 1             or not
+             This_Transaction.TC_Thru_Dist                      then 
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Credit_Message_Complete.Set_True;
+       else
+          if This_Transaction.Return_Value     /= Debit_Return  or   
+             This_Transaction.TC_Message_Count /= 1             or not
+             This_Transaction.TC_Thru_Dist                      then 
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Debit_Message_Complete.Set_True;
+       end if;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Message_Task");
+ 
+    end Message_Task;
+ 
+ 
+ 
+    -- Dispose each input Transaction_Record to the appropriate
+    -- computation tasks
+    --
+    task body Distributor is
+ 
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Show that this message did pass through the Distributor Task
+                Transaction.TC_Thru_Dist := true;
+ 
+                -- Pass this transaction on the appropriate computation
+                -- task
+                case Transaction.Code is 
+                   when Credit =>
+                      requeue Credit_Computation.Input with abort;
+                   when Debit => 
+                      requeue Debit_Computation.Input with abort;
+                end case;
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Distributor");
+    end Distributor;
+                                           
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    task body Credit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select 
+             accept Input ( Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this transaction
+                --
+                null;     -- stub
+ 
+                -- The rest of this code is for Test Control
+                --
+                if not Transaction.TC_Thru_Dist then 
+                   Report.Failed 
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Credit then
+                   Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Credit_Return;
+                -- one, and only one message should pass through
+                if Message_Count /= 0 then
+                   Report.Failed ("Aborted Requeue was not cancelled -1");
+                end if;
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+          
+                
+                -- Having done the basic housekeeping we now need to signal
+                -- that we are in the accept body of the credit task.  The
+                -- first message has arrived and the Line Driver may now send
+                -- the second one
+                TC_Prt.Set_First_Has_Arrived;
+ 
+                -- Now wait for the second to arrive
+ 
+                while Input'Count = 0 loop
+                   delay ImpDef.Minimum_Task_Switch;   
+                end loop;
+                -- Second message has been requeued - the Line driver may 
+                -- now abort the calling task
+                TC_Prt.Set_Second_Has_Arrived;
+ 
+                -- Now wait for the Line Driver to signal that the abort of
+                -- the first task is complete - the requeue should be cancelled
+                -- at this time
+                while not TC_Prt.Abort_Has_Completed loop
+                   delay ImpDef.Minimum_Task_Switch;   
+                end loop;
+                
+                if Input'Count /=0 then
+                   Report.Failed ("Aborted Requeue was not cancelled -2");
+                end if;
+                -- We can now complete the rendezvous with the first caller
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    task body Debit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this message
+                --
+                null;      -- stub
+ 
+                -- The rest of this code is for Test Control
+                --
+                if not Transaction.TC_Thru_Dist then 
+                   Report.Failed 
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Debit then
+                   Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Debit_Return;
+                -- one, and only one, message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Debit_Computation");
+ 
+ 
+    end Debit_Computation;
+ 
+ 
+ begin -- c954013
+ 
+    Report.Test ("C954013", "Abort a task that has a call requeued");
+ 
+    Line_Driver.Start;   -- start the test
+ 
+    -- Wait for the message tasks to complete before calling Report.Result.
+    -- Although two Credit tasks are generated one is aborted so only
+    -- one completes, thus a single flag is sufficient
+    -- Note: the test will hang here if there is a problem with the 
+    -- completion of the tasks
+    while not (TC_Credit_Message_Complete.Value and 
+               TC_Debit_Message_Complete.Value) loop
+       delay ImpDef.Minimum_Task_Switch;   
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954013;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954014.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954014.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954014.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,485 ----
+ -- C954014.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that a requeue is not canceled and that the requeueing 
+ --     task is unaffected when a calling task is aborted. Check that the
+ --     abort is deferred until the entry call is complete.
+ --     Specifically, check requeue to an entry in a different task,
+ --     requeue where the entry call has parameters, and requeue
+ --     without the abort option.
+ --
+ -- TEST DESCRIPTION
+ --     In the Driver create a task that places a call on the
+ --     Distributor.  In the Distributor requeue this call on the Credit task.
+ --     Abort the calling task when it is known to be in rendezvous with the
+ --     Credit task. (We arrange this by using artificial synchronization
+ --     points in the Driver and the accept body of the Credit task) Ensure
+ --     that the abort is deferred (the task is not terminated) until the
+ --     accept body completes.   Afterwards, send one extra message through
+ --     the Distributor to check that the requeueing task has not been
+ --     disrupted. 
+ --
+ --     This series of tests uses a simulation of a transaction driven
+ --     processing system.  Line Drivers accept input from an external source
+ --     and build them into transaction records.  These records are then
+ --     encapsulated in message tasks which remain extant for the life of the
+ --     transaction in the system.  The message tasks put themselves on the
+ --     input queue of a Distributor which, from information in the
+ --     transaction and/or system load conditions forwards them to other
+ --     operating tasks. These in turn might forward the transactions to yet
+ --     other tasks for further action.  The routing is, in real life, dynamic
+ --     and unpredictable at the time of message generation.  All rerouting in
+ --     this  model is done by means of requeues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      25 Nov 95   SAIC    Replaced global variables with protected objects
+ --                          for ACVC 2.0.1.
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+          
+ procedure C954014 is
+  
+    -- Arbitrary test values
+    Credit_Return : constant := 1;
+    Debit_Return  : constant := 2;
+ 
+ 
+    protected type Shared_Boolean (Initial_Value : Boolean := False) is
+       procedure Set_True;
+       procedure Set_False;
+       function  Value return Boolean;
+    private
+       Current_Value : Boolean := Initial_Value;
+    end Shared_Boolean;
+ 
+    protected body Shared_Boolean is
+       procedure Set_True is
+       begin
+          Current_Value := True;
+       end Set_True;
+ 
+       procedure Set_False is
+       begin
+          Current_Value := False;
+       end Set_False;
+ 
+       function Value return Boolean is
+       begin
+          return Current_Value;
+       end Value;
+    end Shared_Boolean;
+  
+ 
+    TC_Debit_Message_Complete  : Shared_Boolean (False);
+    
+    -- Synchronization flags for handshaking between the Line_Driver
+    -- and the Accept body in the Credit Task
+    TC_Handshake_A : Shared_Boolean (False);
+    TC_Handshake_B : Shared_Boolean (False);
+    TC_Handshake_C : Shared_Boolean (False);
+    TC_Handshake_D : Shared_Boolean (False);
+    TC_Handshake_E : Shared_Boolean (False);
+    TC_Handshake_F : Shared_Boolean (False);
+ 
+ 
+    type Transaction_Code is (Credit, Debit);
+ 
+    type Transaction_Record;
+    type acc_Transaction_Record is access Transaction_Record;
+    type Transaction_Record is 
+       record
+          ID               : integer := 0;
+          Code             : Transaction_Code := Debit;
+          Account_Number   : integer := 0;
+          Stock_Number     : integer := 0;
+          Quantity         : integer := 0;
+          Return_Value     : integer := 0;
+          TC_Message_Count : integer := 0; 
+          TC_Thru_Distrib  : Boolean;
+       end record;
+ 
+    
+    task type Message_Task is 
+       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+    end Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is
+       entry start;
+    end Line_Driver;   
+ 
+    task Distributor is 
+       entry Input(Transaction : acc_Transaction_Record);
+    end Distributor;
+ 
+    task Credit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Debit_Computation;
+ 
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each. The message tasks remain extant
+    --   for the life of the messages in the system.
+    --      TC: The Line Driver task would normally be designed to loop
+    --      continuously creating the messages as input is received.  Simulate
+    --      this  but limit it to two dummy messages for this test and use
+    --      special artificial handshaking checks with the Credit accept body
+    --      to control the test. Allow it to terminate at the end
+    --
+    task body Line_Driver is
+       Current_ID : integer := 1;
+       TC_First_message_sent: Boolean := false;
+ 
+       procedure Build_Credit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 100;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Credit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Credit_Record;     
+ 
+ 
+       procedure Build_Debit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 200;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Debit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Debit_Record;     
+ 
+    begin
+    
+       accept Start;       -- Wait for trigger from main
+ 
+       for i in 1..2 loop  -- TC: arbitrarily limit to one credit message
+                           --     and one debit, then complete
+          declare 
+             -- Create a task for the next message
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+             -- Create a record for it
+             Next_Transaction : acc_Transaction_Record := 
+                                                    new Transaction_Record;
+          begin
+             if not TC_First_Message_Sent then
+                -- send out the first message which will be aborted
+                Build_Credit_Record ( Next_Transaction );            
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                TC_First_Message_Sent := true;
+ 
+                -- Wait for Credit task to get into the accept body
+                --   The call from the Message Task has been requeued by
+                --   the distributor
+                while not TC_Handshake_A.Value loop
+                   delay ImpDef.Minimum_Task_Switch;
+                end loop;
+ 
+                -- Abort the calling task; the Credit task is guaranteed to 
+                -- be in the accept body
+                abort Next_Message_Task.all;     -- We are still in this declare
+                                                 -- block
+               
+                -- Inform the Credit task that the abort has been initiated
+                TC_Handshake_B.Set_True;
+                
+                -- Now wait for the "acknowledgment" from the Credit task
+                -- this ensures a complete task switch (at least) 
+                while not TC_Handshake_C.Value loop
+                   delay ImpDef.Minimum_Task_Switch;
+                end loop;
+ 
+                -- The aborted task must not terminate till the accept body
+                -- has completed
+                if Next_Message_Task'terminated then
+                   Report.Failed ("The abort was not deferred");
+                end if;
+ 
+                -- Inform the Credit task that the termination has been checked
+                TC_Handshake_D.Set_True;
+                
+                -- Now wait for the completion of the accept body in the 
+                -- Credit task
+                while not TC_Handshake_E.Value loop
+                   delay ImpDef.Minimum_Task_Switch;
+                end loop;
+                
+                while not ( Next_Message_Task'terminated ) loop
+                   delay ImpDef.Minimum_Task_Switch;
+                end loop;
+ 
+                -- Indicate to the Main program that this section is complete
+                TC_Handshake_F.Set_True;
+ 
+             else
+                -- The main part of the test is complete. Send one Debit message
+                -- as further exercise of the Distributor to ensure it has not
+                -- been affected by the abort of the requeue;
+                Build_Debit_Record ( Next_Transaction );            
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+             end if;
+          end;   -- declare
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+    
+ 
+    task body Message_Task is
+ 
+       TC_Original_Transaction_Code : Transaction_Code;  
+       This_Transaction : acc_Transaction_Record := new Transaction_Record;
+ 
+    begin
+       
+       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+          This_Transaction.all := In_Transaction.all;
+       end Accept_Transaction;      
+ 
+       -- Note the original code to ensure correct return
+       TC_Original_Transaction_Code := This_Transaction.Code;
+                                                                   
+       -- Queue up on Distributor's Input queue
+       Distributor.Input ( This_Transaction );
+       -- This task will now wait for the requeued rendezvous 
+       -- to complete before proceeding
+                                              
+       -- After the required computations have been performed
+       -- return the Transaction_Record appropriately (probably to an output
+       -- line driver)
+       null;            -- stub
+       
+       -- For the test check that the return values are as expected
+       if TC_Original_Transaction_Code /= This_Transaction.Code then
+          -- Incorrect rendezvous
+          Report.Failed ("Message Task: Incorrect code returned");
+       end if;
+ 
+       if This_Transaction.Code = Credit then
+          -- The only Credit message was the one that should have been aborted
+          Report.Failed ("Abort was not effective");
+       else
+          if This_Transaction.Return_Value     /= Debit_Return or   
+             This_Transaction.TC_Message_Count /= 1            or not
+             This_Transaction.TC_Thru_Distrib       then
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Debit_Message_Complete.Set_True;
+       end if;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Message_Task");
+ 
+    end Message_Task;
+ 
+ 
+ 
+    -- Dispose each input Transaction_Record to the appropriate 
+    -- computation tasks
+    --
+    task body Distributor is
+ 
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+ 
+                -- Indicate that the  message did pass through the
+                -- Distributor Task
+                Transaction.TC_Thru_Distrib := true;
+ 
+                -- Pass this transaction on the appropriate computation
+                -- task
+                case Transaction.Code is 
+                   when Credit =>
+                      requeue Credit_Computation.Input;   -- without abort
+                   when Debit => 
+                      requeue Debit_Computation.Input;    -- without abort
+                end case;
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Distributor");
+    end Distributor;
+                                           
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    task body Credit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select 
+             accept Input ( Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this transaction
+                --
+                null;     -- stub
+ 
+                -- The rest of this code is for Test Control
+                --
+                if not Transaction.TC_Thru_Distrib then
+                   Report.Failed 
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Credit then
+                   Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Credit_Return;
+                -- one, and only one message should pass through
+                if Message_Count /= 0 then
+                   Report.Failed ("Aborted Requeue was not canceled -1");
+                end if;
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+                         
+                -- Having done the basic housekeeping we now need to signal
+                -- that we are in the accept body of the credit task.  The
+                -- message has arrived and the Line Driver may now abort the
+                -- calling task
+                TC_Handshake_A.Set_True;
+ 
+                -- Now wait for the Line Driver to inform us the calling 
+                -- task has been aborted
+                while not TC_Handshake_B.Value loop
+                   delay ImpDef.Minimum_Task_Switch;
+                end loop;
+ 
+                -- The abort has taken place
+                -- Inform the Line Driver that we are still running in the
+                -- accept body
+                TC_Handshake_C.Set_True;
+ 
+                -- Now wait for the Line Driver to digest this information
+                while not TC_Handshake_D.Value loop
+                   delay ImpDef.Minimum_Task_Switch;
+                end loop;
+ 
+                -- The Line driver has checked that the caller is not terminated
+                -- We can now complete the accept
+                
+             end Input;
+             -- We are out of the accept
+             TC_Handshake_E.Set_True; 
+                    
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    task body Debit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this message
+                --
+                null;      -- stub
+ 
+                -- The rest of this code is for Test Control
+                --
+                if not Transaction.TC_Thru_Distrib then
+                   Report.Failed 
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Debit then
+                   Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Debit_Return;
+                -- one, and only one, message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Debit_Computation");
+ 
+ 
+    end Debit_Computation;
+ 
+ 
+ begin -- c954014
+    Report.Test ("C954014", "Abort a task that has a call" &
+                                           " requeued_without_abort");
+ 
+    Line_Driver.Start;   -- Start the test
+ 
+    -- Wait for the message tasks to complete before reporting the result
+    --
+    while not (TC_Handshake_F.Value                  -- abort not effective?
+               and TC_Debit_Message_Complete.Value   -- Distributor affected?
+               and TC_Handshake_E.Value ) loop       -- accept not completed?
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954014;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954015.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954015.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954015.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,549 ----
+ -- C954015.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that requeued calls to task entries may, in turn, be requeued.  
+ --      Check that the intermediate requeues are not blocked and that the
+ --      original caller remains blocked until the last requeue is complete.
+ --         This test uses: 
+ --                      Call with parameters
+ --                      Requeue with abort
+ --      
+ -- TEST DESCRIPTION
+ --      A call is placed on the input queue of the Distributor.  The
+ --      Distributor requeues to the Credit task; the Credit task requeues to a
+ --      secondary task which, in turn requeues to yet another task.  This
+ --      continues down the chain.  At the furthest point of the chain the
+ --      rendezvous is completed.  To verify the action, the furthest task
+ --      waits in the accept statement for a second message to arrive before
+ --      completing.  This second message can only arrive if none of the earlier
+ --      tasks in the chain are blocked waiting for completion.   Apart from
+ --      the two Credit messages which are used to check the requeue chain one
+ --      Debit message is sent to validate the mix.
+ --
+ --                                                    
+ --      This series of tests uses a simulation of a transaction driven
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system.  The message tasks put themselves on the
+ --      input queue of a Distributor which, from information in the
+ --      transaction and/or system load conditions forwards them to other
+ --      operating tasks. These in turn might forward the transactions to yet
+ --      other tasks for further action.  The routing is, in real life, dynamic
+ --      and unpredictable at the time of message generation.  All rerouting in
+ --      this  model is done by means of requeues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with Report;
+ with ImpDef;
+          
+ procedure C954015 is
+  
+    -- Arbitrary test values
+    Credit_Return : constant := 1;
+    Debit_Return  : constant := 2;
+ 
+    -- Mechanism to count the number of Credit Message tasks completed
+    protected TC_Tasks_Completed is
+       procedure Increment;
+       function  Count return integer;
+    private
+       Number_Complete : integer := 0;
+    end TC_Tasks_Completed;
+    
+    TC_Expected_To_Complete   : constant integer := 3;
+ 
+ 
+    -- Values added to the Return_Value indicating passage through the
+    -- particular task
+    TC_Credit_Value :  constant integer := 1;
+    TC_Sub_1_Value  :  constant integer := 2;
+    TC_Sub_2_Value  :  constant integer := 3;
+    TC_Sub_3_Value  :  constant integer := 4;
+    TC_Sub_4_Value  :  constant integer := 5;
+    --
+    TC_Full_Value   :  integer := TC_Credit_Value + TC_Sub_1_Value + 
+                                  TC_Sub_2_Value  + TC_Sub_3_Value +
+                                  TC_Sub_4_Value;
+ 
+    type Transaction_Code is (Credit, Debit);
+ 
+    type Transaction_Record;
+    type acc_Transaction_Record is access Transaction_Record;
+    type Transaction_Record is 
+       record
+          ID               : integer := 0;
+          Code             : Transaction_Code := Debit;
+          Account_Number   : integer := 0;
+          Stock_Number     : integer := 0;
+          Quantity         : integer := 0;
+          Return_Value     : integer := 0;
+          TC_Message_Count : integer := 0;
+          TC_Thru_Distrib  : Boolean := false;
+       end record;
+ 
+ 
+    task type Message_Task is 
+       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+    end Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is
+       entry Start;
+    end Line_Driver;   
+ 
+    task Distributor is 
+       entry Input(Transaction : acc_Transaction_Record);
+    end Distributor;
+ 
+    task Credit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Debit_Computation;
+ 
+    -- The following are almost identical for the purpose of the test
+    task Credit_Sub_1 is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Sub_1;
+    --
+    task Credit_Sub_2 is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Sub_2;
+    --
+    task Credit_Sub_3 is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Sub_3;
+ 
+    -- This is the last in the chain
+    task Credit_Sub_4 is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Sub_4;
+   
+    
+    -- Mechanism to count the number of Message tasks completed (Credit)
+    protected body TC_Tasks_Completed is
+       procedure Increment is
+       begin
+          Number_Complete := Number_Complete + 1;
+       end Increment;
+ 
+       function Count return integer is
+       begin
+          return Number_Complete;
+       end Count;
+    end TC_Tasks_Completed;
+ 
+ 
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each. The message tasks remain extant
+    --   for the life of the messages in the system.
+    --      The Line Driver task would normally be designed to loop continuously
+    --      creating the messages as input is received.  Simulate this 
+    --      but limit it to the number of dummy messages needed for this 
+    --      test and allow it to terminate at that point. 
+    --
+    task body Line_Driver is
+       Current_ID : integer := 1;
+       TC_Last_was_for_credit : Boolean := false;
+ 
+        -- Arbitrary limit for the number of messages sent for this test
+       type TC_Trans_Range is range 1..3;
+ 
+       procedure Build_Credit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 100;
+       begin
+          Next_Transaction.ID := Current_ID;
+          Next_Transaction.Code := Credit; 
+          Next_Transaction.Account_Number := Dummy_Account;
+          Current_ID := Current_ID + 1;
+       end Build_Credit_Record;     
+ 
+       procedure Build_Debit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 200;
+       begin
+          Next_Transaction.ID := Current_ID;
+          Next_Transaction.Code := Debit; 
+          Next_Transaction.Account_Number := Dummy_Account;
+          Current_ID := Current_ID + 1;
+       end Build_Debit_Record;     
+ 
+ 
+    begin
+ 
+       accept Start;   -- wait for trigger from Main
+       
+       -- Arbitrarily limit the loop to the number needed for this test only
+       for Transaction_Numb in TC_Trans_Range  loop
+          declare 
+             -- Create a task for the next message
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+             -- Create a record for it
+             Next_Transaction : acc_Transaction_Record := 
+                                                 new Transaction_Record;
+          begin
+             -- Artificially send out in the order required
+             case Transaction_Numb is
+                when 1 => 
+                   Build_Credit_Record( Next_Transaction );
+                when 2 =>
+                   Build_Credit_Record( Next_Transaction );
+                when 3 =>
+                   Build_Debit_Record ( Next_Transaction );            
+             end case;
+ 
+             -- Present the record to the message task
+             Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+          end;   -- declare
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+ 
+ 
+    task body Message_Task is
+ 
+       TC_Original_Transaction_Code : Transaction_Code;  
+       This_Transaction : acc_Transaction_Record := new Transaction_Record;
+ 
+    begin
+       
+       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+          This_Transaction.all := In_Transaction.all;
+       end Accept_Transaction;
+ 
+       -- Note the original code to ensure correct return
+       TC_Original_Transaction_Code := This_Transaction.Code;
+  
+       -- Queue up on Distributor's Input queue
+       Distributor.Input ( This_Transaction );
+       -- This task will now wait for the requeued rendezvous 
+       -- to complete before proceeding
+ 
+       -- After the required computations have been performed
+       -- return the Transaction_Record appropriately (probably to an output
+       -- line driver)
+       null;            -- stub
+ 
+       
+       -- The following is all Test Control Code
+ 
+       -- Check that the return values are as expected
+       if TC_Original_Transaction_Code /= This_Transaction.Code then
+          -- Incorrect rendezvous
+          Report.Failed ("Message Task: Incorrect code returned");
+       end if;
+ 
+       if This_Transaction.Code = Credit then
+          if This_Transaction.Return_Value  /= TC_Full_Value or not  
+             This_Transaction.TC_Thru_Distrib       then
+                Report.Failed ("Expected path not traversed - CR");
+          end if;
+          if 
+             This_Transaction.TC_Message_Count not in 1..2 then
+                Report.Failed ("Incorrect Message Count");
+          end if;
+       else
+          if This_Transaction.Return_Value  /= Debit_Return or   
+             This_Transaction.TC_Message_Count /= 1            or not
+             This_Transaction.TC_Thru_Distrib     then
+                Report.Failed ("Expected path not traversed - DB");
+          end if;
+       end if;
+       TC_Tasks_Completed.Increment;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Message_Task");
+ 
+    end Message_Task;
+ 
+ 
+ 
+    -- Dispose each input Transaction_Record to the appropriate 
+    -- computation tasks
+    --
+    task body Distributor is
+ 
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Show that the message did pass through the Distributor Task
+                Transaction.TC_Thru_Distrib := true;
+ 
+                -- Pass this transaction on to the appropriate computation
+                -- task
+                case Transaction.Code is 
+                   when Credit =>
+                      requeue Credit_Computation.Input with abort;
+                   when Debit => 
+                      requeue Debit_Computation.Input with abort;
+                end case;
+             end Input;
+          or
+             terminate;
+          end select;
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Distributor");
+    end Distributor;
+                                           
+ 
+ 
+                                                 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task the message is
+    --   passed on for further processing to some subsidiary task.  The choice
+    --   of subsidiary task is made according to criteria not specified in
+    --   this test.  
+    --                                           
+    task body Credit_Computation is
+       Message_Count   : integer := 0;   
+    begin
+       loop
+          select 
+             accept Input ( Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this transaction
+                null;      -- stub
+ 
+                -- For the test: 
+                if not Transaction.TC_Thru_Distrib then
+                   Report.Failed 
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Credit then
+                   Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test, plug a known value and count
+                Transaction.Return_Value := TC_Credit_Value;
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+ 
+                -- Depending on transaction content send it on to the
+                -- some other task for further processing
+                -- TC: Arbitrarily send the message on to Credit_Sub_1
+                requeue Credit_Sub_1.Input with abort;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+ 
+ 
+    task body Credit_Sub_1 is
+    begin
+       loop
+          select
+             accept Input(Transaction : acc_Transaction_Record) do
+                -- Process this transaction
+                null;   -- stub
+             
+                -- Add the value showing passage through this task
+                Transaction.Return_Value := 
+                                     Transaction.Return_Value + TC_Sub_1_Value;
+                -- Depending on transaction content send it on to the
+                -- some other task for further processing
+                -- Arbitrarily send the message on to Credit_Sub_2
+                requeue Credit_Sub_2.Input with abort;  
+             end Input;
+          or 
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Sub_1");
+ 
+    end Credit_Sub_1;
+ 
+    task body Credit_Sub_2 is
+    begin
+       loop
+          select
+             accept Input(Transaction : acc_Transaction_Record) do
+                -- Process this transaction
+                null;   -- stub
+             
+                -- Add the value showing passage through this task
+                Transaction.Return_Value := 
+                                     Transaction.Return_Value + TC_Sub_2_Value;
+                -- Depending on transaction content send it on to the
+                -- some other task for further processing
+                -- Arbitrarily send the message on to Credit_Sub_3
+                requeue Credit_Sub_3.Input with abort;  
+             end Input;
+          or 
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Sub_2");
+    end Credit_Sub_2;
+ 
+    task body Credit_Sub_3 is
+    begin
+       loop
+          select
+             accept Input(Transaction : acc_Transaction_Record) do
+                -- Process this transaction
+                null;   -- stub
+             
+                -- Add the value showing passage through this task
+                Transaction.Return_Value := 
+                                     Transaction.Return_Value + TC_Sub_3_Value;
+                -- Depending on transaction content send it on to the
+                -- some other task for further processing
+                -- Arbitrarily send the message on to Credit_Sub_4
+                requeue Credit_Sub_4.Input with abort;  
+             end Input;
+          or 
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Sub_3");
+    end Credit_Sub_3;
+ 
+    -- This is the last in the chain of tasks to which transactions will
+    -- be requeued
+    --
+    task body Credit_Sub_4 is
+    
+       TC_First_Message : Boolean := true;
+ 
+    begin
+       loop
+          select
+             accept Input(Transaction : acc_Transaction_Record) do
+                -- Process this transaction
+                null;   -- stub
+             
+                -- Add the value showing passage through this task
+                Transaction.Return_Value := 
+                                     Transaction.Return_Value + TC_Sub_4_Value;
+                -- TC: stay in the accept body dealing with the first message
+                -- until the second arrives.  If any of the requeues are 
+                -- blocked the test will hang here indicating failure
+                if TC_First_Message then
+                   while Input'count = 0 loop
+                      delay ImpDef.Minimum_Task_Switch;
+                   end loop;
+                TC_First_Message := false;
+                end if;
+                -- for the second message, just complete the rendezvous
+             end Input;
+          or 
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Sub_4");
+    end Credit_Sub_4;
+ 
+ 
+                                                 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    --                                                
+    task body Debit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this message
+                null;      -- stub
+ 
+                -- For the test: 
+                if not Transaction.TC_Thru_Distrib then
+                   Report.Failed 
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Debit then
+                   Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Debit_Return;
+                -- one, and only one, message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Debit_Computation");
+ 
+ 
+    end Debit_Computation;
+ 
+ 
+ begin 
+ 
+    Report.Test ("C954015", "Test multiple levels of requeue to task entry");
+ 
+    Line_Driver.Start;  -- Start the test
+ 
+    -- Ensure that the message tasks completed before calling Result
+    while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954015;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954016.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954016.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954016.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,182 ----
+ -- C954016.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that when a task that is called by a requeue is aborted, the 
+ --      original caller receives Tasking_Error and the requeuing task is 
+ --      unaffected.
+ --
+ -- TEST DESCRIPTION:
+ --      The Intermediate task requeues a call from the Original_Caller to the
+ --      Receiver.  While the Receiver is in the accept body for this
+ --      rendezvous the Main aborts it.  Check that Tasking_Error is raised in
+ --      the Original_Caller, that the Receiver does, indeed, get aborted and
+ --      the Intermediate task is undisturbed.
+ --      There are several delay loops in this test any one of which could 
+ --      cause it to hang which would constitute failure.  
+ --      
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      25 Nov 95   SAIC    Replaced shared global variable with protected
+ --                          object for ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C954016 is
+ 
+    TC_Original_Caller_Complete  : Boolean := false;
+    TC_Intermediate_Complete     : Boolean := false;
+ 
+ 
+    protected type Shared_Boolean (Initial_Value : Boolean := False) is
+       procedure Set_True;
+       procedure Set_False;
+       function  Value return Boolean;
+    private
+       Current_Value : Boolean := Initial_Value;
+    end Shared_Boolean;
+ 
+    protected body Shared_Boolean is
+       procedure Set_True is
+       begin
+          Current_Value := True;
+       end Set_True;
+ 
+       procedure Set_False is
+       begin
+          Current_Value := False;
+       end Set_False;
+ 
+       function Value return Boolean is
+       begin
+          return Current_Value;
+       end Value;
+    end Shared_Boolean;
+  
+    TC_Receiver_in_Accept        : Shared_Boolean (False);
+ 
+ 
+    task Original_Caller is
+       entry Start;
+    end Original_Caller;
+ 
+    task Intermediate is
+       entry Input;
+       entry TC_Abort_Process_Complete;
+    end Intermediate;
+    
+    task Receiver is
+       entry Input;
+       entry TC_Never_Called;
+    end Receiver;
+ 
+    
+    task body Original_Caller is
+    begin 
+       accept Start;    -- wait for the trigger from Main
+ 
+       Intermediate.Input;
+       Report.Failed ("Tasking_Error not raised in Original_Caller task");
+ 
+    exception
+       when tasking_error => 
+                TC_Original_Caller_Complete := true;     -- expected behavior
+       when others        => 
+                Report.Failed ("Unexpected Exception in Original_Caller task");
+    end Original_Caller;
+    
+    
+    task body Intermediate is
+    begin
+       accept Input do
+          -- Within this accept call another task
+          requeue Receiver.Input with abort;
+       end Input;
+ 
+       -- Wait for Main to ensure that the abort housekeeping is finished
+       accept TC_Abort_Process_Complete;
+ 
+       TC_Intermediate_Complete := true;
+ 
+    exception
+       when others => 
+                 Report.Failed ("Unexpected exception in Intermediate task");
+    end Intermediate;
+ 
+ 
+    task body Receiver is
+    begin
+       accept Input do
+          TC_Receiver_in_Accept.Set_True;
+          -- Hang within the accept body to allow Main to abort this task
+          accept TC_Never_Called;  
+       end Input;
+    exception
+       when others  =>
+             Report.Failed ("Unexpected Exception in Receiver Task");
+                                                           
+    end Receiver;
+    
+    
+ begin
+    Report.Test ("C954016", "Requeue: abort the called task");
+ 
+    Original_Caller.Start;
+ 
+    -- Wait till the rendezvous with Receiver is started
+    while not TC_Receiver_in_Accept.Value loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    -- At this point the Receiver is guaranteed to be in its accept
+    --
+    abort Receiver;
+ 
+    -- Wait for the whole of the abort process to complete
+    while not ( Original_Caller'terminated and Receiver'terminated ) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    -- Inform the Intermediate task that the process is complete to allow
+    -- it to continue to completion itself
+    Intermediate.TC_Abort_Process_Complete;
+ 
+    -- Wait for everything to settle before reporting the result
+    while not ( Intermediate'terminated ) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+ 
+    if not ( TC_Original_Caller_Complete and TC_Intermediate_Complete ) then
+       Report.Failed ("Proper paths not traversed");
+    end if;
+ 
+    Report.Result;
+ 
+ end C954016;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954017.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954017.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954017.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954017.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,184 ----
+ -- C954017.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that when an exception is raised in the rendezvous of a task 
+ --      that was called by a requeue the exception is propagated to the 
+ --      original caller and that the requeuing task is unaffected.  
+ --
+ -- TEST DESCRIPTION:
+ --      The Intermediate task requeues a call from the Original_Caller to the
+ --      Receiver.  While the Receiver is in the accept body for this
+ --      rendezvous a Constraint_Error exception is raised.  Check that the 
+ --      exception is propagated to the Original_Caller, that the Receiver's 
+ --      normal exception logic is employed and that the Intermediate task
+ --      is undisturbed.
+ --      There are several delay loops in this test any one of which could 
+ --      cause it to hang (and thus fail).
+ --      
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      25 Nov 95   SAIC    Fixed shared global variable problem for
+ --                          ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ 
+ procedure C954017 is
+ 
+    TC_Original_Caller_Complete   : Boolean := false;
+    TC_Intermediate_Complete      : Boolean := false;
+    TC_Receiver_Complete          : Boolean := false;
+    TC_Exception                  : Exception;
+ 
+ 
+    protected type Shared_Boolean (Initial_Value : Boolean := False) is
+       procedure Set_True;
+       procedure Set_False;
+       function  Value return Boolean;
+    private
+       Current_Value : Boolean := Initial_Value;
+    end Shared_Boolean;
+ 
+    protected body Shared_Boolean is
+       procedure Set_True is
+       begin
+          Current_Value := True;
+       end Set_True;
+ 
+       procedure Set_False is
+       begin
+          Current_Value := False;
+       end Set_False;
+ 
+       function Value return Boolean is
+       begin
+          return Current_Value;
+       end Value;
+    end Shared_Boolean;
+  
+    TC_Exception_Process_Complete : Shared_Boolean (False);
+ 
+    task Original_Caller is
+       entry Start;
+    end Original_Caller;
+ 
+    task Intermediate is
+       entry Input;
+    end Intermediate;
+    
+    task Receiver is
+       entry Input;
+    end Receiver;
+ 
+    
+    task body Original_Caller is
+    begin 
+       accept Start;    -- wait for the trigger from Main
+ 
+       Intermediate.Input;
+       Report.Failed ("Exception not propagated to Original_Caller");
+ 
+    exception
+       when TC_Exception => 
+                TC_Original_Caller_Complete := true;     -- Expected behavior
+       when others        => 
+                Report.Failed ("Unexpected Exception in Original_Caller task");
+    end Original_Caller;
+    
+    
+    task body Intermediate is
+    begin
+       accept Input do
+          -- Within this accept call another task
+          requeue Receiver.Input with abort;
+       end Input;
+ 
+       -- Wait for Main to ensure that the exception housekeeping is finished
+       while not TC_Exception_Process_Complete.Value loop
+          delay ImpDef.Minimum_Task_Switch;
+       end loop;
+ 
+       TC_Intermediate_Complete := true;
+ 
+    exception
+       when others => 
+                   Report.Failed ("Unexpected exception in Intermediate task");
+    end Intermediate;
+ 
+ 
+    task body Receiver is
+    --
+    begin
+       accept Input do
+          null;  -- the user code for the rendezvous is stubbed out
+ 
+          -- Test Control: Raise an exception in the destination task which
+          -- should then be propagated
+          raise TC_Exception;
+ 
+       end Input;
+    exception
+       when TC_Exception =>
+             TC_Receiver_Complete := true;  -- expected behavior
+       when others        =>
+             Report.Failed ("Unexpected Exception in Receiver Task");
+    end Receiver;
+    
+    
+ begin
+ 
+    Report.Test ("C954017", "Requeue: exception processing");
+ 
+    Original_Caller.Start;   -- Start the test after the Report.Test
+    
+    -- Wait for the whole of the exception process to complete
+    while not ( Original_Caller'terminated and Receiver'terminated ) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    -- Inform the Intermediate task that the process is complete to allow
+    -- it to continue to completion itself
+    TC_Exception_Process_Complete.Set_True;
+ 
+    -- Wait for everything to settle before reporting the result
+    while not ( Intermediate'terminated ) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+ 
+    if not ( TC_Original_Caller_Complete and 
+             TC_Intermediate_Complete    and
+             TC_Receiver_Complete)       then
+       Report.Failed ("Proper paths not traversed");
+    end if;
+ 
+    Report.Result;
+ 
+ end C954017;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954018.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954018.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954018.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954018.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,227 ----
+ -- C954018.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a task is aborted while a requeued call is queued 
+ --      on one of its entries the original caller receives Tasking_Error
+ --      and the requeuing task is unaffected.
+ --         This test uses: Requeue to an entry in a different task
+ --                         Parameterless call
+ --                         Requeue with abort
+ --
+ -- TEST DESCRIPTION:
+ --      The Intermediate task requeues a call from the Original_Caller to the
+ --      Receiver on an entry with a guard that is always false.  While the 
+ --      Original_Caller is still queued the Receiver is aborted.
+ --      Check that Tasking_Error is raised in the Original_Caller, that the 
+ --      Receiver does, indeed, get aborted and the Intermediate task 
+ --      is undisturbed.
+ --      There are several delay loops in this test any one of which could 
+ --      cause it to hang and thus indicate failure.  
+ --      
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ 
+ procedure C954018 is
+ 
+ 
+    -- Protected object to control the shared test variables
+    --
+    protected TC_State is
+       function  On_Entry_Queue return Boolean;
+       procedure Set_On_Entry_Queue; 
+       function  Original_Caller_Complete return Boolean;
+       procedure Set_Original_Caller_Complete;
+       function  Intermediate_Complete return Boolean;
+       procedure Set_Intermediate_Complete;
+    private
+       On_Entry_Queue_Flag           : Boolean := false;
+       Original_Caller_Complete_Flag : Boolean := false;
+       Intermediate_Complete_Flag    : Boolean := false;
+    end TC_State;
+    --
+    --
+    protected body TC_State is
+       function On_Entry_Queue return Boolean is
+       begin 
+          return On_Entry_Queue_Flag;
+       end On_Entry_Queue;
+       
+       procedure Set_On_Entry_Queue is
+       begin
+          On_Entry_Queue_Flag := true; 
+       end Set_On_Entry_Queue; 
+ 
+       function Original_Caller_Complete return Boolean is
+       begin
+          return Original_Caller_Complete_Flag;
+       end Original_Caller_Complete;
+ 
+       procedure Set_Original_Caller_Complete is
+       begin
+          Original_Caller_Complete_Flag := true;
+       end Set_Original_Caller_Complete;
+ 
+       function Intermediate_Complete return Boolean is
+       begin
+          return Intermediate_Complete_Flag;
+       end Intermediate_Complete;
+ 
+       procedure Set_Intermediate_Complete is
+       begin
+          Intermediate_Complete_Flag := true;
+       end Set_Intermediate_Complete;
+ 
+    end TC_State;
+ 
+    --================================
+ 
+    task Original_Caller is
+       entry Start;
+    end Original_Caller;
+ 
+    task Intermediate is
+       entry Input;
+       entry TC_Abort_Process_Complete;
+    end Intermediate;
+    
+    task Receiver is
+       entry Input;
+    end Receiver;
+ 
+    
+    task body Original_Caller is
+    begin 
+       accept Start;    -- wait for the trigger from Main
+ 
+       Intermediate.Input;
+       Report.Failed ("Tasking_Error not raised in Original_Caller task");
+ 
+    exception
+       when tasking_error => 
+                TC_State.Set_Original_Caller_Complete; -- expected behavior
+       when others        => 
+                Report.Failed ("Unexpected Exception in Original_Caller task");
+    end Original_Caller;
+    
+    
+    task body Intermediate is
+    begin
+       accept Input do
+          -- Within this accept call another task
+          TC_State.Set_On_Entry_Queue;
+          requeue Receiver.Input with abort;  
+          Report.Failed ("Requeue did not complete the Accept");
+       end Input;
+ 
+       -- Wait for Main to ensure that the abort housekeeping is finished
+       accept TC_Abort_Process_Complete;
+ 
+       TC_State.Set_Intermediate_Complete;
+ 
+    exception
+       when others => 
+               Report.Failed ("Unexpected exception in Intermediate task");
+    end Intermediate;
+ 
+ 
+    task body Receiver is
+    begin
+       loop
+          select
+             -- A call to Input will be placed on the queue and never serviced
+             when Report.Equal (1,2) =>     -- Always false
+             accept Input do
+                Report.Failed ("Receiver in Accept");  
+             end Input;
+          or 
+             delay ImpDef.Minimum_Task_Switch;
+          end select;
+       end loop;
+    exception
+       when others =>
+             Report.Failed ("Unexpected Exception in Receiver Task");
+                                                           
+    end Receiver;
+    
+    
+ begin
+ 
+    Report.Test ("C954018", "Requeue: abort the called task" &
+                            " while Caller is still queued");
+ 
+    Original_Caller.Start;
+ 
+ 
+    -- This is the main part of the test  
+ 
+    -- Wait for the requeue
+    while not TC_State.On_Entry_Queue loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+    -- Delay long enough to ensure that the requeue has "arrived" on 
+    -- the entry queue.  Note: TC_State.Set_On_Entry_Queue is called the
+    -- statement before the requeue
+    --
+    delay ImpDef.Switch_To_New_Task;
+ 
+    -- At this point the Receiver is guaranteed to have the requeue on
+    -- the entry queue
+    --
+    abort Receiver;
+    
+    -- Wait for the whole of the abort process to complete
+    while not ( Original_Caller'terminated and Receiver'terminated ) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+ 
+ 
+    -- Inform the Intermediate task that the process is complete to allow
+    -- it to continue to completion itself
+    Intermediate.TC_Abort_Process_Complete;
+ 
+    -- Wait for everything to settle before reporting the result
+    while not ( Intermediate'terminated ) loop
+       delay ImpDef.Minimum_Task_Switch;
+    end loop;
+    
+ 
+    if not ( TC_State.Original_Caller_Complete and 
+             TC_State.Intermediate_Complete )       then
+       Report.Failed ("Proper paths not traversed");
+    end if;
+ 
+    Report.Result;
+ 
+ end C954018;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954019.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954019.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954019.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954019.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,314 ----
+ -- C954019.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that when a requeue is to the same entry the items go to the
+ --      right queue and that they are placed back on the end of the queue.
+ --
+ -- TEST DESCRIPTION:
+ --      Simulate part of a message handling application where the messages are
+ --      composed of several segments.  The sequence of the segments within the
+ --      message is specified by Seg_Sequence_No.   The segments are handled by
+ --      different tasks  and finally forwarded to an output driver.  The
+ --      segments can arrive in any order but must be assembled into the proper
+ --      sequence for final output.  There is a Sequencer task interposed
+ --      before the Driver.  This takes the segments of the message off the
+ --      Ordering_Queue and those that are in the right order it sends on to
+ --      the driver; those that are out of order it places back on the end of
+ --      the queue.
+ --
+ --      The test just simulates the arrival of the segments at the Sequencer.
+ --      The task generating the segments handshakes with the Sequencer during
+ --      the  "Await Arrival" phase  ensuring that the three segments of a
+ --      message arrive in REVERSE order (the End-of-Message segment arrives
+ --      first and the Header last).  In the first cycle the sequencer pulls
+ --      segments off the queue and puts them back on the end till it
+ --      encounters the header.  It checks the sequence of the ones it pulls
+ --      off in case the segments are being put back on in the wrong part of
+ --      the queue. Having cycled once through it no longer verifies the
+ --      sequence - it just executes the "application" code for the correct
+ --      order for dispatch to the driver.
+ -- 
+ --      In this simple example no attempt is made to address segments of
+ --      another message arriving or any other error conditions (such as
+ --      missing segments, timing etc.)
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      19 Dec 94   SAIC    Remove parameter from requeue statement
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C954019 is
+ begin
+ 
+ 
+    Report.Test ("C954019", "Check Requeue to the same Accept");
+    
+    declare  -- encapsulate the test
+ 
+       type Segment_Sequence is range 1..8;
+       Header : constant Segment_Sequence := Segment_Sequence'first;
+ 
+       type Message_Segment is record
+          ID              : integer;            -- Message ID
+          Seg_Sequence_No : Segment_Sequence;   -- Within the message
+          Alpha           : string (1..128);
+          EOM             : Boolean := false;   -- true for final msg segment
+       end record;
+       type acc_Message_Segment is access Message_Segment;
+ 
+       task TC_Simulate_Arrival;
+    
+       task type Carrier_Task is
+          entry Input ( Segment : acc_Message_Segment );
+       end Carrier_Task;
+       type acc_Carrier_Task is access Carrier_Task;
+    
+       task Sequencer is
+          entry Ordering_Queue ( Segment : acc_Message_Segment );
+          entry TC_Handshake_1;
+          entry TC_Handshake_2;
+       end Sequencer;
+    
+       task Output_Driver is
+          entry Input ( Segment : acc_Message_Segment );
+       end Output_Driver;
+    
+ 
+       -- Simulate the arrival of three message segments in REVERSE order
+       --
+       task body TC_Simulate_Arrival is
+          begin
+ 
+             for i in 1..3 loop
+                declare
+                   -- Create a task for the next message segment
+                   Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
+                   -- Create a record for the next segment
+                   Next_Segment : acc_Message_Segment := new Message_Segment;
+                begin
+                   if i = 1 then 
+                      -- Build the EOM segment as the first to "send"
+                      Next_Segment.Seg_Sequence_No := Header + 2;
+                      Next_Segment.EOM := true;
+                   elsif i = 2 then
+                      -- Wait for the first segment to arrive at the Sequencer
+                      -- before "sending" the second
+                      Sequencer.TC_Handshake_1;
+                      -- Build the segment
+                      Next_Segment.Seg_Sequence_No := Header + 1;
+                   else 
+                      -- Wait for the second segment to arrive at the Sequencer
+                      -- before "sending" the third
+                      Sequencer.TC_Handshake_2;
+                      -- Build the segment. The last segment in order to 
+                      -- arrive will be the "header" segment
+                      Next_Segment.Seg_Sequence_No := Header;
+                   end if;
+                   -- pass the record to its carrier
+                   Next_Segment_Task.Input ( Next_Segment );
+                end;
+             end loop;
+       exception
+          when others => 
+               Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
+       end TC_Simulate_Arrival;
+    
+ 
+       -- One of these is generated for each message segment and the flow 
+       -- of the segments through the system is controlled by the calls the
+       -- task makes and the requeues of those calls
+       --
+       task body Carrier_Task is
+          This_Segment : acc_Message_Segment := new Message_Segment;
+       begin
+          accept Input ( Segment : acc_Message_Segment ) do
+             This_Segment.all := Segment.all;
+          end Input;
+          null; --:: stub.  Pass the segment around the application as needed
+ 
+          -- Now output the segment to the Output_Driver.  First we have to 
+          -- go through the Sequencer.  
+          Sequencer.Ordering_Queue ( This_Segment );
+       exception
+          when others => 
+               Report.Failed ("Unexpected Exception in Carrier_Task");
+       end Carrier_Task;
+    
+ 
+       -- Pull segments off the Ordering_Queue and deliver them in the correct
+       -- sequence to the Output_Driver.
+       --
+       task body Sequencer is
+          Next_Needed : Segment_Sequence := Header;
+    
+          TC_Await_Arrival     : Boolean := true;
+          TC_First_Cycle       : Boolean := true;  
+          TC_Expected_Sequence : Segment_Sequence := Header+2;
+       begin
+          loop
+             select
+                accept Ordering_Queue ( Segment : acc_Message_Segment ) do
+ 
+                   --=====================================================
+                   -- This part is all Test_Control code
+ 
+                   if TC_Await_Arrival then
+                      -- We have to arrange that the segments arrive on the 
+                      -- queue in the right order, so we handshake with the 
+                      -- TC_Simulate_Arrival task to "send" only one at 
+                      -- a time
+                      accept TC_Handshake_1;   -- the first  has arrived
+                                               -- and has been pulled off the
+                                               -- queue
+ 
+                      -- Wait for the second to arrive (the first has already
+                      -- been pulled off the queue
+                      while Ordering_Queue'count < 1 loop
+                         delay ImpDef.Minimum_Task_Switch;
+                      end loop;
+                      --
+                      accept TC_Handshake_2;   -- the second has arrived
+ 
+                      -- Wait for the third to arrive
+                      while Ordering_Queue'count < 2 loop
+                         delay ImpDef.Minimum_Task_Switch;
+                      end loop;
+ 
+                      -- Subsequent passes through the loop, bypass this code
+                      TC_Await_Arrival := false; 
+                               
+ 
+                   end if; -- await arrival
+ 
+                   if TC_First_Cycle then 
+                      -- Check the order of the original three 
+                      if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+                         -- The segments are not being pulled off in the 
+                         -- expected sequence.  This could occur if the 
+                         -- requeue is not putting them back on the end.
+                         Report.Failed ("Sequencer: Segment out of sequence");
+                      end if; -- sequence check
+                      -- Decrement the expected sequence
+                      if TC_Expected_Sequence /= Header then
+                         TC_Expected_Sequence := TC_Expected_Sequence - 1;
+                      else 
+                         TC_First_Cycle := false; -- This is the Header - the
+                                                  -- first two segments are
+                                                  -- back on the queue
+                                                  
+                      end if; -- decrementing
+                   end if; -- first pass
+                   --=====================================================
+ 
+                   -- And this is the Application code
+                   if Segment.Seg_Sequence_No = Next_Needed then
+                      if Segment.EOM then
+                         Next_Needed := Header;  -- reset for next message
+                      else
+                         Next_Needed := Next_Needed + 1;
+                      end if;
+                      requeue Output_Driver.Input with abort;
+                      Report.Failed ("Requeue did not complete accept body");
+                   else
+                      -- Not the next needed - put it back on the queue
+                      requeue Sequencer.Ordering_Queue;
+                      Report.Failed ("Requeue did not complete accept body");
+                   end if;   
+                end Ordering_Queue;
+             or
+                terminate;
+             end select;
+          end loop;
+       exception
+          when others => 
+               Report.Failed ("Unexpected Exception in Sequencer");
+       end Sequencer;
+    
+ 
+       task body Output_Driver is
+          This_Segment : acc_Message_Segment := new Message_Segment;
+ 
+          TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
+          TC_Segment_Total     : integer := 0;
+          TC_Expected_Total    : integer := 3;
+       begin
+          loop
+             -- Note: normally we would expect this Accept to be in a select 
+             -- with terminate.  For the test we exit the loop on completion
+             -- to give better control
+             accept Input ( Segment : acc_Message_Segment ) do 
+                This_Segment.all := Segment.all;
+             end Input;
+    
+             null;  --::: stub - output the next segment of the message
+ 
+             -- The following is all test control code
+             --
+             if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+                Report.Failed ("Output_Driver: Segment out of sequence");
+             end if;
+             TC_Expected_Sequence := TC_Expected_Sequence + 1;
+ 
+             -- Now count the number of segments
+             TC_Segment_Total := TC_Segment_Total + 1;
+ 
+             -- Check the number and exit loop when complete
+             -- There must be exactly TC_Expected_Total in number and
+             --    the last one must be EOM
+             --    (test will hang if < TC_Expected_Total arrive
+             --    without EOM)
+             if This_Segment.EOM then
+                -- This is the last segment.
+                if TC_Segment_Total /= TC_Expected_Total then
+                   Report.Failed ("EOM and wrong number of segments");
+                end if;
+                exit;   -- the loop and terminate the task
+             elsif TC_Segment_Total = TC_Expected_Total then
+                Report.Failed ("No EOM found");
+                exit;
+             end if;
+          end loop;
+       exception
+          when others => 
+               Report.Failed ("Unexpected Exception in Output_Driver");
+       end Output_Driver;
+ 
+ 
+ 
+    begin  
+ 
+       null;
+ 
+    end; -- encapsulation
+ 
+    Report.Result;
+    
+ end C954019;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954020.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954020.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954020.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,422 ----
+ -- C954020.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a call to a protected entry can be requeued to a task
+ --      entry. Check that the requeue is placed on the correct entry; that the
+ --      original caller waits for the completion of the requeue and continues
+ --      after the requeued rendezvous.  Check that the requeue does not block.
+ --      Specifically, check a requeue with abort from a protected entry to
+ --      an entry in a task.
+ --
+ -- TEST DESCRIPTION:
+ --
+ --      In the Distributor protected object, requeue two successive calls on
+ --      the entries of two separate target tasks.  Each task in each of the 
+ --      paths adds identifying information in the transaction being passed. 
+ --      This information is checked by the Message tasks on completion
+ --      ensuring that the requeues have been placed on the correct queues.
+ --      There is an artificial guard on the Credit Task to ensure that the
+ --      input is queued; this guard is released by the Debit task which 
+ --      handles its input immediately.  This ensures that we have one of the
+ --      requeued items actually queued for later handling and also verifies
+ --      that the requeuing process (in the protected object) is not blocked.
+ --
+ --      This series of tests uses a simulation of a transaction driven 
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then 
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system. The message tasks put themselves on the 
+ --      input queue of a Distributor object which, from information in the
+ --      transaction and/or system load conditions forwards them to other 
+ --      operating tasks. These in turn might forward the transactions to yet 
+ --      other tasks for further action.  The routing is, in real life, 
+ --      dynamic and unpredictable at the time of message generation. All 
+ --      rerouting in this  model is done by means of requeues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      06 Nov 95   SAIC    Fixed problems for ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+          
+ procedure C954020 is
+    Verbose : constant Boolean := False;
+  
+    -- Arbitrary test values
+    Credit_Return : constant := 1;
+    Debit_Return  : constant := 2;
+ 
+    protected type Message_Status is
+       procedure Set_Complete;
+       function Complete return Boolean;
+    private
+       Is_Complete : Boolean := False;
+    end Message_Status;
+ 
+    protected body Message_Status is
+       procedure Set_Complete is
+       begin
+          Is_Complete := True;
+       end Set_Complete;
+ 
+       function Complete return Boolean is
+       begin
+          return Is_Complete;
+       end Complete;
+    end Message_Status;
+ 
+    TC_Debit_Message : Message_Status;
+    TC_Credit_Message : Message_Status;
+ 
+    type Transaction_Code is (Credit, Debit);
+ 
+    type Transaction_Record;
+    type acc_Transaction_Record is access Transaction_Record;
+    type Transaction_Record is 
+       record
+          ID               : integer := 0;
+          Code             : Transaction_Code := Debit;
+          Account_Number   : integer := 0;
+          Stock_Number     : integer := 0;
+          Quantity         : integer := 0;
+          Return_Value     : integer := 0;
+          TC_Message_Count : integer := 0; 
+          TC_Thru_Dist     : Boolean := false;
+       end record;
+ 
+ 
+    task type Message_Task is 
+       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+    end Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is 
+       entry Start;
+    end Line_Driver;   
+ 
+    task Credit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Debit_Computation;
+ 
+    protected Time_Lock is
+       procedure Credit_Start;
+       function  Credit_Enabled return Boolean;
+    private
+       Credit_OK : Boolean := false;
+    end Time_Lock;
+ 
+    protected body Time_Lock is
+       procedure Credit_Start is
+       begin
+          Credit_OK := true;
+       end Credit_Start;
+ 
+       function  Credit_Enabled return Boolean is 
+       begin
+          return Credit_OK;
+       end Credit_Enabled;
+    end Time_Lock;
+ 
+ 
+ 
+    protected Distributor is
+       entry Input (Transaction : acc_Transaction_Record);
+    end Distributor;
+    --
+    --
+    -- Dispose each input Transaction_Record to the appropriate
+    -- computation tasks
+    --
+    protected body Distributor is
+       entry Input (Transaction : acc_Transaction_Record) when true is
+                                                       -- barrier is always open
+       begin
+          -- Test Control: Set the indicator in the message to show it has
+          -- passed through the Distributor object
+          Transaction.TC_thru_Dist := true;
+              
+          -- Pass this transaction on to the appropriate computation
+          -- task
+          case Transaction.Code is
+             when Credit =>
+                requeue Credit_Computation.Input with abort;
+             when Debit =>
+                requeue Debit_Computation.Input with abort;
+          end case;
+       end Input;
+    end Distributor;
+ 
+ 
+ 
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each. The message tasks remain extant
+    --   for the life of the messages in the system.
+    --      The Line Driver task would normally be designed to loop continuously
+    --      creating the messages as input is received.  Simulate this 
+    --      but limit it to two dummy messages for this test and allow it
+    --      to terminate at that point
+    --
+    task body Line_Driver is
+       Current_ID : integer := 1;
+       TC_Last_was_for_credit : Boolean := false;
+ 
+       procedure Build_Credit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 100;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Credit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Credit_Record;     
+ 
+ 
+       procedure Build_Debit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 200;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Debit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Debit_Record;     
+ 
+    begin
+ 
+       accept Start;      -- Wait for trigger from Main
+ 
+       for i in 1..2 loop  -- arbitrarily limit to two messages for the test
+          declare 
+             -- Create a task for the next message
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+             -- Create a record for it
+             Next_Transaction : acc_Transaction_Record 
+                                                  := new Transaction_Record;
+          begin
+             if TC_Last_was_for_credit then
+                Build_Debit_Record ( Next_Transaction );            
+             else
+                Build_Credit_Record( Next_Transaction );
+                TC_Last_was_for_credit := true;
+             end if;
+             Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+          end;   -- declare
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+    
+ 
+ 
+    task body Message_Task is
+ 
+       TC_Original_Transaction_Code : Transaction_Code;  
+       This_Transaction : acc_Transaction_Record := new Transaction_Record;
+ 
+    begin
+       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+          This_Transaction.all := In_Transaction.all;
+       end Accept_Transaction;
+ 
+       if Verbose then
+          Report.Comment ("message task got " &
+                          Transaction_Code'Image (This_Transaction.Code));
+       end if;
+ 
+       -- Note the original code to ensure correct return
+       TC_Original_Transaction_Code := This_Transaction.Code;
+  
+       -- Queue up on Distributor's Input queue
+       Distributor.Input ( This_Transaction );
+       -- This task will now wait for the requeued rendezvous 
+       -- to complete before proceeding
+ 
+       -- After the required computations have been performed
+       -- return the Transaction_Record appropriately (probably to an output
+       -- line driver)
+       null;            -- stub
+ 
+       
+       -- The following is all Test Control Code
+ 
+       -- Check that the return values are as expected
+       if TC_Original_Transaction_Code /= This_Transaction.Code then
+          -- Incorrect rendezvous
+          Report.Failed ("Message Task: Incorrect code returned");
+       end if;
+ 
+       if This_Transaction.Code = Credit then
+          if This_Transaction.Return_Value  /= Credit_Return or   
+             This_Transaction.TC_Message_Count /= 1          or 
+             not This_Transaction.TC_thru_Dist       then
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Credit_Message.Set_Complete;
+       else
+          if This_Transaction.Return_Value  /= Debit_Return or   
+             This_Transaction.TC_Message_Count /= 1         or 
+             not This_Transaction.TC_thru_Dist       then
+                Report.Failed ("Expected path not traversed");
+          end if;
+          TC_Debit_Message.Set_Complete;
+       end if;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Message_Task");
+ 
+    end Message_Task;
+ 
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    --                                           
+    task body Credit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select 
+             when  Time_Lock.Credit_enabled =>
+             accept Input ( Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this transaction
+                null;      -- stub
+ 
+                if Verbose then
+                   Report.Comment ("Credit_Computation in accept");
+                end if;
+ 
+                -- For the test: 
+                if not Transaction.TC_thru_Dist then
+                   Report.Failed 
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Credit then
+                   Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Credit_Return;
+                -- one, and only one message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+ 
+             end Input;            
+             exit;   -- only handle 1 transaction
+          else
+             -- poll until we can accept credit transaction
+             delay ImpDef.Clear_Ready_Queue;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+ 
+ 
+    -- Computation task.
+    --   Note:  After the computation is performed in this task and the 
+    --          accept body is completed the rendezvous in the original
+    --          message task is completed.                              
+    --                                                
+    task body Debit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this message
+                null;      -- stub
+ 
+                if Verbose then
+                   Report.Comment ("Debit_Computation in accept");
+                end if;
+ 
+                -- For the test: 
+                if not Transaction.TC_thru_Dist then
+                   Report.Failed
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Debit then
+                   Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Debit_Return;
+                -- one, and only one, message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+                -- for the test: once we have completed the only Debit
+                -- message release the Credit Messages which are queued
+                -- on the Credit Input queue
+                Time_Lock.Credit_Start;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Debit_Computation");
+ 
+ 
+    end Debit_Computation;
+ 
+ 
+ begin -- C954020
+ 
+    Report.Test ("C954020", "Requeue, with abort, from protected entry " &
+                                                          "to task entry");
+ 
+    Line_Driver.Start;        -- Start the test
+ 
+    -- Ensure that the message tasks complete before reporting the result
+    while not (TC_Credit_Message.Complete and TC_Debit_Message.Complete) loop
+       delay ImpDef.Minimum_Task_Switch;   
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954020;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954021.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954021.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954021.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,524 ----
+ -- C954021.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that a requeue within a protected entry to an entry in a
+ --     different protected object is queued correctly.
+ --
+ -- TEST DESCRIPTION: 
+ --      One transaction is sent through to check the paths. After processing
+ --      this the Credit task sets the "overloaded" indicator.  Once this
+ --      indicator is set the Distributor (a protected object) queues low
+ --      priority transactions on a Wait_for_Underload queue in another
+ --      protected object using a requeue. The Distributor still delivers high
+ --      priority transactions.  After two high priority transactions have been
+ --      processed by the Credit task it clears the overload condition.  The
+ --      low priority transactions should now be delivered. 
+ --     
+ --      This series of tests uses a simulation of a transaction driven
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system.  The message tasks put themselves on the
+ --      input queue of a Distributor which, from information in the
+ --      transaction and/or system load conditions forwards them to other
+ --      operating tasks. These in turn might forward the transactions to yet
+ --      other tasks for further action.  The routing is, in real life, dynamic
+ --      and unpredictable at the time of message generation.  All rerouting in
+ --      this  model is done by means of requeues.
+ --     
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      26 Nov 95   SAIC    Fixed shared global variable for ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+          
+ procedure C954021 is
+  
+    -- Arbitrary test values
+    Credit_Return : constant := 1;
+    Debit_Return  : constant := 2;
+ 
+ 
+    -- Mechanism to count the number of Credit Message tasks completed
+    protected TC_Tasks_Completed is
+       procedure Increment;
+       function  Count return integer;
+    private
+       Number_Complete : integer := 0;
+    end TC_Tasks_Completed;
+    
+    
+    TC_Credit_Messages_Expected  : constant integer := 5;
+ 
+    protected TC_Handshake is
+       procedure Set;
+       function First_Message_Arrived return Boolean;
+    private
+       Arrived_Flag : Boolean := false;
+    end TC_Handshake;
+ 
+    -- Handshaking mechanism between the Line Driver and the Credit task
+    -- 
+    protected body TC_Handshake is
+       --
+       procedure Set is
+       begin 
+          Arrived_Flag := true;
+       end Set;
+       --
+       function First_Message_Arrived return Boolean is
+       begin
+          return Arrived_Flag;
+       end First_Message_Arrived;
+       -- 
+    end TC_Handshake;
+ 
+ 
+    protected type Shared_Boolean (Initial_Value : Boolean := False) is
+       procedure Set_True;
+       procedure Set_False;
+       function  Value return Boolean;
+    private
+       Current_Value : Boolean := Initial_Value;
+    end Shared_Boolean;
+ 
+    protected body Shared_Boolean is
+       procedure Set_True is
+       begin
+          Current_Value := True;
+       end Set_True;
+ 
+       procedure Set_False is
+       begin
+          Current_Value := False;
+       end Set_False;
+ 
+       function Value return Boolean is
+       begin
+          return Current_Value;
+       end Value;
+    end Shared_Boolean;
+  
+    TC_Debit_Message_Complete    : Shared_Boolean (False);
+ 
+    type Transaction_Code is (Credit, Debit);
+    type Transaction_Priority is (High, Low);
+ 
+    type Transaction_Record;
+    type acc_Transaction_Record is access Transaction_Record;
+    type Transaction_Record is 
+       record
+          ID               : integer := 0;
+          Code             : Transaction_Code := Debit;
+          Priority         : Transaction_Priority := High;
+          Account_Number   : integer := 0;
+          Stock_Number     : integer := 0;
+          Quantity         : integer := 0;
+          Return_Value     : integer := 0;
+          TC_Message_Count : integer := 0;  
+          TC_Thru_Dist     : Boolean := false;
+       end record;
+ 
+ 
+    task type Message_Task is 
+       entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+    end Message_Task;
+    type acc_Message_Task is access Message_Task;
+ 
+    task Line_Driver is
+       entry Start;
+    end Line_Driver;
+ 
+    protected Distributor is
+       procedure Set_Credit_Overloaded;
+       procedure Clear_Credit_Overloaded;
+       function  Credit_is_Overloaded return Boolean;
+       entry     Input (Transaction : acc_Transaction_Record);
+    private
+       Credit_Overloaded : Boolean := false;
+    end Distributor;
+ 
+    protected Hold is
+       procedure Underloaded;
+       entry Wait_for_Underload (Transaction : acc_Transaction_Record);
+    private
+       Release_All : Boolean := false;
+    end Hold;
+ 
+    task Credit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Credit_Computation;
+ 
+    task Debit_Computation is
+       entry Input(Transaction : acc_Transaction_Record);
+    end Debit_Computation;
+ 
+    --
+    -- Dispose each input Transaction_Record to the appropriate
+    -- computation tasks
+    --
+    protected body Distributor is
+ 
+       procedure Set_Credit_Overloaded is
+       begin
+          Credit_Overloaded := true;
+       end Set_Credit_Overloaded;
+ 
+       procedure Clear_Credit_Overloaded is
+       begin
+          Credit_Overloaded := false;
+          Hold.Underloaded;       -- Release all held messages
+       end Clear_Credit_Overloaded;
+   
+       function  Credit_is_Overloaded return Boolean is
+       begin
+          return Credit_Overloaded;
+       end Credit_is_Overloaded;
+ 
+ 
+       entry Input (Transaction : acc_Transaction_Record) when true is
+                                                      -- barrier is always open
+       begin
+          -- Test Control: Set the indicator in the message to show it has
+          -- passed through the Distributor object
+          Transaction.TC_thru_Dist := true;
+  
+          -- Pass this transaction on to the appropriate computation
+          -- task but temporarily hold low-priority transactions under
+          -- overload conditions
+          case Transaction.Code is
+             when Credit =>
+                if Credit_Overloaded and Transaction.Priority = Low then
+                   requeue Hold.Wait_for_Underload with abort;
+                else
+                   requeue Credit_Computation.Input with abort;
+               end if;
+             when Debit =>
+               requeue Debit_Computation.Input with abort;
+          end case;
+       end Input;
+    end Distributor;
+ 
+ 
+    -- Low priority Message tasks are held on the Wait_for_Underload queue
+    -- while the Credit computation system is overloaded.  Once the Credit
+    -- system reached underload send all queued messages immediately
+    --
+    protected body Hold is
+       
+       -- Once this is executed the barrier condition for the entry is 
+       -- evaluated 
+       procedure Underloaded is
+       begin 
+          Release_All := true;
+       end Underloaded;
+ 
+       entry Wait_for_Underload (Transaction : acc_Transaction_Record)
+                                                      when Release_All is
+       begin
+          requeue Credit_Computation.Input with abort;
+          if Wait_for_Underload'count = 0 then
+             -- Queue is purged.  Set up to hold next batch
+             Release_All := false;
+          end if; 
+       end Wait_for_Underload;
+ 
+    end Hold;
+    
+    -- Mechanism to count the number of Message tasks completed (Credit)
+    protected body TC_Tasks_Completed is
+       procedure Increment is
+       begin
+          Number_Complete := Number_Complete + 1;
+       end Increment;
+ 
+       function Count return integer is
+       begin
+          return Number_Complete;
+       end Count;
+    end TC_Tasks_Completed;
+ 
+ 
+    -- Assemble messages received from an external source
+    --   Creates a message task for each. The message tasks remain extant
+    --   for the life of the messages in the system.
+    --      The Line Driver task would normally be designed to loop continuously
+    --      creating the messages as input is received.  Simulate this 
+    --      but limit it to the required number of dummy messages needed for
+    --      this test and allow it to terminate at that point.  Artificially
+    --      alternate High and Low priority Credit transactions for this test.
+    --
+    task body Line_Driver is
+       Current_ID       : integer := 1;
+       Current_Priority : Transaction_Priority := High;      
+ 
+       -- Artificial: number of messages required for this test
+       type TC_Trans_Range is range 1..6;
+ 
+       procedure Build_Credit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 100;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Credit; 
+             Next_Transaction.Priority := Current_Priority;
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Credit_Record;     
+ 
+ 
+       procedure Build_Debit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+          Dummy_Account : constant integer := 200;
+       begin
+             Next_Transaction.ID := Current_ID;
+             Next_Transaction.Code := Debit; 
+ 
+             Next_Transaction.Account_Number := Dummy_Account;
+             Current_ID := Current_ID + 1;
+       end Build_Debit_Record;     
+ 
+    begin
+       
+       accept Start;   -- Wait for trigger from Main
+ 
+       for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
+          declare 
+             -- Create a task for the next message
+             Next_Message_Task : acc_Message_Task := new Message_Task;
+             -- Create a record for it
+             Next_Transaction : acc_Transaction_Record := 
+                                                 new Transaction_Record;
+          begin
+             if Transaction_Numb = TC_Trans_Range'first then
+                -- Send the first Credit message
+                Build_Credit_Record ( Next_Transaction );
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                -- TC: Wait until the first message has been received by the
+                -- Credit task and it has set the Overload indicator for the 
+                -- Distributor
+                while not TC_Handshake.First_Message_Arrived loop
+                   delay ImpDef.Minimum_Task_Switch;   
+                end loop;
+             elsif Transaction_Numb = TC_Trans_Range'last then
+                -- For this test send the last transaction to the Debit task
+                -- to improve the mix
+                Build_Debit_Record( Next_Transaction );
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+             else
+                -- TC: Alternate high and low priority transactions
+                if Current_Priority = High then
+                   Current_Priority := Low;
+                else
+                   Current_Priority := High;
+                end if;
+                Build_Credit_Record( Next_Transaction );
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+             end if;
+          end;   -- declare
+       end loop;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Line_Driver");
+    end Line_Driver;
+ 
+    
+ 
+ 
+    task body Message_Task is
+ 
+       TC_Original_Transaction_Code : Transaction_Code;  
+       This_Transaction : acc_Transaction_Record := new Transaction_Record;
+ 
+    begin
+       
+       accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+          This_Transaction.all := In_Transaction.all;
+       end Accept_Transaction;
+ 
+       -- Note the original code to ensure correct return
+       TC_Original_Transaction_Code := This_Transaction.Code;
+  
+       -- Queue up on Distributor's Input queue
+       Distributor.Input ( This_Transaction );
+       -- This task will now wait for the requeued rendezvous 
+       -- to complete before proceeding
+ 
+       -- After the required computations have been performed
+       -- return the Transaction_Record appropriately (probably to an output
+       -- line driver)
+       null;            -- stub
+       
+       -- For the test check that the return values are as expected
+       if TC_Original_Transaction_Code /= This_Transaction.Code then
+          -- Incorrect rendezvous
+          Report.Failed ("Message Task: Incorrect code returned");
+       end if;
+ 
+       if This_Transaction.Code = Credit then
+          if This_Transaction.Return_Value  /= Credit_Return   or
+          not This_Transaction.TC_thru_Dist                    then
+             Report.Failed ("Expected path not traversed - Credit");
+          end if;
+          TC_Tasks_Completed.Increment;
+       else
+          if This_Transaction.Return_Value  /= Debit_Return or   
+             This_Transaction.TC_Message_Count /= 1         or
+             not This_Transaction.TC_thru_Dist               then
+                Report.Failed ("Expected path not traversed - Debit");
+          end if;
+          TC_Debit_Message_Complete.Set_True;
+       end if;
+ 
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Message_Task");
+    end Message_Task;
+ 
+ 
+ 
+ 
+   
+    -- Computation task.  After the computation is performed the rendezvous
+    -- in the original message task is completed.                              
+    task body Credit_Computation is
+ 
+       Message_Count   : integer := 0;
+       
+    begin
+       loop
+          select 
+             accept Input ( Transaction : acc_Transaction_Record) do
+                if Distributor.Credit_is_Overloaded
+                                     and Transaction.Priority = Low  then 
+                   -- We should not be getting any Low Priority messages. They
+                   -- should be waiting on the Hold.Wait_for_Underload 
+                   -- queue
+                   Report.Failed 
+                      ("Credit Task: Low priority transaction during overload");
+                end if;
+                -- Perform the computations required for this transaction
+                null; -- stub
+ 
+                -- For the test: 
+                if not Transaction.TC_thru_Dist then
+                   Report.Failed 
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Credit then
+                   Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- The following is all Test Control code:
+                Transaction.Return_Value := Credit_Return;
+                Message_Count := Message_Count + 1;
+                --
+                -- Now take special action depending on which Message
+                if Message_Count = 1 then 
+                   -- After the first message :
+                   Distributor.Set_Credit_Overloaded;
+                   -- Now flag the Line_Driver that the second and subsequent
+                   -- messages may now be sent
+                   TC_Handshake.Set;
+                end if;
+                if Message_Count = 3 then
+                   -- The two high priority transactions created subsequent
+                   -- to the overload have now been processed
+                   Distributor.Clear_Credit_Overloaded;
+                end if;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Credit_Computation");
+    end Credit_Computation;
+ 
+ 
+ 
+    -- Computation task.  After the computation is performed the rendezvous
+    -- in the original message task is completed.        
+    --                      
+    task body Debit_Computation is
+       Message_Count   : integer := 0;
+    begin
+       loop
+          select
+             accept Input (Transaction : acc_Transaction_Record) do
+                -- Perform the computations required for this message
+                null;      -- stub
+ 
+                -- For the test: 
+                if not Transaction.TC_thru_Dist then
+                   Report.Failed 
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                end if;
+                if Transaction.code /= Debit then
+                   Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                end if;
+ 
+                -- for the test plug a known value and count
+                Transaction.Return_Value := Debit_Return;
+                -- one, and only one, message should pass through
+                Message_Count := Message_Count + 1;
+                Transaction.TC_Message_Count := Message_Count;
+             end Input;            
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Debit_Computation");
+    end Debit_Computation;
+ 
+ 
+ begin 
+    Report.Test ("C954021", "Requeue from one entry body to an entry in" &
+                                        " another protected object");
+ 
+    Line_Driver.Start;  -- Start the test
+ 
+ 
+    -- Ensure that the message tasks have completed before reporting result
+    while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected) 
+          and not TC_Debit_Message_Complete.Value loop
+       delay ImpDef.Minimum_Task_Switch;   
+    end loop;
+ 
+    Report.Result;
+ 
+ end C954021;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954022.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954022.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954022.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954022.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,351 ----
+ -- C954022.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      In an entry body requeue the call to the same entry.  Check that the
+ --      items go to the right queue and that they are placed back on the end 
+ --      of the queue
+ --
+ -- TEST DESCRIPTION:
+ --      Simulate part of a message handling application where the messages are
+ --      composed of several segments.  The sequence of the segments within the
+ --      message is specified by Seg_Sequence_No.   The segments are handled by
+ --      different tasks and finally forwarded to an output driver.  The
+ --      segments can arrive in any order but must be assembled into the proper
+ --      sequence for final output.  There is a Sequencer task interposed
+ --      before the Driver.  This takes the segments of the message off the
+ --      Ordering_Queue and those that are in the right order it sends on to
+ --      the driver; those that are out of order it places back on the end of
+ --      the queue.
+ --
+ --      The test just simulates the arrival of the segments at the Sequencer.
+ --      The task generating the segments handshakes with the Sequencer during
+ --      the  "Await Arrival" phase  ensuring that the three segments of a
+ --      message arrive in REVERSE order (the End-of-Message segment arrives
+ --      first and the Header last).  In the first cycle the sequencer pulls
+ --      segments off the queue and puts them back on the end till it
+ --      encounters the header.  It checks the sequence of the ones it pulls
+ --      off in case the segments are being put back on in the wrong part of
+ --      the queue.  Having cycled once through it no longer verifies the
+ --      sequence - it just executes the "application" code for the correct
+ --      order for dispatch to the driver.
+ -- 
+ --      In this simple example no attempt is made to address segments of
+ --      another message arriving or any other error conditions (such as
+ --      missing segments, timing etc.)
+ -- 
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      07 Nov 95   SAIC    ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C954022 is
+ 
+    -- These global Booleans are set when failure conditions inside Protected
+    -- objects are encountered.  Report.Failed cannot be called within
+    -- the object or a Bounded Error would occur
+    --
+    TC_Failed_1 : Boolean := false;
+    TC_Failed_2 : Boolean := false;
+    TC_Failed_3 : Boolean := false;
+ 
+ begin
+ 
+ 
+    Report.Test ("C954022", "Check Requeue to the same Protected Entry");
+    
+    declare  -- encapsulate the test
+ 
+       type Segment_Sequence is range 1..8;
+       Header : constant Segment_Sequence := Segment_Sequence'first;
+ 
+       type Message_Segment is record
+          ID              : integer;            -- Message ID
+          Seg_Sequence_No : Segment_Sequence;   -- Within the message
+          Segs_In_Message : integer;            -- Total segs this message
+          EOM             : Boolean := false;   -- true for final msg segment
+          Alpha           : string (1..128);
+       end record;
+       type acc_Message_Segment is access Message_Segment;
+ 
+       task TC_Simulate_Arrival;
+    
+       task type Carrier_Task is
+          entry Input ( Segment : acc_Message_Segment );
+       end Carrier_Task;
+       type acc_Carrier_Task is access Carrier_Task;
+    
+       protected Sequencer is
+          function  TC_Arrivals return integer;
+          entry Input          ( Segment : acc_Message_Segment );
+          entry Ordering_Queue ( Segment : acc_Message_Segment );
+       private
+          Number_of_Segments_Arrived  : integer := 0;
+          Number_of_Segments_Expected : integer := 0;
+          Next_Needed : Segment_Sequence := Header;
+          All_Segments_Arrived : Boolean := false;
+          Seen_EOM             : Boolean := false;
+ 
+          TC_First_Cycle       : Boolean := true;
+          TC_Expected_Sequence : Segment_Sequence := Header+2;
+ 
+       end Sequencer;
+    
+ 
+       task Output_Driver is
+          entry Input ( Segment : acc_Message_Segment );
+       end Output_Driver;
+    
+ 
+       -- Simulate the arrival of three message segments in REVERSE order
+       --
+       task body TC_Simulate_Arrival is
+          begin
+             for i in 1..3 loop
+                declare
+                   -- Create a task for the next message segment
+                   Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
+                   -- Create a record for the next segment
+                   Next_Segment : acc_Message_Segment := new Message_Segment;
+                begin
+                   if i = 1 then 
+                      -- Build the EOM segment as the first to "send"
+                      Next_Segment.Seg_Sequence_No := Header + 2;
+                      Next_Segment.Segs_In_Message := 3;
+                      Next_Segment.EOM := true;
+                   elsif i = 2 then
+                      -- Wait for the first segment to arrive at the Sequencer
+                      -- before "sending" the second
+                      while Sequencer.TC_Arrivals < 1 loop
+                         delay ImpDef.Minimum_Task_Switch;
+                      end loop;
+                      -- Build the segment
+                      Next_Segment.Seg_Sequence_No := Header +1;
+                   else
+                      -- Wait for the second segment to arrive at the Sequencer
+                      -- before "sending" the third
+                      while Sequencer.TC_Arrivals < 2 loop
+                         delay ImpDef.Minimum_Task_Switch;
+                      end loop;                  
+                      -- Build the segment. The last segment (in order) to
+                      -- arrive will be the "header" segment
+                      Next_Segment.Seg_Sequence_No := Header;
+                   end if;
+                   -- pass the record to its carrier
+                   Next_Segment_Task.Input ( Next_Segment );
+                end;
+             end loop;
+  
+ 
+       exception
+          when others => 
+               Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
+       end TC_Simulate_Arrival;
+    
+ 
+       -- One of these is generated for each message segment and the flow 
+       -- of the segments through the system is controlled by the calls the
+       -- task makes and the requeues of those calls
+       --
+       task body Carrier_Task is
+          This_Segment : acc_Message_Segment := new Message_Segment;
+       begin
+          accept Input ( Segment : acc_Message_Segment ) do
+             This_Segment.all := Segment.all;
+          end Input;
+          null; --:: stub.  Pass the segment around the application as needed
+ 
+          -- Now output the segment to the Output_Driver.  First we have to 
+          -- go through the Sequencer.  
+          Sequencer.Input ( This_Segment );
+       exception
+          when others => 
+               Report.Failed ("Unexpected Exception in Carrier_Task");
+       end Carrier_Task;
+    
+       -- Store segments on the Ordering_Queue then deliver them in the correct
+       -- sequence to the Output_Driver.
+       --
+       protected body Sequencer is
+ 
+          function  TC_Arrivals return integer is
+          begin
+             return Number_of_Segments_Arrived;
+          end TC_Arrivals;
+ 
+          
+          -- Segments arriving at the Input queue are counted and checked
+          -- against the total number of segments for the message.  They
+          -- are requeued onto the ordering queue where they are held until
+          -- all the segments have arrived.
+          entry Input ( Segment : acc_Message_Segment ) when true is
+          begin
+             -- check for EOM, if so get the number of segments in the message
+             -- Note: in this portion of code no attempt is made to address
+             -- reset for new message , end conditions, missing segments, 
+             -- segments of a different message etc.
+             Number_of_Segments_Arrived := Number_of_Segments_Arrived + 1;
+             if Segment.EOM then
+                Number_of_Segments_Expected := Segment.Segs_In_Message;
+                Seen_EOM := true;
+             end if;
+ 
+             if Seen_EOM then
+                if Number_of_Segments_Arrived = Number_of_Segments_Expected then
+                   -- This is the last segment for this message
+                   All_Segments_Arrived := true;    -- clear the barrier
+                end if;
+             end if;
+ 
+             requeue Ordering_Queue;
+ 
+             -- At this exit point the entry queue barriers are evaluated
+ 
+          end Input;
+ 
+ 
+          entry Ordering_Queue ( Segment : acc_Message_Segment )
+                                                   when All_Segments_Arrived is
+             begin
+ 
+             --=====================================================
+             -- This part is all Test_Control code
+ 
+             if TC_First_Cycle then 
+                -- Check the order of the original three
+                if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+                   -- The segments are not being pulled off in the 
+                   -- expected sequence.  This could occur if the 
+                   -- requeue is not putting them back on the end.
+                   TC_Failed_3 := true;
+                end if; -- sequence check
+                -- Decrement the expected sequence
+                if TC_Expected_Sequence /= Header then
+                   TC_Expected_Sequence := TC_Expected_Sequence - 1;
+                else 
+                   TC_First_Cycle := false; -- This is the Header - the
+                                            -- first two segments are
+                                            -- back on the queue
+                end if; -- decrementing
+             end if; -- first cycle 
+             --=====================================================
+ 
+             -- And this is the Application code
+             if Segment.Seg_Sequence_No = Next_Needed then
+                if Segment.EOM then
+                   Next_Needed := Header;  -- reset for next message
+                   -- :: other resets not shown
+                else
+                   Next_Needed := Next_Needed + 1;
+                end if;
+                requeue Output_Driver.Input  with abort;
+                -- set to Report Failed - Requeue did not complete entry body
+                TC_Failed_1 := true;
+             else
+                -- Not the next needed - put it back on the queue
+                --    NOTE: here we are requeueing to the same entry
+                requeue Sequencer.Ordering_Queue;
+                -- set to Report Failed - Requeue did not complete entry body
+                TC_Failed_2 := true;
+             end if;
+          end Ordering_Queue;
+       end Sequencer;
+    
+ 
+       task body Output_Driver is
+          This_Segment : acc_Message_Segment := new Message_Segment;
+ 
+          TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
+          TC_Segment_Total : integer := 0;
+          TC_Expected_Total : integer := 3;
+       begin
+          loop
+             -- Note: normally we would expect this Accept to be in a select 
+             -- with terminate.  For the test we exit the loop on completion
+             -- to give better control
+             accept Input ( Segment : acc_Message_Segment ) do 
+                This_Segment.all := Segment.all;
+             end Input;
+    
+             null;  --::: stub - output the next segment of the message
+ 
+             -- The following is all test control code
+             --
+             if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+                Report.Failed ("Output_Driver: Segment out of sequence");
+             end if;
+             TC_Expected_Sequence := TC_Expected_Sequence + 1;
+ 
+             -- Now count the number of segments
+             TC_Segment_Total := TC_Segment_Total + 1;
+ 
+             -- Check the number and exit loop when complete
+             -- There must be exactly TC_Expected_Total in number and
+             --    the last one must be EOM
+             --    (test will hang if < TC_Expected_Total arrive
+             --    without EOM)
+             if This_Segment.EOM then
+                -- This is the last segment.
+                if TC_Segment_Total /= TC_Expected_Total then
+                   Report.Failed ("EOM and wrong number of segments");
+                end if;
+                exit;   -- the loop and terminate the task
+             elsif TC_Segment_Total = TC_Expected_Total then
+                Report.Failed ("No EOM found");
+                exit;
+             end if;
+          end loop;
+       exception
+          when others => 
+               Report.Failed ("Unexpected Exception in Output_Driver");
+       end Output_Driver;
+ 
+ 
+    begin  
+ 
+       null;
+ 
+    end; -- encapsulation
+ 
+    if TC_Failed_1 then
+       Report.Failed ("Requeue did not complete entry body - 1");
+    end if;
+ 
+    if TC_Failed_2 then
+       Report.Failed ("Requeue did not complete entry body - 2");
+    end if;
+ 
+    if TC_Failed_3 then
+       Report.Failed ("Sequencer: Segment out of sequence");
+    end if;
+ 
+    Report.Result;
+    
+ end C954022;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954023.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954023.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954023.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954023.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,558 ----
+ -- C954023.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that a requeue within a protected entry to a family of entries 
+ --     in a different protected object is queued correctly
+ --                      Call with parameters
+ --                      Requeue with abort
+ --
+ -- TEST DESCRIPTION: 
+ --      One transaction is sent through to check the paths.  After processing
+ --      this, the Credit task sets the "overloaded" indicator.  Once this
+ --      indicator is set the Distributor (a protected object) queues lower
+ --      priority transactions on a family of queues (Wait_for_Underload) in
+ --      another protected object using a requeue.  The Distributor still
+ --      delivers high priority transactions. After two more high priority
+ --      transactions have been processed by the Credit task the artificial
+ --      test code clears the overload condition to the threshold level that
+ --      allows only the items on the Medium priority queue of the family to be
+ --      released.  When these have been processed and checked the test code
+ --      then lowers the priority threshold once again, allowing the Low
+ --      priority items from the last queue in the family to be released,
+ --      processed and checked. Note: the High priority queue in the family is 
+ --      not used.   
+ --     
+ --      This series of tests uses a simulation of a transaction driven
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system.  The message tasks put themselves on the
+ --      input queue of a Distributor which, from information in the
+ --      transaction and/or system load conditions forwards them to other
+ --      operating tasks. These in turn might forward the transactions to yet
+ --      other tasks for further action.  The routing is, in real life, dynamic
+ --      and unpredictable at the time of message generation.  All rerouting in
+ --      this  model is done by means of requeues.
+ --     
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+          
+ procedure C954023 is
+ 
+    -- Artificial: number of messages required for this test
+    subtype TC_Trans_Range is integer range 1..8;
+ 
+    TC_Credit_Messages_Expected  : constant integer 
+                                           := TC_Trans_Range'Last - 1;
+ 
+    TC_Debit_Message_Complete    : Boolean := false;
+ 
+ 
+    -- Mechanism for handshaking between tasks
+    protected TC_PO is
+       procedure Increment_Tasks_Completed_Count;
+       function  Tasks_Completed_Count return integer;
+       function  First_Message_Has_Arrived return Boolean;
+       procedure  Set_First_Message_Has_Arrived;
+    private
+       Number_Complete : integer := 0;
+          Message_Arrived_Flag  : Boolean := false;
+    end TC_PO;
+    -- 
+    protected body TC_PO is
+       procedure Increment_Tasks_Completed_Count is
+       begin
+          Number_Complete := Number_Complete + 1;
+       end Increment_Tasks_Completed_Count;
+   
+       function Tasks_Completed_Count return integer is
+       begin
+          return Number_Complete;
+       end Tasks_Completed_Count;
+ 
+       function  First_Message_Has_Arrived return Boolean is
+          begin
+             return Message_Arrived_Flag;
+          end First_Message_Has_Arrived;
+ 
+       procedure  Set_First_Message_Has_Arrived is
+          begin
+             Message_Arrived_Flag := true;
+       end Set_First_Message_Has_Arrived;
+ 
+    end TC_PO;
+ 
+ begin
+    
+    Report.Test ("C954023", "Requeue from within a protected object" &
+                       " to a family of entries in another protected object");
+ 
+  
+    declare -- encapsulate the test
+    
+       -- Arbitrary test values
+       Credit_Return : constant := 1;
+       Debit_Return  : constant := 2;
+ 
+       type Transaction_Code is (Credit, Debit);
+       type App_Priority     is (Low, Medium, High);
+       type Priority_Block   is array (App_Priority) of Boolean;
+ 
+       type Transaction_Record;
+       type acc_Transaction_Record is access Transaction_Record;
+       type Transaction_Record is 
+          record
+             ID               : integer := 0;
+             Code             : Transaction_Code := Debit;
+             Priority         : App_Priority := High;
+             Account_Number   : integer := 0;
+             Stock_Number     : integer := 0;
+             Quantity         : integer := 0;
+             Return_Value     : integer := 0;
+             TC_Message_Count : integer := 0;
+             TC_Thru_Distrib  : Boolean := false;
+          end record;
+    
+    
+       task type Message_Task is 
+          entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+       end Message_Task;
+       type acc_Message_Task is access Message_Task;
+    
+       task Line_Driver is
+          entry Start;
+       end Line_Driver;
+    
+       protected Distributor is
+          procedure Set_Credit_Overloaded;
+          procedure Clear_Overload_to_Medium;
+          procedure Clear_Overload_to_Low;
+          entry     Input (Transaction : acc_Transaction_Record);
+       private
+          Credit_Overloaded : Boolean := false;
+       end Distributor;
+    
+       protected Hold is
+          procedure Release_Medium;
+          procedure Release_Low;
+          -- Family of entry queues indexed by App_Priority
+          entry Wait_for_Underload (App_Priority)
+                                      (Transaction : acc_Transaction_Record);
+       private
+          Release : Priority_Block := (others => false);
+       end Hold;
+    
+       task Credit_Computation is
+          entry Input(Transaction : acc_Transaction_Record);
+       end Credit_Computation;
+    
+       task Debit_Computation is
+          entry Input(Transaction : acc_Transaction_Record);
+       end Debit_Computation;
+    
+       --
+       -- Dispose each input Transaction_Record to the appropriate
+       -- computation tasks
+       --
+       protected body Distributor is
+    
+          procedure Set_Credit_Overloaded is
+          begin
+             Credit_Overloaded := true;
+          end Set_Credit_Overloaded;
+    
+          procedure Clear_Overload_to_Medium is
+          begin
+             Credit_Overloaded := false;
+             Hold.Release_Medium;       -- Release all held messages on Medium
+                                        -- priority queue
+          end Clear_Overload_to_Medium;
+      
+          procedure Clear_Overload_to_Low is
+          begin
+             Credit_Overloaded := false;
+             Hold.Release_Low;          -- Release all held messages on Low
+                                        -- priority queue
+          end Clear_Overload_to_Low;
+      
+    
+    
+          entry Input (Transaction : acc_Transaction_Record)   when true is
+                                                    -- barrier is always open
+          begin
+             -- Test Control: Set the indicator in the message to show it has
+             -- passed through the Distributor object
+             Transaction.TC_thru_Distrib := true;
+     
+             -- Pass this transaction on to the appropriate computation
+             -- task but temporarily hold low-priority transactions under
+             -- overload conditions
+             case Transaction.Code is
+                when Credit =>
+                   if Credit_Overloaded and Transaction.Priority /= High then
+                      -- use the appropriate queue in the family 
+                      requeue Hold.Wait_for_Underload(Transaction.Priority)
+                                                          with abort;
+                   else
+                      requeue Credit_Computation.Input with abort;
+                  end if;
+                when Debit =>
+                  requeue Debit_Computation.Input with abort;
+             end case;
+          end Input;
+       end Distributor;
+    
+    
+       -- Low priority Message tasks are held on the Wait_for_Underload queue
+       -- while the Credit computation system is overloaded.  Once the Credit
+       -- system reached underload send all queued messages immediately
+       --
+       protected body Hold is
+          
+          -- Once these are executed the barrier conditions for the entries
+          -- are evaluated 
+          procedure Release_Medium is
+          begin 
+             Release(Medium) := true;
+          end Release_Medium;
+          --
+          procedure Release_Low is
+          begin 
+             Release(Low) := true;
+          end Release_Low;
+    
+          -- This is a family of entry queues indexed by App_Priority
+          entry Wait_for_Underload  (for AP in App_Priority)
+                                    (Transaction : acc_Transaction_Record)
+                                                 when Release(AP) is
+          begin
+             requeue Credit_Computation.Input with abort;
+             if Wait_for_Underload(AP)'count = 0 then
+                -- Queue is purged.  Set up to hold next batch
+                Release(AP) := false;
+             end if; 
+          end Wait_for_Underload;
+    
+       end Hold;
+       
+    
+    
+    
+       -- Assemble messages received from an external source
+       --   Creates a message task for each. The message tasks remain extant
+       --   for the life of the messages in the system.
+       --      The Line Driver task would normally be designed to loop 
+       --      creating the messages as input is received.  Simulate this 
+       --      but limit it to the required number of dummy messages needed for
+       --      this test and allow it to terminate at that point.  Artificially
+       --      cycle the generation of High medium and Low priority Credit 
+       --      transactions for this test. Send out one final Debit message
+       --
+       task body Line_Driver is
+          Current_ID       : integer := 1;
+          Current_Priority : App_Priority := High;      
+    
+          procedure Build_Credit_Record 
+                               ( Next_Transaction : acc_Transaction_Record ) is
+             Dummy_Account : constant integer := 100;
+          begin
+                Next_Transaction.ID := Current_ID;
+                Next_Transaction.Code := Credit; 
+                Next_Transaction.Priority := Current_Priority;
+    
+                Next_Transaction.Account_Number := Dummy_Account;
+                Current_ID := Current_ID + 1;
+          end Build_Credit_Record;     
+    
+    
+          procedure Build_Debit_Record 
+                             ( Next_Transaction : acc_Transaction_Record ) is
+             Dummy_Account : constant integer := 200;
+          begin
+                Next_Transaction.ID := Current_ID;
+                Next_Transaction.Code := Debit; 
+    
+                Next_Transaction.Account_Number := Dummy_Account;
+                Current_ID := Current_ID + 1;
+          end Build_Debit_Record;     
+    
+       begin
+          
+          for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
+             declare 
+                -- Create a task for the next message
+                Next_Message_Task : acc_Message_Task := new Message_Task;
+                -- Create a record for it
+                Next_Transaction : acc_Transaction_Record := 
+                                                    new Transaction_Record;
+             begin
+                if Transaction_Numb = TC_Trans_Range'first then
+                   -- Send the first Credit message
+                   Build_Credit_Record ( Next_Transaction );
+                   Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                   -- TC: Wait until the first message has been received by the
+                   -- Credit task and it has set the Overload indicator for the 
+                   -- Distributor
+                   while not TC_PO.First_Message_Has_Arrived loop
+                      delay ImpDef.Minimum_Task_Switch;   
+                   end loop;
+                elsif Transaction_Numb = TC_Trans_Range'last then
+                   -- For this test send the last transaction to the Debit task
+                   -- to improve the mix
+                   Build_Debit_Record( Next_Transaction );
+                   Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                else
+                   -- TC: Cycle generation of  high medium and low priority 
+                   -- transactions
+                   if Current_Priority = High then
+                      Current_Priority := Medium;
+                   elsif  
+                      Current_Priority = Medium then
+                      Current_Priority := Low;
+                   else
+                      Current_Priority := High;
+                   end if;
+                   Build_Credit_Record( Next_Transaction );
+                   Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                end if;
+             end;   -- declare
+          end loop;
+    
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Line_Driver");
+       end Line_Driver;
+    
+       
+    
+    
+       task body Message_Task is
+    
+          TC_Original_Transaction_Code : Transaction_Code;  
+          This_Transaction : acc_Transaction_Record := new Transaction_Record;
+    
+       begin
+          
+          accept Accept_Transaction(In_Transaction : acc_Transaction_Record) do
+             This_Transaction.all := In_Transaction.all;
+          end Accept_Transaction;
+    
+          -- Note the original code to ensure correct return
+          TC_Original_Transaction_Code := This_Transaction.Code;
+     
+          -- Queue up on Distributor's Input queue
+          Distributor.Input ( This_Transaction );
+          -- This task will now wait for the requeued rendezvous 
+          -- to complete before proceeding
+    
+          -- After the required computations have been performed
+          -- return the Transaction_Record appropriately (probably to an output
+          -- line driver)
+          null;            -- stub
+          
+          -- For the test check that the return values are as expected
+          if TC_Original_Transaction_Code /= This_Transaction.Code then
+             -- Incorrect rendezvous
+             Report.Failed ("Message Task: Incorrect code returned");
+          end if;
+    
+          if This_Transaction.Code = Credit then
+             if This_Transaction.Return_Value  /= Credit_Return   or
+             not This_Transaction.TC_thru_Distrib                 then
+                Report.Failed ("Expected path not traversed - Credit");
+             end if;
+             TC_PO.Increment_Tasks_Completed_Count;
+          else
+             if This_Transaction.Return_Value  /= Debit_Return or   
+                This_Transaction.TC_Message_Count /= 1         or
+                not This_Transaction.TC_thru_Distrib           then
+                   Report.Failed ("Expected path not traversed - Debit");
+             end if;
+             TC_Debit_Message_Complete := true;
+          end if;
+    
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Message_Task");
+       end Message_Task;
+    
+    
+    
+    
+      
+       -- Computation task.  After the computation is performed the rendezvous
+       -- in the original message task is completed.                              
+       task body Credit_Computation is
+    
+          Message_Count   : integer := 0;
+          
+       begin
+          loop
+             select 
+                accept Input ( Transaction : acc_Transaction_Record) do
+                   
+                   -- Perform the computations required for this transaction
+                   null; -- stub
+    
+                   
+                   -- The following is all Test Control code:
+                  
+                   if not Transaction.TC_thru_Distrib then
+                      Report.Failed 
+                             ("Credit Task: Wrong queue, Distributor bypassed");
+                   end if;
+    
+                   if Transaction.code /= Credit then
+                      Report.Failed
+                          ("Credit Task: Requeue delivered to the wrong queue");
+                   end if;
+    
+                   -- This is checked by the Message_Task:
+                   Transaction.Return_Value := Credit_Return;
+    
+                   -- Now take special action depending on which Message.
+                   -- Note: The count gives the order in which the messages are
+                   --       arriving at this task NOT the order in which they
+                   --       were originally generated and sent out.
+    
+                   Message_Count := Message_Count + 1;
+    
+                   if Message_Count < 4 then 
+                      -- This is one of the first three messages which must 
+                      -- be High priority because we will set "Overload" after 
+                      -- the first, which is known to be High. The lower
+                      -- priority should be waiting on the queues
+                      if Transaction.Priority /= High then  
+                      Report.Failed 
+                         ("Credit Task: Lower priority trans. during overload");
+                      end if;
+                      if Message_Count = 1 then 
+                         -- After the first message :
+                         Distributor.Set_Credit_Overloaded;
+                         -- Now flag the Line_Driver that the second and 
+                         -- subsequent messages may now be sent
+                         TC_PO.Set_First_Message_Has_Arrived;
+                      elsif
+                         Message_Count = 3 then
+                         -- The two high priority transactions created 
+                         -- subsequent to the overload have now been processed,
+                         --  release the Medium priority items
+                         Distributor.Clear_Overload_to_Medium; 
+                      end if;
+                   elsif Message_Count < 6 then
+                      -- This must be one of the Medium priority messages
+                      if Transaction.Priority /= Medium then  
+                      Report.Failed 
+                            ("Credit Task: Second group not Medium Priority");
+                      end if;
+                      if Message_Count = 5 then 
+                         -- The two medium priority transactions
+                         -- have now been processed - release the
+                         -- Low priority items
+                         Distributor.Clear_Overload_to_Low; 
+                      end if;
+                   elsif Message_Count < TC_Trans_Range'Last then
+                      -- This must be one of the Low priority messages
+                      if Transaction.Priority /= Low then  
+                      Report.Failed 
+                            ("Credit Task: Third group not Low Priority");
+                      end if;
+                   else
+                      -- Too many transactions have arrived.  Duplicates?
+                      -- the Debit transaction?
+                      Report.Failed 
+                            ("Credit Task: Too many transactions");
+                   end if;
+                end Input;            
+             or
+                terminate;
+             end select;
+          end loop;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Credit_Computation");
+       end Credit_Computation;
+    
+    
+    
+       -- Computation task.  After the computation is performed the rendezvous
+       -- in the original message task is completed.        
+       --                      
+       task body Debit_Computation is
+          Message_Count   : integer := 0;
+       begin
+          loop
+             select
+                accept Input (Transaction : acc_Transaction_Record) do
+                   -- Perform the computations required for this message
+                   null;      -- stub
+    
+                   -- For the test: 
+                   if not Transaction.TC_thru_Distrib then
+                      Report.Failed 
+                          ("Debit Task: Wrong queue, Distributor bypassed");
+                   end if;
+                   if Transaction.code /= Debit then
+                      Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                   end if;
+    
+                   -- for the test plug a known value and count
+                   Transaction.Return_Value := Debit_Return;
+                   -- one, and only one, message should pass through
+                   Message_Count := Message_Count + 1;
+                   Transaction.TC_Message_Count := Message_Count;
+                end Input;            
+             or
+                terminate;
+             end select;
+          end loop;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Debit_Computation");
+       end Debit_Computation;
+    
+ 
+    begin -- declare 
+ 
+       null;
+ 
+    end; -- declare (test encapsulation)
+ 
+    if (TC_PO.Tasks_Completed_Count /= TC_Credit_Messages_Expected) 
+                                     and not TC_Debit_Message_Complete then
+       Report.Failed ("Incorrect number of Message Tasks completed");
+    end if;
+ 
+    Report.Result;
+ 
+ end C954023;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954024.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954024.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954024.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954024.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,380 ----
+ -- C954024.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE: 
+ --      Check that a call to a protected entry can be requeued to a task
+ --      entry. Check that the requeue is placed on the correct entry; that the
+ --      original caller waits for the completion of the requeue and continues
+ --      after the requeued rendezvous.  Check that the requeue does not block.
+ --      Specifically, check a requeue without abort from a protected entry to
+ --      an entry in a task.
+ --
+ -- TEST DESCRIPTION:
+ --      In the Distributor protected object, requeue two successive calls on
+ --      the entries of two separate target tasks.  Each task in each of the 
+ --      paths adds identifying information in the transaction being passed. 
+ --      This information is checked by the Message tasks on completion
+ --      ensuring that the requeues have been placed on the correct queues.
+ --      There is an artificial guard on the Credit Task to ensure that the
+ --      input is queued; this guard is released by the Debit task which 
+ --      handles its input immediately.  This ensures that we have one of the
+ --      requeued items actually queued for later handling and also verifies
+ --      that the requeuing process (in the protected object) is not blocked.
+ --
+ --      This series of tests uses a simulation of a transaction driven 
+ --      processing system.  Line Drivers accept input from an external source
+ --      and build them into transaction records.  These records are then 
+ --      encapsulated in message tasks which remain extant for the life of the
+ --      transaction in the system. The message tasks put themselves on the 
+ --      input queue of a Distributor object which, from information in the
+ --      transaction and/or system load conditions forwards them to other 
+ --      operating tasks. These in turn might forward the transactions to yet 
+ --      other tasks for further action.  The routing is, in real life, 
+ --      dynamic and unpredictable at the time of message generation. All 
+ --      rerouting in this  model is done by means of requeues.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      08 Nov 95   SAIC    Fixed reported problems for ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;         
+ procedure C954024 is
+     
+    
+ begin -- C954024
+ 
+    Report.Test ("C954024", "Requeue from protected entry to task entry");
+ 
+    declare -- encapsulate the test
+ 
+       -- Arbitrary test values
+       Credit_Return : constant := 1;
+       Debit_Return  : constant := 2;
+    
+       type Transaction_Code is (Credit, Debit);
+    
+       type Transaction_Record;
+       type acc_Transaction_Record is access Transaction_Record;
+       type Transaction_Record is 
+          record
+             ID               : integer := 0;
+             Code             : Transaction_Code := Debit;
+             Account_Number   : integer := 0;
+             Stock_Number     : integer := 0;
+             Quantity         : integer := 0;
+             Return_Value     : integer := 0;
+             TC_Message_Count : integer := 0;       
+             TC_Thru_Dist     : Boolean := false;
+          end record;
+    
+    
+       task type Message_Task is 
+          entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+       end Message_Task;
+       type acc_Message_Task is access Message_Task;
+    
+       task Line_Driver is 
+          entry Start;
+       end Line_Driver;   
+    
+       task Credit_Computation is
+          entry Input(Transaction : acc_Transaction_Record);
+       end Credit_Computation;
+    
+       task Debit_Computation is
+          entry Input(Transaction : acc_Transaction_Record);
+       end Debit_Computation;
+    
+       protected Time_Lock is
+          procedure Credit_Start;
+          function  Credit_Enabled return Boolean;
+       private
+          Credit_OK : Boolean := false;
+       end Time_Lock;
+    
+       protected body Time_Lock is
+          procedure Credit_Start is
+          begin
+             Credit_OK := true;
+          end Credit_Start;
+    
+          function  Credit_Enabled return Boolean is 
+          begin
+             return Credit_OK;
+          end Credit_Enabled;
+       end Time_Lock;
+    
+    
+    
+       protected Distributor is
+          entry Input (Transaction : acc_Transaction_Record);
+       end Distributor;
+       --
+       --
+       -- Dispose each input Transaction_Record to the appropriate
+       -- computation tasks
+       --
+       protected body Distributor is
+          entry Input (Transaction : acc_Transaction_Record) when true is
+                                                    -- barrier is always open
+          begin
+             -- Test Control: Set the indicator in the message to show it has
+             -- passed through the Distributor object
+             Transaction.TC_thru_Dist := true;
+                 
+             -- Pass this transaction on to the appropriate computation
+             -- task
+             case Transaction.Code is
+                when Credit =>
+                   requeue Credit_Computation.Input;
+                when Debit =>
+                   requeue Debit_Computation.Input;
+             end case;
+          end Input;
+       end Distributor;
+    
+    
+    
+    
+       -- Assemble messages received from an external source
+       --   Creates a message task for each. The message tasks remain extant
+       --   for the life of the messages in the system.
+       --   NOTE:
+       --   The Line Driver task would normally be designed to loop continuously
+       --   creating the messages as input is received.  Simulate this 
+       --   but limit it to two dummy messages for this test and allow it
+       --   to terminate at that point
+       --
+       task body Line_Driver is
+          Current_ID : integer := 1;
+          TC_Last_was_for_credit : Boolean := false;
+    
+          procedure Build_Credit_Record 
+                           ( Next_Transaction : acc_Transaction_Record ) is
+             Dummy_Account : constant integer := 100;
+          begin
+                Next_Transaction.ID := Current_ID;
+                Next_Transaction.Code := Credit; 
+    
+                Next_Transaction.Account_Number := Dummy_Account;
+                Current_ID := Current_ID + 1;
+          end Build_Credit_Record;     
+    
+    
+          procedure Build_Debit_Record 
+                           ( Next_Transaction : acc_Transaction_Record ) is
+             Dummy_Account : constant integer := 200;
+          begin
+                Next_Transaction.ID := Current_ID;
+                Next_Transaction.Code := Debit; 
+    
+                Next_Transaction.Account_Number := Dummy_Account;
+                Current_ID := Current_ID + 1;
+          end Build_Debit_Record;     
+    
+       begin
+    
+          accept Start;      -- Wait for trigger from Main
+    
+          for i in 1..2 loop  -- arbitrarily limit to two messages for the test
+             declare 
+                -- Create a task for the next message
+                Next_Message_Task : acc_Message_Task := new Message_Task;
+                -- Create a record for it
+                Next_Transaction : acc_Transaction_Record 
+                                                     := new Transaction_Record;
+             begin
+                if TC_Last_was_for_credit then
+                   Build_Debit_Record ( Next_Transaction );            
+                else
+                   Build_Credit_Record( Next_Transaction );
+                   TC_Last_was_for_credit := true;
+                end if;
+                Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+             end;   -- declare
+          end loop;
+    
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Line_Driver");
+       end Line_Driver;
+    
+       
+    
+    
+       task body Message_Task is
+    
+          TC_Original_Transaction_Code : Transaction_Code;  
+          This_Transaction : acc_Transaction_Record := new Transaction_Record;
+    
+       begin
+          accept Accept_Transaction
+                             (In_Transaction : acc_Transaction_Record) do
+             This_Transaction.all := In_Transaction.all;
+          end Accept_Transaction;
+    
+          -- Note the original code to ensure correct return
+          TC_Original_Transaction_Code := This_Transaction.Code;
+     
+          -- Queue up on Distributor's Input queue
+          Distributor.Input ( This_Transaction );
+          -- This task will now wait for the requeued rendezvous 
+          -- to complete before proceeding
+    
+          -- After the required computations have been performed
+          -- return the Transaction_Record appropriately (probably to an output
+          -- line driver)
+          null;            -- stub
+    
+          
+          -- The following is all Test Control Code
+    
+          -- Check that the return values are as expected
+          if TC_Original_Transaction_Code /= This_Transaction.Code then
+             -- Incorrect rendezvous
+             Report.Failed ("Message Task: Incorrect code returned");
+          end if;
+    
+          if This_Transaction.Code = Credit then
+             if This_Transaction.Return_Value     /= Credit_Return or   
+                This_Transaction.TC_Message_Count /= 1             or 
+                not This_Transaction.TC_thru_Dist       then
+                   Report.Failed ("Expected path not traversed");
+             end if;
+          else
+             if This_Transaction.Return_Value  /= Debit_Return or   
+                This_Transaction.TC_Message_Count /= 1         or 
+                not This_Transaction.TC_thru_Dist       then
+                   Report.Failed ("Expected path not traversed");
+             end if;
+          end if;
+    
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Message_Task");
+    
+       end Message_Task;
+    
+    
+    
+       -- Computation task.
+       --   Note:  After the computation is performed in this task and the 
+       --          accept body is completed the rendezvous in the original
+       --          message task is completed.                              
+       --                                           
+       task body Credit_Computation is
+          Message_Count   : integer := 0;
+       begin
+          loop
+             select 
+                when  Time_Lock.Credit_enabled =>
+                accept Input ( Transaction : acc_Transaction_Record) do
+                   -- Perform the computations required for this transaction
+                   null;      -- stub
+    
+                   -- For the test: 
+                   if not Transaction.TC_thru_Dist then
+                      Report.Failed 
+                           ("Credit Task: Wrong queue, Distributor bypassed");
+                   end if;
+                   if Transaction.code /= Credit then
+                      Report.Failed
+                        ("Credit Task: Requeue delivered to the wrong queue");
+                   end if;
+    
+                   -- for the test plug a known value and count
+                   Transaction.Return_Value := Credit_Return;
+                   -- one, and only one message should pass through
+                   Message_Count := Message_Count + 1;
+                   Transaction.TC_Message_Count := Message_Count;
+                end Input;            
+                exit;  -- one message is enough
+             else
+                delay ImpDef.Clear_Ready_Queue;  -- poll
+             end select;
+          end loop;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Credit_Computation");
+       end Credit_Computation;
+    
+    
+    
+       -- Computation task.
+       --   Note:  After the computation is performed in this task and the 
+       --          accept body is completed the rendezvous in the original
+       --          message task is completed.                              
+       --                                                
+       task body Debit_Computation is
+          Message_Count   : integer := 0;
+       begin
+          loop
+             select
+                accept Input (Transaction : acc_Transaction_Record) do
+                   -- Perform the computations required for this message
+                   null;      -- stub
+    
+                   -- For the test: 
+                   if not Transaction.TC_thru_Dist then
+                      Report.Failed
+                             ("Debit Task: Wrong queue, Distributor bypassed");
+                   end if;
+                   if Transaction.code /= Debit then
+                      Report.Failed
+                          ("Debit Task: Requeue delivered to the wrong queue");
+                   end if;
+    
+                   -- for the test plug a known value and count
+                   Transaction.Return_Value := Debit_Return;
+                   -- one, and only one, message should pass through
+                   Message_Count := Message_Count + 1;
+                   Transaction.TC_Message_Count := Message_Count;
+                   -- for the test: once we have completed the only Debit
+                   -- message release the Credit Messages which are queued
+                   -- on the Credit Input queue
+                   Time_Lock.Credit_Start;
+                   
+                end Input;            
+             or
+                terminate;
+             end select;
+          end loop;
+       exception
+          when others => 
+             Report.Failed ("Unexpected exception in Debit_Computation");
+    
+       end Debit_Computation;
+    
+    begin -- declare block
+       Line_Driver.Start;
+    end;  -- test encapsulation
+ 
+    Report.Result;
+ 
+ end C954024;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954025.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954025.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954025.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954025.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,237 ----
+ -- C954025.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the original entry call was a conditional entry call,
+ --      the call is cancelled if a requeue-with-abort of the call is not
+ --      selected immediately.
+ --      Check that if the original entry call was a timed entry call, the 
+ --      expiration time for a requeue-with-abort is the original expiration 
+ --      time.
+ --
+ -- TEST DESCRIPTION:
+ --      This test declares two tasks: Launch_Control and Mission_Control.
+ --      Mission_Control instructs Launch_Control to start its countdown
+ --      and then requeues (with abort) to the Launch_Control.Launch 
+ --      entry.  This call to Launch will be accepted at the end of the
+ --      countdown (if the task is still waiting).
+ --      The main task does an unconditional, conditional, and timed 
+ --      entry call to Mission_Control and checks to see if the launch
+ --      was accepted.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      18 OCT 95   SAIC    ACVC 2.1
+ --      10 JUL 96   SAIC    Incorporated reviewer's comments.
+ --
+ --!
+ 
+ with Calendar;   use type Calendar.Time;
+ with Report;
+ with ImpDef;
+ procedure C954025 is
+   Verbose : constant Boolean := False;
+   Countdown_Amount : constant Duration := 2.0 * Impdef.One_Long_Second;
+   Plenty_Of_Time : constant Duration := 
+          Countdown_Amount + ImpDef.Clear_Ready_Queue + 1.0 * Impdef.One_Long_Second;
+   Not_Enough_Time : constant Duration :=
+          Countdown_Amount - 0.5 * Impdef.One_Long_Second;
+ begin
+   Report.Test ("C954025",
+                "Check that if the original entry" &
+                " call was a conditional or timed entry call, the" &
+                " expiration time for a requeue with abort is the" &
+                " original expiration time");
+   declare
+      -- note that the following object is a shared object and its use
+      -- governed by the rules of 9.10(3,4,8);6.0
+      Launch_Accepted : Boolean := False;
+ 
+      task Launch_Control is
+         entry Enable_Launch_Control;
+         entry Start_Countdown (How_Long : Duration);
+         -- Launch will be accepted if a call is waiting when the countdown
+         -- reaches 0
+         entry Launch;
+      end Launch_Control;
+ 
+      task body Launch_Control is
+         Wait_Amount : Duration := 0.0;
+      begin
+         loop
+            select
+               accept Enable_Launch_Control do
+                  Launch_Accepted := False;
+               end Enable_Launch_Control;
+            or
+               terminate;
+            end select;
+ 
+            accept Start_Countdown (How_Long : Duration) do
+                  Wait_Amount := How_Long;
+            end Start_Countdown;
+ 
+            delay Wait_Amount;
+ 
+            select
+               accept Launch do
+                  Launch_Accepted := True;
+               end Launch;
+            else
+               null;
+               -- note that Launch_Accepted is False here
+            end select;
+         end loop;
+      end Launch_Control;
+ 
+      task Mission_Control is
+         --  launch will occur if we are given enough time to complete
+         --  a standard countdown.  We will not be rushed!
+         entry Do_Launch;
+      end Mission_Control;
+ 
+      task body Mission_Control is
+      begin
+         loop
+            select
+               accept Do_Launch do
+                  Launch_Control.Start_Countdown (Countdown_Amount);
+                  requeue Launch_Control.Launch with abort;
+               end Do_Launch;
+            or
+               terminate;
+            end select;
+         end loop;
+      end Mission_Control;
+      
+   begin   -- test encapsulation
+      -- unconditional entry call to check the simple case
+      Launch_Control.Enable_Launch_Control;
+      Mission_Control.Do_Launch;
+      if Launch_Accepted then
+         if Verbose then
+            Report.Comment ("simple case passed");
+         end if;
+       else
+          Report.Failed ("simple case");
+       end if;
+ 
+   
+      -- timed but with plenty of time - delay relative
+      Launch_Control.Enable_Launch_Control;
+      select
+         Mission_Control.Do_Launch;
+      or 
+         delay Plenty_Of_Time;
+         if Launch_Accepted then
+            Report.Failed ("plenty of time timed out after accept (1)");
+         end if;
+      end select;
+      if Launch_Accepted then
+         if Verbose then
+            Report.Comment ("plenty of time case passed (1)");
+         end if;
+       else
+          Report.Failed ("plenty of time (1)");
+       end if;
+ 
+   
+      -- timed but with plenty of time  -- delay until
+      Launch_Control.Enable_Launch_Control;
+      select
+         Mission_Control.Do_Launch;
+      or 
+         delay until Calendar.Clock + Plenty_Of_Time;
+         if Launch_Accepted then
+            Report.Failed ("plenty of time timed out after accept(2)");
+         end if;
+      end select;
+      if Launch_Accepted then
+         if Verbose then
+            Report.Comment ("plenty of time case passed (2)");
+         end if;
+       else
+          Report.Failed ("plenty of time (2)");
+       end if;
+ 
+   
+      -- timed without enough time - delay relative
+      Launch_Control.Enable_Launch_Control;
+      select
+         Mission_Control.Do_Launch;
+         Report.Failed ("not enough time completed accept (1)");
+      or 
+         delay Not_Enough_Time;
+      end select;
+      if Launch_Accepted then
+         Report.Failed ("not enough time (1)");
+       else
+         if Verbose then
+            Report.Comment ("not enough time case passed (1)");
+         end if;
+       end if;
+ 
+   
+      -- timed without enough time - delay until
+      Launch_Control.Enable_Launch_Control;
+      select
+         Mission_Control.Do_Launch;
+         Report.Failed ("not enough time completed accept (2)");
+      or 
+         delay until Calendar.Clock + Not_Enough_Time;
+      end select;
+      if Launch_Accepted then
+         Report.Failed ("not enough time (2)");
+       else
+         if Verbose then
+            Report.Comment ("not enough time case passed (2)");
+         end if;
+       end if;
+ 
+   
+      -- conditional case
+      Launch_Control.Enable_Launch_Control;
+      -- make sure Mission_Control is ready to accept immediately
+      delay ImpDef.Clear_Ready_Queue; 
+      select
+         Mission_Control.Do_Launch;
+         Report.Failed ("no time completed accept");
+      else
+         if Verbose then
+            Report.Comment ("conditional case - else taken");
+          end if;
+      end select;
+      if Launch_Accepted then
+         Report.Failed ("no time");
+       else
+         if Verbose then
+            Report.Comment ("no time case passed");
+         end if;
+       end if;
+ 
+   end;
+ 
+   Report.Result;
+ end C954025;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954026.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954026.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954026.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954026.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,269 ----
+ -- C954026.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the original protected entry call was a conditional
+ --      entry call, the call is cancelled if a requeue-with-abort of the 
+ --      call is not selected immediately.
+ --      Check that if the original protected entry call was a timed entry 
+ --      call, the expiration time for a requeue-with-abort is the original 
+ --      expiration time.
+ --
+ -- TEST DESCRIPTION:
+ --      In this test the main task makes a variety of calls to the protected
+ --      object Initial_PO.  These calls include a simple call, a conditional 
+ --      call, and a timed call.  The timed calls include calls with enough
+ --      time and those with less than the needed amount of time to get through
+ --      the requeue performed by Initial_PO.
+ --      Initial_PO requeues its entry call to Final_PO.
+ --      Final_PO does not accept the requeued call until the protected 
+ --      procedure Ok_To_Take_Requeue is called.
+ --      A separate task, Delayed_Opener, is used to call Ok_To_Take_Requeue
+ --      after a delay amount specified by the main task has expired. 
+ --
+ --
+ -- CHANGE HISTORY:
+ --      15 DEC 95   SAIC    ACVC 2.1
+ --      10 JUL 96   SAIC    Incorporated reviewer comments.
+ --      10 OCT 96   SAIC    Incorporated fix provided by vendor.
+ --
+ --!
+ 
+ with Calendar;
+ use type Calendar.Time;
+ with Report;
+ with Impdef;
+ procedure C954026 is
+     Verbose : constant Boolean := False;
+     Final_Po_Reached : Boolean := False;
+     Allowed_Time : constant Duration := 2.0 * Impdef.One_Long_Second;
+     Plenty_Of_Time : constant Duration :=
+        Allowed_Time + Impdef.Clear_Ready_Queue + 1.0 * Impdef.One_Long_Second;
+     Not_Enough_Time : constant Duration := Allowed_Time - 0.5 * Impdef.One_Long_Second;
+ begin
+     Report.Test ("C954026",
+                  "Check that if the original entry" &
+                     " call was a conditional or timed entry call," &
+                     " the expiration time for a requeue with" &
+                     " abort to a protected" &
+                     " entry is the original expiration time");
+     declare
+ 
+         protected Initial_Po is
+             entry Start_Here;
+         end Initial_Po;
+ 
+         protected Final_Po is
+             entry Requeue_Target;
+             procedure Ok_To_Take_Requeue;
+             procedure Close_Requeue;
+         private
+             Open : Boolean := False;
+         end Final_Po;
+ 
+         -- the Delayed_Opener task is used to notify Final_PO that it can
+         -- accept the Requeue_Target entry.
+         task Delayed_Opener is
+             entry Start_Timer (Amt : Duration);
+             entry Cancel_Timer;
+         end Delayed_Opener;
+ 
+         task body Delayed_Opener is
+             Wait_Amt : Duration;
+         begin
+             loop
+                 accept Start_Timer (Amt : Duration) do
+                     Wait_Amt := Amt;
+                 end Start_Timer;
+                 exit when Wait_Amt < 0.0;
+                 if Verbose then
+                     Report.Comment ("Timer started");
+                 end if;
+                 select
+                     accept Cancel_Timer do
+                         Final_Po.Close_Requeue;
+                     end Cancel_Timer;   
+                 or              
+                     delay Wait_Amt;
+                     Final_Po.Ok_To_Take_Requeue;
+                     accept Cancel_Timer do
+                         Final_Po.Close_Requeue;
+                     end Cancel_Timer;   
+                 end select;     
+             end loop;
+         exception
+             when others =>
+                 Report.Failed ("exception in Delayed_Opener");
+         end Delayed_Opener;
+ 
+         protected body Initial_Po is
+             entry Start_Here when True is
+             begin
+                 Final_Po_Reached := False;
+                 requeue Final_Po.Requeue_Target with abort;
+             end Start_Here;
+         end Initial_Po;
+ 
+         protected body Final_Po is
+             entry Requeue_Target when Open is
+             begin
+                 Open := False;
+                 Final_Po_Reached := True;
+             end Requeue_Target;
+ 
+             procedure Ok_To_Take_Requeue is
+             begin
+                 Open := True;
+             end Ok_To_Take_Requeue;
+ 
+             procedure Close_Requeue is          
+             begin                       
+                 Open := False;  
+             end Close_Requeue;
+         end Final_Po;
+ 
+     begin   -- test encapsulation
+         -- unconditional entry call to check the simple case
+         Delayed_Opener.Start_Timer (0.0);
+         Initial_Po.Start_Here;
+         if Final_Po_Reached then
+             if Verbose then
+                 Report.Comment ("simple case passed");
+             end if;
+         else
+             Report.Failed ("simple case");
+         end if;
+         Delayed_Opener.Cancel_Timer;
+ 
+ 
+         -- timed but with plenty of time - delay relative
+         Delayed_Opener.Start_Timer (Allowed_Time);
+         select
+             Initial_Po.Start_Here;
+         or
+             delay Plenty_Of_Time;
+             Report.Failed ("plenty of time timed out (1)");
+             if Final_Po_Reached then
+                 Report.Failed (
+                    "plenty of time timed out after accept (1)");
+             end if;
+         end select;
+         if Final_Po_Reached then
+             if Verbose then
+                 Report.Comment ("plenty of time case passed (1)");
+             end if;
+         else
+             Report.Failed ("plenty of time (1)");
+         end if;
+         Delayed_Opener.Cancel_Timer;
+ 
+ 
+         -- timed but with plenty of time  -- delay until
+         Delayed_Opener.Start_Timer (Allowed_Time);
+         select
+             Initial_Po.Start_Here;
+         or
+             delay until Calendar.Clock + Plenty_Of_Time;
+             Report.Failed ("plenty of time timed out (2)");
+             if Final_Po_Reached then
+                 Report.Failed (
+                   "plenty of time timed out after accept(2)");
+             end if;
+         end select;
+         if Final_Po_Reached then
+             if Verbose then
+                 Report.Comment ("plenty of time case passed (2)");
+             end if;
+         else
+             Report.Failed ("plenty of time (2)");
+         end if;
+         Delayed_Opener.Cancel_Timer;
+ 
+ 
+         -- timed without enough time - delay relative
+         Delayed_Opener.Start_Timer (Allowed_Time);
+         select
+             Initial_Po.Start_Here;
+             Report.Failed ("not enough time completed accept (1)");
+         or
+             delay Not_Enough_Time;
+         end select;
+         if Final_Po_Reached then
+             Report.Failed ("not enough time (1)");
+         else
+             if Verbose then
+                 Report.Comment ("not enough time case passed (1)");
+             end if;
+         end if;
+         Delayed_Opener.Cancel_Timer;
+ 
+ 
+         -- timed without enough time - delay until
+         Delayed_Opener.Start_Timer (Allowed_Time);
+         select
+             Initial_Po.Start_Here;
+             Report.Failed ("not enough time completed accept (2)");
+         or
+             delay until Calendar.Clock + Not_Enough_Time;
+         end select;
+         if Final_Po_Reached then
+             Report.Failed ("not enough time (2)");
+         else
+             if Verbose then
+                 Report.Comment ("not enough time case passed (2)");
+             end if;
+         end if;
+         Delayed_Opener.Cancel_Timer;
+ 
+ 
+         -- conditional case
+         Delayed_Opener.Start_Timer (Allowed_Time);
+         select
+             Initial_Po.Start_Here;
+             Report.Failed ("no time completed accept");
+         else
+             if Verbose then
+                 Report.Comment ("conditional case - else taken");
+             end if;
+         end select;
+         if Final_Po_Reached then
+             Report.Failed ("no time");
+         else
+             if Verbose then
+                 Report.Comment ("no time case passed");
+             end if;
+         end if;
+         Delayed_Opener.Cancel_Timer;
+ 
+         -- kill off the Delayed_Opener task
+         Delayed_Opener.Start_Timer (-10.0);
+ 
+     exception
+         when others =>
+             Report.Failed ("exception in main");
+     end;
+ 
+     Report.Result;
+ end C954026;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,262 ----
+ -- C954A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a task requeued without abort on a protected entry queue
+ --      is aborted, the abort is deferred until the entry call completes,
+ --      after which the task becomes completed.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a protected type which simulates a printer device driver
+ --      (foundation code).
+ --
+ --      Declare a task which simulates a printer server for multiple printers.
+ --
+ --      For the protected type, declare an entry with a barrier that is set
+ --      false by a protected procedure (which simulates starting a print job
+ --      on the printer), and is set true by a second protected procedure (which
+ --      simulates a handler called when the printer interrupts, indicating
+ --      that printing is done).
+ --
+ --      For the task, declare an entry whose corresponding accept statement
+ --      contains a call to first protected procedure of the protected type
+ --      (which sets the barrier of the protected entry to false), followed by
+ --      a requeue with abort to the protected entry. Declare a second entry
+ --      which does nothing.
+ --
+ --      Declare a "requesting" task which calls the printer server task entry
+ --      (and thus executes the requeue). Attempt to abort the requesting
+ --      task. Verify that it is not aborted. Call the second protected
+ --      procedure of the protected type (the interrupt handler) and verify that
+ --      the protected entry completes for the requesting task. Verify that
+ --      the requesting task is then aborted.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F954A00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      10 Oct 96   SAIC    Added pragma elaborate.
+ --
+ --!
+ 
+ package C954A01_0 is  -- Printer server abstraction.
+ 
+    -- Simulate a system with multiple printers. The entry Print requests
+    -- that data be printed on the next available printer. The entry call
+    -- is accepted when a printer is available, and completes when printing
+    -- is done.
+ 
+ 
+    task Printer_Server is
+       entry Print (File_Name : String);        -- Test the requeue statement.
+       entry Verify_Results;                    -- Artifice for test purposes.
+    end Printer_Server;
+ 
+ end C954A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with F954A00;              -- Printer device abstraction.
+ use  F954A00;
+ pragma Elaborate(F954A00);
+ 
+ package body C954A01_0 is  -- Printer server abstraction.
+ 
+    task body Printer_Server is
+       Printers_Busy  : Boolean    := True;
+       Index          : Printer_ID := 1;
+       Print_Accepted : Boolean    := False;
+    begin
+ 
+       loop
+          -- Wait for a printer to become available:
+ 
+          while Printers_Busy loop
+             Printers_Busy := False;                        -- Exit loop if
+                                                            -- entry accepted.
+             select
+                Printer(Index).Done_Printing;               -- Accepted immed.
+                                                            -- when printer is
+                                                            -- available.
+             else
+                Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
+                Printers_Busy := True;                      -- accepted; keep
+             end select;                                    -- looping.
+          end loop;
+                                                            -- Value of Index
+                                                            -- at loop exit
+                                                            -- identifies the
+                                                            -- avail. printer.
+ 
+          -- Wait for a print request or terminate:
+ 
+          select
+             accept Print (File_Name : String) do
+                Print_Accepted := True;                     -- Allow
+                                                            -- Verify_Results
+                                                            -- to be accepted.
+ 
+                Printer(Index).Start_Printing (File_Name);  -- Begin printing on
+                                                            -- the available
+                --                        --                -- printer.
+                -- Requeue is tested here --
+                --                        --
+                                                            -- Requeue caller so
+                requeue Printer(Index).Done_Printing;       -- server task free
+                                                            -- to accept other
+             end Print;                                     -- requests.
+          or
+             --  Guard ensures that Verify_Results cannot be accepted
+             --  until after Print has been accepted. This avoids a
+             --  race condition in the main program.
+ 
+             when Print_Accepted => accept Verify_Results;  -- Artifice for
+                                                            -- testing purposes.
+          or
+             terminate;
+          end select;
+ 
+          -- Allow other tasks to get control
+          delay ImpDef.Long_Minimum_Task_Switch;
+ 
+       end loop;
+ 
+    exception
+       when others =>
+          Report.Failed ("Exception raised in Printer_Server task");
+    end Printer_Server;
+ 
+ 
+ end C954A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with F954A00;    -- Printer device abstraction.
+ with C954A01_0;  -- Printer server abstraction.
+ 
+ use  C954A01_0;
+ use  F954A00;
+ 
+ procedure C954A01 is
+ 
+    Long_Enough : constant Duration := ImpDef.Long_Switch_To_New_Task;
+ 
+                --==============================================--
+ 
+    task Print_Request;                       -- Send a print request.
+ 
+    task body Print_Request is
+       My_File : constant String := "MYFILE.DAT";
+    begin
+       Printer_Server.Print (My_File);          -- Invoke requeue statement.
+       Report.Failed ("Task continued execution following entry call");
+    exception
+       when others =>
+          Report.Failed ("Exception raised in Print_Request task");
+    end Print_Request;
+ 
+                --==============================================--
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C954A01", "Requeue without abort - check that the abort " &
+             "is deferred until after the rendezvous completes. (Task to PO)");
+ 
+    --  To pass this test, the following must be true:
+    -- 
+    --     (A) The abort of Print_Request is deferred until after the
+    --         Done_Printing entry body completes.
+    --     (B) Print_Request aborts after the Done_Printing entry call
+    --         completes.
+    -- 
+    --  Call the entry Verify_Results. The entry call will not be accepted
+    --  until after Print_Request has been requeued to Done_Printing.
+ 
+    Printer_Server.Verify_Results;           -- Accepted after Print_Request is
+                                             -- requeued to Done_Printing.
+ 
+    -- Simulate an application which needs access to the printer within
+    -- a specified time, and which aborts the current printer job if time
+    -- runs out.
+ 
+    select
+       Printer(1).Done_Printing;             -- Wait for printer to come free.
+    or
+       delay Long_Enough;                    -- Print job took too long.
+       abort Print_Request;                  -- Abort print job.
+    end select;
+ 
+    Printer_Server.Verify_Results;           -- Abortion completion point: force
+                                             -- abort to complete (if it's going
+                                             -- to).
+ 
+    --  Verify that the Done_Printing entry body has not yet completed,
+    --  and thus that Print_Request has not been aborted.
+ 
+    if Printer(1).Is_Done then
+       Report.Failed ("Target entry of requeue executed prematurely");
+    elsif Print_Request'Terminated then
+       Report.Failed ("Caller was aborted before entry was complete");
+    else
+ 
+       Printer(1).Handle_Interrupt;          -- Simulate a printer interrupt,
+                                             -- signaling that printing is
+                                             -- done.
+ 
+       --  The Done_Printing entry body will complete before the next protected
+       --  action is called (Printer(1).Is_Done). Verify (A) and (B): that the
+       --  Print_Request is aborted.
+ 
+       Printer_Server.Verify_Results;        -- Abortion completion point: force
+                                             -- Print_Request abort to complete.
+ 
+       if not Printer(1).Is_Done then
+          Report.Failed ("Target entry of requeue did not complete");
+       end if;
+ 
+       if not Print_Request'Terminated then
+          Report.Failed ("Task not aborted following completion of entry call");
+          abort Print_Request;               -- Try to kill hung task.
+       end if;
+ 
+    end if;
+ 
+    Report.Result;
+ 
+ end C954A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,259 ----
+ -- C954A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a task requeued with abort on a protected entry queue
+ --      is aborted, the protected entry call is canceled and the aborted
+ --      task becomes completed.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a protected type which simulates a printer device driver
+ --      (foundation code).
+ --
+ --      Declare a task which simulates a printer server for multiple printers.
+ --
+ --      For the protected type, declare an entry with a barrier that is set
+ --      false by a protected procedure (which simulates starting a print job
+ --      on the printer), and is set true by a second protected procedure (which
+ --      simulates a handler called when the printer interrupts, indicating
+ --      that printing is done).
+ --
+ --      For the task, declare an entry whose corresponding accept statement
+ --      contains a call to first protected procedure of the protected type
+ --      (which sets the barrier of the protected entry to false), followed by
+ --      a requeue with abort to the protected entry. Declare a second entry
+ --      which does nothing.
+ --
+ --      Declare a "requesting" task which calls the printer server task entry
+ --      (and thus executes the requeue). Attempt to abort the requesting
+ --      task. Verify that it is aborted, that the requeued entry call is
+ --      canceled, and that the corresponding entry body is not executed.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F954A00.A
+ --
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      10 Oct 96   SAIC    Added pragma elaborate
+ --
+ --!
+ 
+ package C954A02_0 is  -- Printer server abstraction.
+ 
+    -- Simulate a system with multiple printers. The entry Print requests
+    -- that data be printed on the next available printer. The entry call
+    -- is accepted when a printer is available, and completes when printing
+    -- is done.
+ 
+ 
+    task Printer_Server is
+       entry Print (File_Name : String);        -- Test the requeue statement.
+       entry Verify_Results;                    -- Artifice for test purposes.
+    end Printer_Server;
+ 
+ end C954A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with F954A00;              -- Printer device abstraction.
+ use  F954A00;
+ pragma Elaborate(F954a00);
+ 
+ package body C954A02_0 is  -- Printer server abstraction.
+ 
+    task body Printer_Server is
+       Printers_Busy  : Boolean    := True;
+       Index          : Printer_ID := 1;
+       Print_Accepted : Boolean    := False;
+    begin
+ 
+       loop
+          -- Wait for a printer to become available:
+ 
+          while Printers_Busy loop
+             Printers_Busy := False;                        -- Exit loop if
+                                                            -- entry accepted.
+             select
+                Printer(Index).Done_Printing;               -- Accepted immed.
+                                                            -- when printer is
+                                                            -- available.
+             else
+                Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
+                Printers_Busy := True;                      -- accepted; keep
+             end select;                                    -- looping.
+ 
+             -- Allow other task to get control
+             delay ImpDef.Minimum_Task_Switch;  
+ 
+          end loop;                                         -- Value of Index
+                                                            -- at loop exit
+                                                            -- identifies the
+                                                            -- avail. printer.
+ 
+          -- Wait for a print request or terminate:
+ 
+          select
+             accept Print (File_Name : String) do
+                Print_Accepted := True;                     -- Allow
+                                                            -- Verify_Results
+                                                            -- to be accepted.
+ 
+                Printer(Index).Start_Printing (File_Name);  -- Begin printing on
+                                                            -- the available
+                --                        --                -- printer.
+                -- Requeue is tested here --
+                --                        --
+                                                            -- Requeue caller so
+                requeue Printer(Index).Done_Printing        -- server task free
+                  with abort;                               -- to accept other
+             end Print;                                     -- requests.
+          or
+             -- Guard ensures that Verify_Results cannot be accepted
+             -- until after Print has been accepted. This avoids a
+             -- race condition in the main program.
+ 
+             when Print_Accepted => accept Verify_Results;  -- Artifice for
+                                                            -- testing purposes.
+          or
+             terminate;
+          end select;
+ 
+       end loop;
+ 
+    exception
+       when others =>
+          Report.Failed ("Exception raised in Printer_Server task");
+    end Printer_Server;
+ 
+ 
+ end C954A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with F954A00;    -- Printer device abstraction.
+ with C954A02_0;  -- Printer server abstraction.
+ 
+ use  C954A02_0;
+ use  F954A00;
+ 
+ procedure C954A02 is
+ 
+    -- Length of time which simulates a very long process
+    Long_Enough : constant Duration := ImpDef.Clear_Ready_Queue;
+ 
+                --==============================================--
+ 
+    task Print_Request;                       -- Send a print request.
+ 
+    task body Print_Request is
+       My_File : constant String := "MYFILE.DAT";
+    begin
+       Printer_Server.Print (My_File);          -- Invoke requeue statement.
+       Report.Failed ("Task continued execution following entry call");
+    exception
+       when others =>
+          Report.Failed ("Exception raised in Print_Request task");
+    end Print_Request;
+ 
+                --==============================================--
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C954A02", "Abort a requeue on a Protected entry");
+ 
+    -- To pass this test, the following must be true:
+    --
+    --    (A) The abort of Print_Request takes place immediately.
+    --    (B) The Done_Printing entry call is canceled, and the corresponding
+    --        entry body is not executed.
+    --
+    -- Call the entry Verify_Results. The entry call will not be accepted
+    -- until after Print_Request has been requeued to Done_Printing.
+ 
+    Printer_Server.Verify_Results;           -- Accepted after Print_Request is
+                                             -- requeued to Done_Printing.
+ 
+    -- Verify that the Done_Printing entry call has not been completed.
+    --
+    if Printer(1).Is_Done then
+       Report.Failed ("Target entry of requeue executed prematurely");
+    else
+ 
+       -- Simulate an application which needs access to the printer within
+       -- a specified time, and which aborts the current printer job if time
+       -- runs out.
+ 
+       select
+          Printer(1).Done_Printing;          -- Wait for printer to come free.
+       or
+          delay Long_Enough;                 -- Print job took too long.
+          abort Print_Request;               -- Abort print job.
+       end select;
+ 
+       Printer_Server.Verify_Results;        -- Abortion completion point: force
+                                             -- Print_Request abort to complete.
+ 
+       -- Verify (A): that Print_Request has been aborted.
+       -- Note: the test will hang if the task as not been aborted
+       --
+       while not Print_Request'Terminated loop
+          delay ImpDef.Minimum_Task_Switch;  
+       end loop;
+ 
+       -- Verify (B): that the Done_Printing entry call was canceled, and
+       -- the corresponding entry body was not executed.
+       --
+       -- Set the barrier of the entry to true, then check that the entry
+       -- body is not executed. If the entry call is NOT canceled, the
+       -- entry body will execute when the barrier is set true.
+ 
+       Printer(1).Handle_Interrupt;       -- Simulate a printer interrupt,
+                                          -- signaling that printing is
+                                          -- done.
+       if Printer(1).Is_Done then
+          Report.Failed ("Entry call was not canceled");
+       end if;
+ 
+ 
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C954A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954a03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954a03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c954a03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c954a03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,322 ----
+ -- C954A03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a requeue statement in an accept_statement with
+ --      parameters may requeue the entry call to a protected entry with no
+ --      parameters. Check that, if the call is queued on the new entry's
+ --      queue, the original caller remains blocked after the requeue, but
+ --      the accept_statement containing the requeue is completed.
+ --
+ --      Note that this test uses a requeue "with abort," although it does not
+ --      check that such a requeued caller can be aborted; that feature is
+ --      tested elsewhere.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a protected type which simulates a printer device driver
+ --      (foundation code).
+ --
+ --      Declare a task which simulates a printer server for multiple printers.
+ --
+ --      For the protected type, declare an entry with a barrier that is set
+ --      false by a protected procedure (which simulates starting a print job
+ --      on the printer), and is set true by a second protected procedure (which
+ --      simulates a handler called when the printer interrupts, indicating
+ --      that printing is done).
+ --
+ --      For the task, declare an entry whose corresponding accept statement
+ --      contains a call to first protected procedure of the protected type
+ --      (which sets the barrier of the protected entry to false), followed by
+ --      a requeue with abort to the protected entry. Declare a second entry
+ --      which does nothing.
+ --
+ --      Declare a "requesting" task which calls the printer server task entry
+ --      (and thus executes the requeue). Verify that, following the requeue,
+ --      the requesting task remains blocked. Call the second entry of the
+ --      printer server task (the acceptance of this entry call verifies that
+ --      the requeue statement completed the entry call by the requesting task.
+ --      Call the second protected procedure of the protected type (the
+ --      interrupt handler) and verify that the protected entry completes for
+ --      the requesting task (which verifies that the requeue statement queued
+ --      the first task object to the protected entry).
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F954A00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      10 Oct 96   SAIC    Added pragma elaborate.
+ --
+ --!
+ 
+ package C954A03_0 is  -- Printer server abstraction.
+ 
+    -- Simulate a system with multiple printers. The entry Print requests
+    -- that data be printed on the next available printer. The entry call
+    -- is accepted when a printer is available, and completes when printing
+    -- is done.
+ 
+    task Printer_Server is
+       entry Print (File_Name : String);        -- Test the requeue statement.
+       entry Verify_Results;                    -- Artifice for test purposes.
+    end Printer_Server;
+ 
+ end C954A03_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with F954A00;              -- Printer device abstraction.
+ use  F954A00;
+ pragma Elaborate(F954a00);
+ 
+ package body C954A03_0 is  -- Printer server abstraction.
+ 
+ 
+    task body Printer_Server is
+       Printers_Busy  : Boolean    := True;
+       Index          : Printer_ID := 1;
+       Print_Accepted : Boolean    := False;
+    begin
+ 
+       loop
+          -- Wait for a printer to become available:
+ 
+          while Printers_Busy loop
+             Printers_Busy := False;                        -- Exit loop if
+                                                            -- entry accepted.
+             select
+                Printer(Index).Done_Printing;               -- Accepted immed.
+                                                            -- when printer is
+                                                            -- available.
+             else
+                Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
+                Printers_Busy := True;                      -- accepted; keep
+             end select;                                    -- looping.
+ 
+             -- Allow other tasks to get control
+             delay ImpDef.Minimum_Task_Switch;   
+ 
+          end loop;
+                                                            -- Value of Index
+                                                            -- at loop exit
+                                                            -- identifies the
+                                                            -- avail. printer.
+ 
+          -- Wait for a print request or terminate:
+ 
+          select
+             accept Print (File_Name : String) do
+                Print_Accepted := True;                     -- Allow
+                                                            -- Verify_Results
+                                                            -- to be accepted.
+ 
+                Printer(Index).Start_Printing (File_Name);  -- Begin printing on
+                                                            -- the available
+                --                        --                -- printer.
+                -- Requeue is tested here --
+                --                        --
+                                                            -- Requeue caller so
+                requeue Printer(Index).Done_Printing        -- server task free
+                  with abort;                               -- to accept other
+             end Print;                                     -- requests.
+          or
+             -- Guard ensures that Verify_Results cannot be accepted
+             -- until after Print has been accepted. This avoids a
+             -- race condition in the main program.
+ 
+             when Print_Accepted => accept Verify_Results;  -- Artifice for
+                                                            -- testing purposes.
+          or
+             terminate;
+          end select;
+ 
+       end loop;
+ 
+    exception
+       when others =>
+          Report.Failed ("Exception raised in Printer_Server task");
+    end Printer_Server;
+ 
+ 
+ end C954A03_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with F954A00;    -- Printer device abstraction.
+ with C954A03_0;  -- Printer server abstraction.
+ 
+ use  C954A03_0;
+ use  F954A00;
+ 
+ procedure C954A03 is
+ 
+    Long_Enough : constant Duration := ImpDef.Clear_Ready_Queue;
+ 
+ 
+                --==============================================--
+ 
+    Task_Completed : Boolean := False;          -- Testing flag.
+ 
+    protected Interlock is                      -- Artifice for test purposes.
+       entry Wait;                              -- Wait for lock to be released.
+       procedure Release;                       -- Release the lock.
+    private
+       Locked : Boolean := True;
+    end Interlock;
+ 
+ 
+    protected body Interlock is
+ 
+       entry Wait when not Locked is            -- Calls are queued until after
+       --                                       -- Release is called.
+       begin
+          Task_Completed := True;               
+       end Wait;
+ 
+       procedure Release is                     -- Called by Print_Request.
+       begin
+          Locked := False;
+       end Release;
+ 
+    end Interlock;
+ 
+                --==============================================--
+ 
+    task Print_Request is                       -- Send a print request.
+    end Print_Request;
+ 
+    task body Print_Request is
+       My_File : constant String := "MYFILE.DAT";
+    begin
+       Printer_Server.Print (My_File);          -- Invoke requeue statement.
+       Interlock.Release;                       -- Allow main to continue.
+    exception
+       when others =>
+          Report.Failed ("Exception raised in Print_Request task");
+    end Print_Request;
+ 
+                --==============================================--
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C954A03", "Requeue from an Accept with parameters" &
+                               " to a Protected Entry without parameters");
+ 
+    -- To pass this test, the following must be true:
+    --
+    --    (A) The Print entry call made by the task Print_Request must be
+    --        completed by the requeue statement.
+    --    (B) Print_Request must remain blocked following the requeue.
+    --    (C) Print_Request must be queued on the Done_Printing queue of
+    --        Printer(1).
+    --    (D) Print_Request must continue execution after Done_Printing is
+    --        complete.
+    --
+    -- First, verify (A): that the Print entry call is complete.
+    --
+    -- Call the entry Verify_Results. If the requeue statement completed the
+    -- entry call to Print, the entry call to Verify_Results should be
+    -- accepted. Since the main will hang if this is NOT the case, make this
+    -- a timed entry call.
+ 
+    select
+       Printer_Server.Verify_Results;        -- Accepted if requeue completed
+                                             -- entry call to Print.
+    or
+       delay Long_Enough;                    -- Time out otherwise.
+       Report.Failed ("Requeue did not complete entry call");
+    end select;
+ 
+    -- Now verify (B): that Print_Request remains blocked following the
+    -- requeue. Also verify that Done_Printing (the entry to which
+    -- Print_Request should have been queued) has not yet executed.
+ 
+    if Printer(1).Is_Done then
+       Report.Failed ("Target entry of requeue executed prematurely");
+    elsif Print_Request'Terminated then
+       Report.Failed ("Caller did not remain blocked after the requeue");
+    else
+ 
+       -- Verify (C): that Print_Request is queued on the
+       -- Done_Printing queue of Printer(1).
+       --
+       -- Set the barrier for Printer(1).Done_Printing to true. Check
+       -- that the Done flag is updated and that Print_Request terminates.
+ 
+       Printer(1).Handle_Interrupt;             -- Simulate a printer interrupt,
+                                                -- signaling that printing is
+                                                -- done.
+ 
+       -- The Done_Printing entry body will complete before the next
+       -- protected action is called (Printer(1).Is_Done).
+ 
+       if not Printer(1).Is_Done then
+          Report.Failed ("Caller was not requeued on target entry");
+       end if;
+ 
+       -- Finally, verify (D): that Print_Request continues after Done_Printing
+       -- completes.
+       --
+       -- After Done_Printing completes, there is a potential race condition
+       -- between the main program and Print_Request. The protected object
+       -- Interlock is provided to ensure that the check of whether
+       -- Print_Request continued is made *after* it has had a chance to do so.
+       -- The main program waits until the statement in Print_Request following
+       -- the requeue-causing statement has executed, then checks to see
+       -- whether Print_Request did in fact continue executing.
+       --
+       -- Note that the test will hang here if Print_Request does not continue
+       -- executing following the completion of the requeued entry call.
+ 
+       Interlock.Wait;                          -- Wait until Print_Request is
+                                                -- done.
+       if not Task_Completed then
+          Report.Failed ("Caller remained blocked after target " &
+                         "entry released");
+       end if;
+ 
+       -- Wait for Print_Request to finish before calling Report.Result.
+       while not Print_Request'Terminated loop
+          delay ImpDef.Minimum_Task_Switch;   
+       end loop;                             
+ 
+    end if;
+ 
+    Report.Result;
+ 
+ end C954A03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c960001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c960001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c960001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c960001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- C960001.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Confirm that a simple Delay Until statement is performed.  Check
+ --      that the delay does not complete before the requested time and that it
+ --      does complete thereafter
+ --
+ -- TEST DESCRIPTION:
+ --      Simulate a task that sends a "pulse" at regular intervals.  The Delay
+ --      Until statement is used to avoid accumulated drift.  For the
+ --      test, we expect the delay to return very close to the requested time;
+ --      we use an additional Pulse_Time_Delta for the limit.  The test
+ --      driver (main) artificially limits the number of iterations by setting
+ --      the Stop_Pulse Boolean after a small number.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Nov 95   SAIC    Fixed global variable problem for ACVC 2.0.1
+ --
+ --!
+ 
+ with Report;
+ with Ada.Calendar;
+ with ImpDef;
+          
+ procedure C960001 is
+ 
+ begin
+ 
+    Report.Test ("C960001", "Simple Delay Until");
+ 
+    declare  -- To get the Report.Result after all has completed
+ 
+       function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                             return Ada.Calendar.Time renames Ada.Calendar."+";
+       function "<" (Left, Right : Ada.Calendar.Time)
+                             return Boolean       renames Ada.Calendar."<";
+       function ">" (Left, Right : Ada.Calendar.Time)
+                             return Boolean       renames Ada.Calendar.">";
+ 
+       TC_Loop_Count : integer range 0..4 := 0; 
+      
+ 
+       -- control over stopping tasks
+       protected Control is
+          procedure Stop_Now;
+          function Stop return Boolean;
+       private
+          Halt : Boolean := False;
+       end Control;
+ 
+       protected body Control is
+          procedure Stop_Now is
+          begin
+             Halt := True;
+          end Stop_Now;
+ 
+          function Stop return Boolean is
+          begin
+             return Halt;
+          end Stop;
+       end Control;
+  
+       task Pulse_Task is 
+          entry Trigger;
+       end Pulse_Task;
+    
+ 
+       -- Task to synchronize all qualified receivers.  
+       -- The entry Trigger starts the synchronization; Control.Stop 
+       -- becoming true terminates the task.
+       --
+       task body Pulse_Task is
+ 
+          Pulse_Time       : Ada.Calendar.Time;
+ 
+          Pulse_Time_Delta : duration :=  ImpDef.Clear_Ready_Queue;
+ 
+          TC_Last_Time : Ada.Calendar.Time;
+          TC_Current   : Ada.Calendar.Time;
+ 
+ 
+          -- This routine transmits a synchronizing "pulse" to
+          -- all receivers
+          procedure Pulse is
+          begin
+             null;  -- Stub
+             Report.Comment (".......PULSE........");
+          end Pulse;
+          
+       begin
+          accept Trigger;
+ 
+          Pulse_Time   := Ada.Calendar.Clock + Pulse_Time_Delta; 
+          TC_Last_Time := Pulse_Time;
+ 
+          while not Control.Stop loop
+             delay until Pulse_Time;
+             Pulse;
+ 
+             -- Calculate time for next pulse.  Note: this is based on the
+             -- last pulse time, not the time we returned from the delay
+             --
+             Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+             
+             -- Test Control:
+             TC_Current := Ada.Calendar.Clock;
+             if TC_Current < TC_Last_Time then
+                Report.Failed ("Delay expired before requested time");
+             end if;
+             if TC_Current > Pulse_Time then
+                Report.Failed ("Delay too long");
+             end if;               
+             TC_Last_Time := Pulse_Time;
+             TC_Loop_Count := TC_Loop_Count +1;
+          end loop; 
+ 
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Pulse_Task");
+       end Pulse_Task;
+ 
+ 
+ 
+    begin -- declare
+ 
+       Pulse_Task.Trigger;      -- Start test                            
+ 
+       -- Artificially limit the number of iterations
+       while TC_Loop_Count < 3 loop
+          delay ImpDef.Minimum_Task_Switch;
+       end loop;
+       --
+       Control.Stop_Now;      -- End test
+ 
+    end; -- declare
+ 
+    Report.Result;
+ 
+ end C960001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c960002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c960002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c960002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c960002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,171 ----
+ -- C960002.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the simple "delay until" when the request time is "now" and
+ --      also some time already in the past is obeyed and returns immediately
+ --
+ -- TEST DESCRIPTION:
+ --      Simulate a task that sends a "pulse" at regular intervals.  The Delay
+ --      Until statement is used to avoid accumulated drift.  In this test
+ --      three simple situations simulating the start of drift are used:  the
+ --      next pulse being called for at the normal time, the next pulse being
+ --      called for at exactly the current time and then at some time which has
+ --      already past.  We assume the delay is within a While Loop and, to
+ --      simplify the test, we "unfold" the While Loop and  execute the Delays
+ --      in a serial fashion.  This loop is shown in test C960001.
+ --      It is not possible to test the actual immediacy of the expiration. We
+ --      can only check that it returns in a "reasonable" time.  In this case
+ --      we check that it expires before the next "pulse" should have been 
+ --      issued.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ with Ada.Calendar;
+ with System;                                       
+          
+ procedure C960002 is
+ 
+ begin
+ 
+    Report.Test ("C960002", "Simple Delay Until with requested time being" &
+                         " ""now"" and time already in the past");
+ 
+    declare  -- To get the Report.Result after all has completed
+ 
+       function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                             return Ada.Calendar.Time renames Ada.Calendar."+";
+       function "-" (Left : Ada.Calendar.Time; Right: Duration)
+                             return Ada.Calendar.Time renames Ada.Calendar."-";
+       function "-" (Left, Right : Ada.Calendar.Time)
+                             return duration      renames Ada.Calendar."-";
+       function ">" (Left, Right : Ada.Calendar.Time)
+                             return Boolean       renames Ada.Calendar.">";
+ 
+       
+       task Pulse_Task is 
+          entry Trigger;
+       end Pulse_Task;
+    
+ 
+       -- Task to synchronize all qualified receivers.  
+       -- The entry Trigger starts the synchronization. 
+       --
+       task body Pulse_Task is
+          Pulse_Time       : Ada.Calendar.Time;
+          Pulse_Time_Delta : constant duration := ImpDef.Clear_Ready_Queue; 
+ 
+ 
+ 
+          TC_Time_Back     : Ada.Calendar.Time;
+ 
+ 
+          -- This routine transmits a synchronizing "pulse" to
+          -- all receivers
+          procedure Pulse is
+          begin
+             null;  -- Stub
+             Report.Comment (".......PULSE........");      
+          end Pulse;
+          
+       begin
+          accept Trigger;
+          Pulse;
+          ---------------
+          -- normal calculation for "next"
+          Pulse_Time := Ada.Calendar.Clock + Pulse_Time_Delta; 
+ 
+          -- TC:  unfold the "while" loop in C960001.  Four passes through 
+          -- the loop are shown
+ 
+             delay until Pulse_Time;  
+ 
+             Pulse;
+             ---------------
+             -- TC: the normal calculation for "next" would be
+             -- Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+             -- Instead of this normal pulse time calculation simulate
+             -- the new pulse time to be exactly "now"  (or, as exactly as 
+             -- we can)
+             Pulse_Time := Ada.Calendar.Clock; 
+             delay until  Ada.Calendar.Clock; 
+ 
+             TC_Time_Back := Ada.Calendar.Clock;
+ 
+             -- Now check for reasonableness
+             if TC_Time_Back > Pulse_Time + Pulse_Time_Delta then
+                Report.Failed 
+                      ("""Now"" delayed for more than Pulse_Time_Delta - A");
+             end if;
+             Pulse;
+             ---------------
+             -- normal calculation for "next" would be
+             Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+ 
+             -- TC: Instead of this, simulate the new calculated pulse time
+             -- being already past
+             Pulse_Time := Ada.Calendar.Clock - System.Tick;
+             delay until Pulse_Time;
+ 
+             TC_Time_Back := Ada.Calendar.Clock;
+ 
+             -- Now check for reasonableness
+             if TC_Time_Back > Pulse_Time + Pulse_Time_Delta then
+                Report.Failed 
+                      ("""Now"" delayed for more than Pulse_Time_Delta - B");
+             end if;
+             Pulse;
+             ---------------
+             -- normal calculation for "next"
+             Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+             -- Now simulate getting back into synch
+             delay until Pulse_Time;
+             Pulse;
+             ---------------
+          -- This would be the end of the "while" loop
+ 
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Pulse_Task");
+       end Pulse_Task;
+ 
+ 
+ 
+    begin -- declare
+ 
+       Pulse_Task.Trigger;      -- Start test                            
+ 
+    end; -- declare
+ 
+    Report.Result;
+ 
+ end C960002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c960004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c960004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c960004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c960004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,206 ----
+ -- C960004.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --      
+ -- OBJECTIVE:
+ --      With the triggering statement being a delay and with the Asynchronous
+ --      Select statement being in a tasking situation complete the abortable
+ --      part before the delay expires.  Check that the delay is cancelled 
+ --      and that the optional statements in the triggering part are not
+ --      executed.
+ --
+ -- TEST DESCRIPTION:
+ --      Simulate the creation of a carrier task to control the output of 
+ --      a message via a line driver.  If the message sending process is 
+ --      not complete (the completion of the rendezvous) within a
+ --      specified time the carrier task is designed to take corrective action.
+ --      Use an asynchronous select to control the timing; arrange that
+ --      the abortable part (the rendezvous) completes almost immediately.
+ --      Check that the optional statements are not executed and that the
+ --      test completes well before the time of the trigger delay request thus
+ --      showing that it has been cancelled.
+ --                 
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+          
+                    
+ with Report;
+ with Ada.Calendar;
+          
+ procedure C960004 is
+ 
+    function "-" (Left, Right : Ada.Calendar.Time)
+                                     return Duration  renames Ada.Calendar."-";
+    TC_Start_Time      : Ada.Calendar.Time := Ada.Calendar.Clock;
+    TC_Elapsed_Time    : duration;
+ 
+    -- Note: a properly executing test will complete immediately.   
+    Allowable_ACK_Time : duration := 600.0;         
+ 
+ begin
+ 
+    Report.Test ("C960004", "ATC: When abortable part completes before " &
+                              "a triggering delay, check that the delay " &
+                              "is cancelled & optional statements " &
+                              "are not performed. Tasking situation"); 
+ 
+    declare  -- To get the Report.Result after all has completed
+ 
+       type Sequence_Number is range 1..1_999_999;   -- Message Number
+       subtype S_length_subtype  is integer range 1..80;
+ 
+       type Message_Type (Max_String : S_length_subtype := 1) is
+          record
+             Message_Number    : Sequence_Number;
+             Alpha             : string(1..Max_String);
+          end record;
+ 
+       -- TC:  Dummy message for the test
+       Dummy_Alpha     : constant string := "This could be printed";
+       Message_to_Send : Message_Type (Max_string => Dummy_Alpha'length);
+ 
+ 
+       -- This is the carrier task.  One of these is created for each
+       -- message that requires ACK
+       --
+       task type Require_ACK_task is 
+          entry Message_In (Message_to_Send: Message_Type);
+       end Require_ACK_task;      
+       type acc_Require_ACK_task is access Require_ACK_task;
+ 
+ 
+       --:::::::::::::::::::::::::::::::::
+       -- There would also be another task type "No_ACK_Task" which would
+       -- be the carrier task for those messages not requiring an ACK. 
+       -- This task would call Send_Message.ACK_Not_Required.  It is not
+       -- shown in this test as it is not used.
+       --:::::::::::::::::::::::::::::::::
+ 
+ 
+    
+       task Send_Message is 
+          entry ACK_Required     (Message_to_Send: Message_Type);
+          entry ACK_Not_Required (Message_to_Send: Message_Type);
+       end Send_Message;
+ 
+ 
+       -- This is the carrier task.  One of these is created for each
+       -- message that requires ACK
+       --
+       task body Require_ACK_task is 
+          Hold_Message : Message_Type;
+ 
+          procedure Time_Out (Failed_Message_Number : Sequence_Number) is
+          begin
+             -- Take remedial action on the timed-out message
+             null;    -- stub
+ 
+             Report.Failed ("Optional statements in triggering part" &
+                                     " were performed");
+          end Time_out;
+ 
+       begin   
+          accept Message_In (Message_to_Send: Message_Type) do
+             Hold_Message := Message_to_Send;    -- to release caller
+          end Message_In;
+ 
+          -- Now put the message out to the Send_Message task and 
+          -- wait (no more than Allowable_Ack_Time) for its completion
+          --
+          select
+             delay Allowable_ACK_Time;
+             -- ACK not received in specified time
+             Time_out (Hold_Message.Message_Number);
+          then abort
+             -- If the rendezvous is not completed in the above time, this
+             -- call is cancelled
+             --    Note: for this test this call will complete immediately
+             --          and thus the trigger should be cancelled
+             Send_Message.ACK_Required (Hold_Message);
+          end select;
+ 
+       exception
+          when others => 
+                Report.Failed ("Unexpected exception in Require_ACK_task");
+       end Require_ACK_task;      
+ 
+ 
+       -- This is the Line Driver task
+       --
+       task body Send_Message is
+          Hold_Non_ACK_Message : Message_Type;   
+       begin
+          loop
+             select
+                accept ACK_Required (Message_to_Send: Message_Type) do
+                   -- Here send the message from within the rendezvous 
+                   -- waiting for full transmission to complete
+                   null;  -- stub
+                   -- Note: In this test this accept will complete immediately
+                end ACK_Required;
+             or
+                accept ACK_Not_Required (Message_to_Send: Message_Type) do
+                   Hold_Non_ACK_Message := Message_to_Send;
+                end ACK_Not_Required;
+                -- Here send the message from outside the rendezvous
+                null;  -- stub
+             or 
+                terminate;
+             end select;
+          end loop;
+       exception
+          when others => Report.Failed ("Unexpected exception in Send_Message");
+       end Send_Message;
+ 
+    begin -- declare
+       -- Build a dummy message 
+       Message_to_Send.Alpha          := Dummy_Alpha;
+       Message_to_Send.Message_Number := 110_693;
+ 
+       declare
+          New_Require_ACK_task : acc_Require_ACK_task := 
+                                              new Require_ACK_task;
+       begin
+          -- Create a carrier task for this message and pass the latter in
+          New_Require_ACK_task.Message_In (Message_to_Send);
+       end; -- declare
+ 
+    end; -- declare
+ 
+    --Once we are out of the above declarative region, all tasks have completed
+ 
+    TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;
+    
+    -- Check that the test has completed well before the time of the requested
+    -- delay to ensure the delay was cancelled
+    --
+    if (TC_Elapsed_Time > Allowable_ACK_Time/2) then
+       Report.Failed ("Triggering delay statement was not cancelled");
+    end if;
+ 
+    Report.Result;
+ end C960004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- C96001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT A DELAY STATEMENT DELAYS EXECUTION FOR AT LEAST THE
+ --      SPECIFIED TIME. SPECIFICALLY,
+ --        (A) POSITIVE DELAY ARGUMENT.
+ --        (B) NEGATIVE DELAY ARGUMENT.
+ --        (C) ZERO DELAY ARGUMENT.
+ --        (D) DURATION'SMALL DELAY ARGUMENT.
+ --        (E) EXPRESSION OF TYPE DURATION AS DELAY ARGUMENT.
+ 
+ -- HISTORY:
+ --     CPP  8/14/84  CREATED ORIGINAL TEST.
+ --     RJW 11/13/87  ADDED CODE WHICH ALLOWS TEST TO REPORT "PASSED"
+ --                   IF TICK > DURATION'SMALL.
+ 
+ with Impdef;
+ WITH CALENDAR;  USE CALENDAR;
+ WITH SYSTEM;    USE SYSTEM;
+ WITH REPORT;    USE REPORT;
+ PROCEDURE C96001A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0 .. 20_000;
+ 
+ BEGIN
+      TEST ("C96001A", "CHECK THAT DELAY STATEMENT DELAYS " &
+            "EXECUTION FOR AT LEAST THE SPECIFIED TIME");
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (A)
+           X : DURATION := 5.0 * Impdef.One_Second;
+           OLD_TIME : TIME;
+           LAPSE : DURATION;
+      BEGIN     -- (A)
+           LOOP
+                OLD_TIME := CLOCK;
+                DELAY X;
+                LAPSE := CLOCK - OLD_TIME;
+                EXIT;
+           END LOOP;
+           IF LAPSE < X THEN
+                FAILED ("DELAY DID NOT LAPSE AT LEAST 5.0 " &
+                        "SECONDS - (A)");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (A)");
+      END;
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (B)
+           OLD_TIME : TIME;
+           LAPSE : DURATION;
+      BEGIN     -- (B)
+           LOOP
+                OLD_TIME := CLOCK;
+                DELAY -5.0;
+                LAPSE := CLOCK - OLD_TIME;
+                EXIT;
+           END LOOP;
+           COMMENT ("(B) - NEGATIVE DELAY LAPSED FOR " &
+                    INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (B)");
+      END;
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (C)
+           X : DURATION := 0.0;
+           OLD_TIME : TIME;
+           LAPSE : DURATION;
+      BEGIN     -- (C)
+           LOOP
+                OLD_TIME := CLOCK;
+                DELAY X;
+                LAPSE := CLOCK - OLD_TIME;
+                EXIT;
+           END LOOP;
+           COMMENT ("(C) - ZERO DELAY LAPSED FOR " &
+                    INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (C)");
+      END;
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (D)
+           X : DURATION := DURATION'SMALL;
+           OLD_TIME : TIME;
+           LAPSE : DURATION;
+      BEGIN     -- (D)
+           LOOP
+                OLD_TIME := CLOCK;
+                DELAY X;
+                LAPSE := CLOCK - OLD_TIME;
+                EXIT;
+           END LOOP;
+           IF LAPSE < X THEN
+                IF TICK < DURATION'SMALL THEN
+                     FAILED ("DELAY DID NOT LAPSE AT LEAST " &
+                             "DURATION'SMALL SECONDS - (D)");
+                ELSE
+                     COMMENT ("TICK > DURATION'SMALL SO DELAY IN " &
+                              "'(D)' IS NOT MEASURABLE");
+                END IF;
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (D)");
+      END;
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (E)
+           INC1 : DURATION := 2.0 * Impdef.One_Second;
+           INC2 : DURATION := 3.0 * Impdef.One_Second;
+           OLD_TIME : TIME;
+           LAPSE : DURATION;
+      BEGIN     -- (E)
+           LOOP
+                OLD_TIME := CLOCK;
+                DELAY INC1 + INC2;
+                LAPSE := CLOCK - OLD_TIME;
+                EXIT;
+           END LOOP;
+           IF LAPSE < (INC1 + INC2) THEN
+                FAILED ("DELAY DID NOT LAPSE AT LEAST " &
+                        "INC1 + INC2 SECONDS - (E)");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED - (E)");
+      END;
+ 
+      RESULT;
+ END C96001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,280 ----
+ -- C96004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE PRE-DEFINED SUBTYPES FROM THE PACKAGE CALENDAR,
+ --     NAMELY YEAR_NUMBER, MONTH_NUMBER, DAY_NUMBER, AND DAY_DURATION,
+ --     HAVE THE CORRECT RANGE CONSTRAINTS. SUBTESTS ARE:
+ --       (A) YEAR_NUMBER.
+ --       (B) MONTH_NUMBER.
+ --       (C) DAY_NUMBER.
+ --       (D) DAY_DURATION.
+ 
+ -- HISTORY:
+ --     CPP 08/15/84  CREATED ORIGINAL TEST.
+ --     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
+ --                   OPTIMIZATION.
+ --     RLB 12/18/06  Changed so that the test will work for Ada 2005
+ --                   implementations.
+ 
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C96004A IS
+ 
+ BEGIN
+      TEST("C96004A", "CHECK THAT PRE-DEFINED SUBTYPES FROM THE " &
+           "CALENDAR PACKAGE HAVE CORRECT RANGE CONSTRAINTS");
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (A)
+ 
+           YR : YEAR_NUMBER;
+ 
+      BEGIN     -- (A)
+ 
+           BEGIN
+                YR := 1900;
+                FAILED ("EXCEPTION NOT RAISED - (A)1");
+                IF NOT EQUAL (YR, YR) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (A)1");
+           END;
+ 
+           BEGIN
+                YR := 84;
+                FAILED ("EXCEPTION NOT RAISED - (A)2");
+                IF NOT EQUAL (YR, YR) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (A)2");
+           END;
+ 
+           BEGIN
+                YR := 2099;
+                IF NOT EQUAL (YR, YR) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("OK CASE RAISED EXCEPTION ON 2099 - (A)");
+           END;
+ 
+           BEGIN
+                YR := IDENT_INT(2100);
+                IF NOT EQUAL (YR, YR) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+                BEGIN
+                     YR := 2399;
+                     IF NOT EQUAL (YR, YR) THEN
+                          COMMENT ("NO EXCEPTION RAISED");
+                     END IF;
+ 
+                EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("ADA 2005 CASE RAISED EXCEPTION ON 2399 - (A)");
+                END;
+                BEGIN
+                     YR := IDENT_INT(2400);
+                     IF NOT EQUAL (YR, YR) THEN
+                         COMMENT ("NO EXCEPTION RAISED");
+                     END IF;
+                     FAILED ("EXCEPTION NOT RAISED - (A)3");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          Comment ("Upper bound of Year_Number is appropriate" &
+                                   " for Ada 2005");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     Comment ("Upper bound of Year_Number is appropriate" &
+                              " for Ada 95");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (A)3");
+           END;
+ 
+      END; -- (A)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (B)
+ 
+           MO : MONTH_NUMBER;
+ 
+      BEGIN     -- (B)
+ 
+           BEGIN
+                MO := IDENT_INT(0);
+                FAILED ("EXCEPTION NOT RAISED - (B)1");
+                IF NOT EQUAL (MO, MO) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (B)1");
+           END;
+ 
+           BEGIN
+                MO := 12;
+                IF NOT EQUAL (MO, MO) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("OK CASE RAISED EXCEPTION ON 12 - (B)");
+           END;
+ 
+           BEGIN
+                MO := 13;
+                FAILED ("EXCEPTION NOT RAISED - (B)2");
+                IF NOT EQUAL (MO, MO) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (B)2");
+           END;
+ 
+      END; -- (B)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (C)
+ 
+           DY : DAY_NUMBER;
+ 
+      BEGIN     -- (C)
+ 
+           BEGIN
+                DY := 0;
+                FAILED ("EXCEPTION NOT RAISED - (C)1");
+                IF NOT EQUAL (DY, DY) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (C)1");
+           END;
+ 
+           BEGIN
+                DY := IDENT_INT(32);
+                FAILED ("EXCEPTION NOT RAISED - (C)2");
+                IF NOT EQUAL (DY, DY) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (C)2");
+           END;
+ 
+      END; -- (C)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (D)
+ 
+           SEGMENT : DAY_DURATION;
+ 
+           FUNCTION CHECK_OK (X : DAY_DURATION) RETURN BOOLEAN IS
+                I : INTEGER := INTEGER (X);
+           BEGIN
+                RETURN EQUAL (I,I);
+           END CHECK_OK;
+ 
+      BEGIN     -- (D)
+ 
+           BEGIN
+                SEGMENT := 86_400.0;
+                IF CHECK_OK (SEGMENT - 86_000.0) THEN
+                     COMMENT ("NO EXCEPTION RAISED (D1)");
+                ELSE
+                     COMMENT ("NO EXCEPTION RAISED (D2)");
+                END IF;
+ 
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("OK CASE RAISED EXCEPTION ON 86_400 - (D)");
+           END;
+ 
+           BEGIN
+                SEGMENT := -4.0;
+                FAILED ("EXCEPTION NOT RAISED - (D)1");
+                IF NOT EQUAL (INTEGER(SEGMENT), INTEGER(SEGMENT)) THEN
+                     COMMENT ("NO EXCEPTION RAISED (D3)");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (D)1");
+           END;
+ 
+           BEGIN
+                SEGMENT := 86_401.00;
+                IF CHECK_OK (SEGMENT - 86_000.0) THEN
+                     FAILED ("NO EXCEPTION RAISED (D4)");
+                ELSE
+                     FAILED ("NO EXCEPTION RAISED (D5)");
+                END IF;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (D)2");
+           END;
+ 
+      END; -- (D)
+ 
+      ---------------------------------------------
+ 
+      RESULT;
+ END C96004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,239 ----
+ -- C96005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THE CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
+ -- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
+ -- SPECIFICALLY,
+ --   (A) CHECK THAT ADDITION AND SUBTRACTION OPERATORS WORK CORRECTLY ON
+ --       VALUES OF TYPE TIME.
+ 
+ -- CPP 8/16/84
+ 
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ -- WITH TEXT_IO;  USE TEXT_IO;
+ PROCEDURE C96005A IS
+ 
+      -- PACKAGE DURATION_IO IS NEW FIXED_IO (DURATION);
+      -- USE DURATION_IO;
+ 
+ BEGIN
+      TEST ("C96005A", "CHECK THAT THE ADDITION AND SUBTRACTION " &
+            "FUNCTIONS FOR VALUES OF TYPE TIME WORK CORRECTLY");
+ 
+      -----------------------------------------------
+ 
+      BEGIN     -- (A)
+ 
+           -- ADDITION TESTS FOLLOW.
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 0.0);
+                NEW_TIME := NOW + INCREMENT;
+                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                     FAILED ("SUM OF TIMES IS INCORRECT - (A)1");
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 0.0);
+                NEW_TIME :=  INCREMENT + NOW;
+                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                     FAILED ("SUM OF TIMES IS INCORRECT - (A)2");
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 0.0);
+                NEW_TIME := "+"(INCREMENT, NOW);
+                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                     FAILED ("SUM OF TIMES IS INCORRECT - (A)3");
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 0.0);
+                NEW_TIME := "+"(LEFT => NOW,
+                                RIGHT => INCREMENT);
+                IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                     FAILED ("SUM OF TIMES IS INCORRECT - (A)4");
+                END IF;
+           END;
+ 
+ 
+           -- SUBTRACTION TESTS FOLLOW.
+           DECLARE
+                NOW, ONCE : TIME;
+                DIFFERENCE : DURATION;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 45_000.0);
+                ONCE := TIME_OF (1984, 8, 12, 45_000.0);
+                DIFFERENCE := NOW - ONCE;
+                IF DIFFERENCE /= 86_400.0 THEN
+                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)1");
+                     -- COMMENT ("DIFFERENCE YIELDS: ");
+                     -- PUT (DIFFERENCE);
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+           -- TIMES IN DIFFERENT MONTHS.
+                NOW, ONCE : TIME;
+                DIFFERENCE : DURATION;
+           BEGIN
+                NOW := TIME_OF (1984, 8, IDENT_INT(1), 60.0);
+                ONCE := TIME_OF (1984, 7, 31, 86_399.0);
+                DIFFERENCE := "-"(NOW, ONCE);
+                IF DIFFERENCE /= 61.0 THEN
+                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)2");
+                     -- COMMENT ("DIFFERENCE YIELDS: ");
+                     -- PUT (DIFFERENCE);
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+           -- TIMES IN DIFFERENT YEARS.
+                NOW, AFTER : TIME;
+                DIFFERENCE : DURATION;
+           BEGIN
+                NOW := TIME_OF (IDENT_INT(1999), 12, 31, 86_399.0);
+                AFTER := TIME_OF (2000, 1, 1, 1.0);
+                DIFFERENCE := "-"(LEFT => AFTER,
+                                  RIGHT => NOW);
+                IF DIFFERENCE /= 2.0 THEN
+                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)3");
+                     -- COMMENT ("DIFFERENCE YIELDS: ");
+                     -- PUT (DIFFERENCE);
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+           -- TIMES IN A LEAP YEAR.
+                NOW, LEAP : TIME;
+                DIFFERENCE : DURATION;
+           BEGIN
+                NOW := TIME_OF (1984, 3, 1);
+                LEAP := TIME_OF (1984, 2, 29, 86_399.0);
+                DIFFERENCE := NOW - LEAP;
+                IF DIFFERENCE /= 1.0 THEN
+                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)4");
+                     -- COMMENT ("DIFFERENCE YIELDS: ");
+                     -- PUT (DIFFERENCE);
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+           -- TIMES IN A NON-LEAP YEAR.
+                NOW, NON_LEAP : TIME;
+                DIFFERENCE : DURATION;
+           BEGIN
+                NOW := TIME_OF (1983, 3, 1);
+                NON_LEAP := TIME_OF (1983, 2, 28, 86_399.0);
+                DIFFERENCE := NOW - NON_LEAP;
+                IF DIFFERENCE /= 1.0 THEN
+                     FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)5");
+                     -- COMMENT ("DIFFERENCE YIELDS: ");
+                     -- PUT (DIFFERENCE);
+                END IF;
+           END;
+ 
+ 
+           -- SUBTRACTION TESTS FOLLOW: TIME - DURATION.
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 0.0);
+                NEW_TIME := NOW - INCREMENT;
+                IF NEW_TIME /= TIME_OF (1984, 8, 12, 86_399.0) THEN
+                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                             "INCORRECT - (A)6");
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 1, 0.0);
+                NEW_TIME := NOW - INCREMENT;
+                IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
+                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                             "INCORRECT - (A)7");
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 1, 0.0);
+                NEW_TIME := "-"(LEFT => NOW,
+                                RIGHT => INCREMENT);
+                IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
+                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                             "INCORRECT - (A)8");
+                END IF;
+           END;
+ 
+ 
+           DECLARE
+                NOW, NEW_TIME : TIME;
+                INCREMENT : DURATION := 1.0;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 1, 0.0);
+                NEW_TIME := "-"(NOW, INCREMENT);
+                IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
+                     FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                             "INCORRECT - (A)7");
+                END IF;
+           END;
+ 
+ 
+      END; -- (A)
+ 
+      -----------------------------------------------
+ 
+      RESULT;
+ END C96005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005b.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005b.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005b.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005b.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,135 ----
+ -- C96005B.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THE CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
+ -- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
+ -- SPECIFICALLY,
+ --   (B) ADDITION AND SUBTRACTION OPERATORS RAISE CONSTRAINT_ERROR WHEN
+ --       CALLED WITH AN OUT OF RANGE DURATION PARAMETER.
+ 
+ -- CPP 8/16/84
+ 
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C96005B IS
+ 
+ BEGIN
+      TEST ("C96005B", "CHECK THAT ADDITION AND SUBTRACTION " &
+            "OPERATORS RAISE CONSTRAINT_ERROR WHEN CALLED WITH " &
+            "OUT OF RANGE DURATION PARAMETER");
+ 
+      -----------------------------------------------
+ 
+      BEGIN     -- (B)
+ 
+           -- ADDITION TESTS FOLLOW.
+           DECLARE
+                BEFORE : TIME := CLOCK;
+           BEGIN
+                IF DURATION'BASE'FIRST < DURATION'FIRST THEN
+                     COMMENT("LOW VALUES EXIST - (B)1");
+                     BEFORE := BEFORE + ($LESS_THAN_DURATION);
+                     FAILED ("EXCEPTION NOT RAISED - (B)1");
+                ELSE
+                     NOT_APPLICABLE ("NO LOW VALUES EXIST - (B)1");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN TIME_ERROR =>
+                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                             "CONSTRAINT_ERROR - (B)1");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (B)1");
+           END;
+ 
+           DECLARE
+                BEFORE : TIME := CLOCK;
+           BEGIN
+                IF DURATION'LAST < DURATION'BASE'LAST THEN
+                     COMMENT("HIGH VALUES EXIST - (B)2");
+                     BEFORE := $GREATER_THAN_DURATION + BEFORE;
+                     FAILED ("EXCEPTION NOT RAISED - (B)2");
+                ELSE
+                     NOT_APPLICABLE ("NO HIGH VALUES EXIST - (B)2");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN TIME_ERROR =>
+                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                             "CONSTRAINT_ERROR - (B)2");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (B)2");
+           END;
+ 
+ 
+           -- SUBTRACTION TESTS FOLLOW.
+           DECLARE
+                BEFORE : TIME := CLOCK;
+           BEGIN
+                IF DURATION'BASE'FIRST < DURATION'FIRST THEN
+                     COMMENT("LOW VALUES EXIST - (B)3");
+                     BEFORE := BEFORE - ($LESS_THAN_DURATION);
+                     FAILED ("EXCEPTION NOT RAISED - (B)3");
+                ELSE
+                     NOT_APPLICABLE ("NO LOW VALUES EXIST - (B)3");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN TIME_ERROR =>
+                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                             "CONSTRAINT_ERROR - (B)3");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (B)3");
+           END;
+ 
+           DECLARE
+                BEFORE : TIME := CLOCK;
+           BEGIN
+                IF DURATION'LAST < DURATION'BASE'LAST THEN
+                     COMMENT("HIGH VALUES EXIST - (B)4");
+                     BEFORE := BEFORE - $GREATER_THAN_DURATION;
+                     FAILED ("EXCEPTION NOT RAISED - (B)4");
+                ELSE
+                     NOT_APPLICABLE ("NO HIGH VALUES EXIST - (B)4");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN TIME_ERROR =>
+                     FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                             "CONSTRAINT_ERROR - (B)4");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (B)4");
+           END;
+ 
+ 
+      END; -- (B)
+ 
+      -----------------------------------------------
+ 
+      RESULT;
+ END C96005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C96005D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THE CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
+ -- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
+ -- SPECIFICALLY,
+ --   (D) THE EXCEPTION TIME_ERROR IS RAISED WHEN THE FUNCTION "-"
+ --       RETURNS A VALUE NOT IN THE SUBTYPE RANGE DURATION.
+ 
+ -- CPP 8/16/84
+ 
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C96005D IS
+ 
+ BEGIN
+      TEST ("C96005D", "CHECK THAT THE SUBTRACTION OPERATOR RAISES " &
+            "TIME_ERROR APPROPRIATELY");
+ 
+      ---------------------------------------------
+ 
+      BEGIN     -- (D)
+ 
+           DECLARE
+                NOW, LATER : TIME;
+                WAIT : DURATION;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 0.0);
+                LATER := (NOW + DURATION'LAST) + 1.0;
+                WAIT := LATER - NOW;
+                FAILED ("EXCEPTION NOT RAISED - (D)1");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (D)1");
+           END;
+ 
+ 
+           DECLARE
+                NOW, LATER : TIME;
+                WAIT : DURATION;
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, 0.0);
+                LATER := (NOW + DURATION'FIRST) - 1.0;
+                WAIT := NOW - LATER;
+                FAILED ("EXCEPTION NOT RAISED - (D)2");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - (D)2");
+           END;
+ 
+      END; -- (D)
+ 
+      ---------------------------------------------
+ 
+      RESULT;
+ END C96005D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96005f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96005f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,93 ----
+ -- C96005F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PACKAGE CALENDAR + AND - FUNCTIONS WORK PROPERLY,
+ -- ESPECIALLY WITH VALUES AT MIDNIGHT.
+  
+ -- GOM 02/18/85
+ -- JWC 05/14/85
+  
+ WITH REPORT;
+ USE REPORT;
+ WITH CALENDAR;
+ USE CALENDAR;
+  
+ PROCEDURE C96005F IS
+ 
+      CURR_DAY1 : CONSTANT TIME := TIME_OF(1984,1,1,0.0);
+      CURR_DAY2 : CONSTANT TIME := TIME_OF(1984,1,1,DAY_DURATION'LAST);
+      CURR_DAY3 : CONSTANT TIME := TIME_OF(1984,1,1,10000.0);
+ 
+      TOMORROW1 : CONSTANT TIME := TIME_OF(1984,1,2,0.0);
+      TOMORROW2 : CONSTANT TIME := TIME_OF(1984,1,2,DAY_DURATION'LAST);
+      TOMORROW3 : CONSTANT TIME := TIME_OF(1984,1,2,10000.0);
+ 
+      YESTERDAY1 : CONSTANT TIME := TIME_OF(1983,12,31,0.0);
+      YESTERDAY2 : CONSTANT TIME := TIME_OF(1983,12,31,
+                                            DAY_DURATION'LAST);
+      YESTERDAY3 : CONSTANT TIME := TIME_OF(1983,12,31,10000.0);
+ 
+ BEGIN
+      TEST("C96005F","CHECKING PACKAGE CALENDAR + AND - FUNCTIONS");
+ 
+      -- CHECK IF ADDING ONE DAY TO 'CURR_DAY#' TIMES YIELDS
+      -- TIMES EQUAL TO 'TOMORROW'.
+ 
+      IF (CURR_DAY1 + DAY_DURATION'LAST) /= TOMORROW1 THEN
+           FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY1'");
+      END IF;
+ 
+      IF (CURR_DAY2 + DAY_DURATION'LAST) /= TOMORROW2 THEN
+           FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY2'");
+      END IF;
+  
+      IF (CURR_DAY3 + DAY_DURATION'LAST) /= TOMORROW3 THEN
+           FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY3'");
+      END IF;
+ 
+      IF (CURR_DAY1 + DAY_DURATION'LAST) /= CURR_DAY2 THEN
+           FAILED("'CURR_DAY1' + 1 /= 'CURR_DAY2'");
+      END IF;
+  
+      -- CHECK IF SUBTRACTING ONE DAY FROM 'CURR_DAY#' TIMES YIELDS
+      -- TIMES EQUAL TO 'YESTERDAY'.
+ 
+      IF (CURR_DAY1 - DAY_DURATION'LAST) /= YESTERDAY1 THEN
+           FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY1'");
+      END IF;
+ 
+      IF (CURR_DAY2 - DAY_DURATION'LAST) /= YESTERDAY2 THEN
+           FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY2'");
+      END IF;
+ 
+      IF (CURR_DAY3 - DAY_DURATION'LAST) /= YESTERDAY3 THEN
+           FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY3'");
+      END IF;
+ 
+      IF (CURR_DAY2 - DAY_DURATION'LAST) /= CURR_DAY1 THEN
+           FAILED("'CURR_DAY2' - 1 /= 'CURR_DAY1'");
+      END IF;
+  
+      RESULT;
+ END C96005F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,298 ----
+ -- C96006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR THE PACKAGE CALENDAR, THE RELATIONAL OPERATORS WORK
+ -- CORRECTLY FOR OPERANDS OF TYPE TIME AND TYPE DURATION. PARTICULARLY,
+ --   (A) RELATIONS BASED ON YEARS.
+ --   (B) RELATIONS BASED ON MONTH.
+ --   (C) RELATIONS BASED ON SECONDS.
+ --   (D) RELATIONS AT EXTREMES OF THE PERMITTED RANGE OF TIME.
+ 
+ -- CPP 8/16/84
+ 
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C96006A IS
+ 
+ BEGIN
+      TEST ("C96006A", "CHECK THAT RELATIONAL OPERATORS WORK " &
+            "CORRECTLY IN THE PACKAGE CALENDAR");
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (A)
+      -- RELATIONS BASED ON YEARS.
+           NOW, LATER : TIME;
+      BEGIN     -- (A)
+           NOW := TIME_OF (1984, 8, 12, 500.0);
+           LATER := TIME_OF (1985, 8, 12, 500.0);
+ 
+           IF NOW < LATER THEN
+                COMMENT ("< OPERATOR OK - (A)");
+           ELSE
+                FAILED ("< OPERATOR INCORRECT - (A)");
+           END IF;
+ 
+           IF NOW <= LATER THEN
+                COMMENT ("<= OPERATOR OK - (A)");
+           ELSE
+                FAILED ("<= OPERATOR INCORRECT - (A)");
+           END IF;
+ 
+           IF NOW <= NOW THEN
+                COMMENT ("<= OPERATOR OK - (A)2");
+           ELSE
+                FAILED ("<= OPERATOR INCORRECT - (A)2");
+           END IF;
+ 
+           IF LATER > NOW THEN
+                COMMENT ("> OPERATOR OK - (A)");
+           ELSE
+                FAILED ("> OPERATOR INCORRECT - (A)");
+           END IF;
+ 
+           IF LATER >= NOW THEN
+                COMMENT (">= OPERATOR OK - (A)");
+           ELSE
+                FAILED (">= OPERATOR INCORRECT - (A)");
+           END IF;
+ 
+           IF LATER >= LATER THEN
+                COMMENT (">= OPERATOR OK - (A)2");
+           ELSE
+                FAILED (">= OPERATOR INCORRECT - (A)2");
+           END IF;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (B)
+      -- RELATIONS BASED ON MONTH.
+           NOW, LATER : TIME;
+      BEGIN     -- (B)
+           NOW := TIME_OF (1984, 8, 12, 500.0);
+           LATER := TIME_OF (1984, 9, 12, 500.0);
+ 
+           IF NOW < LATER THEN
+                COMMENT ("< OPERATOR OK - (B)");
+           ELSE
+                FAILED ("< OPERATOR INCORRECT - (B)");
+           END IF;
+ 
+           IF NOW <= LATER THEN
+                COMMENT ("<= OPERATOR OK - (B)");
+           ELSE
+                FAILED ("<= OPERATOR INCORRECT - (B)");
+           END IF;
+ 
+           IF NOW <= NOW THEN
+                COMMENT ("<= OPERATOR OK - (B)2");
+           ELSE
+                FAILED ("<= OPERATOR INCORRECT - (B)2");
+           END IF;
+ 
+           IF LATER > NOW THEN
+                COMMENT ("> OPERATOR OK - (B)");
+           ELSE
+                FAILED ("> OPERATOR INCORRECT - (B)");
+           END IF;
+ 
+           IF LATER >= NOW THEN
+                COMMENT (">= OPERATOR OK - (B)");
+           ELSE
+                FAILED (">= OPERATOR INCORRECT - (B)");
+           END IF;
+ 
+           IF LATER >= LATER THEN
+                COMMENT (">= OPERATOR OK - (B)2");
+           ELSE
+                FAILED (">= OPERATOR INCORRECT - (B)2");
+           END IF;
+ 
+           IF NOW = NOW THEN
+                COMMENT ("= OPERATOR OK - (B)");
+           ELSE
+                FAILED ("= OPERATOR INCORRECT - (B)");
+           END IF;
+ 
+           IF LATER /= NOW THEN
+                COMMENT ("/= OPERATOR OK - (B)");
+           ELSE
+                FAILED ("/= OPERATOR INCORRECT - (B)");
+           END IF;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (C)
+      -- RELATIONS BASED ON SECONDS.
+           NOW, LATER : TIME;
+           INCREMENT : DURATION := 99.9;
+      BEGIN     -- (C)
+           NOW := TIME_OF (1984, 8, 12, 500.0);
+           LATER := NOW + INCREMENT;
+ 
+           IF NOW < LATER THEN
+                COMMENT ("< OPERATOR OK - (C)");
+           ELSE
+                FAILED ("< OPERATOR INCORRECT - (C)");
+           END IF;
+ 
+           IF NOW <= LATER THEN
+                COMMENT ("<= OPERATOR OK - (C)");
+           ELSE
+                FAILED ("<= OPERATOR INCORRECT - (C)");
+           END IF;
+ 
+           IF NOW <= NOW THEN
+                COMMENT ("<= OPERATOR OK - (C)2");
+           ELSE
+                FAILED ("<= OPERATOR INCORRECT - (C)2");
+           END IF;
+ 
+           IF LATER > NOW THEN
+                COMMENT ("> OPERATOR OK - (C)");
+           ELSE
+                FAILED ("> OPERATOR INCORRECT - (C)");
+           END IF;
+ 
+           IF LATER >= NOW THEN
+                COMMENT (">= OPERATOR OK - (C)");
+           ELSE
+                FAILED (">= OPERATOR INCORRECT - (C)");
+           END IF;
+ 
+           IF LATER >= LATER THEN
+                COMMENT (">= OPERATOR OK - (C)2");
+           ELSE
+                FAILED (">= OPERATOR INCORRECT - (C)2");
+           END IF;
+ 
+           IF LATER = LATER THEN
+                COMMENT ("= OPERATOR OK - (C)");
+           ELSE
+                FAILED ("= OPERATOR INCORRECT - (C)");
+           END IF;
+ 
+           IF NOW /= LATER THEN
+                COMMENT ("/= OPERATOR OK - (C)");
+           ELSE
+                FAILED ("/= OPERATOR INCORRECT - (C)");
+           END IF;
+ 
+           IF NOW < NOW THEN
+                FAILED ("NOW < NOW INCORRECT - (C)");
+           ELSIF NOW /= NOW THEN
+                FAILED ("NOW = NOW INCORRECT - (C)");
+           ELSIF LATER < NOW THEN
+                FAILED ("LATER < NOW INCORRECT - (C)");
+           ELSIF LATER <= NOW THEN
+                FAILED ("LATER <= NOW INCORRECT - (C)");
+           ELSIF LATER = NOW THEN
+                FAILED ("NOW = LATER INCORRECT - (C)");
+           ELSIF NOW > LATER THEN
+                FAILED ("NOW > LATER INCORRECT - (C)");
+           ELSIF NOW > NOW THEN
+                FAILED ("NOW > NOW INCORRECT - (C)");
+           ELSIF NOW >= LATER THEN
+                FAILED ("NOW >= LATER INCORRECT - (C)");
+           ELSIF NOW = LATER THEN
+                FAILED ("NOW = LATER INCORRECT - (C)");
+           END IF;
+ 
+      END; -- (C)
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (D)
+ 
+           NOW, WAY_BACK_THEN : TIME;
+ 
+      BEGIN     -- (D)
+ 
+           NOW := TIME_OF (2099, 12, 31);
+           WAY_BACK_THEN := TIME_OF (1901, 1, 1);
+ 
+           BEGIN
+                IF NOW < WAY_BACK_THEN THEN
+                     FAILED ("TEST < AT EXTREMES INCORRECT - (D)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("< AT EXTREMES RAISED EXCEPTION - (D)");
+           END;
+ 
+           BEGIN
+                IF NOW <= WAY_BACK_THEN THEN
+                     FAILED ("TEST <= AT EXTREMES INCORRECT - (D)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("<= AT EXTREMES RAISED EXCEPTION - (D)");
+           END;
+ 
+           BEGIN
+                IF WAY_BACK_THEN > NOW THEN
+                     FAILED ("TEST > AT EXTREMES INCORRECT - (D)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("> AT EXTREMES RAISED EXCEPTION - (D)");
+           END;
+ 
+           BEGIN
+                IF WAY_BACK_THEN >= NOW THEN
+                     FAILED ("TEST >= AT EXTREMES INCORRECT - (D)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED (">= AT EXTREMES RAISED EXCEPTION - (D)");
+           END;
+ 
+           BEGIN
+                IF WAY_BACK_THEN /= WAY_BACK_THEN THEN
+                     FAILED ("TEST /= AT EXTREMES INCORRECT - (D)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("/= AT EXTREMES RAISED EXCEPTION - (D)");
+           END;
+ 
+           BEGIN
+                IF NOW = WAY_BACK_THEN THEN
+                     FAILED ("TEST = AT EXTREMES INCORRECT - (D)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("= AT EXTREMES RAISED EXCEPTION - (D)");
+           END;
+ 
+      END; -- (D)
+ 
+      --------------------------------------------
+ 
+      RESULT;
+ END C96006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,205 ----
+ -- C96007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT APPROPRIATE EXCEPTIONS ARE RAISED FOR THE TIME_OF()
+ -- FUNCTION IN THE PACKAGE CALENDAR. PARTICULARLY,
+ --   (A) TIME_ERROR IS RAISED ON INVALID DATES.
+ --   (B) CONSTRAINT_ERROR IS RAISED FOR OUT-OF-RANGE PARAMETERS.
+ 
+ -- CPP  8/16/84
+ -- RLB 12/18/06 - Changed so that the test will work for Ada 2005
+ --                implementations.
+ 
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C96007A IS
+ 
+ BEGIN
+      TEST ("C96007A", "CHECK THAT APPROPRIATE EXCEPTIONS ARE RAISED " &
+            "FOR THE TIME_OF FUNCTION IN THE PACKAGE CALENDAR");
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (A)
+ 
+           BAD_TIME : TIME;
+ 
+      BEGIN     -- (A)
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 2, 30);
+                FAILED ("EXCEPTION NOT RAISED - 2/30 (A)");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 2/30 (A)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 2, 31);
+                FAILED ("EXCEPTION NOT RAISED - 2/31 (A)");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 2/31 (A)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 4, 31);
+                FAILED ("EXCEPTION NOT RAISED - 4/31 (A)");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 4/31 (A)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 6, 31);
+                FAILED ("EXCEPTION NOT RAISED - 6/31 (A)");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 6/31 (A)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 9, 31);
+                FAILED ("EXCEPTION NOT RAISED - 9/31 (A)");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 9/31 (A)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 11, 31);
+                FAILED ("EXCEPTION NOT RAISED - 11/31 (A)");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 11/31 (A)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1983, 2, 29);
+                FAILED ("EXCEPTION NOT RAISED - 2/29 (A)");
+           EXCEPTION
+                WHEN TIME_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 2/29 (A)");
+           END;
+ 
+      END; -- (A)
+ 
+      --------------------------------------------
+ 
+      DECLARE   -- (B)
+ 
+           BAD_TIME : TIME;
+ 
+      BEGIN     -- (B)
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1900, 8, 13);
+                FAILED ("EXCEPTION NOT RAISED - 1900 (B)");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - 1900 (B)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (YEAR_NUMBER'LAST+1, 8, 13);
+                FAILED ("EXCEPTION NOT RAISED - YEAR_NUM'LAST+1 (B)");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - YEAR_NUM'LAST+1 (B)");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 0, 13);
+                FAILED ("EXCEPTION NOT RAISED - MONTH (B)1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - MONTH (B)1");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 13, 13);
+                FAILED ("EXCEPTION NOT RAISED - MONTH (B)2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - MONTH (B)2");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 8, 0);
+                FAILED ("EXCEPTION NOT RAISED - DAY (B)1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - DAY (B)1");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (19784, 8, 32);
+                FAILED ("EXCEPTION NOT RAISED - DAY (B)2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - DAY (B)2");
+           END;
+ 
+           BEGIN
+                BAD_TIME := TIME_OF (1984, 8, 13, -0.5);
+                FAILED ("EXCEPTION NOT RAISED - SECONDS (B)1");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - SECONDS (B)1");
+           END;
+ 
+      END; -- (B)
+ 
+      --------------------------------------------
+ 
+      RESULT;
+ END C96007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,203 ----
+ -- C96008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- MISCELLANEOUS CHECKS ON THE PRE-DEFINED FUNCTIONS IN THE PACKAGE
+ -- CALENDAR.  SUBTESTS ARE:
+ --   (A) TIME_OF() AND SPLIT() ARE INVERSE FUNCTIONS.
+ --   (B) FORMAL PARAMETERS OF TIME_OF() AND SPLIT() ARE NAMED CORRECTLY.
+ --   (C) TIME_OF() GIVES THE PARAMETER SECONDS A DEFAULT VALUE OF 0.0.
+ --   (D) THE FUNCTIONS YEAR(), MONTH(), DAY(), AND SECONDS() RETURN
+ --       CORRECT VALUES USING NAMED NOTATION.
+ --   (E) A VALUE RETURNED FROM CLOCK() CAN BE PROCESSED BY SPLIT().
+ --   (F) DURATION'SMALL MEETS REQUIRED LIMIT.
+ 
+ -- CPP 8/16/84
+ 
+ WITH SYSTEM;
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C96008A IS
+ 
+ BEGIN
+      TEST ("C96008A", "CHECK MISCELLANEOUS FUNCTIONS IN THE " &
+            "PACKAGE CALENDAR");
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (A)
+           NOW : TIME;
+           YR : YEAR_NUMBER;
+           MO : MONTH_NUMBER;
+           DY : DAY_NUMBER;
+           SEC : DAY_DURATION;
+      BEGIN     -- (A)
+           BEGIN
+                NOW := TIME_OF (1984, 8, 13, DURATION(1.0/3.0));
+                SPLIT (NOW, YR, MO, DY, SEC);
+                IF NOW /= TIME_OF (YR, MO, DY, SEC) THEN
+                     COMMENT ("TIME_OF AND SPLIT ARE NOT INVERSES " &
+                              "WHEN SECONDS IS A NON-MODEL NUMBER " &
+                              "- (A)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("TIME_OF(SPLIT) RAISED EXCEPTION - (A)");
+           END;
+ 
+ 
+           BEGIN
+                -- RESET VALUES.
+                YR := 1984;
+                MO := 8;
+                DY := 13;
+                SEC := 1.0;
+ 
+                SPLIT (TIME_OF (YR, MO, DY, SEC), YR, MO, DY, SEC);
+ 
+                IF YR /= 1984 THEN
+                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF YR - (A)");
+                END IF;
+ 
+                IF MO /= 8 THEN
+                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF MO - (A)");
+                END IF;
+ 
+                IF DY /= 13 THEN
+                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF DY - (A)");
+                END IF;
+ 
+                IF SEC /= 1.0 THEN
+                     FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF " &
+                             "SEC - (A)");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("SPLIT(TIME_OF) PROCESSING RAISED " &
+                             "EXCEPTION - (A)");
+           END;
+      END; -- (A)
+ 
+      ---------------------------------------------
+ 
+      BEGIN     -- (B)
+           DECLARE
+                NOW : TIME;
+           BEGIN
+                NOW := TIME_OF (YEAR => 1984,
+                                MONTH => 8,
+                                DAY => 13,
+                                SECONDS => 60.0);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NAMED ASSOCIATION ON TIME_OF() RAISED " &
+                             "EXCEPTION - (B)");
+           END;
+ 
+ 
+           DECLARE
+                NOW : TIME := CLOCK;
+                YR : YEAR_NUMBER := 1984;
+                MO : MONTH_NUMBER := 8;
+                DY : DAY_NUMBER := 13;
+                SEC : DAY_DURATION := 0.0;
+           BEGIN
+                SPLIT (DATE => NOW,
+                       YEAR => YR,
+                       MONTH => MO,
+                       DAY => DY,
+                       SECONDS => SEC);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("NAMED ASSOCIATION ON SPLIT() RAISED " &
+                             "EXCEPTION - (B)2");
+           END;
+      END; -- (B)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (C)
+           NOW : TIME;
+      BEGIN     -- (C)
+           NOW := TIME_OF (1984, 8, 13);
+           IF SECONDS (NOW) /= 0.0 THEN
+                FAILED ("TIME_OF() DID NOT ZERO SECONDS - (C)");
+           END IF;
+      END; -- (C)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (D)
+      -- ASSUMES TIME_OF() WORKS CORRECTLY.
+           HOLIDAY : TIME;
+      BEGIN     -- (D)
+           HOLIDAY := TIME_OF (1958, 9, 9, 1.0);
+ 
+           IF YEAR (DATE => HOLIDAY) /= 1958 THEN
+                FAILED ("YEAR() DID NOT RETURN CORRECT VALUE - (D)");
+           END IF;
+ 
+           IF MONTH (DATE => HOLIDAY) /= 9 THEN
+                FAILED ("MONTH() DID NOT RETURN CORRECT VALUE - (D)");
+           END IF;
+ 
+           IF DAY (DATE => HOLIDAY) /= 9 THEN
+                FAILED ("DAY() DID NOT RETURN CORRECT VALUE - (D)");
+           END IF;
+ 
+           IF SECONDS (HOLIDAY) /= 1.0 THEN
+                FAILED ("SECONDS() DID NOT RETURN CORRECT VALUE - (D)");
+           END IF;
+      END; -- (D)
+ 
+      ---------------------------------------------
+ 
+      DECLARE   -- (E)
+           YR : YEAR_NUMBER;
+           MO : MONTH_NUMBER;
+           DY : DAY_NUMBER;
+           SEC : DAY_DURATION;
+      BEGIN     -- (E)
+           SPLIT (CLOCK, YR, MO, DY, SEC);
+           DELAY SYSTEM.TICK;
+ 
+           IF TIME_OF (YR, MO, DY, SEC) > CLOCK THEN
+                FAILED ("SPLIT() ON CLOCK INCORRECT - (E)");
+           END IF;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("SPLIT() ON CLOCK RAISED EXCEPTION - (E)");
+      END; -- (E)
+ 
+      ---------------------------------------------
+ 
+      BEGIN     -- (F)
+           IF DURATION'SMALL > 0.020 THEN
+                FAILED ("DURATION'SMALL LARGER THAN SPECIFIED - (F)");
+           END IF;
+      END; -- (F)
+ 
+      ---------------------------------------------
+ 
+      RESULT;
+ END C96008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96008b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96008b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c96008b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c96008b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C96008B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- MISCELLANEOUS CHECKS ON THE PRE-DEFINED FUNCTIONS IN THE PACKAGE
+ -- CALENDAR.  SUBTESTS ARE:
+ --   (A) THE FUNCTION TIME_OF() MUST ADVANCE DAY WHEN CALLED WITH THE
+ --       SECONDS ARGUMENT HAVING THE VALUE 86_400.
+ 
+ -- CPP 8/16/84
+ -- JRK 12/4/84
+ 
+ WITH CALENDAR;  USE CALENDAR;
+ WITH REPORT;  USE REPORT;
+ PROCEDURE C96008B IS
+ 
+      NOW1, NOW2 : TIME;
+      YR : YEAR_NUMBER;
+      MO : MONTH_NUMBER;
+      DY : DAY_NUMBER;
+      SEC : DAY_DURATION;
+ 
+ BEGIN
+ 
+      TEST ("C96008B", "CHECK THAT TIME_OF() ADVANCES DAY");
+ 
+      NOW1 := TIME_OF (1984, 8, 13, 86_400.0);
+      NOW2 := TIME_OF (1984, 8, 14, 0.0);
+ 
+      IF NOW1 /= NOW2 THEN
+           FAILED ("TIME_OF DID NOT CONVERT 86_400 SECONDS TO A DAY");
+      END IF;
+ 
+      SPLIT (NOW2, YR, MO, DY, SEC);
+ 
+      IF DY /= 14 THEN
+           FAILED ("DAY OF NOW2 INCORRECT");
+      END IF;
+      IF SEC /= 0.0 THEN
+           FAILED ("SECONDS OF NOW2 INCORRECT");
+      END IF;
+ 
+      SPLIT (NOW1, YR, MO, DY, SEC);
+ 
+      IF DY /= 14 OR SEC /= 0.0 OR
+         DAY (NOW1) /= 14 OR SECONDS (NOW1) /= 0.0 THEN
+           FAILED ("TIME_OF DID NOT ADVANCE DAY");
+      END IF;
+ 
+      RESULT;
+ END C96008B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97112a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97112a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97112a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97112a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- C97112A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A DELAY STATEMENT IS ALLOWED IN THE SEQUENCE OF STATEMENTS
+ -- OF A SELECT ALTERNATIVE OF A SELECTIVE WAIT CONTAINING A TERMINATE
+ -- ALTERNATIVE OR AN ELSE PART.
+ 
+ -- WRG 7/9/86
+ 
+ with Impdef;
+ WITH REPORT;   USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97112A IS
+ 
+      ACCEPT_ALTERNATIVE_TAKEN : BOOLEAN := FALSE;
+ 
+ BEGIN
+ 
+      TEST ("C97112A", "CHECK THAT A DELAY STATEMENT IS ALLOWED IN " &
+                       "THE SEQUENCE OF STATEMENTS OF A SELECT " &
+                       "ALTERNATIVE OF A SELECTIVE WAIT CONTAINING A " &
+                       "TERMINATE ALTERNATIVE OR AN ELSE PART");
+ 
+      --------------------------------------------------
+ 
+   A: DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+                BEFORE, AFTER : TIME;
+           BEGIN
+                SELECT
+                     ACCEPT E;
+                     ACCEPT_ALTERNATIVE_TAKEN := TRUE;
+                     BEFORE := CLOCK;
+                     DELAY 10.0 * Impdef.One_Second;
+                     AFTER  := CLOCK;
+                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                          FAILED ("INSUFFICIENT DELAY (A)");
+                     END IF;
+                OR
+                     TERMINATE;
+                END SELECT;
+           END T;
+ 
+      BEGIN
+ 
+           T.E;
+ 
+      END A;
+ 
+      IF NOT ACCEPT_ALTERNATIVE_TAKEN THEN
+           FAILED ("ACCEPT ALTERNATIVE NOT TAKEN");
+      END IF;
+ 
+      --------------------------------------------------
+ 
+   B: DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+                BEFORE, AFTER : TIME;
+           BEGIN
+                --ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+                WHILE E'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                SELECT
+                     ACCEPT E;
+                     BEFORE := CLOCK;
+                     DELAY 10.0 * Impdef.One_Second;
+                     AFTER  := CLOCK;
+                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                          FAILED ("INSUFFICIENT DELAY (B-1)");
+                     END IF;
+                ELSE
+                     FAILED ("ELSE PART EXECUTED (B-1)");
+                END SELECT;
+ 
+                SELECT
+                     ACCEPT E;
+                     FAILED ("ACCEPT STATEMENT EXECUTED (B-2)");
+                ELSE
+                     BEFORE := CLOCK;
+                     DELAY 10.0 * Impdef.One_Second;
+                     AFTER  := CLOCK;
+                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                          FAILED ("INSUFFICIENT DELAY (B-2)");
+                     END IF;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED");
+           END T;
+ 
+      BEGIN
+ 
+           T.E;
+ 
+      END B;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ 
+ END C97112A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97113a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97113a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97113a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97113a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,113 ----
+ -- C97113A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL CONDITIONS, OPEN DELAY ALTERNATIVE EXPRESSIONS, AND
+ --   OPEN ENTRY FAMILY INDICES ARE EVALUATED (EVEN WHEN SOME (PERHAPS
+ --   ALL BUT ONE) OF THE ALTERNATIVES CAN BE RULED OUT WITHOUT
+ --   COMPLETING THE EVALUATIONS).
+ 
+ -- RM 5/06/82
+ -- SPS 11/21/82
+ -- WRG 7/9/86    ADDED DELAY EXPRESSIONS AND ENTRY FAMILY INDICES.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97113A IS
+ 
+      EXPR1_EVALUATED : BOOLEAN := FALSE;
+      EXPR2_EVALUATED : BOOLEAN := FALSE;
+      EXPR3_EVALUATED : BOOLEAN := FALSE;
+ 
+      FUNCTION F1 RETURN BOOLEAN IS
+      BEGIN
+           EXPR1_EVALUATED := TRUE;
+           RETURN TRUE;
+      END F1;
+ 
+      FUNCTION F2 (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           EXPR2_EVALUATED := TRUE;
+           RETURN X;
+      END F2;
+ 
+      FUNCTION F3 (X : DURATION) RETURN DURATION IS
+      BEGIN
+           EXPR3_EVALUATED := TRUE;
+           RETURN X;
+      END F3;
+ 
+ BEGIN
+ 
+      TEST ("C97113A", "CHECK THAT ALL CONDITIONS, OPEN DELAY " &
+                       "ALTERNATIVE EXPRESSIONS, AND OPEN ENTRY " &
+                       "FAMILY INDICES ARE EVALUATED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E1;
+                ENTRY E2;
+                ENTRY E3 (1..1);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                --ENSURE THAT E1 HAS BEEN CALLED BEFORE PROCEEDING:
+                WHILE E1'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                SELECT
+                     ACCEPT E1;
+                OR
+                     WHEN F1 =>
+                          ACCEPT E2;
+                OR
+                     ACCEPT E3 ( F2(1) );
+                OR
+                     DELAY F3 ( 1.0 ) * Impdef.One_Second;
+                END SELECT;
+           END T;
+ 
+      BEGIN
+ 
+           T.E1;
+ 
+      END;
+ 
+      IF NOT EXPR1_EVALUATED THEN
+           FAILED ("GUARD NOT EVALUATED");
+      END IF;
+ 
+      IF NOT EXPR2_EVALUATED THEN
+           FAILED ("ENTRY FAMILY INDEX NOT EVALUATED");
+      END IF;
+ 
+      IF NOT EXPR3_EVALUATED THEN
+           FAILED ("OPEN DELAY ALTERNATIVE EXPRESSION NOT EVALUATED");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97113A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97114a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97114a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97114a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97114a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,196 ----
+ -- C97114A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK WHETHER A DELAY EXPRESSION FOLLOWING AN OPEN GUARD IS EVALUATED
+ -- DIRECTLY AFTER THE GUARD OR ONLY AFTER ALL GUARDS HAVE BEEN
+ -- EVALUATED, OR IN SOME MIXED ORDER SUCH THAT DELAY EXPRESSIONS ARE
+ -- EVALUATED AFTER THEIR GUARDS ARE DETERMINED TO BE OPEN.
+ 
+ -- RM 5/10/82
+ -- SPS 11/21/82
+ -- JBG 10/24/83
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97114A IS
+ 
+ 
+      -- THE TASK WILL HAVE LAST PRIORITY ( PRIORITY'FIRST )
+ 
+      EVAL_ORDER  :  STRING (1..6)       := ( 1..6 => '*' );
+      EVAL_ORD    :  STRING (1..6)       := ( 1..6 => '*' );
+      INDEX       :  INTEGER             := 0; 
+      DUMMY       :  INTEGER             := 0; 
+ 
+ 
+      FUNCTION F1 (X:INTEGER) RETURN INTEGER IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'F';    -- 123: FGH
+           EVAL_ORD   (INDEX) := 'G';    -- 123: GGG ( 'G' FOR 'GUARD' )
+           RETURN ( IDENT_INT(7) ); 
+      END F1; 
+ 
+ 
+      FUNCTION F2 (X:INTEGER) RETURN INTEGER IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'G'; 
+           EVAL_ORD   (INDEX) := 'G'; 
+           RETURN ( IDENT_INT(7) ); 
+      END F2; 
+ 
+ 
+      FUNCTION F3 (X:INTEGER) RETURN INTEGER IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'H'; 
+           EVAL_ORD   (INDEX) := 'G'; 
+           RETURN ( IDENT_INT(7) ); 
+      END F3; 
+ 
+ 
+      FUNCTION  D1( X:INTEGER )  RETURN DURATION IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'A';    -- 123: ABC
+           EVAL_ORD   (INDEX) := 'D';    -- 123: DDD ( 'D' FOR 'DELAY' )
+           RETURN ( 1.0 );
+      END D1; 
+ 
+ 
+      FUNCTION  D2( X:INTEGER )  RETURN DURATION IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'B'; 
+           EVAL_ORD   (INDEX) := 'D'; 
+           RETURN ( 2.0 );
+      END D2; 
+ 
+ 
+      FUNCTION  D3( X:INTEGER )  RETURN DURATION IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'C'; 
+           EVAL_ORD   (INDEX) := 'D'; 
+           RETURN ( 3.0 );
+      END D3; 
+ 
+      FUNCTION POS_OF (FUNC : CHARACTER) RETURN INTEGER  IS
+      BEGIN
+           FOR I IN EVAL_ORDER'RANGE LOOP
+                IF EVAL_ORDER(I) = FUNC THEN
+                     RETURN I;
+                END IF;
+           END LOOP;
+           FAILED ("DID NOT FIND LETTER " & FUNC);
+           RETURN 0;
+      END POS_OF;
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97114A", "CHECK THAT THE DELAY EXPRESSIONS ARE" &
+                       " EVALUATED AFTER THE GUARDS BUT"      &
+                       " BEFORE THE RENDEZVOUS IS ATTEMPTED"  );
+ 
+ 
+      DECLARE
+  
+ 
+           TASK T IS
+ 
+ 
+                ENTRY E1; 
+ 
+           END T; 
+ 
+ 
+           TASK BODY T IS
+           BEGIN
+ 
+ 
+                WHILE  E1'COUNT = 0  -- IF  E1  NOT YET CALLED, THEN GIVE
+                LOOP                 --     THE MAIN TASK AN OPPORTUNITY
+                     DELAY  10.01 * Impdef.One_Second;   --     TO ISSUE THE CALL.
+                END LOOP;
+ 
+ 
+                SELECT               
+ 
+                          ACCEPT  E1; 
+ 
+                OR
+ 
+                     WHEN  6 + F1(7) = 13  =>
+                          DELAY  D1( DUMMY ) * Impdef.One_Second;
+ 
+                OR
+ 
+                     WHEN  6 + F2(7) = 13  =>
+                          DELAY  D2( DUMMY ) * Impdef.One_Second;
+ 
+                OR
+ 
+                     WHEN  6 + F3(7) = 13  =>
+                          DELAY  D3( DUMMY ) * Impdef.One_Second;
+ 
+                END SELECT;
+ 
+ 
+           END T; 
+ 
+ 
+      BEGIN
+ 
+           T.E1; 
+ 
+      END; -- END OF BLOCK CONTAINING THE ENTRY CALLS
+ 
+ 
+      COMMENT ("EVALUATIONS WERE DONE IN THE ORDER " & EVAL_ORD);
+      COMMENT ("FUNCTIONS WERE CALLED IN THE ORDER " & EVAL_ORDER);
+ 
+      IF EVAL_ORD = "GGGDDD" THEN
+           COMMENT ("ALL GUARDS EVALUATED FIRST");
+      ELSIF EVAL_ORD = "GDGDGD" THEN
+           COMMENT ("DELAY EXPRESSION EVALUATED AFTER EACH GUARD");
+      END IF;
+ 
+ -- CHECK THAT GUARDS ARE ALWAYS EVALUATED BEFORE DELAY EXPRESSIONS
+ 
+      IF   POS_OF ('F') > POS_OF ('A') OR
+           POS_OF ('G') > POS_OF ('B') OR
+           POS_OF ('H') > POS_OF ('C') THEN
+                FAILED ("A DELAY EXPRESSION WAS EVALUATED BEFORE ITS " &
+                        "GUARD");
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C97114A;  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97115a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97115a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97115a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97115a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,189 ----
+ -- C97115A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK WHETHER AN ENTRY FAMILY INDEX EXPRESSION FOLLOWING AN OPEN
+ -- GUARD IS EVALUATED DIRECTLY AFTER THE GUARD, OR ONLY AFTER ALL GUARDS
+ -- HAVE BEEN EVALUATED, OR IN SOME MIXED ORDER SUCH THAT INDEX
+ -- EXPRESSIONS ARE EVALUATED AFTER THEIR GUARDS ARE DETERMINED TO BE
+ -- OPEN. 
+ 
+ -- RM 5/11/82
+ -- SPS 11/21/82
+ -- JBG 10/24/83
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97115A IS
+ 
+ 
+      -- THE TASK WILL HAVE LAST PRIORITY ( PRIORITY'FIRST )
+ 
+      EVAL_ORDER  :  STRING (1..6)       := ( 1..6 => '*' );
+      EVAL_ORD    :  STRING (1..6)       := ( 1..6 => '*' );
+      INDEX       :  INTEGER             := 0; 
+ 
+ 
+      FUNCTION F1 (X:INTEGER) RETURN INTEGER IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'F';    -- 123: FGH
+           EVAL_ORD   (INDEX) := 'G';    -- 123: GGG ( 'G' FOR 'GUARD' )
+           RETURN ( IDENT_INT(7) ); 
+      END F1; 
+ 
+ 
+      FUNCTION F2 (X:INTEGER) RETURN INTEGER IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'G'; 
+           EVAL_ORD   (INDEX) := 'G'; 
+           RETURN ( IDENT_INT(7) ); 
+      END F2; 
+ 
+ 
+      FUNCTION F3 (X:INTEGER) RETURN INTEGER IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'H'; 
+           EVAL_ORD   (INDEX) := 'G'; 
+           RETURN ( IDENT_INT(7) ); 
+      END F3; 
+ 
+ 
+      FUNCTION  I1 ( X:INTEGER )  RETURN BOOLEAN  IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'A';  -- 123: ABC
+           EVAL_ORD   (INDEX) := 'I';  -- 123: III ( 'I' FOR 'INDEX' )
+           RETURN ( IDENT_BOOL(TRUE) );    -- (THAT'S ENTRY-FAMILY INDEX)
+      END I1; 
+ 
+ 
+      FUNCTION  I2 ( X:INTEGER )  RETURN BOOLEAN  IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'B'; 
+           EVAL_ORD   (INDEX) := 'I'; 
+           RETURN ( IDENT_BOOL(TRUE) );
+      END I2; 
+ 
+ 
+      FUNCTION  I3 ( X:INTEGER )  RETURN BOOLEAN  IS
+      BEGIN
+           INDEX := INDEX + 1; 
+           EVAL_ORDER (INDEX) := 'C'; 
+           EVAL_ORD   (INDEX) := 'I'; 
+           RETURN ( IDENT_BOOL(TRUE) );
+      END I3; 
+ 
+      FUNCTION POS_OF (FUNC : CHARACTER) RETURN INTEGER  IS
+      BEGIN
+           FOR I IN EVAL_ORDER'RANGE LOOP
+                IF EVAL_ORDER(I) = FUNC THEN
+                     RETURN I;
+                END IF;
+           END LOOP;
+           FAILED ("DID NOT FIND LETTER " & FUNC);
+           RETURN 0;
+      END POS_OF;
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97115A", "CHECK THAT THE INDEX EXPRESSIONS ARE" &
+                       " EVALUATED AFTER THE GUARDS BUT"      &
+                       " BEFORE THE RENDEZVOUS IS ATTEMPTED"  );
+ 
+ 
+      DECLARE
+  
+ 
+           TASK T IS
+ 
+ 
+                ENTRY E ( BOOLEAN );
+                ENTRY E1; 
+ 
+           END T; 
+ 
+ 
+           TASK BODY T IS
+           BEGIN
+ 
+ 
+                WHILE  E1'COUNT = 0  -- IF  E1  NOT YET CALLED, THEN GIVE
+                LOOP                 --     THE MAIN TASK AN OPPORTUNITY
+                     DELAY  10.01 * Impdef.One_Second;   --     TO ISSUE THE CALL.
+                END LOOP;
+ 
+ 
+                SELECT               
+ 
+                          ACCEPT  E1; 
+ 
+                OR
+ 
+                     WHEN  6 + F1(7) = 13  =>
+                          ACCEPT  E ( I1(17) );
+ 
+                OR
+ 
+                     WHEN  6 + F2(7) = 13  =>
+                          ACCEPT  E ( I2(17) );
+ 
+                OR
+ 
+                     WHEN  6 + F3(7) = 13  =>
+                          ACCEPT  E ( I3(17) );
+ 
+                END SELECT;
+ 
+ 
+           END T; 
+ 
+ 
+      BEGIN
+ 
+           T.E1; 
+ 
+      END; -- END OF BLOCK CONTAINING THE ENTRY CALLS
+ 
+ 
+      COMMENT ("GUARD AND INDEX FUNCTIONS WERE CALLED IN ORDER " & 
+                EVAL_ORDER);
+      COMMENT ("GUARD AND INDEX EXPRESSIONS WERE EVALUATED IN THE " &
+               "ORDER " & EVAL_ORD);
+ 
+      IF POS_OF ('F') > POS_OF ('A') OR
+         POS_OF ('G') > POS_OF ('B') OR
+         POS_OF ('H') > POS_OF ('C') THEN
+           FAILED ("AN INDEX EXPRESSION WAS EVALUATED TOO EARLY");
+      END IF;
+ 
+      RESULT;
+ 
+ END  C97115A;  
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97116a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97116a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97116a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97116a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C97116A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE GUARD CONDITIONS IN A SELECTIVE WAIT STATEMENT
+ --     ARE NOT RE-EVALUATED DURING THE WAIT.
+ 
+ -- HISTORY:
+ --     WRG 7/10/86  CREATED ORIGINAL TEST.
+ --     RJW 5/15/90  REMOVED SHARED VARIABLES.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97116A IS
+ 
+      GUARD_EVALUATIONS : NATURAL := 0;
+ 
+      FUNCTION GUARD RETURN BOOLEAN IS
+      BEGIN
+           GUARD_EVALUATIONS := GUARD_EVALUATIONS + 1;
+           RETURN FALSE;
+      END GUARD;
+ 
+      FUNCTION SO_LONG RETURN DURATION IS
+      BEGIN
+           RETURN 20.0;
+      END SO_LONG;
+ 
+ BEGIN
+ 
+      TEST ("C97116A", "CHECK THAT THE GUARD CONDITIONS IN A " &
+                       "SELECTIVE WAIT STATEMENT ARE NOT RE-EVALUATED " &
+                       "DURING THE WAIT");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                SELECT
+                     ACCEPT E;
+                     FAILED ("ACCEPTED NONEXISTENT CALL TO E");
+                OR WHEN GUARD     =>
+                     DELAY 0.0;
+                     FAILED ("EXECUTED ALTERNATIVE CLOSED BY FALSE " &
+                             "GUARD FUNCTION" );
+                OR
+                     DELAY SO_LONG * Impdef.One_Second;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED");
+           END T;
+ 
+           TASK GET_CPU;
+ 
+           TASK BODY GET_CPU IS
+           BEGIN
+                WHILE NOT T'TERMINATED LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+           END GET_CPU;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      IF GUARD_EVALUATIONS /= 1 THEN
+           FAILED ("GUARD EVALUATED" &
+                   NATURAL'IMAGE(GUARD_EVALUATIONS) & " TIMES");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97116A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97117a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97117a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97117a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97117a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,72 ----
+ -- C97117A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PROGRAM_ERROR IS RAISED IF ALL ALTERNATIVES ARE CLOSED AND
+ -- NO ELSE PART IS PRESENT.
+ 
+ -- WRG 7/10/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97117A IS
+ 
+ BEGIN
+ 
+      TEST ("C97117A", "CHECK THAT PROGRAM_ERROR IS RAISED IF ALL " &
+                       "ALTERNATIVES ARE CLOSED AND NO ELSE PART IS " &
+                       "PRESENT");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                SELECT
+                     WHEN IDENT_BOOL (FALSE) =>
+                          ACCEPT E;
+                          FAILED ("CLOSED ACCEPT ALTERNATIVE TAKEN " &
+                                  "FOR NONEXISTENT ENTRY CALL");
+                OR   WHEN IDENT_BOOL (FALSE) =>
+                          DELAY 0.0;
+                          FAILED ("CLOSED ALTERNATIVE TAKEN");
+                END SELECT;
+                FAILED ("PROGRAM_ERROR NOT RAISED");
+           EXCEPTION
+                WHEN PROGRAM_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED");
+           END T;
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97117A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97117b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97117b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97117b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97117b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- C97117B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ELSE PART IS EXECUTED IF ALL ALTERNATIVES ARE CLOSED OR
+ -- IF THERE ARE NO TASKS QUEUED FOR OPEN ALTERNATIVES.
+ 
+ -- WRG 7/10/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97117B IS
+ 
+ BEGIN
+ 
+      TEST ("C97117B", "CHECK THAT AN ELSE PART IS EXECUTED IF ALL " &
+                       "ALTERNATIVES ARE CLOSED OR IF THERE ARE NO " &
+                       "TASKS QUEUED FOR OPEN ALTERNATIVES");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY NO_GO;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                -- ENSURE THAT NO_GO HAS BEEN CALLED BEFORE PROCEEDING:
+                WHILE NO_GO'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                SELECT
+                     WHEN IDENT_BOOL (FALSE) =>
+                          ACCEPT E;
+                          FAILED ("CLOSED ACCEPT ALTERNATIVE TAKEN " &
+                                  "FOR NONEXISTENT ENTRY CALL - 1");
+                OR
+                     WHEN IDENT_BOOL (FALSE) =>
+                          ACCEPT NO_GO;
+                          FAILED ("CLOSED ALTERNATIVE TAKEN - 1");
+                ELSE
+                     COMMENT ("ELSE PART EXECUTED - 1");
+                END SELECT;
+ 
+                SELECT
+                     ACCEPT E;
+                     FAILED ("ACCEPTED NONEXISTENT ENTRY CALL - 2");
+                OR WHEN IDENT_BOOL (FALSE) =>
+                     ACCEPT NO_GO;
+                     FAILED ("CLOSED ALTERNATIVE TAKEN - 2");
+                ELSE
+                     COMMENT ("ELSE PART EXECUTED - 2");
+                END SELECT;
+ 
+                ACCEPT NO_GO;
+           END T;
+ 
+      BEGIN
+ 
+           T.NO_GO;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97117B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97117c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97117c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97117c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97117c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- C97117C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN ELSE PART IS NOT EXECUTED IF A TASK IS QUEUED AT AN
+ -- OPEN ALTERNATIVE.
+ 
+ -- WRG 7/10/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97117C IS
+ 
+ BEGIN
+ 
+      TEST ("C97117C", "CHECK THAT AN ELSE PART IS NOT EXECUTED IF A " &
+                       "TASK IS QUEUED AT AN OPEN ALTERNATIVE");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY NO_GO;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                --ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+                WHILE E'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                SELECT
+                     ACCEPT NO_GO;
+                     FAILED ("ACCEPTED NONEXISTENT ENTRY CALL");
+                OR WHEN IDENT_BOOL (TRUE)  =>
+                     ACCEPT E;
+                OR WHEN IDENT_BOOL (FALSE) =>
+                     ACCEPT E;
+                     FAILED ("CLOSED ALTERNATIVE TAKEN");
+                ELSE
+                     FAILED ("ELSE PART EXECUTED");
+                END SELECT;
+           END T;
+ 
+      BEGIN
+ 
+           T.E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97117C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97118a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97118a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97118a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97118a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- C97118A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CALL TO A CLOSED ALTERNATIVE OF A SELECTIVE WAIT IS NOT
+ -- ACCEPTED.
+ 
+ -- WRG 7/11/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97118A IS
+ 
+ BEGIN
+ 
+      TEST ("C97118A", "CHECK THAT A CALL TO A CLOSED ALTERNATIVE OF " &
+                       "A SELECTIVE WAIT IS NOT ACCEPTED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                -- ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+                WHILE E'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                SELECT
+                     WHEN IDENT_BOOL (FALSE) =>
+                          ACCEPT E;
+                          FAILED ("ACCEPTED CALL TO CLOSED ALTERNATIVE");
+                     ELSE
+                          NULL;
+                END SELECT;
+ 
+                IF E'COUNT = 1 THEN
+                     ACCEPT E;
+                END IF;
+           END T;
+ 
+      BEGIN
+ 
+           T.E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97118A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97120a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97120a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97120a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97120a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- C97120A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SELECTIVE WAIT DELAYS AT LEAST AS LONG AS IS SPECIFIED
+ -- IN A DELAY ALTERNATIVE.
+ 
+ -- WRG 7/11/86
+ 
+ with Impdef;
+ WITH REPORT;   USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97120A IS
+ 
+ BEGIN
+ 
+      TEST ("C97120A", "CHECK THAT A SELECTIVE WAIT DELAYS AT LEAST " &
+                       "AS LONG AS IS SPECIFIED IN A DELAY ALTERNATIVE");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY NO_GO;
+                ENTRY SYNCH;
+           END T;
+ 
+           TASK BODY T IS
+                BEFORE, AFTER : TIME;
+           BEGIN
+                -- ENSURE THAT SYNCH HAS BEEN CALLED BEFORE PROCEEDING:
+                WHILE SYNCH'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                BEFORE := CLOCK;
+                SELECT
+                     ACCEPT NO_GO;
+                     FAILED ("ACCEPTED NONEXISTENT ENTRY CALL");
+                OR
+                     DELAY 10.0 * Impdef.One_Second;
+                     AFTER := CLOCK;
+                     IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                          FAILED ("INSUFFICIENT DELAY");
+                     END IF;
+                END SELECT;
+ 
+                ACCEPT SYNCH;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED");
+           END T;
+ 
+      BEGIN
+ 
+           T.SYNCH;  -- SUSPEND MAIN TASK BEFORE READING CLOCK.
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97120A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97120b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97120b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97120b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97120b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- C97120B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A SPECIFIED DELAY IS ZERO OR NEGATIVE AND AN ENTRY CALL
+ -- IS WAITING AT AN OPEN ALTERNATIVE WHEN THE SELECTIVE WAIT IS
+ -- EXECUTED, THE CALL IS ACCEPTED.
+ 
+ -- WRG 7/11/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97120B IS
+ 
+      ZERO, NEG : DURATION := 1.0;
+ 
+ BEGIN
+ 
+      TEST ("C97120B", "CHECK THAT IF A SPECIFIED DELAY IS ZERO OR " &
+                       "NEGATIVE AND AN ENTRY CALL IS WAITING AT AN " &
+                       "OPEN ALTERNATIVE WHEN THE SELECTIVE WAIT IS " &
+                       "EXECUTED, THE CALL IS ACCEPTED");
+ 
+      IF EQUAL (3, 3) THEN
+           ZERO :=  0.0;
+           NEG  := -1.0;
+      END IF;
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                WHILE E'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+             A: BEGIN
+                     SELECT
+                          WHEN IDENT_BOOL (TRUE) =>
+                               ACCEPT E;
+                     OR
+                          DELAY ZERO * Impdef.One_Second;
+                          FAILED ("ZERO DELAY ALTERNATIVE TAKEN");
+                          ACCEPT E;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED (A)");
+                END A;
+ 
+                WHILE E'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+             B: BEGIN
+                     SELECT
+                          ACCEPT E;
+                     OR
+                          DELAY NEG;
+                          FAILED ("NEGATIVE DELAY ALTERNATIVE TAKEN");
+                          ACCEPT E;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED (B)");
+                END B;
+ 
+           END T;
+ 
+      BEGIN
+ 
+           T.E;
+           T.E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97120B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- C97201A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+ --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+ 
+ -- CASE  A:  THE TASK TO BE CALLED IS NOT YET ACTIVE AS OF THE
+ --     MOMENT OF CALL (CONDITIONAL_ENTRY_CALL),
+ --     AND THIS FACT CAN BE DETERMINED STATICALLY.
+ 
+ 
+ -- RM 4/20/82
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97201A IS
+ 
+      ELSE_BRANCH_TAKEN    :  INTEGER  :=  3 ;
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97201A", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                       " A CONDITIONAL_ENTRY_CALL CAN OCCUR  WHILE" &
+                       " THE CALLED TASK IS NOT YET ACTIVE"         );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_ORELSE ( AUTHORIZED : IN BOOLEAN ) ;
+           END  T ;
+ 
+ 
+           TASK BODY  T  IS
+ 
+                PACKAGE       SECOND_ATTEMPT  IS    END  SECOND_ATTEMPT ;
+                PACKAGE BODY  SECOND_ATTEMPT  IS
+                BEGIN
+ 
+                     SELECT
+                          DO_IT_NOW_ORELSE (FALSE) ;--CALLING (OWN) ENTRY
+                     ELSE    -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                          ELSE_BRANCH_TAKEN := 2 * ELSE_BRANCH_TAKEN ;
+                          COMMENT( "ELSE_BRANCH  TAKEN  (#2)" );
+                     END SELECT;
+ 
+                END  SECOND_ATTEMPT ;
+ 
+           BEGIN
+ 
+                ACCEPT DO_IT_NOW_ORELSE ( AUTHORIZED : IN BOOLEAN )  DO
+ 
+                     IF  AUTHORIZED  THEN
+                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                     ELSE
+                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                     END IF;
+ 
+                END DO_IT_NOW_ORELSE ;
+ 
+ 
+           END  T ;
+ 
+ 
+           PACKAGE       FIRST_ATTEMPT  IS      END  FIRST_ATTEMPT ;
+           PACKAGE BODY  FIRST_ATTEMPT  IS
+           BEGIN
+                SELECT
+                     T.DO_IT_NOW_ORELSE (FALSE) ;
+                ELSE        -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                     ELSE_BRANCH_TAKEN := 1 + ELSE_BRANCH_TAKEN ;
+                     COMMENT( "ELSE_BRANCH  TAKEN  (#1)" );
+                END SELECT;
+ 
+           END  FIRST_ATTEMPT ;
+ 
+ 
+      BEGIN
+ 
+           T.DO_IT_NOW_ORELSE ( TRUE );   -- TO SATISFY THE SERVER'S
+                                           --     WAIT FOR SUCH A CALL
+ 
+      EXCEPTION
+ 
+           WHEN  TASKING_ERROR  =>
+                FAILED( "TASKING ERROR" );
+ 
+      END  ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      -- BY NOW, THE TASK IS TERMINATED  (AND THE NONLOCALS UPDATED)
+ 
+ 
+      CASE  ELSE_BRANCH_TAKEN  IS
+ 
+           WHEN  3  =>
+                FAILED( "NO 'ELSE'; BOTH (?) RENDEZVOUS ATTEMPTED?" );
+ 
+           WHEN  4  =>
+                FAILED( "'ELSE' #1 ONLY; RENDEZVOUS (#2) ATTEMPTED?" );
+ 
+           WHEN  6  =>
+                FAILED( "'ELSE' #2 ONLY; RENDEZVOUS (#1) ATTEMPTED?" );
+ 
+           WHEN  7  =>
+                FAILED( "WRONG ORDER FOR 'ELSE':  #2,#1 " );
+ 
+           WHEN  8  =>
+                NULL ;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG CASE_VALUE" );
+ 
+      END CASE;
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C97201A ; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C97201B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CONDITIONAL ENTRY CALL IS NOT ACCEPTED IF THERE IS
+ -- ANOTHER TASK QUEUED FOR THE ENTRY.
+ 
+ -- WRG 7/11/86
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97201B IS
+ 
+ 
+ BEGIN
+ 
+      TEST ("C97201B", "CHECK THAT A CONDITIONAL ENTRY CALL IS NOT " &
+                       "ACCEPTED IF THERE IS ANOTHER TASK QUEUED " &
+                       "FOR THE ENTRY");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY SYNCH;
+                ENTRY DONE;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                -- ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+                WHILE E'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+ 
+                ACCEPT SYNCH;
+ 
+                SELECT
+                     WHEN IDENT_BOOL (FALSE) =>
+                          ACCEPT E;
+                          FAILED ("CLOSED ALTERNATIVE TAKEN");
+                OR
+                     ACCEPT DONE DO
+                          IF E'COUNT /= 1 THEN
+                               FAILED (NATURAL'IMAGE(E'COUNT) &
+                                       " CALLS WERE QUEUED FOR ENTRY " &
+                                       "E OF TASK T");
+                          END IF;
+                     END DONE;
+                OR
+                     DELAY 1000.0 * Impdef.One_Second;
+                     FAILED ("DELAY EXPIRED; E'COUNT =" &
+                             NATURAL'IMAGE(E'COUNT) );
+                END SELECT;
+ 
+                WHILE E'COUNT > 0 LOOP
+                     ACCEPT E;
+                END LOOP;
+           END T;
+ 
+           TASK AGENT;
+ 
+           TASK BODY AGENT IS
+           BEGIN
+                T.E;
+           END AGENT;
+ 
+      BEGIN
+ 
+           T.SYNCH;
+ 
+           DELAY 10.0 * Impdef.One_Second;
+ 
+           SELECT
+                T.E;
+                FAILED ("CONDITIONAL ENTRY CALL ACCEPTED" );
+           ELSE
+                COMMENT ("ELSE PART EXECUTED");
+                T.DONE;
+           END SELECT;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97201B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- C97201C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CONDITIONAL ENTRY CALL IS NOT ACCEPTED IF AN ACCEPT
+ -- STATEMENT FOR THE CALLED ENTRY HAS NOT YET BEEN REACHED.
+ 
+ -- WRG 7/11/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97201C IS
+ 
+ BEGIN
+ 
+      TEST ("C97201C", "CHECK THAT A CONDITIONAL ENTRY CALL IS NOT " &
+                       "ACCEPTED IF AN ACCEPT STATEMENT FOR THE " &
+                       "CALLED ENTRY HAS NOT YET BEEN REACHED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY BARRIER;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT BARRIER;
+                IF E'COUNT > 0 THEN
+                     FAILED ("ENTRY CALL WAS QUEUED");
+                     ACCEPT E;
+                END IF;
+           END T;
+ 
+      BEGIN
+ 
+           SELECT
+                T.E;
+                FAILED ("CONDITIONAL ENTRY CALL ACCEPTED");
+           ELSE
+                COMMENT ("ELSE PART EXECUTED");
+           END SELECT;
+ 
+           T.BARRIER;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97201C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C97201D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+ --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+ 
+ -- CASE  D:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+ --     DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
+ --     AND THIS FACT IS DETERMINED STATICALLY.
+ 
+ 
+ -- RM 4/12/82
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97201D IS
+ 
+      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97201D", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                       " IN THE ABSENCE OF A CORRESPONDING "        &
+                       " ACCEPT_STATEMENT "                         );
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_ORELSE ;
+                ENTRY  KEEP_ALIVE ;
+           END  T ;
+           
+ 
+           TASK BODY  T  IS
+           BEGIN
+ 
+                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED
+ 
+                ACCEPT  KEEP_ALIVE ;  -- TO PREVENT THIS SERVER TASK FROM
+                                      --     TERMINATING IF
+                                      --     UPON ACTIVATION
+                                      --     IT GETS TO RUN    
+                                      --     AHEAD OF THE CALLER (WHICH
+                                      --     WOULD LEAD TO A SUBSEQUENT
+                                      --     TASKING_ERROR AT THE TIME OF
+                                      --     THE NO-WAIT CALL).
+ 
+           END ;
+ 
+ 
+      BEGIN
+ 
+           SELECT
+                T.DO_IT_NOW_ORELSE ;
+           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                ELSE_BRANCH_TAKEN := TRUE ;
+                COMMENT( "ELSE_BRANCH  TAKEN" );
+           END SELECT;
+ 
+           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+ 
+      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+ 
+ 
+      -- BY NOW, THE TASK IS TERMINATED
+ 
+      IF  ELSE_BRANCH_TAKEN  THEN
+           NULL ;
+      ELSE
+           FAILED( "RENDEZVOUS ATTEMPTED?" );
+      END IF;
+ 
+      RESULT;
+ 
+ 
+ END  C97201D ; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- C97201E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+ --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+ 
+ -- CASE  E:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+ --     DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
+ --     AND THIS FACT CAN NOT BE DETERMINED STATICALLY.
+ --     (THE ENTRY BELONGS TO AN ENTRY FAMILY; SOME FAMILY MEMBERS
+ --     ARE "ACCEPTABLE", BUT NOT THE CALLED ONE.)
+ 
+ 
+ -- RM 4/13/82
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97201E IS
+ 
+      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97201E", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                       " IN THE ABSENCE OF A CORRESPONDING "        &
+                       " ACCEPT_STATEMENT "                         );
+ 
+ 
+      DECLARE
+ 
+           SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
+ 
+           KEEP_ALIVE  :  INTEGER  := 15 ;
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_ORELSE ( SHORT ) ;
+           END  T ;
+           
+ 
+           TASK BODY  T  IS
+           BEGIN
+ 
+                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED
+                ACCEPT  DO_IT_NOW_ORELSE ( IDENT_INT(15) );
+ 
+                                      -- THIS ALSO PREVENTS THIS SERVER
+                                      --     TASK FROM TERMINATING IF
+                                      --     UPON ACTIVATION
+                                      --     IT GETS TO RUN    
+                                      --     AHEAD OF THE CALLER (WHICH
+                                      --     WOULD LEAD TO A SUBSEQUENT
+                                      --     TASKING_ERROR AT THE TIME OF
+                                      --     THE NO-WAIT CALL).
+ 
+           END ;
+ 
+ 
+      BEGIN
+ 
+           SELECT
+                T.DO_IT_NOW_ORELSE (10) ;  -- ACCEPT_STATEMENT HAS  15
+           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                ELSE_BRANCH_TAKEN := TRUE ;
+                COMMENT( "ELSE_BRANCH  TAKEN" );
+           END SELECT;
+ 
+           T.DO_IT_NOW_ORELSE(KEEP_ALIVE) ;-- THIS ALSO UPDATES NONLOCALS
+ 
+      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+ 
+ 
+      -- BY NOW, THE TASK IS TERMINATED
+ 
+      IF  ELSE_BRANCH_TAKEN  THEN
+           NULL ;
+      ELSE
+           FAILED( "RENDEZVOUS ATTEMPTED?" );
+      END IF;
+ 
+      RESULT;
+ 
+ 
+ END  C97201E ; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- C97201G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+ --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+ 
+ -- CASE  G:  THE CORRESPONDING ACCEPT_STATEMENT IS CLOSED
+ --     AND THIS FACT IS STATICALLY DETERMINABLE.
+ 
+ 
+ -- RM 4/21/82
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97201G IS
+ 
+      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+      RENDEZVOUS_OCCURRED  :  BOOLEAN  :=  FALSE ;
+      QUEUE_NOT_EMPTY      :  BOOLEAN  :=  FALSE ;
+      X                    :  INTEGER  :=  17 ;
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97201G", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                       " IF THE CORRESPONDING ACCEPT_STATEMENT IS"  &
+                       " CLOSED"                                    );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
+                ENTRY  KEEP_ALIVE ;
+           END  T ;
+           
+ 
+           TASK BODY  T  IS
+           BEGIN
+ 
+                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                     QUEUE_NOT_EMPTY := TRUE ;
+                END IF;
+ 
+ 
+                SELECT
+                     WHEN  3 = 5  =>
+                          ACCEPT  DO_IT_NOW_ORELSE
+                                       ( DID_YOU_DO_IT : IN OUT BOOLEAN)
+                          DO
+                               DID_YOU_DO_IT := TRUE ;
+                          END;
+                OR
+                          ACCEPT  KEEP_ALIVE ; -- TO PREVENT SELECT_ERROR
+                END SELECT;
+ 
+ 
+                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                     QUEUE_NOT_EMPTY := TRUE ;
+                END IF;
+ 
+ 
+           END  T ;
+ 
+ 
+      BEGIN
+ 
+           COMMENT( "PERMANENTLY CLOSED" );
+ 
+           SELECT
+                T.DO_IT_NOW_ORELSE( RENDEZVOUS_OCCURRED );
+           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                ELSE_BRANCH_TAKEN := TRUE ;
+                COMMENT( "ELSE_BRANCH  TAKEN" );
+           END SELECT;
+ 
+           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+ 
+      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      -- BY NOW, THE TASK IS TERMINATED
+ 
+      IF  RENDEZVOUS_OCCURRED
+      THEN
+           FAILED( "RENDEZVOUS OCCURRED" );
+      END IF;
+ 
+      IF  QUEUE_NOT_EMPTY
+      THEN
+           FAILED( "ENTRY QUEUE NOT EMPTY" );
+      END IF;
+ 
+      IF  ELSE_BRANCH_TAKEN  THEN
+           NULL ;
+      ELSE
+           FAILED( "RENDEZVOUS ATTEMPTED?" );
+      END IF;
+ 
+      RESULT;
+ 
+ 
+ END  C97201G ; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- C97201H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+ --     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+ 
+ -- CASE  H:  THE CORRESPONDING ACCEPT_STATEMENT IS CLOSED
+ --     AND THIS FACT IS NOT STATICALLY DETERMINABLE.
+ 
+ 
+ -- RM 4/22/82
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97201H IS
+ 
+      ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+      RENDEZVOUS_OCCURRED  :  BOOLEAN  :=  FALSE ;
+      QUEUE_NOT_EMPTY      :  BOOLEAN  :=  FALSE ;
+      X                    :  INTEGER  :=  17 ;
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97201H", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                       " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                       " IF THE CORRESPONDING ACCEPT_STATEMENT IS"  &
+                       " CLOSED"                                    );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
+                ENTRY  KEEP_ALIVE ;
+           END  T ;
+           
+ 
+           TASK BODY  T  IS
+           BEGIN
+ 
+                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                     QUEUE_NOT_EMPTY := TRUE ;
+                END IF;
+ 
+ 
+                SELECT
+                     WHEN  3 = IDENT_INT(5)  =>
+                          ACCEPT  DO_IT_NOW_ORELSE
+                                       ( DID_YOU_DO_IT : IN OUT BOOLEAN)
+                          DO
+                               DID_YOU_DO_IT := TRUE ;
+                          END;
+                OR
+                          ACCEPT  KEEP_ALIVE ; -- TO PREVENT SELECT_ERROR
+                END SELECT;
+ 
+ 
+                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                     QUEUE_NOT_EMPTY := TRUE ;
+                END IF;
+ 
+ 
+           END  T ;
+ 
+ 
+      BEGIN
+ 
+           COMMENT( "PERMANENTLY CLOSED" );
+ 
+           SELECT
+                T.DO_IT_NOW_ORELSE( RENDEZVOUS_OCCURRED );
+           ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                             --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                ELSE_BRANCH_TAKEN := TRUE ;
+                COMMENT( "ELSE_BRANCH  TAKEN" );
+           END SELECT;
+ 
+           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+ 
+      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      -- BY NOW, THE TASK IS TERMINATED
+ 
+      IF  RENDEZVOUS_OCCURRED
+      THEN
+           FAILED( "RENDEZVOUS OCCURRED" );
+      END IF;
+ 
+      IF  QUEUE_NOT_EMPTY
+      THEN
+           FAILED( "ENTRY QUEUE NOT EMPTY" );
+      END IF;
+ 
+      IF  ELSE_BRANCH_TAKEN  THEN
+           NULL ;
+      ELSE
+           FAILED( "RENDEZVOUS ATTEMPTED?" );
+      END IF;
+ 
+      RESULT;
+ 
+ 
+ END  C97201H ; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201x.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201x.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97201x.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97201x.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- C97201X.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NO RENDEZVOUS CAN EVER OCCUR IF BOTH PARTNERS REFUSE TO
+ --     WAIT (THAT IS, IF THE ENTRY CALL IS ISSUED BY A
+ --     "CONDITIONAL_ENTRY_CALL" AND THUS FOLLOWS A NO-WAIT POLICY
+ --     (DEMANDING UNCONDITIONALLY THAT "YOU DO IT   N O W  , OR ELSE"),
+ --     WHILE THE CALLEE IS ALSO COMMITTED TO A NO-WAIT POLICY,
+ --     BY VIRTUE OF A SELECTIVE_WAIT STATEMENT OF THE THIRD KIND
+ --     (WITH AN "ELSE" PART) IN WHICH THE CORRESPONDING ACCEPT_STATEMENT
+ --     IS EMBEDDED).
+ --     ("CLOSE ENCOUNTERS OF THE THIRD KIND"  --  ARE THEY POSSIBLE?)
+ 
+ 
+ -- THE SEMANTICS OF THIS ENTRY CALL REQUIRES THAT THE CALLING TASK
+ --     N O T   ENTER ITSELF ON ANY QUEUE BUT RATHER ATTEMPT AN IMMEDIATE
+ --     RENDEZVOUS WHICH IS TO TAKE PLACE IF AND ONLY IF THE CALLED TASK
+ --     HAS REACHED A POINT WHERE IT IS READY TO ACCEPT THE CALL (I.E.
+ --     IT IS EITHER WAITING AT AN ACCEPT STATEMENT FOR THE CORRESPONDING
+ --     ENTRY OR IT IS WAITING AT A SELECTIVE_WAIT STATEMENT WITH AN OPEN
+ --     ALTERNATIVE STARTING WITH SUCH AN ACCEPT STATEMENT).  IT ALSO
+ --     REQUIRES THAT THE ENTRY CALL BE CANCELLED IF THE CALLED TASK 
+ --     IS NOT AT SUCH A POINT.  ON THE OTHER HAND, THE SEMANTICS OF THE
+ --     SELECTIVE_WAIT STATEMENT WITH AN  'ELSE'  PART  SPECIFIES THAT
+ --     THE  'ELSE'  PART  MUST BE SELECTED IF NO 'ACCEPT' ALTERNATIVE
+ --     CAN BE IMMEDIATELY SELECTED,  AND THAT SUCH AN ALTERNATIVE
+ --     IS DEEMED TO BE IMMEDIATELY SELECTABLE ("SELECTION OF ONE SUCH
+ --     ALTERNATIVE OCCURS IMMEDIATELY"), AND A CORRESPONDING RENDEZVOUS
+ --     POSSIBLE,  IF AND ONLY IF THERE IS A CORRESPONDING ENTRY CALL
+ --     W A I T I N G   TO BE ACCCEPTED.  A "CONDITIONAL ENTRY CALL"
+ --     NEVER WAITS, AND IS NEVER ENTERED IN WAIT QUEUES; IT TAKES
+ --     THE 'ELSE' PART INSTEAD.
+ 
+ 
+ -- NOTE: IF THIS TEST PROGRAM HANGS UP, THE COMPILER WILL BE DEEMED
+ --     TO HAVE FAILED.
+ 
+ 
+ -- RM 3/19/82
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97201X IS
+ 
+      RENDEZVOUS_OCCURRED        :  BOOLEAN  :=  FALSE ;
+ 
+      CALLER_TAKES_WRONG_BRANCH  :  BOOLEAN  :=  TRUE  ;
+      SERVER_TAKES_WRONG_BRANCH  :  BOOLEAN  :=  TRUE  ;
+      QUEUE_NOT_EMPTY            :  BOOLEAN  :=  FALSE ;
+ 
+ BEGIN
+ 
+ 
+      TEST ("C97201X", "CHECK THAT NO RENDEZVOUS CAN EVER OCCUR IF" &
+                       " BOTH PARTNERS REFUSE TO WAIT" );
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  T  IS
+                ENTRY  SYNCHRONIZE ;
+                ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
+                ENTRY  KEEP_ALIVE  ;
+           END  T ;
+           
+ 
+           TASK BODY  T  IS
+           BEGIN
+ 
+ 
+                ACCEPT  SYNCHRONIZE ;
+ 
+ 
+                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                     QUEUE_NOT_EMPTY := TRUE ;
+                END IF;
+ 
+ 
+                SELECT
+                          ACCEPT  DO_IT_NOW_ORELSE
+                                       ( DID_YOU_DO_IT : IN OUT BOOLEAN )
+                          DO
+                               DID_YOU_DO_IT  :=  TRUE ;
+                          END ;
+                ELSE         -- (I.E. TASK ADOPTS NO-WAIT POLICY)
+                             -- 'ELSE' BRANCH MUST THEREFORE BE CHOSEN
+                     SERVER_TAKES_WRONG_BRANCH := FALSE ;
+                END SELECT;
+ 
+ 
+                IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                     QUEUE_NOT_EMPTY := TRUE ;
+                END IF;
+ 
+ 
+                ACCEPT  KEEP_ALIVE ;  -- TO PREVENT THIS SERVER TASK FROM
+                                      --     TERMINATING IF IT GETS TO
+                                      --     THE NO-WAIT MEETING-PLACE
+                                      --     AHEAD OF THE CALLER (WHICH
+                                      --     WOULD LEAD TO A SUBSEQUENT
+                                      --     TASKING_ERROR AT THE TIME OF
+                                      --     THE NO-WAIT CALL).
+ 
+ 
+           END  T ;
+ 
+ 
+      BEGIN
+ 
+ 
+           T.SYNCHRONIZE ;  -- TO MINIMIZE THE   N E E D   TO WAIT
+ 
+ 
+           SELECT
+                T.DO_IT_NOW_ORELSE ( RENDEZVOUS_OCCURRED );
+           ELSE              -- (I.E. CALLER TOO ADOPTS A NO-WAIT POLICY)
+                                     -- MUST THEREFORE CHOOSE THIS BRANCH
+                CALLER_TAKES_WRONG_BRANCH := FALSE ;
+           END SELECT;
+ 
+ 
+           T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+ 
+ 
+      END;   -- END OF BLOCK CONTAINING THE NO-WAIT ENTRY CALL
+ 
+ 
+      IF  RENDEZVOUS_OCCURRED
+      THEN
+           FAILED( "RENDEZVOUS OCCURRED" );
+      END IF;
+ 
+      IF  CALLER_TAKES_WRONG_BRANCH  OR
+          SERVER_TAKES_WRONG_BRANCH
+      THEN
+           FAILED( "WRONG BRANCH TAKEN" );
+      END IF;
+ 
+      IF  QUEUE_NOT_EMPTY
+      THEN
+           FAILED( "ENTRY QUEUE NOT EMPTY" );
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C97201X ; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97202a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97202a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97202a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97202a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C97202A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE INDEX IS EVALUATED BEFORE THE ENTRY PARAMETER AND BOTH
+ -- THE INDEX AND THE ENTRY PARAMETER ARE EVALUATED BEFORE THE RENDEZVOUS
+ -- IS ATTEMPED.
+ 
+ -- RM 4/05/82
+ -- TBN 2/3/86     ADDED A CHECK THAT INDEX IS EVALUATED BEFORE THE ENTRY
+ --                PARAMETER AND FIXED APPROPRIATE COMMENTS.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97202A IS
+ 
+      INDEX_COMPUTED   :  BOOLEAN  :=  FALSE ;
+      FORMAL_COMPUTED  :  BOOLEAN  :=  FALSE ;
+ 
+ BEGIN
+ 
+      TEST ("C97202A", "CHECK THAT THE INDEX IS EVALUATED BEFORE THE " &
+                       "ENTRY PARAMETER AND BOTH INDEX AND THE ENTRY " &
+                       "PARAMETER ARE EVALUATED BEFORE THE RENDEZVOUS " &
+                       "IS ATTEMPTED");
+ 
+      DECLARE
+           SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_ORELSE (SHORT)
+                                        (DID_YOU_DO_IT : IN BOOLEAN);
+                ENTRY  KEEP_ALIVE ;
+           END  T ;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  KEEP_ALIVE ;
+           END  T ;
+ 
+           FUNCTION  F1 (X:INTEGER) RETURN INTEGER  IS
+           BEGIN
+                IF FORMAL_COMPUTED THEN
+                     FAILED ("INDEX WAS NOT EVALUATED FIRST");
+                END IF;
+                INDEX_COMPUTED  :=  TRUE ;
+                RETURN (7) ;
+           END  F1 ;
+ 
+           FUNCTION  F2 (X:INTEGER) RETURN BOOLEAN  IS
+           BEGIN
+                FORMAL_COMPUTED  :=  TRUE ;
+                RETURN (FALSE) ;
+           END  F2 ;
+ 
+      BEGIN
+           SELECT
+                T.DO_IT_NOW_ORELSE ( 6 + F1(7)  )
+                                   ( NOT(F2(7)) ) ;
+           ELSE
+                NULL ;
+           END SELECT;
+ 
+           T.KEEP_ALIVE ;
+      END;   -- END OF BLOCK CONTAINING THE ENTRY CALLS.
+ 
+      IF  INDEX_COMPUTED  THEN
+           NULL ;
+      ELSE
+           FAILED( "ENTRY INDEX WAS NOT COMPUTED" );
+      END IF;
+ 
+      IF  FORMAL_COMPUTED  THEN
+           NULL ;
+      ELSE
+           FAILED( "ENTRY PARAMETER WAS NOT COMPUTED" );
+      END IF;
+ 
+      RESULT;
+ 
+ END  C97202A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97203a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97203a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97203a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,125 ----
+ -- C97203A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CONDITIONAL_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+ --     SELECTIVE_WAIT  CANNOT.
+ 
+ -- PART 1: PACKAGE BODY EMBEDDED IN TASK BODY.
+ 
+ 
+ -- RM 4/01/1982
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE  C97203A  IS
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST ( "C97203A" , "CHECK THAT A  CONDITIONAL_ENTRY_CALL  CAN" &
+                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  TT  IS
+                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+           END  TT ;
+ 
+ 
+           TASK BODY  TT  IS
+ 
+ 
+                PACKAGE  WITHIN_TASK_BODY  IS
+                     -- NOTHING HERE
+                END  WITHIN_TASK_BODY ;
+ 
+ 
+                PACKAGE BODY  WITHIN_TASK_BODY  IS
+                BEGIN
+ 
+                     SELECT  -- NOT A SELECTIVE_WAIT
+                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                     ELSE 
+                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                     END SELECT;
+                     
+                END  WITHIN_TASK_BODY ;
+ 
+ 
+           BEGIN
+ 
+                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+ 
+                     IF  AUTHORIZED  THEN
+                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                     ELSE
+                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                     END IF;
+ 
+                END  A ;
+ 
+           END  TT ;
+ 
+ 
+           PACKAGE  OUTSIDE_TASK_BODY  IS
+                -- NOTHING HERE
+           END  OUTSIDE_TASK_BODY ;
+ 
+ 
+           PACKAGE BODY  OUTSIDE_TASK_BODY  IS
+           BEGIN
+ 
+                SELECT  -- NOT A SELECTIVE_WAIT
+                     TT.A ( FALSE ) ;  -- UNBORN
+                ELSE 
+                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+                END SELECT;
+ 
+           END  OUTSIDE_TASK_BODY ;
+ 
+ 
+      BEGIN
+ 
+           TT.A ( TRUE );
+ 
+      EXCEPTION
+ 
+           WHEN  TASKING_ERROR  =>
+                FAILED( "TASKING ERROR" );
+ 
+      END  ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT ;
+ 
+ 
+ END  C97203A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97203b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97203b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97203b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97203b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,131 ----
+ -- C97203B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CONDITIONAL_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+ --     SELECTIVE_WAIT  CANNOT.
+ 
+ -- PART 2: PROCEDURE BODY EMBEDDED IN TASK BODY.
+ 
+ 
+ -- RM 4/09/1982
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE  C97203B  IS
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST ( "C97203B" , "CHECK THAT A  CONDITIONAL_ENTRY_CALL  CAN" &
+                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  TT  IS
+                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+           END  TT ;
+ 
+ 
+           TASK BODY  TT  IS
+ 
+ 
+                PROCEDURE  WITHIN_TASK_BODY ;
+ 
+ 
+                PROCEDURE  WITHIN_TASK_BODY  IS
+                BEGIN
+ 
+                     SELECT  -- NOT A SELECTIVE_WAIT
+                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                     ELSE 
+                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                     END SELECT;
+                     
+                END  WITHIN_TASK_BODY ;
+ 
+ 
+           BEGIN
+ 
+ 
+                -- CALL THE INNER PROC. TO FORCE EXEC. OF COND_E_CALL
+                WITHIN_TASK_BODY ;
+ 
+ 
+                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+ 
+                     IF  AUTHORIZED  THEN
+                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                     ELSE
+                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                     END IF;
+ 
+                END  A ;
+ 
+           END  TT ;
+ 
+ 
+           PROCEDURE  OUTSIDE_TASK_BODY  IS
+           BEGIN
+ 
+                SELECT  -- NOT A SELECTIVE_WAIT
+                     TT.A ( FALSE ) ;  -- UNBORN
+                ELSE 
+                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+                END SELECT;
+ 
+           END  OUTSIDE_TASK_BODY ;
+ 
+ 
+           PACKAGE       CREATE_OPPORTUNITY_TO_CALL           IS END;   
+           PACKAGE BODY  CREATE_OPPORTUNITY_TO_CALL  IS
+           BEGIN
+                -- CALL THE OTHER PROC. TO FORCE EXEC. OF COND_E_CALL
+                OUTSIDE_TASK_BODY ;
+           END  CREATE_OPPORTUNITY_TO_CALL ;
+ 
+ 
+      BEGIN
+ 
+           TT.A ( TRUE );
+ 
+      EXCEPTION
+ 
+           WHEN  TASKING_ERROR  =>
+                FAILED( "TASKING ERROR" );
+ 
+      END  ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT ;
+ 
+ 
+ END  C97203B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97203c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97203c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97203c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97203c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- C97203C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A CONDITIONAL ENTRY CALL CAN APPEAR IN PLACES WHERE A
+ -- SELECTIVE WAIT IS NOT ALLOWED.
+ 
+ -- PART 3: TASK BODY NESTED WITHIN A TASK.
+ 
+ -- WRG 7/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97203C IS
+ 
+ BEGIN
+ 
+      TEST ("C97203C", "CHECK THAT A CONDITIONAL ENTRY CALL CAN " &
+                       "APPEAR IN PLACES WHERE A SELECTIVE WAIT " &
+                       "IS NOT ALLOWED; CASE: TASK BODY NESTED " &
+                       "WITHIN A TASK");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY SYNCH;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT SYNCH;
+                ACCEPT SYNCH;
+                ACCEPT SYNCH;
+                ACCEPT E;
+           END T;
+ 
+           TASK OUTER IS
+                ENTRY E;
+                ENTRY SYNCH;
+           END OUTER;
+ 
+           TASK BODY OUTER IS
+ 
+                TASK TYPE INNER;
+ 
+                INNER1 : INNER;
+ 
+                TASK BODY INNER IS
+                BEGIN
+                     SELECT
+                          T.E;
+                          FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - " &
+                                  "INNER (1)");
+                     ELSE
+                          T.SYNCH;
+                     END SELECT;
+ 
+                     SELECT
+                          OUTER.E;
+                          FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - " &
+                                  "INNER (2)");
+                     ELSE
+                          OUTER.SYNCH;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED - INNER");
+                END INNER;
+ 
+                PACKAGE DUMMY IS
+                     TYPE ACC_INNER IS ACCESS INNER;
+                     INNER2 : ACC_INNER := NEW INNER;
+                END DUMMY;
+ 
+           BEGIN
+ 
+                SELECT
+                     T.E;
+                     FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - OUTER");
+                ELSE
+                     T.SYNCH;
+                END SELECT;
+ 
+                ACCEPT SYNCH;
+                ACCEPT SYNCH;
+                ACCEPT E;
+ 
+           EXCEPTION
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - OUTER");
+ 
+           END OUTER;
+ 
+      BEGIN
+ 
+           T.E;
+           OUTER.E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97203C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97204a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97204a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97204a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- C97204A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL BE RAISED IF THE CALLED
+ --     TASK HAS ALREADY COMPLETED ITS EXECUTION AT THE TIME OF THE
+ --     CONDITIONAL_ENTRY_CALL.
+ 
+ 
+ -- RM 5/28/82
+ -- SPS 11/21/82
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE  C97204A  IS
+ 
+      -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
+ 
+ BEGIN
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      TEST ("C97204A", "CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL" &
+                       " BE RAISED IF THE CALLED TASK HAS ALREADY"     &
+                       " COMPLETED ITS EXECUTION AT THE TIME OF THE"   &
+                       " CONDITIONAL_ENTRY_CALL"                       );
+ 
+   
+      DECLARE
+ 
+ 
+           TASK TYPE  T_TYPE  IS
+ 
+ 
+                ENTRY  E ;
+ 
+           END  T_TYPE ;
+ 
+ 
+           T_OBJECT1 : T_TYPE ;
+ 
+ 
+           TASK BODY  T_TYPE  IS
+                BUSY : BOOLEAN := FALSE ;
+           BEGIN
+ 
+                NULL;
+ 
+           END  T_TYPE ;
+ 
+ 
+      BEGIN
+ 
+ 
+           FOR  I  IN  1..5  LOOP
+                EXIT WHEN  T_OBJECT1'TERMINATED ;
+                DELAY 10.0 * Impdef.One_Second;
+           END LOOP;
+ 
+ 
+           IF NOT  T_OBJECT1'TERMINATED  THEN
+                COMMENT( "TASK NOT YET TERMINATED (AFTER 50 S.)" );
+           END IF;
+ 
+ 
+           BEGIN
+ 
+                SELECT
+                     T_OBJECT1.E ;
+                     FAILED( "CALL WAS NOT DISOBEYED" );
+                ELSE
+                     FAILED( "'ELSE' BRANCH TAKEN INSTEAD OF TSKG_ERR" );
+                END SELECT;
+ 
+                FAILED( "EXCEPTION NOT RAISED" );
+ 
+           EXCEPTION
+ 
+                WHEN  TASKING_ERROR  =>
+                     NULL ;
+ 
+                WHEN  OTHERS  =>
+                     FAILED(  "WRONG EXCEPTION RAISED"  );
+ 
+           END ;
+ 
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C97204A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97204b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97204b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97204b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97204b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,82 ----
+ -- C97204B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT TASKING_ERROR IS RAISED IF THE CALLED TASK IS ABORTED
+ -- BEFORE THE CONDITIONAL ENTRY CALL IS EXECUTED.
+ 
+ -- WRG 7/13/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97204B IS
+ 
+ BEGIN
+ 
+      TEST ("C97204B", "CHECK THAT TASKING_ERROR IS RAISED IF THE " &
+                       "CALLED TASK IS ABORTED BEFORE THE CONDITIONAL " &
+                       "ENTRY CALL IS EXECUTED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (I : INTEGER);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (I : INTEGER);
+                FAILED ("ENTRY CALL ACCEPTED");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED");
+           END T;
+ 
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                ABORT T;
+                RETURN 1;
+           END F;
+ 
+      BEGIN
+ 
+           SELECT
+                T.E (F);
+                FAILED ("CONDITIONAL ENTRY CALL MADE");
+           ELSE
+                FAILED ("ELSE PART EXECUTED");
+           END SELECT;
+ 
+           FAILED ("EXCEPTION NOT RAISED");
+ 
+      EXCEPTION
+ 
+           WHEN TASKING_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97204B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97205a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97205a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97205a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97205a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,94 ----
+ -- C97205A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+ -- CONDITIONAL ENTRY CALL), IT IS PERFORMED.
+ 
+ -- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
+ --         STATEMENT.
+ 
+ -- WRG 7/13/86
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97205A IS
+ 
+      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+      COUNT                          : POSITIVE := 1;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C97205A", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                       "POSSIBLE (FOR A CONDITIONAL ENTRY CALL), IT " &
+                       "IS PERFORMED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (B : IN OUT BOOLEAN);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (B : IN OUT BOOLEAN) DO
+                     B := IDENT_BOOL (TRUE);
+                END E;
+           END T;
+ 
+      BEGIN
+ 
+           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+                DELAY 1.0 * Impdef.One_Second;
+ 
+                SELECT
+                     T.E (RENDEZVOUS_OCCURRED);
+                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+                ELSE
+                     IF COUNT < 60 * 60 THEN
+                          COUNT := COUNT + 1;
+                     ELSE
+                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                  "HOUR ELAPSED");
+                          EXIT;
+                     END IF;
+                END SELECT;
+           END LOOP;
+ 
+      END;
+ 
+      IF NOT RENDEZVOUS_OCCURRED THEN
+           FAILED ("RENDEZVOUS DID NOT OCCUR");
+      END IF;
+ 
+      IF COUNT > 1 THEN
+           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97205A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97205b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97205b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97205b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97205b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,98 ----
+ -- C97205B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+ -- CONDITIONAL ENTRY CALL), IT IS PERFORMED.
+ 
+ -- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
+ 
+ -- WRG 7/13/86
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97205B IS
+ 
+      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+      COUNT                          : POSITIVE := 1;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C97205B", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                       "POSSIBLE (FOR A CONDITIONAL ENTRY CALL), IT " &
+                       "IS PERFORMED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (1..3) (B : IN OUT BOOLEAN);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                SELECT
+                     ACCEPT E (2) (B : IN OUT BOOLEAN) DO
+                          B := IDENT_BOOL (TRUE);
+                     END E;
+                OR
+                     ACCEPT E (3) (B : IN OUT BOOLEAN);
+                     FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
+                END SELECT;
+           END T;
+ 
+      BEGIN
+ 
+           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+                DELAY 1.0 * Impdef.One_Second;
+ 
+                SELECT
+                     T.E (2) (RENDEZVOUS_OCCURRED);
+                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+                ELSE
+                     IF COUNT < 60 * 60 THEN
+                          COUNT := COUNT + 1;
+                     ELSE
+                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                  "HOUR ELAPSED");
+                          EXIT;
+                     END IF;
+                END SELECT;
+           END LOOP;
+ 
+      END;
+ 
+      IF NOT RENDEZVOUS_OCCURRED THEN
+           FAILED ("RENDEZVOUS DID NOT OCCUR");
+      END IF;
+ 
+      IF COUNT > 1 THEN
+           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97205B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- C97301A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
+ -- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
+ 
+ -- CASE  A:  THE TASK TO BE CALLED HAS NOT YET BEEN ACTIVATED AS OF THE
+ --           MOMENT OF CALL.
+ 
+ -- RJW 3/31/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97301A IS
+ 
+      WAIT_TIME : CONSTANT DURATION := 10.0 * Impdef.One_Second;
+      OR_BRANCH_TAKEN : INTEGER := 3;
+ 
+ BEGIN
+ 
+      TEST ("C97301A", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
+                       "CALLED TASK IS NOT ACTIVE" );
+ 
+      ------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_OR_WAIT ( AUTHORIZED : IN BOOLEAN );
+           END  T;
+ 
+           TASK BODY  T  IS
+ 
+                PACKAGE       SECOND_ATTEMPT  IS    END  SECOND_ATTEMPT;
+                PACKAGE BODY  SECOND_ATTEMPT  IS
+                     START_TIME : TIME;
+                BEGIN
+                     START_TIME := CLOCK;
+                     SELECT
+                          DO_IT_NOW_OR_WAIT (FALSE); --CALLING OWN ENTRY.
+                     OR
+                                       -- THEREFORE THIS BRANCH
+                                       --    MUST BE CHOSEN.
+                          DELAY WAIT_TIME;
+                          IF CLOCK >= (WAIT_TIME + START_TIME) THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "INSUFFICIENT DELAY (#2)" );
+                          END IF;
+                          OR_BRANCH_TAKEN := 2 * OR_BRANCH_TAKEN;
+                          COMMENT( "OR_BRANCH  TAKEN  (#2)" );
+                     END SELECT;
+                END  SECOND_ATTEMPT;
+ 
+           BEGIN
+ 
+                ACCEPT DO_IT_NOW_OR_WAIT ( AUTHORIZED : IN BOOLEAN )  DO
+ 
+                     IF  AUTHORIZED  THEN
+                          COMMENT( "AUTHORIZED ENTRY_CALL" );
+                     ELSE
+                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                     END IF;
+ 
+                END DO_IT_NOW_OR_WAIT;
+ 
+ 
+           END  T;
+ 
+ 
+           PACKAGE       FIRST_ATTEMPT  IS      END  FIRST_ATTEMPT;
+           PACKAGE BODY  FIRST_ATTEMPT  IS
+                START_TIME : TIME;
+           BEGIN
+                START_TIME := CLOCK;
+                SELECT
+                     T.DO_IT_NOW_OR_WAIT (FALSE);
+                OR
+                                       -- THIS BRANCH MUST BE CHOSEN.
+                     DELAY WAIT_TIME;
+                     IF CLOCK >= (WAIT_TIME + START_TIME) THEN
+                          NULL;
+                     ELSE
+                          FAILED ( "INSUFFICIENT DELAY (#1)" );
+                     END IF;
+                     OR_BRANCH_TAKEN := 1 + OR_BRANCH_TAKEN;
+                     COMMENT( "OR_BRANCH  TAKEN  (#1)" );
+                END SELECT;
+ 
+           END  FIRST_ATTEMPT;
+ 
+      BEGIN
+ 
+           T.DO_IT_NOW_OR_WAIT ( TRUE );   -- TO SATISFY THE SERVER'S
+                                           --     WAIT FOR SUCH A CALL.
+ 
+      EXCEPTION
+ 
+           WHEN  TASKING_ERROR  =>
+                FAILED( "TASKING ERROR" );
+ 
+      END ;
+ 
+ 
+      ------------------------------------------------------------------
+ 
+ 
+      -- BY NOW, THE TASK IS TERMINATED  (AND THE NONLOCALS UPDATED).
+ 
+ 
+      CASE  OR_BRANCH_TAKEN  IS
+ 
+           WHEN  3  =>
+                FAILED( "NO 'OR'; BOTH (?) RENDEZVOUS ATTEMPTED?" );
+ 
+           WHEN  4  =>
+                FAILED( "'OR' #1 ONLY; RENDEZVOUS (#2) ATTEMPTED?" );
+ 
+           WHEN  6  =>
+                FAILED( "'OR' #2 ONLY; RENDEZVOUS (#1) ATTEMPTED?" );
+ 
+           WHEN  7  =>
+                FAILED( "WRONG ORDER FOR 'OR':  #2,#1" );
+ 
+           WHEN  8  =>
+                NULL;
+ 
+           WHEN  OTHERS  =>
+                FAILED( "WRONG CASE_VALUE" );
+ 
+      END CASE;
+ 
+      RESULT;
+ 
+ END  C97301A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- C97301B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
+ --     AMOUNT OF TIME IF A RENDEZVOUS IS NOT POSSIBLE.
+ 
+ --     CASE  B:  THE QUEUE FOR THE CALLED ENTRY ALREADY CONTAINS
+ --           ANOTHER  TASK WHOSE RENDEZVOUS CANNOT BE COMPLETED WITHIN
+ --           THE SPECIFIED DELAY.
+ 
+ --HISTORY:
+ --     RJW 03/31/86 CREATED ORIGINAL TEST.
+ --     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97301B IS
+ 
+      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+ 
+ BEGIN
+ 
+      TEST ("C97301B", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
+                       "QUEUE FOR THE CALLED ENTRY ALREADY CONTAINS " &
+                       "ANOTHER TASK WHOSE RENDEZVOUS CANNOT BE " &
+                       "COMPLETED WITHIN THE SPECIFIED DELAY" );
+ 
+ 
+      DECLARE
+           WAIT_TIME  : DURATION :=  3.0 * Impdef.One_Second;
+ 
+           TASK T1;
+ 
+           TASK T2 IS
+                ENTRY AWAKEN_T2;
+           END T2;
+ 
+           TASK T3 IS
+                ENTRY AWAKEN_T3;
+                ENTRY RELEASE_T;
+           END T3;
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_OR_WAIT (X : INTEGER);
+           END  T;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT DO_IT_NOW_OR_WAIT (X : INTEGER) DO
+                     IF X = 1 THEN
+                          T2.AWAKEN_T2;
+                          WHILE DO_IT_NOW_OR_WAIT'COUNT = 0 LOOP
+                               DELAY 1.0 * Impdef.One_Second;
+                          END LOOP;
+                          T3.AWAKEN_T3;
+                          T3.RELEASE_T;
+                     ELSE
+                          FAILED ("WRONG TASK IN RENDEZVOUS - 1");
+                     END IF;
+                END DO_IT_NOW_OR_WAIT;
+                ACCEPT DO_IT_NOW_OR_WAIT (X : INTEGER) DO
+                     IF X /= 2 THEN
+                          FAILED ("WRONG TASK IN RENDEZVOUS - 2");
+                     END IF;
+                END DO_IT_NOW_OR_WAIT;
+           END  T;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                T.DO_IT_NOW_OR_WAIT (1);
+           END T1;
+ 
+           TASK BODY T2 IS
+           BEGIN
+                ACCEPT AWAKEN_T2;
+                T.DO_IT_NOW_OR_WAIT (2);
+           END T2;
+ 
+           TASK BODY T3 IS
+                START_TIME : TIME;
+                STOP_TIME : TIME;
+           BEGIN
+                BEGIN
+                     ACCEPT AWAKEN_T3;
+                     START_TIME := CLOCK;
+                     SELECT
+                          T.DO_IT_NOW_OR_WAIT (3);
+                     OR
+                                          -- THIS BRANCH MUST BE CHOSEN.
+                          DELAY WAIT_TIME;
+                          STOP_TIME := CLOCK;
+                          IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
+                               NULL;
+                          ELSE
+                               FAILED ( "INSUFFICIENT DELAY" );
+                          END IF;
+                          OR_BRANCH_TAKEN := TRUE;
+                          COMMENT( "OR_BRANCH TAKEN" );
+                          ACCEPT RELEASE_T;
+                     END SELECT;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          FAILED ( "TASKING ERROR" );
+                END;
+                              -- END OF BLOCK CONTAINING TIMED
+                              -- ENTRY CALL.
+ 
+                              -- BY NOW, THE TASK T IS EFFECTIVELY
+                              -- TERMINATED (AND THE NONLOCALS UPDATED).
+ 
+                IF OR_BRANCH_TAKEN THEN
+                     NULL;
+                ELSE
+                     FAILED( "RENDEZVOUS ATTEMPTED" );
+                END IF;
+           END T3;
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END C97301B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,101 ----
+ -- C97301C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED 
+ -- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
+ 
+ -- CASE  C:  AN ACCEPT STATEMENT FOR THE CALLED ENTRY HAS NOT BEEN
+ --           REACHED.
+ 
+ -- RJW 3/31/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97301C IS
+      
+      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+      
+ BEGIN
+ 
+      TEST ("C97301C", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN AN " &
+                       "ACCEPT STATEMENT FOR THE CALLED ENTRY HAS " &
+                       "NOT BEEN REACHED" );
+ 
+ 
+      DECLARE
+           START_TIME : TIME;
+           STOP_TIME : TIME;
+           WAIT_TIME  : DURATION :=  3.0 * Impdef.One_Second;
+ 
+           TASK  T  IS
+                ENTRY NO_SPIN;
+                ENTRY DO_IT_NOW_OR_WAIT;
+           END  T;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT NO_SPIN;
+                ACCEPT DO_IT_NOW_OR_WAIT;
+           END  T;
+ 
+      BEGIN
+           START_TIME := CLOCK;
+           SELECT
+                T.DO_IT_NOW_OR_WAIT;
+                FAILED("RENDEZVOUS OCCURRED");
+                ABORT T;
+           OR
+                                       -- THIS BRANCH MUST BE CHOSEN.
+                DELAY WAIT_TIME;
+                STOP_TIME := CLOCK;
+                IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INSUFFICIENT DELAY" );
+                END IF;
+                T.NO_SPIN;
+                OR_BRANCH_TAKEN := TRUE;
+                COMMENT( "OR_BRANCH TAKEN" );
+                T.DO_IT_NOW_OR_WAIT;
+           END SELECT;
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                FAILED ( "TASKING ERROR" );
+      END;
+                                      -- END OF BLOCK CONTAINING TIMED 
+                                      -- ENTRY CALL.
+ 
+      -- BY NOW, TASK T IS TERMINATED (AND THE NONLOCALS UPDATED).
+           
+      IF OR_BRANCH_TAKEN THEN
+           NULL;
+      ELSE
+           FAILED( "RENDEZVOUS ATTEMPTED" );
+      END IF;
+ 
+      RESULT;
+ 
+ END C97301C; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- C97301D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
+ -- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
+ 
+ -- CASE  D:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+ --           DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY.
+ 
+ -- RJW 3/31/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97301D IS
+ 
+      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+ 
+ BEGIN
+ 
+      TEST ("C97301D", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                       "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
+                       "BODY OF THE TASK CONTAINING THE CALLED ENTRY " &
+                       "DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR " &
+                       "THAT ENTRY" );
+ 
+      DECLARE
+           START_TIME : TIME;
+           WAIT_TIME : CONSTANT DURATION := 10.0 * Impdef.One_Second;
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_OR_WAIT;
+                ENTRY  KEEP_ALIVE;
+           END  T;
+ 
+           TASK BODY  T  IS
+           BEGIN
+ 
+                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED.
+ 
+                ACCEPT  KEEP_ALIVE;  -- TO PREVENT THIS SERVER TASK FROM
+                                      --     TERMINATING IF
+                                      --     UPON ACTIVATION
+                                      --     IT GETS TO RUN
+                                      --     AHEAD OF THE CALLER (WHICH
+                                      --     WOULD LEAD TO A SUBSEQUENT
+                                      --     TASKING_ERROR AT THE TIME
+                                      --     OF THE NO-WAIT CALL).
+ 
+           END;
+ 
+      BEGIN
+           START_TIME := CLOCK;
+           SELECT
+                T.DO_IT_NOW_OR_WAIT;
+           OR
+                             --  THIS BRANCH MUST BE CHOSEN.
+                DELAY WAIT_TIME;
+                IF CLOCK >= (WAIT_TIME + START_TIME) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INSUFFICIENT WAITING TIME" );
+                END IF;
+                OR_BRANCH_TAKEN := TRUE;
+                COMMENT( "OR_BRANCH  TAKEN" );
+           END SELECT;
+ 
+           T.KEEP_ALIVE;
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                FAILED ( "TASKING ERROR RAISED" );
+ 
+      END;   -- END OF BLOCK CONTAINING THE ENTRY CALL.
+ 
+      -- BY NOW, THE TASK IS TERMINATED.
+ 
+      IF  OR_BRANCH_TAKEN  THEN
+           NULL;
+      ELSE
+           FAILED( "RENDEZVOUS ATTEMPTED?" );
+      END IF;
+ 
+      RESULT;
+ 
+ END  C97301D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301e.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301e.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97301e.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97301e.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- C97301E.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED 
+ -- AMOUNT OF TIME IF A RENDEZVOUS IS NOT POSSIBLE.
+ 
+ -- CASE  E:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+ --           DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
+ --           (THE ENTRY BELONGS TO AN ENTRY FAMILY; SOME FAMILY MEMBERS
+ --           ARE "ACCEPTABLE", BUT NOT THE CALLED ONE.)
+ 
+ -- RJW 3/31/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97301E IS
+      
+      OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+      
+ BEGIN
+ 
+      TEST ("C97301E", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                       "LEAST THE SPECIFIED AMOUNT OF TIME " &
+                       "IN THE ABSENCE OF A CORRESPONDING " &
+                       "ACCEPT_STATEMENT " );
+ 
+      DECLARE
+           
+           WAIT_TIME : DURATION :=  3.0 * Impdef.One_Second;
+           
+           START_TIME : TIME;
+          
+           STOP_TIME : TIME;
+ 
+           SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
+ 
+           KEEP_ALIVE  :  INTEGER  := 15 ;
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_OR_WAIT ( SHORT ) ;
+           END  T ;
+           
+           TASK BODY  T  IS
+           BEGIN
+ 
+                -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED.
+                ACCEPT  DO_IT_NOW_OR_WAIT ( IDENT_INT(15) );
+ 
+                                      -- THIS ALSO PREVENTS THIS SERVER
+                                      --     TASK FROM TERMINATING IF
+                                      --     UPON ACTIVATION
+                                      --     IT GETS TO RUN    
+                                      --     AHEAD OF THE CALLER (WHICH
+                                      --     WOULD LEAD TO A SUBSEQUENT
+                                      --     TASKING_ERROR AT THE TIME 
+                                      --     OF THE NO-WAIT CALL).
+ 
+           END ;
+ 
+ 
+      BEGIN
+           START_TIME := CLOCK;
+           SELECT
+                T.DO_IT_NOW_OR_WAIT (10) ;  -- ACCEPT_STATEMENT HAS 15.
+           OR              
+                             --   THEREFORE THIS BRANCH MUST BE CHOSEN.
+                DELAY WAIT_TIME;
+                STOP_TIME := CLOCK;
+                IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INSUFFICIENT DELAY" );
+                END IF;
+                OR_BRANCH_TAKEN := TRUE ;
+                COMMENT( "OR_BRANCH TAKEN" );
+           END SELECT;
+ 
+           T.DO_IT_NOW_OR_WAIT (KEEP_ALIVE) ;
+ 
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                FAILED ( "TASKING ERROR" );
+ 
+      END;   -- END OF BLOCK CONTAINING THE TIMED ENTRY CALL.
+ 
+      -- BY NOW, TASK T IS TERMINATED.
+ 
+      IF  OR_BRANCH_TAKEN  THEN
+           NULL ;
+      ELSE
+           FAILED( "RENDEZVOUS ATTEMPTED" );
+      END IF;
+ 
+      RESULT;
+ 
+ END  C97301E ; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97302a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97302a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97302a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- C97302A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHENEVER AN INDEX IS PRESENT IN A TIMED_ENTRY_CALL, IT
+ -- IS EVALUATED BEFORE ANY PARAMETER ASSOCIATIONS ARE EVALUATED, AND 
+ -- PARAMETER ASSOCIATIONS ARE EVALUATED BEFORE THE DELAY EXPRESSION.
+ -- THEN A RENDEZVOUS IS ATTEMPTED.
+ 
+ -- RJW 3/31/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH CALENDAR; USE CALENDAR;
+ PROCEDURE C97302A IS
+      
+      INDEX_COMPUTED  :  BOOLEAN  :=  FALSE;
+      PARAM_COMPUTED  :  BOOLEAN  :=  FALSE;     
+      DELAY_COMPUTED  :  BOOLEAN  :=  FALSE;
+ BEGIN
+ 
+      TEST ("C97302A", "CHECK THAT WHENEVER AN INDEX IS PRESENT IN " &
+                       "A TIMED_ENTRY_CALL, IT IS EVALUATED BEFORE " &
+                       "ANY PARAMETER ASSOCIATIONS ARE EVALUATED, " &
+                       "AND PARAMETER ASSOCIATIONS ARE EVALUATED " & 
+                       "BEFORE THE DELAY EXPRESSION" );
+      DECLARE
+ 
+           WAIT_TIME : DURATION := 3.0 * Impdef.One_Second;
+           
+           TYPE SHORT IS RANGE 10 .. 20;
+ 
+           TASK  T  IS
+                ENTRY  DO_IT_NOW_OR_WAIT
+                                       ( SHORT )
+                                       ( DID_YOU_DO_IT : IN BOOLEAN );
+                ENTRY  KEEP_ALIVE;
+           END  T;
+ 
+           TASK BODY  T  IS
+           BEGIN
+                ACCEPT  KEEP_ALIVE;
+           END  T;
+ 
+           FUNCTION  F1 (X : SHORT) RETURN SHORT IS
+           BEGIN
+                INDEX_COMPUTED  :=  TRUE;
+                RETURN (15);
+           END  F1;
+ 
+           FUNCTION  F2 RETURN BOOLEAN  IS
+           BEGIN
+                IF INDEX_COMPUTED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INDEX NOT EVALUATED FIRST" );
+                END IF;
+                PARAM_COMPUTED  :=  TRUE;
+                RETURN (FALSE);
+           END  F2;
+ 
+           FUNCTION F3 RETURN DURATION IS
+           BEGIN
+                IF PARAM_COMPUTED THEN
+                     NULL;
+                ELSE
+                     FAILED ( "PARAMETERS NOT EVALUATED BEFORE DELAY " &
+                              "EXPRESSION" );
+                END IF;
+                DELAY_COMPUTED := TRUE;
+                RETURN (WAIT_TIME);
+           END;
+      BEGIN
+ 
+           SELECT
+                T.DO_IT_NOW_OR_WAIT
+                                       ( F1 (15) )
+                                       ( NOT F2 );
+                FAILED ("RENDEZVOUS OCCURRED");
+           OR
+                DELAY F3;          
+           END SELECT;
+ 
+           T.KEEP_ALIVE;
+ 
+      END;   -- END OF BLOCK CONTAINING THE ENTRY CALLS.
+ 
+      IF  DELAY_COMPUTED  THEN
+           NULL;
+      ELSE
+           FAILED( "DELAY EXPRESSION NOT EVALUATED" );
+      END IF;
+ 
+      RESULT;
+ 
+ END  C97302A; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97303a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97303a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97303a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97303a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C97303A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+ --     SELECTIVE_WAIT  CANNOT.
+ 
+ -- PART 1: PACKAGE BODY EMBEDDED IN TASK BODY.
+ 
+ 
+ -- RM 4/06/1982
+ 
+ with Impdef;
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE  C97303A  IS
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST ( "C97303A" , "CHECK THAT A  TIMED_ENTRY_CALL  CAN" &
+                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  TT  IS
+                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+           END  TT ;
+ 
+ 
+           TASK BODY  TT  IS
+ 
+                PACKAGE  WITHIN_TASK_BODY  IS
+                     -- NOTHING HERE
+                END  WITHIN_TASK_BODY ;
+ 
+ 
+                PACKAGE BODY  WITHIN_TASK_BODY  IS
+                BEGIN
+ 
+                     SELECT  -- NOT A SELECTIVE_WAIT
+                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                     OR
+                          DELAY 1.0 * Impdef.One_Second;
+                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                     END SELECT;
+                     
+                END  WITHIN_TASK_BODY ;
+ 
+ 
+           BEGIN
+ 
+                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+ 
+                     IF  AUTHORIZED  THEN
+                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                     ELSE
+                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                     END IF;
+ 
+                END  A ;
+    
+           END  TT ;
+ 
+ 
+           PACKAGE  OUTSIDE_TASK_BODY  IS
+                -- NOTHING HERE
+           END  OUTSIDE_TASK_BODY ;
+ 
+ 
+           PACKAGE BODY  OUTSIDE_TASK_BODY  IS
+           BEGIN
+ 
+                SELECT  -- NOT A SELECTIVE_WAIT
+                     TT.A ( FALSE ) ;  -- UNBORN
+                OR 
+                     DELAY  2.0 * Impdef.One_Second;
+                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+                END SELECT;
+ 
+           END  OUTSIDE_TASK_BODY ;
+ 
+ 
+      BEGIN
+ 
+           TT.A ( TRUE );
+ 
+      EXCEPTION
+ 
+           WHEN  TASKING_ERROR  =>
+                FAILED( "TASKING ERROR" );
+ 
+      END  ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      RESULT ;
+ 
+ 
+ END  C97303A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97303b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97303b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97303b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97303b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- C97303B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+ --     SELECTIVE_WAIT  CANNOT.
+ 
+ -- PART 2: PROCEDURE BODY EMBEDDED IN TASK BODY.
+ 
+ 
+ -- RM 4/12/1982
+ 
+ with Impdef;
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE  C97303B  IS
+ 
+ 
+ BEGIN
+ 
+ 
+      TEST ( "C97303B" , "CHECK THAT A  TIMED_ENTRY_CALL  CAN" &
+                         " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      DECLARE
+ 
+ 
+           TASK  TT  IS
+                ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+           END  TT ;
+ 
+ 
+           TASK BODY  TT  IS
+ 
+ 
+                PROCEDURE  WITHIN_TASK_BODY ;
+ 
+ 
+                PROCEDURE  WITHIN_TASK_BODY  IS
+                BEGIN
+ 
+                     SELECT  -- NOT A SELECTIVE_WAIT
+                          A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                     OR
+                          DELAY 1.0 * Impdef.One_Second;
+                          COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                     END SELECT;
+                     
+                END  WITHIN_TASK_BODY ;
+ 
+ 
+           BEGIN
+ 
+ 
+                -- CALL THE INNER PROC. TO FORCE EXEC. OF TIMED_E_CALL
+                WITHIN_TASK_BODY ;
+ 
+ 
+                ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+ 
+                     IF  AUTHORIZED  THEN
+                          COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                     ELSE
+                          FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                     END IF;
+ 
+                END  A ;
+ 
+           END  TT ;
+ 
+ 
+           PROCEDURE  OUTSIDE_TASK_BODY  IS
+           BEGIN
+ 
+                SELECT  -- NOT A SELECTIVE_WAIT
+                     TT.A ( FALSE ) ;  -- UNBORN
+                OR   
+                     DELAY 1.0 * Impdef.One_Second;
+                     COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+                END SELECT;
+ 
+           END  OUTSIDE_TASK_BODY ;
+ 
+ 
+           PACKAGE       CREATE_OPPORTUNITY_TO_CALL           IS END;   
+           PACKAGE BODY  CREATE_OPPORTUNITY_TO_CALL  IS
+           BEGIN
+                -- CALL THE OTHER PROC. TO FORCE EXEC. OF TIMED_E_CALL
+                OUTSIDE_TASK_BODY ;
+           END  CREATE_OPPORTUNITY_TO_CALL ;
+ 
+ 
+      BEGIN
+ 
+           TT.A ( TRUE );
+ 
+      EXCEPTION
+ 
+           WHEN  TASKING_ERROR  =>
+                FAILED( "TASKING ERROR" );
+ 
+      END  ;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT ;
+ 
+ 
+ END  C97303B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97303c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97303c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97303c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97303c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- C97303C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED ENTRY CALL CAN APPEAR IN PLACES WHERE A SELECTIVE
+ -- WAIT IS NOT ALLOWED.
+ 
+ -- PART 3: TASK BODY NESTED WITHIN A TASK.
+ 
+ -- WRG 7/15/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97303C IS
+ 
+ BEGIN
+ 
+      TEST ("C97303C", "CHECK THAT A TIMED ENTRY CALL CAN " &
+                       "APPEAR IN PLACES WHERE A SELECTIVE WAIT " &
+                       "IS NOT ALLOWED; CASE: TASK BODY NESTED " &
+                       "WITHIN A TASK");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E;
+                ENTRY SYNCH;
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT SYNCH;
+                ACCEPT SYNCH;
+                ACCEPT SYNCH;
+                ACCEPT E;
+           END T;
+ 
+           TASK OUTER IS
+                ENTRY E;
+                ENTRY SYNCH;
+           END OUTER;
+ 
+           TASK BODY OUTER IS
+ 
+                TASK TYPE INNER;
+ 
+                INNER1 : INNER;
+ 
+                TASK BODY INNER IS
+                BEGIN
+                     SELECT
+                          T.E;
+                          FAILED ("TIMED ENTRY CALL ACCEPTED - " &
+                                  "INNER (1)");
+                     OR
+                          DELAY 1.0 * Impdef.One_Second;
+                          T.SYNCH;
+                     END SELECT;
+ 
+                     SELECT
+                          OUTER.E;
+                          FAILED ("TIMED ENTRY CALL ACCEPTED - " &
+                                  "INNER (2)");
+                     OR
+                          DELAY 1.0 * Impdef.One_Second;
+                          OUTER.SYNCH;
+                     END SELECT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED - INNER");
+                END INNER;
+ 
+                PACKAGE DUMMY IS
+                     TYPE ACC_INNER IS ACCESS INNER;
+                     INNER2 : ACC_INNER := NEW INNER;
+                END DUMMY;
+ 
+           BEGIN
+ 
+                SELECT
+                     T.E;
+                     FAILED ("TIMED ENTRY CALL ACCEPTED - OUTER");
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                     T.SYNCH;
+                END SELECT;
+ 
+                ACCEPT SYNCH;
+                ACCEPT SYNCH;
+                ACCEPT E;
+ 
+           EXCEPTION
+ 
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - OUTER");
+ 
+           END OUTER;
+ 
+      BEGIN
+ 
+           T.E;
+           OUTER.E;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97303C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97304a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97304a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97304a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,123 ----
+ -- C97304A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL BE RAISED IF THE CALLED
+ --     TASK HAS ALREADY COMPLETED ITS EXECUTION AT THE TIME OF THE
+ --     TIMED_ENTRY_CALL.
+ 
+ 
+ -- RM 5/28/82
+ -- SPS 11/21/82
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE  C97304A  IS
+ 
+      -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
+ 
+ BEGIN
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      TEST ("C97304A", "CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL" &
+                       " BE RAISED IF THE CALLED TASK HAS ALREADY"     &
+                       " COMPLETED ITS EXECUTION AT THE TIME OF THE"   &
+                       " TIMED_ENTRY_CALL"                       );
+ 
+   
+      DECLARE
+ 
+ 
+           TASK TYPE  T_TYPE  IS
+ 
+ 
+                ENTRY  E ;
+ 
+           END  T_TYPE ;
+ 
+ 
+           T_OBJECT1 : T_TYPE ;
+ 
+ 
+           TASK BODY  T_TYPE  IS
+                BUSY : BOOLEAN := FALSE ;
+           BEGIN
+ 
+                NULL;
+ 
+           END  T_TYPE ;
+ 
+ 
+      BEGIN
+ 
+ 
+           FOR  I  IN  1..5  LOOP
+                EXIT WHEN  T_OBJECT1'TERMINATED ;
+                DELAY 10.0 * Impdef.One_Second;
+           END LOOP;
+ 
+ 
+           IF NOT  T_OBJECT1'TERMINATED  THEN
+                COMMENT( "TASK NOT YET TERMINATED (AFTER 50 S.)" );
+           END IF;
+ 
+ 
+           BEGIN
+ 
+                SELECT
+                     T_OBJECT1.E ;
+                     FAILED( "CALL WAS NOT DISOBEYED" );
+                OR
+                     DELAY 1.0 * Impdef.One_Second;
+                     FAILED( "'OR' BRANCH TAKEN INSTEAD OF TSKG_ERROR" );
+                END SELECT;
+ 
+                FAILED( "EXCEPTION NOT RAISED" );
+ 
+           EXCEPTION
+ 
+                WHEN  TASKING_ERROR  =>
+                     NULL ;
+ 
+                WHEN  OTHERS  =>
+                     FAILED(  "WRONG EXCEPTION RAISED"  );
+ 
+           END ;
+ 
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C97304A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97304b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97304b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97304b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97304b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- C97304B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT TASKING_ERROR IS RAISED IF THE CALLED TASK IS ABORTED
+ -- BEFORE THE TIMED ENTRY CALL IS EXECUTED.
+ 
+ -- WRG 7/13/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97304B IS
+ 
+ BEGIN
+ 
+      TEST ("C97304B", "CHECK THAT TASKING_ERROR IS RAISED IF THE " &
+                       "CALLED TASK IS ABORTED BEFORE THE TIMED " &
+                       "ENTRY CALL IS EXECUTED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (I : INTEGER);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (I : INTEGER);
+                FAILED ("ENTRY CALL ACCEPTED");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED");
+           END T;
+ 
+           FUNCTION F RETURN INTEGER IS
+           BEGIN
+                ABORT T;
+                RETURN 1;
+           END F;
+ 
+      BEGIN
+ 
+           SELECT
+                T.E (F);
+                FAILED ("TIMED ENTRY CALL MADE");
+           OR
+                DELAY 1.0 * Impdef.One_Second;
+                FAILED ("DELAY ALTERNATIVE TAKEN");
+           END SELECT;
+ 
+           FAILED ("EXCEPTION NOT RAISED");
+ 
+      EXCEPTION
+ 
+           WHEN TASKING_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97304B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,100 ----
+ -- C97305A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+ -- TIMED ENTRY CALL), IT IS PERFORMED.
+ 
+ -- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
+ --         STATEMENT.
+ 
+ -- WRG 7/13/86
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97305A IS
+ 
+      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+      COUNT                          : POSITIVE := 1;
+      ZERO                           : DURATION := 1.0;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C97305A", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                       "POSSIBLE (FOR A TIMED ENTRY CALL), IT " &
+                       "IS PERFORMED");
+ 
+      IF EQUAL (3, 3) THEN
+           ZERO := 0.0;
+      END IF;
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (B : IN OUT BOOLEAN);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT E (B : IN OUT BOOLEAN) DO
+                     B := IDENT_BOOL (TRUE);
+                END E;
+           END T;
+ 
+      BEGIN
+ 
+           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+                DELAY 1.0 * Impdef.One_Second;
+ 
+                SELECT
+                     T.E (RENDEZVOUS_OCCURRED);
+                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+                OR
+                     DELAY ZERO;
+                     IF COUNT < 60 * 60 THEN
+                          COUNT := COUNT + 1;
+                     ELSE
+                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                  "HOUR ELAPSED");
+                          EXIT;
+                     END IF;
+                END SELECT;
+           END LOOP;
+ 
+      END;
+ 
+      IF NOT RENDEZVOUS_OCCURRED THEN
+           FAILED ("RENDEZVOUS DID NOT OCCUR");
+      END IF;
+ 
+      IF COUNT > 1 THEN
+           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97305A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- C97305B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+ -- TIMED ENTRY CALL), IT IS PERFORMED.
+ 
+ -- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
+ 
+ -- WRG 7/13/86
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97305B IS
+ 
+      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+      COUNT                          : POSITIVE := 1;
+      ZERO                           : DURATION := 1.0;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C97305B", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                       "POSSIBLE (FOR A TIMED ENTRY CALL), IT " &
+                       "IS PERFORMED");
+ 
+      IF EQUAL (3, 3) THEN
+           ZERO := 0.0;
+      END IF;
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (1..3) (B : IN OUT BOOLEAN);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                SELECT
+                     ACCEPT E (2) (B : IN OUT BOOLEAN) DO
+                          B := IDENT_BOOL (TRUE);
+                     END E;
+                OR
+                     ACCEPT E (3) (B : IN OUT BOOLEAN);
+                     FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
+                END SELECT;
+           END T;
+ 
+      BEGIN
+ 
+           WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+                DELAY 1.0 * Impdef.One_Second;
+ 
+                SELECT
+                     T.E (2) (RENDEZVOUS_OCCURRED);
+                     STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+                OR
+                     DELAY ZERO;
+                     IF COUNT < 60 * 60 THEN
+                          COUNT := COUNT + 1;
+                     ELSE
+                          FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                  "HOUR ELAPSED");
+                          EXIT;
+                     END IF;
+                END SELECT;
+           END LOOP;
+ 
+      END;
+ 
+      IF NOT RENDEZVOUS_OCCURRED THEN
+           FAILED ("RENDEZVOUS DID NOT OCCUR");
+      END IF;
+ 
+      IF COUNT > 1 THEN
+           COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97305B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- C97305C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE RENDEZVOUS IS NOT IMMEDIATELY POSSIBLE BUT BECOMES
+ -- POSSIBLE BEFORE THE DELAY EXPIRES, THE TIMED ENTRY CALL IS ACCEPTED.
+ 
+ -- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
+ --         STATEMENT.
+ 
+ -- WRG 7/13/86
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97305C IS
+ 
+      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+      DELAY_IN_MINUTES               : CONSTANT POSITIVE := 30;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C97305C", "CHECK THAT IF THE RENDEZVOUS IS NOT " &
+                       "IMMEDIATELY POSSIBLE BUT BECOMES POSSIBLE " &
+                       "BEFORE THE DELAY EXPIRES, THE TIMED ENTRY " &
+                       "CALL IS ACCEPTED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (B : IN OUT BOOLEAN);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                DELAY 10.0 * Impdef.One_Long_Second;
+                ACCEPT E (B : IN OUT BOOLEAN) DO
+                     B := IDENT_BOOL (TRUE);
+                END E;
+           END T;
+ 
+      BEGIN
+ 
+           SELECT
+                T.E (RENDEZVOUS_OCCURRED);
+                STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+           OR
+                DELAY DELAY_IN_MINUTES * 60.0 * Impdef.One_Long_Second;
+                FAILED ("TIMED ENTRY CALL NOT ACCEPTED AFTER" &
+                        POSITIVE'IMAGE(DELAY_IN_MINUTES) &
+                        " MINUTES ELAPSED");
+ 
+           END SELECT;
+ 
+      END;
+ 
+      IF NOT RENDEZVOUS_OCCURRED THEN
+           FAILED ("RENDEZVOUS DID NOT OCCUR");
+      END IF;
+ 
+      IF NOT STATEMENTS_AFTER_CALL_EXECUTED THEN
+           FAILED ("STATEMENTS AFTER ENTRY CALL NOT EXECUTED");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97305C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97305d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97305d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C97305D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF THE RENDEZVOUS IS NOT IMMEDIATELY POSSIBLE BUT BECOMES
+ -- POSSIBLE BEFORE THE DELAY EXPIRES, THE TIMED ENTRY CALL IS ACCEPTED.
+ 
+ -- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
+ 
+ -- WRG 7/13/86
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE C97305D IS
+ 
+      RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+      STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+      DELAY_IN_MINUTES               : CONSTANT POSITIVE := 30;
+ 
+ 
+ BEGIN
+ 
+      TEST ("C97305D", "CHECK THAT IF THE RENDEZVOUS IS NOT " &
+                       "IMMEDIATELY POSSIBLE BUT BECOMES POSSIBLE " &
+                       "BEFORE THE DELAY EXPIRES, THE TIMED ENTRY " &
+                       "CALL IS ACCEPTED");
+ 
+      DECLARE
+ 
+           TASK T IS
+                ENTRY E (1..3) (B : IN OUT BOOLEAN);
+           END T;
+ 
+           TASK BODY T IS
+           BEGIN
+                DELAY 10.0 * Impdef.One_Second;
+ 
+                SELECT
+                     ACCEPT E (2) (B : IN OUT BOOLEAN) DO
+                          B := IDENT_BOOL (TRUE);
+                     END E;
+                OR
+                     ACCEPT E (3) (B : IN OUT BOOLEAN);
+                     FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
+                END SELECT;
+           END T;
+ 
+      BEGIN
+ 
+           SELECT
+                T.E (2) (RENDEZVOUS_OCCURRED);
+                STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+           OR
+                DELAY DELAY_IN_MINUTES * 60.0 * Impdef.One_Second;
+                FAILED ("TIMED ENTRY CALL NOT ACCEPTED AFTER" &
+                        POSITIVE'IMAGE(DELAY_IN_MINUTES) &
+                        " MINUTES ELAPSED");
+ 
+           END SELECT;
+ 
+      END;
+ 
+      IF NOT RENDEZVOUS_OCCURRED THEN
+           FAILED ("RENDEZVOUS DID NOT OCCUR");
+      END IF;
+ 
+      IF NOT STATEMENTS_AFTER_CALL_EXECUTED THEN
+           FAILED ("STATEMENTS AFTER ENTRY CALL NOT EXECUTED");
+      END IF;
+ 
+      RESULT;
+ 
+ END C97305D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97307a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97307a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c97307a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c97307a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,209 ----
+ -- C97307A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS
+ -- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY.
+ 
+ -- WRG 7/14/86
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C97307A IS
+ 
+ BEGIN
+ 
+      TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " &
+                       "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " &
+                       "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " &
+                       "ENTRY");
+ 
+      DECLARE
+ 
+           DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second;
+ 
+           TASK EXPIRED IS
+                ENTRY INCREMENT;
+                ENTRY READ (COUNT : OUT NATURAL);
+           END EXPIRED;
+ 
+           TASK TYPE NON_TIMED_CALLER IS
+                ENTRY NAME (N : NATURAL);
+           END NON_TIMED_CALLER;
+ 
+           TASK TYPE TIMED_CALLER IS
+                ENTRY NAME (N : NATURAL);
+           END TIMED_CALLER;
+ 
+           CALLER1 : TIMED_CALLER;
+           CALLER2 : NON_TIMED_CALLER;
+           CALLER3 : TIMED_CALLER;
+           CALLER4 : NON_TIMED_CALLER;
+           CALLER5 : TIMED_CALLER;
+ 
+           TASK T IS
+                ENTRY E (NAME : NATURAL);
+           END T;
+ 
+           TASK DISPATCH IS
+                ENTRY READY;
+           END DISPATCH;
+ 
+           --------------------------------------------------
+ 
+           TASK BODY EXPIRED IS
+                EXPIRED_CALLS : NATURAL := 0;
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT INCREMENT DO
+                               EXPIRED_CALLS := EXPIRED_CALLS + 1;
+                          END INCREMENT;
+                     OR
+                          ACCEPT READ (COUNT : OUT NATURAL) DO
+                               COUNT := EXPIRED_CALLS;
+                          END READ;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END EXPIRED;
+ 
+           --------------------------------------------------
+ 
+           TASK BODY NON_TIMED_CALLER IS
+                MY_NAME : NATURAL;
+           BEGIN
+                ACCEPT NAME (N : NATURAL) DO
+                     MY_NAME := N;
+                END NAME;
+ 
+                T.E (MY_NAME);
+           END NON_TIMED_CALLER;
+ 
+           --------------------------------------------------
+ 
+           TASK BODY TIMED_CALLER IS
+                MY_NAME : NATURAL;
+           BEGIN
+                ACCEPT NAME (N : NATURAL) DO
+                     MY_NAME := N;
+                END NAME;
+ 
+                SELECT
+                     T.E (MY_NAME);
+                     FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" &
+                             NATURAL'IMAGE(MY_NAME));
+                OR
+                     DELAY DELAY_TIME;
+                     EXPIRED.INCREMENT;
+                END SELECT;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " &
+                             "CALLER" & NATURAL'IMAGE(MY_NAME));
+           END TIMED_CALLER;
+ 
+           --------------------------------------------------
+ 
+           TASK BODY DISPATCH IS
+           BEGIN
+                CALLER1.NAME (1);
+                ACCEPT READY;
+ 
+                CALLER2.NAME (2);
+                ACCEPT READY;
+ 
+                CALLER3.NAME (3);
+                ACCEPT READY;
+ 
+                CALLER4.NAME (4);
+                ACCEPT READY;
+ 
+                CALLER5.NAME (5);
+           END DISPATCH;
+ 
+           --------------------------------------------------
+ 
+           TASK BODY T IS
+ 
+                DESIRED_QUEUE_LENGTH : NATURAL := 1;
+                EXPIRED_CALLS        : NATURAL;
+ 
+                ACCEPTED             : ARRAY (1..5) OF NATURAL RANGE 0..5
+                                          := (OTHERS => 0);
+                ACCEPTED_INDEX       : NATURAL := 0;
+ 
+           BEGIN
+                LOOP
+                     LOOP
+                          EXPIRED.READ (EXPIRED_CALLS);
+                     EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH -
+                                          EXPIRED_CALLS;
+                          DELAY 2.0 * Impdef.One_Long_Second;
+                     END LOOP;
+                EXIT WHEN DESIRED_QUEUE_LENGTH = 5;
+                     DISPATCH.READY;
+                     DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1;
+                END LOOP;
+ 
+                -- AT THIS POINT, FIVE TASKS WERE QUEUED.
+                -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1,
+                -- CALLER3, AND CALLER5 EXPIRE:
+ 
+                DELAY DELAY_TIME + 10.0 * Impdef.One_Long_Second;
+ 
+                -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE
+                -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E,
+                -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST.
+ 
+                WHILE E'COUNT > 0 LOOP
+                     ACCEPT E (NAME : NATURAL) DO
+                          ACCEPTED_INDEX := ACCEPTED_INDEX + 1;
+                          ACCEPTED (ACCEPTED_INDEX) := NAME;
+                     END E;
+                END LOOP;
+ 
+                IF ACCEPTED /= (2, 4, 0, 0, 0) THEN
+                     FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " &
+                             "QUEUE");
+                     COMMENT ("ORDER ACCEPTED WAS:" &
+                              NATURAL'IMAGE (ACCEPTED (1))  & ',' &
+                              NATURAL'IMAGE (ACCEPTED (2))  & ',' &
+                              NATURAL'IMAGE (ACCEPTED (3))  & ',' &
+                              NATURAL'IMAGE (ACCEPTED (4))  & ',' &
+                              NATURAL'IMAGE (ACCEPTED (5)) );
+                END IF;
+           END T;
+ 
+           --------------------------------------------------
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C97307A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- C974001.A
+ --
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement
+ --      is aborted if it does not complete before the triggering statement
+ --      completes, where the triggering statement is a delay_relative
+ --      statement and check that the sequence of statements of the triggering 
+ --      alternative is executed after the abortable part is left.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a task with an accept statement containing an asynchronous
+ --      select with a delay_relative triggering statement. Parameterize
+ --      the accept statement with the time to be used in the delay. Simulate a
+ --      time-consuming calculation by declaring a procedure containing an
+ --      infinite loop. Call this procedure in the abortable part.
+ --
+ --      The delay will expire before the abortable part completes, at which
+ --      time the abortable part is aborted, and the sequence of statements
+ --      following the triggering statement is executed.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C974001 is
+ 
+ 
+           --========================================================--
+ 
+    -- Medium length delay
+    Allotted_Time : constant Duration :=  ImpDef.Switch_To_New_Task;
+ 
+    Calculation_Canceled : exception;
+ 
+ 
+    Count : Integer := 1234;                          
+                                                     
+    procedure Lengthy_Calculation is
+    begin
+       -- Simulate a non-converging calculation.
+       loop                                           -- Infinite loop.
+          Count := (Count + 1) mod 10;
+          delay ImpDef.Minimum_Task_Switch;           -- allow other task 
+       end loop;
+    end Lengthy_Calculation;
+ 
+ 
+           --========================================================--
+ 
+ 
+    task type Timed_Calculation is
+       entry Calculation (Time_Limit : in Duration);
+    end Timed_Calculation;
+ 
+ 
+    task body Timed_Calculation is
+    --
+    begin
+       loop
+          select
+             accept Calculation (Time_Limit : in Duration) do
+ 
+                --                                    --
+                -- Asynchronous select is tested here --
+                --                                    --
+ 
+                select
+                   delay Time_Limit;           -- Time_Limit is not up yet, so
+                                               -- Lengthy_Calculation starts.
+ 
+                   raise Calculation_Canceled; -- This is executed after
+                                               -- Lengthy_Calculation aborted.
+                then abort
+                   Lengthy_Calculation;        -- Delay expires before complete,
+                                               -- so this call is aborted.
+ 
+                   -- Check that the whole of the abortable part is aborted,
+                   -- not just the statement in the abortable part that was
+                   -- executing at the time
+                   Report.Failed ("Abortable part not aborted");
+ 
+                end select;
+ 
+                Report.Failed ("Triggering alternative sequence of " &
+                               "statements not executed");
+ 
+             exception    -- New Ada 9x: handler within accept
+                when Calculation_Canceled =>
+                   if Count = 1234 then
+                      Report.Failed ("Abortable part did not execute");
+                   end if;
+             end Calculation;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in Timed_Calculation task");
+    end Timed_Calculation;
+ 
+ 
+           --========================================================--
+ 
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974001", "Asynchronous Select: Trigger is delay_relative" &
+                            " which completes before abortable part");
+ 
+    declare
+       Timed : Timed_Calculation;  -- Task.
+    begin
+       Timed.Calculation (Time_Limit => Allotted_Time); -- Asynchronous select
+                                                        -- inside accept block.
+    exception
+       when Calculation_Canceled => 
+          null; -- expected behavior
+    end;
+ 
+    Report.Result;
+ 
+ end C974001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,209 ----
+ -- C974002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the sequence of statements of the triggering alternative
+ --      of an asynchronous select statement is executed if the triggering
+ --      statement is a delay_until statement, and the specified time has
+ --      already passed. Check that the abortable part is not executed after
+ --      the sequence of statements of the triggering alternative is left.
+ --
+ --      Check that the sequence of statements of the triggering alternative
+ --      of an asynchronous select statement is not executed if the abortable
+ --      part completes before the triggering statement, and the triggering
+ --      statement is a delay_until statement.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a task with an accept statement containing an asynchronous
+ --      select with a delay_until triggering statement. Parameterize
+ --      the accept statement with the time to be used in the delay. Simulate
+ --      a quick calculation by declaring a procedure which sets a Boolean
+ --      flag. Call this procedure in the abortable part.
+ --
+ --      Make two calls to the task entry: (1) with a time that has already
+ --      expired, and (2) with a time that will not expire before the quick
+ --      calculation completes.
+ --
+ --      For (1), the sequence of statements following the triggering statement
+ --      is executed, and the abortable part never starts.
+ --
+ --      For (2), the abortable part completes before the triggering statement,
+ --      the delay is canceled, and the sequence of statements following the
+ --      triggering statement never starts.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      26 Nov 95   SAIC    Bug fix for ACVC 2.0.1.
+ --
+ --!
+ 
+ with Report;
+ with Ada.Calendar;
+ with ImpDef;
+ procedure C974002 is
+ 
+    function "-" (Left: Ada.Calendar.Time; Right: Duration )
+                           return Ada.Calendar.Time renames Ada.Calendar."-";
+    function "+" (Left: Ada.Calendar.Time; Right: Duration ) 
+                           return Ada.Calendar.Time renames Ada.Calendar."+";
+    
+    Abortable_Part_Executed         : Boolean;
+    Triggering_Alternative_Executed : Boolean;
+ 
+ 
+           --========================================================--
+ 
+ 
+    procedure Quick_Calculation is
+    begin
+       if Report.Equal (1, 1) then
+          Abortable_Part_Executed := True;
+       end if;
+    end Quick_Calculation;
+ 
+ 
+           --========================================================--
+ 
+ 
+    task type Timed_Calculation_Task is
+       entry Calculation (Time_Out : in Ada.Calendar.Time);
+    end Timed_Calculation_Task;
+ 
+ 
+    task body Timed_Calculation_Task is
+    begin
+       loop
+          select
+             accept Calculation (Time_Out : in Ada.Calendar.Time) do
+ 
+                --                                    --
+                -- Asynchronous select is tested here --
+                --                                    --
+ 
+                select
+                   delay until Time_Out;                    -- Triggering 
+                                                            -- statement.
+ 
+                   Triggering_Alternative_Executed := True; -- Triggering
+                                                            -- alternative.
+                then abort
+                   Quick_Calculation;                       -- Abortable part.
+                end select;
+             end Calculation;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others =>
+          Report.Failed ("Unexpected exception in Timed_Calculation_Task");
+    end Timed_Calculation_Task;
+ 
+ 
+           --========================================================--
+ 
+ 
+    Start_Time : constant Ada.Calendar.Time := 
+                          Ada.Calendar.Time_of (1901,1,1);
+    Minute     : constant Duration          := 60.0;
+ 
+ 
+           --========================================================--
+ 
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974002", "Asynchronous Select with Delay_Until");
+   
+    -- take care of implementations that start the clock at 1/1/01 
+    delay ImpDef.Delay_For_Time_Past;
+ 
+ 
+    Abortable_Part_Executed         := False;
+    Triggering_Alternative_Executed := False;
+ 
+    NO_DELAY_SUBTEST:
+ 
+       declare
+          -- Set Expiry to a time which has already passed
+          Expiry : constant Ada.Calendar.Time := Start_Time; 
+          Timed  : Timed_Calculation_Task;
+       begin
+ 
+          -- Expiry is the time to be specified in the delay_until statement
+          -- of the asynchronous select. Since it has already passed, the
+          -- abortable part should not execute, and the sequence of statements
+          -- of the triggering alternative should be executed.
+ 
+          Timed.Calculation (Time_Out => Expiry);   -- Asynchronous select
+                                                    -- inside accept block.
+          if Abortable_Part_Executed then
+             Report.Failed ("No delay: Abortable part was executed");
+          end if;
+ 
+          if not Triggering_Alternative_Executed then
+             Report.Failed ("No delay: triggering alternative sequence " &
+                            "of statements was not executed");
+          end if;
+       end No_Delay_Subtest;
+ 
+ 
+    Abortable_Part_Executed         := False;
+    Triggering_Alternative_Executed := False;
+ 
+    LONG_DELAY_SUBTEST:
+ 
+       declare
+ 
+          -- Quick_Calculation should finish before expiry.
+          Expiry : constant Ada.Calendar.Time := 
+                                             Ada.Calendar.Clock + Minute;
+          Timed  : Timed_Calculation_Task;
+ 
+       begin
+ 
+          -- Expiry is the time to be specified in the delay_until statement
+          -- of the asynchronous select. It should not pass before the abortable
+          -- part completes, at which time control should return to the caller;
+          -- the sequence of statements of the triggering alternative should
+          -- not be executed.
+ 
+          Timed.Calculation (Time_Out => Expiry);  -- Asynchronous select.
+ 
+          if not Abortable_Part_Executed then
+             Report.Failed ("Long delay: Abortable part was not executed");
+          end if;
+ 
+          if Triggering_Alternative_Executed then
+             Report.Failed ("Long delay: triggering alternative sequence " &
+                            "of statements was executed");
+          end if;
+       end Long_Delay_Subtest;
+ 
+ 
+    Report.Result;
+ 
+ end C974002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,249 ----
+ -- C974003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement
+ --      is aborted if it does not complete before the triggering statement
+ --      completes, where the triggering statement is a task entry call, and
+ --      the entry call is queued.
+ --
+ --      Check that the sequence of statements of the triggering alternative
+ --      is executed after the abortable part is left.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a main procedure containing an asynchronous select with a task
+ --      entry call as triggering statement. Force the entry call to be
+ --      queued by having the task call a procedure, prior to the corresponding
+ --      accept statement, which simulates a routine waiting for user input
+ --      (with a delay). 
+ --
+ --      Simulate a time-consuming routine in the abortable part by calling a
+ --      procedure containing an infinite loop. Meanwhile, simulate input by
+ --      the user (the delay expires), which causes the task to execute the
+ --      accept statement corresponding to the triggering entry call.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C974003_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    -- Flags for testing purposes:
+    --
+    TC_Triggering_Statement_Completed : Boolean := False;
+    TC_Count                          : Integer := 1234;  -- Global to defeat
+                                                          -- optimization.
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+ 
+    task type ATM_Keyboard_Task is
+       entry Cancel_Pressed;
+    end ATM_Keyboard_Task;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type);
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974003_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ package body C974003_0 is
+ 
+ 
+    procedure Listen_For_Input (Key : out Key_Enum) is
+    begin
+       -- Model the situation where the user waits a bit for the card to
+       -- be validated, then presses cancel before it completes.
+ 
+       -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
+       delay ImpDef.Minimum_Task_Switch;
+ 
+       if Report.Equal (3, 3) then  -- Always true.
+          Key := Cancel;
+       end if;
+    end Listen_For_Input;
+ 
+ 
+ 
+    -- One of these gets created as "Keyboard" for each transaction
+    --
+    task body ATM_Keyboard_Task is
+       Key_Pressed : Key_Enum := None;
+    begin
+       loop
+                                                            -- Force entry calls
+          Listen_For_Input (Key_Pressed);                   -- to be queued,
+                                                            -- then set guard to
+                                                            -- true.
+          select
+             when (Key_Pressed = Cancel) =>                 -- Guard is now
+                accept Cancel_Pressed do                    -- true, so accept
+                   TC_Triggering_Statement_Completed := True;  -- queued entry
+                end Cancel_Pressed;                         -- call.
+ 
+                -- User has cancelled the transaction so we exit the
+                -- loop and allow the task to terminate
+                exit;
+          else
+             Key_Pressed := None;
+          end select;
+ 
+       end loop;
+    exception
+       when others =>
+           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+    end ATM_Keyboard_Task;
+ 
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type) is
+    begin
+       Card.Number := 9999;
+       Card.PIN    := 111;
+    end Read_Card;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       -- Simulate an exceedingly long validation activity.
+       loop                                             -- Infinite loop.
+          TC_Count := (TC_Count + 1) mod Integer (Card.PIN);
+          -- Synch. point to allow transfer of control to Keyboard
+          -- task during this simulation
+          delay ImpDef.Minimum_Task_Switch;
+          exit when not Report.Equal (TC_Count, TC_Count);    -- Always false.
+       end loop;
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Triggering alternative sequence of statements " &
+                      "not executed");
+       if not TC_Triggering_Statement_Completed then
+          Report.Failed ("Triggering statement did not complete");
+       end if;
+       if TC_Count = 1234 then
+          -- Initial value is unchanged
+          Report.Failed ("Abortable part did not execute");
+       end if;
+    end Perform_Transaction;
+ 
+ 
+ end C974003_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with C974003_0;  -- Automated teller machine abstraction.
+ use  C974003_0;
+ 
+ procedure C974003 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974003", "Asynchronous Select: Trigger is queued on a " &
+                             "task entry and completes first");
+ 
+    Read_Card (Card_Data);
+ 
+    declare
+       -- Create the task for this transaction
+       Keyboard : C974003_0.ATM_Keyboard_Task;    
+    begin
+ 
+       --                                    --
+       -- Asynchronous select is tested here --
+       --                                    --
+ 
+       select
+          Keyboard.Cancel_Pressed;      -- Entry call is initially queued, so
+                                        -- abortable part starts.
+ 
+          raise Transaction_Canceled;   -- This is executed after Validate_Card
+                                        -- is aborted.
+       then abort
+          Validate_Card (Card_Data);    -- Keyboard.Cancel_Pressed is accepted
+                                        -- and completes before this call
+                                        -- finishes; it is then aborted.
+ 
+          -- Check that the whole of the abortable part is aborted, not
+          -- just the statement in the abortable part that was executing
+          -- at the time
+          Report.Failed ("Abortable part not aborted");
+ 
+       end select;
+ 
+       Perform_Transaction (Card_Data); -- Should not be reached.
+    exception
+       when Transaction_Canceled =>
+          if not TC_Triggering_Statement_Completed then
+             Report.Failed ("Triggering alternative sequence of statements " &
+                            "executed but triggering statement not complete");
+          end if;
+          if TC_Count = 1234 then
+             -- Initial value is unchanged
+             Report.Failed ("Abortable part did not execute");
+          end if;
+    end;
+ 
+    Report.Result;
+ 
+ end C974003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,273 ----
+ -- C974004.A
+ --
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement
+ --      is aborted if it does not complete before the triggering statement
+ --      completes, where the triggering statement is a task entry call,
+ --      the entry call is queued, and the entry call completes by propagating
+ --      an exception and that the sequence of statements of the triggering 
+ --      alternative is not executed after the abortable part is left and that
+ --      the exception propagated by the entry call is re-raised immediately
+ --      following the asynchronous select.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a main procedure containing an asynchronous select with a task
+ --      entry call as triggering statement. Force the entry call to be
+ --      queued by having the task call a procedure, prior to the corresponding
+ --      accept statement, which simulates a routine waiting for user input
+ --      (with a delay). 
+ --
+ --      Simulate a time-consuming routine in the abortable part by calling a
+ --      procedure containing an infinite loop. Meanwhile, simulate input by
+ --      the user (the delay expires), which causes the task to execute the
+ --      accept statement corresponding to the triggering entry call. Raise
+ --      an exception in the accept statement which is not handled by the task,
+ --      and which is thus propagated to the caller.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C974004_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    -- Flags for testing purposes:
+ 
+    Count                          : Integer := 1234;  -- Global to defeat
+                                                       -- optimization.
+    Propagated_From_Task : exception;
+ 
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+ 
+    task type ATM_Keyboard_Task is
+       entry Cancel_Pressed;
+    end ATM_Keyboard_Task;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type);
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974004_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ package body C974004_0 is
+ 
+ 
+    procedure Listen_For_Input (Key : out Key_Enum) is
+    begin
+       -- Simulate the situation where a user waits a bit for the card to
+       -- be validated, then presses cancel before it completes.
+ 
+       -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
+       delay ImpDef.Clear_Ready_Queue;
+ 
+       if Report.Equal (3, 3) then  -- Always true.
+          Key := Cancel;
+       end if;
+    end Listen_For_Input;
+ 
+ 
+    -- One of these gets created as "Keyboard" for each transaction
+    --
+    task body ATM_Keyboard_Task is
+       Key_Pressed : Key_Enum := None;
+    begin
+       loop
+                                                -- Force entry calls to be
+          Listen_For_Input (Key_Pressed);       -- queued, then set guard to
+                                                -- true.
+          select
+             when (Key_Pressed = Cancel) =>     -- Guard is now true, so accept
+                accept Cancel_Pressed do        -- queued entry call.
+                   null;  --:::: user code for cancel
+                   -- Now simulate an unexpected exception arising in the
+                   -- user code
+                   raise Propagated_From_Task;  -- Propagate an exception.
+                   
+                end Cancel_Pressed;
+ 
+                Report.Failed 
+                           ("Exception not propagated in ATM_Keyboard_Task");
+                
+                -- User has canceled the transaction so we exit the
+                -- loop and allow the task to terminate
+                exit;
+          else
+             Key_Pressed := None;
+          end select;
+       end loop;
+    exception
+       when Propagated_From_Task =>
+           null;  -- This is the expected test behavior
+       when others =>
+           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+    end ATM_Keyboard_Task;
+ 
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type) is
+    begin
+       Card.Number := 9999;
+       Card.PIN    := 111;
+    end Read_Card;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       -- Simulate an exceedingly long validation activity.
+       loop                                             -- Infinite loop.
+          Count := (Count + 1) mod Integer (Card.PIN);
+          -- Synch. point to allow transfer of control to Keyboard
+          -- task during this simulation
+          delay ImpDef.Minimum_Task_Switch;
+          exit when not Report.Equal (Count, Count);    -- Always false.
+       end loop;
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Exception not re-raised immediately following " &
+                      "asynchronous select");
+       if Count = 1234 then
+          -- Initial value is unchanged
+          Report.Failed ("Abortable part did not execute");
+       end if;
+    end Perform_Transaction;
+ 
+ 
+ end C974004_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with C974004_0;  -- Automated teller machine abstraction.
+ use  C974004_0;
+ 
+ procedure C974004 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974004", "Asynchronous Select: Trigger is queued on a " &
+                            "task entry and is completed first by an " &
+                            "exception");
+ 
+    Read_Card (Card_Data);
+ 
+    begin
+ 
+       declare
+          -- Create the task for this transaction
+          Keyboard : C974004_0.ATM_Keyboard_Task;
+       begin
+ 
+          --                                    --
+          -- Asynchronous select is tested here --
+          --                                    --
+ 
+          select
+             Keyboard.Cancel_Pressed;     -- Entry call initially queued, so
+                                          -- abortable part starts.
+ 
+             raise Transaction_Canceled;  -- Should not be executed.
+          then abort
+             Validate_Card (Card_Data);   -- Keyboard.Cancel_Pressed is accepted
+                                          -- and propagates an exception before
+                                          -- this call finishes; it is then
+                                          -- aborted.
+ 
+             -- Check that the whole of the abortable part is aborted, not
+             -- just the statement in the abortable part that was executing
+             -- at the time
+             Report.Failed ("Abortable part not aborted");
+          end select;
+                                          -- The propagated exception is
+                                          -- re-raised here; control passes to
+                                          -- the exception handler.
+ 
+          Perform_Transaction(Card_Data); -- Should not be reached.
+       exception
+          when Transaction_Canceled =>
+             Report.Failed ("Triggering alternative sequence of statements " &
+                            "executed");
+          when Propagated_From_Task =>
+             -- This is the expected test path
+             if Count = 1234 then
+                -- Initial value is unchanged
+                Report.Failed ("Abortable part did not execute");
+             end if;
+          when Tasking_Error  =>
+             Report.Failed ("Tasking_Error raised");
+          when others  =>
+             Report.Failed ("Wrong exception raised"); 
+       end;
+ 
+    exception
+       when Propagated_From_Task =>
+          Report.Failed ("Correct exception raised at wrong level");
+       when  others  =>
+          Report.Failed ("Wrong exception raised at wrong level");
+    end;
+ 
+    Report.Result;
+ 
+ end C974004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,259 ----
+ -- C974005.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that Tasking_Error is raised at the point of an entry call
+ --      which is the triggering statement of an asynchronous select, if
+ --      the entry call is queued, but the task containing the entry completes
+ --      before it can be accepted or canceled.
+ --
+ --      Check that the abortable part is aborted if it does not complete
+ --      before the triggering statement completes.
+ --
+ --      Check that the sequence of statements of the triggering alternative
+ --      is not executed.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a main procedure containing an asynchronous select with a task
+ --      entry call as triggering statement. Force the entry call to be
+ --      queued by having the task call a procedure, prior to the corresponding
+ --      accept statement, which simulates a routine waiting for user input
+ --      (with a delay). 
+ --
+ --      Simulate a time-consuming routine in the abortable part by calling a
+ --      procedure containing an infinite loop. Meanwhile, simulate input by
+ --      the user (the delay expires) which is NOT the input expected by the
+ --      guard on the accept statement. The entry remains closed, and the
+ --      task completes its execution. Since the entry was not accepted before
+ --      its task completed, Tasking_Error is raised at the point of the entry
+ --      call.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C974005_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    -- Flags for testing purposes:
+ 
+    Count : Integer := 1234;            
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+ 
+    task type ATM_Keyboard_Task is
+       entry Cancel_Pressed;
+    end ATM_Keyboard_Task;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type);
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974005_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ package body C974005_0 is
+ 
+ 
+    procedure Listen_For_Input (Key : out Key_Enum) is
+    begin
+       -- Simulate the situation where a user waits a bit for the card to
+       -- be validated, then presses a transaction key (NOT Cancel).
+ 
+       -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
+       delay ImpDef.Clear_Ready_Queue;
+ 
+       if Report.Equal (3, 3) then  -- Always true.
+          Key := Deposit;           -- Cancel is NOT pressed.
+       end if;
+    end Listen_For_Input;
+ 
+ 
+    task body ATM_Keyboard_Task is
+       Key_Pressed : Key_Enum := None;
+    begin
+ 
+       -- Note: no loop. If the user does not press Cancel, the task completes.
+       -- In this model of the keyboard monitor, the user only gets one chance
+       -- to cancel the card validation.
+                                                             -- Force entry
+          Listen_For_Input (Key_Pressed);                    -- calls to be
+                                                             -- queued, but do
+                                                             -- NOT set guard
+                                                             -- to true.
+       select
+          when (Key_Pressed = Cancel) =>                     -- Guard is false,
+             accept Cancel_Pressed do                        -- so entry call
+                Report.Failed ("Accept statement executed"); -- remains queued.
+             end Cancel_Pressed;
+       else                                                  -- Else alternative
+          Key_Pressed := None;                               -- executed, then
+       end select;                                           -- task ends.
+    exception
+       when others => 
+          Report.Failed ("Unexpected exception in ATM_Keyboard_Task"); 
+    end ATM_Keyboard_Task;
+ 
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type) is
+    begin
+       Card.Number := 9999;
+       Card.PIN    := 111;
+    end Read_Card;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       -- Simulate an exceedingly long validation activity.
+       loop                                             -- Infinite loop.
+          Count := (Count + 1) mod Integer (Card.PIN);
+ 
+          -- Synch Point to allow transfer of control to Keyboard task
+          -- during this simulation
+          delay ImpDef.Minimum_Task_Switch;
+ 
+          exit when not Report.Equal (Count, Count);    -- Always false.
+       end loop;
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Exception not re-raised immediately following " &
+                      "asynchronous select");
+       if Count = 1234 then
+          -- Additional analysis added to aid developers
+          Report.Failed ("Abortable part did not execute");
+       end if;
+    end Perform_Transaction;
+ 
+ 
+ end C974005_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with C974005_0;  -- Automated teller machine abstraction.
+ use  C974005_0;
+ 
+ procedure C974005 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974005", "ATC: trigger is queued but task terminates" &
+                              " before call is serviced");
+ 
+    Read_Card (Card_Data);
+ 
+    begin
+ 
+       declare
+          Keyboard : C974005_0.ATM_Keyboard_Task;
+       begin
+ 
+          --                                    --
+          -- Asynchronous select is tested here --
+          --                                    --
+ 
+          select
+             Keyboard.Cancel_Pressed;      -- Entry call initially queued, so
+                                           -- abortable part starts.
+ 
+                                           -- Tasking_Error raised here when
+                                           -- Keyboard completes before entry
+                                           -- call can be accepted, and before
+                                           -- abortable part completes.
+ 
+             raise Transaction_Canceled;   -- Should not be executed.
+          then abort
+             Validate_Card (Card_Data);    -- Keyboard task completes before
+                                           -- Keyboard.Cancel_Pressed is
+                                           -- accepted, and before this call
+                                           -- finishes. Tasking_Error is raised
+                                           -- at the point of the entry call,
+                                           -- and this call is aborted.
+             -- Check that the whole of the abortable part is aborted, not just
+             -- the statement in the abortable part that was executing at
+             -- the time
+             Report.Failed ("Abortable part not aborted");
+          end select;
+          Perform_Transaction (Card_Data); -- Should not be reached.
+       exception
+          when Transaction_Canceled =>
+             Report.Failed ("Triggering alternative sequence of statements " &
+                            "executed");
+          when Tasking_Error        =>
+             if Count = 1234 then
+                Report.Failed ("Abortable part did not execute");
+             end if;
+          when others       =>
+             Report.Failed ("Wrong exception raised");
+       end;
+ 
+    exception
+       when Tasking_Error        =>
+          Report.Failed ("Correct exception raised at wrong level");
+       when others       =>
+          Report.Failed ("Wrong exception raised at wrong level");
+    end;
+ 
+    Report.Result;
+ 
+ end C974005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,197 ----
+ -- C974006.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the sequence of statements of the triggering alternative
+ --      of an asynchronous select statement is executed if the triggering
+ --      statement is a protected entry call, and the entry is accepted
+ --      immediately. Check that the corresponding entry body is executed
+ --      before the sequence of statements of the triggering alternative.
+ --      Check that the abortable part is not executed.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a main procedure containing an asynchronous select with a
+ --      protected entry call as triggering statement. Declare a protected
+ --      procedure which sets the protected entry's barrier true. Force the
+ --      entry call to be accepted immediately by calling this protected
+ --      procedure prior to the asynchronous select. Since the entry call
+ --      is accepted immediately, the abortable part should never start. When
+ --      entry call completes, the sequence of statements of the triggering
+ --      alternative should execute.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package C974006_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    -- Flag for testing purposes:
+ 
+    Entry_Body_Executed : Boolean := False;
+ 
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+ 
+    protected type ATM_Keyboard_Protected is
+       entry Cancel_Pressed;
+       procedure Read_Key;
+    private
+       Last_Key_Pressed : Key_Enum := None;
+    end ATM_Keyboard_Protected;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type);
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974006_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C974006_0 is
+ 
+ 
+    protected body ATM_Keyboard_Protected is
+ 
+       entry Cancel_Pressed when (Last_Key_Pressed = Cancel) is
+       begin
+          Entry_Body_Executed := True;
+       end Cancel_Pressed;
+ 
+       procedure Read_Key is
+       begin
+          -- Simulate a procedure which processes user keyboard input, and
+          -- which is called by some interrupt handler.
+          Last_Key_Pressed := Cancel;
+       end Read_Key;
+ 
+    end ATM_Keyboard_Protected;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type) is
+    begin
+       Card.Number := 9999;
+       Card.PIN    := 111;
+    end Read_Card;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Abortable part executed");
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Triggering alternative sequence of statements " &
+                       "not fully executed");
+    end Perform_Transaction;
+ 
+ 
+ end C974006_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with C974006_0;  -- Automated teller machine abstraction.
+ use  C974006_0;
+ 
+ procedure C974006 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin
+ 
+    Report.Test ("C974006", "ATC: trigger is protected entry call" &
+                               " and completes first");
+ 
+    Read_Card (Card_Data);
+ 
+    declare
+       Keyboard : C974006_0.ATM_Keyboard_Protected;
+    begin
+ 
+       -- Simulate the situation where the user hits cancel before the
+       -- validation process can start:
+       Keyboard.Read_Key;                 -- Force Keyboard.Cancel_Pressed to
+                                          -- be accepted immediately.
+ 
+       --                                    --
+       -- Asynchronous select is tested here --
+       --                                    --
+ 
+       select
+          Keyboard.Cancel_Pressed;        -- Entry call is accepted immediately,
+                                          -- so abortable part does NOT start.
+ 
+          if not Entry_Body_Executed then -- Executes after entry completes.
+             Report.Failed ("Triggering alternative sequence of statements " &
+                            "executed before triggering statement complete");
+          end if;
+ 
+          raise Transaction_Canceled;     -- Control passes to exception
+                                          -- handler.
+       then abort
+          Validate_Card (Card_Data);      -- Should not be executed.
+       end select;
+       Perform_Transaction (Card_Data);   -- Should not be reached.
+    exception
+       when Transaction_Canceled =>
+          null;
+    end;
+ 
+    Report.Result;
+ 
+ end C974006;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,205 ----
+ -- C974007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the sequence of statements of the triggering alternative
+ --      of an asynchronous select statement is not executed if the triggering
+ --      statement is a protected entry call, and the entry is not accepted
+ --      before the abortable part completes. Check that execution continues
+ --      immediately following the asynchronous select.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a main procedure containing an asynchronous select with a
+ --      protected entry call as triggering statement. Declare a protected
+ --      procedure which sets the protected entry's barrier true. Ensure
+ --      that the entry call is never accepted by not calling the protected
+ --      procedure; the barrier remains false, and the entry call from
+ --      asynchronous select is queued. Since the abortable part will complete
+ --      before the entry is accepted, the sequence of statements of the
+ --      triggering alternative is never executed.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package C974007_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    -- Flags for testing purposes:
+    -- 
+    Abortable_Part_Executed       : Boolean := False;
+    Perform_Transaction_Executed  : Boolean := False;
+    Triggering_Statement_Executed : Boolean := False;
+ 
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+ 
+    protected type ATM_Keyboard_Protected is
+       entry Cancel_Pressed;
+       procedure Read_Key;
+    private
+       Last_Key_Pressed : Key_Enum := None;
+    end ATM_Keyboard_Protected;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type);
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974007_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C974007_0 is
+ 
+ 
+    protected body ATM_Keyboard_Protected is
+ 
+       -- Barrier is false for the live of the test
+       entry Cancel_Pressed when (Last_Key_Pressed = Cancel) is  
+       begin                                                     
+       Triggering_Statement_Executed  := true;   -- Test has failed
+       -- (Note: cannot call Report.Failed in the protected entry body]
+       end Cancel_Pressed;
+ 
+       procedure Read_Key is                                     -- Never
+       begin                                                     -- called.
+          -- Simulate a procedure which reads user keyboard input, and
+          -- which is called by some interrupt handler.
+          Last_Key_Pressed := Cancel;
+       end Read_Key;
+ 
+    end ATM_Keyboard_Protected;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type) is
+    begin
+       Card.Number := 9999;
+       Card.PIN    := 111;
+    end Read_Card;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       Abortable_Part_Executed := True;
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Perform_Transaction_Executed := True;
+    end Perform_Transaction;
+ 
+ 
+ end C974007_0;
+ 
+ 
+      --==================================================================--
+ with Report;
+ 
+ with C974007_0;  -- Automated teller machine abstraction.
+ use  C974007_0;
+ 
+ procedure C974007 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin
+ 
+    Report.Test ("C974007", "ATC: trigger is protected entry call" &
+                               " and abortable part completes first");
+ 
+    Read_Card (Card_Data);
+ 
+    declare
+       Keyboard : C974007_0.ATM_Keyboard_Protected;
+    begin
+ 
+       --                                    --
+       -- Asynchronous select is tested here --
+       --                                    --
+ 
+       select
+          Keyboard.Cancel_Pressed;        -- Barrier is never set true, so
+                                          -- entry call is queued and never
+                                          -- accepted.
+ 
+          raise Transaction_Canceled;     -- Should not be executed.
+       then abort
+          Validate_Card (Card_Data);      -- This call completes before
+                                          -- Keyboard.Cancel_Pressed can be
+                                          -- accepted.
+       end select;
+       Perform_Transaction (Card_Data);   -- Execution proceeds here after
+                                          -- Validate_Card completes.
+    exception
+       when Transaction_Canceled =>
+          Report.Failed ("Triggering alternative sequence of statements " &
+                         "executed");
+    end;
+    
+    
+    if Triggering_Statement_Executed  then
+       Report.Failed ("Triggering statement was executed");
+    end if;
+ 
+    if not Abortable_Part_Executed then
+       Report.Failed ("Abortable part not executed");
+    end if;
+ 
+    if not Perform_Transaction_Executed then
+       Report.Failed ("Statements following asynchronous select not " &
+                      "executed");
+    end if;
+ 
+    Report.Result;
+ 
+ end C974007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974008.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974008.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974008.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,229 ----
+ -- C974008.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement
+ --      is not started if the triggering statement is a task entry call, and
+ --      the entry call is not queued.
+ --
+ --      Check that the sequence of statements of the triggering alternative
+ --      is executed after the abortable part is left.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a main procedure containing an asynchronous select with a task
+ --      entry call as triggering statement.  Ensure that the task is waiting
+ --      at the accept statement so the rendezvous is executed immediately (the
+ --      entry call is not queued). 
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C974008_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    -- Flags for testing purposes:
+ 
+    Triggering_Statement_Completed : Boolean := False;
+    Count                          : Integer := 1234;  -- Global to defeat
+                                                       -- optimization.
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+ 
+    task type ATM_Keyboard_Task is
+       entry Cancel_Pressed;
+    end ATM_Keyboard_Task;
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type);
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974008_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C974008_0 is
+ 
+ 
+    procedure Listen_For_Input (Key : out Key_Enum) is
+    begin
+       -- Simulate the situation where the user presses the cancel key
+       -- before the card is validated
+ 
+       -- press the cancel key immediately
+       Key := Cancel;
+ 
+    end Listen_For_Input;
+ 
+ 
+ 
+    -- One of these gets created as "Keyboard" for each transaction
+    --
+    task body ATM_Keyboard_Task is
+       Key_Pressed : Key_Enum := None;
+    begin
+       -- NOTE:   Normal usage for this routine would be the loop with 
+       --         the select statement included.  This particular test
+       --         requires that the task be waiting at the accept 
+       --         for the call.  To ensure that this is the case the 
+       --         extraneous commands are commented out (we leave them
+       --         in this form to show the reader the surrounds to the 
+       --         fragment of code remaining)
+  
+       -- loop
+                                          
+          Listen_For_Input (Key_Pressed); 
+                                          
+          -- select
+             -- when (Key_Pressed = Cancel) =>                 -- Guard is now
+                accept Cancel_Pressed do                    -- true, so accept
+                   Triggering_Statement_Completed := True;  -- queued entry
+                end Cancel_Pressed;                         -- call.
+ 
+                -- User has cancelled the transaction so we exit the
+                -- loop and allow the task to terminate
+                -- exit;
+          -- else
+             -- Key_Pressed := None;
+          -- end select;
+ 
+       -- end loop;
+    exception
+       when others =>
+           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+    end ATM_Keyboard_Task;
+ 
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type) is
+    begin
+       Card.Number := 9999;
+       Card.PIN    := 111;
+    end Read_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Triggering alternative sequence of statements " &
+                      "not executed");
+       if not Triggering_Statement_Completed then
+          Report.Failed ("Triggering statement did not complete");
+       end if;
+    end Perform_Transaction;
+ 
+ 
+ end C974008_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with C974008_0;  -- Automated teller machine abstraction.
+ use  C974008_0;
+ 
+ procedure C974008 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974008", "Asynchronous Select: Trigger is a call to a " &
+                            "waiting task entry and completes immediately");
+ 
+    Read_Card (Card_Data);
+ 
+    declare
+       -- Create the task for this transaction
+       Keyboard : C974008_0.ATM_Keyboard_Task;    
+    begin
+ 
+       -- Ensure task is waiting at the accept
+       -- This is the time required to activate another task and allow it
+       -- to run to its first accept statement.
+       --
+       delay ImpDef.Switch_To_New_Task;
+ 
+       --                                    --
+       -- Asynchronous select is tested here --
+       --                                    --
+ 
+       select
+          Keyboard.Cancel_Pressed;      -- Entry call is executed immediately
+ 
+          raise Transaction_Canceled;   -- This is executed after Validate_Card
+                                        -- is aborted.
+       then abort
+ 
+          -- In other similar tests Validate_Card is called here.  In this 
+          -- test we just check to see if the abortable part is called at
+          -- all.  Since the triggering call is not queued the abortable 
+          -- part should not be started
+          --
+          Report.Failed ("Abortable part started");
+ 
+       end select;
+ 
+       Perform_Transaction (Card_Data); -- Should not be reached.
+    exception
+       when Transaction_Canceled =>
+ 
+          if not Triggering_Statement_Completed then
+             Report.Failed ("Triggering alternative sequence of statements " &
+                            "executed but triggering statement not complete");
+          end if;
+ 
+    end;
+ 
+    Report.Result;
+ 
+ end C974008;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974009.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974009.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974009.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,206 ----
+ -- C974009.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement
+ --      is not started if the triggering statement is a task entry call, 
+ --      the entry call is not queued and the entry call completes by 
+ --      propagating an exception.
+ --
+ --      Check that the exception is properly propagated to the asynchronous
+ --      select statement and thus the sequence of statements of the triggering
+ --      alternative is not executed after the abortable part is left. 
+ --
+ --      Check that the exception propagated by the entry call is re-raised
+ --      immediately following the asynchronous select.
+ --
+ -- TEST DESCRIPTION:
+ --
+ --      Use a small subset of the base Automated teller machine simulation
+ --      which is shown in greater detail in other tests of this series.  
+ --      Declare a main procedure containing an asynchronous select with a task
+ --      entry call as triggering statement.  Force the task to be waiting at
+ --      the accept statement so that the call is not queued and the rendezvous
+ --      is executed immediately.  Simulate an unexpected exception in the
+ --      rendezvous. Use stripped down versions of called procedures to  check
+ --      the correct path in the test.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package C974009_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    Propagated_From_Task : exception;
+    Transaction_Canceled : exception;
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+    task type ATM_Keyboard_Task is
+       entry Cancel_Pressed;
+    end ATM_Keyboard_Task;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974009_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C974009_0 is
+ 
+ 
+ 
+    -- One of these gets created as "Keyboard" for each transaction
+    --
+    task body ATM_Keyboard_Task is
+       Key_Pressed : Key_Enum := None;
+    begin
+       accept Cancel_Pressed do        -- queued entry call.
+          null;  --:::: stub, user code for cancel
+          -- Now simulate an unexpected exception arising in the
+          -- user code
+          raise Propagated_From_Task;  -- Propagate an exception.
+                   
+        end Cancel_Pressed;
+ 
+        Report.Failed ("Exception not propagated in ATM_Keyboard_Task");
+                
+    exception
+       when Propagated_From_Task =>
+           null;  -- This is the expected test behavior
+       when others =>
+           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+    end ATM_Keyboard_Task;
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Abortable part was executed");
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Exception not re-raised immediately following " &
+                      "asynchronous select");
+    end Perform_Transaction;
+ 
+ 
+ end C974009_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with C974009_0;  -- Automated teller machine abstraction.
+ use  C974009_0;
+ 
+ procedure C974009 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974009", "Asynchronous Select: Trigger is a call to a " &
+                            "task entry, is not queued and is completed " &
+                            "first by an exception");
+ 
+ 
+    begin
+ 
+       declare
+          -- Create the task for this transaction
+          Keyboard : C974009_0.ATM_Keyboard_Task;
+       begin
+ 
+          -- Ensure task is waiting a the accept so the call is not queued
+          -- This is the time required to activate another task and allow it
+          -- to run to its first accept statement
+          -- 
+          delay ImpDef.Switch_To_New_Task;
+ 
+          --                                    --
+          -- Asynchronous select is tested here --
+          --                                    --
+ 
+          select
+  
+             Keyboard.Cancel_Pressed;
+ 
+             raise Transaction_Canceled;  -- Should not be executed.
+          then abort
+             Validate_Card (Card_Data);   -- Keyboard.Cancel_Pressed is accepted
+                                          -- and propagates an exception before
+                                          -- this call is executed
+          end select;
+ 
+          -- The propagated exception is re-raised here.
+          Perform_Transaction(Card_Data); -- Should not be reached.
+ 
+       exception
+          when Transaction_Canceled =>
+             Report.Failed ("Triggering alternative sequence of statements " &
+                            "executed");
+          when Propagated_From_Task =>
+             null;  -- This is the expected test path
+          when others =>
+             Report.Failed ("Wrong exception raised");
+       end;
+ 
+    exception
+       when others =>
+             Report.Failed ("Unexpected exception raised");
+    end;
+ 
+    Report.Result;
+ 
+ end C974009;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,209 ----
+ -- C974010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement
+ --      is not started if the triggering statement is a task entry call to
+ --      a task that has already terminated.
+ --
+ --      Check that Tasking_Error is properly propagated to the asynchronous
+ --      select statement and thus the sequence of statements of the triggering
+ --      alternative is not executed after the abortable part is left. 
+ --
+ --      Check that Tasking_Error is re-raised immediately following the 
+ --      asynchronous select.
+ --
+ -- TEST DESCRIPTION:
+ --
+ --      Use a small subset of the base Automated Teller Machine simulation
+ --      which is shown in greater detail in other tests of this series.  
+ --      Declare a main procedure containing an asynchronous select with a task
+ --      entry call as triggering statement.  Ensure that the task is
+ --      terminated before the entry call.  Use stripped down versions of
+ --      the  called procedures to check the correct path in the test.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package C974010_0 is  -- Automated teller machine abstraction.
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+    task type ATM_Keyboard_Task is
+       entry Cancel_Pressed;
+    end ATM_Keyboard_Task;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974010_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C974010_0 is
+ 
+ 
+ 
+    -- One of these gets created as "Keyboard" for each transaction
+    --
+    task body ATM_Keyboard_Task is
+       TC_Suicide  : exception;
+       Key_Pressed : Key_Enum := None;
+    begin
+       raise TC_Suicide;   -- Simulate early, unexpected termination
+ 
+       accept Cancel_Pressed do        -- queued entry call.
+          null;  --:::: user code for cancel
+                  
+       end Cancel_Pressed;
+ 
+    exception
+       when TC_Suicide =>
+          null;  -- This is the expected test behavior
+       when others =>
+           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+    end ATM_Keyboard_Task;
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Abortable part was executed");
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       Report.Failed ("Exception not re-raised immediately following " &
+                      "asynchronous select");
+    end Perform_Transaction;
+ 
+ 
+ end C974010_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ with C974010_0;  -- Automated teller machine abstraction.
+ use  C974010_0;
+ 
+ procedure C974010 is
+ 
+    Card_Data : ATM_Card_Type;
+    TC_Tasking_Error_Handled : Boolean := false;
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974010", "Asynchronous Select: Trigger is a call to a " &
+                            "task entry of a task that is already completed");
+ 
+ 
+    declare
+       -- Create the task for this transaction
+       Keyboard : C974010_0.ATM_Keyboard_Task;
+    begin
+ 
+       -- Ensure the task is already completed before calling
+       --
+       while not Keyboard'terminated loop
+          delay ImpDef.Minimum_Task_Switch;
+       end loop;
+ 
+       --                                    --
+       -- Asynchronous select is tested here --
+       --                                    --
+ 
+       select
+  
+          Keyboard.Cancel_Pressed;
+ 
+          raise Transaction_Canceled;  -- Should not be executed.
+ 
+       then abort
+ 
+          -- Since the triggering call is not queued the abortable part
+          -- should not be executed.
+          --
+          Validate_Card (Card_Data);  
+ 
+       end select;
+       --
+       -- The propagated exception is re-raised here.
+ 
+       Perform_Transaction(Card_Data); -- Should not be reached.
+ 
+    exception
+       when Transaction_Canceled =>
+          Report.Failed ("Triggering alternative sequence of statements " &
+                         "executed");
+       when Tasking_Error =>
+          -- This is the expected test path
+          TC_Tasking_Error_Handled := true;
+       when others       =>
+          Report.Failed ("Wrong exception raised: ");
+    end;
+ 
+    
+    if not TC_Tasking_Error_Handled then
+       Report.Failed ("Tasking_Error not properly propagated");
+    end if;
+ 
+    Report.Result;
+ 
+ exception
+    when Tasking_Error =>
+         Report.Failed ("Tasking_Error propagated to wrong handler");
+         Report.Result;
+ 
+ 
+ end C974010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,275 ----
+ -- C974011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the sequence of statements of the triggering alternative
+ --      of an asynchronous select statement is not executed if the triggering
+ --      statement is a task entry call and the entry is not accepted
+ --      before the abortable part completes. 
+ --      Check that the call queued on the entry is cancelled
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a main procedure containing an asynchronous select with a task
+ --      entry call as triggering statement. Force the entry call to be
+ --      queued by having the task call a procedure, prior to the corresponding
+ --      accept statement, which simulates (with a delay) a routine waiting
+ --      for user input
+ --       
+ --      Once the call is known to be queued, complete the abortable part. 
+ --      Check that the rendezvous (and thus the trigger) does not complete. 
+ --      Then clear the barrier and check that the entry has been cancelled
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      28 Nov 95   SAIC    Eliminated shared global variable for ACVC 2.0.1
+ --
+ --!
+ 
+ with ImpDef;
+ --
+ package C974011_0 is  -- Automated teller machine abstraction.
+ 
+ 
+ 
+    type Key_Enum is (None, Cancel, Deposit, Withdraw);
+ 
+    protected Key_PO is
+       procedure Set (K : Key_Enum);
+       function  Value return Key_Enum;
+    private
+       Current : Key_Enum := None;
+    end Key_PO;
+ 
+ 
+    -- Flags for testing purposes
+    TC_Abortable_Part_Completed : Boolean := False;
+    TC_Rendezvous_Entered       : Boolean := False;
+    TC_Delay_Time : constant duration := ImpDef.Switch_To_New_Task;
+ 
+ 
+    Count  : Integer := 1234;  -- Global to defeat optimization.
+ 
+ 
+    type Card_Number_Type is private;
+    type Card_PIN_Type    is private;
+    type ATM_Card_Type    is private;
+ 
+ 
+    Transaction_Canceled : exception;
+ 
+ 
+    task type ATM_Keyboard_Task is
+       entry Cancel_Pressed;
+    end ATM_Keyboard_Task;
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type);
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type);
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type);
+ 
+ private
+ 
+    type Card_Number_Type is range   1 .. 9999;
+    type Card_PIN_Type    is range 100 ..  999;
+ 
+    type ATM_Card_Type is record
+       Number : Card_Number_Type;
+       PIN    : Card_PIN_Type;
+    end record;
+ 
+ end C974011_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ package body C974011_0 is
+ 
+    protected body Key_PO is
+       procedure Set (K : Key_Enum) is
+       begin
+          Current := K;
+       end Set;
+ 
+       function Value return Key_Enum is
+       begin
+         return Current;
+       end Value;
+    end Key_PO;
+ 
+ 
+    procedure Listen_For_Input (Key : out Key_Enum) is
+    begin
+       -- Model the situation where the user does not press cancel thus
+       -- allowing validation to complete
+ 
+       delay TC_Delay_Time;  -- Long enough to force queuing on
+                             -- Keyboard.Cancel_Pressed.
+     
+       Key := Key_PO.Value;
+ 
+    end Listen_For_Input;
+ 
+ 
+ 
+    -- One of these gets created as "Keyboard" for each transaction
+    --
+    task body ATM_Keyboard_Task is
+       Key_Pressed : Key_Enum;
+    begin
+       loop
+                                                            -- Force entry calls
+          Listen_For_Input (Key_Pressed);                   -- to be queued,
+ 
+          select
+             when (Key_Pressed = Cancel) =>                 
+                accept Cancel_Pressed do                    
+                   TC_Rendezvous_Entered := True;
+                end Cancel_Pressed;                        
+ 
+                -- User has cancelled the transaction so we exit the
+                -- loop and allow the task to terminate
+                exit;
+          else
+             delay ImpDef.Switch_To_New_Task;
+          end select;
+ 
+       end loop;
+    exception
+       when others =>
+           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+    end ATM_Keyboard_Task;
+ 
+ 
+ 
+    procedure Read_Card (Card : in out ATM_Card_Type) is
+    begin
+       Card.Number := 9999;
+       Card.PIN    := 111;
+    end Read_Card;
+ 
+ 
+    procedure Validate_Card (Card : in ATM_Card_Type) is
+    begin
+       Count := (Count + 1) mod Integer (Card.PIN);
+ 
+       -- Simulate a validation activity which is longer than the time
+       -- taken in Listen_For_Input but not inordinately so.
+       delay TC_Delay_Time * 2;
+ 
+    end Validate_Card;
+ 
+ 
+    procedure Perform_Transaction (Card : in ATM_Card_Type) is
+    begin
+       if TC_Rendezvous_Entered then
+          Report.Failed ("Triggering statement completed");
+       end if;
+       if Count = 1234 then
+          -- Initial value is unchanged
+          Report.Failed ("Abortable part did not execute");
+       end if;
+       if not TC_Abortable_Part_Completed then
+          Report.Failed ("Abortable part did not complete");
+       end if;
+    end Perform_Transaction;
+ 
+ 
+ end C974011_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with Report;
+ 
+ with C974011_0;  -- Automated teller machine abstraction.
+ use  C974011_0;
+ 
+ procedure C974011 is
+ 
+    Card_Data : ATM_Card_Type;
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974011", "Asynchronous Select: Trigger is queued on a " &
+                             "task entry and the abortable part " &
+                             "completes first");
+ 
+    Read_Card (Card_Data);
+ 
+    declare
+       -- Create the task for this transaction
+       Keyboard : C974011_0.ATM_Keyboard_Task;    
+    begin
+ 
+       --                                    --
+       -- Asynchronous select is tested here --
+       --                                    --
+ 
+       select
+       
+          Keyboard.Cancel_Pressed;      -- Entry call is initially queued, so
+                                        -- abortable part starts.
+          raise Transaction_Canceled;   -- This would be executed if we
+                                        -- completed the rendezvous
+       then abort
+       
+          Validate_Card (Card_Data);
+          TC_Abortable_Part_Completed := true;
+ 
+       end select;
+ 
+       Perform_Transaction (Card_Data); 
+ 
+ 
+       -- Now clear the entry barrier to allow the rendezvous to complete
+       -- if the triggering call has not been cancelled 
+       Key_PO.Set (Cancel);
+       --
+       delay TC_Delay_Time;  -- to allow it all to take place
+ 
+       if TC_Rendezvous_Entered then 
+          Report.Failed ("Triggering Call was not cancelled");
+       end if;
+       
+       abort Keyboard;    -- clean up.  (Note: the task will only exit the
+                          -- loop and terminate if the call hanging on the 
+                          -- entry is executed.)  
+ 
+    exception
+       when Transaction_Canceled =>
+          Report.Failed ("Triggering alternative sequence of statements " &
+                            "executed");
+       when Others =>
+          Report.Failed ("Unexpected exception in the Main");
+    end;
+ 
+    Report.Result;
+        
+ end C974011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C974012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement is
+ --      aborted if it does not complete before the triggering statement
+ --      completes, where the triggering statement is a call on a protected
+ --      entry which is queued.
+ --
+ -- TEST DESCRIPTION:
+ --      A fraction of in-line code is simulated.  A voltage deficiency causes
+ --      the routine to seek an alternate best-cost route on an electrical grid
+ --      system.  
+ --      
+ --      An asynchronous select is used with the triggering alternative being a
+ --      call to a protected entry with a barrier.  The abortable part is a
+ --      routine simulating the lengthy alternate path negotiation.  The entry
+ --      barrier would be cleared if the voltage deficiency is rectified before
+ --      the alternate can be found thus nullifying the need for the alternate.  
+ --      
+ --      The test simulates a return to normal in the middle of the
+ --      negotiation.  The barrier is cleared, the triggering alternative
+ --      completes first and the abortable part should be aborted.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with Report;
+ with ImpDef;
+ 
+ procedure C974012 is
+ 
+    subtype Grid_Path is string(1..21);
+    subtype Deficiency is integer range 100..1_000;   -- in MWh
+ 
+    New_Path         : Grid_Path;
+    Dummy_Deficiency : Deficiency := 520;   
+    Path_Available   : Boolean    := false;
+ 
+    TC_Terminate_Negotiation_Executed  : Boolean := false;
+    TC_Trigger_Completed               : Boolean := false;
+    TC_Negotiation_Completed           : Boolean := false;
+ 
+    protected Local_Deficit is
+       procedure Set_Good_Voltage;
+       procedure Bad_Voltage;
+       entry Terminate_Negotiation;
+    private
+       Good_Voltage   : Boolean := false;   -- barrier
+    end Local_Deficit;
+ 
+    protected body Local_Deficit is
+ 
+       procedure Set_Good_Voltage is
+       begin
+          Good_Voltage := true;
+       end Set_Good_Voltage;
+ 
+       procedure Bad_Voltage is
+       begin
+          Good_Voltage := false;
+       end Bad_Voltage;
+ 
+       -- Trigger is queued on this entry with barrier condition
+       entry Terminate_Negotiation when Good_Voltage is
+       begin
+          -- complete the triggering call thus terminating grid_path
+          -- negotiation.
+          null; --::: stub - signal main board
+          TC_Terminate_Negotiation_Executed := true;   -- show path traversal
+       end Terminate_Negotiation;
+ 
+    end Local_Deficit;
+ 
+ 
+    -- Routine to find the most cost effective grid path for this 
+    -- particular deficiency at this particular time
+    --
+    procedure Path_Negotiation (Requirement : in  Deficiency;
+                                Best_Path   : out Grid_Path  ) is
+       
+       Dummy_Path : Grid_Path := "NYC.425_NY.227_NH.132";
+       Match : Deficiency := Report.Ident_Int (Requirement); 
+   
+    begin
+       -- 
+       null; --::: stub
+       --
+       -- Simulate a lengthy path negotiation 
+       for i in 1..5 loop
+          delay ImpDef.Minimum_Task_Switch;   
+          -- Part of the way through the negotiation simulate some external 
+          -- event returning the voltage to acceptable level 
+          if i = 3 then
+             Local_Deficit.Set_Good_Voltage;   -- clear the barrier
+          end if;
+       end loop; 
+       
+       Best_Path := Dummy_Path;
+       TC_Negotiation_Completed := true;
+    
+    end Path_Negotiation;
+ 
+   
+ 
+ begin
+ 
+    Report.Test ("C974012", "Asynchronous Select: Trigger is queued on a " &
+                            "protected entry and completes before the " &
+                            "abortable part");
+ 
+    -- :::::::::   Fragment of code
+    
+    Local_Deficit.Bad_Voltage;      -- Set barrier condition
+ 
+    -- For the given voltage deficiency start negotiating the best grid
+    -- path.  If voltage returns to acceptable level cancel the negotiation
+    --
+    select
+       -- Prepare to terminate the Path_Negotiation if voltage improves
+       Local_Deficit.Terminate_Negotiation;
+       TC_Trigger_Completed := true;
+    then abort
+       Path_Negotiation (Dummy_Deficiency, New_Path) ;
+       Path_Available := true;
+    end select;
+    -- :::::::::
+ 
+    if not TC_Terminate_Negotiation_Executed or else not
+                                                TC_Trigger_Completed then 
+       Report.Failed ("Unexpected test path taken");
+    end if;
+ 
+    if Path_Available or else TC_Negotiation_Completed then
+       Report.Failed ("Abortable part was not aborted");
+    end if;
+    Report.Result;
+ 
+ end C974012;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,167 ----
+ -- C974013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the abortable part of an asynchronous select statement
+ --      is aborted if it does not complete before the triggering statement
+ --      completes, where the triggering statement is a delay_until
+ --      statement.
+ --
+ --      Check that the sequence of statements of the triggering alternative
+ --      is executed after the abortable part is left.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a task with an accept statement containing an asynchronous
+ --      select with a delay_until triggering statement.  Parameterize
+ --      the accept statement with the amount of time to be added to the
+ --      current time to be used for the delay. Simulate a time-consuming 
+ --      calculation by declaring a procedure containing an infinite loop.
+ --      Call this procedure in the abortable part.
+ --
+ --      The delay will expire before the abortable part completes, at which
+ --      time the abortable part is aborted, and the sequence of statements
+ --      following the triggering statement is executed.
+ --
+ --      Main test logic is identical to c974001 which uses simple delay
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      28 Nov 95   SAIC    Fixed problems for ACVC 2.0.1.
+ --
+ --!
+ 
+ with Report;
+ with ImpDef;
+ with Ada.Calendar;
+ 
+ procedure C974013 is
+ 
+ 
+           --========================================================--
+ 
+    function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                             return Ada.Calendar.Time renames Ada.Calendar."+";
+ 
+ 
+    Allotted_Time : constant Duration := ImpDef.Switch_To_New_Task;
+    Calculation_Canceled : exception;
+ 
+    Count : Integer := 1234;                          
+    procedure Lengthy_Calculation is
+    begin
+       -- Simulate a non-converging calculation.
+       loop                                           -- Infinite loop.
+          Count := (Count + 1) mod 10;
+          exit when not Report.Equal (Count, Count);  -- Condition always false.
+          delay 0.0;                                  -- abort completion point
+       end loop;
+    end Lengthy_Calculation;
+ 
+ 
+           --========================================================--
+ 
+ 
+    task type Timed_Calculation is
+       entry Calculation (Time_Limit : in Duration);
+    end Timed_Calculation;
+ 
+ 
+    task body Timed_Calculation is
+       Delay_Time : Ada.Calendar.Time;
+    begin
+       loop
+          select
+             accept Calculation (Time_Limit : in Duration) do
+ 
+                -- We have to construct an "until" time artificially 
+                -- as we have no control over when the test will be run
+                --
+                Delay_Time := Ada.Calendar.Clock + Time_Limit;
+ 
+                --                                    --
+                -- Asynchronous select is tested here --
+                --                                    --
+ 
+                select
+ 
+                   delay until Delay_Time;     -- Time not reached yet, so
+                                               -- Lengthy_Calculation starts.
+ 
+                   raise Calculation_Canceled; -- This is executed after
+                                               -- Lengthy_Calculation aborted.
+ 
+                then abort
+ 
+                   Lengthy_Calculation;        -- Delay expires before complete,
+                                               -- so this call is aborted.
+                   -- Check that the whole of the abortable part is aborted,
+                   -- not just the statement in the abortable part that was
+                   -- executing at the time
+                   Report.Failed ("Abortable part not aborted");
+ 
+                end select;
+ 
+                Report.Failed ("Triggering alternative sequence of " &
+                               "statements not executed");
+ 
+             exception    -- New Ada 9x: handler within accept
+                when Calculation_Canceled =>
+                   if Count = 1234 then
+                      Report.Failed ("Abortable part did not execute");
+                   end if;
+             end Calculation;
+          or
+             terminate;
+          end select;
+       end loop;
+    exception
+       when others => 
+             Report.Failed ("Unexpected exception in Timed_Calculation task");
+    end Timed_Calculation;
+ 
+ 
+           --========================================================--
+ 
+ 
+ 
+ begin  -- Main program.
+ 
+    Report.Test ("C974013", "Asynchronous Select: Trigger is delay_until " &
+                            "which completes before abortable part");
+ 
+    declare
+       Timed : Timed_Calculation;  -- Task.
+    begin
+       Timed.Calculation (Time_Limit => Allotted_Time); -- Asynchronous select
+                                                        -- inside accept block.
+    exception
+       when Calculation_Canceled => 
+          Report.Failed ("wrong exception handler used");
+    end;       
+ 
+    Report.Result;
+ 
+ end C974013;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974014.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c974014.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c974014.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,132 ----
+ -- C974014.A 
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the triggering alternative of an asynchronous select 
+ --      statement is a delay and the abortable part completes before the delay
+ --      expires then the delay is cancelled and the optional statements in the
+ --      triggering part are not performed.  In particular, check the case of
+ --      the ATC in non-tasking code.
+ --
+ -- TEST DESCRIPTION:
+ --      A fraction of in-line code is simulated.  An asynchronous select
+ --      is used with a triggering delay of several minutes.  The abortable
+ --      part, which is simulating a very lengthy, time consuming procedure
+ --      actually returns almost immediately thus ensuring that it completes
+ --      first.  At the conclusion, if a substantial amount of time has passed
+ --      the delay is assumed not to have been cancelled. 
+ --      (based on example in LRM 9.7.4)
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ with Report;
+ with Ada.Calendar;
+          
+ procedure C974014 is
+ 
+    function "-" (Left, Right : Ada.Calendar.Time)
+                               return Duration      renames Ada.Calendar."-";
+ 
+    TC_Start_Time      : Ada.Calendar.Time := Ada.Calendar.Clock;
+    TC_Elapsed_Time    : duration;
+ 
+    Maximum_Allowable_Time : duration := 300.0; -- for Calculate_Gamma_Function
+ 
+ begin
+ 
+    Report.Test ("C974014", "ATC: When abortable part completes before " &
+                              "a triggering delay, check that the delay " &
+                              "is cancelled & optional statements " &
+                              "are not performed"); 
+ 
+    declare  -- encapsulate test code
+ 
+       type Gamma_Index is digits 5;   -- float precision
+ 
+       -- (These two fields are assumed filled elsewhere)
+       Input_Field, Result_of_Beta : Gamma_Index;   
+ 
+       -- Notify and take corrective action in the event that
+       -- the procedure Calculate_Gamma_Function does not converge.
+       --
+       procedure Non_Convergent is
+       begin
+          null;  -- stub
+ 
+          Report.Failed ("Optional statements in triggering part" &
+                                     " were performed");       
+       end Non_Convergent;
+ 
+ 
+       --  This is a very time consuming calculation.  It is possible,
+       --  that, with certain parameters, it will not converge.  If it
+       --  runs for more than Maximum_Allowable_Time it is considered
+       --  not to be convergent and should be aborted.
+       --
+       Procedure Calculate_Gamma_Function (X, Y : Gamma_Index) is
+       begin
+          null;  -- Stub
+          --
+       end Calculate_Gamma_Function;
+ 
+    begin  -- declare
+ 
+       -- .....  Isolated segment of inline code
+ 
+       -- Now Print Gamma Function (abort and display if not convergent)
+       --
+       select
+          delay Maximum_Allowable_Time;  -- for Calculate_Gamma_Function
+          Non_Convergent;   -- Display error and flag result as failed
+ 
+       then abort
+          Calculate_Gamma_Function (Input_Field, Result_of_Beta);
+       end select;
+ 
+       -- .....  End of Isolated segment of inline code
+ 
+    end; -- declare
+    
+    TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;
+ 
+    -- Note: We are not checking for "cancellation within a reasonable time",
+    -- we are checking for cancellation/non-cancellation of the delay.  We
+    -- use a number which, if exceeded, means that the delay was not
+    -- cancelled and has proceeded to  full term.
+    --
+    if ( TC_Elapsed_Time > Maximum_Allowable_Time/2 ) then
+       -- Test time exceeds a reasonable value.
+       Report.Failed ("Triggering delay statement was not cancelled");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end C974014;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c980001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c980001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c980001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c980001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,303 ----
+ -- C980001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that when a construct is aborted the execution of an Initialize
+ --      procedure as the last step of the default initialization of a
+ --      controlled object is abort-deferred.
+ --     
+ --      Check that when a construct is aborted the execution of a Finalize
+ --      procedure as part of the finalization of a controlled object is
+ --      abort-deferred.
+ --     
+ --      Check that an assignment operation to an object with a controlled
+ --      part is an abort-deferred operation.
+ --
+ -- TEST DESCRIPTION:
+ --      The controlled operations which are being tested call a subprogram
+ --      which guarantees that the enclosing operation becomes aborted.
+ --
+ --      Each object is created with a unique value to prevent optimizations
+ --      due to the values being the same.
+ --
+ --      Two protected objects are utilized to warrant that the operations
+ --      are delayed in their execution until such time that the abort is
+ --      processed.  The object Hold_Up is used to hold the targeted
+ --      operation in execution, the object Progress is used to communicate
+ --      to the driver software that progress is indeed being made. 
+ --
+ --
+ -- CHANGE HISTORY:
+ --      01 MAY 95   SAIC    Initial version
+ --      01 MAY 96   SAIC    Revised for 2.1
+ --      11 DEC 96   SAIC    Final revision for 2.1
+ --      02 DEC 97   EDS     Remove 2 calls to C980001_0.Hold_Up.Lock
+ --!
+ 
+ ---------------------------------------------------------------- C980001_0
+ 
+ with Impdef;
+ with Ada.Finalization;
+ package C980001_0 is
+ 
+   A_Little_While : constant Duration := Impdef.Switch_To_New_Task * 2.0;
+   Enough_Time_For_The_Controlled_Operation_To_Happen : constant Duration
+    := Impdef.Switch_To_New_Task * 4.0;
+ 
+   function TC_Unique return Integer;
+ 
+   type Sticks_In_Initialize is new Ada.Finalization.Controlled with record
+     Item: Integer := TC_Unique;
+   end record;
+   procedure Initialize( AV: in out Sticks_In_Initialize );
+ 
+   type Sticks_In_Adjust is new Ada.Finalization.Controlled with record
+     Item: Integer := TC_Unique;
+   end record;
+   procedure Adjust    ( AV: in out Sticks_In_Adjust );
+ 
+   type Sticks_In_Finalize is new Ada.Finalization.Controlled with record
+     Item: Integer := TC_Unique;
+   end record;
+   procedure Finalize  ( AV: in out Sticks_In_Finalize );
+ 
+   Initialize_Called : Boolean := False;
+   Adjust_Called     : Boolean := False;
+   Finalize_Called   : Boolean := False;
+ 
+   protected type Sticker is
+     entry Lock;
+     procedure Unlock;
+     function Is_Locked return Boolean;
+   private
+     Locked : Boolean := False;
+   end Sticker;
+ 
+   Hold_Up  : Sticker;
+   Progress : Sticker;
+ 
+   procedure Fail_And_Clear( Message : String );
+ 
+ 
+ end C980001_0;
+  
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with TCTouch;
+ package body C980001_0 is
+ 
+   TC_Master_Value : Integer := 0;
+ 
+ 
+   function TC_Unique return Integer is  -- make all values unique.
+   begin
+     TC_Master_Value := TC_Master_Value +1;
+     return TC_Master_Value;
+   end TC_Unique;
+ 
+   protected body Sticker is
+ 
+     entry Lock when not Locked is
+     begin
+       Locked := True;
+     end Lock;
+ 
+     procedure Unlock is
+     begin
+       Locked := False;
+     end Unlock;
+ 
+     function Is_Locked return Boolean is
+     begin
+       return Locked;
+     end Is_Locked;
+ 
+   end Sticker;
+ 
+   procedure Initialize( AV: in out Sticks_In_Initialize ) is
+   begin
+     TCTouch.Touch('I');  -------------------------------------------------- I
+     Hold_Up.Unlock;               -- cause the select to abort
+     Initialize_Called := True;
+     AV.Item := TC_Unique;
+     TCTouch.Touch('i');  -------------------------------------------------- i
+     Progress.Unlock;              -- allows Wait_Your_Turn to continue
+   end Initialize;
+ 
+   procedure Adjust    ( AV: in out Sticks_In_Adjust ) is
+   begin
+     TCTouch.Touch('A');  -------------------------------------------------- A
+     Hold_Up.Unlock;               -- cause the select to abort
+     Adjust_Called := True;
+     AV.Item := TC_Unique;
+     TCTouch.Touch('a');  -------------------------------------------------- a
+     Progress.Unlock;
+   end Adjust;
+ 
+   procedure Finalize  ( AV: in out Sticks_In_Finalize ) is
+   begin
+     TCTouch.Touch('F');  -------------------------------------------------- F
+     Hold_Up.Unlock;               -- cause the select to abort
+     Finalize_Called := True;
+     AV.Item := TC_Unique;
+     TCTouch.Touch('f');  -------------------------------------------------- f
+     Progress.Unlock;
+   end Finalize;
+ 
+   procedure Fail_And_Clear( Message : String ) is
+   begin
+     Report.Failed(Message);
+     Hold_Up.Unlock;
+     Progress.Unlock;
+   end Fail_And_Clear;
+ 
+ end C980001_0;
+  
+ ---------------------------------------------------------------------------
+ 
+ with Report;
+ with TCTouch;
+ with Impdef;
+ with C980001_0;
+ procedure C980001 is
+ 
+   procedure Check_Initialize_Conditions is
+   begin
+     if not C980001_0.Initialize_Called then
+       C980001_0.Fail_And_Clear("Initialize did not correctly complete");
+     end if;
+     TCTouch.Validate("Ii", "Initialization Sequence");
+   end Check_Initialize_Conditions;
+ 
+   procedure Check_Adjust_Conditions is
+   begin
+     if not C980001_0.Adjust_Called then
+       C980001_0.Fail_And_Clear("Adjust did not correctly complete");
+     end if;
+     TCTouch.Validate("Aa", "Adjust Sequence");
+   end Check_Adjust_Conditions;
+ 
+   procedure Check_Finalize_Conditions is
+   begin
+     if not C980001_0.Finalize_Called then
+       C980001_0.Fail_And_Clear("Finalize did not correctly complete");
+     end if;
+     TCTouch.Validate("FfFfFf", "Finalization Sequence",
+                      Order_Meaningful => False);
+   end Check_Finalize_Conditions;
+ 
+   procedure Wait_Your_Turn is
+     Overrun : Natural := 0;
+   begin
+     while C980001_0.Progress.Is_Locked loop  -- and waits
+       delay C980001_0.A_Little_While;
+       Overrun := Overrun +1;
+       if Overrun > 10 then  
+         C980001_0.Fail_And_Clear("Overrun expired lock");
+       end if;
+     end loop;
+   end Wait_Your_Turn;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C980001", "Check the interaction between asynchronous " &
+                           "transfer of control and controlled types" );
+ 
+   C980001_0.Progress.Lock;
+   C980001_0.Hold_Up.Lock;
+ 
+   select
+     C980001_0.Hold_Up.Lock;  -- Init will unlock
+ 
+     Wait_Your_Turn;  -- abortable part is stuck in Initialize
+     Check_Initialize_Conditions;
+ 
+   then abort
+     declare
+       Object : C980001_0.Sticks_In_Initialize;
+     begin
+       delay Impdef.Minimum_Task_Switch;
+       if Report.Ident_Int( Object.Item ) /= Object.Item then
+         Report.Failed("Optimization foil caused failure");
+       end if;
+       C980001_0.Fail_And_Clear(
+                            "Initialize test executed beyond expected region");
+     end;
+   end select;
+ 
+   C980001_0.Progress.Lock;
+ 
+   select
+     C980001_0.Hold_Up.Lock;  -- Adjust will unlock
+ 
+     Wait_Your_Turn;  -- abortable part is stuck in Adjust
+     Check_Adjust_Conditions;
+ 
+   then abort
+     declare
+       Object1 : C980001_0.Sticks_In_Adjust;
+       Object2 : C980001_0.Sticks_In_Adjust;
+     begin
+       Object1 := Object2;
+       delay Impdef.Minimum_Task_Switch;
+       if Report.Ident_Int( Object2.Item )
+          /= Report.Ident_Int( Object1.Item ) then
+         Report.Failed("Optimization foil 1 caused failure");
+       end if;
+       C980001_0.Fail_And_Clear("Adjust test executed beyond expected region");
+     end;
+   end select;
+ 
+   C980001_0.Progress.Lock;
+ 
+   select
+     C980001_0.Hold_Up.Lock;  -- Finalize will unlock
+ 
+     Wait_Your_Turn;  -- abortable part is stuck in Finalize
+     Check_Finalize_Conditions;
+ 
+   then abort
+     declare
+       Object1 : C980001_0.Sticks_In_Finalize;
+       Object2 : C980001_0.Sticks_In_Finalize;
+     begin
+       Object1 := Object2;  -- cause a finalize call
+       delay Impdef.Minimum_Task_Switch;
+       if Report.Ident_Int( Object2.Item )
+          /= Report.Ident_Int( Object1.Item ) then
+         Report.Failed("Optimization foil 2 caused failure");
+       end if;
+       C980001_0.Fail_And_Clear(
+                              "Finalize test executed beyond expected region");
+     end;
+   end select;
+ 
+   Report.Result;
+ 
+ exception
+   when others => C980001_0.Fail_And_Clear("Exception in main");
+                  Report.Result;
+ end C980001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c980002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c980002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c980002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c980002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,165 ----
+ -- C980002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that aborts are deferred during protected actions.
+ --
+ -- TEST DESCRIPTION:
+ --      This test uses an asynchronous transfer of control to attempt
+ --      to abort a protected operation.  The protected operation
+ --      includes several requeues to check that the requeue does not
+ --      allow the abort to occur.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      30 OCT 95   SAIC    ACVC 2.1
+ --
+ --!
+ 
+ with Report;
+ procedure C980002 is
+ 
+   Max_Checkpoints : constant := 7;
+   type Checkpoint_ID is range 1..Max_Checkpoints;
+   type Points_Array is array (Checkpoint_ID) of Boolean;
+ begin
+   Report.Test ("C980002",
+                "Check that aborts are deferred during a protected action" &
+                " including requeues");
+ 
+   declare -- test encapsulation
+ 
+     protected Checkpoint is
+        procedure Got_Here (Id : Checkpoint_ID);
+        function Results return Points_Array;
+     private
+        Reached_Points : Points_Array := (others => False);
+     end Checkpoint;
+ 
+     protected body Checkpoint is
+        procedure Got_Here (Id : Checkpoint_ID) is
+        begin
+           Reached_Points (Id) := True;
+        end Got_Here;
+ 
+        function Results return Points_Array is
+        begin
+           return Reached_Points;
+        end Results;
+     end Checkpoint;
+ 
+ 
+     protected Start_Here is
+        entry AST_Waits_Here;
+        entry Start_PO;
+     private
+        Open : Boolean := False;
+        entry First_Stop;
+     end Start_Here;
+ 
+     protected Middle_PO is
+        entry Stop_1;
+        entry Stop_2;
+     end Middle_PO;
+ 
+     protected Final_PO is
+        entry Final_Stop;
+     end Final_PO;
+ 
+ 
+     protected body Start_Here is
+        entry AST_Waits_Here when Open is
+        begin
+           null;
+        end AST_Waits_Here;
+ 
+        entry Start_PO when True is
+        begin
+           Open := True;
+           Checkpoint.Got_Here (1);
+           requeue First_Stop; 
+        end Start_PO;
+ 
+        -- make sure the AST has been accepted before continuing
+        entry First_Stop when AST_Waits_Here'Count = 0 is
+        begin
+           Checkpoint.Got_Here (2);
+           requeue Middle_PO.Stop_1;
+        end First_Stop;
+     end Start_Here;
+ 
+     protected body Middle_PO is
+        entry Stop_1 when True is
+        begin
+           Checkpoint.Got_Here (3);
+           requeue Stop_2;
+        end Stop_1;
+ 
+        entry Stop_2 when True is
+        begin
+           Checkpoint.Got_Here (4);
+           requeue Final_PO.Final_Stop;
+        end Stop_2;
+     end Middle_PO;
+ 
+     protected body Final_PO is
+        entry Final_Stop when True is
+        begin
+           Checkpoint.Got_Here (5);
+        end Final_Stop;
+     end Final_PO;
+ 
+ 
+   begin   -- test encapsulation
+     select
+        Start_Here.AST_Waits_Here;
+        Checkpoint.Got_Here (6);
+     then abort
+        Start_Here.Start_PO;
+        delay 0.0;  -- abort completion point
+        Checkpoint.Got_Here (7);
+     end select;
+ 
+     Check_The_Results: declare
+        Chk : constant Points_Array := Checkpoint.Results;
+        Expected : constant Points_Array :=  (1..6 => True,
+                                              7    => False);
+     begin
+        for I in Checkpoint_ID loop
+           if Chk (I) /= Expected (I) then
+              Report.Failed ("checkpoint error" &
+                             Checkpoint_ID'Image (I) &
+                             " actual is " &
+                             Boolean'Image (Chk(I)));
+           end if;         
+        end loop; 
+     end Check_The_Results;
+   exception
+     when others =>
+        Report.Failed ("unexpected exception");
+   end;    -- test encapsulation
+   
+   Report.Result;
+ end C980002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c980003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c980003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c980003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c980003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,294 ----
+ -- C980003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- TEST OBJECTIVE:
+ --      Check that aborts are deferred during the execution of an 
+ --      Initialize procedure (as the last step of the default 
+ --      initialization of a controlled object), during the execution 
+ --      of a Finalize procedure (as part of the finalization of a 
+ --      controlled object), and during an assignment operation to an
+ --      object with a controlled part.
+ --
+ -- TEST DESCRIPTION:
+ --      A controlled type is created with Initialize, Adjust, and 
+ --      Finalize operations.  These operations note in a protected
+ --      object when the operation starts and completes.  This change
+ --      in state of the protected object will open the barrier for
+ --      the entry in the protected object.
+ --      The test contains declarations of objects of the controlled
+ --      type.  An asynchronous select is used to attempt to abort
+ --      the operations on the controlled type.  The asynchronous select
+ --      makes use of the state change to the protected object to 
+ --      trigger the abort.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      11 Jan 96   SAIC    Initial Release for 2.1
+ --       5 May 96   SAIC    Incorporated Reviewer comments.
+ --      10 Oct 96   SAIC    Addressed issue where assignment statement
+ --                          can be 2 assignment operations.
+ --
+ --!
+ 
+ with Ada.Finalization;
+ package C980003_0 is
+     Verbose : constant Boolean := False;
+ 
+     -- the following flag is set true whenever the
+     -- Initialize operation is called.
+     Init_Occurred : Boolean;
+ 
+     type Is_Controlled is new Ada.Finalization.Controlled with
+          record
+              Id : Integer;
+          end record;
+ 
+      procedure Initialize (Object : in out Is_Controlled);
+      procedure Finalize   (Object : in out Is_Controlled);
+      procedure Adjust     (Object : in out Is_Controlled);
+ 
+      type States is (Unknown,
+                      Start_Init,   Finished_Init, 
+                      Start_Adjust, Finished_Adjust,
+                      Start_Final,  Finished_Final);
+ 
+      protected State_Manager is
+         procedure Reset;
+         procedure Set (New_State : States);
+         function Current return States;
+         entry Wait_For_Change;
+      private
+         Current_State : States := Unknown;
+         Changed : Boolean := False;
+      end State_Manager;
+ 
+ end C980003_0;
+ 
+ 
+ with Report;
+ with ImpDef;
+ package body C980003_0 is
+      protected body State_Manager is
+          procedure Reset is
+          begin
+              Current_State := Unknown;
+              Changed := False;
+          end Reset;
+ 
+          procedure Set (New_State : States) is
+          begin
+              Changed := True;
+              Current_State := New_State;
+          end Set;
+ 
+          function Current return States is
+          begin
+              return Current_State;
+          end Current;
+ 
+          entry Wait_For_Change when Changed is
+          begin
+              Changed := False;
+          end Wait_For_Change;
+      end State_Manager;
+ 
+      procedure Initialize (Object : in out Is_Controlled) is
+      begin
+         if Verbose then
+             Report.Comment ("starting initialize");
+         end if;
+         State_Manager.Set (Start_Init);
+         if Verbose then
+             Report.Comment ("in initialize");
+         end if;
+         delay ImpDef.Switch_To_New_Task;  -- tempting place for abort
+         State_Manager.Set (Finished_Init);
+         if Verbose then
+             Report.Comment ("finished initialize");
+         end if;
+         Init_Occurred := True;
+      end Initialize;
+ 
+      procedure Finalize   (Object : in out Is_Controlled) is
+      begin
+         if Verbose then
+             Report.Comment ("starting finalize");
+         end if;
+         State_Manager.Set (Start_Final);
+         if Verbose then
+             Report.Comment ("in finalize");
+         end if;
+         delay ImpDef.Switch_To_New_Task; -- tempting place for abort
+         State_Manager.Set (Finished_Final);
+         if Verbose then
+             Report.Comment ("finished finalize");
+         end if;
+      end Finalize;
+ 
+      procedure Adjust     (Object : in out Is_Controlled) is
+      begin
+         if Verbose then
+             Report.Comment ("starting adjust");
+         end if;
+         State_Manager.Set (Start_Adjust);
+         if Verbose then
+             Report.Comment ("in adjust");
+         end if;
+         delay ImpDef.Switch_To_New_Task; -- tempting place for abort
+         State_Manager.Set (Finished_Adjust);
+         if Verbose then
+             Report.Comment ("finished adjust");
+         end if;
+      end Adjust;
+ end C980003_0;
+ 
+ 
+ with Report;
+ with ImpDef;
+ with C980003_0;  use C980003_0;
+ with Ada.Unchecked_Deallocation;
+ procedure C980003 is
+ 
+     procedure Check_State (Should_Be : States;
+                            Msg       : String) is
+         Cur : States := State_Manager.Current;
+     begin
+         if Cur /= Should_Be then
+             Report.Failed (Msg);
+             Report.Comment ("expected: " & States'Image (Should_Be) &
+                             "  found: " & States'Image (Cur));
+         elsif Verbose then
+             Report.Comment ("passed: " & Msg);
+         end if;
+     end Check_State;
+ 
+ begin
+  
+     Report.Test ("C980003", "Check that aborts are deferred during" &
+                             " initialization, finalization, and assignment" &
+                             " operations on controlled objects");
+ 
+     Check_State (Unknown, "initial condition");
+ 
+     -- check that initialization and finalization take place
+     Init_Occurred := False;
+     select
+         State_Manager.Wait_For_Change;
+     then abort
+         declare
+             My_Controlled_Obj : Is_Controlled;
+         begin
+             delay 0.0;   -- abort completion point
+             Report.Failed ("state change did not occur");
+         end; 
+     end select;
+     if not Init_Occurred then
+         Report.Failed ("Initialize did not complete");
+     end if;
+     Check_State (Finished_Final, "init/final for declared item");
+ 
+     -- check adjust
+     State_Manager.Reset;
+     declare
+         Source, Dest : Is_Controlled;
+     begin
+         Check_State (Finished_Init, "adjust initial state");
+         Source.Id := 3;
+         Dest.Id := 4;
+         State_Manager.Reset;  -- so we will wait for change
+         select
+             State_Manager.Wait_For_Change;
+         then abort
+             Dest := Source;
+         end select;
+ 
+         -- there are two implementation methods for the 
+         -- assignment statement:
+         --   1.  no temporary was used in the assignment statement 
+         --        thus the entire
+         --        assignment statement is abort deferred.  
+         --   2.  a temporary was used in the assignment statement so
+         --        there are two assignment operations.  An abort may
+         --        occur between the assignment operations
+         -- Various optimizations are allowed by 7.6 that can affect
+         -- how many times Adjust and Finalize are called. 
+         -- Depending upon the implementation, the state can be either
+         -- Finished_Adjust or Finished_Finalize.   If it is any other
+         -- state then the abort took place at the wrong time.
+ 
+         case State_Manager.Current is
+         when Finished_Adjust =>
+             if Verbose then
+                 Report.Comment ("assignment aborted after adjust");
+             end if;
+         when Finished_Final =>
+             if Verbose then
+                 Report.Comment ("assignment aborted after finalize");
+             end if;
+         when Start_Adjust =>
+             Report.Failed ("assignment aborted in adjust");
+         when Start_Final =>
+             Report.Failed ("assignment aborted in finalize");
+         when Start_Init =>
+             Report.Failed ("assignment aborted in initialize");
+         when Finished_Init =>
+             Report.Failed ("assignment aborted after initialize");
+         when Unknown =>
+             Report.Failed ("assignment aborted in unknown state");
+         end case;
+ 
+ 
+         if Dest.Id /= 3 then
+             if Verbose then
+                 Report.Comment ("assignment not performed");
+             end if;
+         end if;
+     end;
+ 
+ 
+      -- check dynamically allocated objects
+     State_Manager.Reset;
+     declare
+         type Pointer_Type is access Is_Controlled;
+         procedure Free is new Ada.Unchecked_Deallocation (
+               Is_Controlled, Pointer_Type);
+         Ptr : Pointer_Type;
+     begin
+       -- make sure initialize is done when object is allocated
+       Ptr := new Is_Controlled;
+       Check_State (Finished_Init, "init when item allocated");
+       -- now try aborting the finalize
+       State_Manager.Reset;
+       select
+              State_Manager.Wait_For_Change;
+       then abort
+              Free (Ptr);
+       end select;
+       Check_State (Finished_Final, "finalization in dealloc");
+     end;
+ 
+     Report.Result;
+  
+ end C980003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c99004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c99004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c99004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c99004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,166 ----
+ -- C99004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE PREFIX OF 'TERMINATED AND 'CALLABLE CAN BE A
+ --     FUNCTION CALL RETURNING AN OBJECT HAVING A TASK TYPE.
+ 
+ --     NOTE: SEE TEST C38202A FOR CHECKS INVOLVING PREFIXES WHICH ARE
+ --     ACCESS TYPES DENOTING TASK TYPES OR WHICH ARE FUNCTIONS
+ --     RETURNING ACCESS TYPES DENOTING TASK TYPES.
+ 
+ -- HISTORY:
+ --     RJW 09/16/86 CREATED ORIGINAL TEST.
+ --     DHH 10/15/87 CORRECTED HEADER COMMENTS.
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C99004A IS
+ 
+      TYPE ENUM IS (A, B, C, D);
+ 
+      EARRAY : ARRAY (ENUM) OF STRING (1 .. 17) :=
+                                         (A => "BEFORE ACTIVATION",
+                                          B => "DURING ACTIVATION",
+                                          C => "DURING EXECUTION ",
+                                          D => "AFTER TERMINATION" );
+ 
+      FUNCTION CHECK (S : STRING; CALL, B1, TERM, B2 : BOOLEAN;
+                      E : ENUM) RETURN BOOLEAN IS
+      BEGIN
+           IF CALL /= B1 THEN
+                FAILED ( "INCORRECT VALUE FOR " & S & "'CALLABLE " &
+                          EARRAY (E) & " OF TASK" );
+           END IF;
+ 
+           IF TERM /= B2 THEN
+                FAILED ( "INCORRECT VALUE FOR " & S & "'TERMINATED " &
+                          EARRAY (E) & " OF TASK" );
+           END IF;
+ 
+           RETURN IDENT_BOOL (TRUE);
+      END CHECK;
+ 
+ 
+ BEGIN
+      TEST ( "C99004A", "CHECK THAT THE PREFIX OF 'TERMINATED AND " &
+                        "'CALLABLE CAN BE A FUNCTION CALL RETURNING " &
+                        "AN OBJECT HAVING A TASK TYPE" );
+ 
+      DECLARE
+ 
+           TASK TYPE TT IS
+                ENTRY E;
+           END TT;
+ 
+           PACKAGE PKG1 IS
+                T1 : TT;
+           END PKG1;
+ 
+           FUNCTION F RETURN TT IS
+           BEGIN
+                RETURN PKG1.T1;
+           END F;
+ 
+           PACKAGE PKG2 IS
+                A1 : BOOLEAN := CHECK ("F", F'CALLABLE, TRUE,
+                                       F'TERMINATED, FALSE, A);
+           END PKG2;
+ 
+           TASK MAIN_TASK IS
+                ENTRY E (INTEGER RANGE 1 .. 2);
+           END MAIN_TASK;
+ 
+           TASK BODY TT IS
+                B1 : BOOLEAN := CHECK ("F", F'CALLABLE, TRUE,
+                                       F'TERMINATED, FALSE, B);
+                C1 : BOOLEAN;
+           BEGIN
+                C1 := CHECK ("F", F'CALLABLE, TRUE,
+                             F'TERMINATED, FALSE, C);
+                MAIN_TASK.E (1);
+                MAIN_TASK.E (2);
+           END TT;
+ 
+           PACKAGE BODY PKG1 IS
+           BEGIN
+                NULL;
+           END;
+ 
+           TASK BODY MAIN_TASK IS
+                D1 : BOOLEAN;
+           BEGIN
+                ACCEPT E (1);
+                ABORT PKG1.T1;
+                DELAY 5.0 * Impdef.One_Long_Second;
+                D1 := CHECK ("F", F'CALLABLE, FALSE,
+                              F'TERMINATED, TRUE, D);
+           END MAIN_TASK;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE
+ 
+           TASK TYPE TT IS
+                ENTRY E;
+           END TT;
+ 
+           T2 : TT;
+ 
+           A2 : BOOLEAN := CHECK ("T2", T2'CALLABLE, TRUE,
+                                   T2'TERMINATED, FALSE, A);
+ 
+           TASK MAIN_TASK IS
+                ENTRY E (INTEGER RANGE 1 .. 2);
+           END MAIN_TASK;
+ 
+           TASK BODY TT IS
+                B2 : BOOLEAN := CHECK ("T2", T2'CALLABLE, TRUE,
+                                        T2'TERMINATED, FALSE, B);
+                C2 : BOOLEAN;
+           BEGIN
+                C2 := CHECK ("T2", T2'CALLABLE, TRUE,
+                              T2'TERMINATED, FALSE, C);
+                MAIN_TASK.E (1);
+                MAIN_TASK.E (2);
+           END TT;
+ 
+           TASK BODY MAIN_TASK IS
+                D2 : BOOLEAN;
+           BEGIN
+                ACCEPT E (1);
+                ABORT T2;
+                DELAY 5.0 * Impdef.One_Long_Second;
+                D2 := CHECK ("T2", T2'CALLABLE, FALSE,
+                              T2'TERMINATED, TRUE, D);
+           END MAIN_TASK;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C99004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c99005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c99005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c99005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c99005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- C99005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ATTRIBUTE 'COUNT RETURNS THE CORRECT VALUE.
+ 
+ -- HISTORY:
+ --     DHH 03/24/88 CREATED ORIGINAL TEST.
+ 
+ with Impdef;
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C99005A IS
+ 
+ BEGIN
+ 
+      TEST("C99005A", "CHECK THAT THE ATTRIBUTE 'COUNT RETURNS THE " &
+                      "CORRECT VALUE");
+ 
+      DECLARE
+           TASK A IS
+           END A;
+ 
+           TASK B IS
+           END B;
+ 
+           TASK C IS
+           END C;
+ 
+           TASK D IS
+           END D;
+ 
+           TASK E IS
+           END E;
+ 
+           TASK F IS
+           END F;
+ 
+           TASK G IS
+           END G;
+ 
+           TASK H IS
+           END H;
+ 
+           TASK I IS
+           END I;
+ 
+           TASK J IS
+           END J;
+ 
+           TASK T IS
+                ENTRY WAIT;
+           END T;
+ 
+           TASK CHOICE IS
+                ENTRY RETURN_CALL;
+                ENTRY E2;
+                ENTRY E1;
+           END CHOICE;
+ 
+           TASK BODY A IS
+           BEGIN
+                CHOICE.E1;
+           END A;
+ 
+           TASK BODY B IS
+           BEGIN
+                CHOICE.E1;
+           END B;
+ 
+           TASK BODY C IS
+           BEGIN
+                CHOICE.E1;
+           END C;
+ 
+           TASK BODY D IS
+           BEGIN
+                CHOICE.E1;
+           END D;
+ 
+           TASK BODY E IS
+           BEGIN
+                CHOICE.E1;
+           END E;
+ 
+           TASK BODY F IS
+           BEGIN
+                CHOICE.E2;
+           END F;
+ 
+           TASK BODY G IS
+           BEGIN
+                CHOICE.E2;
+           END G;
+ 
+           TASK BODY H IS
+           BEGIN
+                CHOICE.E2;
+           END H;
+ 
+           TASK BODY I IS
+           BEGIN
+                CHOICE.E2;
+           END I;
+ 
+           TASK BODY J IS
+           BEGIN
+                CHOICE.E2;
+           END J;
+ 
+           TASK BODY T IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT WAIT DO
+                               DELAY 1.0 * Impdef.One_Second;
+                          END WAIT;
+                          CHOICE.RETURN_CALL;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END T;
+ 
+           TASK BODY CHOICE IS
+           BEGIN
+                WHILE E1'COUNT + E2'COUNT < 10 LOOP
+                     T.WAIT;
+                     ACCEPT RETURN_CALL;
+                END LOOP;
+ 
+                FOR I IN REVERSE 1 ..10 LOOP
+                     SELECT
+                          ACCEPT E2 DO
+                               IF (E2'COUNT + E1'COUNT + 1) /= I THEN
+                                    FAILED("'COUNT NOT RETURNING " &
+                                           "CORRECT VALUE FOR LOOP" &
+                                            INTEGER'IMAGE(I) & "VALUE " &
+                                            INTEGER'IMAGE((E2'COUNT
+                                            + E1'COUNT + 1)));
+                               END IF;
+                          END E2;
+                     OR
+                          ACCEPT E1 DO
+                               IF (E2'COUNT + E1'COUNT + 1) /= I THEN
+                                    FAILED("'COUNT NOT RETURNING " &
+                                           "CORRECT VALUE FOR LOOP" &
+                                            INTEGER'IMAGE(I) & "VALUE " &
+                                            INTEGER'IMAGE((E2'COUNT
+                                            + E1'COUNT + 1)));
+                               END IF;
+                          END E1;
+                     END SELECT;
+                END LOOP;
+            END CHOICE;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END C99005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- C9A003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ABORTING A TERMINATED TASK DOES NOT CAUSE EXCEPTIONS.
+ 
+ 
+ -- RM 5/21/82
+ -- SPS 11/21/82
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X
+ 
+ with Impdef;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE  C9A003A  IS
+ 
+      -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
+ 
+ BEGIN
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      TEST ("C9A003A", "CHECK THAT  ABORTING A TERMINATED TASK" &
+                       "  DOES NOT CAUSE EXCEPTIONS"   );
+ 
+   
+      DECLARE
+ 
+ 
+           TASK TYPE  T_TYPE  IS
+ 
+ 
+                ENTRY  E ;
+ 
+           END  T_TYPE ;
+ 
+ 
+           T_OBJECT1 : T_TYPE ;
+ 
+ 
+           TASK BODY  T_TYPE  IS
+                BUSY : BOOLEAN := FALSE ;
+           BEGIN
+ 
+                NULL;
+ 
+           END  T_TYPE ;
+ 
+ 
+      BEGIN
+ 
+ 
+           IF NOT  T_OBJECT1'TERMINATED  THEN
+                DELAY  20.0 * Impdef.One_Second;
+           END IF;
+ 
+           IF NOT  T_OBJECT1'TERMINATED  THEN
+                COMMENT( "TASK NOT YET TERMINATED (AFTER 20 S.)" );
+           END IF;
+ 
+ 
+           BEGIN
+                ABORT T_OBJECT1 ;
+           EXCEPTION
+ 
+                WHEN  OTHERS  =>
+                     FAILED(  "EXCEPTION RAISED (WHEN ABORTING A" &
+                              "  TERMINATED TASK)"  );
+ 
+           END ;
+ 
+ 
+      END ;
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C9A003A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- C9A004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A TASK IS ABORTED BEFORE BEING ACTIVATED, THE TASK IS
+ --     TERMINATED.
+ 
+ 
+ -- RM 5/21/82
+ -- SPS 11/21/82
+ -- JBG 6/3/85
+ -- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE  C9A004A  IS
+ 
+ BEGIN
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      TEST ("C9A004A", "CHECK THAT IF A TASK IS ABORTED"  &
+                       " BEFORE BEING ACTIVATED,"         &
+                       "  THE TASK IS TERMINATED"         );
+ 
+   
+      DECLARE
+ 
+ 
+           TASK TYPE  T_TYPE  IS
+ 
+ 
+                ENTRY  E ;
+ 
+           END  T_TYPE ;
+ 
+ 
+           T_OBJECT1 : T_TYPE ;
+ 
+ 
+           TASK BODY  T_TYPE  IS
+                BUSY : BOOLEAN := FALSE ;
+           BEGIN
+ 
+                NULL;
+ 
+           END  T_TYPE ;
+ 
+ 
+           PACKAGE  P  IS
+                X : INTEGER := 0 ;
+           END  P ;
+ 
+ 
+           PACKAGE BODY  P  IS
+           BEGIN
+ 
+                IF      T_OBJECT1'TERMINATED  OR
+                    NOT T_OBJECT1'CALLABLE
+                THEN
+                     FAILED( "WRONG VALUES FOR ATTRIBUTES" );
+                END IF;
+ 
+                ABORT  T_OBJECT1 ;  -- ELABORATED BUT NOT YET ACTIVATED.
+ 
+           END  P ;
+ 
+ 
+      BEGIN
+ 
+ 
+           IF NOT  T_OBJECT1'TERMINATED  THEN
+                FAILED(  "ABORTED (BEFORE ACTIVATION) TASK"  &
+                         "  NOT TERMINATED"  );
+           END IF;
+ 
+      EXCEPTION
+ 
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED");
+ 
+      END;
+ 
+      RESULT;
+ 
+ END C9A004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,293 ----
+ -- C9A007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK MAY ABORT A TASK IT DEPENDS ON.
+ 
+ 
+ -- RM 5/26/82
+ -- RM 7/02/82
+ -- SPS 11/21/82
+ -- JBG 2/27/84
+ -- JBG 3/8/84
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ -- EDS 08/04/98 ENSURE THAT ABORTED TASKS HAVE TIME TO EFFECT THEIR ABORTIONS.
+ 
+ WITH IMPDEF;
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE  C9A007A  IS
+ 
+       TASK_NOT_ABORTED : BOOLEAN := FALSE; 
+       TEST_VALID       : BOOLEAN := TRUE ; 
+ 
+ BEGIN
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      TEST ( "C9A007A" , "CHECK THAT A TASK MAY ABORT A TASK" &
+                         " IT DEPENDS ON"                     );
+ 
+   
+      DECLARE
+ 
+ 
+           TASK  REGISTER  IS
+ 
+ 
+                ENTRY  BIRTHS_AND_DEATHS; 
+ 
+                ENTRY  SYNC1; 
+                ENTRY  SYNC2; 
+ 
+ 
+           END  REGISTER; 
+ 
+ 
+           TASK BODY  REGISTER  IS
+ 
+ 
+                TASK TYPE  SECONDARY  IS
+ 
+ 
+                     ENTRY  WAIT_INDEFINITELY; 
+ 
+                END  SECONDARY; 
+ 
+ 
+                TASK TYPE  T_TYPE1  IS
+ 
+ 
+                     ENTRY  E; 
+ 
+                END  T_TYPE1; 
+ 
+ 
+                TASK TYPE  T_TYPE2  IS
+ 
+ 
+                     ENTRY  E; 
+ 
+                END  T_TYPE2; 
+ 
+ 
+                T_OBJECT1 : T_TYPE1; 
+                T_OBJECT2 : T_TYPE2; 
+ 
+ 
+                TASK BODY  SECONDARY  IS
+                BEGIN
+                     SYNC1; 
+                     ABORT  T_OBJECT1; 
+                     DELAY 0.0; 
+                     TASK_NOT_ABORTED  :=  TRUE; 
+                END  SECONDARY; 
+ 
+ 
+                TASK BODY  T_TYPE1  IS
+ 
+                     TYPE  ACCESS_TO_TASK  IS  ACCESS SECONDARY; 
+   
+                BEGIN
+ 
+ 
+                     DECLARE
+                          DEPENDENT_BY_ACCESS   :  ACCESS_TO_TASK  :=
+                                                   NEW  SECONDARY ; 
+                     BEGIN
+                          NULL;
+                     END; 
+ 
+ 
+                     BIRTHS_AND_DEATHS; 
+                                      -- DURING THIS SUSPENSION
+                                      --     MOST OF THE TASKS
+                                      --     ARE ABORTED   (FIRST
+                                      --     TASK #1    -- T_OBJECT1 --
+                                      --     THEN  #2 ).
+ 
+ 
+                     TASK_NOT_ABORTED := TRUE; 
+ 
+ 
+                END  T_TYPE1; 
+ 
+ 
+                TASK BODY  T_TYPE2  IS
+ 
+                     TASK  INNER_TASK  IS
+ 
+ 
+                          ENTRY  WAIT_INDEFINITELY; 
+ 
+                     END  INNER_TASK; 
+ 
+                     TASK BODY  INNER_TASK  IS
+                     BEGIN
+                          SYNC2; 
+                          ABORT  T_OBJECT2; 
+                          DELAY 0.0; 
+                          TASK_NOT_ABORTED  :=  TRUE; 
+                     END  INNER_TASK; 
+ 
+                BEGIN
+ 
+ 
+                     BIRTHS_AND_DEATHS; 
+                                      -- DURING THIS SUSPENSION
+                                      --     MOST OF THE TASKS
+                                      --     ARE ABORTED   (FIRST
+                                      --     TASK #1     -- T_OBJECT1 --
+                                      --     THEN  #2 ).
+ 
+ 
+                     TASK_NOT_ABORTED := TRUE; 
+ 
+ 
+                END  T_TYPE2; 
+ 
+ 
+           BEGIN
+ 
+                DECLARE
+                     OLD_COUNT : INTEGER := 0; 
+                BEGIN
+ 
+ 
+                     FOR  I  IN  1..5  LOOP
+                          EXIT WHEN  BIRTHS_AND_DEATHS'COUNT = 2; 
+                          DELAY 10.0 * Impdef.One_Second;
+                     END LOOP;
+ 
+                     OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 
+ 
+                     IF  OLD_COUNT = 2  THEN
+ 
+                          ACCEPT  SYNC1;   -- ALLOWING  ABORT#1
+ 
+                          DELAY IMPDEF.CLEAR_READY_QUEUE;
+ 
+                          -- CHECK THAT  #1  WAS ABORTED  -  3 WAYS:
+ 
+                          BEGIN
+                               T_OBJECT1.E; 
+                               FAILED( "T_OBJECT1.E  DID NOT RAISE" &
+                                                    "  TASKING_ERROR" );
+                          EXCEPTION
+ 
+                               WHEN TASKING_ERROR  =>
+                                    NULL;
+ 
+                               WHEN OTHERS  =>
+                                    FAILED("OTHER EXCEPTION RAISED - 1");
+ 
+                          END; 
+ 
+                          IF T_OBJECT1'CALLABLE  THEN
+                               FAILED( "T_OBJECT1'CALLABLE = TRUE" );
+                          END IF;
+ 
+                          IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
+                          THEN
+                               FAILED( "TASK#1 NOT REMOVED FROM QUEUE" );
+                          END IF;
+ 
+ 
+                          OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 
+ 
+ 
+                          ACCEPT  SYNC2;   -- ALLOWING  ABORT#2
+                          
+                          DELAY IMPDEF.CLEAR_READY_QUEUE;
+ 
+                          -- CHECK THAT  #2  WAS ABORTED  -  3 WAYS:
+ 
+                          BEGIN
+                               T_OBJECT2.E; 
+                               FAILED( "T_OBJECT2.E  DID NOT RAISE" &
+                                                    "  TASKING_ERROR" );
+                          EXCEPTION
+ 
+                               WHEN TASKING_ERROR  =>
+                                    NULL;
+ 
+                               WHEN OTHERS  =>
+                                    FAILED("OTHER EXCEPTION RAISED - 2");
+ 
+                          END; 
+ 
+                          IF T_OBJECT2'CALLABLE  THEN
+                               FAILED( "T_OBJECT2'CALLABLE = TRUE" );
+                          END IF;
+ 
+                          IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
+                          THEN
+                               FAILED( "TASK#2 NOT REMOVED FROM QUEUE" );
+                          END IF;
+ 
+ 
+                          IF  BIRTHS_AND_DEATHS'COUNT /= 0  THEN
+                               FAILED( "SOME TASKS STILL QUEUED" );
+                          END IF;
+   
+ 
+                     ELSE
+ 
+                          COMMENT( "LINEUP NOT COMPLETE (AFTER 50 S.)" );
+                          TEST_VALID  :=  FALSE; 
+ 
+                     END IF;
+ 
+ 
+                END; 
+ 
+ 
+                WHILE  BIRTHS_AND_DEATHS'COUNT > 0  LOOP
+                     ACCEPT  BIRTHS_AND_DEATHS; 
+                END LOOP;
+ 
+ 
+           END  REGISTER; 
+ 
+ 
+      BEGIN
+ 
+           NULL;
+ 
+      END; 
+ 
+ 
+      -------------------------------------------------------------------
+ 
+ 
+      IF  TEST_VALID  AND  TASK_NOT_ABORTED  THEN
+           FAILED( "SOME TASKS NOT ABORTED" );
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ 
+ END  C9A007A; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- C9A009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- TEST ABORT DURING RENDEZVOUS
+ 
+ -- CALLING TASK IN RENDEVOUS IS NAMED IN ABORT STATEMENT.
+ 
+ -- JEAN-PIERRE ROSEN 09 MARCH 1984
+ -- JBG 6/1/84
+ -- JWC 6/28/85   RENAMED FROM C9A009D-B.ADA
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C9A009A IS
+ 
+ BEGIN
+ 
+      TEST("C9A009A", "CALLING TASK IS ABORTED DIRECTLY");
+ 
+      DECLARE
+      -- T1 CALLS T2, WHICH ABORTS T1 WHILE IN RENDEVOUS
+ 
+           T2_CONTINUED : BOOLEAN := FALSE;
+ 
+           TASK CONTINUED IS
+                ENTRY GET (T2_CONTINUED : OUT BOOLEAN);
+                ENTRY PUT (T2_CONTINUED : IN  BOOLEAN);
+           END CONTINUED;
+ 
+           TASK BODY CONTINUED IS
+                CONTINUED : BOOLEAN := FALSE;
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT GET (T2_CONTINUED : OUT BOOLEAN) DO
+                               T2_CONTINUED := CONTINUED;
+                          END GET;
+                     OR
+                          ACCEPT PUT (T2_CONTINUED : IN BOOLEAN) DO
+                               CONTINUED := T2_CONTINUED;
+                          END PUT;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END CONTINUED;
+ 
+      BEGIN     -- THIS BLOCK WILL MAKE SURE T2 IS TERMINATED, AND SO,
+                -- T2_CONTINUED IS ASSIGNED A VALUE IF T2 CONTINUES
+                -- EXECUTION CORRECTLY.
+ 
+           DECLARE
+ 
+                TASK T1;
+ 
+                TASK T2 IS
+                     ENTRY E1;
+                END T2;
+ 
+                TASK BODY T1 IS
+                BEGIN
+                     T2.E1;
+                     FAILED ("T1 NOT ABORTED");
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          FAILED ("TASKING_ERROR RAISED IN T1");
+                     WHEN OTHERS =>
+                          FAILED ("OTHER EXCEPTION RAISED - T1");
+                END T1;
+ 
+                TASK BODY T2 IS
+                BEGIN
+                     ACCEPT E1 DO
+                          ABORT T1;
+                          ABORT T1;
+                          ABORT T1; -- WHY NOT?
+                          IF T1'TERMINATED THEN
+                               FAILED ("T1 PREMATURELY TERMINATED");
+                          END IF;
+                     END E1;
+                     CONTINUED.PUT (T2_CONTINUED => TRUE);
+                END T2;
+           BEGIN
+                NULL;
+           END;
+      -- T2 NOW TERMINATED
+           CONTINUED.GET (T2_CONTINUED);
+           IF NOT T2_CONTINUED THEN
+                FAILED ("WHEN CALLER WAS ABORTED IN RENDEVOUS, CALLED " &
+                        "TASK DID NOT CONTINUE");
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END C9A009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C9A009C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- TEST ABORT DURING RENDEZVOUS
+ 
+ -- THE CALLING TASK IN THE RENDEVOUS IS DEPENDENT ON THE ABORTED TASK,
+ -- SO THE DEPENDENT TASK IS INDIRECTLY ABORTED WHILE IN A RENDEVOUS;
+ -- NEITHER THE CALLING TASK NOR ITS MASTER CAN BE TERMINATED WHILE THE
+ -- RENDEVOUS CONTINUES.
+ 
+ -- JEAN-PIERRE ROSEN 09 MARCH 1984
+ -- JBG 6/1/84
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C9A009C IS
+ 
+ BEGIN 
+ 
+      TEST("C9A009C", "DEPENDENT TASK IN RENDEVOUS WHEN MASTER IS " &
+                      "ABORTED");
+ 
+      DECLARE
+      -- T2 CONTAINS DEPENDENT TASK T3 WHICH CALLS T1.
+      -- T1 ABORTS T2 WHILE IN RENDEVOUS WITH T3.
+ 
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+ 
+           TASK BODY T1 IS
+       
+                TASK T2;
+      
+                TASK BODY T2 IS
+                     TASK T3;
+                     TASK BODY T3 IS
+                     BEGIN
+                          T1.E1;
+                          FAILED ("T3 NOT ABORTED");
+                     EXCEPTION
+                          WHEN TASKING_ERROR =>
+                               FAILED ("TASKING_ERROR IN T3");
+                          WHEN OTHERS =>
+                               FAILED ("OTHER EXCEPTION IN T3");
+                     END;
+                BEGIN     -- T3 ACTIVATED NOW
+                     NULL;
+                END T2;
+      
+           BEGIN     -- T1
+                ACCEPT E1 DO
+                     ABORT T2;
+                     ABORT T2;
+                     ABORT T2; -- WHY NOT?
+                     IF T2'TERMINATED THEN
+                          FAILED ("T2 TERMINATED PREMATURELY");
+                     END IF;
+                END E1;
+           EXCEPTION
+                WHEN TASKING_ERROR =>
+                     FAILED ("TASKING_ERROR IN T1 BECAUSE CALLING TASK "&
+                             "WAS ABORTED");
+                WHEN OTHERS =>
+                     FAILED ("OTHER EXCEPTION - T1");
+           END T1;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END C9A009C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- C9A009F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK ABORTED DURING AN ENTRY CALL IS NOT TERMINATED
+ -- BEFORE THE END OF THE RENDEZVOUS.
+ 
+ -- JEAN-PIERRE ROSEN 16-MAR-1984
+ -- JBG 6/1/84
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT,SYSTEM; 
+ USE REPORT,SYSTEM;
+ PROCEDURE C9A009F IS
+ 
+ 
+      TASK BLOCKING IS
+           ENTRY START;
+           ENTRY STOP;
+           ENTRY RESTART;
+           ENTRY NO_CALL;
+      END BLOCKING;
+ 
+      TASK BODY BLOCKING IS
+      BEGIN
+           SELECT
+                ACCEPT STOP DO
+                     ACCEPT START;
+                     ACCEPT RESTART;
+                END;
+           OR TERMINATE;
+           END SELECT;
+      END;
+ 
+ BEGIN
+ 
+      TEST("C9A009F", "ABORTED TASK NOT TERMINATED BEFORE END OF " &
+                      "RENDEVOUS");
+ 
+      DECLARE         -- T1 ABORTED WHILE IN RENDEVOUS WITH BLOCKING.
+ 
+           TASK T1 IS
+           END T1;                              
+           TASK BODY T1 IS
+           BEGIN
+                BLOCKING.STOP;
+                FAILED ("T1 NOT ABORTED");
+           END;
+      
+      BEGIN
+           BLOCKING.START;          -- ALLOWS T1 TO ENTER RENDEVOUS
+ 
+           ABORT T1;
+ 
+           IF T1'CALLABLE THEN
+                FAILED("T1 STILL CALLABLE - 1");
+           END IF;
+ 
+           IF T1'TERMINATED THEN    -- T1 STILL IN RENDEVOUS
+                FAILED("T1 PREMATURELY TERMINATED - 1");
+           END IF;
+ 
+           BLOCKING.RESTART;
+      END;
+ 
+      RESULT;
+ 
+ END C9A009F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009g.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009g.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009g.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009g.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- C9A009G.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A MASTER ABORTED WITH SUBTASKS IN AN ENTRY CALL BECOMES
+ -- COMPLETED, BUT NOT TERMINATED, BEFORE THE END OF THE RENDEZVOUS.
+ 
+ -- JEAN-PIERRE ROSEN 16-MAR-1984
+ -- JBG 6/1/84
+ -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+ 
+ WITH REPORT,SYSTEM; 
+ USE REPORT,SYSTEM;
+ PROCEDURE C9A009G IS
+ 
+ 
+      TASK BLOCKING IS
+           ENTRY START;
+           ENTRY STOP;
+           ENTRY RESTART;
+           ENTRY NO_CALL;
+      END BLOCKING;
+ 
+      TASK BODY BLOCKING IS
+      BEGIN
+           SELECT
+                ACCEPT STOP DO
+                     ACCEPT START;
+                     ACCEPT RESTART;
+                END;
+           OR TERMINATE;
+           END SELECT;
+      END;
+ 
+ BEGIN
+ 
+      TEST("C9A009G", "MASTER COMPLETED BUT NOT TERMINATED");
+ 
+      DECLARE         -- T1 ABORTED WHILE DEPENDENT TASK IN RENDEVOUS 9C?
+ 
+           TASK T1 IS
+                ENTRY LOCK;
+           END T1;                              
+      
+           TASK BODY T1 IS
+                TASK T2;
+      
+                TASK BODY T2 IS
+                BEGIN
+                     BLOCKING.STOP;
+                     FAILED ("T2 NOT ABORTED");
+                END;
+           BEGIN
+                BLOCKING.NO_CALL;          -- WILL DEADLOCK UNTIL ABORT
+           END T1;
+      
+      BEGIN
+           BLOCKING.START;
+           ABORT T1;
+ 
+           IF T1'CALLABLE THEN
+                FAILED("T1 STILL CALLABLE - 2");
+           END IF;
+ 
+           IF T1'TERMINATED THEN    -- T1'S DEPENDENT TASK, T2, STILL IN
+                                    -- RENDEVOUS 
+                FAILED("T1 PREMATURELY TERMINATED - 2");
+           END IF;
+ 
+           BLOCKING.RESTART;
+      END;
+ 
+      RESULT;
+ 
+ END C9A009G;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009h.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009h.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a009h.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a009h.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- C9A009H.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A TASK ABORTED DURING A RENDEVOUS IS NEITHER CALLABLE NOR
+ -- TERMINATED BEFORE THE END OF THE RENDEVOUS.
+ 
+ -- J.P ROSEN, ADA PROJECT, NYU
+ -- JBG 6/1/84
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE C9A009H IS
+ BEGIN
+      TEST ("C9A009H", "TASK ABORTED IN RENDEVOUS IS NOT CALLABLE OR " &
+                       "TERMINATED");
+ 
+      DECLARE
+ 
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+ 
+           TASK T2 IS
+           END T2;
+ 
+           TASK BODY T2 IS
+           BEGIN
+                T1.E1;
+                FAILED ("T2 NOT ABORTED");
+           EXCEPTION
+                WHEN TASKING_ERROR =>
+                     FAILED ("TASKING_ERROR RAISED IN ABORTED TASK");
+                WHEN OTHERS =>
+                     FAILED ("OTHER EXCEPTION RAISED");
+           END T2;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E1 DO
+                     ABORT T2;
+                     IF T2'CALLABLE THEN
+                          FAILED ("T2 STILL CALLABLE");
+                     END IF;
+ 
+                     IF T2'TERMINATED THEN
+                          FAILED ("T2 TERMINATED");
+                     END IF;
+                END E1;
+           END T1;
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ 
+ END C9A009H;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- C9A010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- TEST ABORT DURING RENDEZVOUS
+ 
+ -- ABORTING AN ABNORMAL (NOT YET TERMINATED) TASK.
+ 
+ -- JEAN-PIERRE ROSEN 09 MARCH 1984
+ -- JBG 6/1/84
+ -- JWC 6/28/85   RENAMED FROM C9A009E-B.ADA
+ -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C9A010A IS
+ 
+ BEGIN
+ 
+      TEST("C9A010A", "ABORTING AN ABNORMAL TASK");
+ 
+      DECLARE
+      -- T1 CALLS T2.  WHILE IN RENDEVOUS, T2 ABORTS T1 AND WAITS FOR A
+      -- CALL FROM THE MAIN PROGRAM.  WHEN THE CALL IS ACCEPTED, THE MAIN
+      -- PROGRAM AGAIN ABORTS T1, WHICH IS NOW ABNORMAL, SINCE T1 HAS NOT
+      -- YET COMPLETED ITS RENDEVOUS WITH T2.
+ 
+           TASK T1 IS
+           END T1;
+ 
+           TASK T2 IS
+                ENTRY E1;
+                ENTRY E2;
+           END T2;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                T2.E1;
+                FAILED("T1 NOT ABORTED");
+           EXCEPTION
+                WHEN TASKING_ERROR =>
+                     FAILED ("TASKING_ERROR IN T1");
+                WHEN OTHERS =>
+                     FAILED ("OTHER EXCEPTION IN T1");
+           END T1;
+ 
+           TASK BODY T2 IS
+           BEGIN
+                ACCEPT E1 DO
+                     ABORT  T1;
+                     ACCEPT E2;     -- NOTE CALLER REMAINS IN RENDEVOUS
+                     ACCEPT E2;     -- UNTIL TWO ENTRY CALLS ACCEPTED
+                END E1;
+           END T2;
+      BEGIN
+           T2.E2;    -- ONLY ACCEPTED AFTER T1 HAS BEEN ABORTED.
+           ABORT T1; -- T1 IS ABNORMAL BECAUSE IT IS STILL IN RENDEVOUS.
+           IF T1'CALLABLE THEN
+                FAILED ("T1 CALLABLE AFTER BEING ABORTED");
+           END IF;
+           IF T1'TERMINATED THEN
+                FAILED ("T1 TERMINATED ALTHOUGH IN RENDEVOUS");
+           END IF;
+           T2.E2; -- T1'S RENDEVOUS CAN NOW COMPLETE; T1 CAN TERMINATE.
+      END;
+ 
+      RESULT;
+ 
+ END C9A010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- C9A011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF A CALLED TASK IS ABORTED WHILE IN RENDEZVOUS, THEN
+ --     "TASKING_ERROR" IS RAISED IN THE CALLING TASK.
+ 
+ -- HISTORY:
+ --     DHH 03/28/88 CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C9A011A IS
+ 
+      TASK TYPE CHOICE IS
+           ENTRY E1;
+      END CHOICE;
+ 
+      T : CHOICE;
+ 
+      TASK BODY CHOICE IS
+           X : INTEGER;
+      BEGIN
+           ACCEPT E1 DO
+                X := IDENT_INT(3);
+                IF EQUAL(X,X) THEN
+                     ABORT CHOICE;
+                END IF;
+           END E1;
+      END CHOICE;
+ 
+ BEGIN
+ 
+      TEST("C9A011A", "CHECK THAT IF A CALLED TASK IS ABORTED WHILE " &
+                      "IN RENDEZVOUS, THEN ""TASKING_ERROR"" IS " &
+                      "RAISED IN THE CALLING TASK");
+ 
+      T.E1;
+      FAILED("EXCEPTION NOT RAISED ON ABORT");
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN TASKING_ERROR =>
+           RESULT;
+ 
+      WHEN OTHERS =>
+           FAILED("UNEXPECTED EXCEPTION RAISED ON ABORT");
+           RESULT;
+ END C9A011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a011b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/c9/c9a011b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/c9/c9a011b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- C9A011B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT "TASKING_ERROR" IS RAISED BY A TIMED ENTRY CALL IF
+ --     THE CALLED TASK IS ABORTED BEFORE THE DELAY EXPIRES BUT NOT
+ --     WHEN THE CALL IS FIRST EXECUTED.
+ 
+ -- HISTORY:
+ --     DHH 06/14/88 CREATED ORIGINAL TEST.
+ 
+ with Impdef;
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE C9A011B IS
+ 
+      TASK TIMED_ENTRY IS
+           ENTRY WAIT_AROUND;
+      END TIMED_ENTRY;
+ 
+      TASK OWNER IS
+           ENTRY START;
+           ENTRY SELF_ABORT;
+      END OWNER;
+ 
+      TASK BODY TIMED_ENTRY IS
+      BEGIN
+           SELECT
+                OWNER.SELF_ABORT;
+           OR
+                DELAY 60.0 * Impdef.One_Second;
+           END SELECT;
+           FAILED("NO EXCEPTION RAISED");
+ 
+           ACCEPT WAIT_AROUND;
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                ACCEPT WAIT_AROUND;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION RAISED");
+                ACCEPT WAIT_AROUND;
+      END TIMED_ENTRY;
+ 
+      TASK BODY OWNER IS
+      BEGIN
+           ACCEPT START DO
+                WHILE SELF_ABORT'COUNT = 0 LOOP
+                     DELAY 1.0 * Impdef.One_Second;
+                END LOOP;
+           END START;
+ 
+           ABORT OWNER;
+ 
+           ACCEPT SELF_ABORT;
+ 
+      END OWNER;
+ 
+ BEGIN
+ 
+      TEST("C9A011B", "CHECK THAT ""TASKING_ERROR"" IS RAISED BY A " &
+                      "TIMED ENTRY CALL IF THE CALLED TASK IS " &
+                      "ABORTED BEFORE THE DELAY EXPIRES BUT NOT " &
+                      "WHEN THE CALL IS FIRST EXECUTED");
+ 
+      OWNER.START;
+      DELAY 5.0 * Impdef.One_Second;
+ 
+      IF TIMED_ENTRY'CALLABLE THEN
+           TIMED_ENTRY.WAIT_AROUND;
+      ELSE
+           FAILED("TASK ABORTED WHEN TASKING ERROR IS RAISED");
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED("EXCEPTION RAISED OUTSIDE OF TASK");
+           RESULT;
+ 
+ END C9A011B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- CA1003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT MORE THAN ONE COMPLETELY INDEPENDENT COMPILATION
+ -- UNIT CAN BE SUBMITTED IN A SINGLE FILE.
+ 
+ -- JRK 5/13/81
+ -- JBG 8/25/83
+ 
+ PROCEDURE CA1003A_P (I : IN OUT INTEGER) IS
+ BEGIN
+      I := I + 1;
+ END CA1003A_P;
+ 
+ 
+ PACKAGE CA1003A_PKG IS
+      I : INTEGER := 0;
+ END CA1003A_PKG;
+ 
+ 
+ FUNCTION CA1003A_F (I : INTEGER) RETURN INTEGER IS
+ BEGIN
+      RETURN -I;
+ END CA1003A_F;
+ 
+ 
+ WITH REPORT, CA1003A_P, CA1003A_PKG, CA1003A_F;
+ USE REPORT;
+ 
+ PROCEDURE CA1003A IS
+ 
+      I : INTEGER := IDENT_INT (0);
+ 
+ BEGIN
+      TEST ("CA1003A", "INDEPENDENT UNITS IN A SINGLE FILE");
+ 
+      CA1003A_P (I);
+      IF I /= 1 THEN
+           FAILED ("INDEPENDENT PROCEDURE NOT INVOKED");
+      END IF;
+ 
+      CA1003A_PKG.I := CA1003A_PKG.I + IDENT_INT(10);
+      IF CA1003A_PKG.I /= 10 THEN
+           FAILED ("INDEPENDENT PACKAGE VARIABLE ACCESSED INCORRECTLY");
+      END IF;
+ 
+      IF CA1003A_F(IDENT_INT(5)) /= -5 THEN
+           FAILED ("INDEPENDENT FUNCTION NOT INVOKED");
+      END IF;
+ 
+      RESULT;
+ END CA1003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- CA1004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A PACKAGE DECLARATION AND BODY CAN BE
+ -- SUBMITTED TOGETHER FOR COMPILATION.
+ 
+ -- JRK 5/12/81
+ 
+ 
+ PACKAGE CA1004A_PKG IS
+ 
+      I : INTEGER := 0;
+ 
+      PROCEDURE P (I : IN OUT INTEGER);
+ 
+ END CA1004A_PKG;
+ 
+ 
+ PACKAGE BODY CA1004A_PKG IS
+ 
+      PROCEDURE P (I : IN OUT INTEGER) IS
+      BEGIN
+           I := I + 1;
+      END P;
+ 
+ BEGIN
+ 
+      I := 10;
+ 
+ END CA1004A_PKG;
+ 
+ 
+ WITH REPORT, CA1004A_PKG;
+ USE REPORT;
+ 
+ PROCEDURE CA1004A IS
+ 
+      I : INTEGER := IDENT_INT (0);
+ 
+ BEGIN
+      TEST ("CA1004A", "A PACKAGE DECLARATION AND BODY SUBMITTED " &
+            "TOGETHER");
+ 
+      CA1004A_PKG.I := CA1004A_PKG.I + IDENT_INT(5);
+      IF CA1004A_PKG.I /= 15 THEN
+           FAILED ("PACKAGED VARIABLE NOT ACCESSIBLE OR " &
+                   "PACKAGE BODY NOT EXECUTED");
+      END IF;
+ 
+      CA1004A_PKG.P (I);
+      IF I /= 1 THEN
+           FAILED ("PACKAGED PROCEDURE NOT EXECUTED");
+      END IF;
+ 
+      RESULT;
+ END CA1004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- CA1005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SUBPROGRAM DECLARATION AND BODY CAN BE
+ -- SUBMITTED TOGETHER FOR COMPILATION.
+ 
+ -- JRK 5/14/81
+ 
+ 
+ FUNCTION CA1005A_F (I : INTEGER) RETURN INTEGER;
+ 
+ 
+ FUNCTION CA1005A_F (I : INTEGER) RETURN INTEGER IS
+ BEGIN
+      RETURN I + 1;
+ END CA1005A_F;
+ 
+ 
+ PROCEDURE CA1005A_P (I : IN OUT INTEGER);
+ 
+ 
+ PROCEDURE CA1005A_P (I : IN OUT INTEGER) IS
+ BEGIN
+      I := -I;
+ END CA1005A_P;
+ 
+ 
+ WITH REPORT, CA1005A_F, CA1005A_P;
+ USE REPORT;
+ 
+ PROCEDURE CA1005A IS
+ 
+      I : INTEGER := IDENT_INT (7);
+ 
+ BEGIN
+      TEST ("CA1005A", "SUBPROGRAM DECLARATIONS AND BODIES " &
+            "SUBMITTED TOGETHER");
+ 
+      IF CA1005A_F (IDENT_INT(2)) /= 3 THEN
+           FAILED ("FUNCTION NOT EXECUTED");
+      END IF;
+ 
+      CA1005A_P (I);
+      IF I /= -7 THEN
+           FAILED ("PROCEDURE NOT EXECUTED");
+      END IF;
+ 
+      RESULT;
+ END CA1005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- CA1006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A LIBRARY UNIT AND ITS SUBUNITS CAN BE
+ -- SUBMITTED TOGETHER FOR COMPILATION.
+ 
+ -- JRK 5/14/81
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CA1006A IS
+ 
+      I : INTEGER := IDENT_INT (0);
+ 
+      PACKAGE CALL_TEST IS
+      END CALL_TEST;
+ 
+      PACKAGE BODY CALL_TEST IS
+      BEGIN
+           TEST ("CA1006A", "A LIBRARY UNIT AND ITS SUBUNITS " &
+                 "SUBMITTED TOGETHER");
+      END CALL_TEST;
+ 
+      FUNCTION F (I : INTEGER) RETURN INTEGER IS SEPARATE;
+ 
+      PACKAGE PKG IS
+           I : INTEGER := IDENT_INT (0);
+           PROCEDURE P (I : IN OUT INTEGER);
+      END PKG;
+ 
+      PACKAGE BODY PKG IS SEPARATE;
+ 
+      PROCEDURE P (I : IN OUT INTEGER) IS SEPARATE;
+ 
+ BEGIN
+ 
+      IF PKG.I /= 10 THEN
+           FAILED ("PACKAGE BODY STATEMENTS NOT EXECUTED");
+      END IF;
+ 
+      IF F(IDENT_INT(5)) /= -5 THEN
+           FAILED ("FUNCTION NOT ELABORATED/EXECUTED");
+      END IF;
+ 
+      PKG.P (I);
+      IF I /= 3 THEN
+           FAILED ("PACKAGED PROCEDURE NOT ELABORATED/EXECUTED");
+      END IF;
+ 
+      I := IDENT_INT (-20);
+      P (I);
+      IF I /= -24 THEN
+           FAILED ("PROCEDURE NOT ELABORATED/EXECUTED");
+      END IF;
+ 
+      RESULT;
+ END CA1006A;
+ 
+ 
+ SEPARATE (CA1006A)
+ FUNCTION F (I : INTEGER) RETURN INTEGER IS
+ BEGIN
+      RETURN -I;
+ END F;
+ 
+ 
+ SEPARATE (CA1006A)
+ PACKAGE BODY PKG IS
+ 
+      PROCEDURE P (I : IN OUT INTEGER) IS
+      BEGIN
+           I := I + 3;
+      END P;
+ 
+ BEGIN
+      I := I + 10;
+ END PKG;
+ 
+ 
+ SEPARATE (CA1006A)
+ PROCEDURE P (I : IN OUT INTEGER) IS
+ BEGIN
+      I := I - 4;
+ END P;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,35 ----
+ -- CA1011A0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/20/84
+ -- JBG 5/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CA1011A0 (X : IN OUT INTEGER; Y : IN INTEGER := 2) IS
+ BEGIN
+ 
+      X := Y;
+      FAILED ("DID NOT REPLACE CA1011A0");
+ 
+ END CA1011A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- CA1011A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/20/84
+ -- JBG 5/23/85
+ 
+ PROCEDURE CA1011A0 (X : IN OUT INTEGER;
+                     Y : IN INTEGER  := -1;        
+                     Z : IN INTEGER := 2) IS        
+ 
+ BEGIN
+ 
+      X := 3;
+ 
+ END CA1011A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,35 ----
+ -- CA1011A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/20/84
+ -- JBG 5/23/85
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CA1011A2 (X : INTEGER := 1; Y : IN OUT FLOAT) IS
+ BEGIN
+ 
+      Y := 2.0;
+      FAILED ("DID NOT REPLACE CA1011A2");
+ 
+ END CA1011A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA1011A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/20/84
+ -- JBG 5/23/85
+ 
+ PROCEDURE CA1011A2 (X : BOOLEAN := TRUE;
+                     Y : IN OUT FLOAT) IS
+ BEGIN
+ 
+      Y := 3.0;
+ 
+ END CA1011A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,35 ----
+ -- CA1011A4.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/20/84
+ -- JBG 5/23/85
+ 
+ WITH REPORT; USE REPORT;
+ FUNCTION CA1011A4 RETURN INTEGER IS
+ BEGIN
+ 
+      FAILED ("DID NOT REPLACE CA1011A4");
+      RETURN 2;
+ 
+ END CA1011A4;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a5.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a5.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a5.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,33 ----
+ -- CA1011A5.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/20/84
+ -- JBG 5/23/85
+ 
+ FUNCTION CA1011A4 RETURN FLOAT IS
+ BEGIN
+ 
+      RETURN 3.0;
+ 
+ END CA1011A4;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a6.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1011a6.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1011a6.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- CA1011A6M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A SUBPROGRAM BODY IS INITIALLY COMPILED, SUBSEQUENT
+ -- ATTEMPTS TO COMPILE A SUBPROGRAM BODY WITH A DIFFERENT PARAMETER AND
+ -- RESULT TYPE PROFILE ARE ACCEPTED (SEE AI-00199).
+ 
+ -- SEPARATE FILES ARE:
+ --     CA1011A0  A LIBRARY PROCEDURE (CA1011A0).
+ --     CA1011A1  A LIBRARY PROCEDURE (CA1011A0).
+ --     CA1011A2  A LIBRARY PROCEDURE (CA1011A2).
+ --     CA1011A3  A LIBRARY PROCEDURE (CA1011A2).
+ --     CA1011A4  A LIBRARY FUNCTION  (CA1011A4).
+ --     CA1011A5  A LIBRARY FUNCTION  (CA1011A4).
+ --     CA1011A6M THE MAIN PROCEDURE.
+ 
+ -- BHS 7/20/84
+ -- JBG 5/23/85
+ 
+ WITH CA1011A0, CA1011A2, CA1011A4;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CA1011A6M IS
+ 
+      I : INTEGER := 5;
+      J : FLOAT := 4.0;
+ 
+ BEGIN
+ 
+      TEST("CA1011A", "ATTEMPTS TO RECOMPILE A SUBPROGRAM WITH " &
+                      "NONCONFORMING PARAMETER OR RESULT TYPE "  &
+                      "PROFILES ARE ACCEPTED");
+ 
+      CA1011A0(X => I);             -- EXPECT DEFAULT Y
+      IF I = 3 THEN
+           COMMENT ("SECOND DECLARATION OF CA1011A0 INVOKED CORRECTLY");
+      END IF;
+ 
+      CA1011A2(Y => J);             -- USE DEFAULT X.
+      IF J = 3.0 THEN
+           COMMENT ("SECOND DECLARATION OF CA1011A2 INVOKED CORRECTLY");
+      END IF;
+ 
+      I := INTEGER(CA1011A4);
+      IF I = 3 THEN
+           COMMENT ("SECOND DECLARATION OF CA1011A4 INVOKED CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ 
+ END CA1011A6M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,41 ----
+ -- CA1012A0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- GENERIC PROCEDURE DECLARATION.
+ -- BODY IS IN CA1012A1.DEP.
+ -- INSTANTIATION IS IN CA1012A4M.DEP.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     WKB 07/20/81  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+ --                   AND CLARIFY POSSIBLE NON-APPLICABILITY.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ GENERIC
+      TYPE INDEX IS RANGE <>;
+ PROCEDURE CA1012A0 (I : IN OUT INDEX);
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,45 ----
+ -- CA1012A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- GENERIC PROCEDURE BODY.
+ -- DECLARATION IS IN CA1012A0.DEP.
+ -- INSTANTIATION IN CA1012A4M.DEP.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     WKB 07/20/81  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+ --                   IN TEST AND POSSIBLE NON-APPLICABILITY.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ PROCEDURE CA1012A0 (I : IN OUT INDEX) IS
+ 
+ BEGIN
+ 
+      I := I + 1;
+ 
+ END CA1012A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,41 ----
+ -- CA1012A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- GENERIC FUNCTION DECLARATION.
+ -- BODY IS IN CA1012A3.DEP.
+ -- INSTANTIATION IS IN CA1012A4M.DEP.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     WKB 07/20/81  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+ --                   AND POSSIBLE NON-APPLICABILITY.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ GENERIC
+      TYPE ELEMENT IS RANGE <>;
+ FUNCTION CA1012A2 (J : IN ELEMENT) RETURN ELEMENT;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,45 ----
+ -- CA1012A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- GENERIC FUNCTION BODY.
+ -- DECLARATION IS IN CA1012AB.DEP.
+ -- INSTANTIATION IS IN CA1012A4B.DEP.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     WKB 07/20/81  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+ --                   AND POSSIBLE NON-APPLICABILITY.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ FUNCTION CA1012A2 (J : IN ELEMENT) RETURN ELEMENT IS
+ 
+ BEGIN
+ 
+      RETURN J + 1;
+ 
+ END CA1012A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012a4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012a4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- CA1012A4M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT GENERIC SUBPROGRAM DECLARATIONS AND BODIES CAN BE
+ --     COMPILED SEPARATELY.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA1012A0  A LIBRARY GENERIC PROCEDURE DECLARATION.
+ --   CA1012A1  A LIBRARY GENERIC PROCEDURE BODY (CA1012A0).
+ --   CA1012A2  A LIBRARY GENERIC FUNCTION DECLARATION.
+ --   CA1012A3  A LIBRARY GENERIC FUNCTION BODY (CA1012A2).
+ --   CA1012A4M THE MAIN PROCEDURE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+ --     THIS WAS NOT REQUIRED FOR ADA 83.
+ 
+ -- HISTORY:
+ --     WKB 07/20/81  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED COMMENTS REGARDING NON-APPLICABILITY.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ --     RLB 09/15/99  REMOVED OBSOLETE COMMENT.
+ 
+ WITH REPORT, CA1012A0, CA1012A2;
+ USE REPORT;
+ PROCEDURE CA1012A4M IS
+ 
+      N : INTEGER := 1;
+ 
+      SUBTYPE S50 IS INTEGER RANGE 1..50;
+ 
+      PROCEDURE P IS NEW CA1012A0 (S50);
+ 
+      FUNCTION F IS NEW CA1012A2 (INTEGER);
+ 
+ BEGIN
+      TEST ("CA1012A", "SEPARATELY COMPILED GENERIC SUBPROGRAM " &
+                       "DECLARATIONS AND BODIES");
+ 
+      P(N);
+      IF N /= 2 THEN
+           FAILED ("PROCEDURE NOT INVOKED");
+      END IF;
+ 
+      N := 1;
+      IF F(N) /= 2 THEN
+           FAILED ("FUNCTION NOT INVOKED");
+      END IF;
+ 
+      RESULT;
+ END CA1012A4M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012b0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012b0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012b0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,37 ----
+ -- CA1012B0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ 
+ GENERIC
+      TYPE INDEX IS RANGE <>;
+ PROCEDURE CA1012B0 (I : IN OUT INDEX);
+ 
+ PROCEDURE CA1012B0 (I : IN OUT INDEX) IS
+ 
+ BEGIN
+ 
+      I := I + 1;
+ 
+ END CA1012B0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012b2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012b2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012b2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,37 ----
+ -- CA1012B2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ 
+ GENERIC
+      TYPE ELEMENT IS RANGE <>;
+ FUNCTION CA1012B2 (J : IN ELEMENT) RETURN ELEMENT;
+ 
+ FUNCTION CA1012B2 (J : IN ELEMENT) RETURN ELEMENT IS
+ 
+ BEGIN
+ 
+      RETURN J + 1;
+ 
+ END CA1012B2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012b4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012b4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1012b4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1012b4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,63 ----
+ -- CA1012B4M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT GENERIC SUBPROGRAM DECLARATIONS AND BODIES CAN BE
+ --   COMPILED SEPARATELY.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA1012B0  A LIBRARY GENERIC PROCEDURE DECLARATION AND BODY.
+ --   CA1012B2  A LIBRARY GENERIC FUNCTION DECLARATION AND BODY.
+ --   CA1012B4M THE MAIN PROCEDURE.
+ 
+ -- WKB 7/20/81
+ 
+ WITH REPORT, CA1012B0, CA1012B2;
+ USE REPORT;
+ PROCEDURE CA1012B4M IS
+ 
+      N : INTEGER := 1;
+ 
+      SUBTYPE S50 IS INTEGER RANGE 1..50;
+ 
+      PROCEDURE P IS NEW CA1012B0 (S50);
+ 
+      FUNCTION F IS NEW CA1012B2 (INTEGER);
+ 
+ BEGIN
+      TEST ("CA1012B", "SEPARATELY COMPILED GENERIC SUBPROGRAM " &
+                       "DECLARATIONS AND BODIES");
+ 
+      P(N);
+      IF N /= 2 THEN
+           FAILED ("PROCEDURE NOT INVOKED");
+      END IF;
+ 
+      N := 1;
+      IF F(N) /= 2 THEN
+           FAILED ("FUNCTION NOT INVOKED");
+      END IF;
+ 
+      RESULT;
+ 
+ END CA1012B4M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ -- CA1013A0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ -- PWN 5/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ 
+ GENERIC
+      TYPE ELEM IS RANGE <>;
+ PACKAGE CA1013A0 IS
+ 
+      I : ELEM;
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+ END CA1013A0;
+ 
+ 
+ PACKAGE BODY CA1013A0 IS
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ 
+ BEGIN
+ 
+      I := 1;
+ 
+ END CA1013A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,39 ----
+ -- CA1013A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ 
+ 
+ GENERIC
+      TYPE INDEX IS RANGE <>;
+ PROCEDURE CA1013A1 (I : IN OUT INDEX);
+ 
+ 
+ PROCEDURE CA1013A1 (I : IN OUT INDEX) IS
+ 
+ BEGIN
+  
+      I := I + 1;
+ 
+ END CA1013A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,39 ----
+ -- CA1013A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ 
+ 
+ GENERIC
+      TYPE ITEM IS RANGE <>;
+ FUNCTION CA1013A2 RETURN ITEM;
+ 
+ 
+ FUNCTION CA1013A2 RETURN ITEM IS
+ 
+ BEGIN
+ 
+      RETURN 2;
+ 
+ END CA1013A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,31 ----
+ -- CA1013A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ -- SPS 10/27/82
+ -- JBG 9/15/83
+ 
+ WITH CA1013A0; 
+ PRAGMA ELABORATE (CA1013A0);
+ PACKAGE CA1013A3 IS NEW CA1013A0 (INTEGER);
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,31 ----
+ -- CA1013A4.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ -- SPS 10/27/82
+ -- JBG 9/15/83
+ 
+ WITH CA1013A1;
+ PRAGMA ELABORATE (CA1013A1);
+ PROCEDURE CA1013A4 IS NEW CA1013A1 (INTEGER);
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a5.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a5.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a5.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,30 ----
+ -- CA1013A5.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/20/81
+ -- JBG 9/15/83
+ 
+ WITH CA1013A2;
+ PRAGMA ELABORATE (CA1013A2);
+ FUNCTION CA1013A5 IS NEW CA1013A2 (INTEGER);
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a6.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1013a6.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1013a6.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- CA1013A6M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A GENERIC PACKAGE OR SUBPROGRAM INSTANTIATION
+ -- CAN BE SUBMITTED FOR SEPARATE COMPILATION.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA1013A0  A LIBRARY GENERIC PACKAGE.
+ --   CA1013A1  A LIBRARY GENERIC PROCEDURE.
+ --   CA1013A2  A LIBRARY GENERIC FUNCTION.
+ --   CA1013A3  A LIBRARY GENERIC PACKAGE INSTANTIATION.
+ --   CA1013A4  A LIBRARY GENERIC PROCEDURE INSTANTIATION.
+ --   CA1013A5  A LIBRARY GENERIC FUNCTION INSTANTIATION.
+ --   CA1013A6M THE MAIN PROCEDURE.
+ 
+ -- WKB 7/20/81
+ -- SPS 11/5/82
+ 
+ WITH REPORT;
+ WITH CA1013A3, CA1013A4, CA1013A5;
+ USE REPORT;
+ PROCEDURE CA1013A6M IS
+ 
+      J : INTEGER := 1;
+ 
+ BEGIN
+      TEST ("CA1013A", "GENERIC INSTANTIATIONS SUBMITTED " &
+                       "FOR SEPARATE COMPILATION");
+ 
+      IF CA1013A3.I /= 1 THEN
+           FAILED ("PACKAGE NOT ACCESSED");
+      END IF;
+ 
+      CA1013A4 (J);
+      IF J /= 2 THEN
+           FAILED ("PROCEDURE NOT INVOKED");
+      END IF;
+ 
+      IF CA1013A5 /= 2 THEN
+           FAILED ("FUNCTION NOT INVOKED");
+      END IF;
+ 
+      RESULT;
+ END CA1013A6M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- CA1014A0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SUBUNIT CAN BE SUBMITTED FOR COMPILATION
+ -- SEPARATELY FROM ITS PARENT UNIT.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA1014A0M THE MAIN PROCEDURE.
+ --   CA1014A1  A SUBUNIT PROCEDURE BODY.
+ --   CA1014A2  A SUBUNIT PACKAGE BODY.
+ --   CA1014A3  A SUBUNIT FUNCTION BODY.
+ 
+ -- JRK 5/20/81
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CA1014A0M IS
+ 
+      I : INTEGER := 0;
+ 
+      PACKAGE CALL_TEST IS
+      END CALL_TEST;
+ 
+      PACKAGE BODY CALL_TEST IS
+      BEGIN
+           TEST ("CA1014A", "SUBUNITS SUBMITTED FOR COMPILATION " &
+                 "SEPARATELY FROM PARENT UNIT");
+      END CALL_TEST;
+ 
+      PROCEDURE CA1014A1 (I : IN OUT INTEGER) IS SEPARATE;
+ 
+      PACKAGE CA1014A2 IS
+           I : INTEGER := 10;
+           PROCEDURE P (I : IN OUT INTEGER);
+      END CA1014A2;
+ 
+      PACKAGE BODY CA1014A2 IS SEPARATE;
+ 
+      FUNCTION CA1014A3 (I : INTEGER) RETURN INTEGER IS SEPARATE;
+ 
+ BEGIN
+ 
+      CA1014A1 (I);
+      IF I /= 1 THEN
+           FAILED ("SUBUNIT PROCEDURE NOT ELABORATED/EXECUTED");
+      END IF;
+ 
+      IF CA1014A2.I /= 15 THEN
+           FAILED ("SUBUNIT PACKAGE BODY NOT ELABORATED/EXECUTED");
+      END IF;
+ 
+      I := 0;
+      CA1014A2.P (I);
+      IF I /= -20 THEN
+           FAILED ("SUBUNIT PACKAGED PROCEDURE NOT ELABORATED/EXECUTED");
+      END IF;
+ 
+      IF CA1014A3(50) /= -50 THEN
+           FAILED ("SUBUNIT FUNCTION NOT ELABORATED/EXECUTED");
+      END IF;
+ 
+      RESULT;
+ END CA1014A0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA1014A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- JRK 5/20/81
+ 
+ SEPARATE (CA1014A0M)
+ PROCEDURE CA1014A1 (I : IN OUT INTEGER) IS
+ 
+ BEGIN
+ 
+      I := I + 1;
+ 
+ END CA1014A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,39 ----
+ -- CA1014A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- JRK 5/20/81
+ 
+ SEPARATE (CA1014A0M)
+ PACKAGE BODY CA1014A2 IS
+ 
+      PROCEDURE P (I : IN OUT INTEGER) IS
+      BEGIN
+           I := I - 20;
+      END P;
+ 
+ BEGIN
+ 
+      I := I + 5;
+ 
+ END CA1014A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1014a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1014a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA1014A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- JRK 5/20/81
+ 
+ SEPARATE (CA1014A0M)
+ FUNCTION CA1014A3 (I : INTEGER) RETURN INTEGER IS
+ 
+ BEGIN
+  
+      RETURN -I;
+ 
+ END CA1014A3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- CA1020E0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+ --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+ --     GENERIC UNITS TO BE INSTANTIATED AS LIBRARY UNITS.
+ 
+ -- HISTORY:
+ --     JBG 05/28/85  CREATED ORIGINAL TEST.
+ --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+ --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+ --                   DECLARED WITHOUT A BODY.
+ 
+ GENERIC
+      C : INTEGER;
+ PROCEDURE GENPROC_CA1020E (X : OUT INTEGER);
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PROCEDURE GENPROC_CA1020E (X : OUT INTEGER) IS
+ BEGIN
+      X := IDENT_INT(C);
+ END GENPROC_CA1020E;
+ 
+ GENERIC
+ FUNCTION GENFUNC_CA1020E RETURN INTEGER;
+ 
+ FUNCTION GENFUNC_CA1020E RETURN INTEGER IS
+ BEGIN
+      RETURN 2;
+ END GENFUNC_CA1020E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- CA1020E1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+ --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+ --     SUBPROGRAMS TO BE REPLACED BY LATER GENERIC INSTANTIATIONS.
+ 
+ -- HISTORY:
+ --     JBG 05/28/85  CREATED ORIGINAL TEST.
+ --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+ --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+ --                   DECLARED WITHOUT A BODY.
+ 
+ PROCEDURE CA1020E_PROC1 (X : OUT INTEGER) IS
+ BEGIN
+      X := 3;
+ END CA1020E_PROC1;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION CA1020E_FUNC1 RETURN INTEGER IS
+ BEGIN
+      RETURN IDENT_INT(4);
+ END CA1020E_FUNC1;
+ 
+ PROCEDURE CA1020E_PROC2 (X : OUT INTEGER);
+ PROCEDURE CA1020E_PROC2 (X : OUT INTEGER) IS
+ BEGIN
+      X := 3;
+ END CA1020E_PROC2;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION CA1020E_FUNC2 RETURN FLOAT IS
+ BEGIN
+      RETURN FLOAT(IDENT_INT(4));
+ END CA1020E_FUNC2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ -- CA1020E2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+ --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+ --     GENERIC INSTANTIATIONS REPLACING LIBRARY UNITS CREATED IN
+ --     CA1020E1.
+ 
+ -- HISTORY:
+ --     JBG 05/28/85  CREATED ORIGINAL TEST.
+ --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+ --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+ --                   DECLARED WITHOUT A BODY.
+ 
+ WITH GENPROC_CA1020E;
+ PRAGMA ELABORATE (GENPROC_CA1020E);
+ PROCEDURE CA1020E_PROC1 IS NEW GENPROC_CA1020E(1);
+ 
+ WITH GENFUNC_CA1020E;
+ PRAGMA ELABORATE (GENFUNC_CA1020E);
+ FUNCTION CA1020E_FUNC1 IS NEW GENFUNC_CA1020E;
+ 
+ WITH GENPROC_CA1020E;
+ PRAGMA ELABORATE (GENPROC_CA1020E);
+ PROCEDURE CA1020E_PROC2 IS NEW GENPROC_CA1020E(5);
+ 
+ WITH GENFUNC_CA1020E;
+ PRAGMA ELABORATE (GENFUNC_CA1020E);
+ FUNCTION CA1020E_FUNC2 IS NEW GENFUNC_CA1020E;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1020e3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1020e3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- CA1020E3M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+ --     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+ --     GENERIC UNITS TO BE INSTANTIATED AS LIBRARY UNITS.
+ 
+ -- SEPARATE FILES ARE:
+ --     CA1020E0  -- GENERIC UNITS GENPROC_CA1020E AND GENFUNC_CA1020E.
+ --     CA1020E1  -- SUBPROGRAM LIBRARY UNIT BODIES (CA1020E_PROC1,
+ --                  CA1020E_FUNC1, CA1020E_PROC2, CA1020E_FUNC2).
+ --     CA1020E2  -- INSTANTIATIONS REPLACING UNITS COMPILED IN CA1020E1.
+ --     CA1020E3M -- MAIN PROGRAM.
+ 
+ -- HISTORY:
+ --     JBG 05/28/85  CREATED ORIGINAL TEST.
+ --     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+ --                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+ --                   DECLARED WITHOUT A BODY.
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA1020E_PROC1, CA1020E_FUNC1, CA1020E_PROC2, CA1020E_FUNC2;
+ PROCEDURE CA1020E3M IS
+      TEMP : INTEGER := 0;
+ BEGIN
+      TEST ("CA1020E", "CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE " &
+                       "REPLACED BY A GENERIC INSTANTIATION HAVING " &
+                       "THE SAME IDENTIFIER");
+ 
+      CA1020E_PROC1 (TEMP);
+      IF TEMP /= IDENT_INT(1) THEN
+           FAILED ("INSTANTIATION DID NOT REPLACE PROCEDURE");
+      END IF;
+ 
+      IF CA1020E_FUNC1 /= IDENT_INT(2) THEN
+           FAILED ("INSTANTIATION DID NOT REPLACE FUNCTION");
+      END IF;
+ 
+      CA1020E_PROC2 (TEMP);
+      IF TEMP /= IDENT_INT(5) THEN
+           FAILED ("INSTANTIATION DID NOT REPLACE PROCEDURE");
+      END IF;
+ 
+      IF CA1020E_FUNC2 /= IDENT_INT(2) THEN
+           FAILED ("INSTANTIATION DID NOT REPLACE FUNCTION");
+      END IF;
+ 
+      RESULT;
+ END CA1020E3M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,43 ----
+ -- CA1022A0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/23/84
+ 
+ PACKAGE CA1022A0 IS
+ 
+      I : INTEGER := 2;
+      PROCEDURE P0 (X : IN OUT INTEGER );
+ 
+ END CA1022A0;
+ 
+ PACKAGE BODY CA1022A0 IS
+ 
+      PROCEDURE P0 (X : IN OUT INTEGER) IS
+      BEGIN
+ 
+           X := X + 1;
+ 
+      END P0;
+ 
+ END CA1022A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,33 ----
+ -- CA1022A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/23/84
+ 
+ WITH CA1022A0;
+ PROCEDURE CA1022A1 (Y : IN OUT INTEGER) IS
+ BEGIN
+ 
+      CA1022A0.P0 (Y);
+ 
+ END CA1022A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,33 ----
+ -- CA1022A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/23/84
+ 
+ WITH CA1022A0;
+ FUNCTION CA1022A2 (Z : INTEGER := 1) RETURN BOOLEAN IS
+ BEGIN
+ 
+      RETURN TRUE;
+ 
+ END CA1022A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- CA1022A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- RECOMPILATION OF PACKAGE CA1022A0.
+ 
+ -- BHS 7/23/84
+ 
+ PACKAGE CA1022A0 IS
+ 
+      I, J : INTEGER;
+      PROCEDURE P0 (X : IN OUT INTEGER);
+      FUNCTION F RETURN INTEGER;
+ 
+ END CA1022A0;
+ 
+ PACKAGE BODY CA1022A0 IS
+ 
+      PROCEDURE P0 (X : IN OUT INTEGER) IS
+      BEGIN
+ 
+           X := X + 2;
+ 
+      END P0;
+ 
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+ 
+           RETURN 3;
+ 
+      END F;
+ 
+ END CA1022A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- CA1022A4.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- RECOMPILATION OF PROCEDURE CA1022A1.
+ 
+ -- BHS 7/23/84
+ 
+ WITH CA1022A0;
+ PROCEDURE CA1022A1 (Y : IN OUT INTEGER) IS
+ BEGIN
+ 
+      Y := 3;
+      CA1022A0.P0 (Y);
+ 
+ END CA1022A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a5.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a5.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a5.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA1022A5.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- RECOMPILATION OF FUNCTION CA1022A2 (DECL AND BODY).
+ 
+ -- BHS 7/23/84
+ 
+ FUNCTION CA1022A2 (Z : INTEGER := 1) RETURN BOOLEAN IS
+ BEGIN
+ 
+      RETURN Z /= 1;
+ 
+ END CA1022A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a6.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1022a6.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1022a6.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- CA1022A6M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A SUBPROGRAM BODY IS INITIALLY COMPILED WITH A CONTEXT
+ -- CLAUSE AND A UNIT NAMED IN THE CONTEXT CLAUSE IS RECOMPILED, THEN AN
+ -- ATTEMPT TO COMPILE THE BODY AGAIN WILL SUCCEED IF THE CONTEXT CLAUSE
+ -- IS PRESENT.
+ -- CHECK THAT IF THE RECOMPILED UNIT IS NOT NEEDED IN THE SUBPROGRAM
+ -- BODY, THE BODY CAN BE SUCCESSFULLY RECOMPILED WITHOUT MENTIONING THE
+ -- RECOMPILED UNIT.
+ 
+ -- SEPARATE FILES ARE:
+ --     CA1022A0  A LIBRARY PACKAGE.
+ --     CA1022A1  A LIBRARY PROCEDURE.
+ --     CA1022A2  A LIBRARY FUNCTION.
+ --     CA1022A3  A LIBRARY PACKAGE (CA1022A0).
+ --     CA1022A4  A LIBRARY PROCEDURE (CA1022A1).
+ --     CA1022A5  A LIBRARY FUNCTION (CA1022A2).
+ --     CA1022A6M THE MAIN PROCEDURE.
+ 
+ -- BHS 7/23/84
+ 
+ WITH CA1022A1, CA1022A2;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CA1022A6M IS
+ 
+      I : INTEGER := 1;
+ 
+ BEGIN
+ 
+      TEST ("CA1022A", "USE OF CONTEXT CLAUSES NAMING RECOMPILED " &
+                       "UNITS WITH RECOMPILED SUBPROGRAMS");
+ 
+      CA1022A1(I);
+      IF I /= 5 THEN
+           FAILED ("PROCEDURE CA1022A1 NOT INVOKED CORRECTLY");
+      END IF;
+ 
+      IF CA1022A2 THEN
+           FAILED ("FUNCTION CA1022A2 NOT INVOKED CORRECTLY");
+      END IF;
+ 
+      RESULT;
+ 
+ END CA1022A6M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,276 ----
+ -- CA11001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a child unit can be used to provide an alternate view and
+ --      operations on a private type in its parent package.  Check that a 
+ --      child unit can be a package.  Check that a WITH of a child unit 
+ --      includes an implicit WITH of its ancestor unit.  
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a private type in a package specification. Declare 
+ --      subprograms for the type.
+ --
+ --      Add a public child to the above package.  Within the body of this
+ --      package, access the private type. Declare operations to read and 
+ --      write to its parent private type.
+ --
+ --      In the main program, "with" the child.  Declare objects of the
+ --      parent private type.  Access the subprograms from both parent and
+ --      child packages.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CA11001_0 is   -- Cartesian_Complex
+ --  This package represents a Cartesian view of a complex number.  It contains 
+ --  a private type plus subprograms to construct and decompose a complex 
+ --  number.
+ 
+    type Complex_Int is range 0 .. 100;
+ 
+    type Complex_Type is private;
+ 
+    Constant_Complex : constant Complex_Type;
+ 
+    Complex_Error : exception;
+ 
+    procedure Cartesian_Assign   (R, I : in     Complex_Int; 
+                                  C    :    out Complex_Type);
+ 
+    function Cartesian_Real_Part (C : Complex_Type) 
+      return Complex_Int;
+ 
+    function Cartesian_Imag_Part (C : Complex_Type) 
+      return Complex_Int;
+ 
+    function Complex (Real, Imaginary : Complex_Int)
+      return Complex_Type;                             
+ 
+ private
+    type Complex_Type is                      -- Parent private type
+       record
+          Real, Imaginary : Complex_Int;
+       end record;
+ 
+    Constant_Complex : constant Complex_Type := (Real => 0, Imaginary => 0);
+ 
+ end CA11001_0;       -- Cartesian_Complex
+ 
+ --=======================================================================--
+ 
+ package body CA11001_0 is  -- Cartesian_Complex
+ 
+    procedure Cartesian_Assign (R, I : in     Complex_Int; 
+                                C    :    out Complex_Type) is
+    begin
+       C.Real      := R;
+       C.Imaginary := I;
+    end Cartesian_Assign;
+    -------------------------------------------------------------
+    function Cartesian_Real_Part (C : Complex_Type) 
+      return Complex_Int is
+    begin
+       return C.Real;
+    end Cartesian_Real_Part;
+    -------------------------------------------------------------
+    function Cartesian_Imag_Part (C : Complex_Type) 
+      return Complex_Int is
+    begin
+       return C.Imaginary;
+    end Cartesian_Imag_Part;
+    -------------------------------------------------------------
+    function Complex (Real, Imaginary : Complex_Int)
+      return Complex_Type is
+    begin
+       return (Real, Imaginary);
+    end Complex;
+ 
+ end CA11001_0;      -- Cartesian_Complex
+ 
+ --=======================================================================--
+ 
+ package CA11001_0.CA11001_1 is    -- Polar_Complex
+ --  This public child provides a different view of the private type from its
+ --  parent.  It provides a polar view by the provision of subprograms which
+ --  construct and decompose a complex number.
+ 
+    procedure Polar_Assign (R, Theta : in     Complex_Int; 
+                            C        :    out Complex_Type);  
+                                              -- Complex_Type is a 
+                                              -- record of CA11001_0
+ 
+    function Polar_Real_Part (C: Complex_Type) return Complex_Int;           
+ 
+    function Polar_Imag_Part (C: Complex_Type) return Complex_Int;
+ 
+    function Equals_Const (Num : Complex_Type) return Boolean;
+ 
+ end CA11001_0.CA11001_1;    -- Polar_Complex
+ 
+ --=======================================================================--
+ 
+ package body CA11001_0.CA11001_1 is   -- Polar_Complex
+ 
+    function Cos (Angle : Complex_Int) return Complex_Int is
+       Num : constant Complex_Int := 2;
+    begin
+       return (Angle * Num);   -- not true Cosine function
+    end Cos;
+    -------------------------------------------------------------
+    function Sine (Angle : Complex_Int) return Complex_Int is
+    begin
+       return 1;     -- not true Sine function
+    end Sine;
+    -------------------------------------------------------------
+    function Sqrt (Num : Complex_Int) 
+      return Complex_Int is
+    begin
+      return (Num);     -- not true Square root function
+    end Sqrt;
+    -------------------------------------------------------------
+    function Tan  (Angle : Complex_Int) return Complex_Int is
+    begin
+      return Angle;     -- not true Tangent function
+    end Tan;
+    -------------------------------------------------------------
+    procedure Polar_Assign (R, Theta : in     Complex_Int;  
+                            C        :    out Complex_Type) is 
+    begin
+       if R = 0 and Theta = 0 then
+          raise Complex_Error;
+       end if;
+       C.Real := R * Cos (Theta);
+       C.Imaginary := R * Sine (Theta);
+    end Polar_Assign;
+    -------------------------------------------------------------
+    function Polar_Real_Part (C: Complex_Type) return Complex_Int is
+    begin
+       return Sqrt ((Cartesian_Imag_Part (C)) ** 2 + 
+                    (Cartesian_Real_Part (C)) ** 2);
+    end Polar_Real_Part;
+    -------------------------------------------------------------
+    function Polar_Imag_Part (C: Complex_Type) return Complex_Int is
+    begin
+       return (Tan (Cartesian_Imag_Part (C) / 
+               Cartesian_Real_Part (C)));
+    end Polar_Imag_Part;
+    -------------------------------------------------------------
+    function Equals_Const (Num : Complex_Type) return Boolean is
+    begin
+       return Num.Real = Constant_Complex.Real and
+          Num.Imaginary = Constant_Complex.Imaginary;
+    end Equals_Const;
+ 
+ end CA11001_0.CA11001_1;     -- Polar_Complex
+ 
+ --=======================================================================--
+ 
+ with CA11001_0.CA11001_1;        -- Polar_Complex
+ with Report;
+ 
+ procedure CA11001 is
+ 
+    Complex_No  : CA11001_0.Complex_Type;    -- Complex_Type is a
+                                             -- record of CA11001_0
+ 
+    Complex_5x2 : CA11001_0.Complex_Type := CA11001_0.Complex (5, 2);
+ 
+    Int_2       :  CA11001_0.Complex_Int 
+                := CA11001_0.Complex_Int (Report.Ident_Int (2));
+ 
+ begin
+ 
+    Report.Test ("CA11001", "Check that a child unit can be used " &
+                 "to provide an alternate view and operations " &
+                 "on a private type in its parent package");
+ 
+    Basic_View_Subtest:
+ 
+    begin
+       -- Assign using Cartesian coordinates.
+       CA11001_0.Cartesian_Assign 
+         (CA11001_0.Complex_Int (Report.Ident_Int (1)), Int_2, Complex_No);
+ 
+       -- Read back in Polar coordinates.
+       -- Polar values are surrogates used in checking for correct
+       -- subprogram calls.
+       if CA11001_0."/=" (CA11001_0.CA11001_1.Polar_Real_Part (Complex_No),
+         CA11001_0.Cartesian_Real_Part (Complex_5x2)) and CA11001_0."/="
+           (CA11001_0.CA11001_1.Polar_Imag_Part (Complex_No),  
+             CA11001_0.Cartesian_Imag_Part (Complex_5x2)) then
+            Report.Failed ("Incorrect Cartesian result");
+       end if;
+ 
+    end Basic_View_Subtest;
+    -------------------------------------------------------------
+    Alternate_View_Subtest:
+    begin
+       -- Assign using Polar coordinates.
+       CA11001_0.CA11001_1.Polar_Assign 
+         (Int_2, CA11001_0.Complex_Int (Report.Ident_Int (3)), Complex_No);
+ 
+       -- Read back in Cartesian coordinates.
+       if CA11001_0."/=" (CA11001_0.Cartesian_Real_Part 
+         (Complex_No), CA11001_0.Complex_Int (Report.Ident_Int (12))) or 
+           CA11001_0."/=" (CA11001_0.Cartesian_Imag_Part (Complex_No), Int_2) 
+       then
+          Report.Failed ("Incorrect Polar result");
+       end if;
+    end Alternate_View_Subtest;
+    -------------------------------------------------------------
+    Other_Subtest:
+    begin
+       -- Assign using Polar coordinates.
+       CA11001_0.CA11001_1.Polar_Assign 
+         (CA11001_0.Complex_Int (Report.Ident_Int (0)), Int_2, Complex_No);
+ 
+       -- Compare with Complex_Num in CA11001_0.
+       if not CA11001_0.CA11001_1.Equals_Const (Complex_No)
+         then
+          Report.Failed ("Incorrect result");
+       end if;
+    end Other_Subtest;
+    -------------------------------------------------------------
+    Exception_Subtest:
+    begin
+       -- Raised parent's exception.
+       CA11001_0.CA11001_1.Polar_Assign 
+         (CA11001_0.Complex_Int (Report.Ident_Int (0)), 
+            CA11001_0.Complex_Int (Report.Ident_Int (0)), Complex_No);
+       Report.Failed ("Exception was not raised");
+    exception
+       when CA11001_0.Complex_Error => 
+          null;
+       when others                  =>
+          Report.Failed ("Unexpected exception raised in test");
+    end Exception_Subtest;
+ 
+    Report.Result;
+ 
+ end CA11001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,238 ----
+ -- CA11002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a public child can utilize its parent unit's visible 
+ --      definitions.
+ --      
+ -- TEST DESCRIPTION:
+ --      Declare a parent package that contains the following: type, object,
+ --      constant, exception, and subprograms.  Declare a public child unit
+ --      that utilizes the components found in the visible part of its parent.
+ --
+ --      Demonstrate utilization of the following parent components in the 
+ --      child package:
+ --
+ --                          Parent
+ --          Type              X
+ --          Constant          X
+ --          Object            X           
+ --          Subprogram        X           
+ --          Exception         X           
+ --
+ --      This abstraction simulates a portion of a simple operating system.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CA11002_0 is                      -- Package OS.
+ 
+    type File_Descriptor is new Integer;
+    type File_Mode is (Read_Only, Write_Only, Read_Write);
+ 
+    Null_File    : constant File_Descriptor := 0;
+    Default_Mode : constant File_Mode       := Read_Only;
+    Active_Mode  : constant File_Mode       := Read_Write;
+ 
+    type File_Type is 
+      record
+         Descriptor : File_Descriptor := Null_File;
+         Mode       : File_Mode       := Default_Mode;
+      end record;
+ 
+    System_File     : File_Type;
+    File_Mode_Error : exception;
+ 
+    function Next_Available_File return File_Descriptor;
+ 
+    function Mode_Of_File (File : File_Type) return File_Mode;
+ 
+ end CA11002_0;                            -- Package OS. 
+ 
+      --=================================================================--
+ 
+ package body CA11002_0 is                 -- Package body OS.
+    
+    File_Count : Integer := 0;
+ 
+    function Next_Available_File return File_Descriptor is
+    begin
+       File_Count := File_Count + 1;
+       return (File_Descriptor(File_Count));    -- Type conversion.
+    end Next_Available_File;
+    --------------------------------------------------------------
+    function Mode_Of_File (File : File_Type) return File_Mode is
+       Mode : File_Mode := File.Mode;
+    begin
+       return (Mode);
+    end Mode_Of_File;
+ 
+ end CA11002_0;                            -- Package body OS.
+ 
+      --=================================================================--
+ 
+ package CA11002_0.CA11002_1 is            -- Child package OS.Operations.
+ 
+    -- Dot qualification of types, objects, etc. from parent is not required
+    -- in a child unit.
+ 
+    procedure Create_File (Mode : in     File_Mode:= Active_Mode;
+                           File :    out File_Type);    
+ 
+ end CA11002_0.CA11002_1;                  -- Child package OS.Operations. 
+ 
+      --=================================================================--
+ 
+ with Report;
+ package body CA11002_0.CA11002_1 is       -- Child package body OS.Operations.
+ 
+    function New_File_Validated (File : File_Type)        -- Ensure that a newly
+      return Boolean is                                   -- created file has
+       Result : Boolean := False;                         -- appropriate values.
+    begin                                                 
+       if (File.Descriptor > System_File.Descriptor) and  -- Parent object.
+          (File.Mode  in  File_Mode )                     -- Parent type.
+       then
+          Result := True;
+       end if;
+ 
+       return (Result);
+ 
+    end New_File_Validated;
+    --------------------------------------------------------------
+    procedure Create_File 
+      (Mode       : in     File_Mode := Active_Mode;     -- Parent constant.
+       File       :    out File_Type) is                 -- Parent type.
+ 
+       New_File : File_Type;
+ 
+    begin
+       New_File.Descriptor := Next_Available_File;       -- Parent subprogram.
+       New_File.Mode       := Mode;
+ 
+       if New_File_Validated (File => New_File) then
+          File := New_File;
+       end if;
+ 
+    end Create_File;
+ 
+ end CA11002_0.CA11002_1;                  -- Child Package body OS.Operations.
+ 
+      --=================================================================--
+ 
+ -- Child library subprogram Convert_File_Mode specification.
+ procedure CA11002_0.CA11002_2 (File     : in out File_Type;    -- Parent type. 
+                                New_Mode : in     File_Mode);   -- Parent type.
+ 
+ 
+      --=================================================================--
+ with Report;
+ 
+ -- Child library subprogram Convert_File_Mode body.
+ procedure CA11002_0.CA11002_2 (File     : in out File_Type;   
+                                New_Mode : in     File_Mode) is
+ begin
+    if File.Mode = New_Mode then
+       raise File_Mode_Error;                               -- Parent exception.
+       Report.Failed ("Exception not raised in child unit");
+    else
+       File.Mode := New_Mode;
+    end if;
+ end CA11002_0.CA11002_2;
+ 
+      --=================================================================--
+ 
+ with Report;
+ with CA11002_0.CA11002_1;          -- Child package OS.Operations.
+ with CA11002_0.CA11002_2;          -- Child subprogram OS.Convert_File_Mode,
+                                    -- Implicitly with parent, OS.
+ use CA11002_0;                     -- All user-defined operators directly
+                                    -- visible.
+ procedure CA11002 is
+ begin
+ 
+    Report.Test ("CA11002", "Check that a public child can utilize its " &
+                 "parent unit's visible definitions");
+ 
+    File_Creation:                   -- This processing block will demonstrate
+                                     -- use of child package subroutine that
+                                     -- takes advantage of components declared
+                                     -- in the parent package.
+    declare
+       User_File : File_Type;
+    begin
+       CA11002_0.CA11002_1.Create_File (File => User_File); -- Default mode
+                                                            -- parameter used in
+                                                            -- this call.
+       if (User_File.Descriptor = System_File.Descriptor) or
+          (User_File.Mode       = Default_Mode) 
+       then
+          Report.Failed ("Incorrect file creation");
+       end if;
+ 
+    end File_Creation;
+ 
+    --------------------------------------------------------------
+    File_Mode_Conversion:            -- This processing block will demonstrate
+                                     -- the occurrence of a (forced) exception
+                                     -- being raised in a child subprogram, and
+                                     -- propagated to the caller.  The exception
+                                     -- is handled, and the child subprogram
+                                     -- is called again, this time to perform
+                                     -- without error.
+    declare
+       procedure Convert_File_Mode (File : in out File_Type; 
+         New_Mode : in File_Mode) renames CA11002_0.CA11002_2; 
+       New_File : File_Type;
+    begin                               -- Raise an exception with this
+                                        -- illegal conversion operation
+                                        -- (attempt to change to current mode).
+ 
+       Convert_File_Mode (File     => New_File,
+                          New_Mode => Default_Mode);
+       Report.Failed ("Exception should have been raised in child unit");
+ 
+    exception
+       when File_Mode_Error =>          -- Perform the conversion again, this
+                                        -- time with a different file mode.
+ 
+          Convert_File_Mode (File     => New_File,
+                             New_Mode => CA11002_0.Active_Mode);
+ 
+          if New_File.Mode /= Read_Write then
+             Report.Failed ("Incorrect result from mode conversion operation");
+          end if;
+ 
+       when others =>
+          Report.Failed ("Unexpected exception raised in File_Mode_Conversion");
+ 
+    end File_Mode_Conversion;
+ 
+    Report.Result;
+ 
+ end CA11002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,290 ----
+ -- CA11003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a public grandchild can utilize its ancestor unit's visible 
+ --      definitions.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a public package, public child package, and public 
+ --      grandchild package and library unit function.  Within the 
+ --      grandchild package and function, make use of components that are 
+ --      declared in the ancestor packages, both parent and grandparent.  
+ --
+ --      Use the following ancestral components in the grandchildren library
+ --      units:
+ --                       Grandparent   Parent
+ --          Type              X           X
+ --          Constant          X           X
+ --          Object            X           X
+ --          Subprogram        X           X
+ --          Exception         X           X
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Dec 94   SAIC    Modified procedure Create_File
+ --      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --
+ --!
+    
+ package CA11003_0 is      -- Package OS 
+ 
+    type File_Descriptor is new Integer;
+    type File_Mode       is (Read_Only, Write_Only, Read_Write);
+ 
+    Null_File       : constant File_Descriptor := 0;
+    Default_Mode    : constant File_Mode       := Read_Only;
+    File_Data_Error : exception;
+ 
+    type File_Type is tagged
+      record
+         Descriptor : File_Descriptor := Null_File;
+         Mode       : File_Mode       := Read_Write;
+      end record;
+ 
+    System_File : File_Type;
+ 
+    function Next_Available_File return File_Descriptor;
+ 
+    procedure Reclaim_File_Descriptor;
+ 
+ end CA11003_0;               -- Package OS 
+ 
+      --=================================================================--
+ 
+ package body CA11003_0 is    -- Package body OS 
+    
+    File_Count : Integer := 0;
+ 
+    function Next_Available_File return File_Descriptor is
+    begin
+       File_Count := File_Count + 1;
+       return (File_Descriptor(File_Count));
+    end Next_Available_File;
+    --------------------------------------------------
+    procedure Reclaim_File_Descriptor is
+    begin
+       null;                                        -- Dummy processing unit.
+    end Reclaim_File_Descriptor;
+ 
+ end CA11003_0;                          -- Package body OS 
+ 
+      --=================================================================--
+ 
+ package CA11003_0.CA11003_1 is          -- Child package OS.Operations
+ 
+    subtype File_Length_Type is Integer range 0 .. 1000;
+    Min_File_Size : File_Length_Type := File_Length_Type'First;
+    Max_File_Size : File_Length_Type := File_Length_Type'Last;
+ 
+    File_Duplication_Error : exception;
+ 
+    type Extended_File_Type is new File_Type with private;
+ 
+    procedure Create_File (Mode : in     File_Mode;
+                           File :    out Extended_File_Type);    
+ 
+    procedure Duplicate_File (Original  : in     Extended_File_Type;
+                              Duplicate :    out Extended_File_Type);
+ 
+ private
+    type Extended_File_Type is new File_Type with
+       record
+          Blocks : File_Length_Type := Min_File_Size;
+       end record;
+ 
+    System_Extended_File : Extended_File_Type;
+ 
+ end CA11003_0.CA11003_1;                -- Child Package OS.Operations 
+ 
+      --=================================================================--
+ 
+ package body CA11003_0.CA11003_1 is     -- Child package body OS.Operations
+ 
+    procedure Create_File 
+      (Mode : in     File_Mode;
+       File :    out Extended_File_Type) is                 
+    begin
+       File.Descriptor := Next_Available_File;           -- Parent subprogram.
+       File.Mode       := Default_Mode;                  -- Parent constant.
+       File.Blocks     := Min_File_Size;
+    end Create_File;
+    --------------------------------------------------
+    procedure Duplicate_File (Original  : in     Extended_File_Type;
+                              Duplicate :    out Extended_File_Type) is
+    begin
+       Duplicate.Descriptor := Next_Available_File;      -- Parent subprogram.
+       Duplicate.Mode       := Original.Mode;
+       Duplicate.Blocks     := Original.Blocks;
+    end Duplicate_File;
+ 
+ end CA11003_0.CA11003_1;                   -- Child package body OS.Operations
+ 
+      --=================================================================--
+ 
+ -- This package contains menu selectable operations for manipulating files.
+ -- This abstraction builds on the capabilities available from ancestor
+ -- packages.
+ 
+ package CA11003_0.CA11003_1.CA11003_2 is   
+ 
+    procedure News (Mode : in     File_Mode;
+                    File :    out Extended_File_Type);    
+ 
+    procedure Copy (Original  : in     Extended_File_Type;
+                    Duplicate :    out Extended_File_Type);
+ 
+    procedure Delete   (File : in Extended_File_Type);
+ 
+ end CA11003_0.CA11003_1.CA11003_2;  -- Grandchild package OS.Operations.Menu
+  
+      --=================================================================--
+ 
+ -- Grandchild subprogram Validate 
+ function  CA11003_0.CA11003_1.CA11003_3 (File : in Extended_File_Type) 
+   return Boolean;     
+ 
+      --=================================================================--
+ 
+ -- Grandchild subprogram Validate 
+ function  CA11003_0.CA11003_1.CA11003_3         
+   (File : in Extended_File_Type)                            -- Parent type.
+   return Boolean is      
+ 
+    function New_File_Validated (File : Extended_File_Type) 
+        return Boolean is  
+    begin                                                
+       if (File.Descriptor > System_File.Descriptor) and     -- Grandparent
+          (File.Mode in File_Mode ) and                      -- object and type
+          not ((File.Blocks < System_Extended_File.Blocks) or       
+               (File.Blocks > Max_File_Size))                -- Parent object
+       then                                                  -- and constant.
+          return True;
+       else
+          return False;
+       end if;
+    end New_File_Validated;
+       
+ begin
+    return (New_File_Validated (File)) and    
+           (File.Descriptor /= Null_File);              -- Grandparent constant.
+                                                  
+ end CA11003_0.CA11003_1.CA11003_3;      -- Grandchild subprogram Validate
+ 
+      --=================================================================--
+ 
+ with CA11003_0.CA11003_1.CA11003_3;
+                                  -- Grandchild package body OS.Operations.Menu
+ package body CA11003_0.CA11003_1.CA11003_2 is  
+ 
+    procedure News (Mode : in     File_Mode;
+                    File :    out Extended_File_Type) is   -- Parent type.
+    begin
+       Create_File (Mode, File);                           -- Parent subprogram.
+       if not CA11003_0.CA11003_1.CA11003_3 (File) then                       
+          raise File_Data_Error;                       -- Grandparent exception.
+       end if;
+    end News;
+    --------------------------------------------------
+    procedure Copy (Original  : in     Extended_File_Type;
+                    Duplicate :    out Extended_File_Type) is
+    begin
+       Duplicate_File (Original, Duplicate);               -- Parent subprogram.
+ 
+       if Original.Descriptor = Duplicate.Descriptor then
+          raise File_Duplication_Error;                    -- Parent exception.
+       end if;
+ 
+    end Copy;
+    --------------------------------------------------
+    procedure Delete (File : in Extended_File_Type) is
+    begin
+       Reclaim_File_Descriptor;                            -- Grandparent
+    end Delete;                                            -- subprogram.
+ 
+ end CA11003_0.CA11003_1.CA11003_2;  
+ 
+      --=================================================================--
+ 
+ with CA11003_0.CA11003_1.CA11003_2;  -- Grandchild Pkg OS.Operations.Menu
+ with CA11003_0.CA11003_1.CA11003_3;  -- Grandchild Ftn OS.Operations.Validate
+ with Report;
+ 
+ procedure CA11003 is
+ 
+    package Menu renames CA11003_0.CA11003_1.CA11003_2;
+ 
+ begin
+ 
+    Report.Test ("CA11003", "Check that a public grandchild can utilize " &
+                 "its ancestor unit's visible definitions");
+ 
+    File_Processing:         -- Validate all of the capabilities contained in 
+                             -- the Menu package by exercising them on specific 
+                             -- files.  This will demonstrate the use of child
+                             -- and grandchild functionality based on components
+                             -- that have been declared in the
+                             -- parent/grandparent package.
+    declare
+ 
+       function Validate (File : CA11003_0.CA11003_1.Extended_File_Type) 
+         return Boolean renames CA11003_0.CA11003_1.CA11003_3;
+ 
+       MacWrite_File,
+       Backup_Copy : CA11003_0.CA11003_1.Extended_File_Type;        
+       MacWrite_File_Mode : CA11003_0.File_Mode := CA11003_0.Read_Write;
+                                      
+    begin                                                
+                                                         
+       Menu.News (MacWrite_File_Mode, MacWrite_File);                          
+ 
+       if not Validate (MacWrite_File) then
+          Report.Failed ("Incorrect initialization of files");
+       end if;
+ 
+       Menu.Copy (MacWrite_File, Backup_Copy);
+ 
+       if not (Validate (MacWrite_File) and 
+               Validate (Backup_Copy))
+       then
+          Report.Failed ("Incorrect duplication of files");
+       end if;
+ 
+       Menu.Delete (Backup_Copy);
+ 
+    exception
+       when CA11003_0.File_Data_Error =>
+           Report.Failed ("Exception raised during file validation");
+       when CA11003_0.CA11003_1.File_Duplication_Error =>
+           Report.Failed ("Exception raised during file duplication");
+       when others =>
+           Report.Failed ("Unexpected exception in test procedure");
+ 
+    end File_Processing;
+ 
+    Report.Result;
+ 
+ end CA11003; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110040.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110040.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110040.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110040.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,90 ----
+ -- CA110040.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA110042.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See CA110042.AM
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --      => CA110040.A
+ --         CA110041.A
+ --         CA110042.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue; Added pragma 
+ --                          Elaborate_Body.
+ --
+ --!
+ 
+ package CA110040 is                              -- Package Computer_System.
+    pragma Elaborate_Body (CA110040);
+ 
+    -- Types.
+    type ID_Type                 is range 1 .. 4;
+    type System_Account_Capacity is new ID_Type;
+ 
+    type Account is tagged 
+       record
+          User_ID : ID_Type;
+       end record;
+ 
+    -- Constants.
+    Maximum_System_Accounts : constant System_Account_Capacity := 
+      System_Account_Capacity'Last;
+ 
+    System_Administrator    : constant ID_Type := 
+      ID_Type (System_Account_Capacity'First);
+ 
+    Administrator_Account   : constant Account := 
+      (User_ID => System_Administrator);
+ 
+    -- Objects.
+    Total_Accounts           : System_Account_Capacity  := 1;
+ 
+    -- Exceptions.
+    Illegal_Account          : exception;
+    Account_Limit_Exceeded   : exception;
+ 
+    -- Subprograms.
+    function Next_Available_ID return ID_Type;
+ 
+ end CA110040;                                -- Package Computer_System.
+ 
+      --=================================================================--
+ 
+ package body CA110040 is                     -- Package body Computer_System.
+ 
+    function Next_Available_ID return ID_Type is
+    begin
+       Total_Accounts := Total_Accounts + 1;
+       return (ID_Type(Total_Accounts));
+    end Next_Available_ID;
+ 
+ end CA110040;                                -- Package body Computer_System.
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110041.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110041.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110041.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110041.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- CA110041.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA110042.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See CA110042.AM
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         CA110040.A
+ --      => CA110041.A
+ --         CA110042.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ package CA110040.CA110041 is         -- Child Package Computer_System.Manager
+ 
+    type User_Account is new Account with private;
+ 
+    procedure Initialize_User_Account (Acct : out User_Account);
+ 
+ private
+ 
+ -- The private portion of this spec demonstrates that components contained
+ -- in the visible part of the parent are directly visible in the private 
+ -- part of a public child.
+ 
+    type Account_Access_Type is (None, Guest, User, System);
+ 
+    type User_Account is new Account with                   -- Parent type.
+       record
+          Privilege : Account_Access_Type := None;
+       end record;
+ 
+    System_Account : User_Account := 
+      (User_ID   => Administrator_Account.User_ID,          -- Parent constant.
+       Privilege => System);                                -- User_ID has been
+                                                            -- set to 1.
+    Auditor_Account : User_Account :=
+      (User_ID   => Next_Available_ID,                      -- Parent function.
+       Privilege => System);                                -- User_ID has been
+                                                            -- set to 2.
+    Total_Authorized_Accounts : System_Account_Capacity 
+      renames Total_Accounts;                               -- Parent object.
+ 
+    Unauthorized_Account : exception 
+      renames Illegal_Account;                              -- Parent exception
+ 
+ end CA110040.CA110041;             -- Child Package Computer_System.Manager
+ 
+      --=================================================================--
+ 
+                                  -- Child Package body Computer_System.Manager
+ package body CA110040.CA110041 is  
+ 
+    function  Account_Limit_Reached  return Boolean is
+    begin
+       if Total_Authorized_Accounts = Maximum_System_Accounts then
+          return (True);
+       else
+          return (False);
+       end if;
+    end Account_Limit_Reached;
+    ---------------------------------------------------------------
+    function Valid_Account (Acct : User_Account) return Boolean is
+       Result : Boolean := False; 
+    begin
+       if (Acct.User_ID /= System_Account.User_ID) and
+          (Acct.User_ID /= Auditor_Account.User_ID) 
+       then
+          Result := True;
+       end if;
+       return (Result);
+    end Valid_Account;
+    ---------------------------------------------------------------
+    procedure Initialize_User_Account (Acct : out User_Account) is
+    begin
+       if Account_Limit_Reached then
+          raise Account_Limit_Exceeded;           
+       else                                       
+          Acct.User_ID := Next_Available_ID;
+          Acct.Privilege := User;
+       end if;
+       if not Valid_Account (Acct) then
+          raise Unauthorized_Account;
+       end if;
+    end Initialize_User_Account;
+ 
+ end CA110040.CA110041;          -- Child Package body Computer_System.Manager
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110042.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110042.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110042.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110042.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,130 ----
+ -- CA110042.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the private part of a child library unit package can
+ --      utilize its parent unit's visible definitions.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a public library unit package and child package, with the
+ --      child package having a private part in the specification.  Within
+ --      this child private part, make use of components that are declared in
+ --      the visible part of the parent.
+ --
+ --      Demonstrate visibility to the following parent components in the 
+ --      child private part:
+ --                          Parent
+ --          Type              X
+ --          Constant          X
+ --          Object            X           
+ --          Subprogram        X           
+ --          Exception         X           
+ --
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         CA110040.A
+ --         CA110041.A
+ --      => CA110042.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ with Report;
+ with CA110040.CA110041;
+ 
+ procedure CA110042 is
+ 
+       package System_Manager renames CA110040.CA110041;
+       use CA110040;
+       User1, User2, User3 : System_Manager.User_Account;
+ 
+ begin
+ 
+    Report.Test ("CA110042", "Check that the private part of a child "     &
+                             "library unit package can utilize its "       &
+                             "parent unit's visible definitions");
+ 
+    Assign_New_Accounts:            -- This code simulates the entering of new
+                                    -- user accounts into a computer system.
+                                    -- It also simulates the processing that
+                                    -- could occur when the limit on system
+                                    -- accounts has been exceeded.
+ 
+                                    -- This processing block demonstrates the
+                                    -- use of child package functionality that
+                                    -- takes advantage of components declared in
+                                    -- the parent package.
+    begin
+ 
+       if Total_Accounts /= 2 then
+          Report.Failed ("Incorrect number of accounts currently allocated");
+       end if;                                         -- At this point, both
+                                                       -- System_Account and
+                                                       -- Auditor_Account have
+                                                       -- been declared and
+                                                       -- initialized in package
+                                                       -- CA110040.CA110041.
+ 
+       System_Manager.Initialize_User_Account (User1); -- User_ID has been
+                                                       -- set to 3.
+ 
+       System_Manager.Initialize_User_Account (User2); -- User_ID has been
+                                                       -- set to 4, which
+                                                       -- is the last value
+                                                       -- defined for the
+                                                       -- CA110040.ID_Type
+                                                       -- range.
+ 
+       System_Manager.Initialize_User_Account (User3); -- This final call will 
+                                                       -- result in an 
+                                                       -- Account_Limit_Exceeded
+                                                       -- exception being raised.
+ 
+       Report.Failed ("Control should have transferred with exception");
+ 
+    exception
+ 
+       when Account_Limit_Exceeded =>
+          if (not (Administrator_Account.User_ID = ID_Type'First)) or
+            (User2.User_ID /= CA110040.ID_Type'Last)
+          then
+             Report.Failed ("Account initialization failure");
+          end if;
+       when others =>
+          Report.Failed ("Unexpected exception raised");
+ 
+    end Assign_New_Accounts;
+ 
+    if (User1.User_ID /= 3) or (User2.User_ID /= 4) then
+       Report.Failed ("Improper initialization of user accounts");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA110042;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110050.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110050.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110050.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110050.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,99 ----
+ -- CA110050.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA110051.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See CA110051.AM
+ --
+ -- TEST FILES:
+ --      The test consists of the following files:
+ --
+ --      => CA110050.A
+ --         CA110051.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Dec 94   SAIC    Modified discriminant type 
+ --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue; Added pragma 
+ --                          Elaborate_Body.
+ --
+ --!
+   
+ package CA110050_0 is                   -- Package Messages.
+    pragma Elaborate_Body (CA110050_0);
+ 
+    type Descriptor is new Integer;
+ 
+    Null_Descriptor_Value   : constant Descriptor := 0;
+    Null_Message_Descriptor : constant Descriptor := 0;
+ 
+    type Message_Type is tagged 
+       record
+          Number : Descriptor := Null_Message_Descriptor;
+       end record;
+ 
+    function Next_Available_Message return Descriptor;
+ 
+ end CA110050_0;                         -- Package Messages.
+ 
+      --=================================================================--
+ 
+ package body CA110050_0 is              -- Package body Messages.
+ 
+    Message_Count : Integer := 0;
+ 
+    function Next_Available_Message return Descriptor is
+    begin
+       Message_Count := Message_Count + 5;
+       return (Descriptor(Message_Count));
+    end Next_Available_Message;
+ 
+ end CA110050_0;                         -- Package body Messages.
+ 
+      --=================================================================--
+ 
+ package CA110050_0.CA110050_1 is        -- Child package Messages.Text
+ 
+    subtype Default_Length is Natural range 0 .. 80;
+ 
+    type Text_Type (Max_Length : Default_Length := 0) is
+       record
+          Length      : Default_Length := Max_Length;
+          Text_Field  : String (1 .. Max_Length);
+       end record;
+ 
+    type Text_Message_Type is new Message_Type with
+       record
+          Text : Text_Type;
+       end record;
+ 
+    Null_Text    : Text_Type (0);                     -- Null range for 
+                                                      -- Text_Field component.
+ 
+ end CA110050_0.CA110050_1;              -- Child package Messages.Text
+ --
+ -- No package body needed for this specification.
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110051.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110051.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca110051.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca110051.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,224 ----
+ -- CA110051.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that entities and operations declared in a package can be used
+ --      in the private part of a child of a child of the package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a series of library unit packages -- parent, child, and 
+ --      grandchild.  The grandchild package will have a private part.
+ --      From within the private part of the grandchild, make use of 
+ --      components declared in the parent and grandparent packages.
+ --
+ -- TEST FILES:
+ --      The test consists of the following files:
+ --
+ --         CA110050.A
+ --      => CA110051.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+                                     -- Grandchild Package Message.Text.Encoded
+ package CA110050_0.CA110050_1.CA110050_2 is  
+ 
+    type Coded_Message is new Text_Message_Type with private;
+ 
+    procedure Send (Message : in     Coded_Message;
+                    Confirm :    out Coded_Message;
+                    Status  :    out Boolean);
+ 
+    function Encode (Message : Text_Message_Type) return Coded_Message;
+    function Decode (Message : Coded_Message)     return Boolean;
+    function Test_Connection                      return Boolean;
+ 
+ private
+ 
+    Uncoded : Descriptor renames Null_Descriptor_Value; -- Grandparent object.
+ 
+    type Coded_Message is new Text_Message_Type with    -- Parent type.
+       record
+          Key       : Descriptor := Uncoded;
+          Coded_Key : Descriptor := Next_Available_Message;
+                                  -- Grandparent type, grandparent function.
+          Scrambled : Text_Type  := Null_Text;          -- Parent object.
+       end record;                                      
+ 
+    Coded_Msg : Coded_Message;
+ 
+    type Blank_Message is new Message_Type with         -- Grandparent type.
+       record
+          ID        : Descriptor := Next_Available_Message;
+                                  -- Grandparent type, grandparent function.
+       end record;                                      
+ 
+    Test_Message     : Blank_Message;
+ 
+    Confirm_String   : constant String := "OK";
+    Scrambled_String : constant String := "KO";
+ 
+    Confirm_Text : Text_Type (Confirm_String'Length) :=
+      (Max_Length => Confirm_String'Length,
+       Length     => Confirm_String'Length,
+       Text_Field => Confirm_String);
+ 
+    Scrambled_Text : Text_Type (Scrambled_String'Length) :=
+      (Max_Length => Scrambled_String'Length,
+       Length     => Scrambled_String'Length,
+       Text_Field => Scrambled_String);
+      
+ end CA110050_0.CA110050_1.CA110050_2; -- Grandchild Pkg Message.Text.Encoded
+ 
+      --=================================================================--
+ 
+                                -- Grandchild Package body Message.Text.Encoded
+ package body CA110050_0.CA110050_1.CA110050_2 is 
+ 
+    procedure Send (Message : in     Coded_Message;
+                    Confirm :    out Coded_Message;
+                    Status  :    out Boolean) is
+ 
+       Confirmation_Message : Coded_Message :=
+         (Number    => Message.Number,
+          Text      => Confirm_Text,
+          Key       => Message.Number,
+          Coded_Key => Message.Number,
+          Scrambled => Scrambled_Text);  
+ 
+    begin                                          -- Dummy processing unit.
+       Confirm := Confirmation_Message;
+       if Confirm.Number /= Null_Message_Descriptor then
+          Status := True;                            
+       else
+          Status := False;
+       end if;
+    end Send;
+    -------------------------------------------------------------------------
+    function Encode (Message : Text_Message_Type)  return Coded_Message is
+    begin
+       Coded_Msg.Number       := Message.Number;
+       if Message.Text.Length > 0 then
+          Coded_Msg.Text      := Message.Text;     -- Record assignment.
+          Coded_Msg.Key       := Message.Number;   -- Same as msg number.
+          Coded_Msg.Coded_Key := Message.Number;   -- Same as msg number.
+          Coded_Msg.Scrambled := Message.Text;     -- Dummy processing.
+       end if;
+       return (Coded_Msg);
+    end Encode;
+    -------------------------------------------------------------------------
+    function Decode (Message : Coded_Message) return Boolean is
+       Decoded : Boolean := False;
+    begin                                                       
+       if (Message.Text.Length = Confirm_String'Length)        and then
+          (Message.Text.Text_Field = Confirm_String)           and then
+          (Message.Scrambled.Length = Scrambled_String'Length) and then
+          (Message.Scrambled.Text_Field = Scrambled_String)    and then
+          (Message.Coded_Key = 15)
+       then
+          Decoded := True;
+       end if;
+       return (Decoded);
+    end Decode;
+    -------------------------------------------------------------------------
+    function Test_Connection return Boolean is
+    begin
+       return Test_Message.Id = 10;
+    end Test_Connection;
+ 
+ end CA110050_0.CA110050_1.CA110050_2;        
+                                -- Grandchild Package body Message.Text.Encoded
+  
+      --=================================================================--
+ 
+ with CA110050_0.CA110050_1.CA110050_2; 
+ with Report;
+ 
+ procedure CA110051 is
+ 
+    package Message_Package renames CA110050_0.CA110050_1;
+    package Code_Package    renames CA110050_0.CA110050_1.CA110050_2; 
+ 
+    Message_String : constant String := "One if by land, two if by sea";
+ 
+    Message_Text   : Message_Package.Text_Type (Message_String'Length) := 
+      (Max_Length => Message_String'Length,
+       Length     => Message_String'Length,
+       Text_Field => Message_String);
+ 
+    Message : Message_Package.Text_Message_Type := 
+      (Number => CA110050_0.Next_Available_Message,
+       Text   => Message_Text);
+ 
+    Confirmation_Message : Code_Package.Coded_Message;
+    Verification_OK      : Boolean := False;
+    Transmission_OK      : Boolean := False;
+ 
+ begin
+ 
+ -- This test simulates the use of child library unit packages to implement
+ -- a message encoding and transmission scheme.  The full capability of the
+ -- encoding and transmission mechanisms are not developed here, but the 
+ -- intent is to demonstrate that a grandchild library unit package with a
+ -- private part will provide the framework for this type of processing.
+ 
+    Report.Test ("CA110051", "Check that entities and operations declared "  &
+                             "in a package can be used in the private part " & 
+                             "of a child of a child of the package");
+ 
+                             -- The following code demonstrates the use
+                             -- of functionality contained in a grandchild
+                             -- library unit.  The grandchild unit made use
+                             -- of components declared in the ancestor
+                             -- packages.
+    
+    Code_Package.Send                            -- Message object declared
+      (Message => Code_Package.Encode (Message), -- above in "encoded" by a
+       Confirm => Confirmation_Message,          -- call to grandchild pkg
+       Status  => Transmission_OK);              -- function call, reseting
+                                                 -- fields and returning a
+                                                 -- coded message to the
+                                                 -- parameter.  The confirm
+                                                 -- parameter receives an
+                                                 -- encoded message value
+                                                 -- from proc Send, which is 
+                                                 -- "decoded"/verified below.
+ 
+    if not Code_Package.Test_Connection then
+       Report.Failed ("Bad initialization");
+    end if;
+ 
+    Verification_OK := Code_Package.Decode (Confirmation_Message);
+ 
+    if not (Transmission_OK and Verification_OK) then
+       Report.Failed ("Message transmission failure");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA110051;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,211 ----
+ -- CA11006.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the private part of a child library unit can utilize
+ --      its parent unit's private definition.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package and public child package, both with private 
+ --      parts.  The child package will have a private extension of a type 
+ --      declared in the parent's private part.  In addition, the private 
+ --      part of the child package specification will make use of some of 
+ --      the components declared in the private part of the parent.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --
+ --!
+ 
+ package CA11006_0 is      -- Package File_Package 
+ 
+    type File_Descriptor is private;
+    type File_Mode       is (Read_Only, Write_Only, Read_Write);
+    type File_Type       is tagged private;
+ 
+    function  Next_Available_File return File_Descriptor;
+ 
+ private
+ 
+    type File_Measure    is range 0 .. 1000;
+    type File_Descriptor is new Integer;
+ 
+    Null_File       : constant File_Descriptor := 0;
+    Default_Mode    : constant File_Mode       := Read_Write;
+ 
+    type File_Type is tagged
+      record
+         Descriptor : File_Descriptor := Null_File;
+         Mode       : File_Mode       := Default_Mode;
+      end record;
+ 
+    System_File : File_Type;
+ 
+ end CA11006_0;               -- Package File_Package  
+ 
+      --=================================================================--
+ 
+ package body CA11006_0 is    -- Package File_Package  
+    
+    File_Count : Integer := 0;
+ 
+    function Next_Available_File return File_Descriptor is
+    begin
+       File_Count := File_Count + 1;
+       return File_Descriptor (File_Count);
+    end Next_Available_File;
+ 
+ end CA11006_0;               -- Package File_Package   
+ 
+      --=================================================================--
+ 
+ package CA11006_0.CA11006_1 is        -- Child package File_Package.Operations
+ 
+    type File_Length_Type   is private;
+    type Extended_File_Type is new File_Type with private;
+ 
+    System_Extended_File : constant Extended_File_Type;
+ 
+    procedure Create_File (Mode : in     File_Mode;
+                           File :    out Extended_File_Type);    
+ 
+    procedure Compress_File (Original        : in     Extended_File_Type;
+                             Compressed_File :    out Extended_File_Type);
+ 
+    function  Validate (File : in Extended_File_Type) return Boolean;
+ 
+    function  Validate_Compression (File : in Extended_File_Type) 
+      return Boolean;
+                                    -- These two validation functions provide
+                                    -- the capability to check the private
+                                    -- components defined in the parent and
+                                    -- child packages from within the client
+                                    -- program.
+ private
+ 
+    type File_Length_Type is new File_Measure;       -- Parent private type.
+ 
+    Min_File_Size : File_Length_Type := File_Length_Type'First;
+    Max_File_Size : File_Length_Type := File_Length_Type'Last;
+ 
+    type Extended_File_Type is new File_Type with        -- Parent type.
+       record
+          Blocks : File_Length_Type := Min_File_Size;
+       end record;
+ 
+    System_Extended_File : constant Extended_File_Type :=
+      (Descriptor => System_File.Descriptor,      -- Parent private object.
+       Mode       => Read_Only,                   -- Parent enumeration literal.
+       Blocks     => Min_File_Size);
+ 
+ 
+ end CA11006_0.CA11006_1;             -- Child Package File_Package.Operations
+ 
+      --=================================================================--
+ 
+                                 -- Child package body File_Package.Operations
+ package body CA11006_0.CA11006_1 is  
+ 
+    procedure Create_File 
+      (Mode : in     File_Mode; 
+       File :    out Extended_File_Type) is                 
+    begin
+       File.Descriptor := Next_Available_File;    -- Parent subprogram.
+       File.Mode       := Default_Mode;           -- Parent private constant.
+       File.Blocks     := Max_File_Size;
+    end Create_File;
+    ------------------------------------------------------------------------
+    procedure Compress_File (Original        : in     Extended_File_Type;
+                             Compressed_File :    out Extended_File_Type) is
+    begin
+       Compressed_File.Descriptor := Next_Available_File;      
+       Compressed_File.Mode       := Read_Only;
+       Compressed_File.Blocks     := Original.Blocks / 2;  -- Simulated file
+    end Compress_File;                                     -- compression.
+    ------------------------------------------------------------------------
+    function  Validate (File : in Extended_File_Type) return Boolean is      
+    begin
+       if ((File.Descriptor /= System_Extended_File.Descriptor) and    
+           (File.Mode = Read_Write)                             and
+           (File.Blocks = Max_File_Size))                       then
+          return True;
+       else
+          return False;
+       end if;
+    end Validate;
+    ------------------------------------------------------------------------
+    function  Validate_Compression (File : in Extended_File_Type) 
+       return Boolean is      
+    begin
+       if ((File.Descriptor /= System_File.Descriptor) and    
+           (File.Mode = Read_Only)                     and
+           (File.Blocks = Max_File_Size/2))            then
+          return True;
+       else
+          return False;
+       end if;
+    end Validate_Compression;
+ 
+ end CA11006_0.CA11006_1;         -- Child package body File_Package.Operations
+ 
+      --=================================================================--
+ 
+ with CA11006_0.CA11006_1;        -- with Child package File_Package.Operations
+ with Report;
+ 
+ procedure CA11006 is
+ 
+    package File      renames CA11006_0;
+    package File_Ops  renames CA11006_0.CA11006_1;            
+ 
+    Validation_File_Mode : File.File_Mode := File.Read_Only;
+    Validation_File,
+    Storage_Copy         : File_Ops.Extended_File_Type;     
+ 
+ begin
+ 
+    Report.Test ("CA11006", "Check that the private part of a child "  &
+                            "library unit can utilize its parent "     &
+                            "unit's private definition");
+ 
+    File_Ops.Create_File (Validation_File_Mode, Validation_File);
+ 
+    if not File_Ops.Validate (Validation_File) then
+       Report.Failed ("Incorrect initialization of file");
+    end if;
+ 
+    File_Ops.Compress_File (Validation_File, Storage_Copy);
+ 
+    if not (File_Ops.Validate (Validation_File) and 
+            File_Ops.Validate_Compression (Storage_Copy))
+    then
+       Report.Failed ("Incorrect compression of file");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11006; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,228 ----
+ -- CA11007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the private part of a grandchild library unit can
+ --      utilize its grandparent unit's private definition.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package, child package, and grandchild package, all 
+ --      with private parts in their specifications.  
+ --
+ --      The private part of the grandchild package will make use of components
+ --      that have been declared in the private part of the grandparent
+ --      specification.
+ --
+ --      The child package demonstrates the extension of a parent file type 
+ --      into an abstraction of an analog file structure. The grandchild package
+ --      extends the grandparent file type into an abstraction of a digital 
+ --      file structure, and provides conversion capability to/from the parent 
+ --      analog file structure.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+   
+ package CA11007_0 is                                -- Package File_Package 
+ 
+    type File_Descriptor is private;
+    type File_Type       is tagged private;
+ 
+    function  Next_Available_File return File_Descriptor;
+ 
+ private
+ 
+    type File_Measure_Type is range 0 .. 1000;
+    type File_Descriptor   is new Integer;
+ 
+    Null_Measure : constant File_Measure_Type := File_Measure_Type'First;
+    Null_File    : constant File_Descriptor   := 0;
+ 
+    type File_Type is tagged
+      record
+         Descriptor : File_Descriptor := Null_File;
+      end record;
+ 
+ end CA11007_0;                                 -- Package File_Package  
+ 
+      --=================================================================--
+ 
+ package body CA11007_0 is                      -- Package body File_Package  
+ 
+    File_Count : Integer := 0;
+ 
+    function Next_Available_File return File_Descriptor is
+    begin
+       File_Count := File_Count + 1;
+       return File_Descriptor (File_Count);
+    end Next_Available_File;
+ 
+ end CA11007_0;                                 -- Package body File_Package   
+ 
+      --=================================================================--
+ 
+ package CA11007_0.CA11007_1 is                 -- Child package Analog
+ 
+    type    Analog_File_Type is new File_Type with private;
+ 
+ private
+ 
+    type Wavelength_Type is new File_Measure_Type;
+ 
+    Min_Wavelength : constant Wavelength_Type := Wavelength_Type'First;
+ 
+    type Analog_File_Type is new File_Type with          -- Parent type.
+       record                                           
+          Wavelength : Wavelength_Type := Min_Wavelength;
+       end record;
+ 
+ end CA11007_0.CA11007_1;                        -- Child package Analog
+ 
+      --=================================================================--
+ 
+ package CA11007_0.CA11007_1.CA11007_2 is        -- Grandchild package Digital
+ 
+    type    Digital_File_Type is new File_Type with private;
+ 
+    procedure Recording (File : out Digital_File_Type);    
+ 
+    procedure Convert (From : in     Analog_File_Type;
+                       To   :    out Digital_File_Type);
+ 
+    function Validate         (File : in Digital_File_Type) return Boolean;
+    function Valid_Conversion (To : Digital_File_Type) return Boolean;
+    function Valid_Initial (From : Analog_File_Type) return Boolean;
+ 
+ private
+ 
+    type Track_Type is new File_Measure_Type;          -- Grandparent type.
+ 
+    Min_Tracks : constant Track_Type := 
+      Track_Type (Null_Measure) + Track_Type'First;    -- Grandparent private 
+    Max_Tracks : constant Track_Type :=                -- constant.
+      Track_Type (Null_Measure) + Track_Type'Last;
+ 
+    type Digital_File_Type is new File_Type with       -- Grandparent type.  
+       record
+          Tracks : Track_Type := Min_Tracks;
+       end record;
+ 
+ end CA11007_0.CA11007_1.CA11007_2;             -- Grandchild package Digital
+ 
+      --=================================================================--
+ 
+                                           -- Grandchild package body Digital
+ package body CA11007_0.CA11007_1.CA11007_2 is  
+ 
+    procedure Recording (File : out Digital_File_Type) is
+    begin
+       File.Descriptor := Next_Available_File;    -- Assign new file descriptor.
+       File.Tracks     := Max_Tracks;             -- Change initial value.
+    end Recording;
+    --------------------------------------------------------------------------
+    procedure Convert (From : in     Analog_File_Type;
+                       To   :    out Digital_File_Type) is
+    begin
+       To.Descriptor := From.Descriptor + 100;            -- Dummy conversion.
+       To.Tracks     := Track_Type (From.Wavelength) / 2;
+    end Convert;                                     
+    --------------------------------------------------------------------------
+    function  Validate (File : in Digital_File_Type) return Boolean is
+       Result : Boolean := False;
+    begin
+       if not (File.Tracks /= Max_Tracks) then
+          Result := True;
+       end if;
+       return Result;                     
+    end Validate;
+    --------------------------------------------------------------------------
+    function Valid_Conversion (To : Digital_File_Type) return Boolean is
+    begin
+       return (To.Descriptor = 100) and (To.Tracks = (Min_Tracks / 2));
+    end Valid_Conversion;
+    --------------------------------------------------------------------------
+    function Valid_Initial (From : Analog_File_Type) return Boolean is
+    begin
+       return (From.Wavelength = Min_Wavelength);     -- Validate initial 
+    end Valid_Initial;                                -- conditions.  
+ 
+ end CA11007_0.CA11007_1.CA11007_2;     -- Grandchild package body Digital
+ 
+      --=================================================================--
+ 
+ with CA11007_0.CA11007_1.CA11007_2;    -- with Grandchild package Digital
+ with Report;
+ 
+ procedure CA11007 is
+ 
+    package Analog  renames CA11007_0.CA11007_1;
+    package Digital renames CA11007_0.CA11007_1.CA11007_2;            
+ 
+    Original_Digital_File,
+    Converted_Digital_File : Digital.Digital_File_Type;
+ 
+    Original_Analog_File : Analog.Analog_File_Type;
+ 
+ begin
+    
+    -- This code demonstrates how private extensions could be utilized
+    -- in child packages to allow for recording on different media.  
+    -- The processing contained in the procedures and functions is
+    -- "dummy" processing, not intended to perform actual recording,
+    -- conversion, or validation operations, but simply to demonstrate 
+    -- this type of structural decomposition  as a possible solution to 
+    -- a user's design problem.
+ 
+    Report.Test ("CA11007", "Check that the private part of a grandchild "  &
+                            "library unit can utilize its grandparent    "  &
+                            "unit's private definition");
+ 
+    if not Digital.Valid_Initial (Original_Analog_File)
+    then
+       Report.Failed ("Incorrect initialization of Analog File");
+    end if;
+ 
+    ---
+ 
+    Digital.Convert (From => Original_Analog_File,        -- Convert file to
+                     To   => Converted_Digital_File);     -- digital format.
+ 
+    if not Digital.Valid_Conversion (To => Converted_Digital_File) then
+       Report.Failed ("Incorrect conversion of analog file");
+    end if;
+              
+    ---
+ 
+    Digital.Recording (Original_Digital_File);            -- Create file in
+                                                          -- digital format.
+    if not Digital.Validate (Original_Digital_File) then
+       Report.Failed ("Incorrect recording of digital file");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11007; 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11008.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11008.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11008.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,216 ----
+ -- CA11008.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a private child package can use entities declared in the
+ --      visible part of its parent unit.
+ --      
+ -- TEST DESCRIPTION:
+ --      Declare a parent package containing types and objects used 
+ --      by the system. Declare a private child package that uses the parent
+ --      components to provide functionality to the system.  
+ --
+ --      The tagged file type defined in the parent has defaults for all
+ --      component fields.  Prior to initialization, these values are checked
+ --      to ensure a correct start condition.  The initial subprogram is
+ --      called, which utilizes the functionality provided in the private
+ --      child package.  This subprogram changes the fields of the file object
+ --      to something other than the default values, and this process is then
+ --      verified at the conclusion of the test.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+   
+ package CA11008_0 is               -- Package OS.
+ 
+    type File_Descriptor_Type is new Integer;
+    type File_Name_Type       is new String (1 .. 11);
+    type Permission_Type      is (None, User, System, Bypass);
+    type File_Mode_Type       is (Read_Only, Write_Only, Read_Write);
+    type File_Status_Type     is (Open, Closed);
+ 
+    Default_Descriptor : constant File_Descriptor_Type := 0;
+    Default_Permission : constant Permission_Type      := None;
+    Default_Mode       : constant File_Mode_Type       := Read_Only;
+    Default_Status     : constant File_Status_Type     := Closed;
+    Default_Filename   : constant File_Name_Type       := "           ";
+ 
+    Max_Files          : constant File_Descriptor_Type := 100;
+    Constant_Name      : constant File_Name_Type       := "AdaFileName";
+    File_Counter       : Integer                       := 0;
+ 
+    type File_Type is tagged
+       record
+          Descriptor     : File_Descriptor_Type := Default_Descriptor;
+          Name           : File_Name_Type       := Default_Filename;
+          Acct_Access    : Permission_Type      := Default_Permission;
+          Mode           : File_Mode_Type       := Default_Mode;
+          Current_Status : File_Status_Type     := Default_Status;
+       end record;
+ 
+    type File_Array_Type is array (1 .. Max_Files) of File_Type;
+ 
+    File_Table : File_Array_Type;
+ 
+    --
+ 
+    function Get_File_Name return File_Name_Type;
+ 
+    function Initialize_File return File_Descriptor_Type;
+ 
+ end CA11008_0;                     -- Package OS.
+ 
+      --=================================================================--
+ 
+ -- Subprograms that perform the actual file operations are contained in a
+ -- private package so that they are not accessible to any client.
+ 
+ private package CA11008_0.CA11008_1 is  -- Package OS.Internals
+ 
+    Private_File_Counter : Integer renames File_Counter;          -- Parent 
+                                                                  -- object.
+    function Initialize 
+      (File_Name : File_Name_Type := Get_File_Name;      -- Parent function.
+       File_Mode : File_Mode_Type := Read_Write)         -- Parent literal.
+      return File_Descriptor_Type;                       -- Parent type.
+ 
+ end CA11008_0.CA11008_1;             -- Package OS.Internals
+ 
+      --=================================================================--
+ 
+ package body CA11008_0.CA11008_1 is  -- Package body OS.Internals
+ 
+    function Next_Available_File return File_Descriptor_Type is
+    begin
+       Private_File_Counter := Private_File_Counter + 1; 
+       return (File_Descriptor_Type(File_Counter));
+    end Next_Available_File;
+    -----------------------------------------------------------------
+    function Initialize 
+      (File_Name : File_Name_Type := Get_File_Name; -- Parent function
+       File_Mode : File_Mode_Type := Read_Write)    -- Parent literal
+      return File_Descriptor_Type is                -- Parent type
+       Number : File_Descriptor_Type;                         
+    begin
+       Number := Next_Available_File;
+       File_Table(Number).Descriptor := Number;     -- Parent object
+       File_Table(Number).Name := File_Name;        -- Default parameter value 
+       File_Table(Number).Mode := File_Mode;        -- Default parameter value
+       File_Table(Number).Acct_Access := User;
+       File_Table(Number).Current_Status := Open;
+       return (Number);
+    end Initialize;
+ 
+ end CA11008_0.CA11008_1;           -- Package body OS.Internals
+ 
+      --=================================================================--
+ 
+ with CA11008_0.CA11008_1;          -- Private child package "withed" by
+                                    -- parent body.
+ 
+ package body CA11008_0 is          -- Package body OS
+ 
+    function Get_File_Name return File_Name_Type is
+    begin
+       return (Constant_Name);   -- Of course if this was a real function, the
+    end Get_File_Name;           -- user would be asked to input a name, or
+                                 -- there would be some type of similar process.
+ 
+    -- This subprogram utilizes a call to a subprogram contained in a private
+    -- child to perform the actual processing.
+ 
+    function Initialize_File return File_Descriptor_Type is
+    begin
+      return (CA11008_0.CA11008_1.Initialize);    -- No parameters are needed, 
+                                                  -- since defaults have been 
+                                                  -- provided.
+    end Initialize_File;
+ 
+ end CA11008_0;                         -- Package body OS
+ 
+      --=================================================================--
+ 
+ with CA11008_0;                        -- with Package OS.
+ with Report;
+ 
+ procedure CA11008 is
+ 
+    package OS renames CA11008_0;
+    use OS;
+    Ada_File_Key : File_Descriptor_Type := Default_Descriptor;
+ 
+ begin
+ 
+    -- This test indicates one approach to file management operations.
+    -- It is not intended to demonstrate full functionality, but rather
+    -- that the use of a private child package can provide a solution
+    -- to a user situation, that being the implementation of certain functions
+    -- being provided in a child package, with the parent package body 
+    -- utilizing these implementations.
+ 
+    Report.Test ("CA11008", "Check that a private child package can use "   &
+                            "entities declared in the visible part of its " &
+                            "parent unit");
+ 
+    -- Check initial conditions of the first entry in the file table.
+    -- These are all default values provided in the declaration of the 
+    -- type File_Type.
+ 
+    if (Ada_File_Key                 /= Default_Descriptor)  or else
+       (File_Table(1).Descriptor     /= (Default_Descriptor) or
+       (File_Table(1).Name           /= Default_Filename))   or else
+       (File_Table(1).Acct_Access    /= (Default_Permission) or
+       (File_Table(1).Mode           /= Default_Mode))       or else
+       (File_Table(1).Current_Status /= Default_Status)
+    then
+       Report.Failed ("Initial condition failure");
+    end if;
+    
+    -- Call the initialization function.  This will result in the resetting
+    -- of the fields associated with the first entry in the File_Table (this
+    -- is the first call of Initialize_File).  
+    -- No parameters are necessary for this call, due to the default values
+    -- provided in the private child package routine Initialize.
+    
+    Ada_File_Key := Initialize_File;
+ 
+    -- Verify that the initial conditions of the file table component have
+    -- been properly modified by the initialization function.
+ 
+    if not ((File_Table(1).Descriptor     = Ada_File_Key)         and then
+            (File_Table(1).Name           = Constant_Name) and then
+            (File_Table(1).Acct_Access    = User)              and then
+            not ((File_Table(1).Mode      = Default_Mode)      or else
+                 (File_Table(1).Current_Status = Default_Status)))
+    then
+       Report.Failed ("Initialization processing failure");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11008;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11009.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11009.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11009.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11009.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,246 ----
+ -- CA11009.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a private child package can use entities declared in the
+ --      visible part of the parent unit of its parent unit.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a parent package containing types and objects used by the 
+ --      system.  Declare a public child package that provides a visible 
+ --      interface to the system functionality.
+ --      Declare a private grandchild package that uses the visible grandparent
+ --      components to provide the actual functionality to the system. 
+ --
+ --      The public child (parent of the private grandchild) uses the 
+ --      functionality of its private child (grandchild package) to provide 
+ --      the visible interface to operations of the system.
+ --
+ --      The test itself will utilize the visible interface provided in the 
+ --      public child package to demonstrate a possible structure for
+ --      file management.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate_body.
+ --
+ --!
+ 
+ package CA11009_0 is               -- Package OS.
+    pragma Elaborate_Body (CA11009_0);
+ 
+    type File_Descriptor_Type is new Integer;
+    type File_Name_Type       is new String (1 .. 11);
+    type Permission_Type      is (None, User, System, Bypass);
+    type File_Mode_Type       is (Read_Only, Write_Only, Read_Write);
+    type File_Status_Type     is (Open, Closed);
+ 
+    Default_Descriptor : constant File_Descriptor_Type := 0;
+    Default_Permission : constant Permission_Type      := None;
+    Default_Mode       : constant File_Mode_Type       := Read_Only;
+    Default_Status     : constant File_Status_Type     := Closed;
+    Default_Filename   : constant File_Name_Type       := "           ";
+ 
+    Max_Files          : constant File_Descriptor_Type := 10;
+    An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
+    File_Counter       : Integer                       := 0;
+ 
+    type File_Type is tagged
+       record
+          Descriptor     : File_Descriptor_Type := Default_Descriptor;
+          Name           : File_Name_Type       := Default_Filename;
+          Acct_Access    : Permission_Type      := Default_Permission;
+          Mode           : File_Mode_Type       := Default_Mode;
+          Current_Status : File_Status_Type     := Default_Status;
+       end record;
+ 
+    type File_Array_Type is array (1 .. Max_Files) of File_Type;
+ 
+    File_Table : File_Array_Type;
+ 
+    --
+ 
+    function Get_File_Name return File_Name_Type;
+ 
+ end CA11009_0;                     -- Package OS.
+ 
+      --=================================================================--
+ 
+ package body CA11009_0 is          -- Package body OS.
+ 
+    function Get_File_Name return File_Name_Type is
+    begin
+       return (An_Ada_File_Name);   -- Processing would be replace by a user
+                                    -- prompt in a functioning system.
+    end Get_File_Name;           
+                                 
+ end CA11009_0;                     -- Package body OS.
+ 
+      --=================================================================--
+ 
+ package CA11009_0.CA11009_1 is     -- Child Package OS.File_Manager
+ 
+    -- This package simulates a visible interface for the Operating System.
+    -- The actual processing performed by this routine is encapsulated
+    -- in the routines of private child package Internals, which is "withed"
+    -- by the body of this package.
+ 
+    procedure Create_File (Mode      : in     File_Mode_Type;
+                           File_Key  :    out File_Descriptor_Type);
+ 
+ end CA11009_0.CA11009_1;           -- Child Package OS.File_Manager
+ 
+      --=================================================================--
+ 
+ -- Subprogram that performs the actual file operation is contained in a
+ -- private package so that it is not accessible to any client, and can be
+ -- modified/extended without requiring recompilation of the clients of the
+ -- parent (since this package is "withed" by the parent body only.)
+ 
+ 
+                                -- Grandchild Package OS.File_Manager.Internals
+ private package CA11009_0.CA11009_1.CA11009_2 is  
+ 
+    Initial_Permission : constant Permission_Type  := User;  -- Grandparent
+    Initial_Status     : constant File_Status_Type := Open;  -- literals.
+    Initial_Filename   : constant File_Name_Type   :=  -- Grandparent type.
+      Get_File_Name;                                   -- Grandparent function.
+ 
+    function Create (Mode : File_Mode_Type)                      
+      return File_Descriptor_Type;                     -- Grandparent type.
+ 
+ end CA11009_0.CA11009_1.CA11009_2;   
+                           -- Grandchild Package OS.File_Manager.Internals
+ 
+      --=================================================================--
+ 
+                           -- Grandchild Package body OS.File_Manager.Internals
+ package body CA11009_0.CA11009_1.CA11009_2 is  
+ 
+    function Next_Available_File return File_Descriptor_Type is
+    begin
+       File_Counter := File_Counter + 1;              -- Grandparent object.
+       return (File_Descriptor_Type(File_Counter));
+    end Next_Available_File;
+    -------------------------------------------------------------------------
+    function Create (Mode : File_Mode_Type)           -- Grandparent literal.
+      return File_Descriptor_Type is
+       Number : File_Descriptor_Type;                 -- Grandparent type.
+    begin
+       Number := Next_Available_File;
+       File_Table(Number).Descriptor     := Number;   -- Grandparent object.
+       File_Table(Number).Name           := Initial_Filename;
+       File_Table(Number).Mode           := Mode;     -- Parameter.
+       File_Table(Number).Acct_Access    := Initial_Permission;
+       File_Table(Number).Current_Status := Initial_Status;
+       return (Number);
+    end Create;
+ 
+ end CA11009_0.CA11009_1.CA11009_2;  
+                           -- Grandchild Package body OS.File_Manager.Internals
+ 
+      --=================================================================--
+ 
+                                      -- "With" of a child package 
+                                      -- by the parent body.
+ with CA11009_0.CA11009_1.CA11009_2;  -- Grandchild OS.File_Manager.Internals
+ 
+ package body CA11009_0.CA11009_1 is  -- Child Package body OS.File_Manager
+ 
+    package Internal renames CA11009_0.CA11009_1.CA11009_2;            
+ 
+    -- These subprograms utilize calls to subprograms contained in a private
+    -- sibling to perform the actual processing.
+ 
+    procedure Create_File (Mode      : in     File_Mode_Type;
+                           File_Key  :    out File_Descriptor_Type) is
+    begin
+       File_Key := Internal.Create (Mode);
+    end Create_File;
+ 
+ end CA11009_0.CA11009_1;        -- Child Package body OS.File_Manager
+ 
+      --=================================================================--
+ 
+ with CA11009_0.CA11009_1;       -- with Child Package OS.File_Manager
+ with Report;
+ 
+ procedure CA11009 is
+ 
+    package OS           renames CA11009_0;
+    use OS;
+    package File_Manager renames CA11009_0.CA11009_1;
+ 
+    Data_Base_File_Key : File_Descriptor_Type := Default_Descriptor;
+    New_Mode           : File_Mode_Type := Read_Write;
+ 
+ begin
+    
+    -- This test indicates one approach to file management.
+    -- It is not intended to demonstrate full functionality, but rather
+    -- that the use of a private child package could provide a solution
+    -- to this type of situation.
+ 
+    Report.Test ("CA11009", "Check that a private child package can use "   &
+                            "entities declared in the visible part of the " &
+                            "parent unit of its parent unit");
+ 
+    -- Check initial conditions of the first entry in the file table.
+    -- These are all default values provided in the declaration of the 
+    -- type File_Type.                           
+ 
+    if (not (Data_Base_File_Key      = Default_Descriptor)) and then
+       (((not (File_Table(1).Name    = Default_Filename))   or 
+       (File_Table(1).Descriptor     /= Default_Descriptor))  or else
+       ((File_Table(1).Acct_Access   /= Default_Permission)  or
+       (not (File_Table(1).Mode      = Default_Mode))       or
+       (File_Table(1).Current_Status /= Default_Status)))
+    then
+       Report.Failed ("Initial condition failure");
+    end if;
+ 
+    -- Create/initialize file using the capability provided by the visible 
+    -- interface to the operating system, OS.File_Manager.  The actual 
+    -- processing routine is contained in the private grandchild package 
+    -- Internals, which utilize the components from the grandparent package.
+ 
+    File_Manager.Create_File (New_Mode, Data_Base_File_Key);
+ 
+    -- Verify that the initial conditions of the file table component have
+    -- been properly modified by the initialization function.
+ 
+    if not ((File_Table(1).Descriptor          = Data_Base_File_Key)   and then
+            (File_Table(1).Name                = An_Ada_File_Name)  and then
+            (File_Table(1).Acct_Access         = User)              and then
+            not ((File_Table(1).Mode           = Default_Mode)      or else
+                 (File_Table(1).Current_Status = Default_Status)))
+    then
+       Report.Failed ("File creation failure");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11009;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,254 ----
+ -- CA11010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --     Check that a private child package can use entities declared in the
+ --     private part of its parent unit.
+ --
+ -- TEST DESCRIPTION:
+ --     Declare a parent package containing private types, objects,
+ --     and functions used by the system. Declare a private child package that 
+ --     uses the parent components to provide functionality to the system.  
+ --
+ --     Declare an array of files with default values for all 
+ --     component fields of the files (records).  Check the initial state of
+ --     a specified file for proper default values.  Perform the file "creation"
+ --     (initialization), which will modify the fields of the record object.
+ --     Again verify the file object to determine whether the fields have been
+ --     reset properly.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+    
+ package CA11010_0 is               -- Package OS.
+  
+    type File_Descriptor_Type is private;
+ 
+    Default_Descriptor  : constant File_Descriptor_Type;
+ 
+    function  Initialize_File           return File_Descriptor_Type;
+    procedure Verify_Initial_Conditions (Status : out Boolean);
+    function  Final_Conditions_Valid    return Boolean;
+ 
+ private
+ 
+    type File_Descriptor_Type    is new Integer;
+    type File_Name_Type          is new String (1 .. 11);
+    type Permission_Type         is (None, User, System);
+    type File_Mode_Type          is (Read_Only, Write_Only, Read_Write);
+    type File_Status_Type        is (Open, Closed);
+ 
+    Default_Descriptor : constant File_Descriptor_Type := 0;
+    Default_Permission : constant Permission_Type      := None;
+    Default_Mode       : constant File_Mode_Type       := Read_Only;
+    Default_Status     : constant File_Status_Type     := Closed;
+    Default_Filename   : constant File_Name_Type       := "           ";
+    An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
+    Max_Files          : constant File_Descriptor_Type := 100;
+ 
+    type File_Type is tagged
+       record
+          Descriptor     : File_Descriptor_Type := Default_Descriptor;
+          Name           : File_Name_Type       := Default_Filename;
+          Acct_Access    : Permission_Type      := Default_Permission;
+          Mode           : File_Mode_Type       := Default_Mode;
+          Current_Status : File_Status_Type     := Default_Status;
+       end record;
+ 
+    type File_Array_Type is array (1 .. Max_Files) of File_Type;
+ 
+    File_Table   : File_Array_Type;
+    File_Counter : Integer := 0;
+ 
+    --
+ 
+    function Get_File_Name return File_Name_Type;
+ 
+ end CA11010_0;                     -- Package OS.
+ 
+      --=================================================================--
+ 
+ -- Subprograms that perform the actual file operations are contained in a
+ -- private package so that they are not accessible to any client.
+ 
+ private package CA11010_0.CA11010_1 is  -- Package OS.Internals
+ 
+    Private_File_Counter : Integer renames File_Counter; -- Parent priv. object.
+ 
+    function Initialize 
+      (File_Name : File_Name_Type := Get_File_Name;  -- Parent priv. function.
+       File_Mode : File_Mode_Type := Read_Write)     -- Parent priv. literal.
+      return File_Descriptor_Type;                   -- Parent type.
+ 
+ end CA11010_0.CA11010_1;             -- Package OS.Internals
+ 
+      --=================================================================--
+ 
+ package body CA11010_0.CA11010_1 is  -- Package body OS.Internals
+ 
+    function Next_Available_File return File_Descriptor_Type is
+    begin
+       Private_File_Counter := Private_File_Counter + 1; 
+       return (File_Descriptor_Type(File_Counter));
+    end Next_Available_File;
+    ----------------------------------------------------------------
+    function Initialize 
+      (File_Name : File_Name_Type := Get_File_Name; -- Parent priv. function
+       File_Mode : File_Mode_Type := Read_Write)    -- Parent priv. literal
+      return File_Descriptor_Type is                -- Parent type
+       Number : File_Descriptor_Type;                         
+    begin
+       Number := Next_Available_File;
+       File_Table(Number).Descriptor := Number;     -- Parent priv. object
+       File_Table(Number).Name := File_Name;        -- Default parameter value 
+       File_Table(Number).Mode := File_Mode;        -- Default parameter value
+       File_Table(Number).Acct_Access := User;
+       File_Table(Number).Current_Status := Open;
+       return (Number);
+    end Initialize;
+ 
+ end CA11010_0.CA11010_1;           -- Package body OS.Internals
+ 
+      --=================================================================--
+ 
+ with CA11010_0.CA11010_1;          -- Private child package "withed" by
+                                    -- parent body.
+ 
+ package body CA11010_0 is          -- Package body OS
+ 
+    function Get_File_Name return File_Name_Type is
+    begin
+       return (An_Ada_File_Name); -- If this was a real function, the user 
+    end Get_File_Name;            -- would be asked to input a name, or there 
+                                  -- would be some type of similar processing.
+ 
+    -- This subprogram utilizes a call to a subprogram contained in a private
+    -- child to perform the actual processing.
+ 
+    function Initialize_File return File_Descriptor_Type is
+    begin
+      return (CA11010_0.CA11010_1.Initialize);    -- No parameters are needed, 
+                                                  -- since defaults have been 
+                                                  -- provided.
+    end Initialize_File;
+ 
+    --
+    -- Separate subunits.
+    --
+ 
+    procedure Verify_Initial_Conditions (Status : out Boolean) is separate;
+ 
+    function  Final_Conditions_Valid return Boolean is separate;
+ 
+ end CA11010_0;                         -- Package body OS
+ 
+      --=================================================================--
+ 
+ separate (CA11010_0)
+ procedure Verify_Initial_Conditions (Status : out Boolean) is
+ begin
+    Status := False;
+    if (File_Table(1).Descriptor     = Default_Descriptor) and then
+       (File_Table(1).Name           = Default_Filename)   and then
+       (File_Table(1).Acct_Access    = Default_Permission) and then
+       (File_Table(1).Mode           = Default_Mode)       and then
+       (File_Table(1).Current_Status = Default_Status)
+    then 
+       Status := True;
+    end if;
+ end Verify_Initial_Conditions;
+ 
+      --=================================================================--
+ 
+ separate (CA11010_0)
+ function Final_Conditions_Valid return Boolean is 
+ begin
+    if  ((File_Table(1).Descriptor         /= Default_Descriptor) and then
+         (File_Table(1).Name                = An_Ada_File_Name)   and then
+         (File_Table(1).Acct_Access         = User)               and then
+         not ((File_Table(1).Mode           = Default_Mode)       or else
+              (File_Table(1).Current_Status = Default_Status)))
+    then
+       return (True);
+    else
+       return (False);
+    end if;
+ end Final_Conditions_Valid;
+ 
+      --=================================================================--
+ 
+ with CA11010_0;                        -- with Package OS.
+ with Report;
+ 
+ procedure CA11010 is
+ 
+    package OS renames CA11010_0;
+ 
+    Ada_File_Key          : OS.File_Descriptor_Type := OS.Default_Descriptor;
+    Initialization_Status : Boolean := False;
+ 
+ begin
+ 
+    -- This test indicates one approach to a file management operation.
+    -- It is not intended to demonstrate full functionality, but rather
+    -- that the use of a private child package can provide a solution
+    -- to a user situation, that being the implementation of certain functions
+    -- being provided in a child package, with the parent package body 
+    -- utilizing these implementations.
+ 
+    Report.Test ("CA11010", "Check that a private child package can use "   &
+                            "entities declared in the private part of its " &
+                            "parent unit");
+ 
+    -- Check initial conditions of the first entry in the file table.
+    -- These are all default values provided in the declaration of the 
+    -- type File_Type.
+ 
+    OS.Verify_Initial_Conditions (Initialization_Status);
+ 
+    if not Initialization_Status then
+       Report.Failed ("Initial condition failure");
+    end if;
+    
+    -- Call the initialization function.  This will result in the resetting
+    -- of the fields associated with the first entry in the File_Table (this
+    -- is the first/only call of Initialize_File).  
+    -- No parameters are necessary for this call, due to the default values
+    -- provided in the private child package routine Initialize.
+    
+    Ada_File_Key := OS.Initialize_File;
+ 
+    -- Verify that the initial conditions of the file table component have
+    -- been properly modified by the initialization function.
+ 
+    if not OS.Final_Conditions_Valid then
+       Report.Failed ("Initialization processing failure");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11010;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,271 ----
+ -- CA11011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a private child package can use entities declared in the
+ --      private part of the parent unit of its parent unit.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a parent package containing private types and objects
+ --      used by the system.  Declare a public child package that 
+ --      provides a visible interface to the system functionality.
+ --      Declare a private grandchild package that uses the visible grandparent
+ --      components to provide the actual functionality to the system. 
+ --
+ --      The public child (parent of the private grandchild) uses the 
+ --      functionality of its private child (grandchild package) to provide 
+ --      the visible interface to operations of the system.
+ --
+ --      The test itself will utilize the visible interface provided in the 
+ --      public child package to demonstrate a possible solution to file 
+ --      management.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CA11011_0 is               -- Package OS.
+ 
+    type File_Descriptor_Type is private;
+ 
+    Default_Descriptor  : constant File_Descriptor_Type;
+    First_File          : constant File_Descriptor_Type;
+ 
+    procedure Verify_Initial_Conditions (Key    : in     File_Descriptor_Type;
+                                         Status :    out Boolean);
+ 
+    function Final_Conditions_Valid (Key : File_Descriptor_Type) 
+      return Boolean;
+ 
+ 
+ private
+ 
+    type File_Descriptor_Type    is new Integer;
+    type File_Name_Type          is new String (1 .. 11);
+    type Permission_Type         is (None, User, System);
+    type File_Mode_Type          is (Read_Only, Write_Only, Read_Write);
+    type File_Status_Type        is (Open, Closed);
+ 
+    Default_Descriptor : constant File_Descriptor_Type := 0;
+    First_File         : constant File_Descriptor_Type := 1;
+    Default_Permission : constant Permission_Type      := None;
+    Default_Mode       : constant File_Mode_Type       := Read_Only;
+    Default_Status     : constant File_Status_Type     := Closed;
+    Default_Filename   : constant File_Name_Type       := "           ";
+ 
+    Init_Permission    : constant Permission_Type      := User;
+    Init_Mode          : constant File_Mode_Type       := Read_Write;
+    Init_Status        : constant File_Status_Type     := Open;
+    An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
+ 
+    Max_Files          : constant File_Descriptor_Type := 10;
+ 
+    type File_Type is tagged
+       record
+          Descriptor     : File_Descriptor_Type := Default_Descriptor;
+          Name           : File_Name_Type       := Default_Filename;
+          Acct_Access    : Permission_Type      := Default_Permission;
+          Mode           : File_Mode_Type       := Default_Mode;
+          Current_Status : File_Status_Type     := Default_Status;
+       end record;
+ 
+    type File_Array_Type is array (1 .. Max_Files) of File_Type;
+ 
+    File_Table   : File_Array_Type;
+    File_Counter : Integer := 0;
+ 
+    --
+ 
+    function  Get_File_Name return File_Name_Type;
+ 
+ end CA11011_0;                     -- Package OS.
+ 
+      --=================================================================--
+ 
+ package body CA11011_0 is          -- Package body OS.
+ 
+    function Get_File_Name return File_Name_Type is
+    begin
+       return (An_Ada_File_Name);
+    end Get_File_Name;
+    ---------------------------------------------------------------------
+    procedure Verify_Initial_Conditions (Key    : in     File_Descriptor_Type;
+                                         Status :    out Boolean) is
+    begin
+       Status := False;
+       if (File_Table(Key).Descriptor     = Default_Descriptor) and then
+          (File_Table(Key).Name           = Default_Filename)   and then
+          (File_Table(Key).Acct_Access    = Default_Permission) and then
+          (File_Table(Key).Mode           = Default_Mode)       and then
+          (File_Table(Key).Current_Status = Default_Status)
+       then 
+          Status := True;
+       end if;
+    end Verify_Initial_Conditions;
+    ---------------------------------------------------------------------
+    function Final_Conditions_Valid (Key : File_Descriptor_Type) 
+      return Boolean is
+    begin
+       if  ((File_Table(Key).Descriptor          = First_File)         and then
+            (File_Table(Key).Name                = An_Ada_File_Name)   and then
+            (File_Table(Key).Acct_Access         = Init_Permission)    and then
+            not ((File_Table(Key).Mode           = Default_Mode)       or else
+                 (File_Table(Key).Current_Status = Default_Status)))
+       then
+          return (True);
+       else
+          return (False);
+       end if;
+    end Final_Conditions_Valid;
+ 
+ end CA11011_0;                     -- Package body OS.
+ 
+      --=================================================================--
+ 
+ package CA11011_0.CA11011_1 is     -- Package OS.File_Manager
+ 
+    procedure Create_File (File_Key : in File_Descriptor_Type);
+ 
+ end CA11011_0.CA11011_1;           -- Package OS.File_Manager
+ 
+      --=================================================================--
+ 
+ -- The Subprogram that performs the actual file operations is contained in a
+ -- private package so that it is not accessible to any client.
+ -- Default parameters are used in most cases in the subprogram calls, since
+ -- the caller does not have visibility to these private types.
+ 
+                                    -- Package OS.File_Manager.Internals
+ private package CA11011_0.CA11011_1.CA11011_2 is  
+ 
+    Private_File_Counter : Integer renames File_Counter;         -- Grandparent
+                                                                 -- object.
+    procedure Create 
+      (Key         : in     File_Descriptor_Type; 
+       File_Name   : in     File_Name_Type   := Get_File_Name;   -- Grandparent
+                                                                 -- prvt type,
+                                                                 -- prvt functn.
+       File_Mode   : in     File_Mode_Type   := Init_Mode;       -- Grandparent
+                                                                 -- prvt type,
+                                                                 -- prvt const.
+       File_Access : in     Permission_Type  := Init_Permission; -- Grandparent
+                                                                 -- prvt type,
+                                                                 -- prvt const.
+       File_Status : in     File_Status_Type := Init_Status);    -- Grandparent
+                                                                 -- prvt type,
+                                                                 -- prvt const.
+ 
+ end CA11011_0.CA11011_1.CA11011_2;   -- Package OS.File_Manager.Internals
+ 
+      --=================================================================--
+ 
+                                      -- Package Body OS.File_Manager.Internals
+ package body CA11011_0.CA11011_1.CA11011_2 is  
+ 
+    procedure Create 
+      (Key         : in     File_Descriptor_Type; 
+       File_Name   : in     File_Name_Type   := Get_File_Name;
+       File_Mode   : in     File_Mode_Type   := Init_Mode;
+       File_Access : in     Permission_Type  := Init_Permission;
+       File_Status : in     File_Status_Type := Init_Status) is
+    begin
+       Private_File_Counter := Private_File_Counter + 1;
+       File_Table(Key).Descriptor     := Key;            -- Grandparent object.
+       File_Table(Key).Name           := File_Name;            
+       File_Table(Key).Mode           := File_Mode;            
+       File_Table(Key).Acct_Access    := File_Access;            
+       File_Table(Key).Current_Status := File_Status;
+    end Create;
+ 
+ end CA11011_0.CA11011_1.CA11011_2;   -- Package body OS.File_Manager.Internals
+ 
+      --=================================================================--
+ 
+ with CA11011_0.CA11011_1.CA11011_2;  -- with Child OS.File_Manager.Internals
+ 
+ package body CA11011_0.CA11011_1 is  -- Package body OS.File_Manager
+ 
+    package Internal renames CA11011_0.CA11011_1.CA11011_2;            
+ 
+    -- This subprogram utilizes a call to a subprogram contained in a private
+    -- child to perform the actual processing.
+ 
+    procedure Create_File (File_Key : in File_Descriptor_Type) is
+    begin
+       Internal.Create (Key => File_Key);  -- Other parameters are defaults, 
+                                           -- since they are of private types
+                                           -- from the parent package.
+                                           -- File_Descriptor_Type is private,
+                                           -- but declared in visible part of 
+                                           -- parent spec.
+    end Create_File;
+ 
+ end CA11011_0.CA11011_1;        -- Package body OS.File_Manager
+ 
+      --=================================================================--
+ 
+ with CA11011_0.CA11011_1;       -- with public Child Package OS.File_Manager
+ with Report;
+ 
+ procedure CA11011 is
+ 
+    package OS           renames CA11011_0;
+    package File_Manager renames CA11011_0.CA11011_1;
+ 
+    Data_Base_File_Key : OS.File_Descriptor_Type := OS.First_File;
+    TC_Status          : Boolean := False;
+ 
+ begin
+ 
+    -- This test indicates one approach to file management operations.
+    -- It is not intended to demonstrate full functionality, but rather
+    -- that the use of a private child package can provide a solution
+    -- to a typical user situation.
+ 
+    Report.Test ("CA11011", "Check that a private child package can use "   &
+                            "entities declared in the private part of the " &
+                            "parent unit of its parent unit");
+ 
+    OS.Verify_Initial_Conditions (Data_Base_File_Key, TC_Status);
+ 
+    if not TC_Status then
+       Report.Failed ("Initial condition failure");
+    end if;
+ 
+    -- Perform file initializations.
+ 
+    File_Manager.Create_File (File_Key => Data_Base_File_Key);
+ 
+    TC_Status := OS.Final_Conditions_Valid (Data_Base_File_Key);
+ 
+    if not TC_Status then
+       Report.Failed ("Bad status return from Create_File");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11011;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,259 ----
+ -- CA11012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a child package of a library level instantiation
+ --      of a generic can be the instantiation of a child package of
+ --      the generic. Check that the child instance can use its parent's
+ --      declarations and operations, including a formal type of the parent. 
+ --      
+ -- TEST DESCRIPTION:
+ --      Declare a generic package which simulates an integer complex 
+ --      abstraction.  Declare a generic child package of this package 
+ --      which defines additional complex operations. 
+ --
+ --      Instantiate the first generic package, then instantiate the child 
+ --      generic package as a child unit of the first instance.  In the main
+ --      program, check that the operations in both instances perform as 
+ --      expected.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Dec 94   SAIC    Corrected visibility errors for literals
+ --      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11012_3
+ --!
+ 
+ generic               -- Complex number abstraction.
+    type Int_Type is range <>;
+ 
+ package CA11012_0 is
+  
+    -- Simulate a generic complex number support package. Complex numbers
+    -- are treated as coordinates in the Cartesian plane.
+ 
+    type Complex_Type is private;
+ 
+    Zero : constant Complex_Type;                      -- Real number (0,0).
+ 
+    function Complex (Real, Imag : Int_Type)           -- Create a complex
+      return Complex_Type;                             -- number.
+ 
+    function "-" (Right : Complex_Type)                -- Invert a complex
+      return Complex_Type;                             -- number.
+ 
+    function "+" (Left, Right : Complex_Type)          -- Add two complex
+      return Complex_Type;                             -- numbers.
+ 
+ private
+    type Complex_Type is record
+       Real : Int_Type;
+       Imag : Int_Type;
+    end record;
+ 
+    Zero : constant Complex_Type := (Real => 0, Imag => 0);
+ 
+ end CA11012_0;
+ 
+      --==================================================================--
+ 
+ package body CA11012_0 is
+ 
+    function Complex (Real, Imag : Int_Type) return Complex_Type is
+    begin
+       return (Real, Imag);
+    end Complex;
+    ---------------------------------------------------------------
+    function "-" (Right : Complex_Type) return Complex_Type is
+    begin
+       return (-Right.Real, -Right.Imag);
+    end "-";
+    ---------------------------------------------------------------
+    function "+" (Left, Right : Complex_Type) return Complex_Type is
+    begin
+       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
+    end "+";
+ 
+ end CA11012_0;
+ 
+      --==================================================================--
+ 
+ -- Generic child of complex number package.  Child must be generic since 
+ -- parent is generic. 
+ 
+ generic               -- Complex additional operations
+ 
+ package CA11012_0.CA11012_1 is
+  
+    -- More operations on complex number. This child adds a layer of
+    -- functionality to the parent generic.
+ 
+    function Real_Part (Complex_No : Complex_Type)
+      return Int_Type;
+ 
+    function Imag_Part (Complex_No : Complex_Type)
+      return Int_Type;
+ 
+    function "*" (Factor : Int_Type; 
+                  C      : Complex_Type) return Complex_Type;
+ 
+    function Vector_Magnitude (Complex_No : Complex_Type)
+      return Int_Type;
+ 
+ end CA11012_0.CA11012_1;
+ 
+      --==================================================================--
+ 
+ package body CA11012_0.CA11012_1 is
+ 
+    function Real_Part (Complex_No : Complex_Type) return Int_Type is
+    begin
+       return (Complex_No.Real);
+    end Real_Part;
+    ---------------------------------------------------------------
+    function Imag_Part (Complex_No : Complex_Type) return Int_Type is
+    begin
+       return (Complex_No.Imag);
+    end Imag_Part;
+    ---------------------------------------------------------------
+    function "*" (Factor : Int_Type; 
+                  C      : Complex_Type) return Complex_Type is
+       Result : Complex_Type := Zero;   -- Zero is declared in parent,
+                                        -- Complex_Number
+    begin
+       for I in 1 .. abs (Factor) loop
+          Result := Result + C;         -- Complex_Number "+"
+       end loop;
+ 
+       if Factor < 0 then
+          Result := - Result;           -- Complex_Number "-"
+       end if;
+ 
+       return Result;
+    end "*";
+    ---------------------------------------------------------------
+    function Vector_Magnitude (Complex_No : Complex_Type)
+      return Int_Type is                -- Not a real vector magnitude.
+    begin
+       return (Complex_No.Real + Complex_No.Imag);
+    end Vector_Magnitude;  
+ 
+ end CA11012_0.CA11012_1;
+ 
+      --==================================================================--
+ 
+ package CA11012_2 is
+ 
+    subtype My_Integer is integer range -100 .. 100;
+ 
+    -- ... Various other types used by the application.
+ 
+ end CA11012_2;
+ 
+ -- No body for CA11012_2;
+ 
+      --==================================================================--
+ 
+ -- Declare instances of the generic complex packages for integer type.  
+ -- The instance of the child must itself be declared as a child of the 
+ -- instance of the parent.
+ 
+ with CA11012_0;                        -- Complex number abstraction
+ with CA11012_2;                        -- Package containing integer type
+ pragma Elaborate (CA11012_0);
+ package CA11012_3 is new CA11012_0 (Int_Type => CA11012_2.My_Integer);
+ 
+ with CA11012_0.CA11012_1;              -- Complex additional operations
+ with CA11012_3;
+ package CA11012_3.CA11012_4 is new CA11012_3.CA11012_1;
+ 
+      --==================================================================--
+ 
+ with CA11012_2;                -- Package containing integer type
+ with CA11012_3.CA11012_4;      -- Complex abstraction + additional operations
+ with Report;
+ 
+ procedure CA11012 is
+ 
+    package My_Complex_Pkg renames CA11012_3;
+ 
+    package My_Complex_Operation renames CA11012_3.CA11012_4;
+ 
+    use My_Complex_Pkg,                                -- All user-defined
+        My_Complex_Operation;                          -- operators directly
+                                                       -- visible.
+    Complex_One, Complex_Two : Complex_Type;
+ 
+ begin
+ 
+    Report.Test ("CA11012", "Check that child instance can use its parent's "  &
+                            "declarations and operations, including a formal " &
+                            "type of the parent");
+ 
+    Correct_Range_Test:
+    declare
+       My_Literal  : CA11012_2.My_Integer := -3;
+ 
+    begin
+       Complex_One := Complex (-4, 7);          -- Operation from the generic 
+                                                -- parent package.
+ 
+       Complex_Two := My_Literal * Complex_One; -- Operation from the generic 
+                                                -- child package.
+ 
+       if Real_Part (Complex_Two) /= 12         -- Operation from the generic 
+         or Imag_Part (Complex_Two) /= -21      -- child package.
+           then
+              Report.Failed ("Incorrect results from complex operation");
+       end if;
+ 
+    end Correct_Range_Test;
+ 
+    ---------------------------------------------------------------
+ 
+    Out_Of_Range_Test:
+    declare
+       My_Vector : CA11012_2.My_Integer;
+ 
+    begin
+       Complex_One := Complex (70, 70);         -- Operation from the generic 
+                                                -- parent package.
+       My_Vector := Vector_Magnitude (Complex_One);         
+                      -- Operation from the generic child package.
+ 
+       Report.Failed ("Exception not raised in child package");
+ 
+    exception
+       when Constraint_Error =>
+         Report.Comment ("Exception is raised as expected");
+ 
+       when others           =>
+         Report.Failed ("Others exception is raised");
+ 
+    end Out_Of_Range_Test;
+ 
+    Report.Result;
+ 
+ end CA11012;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11013.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11013.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11013.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11013.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,201 ----
+ -- CA11013.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a child function of a library level instantiation
+ --      of a generic can be the instantiation of a child function of
+ --      the generic. Check that the child instance can use its parent's
+ --      declarations and operations, including a formal subprogram of the 
+ --      parent.                                                           
+ --      
+ -- TEST DESCRIPTION:
+ --      Declare a generic package which simulates a real complex
+ --      abstraction.  Declare a generic child function of this package 
+ --      which builds a random complex number.  Declare a second
+ --      package which defines a random complex number generator.  This
+ --      package provides actual parameters for the generic parent package.
+ --
+ --      Instantiate the first generic package, then instantiate the child 
+ --      generic function as a child unit of the first instance.  In the main
+ --      program, check that the operations in both instances perform as 
+ --      expected.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
+ --                          clause of CA11013_3.
+ --      27 Feb 97   CTA.PWB Added elaboration pragma at package CA11013_3
+ --!
+   
+ generic               -- Complex number abstraction.
+    type Real_Type is digits <>;
+    with function Random_Generator (Seed : Real_Type) return Real_Type;
+ 
+ package CA11013_0 is
+  
+    -- Simulate a generic complex number support package. Complex numbers
+    -- are treated as coordinates in the Cartesian plane.
+ 
+    type Complex_Type is
+      record
+         Real : Real_Type;
+         Imag : Real_Type;
+      end record;
+ 
+    function Make (Real, Imag : Real_Type)           -- Create a complex
+      return Complex_Type;                           -- number.
+ 
+    procedure Components (Complex_No           : in Complex_Type;
+                          Real_Part, Imag_Part : out Real_Type);
+ 
+ end CA11013_0;
+ 
+      --==================================================================--
+ 
+ package body CA11013_0 is
+ 
+    function Make (Real, Imag : Real_Type) return Complex_Type is
+    begin
+       return (Real, Imag);
+    end Make;
+    -------------------------------------------------------------
+    procedure Components (Complex_No           : in Complex_Type;
+                          Real_Part, Imag_Part : out Real_Type) is
+    begin
+       Real_Part := Complex_No.Real;
+       Imag_Part := Complex_No.Imag;
+    end Components;
+ 
+ end CA11013_0;
+ 
+      --==================================================================--
+ 
+ -- Generic child of complex number package.  This child adds a layer of 
+ -- functionality to the parent generic.
+ 
+ generic               -- Random complex number operation.
+ 
+ function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type;
+ 
+                --==============================================--
+ 
+ function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type is
+ 
+    Random_Real_Part  :  Real_Type  := Random_Generator (Seed);
+                                       -- parent's formal subprogram
+    Random_Imag_Part  :  Real_Type  
+                      := Random_Generator (Random_Generator (Seed));
+                                       -- parent's formal subprogram
+    Random_Complex_No :  Complex_Type;
+ 
+ begin -- CA11013_0.CA11013_1
+ 
+    Random_Complex_No := Make (Random_Real_Part, Random_Imag_Part);
+                                       -- operation from parent
+    return (Random_Complex_No); 
+ 
+ end CA11013_0.CA11013_1;
+ 
+      --==================================================================--
+ 
+ package CA11013_2 is
+  
+    -- To be used as actual parameters for random number generator
+    -- in the parent package.
+ 
+    type My_Float is digits 6 range -10.0 .. 100.0;
+ 
+    function Random_Complex (Seed : My_float) return My_Float;
+ 
+ end CA11013_2;
+ 
+      --==================================================================--
+ 
+ package body CA11013_2 is
+ 
+    -- Not a real random number generator.
+    function Random_Complex (Seed : My_float) return My_Float is
+    begin
+       return (Seed + 3.0);    
+    end Random_Complex;
+ 
+ end CA11013_2;
+ 
+      --==================================================================--
+ 
+ -- Declare instances of the generic complex packages for real type.  
+ -- The instance of the child must itself be declared as a child of the 
+ -- instance of the parent.
+ 
+ with CA11013_0;                       -- Complex number.
+ with CA11013_2;                       -- Random number generator.
+ pragma Elaborate (CA11013_0);
+ package CA11013_3 is new 
+   CA11013_0 (Random_Generator => CA11013_2.Random_Complex,
+              Real_Type        => CA11013_2.My_Float);
+ 
+ with CA11013_0.CA11013_1;             -- Random complex number operation.
+ with CA11013_3;
+ pragma Elaborate (CA11013_3);
+ function CA11013_3.CA11013_4 is new CA11013_3.CA11013_1;
+   
+      --==================================================================--
+ 
+ with Report;
+ with CA11013_2;                       -- Random number generator.
+ with CA11013_3.CA11013_4;             -- Complex abstraction + Random complex 
+                                       -- number operation.
+ procedure CA11013 is
+ 
+    package My_Complex_Pkg renames CA11013_3;
+    use type CA11013_2.My_Float;
+ 
+    My_Complex                 : My_Complex_Pkg.Complex_Type;
+    My_Literal                 : CA11013_2.My_Float := 3.0;
+    My_Real_Part, My_Imag_Part : CA11013_2.My_Float;
+ 
+ begin
+ 
+    Report.Test ("CA11013", "Check that child instance can use its parent's "  &
+                            "declarations and operations, including a formal " &
+                            "subprogram of the parent");
+ 
+    My_Complex := CA11013_3.CA11013_4 (My_Literal); 
+                  -- Operation from the generic child function.
+ 
+    My_Complex_Pkg.Components (My_Complex, My_Real_Part, My_Imag_Part);
+                  -- Operation from the generic parent package.
+ 
+    if My_Real_Part /= 6.0           -- Operation from the generic 
+      or My_Imag_Part /= 9.0         -- parent package.
+        then
+          Report.Failed ("Incorrect results from complex operation");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11013;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11014.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11014.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11014.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11014.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,302 ----
+ -- CA11014.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an instantiation of a child package of a generic package
+ --      can use its parent's declarations and operations, including a formal 
+ --      package of the parent. 
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a list abstraction in a generic package which manages lists of
+ --      elements of any discrete type. Declare a generic package which 
+ --      operates on lists of elements of integer types.  Declare a generic
+ --      child of this package which defines additional list operations. 
+ --      Use the formal discrete type as the generic formal actual part for the
+ --      parent formal package. 
+ --
+ --      Declare an instance of parent, then declare an instance of the child 
+ --      which is itself a child the parent's instance. In the main program,
+ --      check that the operations in both instances perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --      07 Sep 96   SAIC    Change formal param E to be out only.
+ --      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
+ --                          clauses of CA11014_0, CA11014_1, and CA11014_5.
+ --      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11014_4
+ --!
+   
+ -- Actual package for the parent's formal.
+ generic               
+ 
+    type Element_Type is (<>);  -- List elems may be of any discrete types.
+ 
+ package CA11014_0 is              
+ 
+    type Node_Type;
+    type Node_Pointer is access Node_Type;
+ 
+    type Node_Type is record
+       Item : Element_Type;
+       Next : Node_Pointer := null;
+    end record;
+ 
+    type List_Type is record
+       First   : Node_Pointer := null;
+       Current : Node_Pointer := null;
+       Last    : Node_Pointer := null;
+    end record;
+ 
+    -- Return true if current element is last in the list.
+    function End_Of_List (L : List_Type) return boolean;
+ 
+    -- Set "current" pointer to first list element.
+    procedure Reset (L : in out List_Type);
+ 
+ end CA11014_0;
+ 
+      --==================================================================--
+ 
+ package body CA11014_0 is
+ 
+    function End_Of_List (L : List_Type) return boolean is
+    begin
+       return (L.Current = null);
+    end End_Of_List;
+    -------------------------------------------------------
+    procedure Reset (L : in out List_Type) is
+    begin
+       L.Current := L.First;                 -- Set "current" pointer to first
+    end Reset;                               -- list element.
+ 
+ end CA11014_0;
+ 
+      --==================================================================--
+ 
+ with CA11014_0;            -- Generic list abstraction.
+ pragma Elaborate (CA11014_0);
+ generic             
+ 
+    -- Import the list abstraction defined in CA11014_0.
+    with package List_Mgr is new CA11014_0 (<>);
+ 
+ package CA11014_1 is    
+ 
+    -- Write to current element and advance "current" pointer.
+    procedure Write_Element (L : in out List_Mgr.List_Type; 
+                             E : in     List_Mgr.Element_Type);
+ 
+    -- Read from current element and advance "current" pointer.
+    procedure Read_Element (L : in out List_Mgr.List_Type; 
+                            E :    out List_Mgr.Element_Type);
+ 
+    -- Add element to end of list.
+    procedure Add_Element (L : in out List_Mgr.List_Type; 
+                           E : in     List_Mgr.Element_Type);
+ 
+ end CA11014_1;
+ 
+      --==================================================================--
+ 
+ package body CA11014_1 is
+ 
+    procedure Write_Element (L : in out List_Mgr.List_Type; 
+                             E : in     List_Mgr.Element_Type) is
+    begin
+       L.Current.Item := E;               -- Write to current element.
+       L.Current      := L.Current.Next;  -- Advance "current" pointer.
+    end Write_Element;
+    -------------------------------------------------------
+    procedure Read_Element (L : in out List_Mgr.List_Type; 
+                            E :    out List_Mgr.Element_Type) is
+    begin
+       E         := L.Current.Item;       -- Retrieve current element.
+       L.Current := L.Current.Next;       -- Advance "current" pointer.
+    end Read_Element;
+    -------------------------------------------------------
+    procedure Add_Element (L : in out List_Mgr.List_Type; 
+                           E : in     List_Mgr.Element_Type) is
+       New_Node : List_Mgr.Node_Pointer := new List_Mgr.Node_Type'(E, null); 
+        use type List_Mgr.Node_Pointer;
+    begin
+       if L.First = null then                -- No elements in list, so add new
+          L.First := New_Node;               -- element at beginning of list.
+       else
+          L.Last.Next := New_Node;           -- Add new element at end of list.
+       end if;
+       L.Last := New_Node;                   -- Set last-in-list pointer.
+    end Add_Element;
+ 
+ end CA11014_1;
+ 
+      --==================================================================--
+ 
+ -- Generic child of list operation.  This child adds a layer of 
+ -- functionality to the parent generic.
+ 
+ generic
+ 
+ package CA11014_1.CA11014_2 is
+ 
+    procedure Write_First_To_List (L : in out List_Mgr.List_Type);
+ 
+    -- ... Various other operations used by the application.
+ 
+ end CA11014_1.CA11014_2;
+ 
+      --==================================================================--
+ 
+ package body CA11014_1.CA11014_2 is
+ 
+    procedure Write_First_To_List (L : in out List_Mgr.List_Type) is
+    begin
+       List_Mgr.Reset (L);    -- Parent's formal package.
+ 
+       while not List_Mgr.End_Of_List (L) loop     -- Parent's formal package.
+          Write_Element (L, List_Mgr.Element_Type'First);   
+                                                   -- Parent's operation, 
+       end loop;                                   -- parent's formal.
+       
+    end Write_First_To_List;
+ 
+ end CA11014_1.CA11014_2;
+ 
+      --==================================================================--
+ 
+ package CA11014_3 is
+ 
+    type Points is range 0 .. 100;
+ 
+    -- ... Various other types used by the application.
+ 
+ end CA11014_3;
+ 
+ 
+ -- No body for CA11014_3;
+ 
+      --==================================================================--
+ 
+ -- Declare instances of the generic list packages for the discrete type.
+ -- The instance of the child must itself be declared as a child of the 
+ -- instance of the parent.
+ 
+ with CA11014_0;               -- Generic list abstraction.
+ with CA11014_3;               -- Package containing discrete type declaration.
+ pragma Elaborate (CA11014_0);
+ package CA11014_4 is new CA11014_0 (CA11014_3.Points);  -- Points list.
+ 
+ with CA11014_4;               -- Points list.
+ with CA11014_1;               -- Generic list operation.
+ pragma Elaborate (CA11014_1);
+ package CA11014_5 is new CA11014_1 (CA11014_4);         -- Scores list.
+ 
+ with CA11014_1.CA11014_2;     -- Additional generic list operation,
+ with CA11014_5;
+ pragma Elaborate (CA11014_5);
+ package CA11014_5.CA11014_6 is new CA11014_5.CA11014_2;
+                                                    -- Points list operation.
+ 
+      --==================================================================--
+ 
+ with CA11014_1.CA11014_2;      -- Additional generic list operation,
+                                -- implicitly with list operation.
+ with CA11014_3;                -- Package containing discrete type declaration.
+ with CA11014_4;                -- Points list.
+ with CA11014_5.CA11014_6;      -- Points list operation.
+ with Report;
+ 
+ procedure CA11014 is
+ 
+    package Lists_Of_Scores renames CA11014_4;
+    package Score_Ops renames CA11014_5;
+    package Point_Ops renames CA11014_5.CA11014_6;
+ 
+    Scores : Lists_Of_Scores.List_Type;                -- List of points.
+ 
+    type TC_Score_Array is array (1 .. 3) of CA11014_3.Points;
+ 
+    TC_Initial_Values : constant TC_Score_Array := (10, 21, 49);
+    TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
+ 
+    TC_Initial_Values_Are_Correct : boolean := false;
+    TC_Final_Values_Are_Correct   : boolean := false;
+ 
+                --------------------------------------------------
+ 
+    -- Initial list contains 3 scores with the values 10, 21, and 49.
+    procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
+    begin                                  
+       for I in TC_Score_Array'range loop  
+          Score_Ops.Add_Element (L, TC_Initial_Values(I));
+                    -- Operation from generic parent.
+       end loop;
+    end TC_Initialize_List;
+ 
+                --------------------------------------------------
+ 
+    -- Verify that all scores have been set to zero.
+    procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
+                              Expected : in     TC_Score_Array;
+                              OK       :    out boolean) is
+       Actual : TC_Score_Array;
+    begin                                  
+       Lists_of_Scores.Reset (L);       -- Operation from parent's formal.
+       for I in TC_Score_Array'range loop
+          Score_Ops.Read_Element (L, Actual(I));
+                    -- Operation from generic parent.
+       end loop;
+       OK := (Actual = Expected);
+    end TC_Verify_List;
+ 
+                --------------------------------------------------
+ 
+ begin -- CA11014 
+ 
+    Report.Test ("CA11014", "Check that an instantiation of a child package " &
+                            "of a generic package can use its parent's "      & 
+                            "declarations and operations, including a "       &
+                            "formal package of the parent");
+ 
+    TC_Initialize_List (Scores);
+    TC_Verify_List (Scores, TC_Initial_Values, TC_Initial_Values_Are_Correct);
+ 
+    if not TC_Initial_Values_Are_Correct then
+       Report.Failed ("List contains incorrect initial values");
+    end if;
+ 
+    Point_Ops.Write_First_To_List (Scores);
+                    -- Operation from generic child package.
+ 
+    TC_Verify_List (Scores, TC_Final_Values, TC_Final_Values_Are_Correct);
+ 
+    if not TC_Final_Values_Are_Correct then
+       Report.Failed ("List contains incorrect final values");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11014;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11015.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11015.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11015.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11015.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,312 ----
+ -- CA11015.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a generic child of a non-generic package can use its 
+ --      parent's declarations and operations.  Check that the instantiation
+ --      of the generic child can correctly use the operations.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a map abstraction in a package which manages basic physical
+ --      maps.  Declare a generic child of this package which defines copies
+ --      of maps of any discrete type, i.e., population, density, or weather.
+ --
+ --      In the main program, declare an instance of the child.  Check that
+ --      the operations in the parent and instance of the child package 
+ --      perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Simulates map of physical features, i.e., desert, forest, water, 
+ -- or plains.
+ 
+ package CA11015_0 is              
+    type Map_Type is private;
+    subtype Latitude is integer range 1 .. 9;
+    subtype Longitude is integer range 1 .. 7;
+ 
+    type Physical_Features is (Desert, Forest, Water, Plains, Unexplored);
+    type Page_Type is range 0 .. 80;
+    
+    Terra_Incognita : exception;
+ 
+    -- Use geographic database to initialize the basic map.
+ 
+    procedure Initialize_Basic_Map (Map  : in out Map_Type);
+ 
+    function Get_Physical_Feature (Lat  : Latitude;
+                                   Long : Longitude;
+                                   Map  : Map_Type) return Physical_Features;
+ 
+    function Next_Page return Page_Type;
+ 
+ private
+    type Map_Type is array (Latitude, Longitude) of Physical_Features;
+    Basic_Map : Map_Type;
+    Page      : Page_Type := 0;       -- Location for each copy of Map.
+ 
+ end CA11015_0;
+ 
+      --==================================================================--
+ 
+ package body CA11015_0 is              
+ 
+    procedure Initialize_Basic_Map (Map : in out Map_Type) is
+    -- Not a real initialization.  Real application can use geographic
+    -- database to create the basic map.
+    begin
+       for I in Latitude'first .. Latitude'last loop
+          for J in 1 .. 2 loop
+             Map (I, J) := Unexplored;
+          end loop;
+          for J in 3 .. 4 loop
+             Map (I, J) := Desert;
+          end loop;
+          for J in 5 .. 7 loop
+             Map (I, J) := Plains;
+          end loop;
+       end loop;
+ 
+    end Initialize_Basic_Map;
+    ---------------------------------------------------
+    function Get_Physical_Feature (Lat  : Latitude;
+                                   Long : Longitude;
+                                   Map  : Map_Type) 
+      return Physical_Features is
+    begin
+      return (Map (Lat, Long));
+    end Get_Physical_Feature;
+    ---------------------------------------------------
+    function Next_Page return Page_Type is
+    begin
+       Page := Page + 1;
+       return (Page);
+    end Next_Page;
+ 
+    ---------------------------------------------------
+    begin -- CA11015_0
+       -- Initialize a basic map.
+       Initialize_Basic_Map (Basic_Map);
+ 
+ end CA11015_0;
+ 
+      --==================================================================--
+ 
+ -- Generic child package of physical map.  Instantiate this package to
+ -- create map copy with a new geographic feature, i.e., population, density,
+ -- or weather.
+ 
+ generic               
+ 
+    type Generic_Feature is (<>);  -- Any geographic feature, i.e., population,
+                                   -- density, or weather that can be
+                                   -- characterized by a scalar value.
+ 
+ package CA11015_0.CA11015_1 is              
+ 
+    type Feature_Map is private;
+ 
+    function Get_Feature_Val (Lat  : Latitude;
+                              Long : Longitude;
+                              Map  : Feature_Map) return Generic_Feature;
+ 
+    procedure Set_Feature_Val (Lat  : in     Latitude;
+                               Long : in     Longitude;
+                               Fea  : in     Generic_Feature;
+                               Map  : in out Feature_Map);
+ 
+    function Check_Page (Map     : Feature_Map;
+                         Page_No : Page_Type) return boolean;
+ 
+ private
+    type Feature_Type is array (Latitude, Longitude) of Generic_Feature;
+ 
+    type Feature_Map is
+      record
+         Feature : Feature_Type;
+         Page    : Page_Type := Next_Page;    -- Operation from parent.
+      end record;
+ 
+ end CA11015_0.CA11015_1;
+ 
+      --==================================================================--
+ 
+ package body CA11015_0.CA11015_1 is              
+ 
+    function Get_Feature_Val (Lat  : Latitude;
+                              Long : Longitude;
+                              Map  : Feature_Map) return Generic_Feature is
+    begin
+      return (Map.Feature (Lat, Long));
+    end Get_Feature_Val;
+    ---------------------------------------------------
+    procedure Set_Feature_Val (Lat  : in     Latitude;
+                               Long : in     Longitude;
+                               Fea  : in     Generic_Feature;
+                               Map  : in out Feature_Map) is
+    begin
+       if Get_Physical_Feature (Lat, Long, Basic_Map) = Unexplored  
+                                                 -- Parent's operation,
+                                                 -- Parent's private object.
+       then
+          raise Terra_Incognita;                 -- Exception from parent.
+       else
+          Map.Feature (Lat, Long) := Fea;
+       end if;
+    end Set_Feature_Val;
+    ---------------------------------------------------
+    function Check_Page (Map     : Feature_Map;
+                         Page_No : Page_Type) return boolean is
+    begin
+       return (Map.Page = Page_No);
+    end Check_Page;
+ 
+ end CA11015_0.CA11015_1;
+ 
+      --==================================================================--
+ 
+ with CA11015_0.CA11015_1;              -- Generic map operation,
+                                        -- implicitly withs parent, basic map
+                                        -- application.
+ with Report;
+ 
+ procedure CA11015 is
+ 
+ begin 
+ 
+    Report.Test ("CA11015", "Check that an instantiation of a child package " &
+                            "of a non-generic package can use its parent's "  &
+                            "declarations and operations");
+ 
+ -- An application creates a population map using an integer type.
+ 
+            Population_Map_Subtest:
+            declare
+               type Population_Type is range 0 .. 10_000;         
+ 
+               -- Declare instance of the child generic map package for one 
+               -- particular integer type.            
+ 
+               package Population is new CA11015_0.CA11015_1 (Population_Type);
+ 
+               Population_Map_Latitude   : CA11015_0.Latitude := 1;  
+                                                    -- parent's type
+               Population_Map_Longitude : CA11015_0.Longitude := 5;
+                                                    -- parent's type
+               Pop_Map                   : Population.Feature_Map;
+               Pop                       : Population_Type := 1000;
+ 
+            begin
+               Population.Set_Feature_Val (Population_Map_Latitude, 
+                                           Population_Map_Longitude,
+                                           Pop, 
+                                           Pop_Map);
+ 
+               If not ( (Population.Get_Feature_Val (Population_Map_Latitude, 
+                 Population_Map_Longitude, Pop_Map) = Pop) or  
+                   (Population.Check_Page (Pop_Map, 1)) ) then
+                     Report.Failed ("Population map contains incorrect values");
+               end if;
+ 
+            end Population_Map_Subtest;
+ 
+ -- An application creates a weather map using an enumeration type.
+ 
+            Weather_Map_Subtest:
+            declare
+               type Weather_Type is (Hot, Cold, Mild);                    
+ 
+               -- Declare instance of the child generic map package for one 
+               -- particular enumeration type.            
+ 
+               package Weather_Pkg is new CA11015_0.CA11015_1 (Weather_Type);
+ 
+               Weather_Map_Latitude   : CA11015_0.Latitude := 2;
+                                                    -- parent's type
+               Weather_Map_Longitude : CA11015_0.Longitude := 6;
+                                                    -- parent's type
+               Weather_Map            : Weather_Pkg.Feature_Map;
+               Weather                : Weather_Type := Mild;
+ 
+            begin
+               Weather_Pkg.Set_Feature_Val (Weather_Map_Latitude, 
+                                            Weather_Map_Longitude,
+                                            Weather, 
+                                            Weather_Map);
+ 
+               if ( (Weather_Pkg.Get_Feature_Val (Weather_Map_Latitude, 
+                     Weather_Map_Longitude, Weather_Map) /= Weather) or
+                 not (Weather_Pkg.Check_Page (Weather_Map, 2)) )
+               then
+                  Report.Failed ("Weather map contains incorrect values");
+               end if;
+ 
+            end Weather_Map_Subtest;
+ 
+ -- During processing, the application may erroneously attempts to create 
+ -- a density map on an unexplored area.  This would result in the raising 
+ -- of an exception.
+ 
+            Density_Map_Subtest:
+            declare
+               type Density_Type is (High, Medium, Low);
+ 
+               -- Declare instance of the child generic map package for one 
+               -- particular enumeration type.            
+ 
+               package Density_Pkg is new CA11015_0.CA11015_1 (Density_Type);
+ 
+               Density_Map_Latitude   : CA11015_0.Latitude := 7;
+                                                    -- parent's type
+               Density_Map_Longitude : CA11015_0.Longitude := 2;
+                                                    -- parent's type
+               Density                : Density_Type := Low;
+               Density_Map            : Density_Pkg.Feature_Map;
+ 
+            begin
+               Density_Pkg.Set_Feature_Val (Density_Map_Latitude, 
+                                            Density_Map_Longitude,
+                                            Density, 
+                                            Density_Map);
+ 
+               Report.Failed ("Exception not raised in child generic package");
+ 
+            exception
+ 
+               when CA11015_0.Terra_Incognita =>   -- parent's exception,
+                   null;                           -- raised in child.
+ 
+               when others          =>         
+                   Report.Failed ("Others exception is raised");
+ 
+            end Density_Map_Subtest;
+ 
+    Report.Result;
+ 
+ end CA11015;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11016.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11016.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11016.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11016.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,321 ----
+ -- CA11016.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a child of a non-generic package can be a private generic 
+ --      package. Check that the private child instance can use its parent's
+ --      declarations and operations.  Check that the body of a public child 
+ --      package can instantiate its sibling private generic package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a map abstraction in a package which manages basic physical
+ --      map[s].  Declare a private generic child of this package which can be
+ --      instantiated for any display device which has display locations of 
+ --      the physical map that can be characterized by any integer type, i.e., 
+ --      the intensity of the display point.
+ --
+ --      Declare a public child of the physical map which specifies the 
+ --      display device.  In the body of this child, declare an instance of 
+ --      its generic sibling to display the geographic locations.
+ --
+ --      In the main program, check that the operations in the parent, public 
+ --      child and instance of the private child package perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      17 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate.
+ --
+ --!
+ 
+ -- Simulates map of physical features, i.e., desert, forest, or water.
+ 
+ package CA11016_0 is              
+    type Map_Type is private;
+    subtype Latitude is integer range 1 .. 9;
+    subtype Longitude is integer range 1 .. 7;
+ 
+    type Physical_Features is (Desert, Forest, Water);
+    
+    -- Use geographic database to initialize the basic map.
+ 
+    procedure Initialize_Basic_Map (Map  : in out Map_Type);
+ 
+    function Get_Physical_Feature (Lat  : Latitude;
+                                   Long : Longitude;
+                                   Map  : Map_Type) return Physical_Features;
+ 
+ private
+    type Map_Type is array (Latitude, Longitude) of Physical_Features;
+    Basic_Map : Map_Type;
+ 
+ end CA11016_0;
+ 
+      --==================================================================--
+ 
+ package body CA11016_0 is              
+ 
+    procedure Initialize_Basic_Map (Map : in out Map_Type) is
+    -- Not a real initialization.  Real application can use geographic
+    -- database to create the basic map.
+ 
+    begin
+       for I in Latitude'first .. Latitude'last loop
+          for J in 1 .. 2 loop
+             Map (I, J) := Desert;
+          end loop;
+          for J in 3 .. 4 loop
+             Map (I, J) := Forest;
+          end loop;
+          for J in 5 .. 7 loop
+             Map (I, J) := Water;
+          end loop;
+       end loop;
+ 
+    end Initialize_Basic_Map;
+    --------------------------------------------------------
+    function Get_Physical_Feature (Lat  : Latitude;
+                                   Long : Longitude;
+                                   Map  : Map_Type) 
+      return Physical_Features is
+    begin
+      return (Map (Lat, Long));
+    end Get_Physical_Feature;
+    --------------------------------------------------------
+ 
+    begin
+       -- Initialize a basic map.
+       Initialize_Basic_Map (Basic_Map);
+ 
+ end CA11016_0;
+ 
+      --==================================================================--
+ 
+ -- Private generic child package of physical map.  This generic package may
+ -- be instantiated for any display device which has display locations 
+ -- (latitude, longitude) that can be characterized by an integer value.
+ -- For example, the intensity of the display point might be so characterized.
+ -- It can be instantiated for any desired range of values (which would 
+ -- correspond to the range accepted by the display device).
+ 
+ 
+ private 
+ 
+ generic               
+ 
+    type Display_Value is range <>;  -- Any display feature that is 
+                                     -- represented by an integer.
+ 
+ package CA11016_0.CA11016_1 is              
+ 
+    function Get_Display_Value (Lat  : Latitude;
+                                Long : Longitude;
+                                Map  : Map_Type) return Display_Value;
+ 
+ end CA11016_0.CA11016_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CA11016_0.CA11016_1 is              
+ 
+    function Get_Display_Value (Lat  : Latitude;
+                                Long : Longitude;
+                                Map  : Map_Type) 
+      return Display_Value is
+    begin
+       case Get_Physical_Feature (Lat, Long, Map) is
+                                           -- Parent's operation,
+            when Forest => return (Display_Value'first);
+                                           -- Parent's type.
+            when Desert => return (Display_Value'last);
+                                           -- Parent's type.
+            when others => return 
+                             ( (Display_Value'last - Display_Value'first) / 2 );
+                                           -- NOTE: Results are truncated.
+       end case;
+ 
+    end Get_Display_Value;
+ 
+ end CA11016_0.CA11016_1;
+ 
+ 
+      --==================================================================--
+ 
+ -- Map display operation, public child of physical map.
+ 
+ package CA11016_0.CA11016_2 is              
+ 
+    -- Super-duper Ultra Geographic Display Device (SDUGD) can display 
+    -- geographic locations with light intensity values ranging from 1 to 7.
+ 
+    type Display_Val is range 1 .. 7;
+ 
+    type Device_Color is (Brown, Blue, Green);
+ 
+    type IO_Packet is
+       record
+          Lat       : Latitude;       -- Parent's type.
+          Long      : Longitude;      -- Parent's type.
+          Color     : Device_Color;
+          Intensity : Display_Val;
+       end record;
+ 
+    procedure Data_For_SDUGD (Lat           : in     Latitude;
+                              Long          : in     Longitude;
+                              Output_Packet : in out IO_Packet);
+ 
+ end CA11016_0.CA11016_2;
+ 
+      --==================================================================--
+ 
+ 
+ with CA11016_0.CA11016_1;          -- Private generic sibling.
+ pragma Elaborate (CA11016_0.CA11016_1);
+ 
+ package body CA11016_0.CA11016_2 is              
+ 
+    -- Declare instance of the private generic sibling for 
+    -- an integer type that represents color intensity.
+ 
+    package SDUGD is new CA11016_0.CA11016_1 (Display_Val);
+ 
+    procedure Data_For_SDUGD (Lat           : in     Latitude;
+                              Long          : in     Longitude;
+                              Output_Packet : in out IO_Packet) is
+ 
+    -- Simulates sending control information to a display device.
+    -- Control information consists of latitude, longitude, a
+    -- color, and an intensity.
+ 
+    begin
+       case Get_Physical_Feature (Lat, Long, Basic_Map) is
+                                            -- Parent's operation.
+          when Water  => Output_Packet.Color     := Blue;
+                         Output_Packet.Intensity := SDUGD.Get_Display_Value 
+                                                    (Lat, Long, Basic_Map);
+                                            -- Sibling's operation.
+          when Forest => Output_Packet.Color     := Green;
+                         Output_Packet.Intensity := SDUGD.Get_Display_Value 
+                                                    (Lat, Long, Basic_Map);
+                                            -- Sibling's operation.
+          when others => Output_Packet.Color     := Brown;
+                         Output_Packet.Intensity := SDUGD.Get_Display_Value 
+                                                    (Lat, Long, Basic_Map);
+                                            -- Sibling's operation.
+        end case;
+ 
+    end Data_For_SDUGD;
+ 
+ end CA11016_0.CA11016_2;
+ 
+      --==================================================================--
+ 
+ with CA11016_0.CA11016_2;            -- Map display device operation,
+                                      -- implicitly withs parent, physical map
+                                      -- application.
+ 
+ use CA11016_0.CA11016_2;             -- Allows direct visibility to the simple
+                                      -- name of CA11016_0.CA11016_2.
+ 
+ with Report;
+ 
+ procedure CA11016 is
+ 
+    TC_Packet : IO_Packet;
+ 
+ begin 
+ 
+    Report.Test ("CA11016", "Check that body of a public child package can " &
+                            "use its sibling private generic package "       &
+                            "declarations and operations");
+ 
+ -- Simulate control information at coordinates 3 and 7 of the
+ -- basic map for the SDUGD.
+          
+          Water_Display_Subtest:
+          begin
+             TC_Packet.Lat  := 3;
+             TC_Packet.Long := 7;
+ 
+             -- Build color and light intensity of the basic map at 
+             -- latitude 3 and longitude 7.
+ 
+             Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
+ 
+             if ( (TC_Packet.Color     /= Blue) or
+                  (TC_Packet.Intensity /= 3) ) then
+                 Report.Failed ("Map display device contains " &
+                                "incorrect values for water subtest");
+             end if;
+ 
+          end Water_Display_Subtest;
+ 
+ -- Simulate control information at coordinates 2 and 1 of the
+ -- basic map for the SDUGD.
+          
+          Desert_Display_Subtest:
+          begin
+             TC_Packet.Lat  := 9;
+             TC_Packet.Long := 2;
+ 
+             -- Build color and light intensity of the basic map at 
+             -- latitude 9 and longitude 2.
+ 
+             Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
+ 
+             if ( (TC_Packet.Color     /= Brown) or
+                  (TC_Packet.Intensity /= 7) ) then
+                 Report.Failed ("Map display device contains " &
+                                "incorrect values for desert subtest");
+             end if;
+ 
+          end Desert_Display_Subtest;
+ 
+ -- Simulate control information at coordinates 8 and 4 of the
+ -- basic map for the SDUGD.
+          
+          Forest_Display_Subtest:
+          begin
+             TC_Packet.Lat  := 8;
+             TC_Packet.Long := 4;
+ 
+             -- Build color and light intensity of the basic map at 
+             -- latitude 8 and longitude 4.
+ 
+             Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
+ 
+             if ( (TC_Packet.Color     /= Green) or
+                  (TC_Packet.Intensity /= 1) ) then
+                 Report.Failed ("Map display device contains " &
+                                "incorrect values for forest subtest");
+             end if;
+ 
+          end Forest_Display_Subtest;
+ 
+    Report.Result;
+ 
+ end CA11016;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11017.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11017.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11017.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11017.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,246 ----
+ -- CA11017.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that body of the parent package may depend on one of its own 
+ --      public children.
+ --
+ -- TEST DESCRIPTION:
+ --      A scenario is created that demonstrates the potential of adding a
+ --      public child during code maintenance without distubing a large 
+ --      subsystem.  After child is added to the subsystem, a maintainer
+ --      decides to take advantage of the new functionality and rewrites
+ --      the parent's body.
+ --
+ --      Declare a string abstraction in a package which manipulates string
+ --      replacement. Define a parent package which provides operations for 
+ --      a record type with discriminant.  Declare a public child of this 
+ --      package which adds functionality to the original subsystem.  In the 
+ --      parent body, call operations from the public child.
+ --
+ --      In the main program, check that operations in the parent and public 
+ --      child perform as expected.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Simulates application which manipulates strings.
+ 
+ package CA11017_0 is               
+ 
+    type String_Rec (The_Size : positive) is private;
+ 
+    type Substring is new string;
+ 
+    -- ... Various other types used by the application.
+ 
+    procedure Replace (In_The_String   : in out String_Rec;
+                       At_The_Position : in     positive;
+                       With_The_String : in     String_Rec);
+ 
+    -- ... Various other operations used by the application.
+ 
+ private
+    -- Different size for each individual record.
+ 
+    type String_Rec (The_Size : positive) is
+       record
+          The_Length  : natural := 0;
+          The_Content : Substring (1 .. The_Size);
+       end record;
+ 
+ end CA11017_0;
+ 
+      --=================================================================--
+ 
+ -- Public child added during code maintenance without disturbing a 
+ -- large system.  This public child would add functionality to the
+ -- original system.
+ 
+ package CA11017_0.CA11017_1 is    
+ 
+    Position_Error : exception;
+ 
+    function Equal_Length (Left  : in String_Rec;
+                           Right : in String_Rec) return boolean;
+ 
+    function Same_Content (Left  : in String_Rec;
+                           Right : in String_Rec) return boolean;
+ 
+    procedure Copy (From_The_Substring : in     Substring;
+                    To_The_String      : in out String_Rec);
+ 
+    -- ... Various other operations used by the application.
+ 
+ end CA11017_0.CA11017_1;
+ 
+      --=================================================================--
+ 
+ package body CA11017_0.CA11017_1 is    
+ 
+    function Equal_Length (Left  : in String_Rec;
+                           Right : in String_Rec) return boolean is
+    -- Quick comparison between the lengths of the input strings.
+ 
+    begin
+       return (Left.The_Length = Right.The_Length);  -- Parent's private
+                                                     -- type.
+    end Equal_Length;
+    --------------------------------------------------------------------
+    function Same_Content (Left  : in String_Rec;
+                           Right : in String_Rec) return boolean is
+ 
+    begin
+       for I in 1 .. Left.The_Length loop
+          if Left.The_Content (I) = Right.The_Content (I) then
+             return true;
+          else
+             return false;
+          end if;
+       end loop;
+ 
+    end Same_Content;
+    --------------------------------------------------------------------
+    procedure Copy (From_The_Substring : in     Substring;
+                    To_The_String      : in out String_Rec) is
+    begin
+       To_The_String.The_Content        -- Parent's private type.
+         (1 .. From_The_Substring'length) := From_The_Substring;
+ 
+       To_The_String.The_Length         -- Parent's private type.
+                                          := From_The_Substring'length;
+    end Copy;
+ 
+ end CA11017_0.CA11017_1;
+ 
+      --=================================================================--
+ 
+ --  After child is added to the subsystem, a maintainer decides
+ --  to take advantage of the new functionality and rewrites the
+ --  parent's body.
+ 
+ with CA11017_0.CA11017_1;
+ 
+ package body CA11017_0 is
+ 
+    -- Calls functions from public child for a quick comparison of the
+    -- input strings.  If their lengths are the same, do the replacement.
+ 
+    procedure Replace (In_The_String   : in out String_Rec;
+                       At_The_Position : in     positive;
+                       With_The_String : in     String_Rec) is
+       End_Position : natural := At_The_Position +
+                                 With_The_String.The_Length - 1;
+ 
+    begin
+       if not CA11017_0.CA11017_1.Equal_Length  -- Public child's operation.
+         (With_The_String, In_The_String) then
+            raise CA11017_0.CA11017_1.Position_Error;                 
+                                                -- Public child's exception.
+       else 
+          In_The_String.The_Content (At_The_Position .. End_Position) :=
+            With_The_String.The_Content (1 .. With_The_String.The_Length);
+       end if;
+ 
+    end Replace;
+ 
+ end CA11017_0;
+ 
+      --=================================================================--
+ 
+ with Report;
+ 
+ with CA11017_0.CA11017_1;   -- Explicit with public child package,
+                             -- implicit with parent package (CA11017_0).
+ 
+ procedure CA11017 is
+ 
+    package String_Pkg renames CA11017_0;
+    use String_Pkg;
+ 
+ begin
+ 
+    Report.Test ("CA11017", "Check that body of the parent package can " &
+                 "depend on one of its own public children");
+ 
+ -- Both input strings have the same size. Replace the first string by the 
+ -- second string.  
+ 
+         Replace_Subtest:
+         declare
+            The_First_String, The_Second_String : String_Rec (16);
+                                                  -- Parent's private type.
+            The_Position                        : positive := 1;
+         begin
+            CA11017_1.Copy ("This is the time", 
+                            To_The_String => The_First_String); 
+ 
+            CA11017_1.Copy ("For all good men", The_Second_String); 
+ 
+            Replace (The_First_String, The_Position, The_Second_String);
+   
+            -- Compare results using function from public child since
+            -- the type is private.
+ 
+            if not CA11017_1.Same_Content
+                             (The_First_String, The_Second_String) then
+               Report.Failed ("Incorrect results");
+            end if;
+ 
+         end Replace_Subtest;
+ 
+ -- During processing, the application may erroneously attempt to replace
+ -- strings of different size. This would result in the raising of an 
+ -- exception.                                                       
+ 
+         Exception_Subtest:
+         declare
+            The_First_String  : String_Rec (17);
+                                                  -- Parent's private type.
+            The_Second_String : String_Rec (13);
+                                                  -- Parent's private type.
+            The_Position      : positive := 2;
+         begin
+            CA11017_1.Copy (" ACVC Version 2.0", The_First_String); 
+ 
+            CA11017_1.Copy (From_The_Substring => "ACVC 9X Basic", 
+                            To_The_String      => The_Second_String); 
+ 
+            Replace (The_First_String, The_Position, The_Second_String);
+ 
+            Report.Failed ("Exception was not raised");
+ 
+         exception
+            when CA11017_1.Position_Error =>
+                   Report.Comment ("Exception is raised as expected");
+ 
+         end Exception_Subtest;
+ 
+    Report.Result;
+ 
+ end CA11017;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11018.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11018.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11018.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11018.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,366 ----
+ -- CA11018.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that body of the parent package may depend on one of its own 
+ --      public generic children.
+ --
+ -- TEST DESCRIPTION:
+ --      A scenario is created that demonstrates the potential of adding a
+ --      public generic child during code maintenance without distubing a large 
+ --      subsystem.  After child is added to the subsystem, a maintainer
+ --      decides to take advantage of the new functionality and rewrites
+ --      the parent's body.
+ --
+ --      Declare a message application in a package which highlights some
+ --      key words.  Declare a public generic child of this package which adds 
+ --      functionality to the original subsystem.  In the parent body, 
+ --      instantiate the child.
+ --
+ --      In the main program, check that the operations in the parent, 
+ --      and instances of the public child package perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      14 Dec 94   SAIC    Modified Copy_Particularly_Designated_Pkg inst.
+ --      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --
+ --!
+   
+ -- Simulates application which displays messages.
+ 
+ package CA11018_0 is               
+ 
+    type Designated_Num is new Integer range 0 .. 100;
+ 
+    type Particularly_Designated_Num is new Integer range 0 .. 100;
+ 
+    type Message is new String;
+ 
+    type Message_Rec is tagged private;
+ 
+    type Designated_Msg is new Message_Rec with private;
+ 
+    type Particularly_Designated_Msg is new Message_Rec with private;
+ 
+    -- Analyzes message for presence of word in the secret message. If found, 
+    -- word is highlighted.
+ 
+    procedure Highlight_Designated (The_Word       : in     Message;
+                                    In_The_Message : in out Designated_Msg);
+                                
+ 
+    -- Analyzes message for presence of word in the secret message. If found, 
+    -- word is highlighted and do other actions.
+ 
+    procedure Highlight_Particularly_Designated 
+      (The_Word       : in     Message;
+       In_The_Message : in out Particularly_Designated_Msg);
+  
+ 
+    -- Begin test code declarations: -----------------------
+ 
+    TC_Designated_Not_Zero : Boolean := false;
+ 
+    TC_Particularly_Designated_Not_Zero : Boolean := false;
+ 
+    -- The following two functions are used to check for function
+    -- calls from the public generic child.
+ 
+    function TC_Designated_Success return Boolean;
+ 
+    function TC_Particularly_Designated_Success return Boolean;
+ 
+    -- End test code declarations. -------------------------
+ 
+ private
+    type Message_Rec is tagged
+       record
+          The_Length  : natural := 0;
+          The_Content : Message (1 .. 60);
+       end record;
+ 
+    type Designated_Msg is new Message_Rec with null record;
+    -- ... More components in real application.
+ 
+    type Particularly_Designated_Msg is new Message_Rec with null record;
+    -- ... More components in real application.
+ 
+ end CA11018_0;
+ 
+      --=================================================================--
+ 
+ 
+ -- Public generic child package of message display application.  Imagine that 
+ -- messages of one security level are associated with a type derived from 
+ -- integer.  For overall system security, messages of a different security
+ -- level are associated with a different type derived from integer.  By 
+ -- instantiating this package for each security level, the results of Count 
+ -- applied to one kind of message cannot inadvertently be compared with the 
+ -- results applied to a different kind.
+ 
+ generic
+    type Msg_Type is new Message_Rec with private; 
+                                               -- Derived from parent's type.
+    type Count is range <>;
+ 
+ package CA11018_0.CA11018_1 is    
+ 
+    TC_Function_Called : Boolean := false;
+ 
+    function Find_Word (Wrd : in Message;
+                        Msg : in Msg_Type) return Count;
+ 
+ end CA11018_0.CA11018_1;
+ 
+      --=================================================================--
+ 
+ package body CA11018_0.CA11018_1 is    
+ 
+    function Find_Word (Wrd : in Message;
+                        Msg : in Msg_Type) return Count is
+ 
+       Num  : Count   := Count'first;
+ 
+    -- Count how many time the word appears within the given message.
+ 
+    begin
+       -- ... Error-checking code omitted for brevity.
+ 
+       for I in 1 .. (Msg.The_Length - Wrd'length + 1) loop
+                                                  -- Parent's private type
+          if Msg.The_Content (I .. I + Wrd'length - 1) = Wrd
+                                                  -- Parent's private type
+            then
+               Num := Num + 1;
+          end if;
+ 
+       end loop;
+ 
+       TC_Function_Called := true;
+ 
+       return (Num);
+ 
+    end Find_Word;
+ 
+ end CA11018_0.CA11018_1;
+ 
+      --=================================================================--
+ 
+ with CA11018_0.CA11018_1;   -- Public generic child.
+ 
+ pragma Elaborate (CA11018_0.CA11018_1);
+ package body CA11018_0 is
+ 
+    ----------------------------------------------------
+    -- Parent's body depends on public generic child. --
+    ----------------------------------------------------
+ 
+    -- Instantiate the public child for the secret message.
+ 
+    package Designated_Pkg is new CA11018_0.CA11018_1 
+      (Msg_Type => Designated_Msg, Count => Designated_Num);
+ 
+    -- Instantiate the public child for the top secret message.
+ 
+    package Particularly_Designated_Pkg is new CA11018_0.CA11018_1 
+      (Particularly_Designated_Msg, Particularly_Designated_Num);
+ 
+    -- End instantiations. -----------------------------
+ 
+    
+    function TC_Designated_Success return Boolean is
+    -- Check to see if the function in the public generic child is called.
+ 
+    begin
+       return Designated_Pkg.TC_Function_Called;
+    end TC_Designated_Success;
+    --------------------------------------------------------------
+    function TC_Particularly_Designated_Success return Boolean is
+    -- Check to see if the function in the public generic child is called.
+ 
+    begin
+       return Particularly_Designated_Pkg.TC_Function_Called;
+    end TC_Particularly_Designated_Success;
+    --------------------------------------------------------------
+    -- Calls functions from public child to search for a key word.  
+    -- If the word appears more than once in each message, 
+    -- highlight all of them.
+ 
+    procedure Highlight_Designated (The_Word       : in     Message;
+                                    In_The_Message : in out Designated_Msg) is
+ 
+    -- Not a real highlight procedure.  Real application can use graphic
+    -- device to highlight all occurrences of words.
+ 
+    begin
+       --------------------------------------------------------------
+       -- Parent's body uses function from instantiation of public --
+       -- generic child.                                           --
+       --------------------------------------------------------------
+ 
+       if Designated_Pkg.Find_Word          -- Child's operation.   
+         (The_Word, In_The_Message) > 0 then
+ 
+           -- Highlight all occurrences in lavender.
+ 
+           TC_Designated_Not_Zero := true;       
+       end if;
+ 
+    end Highlight_Designated;
+    --------------------------------------------------------------
+    procedure Highlight_Particularly_Designated 
+      (The_Word       : in     Message;
+       In_The_Message : in out Particularly_Designated_Msg) is
+ 
+    -- Not a real highlight procedure.  Real application can use graphic
+    -- device to highlight all occurrences of words.
+ 
+    begin
+       --------------------------------------------------------------
+       -- Parent's body uses function from instantiation of public --
+       -- generic child.                                           --
+       --------------------------------------------------------------
+ 
+       if Particularly_Designated_Pkg.Find_Word     -- Child's operation.   
+         (The_Word, In_The_Message) > 0 then
+ 
+           -- Highlight all occurrences in chartreuse.
+           -- Do other more secret stuff.
+ 
+           TC_Particularly_Designated_Not_Zero := true;       
+       end if;
+ 
+    end Highlight_Particularly_Designated;
+ 
+ end CA11018_0;
+ 
+      --=================================================================--
+ 
+ -- Public generic child to copy words to the messages.
+ 
+ generic
+    type Message_Type is new Message_Rec with private; 
+                         -- Derived from parent's type.
+ 
+ package CA11018_0.CA11018_2 is    
+ 
+    procedure Copy (From_The_Word  : in     Message;
+                    To_The_Message : in out Message_Type);
+ 
+ end CA11018_0.CA11018_2;
+ 
+      --=================================================================--
+ 
+ package body CA11018_0.CA11018_2 is    
+ 
+    procedure Copy (From_The_Word  : in     Message;
+                    To_The_Message : in out Message_Type) is
+ 
+    -- Copy words to the appropriate messages.
+ 
+    begin
+       To_The_Message.The_Content        -- Parent's private type.
+         (1 .. From_The_Word'length) := From_The_Word;
+ 
+       To_The_Message.The_Length         -- Parent's private type.
+                                     := From_The_Word'length;
+    end Copy;
+ 
+ end CA11018_0.CA11018_2;
+ 
+      --=================================================================--
+ 
+ with Report;
+ 
+ with CA11018_0.CA11018_2;   -- Public generic child package, copy words
+                             -- to the message.
+                             -- Implicit with parent package (CA11018_0).
+ 
+ procedure CA11018 is
+ 
+    package Message_Pkg renames CA11018_0;
+ 
+ begin
+ 
+    Report.Test ("CA11018", "Check that body of the parent package can " &
+                 "depend on one of its own public generic children");
+ 
+ -- Highlight the word "Alert" from the secret message.
+  
+        Designated_Subtest:
+        declare
+           The_Message : Message_Pkg.Designated_Msg;  -- Parent's private type.
+ 
+           -- Instantiate the public child to copy words to the secret message.
+ 
+           package Copy_Designated_Pkg is new CA11018_0.CA11018_2 
+             (Message_Pkg.Designated_Msg);
+ 
+        begin
+           Copy_Designated_Pkg.Copy ("Alert Level 1 : Alert The Guard", 
+                                 To_The_Message => The_Message);
+ 
+           Message_Pkg.Highlight_Designated ("Alert", The_Message);
+ 
+           if not Message_Pkg.TC_Designated_Not_Zero and 
+             Message_Pkg.TC_Designated_Success then
+                Report.Failed ("Alert should have been highlighted");
+           end if;
+ 
+        end Designated_Subtest;
+ 
+ -- Highlight the word "Push The Alarm" from the top secret message.
+ 
+        Particularly_Designated_Subtest:
+        declare
+           The_Message : Message_Pkg.Particularly_Designated_Msg ;  
+                                          -- Parent's private type.
+ 
+           -- Instantiate the public child to copy words to the top secret
+           -- message.
+ 
+           package Copy_Particularly_Designated_Pkg is new 
+             CA11018_0.CA11018_2 (Message_Pkg.Particularly_Designated_Msg);
+ 
+        begin
+           Copy_Particularly_Designated_Pkg.Copy 
+             ("Alert Level 10 : Alert The Guard and Push The Alarm", 
+              The_Message);
+ 
+           Message_Pkg.Highlight_Particularly_Designated 
+             ("Push The Alarm", The_Message);
+ 
+           if not Message_Pkg.TC_Particularly_Designated_Not_Zero and 
+             Message_Pkg.TC_Particularly_Designated_Success then
+                Report.Failed ("Key words should have been highlighted");
+           end if;
+ 
+        end Particularly_Designated_Subtest;
+ 
+    Report.Result;
+ 
+ end CA11018;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11019.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11019.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11019.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11019.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,306 ----
+ -- CA11019.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that body of the parent package may depend on one of its own
+ --      private generic children.
+ --
+ -- TEST DESCRIPTION:
+ --      A scenario is created that demonstrates the potential of adding a
+ --      generic private child during code maintenance without distubing a 
+ --      large subsystem.  After child is added to the subsystem, a maintainer
+ --      decides to take advantage of the new functionality and rewrites
+ --      the parent's body.
+ --
+ --      Declare a data collection abstraction in a package. Declare a private
+ --      generic child of this package which provides parameterized code that
+ --      have been written once and will be used three times to implement the
+ --      services of the parent package. In the parent body, instantiate the 
+ --      private child.  
+ --
+ --      In the main program, check that the operations in the parent, 
+ --      and instance of the private child package perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --
+ --!
+   
+ package CA11019_0 is   
+      -- parent
+ 
+    type Data_Record is tagged private;
+    type Data_Collection is private;
+    ---
+    ---
+    subtype Data_1 is integer range 0 .. 100;
+    procedure Add_1 (Data : Data_1; To : in out Data_Collection);  
+    function Statistical_Op_1 (Data : Data_Collection) return Data_1;
+    ---
+    subtype Data_2 is integer range -100 .. 1000;
+    procedure Add_2 (Data : Data_2; To : in out Data_Collection);
+    function Statistical_Op_2 (Data : Data_Collection) return Data_2;
+    ---
+    subtype Data_3 is integer range -10_000 .. 10_000;
+    procedure Add_3 (Data : Data_3; To : in out Data_Collection);  
+    function Statistical_Op_3 (Data : Data_Collection) return Data_3;
+    ---
+ 
+ private
+ 
+    type Data_Ptr is access Data_Record'class;
+    subtype Sequence_Number is positive range 1 .. 512;
+ 
+    type Data_Record is tagged 
+      record
+         Next  : Data_Ptr := null;
+         Seq   : Sequence_Number;
+      end record;
+    ---
+    type Data_Collection is 
+      record
+         First : Data_Ptr := null;
+         Last  : Data_Ptr := null;
+      end record;
+             
+ end CA11019_0;
+  -- parent
+ 
+     --=================================================================--
+ 
+ -- This generic package provides parameterized code that has been
+ -- written once and will be used three times to implement the services
+ -- of the parent package.
+ 
+ private
+ generic   
+    type Data_Type is range <>;
+ 
+ package CA11019_0.CA11019_1 is    
+      -- parent.child
+ 
+    type Data_Elem is new Data_Record with
+      record
+         Value : Data_Type;
+      end record;
+ 
+    Next_Avail_Seq_No : Sequence_Number := 1;
+ 
+    procedure Sequence (Ptr : Data_Ptr);
+     -- the child must be private for this procedure to know details of
+     -- the implementation of data collections
+ 
+    procedure Add (Datum : Data_Type; To : in out Data_Collection);
+ 
+    function  Op  (Data : Data_Collection) return Data_Type;
+     -- op models a complicated operation that whose code can be
+     -- used for various data types
+ 
+ 
+ end CA11019_0.CA11019_1;
+  -- parent.child
+ 
+      --=================================================================--
+ 
+  
+ package body CA11019_0.CA11019_1 is    
+           -- parent.child
+ 
+    procedure Sequence (Ptr : Data_Ptr) is
+    begin
+       Ptr.Seq := Next_Avail_Seq_No;
+       Next_Avail_Seq_No := Next_Avail_Seq_No + 1;
+    end Sequence;
+ 
+    ---------------------------------------------------------
+ 
+    procedure Add (Datum : Data_Type; To : in out Data_Collection) is
+       Ptr : Data_Ptr;
+    begin
+       if To.First = null then
+          -- assign new record with data value to 
+          -- to.next <- null;
+          To.First := new Data_Elem'(Next  => null,
+                                     Value => Datum,
+                                     Seq   => 1);
+          Sequence (To.First);
+          To.Last := To.First;
+       else
+          -- chase to end of list
+          Ptr := To.First;
+          while Ptr.Next /= null loop
+             Ptr := Ptr.Next;
+          end loop;
+          -- and add element there
+          Ptr.Next := new Data_Elem'(Next  => null,
+                                     Value => Datum,
+                                     Seq   => 1);
+          Sequence (Ptr.Next);
+          To.Last := Ptr.Next;
+       end if;
+ 
+    end Add;
+ 
+    ---------------------------------------------------------
+ 
+    function  Op  (Data : Data_Collection) return Data_Type is
+       -- for simplicity, just return the maximum of the data set
+       Max : Data_Type := Data_Elem( Data.First.all ).Value; 
+                               -- assuming non-empty collection
+       Ptr : Data_Ptr  := Data.First;
+ 
+    begin
+       -- no error checking
+       while Ptr.Next /= null loop
+          if Data_Elem( Ptr.Next.all ).Value > Max then
+             Max := Data_Elem( Ptr.Next.all ).Value;
+          end if;
+          Ptr := Ptr.Next;
+       end loop;
+       return Max;
+    end Op;
+ 
+ end CA11019_0.CA11019_1;
+  -- parent.child
+ 
+      --=================================================================--
+ 
+ -- parent body depends on private generic child
+ with CA11019_0.CA11019_1;     -- Private generic child.
+ 
+ pragma Elaborate (CA11019_0.CA11019_1);
+ package body CA11019_0 is
+ 
+    -- instantiate the generic child with data types needed by the 
+    -- package interface services
+    package Data_1_Ops is new CA11019_1
+      (Data_Type => Data_1);
+  
+    package Data_2_Ops is new CA11019_1
+      (Data_Type => Data_2);
+ 
+    package Data_3_Ops is new CA11019_1
+      (Data_Type => Data_3);
+ 
+    ---------------------------------------------------------
+ 
+    procedure Add_1 (Data : Data_1; To : in out Data_Collection) is
+    begin
+       -- maybe do other stuff here
+       Data_1_Ops.Add (Data, To);
+       -- and here
+    end;
+ 
+    ---------------------------------------------------------
+ 
+    function Statistical_Op_1 (Data : Data_Collection) return Data_1 is
+    begin
+       -- maybe use generic operation(s) in some complicated ways
+       -- (but simplified out, for the sake of testing)
+       return Data_1_Ops.Op (Data);
+    end;
+ 
+    ---------------------------------------------------------
+ 
+    procedure Add_2 (Data : Data_2; To : in out Data_Collection) is
+    begin
+       Data_2_Ops.Add (Data, To);
+    end;
+ 
+    ---------------------------------------------------------
+ 
+    function Statistical_Op_2 (Data : Data_Collection) return Data_2 is
+    begin
+       return Data_2_Ops.Op (Data);
+    end;
+ 
+    ---------------------------------------------------------
+ 
+    procedure Add_3 (Data : Data_3; To : in out Data_Collection) is
+    begin
+       Data_3_Ops.Add (Data, To);
+    end;
+ 
+    ---------------------------------------------------------
+ 
+    function Statistical_Op_3 (Data : Data_Collection) return Data_3 is
+    begin
+       return Data_3_Ops.Op (Data);
+    end;
+ 
+ end CA11019_0;
+ 
+ 
+      --=================================================--
+ 
+ with CA11019_0,
+   -- Main,    
+   -- Main.Child is private
+      Report;
+ 
+ procedure CA11019 is
+ 
+    package Main renames CA11019_0;
+ 
+    Col_1,
+    Col_2,
+    Col_3 : Main.Data_Collection;
+ 
+ begin
+ 
+    Report.Test ("CA11019", "Check that body of a (non-generic) package " &
+                 "may depend on its private generic child");
+ 
+    -- build a data collection
+ 
+    for I in 1 .. 10 loop
+       Main.Add_1 ( Main.Data_1(I), Col_1);
+    end loop;
+ 
+    if Main.Statistical_Op_1 (Col_1) /= 10 then 
+       Report.Failed ("Wrong data_1 value returned");
+    end if;
+ 
+    for I in reverse 10 .. 20 loop
+       Main.Add_2 ( Main.Data_2(I * 10), Col_2);
+    end loop;
+ 
+    if Main.Statistical_Op_2 (Col_2) /= 200 then 
+       Report.Failed ("Wrong data_2 value returned");
+    end if;
+ 
+    for I in 0 .. 10 loop
+       Main.Add_3 ( Main.Data_3(I + 5), Col_3);
+    end loop;
+ 
+    if Main.Statistical_Op_3 (Col_3) /= 15 then 
+       Report.Failed ("Wrong data_3 value returned");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11019;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11020.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11020.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11020.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,238 ----
+ -- CA11020.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that body of the generic parent package can depend on one of 
+ --      its own public generic children.
+ --
+ -- TEST DESCRIPTION:
+ --      A scenario is created that demonstrates the potential of adding a
+ --      public generic child during code maintenance without distubing a large 
+ --      subsystem.  After child is added to the subsystem, a maintainer
+ --      decides to take advantage of the new functionality and rewrites
+ --      the parent's body.
+ --
+ --      Declare a bag abstraction in a generic package. Declare a public 
+ --      generic child of this package which adds a generic procedure to the 
+ --      original subsystem.  In the parent body, instantiate the public
+ --      child.  Then instantiate the procedure as a child instance of the
+ --      public child instance.  
+ --
+ --      In the main program, declare an instance of parent.  Check that the 
+ --      operations in both parent and child packages perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Simulates bag application.
+ 
+ generic
+    type Element is private;
+    with function Image (E : Element) return String;
+ 
+ package CA11020_0 is
+ 
+    type Bag is limited private;
+ 
+    procedure Add (E : in Element; To_The_Bag : in out Bag);
+ 
+    function Bag_Image (B : Bag) return string;
+ 
+ private
+    type Node_Type;
+    type Bag is access Node_Type;
+ 
+    type Node_Type is
+       record
+          The_Element : Element;
+ 
+          -- Other components in real application, i.e.,
+          -- The_Count   : positive;
+ 
+          Next        : Bag;
+       end record;
+ 
+ end CA11020_0;
+ 
+      --==================================================================--
+ 
+ -- More operations on Bag.
+ 
+ generic
+ 
+ -- Parameters go here.
+ 
+ package CA11020_0.CA11020_1 is        
+ 
+    -- ... Other declarations.
+ 
+    generic                            -- Generic iterator procedure.
+       with procedure Use_Element (E : in Element);
+ 
+    procedure Iterate (B : in Bag);    -- Called once per element in the bag.
+ 
+    -- ... Various other operations.
+ 
+ end CA11020_0.CA11020_1;
+ 
+      --==================================================================--
+ 
+ package body CA11020_0.CA11020_1 is 
+ 
+    procedure Iterate (B : in Bag) is
+ 
+    -- Traverse each element in the bag.
+ 
+       Elem : Bag := B;
+ 
+    begin
+       while Elem /= null loop
+          Use_Element (Elem.The_Element);
+          Elem := Elem.Next;
+       end loop;
+ 
+    end Iterate;      
+ 
+ end CA11020_0.CA11020_1;
+ 
+      --==================================================================--
+ 
+ with CA11020_0.CA11020_1;    -- Public generic child package.
+ 
+ package body CA11020_0 is
+ 
+    ----------------------------------------------------
+    -- Parent's body depends on public generic child. --
+    ----------------------------------------------------
+ 
+    -- Instantiate the public child.
+ 
+    package MS is new CA11020_1;  
+ 
+    function Bag_Image (B : Bag) return string is
+ 
+       Buffer : String (1 .. 10_000);
+       Last   : Integer := 0;
+ 
+       -----------------------------------------------------
+ 
+       -- Will be called by the iterator.
+ 
+       procedure Append_Image (E : in Element) is  
+          Im : constant String := Image (E);
+ 
+       begin  -- Append_Image
+          if Last /= 0 then        -- Insert a comma.
+             Last := Last + 1;
+             Buffer (Last) := ',';
+          end if;
+ 
+          Buffer (Last + 1 .. Last + Im'Length) := Im;
+          Last := Last + Im'Length;
+ 
+       end Append_Image;
+ 
+       -----------------------------------------------------
+ 
+       -- Instantiate procedure Iterate as a child of instance MS.
+ 
+       procedure Append_All is new MS.Iterate (Use_Element => Append_Image);
+ 
+    begin  -- Bag_Image
+ 
+       Append_All (B);
+ 
+       return Buffer (1 .. Last);
+ 
+    end Bag_Image;
+ 
+            -----------------------------------------------------
+ 
+    procedure Add (E : in Element; To_The_Bag : in out Bag) is
+ 
+       -- Not a real bag addition.
+ 
+       Index : Bag := To_The_Bag;
+ 
+    begin
+       -- ... Error-checking code omitted for brevity.
+     
+       if Index = null then
+          To_The_Bag := new Node_Type' (The_Element => E,
+                                        Next        => null);
+       else
+          -- Goto the end of the list.
+ 
+          while Index.Next /= null loop
+             Index := Index.Next;
+          end loop;
+ 
+          -- Add element to the end of the list.
+ 
+          Index.Next := new Node_Type' (The_Element => E,
+                                        Next        => null);
+       end if;
+ 
+    end Add;
+ 
+ end CA11020_0;
+ 
+      --==================================================================--
+ 
+ with CA11020_0;               -- Bag application.
+ 
+ with Report;
+ 
+ procedure CA11020 is
+ 
+     -- Instantiate the bag application for integer type and attribute
+     -- Image.
+ 
+     package Bag_Of_Integers is new CA11020_0 (Integer, Integer'Image);
+ 
+     My_Bag : Bag_Of_Integers.Bag;
+ 
+ begin 
+ 
+    Report.Test ("CA11020", "Check that body of the generic parent package " &
+                 "can depend on one of its own public generic children");
+ 
+    -- Add 10 consecutive integers to the bag.
+ 
+    for I in 1 .. 10 loop
+       Bag_Of_Integers.Add (I, My_Bag);
+    end loop;
+ 
+    if Bag_Of_Integers.Bag_Image (My_Bag) 
+       /= " 1, 2, 3, 4, 5, 6, 7, 8, 9, 10" then
+          Report.Failed ("Incorrect results");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11020;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11021.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11021.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11021.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,245 ----
+ -- CA11021.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that body of the generic parent package can depend on one of 
+ --      its own private generic children.
+ --      
+ -- TEST DESCRIPTION:
+ --      A scenario is created that demonstrates the potential of adding a
+ --      public generic child during code maintenance without distubing a large 
+ --      subsystem.  After child is added to the subsystem, a maintainer
+ --      decides to take advantage of the new functionality and rewrites
+ --      the parent's body.
+ --
+ --      Declare a generic package which declares high level operations for a
+ --      complex number abstraction.  Declare a private generic child package 
+ --      of this package which defines low level complex operations. In the 
+ --      parent body, instantiate the private child.  Use the low level
+ --      operation to complete the high level operation.
+ --
+ --      In the main program, instantiate the parent generic package.
+ --      Check that the operations in both packages perform as expected.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ generic               -- Complex number abstraction.
+    type Int_Type is range <>;
+ 
+ package CA11021_0 is
+  
+    -- Simulate a generic complex number support package. Complex numbers
+    -- are treated as coordinates in the Cartesian plane.
+ 
+    type Complex_Type is private;
+ 
+    Zero : constant Complex_Type;                      -- Real number (0,0).
+ 
+    function Real_Part (Complex_No : Complex_Type)
+      return Int_Type;
+ 
+    function Imag_Part (Complex_No : Complex_Type)
+      return Int_Type;
+ 
+    function Complex (Real, Imag : Int_Type)           
+      return Complex_Type;                             
+ 
+    -- High level operation for complex number.
+    function "*" (Factor : Int_Type; 
+                  C      : Complex_Type) return Complex_Type;
+ 
+    -- ... and other complicated ones.
+ 
+ private
+    type Complex_Type is record
+       Real : Int_Type;
+       Imag : Int_Type;
+    end record;
+ 
+    Zero : constant Complex_Type := (Real => 0, Imag => 0);
+ 
+ end CA11021_0;
+ 
+      --==================================================================--
+ 
+ -- Private generic child of Complex_Number.  
+ 
+ private
+ 
+ generic               
+ 
+ -- No parameter.
+ 
+ package CA11021_0.CA11021_1 is
+  
+    -- ... Other declarations.
+ 
+    -- Low level operation on complex number. 
+    function "+" (Left, Right : Complex_Type)              
+      return Complex_Type;                     
+ 
+    function "-" (Right : Complex_Type)                
+      return Complex_Type;                             
+ 
+    -- ... Various other operations in real application.
+ 
+ end CA11021_0.CA11021_1;
+ 
+      --==================================================================--
+ 
+ package body CA11021_0.CA11021_1 is
+ 
+    function "+" (Left, Right : Complex_Type)              
+      return Complex_Type is
+ 
+    begin
+       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
+    end "+";
+ 
+                --------------------------------------------------
+ 
+    function "-" (Right : Complex_Type) return Complex_Type is
+    begin
+       return (-Right.Real, -Right.Imag);
+    end "-";
+ 
+ end CA11021_0.CA11021_1;
+ 
+      --==================================================================--
+ 
+ with CA11021_0.CA11021_1;    -- Private generic child package.
+ 
+ package body CA11021_0 is
+ 
+    -----------------------------------------------------
+    -- Parent's body depends on private generic child. --
+    -----------------------------------------------------
+ 
+    -- Instantiate the private child.
+ 
+    package Complex_Ops is new CA11021_1;  
+    use Complex_Ops;                    -- All user-defined operators 
+                                        -- directly visible.        
+ 
+                --------------------------------------------------
+ 
+    function "*" (Factor : Int_Type; 
+                  C      : Complex_Type) return Complex_Type is
+       Result : Complex_Type := Zero;   
+ 
+    begin
+       for I in 1 .. abs (Factor) loop
+          Result := Result + C;         -- Private generic child "+".
+       end loop;
+ 
+       if Factor < 0 then
+          Result := - Result;           -- Private generic child "-".
+       end if;
+ 
+       return Result;
+    end "*";
+ 
+                --------------------------------------------------
+ 
+    function Real_Part (Complex_No : Complex_Type) return Int_Type is
+    begin
+       return (Complex_No.Real);
+    end Real_Part;
+ 
+                --------------------------------------------------
+ 
+    function Imag_Part (Complex_No : Complex_Type) return Int_Type is
+    begin
+       return (Complex_No.Imag);
+    end Imag_Part;
+ 
+                --------------------------------------------------
+ 
+    function Complex (Real, Imag : Int_Type) return Complex_Type is
+    begin
+       return (Real, Imag);
+    end Complex;
+ 
+ end CA11021_0;
+ 
+      --==================================================================--
+ 
+ with CA11021_0;                        -- Complex number abstraction.
+ 
+ with Report;
+ 
+ procedure CA11021 is
+ 
+    type My_Integer is range -100 .. 100;
+ 
+                --------------------------------------------------
+ 
+ -- Declare instance of the generic complex package for one particular 
+ -- integer type.  
+ 
+    package My_Complex_Pkg is new 
+      CA11021_0 (Int_Type => My_Integer);
+ 
+    use My_Complex_Pkg;                 -- All user-defined operators 
+                                        -- directly visible.
+ 
+                --------------------------------------------------
+ 
+    Complex_One, Complex_Two : Complex_Type;
+ 
+    My_Literal               : My_Integer := -3;
+ 
+ begin
+ 
+    Report.Test ("CA11021", "Check that body of the generic parent package " &
+                 "can depend on its private generic child");
+ 
+    Complex_One := Complex (11, 6);          
+ 
+    Complex_Two := 5 * Complex_One; 
+ 
+    if Real_Part (Complex_Two) /= 55         
+      and Imag_Part (Complex_Two) /= 30     
+         then
+            Report.Failed ("Incorrect results from complex operation");
+    end if;
+ 
+    Complex_One := Complex (-4, 7);          
+ 
+    Complex_Two := My_Literal * Complex_One; 
+ 
+    if Real_Part (Complex_Two) /= 12         
+      and Imag_Part (Complex_Two) /= -21     
+         then
+            Report.Failed ("Incorrect results from complex operation");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11021;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11022.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11022.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11022.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11022.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,242 ----
+ -- CA11022.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that body of a child unit can instantiate its generic sibling.
+ --      
+ -- TEST DESCRIPTION:
+ --      Declare a package that provides some types for the graphic 
+ --      application.  Add a generic child package with a subprogram parameter
+ --      to provide algorithms that can be used by different terminal types
+ --      but that have to be customized to the specific terminal. Add child 
+ --      packages to take advantage of the parent types and to provide a 
+ --      customized operation for each of the different terminals.  The 
+ --      customized operation will be passed as a generic subprogram parameter 
+ --      to the child package's sibling.
+ --
+ --      The main program "with"s the child packages.  Check that the
+ --      operations in child units perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CA11022_0 is    -- Graphic Manager
+  
+    type Row is range 1 .. 66;
+    type Column is range 1 .. 80;
+    type Radius is range 1 .. 3;
+    type Length is range 5 .. 10;
+ 
+    -- Testing artifice.
+    TC_Screen : array (Row, Column) of boolean := (others => (others => false));
+    TC_Draw_Circle : boolean := false;
+    TC_Draw_Square : boolean := false;
+ 
+    -- ... and other complicated ones.
+ 
+ end CA11022_0;
+ 
+ -- No bodies required for CA11022_0.
+ 
+      --==================================================================--
+ 
+ -- Child package to provide general graphic functionalities.
+ 
+ generic               
+ 
+    with procedure Put_Dot (X : in Column;
+                            Y : in Row);
+ 
+ package CA11022_0.CA11022_1 is     
+ 
+    procedure Draw_Square (At_Col : in Column;
+                           At_Row : in Row;
+                           Len    : in Length);
+ 
+    procedure Draw_Circle (At_Col : in Column;
+                           At_Row : in Row;
+                           Rad    : in Radius);
+ 
+    -- procedure Draw_Ellipse ...
+    -- and other drawings ...
+ 
+ end CA11022_0.CA11022_1;
+ 
+      --==================================================================--
+ 
+ package body CA11022_0.CA11022_1 is
+ 
+    procedure Draw_Square (At_Col : in Column;
+                           At_Row : in Row;
+                           Len    : in Length) is
+    begin
+       -- use square drawing algorithm 
+       -- call
+       Put_Dot (At_Col + Column (Len), At_Row + Row(Len));
+       -- as needed in the algorithm.
+       TC_Draw_Square := true;
+    end Draw_Square;
+ 
+    -------------------------------------------------------
+    procedure Draw_Circle (At_Col : in Column;
+                           At_Row : in Row;
+                           Rad    : in Radius) is
+    begin
+       -- use circle drawing algorithm 
+       -- call
+       for I in 1 .. Rad loop
+          Put_Dot (At_Col + Column(I), At_Row + Row(I));
+       end loop;
+       -- as needed in the algorithm.
+       TC_Draw_Circle := true;
+    end Draw_Circle;
+ 
+ end CA11022_0.CA11022_1;
+ 
+      --==================================================================--
+ 
+ with CA11022_0.CA11022_1;                -- Generic sibling.
+ 
+ -- Child package to provide customized graphic functions for the
+ -- VT100.
+ package CA11022_0.CA11022_2 is           -- VT100 Graphic.
+ 
+    X : Column := 8;
+    Y : Row    := 3;
+    R : Radius := 2;
+    L : Length := 6;
+ 
+    procedure VT100_Graphic;
+ 
+ end CA11022_0.CA11022_2;
+ 
+      --==================================================================--
+ 
+ package body CA11022_0.CA11022_2 is    
+ 
+    procedure VT100_Graphic is
+       procedure VT100_Putdot (X : in Column;
+                               Y : in Row) is
+       begin   
+          -- Light a pixel at location (X, Y);
+          TC_Screen (Y, X) := true;
+       end VT100_Putdot;
+ 
+                   ------------------------------------
+ 
+       -- Declare instance of the generic sibling package to draw a circle, 
+       -- a square, or an ellipse customized for the VT100.
+       package VT100_Graphic is new CA11022_0.CA11022_1 (VT100_Putdot);
+    
+    begin  
+       VT100_Graphic.Draw_Circle (X, Y, R);
+       VT100_Graphic.Draw_Square (X, Y, L);
+    end VT100_Graphic;
+ 
+ end CA11022_0.CA11022_2;
+ 
+      --==================================================================--
+ 
+ with CA11022_0.CA11022_1;                -- Generic sibling.
+ 
+ -- Child package to provide customized graphic functions for the
+ -- IBM3270.
+ package CA11022_0.CA11022_3 is           -- IBM3270 Graphic.
+ 
+    X : Column := 39;
+    Y : Row    := 11;
+    R : Radius := 3;
+    L : Length := 7;
+ 
+    procedure IBM3270_Graphic;
+ 
+ end CA11022_0.CA11022_3;
+ 
+      --==================================================================--
+ 
+ package body CA11022_0.CA11022_3 is    
+ 
+    procedure IBM3270_Graphic is
+       procedure IBM3270_Putdot (X : in Column;
+                              Y : in Row) is
+       begin   
+          -- Light a pixel at location (X + 2, Y);
+          TC_Screen (Y, X + Column(2)) := true;
+       end IBM3270_Putdot;
+ 
+                   ------------------------------------
+ 
+       -- Declare instance of the generic sibling package to draw a circle, 
+       -- a square, or an ellipse customized for the IBM3270.
+       package IBM3270_Graphic is new CA11022_0.CA11022_1 (IBM3270_Putdot);
+    
+    begin  
+       IBM3270_Graphic.Draw_Circle (X, Y, R);
+       IBM3270_Graphic.Draw_Square (X, Y, L);
+    end IBM3270_Graphic;
+ 
+ end CA11022_0.CA11022_3;
+ 
+      --==================================================================--
+ 
+ with CA11022_0.CA11022_2;              -- VT100 Graphic, implicitly with
+                                        -- CA11022_0, Graphic Manager.
+ with CA11022_0.CA11022_3;              -- IBM3270 Graphic.
+ with Report;
+ 
+ procedure CA11022 is
+ 
+ begin
+ 
+    Report.Test ("CA11022", "Check that body of a child unit can depend on " &
+                 "its generic sibling");
+ 
+    -- Customized graphic functions for the VT100 terminal.
+    CA11022_0.CA11022_2.VT100_Graphic;
+ 
+    if not CA11022_0.TC_Screen (4,9) and not CA11022_0.TC_Screen (5,10) 
+      and not CA11022_0.TC_Screen (9,14) and not CA11022_0.TC_Draw_Circle 
+        and not CA11022_0.TC_Draw_Square then
+           Report.Failed ("Wrong results for the VT100");
+    end if;
+ 
+    CA11022_0.TC_Draw_Circle := false;
+    CA11022_0.TC_Draw_Square := false;
+ 
+    -- Customized graphic functions for the IBM3270 terminal.
+    CA11022_0.CA11022_3.IBM3270_Graphic;
+ 
+    if not CA11022_0.TC_Screen (12,42) and not CA11022_0.TC_Screen (13,43) 
+      and not CA11022_0.TC_Screen (14,44) and not CA11022_0.TC_Screen (46,18) 
+        and not CA11022_0.TC_Draw_Circle and not CA11022_0.TC_Draw_Square then
+           Report.Failed ("Wrong results for the IBM3270");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11022;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1102a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1102a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1102a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1102a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,31 ----
+ -- CA1102A0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/12/81
+ 
+ PACKAGE CA1102A0 IS          -- BODY IS IN CA1102A1.
+ 
+      PROCEDURE P (INVOKED : IN OUT BOOLEAN);
+ 
+ END CA1102A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1102a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1102a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1102a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1102a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- CA1102A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/12/81
+ 
+ PACKAGE BODY CA1102A0 IS
+ 
+      PROCEDURE P (INVOKED : IN OUT BOOLEAN) IS
+      BEGIN
+           INVOKED := TRUE;
+      END P;
+ 
+ BEGIN
+      NULL;
+ END CA1102A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1102a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1102a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1102a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1102a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,58 ----
+ -- CA1102A2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT MORE THAN ONE WITH_CLAUSE CAN APPEAR IN
+ --   A CONTEXT_SPECIFICATION.
+ -- CHECK THAT USE_CLAUSES CAN MENTION NAMES MADE
+ --   VISIBLE BY PRECEDING WITH_CLAUSES IN THE SAME
+ --   CONTEXT_SPECIFICATION.
+ -- CHECK THAT CONSECUTIVE USE_CLAUSES ARE ALLOWED.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA1102A0  A LIBRARY PACKAGE DECLARATION.
+ --   CA1102A1  A LIBRARY PACKAGE BODY (CA1102A0).
+ --   CA1102A2M THE MAIN PROCEDURE.
+ 
+ -- WKB 6/12/81
+ -- BHS 7/19/84
+ 
+ WITH CA1102A0;
+ WITH REPORT; USE CA1102A0; USE REPORT;
+ PROCEDURE CA1102A2M IS
+ 
+ 
+      INVOKED : BOOLEAN := FALSE;
+ 
+ BEGIN
+      TEST ("CA1102A", "MORE THAN ONE WITH_CLAUSE; ALSO, A " &
+            "USE_CLAUSE REFERING TO A PRECEDING WITH_CLAUSE " &
+            "IN THE SAME CONTEXT_SPECIFICATION");
+ 
+      P (INVOKED);
+      IF NOT INVOKED THEN
+           FAILED ("COMPILATION UNIT NOT MADE VISIBLE");
+      END IF;
+ 
+      RESULT;
+ END CA1102A2M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1106a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1106a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1106a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1106a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,112 ----
+ -- CA1106A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A WITH CLAUSE FOR A PACKAGE BODY (GENERIC OR
+ --     NONGENERIC) OR FOR A GENERIC SUBPROGRAM BODY CAN NAME THE
+ --     CORRESPONDING SPECIFICATION, AND A USE CLAUSE CAN ALSO BE
+ --     GIVEN.
+ 
+ -- HISTORY:
+ --     JET 07/14/88  CREATED ORIGINAL TEST.
+ --     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ 
+ PACKAGE CA1106A_1 IS
+      I : INTEGER := 0;
+      PROCEDURE REQUIRE_BODY;
+ END CA1106A_1;
+ 
+ GENERIC
+      TYPE TG IS RANGE <>;
+ PACKAGE CA1106A_2 IS
+      J : TG := 0;
+      PROCEDURE REQUIRE_BODY;
+ END CA1106A_2;
+ 
+ GENERIC
+      TYPE TG IS RANGE <>;
+ FUNCTION CA1106A_3 RETURN TG;
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA1106A_1; USE CA1106A_1;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY CA1106A_1 IS
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ BEGIN
+      I := IDENT_INT(1);
+ END CA1106A_1;
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA1106A_2;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY CA1106A_2 IS
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ BEGIN
+      J := TG(IDENT_INT(2));
+ END CA1106A_2;
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA1106A_3;
+ FUNCTION CA1106A_3 RETURN TG IS
+ BEGIN
+      RETURN TG(IDENT_INT(3));
+ END CA1106A_3;
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA1106A_1, CA1106A_2, CA1106A_3;
+ USE CA1106A_1;
+ PROCEDURE CA1106A IS
+ 
+      PACKAGE CA1106A_2X IS NEW CA1106A_2 (INTEGER);
+      FUNCTION CA1106A_3X IS NEW CA1106A_3 (INTEGER);
+ 
+      USE CA1106A_2X;
+ 
+ BEGIN
+      TEST ("CA1106A", "CHECK THAT A WITH CLAUSE FOR A PACKAGE BODY " &
+                       "(GENERIC OR NONGENERIC) OR FOR A GENERIC " &
+                       "SUBPROGRAM BODY CAN NAME THE CORRESPONDING " &
+                       "SPECIFICATION, AND A USE CLAUSE CAN ALSO BE " &
+                       "GIVEN");
+ 
+      IF I /= 1 THEN
+           FAILED ("INCORRECT VALUE FROM NONGENERIC PACKAGE");
+      END IF;
+ 
+      IF J /= 2 THEN
+           FAILED ("INCORRECT VALUE FROM GENERIC PACKAGE");
+      END IF;
+ 
+      IF CA1106A_3X /= 3 THEN
+           FAILED ("INCORRECT VALUE FROM GENERIC SUBPROGRAM");
+      END IF;
+ 
+      RESULT;
+ END CA1106A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1108a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1108a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1108a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1108a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,136 ----
+ -- CA1108A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A WITH_CLAUSE AND USE_CLAUSE GIVEN FOR A PACKAGE
+ -- SPECIFICATION APPLIES TO THE BODY AND SUBUNITS OF THE BODY.
+ 
+ -- BHS 7/27/84
+ -- JBG 5/1/85
+ 
+ PACKAGE OTHER_PKG IS
+ 
+      I : INTEGER := 4;
+      FUNCTION F (X : INTEGER) RETURN INTEGER;
+ 
+ END OTHER_PKG;
+ 
+ PACKAGE BODY OTHER_PKG IS
+ 
+      FUNCTION F (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN X + 1;
+      END F;
+ 
+ END OTHER_PKG;
+ 
+ WITH REPORT, OTHER_PKG;
+ USE REPORT, OTHER_PKG;
+ PRAGMA ELABORATE (OTHER_PKG);
+ PACKAGE CA1108A_PKG IS
+ 
+      J : INTEGER := 2;
+      PROCEDURE PROC;
+      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
+ 
+ END CA1108A_PKG;
+ 
+ PACKAGE BODY CA1108A_PKG IS
+      
+      PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
+ 
+      PROCEDURE PROC IS
+           Y : INTEGER := 2;
+      BEGIN
+           Y := OTHER_PKG.I;
+           IF Y /= 4 THEN
+                FAILED ("OTHER_PKG VARIABLE NOT VISIBLE " &
+                        "IN PACKAGE BODY PROCEDURE");
+           END IF;
+      END PROC;
+ 
+      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
+      BEGIN
+           SUB (X, Y);
+      END CALL_SUBS;
+ 
+ BEGIN  
+ 
+      J := F(J);            -- J => J + 1.
+      IF J /= 3 THEN
+           FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN " &
+                   "PACKAGE BODY");
+      END IF;
+ 
+ END CA1108A_PKG;
+ 
+ 
+ WITH REPORT, CA1108A_PKG;
+ USE REPORT, CA1108A_PKG;
+ PROCEDURE CA1108A IS
+ 
+      VAR1, VAR2 : INTEGER;
+ 
+ BEGIN  
+ 
+      TEST ("CA1108A", "WITH_ AND USE_CLAUSES GIVEN FOR A PACKAGE " &
+                       "SPEC APPLY TO THE BODY AND ITS SUBUNITS");
+ 
+      PROC;
+ 
+      VAR1 := 1;
+      VAR2 := 1;
+      CALL_SUBS (VAR1, VAR2);
+      IF VAR1 /= 4 THEN
+           FAILED ("OTHER_PKG VARIABLE NOT VISIBLE IN SUBUNIT");
+      END IF;
+ 
+      IF VAR2 /= 6 THEN
+           FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
+                   "OF SUBUNIT");
+      END IF;
+ 
+      RESULT;
+ 
+ END CA1108A;
+ 
+ 
+ SEPARATE (CA1108A_PKG)
+ PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
+      PROCEDURE SUB2 (Z : IN OUT INTEGER) IS SEPARATE;
+ BEGIN
+ 
+      X := I;
+      SUB2 (Y);
+ 
+ END SUB;
+ 
+ 
+ SEPARATE (CA1108A_PKG.SUB)
+ PROCEDURE SUB2 (Z : IN OUT INTEGER) IS
+      I : INTEGER := 5;
+ BEGIN
+ 
+      Z := OTHER_PKG.F(I);    -- Z => I + 1.
+ 
+ END SUB2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1108b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1108b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca1108b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca1108b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,168 ----
+ -- CA1108B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF WITH_CLAUSES ARE GIVEN FOR BOTH A SPEC AND A BODY, AND
+ -- THE CLAUSES NAME DIFFERENT LIBRARY UNITS, THE UNITS NAMED IN ALL THE
+ -- CLAUSES ARE VISIBLE IN THE BODY AND IN SUBUNITS OF THE BODY.
+ 
+ -- BHS 7/31/84
+ -- JBG 5/1/85
+ 
+ PACKAGE FIRST_PKG IS
+ 
+      FUNCTION F (X : INTEGER := 1) RETURN INTEGER;
+ 
+ END FIRST_PKG;
+ 
+ PACKAGE BODY FIRST_PKG IS
+ 
+      FUNCTION F (X : INTEGER := 1) RETURN INTEGER IS
+      BEGIN
+           RETURN X;
+      END F;
+ 
+ END FIRST_PKG;
+ 
+ PACKAGE LATER_PKG IS
+ 
+      FUNCTION F (Y : INTEGER := 2) RETURN INTEGER;
+ 
+ END LATER_PKG;
+ 
+ PACKAGE BODY LATER_PKG IS
+ 
+      FUNCTION F (Y : INTEGER := 2) RETURN INTEGER IS
+      BEGIN
+           RETURN Y + 1;
+      END F;
+ 
+ END LATER_PKG;
+ 
+ WITH REPORT, FIRST_PKG;
+ USE REPORT;
+ PRAGMA ELABORATE (FIRST_PKG);
+ PACKAGE CA1108B_PKG IS
+ 
+      I, J : INTEGER;
+      PROCEDURE PROC;
+      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
+ 
+ END CA1108B_PKG;
+ 
+ WITH LATER_PKG;
+ PRAGMA ELABORATE (LATER_PKG);
+ PACKAGE BODY CA1108B_PKG IS
+ 
+      PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
+ 
+      PROCEDURE PROC IS
+           I, J : INTEGER;
+      BEGIN
+           I := FIRST_PKG.F;
+           IF I /= 1 THEN
+                FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN " &
+                        "PACKAGE BODY PROCEDURE");
+           END IF;
+           J := LATER_PKG.F;
+           IF J /= 3 THEN
+                FAILED ("LATER_PKG FUNCITON NOT VISIBLE IN " &
+                        "PACKAGE BODY PROCEDURE");
+           END IF;
+      END PROC;
+ 
+      PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
+      BEGIN
+           SUB (X, Y);
+      END CALL_SUBS;
+ 
+ BEGIN
+ 
+      I := FIRST_PKG.F;
+      IF I /= 1 THEN
+           FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
+      END IF;
+      J := LATER_PKG.F;
+      IF J /= 3 THEN
+           FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
+      END IF;
+ 
+ END CA1108B_PKG;
+ 
+ WITH REPORT, CA1108B_PKG;
+ USE REPORT, CA1108B_PKG;
+ PROCEDURE CA1108B IS
+ 
+      VAR1, VAR2 : INTEGER;
+ 
+ BEGIN
+ 
+      TEST ("CA1108B", "IF DIFFERENT WITH_CLAUSES GIVEN FOR PACKAGE " &
+                       "SPEC AND BODY, ALL NAMED UNITS ARE VISIBLE " &
+                       "IN THE BODY AND ITS SUBUNITS");
+ 
+      PROC;
+ 
+      VAR1 := 0;
+      VAR2 := 1;
+      CALL_SUBS (VAR1, VAR2);
+      IF VAR1 /= 1 THEN
+           FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
+      END IF;
+ 
+      IF VAR2 /= 3 THEN
+           FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
+      END IF;
+ 
+      RESULT;
+ 
+ END CA1108B;
+ 
+ 
+ SEPARATE (CA1108B_PKG)
+ PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
+      PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS SEPARATE;
+ BEGIN
+ 
+      SUB2 (Y, X);
+      IF Y /= 1 THEN
+           FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
+                   "OF SUBUNIT");
+      END IF;
+      IF X /= 3 THEN
+           FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
+                   "OF SUBUNIT");
+      END IF;
+      X := FIRST_PKG.F;
+      Y := LATER_PKG.F;
+ 
+ END SUB;
+ 
+ SEPARATE (CA1108B_PKG.SUB)
+ PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS
+ BEGIN
+ 
+      A := FIRST_PKG.F;
+      B := LATER_PKG.F;
+ 
+ END SUB2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,228 ----
+ -- CA11A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that type extended in a public child inherits primitive 
+ --      operations from its ancestor.  
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type in a package specification. Declare two 
+ --      primitive subprograms for the type (foundation code).
+ --
+ --      Add a public child to the above package.  Extend the root type with 
+ --      a record extension in the specification.  Declare a new primitive 
+ --      subprogram to write to the child extension.
+ --
+ --      Add a public grandchild to the above package.  Extend the extension of
+ --      the parent type with a record extension in the private part of the 
+ --      specification.  Declare a new primitive subprogram for this grandchild
+ --      extension.
+ --
+ --      In the main program, "with" the grandchild.  Access the primitive
+ --      operations from grandparent and parent package.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11A00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package FA11A00.CA11A01_0 is     -- Color_Widget_Pkg
+ -- This public child declares an extension from its parent.  It 
+ -- represents processing of widgets in a window system.  
+ 
+    type Widget_Color_Enum is (Black, Green, White);
+ 
+    type Color_Widget is new Widget with           -- Record extension of
+       record                                      -- parent tagged type.
+          Color : Widget_Color_Enum;
+       end record;
+ 
+    -- Inherits procedure Set_Width from Widget.
+    -- Inherits procedure Set_Height from Widget.
+ 
+    -- To be inherited by its derivatives.
+    procedure Set_Color (The_Widget : in out Color_Widget; 
+                         C          : in     Widget_Color_Enum);
+ 
+    procedure Set_Color_Widget (The_Widget : in out Color_Widget; 
+                                The_Width  : in     Widget_Length;
+                                The_Height : in     Widget_Length; 
+                                The_Color  : in     Widget_Color_Enum);
+ 
+ end FA11A00.CA11A01_0;     -- Color_Widget_Pkg
+ 
+ --=======================================================================--
+ 
+ package body FA11A00.CA11A01_0 is     -- Color_Widget_Pkg
+ 
+    procedure Set_Color (The_Widget : in out Color_Widget; 
+                         C          : in     Widget_Color_Enum) is
+    begin
+       The_Widget.Color := C;
+    end Set_Color;
+    ---------------------------------------------------------------
+    procedure Set_Color_Widget (The_Widget : in out Color_Widget; 
+                                The_Width  : in     Widget_Length;
+                                The_Height : in     Widget_Length; 
+                                The_Color  : in     Widget_Color_Enum) is
+    begin
+       Set_Width  (The_Widget, The_Width);   -- Inherited from parent.
+       Set_Height (The_Widget, The_Height);  -- Inherited from parent.
+       Set_Color  (The_Widget, The_Color);
+    end Set_Color_Widget;
+ 
+ end FA11A00.CA11A01_0;     -- Color_Widget_Pkg
+ 
+ --=======================================================================--
+ 
+ package FA11A00.CA11A01_0.CA11A01_1 is     -- Label_Widget_Pkg
+ -- This public grandchild extends the extension from its parent.  It 
+ -- represents processing of widgets in a window system.  
+ 
+    -- Declaration used by private extension component.
+    subtype Widget_Label_Str is string (1 .. 10);
+ 
+    type Label_Widget is new Color_Widget with private;  
+                             -- Record extension of parent tagged type.
+ 
+    -- Inherits (inherited) procedure Set_Width from Color_Widget.
+    -- Inherits (inherited) procedure Set_Height from Color_Widget.
+    -- Inherits procedure Set_Color from Color_Widget.
+    -- Inherits procedure Set_Color_Widget from Color_Widget.
+ 
+    procedure Set_Label_Widget (The_Widget : in out Label_Widget;
+                                The_Width  : in     Widget_Length;
+                                The_Height : in     Widget_Length; 
+                                The_Color  : in     Widget_Color_Enum;
+                                The_Label  : in     Widget_Label_Str);
+ 
+    -- The following function is needed to verify the value of the
+    -- extension's private component.
+ 
+    function Verify_Label (The_Widget : in Label_Widget;
+                           The_Label  : in Widget_Label_Str) return Boolean;
+ 
+ private
+    type Label_Widget is new Color_Widget with
+       record
+          Label : Widget_Label_Str;
+       end record;
+ 
+ end FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg
+ 
+ --=======================================================================--
+ 
+ package body FA11A00.CA11A01_0.CA11A01_1 is     -- Label_Widget_Pkg
+ 
+    procedure Set_Label (The_Widget : in out Label_Widget; 
+                         L          : in     Widget_Label_Str) is
+    begin
+       The_Widget.Label := L;
+    end Set_Label;
+    --------------------------------------------------------------
+    procedure Set_Label_Widget (The_Widget : in out Label_Widget;
+                                The_Width  : in     Widget_Length;
+                                The_Height : in     Widget_Length; 
+                                The_Color  : in     Widget_Color_Enum;
+                                The_Label  : in     Widget_Label_Str) is
+    begin
+       Set_Width  (The_Widget, The_Width);   -- Twice inherited.
+       Set_Height (The_Widget, The_Height);  -- Twice inherited.
+       Set_Color  (The_Widget, The_Color);   -- Inherited from parent.
+       Set_Label  (The_Widget, The_Label); 
+    end Set_Label_Widget;
+    --------------------------------------------------------------
+    function Verify_Label (The_Widget : in Label_Widget; 
+                           The_Label  : in Widget_Label_Str) return Boolean is
+    begin
+       return (The_Widget.Label = The_Label);
+    end Verify_Label;
+ 
+ end FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg
+ 
+ --=======================================================================--
+ 
+ with FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg, 
+                                       -- implicitly with Widget_Pkg,
+                                       -- implicitly with Color_Widget_Pkg
+ with Report;
+ 
+ procedure CA11A01 is
+ 
+    package Widget_Pkg renames FA11A00;
+    package Color_Widget_Pkg renames FA11A00.CA11A01_0;
+    package Label_Widget_Pkg renames FA11A00.CA11A01_0.CA11A01_1;
+ 
+    use Widget_Pkg;              -- All user-defined operators directly visible.
+ 
+    Mail_Label     : Label_Widget_Pkg.Widget_Label_Str := "Quick_Mail";
+ 
+    Default_Widget : Widget;
+    Black_Widget   : Color_Widget_Pkg.Color_Widget;
+    Mail_Widget    : Label_Widget_Pkg.Label_Widget;
+ 
+ begin
+ 
+    Report.Test ("CA11A01", "Check that type extended in a public " &
+                 "child inherits primitive operations from its " &
+                 "ancestor");                                     
+ 
+    Set_Width (Default_Widget, 9);             -- Call from parent.
+    Set_Height (Default_Widget, 10);           -- Call from parent.
+ 
+    If Default_Widget.Width /= Widget_Length (Report.Ident_Int (9)) or 
+      Default_Widget.Height /= Widget_Length (Report.Ident_Int (10)) then
+         Report.Failed ("Incorrect result for Default_Widget");
+    end if;
+ 
+    Color_Widget_Pkg.Set_Color_Widget 
+      (Black_Widget, 17, 18, Color_Widget_Pkg.Black);   -- Explicitly declared.
+ 
+    If Black_Widget.Width /= Widget_Length (Report.Ident_Int (17)) or 
+      Black_Widget.Height /= Widget_Length (Report.Ident_Int (18)) or 
+        Color_Widget_Pkg."/=" (Black_Widget.Color, Color_Widget_Pkg.Black) then
+           Report.Failed ("Incorrect result for Black_Widget");
+    end if;
+ 
+    Label_Widget_Pkg.Set_Label_Widget 
+      (Mail_Widget, 15, 21, Color_Widget_Pkg.White, 
+        "Quick_Mail");                                  -- Explicitly declared.
+ 
+    If Mail_Widget.Width /= Widget_Length (Report.Ident_Int (15)) or 
+      Mail_Widget.Height /= Widget_Length (Report.Ident_Int (21)) or 
+        Color_Widget_Pkg."/=" (Mail_Widget.Color, Color_Widget_Pkg.White) or 
+          not Label_Widget_Pkg.Verify_Label (Mail_Widget, Mail_Label) then
+             Report.Failed ("Incorrect result for Mail_Widget");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,156 ----
+ -- CA11A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a type extended in a client of a public child inherits 
+ --      primitive operations from parent.  
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type in a package specification. Declare two 
+ --      primitive subprograms for the type (foundation code).
+ --
+ --      Add a public child to the above package.  Extend the root type with 
+ --      a record extension in the specification.  Declare a new primitive 
+ --      subprogram to write to the child extension.
+ --
+ --      In the main program, "with" the child.  Declare an extension of
+ --      the child extension.  Access the primitive operations from both 
+ --      parent and child packages.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11A00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      20 Dec 94   SAIC    Moved declaration of Label_Widget to library level
+ --
+ --!
+ 
+ package FA11A00.CA11A02_0 is     -- Color_Widget_Pkg
+ -- This public child declares an extension from its parent.  It 
+ -- represents processing of widgets in a window system.  
+ 
+    type Widget_Color_Enum is (Black, Green, White);
+ 
+    type Color_Widget is new Widget with           -- Record extension of
+       record                                      -- parent tagged type.
+          Color : Widget_Color_Enum;
+       end record;
+ 
+    -- Inherits procedure Set_Width from parent.
+    -- Inherits procedure Set_Height from parent.
+ 
+    -- To be inherited by its derivatives.
+    procedure Set_Color (The_Widget : in out Color_Widget; 
+                         C          : in     Widget_Color_Enum);
+ 
+ end FA11A00.CA11A02_0;     -- Color_Widget_Pkg
+ 
+ --=======================================================================--
+ 
+ package body FA11A00.CA11A02_0 is     -- Color_Widget_Pkg
+ 
+    procedure Set_Color (The_Widget : in out Color_Widget; 
+                         C          : in     Widget_Color_Enum) is
+    begin
+       The_Widget.Color := C;
+    end Set_Color;
+ 
+ end FA11A00.CA11A02_0;     -- Color_Widget_Pkg
+ 
+ --=======================================================================--
+ 
+ with FA11A00.CA11A02_0;               -- Color_Widget_Pkg.
+ 
+ package CA11A02_1 is
+ 
+    type Label_Widget (Str_Disc : Integer) is new 
+      FA11A00.CA11A02_0.Color_Widget with
+        record
+          Label : String (1 .. Str_Disc);
+        end record;
+ 
+    -- Inherits (inherited) procedure Set_Width from Color_Widget.
+    -- Inherits (inherited) procedure Set_Height from Color_Widget.
+    -- Inherits procedure Set_Color from Color_Widget.
+ 
+ end CA11A02_1;
+ 
+ --=======================================================================--
+ 
+ with FA11A00.CA11A02_0;               -- Color_Widget_Pkg, 
+                                       -- implicitly with Widget_Pkg
+ with CA11A02_1;
+ 
+ with Report;
+ 
+ procedure CA11A02 is
+ 
+    package Widget_Pkg renames FA11A00;
+    package Color_Widget_Pkg renames FA11A00.CA11A02_0;
+ 
+    use Widget_Pkg;              -- All user-defined operators directly visible.
+ 
+    procedure Set_Label (The_Widget : in out CA11A02_1.Label_Widget; 
+                         L          : in     String) is
+    begin
+       The_Widget.Label := L;
+    end Set_Label;
+    ---------------------------------------------------------
+    procedure Set_Widget (The_Widget : in out CA11A02_1.Label_Widget;
+                          The_Width  : in     Widget_Length;
+                          The_Height : in     Widget_Length; 
+                          The_Color  : in     
+                                           Color_Widget_Pkg.Widget_Color_Enum;
+                          The_Label  : in     String) is
+    begin
+       CA11A02_1.Set_Width  (The_Widget, The_Width);    -- Twice inherited.
+       CA11A02_1.Set_Height (The_Widget, The_Height);   -- Twice inherited.
+       CA11A02_1.Set_Color (The_Widget, The_Color);     -- Inherited.
+       Set_Label  (The_Widget, The_Label);              -- Explicitly declared.
+    end Set_Widget;                                         
+ 
+    White_Widget : CA11A02_1.Label_Widget (11);
+ 
+ begin
+ 
+    Report.Test ("CA11A02", "Check that a type extended in a client of " &
+                 "a public child inherits primitive operations from parent");
+ 
+    Set_Widget (White_Widget, 15, 21, Color_Widget_Pkg.White, "Alarm_Clock");  
+ 
+    If White_Widget.Width /= Widget_Length (Report.Ident_Int (15)) or 
+      White_Widget.Height /= Widget_Length (Report.Ident_Int (21)) or
+        Color_Widget_Pkg."/=" (White_Widget.Color, Color_Widget_Pkg.White) or
+          White_Widget.Label /= "Alarm_Clock" then
+             Report.Failed ("Incorrect result for White_Widget");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11b01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11b01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11b01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11b01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,208 ----
+ -- CA11B01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a type derived in a public child inherits primitive 
+ --      operations from parent.  
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root record type with discriminant in a package 
+ --      specification. Declare a primitive subprogram for the type 
+ --      (foundation code).
+ --
+ --      Add a public child to the above package.  Derive a new type 
+ --      with constraint to the discriminant record type from the parent 
+ --      package.  Declare a new primitive subprogram to write to the child 
+ --      derived type.
+ --
+ --      Add a new public child to the above package.  This grandchild package
+ --      derives a new type using the record type from the above package.  
+ --      Declare a new primitive subprogram to write to the grandchild derived 
+ --      type.
+ --
+ --      In the main program, "with" the grandchild.  Access the inherited 
+ --      operations from grandparent, parent, and grandchild packages.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11B00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Child package of FA11B00.
+ package FA11B00.CA11B01_0 is          -- Application_Two_Widget
+ -- This public child declares a derived type from its parent.  It 
+ -- represents processing of widgets in a window system.  
+                                                                
+    type App2_Widget is new App1_Widget (Maximum_Size => 5000); 
+    -- Inherits procedure Create_Widget from parent.
+ 
+    -- Primitive operation of type App2_Widget.
+    -- To be inherited by its children derivatives.
+    procedure App2_Widget_Specific_Oper (The_Widget : in out App2_Widget;    
+                                         Loc        : in     Widget_Location);
+ 
+ end FA11B00.CA11B01_0;                -- Application_Two_Widget
+ 
+ --=======================================================================--
+ 
+ package body FA11B00.CA11B01_0 is     -- Application_Two_Widget
+ 
+    procedure App2_Widget_Specific_Oper 
+      (The_Widget : in out App2_Widget;    
+       Loc        : in     Widget_Location) is
+    begin
+       The_Widget.Location := Loc;
+    end App2_Widget_Specific_Oper;
+ 
+ end FA11B00.CA11B01_0;                -- Application_Two_Widget
+ 
+ --=======================================================================--
+ 
+ -- Grandchild package of FA11B00, child package of FA11B00.CA11B01_0.
+ package FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
+ -- This public grandchild declares a derived type from its parent.  It 
+ -- represents processing of widgets in a window system.  
+ 
+    type App3_Widget is new App2_Widget;    -- Derived record of App2_Widget.
+ 
+    -- Inherits (inherited) procedure Create_Widget from Application_One_Widget.
+    -- Inherits procedure App2_Widget_Specific_Oper from App2_Widget.
+ 
+    -- Primitive operation of type App3_Widget.
+    procedure App3_Widget_Specific_Oper (The_Widget : in out App3_Widget; 
+                                         S          : in     Widget_Size);
+ 
+ end FA11B00.CA11B01_0.CA11B01_1;           -- Application_Three_Widget
+ 
+ --=======================================================================--
+ 
+ package body FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
+ 
+    procedure App3_Widget_Specific_Oper 
+      (The_Widget : in out App3_Widget; 
+       S          : in     Widget_Size) is
+    begin
+       The_Widget.Size := S;
+    end App3_Widget_Specific_Oper;
+ 
+ end FA11B00.CA11B01_0.CA11B01_1;                -- Application_Three_Widget
+ 
+ --=======================================================================--
+ 
+ with FA11B00.CA11B01_0.CA11B01_1; -- Application_Three_Widget, 
+                                   -- implicitly with Application_Two_Widget,
+                                   -- implicitly with Application_Three_Widget.
+ with Report;
+ 
+ procedure CA11B01 is
+ 
+    package Application_One_Widget renames FA11B00;
+    package Application_Two_Widget renames FA11B00.CA11B01_0;
+    package Application_Three_Widget renames FA11B00.CA11B01_0.CA11B01_1;
+ 
+    use Application_One_Widget;
+    use Application_Two_Widget;
+    use Application_Three_Widget;
+ 
+ begin
+ 
+    Report.Test ("CA11B01", "Check that a type derived in a public " &
+                 "child inherits primitive operations from parent");
+ 
+    Application_One_Subtest:
+    declare
+       White_Widget : App1_Widget;
+ 
+    begin
+       -- perform an App1_Widget specific operation.
+       App1_Widget_Specific_Oper (C => White, L => "Line Editor    ",
+                                  The_Widget => White_Widget, I => 10);
+ 
+       If White_Widget.Color /= White or
+         White_Widget.Id /= Widget_ID 
+           (Report.Ident_Int (10)) or
+             White_Widget.Label  /= "Line Editor    " then
+               Report.Failed ("Incorrect result for White_Widget");
+       end if;
+ 
+    end Application_One_Subtest;
+    ---------------------------------------------------------------
+    Application_Two_Subtest:
+    declare
+       Amber_Widget : App2_Widget;
+ 
+    begin
+       App1_Widget_Specific_Oper (Amber_Widget, I => 11, 
+                                  C => Amber, L => "Alarm_Clock    ");  
+                                  -- Inherited from Application_One_Widget.
+                                            
+       -- perform an App2_Widget specific operation.
+       App2_Widget_Specific_Oper (The_Widget => Amber_Widget, Loc => (380,512));
+ 
+       If Amber_Widget.Color /= Amber or
+         Amber_Widget.Id /= Widget_ID (Report.Ident_Int (11)) or
+             Amber_Widget.Label  /= "Alarm_Clock    " or
+               Amber_Widget.Location /= (380,512) then
+                 Report.Failed ("Incorrect result for Amber_Widget");
+       end if;
+ 
+    end Application_Two_Subtest;
+    ---------------------------------------------------------------
+    Application_Three_Subtest:
+    declare
+       Green_Widget : App3_Widget;
+ 
+    begin
+       App1_Widget_Specific_Oper (Green_Widget, 100, Green, 
+                                  "Screen Editor  ");  
+                                    -- Inherited (inherited) from Basic_Widget.
+ 
+       -- perform an App2_Widget specific operation.
+       App2_Widget_Specific_Oper (Loc => (1024,760), 
+                                  The_Widget => Green_Widget);
+                                     -- Inherited from App_1_Widget.
+ 
+       -- perform an App3_Widget specific operation.
+       App3_Widget_Specific_Oper (Green_Widget, S => (100,100));
+ 
+       If Green_Widget.Color /= Green or
+         Green_Widget.Id /= Widget_ID (Report.Ident_Int (100)) or
+           Green_Widget.Label  /= "Screen Editor  " or
+             Green_Widget.Location /= (1024,760) or
+               Green_Widget.Size /= (100,100) then
+                 Report.Failed ("Incorrect result for Green_Widget");
+       end if;
+ 
+    end Application_Three_Subtest;
+ 
+    Report.Result;
+ 
+ end CA11B01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11b02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11b02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11b02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11b02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,169 ----
+ -- CA11B02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a type derived in a client of a public child inherits 
+ --      primitive operations from parent.  
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root record type with discriminant in a package 
+ --      specification. Declare a primitive subprogram for the type 
+ --      (foundation code).
+ --
+ --      Add a public child to the above package.  Derive a new type 
+ --      with constraint to the discriminant record type from the parent 
+ --      package.  Declare a new primitive subprogram to write to the child 
+ --      derived type.
+ --
+ --      In the main program, "with" the child.  Derive a new type using the 
+ --      record type from the child package.  Access the inherited operations 
+ --      from both parent and child packages.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11B00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Child package of FA11B00.
+ package FA11B00.CA11B02_0 is     -- Application_Two_Widget
+ -- This public child declares a derived type from its parent.  It 
+ -- represents processing of widgets in a window system.  
+ 
+    -- Dimension of app2_widget is limited to 5000 pixels.
+ 
+    type App2_Widget is new App1_Widget (Maximum_Size => 5000); 
+                            -- Derived record of parent type.
+ 
+    -- Inherits procedure App1_Widget_Specific_Oper from parent.
+ 
+ 
+    -- Primitive operation of type App2_Widget.
+ 
+    procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget;    
+                                        S          : in     Widget_Size);
+      
+    -- Primitive operation of type App2_Widget.
+ 
+    procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget;    
+                                        Loc        : in     Widget_Location);
+ 
+ end FA11B00.CA11B02_0;      -- Application_Two_Widget
+ 
+ 
+ --=======================================================================--
+ 
+ 
+ package body FA11B00.CA11B02_0 is     -- Application_Two_Widget
+ 
+    procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget;    
+                                        S          : in     Widget_Size) is
+    begin
+       The_Widget.Size := S;
+    end App2_Widget_Specific_Op1;
+ 
+                --==============================================--
+ 
+    procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget;    
+                                        Loc        : in     Widget_Location) is
+    begin
+       The_Widget.Location := Loc;
+    end App2_Widget_Specific_Op2;
+ 
+ end FA11B00.CA11B02_0;     -- Application_Two_Widget
+ 
+ 
+ --=======================================================================--
+ 
+ with FA11B00.CA11B02_0;      -- Application_Two_Widget
+                              -- implicitly with Application_One_Widget.
+ with Report;
+ 
+ procedure CA11B02 is
+                              
+    package Application_One_Widget renames FA11B00;
+ 
+    package Application_Two_Widget renames FA11B00.CA11B02_0;
+ 
+    use Application_One_Widget ;
+    use Application_Two_Widget ;
+ 
+    type Emulator_Widget is new App2_Widget;   -- Derived record of 
+                                               -- parent type.
+ 
+    White_Widget, Amber_Widget : Emulator_Widget;
+ 
+ 
+ begin
+ 
+    Report.Test ("CA11B02", "Check that a type derived in client of a " &
+                 "public child inherits primitive operations from parent");
+ 
+    App1_Widget_Specific_Oper (C => White, L => "Line Editor    ",
+                               The_Widget => White_Widget, I => 10);
+                                   -- Inherited from Application_One_Widget.
+    If White_Widget.Color /= White or
+      White_Widget.Id /= Widget_ID (Report.Ident_Int (10)) or
+      White_Widget.Label  /= "Line Editor    " 
+    then
+       Report.Failed ("Incorrect result for White_Widget");
+    end if;
+ 
+    -- perform an App2_Widget specific operation.
+ 
+    App2_Widget_Specific_Op1 (White_Widget, S => (100, 200));
+ 
+    If White_Widget.Size.X_Length /= 100 or
+      White_Widget.Size.Y_Length /= 200
+    then
+       Report.Failed ("Incorrect size for White_Widget");
+    end if;
+ 
+    App1_Widget_Specific_Oper (Amber_Widget, 5, Amber, "Screen Editor  ");  
+                                   -- Inherited from Application_One_Widget.
+ 
+    -- perform an App2_Widget specific operations.
+ 
+    App2_Widget_Specific_Op1 (S => (1024,100), The_Widget => Amber_Widget);  
+    App2_Widget_Specific_Op2 (Amber_Widget, (1024, 760));
+ 
+    If Amber_Widget.Color /= Amber or
+      Amber_Widget.Id /= Widget_ID (Report.Ident_Int (5)) or 
+      Amber_Widget.Label  /= "Screen Editor  " or
+      Amber_Widget.Size /= (1024,100) or 
+      Amber_Widget.Location.X_Location /= 1024 or
+      Amber_Widget.Location.Y_Location /= 760
+    then
+       Report.Failed ("Incorrect result for Amber_Widget");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11B02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11c01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11c01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11c01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11c01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,170 ----
+ -- CA11C01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that when primitive operations declared in a child package
+ --      override operations declared in ancestor packages, a client of the
+ --      child package inherits the operations correctly.
+ --
+ -- TEST DESCRIPTION:
+ --
+ --      This test builds on the foundation code file (FA11C00) that contains
+ --      a parent package, child package, and grandchild package.  The parent
+ --      package declares a tagged type and primitive operation.  The child
+ --      package extends the type, and overrides the primitive operation. The
+ --      grandchild package does the same.  
+ --
+ --      The test procedure "withs" the grandchild package, and receives
+ --      visibility to all of its ancestor packages, types and operations.
+ --      Three procedures, each with a formal parameter of a specific type are
+ --      defined.  Each of these invokes a particular version of the overridden
+ --      primitive operation Image.  Calls to these local procedures are made, 
+ --      with objects of each of the tagged types as parameters, and the global 
+ --      variable is finally examined to ensure that the correct version of 
+ --      primitive operation was inherited by the client and invoked by the 
+ --      call.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11C00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with FA11C00_0.FA11C00_1.FA11C00_2;    -- Package Animal.Mammal.Primate
+ with Report;
+ 
+ procedure CA11C01 is
+ 
+    package Animal_Package  renames FA11C00_0;
+    package Mammal_Package  renames FA11C00_0.FA11C00_1;
+    package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2;
+ 
+    Max_Animals : constant := 3;
+ 
+    subtype Data_String is String (1 .. 37);
+    type Data_Base_Type is array  (1 .. Max_Animals) of Data_String;
+ 
+    Zoo_Data_Base : Data_Base_Type := (others => (others => ' '));
+                                       -- Global variable.
+ 
+    Salmon   : Animal_Package.Animal := (Common_Name => "Chinook Salmon      ", 
+                                         Weight      => 10);
+ 
+    Platypus : Mammal_Package.Mammal := (Common_Name => "Tasmanian Platypus  ",
+                                         Weight      => 13,
+                                         Hair_Color  => Mammal_Package.Brown);
+ 
+    Orangutan : Primate_Package.Primate := 
+                  (Common_Name => "Sumatran Orangutan  ",
+                   Weight      => 220,
+                   Hair_Color  => Mammal_Package.Red,
+                   Habitat     => Primate_Package.Arboreal);
+ begin
+ 
+    Report.Test ("CA11C01", "Check that when primitive operations declared "   &
+                            "in a child package override operations declared " &
+                            "in ancestor packages, a client of the child "     &
+                            "package inherits the operations correctly");
+ 
+    declare
+ 
+       use Animal_Package, Mammal_Package, Primate_Package;
+ 
+       -- The function Image has been overridden in the child and grandchild
+       -- packages, but the client has inherited all versions of the function,
+       -- and can successfully use them to enter data into the database.
+       -- Each of the following procedures updates the global variable 
+       -- Zoo_Data_Base.
+ 
+       procedure Enter_Animal_Data (A : Animal; I : Integer) is
+       begin
+          Zoo_Data_Base (I) := Image (A);  
+       end Enter_Animal_Data;              
+ 
+       procedure Enter_Mammal_Data (M : Mammal; I : Integer) is
+       begin
+          Zoo_Data_Base (I) := Image (M);  
+       end Enter_Mammal_Data;
+ 
+       procedure Enter_Primate_Data (P : Primate; I : Integer) is
+       begin
+          Zoo_Data_Base (I) := Image (P);  
+       end Enter_Primate_Data;
+ 
+    begin
+ 
+       -- Verify initial test conditions.
+ 
+       if not (Zoo_Data_Base(1)(1..6) = "      ") 
+          or else
+              (Zoo_Data_Base(2)(1..6) /= "      ") 
+          or else
+              (Zoo_Data_Base(3)(1..6) /= "      ")
+       then
+          Report.Failed ("Initial condition failure");
+       end if;
+ 
+ 
+       -- Enter data from all three animals into the zoo database.
+ 
+       Enter_Animal_Data  (A => Salmon,    I => 1);  -- First entry in database.
+       Enter_Mammal_Data  (M => Platypus,  I => 2);  -- Second entry.
+       Enter_Primate_Data (P => Orangutan, I => 3);  -- Third entry. 
+ 
+       -- Verify the correct version of the overridden function Image was used
+       -- for entering the specific data.  
+ 
+       if  Zoo_Data_Base(1)(1 .. 6) /= "Animal"
+         or else
+           Zoo_Data_Base(1)(26 .. 31) /= "Salmon"
+         then
+            Report.Failed ("Incorrect version of Image for parent type");
+       end if;
+ 
+       if (Zoo_Data_Base(2)(1 .. 6) /= "Mammal") 
+         or
+           (Zoo_Data_Base(2)(28 .. 35) /= "Platypus") 
+         then
+            Report.Failed ("Incorrect version of Image for child type");
+       end if;
+ 
+       if ((Zoo_Data_Base(3)(1 .. 7) /= "Primate") 
+         or 
+           (Zoo_Data_Base(3)(27 .. 35) /= "Orangutan"))
+         then
+            Report.Failed ("Incorrect version of Image for grandchild type");
+       end if;
+ 
+    end;
+ 
+ 
+    Report.Result;
+ 
+ end CA11C01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11c02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11c02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11c02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11c02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,158 ----
+ -- CA11C02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that primitive operations declared in a child package
+ --      override operations declared in ancestor packages, and that
+ --      operations on class-wide types defined in the ancestor packages 
+ --      dispatch as appropriate to these overriding implementations. 
+ --
+ -- TEST DESCRIPTION:
+ --
+ --      This test builds on the foundation code file (FA11C00) that contains
+ --      a parent package, child package, and grandchild package.  The parent
+ --      package declares a tagged type and primitive operation.  The child
+ --      package extends the type, and overrides the primitive operation. The
+ --      grandchild package does the same.  
+ --
+ --      The test procedure "withs" the grandchild package, and receives
+ --      visibility to all of its ancestor packages, types and operations.
+ --      A procedure with a formal class-wide parameter is defined that will
+ --      allow for dispatching calls to the overridden primitive operations,
+ --      based on the specific type of the actual parameter.  The primitive
+ --      operations provide a string value to update a global string array
+ --      variable.  Calls to the local procedure are made, with objects of each
+ --      of the tagged types as parameters, and the global variable is finally 
+ --      examined to ensure that the correct version of primitive operation was 
+ --      dispatched correctly.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11C00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with FA11C00_0.FA11C00_1.FA11C00_2;    -- Package Animal.Mammal.Primate
+ with Report;
+ 
+ procedure CA11C02 is
+ 
+    package Animal_Package  renames FA11C00_0;
+    package Mammal_Package  renames FA11C00_0.FA11C00_1;
+    package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2;
+ 
+    Max_Animals : constant := 3;
+ 
+    type Data_Base_Type is array (1 .. Max_Animals) of String (1 .. 37);
+ 
+    Zoo_Data_Base : Data_Base_Type := (others => (others => ' '));
+                                       -- Global variable.
+ 
+    Macaw : Animal_Package.Animal   := (Common_Name => "Scarlet Macaw       ", 
+                                        Weight      => 2);
+ 
+    Manatee : Mammal_Package.Mammal := (Common_Name => "Southern Manatee    ",
+                                        Weight      => 230,
+                                        Hair_Color  => Mammal_Package.Brown);
+ 
+    Lemur : Primate_Package.Primate := 
+               (Common_Name => "Ring-Tailed Lemur   ",
+                Weight      => 5,
+                Hair_Color  => Mammal_Package.Black,
+                Habitat     => Primate_Package.Arboreal);
+ begin
+ 
+    Report.Test ("CA11C02", "Check that primitive operations declared "   &
+                            "in a child package override operations declared " &
+                            "in ancestor packages, and that operations " &
+                            "on class-wide types defined in the ancestor " &
+                            "packages dispatch as appropriate to these " &
+                            "overriding implementations");
+ 
+    declare
+ 
+       use Animal_Package, Mammal_Package, Primate_Package;
+ 
+       -- The following procedure updates the global variable Zoo_Data_Base.
+ 
+       procedure Enter_Data (A : Animal'Class; I : Integer) is
+       begin
+          Zoo_Data_Base (I) := Image (A);  
+       end Enter_Data;              
+ 
+    begin
+ 
+       -- Verify initial test conditions.
+ 
+       if not (Zoo_Data_Base(1)(1..6) = "      ")
+          or not
+              (Zoo_Data_Base(2)(1..6) = "      ")
+          or not 
+              (Zoo_Data_Base(3)(1..6) = "      ")
+       then
+          Report.Failed ("Initial condition failure");
+       end if;
+ 
+ 
+       -- Enter data from all three animals into the zoo database.
+ 
+       Enter_Data (Macaw, 1);                 -- First entry in database.
+       Enter_Data (A => Manatee, I => 2);     -- Second entry.
+       Enter_Data (Lemur, I => 3);            -- Third entry. 
+ 
+       -- Verify the correct version of the overridden function Image was used
+       -- for entering the specific data.  
+ 
+       if not (Zoo_Data_Base(1)(1 .. 6)   = "Animal") 
+         or not
+              (Zoo_Data_Base(1)(26 .. 30) = "Macaw") 
+         then
+            Report.Failed ("Incorrect version of Image for parent type");
+       end if;
+ 
+       if not (Zoo_Data_Base(2)(1 .. 6)   = "Mammal"
+         and 
+           Zoo_Data_Base(2)(27 .. 33) = "Manatee") 
+         then
+            Report.Failed ("Incorrect version of Image for child type");
+       end if;
+ 
+       if not ((Zoo_Data_Base(3)(1 .. 7)   = "Primate")
+         and 
+           (Zoo_Data_Base(3)(30 .. 34) = "Lemur"))
+         then
+            Report.Failed ("Incorrect version of Image for grandchild type");
+       end if;
+ 
+    end;
+ 
+    Report.Result;
+ 
+ end CA11C02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11c03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11c03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11c03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11c03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- CA11C03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that when a child unit is "withed", visibility is obtained to 
+ --      all ancestor units named in the expanded name of the "withed" child
+ --      unit.  Check that when the parent unit is "used", the simple name of 
+ --      a "withed" child unit is made directly visible.
+ --
+ -- TEST DESCRIPTION:
+ --      To satisfy the first part of the objective, various references are
+ --      made to types and functions declared in the ancestor packages of the
+ --      foundation code package hierarchy.  Since the grandchild library unit
+ --      package has been "withed" by this test, the visibility of these 
+ --      components demonstrates that visibility of the ancestor package names
+ --      is provided when the expanded name of a child library unit is "withed". 
+ --      
+ --      The declare block in the test program includes a "use" clause of the
+ --      parent package (FA11C00_0.FA11C00_1) of the "withed" child package.  
+ --      As a result, the simple name of the child package (FA11C00_2) is
+ --      directly visible.  The type and function declared in the child 
+ --      package are now visible when qualified with the simple name of the
+ --      "withed" package (FA11C00_2).
+ --      
+ --      This test simulates the formatting of data strings, based on the
+ --      component fields of a "doubly-extended" tagged record type.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11C00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with FA11C00_0.FA11C00_1.FA11C00_2;  -- "with" of child library package 
+                                      -- Animal.Mammal.Primate.
+                                      -- This will be used in conjunction with
+                                      -- a "use" of FA11C00_0.FA11C00_1 below 
+                                      -- to verify a portion of the objective.
+ with Report;
+ 
+ procedure CA11C03 is
+ 
+    Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' ');
+                                      -- Visibility of grandparent package.
+                                      -- The package FA11C00_0 is visible since
+                                      -- it is an ancestor that is mentioned in
+                                      -- the expanded name of its "withed"
+                                      -- grandchild package.
+ 
+    Blank_Hair_Color : 
+      String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' ');
+                                      -- Visibility of parent package.
+                                      -- The package FA11C00_0.FA11C00_1 is
+                                      -- visible due to the "with" of its 
+                                      -- child package.
+ 
+    subtype Data_String_Type is String (1 .. 60);
+ 
+    TC_Result_String : Data_String_Type := (others => ' ');
+ 
+    --
+ 
+    function Format_Primate_Data (Name : String := Blank_Name_String;  
+                                  Hair : String := Blank_Hair_Color) 
+      return Data_String_Type is
+ 
+       Pos                        : Integer := 1;
+       Hair_Color_Field_Separator : constant String := " Hair Color: ";
+ 
+       Result_String              : Data_String_Type := (others => ' '); 
+ 
+    begin
+       Result_String (Pos .. Name'Length) := Name;    -- Enter name at start
+                                                      -- of string.
+       Pos := Pos + Name'Length;                      -- Increment counter to
+                                                      -- next blank position.
+       Result_String 
+         (Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) :=
+         Hair_Color_Field_Separator & Hair;           -- Include hair color data
+                                                      -- in result string.
+       return (Result_String);                        
+    end Format_Primate_Data;
+ 
+ 
+ begin
+ 
+    Report.Test ("CA11C03", "Check that when a child unit is WITHED, "        &
+                            "visibility is obtained to all ancestor units "   &
+                            "named in the expanded name of the WITHED child " &
+                            "unit. Check that when the parent unit is USED, " &
+                            "the simple name of a WITHED child unit is made " &
+                            "directly visible" );
+ 
+    declare
+       use FA11C00_0.FA11C00_1;    -- This "use" clause will allow direct 
+                                   -- visibility to the simple name of
+                                   -- package FA11C00_0.FA11C00_1.FA11C00_2,
+                                   -- since this child package was "withed" by
+                                   -- the main program.
+ 
+       Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ",
+                                       Weight      => 7,
+                                       Hair_Color  => Brown,
+                                       Habitat     => FA11C00_2.Arboreal);
+ 
+                                   -- Demonstrates visibility of package
+                                   -- FA11C00_0.FA11C00_1.FA11C00_2.
+                                   --
+                                   -- Type Primate referenced with the simple
+                                   -- name of package FA11C00_2 only.
+                                   --
+                                   -- Simple name of package FA11C00_2 is 
+                                   -- directly visible through "use" of parent.
+ 
+    begin
+ 
+       -- Verify that the Format_Primate_Data function will return a blank
+       -- filled string when no parameters are provided in the call.
+ 
+       TC_Result_String := Format_Primate_Data;
+ 
+       if (TC_Result_String (1 .. 20)  /= Blank_Name_String) then 
+          Report.Failed ("Incorrect initialization value from function");
+       end if;
+ 
+ 
+       -- Use function Format_Primate_Data to return a formatted data string.
+ 
+       TC_Result_String := 
+         Format_Primate_Data 
+          (Name => FA11C00_2.Image (Tarsier),       
+                                   -- Function returns a 37 character string 
+                                   -- value.
+           Hair => Hair_Color_Type'Image(Tarsier.Hair_Color));
+                                   -- The Hair_Color_Type is referenced 
+                                   -- directly, without package
+                                   -- FA11C00_0.FA11C00_1 qualifier.
+                                   -- No qualification of Hair_Color_Type is
+                                   -- needed due to "use" clause.
+ 
+                                   -- Note that the result of calling 'Image 
+                                   -- with an enumeration type argument 
+                                   -- results in an upper-case string.
+                                   -- (See conditional statement below.)
+ 
+       -- Verify the results of the function call.
+ 
+       if not  (TC_Result_String (1 .. 37) = 
+                 "Primate Species: East-Indian Tarsier " and then
+               TC_Result_String (38 .. 55) =
+                 " Hair Color: BROWN") then
+         Report.Failed ("Incorrect result returned from function call");
+       end if;
+ 
+    end;
+ 
+    Report.Result;
+ 
+ end CA11C03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d010.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d010.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d010.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d010.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- CA11D010.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA11D013.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See CA11D013.AM
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FA11D00.A
+ --      => CA11D010.A
+ --         CA11D011.A
+ --         CA11D012.A
+ --         CA11D013.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ -- Child package of FA11D00.
+ 
+ package FA11D00.CA11D010 is     -- Add_Subtract_Complex
+ 
+    procedure Add (Left, Right : in     Complex_Type;   -- Add two complex
+                   C           :    out Complex_Type);  -- numbers.
+ 
+    function Subtract (Left, Right : Complex_Type)      -- Subtract two 
+      return Complex_Type;                              -- complex numbers.
+                                                 
+                                                        
+                                                        
+ end FA11D00.CA11D010;     -- Add_Subtract_Complex
+ 
+ --=======================================================================--
+ 
+ with Report;
+ 
+ package body FA11D00.CA11D010 is     -- Add_Subtract_Complex
+ 
+    procedure Add (Left, Right : in Complex_Type;
+                   C           :    out Complex_Type) is
+    begin
+       -- Zero is declared in parent package.
+ 
+       if Left.Real < Zero.Real or else Right.Real < Zero.Real
+         or else Left.Imag < Zero.Imag or else Right.Imag < Zero.Imag then
+           raise Add_Error;     -- Reference to exception in parent package.
+           Report.Failed ("Program control not transferred by raise in " &
+                          "procedure Add");
+       else
+          C.Real := (Left.Real + Right.Real);
+          C.Imag := (Left.Imag + Right.Imag);
+       end if;
+ 
+    exception
+       when Add_Error => 
+          TC_Handled_In_Child_Pkg_Proc := true;
+          C := Check_Value;           -- Reference to object in parent package.
+          raise;     -- Reraise the Add_Error exception in the subtest.
+          Report.Failed ("Exception not reraised in handler");
+ 
+       when others    =>
+          Report.Failed ("Unexpected exception raised in Add");
+ 
+    end Add;
+    -----------------------------------------------------------
+    function Subtract (Left, Right : Complex_Type) 
+      return Complex_Type is
+    begin
+       -- Zero is declared in parent package.
+       if Left.Real < Zero.Real or Right.Real < Zero.Real
+         or Left.Imag < Zero.Imag or Right.Imag < Zero.Imag then
+           raise Subtract_Error;    -- Reference to exception in parent package. 
+           Report.Failed ("Program control not transferred by raise in " &
+                          "function Subtract");
+       else
+          return ( Real => (Left.Real - Right.Real),
+                   Imag => (Left.Imag - Right.Imag) );
+       end if;
+ 
+    exception
+       when Subtract_Error => 
+          Report.Comment ("Exception is properly handled in Subtract");
+          TC_Handled_In_Child_Pkg_Func := true;
+          return Check_Value;
+ 
+       when others         =>
+          Report.Failed ("Unexpected exception raised in Subtract");
+ 
+    end Subtract;
+ 
+ end FA11D00.CA11D010;     -- Add_Subtract_Complex
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d011.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d011.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d011.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d011.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- CA11D011.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA11D013.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See CA11D013.AM
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FA11D00.A
+ --         CA11D010.A
+ --      => CA11D011.A
+ --         CA11D012.A
+ --         CA11D013.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Dec 94   SAIC    Declared child procedure specification
+ --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ 
+ 
+ -- Child procedure of FA11D00.
+ 
+ procedure FA11D00.CA11D011 (Left, Right : in     Complex_Type;
+                             C           :    out Complex_Type);
+ 
+ --=======================================================================--
+ 
+ procedure FA11D00.CA11D011 (Left, Right : in     Complex_Type;
+                             C           :    out Complex_Type) is
+ -- Multiply_Complex.
+ 
+ begin
+    -- Zero is declared in parent package.
+ 
+    if Left.Real < Zero.Real or Right.Imag < Zero.Imag then
+       raise Multiply_Error;  -- Reference to exception in parent package. 
+       Report.Failed ("Program control not transferred by raise in " &
+                      "child procedure FA11D00.CA11D011");
+    else
+       C.Real := (Left.Real * Right.Real);
+       C.Imag := (Left.Imag * Right.Imag);
+    end if;
+ 
+    exception
+       when others => 
+          TC_Handled_In_Child_Sub := true;
+          C := Check_Value;            -- Reference to object in parent package.
+ 
+ end FA11D00.CA11D011;     -- Multiply_Complex
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d012.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d012.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d012.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d012.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,73 ----
+ -- CA11D012.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA11D013.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See CA11D013.AM
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FA11D00.A
+ --         CA11D010.A
+ --         CA11D011.A
+ --      => CA11D012.A
+ --         CA11D013.AM
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Dec 94   SAIC    Declared child function specification
+ --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ 
+ -- Child function of FA11D00.
+ -- Does not divide zero complex numbers.
+ 
+ function FA11D00.CA11D012 (Left, Right : Complex_Type)
+   return Complex_Type; 
+ 
+ --=======================================================================--
+ 
+ function FA11D00.CA11D012 (Left, Right : Complex_Type)
+   return Complex_Type is                       -- Divide_Complex
+ 
+ begin
+    -- Zero is declared in parent package.
+ 
+    if Right.Real = Zero.Real or Right.Imag = Zero.Imag then
+       raise Divide_Error;  -- Reference to exception in parent package. 
+       Report.Failed ("Program control not transferred by raise in " &
+                      "child function FA11D00.CA11D012");
+    else
+       return ( Real => (Left.Real / Right.Real),
+                Imag => (Left.Imag / Right.Imag) );
+    end if;
+ 
+ end FA11D00.CA11D012;     -- Divide_Complex
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d013.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d013.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d013.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d013.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,256 ----
+ -- CA11D013.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a child unit can raise an exception that is declared in 
+ --      parent.                
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package which defines complex number abstraction with
+ --      user-defined exceptions (foundation code).
+ --
+ --      Add a public child package to the above package. Declare two 
+ --      subprograms for the parent type.  Each of the subprograms raises a 
+ --      different exception, based on the value of an input parameter.
+ --
+ --      Add a public child procedure to the foundation package.  This
+ --      procedure raises an exception based on the value of an input 
+ --      parameter.
+ --
+ --      Add a public child function to the foundation package.  This
+ --      function raises an exception based on the value of an input 
+ --      parameter.
+ --
+ --      In the main program, "with" the child packages, then check that
+ --      the exceptions are raised and handled as expected.  Ensure that
+ --      exceptions are:
+ --         1) raised in the public child package and handled/reraised to
+ --            be handled by the main program.
+ --         2) raised and handled locally in the public child package.
+ --         3) raised and handled locally by "others" in the public child 
+ --            procedure.
+ --         4) raised in the public child function and propagated to the
+ --            main program.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FA11D00.A
+ --         CA11D010.A
+ --         CA11D011.A
+ --         CA11D012.A
+ --      => CA11D013.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with FA11D00.CA11D010;               -- Add_Subtract_Complex
+ with FA11D00.CA11D011;               -- Multiply_Complex
+ with FA11D00.CA11D012;               -- Divide_Complex
+ 
+ with Report;
+ 
+ 
+ procedure CA11D013 is
+ 
+    package Complex_Pkg renames FA11D00;
+    package Add_Subtract_Complex_Pkg renames FA11D00.CA11D010;
+    use Complex_Pkg;
+ 
+ begin
+ 
+    Report.Test ("CA11D013", "Check that a child unit can raise an " &
+                 "exception that is declared in parent");
+ 
+ 
+    Add_Complex_Subtest:
+    declare
+       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
+                                     Int_Type (Report.Ident_Int (7)));  
+       Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 
+                                     Int_Type (Report.Ident_Int (3)));  
+       Add_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (8)), 
+                                     Int_Type (Report.Ident_Int (10)));  
+       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-100)), 
+                                     Int_Type (Report.Ident_Int (100)));  
+       Complex_Num : Complex_Type := Zero;  
+ 
+    begin
+       Add_Subtract_Complex_Pkg.Add (First, Second, Complex_Num);
+ 
+       if (Complex_Num /= Add_Result) then
+          Report.Failed ("Incorrect results from addition");
+       end if;
+   
+       -- Error is raised in child package and exception 
+       -- will be handled/reraised to caller.
+ 
+       Add_Subtract_Complex_Pkg.Add (First, Third, Complex_Num);
+ 
+       -- Error was not raised in child package.
+       Report.Failed ("Exception was not reraised in addition");
+ 
+    exception
+       when Add_Error     => 
+          if not TC_Handled_In_Child_Pkg_Proc then
+             Report.Failed ("Exception was not raised in addition");
+          else
+             TC_Handled_In_Caller := true;  -- Exception is reraised from
+                                            -- child package.
+          end if;
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in addition subtest"); 
+          TC_Handled_In_Caller := false;  -- Improper exception handling
+                                          -- in caller.
+ 
+    end Add_Complex_Subtest;
+ 
+ 
+    Subtract_Complex_Subtest:
+    declare
+       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
+                                     Int_Type (Report.Ident_Int (6)));  
+       Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 
+                                     Int_Type (Report.Ident_Int (7)));  
+       Sub_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 
+                                     Int_Type (Report.Ident_Int (1)));  
+       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-200)), 
+                                     Int_Type (Report.Ident_Int (1)));  
+       Complex_Num : Complex_Type;
+ 
+    begin
+       Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, First);
+ 
+       if (Complex_Num /= Sub_Result) then
+          Report.Failed ("Incorrect results from subtraction");
+       end if;
+   
+       -- Error is raised and exception will be handled in child package.
+       Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, Third);
+ 
+    exception
+       when Subtract_Error => 
+          Report.Failed ("Exception raised in subtraction and " &
+                         "propagated to caller");
+          TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
+                                                 -- in caller.
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in subtraction subtest"); 
+          TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
+                                                 -- in caller.
+ 
+    end Subtract_Complex_Subtest;
+ 
+ 
+    Multiply_Complex_Subtest:
+    declare
+       First       : Complex_Type := Complex (Int_Type(Report.Ident_Int(3)), 
+                                     Int_Type (Report.Ident_Int (4)));  
+       Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 
+                                     Int_Type (Report.Ident_Int (3)));  
+       Mult_Result : Complex_Type := Complex(Int_Type(Report.Ident_Int(15)), 
+                                     Int_Type(Report.Ident_Int (12)));  
+       Third       : Complex_Type := Complex(Int_Type(Report.Ident_Int(10)), 
+                                     Int_Type(Report.Ident_Int (-10)));  
+       Complex_Num : Complex_Type;
+ 
+    begin
+       CA11D011 (First, Second, Complex_Num);
+ 
+       if (Complex_Num /= Mult_Result) then
+          Report.Failed ("Incorrect results from multiplication");
+       end if;
+   
+       -- Error is raised and exception will be handled in child package.
+      CA11D011 (First, Third, Complex_Num);
+ 
+    exception
+       when Multiply_Error => 
+          Report.Failed ("Exception raised in multiplication and " &
+                         "propagated to caller");
+          TC_Handled_In_Child_Sub := false;     -- Improper exception handling
+                                                -- in caller.
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in multiplication subtest"); 
+          TC_Handled_In_Child_Sub := false;     -- Improper exception handling
+                                                -- in caller.
+    end Multiply_Complex_Subtest;
+ 
+ 
+    Divide_Complex_Subtest:
+    declare
+       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int(10)), 
+                                     Int_Type (Report.Ident_Int (15)));  
+       Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 
+                                     Int_Type (Report.Ident_Int (3)));  
+       Div_Result  : Complex_Type := Complex (Int_Type(Report.Ident_Int(2)), 
+                                     Int_Type (Report.Ident_Int (5)));  
+       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-10)), 
+                                     Int_Type (Report.Ident_Int (0)));  
+       Complex_Num : Complex_Type := Zero;
+ 
+    begin
+       Complex_Num := CA11D012 (First, Second);
+ 
+       if (Complex_Num /= Div_Result) then
+          Report.Failed ("Incorrect results from division");
+       end if;
+   
+       -- Error is raised in child package; exception will be
+       -- propagated to caller.
+       Complex_Num := CA11D012 (Second, Third);
+ 
+       -- Error was not raised in child package.
+       Report.Failed ("Exception was not raised in division subtest ");
+ 
+    exception
+       when Divide_Error => 
+          TC_Propagated_To_Caller := true;  -- Exception is propagated.
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in division subtest"); 
+          TC_Propagated_To_Caller := false;  -- Improper exception handling
+                                             -- in caller.
+    end Divide_Complex_Subtest;
+ 
+ 
+    if not (TC_Handled_In_Caller         and     -- Check to see that all 
+            TC_Handled_In_Child_Pkg_Proc and     -- exceptions were handled in
+            TC_Handled_In_Child_Pkg_Func and     -- the proper locations.
+            TC_Handled_In_Child_Sub      and     
+            TC_Propagated_To_Caller)
+    then
+       Report.Failed ("Exceptions handled in incorrect locations");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11D013;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,393 ----
+ -- CA11D02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an exception declared in a package can be raised by a 
+ --      child of a child package.  Check that it can be renamed in the 
+ --      child of the child package and raised with the correct effect.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package which defines complex number abstraction with
+ --      user-defined exceptions (foundation code).
+ --
+ --      Add a public child package to the above package. Declare two 
+ --      subprograms for the parent type.  
+ --
+ --      Add a public grandchild package to the foundation package.  Declare
+ --      subprograms to raise exceptions.
+ --
+ --      In the main program, "with" the grandchild package, then check that
+ --      the exceptions are raised and handled as expected.  Ensure that
+ --      exceptions are:
+ --         1) raised in the public grandchild package and handled/reraised to
+ --            be handled by the main program.
+ --         2) raised and handled locally by the "others" handler in the 
+ --            public grandchild package.
+ --         3) raised in the public grandchild and propagated to the main 
+ --            program.
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11D00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Child package of FA11D00.
+ 
+ package FA11D00.CA11D02_0 is     -- Basic_Complex
+ 
+    function "+" (Left, Right : Complex_Type) 
+      return Complex_Type;                   -- Add two complex numbers.
+ 
+    function "*" (Left, Right : Complex_Type) 
+      return Complex_Type;                   -- Multiply two complex numbers.
+ 
+ end FA11D00.CA11D02_0;     -- Basic_Complex
+ 
+ --=======================================================================--
+ 
+ package body FA11D00.CA11D02_0 is     -- Basic_Complex
+ 
+    function "+" (Left, Right : Complex_Type) return Complex_Type is
+    begin
+       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
+    end "+";
+    --------------------------------------------------------------
+    function "*" (Left, Right : Complex_Type) return Complex_Type is
+    begin
+       return ( Real => (Left.Real * Right.Real),
+                Imag => (Left.Imag * Right.Imag) );
+    end "*";
+ 
+ end FA11D00.CA11D02_0;     -- Basic_Complex
+ 
+ --=======================================================================--
+ 
+ -- Child package of FA11D00.CA11D02_0.
+ -- Grandchild package of FA11D00.
+ 
+ package FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
+ 
+    Inverse_Error : exception renames Divide_Error;   -- Reference to exception 
+                                                      -- in grandparent package.
+    Array_Size    : constant := 2;
+ 
+    type Complex_Array_Type is                        
+       array (1 .. Array_Size) of Complex_Type;       -- Reference to type
+                                                      -- in parent package.
+ 
+    function Multiply (Left  : Complex_Array_Type;    -- Multiply two complex
+                       Right : Complex_Array_Type)    -- arrays.
+      return Complex_Array_Type;
+ 
+    function Add (Left, Right : Complex_Array_Type)   -- Add two complex
+      return Complex_Array_Type;                      -- arrays.
+ 
+    procedure Inverse (Right : in     Complex_Array_Type;  -- Invert a complex
+                       Left  : in out Complex_Array_Type); -- array.
+  
+ end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
+ 
+ --=======================================================================--
+ 
+ with Report;
+ 
+ 
+ package body FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
+ 
+    function Multiply (Left  : Complex_Array_Type;
+                       Right : Complex_Array_Type)
+      return Complex_Array_Type is
+ 
+    -- This procedure will raise an exception depending on the input
+    -- parameter.  The exception will be handled locally by the
+    -- "others" handler.
+ 
+       Result : Complex_Array_Type := (others => Zero);
+ 
+       subtype Vector_Size is Positive range Left'Range;
+ 
+    begin  
+       if Left = Result or else Right = Result then -- Do not multiply zero.
+          raise Multiply_Error;                     -- Refence to exception in
+                                                    -- grandparent package.
+          Report.Failed ("Program control not transferred by raise");
+       else
+          for I in Vector_Size loop
+            Result(I) := ( Left(I) * Right(I) );    -- Basic_Complex."*".
+          end loop;
+       end if;
+       return (Result);
+    
+    exception
+       when others =>
+          Report.Comment ("Exception is handled by others in Multiplication");
+          TC_Handled_In_Grandchild_Pkg_Func := true;
+          return (Zero, Zero);
+       
+    end Multiply;
+    --------------------------------------------------------------
+    function Add (Left, Right : Complex_Array_Type)
+      return Complex_Array_Type is
+ 
+    -- This function will raise an exception depending on the input
+    -- parameter.  The exception will be propagated and handled
+    -- by the caller.
+ 
+       Result : Complex_Array_Type := (others => Zero);
+ 
+       subtype Vector_Size is Positive range Left'Range;
+ 
+    begin  
+       if Left = Result or Right = Result then     -- Do not add zero.
+          raise Add_Error;                         -- Refence to exception in
+                                                   -- grandparent package.
+          Report.Failed ("Program control not transferred by raise");
+       else
+          for I in Vector_Size loop                   
+            Result(I) := ( Left(I) + Right(I) );   -- Basic_Complex."+".
+          end loop;
+       end if;
+       return (Result);
+  
+    end Add;
+    --------------------------------------------------------------
+    procedure Inverse (Right : in     Complex_Array_Type;
+                       Left  : in out Complex_Array_Type) is
+ 
+    -- This function will raise an exception depending on the input
+    -- parameter.  The exception will be handled/reraised to be
+    -- handled by the caller.
+ 
+       Result : Complex_Array_Type := (others => Zero);
+ 
+       Array_With_Zero : boolean := false;
+ 
+    begin
+       for I in 1 .. Right'Length loop
+         if Right(I) = Zero then      -- Check for zero.
+           Array_With_Zero := true;
+         end if;
+       end loop;
+ 
+       If Array_With_Zero then
+          raise Inverse_Error;      -- Do not inverse zero.
+          Report.Failed ("Program control not transferred by raise");
+       else
+          for I in 1 .. Array_Size loop
+            Left(I).Real := - Right(I).Real;
+            Left(I).Imag := - Right(I).Imag;
+         end loop;
+       end if;
+ 
+    exception
+       when Inverse_Error  => 
+          TC_Handled_In_Grandchild_Pkg_Proc := true;
+          Left := Result;
+          raise;     -- Reraise the Inverse_Error exception in the subtest.
+          Report.Failed ("Exception not reraised in handler");
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in procedure Inverse");
+    end Inverse;
+ 
+ end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
+ 
+ --=======================================================================--
+ 
+ with FA11D00.CA11D02_0.CA11D02_1;    -- Array_Complex,
+                                      -- implicitly with Basic_Complex.
+ with Report;
+ 
+ procedure CA11D02 is
+ 
+    package Complex_Pkg renames FA11D00;
+    package Array_Complex_Pkg renames FA11D00.CA11D02_0.CA11D02_1;
+ 
+    use Complex_Pkg;                            
+    use Array_Complex_Pkg;                      
+ 
+ begin
+ 
+    Report.Test ("CA11D02", "Check that an exception declared in a package " &
+                 "can be raised by a child of a child package");
+ 
+    Multiply_Complex_Subtest:
+    declare
+       Operand_1  : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (3)), 
+                       Int_Type (Report.Ident_Int (5))),
+                       Complex (Int_Type (Report.Ident_Int (2)), 
+                       Int_Type (Report.Ident_Int (8))) );
+       Operand_2  : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (1)), 
+                       Int_Type (Report.Ident_Int (2))),
+                       Complex (Int_Type (Report.Ident_Int (3)), 
+                       Int_Type (Report.Ident_Int (6))) );
+       Operand_3  : Complex_Array_Type := ( Zero, Zero);
+       Mul_Result : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (3)), 
+                       Int_Type (Report.Ident_Int (10))),
+                       Complex (Int_Type (Report.Ident_Int (6)), 
+                       Int_Type (Report.Ident_Int (48))) );
+       Complex_No : Complex_Array_Type := (others => Zero);
+ 
+    begin
+       If (Multiply (Operand_1, Operand_2) /= Mul_Result) then
+          Report.Failed ("Incorrect results from multiplication");
+       end if;
+ 
+       -- Error is raised and exception will be handled in grandchild package.
+ 
+       Complex_No := Multiply (Operand_1, Operand_3);
+ 
+       if Complex_No /= (Zero, Zero) then
+          Report.Failed ("Exception was not raised in multiplication");
+       end if;
+ 
+    exception
+       when Multiply_Error     =>
+          Report.Failed ("Exception raised in multiplication and " &
+                         "propagated to caller");
+          TC_Handled_In_Grandchild_Pkg_Func := false;  
+               -- Improper exception handling in caller.
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in multiplication");
+          TC_Handled_In_Grandchild_Pkg_Func := false;  
+               -- Improper exception handling in caller.
+ 
+    end Multiply_Complex_Subtest;
+ 
+ 
+    Add_Complex_Subtest:
+    declare
+       Operand_1  : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (2)), 
+                       Int_Type (Report.Ident_Int (7))),
+                       Complex (Int_Type (Report.Ident_Int (5)), 
+                       Int_Type (Report.Ident_Int (8))) );
+       Operand_2  : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (4)), 
+                       Int_Type (Report.Ident_Int (1))),
+                       Complex (Int_Type (Report.Ident_Int (2)), 
+                       Int_Type (Report.Ident_Int (3))) );
+       Operand_3  : Complex_Array_Type := ( Zero, Zero);
+       Add_Result : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (6)), 
+                       Int_Type (Report.Ident_Int (8))),
+                       Complex (Int_Type (Report.Ident_Int (7)), 
+                       Int_Type (Report.Ident_Int (11))) );
+       Complex_No : Complex_Array_Type := (others => Zero);
+ 
+    begin
+       Complex_No := Add (Operand_1, Operand_2);
+ 
+       If (Complex_No /= Add_Result) then
+          Report.Failed ("Incorrect results from addition");
+       end if;
+ 
+       -- Error is raised in grandchild package and exception 
+       -- will be propagated to caller.
+ 
+       Complex_No := Add (Operand_1, Operand_3);
+ 
+       if Complex_No = Add_Result then
+          Report.Failed ("Exception was not raised in addition");
+       end if;
+ 
+    exception
+       when Add_Error => 
+          TC_Propagated_To_Caller := true;  -- Exception is propagated.
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in addition subtest");
+          TC_Propagated_To_Caller := false;  -- Improper exception handling
+                                             -- in caller.
+    end Add_Complex_Subtest;
+ 
+    Inverse_Complex_Subtest:
+    declare
+       Operand_1  : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (1)), 
+                       Int_Type (Report.Ident_Int (5))),
+                       Complex (Int_Type (Report.Ident_Int (3)), 
+                       Int_Type (Report.Ident_Int (11))) );
+       Operand_3  : Complex_Array_Type 
+                  := ( Zero, Complex (Int_Type (Report.Ident_Int (3)), 
+                       Int_Type (Report.Ident_Int (6))) );
+       Inv_Result : Complex_Array_Type 
+                  := ( Complex (Int_Type (Report.Ident_Int (-1)), 
+                       Int_Type (Report.Ident_Int (-5))),
+                       Complex (Int_Type (Report.Ident_Int (-3)), 
+                       Int_Type (Report.Ident_Int (-11))) );
+       Complex_No : Complex_Array_Type := (others => Zero);
+ 
+    begin
+       Inverse (Operand_1, Complex_No);
+ 
+       if (Complex_No /= Inv_Result) then
+          Report.Failed ("Incorrect results from inverse");
+       end if;
+ 
+       -- Error is raised in grandchild package and exception 
+       -- will be handled/reraised to caller.
+ 
+       Inverse (Operand_3, Complex_No);
+ 
+       Report.Failed ("Exception was not handled in inverse");
+ 
+    exception
+       when Inverse_Error => 
+          if not TC_Handled_In_Grandchild_Pkg_Proc then
+             Report.Failed ("Exception was not raised in inverse");
+          else
+             TC_Handled_In_Caller := true;  -- Exception is reraised from
+                                            -- child package.
+          end if;
+ 
+       when others => 
+          Report.Failed ("Unexpected exception in inverse");
+          TC_Handled_In_Caller := false; 
+                 -- Improper exception handling in caller.
+ 
+    end Inverse_Complex_Subtest;
+ 
+    if not (TC_Handled_In_Caller               and   -- Check to see that all 
+            TC_Handled_In_Grandchild_Pkg_Proc  and   -- exceptions were handled
+            TC_Handled_In_Grandchild_Pkg_Func  and   -- in proper location.
+            TC_Propagated_To_Caller)        
+    then
+       Report.Failed ("Exceptions handled in incorrect locations");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11D02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca11d03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca11d03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,174 ----
+ -- CA11D03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an exception declared in a package can be raised by a 
+ --      client of a child of the package.  Check that it can be renamed in 
+ --      the client of the child of the package and raised with the correct 
+ --      effect.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package which defines complex number abstraction with
+ --      user-defined exceptions (foundation code).
+ --
+ --      Add a public child package to the above package. Declare two 
+ --      subprograms for the parent type.  
+ --
+ --      In the main program, "with" the child package, then check that
+ --      an exception can be raised and handled as expected.  
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         FA11D00.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Child package of FA11D00.
+ package FA11D00.CA11D03_0 is     -- Basic_Complex
+ 
+    function "+" (Left, Right : Complex_Type) 
+      return Complex_Type;                   -- Add two complex numbers.
+ 
+    function "*" (Left, Right : Complex_Type) 
+      return Complex_Type;                   -- Multiply two complex numbers.
+ 
+ end FA11D00.CA11D03_0;     -- Basic_Complex
+ 
+ --=======================================================================--
+ 
+ package body FA11D00.CA11D03_0 is     -- Basic_Complex
+ 
+    function "+" (Left, Right : Complex_Type) return Complex_Type is
+    begin
+       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
+    end "+";
+    --------------------------------------------------------------
+    function "*" (Left, Right : Complex_Type) return Complex_Type is
+    begin
+       return ( Real => (Left.Real * Right.Real),
+                Imag => (Left.Imag * Right.Imag) );
+    end "*";
+ 
+ end FA11D00.CA11D03_0;     -- Basic_Complex
+ 
+ --=======================================================================--
+ 
+ with FA11D00.CA11D03_0;    -- Basic_Complex,
+                            -- implicitly with Complex_Definition.
+ with Report;
+ 
+ procedure CA11D03 is
+ 
+    package Complex_Pkg renames FA11D00;     -- Complex_Definition_Pkg
+    package Basic_Complex_Pkg renames FA11D00.CA11D03_0;   -- Basic_Complex
+ 
+    use Complex_Pkg;                            
+    use Basic_Complex_Pkg;           
+            
+    TC_Handled_In_Subtest_1,
+    TC_Handled_In_Subtest_2 : boolean := false;
+ 
+ begin
+ 
+    Report.Test ("CA11D03", "Check that an exception declared in a package " &
+                 "can be raised by a client of a child of the package");
+ 
+    Multiply_Complex_Subtest:
+    declare
+       Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
+                                    Int_Type (Report.Ident_Int (2)));  
+                                    -- Referenced to function in parent package.
+       Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (10)), 
+                                    Int_Type (Report.Ident_Int (8)));  
+       Mul_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (30)), 
+                                    Int_Type (Report.Ident_Int (16)));  
+       Complex_No : Complex_Type := Zero;  -- Zero is declared in parent package.
+    begin
+       Complex_No := Operand_1 * Operand_2;   -- Basic_Complex."*".
+       if Complex_No /= Mul_Res then
+          Report.Failed ("Incorrect results from multiplication");
+       end if;
+ 
+       -- Error is raised and exception will be handled.
+       if Complex_No = Mul_Res then
+          raise Multiply_Error;             -- Reference to exception in
+       end if;                              -- parent package.
+ 
+    exception
+       when Multiply_Error => 
+          TC_Handled_In_Subtest_1 := true;
+       when others => 
+          TC_Handled_In_Subtest_1 := false;  -- Improper exception handling.
+ 
+    end Multiply_Complex_Subtest;
+ 
+    Add_Complex_Subtest:
+    declare
+       Error_In_Client : exception renames Add_Error;  
+                         -- Reference to exception in parent package.
+       Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 
+                                    Int_Type (Report.Ident_Int (7)));  
+       Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (-4)), 
+                                    Int_Type (Report.Ident_Int (1)));  
+       Add_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (-2)), 
+                                    Int_Type (Report.Ident_Int (8)));  
+       Complex_No : Complex_Type := One;   -- One is declared in parent 
+                                           -- package.
+    begin
+       Complex_No := Operand_1 + Operand_2;   -- Basic_Complex."+".
+ 
+       if Complex_No /= Add_Res then
+          Report.Failed ("Incorrect results from multiplication");
+       end if;
+ 
+       -- Error is raised and exception will be handled.
+       if Complex_No = Add_Res then
+          raise Error_In_Client;
+       end if;
+ 
+    exception
+       when Error_In_Client => 
+          TC_Handled_In_Subtest_2 := true;
+ 
+       when others => 
+          TC_Handled_In_Subtest_2 := false;  -- Improper exception handling.
+ 
+    end Add_Complex_Subtest;
+ 
+    if not (TC_Handled_In_Subtest_1           and   -- Check to see that all 
+            TC_Handled_In_Subtest_2)                -- exceptions were handled
+                                                    -- in the proper location.
+    then
+       Report.Failed ("Exceptions handled in incorrect locations");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA11D03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,370 ----
+ -- CA13001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a separate protected unit declared in a non-generic child 
+ --      unit of a private parent have the same visibility into its parent, 
+ --      its siblings, and packages on which its parent depends as is available 
+ --      at the point of their declaration.
+ --
+ -- TEST DESCRIPTION:
+ --      A scenario is created that demonstrates the potential of having all
+ --      members of one family to take out a transportation.  The restriction
+ --      is depend on each member to determine who can get a car, a clunker, 
+ --      or a bicycle.  If no transportation is available, that member has to
+ --      walk.  
+ --      
+ --      Declare a package with location for each family member.  Declare
+ --      a public parent package.  Declare a private child package. Declare a 
+ --      public grandchild of this private package.  Declare a protected unit 
+ --      as a subunit in a public grandchild package.  This subunit has 
+ --      visibility into it's parent body ancestor and its sibling.
+ --
+ --      Declare another public parent package.  The body of this package has
+ --      visibility into its private sibling's descendants.
+ --
+ --      In the main program, "with"s the parent package.  Check that the
+ --      protected subunit performs as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+ --
+ --!
+ 
+ package CA13001_0 is                    
+ 
+    type Location is (School, Work, Beach, Home);
+    type Family is (Father, Mother, Teen);
+    Destination : array (Family) of Location;
+ 
+    -- Other type definitions and procedure declarations in real application.
+ 
+ end CA13001_0;
+ 
+ -- No bodies required for CA13001_0.
+ 
+      --==================================================================--
+ 
+ -- Public parent.
+ 
+ package CA13001_1 is                     
+ 
+    type Transportation is (Bicycle, Clunker, New_Car);
+    type Key_Type is private;
+    Walking : boolean := false;
+ 
+    -- Other type definitions and procedure declarations in real application.
+ 
+ private
+    type Key_Type 
+      is range Transportation'pos(Bicycle) .. Transportation'pos(New_Car);
+ 
+ end CA13001_1;
+ 
+ -- No bodies required for CA13001_1.
+ 
+      --==================================================================--
+ 
+ -- Private child. 
+ 
+ private package CA13001_1.CA13001_2 is       
+ 
+    type Transport is
+       record
+          In_Use : boolean := false;
+       end record;
+    Vehicles : array (Transportation) of Transport;
+ 
+    -- Other type definitions and procedure declarations in real application.
+ 
+ end CA13001_1.CA13001_2;
+ 
+ -- No bodies required for CA13001_1.CA13001_2.
+ 
+      --==================================================================--
+ 
+ -- Public grandchild of a private parent.
+ 
+ package CA13001_1.CA13001_2.CA13001_3 is
+ 
+    Flat_Tire : array (Transportation) of boolean := (others => false);
+ 
+    -- Other type definitions and procedure declarations in real application.
+ 
+ end CA13001_1.CA13001_2.CA13001_3;
+ 
+ -- No bodies required for CA13001_1.CA13001_2.CA13001_3.
+ 
+      --==================================================================--
+ 
+ -- Context clauses required for visibility needed by a separate subunit.
+ 
+ with CA13001_0;                           
+ use  CA13001_0;
+ 
+ -- Public grandchild of a private parent.
+ 
+ package CA13001_1.CA13001_2.CA13001_4 is
+ 
+    type Transit is
+       record
+          Available : boolean := false;
+       end record;
+    type Keys_Array is array (Transportation) of Transit;
+    Fuel : array (Transportation) of boolean := (others => true);
+ 
+    protected Family_Transportation is
+ 
+       procedure Get_Vehicle (Who : in     Family;
+                              Key :    out Key_Type);
+       procedure Return_Vehicle (Tr : in Transportation);
+       function TC_Verify (What : Transportation) return boolean;
+ 
+    private
+       Keys : Keys_Array;
+ 
+    end Family_Transportation;
+ 
+ end CA13001_1.CA13001_2.CA13001_4;
+ 
+      --==================================================================--
+ 
+ -- Context clause required for visibility needed by a separate subunit.
+ 
+ with CA13001_1.CA13001_2.CA13001_3;    -- Public sibling.
+ 
+ package body CA13001_1.CA13001_2.CA13001_4 is
+ 
+    protected body Family_Transportation is separate;
+ 
+ end CA13001_1.CA13001_2.CA13001_4;
+ 
+      --==================================================================--
+ 
+ separate (CA13001_1.CA13001_2.CA13001_4)
+ protected body Family_Transportation is
+ 
+    procedure Get_Vehicle (Who : in     Family;
+                           Key :    out Key_Type) is
+    begin
+       case Who is
+          when Father|Mother => 
+             -- Drive new car to work
+ 
+             -- Reference package with'ed by the subunit parent's body.
+             if Destination(Who) = Work then
+ 
+                -- Reference type declared in the private parent of the subunit
+                -- parent's body.
+                -- Reference type declared in the visible part of the 
+                -- subunit parent's body.
+                if not Vehicles(New_Car).In_Use and Fuel(New_Car) 
+ 
+                  -- Reference type declared in the public sibling of the 
+                  -- subunit parent's body.
+                  and not CA13001_1.CA13001_2.CA13001_3.Flat_Tire(New_Car) then
+                     Vehicles(New_Car).In_Use := true;
+ 
+                     -- Reference type declared in the private part of the 
+                     -- protected subunit.
+                     Keys(New_Car).Available := false;
+                     Key                     := Transportation'pos(New_Car);
+                else
+                  -- Reference type declared in the grandparent of the subunit
+                  -- parent's body.
+                  Walking := true;
+                end if;
+ 
+             -- Drive clunker to other destinations.
+             else
+                if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not 
+                  CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
+                     Vehicles(Clunker).In_Use := true;
+                     Keys(Clunker).Available  := false;
+                     Key                      := Transportation'pos(Clunker);
+                else
+                  Walking := true;
+                  Key     := Transportation'pos(Bicycle);
+                end if;
+             end if;
+     
+          -- Similar for Teen.
+          when Teen => 
+             if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not 
+               CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
+                  Vehicles(Clunker).In_Use := true;
+                  Keys(Clunker).Available  := false;
+                  Key                      := Transportation'pos(Clunker);
+             else
+                Walking := true;
+                Key     := Transportation'pos(Bicycle);
+             end if;
+       end case;
+ 
+    end Get_Vehicle;
+ 
+    ----------------------------------------------------------------
+ 
+    -- Any family member can bring back the transportation with the key.
+ 
+    procedure Return_Vehicle (Tr : in Transportation) is
+    begin
+       Vehicles(Tr).In_Use := false;
+       Keys(Tr).Available  := true;
+    end Return_Vehicle;
+ 
+    ----------------------------------------------------------------
+ 
+    function TC_Verify (What : Transportation) return boolean is
+    begin
+       return Keys(What).Available;
+    end TC_Verify;
+    
+ end Family_Transportation;
+ 
+      --==================================================================--
+ 
+ with CA13001_0;
+ use  CA13001_0;
+ 
+ -- Public child.
+ 
+ package CA13001_1.CA13001_5 is
+ 
+    -- In a real application, tasks could be used to demonstrate 
+    -- a family transportation scenario, i.e., each member of
+    -- a family can take a vehicle out concurrently, then return
+    -- them at the same time. For the purposes of the test, family
+    -- transportation happens sequentially.
+ 
+    procedure Provide_Transportation (Who     : in     Family;
+                                      Get_Key :    out Key_Type;
+                                      Get_Veh :    out boolean);
+    procedure Return_Transportation (What   : in     Transportation;
+                                     Rt_Veh :    out boolean);
+ 
+ end CA13001_1.CA13001_5;
+ 
+      --==================================================================--
+ 
+ with CA13001_1.CA13001_2.CA13001_4;   -- Public grandchild of a private parent,
+                                       -- implicitly with CA13001_1.CA13001_2.
+ package body CA13001_1.CA13001_5 is
+ 
+    package Transportation_Pkg renames CA13001_1.CA13001_2.CA13001_4;
+    use Transportation_Pkg;
+ 
+    -- These two validation subprograms provide the capability to check the 
+    -- components defined in the private packages from within the client 
+    -- program.
+ 
+    procedure Provide_Transportation (Who     : in     Family;
+                                      Get_Key :    out Key_Type;
+                                      Get_Veh :    out boolean) is
+    begin
+       -- Goto work, school, or to the beach.
+       Family_Transportation.Get_Vehicle (Who, Get_Key);
+       if not Family_Transportation.TC_Verify 
+         (Transportation'Val(Get_Key)) then
+            Get_Veh := true;
+       else
+          Get_Veh := false;
+       end if;
+ 
+    end Provide_Transportation;
+ 
+    ----------------------------------------------------------------
+ 
+    procedure Return_Transportation (What   : in     Transportation;
+                                     Rt_Veh :    out boolean) is
+    begin
+       Family_Transportation.Return_Vehicle (What);
+       if Family_Transportation.TC_Verify(What) and 
+         not CA13001_1.CA13001_2.Vehicles(What).In_Use then
+            Rt_Veh := true;
+       else
+          Rt_Veh := false;
+       end if;
+ 
+    end Return_Transportation;
+ 
+ end CA13001_1.CA13001_5;
+ 
+      --==================================================================--
+ 
+ with CA13001_0;
+ with CA13001_1.CA13001_5;        -- Implicitly with parent, CA13001_1.
+ with Report;
+ 
+ procedure CA13001 is
+ 
+    Mommy           : CA13001_0.Family := CA13001_0.Mother;
+    Daddy           : CA13001_0.Family := CA13001_0.Father;
+    BG              : CA13001_0.Family := CA13001_0.Teen;
+    BG_Clunker      : CA13001_1.Transportation := CA13001_1.Clunker;
+    Get_Key         : CA13001_1.Key_Type;
+    Get_Transit     : boolean := false;
+    Return_Transit  : boolean := false;
+ 
+ begin 
+    Report.Test ("CA13001", "Check that a protected subunit declared in " & 
+                 "a child unit of a private parent have the same visibility " &
+                 "into its parent, its parent's siblings, and packages on " &
+                 "which its parent depends");
+ 
+    -- Get transportation for mother to go to work.
+    CA13001_0.Destination(CA13001_0.Mother) := CA13001_0.Work;
+    CA13001_1.CA13001_5.Provide_Transportation (Mommy, Get_Key, Get_Transit);
+    if not Get_Transit then
+       Report.Failed ("Failed to get mother transportation");
+    end if;
+ 
+    -- Get transportation for teen to go to school.
+    CA13001_0.Destination(CA13001_0.Teen) := CA13001_0.School;
+    Get_Transit := false;
+    CA13001_1.CA13001_5.Provide_Transportation (BG, Get_Key, Get_Transit);
+    if not Get_Transit then
+       Report.Failed ("Failed to get teen transportation");
+    end if;
+ 
+    -- Get transportation for father to go to the beach.
+    CA13001_0.Destination(CA13001_0.Father) := CA13001_0.Beach;
+    Get_Transit := false;
+    CA13001_1.CA13001_5.Provide_Transportation (Daddy, Get_Key, Get_Transit);
+    if Get_Transit and not CA13001_1.Walking then
+       Report.Failed ("Failed to make daddy to walk to the beach");
+    end if;
+ 
+    -- Return the clunker.
+    CA13001_1.CA13001_5.Return_Transportation (BG_Clunker, Return_Transit);
+    if not Return_Transit then
+       Report.Failed ("Failed to get back the clunker");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA13001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,259 ----
+ -- CA13002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that two library child units and/or subunits may have the same 
+ --      simple names if they have distinct expanded names.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package that provides some primitive functionality (minimal
+ --      terminal driver operations in this case).  Add child packages to 
+ --      expand the functionality for different but related contexts (different
+ --      terminal kinds).  Add child packages, or subunits, to the children to
+ --      provide the same high level operation for each of the different 
+ --      contexts (terminals).  Since the operations are the same, at the leaf
+ --      level they are likely to have the same names.
+ --
+ --      The main program "with"s the child packages.  Check that the
+ --      child units and subunits perform as expected.  
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+    
+ -- Public parent.
+ package CA13002_0 is                     -- Terminal_Driver.
+ 
+    type TC_Name is (First_Child, Second_Child, Third_Child, Fourth_Child);
+    type TC_Call_From is (First_Grandchild, Second_Grandchild, First_Subunit, 
+                            Second_Subunit);
+    type TC_Calls_Arr is array (TC_Name, TC_Call_From) of boolean;
+    TC_Calls : TC_Calls_Arr := (others => (others => false));
+ 
+    -- In real application, Send_Control_Sequence sends keystrokes from
+    -- the terminal, i.e., space, escape, etc.
+    procedure Send_Control_Sequence (Row : in TC_Name;
+                                     Col : in TC_Call_From);
+ 
+ end CA13002_0;
+ 
+      --==================================================================--
+ 
+ -- First child.
+ package CA13002_0.CA13002_1 is           -- Terminal_Driver.VT100
+ 
+    -- Move cursor up, down, left, or right.
+    procedure Move_Cursor (Col : in TC_Call_From);
+ 
+ end CA13002_0.CA13002_1;
+ 
+      --==================================================================--
+ 
+ -- First grandchild.
+ procedure CA13002_0.CA13002_1.CA13002_5; -- Terminal_Driver.VT100.Cursor_Up
+ 
+      --==================================================================--
+ 
+ -- Second child.
+ package CA13002_0.CA13002_2 is           -- Terminal_Driver.IBM3270
+ 
+    procedure Move_Cursor (Col : in TC_Call_From);
+ 
+ end CA13002_0.CA13002_2;
+ 
+      --==================================================================--
+ 
+ -- Second grandchild.
+ procedure CA13002_0.CA13002_2.CA13002_5; -- Terminal_Driver.IBM3270.Cursor_Up
+ 
+      --==================================================================--
+ 
+ -- Third child.
+ package CA13002_0.CA13002_3 is           -- Terminal_Driver.DOS_ANSI
+ 
+    procedure Move_Cursor (Col : in TC_Call_From);
+ 
+    procedure CA13002_5;                  -- Terminal_Driver.DOS_ANSI.Cursor_Up
+                                          -- implementation will be as a 
+                                          -- separate subunit.
+ end CA13002_0.CA13002_3;
+ 
+      --==================================================================--
+ 
+ -- Fourth child.
+ package CA13002_0.CA13002_4 is           -- Terminal_Driver.WYSE
+ 
+    procedure Move_Cursor (Col : in TC_Call_From);
+ 
+    procedure CA13002_5;                  -- Terminal_Driver.WYSE.Cursor_Up
+                                          -- implementation will be as a 
+                                          -- separate subunit.
+ 
+ end CA13002_0.CA13002_4;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.
+ package body CA13002_0 is                  
+ 
+    procedure Send_Control_Sequence (Row : in TC_Name;
+                                     Col : in TC_Call_From) is
+    begin
+       -- Reads a key and takes action.
+       TC_Calls (Row, Col) := true;
+    end Send_Control_Sequence;
+ 
+ end CA13002_0;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.VT100.
+ package body CA13002_0.CA13002_1 is                     
+ 
+    procedure Move_Cursor (Col : in TC_Call_From) is
+    begin
+       Send_Control_Sequence (First_Child, Col);
+    end Move_Cursor;
+ 
+ end CA13002_0.CA13002_1;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.VT100.Cursor_Up.
+ procedure CA13002_0.CA13002_1.CA13002_5 is 
+ begin
+    Move_Cursor (First_Grandchild);        -- from Terminal_Driver.VT100.
+ end CA13002_0.CA13002_1.CA13002_5;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.IBM3270.
+ package body CA13002_0.CA13002_2 is                     
+ 
+    procedure Move_Cursor (Col : in TC_Call_From) is
+    begin
+       Send_Control_Sequence (Second_Child, Col);
+    end Move_Cursor;
+ 
+ end CA13002_0.CA13002_2;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.IBM3270.Cursor_Up.
+ procedure CA13002_0.CA13002_2.CA13002_5 is 
+ begin
+    Move_Cursor (Second_Grandchild);       -- from Terminal_Driver.IBM3270.
+ end CA13002_0.CA13002_2.CA13002_5;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.DOS_ANSI.
+ package body CA13002_0.CA13002_3 is                     
+ 
+    procedure Move_Cursor (Col : in TC_Call_From) is
+    begin
+       Send_Control_Sequence (Third_Child, Col);
+    end Move_Cursor;
+ 
+    procedure CA13002_5 is separate;
+ 
+ end CA13002_0.CA13002_3;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.DOS_ANSI.Cursor_Up.
+ separate (CA13002_0.CA13002_3)
+ procedure CA13002_5 is 
+ begin
+    Move_Cursor (First_Subunit);           -- from Terminal_Driver.DOS_ANSI.
+ end CA13002_5;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.WYSE.
+ package body CA13002_0.CA13002_4 is                     
+ 
+    procedure Move_Cursor (Col : in TC_Call_From) is
+    begin
+       Send_Control_Sequence (Fourth_Child, Col);
+    end Move_Cursor;
+ 
+    procedure CA13002_5 is separate;
+ 
+ end CA13002_0.CA13002_4;
+ 
+      --==================================================================--
+ 
+ -- Terminal_Driver.WYSE.Cursor_Up.
+ separate (CA13002_0.CA13002_4)
+ procedure CA13002_5 is 
+ begin
+    Move_Cursor (Second_Subunit);          -- from Terminal_Driver.WYSE.
+ end CA13002_5;
+ 
+      --==================================================================--
+ 
+ with CA13002_0.CA13002_1.CA13002_5;     -- Terminal_Driver.VT100.Cursor_Up,
+                                         -- implicitly with parent, CA13002_0.
+ with CA13002_0.CA13002_2.CA13002_5;     -- Terminal_Driver.IBM3270.Cursor_Up.
+ with CA13002_0.CA13002_3;               -- Terminal_Driver.DOS_ANSI.
+ with CA13002_0.CA13002_4;               -- Terminal_Driver.WYSE.
+ with Report;
+ use  CA13002_0;                         -- All primitive subprograms directly
+                                         -- visible.
+ 
+ procedure CA13002 is
+    Expected_Calls : constant CA13002_0.TC_Calls_Arr 
+                   := ((true,  false, false, false),
+                       (false, true , false, false),
+                       (false, false, true , false),
+                       (false, false, false, true ));
+ begin
+    Report.Test ("CA13002", "Check that two library units and/or subunits " &
+                 "may have the same simple names if they have distinct " &
+                 "expanded names");
+ 
+    -- Note that the leaves all have the same name.
+    -- Call the first grandchild.
+    CA13002_0.CA13002_1.CA13002_5;       
+ 
+    -- Call the second grandchild.
+    CA13002_0.CA13002_2.CA13002_5;
+ 
+    -- Call the first subunit.
+    CA13002_0.CA13002_3.CA13002_5;
+ 
+    -- Call the second subunit.
+    CA13002_0.CA13002_4.CA13002_5;
+ 
+    if TC_Calls /= Expected_Calls then
+       Report.Failed ("Wrong result");
+    end if;  
+ 
+    Report.Result;
+ 
+ end CA13002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,256 ----
+ -- CA13003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that separate subunits which share an ancestor may have the
+ --      same name if they have different fully qualified names.  Check
+ --      the case of separate subunits of separate subunits.
+ --      This test is a change in semantics from Ada 83 to Ada 9X.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package that provides file processing operations.  Declare
+ --      one separate package to do the file processing, and another to do the
+ --      auditing.  These packages contain similar functions declared in 
+ --      separate subunits.  Verify that the main program can call the 
+ --      separate subunits with the same name.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Simulates a file processing application.  The processing package opens
+ -- files, reads files, does file processing, and generates reports.
+ -- The auditing package opens files, read files, and generates reports.
+ 
+ package CA13003_0 is       
+ 
+    type File_ID is range 1 .. 100;
+    subtype File_Name is string (1 .. 10);
+ 
+    TC_Open_For_Process    : boolean := false;
+    TC_Open_For_Audit      : boolean := false;
+    TC_Report_From_Process : boolean := false;
+    TC_Report_From_Audit   : boolean := false;
+ 
+    type File_Rec is 
+       record
+          Name : File_Name;
+          ID   : File_ID;
+       end record;
+ 
+    procedure Initialize_File_Rec (Name_In : in     File_Name;
+                                   ID_In   : in     File_ID;
+                                   File_In :    out File_Rec);
+  
+    ----------------------------------------------------------------------
+ 
+    package CA13003_1 is    -- File processing
+ 
+       procedure CA13003_3;                             -- Open files
+       function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+         return File_Name;                              -- Process files
+       package CA13003_5 is                             -- Generate report
+          procedure Generate_Report;
+       end CA13003_5;
+ 
+    end CA13003_1;
+ 
+    ----------------------------------------------------------------------
+ 
+    package CA13003_2 is    -- File auditing
+ 
+       procedure CA13003_3;                             -- Open files
+       function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+         return File_Name;                              -- Process files
+       package CA13003_5 is                             -- Generate report
+          procedure Generate_Report;
+       end CA13003_5;
+ 
+    end CA13003_2;
+ 
+ end CA13003_0;
+ 
+      --==================================================================--
+ 
+ package body CA13003_0 is       
+ 
+    procedure Initialize_File_Rec (Name_In : in     File_Name;
+                                   ID_In   : in     File_ID;
+                                   File_In :    out File_Rec) is
+    -- Not a real initialization.  Real application can use file
+    -- database to create the file record.
+    begin
+       File_In.Name := Name_In;
+       File_In.ID   := ID_In;
+    end Initialize_File_Rec;
+ 
+    package body CA13003_1 is separate;
+    package body CA13003_2 is separate;
+ 
+ end CA13003_0;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0)
+ package body CA13003_1 is
+ 
+    procedure CA13003_3 is separate;                 -- Open files
+    function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+      return File_Name is separate;                  -- Process files
+    package body CA13003_5 is separate;              -- Generate report
+ 
+ end CA13003_1;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0.CA13003_1)
+ procedure CA13003_3 is                              -- Open files
+ begin
+    -- In real file processing application, open file from database, setup
+    -- data structure, etc.
+    TC_Open_For_Process := true;
+ end CA13003_3;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0.CA13003_1)
+ function CA13003_4 (ID_In : File_ID;                -- Process files
+                     File_In : File_Rec) return File_Name is 
+ begin
+    -- In real file processing application, process files for more information.
+    return File_In.Name;
+ end CA13003_4;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0.CA13003_1)
+ package body CA13003_5 is                           -- Generate report
+    procedure Generate_Report is
+    begin
+       -- In real file processing application, generate various report from the
+       -- file database.
+       TC_Report_From_Process := true;
+    end Generate_Report;
+ 
+ end CA13003_5;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0)
+ package body CA13003_2 is
+ 
+    procedure CA13003_3 is separate;                 -- Open files
+    function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+      return File_Name is separate;                  -- Process files
+    package body CA13003_5 is separate;              -- Generate report
+ 
+ end CA13003_2;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0.CA13003_2)
+ procedure CA13003_3 is                              -- Open files
+ begin
+    TC_Open_For_Audit := true;
+ end CA13003_3;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0.CA13003_2)
+ function CA13003_4 (ID_In : File_ID; 
+                     File_In : File_Rec) return File_Name is 
+ begin
+    return File_In.Name;
+ end CA13003_4;
+ 
+      --==================================================================--
+ 
+ separate (CA13003_0.CA13003_2)
+ package body CA13003_5 is                           -- Generate report
+    procedure Generate_Report is
+    begin
+       TC_Report_From_Audit := true;
+    end Generate_Report;
+ 
+ end CA13003_5;
+ 
+      --==================================================================--
+ 
+ with CA13003_0;
+ with Report;
+ 
+ procedure CA13003 is
+    First_File_Name  : CA13003_0.File_Name := "Joe Smith ";
+    First_File_Id    : CA13003_0.File_ID   := 11;
+    Second_File_Name : CA13003_0.File_Name := "John Schep";
+    Second_File_Id   : CA13003_0.File_ID   := 47;
+    Expected_Name    : CA13003_0.File_Name := "          ";
+    Student_File     : CA13003_0.File_Rec;
+    
+    function Process_Input_Files (ID_In   : CA13003_0.File_ID; 
+                                  File_In : CA13003_0.File_Rec) return 
+      CA13003_0.File_Name renames CA13003_0.CA13003_1.CA13003_4;
+ 
+    function Process_Audit_Files (ID_In   : CA13003_0.File_ID; 
+                                  File_In : CA13003_0.File_Rec) return 
+      CA13003_0.File_Name renames CA13003_0.CA13003_2.CA13003_4;
+ begin
+    Report.Test ("CA13003", "Check that separate subunits which share " &
+                 "an ancestor may have the same name if they have " &
+                 "different fully qualified names");
+ 
+    Student_File := (ID => First_File_Id, Name => First_File_Name);
+ 
+    -- Note that all subunits have the same simple name.
+    -- Generate report from file processing.
+    CA13003_0.CA13003_1.CA13003_3;
+    Expected_Name := Process_Input_Files (First_File_Id, Student_File);
+    CA13003_0.CA13003_1.CA13003_5.Generate_Report;
+ 
+    if not CA13003_0.TC_Open_For_Process or 
+      not CA13003_0.TC_Report_From_Process or 
+        Expected_Name /= First_File_Name then
+          Report.Failed ("Unexpected results in processing file");
+    end if;
+ 
+    CA13003_0.Initialize_File_Rec 
+      (Second_File_Name, Second_File_Id, Student_File);
+ 
+    -- Generate report from file auditing.
+    CA13003_0.CA13003_2.CA13003_3;
+    Expected_Name := Process_Audit_Files (Second_File_Id, Student_File);
+    CA13003_0.CA13003_2.CA13003_5.Generate_Report;
+ 
+    if not CA13003_0.TC_Open_For_Audit or 
+      not CA13003_0.TC_Report_From_Audit or 
+        Expected_Name /= Second_File_Name then
+          Report.Failed ("Unexpected results in auditing file");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA13003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,320 ----
+ -- CA13A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that subunits declared in non-generic child units of a public 
+ --      parent have the same visibility into its parent, its siblings 
+ --      (public and private), and packages on which its parent depends 
+ --      as is available at the point of their declaration.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an check system procedure as a subunit in a private child 
+ --      package of the basic operation package (FA13A00.A).  This procedure 
+ --      has visibility into its parent ancestor and its private sibling.
+ --
+ --      Declare an emergency procedure as a subunit in a public child package
+ --      of the basic operation package (FA13A00.A).  This procedure has 
+ --      visibility into its parent ancestor and its private sibling. 
+ --
+ --      Declare an express procedure as a subunit in a public child subprogram
+ --      of the basic operation package (FA13A00.A).  This procedure has 
+ --      visibility into its parent ancestor and its public sibling. 
+ --
+ --      In the main program, "with"s the child package and subprogram.  Check 
+ --      that subunits perform as expected.  
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FA13A00.A
+ --         CA13A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Private child package of an elevator application.  This package
+ -- provides maintenance operations.
+ 
+ private package FA13A00_1.CA13A01_4 is    -- Maintenance operation
+ 
+    One_Floor : Floor_No := 1;             -- Type declared in parent.
+ 
+    procedure Check_System;
+ 
+    -- other type definitions and procedure declarations in real application.
+ 
+ end FA13A00_1.CA13A01_4;
+ 
+      --==================================================================--
+ 
+ -- Context clauses required for visibility needed by separate subunit.
+ 
+ with FA13A00_0;                           -- Building Manager
+ 
+ with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
+                                          
+ with FA13A00_1.FA13A00_3;                 -- Move Elevator
+ 
+ use  FA13A00_0;                           
+ 
+ package body FA13A00_1.CA13A01_4 is              
+ 
+    procedure Check_System is separate;
+ 
+ end FA13A00_1.CA13A01_4;
+ 
+      --==================================================================--
+ 
+ separate (FA13A00_1.CA13A01_4)
+ 
+ -- Subunit Check_System declared in Maintenance Operation.
+ 
+ procedure Check_System is
+ begin
+    -- See if regular power is on.
+ 
+    if Power /= V120 then                  -- Reference package with'ed by
+       TC_Operation := false;              -- the subunit parent's body.
+    end if;
+ 
+    -- Test elevator function.
+ 
+    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of
+      (Penthouse, Call_Waiting);           -- the subunit parent's body.
+ 
+    if not Call_Waiting (Penthouse) then   -- Reference private part of the
+       TC_Operation := false;              -- parent of the subunit package's 
+                                           -- body.
+    end if;
+ 
+    FA13A00_1.FA13A00_2.Down (One_Floor);  -- Reference private sibling of
+                                           -- the subunit parent's body.
+ 
+    if Current_Floor /= Floor'pred (Penthouse) then 
+       TC_Operation := false;              -- Reference type declared in the
+    end if;                                -- parent of the subunit parent's
+                                           -- body.
+ 
+ end Check_System;
+ 
+      --==================================================================--
+ 
+ -- Public child package of an elevator application.  This package provides
+ -- an emergency operation.
+ 
+ package FA13A00_1.CA13A01_5 is            -- Emergency Operation
+ 
+    -- Other type definitions in real application.
+ 
+    procedure Emergency;
+ 
+ private
+    type Bell_Type is (Inactive, Active);
+ 
+ end FA13A00_1.CA13A01_5;
+ 
+      --==================================================================--
+ 
+ -- Context clauses required for visibility needed by separate subunit.
+ 
+ with FA13A00_0;                           -- Building Manager
+ 
+ with FA13A00_1.FA13A00_3;                 -- Move Elevator
+ 
+ with FA13A00_1.CA13A01_4;                 -- Maintenance Operation (private)
+ 
+ use  FA13A00_0;
+ 
+ package body FA13A00_1.CA13A01_5 is              
+ 
+    procedure Emergency is separate;
+ 
+ end FA13A00_1.CA13A01_5;
+ 
+      --==================================================================--
+ 
+ separate (FA13A00_1.CA13A01_5)
+ 
+ -- Subunit Emergency declared in Maintenance Operation.
+ 
+ procedure Emergency is
+    Bell : Bell_Type;                      -- Reference type declared in the 
+                                           -- subunit parent's body.
+ 
+ begin
+    -- Calls maintenance operation.
+ 
+    FA13A00_1.CA13A01_4.Check_System;      -- Reference private sibling of the
+                                           -- subunit parent 's body.
+ 
+    -- Clear all calls to the elevator.
+ 
+    Clear_Calls (Call_Waiting);            -- Reference subprogram declared
+                                           -- in the parent of the subunit
+                                           -- parent's body.
+    for I in Floor loop                    
+       if Call_Waiting (I) then            -- Reference private part of the
+         TC_Operation := false;            -- parent of the subunit parent's
+       end if;                             -- body.
+    end loop;
+ 
+    -- Move elevator to the basement.
+ 
+    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
+      (Basement, Call_Waiting);            -- subunit parent's body.
+ 
+    if Current_Floor /= Basement then      -- Reference type declared in the
+       TC_Operation := false;              -- parent of the subunit parent's
+    end if;                                -- body.
+ 
+    -- Shut off power.
+ 
+    Power := Off;                          -- Reference package with'ed by
+                                           -- the subunit parent's body.
+ 
+    -- Activate bell.
+ 
+    Bell := Active;                        -- Reference type declared in the 
+                                           -- subunit parent's body. 
+ 
+ end Emergency;
+ 
+      --==================================================================--
+ 
+ -- Public child subprogram of an elevator application.  This subprogram 
+ -- provides an express operation.
+ 
+ procedure FA13A00_1.CA13A01_6;
+ 
+      --==================================================================--
+ 
+ -- Context clauses required for visibility needed by separate subunit.
+ 
+ with FA13A00_0;                           -- Building Manager
+ 
+ with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
+ 
+ with FA13A00_1.FA13A00_3;                 -- Move Elevator
+ 
+ use  FA13A00_0;
+ 
+ procedure FA13A00_1.CA13A01_6 is          -- Express Operation
+ 
+    -- Other type definitions in real application.
+ 
+    procedure GoTo_Penthouse is separate;
+ 
+ begin
+    GoTo_Penthouse;
+ 
+ end FA13A00_1.CA13A01_6;
+ 
+      --==================================================================--
+ 
+ separate (FA13A00_1.CA13A01_6)
+ 
+ -- Subunit GoTo_Penthouse declared in Express Operation.
+ 
+ procedure GoTo_Penthouse is
+ begin
+    -- Go faster.
+ 
+    Power := V240;                         -- Reference package with'ed by
+                                           -- the subunit parent's body. 
+ 
+    -- Call elevator.
+ 
+    Call (Penthouse, Call_Waiting);        -- Reference subprogram declared in
+                                           -- the parent of the subunit 
+                                           -- parent's body.
+ 
+    if not Call_Waiting (Penthouse) then   -- Reference private part of the
+       TC_Operation := false;              -- parent of the subunit parent's
+    end if;                                -- body.
+ 
+    -- Move elevator to Penthouse.
+ 
+    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
+      (Penthouse, Call_Waiting);           -- subunit parent's body.
+ 
+    if Current_Floor /= Penthouse then     -- Reference type declared in the
+       TC_Operation := false;              -- parent of the subunit parent's
+    end if;                                -- body.
+ 
+    -- Return slowly
+ 
+    while Current_Floor /= Floor1 loop     -- Reference type, subprogram 
+       FA13A00_1.FA13A00_2.Down (1);       -- declared in the parent of the
+                                           -- subunit parent's body.
+    end loop;
+ 
+    if Current_Floor /= Floor1 then        -- Reference type declared in
+       TC_Operation := false;              -- the parent of the subunit
+    end if;                                -- parent's body.
+ 
+    -- Back to normal.
+                                           
+    Power := V120;                         -- Reference package with'ed by
+                                           -- the subunit parent's body.
+ 
+ end GoTo_Penthouse;
+ 
+      --==================================================================--
+ 
+ with FA13A00_1.CA13A01_5;                 -- Emergency Operation
+                                           -- implicitly with Basic Elevator
+                                           -- Operations
+ 
+ with FA13A00_1.CA13A01_6;                 -- Express Operation
+ 
+ with Report;
+ 
+ procedure CA13A01 is
+ 
+ begin
+ 
+    Report.Test ("CA13A01", "Check that subunits declared in non-generic " &
+                 "child units of a public parent have the same visibility " &
+                 "into its parent, its parent's siblings, and packages on " &
+                 "which its parent depends");
+ 
+    -- Go to Penthouse.
+ 
+    FA13A00_1.CA13A01_6;
+ 
+    -- Call emergency operation.
+ 
+    FA13A00_1.CA13A01_5.Emergency;
+ 
+    if not FA13A00_1.TC_Operation then
+       Report.Failed ("Incorrect elevator operation");
+    end if;
+ 
+    Report.Result;
+ 
+ end CA13A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca13a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca13a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,301 ----
+ -- CA13A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that subunits declared in generic child units of a public 
+ --      parent have the same visibility into its parent, its siblings 
+ --      (public and private), and packages on which its parent depends 
+ --      as is available at the point of their declaration.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare an outside elevator button operation as a subunit in a 
+ --      generic child package of the basic operation package (FA13A00.A).  
+ --      This procedure has visibility into its parent ancestor and its 
+ --      private sibling.
+ --
+ --      In the main program, instantiate the child package. Check that 
+ --      subunits perform as expected.  
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FA13A00.A
+ --         CA13A02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ -- Public generic child package of an elevator application.  This package
+ -- provides outside elevator button operations.
+ 
+ generic                           -- Instantiate once for each floor.
+    Our_Floor : in Floor;          -- Reference type declared in parent.
+ 
+ package FA13A00_1.CA13A02_4 is    -- Outside Elevator Button Operations
+ 
+    type Light is (Up, Down, Express, Off);
+ 
+    type Direction is (Up, Down, Express);
+ 
+    function Call_Elevator (D : Direction) return Light;
+ 
+    -- other type definitions and procedure declarations in real application.
+ 
+ end FA13A00_1.CA13A02_4;
+ 
+      --==================================================================--
+ 
+ -- Context clauses required for visibility needed by separate subunit.
+ 
+ with FA13A00_0;                   -- Building Manager
+ 
+ with FA13A00_1.FA13A00_2;         -- Floor Calculation (private)
+                                          
+ with FA13A00_1.FA13A00_3;         -- Move Elevator
+ 
+ use  FA13A00_0;                           
+ 
+ package body FA13A00_1.CA13A02_4 is              
+ 
+    function Call_Elevator (D : Direction) return Light is separate;
+ 
+ end FA13A00_1.CA13A02_4;
+ 
+      --==================================================================--
+ 
+ separate (FA13A00_1.CA13A02_4)
+ 
+ -- Subunit Call_Elevator declared in Outside Elevator Button Operations.
+ 
+ function Call_Elevator (D : Direction) return Light is
+    Elevator_Button : Light;
+ 
+ begin
+    -- See if power is on.
+ 
+    if Power = Off then                       -- Reference package with'ed by
+       Elevator_Button := Off;                -- the subunit parent's body.
+ 
+    else
+       case D is
+          when Express =>        
+             FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of
+               (Penthouse, Call_Waiting);      -- the subunit parent's body.
+ 
+             Elevator_Button := Express;    
+ 
+          when Up      =>        
+             if Current_Floor < Our_Floor then
+                FA13A00_1.FA13A00_2.Up         -- Reference private sibling of
+                  (Floor'pos (Our_Floor)       -- the subunit parent's body.
+                    - Floor'pos (Current_Floor));
+             else
+                FA13A00_1.FA13A00_2.Down       -- Reference private sibling of
+                  (Floor'pos (Current_Floor)   -- the subunit parent's body.
+                    - Floor'pos (Our_Floor));
+             end if;
+ 
+             -- Call elevator.
+ 
+             Call 
+               (Current_Floor, Call_Waiting);  -- Reference subprogram declared
+                                               -- in the parent of the subunit 
+                                               -- parent's body. 
+             Elevator_Button := Up;    
+ 
+          when Down    =>        
+             if Current_Floor > Our_Floor then
+                FA13A00_1.FA13A00_2.Down       -- Reference private sibling of
+                  (Floor'pos (Current_Floor)   -- the subunit parent's body.
+                    - Floor'pos (Our_Floor));
+             else
+                FA13A00_1.FA13A00_2.Up         -- Reference private sibling of
+                  (Floor'pos (Our_Floor)       -- the subunit parent's body.
+                    - Floor'pos (Current_Floor));
+             end if;
+ 
+             Elevator_Button := Down;    
+ 
+             -- Call elevator.
+ 
+             Call 
+               (Current_Floor, Call_Waiting);  -- Reference subprogram declared
+                                               -- in the parent of the subunit 
+                                               -- parent's body.
+       end case;
+ 
+       if not Call_Waiting (Current_Floor)     -- Reference private part of the
+       then                                    -- parent of the subunit parent's
+                                               -- body.
+          TC_Operation := false;              
+       end if;
+ 
+    end if;
+ 
+    return Elevator_Button;
+ 
+ end Call_Elevator;
+ 
+      --==================================================================--
+ 
+ with FA13A00_1.CA13A02_4;         -- Outside Elevator Button Operations
+                                   -- implicitly with Basic Elevator
+                                   -- Operations
+ with Report;
+ 
+ procedure CA13A02 is
+ 
+ begin
+ 
+    Report.Test ("CA13A02", "Check that subunits declared in generic child " &
+                 "units of a public parent have the same visibility into " & 
+                 "its parent, its parent's siblings, and packages on " &
+                 "which its parent depends");
+ 
+ -- Going from floor one to penthouse.
+ 
+    Going_To_Penthouse:
+    declare
+       -- Declare instance of the child generic elevator package for penthouse.
+  
+       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+         (FA13A00_1.Penthouse);
+ 
+       use Call_Elevator_Pkg;
+ 
+       Call_Button_Light : Light;
+ 
+    begin
+ 
+       Call_Button_Light := Call_Elevator (Express);
+ 
+       if not FA13A00_1.TC_Operation or Call_Button_Light /= Express then
+          Report.Failed ("Incorrect elevator operation going to penthouse");
+       end if;
+ 
+    end Going_To_Penthouse;
+ 
+ -- Going from penthouse to basement.
+ 
+    Going_To_Basement:
+    declare
+       -- Declare instance of the child generic elevator package for basement.
+  
+       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+         (FA13A00_1.Basement);
+ 
+       use Call_Elevator_Pkg;
+ 
+       Call_Button_Light : Light;
+ 
+    begin
+ 
+       Call_Button_Light := Call_Elevator (Down);
+ 
+       if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
+          Report.Failed ("Incorrect elevator operation going to basement");
+       end if;
+ 
+    end Going_To_Basement;
+   
+ -- Going from basement to floor three.
+ 
+    Going_To_Floor3:
+    declare
+       -- Declare instance of the child generic elevator package for floor 
+       -- three.
+  
+       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+         (FA13A00_1.Floor3);
+ 
+       use Call_Elevator_Pkg;
+ 
+       Call_Button_Light : Light;
+ 
+    begin
+ 
+       Call_Button_Light := Call_Elevator (Up);
+ 
+       if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
+          Report.Failed ("Incorrect elevator operation going to floor 3");
+       end if;
+ 
+    end Going_To_Floor3;
+   
+ -- Going from floor three to floor two.
+ 
+    Going_To_Floor2:
+    declare
+       -- Declare instance of the child generic elevator package for floor two.
+  
+       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+         (FA13A00_1.Floor2);
+ 
+       use Call_Elevator_Pkg;
+ 
+       Call_Button_Light : Light;
+ 
+    begin
+ 
+       Call_Button_Light := Call_Elevator (Up);
+ 
+       if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
+          Report.Failed ("Incorrect elevator operation going to floor 2");
+       end if;
+ 
+    end Going_To_Floor2;
+   
+ -- Going to floor one.
+ 
+    Going_To_Floor1:
+    declare
+       -- Declare instance of the child generic elevator package for floor one.
+  
+       package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+         (FA13A00_1.Floor1);
+ 
+       use Call_Elevator_Pkg;
+ 
+       Call_Button_Light : Light;
+ 
+    begin
+       -- Calling elevator from floor one.
+ 
+       FA13A00_1.Current_Floor := FA13A00_1.Floor1;
+ 
+       Call_Button_Light := Call_Elevator (Down);
+ 
+       if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
+          Report.Failed ("Incorrect elevator operation going to floor 1");
+       end if;
+ 
+    end Going_To_Floor1;
+ 
+    Report.Result;
+ 
+ end CA13A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140230.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140230.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140230.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140230.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,62 ----
+ -- CA140230.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA140232.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See CA140232.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --      -> CA140230.A
+ --         CA140231.A
+ --         CA140232.AM
+ --         CA140233.A
+ --
+ -- PASS/FAIL CRITERIA:
+ --      See CA140232.AM.
+ --
+ -- CHANGE HISTORY:
+ --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+ --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+ --     20 MAR 00   RLB         Removed special requirements, because there
+ --                             aren't any.
+ --
+ --!
+ 
+ package CA14023_0 is
+      subtype Little_float is float digits 4 range 0.0..100.0;
+      type Data_rec is tagged record
+           Data : Little_float;
+      end record;
+ end CA14023_0;
+ 
+ --------------------------------------------------------
+ 
+ generic
+      type Data_type is digits <>;
+      Floor : Data_type;
+ function CA14023_1 (P1, P2 : Data_type) return Data_type;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140231.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140231.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140231.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140231.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,59 ----
+ -- CA140231.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA140232.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See CA140232.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA140230.A
+ --      -> CA140231.A
+ --         CA140232.AM
+ --         CA140233.A
+ --
+ -- PASS/FAIL CRITERIA:
+ --      See CA140232.AM.
+ --
+ -- CHANGE HISTORY:
+ --     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+ --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+ --     20 MAR 00   RLB         Removed special requirements, because there
+ --                             aren't any.
+ --
+ --!
+ 
+ function CA14023_1 (P1, P2 : Data_type) return Data_type is
+ begin
+      if Floor > P1 and Floor > P2 then
+           return Floor;
+      elsif P2 > P1 then
+           return P2;
+      else
+           return P1;
+      end if;
+ end CA14023_1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140232.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140232.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140232.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140232.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,139 ----
+ -- CA140232.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a compilation unit may not depend semantically
+ --      on two different versions of the same compilation unit.
+ --      Check the case where a generic instantiation depends on
+ --      a generic function that is changed.
+ --
+ -- TEST DESCRIPTION:
+ --      This test compiles a generic function, a generic
+ --      instantiation of the generic function, and a main
+ --      procedure that withs the instantiated generic
+ --      function.  Then, a new version of the first generic
+ --      function is compiled (in a separate file, simulating
+ --      editing and modification to the unit).  The test should
+ --      link the correct version of the withed function and
+ --      report "PASSED" at execution time.
+ --
+ --      Note that compilers are required by the standard to support
+ --      replacement of a generic body without recompilation of the
+ --      instantation. The ARG confirmed 10.1.4(10) with AI-00077.
+ --
+ --      To build this test:
+ --         1) Compile the file CA140230 (and include the results in the
+ --            program library).
+ --         2) Compile the file CA140231 (and include the results in the
+ --            program library).
+ --         3) Compile the file CA140232 (and include the results in the
+ --            program library).
+ --         4) Compile the file CA140233 (and include the results in the
+ --            program library).
+ --         5) Build and run an executable image.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA140230.A
+ --         CA140231.A
+ --      -> CA140232.AM
+ --         CA140233.A
+ --
+ -- CHANGE HISTORY:
+ --     01 MAY 95   ACVC 1.12   LA5008T baseline version
+ --     29 JUN 95   SAIC        Initial version
+ --     05 MAR 96   SAIC        First revision after review
+ --     18 NOV 96   SAIC        Modified unit names and prologue to conform
+ --                             to coding conventions.
+ --     07 DEC 96   SAIC        Moved CA14023_1 to a separate file.
+ --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+ --     20 MAR 00   RLB         Removed special requirements, because there
+ --                             aren't any.
+ --
+ --!
+ 
+ with CA14023_0;
+ use CA14023_0;
+ 
+ generic
+      Min : Little_float := 0.0;
+      type Any_rec is new Data_rec with private;
+ function CA14023_2 (R1, R2 : Any_rec) return Little_float;
+ 
+ --------------------------------------------------------
+ 
+ with CA14023_1;
+ 
+ function CA14023_2 (R1, R2 : Any_rec) return Little_float is
+      function Max_val is new CA14023_1 (Little_float, Min);
+ begin
+      return max_val (R1.Data, R2.Data);
+ end CA14023_2;
+ 
+ --------------------------------------------------------
+ 
+ package CA14023_0.CA14023_3 is
+      type New_data_rec is new Data_rec with record
+           Other_val : integer := 100;
+      end record;
+ end CA14023_0.CA14023_3;
+ 
+ --------------------------------------------------------
+ 
+ with Report; use Report;
+ with CA14023_2;
+ with CA14023_0;
+ with CA14023_0.CA14023_3;
+ 
+ procedure CA140232 is
+ 
+      NDR1, NDR2 : CA14023_0.CA14023_3.New_data_rec;
+      Min_value : constant CA14023_0.Little_float := 0.0;
+      TC_result : CA14023_0.Little_float;
+      function Max_Data_Val is new CA14023_2 (Min_value,
+                     CA14023_0.CA14023_3.New_data_rec);
+ begin
+      Test ("CA14023", "Check that a compilation unit may not " &
+                       "depend semantically on two different " &
+                       "versions of the same compilation unit.  " &
+                       "Check the case where a generic " &
+                       "instantiation depends on a generic " &
+                       "function that is changed");
+ 
+      NDR1.Data := 2.0;
+      NDR2.Data := 5.0;
+ 
+      TC_result := Max_Data_Val (NDR1, NDR2);
+ 
+      if TC_result = 5.0 then
+           Failed ("Revised generic not used");
+      elsif TC_result /= 0.0 then               -- the minimum, floor
+           Failed ("Incorrect value returned"); -- value of 0.0 should
+      end if;                                   -- be returned rather
+                                                -- than the min of the
+                                                -- two actual parameters
+ 
+      Result;
+ end CA140232;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140233.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140233.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140233.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140233.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,68 ----
+ -- CA140233.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA140232.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See CA140232.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA140230.A
+ --         CA140231.A
+ --         CA140232.AM
+ --      -> CA140233.A
+ --
+ -- PASS/FAIL CRITERIA:
+ --      See CA140232.AM.
+ --
+ -- CHANGE HISTORY:
+ --     01 MAY 95   ACVC 1.12   LA5008T baseline version
+ --     29 JUN 95   SAIC        Initial version
+ --     05 MAR 96   SAIC        First revision after review
+ --     18 NOV 96   SAIC        Modified unit names and prologue to conform
+ --                             to coding conventions.
+ --     07 DEC 96   SAIC        Modified prologue to reflect new test
+ --                             file organization.
+ --     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+ --     20 MAR 00   RLB         Removed special requirements, because there
+ --                             aren't any.
+ --!
+ 
+ -- here is the replacement body, correcting "errors" in
+ -- the original
+ 
+ function CA14023_1 (P1, P2 : Data_type) return Data_type is
+ begin
+      -- return min rather than max
+      if Floor < P1 and Floor < P2 then
+           return Floor;
+      elsif P2 < P1 then
+           return P2;
+      else
+           return P1;
+      end if;
+ end CA14023_1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140280.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140280.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140280.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140280.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- CA140280.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     See CA140283.AM.
+ --
+ -- TEST DESCRIPTION
+ --     See CA140283.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --      -> CA140280.A
+ --         CA140281.A
+ --         CA140282.A
+ --         CA140283.AM
+ --
+ -- CHANGE HISTORY:
+ --     JBG 05/28/85  CREATED ORGINAL TEST.
+ --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+ --                   NOT THE SAME.
+ --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+ 
+ GENERIC
+      C : INTEGER;
+ PROCEDURE GENPROC_CA14028 (X : OUT INTEGER);
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PROCEDURE GENPROC_CA14028 (X : OUT INTEGER) IS
+ BEGIN
+      X := IDENT_INT(C);
+ END GENPROC_CA14028;
+ 
+ GENERIC
+ FUNCTION GENFUNC_CA14028 RETURN INTEGER;
+ 
+ FUNCTION GENFUNC_CA14028 RETURN INTEGER IS
+ BEGIN
+      RETURN 2;
+ END GENFUNC_CA14028;
+ 
+ WITH GENPROC_CA14028;
+ PRAGMA ELABORATE (GENPROC_CA14028);
+ PROCEDURE CA14028_PROC1 IS NEW GENPROC_CA14028(1);
+ 
+ WITH GENFUNC_CA14028;
+ PRAGMA ELABORATE (GENFUNC_CA14028);
+ FUNCTION CA14028_FUNC2 IS NEW GENFUNC_CA14028;
+ 
+ WITH GENPROC_CA14028;
+ PRAGMA ELABORATE (GENPROC_CA14028);
+ PROCEDURE CA14028_PROC3 IS NEW GENPROC_CA14028(3);
+ 
+ WITH GENFUNC_CA14028;
+ PRAGMA ELABORATE (GENFUNC_CA14028);
+ FUNCTION CA14028_FUNC3 IS NEW GENFUNC_CA14028;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140281.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140281.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140281.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140281.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- CA140281.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     See CA140283.AM.
+ --
+ -- TEST DESCRIPTION
+ --     See CA140283.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA140280.A
+ --      -> CA140281.A
+ --         CA140282.A
+ --         CA140283.AM
+ --
+ -- CHANGE HISTORY:
+ --     JBG 05/28/85  CREATED ORGINAL TEST.
+ --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+ --                   NOT THE SAME.
+ --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+ 
+ PROCEDURE CA14028_PROC1 (X : OUT INTEGER) IS
+ BEGIN
+      X := 3;
+ END CA14028_PROC1;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION CA14028_FUNC2 RETURN INTEGER IS
+ BEGIN
+      RETURN IDENT_INT(4);
+ END CA14028_FUNC2;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PROCEDURE CA14028_PROC3 (X : OUT BOOLEAN; Y : OUT INTEGER) IS
+ BEGIN
+      X := FALSE;
+      Y := IDENT_INT(6);
+ END CA14028_PROC3;
+ 
+ FUNCTION CA14028_FUNC3 RETURN BOOLEAN IS
+ BEGIN
+      RETURN FALSE;
+ END CA14028_FUNC3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140282.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140282.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140282.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140282.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- CA140282.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     See CA140283.AM.
+ --
+ -- TEST DESCRIPTION
+ --     See CA140283.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA140280.A
+ --         CA140281.A
+ --      -> CA140282.A
+ --         CA140283.AM
+ --
+ -- CHANGE HISTORY:
+ --     JBG 05/28/85  CREATED ORIGINAL TEST.
+ --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+ --                   NOT THE SAME.
+ --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+ 
+ WITH GENPROC_CA14028;
+ PRAGMA ELABORATE (GENPROC_CA14028);
+ PROCEDURE CA14028_PROC5 IS NEW GENPROC_CA14028 (5);
+ 
+ WITH GENFUNC_CA14028;
+ PRAGMA ELABORATE (GENFUNC_CA14028);
+ FUNCTION CA14028_FUNC22 IS NEW GENFUNC_CA14028;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PROCEDURE CA14028_PROC3 (X : OUT INTEGER) IS
+ BEGIN
+      X := IDENT_INT(4);
+ END CA14028_PROC3;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ FUNCTION CA14028_FUNC3 RETURN INTEGER IS
+ BEGIN
+      RETURN IDENT_INT(7);
+ END CA14028_FUNC3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140283.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140283.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca140283.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca140283.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,91 ----
+ -- CA140283.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     Check that when a subprogram body is compiled as a library unit
+ --     it is not interpreted as a completion for any previous library
+ --     subprogram created by generic instantiation, and it therefore
+ --     declares a new library subprogram.
+ --
+ -- TEST DESCRIPTION
+ --     A generic function and procedure plus their instantiations are
+ --     created. Then, subprogram bodies which ought to replace the
+ --     instantiations are compiled. Following that, additional instantiations
+ --     are compiled. Finally the main subprogram is compiled.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA140280.A
+ --         CA140281.A
+ --         CA140282.A
+ --      -> CA140283.AM
+ --
+ -- CHANGE HISTORY:
+ --     JBG 05/28/85  CREATED ORIGINAL TEST.
+ --     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+ --                   NOT THE SAME.
+ --     THS 09/24/90  REWORDED HEADER COMMENTS, ERROR MESSAGES, AND
+ --                   CALL TO TEST. CALLED IDENT_INT CONSISTENTLY.
+ --     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA14028_PROC1, CA14028_FUNC2, CA14028_PROC5, CA14028_FUNC22,
+      CA14028_PROC3, CA14028_FUNC3;
+ PROCEDURE CA140283 IS
+      TEMP : INTEGER := 0;
+ BEGIN
+      TEST ("CA14028", "Check that library subprograms created by " &
+                       "generic instantiation are replaced " &
+                       "when new non-generic subprogram bodies are " &
+                       "compiled");
+ 
+      CA14028_PROC1(TEMP);
+      IF TEMP /= IDENT_INT(3) THEN
+           FAILED ("CA14028_Proc1 instantiation not replaced");
+      END IF;
+ 
+      IF CA14028_FUNC2 /= IDENT_INT(4) THEN
+           FAILED ("CA14028_Func2 instantiation not replaced");
+      END IF;
+ 
+      CA14028_PROC5(TEMP);
+      IF TEMP /= IDENT_INT(5) THEN
+           FAILED ("New CA14028_Proc5 instantiation not correct");
+      END IF;
+ 
+      IF CA14028_FUNC22 /= IDENT_INT(2) THEN
+           FAILED ("New CA14028_Func22 instantiation not correct");
+      END IF;
+ 
+      CA14028_PROC3(TEMP);
+      IF TEMP /= IDENT_INT(4) THEN
+           FAILED ("CA14028_Proc3 not replaced by correct version");
+      END IF;
+ 
+      IF CA14028_FUNC3 /= IDENT_INT(7) THEN
+           FAILED ("CA14028_Func3 not replaced by correct version");
+      END IF;
+ 
+      RESULT;
+ END CA140283;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca15003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca15003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca15003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca15003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,161 ----
+ -- CA15003.A
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE
+ --     Check the requirements of 10.1.5(4) and the modified 10.1.5(5)
+ --     from Technical Corrigendum 1. (Originally discussed as AI95-00136.)
+ --     Specifically:
+ --     Check that program unit pragma for a generic package are accepted
+ --     when given at the beginning of the package specification.
+ --     Check that a program unit pragma can be given for a generic
+ --     instantiation by placing the pragma immediately after the instantation.
+ --
+ -- TEST DESCRIPTION
+ --     This test checks the cases that are *not* forbidden by the RM,
+ --     and makes sure such legal cases actually work.
+ --
+ -- CHANGE HISTORY:
+ --      29 JUN 1999   RAD   Initial Version
+ --      08 JUL 1999   RLB   Cleaned up and added to test suite.
+ --      27 AUG 1999   RLB   Repaired errors introduced by me.
+ --
+ --!
+ 
+ with System;
+ package CA15003A is
+     pragma Pure;
+ 
+     type Big_Int is range -System.Max_Int .. System.Max_Int;
+     type Big_Positive is new Big_Int range 1..Big_Int'Last;
+ end CA15003A;
+ 
+ generic
+     type Int is new Big_Int;
+ package CA15003A.Pure is
+     pragma Pure;
+     function F(X: access Int) return Int;
+ end CA15003A.Pure;
+ 
+ with CA15003A.Pure;
+ package CA15003A.Pure_Instance is new CA15003A.Pure(Int => Big_Positive);
+     pragma Pure(CA15003A.Pure_Instance);
+ 
+ package body CA15003A.Pure is
+     function F(X: access Int) return Int is
+     begin
+         X.all := X.all + 1;
+         return X.all;
+     end F;
+ end CA15003A.Pure;
+ 
+ generic
+ package CA15003A.Pure.Preelaborate is
+     pragma Preelaborate;
+     One: Int := 1;
+     function F(X: access Int) return Int;
+ end CA15003A.Pure.Preelaborate;
+ 
+ package body CA15003A.Pure.Preelaborate is
+     function F(X: access Int) return Int is
+     begin
+         X.all := X.all + One;
+         return X.all;
+     end F;
+ end CA15003A.Pure.Preelaborate;
+ 
+ with CA15003A.Pure_Instance;
+ with CA15003A.Pure.Preelaborate;
+ package CA15003A.Pure_Preelaborate_Instance is
+     new CA15003A.Pure_Instance.Preelaborate;
+         pragma Preelaborate(CA15003A.Pure_Preelaborate_Instance);
+ 
+ package CA15003A.Empty_Pure is
+     pragma Pure;
+     pragma Elaborate_Body;
+ end CA15003A.Empty_Pure;
+ 
+ package body CA15003A.Empty_Pure is
+ end CA15003A.Empty_Pure;
+ 
+ package CA15003A.Empty_Preelaborate is
+     pragma Preelaborate;
+     pragma Elaborate_Body;
+     One: Big_Int := 1;
+ end CA15003A.Empty_Preelaborate;
+ 
+ package body CA15003A.Empty_Preelaborate is
+     function F(X: access Big_Int) return Big_Int is
+     begin
+         X.all := X.all + One;
+         return X.all;
+     end F;
+ end CA15003A.Empty_Preelaborate;
+ 
+ package CA15003A.Empty_Elaborate_Body is
+     pragma Elaborate_Body;
+     Three: aliased Big_Positive := 1;
+     Two, Tres: Big_Positive'Base := 0;
+ end CA15003A.Empty_Elaborate_Body;
+ 
+ with Report; use Report; pragma Elaborate_All(Report);
+ with CA15003A.Pure_Instance;
+ with CA15003A.Pure_Preelaborate_Instance;
+ use CA15003A;
+ package body CA15003A.Empty_Elaborate_Body is
+ begin
+     if Two /= Big_Positive'Base(Ident_Int(0)) then
+ 	Failed ("Two should be zero now");
+     end if;
+     if Tres /= Big_Positive'Base(Ident_Int(0)) then
+ 	Failed ("Tres should be zero now");
+     end if;
+     if Two /= Tres then
+ 	Failed ("Tres should be zero now");
+     end if;
+     Two := Pure_Instance.F(Three'Access);
+     Tres := Pure_Preelaborate_Instance.F(Three'Access);
+     if Two /= Big_Positive(Ident_Int(2)) then
+ 	Failed ("Two should be 2 now");
+     end if;
+     if Tres /= Big_Positive(Ident_Int(3)) then
+ 	Failed ("Tres should be 3 now");
+     end if;
+ end CA15003A.Empty_Elaborate_Body;
+ 
+ with Report; use Report;
+ with CA15003A.Empty_Pure;
+ with CA15003A.Empty_Preelaborate;
+ with CA15003A.Empty_Elaborate_Body; use CA15003A.Empty_Elaborate_Body;
+ use type CA15003A.Big_Positive'Base;
+ procedure CA15003 is
+ begin
+     Test("CA15003", "Placement of Program Unit Pragmas in Generic Packages");
+     if Two /= 2 then
+ 	Failed ("Two should be 2 now");
+     end if;
+     if Tres /= 3 then
+ 	Failed ("Tres should be 3 now");
+     end if;
+     Result;
+ end CA15003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca200020.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca200020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca200020.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca200020.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- CA200020.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a partition can be created even if the environment contains
+ --      two units with the same name. (This is rule 10.2(19)).
+ --
+ -- TEST DESCRIPTION:
+ --      Declare the a parent package (CA20002_0). Declare a child package
+ --      (CA20002_0.CA20002_1). Declare a subunit in the parent package body
+ --      (CA20002_1). Declare a main subprogram that does NOT include the
+ --      child package. Insure that this partition can be created.
+ --
+ --      This test is intended to test the effects of program maintenance.
+ --      After the programmer receives an error from creating a partition
+ --      like that tested in test LA20001, the programmer may then repair
+ --      the partition by eliminating the reference of the child unit. The
+ --      partition should be able to be created.
+ --
+ --      To build this test:
+ --         1) Compile the file CA200020 (and include the results in the
+ --            program library).
+ --         2) Compile the file CA200021 (and include the results in the
+ --            program library).
+ --         3) Compile the file CA200022 (and include the results in the
+ --            program library).
+ --         4) Build an executable image, and run it.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --      -> CA200020.A
+ --         CA200021.A
+ --         CA200022.AM
+ --
+ -- CHANGE HISTORY:
+ --      27 Jan 99   RLB     Initial test.
+ --      20 Mar 00   RLB     Removed special requirements, because there
+ --                          aren't any.
+ --!
+ 
+ package CA20002_0 is
+    procedure Do_a_Little (A : out Integer);
+ 
+ end CA20002_0;
+ 
+ package CA20002_0.CA20002_1 is
+    My_Global : Integer;
+ end CA20002_0.CA20002_1;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca200021.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca200021.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca200021.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca200021.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- CA200021.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA200020.A.
+ --
+ -- TEST DESCRIPTION:
+ --      See CA200020.A.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA200020.A
+ --      -> CA200021.A
+ --         CA200022.AM
+ --
+ -- PASS/FAIL CRITERIA:
+ --      See CA200020.A.
+ --
+ -- CHANGE HISTORY:
+ --     27 JAN 99   RLB       Initial version.
+ --     20 MAR 00   RLB       Removed special requirements, because there
+ --                           aren't any.
+ --
+ --!
+ 
+ package body CA20002_0 is
+ 
+    function CA20002_1 return Integer is separate; -- Has the same expanded name
+                                                   -- as the child.
+       -- Note: An implementation may produce a warning about the child
+       -- unit at this point, but it must accept the subunit declaration.
+ 
+    procedure Do_a_Little (A : out Integer) is
+    begin
+       A := CA20002_1;
+    end Do_a_Little;
+ 
+ end CA20002_0;
+ 
+ with Report;
+ separate (CA20002_0)
+ function CA20002_1 return Integer is
+ begin
+    return Report.Ident_Int(5);
+ end CA20002_1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca200022.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca200022.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca200022.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca200022.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- CA200022.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CA200020.A.
+ --
+ -- TEST DESCRIPTION:
+ --      See CA200020.A.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --         CA200020.A
+ --         CA200021.A
+ --      -> CA200022.AM
+ --
+ -- PASS/FAIL CRITERIA:
+ --      See CA200020.A.
+ --
+ -- CHANGE HISTORY:
+ --     25 JAN 99   RLB       Initial version.
+ --     08 JUL 99   RLB       Repaired comments.
+ --     20 MAR 00   RLB       Removed special requirements, because there
+ --                           aren't any.
+ --!
+ 
+ with Report;
+ use Report;
+ with CA20002_0; -- Child unit not included in the partition.
+ procedure CA200022 is
+      Value : Integer := 0;
+ begin
+      Test ("CA20002","Check that compiling multiple units with the same " &
+                      "name does not prevent the creation of a partition " &
+                      "using only one of the units.");
+      CA20002_0.Do_a_Little (Value);
+      if Report.Equal (Value, 5) then
+         null; -- OK.
+      else
+         Failed ("Wrong result from subunit");
+      end if;
+ 
+      Result;
+ end CA200022;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,40 ----
+ -- CA2001H0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/25/81
+ -- JBG 8/25/83
+ 
+ FUNCTION CA2001H0 RETURN INTEGER IS
+ 
+      PACKAGE CA2001H1 IS
+           I : INTEGER := 0;
+      END CA2001H1;
+ 
+      PACKAGE BODY CA2001H1 IS SEPARATE;
+ 
+ BEGIN
+      
+      RETURN CA2001H1.I;
+ 
+ END CA2001H0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,39 ----
+ -- CA2001H1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/25/81
+ -- JBG 8/25/83
+ -- BHS 7/31/84
+ 
+ SEPARATE (CA2001H0)
+ 
+ PACKAGE BODY CA2001H1 IS
+      PROCEDURE NOT_USED IS SEPARATE;
+ 
+ BEGIN
+ 
+      I := 1;
+      NOT_USED;
+ 
+ END CA2001H1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,38 ----
+ -- CA2001H2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/25/81
+ -- JBG 8/25/83
+ 
+ FUNCTION CA2001H0 RETURN INTEGER IS
+ 
+      PACKAGE CA2001H1 IS
+           I : INTEGER := 2;
+      END CA2001H1;
+ 
+ BEGIN
+ 
+      RETURN CA2001H1.I;
+ 
+ END CA2001H0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2001h3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2001h3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- CA2001H3M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF A BODY_STUB IS DELETED FROM A COMPILATION UNIT,
+ --   THE PREVIOUSLY EXISTING SUBUNIT CAN NO LONGER BE ACCESSED.
+ 
+ -- SEPARATE FILES ARE;
+ --   CA2001H0  A LIBRARY FUNCTION (CA2001H0).
+ --   CA2001H1  A SUBUNIT PACKAGE BODY.
+ --   CA2001H2  A LIBRARY FUNCTION (CA2001H0).
+ --   CA2001H3M THE MAIN PROCEDURE.
+ 
+ -- WKB 6/25/81
+ -- JRK 6/26/81
+ -- SPS 11/2/82
+ -- JBG 8/25/83
+ 
+ 
+ WITH REPORT, CA2001H0;
+ USE REPORT;
+ PROCEDURE CA2001H3M IS
+ 
+      I : INTEGER := -1;
+ 
+ BEGIN
+      TEST ("CA2001H", "IF A BODY_STUB IS DELETED FROM A COMPILATION " &
+                       "UNIT, THE PREVIOUSLY EXISTING SUBUNIT CAN NO " &
+                       "LONGER BE ACCESSED");
+ 
+      I := CA2001H0;
+ 
+      IF I = 1 THEN
+           FAILED ("SUBUNIT ACCESSED");
+      END IF;
+ 
+      IF I = 0 THEN
+           FAILED ("OLD LIBRARY UNIT ACCESSED");
+      END IF;
+ 
+      IF I /= 2 THEN
+           FAILED ("NEW LIBRARY UNIT NOT ACCESSED");
+      END IF;
+ 
+      RESULT;
+ END CA2001H3M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2002a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2002a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2002a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2002a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,139 ----
+ -- CA2002A0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SUBUNITS HAVING DIFFERENT ANCESTOR LIBRARY UNITS CAN HAVE
+ -- THE SAME NAME.
+ 
+ -- SEPARATE FILES ARE:
+ --     CA2002A0M  THE MAIN PROCEDURE, WITH SEPARATE LIBRARY 
+ --                     PACKAGES (CA2002A1) AND (CA2002A2).
+ --     CA2002A1   SUBUNIT BODIES FOR STUBS IN PACKAGE CA2002A1.
+ --     CA2002A2   SUBUNIT BODIES FOR STUBS IN PACKAGE CA2002A2.
+ 
+ -- BHS 8/02/84
+ 
+ PACKAGE CA2002A1 IS
+ 
+      PROCEDURE PROC (X : OUT INTEGER);
+      FUNCTION FUN RETURN BOOLEAN;
+ 
+      PACKAGE PKG IS
+           I : INTEGER;
+           PROCEDURE PKG_PROC (XX : IN OUT INTEGER);
+      END PKG;
+ 
+ END CA2002A1;
+ 
+ PACKAGE BODY CA2002A1 IS
+ 
+      PROCEDURE PROC (X : OUT INTEGER) IS SEPARATE;
+      FUNCTION FUN RETURN BOOLEAN IS SEPARATE;
+      PACKAGE BODY PKG IS SEPARATE;
+ 
+ END CA2002A1;
+ 
+ 
+ PACKAGE CA2002A2 IS
+ 
+      PROCEDURE PROC (Y : OUT INTEGER);
+      FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN;
+ 
+      PACKAGE PKG IS
+           I : INTEGER;
+           PROCEDURE PKG_PROC (YY : IN OUT INTEGER);
+      END PKG;
+ 
+ END CA2002A2;
+ 
+ PACKAGE BODY CA2002A2 IS
+ 
+      PROCEDURE PROC (Y : OUT INTEGER) IS SEPARATE;
+      FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN IS SEPARATE;
+      PACKAGE BODY PKG IS SEPARATE;
+ 
+ END CA2002A2;
+ 
+ WITH CA2002A1, CA2002A2;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CA2002A0M IS
+ BEGIN
+ 
+      TEST ("CA2002A", "SUBUNITS WITH DIFFERENT ANCESTORS " &
+                       "CAN HAVE THE SAME NAME");
+ 
+      DECLARE
+           VAR1 : INTEGER;
+           USE CA2002A1;
+      BEGIN
+ 
+           PROC (VAR1);
+           IF VAR1 /= 1 THEN 
+                FAILED ("CA2002A1 PROCEDURE NOT INVOKED CORRECTLY");
+           END IF;
+ 
+           IF NOT FUN THEN
+                FAILED ("CA2002A1 FUNCTION NOT INVOKED CORRECTLY");
+           END IF;
+ 
+           IF PKG.I /= 1 THEN
+                FAILED ("CA2202A1 PKG VARIABLE NOT ACCESSED CORRECTLY");
+           END IF;
+ 
+           VAR1 := 5;
+           PKG.PKG_PROC (VAR1);
+           IF VAR1 /= 4 THEN
+                FAILED ("CA2002A1 PKG SUBUNIT NOT INVOKED CORRECTLY");
+           END IF;
+ 
+      END;
+ 
+      DECLARE
+           VAR2 : INTEGER;
+           USE CA2002A2;
+      BEGIN
+ 
+           PROC (VAR2);
+           IF VAR2 /= 2 THEN
+                FAILED ("CA2002A2 PROCEDURE NOT INVOKED CORRECTLY");
+           END IF;
+ 
+           IF FUN THEN
+                FAILED ("CA2002A2 FUNCTION NOT INVOKED CORRECTLY");
+           END IF;
+ 
+           IF PKG.I /= 2 THEN
+                FAILED ("CA2002A2 PKG VARIABLE NOT ACCESSED CORRECTLY");
+           END IF;
+ 
+           VAR2 := 3;
+           PKG.PKG_PROC (VAR2);
+           IF VAR2 /= 4 THEN
+                FAILED ("CA2002A2 PKG SUBUNIT NOT INVOKED CORRECTLY");
+           END IF;
+ 
+      END;
+ 
+      RESULT;
+ 
+ END CA2002A0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2002a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2002a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2002a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2002a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- CA2002A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SUBUNIT BODIES FOR STUBS GIVEN IN PACKAGE CA2002A1 IN FILE
+ -- CA2002A0M. 
+ 
+ -- BHS 8/02/84
+ 
+ SEPARATE (CA2002A1)
+ PROCEDURE PROC (X : OUT INTEGER) IS
+ BEGIN
+      X := 1;
+ END PROC;
+ 
+ SEPARATE (CA2002A1)
+ FUNCTION FUN RETURN BOOLEAN IS
+ BEGIN
+      RETURN TRUE;
+ END FUN;
+ 
+ SEPARATE (CA2002A1)
+ PACKAGE BODY PKG IS
+      PROCEDURE PKG_PROC (XX : IN OUT INTEGER) IS SEPARATE;
+ BEGIN
+      I := 1;
+ END PKG;
+ 
+ SEPARATE (CA2002A1.PKG)
+ PROCEDURE PKG_PROC (XX : IN OUT INTEGER) IS
+ BEGIN
+      XX := XX - 1;
+ END PKG_PROC;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2002a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2002a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2002a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2002a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,53 ----
+ -- CA2002A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SUBUNIT BODIES FOR STUBS GIVEN IN PACKAGE CA2002A2 IN FILE
+ -- CA2002A0M. 
+ 
+ -- BHS 8/02/84
+ 
+ SEPARATE (CA2002A2)
+ PROCEDURE PROC (Y : OUT INTEGER) IS
+ BEGIN
+      Y := 2;
+ END PROC;
+ 
+ SEPARATE (CA2002A2)
+ FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN IS
+ BEGIN
+      RETURN Z /= 3;
+ END FUN;
+ 
+ SEPARATE (CA2002A2)
+ PACKAGE BODY PKG IS
+      PROCEDURE PKG_PROC (YY : IN OUT INTEGER) IS SEPARATE;
+ BEGIN
+      I := 2;
+ END PKG;
+ 
+ SEPARATE (CA2002A2.PKG)
+ PROCEDURE PKG_PROC (YY : IN OUT INTEGER) IS
+ BEGIN
+      YY := YY + 1;
+ END PKG_PROC;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2003a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2003a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2003a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2003a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,55 ----
+ -- CA2003A0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SUBUNIT HAS VISIBILITY OF IDENTIFIERS DECLARED
+ --   PRIOR TO ITS BODY_STUB.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA2003A0M THE MAIN PROCEDURE.
+ --   CA2003A1  A SUBUNIT PROCEDURE BODY.
+ 
+ -- WKB 6/26/81
+ -- JRK 6/26/81
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2003A0M IS
+ 
+      I : INTEGER := 1;
+ 
+      PROCEDURE CA2003A1 IS SEPARATE;
+ 
+      PACKAGE P IS
+           I : INTEGER := 2;
+      END P;
+ 
+ BEGIN
+      TEST ("CA2003A", "A SUBUNIT HAS VISIBILITY OF IDENTIFIERS " &
+                       "DECLARED BEFORE ITS BODY_STUB");
+ 
+ 
+      CA2003A1;
+ 
+      RESULT;
+ END CA2003A0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2003a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2003a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2003a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2003a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,35 ----
+ -- CA2003A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/26/81
+ 
+ SEPARATE (CA2003A0M)
+ PROCEDURE CA2003A1 IS
+ BEGIN
+ 
+      IF I /= 1 THEN
+           FAILED ("IDENTIFIER IN PARENT NOT VISIBLE");
+      END IF;
+ 
+ END CA2003A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- CA2004A0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A SUBUNIT HAS VISIBILITY OF IDENTIFIERS DECLARED
+ --   IN ANCESTORS OTHER THAN THE PARENT.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA2004A0M THE MAIN PROCEDURE.
+ --   CA2004A1  A SUBUNIT PACKAGE BODY.
+ --   CA2004A2  A SUBUNIT PROCEDURE BODY.
+ --   CA2004A3  A SUBUNIT PROCEDURE BODY.
+ --   CA2004A4  A SUBUNIT PROCEDURE BODY.
+ 
+ -- WKB 6/26/81
+ -- JRK 6/26/81
+ -- BHS 7/31/84
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2004A0M IS
+ 
+      I : INTEGER := 1;
+ 
+      PACKAGE CA2004A1 IS
+           J : INTEGER := 2;
+           PROCEDURE CA2004A2;
+      END CA2004A1;
+ 
+      USE CA2004A1;
+      PACKAGE BODY CA2004A1 IS SEPARATE;
+      PROCEDURE CA2004A3 IS SEPARATE;
+ 
+ BEGIN
+      TEST ("CA2004A", "CHECK THAT A SUBUNIT HAS VISIBILITY OF " &
+                       "IDENTIFIERS DECLARED IN ANCESTORS");
+ 
+ 
+      CA2004A1.
+      CA2004A2;
+ 
+      CA2004A3;
+ 
+      RESULT;
+ END CA2004A0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA2004A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/26/81
+ 
+ SEPARATE (CA2004A0M)
+ PACKAGE BODY CA2004A1 IS
+ 
+      K : INTEGER := 3;
+ 
+      PROCEDURE CA2004A2 IS SEPARATE;
+ 
+ END CA2004A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,43 ----
+ -- CA2004A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/26/81
+ 
+ SEPARATE (CA2004A0M.CA2004A1)
+ PROCEDURE CA2004A2 IS
+ BEGIN
+ 
+      IF I /= 1 THEN
+           FAILED ("IDENTIFIER NOT VISIBLE - 1");
+      END IF;
+ 
+      IF J /= 2 THEN
+           FAILED ("IDENTIFIER NOT VISIBLE - 2");
+      END IF;
+ 
+      IF K /= 3 THEN
+           FAILED ("IDENTIFIER NOT VISIBLE - 3");
+      END IF;
+ 
+ END CA2004A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,39 ----
+ -- CA2004A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/31/84
+ 
+ SEPARATE (CA2004A0M)
+ PROCEDURE CA2004A3 IS
+ 
+      PROCEDURE CA2004A4 IS SEPARATE;
+ 
+ BEGIN
+ 
+      IF I /= IDENT_INT(1) OR
+         J /= IDENT_INT(2) THEN
+           FAILED ("IDENTIFIER NOT VISIBLE - 4");
+      END IF;
+ 
+ END CA2004A3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2004a4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2004a4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- CA2004A4.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 7/31/84
+ 
+ SEPARATE (CA2004A0M.CA2004A3)
+ PROCEDURE CA2004A4 IS
+ BEGIN
+ 
+      IF I /= IDENT_INT(1) OR
+         J /= IDENT_INT(2) THEN
+           FAILED ("IDENTIFIER NOT VISIBLE - 5");
+      END IF;
+ 
+ END CA2004A4;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- CA2007A0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SUBUNIT PACKAGES ARE ELABORATED IN THE ORDER IN
+ --   WHICH THEIR BODY STUBS APPEAR, NOT (NECESSARILY) IN THE
+ --   ORDER IN WHICH THEY ARE COMPILED.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA2007A0M THE MAIN PROCEDURE.
+ --   CA2007A1  A SUBUNIT PACKAGE BODY.
+ --   CA2007A2  A SUBUNIT PACKAGE BODY.
+ --   CA2007A3  A SUBUNIT PACKAGE BODY.
+ 
+ -- WKB 7/1/81
+ -- JRK 7/1/81
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2007A0M IS
+ 
+      ELAB_ORDER : STRING (1..3) := "   ";
+      NEXT : NATURAL := 1;
+ 
+      PACKAGE CALL_TEST IS 
+      END CALL_TEST;
+ 
+      PACKAGE BODY CALL_TEST IS
+      BEGIN
+           TEST ("CA2007A", "CHECK THAT SUBUNIT PACKAGES ARE " &
+                            "ELABORATED IN THE ORDER IN WHICH THEIR " &
+                            "BODY STUBS APPEAR");
+      END CALL_TEST;
+ 
+      PACKAGE CA2007A3 IS
+      END CA2007A3;
+ 
+      PACKAGE BODY CA2007A3 IS SEPARATE;
+ 
+      PACKAGE CA2007A2 IS
+      END CA2007A2;
+ 
+      PACKAGE BODY CA2007A2 IS SEPARATE;
+ 
+      PACKAGE CA2007A1 IS
+      END CA2007A1;
+ 
+      PACKAGE BODY CA2007A1 IS SEPARATE;
+ 
+ BEGIN
+ 
+      IF ELAB_ORDER /= "321" THEN
+           FAILED ("INCORRECT ELABORATION ORDER");
+      END IF;
+ 
+      RESULT;
+ END CA2007A0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- CA2007A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/1/81
+ 
+ SEPARATE (CA2007A0M)
+ 
+ PACKAGE BODY CA2007A1 IS
+ 
+ BEGIN 
+ 
+      ELAB_ORDER (NEXT) := '1';
+      NEXT := NEXT + 1;
+ 
+ END CA2007A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- CA2007A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/1/81
+ 
+ SEPARATE (CA2007A0M)
+ 
+ PACKAGE BODY CA2007A2 IS
+ 
+ BEGIN
+ 
+      ELAB_ORDER (NEXT) := '2';
+      NEXT := NEXT + 1;
+ 
+ END CA2007A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2007a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2007a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,36 ----
+ -- CA2007A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/1/81
+ 
+ SEPARATE (CA2007A0M)
+ 
+ PACKAGE BODY CA2007A3 IS
+ 
+ BEGIN
+ 
+      ELAB_ORDER (NEXT) := '3';
+      NEXT := NEXT + 1;
+ 
+ END CA2007A3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2008a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2008a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2008a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2008a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,81 ----
+ -- CA2008A0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT FOR AN OVERLOADED SUBPROGRAM, ONE OF THE
+ --   SUBPROGRAM BODIES CAN BE SPECIFIED WITH A BODY_STUB AND
+ --   COMPILED SEPARATELY.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA2008A0M THE MAIN PROCEDURE.
+ --   CA2008A1  A SUBUNIT PROCEDURE BODY.
+ --   CA2008A2  A SUBUNIT FUNCTION BODY.
+ 
+ -- WKB 6/26/81
+ -- SPS 11/2/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2008A0M IS
+ 
+      I : INTEGER := 0;
+      B : BOOLEAN := TRUE;
+ 
+      PROCEDURE CA2008A1 (I : IN OUT INTEGER) IS
+      BEGIN
+           I := IDENT_INT (1);
+      END CA2008A1;
+ 
+      PROCEDURE CA2008A1 (B : IN OUT BOOLEAN) IS SEPARATE;
+ 
+      FUNCTION CA2008A2 RETURN INTEGER IS SEPARATE;
+ 
+      FUNCTION CA2008A2 RETURN BOOLEAN IS
+      BEGIN
+           RETURN IDENT_BOOL (FALSE);
+      END CA2008A2;
+ 
+ BEGIN
+      TEST ("CA2008A", "CHECK THAT AN OVERLOADED SUBPROGRAM " &
+                       "CAN HAVE ONE OF ITS BODIES COMPILED SEPARATELY");
+ 
+      CA2008A1 (I);
+      IF I /= 1 THEN
+           FAILED ("OVERLOADED PROCEDURE NOT INVOKED - 1");
+      END IF;
+ 
+      CA2008A1 (B);
+      IF B THEN
+           FAILED ("OVERLOADED PROCEDURE NOT INVOKED - 2");
+      END IF;
+ 
+      IF CA2008A2 /= 2 THEN
+           FAILED ("OVERLOADED FUNCTION NOT INVOKED - 1");
+      END IF;
+ 
+      IF CA2008A2 THEN
+           FAILED ("OVERLOADED FUNCTION NOT INVOKED - 2");
+      END IF;
+ 
+      RESULT;
+ END CA2008A0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2008a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2008a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2008a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2008a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,35 ----
+ -- CA2008A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/26/81
+ 
+ SEPARATE (CA2008A0M)
+ 
+ PROCEDURE CA2008A1 (B : IN OUT BOOLEAN) IS
+ 
+ BEGIN
+ 
+      B := FALSE;
+ 
+ END CA2008A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2008a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2008a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2008a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2008a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,35 ----
+ -- CA2008A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 6/26/81
+ 
+ SEPARATE (CA2008A0M)
+ 
+ FUNCTION CA2008A2 RETURN INTEGER IS
+ 
+ BEGIN
+ 
+      RETURN 2;
+ 
+ END CA2008A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- CA2009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A GENERIC PACKAGE SUBUNIT CAN BE SPECIFIED AND
+ -- INSTANTIATED.
+ 
+ -- BHS 8/01/84
+ -- JRK 5/24/85  CHANGED TO .ADA, SEE AI-00323.
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2009A IS
+ 
+      INT1 : INTEGER := 1;
+ 
+      SUBTYPE STR15 IS STRING (1..15);
+      SVAR : STR15 := "ABCDEFGHIJKLMNO";
+ 
+      GENERIC 
+           TYPE ITEM IS PRIVATE;
+           CON1 : IN ITEM;
+           VAR1 : IN OUT ITEM;
+      PACKAGE PKG1 IS 
+      END PKG1;
+ 
+      PACKAGE BODY PKG1 IS SEPARATE;
+      
+      PACKAGE NI_PKG1 IS NEW PKG1 (INTEGER, IDENT_INT(2), INT1);
+      PACKAGE NS_PKG1 IS NEW PKG1 (STR15, IDENT_STR("REINSTANTIATION"),
+                                   SVAR);
+ 
+ BEGIN
+ 
+      TEST ("CA2009A", "SPECIFICATION AND INSTANTIATION " &
+                       "OF GENERIC PACKAGE SUBUNITS");
+ 
+      IF INT1 /= 2 THEN
+           FAILED ("INCORRECT INSTANTIATION - INTEGER");
+      END IF;
+ 
+      IF SVAR /= "REINSTANTIATION" THEN
+           FAILED ("INCORRECT INSTANTIATION - STRING");
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ END CA2009A;
+ 
+ 
+ SEPARATE (CA2009A)
+ PACKAGE BODY PKG1 IS
+ BEGIN
+      VAR1 := CON1;
+ END PKG1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- CA2009C0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A GENERIC PACKAGE SUBUNIT CAN BE SPECIFIED AND
+ --     INSTANTIATED.  IN THIS TEST, THE SUBUNIT BODY IS IN A
+ --     SEPARATE FILE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- SEPARATE FILES ARE:
+ --     CA2009C0M  THE MAIN PROCEDURE.
+ --     CA2009C1   A SUBUNIT PACKAGE BODY (PKG1).
+ 
+ -- HISTORY:
+ --     BHS 08/01/84  CREATED ORIGINAL TEST.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ --     RLB 09/15/99  REMOVED JUNK COMMENT.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2009C0M IS
+ 
+      INT1 : INTEGER := 1;
+ 
+      SUBTYPE STR15 IS STRING (1..15);
+      SVAR : STR15 := "ABCDEFGHIJKLMNO";
+ 
+      GENERIC
+           TYPE ITEM IS PRIVATE;
+           CON1 : IN ITEM;
+           VAR1 : IN OUT ITEM;
+      PACKAGE PKG1 IS
+      END PKG1;
+ 
+      PACKAGE BODY PKG1 IS SEPARATE;
+ 
+      PACKAGE NI_PKG1 IS NEW PKG1 (INTEGER, IDENT_INT(2), INT1);
+      PACKAGE NS_PKG1 IS NEW PKG1 (STR15, IDENT_STR("REINSTANTIATION"),
+                                   SVAR);
+ 
+ BEGIN
+ 
+      TEST ("CA2009C", "SPECIFICATION AND INSTANTIATION " &
+                       "OF GENERIC PACKAGE SUBUNITS " &
+                       " -  SEPARATE FILES USED");
+ 
+      IF INT1 /= 2 THEN
+           FAILED ("INCORRECT INSTANTIATION - INTEGER");
+      END IF;
+ 
+      IF SVAR /= "REINSTANTIATION" THEN
+           FAILED ("INCORRECT INSTANTIATION - STRING");
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ END CA2009C0M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,43 ----
+ -- CA2009C1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- A GENERIC PACKAGE BODY.
+ -- THE DECLARATION AND AN INSTANTIATION ARE IN CA2009C0M.DEP.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     BHS 08/09/84  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED COMMENTS TO RELATE TO OTHER TEST FILES
+ --                   AND TO DESCRIBE EXPECTED COMPILER ACTION.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ SEPARATE (CA2009C0M)
+ PACKAGE BODY PKG1 IS
+ BEGIN
+      VAR1 := CON1;
+ END PKG1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- CA2009D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A GENERIC SUBPROGRAM SUBUNIT CAN BE SPECIFIED AND
+ -- INSTANTIATED.
+ 
+ -- BHS 8/01/84
+ -- JRK 5/24/85  CHANGED TO .ADA, SEE AI-00323.
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2009D IS
+ 
+      INT1 : INTEGER := 1;
+      INT2 : INTEGER := 2;
+ 
+ 
+      GENERIC
+           TYPE ELEM IS PRIVATE;
+           PCON1 : IN ELEM;
+           PVAR1 : IN OUT ELEM;
+      PROCEDURE PROC1;
+ 
+ 
+      GENERIC
+           TYPE OBJ IS PRIVATE;
+           FCON1 : IN OBJ;
+           FVAR1 : IN OUT OBJ;
+      FUNCTION FUNC1 RETURN OBJ;
+ 
+ 
+      PROCEDURE PROC1 IS SEPARATE;
+      FUNCTION FUNC1 RETURN OBJ IS SEPARATE;
+ 
+ 
+      PROCEDURE NI_PROC1 IS NEW PROC1 (INTEGER, 2, INT1);
+      FUNCTION NI_FUNC1 IS NEW FUNC1 (INTEGER, 3, INT2);
+ 
+ 
+ BEGIN
+ 
+      TEST ("CA2009D", "SPECIFICATION AND INSTANTIATION " &
+                       "OF GENERIC SUBPROGRAM SUBUNITS");
+ 
+      NI_PROC1;
+      IF INT1 /= 2 THEN
+           FAILED ("INCORRECT INSTANTIATION - NI_PROC1");
+      END IF;
+ 
+ 
+      IF NI_FUNC1 /= 3 THEN
+           FAILED ("INCORRECT INSTANTIATION - NI_FUNC1");
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ END CA2009D;
+ 
+ 
+ SEPARATE (CA2009D)
+ PROCEDURE PROC1 IS
+ BEGIN
+      PVAR1 := PCON1;
+ END PROC1;
+ 
+ 
+ SEPARATE (CA2009D)
+ FUNCTION FUNC1 RETURN OBJ IS
+ BEGIN
+      FVAR1 := FCON1;
+      RETURN FVAR1;
+ END FUNC1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009f0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009f0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009f0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009f0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- CA2009F0M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A GENERIC SUBPROGRAM SUBUNIT CAN BE SPECIFIED AND
+ --     INSTANTIATED.  IN THIS TEST, SOME SUBUNIT BODIES ARE
+ --     IN SEPARATE FILES.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- SEPARATE FILES ARE:
+ --     CA2009F0M  THE MAIN PROCEDURE, WITH SUBUNIT BODIES FOR
+ --                     PROC2 AND FUNC2.
+ --     CA2009F1   A SUBUNIT PROCEDURE BODY (PROC1).
+ --     CA2009F2   A SUBUNIT FUNCTION BODY  (FUNC1).
+ 
+ -- HISTORY:
+ --     BHS 08/01/84  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  ADDED "SOME" TO FIRST COMMENT.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ --     RLB 09/15/99  REMOVED JUNK COMMENT.
+ 
+ WITH REPORT;
+ USE REPORT;
+ PROCEDURE CA2009F0M IS
+ 
+      INT1 : INTEGER := 1;
+      INT2 : INTEGER := 2;
+      INT3 : INTEGER := 3;
+      INT4 : INTEGER := 4;
+ 
+ 
+      GENERIC
+           TYPE ELEM IS PRIVATE;
+           PCON1 : IN ELEM;
+           PVAR1 : IN OUT ELEM;
+      PROCEDURE PROC1;
+ 
+      GENERIC
+           TYPE ELEM IS PRIVATE;
+           PCON2 : IN ELEM;
+           PVAR2 : IN OUT ELEM;
+      PROCEDURE PROC2;
+ 
+      GENERIC
+           TYPE OBJ IS PRIVATE;
+           FCON1 : IN OBJ;
+           FVAR1 : IN OUT OBJ;
+      FUNCTION FUNC1 RETURN OBJ;
+ 
+      GENERIC
+           TYPE OBJ IS PRIVATE;
+           FCON2 : IN OBJ;
+           FVAR2 : IN OUT OBJ;
+      FUNCTION FUNC2 RETURN OBJ;
+ 
+ 
+      PROCEDURE PROC1 IS SEPARATE;
+      PROCEDURE PROC2 IS SEPARATE;
+      FUNCTION FUNC1 RETURN OBJ IS SEPARATE;
+      FUNCTION FUNC2 RETURN OBJ IS SEPARATE;
+ 
+ 
+      PROCEDURE NI_PROC1 IS NEW PROC1 (INTEGER, 2, INT1);
+      PROCEDURE NI_PROC2 IS NEW PROC2 (INTEGER, 3, INT2);
+      FUNCTION NI_FUNC1 IS NEW FUNC1 (INTEGER, 4, INT3);
+      FUNCTION NI_FUNC2 IS NEW FUNC2 (INTEGER, 5, INT4);
+ 
+ 
+ BEGIN
+ 
+      TEST ("CA2009F", "SPECIFICATION AND INSTANTIATION " &
+                       "OF GENERIC SUBPROGRAM SUBUNITS");
+ 
+      NI_PROC1;
+      IF INT1 /= 2 THEN
+           FAILED ("INCORRECT INSTANTIATION - NI_PROC1");
+      END IF;
+ 
+      NI_PROC2;
+      IF INT2 /= 3 THEN
+           FAILED ("INCORRECT INSTANTIATION - NI_PROC2");
+      END IF;
+ 
+      IF NI_FUNC1 /= 4 THEN
+           FAILED ("INCORRECT INSTANTIATION - NI_FUNC1");
+      END IF;
+ 
+      IF NI_FUNC2 /= 5 THEN
+           FAILED ("INCORRECT INSTANTIATION - NI_FUNC2");
+      END IF;
+ 
+ 
+      RESULT;
+ 
+ END CA2009F0M;
+ 
+ 
+ SEPARATE (CA2009F0M)
+ PROCEDURE PROC2 IS
+ BEGIN
+      PVAR2 := PCON2;
+ END PROC2;
+ 
+ SEPARATE (CA2009F0M)
+ FUNCTION FUNC2 RETURN OBJ IS
+ BEGIN
+      FVAR2 := FCON2;
+      RETURN FVAR2;
+ END FUNC2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009f1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009f1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009f1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009f1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,43 ----
+ -- CA2009F1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATE GENERIC PROCEDURE BODY.
+ -- SPECIFICATION, BODY STUB, AND INSTANTIATION ARE IN A2009F0M.DEP.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     BHS 08/01/84  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  MODIFIED COMMENTS TO SHOW RELATION TO OTHER FILES
+ --                   AND TO CLARIFY NON-APPLICABILITY.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ SEPARATE (CA2009F0M)
+ PROCEDURE PROC1 IS
+ BEGIN
+      PVAR1 := PCON1;
+ END PROC1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009f2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009f2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2009f2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2009f2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,45 ----
+ -- CA2009F2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- SEPARATE GENERIC FUNCTION BODY.
+ -- SPECIFICATION, BODY STUB, AND AN INSTANTIATION ARE
+ -- IN CA2009F0M.DEP.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     BHS 08/01/84  CREATED ORIGINAL TEST.
+ --     PWB 02/19/86  MODIFIED COMMENTS TO DESCRIBE RELATION TO OTHER
+ --                   FILES AND POSSIBLE NON-APPLICABILITY.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ SEPARATE (CA2009F0M)
+ FUNCTION FUNC1 RETURN OBJ IS
+ BEGIN
+      FVAR1 := FCON1;
+      RETURN FVAR1;
+ END FUNC1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2011b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2011b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca2011b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca2011b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- CA2011B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FOR A SUBPROGRAM DECLARATION-STUB-BODY TRIPLE, THE
+ --     DECLARATION-STUB AND STUB-BODY SPECIFICATIONS CAN CONFORM, BUT
+ --     THE DECLARATION-BODY SPECIFICATIONS NEED NOT.
+ 
+ -- HISTORY:
+ --     JET 08/01/88  CREATED ORIGINAL TEST.
+ 
+ PACKAGE CA2011B0 IS
+      SUBTYPE T IS INTEGER RANGE -100 .. 100;
+      I : T := 0;
+ END CA2011B0;
+ 
+ WITH CA2011B0; USE CA2011B0;
+ PACKAGE CA2011B1 IS
+      PROCEDURE P1 (X : CA2011B0.T);
+      PROCEDURE P2 (X : T);
+ END CA2011B1;
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY CA2011B1 IS
+      PACKAGE CA2011BX RENAMES CA2011B0;
+      PROCEDURE P1 (X : T) IS SEPARATE;
+      PROCEDURE P2 (X : CA2011BX.T) IS SEPARATE;
+ END CA2011B1;
+ 
+ SEPARATE (CA2011B1)
+ PROCEDURE P1 (X : CA2011BX.T) IS
+ BEGIN
+      I := IDENT_INT(X);
+ END P1;
+ 
+ SEPARATE (CA2011B1)
+ PROCEDURE P2 (X : CA2011BX.T) IS
+ BEGIN
+      I := IDENT_INT(X);
+ END P2;
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA2011B0, CA2011B1;
+ PROCEDURE CA2011B IS
+ 
+      PACKAGE P1 IS
+           SUBTYPE T IS INTEGER RANGE -100 .. 100;
+      END P1;
+      USE P1;
+ 
+      FUNCTION F1 RETURN P1.T;
+      FUNCTION F2 RETURN T;
+ 
+      PACKAGE P2 RENAMES P1;
+ 
+      FUNCTION F1 RETURN T IS SEPARATE;
+      FUNCTION F2 RETURN P2.T IS SEPARATE;
+ 
+ BEGIN
+      TEST ("CA2011B", "CHECK THAT FOR A SUBPROGRAM DECLARATION-STUB-" &
+                       "BODY TRIPLE, THE DECLARATION-STUB AND STUB-" &
+                       "BODY SPECIFICATIONS CAN CONFORM, BUT THE " &
+                       "DECLARATON-BODY SPECIFICATIONS NEED NOT");
+ 
+      IF F1 /= IDENT_INT(100) THEN
+           FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 1");
+      END IF;
+ 
+      IF F2 /= IDENT_INT(-100) THEN
+           FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 2");
+      END IF;
+ 
+      CA2011B1.P1(3);
+      IF CA2011B0.I /= IDENT_INT(3) THEN
+           FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 1");
+      END IF;
+ 
+      CA2011B1.P2(4);
+      IF CA2011B0.I /= IDENT_INT(4) THEN
+           FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 2");
+      END IF;
+ 
+      RESULT;
+ END CA2011B;
+ 
+ SEPARATE (CA2011B)
+ FUNCTION F1 RETURN P2.T IS
+ BEGIN
+      RETURN 100;
+ END F1;
+ 
+ SEPARATE (CA2011B)
+ FUNCTION F2 RETURN P2.T IS
+ BEGIN
+      RETURN -100;
+ END F2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca21001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca21001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca21001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca21001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,152 ----
+ -- CA21001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+ --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+ --     software and documentation contained herein.  Unlimited rights are
+ --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+ --     the Government intends to confer upon all recipients unlimited rights
+ --     equal to those held by the Government.  These rights include rights to
+ --     use, duplicate, release or disclose the released technical data and
+ --     computer software in whole or in part, in any manner and for any purpose
+ --     whatsoever, and to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE
+ --     Check the requirements of the revised 10.2.1(11) from Technical
+ --     Corrigendum 1 (originally discussed as AI95-00002).
+ --     A package subunit whose parent is a preelaborated subprogram need
+ --     not be preelaborable.
+ --
+ -- TEST DESCRIPTION
+ --     We create several preelaborated library procedures with
+ --     non-preelaborable package body subunits.  We try various levels
+ --     of nesting of package and procedure subunits.
+ --
+ -- CHANGE HISTORY:
+ --      29 JUN 1999   RAD   Initial Version
+ --      23 SEP 1999   RLB   Improved comments, renamed, issued.
+ --
+ --!
+ 
+ procedure CA21001_1(X: out Integer);
+     pragma Preelaborate(CA21001_1);
+ 
+ procedure CA21001_1(X: out Integer) is
+     function F return Integer is separate;
+ 
+     package Sub is
+         function G(X: Integer) return Integer;
+             -- Returns X + 1.
+         Not_Preelaborable: Integer := F; -- OK, by AI-2.
+     end Sub;
+ 
+     package body Sub is separate;
+ 
+ begin
+     X := -1;
+     X := F;
+     X := Sub.G(X);
+ end CA21001_1;
+ 
+ separate(CA21001_1)
+ package body Sub is
+     package Sub_Sub is
+         -- Empty.
+     end Sub_Sub;
+     package body Sub_Sub is separate;
+ 
+     function G(X: Integer) return Integer is separate;
+ begin
+     Not_Preelaborable := G(F); -- OK, by AI-2.
+     if Not_Preelaborable /= 101 then
+         raise Program_Error; -- Can't call Report.Failed, here,
+             -- because Report is not preelaborated.
+     end if;
+ end Sub;
+ 
+ separate(CA21001_1.Sub)
+ package body Sub_Sub is
+ begin
+     X := X; -- OK by AI-2.
+ end Sub_Sub;
+ 
+ separate(CA21001_1.Sub)
+ function G(X: Integer) return Integer is
+ 
+     package G_Sub is
+         function H(X: Integer) return Integer;
+             -- Returns X + 1.
+         Not_Preelaborable: Integer := F; -- OK, by AI-2.
+     end G_Sub;
+     package body G_Sub is separate;
+ 
+ begin
+     return G_Sub.H(X);
+ end G;
+ 
+ separate(CA21001_1.Sub.G)
+ package body G_Sub is
+     function H(X: Integer) return Integer is separate;
+ begin
+     Not_Preelaborable := H(F); -- OK, by AI-2.
+     if Not_Preelaborable /= 101 then
+         raise Program_Error; -- Can't call Report.Failed, here,
+             -- because Report is not preelaborated.
+     end if;
+ end G_Sub;
+ 
+ separate(CA21001_1.Sub.G.G_Sub)
+ function H(X: Integer) return Integer is
+ begin
+     return X + 1;
+ end H;
+ 
+ separate(CA21001_1)
+ function F return Integer is
+ 
+     package F_Sub is
+         -- Empty.
+     end F_Sub;
+ 
+     package body F_Sub is separate;
+ begin
+     return 100;
+ end F;
+ 
+ separate(CA21001_1.F)
+ package body F_Sub is
+     True_Var: Boolean;
+ begin
+     True_Var := True;
+     if True_Var then -- OK by AI-2.
+         X := X;
+     else
+         X := X + 2;
+     end if;
+ end F_Sub;
+ 
+ with Report; use Report;
+ with CA21001_1;
+ procedure CA21001 is
+     X: Integer := 0;
+ begin
+     Test("CA21001",
+          "Test that a package subunit whose parent is a preelaborated"
+          & " subprogram need not be preelaborable");
+     CA21001_1(X);
+     if X /= 101 then
+         Failed("Bad value for X");
+     end if;
+     Result;
+ end CA21001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,74 ----
+ -- CA3011A0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- A GENERIC UNIT.
+ -- SUBUNITS ARE IN CA3011A1, CA3011A2, AND CA3011A3.
+ -- INSTANTIATION IS IN CA3011A4M.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     RJW 09/22/86  CREATED ORIGINAL TEST.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ GENERIC
+      TYPE T IS (<>);
+      X : T;
+ PROCEDURE CA3011A0 (Z : OUT T);
+ 
+ PROCEDURE CA3011A0 (Z : OUT T) IS
+      T1 : T;
+ 
+      FUNCTION CA3011A1 RETURN T IS SEPARATE;
+ 
+      PROCEDURE CA3011A2 (Y : OUT T) IS SEPARATE;
+ 
+      PACKAGE CA3011A3 IS
+           FUNCTION CA3011A3F RETURN T;
+      END CA3011A3;
+ 
+      PACKAGE BODY CA3011A3 IS SEPARATE;
+ 
+ BEGIN
+      IF CA3011A1 /= X THEN
+           FAILED ( "INCORRECT VALUE RETURNED BY FUNCTION CA3011A1" );
+      END IF;
+ 
+      CA3011A2 (T1);
+ 
+      IF T1 /= X THEN
+           FAILED ( "INCORRECT VALUE RETURNED BY PROCEDURE CA3011A2 " );
+      END IF;
+ 
+      IF CA3011A3.CA3011A3F /= X THEN
+           FAILED ( "INCORRECT VALUE RETURNED BY FUNCTION CA3011A3F " );
+      END IF;
+ 
+      Z := X;
+ 
+ END CA3011A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,42 ----
+ -- CA3011A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- A SUBUNIT OF A GENERIC UNIT.
+ -- THE GENERIC UNIT IS IN CA3011A0.
+ -- INSTANTIATION IS IN CA0011A4M.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     RJW 09/22/86  CREATED ORIGINAL TEST.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ SEPARATE (CA3011A0)
+ FUNCTION CA3011A1 RETURN T IS
+ 
+ BEGIN
+      RETURN X;
+ END CA3011A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,42 ----
+ -- CA3011A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- A SUBUNIT OF A GENERIC UNIT.
+ -- THE GENERIC UNIT IS IN CA3011A0.
+ -- INSTANTIATION IS IN CA3011A4M.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     RJW 09/22/86  CREATED ORIGINAL TEST.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ SEPARATE (CA3011A0)
+ PROCEDURE CA3011A2 (Y : OUT T) IS
+ 
+ BEGIN
+      Y := X;
+ END CA3011A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,43 ----
+ -- CA3011A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- A SUBUNIT OF A GENERIC UNIT.
+ -- THE GENERIC UNIT IS IN CA3011A0.
+ -- INSTANTIATION IS IN CA3011A4M.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+ 
+ -- HISTORY:
+ --     RJW 09/22/86  CREATED ORIGINAL TEST.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ 
+ SEPARATE (CA3011A0)
+ PACKAGE BODY CA3011A3 IS
+      FUNCTION CA3011A3F RETURN T IS
+      BEGIN
+           RETURN X;
+      END;
+ END CA3011A3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca3011a4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca3011a4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,61 ----
+ -- CA3011A4M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN IMPLEMENTATION DOES NOT REQUIRE GENERIC UNIT BODIES AND
+ --     SUBUNITS TO BE COMPILED TOGETHER IN THE SAME FILE.
+ 
+ -- SEPARATE FILES ARE:
+ --     CA3011A0 - A GENERIC UNIT.
+ --     CA3011A1, CA3011A2, CA3011A3 - SUBUNITS OF GENERIC UNIT.
+ --     CA3011A4M - THE MAIN PROCEDURE.
+ 
+ -- APPLICABILITY CRITERIA:
+ --     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+ --     THIS WAS NOT REQUIRED FOR ADA 83.
+ 
+ -- HISTORY:
+ --     RJW 09/22/86  CREATED ORIGINAL TEST.
+ --     BCB 01/05/88  MODIFIED HEADER.
+ --     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+ --     RLB 09/15/99  REPAIRED OBJECTIVE FOR ADA 95.
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA3011A0;
+ PROCEDURE CA3011A4M IS
+      I : INTEGER;
+      PROCEDURE P IS NEW CA3011A0 (INTEGER, 22);
+ 
+ BEGIN
+      TEST ( "CA3011A", "CHECK THAT AN IMPLEMENTATION DOES NOT REQUIRE " &
+                        "GENERIC UNIT BODIES AND SUBUNITS TO BE " &
+                        "COMPILED TOGETHER IN THE SAME FILE" );
+ 
+      P (I);
+      IF I /= 22 THEN
+           FAILED ( "INCORRECT INSTANTIATION" );
+      END IF;
+ 
+      RESULT;
+ END CA3011A4M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,50 ----
+ -- CA5003A0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ 
+ PACKAGE CA5003A0 IS
+ 
+      ORDER : STRING (1..5) := "     ";
+ 
+      INDEX : NATURAL := 1;
+ 
+      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER;
+ 
+ END CA5003A0;
+ 
+ 
+ WITH REPORT;
+ USE REPORT;
+ PACKAGE BODY CA5003A0 IS
+ 
+      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER IS
+      BEGIN
+           ORDER (INDEX) := UNIT;
+           INDEX := INDEX + 1;
+           RETURN INDEX - 1;
+      END SHOW_ELAB;
+ 
+ END CA5003A0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA5003A1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ 
+ WITH CA5003A0;
+ USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+ PACKAGE CA5003A1 IS
+ 
+      A1 : INTEGER := SHOW_ELAB ('1');
+ 
+ END CA5003A1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA5003A2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ 
+ WITH CA5003A0;
+ USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+ PACKAGE CA5003A2 IS
+ 
+      A2 : INTEGER := SHOW_ELAB ('2');
+ 
+ END CA5003A2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA5003A3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ 
+ WITH CA5003A0, CA5003A2;
+ USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+ PACKAGE CA5003A3 IS
+ 
+      A3 : INTEGER := SHOW_ELAB ('3');
+ 
+ END CA5003A3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA5003A4.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ 
+ WITH CA5003A0, CA5003A2;
+ USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+ PACKAGE CA5003A4 IS
+ 
+      A4 : INTEGER := SHOW_ELAB ('4');
+ 
+ END CA5003A4;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a5.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a5.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a5.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,34 ----
+ -- CA5003A5.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ 
+ WITH CA5003A0, CA5003A3, CA5003A4;
+ USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+ PACKAGE CA5003A5 IS
+ 
+      A5 : INTEGER := SHOW_ELAB ('5');
+ 
+ END CA5003A5;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a6.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a6.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003a6.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003a6.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,71 ----
+ -- CA5003A6M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ELABORATION OF LIBRARY UNITS REQUIRED BY
+ --   A MAIN PROGRAM IS PERFORMED CONSISTENTLY WITH THE PARTIAL
+ --   ORDERING DEFINED BY THE COMPILATION ORDER RULES.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA5003A0  A LIBRARY PACKAGE.
+ --   CA5003A1  A LIBRARY PACKAGE SPECIFICATION.
+ --   CA5003A2  A LIBRARY PACKAGE SPECIFICATION.
+ --   CA5003A3  A LIBRARY PACKAGE SPECIFICATION.
+ --   CA5003A4  A LIBRARY PACKAGE SPECIFICATION.
+ --   CA5003A5  A LIBRARY PACKAGE SPECIFICATION.
+ --   CA5003A6M THE MAIN PROCEDURE.
+ 
+ -- PACKAGE A5 MUST BE ELABORATED AFTER A2, A3, AND A4.
+ -- PACKAGE A3 MUST BE ELABORATED AFTER A2.
+ -- PACKAGE A4 MUST BE ELABORATED AFTER A2.
+ 
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ 
+ WITH REPORT, CA5003A0;
+ USE REPORT, CA5003A0;
+ WITH CA5003A1, CA5003A5;
+ PROCEDURE CA5003A6M IS
+ 
+ BEGIN
+ 
+      TEST ("CA5003A", "CHECK THAT ELABORATION ORDER IS CONSISTENT " &
+                       "WITH PARTIAL ORDERING REQUIREMENTS");
+ 
+      COMMENT ("ACTUAL ELABORATION ORDER WAS " & ORDER);
+ 
+      IF ORDER /= "12345" AND
+         ORDER /= "12435" AND
+         ORDER /= "21345" AND
+         ORDER /= "21435" AND
+         ORDER /= "23145" AND
+         ORDER /= "24135" AND
+         ORDER /= "23415" AND
+         ORDER /= "24315" AND
+         ORDER /= "23451" AND
+         ORDER /= "24351" THEN
+           FAILED ("ILLEGAL ELABORATION ORDER");
+      END IF;
+ 
+      RESULT;
+ END CA5003A6M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,51 ----
+ -- CA5003B0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ -- BHS 8/02/84
+ -- JRK 9/20/84
+ 
+ 
+ PACKAGE CA5003B0 IS
+ 
+      ORDER : STRING (1..4) := "    ";
+ 
+      INDEX : NATURAL := 1;
+ 
+      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER;
+ 
+ END CA5003B0;
+ 
+ 
+ PACKAGE BODY CA5003B0 IS
+ 
+      FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER IS
+      BEGIN
+           ORDER (INDEX) := UNIT;
+           INDEX := INDEX + 1;
+           RETURN INDEX - 1;
+      END SHOW_ELAB;
+ 
+ END CA5003B0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,46 ----
+ -- CA5003B1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ -- BHS 8/02/84
+ -- JRK 9/20/84
+ 
+ 
+ WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+ PACKAGE CA5003B1 IS
+ 
+      PACKAGE CA5003B2 IS
+           PROCEDURE P1;
+      END CA5003B2;
+ 
+ END CA5003B1;
+ 
+ 
+ PACKAGE BODY CA5003B1 IS
+ 
+      A1 : INTEGER := SHOW_ELAB ('1');
+      PACKAGE BODY CA5003B2 IS SEPARATE;
+ 
+ END CA5003B1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,45 ----
+ -- CA5003B2.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 8/02/84
+ -- JRK 9/20/84
+ 
+ WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+ SEPARATE (CA5003B1)
+ PACKAGE BODY CA5003B2 IS
+ 
+      A2 : INTEGER := SHOW_ELAB ('2');
+ 
+      PROCEDURE P1 IS
+      BEGIN
+           NULL;
+      END P1;
+ 
+      PACKAGE CA5003B4 IS 
+           PROCEDURE P2;
+      END CA5003B4;
+ 
+      PACKAGE BODY CA5003B4 IS SEPARATE;
+ 
+ END CA5003B2;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b3.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b3.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b3.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b3.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,35 ----
+ -- CA5003B3.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ -- BHS 8/02/84
+ -- JRK 9/20/84
+ 
+ WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+ PACKAGE CA5003B3 IS
+ 
+      A3 : INTEGER := SHOW_ELAB ('3');
+ 
+ END CA5003B3;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b4.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b4.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b4.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b4.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,40 ----
+ -- CA5003B4.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- BHS 8/02/84
+ -- JRK 9/20/84
+ 
+ WITH CA5003B3;                -- MUST BE ELABORATED BEFORE CA5003B1.
+ WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+ SEPARATE (CA5003B1.CA5003B2)
+ PACKAGE BODY CA5003B4 IS
+ 
+      A4 : INTEGER := SHOW_ELAB ('4');
+ 
+      PROCEDURE P2 IS
+      BEGIN
+           NULL;
+      END P2;
+ 
+ END CA5003B4;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b5.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b5.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5003b5.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5003b5.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,65 ----
+ -- CA5003B5M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ELABORATION OF LIBRARY UNITS REQUIRED BY
+ --   A MAIN PROGRAM IS PERFORMED CONSISTENTLY WITH THE PARTIAL
+ --   ORDERING DEFINED BY THE COMPILATION ORDER RULES.
+ -- IN PARTICULAR, CHECK THAT A LIBRARY UNIT MENTIONED IN THE
+ --   WITH_CLAUSE OF A SUBUNIT IS ELABORATED PRIOR TO THE BODY OF 
+ --   THE ANCESTOR UNIT.
+ 
+ -- SEPARATE FILES ARE:
+ --   CA5003B0  A LIBRARY PACKAGE.
+ --   CA5003B1  A LIBRARY PACKAGE.
+ --   CA5003B2  A SUBUNIT PACKAGE BODY (_B1._B2).
+ --   CA5003B3  A LIBRARY PACKAGE DECLARATION.
+ --   CA5003B4  A SUBUNIT PACKAGE BODY (_B1._B2._B4).
+ --   CA5003B5M THE MAIN PROCEDURE.
+ 
+ -- LIBRARY PACKAGES MUST BE ELABORATED IN ORDER: _B0, _B3, _B1.
+ -- PARENT UNITS MUST BE ELABORATED BEFORE THEIR SUBUNITS.
+ 
+ -- WKB 7/22/81
+ -- JBG 10/6/83
+ -- BHS 8/02/84
+ -- JRK 9/20/84
+ 
+ WITH REPORT, CA5003B0;
+ USE REPORT, CA5003B0;
+ WITH CA5003B1;
+ PROCEDURE CA5003B5M IS
+ 
+ BEGIN
+      TEST ("CA5003B", "CHECK THAT UNITS IN WITH_CLAUSES OF " &
+                       "SUBUNITS ARE ELABORATED PRIOR TO THE " &
+                       "BODY OF THE ANCESTOR UNIT");
+ 
+      COMMENT ("ACTUAL ELABORATION ORDER WAS " & ORDER);
+ 
+      IF ORDER /= "3124" THEN
+           FAILED ("ILLEGAL ELABORATION ORDER");
+      END IF;
+ 
+      RESULT;
+ END CA5003B5M;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- CA5004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT IF PRAGMA ELABORATE IS APPLIED TO A PACKAGE THAT DECLARES
+ -- A TASK OBJECT, THE IMPLICIT PACKAGE BODY IS ELABORATED AND THE TASK
+ -- IS ACTIVATED.
+ 
+ -- BHS 8/03/84
+ -- JRK 9/20/84
+ -- PWN 01/31/95  ADDED A PROCEDURE TO REQUIRE A BODY FOR ADA 9X.
+ 
+ 
+ PACKAGE CA5004A0 IS
+ 
+      TASK TYPE TSK IS
+           ENTRY E (VAR : OUT INTEGER);
+      END TSK;
+ 
+ END CA5004A0;
+ 
+ 
+ PACKAGE BODY CA5004A0 IS
+ 
+      TASK BODY TSK IS
+      BEGIN
+           ACCEPT E (VAR : OUT INTEGER) DO
+                VAR := 4;
+           END E;
+      END TSK;
+ 
+ END CA5004A0;
+ 
+ 
+ WITH CA5004A0; USE CA5004A0; PRAGMA ELABORATE (CA5004A0);
+ PACKAGE CA5004A1 IS
+ 
+      T : TSK;
+ 
+ END CA5004A1;
+ 
+ 
+ PACKAGE CA5004A2 IS
+      PROCEDURE REQUIRE_BODY;
+ END CA5004A2;
+ 
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA5004A1; USE CA5004A1;
+ PRAGMA ELABORATE (CA5004A1, REPORT);
+ PACKAGE BODY CA5004A2 IS
+ 
+      I : INTEGER := 1;
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+           NULL;
+      END;
+ BEGIN
+ 
+      TEST ("CA5004A", "APPLYING PRAGMA ELABORATE TO A PACKAGE " &
+                       "DECLARING A TASK OBJECT CAUSES IMPLICIT " &
+                       "BODY ELABORATION AND TASK ACTIVATION");
+ 
+      SELECT
+           T.E(I);
+           IF I /= 4 THEN
+                FAILED ("TASK NOT EXECUTED PROPERLY");
+           END IF;
+      OR
+           DELAY 10.0;
+           FAILED ("TASK NOT ACTIVATED AFTER 10 SECONDS");
+      END SELECT;
+ 
+ END CA5004A2;
+ 
+ 
+ WITH CA5004A2;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CA5004A IS
+ BEGIN
+ 
+      RESULT;
+ 
+ END CA5004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004b0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004b0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004b0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,64 ----
+ -- CA5004B0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE: See CA5004B2M.ADA
+ --
+ -- SPECIAL INSTRUCTIONS:  See CA5004B2M.ADA
+ --
+ -- TEST FILES:
+ --     => CA5004B0.ADA
+ --        CA5004B1.ADA
+ --        CA5004B2M.ADA
+ 
+ -- PWN 05/31/96 Split test into files without duplicate unit names.
+ -- RLB 03/11/99 Split test into files so that units that will be replaced
+ --              and units that won't are not in the same source file.
+ 
+ -------------------------------------------------------------
+ 
+ PACKAGE HEADER IS 
+ 
+      PROCEDURE WRONG (WHY : STRING);
+ 
+ END HEADER;
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY HEADER IS
+ 
+      PROCEDURE WRONG (WHY : STRING) IS
+      BEGIN
+           FAILED ("PACKAGE WITH " & WHY & " NOT ELABORATED " &
+                   "CORRECTLY");
+      END WRONG;
+ 
+ BEGIN
+ 
+      TEST ("CA5004B", "PRAGMA ELABORATE IS ACCEPTED AND OBEYED " &
+                       "EVEN WHEN THE BODY OF THE UNIT NAMED IS " &
+                       "MISSING OR OBSOLETE");
+ 
+ END HEADER;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004b1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004b1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004b1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,56 ----
+ -- CA5004B1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE: See CA5004B2M.ADA
+ --
+ -- SPECIAL INSTRUCTIONS:  See CA5004B2M.ADA
+ --
+ -- TEST FILES:
+ --        CA5004B0.ADA
+ --     => CA5004B1.ADA
+ --        CA5004B2M.ADA
+ 
+ -- PWN 05/31/96 Split test into files without duplicate unit names.
+ -- RLB 03/11/99 Split test into files so that units that will be replaced
+ --              and units that won't are not in the same source file.
+ 
+ ------------------------------------------------------------------
+ 
+ PACKAGE CA5004B0 IS
+ 
+      I : INTEGER := 1;
+ 
+      FUNCTION F RETURN BOOLEAN;
+ 
+ END CA5004B0;
+ 
+ 
+ PACKAGE BODY CA5004B0 IS
+ 
+      FUNCTION F RETURN BOOLEAN IS
+      BEGIN
+           RETURN TRUE;
+      END F;
+ 
+ END CA5004B0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004b2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5004b2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5004b2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,153 ----
+ -- CA5004B2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PRAGMA ELABORATE IS ACCEPTED AND OBEYED EVEN IF THE UNIT
+ --    NAMED IN THE PRAGMA DOES NOT YET HAVE A BODY IN THE LIBRARY OR IF 
+ --    ITS BODY IS OBSOLETE.
+ -- CHECK THAT MORE THAN ONE NAME IS ALLOWED IN A PRAGMA ELABORATE.
+ --
+ -- SPECIAL INSTRUCTIONS:  
+ --     1. Compile CA5004B0.ADA
+ --     2. Compile CA5004B1.ADA
+ --     3. Compile CA5004B2M.ADA
+ --     4. Bind/Link main unit CA5004B2M
+ --     5. Execute the resulting file
+ --
+ -- TEST FILES:
+ --        CA5004B0.ADA
+ --        CA5004B1.ADA
+ --     => CA5004B2M.ADA
+ 
+ -- BHS 8/03/84
+ -- JRK 9/20/84
+ -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+ -- PWN 05/31/96 Split test into files without duplicate unit names.
+ -- TMB 11/20/96 ADDED PROCEDURE DECL TO CA5004B0 TO INSURE IT MAKES
+ --               THE OLD BODY OBSOLETE
+ -- TMB 12/2/96  MADE NAME OF MAIN PROCEDURE SAME AS FILE NAME
+ -- RLB 03/11/99 Split first test file in order to prevent good units
+ --              from being made obsolete.
+ 
+ -------------------------------------------------------------
+ 
+ PACKAGE CA5004B0 IS          -- OLD BODY NOW OBSOLETE.
+ 
+      I : INTEGER := 2;
+      B : BOOLEAN := TRUE;
+ 
+      FUNCTION F RETURN BOOLEAN;
+      PROCEDURE P;
+ 
+ END CA5004B0;
+ 
+ ---------------------------------------------------------
+ 
+ PACKAGE CA5004B1 IS
+ 
+      J : INTEGER := 3;
+ 
+      PROCEDURE P (X : INTEGER);
+ 
+ END CA5004B1;                -- NO BODY GIVEN YET.
+ 
+ ----------------------------------------------------------
+ 
+ WITH HEADER; USE HEADER;
+ WITH CA5004B0, CA5004B1;
+ USE CA5004B0, CA5004B1;
+ PRAGMA ELABORATE (HEADER, CA5004B0, CA5004B1);
+ PACKAGE CA5004B2 IS
+ 
+      K1 : INTEGER := CA5004B0.I;
+      K2 : INTEGER := CA5004B1.J;
+ 
+      PROCEDURE REQUIRE_BODY;
+ 
+ END CA5004B2;
+ 
+ 
+ PACKAGE BODY CA5004B2 IS
+ 
+      PROCEDURE REQUIRE_BODY IS
+      BEGIN
+        NULL;
+      END;
+ 
+ BEGIN
+ 
+      IF K1 /= 4 THEN
+           WRONG ("OBSOLETE BODY");
+      END IF;
+ 
+      IF K2 /= 5 THEN
+           WRONG ("NO BODY");
+      END IF;
+ 
+ END CA5004B2;
+ 
+ --------------------------------------------------
+ 
+ WITH REPORT, CA5004B2;
+ USE REPORT, CA5004B2;
+ PROCEDURE CA5004B2M IS
+ BEGIN
+ 
+      RESULT;
+ 
+ END CA5004B2M;
+ 
+ ----------------------------------------------------
+ 
+ PACKAGE BODY CA5004B0 IS
+ 
+      FUNCTION F RETURN BOOLEAN IS
+      BEGIN
+           RETURN FALSE;
+      END F;
+ 
+      PROCEDURE P IS
+      BEGIN
+         RETURN;
+      END P;
+ 
+ BEGIN
+ 
+      I := 4;
+ 
+ END CA5004B0;
+ 
+ ---------------------------------------------------
+ 
+ PACKAGE BODY CA5004B1 IS
+ 
+      PROCEDURE P (X : INTEGER) IS
+      BEGIN
+           NULL;
+      END P;
+ 
+ BEGIN
+ 
+      J := 5;
+ 
+ END CA5004B1;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/ca/ca5006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/ca/ca5006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- CA5006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A PROGRAM IS NOT REJECTED JUST BECAUSE THERE IS NO WAY TO
+ -- ELABORATE SECONDARY UNITS SO PROGRAM_ERROR WILL BE AVOIDED.
+ 
+ -- R.WILLIAMS 9/22/86
+ 
+ -----------------------------------------------------------------------
+ 
+ PACKAGE CA5006A0 IS
+    FUNCTION P_E_RAISED RETURN BOOLEAN;
+    PROCEDURE SHOW_PE_RAISED;
+ END CA5006A0;
+ 
+ -----------------------------------------------------------------------
+ 
+ WITH REPORT; USE REPORT;
+ PRAGMA ELABORATE (REPORT);
+ PACKAGE BODY CA5006A0 IS
+    RAISED : BOOLEAN := FALSE;
+ 
+    FUNCTION P_E_RAISED RETURN BOOLEAN IS
+    BEGIN
+       RETURN RAISED;
+    END P_E_RAISED;
+ 
+    PROCEDURE SHOW_PE_RAISED IS
+    BEGIN
+       RAISED := TRUE;
+    END SHOW_PE_RAISED;
+ 
+ BEGIN
+      TEST ( "CA5006A", "CHECK THAT A PROGRAM IS NOT REJECTED JUST " &
+                        "BECAUSE THERE IS NO WAY TO ELABORATE " &
+                        "SECONDARY UNITS SO PROGRAM_ERROR WILL BE " &
+                        "AVOIDED" );
+ 
+                          
+ END CA5006A0;
+ 
+ -----------------------------------------------------------------------
+ 
+ PACKAGE CA5006A1 IS
+   FUNCTION F RETURN INTEGER;
+ END CA5006A1;
+ 
+ -----------------------------------------------------------------------
+ 
+ PACKAGE CA5006A2 IS
+   FUNCTION G RETURN INTEGER;
+ END CA5006A2;
+ 
+ -----------------------------------------------------------------------
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA5006A0; USE CA5006A0;
+ WITH CA5006A2; USE CA5006A2;
+ PRAGMA ELABORATE(CA5006A0);
+ 
+ PACKAGE BODY CA5006A1 IS
+    X : INTEGER;
+ 
+    FUNCTION F RETURN INTEGER IS
+    BEGIN
+       RETURN IDENT_INT(0);
+    END F;
+ 
+ BEGIN
+    X := G;
+    IF NOT P_E_RAISED THEN
+       FAILED ( "G CALLED" );
+    END IF;
+ EXCEPTION
+    WHEN PROGRAM_ERROR =>
+       COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A1" );
+       SHOW_PE_RAISED;
+    WHEN OTHERS =>
+       FAILED ( "OTHER ERROR RAISED IN CA5006A1" );
+ END CA5006A1;
+ 
+ -----------------------------------------------------------------------
+ 
+ WITH REPORT; USE REPORT;
+ WITH CA5006A0; USE CA5006A0;
+ WITH CA5006A1; USE CA5006A1;
+ PRAGMA ELABORATE(CA5006A0);
+ 
+ PACKAGE BODY CA5006A2 IS
+    X : INTEGER;
+ 
+    FUNCTION G RETURN INTEGER IS
+    BEGIN
+       RETURN IDENT_INT(1);
+    END G;
+ 
+ BEGIN
+    X := F;
+    IF NOT P_E_RAISED THEN
+       FAILED ( "F CALLED" );
+    END IF;
+ EXCEPTION
+    WHEN PROGRAM_ERROR =>
+       COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A2" );
+       SHOW_PE_RAISED;
+    WHEN OTHERS =>
+       FAILED ( "OTHER ERROR RAISED IN CA5006A2" );
+ END CA5006A2;
+ 
+ -----------------------------------------------------------------------
+ 
+ WITH REPORT; USE REPORT; 
+ WITH CA5006A0; USE CA5006A0;
+ WITH CA5006A1; 
+ WITH CA5006A2; 
+ 
+ PROCEDURE CA5006A IS
+ BEGIN
+    IF NOT P_E_RAISED THEN
+       FAILED ( "PROGRAM_ERROR NEVER RAISED" );
+    END IF;
+ 
+    RESULT;
+ END CA5006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb10002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb10002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb10002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb10002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,128 ----
+ -- CB10002.A
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that Storage_Error is raised when storage for allocated objects
+ --      is exceeded.
+ --
+ -- TEST DESCRIPTION:
+ --      This test allocates a very large data structure.
+ --
+ --      In order to avoid running forever on virtual memory targets, the
+ --      data structure is bounded in size, and elements are larger the longer
+ --      the program runs.
+ --
+ --      The program attempts to allocate about 8,600,000 integers, or about
+ --      32 Megabytes on a typical 32-bit machine.
+ --
+ --      If Storage_Error is raised, the data structure is deallocated.
+ --      (Otherwise, Report.Result may fail as memory is exhausted).
+ 
+ -- CHANGE HISTORY:
+ --      30 Aug 85   JRK     Ada 83 test created.
+ --      14 Sep 99   RLB     Created Ada 95 test.
+ 
+ 
+ with Report;
+ with Ada.Unchecked_Deallocation;
+ procedure CB10002 is
+ 
+    type Data_Space is array (Positive range <>) of Integer;
+ 
+    type Element (Size : Positive);
+ 
+    type Link is access Element;
+ 
+    type Element (Size : Positive) is
+       record
+          Parent : Link;
+          Child  : Link;
+          Sibling: Link;
+          Data   : Data_Space (1 .. Size);
+       end record;
+ 
+     procedure Free is new Ada.Unchecked_Deallocation (Element, Link);
+ 
+     Holder : array (1 .. 430) of Link;
+     Last_Allocated : Natural := 0;
+ 
+     procedure Allocator (Count : in Positive) is
+     begin
+ 	-- Allocate various sized objects similar to what a real application
+ 	-- would do.
+ 	if Count in 1 .. 20 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(10));
+ 	elsif Count in 21 .. 40 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(79));
+ 	elsif Count in 41 .. 60 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(250));
+ 	elsif Count in 61 .. 80 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(520));
+ 	elsif Count in 81 .. 100 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(1000));
+ 	elsif Count in 101 .. 120 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(2048));
+ 	elsif Count in 121 .. 140 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(4200));
+ 	elsif Count in 141 .. 160 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(7999));
+ 	elsif Count in 161 .. 180 then
+ 	    Holder(Count) := new Element (Report.Ident_Int(15000));
+ 	else -- 181..430
+ 	    Holder(Count) := new Element (Report.Ident_Int(32000));
+ 	end if;
+ 	Last_Allocated := Count;
+     end Allocator;
+ 
+ 
+ begin
+    Report.Test ("CB10002", "Check that Storage_Error is raised when " &
+                            "storage for allocated objects is exceeded");
+ 
+    begin
+       for I in Holder'range loop
+          Allocator (I);
+       end loop;
+       Report.Not_Applicable ("Unable to exhaust memory");
+       for I in 1 .. Last_Allocated loop
+          Free (Holder(I));
+       end loop;
+    exception
+       when Storage_Error =>
+          if Last_Allocated = 0 then
+             Report.Failed ("Unable to allocate anything");
+          else -- Clean up, so we have enough memory to report on the result.
+             for I in 1 .. Last_Allocated loop
+                Free (Holder(I));
+             end loop;
+             Report.Comment (Natural'Image(Last_Allocated) & " items allocated");
+          end if;
+       when others =>
+          Report.Failed ("Wrong exception raised by heap overflow");
+    end;
+ 
+    Report.Result;
+ 
+ end CB10002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- CB1001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ALL PREDEFINED EXCEPTIONS MAY BE RAISED EXPLICITLY
+ --    AND MAY HAVE HANDLERS WRITTEN FOR THEM.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- DCB 03/25/80
+ -- JRK 11/17/80
+ -- SPS 11/2/82
+ -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT;
+ PROCEDURE CB1001A IS
+ 
+      USE REPORT;
+ 
+      FLOW_COUNT : INTEGER := 0;
+ 
+ BEGIN
+      TEST("CB1001A", "CHECK THAT ALL PREDEFINED EXCEPTIONS MAY BE " &
+           "RAISED EXPLICITLY AND MAY HAVE HANDLERS WRITTEN FOR THEM");
+ 
+      BEGIN
+           RAISE CONSTRAINT_ERROR;
+           FAILED("NO EXCEPTION RAISED WHEN CONSTRAINT_ERROR EXPECTED");
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION RAISED WHEN CONSTRAINT_ERROR " &
+                       "EXPECTED");
+      END;
+ 
+ 
+      BEGIN
+           RAISE PROGRAM_ERROR;
+           FAILED("NO EXCEPTION RAISED WHEN PROGRAM_ERROR EXPECTED");
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION RAISED WHEN PROGRAM_ERROR " &
+                       "EXPECTED");
+      END;
+ 
+      BEGIN
+           RAISE STORAGE_ERROR;
+           FAILED("NO EXCEPTION RAISED WHEN STORAGE_ERROR EXPECTED");
+ 
+      EXCEPTION
+           WHEN STORAGE_ERROR =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION RAISED WHEN STORAGE_ERROR " &
+                       "EXPECTED");
+      END;
+ 
+      BEGIN
+           RAISE TASKING_ERROR;
+           FAILED("NO EXCEPTION RAISED WHEN TASKING_ERROR EXPECTED");
+ 
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION RAISED WHEN TASKING_ERROR " &
+                       "EXPECTED");
+      END;
+ 
+      IF FLOW_COUNT /= 4 THEN
+           FAILED("WRONG FLOW_COUNT VALUE");
+      END IF;
+ 
+      RESULT;
+ END CB1001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,85 ----
+ -- CB1004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EXCEPTIONS DECLARED IN RECURSIVE PROCEDURES ARE NOT
+ --    REPLICATED ANEW FOR EACH RECURSIVE ACTIVATION OF THE PROCEDURE.
+ 
+ -- DCB 03/30/80
+ -- JRK 11/17/80
+ -- SPS 3/23/83
+ 
+ WITH REPORT;
+ PROCEDURE CB1004A IS
+ 
+      USE REPORT;
+ 
+      FLOW_COUNT : INTEGER := 0;
+ 
+      PROCEDURE P1(SWITCH1 : IN INTEGER) IS
+ 
+           E1 : EXCEPTION;
+ 
+           PROCEDURE P2 IS
+ 
+           BEGIN
+                FLOW_COUNT := FLOW_COUNT + 1;   -- 3
+                P1(2);
+                FAILED("EXCEPTION NOT PROPAGATED");
+ 
+           EXCEPTION
+                WHEN E1 =>
+                     FLOW_COUNT := FLOW_COUNT + 1;   -- 6
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED");
+           END P2;
+ 
+      BEGIN
+           FLOW_COUNT := FLOW_COUNT + 1;   -- 2   -- 4
+           IF SWITCH1 = 1 THEN
+                P2;
+           ELSIF SWITCH1 = 2 THEN
+                FLOW_COUNT := FLOW_COUNT + 1;   -- 5
+                RAISE E1;
+                FAILED("EXCEPTION NOT RAISED");
+           END IF;
+      END P1;
+ 
+ BEGIN
+      TEST("CB1004A","CHECK THAT EXCEPTIONS ARE NOT RECURSIVELY " &
+                     "REPLICATED");
+ 
+      FLOW_COUNT := FLOW_COUNT + 1;   -- 1
+      P1(1);
+ 
+      IF FLOW_COUNT /= 6 THEN
+           FAILED("INCORRECT FLOW_COUNT VALUE");
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED("EXCEPTION HANDLED IN WRONG SCOPE");
+           RESULT;
+ END CB1004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- CB1005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EXCEPTIONS DECLARED IN GENERIC PACKAGES AND PROCEDURES ARE
+ -- CONSIDERED DISTINCT FOR EACH INSTANTIATION.
+ 
+ -- CHECK THAT AN EXCEPTION NAME DECLARED IN A GENERIC PACKAGE
+ -- INSTANTIATION IN A RECURSIVE PROCEDURE DENOTES THE SAME ENTITY
+ -- EVEN WHEN THE INSTANTIATION IS ELABORATED MORE THAN ONCE BECAUSE
+ -- OF RECURSIVE CALLS.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- TBN  9/23/86
+ -- MRM  03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CB1005A IS
+ 
+      PROCEDURE PROP;
+ 
+      GENERIC
+           PACKAGE PAC IS
+                EXC : EXCEPTION;
+           END PAC;
+ 
+      GENERIC
+           PROCEDURE PROC (INST_AGAIN : BOOLEAN);
+ 
+      PROCEDURE PROC (INST_AGAIN : BOOLEAN) IS
+           EXC : EXCEPTION;
+      BEGIN
+           IF INST_AGAIN THEN
+                BEGIN
+                     PROP;
+                     FAILED ("EXCEPTION WAS NOT PROPAGATED - 9");
+                EXCEPTION
+                     WHEN EXC =>
+                          FAILED ("EXCEPTION NOT DISTINCT - 10");
+                     WHEN PROGRAM_ERROR | STORAGE_ERROR |
+                          TASKING_ERROR | CONSTRAINT_ERROR =>
+                          FAILED ("WRONG EXCEPTION PROPAGATED - 11");
+                     WHEN OTHERS =>
+                          NULL;
+                END;
+           ELSE
+                RAISE EXC;
+           END IF;
+      END PROC;
+ 
+      PROCEDURE RAISE_EXC (CALL_AGAIN : BOOLEAN) IS
+           PACKAGE PAC3 IS NEW PAC;
+      BEGIN
+           IF CALL_AGAIN THEN
+                BEGIN
+                     RAISE_EXC (FALSE);
+                     FAILED ("EXCEPTION WAS NOT PROPAGATED - 12");
+                EXCEPTION
+                     WHEN PAC3.EXC =>
+                          NULL;
+                END;
+           ELSE
+                RAISE PAC3.EXC;
+           END IF;
+      END RAISE_EXC;
+ 
+      PROCEDURE PROP IS
+           PROCEDURE PROC2 IS NEW PROC;
+      BEGIN
+           PROC2 (FALSE);
+      END PROP;
+ 
+ BEGIN
+      TEST ("CB1005A", "CHECK THAT EXCEPTIONS DECLARED IN GENERIC " &
+                       "PACKAGES AND PROCEDURES ARE CONSIDERED " &
+                       "DISTINCT FOR EACH INSTANTIATION");
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           PACKAGE PAC1 IS NEW PAC;
+           PACKAGE PAC2 IS NEW PAC;
+           PAC1_EXC_FOUND : BOOLEAN := FALSE;
+      BEGIN
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RAISE PAC2.EXC;
+                END IF;
+                FAILED ("EXCEPTION WAS NOT RAISED - 1");
+ 
+           EXCEPTION
+                WHEN PAC1.EXC =>
+                     FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 2");
+                     PAC1_EXC_FOUND := TRUE;
+           END;
+           IF NOT PAC1_EXC_FOUND THEN
+                FAILED ("EXCEPTION WAS NOT PROPAGATED - 3");
+           END IF;
+ 
+      EXCEPTION
+           WHEN PAC1.EXC =>
+                FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 4");
+           WHEN PAC2.EXC =>
+                BEGIN
+                     IF EQUAL (3, 3) THEN
+                          RAISE PAC1.EXC;
+                     END IF;
+                     FAILED ("EXCEPTION WAS NOT RAISED - 5");
+ 
+                EXCEPTION
+                     WHEN PAC2.EXC =>
+                          FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 6");
+                     WHEN PAC1.EXC =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("UNKNOWN EXCEPTION RAISED - 7");
+                END;
+           WHEN OTHERS =>
+                FAILED ("UNKNOWN EXCEPTION RAISED - 8");
+      END;
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           PROCEDURE PROC1 IS NEW PROC;
+      BEGIN
+           PROC1 (TRUE);
+      END;
+ 
+      -------------------------------------------------------------------
+      BEGIN
+           RAISE_EXC (TRUE);
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTIONS ARE DISTINCT FOR RECURSION - 13");
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ END CB1005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,179 ----
+ -- CB1010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT STORAGE_ERROR IS RAISED WHEN STORAGE ALLOCATED TO A TASK
+ -- IS EXCEEDED.
+ 
+ -- PNH 8/26/85
+ -- JRK 8/30/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB1010A IS
+ 
+      N : INTEGER := IDENT_INT (1);
+      M : INTEGER := IDENT_INT (0);
+ 
+      PROCEDURE OVERFLOW_STACK IS
+           A : ARRAY (1 .. 1000) OF INTEGER;
+      BEGIN
+           N := N + M;
+           A (N) := M;
+           IF N > M THEN  -- ALWAYS TRUE.
+                OVERFLOW_STACK;
+           END IF;
+           M := A (N);    -- TO PREVENT TAIL RECURSION OPTIMIZATION.
+      END OVERFLOW_STACK;
+ 
+ BEGIN
+      TEST ("CB1010A", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
+                       "STORAGE ALLOCATED TO A TASK IS EXCEEDED");
+ 
+      --------------------------------------------------
+ 
+      COMMENT ("CHECK TASKS THAT DO NOT HANDLE STORAGE_ERROR " &
+               "PRIOR TO RENDEZVOUS");
+ 
+      DECLARE
+ 
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+ 
+           TASK BODY T1 IS
+           BEGIN
+                OVERFLOW_STACK;
+                FAILED ("TASK T1 NOT TERMINATED BY STACK OVERFLOW");
+           END T1;
+ 
+      BEGIN
+ 
+           T1.E1;
+           FAILED ("NO EXCEPTION RAISED BY ENTRY CALL T1.E1");
+ 
+      EXCEPTION
+           WHEN TASKING_ERROR =>
+                IF N /= 1 OR M /= 0 THEN
+                     FAILED ("VALUES OF VARIABLES N OR M ALTERED - 1");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY CALL OF ENTRY E1 " &
+                        "OF TERMINATED TASK T1");
+      END;
+ 
+      --------------------------------------------------
+ 
+      COMMENT ("CHECK TASKS THAT DO HANDLE STORAGE_ERROR PRIOR TO " &
+               "RENDEZVOUS");
+ 
+      N := IDENT_INT (1);
+      M := IDENT_INT (0);
+ 
+      DECLARE
+ 
+           TASK T2 IS
+                ENTRY E2;
+           END T2;
+ 
+           TASK BODY T2 IS
+           BEGIN
+                OVERFLOW_STACK;
+                FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW IN " &
+                        "TASK T2");
+           EXCEPTION
+                WHEN STORAGE_ERROR =>
+                     ACCEPT E2;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN TASK T2 BY " &
+                             "STACK OVERFLOW");
+           END T2;
+ 
+      BEGIN
+ 
+           T2.E2;
+           IF N /= 1 OR M /= 0 THEN
+                FAILED ("VALUES OF VARIABLES N OR M ALTERED - 2");
+           END IF;
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED BY ENTRY CALL T2.E2");
+                ABORT T2;
+      END;
+ 
+      --------------------------------------------------
+ 
+      COMMENT ("CHECK TASKS THAT DO NOT HANDLE STORAGE_ERROR " &
+               "DURING RENDEZVOUS");
+ 
+      N := IDENT_INT (1);
+      M := IDENT_INT (0);
+ 
+      DECLARE
+ 
+           TASK T3 IS
+                ENTRY E3A;
+                ENTRY E3B;
+           END T3;
+ 
+           TASK BODY T3 IS
+           BEGIN
+                ACCEPT E3A DO
+                     OVERFLOW_STACK;
+                     FAILED ("EXCEPTION NOT RAISED IN ACCEPT E3A BY " &
+                             "STACK OVERFLOW");
+                END E3A;
+                FAILED ("EXCEPTION NOT PROPOGATED CORRECTLY IN TASK T3");
+           EXCEPTION
+                WHEN STORAGE_ERROR =>
+                     ACCEPT E3B;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED IN TASK T3 BY " &
+                             "STACK OVERFLOW");
+           END T3;
+ 
+      BEGIN
+ 
+           T3.E3A;
+           FAILED ("NO EXCEPTION RAISED BY ENTRY CALL T3.E3A");
+ 
+      EXCEPTION
+           WHEN STORAGE_ERROR =>
+                T3.E3B;
+                IF N /= 1 OR M /= 0 THEN
+                     FAILED ("VALUES OF VARIABLES N OR M ALTERED - 3");
+                END IF;
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED BY ENTRY CALL T3.E3A " &
+                        "INSTEAD OF STORAGE_ERROR");
+                ABORT T3;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY ENTRY CALL T3.E3A");
+                ABORT T3;
+      END;
+ 
+      --------------------------------------------------
+ 
+      RESULT;
+ END CB1010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1010c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1010c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1010c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1010c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- CB1010C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT STORAGE_ERROR IS RAISED WHEN STORAGE FOR A DECLARATIVE
+ -- ITEM IS INSUFFICIENT.
+ 
+ -- JRK 8/30/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB1010C IS
+ 
+      N : INTEGER := IDENT_INT (1000);
+      M : INTEGER := IDENT_INT (0);
+ 
+      PROCEDURE OVERFLOW_STACK IS
+      BEGIN
+           N := N + M;
+           DECLARE
+                A : ARRAY (1 .. N) OF INTEGER;
+           BEGIN
+                A (N) := M;
+                IF N > M THEN  -- ALWAYS TRUE.
+                     OVERFLOW_STACK;
+                END IF;
+                M := A (N);    -- TO PREVENT TAIL RECURSION OPTIMIZATION.
+           END;
+      END OVERFLOW_STACK;
+ 
+ BEGIN
+      TEST ("CB1010C", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
+                       "STORAGE FOR A DECLARATIVE ITEM IS INSUFFICIENT");
+ 
+      BEGIN
+ 
+           OVERFLOW_STACK;
+           FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW");
+ 
+      EXCEPTION
+           WHEN STORAGE_ERROR =>
+                IF N /= 1000 OR M /= 0 THEN
+                     FAILED ("VALUES OF VARIABLES N OR M WERE ALTERED");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY STACK OVERFLOW");
+      END;
+ 
+      RESULT;
+ END CB1010C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1010d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1010d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb1010d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb1010d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,92 ----
+ -- CB1010D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT STORAGE_ERROR IS RAISED WHEN STORAGE FOR THE EXECUTION OF
+ -- A SUBPROGRAM IS INSUFFICIENT.
+ 
+ -- PNH 8/26/85
+ -- JRK 8/30/85
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB1010D IS
+ 
+      N : INTEGER := IDENT_INT (1);
+      M : INTEGER := IDENT_INT (0);
+ 
+      PROCEDURE OVERFLOW_STACK IS
+      BEGIN
+           N := N + M;
+           IF N > M THEN       -- ALWAYS TRUE.
+                OVERFLOW_STACK;
+           END IF;
+           N := N - M;         -- TO PREVENT TAIL RECURSION OPTIMIZATION.
+      END OVERFLOW_STACK;
+ 
+ BEGIN
+      TEST ("CB1010D", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
+                       "STORAGE FOR THE EXECUTION OF A SUBPROGRAM " &
+                       "IS INSUFFICIENT");
+ 
+      -- CHECK HANDLING OF STORAGE_ERROR IN MAIN PROGRAM.
+ 
+      BEGIN
+           OVERFLOW_STACK;
+           FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW - 1");
+      EXCEPTION
+           WHEN STORAGE_ERROR =>
+                IF N /= 1 THEN
+                     FAILED ("VALUE OF VARIABLE N ALTERED - 1");
+                END IF;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED BY STACK OVERFLOW - 1");
+      END;
+ 
+      -- CHECK HANDLING OF STORAGE_ERROR IN SUBPROGRAM.
+ 
+      DECLARE
+ 
+           PROCEDURE P IS
+           BEGIN
+                OVERFLOW_STACK;
+                FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW - 2");
+           EXCEPTION
+                WHEN STORAGE_ERROR =>
+                     IF N /= 1 THEN
+                          FAILED ("VALUE OF VARIABLE N ALTERED - 2");
+                     END IF;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED BY STACK " &
+                             "OVERFLOW - 2");
+           END P;
+ 
+      BEGIN
+ 
+           N := IDENT_INT (1);
+           P;
+ 
+      END;
+ 
+      RESULT;
+ END CB1010D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,228 ----
+ -- CB20001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that exceptions can be handled in accept bodies, and that a
+ --      task object that has an exception handled in an accept body is still
+ --      viable for future use.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a task that has exception handlers within an accept
+ --      statement in the task body.  Declare a task object, and make entry
+ --      calls with data that will cause various exceptions to be raised
+ --      by the accept statement.  Ensure that the exceptions are: 
+ --         1) raised and handled locally in the accept body
+ --         2) raised in the accept body and handled/reraised to be handled 
+ --            by the task body
+ --         3) raised in the accept body and propagated to the calling 
+ --            procedure. 
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ 
+ package CB20001_0 is               
+ 
+    Incorrect_Data,
+    Location_Error,
+    Off_Screen_Data           : exception;
+ 
+    TC_Handled_In_Accept,
+    TC_Reraised_In_Accept,
+    TC_Handled_In_Task_Block,
+    TC_Handled_In_Caller      : boolean := False;
+ 
+    type Location_Type is range 0 .. 2000;
+ 
+    task type Submarine_Type is
+       entry Contact (Location : in Location_Type);
+    end Submarine_Type;
+ 
+    Current_Position : Location_Type := 0;
+ 
+ end CB20001_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ package body CB20001_0 is
+ 
+ 
+    task body Submarine_Type is
+    begin
+       loop
+ 
+          Task_Block:
+          begin
+             select
+                accept Contact (Location : in Location_Type) do
+                   if Location > 1000 then
+                      raise Off_Screen_Data;
+                   elsif (Location > 500) and (Location <= 1000) then
+                      raise Location_Error;
+                   elsif (Location > 100) and (Location <= 500) then
+                      raise Incorrect_Data;
+                   else
+                      Current_Position := Location;
+                   end if;
+                exception
+                   when Off_Screen_Data =>
+                      TC_Handled_In_Accept := True;
+                   when Location_Error =>
+                      TC_Reraised_In_Accept := True;
+                      raise;   -- Reraise the Location_Error exception
+                               -- in the task block.
+                end Contact;
+             or
+                terminate;
+             end select;
+ 
+          exception
+ 
+             when Off_Screen_Data =>
+                 TC_Handled_In_Accept := False;
+                 Report.Failed ("Off_Screen_Data exception " &
+                                "improperly handled in task block");
+ 
+             when Location_Error =>
+                 TC_Handled_In_Task_Block := True;
+          end Task_Block;
+ 
+       end loop;
+ 
+    exception
+ 
+       when Location_Error | Off_Screen_Data =>
+          TC_Handled_In_Accept := False;
+          TC_Handled_In_Task_Block := False;
+          Report.Failed ("Exception improperly propagated out to task body"); 
+       when others =>
+          null;
+    end Submarine_Type;
+ 
+ end CB20001_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with CB20001_0;       
+ with Report;
+ with ImpDef;
+ 
+ procedure CB20001 is
+ 
+    package Submarine_Tracking renames CB20001_0;
+ 
+    Trident       : Submarine_Tracking.Submarine_Type;   -- Declare task
+    Sonar_Contact : Submarine_Tracking.Location_Type;
+ 
+    TC_LEB_Error,
+    TC_Main_Handler_Used : Boolean := False;
+ 
+ begin
+ 
+    Report.Test ("CB20001", "Check that exceptions can be handled " &
+                            "in accept bodies");
+ 
+ 
+    Off_Screen_Block:
+    begin
+       Sonar_Contact := 1500;
+       Trident.Contact (Sonar_Contact);  -- Cause Off_Screen_Data exception
+                                         -- to be raised and handled in a task 
+                                         -- accept body.
+    exception                            
+       when Submarine_Tracking.Off_Screen_Data =>
+           TC_Main_Handler_Used := True;
+           Report.Failed ("Off_Screen_Data exception improperly handled " &
+                          "in calling procedure");
+       when others =>
+           Report.Failed ("Exception handled unexpectedly in " &
+                          "Off_Screen_Block");
+    end Off_Screen_Block;
+ 
+ 
+    Location_Error_Block:
+    begin
+       Sonar_Contact := 700;
+       Trident.Contact (Sonar_Contact);  -- Cause Location_Error exception
+                                         -- to be raised in task accept body,
+                                         -- propogated to a task block, and
+                                         -- handled there.  Corresponding
+                                         -- exception propagated here also.
+       Report.Failed ("Expected exception not raised");
+    exception                            
+       when Submarine_Tracking.Location_Error =>
+           TC_LEB_Error := True;
+       when others =>
+           Report.Failed ("Exception handled unexpectedly in " &
+                          "Location_Error_Block");
+    end Location_Error_Block;
+ 
+ 
+    Incorrect_Data_Block:
+    begin
+       Sonar_Contact := 200;
+       Trident.Contact (Sonar_Contact);  -- Cause Incorrect_Data exception
+                                         -- to be raised in task accept body,
+                                         -- propogated to calling procedure.
+       Report.Failed ("Expected exception not raised");
+    exception                            
+       when Submarine_Tracking.Incorrect_Data =>
+           Submarine_Tracking.TC_Handled_In_Caller := True;
+       when others =>
+           Report.Failed ("Exception handled unexpectedly in " &
+                          "Incorrect_Data_Block");
+    end Incorrect_Data_Block;
+ 
+ 
+    if TC_Main_Handler_Used or
+       not (Submarine_Tracking.TC_Handled_In_Caller     and -- Check to see that
+            Submarine_Tracking.TC_Handled_In_Task_Block and -- all exceptions
+            Submarine_Tracking.TC_Handled_In_Accept     and -- were handled in
+            Submarine_Tracking.TC_Reraised_In_Accept    and -- proper locations.
+            TC_LEB_Error)       
+    then                                                    
+       Report.Failed ("Exceptions handled in incorrect locations");
+    end if;
+ 
+    if Integer(Submarine_Tracking.Current_Position) /= 0 then
+       Report.Failed ("Variable incorrectly written in task processing");
+    end if;
+ 
+    delay ImpDef.Minimum_Task_Switch;
+    if Trident'Callable then
+       Report.Failed ("Task didn't terminate with exception propagation");
+    end if;
+ 
+    Report.Result;
+ 
+ end CB20001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,286 ----
+ -- CB20003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that exceptions can be raised, reraised, and handled in an
+ --      accessed subprogram.
+ --
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a record type, with one component being an access to
+ --      subprogram type.  Various subprograms are defined to fit the profile 
+ --      of this access type, such that the record component can refer to 
+ --      any of the subprograms.  
+ --
+ --      Each of the subprograms raises a different exception, based on the
+ --      value of an input parameter.  Exceptions are 1) raised, handled with
+ --      an others handler, reraised and propagated to main to be handled in
+ --      a specific handler; 2) raised, handled in a specific handler, reraised 
+ --      and propagated to the main to be handled in an others handler there,
+ --      and 3) raised and propagated directly to the caller by the subprogram.
+ --
+ --      Boolean variables are set throughout the test to ensure that correct
+ --      exception processing has occurred, and these variables are verified at
+ --      the conclusion of the test.
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CB20003_0 is                          -- package Push_Buttons 
+ 
+ 
+    Non_Default_Priority,
+    Non_Alert_Priority,
+    Non_Emergency_Priority : exception;
+ 
+    Handled_With_Others,
+    Reraised_In_Subprogram,
+    Handled_In_Caller      : Boolean := False;
+ 
+    subtype Priority_Type is Integer range 1 .. 10;
+ 
+    Default_Priority   : Priority_Type := 1;
+    Alert_Priority     : Priority_Type := 3;
+    Emergency_Priority : Priority_Type := 5;
+ 
+ 
+    type Button is tagged private;                  -- Private tagged type.
+ 
+    type Button_Response_Ptr is access procedure (P : in     Priority_Type;
+                                                  B : in out Button);
+ 
+ 
+    -- Procedures accessible with Button_Response_Ptr type.
+ 
+    procedure Default_Response   (P : in     Priority_Type;
+                                  B : in out Button);
+ 
+    procedure Alert_Response     (P : in     Priority_Type;
+                                  B : in out Button);
+ 
+    procedure Emergency_Response (P : in     Priority_Type;
+                                  B : in out Button);
+ 
+ 
+ 
+    procedure Push (B : in out Button;
+                    P : in     Priority_Type);
+ 
+    procedure Set_Response (B : in out Button;       
+                            R : in     Button_Response_Ptr);
+ 
+ private
+ 
+    type Button is tagged                   
+       record
+          Priority :  Priority_Type       := Default_Priority;
+          Response :  Button_Response_Ptr := Default_Response'Access;   
+       end record;
+ 
+ 
+ end CB20003_0;                                -- package Push_Buttons
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with Report;
+ 
+ package body CB20003_0 is                     -- package Push_Buttons 
+ 
+ 
+    procedure Push (B : in out Button;
+                    P : in     Priority_Type) is
+    begin                                  -- Invoking subprogram designated 
+       B.Response (P, B);                  -- by access value.
+    end Push;
+ 
+ 
+    procedure Set_Response (B : in out Button;
+                            R : in     Button_Response_Ptr) is
+    begin
+       B.Response := R;      -- Set procedure value in record
+    end Set_Response;
+ 
+ 
+    procedure Default_Response (P : in     Priority_Type;
+                                B : in out Button) is
+    begin
+       if (P > Default_Priority) then
+          raise Non_Default_Priority;
+          Report.Failed ("Exception not raised in procedure body");
+       else
+          B.Priority := P;
+       end if;
+    exception
+       when others =>                    -- Catch exception with others handler
+          Handled_With_Others := True;   -- Successfully caught with "others"
+          raise;
+          Report.Failed ("Exception not reraised in handler");
+    end Default_Response;
+ 
+ 
+ 
+    procedure Alert_Response (P : in     Priority_Type;
+                              B : in out Button) is
+    begin
+       if (P > Alert_Priority) then
+          raise Non_Alert_Priority;
+          Report.Failed ("Exception not raised in procedure body");
+       else
+          B.Priority := P;
+       end if;
+    exception
+       when Non_Alert_Priority =>
+          Reraised_In_Subprogram := True;
+          raise;                                  -- Propagate to caller.
+          Report.Failed ("Exception not reraised in procedure excpt handler");
+       when others =>
+          Report.Failed ("Incorrect exception raised/handled");
+    end Alert_Response;
+ 
+ 
+ 
+    procedure Emergency_Response (P : in     Priority_type;
+                                  B : in out Button) is
+    begin
+       if (P > Emergency_Priority) then
+          raise Non_Emergency_Priority;
+          Report.Failed ("Exception not raised in procedure body");
+       else
+          B.Priority := P;
+       end if;
+       -- No exception handler here, exception will be propagated to caller.
+    end Emergency_Response;
+ 
+ 
+ end CB20003_0;                                -- package Push_Buttons
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with Report;
+ with CB20003_0;                               -- package Push_Buttons
+ 
+ procedure CB20003 is
+       
+    package Push_Buttons renames CB20003_0;
+ 
+    Console_Button : Push_Buttons.Button;
+ 
+ begin
+ 
+    Report.Test ("CB20003", "Check that exceptions can be raised, "  &
+                            "reraised, and handled in a subprogram " &
+                            "referenced by an access to subprogram value");
+ 
+ 
+    Default_Response_Processing:                 -- The exception
+                                                 -- Handled_With_Others is to 
+                                                 -- be caught with an others
+                                                 -- handler in Default_Resp.,
+                                                 -- reraised, and handled with
+                                                 -- a specific handler here.
+    begin
+    
+       Push_Buttons.Push (Console_Button,        -- Raise exception that will
+                          Report.Ident_Int(2));  -- be handled in procedure.
+    exception
+       when Push_Buttons.Non_Default_Priority =>
+          if not Push_Buttons.Handled_With_Others then   -- Not reraised in 
+                                                         -- procedure.
+             Report.Failed 
+               ("Exception not handled/reraised in procedure");
+          end if;
+       when others =>
+          Report.Failed ("Exception handled in " &
+                         " Default_Response_Processing block");
+    end Default_Response_Processing;
+ 
+ 
+ 
+    Alert_Response_Processing:
+    begin
+    
+       Push_Buttons.Set_Response (Console_Button,
+                                  Push_Buttons.Alert_Response'access);
+ 
+       Push_Buttons.Push (Console_Button,        -- Raise exception that will
+                          Report.Ident_Int(4));  -- be handled in procedure, 
+                                                 -- reraised, and propagated
+                                                 -- to caller.
+       Report.Failed ("Exception not propagated to caller " &
+                      "in Alert_Response_Processing block");
+ 
+    exception                                    
+       when Push_Buttons.Non_Alert_Priority =>
+          if not Push_Buttons.Reraised_In_Subprogram then  -- Not reraised in 
+                                                           -- procedure.
+             Report.Failed ("Exception not reraised in procedure");
+          end if;
+       when others =>
+          Report.Failed ("Exception handled in " &
+                         " Alert_Response_Processing block");
+    end Alert_Response_Processing;
+ 
+ 
+ 
+    Emergency_Response_Processing:
+    begin
+    
+       Push_Buttons.Set_Response (Console_Button,
+                                  Push_Buttons.Emergency_Response'access);
+ 
+       Push_Buttons.Push (Console_Button,        -- Raise exception that will
+                          Report.Ident_Int(6));  -- be propagated directly to
+                                                 -- caller.
+       Report.Failed ("Exception not propagated to caller " &
+                      "in Emergency_Response_Processing block");
+ 
+    exception                                   
+       when Push_Buttons.Non_Emergency_Priority =>
+          Push_Buttons.Handled_In_Caller := True;
+       when others =>
+          Report.Failed ("Exception handled in " &
+                         " Emergency_Response_Processing block");
+    end Emergency_Response_Processing;
+ 
+ 
+ 
+    if not (Push_Buttons.Handled_With_Others and
+            Push_Buttons.Reraised_In_Subprogram and
+            Push_Buttons.Handled_In_Caller ) 
+    then
+       Report.Failed ("Incorrect exception handling in referenced subprograms");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end CB20003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,203 ----
+ -- CB20004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that exceptions propagate correctly from objects of 
+ --      protected types. Check propagation from protected entry bodies.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package with a protected type, including entries and private
+ --      data, simulating a bounded buffer abstraction.  In the main procedure,
+ --      perform entry calls on an object of the protected type that raises
+ --      exceptions.
+ --      Ensure that the exceptions are: 
+ --         1) raised and handled locally in the entry body
+ --         2) raised in the entry body and handled/reraised to be handled 
+ --            by the caller.
+ --         3) raised in the entry body and propagated directly to the calling 
+ --            procedure. 
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CB20004_0 is               -- Package Buffer.
+ 
+    Max_Buffer_Size       : constant := 2;
+ 
+    Handled_In_Body,
+    Propagated_To_Caller,
+    Handled_In_Caller     : Boolean := False;
+ 
+    Data_Over_5,
+    Data_Degradation      : exception;
+ 
+    type Data_Item is range 0 .. 100;
+ 
+    type Item_Array_Type is array (1 .. Max_Buffer_Size) of Data_Item;
+ 
+    protected type Bounded_Buffer is
+       entry Put (Item : in     Data_Item);
+       entry Get (Item :    out Data_Item);
+    private
+       Item_Array : Item_Array_Type;
+       I, J       : Integer range 1 .. Max_Buffer_Size := 1;
+       Count      : Integer range 0 .. Max_Buffer_Size := 0;
+    end Bounded_Buffer;
+ 
+ end CB20004_0;
+ 
+      --=================================================================--
+ 
+ with Report;
+ 
+ package body CB20004_0 is               -- Package Buffer.
+ 
+    protected body Bounded_Buffer is
+ 
+       entry Put (Item : in Data_Item) when Count < Max_Buffer_Size is
+       begin
+          if Item > 10 then
+             Item_Array (I) := Item * 8;  -- Constraint_Error will be raised
+          elsif Item > 5 then             -- and handled in entry body.
+             raise Data_Over_5;           -- Exception  handled/reraised in
+          else                            -- entry body, propagated to caller.
+             Item_Array (I) := Item;      -- Store data item in buffer.
+             I := (I mod Max_Buffer_Size) + 1;
+             Count := Count + 1;
+          end if;
+       exception
+          when Constraint_Error =>
+             Handled_In_Body := True;
+          when Data_Over_5 =>
+             Propagated_To_Caller := True;
+             raise;    -- Propagate the exception to the caller.
+       end Put;
+ 
+ 
+       entry Get (Item : out Data_Item) when Count > 0 is
+       begin
+          Item := Item_Array(J);
+          J := (J mod Max_Buffer_Size) + 1;
+          Count := Count - 1;
+          if Count = 0 then
+             raise Data_Degradation;   -- Exception to propagate to caller.
+          end if;
+       end Get;
+ 
+    end Bounded_Buffer;
+ 
+ end CB20004_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with CB20004_0;                   -- Package Buffer.
+ with Report;
+ 
+ procedure CB20004 is
+ 
+    package Buffer renames CB20004_0;
+ 
+    Data        : Buffer.Data_Item := Buffer.Data_Item'First;
+    Data_Buffer : Buffer.Bounded_Buffer;   -- an object of protected type.
+ 
+    Handled_In_Caller : Boolean := False;  -- same name as boolean declared 
+                                           -- in package Buffer.
+ begin
+ 
+    Report.Test ("CB20004", "Check that exceptions propagate correctly " &
+                            "from objects of protected types" );
+ 
+    Initial_Data_Block:
+    begin                                    -- Data causes Constraint_Error.
+       Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(51)));
+ 
+    exception                                  
+       when Constraint_Error => 
+          Buffer.Handled_In_Body := False;     -- Improper exception handling
+                                               -- in entry body.
+          Report.Failed ("Exception propagated to caller " &
+                         " from Initial_Data_Block");
+       when others =>
+          Report.Failed ("Exception raised in processing and " &
+                         "propagated to caller from Initial_Data_Block");
+    end Initial_Data_Block;
+ 
+ 
+    Data_Entry_Block:
+    begin
+                                               -- Valid data. No exception.
+       Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(3)));  
+ 
+                                               -- Data will cause exception.
+       Data_Buffer.Put (7);                    -- Call protected object entry, 
+                                               -- exception to be handled/
+                                               -- reraised in entry body.
+       Report.Failed ("Data_Over_5 Exception not raised in processing");
+    exception
+       when Buffer.Data_Over_5 =>
+          if Buffer.Propagated_To_Caller then   -- Reraised in entry body?
+             Buffer.Handled_In_Caller := True;
+          else
+             Report.Failed ("Exception not reraised in entry body");
+          end if;
+       when others =>
+          Report.Failed ("Exception raised in processing and propagated " &
+                         "to caller from Data_Entry_Block");
+    end Data_Entry_Block;
+ 
+ 
+    Data_Retrieval_Block:
+    begin
+ 
+       Data_Buffer.Get (Data);  -- Retrieval of buffer data, buffer now empty.
+                                -- Exception will be raised in entry body, with
+                                -- propagation to caller.
+       Report.Failed ("Data_Degradation Exception not raised in processing");
+    exception
+       when Buffer.Data_Degradation =>
+          Handled_In_Caller := True;   -- Local Boolean used here.
+       when others =>
+          Report.Failed ("Exception raised in processing and propagated " &
+                         "to caller from Data_Retrieval_Block");
+    end Data_Retrieval_Block;
+ 
+ 
+    if not (Buffer.Handled_In_Body      and    -- Validate proper exception
+            Buffer.Propagated_To_Caller and    -- handling in entry bodies.
+            Buffer.Handled_In_Caller    and
+            Handled_In_Caller)
+    then
+       Report.Failed ("Improper exception handling by entry bodies");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end CB20004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,210 ----
+ -- CB20005.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that exceptions are raised and properly handled locally in
+ --      protected operations.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package with a protected type, including protected operation
+ --      declarations and private data, simulating a counting semaphore.
+ --      In the main procedure, perform calls on protected operations 
+ --      of the protected object designed to induce the raising of exceptions.
+ --
+ --      Ensure that the exceptions are raised and handled locally in a 
+ --      protected procedures and functions, and that in this case the 
+ --      exceptions will not propagate to the calling unit.  Use specific 
+ --      exception handlers in the protected functions.
+ --
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CB20005_0 is               -- Package Semaphore.
+ 
+    Handled_In_Function,
+    Handled_In_Procedure : Boolean := False;
+ 
+    Resource_Overflow,
+    Resource_Underflow   : exception;
+ 
+    protected type Counting_Semaphore (Max_Resources : Integer) is
+       procedure Secure;
+       function  Resource_Limit_Exceeded return Boolean;
+       procedure Release;
+    private
+       Count : Integer := Max_Resources;
+    end Counting_Semaphore;
+ 
+ end CB20005_0;
+ 
+      --=================================================================--
+ 
+ with Report;
+ 
+ package body CB20005_0 is               -- Package Semaphore.
+ 
+    protected body Counting_Semaphore is
+ 
+       procedure Secure is
+       begin
+          if (Count = 0) then               -- No resources left to secure.
+             raise Resource_Underflow;      
+             Report.Failed 
+               ("Program control not transferred by raise in Secure");
+          else
+             Count := Count - 1;             -- Avail resources decremented.
+          end if;                          
+       exception
+          when Resource_Underflow =>         -- Exception handled locally in
+             Handled_In_Procedure := True;   -- this protected operation.
+          when others =>
+             Report.Failed ("Unexpected exception raised in Secure");
+       end Secure;
+ 
+ 
+       function Resource_Limit_Exceeded return Boolean is
+       begin
+          if (Count > Max_Resources) then   
+             raise Resource_Overflow;       -- Exception used as control flow
+                                            -- mechanism.
+             Report.Failed 
+               ("Program control not transferred by raise in " &
+                "Resource_Limit_Exceeded");
+          else                              
+             return (False);
+          end if;
+       exception
+          when Resource_Overflow =>         -- Handle its own raised
+             Handled_In_Function := True;   -- exception.
+             return (True);                 
+          when others =>
+             Report.Failed 
+               ("Unexpected exception raised in Resource_Limit_Exceeded");
+       end Resource_Limit_Exceeded;
+ 
+ 
+       procedure Release is
+       begin
+          Count := Count + 1;               -- Count of resources available 
+                                            -- incremented.
+          if Resource_Limit_Exceeded then   -- Call to protected operation
+             Count := Count - 1;            -- function that raises/handles
+          end if;                           -- an exception.
+       exception
+          when Resource_Overflow =>
+             Handled_In_Function := False;
+             Report.Failed ("Exception propagated to Function Release");
+          when others =>
+             Report.Failed ("Unexpected exception raised in Function Release");
+       end Release;
+ 
+ 
+    end Counting_Semaphore;
+ 
+ end CB20005_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with CB20005_0;                           -- Package Semaphore.
+ with Report;
+ 
+ procedure CB20005 is
+ begin
+ 
+    Report.Test ("CB20005", "Check that exceptions are raised and handled " &
+                            "correctly in protected operations" );
+ 
+    Test_Block:
+    declare
+ 
+       package Semaphore renames CB20005_0;
+ 
+       Total_Resources_Available : constant := 1;
+ 
+       Resources : Semaphore.Counting_Semaphore(Total_Resources_Available);
+                                           -- An object of protected type.
+ 
+    begin
+ 
+       Allocate_Resources:
+       declare
+          Loop_Count : Integer := Total_Resources_Available + 1;
+       begin
+          for I in 1..Loop_Count loop -- Force exception.
+             Resources.Secure;
+          end loop;
+       exception                                     
+          when Semaphore.Resource_Underflow =>
+             Semaphore.Handled_In_Procedure := False; -- Excptn not handled 
+             Report.Failed                            -- in prot. operation.
+               ("Resource_Underflow exception not handled " &
+                "in Allocate_Resources");
+          when others =>
+             Report.Failed 
+               ("Exception unexpectedly raised during resource allocation");
+       end Allocate_Resources;
+ 
+    
+       Deallocate_Resources:
+       declare
+          Loop_Count : Integer := Total_Resources_Available + 1;
+       begin
+          for I in 1..Loop_Count loop -- Force excptn.
+             Resources.Release;  
+          end loop;
+       exception                                     
+          when Semaphore.Resource_Overflow =>
+             Semaphore.Handled_In_Function := False; -- Exception not handled
+                Report.Failed                        -- in prot. operation.
+                  ("Resource overflow not handled by function");
+             when others =>
+                Report.Failed 
+                  ("Exception raised during resource deallocation"); 
+       end Deallocate_Resources;
+ 
+ 
+       if not (Semaphore.Handled_In_Procedure and -- Incorrect excpt. handling
+               Semaphore.Handled_In_Function)     -- in protected operations.
+       then
+          Report.Failed 
+            ("Improper exception handling by protected operations");
+       end if;
+ 
+ 
+    exception
+       when others =>
+          Report.Failed ("Exception raised and propagated in test");
+ 
+    end Test_Block;
+ 
+    Report.Result;
+ 
+ end CB20005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,217 ----
+ -- CB20006.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that exceptions are raised and properly handled (including 
+ --      propagation by reraise) in protected operations.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package with a protected type, including protected operation
+ --      declarations and private data, simulating a counting semaphore.
+ --      In the main procedure, perform calls on protected operations 
+ --      of the protected object designed to induce the raising of exceptions.
+ --
+ --      The exceptions raised are to be initially handled in the protected
+ --      operations, but this handling involves the reraise of the exception
+ --      and the propagation of the exception to the caller.
+ --
+ --      Ensure that the exceptions are raised, handled / reraised successfully
+ --      in protected procedures and functions.  Use "others" handlers in the
+ --      protected operations.
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CB20006_0 is               -- Package Semaphore.
+ 
+    Reraised_In_Function,
+    Reraised_In_Procedure,
+    Handled_In_Function_Caller,
+    Handled_In_Procedure_Caller   : Boolean := False;
+ 
+    Resource_Overflow,
+    Resource_Underflow            : exception;
+ 
+    protected type Counting_Semaphore (Max_Resources : Integer) is
+       procedure Secure;
+       function  Resource_Limit_Exceeded return Boolean;
+       procedure Release;
+    private
+       Count : Integer := Max_Resources;
+    end Counting_Semaphore;
+ 
+ end CB20006_0;
+ 
+      --=================================================================--
+ 
+ with Report;
+ 
+ package body CB20006_0 is                 -- Package Semaphore.
+ 
+    protected body Counting_Semaphore is
+ 
+       procedure Secure is
+       begin
+          if (Count = 0) then              -- No resources left to secure.
+             raise Resource_Underflow;      
+             Report.Failed 
+               ("Program control not transferred by raise in Procedure Secure");
+          else
+             Count := Count - 1;           -- Available resources decremented.
+          end if;                          
+       exception
+          when Resource_Underflow =>
+             Reraised_In_Procedure := True; 
+             raise;                        -- Exception propagated to caller.
+             Report.Failed ("Exception not propagated to caller from Secure");
+          when others =>
+             Report.Failed ("Unexpected exception raised in Secure");
+       end Secure;
+ 
+ 
+       function Resource_Limit_Exceeded return Boolean is
+       begin
+          if (Count > Max_Resources) then   
+             raise Resource_Overflow;      -- Exception used as control flow
+                                           -- mechanism.
+             Report.Failed 
+               ("Specific raise did not alter program control" &
+                " from Resource_Limit_Exceeded");
+          else                              
+             return (False);
+          end if;
+       exception
+          when others =>
+             Reraised_In_Function := True; 
+             raise;                         -- Exception propagated to caller.
+             Report.Failed ("Exception not propagated to caller" & 
+                            " from Resource_Limit_Exceeded");
+       end Resource_Limit_Exceeded;
+ 
+ 
+       procedure Release is
+       begin
+          Count := Count + 1;               -- Count of resources available 
+                                            -- incremented.
+          if Resource_Limit_Exceeded then   -- Call to protected operation
+             Count := Count - 1;            -- function that raises/reraises
+                                            -- an exception.
+             Report.Failed("Resource limit exceeded");
+          end if;                          
+ 
+       exception
+          when others =>
+             raise;                         -- Reraised and propagated again.
+              Report.Failed ("Exception not reraised by procedure Release");
+       end Release;
+ 
+ 
+    end Counting_Semaphore;
+ 
+ end CB20006_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with CB20006_0;                           -- Package Semaphore.
+ with Report;
+ 
+ procedure CB20006 is
+ begin
+ 
+    Report.Test ("CB20006", "Check that exceptions are raised and " &
+                            "handled / reraised and propagated "    &
+                            "correctly by protected operations" );
+ 
+    Test_Block:
+    declare
+ 
+       package Semaphore renames CB20006_0;
+ 
+       Total_Resources_Available : constant := 1;
+ 
+       Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);
+                                              -- An object of protected type.
+ 
+    begin
+ 
+       Allocate_Resources:
+       declare
+          Loop_Count : Integer := Total_Resources_Available + 1;
+       begin
+          for I in 1..Loop_Count loop -- Force exception
+             Resources.Secure;
+          end loop;
+          Report.Failed 
+            ("Exception not propagated from protected operation Secure");
+       exception                                     
+          when Semaphore.Resource_Underflow =>        -- Exception propagated
+            Semaphore.Handled_In_Procedure_Caller := True;  -- from protected
+          when others =>                                    -- procedure.
+            Semaphore.Handled_In_Procedure_Caller := False;
+       end Allocate_Resources;
+ 
+    
+       Deallocate_Resources:
+       declare
+          Loop_Count : Integer := Total_Resources_Available + 1;
+       begin
+          for I in 1..Loop_Count loop -- Force exception
+             Resources.Release;  
+          end loop;
+          Report.Failed 
+            ("Exception not propagated from protected operation Release");
+       exception                                     
+          when Semaphore.Resource_Overflow =>        -- Exception propagated 
+             Semaphore.Handled_In_Function_Caller := True; -- from protected
+          when others =>                                   -- function.
+             Semaphore.Handled_In_Function_Caller := False;
+       end Deallocate_Resources;
+ 
+ 
+       if not (Semaphore.Reraised_In_Procedure and
+               Semaphore.Reraised_In_Function  and
+               Semaphore.Handled_In_Procedure_Caller and
+               Semaphore.Handled_In_Function_Caller) 
+       then                                       -- Incorrect excpt. handling
+          Report.Failed                           -- in protected operations.
+            ("Improper exception handling/reraising by protected operations");
+       end if;
+ 
+    exception
+ 
+       when others =>
+          Report.Failed ("Unexpected exception " & 
+                         " raised and propagated in test");
+    end Test_Block;
+ 
+    Report.Result;
+ 
+ 
+ end CB20006;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,196 ----
+ -- CB20007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that exceptions are raised and can be directly propagated to
+ --      the calling unit by protected operations.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a package with a protected type, including protected operation
+ --      declarations and private data, simulating a counting semaphore.
+ --      In the main procedure, perform calls on protected operations 
+ --      of the protected object designed to induce the raising of exceptions.
+ --
+ --      The exceptions raised are to be propagated directly from the protected
+ --      operations to the calling unit. 
+ --
+ --      Ensure that the exceptions are raised and correctly propagated directly
+ --      to the calling unit from protected procedures and functions.
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CB20007_0 is               -- Package Semaphore.
+ 
+    Handled_In_Function_Caller,
+    Handled_In_Procedure_Caller : Boolean := False;
+ 
+    Resource_Overflow,
+    Resource_Underflow          : exception;
+ 
+    protected type Counting_Semaphore (Max_Resources : Integer) is
+       procedure Secure;
+       function  Resource_Limit_Exceeded return Boolean;
+       procedure Release;
+    private
+       Count : Integer := Max_Resources;
+    end Counting_Semaphore;
+ 
+ end CB20007_0;
+ 
+      --=================================================================--
+ 
+ with Report;
+ 
+ package body CB20007_0 is                  -- Package Semaphore.
+ 
+    protected body Counting_Semaphore is
+ 
+       procedure Secure is
+       begin
+          if (Count = 0) then               -- No resources left to secure.
+             raise Resource_Underflow;      
+             Report.Failed ("Program control not transferred by raise");
+          else
+             Count := Count - 1;            -- Available resources decremented.
+          end if;                          
+          -- No exception handlers here, direct propagation to calling unit.
+       end Secure;
+ 
+ 
+       function Resource_Limit_Exceeded return Boolean is
+       begin
+          if (Count > Max_Resources) then   
+             raise Resource_Overflow;       -- Exception used as control flow
+                                            -- mechanism.
+             Report.Failed ("Program control not transferred by raise");
+          else                              
+             return (False);
+          end if;
+          -- No exception handlers here, direct propagation to calling unit.
+       end Resource_Limit_Exceeded;
+ 
+ 
+       procedure Release is
+       begin
+          Count := Count + 1;               -- Count of resources available 
+                                            -- incremented.
+          if Resource_Limit_Exceeded then   -- Call to protected operation
+             Count := Count - 1;            -- function that raises an
+                                            -- exception.
+             Report.Failed("Resource limit exceeded");
+          end if;                           
+          -- No exception handler here for exception raised in function.
+          -- Exception will propagate directly to calling unit.
+       end Release;
+ 
+ 
+    end Counting_Semaphore;
+ 
+ end CB20007_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with CB20007_0;                           -- Package Semaphore.
+ with Report;
+ 
+ procedure CB20007 is
+ begin
+ 
+    Test_Block:
+    declare
+ 
+       package Semaphore renames CB20007_0;
+ 
+       Total_Resources_Available : constant := 1;
+ 
+       Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);
+                                              -- An object of protected type.
+ 
+    begin
+ 
+       Report.Test ("CB20007", "Check that exceptions are raised and can "   &
+                               "be directly propagated to the calling unit " &
+                               "by protected operations" );
+ 
+       Allocate_Resources:
+       declare
+          Loop_Count : Integer := Total_Resources_Available + 1;
+       begin                                   -- Force exception.
+          for I in 1..Loop_Count loop  
+             Resources.Secure;
+          end loop;
+          Report.Failed ("Exception not propagated from protected " &
+                         " operation in Allocate_Resources");
+       exception                                     
+          when Semaphore.Resource_Underflow =>              -- Exception prop.
+             Semaphore.Handled_In_Procedure_Caller := True; -- from protected
+                                                            -- procedure.
+          when others =>
+             Report.Failed ("Unknown exception during resource allocation");
+       end Allocate_Resources;
+ 
+    
+       Deallocate_Resources:
+       declare
+          Loop_Count : Integer := Total_Resources_Available + 1;
+       begin                                   -- Force exception.
+          for I in 1..Loop_Count loop  
+             Resources.Release;  
+          end loop;
+          Report.Failed ("Exception not propagated from protected " &
+                         "operation in Deallocate_Resources");
+       exception                                     
+          when Semaphore.Resource_Overflow =>              -- Exception prop
+             Semaphore.Handled_In_Function_Caller := True; -- from protected
+                                                           -- function.
+          when others =>
+             Report.Failed ("Exception raised during resource deallocation");
+       end Deallocate_Resources;
+ 
+ 
+       if not (Semaphore.Handled_In_Procedure_Caller and -- Incorrect exception
+               Semaphore.Handled_In_Function_Caller)     -- handling in
+       then                                              -- protected ops.
+           Report.Failed                                 
+             ("Improper exception propagation by protected operations");
+       end if;
+ 
+    exception
+ 
+       when others =>
+          Report.Failed ("Unexpected exception " &
+                         " raised and propagated in test");
+    end Test_Block;
+ 
+ 
+    Report.Result;
+ 
+ end CB20007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,245 ----
+ -- CB2004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A PREDEFINED OR A PROGRAMMER DEFINED EXCEPTION
+ --    RAISED SEVERAL LEVELS INSIDE A HIERARCHY OF NESTED BLOCKS
+ --    CAN BE SUCCESSFULLY HANDLED IN AN OUTER BLOCK.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- DCB 5/12/80
+ -- JRK 11/17/80
+ -- SPS 11/2/82
+ -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT;
+ PROCEDURE CB2004A IS
+ 
+      USE REPORT;
+ 
+      FLOW_COUNT : INTEGER := 0;
+ 
+      E1, E2, E3 : EXCEPTION;
+ 
+ BEGIN
+      TEST("CB2004A","CHECK THAT EXCEPTIONS RAISED INSIDE NESTED " &
+           "BLOCKS CAN BE HANDLED IN OUTER BLOCKS");
+ 
+      BEGIN
+ 
+           -- PROGRAMMER-DEFINED EXCEPTION, SINGLE EXCEPTON_CHOICE.
+ 
+           BEGIN
+                BEGIN
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE E1;
+                          FAILED("PROGRAMMER-DEFINED EXCEPTION " &
+                                 "NOT RAISED  #1");
+ 
+                     EXCEPTION
+                          WHEN E2 | E3 =>
+                               FAILED("WRONG PROGRAMMER-" &
+                                      "DEFINED EXCEPTION HANDLED   #1");
+                     END;
+ 
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR |
+                          PROGRAM_ERROR | STORAGE_ERROR |
+                          TASKING_ERROR | E2 | E3     =>
+                          FAILED("WRONG  " &
+                                 "EXCEPTION HANDLED   #1");
+                END;
+ 
+           EXCEPTION
+                WHEN E1 =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+           END;
+ 
+           -- PROGRAMMER-DEFINED EXCEPTION, MULTIPLE EXCEPTION_CHOICES.
+ 
+           BEGIN
+                BEGIN
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE E2;
+                          FAILED("PROGRAMMER-DEFINED EXCEPTION " &
+                                 "NOT RAISED  #2");
+ 
+                     EXCEPTION
+                          WHEN E1 | E3 =>
+                               FAILED("WRONG PROGRAMMER-" &
+                                      "DEFINED EXCEPTION HANDLED   #2");
+                     END;
+ 
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR |
+                          PROGRAM_ERROR | STORAGE_ERROR |
+                          TASKING_ERROR | E1 | E3     =>
+                          FAILED("WRONG  " &
+                                 "EXCEPTION HANDLED   #2");
+                END;
+ 
+           EXCEPTION
+                WHEN E3 =>
+                     FAILED("WRONG EXCEPTION HANDLED  #2A");
+                WHEN E1 | E2 | CONSTRAINT_ERROR =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+           END;
+ 
+           -- PROGRAMMER-DEFINED EXCEPTION, 'OTHERS' CHOICE.
+ 
+           BEGIN
+                BEGIN
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE E1;
+                          FAILED("PROGRAMMER-DEFINED EXCEPTION " &
+                                 "NOT RAISED  #3");
+ 
+                     EXCEPTION
+                          WHEN E2 | E3 =>
+                               FAILED("WRONG PROGRAMMER-" &
+                                      "DEFINED EXCEPTION HANDLED   #3");
+                     END;
+ 
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR |
+                          PROGRAM_ERROR | STORAGE_ERROR |
+                          TASKING_ERROR | E2 | E3   =>
+                          FAILED("WRONG " &
+                                 "EXCEPTION HANDLED   #3");
+                END;
+ 
+           EXCEPTION
+                WHEN E2 | CONSTRAINT_ERROR =>
+                     FAILED("WRONG EXCEPTION HANDLED  #3A");
+                WHEN OTHERS =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+           END;
+ 
+           -- PREDEFINED EXCEPTION, SINGLE EXCEPTION_CHOICE.
+ 
+           BEGIN
+                BEGIN
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE CONSTRAINT_ERROR;
+                          FAILED("PREDEFINED EXCEPTION NOT RAISED  #4");
+ 
+                     EXCEPTION
+                          WHEN E1 | E2 | E3 =>
+                               FAILED("WRONG " &
+                                      "EXCEPTION HANDLED   #4");
+                     END;
+ 
+                EXCEPTION
+                     WHEN PROGRAM_ERROR | STORAGE_ERROR |
+                          TASKING_ERROR     =>
+                          FAILED("WRONG PREDEFINED " &
+                                 "EXCEPTION HANDLED   #4");
+                END;
+ 
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+           END;
+ 
+           -- PREDEFINED EXCEPTION, MULTIPLE EXCEPTION_CHOICES.
+ 
+           BEGIN
+                BEGIN
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE CONSTRAINT_ERROR;
+                          FAILED("PREDEFINED EXCEPTION NOT RAISED  #5");
+ 
+                     EXCEPTION
+                          WHEN E1 | E2 | E3 =>
+                               FAILED("WRONG " &
+                                      "EXCEPTION HANDLED   #5");
+                     END;
+ 
+                EXCEPTION
+                     WHEN PROGRAM_ERROR | 
+                          STORAGE_ERROR | TASKING_ERROR     =>
+                          FAILED("WRONG PREDEFINED " &
+                                 "EXCEPTION HANDLED   #5");
+                END;
+ 
+           EXCEPTION
+                WHEN E1 | E2 =>
+                     FAILED("WRONG EXCEPTION HANDLED  #5A");
+                WHEN CONSTRAINT_ERROR | E3 =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+           END;
+ 
+           -- PREDEFINED EXCEPTION, 'OTHERS' CHOICE.
+ 
+           BEGIN
+                BEGIN
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE CONSTRAINT_ERROR;
+                          FAILED("PREDEFINED EXCEPTION NOT RAISED  #6");
+ 
+                     EXCEPTION
+                          WHEN E1 | E2 | E3 =>
+                               FAILED("WRONG " &
+                                      " EXCEPTION HANDLED   #6");
+                     END;
+ 
+                EXCEPTION
+                     WHEN PROGRAM_ERROR | STORAGE_ERROR |
+                          TASKING_ERROR     =>
+                          FAILED("WRONG PREDEFINED " &
+                                 "EXCEPTION HANDLED   #6");
+                END;
+ 
+           EXCEPTION
+                WHEN E1 =>
+                     FAILED("WRONG EXCEPTION HANDLED  #6A");
+                WHEN OTHERS =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+           END;
+ 
+      EXCEPTION
+           WHEN E1 | E2 | E3 =>
+                FAILED("PROGRAMMER-DEFINED EXCEPTION HANDLED IN" &
+                       "WRONG SCOPE");
+           WHEN CONSTRAINT_ERROR =>
+                FAILED("CONSTRAINT_ERROR HANDLED IN WRONG SCOPE");
+           WHEN OTHERS =>
+                FAILED("OTHER EXCEPTIONS HANDLED IN WRONG SCOPE");
+      END;
+ 
+      IF FLOW_COUNT /= 12 THEN
+           FAILED("INCORRECT FLOW_COUNT VALUE");
+      END IF;
+ 
+      RESULT;
+ END CB2004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- CB2005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A RETURN STATEMENT CAN APPEAR IN AN EXCEPTION HANDLER
+ -- AND IT CAUSES CONTROL TO LEAVE THE SUBPROGRAM, FOR BOTH
+ -- FUNCTIONS AND PROCEDURES.
+ 
+ -- DAT 4/13/81
+ -- JRK 4/24/81
+ -- SPS 10/26/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB2005A IS
+ 
+      I : INTEGER RANGE 0 .. 1;
+ 
+      FUNCTION SETI RETURN INTEGER IS
+      BEGIN
+           I := I + 1;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 1");
+           RETURN 0;
+      EXCEPTION
+           WHEN OTHERS =>
+                RETURN I;
+                FAILED ("FUNCTION RETURN STMT DID NOT RETURN");
+                RETURN 0;
+      END SETI;
+ 
+      PROCEDURE ISET IS
+      BEGIN
+           I := 2;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 2");
+           I := 0;
+      EXCEPTION
+           WHEN OTHERS => 
+                RETURN;
+                FAILED ("PROCEDURE RETURN STMT DID NOT RETURN");
+      END ISET;
+ 
+ BEGIN
+      TEST ("CB2005A", "RETURN IN EXCEPTION HANDLERS");
+ 
+      I := 1;
+      IF SETI /= 1 THEN
+           FAILED ("WRONG VALUE RETURNED 1");
+      END IF;
+ 
+      I := 1;
+      ISET;
+      IF I /= 1 THEN
+           FAILED ("WRONG VALUE RETURNED 2");
+      END IF;
+ 
+      RESULT;
+ END CB2005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,70 ----
+ -- CB2006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT LOCAL VARIABLES AND PARAMETERS OF A SUBPROGRAM,
+ -- OR PACKAGE ARE ACCESSIBLE WITHIN A HANDLER.
+ 
+ -- DAT 4/13/81
+ -- SPS 3/23/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB2006A IS
+ 
+      I : INTEGER RANGE 0 .. 1;
+ 
+      PACKAGE P IS
+           V2 : INTEGER := 2;
+      END P;
+ 
+      PROCEDURE PR (J : IN OUT INTEGER) IS
+           K : INTEGER := J;
+      BEGIN
+           I := K;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 1");
+      EXCEPTION
+           WHEN OTHERS =>
+                J := K + 1;
+      END PR;
+ 
+      PACKAGE BODY P IS
+           L : INTEGER := 2;
+      BEGIN
+           TEST ("CB2006A", "LOCAL VARIABLES ARE ACCESSIBLE IN"
+                & " HANDLERS");
+ 
+           I := 1;
+           I := I + 1;
+           FAILED ("CONSTRAINT_ERROR NOT RAISED 2");
+      EXCEPTION
+           WHEN OTHERS =>
+                PR (L);
+                IF L /= V2 + 1 THEN
+                     FAILED ("WRONG VALUE IN LOCAL VARIABLE");
+                END IF;
+      END P;
+ BEGIN
+ 
+      RESULT;
+ END CB2006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb2007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb2007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- CB2007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXIT STATEMENT IN A HANDLER CAN TRANSFER CONTROL
+ -- OUT OF A LOOP.
+ 
+ -- DAT 4/13/81
+ --  RM 4/30/81
+ -- SPS 3/23/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB2007A IS
+ BEGIN
+      TEST ("CB2007A", "EXIT STATEMENTS IN EXCEPTION HANDLERS");
+ 
+      DECLARE
+           FLOW_INDEX : INTEGER := 0 ;
+      BEGIN
+ 
+           FOR I IN 1 .. 10 LOOP
+                BEGIN
+                     IF I = 1 THEN
+                          RAISE CONSTRAINT_ERROR;
+                     END IF;
+                     FAILED ("WRONG CONTROL FLOW 1");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR => EXIT;
+                END;
+                FAILED ("WRONG CONTROL FLOW 2");
+                EXIT;
+           END LOOP;
+ 
+           FOR AAA IN 1..1 LOOP
+                FOR BBB IN 1..1 LOOP
+                     FOR I IN 1 .. 10 LOOP
+                          BEGIN
+                               IF I = 1 THEN
+                                    RAISE CONSTRAINT_ERROR;
+                               END IF;
+                               FAILED ("WRONG CONTROL FLOW A1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR => EXIT;
+                          END;
+                          FAILED ("WRONG CONTROL FLOW A2");
+                          EXIT;
+                     END LOOP;
+ 
+                     FLOW_INDEX := FLOW_INDEX + 1 ;
+                END LOOP;
+           END LOOP;
+ 
+           LOOP1 :
+           FOR AAA IN 1..1 LOOP
+                LOOP2 :
+                FOR BBB IN 1..1 LOOP
+                     LOOP3 :
+                     FOR I IN 1 .. 10 LOOP
+                          BEGIN
+                               IF I = 1 THEN
+                                    RAISE CONSTRAINT_ERROR;
+                               END IF;
+                               FAILED ("WRONG CONTROL FLOW B1");
+                          EXCEPTION
+                               WHEN CONSTRAINT_ERROR => EXIT LOOP2 ;
+                          END;
+                          FAILED ("WRONG CONTROL FLOW B2");
+                          EXIT LOOP2 ;
+                     END LOOP  LOOP3 ;
+ 
+                     FAILED ("WRONG CONTROL FLOW B3");
+                END LOOP  LOOP2 ;
+ 
+                FLOW_INDEX := FLOW_INDEX + 1 ;
+           END LOOP  LOOP1 ;
+ 
+           IF  FLOW_INDEX /= 2  THEN  FAILED( "WRONG FLOW OF CONTROL" );
+           END IF;
+ 
+      END ;
+ 
+      RESULT;
+ END CB2007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb20a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb20a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,155 ----
+ -- CB20A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the name and pertinent information about a user defined
+ --      exception are available to an enclosing program unit even when the 
+ --      enclosing unit has no visibility into the scope where the exception
+ --      is declared and raised.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a subprogram nested within the test subprogram.  The enclosing 
+ --      subprogram does not have visibility into the nested subprogram.
+ --      Declare and raise an exception in the nested subprogram, and allow
+ --      the exception to propagate to the enclosing scope.  Use the function
+ --      Exception_Name in the enclosing subprogram to produce exception 
+ --      specific information when the exception is handled in an others 
+ --      handler.
+ --
+ -- TEST FILES:
+ --
+ --      This test depends on the following foundation code file:
+ --         FB20A00.A
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with FB20A00;             -- Package containing Function Find
+ with Ada.Exceptions;
+ with Report;
+ 
+ procedure CB20A02 is
+ 
+    Seed_Number   : Integer;
+    Random_Number : Integer := 0;
+ 
+      --=================================================================--
+ 
+    function Random_Number_Generator (Seed : Integer) return Integer is
+ 
+       Result : Integer := 0;
+ 
+       HighSeedError,
+       Mid_Seed_Error,
+       L_o_w_S_e_e_d_E_r_r_o_r : exception;
+ 
+    begin  -- Random_Number_Generator
+ 
+ 
+       if (Report.Ident_Int (Seed)    > 1000) then
+          raise HighSeedError;
+       elsif (Report.Ident_Int (Seed) >  100) then
+          raise Mid_Seed_Error;
+       elsif (Report.Ident_Int (Seed) >   10) then
+          raise L_o_w_S_e_e_d_E_r_r_o_r;
+       else
+          Seed_Number := ((Seed_Number * 417) + 231) mod 53;
+          Result := Seed_Number / 52;
+       end if;
+ 
+       return Result;
+ 
+    end Random_Number_Generator;
+ 
+      --=================================================================--
+ 
+ begin
+ 
+    Report.Test ("CB20A02", "Check that the name "                        &
+                            "of a user defined exception is available "   &
+                            "to an enclosing program unit even when the " &
+                            "enclosing unit has no visibility into the "  &
+                            "scope where the exception is declared and "  &
+                            "raised" );
+ 
+    High_Seed:
+    begin
+       -- This seed value will result in the raising of a HighSeedError
+       -- exception.
+       Seed_Number   := 1001;
+       Random_Number := Random_Number_Generator (Seed_Number);
+       Report.Failed ("Exception not raised in High_Seed block");
+    exception
+       when Error : others =>
+          if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
+                               "HighSeedError")
+          then
+             Report.Failed ("Expected HighSeedError, but found " &
+                             Ada.Exceptions.Exception_Name (Error));
+          end if;
+    end High_Seed;
+ 
+ 
+    Mid_Seed:
+    begin        
+       -- This seed value will generate a Mid_Seed_Error exception.
+       Seed_Number   := 101;
+       Random_Number := Random_Number_Generator (Seed_Number);
+       Report.Failed ("Exception not raised in Mid_Seed block");
+    exception
+       when Error : others =>
+          if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
+                               "Mid_Seed_Error")
+          then
+             Report.Failed ("Expected Mid_Seed_Error, but found " &
+                             Ada.Exceptions.Exception_Name (Error));
+          end if;
+    end Mid_Seed;
+ 
+ 
+    Low_Seed:
+    begin
+       -- This seed value will result in the raising of a
+       -- L_o_w_S_e_e_d_E_r_r_o_r exception.
+       Seed_Number   := 11;
+       Random_Number := Random_Number_Generator (Seed_Number);
+       Report.Failed ("Exception not raised in Low_Seed block");
+    exception
+       when Error : others =>
+          if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
+                               "L_o_w_S_e_e_d_E_r_r_o_r")
+          then
+             Report.Failed ("Expected L_o_w_S_e_e_d_E_r_r_o_r but found " &
+                             Ada.Exceptions.Exception_Name (Error));
+          end if;
+    end Low_Seed;
+ 
+ 
+    Report.Result;
+ 
+ end CB20A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb3003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb3003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb3003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb3003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- CB3003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NON-SPECIFIC RAISE STATEMENT PROPAGATES THE EXCEPTION
+ --    FOR FURTHER PROCESSING(HANDLING) IN ANOTHER HANDLER.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- DCB 04/01/80
+ -- JRK 11/19/80
+ -- SPS 11/2/82
+ -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT;
+ PROCEDURE CB3003A IS
+ 
+      USE REPORT;
+ 
+      FLOW_COUNT : INTEGER := 0;
+      E1,E2 : EXCEPTION;
+ 
+ BEGIN
+      TEST("CB3003A","CHECK THAT THE NON-SPECIFIC RAISE STATEMENT" &
+           " PROPAGATES THE ERROR FOR FURTHER HANDLING IN ANOTHER" &
+           " HANDLER");
+ 
+      -------------------------------------------------------
+ 
+      BEGIN
+           BEGIN
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                     RAISE E1;
+                     FAILED("EXCEPTION NOT RAISED (CASE 1)");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE;
+                          FAILED("EXCEPTION NOT RERAISED (CASE 1; " &
+                                 "INNER)");
+                END;
+ 
+           EXCEPTION
+           -- A HANDLER SPECIFIC TO THE RAISED EXCEPTION (E1).
+                WHEN E1 =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                     RAISE;
+                     FAILED("EXCEPTION NOT RERAISED (CASE 1; OUTER)");
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED (CASE 1)");
+           END;
+ 
+      EXCEPTION
+           WHEN E1 =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION PASSED (CASE 1)");
+      END;
+ 
+      -------------------------------------------------------
+ 
+      BEGIN
+           BEGIN
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                     RAISE E1;
+                     FAILED("EXCEPTION NOT RAISED (CASE 2)");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE;
+                          FAILED("EXCEPTION NOT RERAISED (CASE 2; " &
+                                 "INNER)");
+                END;
+ 
+           EXCEPTION
+           -- A HANDLER FOR SEVERAL EXCEPTIONS INCLUDING THE ONE RAISED.
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED("WRONG EXCEPTION RAISED (CONSTRAINT_ERROR)");
+                WHEN E2 =>
+                     FAILED("WRONG EXCEPTION RAISED (E2)");
+                WHEN PROGRAM_ERROR | E1 | TASKING_ERROR =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                     RAISE;
+                     FAILED("EXCEPTION NOT RERAISED (CASE 2; OUTER)");
+                WHEN STORAGE_ERROR =>
+                     FAILED("WRONG EXCEPTION RAISED (STORAGE_ERROR)");
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED (OTHERS)");
+           END;
+ 
+      EXCEPTION
+           WHEN E1 =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION PASSED (CASE 2)");
+      END;
+ 
+      -------------------------------------------------------
+ 
+      BEGIN
+           BEGIN
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                     RAISE E1;
+                     FAILED("EXCEPTION NOT RAISED (CASE 3)");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE;
+                          FAILED("EXCEPTION NOT RERAISED (CASE 3; " &
+                                 "INNER)");
+                END;
+ 
+           EXCEPTION
+           -- A NON-SPECIFIC HANDLER.
+                WHEN CONSTRAINT_ERROR | E2 =>
+                     FAILED("WRONG EXCEPTION RAISED " &
+                            "(CONSTRAINT_ERROR | E2)");
+                WHEN OTHERS =>
+                     FLOW_COUNT := FLOW_COUNT + 1;
+                     RAISE;
+                     FAILED("EXCEPTION NOT RERAISED (CASE 3; OUTER)");
+           END;
+ 
+      EXCEPTION
+           WHEN E1 =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("WRONG EXCEPTION PASSED (CASE 3)");
+      END;
+ 
+      -------------------------------------------------------
+ 
+      IF FLOW_COUNT /= 12 THEN
+           FAILED("INCORRECT FLOW_COUNT VALUE");
+      END IF;
+ 
+      RESULT;
+ END CB3003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb3003b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb3003b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb3003b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb3003b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,135 ----
+ -- CB3003B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A NON-EXPLICIT RAISE STATEMENT MAY APPEAR IN A BLOCK
+ -- STATEMENT WITHIN AN EXCEPTION HANDLER; IF THE BLOCK STATEMENT
+ -- INCLUDES A HANDLER FOR THE CURRENT EXCEPTION, THEN THE INNER
+ -- HANDLER RECEIVES CONTROL.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- L.BROWN  10/08/86
+ -- MRM  03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  CB3003B  IS
+ 
+      MY_ERROR : EXCEPTION;
+ 
+ BEGIN
+      TEST("CB3003B","A NON-EXPLICIT RAISE STATEMENT MAY APPEAR IN A "&
+                     "BLOCK STATEMENT WITHIN AN EXCEPTION HANDLER");
+ 
+      BEGIN
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RAISE MY_ERROR;
+                END IF;
+                FAILED("MY_ERROR WAS NOT RAISED 1");
+           EXCEPTION
+                WHEN MY_ERROR =>
+                     BEGIN
+                          IF EQUAL(3,3) THEN
+                               RAISE;
+                          END IF;
+                          FAILED("MY_ERROR WAS NOT RAISED 2");
+                     EXCEPTION
+                          WHEN MY_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("WRONG EXCEPTION RAISED 1");
+                     END;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED 2");
+           END;
+      EXCEPTION
+           WHEN MY_ERROR =>
+                FAILED("CONTROL PASSED TO OUTER HANDLER 1");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED 1");
+      END;
+ 
+      BEGIN
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RAISE MY_ERROR;
+                END IF;
+                FAILED("MY_ERROR WAS NOT RAISED 3");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR | MY_ERROR | TASKING_ERROR =>
+                     BEGIN
+                          IF EQUAL(3,3) THEN
+                               RAISE;
+                          END IF;
+                          FAILED("MY_ERROR WAS NOT RAISED 4");
+                     EXCEPTION
+                          WHEN MY_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("WRONG EXCEPTION RAISED 3");
+                     END;
+                WHEN OTHERS =>
+                     FAILED("WRONG EXCEPTION RAISED 4");
+           END;
+      EXCEPTION
+           WHEN MY_ERROR =>
+                FAILED("CONTROL PASSED TO OUTER HANDLER 2");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED 2");
+      END;
+ 
+      BEGIN
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RAISE MY_ERROR;
+                END IF;
+                FAILED("MY_ERROR WAS NOT RAISED 5");
+           EXCEPTION
+                WHEN OTHERS =>
+                     BEGIN
+                          IF EQUAL(3,3) THEN
+                               RAISE;
+                          END IF;
+                          FAILED("MY_ERROR WAS NOT RAISED 6");
+                     EXCEPTION
+                          WHEN MY_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("WRONG EXCEPTION RAISED 5");
+                     END;
+           END;
+      EXCEPTION
+           WHEN MY_ERROR =>
+                FAILED("CONTROL PASSED TO OUTER HANDLER 3");
+           WHEN OTHERS =>
+                FAILED("UNEXPECTED EXCEPTION RAISED 3");
+      END;
+ 
+      RESULT;
+ 
+ END CB3003B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb3004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb3004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb3004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb3004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,145 ----
+ -- CB3004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN AN INNER UNIT REDECLARES AN EXCEPTION NAME
+ --    THE HIDDEN DEFINITION IS STILL AVAILABLE FOR USE.
+ 
+ --  NOTE : WE ASSUME FUNCTIONS ACT LIKE PROCEDURES AND
+ --  THAT UNITS, BLOCKS, AND PROCEDURES ACT THE SAME
+ --  IN OTHER CONTEXTS (E.G. TASKS AND PACKAGES).
+ 
+ -- DCB 6/2/80
+ -- JRK 11/19/80
+ -- SPS 3/24/83
+ 
+ WITH REPORT;
+ PROCEDURE CB3004A IS
+ 
+      USE REPORT;
+ 
+      E1 : EXCEPTION;
+      FLOW_COUNT : INTEGER := 0;
+ 
+      PROCEDURE P1 IS
+           E1, E2 : EXCEPTION;
+ 
+           PROCEDURE P2 IS
+                E1 : EXCEPTION;
+           BEGIN
+                FLOW_COUNT := FLOW_COUNT + 1;
+                RAISE E1;
+                FAILED("E1 EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN P1.E1 =>
+                     FAILED("P1.E1 EXCEPTION RAISED WHEN " &
+                            "(P2)E1 EXPECTED");
+                WHEN E1 =>
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE P1.E1;
+                          FAILED("P1.E1 EXCEPTION NOT RAISED");
+                     EXCEPTION
+                          WHEN E1 =>
+                               FAILED("(P2)E1 EXCEPTION RAISED WHEN" &
+                                      " P1.E1 EXPECTED");
+                          WHEN P1.E1 =>
+                               FLOW_COUNT := FLOW_COUNT + 1;
+                          WHEN OTHERS =>
+                               FAILED("OTHERS RAISED WHEN P1.E1 " &
+                                      "EXPECTED");
+                     END;
+                WHEN OTHERS =>
+                     FAILED("OTHERS RAISED WHEN (P2)E1 EXPECTED");
+           END P2;
+ 
+           PROCEDURE P3 IS
+                CONSTRAINT_ERROR : EXCEPTION;
+           BEGIN
+                FLOW_COUNT := FLOW_COUNT + 1;
+                RAISE CONSTRAINT_ERROR;
+                FAILED("CONSTRAINT_ERROR EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN STANDARD.CONSTRAINT_ERROR =>
+                     FAILED("STANDARD.CONSTRAINT_ERROR EXCEPTION " &
+                            "RAISED WHEN " &
+                            "(P3)CONSTRAINT_ERROR EXPECTED");
+                WHEN CONSTRAINT_ERROR =>
+                     BEGIN
+                          FLOW_COUNT := FLOW_COUNT + 1;
+                          RAISE STANDARD.CONSTRAINT_ERROR;
+                          FAILED("STANDARD.CONSTRAINT_ERROR " &
+                                 "EXCEPTION NOT RAISED");
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED("(P3)CONSTRAINT_ERROR " &
+                                      "EXCEPTION RAISED WHEN " &
+                                      "STANDARD.CONSTRAINT_ERROR " &
+                                      "EXPECTED");
+                          WHEN STANDARD.CONSTRAINT_ERROR =>
+                               FLOW_COUNT := FLOW_COUNT + 1;
+                          WHEN OTHERS =>
+                                FAILED("OTHERS RAISED WHEN " &
+                                       "STANDARD.CONSTRAINT_ERROR " &
+                                       "EXPECTED");
+                     END;
+                WHEN OTHERS =>
+                     FAILED("OTHERS RAISED WHEN " &
+                            "(P3)CONSTRAINT_ERROR EXPECTED");
+           END P3;
+ 
+           PROCEDURE P4 IS
+                E2 : EXCEPTION;
+           BEGIN
+                FLOW_COUNT := FLOW_COUNT + 1;
+                RAISE P1.E2;
+                FAILED("P1.E2 EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN E2 =>
+                     FAILED("(P4).E2 RAISED WHEN P1.E2 EXPECTED");
+           END P4;
+ 
+      BEGIN  -- P1
+           P2;
+           P3;
+           P4;
+           FAILED("P1.E2 EXCEPTION NOT PROPAGATED FROM P4");
+      EXCEPTION
+           WHEN E2 =>
+                FLOW_COUNT := FLOW_COUNT + 1;
+           WHEN OTHERS =>
+                FAILED("EXCEPTION RAISED WHERE NONE EXPECTED");
+      END P1;
+ 
+ BEGIN
+      TEST("CB3004A","CHECK THAT WHEN EXCEPTION NAMES" &
+           " ARE REDECLARED THE HIDDEN DEFINITION IS STILL AVAILABLE");
+ 
+      P1;
+ 
+      IF FLOW_COUNT /= 8 THEN
+           FAILED("INCORRECT FLOW_COUNT VALUE");
+      END IF;
+ 
+      RESULT;
+ END CB3004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40005.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40005.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40005.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40005.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,339 ----
+ -- CB40005.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that exceptions raised in non-generic code can be handled by
+ --      a procedure in a generic package.  Check that the exception identity
+ --      can be properly retrieved from the generic code and used by the
+ --      non-generic code.
+ --
+ -- TEST DESCRIPTION:
+ --      This test models a possible usage paradigm for the type:
+ --        Ada.Exceptions.Exception_Occurrence.
+ --
+ --      A generic package takes access to procedure types (allowing it to
+ --      be used at any accessibility level) and defines a "fail soft"
+ --      procedure that takes designators to a procedure to call, a
+ --      procedure to call in the event that it fails, and a function to
+ --      call to determine the next action.
+ --
+ --      In the event an exception occurs on the call to the first procedure,
+ --      the exception is stored in a stack; along with the designator to the
+ --      procedure that caused it; allowing the procedure to be called again, 
+ --      or the exception to be re-raised.
+ --
+ --      A full implementation of such a tool would use a more robust storage
+ --      mechanism, and would provide a more flexible interface.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      29 MAR 96   SAIC   Initial version
+ --      12 NOV 96   SAIC   Revised for 2.1 release
+ --
+ --!
+ 
+ ----------------------------------------------------------------- CB40005_0
+ 
+ with Ada.Exceptions;
+ generic
+   type Proc_Pointer is access procedure;
+   type Func_Pointer is access function return Proc_Pointer;
+ package CB40005_0 is -- Fail_Soft
+ 
+ 
+   procedure Fail_Soft_Call( Proc_To_Call : Proc_Pointer;
+                             Proc_To_Call_On_Exception : Proc_Pointer := null;
+                             Retry_Routine : Func_Pointer := null );
+ 
+   function Top_Event_Exception return Ada.Exceptions.Exception_Occurrence;
+ 
+   function Top_Event_Procedure return Proc_Pointer;
+ 
+   procedure Pop_Event;
+ 
+   function Event_Stack_Size return Natural;
+ 
+ end CB40005_0; -- Fail_Soft
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CB40005_0
+ 
+ with Report;
+ package body CB40005_0 is
+ 
+   type History_Event is record
+     Exception_Event  : Ada.Exceptions.Exception_Occurrence_Access;
+     Procedure_Called : Proc_Pointer;
+   end record;
+ 
+   procedure Store_Event( Proc_Called : Proc_Pointer;
+                          Error       : Ada.Exceptions.Exception_Occurrence );
+ 
+   procedure Fail_Soft_Call( Proc_To_Call : Proc_Pointer;
+                             Proc_To_Call_On_Exception : Proc_Pointer := null;
+                             Retry_Routine : Func_Pointer := null ) is
+ 
+     Current_Proc_To_Call : Proc_Pointer := Proc_To_Call;
+ 
+   begin
+     while Current_Proc_To_Call /= null loop
+       begin
+         Current_Proc_To_Call.all;  -- call procedure through pointer
+         Current_Proc_To_Call := null;
+       exception
+         when Capture: others =>
+           Store_Event( Current_Proc_To_Call, Capture );
+           if Proc_To_Call_On_Exception /= null then
+             Proc_To_Call_On_Exception.all;
+           end if;
+           if Retry_Routine /= null then
+             Current_Proc_To_Call := Retry_Routine.all;
+           else
+             Current_Proc_To_Call := null;
+           end if;
+       end;
+     end loop;
+   end Fail_Soft_Call;
+   
+   Stack : array(1..10) of History_Event;  -- minimal, sufficient for testing
+ 
+   Stack_Top : Natural := 0;
+ 
+   procedure Store_Event( Proc_Called : Proc_Pointer;
+                          Error       : Ada.Exceptions.Exception_Occurrence )
+   is
+   begin
+     Stack_Top := Stack_Top +1;
+     Stack(Stack_Top) := ( Ada.Exceptions.Save_Occurrence(Error),
+                           Proc_Called );
+   end Store_Event;
+ 
+   function Top_Event_Exception return Ada.Exceptions.Exception_Occurrence is
+   begin
+     if Stack_Top > 0 then
+       return Stack(Stack_Top).Exception_Event.all;
+     else
+       return Ada.Exceptions.Null_Occurrence;
+     end if;
+   end Top_Event_Exception;
+ 
+   function Top_Event_Procedure return Proc_Pointer is
+   begin
+     if Stack_Top > 0 then
+       return Stack(Stack_Top).Procedure_Called;
+     else
+       return null;
+     end if;
+   end Top_Event_Procedure;
+ 
+   procedure Pop_Event is
+   begin
+     if Stack_Top > 0 then
+       Stack_Top := Stack_Top -1;
+     else
+       Report.Failed("Stack Error");
+     end if;
+   end Pop_Event;
+ 
+   function Event_Stack_Size return Natural is
+   begin
+     return Stack_Top;
+   end Event_Stack_Size;
+ 
+ end CB40005_0;
+ 
+ ------------------------------------------------------------------- CB40005
+ 
+ with Report;
+ with TCTouch;
+ with CB40005_0;
+ with Ada.Exceptions;
+ procedure CB40005 is
+ 
+   type Proc_Pointer is access procedure;
+   type Func_Pointer is access function return Proc_Pointer;
+ 
+   package Fail_Soft is new CB40005_0(Proc_Pointer, Func_Pointer);
+ 
+   procedure Cause_Standard_Exception;
+ 
+   procedure Cause_Visible_Exception;
+ 
+   procedure Cause_Invisible_Exception;
+ 
+   Exception_Procedure_Pointer : Proc_Pointer;
+ 
+   Visible_Exception : exception;
+ 
+   procedure Action_On_Exception;
+ 
+   function Retry_Procedure return Proc_Pointer;
+ 
+   Raise_Error : Boolean;
+ 
+   -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+   procedure Cause_Standard_Exception is
+   begin
+     TCTouch.Touch('S');  --------------------------------------------------- S
+     if Raise_Error then
+       raise Constraint_Error;
+     end if;
+   end Cause_Standard_Exception;
+ 
+   procedure Cause_Visible_Exception is
+   begin
+     TCTouch.Touch('V');  --------------------------------------------------- V
+     if Raise_Error then
+       raise Visible_Exception;
+     end if;
+   end Cause_Visible_Exception;
+ 
+   procedure Cause_Invisible_Exception is
+     Invisible_Exception : exception;
+   begin
+     TCTouch.Touch('I');  --------------------------------------------------- I
+     if Raise_Error then
+       raise Invisible_Exception;
+     end if;
+   end Cause_Invisible_Exception;
+ 
+   procedure Action_On_Exception is
+   begin
+     TCTouch.Touch('A');  --------------------------------------------------- A
+   end Action_On_Exception;
+ 
+   function Retry_Procedure return Proc_Pointer is
+   begin
+     TCTouch.Touch('R');  --------------------------------------------------- R
+     return Action_On_Exception'Access;
+   end Retry_Procedure;
+ 
+          -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("CB40005", "Check that exceptions raised in non-generic " &
+                           "code can be handled by a procedure in a generic " &
+                           "package.  Check that the exception identity can " &
+                           "be properly retrieved from the generic code and " &
+                           "used by the non-generic code" );
+ 
+   -- first, check that the no exception cases cause no action on the stack
+   Raise_Error := False;
+ 
+   Fail_Soft.Fail_Soft_Call( Cause_Standard_Exception'Access );    -- S
+ 
+   Fail_Soft.Fail_Soft_Call( Cause_Visible_Exception'Access,       -- V
+                             Action_On_Exception'Access,
+                             Retry_Procedure'Access );
+ 
+   Fail_Soft.Fail_Soft_Call( Cause_Invisible_Exception'Access,     -- I
+                             null,
+                             Retry_Procedure'Access );
+ 
+   TCTouch.Assert( Fail_Soft.Event_Stack_Size = 0, "Empty stack");
+ 
+   TCTouch.Validate( "SVI", "Non error case check" );
+ 
+   -- second, check that error cases add to the stack
+   Raise_Error := True;
+ 
+   Fail_Soft.Fail_Soft_Call( Cause_Standard_Exception'Access );    -- S
+ 
+   Fail_Soft.Fail_Soft_Call( Cause_Visible_Exception'Access,       -- V
+                             Action_On_Exception'Access,           -- A
+                             Retry_Procedure'Access );             -- RA
+ 
+   Fail_Soft.Fail_Soft_Call( Cause_Invisible_Exception'Access,     -- I
+                             null,
+                             Retry_Procedure'Access );             -- RA
+ 
+   TCTouch.Assert( Fail_Soft.Event_Stack_Size = 3, "Stack = 3");
+ 
+   TCTouch.Validate( "SVARAIRA", "Error case check" );
+ 
+   -- check that the exceptions and procedure were stored correctly
+   -- on the stack
+   Raise_Error := False;
+ 
+   -- return procedure pointer from top of stack and call the procedure
+   -- through that pointer:
+ 
+   Fail_Soft.Top_Event_Procedure.all;
+ 
+   TCTouch.Validate( "I", "Invisible case unwind" );
+ 
+   begin
+     Ada.Exceptions.Raise_Exception( 
+       Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
+     Report.Failed("1: Exception not raised");
+   exception
+     when Constraint_Error  => Report.Failed("1: Raised Constraint_Error");
+     when Visible_Exception => Report.Failed("1: Raised Visible_Exception");
+     when others            => null; -- expected case
+   end;
+ 
+   Fail_Soft.Pop_Event;
+ 
+   -- return procedure pointer from top of stack and call the procedure
+   -- through that pointer:
+ 
+   Fail_Soft.Top_Event_Procedure.all;
+ 
+   TCTouch.Validate( "V", "Visible case unwind" );
+ 
+   begin
+     Ada.Exceptions.Raise_Exception( 
+       Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
+     Report.Failed("2: Exception not raised");
+   exception
+     when Constraint_Error  => Report.Failed("2: Raised Constraint_Error");
+     when Visible_Exception => null; -- expected case
+     when others            => Report.Failed("2: Raised Invisible_Exception");
+   end;
+ 
+   Fail_Soft.Pop_Event;
+ 
+   Fail_Soft.Top_Event_Procedure.all;
+ 
+   TCTouch.Validate( "S", "Standard case unwind" );
+ 
+   begin
+     Ada.Exceptions.Raise_Exception( 
+       Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
+     Report.Failed("3: Exception not raised");
+   exception
+     when Constraint_Error  => null; -- expected case
+     when Visible_Exception => Report.Failed("3: Raised Visible_Exception");
+     when others            => Report.Failed("3: Raised Invisible_Exception");
+   end;
+ 
+   Fail_Soft.Pop_Event;
+ 
+   TCTouch.Assert( Fail_Soft.Event_Stack_Size = 0, "Stack empty after pops");
+ 
+   Report.Result;
+ 
+ end CB40005;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- CB4001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ANY EXCEPTION RAISED IN THE STATEMENT SEQUENCE OF A
+ -- SUBPROGRAM IS PROPAGATED TO THE CALLER OF THE SUBPROGRAM, NOT TO THE
+ -- STATICALLY ENCLOSING LEXICAL ENVIRONMENT.
+ 
+ -- RM  05/30/80
+ -- JRK 11/19/80
+ -- SPS 03/28/83
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ 
+ WITH REPORT;
+ PROCEDURE CB4001A IS
+ 
+      USE REPORT;
+ 
+      E1 : EXCEPTION;
+      I9 : INTEGER RANGE 1..10 ;
+      FLOW_COUNT : INTEGER := 0 ;
+ 
+ BEGIN
+      TEST("CB4001A","CHECK THAT ANY EXCEPTION RAISED IN THE " &
+           "STATEMENT SEQUENCE OF A SUBPROGRAM IS " &
+           "PROPAGATED TO THE CALLER, NOT TO THE STATICALLY ENCLOSING" &
+           " LEXICAL ENVIRONMENT");
+ 
+      BEGIN   --  BLOCK WITH HANDLERS; LEX. ENVIRONMT FOR ALL PROC.DEFS
+ 
+           DECLARE   --  BLOCK WITH PROCEDURE DEFINITIONS
+ 
+                PROCEDURE  CALLEE1 ;
+                PROCEDURE  CALLEE2 ;
+                PROCEDURE  CALLEE3 ;
+                PROCEDURE  R ;
+                PROCEDURE  S ;
+ 
+                PROCEDURE  CALLER1  IS
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1 ;
+                     CALLEE1 ;
+                     FAILED("EXCEPTION NOT RAISED  (CALLER1)");
+                EXCEPTION
+                     WHEN E1 =>
+                          FLOW_COUNT := FLOW_COUNT + 1 ;
+                END ;
+ 
+                PROCEDURE  CALLER2  IS
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1 ;
+                     CALLEE2 ;
+                     FAILED("EXCEPTION NOT RAISED  (CALLER2)");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          FLOW_COUNT := FLOW_COUNT + 1 ;
+                END ;
+ 
+                PROCEDURE  CALLER3  IS
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1 ;
+                     CALLEE3 ;
+                     FAILED("EXCEPTION NOT RAISED  (CALLER3)");
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          FLOW_COUNT := FLOW_COUNT + 1 ;
+                END ;
+ 
+                PROCEDURE  CALLEE1  IS
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1 ;
+                     R ;
+                     FAILED("EXCEPTION NOT RAISED  (CALLEE1)");
+                END ;
+ 
+                PROCEDURE  CALLEE2  IS
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1 ;
+                     RAISE  CONSTRAINT_ERROR ;
+                     FAILED("EXCEPTION NOT RAISED  (CALLEE2)");
+                EXCEPTION
+                     WHEN PROGRAM_ERROR =>
+                          FAILED("WRONG EXCEPTION RAISED  (CALLEE2)");
+                END ;
+ 
+                PROCEDURE  CALLEE3  IS
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 1 ;
+                     I9 := IDENT_INT(20) ;
+                     FAILED("EXCEPTION NOT RAISED  (CALLEE3)");
+                END ;
+ 
+                PROCEDURE  R  IS
+                     E2 : EXCEPTION;
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 10 ;
+                     S ;
+                     FAILED("EXCEPTION E1 NOT RAISED (PROC R)");
+                EXCEPTION
+                     WHEN E2 =>
+                          FAILED("WRONG EXCEPTION RAISED  (PROC R)");
+                END ;
+ 
+                PROCEDURE  S  IS
+                BEGIN
+                     FLOW_COUNT := FLOW_COUNT + 10 ;
+                     RAISE  E1 ;
+                     FAILED("EXCEPTION  E1  NOT RAISED  (PROC S)");
+                END ;
+ 
+           BEGIN   --  (THE BLOCK WITH PROC. DEFS)
+ 
+                CALLER1;
+                CALLER2;
+                CALLER3;
+ 
+           END ;   --  (THE BLOCK WITH PROC. DEFS)
+ 
+      EXCEPTION
+ 
+           WHEN OTHERS =>
+                FAILED("EXCEPTION PROPAGATED STATICALLY");
+ 
+      END ;
+ 
+      IF  FLOW_COUNT /= 29  THEN
+           FAILED("INCORRECT FLOW_COUNT VALUE");
+      END IF;
+ 
+      RESULT;
+ END CB4001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,127 ----
+ -- CB4002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EXCEPTIONS RAISED DURING ELABORATION OF THE
+ -- DECLARATIVE PART OF A SUBPROGRAM ARE PROPAGATED TO THE
+ -- CALLER, FOR CONSTRAINT_ERROR CAUSED BY INITIALIZATION,
+ -- AND CONSTRAINT ELABORATION, AND FOR FUNCTION EVALUATIONS
+ -- RAISING  CONSTRAINT_ERROR AND A PROGRAMMER-DEFINED EXCEPTION.
+ 
+ -- DAT 4/13/81
+ -- SPS 3/28/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB4002A IS
+ BEGIN
+      TEST("CB4002A", "EXCEPTIONS IN SUBPROGRAM DECLARATIVE_PARTS"
+           & " ARE PROPAGATED TO CALLER");
+ 
+      DECLARE
+           SUBTYPE I5 IS INTEGER RANGE -5 .. 5;
+      
+           E : EXCEPTION;
+      
+           FUNCTION RAISE_IT (I : I5) RETURN INTEGER IS
+                J : INTEGER RANGE 0 .. 1 := I;
+           BEGIN
+                IF I = 0 THEN
+                     RAISE CONSTRAINT_ERROR;
+                ELSIF I = 1 THEN
+                     RAISE E;
+                END IF;
+                FAILED ("EXCEPTION NOT RAISED 0");
+                RETURN J;
+           EXCEPTION
+                WHEN OTHERS =>
+                     IF I NOT IN 0 .. 1 THEN
+                          FAILED ("WRONG HANDLER 0");
+                          RETURN 0;
+                     ELSE
+                          RAISE;
+                     END IF;
+           END RAISE_IT;
+      
+           PROCEDURE P1 (P : INTEGER) IS
+                Q : INTEGER := RAISE_IT (P);
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED 1");
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("WRONG HANDLER 1");
+           END P1;
+ 
+           PROCEDURE P2 (P : INTEGER) IS
+                Q : I5 RANGE 0 .. P := 1;
+           BEGIN
+                IF P = 0 OR P > 5 THEN
+                     FAILED ("EXCEPTION NOT RAISED 2");
+                END IF;
+           END P2;
+      
+      BEGIN
+      
+           BEGIN
+                P1(-1);
+                FAILED ("EXCEPTION NOT RAISED 2A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+           END;
+      
+           BEGIN
+                P1(0);
+                FAILED ("EXCEPTION NOT RAISED 3");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+           END;
+      
+           BEGIN
+                P1(1);
+                FAILED ("EXCEPTION NOT RAISED 4");
+           EXCEPTION
+                WHEN E => NULL;
+           END;
+      
+           BEGIN
+                P2(0);
+                FAILED ("EXCEPTION NOT RAISED 5");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+           END;
+      
+           BEGIN
+                P2(6);
+                FAILED ("EXCEPTION NOT RAISED 6");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+           END;
+      
+      EXCEPTION
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION OR HANDLER");
+      END;
+      
+      RESULT;
+ EXCEPTION
+      WHEN OTHERS => FAILED ("WRONG HANDLER FOR SURE"); RESULT;
+ END CB4002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4003a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4003a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4003a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4003a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- CB4003A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT EXCEPTIONS RAISED DURING ELABORATION OF PACKAGE
+ --     SPECIFICATIONS, OR DECLARATIVE_PARTS OF BLOCKS AND PACKAGE
+ --     BODIES, ARE PROPAGATED TO THE STATIC ENVIRONMENT.  EXCEPTIONS
+ --     ARE CAUSED BY INITIALIZATIONS AND FUNCTION CALLS.
+ 
+ -- HISTORY:
+ --     DAT 04/14/81  CREATED ORIGINAL TEST.
+ --     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO
+ --                   PREVENT OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB4003A IS
+ 
+      E : EXCEPTION;
+ 
+      FUNCTION F (B : BOOLEAN) RETURN INTEGER IS
+      BEGIN
+           IF B THEN
+                RAISE E;
+           ELSE
+                RETURN 1;
+           END IF;
+      END F;
+ 
+ BEGIN
+      TEST ("CB4003A", "CHECK THAT EXCEPTIONS DURING ELABORATION"
+           & " OF DECLARATIVE PARTS"
+           & " IN BLOCKS, PACKAGE SPECS, AND PACKAGE BODIES ARE"
+           & " PROPAGATED TO STATIC ENCLOSING ENVIRONMENT");
+ 
+      BEGIN
+           DECLARE
+                PACKAGE P1 IS
+                     I : INTEGER RANGE 1 .. 1 := 2;
+                END P1;
+           BEGIN
+                FAILED ("EXCEPTION NOT RAISED 1");
+                IF NOT EQUAL(P1.I,P1.I) THEN
+                     COMMENT ("NO EXCEPTION RAISED");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS => FAILED ("WRONG HANDLER 1");
+           END;
+           FAILED ("EXCEPTION NOT RAISED 1A");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
+      END;
+ 
+      FOR L IN IDENT_INT(1) .. IDENT_INT(4) LOOP
+           BEGIN
+                DECLARE
+                     PACKAGE P2 IS
+                     PRIVATE
+                          J : INTEGER RANGE 2 .. 4 := L;
+                     END P2;
+ 
+                     Q : INTEGER := F(L = 3);
+ 
+                     PACKAGE BODY P2 IS
+                          K : INTEGER := F(L = 2);
+ 
+                     BEGIN
+                          IF NOT (EQUAL(J,J) OR EQUAL(K,K)) THEN
+                               COMMENT("CAN'T OPTIMIZE THIS");
+                          END IF;
+                     END P2;
+                BEGIN
+                     IF L /= 4 THEN
+                          FAILED ("EXCEPTION NOT RAISED 2");
+                     END IF;
+ 
+                     IF NOT EQUAL(Q,Q) THEN
+                          COMMENT("CAN'T OPTIMIZE THIS");
+                     END IF;
+ 
+                     EXIT;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION HANDLER 2");
+                          EXIT;
+                END;
+                FAILED ("EXCEPTION NOT RAISED 2A");
+           EXCEPTION
+                WHEN E | CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+           END;
+      END LOOP;
+ 
+      RESULT;
+ 
+ END CB4003A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- CB4004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT VARIOUS EXCEPTIONS IN THE BODY OF A SUBPROGRAM WITH
+ -- AN APPLICABLE HANDLER ARE HANDLED LOCALLY.
+ 
+ -- DAT 04/15/81
+ -- JRK 04/24/81
+ -- SPS 11/02/82
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB4004A IS
+ 
+      E, F : EXCEPTION;
+      STORAGE_ERROR: EXCEPTION;
+ 
+      I1 : INTEGER RANGE 1 .. 1;
+ 
+      FUNCTION F1 (I : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           CASE I IS
+                WHEN 1 => RAISE E;
+                WHEN 2 => RAISE STORAGE_ERROR;
+                WHEN 3 => I1 := 4;
+                WHEN 4 => RAISE TASKING_ERROR;
+                WHEN OTHERS => NULL;
+           END CASE;
+           RETURN FALSE;
+      EXCEPTION
+           WHEN E | F => RETURN I = 1;
+           WHEN STORAGE_ERROR => RETURN I = 2;
+           WHEN PROGRAM_ERROR | CONSTRAINT_ERROR =>
+                RETURN I = 3;
+           WHEN OTHERS => RETURN I = 4;
+      END F1;
+ 
+ BEGIN
+      TEST ("CB4004A", "EXCEPTIONS WITH LOCAL HANDLERS ARE HANDLED"
+           & " THERE");
+ 
+      BEGIN
+           FOR L IN 1 .. 4 LOOP
+                IF F1(L) /= TRUE THEN
+                     FAILED ("LOCAL EXCEPTIONS DON'T WORK");
+                     EXIT;
+                END IF;
+           END LOOP;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("WRONG HANDLER");
+      END;
+ 
+      RESULT;
+ END CB4004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4005a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4005a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4005a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4005a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- CB4005A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT EXCEPTIONS PROPAGATED OUT OF A HANDLER ARE PROPAGATED
+ -- OUTSIDE THE ENCLOSING UNIT.
+ 
+ -- DAT 4/15/81
+ -- SPS 3/28/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB4005A IS
+ 
+      E , F : EXCEPTION;
+ 
+      B : BOOLEAN := FALSE;
+ 
+      PROCEDURE P IS
+      BEGIN
+           RAISE E;
+      EXCEPTION
+           WHEN F => FAILED ("WRONG HANDLER 1");
+           WHEN E =>
+                IF B THEN
+                     FAILED ("WRONG HANDLER 2");
+                ELSE
+                     B := TRUE;
+                     RAISE F;
+                END IF;
+      END P;
+ 
+ BEGIN
+      TEST ("CB4005A", "EXCEPTIONS FROM HANDLERS ARE PROPAGATED " & 
+            "OUTSIDE");
+ 
+      BEGIN
+           P;
+           FAILED ("EXCEPTION NOT PROPAGATED 1");
+      EXCEPTION
+           WHEN F => NULL;
+           WHEN OTHERS => FAILED ("WRONG HANDLER 3");
+      END;
+ 
+      RESULT;
+ END CB4005A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4006a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4006a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4006a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4006a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- CB4006A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT EXCEPTIONS IN A BLOCK IN A HANDLER
+ --     ARE HANDLED CORRECTLY.
+ 
+ -- HISTORY:
+ --     DAT 04/15/81
+ --     SPS 11/02/82
+ --     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO
+ --                   PREVENT OPTIMIZATION.
+ --     JRL 05/28/92  CHANGED CODE IN PROGRAM_ERROR BLOCK TO
+ --                   PREVENT OPTIMIZATION.
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CB4006A IS
+ 
+      I1 : INTEGER RANGE 1 .. 2 := 1;
+ 
+      PROCEDURE P IS
+      BEGIN
+           IF EQUAL(3,3) THEN
+                RAISE PROGRAM_ERROR;
+           END IF;
+      EXCEPTION
+           WHEN PROGRAM_ERROR =>
+                DECLARE
+                     I : INTEGER RANGE 1 .. 1 := I1;
+                BEGIN
+                     IF EQUAL(I,I) THEN
+                          I := I1 + 1;
+                     END IF ;
+                     FAILED ("EXCEPTION NOT RAISED 1");
+ 
+                     IF NOT EQUAL(I,I) THEN
+                          COMMENT ("CAN'T OPTIMIZE THIS");
+                     END IF;
+ 
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          IF I1 /= 1 THEN
+                               FAILED ("WRONG HANDLER 1");
+                          ELSE
+                               I1 := I1 + 1;
+                          END IF;
+                END;
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("WRONG HANDLER 3");
+      END P;
+ 
+ BEGIN
+      TEST ("CB4006A", "CHECK THAT EXCEPTIONS IN BLOCKS IN " &
+                       "HANDLERS WORK");
+ 
+      P;
+      IF IDENT_INT(I1) /= 2 THEN
+           FAILED ("EXCEPTION NOT HANDLED CORRECTLY");
+      ELSE
+           BEGIN
+                P;
+                FAILED ("EXCEPTION NOT RAISED CORRECTLY 2");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR => NULL;
+           END;
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS => FAILED ("WRONG HANDLER 2");
+           RESULT;
+ 
+ END CB4006A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- CB4007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE STATEMENT PART OF A PACKAGE CAN RAISE, PROPAGATE,
+ --     AND HANDLE EXCEPTIONS. IF THE BODY'S HANDLERS HANDLE ALL
+ --     EXCEPTIONS RAISED AND DO NOT RAISE ANY UNHANDLED EXCEPTIONS,
+ --     NO EXCEPTION IS PROPAGATED.
+ 
+ -- HISTORY:
+ --     DHH 03/28/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CB4007A IS
+ BEGIN
+ 
+      TEST("CB4007A", "CHECK THAT THE STATEMENT PART OF A PACKAGE " &
+                      "CAN RAISE, PROPAGATE, AND HANDLE EXCEPTIONS. " &
+                      "IF THE BODY'S HANDLERS HANDLE ALL EXCEPTIONS " &
+                      "RAISED AND DO NOT RAISE ANY UNHANDLED " &
+                      "EXCEPTIONS, NO EXCEPTION IS PROPAGATED");
+      DECLARE
+ 
+           PACKAGE OUTSIDE IS
+           END OUTSIDE;
+ 
+           PACKAGE BODY OUTSIDE IS
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE HANDLER IS
+                     END HANDLER;
+ 
+                     PACKAGE BODY HANDLER IS
+                     BEGIN
+                          DECLARE
+                               PACKAGE PROPAGATE IS
+                               END PROPAGATE;
+ 
+                               PACKAGE BODY PROPAGATE IS
+                               BEGIN
+                                    DECLARE
+                                         PACKAGE RISE IS
+                                         END RISE;
+ 
+                                         PACKAGE BODY RISE IS
+                                         BEGIN
+                                              RAISE CONSTRAINT_ERROR;
+                                              FAILED("EXCEPTION " &
+                                                     "NOT RAISED");
+                                         END RISE;
+ 
+                                    BEGIN
+                                         NULL;
+                                    END;   -- PACKAGE PROPAGATE DECLARE.
+                               EXCEPTION
+                                    WHEN CONSTRAINT_ERROR =>
+                                         RAISE CONSTRAINT_ERROR;
+                                    WHEN OTHERS =>
+                                         FAILED("UNEXPECTED EXCEPTION " &
+                                                "RAISED IN PROPAGATE " &
+                                                "PACKAGE");
+                               END PROPAGATE;
+ 
+                          BEGIN
+                               NULL;
+                          END;               -- PACKAGE HANDLER DECLARE.
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                          WHEN OTHERS =>
+                               FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                                      "HANDLER PACKAGE");
+                     END HANDLER;
+ 
+                BEGIN
+                     NULL;
+                END;                    -- PACKAGE OUTSIDE DECLARE.
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED("UNEXPECTED EXCEPTION RAISED IN OUTSIDE " &
+                            "PACKAGE");
+           END OUTSIDE;
+      BEGIN
+          NULL;
+      END;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN OTHERS =>
+           FAILED("UNEXPECTED EXCEPTION RAISED");
+           RESULT;
+ END CB4007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4008a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4008a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4008a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4008a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,137 ----
+ -- CB4008A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NESTED LAST WISHES EXCEPTION HANDLERS WORK 
+ -- (FOR PROCEDURES).
+ 
+ -- DAT 4/15/81
+ -- SPS 3/28/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB4008A IS
+ 
+      C : INTEGER := 0;
+ 
+      E : EXCEPTION;
+ 
+      DEPTH : CONSTANT := 99;
+ 
+      PROCEDURE F;
+ 
+      PROCEDURE I IS
+      BEGIN
+           C := C + 1;
+           IF C >= DEPTH THEN
+                RAISE E;
+           END IF;
+      END I;
+ 
+      PROCEDURE O IS
+      BEGIN
+           C := C - 1;
+      END O;
+ 
+      PROCEDURE X IS
+           PROCEDURE X1 IS
+                PROCEDURE X2 IS
+                BEGIN
+                     F;
+                END X2;
+ 
+                PROCEDURE X3 IS
+                BEGIN
+                     I;
+                     X2;
+                EXCEPTION
+                     WHEN E => O; RAISE;
+                END X3;
+           BEGIN
+                I;
+                X3;
+           EXCEPTION
+                WHEN E => O; RAISE;
+           END X1;
+ 
+           PROCEDURE X1A IS
+           BEGIN
+                I;
+                X1;
+                FAILED ("INCORRECT EXECUTION SEQUENCE");
+           EXCEPTION
+                WHEN E => O; RAISE;
+           END X1A;
+      BEGIN
+           I;
+           X1A;
+      EXCEPTION
+           WHEN E => O; RAISE;
+      END X;
+ 
+      PROCEDURE Y IS
+      BEGIN
+           I;
+           X;
+      EXCEPTION WHEN E => O; RAISE;
+      END Y;
+ 
+      PROCEDURE F IS
+           PROCEDURE F2;
+ 
+           PROCEDURE F1 IS
+           BEGIN
+                I;
+                F2;
+           EXCEPTION WHEN E => O; RAISE;
+           END F1;
+ 
+           PROCEDURE F2 IS
+           BEGIN
+                I;
+                Y;
+           EXCEPTION WHEN E => O; RAISE;
+           END F2;
+      BEGIN
+           I;
+           F1;
+      EXCEPTION WHEN E => O; RAISE;
+      END F;
+ 
+ BEGIN
+      TEST ("CB4008A", "(PROCEDURE) LAST WISHES UNWIND PROPERLY");
+ 
+      BEGIN
+           I;
+           Y;
+           FAILED ("INCORRECT EXECUTION SEQUENCE 2");
+      EXCEPTION
+           WHEN E =>
+                O;
+                IF C /= 0 THEN
+                     FAILED ("EXCEPTION HANDLER MISSED SOMEWHERE");
+                END IF;
+      END;
+ 
+      RESULT;
+ END CB4008A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4009a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4009a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4009a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4009a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,114 ----
+ -- CB4009A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A PROGRAMMER DEFINED EXCEPTION AND A REDECLARED
+ -- PREDEFINED EXCEPTION MAY BE PROPAGATED OUT OF SCOPE AND BACK IN,
+ -- WITH OUT-OF-SCOPE 'OTHERS' HANDLERS HANDLING THE EXCEPTION
+ -- INSTEAD OF OTHER HANDLERS. SEPARATELY COMPILED UNITS ARE NOT TESTED.
+ 
+ -- DAT 4/15/81
+ -- SPS 1/14/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CB4009A IS
+ 
+      E : EXCEPTION;
+ 
+      I : INTEGER := 0;
+ 
+      PROCEDURE P1 (C : INTEGER);
+      PROCEDURE P2 (C : INTEGER);
+      PROCEDURE P3 (C : INTEGER);
+ 
+      F : BOOLEAN := FALSE;
+      T : CONSTANT BOOLEAN := TRUE;
+ 
+      PROCEDURE P1 (C : INTEGER) IS
+      BEGIN
+           P3(C);
+      EXCEPTION
+           WHEN E => F := T;
+           WHEN CONSTRAINT_ERROR => F := T;
+           WHEN OTHERS => I := I + 1; RAISE;
+      END P1;
+ 
+      PROCEDURE P2 (C : INTEGER) IS
+           E : EXCEPTION;
+           CONSTRAINT_ERROR : EXCEPTION;
+      BEGIN
+           CASE C IS
+                WHEN 0 => FAILED ("WRONG CASE");
+                WHEN 1 => RAISE E;
+                WHEN -1 => RAISE CONSTRAINT_ERROR;
+                WHEN OTHERS => P1 (C - C/ABS(C));
+           END CASE;
+      EXCEPTION
+           WHEN E =>
+                I := I + 100; RAISE;
+           WHEN CONSTRAINT_ERROR =>
+                I := I + 101; RAISE;
+           WHEN OTHERS =>
+                F := T;
+      END P2;
+ 
+      PROCEDURE P3 (C : INTEGER) IS
+      BEGIN
+           P2(C);
+      EXCEPTION
+           WHEN E => F := T;
+           WHEN CONSTRAINT_ERROR => F := T;
+      END P3;
+ 
+ BEGIN
+      TEST ("CB4009A", "EXCEPTIONS PROPAGATED OUT OF SCOPE");
+ 
+      I := 0;
+      BEGIN
+           P3 (-2);
+           FAILED ("EXCEPTION NOT RAISED 1");
+      EXCEPTION
+           WHEN OTHERS => NULL;
+      END;
+      IF I /= 203 THEN
+           FAILED ("INCORRECT HANDLER SOMEWHERE 1");
+      END IF;
+ 
+      I := 0;
+      BEGIN
+           P3(3);
+           FAILED ("EXCEPTION NOT RAISED 2");
+      EXCEPTION
+           WHEN OTHERS => NULL;
+      END;
+      IF I /= 302 THEN
+           FAILED ("INCORRECT HANDLER SOMEWHERE 2");
+      END IF;
+ 
+      IF F = T THEN
+           FAILED ("WRONG HANDLER SOMEWHERE");
+      END IF;
+ 
+      RESULT;
+ END CB4009A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4013a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4013a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb4013a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb4013a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,80 ----
+ -- CB4013A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN UNHANDLED EXCEPTION RAISED IN A TASK BODY, BUT
+ --     OUTSIDE AN ACCEPT STATEMENT, RAISES NO EXCEPTION OUTSIDE THE
+ --     TASK.
+ 
+ -- HISTORY:
+ --     DHH 03/29/88 CREATED ORIGINAL TEST.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CB4013A IS
+ 
+      TASK TYPE CHOICE IS
+           ENTRY E1;
+           ENTRY STOP;
+      END CHOICE;
+ 
+      T : CHOICE;
+ 
+      TASK BODY CHOICE IS
+      BEGIN
+           ACCEPT E1;
+           IF EQUAL(3,3) THEN
+                RAISE CONSTRAINT_ERROR;
+           END IF;
+           ACCEPT STOP;
+      END CHOICE;
+ 
+ BEGIN
+ 
+      TEST("CB4013A", "CHECK THAT AN UNHANDLED EXCEPTION RAISED IN " &
+                      "A TASK BODY, BUT OUTSIDE AN ACCEPT STATEMENT, " &
+                      "RAISES NO EXCEPTION OUTSIDE THE TASK");
+ 
+      T.E1;
+      DELAY 1.0;
+      IF T'CALLABLE THEN
+           FAILED("TASK NOT COMPLETED ON RAISING CONSTRAINT_ERROR");
+           T.STOP;
+      END IF;
+ 
+      RESULT;
+ 
+ EXCEPTION
+      WHEN TASKING_ERROR =>
+           FAILED("TASKING_ERROR RAISED OUTSIDE TASK");
+           RESULT;
+ 
+      WHEN CONSTRAINT_ERROR =>
+           FAILED("CONSTRAINT_ERROR PROPAGATED OUTSIDE TASK");
+           RESULT;
+ 
+      WHEN OTHERS =>
+           FAILED("UNEXPECTED EXCEPTION RAISED");
+           RESULT;
+ END CB4013A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,135 ----
+ -- CB40A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a user defined exception is correctly propagated out of
+ --      a public child package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a public child package containing a procedure used to 
+ --      analyze the alphanumeric content of a particular text string.
+ --      The procedure contains a processing loop that continues until the
+ --      range of the text string is exceeded, at which time a user defined
+ --      exception is raised.  This exception propagates out of the procedure
+ --      through the parent package, to the main test program.
+ --
+ --      Exception Type Raised:
+ --        * User Defined
+ --          Predefined  
+ --
+ --      Hierarchical Structure Employed For This Test:  
+ --        * Parent Package
+ --        * Public Child Package
+ --          Private Child Package
+ --          Public Child Subprogram
+ --          Private Child Subprogram
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --         FB40A00.A
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ package FB40A00.CB40A01_0 is    -- package Text_Parser.Processing
+ 
+    procedure Process_Text (Text : in String_Pointer_Type);
+ 
+ end FB40A00.CB40A01_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with Report;
+ 
+ package body FB40A00.CB40A01_0 is
+ 
+    procedure Process_Text (Text : in String_Pointer_Type) is
+       Pos : Natural := Text'First - 1;
+    begin
+       loop   -- Process string, raise exception upon completion.
+          Pos := Pos + 1;
+          if Pos > Text.all'Last then
+             raise Completed_Text_Processing; 
+          elsif (Text.all (Pos) in 'A' .. 'Z') or
+                (Text.all (Pos) in 'a' .. 'z') or
+                (Text.all (Pos) in '0' .. '9') then
+             Increment_AlphaNumeric_Count;
+          else
+             Increment_Non_AlphaNumeric_Count;
+          end if;
+       end loop;
+       -- No exception handler here, exception propagates.
+       Report.Failed ("No exception raised in child package subprogram");
+    end Process_Text;
+ 
+ end FB40A00.CB40A01_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with FB40A00.CB40A01_0;
+ with Report;
+ 
+ procedure CB40A01 is
+ 
+    String_Pointer : FB40A00.String_Pointer_Type := 
+      new String'("'Twas the night before Christmas, " &
+                  "and all through the house...");
+ 
+ begin
+ 
+    Process_Block:
+    begin
+ 
+       Report.Test ("CB40A01", "Check that a user defined exception " &
+                               "is correctly propagated out of a "    &
+                               "public child package");
+ 
+       FB40A00.CB40A01_0.Process_Text (String_Pointer);
+ 
+       Report.Failed ("Exception should have been handled");
+ 
+    exception
+ 
+       when FB40A00.Completed_Text_Processing =>      -- Correct exception 
+          if FB40A00.AlphaNumeric_Count /= 48 then    -- propagation.
+             Report.Failed ("Incorrect string processing");
+          end if;
+ 
+       when others =>
+          Report.Failed ("Exception handled in an others handler");
+ 
+    end Process_Block;
+ 
+    Report.Result;
+ 
+ end CB40A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a020.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a020.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a020.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a020.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,95 ----
+ -- CB40A020.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CB40A021.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See CB40A021.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         FB40A00.A
+ --      => CB40A020.A
+ --         CB40A021.AM
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ 
+ package FB40A00.CB40A020_0 is    -- package Text_Parser.Processing 
+ 
+    function Count_AlphaNumerics (Text : in String) return Natural;
+ 
+ end FB40A00.CB40A020_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ -- Text_Parser.Processing.Process_Text 
+ with Report;
+ private procedure FB40A00.CB40A020_0.CB40A020_1 (Text : in String);
+ 
+ procedure FB40A00.CB40A020_0.CB40A020_1 (Text : in String) is
+    Pos : Natural := Text'First - 1;
+ begin
+    loop   -- Process string, raise exception upon completion.
+       Pos := Pos + 1;
+       if Pos > Text'Last then
+          raise Completed_Text_Processing; 
+       elsif (Text (Pos) in 'A' .. 'Z') or
+             (Text (Pos) in 'a' .. 'z') or
+             (Text (Pos) in '0' .. '9') then
+          Increment_AlphaNumeric_Count;
+       else
+          Increment_Non_AlphaNumeric_Count;
+       end if;
+    end loop;
+    -- No exception handler here, exception propagates.
+    Report.Failed ("No exception raised in child package subprogram");
+ end FB40A00.CB40A020_0.CB40A020_1;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with FB40A00.CB40A020_0.CB40A020_1;   -- "with" of  private child subprogram
+                                       -- Text_Parser.Processing.Process_Text 
+ package body FB40A00.CB40A020_0 is
+ 
+    function Count_AlphaNumerics (Text : in String) return Natural is
+    begin
+       FB40A00.CB40A020_0.CB40A020_1 (Text);  -- Call prvt child proc.
+       return (AlphaNumeric_Count);           -- Global maintained in parent.
+       -- No exception handler here, exception propagates.
+    end Count_AlphaNumerics;
+ 
+ end FB40A00.CB40A020_0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a021.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a021.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a021.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a021.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- CB40A021.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a user defined exception is correctly propagated from a
+ --      private child subprogram to its parent and then to a client of the
+ --      parent.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a child package containing a function.  The body of the 
+ --      function contains a call to a private child subprogram (child of
+ --      the child).  The private child subprogram raises an exception
+ --      defined in the root ancestor package, and it is propagated to the
+ --      test program.
+ --
+ --      Exception Type Raised:
+ --        * User Defined
+ --          Predefined  
+ --
+ --      Hierarchical Structure Employed For This Test:  
+ --        * Parent Package
+ --        * Visible Child Package
+ --          Private Child Package
+ --          Visible Child Subprogram
+ --        * Private Child Subprogram
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         FB40A00.A
+ --         CB40A020.A
+ --      => CB40A021.AM
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ 
+ with Report;
+ with FB40A00.CB40A020_0;   -- Explicit "with" of Text_Parser.Processing
+                            -- Implicit "with" of Text_Parser (FB40A00)
+ 
+ procedure CB40A021 is
+ 
+    String_Constant : constant String := 
+      "ACVC Version 2.0 will incorporate Ada 9X feature tests."; 
+ 
+    Number_Of_AlphaNumeric_Characters : Natural := 0;
+ 
+ begin
+ 
+    Process_Block:
+    begin
+ 
+       Report.Test ("CB40A021", "Check that a user defined exception " &
+                                "is correctly propagated across "      &
+                                "package and subprogram boundaries");
+ 
+       Number_Of_AlphaNumeric_Characters := 
+         FB40A00.CB40A020_0.Count_AlphaNumerics (String_Constant);
+ 
+       Report.Failed ("Exception should have been handled");
+ 
+    exception
+ 
+       when FB40A00.Completed_Text_Processing =>      -- Correct exception 
+          if FB40A00.AlphaNumeric_Count /= 45 then    -- propagation.
+             Report.Failed ("Incorrect string processing");
+          end if;
+ 
+       when others =>
+          Report.Failed ("Exception handled in an others handler");
+ 
+    end Process_Block;
+ 
+    Report.Result;
+ 
+ end CB40A021;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a030.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a030.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a030.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a030.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,105 ----
+ -- CB40A030.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      See CB40A031.AM.
+ --
+ -- TEST DESCRIPTION:
+ --      See CB40A031.AM.
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         FB40A00.A
+ --      => CB40A030.A
+ --         CB40A031.AM
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ 
+ package FB40A00.CB40A030_0 is  -- package Text_Parser.Character_Counting
+ 
+    function Count_AlphaNumerics (Text : in String) return Natural;
+ 
+ end FB40A00.CB40A030_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ private package  FB40A00.CB40A030_1  is    -- package Text_Parser.Processing
+ 
+    procedure Process_Text (Text : in String);
+ 
+ end FB40A00.CB40A030_1;  
+ 
+ 
+      --=================================================================--
+ 
+ 
+ package body  FB40A00.CB40A030_1  is
+ 
+    procedure Process_Text (Text : in String) is
+       Loop_Count : Integer := Text'Length + 1;
+    begin
+       for Pos in 1..Loop_Count loop          -- Process string, force the 
+                                              -- raise of Constraint_Error. 
+          if (Text (Pos) in 'a'..'z') or 
+             (Text (Pos) in 'A'..'Z') or
+             (Text (Pos) in '0'..'9') then
+             Increment_AlphaNumeric_Count;
+          else
+             Increment_Non_AlphaNumeric_Count;
+          end if;
+ 
+       end loop;
+       -- No exception handler here, exception propagates.
+    end Process_Text;
+ 
+ end FB40A00.CB40A030_1;  
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with FB40A00.CB40A030_1;  -- private sibling package Text_Parser.Processing;
+ 
+ package body FB40A00.CB40A030_0 is
+ 
+    function Count_AlphaNumerics (Text : in String) return Natural is
+    begin
+       FB40A00.CB40A030_1.Process_Text (Text);     -- Call proc in prvt child
+                                                   -- package that is a
+                                                   -- sibling of this package.
+       return (AlphaNumeric_Count);
+       -- No exception handler here, exception propagates.
+    end Count_AlphaNumerics;
+ 
+ end FB40A00.CB40A030_0;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a031.am gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a031.am
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a031.am	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a031.am	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,102 ----
+ -- CB40A031.AM
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a predefined exception is correctly propagated from
+ --      a private child package through a visible child package to a client.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare two child packages from a root package, one visible, one
+ --      private.  The visible child package contains a function, whose
+ --      body makes a call to a procedure contained in the private sibling
+ --      package.  A predefined exception occurring in the subprogram within the
+ --      private package is propagated through the visible sibling and ancestor
+ --      to the test program.
+ --
+ --      Exception Type Raised:
+ --          User Defined
+ --        * Predefined  
+ --
+ --      Hierarchical Structure Employed For This Test:  
+ --        * Parent Package
+ --        * Visible Child Package
+ --        * Private Child Package
+ --          Visible Child Subprogram
+ --          Private Child Subprogram
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         FB40A00.A
+ --         CB40A030.A
+ --      => CB40A031.AM
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+ --
+ --!
+ 
+ with Report;
+ with FB40A00.CB40A030_0; -- Explicit "with" of Text_Parser.Character_Counting
+                          -- Implicit "with" of Text_Parser
+ 
+ procedure CB40A031 is
+ 
+    String_Constant : constant String := 
+      "The San Diego Padres will win the World Series in 1999."; 
+ 
+    Number_Of_AlphaNumeric_Characters : Natural := 0;
+ 
+ begin
+ 
+    Process_Block:
+    begin
+ 
+       Report.Test ("CB40A031", "Check that a predefined exception " &
+                                "is correctly propagated across "    &
+                                "package boundaries");
+ 
+       Number_Of_AlphaNumeric_Characters := 
+         FB40A00.CB40A030_0.Count_AlphaNumerics (String_Constant);
+ 
+       Report.Failed ("Exception should have been handled");
+ 
+    exception
+ 
+       when Constraint_Error =>                       -- Correct exception 
+          if FB40A00.AlphaNumeric_Count /= 44 then    -- propagation.
+             Report.Failed ("Incorrect string processing");
+          end if;
+ 
+       when others =>
+          Report.Failed ("Exception handled in an others handler");
+ 
+    end Process_Block;
+ 
+    Report.Result;
+ 
+ end CB40A031;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a04.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a04.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb40a04.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb40a04.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- CB40A04.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a predefined exception is correctly propagated out of a
+ --      public child function to a client. 
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a public child subprogram.  Define the processing loop
+ --      inside the subprogram to expect a string with index starting at 1.
+ --      From the test procedure, call the child subprogram with a slice
+ --      from the middle of a string variable.  This will cause an exception
+ --      to be raised in the child and propagated to the caller.
+ --
+ --      Exception Type Raised:
+ --          User Defined
+ --        * Predefined  
+ --
+ --      Hierarchical Structure Employed For This Test:  
+ --        * Parent Package
+ --          Public Child Package
+ --          Private Child Package
+ --        * Public Child Subprogram
+ --          Private Child Subprogram
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --         FB40A00.A
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ 
+ -- Child subprogram Text_Parser.Count_AlphaNumerics 
+ 
+ function FB40A00.CB40A04_0 (Text : string) return Natural is
+ begin
+ 
+    for I in 1 .. Text'Last loop          -- Raise immediate Constraint_Error 
+       if (Text (I) in 'a'..'z') or       -- with String slice passed from
+          (Text (I) in 'A'..'Z') or       -- caller. (Slice'first /= 1)
+          (Text (I) in '0'..'9') then
+          Increment_AlphaNumeric_Count;
+       else
+          Increment_Non_AlphaNumeric_Count;
+       end if;
+    end loop;
+ 
+    return (AlphaNumeric_Count);          -- Global in parent package.
+ 
+    -- No exception handler here, exception propagates.
+ 
+ end FB40A00.CB40A04_0;
+ 
+ 
+      --=================================================================--
+ 
+ 
+ with FB40A00.CB40A04_0; -- Explicit "with" of Text_Parser.Count_AlphaNumerics
+ with Report;            -- Implicit "with" of Text_Parser.
+ 
+ procedure CB40A04 is
+ 
+    String_Var : String (1..19) := "The quick brown fox";
+ 
+    Number_Of_AlphaNumeric_Characters : Natural := 0;
+ 
+ begin
+ 
+    Report.Test ("CB40A04", "Check that a predefined exception is " &
+                            "correctly propagated out of a public " &
+                            "child function to a client");
+ 
+    Process_Block:
+    begin
+ 
+       Number_Of_AlphaNumeric_Characters :=       -- Provide slice of string
+         FB40A00.CB40A04_0 (String_Var (5..10));  -- to subprogram.
+                                                            
+       Report.Failed ("Exception should have been handled");
+ 
+    exception
+ 
+       when Constraint_Error =>                      -- Correct exception 
+          null;                                      -- propagation.
+ 
+       when others =>
+          Report.Failed ("Exception handled in an others handler");
+ 
+    end Process_Block;
+ 
+    Report.Result;
+ 
+ end CB40A04;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,213 ----
+ -- CB41001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the 'Identity attribute returns the unique identity of an
+ --      exception. Check that the Raise_Exception procedure can raise an 
+ --      exception that is specified through the use of the 'Identity attribute,
+ --      and that Reraise_Occurrence can re-raise an exception occurrence
+ --      using an exception choice parameter.
+ --
+ -- TEST DESCRIPTION:
+ --      This test uses the capability of the 'Identity attribute, which 
+ --      returns the unique identity of an exception, as an Exception_Id 
+ --      result.  This result is used as an input parameter to the procedure
+ --      Raise_Exception.  The exception that results is handled, propagated
+ --      using the Reraise_Occurrence procedure, and handled again.
+ --      The above actions are performed for both a user-defined and a
+ --      predefined exception.
+ --
+ --       
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      11 Nov 96   SAIC    ACVC 2.1: Modified Propagate_User_Exception.
+ --
+ --!
+ 
+ with Report;
+ with Ada.Exceptions;
+ 
+ procedure CB41001 is
+ 
+ begin
+ 
+    Report.Test ("CB41001", "Check that the 'Identity attribute returns " &
+                            "the unique identity of an exception. Check " &
+                            "that the 'Identity attribute is of type "    &
+                            "Exception_Id.  Check that the "              &
+                            "Raise_Exception procedure can raise an "     &
+                            "exception that is specified through the "    &
+                            "use of the 'Identity attribute");
+    Test_Block:
+    declare
+ 
+       Check_Points : constant := 5;
+ 
+       type Check_Point_Array_Type is array (1..Check_Points) of Boolean;
+ 
+       -- Global array used to track the processing path through the test.
+       TC_Check_Points : Check_Point_Array_Type := (others => False);
+ 
+       A_User_Defined_Exception  : Exception;
+       An_Exception_ID           : Ada.Exceptions.Exception_Id :=
+                                     Ada.Exceptions.Null_Id;
+ 
+       procedure Propagate_User_Exception is
+          Hidden_Exception : Exception;
+       begin
+          -- Use the 'Identity function to store the unique identity of a
+          -- user defined exception into a variable of type Exception_Id.
+ 
+          An_Exception_ID := A_User_Defined_Exception'Identity;
+ 
+          -- Raise this user defined exception using the result of the 
+          -- 'Identity attribute.
+ 
+          Ada.Exceptions.Raise_Exception(E => An_Exception_Id);
+ 
+          Report.Failed("User defined exception not raised by " &
+                        "procedure Propagate_User_Exception");
+ 
+       exception
+          when Proc_Excpt : A_User_Defined_Exception => -- Expected exception.
+             begin
+ 
+                -- By raising a different exception at this point, the 
+                -- information associated with A_User_Defined_Exception must
+                -- be correctly stacked internally.
+ 
+                Ada.Exceptions.Raise_Exception(Hidden_Exception'Identity);
+                Report.Failed("Hidden_Exception not raised by " &
+                              "procedure Propagate_User_Exception");
+             exception
+                when others => 
+                   TC_Check_Points(1) := True;
+ 
+                   -- Reraise the original exception, which will be propagated 
+                   -- outside the scope of this procedure.
+ 
+                   Ada.Exceptions.Reraise_Occurrence(Proc_Excpt);
+                   Report.Failed("User defined exception not reraised");
+ 
+             end;
+ 
+          when others =>
+             Report.Failed("Unexpected exception raised by " &
+                           "Procedure Propagate_User_Exception");
+       end Propagate_User_Exception;
+ 
+    begin
+ 
+       User_Exception_Block:
+       begin
+          -- Call procedure to raise, handle, and reraise a user defined 
+          -- exception.
+          Propagate_User_Exception;
+ 
+          Report.Failed("User defined exception not propagated from " &
+                        "procedure Propagate_User_Exception");
+ 
+       exception
+          when A_User_Defined_Exception => -- Expected exception.
+             TC_Check_Points(2) := True;
+          when others =>
+             Report.Failed
+               ("Unexpected exception handled in User_Exception_Block");
+       end User_Exception_Block;
+ 
+ 
+       Predefined_Exception_Block:
+       begin
+ 
+          Inner_Block:
+          begin
+ 
+             begin
+                -- Use the 'Identity attribute as an input parameter to the
+                -- Raise_Exception procedure.
+ 
+                Ada.Exceptions.Raise_Exception(Constraint_Error'Identity);
+                Report.Failed("Constraint_Error not raised in Inner_Block");
+ 
+             exception
+                when Excpt : Constraint_Error =>  -- Expected exception.
+                   TC_Check_Points(3) := True;
+ 
+                   -- Reraise the exception.
+                   Ada.Exceptions.Reraise_Occurrence(X => Excpt);
+                   Report.Failed("Predefined exception not raised from " &
+                                 "within the exception handler - 1");
+                when others => 
+                   Report.Failed("Incorrect result from attempt to raise " &
+                                 "Constraint_Error using the 'Identity "   &
+                                 "attribute - 1");
+             end;
+ 
+             Report.Failed("Constraint_Error not reraised in Inner_Block");
+ 
+          exception
+             when Block_Excpt : Constraint_Error =>  -- Expected exception.
+                TC_Check_Points(4) := True;
+ 
+                -- Reraise the exception in a scope where the exception
+                -- was not originally raised.
+ 
+                Ada.Exceptions.Reraise_Occurrence(X => Block_Excpt);
+                Report.Failed("Predefined exception not raised from " &
+                              "within the exception handler - 2");
+ 
+             when others => 
+                Report.Failed("Incorrect result from attempt to raise " &
+                              "Constraint_Error using the 'Identity "   &
+                              "attribute - 2");
+          end Inner_Block;
+ 
+          Report.Failed("Exception not propagated from Inner_Block");
+ 
+       exception
+          when Constraint_Error =>  -- Expected exception.
+             TC_Check_Points(5) := True;
+          when others => 
+             Report.Failed("Unexpected exception handled after second " &
+                           "reraise of Constraint_Error");
+       end Predefined_Exception_Block;
+ 
+ 
+       -- Verify the processing path taken through the test.
+ 
+       for i in 1..Check_Points loop
+          if not TC_Check_Points(i) then
+             Report.Failed("Incorrect processing path taken through test, " &
+                           "didn't pass check point #" & Integer'Image(i));
+          end if;
+       end loop;
+ 
+    exception
+       when others => Report.Failed ("Exception raised in Test_Block");
+    end Test_Block;
+ 
+    Report.Result;
+ 
+ end CB41001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,283 ----
+ -- CB41002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the message string input parameter in a call to the
+ --      Raise_Exception procedure is associated with the raised exception
+ --      occurrence, and that the message string can be obtained using the
+ --      Exception_Message function with the associated Exception_Occurrence
+ --      object.  Check that Function Exception_Information is available
+ --      to provide implementation-defined information about the exception
+ --      occurrence.
+ --
+ -- TEST DESCRIPTION:
+ --      This test checks that a message associated with a raised exception
+ --      is propagated with the exception, and can be retrieved using the
+ --      Exception_Message function.  The exception will be raised using the
+ --      'Identity attribute as a parameter to the Raise_Exception procedure,
+ --      and an associated message string will be provided.  The exception
+ --      will be handled, and the message associated with the occurrence will
+ --      be compared to the original source message (non-default).
+ --
+ --      The test also includes a simulated logging procedure
+ --      (Check_Exception_Information) that checks that Exception_Information
+ --      can be called.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      22 Jun 00   RLB     Added a check at Exception_Information can be
+ --                          called.
+ --
+ --!
+ 
+ with Report;
+ with Ada.Exceptions;
+ 
+ procedure CB41002 is
+ begin
+ 
+    Report.Test ("CB41002", "Check that the message string input parameter " &
+                            "in a call to the Raise_Exception procedure is " &
+                            "associated with the raised exception "          &
+                            "occurrence, and that the message string can "   &
+                            "be obtained using the Exception_Message "       &
+                            "function with the associated "                  &
+                            "Exception_Occurrence object. Also check that "  &
+                            "the Exception_Information function can be called");
+ 
+    Test_Block:
+    declare
+ 
+       Number_Of_Exceptions : constant := 3;
+ 
+       User_Exception_1,
+       User_Exception_2,
+       User_Exception_3 : exception;
+ 
+       type String_Ptr is access String;
+ 
+       User_Messages : constant array (1..Number_Of_Exceptions)
+         of String_Ptr :=
+         (new String'("Msg"),
+          new String'("This message will override the default "   &
+                      "message provided by the implementation"),
+          new String'("The message can be captured by procedure"  & -- 200 chars
+                       " Exception_Message.  It is designed to b" &
+                       "e exactly 200 characters in length, sinc" &
+                       "e there is a permission  concerning the " &
+                       "truncation of a message over 200 chars. "));
+ 
+       procedure Check_Exception_Information (
+                  Occur : in Ada.Exceptions.Exception_Occurrence) is
+           -- Simulates an error logging routine.
+          Info : constant String :=
+               Ada.Exceptions.Exception_Information (Occur);
+          function Is_Substring_of (Target, Search : in String) return Boolean is
+             -- Returns True if Search is a substring of Target, and False
+             -- otherwise.
+          begin
+             for I in Report.Ident_Int(Target'First) ..
+                      Target'Last - Search'Length + 1 loop
+                if Target(I .. I+Search'Length-1) = Search then
+                   return True;
+                end if;
+             end loop;
+             return False;
+          end Is_Substring_of;
+       begin
+          -- We can't display Info, as it often contains line breaks
+          -- (confusing Report), and might look much like the failure of a test
+          -- with an unhandled exception (thus confusing grading tools).
+          --
+          -- We don't particular care if the implementation advice is followed,
+          -- but we make these checks to insure that a compiler cannot optimize
+          -- away Info or the rest of this routine.
+          if not Is_Substring_of (Info,
+                        Ada.Exceptions.Exception_Name (Occur)) then
+              Report.Comment ("Exception_Information does not contain " &
+                              "Exception_Name - see 11.4.1(19)");
+          elsif not Is_Substring_of (Info,
+                        Ada.Exceptions.Exception_Message (Occur)) then
+              Report.Comment ("Exception_Information does not contain " &
+                              "Exception_Message - see 11.4.1(19)");
+          end if;
+       end Check_Exception_Information;
+ 
+    begin
+ 
+       for i in 1..Number_Of_Exceptions loop
+          begin
+ 
+             -- Raise a user-defined exception with a specific message string.
+             case i is
+                when 1 =>
+                   Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
+                                                  User_Messages(i).all);
+                when 2 =>
+                   Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
+                                                  User_Messages(i).all);
+                when 3 =>
+                   Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
+                                                  User_Messages(i).all);
+                when others =>
+                   Report.Failed("Incorrect result from Case statement");
+             end case;
+ 
+             Report.Failed
+               ("Exception not raised by procedure Exception_With_Message " &
+                "for User_Exception #" & Integer'Image(i));
+ 
+          exception
+             when Excptn : others =>
+ 
+                begin
+                   -- The message that is associated with the raising of each
+                   -- exception is captured here using the Exception_Message
+                   -- function.
+ 
+                   if User_Messages(i).all /=
+                      Ada.Exceptions.Exception_Message(Excptn)
+                   then
+                      Report.Failed
+                        ("Message captured from exception is not the "  &
+                         "message provided when the exception was raised, " &
+                         "User_Exception #" & Integer'Image(i));
+                   end if;
+ 
+                   Check_Exception_Information(Excptn);
+                end;
+          end;
+       end loop;
+ 
+ 
+ 
+       -- Verify that the exception specific message is carried across
+       -- various boundaries:
+ 
+       begin
+ 
+          begin
+             Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
+                                            User_Messages(1).all);
+             Report.Failed("User_Exception_1 not raised");
+          end;
+          Report.Failed("User_Exception_1 not propagated");
+       exception
+          when Excptn : User_Exception_1 =>
+ 
+             if User_Messages(1).all /=
+                Ada.Exceptions.Exception_Message(Excptn)
+             then
+                Report.Failed("User_Message_1 not found");
+             end if;
+             Check_Exception_Information(Excptn);
+ 
+          when others => Report.Failed("Unexpected exception handled - 1");
+       end;
+ 
+ 
+ 
+       begin
+ 
+          begin
+             Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
+                                            User_Messages(2).all);
+             Report.Failed("User_Exception_2 not raised");
+          exception
+             when Exc : User_Exception_2 =>
+ 
+                -- The exception is reraised here; message should propagate
+                -- with exception occurrence.
+ 
+                Ada.Exceptions.Reraise_Occurrence(Exc);
+             when others => Report.Failed("User_Exception_2 not handled");
+          end;
+          Report.Failed("User_Exception_2 not propagated");
+       exception
+          when Excptn : User_Exception_2 =>
+ 
+             if User_Messages(2).all /=
+                Ada.Exceptions.Exception_Message(Excptn)
+             then
+                Report.Failed("User_Message_2 not found");
+             end if;
+             Check_Exception_Information(Excptn);
+ 
+          when others => Report.Failed("Unexpected exception handled - 2");
+       end;
+ 
+ 
+       -- Check exception and message propagation across task boundaries.
+ 
+       declare
+ 
+          task Raise_An_Exception is  -- single task
+             entry Raise_It;
+          end Raise_An_Exception;
+ 
+          task body Raise_An_Exception is
+          begin
+             accept Raise_It do
+                Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
+                                               User_Messages(3).all);
+             end Raise_It;
+             Report.Failed("User_Exception_3 not raised");
+          exception
+             when Excptn : User_Exception_3 =>
+                if User_Messages(3).all /=
+                   Ada.Exceptions.Exception_Message(Excptn)
+                then
+                   Report.Failed
+                     ("User_Message_3 not returned inside task body");
+                end if;
+                Check_Exception_Information(Excptn);
+             when others =>
+                Report.Failed("Incorrect exception raised in task body");
+          end Raise_An_Exception;
+ 
+       begin
+          Raise_An_Exception.Raise_It;  -- Exception will be propagated here.
+          Report.Failed("User_Exception_3 not propagated to caller");
+       exception
+          when Excptn : User_Exception_3 =>
+             if User_Messages(3).all /=
+                Ada.Exceptions.Exception_Message(Excptn)
+             then
+                Report.Failed("User_Message_3 not returned to caller of task");
+             end if;
+             Check_Exception_Information(Excptn);
+          when others =>
+             Report.Failed("Incorrect exception raised by task");
+       end;
+ 
+ 
+    exception
+       when others => Report.Failed ("Exception raised in Test_Block");
+    end Test_Block;
+ 
+    Report.Result;
+ 
+ end CB41002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,358 ----
+ -- CB41003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an exception occurrence can be saved into an object of
+ --      type Exception_Occurrence using the procedure Save_Occurrence.
+ --      Check that a saved exception occurrence can be used to reraise 
+ --      another occurrence of the same exception using the procedure
+ --      Reraise_Occurrence.  Check that the function Save_Occurrence will
+ --      allocate a new object of type Exception_Occurrence_Access, and saves
+ --      the source exception to the new object which is returned as the 
+ --      function result.
+ --
+ -- TEST DESCRIPTION:
+ --      This test verifies that an occurrence of an exception can be saved,
+ --      using either of two overloaded versions of Save_Occurrence.  The
+ --      procedure version of Save_Occurrence is used to save an occurrence
+ --      of a user defined exception into an object of type 
+ --      Exception_Occurrence.  This object is then used as an input 
+ --      parameter to procedure Reraise_Occurrence, the expected exception is
+ --      handled, and the exception id of the handled exception is compared
+ --      to the id of the originally raised exception.
+ --      The function version of Save_Occurrence returns a result of 
+ --      Exception_Occurrence_Access, and is used to store the value of another
+ --      occurrence of the user defined exception.  The resulting access value
+ --      is dereferenced and used as an input to Reraise_Occurrence.  The
+ --      resulting exception is handled, and the exception id of the handled 
+ --      exception is compared to the id of the originally raised exception.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with Report;
+ with Ada.Exceptions;
+ 
+ procedure CB41003 is
+ 
+ begin
+ 
+    Report.Test ("CB41003", "Check that an exception occurrence can "   &
+                            "be saved into an object of type "          &
+                            "Exception_Occurrence using the procedure " &
+                            "Save_Occurrence");
+ 
+    Test_Block:
+    declare
+ 
+       use Ada.Exceptions;
+ 
+       User_Exception_1,
+       User_Exception_2   : Exception;
+ 
+       Saved_Occurrence   : Exception_Occurrence;
+       Occurrence_Ptr     : Exception_Occurrence_Access;
+ 
+       User_Message       : constant String :=   -- 200 character string.
+         "The string returned by Exception_Message may be tr" &
+         "uncated (to no less then 200 characters) by the Sa" &
+         "ve_Occurrence procedure (not the function), the Re" &
+         "raise_Occurrence proc, and the re-raise statement.";
+ 
+    begin
+ 
+       Raise_And_Save_Block_1 :
+       begin
+ 
+          -- This nested exception structure is designed to ensure that the
+          -- appropriate exception occurrence is saved using the 
+          -- Save_Occurrence procedure.
+ 
+          raise Program_Error;
+          Report.Failed("Program_Error not raised");
+ 
+       exception
+          when Program_Error => 
+ 
+             begin
+                -- Use the procedure Raise_Exception, along with the 'Identity
+                -- attribute to raise the first user defined exception.  Note
+                -- that a 200 character message is included in the call.
+ 
+                Raise_Exception(User_Exception_1'Identity, User_Message);
+                Report.Failed("User_Exception_1 not raised");
+ 
+             exception
+                when Exc : User_Exception_1 => 
+ 
+                   -- This exception occurrence is saved into a variable using
+                   -- procedure Save_Occurrence.  This saved occurrence should
+                   -- not be confused with the raised occurrence of 
+                   -- Program_Error above.
+ 
+                   Save_Occurrence(Target => Saved_Occurrence, Source => Exc);
+ 
+                when others => 
+                   Report.Failed("Unexpected exception handled, expecting " &
+                                 "User_Exception_1");
+             end;
+ 
+          when others => 
+             Report.Failed("Incorrect exception generated by raise statement");
+ 
+       end Raise_And_Save_Block_1;
+ 
+ 
+       Reraise_And_Handle_Saved_Exception_1 :
+       begin
+          -- Reraise the exception that was saved in the previous block.
+ 
+          Reraise_Occurrence(X => Saved_Occurrence);
+ 
+       exception
+          when Exc : User_Exception_1 => -- Expected exception.
+             -- Check the exception id of the handled id by using the 
+             -- Exception_Identity function, and compare with the id of the
+             -- originally raised exception.
+ 
+             if User_Exception_1'Identity /= Exception_Identity(Exc) then
+                Report.Failed("Exception_Ids do not match - 1");
+             end if;
+ 
+             -- Check that the message associated with this exception occurrence
+             -- has not been truncated (it was originally 200 characters).
+ 
+             if User_Message /= Exception_Message(Exc) then
+                Report.Failed("Exception messages do not match - 1");
+             end if;
+ 
+          when others => 
+             Report.Failed
+               ("Incorrect exception raised by Reraise_Occurrence - 1");
+       end Reraise_And_Handle_Saved_Exception_1;
+ 
+ 
+       Raise_And_Save_Block_2 :
+       begin
+ 
+          Raise_Exception(User_Exception_2'Identity, User_Message);
+          Report.Failed("User_Exception_2 not raised");
+ 
+       exception
+          when Exc : User_Exception_2 => 
+ 
+             -- This exception occurrence is saved into an access object 
+             -- using function Save_Occurrence.
+ 
+             Occurrence_Ptr := Save_Occurrence(Source => Exc);
+ 
+          when others => 
+             Report.Failed("Unexpected exception handled, expecting " &
+                           "User_Exception_2");
+       end Raise_And_Save_Block_2;
+ 
+ 
+       Reraise_And_Handle_Saved_Exception_2 :
+       begin
+          -- Reraise the exception that was saved in the previous block.
+          -- Dereference the access object for use as input parameter.
+ 
+          Reraise_Occurrence(X => Occurrence_Ptr.all);
+ 
+       exception
+          when Exc : User_Exception_2 => -- Expected exception.
+             -- Check the exception id of the handled id by using the 
+             -- Exception_Identity function, and compare with the id of the
+             -- originally raised exception.
+ 
+             if User_Exception_2'Identity /= Exception_Identity(Exc) then
+                Report.Failed("Exception_Ids do not match - 2");
+             end if;
+ 
+             -- Check that the message associated with this exception occurrence
+             -- has not been truncated (it was originally 200 characters).
+ 
+             if User_Message /= Exception_Message(Exc) then
+                Report.Failed("Exception messages do not match - 2");
+             end if;
+ 
+          when others => 
+             Report.Failed
+               ("Incorrect exception raised by Reraise_Occurrence - 2");
+        end Reraise_And_Handle_Saved_Exception_2;
+ 
+ 
+        -- Another example of the use of saving an exception occurrence
+        -- is demonstrated in the following block, where the ability to 
+        -- save an occurrence into a data structure, for later processing,
+        -- is modeled.
+ 
+        Store_And_Handle_Block:
+        declare
+           
+           Exc_Number  : constant := 3;
+           Exception_1, 
+           Exception_2, 
+           Exception_3 : exception;
+ 
+           Exception_Storage : array (1..Exc_Number) of Exception_Occurrence;
+           Messages          : array (1..Exc_Number) of String(1..9) :=
+                                 ("Message 1", "Message 2", "Message 3");
+ 
+        begin
+ 
+           Outer_Block:
+           begin
+ 
+              Inner_Block:
+              begin
+ 
+                 for i in 1..Exc_Number loop
+                    begin
+ 
+                       begin
+                          -- Exceptions all raised in a deep scope.
+                          if i = 1 then
+                             Raise_Exception(Exception_1'Identity, Messages(i));
+                          elsif i = 2 then
+                             Raise_Exception(Exception_2'Identity, Messages(i));
+                          elsif i = 3 then
+                             Raise_Exception(Exception_3'Identity, Messages(i));
+                          end if;
+                          Report.Failed("Exception not raised on loop #" &
+                                        Integer'Image(i));
+                       end;
+                       Report.Failed("Exception not propagated on loop #" &
+                                     Integer'Image(i));
+                    exception
+                       when Exc : others =>
+ 
+                          -- Save each occurrence into a storage array for 
+                          -- later processing.
+ 
+                          Save_Occurrence(Exception_Storage(i), Exc);
+                    end;
+                 end loop;
+ 
+              end Inner_Block;
+           end Outer_Block;
+ 
+           -- Raise the exceptions from the stored occurrences, and handle.
+ 
+           for i in 1..Exc_Number loop
+              begin
+                 Reraise_Occurrence(Exception_Storage(i));
+                 Report.Failed("No exception reraised for " &
+                               "exception #" & Integer'Image(i));
+              exception
+                 when Exc   : others =>
+                    -- The following sequence of checks ensures that the 
+                    -- correct occurrence was stored, and the associated
+                    -- exception was raised and handled in the proper order.
+                    if i = 1 then
+                       if Exception_1'Identity /= Exception_Identity(Exc) then
+                          Report.Failed("Exception_1 not raised");
+                       end if;
+                    elsif i = 2 then
+                       if Exception_2'Identity /= Exception_Identity(Exc) then
+                          Report.Failed("Exception_2 not raised");
+                       end if;
+                    elsif i = 3 then
+                       if Exception_3'Identity /= Exception_Identity(Exc) then
+                          Report.Failed("Exception_3 not raised");
+                       end if;
+                    end if;
+ 
+                    if Exception_Message(Exc) /= Messages(i) then
+                       Report.Failed("Incorrect message associated with " &
+                                     "exception #" & Integer'Image(i));
+                    end if;
+              end;
+           end loop;
+        exception
+           when others => 
+             Report.Failed("Unexpected exception in Store_And_Handle_Block");
+        end Store_And_Handle_Block;
+ 
+ 
+       Reraise_Out_Of_Scope:
+       declare
+ 
+          TC_Value      : constant := 5;
+          The_Exception : exception;
+          Saved_Exc_Occ : Exception_Occurrence;
+ 
+          procedure Handle_It (Exc_Occ : in Exception_Occurrence) is
+             Must_Be_Raised : exception;
+          begin
+             if Exception_Identity(Exc_Occ) = The_Exception'Identity then
+                raise Must_Be_Raised;
+                Report.Failed("Exception Must_Be_Raised was not raised");
+             else
+                Report.Failed("Incorrect exception handled in " &
+                              "Procedure Handle_It");
+             end if;
+          end Handle_It;
+ 
+       begin
+ 
+          if Report.Ident_Int(5) = TC_Value then
+             raise The_Exception;
+          end if;
+ 
+       exception
+          when Exc : others => 
+             Save_Occurrence (Saved_Exc_Occ, Exc);
+             begin
+                Handle_It(Saved_Exc_Occ);   -- Raise another exception, in a
+             exception                      -- different scope.
+                when others =>              -- Handle this new exception.
+                   begin
+                      Reraise_Occurrence (Saved_Exc_Occ);  -- Reraise the
+                                                           -- original excptn.
+                      Report.Failed("Saved Exception was not raised");
+                   exception                               
+                      when Exc_2 : others =>
+                         if Exception_Identity (Exc_2) /= 
+                            The_Exception'Identity 
+                         then
+                            Report.Failed
+                              ("Incorrect exception occurrence reraised");
+                         end if;
+                   end;
+             end;
+       end Reraise_Out_Of_Scope;
+ 
+ 
+    exception
+       when others => Report.Failed ("Exception raised in Test_Block");
+    end Test_Block;
+ 
+    Report.Result;
+ 
+ end CB41003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb41004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb41004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,324 ----
+ -- CB41004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that Raise_Exception and Reraise_Occurrence have no effect in
+ --      the case of Null_Id or Null_Occurrence.  Check that Exception_Message,
+ --      Exception_Identity, Exception_Name, and Exception_Information raise
+ --      Constraint_Error for a Null_Occurrence input parameter.
+ --      Check that calling the Save_Occurrence subprograms with the
+ --      Null_Occurrence input parameter saves the Null_Occurrence to the
+ --      appropriate target object, and does not raise Constraint_Error.
+ --      Check that Null_Id is the default initial value of type Exception_Id.
+ --
+ -- TEST DESCRIPTION:
+ --      This test performs a series of calls to many of the subprograms
+ --      defined in package Ada.Exceptions, using either Null_Id or
+ --      Null_Occurrence (based on their parameter profile).  In the cases of
+ --      Raise_Exception and Reraise_Occurrence, these null input values
+ --      should result in no exceptions being raised, and Constraint_Error
+ --      should not be raised in response to these calls.  Test failure will
+ --      result if any exception is raised in these cases.
+ --      For the Save_Occurrence subprograms, calling them with the
+ --      Null_Occurrence input parameter does not raise Constraint_Error, but
+ --      simply results in the Null_Occurrence being saved into the appropriate
+ --      target (either a Exception_Occurrence out parameter, or as an
+ --      Exception_Occurrence_Access value).
+ --      In the cases of the other mentioned subprograms, calls performed with
+ --      a Null_Occurrence input parameter must result in Constraint_Error
+ --      being raised.  This exception will be handled, with test failure the
+ --      result if the exception is not raised.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      08 Dec 00   RLB     Removed Exception_Identity subtest, pending
+ --                          resolution of AI95-00241.
+ --      29 Mar 07   RLB     Replaced Exception_Identity subtest, repaired
+ --                          Raise_Exception subtest for AI95-00446.
+ --!
+ 
+ with Report;
+ with Ada.Exceptions;
+ 
+ procedure CB41004 is
+ begin
+ 
+    Report.Test ("CB41004", "Check that Null_Id and Null_Occurrence input " &
+                            "parameters have the appropriate effect when "  &
+                            "used in calls of the subprograms found in "    &
+                            "package Ada.Exceptions");
+ 
+    Test_Block:
+    declare
+ 
+       use Ada.Exceptions;
+ 
+       -- No initial values given for these two declarations; they default
+       -- to Null_Id and Null_Occurrence respectively.
+       A_Null_Exception_Id         : Ada.Exceptions.Exception_Id;
+       A_Null_Exception_Occurrence : Ada.Exceptions.Exception_Occurrence;
+ 
+       TC_Flag : Boolean := False;
+ 
+    begin
+ 
+       -- Verify that Null_Id is the default initial value of type
+       -- Exception_Id.
+ 
+       if not (A_Null_Exception_Id = Ada.Exceptions.Null_Id) then
+          Report.Failed("The default initial value of an object of type " &
+                        "Exception_Id was not Null_Id");
+       end if;
+ 
+ 
+       -- Verify that Raise_Exception has no effect in the case of Null_Id.
+       -- Modified by AI-446.
+       begin
+          Ada.Exceptions.Raise_Exception(A_Null_Exception_Id);
+          Report.Comment(
+            "No exception raised by procedure Raise_Exception " &
+            "when called with a Null_Id input parameter - compatible with " &
+            "original Ada95");
+       exception
+          when Constraint_Error => null; -- OK, expected exception.
+             Report.Comment(
+                "Constraint_Error exception raised by procedure Raise_Exception " &
+                "when called with a Null_Id input parameter - compatible with " &
+                "AI95-00446");
+          when others =>
+             Report.Failed(
+                "Unexpected exception raised by procedure Raise_Exception " &
+                "when called with a Null_Id input parameter");
+       end;
+ 
+       TC_Flag := False;
+ 
+ 
+       -- Verify that Reraise_Occurrence has no effect in the case of
+       -- Null_Occurrence.
+       begin
+          Ada.Exceptions.Reraise_Occurrence(A_Null_Exception_Occurrence);
+          TC_Flag := True;
+       exception
+          when others =>
+             Report.Failed
+               ("Exception raised by procedure Reraise_Occurrence " &
+                "when called with a Null_Occurrence input parameter");
+       end;
+ 
+       if not TC_Flag then
+          Report.Failed("Incorrect processing following the call to " &
+                        "Reraise_Occurrence with a Null_Occurrence "  &
+                        "input parameter");
+       end if;
+ 
+ 
+       -- Verify that function Exception_Message raises Constraint_Error for
+       -- a Null_Occurrence input parameter.
+       begin
+          declare
+             Msg : constant String :=
+               Ada.Exceptions.Exception_Message(A_Null_Exception_Occurrence);
+          begin
+             Report.Failed
+               ("Constraint_Error not raised by Function Exception_Message " &
+                "when called with a Null_Occurrence input parameter");
+          end;
+       exception
+          when Constraint_Error => null; -- OK, expected exception.
+          when others =>
+             Report.Failed
+               ("Unexpected exception raised by Function Exception_Message " &
+                "when called with a Null_Occurrence input parameter");
+       end;
+ 
+ 
+       -- Verify that function Exception_Identity raises Constraint_Error for
+       -- a Null_Occurrence input parameter.
+       -- Modified by AI-241.
+       begin
+          declare
+             Id : Ada.Exceptions.Exception_Id :=
+               Ada.Exceptions.Exception_Identity(A_Null_Exception_Occurrence);
+          begin
+             Report.Comment
+               ("No exception raised by Function Exception_Identity " &
+                "when called with a Null_Occurrence input parameter - " &
+                "compatible with AI95-00241.");
+          end;
+       exception
+          when Constraint_Error =>
+             Report.Comment
+               ("Constraint_Error raised by Function Exception_Identity " &
+                "when called with a Null_Occurrence input parameter - " &
+                "compatible with original Ada95.");
+          when others =>
+             Report.Failed
+               ("Unexpected exception raised by Function Exception_Identity " &
+                "when called with a Null_Occurrence input parameter");
+       end;
+ 
+ 
+       -- Verify that function Exception_Name raises Constraint_Error for
+       -- a Null_Occurrence input parameter.
+       begin
+          declare
+             Name : constant String :=
+               Ada.Exceptions.Exception_Name(A_Null_Exception_Occurrence);
+          begin
+             Report.Failed
+               ("Constraint_Error not raised by Function Exception_Name " &
+                "when called with a Null_Occurrence input parameter");
+          end;
+       exception
+          when Constraint_Error => null; -- OK, expected exception.
+          when others =>
+             Report.Failed
+               ("Unexpected exception raised by Function Exception_Null " &
+                "when called with a Null_Occurrence input parameter");
+       end;
+ 
+ 
+       -- Verify that function Exception_Information raises Constraint_Error
+       -- for a Null_Occurrence input parameter.
+       begin
+          declare
+             Info : constant String :=
+               Ada.Exceptions.Exception_Information
+                                (A_Null_Exception_Occurrence);
+          begin
+             Report.Failed
+               ("Constraint_Error not raised by Function "  &
+                "Exception_Information when called with a " &
+                "Null_Occurrence input parameter");
+          end;
+       exception
+          when Constraint_Error => null; -- OK, expected exception.
+          when others =>
+             Report.Failed
+               ("Unexpected exception raised by Function Exception_Null " &
+                "when called with a Null_Occurrence input parameter");
+       end;
+ 
+ 
+       -- Verify that calling the Save_Occurrence procedure with a
+       -- Null_Occurrence input parameter saves the Null_Occurrence to the
+       -- target object, and does not raise Constraint_Error.
+       declare
+          use Ada.Exceptions;
+          Saved_Occurrence : Exception_Occurrence;
+       begin
+ 
+          -- Initialize the Saved_Occurrence variable with a value other than
+          -- Null_Occurrence (default).
+          begin
+             raise Program_Error;
+          exception
+             when Exc : others => Save_Occurrence(Saved_Occurrence, Exc);
+          end;
+ 
+          -- Save a Null_Occurrence input parameter.
+          begin
+             Save_Occurrence(Target => Saved_Occurrence,
+                             Source => Ada.Exceptions.Null_Occurrence);
+          exception
+             when others =>
+                Report.Failed
+                  ("Unexpected exception raised by procedure "           &
+                   "Save_Occurrence when called with a Null_Occurrence " &
+                   "input parameter");
+          end;
+ 
+          -- Verify that the occurrence that was saved above is a
+          -- Null_Occurrence value.
+ 
+          begin
+             Reraise_Occurrence(Saved_Occurrence);
+          exception
+             when others =>
+                Report.Failed("Value saved from Procedure Save_Occurrence " &
+                              "resulted in an exception, i.e., was not a "  &
+                              "value of Null_Occurrence");
+          end;
+ 
+       exception
+          when others =>
+             Report.Failed("Unexpected exception raised during evaluation " &
+                           "of Procedure Save_Occurrence");
+       end;
+ 
+ 
+       -- Verify that calling the Save_Occurrence function with a
+       -- Null_Occurrence input parameter returns the Null_Occurrence as the
+       -- function result, and does not raise Constraint_Error.
+       declare
+          Occurrence_Ptr : Ada.Exceptions.Exception_Occurrence_Access;
+       begin
+          -- Save a Null_Occurrence input parameter.
+          begin
+             Occurrence_Ptr :=
+               Ada.Exceptions.Save_Occurrence(Ada.Exceptions.Null_Occurrence);
+          exception
+             when others =>
+                Report.Failed
+                  ("Unexpected exception raised by function "            &
+                   "Save_Occurrence when called with a Null_Occurrence " &
+                   "input parameter");
+          end;
+ 
+          -- Verify that the occurrence that was saved above is a
+          -- Null_Occurrence value.
+ 
+          begin
+             -- Dereferenced value of type Exception_Occurrence_Access
+             -- should be a Null_Occurrence value, based on the action
+             -- of Function Save_Occurrence above.  Providing this as an
+             -- input parameter to Reraise_Exception should not result in
+             -- any exception being raised.
+ 
+             Ada.Exceptions.Reraise_Occurrence(Occurrence_Ptr.all);
+ 
+          exception
+             when others =>
+                Report.Failed("Value saved from Function Save_Occurrence " &
+                              "resulted in an exception, i.e., was not a "  &
+                              "value of Null_Occurrence");
+          end;
+       exception
+          when others =>
+             Report.Failed("Unexpected exception raised during evaluation " &
+                           "of Function Save_Occurrence");
+       end;
+ 
+ 
+ 
+    exception
+       when others => Report.Failed ("Exception raised in Test_Block");
+    end Test_Block;
+ 
+    Report.Result;
+ 
+ end CB41004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb5001a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb5001a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb5001a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb5001a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- CB5001A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXCEPTION RAISED IN A RENDEVOUS IS PROPAGATED BOTH TO
+ -- THE CALLER AND TO THE CALLED TASK.
+ 
+ -- THIS VERSION CHECKS THAT THE EXCEPTION IS PROPAGATED THROUGH ONE
+ -- LEVEL OF RENDEVOUS.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- JEAN-PIERRE ROSEN 09 MARCH 1984
+ -- JBG 6/1/84
+ -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CB5001A IS
+ 
+ BEGIN
+ 
+      TEST("CB5001A", "CHECK THAT AN EXCEPTION IN A RENDEVOUS IS " &
+                      "PROPAGATED TO CALLER AND CALLED TASKS -- ONE " &
+                      "LEVEL");
+ 
+      DECLARE
+           TASK T2 IS
+                ENTRY E2;
+           END T2;
+      
+           TASK BODY T2 IS
+                MY_EXCEPTION: EXCEPTION;
+           BEGIN
+                ACCEPT E2 DO 
+                     IF EQUAL (1,1) THEN
+                          RAISE MY_EXCEPTION; 
+                     END IF;
+                END E2;
+                FAILED ("T2: EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN MY_EXCEPTION => 
+                     NULL;
+                WHEN TASKING_ERROR =>
+                     FAILED ("TASKING_ERROR RAISED IN T2");
+                WHEN OTHERS =>
+                     FAILED ("T2 RECEIVED ABNORMAL EXCEPTION");
+           END T2;
+      
+      BEGIN 
+           T2.E2;
+           FAILED ("MAIN: EXCEPTION NOT RAISED");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR | PROGRAM_ERROR | STORAGE_ERROR =>
+                FAILED ("PREDEFINED ERROR RAISED IN MAIN");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED IN MAIN");
+           WHEN OTHERS => 
+                NULL;
+      END;
+ 
+      RESULT;
+ 
+ END CB5001A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb5001b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb5001b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb5001b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb5001b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,106 ----
+ -- CB5001B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN EXCEPTION RAISED IN A RENDEVOUS IS PROPAGATED BOTH TO
+ -- THE CALLER AND TO THE CALLED TASK.
+ 
+ -- THIS VERSION CHECKS THAT THE EXCEPTION IS PROPAGATED THROUGH TWO
+ -- LEVELS OF RENDEVOUS.
+ 
+ -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+ -- ***       remove incompatibilities associated with the transition   -- 9X
+ -- ***       to Ada 9X.                                                -- 9X
+ -- ***                                                                 -- 9X
+ 
+ -- JEAN-PIERRE ROSEN 09 MARCH 1984
+ -- JBG 6/1/84
+ -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CB5001B IS
+ 
+ BEGIN
+ 
+      TEST("CB5001B", "CHECK THAT AN EXCEPTION IN A RENDEVOUS IS " &
+                      "PROPAGATED TO CALLER AND CALLED TASKS -- TWO " &
+                      "LEVELS");
+ 
+      DECLARE
+           TASK T1 IS
+                ENTRY E1;
+           END T1;
+      
+           TASK T2 IS
+                ENTRY E2;
+           END T2;
+      
+           TASK BODY T1 IS
+           BEGIN
+                ACCEPT E1 DO 
+                     T2.E2; 
+                END E1;
+                FAILED ("T1: EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR | PROGRAM_ERROR =>
+                     FAILED ("PREDEFINED EXCEPTION RAISED IN T1");
+                WHEN TASKING_ERROR =>
+                     FAILED ("TASKING_ERROR RAISED IN T1");
+                WHEN OTHERS => 
+                     NULL;
+           END T1;
+      
+           TASK BODY T2 IS
+                MY_EXCEPTION: EXCEPTION;
+           BEGIN
+                ACCEPT E2 DO 
+                     IF EQUAL (1,1) THEN
+                          RAISE MY_EXCEPTION; 
+                     END IF;
+                END E2;
+                FAILED ("T2: EXCEPTION NOT RAISED");
+           EXCEPTION
+                WHEN MY_EXCEPTION => 
+                     NULL;
+                WHEN TASKING_ERROR =>
+                     FAILED ("TASKING_ERROR RAISED IN T2");
+                WHEN OTHERS =>
+                     FAILED ("T2 RECEIVED ABNORMAL EXCEPTION");
+           END T2;
+      
+      BEGIN 
+           T1.E1;
+           FAILED ("MAIN: EXCEPTION NOT RAISED");
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR | PROGRAM_ERROR =>
+                FAILED ("PREDEFINED ERROR RAISED IN MAIN");
+           WHEN TASKING_ERROR =>
+                FAILED ("TASKING_ERROR RAISED IN MAIN");
+           WHEN OTHERS => 
+                NULL;
+      END;
+ 
+      RESULT;
+ 
+ END CB5001B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb5002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb5002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cb/cb5002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cb/cb5002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,168 ----
+ -- CB5002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WHEN "TASKING_ERROR" IS RAISED EXPLICITLY OR BY
+ --     PROPAGATION WITHIN AN ACCEPT STATEMENT, THEN "TASKING_ERROR"
+ --     IS RAISED IN BOTH THE CALLING AND THE CALLED TASK.
+ 
+ -- HISTORY:
+ --     DHH 03/31/88 CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CB5002A IS
+ 
+ BEGIN
+      TEST("CB5002A", "CHECK THAT WHEN ""TASKING_ERROR"" IS RAISED " &
+                      "EXPLICITLY OR BY PROPAGATION WITHIN AN ACCEPT " &
+                      "STATEMENT, THEN ""TASKING_ERROR"" IS RAISED " &
+                      "IN BOTH THE CALLING AND THE CALLED TASK");
+ 
+      DECLARE
+           TASK CALLING_EXP IS
+                ENTRY A;
+           END CALLING_EXP;
+ 
+           TASK CALLED_EXP IS
+                ENTRY B;
+                ENTRY STOP;
+           END CALLED_EXP;
+ 
+           TASK CALLING_PROP IS
+                ENTRY C;
+           END CALLING_PROP;
+ 
+           TASK CALLED_PROP IS
+                ENTRY D;
+                ENTRY STOP;
+           END CALLED_PROP;
+ 
+           TASK PROP IS
+                ENTRY E;
+                ENTRY STOP;
+           END PROP;
+ -----------------------------------------------------------------------
+           TASK BODY CALLING_EXP IS
+           BEGIN
+                ACCEPT A DO
+                     BEGIN
+                          CALLED_EXP.B;
+                          FAILED("EXCEPTION NOT RAISED IN CALLING " &
+                                 "TASK - EXPLICIT RAISE");
+                     EXCEPTION
+                          WHEN TASKING_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("WRONG EXCEPTION RAISED IN " &
+                                      "CALLING TASK - EXPLICIT RAISE");
+                     END; -- EXCEPTION
+                END A;
+           END CALLING_EXP;
+ 
+           TASK BODY CALLED_EXP IS
+           BEGIN
+                BEGIN
+                     ACCEPT B DO
+                          RAISE TASKING_ERROR;
+                          FAILED("EXCEPTION NOT RAISED IN CALLED " &
+                                 "TASK - EXPLICIT RAISE");
+                     END B;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("WRONG EXCEPTION RAISED IN CALLED " &
+                                 "TASK - EXPLICIT RAISE");
+                END;  -- EXCEPTION BLOCK
+ 
+                ACCEPT STOP;
+           END CALLED_EXP;
+ 
+ -----------------------------------------------------------------------
+           TASK BODY CALLING_PROP IS
+           BEGIN
+                ACCEPT C DO
+                     BEGIN
+                          CALLED_PROP.D;
+                          FAILED("EXCEPTION NOT RAISED IN CALLING " &
+                                 "TASK - PROPAGATED RAISE");
+                     EXCEPTION
+                          WHEN TASKING_ERROR =>
+                               NULL;
+                          WHEN OTHERS =>
+                               FAILED("WRONG EXCEPTION RAISED IN " &
+                                      "CALLING TASK - PROPAGATED RAISE");
+                     END;  -- EXCEPTION
+                END C;
+           END CALLING_PROP;
+ 
+           TASK BODY CALLED_PROP IS
+           BEGIN
+                BEGIN
+                     ACCEPT D DO
+                          PROP.E;
+                          FAILED("EXCEPTION NOT RAISED IN CALLED " &
+                                 "TASK - PROPAGATED RAISE");
+                     END D;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("WRONG EXCEPTION RAISED IN CALLED " &
+                                 "TASK - PROPAGATED RAISE");
+                END;  -- EXCEPTION BLOCK;
+ 
+                ACCEPT STOP;
+           END CALLED_PROP;
+ 
+           TASK BODY PROP IS
+           BEGIN
+                BEGIN
+                     ACCEPT E DO
+                          RAISE TASKING_ERROR;
+                          FAILED("EXCEPTION NOT RAISED IN PROPAGATE " &
+                                 "TASK - ACCEPT E");
+                     END E;
+                EXCEPTION
+                     WHEN TASKING_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED("WRONG EXCEPTION RAISED IN PROP. TASK");
+               END;    -- EXCEPTION BLOCK
+ 
+               ACCEPT STOP;
+ 
+           END PROP;
+ -----------------------------------------------------------------------
+      BEGIN
+           CALLING_EXP.A;
+           CALLING_PROP.C;
+           CALLED_EXP.STOP;
+           CALLED_PROP.STOP;
+           PROP.STOP;
+ 
+      END;    -- DECLARE
+ 
+      RESULT;
+ END CB5002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,108 ----
+ -- CC1004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE ELABORATION OF A GENERIC DECLARATION
+ --     DOES NOT ELABORATE THE SUBPROGRAM OR PACKAGE SPECIFICATION.
+ 
+ -- HISTORY:
+ --     DAT 07/31/81  CREATED ORIGINAL TEST.
+ --     SPS 10/18/82
+ --     SPS 02/09/83
+ --     JET 01/07/88  UPDATED HEADER FORMAT AND ADDED CODE TO
+ --                   PREVENT OPTIMIZATION.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1004A IS
+ BEGIN
+      TEST ("CC1004A", "THE SPECIFICATION PART OF A GENERIC " &
+                       "SUBPROGRAM IS NOT ELABORATED AT THE " &
+                       "ELABORATION OF THE DECLARATION");
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE I1 IS INTEGER RANGE 1 .. 1;
+ 
+                GENERIC
+                PROCEDURE PROC (P1: I1 := IDENT_INT(2));
+ 
+                PROCEDURE PROC (P1: I1 := IDENT_INT(2)) IS
+                BEGIN
+                     IF NOT EQUAL (P1,P1) THEN
+                          COMMENT ("DON'T OPTIMIZE THIS");
+                     END IF;
+                END PROC;
+           BEGIN
+                BEGIN
+                     DECLARE
+                          PROCEDURE P IS NEW PROC;
+                     BEGIN
+                          IF NOT EQUAL(3,3) THEN
+                               P(1);
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("INSTANTIATION ELABORATES SPEC");
+                END;
+ 
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("DECL ELABORATED SPEC PART - 1");
+      END;
+ 
+      BEGIN
+           DECLARE
+                SUBTYPE I1 IS INTEGER RANGE 1 .. 1;
+ 
+                GENERIC
+                PACKAGE PKG IS
+                     X : INTEGER := I1(IDENT_INT(2));
+                END PKG;
+           BEGIN
+                BEGIN
+                     DECLARE
+                          PACKAGE P IS NEW PKG;
+                     BEGIN
+                          FAILED ("PACKAGE INSTANTIATION FAILED");
+                          IF NOT EQUAL(P.X,P.X) THEN
+                               COMMENT("DON'T OPTIMIZE THIS");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR => NULL;
+                     WHEN OTHERS => FAILED ("WRONG EXCEPTION - 2");
+                END;
+ 
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("DECL ELABORATED SPEC PART - 2");
+      END;
+ 
+      RESULT;
+ 
+ END CC1004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1005b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1005b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1005b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1005b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- CC1005B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A GENERIC UNIT'S IDENTIFIER CAN BE USED IN ITS
+ --     FORMAL PART:
+ --
+ --     (A) AS THE SELECTOR IN AN EXPANDED NAME TO DENOTE AN ENTITY IN THE
+ --         VISIBLE PART OF A PACKAGE, OR TO DENOTE AN ENTITY IMMEDIATELY
+ --         ENCLOSED IN A CONSTRUCT OTHER THAN THE CONSTRUCT IMMEDIATELY
+ --         ENCLOSING THE GENERIC UNIT.
+ --
+ --     (B) AS A SELECTOR TO DENOTE A COMPONENT OF A RECORD OBJECT,
+ --         AS THE NAME OF A RECORD OR DISCRIMINANT COMPONENT IN A RECORD
+ --         AGGREGATE, AND AS THE NAME OF A FORMAL PARAMETER IN A
+ --         FUNCTION CALL.
+ 
+ -- HISTORY:
+ --     BCB 08/03/88  CREATED ORIGINAL TEST.
+ --     JRL 03/20/92  DELETED TEST IN BLOCK STATEMENT; CONSOLIDATED
+ --                   WITH CC1005C.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1005B IS
+ 
+      S : INTEGER := IDENT_INT(0);
+ 
+      PACKAGE CC1005B IS
+           I : INTEGER;
+           S : INTEGER := IDENT_INT(5);
+           GENERIC
+                S : INTEGER := IDENT_INT(10);
+                V : INTEGER := STANDARD.CC1005B.S;
+                W : INTEGER := STANDARD.CC1005B.CC1005B.S;
+           FUNCTION CC1005B RETURN INTEGER;
+      END CC1005B;
+ 
+      PACKAGE BODY CC1005B IS
+           FUNCTION CC1005B RETURN INTEGER IS
+           BEGIN
+                IF NOT EQUAL(V,0) THEN
+                     FAILED ("WRONG VALUE OF S USED IN ASSIGNMENT OF V");
+                END IF;
+ 
+                IF NOT EQUAL(W,5) THEN
+                     FAILED ("WRONG VALUE OF S USED IN ASSIGNMENT OF W");
+                END IF;
+ 
+                RETURN 0;
+           END CC1005B;
+ 
+           FUNCTION NEW_CC IS NEW CC1005B;
+ 
+      BEGIN
+           TEST ("CC1005B", "CHECK THAT A GENERIC UNIT'S IDENTIFIER " &
+                            "CAN BE USED IN ITS FORMAL PART: AS THE " &
+                            "SELECTOR IN AN EXPANDED NAME TO DENOTE " &
+                            "AN ENTITY IN THE VISIBLE PART OF A " &
+                            "PACKAGE, OR TO DENOTE AN ENTITY " &
+                            "IMMEDIATELY ENCLOSED IN A CONSTRUCT " &
+                            "OTHER THAN THE CONSTRUCT IMMEDIATELY " &
+                            "ENCLOSING THE GENERIC UNIT; AND AS A " &
+                            "SELECTOR TO DENOTE A COMPONENT OF A " &
+                            "RECORD OBJECT, AS THE NAME OF A RECORD " &
+                            "OR DISCRIMINANT COMPONENT IN A RECORD " &
+                            "AGGREGATE, AND AS THE NAME OF A FORMAL " &
+                            "PARAMETER IN A FUNCTION CALL");
+ 
+           I := NEW_CC;
+      END CC1005B;
+ 
+      FUNCTION F (P : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN P;
+      END F;
+ 
+ BEGIN
+ 
+      BLOCK1:
+         DECLARE
+              TYPE REC IS RECORD
+                   P : INTEGER := IDENT_INT(0);
+              END RECORD;
+ 
+              TYPE REC2 (P : INTEGER) IS RECORD
+                   NULL;
+              END RECORD;
+ 
+              R : REC;
+ 
+              J : INTEGER;
+ 
+              GENERIC
+                   V : INTEGER := R.P;
+                   X : REC := (P => IDENT_INT(10));
+                   Y : REC2 := (P => IDENT_INT(15));
+                   Z : INTEGER := F(P => IDENT_INT(20));
+              FUNCTION P RETURN INTEGER;
+ 
+              FUNCTION P RETURN INTEGER IS
+              BEGIN
+                   IF NOT EQUAL(V,0) THEN
+                        FAILED ("WRONG VALUE OF P USED IN ASSIGNMENT " &
+                                "OF V");
+                   END IF;
+ 
+                   IF NOT EQUAL(X.P,10) THEN
+                        FAILED ("WRONG VALUE USED IN ASSIGNMENT OF X.P");
+                   END IF;
+ 
+                   IF NOT EQUAL(Y.P,15) THEN
+                        FAILED ("WRONG VALUE USED IN ASSIGNMENT OF Y.P");
+                   END IF;
+ 
+                   IF NOT EQUAL(Z,20) THEN
+                        FAILED ("WRONG VALUE OF P USED IN ASSIGNMENT " &
+                                "OF Z");
+                   END IF;
+ 
+                   RETURN 0;
+              END P;
+ 
+              FUNCTION NEW_P IS NEW P;
+         BEGIN
+              J := NEW_P;
+         END BLOCK1;
+ 
+      RESULT;
+ END CC1005B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1010a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1010a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1010a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1010a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,66 ----
+ -- CC1010A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NAMES IN A GENERIC SUBPROGRAM DECLARATION ARE
+ -- STATICALLY IDENTIFIED (I.E., BOUND) AT THE POINT WHERE THE
+ -- GENERIC DECLARATION TEXTUALLY OCCURS, AND ARE NOT DYNAMICALLY
+ -- BOUND AT THE POINT OF INSTANTIATION.
+ 
+ -- ASL 8/12/81
+ 
+ WITH REPORT;
+ PROCEDURE CC1010A IS
+      USE REPORT;
+ BEGIN
+      TEST ("CC1010A","PROPER VISIBILITY OF FREE IDENTIFIERS IN " &
+            "GENERIC DECLARATIONS, BODIES AND INSTANTIATIONS");
+ 
+      OUTER:
+           DECLARE
+                FREE : CONSTANT INTEGER := 5;
+           BEGIN
+                DECLARE
+                     GENERIC
+                          GFP : INTEGER := FREE;
+                     PROCEDURE P(PFP : IN INTEGER := FREE);
+           
+                     FREE : CONSTANT INTEGER := 6;
+             
+                     PROCEDURE P(PFP : IN INTEGER := OUTER.FREE) IS
+                     BEGIN
+                          IF FREE /= 6 OR GFP /= 5 OR PFP /= 5 THEN
+                               FAILED ("BINDINGS INCORRECT");
+                          END IF;
+                     END P;
+                BEGIN
+                     DECLARE
+                          FREE : CONSTANT INTEGER := 7;
+                          PROCEDURE INST IS NEW P;
+                     BEGIN
+                          INST;
+                     END;
+                END;
+           END OUTER;
+      RESULT;
+ END CC1010A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1010b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1010b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1010b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1010b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,67 ----
+ -- CC1010B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE NAMES IN A GENERIC PACKAGE BODY ARE STATICALLY
+ -- IDENTIFIED (I.E., BOUND) AT THE POINT WHERE THE GENERIC BODY
+ -- TEXTUALLY OCCURS, AND ARE NOT DYNAMICALLY BOUND AT THE POINT
+ -- OF INSTANTIATION.
+ 
+ -- ASL 8/13/81
+ 
+ WITH REPORT;
+ PROCEDURE CC1010B IS
+ 
+      USE REPORT;
+      FREE : CONSTANT INTEGER := 5;
+ BEGIN
+      TEST("CC1010B","PROPER VISIBILITY OF FREE IDENTIFIERS IN " &
+           "GENERIC PACKAGE DECLARATIONS, BODIES AND INSTANTIATIONS");
+ 
+      DECLARE
+           GENERIC
+                GFP : INTEGER := FREE;
+           PACKAGE P IS
+                SPECITEM : CONSTANT INTEGER := FREE;
+           END P;
+           
+           FREE : CONSTANT INTEGER := 6;
+ 
+           PACKAGE BODY P IS
+                BODYITEM : INTEGER := FREE;
+           BEGIN
+                IF GFP /= 5 OR SPECITEM /= 5 OR BODYITEM /= 6 THEN
+                     FAILED ("BINDINGS INCORRECT");
+                END IF;
+           END P;
+      BEGIN
+           DECLARE
+                FREE : CONSTANT INTEGER := 7;
+                PACKAGE INST IS NEW P;
+           BEGIN
+                NULL;
+           END;
+      END;
+ 
+      RESULT;
+ END CC1010B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1018a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1018a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1018a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1018a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,83 ----
+ -- CC1018A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A FORMAL OUT PARAMETER OF A GENERIC FORMAL SUBPROGRAM CAN 
+ -- HAVE A FORMAL LIMITED TYPE AND AN ARRAY TYPE WITH LIMITED COMPONENTS.
+ 
+ -- AH  10/3/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC1018A IS
+      TYPE INT IS RANGE 1..10;
+      TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INT;
+      INT_OBJ : INT := 4;
+      ARR_OBJ : ARR(1..5) := (2, 8, 2, 8, 2);
+ 
+      GENERIC
+           TYPE GLP IS LIMITED PRIVATE;
+           TYPE GARR IS ARRAY (INTEGER RANGE <>) OF GLP;
+           LP_OBJ : IN OUT GLP;
+           GA_OBJ : IN OUT GARR;
+           WITH PROCEDURE P (X : OUT GLP; Y : OUT GARR);
+           WITH FUNCTION SAME (LEFT, RIGHT : GLP) RETURN BOOLEAN;
+      PROCEDURE GEN_PROC;
+ 
+      PROCEDURE GET_VALUES (X1 : OUT INT; Y1 : OUT ARR) IS
+      BEGIN
+           X1 := 4;
+           Y1 := (2, 8, 2, 8, 2);
+      END GET_VALUES;
+ 
+      FUNCTION SAME_VALUE (LEFT, RIGHT : INT) RETURN BOOLEAN IS 
+      BEGIN
+           RETURN LEFT = RIGHT;
+      END SAME_VALUE;
+ 
+      PROCEDURE GEN_PROC IS
+           LP : GLP;
+           A : GARR(1..5);
+      BEGIN
+           P(LP, A);
+           IF NOT SAME(LP, LP_OBJ) THEN
+                FAILED ("LIMITED PRIVATE TYPE HAS INCORRECT VALUE");
+           END IF;
+ 
+           FOR INDEX IN A'RANGE LOOP
+                IF NOT SAME(A(INDEX), GA_OBJ(INDEX)) THEN
+                     FAILED ("LIMITED PRIVATE TYPE COMPONENT " & 
+                             "HAS INCORRECT VALUE");
+                END IF;
+           END LOOP;
+      END GEN_PROC;
+ 
+      PROCEDURE TEST_LP IS NEW GEN_PROC(INT, ARR, INT_OBJ, ARR_OBJ,
+                                        GET_VALUES, SAME_VALUE);
+ 
+ BEGIN
+      TEST ("CC1018A", "A GENERIC FORMAL SUBPROGRAM OUT PRARAMETER " & 
+                       "CAN HAVE A LIMITED TYPE");
+      TEST_LP;
+ 
+      RESULT;
+ END CC1018A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1104c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1104c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1104c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1104c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,151 ----
+ -- CC1104C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE;
+ --     CHECK THAT A GENERIC FORMAL IN OUT PARAMETER CAN HAVE A
+ --     LIMITED TYPE.
+ 
+ -- HISTORY:
+ --     BCB 08/03/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1104C IS
+ 
+      TASK TYPE TSK IS
+           ENTRY E;
+      END TSK;
+ 
+      VAR : INTEGER := IDENT_INT(0);
+      NEW_VAL : INTEGER := IDENT_INT(5);
+ 
+      TSK_VAR : TSK;
+ 
+      PACKAGE PP IS
+           TYPE LP IS LIMITED PRIVATE;
+           PROCEDURE INIT (ONE : OUT LP; TWO : INTEGER);
+           FUNCTION EQUAL (ONE : LP; TWO : INTEGER) RETURN BOOLEAN;
+      PRIVATE
+           TYPE LP IS RANGE 1 .. 100;
+      END PP;
+ 
+      USE PP;
+ 
+      TYPE REC IS RECORD
+           COMP : LP;
+      END RECORD;
+ 
+      C : LP;
+ 
+      REC_VAR : REC;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+           IN_OUT_VAR : IN OUT T;
+           IN_OUT_TSK : IN OUT TSK;
+           VAL : IN OUT T;
+           WITH PROCEDURE INIT (L : IN OUT T; R : T);
+      PROCEDURE P;
+ 
+      GENERIC
+           VAL : IN OUT LP;
+      PROCEDURE Q;
+ 
+      GENERIC
+           VAL : IN OUT REC;
+      PROCEDURE R;
+ 
+      PACKAGE BODY PP IS
+           PROCEDURE INIT(ONE : OUT LP; TWO : INTEGER) IS
+           BEGIN
+                ONE := LP(TWO);
+           END INIT;
+ 
+           FUNCTION EQUAL(ONE : LP; TWO : INTEGER) RETURN BOOLEAN IS
+           BEGIN
+                RETURN ONE = LP(TWO);
+           END EQUAL;
+      END PP;
+ 
+      TASK BODY TSK IS
+      BEGIN
+           ACCEPT E;
+      END TSK;
+ 
+      PROCEDURE P IS
+      BEGIN
+           INIT(IN_OUT_VAR,VAL);
+           IN_OUT_TSK.E;
+           INIT(C,50);
+      END P;
+ 
+      PROCEDURE Q IS
+      BEGIN
+           INIT(VAL,75);
+           INIT(REC_VAR.COMP,50);
+      END Q;
+ 
+      PROCEDURE R IS
+      BEGIN
+           INIT(VAL.COMP,75);
+      END R;
+ 
+      PROCEDURE I (ONE : IN OUT INTEGER; TWO : INTEGER) IS
+      BEGIN
+           ONE := TWO;
+      END I;
+ 
+      PROCEDURE NEW_P IS NEW P(INTEGER,VAR,TSK_VAR,NEW_VAL,I);
+ 
+      PROCEDURE NEW_Q IS NEW Q(C);
+ 
+      PROCEDURE NEW_R IS NEW R(REC_VAR);
+ 
+ BEGIN
+      TEST ("CC1104C", "CHECK THAT A GENERIC FORMAL IN OUT PARAMETER " &
+                       "CAN HAVE A LIMITED TYPE");
+ 
+      NEW_P;
+ 
+      IF NOT EQUAL(VAR,5) THEN
+           FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
+                   "GENERIC PACKAGE - 1");
+      END IF;
+ 
+      NEW_Q;
+ 
+      IF NOT EQUAL(C,75) THEN
+           FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
+                   "GENERIC PACKAGE - 2");
+      END IF;
+ 
+      NEW_R;
+ 
+      IF NOT EQUAL(REC_VAR.COMP,75) THEN
+           FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
+                   "GENERIC PACKAGE - 3");
+      END IF;
+ 
+      RESULT;
+ END CC1104C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1107b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1107b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1107b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1107b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- CC1107B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A DEFAULT EXPRESSION MAY REFER TO AN EARLIER FORMAL
+ --     PARAMETER OF THE SAME GENERIC FORMAL PART.
+ 
+ -- HISTORY:
+ --     BCB 08/03/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1107B IS
+ 
+      J, I : INTEGER;
+ 
+      X : INTEGER := IDENT_INT(0);
+ 
+      VAL : INTEGER := IDENT_INT(10);
+ 
+      GENERIC
+           X : INTEGER := IDENT_INT(5);
+           Y : INTEGER := X;
+      FUNCTION F RETURN INTEGER;
+ 
+      GENERIC
+           X : INTEGER;
+           Y : INTEGER := X;
+      FUNCTION G RETURN INTEGER;
+ 
+      FUNCTION F RETURN INTEGER IS
+      BEGIN
+           IF NOT EQUAL(X,Y) THEN
+                FAILED ("WRONG VALUE FROM EARLIER FORMAL PARAMETER - 1");
+           END IF;
+ 
+           RETURN 0;
+      END F;
+ 
+      FUNCTION G RETURN INTEGER IS
+      BEGIN
+           IF NOT EQUAL(X,Y) THEN
+                FAILED ("WRONG VALUE FROM EARLIER FORMAL PARAMETER - 2");
+           END IF;
+ 
+           RETURN 0;
+      END G;
+ 
+      FUNCTION NEW_F IS NEW F;
+ 
+      FUNCTION NEW_G IS NEW G(VAL);
+ 
+ BEGIN
+      TEST ("CC1107B", "CHECK THAT A DEFAULT EXPRESSION MAY REFER " &
+                       "TO AN EARLIER FORMAL PARAMETER OF THE SAME " &
+                       "GENERIC FORMAL PART");
+ 
+      J := NEW_F;
+ 
+      I := NEW_G;
+ 
+      RESULT;
+ END CC1107B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1111a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1111a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1111a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1111a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,322 ----
+ -- CC1111A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AFTER A GENERIC UNIT IS INSTANTIATED, THE SUBTYPE OF
+ --     AN IN OUT OBJECT PARAMETER IS DETERMINED BY THE ACTUAL PARAMETER
+ --     (TESTS INTEGER, ENUMERATION, FLOATING POINT, FIXED POINT, ARRAY,
+ --     ACCESS, AND DISCRIMINATED TYPES).
+ 
+ -- HISTORY:
+ --     BCB 03/28/88  CREATED ORIGINAL TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1111A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 0..5;
+      INTVAR : INTEGER RANGE 1..3;
+ 
+      TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT);
+      SUBTYPE SUBENUM IS ENUM RANGE ONE .. FIVE;
+      ENUMVAR : ENUM RANGE TWO .. THREE;
+ 
+      TYPE FLT IS DIGITS 5 RANGE -5.0 .. 5.0;
+      SUBTYPE SUBFLT IS FLT RANGE -1.0 .. 1.0;
+      FLTVAR : FLT RANGE 0.0 .. 1.0;
+ 
+      TYPE FIX IS DELTA 0.5 RANGE -5.0 .. 5.0;
+      SUBTYPE SUBFIX IS FIX RANGE -1.0 .. 1.0;
+      FIXVAR : FIX RANGE 0.0 .. 1.0;
+ 
+      SUBTYPE STR IS STRING (1..10);
+      STRVAR : STRING (1..5);
+ 
+      TYPE REC (DISC : INTEGER := 5) IS RECORD
+           NULL;
+      END RECORD;
+      SUBTYPE SUBREC IS REC (6);
+      RECVAR : REC(5);
+      SUBRECVAR : SUBREC;
+ 
+      TYPE ACCREC IS ACCESS REC;
+      SUBTYPE A1 IS ACCREC(1);
+      SUBTYPE A2 IS ACCREC(2);
+      A1VAR : A1 := NEW REC(1);
+      A2VAR : A2 := NEW REC(2);
+ 
+      PACKAGE P IS
+           TYPE PRIV IS PRIVATE;
+      PRIVATE
+           TYPE PRIV IS RANGE 1 .. 100;
+           SUBTYPE SUBPRIV IS PRIV RANGE 5 .. 10;
+           PRIVVAR : PRIV RANGE 8 .. 10;
+      END P;
+ 
+      PACKAGE BODY P IS
+           FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN;
+ 
+           FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN IS
+           BEGIN
+                RETURN ONE = TWO;
+           END PRIVEQUAL;
+ 
+           GENERIC
+                INPUT : SUBPRIV;
+                OUTPUT : IN OUT SUBPRIV;
+           PROCEDURE I;
+ 
+           PROCEDURE I IS
+           BEGIN
+                OUTPUT := INPUT;
+                FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                        "PRIVATE TYPE");
+                IF PRIVEQUAL (OUTPUT, OUTPUT) THEN
+                     COMMENT ("DON'T OPTIMIZE OUTPUT");
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED");
+           END I;
+ 
+           PROCEDURE I1 IS NEW I (5, PRIVVAR);
+           PROCEDURE I2 IS NEW I (SUBPRIV'FIRST, PRIVVAR);
+ 
+      BEGIN
+           TEST ("CC1111A", "CHECK THAT AFTER A GENERIC UNIT IS " &
+                            "INSTANTIATED, THE SUBTYPE OF AN IN OUT " &
+                            "OBJECT PARAMETER IS DETERMINED BY THE " &
+                            "ACTUAL PARAMETER (TESTS INTEGER, " &
+                            "ENUMERATION, FLOATING POINT, FIXED POINT " &
+                            ", ARRAY, ACCESS, AND DISCRIMINATED TYPES)");
+ 
+           I1;
+           I2;
+      END P;
+ 
+      USE P;
+ 
+      GENERIC
+           TYPE GP IS PRIVATE;
+      FUNCTION GEN_IDENT (X : GP) RETURN GP;
+ 
+      GENERIC
+           INPUT : INT;
+           OUTPUT : IN OUT INT;
+      PROCEDURE B;
+ 
+      GENERIC
+           INPUT : SUBENUM;
+           OUTPUT : IN OUT SUBENUM;
+      PROCEDURE C;
+ 
+      GENERIC
+           INPUT : SUBFLT;
+           OUTPUT : IN OUT SUBFLT;
+      PROCEDURE D;
+ 
+      GENERIC
+           INPUT : SUBFIX;
+           OUTPUT : IN OUT SUBFIX;
+      PROCEDURE E;
+ 
+      GENERIC
+           INPUT : STR;
+           OUTPUT : IN OUT STR;
+      PROCEDURE F;
+ 
+      GENERIC
+           INPUT : A1;
+           OUTPUT : IN OUT A1;
+      PROCEDURE G;
+ 
+      GENERIC
+           INPUT : SUBREC;
+           OUTPUT : IN OUT SUBREC;
+      PROCEDURE H;
+ 
+      GENERIC
+           TYPE GP IS PRIVATE;
+      FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN;
+ 
+      FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN IS
+      BEGIN
+           RETURN ONE = TWO;
+      END GENEQUAL;
+ 
+      FUNCTION GEN_IDENT (X : GP) RETURN GP IS
+      BEGIN
+                RETURN X;
+      END GEN_IDENT;
+ 
+      FUNCTION INT_IDENT IS NEW GEN_IDENT (INT);
+      FUNCTION SUBENUM_IDENT IS NEW GEN_IDENT (SUBENUM);
+      FUNCTION SUBFLT_IDENT IS NEW GEN_IDENT (SUBFLT);
+      FUNCTION SUBFIX_IDENT IS NEW GEN_IDENT (SUBFIX);
+ 
+      FUNCTION ENUMEQUAL IS NEW GENEQUAL (SUBENUM);
+      FUNCTION FLTEQUAL IS NEW GENEQUAL (SUBFLT);
+      FUNCTION FIXEQUAL IS NEW GENEQUAL (SUBFIX);
+      FUNCTION STREQUAL IS NEW GENEQUAL (STR);
+      FUNCTION ACCEQUAL IS NEW GENEQUAL (A2);
+      FUNCTION RECEQUAL IS NEW GENEQUAL (REC);
+ 
+      PROCEDURE B IS
+      BEGIN
+           OUTPUT := INPUT;
+           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                   "INTEGER TYPE");
+           IF EQUAL (OUTPUT, OUTPUT) THEN
+                COMMENT ("DON'T OPTIMIZE OUTPUT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END B;
+ 
+      PROCEDURE C IS
+      BEGIN
+           OUTPUT := INPUT;
+           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                   "ENUMERATION TYPE");
+           IF ENUMEQUAL (OUTPUT, OUTPUT) THEN
+                COMMENT ("DON'T OPTIMIZE OUTPUT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END C;
+ 
+      PROCEDURE D IS
+      BEGIN
+           OUTPUT := INPUT;
+           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                   "FLOATING POINT TYPE");
+           IF FLTEQUAL (OUTPUT, OUTPUT) THEN
+                COMMENT ("DON'T OPTIMIZE OUTPUT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END D;
+ 
+      PROCEDURE E IS
+      BEGIN
+           OUTPUT := INPUT;
+           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                   "FIXED POINT TYPE");
+           IF FIXEQUAL (OUTPUT, OUTPUT) THEN
+                COMMENT ("DON'T OPTIMIZE OUTPUT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END E;
+ 
+      PROCEDURE F IS
+      BEGIN
+           OUTPUT := INPUT;
+           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                   "ARRAY TYPE");
+           IF STREQUAL (OUTPUT, OUTPUT) THEN
+                COMMENT ("DON'T OPTIMIZE OUTPUT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END F;
+ 
+      PROCEDURE G IS
+      BEGIN
+           OUTPUT := INPUT;
+           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                   "ACCESS TYPE");
+           IF ACCEQUAL (OUTPUT, OUTPUT) THEN
+                COMMENT ("DON'T OPTIMIZE OUTPUT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END G;
+ 
+      PROCEDURE H IS
+      BEGIN
+           OUTPUT := INPUT;
+           FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                   "DISCRIMINATED RECORD TYPE");
+           IF RECEQUAL (OUTPUT, OUTPUT) THEN
+                COMMENT ("DON'T OPTIMIZE OUTPUT");
+           END IF;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                NULL;
+           WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+      END H;
+ 
+      PROCEDURE B1 IS NEW B (4, INTVAR);
+      PROCEDURE C1 IS NEW C (FOUR, ENUMVAR);
+      PROCEDURE D1 IS NEW D (-1.0, FLTVAR);
+      PROCEDURE E1 IS NEW E (-1.0, FIXVAR);
+      PROCEDURE F1 IS NEW F ("9876543210", STRVAR);
+      PROCEDURE G1 IS NEW G (A1VAR, A2VAR);
+      PROCEDURE H1 IS NEW H (SUBRECVAR, RECVAR);
+ 
+      PROCEDURE B2 IS NEW B (INT_IDENT(INT'FIRST), INTVAR);
+      PROCEDURE C2 IS NEW C (SUBENUM_IDENT(SUBENUM'FIRST), ENUMVAR);
+      PROCEDURE D2 IS NEW D (SUBFLT_IDENT(SUBFLT'FIRST), FLTVAR);
+      PROCEDURE E2 IS NEW E (SUBFIX_IDENT(SUBFIX'FIRST), FIXVAR);
+ 
+ BEGIN
+ 
+      B1;
+      C1;
+      D1;
+      E1;
+      F1;
+      G1;
+      H1;
+ 
+      B2;
+      C2;
+      D2;
+      E2;
+ 
+      RESULT;
+ END CC1111A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1204a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1204a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1204a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1204a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,115 ----
+ -- CC1204A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT GENERIC FORMAL TYPES MAY HAVE A DISCRIMINANT PART,
+ -- WHICH MAY BE OF A GENERIC FORMAL TYPE.
+ 
+ -- DAT 8/14/81
+ -- SPS 5/12/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1204A IS
+ BEGIN
+      TEST ("CC1204A", "DISCRIMINANT PARTS FOR GENERIC FORMAL TYPES");
+ 
+      DECLARE
+           GENERIC
+                TYPE T IS ( <> );
+                TYPE I IS RANGE <> ;
+                TYPE R1 (C : BOOLEAN) IS PRIVATE;
+                TYPE R2 (C : T) IS PRIVATE;
+                TYPE R3 (C : I) IS LIMITED PRIVATE;
+                P1 : IN R1;
+                P2 : IN R2;
+                V1 : IN OUT R1;
+                V2 : IN OUT R2;
+                V3 : IN OUT R3;
+           PROCEDURE PROC;
+ 
+           TYPE DD IS NEW INTEGER RANGE 1 .. 10;
+           TYPE ARR IS ARRAY (DD RANGE <>) OF CHARACTER;
+           TYPE RECD (C : DD := DD (IDENT_INT (1))) IS
+                RECORD
+                     C1 : ARR (1..C);
+                END RECORD;
+ 
+           X1 : RECD;
+           X2 : RECD := (1, "Y");
+ 
+           TYPE RECB (C : BOOLEAN) IS
+                RECORD
+                     V : INTEGER := 6;
+                END RECORD;
+           RB : RECB (IDENT_BOOL (TRUE));
+           RB1 : RECB (IDENT_BOOL (TRUE));
+ 
+           PROCEDURE PROC IS
+           BEGIN
+                IF P1.C /= TRUE
+                   OR P2.C /= T'FIRST
+                   OR V1.C /= TRUE
+                   OR V2.C /= T'FIRST
+                   OR V3.C /= I'FIRST
+                THEN
+                     FAILED ("WRONG GENERIC PARAMETER VALUE");
+                END IF;
+ 
+                V1 := P1;
+                V2 := P2;
+ 
+                IF V1 /= P1
+                   OR V2 /= P2 
+                THEN
+                     FAILED ("BAD ASSIGNMENT TO GENERIC PARAMETERS");
+                END IF;
+           END PROC;
+ 
+      BEGIN
+           RB1.V := IDENT_INT (1);
+           X1.C1 := "X";
+ 
+           DECLARE
+      
+                PROCEDURE PR IS NEW PROC
+                     (T => DD,
+                      I => DD,
+                      R1 => RECB,
+                      R2 => RECD,
+                      R3 => RECD,
+                      P1 => RB1,
+                      P2 => X1,
+                      V1 => RB,
+                      V2 => X2,
+                      V3 => X2);
+           BEGIN
+                PR;
+                IF RB /= (TRUE, 1) OR X2.C1 /= "X" THEN
+                     FAILED ("PR NOT CALLED CORRECTLY");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END CC1204A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1207b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1207b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1207b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,138 ----
+ -- CC1207B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH DISCRIMINANTS IS
+ --     ALLOWED AS THE TYPE OF A SUBPROGRAM OR AN ENTRY FORMAL
+ --     PARAMETER, AND AS THE TYPE OF A GENERIC FORMAL OBJECT PARAMETER,
+ --     AS A GENERIC ACTUAL PARAMETER, AND IN A MEMBERSHIP TEST, IN A
+ --     SUBTYPE DECLARATION, IN AN ACCESS TYPE DEFINITION, AND IN A
+ --     DERIVED TYPE DEFINITION.
+ 
+ -- HISTORY:
+ --     BCB 08/04/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1207B IS
+ 
+      GENERIC
+           TYPE X (L : INTEGER) IS PRIVATE;
+      PACKAGE PACK IS
+      END PACK;
+ 
+ BEGIN
+      TEST ("CC1207B", "CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH " &
+                       "DISCRIMINANTS IS ALLOWED AS THE TYPE OF A " &
+                       "SUBPROGRAM OR AN ENTRY FORMAL PARAMETER, AND " &
+                       "AS THE TYPE OF A GENERIC FORMAL OBJECT " &
+                       "PARAMETER, AS A GENERIC ACTUAL PARAMETER, AND " &
+                       "IN A MEMBERSHIP TEST, IN A SUBTYPE " &
+                       "DECLARATION, IN AN ACCESS TYPE DEFINITION, " &
+                       "AND IN A DERIVED TYPE DEFINITION");
+ 
+      DECLARE
+           TYPE REC (D : INTEGER := 3) IS RECORD
+                NULL;
+           END RECORD;
+ 
+           GENERIC
+                TYPE R (D : INTEGER) IS PRIVATE;
+                OBJ : R;
+           PACKAGE P IS
+                PROCEDURE S (X : R);
+ 
+                TASK T IS
+                     ENTRY E (Y : R);
+                END T;
+ 
+                SUBTYPE SUB_R IS R;
+ 
+                TYPE ACC_R IS ACCESS R;
+ 
+                TYPE NEW_R IS NEW R;
+ 
+                BOOL : BOOLEAN := (OBJ IN R);
+ 
+                SUB_VAR : SUB_R(5);
+ 
+                ACC_VAR : ACC_R := NEW R(5);
+ 
+                NEW_VAR : NEW_R(5);
+ 
+                PACKAGE NEW_PACK IS NEW PACK (R);
+           END P;
+ 
+           REC_VAR : REC(5) := (D => 5);
+ 
+           PACKAGE BODY P IS
+                PROCEDURE S (X : R) IS
+                BEGIN
+                     IF NOT EQUAL(X.D,5) THEN
+                          FAILED ("WRONG DISCRIMINANT VALUE - S");
+                     END IF;
+                END S;
+ 
+                TASK BODY T IS
+                BEGIN
+                     ACCEPT E (Y : R) DO
+                          IF NOT EQUAL(Y.D,5) THEN
+                               FAILED ("WRONG DISCRIMINANT VALUE - T");
+                          END IF;
+                     END E;
+                END T;
+           BEGIN
+                IF NOT EQUAL(OBJ.D,5) THEN
+                     FAILED ("IMPROPER DISCRIMINANT VALUE");
+                END IF;
+ 
+                S (OBJ);
+ 
+                T.E (OBJ);
+ 
+                IF NOT EQUAL(SUB_VAR.D,5) THEN
+                     FAILED ("IMPROPER DISCRIMINANT VALUE - SUBTYPE");
+                END IF;
+ 
+                IF NOT EQUAL(ACC_VAR.D,5) THEN
+                     FAILED ("IMPROPER DISCRIMINANT VALUE - ACCESS");
+                END IF;
+ 
+                IF NOT EQUAL(NEW_VAR.D,5) THEN
+                     FAILED ("IMPROPER DISCRIMINANT VALUE - DERIVED");
+                END IF;
+ 
+                IF NOT BOOL THEN
+                     FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+                END IF;
+           END P;
+ 
+           PACKAGE NEW_P IS NEW P (REC,REC_VAR);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC1207B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1220a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1220a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1220a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1220a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,174 ----
+ -- CC1220A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A GENERIC UNIT CAN REFER TO AN IMPLICITLY
+ --     DECLARED PREDEFINED OPERATOR.
+ 
+ -- HISTORY:
+ --     DAT 08/20/81  CREATED ORIGINAL TEST.
+ --     SPS 05/03/82
+ --     BCB 08/04/88  MODIFIED HEADER FORMAT AND ADDED CHECKS FOR OTHER
+ --                   OPERATIONS OF A DISCRETE TYPE.
+ --     RJW 03/27/90  REVISED TEST TO CHECK FOR A GENERIC FORMAL
+ --                   DISCRETE TYPE.
+ --     CJJ 10/14/90  ADDED CHECKS FOR RELATIONAL OPERATOR (<, <=, >, >=);
+ --                   MADE FAILED MESSAGES IN PROCEDURE BODY MORE SPECIFIC.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ 
+ PROCEDURE CC1220A IS
+ 
+ BEGIN
+      TEST ("CC1220A", "GENERIC UNIT CAN REFER TO IMPLICITLY " &
+            "DECLARED OPERATORS");
+ 
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T IS (<>);
+                STR : STRING;
+                P1 : T := T'FIRST;
+                P2 : T := T(T'SUCC (P1));
+                P3 : T := T'(T'PRED (P2));
+                P4 : INTEGER := IDENT_INT(T'WIDTH);
+                P5 : BOOLEAN := (P1 < P2) AND (P2 > P3);
+                P6: BOOLEAN := (P1 <= P3) AND (P2 >= P1);
+                P7 : BOOLEAN := (P3 = P1);
+                P8 : T := T'BASE'FIRST;
+                P10 : T := T'LAST;
+                P11 : INTEGER := T'SIZE;
+                P12 : ADDRESS := P10'ADDRESS;
+                P13 : INTEGER := T'WIDTH;
+                P14 : INTEGER := T'POS(T'LAST);
+                P15 : T := T'VAL(1);
+                P16 : INTEGER := T'POS(P15);
+                P17 : STRING := T'IMAGE(T'BASE'LAST);
+                P18 : T := T'VALUE(P17);
+                P19 : BOOLEAN := (P15 IN T);
+                WITH FUNCTION IDENT (X : T) RETURN T;
+           PACKAGE PKG IS
+                ARR : ARRAY (1 .. 3) OF T := (P1,P2,P3);
+                B1 : BOOLEAN := P7 AND P19;
+                B2 : BOOLEAN := P5 AND P6;
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF P1 /= T(T'FIRST) THEN
+                     FAILED ("IMPROPER VALUE FOR 'FIRST - " & STR);
+                END IF;
+ 
+                IF T'SUCC (P1) /= IDENT (P2) OR
+                   T'PRED (P2) /= IDENT (P1) THEN
+                     FAILED ("IMPROPER VALUE FOR 'SUCC, PRED - " & STR);
+                END IF;
+ 
+                IF P10 /= T(T'LAST) THEN
+                     FAILED ("IMPROPER VALUE FOR 'LAST - " & STR);
+                END IF;
+ 
+                IF NOT EQUAL(P11,T'SIZE) THEN
+                     FAILED ("IMPROPER VALUE FOR 'SIZE - " & STR);
+                END IF;
+ 
+                IF NOT EQUAL(P13,T'WIDTH) THEN
+                     FAILED ("IMPROPER VALUE FOR 'WIDTH - " & STR);
+                END IF;
+ 
+                IF NOT EQUAL (P16, T'POS (P15)) OR
+                   T'VAL (P16) /= T(IDENT (P15)) THEN
+                     FAILED ("IMPROPER VALUE FOR 'POS, 'VAL - " & STR);
+                END IF;
+ 
+                IF T'VALUE (P17) /= T'BASE'LAST OR
+                   T'IMAGE (P18) /= T'IMAGE (T'BASE'LAST) THEN
+                     FAILED ("IMPROPER VALUE FOR 'VALUE, 'IMAGE - " &
+                              STR);
+                END IF;
+           END PKG;
+ 
+      BEGIN
+           DECLARE
+                TYPE CHAR IS ('A', 'B', 'C', 'D', 'E');
+ 
+                FUNCTION IDENT (C : CHAR) RETURN CHAR IS
+                BEGIN
+                     RETURN CHAR'VAL (IDENT_INT (CHAR'POS (C)));
+                END IDENT;
+ 
+                PACKAGE N_CHAR IS NEW PKG (T => CHAR, STR => "CHAR",
+                                           IDENT => IDENT);
+           BEGIN
+                IF N_CHAR.ARR (1) /= IDENT ('A') OR
+                   N_CHAR.ARR (2) /= IDENT ('B') OR
+                   N_CHAR.ARR (3) /= 'A' OR
+                   N_CHAR.B1 /= TRUE OR
+                  N_CHAR.B2 /= TRUE THEN
+                     FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
+                             " IN INSTANTIATION OF N_CHAR.");
+                END IF;
+           END;
+ 
+           DECLARE
+                TYPE ENUM IS (JOVIAL, ADA, FORTRAN, BASIC);
+ 
+                FUNCTION IDENT (C : ENUM) RETURN ENUM IS
+                BEGIN
+                     RETURN ENUM'VAL (IDENT_INT (ENUM'POS (C)));
+                END IDENT;
+ 
+                PACKAGE N_ENUM IS NEW PKG (T => ENUM, STR => "ENUM",
+                                           IDENT => IDENT);
+ 
+           BEGIN
+                IF N_ENUM.ARR (1) /= IDENT (JOVIAL) OR
+                   N_ENUM.ARR (2) /= IDENT (ADA) OR
+                   N_ENUM.ARR (3) /= JOVIAL OR
+                   N_ENUM.B1 /= TRUE OR
+                   N_ENUM.B2 /= TRUE THEN
+                     FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
+                             " IN INSTANTIATION OF N_ENUM.");
+                END IF;
+           END;
+ 
+           DECLARE
+ 
+                PACKAGE N_INT IS NEW PKG (T => INTEGER, STR => "INTEGER",
+                                           IDENT => IDENT_INT);
+           BEGIN
+                IF N_INT.ARR (1) /= IDENT_INT (INTEGER'FIRST) OR
+                   N_INT.ARR (2) /= IDENT_INT (INTEGER'FIRST + 1) OR
+                   N_INT.ARR (3) /= INTEGER'FIRST OR
+                   N_INT.B1 /= TRUE OR
+                   N_INT.B2 /= TRUE THEN
+                     FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
+                             " IN INSTANTIATION OF N_INT.");
+                END IF;
+           END;
+      END;
+      RESULT;
+ END CC1220A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,141 ----
+ -- CC1221A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+ --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+ --     WITHIN THE GENERIC UNIT:  ASSIGNMENT, MEMBERSHIP, QUALIFICATION,
+ --     AND EXPLICIT CONVERSION TO AND FROM OTHER INTEGER TYPES.
+ 
+ -- HISTORY:
+ --     RJW 09/26/86  CREATED ORIGINAL TEST.
+ --     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.  SPLIT TEST
+ --                   INTO PARTS A, B, C, AND D.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC1221A IS
+ 
+      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+      TYPE NEWINT IS NEW INTEGER;
+      TYPE INT IS RANGE -300 .. 300;
+ 
+ BEGIN
+      TEST ( "CC1221A", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                        "DECLARED AND ARE THEREFORE AVAILABLE " &
+                        "WITHIN THE GENERIC UNIT:  ASSIGNMENT, " &
+                        "MEMBERSHIP, QUALIFICATION, AND EXPLICIT " &
+                        "CONVERSION TO AND FROM OTHER INTEGER TYPES");
+ 
+      DECLARE -- (A) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+              --     PART I.
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+                TYPE T1 IS RANGE <>;
+                I  : T;
+                I1 : T1;
+           PROCEDURE P (J : T; STR : STRING);
+ 
+           PROCEDURE P (J : T; STR : STRING) IS
+                SUBTYPE ST IS T RANGE T'VAL (-1) .. T'VAL (1);
+                K, L  : T;
+ 
+                FUNCTION F (X : T) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN IDENT_BOOL (TRUE);
+                END F;
+ 
+                FUNCTION F (X : T1) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN IDENT_BOOL (FALSE);
+                END F;
+ 
+           BEGIN
+                K := I;
+                L := J;
+                K := L;
+ 
+                IF K /= J THEN
+                     FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
+                              "WITH TYPE - " & STR);
+                END IF;
+ 
+                IF I IN ST THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
+                              "TYPE  - " & STR);
+                END IF;
+ 
+                IF J NOT IN ST THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
+                              "TYPE  - " & STR);
+                END IF;
+ 
+                IF T'(I) /= I THEN
+                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                              "WITH TYPE - " & STR & " - 1" );
+                END IF;
+ 
+                IF F (T'(1)) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                              "WITH TYPE - " & STR & " - 2" );
+                END IF;
+ 
+                IF T (I1) /= I THEN
+                     FAILED ( "INCORRECT RESULTS FOR EXPLICIT " &
+                              "CONVERSION WITH TYPE - " & STR &
+                              " - 1" );
+                END IF;
+ 
+                IF F (T (I1)) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR EXPLICIT  " &
+                              "CONVERSION WITH TYPE - " & STR &
+                              " - 2" );
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE NP1 IS NEW P (SUBINT,  SUBINT,  0, 0);
+           PROCEDURE NP2 IS NEW P (NEWINT,  NEWINT,  0, 0);
+           PROCEDURE NP3 IS NEW P (INT,     INT,     0, 0);
+           PROCEDURE NP4 IS NEW P (INTEGER, INTEGER, 0, 0);
+ 
+      BEGIN
+           NP1 (2, "SUBINT");
+           NP2 (2, "NEWINT");
+           NP3 (2, "INT");
+           NP4 (2, "INTEGER");
+      END; -- (A).
+ 
+      RESULT;
+ END CC1221A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,159 ----
+ -- CC1221B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+ --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+ --     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, 'LAST, 'WIDTH,
+ --     'ADDRESS, AND 'SIZE.
+ 
+ -- HISTORY:
+ --     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC1221B IS
+ 
+      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+      SUBTYPE NOINT IS INTEGER RANGE 1 .. -1;
+      TYPE NEWINT IS NEW INTEGER;
+      TYPE INT IS RANGE -300 .. 300;
+      SUBTYPE SINT1 IS INT
+           RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
+      SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
+      TYPE INT2 IS RANGE 0E8 .. 1E3;
+ 
+ BEGIN
+      TEST ( "CC1221B", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                        "DECLARED AND ARE THEREFORE AVAILABLE " &
+                        "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, " &
+                        "'LAST, 'WIDTH, 'ADDRESS, AND 'SIZE");
+ 
+      DECLARE -- (B) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+              --     PART II.
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+                F, L : T;
+                W : INTEGER;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                I : INTEGER := F'SIZE;
+                T1 : T;
+                A : ADDRESS := T1'ADDRESS;
+ 
+           BEGIN
+                IF T'FIRST /= F THEN
+                     FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
+                END IF;
+ 
+                IF T'LAST /= L THEN
+                     FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
+                END IF;
+ 
+                IF T'BASE'FIRST > T'FIRST THEN
+                     FAILED ( "INCORRECT RESULTS WITH " & STR &
+                              "'BASE'FIRST" );
+                END IF;
+ 
+                IF T'BASE'LAST < T'LAST THEN
+                     FAILED ( "INCORRECT RESULTS WITH " & STR &
+                              "'BASE'LAST" );
+                END IF;
+ 
+                IF T'WIDTH /= W THEN
+                     FAILED ( "INCORRECT VALUE FOR " & STR &
+                              "'WIDTH" );
+                END IF;
+ 
+                IF T'BASE'WIDTH < T'WIDTH THEN
+                     FAILED ( "INCORRECT RESULTS WITH " & STR &
+                              "'BASE'WIDTH" );
+                END IF;
+ 
+           END P;
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           PROCEDURE Q;
+ 
+           PROCEDURE Q IS
+           BEGIN
+                IF T'FIRST /= 1 THEN
+                     FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
+                END IF;
+ 
+                IF T'LAST /= -1 THEN
+                     FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
+                END IF;
+ 
+                IF T'BASE'FIRST > T'FIRST THEN
+                     FAILED ( "INCORRECT RESULTS WITH " &
+                              "NOINT'BASE'FIRST" );
+                END IF;
+ 
+                IF T'BASE'LAST < T'LAST THEN
+                     FAILED ( "INCORRECT RESULTS WITH " &
+                              "NOINT'BASE'LAST" );
+                END IF;
+ 
+                IF T'WIDTH /= 0 THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                              "NOINT'WIDTH" );
+                END IF;
+ 
+                IF T'BASE'WIDTH < T'WIDTH THEN
+                     FAILED ( "INCORRECT RESULTS WITH " &
+                              "NOINT'BASE'WIDTH" );
+                END IF;
+ 
+           END Q;
+ 
+           PROCEDURE P1 IS NEW P (INTEGER, INTEGER'FIRST, INTEGER'LAST,
+                                  INTEGER'WIDTH);
+           PROCEDURE P2 IS NEW P (SUBINT, -100, 100, 4);
+           PROCEDURE P3 IS NEW P (NEWINT, NEWINT'FIRST, NEWINT'LAST,
+                                  NEWINT'WIDTH);
+           PROCEDURE P4 IS NEW P (SINT1, -4, 4, 2);
+           PROCEDURE P5 IS NEW P (SINT2, 224, 255, 4);
+           PROCEDURE P6 IS NEW P (INT2 , 0, 1000, 5);
+ 
+           PROCEDURE Q1 IS NEW Q (NOINT);
+ 
+      BEGIN
+            P1 ( "INTEGER" );
+            P2 ( "SUBINT" );
+            P3 ( "NEWINT" );
+            P4 ( "SINT1" );
+            P5 ( "SINT2" );
+            P6 ( "INT2" );
+ 
+            Q1;
+ 
+      END; -- (B).
+ 
+      RESULT;
+ END CC1221B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,195 ----
+ -- CC1221C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+ --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+ --     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'POS, 'VAL, 'PRED, 'SUCC,
+ --     'IMAGE, AND 'VALUE.
+ 
+ -- HISTORY:
+ --     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC1221C IS
+ 
+      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+      TYPE NEWINT IS NEW INTEGER;
+      TYPE INT IS RANGE -300 .. 300;
+      SUBTYPE SINT1 IS INT
+           RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
+      TYPE INT1 IS RANGE -6 .. 6;
+ 
+ BEGIN
+      TEST ( "CC1221C", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                        "DECLARED AND ARE THEREFORE AVAILABLE " &
+                        "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'POS, " &
+                        "'VAL, 'PRED, 'SUCC, 'IMAGE, AND 'VALUE");
+ 
+      DECLARE -- (C1) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+              --      PART III.
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+                F : INTEGER;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+                I : INTEGER;
+                Y : T;
+ 
+                FUNCTION IDENT (X : T) RETURN T IS
+                BEGIN
+                     IF EQUAL (3, 3) THEN
+                          RETURN X;
+                     ELSE
+                          RETURN T'SUCC (T'FIRST);
+                     END IF;
+                END IDENT;
+ 
+           BEGIN
+                I := F;
+                FOR X IN T LOOP
+                     IF T'VAL (I) /= X THEN
+                          FAILED ( "WRONG VALUE FOR " & STR &
+                                   "'VAL OF " & INTEGER'IMAGE (I));
+                     END IF;
+ 
+                     IF T'POS (X) /= I THEN
+                          FAILED ( "WRONG VALUE FOR " & STR &
+                                   "'POS OF " & T'IMAGE (X));
+                     END IF;
+ 
+                     I := I + 1;
+                END LOOP;
+ 
+                FOR X IN T LOOP
+                     IF T'SUCC (X) /= T'VAL (T'POS (X) + 1) THEN
+                          FAILED ( "WRONG VALUE FOR " & STR &
+                                   "'SUCC OF " & T'IMAGE (X));
+                     END IF;
+ 
+                     IF T'PRED (X) /= T'VAL (T'POS (X) - 1) THEN
+                          FAILED ( "WRONG VALUE FOR " & STR &
+                                   "'PRED OF " & T'IMAGE (X));
+                     END IF;
+                END LOOP;
+ 
+                BEGIN
+                     Y := T'SUCC (IDENT (T'BASE'LAST));
+                     FAILED ( "NO EXCEPTION RAISED FOR " &
+                               STR & "'SUCC (IDENT (" & STR &
+                              "'BASE'LAST))" );
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'SUCC (IDENT (" & STR &
+                                   "'BASE'LAST))" );
+                END;
+ 
+                BEGIN
+                     Y := T'PRED (IDENT (T'BASE'FIRST));
+                     FAILED ( "NO EXCEPTION RAISED FOR " &
+                               STR & "'PRED (IDENT (" & STR &
+                              "'BASE'FIRST))" );
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                    STR & "'PRED (IDENT (" & STR &
+                                   "'BASE'FIRST))" );
+                END;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (SUBINT, -100);
+           PROCEDURE P2 IS NEW P (SINT1, -4);
+           PROCEDURE P3 IS NEW P (INT1, -6);
+ 
+      BEGIN
+            P1 ( "SUBINT" );
+            P2 ( "SINT" );
+            P3 ( "INT1" );
+      END; -- (C1).
+ 
+      DECLARE -- (C2) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+              --      PART IV.
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+                STR : STRING;
+           PACKAGE PKG IS END PKG;
+ 
+           PACKAGE BODY PKG IS
+                PROCEDURE P (IM : STRING; VA : T) IS
+                BEGIN
+                     IF T'IMAGE (VA) /= IM THEN
+                          FAILED ( "INCORRECT RESULTS FOR " & STR &
+                                   "'IMAGE OF " &
+                                    INTEGER'IMAGE (INTEGER (VA)));
+                     END IF;
+                END P;
+ 
+                PROCEDURE Q (IM : STRING; VA : T) IS
+                BEGIN
+                     IF T'VALUE (IM) /= VA THEN
+                          FAILED ( "INCORRECT RESULTS FOR " & STR &
+                                   "'VALUE OF " & IM);
+                     END IF;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
+                                    STR &"'VALUE OF " & IM);
+                     WHEN OTHERS =>
+                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
+                                    STR &"'VALUE OF " & IM);
+ 
+                END Q;
+ 
+           BEGIN
+                P (" 2", 2);
+                P ("-1", -1);
+ 
+                Q (" 2", 2);
+                Q ("-1", -1);
+                Q ("        2", 2);
+                Q ("-1     ", -1);
+           END PKG;
+ 
+           PACKAGE PKG1 IS NEW PKG (SUBINT, "SUBINT");
+           PACKAGE PKG2 IS NEW PKG (SINT1, "SINT1");
+           PACKAGE PKG3 IS NEW PKG (INT1, "INT1");
+           PACKAGE PKG4 IS NEW PKG (NEWINT, "NEWINT");
+ 
+      BEGIN
+           NULL;
+      END; -- (C2).
+ 
+      RESULT;
+ END CC1221C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1221d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1221d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,173 ----
+ -- CC1221D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+ --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+ --     WITHIN THE GENERIC UNIT:  EXPLICIT CONVERSION TO AND FROM REAL
+ --     TYPES AND IMPLICIT CONVERSION FROM INTEGER LITERALS.
+ 
+ -- HISTORY:
+ --     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC1221D IS
+ 
+      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+      TYPE INT IS RANGE -300 .. 300;
+      SUBTYPE SINT1 IS INT
+           RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
+      TYPE INT1 IS RANGE -6 .. 6;
+ 
+ BEGIN
+      TEST ( "CC1221D", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                        "DECLARED AND ARE THEREFORE AVAILABLE " &
+                        "WITHIN THE GENERIC UNIT:  EXPLICIT " &
+                        "CONVERSION TO AND FROM REAL TYPES AND " &
+                        "IMPLICIT CONVERSION FROM INTEGER LITERALS");
+ 
+      DECLARE -- (D) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
+              --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
+              --     INTEGER LITERALS.
+ 
+           GENERIC
+                TYPE T IS RANGE <>;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+ 
+                TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
+                FI0  : FIXED := 0.0;
+                FI2  : FIXED := 2.0;
+                FIN2 : FIXED := -2.0;
+ 
+                FL0  : FLOAT := 0.0;
+                FL2  : FLOAT := 2.0;
+                FLN2 : FLOAT := -2.0;
+ 
+                T0  : T := 0;
+                T2  : T := 2;
+                TN2 : T := -2;
+ 
+                FUNCTION IDENT (X : T) RETURN T IS
+                BEGIN
+                     IF EQUAL (3, 3) THEN
+                          RETURN X;
+                     ELSE
+                          RETURN T'FIRST;
+                     END IF;
+                END IDENT;
+ 
+           BEGIN
+                IF T0 + 1 /= 1 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 1" );
+                END IF;
+ 
+                IF T2 + 1 /= 3 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 2" );
+                END IF;
+ 
+                IF TN2 + 1 /= -1 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 3" );
+                END IF;
+ 
+                IF T (FI0) /= T0 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FIXED VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FI2) /= IDENT (T2) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FIXED VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FIN2) /= TN2 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FIXED VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FL0) /= IDENT (T0) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FL2) /= T2 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FLN2) /= IDENT (TN2) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FIXED (T0) /= FI0 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FIXED VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FIXED (IDENT (T2)) /= FI2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FIXED VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FIXED (TN2) /= FIN2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FIXED VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FLOAT (IDENT (T0)) /= FL0 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FLOAT (T2) /= FL2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FLOAT (IDENT (TN2)) /= FLN2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (SUBINT);
+           PROCEDURE P2 IS NEW P (SINT1);
+           PROCEDURE P3 IS NEW P (INT1);
+ 
+      BEGIN
+            P1 ( "SUBINT" );
+            P2 ( "SINT" );
+            P3 ( "INT1" );
+      END; -- (D).
+ 
+      RESULT;
+ END CC1221D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1222a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1222a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1222a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1222a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,290 ----
+ -- CC1222A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- FOR A FORMAL FLOATING POINT TYPE, CHECK THAT THE FOLLOWING BASIC 
+ -- OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+ -- WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS, 
+ -- QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC TYPES, 
+ -- AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL TO THE 
+ -- FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DIGITS, 'MACHINE_RADIX,
+ -- 'MACHINE_MANTISSA, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_ROUNDS,
+ -- 'MACHINE_OVERFLOWS.
+ 
+ -- R.WILLIAMS 9/30/86
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ PROCEDURE CC1222A IS
+ 
+      TYPE NEWFLT IS NEW FLOAT;
+ 
+ BEGIN
+      TEST ( "CC1222A",  "FOR A FORMAL FLOATING POINT TYPE, CHECK " &
+                         "THAT THE BASIC OPERATIONS ARE " &
+                         "IMPLICITLY DECLARED AND ARE THEREFORE " &
+                         "AVAILABLE WITHIN THE GENERIC UNIT" );
+ 
+      DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND 
+              --      QUALIFICATION.
+ 
+           GENERIC
+                TYPE T IS DIGITS <>;
+                TYPE T1 IS DIGITS <>;
+                F  : T;               
+                F1 : T1;
+           PROCEDURE P (F2 : T; STR : STRING);
+ 
+           PROCEDURE P (F2 : T; STR : STRING) IS
+                SUBTYPE ST IS T RANGE -1.0 .. 1.0; 
+                F3, F4  : T;
+ 
+                FUNCTION FUN (X : T) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN IDENT_BOOL (TRUE);
+                END FUN;
+ 
+                FUNCTION FUN (X : T1) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN IDENT_BOOL (FALSE);
+                END FUN;
+ 
+           BEGIN
+                F3 := F;
+                F4 := F2;
+                F3 := F4;
+        
+                IF F3 /= F2 THEN
+                     FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
+                              "WITH TYPE - " & STR);
+                END IF;
+ 
+                IF F IN ST THEN
+                     NULL;
+                ELSE                                        
+                     FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
+                              "TYPE  - " & STR);
+                END IF;
+ 
+                IF F2 NOT IN ST THEN
+                     NULL;
+                ELSE                                        
+                     FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
+                              "TYPE  - " & STR);
+                END IF;
+                
+                IF T'(F) /= F THEN                              
+                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                              "WITH TYPE - " & STR & " - 1" );
+                END IF;
+ 
+                IF FUN (T'(1.0)) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                              "WITH TYPE - " & STR & " - 2" );
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (FLOAT,  FLOAT,  0.0, 0.0);
+           PROCEDURE P2 IS NEW P (NEWFLT, NEWFLT, 0.0, 0.0);
+      
+      BEGIN
+           P1 (2.0, "FLOAT");
+           P2 (2.0, "NEWFLT");
+      END; -- (A).         
+ 
+      DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER 
+              --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM 
+              --     REAL LITERAL.
+ 
+           GENERIC
+                TYPE T IS DIGITS <>;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+ 
+                TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
+                FI0  : FIXED := 0.0;
+                FI2  : FIXED := 2.0;
+                FIN2 : FIXED := -2.0; 
+ 
+                I0  : INTEGER := 0;
+                I2  : INTEGER := 2;
+                IN2 : INTEGER := -2; 
+ 
+                T0  : T := 0.0;
+                T2  : T := 2.0;
+                TN2 : T := -2.0; 
+                
+                FUNCTION IDENT (X : T) RETURN T IS
+                BEGIN
+                     IF EQUAL (3, 3) THEN
+                          RETURN X;
+                     ELSE
+                          RETURN T'FIRST;
+                     END IF;
+                END IDENT;
+ 
+           BEGIN
+                IF T0 + 1.0 /= 1.0 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 1" );
+                END IF;
+ 
+                IF T2 + 1.0 /= 3.0 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 2" );
+                END IF;
+ 
+                IF TN2 + 1.0 /= -1.0 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 3" );
+                END IF;
+ 
+                IF T (FI0) /= T0 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FIXED VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FI2) /= IDENT (T2) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FIXED VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FIN2) /= TN2 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FIXED VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (I0) /= IDENT (T0) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "INTEGER VALUE 0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (I2) /= T2 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "INTEGER VALUE 2 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (IN2) /= IDENT (TN2) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "INTEGER VALUE -2 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FIXED (T0) /= FI0 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FIXED VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FIXED (IDENT (T2)) /= FI2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FIXED VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FIXED (TN2) /= FIN2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FIXED VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF INTEGER (IDENT (T0)) /= I0 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "INTEGER VALUE 0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF INTEGER (T2) /= I2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "INTEGER VALUE 2 WITH TYPE " & STR);
+                END IF;
+ 
+                IF INTEGER (IDENT (TN2)) /= IN2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "INTEGER VALUE -2 WITH TYPE " & STR);
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (FLOAT);
+           PROCEDURE P2 IS NEW P (NEWFLT);
+ 
+      BEGIN
+            P1 ( "FLOAT" );
+            P2 ( "NEWFLT" );
+      END; -- (B).         
+ 
+      DECLARE -- (C) CHECKS FOR ATTRIBUTES.
+ 
+           GENERIC
+                TYPE T IS DIGITS <>;
+                F, L : T;
+                D : INTEGER;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+ 
+                F1 : T;
+                A  : ADDRESS := F'ADDRESS;
+                S  : INTEGER := F'SIZE;
+ 
+                I  : INTEGER;
+                I1 : INTEGER := T'MACHINE_RADIX;
+                I2 : INTEGER := T'MACHINE_MANTISSA;
+                I3 : INTEGER := T'MACHINE_EMAX;
+                I4 : INTEGER := T'MACHINE_EMIN;
+ 
+                B1 : BOOLEAN := T'MACHINE_ROUNDS;
+                B2 : BOOLEAN := T'MACHINE_OVERFLOWS;
+ 
+           BEGIN
+                IF T'DIGITS /= D THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                               STR & "'DIGITS" );
+                END IF;
+ 
+                IF T'FIRST /= F THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                               STR & "'FIRST" );
+                END IF;
+ 
+                IF T'LAST /= L THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                               STR & "'LAST" );
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS 
+                NEW P (FLOAT, FLOAT'FIRST, FLOAT'LAST, FLOAT'DIGITS);
+           PROCEDURE P2 IS 
+                NEW P (NEWFLT, NEWFLT'FIRST, NEWFLT'LAST, 
+                       NEWFLT'DIGITS);
+ 
+      BEGIN
+            P1 ( "FLOAT" );
+            P2 ( "NEWFLT" );
+      END; -- (C).         
+ 
+      RESULT;
+ END CC1222A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1223a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1223a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1223a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1223a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,297 ----
+ -- CC1223A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR A FORMAL FIXED POINT TYPE, CHECK THAT THE FOLLOWING BASIC
+ --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+ --     WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS,
+ --     QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC
+ --     TYPES, AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL
+ --     TO THE FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DELTA, 'FORE, 
+ --     'AFT, 'MACHINE_ROUNDS, 'MACHINE_OVERFLOWS.
+ 
+ -- HISTORY:
+ --     RJW 09/30/86  CREATED ORIGINAL TEST.
+ --     JLH 09/25/87  REFORMATTED HEADER.
+ --     RJW 08/21/89  MODIFIED CHECKS FOR 'MANTISSA AND 'AFT.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM; USE SYSTEM;
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1223A IS
+ 
+      TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
+ 
+ BEGIN
+      TEST ( "CC1223A",  "FOR A FORMAL FIXED POINT TYPE, CHECK " &
+                         "THAT THE BASIC OPERATIONS ARE " &
+                         "IMPLICITLY DECLARED AND ARE THEREFORE " &
+                         "AVAILABLE WITHIN THE GENERIC UNIT" );
+ 
+      DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND
+              --      QUALIFICATION.
+ 
+           GENERIC
+                TYPE T IS DELTA <>;
+                TYPE T1 IS DELTA <>;
+                F  : T;
+                F1 : T1;
+           PROCEDURE P (F2 : T; STR : STRING);
+ 
+           PROCEDURE P (F2 : T; STR : STRING) IS
+                SUBTYPE ST IS T RANGE -1.0 .. 1.0;
+                F3, F4  : T;
+ 
+                FUNCTION FUN (X : T) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN IDENT_BOOL (TRUE);
+                END FUN;
+ 
+                FUNCTION FUN (X : T1) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN IDENT_BOOL (FALSE);
+                END FUN;
+ 
+           BEGIN
+                F3 := F;
+                F4 := F2;
+                F3 := F4;
+ 
+                IF F3 /= F2 THEN
+                     FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
+                              "WITH TYPE - " & STR);
+                END IF;
+ 
+                IF F IN ST THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
+                              "TYPE  - " & STR);
+                END IF;
+ 
+                IF F2 NOT IN ST THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
+                              "TYPE  - " & STR);
+                END IF;
+ 
+                IF T'(F) /= F THEN
+                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                              "WITH TYPE - " & STR & " - 1" );
+                END IF;
+ 
+                IF FUN (T'(1.0)) THEN
+                     NULL;
+                ELSE
+                     FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                              "WITH TYPE - " & STR & " - 2" );
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (FIXED, FIXED, 0.0, 0.0);
+           PROCEDURE P2 IS NEW P (DURATION, DURATION, 0.0, 0.0);
+ 
+      BEGIN
+           P1 (2.0, "FIXED");
+           P2 (2.0, "DURATION");
+      END; -- (A).
+ 
+      DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
+              --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
+              --     REAL LITERAL.
+ 
+           GENERIC
+                TYPE T IS DELTA <>;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+ 
+                FL0  : FLOAT := 0.0;
+                FL2  : FLOAT := 2.0;
+                FLN2 : FLOAT := -2.0;
+ 
+                I0  : INTEGER := 0;
+                I2  : INTEGER := 2;
+                IN2 : INTEGER := -2;
+ 
+                T0  : T := 0.0;
+                T2  : T := 2.0;
+                TN2 : T := -2.0;
+ 
+                FUNCTION IDENT (X : T) RETURN T IS
+                BEGIN
+                     IF EQUAL (3, 3) THEN
+                          RETURN X;
+                     ELSE
+                          RETURN T'FIRST;
+                     END IF;
+                END IDENT;
+ 
+           BEGIN
+                IF T0 + 1.0 /= 1.0 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 1" );
+                END IF;
+ 
+                IF T2 + 1.0 /= 3.0 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 2" );
+                END IF;
+ 
+                IF TN2 + 1.0 /= -1.0 THEN
+                     FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                              "CONVERSION WITH TYPE " & STR & " - 3" );
+                END IF;
+ 
+                IF T (FL0) /= T0 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FL2) /= IDENT (T2) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (FLN2) /= TN2 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (I0) /= IDENT (T0) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "INTEGER VALUE 0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (I2) /= T2 THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "INTEGER VALUE 2 WITH TYPE " & STR);
+                END IF;
+ 
+                IF T (IN2) /= IDENT (TN2) THEN
+                     FAILED ( "INCORRECT CONVERSION FROM " &
+                              "INTEGER VALUE -2 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FLOAT (T0) /= FL0 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FLOAT VALUE 0.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FLOAT (IDENT (T2)) /= FL2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FLOAT VALUE 2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF FLOAT (TN2) /= FLN2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "FLOAT VALUE -2.0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF INTEGER (IDENT (T0)) /= I0 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "INTEGER VALUE 0 WITH TYPE " & STR);
+                END IF;
+ 
+                IF INTEGER (T2) /= I2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "INTEGER VALUE 2 WITH TYPE " & STR);
+                END IF;
+ 
+                IF INTEGER (IDENT (TN2)) /= IN2 THEN
+                     FAILED ( "INCORRECT CONVERSION TO " &
+                              "INTEGER VALUE -2 WITH TYPE " & STR);
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS NEW P (FIXED);
+           PROCEDURE P2 IS NEW P (DURATION);
+ 
+      BEGIN
+            P1 ( "FIXED" );
+            P2 ( "DURATION" );
+      END; -- (B).
+ 
+      DECLARE -- (C) CHECKS FOR ATTRIBUTES.
+ 
+           GENERIC
+                TYPE T IS DELTA <>;
+                F, L, D : T;
+           PROCEDURE P (STR : STRING);
+ 
+           PROCEDURE P (STR : STRING) IS
+ 
+                F1 : T;
+                A  : ADDRESS := F'ADDRESS;
+                S  : INTEGER := F'SIZE;
+ 
+                I  : INTEGER;
+ 
+                B1 : BOOLEAN := T'MACHINE_ROUNDS;
+                B2 : BOOLEAN := T'MACHINE_OVERFLOWS;
+ 
+           BEGIN
+                IF T'DELTA /= D THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                               STR & "'DELTA" );
+                END IF;
+ 
+                IF T'FIRST /= F THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                               STR & "'FIRST" );
+                END IF;
+ 
+                IF T'LAST /= L THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                               STR & "'LAST" );
+                END IF;
+ 
+                IF T'FORE < 2 THEN
+                     FAILED ( "INCORRECT VALUE FOR " &
+                               STR & "'FORE" );
+                END IF;
+ 
+                IF T'AFT <= 0 THEN
+                     FAILED ( "INCORRECT VALUE FOR " & STR & "'AFT" );
+                END IF;
+ 
+           END P;
+ 
+           PROCEDURE P1 IS
+                NEW P (FIXED, FIXED'FIRST, FIXED'LAST, FIXED'DELTA);
+           PROCEDURE P2 IS
+                NEW P (DURATION, DURATION'FIRST, DURATION'LAST,
+                       DURATION'DELTA);
+ 
+      BEGIN
+            P1 ( "FIXED" );
+            P2 ( "DURATION" );
+      END; -- (C).
+ 
+      RESULT;
+ END CC1223A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1224a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1224a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1224a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1224a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,558 ----
+ -- CC1224A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR ARRAY TYPES WITH A NONLIMITED COMPONENT TYPE (OF A FORMAL
+ --     AND NONFORMAL GENERIC TYPE), CHECK THAT THE FOLLOWING OPERATIONS
+ --     ARE IMPLICITY DECLARED AND ARE, THEREFORE, AVAILABLE WITHIN THE
+ --     GENERIC UNIT: ASSIGNMENT, THE OPERATION ASSOCIATED WITH
+ --     AGGREGATE NOTATION, MEMBERSHIP TESTS, THE OPERATION ASSOCIATED
+ --     WITH INDEXED COMPONENTS, QUALIFICATION, EXPLICIT CONVERSION,
+ --     'SIZE, 'ADDRESS, 'FIRST, 'FIRST (N), 'LAST, 'LAST (N),
+ --     'RANGE, 'RANGE (N), 'LENGTH, 'LENGTH (N).
+ 
+ -- HISTORY:
+ --     R.WILLIAMS  10/6/86
+ --     EDWARD V. BERARD  8/10/90  ADDED CHECKS FOR MULTI-DIMENSIONAL
+ --                                ARRAYS
+ --     LDC  10/10/90  CHANGED DECLARATIONS OF AD1 - AD6 TO PROCEDURE
+ --                    CALLS OF FA1 - FA6 TO ADDRESS_CHECK AS SUGGESTED
+ --                    BY THE CRG. 
+ --     PWN  01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH SYSTEM ;
+ WITH REPORT ;
+ 
+ PROCEDURE CC1224A IS
+ 
+      SHORT_START : CONSTANT := -10 ;
+      SHORT_END   : CONSTANT := 10 ;
+ 
+      TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+      SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
+ 
+      MEDIUM_START    : CONSTANT := 1 ;
+      MEDIUM_END      : CONSTANT := 15 ;
+ 
+      TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
+      MEDIUM_LENGTH   : CONSTANT NATURAL := 
+                                 (MEDIUM_END - MEDIUM_START + 1) ;
+ 
+      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                          SEP, OCT, NOV, DEC) ;
+      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+      TYPE DATE IS RECORD
+           MONTH : MONTH_TYPE ;
+           DAY   : DAY_TYPE ;
+           YEAR  : YEAR_TYPE ;
+      END RECORD ;
+ 
+      TODAY : DATE := (AUG, 10, 1990) ;
+ 
+      TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
+                                    MEDIUM_RANGE RANGE <>) OF DATE ;
+ 
+      TYPE SECOND_TEMPLATE IS ARRAY (SHORT_RANGE, MEDIUM_RANGE) 
+                                    OF DATE ;
+ 
+      FIRST_ARRAY     : FIRST_TEMPLATE (-10 .. 10, 6 .. 10) ;
+      SECOND_ARRAY    : FIRST_TEMPLATE (0 .. 7, 1 .. 15) ;
+      THIRD_ARRAY     : SECOND_TEMPLATE ;
+      FOURTH_ARRAY    : SECOND_TEMPLATE ;
+ 
+      SUBTYPE SUBINT IS INTEGER RANGE REPORT.IDENT_INT (1) .. 
+                                      REPORT.IDENT_INT (6);
+ 
+      TYPE ARRA IS ARRAY (SUBINT) OF SUBINT;
+      A1 : ARRA := (REPORT.IDENT_INT (1) .. REPORT.IDENT_INT (6) => 1);
+      A2 : ARRA := (A1'RANGE => 2);
+ 
+      TYPE ARRB IS ARRAY (SUBINT RANGE <>) OF DATE ;
+      A3 : ARRB (1 .. 6) := 
+                (REPORT.IDENT_INT (1) .. REPORT.IDENT_INT (6) => TODAY);
+ 
+      TYPE ARRC IS ARRAY (SUBINT RANGE <>, SUBINT RANGE <>) OF SUBINT;
+      A4 : CONSTANT ARRC := (1 .. 6 => (1 .. 6 => 4));
+ 
+      TYPE ARRD IS ARRAY (SUBINT, SUBINT) OF SUBINT;
+      A5 : ARRD := (A4'RANGE (1) => (A4'RANGE (2) => 5));
+ 
+      TYPE ARRE IS ARRAY (SUBINT) OF DATE ;
+      A6 : ARRE := (A1'RANGE => TODAY);
+ 
+      FUNCTION "=" (LEFT  : IN SYSTEM.ADDRESS ;
+                    RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN
+               RENAMES SYSTEM."=" ;
+ 
+      GENERIC
+ 
+           TYPE T1 IS (<>);
+           TYPE T2 IS PRIVATE;
+           X2 : T2;
+ 
+           TYPE FARR1 IS ARRAY (SUBINT) OF T1;
+           FA1 : FARR1;
+ 
+           TYPE FARR2 IS ARRAY (SUBINT) OF SUBINT;
+           FA2 : FARR2;
+ 
+           TYPE FARR3 IS ARRAY (SUBINT RANGE <>) OF T2;
+           FA3 : FARR3;
+ 
+           TYPE FARR4 IS ARRAY (SUBINT RANGE <>, SUBINT RANGE <>) OF T1;
+           FA4 : FARR4;
+ 
+           TYPE FARR5 IS ARRAY (SUBINT, SUBINT) OF SUBINT;
+           FA5 : FARR5;
+ 
+           TYPE FARR6 IS ARRAY (T1) OF T2;
+           FA6 : FARR6;
+ 
+           TYPE FARR7 IS ARRAY (T1) OF T2;
+           FA7 : FARR7;
+ 
+      PROCEDURE P ;
+ 
+      GENERIC
+ 
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE UNCONSTRAINED_ARRAY IS ARRAY 
+                (FIRST_INDEX RANGE <>, SECOND_INDEX RANGE <>) OF DATE ;
+ 
+      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                                FFIFS        : IN FIRST_INDEX ;
+                                FFILS        : IN FIRST_INDEX ;
+                                FSIFS        : IN SECOND_INDEX ;
+                                FSILS        : IN SECOND_INDEX ;
+                                FFLEN        : IN NATURAL ;
+                                FSLEN        : IN NATURAL ;
+                                FFIRT        : IN FIRST_INDEX ;
+                                FSIRT        : IN SECOND_INDEX ;
+                                SECOND       : IN UNCONSTRAINED_ARRAY ;
+                                SFIFS        : IN FIRST_INDEX ;
+                                SFILS        : IN FIRST_INDEX ;
+                                SSIFS        : IN SECOND_INDEX ;
+                                SSILS        : IN SECOND_INDEX ;
+                                SFLEN        : IN NATURAL ;
+                                SSLEN        : IN NATURAL ;
+                                SFIRT        : IN FIRST_INDEX ;
+                                SSIRT        : IN SECOND_INDEX ;
+                                REMARKS      : IN STRING) ;
+      GENERIC
+ 
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           TYPE CONSTRAINED_ARRAY IS ARRAY 
+                (FIRST_INDEX,SECOND_INDEX) OF COMPONENT_TYPE ;
+ 
+      PROCEDURE CTEST_PROCEDURE (FIRST        : IN CONSTRAINED_ARRAY ;
+                                 FFIRT        : IN FIRST_INDEX ;
+                                 FSIRT        : IN SECOND_INDEX ;
+                                 SECOND       : IN CONSTRAINED_ARRAY ;
+                                 SFIRT        : IN FIRST_INDEX ;
+                                 SSIRT        : IN SECOND_INDEX ;
+                                 REMARKS      : IN STRING) ;
+ 
+ 
+      PROCEDURE P IS
+ 
+           IN1 : INTEGER := FA1'SIZE;
+           IN2 : INTEGER := FA2'SIZE;
+           IN3 : INTEGER := FA3'SIZE;
+           IN4 : INTEGER := FA4'SIZE;
+           IN5 : INTEGER := FA5'SIZE;
+           IN6 : INTEGER := FA6'SIZE;
+ 
+           B1 : FARR1;
+ 
+           B2 : FARR2;
+ 
+           SUBTYPE SARR3 IS FARR3 (FA3'RANGE);
+           B3 : SARR3;
+ 
+           SUBTYPE SARR4 IS FARR4 (FA4'RANGE (1), FA4'RANGE (2));
+           B4 : SARR4;
+ 
+           B5 : FARR5;
+ 
+           B6 : FARR6 ;
+ 
+           PROCEDURE ADDRESS_CHECK(ADDRESS : SYSTEM.ADDRESS) IS
+ 
+           BEGIN
+                IF REPORT.EQUAL(1, REPORT.IDENT_INT(2)) THEN
+                     REPORT.COMMENT("DON'T OPTIMIZE OUT ADDRESS_CHECK");
+                END IF;
+           END ADDRESS_CHECK;
+ 
+      BEGIN  -- P
+ 
+           ADDRESS_CHECK(FA1'ADDRESS);
+           ADDRESS_CHECK(FA2'ADDRESS);
+           ADDRESS_CHECK(FA3'ADDRESS);
+           ADDRESS_CHECK(FA4'ADDRESS);
+           ADDRESS_CHECK(FA5'ADDRESS);
+           ADDRESS_CHECK(FA6'ADDRESS);
+ 
+           B1 := FA1;
+ 
+           IF B1 /= FARR1 (FA1) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 1" );
+           END IF;
+ 
+           B2 := FA2;
+ 
+           IF B2 /= FARR2 (A2) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 2" );
+           END IF;
+ 
+           B3 := FA3;
+ 
+           IF B3 /= FARR3 (FA3) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 3" );
+           END IF;
+ 
+           B4 := FA4;
+ 
+           IF B4 /= FARR4 (FA4) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 4" );
+           END IF;
+ 
+           B5 := FA5;
+ 
+           IF B5 /= FARR5 (A5) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 5" );
+           END IF;
+ 
+           B6 := FA6;
+ 
+           IF B6 /= FARR6 (FA6) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 6" );
+           END IF;
+ 
+           IF FA7 /= FARR7 (FA6) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 7" );
+           END IF;
+ 
+           B1 := FARR1'(FA1'RANGE => T1'VAL (1));
+ 
+           IF B1 (1) /= FA1 (1) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 8" );
+           END IF;
+ 
+           B1 := FARR1'(1 => T1'VAL (1), 2 => T1'VAL (1), 
+                        3 .. 6 => T1'VAL (2));
+ 
+           IF B1 (1) /= FA1 (1) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 9" );
+           END IF;
+ 
+           B2 := FARR2'(FA2'RANGE => 2);
+ 
+           IF B2 (2) /= FA2 (2) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 10" );
+           END IF;
+ 
+           B3 := FARR3'(1|2|3 => X2, 4|5|6 => X2);
+ 
+           IF B3 (3) /= FA3 (3) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 11" );
+           END IF;
+ 
+           B4 := FARR4'(FA5'RANGE (1) => (FA5'RANGE (2) => T1'VAL (4)));
+ 
+           IF B4 (4, 4) /= FA4 (4, 4) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 12" );
+           END IF;
+ 
+           B5 := FARR5'(REPORT.IDENT_INT (1) .. 
+                        REPORT.IDENT_INT (6) =>  (1 .. 6 => 5));
+ 
+           IF B5 (5, 5) /= FA5 (5, 5) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 13" );
+           END IF;
+ 
+           B6 := FARR6'(FA6'RANGE => X2);
+ 
+           IF B6 (T1'FIRST) /= FA6 (T1'FIRST) THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 14" );
+           END IF;
+ 
+           IF B1 NOT IN FARR1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 15" );
+           END IF;
+ 
+           IF FA2 NOT IN FARR2 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 16" );
+           END IF;
+ 
+           IF FA3 NOT IN FARR3 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 17" );
+           END IF;
+ 
+           IF B4 NOT IN FARR4 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 18" );
+           END IF;
+ 
+           IF B5 NOT IN FARR5 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 19" );
+           END IF;
+ 
+           IF FA6 NOT IN FARR6 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 20" );
+           END IF;
+ 
+           IF FA1'LENGTH /= FA1'LAST - FA1'FIRST + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 27" );
+           END IF;
+ 
+           IF FA2'LENGTH /= FA2'LAST - FA2'FIRST + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 28" );
+           END IF;
+ 
+           IF FA3'LENGTH /= FA3'LAST - FA3'FIRST + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 29" );
+           END IF;
+ 
+           IF FA4'LENGTH /= FA4'LAST - FA4'FIRST + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 30" );
+           END IF;
+ 
+           IF FA4'LENGTH (2) /= FA4'LAST (2) - FA4'FIRST (2) + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 31" );
+           END IF;
+ 
+           IF FA5'LENGTH /= FA5'LAST - FA5'FIRST + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 32" );
+           END IF;
+ 
+           IF FA5'LENGTH (2) /= FA5'LAST (2) - FA5'FIRST (2) + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 33" );
+           END IF;
+ 
+           IF FA6'LENGTH /= T1'POS (FA6'LAST) - 
+              T1'POS (FA6'FIRST) + 1 THEN
+                REPORT.FAILED ("INCORRECT RESULTS - 34" );
+           END IF;
+ 
+      END P ;
+ 
+      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                                FFIFS        : IN FIRST_INDEX ;
+                                FFILS        : IN FIRST_INDEX ;
+                                FSIFS        : IN SECOND_INDEX ;
+                                FSILS        : IN SECOND_INDEX ;
+                                FFLEN        : IN NATURAL ;
+                                FSLEN        : IN NATURAL ;
+                                FFIRT        : IN FIRST_INDEX ;
+                                FSIRT        : IN SECOND_INDEX ;
+                                SECOND       : IN UNCONSTRAINED_ARRAY ;
+                                SFIFS        : IN FIRST_INDEX ;
+                                SFILS        : IN FIRST_INDEX ;
+                                SSIFS        : IN SECOND_INDEX ;
+                                SSILS        : IN SECOND_INDEX ;
+                                SFLEN        : IN NATURAL ;
+                                SSLEN        : IN NATURAL ;
+                                SFIRT        : IN FIRST_INDEX ;
+                                SSIRT        : IN SECOND_INDEX ;
+                                REMARKS      : IN STRING) IS
+ 
+      BEGIN -- TEST_PROCEDURE
+ 
+           IF (FIRST'FIRST /= FFIFS) OR
+              (FIRST'FIRST (1) /= FFIFS) OR
+              (FIRST'FIRST (2) /= FSIFS) OR
+              (SECOND'FIRST /= SFIFS) OR
+              (SECOND'FIRST (1) /= SFIFS) OR
+              (SECOND'FIRST (2) /= SSIFS) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FIRST'LAST /= FFILS) OR
+              (FIRST'LAST (1) /= FFILS) OR
+              (FIRST'LAST (2) /= FSILS) OR
+              (SECOND'LAST /= SFILS) OR
+              (SECOND'LAST (1) /= SFILS) OR
+              (SECOND'LAST (2) /= SSILS) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FIRST'LENGTH /= FFLEN) OR
+              (FIRST'LENGTH (1) /= FFLEN) OR
+              (FIRST'LENGTH (2) /= FSLEN) OR
+              (SECOND'LENGTH /= SFLEN) OR
+              (SECOND'LENGTH (1) /= SFLEN) OR
+              (SECOND'LENGTH (2) /= SSLEN) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FFIRT NOT IN FIRST'RANGE (1)) OR
+              (FFIRT NOT IN FIRST'RANGE) OR
+              (SFIRT NOT IN SECOND'RANGE (1)) OR
+              (SFIRT NOT IN SECOND'RANGE) OR
+              (FSIRT NOT IN FIRST'RANGE (2)) OR
+              (SSIRT NOT IN SECOND'RANGE (2)) THEN
+                REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
+                               REMARKS) ;
+           END IF ;
+ 
+      END TEST_PROCEDURE ;
+ 
+      PROCEDURE CTEST_PROCEDURE (FIRST        : IN CONSTRAINED_ARRAY ;
+                                 FFIRT        : IN FIRST_INDEX ;
+                                 FSIRT        : IN SECOND_INDEX ;
+                                 SECOND       : IN CONSTRAINED_ARRAY ;
+                                 SFIRT        : IN FIRST_INDEX ;
+                                 SSIRT        : IN SECOND_INDEX ;
+                                 REMARKS      : IN STRING) IS
+ 
+      BEGIN -- CTEST_PROCEDURE
+ 
+           IF (FIRST'FIRST /= FIRST_INDEX'FIRST) OR
+              (FIRST'FIRST (1) /= FIRST_INDEX'FIRST) OR
+              (FIRST'FIRST (2) /= SECOND_INDEX'FIRST) OR
+              (SECOND'FIRST /= FIRST_INDEX'FIRST) OR
+              (SECOND'FIRST (1) /= FIRST_INDEX'FIRST) OR
+              (SECOND'FIRST (2) /= SECOND_INDEX'FIRST) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FIRST'LAST /= FIRST_INDEX'LAST) OR
+              (FIRST'LAST (1) /= FIRST_INDEX'LAST) OR
+              (FIRST'LAST (2) /= SECOND_INDEX'LAST) OR
+              (SECOND'LAST /= FIRST_INDEX'LAST) OR
+              (SECOND'LAST (1) /= FIRST_INDEX'LAST) OR
+              (SECOND'LAST (2) /= SECOND_INDEX'LAST) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FIRST'LENGTH /=
+               FIRST_INDEX'POS (FIRST_INDEX'LAST)
+               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+              (FIRST'LENGTH (1) /= 
+               FIRST_INDEX'POS (FIRST_INDEX'LAST)
+               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+              (FIRST'LENGTH (2) /=
+               SECOND_INDEX'POS (SECOND_INDEX'LAST)
+               - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) OR
+              (SECOND'LENGTH /= 
+               FIRST_INDEX'POS (FIRST_INDEX'LAST)
+               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+              (SECOND'LENGTH (1) /=
+               FIRST_INDEX'POS (FIRST_INDEX'LAST)
+               - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+              (SECOND'LENGTH (2) /=
+               SECOND_INDEX'POS (SECOND_INDEX'LAST)
+               - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) THEN
+                REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
+           END IF ;
+ 
+           IF (FFIRT NOT IN FIRST'RANGE (1)) OR
+              (FFIRT NOT IN FIRST'RANGE) OR
+              (SFIRT NOT IN SECOND'RANGE (1)) OR
+              (SFIRT NOT IN SECOND'RANGE) OR
+              (FSIRT NOT IN FIRST'RANGE (2)) OR
+              (SSIRT NOT IN SECOND'RANGE (2)) THEN
+                 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
+                                REMARKS) ;
+           END IF ;
+ 
+           IF CONSTRAINED_ARRAY'SIZE <= 0 THEN
+                REPORT.FAILED ("PROBLEMS WITH THE 'SIZE ATTRIBUTE. " &
+                               REMARKS) ;
+           END IF ;
+ 
+           IF FIRST'ADDRESS = SECOND'ADDRESS THEN
+                REPORT.FAILED ("PROBLEMS WITH THE 'ADDRESS ATTRIBUTE. " &
+                               REMARKS) ;
+           END IF ;
+ 
+      END CTEST_PROCEDURE ;
+ 
+      PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE 
+                (FIRST_INDEX            => SHORT_RANGE,
+                 SECOND_INDEX           => MEDIUM_RANGE,
+                 UNCONSTRAINED_ARRAY    => FIRST_TEMPLATE) ;
+ 
+      PROCEDURE NEW_CTEST_PROCEDURE IS NEW CTEST_PROCEDURE 
+                (FIRST_INDEX           => SHORT_RANGE,
+                 SECOND_INDEX          => MEDIUM_RANGE,
+                 COMPONENT_TYPE        => DATE,
+                 CONSTRAINED_ARRAY     => SECOND_TEMPLATE) ;
+ 
+      PROCEDURE NP IS NEW P (SUBINT, DATE, TODAY, ARRA, A1, 
+                             ARRA, A2, ARRB, A3, ARRC, A4, ARRD,
+                             A5, ARRE, A6, ARRE, A6);
+ 
+ BEGIN  -- CC1224A
+ 
+      REPORT.TEST ("CC1224A", "FOR ARRAY TYPES WITH A NONLIMITED " &
+                   "COMPONENT TYPE (OF A FORMAL AND NONFORMAL GENERIC " &
+                   "TYPE), CHECK THAT THE FOLLOWING OPERATIONS " &
+                   "ARE IMPLICITY DECLARED AND ARE, THEREFORE, " &
+                   "AVAILABLE WITHIN THE GENERIC -- UNIT: " &
+                   "ASSIGNMENT, THE OPERATION ASSOCIATED WITH " &
+                   "AGGREGATE NOTATION, MEMBERSHIP TESTS, THE " &
+                   "OPERATION ASSOCIATED WITH INDEXED " &
+                   "COMPONENTS, QUALIFICATION, EXPLICIT " &
+                   "CONVERSION, 'SIZE, 'ADDRESS, 'FIRST, " &
+                   "'FIRST (N), 'LAST, 'LAST (N), 'RANGE, " &
+                   "'RANGE (N), 'LENGTH, 'LENGTH (N)" ) ;
+ 
+      NP ;
+ 
+      FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
+                            FFIFS        => -10,
+                            FFILS        => 10,
+                            FSIFS        => 6,
+                            FSILS        => 10,
+                            FFLEN        => 21,
+                            FSLEN        => 5,
+                            FFIRT        => 0,
+                            FSIRT        => 8,
+                            SECOND       => SECOND_ARRAY,
+                            SFIFS        => 0,
+                            SFILS        => 7,
+                            SSIFS        => 1,
+                            SSILS        => 15,
+                            SFLEN        => 8,
+                            SSLEN        => 15,
+                            SFIRT        => 5,
+                            SSIRT        => 13,
+                            REMARKS      => "FIRST_TEST_PROCEDURE") ;
+ 
+      NEW_CTEST_PROCEDURE (FIRST         => THIRD_ARRAY,
+                           FFIRT         => -5,
+                           FSIRT         => 11,
+                           SECOND        => FOURTH_ARRAY,
+                           SFIRT         => 0,
+                           SSIRT         => 14,
+                           REMARKS       => "NEW_CTEST_PROCEDURE") ;
+ 
+      REPORT.RESULT ;
+ 
+ END CC1224A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1225a.tst gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1225a.tst
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1225a.tst	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1225a.tst	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,350 ----
+ -- CC1225A.TST
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, FOR A FORMAL ACCESS TYPE, THAT ALL ALLOWABLE OPERATIONS
+ --     ARE IMPLICITLY DECLARED.
+ 
+ -- MACRO SUBSTITUTION:
+ --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+ --     THE ACTIVATION OF A TASK.
+ 
+ -- HISTORY:
+ --     BCB 03/29/88  CREATED ORIGINAL TEST.
+ --     RDH 04/09/90  ADDED 'STORAGE_SIZE CLAUSES.  CHANGED EXTENSION TO
+ --                   'TST'.
+ --     LDC 09/26/90  REMOVED 'USE PACK' AFTER THE WITH SINCE IT ISN'T 
+ --                   NEEDED, ADDED CHECK FOR NULL AFTER ASSIGMENT TO
+ --                   NULL, ADDED CHECKS FOR OTHER RELATION OPERATORS,
+ --                   CHANGED CHECK FOR 'ADDRESS TO A PROCEDURE CALL.
+ --     LDC 10/13/90  CHANGED CHECK FOR 'SIZE TO ONLY CHECK FOR 
+ --                   AVAILABILITY.  CHANGED CHECK FOR 'ADDRESS TO A 
+ --                   MEMBERSHIP TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ 
+ PROCEDURE CC1225A IS
+ 
+      TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+ 
+      TYPE AI IS ACCESS INTEGER;
+ 
+      TYPE ACCINTEGER IS ACCESS INTEGER;
+ 
+      TYPE REC IS RECORD
+           COMP : INTEGER;
+      END RECORD;
+ 
+      TYPE DISCREC (DISC : INTEGER := 1) IS RECORD
+           COMPD : INTEGER;
+      END RECORD;
+ 
+      TYPE AREC IS ACCESS REC;
+ 
+      TYPE ADISCREC IS ACCESS DISCREC;
+ 
+      TYPE ARR IS ARRAY(1..2,1..2) OF INTEGER;
+ 
+      TYPE ONEDIM IS ARRAY(1..10) OF INTEGER;
+ 
+      TYPE AA IS ACCESS ARR;
+ 
+      TYPE AONEDIM IS ACCESS ONEDIM;
+ 
+      TYPE ENUM IS (ONE, TWO, THREE);
+ 
+      TASK TYPE T IS
+           ENTRY HERE(VAL : IN OUT INTEGER);
+      END T;
+ 
+      TYPE ATASK IS ACCESS T;
+ 
+      TYPE ANOTHERTASK IS ACCESS T;
+      FOR ANOTHERTASK'STORAGE_SIZE USE 2 * TASK_STORAGE_SIZE;
+ 
+      TASK TYPE T1 IS
+           ENTRY HERE1(ENUM)(VAL1 : IN OUT INTEGER);
+      END T1;
+ 
+      TYPE ATASK1 IS ACCESS T1;
+ 
+      TASK BODY T IS
+      BEGIN
+           ACCEPT HERE(VAL : IN OUT INTEGER) DO
+                VAL := VAL * 2;
+           END HERE;
+      END T;
+ 
+      TASK BODY T1 IS
+      BEGIN
+           SELECT
+                ACCEPT HERE1(ONE)(VAL1 : IN OUT INTEGER) DO
+                     VAL1 := VAL1 * 1;
+                END HERE1;
+           OR
+                ACCEPT HERE1(TWO)(VAL1 : IN OUT INTEGER) DO
+                     VAL1 := VAL1 * 2;
+                END HERE1;
+           OR
+                ACCEPT HERE1(THREE)(VAL1 : IN OUT INTEGER) DO
+                     VAL1 := VAL1 * 3;
+                END HERE1;
+           END SELECT;
+      END T1;
+ 
+      GENERIC
+           TYPE FORM IS (<>);
+           TYPE ACCFORM IS ACCESS FORM;
+           TYPE ACC IS ACCESS INTEGER;
+           TYPE ACCREC IS ACCESS REC;
+           TYPE ACCDISCREC IS ACCESS DISCREC;
+           TYPE ACCARR IS ACCESS ARR;
+           TYPE ACCONE IS ACCESS ONEDIM;
+           TYPE ACCTASK IS ACCESS T;
+           TYPE ACCTASK1 IS ACCESS T1;
+           TYPE ANOTHERTASK1 IS ACCESS T;
+      PACKAGE P IS
+      END P;
+ 
+      PACKAGE BODY P IS
+           AF : ACCFORM;
+           TYPE DER_ACC IS NEW ACC;
+           A, B : ACC;
+           DERA : DER_ACC;
+           R : ACCREC;
+           DR : ACCDISCREC;
+           C : ACCARR;
+           D, E : ACCONE;
+           F : ACCTASK;
+           G : ACCTASK1;
+           INT : INTEGER := 5;
+ 
+      BEGIN
+           TEST ("CC1225A", "CHECK, FOR A FORMAL ACCESS TYPE, THAT " &
+                            "ALL ALLOWABLE OPERATIONS ARE IMPLICITLY " &
+                            "DECLARED");
+ 
+           IF AF'ADDRESS NOT IN ADDRESS THEN
+                FAILED ("IMPROPER RESULT FROM AF'ADDRESS TEST");
+           END IF;
+ 
+           DECLARE
+                AF_SIZE : INTEGER := ACCFORM'SIZE;
+           BEGIN
+                IF AF_SIZE NOT IN INTEGER THEN
+                     FAILED ("IMPROPER RESULT FROM AF'SIZE");
+                END IF;
+           END;
+ 
+           IF ANOTHERTASK1'STORAGE_SIZE < TASK_STORAGE_SIZE THEN
+                FAILED ("IMPROPER VALUE FOR ANOTHERTASK1'STORAGE_SIZE");
+           END IF;
+ 
+           B := NEW INTEGER'(25);
+ 
+           A := B;
+ 
+           IF A.ALL /= 25 THEN
+                FAILED ("IMPROPER VALUE FOR ASSIGNMENT OF VARIABLE " &
+                        "OF A FORMAL ACCESS TYPE FROM ANOTHER " &
+                        "VARIABLE OF A FORMAL ACCESS TYPE");
+           END IF;
+ 
+           A := NEW INTEGER'(10);
+ 
+           IF A.ALL /= 10 THEN
+                FAILED ("IMPROPER VALUE FOR VARIABLE OF FORMAL ACCESS " &
+                        "TYPE");
+           END IF;
+ 
+           IF A NOT IN ACC THEN
+                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+           END IF;
+ 
+           B := ACC'(A);
+ 
+           IF B.ALL /= 10 THEN
+                FAILED ("IMPROPER VALUE FROM QUALIFICATION");
+           END IF;
+ 
+           DERA := NEW INTEGER'(10);
+           A := ACC(DERA);
+ 
+           IF A.ALL /= IDENT_INT(10) THEN
+                FAILED ("IMPROPER VALUE FROM EXPLICIT CONVERSION");
+           END IF;
+ 
+           IF A.ALL > IDENT_INT(10) THEN
+                FAILED ("IMPROPER VALUE USED IN LESS THAN");
+           END IF;
+ 
+           IF A.ALL < IDENT_INT(10) THEN
+                FAILED ("IMPROPER VALUE USED IN GREATER THAN");
+           END IF;
+ 
+           IF A.ALL >= IDENT_INT(11) THEN
+                FAILED ("IMPROPER VALUE USED IN LESS THAN OR EQUAL");
+           END IF;
+ 
+           IF A.ALL <= IDENT_INT(9) THEN
+                FAILED ("IMPROPER VALUE USED IN GREATER THAN OR EQUAL");
+           END IF;
+ 
+           IF NOT (A.ALL + A.ALL = IDENT_INT(20)) THEN
+                FAILED ("IMPROPER VALUE FROM ADDITION");
+           END IF;
+ 
+           IF NOT (A.ALL - IDENT_INT(2) = IDENT_INT(8)) THEN
+                FAILED ("IMPROPER VALUE FROM SUBTRACTION");
+           END IF;
+ 
+           IF NOT (A.ALL * IDENT_INT(3) = IDENT_INT(30)) THEN
+                FAILED ("IMPROPER VALUE FROM MULTIPLICATION");
+           END IF;
+ 
+           IF NOT (A.ALL / IDENT_INT(3) = IDENT_INT(3)) THEN
+                FAILED ("IMPROPER VALUE FROM DIVISION");
+           END IF;
+ 
+           IF NOT (A.ALL MOD IDENT_INT(3) = IDENT_INT(1)) THEN
+                FAILED ("IMPROPER VALUE FROM MODULO");
+           END IF;
+ 
+           IF NOT (A.ALL REM IDENT_INT(7) = IDENT_INT(3)) THEN
+                FAILED ("IMPROPER VALUE FROM REMAINDER");
+           END IF;
+ 
+           IF NOT (A.ALL ** IDENT_INT(2) = IDENT_INT(100)) THEN
+                FAILED ("IMPROPER VALUE FROM EXPONENTIATION");
+           END IF;
+ 
+           IF NOT (+A.ALL = IDENT_INT(10)) THEN
+                FAILED ("IMPROPER VALUE FROM IDENTITY");
+           END IF;
+ 
+           IF NOT (-A.ALL = IDENT_INT(-10)) THEN
+                FAILED ("IMPROPER VALUE FROM NEGATION");
+           END IF;
+ 
+           A := NULL;
+ 
+           IF A /= NULL THEN
+                FAILED ("IMPROPER VALUE FROM ACCESS SET TO NULL");
+           END IF;
+ 
+           IF A'ADDRESS NOT IN ADDRESS THEN
+                FAILED ("IMPROPER RESULT FROM A'ADDRESS TEST");
+           END IF;
+ 
+ 
+           DECLARE
+                ACC_SIZE : INTEGER := ACC'SIZE;
+           BEGIN
+                IF ACC_SIZE NOT IN INTEGER THEN
+                     FAILED ("IMPROPER RESULT FROM ACC'SIZE");
+                END IF;
+           END;
+ 
+           R := NEW REC'(COMP => 5);
+ 
+           IF NOT EQUAL(R.COMP,5) THEN
+                FAILED ("IMPROPER VALUE FOR RECORD COMPONENT");
+           END IF;
+ 
+           DR := NEW DISCREC'(DISC => 1, COMPD => 5);
+ 
+           IF NOT EQUAL(DR.DISC,1) OR NOT EQUAL(DR.COMPD,5) THEN
+                FAILED ("IMPROPER VALUES FOR DISCRIMINATED RECORD " &
+                        "COMPONENTS");
+           END IF;
+ 
+           C := NEW ARR'(1 => (1,2), 2 => (3,4));
+ 
+           IF C(1,1) /= 1 OR C(1,2) /= 2 OR C(2,1) /= 3 OR C(2,2) /= 4
+                THEN FAILED ("IMPROPER ARRAY COMPONENT VALUES");
+           END IF;
+ 
+           D := NEW ONEDIM'(1,2,3,4,5,6,7,8,9,10);
+           E := NEW ONEDIM'(10,9,8,7,6,5,4,3,2,1);
+ 
+           D(1..5) := E(1..5);
+ 
+           IF D(1) /= 10 OR D(2) /= 9 OR D(3) /= 8
+                OR D(4) /= 7 OR D(5) /= 6 THEN
+                FAILED ("IMPROPER RESULTS FROM SLICE ASSIGNMENT");
+           END IF;
+ 
+           IF C'FIRST /= 1 OR C'FIRST(2) /= 1 THEN
+                FAILED ("IMPROPER LOWER BOUNDS FOR CONSTRAINED ARRAY");
+           END IF;
+ 
+           IF C'LAST /= 2 OR C'LAST(2) /= 2 THEN
+                FAILED ("IMPROPER UPPER BOUNDS FOR CONSTRAINED ARRAY");
+           END IF;
+ 
+           IF 1 NOT IN C'RANGE THEN
+                FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 1");
+           END IF;
+ 
+           IF 1 NOT IN C'RANGE(2) THEN
+                FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 2");
+           END IF;
+ 
+           IF C'LENGTH /= 2 THEN
+                FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
+                        "ARRAY - 1");
+           END IF;
+ 
+           IF C'LENGTH(2) /= 2 THEN
+                FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
+                        "ARRAY - 2");
+           END IF;
+ 
+           F := NEW T;
+ 
+           F.HERE(INT);
+ 
+           IF NOT EQUAL(INT,IDENT_INT(10)) THEN
+                FAILED ("IMPROPER RESULTS FROM ENTRY SELECTION");
+           END IF;
+ 
+           G := NEW T1;
+ 
+           G.HERE1(TWO)(INT);
+ 
+           IF NOT EQUAL(INT,IDENT_INT(20)) THEN
+                FAILED ("IMPROPER RESULTS FROM FAMILY ENTRY SELECTION");
+           END IF;
+ 
+           RESULT;
+      END P;
+ 
+      PACKAGE PACK IS NEW P(INTEGER,ACCINTEGER,AI,AREC,ADISCREC,
+                            AA,AONEDIM,ATASK,ATASK1,ANOTHERTASK);
+ 
+ BEGIN
+      NULL;
+ END CC1225A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1226b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1226b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1226b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1226b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,176 ----
+ -- CC1226B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, FOR A FORMAL NONLIMITED PRIVATE TYPE, THAT ALL ALLOWABLE
+ --     OPERATIONS ARE IMPLICITLY DECLARED.
+ 
+ -- HISTORY:
+ --     BCB 04/04/88  CREATED ORIGINAL TEST.
+ --     RJW 03/28/90  INITIALIZED PREVIOUSLY UNINITIALIZED VARIABLES.
+ --     LDC 09/19/90  INITALIZED NLPVAR & NLPVAR2 TO DIFFERENT VALUES,
+ --                   REMOVED USE CLAUSE.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ 
+ PROCEDURE CC1226B IS
+ 
+      TYPE DISCREC(DISC1 : INTEGER := 1;
+                   DISC2 : BOOLEAN := FALSE) IS RECORD
+           NULL;
+      END RECORD;
+ 
+      GENERIC
+           TYPE NLP IS PRIVATE;
+           TYPE NLPDISC(DISC1 : INTEGER;
+                        DISC2 : BOOLEAN) IS PRIVATE;
+           WITH PROCEDURE INITIALIZE (N : OUT NLPDISC);
+           WITH FUNCTION INITIALIZE RETURN NLP;
+           WITH FUNCTION INITIALIZE_2 RETURN NLP;
+      PACKAGE P IS
+           FUNCTION IDENT(X : NLP) RETURN NLP;
+           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
+      END P;
+ 
+      PACKAGE BODY P IS
+           TYPE DER_NLP IS NEW NLP;
+           NLPVAR : NLP := INITIALIZE_2;
+           NLPVAR2, NLPVAR3 : NLP := INITIALIZE;
+           DERNLP : DER_NLP := DER_NLP (INITIALIZE);
+           NDVAR : NLPDISC(DISC1 => 5, DISC2 => TRUE);
+           NLPVARADDRESS : ADDRESS;
+           NLPSIZE : INTEGER;
+           NLPBASESIZE : INTEGER;
+ 
+           FUNCTION IDENT(X : NLP) RETURN NLP IS
+                Z : NLP := INITIALIZE;
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN X;
+                END IF;
+                RETURN Z;
+           END IDENT;
+ 
+           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
+                I : INTEGER;
+                Z : ADDRESS := I'ADDRESS;
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN Y;
+                END IF;
+                RETURN Z;
+           END IDENT_ADR;
+ 
+      BEGIN
+           TEST ("CC1226B", "CHECK, FOR A FORMAL NONLIMITED PRIVATE " &
+                            "TYPE THAT ALL ALLOWABLE OPERATIONS ARE " &
+                            "IMPLICITLY DECLARED");
+ 
+           INITIALIZE (NDVAR);
+ 
+           NLPVAR := NLPVAR2;
+ 
+           IF NLPVAR /= NLPVAR2 THEN
+                FAILED ("IMPROPER VALUE FROM ASSIGNMENT");
+           END IF;
+ 
+           IF NLPVAR NOT IN NLP THEN
+                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+           END IF;
+ 
+           NLPVAR := NLP'(NLPVAR2);
+ 
+           IF NLPVAR /= NLPVAR2 THEN
+                FAILED ("IMPROPER RESULT FROM QUALIFICATION");
+           END IF;
+ 
+           NLPVAR := NLP(DERNLP);
+ 
+           IF NLPVAR /= IDENT(NLP(DERNLP)) THEN
+                FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION");
+           END IF;
+ 
+           NLPSIZE := IDENT_INT(NLP'SIZE);
+ 
+           IF NLPSIZE /= INTEGER(NLP'SIZE) THEN
+                FAILED ("IMPROPER VALUE FOR NLP'SIZE");
+           END IF;
+ 
+           NLPVARADDRESS := NLPVAR'ADDRESS;
+ 
+           IF NLPVAR'ADDRESS /= IDENT_ADR(NLPVARADDRESS) THEN
+                FAILED ("IMPROPER VALUE FOR NLPVAR'ADDRESS");
+           END IF;
+ 
+           IF NDVAR.DISC1 /= IDENT_INT(5) THEN
+                FAILED ("IMPROPER DISCRIMINANT VALUE - 1");
+           END IF;
+ 
+           IF NOT NDVAR.DISC2 THEN
+                FAILED ("IMPROPER DISCRIMINANT VALUE - 2");
+           END IF;
+ 
+           IF NOT NDVAR'CONSTRAINED THEN
+                FAILED ("IMPROPER VALUE FOR NDVAR'CONSTRAINED");
+           END IF;
+ 
+           NLPVAR := NLPVAR3;
+ 
+           IF NOT (NLPVAR = IDENT(NLPVAR3)) THEN
+                FAILED ("IMPROPER VALUE FROM EQUALITY OPERATION");
+           END IF;
+ 
+           IF NLPVAR /= IDENT(NLPVAR3) THEN
+                FAILED ("IMPROPER VALUE FROM INEQUALITY OPERATION");
+           END IF;
+ 
+           RESULT;
+      END P;
+ 
+      PROCEDURE INITIALIZE (I : OUT DISCREC) IS
+      BEGIN
+           I := (5, TRUE);
+      END INITIALIZE;
+ 
+      FUNCTION INITIALIZE RETURN INTEGER IS
+      BEGIN
+           RETURN 5;
+      END INITIALIZE;
+ 
+      FUNCTION INITIALIZE_OTHER RETURN INTEGER IS
+      BEGIN
+           RETURN 3;
+      END INITIALIZE_OTHER;
+ 
+      PACKAGE PACK IS NEW P(INTEGER, 
+                            DISCREC, 
+                            INITIALIZE, 
+                            INITIALIZE, 
+                            INITIALIZE_OTHER);
+ 
+ BEGIN
+      NULL;
+ END CC1226B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1227a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1227a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1227a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1227a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,289 ----
+ -- CC1227A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK, WHEN DERIVING FROM A FORMAL TYPE, THAT ALL THE PREDEFINED
+ --     OPERATIONS ASSOCIATED WITH THE CLASS OF THE FORMAL TYPE ARE
+ --     DECLARED FOR THE DERIVED TYPE.
+ 
+ -- HISTORY:
+ --     BCB 04/04/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ WITH SYSTEM; USE SYSTEM;
+ 
+ PROCEDURE CC1227A IS
+ 
+      GENERIC
+           TYPE FORM IS RANGE <>;
+      PACKAGE P IS
+           TYPE DER_FORM IS NEW FORM;
+           FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM;
+           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
+      END P;
+ 
+      PACKAGE BODY P IS
+           DER_VAR : DER_FORM;
+           DER_FORM_BASE_FIRST : DER_FORM;
+           DER_FORM_FIRST : DER_FORM;
+           DER_FORM_LAST : DER_FORM;
+           DER_FORM_SIZE : DER_FORM;
+           DER_FORM_WIDTH : DER_FORM;
+           DER_FORM_POS : DER_FORM;
+           DER_FORM_VAL : DER_FORM;
+           DER_FORM_SUCC : DER_FORM;
+           DER_FORM_PRED : DER_FORM;
+           DER_FORM_IMAGE : STRING(1..5);
+           DER_FORM_VALUE : DER_FORM;
+           DER_VAR_SIZE : DER_FORM;
+           DER_VAR_ADDRESS : ADDRESS;
+           DER_EQUAL, DER_UNEQUAL : DER_FORM;
+           DER_GREATER : DER_FORM;
+           DER_MOD, DER_REM : DER_FORM;
+           DER_ABS, DER_EXP : DER_FORM;
+           INT : INTEGER := 5;
+           FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM IS
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN X;
+                END IF;
+                RETURN 0;
+           END IDENT_DER;
+           FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
+                X : DER_FORM;
+           BEGIN
+                IF EQUAL(3,3) THEN
+                     RETURN Y;
+                END IF;
+                RETURN X'ADDRESS;
+           END IDENT_ADR;
+      BEGIN
+           TEST ("CC1227A", "CHECK, WHEN DERIVING FROM A FORMAL TYPE, " &
+                            "THAT ALL THE PREDEFINED OPERATIONS " &
+                            "ASSOCIATED WITH THE CLASS OF THE FORMAL " &
+                            "TYPE ARE DECLARED FOR THE DERIVED TYPE");
+ 
+           DER_VAR := IDENT_DER(1);
+ 
+           IF DER_VAR /= 1 THEN
+                FAILED ("IMPROPER VALUE FROM ASSIGNMENT OPERATION");
+           END IF;
+ 
+           IF DER_VAR NOT IN DER_FORM THEN
+                FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+           END IF;
+ 
+           DER_VAR := DER_FORM'(2);
+ 
+           IF DER_VAR /= IDENT_DER(2) THEN
+                FAILED ("IMPROPER RESULT FROM QUALIFICATION");
+           END IF;
+ 
+           DER_VAR := DER_FORM(INT);
+ 
+           IF DER_VAR /= IDENT_DER(5) THEN
+                FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " &
+                        "INTEGER");
+           END IF;
+ 
+           DER_VAR := DER_FORM(3.0);
+ 
+           IF DER_VAR /= IDENT_DER(3) THEN
+                FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " &
+                         "FLOAT");
+           END IF;
+ 
+           DER_VAR := 1_000;
+ 
+           IF DER_VAR /= IDENT_DER(1000) THEN
+                FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
+           END IF;
+ 
+           DER_FORM_BASE_FIRST := DER_FORM'BASE'FIRST;
+ 
+           DER_FORM_FIRST := DER_FORM'FIRST;
+ 
+           IF DER_FORM_BASE_FIRST /= IDENT_DER(DER_FORM_FIRST) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'BASE'FIRST");
+           END IF;
+ 
+           IF DER_FORM_FIRST /= IDENT_DER(DER_FORM'FIRST) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'FIRST");
+           END IF;
+ 
+           DER_FORM_LAST := DER_FORM'LAST;
+ 
+           IF DER_FORM_LAST /= IDENT_DER(DER_FORM'LAST) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'LAST");
+           END IF;
+ 
+           DER_FORM_SIZE := DER_FORM(DER_FORM'SIZE);
+ 
+           IF DER_FORM_SIZE /= IDENT_DER(DER_FORM(DER_FORM'SIZE)) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'SIZE");
+           END IF;
+ 
+           DER_FORM_WIDTH := DER_FORM(DER_FORM'WIDTH);
+ 
+           IF DER_FORM_WIDTH /= IDENT_DER(DER_FORM(DER_FORM'WIDTH)) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'WIDTH");
+           END IF;
+ 
+           DER_FORM_POS := DER_FORM(DER_FORM'POS(DER_VAR));
+ 
+           IF DER_FORM_POS /= IDENT_DER(DER_FORM(DER_FORM'POS(DER_VAR)))
+                THEN FAILED ("IMPROPER VALUE FOR DER_FORM'POS(DER_VAR)");
+           END IF;
+ 
+           DER_FORM_VAL := DER_FORM'VAL(DER_VAR);
+ 
+           IF DER_FORM_VAL /= IDENT_DER(DER_FORM'VAL(DER_VAR)) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'VAL(DER_VAR)");
+           END IF;
+ 
+           DER_FORM_SUCC := DER_FORM'SUCC(DER_VAR);
+ 
+           IF DER_FORM_SUCC /= IDENT_DER(DER_FORM'SUCC(DER_VAR)) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'SUCC(DER_VAR)");
+           END IF;
+ 
+           DER_FORM_PRED := DER_FORM'PRED(DER_VAR);
+ 
+           IF DER_FORM_PRED /= IDENT_DER(DER_FORM'PRED(DER_VAR)) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'PRED(DER_VAR)");
+           END IF;
+ 
+           DER_FORM_IMAGE := DER_FORM'IMAGE(DER_VAR);
+ 
+           IF DER_FORM_IMAGE(2..5) /= "1000" THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'IMAGE(DER_VAR)");
+           END IF;
+ 
+           DER_FORM_VALUE := DER_FORM'VALUE(DER_FORM_IMAGE);
+ 
+           IF DER_FORM_VALUE /= IDENT_DER(1000) THEN
+                FAILED ("IMPROPER VALUE FOR DER_FORM'VALUE" &
+                        "(DER_FORM_IMAGE)");
+           END IF;
+ 
+           DER_VAR_SIZE := DER_FORM(DER_VAR'SIZE);
+ 
+           IF DER_VAR_SIZE /= IDENT_DER(DER_FORM(DER_VAR'SIZE)) THEN
+                FAILED ("IMPROPER VALUE FOR DER_VAR'SIZE");
+           END IF;
+ 
+           DER_VAR_ADDRESS := DER_VAR'ADDRESS;
+ 
+           IF DER_VAR_ADDRESS /= IDENT_ADR(DER_VAR'ADDRESS) THEN
+                FAILED ("IMPROPER VALUE FOR DER_VAR'ADDRESS");
+           END IF;
+ 
+           DER_EQUAL := IDENT_DER(1000);
+ 
+           IF DER_VAR /= DER_EQUAL THEN
+                FAILED ("IMPROPER RESULT FROM INEQUALITY OPERATOR");
+           END IF;
+ 
+           DER_UNEQUAL := IDENT_DER(500);
+ 
+           IF DER_VAR = DER_UNEQUAL THEN
+                FAILED ("IMPROPER RESULT FROM EQUALITY OPERATOR");
+           END IF;
+ 
+           IF DER_VAR < DER_UNEQUAL THEN
+                FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
+           END IF;
+ 
+           IF DER_VAR <= DER_UNEQUAL THEN
+                FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
+                        "OPERATOR");
+           END IF;
+ 
+           DER_GREATER := IDENT_DER(1500);
+ 
+           IF DER_VAR > DER_GREATER THEN
+                FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
+           END IF;
+ 
+           IF DER_VAR >= DER_GREATER THEN
+                FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
+                        "TO OPERATOR");
+           END IF;
+ 
+           DER_VAR := DER_VAR + DER_EQUAL;
+ 
+           IF DER_VAR /= IDENT_DER(2000) THEN
+                FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
+           END IF;
+ 
+           DER_VAR := DER_VAR - DER_EQUAL;
+ 
+           IF DER_VAR /= IDENT_DER(1000) THEN
+                FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
+           END IF;
+ 
+           DER_VAR := DER_VAR * IDENT_DER(2);
+ 
+           IF DER_VAR /= IDENT_DER(2000) THEN
+                FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
+           END IF;
+ 
+           DER_VAR := DER_VAR / IDENT_DER(2);
+ 
+           IF DER_VAR /= IDENT_DER(1000) THEN
+                FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
+           END IF;
+ 
+           DER_MOD := DER_GREATER MOD DER_VAR;
+ 
+           IF DER_MOD /= IDENT_DER(500) THEN
+                FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
+           END IF;
+ 
+           DER_REM := DER_GREATER REM DER_VAR;
+ 
+           IF DER_REM /= IDENT_DER(500) THEN
+                FAILED ("IMPROPER RESULT FROM REM OPERATOR");
+           END IF;
+ 
+           DER_ABS := ABS(IDENT_DER(-1500));
+ 
+           IF DER_ABS /= IDENT_DER(DER_GREATER) THEN
+                FAILED ("IMPROPER RESULT FROM ABS OPERATOR");
+           END IF;
+ 
+           DER_EXP := IDENT_DER(2) ** IDENT_INT(2);
+ 
+           IF DER_EXP /= IDENT_DER(4) THEN
+                FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
+           END IF;
+ 
+           RESULT;
+      END P;
+ 
+      PACKAGE PACK IS NEW P(INTEGER);
+ 
+ BEGIN
+      NULL;
+ END CC1227A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1301a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1301a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1301a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1301a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,164 ----
+ -- CC1301A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DEFAULT GENERIC SUBPROGRAM PARAMETERS WORK CORRECTLY,
+ -- INCLUDING OVERLOADED AND PREDEFINED OPERATOR_SYMBOLS,
+ -- AND SUBPROGRAMS HIDDEN AT THE INSTANTIATION.
+ -- BOTH KINDS OF DEFAULTS ARE TESTED, FOR BOTH PROCEDURES
+ -- AND FUNCTIONS.
+ 
+ -- DAT 8/14/81
+ -- JBG 5/5/83
+ -- JBG 8/3/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1301A IS
+ 
+      FUNCTION "-" (R, S : INTEGER) RETURN INTEGER;
+ 
+      FUNCTION NEXT (X : INTEGER) RETURN INTEGER;
+ 
+      PROCEDURE BUMP (X : IN OUT INTEGER);
+ 
+      GENERIC
+           WITH FUNCTION "*" (A, B : INTEGER) RETURN INTEGER IS "-";
+           WITH FUNCTION "+" (R, S: INTEGER) RETURN INTEGER IS 
+                                                        STANDARD."+";
+           WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
+           WITH FUNCTION NEXTO (Q : INTEGER) RETURN INTEGER IS NEXT ;
+           WITH PROCEDURE BUMPO (A : IN OUT INTEGER) IS BUMP;
+           WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER  IS <> ;
+           WITH PROCEDURE BUMP (Q : IN OUT INTEGER) IS <> ;
+           TYPE INTEGER IS RANGE <> ;
+           WITH FUNCTION "*" (A , B : INTEGER) RETURN INTEGER IS <> ;
+           WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
+           WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER IS <> ;
+           WITH PROCEDURE BUMP (Z : IN OUT INTEGER) IS <> ;
+      PACKAGE PKG IS
+           SUBTYPE INT IS STANDARD.INTEGER;
+           DIFF : INT := -999;
+      END PKG;
+ 
+      TYPE NEWINT IS NEW INTEGER RANGE -1000 .. 1000;
+ 
+      FUNCTION PLUS (Q1, Q2 : INTEGER) RETURN INTEGER RENAMES "+";
+ 
+      FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN PLUS (X, PLUS (Y, -10));
+           -- (X + Y - 10)
+      END "+";
+ 
+      FUNCTION "-" (R, S : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN - R + S;
+           -- (-R + S - 10)
+      END "-";
+ 
+      FUNCTION NEXT (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN X + 1;
+           -- (X + 1 - 10)
+           -- (X - 9)
+      END NEXT;
+ 
+      PROCEDURE BUMP (X : IN OUT INTEGER) IS
+      BEGIN
+           X := NEXT (X);
+           -- (X := X - 9)
+      END BUMP;
+ 
+      PACKAGE BODY PKG IS
+           W : INTEGER;
+           WI : INT;
+      BEGIN
+           W := NEXT (INTEGER'(3) * 4 - 2);
+           -- (W := (4 ** 3 - 2) - 1)
+           -- (W := 61)
+           BUMP (W);
+           -- (W := 61 + 7)
+           -- (W := 68)
+           WI := NEXT (INT'(3) * 4 - 2 + NEXTO (0));
+           -- (3 * 4) => (3 - 4) => (-3 + 4 - 10) = -9
+           -- ((-9) - 2) => (2 + 2 - (-9) - 20) = -7
+           -- (-7 + (-9)) => -16
+           -- (WI := 7 - (-16)) => (WI := 23)
+           BUMPO (WI);
+           -- (WI := 23 - 9) (= 14)
+           BUMP (WI);
+           -- (WI := 14 - 9) (= 5)
+           DIFF := STANDARD."-" (INT(W), WI);
+           -- (DIFF := 68 - 5) (= 63)
+      END PKG;
+ 
+      FUNCTION "*" (Y, X : NEWINT) RETURN NEWINT IS
+      BEGIN
+           RETURN X ** INTEGER(Y);
+           -- (X,Y) (Y ** X)
+      END "*";
+ 
+      FUNCTION NEXT (Z : NEWINT) RETURN NEWINT IS
+      BEGIN
+           RETURN Z - 1;
+           -- (Z - 1)
+      END NEXT;
+ 
+      PROCEDURE BUMP (ZZ : IN OUT NEWINT) IS
+      BEGIN
+           FAILED ("WRONG PROCEDURE CALLED");
+      END BUMP;
+ BEGIN
+      TEST ("CC1301A", "DEFAULT GENERIC SUBPROGRAM PARAMETERS");
+ 
+      DECLARE
+           PROCEDURE BUMP (QQQ : IN OUT NEWINT) IS
+           BEGIN
+                QQQ := QQQ + 7;
+                -- (QQQ + 7)
+           END BUMP;
+ 
+           FUNCTION NEXT (Q7 : INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN Q7 - 17;
+                -- (-Q7 + 17 - 10)
+                -- (7 - Q7)
+           END NEXT;
+ 
+           FUNCTION "-" (Q3, Q4 : INTEGER) RETURN INTEGER IS
+           BEGIN
+                RETURN -Q3 + Q4 + Q4;
+                -- (-Q3 + Q4 - 10 + Q4 - 10) = (Q4 + Q4 - Q3 - 20)
+           END "-";
+ 
+           PACKAGE P1 IS NEW PKG (INTEGER => NEWINT);
+ 
+      BEGIN
+           IF P1.DIFF /= 63 THEN
+                FAILED ("WRONG DEFAULT SUBPROGRAM PARAMETERS");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC1301A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1302a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1302a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1302a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1302a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,174 ----
+ -- CC1302A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT GENERIC DEFAULT SUBPROGRAM PARAMETERS MAY BE ATTRIBUTES
+ -- OF TYPES, INCLUDING GENERIC FORMAL TYPES IN SAME GENERIC PART,
+ -- OR IN GENERIC PART OF ENCLOSING UNIT.
+ 
+ -- DAT 8/27/81
+ -- SPS 2/9/83
+ -- JBG 2/15/83
+ -- JBG 4/29/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1302A IS
+ BEGIN
+      TEST ("CC1302A", "GENERIC DEFAULT SUBPROGRAMS MAY BE"
+           & " FUNCTION ATTRIBUTES OF TYPES");
+ 
+      DECLARE
+           GENERIC 
+                TYPE T IS ( <> );
+                T_LAST : T;
+                WITH FUNCTION SUCC (X : T) RETURN T IS T'SUCC;
+           PACKAGE PK1 IS
+           END PK1;
+ 
+           SUBTYPE CH IS CHARACTER RANGE CHARACTER'FIRST .. '~';
+           SUBTYPE BL IS BOOLEAN RANGE FALSE .. FALSE;
+           SUBTYPE INT IS INTEGER RANGE -10 .. 10;
+ 
+           PACKAGE BODY PK1 IS
+                GENERIC 
+                     TYPE TT IS ( <> );
+                     TT_LAST : TT;
+                     WITH FUNCTION PRED (X : TT) RETURN TT IS TT'PRED;
+                     WITH FUNCTION IM(X : T) RETURN STRING IS T'IMAGE;
+                     WITH FUNCTION VAL(X : STRING) RETURN TT IS TT'VALUE;
+                PACKAGE PK2 IS END PK2;
+ 
+                PACKAGE BODY PK2 IS
+                BEGIN
+ 
+ -- CHECK THAT 'LAST GIVES RIGHT ANSWER
+                     IF T'LAST /= T_LAST THEN
+                          FAILED ("T'LAST INCORRECT");
+                     END IF;
+ 
+                     IF TT'LAST /= TT_LAST THEN
+                          FAILED ("TT'LAST INCORRECT");
+                     END IF;
+ 
+ -- CHECK SUCC FUNCTION
+                     BEGIN
+                          IF T'PRED(SUCC(T'LAST)) /= T'LAST THEN
+                               FAILED ("'PRED OR SUCC GIVES WRONG " &
+                                       "RESULT");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED ("SUCC HAS CONSTRAINTS OF " &
+                                       "SUBTYPE");
+                          WHEN OTHERS =>
+                               FAILED ("SOME EXCEPTION RAISED - 1");
+                     END;
+ 
+ -- CHECK 'SUCC ATTRIBUTE
+                     BEGIN
+                          IF T'PRED(T'SUCC(T'LAST)) /= T'LAST THEN
+                               FAILED ("'PRED OR 'SUCC GIVES WRONG " &
+                                       "RESULT");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED ("'PRED OR 'SUCC HAS CONSTRAINTS "&
+                                       "OF SUBTYPE");
+                          WHEN OTHERS =>
+                               FAILED ("SOME EXCEPTION RAISED - 2");
+                     END;
+ 
+ -- CHECK VAL ATTRIBUTE
+                     BEGIN
+                          IF T'VAL(T'POS(T'SUCC(T'LAST))) /=
+                             T'VAL(T'POS(T'LAST)+1) THEN
+                               FAILED ("VAL OR POS ATTRIBUTE HAS " &
+                                       "INCONSISTENT RESULTS");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED ("VAL OR POS ATTRIBUTE HAS " &
+                                       "CONSTRAINTS OF SUBTYPE");
+                          WHEN OTHERS =>
+                               FAILED ("SOME EXCEPTION RAISED - 4");
+                     END;
+ 
+ -- CHECK VAL FUNCTION
+                     BEGIN
+                          IF TT'VAL(TT'POS(TT'SUCC(TT'LAST))) /= 
+                             TT'VAL(TT'POS(TT'LAST)+1) THEN
+                               FAILED ("VAL FUNCTION GIVES INCORRECT " &
+                                       "RESULTS");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED ("VAL FUNCTION HAS CONSTRAINTS " &
+                                       "OF SUBTYPE");
+                          WHEN OTHERS =>
+                               FAILED ("SOME EXCEPTION RAISED - 6");
+                     END;
+ 
+ -- CHECK IM FUNCTION
+                     BEGIN
+                          IF T'IMAGE(T'SUCC(T'LAST)) /= 
+                               IM   (T'SUCC(T'LAST)) THEN
+                               FAILED ("IM FUNCTION GIVES INCORRECT " &
+                                       "RESULTS");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED ("IM FUNCTION HAS CONSTRAINTS " &
+                                       "OF SUBTYPE");
+                          WHEN OTHERS =>
+                               FAILED ("SOME EXCEPTION RAISED - 7");
+                     END;
+ 
+ -- CHECK PRED FUNCTION
+                     BEGIN
+                          IF PRED(TT'SUCC(TT'LAST)) /= TT'LAST THEN
+                               FAILED ("PRED FUNCTION GIVES INCORRECT " &
+                                       "RESULTS");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               FAILED ("PRED FUNCTION HAS CONSTRAINTS " &
+                                       "OF SUBTYPE");
+                          WHEN OTHERS =>
+                               FAILED ("SOME EXCEPTION RAISED - 8");
+                     END;
+ 
+                END PK2;
+ 
+                PACKAGE PK3 IS NEW PK2 (T, T'LAST);
+           END PK1;
+ 
+           PACKAGE PKG1 IS NEW PK1 (CH, CH'LAST);
+           PACKAGE PKG2 IS NEW PK1 (BL, BL'LAST);
+           PACKAGE PKG3 IS NEW PK1 (INT, INT'LAST);
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC1302A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1304a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1304a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1304a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1304a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- CC1304A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT GENERIC FORMAL SUBPROGRAMS MAY HAVE A PARAMETER
+ -- OF A GENERIC FORMAL TYPE, AND MAY RETURN A GENERIC FORMAL
+ -- TYPE.
+ 
+ -- DAT 8/27/81
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1304A IS
+ BEGIN
+      TEST ("CC1304A", "GENERIC FORMAL SUBPROGRAMS MAY HAVE PARAMETERS"
+           & " OF (AND RETURN) A FORMAL TYPE");
+ 
+      DECLARE
+           GENERIC
+                TYPE T IS ( <> );
+                WITH FUNCTION S (P : T) RETURN T;
+                WITH PROCEDURE P (P : T);
+           PROCEDURE PR (PARM : T);
+ 
+           PROCEDURE PR (PARM: T) IS
+           BEGIN
+                P(P=>S(P=>PARM));
+           END PR;
+      BEGIN
+           DECLARE
+                C : CHARACTER := 'A';
+                B : BOOLEAN := FALSE;
+                I : INTEGER := 5;
+                TYPE ENUM IS (E1, E2, E3);
+                E : ENUM := E2;
+ 
+                FUNCTION FC (P : CHARACTER) RETURN CHARACTER IS
+                BEGIN
+                     RETURN 'B';
+                END FC;
+ 
+                FUNCTION FB (P : BOOLEAN) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN NOT P;
+                END FB;
+      
+                FUNCTION FI (P : INTEGER) RETURN INTEGER IS
+                BEGIN
+                     RETURN P + 1;
+                END FI;
+ 
+                FUNCTION FE (P : ENUM) RETURN ENUM IS
+                BEGIN
+                     RETURN ENUM'SUCC (P);
+                END FE;
+ 
+                PROCEDURE  PC (P : CHARACTER) IS
+                BEGIN
+                     C := P;
+                END PC;
+ 
+                PROCEDURE PB (P : BOOLEAN) IS
+                BEGIN
+                     B := P;
+                END PB;
+ 
+                PROCEDURE PI (P : INTEGER) IS
+                BEGIN
+                    I := P;
+                END PI;
+  
+                PROCEDURE PE (P : ENUM) IS
+                BEGIN
+                     E := P;
+                END PE;
+ 
+                PACKAGE PKG2 IS
+                     PROCEDURE P1 IS NEW PR (CHARACTER, FC, PC);
+                     PROCEDURE P2 IS NEW PR (BOOLEAN, FB, PB);
+                     PROCEDURE P3 IS NEW PR (INTEGER, FI, PI);
+                     PROCEDURE P4 IS NEW PR (ENUM, FE, PE);
+                END PKG2;
+ 
+                PACKAGE BODY PKG2 IS
+                BEGIN
+                     P1 (C);
+                     P2 (B);
+                     P3 (I);
+                     P4 (E);
+                END  PKG2;
+           BEGIN
+                IF C /= 'B'
+                OR B /= TRUE
+                OR I /= 6
+                OR E /= E3 THEN
+                     FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES");
+                END IF;
+           END;
+      END;
+      
+      RESULT;
+ END CC1304A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1304b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1304b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1304b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1304b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,166 ----
+ -- CC1304B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT GENERIC FORMAL SUBPROGRAMS MAY HAVE A PARAMETER
+ --     OF A GENERIC FORMAL TYPE, AND MAY RETURN A GENERIC FORMAL
+ --     TYPE.  CHECK MODES IN OUT AND OUT.
+ 
+ -- HISTORY:
+ --     BCB 08/04/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1304B IS
+ 
+ BEGIN
+      TEST ("CC1304B", "GENERIC FORMAL SUBPROGRAMS MAY HAVE A " &
+                       "PARAMETER OF A GENERIC FORMAL TYPE, AND MAY  " &
+                       "RETURN A GENERIC FORMAL TYPE.  CHECK MODES IN " &
+                       "OUT AND OUT");
+ 
+      DECLARE
+           GENERIC
+                TYPE T IS ( <> );
+                WITH PROCEDURE S (P : OUT T);
+                WITH PROCEDURE P (P : IN OUT T);
+                WITH FUNCTION L RETURN T;
+           PROCEDURE PR (PARM1, PARM2, PARM3 : IN OUT T);
+ 
+           PROCEDURE PR (PARM1, PARM2, PARM3 : IN OUT T) IS
+           BEGIN
+                S (P => PARM1);
+                P (P => PARM2);
+                PARM3 := L;
+           END PR;
+      BEGIN
+           DECLARE
+                C : CHARACTER := 'A';
+                C1 : CHARACTER := 'Y';
+                C2 : CHARACTER := 'I';
+                B : BOOLEAN := FALSE;
+                B1 : BOOLEAN := TRUE;
+                B2 : BOOLEAN := FALSE;
+                I : INTEGER := 5;
+                I1 : INTEGER := 10;
+                I2 : INTEGER := 0;
+                TYPE ENUM IS (E1, E2, E3);
+                F : ENUM := E2;
+                F1 : ENUM := E1;
+                F2 : ENUM := E2;
+ 
+                PROCEDURE FC (P : OUT CHARACTER) IS
+                BEGIN
+                     P := 'B';
+                END FC;
+ 
+                PROCEDURE FB (P : OUT BOOLEAN) IS
+                BEGIN
+                     P := NOT B;
+                END FB;
+ 
+                PROCEDURE FI (P : OUT INTEGER) IS
+                BEGIN
+                     P :=  I + 1;
+                END FI;
+ 
+                PROCEDURE FE (P : OUT ENUM) IS
+                BEGIN
+                     P := ENUM'SUCC (F);
+                END FE;
+ 
+                PROCEDURE  PC (P : IN OUT CHARACTER) IS
+                BEGIN
+                     P := 'Z';
+                END PC;
+ 
+                PROCEDURE PB (P : IN OUT BOOLEAN) IS
+                BEGIN
+                     P := NOT B1;
+                END PB;
+ 
+                PROCEDURE PI (P : IN OUT INTEGER) IS
+                BEGIN
+                    P := I1 + 1;
+                END PI;
+ 
+                PROCEDURE PE (P : IN OUT ENUM) IS
+                BEGIN
+                     P := ENUM'SUCC (F1);
+                END PE;
+ 
+                FUNCTION LC RETURN CHARACTER IS
+                BEGIN
+                     RETURN 'J';
+                END LC;
+ 
+                FUNCTION LB RETURN BOOLEAN IS
+                BEGIN
+                     RETURN TRUE;
+                END LB;
+ 
+                FUNCTION LI RETURN INTEGER IS
+                BEGIN
+                     RETURN IDENT_INT(5);
+                END LI;
+ 
+                FUNCTION LE RETURN ENUM IS
+                BEGIN
+                     RETURN ENUM'SUCC(F2);
+                END LE;
+ 
+                PACKAGE PKG2 IS
+                     PROCEDURE P1 IS NEW PR (CHARACTER, FC, PC, LC);
+                     PROCEDURE P2 IS NEW PR (BOOLEAN, FB, PB, LB);
+                     PROCEDURE P3 IS NEW PR (INTEGER, FI, PI, LI);
+                     PROCEDURE P4 IS NEW PR (ENUM, FE, PE, LE);
+                END PKG2;
+ 
+                PACKAGE BODY PKG2 IS
+                BEGIN
+                     P1 (C,C1,C2);
+                     P2 (B,B1,B2);
+                     P3 (I,I1,I2);
+                     P4 (F,F1,F2);
+                END  PKG2;
+           BEGIN
+                IF C /= 'B' OR B /= TRUE OR I /= 6 OR F /= E3 THEN
+                     FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES - " &
+                             "MODE OUT");
+                END IF;
+ 
+                IF C1 /= 'Z' OR B1 /= FALSE OR I1 /= 11 OR F1 /= E2 THEN
+                     FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES - " &
+                             "MODE IN OUT");
+                END IF;
+ 
+                IF C2 /= 'J' OR B2 /= TRUE OR I2 /= 5 OR F2 /= E3 THEN
+                     FAILED ("GENERIC FORMAL SUBPROGRAMS RETURNING A " &
+                             "GENERIC FORMAL TYPE");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END CC1304B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1307a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1307a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1307a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1307a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,54 ----
+ -- CC1307A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SUBPROGRAM PARAMETERS MAY HAVE AN OPERATOR_SYMBOL DEFAULT,
+ -- WHICH LOOKS THE SAME AS A DEFAULT STRING PARAMETER.
+ 
+ -- DAT 9/8/81
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1307A IS
+ BEGIN
+      TEST ("CC1307A", "GENERIC SUBPROGRAM AND STRING DEFAULT PARAMETERS"
+           & " MAY LOOK THE SAME");
+ 
+      DECLARE
+           GENERIC
+                WITH FUNCTION CAT (X, Y : STRING) RETURN STRING
+                     IS "&";
+                S : STRING := "&";
+           PACKAGE PK IS
+                VAL : CONSTANT STRING := CAT (S, S);
+           END PK;
+ 
+           PACKAGE PK1 IS NEW PK;
+      BEGIN
+           IF PK1.VAL /= "&&" THEN
+                FAILED ("INCORRECT GENERIC INSTANTIATION WITH DEFAULTS");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC1307A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1307b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1307b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1307b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1307b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- CC1307B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN ENUMERATION LITERAL (BOTH AN IDENTIFIER AND A
+ --     CHARACTER LITERAL) MAY BE USED AS A DEFAULT SUBPROGRAM NAME
+ --     AND AS A DEFAULT INITIAL VALUE FOR AN OBJECT PARAMETER.
+ 
+ -- HISTORY:
+ --     BCB 08/09/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1307B IS
+ 
+      TYPE ENUM IS (R, 'S', R1);
+ 
+ BEGIN
+      TEST ("CC1307B", "CHECK THAT AN ENUMERATION LITERAL (BOTH AN " &
+                       "IDENTIFIER AND A CHARACTER LITERAL) MAY BE " &
+                       "USED AS A DEFAULT SUBPROGRAM NAME AND AS A " &
+                       "DEFAULT INITIAL VALUE FOR AN OBJECT PARAMETER");
+ 
+      DECLARE
+           GENERIC
+                WITH FUNCTION J RETURN ENUM IS R;
+                WITH FUNCTION K RETURN ENUM IS 'S';
+                OBJ1 : ENUM := R;
+                OBJ2 : ENUM := 'S';
+           PACKAGE P IS
+           END P;
+ 
+           PACKAGE BODY P IS
+                VAR1, VAR2 : ENUM := R1;
+           BEGIN
+                VAR1 := J;
+ 
+                IF VAR1 /= R THEN
+                     FAILED ("WRONG VALUE FOR DEFAULT SUBPROGRAM " &
+                             "NAME - IDENTIFIER");
+                END IF;
+ 
+                VAR2 := K;
+ 
+                IF VAR2 /= 'S' THEN
+                     FAILED ("WRONG VALUE FOR DEFAULT SUBPROGRAM " &
+                             "NAME - CHARACTER LITERAL");
+                END IF;
+ 
+                IF OBJ1 /= R THEN
+                     FAILED ("WRONG VALUE FOR OBJECT PARAMETER - " &
+                             "IDENTIFIER");
+                END IF;
+ 
+                IF OBJ2 /= 'S' THEN
+                     FAILED ("WRONG VALUE FOR OBJECT PARAMETER - " &
+                             "CHARACTER LITERAL");
+                END IF;
+           END P;
+ 
+           PACKAGE NEW_P IS NEW P;
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC1307B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1308a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1308a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1308a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1308a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,266 ----
+ -- CC1308A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT FORMAL SUBPROGRAM PARAMETERS MAY OVERLOAD EACH OTHER
+ --     AND OTHER VISIBLE SUBPROGRAMS AND ENUMERATION LITERALS WITHIN AND
+ --     OUTSIDE OF THE GENERIC UNIT.
+ 
+ -- HISTORY:
+ --     DAT 09/08/81  CREATED ORIGINAL TEST.
+ --     SPS 10/26/82
+ --     SPS 02/09/83
+ --     BCB 08/09/88  REPLACED THE OLD TEST WITH A VERSION BASED ON
+ --                   AIG 6.6/T2.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1308A IS
+ 
+      TYPE ENUM IS (F1,F2,F3,F4,F5,F6,F7);
+ 
+      FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN 2*X;
+      END F1;
+ 
+      PROCEDURE F1 (X : IN OUT INTEGER) IS
+      BEGIN
+           X := 3*X;
+      END F1;
+ 
+      PROCEDURE F2 (Y : IN OUT INTEGER; Z : IN OUT BOOLEAN) IS
+      BEGIN
+           Y := 2*Y;
+           Z := NOT Z;
+      END F2;
+ 
+      PROCEDURE F2 (Y : IN OUT INTEGER) IS
+      BEGIN
+           Y := 3*Y;
+      END F2;
+ 
+      PROCEDURE F3 (B : BOOLEAN := FALSE; A : IN OUT INTEGER) IS
+      BEGIN
+           A := 2*A;
+      END F3;
+ 
+      PROCEDURE F3 (A : IN OUT INTEGER) IS
+      BEGIN
+           A := 3*A;
+      END F3;
+ 
+      PROCEDURE F4 (C : IN OUT INTEGER) IS
+      BEGIN
+           C := 2*C;
+      END F4;
+ 
+      PROCEDURE F4 (C : IN OUT BOOLEAN) IS
+      BEGIN
+           C := NOT C;
+      END F4;
+ 
+      PROCEDURE F5 (D : IN OUT INTEGER; E : IN OUT BOOLEAN) IS
+      BEGIN
+           D := 2*D;
+           E := NOT E;
+      END F5;
+ 
+      PROCEDURE F5 (E : IN OUT BOOLEAN; D : IN OUT INTEGER) IS
+      BEGIN
+           E := NOT E;
+           D := 3*D;
+      END F5;
+ 
+      FUNCTION F6 (G : INTEGER) RETURN INTEGER IS
+      BEGIN
+           RETURN 2*G;
+      END F6;
+ 
+      FUNCTION F6 (G : INTEGER) RETURN BOOLEAN IS
+      BEGIN
+           RETURN TRUE;
+      END F6;
+ 
+      FUNCTION F7 RETURN INTEGER IS
+      BEGIN
+           RETURN 25;
+      END F7;
+ 
+      FUNCTION F7 RETURN BOOLEAN IS
+      BEGIN
+           RETURN FALSE;
+      END F7;
+ 
+ BEGIN
+      TEST ("CC1308A", "CHECK THAT FORMAL SUBPROGRAM PARAMETERS MAY " &
+                       "OVERLOAD EACH OTHER AND OTHER VISIBLE " &
+                       "SUBPROGRAMS AND ENUMERATION LITERALS WITHIN " &
+                       "AND OUTSIDE OF THE GENERIC UNIT");
+ 
+      DECLARE
+           GENERIC
+                WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER;
+                WITH PROCEDURE F1 (X : IN OUT INTEGER);
+ 
+                WITH PROCEDURE F2 (Y : IN OUT INTEGER;
+                                   Z : IN OUT BOOLEAN);
+                WITH PROCEDURE F2 (Y : IN OUT INTEGER);
+ 
+                WITH PROCEDURE F3 (B : BOOLEAN := FALSE;
+                                   A : IN OUT INTEGER);
+                WITH PROCEDURE F3 (A : IN OUT INTEGER);
+ 
+                WITH PROCEDURE F4 (C : IN OUT INTEGER);
+                WITH PROCEDURE F4 (C : IN OUT BOOLEAN);
+ 
+                WITH PROCEDURE F5 (D : IN OUT INTEGER;
+                                   E : IN OUT BOOLEAN);
+                WITH PROCEDURE F5 (E : IN OUT BOOLEAN;
+                                   D : IN OUT INTEGER);
+ 
+                WITH FUNCTION F6 (G : INTEGER) RETURN INTEGER;
+                WITH FUNCTION F6 (G : INTEGER) RETURN BOOLEAN;
+ 
+                WITH FUNCTION F7 RETURN INTEGER;
+                WITH FUNCTION F7 RETURN BOOLEAN;
+           PACKAGE P IS
+                TYPE EN IS (F1,F2,F3,F4,F5,F6,F7);
+           END P;
+ 
+           PACKAGE BODY P IS
+                X1, X2, Y1, Y2, A1, A2, C1, D1, D2, G1
+                   : INTEGER := IDENT_INT(5);
+ 
+                VAL : INTEGER := IDENT_INT(0);
+ 
+                Z1, B1, C2, E1, E2, BOOL : BOOLEAN := IDENT_BOOL(FALSE);
+           BEGIN
+                VAL := F1(X1);
+ 
+                IF NOT EQUAL(VAL,10) THEN
+                     FAILED ("CASE 1 - WRONG VALUE RETURNED FROM " &
+                             "FUNCTION");
+                END IF;
+ 
+                F1(X2);
+ 
+                IF NOT EQUAL(X2,15) THEN
+                     FAILED ("CASE 1 - WRONG VALUE ASSIGNED INSIDE " &
+                             "PROCEDURE");
+                END IF;
+ 
+                F2(Y1,Z1);
+ 
+                IF NOT EQUAL(Y1,10) OR Z1 /= TRUE THEN
+                     FAILED ("CASE 2 - WRONG VALUES ASSIGNED INSIDE " &
+                             "PROCEDURE");
+                END IF;
+ 
+                F2(Y2);
+ 
+                IF NOT EQUAL(Y2,15) THEN
+                     FAILED ("CASE 2 - WRONG VALUE ASSIGNED INSIDE " &
+                             "PROCEDURE");
+                END IF;
+ 
+                F3(B1,A1);
+ 
+                IF NOT EQUAL(A1,10) OR B1 /= FALSE THEN
+                     FAILED ("CASE 3 - WRONG VALUES ASSIGNED INSIDE " &
+                             "PROCEDURE");
+                END IF;
+ 
+                F3(A2);
+ 
+                IF NOT EQUAL(A2,15) THEN
+                     FAILED ("CASE 3 - WRONG VALUE ASSIGNED INSIDE " &
+                             "PROCEDURE");
+                END IF;
+ 
+                F4(C1);
+ 
+                IF NOT EQUAL(C1,10) THEN
+                     FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
+                             "PROCEDURE - BASE TYPE INTEGER");
+                END IF;
+ 
+                F4(C2);
+ 
+                IF C2 /= TRUE THEN
+                     FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
+                             "PROCEDURE - BASE TYPE BOOLEAN");
+                END IF;
+ 
+                F5(D1,E1);
+ 
+                IF NOT EQUAL(D1,10) OR E1 /= TRUE THEN
+                     FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
+                             "PROCEDURE - ORDER WAS INTEGER, BOOLEAN");
+                END IF;
+ 
+                F5(E2,D2);
+ 
+                IF E2 /= TRUE OR NOT EQUAL(D2,15) THEN
+                     FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
+                             "PROCEDURE - ORDER WAS BOOLEAN, INTEGER");
+                END IF;
+ 
+                VAL := F6(G1);
+ 
+                IF NOT EQUAL(VAL,10) THEN
+                     FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
+                             "FUNCTION - TYPE INTEGER");
+                END IF;
+ 
+                BOOL := F6(G1);
+ 
+                IF BOOL /= TRUE THEN
+                     FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
+                             "FUNCTION - TYPE BOOLEAN");
+                END IF;
+ 
+                VAL := F7;
+ 
+                IF NOT EQUAL(VAL,25) THEN
+                     FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
+                             "PARAMETERLESS FUNCTION - TYPE INTEGER");
+                END IF;
+ 
+                BOOL := F7;
+ 
+                IF BOOL /= FALSE THEN
+                     FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
+                             "PARAMETERLESS FUNCTION - TYPE BOOLEAN");
+                END IF;
+           END P;
+ 
+           PACKAGE NEW_P IS NEW P (F1, F1, F2, F2, F3, F3,
+                                   F4, F4, F5, F5, F6, F6, F7, F7);
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC1308A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1310a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1310a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1310a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1310a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,88 ----
+ -- CC1310A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DEFAULT GENERIC SUBPROGRAM PARAMETERS MAY BE ENTRIES.
+ 
+ -- DAT 9/8/81
+ -- SPS 2/7/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1310A IS
+ BEGIN
+      TEST ("CC1310A", "DEFAULT GENERIC SUBPROGRAM PARAMETERS MAY BE"
+           & " ENTRIES");
+ 
+      DECLARE
+           TASK T IS
+                ENTRY ENT1;
+                ENTRY ENT2 (I : IN INTEGER);
+           END T;
+ 
+           PROCEDURE P1 RENAMES T.ENT1;
+           
+           PROCEDURE P4 (I : IN INTEGER) RENAMES T.ENT2;
+ 
+           INT : INTEGER := 0;
+ 
+           TASK BODY T IS
+           BEGIN
+                ACCEPT ENT1;
+                ACCEPT ENT2 (I : IN INTEGER) DO
+                     INT := INT + I;
+                END ENT2;
+                ACCEPT ENT2 (I : IN INTEGER) DO
+                     INT := INT + I;
+                END ENT2;
+                ACCEPT ENT1;
+           END T;
+ 
+      BEGIN
+           DECLARE
+                GENERIC 
+                     WITH PROCEDURE P1 IS <> ;
+                     WITH PROCEDURE P2 IS T.ENT1;
+                     WITH PROCEDURE P3 (I : IN INTEGER) IS T.ENT2;
+                     WITH PROCEDURE P4 (I : IN INTEGER) IS <> ;
+                PACKAGE PKG IS END PKG;
+ 
+                PACKAGE BODY PKG IS
+                BEGIN
+                     P1;
+                     P4 (3);
+                     P3 (6);
+                     P2;
+                END PKG;
+ 
+                PACKAGE PP IS NEW PKG;
+ 
+           BEGIN
+                IF INT /= 9 THEN
+                     FAILED ("ENTRIES AS DEFAULT GENERIC PARAMETERS");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END CC1310A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1311a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1311a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1311a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1311a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,480 ----
+ -- CC1311A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --     CHECK THAT THE DEFAULT EXPRESSIONS OF THE PARAMETERS OF A FORMAL
+ --     SUBPROGRAM ARE USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE
+ --     ACTUAL SUBPROGRAM PARAMETER.
+ 
+ -- HISTORY:
+ --     RJW 06/05/86  CREATED ORIGINAL TEST.
+ --     VCL 08/18/87  CHANGED A COUPLE OF STATIC DEFAULT EXPRESSIONS FOR
+ --                   FORMAL SUBPROGRAM PARAMETERS TO DYNAMIC 
+ --                   EXPRESSIONS VIA THE USE OF THE IDENTITY FUNCTION.
+ --     EDWARD V. BERARD 08/13/90  
+ --                   ADDED CHECKS FOR MULTI-DIMENSIONAL ARRAYS.
+ 
+ WITH REPORT ;
+ 
+ PROCEDURE CC1311A IS
+ 
+      TYPE NUMBERS IS (ZERO, ONE ,TWO);
+ 
+      SHORT_START : CONSTANT := -100 ;
+      SHORT_END   : CONSTANT := 100 ;
+      TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+     
+      SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
+     
+      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                          SEP, OCT, NOV, DEC) ;
+                         
+      SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
+     
+      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+      TYPE DATE IS RECORD
+           MONTH : MONTH_TYPE ;
+           DAY   : DAY_TYPE ;
+           YEAR  : YEAR_TYPE ;
+      END RECORD ;
+     
+      TODAY         : DATE := (MONTH => AUG,
+                               DAY   => 8,
+                               YEAR  => 1990) ;
+                             
+      FIRST_DATE     : DATE := (DAY   => 6,
+                                MONTH => JUN,
+                                YEAR  => 1967) ;
+      
+      SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
+                             
+      TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
+                                       FIRST_HALF,
+                                       FIRST_FIVE) OF DATE ;
+                             
+      GENERIC
+     
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE THIRD_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           DEFAULT_VALUE : IN COMPONENT_TYPE ;
+           TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                               SECOND_INDEX,
+                               THIRD_INDEX) OF COMPONENT_TYPE ;
+           WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
+                                                 (CUBE'RANGE (2) =>
+                                                 (CUBE'RANGE (3) =>
+                                                      DEFAULT_VALUE))))
+                         RETURN CUBE ;
+                         
+      PROCEDURE PROC_WITH_3D_FUNC ;
+     
+      PROCEDURE PROC_WITH_3D_FUNC IS
+     
+      BEGIN  -- PROC_WITH_3D_FUNC
+     
+           IF FUN /= CUBE'(CUBE'RANGE =>
+                          (CUBE'RANGE (2) =>
+                          (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                               "ARRAY, FUNCTION, AND PROCEDURE.") ;
+           END IF ;
+         
+      END PROC_WITH_3D_FUNC ;
+     
+      GENERIC
+     
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE THIRD_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           DEFAULT_VALUE : IN COMPONENT_TYPE ;
+           TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                               SECOND_INDEX,
+                               THIRD_INDEX) OF COMPONENT_TYPE ;
+           WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
+                                                 (CUBE'RANGE (2) =>
+                                                 (CUBE'RANGE (3) =>
+                                                      DEFAULT_VALUE))))
+                         RETURN CUBE ;
+                         
+      PACKAGE PKG_WITH_3D_FUNC IS
+      END PKG_WITH_3D_FUNC ;
+     
+      PACKAGE BODY PKG_WITH_3D_FUNC IS
+      BEGIN  -- PKG_WITH_3D_FUNC
+ 
+           REPORT.TEST("CC1311A","CHECK THAT THE DEFAULT EXPRESSIONS " &
+                       "OF THE PARAMETERS OF A FORMAL SUBPROGRAM ARE " &
+                       "USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE " &
+                       "ACTUAL SUBPROGRAM PARAMETER" ) ;
+     
+           IF FUN /= CUBE'(CUBE'RANGE =>
+                          (CUBE'RANGE (2) =>
+                          (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                               "ARRAY, FUNCTION, AND PACKAGE.") ;
+           END IF ;
+         
+      END PKG_WITH_3D_FUNC ;
+     
+      GENERIC
+     
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE THIRD_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           DEFAULT_VALUE : IN COMPONENT_TYPE ;
+           TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                               SECOND_INDEX,
+                               THIRD_INDEX) OF COMPONENT_TYPE ;
+           WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
+                                                 (CUBE'RANGE (2) =>
+                                                 (CUBE'RANGE (3) =>
+                                                      DEFAULT_VALUE))))
+                         RETURN CUBE ;
+                         
+      FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN ;
+     
+      FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN IS
+      BEGIN  -- FUNC_WITH_3D_FUNC
+      
+           RETURN FUN = CUBE'(CUBE'RANGE =>
+                             (CUBE'RANGE (2) =>
+                             (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
+                        
+      END FUNC_WITH_3D_FUNC ;
+     
+      GENERIC
+     
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE THIRD_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           DEFAULT_VALUE : IN COMPONENT_TYPE ;
+           TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                               SECOND_INDEX,
+                               THIRD_INDEX) OF COMPONENT_TYPE ;
+           WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
+                                                     (CUBE'RANGE (2) =>
+                                                     (CUBE'RANGE (3) =>
+                                                      DEFAULT_VALUE))) ;
+                                OUTPUT : OUT CUBE) ;
+                         
+      PROCEDURE PROC_WITH_3D_PROC ;
+     
+      PROCEDURE PROC_WITH_3D_PROC IS
+     
+           RESULTS : CUBE ;
+         
+      BEGIN  -- PROC_WITH_3D_PROC
+     
+           PROC (OUTPUT => RESULTS) ;
+         
+           IF RESULTS /= CUBE'(CUBE'RANGE =>
+                              (CUBE'RANGE (2) =>
+                              (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                               "ARRAY, PROCEDURE, AND PROCEDURE.") ;
+           END IF ;
+         
+      END PROC_WITH_3D_PROC ;
+ 
+      GENERIC
+     
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE THIRD_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           DEFAULT_VALUE : IN COMPONENT_TYPE ;
+           TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                               SECOND_INDEX,
+                               THIRD_INDEX) OF COMPONENT_TYPE ;
+           WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
+                                                     (CUBE'RANGE (2) =>
+                                                     (CUBE'RANGE (3) =>
+                                                      DEFAULT_VALUE))) ;
+                                OUTPUT : OUT CUBE) ;
+                         
+      PACKAGE PKG_WITH_3D_PROC IS
+      END PKG_WITH_3D_PROC ;
+     
+      PACKAGE BODY PKG_WITH_3D_PROC IS
+     
+           RESULTS : CUBE ;
+         
+      BEGIN  -- PKG_WITH_3D_PROC
+     
+           PROC (OUTPUT => RESULTS) ;
+         
+           IF RESULTS /= CUBE'(CUBE'RANGE =>
+                              (CUBE'RANGE (2) =>
+                              (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+                REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                               "ARRAY, PROCEDURE, AND PACKAGE.") ;
+           END IF ;
+         
+      END PKG_WITH_3D_PROC ;
+     
+      GENERIC
+     
+           TYPE FIRST_INDEX IS (<>) ;
+           TYPE SECOND_INDEX IS (<>) ;
+           TYPE THIRD_INDEX IS (<>) ;
+           TYPE COMPONENT_TYPE IS PRIVATE ;
+           DEFAULT_VALUE : IN COMPONENT_TYPE ;
+           TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                               SECOND_INDEX,
+                               THIRD_INDEX) OF COMPONENT_TYPE ;
+           WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
+                                                     (CUBE'RANGE (2) =>
+                                                     (CUBE'RANGE (3) =>
+                                                      DEFAULT_VALUE))) ;
+                                OUTPUT : OUT CUBE) ;
+                         
+      FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN ;
+     
+      FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN IS
+     
+           RESULTS : CUBE ;
+         
+      BEGIN  -- FUNC_WITH_3D_PROC
+     
+           PROC (OUTPUT => RESULTS) ;
+           RETURN RESULTS = CUBE'(CUBE'RANGE =>
+                                 (CUBE'RANGE (2) =>
+                                 (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
+                          
+      END FUNC_WITH_3D_PROC ;
+     
+      GENERIC
+           TYPE T IS (<>);
+           WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
+      FUNCTION FUNC1 RETURN BOOLEAN;
+ 
+      FUNCTION FUNC1 RETURN BOOLEAN IS
+      BEGIN  -- FUNC1
+          RETURN F = T'VAL (0);
+      END FUNC1;
+ 
+      GENERIC
+           TYPE T IS (<>);
+           WITH FUNCTION F (X : T := T'VAL (REPORT.IDENT_INT(0)))
+                         RETURN T;
+      PACKAGE PKG1 IS END PKG1;
+ 
+      PACKAGE BODY PKG1 IS
+      BEGIN  -- PKG1
+           IF F /= T'VAL (0) THEN
+                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                               "FUNCTION 'F' AND PACKAGE 'PKG1'" );
+           END IF;
+      END PKG1;
+      GENERIC
+           TYPE T IS (<>);
+           WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
+      PROCEDURE PROC1;
+ 
+      PROCEDURE PROC1 IS
+      BEGIN  -- PROC1
+           IF F /= T'VAL (0) THEN
+                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                               "FUNCTION 'F' AND PROCEDURE 'PROC1'" );
+           END IF;
+      END PROC1;
+ 
+      GENERIC
+           TYPE T IS (<>);
+           WITH PROCEDURE P (RESULTS : OUT T ; 
+                             X       : T := T'VAL (0)) ;
+      FUNCTION FUNC2 RETURN BOOLEAN;
+ 
+      FUNCTION FUNC2 RETURN BOOLEAN IS
+           RESULTS : T;
+      BEGIN  -- FUNC2
+           P (RESULTS);
+           RETURN RESULTS = T'VAL (0);
+      END FUNC2;
+ 
+      GENERIC
+           TYPE T IS (<>);
+           WITH PROCEDURE P (RESULTS : OUT T;
+                             X       : T := T'VAL(REPORT.IDENT_INT(0)));
+      PACKAGE PKG2 IS END PKG2 ;
+ 
+      PACKAGE BODY PKG2 IS
+           RESULTS : T;
+      BEGIN  -- PKG2
+           P (RESULTS);
+           IF RESULTS /= T'VAL (0) THEN
+                 REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                                "PROCEDURE 'P' AND PACKAGE 'PKG2'" );
+           END IF;
+      END PKG2;
+ 
+      GENERIC
+           TYPE T IS (<>);
+           WITH PROCEDURE P (RESULTS :OUT T; X : T := T'VAL (0));
+      PROCEDURE PROC2;
+ 
+      PROCEDURE PROC2 IS
+           RESULTS : T;
+      BEGIN  -- PROC2
+           P (RESULTS);
+           IF RESULTS /= T'VAL (0) THEN
+                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                              "PROCEDURE 'P' AND PROCEDURE 'PROC2'" );
+           END IF;
+      END PROC2;
+ 
+      FUNCTION F1 (A : NUMBERS := ONE) RETURN NUMBERS IS
+      BEGIN  -- F1
+           RETURN A;
+      END;
+ 
+      PROCEDURE P2 (OUTVAR : OUT NUMBERS; INVAR : NUMBERS := TWO) IS
+      BEGIN  -- P2
+           OUTVAR := INVAR;
+      END;
+ 
+      FUNCTION TD_FUNC (FIRST : IN THREE_DIMENSIONAL :=
+                                        (THREE_DIMENSIONAL'RANGE =>
+                                        (THREE_DIMENSIONAL'RANGE (2) =>
+                                        (THREE_DIMENSIONAL'RANGE (3) =>
+                                             FIRST_DATE))))
+               RETURN THREE_DIMENSIONAL IS 
+                 
+      BEGIN  -- TD_FUNC
+     
+           RETURN FIRST ;
+         
+      END TD_FUNC ;
+     
+      PROCEDURE TD_PROC (INPUT  : IN  THREE_DIMENSIONAL := 
+                                         (THREE_DIMENSIONAL'RANGE =>
+                                         (THREE_DIMENSIONAL'RANGE (2) =>
+                                         (THREE_DIMENSIONAL'RANGE (3) =>
+                                              FIRST_DATE))) ;
+                         OUTPUT : OUT THREE_DIMENSIONAL) IS
+      BEGIN  -- TD_PROC
+     
+           OUTPUT := INPUT ;
+         
+      END TD_PROC ;
+     
+      PROCEDURE NEW_PROC_WITH_3D_FUNC IS NEW 
+           PROC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
+                              SECOND_INDEX   => FIRST_HALF,
+                              THIRD_INDEX    => FIRST_FIVE,
+                              COMPONENT_TYPE => DATE,
+                              DEFAULT_VALUE  => TODAY,
+                              CUBE           => THREE_DIMENSIONAL,
+                              FUN            => TD_FUNC) ;
+ 
+      PACKAGE NEW_PKG_WITH_3D_FUNC IS NEW 
+           PKG_WITH_3D_FUNC (FIRST_INDEX     => REALLY_SHORT,
+                             SECOND_INDEX    => FIRST_HALF,
+                             THIRD_INDEX     => FIRST_FIVE,
+                             COMPONENT_TYPE  => DATE,
+                             DEFAULT_VALUE   => TODAY,
+                             CUBE            => THREE_DIMENSIONAL,
+                             FUN             => TD_FUNC) ;
+ 
+       FUNCTION NEW_FUNC_WITH_3D_FUNC IS NEW 
+           FUNC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
+                              SECOND_INDEX   => FIRST_HALF,
+                              THIRD_INDEX    => FIRST_FIVE,
+                              COMPONENT_TYPE => DATE,
+                              DEFAULT_VALUE  => TODAY,
+                              CUBE           => THREE_DIMENSIONAL,
+                              FUN            => TD_FUNC) ;
+ 
+      PROCEDURE NEW_PROC_WITH_3D_PROC IS NEW 
+           PROC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
+                              SECOND_INDEX   => FIRST_HALF,
+                              THIRD_INDEX    => FIRST_FIVE,
+                              COMPONENT_TYPE => DATE,
+                              DEFAULT_VALUE  => TODAY,
+                              CUBE           => THREE_DIMENSIONAL,
+                              PROC           => TD_PROC) ;
+ 
+      PACKAGE NEW_PKG_WITH_3D_PROC IS NEW 
+           PKG_WITH_3D_PROC (FIRST_INDEX     => REALLY_SHORT,
+                             SECOND_INDEX   => FIRST_HALF,
+                             THIRD_INDEX    => FIRST_FIVE,
+                             COMPONENT_TYPE => DATE,
+                             DEFAULT_VALUE  => TODAY,
+                             CUBE           => THREE_DIMENSIONAL,
+                             PROC           => TD_PROC) ;
+ 
+      FUNCTION NEW_FUNC_WITH_3D_PROC IS NEW 
+           FUNC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
+                              SECOND_INDEX   => FIRST_HALF,
+                              THIRD_INDEX    => FIRST_FIVE,
+                              COMPONENT_TYPE => DATE,
+                              DEFAULT_VALUE  => TODAY,
+                              CUBE           => THREE_DIMENSIONAL,
+                              PROC           => TD_PROC) ;
+ 
+      FUNCTION  NFUNC1 IS NEW FUNC1 (NUMBERS, F1);
+      PACKAGE   NPKG1  IS NEW PKG1  (NUMBERS, F1);
+      PROCEDURE NPROC1 IS NEW PROC1 (NUMBERS, F1);
+ 
+      FUNCTION  NFUNC2 IS NEW FUNC2 (NUMBERS, P2);
+      PACKAGE   NPKG2  IS NEW PKG2  (NUMBERS, P2);
+      PROCEDURE NPROC2 IS NEW PROC2 (NUMBERS, P2);
+ 
+ BEGIN  -- CC1311A
+ 
+      IF NOT NFUNC1 THEN
+           REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
+                          "WITH FUNCTION 'NFUNC1'" ) ;
+      END IF ;
+ 
+      IF NOT NFUNC2 THEN
+           REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
+                          "WITH FUNCTION 'NFUNC2'" ) ;
+      END IF ;
+ 
+      NPROC1 ;
+      NPROC2 ;
+     
+      NEW_PROC_WITH_3D_FUNC ;
+     
+      IF NOT NEW_FUNC_WITH_3D_FUNC THEN
+           REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
+                          "FUNCTION, AND FUNCTION.") ;
+      END IF ;
+     
+      NEW_PROC_WITH_3D_PROC ;
+     
+      IF NOT NEW_FUNC_WITH_3D_PROC THEN
+           REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
+                          "FUNCTION, AND PROCEDURE.") ;
+      END IF ;
+         
+      REPORT.RESULT ;
+ 
+ END CC1311A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1311b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1311b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc1311b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc1311b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,332 ----
+ -- CC1311B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT IF PARAMETERS OF DEFAULT AND FORMAL SUBPROGRAMS HAVE
+ --     THE SAME TYPE BUT NOT THE SAME SUBTYPE, THE PARAMETER SUBTYPES OF
+ --     THE SUBPROGRAM DENOTED BY THE DEFAULT ARE USED INSTEAD OF
+ --     SUBTYPES SPECIFIED IN THE FORMAL SUBPROGRAM DECLARATION.
+ 
+ -- HISTORY:
+ --     RJW 06/11/86 CREATED ORIGINAL TEST.
+ --     DHH 10/20/86 CORRECTED RANGE ERRORS.
+ --     PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
+ --     PWN 10/27/95 REMOVED CHECKS AGAINST ARRAY SLIDING RULES THAT
+ --                  HAVE BEEN RELAXED.
+ --     PWN 10/25/96 RESTORED CHECKS WITH NEW ADA 95 EXPECTED RESULTS.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC1311B IS
+ 
+ BEGIN
+      TEST ("CC1311B", "CHECK THAT IF PARAMETERS OF DEFAULT AND " &
+                       "FORMAL SUBPROGRAMS HAVE THE SAME TYPE BUT " &
+                       "NOT THE SAME SUBTYPE, THE PARAMETER SUBTYPES " &
+                       "OF THE SUBPROGRAM DENOTED BY THE DEFAULT ARE " &
+                       "USED INSTEAD OF SUBTYPES SPECIFIED IN THE " &
+                       "FORMAL SUBPROGRAM DECLARATION" );
+ 
+      DECLARE
+           TYPE NUMBERS IS (ZERO, ONE ,TWO);
+           SUBTYPE ZERO_TWO IS NUMBERS;
+           SUBTYPE ZERO_ONE IS NUMBERS RANGE ZERO .. ONE;
+ 
+           FUNCTION FSUB (X : ZERO_ONE) RETURN ZERO_ONE IS
+           BEGIN
+                RETURN NUMBERS'VAL (IDENT_INT (NUMBERS'POS (ONE)));
+           END FSUB;
+ 
+           GENERIC
+                WITH FUNCTION F (X : ZERO_TWO := TWO) RETURN ZERO_TWO
+                     IS FSUB;
+           FUNCTION FUNC  RETURN ZERO_TWO;
+ 
+           FUNCTION FUNC RETURN ZERO_TWO IS
+           BEGIN
+                RETURN F;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     RETURN ZERO;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                              "NFUNC1" );
+                     RETURN ZERO;
+           END FUNC;
+ 
+           FUNCTION NFUNC1 IS NEW FUNC;
+ 
+      BEGIN
+           IF NFUNC1 = ONE THEN
+                FAILED ( "NO EXCEPTION RAISED WITH NFUNC1" );
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE GENDER IS (MALE, FEMALE);
+ 
+           TYPE PERSON (SEX : GENDER) IS
+                RECORD
+                    CASE SEX IS
+                          WHEN MALE =>
+                               BEARDED : BOOLEAN;
+                          WHEN FEMALE =>
+                               CHILDREN : INTEGER;
+                     END CASE;
+                END RECORD;
+ 
+           SUBTYPE MAN IS PERSON (SEX => MALE);
+           SUBTYPE TESTWRITER IS PERSON (FEMALE);
+ 
+           ROSA : TESTWRITER := (FEMALE, 4);
+ 
+           FUNCTION F (X : MAN) RETURN PERSON IS
+                TOM : PERSON (MALE) := (MALE, FALSE);
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RETURN X;
+                ELSE
+                     RETURN TOM;
+                END IF;
+           END F;
+ 
+           GENERIC
+                TYPE T IS PRIVATE;
+                X1 : T;
+                WITH FUNCTION F (X : T) RETURN T IS <> ;
+           PACKAGE PKG IS END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                IF F(X1) = X1 THEN
+                     FAILED ( "NO EXCEPTION RAISED WITH " &
+                              "FUNCTION 'F' AND PACKAGE " &
+                              "'PKG' - 1" );
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED WITH " &
+                              "FUNCTION 'F' AND PACKAGE " &
+                              "'PKG' - 2" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                              "FUNCTION 'F' AND PACKAGE 'PKG'" );
+           END PKG;
+ 
+           PACKAGE NPKG IS NEW PKG (TESTWRITER, ROSA);
+ 
+      BEGIN
+           COMMENT ( "PACKAGE BODY ELABORATED - 1" );
+      END;
+ 
+      DECLARE
+           TYPE VECTOR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           SUBTYPE SUBV1 IS VECTOR (1 .. 5);
+           SUBTYPE SUBV2 IS VECTOR (2 .. 6);
+ 
+           V1 : SUBV1 := (1, 2, 3, 4, 5);
+ 
+           FUNCTION FSUB (Y : SUBV2) RETURN VECTOR IS
+                Z : SUBV2;
+           BEGIN
+                FOR I IN Y'RANGE LOOP
+                     Z (I) := IDENT_INT (Y (I));
+                END LOOP;
+                RETURN Z;
+           END;
+ 
+           GENERIC
+            WITH FUNCTION F (X : SUBV1 := V1) RETURN SUBV1 IS FSUB;
+           PROCEDURE PROC;
+ 
+           PROCEDURE PROC IS
+           BEGIN
+                IF F = V1 THEN
+                     COMMENT ( "NO EXCEPTION RAISED WITH " &
+                               "FUNCTION 'F' AND PROCEDURE " &
+                               "'PROC' - 1" );
+                ELSE
+                     COMMENT ( "NO EXCEPTION RAISED WITH " &
+                               "FUNCTION 'F' AND PROCEDURE " &
+                               "'PROC' - 2" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                              "FUNCTION 'F' AND PROCEDURE " &
+                              "'PROC'" );
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                              "FUNCTION 'F' AND PROCEDURE " &
+                              "'PROC'" );
+           END PROC;
+ 
+           PROCEDURE NPROC IS NEW PROC;
+      BEGIN
+           NPROC;
+      END;
+ 
+      DECLARE
+ 
+           TYPE ACC IS ACCESS STRING;
+ 
+           SUBTYPE INDEX1 IS INTEGER RANGE 1 .. 5;
+           SUBTYPE INDEX2 IS INTEGER RANGE 2 .. 6;
+ 
+           SUBTYPE ACC1 IS ACC (INDEX1);
+           SUBTYPE ACC2 IS ACC (INDEX2);
+ 
+           AC2 : ACC2 := NEW STRING'(2 .. 6 => 'A');
+           AC  : ACC;
+ 
+           PROCEDURE P (RESULTS : OUT ACC1; X : ACC1) IS
+           BEGIN
+                RESULTS := NULL;
+           END P;
+ 
+           GENERIC
+            WITH PROCEDURE P1 (RESULTS : OUT ACC2; X : ACC2 := AC2)
+                     IS P;
+           FUNCTION FUNC RETURN ACC;
+ 
+           FUNCTION FUNC RETURN ACC IS
+                RESULTS : ACC;
+           BEGIN
+                P1 (RESULTS);
+                RETURN RESULTS;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     RETURN NEW STRING'("ABCDE");
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                              "NFUNC2" );
+                     RETURN NULL;
+           END FUNC;
+ 
+           FUNCTION NFUNC2 IS NEW FUNC;
+ 
+      BEGIN
+           AC := NFUNC2;
+           IF AC = NULL OR ELSE AC.ALL /= "ABCDE" THEN
+             FAILED ( "NO OR WRONG EXCEPTION RAISED WITH NFUNC2" );
+           END IF;
+      END;
+ 
+      DECLARE
+           SUBTYPE FLOAT1 IS FLOAT RANGE -1.0 .. 0.0;
+           SUBTYPE FLOAT2 IS FLOAT RANGE  0.0 .. 1.0;
+ 
+           PROCEDURE PSUB (RESULTS : OUT FLOAT2; X : FLOAT2) IS
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RESULTS := X;
+                ELSE
+                     RESULTS := 0.0;
+                END IF;
+           END PSUB;
+ 
+           GENERIC
+                WITH PROCEDURE P (RESULTS : OUT FLOAT1;
+                                  X : FLOAT1 := -0.0625) IS PSUB;
+           PACKAGE PKG IS END PKG;
+ 
+           PACKAGE BODY PKG IS
+                RESULTS : FLOAT1;
+           BEGIN
+                P (RESULTS);
+                IF RESULTS = 1.0 THEN
+                     FAILED ( "NO EXCEPTION RAISED WITH " &
+                              "PROCEDURE 'P' AND PACKAGE " &
+                              "'PKG' - 1" );
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED WITH " &
+                              "PROCEDURE 'P' AND PACKAGE " &
+                              "'PKG' - 2" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                              "PROCEDURE 'P' AND PACKAGE 'PKG'" );
+           END PKG;
+ 
+           PACKAGE NPKG IS NEW PKG;
+      BEGIN
+           COMMENT ( "PACKAGE BODY ELABORATED - 2" );
+      END;
+ 
+      DECLARE
+           TYPE FIXED IS DELTA 0.125 RANGE -1.0 .. 1.0;
+           SUBTYPE FIXED1 IS FIXED RANGE -0.5 .. 0.0;
+           SUBTYPE FIXED2 IS FIXED RANGE  0.0 .. 0.5;
+ 
+           PROCEDURE P (RESULTS : OUT FIXED1; X : FIXED1) IS
+           BEGIN
+                IF EQUAL (3, 3) THEN
+                     RESULTS := X;
+                ELSE
+                     RESULTS := X;
+                END IF;
+           END P;
+ 
+           GENERIC
+                TYPE F IS DELTA <>;
+                F1 : F;
+                WITH PROCEDURE P (RESULTS : OUT F; X : F) IS <> ;
+           PROCEDURE PROC;
+ 
+           PROCEDURE PROC IS
+                RESULTS : F;
+           BEGIN
+                P (RESULTS, F1);
+                IF RESULTS = 0.0 THEN
+                     FAILED ( "NO EXCEPTION RAISED WITH " &
+                              "PROCEDURE 'P' AND PROCEDURE " &
+                              "'PROC' - 1" );
+                ELSE
+                     FAILED ( "NO EXCEPTION RAISED WITH " &
+                              "PROCEDURE 'P' AND PROCEDURE " &
+                              "'PROC' - 2" );
+                END IF;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                              "PROCEDURE 'P' AND PROCEDURE " &
+                              "'PROC'" );
+           END PROC;
+ 
+           PROCEDURE NPROC IS NEW PROC (FIXED2, 0.125);
+ 
+      BEGIN
+           NPROC;
+      END;
+ 
+      RESULT;
+ 
+ END CC1311B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc2002a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc2002a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc2002a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc2002a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,77 ----
+ -- CC2002A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT THE ELABORATION OF A GENERIC BODY HAS NO EFFECT OTHER
+ -- THAN TO ESTABLISH THE TEMPLATE BODY TO BE USED FOR THE
+ -- CORRESPONDING INSTANTIATIONS.
+ 
+ -- ASL 09/02/81
+ -- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+ -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC2002A IS
+ 
+      GLOBAL : INTEGER := 0;
+      Q : INTEGER RANGE 1..1 := 1;
+ BEGIN
+      TEST ("CC2002A","NO SIDE EFFECTS OF ELABORATION OF GENERIC BODY");
+ 
+      BEGIN
+           DECLARE
+                GENERIC
+                     PACKAGE P IS
+                     END P;
+ 
+                GENERIC PROCEDURE PROC;
+ 
+                     PROCEDURE PROC IS
+                          C : CONSTANT INTEGER RANGE 1 .. 1 := 2;
+                     BEGIN
+                          RAISE PROGRAM_ERROR;
+                     END PROC;
+ 
+                     PACKAGE BODY P IS
+                          C : CONSTANT BOOLEAN := 
+                               BOOLEAN'SUCC(IDENT_BOOL(TRUE));
+                     BEGIN
+                          GLOBAL := 1;
+                          Q := Q + 1;
+                     END P;
+           BEGIN
+                NULL;
+           END;
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("EXCEPTION RAISED DURING ELABORATION OF " &
+                        "GENERIC BODY");
+      END;
+ 
+      IF GLOBAL /= 0 THEN
+           FAILED ("VALUE OF GLOBAL VARIABLE CHANGED BY ELABORATION " &
+                   "OF GENERIC BODY");
+      END IF;
+ 
+      RESULT;
+ END CC2002A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc30001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc30001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc30001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc30001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,219 ----
+ -- CC30001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if a non-overriding primitive subprogram is declared for
+ --      a type derived from a formal derived tagged type, the copy of that
+ --      subprogram in an instance can override a subprogram inherited from the
+ --      actual type.
+ --
+ -- TEST DESCRIPTION:
+ --      User writes program to handle both mail messages and system messages.
+ --
+ --      Mail messages are created by instantiating a generic "mail" package
+ --      with a root message type. System messages are created by
+ --      instantiating the generic with a system message type derived from the
+ --      root in a separate package. The system message type has a primitive
+ --      subprogram called Send.
+ --
+ --      Inside the generic, a "mail" type is derived from the generic formal
+ --      derived type, and a "Send" operation is declared.
+ --
+ --      Declare a root tagged type T. Declare a generic package with a formal
+ --      derived type using the root tagged type as ancestor. In the generic,
+ --      derive a type from the formal derived type and declare a primitive
+ --      subprogram for it. In a separate package, declare a derivative DT of
+ --      the root tagged type T and declare a primitive subprogram which is
+ --      type conformant with (and hence, overridable for) the primitive
+ --      declared in the generic. Instantiate the generic for DT. Make both
+ --      dispatching and non-dispatching calls to the primitive subprogram. In
+ --      both cases the version of the subprogram in the instance should be
+ --      called (since it overrides the implementation inherited from the
+ --      actual).
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      13 Apr 95   SAIC    Replaced call involving instance for root tagged
+ --                          type with a dispatching call involving instance
+ --                          for derived type. Updated commentary. Moved
+ --                          instantiations (and related commentary) to
+ --                          library-level to avoid accessibility violation.
+ --                          Commented out instantiation for root tagged type.
+ --      27 Feb 97   PWB.CTA Added elaboration pragma.
+ --!
+ 
+ package CC30001_0 is  -- Root message type.
+ 
+    type Msg_Type is tagged record
+       Text         : String (1 .. 20);
+       Message_Sent : Boolean;
+    end record;
+ 
+ end CC30001_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC30001_0;  -- Root message type.
+ generic          -- Generic "mail" package.
+    type Message is new CC30001_0.Msg_Type with private;
+ package CC30001_1 is
+ 
+    type Mail_Type is new Message with record   -- Derived from formal type.
+       To : String (1 .. 8);
+    end record;
+ 
+    procedure Send (M : in out Mail_Type);      -- For this test, this version
+                                                -- of Send should be called in
+    -- ... Other operations.                    -- all cases.
+ 
+ end CC30001_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC30001_1 is
+ 
+    procedure Send (M : in out Mail_Type) is
+    begin
+       -- ... Code to send message omitted for brevity.
+       M.Message_Sent := True;
+    end Send;
+ 
+ end CC30001_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC30001_0;       -- Root message type.
+ package CC30001_2 is  -- System message type and operations.
+ 
+    type Signal_Type is (Note, Warning, Error);
+ 
+    type Sys_Message is new CC30001_0.Msg_Type with record   -- Derived from
+       Signal : Signal_Type := Warning;                      -- root type.
+    end record;
+ 
+    procedure Send (Item : in out Sys_Message); -- For this test, this version
+                                                -- of Send should never be
+    -- ... Other operations.                    -- called (it will have been
+                                                -- overridden).
+ end CC30001_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC30001_2 is
+ 
+    procedure Send (Item : in out Sys_Message) is
+    begin
+       -- ... Code to send message omitted for brevity.
+       Item.Message_Sent := False;  -- Ensure this procedure gives a different
+    end Send;                       -- result than CC30001_1.Send.
+ 
+ end CC30001_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- User first sets up support for mail messages by instantiating the
+ -- generic mail package for the root message type. An operation "Send" is
+ -- declared for the mail message type in the instance.
+ --
+ -- with CC30001_0;  -- Root message type.
+ -- with CC30001_1;  -- Generic "mail" package.
+ -- package Mail_Messages is new CC30001_1 (CC30001_0.Msg_Type);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- Next, the user sets up support for system messages by instantiating the
+ -- generic mail package with the system message type. An operation "Send"
+ -- is declared for the "system" mail message type in the instance. This
+ -- operation overrides the "Send" operation inherited from the system
+ -- message type actual (a situation the user may not have intended).
+ 
+ with CC30001_1;  -- Generic "mail" package.
+ with CC30001_2;  -- System message type and operations.
+ pragma Elaborate (CC30001_1);
+ package CC30001_3 is new CC30001_1 (CC30001_2.Sys_Message);
+ 
+ 
+      --==================================================================--
+ 
+ with CC30001_2;  -- System message type and operations.
+ with CC30001_3;  -- Instance with mail type and operations.
+ 
+ with Report;
+ procedure CC30001 is
+ 
+    package System_Messages renames CC30001_3;
+ 
+ 
+    Sys_Msg1 : System_Messages.Mail_Type := (Text   => "System shutting down",
+                                             Signal => CC30001_2.Warning,
+                                             To     => "AllUsers",
+                                             Message_Sent => False);
+ 
+    Sys_Msg2 : System_Messages.Mail_Type'Class := Sys_Msg1;
+ 
+ 
+    use System_Messages, CC30001_2;                 -- All versions of "Send"
+                                                    -- directly visible.
+ 
+ begin
+ 
+    Report.Test ("CC30001", "Check that if a non-overriding primitive "     &
+                 "subprogram is declared for a type derived from a formal " &
+                 "derived tagged type, the copy of that subprogram in an "  &
+                 "instance can override a subprogram inherited from the "   &
+                 "actual type");
+ 
+ 
+    Send (Sys_Msg1);   -- Calls version declared in instance (version declared
+                       -- in CC30001_2 has been overridden).
+ 
+    if not Sys_Msg1.Message_Sent then
+       Report.Failed ("Non-dispatching call: instance operation not called");
+    end if;
+ 
+ 
+    Send (Sys_Msg2);   -- Calls version declared in instance (version declared
+                       -- in CC30001_2 has been overridden).
+ 
+    if not Sys_Msg2.Message_Sent then
+       Report.Failed ("Dispatching call: instance operation not called");
+    end if;
+ 
+ 
+    Report.Result;
+ end CC30001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc30002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc30002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc30002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc30002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,349 ----
+ -- CC30002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that an explicit declaration in the private part of an instance
+ --      does not override an implicit declaration in the instance, unless the
+ --	corresponding explicit declaration in the generic overrides a
+ --      corresponding implicit declaration in the generic. Check for primitive
+ --      subprograms of tagged types.
+ --
+ -- TEST DESCRIPTION:
+ --      Consider the following:
+ --
+ --         type Ancestor is tagged null record;
+ --         procedure R (X: in Ancestor);
+ --
+ --         generic
+ --            type Formal is new Ancestor with private;
+ --         package G is
+ --            type T is new Formal with null record;
+ --            -- Implicit procedure R (X: in T);
+ --            procedure P (X: in T);  -- (1)
+ --         private
+ --            procedure Q (X: in T);  -- (2)
+ --            procedure R (X: in T);  -- (3) Overrides implicit R in generic.
+ --         end G;
+ --
+ --         type Actual is new Ancestor with null record;
+ --         procedure P (X: in Actual);
+ --         procedure Q (X: in Actual);
+ --         procedure R (X: in Actual);
+ --
+ --         package Instance is new G (Formal => Actual);
+ --
+ --      In the instance, the copy of P at (1) overrides Actual's P, since it
+ --      is declared in the visible part of the instance. The copy of Q at (2)
+ --      does not override anything. The copy of R at (3) overrides Actual's
+ --      R, even though it is declared in the private part, because within
+ --      the generic the explicit declaration of R overrides an implicit
+ --      declaration.
+ --
+ --      Thus, for calls involving a parameter with tag T:
+ --         - Calls to P will execute the body declared for T.
+ --         - Calls to Q from within Instance will execute the body declared
+ --           for T.
+ --         - Calls to Q from outside Instance will execute the body declared
+ --           for Actual.
+ --         - Calls to R will execute the body declared for T.
+ --
+ --      Verify this behavior for both dispatching and nondispatching calls to
+ --      Q and R. 
+ --
+ --
+ -- CHANGE HISTORY:
+ --      24 Feb 95   SAIC    Initial prerelease version.
+ --
+ --!
+ 
+ package CC30002_0 is
+ 
+    type TC_Body_Kind is (Body_Of_Ancestor, Body_In_Instance,
+                          Body_Of_Actual,   Initial_Value);
+ 
+    type Camera is tagged record
+       -- ... Camera components.
+       TC_Focus_Called   : TC_Body_Kind := Initial_Value;
+       TC_Shutter_Called : TC_Body_Kind := Initial_Value;
+    end record;
+ 
+    procedure Focus (C: in out Camera);
+ 
+    -- ...Other operations.
+ 
+ end CC30002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC30002_0 is
+ 
+    procedure Focus (C: in out Camera) is
+    begin
+       -- Artificial for testing purposes.
+       C.TC_Focus_Called := Body_Of_Ancestor;
+    end Focus;
+ 
+ end CC30002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC30002_0;
+ use  CC30002_0;
+ generic
+    type Camera_Type is new CC30002_0.Camera with private;
+ package CC30002_1 is
+ 
+    type Speed_Camera is new Camera_Type with record
+       Diag_Code: Positive;
+       -- ...Other components.
+    end record;
+ 
+    -- Implicit procedure Focus (C: in out Speed_Camera) declared in generic.
+    procedure Self_Test_NonDisp (C: in out Speed_Camera);
+    procedure Self_Test_Disp    (C: in out Speed_Camera'Class);
+ 
+ private
+ 
+    -- The following explicit declaration of Set_Shutter_Speed does NOT override
+    -- a corresponding implicit declaration in the generic. Therefore, its copy
+    -- does NOT override the implicit declaration (inherited from the actual)
+    -- in the instance.
+ 
+    procedure Set_Shutter_Speed (C: in out Speed_Camera);
+ 
+    -- The following explicit declaration of Focus DOES override a
+    -- corresponding implicit declaration (inherited from the parent) in the
+    -- generic. Therefore, its copy overrides the implicit declaration
+    -- (inherited from the actual) in the instance.
+ 
+    procedure Focus (C: in out Speed_Camera);  -- Overrides implicit Focus
+                                               -- in generic.
+ end CC30002_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC30002_1 is
+ 
+    procedure Self_Test_NonDisp (C: in out Speed_Camera) is
+    begin
+       -- Nondispatching calls:
+       Focus (C);
+       Set_Shutter_Speed (C);
+    end Self_Test_NonDisp;
+ 
+    procedure Self_Test_Disp (C: in out Speed_Camera'Class) is
+    begin
+       -- Dispatching calls:
+       Focus (C);
+       Set_Shutter_Speed (C);
+    end Self_Test_Disp;
+ 
+    procedure Set_Shutter_Speed (C: in out Speed_Camera) is
+    begin
+       -- Artificial for testing purposes.
+       C.TC_Shutter_Called := Body_In_Instance;
+    end Set_Shutter_Speed;
+ 
+    procedure Focus (C: in out Speed_Camera) is
+    begin
+       -- Artificial for testing purposes.
+       C.TC_Focus_Called := Body_In_Instance;
+    end Focus;
+ 
+ end CC30002_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC30002_0;
+ package CC30002_2 is
+ 
+    type Aperture_Camera is new CC30002_0.Camera with record
+       FStop: Natural;
+       -- ...Other components.
+    end record;
+ 
+    procedure Set_Shutter_Speed (C: in out Aperture_Camera);
+    procedure Focus (C: in out Aperture_Camera);
+ 
+ end CC30002_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC30002_2 is
+ 
+    procedure Set_Shutter_Speed (C: in out Aperture_Camera) is
+       use CC30002_0;
+    begin
+       -- Artificial for testing purposes.
+       C.TC_Shutter_Called := Body_Of_Actual;
+    end Set_Shutter_Speed;
+ 
+    procedure Focus (C: in out Aperture_Camera) is
+       use CC30002_0;
+    begin
+       -- Artificial for testing purposes.
+       C.TC_Focus_Called := Body_Of_Actual;
+    end Focus;
+ 
+ end CC30002_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- Instance declaration.
+ 
+ with CC30002_1;
+ with CC30002_2;
+ package CC30002_3 is new CC30002_1 (Camera_Type => CC30002_2.Aperture_Camera);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC30002_0;
+ with CC30002_1;
+ with CC30002_2;
+ with CC30002_3; -- Instance.
+ 
+ with Report;
+ procedure CC30002 is
+ 
+    package Speed_Cameras renames CC30002_3;
+ 
+    use CC30002_0;
+ 
+    TC_Camera1: Speed_Cameras.Speed_Camera;
+    TC_Camera2: Speed_Cameras.Speed_Camera'Class := TC_Camera1;
+    TC_Camera3: Speed_Cameras.Speed_Camera;
+    TC_Camera4: Speed_Cameras.Speed_Camera;
+ 
+ begin
+    Report.Test ("CC30002", "Check that an explicit declaration in the "      &
+                 "private part of an instance does not override an implicit " &
+                 "declaration in the instance, unless the corresponding "     &
+                 "explicit declaration in the generic overrides a "           &
+                 "corresponding implicit declaration in the generic. Check "  &
+                 "for primitive subprograms of tagged types");
+ 
+ --
+ -- Check non-dispatching calls outside instance:
+ --
+ 
+    -- Non-overriding primitive operation:
+ 
+    Speed_Cameras.Set_Shutter_Speed (TC_Camera1);
+    if TC_Camera1.TC_Shutter_Called /= Body_Of_Actual then
+       Report.Failed ("Wrong body executed: non-dispatching call to " &
+                      "Set_Shutter_Speed outside instance");
+    end if;
+ 
+ 
+    -- Overriding primitive operation:
+ 
+    Speed_Cameras.Focus (TC_Camera1);
+    if TC_Camera1.TC_Focus_Called /= Body_In_Instance then
+       Report.Failed ("Wrong body executed: non-dispatching call to " &
+                      "Focus outside instance");
+    end if;
+ 
+ 
+ --
+ -- Check dispatching calls outside instance:
+ --
+ 
+    -- Non-overriding primitive operation:
+ 
+    Speed_Cameras.Set_Shutter_Speed (TC_Camera2);
+    if TC_Camera2.TC_Shutter_Called /= Body_Of_Actual then
+       Report.Failed ("Wrong body executed: dispatching call to " &
+                      "Set_Shutter_Speed outside instance");
+    end if;
+ 
+ 
+    -- Overriding primitive operation:
+ 
+    Speed_Cameras.Focus (TC_Camera2);
+    if TC_Camera2.TC_Focus_Called /= Body_In_Instance then
+       Report.Failed ("Wrong body executed: dispatching call to " &
+                      "Focus outside instance");
+    end if;
+ 
+ 
+ 
+ --
+ -- Check non-dispatching calls within instance:
+ --
+ 
+    Speed_Cameras.Self_Test_NonDisp (TC_Camera3);
+ 
+    -- Non-overriding primitive operation:
+ 
+    if TC_Camera3.TC_Shutter_Called /= Body_In_Instance then
+       Report.Failed ("Wrong body executed: non-dispatching call to " &
+                      "Set_Shutter_Speed inside instance");
+    end if;
+ 
+    -- Overriding primitive operation:
+ 
+    if TC_Camera3.TC_Focus_Called /= Body_In_Instance then
+       Report.Failed ("Wrong body executed: non-dispatching call to " &
+                      "Focus inside instance");
+    end if;
+ 
+ 
+ 
+ --
+ -- Check dispatching calls within instance:
+ --
+ 
+    Speed_Cameras.Self_Test_Disp (TC_Camera4);
+ 
+    -- Non-overriding primitive operation:
+ 
+    if TC_Camera4.TC_Shutter_Called /= Body_In_Instance then
+       Report.Failed ("Wrong body executed: dispatching call to " &
+                      "Set_Shutter_Speed inside instance");
+    end if;
+ 
+    -- Overriding primitive operation:
+ 
+    if TC_Camera4.TC_Focus_Called /= Body_In_Instance then
+       Report.Failed ("Wrong body executed: dispatching call to " &
+                      "Focus inside instance");
+    end if;
+ 
+    Report.Result;
+ end CC30002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3004a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3004a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3004a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3004a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,87 ----
+ -- CC3004A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT ACTUAL PARAMETERS IN A NAMED GENERIC ACTUAL PARAMETER 
+ -- ASSOCIATION MAY BE OUT OF ORDER, AND ARE ASSOCIATED WITH THE 
+ -- CORRECT FORMALS.
+ 
+ -- DAT 9/16/81 
+ -- SPS 10/26/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3004A IS 
+ BEGIN
+      TEST ("CC3004A", "ORDER OF NAMED GENERIC ACTUAL PARAMETERS");
+ 
+      DECLARE
+           GENERIC
+                A,B : INTEGER;
+                C : INTEGER;
+                D : INTEGER;
+           PACKAGE P1 IS END P1;
+ 
+           TYPE AI IS ACCESS INTEGER;
+ 
+           GENERIC
+                TYPE D IS ( <> );
+                VD : D;
+                TYPE AD IS ACCESS D;
+                VA : AD;
+           PACKAGE P2 IS END P2;
+ 
+           X : AI := NEW INTEGER '(IDENT_INT(23));
+           Y : AI := NEW INTEGER '(IDENT_INT(77));
+ 
+           PACKAGE BODY P1 IS
+           BEGIN
+                IF A /= IDENT_INT(4)  OR
+                   B /= IDENT_INT(12) OR
+                   C /= IDENT_INT(11) OR
+                   D /= IDENT_INT(-33)
+                THEN
+                     FAILED ("WRONG GENERIC PARAMETER ASSOCIATIONS");
+                END IF;
+           END P1;
+ 
+           PACKAGE BODY P2 IS
+           BEGIN
+                IF VA.ALL /= VD THEN 
+                     FAILED ("WRONG GENERIC PARM ASSOCIATIONS 2");
+                END IF;
+           END P2;
+ 
+           PACKAGE N1 IS NEW P1 (C => 11, A => 4, D => -33, B => 12);
+ 
+           PACKAGE N2 IS NEW P2 (VA => X, AD => AI, D => INTEGER, 
+                                 VD => 23);
+ 
+           PACKAGE N3 IS NEW P2 (INTEGER, 77, VA => Y, AD => AI);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC3004A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3007a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3007a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3007a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3007a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,118 ----
+ -- CC3007A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT NAMES IN A GENERIC DECLARATIONS ARE STATICALLY BOUND.
+ 
+ -- DAT 9/18/81
+ -- SPS 2/7/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3007A IS
+ BEGIN
+      TEST ("CC3007A", "NAMES IN GENERICS ARE STATICALLY BOUND");
+ 
+      DECLARE
+           I : INTEGER := 1;
+           EX : EXCEPTION;
+           IA : INTEGER := I'SIZE;
+ 
+           FUNCTION F (X : INTEGER) RETURN INTEGER;
+ 
+           PACKAGE P IS
+                Q : INTEGER := 1;
+           END P;
+ 
+           GENERIC
+                J : IN OUT INTEGER;
+                WITH FUNCTION FP (X : INTEGER) RETURN INTEGER IS F;
+           PACKAGE GP IS
+                V1 : INTEGER := F(I);
+                V2 : INTEGER := FP(I);
+           END GP;
+ 
+           GENERIC
+                TYPE T IS RANGE <> ;
+                WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER IS F;
+                INP : IN T := T (I'SIZE);
+           FUNCTION F1 (X : T) RETURN T;
+ 
+           FUNCTION F1 (X : T) RETURN T IS
+           BEGIN
+                IF INP /= T(IA) THEN
+                     FAILED ("INCORRECT GENERIC BINDING 2");
+                END IF;
+                I := I + 1;
+                RETURN 2 * T (F1 (F (INTEGER (X) + I + P.Q)));
+           END F1;
+ 
+           PACKAGE BODY GP IS
+                PACKAGE P IS
+                     Q : INTEGER := I + 1;
+                END P;
+                I : INTEGER := 1000;
+                FUNCTION F IS NEW F1 (INTEGER);
+                FUNCTION F2 IS NEW F1 (INTEGER);
+           BEGIN
+                P.Q := F2 (J + P.Q + V1 + 2 * V2);
+                J := P.Q;
+                RAISE EX;
+           END GP;
+ 
+           FUNCTION F (X : INTEGER) RETURN INTEGER IS
+           BEGIN
+                I := I + 2;
+                RETURN X + I;
+           END;
+      BEGIN
+           DECLARE
+                I : INTEGER := 1000;
+                EX : EXCEPTION;
+                FUNCTION F IS NEW F1 (INTEGER);
+                V : INTEGER := F (3);
+           BEGIN
+                BEGIN
+                     DECLARE
+                          PACKAGE P IS NEW GP (V);
+                     BEGIN
+                          FAILED ("EX NOT RAISED");
+                     END;
+                EXCEPTION
+                     WHEN EX =>
+                          FAILED ("WRONG EXCEPTION RAISED");
+                     WHEN OTHERS =>
+                          IF V /= 266 THEN
+                               FAILED ("WRONG BINDING IN GENERICS");
+                          END IF;
+                          RAISE;
+                END;
+ 
+           END;
+      EXCEPTION
+           WHEN EX => NULL;
+           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+      END;
+ 
+      RESULT;
+ END CC3007A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3007b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3007b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3007b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3007b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,397 ----
+ -- CC3007B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  CHECK THAT THE NAMES IN A GENERIC INSTANTIATION ARE STATICALLY
+ --  IDENTIFIED (I.E., BOUND) AT THE TEXTUAL POINT OF THE INSTANTIA-
+ --  TION, AND ARE BOUND BEFORE BEING "SUBSTITUTED" FOR THE COR-
+ --  RESPONDING GENERIC FORMAL PARAMETERS IN THE SPECIFICATION AND
+ --  BODY TEMPLATES.
+ --
+ --  SEE AI-00365/05-BI-WJ.
+ 
+ -- HISTORY:
+ --      EDWARD V. BERARD, 15 AUGUST 1990
+ --      DAS   08 OCT 90   CHANGED INSTANTIATIONS TO USE VARIABLES
+ --                        M1 AND M2 IN THE FIRST_BLOCK INSTANTIA-
+ --                        TION AND TO ASSIGN THIRD_DATE AND
+ --                        FOURTH_DATE VALUES BEFORE AND AFTER THE
+ --                        SECOND_BLOCK INSTANTIATION.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE CC3007B IS
+ 
+      INCREMENTED_VALUE : NATURAL := 0;
+ 
+      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                          SEP, OCT, NOV, DEC);
+      TYPE DAY_TYPE IS RANGE 1 .. 31;
+      TYPE YEAR_TYPE IS RANGE 1904 .. 2050;
+      TYPE DATE IS RECORD
+           MONTH : MONTH_TYPE;
+           DAY   : DAY_TYPE;
+           YEAR  : YEAR_TYPE;
+      END RECORD;
+ 
+      TYPE DATE_ACCESS IS ACCESS DATE;
+ 
+      TODAY           : DATE := (MONTH => AUG,
+                                 DAY   => 8,
+                                 YEAR  => 1990);
+ 
+      CHRISTMAS       : DATE := (MONTH => DEC,
+                                 DAY   => 25,
+                                 YEAR  => 1948);
+ 
+      WALL_DATE       : DATE := (MONTH => NOV,
+                                 DAY   => 9,
+                                 YEAR  => 1989);
+ 
+      BIRTH_DATE     : DATE := (MONTH => OCT,
+                                DAY   => 3,
+                                YEAR  => 1949);
+ 
+      FIRST_DUE_DATE : DATE := (MONTH => JAN,
+                                DAY   => 23,
+                                YEAR  => 1990);
+ 
+      LAST_DUE_DATE  : DATE := (MONTH => DEC,
+                                DAY   => 20,
+                                YEAR  => 1990);
+ 
+      THIS_MONTH    : MONTH_TYPE := AUG;
+ 
+      STORED_RECORD : DATE := TODAY;
+ 
+      STORED_INDEX  : MONTH_TYPE := AUG;
+ 
+      FIRST_DATE   : DATE_ACCESS := NEW DATE'(WALL_DATE);
+      SECOND_DATE  : DATE_ACCESS := FIRST_DATE;
+ 
+      THIRD_DATE     : DATE_ACCESS := NEW DATE'(BIRTH_DATE);
+      FOURTH_DATE  : DATE_ACCESS := NEW DATE'(CHRISTMAS);
+ 
+      TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE;
+      REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
+                                   (MAR, 23, 1990), (APR, 23, 1990),
+                                   (MAY, 23, 1990), (JUN, 22, 1990),
+                                   (JUL, 23, 1990), (AUG, 23, 1990),
+                                   (SEP, 24, 1990), (OCT, 23, 1990),
+                                   (NOV, 23, 1990), (DEC, 20, 1990));
+ 
+      GENERIC
+ 
+           NATURALLY     : IN NATURAL;
+           FIRST_RECORD  : IN OUT DATE;
+           SECOND_RECORD : IN OUT DATE;
+           TYPE RECORD_POINTER IS ACCESS DATE;
+           POINTER : IN OUT RECORD_POINTER;
+           TYPE ARRAY_TYPE IS ARRAY (MONTH_TYPE) OF DATE;
+           THIS_ARRAY           : IN OUT ARRAY_TYPE;
+           FIRST_ARRAY_ELEMENT  : IN OUT DATE;
+           SECOND_ARRAY_ELEMENT : IN OUT DATE;
+           INDEX_ELEMENT        : IN OUT MONTH_TYPE;
+           POINTER_TEST         : IN OUT DATE;
+           ANOTHER_POINTER_TEST : IN OUT DATE;
+ 
+      PACKAGE TEST_ACTUAL_PARAMETERS IS
+ 
+           PROCEDURE EVALUATE_FUNCTION;
+           PROCEDURE CHECK_RECORDS;
+           PROCEDURE CHECK_ACCESS;
+           PROCEDURE CHECK_ARRAY;
+           PROCEDURE CHECK_ARRAY_ELEMENTS;
+           PROCEDURE CHECK_SCALAR;
+           PROCEDURE CHECK_POINTERS;
+ 
+      END TEST_ACTUAL_PARAMETERS;
+ 
+      PACKAGE BODY TEST_ACTUAL_PARAMETERS IS
+ 
+           PROCEDURE EVALUATE_FUNCTION IS
+           BEGIN  -- EVALUATE_FUNCTION
+ 
+                IF (INCREMENTED_VALUE = 0) OR 
+                   (NATURALLY /= INCREMENTED_VALUE) THEN
+                     REPORT.FAILED ("PROBLEMS EVALUATING FUNCTION " &
+                                    "PARAMETER.");
+                END IF;
+ 
+           END EVALUATE_FUNCTION;
+ 
+           PROCEDURE CHECK_RECORDS IS
+ 
+                STORE : DATE;
+ 
+           BEGIN  -- CHECK_RECORDS
+ 
+                IF STORED_RECORD /= FIRST_RECORD THEN
+                     REPORT.FAILED ("PROBLEM WITH RECORD TYPES");
+                ELSE
+                     STORED_RECORD := SECOND_RECORD;
+                     STORE := FIRST_RECORD;
+                     FIRST_RECORD := SECOND_RECORD;
+                     SECOND_RECORD := STORE;
+                END IF;
+ 
+           END CHECK_RECORDS;
+ 
+           PROCEDURE CHECK_ACCESS IS
+           BEGIN  -- CHECK_ACCESS
+ 
+                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+                THEN
+                     IF POINTER.ALL /= DATE'(WALL_DATE) THEN
+                          REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
+                                         "- 1");
+                     ELSE
+                          POINTER.ALL := DATE'(BIRTH_DATE);
+                     END IF;
+                ELSE
+                     IF POINTER.ALL /= DATE'(BIRTH_DATE) THEN
+                          REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
+                                         "- 2");
+                     ELSE
+                          POINTER.ALL := DATE'(WALL_DATE);
+                     END IF;
+                END IF;
+ 
+           END CHECK_ACCESS;
+ 
+           PROCEDURE CHECK_ARRAY IS
+ 
+                STORE : DATE;
+ 
+           BEGIN  -- CHECK_ARRAY
+ 
+                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+                THEN
+                     IF THIS_ARRAY (THIS_ARRAY'FIRST) /= FIRST_DUE_DATE
+                     THEN
+                          REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 1");
+                     ELSE
+                          THIS_ARRAY (THIS_ARRAY'FIRST) := LAST_DUE_DATE;
+                          THIS_ARRAY (THIS_ARRAY'LAST) := FIRST_DUE_DATE;
+                     END IF;
+                ELSE
+                     IF THIS_ARRAY (THIS_ARRAY'FIRST) /= LAST_DUE_DATE
+                     THEN
+                          REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 2");
+                     ELSE
+                          THIS_ARRAY (THIS_ARRAY'FIRST) :=
+                                                   FIRST_DUE_DATE;
+                          THIS_ARRAY (THIS_ARRAY'LAST)  := LAST_DUE_DATE;
+                     END IF;
+                END IF;
+ 
+           END CHECK_ARRAY;
+ 
+           PROCEDURE CHECK_ARRAY_ELEMENTS IS
+ 
+                STORE : DATE;
+ 
+           BEGIN  -- CHECK_ARRAY_ELEMENTS
+ 
+                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+                THEN
+                     IF (FIRST_ARRAY_ELEMENT.MONTH /= MAY) OR
+                        (SECOND_ARRAY_ELEMENT.DAY /= 22) THEN
+                          REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
+                                         "- 1");
+                     ELSE
+                          STORE := FIRST_ARRAY_ELEMENT;
+                          FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
+                          SECOND_ARRAY_ELEMENT := STORE;
+                     END IF;
+                ELSE
+                     IF (FIRST_ARRAY_ELEMENT.MONTH /= JUN) OR
+                        (SECOND_ARRAY_ELEMENT.DAY /= 23) THEN
+                          REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
+                                         "- 2");
+                     ELSE
+                          STORE := FIRST_ARRAY_ELEMENT;
+                          FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
+                          SECOND_ARRAY_ELEMENT := STORE;
+                     END IF;
+                END IF;
+ 
+           END CHECK_ARRAY_ELEMENTS;
+ 
+           PROCEDURE CHECK_SCALAR IS
+           BEGIN  -- CHECK_SCALAR
+ 
+                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+                THEN
+                     IF INDEX_ELEMENT /= STORED_INDEX THEN
+                          REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 1");
+                     ELSE
+                          INDEX_ELEMENT :=
+                                    MONTH_TYPE'SUCC(INDEX_ELEMENT);
+                          STORED_INDEX := INDEX_ELEMENT;
+                     END IF;
+                ELSE
+                     IF INDEX_ELEMENT /= STORED_INDEX THEN
+                          REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 2");
+                     ELSE
+                          INDEX_ELEMENT :=
+                               MONTH_TYPE'PRED (INDEX_ELEMENT);
+                          STORED_INDEX := INDEX_ELEMENT;
+                     END IF;
+                END IF;
+ 
+           END CHECK_SCALAR;
+ 
+           PROCEDURE CHECK_POINTERS IS
+ 
+                STORE : DATE;
+ 
+           BEGIN  -- CHECK_POINTERS
+ 
+                IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+                THEN
+                     IF (POINTER_TEST /= DATE'(OCT, 3, 1949)) OR
+                        (ANOTHER_POINTER_TEST /= DATE'(DEC, 25, 1948))
+                     THEN
+                          REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
+                                         "- 1");
+                     ELSE
+                          STORE := POINTER_TEST;
+                          POINTER_TEST := ANOTHER_POINTER_TEST;
+                          ANOTHER_POINTER_TEST := STORE;
+                     END IF;
+                ELSE
+                     IF (POINTER_TEST /= DATE'(DEC, 25, 1948)) OR
+                        (ANOTHER_POINTER_TEST /= DATE'(OCT, 3, 1949))
+                     THEN
+                          REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
+                                         "- 2");
+                     ELSE
+                          STORE := POINTER_TEST;
+                          POINTER_TEST := ANOTHER_POINTER_TEST;
+                          ANOTHER_POINTER_TEST := STORE;
+                     END IF;
+                END IF;
+ 
+           END CHECK_POINTERS;
+ 
+      END TEST_ACTUAL_PARAMETERS;
+ 
+      FUNCTION INC RETURN NATURAL IS
+      BEGIN  -- INC
+           INCREMENTED_VALUE := NATURAL'SUCC (INCREMENTED_VALUE);
+           RETURN INCREMENTED_VALUE;
+      END INC;
+ 
+ BEGIN  -- CC3007B
+ 
+      REPORT.TEST ("CC3007B", "CHECK THAT THE NAMES IN A GENERIC " &
+                   "INSTANTIATION ARE STAICALLY IDENTIFIED (I.E., " &
+                   "BOUND) AT THE TEXTUAL POINT OF THE INSTANTIATION" &
+                   ", AND ARE BOUND BEFORE BEING SUBSTITUTED FOR " &
+                   "THE CORRESPONDING GENERIC FORMAL PARAMETERS IN " &
+                   "THE SPECIFICATION AND BODY TEMPLATES.  " &
+                   "SEE AI-00365/05-BI-WJ.");
+ 
+      FIRST_BLOCK:
+ 
+      DECLARE
+ 
+           M1 : MONTH_TYPE := MAY;
+           M2 : MONTH_TYPE := JUN;
+ 
+           PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
+                NEW TEST_ACTUAL_PARAMETERS (
+                     NATURALLY              => INC,
+                     FIRST_RECORD           => TODAY,
+                     SECOND_RECORD          => CHRISTMAS,
+                     RECORD_POINTER         => DATE_ACCESS,
+                     POINTER                => SECOND_DATE,
+                     ARRAY_TYPE             => DUE_DATES,
+                     THIS_ARRAY             => REPORT_DATES,
+                     FIRST_ARRAY_ELEMENT    => REPORT_DATES (M1),
+                     SECOND_ARRAY_ELEMENT   => REPORT_DATES (M2),
+                     INDEX_ELEMENT          => THIS_MONTH,
+                     POINTER_TEST           => THIRD_DATE.ALL,
+                     ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
+ 
+      BEGIN  -- FIRST_BLOCK
+ 
+           REPORT.COMMENT ("ENTERING FIRST BLOCK");
+           NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
+           M1 := SEP;
+           M2 := OCT;
+           -- NEW_TEST_ACTUAL_PARAMETERS SHOULD USE THE PREVIOUS
+           -- VALUES OF MAY AND JUN.
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
+ 
+      END FIRST_BLOCK;
+ 
+      SECOND_BLOCK:
+ 
+      DECLARE
+ 
+           SAVE_THIRD_DATE  : DATE_ACCESS := THIRD_DATE;
+           SAVE_FOURTH_DATE : DATE_ACCESS := FOURTH_DATE;
+ 
+           PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
+                NEW TEST_ACTUAL_PARAMETERS (
+                     NATURALLY              => INC,
+                     FIRST_RECORD           => TODAY,
+                     SECOND_RECORD          => CHRISTMAS,
+                     RECORD_POINTER         => DATE_ACCESS,
+                     POINTER                => SECOND_DATE,
+                     ARRAY_TYPE             => DUE_DATES,
+                     THIS_ARRAY             => REPORT_DATES,
+                     FIRST_ARRAY_ELEMENT    => REPORT_DATES (MAY),
+                     SECOND_ARRAY_ELEMENT   => REPORT_DATES (JUN),
+                     INDEX_ELEMENT          => THIS_MONTH,
+                     POINTER_TEST           => THIRD_DATE.ALL,
+                     ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
+ 
+      BEGIN  -- SECOND_BLOCK
+ 
+           REPORT.COMMENT ("ENTERING SECOND BLOCK");
+           NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
+ 
+           THIRD_DATE := NEW DATE'(JUL, 13, 1951);
+           FOURTH_DATE := NEW DATE'(JUL, 4, 1976);
+           NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
+           THIRD_DATE := SAVE_THIRD_DATE;
+           FOURTH_DATE := SAVE_FOURTH_DATE;
+ 
+      END SECOND_BLOCK;
+ 
+      REPORT.RESULT;
+ 
+ END CC3007B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3011a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3011a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3011a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3011a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,131 ----
+ -- CC3011A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT SUBPROGRAMS THAT WOULD HAVE THE SAME SPECIFICATION
+ -- AFTER GENERIC INSTANTIATION MAY BE DECLARED IN THE SAME
+ -- DECLARATIVE PART, AND THAT CALLS WITHIN THE INSTANTIATED UNIT ARE
+ -- UNAMBIGUOUS.  CHECK THAT CALLS FROM OUTSIDE THE UNIT ARE UNAMBIGUOUS
+ -- IF FORMAL PARAMETER NAMES ARE USED OR IF ONLY ONE OF THE EQUIVALENT
+ -- PROGRAMS APPEARS IN THE VISIBLE PART OF THE PACKAGE.
+ 
+ -- DAT 9/18/81
+ -- SPS 10/19/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3011A IS
+ BEGIN
+      TEST ("CC3011A", "CHECK SUBPROGRAMS IN GENERIC PACKAGES WITH SAME"
+           & " SPECIFICATION AFTER GENERIC PARAMETER SUBSTITUTION");
+ 
+      DECLARE
+           C : INTEGER := 0;
+ 
+           GENERIC
+                TYPE S IS ( <> );
+                TYPE T IS PRIVATE;
+                TYPE U IS RANGE <> ;
+                VT : T;
+           PACKAGE PKG IS
+                PROCEDURE P1 (X : S);
+           PRIVATE
+                PROCEDURE P1 (X : T);
+                VS : S := S'FIRST;
+                VU : U := U'FIRST;
+           END PKG;
+ 
+           GENERIC
+                TYPE S IS (<>);
+                TYPE T IS RANGE <>;
+           PACKAGE PP IS
+                PROCEDURE P1 (D: S);
+                PROCEDURE P1 (X: T);
+           END PP;
+ 
+           PACKAGE BODY PKG IS
+                PROCEDURE P1 (X : S) IS 
+                BEGIN
+                     C := C + 1;
+                END P1;
+                PROCEDURE P1 (X : T) IS
+                BEGIN
+                     C := C + 2;
+                END P1;
+                PROCEDURE P1 (X : U) IS
+                BEGIN
+                     C := C + 4;
+                END P1;
+           BEGIN
+                C := 0;
+                P1 (VS);
+                IF C /= IDENT_INT (1) THEN
+                     FAILED ("WRONG P1 CALLED -S");
+                END IF;
+                C := 0;
+                P1 (VT);
+                IF C /= IDENT_INT (2) THEN
+                     FAILED ("WRONG P1 CALLED -T");
+                END IF;
+                C := 0;
+                P1 (VU);
+                IF C /= IDENT_INT (4) THEN
+                     FAILED ("WRONG P1 CALLED -U");
+                END IF;
+                C := 0;
+           END PKG;
+ 
+           PACKAGE BODY PP IS
+                PROCEDURE P1 (D: S) IS
+                BEGIN
+                     C := C + 3;
+                END P1;
+                PROCEDURE P1 (X: T) IS
+                BEGIN
+                     C := C + 5;
+                END P1;
+           BEGIN
+                NULL;
+           END PP;
+ 
+           PACKAGE NP IS NEW PKG (INTEGER, INTEGER, INTEGER, 7);
+           PACKAGE NPP IS NEW PP (INTEGER, INTEGER);
+      BEGIN
+           NP.P1 (4);
+           IF C /= IDENT_INT (1) THEN
+                FAILED ("INCORRECT OVERLOADING ON FORMAL TYPES");
+           END IF;
+           C := 0;
+           NPP.P1 (D => 3);
+           IF C /= IDENT_INT (3) THEN
+                FAILED ("INCORRECT CALL TO P1 WITH D PARAMETER");
+           END IF;
+           C := 0;
+           NPP.P1 (X => 7);
+           IF C /= IDENT_INT (5) THEN
+                FAILED ("INCORRECT CALL TO P1 WITH X PARAMETER");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3011A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3011d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3011d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3011d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3011d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- CC3011D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC PACKAGE INSTANTIATION CONTAINS DECLARATIONS
+ -- OF SUBPROGRAMS WITH THE SAME SPECIFICATIONS, THE CALLS TO THE
+ -- SUBPROGRAMS ARE NOT AMBIGIOUS WITHIN THE GENERIC BODY.
+ 
+ -- SPS 5/7/82
+ -- SPS 2/7/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3011D IS
+ BEGIN
+      TEST ("CC3011D", "SUBPROGRAMS WITH SAME SPECIFICATIONS NOT"
+           & " AMBIGIOUS WITHIN GENERIC BODY");
+ 
+      DECLARE
+           TYPE FLAG IS (PRT,PRS);
+           XX : FLAG;
+ 
+           GENERIC
+                TYPE S IS PRIVATE;
+                TYPE T IS PRIVATE;
+                V1 : S;
+                V2 : T;
+           PACKAGE P1 IS
+                PROCEDURE PR(X : S);
+                PROCEDURE PR(X : T);
+           END P1;
+ 
+           PACKAGE BODY P1 IS
+                PROCEDURE PR (X : S) IS
+                BEGIN
+                     XX := PRS;
+                END;
+ 
+                PROCEDURE PR (X : T ) IS
+                BEGIN
+                     XX := PRT;
+                END;
+ 
+           BEGIN
+                XX := PRT;
+                PR (V1);
+                IF XX /= PRS THEN
+                     FAILED ("WRONG BINDING FOR PR WITH TYPE S");
+                END IF;
+                XX := PRS;
+                PR (V2);
+                IF XX /= PRT THEN
+                     FAILED ("WRONG BINDING FOR PR WITH TYPE T");
+                END IF;
+           END P1;
+ 
+           PACKAGE PAK IS NEW P1 (INTEGER, INTEGER, 1, 2);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC3011D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3012a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3012a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3012a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3012a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,247 ----
+ -- CC3012A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT GENERIC INSTANCES MAY BE OVERLOADED.
+ 
+ -- CHECK THAT THEY MAY OVERLOAD PREVIOUSLY DECLARED SUBPROGRAMS AND
+ -- ENUMERATION LITERALS.
+ 
+ -- DAT 9/16/81
+ -- SPS 10/19/82
+ -- SPS 2/8/83
+ -- PWN 11/30/94 REMOVED PART OF TEST INVALID FOR ADA 9X.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3012A IS
+ BEGIN
+      TEST ("CC3012A", "CHECK THAT GENERIC INSTANCES MAY OVERLOAD " &
+                       "OTHER IDENTIFIERS");
+ 
+      DECLARE
+           GENERIC 
+                TYPE T IS ( <> );
+                V : IN T;
+           PROCEDURE GP (X : IN OUT T);
+ 
+           GENERIC 
+                TYPE T IS ( <> );
+           FUNCTION LESS (X, Y : T) RETURN BOOLEAN;
+ 
+           GENERIC
+                TYPE T IS ( <> );
+           FUNCTION PLUS (X, Y : T) RETURN T;
+ 
+           GENERIC
+                TYPE T IS PRIVATE;
+                Z : T;
+           FUNCTION F1  RETURN T;
+ 
+           TYPE DC IS NEW CHARACTER RANGE IDENT_CHAR ('A') .. 'Z';
+           TYPE DI IS NEW INTEGER;
+           TYPE ENUM IS (E1, E2, E3, E4);
+ 
+           VC : CHARACTER := 'A';
+           VI : INTEGER := 5;
+           VB : BOOLEAN := TRUE;
+           VE : ENUM := E2;
+ 
+           TYPE DENUM IS NEW ENUM RANGE E2 .. ENUM'LAST;
+ 
+           VDE : DENUM := E4;
+           VDC : DC := 'A';
+           VDI : DI := 7;
+ 
+           PROCEDURE GP (X : IN OUT T) IS
+           BEGIN
+                X := V;
+           END GP;
+ 
+           FUNCTION LESS (X, Y : T) RETURN BOOLEAN IS
+           BEGIN
+                RETURN FALSE;
+           END LESS;
+ 
+           FUNCTION PLUS (X, Y : T) RETURN T IS
+           BEGIN
+                RETURN T'FIRST;
+           END PLUS;
+ 
+           FUNCTION F1 RETURN T IS
+           BEGIN
+                RETURN Z;
+           END F1;
+ 
+           FUNCTION E5 RETURN INTEGER IS
+           BEGIN
+                RETURN 1;
+           END E5;
+ 
+           PACKAGE PKG IS
+           
+                PROCEDURE P IS NEW GP (CHARACTER, 'Q');
+                PROCEDURE P IS NEW GP (INTEGER, -14);
+                PROCEDURE P IS NEW GP (BOOLEAN, FALSE);
+                PROCEDURE P IS NEW GP (ENUM, E4);
+                PROCEDURE P IS NEW GP (DC, 'W');
+                PROCEDURE P IS NEW GP (DI, -33);
+                PROCEDURE P IS NEW GP (DENUM, E2);
+      
+                FUNCTION "<" IS NEW LESS (CHARACTER);
+                FUNCTION "<" IS NEW LESS (INTEGER);
+                FUNCTION "<" IS NEW LESS (BOOLEAN);
+                FUNCTION "<" IS NEW LESS (ENUM);
+                FUNCTION "<" IS NEW LESS (DC);
+                FUNCTION "<" IS NEW LESS (DI);
+                -- NOT FOR DENUM.
+      
+                FUNCTION "+" IS NEW PLUS (CHARACTER);
+                FUNCTION "+" IS NEW PLUS (INTEGER);
+                FUNCTION "+" IS NEW PLUS (BOOLEAN);
+                FUNCTION "+" IS NEW PLUS (ENUM);
+                FUNCTION "+" IS NEW PLUS (DC);
+                -- NOT FOR DI.
+                FUNCTION "+" IS NEW PLUS (DENUM);
+ 
+                FUNCTION E2 IS NEW F1 (BOOLEAN, FALSE);
+                FUNCTION E5 IS NEW F1 (DC, 'M');
+ 
+           END PKG;
+ 
+           PACKAGE BODY PKG IS
+           BEGIN
+                P (VC);
+                P (VI);
+                P (VB);
+                P (VE);
+                P (X => VDE);
+                P (X => VDC);
+                P (X => VDI);
+ 
+                IF VC /= 'Q' THEN
+                     FAILED ("OVERLOADED PROCEDURE - 1");
+                END IF;
+ 
+                IF VI /= -14 THEN
+                     FAILED ("OVERLOADED PROCEDURE - 2");
+                END IF;
+ 
+                IF VB /= FALSE THEN
+                     FAILED ("OVERLOADED PROCEDURE - 3");
+                END IF;
+ 
+                IF VE /= E4 THEN
+                     FAILED ("OVERLOADED PROCEDURE - 4");
+                END IF;
+ 
+                IF VDE /= E2 THEN
+                     FAILED ("OVERLOADED PROCEDURE - 5");
+                END IF;
+ 
+                IF VDC /= 'W' THEN
+                     FAILED ("OVERLOADED PROCEDURE - 6");
+                END IF;
+ 
+                IF VDI /= -33 THEN
+                     FAILED ("OVERLOADED PROCEDURE - 7");
+                END IF;
+ 
+                IF VC  < ASCII.DEL THEN
+                     FAILED ("OVERLOADED LESS THAN - 1");
+                END IF;
+ 
+                IF VI < 1E3 THEN
+                     FAILED ("OVERLOADED LESS THAN - 2");
+                END IF;
+ 
+                IF FALSE < TRUE THEN
+                     FAILED ("OVERLOADED LESS THAN - 3");
+                END IF;
+ 
+                IF E1 < VE THEN
+                     FAILED ("OVERLOADED LESS THAN - 4");
+                END IF;
+ 
+                IF VDC < 'Z' THEN
+                     FAILED ("OVERLOADED LESS THAN - 5");
+                END IF;
+ 
+                IF VDI < 0 THEN
+                     FAILED ("OVERLOADED LESS THAN - 6");
+                END IF;
+ 
+ 
+                IF -14 + 5 /= -9 THEN
+                     FAILED ("OVERLOADED PLUS - 2");
+                END IF;
+ 
+                IF VI + 5 /= INTEGER'FIRST THEN
+                     FAILED ("OVERLOADED PLUS - 3");
+                END IF;
+ 
+                IF VB + TRUE /= FALSE THEN
+                     FAILED ("OVERLOADED PLUS - 4");
+                END IF;
+ 
+                IF VE + E2 /= E1 THEN
+                     FAILED ("OVERLOADED PLUS - 5");
+                END IF;
+ 
+                IF DENUM'(E3) + E2 /= E2 THEN
+                     FAILED ("OVERLOADED PLUS - 6");
+                END IF;
+ 
+                IF  VDC + 'B' /= 'A' THEN
+                     FAILED ("OVERLOADED PLUS - 7");
+                END IF;
+ 
+                IF VDI + 14 /= -19 THEN       -- -33 + 14
+                     FAILED ("OVERLOADED PLUS - 8");
+                END IF;
+ 
+                VI := E5;
+                VDC := E5;
+                VE := E2;
+                VB := E2;
+                IF VI /= 1 OR
+                   VDC /= 'M' OR
+                   VE /= ENUM'VAL(IDENT_INT(1)) OR
+                   VB /= FALSE THEN
+                     FAILED ("OVERLOADING OF ENUMERATION LITERALS " &
+                             "AND PREDEFINED SUBPROGRAMS");
+                END IF;
+           END PKG;
+      BEGIN
+           DECLARE
+                USE PKG;
+           BEGIN
+                IF NOT (VI + 5 < 11) THEN
+                FAILED ("INCORRECT VISIBILITY OF GENERIC OVERLOADING");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END CC3012A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3015a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3015a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3015a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3015a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,104 ----
+ -- CC3015A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC PACKAGE INSTANTIATION IS ELABORATED, 
+ -- STATEMENTS IN ITS PACKAGE BODY ARE EXECUTED AND EXPRESSIONS
+ -- REQUIRING EVALUATION ARE EVALUATED (E.G., DEFAULTS FOR OBJECT
+ -- DECLARATIONS ARE EVALUATED).
+ 
+ -- RJW 6/11/86
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3015A IS
+      BOOL1, BOOL2 : BOOLEAN := FALSE;          
+           
+      TYPE ENUM IS (BEFORE, AFTER);
+ 
+      FUNCTION F (I : INTEGER) RETURN INTEGER IS
+      BEGIN
+           BOOL2 := TRUE;
+           RETURN I;
+      END;
+           
+      FUNCTION CHECK (E : ENUM) RETURN CHARACTER IS
+      BEGIN
+           IF E = BEFORE THEN
+                IF BOOL1 THEN
+                     FAILED ( "STATEMENT EXECUTED BEFORE " &
+                              "INSTANTIATION" );
+                END IF;
+                IF BOOL2 THEN
+                     FAILED ( "DEFAULT EXPRESSION EVALUATED " &
+                              "BEFORE INSTANTIATION" );
+                END IF;
+           ELSE
+                IF BOOL1 THEN
+                     NULL;
+                ELSE
+                     FAILED ( "STATEMENT NOT EXECUTED AT " &
+                              "INSTANTIATION" );
+                END IF;
+                IF BOOL2 THEN
+                     NULL;
+                ELSE
+                     FAILED ( "DEFAULT EXPRESSION NOT EVALUATED " &
+                              "AT INSTANTIATION" );
+                END IF;
+           END IF;
+           RETURN 'A';
+       END;
+ 
+      GENERIC 
+           TYPE INT IS RANGE <>;
+      PACKAGE PKG IS END PKG;
+ 
+      PACKAGE BODY PKG IS
+           I : INT := INT'VAL (F(0));
+      BEGIN
+           BOOL1 := TRUE;
+      END;
+                          
+ BEGIN
+      TEST ("CC3015A", "CHECK THAT WHEN A GENERIC PACKAGE " & 
+                       "INSTANTIATION IS ELABORATED, STATEMENTS " & 
+                       "IN ITS PACKAGE BODY ARE EXECUTED AND " &
+                       "EXPRESSIONS REQUIRING EVALUATION ARE " &
+                       "EVALUATED (E.G., DEFAULTS FOR OBJECT " &
+                       "DECLARATIONS ARE EVALUATED)" );
+      
+ 
+      DECLARE
+           A : CHARACTER := CHECK (BEFORE);
+ 
+           PACKAGE NPKG IS NEW PKG (INTEGER);
+      
+           B : CHARACTER := CHECK (AFTER);
+ 
+      BEGIN
+           NULL;
+      END;          
+ 
+      RESULT;
+ END CC3015A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,396 ----
+ -- CC3016B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  CHECK THAT AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
+ --  PACKAGE. CHECK THAT THE DECLARATIVE ITEMS IN AN INSTANTIATION
+ --  OF A GENERIC PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER
+ --  DECLARED.    
+ 
+ -- HISTORY:
+ --         EDWARD V. BERARD, 8 AUGUST 1990
+ 
+ WITH REPORT ;
+ 
+ PROCEDURE CC3016B IS
+      
+     WHEN_ELABORATED : NATURAL := 0 ;
+     
+     TYPE REAL IS DIGITS 6 ;
+     REAL_VALUE : REAL := 3.14159 ;
+     
+     TRUE_VALUE : BOOLEAN := TRUE ;
+     
+     CHARACTER_VALUE : CHARACTER := 'Z' ;
+           
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+       MONTH : MONTH_TYPE ;
+       DAY   : DAY_TYPE ;
+       YEAR  : YEAR_TYPE ;
+     END RECORD ;
+           
+     TYPE DATE_ACCESS IS ACCESS DATE ;
+ 
+     THIS_MONTH   : MONTH_TYPE := AUG ;
+     THIS_YEAR     : YEAR_TYPE := 1990 ;
+ 
+     TODAY         : DATE := (MONTH => AUG,
+                                DAY   => 8,
+                               YEAR  => 1990) ;
+ 
+     FIRST_DATE   : DATE_ACCESS  := NEW DATE'(DAY   => 6,
+                                              MONTH => JUN,
+                                              YEAR  => 1967) ;
+     
+     TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE ;
+     REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
+                                  (MAR, 23, 1990), (APR, 23, 1990),
+                                  (MAY, 23, 1990), (JUN, 22, 1990),
+                                  (JUL, 23, 1990), (AUG, 23, 1990),
+                                  (SEP, 24, 1990), (OCT, 23, 1990),
+                                  (NOV, 23, 1990), (DEC, 20, 1990)) ;
+                                  
+     TYPE LIST_INDEX IS RANGE 1 .. 16 ;
+     TYPE LIST IS ARRAY (LIST_INDEX) OF NATURAL ;
+     ORDER_LIST : LIST := (OTHERS => 0) ;
+ 
+     GENERIC
+     
+         TYPE RETURN_TYPE IS PRIVATE ;
+         RETURN_VALUE : IN OUT RETURN_TYPE ;
+         POSITION      : IN       NATURAL ;
+         OFFSET        : IN       NATURAL ;
+         WHEN_ELAB     : IN OUT NATURAL ;
+         TYPE INDEX IS RANGE <> ;
+         TYPE LIST IS ARRAY (INDEX) OF NATURAL ;
+         ORDER_LIST      : IN OUT LIST ;
+     
+     FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE ;
+     
+     FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE IS
+     
+     BEGIN -- NAME
+         
+         IF (VALUE = POSITION) THEN
+           WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;
+           ORDER_LIST (INDEX (POSITION)) := WHEN_ELAB ;
+           RETURN RETURN_VALUE ;
+         ELSIF (VALUE = (POSITION + OFFSET)) THEN
+           WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;
+           ORDER_LIST (INDEX (POSITION + OFFSET)) := WHEN_ELAB ;
+           RETURN RETURN_VALUE ;
+         END IF ;
+     
+     END NAME ;
+     
+     GENERIC
+     
+         TYPE FIRST_TYPE IS PRIVATE ;
+         WITH FUNCTION FIRST (POSITION : IN NATURAL) 
+                             RETURN FIRST_TYPE ;
+         FIRST_VALUE : IN NATURAL ;
+         TYPE SECOND_TYPE IS PRIVATE ;
+         WITH FUNCTION SECOND (POSITION : IN NATURAL) 
+                             RETURN SECOND_TYPE ;
+         SECOND_VALUE : IN NATURAL ;
+         TYPE THIRD_TYPE IS PRIVATE ;
+         WITH FUNCTION THIRD (POSITION : IN NATURAL) 
+                             RETURN THIRD_TYPE ;
+         THIRD_VALUE : IN NATURAL ;
+         TYPE FOURTH_TYPE IS PRIVATE ;
+         WITH FUNCTION FOURTH (POSITION : IN NATURAL) 
+                             RETURN FOURTH_TYPE ;
+         FOURTH_VALUE : IN NATURAL ;
+         TYPE FIFTH_TYPE IS PRIVATE ;
+         WITH FUNCTION FIFTH (POSITION : IN NATURAL) 
+                             RETURN FIFTH_TYPE ;
+         FIFTH_VALUE : IN NATURAL ;
+         TYPE SIXTH_TYPE IS PRIVATE ;
+         WITH FUNCTION SIXTH (POSITION : IN NATURAL) 
+                             RETURN SIXTH_TYPE ;
+         SIXTH_VALUE : IN NATURAL ;
+         TYPE SEVENTH_TYPE IS PRIVATE ;
+         WITH FUNCTION SEVENTH (POSITION : IN NATURAL) 
+                             RETURN SEVENTH_TYPE ;
+         SEVENTH_VALUE : IN NATURAL ;
+         TYPE EIGHTH_TYPE IS PRIVATE ;
+         WITH FUNCTION EIGHTH (POSITION : IN NATURAL) 
+                             RETURN EIGHTH_TYPE ;
+         EIGHTH_VALUE : IN NATURAL ;
+         TYPE NINTH_TYPE IS PRIVATE ;
+         WITH FUNCTION NINTH (POSITION : IN NATURAL) 
+                             RETURN NINTH_TYPE ;
+         NINTH_VALUE : IN NATURAL ;
+         TYPE TENTH_TYPE IS PRIVATE ;
+         WITH FUNCTION TENTH (POSITION : IN NATURAL) 
+                             RETURN TENTH_TYPE ;
+         TENTH_VALUE : IN NATURAL ;
+         TYPE ELEVENTH_TYPE IS PRIVATE ;
+         WITH FUNCTION ELEVENTH (POSITION : IN NATURAL) 
+                             RETURN ELEVENTH_TYPE ;
+         ELEVENTH_VALUE : IN NATURAL ;
+         TYPE TWELFTH_TYPE IS PRIVATE ;
+         WITH FUNCTION TWELFTH (POSITION : IN NATURAL) 
+                             RETURN TWELFTH_TYPE ;
+         TWELFTH_VALUE : IN NATURAL ;
+         TYPE THIRTEENTH_TYPE IS PRIVATE ;
+         WITH FUNCTION THIRTEENTH (POSITION : IN NATURAL) 
+                             RETURN THIRTEENTH_TYPE ;
+         THIRTEENTH_VALUE : IN NATURAL ;
+         TYPE FOURTEENTH_TYPE IS PRIVATE ;
+         WITH FUNCTION FOURTEENTH (POSITION : IN NATURAL) 
+                             RETURN FOURTEENTH_TYPE ;
+         FOURTEENTH_VALUE : IN NATURAL ;
+         TYPE FIFTEENTH_TYPE IS PRIVATE ;
+         WITH FUNCTION FIFTEENTH (POSITION : IN NATURAL) 
+                             RETURN FIFTEENTH_TYPE ;
+         FIFTEENTH_VALUE : IN NATURAL ;
+         TYPE SIXTEENTH_TYPE IS PRIVATE ;
+         WITH FUNCTION SIXTEENTH (POSITION : IN NATURAL) 
+                             RETURN SIXTEENTH_TYPE ;
+         SIXTEENTH_VALUE : IN NATURAL ;
+         
+     PACKAGE ORDER_PACKAGE IS
+     
+         A : FIRST_TYPE      := FIRST (FIRST_VALUE) ;
+         B : SECOND_TYPE     := SECOND (SECOND_VALUE) ;
+         C : THIRD_TYPE      := THIRD (THIRD_VALUE) ;
+         D : FOURTH_TYPE     := FOURTH (FOURTH_VALUE) ;
+         E : FIFTH_TYPE      := FIFTH (FIFTH_VALUE) ;
+         F : SIXTH_TYPE      := SIXTH (SIXTH_VALUE) ;
+         G : SEVENTH_TYPE    := SEVENTH (SEVENTH_VALUE) ;
+         H : EIGHTH_TYPE     := EIGHTH (EIGHTH_VALUE) ;
+         I : NINTH_TYPE      := NINTH (NINTH_VALUE) ;
+         J : TENTH_TYPE      := TENTH (TENTH_VALUE) ;
+         K : ELEVENTH_TYPE   := ELEVENTH (ELEVENTH_VALUE) ;
+         L : TWELFTH_TYPE    := TWELFTH (TWELFTH_VALUE) ;
+         M : THIRTEENTH_TYPE := THIRTEENTH (THIRTEENTH_VALUE) ;
+         N : FOURTEENTH_TYPE := FOURTEENTH (FOURTEENTH_VALUE) ;
+         O : FIFTEENTH_TYPE  := FIFTEENTH (FIFTEENTH_VALUE) ;
+         P : SIXTEENTH_TYPE  := SIXTEENTH (SIXTEENTH_VALUE) ;
+         
+     END ORDER_PACKAGE ;
+     
+ 
+     FUNCTION BOOL IS NEW NAME (RETURN_TYPE  => BOOLEAN,
+                                RETURN_VALUE => TRUE_VALUE,
+                                POSITION     => 1,
+                                OFFSET       => 8,
+                                WHEN_ELAB    => WHEN_ELABORATED,
+                                INDEX        => LIST_INDEX,
+                                LIST         => LIST,
+                                ORDER_LIST   => ORDER_LIST) ;
+                                
+     FUNCTION INT IS NEW NAME (RETURN_TYPE   => YEAR_TYPE,
+                               RETURN_VALUE  => THIS_YEAR,
+                               POSITION      => 2,
+                               OFFSET        => 8,
+                               WHEN_ELAB     => WHEN_ELABORATED,
+                               INDEX         => LIST_INDEX,
+                               LIST          => LIST,
+                               ORDER_LIST    => ORDER_LIST) ;
+                                
+     FUNCTION FLOAT IS NEW NAME (RETURN_TYPE  => REAL,
+                                 RETURN_VALUE => REAL_VALUE,
+                                 POSITION     => 3,
+                                 OFFSET       => 8,
+                                 WHEN_ELAB    => WHEN_ELABORATED,
+                                 INDEX        => LIST_INDEX,
+                                 LIST         => LIST,
+                                 ORDER_LIST   => ORDER_LIST) ;
+                                
+     FUNCTION CHAR IS NEW NAME (RETURN_TYPE  => CHARACTER,
+                                RETURN_VALUE => CHARACTER_VALUE,
+                                POSITION     => 4,
+                                OFFSET       => 8,
+                                WHEN_ELAB    => WHEN_ELABORATED,
+                                INDEX        => LIST_INDEX,
+                                LIST         => LIST,
+                                ORDER_LIST   => ORDER_LIST) ;
+                                
+     FUNCTION ENUM IS NEW NAME (RETURN_TYPE  => MONTH_TYPE,
+                                RETURN_VALUE => THIS_MONTH,
+                                POSITION     => 5,
+                                OFFSET       => 8,
+                                WHEN_ELAB    => WHEN_ELABORATED,
+                                INDEX        => LIST_INDEX,
+                                LIST         => LIST,
+                                ORDER_LIST   => ORDER_LIST) ;
+                                
+     FUNCTION ARRY IS NEW NAME (RETURN_TYPE  => DUE_DATES,
+                                RETURN_VALUE => REPORT_DATES,
+                                POSITION     => 6,
+                                OFFSET       => 8,
+                                WHEN_ELAB    => WHEN_ELABORATED,
+                                INDEX        => LIST_INDEX,
+                                LIST         => LIST,
+                                ORDER_LIST   => ORDER_LIST) ;
+                                
+ 
+     FUNCTION RCRD IS NEW NAME (RETURN_TYPE  => DATE,
+                                RETURN_VALUE => TODAY,
+                                POSITION     => 7,
+                                OFFSET       => 8,
+                                WHEN_ELAB    => WHEN_ELABORATED,
+                                INDEX        => LIST_INDEX,
+                                LIST         => LIST,
+                                ORDER_LIST   => ORDER_LIST) ;
+                                
+ 
+     FUNCTION ACSS IS NEW NAME (RETURN_TYPE  => DATE_ACCESS,
+                                RETURN_VALUE => FIRST_DATE,
+                                POSITION     => 8,
+                                OFFSET       => 8,
+                                WHEN_ELAB    => WHEN_ELABORATED,
+                                INDEX        => LIST_INDEX,
+                                LIST         => LIST,
+                                ORDER_LIST   => ORDER_LIST) ;
+                                
+     PACKAGE ELABORATION_ORDER IS NEW ORDER_PACKAGE
+         (FIRST_TYPE            => BOOLEAN,
+          FIRST                 => BOOL,
+          FIRST_VALUE           => 1,
+          THIRD_TYPE            => REAL,
+          THIRD                 => FLOAT,
+          THIRD_VALUE           => 3,
+          SECOND_TYPE           => YEAR_TYPE,    -- ORDERING OF PARAMETERS
+          SECOND                => INT,          -- IS DELIBERATE. 
+          SECOND_VALUE          => 2,
+          FOURTH_TYPE           => CHARACTER,
+          FOURTH                => CHAR,
+          FOURTH_VALUE          => 4,
+          FIFTH_TYPE            => MONTH_TYPE,
+          FIFTH                 => ENUM,
+          FIFTH_VALUE           => 5,
+          SIXTH_TYPE            => DUE_DATES,
+          SIXTH                 => ARRY,
+          SIXTH_VALUE           => 6,
+          SEVENTH_TYPE          => DATE,
+          SEVENTH               => RCRD,
+          SEVENTH_VALUE         => 7,
+          EIGHTH_TYPE           => DATE_ACCESS,
+          EIGHTH                => ACSS,
+          EIGHTH_VALUE          => 8,
+          NINTH_TYPE            => BOOLEAN,
+          NINTH                 => BOOL,
+          NINTH_VALUE           => 9,
+          TENTH_TYPE            => YEAR_TYPE,
+          TENTH                 => INT,
+          TENTH_VALUE           => 10,
+          ELEVENTH_TYPE         => REAL,
+          ELEVENTH              => FLOAT,
+          ELEVENTH_VALUE        => 11,
+          TWELFTH_TYPE          => CHARACTER,
+          TWELFTH               => CHAR,
+          TWELFTH_VALUE         => 12,
+          THIRTEENTH_TYPE       => MONTH_TYPE,
+          THIRTEENTH            => ENUM,
+          THIRTEENTH_VALUE      => 13,
+          FOURTEENTH_TYPE       => DUE_DATES,
+          FOURTEENTH            => ARRY,
+          FOURTEENTH_VALUE      => 14,
+          FIFTEENTH_TYPE        => DATE,
+          FIFTEENTH             => RCRD,
+          FIFTEENTH_VALUE       => 15,
+          SIXTEENTH_TYPE        => DATE_ACCESS,
+          SIXTEENTH             => ACSS,
+          SIXTEENTH_VALUE       => 16) ;
+ 
+ BEGIN
+      REPORT.TEST("CC3016B", "CHECK THAT AN INSTANCE OF A GENERIC " &
+                  "PACKAGE MUST DECLARE A PACKAGE. CHECK THAT THE " &
+                  "DECLARATIVE ITEMS IN AN INSTANTIATION OF A GENERIC " &
+                  "PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER " &
+                  "DECLARED.");
+ 
+      IF ORDER_LIST(1) /= REPORT.IDENT_INT(1) THEN
+           REPORT.FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(2) /= REPORT.IDENT_INT(2) THEN
+           REPORT.FAILED("INTEGER TYPE 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(3) /= REPORT.IDENT_INT(3) THEN
+           REPORT.FAILED("REAL 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(4) /= REPORT.IDENT_INT(4) THEN
+           REPORT.FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(5) /= REPORT.IDENT_INT(5) THEN
+           REPORT.FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(6) /= REPORT.IDENT_INT(6) THEN
+           REPORT.FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(7) /= REPORT.IDENT_INT(7) THEN
+           REPORT.FAILED("RECORD 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(8) /= REPORT.IDENT_INT(8) THEN
+           REPORT.FAILED("ACCESS 1 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(9) /= REPORT.IDENT_INT(9) THEN
+           REPORT.FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(10) /= REPORT.IDENT_INT(10) THEN
+           REPORT.FAILED("INTEGER TYPE 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(11) /= REPORT.IDENT_INT(11) THEN
+           REPORT.FAILED("REAL 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(12) /= REPORT.IDENT_INT(12) THEN
+           REPORT.FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(13) /= REPORT.IDENT_INT(13) THEN
+           REPORT.FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(14) /= REPORT.IDENT_INT(14) THEN
+           REPORT.FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(15) /= REPORT.IDENT_INT(15) THEN
+           REPORT.FAILED("RECORD 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      IF ORDER_LIST(16) /= REPORT.IDENT_INT(16) THEN
+           REPORT.FAILED("ACCESS 2 ELABORATED OUT OF ORDER");
+      END IF;
+ 
+      REPORT.RESULT ;
+      
+ END CC3016B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,192 ----
+ -- CC3016C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  CHECK THAT AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
+ --  PACKAGE. CHECK THAT THE STATEMENTS IN AN INSTANTIATED GENERIC
+ --  PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE
+ --  DECLARATIONS (IN SPEC AND IN BODY).
+ 
+ -- HISTORY:
+ --         EDWARD V. BERARD, 8 AUGUST 1990
+ 
+ WITH REPORT;
+ 
+ PROCEDURE  CC3016C  IS
+ 
+     GENERIC
+     
+         TYPE SOME_TYPE IS PRIVATE ;
+         FIRST_INITIAL_VALUE  : IN SOME_TYPE ;
+         SECOND_INITIAL_VALUE : IN SOME_TYPE ;
+         WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
+                                RESULT : OUT SOME_TYPE) ;
+         WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
+                                       RESULT : OUT SOME_TYPE) ;
+         WITH PROCEDURE THIRD_CHANGE (FIRST  : IN SOME_TYPE ;
+                                      RESULT : OUT SOME_TYPE) ;
+         FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
+         SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
+         THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
+         FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
+         FIFTH_EXPECTED_RESULT     : IN SOME_TYPE ;
+         SIXTH_EXPECTED_RESULT     : IN SOME_TYPE ;
+     
+     PACKAGE OUTER IS
+ 
+         VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
+         
+         FUNCTION INNER_VARIABLE RETURN SOME_TYPE ;
+ 
+         GENERIC
+         
+             INITIAL_VALUE : IN SOME_TYPE ;
+             WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
+                                    RESULT : OUT SOME_TYPE) ;
+             WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
+                                           RESULT : OUT SOME_TYPE) ;
+             FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
+             SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
+             THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
+             FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
+                     
+         PACKAGE INNER  IS
+             VARIABLE : SOME_TYPE := INITIAL_VALUE ;
+         END INNER ;
+         
+     END OUTER ;
+ 
+ 
+     PACKAGE BODY OUTER IS
+ 
+         ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
+         
+         PACKAGE BODY  INNER  IS
+             ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ;
+         BEGIN  -- INNER
+ 
+             CHANGE (FIRST  => VARIABLE,
+                     RESULT => VARIABLE) ;
+             CHANGE (FIRST  => ANOTHER_VARIABLE,
+                     RESULT => ANOTHER_VARIABLE) ;
+             OUTER.SECOND_CHANGE (FIRST  => OUTER.VARIABLE,
+                                  RESULT => OUTER.VARIABLE) ;
+             OUTER.CHANGE (FIRST  => OUTER.ANOTHER_VARIABLE,
+                           RESULT => OUTER.ANOTHER_VARIABLE) ;
+ 
+             IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR
+                (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR
+                (OUTER.VARIABLE 
+                        /= THIRD_EXPECTED_RESULT) OR
+                (OUTER.ANOTHER_VARIABLE 
+                        /= FOURTH_EXPECTED_RESULT) THEN
+                     REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ;
+             END IF;
+ 
+         END INNER ;
+ 
+         PACKAGE NEW_INNER IS NEW INNER 
+             (INITIAL_VALUE          => SECOND_INITIAL_VALUE,
+              CHANGE                 => CHANGE,
+              SECOND_CHANGE          => THIRD_CHANGE,
+              FIRST_EXPECTED_RESULT  => FIRST_EXPECTED_RESULT,
+              SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT,
+              THIRD_EXPECTED_RESULT  => THIRD_EXPECTED_RESULT,
+              FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ;
+              
+         FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS
+         BEGIN
+             RETURN NEW_INNER.VARIABLE ;            
+         END INNER_VARIABLE ;
+ 
+     BEGIN  -- OUTER
+     
+         SECOND_CHANGE (FIRST  => VARIABLE,
+                        RESULT => VARIABLE) ;
+         SECOND_CHANGE (FIRST  => ANOTHER_VARIABLE,
+                        RESULT => ANOTHER_VARIABLE) ;
+                        
+         IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR
+            (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR
+            (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN
+             REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ;
+         END IF;
+ 
+     END OUTER ;
+     
+     PROCEDURE DOUBLE (THIS_VALUE          : IN  INTEGER;
+                       GIVING_THIS_RESULT  : OUT INTEGER) IS
+     BEGIN -- DOUBLE
+         GIVING_THIS_RESULT := 2 * THIS_VALUE ;
+     END DOUBLE ;
+     
+     PROCEDURE ADD_20 (TO_THIS_VALUE      : IN  INTEGER;
+                       GIVING_THIS_RESULT : OUT INTEGER) IS
+     BEGIN -- ADD_20
+         GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ;
+     END ADD_20 ;
+     
+     PROCEDURE TIMES_FIVE (THIS_VALUE          : IN  INTEGER;
+                           GIVING_THIS_RESULT  : OUT INTEGER) IS
+     BEGIN -- TIMES_FIVE
+         GIVING_THIS_RESULT := 5 * THIS_VALUE ;
+     END TIMES_FIVE ;    
+     
+ BEGIN -- CC3016C
+ 
+     REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " &
+                  "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " &
+                  "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " &
+                  "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ;
+                    
+     LOCAL_BLOCK:
+     
+     DECLARE
+     
+         PACKAGE NEW_OUTER IS NEW OUTER
+             (SOME_TYPE                 => INTEGER,
+             FIRST_INITIAL_VALUE        => 7,
+             SECOND_INITIAL_VALUE       => 11,
+             CHANGE                     => DOUBLE,
+             SECOND_CHANGE              => ADD_20,
+             THIRD_CHANGE               => TIMES_FIVE,
+             FIRST_EXPECTED_RESULT      => 22, 
+             SECOND_EXPECTED_RESULT     => 22,
+             THIRD_EXPECTED_RESULT      => 27,
+             FOURTH_EXPECTED_RESULT     => 14,
+             FIFTH_EXPECTED_RESULT      => 47,
+             SIXTH_EXPECTED_RESULT      => 34) ;
+ 
+     BEGIN  -- LOCAL_BLOCK    
+     
+         IF (NEW_OUTER.VARIABLE /= 47) OR
+            (NEW_OUTER.INNER_VARIABLE /= 22) THEN
+             REPORT.FAILED("ASSIGNED VALUES INCORRECT - " &
+                           "BODY OF MAIN PROGRAM") ;
+         END IF;
+         
+     END LOCAL_BLOCK ;
+ 
+     REPORT.RESULT;
+ 
+ END CC3016C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016f.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016f.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016f.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016f.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- CC3016F.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+ --     this public release, the Government intends to confer upon all
+ --     recipients unlimited rights  equal to those held by the Government.
+ --     These rights include rights to use, duplicate, release or disclose the
+ --     released technical data and computer software in whole or in part, in
+ --     any manner and for any purpose whatsoever, and to have or permit others
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ 
+ -- OBJECTIVE:
+ --   CHECK THAT AN INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
+ --   OF A PACKAGE.
+ 
+ --   CHECK THAT IF THE PARENT TYPE IN A DERIVED TYPE DEFINITION IS
+ --   A GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE DERIVED
+ --   TYPE IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE
+ --   FORMAL TYPE.  THE OPERATIONS DECLARED FOR DERIVED TYPE IN THE
+ --   INSTANCE ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL
+ --   PARAMETER.  SEE AI-00398.
+ 
+ -- HISTORY:
+ --   DAS  8 OCT 90   INITIAL VERSION.
+ --   JRL 02/19/93  ADDED USE CLAUSES FOR INSTANCES TO ENSURE DIRECT
+ --                 OPERATOR VISIBILITY. CHANGED NT4'LAST TO P4.NT4'LAST
+ --                 IN ASSIGNMENT STATEMENT FOR P4.X IN EXAMPLE_4.
+ --                 CORRECTED ABE ERRORS IN EXAMPLE_2 AND EXAMPLE_3.
+ --                 CHANGED R3."+" FROM MULTIPLICATION TO SUBTRACTION TO
+ --                 AVOID CONSTRAINT_ERROR.
+ 
+ WITH REPORT;
+ 
+ PROCEDURE CC3016F IS
+ BEGIN
+      REPORT.TEST ("CC3016F", "CHECK THAT IF THE PARENT TYPE IN A " &
+                              "DERIVED TYPE DEFINITION IS A GENERIC " &
+                              "FORMAL TYPE, THE OPERATIONS DECLARED " &
+                              "FOR THE DERIVED TYPE IN THE TEMPLATE " &
+                              "ARE DETERMINED BY THE DECLARATION OF " &
+                              "THE FORMAL TYPE, AND THAT THE " &
+                              "OPERATIONS DECLARED FOR THE DERIVED " &
+                              "TYPE IN THE INSTANCE ARE DETERMINED BY " &
+                              "THE ACTUAL TYPE DENOTED BY THE FORMAL " &
+                              "PARAMETER (AI-00398)");
+ EXAMPLE_2:
+      DECLARE
+           GENERIC
+                TYPE PRIV IS PRIVATE;
+           PACKAGE GP2 IS
+                TYPE NT2 IS NEW PRIV;
+           END GP2;
+ 
+           PACKAGE R2 IS
+                TYPE T2 IS RANGE 1..10;
+                FUNCTION F RETURN T2;
+           END R2;
+ 
+           PACKAGE P2 IS NEW GP2 (PRIV => R2.T2);
+           USE P2;
+ 
+           XX1 : P2.NT2;
+           XX2 : P2.NT2;
+           XX3 : P2.NT2;
+ 
+           PACKAGE BODY R2 IS
+                FUNCTION F RETURN T2 IS
+                BEGIN
+                     RETURN T2'LAST;
+                END F;
+           END R2;
+      BEGIN
+           XX1 := 5;                   -- IMPLICIT CONVERSION FROM
+                                       -- UNIVERSAL INTEGER TO P2.NT2
+                                       -- IN P2.
+           XX2 := XX1 + XX1;           -- PREDEFINED "+" DECLARED FOR
+                                       -- P2.NT2.
+           XX3 := P2.F;                -- FUNCTION F DERIVED WITH THE
+                                       -- INSTANCE.
+ 
+      END EXAMPLE_2;
+ 
+ EXAMPLE_3:
+      DECLARE
+           GENERIC
+                TYPE T3 IS RANGE <>;
+           PACKAGE GP3 IS
+                TYPE NT3 IS NEW T3;
+                X : NT3 := 5;
+                Y : NT3 := X + 3;      -- USES PREDEFINED "+" EVEN IN
+                                       -- INSTANCES
+           END GP3;
+ 
+           PACKAGE R3 IS
+                TYPE S IS RANGE 1..10;
+                FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S;
+           END R3;
+ 
+           PACKAGE P3 IS NEW GP3 ( T3 => R3.S );
+           USE P3;
+ 
+           Z : P3.NT3;
+ 
+           PACKAGE BODY R3 IS
+                FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S IS
+                BEGIN  -- IMPLEMENT AS SUBTRACTION, NOT ADDITION
+                     RETURN LEFT - RIGHT;
+                END "+";
+           END R3;
+      BEGIN
+           Z := P3.X + 3;     -- USES REDEFINED "+"
+ 
+           IF ( P3.Y /= P3.NT3'(8) ) THEN
+                REPORT.FAILED ("PREDEFINED ""+"" NOT USED TO COMPUTE " &
+                              "P3.Y");
+           END IF;
+ 
+           IF (Z /= P3.NT3'(2) ) THEN
+                REPORT.FAILED ("REDEFINED ""+"" NOT USED TO COMPUTE Z");
+           END IF;
+      END EXAMPLE_3;
+ 
+ EXAMPLE_4:
+      DECLARE
+           GENERIC
+                TYPE T4 IS LIMITED PRIVATE;
+           PACKAGE GP4 IS
+                TYPE NT4 IS NEW T4;
+                X : NT4;
+           END GP4;
+ 
+           PACKAGE P4 IS NEW GP4 (BOOLEAN);
+           USE P4;
+ 
+      BEGIN
+           P4.X := P4.NT4'LAST;
+           IF ( P4.X  OR (NOT P4.X) ) THEN
+                REPORT.COMMENT ("P4.X CORRECTLY HAS A BOOLEAN TYPE");
+           END IF;
+      END EXAMPLE_4;
+ 
+ EXAMPLE_5:
+      DECLARE
+           GENERIC
+                TYPE T5 (D : POSITIVE) IS PRIVATE;
+           PACKAGE GP5 IS
+                TYPE NT5 IS NEW T5;
+                X : NT5 (D => 5);
+                Y : POSITIVE := X.D;  -- REFERS TO DISCRIMINANT OF NT5
+           END GP5;
+ 
+           TYPE REC (A : POSITIVE) IS
+                RECORD
+                     D : POSITIVE := 7;
+                END RECORD;
+           PACKAGE P5 IS NEW GP5 (T5 => REC);
+                -- P5.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
+                -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
+                -- T5 WHICH DENOTES REC.
+ 
+           W1 : POSITIVE := P5.X.D;     -- VALUE IS 7
+           W2 : POSITIVE := P5.X.A;     -- VALUE IS 5
+           W3 : POSITIVE := P5.Y;       -- VALUE IS 5;
+      BEGIN
+           IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR  (W3 /= 5 ) ) THEN
+                REPORT.FAILED ("INCORRECT COMPONENT SELECTION");
+           END IF;
+      END EXAMPLE_5;
+ 
+      REPORT.RESULT;
+ 
+ END CC3016F;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016i.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016i.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3016i.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3016i.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,78 ----
+ -- CC3016I.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --   CHECK THAT AN INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
+ --   OF A PACKAGE.
+ 
+ --   CHECK THAT IF THE DESIGNATED TYPE OF AN ACCESS TYPE IS A GENERIC
+ --   FORMAL TYPE, OR IS A TYPE DERIVED DIRECTLY OR INDIRECTLY FROM A
+ --   GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE ACCESS TYPE
+ --   IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE FORMAL
+ --   TYPE.  THE OPERATIONS DECLARED FOR ACCESS TYPE IN THE INSTANCE
+ --   ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL PARAMETER.
+ --   SEE AI-00398.
+ 
+ -- HISTORY:
+ --   DAS  8 OCT 90   INITIAL VERSION.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3016I IS
+ BEGIN
+      TEST("CC3016I", "CHECK THAT AN INSTANTIATED PACKAGE HAS THE " &
+           "PROPERTIES REQUIRED OF A PACKAGE.");
+ 
+ EXAMPLE_5A:
+      DECLARE
+           GENERIC
+                TYPE T5A (D : POSITIVE) IS PRIVATE;
+           PACKAGE GP5A IS
+                TYPE NT5A IS NEW T5A;
+                X : NT5A (D => 5);
+                Y : POSITIVE := X.D;  -- REFERS TO DISCRIMINANT OF NT5A
+           END GP5A;
+ 
+           TYPE REC (A : POSITIVE) IS
+                RECORD
+                     D : POSITIVE := 7;
+                END RECORD;
+           PACKAGE P5A IS NEW GP5A (T5A => REC);
+                -- P5A.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
+                -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
+                -- T5A WHICH DENOTES REC.
+ 
+           W1 : POSITIVE := P5A.X.D;    -- VALUE IS 7
+           W2 : POSITIVE := P5A.X.A;    -- VALUE IS 5
+           W3 : POSITIVE := P5A.Y;      -- VALUE IS 5;
+      BEGIN
+           IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR  (W3 /= 5 ) ) THEN
+                FAILED ("INCORRECT COMPONENT SELECTION - ACCESS");
+           END IF;
+      END EXAMPLE_5A;
+ 
+      RESULT;
+  
+ END CC3016I;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3017b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3017b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3017b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3017b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,470 ----
+ -- CC3017B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
+ -- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
+ -- DECLARE A FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT RAISED
+ -- IF THE DEFAULT VALUE FOR A FORMAL PARAMETER DOES NOT SATISFY
+ -- THE CONSTRAINTS OF THE SUBTYPE_INDICATION WHEN THE     
+ -- DECLARATION IS ELABORATED, ONLY WHEN THE DEFAULT IS USED.   
+ 
+ --   SUBTESTS ARE:
+ --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+ --            INITIALIZED WITH A STATIC AGGREGATE.
+ --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+ --            INITIALIZED WITH A STATIC VALUE.
+ --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+ --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+ --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+ --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+ --            WITH A STATIC AGGREGATE.
+ --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+ --            INITIALIZED WITH A STATIC AGGREGATE.
+ 
+ -- EDWARD V. BERARD, 7 AUGUST 1990
+ 
+ WITH REPORT;
+ 
+ PROCEDURE CC3017B IS
+ 
+ BEGIN
+ 
+      REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " &
+                   "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
+                   "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
+                   "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " &
+                   "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                   "CONSTRAINTS ON A FORMAL PARAMETER");
+ 
+      --------------------------------------------------
+ 
+      NONSTAT_ARRAY_PARMS:
+      
+      DECLARE
+      
+ --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+ --            INITIALIZED WITH A STATIC AGGREGATE.
+ 
+           TYPE NUMBER IS RANGE 1 .. 100 ;
+           
+           GENERIC
+           
+             TYPE INTEGER_TYPE IS RANGE <> ;
+             LOWER : IN INTEGER_TYPE ;
+             UPPER : IN INTEGER_TYPE ;
+           
+           PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
+                         SECOND : IN INTEGER_TYPE) ;
+ 
+           PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
+                         SECOND : IN INTEGER_TYPE) IS
+                         
+                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST,
+                                  INTEGER_TYPE RANGE LOWER .. SECOND)
+                                          OF INTEGER_TYPE;
+ 
+                PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER)))
+                     IS
+                BEGIN
+                     REPORT.FAILED ("BODY OF PA1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          REPORT.FAILED ("EXCEPTION RAISED IN PA1");
+                END PA1;
+ 
+           BEGIN  -- PA
+                PA1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1");
+           END PA;
+           
+           PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER,
+                                       LOWER        => 1,
+                                       UPPER        => 50) ;
+ 
+      BEGIN   -- NONSTAT_ARRAY_PARMS
+      
+           NEW_PA (FIRST  => NUMBER (25),
+                   SECOND => NUMBER (75));
+           
+      EXCEPTION
+           WHEN OTHERS =>
+                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA");
+                
+      END NONSTAT_ARRAY_PARMS ;   
+      
+      --------------------------------------------------
+ 
+      SCALAR_NON_STATIC:
+      
+      DECLARE
+      
+ --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+ --            INITIALIZED WITH A STATIC VALUE.
+ 
+           TYPE NUMBER IS RANGE 1 .. 100 ;
+           
+           GENERIC
+           
+             TYPE INTEGER_TYPE IS RANGE <> ;
+             STATIC_VALUE : IN INTEGER_TYPE ;
+           
+           PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) ;
+ 
+           PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) IS
+ 
+                SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ;
+ 
+                PROCEDURE PB1 (I : INT := STATIC_VALUE) IS
+                BEGIN  -- PB1
+                     REPORT.FAILED ("BODY OF PB1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          REPORT.FAILED ("EXCEPTION RAISED IN PB1");
+                END PB1;
+ 
+           BEGIN  -- PB
+                PB1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1");
+           END PB;
+ 
+           PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER,
+                                       STATIC_VALUE => 20) ;
+ 
+      BEGIN   -- SCALAR_NON_STATIC
+           
+           NEW_PB (LOWER  => NUMBER (25),
+                   UPPER  => NUMBER (75));
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB");
+      END SCALAR_NON_STATIC ; 
+ 
+      --------------------------------------------------
+ 
+      REC_NON_STAT_COMPS:
+      
+      DECLARE
+      
+ --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+ --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+ 
+           TYPE NUMBER IS RANGE 1 .. 100 ;
+           
+           GENERIC
+           
+             TYPE INTEGER_TYPE IS RANGE <> ;
+             F_STATIC_VALUE : IN INTEGER_TYPE ;
+             S_STATIC_VALUE : IN INTEGER_TYPE ;
+             T_STATIC_VALUE : IN INTEGER_TYPE ;
+             L_STATIC_VALUE : IN INTEGER_TYPE ;
+           
+           PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) ;
+ 
+           PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) IS
+                         
+                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                        RANGE LOWER .. UPPER ;
+                TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
+                      SUBINTEGER_TYPE ;
+                TYPE REC IS
+                     RECORD
+                          FIRST  : SUBINTEGER_TYPE ;
+                          SECOND : AR1 ;
+                     END RECORD;
+ 
+                PROCEDURE PC1 (R : REC := (F_STATIC_VALUE,
+                                          (S_STATIC_VALUE,
+                                           T_STATIC_VALUE,
+                                           L_STATIC_VALUE))) IS
+                BEGIN  -- PC1
+                     REPORT.FAILED ("BODY OF PC1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          REPORT.FAILED ("EXCEPTION RAISED IN PC1");
+                END PC1;
+ 
+           BEGIN  -- PC
+                PC1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1");
+           END PC;
+          
+           PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER,
+                                       F_STATIC_VALUE => 15,
+                                       S_STATIC_VALUE => 19,
+                                       T_STATIC_VALUE => 85,
+                                       L_STATIC_VALUE => 99) ;
+ 
+      BEGIN   -- REC_NON_STAT_COMPS
+           NEW_PC (LOWER => 20,
+                   UPPER => 80);
+      EXCEPTION
+           WHEN OTHERS =>
+                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC");
+      END REC_NON_STAT_COMPS ;
+ 
+      --------------------------------------------------
+ 
+      FIRST_STATIC_ARRAY:
+ 
+      DECLARE
+      
+ --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+ --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+ --            WITH A STATIC AGGREGATE.
+ 
+           TYPE NUMBER IS RANGE 1 .. 100 ;
+           
+           GENERIC
+           
+             TYPE INTEGER_TYPE IS RANGE <> ;
+             F_STATIC_VALUE : IN INTEGER_TYPE ;
+             S_STATIC_VALUE : IN INTEGER_TYPE ;
+             T_STATIC_VALUE : IN INTEGER_TYPE ;
+             L_STATIC_VALUE : IN INTEGER_TYPE ;
+             A_STATIC_VALUE : IN INTEGER_TYPE ;
+             B_STATIC_VALUE : IN INTEGER_TYPE ;
+             C_STATIC_VALUE : IN INTEGER_TYPE ;
+             D_STATIC_VALUE : IN INTEGER_TYPE ;
+           
+           PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
+                          UPPER  : IN INTEGER_TYPE) ;
+ 
+           PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
+                          UPPER  : IN INTEGER_TYPE) IS
+                          
+                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                        RANGE LOWER .. UPPER ;
+ 
+                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
+                                        F_STATIC_VALUE .. S_STATIC_VALUE,
+                                  INTEGER_TYPE RANGE
+                                        T_STATIC_VALUE .. L_STATIC_VALUE)
+                        OF SUBINTEGER_TYPE ;
+ 
+                PROCEDURE P1D1 (A : A1 :=
+                            ((A_STATIC_VALUE, B_STATIC_VALUE),
+                            (C_STATIC_VALUE, D_STATIC_VALUE))) IS
+                BEGIN  -- P1D1
+                     REPORT.FAILED ("BODY OF P1D1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          REPORT.FAILED ("EXCEPTION RAISED IN P1D1");
+                END P1D1;
+ 
+           BEGIN  -- P1D
+                P1D1 ;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1");
+           END P1D;
+           
+           PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER,
+                                         F_STATIC_VALUE => 21,
+                                         S_STATIC_VALUE => 37,
+                                         T_STATIC_VALUE => 67,
+                                         L_STATIC_VALUE => 79,
+                                         A_STATIC_VALUE => 11,
+                                         B_STATIC_VALUE => 88,
+                                         C_STATIC_VALUE => 87,
+                                         D_STATIC_VALUE => 13) ;
+ 
+      BEGIN  -- FIRST_STATIC_ARRAY
+           NEW_P1D (LOWER => 10,
+                      UPPER => 90);
+      EXCEPTION
+           WHEN OTHERS =>
+                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D");
+      END FIRST_STATIC_ARRAY ;
+ 
+      --------------------------------------------------
+ 
+      SECOND_STATIC_ARRAY:
+      
+      DECLARE
+      
+ --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+ --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+ --            WITH A STATIC AGGREGATE.
+ 
+           TYPE NUMBER IS RANGE 1 .. 100 ;
+           
+           GENERIC
+           
+             TYPE INTEGER_TYPE IS RANGE <> ;
+             F_STATIC_VALUE : IN INTEGER_TYPE ;
+             S_STATIC_VALUE : IN INTEGER_TYPE ;
+             T_STATIC_VALUE : IN INTEGER_TYPE ;
+             L_STATIC_VALUE : IN INTEGER_TYPE ;
+             A_STATIC_VALUE : IN INTEGER_TYPE ;
+             B_STATIC_VALUE : IN INTEGER_TYPE ;
+           
+           PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
+                          UPPER  : IN INTEGER_TYPE) ;
+ 
+           PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
+                          UPPER  : IN INTEGER_TYPE) IS
+                          
+                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                        RANGE LOWER .. UPPER ;
+ 
+                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
+                                        F_STATIC_VALUE .. S_STATIC_VALUE,
+                                  INTEGER_TYPE RANGE
+                                        T_STATIC_VALUE .. L_STATIC_VALUE)
+                        OF SUBINTEGER_TYPE ;
+ 
+                PROCEDURE P2D1 (A : A1 :=
+                                    (F_STATIC_VALUE .. S_STATIC_VALUE =>
+                                    (A_STATIC_VALUE, B_STATIC_VALUE))) IS
+                BEGIN  -- P2D1
+                     REPORT.FAILED ("BODY OF P2D1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          REPORT.FAILED ("EXCEPTION RAISED IN P2D1");
+                END P2D1;
+ 
+           BEGIN  -- P2D
+                P2D1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1");
+           END P2D;
+           
+           PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER,
+                                         F_STATIC_VALUE => 21,
+                                         S_STATIC_VALUE => 37,
+                                         T_STATIC_VALUE => 67,
+                                         L_STATIC_VALUE => 79,
+                                         A_STATIC_VALUE => 7,
+                                         B_STATIC_VALUE => 93) ;
+ 
+      BEGIN  -- SECOND_STATIC_ARRAY
+           NEW_P2D (LOWER => 5,
+                    UPPER => 95);
+      EXCEPTION
+           WHEN OTHERS =>
+                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D");
+      END SECOND_STATIC_ARRAY ;
+ 
+      --------------------------------------------------
+ 
+      REC_NON_STATIC_CONS:
+      
+      DECLARE
+      
+ --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+ --            INITIALIZED WITH A STATIC AGGREGATE.
+ 
+           TYPE NUMBER IS RANGE 1 .. 100 ;
+           
+           GENERIC
+           
+             TYPE INTEGER_TYPE IS RANGE <> ;
+             F_STATIC_VALUE : IN INTEGER_TYPE ;
+             S_STATIC_VALUE : IN INTEGER_TYPE ;
+             T_STATIC_VALUE : IN INTEGER_TYPE ;
+             L_STATIC_VALUE : IN INTEGER_TYPE ;
+             D_STATIC_VALUE : IN INTEGER_TYPE ;
+           
+           PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) ;
+ 
+           PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) IS
+                         
+                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                        RANGE LOWER .. UPPER ;
+                TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
+                      SUBINTEGER_TYPE ;
+                     
+                TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS
+                     RECORD
+                          FIRST  : SUBINTEGER_TYPE ;
+                          SECOND : AR1 ;
+                     END RECORD ;
+ 
+                SUBTYPE REC4 IS REC (LOWER) ;
+ 
+                PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE,
+                                            F_STATIC_VALUE,
+                                           (S_STATIC_VALUE,
+                                            T_STATIC_VALUE,
+                                            L_STATIC_VALUE))) IS
+                BEGIN  -- PE1
+                     REPORT.FAILED ("BODY OF PE1 EXECUTED");
+                EXCEPTION
+                     WHEN OTHERS =>
+                          REPORT.FAILED ("EXCEPTION RAISED IN PE1");
+                END PE1;
+ 
+           BEGIN  -- PE
+                PE1;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1");
+           END PE;
+ 
+           PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER,
+                                       F_STATIC_VALUE => 37,
+                                       S_STATIC_VALUE => 21,
+                                       T_STATIC_VALUE => 67,
+                                       L_STATIC_VALUE => 79,
+                                       D_STATIC_VALUE => 44) ;
+ 
+      BEGIN  -- REC_NON_STATIC_CONS
+           NEW_PE  (LOWER => 2,
+                    UPPER => 99);
+      EXCEPTION
+           WHEN OTHERS =>
+                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE");
+      END REC_NON_STATIC_CONS ;
+ 
+      --------------------------------------------------
+ 
+      REPORT.RESULT;
+ 
+ END CC3017B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3017c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3017c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3017c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3017c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,336 ----
+ -- CC3017C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
+ --     PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
+ --     DECLARE A FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS
+ --     ARE COPIED.
+ --
+ --     SUBTESTS ARE:
+ --         (A) SCALAR PARAMETERS TO PROCEDURES.
+ --         (B) SCALAR PARAMETERS TO FUNCTIONS.
+ --         (C) ACCESS PARAMETERS TO PROCEDURES.
+ --         (D) ACCESS PARAMETERS TO FUNCTIONS.
+ 
+ -- HISTORY:
+ --     EDWARD V. BERARD, 7 AUGUST 1990
+ --     CJJ 10/16/90  ADJUSTED LINES THAT WERE TOO LONG; REFORMATTED
+ --                   HEADER TO CONFORM TO ACVC STANDARDS.
+ --
+ 
+ WITH REPORT;
+ PROCEDURE CC3017C IS
+ 
+ BEGIN
+      REPORT.TEST ("CC3017C", "CHECK THAT AN INSTANCE OF A GENERIC " &
+                   "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
+                   "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
+                   "FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS " &
+                   "ARE COPIED");
+ 
+      --------------------------------------------------
+ 
+      SCALAR_TO_PROCS:
+      
+      DECLARE
+ 
+ --        (A) SCALAR PARAMETERS TO PROCEDURES.
+ 
+           TYPE NUMBER IS RANGE 0 .. 120 ;
+           VALUE : NUMBER ;
+           E     : EXCEPTION ;
+ 
+           GENERIC
+           
+             TYPE SCALAR_ITEM IS RANGE <> ;
+             
+           PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
+                        P_OUT     : OUT SCALAR_ITEM ;
+                        P_IN_OUT : IN OUT SCALAR_ITEM) ;
+                        
+           PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
+                        P_OUT     : OUT SCALAR_ITEM ;
+                        P_IN_OUT : IN OUT SCALAR_ITEM) IS
+ 
+                STORE  : SCALAR_ITEM ;
+ 
+           BEGIN  -- P
+ 
+                STORE := P_IN;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
+ 
+                P_OUT := 10;
+                IF (P_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO SCALAR OUT " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+                END IF;
+ 
+                P_IN_OUT := P_IN_OUT + 100;
+                IF (P_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+                END IF;
+ 
+                VALUE := VALUE + 1;
+                IF (P_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                END IF;
+ 
+                RAISE E;  -- CHECK EXCEPTION HANDLING.
+           END P;
+           
+           PROCEDURE NEW_P IS NEW P (SCALAR_ITEM => NUMBER) ;
+ 
+      BEGIN  -- SCALAR_TO_PROCS
+           VALUE := 0;   -- INITIALIZE VALUE SO VARIOUS CASES CAN BE DETECTED.
+           
+           NEW_P (P_IN     => VALUE,
+                  P_OUT    => VALUE,
+                  P_IN_OUT => VALUE);
+           
+           REPORT.FAILED ("EXCEPTION NOT RAISED - SCALARS TO PROCEDURES");
+      EXCEPTION
+           WHEN E =>
+                IF (VALUE /= 1) THEN
+                     CASE VALUE IS
+                          WHEN 11  =>
+                               REPORT.FAILED ("OUT ACTUAL SCALAR " &
+                                              "PARAMETER CHANGED GLOBAL VALUE");
+                          WHEN 101 =>
+                               REPORT.FAILED ("IN OUT ACTUAL SCALAR " &
+                                              "PARAMETER CHANGED GLOBAL VALUE");
+                          WHEN 111 =>
+                               REPORT.FAILED ("OUT AND IN OUT ACTUAL " &
+                                              "SCALAR PARAMETERS CHANGED " &
+                                              "GLOBAL VALUE");
+                          WHEN OTHERS =>
+                               REPORT.FAILED ("UNDETERMINED CHANGE TO " &
+                                              "GLOBAL VALUE");
+                     END CASE;
+                END IF;
+           WHEN OTHERS =>
+               REPORT.FAILED ("WRONG EXCEPTION RAISED - SCALARS TO PROCEDURES");
+      END SCALAR_TO_PROCS ;
+ 
+      --------------------------------------------------
+ 
+      SCALAR_TO_FUNCS:
+      
+      DECLARE
+ 
+ --        (B) SCALAR PARAMETERS TO FUNCTIONS.
+ 
+           TYPE NUMBER IS RANGE 0 .. 101 ;
+           FIRST  : NUMBER ;
+           SECOND : NUMBER ;
+ 
+           GENERIC
+           
+               TYPE ITEM IS RANGE <> ;
+             
+           FUNCTION F (F_IN : IN ITEM) RETURN ITEM ;
+           
+           FUNCTION F (F_IN : IN ITEM) RETURN ITEM IS
+ 
+                STORE  : ITEM := F_IN;
+ 
+           BEGIN  -- F
+ 
+                FIRST := FIRST + 1;
+                IF (F_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL FUNCTION " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                END IF;
+ 
+                RETURN (100);
+           END F;
+           
+           FUNCTION NEW_F IS NEW F (ITEM => NUMBER) ;
+ 
+      BEGIN  -- SCALAR_TO_FUNCS
+           FIRST  := 100 ;
+           SECOND := NEW_F (FIRST) ;
+      END SCALAR_TO_FUNCS ;
+ 
+      --------------------------------------------------
+ 
+      ACCESS_TO_PROCS:
+      
+      DECLARE
+ 
+ --        (C) ACCESS PARAMETERS TO PROCEDURES.
+ 
+           TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                                SEP, OCT, NOV, DEC) ;
+           TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+           TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+           TYPE DATE IS RECORD
+               MONTH : MONTH_TYPE ;
+               DAY   : DAY_TYPE ;
+               YEAR  : YEAR_TYPE ;
+           END RECORD ;
+           
+           TYPE DATE_ACCESS IS ACCESS DATE ;
+           DATE_POINTER : DATE_ACCESS ;
+           
+           E    : EXCEPTION;
+           
+           GENERIC
+           
+             TYPE ITEM IS PRIVATE ;
+             TYPE ACCESS_ITEM IS ACCESS ITEM ;
+ 
+           PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;  
+                        P_OUT    : OUT    ACCESS_ITEM ;
+                        P_IN_OUT : IN OUT ACCESS_ITEM) ;
+ 
+           PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;  
+                        P_OUT    : OUT    ACCESS_ITEM ;
+                        P_IN_OUT : IN OUT ACCESS_ITEM) IS
+ 
+                STORE  : ACCESS_ITEM ;
+ 
+           BEGIN  -- P
+ 
+                STORE := P_IN ;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
+ 
+                DATE_POINTER := NEW DATE'(YEAR  => 1990,
+                                          DAY   => 7,
+                                          MONTH => AUG) ;
+                IF (P_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+                END IF;
+ 
+                P_OUT := NEW ITEM ;
+                IF (P_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO ACCESS OUT " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+                END IF;
+ 
+                P_IN_OUT :=  NEW ITEM ;
+                IF (P_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                END IF;
+ 
+                RAISE E;  -- CHECK EXCEPTION HANDLING.
+           END P ;
+           
+           PROCEDURE NEW_P IS NEW P (ITEM         => DATE,
+                                     ACCESS_ITEM  => DATE_ACCESS) ;
+ 
+      BEGIN  -- ACCESS_TO_PROCS
+           DATE_POINTER := NEW DATE'(MONTH => DEC,
+                                     DAY   => 25,
+                                     YEAR  => 2000) ;
+                                     
+           NEW_P (P_IN       => DATE_POINTER,
+                    P_OUT    => DATE_POINTER,
+                    P_IN_OUT => DATE_POINTER) ;
+                  
+           REPORT.FAILED ("EXCEPTION NOT RAISED - ACCESS TO PROCEDURES");
+      EXCEPTION
+           WHEN E =>
+                IF (DATE_POINTER.ALL /= (AUG, 7, 1990)) THEN
+                     REPORT.FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
+                                    "PARAMETER VALUE CHANGED DESPITE " &
+                                    "RAISED EXCEPTION");
+                END IF;
+           WHEN OTHERS =>
+                REPORT.FAILED ("WRONG EXCEPTION RAISED - ACCESS TO PROCEDURES");
+      END ACCESS_TO_PROCS ;
+ 
+      --------------------------------------------------
+ 
+      ACCESS_TO_FUNCS:
+      
+      DECLARE
+      
+ --        (D) ACCESS PARAMETERS TO FUNCTIONS.
+ 
+           TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                                SEP, OCT, NOV, DEC) ;
+           TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+           TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+           TYPE DATE IS RECORD
+             MONTH : MONTH_TYPE ;
+             DAY   : DAY_TYPE ;
+             YEAR  : YEAR_TYPE ;
+           END RECORD ;
+           
+           TYPE DATE_ACCESS IS ACCESS DATE ;
+           DATE_POINTER : DATE_ACCESS ;
+           NEXT_DATE    : DATE_ACCESS ;
+ 
+           GENERIC
+           
+             TYPE ITEM IS PRIVATE ;
+             TYPE ACCESS_ITEM IS ACCESS ITEM ;
+ 
+           FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM ;
+ 
+           FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM IS
+ 
+                STORE  : ACCESS_ITEM := F_IN ;
+ 
+           BEGIN  -- F
+ 
+                DATE_POINTER := NEW DATE'(YEAR  => 1990,
+                                             DAY   => 7,
+                                          MONTH => AUG) ;
+                IF (F_IN /= STORE) THEN
+                     REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL FUNCTION " &
+                                    "PARAMETER CHANGES THE VALUE OF " &
+                                    "INPUT PARAMETER");
+                END IF;
+ 
+                RETURN (NULL);
+           END F ;
+           
+           FUNCTION NEW_F IS NEW F (ITEM        => DATE,
+                                    ACCESS_ITEM => DATE_ACCESS) ;
+ 
+      BEGIN  -- ACCESS_TO_FUNCS
+           DATE_POINTER := NULL ;
+           NEXT_DATE    := NEW_F(F_IN => DATE_POINTER) ;
+      END ACCESS_TO_FUNCS ;
+ 
+      --------------------------------------------------
+ 
+      REPORT.RESULT;
+ 
+ END CC3017C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,173 ----
+ -- CC3019A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT INSTANTIATIONS OF NESTED GENERIC UNITS ARE PROCESSED
+ -- CORRECTLY.
+ 
+ -- JBG 11/6/85
+ 
+ GENERIC
+      TYPE ELEMENT_TYPE IS PRIVATE;
+ PACKAGE CC3019A_QUEUES IS
+ 
+      TYPE QUEUE_TYPE IS PRIVATE;
+ 
+      PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
+                     VALUE : ELEMENT_TYPE);
+ 
+      GENERIC
+           WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
+      PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE);
+ 
+ PRIVATE
+ 
+      TYPE CONTENTS_TYPE IS ARRAY (1..3) OF ELEMENT_TYPE;
+      TYPE QUEUE_TYPE IS
+           RECORD
+                CONTENTS : CONTENTS_TYPE;
+                SIZE     : NATURAL := 0;
+           END RECORD;
+ 
+ END CC3019A_QUEUES;
+ 
+ PACKAGE BODY CC3019A_QUEUES IS
+ 
+      PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
+                     VALUE : ELEMENT_TYPE) IS
+      BEGIN
+           TO_Q.SIZE := TO_Q.SIZE + 1;
+           TO_Q.CONTENTS(TO_Q.SIZE) := VALUE;
+      END ADD;
+ 
+ --   GENERIC
+ --        WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
+      PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE) IS
+      BEGIN
+           FOR I IN TO_Q.CONTENTS'FIRST .. TO_Q.SIZE LOOP
+                APPLY (TO_Q.CONTENTS(I));
+           END LOOP;
+      END ITERATOR;
+ 
+ END CC3019A_QUEUES;
+ 
+ WITH REPORT; USE REPORT;
+ WITH CC3019A_QUEUES;
+ PROCEDURE CC3019A IS
+ 
+      SUBTYPE STR6 IS STRING (1..6);
+ 
+      TYPE STR6_ARR IS ARRAY (1..3) OF STR6;
+      STR6_VALS : STR6_ARR := ("111111", "222222",
+                                IDENT_STR("333333"));
+      CUR_STR_INDEX : NATURAL := 1;
+ 
+      TYPE INT_ARR IS ARRAY (1..3) OF INTEGER;
+      INT_VALS : INT_ARR := (-1, 3, IDENT_INT(3));
+      CUR_INT_INDEX : NATURAL := 1;
+ 
+ -- THIS PROCEDURE IS CALLED ONCE FOR EACH ELEMENT OF THE QUEUE
+ --
+      PROCEDURE CHECK_STR (VAL : STR6) IS
+      BEGIN
+           IF VAL /= STR6_VALS(CUR_STR_INDEX) THEN
+                FAILED ("STR6 ITERATOR FOR INDEX =" &
+                        INTEGER'IMAGE(CUR_STR_INDEX) & " WITH VALUE " &
+                        """" & VAL & """");
+           END IF;
+           CUR_STR_INDEX := CUR_STR_INDEX + 1;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("STR6 - CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("STR6 - UNEXPECTED EXCEPTION");
+      END CHECK_STR;
+ 
+      PROCEDURE CHECK_INT (VAL : INTEGER) IS
+      BEGIN
+           IF VAL /= INT_VALS(CUR_INT_INDEX) THEN
+                FAILED ("INTEGER ITERATOR FOR INDEX =" &
+                        INTEGER'IMAGE(CUR_INT_INDEX) & " WITH VALUE " &
+                        """" & INTEGER'IMAGE(VAL) & """");
+           END IF;
+           CUR_INT_INDEX := CUR_INT_INDEX + 1;
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("INTEGER - CONSTRAINT_ERROR RAISED");
+           WHEN OTHERS =>
+                FAILED ("INTEGER - UNEXPECTED EXCEPTION");
+      END CHECK_INT;
+ 
+      PACKAGE STR6_QUEUE IS NEW CC3019A_QUEUES (STR6);
+      USE STR6_QUEUE;
+ 
+      PACKAGE INT_QUEUE IS NEW CC3019A_QUEUES (INTEGER);
+      USE INT_QUEUE;
+ 
+ BEGIN
+ 
+      TEST ("CC3019A", "CHECK NESTED GENERICS - ITERATORS");
+ 
+      DECLARE
+           Q1 : STR6_QUEUE.QUEUE_TYPE;
+ 
+           PROCEDURE CHK_STR IS NEW STR6_QUEUE.ITERATOR (CHECK_STR);
+ 
+      BEGIN
+ 
+           ADD (Q1, "111111");
+           ADD (Q1, "222222");
+           ADD (Q1, "333333");
+ 
+           CUR_STR_INDEX := 1;
+           CHK_STR (Q1);
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - Q1");
+      END;
+ 
+ -- REPEAT FOR INTEGERS
+ 
+      DECLARE
+           Q2 : INT_QUEUE.QUEUE_TYPE;
+ 
+           PROCEDURE CHK_INT IS NEW INT_QUEUE.ITERATOR (CHECK_INT);
+ 
+      BEGIN
+ 
+           ADD (Q2, -1);
+           ADD (Q2, 3);
+           ADD (Q2, 3);
+ 
+           CUR_INT_INDEX := 1;
+           CHK_INT (Q2);
+ 
+      EXCEPTION
+           WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - Q2");
+      END;
+ 
+      RESULT;
+ 
+ END CC3019A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019b0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019b0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019b0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019b0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- CC3019B0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+ --  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
+ --
+ -- HISTORY:
+ --         EDWARD V. BERARD, 31 AUGUST 1990
+ 
+ GENERIC
+      
+      TYPE ELEMENT IS LIMITED PRIVATE ;
+           
+      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                             DESTINATION   : IN OUT ELEMENT) ;
+                                 
+      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+                                        
+ PACKAGE CC3019B0_LIST_CLASS IS
+      
+      TYPE LIST IS LIMITED PRIVATE ;
+           
+      OVERFLOW    : EXCEPTION ;
+      UNDERFLOW    : EXCEPTION ;
+           
+      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                        TO_THIS_LIST        : IN OUT LIST) ;
+                        
+      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                        FROM_THIS_LIST    : IN OUT LIST) ;
+                            
+      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                        TO_THIS_LIST        : IN OUT LIST) ;
+                            
+      PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
+                                
+      GENERIC
+           
+           WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                   CONTINUE        : OUT BOOLEAN) ;
+                                          
+      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
+                                
+      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+           RETURN NATURAL ;
+           
+      FUNCTION "=" (LEFT  : IN LIST ;
+                    RIGHT : IN LIST) RETURN BOOLEAN ;
+                
+ PRIVATE
+      
+      TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
+           
+      TYPE LIST IS RECORD
+           LENGTH        : NATURAL := 0 ;
+           ACTUAL_LIST   : LIST_TABLE ;
+      END RECORD ;
+           
+ END CC3019B0_LIST_CLASS ;
+      
+ PACKAGE BODY CC3019B0_LIST_CLASS IS
+      
+      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                        TO_THIS_LIST        : IN OUT LIST) IS
+                            
+      BEGIN  -- ADD
+           
+           IF TO_THIS_LIST.LENGTH >= 10 THEN
+                RAISE OVERFLOW ;
+           ELSE
+                TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
+                ASSIGN (
+                     SOURCE      => THIS_ELEMENT,
+                     DESTINATION =>
+                         TO_THIS_LIST.ACTUAL_LIST (TO_THIS_LIST.LENGTH));
+           END IF ;
+           
+      END ADD ;
+                             
+      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                        FROM_THIS_LIST    : IN OUT LIST) IS
+                                
+      BEGIN  -- DELETE
+           
+           IF FROM_THIS_LIST.LENGTH <= 0 THEN
+                RAISE UNDERFLOW ;
+           ELSE
+                ASSIGN (
+                     SOURCE      => 
+                       FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
+                     DESTINATION => THIS_ELEMENT) ;
+                FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
+           END IF ;
+           
+      END DELETE ;
+                             
+      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                            TO_THIS_LIST        : IN OUT LIST) IS
+                                
+      BEGIN  -- COPY
+           
+           TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
+           FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
+                ASSIGN (
+                     SOURCE      => THIS_LIST.ACTUAL_LIST (INDEX),
+                     DESTINATION => TO_THIS_LIST.ACTUAL_LIST (INDEX)) ;
+           END LOOP ;
+                
+      END COPY ;
+      
+      PROCEDURE CLEAR  (THIS_LIST          : IN OUT LIST) IS
+      
+      BEGIN  -- CLEAR
+      
+           THIS_LIST.LENGTH := 0 ;
+           
+      END CLEAR ;
+                                
+      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) IS
+           
+           CONTINUE : BOOLEAN := TRUE ;
+           FINISHED : NATURAL := 0 ;
+                
+      BEGIN  -- ITERATE
+           
+           WHILE (CONTINUE = TRUE) AND (FINISHED < OVER_THIS_LIST.LENGTH)
+                LOOP
+                     FINISHED := FINISHED + 1 ;
+                     PROCESS (THIS_ELEMENT =>
+                                  OVER_THIS_LIST.ACTUAL_LIST (FINISHED),
+                               CONTINUE     => CONTINUE) ;
+                END LOOP ;
+                     
+      END ITERATE ;
+                
+      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+           RETURN NATURAL IS
+           
+      BEGIN  -- NUMBER_OF_ELEMENTS
+           
+           RETURN IN_THIS_LIST.LENGTH ;
+                
+      END NUMBER_OF_ELEMENTS ;
+           
+      FUNCTION "=" (LEFT  : IN LIST ;
+                    RIGHT : IN LIST) RETURN BOOLEAN IS
+                       
+           RESULT : BOOLEAN := TRUE ;
+           INDEX  : NATURAL := 0 ;
+           
+      BEGIN  -- "="
+      
+           IF LEFT.LENGTH /= RIGHT.LENGTH THEN
+                RESULT := FALSE ;
+           ELSE
+                WHILE (INDEX < LEFT.LENGTH) AND RESULT LOOP
+                     INDEX := INDEX + 1 ;
+                     IF LEFT.ACTUAL_LIST (INDEX) /=
+                        RIGHT.ACTUAL_LIST (INDEX) THEN
+                          RESULT := FALSE ;
+                     END IF ;
+                END LOOP ;
+           END IF ;
+           
+           RETURN RESULT ;
+           
+      END "=" ;
+                
+ END CC3019B0_LIST_CLASS ;          
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019b1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019b1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019b1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019b1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,174 ----
+ -- CC3019B1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+ --  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED
+ --  BY THE MAIN PROCEDURE, I.E., CC3019B2M.ADA.
+ --
+ -- *** THIS FILE MUST BE COMPILED AFTER CC3019B0.ADA HAS BEEN
+ -- *** COMPILED.
+ --
+ -- HISTORY:
+ --         EDWARD V. BERARD, 31 AUGUST 1990
+ 
+ WITH CC3019B0_LIST_CLASS ;
+ 
+ GENERIC
+      
+      TYPE ELEMENT IS LIMITED PRIVATE ;
+           
+      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                             DESTINATION   : IN OUT ELEMENT) ;
+                                
+      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+                                       
+ PACKAGE CC3019B1_STACK_CLASS IS
+      
+      TYPE STACK IS LIMITED PRIVATE ;
+           
+      OVERFLOW    : EXCEPTION ;
+      UNDERFLOW   : EXCEPTION ;
+           
+      PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                      ON_TO_THIS_STACK    : IN OUT STACK) ;
+                         
+      PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                      OFF_THIS_STACK      : IN OUT STACK) ;
+                             
+      PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
+                       TO_THIS_STACK    : IN OUT STACK) ;
+                          
+      PROCEDURE CLEAR (THIS_STACK       : IN OUT STACK) ;
+      
+      GENERIC
+           
+           WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                   CONTINUE        : OUT BOOLEAN) ;
+                                         
+      PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) ;
+                               
+      FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+           RETURN NATURAL ;
+           
+      FUNCTION "=" (LEFT  : IN STACK ;
+                    RIGHT : IN STACK) RETURN BOOLEAN ;
+                
+ PRIVATE
+ 
+      PACKAGE NEW_LIST_CLASS IS
+           NEW CC3019B0_LIST_CLASS (ELEMENT => ELEMENT,
+                                    ASSIGN  => ASSIGN,
+                                    "="     => "=") ;
+                                                       
+      TYPE STACK IS NEW NEW_LIST_CLASS.LIST ;
+           
+ END CC3019B1_STACK_CLASS ;
+      
+ PACKAGE BODY CC3019B1_STACK_CLASS IS
+      
+      PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                      ON_TO_THIS_STACK    : IN OUT STACK) IS
+                             
+      BEGIN  -- PUSH
+           
+           NEW_LIST_CLASS.ADD (
+                THIS_ELEMENT    => THIS_ELEMENT,
+                TO_THIS_LIST    =>
+                     NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ;
+                                     
+      EXCEPTION
+      
+           WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ;
+                                     
+      END PUSH ;
+                             
+      PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                      OFF_THIS_STACK      : IN OUT STACK) IS
+                             
+      BEGIN  -- POP
+           
+           NEW_LIST_CLASS.DELETE (
+                THIS_ELEMENT      => THIS_ELEMENT,
+                FROM_THIS_LIST    =>
+                          NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ;
+                                        
+      EXCEPTION
+      
+           WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ;
+                                     
+      END POP ;
+                             
+      PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
+                       TO_THIS_STACK    : IN OUT STACK) IS
+                              
+      BEGIN  -- COPY
+           
+           NEW_LIST_CLASS.COPY (
+                THIS_LIST    => NEW_LIST_CLASS.LIST (THIS_STACK),
+                TO_THIS_LIST => NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ;
+                
+      END COPY ;
+      
+      PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) IS
+      
+      BEGIN  -- CLEAR
+      
+           NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ;
+           
+      END CLEAR ;
+      
+      PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) IS
+      
+           PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE
+                (PROCESS => PROCESS) ;
+                
+      BEGIN  -- ITERATE
+      
+           STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ;
+           
+      END ITERATE ;
+ 
+      FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+           RETURN NATURAL IS
+                
+      BEGIN  -- NUMBER_OF_ELEMENTS
+           
+           RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS
+                (IN_THIS_LIST => NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ;
+                     
+      END NUMBER_OF_ELEMENTS ;
+           
+      FUNCTION "=" (LEFT  : IN STACK ;
+                    RIGHT : IN STACK) RETURN BOOLEAN IS
+      
+      BEGIN  -- "="
+      
+           RETURN NEW_LIST_CLASS."=" (
+                LEFT  => NEW_LIST_CLASS.LIST (LEFT),
+                RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ;
+                                        
+      END "=" ;
+                
+ END CC3019B1_STACK_CLASS ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019b2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019b2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019b2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019b2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,300 ----
+ -- CC3019B2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G.,
+ --  TO SUPPORT ITERATORS. THIS TEST SPECIFICALLY CHECKS THAT A
+ --  NESTING LEVEL OF 2 IS SUPPORTED FOR GENERICS.
+ --
+ --  *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE
+ --  *** SOURCE CODE IN FILES CC3019B0.ADA AND CC3019B1.ADA HAVE
+ --  *** BEEN COMPILED.
+ --
+ -- HISTORY:
+ --         EDWARD V. BERARD, 31 AUGUST 1990
+ 
+ WITH REPORT ;
+ WITH CC3019B1_STACK_CLASS ;
+ 
+ PROCEDURE CC3019B2M IS
+ 
+      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                          SEP, OCT, NOV, DEC) ;
+      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+      TYPE DATE IS RECORD
+           MONTH : MONTH_TYPE ;
+           DAY   : DAY_TYPE ;
+           YEAR  : YEAR_TYPE ;
+      END RECORD ;
+      
+      STORE_DATE     : DATE ;
+ 
+      TODAY        : DATE := (MONTH => AUG,
+                              DAY   => 31,
+                              YEAR  => 1990) ;
+                                     
+      FIRST_DATE   : DATE := (MONTH => JUN,
+                              DAY   => 4,
+                              YEAR  => 1967) ;
+                                     
+      BIRTH_DATE   : DATE := (MONTH => OCT,
+                              DAY   => 3,
+                              YEAR  => 1949) ;
+                                     
+      WALL_DATE    : DATE := (MONTH => NOV,
+                              DAY   => 9,
+                              YEAR  => 1989) ;
+                                     
+      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                        TO_THIS_DATE              : IN OUT DATE) ;
+                               
+      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                         RIGHT : IN DATE) RETURN BOOLEAN ;
+ 
+      PACKAGE DATE_STACK IS
+           NEW CC3019B1_STACK_CLASS (ELEMENT => DATE,
+                                     ASSIGN  => ASSIGN,
+                                     "="     => IS_EQUAL) ;
+                                                    
+      FIRST_DATE_STACK    : DATE_STACK.STACK ;
+      SECOND_DATE_STACK   : DATE_STACK.STACK ;
+      THIRD_DATE_STACK    : DATE_STACK.STACK ;
+      
+      FUNCTION "=" (LEFT  : IN DATE_STACK.STACK ;
+                    RIGHT : IN DATE_STACK.STACK) RETURN BOOLEAN
+                    RENAMES DATE_STACK."=" ;
+                               
+      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                        TO_THIS_DATE              : IN OUT DATE) IS
+                               
+      BEGIN -- ASSIGN
+           
+           TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
+                 
+      END ASSIGN ;
+                                             
+      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                         RIGHT : IN DATE) RETURN BOOLEAN IS
+                          
+      BEGIN -- IS_EQUAL
+      
+           RETURN (LEFT.MONTH = RIGHT.MONTH) AND
+                  (LEFT.DAY = RIGHT.DAY) AND
+                  (LEFT.YEAR = RIGHT.YEAR) ;
+           
+      END IS_EQUAL ;
+ 
+ BEGIN  -- CC3019B2M
+ 
+      REPORT.TEST ("CC3019B2M",
+                   "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " &
+                   "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " &
+                   "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF " &
+                   "2 IS SUPPORTED FOR GENERICS.") ;
+                         
+      DATE_STACK.CLEAR (THIS_STACK => FIRST_DATE_STACK) ;
+      IF DATE_STACK.NUMBER_OF_ELEMENTS 
+         (ON_THIS_STACK => FIRST_DATE_STACK) /= 0 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
+      END IF ;
+      
+      DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
+                       ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
+      IF DATE_STACK.NUMBER_OF_ELEMENTS 
+         (ON_THIS_STACK => FIRST_DATE_STACK) /= 1 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
+      END IF ;
+      
+      DATE_STACK.PUSH (THIS_ELEMENT     => FIRST_DATE,
+                       ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
+      IF DATE_STACK.NUMBER_OF_ELEMENTS 
+         (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
+      END IF ;
+      
+      DATE_STACK.PUSH (THIS_ELEMENT     => BIRTH_DATE,
+                       ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
+      IF DATE_STACK.NUMBER_OF_ELEMENTS 
+         (ON_THIS_STACK => FIRST_DATE_STACK) /= 3 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
+      END IF ;
+      
+      DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
+                            OFF_THIS_STACK => FIRST_DATE_STACK) ;
+      IF DATE_STACK.NUMBER_OF_ELEMENTS 
+         (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
+      END IF ;
+      
+      IF STORE_DATE /= BIRTH_DATE THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE REMOVED FROM STACK - 1") ;
+      END IF ;
+      
+      DATE_STACK.CLEAR (THIS_STACK => SECOND_DATE_STACK) ;
+      IF DATE_STACK.NUMBER_OF_ELEMENTS 
+         (ON_THIS_STACK => SECOND_DATE_STACK) /= 0 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
+      END IF ;
+           
+      DATE_STACK.COPY (THIS_STACK    => FIRST_DATE_STACK,
+                       TO_THIS_STACK => SECOND_DATE_STACK) ;
+                              
+      IF FIRST_DATE_STACK /= SECOND_DATE_STACK THEN
+           REPORT.FAILED (
+                "PROBLEMS WITH COPY OR TEST FOR EQUALITY") ;
+      END IF ;
+      
+      DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
+                      OFF_THIS_STACK => SECOND_DATE_STACK) ;
+      DATE_STACK.PUSH (THIS_ELEMENT     => WALL_DATE,
+                       ON_TO_THIS_STACK => SECOND_DATE_STACK) ;
+      IF FIRST_DATE_STACK = SECOND_DATE_STACK THEN
+           REPORT.FAILED (
+                "PROBLEMS WITH POP OR TEST FOR EQUALITY") ;
+      END IF ;
+      
+      UNDERFLOW_EXCEPTION_TEST:
+      
+      BEGIN  -- UNDERFLOW_EXCEPTION_TEST
+      
+           DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
+           DATE_STACK.POP (THIS_ELEMENT      => STORE_DATE,
+                           OFF_THIS_STACK    => THIRD_DATE_STACK) ;
+           REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;
+      
+      EXCEPTION
+      
+           WHEN DATE_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                                -- RAISED
+           WHEN OTHERS =>
+                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                               "UNDERFLOW EXCEPTION TEST") ;
+                                               
+      END UNDERFLOW_EXCEPTION_TEST ;
+      
+      OVERFLOW_EXCEPTION_TEST:
+      
+      BEGIN  -- OVERFLOW_EXCEPTION_TEST
+      
+           DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
+           FOR INDEX IN 1 .. 10 LOOP
+                DATE_STACK.PUSH ( THIS_ELEMENT     => TODAY,
+                                  ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
+           END LOOP ;
+           
+           DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
+                            ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
+           REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;
+      
+      EXCEPTION
+      
+           WHEN DATE_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                               -- RAISED
+           WHEN OTHERS =>
+                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                               "OVERFLOW EXCEPTION TEST") ;
+                                               
+      END OVERFLOW_EXCEPTION_TEST ;
+ 
+      LOCAL_BLOCK:
+      
+      DECLARE
+      
+           TYPE DATE_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF DATE ;
+      
+           FIRST_DATE_TABLE : DATE_TABLE ;
+      
+           TABLE_INDEX : POSITIVE := 1 ;
+      
+           PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
+                                 CONTINUE  : OUT BOOLEAN) ;
+                                       
+           PROCEDURE STORE_DATES (THIS_DATE : IN DATE ;
+                                  CONTINUE  : OUT BOOLEAN) ;
+                                       
+           PROCEDURE SHOW_DATE_ITERATE IS NEW 
+                DATE_STACK.ITERATE (PROCESS => SHOW_DATES) ;
+                                 
+           PROCEDURE STORE_DATE_ITERATE IS NEW 
+                DATE_STACK.ITERATE (PROCESS => STORE_DATES) ;
+                                 
+           PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
+                                 CONTINUE  : OUT BOOLEAN) IS
+           BEGIN  -- SHOW_DATES
+           
+                 REPORT.COMMENT ("THE MONTH IS " &
+                            MONTH_TYPE'IMAGE (THIS_DATE.MONTH)) ;
+                 REPORT.COMMENT ("THE DAY IS " &
+                            DAY_TYPE'IMAGE (THIS_DATE.DAY)) ;
+                 REPORT.COMMENT ("THE YEAR IS " &
+                            YEAR_TYPE'IMAGE (THIS_DATE.YEAR)) ;
+                 
+                 CONTINUE := TRUE ;
+                            
+           END SHOW_DATES ;
+           
+           PROCEDURE STORE_DATES (THIS_DATE : IN  DATE ;
+                                        CONTINUE  : OUT BOOLEAN) IS
+           BEGIN  -- STORE_DATES
+           
+                 FIRST_DATE_TABLE (TABLE_INDEX) := THIS_DATE ;
+                 TABLE_INDEX := TABLE_INDEX + 1 ;
+                 
+                 CONTINUE := TRUE ;
+                 
+           END STORE_DATES ;
+           
+      BEGIN  -- LOCAL_BLOCK
+      
+           REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
+           SHOW_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
+ 
+           REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
+           SHOW_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
+ 
+           STORE_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
+           IF (FIRST_DATE_TABLE (1) /= TODAY) OR
+                (FIRST_DATE_TABLE (2) /= FIRST_DATE) THEN
+                      REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
+           END IF ;
+           
+           TABLE_INDEX := 1 ;
+           STORE_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
+           IF (FIRST_DATE_TABLE (1) /= TODAY) OR
+                (FIRST_DATE_TABLE (2) /= WALL_DATE) THEN
+                      REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
+           END IF ;
+           
+      END LOCAL_BLOCK ;
+      
+      REPORT.RESULT ;
+      
+ END CC3019B2M ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019c0.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019c0.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019c0.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019c0.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,191 ----
+ -- CC3019C0.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE
+ --   THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+ --   NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
+ --
+ -- HISTORY:
+ --         EDWARD V. BERARD, 31 AUGUST 1990
+ 
+ GENERIC
+ 
+      TYPE ELEMENT IS LIMITED PRIVATE ;
+ 
+      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                             DESTINATION   : IN OUT ELEMENT) ;
+ 
+      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+ 
+ PACKAGE CC3019C0_LIST_CLASS IS
+ 
+      TYPE LIST IS LIMITED PRIVATE ;
+ 
+      OVERFLOW    : EXCEPTION ;
+      UNDERFLOW   : EXCEPTION ;
+ 
+      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                        TO_THIS_LIST        : IN OUT LIST) ;
+ 
+      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                        FROM_THIS_LIST    : IN OUT LIST) ;
+ 
+      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                        TO_THIS_LIST        : IN OUT LIST) ;
+ 
+      PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
+ 
+      GENERIC
+ 
+           WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                   CONTINUE        : OUT BOOLEAN) ;
+ 
+      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
+ 
+      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+           RETURN NATURAL ;
+ 
+      FUNCTION "=" (LEFT  : IN LIST ;
+                    RIGHT : IN LIST) RETURN BOOLEAN ;
+ 
+ PRIVATE
+ 
+      TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
+ 
+      TYPE LIST IS RECORD
+           LENGTH        : NATURAL := 0 ;
+           ACTUAL_LIST   : LIST_TABLE ;
+      END RECORD ;
+ 
+ END CC3019C0_LIST_CLASS ;
+ 
+ PACKAGE BODY CC3019C0_LIST_CLASS IS
+ 
+      PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                        TO_THIS_LIST        : IN OUT LIST) IS
+ 
+      BEGIN  -- ADD
+ 
+           IF TO_THIS_LIST.LENGTH >= 10 THEN
+                RAISE OVERFLOW ;
+           ELSE
+                TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
+                ASSIGN (
+                     SOURCE      => THIS_ELEMENT,
+                     DESTINATION =>
+                          TO_THIS_LIST.ACTUAL_LIST(TO_THIS_LIST.LENGTH));
+           END IF ;
+ 
+      END ADD ;
+ 
+      PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                        FROM_THIS_LIST    : IN OUT LIST) IS
+ 
+      BEGIN  -- DELETE
+ 
+           IF FROM_THIS_LIST.LENGTH <= 0 THEN
+                RAISE UNDERFLOW ;
+           ELSE
+                ASSIGN (
+                     SOURCE      =>
+                       FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
+                     DESTINATION => THIS_ELEMENT) ;
+                FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
+           END IF ;
+ 
+      END DELETE ;
+ 
+      PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                        TO_THIS_LIST        : IN OUT LIST) IS
+ 
+      BEGIN  -- COPY
+ 
+           TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
+           FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
+                ASSIGN (SOURCE      => THIS_LIST.ACTUAL_LIST (INDEX),
+                        DESTINATION => TO_THIS_LIST.ACTUAL_LIST (INDEX));
+           END LOOP ;
+ 
+      END COPY ;
+ 
+      PROCEDURE CLEAR  (THIS_LIST         : IN OUT LIST) IS
+ 
+      BEGIN  -- CLEAR
+ 
+           THIS_LIST.LENGTH := 0 ;
+ 
+      END CLEAR ;
+ 
+      PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) IS
+ 
+           CONTINUE : BOOLEAN := TRUE ;
+           FINISHED : NATURAL := 0 ;
+ 
+      BEGIN  -- ITERATE
+ 
+           WHILE (CONTINUE = TRUE) AND (FINISHED < OVER_THIS_LIST.LENGTH)
+                LOOP
+                     FINISHED := FINISHED + 1 ;
+                     PROCESS (THIS_ELEMENT =>
+                                 OVER_THIS_LIST.ACTUAL_LIST (FINISHED),
+                              CONTINUE     => CONTINUE) ;
+                END LOOP ;
+ 
+      END ITERATE ;
+ 
+      FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+           RETURN NATURAL IS
+ 
+      BEGIN  -- NUMBER_OF_ELEMENTS
+ 
+           RETURN IN_THIS_LIST.LENGTH ;
+ 
+      END NUMBER_OF_ELEMENTS ;
+ 
+      FUNCTION "=" (LEFT  : IN LIST ;
+                    RIGHT : IN LIST) RETURN BOOLEAN IS
+ 
+           RESULT : BOOLEAN := TRUE ;
+           INDEX  : NATURAL := 0 ;
+ 
+      BEGIN  -- "="
+ 
+           IF LEFT.LENGTH /= RIGHT.LENGTH THEN
+                RESULT := FALSE ;
+           ELSE
+                WHILE (INDEX < LEFT.LENGTH) AND RESULT LOOP
+                     INDEX := INDEX + 1 ;
+                     IF LEFT.ACTUAL_LIST (INDEX) /=
+                        RIGHT.ACTUAL_LIST (INDEX) THEN
+                         RESULT := FALSE ;
+                     END IF ;
+                END LOOP ;
+           END IF ;
+ 
+           RETURN RESULT ;
+ 
+      END "=" ;
+ 
+ END CC3019C0_LIST_CLASS ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019c1.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019c1.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019c1.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019c1.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,331 ----
+ -- CC3019C1.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --  THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+ --  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED
+ --  BY MAIN PROCEDURE CC3019C2M.ADA.
+ --
+ -- HISTORY:
+ --         EDWARD V. BERARD, 31 AUGUST 1990
+ 
+ WITH CC3019C0_LIST_CLASS ;
+ 
+ GENERIC
+ 
+      TYPE ELEMENT IS LIMITED PRIVATE ;
+ 
+      WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                             DESTINATION   : IN OUT ELEMENT) ;
+ 
+      WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                         RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+ 
+ PACKAGE CC3019C1_NESTED_GENERICS IS
+ 
+      TYPE NESTED_GENERICS_TYPE IS LIMITED PRIVATE ;
+ 
+      PROCEDURE COPY (SOURCE        : IN OUT NESTED_GENERICS_TYPE ;
+                      DESTINATION   : IN OUT NESTED_GENERICS_TYPE) ;
+ 
+      PROCEDURE SET_ELEMENT
+                     (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+                      TO_THIS_ELEMENT     : IN OUT ELEMENT) ;
+ 
+      PROCEDURE SET_NUMBER
+                     (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+                      TO_THIS_NUMBER      : IN NATURAL) ;
+ 
+      FUNCTION "=" (LEFT  : IN NESTED_GENERICS_TYPE ;
+                    RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN ;
+ 
+      FUNCTION ELEMENT_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+           RETURN ELEMENT ;
+ 
+      FUNCTION NUMBER_OF  (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+           RETURN NATURAL ;
+ 
+      GENERIC
+ 
+           TYPE ELEMENT IS LIMITED PRIVATE ;
+ 
+           WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                                  DESTINATION   : IN OUT ELEMENT) ;
+ 
+      PACKAGE GENERIC_TASK IS
+ 
+           TASK TYPE PROTECTED_AREA IS
+ 
+                     ENTRY STORE (ITEM    : IN OUT ELEMENT) ;
+                     ENTRY GET   (ITEM    : IN OUT ELEMENT) ;
+ 
+           END PROTECTED_AREA ;
+ 
+      END GENERIC_TASK ;
+ 
+      GENERIC
+ 
+           TYPE ELEMENT IS LIMITED PRIVATE ;
+ 
+           WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                                  DESTINATION   : IN OUT ELEMENT) ;
+ 
+           WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                              RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+ 
+      PACKAGE STACK_CLASS IS
+ 
+           TYPE STACK IS LIMITED PRIVATE ;
+ 
+           OVERFLOW    : EXCEPTION ;
+           UNDERFLOW   : EXCEPTION ;
+ 
+           PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                           ON_TO_THIS_STACK    : IN OUT STACK) ;
+ 
+           PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                           OFF_THIS_STACK      : IN OUT STACK) ;
+ 
+           PROCEDURE COPY  (THIS_STACK        : IN OUT STACK ;
+                            TO_THIS_STACK    : IN OUT STACK) ;
+ 
+           PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) ;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                        CONTINUE        : OUT BOOLEAN) ;
+ 
+           PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) ;
+ 
+           FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+                     RETURN NATURAL ;
+ 
+           FUNCTION "=" (LEFT  : IN STACK ;
+                         RIGHT : IN STACK) RETURN BOOLEAN ;
+ 
+      PRIVATE
+ 
+           PACKAGE NEW_LIST_CLASS IS NEW
+                CC3019C0_LIST_CLASS (ELEMENT => ELEMENT,
+                                     ASSIGN  => ASSIGN,
+                                     "="     => "=") ;
+ 
+           TYPE STACK IS NEW NEW_LIST_CLASS.LIST ;
+ 
+      END STACK_CLASS ;
+ 
+ PRIVATE
+ 
+      TYPE NESTED_GENERICS_TYPE IS RECORD
+           FIRST    : ELEMENT ;
+           SECOND   : NATURAL ;
+      END RECORD ;
+ 
+ END CC3019C1_NESTED_GENERICS ;
+ 
+ PACKAGE BODY CC3019C1_NESTED_GENERICS IS
+ 
+      PROCEDURE COPY (SOURCE        : IN OUT NESTED_GENERICS_TYPE ;
+                      DESTINATION   : IN OUT NESTED_GENERICS_TYPE) IS
+ 
+      BEGIN  -- COPY
+ 
+           ASSIGN (SOURCE        => SOURCE.FIRST,
+                   DESTINATION   => DESTINATION.FIRST) ;
+ 
+           DESTINATION.SECOND := SOURCE.SECOND ;
+ 
+      END COPY ;
+ 
+      PROCEDURE SET_ELEMENT
+           (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+           TO_THIS_ELEMENT     : IN OUT ELEMENT) IS
+ 
+      BEGIN  -- SET_ELEMENT
+ 
+           ASSIGN (SOURCE        => TO_THIS_ELEMENT,
+                   DESTINATION   => FOR_THIS_NGT_OBJECT.FIRST) ;
+ 
+      END SET_ELEMENT ;
+ 
+      PROCEDURE SET_NUMBER
+           (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+           TO_THIS_NUMBER      : IN NATURAL) IS
+ 
+      BEGIN  -- SET_NUMBER
+ 
+           FOR_THIS_NGT_OBJECT.SECOND := TO_THIS_NUMBER ;
+ 
+      END SET_NUMBER ;
+ 
+      FUNCTION "=" (LEFT  : IN NESTED_GENERICS_TYPE ;
+                    RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN IS
+ 
+      BEGIN  -- "="
+ 
+           IF (LEFT.FIRST = RIGHT.FIRST) AND
+              (LEFT.SECOND = RIGHT.SECOND) THEN
+                        RETURN TRUE ;
+           ELSE
+                     RETURN FALSE ;
+           END IF ;
+ 
+      END "=" ;
+ 
+      FUNCTION ELEMENT_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+           RETURN ELEMENT IS
+ 
+      BEGIN  -- ELEMENT_OF
+ 
+           RETURN THIS_NGT_OBJECT.FIRST ;
+ 
+      END ELEMENT_OF ;
+ 
+      FUNCTION NUMBER_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+           RETURN NATURAL IS
+ 
+      BEGIN  -- NUMBER_OF
+ 
+           RETURN THIS_NGT_OBJECT.SECOND ;
+ 
+      END NUMBER_OF ;
+ 
+      PACKAGE BODY GENERIC_TASK IS
+ 
+           TASK BODY PROTECTED_AREA IS
+ 
+                LOCAL_STORE : ELEMENT ;
+ 
+           BEGIN  -- PROTECTED_AREA
+ 
+                LOOP
+                     SELECT
+                          ACCEPT STORE (ITEM    : IN OUT ELEMENT) DO
+                               ASSIGN (SOURCE        => ITEM,
+                                       DESTINATION   => LOCAL_STORE) ;
+                          END STORE ;
+                     OR
+                          ACCEPT GET   (ITEM    : IN OUT ELEMENT) DO
+                               ASSIGN (SOURCE        => LOCAL_STORE,
+                                       DESTINATION   => ITEM) ;
+                          END GET ;
+                     OR
+                          TERMINATE ;
+                     END SELECT ;
+                END LOOP ;
+ 
+           END PROTECTED_AREA ;
+ 
+      END GENERIC_TASK ;
+ 
+      PACKAGE BODY STACK_CLASS IS
+ 
+           PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                           ON_TO_THIS_STACK    : IN OUT STACK) IS
+ 
+           BEGIN  -- PUSH
+ 
+               NEW_LIST_CLASS.ADD (
+                     THIS_ELEMENT    => THIS_ELEMENT,
+                     TO_THIS_LIST    =>
+                          NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ;
+ 
+           EXCEPTION
+ 
+               WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ;
+ 
+           END PUSH ;
+ 
+           PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                           OFF_THIS_STACK      : IN OUT STACK) IS
+ 
+           BEGIN  -- POP
+ 
+                NEW_LIST_CLASS.DELETE (
+                     THIS_ELEMENT     => THIS_ELEMENT,
+                     FROM_THIS_LIST   =>
+                         NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ;
+ 
+           EXCEPTION
+ 
+                     WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ;
+ 
+           END POP ;
+ 
+           PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
+                            TO_THIS_STACK    : IN OUT STACK) IS
+ 
+           BEGIN  -- COPY
+ 
+               NEW_LIST_CLASS.COPY (
+                     THIS_LIST    => NEW_LIST_CLASS.LIST (THIS_STACK),
+                     TO_THIS_LIST =>
+                          NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ;
+ 
+           END COPY ;
+ 
+           PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) IS
+ 
+           BEGIN  -- CLEAR
+ 
+                NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ;
+ 
+           END CLEAR ;
+ 
+           PROCEDURE ITERATE (OVER_THIS_STACK  : IN STACK) IS
+ 
+                PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE
+                                         (PROCESS => PROCESS) ;
+ 
+           BEGIN  -- ITERATE
+ 
+                STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ;
+ 
+           END ITERATE ;
+ 
+           FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+                     RETURN NATURAL IS
+ 
+           BEGIN  -- NUMBER_OF_ELEMENTS
+ 
+                RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS
+                     (IN_THIS_LIST =>
+                          NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ;
+ 
+           END NUMBER_OF_ELEMENTS ;
+ 
+           FUNCTION "=" (LEFT  : IN STACK ;
+                         RIGHT : IN STACK) RETURN BOOLEAN IS
+ 
+           BEGIN  -- "="
+ 
+                RETURN NEW_LIST_CLASS."=" (
+                     LEFT  => NEW_LIST_CLASS.LIST (LEFT),
+                    RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ;
+ 
+           END "=" ;
+ 
+      END STACK_CLASS ;
+ 
+ END CC3019C1_NESTED_GENERICS ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019c2.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019c2.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3019c2.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3019c2.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,457 ----
+ -- CC3019C2M.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --   CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G.
+ --   TO SUPPORT ITERATORS.
+ 
+ --  THIS TEST SPECIFICALLY CHECKS THAT A
+ --  NESTING LEVEL OF 3 IS SUPPORTED FOR GENERICS:
+ --       INSTANTIATE CC3019C1_NESTED_GENERICS IN THE MAIN
+ --       PROCEDURE, THE INSTANTIATION OF CC3019C0_LIST_CLASS
+ --       IN GENERIC PACKAGE CC3019C1_NESTED_GENERICS, AND
+ --       THE INSTANTIATION OF NEW_LIST_CLASS.ITERATE IN
+ --       PROCEDURE ITERATE IN PACKAGE BODY STACK_CLASS.
+ --
+ --  *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE
+ --  *** SOURCE CODE IN FILES CC3019C0.ADA AND CC3019C1.ADA HAVE
+ --  *** BEEN COMPILED.
+ --
+ -- HISTORY:
+ --         EDWARD V. BERARD, 31 AUGUST 1990
+ 
+ WITH REPORT ;
+ WITH CC3019C1_NESTED_GENERICS ;
+ 
+ PROCEDURE CC3019C2M IS
+ 
+      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                          SEP, OCT, NOV, DEC) ;
+      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+      TYPE DATE IS RECORD
+           MONTH : MONTH_TYPE ;
+           DAY   : DAY_TYPE ;
+           YEAR  : YEAR_TYPE ;
+      END RECORD ;
+ 
+      STORE_DATE   : DATE ;
+ 
+      TODAY        : DATE := (MONTH => AUG,
+                              DAY   => 31,
+                              YEAR  => 1990) ;
+ 
+      FIRST_DATE   : DATE := (MONTH => JUN,
+                              DAY   => 4,
+                              YEAR  => 1967) ;
+ 
+      BIRTH_DATE   : DATE := (MONTH => OCT,
+                              DAY   => 3,
+                              YEAR  => 1949) ;
+ 
+      WALL_DATE    : DATE := (MONTH => NOV,
+                              DAY   => 9,
+                              YEAR  => 1989) ;
+ 
+      TYPE SEX IS (MALE, FEMALE) ;
+ 
+      TYPE PERSON IS RECORD
+           BIRTH_DATE : DATE ;
+           GENDER     : SEX ;
+           NAME       : STRING (1 .. 10) ;
+      END RECORD ;
+ 
+      FIRST_PERSON  : PERSON ;
+      SECOND_PERSON : PERSON ;
+ 
+      MYSELF      : PERSON := (BIRTH_DATE => BIRTH_DATE,
+                               GENDER     => MALE,
+                               NAME        => "ED        ") ;
+ 
+      FRIEND      : PERSON := (BIRTH_DATE => DATE'(DEC, 27, 1949),
+                               GENDER     => MALE,
+                               NAME        => "DENNIS    ") ;
+ 
+      FATHER      : PERSON := (BIRTH_DATE => DATE'(JUL, 5, 1925),
+                               GENDER     => MALE,
+                               NAME        => "EDWARD    ") ;
+ 
+      DAUGHTER    : PERSON := (BIRTH_DATE => DATE'(DEC, 10, 1980),
+                               GENDER     => FEMALE,
+                               NAME       => "CHRISSY   ") ;
+ 
+      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                        TO_THIS_DATE              : IN OUT DATE) ;
+ 
+      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                         RIGHT : IN DATE) RETURN BOOLEAN ;
+ 
+      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON  : IN OUT PERSON ;
+                        TO_THIS_PERSON            : IN OUT PERSON) ;
+ 
+      FUNCTION IS_EQUAL (LEFT  : IN PERSON ;
+                         RIGHT : IN PERSON) RETURN BOOLEAN ;
+ 
+ --  INSTANTIATE OUTER GENERIC PACKAGE
+ 
+      PACKAGE NEW_NESTED_GENERICS IS NEW
+           CC3019C1_NESTED_GENERICS (ELEMENT => DATE,
+                                     ASSIGN  => ASSIGN,
+                                     "="     => IS_EQUAL) ;
+ 
+      FIRST_NNG  : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
+      SECOND_NNG : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
+ 
+      FUNCTION "=" (LEFT  : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
+                    RIGHT : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE)
+                    RETURN BOOLEAN RENAMES NEW_NESTED_GENERICS."=" ;
+ 
+ --  INSTANTIATE NESTED TASK PACKAGE
+ 
+      PACKAGE NEW_GENERIC_TASK IS NEW
+           NEW_NESTED_GENERICS.GENERIC_TASK (ELEMENT => PERSON,
+                                             ASSIGN  => ASSIGN) ;
+ 
+      FIRST_GENERIC_TASK  : NEW_GENERIC_TASK.PROTECTED_AREA ;
+      SECOND_GENERIC_TASK : NEW_GENERIC_TASK.PROTECTED_AREA ;
+ 
+ --  INSTANTIATE NESTED STACK PACKAGE
+ 
+      PACKAGE PERSON_STACK IS NEW
+           NEW_NESTED_GENERICS.STACK_CLASS (ELEMENT => PERSON,
+                                            ASSIGN  => ASSIGN,
+                                            "="     => IS_EQUAL) ;
+ 
+      FIRST_PERSON_STACK  : PERSON_STACK.STACK ;
+      SECOND_PERSON_STACK : PERSON_STACK.STACK ;
+      THIRD_PERSON_STACK  : PERSON_STACK.STACK ;
+ 
+      FUNCTION "=" (LEFT  : IN PERSON_STACK.STACK ;
+                    RIGHT : IN PERSON_STACK.STACK) RETURN BOOLEAN
+               RENAMES PERSON_STACK."=" ;
+ 
+      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                        TO_THIS_DATE              : IN OUT DATE) IS
+ 
+      BEGIN -- ASSIGN
+ 
+           TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
+ 
+      END ASSIGN ;
+ 
+      FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                         RIGHT : IN DATE) RETURN BOOLEAN IS
+ 
+      BEGIN -- IS_EQUAL
+ 
+           IF (LEFT.MONTH = RIGHT.MONTH) AND (LEFT.DAY = RIGHT.DAY)
+              AND (LEFT.YEAR = RIGHT.YEAR) THEN
+                RETURN TRUE ;
+           ELSE
+                RETURN FALSE ;
+           END IF ;
+ 
+      END IS_EQUAL ;
+ 
+      PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON  : IN OUT PERSON ;
+                        TO_THIS_PERSON            : IN OUT PERSON) IS
+ 
+      BEGIN -- ASSIGN
+ 
+           TO_THIS_PERSON := THE_VALUE_OF_THIS_PERSON ;
+ 
+      END ASSIGN ;
+ 
+      FUNCTION IS_EQUAL (LEFT  : IN PERSON ;
+                         RIGHT : IN PERSON) RETURN BOOLEAN IS
+ 
+      BEGIN -- IS_EQUAL
+ 
+           IF (LEFT.BIRTH_DATE = RIGHT.BIRTH_DATE) AND
+              (LEFT.GENDER = RIGHT.GENDER) AND
+              (LEFT.NAME = RIGHT.NAME) THEN
+                RETURN TRUE ;
+           ELSE
+                RETURN FALSE ;
+           END IF ;
+ 
+      END IS_EQUAL ;
+ 
+ BEGIN  -- CC3019C2M
+ 
+      REPORT.TEST ("CC3019C2M",
+                   "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " &
+                   "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " &
+                   "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF 3 " &
+                   "IS SUPPORTED FOR GENERICS.") ;
+ 
+ -- CHECK THE OUTERMOST GENERIC (NEW_NESTED_GENERICS)
+ 
+      NEW_NESTED_GENERICS.SET_ELEMENT (
+           FOR_THIS_NGT_OBJECT => FIRST_NNG,
+           TO_THIS_ELEMENT     => TODAY) ;
+      NEW_NESTED_GENERICS.SET_NUMBER (
+           FOR_THIS_NGT_OBJECT => FIRST_NNG,
+           TO_THIS_NUMBER      => 1) ;
+ 
+      NEW_NESTED_GENERICS.SET_ELEMENT (
+           FOR_THIS_NGT_OBJECT => SECOND_NNG,
+           TO_THIS_ELEMENT     => FIRST_DATE) ;
+      NEW_NESTED_GENERICS.SET_NUMBER  (
+           FOR_THIS_NGT_OBJECT => SECOND_NNG,
+           TO_THIS_NUMBER      => 2) ;
+ 
+      IF FIRST_NNG = SECOND_NNG THEN
+           REPORT.FAILED ("PROBLEMS WITH TESTING EQUALITY FOR " &
+                          "OUTERMOST GENERIC") ;
+      END IF ;
+ 
+      IF (NEW_NESTED_GENERICS.ELEMENT_OF (THIS_NGT_OBJECT => FIRST_NNG)
+              /= TODAY) OR
+         (NEW_NESTED_GENERICS.ELEMENT_OF (
+                 THIS_NGT_OBJECT => SECOND_NNG)
+              /= FIRST_DATE) THEN
+              REPORT.FAILED ("PROBLEMS WITH EXTRACTING ELEMENTS IN " &
+                             "OUTERMOST GENERIC") ;
+      END IF ;
+ 
+      IF (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => FIRST_NNG)
+              /= 1) OR
+         (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => SECOND_NNG)
+              /= 2) THEN
+              REPORT.FAILED ("PROBLEMS WITH EXTRACTING NUMBERS IN " &
+                              "OUTERMOST GENERIC") ;
+      END IF ;
+ 
+      NEW_NESTED_GENERICS.COPY (SOURCE        => FIRST_NNG,
+                                DESTINATION    => SECOND_NNG) ;
+ 
+      IF FIRST_NNG /= SECOND_NNG THEN
+           REPORT.FAILED ("PROBLEMS WITH COPYING OR TESTING EQUALITY " &
+                          "IN OUTERMOST GENERIC") ;
+      END IF ;
+ 
+ -- CHECK THE FIRST NESTED GENERIC (GENERIC_TASK)
+ 
+      FIRST_GENERIC_TASK.STORE  (ITEM => MYSELF) ;
+      SECOND_GENERIC_TASK.STORE (ITEM => FRIEND) ;
+ 
+      FIRST_GENERIC_TASK.GET  (ITEM => FIRST_PERSON) ;
+      SECOND_GENERIC_TASK.GET (ITEM => SECOND_PERSON) ;
+ 
+      IF (FIRST_PERSON /= MYSELF) OR (SECOND_PERSON /= FRIEND) THEN
+           REPORT.FAILED ("PROBLEMS WITH NESTED TASK GENERIC") ;
+      END IF ;
+ 
+ -- CHECK THE SECOND NESTED GENERIC (STACK_CLASS)
+ 
+      PERSON_STACK.CLEAR (THIS_STACK => FIRST_PERSON_STACK) ;
+      IF PERSON_STACK.NUMBER_OF_ELEMENTS
+         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 0 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
+      END IF ;
+ 
+      PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
+                             ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
+      IF PERSON_STACK.NUMBER_OF_ELEMENTS
+         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 1 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
+      END IF ;
+ 
+      PERSON_STACK.PUSH (THIS_ELEMENT     => FRIEND,
+                             ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
+      IF PERSON_STACK.NUMBER_OF_ELEMENTS
+         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
+      END IF ;
+ 
+      PERSON_STACK.PUSH (THIS_ELEMENT     => FATHER,
+                             ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
+      IF PERSON_STACK.NUMBER_OF_ELEMENTS
+         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 3 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
+      END IF ;
+ 
+      PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
+                            OFF_THIS_STACK => FIRST_PERSON_STACK) ;
+      IF PERSON_STACK.NUMBER_OF_ELEMENTS
+         (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
+      END IF ;
+ 
+      IF FIRST_PERSON /= FATHER THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE REMOVED FROM STACK - 1") ;
+      END IF ;
+ 
+      PERSON_STACK.CLEAR (THIS_STACK => SECOND_PERSON_STACK) ;
+      IF PERSON_STACK.NUMBER_OF_ELEMENTS
+         (ON_THIS_STACK => SECOND_PERSON_STACK) /= 0 THEN
+           REPORT.FAILED (
+                "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
+      END IF ;
+ 
+      PERSON_STACK.COPY (THIS_STACK    => FIRST_PERSON_STACK,
+                             TO_THIS_STACK => SECOND_PERSON_STACK) ;
+ 
+      IF FIRST_PERSON_STACK /= SECOND_PERSON_STACK THEN
+           REPORT.FAILED (
+                "PROBLEMS WITH COPY OR TEST FOR EQUALITY (STACK)") ;
+      END IF ;
+ 
+      PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
+                        OFF_THIS_STACK => SECOND_PERSON_STACK) ;
+      PERSON_STACK.PUSH (THIS_ELEMENT     => DAUGHTER,
+                         ON_TO_THIS_STACK => SECOND_PERSON_STACK) ;
+      IF FIRST_PERSON_STACK = SECOND_PERSON_STACK THEN
+           REPORT.FAILED (
+                "PROBLEMS WITH POP OR TEST FOR EQUALITY (STACK)") ;
+      END IF ;
+ 
+      UNDERFLOW_EXCEPTION_TEST:
+ 
+      BEGIN  -- UNDERFLOW_EXCEPTION_TEST
+ 
+           PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
+           PERSON_STACK.POP (THIS_ELEMENT    => FIRST_PERSON,
+                             OFF_THIS_STACK  => THIRD_PERSON_STACK) ;
+           REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;
+ 
+      EXCEPTION
+ 
+           WHEN PERSON_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                                  -- RAISED
+           WHEN OTHERS =>
+                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                               "UNDERFLOW EXCEPTION TEST") ;
+ 
+      END UNDERFLOW_EXCEPTION_TEST ;
+ 
+      OVERFLOW_EXCEPTION_TEST:
+ 
+      BEGIN  -- OVERFLOW_EXCEPTION_TEST
+ 
+           PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
+           FOR INDEX IN 1 .. 10 LOOP
+                PERSON_STACK.PUSH (
+                     THIS_ELEMENT     => MYSELF,
+                     ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
+           END LOOP ;
+ 
+           PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
+                              ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
+           REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;
+ 
+      EXCEPTION
+ 
+           WHEN PERSON_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                                 -- RAISED
+           WHEN OTHERS =>
+                REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                               "OVERFLOW EXCEPTION TEST") ;
+ 
+      END OVERFLOW_EXCEPTION_TEST ;
+ 
+      LOCAL_BLOCK:
+ 
+      DECLARE
+ 
+           TYPE PERSON_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF PERSON;
+ 
+           FIRST_PERSON_TABLE : PERSON_TABLE ;
+ 
+           TABLE_INDEX : POSITIVE := 1 ;
+ 
+           PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
+                                    CONTINUE    : OUT BOOLEAN) ;
+ 
+           PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
+                                  CONTINUE     : OUT BOOLEAN) ;
+ 
+           PROCEDURE GATHER_PERSON_ITERATE IS NEW
+                PERSON_STACK.ITERATE (PROCESS => GATHER_PEOPLE) ;
+ 
+           PROCEDURE SHOW_PERSON_ITERATE IS NEW
+                PERSON_STACK.ITERATE (PROCESS => SHOW_PEOPLE) ;
+ 
+           PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
+                                    CONTINUE    : OUT BOOLEAN) IS
+           BEGIN  -- GATHER_PEOPLE
+ 
+                FIRST_PERSON_TABLE (TABLE_INDEX) := THIS_PERSON ;
+                TABLE_INDEX := TABLE_INDEX + 1 ;
+ 
+                CONTINUE := TRUE ;
+ 
+           END GATHER_PEOPLE ;
+ 
+           PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
+                                  CONTINUE     : OUT BOOLEAN) IS
+ 
+           BEGIN  -- SHOW_PEOPLE
+ 
+                REPORT.COMMENT ("THE BIRTH MONTH IS " &
+                     MONTH_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.MONTH)) ;
+                REPORT.COMMENT ("THE BIRTH DAY IS " &
+                     DAY_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.DAY)) ;
+                REPORT.COMMENT ("THE BIRTH YEAR IS " &
+                     YEAR_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.YEAR)) ;
+                REPORT.COMMENT ("THE GENDER IS " &
+                     SEX'IMAGE (THIS_PERSON.GENDER)) ;
+                REPORT.COMMENT ("THE NAME IS " & THIS_PERSON.NAME) ;
+ 
+                CONTINUE := TRUE ;
+ 
+           END SHOW_PEOPLE ;
+ 
+      BEGIN  -- LOCAL_BLOCK
+ 
+           REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
+           SHOW_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK) ;
+ 
+           REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
+           SHOW_PERSON_ITERATE (OVER_THIS_STACK => SECOND_PERSON_STACK) ;
+ 
+           GATHER_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK);
+           IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
+              (FIRST_PERSON_TABLE (2) /= FRIEND) THEN
+                REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
+           END IF ;
+ 
+           TABLE_INDEX := 1 ;
+           GATHER_PERSON_ITERATE(OVER_THIS_STACK => SECOND_PERSON_STACK);
+           IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
+              (FIRST_PERSON_TABLE (2) /= DAUGHTER) THEN
+                REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
+           END IF ;
+ 
+      END LOCAL_BLOCK ;
+ 
+      REPORT.RESULT ;
+ 
+ END CC3019C2M ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3106b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3106b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3106b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3106b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,207 ----
+ -- CC3106B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --     CHECK THAT THE FORMAL PARAMETER DENOTES THE ACTUAL
+ --     IN AN INSTANTIATION.
+ 
+ -- HISTORY:
+ --     LDC 06/20/88  CREATED ORIGINAL TEST
+ --     EDWARD V. BERARD, 10 AUGUST 1990  ADDED CHECKS FOR MULTI-
+ --                                       DIMENSIONAL ARRAYS
+ 
+ WITH REPORT ;
+ 
+ PROCEDURE CC3106B IS
+ 
+ BEGIN  -- CC3106B
+ 
+     REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &
+                 "THE ACTUAL IN AN INSTANTIATION");
+ 
+     LOCAL_BLOCK:
+     
+     DECLARE
+     
+         SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;
+         TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;
+         PRAGMA PACK(PCK_BOL) ;
+           
+         SHORT_START : CONSTANT := -100 ;
+         SHORT_END   : CONSTANT := 100 ;
+         TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+     
+         SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
+     
+         TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                             SEP, OCT, NOV, DEC) ;
+                         
+         SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
+     
+         TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+         TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+         TYPE DATE IS RECORD
+             MONTH : MONTH_TYPE ;
+             DAY   : DAY_TYPE ;
+             YEAR  : YEAR_TYPE ;
+         END RECORD ;
+     
+         TODAY         : DATE := (MONTH => AUG,
+                                  DAY   => 8,
+                                  YEAR  => 1990) ;
+                             
+         FIRST_DATE    : DATE := (DAY   => 6,
+                                  MONTH => JUN,
+                                  YEAR  => 1967) ;
+                             
+         WALL_DATE     : DATE := (MONTH => NOV,
+                                  DAY   => 9,
+                                  YEAR  => 1989) ;
+                             
+         SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
+                             
+         TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
+                                          FIRST_HALF,
+                                          FIRST_FIVE) OF DATE ;
+                                      
+         TD_ARRAY : THREE_DIMENSIONAL := (THREE_DIMENSIONAL'RANGE =>
+                                         (THREE_DIMENSIONAL'RANGE (2) =>
+                                         (THREE_DIMENSIONAL'RANGE (3) =>
+                                           TODAY))) ;
+ 
+         TASK TYPE TSK IS
+             ENTRY ENT_1;
+             ENTRY ENT_2;
+             ENTRY ENT_3;
+         END TSK;
+ 
+         GENERIC
+           
+             TYPE GEN_TYPE IS (<>);
+             GEN_BOLARR         : IN OUT PCK_BOL;
+             GEN_TYP            : IN OUT GEN_TYPE;
+             GEN_TSK            : IN OUT TSK;
+             TEST_VALUE         : IN DATE ;
+             TEST_CUBE          : IN OUT THREE_DIMENSIONAL ;
+ 
+         PACKAGE P IS
+                PROCEDURE GEN_PROC1 ;
+                PROCEDURE GEN_PROC2 ;
+                PROCEDURE GEN_PROC3 ;
+                PROCEDURE ARRAY_TEST ;
+         END P;
+ 
+         ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);
+         SI         : SM_INT := 0 ;
+         T          : TSK;
+ 
+         PACKAGE BODY P IS
+         
+             PROCEDURE GEN_PROC1 IS
+             BEGIN  -- GEN_PROC1
+                 GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);
+                 GEN_TYP := GEN_TYPE'VAL(4);
+                 IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)
+                    THEN
+                     REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
+                                   "INSTANTIATED VALUES");
+                 END IF;
+             END GEN_PROC1;
+ 
+             PROCEDURE GEN_PROC2 IS
+             BEGIN  -- GEN_PROC2
+                 IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR
+                       GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN
+                     REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
+                                   "VALUES ASSIGNED IN THE MAIN " &
+                                   "PROCEDURE");
+                 END IF;
+                 GEN_BOLARR(18) := TRUE;
+                 GEN_TYP := GEN_TYPE'VAL(9);
+             END GEN_PROC2;
+ 
+             PROCEDURE GEN_PROC3 IS
+             BEGIN  -- GEN_PROC3
+                 GEN_TSK.ENT_2;
+             END GEN_PROC3 ;
+                
+             PROCEDURE ARRAY_TEST IS            
+             BEGIN  -- ARRAY_TEST
+                
+                 TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;
+                            
+                 IF (TD_ARRAY (0, JUN, 'C')  /= TEST_VALUE) OR
+                       (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN
+                     REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &
+                                    "DIFFERENT THAN THE VALUES ASSIGNED " &
+                                    "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;
+                 END IF ;
+                 
+             END ARRAY_TEST ;
+             
+         END P ;
+ 
+         TASK BODY TSK IS
+         BEGIN  -- TSK
+             ACCEPT ENT_1 DO
+                 REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");
+             END;
+             ACCEPT ENT_2 DO
+                 REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");
+             END;
+             ACCEPT ENT_3 DO
+                 REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");
+             END;
+         END TSK;
+ 
+         PACKAGE INSTA1 IS NEW P (GEN_TYPE       => SM_INT,
+                                  GEN_BOLARR     => ACT_BOLARR,
+                                  GEN_TYP        => SI,
+                                  GEN_TSK        => T,
+                                  TEST_VALUE     => FIRST_DATE,
+                                  TEST_CUBE      => TD_ARRAY) ;
+                              
+     BEGIN  -- LOCAL_BLOCK
+     
+         INSTA1.GEN_PROC1;
+         ACT_BOLARR(9) := TRUE;
+         SI := 2;
+         INSTA1.GEN_PROC2;
+         IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR
+               SI /= REPORT.IDENT_INT(9) THEN
+             REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &
+                           "ASSIGNED IN THE GENERIC PROCEDURE");
+         END IF;
+ 
+         T.ENT_1;
+         INSTA1.GEN_PROC3;
+         T.ENT_3;
+           
+         TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;
+         INSTA1.ARRAY_TEST ;
+ 
+      END LOCAL_BLOCK;
+ 
+      REPORT.RESULT;
+ 
+ END CC3106B ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3120a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3120a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3120a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3120a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,180 ----
+ -- CC3120A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT GENERIC IN PARAMETERS ARE ALWAYS COPIED, AND THAT
+ -- GENERIC IN OUT PARAMETERS ARE ALWAYS RENAMED.
+ 
+ -- DAT 8/10/81
+ -- SPS 10/21/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3120A IS
+ BEGIN
+      TEST ("CC3120A", "GENERIC IN PARMS ARE COPIED, GENERIC IN OUT"
+           & " PARMS ARE RENAMED");
+ 
+      DECLARE
+           S1, S2 : INTEGER;
+           A1, A2, A3 : STRING (1 .. IDENT_INT (3));
+ 
+           TYPE REC IS RECORD
+                C1, C2 : INTEGER := 1;
+           END RECORD;
+ 
+           R1, R2 : REC;
+ 
+           PACKAGE P IS
+                TYPE PRIV IS PRIVATE;
+                PROCEDURE SET_PRIV (P : IN OUT PRIV);
+           PRIVATE
+                TYPE PRIV IS NEW REC;
+           END P;
+           USE P;
+ 
+           P1, P2 : PRIV;
+           EX : EXCEPTION;
+ 
+           GENERIC
+                TYPE T IS PRIVATE;
+                P1 : IN OUT T;
+                P2 : IN T;
+           PROCEDURE GP;
+ 
+           B_ARR : ARRAY (1..10) OF BOOLEAN;
+ 
+           PACKAGE BODY P IS
+                PROCEDURE SET_PRIV (P : IN OUT PRIV) IS
+                BEGIN
+                     P.C1 := 3;
+                END SET_PRIV;
+           END P;
+ 
+           PROCEDURE GP IS
+           BEGIN
+                IF P1 = P2 THEN
+                     FAILED ("PARAMETER SCREW_UP SOMEWHERE");
+                END IF;
+                P1 := P2;
+                IF P1 /= P2 THEN
+                     FAILED ("ASSIGNMENT SCREW_UP SOMEWHERE");
+                END IF;
+                RAISE EX;
+                FAILED ("RAISE STATEMENT DOESN'T WORK");
+           END GP;
+      BEGIN
+           S1 := 4;
+           S2 := 5;
+           A1 := "XYZ";
+           A2 := "ABC";
+           A3 := "DEF";
+           R1.C1 := 4;
+           R2.C1 := 5;
+           B_ARR := (1|3|5|7|9 => TRUE, 2|4|6|8|10 => FALSE);
+           SET_PRIV (P2);
+ 
+           IF S1 = S2
+           OR A1 = A3
+           OR R1 = R2
+           OR P1 = P2 THEN
+                FAILED ("WRONG ASSIGNMENT");
+           END IF;
+           BEGIN
+                DECLARE
+                     PROCEDURE PR IS NEW GP (INTEGER, S1, S2);
+                BEGIN
+                     S2 := S1;
+                     PR;       -- OLD S2 ASSIGNED TO S1, SO S1 /= S2 NOW
+                     FAILED ("EX NOT RAISED 1");
+                EXCEPTION
+                     WHEN EX => NULL;
+                END;
+ 
+                DECLARE
+                     SUBTYPE STR_1_3 IS STRING (IDENT_INT (1)..3);
+                     PROCEDURE PR IS NEW GP (STR_1_3, A1, A3);
+                BEGIN
+                     A3 := A1;
+                     PR;
+                     FAILED ("EX NOT RAISED 2");
+                EXCEPTION
+                     WHEN EX => NULL;
+                END;
+ 
+                DECLARE
+                     PROCEDURE PR IS NEW GP (REC, R1, R2);
+                BEGIN
+                     R2 := R1;
+                     PR;
+                     FAILED ("EX NOT RAISED 3");
+                EXCEPTION
+                     WHEN EX => NULL;
+                END;
+ 
+                DECLARE
+                     PROCEDURE PR IS NEW GP (PRIV, P1, P2);
+                BEGIN
+                     P2 := P1;
+                     PR;
+                     FAILED ("EX NOT RAISED 4");
+                EXCEPTION
+                     WHEN EX => NULL;
+                END;
+                DECLARE
+                     PROCEDURE PR IS NEW GP (CHARACTER,
+                                             A3(IDENT_INT(2)),
+                                             A3(IDENT_INT(3)));
+                BEGIN
+                     A3(3) := A3(2);
+                     PR;
+                     FAILED ("EX NOT RAISED 5");
+                EXCEPTION
+                     WHEN EX => NULL;
+                END;
+ 
+                DECLARE
+                     PROCEDURE PR IS NEW GP (BOOLEAN,
+                                             B_ARR(IDENT_INT(2)),
+                                             B_ARR(IDENT_INT(3)));
+                BEGIN
+                     B_ARR(3) := B_ARR(2);
+                     PR;
+                     FAILED ("EX NOT RAISED 6");
+                EXCEPTION
+                     WHEN EX => NULL;
+                END;
+           END;
+ 
+           IF S1 = S2
+           OR A1 = A2
+           OR R1 = R2
+           OR P1 = P2
+           OR A3(2) = A3(3) 
+           OR B_ARR(2) = B_ARR(3) THEN
+                FAILED ("ASSIGNMENT FAILED 2");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3120A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3120b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3120b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3120b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3120b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- CC3120B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT TASKS ARE NOT COPIED AS GENERIC IN OUT PARMS.
+ 
+ -- DAT 8/27/81
+ -- SPS 4/6/82
+ -- JBG 3/23/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3120B IS
+ BEGIN
+      TEST ("CC3120B", "TASKS ARE NOT COPIED AS GENERIC PARAMETERS");
+ 
+      DECLARE
+           PACKAGE P IS
+                TYPE T IS LIMITED PRIVATE;
+                PROCEDURE UPDT (TPARM: IN T; I : IN OUT INTEGER);
+           PRIVATE
+                TASK TYPE T1 IS
+                     ENTRY GET (I : OUT INTEGER);
+                     ENTRY PUT (I : IN INTEGER);
+                END T1;
+                TYPE T IS RECORD
+                     C : T1;
+                END RECORD;
+           END P;
+           USE P;
+           TT : T;
+           GENERIC
+                TYPE T IS LIMITED PRIVATE;
+                T1 : IN OUT T;
+                WITH PROCEDURE UPDT (TPARM : IN T; I: IN OUT INTEGER)
+                     IS <> ;
+           PROCEDURE PR;
+ 
+           PROCEDURE PR IS
+                I : INTEGER;
+           BEGIN
+                I := 5;
+                                         -- PR.I
+                                         -- UPDT.I      UPDT.T1.I
+                                         --   5            4
+                UPDT (T1, I); 
+                                         --   4            5
+                IF I /= 4 THEN
+                     FAILED ("BAD VALUE 1");
+                END IF;
+                I := 6;
+                                         --   6            5
+                UPDT (T1, I);
+                                         --   5            6
+                IF I /= 5 THEN
+                     FAILED ("BAD VALUE 3");
+                END IF;
+                RAISE TASKING_ERROR;
+                FAILED ("INCORRECT RAISE STATEMENT");
+           END PR;
+ 
+           PACKAGE BODY P IS
+                PROCEDURE UPDT (TPARM : IN T; I : IN OUT INTEGER) IS
+                     V : INTEGER := I;
+                     -- UPDT.I => V
+                     -- T1.I => UPDT.I
+                     -- V => T1.I
+                BEGIN
+                     TPARM.C.GET (I);
+                     TPARM.C.PUT (V);
+                END UPDT;
+ 
+                TASK BODY T1 IS
+                     I : INTEGER;
+                BEGIN
+                     I := 1;
+                     LOOP
+                          SELECT
+                               ACCEPT GET (I : OUT INTEGER) DO
+                                    I := T1.I;
+                               END GET;
+                          OR
+                               ACCEPT PUT (I : IN INTEGER) DO
+                                    T1.I := I;
+                               END PUT;
+                          OR
+                               TERMINATE;
+                          END SELECT;
+                     END LOOP;
+                END T1;
+           END P;
+      BEGIN
+           DECLARE
+                X : INTEGER := 2;
+                PROCEDURE PPP IS NEW PR (T, TT);
+           BEGIN
+                                         -- X
+                                         -- UPDT.I      UPDT.T1.I
+                                         --   2            1
+                UPDT (TT, X);
+                                         --   1            2
+                X := X + 3;
+                                         --   4            2
+                UPDT (TT, X);
+                                         --   2            4
+                IF X /= 2 THEN 
+                     FAILED ("WRONG VALUE FOR X");
+                END IF;
+                BEGIN
+                     PPP;
+                     FAILED ("PPP NOT CALLED");
+                EXCEPTION
+                     WHEN TASKING_ERROR => NULL;
+                END;
+                X := 12;
+                                         --   12           6
+                UPDT (TT, X);
+                                         --   6            12
+                IF X /= 6 THEN
+                     FAILED ("WRONG FINAL VALUE IN TASK");
+                END IF;
+           END;
+      END;
+ 
+      RESULT;
+ END CC3120B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3121a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3121a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3121a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3121a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- CC3121A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN UNCONSTRAINED FORMAL GENERIC PARAMETER OF MODE "IN"
+ -- HAVING AN ARRAY TYPE OR A TYPE WITH DISCRIMINANTS HAS THE CONSTRAINTS
+ -- OF THE ACTUAL PARAMETER.
+ 
+ -- TBN  9/29/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3121A IS
+ 
+      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+ 
+      TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
+ 
+      TYPE REC1 (D : INT) IS
+           RECORD
+                VAR1 : INTEGER := 1;
+           END RECORD;
+ 
+      TYPE REC2 (D : INT := 2) IS
+           RECORD
+                A : ARRAY1 (D .. IDENT_INT(4));
+                B : REC1 (D);
+                C : INTEGER := 1;
+           END RECORD;
+ 
+      TYPE ARRAY2 IS ARRAY (INT RANGE <>) OF REC2;
+ 
+ BEGIN
+      TEST ("CC3121A", "CHECK THAT AN UNCONSTRAINED FORMAL GENERIC " &
+                       "PARAMETER OF MODE 'IN' HAVING AN ARRAY TYPE " &
+                       "OR A TYPE WITH DISCRIMINANTS HAS THE " &
+                       "CONSTRAINTS OF THE ACTUAL PARAMETER");
+ 
+      DECLARE
+           OBJ_ARA1 : ARRAY1 (IDENT_INT(2) .. 5);
+ 
+           GENERIC
+                VAR : ARRAY1;
+           PROCEDURE PROC;
+ 
+           PROCEDURE PROC IS
+           BEGIN
+                IF VAR'FIRST /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FOR VAR'FIRST");
+                END IF;
+                IF VAR'LAST /= IDENT_INT(5) THEN
+                     FAILED ("INCORRECT RESULTS FOR VAR'LAST");
+                END IF;
+           END PROC;
+ 
+           PROCEDURE PROC1 IS NEW PROC (OBJ_ARA1);
+      BEGIN
+           PROC1;
+      END;
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           OBJ_REC2 : REC2;
+ 
+           GENERIC
+                VAR : REC2;
+           FUNCTION FUNC RETURN INTEGER;
+ 
+           FUNCTION FUNC RETURN INTEGER IS
+           BEGIN
+                IF VAR.D /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.D");
+                END IF;
+                IF VAR.A'FIRST /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.A'FIRST");
+                END IF;
+                IF VAR.A'LAST /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.A'LAST");
+                END IF;
+                IF VAR.B.D /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.B.D");
+                END IF;
+                RETURN IDENT_INT(1);
+           END FUNC;
+ 
+           FUNCTION FUNC1 IS NEW FUNC (OBJ_REC2);
+ 
+      BEGIN
+           IF FUNC1 /= IDENT_INT(1) THEN
+                FAILED ("INCORRECT RESULTS FROM FUNC1 CALL");
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           OBJ_ARA2 : ARRAY2 (IDENT_INT(6) .. 8);
+ 
+           GENERIC
+                VAR : ARRAY2;
+           PROCEDURE PROC;
+ 
+           PROCEDURE PROC IS
+           BEGIN
+                IF VAR'FIRST /= IDENT_INT(6) THEN
+                     FAILED ("INCORRECT RESULTS FOR VAR'FIRST");
+                END IF;
+                IF VAR'LAST /= IDENT_INT(8) THEN
+                     FAILED ("INCORRECT RESULTS FOR VAR'LAST");
+                END IF;
+                IF VAR(6).D /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR(6).D");
+                END IF;
+                IF VAR(6).A'FIRST /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR(6).A'FIRST");
+                END IF;
+                IF VAR(6).A'LAST /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR(6).A'LAST");
+                END IF;
+                IF VAR(6).B.D /= IDENT_INT(2) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR(6).B.D");
+                END IF;
+           END PROC;
+ 
+           PROCEDURE PROC2 IS NEW PROC (OBJ_ARA2);
+      BEGIN
+           PROC2;
+      END;
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           OBJ_REC3 : REC2 (3);
+ 
+           GENERIC
+                VAR : REC2;
+           PACKAGE PAC IS
+                PAC_VAR : INTEGER := 1;
+           END PAC;
+ 
+           PACKAGE BODY PAC IS
+           BEGIN
+                IF VAR.D /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.D");
+                END IF;
+                IF VAR.A'FIRST /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.A'FIRST");
+                END IF;
+                IF VAR.A'LAST /= IDENT_INT(4) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.A'LAST");
+                END IF;
+                IF VAR.B.D /= IDENT_INT(3) THEN
+                     FAILED ("INCORRECT RESULTS FROM VAR.B.D");
+                END IF;
+           END PAC;
+ 
+           PACKAGE PAC1 IS NEW PAC (OBJ_REC3);
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      -------------------------------------------------------------------
+ 
+      RESULT;
+ END CC3121A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3123a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3123a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3123a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3123a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,198 ----
+ -- CC3123A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN PARAMETERS ARE ONLY
+ -- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS.
+ 
+ -- TBN  12/01/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3123A IS
+ 
+ BEGIN
+      TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " &
+                       "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " &
+                       "NO ACTUAL PARAMETERS");
+      DECLARE
+           TYPE ENUM IS (I, II, III);
+           OBJ_INT : INTEGER := 1;
+           OBJ_ENUM : ENUM := I;
+ 
+           GENERIC
+                GEN_INT : IN INTEGER := IDENT_INT(2);
+                GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE);
+                GEN_ENUM : IN ENUM := II;
+           PACKAGE P IS
+                PAC_INT : INTEGER := GEN_INT;
+                PAC_BOOL : BOOLEAN := GEN_BOOL;
+                PAC_ENUM : ENUM := GEN_ENUM;
+           END P;
+ 
+           PACKAGE P1 IS NEW P;
+           PACKAGE P2 IS
+                NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM);
+           PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE));
+      BEGIN
+           IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN
+                FAILED ("DEFAULT VALUES WERE NOT EVALUATED");
+           END IF;
+           IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN
+                FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
+                        "- 1");
+           END IF;
+           IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR
+                P3.PAC_ENUM /= II THEN
+                FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
+                        "- 2");
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           OBJ_INT1 : INTEGER := 3;
+ 
+           FUNCTION FUNC (X : INTEGER) RETURN INTEGER;
+ 
+           GENERIC
+                GEN_INT1 : IN INTEGER := FUNC (1);
+                GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1);
+           PROCEDURE PROC;
+ 
+           PROCEDURE PROC IS
+                PROC_INT1 : INTEGER := GEN_INT1;
+                PROC_INT2 : INTEGER := GEN_INT2;
+           BEGIN
+                IF PROC_INT1 /= 3 THEN
+                     FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
+                             "CORRECTLY - 3");
+                END IF;
+                IF PROC_INT2 /= 4 THEN
+                     FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
+                             "CORRECTLY - 4");
+                END IF;
+           END PROC;
+ 
+           FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF X /= IDENT_INT(4) THEN
+                     FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
+                             "CORRECTLY - 5");
+                END IF;
+                RETURN IDENT_INT(X);
+           END FUNC;
+ 
+           PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1);
+ 
+      BEGIN
+           NEW_PROC;
+      END;
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
+           TYPE REC IS
+                RECORD
+                     ANS : BOOLEAN;
+                     ARA : ARA_TYP;
+                END RECORD;
+           TYPE ARA_REC IS ARRAY (1 .. 5) OF REC;
+ 
+           FUNCTION F (X : INTEGER) RETURN INTEGER;
+ 
+           OBJ_REC : REC := (FALSE, (3, 4));
+           OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4)));
+ 
+           GENERIC
+                GEN_OBJ1 : IN ARA_TYP := (F(1), 2);
+                GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1);
+                GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2)));
+           FUNCTION FUNC RETURN INTEGER;
+ 
+           FUNCTION FUNC RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT(1);
+           END FUNC;
+ 
+           FUNCTION F (X : INTEGER) RETURN INTEGER IS
+           BEGIN
+                FAILED ("DEFAULT VALUES WERE EVALUATED - 1");
+                RETURN IDENT_INT(X);
+           END F;
+ 
+           FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA);
+ 
+      BEGIN
+           IF NOT EQUAL (NEW_FUNC, 1) THEN
+                FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1");
+           END IF;
+      END;
+ 
+      -------------------------------------------------------------------
+      DECLARE
+           SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+           TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
+           TYPE COLOR IS (RED, WHITE);
+           TYPE CON_REC (D : INT) IS
+                RECORD
+                     A : COLOR;
+                     B : ARA_TYP;
+                END RECORD;
+           TYPE UNCON_OR_CON_REC (D : INT := 2) IS
+                RECORD
+                     A : COLOR;
+                     B : ARA_TYP;
+                END RECORD;
+           FUNCTION F (X : COLOR) RETURN COLOR;
+ 
+           OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4));
+           OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4));
+           OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4));
+ 
+           GENERIC
+                GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2));
+                GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2));
+                GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON;
+           FUNCTION FUNC RETURN INTEGER;
+ 
+           FUNCTION FUNC RETURN INTEGER IS
+           BEGIN
+                RETURN IDENT_INT(1);
+           END FUNC;
+ 
+           FUNCTION F (X : COLOR) RETURN COLOR IS
+           BEGIN
+                FAILED ("DEFAULT VALUES WERE EVALUATED - 2");
+                RETURN WHITE;
+           END F;
+ 
+           FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2);
+ 
+      BEGIN
+           IF NOT EQUAL (NEW_FUNC, 1) THEN
+                FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3123A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,111 ----
+ -- CC3125A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE OF A 
+ -- GENERIC IN PARAMETER DOES NOT SATISFY ITS SUBTYPE CONSTRAINT.
+ 
+ -- THIS TEST CHECKS PARAMETERS OF A NON-GENERIC TYPE.
+ 
+ -- DAT 8/10/81
+ -- SPS 4/14/82
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3125A IS
+ 
+ BEGIN
+      TEST ("CC3125A","GENERIC PARAMETER DEFAULTS OF " &
+                      "NON-GENERIC TYPE EVALUATED AND CHECKED WHEN " &
+                      "DECLARATION IS INSTANTIATED AND DEFAULT USED");
+ 
+      FOR I IN 1 .. 3 LOOP
+           COMMENT ("LOOP ITERATION");
+           BEGIN
+ 
+                DECLARE
+                     SUBTYPE T IS INTEGER RANGE 1 .. IDENT_INT(1);
+                     SUBTYPE I_1_2 IS INTEGER RANGE
+                          IDENT_INT (1) .. IDENT_INT (2);
+ 
+                     GENERIC
+                          P,Q : T := I_1_2'(I);
+                     PACKAGE PKG IS 
+                          R: T := P;
+                     END PKG;
+ 
+                BEGIN
+ 
+                     BEGIN
+                          DECLARE
+                               PACKAGE P1 IS NEW PKG;
+                          BEGIN
+                               IF I = IDENT_INT(1) THEN
+                                    IF P1.R /= IDENT_INT(1) 
+                                    THEN FAILED ("BAD INITIAL"&
+                                         " VALUE");
+                                    END IF;
+                               ELSIF I = 2 THEN
+                                    FAILED ("SUBTYPE NOT CHECKED AT " &
+                                            "INSTANTIATION");
+                               ELSE
+                                    FAILED ("DEFAULT NOT EVALUATED AT " &
+                                            "INSTANTIATION");
+                               END IF;
+                          EXCEPTION
+                               WHEN OTHERS => FAILED ("WRONG HANDLER");
+                          END;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               CASE I IS
+                                    WHEN 1 =>
+                                         FAILED ("INCORRECT EXCEPTION");
+                                    WHEN 2 =>
+                                         COMMENT ("CONSTRAINT CHECKED" &
+                                              " ON INSTANTIATION");
+                                    WHEN 3 =>
+                                         COMMENT ("DEFAULT EVALUATED " &
+                                              "ON INSTANTIATION");
+                               END CASE;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     CASE I IS
+                          WHEN 1 =>
+                               FAILED ("NO EXCEPTION SHOULD BE RAISED");
+                          WHEN 2 =>
+                               FAILED ("DEFAULT CHECKED AGAINST " &
+                                       "SUBTYPE AT DECLARATION");
+                          WHEN 3 =>
+                               FAILED ("DEFAULT EVALUATED AT " &
+                                       "DECLARATION");
+                     END CASE;
+           END;
+      END LOOP;
+ 
+      RESULT;
+ END CC3125A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- CC3125B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A GENERIC IN PARAMETER
+ -- HAVING AN ENUMERATION TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
+ -- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
+ 
+ -- TBN  12/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3125B IS
+ 
+      TYPE COLOR IS (GREEN, RED, WHITE, BLUE, ORANGE, PINK);
+      SUBTYPE FLAG IS COLOR RANGE RED .. BLUE;
+ 
+      FUNCTION IDENT_COL (X : COLOR) RETURN COLOR IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           END IF;
+           RETURN GREEN;
+      END IDENT_COL;
+ 
+ BEGIN
+      TEST ("CC3125B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                       "GENERIC IN PARAMETER HAVING AN ENUMERATION " &
+                       "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
+                       "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
+                       "FORMAL PARAMETER");
+      DECLARE
+           GENERIC
+                GEN_COL : IN FLAG;
+           PACKAGE P IS
+                PAC_COL : FLAG := GEN_COL;
+           END P;
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE P1 IS NEW P(IDENT_COL(RED));
+                BEGIN
+                     IF P1.PAC_COL /= IDENT_COL(RED) THEN
+                          FAILED ("INCORRECT VALUE PASSED - 1");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE P2 IS NEW P(IDENT_COL(GREEN));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 2");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE P3 IS NEW P(IDENT_COL(PINK));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+           END;
+      END;
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           GENERIC
+                TYPE GEN_TYP IS (<>);
+                GEN_COL : IN GEN_TYP;
+           PACKAGE Q IS
+                PAC_COL : GEN_TYP := GEN_COL;
+           END Q;
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE Q1 IS NEW Q(FLAG, IDENT_COL(BLUE));
+                BEGIN
+                     IF Q1.PAC_COL /= IDENT_COL(BLUE) THEN
+                          FAILED ("INCORRECT VALUE PASSED - 4");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE Q2 IS NEW Q(FLAG, IDENT_COL(GREEN));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE Q3 IS NEW Q(FLAG, IDENT_COL(PINK));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+           END;
+      END;
+ 
+      RESULT;
+ END CC3125B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- CC3125C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A GENERIC IN PARAMETER
+ -- HAVING A FLOATING POINT TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
+ -- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
+ 
+ -- TBN  12/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3125C IS
+ 
+      TYPE FLT IS DIGITS 5 RANGE -10.0 .. 10.0;
+      SUBTYPE FLO IS FLT RANGE -5.0 .. 5.0;
+ 
+      FUNCTION IDENT_FLT (X : FLT) RETURN FLT IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           END IF;
+           RETURN 0.0;
+      END IDENT_FLT;
+ 
+ BEGIN
+      TEST ("CC3125C", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                       "GENERIC IN PARAMETER HAVING A FLOATING POINT " &
+                       "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
+                       "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
+                       "FORMAL PARAMETER");
+      DECLARE
+           GENERIC
+                GEN_FLO : IN FLO;
+           PACKAGE P IS
+                PAC_FLO : FLT := GEN_FLO;
+           END P;
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE P1 IS NEW P(IDENT_FLT(-5.0));
+                BEGIN
+                     IF P1.PAC_FLO /= IDENT_FLT(-5.0) THEN
+                          FAILED ("INCORRECT VALUE PASSED - 1");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE P2 IS NEW P(IDENT_FLT(-5.1));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 2");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE P3 IS NEW P(IDENT_FLT(5.1));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+           END;
+      END;
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           GENERIC
+                TYPE GEN_TYP IS DIGITS <>;
+                GEN_FLO : IN GEN_TYP;
+           PACKAGE Q IS
+                PAC_FLO : GEN_TYP := GEN_FLO;
+           END Q;
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE Q1 IS NEW Q(FLO, IDENT_FLT(5.0));
+                BEGIN
+                     IF Q1.PAC_FLO /= IDENT_FLT(5.0) THEN
+                          FAILED ("INCORRECT VALUE PASSED - 4");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE Q2 IS NEW Q(FLO, IDENT_FLT(-5.1));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE Q3 IS NEW Q(FLO, IDENT_FLT(5.1));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+           END;
+      END;
+ 
+      RESULT;
+ END CC3125C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3125d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3125d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,148 ----
+ -- CC3125D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A GENERIC IN PARAMETER
+ -- HAVING A FIXED POINT TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
+ -- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
+ 
+ -- TBN  12/15/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3125D IS
+ 
+      TYPE FIXED IS DELTA 0.125 RANGE -10.0 .. 10.0;
+      SUBTYPE FIX IS FIXED RANGE -5.0 .. 5.0;
+ 
+      FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           END IF;
+           RETURN 0.0;
+      END IDENT_FIX;
+ 
+ BEGIN
+      TEST ("CC3125D", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                       "GENERIC IN PARAMETER HAVING A FIXED POINT " &
+                       "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
+                       "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
+                       "FORMAL PARAMETER");
+      DECLARE
+           GENERIC
+                GEN_FIX : IN FIX;
+           PACKAGE P IS
+                PAC_FIX : FIXED := GEN_FIX;
+           END P;
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE P1 IS NEW P(IDENT_FIX(-5.0));
+                BEGIN
+                     IF P1.PAC_FIX /= IDENT_FIX(-5.0) THEN
+                          FAILED ("INCORRECT VALUE PASSED - 1");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - 1");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE P2 IS NEW P(IDENT_FIX(-5.2));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 2");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE P3 IS NEW P(IDENT_FIX(5.2));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 3");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+           END;
+      END;
+      -------------------------------------------------------------------
+ 
+      DECLARE
+           GENERIC
+                TYPE GEN_TYP IS DELTA <>;
+                GEN_FIX : IN GEN_TYP;
+           PACKAGE Q IS
+                PAC_FIX : GEN_TYP := GEN_FIX;
+           END Q;
+      BEGIN
+           BEGIN
+                DECLARE
+                     PACKAGE Q1 IS NEW Q(FIX, IDENT_FIX(5.0));
+                BEGIN
+                     IF Q1.PAC_FIX /= IDENT_FIX(5.0) THEN
+                          FAILED ("INCORRECT VALUE PASSED - 4");
+                     END IF;
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - 4");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE Q2 IS NEW Q(FIX, IDENT_FIX(-5.2));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 5");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     PACKAGE Q3 IS NEW Q(FIX, IDENT_FIX(5.2));
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED - 6");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+           END;
+      END;
+ 
+      RESULT;
+ END CC3125D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3126a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3126a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3126a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3126a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,188 ----
+ -- CC3126A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL
+ --     PARAMETER DOES NOT HAVE THE SAME NUMBER OF COMPONENTS
+ --     (PER DIMENSION) AS THE FORMAL PARAMETER. ALSO THAT FOR NULL
+ --     ARRAYS NO ERROR IS RAISED.
+ 
+ -- HISTORY:
+ --     LB  12/02/86
+ --     DWC 08/11/87  CHANGED HEADING FORMAT.
+ --     RJW 10/26/89  INITIALIZED VARIABLE H.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  CC3126A  IS
+ 
+ BEGIN
+      TEST ("CC3126A","GENERIC ACTUAL PARAMETER MUST HAVE THE SAME "&
+                      "NUMBER OF COMPONENTS (PER DIMENSION) AS THE "&
+                      "GENERIC FORMAL PARMETER");
+      BEGIN
+           DECLARE
+                TYPE ARRY1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+                SUBTYPE ARR IS ARRY1 (1 .. 10);
+ 
+                GENERIC
+                     GARR : IN ARR;
+                PACKAGE P IS
+                     NARR : ARR := GARR;
+                END P;
+ 
+           BEGIN
+                BEGIN
+                     DECLARE
+                          X : ARRY1 (2 .. 11) := (2 .. 11 => 0);
+                          PACKAGE Q IS NEW P(X);
+                     BEGIN
+                          Q.NARR(2) := 1;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED 1");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
+                          PACKAGE R IS NEW P(S);
+                     BEGIN
+                          FAILED ("EXCEPTION NOT RAISED 2");
+                          R.NARR(1) := IDENT_INT(R.NARR(1));
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION RAISED 2");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          G : ARRY1 (1 .. 9) := (1 .. 9 => 0);
+                          PACKAGE K IS NEW P(G);
+                     BEGIN
+                          FAILED ("EXCEPTION NOT RAISED 3");
+                          IF EQUAL(3,3) THEN
+                               K.NARR(1) := IDENT_INT(K.NARR(1));
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION RAISED 3");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
+                          PACKAGE F IS NEW P(S(2 .. 11));
+                     BEGIN
+                          F.NARR(2) := IDENT_INT(F.NARR(2));
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED 4");
+                END;
+           END;
+ 
+           DECLARE
+                SUBTYPE STR IS STRING(1 .. 20);
+ 
+                GENERIC
+                     GVAR : IN STR;
+                PACKAGE M IS
+                     NVAR : STR := GVAR;
+                END M;
+ 
+           BEGIN
+                BEGIN
+                     DECLARE
+                          L : STRING (2 .. 15);
+                          PACKAGE U IS NEW M(L);
+                     BEGIN
+                          FAILED ("EXCEPTION NOT RAISED 5");
+                          U.NVAR(2) := IDENT_CHAR(U.NVAR(2));
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION RAISED 5");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          H : STRING (1 .. 20) := (OTHERS => 'R');
+                          PACKAGE J IS NEW M(H);
+                     BEGIN
+                          IF EQUAL(3,3) THEN
+                               J.NVAR(2) := IDENT_CHAR(J.NVAR(2));
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED 6");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED ERROR RAISED STRINGS");
+           END;
+ 
+           DECLARE
+                TYPE NARRY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+                SUBTYPE SNARRY IS NARRY (2 .. 0);
+ 
+                GENERIC
+                     RD : IN SNARRY;
+                PACKAGE JA IS
+                     CD : SNARRY := RD;
+                END JA;
+           BEGIN
+                BEGIN
+                     DECLARE
+                          AD : NARRY(1 .. 0);
+                          PACKAGE PA IS NEW JA(AD);
+                     BEGIN
+                          IF NOT EQUAL(0,PA.CD'LAST) THEN
+                               FAILED ("PARAMETER ATTRIBUTE INCORRECT");
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED 7");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR ARRAYS "&
+                             "WITH NULL RANGES");
+           END;
+      END;
+ 
+      RESULT;
+ 
+ END CC3126A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3127a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3127a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3127a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3127a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,143 ----
+ -- CC3127A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     FOR A CONSTRAINED IN FORMAL PARAMETER HAVING A RECORD OR PRIVATE
+ --     TYPE WITH DISCRIMINANTS, CHECK THAT CONSTRAINT_ERROR IS RAISED
+ --     IF AND ONLY IF CORRESPONDING DISCRIMINANTS OF THE ACTUAL AND
+ --     FORMAL PARAMETER DO NOT HAVE THE SAME VALUES.
+ 
+ -- HISTORY:
+ --     LB   12/04/86  CREATED ORIGINAL TEST.
+ --     VCL  08/19/87  CORRECTED THE FORMAT OF THIS HEADER.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE  CC3127A  IS
+ 
+      TYPE INT IS RANGE 1 .. 20;
+ 
+ BEGIN
+      TEST ("CC3127A","CORRESPONDING DISCRIMINANTS OF THE GENERIC "&
+                      "ACTUAL PARAMETER AND THE GENERIC FORMAL "&
+                      "PARAMETER MUST HAVE THE SAME VALUES.");
+      BEGIN
+           DECLARE
+                TYPE REC (A : INT) IS
+                     RECORD
+                          RINT : POSITIVE := 2;
+                     END RECORD;
+                SUBTYPE CON_REC IS REC(4);
+ 
+                GENERIC
+                     GREC : IN CON_REC;
+                PACKAGE PA IS
+                     NREC : CON_REC := GREC;
+                END PA;
+           BEGIN
+                BEGIN
+                     DECLARE
+                          RVAR : REC(3);
+                          PACKAGE AB IS NEW PA(RVAR);
+                     BEGIN
+                          FAILED ("EXCEPTION NOT RAISED 1");
+                          AB.NREC.RINT := IDENT_INT(AB.NREC.RINT);
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION RAISED 1");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          SVAR : REC(4);
+                          PACKAGE CD IS NEW PA(SVAR);
+                     BEGIN
+                          IF EQUAL(3,3) THEN
+                               CD.NREC.RINT := IDENT_INT(CD.NREC.RINT);
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED 2");
+                END;
+           END;
+ 
+           DECLARE
+                PACKAGE EF IS
+                     TYPE PRI_REC (G : INT) IS PRIVATE;
+                PRIVATE
+                     TYPE PRI_REC (G : INT) IS
+                          RECORD
+                               PINT : POSITIVE := 2;
+                          END RECORD;
+                END EF;
+                SUBTYPE CPRI_REC IS EF.PRI_REC(4);
+ 
+                GENERIC
+                     GEN_REC : IN CPRI_REC;
+                PACKAGE GH IS
+                     NGEN_REC : CPRI_REC := GEN_REC;
+                END GH;
+ 
+           BEGIN
+                BEGIN
+                     DECLARE
+                          PVAR : EF.PRI_REC(4);
+                          PACKAGE LM IS NEW GH(PVAR);
+                     BEGIN
+                          IF EQUAL(3,3) THEN
+                               LM.NGEN_REC := LM.NGEN_REC;
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED 3");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          PTVAR : EF.PRI_REC(5);
+                          PACKAGE PAC IS NEW GH(PTVAR);
+                     BEGIN
+                          FAILED ("EXCEPTION NOT RAISED 4");
+                          IF EQUAL(3,5) THEN
+                             COMMENT ("DISCRIMINANT OF PAC.NGEN_REC IS "&
+                                        INT'IMAGE(PAC.NGEN_REC.G));
+                          END IF;
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION RAISED 4");
+                END;
+           END;
+      END;
+ 
+      RESULT;
+ 
+ END CC3127A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3128a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3128a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3128a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3128a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,358 ----
+ -- CC3128A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT, FOR A CONSTRAINED IN FORMAL PARAMETER HAVING AN ACCESS TYPE,
+ --     CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL PARAMETER IS NOT
+ --     NULL AND THE OBJECT DESIGNATED BY THE ACTUAL PARAMETER DOES NOT SATISFY
+ --     THE FORMAL PARAMETER'S CONSTRAINTS.
+ 
+ -- HISTORY:
+ --     RJW 10/28/88  CREATED ORIGINAL TEST.
+ --     JRL 02/28/96  Removed cases where the designated subtypes of the formal
+ --                   and actual do not statically match. Corrected commentary.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3128A IS
+ 
+ BEGIN
+      TEST ("CC3128A", "FOR A CONSTRAINED IN FORMAL PARAMETER HAVING " &
+                       "AN ACCESS TYPE, CONSTRAINT_ERROR IS RAISED " &
+                       "IF AND ONLY IF THE ACTUAL PARAMETER IS NOT " &
+                       "NULL AND THE OBJECT DESIGNATED BY THE ACTUAL " &
+                       "PARAMETER DOES NOT SATISFY FORMAL PARAMETER'S " &
+                       "CONSTRAINTS");
+ 
+      DECLARE
+           TYPE REC (D : INTEGER := 10) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACCREC IS ACCESS REC;
+ 
+           SUBTYPE LINK IS ACCREC (5);
+ 
+           GENERIC
+                LINK1 : LINK;
+           FUNCTION F (I : INTEGER) RETURN INTEGER;
+ 
+           FUNCTION F (I : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF I /= 5 THEN
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                             "TO CALL TO FUNCTION F - 1");
+                END IF;
+                IF NOT EQUAL (I, 5) AND THEN
+                   NOT EQUAL (LINK1.D, LINK1.D) THEN
+                     COMMENT ("DISREGARD");
+                END IF;
+                RETURN I + 1;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 1");
+                RETURN I + 1;
+           END F;
+ 
+           GENERIC
+                TYPE PRIV (D : INTEGER) IS PRIVATE;
+                PRIV1 : PRIV;
+           PACKAGE GEN IS
+                TYPE ACCPRIV IS ACCESS PRIV;
+                SUBTYPE LINK IS ACCPRIV (5);
+                GENERIC
+                     LINK1 : LINK;
+                     I : IN OUT INTEGER;
+                PACKAGE P IS END P;
+           END GEN;
+ 
+           PACKAGE BODY GEN IS
+                PACKAGE BODY P IS
+                BEGIN
+                     IF I /= 5 THEN
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                                  "TO PACKAGE BODY P - 1");
+                     END IF;
+                     IF NOT EQUAL (I, 5) AND THEN
+                        NOT EQUAL (LINK1.D, LINK1.D) THEN
+                          COMMENT ("DISREGARD");
+                     END IF;
+                     I := I + 1;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED WITHIN " &
+                                  "PACKAGE P - 1");
+                     I := I + 1;
+                END P;
+ 
+           BEGIN
+                BEGIN
+                     DECLARE
+                          AR10 : ACCPRIV;
+                          I : INTEGER := IDENT_INT (5);
+                          PACKAGE P1 IS NEW P (AR10, I);
+                     BEGIN
+                          IF I /= 6 THEN
+                               FAILED ("INCORRECT RESULT - " &
+                                       "PACKAGE P1");
+                          END IF;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                       "PACKAGE P1 - 1");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
+                                  "OF PACKAGE P1 WITH NULL ACCESS " &
+                                  "VALUE");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          AR10 : ACCPRIV := NEW PRIV'(PRIV1);
+                          I : INTEGER := IDENT_INT (0);
+                          PACKAGE P1 IS NEW P (AR10, I);
+                     BEGIN
+                          FAILED ("NO EXCEPTION RAISED BY " &
+                                  "INSTANTIATION OF PACKAGE P1");
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                       "PACKAGE P1 - 2");
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION RAISED AT " &
+                                  "INSTANTIATION OF PACKAGE P1");
+                END;
+           END GEN;
+ 
+           PACKAGE NEWGEN IS NEW GEN (REC, (D => 10));
+ 
+      BEGIN
+           BEGIN
+                DECLARE
+                     I : INTEGER := IDENT_INT (5);
+                     AR10 : ACCREC;
+                     FUNCTION F1 IS NEW F (AR10);
+                BEGIN
+                     I := F1 (I);
+                     IF I /= 6 THEN
+                          FAILED ("INCORRECT RESULT RETURNED BY " &
+                                  "FUNCTION F1");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                  "FUNCTION F1 - 1");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
+                             "FUNCTION F1 WITH NULL ACCESS VALUE");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     I : INTEGER := IDENT_INT (0);
+                     AR10 : ACCREC := NEW REC'(D => 10);
+                     FUNCTION F1 IS NEW F (AR10);
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
+                             "OF FUNCTION F1");
+                     I := F1 (I);
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                  "FUNCTION F1 - 2");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED AT " &
+                             "INSTANTIATION OF FUNCTION F1");
+           END;
+      END;
+ 
+      DECLARE
+           TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+ 
+           TYPE ACCARR IS ACCESS ARR;
+ 
+           SUBTYPE LINK IS ACCARR (1 .. 5);
+ 
+           GENERIC
+                LINK1 : LINK;
+           FUNCTION F (I : INTEGER) RETURN INTEGER;
+ 
+           FUNCTION F (I : INTEGER) RETURN INTEGER IS
+           BEGIN
+                IF I /= 5 THEN
+                     FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                             "TO CALL TO FUNCTION F - 2");
+                END IF;
+                IF NOT EQUAL (I, 5) AND THEN
+                   NOT EQUAL (LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
+                   THEN
+                     COMMENT ("DISREGARD");
+                END IF;
+                RETURN I + 1;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 2");
+                RETURN I + 1;
+           END F;
+ 
+           GENERIC
+                TYPE GENARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+           PACKAGE GEN IS
+                TYPE ACCGENARR IS ACCESS GENARR;
+                SUBTYPE LINK IS ACCGENARR (1 .. 5);
+                GENERIC
+                     LINK1 : LINK;
+                     I : IN OUT INTEGER;
+                PACKAGE P IS END P;
+           END GEN;
+ 
+           PACKAGE BODY GEN IS
+                PACKAGE BODY P IS
+                BEGIN
+                     IF I /= 5 THEN
+                          FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                                  "TO PACKAGE BODY P - 2");
+                     END IF;
+                     IF NOT EQUAL (I, 5) AND THEN
+                        NOT
+                        EQUAL(LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
+                        THEN
+                          COMMENT ("DISREGARD");
+                     END IF;
+                     I := I + 1;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED WITHIN " &
+                                  "PACKAGE P - 2");
+                     I := I + 1;
+                END P;
+ 
+           BEGIN
+                BEGIN
+                     DECLARE
+                          AR26 : ACCGENARR (2 .. 6);
+                          I : INTEGER := IDENT_INT (5);
+                          PACKAGE P2 IS NEW P (AR26, I);
+                     BEGIN
+                          IF I /= 6 THEN
+                               FAILED ("INCORRECT RESULT - " &
+                                       "PACKAGE P2");
+                          END IF;
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                       "PACKAGE P2 - 1");
+                     END;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
+                                  "OF PACKAGE P2 WITH NULL ACCESS " &
+                                  "VALUE");
+                END;
+ 
+                BEGIN
+                     DECLARE
+                          AR26 : ACCGENARR
+                                 (IDENT_INT (2) .. IDENT_INT (6)) :=
+                                 NEW GENARR'(1,2,3,4,5);
+                          I : INTEGER := IDENT_INT (0);
+                          PACKAGE P2 IS NEW P (AR26, I);
+                     BEGIN
+                          FAILED ("NO EXCEPTION RAISED BY " &
+                                  "INSTANTIATION OF PACKAGE P2");
+                     EXCEPTION
+                          WHEN OTHERS =>
+                               FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                       "PACKAGE P2 - 2");
+                     END;
+                EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                          NULL;
+                     WHEN OTHERS =>
+                          FAILED ("WRONG EXCEPTION RAISED AT " &
+                                  "INSTANTIATION OF PACKAGE P2");
+                END;
+           END GEN;
+ 
+           PACKAGE NEWGEN IS NEW GEN (ARR);
+ 
+      BEGIN
+           BEGIN
+                DECLARE
+                     I : INTEGER := IDENT_INT (5);
+                     AR26 : ACCARR (IDENT_INT (2) .. IDENT_INT (6));
+                     FUNCTION F2 IS NEW F (AR26);
+                BEGIN
+                     I := F2 (I);
+                     IF I /= 6 THEN
+                          FAILED ("INCORRECT RESULT RETURNED BY " &
+                                  "FUNCTION F2");
+                     END IF;
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                  "FUNCTION F2 - 1");
+                END;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
+                             "FUNCTION F2 WITH NULL ACCESS VALUE");
+           END;
+ 
+           BEGIN
+                DECLARE
+                     I : INTEGER := IDENT_INT (0);
+                     AR26 : ACCARR (2 .. 6) := NEW ARR'(1,2,3,4,5);
+                     FUNCTION F2 IS NEW F (AR26);
+                BEGIN
+                     FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
+                             "OF FUNCTION F2");
+                     I := F2 (I);
+                EXCEPTION
+                     WHEN OTHERS =>
+                          FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                  "FUNCTION F2 - 2");
+                END;
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED AT " &
+                             "INSTANTIATION OF FUNCTION F2");
+           END;
+      END;
+      RESULT;
+ END CC3128A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3203a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3203a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3203a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3203a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,89 ----
+ -- CC3203A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC FORMAL LIMITED/NON LIMITED PRIVATE TYPE HAS
+ -- DISCRIMINANTS, THE ACTUAL PARAMETER CAN HAVE DEFAULT DISCRIMINANT
+ -- VALUES.
+ 
+ -- SPS 7/9/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CC3203A IS
+ BEGIN
+      TEST ("CC3203A", "CHECK DEFAULT VALUES FOR LIMITED/" &
+            "NON LIMITED GENERIC FORMAL PRIVATE TYPES");
+      DECLARE
+           SD : INTEGER := IDENT_INT(0);
+ 
+           FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER;
+ 
+           TYPE REC (D : INTEGER := 3) IS
+                RECORD NULL; END RECORD;
+ 
+           TYPE RC(C : INTEGER := INIT_RC (1)) IS
+                RECORD NULL; END RECORD;
+ 
+           GENERIC
+                TYPE PV(X : INTEGER) IS PRIVATE;
+                TYPE LP(X : INTEGER) IS LIMITED PRIVATE;
+           PACKAGE PACK IS
+                SUBTYPE NPV IS PV;
+                SUBTYPE NLP IS LP;
+           END PACK;
+ 
+           FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER IS
+                BEGIN
+                     SD := SD + X;
+                     RETURN SD;
+           END INIT_RC;
+ 
+           PACKAGE P1 IS NEW PACK (REC, RC);
+ 
+           PACKAGE P2 IS
+                P1VP : P1.NPV;
+                P1VL : P1.NLP;
+                P1VL2 : P1.NLP;
+           END P2;
+           USE P2;
+      BEGIN
+ 
+           IF P1VP.D /= IDENT_INT(3) THEN
+                FAILED ("DEFAULT DISCRIMINANT VALUE WRONG");
+           END IF;
+ 
+           IF P1VL.C /= 1 THEN
+                FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT");
+           END IF;
+ 
+           IF P1VL2.C /= IDENT_INT(2) THEN
+                FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT " &
+                        "WHEN NEEDED");
+           END IF;
+      END;
+ 
+      RESULT;
+ 
+ END CC3203A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3207b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3207b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3207b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3207b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,119 ----
+ -- CC3207B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT INSTANTIATION IS LEGAL IF A FORMAL
+ --     PARAMETER HAVING A LIMITED PRIVATE TYPE WITHOUT
+ --     A DISCRIMINANT IS USED TO DECLARE AN ACCESS
+ --     TYPE IN A BLOCK THAT CONTAINS A SELECTIVE WAIT
+ --     WITH A TERMINATE ALTERNATIVE, AND ACTUAL
+ --     PARAMETER'S BASE IS A TASK TYPE OR TYPE WITH A
+ --     SUBCOMPONENT OF A TASK TYPE.
+ 
+ -- HISTORY:
+ --     LDC  06/24/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CC3207B IS
+ BEGIN
+      TEST("CC3207B","CHECK THAT INSTANTIATION IS LEGAL IF A "     &
+                     "FORMAL PARAMETER HAVING A LIMITED PRIVATE "  &
+                     "TYPE WITHOUT A DISCRIMINANT IS USED TO "     &
+                     "DECLARE AN ACCESS TYPE IN A BLOCK THAT "     &
+                     "CONTAINS A SELECTIVE WAIT WITH A TERMINATE " &
+                     "ALTERNATIVE, AND ACTUAL PARAMETER'S BASE "   &
+                     "A TASK TYPE OR TYPE WITH A SUBCOMPONENT OF " &
+                     "A TASK TYPE. ");
+ 
+      DECLARE
+           TASK TYPE TT IS
+                ENTRY E;
+           END TT;
+ 
+           TYPE TT_ARR IS ARRAY (1..2) OF TT;
+ 
+           TYPE TT_REC IS RECORD
+                COMP : TT_ARR;
+           END RECORD;
+ 
+           GENERIC
+                TYPE T IS LIMITED PRIVATE;
+           PACKAGE GEN IS
+                TASK TSK IS
+                     ENTRY ENT(A : OUT INTEGER);
+                END TSK;
+           END GEN;
+ 
+           INT : INTEGER;
+ 
+           TASK BODY TT IS
+           BEGIN
+                SELECT
+                     ACCEPT E;
+                OR
+                     TERMINATE;
+                END SELECT;
+           END TT;
+ 
+           PACKAGE BODY GEN IS
+                TASK BODY TSK IS
+                BEGIN
+                     DECLARE
+                          TYPE ACC_T IS ACCESS T;
+                          TA : ACC_T := NEW T;
+                     BEGIN
+                          SELECT
+                               ACCEPT ENT(A : OUT INTEGER) DO
+                                    A := IDENT_INT(7);
+                               END;
+                          OR
+                               TERMINATE;
+                          END SELECT;
+                     END;
+                END TSK;
+           END GEN;
+ 
+           PACKAGE GEN_TSK     IS NEW GEN(TT);
+           PACKAGE GEN_TSK_SUB IS NEW GEN(TT_REC);
+ 
+      BEGIN
+           GEN_TSK.TSK.ENT(INT);
+ 
+           IF INT /= IDENT_INT(7) THEN
+                FAILED("THE WRONG VALUE WAS RETURNED BY THE TASK");
+           END IF;
+ 
+           INT := 0;
+           GEN_TSK_SUB.TSK.ENT(INT);
+ 
+           IF INT /= IDENT_INT(7) THEN
+                FAILED("THE WRONG VALUE WAS RETURNED BY THE TASK, " &
+                       "WITH ACTUAL PARAMETER'S BASE IS A SUB" &
+                       "COMPONENT OF A TASK TYPE");
+           END IF;
+           RESULT;
+      END;
+ END CC3207B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3220a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3220a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3220a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3220a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,163 ----
+ -- CC3220A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
+ -- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
+ -- OPERATIONS OF THE ACTUAL TYPE.
+ 
+ -- TBN  10/08/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3220A IS
+ 
+      GENERIC
+           TYPE T IS (<>);
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+ BEGIN
+      TEST ("CC3220A", "CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS " &
+                       "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE
+           OBJ_INT : INTEGER := 1;
+ 
+           PACKAGE P1 IS NEW P (INTEGER);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1);
+           IF PAC_VAR /= OBJ_INT THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_INT := PAC_VAR + OBJ_INT;
+           IF OBJ_INT <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := PAC_VAR * OBJ_INT;
+           IF PAC_VAR NOT IN INTEGER THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_INT NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_NEWT := 1;
+           OBJ_NEWT := OBJ_NEWT + 1;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           IF NEW_T'SUCC(2) /= 3 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+           OBJ_ENU : ENUM := RED;
+ 
+           PACKAGE P2 IS NEW P (ENUM);
+           USE P2;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(RED);
+           IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           IF PAC_VAR NOT IN ENUM THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF OBJ_ENU NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+           IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
+                FAILED ("INCORRECT RESULTS - 11");
+           END IF;
+           OBJ_ENU := SUB_T'SUCC(PAC_VAR);
+           IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
+                FAILED ("INCORRECT RESULTS - 12");
+           END IF;
+           OBJ_NEWT := BLUE;
+           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 13");
+           END IF;
+           IF NEW_T'WIDTH /= 6 THEN
+                FAILED ("INCORRECT RESULTS - 14");
+           END IF;
+      END;
+ 
+      DECLARE
+           OBJ_CHR : CHARACTER := 'A';
+ 
+           PACKAGE P3 IS NEW P (CHARACTER);
+           USE P3;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+           ARA_NEWT : ARRAY (1 .. 5) OF NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'('A');
+           IF (PAC_VAR < OBJ_CHR) OR (PAC_VAR > OBJ_CHR) THEN
+                FAILED ("INCORRECT RESULTS - 15");
+           END IF;
+           IF PAC_VAR NOT IN CHARACTER THEN
+                FAILED ("INCORRECT RESULTS - 16");
+           END IF;
+           IF OBJ_CHR NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 17");
+           END IF;
+           IF CHARACTER'VAL(0) /= SUB_T'VAL(0) THEN
+                FAILED ("INCORRECT RESULTS - 18");
+           END IF;
+           OBJ_CHR := SUB_T'SUCC(PAC_VAR);
+           IF SUB_T'POS('A') /= 65 AND THEN OBJ_CHR /= 'A' THEN
+                FAILED ("INCORRECT RESULTS - 19");
+           END IF;
+           OBJ_NEWT := 'C';
+           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 20");
+           END IF;
+           IF NEW_T'IMAGE('A') /= "'A'" THEN
+                FAILED ("INCORRECT RESULTS - 21");
+           END IF;
+           ARA_NEWT := "HELLO";
+           IF (NEW_T'('H') & NEW_T'('I')) /= "HI" THEN
+                FAILED ("INCORRECT RESULTS - 22");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3220A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3221a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3221a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3221a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3221a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,107 ----
+ -- CC3221A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT AN INTEGER FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
+ -- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
+ -- OPERATIONS OF THE ACTUAL TYPE.
+ 
+ -- TBN  10/09/86
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3221A IS
+ 
+      GENERIC
+           TYPE T IS RANGE <>;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+ BEGIN
+      TEST ("CC3221A", "CHECK THAT AN INTEGER FORMAL TYPE DENOTES ITS " &
+                       "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE
+           TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+ 
+           OBJ_INT : INTEGER := 1;
+           OBJ_FLO : FLOAT := 1.0;
+           OBJ_FIX : FIXED := 1.0;
+ 
+           PACKAGE P1 IS NEW P (INTEGER);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1);
+           IF PAC_VAR /= OBJ_INT THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_INT := PAC_VAR + OBJ_INT;
+           IF OBJ_INT <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := PAC_VAR * OBJ_INT;
+           IF PAC_VAR NOT IN INTEGER THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_INT NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           PAC_VAR := 1;
+           OBJ_FIX := PAC_VAR * OBJ_FIX;
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           OBJ_INT := 1;
+           OBJ_FIX := OBJ_FIX / OBJ_INT;
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           OBJ_INT := OBJ_INT ** PAC_VAR;
+           IF OBJ_INT /= 1 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_FLO := OBJ_FLO ** PAC_VAR;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           OBJ_NEWT := 1;
+           OBJ_NEWT := OBJ_NEWT - 1;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+           IF NEW_T'SUCC(2) /= 3 THEN
+                FAILED ("INCORRECT RESULTS - 11");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3221A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3222a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3222a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3222a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3222a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,116 ----
+ -- CC3222A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A FLOATING POINT FORMAL TYPE DENOTES ITS ACTUAL
+ --     PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH
+ --     CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+ 
+ -- HISTORY:
+ --     TBN 10/09/86  CREATED ORIGINAL TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3222A IS
+ 
+      TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 10.0;
+ 
+      GENERIC
+           TYPE T IS DIGITS <>;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      FUNCTION IDENT_FLO (X : FLOAT) RETURN FLOAT IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           ELSE
+                RETURN (0.0);
+           END IF;
+      END IDENT_FLO;
+ 
+ BEGIN
+      TEST ("CC3222A", "CHECK THAT A FLOATING POINT FORMAL TYPE " &
+                       "DENOTES ITS ACTUAL PARAMETER, AND OPERATIONS " &
+                       "OF THE FORMAL TYPE ARE IDENTIFIED WITH " &
+                       "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE
+           OBJ_INT : INTEGER := 1;
+           OBJ_FLO : FLOAT := 1.0;
+ 
+           PACKAGE P1 IS NEW P (FLOAT);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1.0);
+           IF PAC_VAR /= OBJ_FLO THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
+           IF OBJ_FLO <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := PAC_VAR * OBJ_FLO;
+           IF PAC_VAR NOT IN FLOAT THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_FLO NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           PAC_VAR := 1.0;
+           OBJ_FLO := 1.0;
+           OBJ_FLO := PAC_VAR * OBJ_FLO;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_FLO := 1.0;
+           OBJ_FLO := OBJ_FLO / OBJ_FLO;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           PAC_VAR := 1.0;
+           OBJ_FLO := PAC_VAR ** OBJ_INT;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           IF SUB_T'DIGITS /= 5 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_NEWT := 1.0;
+           OBJ_NEWT := OBJ_NEWT - 1.0;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF NEW_T'DIGITS /= 5 THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3222A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3223a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3223a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3223a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3223a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,114 ----
+ -- CC3223A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A FIXED POINT FORMAL TYPE DENOTES ITS ACTUAL
+ --     PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED
+ --     WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+ 
+ -- HISTORY:
+ --     TBN 10/09/86  CREATED ORIGINAL TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3223A IS
+ 
+      TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+ 
+      GENERIC
+           TYPE T IS DELTA <>;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           ELSE
+                RETURN (0.0);
+           END IF;
+      END IDENT_FIX;
+ 
+ BEGIN
+      TEST ("CC3223A", "CHECK THAT A FIXED POINT FORMAL TYPE DENOTES " &
+                       "ITS ACTUAL PARAMETER, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE
+           OBJ_INT : INTEGER := 1;
+           OBJ_FIX : FIXED := 1.0;
+ 
+           PACKAGE P1 IS NEW P (FIXED);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1.0);
+           IF PAC_VAR /= OBJ_FIX THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
+           IF OBJ_FIX <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := OBJ_INT * OBJ_FIX;
+           IF PAC_VAR NOT IN FIXED THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_FIX NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           IF SUB_T'DELTA /= 0.125 THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_NEWT := 1.0;
+           OBJ_NEWT := OBJ_NEWT - 1.0;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           IF NEW_T'DELTA /= 0.125 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           OBJ_NEWT := NEW_T'SMALL + 1.0;
+           OBJ_FIX := 1.0;
+           OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_FIX := 1.0;
+           OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF FIXED'SMALL /= NEW_T'SMALL THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3223A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3224a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3224a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3224a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3224a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,313 ----
+ -- CC3224A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --     CHECK THAT A FORMAL ARRAY TYPE DENOTES ITS ACTUAL
+ --     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE
+ --     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+ 
+ -- HISTORY:
+ --     DHH 09/19/88  CREATED ORIGINAL TEST.
+ --     EDWARD V. BERARD, 14 AUGUST 1990  ADDED CHECKS FOR MULTI-
+ --                                       DIMENSIONAL ARRAYS
+ --     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+ 
+ WITH REPORT ;
+ 
+ PROCEDURE CC3224A IS
+ 
+     SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+     TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
+     TYPE B_ARR IS ARRAY(1 .. 3) OF BOOLEAN;
+ 
+     Q : ARR;
+     R : B_ARR;
+      
+     GENERIC
+         TYPE T IS ARRAY(INT) OF INTEGER;
+     PACKAGE P IS
+         SUBTYPE SUB_T IS T;
+         X : SUB_T := (1, 2, 3);
+     END P;
+ 
+     GENERIC
+         TYPE T IS ARRAY(INT) OF BOOLEAN;
+     PACKAGE BOOL IS
+         SUBTYPE SUB_T IS T;
+     END BOOL;
+      
+     SHORT_START : CONSTANT := -100 ;
+     SHORT_END   : CONSTANT := 100 ;
+     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+     
+     SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
+     
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+                         
+     SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
+     
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+       MONTH : MONTH_TYPE ;
+       DAY   : DAY_TYPE ;
+       YEAR  : YEAR_TYPE ;
+     END RECORD ;
+     
+     TODAY         : DATE := (MONTH => AUG,
+                              DAY   => 8,
+                              YEAR  => 1990) ;
+                             
+     FIRST_DATE    : DATE := (DAY   => 6,
+                              MONTH => JUN,
+                              YEAR  => 1967) ;
+                             
+     WALL_DATE     : DATE := (MONTH => NOV,
+                              DAY   => 9,
+                              YEAR  => 1989) ;
+                             
+     SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
+                             
+     TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
+                                      FIRST_HALF,
+                                      FIRST_FIVE) OF DATE ;
+                                      
+     TD_ARRAY        : THREE_DIMENSIONAL ;
+     SECOND_TD_ARRAY : THREE_DIMENSIONAL ;
+                                      
+     GENERIC
+     
+         TYPE CUBE IS ARRAY (REALLY_SHORT,
+                             FIRST_HALF,
+                             FIRST_FIVE) OF DATE ;
+                             
+     PACKAGE TD_ARRAY_PACKAGE IS
+     
+         SUBTYPE SUB_CUBE IS CUBE ;
+         TEST_3D_ARRAY : SUB_CUBE := (THREE_DIMENSIONAL'RANGE =>
+                                     (THREE_DIMENSIONAL'RANGE (2) =>
+                                     (THREE_DIMENSIONAL'RANGE (3) =>
+                                      TODAY))) ;
+                                      
+     END TD_ARRAY_PACKAGE ;
+ 
+ 
+ BEGIN  -- CC3224A
+ 
+     REPORT.TEST ("CC3224A", "CHECK THAT A FORMAL ARRAY TYPE DENOTES " &
+                  "ITS ACTUAL PARAMETER, AND THAT OPERATIONS OF " &
+                  "THE FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &
+                  "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
+ 
+     ONE_DIMENSIONAL:
+      
+     DECLARE
+ 
+         PACKAGE P1 IS NEW P (ARR);
+ 
+         TYPE NEW_T IS NEW P1.SUB_T;
+         OBJ_NEWT : NEW_T;
+           
+     BEGIN  -- ONE_DIMENSIONAL
+      
+         IF NEW_T'FIRST /= ARR'FIRST THEN
+             REPORT.FAILED("'FIRST ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+         IF NEW_T'LAST /= ARR'LAST THEN
+             REPORT.FAILED("'LAST ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+         IF NEW_T'FIRST(1) /= ARR'FIRST(1) THEN
+             REPORT.FAILED("'FIRST(N) ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+         IF NOT (NEW_T'LAST(1) = ARR'LAST(1)) THEN
+             REPORT.FAILED("'LAST(N) ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+         IF 2 NOT IN NEW_T'RANGE THEN
+             REPORT.FAILED("'RANGE ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+         IF 3 NOT IN NEW_T'RANGE(1) THEN
+             REPORT.FAILED("'RANGE(N) ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+         IF NEW_T'LENGTH /= ARR'LENGTH THEN
+             REPORT.FAILED("'LENGTH ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+         IF NEW_T'LENGTH(1) /= ARR'LENGTH(1) THEN
+             REPORT.FAILED("'LENGTH(N) ATTRIBUTE REPORT.FAILED");
+          END IF;
+            
+         OBJ_NEWT := (1, 2, 3);
+         IF REPORT.IDENT_INT(3) /= OBJ_NEWT(3) THEN
+             REPORT.FAILED("ASSIGNMENT REPORT.FAILED");
+         END IF;
+ 
+         IF NEW_T'(1, 2, 3) NOT IN NEW_T THEN
+             REPORT.FAILED("QUALIFIED EXPRESSION REPORT.FAILED");
+         END IF;
+ 
+         Q := (1, 2, 3);
+         IF NEW_T(Q) /= OBJ_NEWT THEN
+             REPORT.FAILED("EXPLICIT CONVERSION REPORT.FAILED");
+         END IF;
+         
+         IF Q(1) /= OBJ_NEWT(1) THEN
+             REPORT.FAILED("INDEXING REPORT.FAILED");
+         END IF;
+         
+         IF (1, 2) /= OBJ_NEWT(1 .. 2) THEN
+             REPORT.FAILED("SLICE REPORT.FAILED");
+         END IF;
+         
+         IF (1, 2) & OBJ_NEWT(3) /= NEW_T(Q)THEN
+             REPORT.FAILED("CATENATION REPORT.FAILED");
+         END IF;
+         
+         IF NOT (P1.X IN ARR) THEN
+             REPORT.FAILED ("FORMAL DOES NOT DENOTE ACTUAL");
+         END IF;
+           
+     END ONE_DIMENSIONAL ;
+ 
+     BOOLEAN_ONE_DIMENSIONAL:
+      
+     DECLARE
+ 
+         PACKAGE B1 IS NEW BOOL (B_ARR);
+ 
+         TYPE NEW_T IS NEW B1.SUB_T;
+         OBJ_NEWT : NEW_T;
+           
+     BEGIN  -- BOOLEAN_ONE_DIMENSIONAL
+ 
+         OBJ_NEWT := (TRUE, TRUE, TRUE);
+         R := (TRUE, TRUE, TRUE);
+ 
+         IF (NEW_T'((TRUE, TRUE, TRUE)) XOR OBJ_NEWT) /=
+            NEW_T'((FALSE, FALSE, FALSE)) THEN
+             REPORT.FAILED("XOR REPORT.FAILED - BOOLEAN") ;
+         END IF;
+         
+         IF (NEW_T'((FALSE, FALSE, TRUE)) AND OBJ_NEWT) /=
+            NEW_T'((FALSE, FALSE, TRUE)) THEN
+             REPORT.FAILED("AND REPORT.FAILED - BOOLEAN") ;
+         END IF;
+         
+         IF (NEW_T'((FALSE, FALSE, FALSE)) OR OBJ_NEWT) /=
+            NEW_T'((TRUE, TRUE, TRUE)) THEN
+             REPORT.FAILED("OR REPORT.FAILED - BOOLEAN") ;
+         END IF ;
+           
+     END BOOLEAN_ONE_DIMENSIONAL ;
+      
+     THREE_DIMENSIONAL_TEST:
+      
+     DECLARE
+      
+          PACKAGE TD IS NEW TD_ARRAY_PACKAGE (CUBE => THREE_DIMENSIONAL) ;
+         
+         TYPE NEW_CUBE IS NEW TD.SUB_CUBE ;
+         NEW_CUBE_OBJECT : NEW_CUBE ;
+         
+     BEGIN  -- THREE_DIMENSIONAL_TEST
+     
+         IF (NEW_CUBE'FIRST /= THREE_DIMENSIONAL'FIRST) OR
+            (NEW_CUBE'FIRST (1) /= THREE_DIMENSIONAL'FIRST) OR
+            (NEW_CUBE'FIRST (2) /= THREE_DIMENSIONAL'FIRST (2)) OR
+            (NEW_CUBE'FIRST (3) /= THREE_DIMENSIONAL'FIRST (3)) THEN
+             REPORT.FAILED ("PROBLEMS WITH 'FIRST FOR MULTI-" &
+                            "DIMENSIONAL ARRAYS.") ;
+         END IF ;
+         
+         IF (NEW_CUBE'LAST /= THREE_DIMENSIONAL'LAST) OR
+            (NEW_CUBE'LAST (1) /= THREE_DIMENSIONAL'LAST) OR
+            (NEW_CUBE'LAST (2) /= THREE_DIMENSIONAL'LAST (2)) OR
+            (NEW_CUBE'LAST (3) /= THREE_DIMENSIONAL'LAST (3)) THEN
+             REPORT.FAILED ("PROBLEMS WITH 'LAST FOR MULTI-" &
+                            "DIMENSIONAL ARRAYS.") ;
+         END IF ;
+         
+         IF (-5 NOT IN NEW_CUBE'RANGE) OR
+            (-3 NOT IN NEW_CUBE'RANGE (1)) OR
+            (FEB NOT IN NEW_CUBE'RANGE (2)) OR
+            ('C' NOT IN NEW_CUBE'RANGE (3)) THEN
+             REPORT.FAILED ("PROBLEMS WITH 'RANGE FOR MULTI-" &
+                            "DIMENSIONAL ARRAYS.") ;
+         END IF ;
+         
+         IF (NEW_CUBE'LENGTH /= THREE_DIMENSIONAL'LENGTH) OR
+            (NEW_CUBE'LENGTH (1) /= THREE_DIMENSIONAL'LENGTH) OR
+            (NEW_CUBE'LENGTH (2) /= THREE_DIMENSIONAL'LENGTH (2)) OR
+            (NEW_CUBE'LENGTH (3) /= THREE_DIMENSIONAL'LENGTH (3)) THEN
+             REPORT.FAILED ("PROBLEMS WITH 'LENGTH FOR MULTI-" &
+                            "DIMENSIONAL ARRAYS.") ;
+         END IF ;
+         
+         NEW_CUBE_OBJECT := (NEW_CUBE'RANGE =>
+                            (NEW_CUBE'RANGE (2) =>
+                            (NEW_CUBE'RANGE (3) =>
+                             FIRST_DATE))) ;
+         IF FIRST_DATE /= NEW_CUBE_OBJECT (-3, MAR, 'D') THEN
+             REPORT.FAILED ("ASSIGNMENT FOR MULTI-DIMENSIONAL " &
+                            "ARRAYS FAILED.") ;
+         END IF ;
+         
+         IF NEW_CUBE'(NEW_CUBE'RANGE =>
+                     (NEW_CUBE'RANGE (2) =>
+                     (NEW_CUBE'RANGE (3) =>
+                      WALL_DATE))) NOT IN NEW_CUBE THEN
+             REPORT.FAILED ("QUALIFIED EXPRESSION FOR MULTI-" &
+                            "DIMENSIONAL ARRAYS FAILED.") ;
+         END IF ;
+         
+         SECOND_TD_ARRAY := (NEW_CUBE'RANGE =>
+                            (NEW_CUBE'RANGE (2) =>
+                            (NEW_CUBE'RANGE (3) =>
+                             FIRST_DATE))) ;
+         IF NEW_CUBE (SECOND_TD_ARRAY) /= NEW_CUBE_OBJECT THEN
+             REPORT.FAILED ("EXPLICIT CONVERSION FOR MULTI-" &
+                            "DIMENSIONAL ARRAYS FAILED.") ;
+         END IF ;
+         
+         IF SECOND_TD_ARRAY (-2, FEB, 'B')
+             /= NEW_CUBE_OBJECT (-2, FEB, 'B') THEN
+             REPORT.FAILED ("INDEXING FOR MULTI-" &
+                            "DIMENSIONAL ARRAYS FAILED.") ;
+         END IF ;
+         
+         IF NOT (TD.TEST_3D_ARRAY IN THREE_DIMENSIONAL) THEN
+             REPORT.FAILED ("FORMAL MULTI-DIMENSIONAL ARRAY " &
+                            "DOES NOT DENOTE ACTUAL.") ;
+         END IF ;
+         
+     END THREE_DIMENSIONAL_TEST ;
+     
+     REPORT.RESULT ;
+      
+ END CC3224A ;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3225a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3225a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3225a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3225a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,183 ----
+ -- CC3225A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A FORMAL ACCESS TYPE DENOTES ITS ACTUAL
+ --     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE
+ --     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+ 
+ -- HISTORY:
+ --     DHH 10/21/88  CREATED ORIGINAL TEST.
+ --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3225A IS
+ 
+      GENERIC
+           TYPE NODE IS PRIVATE;
+           TYPE T IS ACCESS NODE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : SUB_T;
+      END P;
+ 
+ BEGIN
+      TEST ("CC3225A", "CHECK THAT A FORMAL ACCESS TYPE DENOTES ITS " &
+                       "ACTUAL PARAMETER, AND THAT OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &
+                       "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE
+           SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+           TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
+           TYPE ACC_ARR IS ACCESS ARR;
+ 
+           Q : ACC_ARR := NEW ARR;
+ 
+           PACKAGE P1 IS NEW P (ARR, ACC_ARR);
+           USE P1;
+ 
+      BEGIN
+           PAC_VAR := NEW ARR'(1, 2, 3);
+           IF PAC_VAR'FIRST /= Q'FIRST THEN
+                FAILED("'FIRST ATTRIBUTE FAILED");
+           END IF;
+           IF PAC_VAR'LAST /= Q'LAST THEN
+                FAILED("'LAST ATTRIBUTE FAILED");
+           END IF;
+           IF PAC_VAR'FIRST(1) /= Q'FIRST(1) THEN
+                FAILED("'FIRST(N) ATTRIBUTE FAILED");
+           END IF;
+           IF NOT (PAC_VAR'LAST(1) = Q'LAST(1)) THEN
+                FAILED("'LAST(N) ATTRIBUTE FAILED");
+           END IF;
+           IF 2 NOT IN PAC_VAR'RANGE THEN
+                FAILED("'RANGE ATTRIBUTE FAILED");
+           END IF;
+           IF 3 NOT IN PAC_VAR'RANGE(1) THEN
+                FAILED("'RANGE(N) ATTRIBUTE FAILED");
+           END IF;
+           IF PAC_VAR'LENGTH /= Q'LENGTH THEN
+                FAILED("'LENGTH ATTRIBUTE FAILED");
+           END IF;
+           IF PAC_VAR'LENGTH(1) /= Q'LENGTH(1) THEN
+                FAILED("'LENGTH(N) ATTRIBUTE FAILED");
+            END IF;
+ 
+           PAC_VAR.ALL := (1, 2, 3);
+           IF IDENT_INT(3) /= PAC_VAR(3) THEN
+                FAILED("ASSIGNMENT FAILED");
+           END IF;
+ 
+           IF SUB_T'(PAC_VAR) NOT IN SUB_T THEN
+                FAILED("QUALIFIED EXPRESSION FAILED");
+           END IF;
+ 
+           Q.ALL := PAC_VAR.ALL;
+           IF SUB_T(Q) = PAC_VAR THEN
+                FAILED("EXPLICIT CONVERSION FAILED");
+           END IF;
+           IF Q(1) /= PAC_VAR(1) THEN
+                FAILED("INDEXING FAILED");
+           END IF;
+           IF (1, 2) /= PAC_VAR(1 .. 2) THEN
+                FAILED("SLICE FAILED");
+           END IF;
+           IF (1, 2) & PAC_VAR(3) /= PAC_VAR.ALL THEN
+                FAILED("CATENATION FAILED");
+           END IF;
+      END;
+ 
+      DECLARE
+           TASK TYPE TSK IS
+                ENTRY ONE;
+           END TSK;
+ 
+           GENERIC
+                TYPE T IS ACCESS TSK;
+           PACKAGE P IS
+                SUBTYPE SUB_T IS T;
+                PAC_VAR : SUB_T;
+           END P;
+ 
+           TYPE ACC_TSK IS ACCESS TSK;
+ 
+           PACKAGE P1 IS NEW P(ACC_TSK);
+           USE P1;
+ 
+           GLOBAL : INTEGER := 5;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                ACCEPT ONE DO
+                     GLOBAL := 1;
+                END ONE;
+           END;
+      BEGIN
+           PAC_VAR := NEW TSK;
+           PAC_VAR.ONE;
+           IF GLOBAL /= 1 THEN
+                FAILED("TASK ENTRY SELECTION FAILED");
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE REC IS
+                RECORD
+                     I : INTEGER;
+                     B : BOOLEAN;
+                END RECORD;
+ 
+           TYPE ACC_REC IS ACCESS REC;
+ 
+           PACKAGE P1 IS NEW P (REC, ACC_REC);
+           USE P1;
+ 
+      BEGIN
+           PAC_VAR := NEW REC'(4, (PAC_VAR IN ACC_REC));
+           IF PAC_VAR.I /= IDENT_INT(4) AND NOT PAC_VAR.B THEN
+                FAILED("RECORD COMPONENT SELECTION FAILED");
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE REC(B : BOOLEAN := FALSE) IS
+                RECORD
+                     NULL;
+                END RECORD;
+ 
+           TYPE ACC_REC IS ACCESS REC;
+ 
+           PACKAGE P1 IS NEW P (REC, ACC_REC);
+           USE P1;
+ 
+      BEGIN
+           PAC_VAR := NEW REC'(B => PAC_VAR IN ACC_REC);
+           IF NOT PAC_VAR.B THEN
+                FAILED("DISCRIMINANT SELECTION FAILED");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3225A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3230a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3230a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3230a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3230a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,133 ----
+ -- CC3230A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+ --      ACTUAL PARAMETER AN ENUMERATION TYPE, AND OPERATIONS OF THE
+ --      FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE
+ --      ACTUAL TYPE.
+ 
+ -- HISTORY:
+ --      TBN 09/14/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3230A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PACKAGE LP IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END LP;
+ 
+ BEGIN
+      TEST ("CC3230A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                       "ENUMERATION TYPE, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE
+           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+           OBJ_ENU : ENUM := RED;
+ 
+           PACKAGE P2 IS NEW P (ENUM);
+           USE P2;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(RED);
+           IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           IF PAC_VAR NOT IN ENUM THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           IF OBJ_ENU NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           OBJ_ENU := SUB_T'SUCC(PAC_VAR);
+           IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_NEWT := BLUE;
+           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           IF NEW_T'WIDTH /= 6 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+           OBJ_ENU : ENUM := RED;
+ 
+           PACKAGE P2 IS NEW LP (ENUM);
+           USE P2;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(RED);
+           IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           IF PAC_VAR NOT IN ENUM THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF OBJ_ENU NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+           IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
+                FAILED ("INCORRECT RESULTS - 11");
+           END IF;
+           OBJ_ENU := SUB_T'SUCC(PAC_VAR);
+           IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
+                FAILED ("INCORRECT RESULTS - 12");
+           END IF;
+           OBJ_NEWT := BLUE;
+           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 13");
+           END IF;
+           IF NEW_T'WIDTH /= 6 THEN
+                FAILED ("INCORRECT RESULTS - 14");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3230A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3231a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3231a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3231a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3231a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,177 ----
+ -- CC3231A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+ --      ACTUAL PARAMETER AN INTEGER TYPE, AND OPERATIONS OF THE FORMAL
+ --      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+ --      TYPE.
+ 
+ -- HISTORY:
+ --      TBN 09/14/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3231A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PACKAGE LP IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END LP;
+ 
+ BEGIN
+      TEST ("CC3231A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                       "INTEGER TYPE, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE  -- PRIVATE TYPE.
+           TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+ 
+           OBJ_INT : INTEGER := 1;
+           OBJ_FLO : FLOAT := 1.0;
+           OBJ_FIX : FIXED := 1.0;
+ 
+           PACKAGE P1 IS NEW P (INTEGER);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1);
+           IF PAC_VAR /= OBJ_INT THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_INT := PAC_VAR + OBJ_INT;
+           IF OBJ_INT <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := PAC_VAR * OBJ_INT;
+           IF PAC_VAR NOT IN INTEGER THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_INT NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           PAC_VAR := 1;
+           OBJ_FIX := PAC_VAR * OBJ_FIX;
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           OBJ_INT := 1;
+           OBJ_FIX := OBJ_FIX / OBJ_INT;
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           OBJ_INT := OBJ_INT ** PAC_VAR;
+           IF OBJ_INT /= 1 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_FLO := OBJ_FLO ** PAC_VAR;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           OBJ_NEWT := 1;
+           OBJ_NEWT := OBJ_NEWT - 1;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+           IF NEW_T'SUCC(2) /= 3 THEN
+                FAILED ("INCORRECT RESULTS - 11");
+           END IF;
+      END;
+ 
+      DECLARE  -- LIMITED PRIVATE TYPE.
+           TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+ 
+           OBJ_INT : INTEGER := 1;
+           OBJ_FLO : FLOAT := 1.0;
+           OBJ_FIX : FIXED := 1.0;
+ 
+           PACKAGE P1 IS NEW LP (INTEGER);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1);
+           IF PAC_VAR /= OBJ_INT THEN
+                FAILED ("INCORRECT RESULTS - 12");
+           END IF;
+           OBJ_INT := PAC_VAR + OBJ_INT;
+           IF OBJ_INT <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 13");
+           END IF;
+           PAC_VAR := PAC_VAR * OBJ_INT;
+           IF PAC_VAR NOT IN INTEGER THEN
+                FAILED ("INCORRECT RESULTS - 14");
+           END IF;
+           IF OBJ_INT NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 15");
+           END IF;
+           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+                FAILED ("INCORRECT RESULTS - 16");
+           END IF;
+           PAC_VAR := 1;
+           OBJ_FIX := PAC_VAR * OBJ_FIX;
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 17");
+           END IF;
+           OBJ_INT := 1;
+           OBJ_FIX := OBJ_FIX / OBJ_INT;
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 18");
+           END IF;
+           OBJ_INT := OBJ_INT ** PAC_VAR;
+           IF OBJ_INT /= 1 THEN
+                FAILED ("INCORRECT RESULTS - 19");
+           END IF;
+           OBJ_FLO := OBJ_FLO ** PAC_VAR;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 20");
+           END IF;
+           OBJ_NEWT := 1;
+           OBJ_NEWT := OBJ_NEWT - 1;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 21");
+           END IF;
+           IF NEW_T'SUCC(2) /= 3 THEN
+                FAILED ("INCORRECT RESULTS - 22");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3231A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3232a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3232a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3232a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3232a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,179 ----
+ -- CC3232A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+ --     ACTUAL PARAMETER A FLOATING POINT TYPE, AND OPERATIONS OF THE
+ --     FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE
+ --     ACTUAL TYPE.
+ 
+ -- HISTORY:
+ --     TBN 09/15/88  CREATED ORIGINAL TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3232A IS
+ 
+      TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 10.0;
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PACKAGE LP IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END LP;
+ 
+      FUNCTION IDENT_FLO (X : FLOAT) RETURN FLOAT IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           ELSE
+                RETURN (0.0);
+           END IF;
+      END IDENT_FLO;
+ 
+ BEGIN
+      TEST ("CC3232A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER A " &
+                       "FLOATING POINT TYPE, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE  -- PRIVATE TYPE.
+           OBJ_INT : INTEGER := 1;
+           OBJ_FLO : FLOAT := 1.0;
+ 
+           PACKAGE P1 IS NEW P (FLOAT);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1.0);
+           IF PAC_VAR /= OBJ_FLO THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
+           IF OBJ_FLO <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := PAC_VAR * OBJ_FLO;
+           IF PAC_VAR NOT IN FLOAT THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_FLO NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           PAC_VAR := 1.0;
+           OBJ_FLO := 1.0;
+           OBJ_FLO := PAC_VAR * OBJ_FLO;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_FLO := 1.0;
+           OBJ_FLO := OBJ_FLO / OBJ_FLO;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           PAC_VAR := 1.0;
+           OBJ_FLO := PAC_VAR ** OBJ_INT;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           IF SUB_T'DIGITS /= 5 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_NEWT := 1.0;
+           OBJ_NEWT := OBJ_NEWT - 1.0;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF NEW_T'DIGITS /= 5 THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      DECLARE  -- LIMITED PRIVATE TYPE.
+           OBJ_INT : INTEGER := 1;
+           OBJ_FLO : FLOAT := 1.0;
+ 
+           PACKAGE P1 IS NEW LP (FLOAT);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1.0);
+           IF PAC_VAR /= OBJ_FLO THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
+           IF OBJ_FLO <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := PAC_VAR * OBJ_FLO;
+           IF PAC_VAR NOT IN FLOAT THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_FLO NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           PAC_VAR := 1.0;
+           OBJ_FLO := 1.0;
+           OBJ_FLO := PAC_VAR * OBJ_FLO;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_FLO := 1.0;
+           OBJ_FLO := OBJ_FLO / OBJ_FLO;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           PAC_VAR := 1.0;
+           OBJ_FLO := PAC_VAR ** OBJ_INT;
+           IF OBJ_FLO /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           IF SUB_T'DIGITS /= 5 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_NEWT := 1.0;
+           OBJ_NEWT := OBJ_NEWT - 1.0;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF NEW_T'DIGITS /= 5 THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3232A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3233a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3233a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3233a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3233a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,175 ----
+ -- CC3233A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+ --     ACTUAL PARAMETER, A FIXED POINT TYPE AND OPERATIONS OF THE FORMAL
+ --     TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+ --     TYPE.
+ 
+ -- HISTORY:
+ --     TBN 09/15/88  CREATED ORIGINAL TEST.
+ --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3233A IS
+ 
+      TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PACKAGE LP IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END LP;
+ 
+      FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
+      BEGIN
+           IF EQUAL (3, 3) THEN
+                RETURN X;
+           ELSE
+                RETURN (0.0);
+           END IF;
+      END IDENT_FIX;
+ 
+ BEGIN
+      TEST ("CC3233A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, A " &
+                       "FIXED POINT TYPE AND OPERATIONS OF THE FORMAL " &
+                       "TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE  -- PRIVATE TYPE.
+           OBJ_INT : INTEGER := 1;
+           OBJ_FIX : FIXED := 1.0;
+ 
+           PACKAGE P1 IS NEW P (FIXED);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1.0);
+           IF PAC_VAR /= OBJ_FIX THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
+           IF OBJ_FIX <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := OBJ_INT * OBJ_FIX;
+           IF PAC_VAR NOT IN FIXED THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_FIX NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           IF SUB_T'DELTA /= 0.125 THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_NEWT := 1.0;
+           OBJ_NEWT := OBJ_NEWT - 1.0;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           IF NEW_T'DELTA /= 0.125 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           OBJ_NEWT := NEW_T'SMALL + 1.0;
+           OBJ_FIX := 1.0;
+           OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_FIX := 1.0;
+           OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF FIXED'SMALL /= NEW_T'SMALL THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      DECLARE  -- LIMITED PRIVATE TYPE.
+           OBJ_INT : INTEGER := 1;
+           OBJ_FIX : FIXED := 1.0;
+ 
+           PACKAGE P1 IS NEW LP (FIXED);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1.0);
+           IF PAC_VAR /= OBJ_FIX THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
+           IF OBJ_FIX <= PAC_VAR THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR := OBJ_INT * OBJ_FIX;
+           IF PAC_VAR NOT IN FIXED THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_FIX NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           IF SUB_T'DELTA /= 0.125 THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_NEWT := 1.0;
+           OBJ_NEWT := OBJ_NEWT - 1.0;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           IF NEW_T'DELTA /= 0.125 THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           OBJ_NEWT := NEW_T'SMALL + 1.0;
+           OBJ_FIX := 1.0;
+           OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_FIX := 1.0;
+           OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
+           IF OBJ_FIX /= 1.0 THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF FIXED'SMALL /= NEW_T'SMALL THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3233A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3234a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3234a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3234a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3234a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,147 ----
+ -- CC3234A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+ --      ACTUAL PARAMETER AN ARRAY TYPE, AND OPERATIONS OF THE FORMAL
+ --      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+ --      TYPE.
+ 
+ -- HISTORY:
+ --      TBN 09/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3234A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PACKAGE LP IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END LP;
+ 
+ BEGIN
+      TEST ("CC3234A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                       "ARRAY TYPE, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE  -- PRIVATE TYPE.
+           TYPE ARRAY_TYPE IS ARRAY (1..10) OF INTEGER;
+ 
+           OBJ_ARR : ARRAY_TYPE := (OTHERS => 1);
+ 
+           PACKAGE P1 IS NEW P (ARRAY_TYPE);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+           IF PAC_VAR /= OBJ_ARR THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           OBJ_ARR(1) := PAC_VAR(2) + OBJ_ARR(1);
+           IF OBJ_ARR(1) <= PAC_VAR(1) THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           PAC_VAR(1) := PAC_VAR(1) * OBJ_ARR(3);
+           IF PAC_VAR NOT IN ARRAY_TYPE THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF OBJ_ARR NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           IF ARRAY_TYPE'FIRST /= SUB_T'FIRST THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+           OBJ_ARR(1..5) := PAC_VAR(6..10);
+           IF OBJ_ARR(1..5) /= (1, 1, 1, 1, 1) THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           PAC_VAR := (1, 1, 1, 1, 1, 2, 2, 2, 2, 2);
+           OBJ_NEWT := (1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+           OBJ_NEWT := NEW_T(PAC_VAR);
+           IF OBJ_NEWT(3..7) /= (1, 1, 1, 2, 2) THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+      END;
+ 
+      DECLARE  -- LIMITED PRIVATE TYPE.
+           TYPE ARRAY_TYPE IS ARRAY (1..10) OF INTEGER;
+ 
+           OBJ_ARR : ARRAY_TYPE := (OTHERS => 1);
+ 
+           PACKAGE P1 IS NEW LP (ARRAY_TYPE);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := SUB_T'(1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+           IF PAC_VAR /= OBJ_ARR THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           OBJ_ARR(1) := PAC_VAR(2) + OBJ_ARR(1);
+           IF OBJ_ARR(1) <= PAC_VAR(1) THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+           PAC_VAR(1) := PAC_VAR(1) * OBJ_ARR(3);
+           IF PAC_VAR NOT IN ARRAY_TYPE THEN
+                FAILED ("INCORRECT RESULTS - 11");
+           END IF;
+           IF OBJ_ARR NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 12");
+           END IF;
+           IF ARRAY_TYPE'FIRST /= SUB_T'FIRST THEN
+                FAILED ("INCORRECT RESULTS - 13");
+           END IF;
+           OBJ_ARR(1..5) := PAC_VAR(6..10);
+           IF OBJ_ARR(1..5) /= (1, 1, 1, 1, 1) THEN
+                FAILED ("INCORRECT RESULTS - 14");
+           END IF;
+           PAC_VAR := (1, 1, 1, 1, 1, 2, 2, 2, 2, 2);
+           OBJ_NEWT := (1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+           OBJ_NEWT := NEW_T(PAC_VAR);
+           IF OBJ_NEWT(3..7) /= (1, 1, 1, 2, 2) THEN
+                FAILED ("INCORRECT RESULTS - 15");
+           END IF;
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 16");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3234A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3235a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3235a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3235a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3235a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,129 ----
+ -- CC3235A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT A PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+ --      ACTUAL PARAMETER AN ACCESS TYPE, AND OPERATIONS OF THE FORMAL
+ --      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+ --      TYPE.
+ 
+ -- HISTORY:
+ --      TBN 09/15/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3235A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PACKAGE LP IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END LP;
+ 
+ BEGIN
+      TEST ("CC3235A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                       "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                       "ACCESS TYPE, AND OPERATIONS OF THE " &
+                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                       "OPERATIONS OF THE ACTUAL TYPE");
+ 
+      DECLARE  -- PRIVATE TYPE.
+           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+ 
+           TYPE ACCESS_TYPE IS ACCESS ENUM;
+ 
+           OBJ_ACC : ACCESS_TYPE := NEW ENUM'(RED);
+ 
+           PACKAGE P1 IS NEW P (ACCESS_TYPE);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := NEW ENUM'(RED);
+           IF (PAC_VAR.ALL < OBJ_ACC.ALL) OR
+              (PAC_VAR.ALL > OBJ_ACC.ALL) THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           IF PAC_VAR NOT IN ACCESS_TYPE THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           IF OBJ_ACC NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           OBJ_ACC := NEW ENUM'(ENUM'SUCC(PAC_VAR.ALL));
+           IF OBJ_ACC.ALL /= YELLOW THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+           OBJ_NEWT := NEW ENUM'(BLUE);
+           OBJ_NEWT := NEW ENUM'(ENUM'PRED(OBJ_NEWT.ALL));
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 5");
+           END IF;
+      END;
+ 
+      DECLARE  -- LIMITED PRIVATE TYPE.
+           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+ 
+           TYPE ACCESS_TYPE IS ACCESS ENUM;
+ 
+           OBJ_ACC : ACCESS_TYPE := NEW ENUM'(RED);
+ 
+           PACKAGE P1 IS NEW LP (ACCESS_TYPE);
+           USE P1;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T;
+      BEGIN
+           PAC_VAR := NEW ENUM'(RED);
+           IF (PAC_VAR.ALL < OBJ_ACC.ALL) OR
+              (PAC_VAR.ALL > OBJ_ACC.ALL) THEN
+                FAILED ("INCORRECT RESULTS - 6");
+           END IF;
+           IF PAC_VAR NOT IN ACCESS_TYPE THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           IF OBJ_ACC NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           OBJ_ACC := NEW ENUM'(ENUM'SUCC(PAC_VAR.ALL));
+           IF OBJ_ACC.ALL /= YELLOW THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           OBJ_NEWT := NEW ENUM'(BLUE);
+           OBJ_NEWT := NEW ENUM'(ENUM'PRED(OBJ_NEWT.ALL));
+           IF OBJ_NEWT NOT IN NEW_T THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3235A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3236a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3236a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3236a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3236a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,117 ----
+ -- CC3236A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT A FORMAL PRIVATE AND LIMITED PRIVATE TYPE DENOTES ITS
+ --      ACTUAL PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE
+ --      IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE
+ --      WHEN THE ACTUAL PARAMETER IS A TYPE WITH DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --      DHH 10/24/88 CREATED ORIGINAL TEST.
+ --      PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3236A IS
+ 
+      GENERIC
+           TYPE T IS PRIVATE;
+      PACKAGE P IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END P;
+ 
+      GENERIC
+           TYPE T IS LIMITED PRIVATE;
+      PACKAGE LP IS
+           SUBTYPE SUB_T IS T;
+           PAC_VAR : T;
+      END LP;
+ 
+ BEGIN
+      TEST ("CC3236A", "CHECK THAT A FORMAL PRIVATE OR LIMITED " &
+                       "PRIVATE TYPE DENOTES ITS ACTUAL PARAMETER AND " &
+                       "OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED " &
+                       "WITH CORRESPONDING OPERATIONS OF THE ACTUAL " &
+                       "TYPE, WHEN THE ACTUAL PARAMETER IS A TYPE " &
+                       "WITH DISCRIMINANTS");
+ 
+      DECLARE
+           TYPE REC(X : INTEGER := 5) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           OBJ_REC : REC(4);
+ 
+           PACKAGE P2 IS NEW P (REC);
+           USE P2;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T(4);
+      BEGIN
+           PAC_VAR := SUB_T'((X => 4));
+           IF PAC_VAR /= OBJ_REC THEN
+                FAILED ("INCORRECT RESULTS - 1");
+           END IF;
+           IF PAC_VAR NOT IN REC THEN
+                FAILED ("INCORRECT RESULTS - 2");
+           END IF;
+           IF OBJ_REC NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 3");
+           END IF;
+           IF PAC_VAR.X /= OBJ_NEWT.X THEN
+                FAILED ("INCORRECT RESULTS - 4");
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE REC(X : INTEGER := 5) IS
+                RECORD
+                     NULL;
+                END RECORD;
+           OBJ_REC : REC(4);
+ 
+           PACKAGE P2 IS NEW LP (REC);
+           USE P2;
+ 
+           TYPE NEW_T IS NEW SUB_T;
+           OBJ_NEWT : NEW_T(4);
+      BEGIN
+           PAC_VAR := SUB_T'(X => 4);
+           IF PAC_VAR /= OBJ_REC THEN
+                FAILED ("INCORRECT RESULTS - 7");
+           END IF;
+           IF PAC_VAR NOT IN REC THEN
+                FAILED ("INCORRECT RESULTS - 8");
+           END IF;
+           IF OBJ_REC NOT IN SUB_T THEN
+                FAILED ("INCORRECT RESULTS - 9");
+           END IF;
+           IF PAC_VAR.X /= OBJ_NEWT.X THEN
+                FAILED ("INCORRECT RESULTS - 10");
+           END IF;
+      END;
+ 
+      RESULT;
+ END CC3236A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3240a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3240a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3240a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3240a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,122 ----
+ -- CC3240A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --      CHECK THAT A FORMAL PRIVATE AND LIMITED PRIVATE TYPE DENOTES ITS
+ --      ACTUAL PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE
+ --      IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE
+ --      WHEN THE FORMAL TYPE IS A TYPE WITH DISCRIMINANTS.
+ 
+ -- HISTORY:
+ --      RJW 10/13/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3240A IS
+ 
+ BEGIN
+      TEST ("CC3240A", "CHECK THAT A FORMAL PRIVATE OR LIMITED " &
+                       "PRIVATE TYPE DENOTES ITS ACTUAL PARAMETER AND " &
+                       "OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED " &
+                       "WITH CORRESPONDING OPERATIONS OF THE ACTUAL " &
+                       "TYPE, WHEN THE FORMAL TYPE IS A TYPE " &
+                       "WITH DISCRIMINANTS");
+ 
+      DECLARE
+ 
+           GENERIC
+                TYPE T(A : INTEGER) IS PRIVATE;
+           PACKAGE P IS
+                SUBTYPE S IS T;
+                TX : T(5);
+           END P;
+ 
+           TYPE REC (L : INTEGER) IS
+                RECORD
+                     A : INTEGER;
+                END RECORD;
+ 
+           PACKAGE P1 IS NEW P (REC);
+           USE P1;
+ 
+      BEGIN
+           TX := (L => 5, A => 7);
+           IF NOT (TX IN REC) THEN
+                FAILED ("MEMBERSHIP TEST - PRIVATE");
+           END IF;
+ 
+           IF TX.A /= 7 OR TX.L /= 5 THEN
+                FAILED ("SELECTED COMPONENTS - PRIVATE");
+           END IF;
+ 
+           IF S(TX) /= REC(TX) THEN
+                FAILED ("EXPLICIT CONVERSION - PRIVATE");
+           END IF;
+ 
+           IF NOT TX'CONSTRAINED THEN
+                FAILED ("'CONSTRAINED - PRIVATE");
+           END IF;
+      END;
+ 
+      DECLARE
+           TYPE REC(L : INTEGER) IS
+                RECORD
+                     A : INTEGER;
+                END RECORD;
+ 
+           GENERIC
+                TYPE T(A : INTEGER) IS LIMITED PRIVATE;
+                TX : IN OUT T;
+           PACKAGE LP IS
+                SUBTYPE S IS T;
+           END LP;
+ 
+           R : REC (5) := (5, 7);
+ 
+           PACKAGE BODY LP IS
+           BEGIN
+                IF (TX IN S) /= (R IN REC) THEN
+                     FAILED ("MEMBERSHIP TEST - LIMITED PRIVATE");
+                END IF;
+ 
+                IF TX.A /= 5 THEN
+                     FAILED ("SELECTED COMPONENTS - LIMITED PRIVATE");
+                END IF;
+ 
+                IF (S(TX) IN S) /= (REC(R) IN REC) THEN
+                     FAILED ("EXPLICIT CONVERSION - LIMITED PRIVATE");
+                END IF;
+ 
+                IF NOT TX'CONSTRAINED THEN
+                     FAILED ("'CONSTRAINED - LIMITED PRIVATE");
+                END IF;
+           END LP;
+ 
+           PACKAGE P1 IS NEW LP (REC, R);
+           USE P1;
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC3240A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,103 ----
+ -- CC3305A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+ -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+ 
+ -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY (<>).
+ 
+ -- SPS 7/15/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CC3305A IS
+ BEGIN
+ 
+      TEST ("CC3305A", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+            "TYPES OF THE FORM (<>)");
+ 
+      DECLARE
+           TYPE COLOR IS (RED, BLUE, YELLOW, ORANGE, GREEN, PURPLE);
+           SUBTYPE P_COLOR IS COLOR RANGE BLUE .. ORANGE;
+           SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+           SUBTYPE ATOC IS CHARACTER RANGE CHARACTER'VAL(1) .. 
+                CHARACTER'VAL(3);
+ 
+           GENERIC
+                TYPE GFT IS (<>);
+           PACKAGE PK IS END PK;
+ 
+           PACKAGE BODY PK IS
+           BEGIN
+                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                     COMMENT ("START OF ITERATION");
+                     DECLARE
+                          VAR : GFT;
+                     BEGIN
+                          VAR := GFT'VAL (I);
+                          IF I = 0 OR I = 4 THEN
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               IF I /= 0 AND I /= 4 THEN
+                                    FAILED ("CONSTRAINT_ERROR RAISED " &
+                                       "INAPPROPRIATELY");
+                               END IF;
+                     END;
+                END LOOP;
+           END PK;
+ 
+      BEGIN
+           COMMENT ("INSTANTIATION WITH P_COLOR");
+           DECLARE
+                PACKAGE NPC IS NEW PK (P_COLOR);
+           BEGIN
+                NULL;
+           END;
+ 
+           COMMENT ("INSTANTIATION WITH INT");
+ 
+           DECLARE
+                PACKAGE NPI IS NEW PK (INT);
+           BEGIN
+                NULL;
+           END;
+ 
+           COMMENT ("INSTANTIATION WITH ATOC");
+ 
+           DECLARE
+                PACKAGE NPA IS NEW PK (ATOC);
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+      END;
+ 
+      RESULT;
+ END CC3305A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- CC3305B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+ -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+ 
+ -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY RANGE <>.
+ 
+ -- SPS 7/15/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CC3305B IS
+ BEGIN
+ 
+      TEST ("CC3305B", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+            "TYPES OF THE FORM RANGE <>");
+ 
+      DECLARE
+           SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+ 
+           GENERIC
+                TYPE GFT IS RANGE <>;
+           PACKAGE PK IS END PK;
+ 
+           PACKAGE BODY PK IS
+           BEGIN
+                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                     COMMENT ("START OF ITERATION");
+                     DECLARE
+                          VAR : GFT;
+                     BEGIN
+                          VAR := GFT(I);
+                          IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               IF I /= IDENT_INT(0) AND
+                                  I /= IDENT_INT(4) THEN
+                                    FAILED ("CONSTRAINT_ERROR RAISED " &
+                                       "INAPPROPRIATELY");
+                               END IF;
+                     END;
+                END LOOP;
+           END PK;
+ 
+      BEGIN
+ 
+           DECLARE
+                PACKAGE NPI IS NEW PK (INT);
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+      END;
+ 
+      RESULT;
+ END CC3305B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- CC3305C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+ -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+ 
+ -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY DIGITS <>.
+ 
+ -- SPS 7/15/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CC3305C IS
+ BEGIN
+ 
+      TEST ("CC3305C", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+            "TYPES OF THE FORM DIGITS <>");
+ 
+      DECLARE
+           SUBTYPE FL IS FLOAT RANGE 1.0 .. 3.0;
+ 
+           GENERIC
+                TYPE GFT IS DIGITS <>;
+           PACKAGE PK IS END PK;
+ 
+           PACKAGE BODY PK IS
+           BEGIN
+                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                     COMMENT ("START OF ITERATION");
+                     DECLARE
+                          VAR : GFT;
+                     BEGIN
+                          VAR := GFT (I);
+                          IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               IF I /= IDENT_INT(0) AND 
+                                  I /= IDENT_INT(4) THEN
+                                    FAILED ("CONSTRAINT_ERROR RAISED " &
+                                       "INAPPROPRIATELY");
+                               END IF;
+                     END;
+                END LOOP;
+           END PK;
+ 
+      BEGIN
+ 
+           DECLARE
+                PACKAGE NP IS NEW PK (FL);
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+      END;
+ 
+      RESULT;
+ END CC3305C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305d.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305d.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3305d.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3305d.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,84 ----
+ -- CC3305D.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+ -- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+ 
+ -- CHECK WHEN THE SCALAR TYPE IS DEFINED BY DELTA <>.
+ 
+ -- SPS 7/15/82
+ 
+ WITH REPORT;
+ USE REPORT;
+ 
+ PROCEDURE CC3305D IS
+ BEGIN
+ 
+      TEST ("CC3305D", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+            "TYPES OF THE FORM DELTA <>");
+ 
+      DECLARE
+           TYPE FX IS DELTA 0.1 RANGE 1.0 .. 3.0;
+ 
+           GENERIC
+                TYPE GFT IS DELTA <>;
+           PACKAGE PK IS END PK;
+ 
+           PACKAGE BODY PK IS
+           BEGIN
+                FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                     COMMENT ("START OF ITERATION");
+                     DECLARE
+                          VAR : GFT;
+                     BEGIN
+                          VAR := GFT (I);
+                          IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
+                               FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                          END IF;
+                     EXCEPTION
+                          WHEN CONSTRAINT_ERROR =>
+                               IF I /= IDENT_INT(0) AND
+                                  I /= IDENT_INT(4) THEN
+                                    FAILED ("CONSTRAINT_ERROR RAISED " &
+                                       "INAPPROPRIATELY");
+                               END IF;
+                     END;
+                END LOOP;
+           END PK;
+ 
+      BEGIN
+ 
+           DECLARE
+                PACKAGE NP IS NEW PK (FX);
+           BEGIN
+                NULL;
+           END;
+ 
+      EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+                FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+      END;
+ 
+      RESULT;
+ END CC3305D;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3601a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3601a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3601a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3601a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,251 ----
+ -- CC3601A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL
+ -- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN
+ -- CC3601C).
+ 
+ -- R.WILLIAMS 10/9/86
+ -- JRL        11/15/95 Added unknown discriminant part to all formal
+ --                     private types.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3601A IS
+ 
+      GENERIC
+           TYPE T (<>) IS PRIVATE;
+           V, V1 : T;
+           KIND : STRING;
+           WITH FUNCTION F1 (X : IN T) RETURN T;
+      PACKAGE GP1 IS
+           R : BOOLEAN := F1 (V) = V1;
+      END GP1;
+ 
+      PACKAGE BODY GP1 IS
+      BEGIN
+           IF NOT (IDENT_BOOL(R)) THEN
+                FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND);
+           END IF;
+      END GP1;
+ 
+      GENERIC
+           TYPE T (<>) IS PRIVATE;
+           V, V1, V2 : IN T;
+           KIND : STRING;
+           WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T;
+      PACKAGE GP2 IS
+           R : BOOLEAN := V /= F1 (V1, V2);
+      END GP2;
+ 
+      PACKAGE BODY GP2 IS
+      BEGIN
+           IF IDENT_BOOL (R) THEN
+                FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND);
+           END IF;
+      END GP2;
+ 
+      
+      GENERIC
+           TYPE T1 (<>) IS PRIVATE;
+           TYPE T2 (<>) IS PRIVATE;
+           V1 : T1;
+           V2 : T2;
+           KIND : STRING;
+           WITH FUNCTION F1 (X : IN T1) RETURN T2;
+      PACKAGE GP3 IS
+           R : BOOLEAN := F1 (V1) = V2;
+      END GP3;
+ 
+      PACKAGE BODY GP3 IS
+      BEGIN
+           IF NOT (IDENT_BOOL(R)) THEN
+                FAILED ( "INCORRECT VALUE FOR OP - " & KIND);
+           END IF;
+      END GP3;
+ 
+ BEGIN
+      TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " &
+                        "PASSED AS ACTUAL GENERIC SUBPROGRAM " &
+                        "PARAMETERS" );
+ 
+ 
+      BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS
+            -- ACTUAL PARAMETERS.
+ 
+           FOR I1 IN BOOLEAN LOOP
+ 
+                FOR I2 IN BOOLEAN LOOP
+                     COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " &
+                               "B2 = " & BOOLEAN'IMAGE (I2) );
+                     DECLARE
+                          B1 : BOOLEAN := IDENT_BOOL (I1);
+                          B2 : BOOLEAN := IDENT_BOOL (I2);
+ 
+                          PACKAGE P1 IS 
+                               NEW GP1 (BOOLEAN, NOT B2, B2, 
+                                        """NOT"" - 1", "NOT");
+                          PACKAGE P2 IS 
+                               NEW GP2 (BOOLEAN, B1 OR B2, B1, B2, 
+                                        "OR", "OR");
+                          PACKAGE P3 IS  
+                               NEW GP2 (BOOLEAN, B1 AND B2, B2, B1, 
+                                        "AND", "AND");
+                          PACKAGE P4 IS 
+                               NEW GP2 (BOOLEAN, B1 /= B2, B1, B2, 
+                                        "XOR", "XOR");
+                          PACKAGE P5 IS  
+                               NEW GP2 (BOOLEAN, B1 < B2, B1, B2, 
+                                        "<", "<");
+                          PACKAGE P6 IS 
+                               NEW GP2 (BOOLEAN, B1 <= B2, B1, B2, 
+                                        "<=", "<=");
+                          PACKAGE P7 IS  
+                               NEW GP2 (BOOLEAN, B1 > B2, B1, B2, 
+                                        ">", ">");
+                          PACKAGE P8 IS  
+                               NEW GP2 (BOOLEAN, B1 >= B2, B1, B2, 
+                                        ">=", ">=");
+ 
+                          TYPE AB IS ARRAY (BOOLEAN RANGE <> ) 
+                               OF BOOLEAN;
+                          AB1 : AB (BOOLEAN) := (B1, B2);
+                          AB2 : AB (BOOLEAN) := (B2, B1);
+                          T : AB (B1 .. B2) := (B1 .. B2 => TRUE);
+                          F : AB (B1 .. B2) := (B1 .. B2 => FALSE);
+                          VB1 : AB (B1 .. B1) := (B1 => B2);
+                          VB2 : AB (B2 .. B2) := (B2 => B1);
+ 
+                          PACKAGE P9 IS 
+                               NEW GP1 (AB, AB1, NOT AB1, 
+                                        """NOT"" - 2", "NOT");
+                          PACKAGE P10 IS 
+                               NEW GP1 (AB, T, F, 
+                                        """NOT"" - 3", "NOT");
+                          PACKAGE P11 IS 
+                               NEW GP1 (AB, VB2, (B2 => NOT B1), 
+                                        """NOT"" - 4", "NOT");
+                          PACKAGE P12 IS 
+                               NEW GP2 (AB, AB1 AND AB2, AB1, AB2, 
+                                        "AND", "AND");
+                     BEGIN
+                          NULL;
+                     END;
+                END LOOP;
+           END LOOP;
+      END;
+ 
+      DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**", 
+              -- AND "ABS".
+           
+           PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+");
+ 
+           PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+");
+ 
+           PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3",
+                                  "+");
+           PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-");
+ 
+           PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-");
+ 
+           PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3", 
+                                  "-");
+           PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+");
+ 
+           PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2", 
+                                  "+");
+           PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3",
+                                  "+");
+           PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1",
+                                   "-" );
+           PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0, 
+                                   """-"" - 2", "-");
+           PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3",
+                                   "-");
+ 
+           SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2;
+           TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER;
+           VSTR : STR (0 .. 1) := "AB";
+ 
+           PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) & 
+                                       VSTR (1 .. 1),
+                                       VSTR (0 .. 0),  
+                                       VSTR (1 .. 1), """&"" - 1", "&");
+ 
+           PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) & 
+                                       VSTR (0 .. 0),
+                                       VSTR (1 .. 1),  
+                                       VSTR (0 .. 0), """&"" - 2", "&");
+                                         
+           PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*");
+ 
+           PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2",
+                                   "*");
+           PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/");
+ 
+           PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2",
+                                   "/");
+           PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM");
+ 
+           PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD");
+           
+           PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS");
+ 
+           PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2", 
+                                   "ABS");
+ 
+           PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3", 
+                                   "ABS");
+ 
+           PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1", 
+                                   "**");
+ 
+           PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2",
+                                   "**");
+ 
+      BEGIN
+           NULL;
+      END;
+ 
+      DECLARE -- CHECKS WITH ATTRIBUTES.
+           
+           TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI);
+ 
+           PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC", 
+                                  WEEKDAY'SUCC);
+ 
+           PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED", 
+                                  WEEKDAY'PRED);
+           
+           PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR", 
+                                  "WEEKDAY'IMAGE", WEEKDAY'IMAGE);
+ 
+           PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI, 
+                                  "WEEKDAY'VALUE", WEEKDAY'VALUE);
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC3601A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3601c.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3601c.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3601c.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3601c.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,149 ----
+ -- CC3601C.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- CHECK THAT "/=" MAY BE PASSED AS A GENERIC ACTUAL FUNCTION
+ -- PARAMETER.
+ 
+ -- DAT 10/6/81
+ -- SPS 10/27/82
+ -- JRK 2/9/83
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3601C IS
+ BEGIN
+      TEST ("CC3601C", "/= AS GENERIC ACTUAL PARAMETER");
+ 
+      DECLARE
+           PACKAGE PK IS
+                TYPE LP IS LIMITED PRIVATE;
+                FUNCTION "=" (X, Y : LP) RETURN BOOLEAN;-- RETURNS FALSE.
+                TYPE INT IS NEW INTEGER;
+           PRIVATE
+                TASK TYPE LP;
+           END PK;
+           USE PK;
+ 
+           V1, V2 : LP;
+ 
+           TYPE REC IS RECORD
+                C : LP;
+           END RECORD;
+ 
+           R1, R2 : REC;
+ 
+           TYPE INT IS NEW INTEGER;
+ 
+           B1 : BOOLEAN := TRUE;
+           B2 : BOOLEAN := TRUE;
+           INTEGER_3 : INTEGER := 3;
+           INTEGER_4 : INTEGER := 4;
+           INT_3     : INT := 3;
+           INT_4     : INT := 4;
+           INT_5     : INT := 5;
+           PK_INT_M1 : PK.INT := -1;
+           PK_INT_M2 : PK.INT := -2;
+           PK_INT_1  : PK.INT := 1;
+           PK_INT_2  : PK.INT := 2;
+           PK_INT_3  : PK.INT := 3;
+ 
+           FUNCTION "=" (Q, R : LP) RETURN BOOLEAN;-- RETURNS TRUE.
+ 
+           GENERIC
+                TYPE T IS LIMITED PRIVATE;
+                V1, V2 : IN OUT T;
+                WITH FUNCTION NE (ZA : IN T; ZB : T) RETURN BOOLEAN;
+                VALUE : IN BOOLEAN; -- SHOULD BE VALUE OF NE(V1,V2).
+                STR : STRING;
+           PACKAGE GP IS END GP;
+ 
+           FUNCTION "=" (Q, R : IN REC) RETURN BOOLEAN;
+ 
+           FUNCTION NE (Q : INT; R : IN INT) RETURN BOOLEAN
+                RENAMES "/=";
+ 
+           FUNCTION NE (Q : PK.INT; R : IN PK.INT) RETURN BOOLEAN
+                RENAMES "/=";
+ 
+           PACKAGE BODY GP IS
+           BEGIN
+                IF IDENT_BOOL(VALUE) /= NE (V1, V2) THEN
+                     FAILED ("WRONG /= ACTUAL GENERIC PARAMETER "
+                     & STR);
+                END IF;
+           END GP;
+ 
+           FUNCTION "=" (Q, R : IN REC) RETURN BOOLEAN IS
+           BEGIN
+                RETURN FALSE;
+           END "=";
+ 
+           FUNCTION "=" (Q, R : LP) RETURN BOOLEAN IS
+           BEGIN
+                RETURN TRUE;
+           END "=";
+ 
+           PACKAGE BODY PK IS
+                FUNCTION "=" (X, Y : LP) RETURN BOOLEAN IS
+                BEGIN
+                     RETURN R1 = R1;     -- FALSE.
+                END "=";
+                TASK BODY LP IS BEGIN NULL; END;
+           END PK;
+ 
+           PACKAGE P1 IS NEW GP (LP, V1, V2, "/=", FALSE, "1");
+ 
+           FUNCTION "NOT" (X : BOOLEAN) RETURN BOOLEAN IS
+           BEGIN RETURN X; END "NOT"; -- ENSURES USE OF PREDEFINED "NOT"
+ 
+           PACKAGE P2 IS NEW GP (LP,      V1, V2, "/=", FALSE, "2");
+           PACKAGE P3 IS NEW GP (LP, V1, V2, PK."/=", TRUE, "3");
+           PACKAGE P4 IS NEW GP (PK.LP, V1, V2, "/=", FALSE, "4");
+           PACKAGE P5 IS NEW GP (PK.LP, V1, V2, PK."/=", TRUE, "5");
+           PACKAGE P6 IS NEW GP (REC, R1, R2, "/=", TRUE, "6");
+           PACKAGE P7 IS NEW GP (INTEGER, INTEGER_3, INTEGER_4, "/=",
+                                 TRUE, "7");
+           PACKAGE P8 IS NEW GP (BOOLEAN, B1, B2, "/=", FALSE,"8");
+           PACKAGE P9 IS NEW GP (INT, INT_3, INT_5, "/=", TRUE, "9");
+           PACKAGE P10 IS NEW GP (INT, INT_3, INT_3, "/=", FALSE, "10");
+           PACKAGE P11 IS NEW GP (INT, INT_3, INT_4, NE, TRUE, "11");
+           PACKAGE P12 IS NEW GP (INT, INT_3, INT_3, NE, FALSE, "12");
+           PACKAGE P13 IS NEW GP (PK.INT, PK_INT_3, PK_INT_3, NE,
+                                  FALSE, "13");
+           PACKAGE P14 IS NEW GP (PK.INT, PK_INT_M1, PK_INT_M2, NE, 
+                                  TRUE,  "14");
+           PACKAGE P15 IS NEW GP (PK.INT, PK_INT_1, PK_INT_1, "/=",
+                                  FALSE, "15");
+           PACKAGE P16 IS NEW GP (PK.INT, PK_INT_1, PK_INT_2, "/=",
+                                  TRUE,  "16");
+           PACKAGE P17 IS NEW GP (PK.INT, PK_INT_1, PK_INT_1, PK."/=",
+                                  FALSE, "17");
+           PACKAGE P18 IS NEW GP (PK.INT, PK_INT_1, PK_INT_2, PK."/=",
+                                  TRUE,  "18");
+      BEGIN
+           NULL;
+      END;
+ 
+      RESULT;
+ END CC3601C;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3602a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3602a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3602a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3602a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,146 ----
+ -- CC3602A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ENTRIES MAY BE PASSED AS GENERIC SUBPROGRAM
+ --     PARAMETERS.
+ 
+ -- HISTORY:
+ --     DAT 9/25/81     CREATED ORIGINAL TEST.
+ --     LDC 10/6/88     REVISED; CHECKED THAT DEFAULT NAME CAN BE
+ --                     IDENTIFIED WITH ENTRY.
+ 
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3602A IS
+      COUNTER : INTEGER := 0;
+ BEGIN
+      TEST ("CC3602A", "ENTRIES AS GENERIC SUBPROGRAM PARAMETERS");
+ 
+      DECLARE
+           TASK TSK IS
+                ENTRY ENT;
+           END TSK;
+ 
+           GENERIC
+                WITH PROCEDURE P;
+           PROCEDURE GP;
+ 
+           GENERIC
+                WITH PROCEDURE P;
+           PACKAGE PK IS END PK;
+ 
+ 
+           PROCEDURE E1 RENAMES TSK.ENT;
+ 
+           GENERIC
+                WITH PROCEDURE P IS TSK.ENT;
+           PROCEDURE GP_DEF1;
+ 
+           GENERIC
+                WITH PROCEDURE P IS E1;
+           PROCEDURE GP_DEF2;
+ 
+           GENERIC
+                WITH PROCEDURE P IS TSK.ENT;
+           PACKAGE PK_DEF1 IS END PK_DEF1;
+ 
+           GENERIC
+                WITH PROCEDURE P IS E1;
+           PACKAGE PK_DEF2 IS END PK_DEF2;
+ 
+           PROCEDURE GP IS
+           BEGIN
+                P;
+           END GP;
+ 
+           PACKAGE BODY PK IS
+           BEGIN
+                P;
+           END PK;
+ 
+ 
+           PROCEDURE GP_DEF1 IS
+           BEGIN
+                P;
+           END GP_DEF1;
+ 
+           PROCEDURE GP_DEF2 IS
+           BEGIN
+                P;
+           END GP_DEF2;
+ 
+           PACKAGE BODY PK_DEF1 IS
+           BEGIN
+                P;
+           END PK_DEF1;
+ 
+           PACKAGE BODY PK_DEF2 IS
+           BEGIN
+                P;
+           END PK_DEF2;
+ 
+           TASK BODY TSK IS
+           BEGIN
+                LOOP
+                     SELECT
+                          ACCEPT ENT DO
+                               COUNTER := COUNTER + 1;
+                          END ENT;
+                     OR
+                          TERMINATE;
+                     END SELECT;
+                END LOOP;
+           END TSK;
+ 
+      BEGIN
+           DECLARE
+                PROCEDURE P1 IS NEW GP (TSK.ENT);
+                PROCEDURE E RENAMES TSK.ENT;
+                PROCEDURE P2 IS NEW GP (E);
+                PACKAGE PK1 IS NEW PK (TSK.ENT);
+                PACKAGE PK2 IS NEW PK (E);
+ 
+                PROCEDURE P3 IS NEW GP_DEF1;
+                PROCEDURE P4 IS NEW GP_DEF2;
+                PACKAGE PK3 IS NEW PK_DEF1;
+                PACKAGE PK4 IS NEW PK_DEF2;
+           BEGIN
+                P1;
+                P2;
+                TSK.ENT;
+                E;
+                P3;
+                P4;
+           END;
+           TSK.ENT;
+      END;
+ 
+      IF COUNTER /= 11 THEN
+           FAILED ("INCORRECT CALL OF ENTRY AS GENERIC PARAMETER");
+      END IF;
+ 
+      RESULT;
+ END CC3602A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3603a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3603a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3603a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3603a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,97 ----
+ -- CC3603A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ENUMERATION LITERALS (BOTH IDENTIFIERS AND CHARACTER
+ --     LITERALS) MAY BE PASSED AS ACTUALS CORRESPONDING TO GENERIC
+ --     FORMAL SUBPROGRAMS.
+ 
+ -- HISTORY:
+ --     RJW 06/11/86  CREATED ORIGINAL TEST.
+ --     VCL 08/18/87  CHANGED THE SECOND ACTUAL GENERIC PARAMETER IN THE
+ --                   INSTANTIATION OF PROCEDURE NP3 TO
+ --                   'IDENT_CHAR('X')'.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3603A IS
+ 
+ BEGIN
+      TEST ("CC3603A", "CHECK THAT ENUMERATION LITERALS (BOTH " &
+                       "IDENTIFIERS AND CHARACTER LITERALS) MAY " &
+                       "BE PASSED AS ACTUALS CORRESPONDING TO " &
+                       "GENERIC FORMAL SUBPROGRAMS" );
+ 
+      DECLARE
+ 
+           TYPE ENUM1 IS ('A', 'B');
+           TYPE ENUM2 IS (C, D);
+ 
+           GENERIC
+                TYPE E IS (<>);
+                E1 : E;
+                WITH FUNCTION F RETURN E;
+           PROCEDURE P;
+ 
+           PROCEDURE P IS
+           BEGIN
+                IF F /= E1 THEN
+                     FAILED ( "WRONG VALUE FOR " & E'IMAGE (E1) &
+                              " AS ACTUAL PARAMETER" );
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED INSIDE OF P WITH " &
+                               E'IMAGE (E1) &
+                              " AS ACTUAL PARAMETER" );
+           END P;
+ 
+           PROCEDURE NP1 IS NEW P (ENUM1, 'A', 'A');
+           PROCEDURE NP2 IS NEW P (ENUM2, D, D);
+           PROCEDURE NP3 IS NEW P (CHARACTER, IDENT_CHAR('X'), 'X');
+      BEGIN
+           BEGIN
+                NP1;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED WHEN NP1 CALLED" );
+           END;
+ 
+           BEGIN
+                NP2;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED WHEN NP2 CALLED" );
+           END;
+ 
+           BEGIN
+                NP3;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ( "EXCEPTION RAISED WHEN NP3 CALLED" );
+           END;
+      END;
+      RESULT;
+ 
+ END CC3603A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3605a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3605a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3605a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3605a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,381 ----
+ -- CC3605A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT SOME DIFFERENCES BETWEEN THE FORMAL AND THE
+ --     ACTUAL SUBPROGRAMS DO NOT INVALIDATE A MATCH.
+ --          1)  CHECK DIFFERENT PARAMETER NAMES.
+ --          2)  CHECK DIFFERENT PARAMETER CONSTRAINTS.
+ --          3)  CHECK ONE PARAMETER CONSTRAINED AND THE OTHER
+ --               UNCONSTRAINED (WITH ARRAY, RECORD, ACCESS, AND
+ --               PRIVATE TYPES).
+ --          4)  CHECK PRESENCE OR ABSENCE OF AN EXPLICIT "IN" MODE
+ --               INDICATOR.
+ --          5)  DIFFERENT TYPE MARKS USED TO SPECIFY THE TYPE OF
+ --               PARAMETERS.
+ 
+ -- HISTORY:
+ --     LDC 10/04/88  CREATED ORIGINAL TEST.
+ 
+ PACKAGE CC3605A_PACK IS
+ 
+      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
+ 
+      TYPE PRI_TYPE (SIZE : INT) IS PRIVATE;
+ 
+      SUBTYPE PRI_CONST IS PRI_TYPE (2);
+ 
+ PRIVATE
+ 
+      TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+ 
+      TYPE PRI_TYPE (SIZE : INT) IS
+           RECORD
+                SUB_A : ARR_TYPE (1 .. SIZE);
+           END RECORD;
+ 
+ END CC3605A_PACK;
+ 
+ 
+ WITH REPORT;
+ USE  REPORT;
+ WITH CC3605A_PACK;
+ USE  CC3605A_PACK;
+ 
+ PROCEDURE CC3605A IS
+ 
+      SUBTYPE ZERO_TO_TEN IS INTEGER
+           RANGE IDENT_INT (0) .. IDENT_INT (10);
+ 
+      SUBTYPE ONE_TO_FIVE IS INTEGER
+           RANGE IDENT_INT (1) .. IDENT_INT (5);
+ 
+      SUBPRG_ACT : BOOLEAN := FALSE;
+ BEGIN
+      TEST
+           ("CC3605A", "CHECK THAT SOME DIFFERENCES BETWEEN THE " &
+                       "FORMAL AND THE ACTUAL PARAMETERS DO NOT " &
+                       "INVALIDATE A MATCH");
+ 
+ ----------------------------------------------------------------------
+ -- DIFFERENT PARAMETER NAMES
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           PROCEDURE ACT_PROC (DIFF_NAME_PARM : ONE_TO_FIVE) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM : ONE_TO_FIVE);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (ONE_TO_FIVE'FIRST);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED
+                     ("DIFFERENT PARAMETER NAMES MADE MATCH INVALID");
+           END IF;
+      END;
+ 
+ ----------------------------------------------------------------------
+ -- DIFFERENT PARAMETER CONSTRAINTS
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           PROCEDURE ACT_PROC (PARM : ONE_TO_FIVE) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM : ZERO_TO_TEN);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (ONE_TO_FIVE'FIRST);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           SUBPRG_ACT := FALSE;
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED
+                     ("DIFFERENT PARAMETER CONSTRAINTS MADE MATCH " &
+                      "INVALID");
+           END IF;
+      END;
+ 
+ ----------------------------------------------------------------------
+ -- ONE PARAMETER CONSTRAINED (ARRAY)
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+ 
+           SUBTYPE ARR_CONST IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
+                ONE_TO_FIVE'LAST);
+ 
+           PASSED_PARM : ARR_CONST := (OTHERS => TRUE);
+ 
+           PROCEDURE ACT_PROC (PARM : ARR_CONST) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM : ARR_TYPE);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (PASSED_PARM);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           SUBPRG_ACT := FALSE;
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED
+                     ("ONE ARRAY PARAMETER CONSTRAINED MADE MATCH " &
+                      "INVALID");
+           END IF;
+      END;
+ 
+ ----------------------------------------------------------------------
+ -- ONE PARAMETER CONSTRAINED (RECORDS)
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE REC_TYPE (BOL : BOOLEAN) IS
+                RECORD
+                     SUB_A : INTEGER;
+                     CASE BOL IS
+                          WHEN TRUE =>
+                               DSCR_A : INTEGER;
+ 
+                          WHEN FALSE =>
+                               DSCR_B : BOOLEAN;
+ 
+                     END CASE;
+                END RECORD;
+ 
+           SUBTYPE REC_CONST IS REC_TYPE (TRUE);
+ 
+           PASSED_PARM : REC_CONST := (TRUE, 1, 2);
+ 
+           PROCEDURE ACT_PROC (PARM : REC_CONST) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM : REC_TYPE);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (PASSED_PARM);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           SUBPRG_ACT := FALSE;
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED
+                     ("ONE RECORD PARAMETER CONSTRAINED MADE MATCH " &
+                      "INVALID");
+           END IF;
+      END;
+ 
+ ----------------------------------------------------------------------
+ -- ONE PARAMETER CONSTRAINED (ACCESS)
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+ 
+           SUBTYPE ARR_CONST     IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
+                ONE_TO_FIVE'LAST);
+ 
+           TYPE ARR_ACC_TYPE IS ACCESS ARR_TYPE;
+ 
+           SUBTYPE ARR_ACC_CONST IS ARR_ACC_TYPE (1 .. 3);
+ 
+           PASSED_PARM : ARR_ACC_TYPE := NULL;
+ 
+           PROCEDURE ACT_PROC (PARM : ARR_ACC_CONST) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM : ARR_ACC_TYPE);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (PASSED_PARM);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           SUBPRG_ACT := FALSE;
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED
+                     ("ONE ACCESS PARAMETER CONSTRAINED MADE MATCH " &
+                      "INVALID");
+           END IF;
+      END;
+ 
+ ----------------------------------------------------------------------
+ -- ONE PARAMETER CONSTRAINED (PRIVATE)
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+           PASSED_PARM : PRI_CONST;
+ 
+           PROCEDURE ACT_PROC (PARM : PRI_CONST) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM : PRI_TYPE);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (PASSED_PARM);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           SUBPRG_ACT := FALSE;
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED
+                     ("ONE PRIVATE PARAMETER CONSTRAINED MADE MATCH " &
+                      "INVALID");
+           END IF;
+      END;
+ 
+ ----------------------------------------------------------------------
+ -- PRESENCE (OR ABSENCE) OF AN EXPLICIT "IN" MODE
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           PROCEDURE ACT_PROC (PARM : INTEGER) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM : IN INTEGER);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (1);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           SUBPRG_ACT := FALSE;
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED
+                      ("PRESENCE OF AN EXPLICIT 'IN' MODE MADE MATCH " &
+                      "INVALID");
+           END IF;
+      END;
+ 
+ ----------------------------------------------------------------------
+ -- DIFFERENT TYPE MARKS
+ ----------------------------------------------------------------------
+ 
+      DECLARE
+ 
+           SUBTYPE MARK_1_TYPE IS INTEGER;
+ 
+           SUBTYPE MARK_2_TYPE IS INTEGER;
+ 
+           PROCEDURE ACT_PROC (PARM1 : IN MARK_1_TYPE) IS
+           BEGIN
+                SUBPRG_ACT := TRUE;
+           END ACT_PROC;
+ 
+           GENERIC
+ 
+                WITH PROCEDURE PASSED_PROC (PARM2 : MARK_2_TYPE);
+ 
+           PROCEDURE GEN_PROC;
+ 
+           PROCEDURE GEN_PROC IS
+           BEGIN
+                PASSED_PROC (1);
+           END GEN_PROC;
+ 
+           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+      BEGIN
+           SUBPRG_ACT := FALSE;
+           INST_PROC;
+           IF NOT SUBPRG_ACT THEN
+                FAILED ("DIFFERENT TYPE MARKS MADE MATCH INVALID");
+           END IF;
+      END;
+      RESULT;
+ END CC3605A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3606a.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3606a.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3606a.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3606a.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- CC3606A.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT THE DEFAULT EXPRESSIONS OF A FORMAL SUBPROGRAM'S
+ --     FORMAL PARAMETERS ARE USED WHEN THE FORMAL SUBPROGRAM IS
+ --     CALLED IN THE INSTANTIATED UNIT (RATHER THAN ANY DEFAULT
+ --     ASSOCIATED WITH ACTUAL SUBPROGRAM'S PARAMETERS).
+ 
+ -- HISTORY:
+ --     BCB 09/29/87  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3606A IS
+ 
+      X : BOOLEAN;
+      Y : BOOLEAN;
+ 
+      FUNCTION FUNC (A : INTEGER := 35) RETURN BOOLEAN IS
+      BEGIN
+           RETURN (A = 7);
+      END FUNC;
+ 
+      PROCEDURE PROC (B : INTEGER := 35) IS
+      BEGIN
+           IF B /= 7 THEN
+                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                        "PROCEDURE NOT USED - 1");
+           END IF;
+      END PROC;
+ 
+      FUNCTION FUNC1 (C : INTEGER := 35) RETURN BOOLEAN IS
+      BEGIN
+           RETURN (C = 7);
+      END FUNC1;
+ 
+      PROCEDURE PROC3 (D : INTEGER := 35) IS
+      BEGIN
+           IF D /= 7 THEN
+                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                        "PROCEDURE NOT USED - 2");
+           END IF;
+      END PROC3;
+ 
+      GENERIC
+           WITH FUNCTION FUNC (A : INTEGER := 7) RETURN BOOLEAN;
+      FUNCTION GENFUNC RETURN BOOLEAN;
+ 
+      FUNCTION GENFUNC RETURN BOOLEAN IS
+      BEGIN
+           IF NOT FUNC THEN
+                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                        "FUNCTION NOT USED - 1");
+           END IF;
+           RETURN TRUE;
+      END GENFUNC;
+ 
+      GENERIC
+           WITH PROCEDURE PROC (B : INTEGER := 7);
+      PACKAGE PKG IS
+      END PKG;
+ 
+      PACKAGE BODY PKG IS
+      BEGIN
+           PROC;
+      END PKG;
+ 
+      GENERIC
+           WITH FUNCTION FUNC1 (C : INTEGER := 7) RETURN BOOLEAN;
+      PROCEDURE PROC2;
+ 
+      PROCEDURE PROC2 IS
+      BEGIN
+           IF NOT FUNC1 THEN
+                FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                        "FUNCTION NOT USED - 2");
+           END IF;
+      END PROC2;
+ 
+      GENERIC
+           WITH PROCEDURE PROC3 (D : INTEGER := 7) IS <>;
+      FUNCTION GENFUNC1 RETURN BOOLEAN;
+ 
+      FUNCTION GENFUNC1 RETURN BOOLEAN IS
+      BEGIN
+           PROC3;
+           RETURN TRUE;
+      END GENFUNC1;
+ 
+      FUNCTION NEWFUNC IS NEW GENFUNC(FUNC);
+ 
+      PACKAGE PACK IS NEW PKG(PROC);
+ 
+      PROCEDURE PROC4 IS NEW PROC2(FUNC1);
+ 
+      FUNCTION NEWFUNC1 IS NEW GENFUNC1;
+ 
+ BEGIN
+ 
+      TEST ("CC3606A", "CHECK THAT THE DEFAULT EXPRESSIONS OF A " &
+                       "FORMAL SUBPROGRAM'S FORMAL PARAMETERS ARE " &
+                       "USED WHEN THE FORMAL SUBPROGRAM IS CALLED IN " &
+                       "THE INSTANTIATED UNIT (RATHER THAN ANY " &
+                       "DEFAULT ASSOCIATED WITH ACTUAL SUBPROGRAM'S " &
+                       "PARAMETERS)");
+ 
+      X := NEWFUNC;
+      Y := NEWFUNC1;
+      PROC4;
+ 
+      RESULT;
+ END CC3606A;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3606b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3606b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3606b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3606b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,134 ----
+ -- CC3606B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT ANY CONSTRAINTS SPECIFIED FOR THE ACTUAL
+ --     SUBPROGRAM'S PARAMETERS ARE USED IN PLACE OF THOSE
+ --     ASSOCIATED WITH THE FORMAL SUBPROGRAM'S PARAMETERS
+ --     (INCLUDING PARAMETERS SPECIFIED WITH A FORMAL GENERIC TYPE).
+ 
+ -- HISTORY:
+ --     LDC  06/30/88 CREATED ORIGINAL TEST.
+ --     PWN  05/31/96 Corrected spelling problems.
+ 
+ WITH REPORT; USE REPORT;
+ 
+ PROCEDURE CC3606B IS
+ 
+      SUBTYPE ONE_TO_TEN IS
+           INTEGER RANGE IDENT_INT (1) .. IDENT_INT (10);
+      SUBTYPE ONE_TO_FIVE IS
+           INTEGER RANGE IDENT_INT (1) .. IDENT_INT (5);
+ 
+ BEGIN
+      TEST ( "CC3606B", "CHECK THAT ANY CONSTRAINTS SPECIFIED FOR " &
+                        "THE ACTUAL SUBPROGRAM'S PARAMETERS ARE USED " &
+                        "IN PLACE OF THOSE ASSOCIATED WITH THE " &
+                        "FORMAL SUBPROGRAM'S PARAMETERS (INCLUDING " &
+                        "PARAMETERS SPECIFIED WITH A FORMAL GENERIC " &
+                        "TYPE)");
+      DECLARE
+           GENERIC
+                BRIAN : IN OUT INTEGER;
+                WITH PROCEDURE PASSED_PROC(LYNN :IN OUT ONE_TO_TEN);
+           PACKAGE GEN IS
+           END GEN;
+ 
+           DOUG : INTEGER := 10;
+ 
+           PACKAGE BODY GEN IS
+           BEGIN
+                PASSED_PROC(BRIAN);
+                FAILED("WRONG CONSTRAINTS FOR ACTUAL PARAMETER IN GEN");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("OTHER EXCEPTION WAS RAISED FOR ACTUAL " &
+                            "PARAMETER");
+           END GEN;
+ 
+           PROCEDURE PROC(JODIE : IN OUT ONE_TO_FIVE) IS
+                JOHN : ONE_TO_TEN;
+           BEGIN
+                JOHN := IDENT_INT(JODIE);
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
+           END PROC;
+ 
+           PACKAGE GEN_PCK IS NEW GEN( DOUG, PROC);
+ 
+      BEGIN
+           NULL;
+      END;
+      DECLARE
+           TYPE ENUM IS (DAYTON, BEAVERCREEK, CENTERVILLE, ENGLEWOOD,
+                         FAIRBORN, HUBER_HEIGHTS, KETTERING, MIAMISBURG,
+                         OAKWOOD, RIVERSIDE, TROTWOOD, WEST_CARROLLTON,
+                         VANDALIA);
+           SUBTYPE SUB_ENUM IS ENUM RANGE  CENTERVILLE..FAIRBORN;
+ 
+           GENERIC
+                TYPE T_TYPE IS (<>);
+                BRIAN : T_TYPE;
+                WITH FUNCTION PASSED_FUNC(LYNN : T_TYPE)
+                     RETURN T_TYPE;
+ 
+           PACKAGE GEN_TWO IS
+           END GEN_TWO;
+ 
+           DOUG : ENUM := ENUM'FIRST;
+ 
+           PACKAGE BODY GEN_TWO IS
+ 
+           DAVE : T_TYPE;
+ 
+           BEGIN
+                DAVE := PASSED_FUNC(BRIAN);
+                FAILED("WRONG CONSTRAINTS FOR ACTUAL PARAMETER IN " &
+                       "GEN_TWO");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED("OTHER EXCEPTION WAS " &
+                            "RAISED FOR ACTUAL " &
+                            "PARAMETER");
+           END GEN_TWO;
+ 
+           FUNCTION FUNC(JODIE : SUB_ENUM) RETURN SUB_ENUM IS
+           BEGIN
+                RETURN ENUM'VAL(IDENT_INT(ENUM'POS(JODIE)));
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
+           END FUNC;
+ 
+           PACKAGE GEN_PCK_TWO IS NEW GEN_TWO( ENUM, DOUG, FUNC);
+ 
+      BEGIN
+           RESULT;
+      END;
+ END CC3606B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3607b.ada gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3607b.ada
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc3607b.ada	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc3607b.ada	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,79 ----
+ -- CC3607B.ADA
+ 
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ -- OBJECTIVE:
+ --     CHECK THAT WHEN A DEFAULT SUBPROGRAM IS SPECIFIED WITH A BOX, A
+ --     SUBPROGRAM DIRECTLY VISIBLE AT THE POINT OF INSTANTIATION
+ --     IS USED.
+ 
+ -- HISTORY:
+ --     LDC 08/23/88  CREATED ORIGINAL TEST.
+ 
+ WITH REPORT; USE REPORT;
+ PROCEDURE CC3607B IS
+ 
+ BEGIN
+      TEST ("CC3607B", "CHECK THAT WHEN A DEFAULT SUBPROGRAM IS " &
+                       "SPECIFIED WITH A BOX, A SUBPROGRAM DIRECTLY " &
+                       "VISIBLE AT THE POINT OF INSTANTIATION IS USED");
+      DECLARE
+           PACKAGE PROC_PACK IS
+                PROCEDURE PROC;
+ 
+                GENERIC
+                     WITH PROCEDURE PROC IS <>;
+                PACKAGE GEN_PACK IS
+                     PROCEDURE DO_PROC;
+                END GEN_PACK;
+           END PROC_PACK;
+           USE PROC_PACK;
+ 
+           PACKAGE BODY PROC_PACK IS
+                PROCEDURE PROC IS
+                BEGIN
+                     FAILED("WRONG SUBPROGRAM WAS USED");
+                END PROC;
+ 
+                PACKAGE BODY GEN_PACK IS
+                     PROCEDURE DO_PROC IS
+                     BEGIN
+                          PROC;
+                     END DO_PROC;
+                END GEN_PACK;
+           END PROC_PACK;
+ 
+           PROCEDURE PROC IS
+           BEGIN
+                COMMENT ("SUBPROGRAM VISIBLE AT INSTANTIATION WAS " &
+                         "USED");
+           END PROC;
+ 
+           PACKAGE NEW_PACK IS NEW GEN_PACK;
+ 
+      BEGIN
+           NEW_PACK.DO_PROC;
+      END;
+ 
+      RESULT;
+ END CC3607B;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc40001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc40001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc40001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc40001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,403 ----
+ -- CC40001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that adjust is called on the value of a constant object created
+ --      by the evaluation of a generic association for a formal object of
+ --      mode in.
+ --
+ --      Check that those values are also subsequently finalized.
+ --
+ -- TEST DESCRIPTION:
+ --      Create a backdrop of a controlled type sufficient to check that the
+ --      correct operations get called at appropriate times.  Create a generic
+ --      unit that takes a formal parameter of a formal type.  Create instances
+ --      of this generic using various "levels" of the controlled type.  Check
+ --      the same case for a generic child unit.
+ --
+ --      The cases tested are where the type of the formal object is:
+ --        a visible classwide type  : CC40001_2
+ --        a formal private type     : CC40001_3
+ --        a formal tagged type      : CC40001_4
+ --
+ --      To more fully take advantage of the features of the language, and
+ --      present a test which is "user oriented" this test utilizes multiple
+ --      aspects of the language in combination.  Using Ada.Strings.Unbounded
+ --      in combination with Ada.Finalization and Ada.Calendar to build layers
+ --      of an object oriented system will likely be very common in actual
+ --      practice.  A common paradigm in the language will also be the use of
+ --      a parent package defining "basic" tagged types, and child packages
+ --      will expand on those types via derivation.  The model used in this
+ --      test is a simple type containing a character identity (used in the
+ --      identity).  The next level of type add a timestamp.  Further levels
+ --      might add location information, etc. however for the purposes of this
+ --      test we stop at the second layer, as it is sufficient to test the
+ --      stated objective.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 FEB 96   SAIC   Initial version
+ --      30 APR 96   SAIC   Added finalization checks for 2.1
+ --      13 FEB 97   PWB.CTA  Moved global objects into bodies, after Initialize
+ --                         body is elaborated; counted finalizations correctly.
+ --!
+ 
+ ----------------------------------------------------------------- CC40001_0
+ 
+ with Ada.Finalization;
+ with Ada.Strings.Unbounded;
+ package CC40001_0 is
+ 
+   type States is ( Erroneous, Defaulted, Initialized, Reset, Adjusted );
+ 
+   type Simple_Object(ID: Character) is
+     new Ada.Finalization.Controlled with
+       record
+         TC_Current_State : States := Defaulted;
+         Name : Ada.Strings.Unbounded.Unbounded_String;
+       end record;
+ 
+   procedure User_Operation( COB: in out Simple_Object; Name : String );
+   procedure Initialize( COB: in out Simple_Object );
+   procedure Adjust    ( COB: in out Simple_Object );
+   procedure Finalize  ( COB: in out Simple_Object );
+ 
+   Finalization_Count : Natural;
+ 
+ end CC40001_0;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with TCTouch;
+ package body CC40001_0 is
+ 
+   procedure User_Operation( COB: in out Simple_Object; Name : String ) is
+   begin
+     COB.Name := Ada.Strings.Unbounded.To_Unbounded_String(Name);
+   end User_Operation;
+ 
+   procedure Initialize( COB: in out Simple_Object ) is
+   begin
+     COB.TC_Current_State := Initialized;
+   end Initialize;
+ 
+   procedure Adjust    ( COB: in out Simple_Object ) is
+   begin
+     COB.TC_Current_State := Adjusted;
+     TCTouch.Touch('A');  -------------------------------------------------- A
+     TCTouch.Touch(COB.ID); ------------------------------------------------ ID
+     -- note that the calls to touch will not be directly validated, it is
+     -- expected that some number > 0 of calls will be made to this procedure,
+     -- the subtests then clear (Flush) the Touch buffer and perform actions
+     -- where an incorrect implementation might call this procedure.  Such a
+     -- call will fail on the attempt to "Validate" the null string.
+   end Adjust;
+ 
+   procedure Finalize  ( COB: in out Simple_Object ) is
+   begin
+     COB.TC_Current_State := Erroneous;
+     Finalization_Count := Finalization_Count +1;
+   end Finalize;
+ 
+   TC_Global_Object : Simple_Object('G');
+ 
+ end CC40001_0;
+ 
+ ----------------------------------------------------------------- CC40001_1
+ 
+ with Ada.Calendar;
+ package CC40001_0.CC40001_1 is
+ 
+   type Object_In_Time(ID: Character) is
+     new Simple_Object(ID) with
+       record
+         Birth : Ada.Calendar.Time;
+         Activity : Ada.Calendar.Time;
+       end record;
+ 
+   procedure User_Operation( COB: in out Object_In_Time;
+                            Name: String );
+ 
+   procedure Initialize( COB: in out Object_In_Time );
+   procedure Adjust    ( COB: in out Object_In_Time );
+   procedure Finalize  ( COB: in out Object_In_Time );
+ 
+ end CC40001_0.CC40001_1;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ with TCTouch;
+ package body CC40001_0.CC40001_1 is
+ 
+   procedure Initialize( COB: in out Object_In_Time ) is
+   begin
+     COB.TC_Current_State := Initialized;
+     COB.Birth := Ada.Calendar.Clock;
+   end Initialize;
+ 
+   procedure Adjust    ( COB: in out Object_In_Time ) is
+   begin
+     COB.TC_Current_State := Adjusted;
+     TCTouch.Touch('a');    ------------------------------------------------ a
+     TCTouch.Touch(COB.ID); ------------------------------------------------ ID
+   end Adjust;
+ 
+   procedure Finalize  ( COB: in out Object_In_Time ) is
+   begin
+     COB.TC_Current_State := Erroneous;
+     Finalization_Count := Finalization_Count +1;
+   end Finalize;
+ 
+   procedure User_Operation( COB: in out Object_In_Time;
+                            Name: String ) is
+   begin
+     CC40001_0.User_Operation( Simple_Object(COB), Name );
+     COB.Activity := Ada.Calendar.Clock;
+     COB.TC_Current_State := Reset;
+   end User_Operation;
+ 
+   TC_Time_Object  : Object_In_Time('g');
+ 
+ end CC40001_0.CC40001_1;
+ 
+ ----------------------------------------------------------------- CC40001_2
+ 
+ generic
+   TC_Check_Object : in CC40001_0.Simple_Object'Class;
+ package CC40001_0.CC40001_2 is
+   procedure TC_Verify_State;
+ end CC40001_0.CC40001_2;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body CC40001_0.CC40001_2 is
+ 
+   procedure TC_Verify_State is
+   begin
+     if TC_Check_Object.TC_Current_State /= Adjusted then
+       Report.Failed( "CC40001_2 : Formal Object not adjusted" );
+     end if;
+   end TC_Verify_State;
+ 
+ end CC40001_0.CC40001_2;
+ 
+ ----------------------------------------------------------------- CC40001_3
+ 
+ generic
+   type Formal_Private(<>) is private;
+   TC_Check_Object : in Formal_Private;
+   with function Bad_Status( O: Formal_Private ) return Boolean;
+ package CC40001_0.CC40001_3 is
+   procedure TC_Verify_State;
+ end CC40001_0.CC40001_3;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body CC40001_0.CC40001_3 is
+ 
+   procedure TC_Verify_State is
+   begin
+     if Bad_Status( TC_Check_Object ) then
+       Report.Failed( "CC40001_3 : Formal Object not adjusted" );
+     end if;
+   end TC_Verify_State;
+ 
+ end CC40001_0.CC40001_3;
+ 
+ ----------------------------------------------------------------- CC40001_4
+ 
+ generic
+   type Formal_Tagged_Private(<>) is tagged private; 
+   TC_Check_Object : in Formal_Tagged_Private;
+   with function Bad_Status( O: Formal_Tagged_Private ) return Boolean;
+ package CC40001_0.CC40001_4 is
+   procedure TC_Verify_State;
+ end CC40001_0.CC40001_4;
+ 
+ -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+ 
+ with Report;
+ package body CC40001_0.CC40001_4 is
+ 
+   procedure TC_Verify_State is
+   begin
+     if Bad_Status( TC_Check_Object ) then
+       Report.Failed( "CC40001_4 : Formal Object not adjusted" );
+     end if;
+   end TC_Verify_State;
+ 
+ end CC40001_0.CC40001_4;
+ 
+ ------------------------------------------------------------------- CC40001
+ 
+ with Report;
+ with TCTouch;
+ with CC40001_0.CC40001_1;
+ with CC40001_0.CC40001_2;
+ with CC40001_0.CC40001_3;
+ with CC40001_0.CC40001_4;
+ procedure CC40001 is
+ 
+   function Not_Adjusted( CO : CC40001_0.Simple_Object )
+     return Boolean is
+      use type CC40001_0.States;
+   begin
+     return CO.TC_Current_State /= CC40001_0.Adjusted;
+   end Not_Adjusted;
+ 
+   function Not_Adjusted( CO : CC40001_0.CC40001_1.Object_In_Time )
+     return Boolean is
+      use type CC40001_0.States;
+   begin
+     return CO.TC_Current_State /= CC40001_0.Adjusted;
+   end Not_Adjusted;
+ 
+    -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 1
+ 
+   procedure Subtest_1 is
+     Object_0 : CC40001_0.Simple_Object('T');
+     Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
+ 
+     package Subtest_1_1 is
+       new CC40001_0.CC40001_2( Object_0 ); -- classwide generic formal object
+ 
+     package Subtest_1_2 is
+       new CC40001_0.CC40001_2( Object_1 ); -- classwide generic formal object
+   begin
+     TCTouch.Flush;  -- clear out all "A" and "T" entries, no further calls
+                     -- to Touch should occur before the call to Validate
+ 
+     -- set the objects TC_Current_State to "Reset"
+     CC40001_0.User_Operation( Object_0, "Subtest 1" );
+     CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 1" );
+ 
+     -- check that the objects TC_Current_State is "Adjusted"
+     Subtest_1_1.TC_Verify_State;
+     Subtest_1_2.TC_Verify_State;
+ 
+     TCTouch.Validate( "", "No actions should occur here, subtest 1" );
+ 
+   end Subtest_1;
+ 
+    -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 2
+ 
+   procedure Subtest_2 is
+     Object_0 : CC40001_0.Simple_Object('T');
+     Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
+ 
+     package Subtest_2_1 is -- generic formal object is discriminated private
+       new CC40001_0.CC40001_3( CC40001_0.Simple_Object,
+                                Object_0,
+                                Not_Adjusted );
+ 
+     package Subtest_2_2 is -- generic formal object is discriminated private
+       new CC40001_0.CC40001_3( CC40001_0.CC40001_1.Object_In_Time,
+                                Object_1,
+                                Not_Adjusted );
+ 
+   begin
+     TCTouch.Flush;  -- clear out all "A" and "T" entries
+ 
+     -- set the objects state to "Reset"
+     CC40001_0.User_Operation( Object_0, "Subtest 2" );
+     CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 2" );
+ 
+     Subtest_2_1.TC_Verify_State;
+     Subtest_2_2.TC_Verify_State;
+ 
+     TCTouch.Validate( "", "No actions should occur here, subtest 2" );
+ 
+   end Subtest_2;
+ 
+    -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 3
+ 
+   procedure Subtest_3 is
+     Object_0 : CC40001_0.Simple_Object('T');
+     Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
+ 
+     package Subtest_3_1 is -- generic formal object is discriminated tagged
+       new CC40001_0.CC40001_4( CC40001_0.Simple_Object,
+                                Object_0,
+                                Not_Adjusted );
+ 
+     package Subtest_3_2 is -- generic formal object is discriminated tagged
+       new CC40001_0.CC40001_4( CC40001_0.CC40001_1.Object_In_Time,
+                                Object_1,
+                                Not_Adjusted );
+   begin
+     TCTouch.Flush;  -- clear out all "A" and "T" entries
+ 
+     -- set the objects state to "Reset"
+     CC40001_0.User_Operation( Object_0, "Subtest 3" );
+     CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 3" );
+ 
+     Subtest_3_1.TC_Verify_State;
+     Subtest_3_2.TC_Verify_State;
+ 
+     TCTouch.Validate( "", "No actions should occur here, subtest 3" );
+ 
+   end Subtest_3;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("CC40001", "Check that adjust and finalize are called on " &
+                           "the constant object created by the " &
+                           "evaluation of a generic association for a " &
+                           "formal object of mode in" );
+ 
+   -- check that the created constant objects are properly adjusted
+   -- and subsequently finalized
+ 
+   CC40001_0.Finalization_Count := 0;
+ 
+   Subtest_1;
+ 
+   if CC40001_0.Finalization_Count < 4 then
+     Report.Failed("Insufficient Finalizations for Subtest 1");
+   end if;
+ 
+   CC40001_0.Finalization_Count := 0;
+ 
+   Subtest_2;
+ 
+   if CC40001_0.Finalization_Count < 4 then
+     Report.Failed("Insufficient Finalizations for Subtest 2");
+   end if;
+ 
+   CC40001_0.Finalization_Count := 0;
+ 
+   Subtest_3;
+ 
+   if CC40001_0.Finalization_Count < 4 then
+     Report.Failed("Insufficient Finalizations for Subtest 3");
+   end if;
+ 
+   Report.Result;
+ 
+ end CC40001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc50001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc50001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc50001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc50001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,257 ----
+ -- CC50001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, in an instance, each implicit declaration of a predefined
+ --      operator of a formal tagged private type declares a view of the
+ --      corresponding predefined operator of the actual type (even if the
+ --      operator has been overridden for the actual type). Check that the
+ --      body executed is determined by the type and tag of the operands.
+ --
+ -- TEST DESCRIPTION:
+ --      The formal tagged private type has an unknown discriminant part, and
+ --      is thus indefinite. This allows both definite and indefinite types
+ --      to be passed as actuals. For tagged types, definite implies
+ --      nondiscriminated, and indefinite implies discriminated (with known
+ --      or unknown discriminants).
+ --
+ --      Only nonlimited tagged types are tested, since equality operators
+ --      are not predefined for limited types. 
+ --
+ --      A tagged type is passed as an actual to a generic formal tagged
+ --      private type. The tagged type overrides the predefined equality
+ --      operator. A subprogram within the generic calls the equality operator
+ --      of the formal type. In an instance, the equality operator denotes
+ --      a view of the predefined operator of the actual type, but the
+ --      call dispatches to the body of the overriding operator.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected expected result on
+ --                          calls to "=" within the instance. Modified
+ --                          commentary.
+ --
+ --!
+ 
+ package CC50001_0 is
+ 
+    type Count_Type is tagged record                     -- Nondiscriminated
+       Count : Integer := 0;                             -- tagged type.
+    end record;
+ 
+    function "="(Left, Right : Count_Type)               -- User-defined
+      return Boolean;                                    -- equality operator.
+ 
+ 
+    subtype Str_Len is Natural range 0 .. 100;
+    subtype Stu_ID  is String (1 .. 5);
+    subtype Dept_ID is String (1 .. 4);
+    subtype Emp_ID  is String (1 .. 9);
+    type    Status   is (Student, Faculty, Staff);
+ 
+    type Person_Type (Stat : Status;                     -- Discriminated
+                      NameLen, AddrLen : Str_Len) is     -- tagged type.
+      tagged record                                 
+       Name    : String (1 .. NameLen);
+       Address : String (1 .. AddrLen);
+       case Stat is
+          when Student =>
+             Student_ID  : Stu_ID;
+          when Faculty =>
+             Department  : Dept_ID;
+          when Staff   =>
+             Employee_ID : Emp_ID;
+       end case;
+    end record;
+ 
+    function "="(Left, Right : Person_Type)              -- User-defined
+      return Boolean;                                    -- equality operator.
+ 
+ 
+    -- Testing entities: ------------------------------------------------
+ 
+    TC_Count_Item     : constant Count_Type  := (Count => 111);
+ 
+    TC_Person_Item    : constant Person_Type :=
+      (Faculty, 18, 17, "Eccles, John Scott", "Popham House, Lee", "0931");
+ 
+    ---------------------------------------------------------------------
+ 
+ 
+ end CC50001_0;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body CC50001_0 is
+ 
+    function "="(Left, Right : Count_Type) return Boolean is
+    begin
+       return False;   -- Return FALSE even if Left = Right.
+    end "=";
+ 
+ 
+    function "="(Left, Right : Person_Type) return Boolean is
+    begin
+       return False;   -- Return FALSE even if Left = Right.
+    end "=";
+ 
+ end CC50001_0;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with CC50001_0;  -- Tagged (actual) type declarations.
+ generic        -- Generic stack abstraction.
+ 
+    type Item (<>) is tagged private;            -- Formal tagged private type.
+ 
+ package CC50001_1 is
+ 
+    -- Simulate a generic stack abstraction. In a real application, the
+    -- second operand of Push might be of type Stack, and type Stack
+    -- would have at least one component (pointing to the top stack item).
+ 
+    type Stack is private;
+ 
+    procedure Push (I : in Item; TC_Check : out Boolean);
+ 
+    -- ... Other stack operations.
+ 
+ private
+ 
+    -- ... Stack and ancillary type declarations.
+ 
+    type Stack is record                       -- Artificial.
+       null;
+    end record;
+ 
+ end CC50001_1;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body CC50001_1 is
+ 
+    -- For the sake of brevity, the implementation of Push is completely
+    -- artificial; the goal is to model a call of the equality operator within
+    -- the generic.
+    --
+    -- A real application might implement Push such that it does not add new
+    -- items to the stack if they are identical to the top item; in that
+    -- case, the equality operator would be called as part of an "if"
+    -- condition.
+ 
+    procedure Push (I : in Item; TC_Check : out Boolean) is
+    begin
+       TC_Check := not (I = I);              -- Call user-defined "="; should
+                                             -- return FALSE. Negation of
+                                             -- result makes TC_Check TRUE.
+    end Push;
+ 
+ end CC50001_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC50001_0;  -- Tagged (actual) type declarations.
+ with CC50001_1;  -- Generic stack abstraction.
+ 
+ use  CC50001_0;  -- Overloaded "=" directly visible.
+ 
+ with Report;
+ procedure CC50001 is
+ 
+    package Count_Stacks  is new CC50001_1 (CC50001_0.Count_Type);
+    package Person_Stacks is new CC50001_1 (CC50001_0.Person_Type);
+ 
+    User_Defined_Op_Called : Boolean;
+ 
+ begin
+    Report.Test ("CC50001", "Check that, in an instance, each implicit "     &
+                 "declaration of a primitive subprogram of a formal tagged " &
+                 "private type declares a view of the corresponding "        &
+                 "predefined operator of the actual type (even if the "      &
+                 "operator has been overridden or hidden for the actual type)");
+ 
+ --
+ -- Test which "=" is called inside generic:
+ --
+ 
+    User_Defined_Op_Called := False;
+ 
+    Count_Stacks.Push (CC50001_0.TC_Count_Item,
+                       User_Defined_Op_Called);
+ 
+ 
+    if not User_Defined_Op_Called then
+       Report.Failed ("User-defined ""="" not called inside generic for Count");
+    end if;
+ 
+ 
+    User_Defined_Op_Called := False;
+ 
+    Person_Stacks.Push (CC50001_0.TC_Person_Item,
+                        User_Defined_Op_Called);
+ 
+    if not User_Defined_Op_Called then
+       Report.Failed ("User-defined ""="" not called inside generic " &
+                      "for Person");
+    end if;
+ 
+ 
+ --
+ -- Test which "=" is called outside generic:
+ --
+ 
+    User_Defined_Op_Called := False;
+ 
+    User_Defined_Op_Called :=
+      not (CC50001_0.TC_Count_Item = CC50001_0.TC_Count_Item);
+ 
+    if not User_Defined_Op_Called then
+       Report.Failed ("User-defined ""="" not called outside generic "&
+                      "for Count");
+    end if;
+ 
+ 
+    User_Defined_Op_Called := False;
+ 
+    User_Defined_Op_Called :=
+      not (CC50001_0.TC_Person_Item = CC50001_0.TC_Person_Item);
+ 
+    if not User_Defined_Op_Called then
+       Report.Failed ("User-defined ""="" not called outside generic "&
+                      "for Person");
+    end if;
+ 
+ 
+    Report.Result;
+ end CC50001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc50a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc50a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc50a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc50a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,313 ----
+ -- CC50A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a formal parameter of a library-level generic unit may be
+ --      a formal tagged private type. Check that a nonlimited tagged type may
+ --      be passed as an actual. Check that if the formal type is indefinite,
+ --      both indefinite and definite types may be passed as actuals.
+ --
+ -- TEST DESCRIPTION:
+ --      The generic package declares a formal tagged private type (this can
+ --      be considered the parent "mixin" class). This type is extended in
+ --      the generic to provide support for stacks of items of any nonlimited
+ --      tagged type. Stacks are modeled as singly linked lists, with the list
+ --      nodes being objects of the extended type.
+ --
+ --      A generic testing procedure pushes items onto a stack, and pops them
+ --      back off, verifying the state of the stack at various points along the
+ --      way. The push and pop routines exercise functionality important to
+ --      tagged types, such as type conversion toward the root of the derivation
+ --      class and extension aggregates.
+ --
+ --      The formal tagged private type has an unknown discriminant part, and
+ --      is thus indefinite. This allows both definite and indefinite types
+ --      to be passed as actuals. For tagged types, definite implies
+ --      nondiscriminated, and indefinite implies discriminated (with known
+ --      or unknown discriminants). 
+ --
+ -- TEST FILES:
+ --      This test consists of the following files:
+ --
+ --         FC50A00.A
+ --      -> CC50A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      21 Nov 95   SAIC    ACVC 2.0.1 fixes: Moved instantiations of
+ --                          BC50A01_0 to library level.
+ --      11 Aug 96   SAIC    ACVC 2.1: Updated prologue. Added pragma
+ --                          Elaborate to context clauses for CC50A01_2 & _3.
+ --
+ --!
+ 
+ with FC50A00;  -- Tagged (actual) type declarations.
+ generic        -- Generic stack abstraction.
+ 
+    type Item (<>) is tagged private;            -- Formal tagged private type.
+    TC_Default_Value : Item;                     -- Needed in View_Top (see
+                                                 -- below).
+ package CC50A01_0 is
+ 
+    type Stack is private;
+ 
+ -- Note that because the actual type corresponding to Item may be
+ -- unconstrained, the functions of removing the top item from the stack and
+ -- returning the value of the top item of the stack have been separated into
+ -- Pop and View_Top, respectively. This is necessary because otherwise the
+ -- returned value would have to be an out parameter of Pop, which would
+ -- require the user (in the unconstrained case) to create an uninitialized
+ -- unconstrained object to serve as the actual, which is illegal.
+ 
+    procedure Push     (I : in Item; S : in out Stack);
+    procedure Pop      (S : in out Stack);
+    function  View_Top (S : Stack) return Item;
+ 
+    function Size_Of (S : Stack) return Natural;
+ 
+ private
+ 
+    type Stack_Item;
+    type Stack_Ptr is access Stack_Item;
+ 
+    type Stack_Item is new Item with record      -- Extends formal type.
+       Next : Stack_Ptr := null;
+    end record;
+ 
+    type Stack is record
+       Top  : Stack_Ptr := null;
+       Size : Natural   := 0;
+    end record;
+ 
+ end CC50A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC50A01_0 is
+ 
+    -- Link NewItem in at the top of the stack (the extension aggregate within
+    -- the allocator initializes the inherited portion of NewItem to equal I,
+    -- and NewItem.Next to point to what S.Top points to).
+ 
+    procedure Push (I : in Item; S : in out Stack) is
+       NewItem : Stack_Ptr;
+    begin
+       NewItem := new Stack_Item'(I with S.Top);     -- Extension aggregate.
+       S.Top   := NewItem;
+       S.Size  := S.Size + 1;
+    end Push;
+ 
+ 
+    -- Remove item from top of stack. This procedure only updates the state of
+    -- the stack; it does not return the value of the popped item. Hence, in
+    -- order to accomplish a "true" pop, both View_Top and Pop must be called
+    -- consecutively.
+    --
+    -- If the stack is empty, the Pop is ignored (for simplicity; in a true
+    -- application this might be treated as an error condition).
+ 
+    procedure Pop (S : in out Stack) is
+    begin
+       if S.Top = null then                          -- Stack is empty.
+          null;
+          -- Raise exception.
+       else
+          S.Top  := S.Top.Next;
+          S.Size := S.Size - 1;
+          -- Deallocate discarded node.
+       end if;
+    end Pop;
+ 
+ 
+    -- Return the value of the top item on the stack. This procedure only
+    -- returns the value; it does not remove the top item from the stack.
+    -- Hence, in order to accomplish a "true" pop, both View_Top and Pop must
+    -- be called consecutively.
+    --
+    -- Since items on the stack are of a type (Stack_Item) derived from Item,
+    -- which is a (tagged) private type, type conversion toward the root is the
+    -- only way to get a value of type Item for return to the caller.
+    --
+    -- If the stack is empty, View_Top returns a pre-specified default value.
+    -- (In a true application, an exception might be raised instead).
+ 
+    function View_Top (S : Stack) return Item is
+    begin
+       if S.Top = null then                          -- Stack is empty.
+          return TC_Default_Value;                   -- Testing artifice.
+          -- Raise exception.
+       else
+          return Item(S.Top.all);                    -- Type conversion.
+       end if;
+    end View_Top;
+ 
+ 
+    function Size_Of (S : Stack) return Natural is
+    begin
+       return (S.Size);
+    end Size_Of;
+ 
+ 
+ end CC50A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- The formal package Stacker below is needed to gain access to the
+ -- appropriate version of the "generic" type Stack. It is provided with an
+ -- explicit actual part in order to restrict the packages that can be passed
+ -- as actuals to those which have been instantiated with the same actuals
+ -- which this generic procedure has been instantiated with.
+ 
+ with CC50A01_0;  -- Generic stack abstraction.
+ generic
+    type Item_Type (<>) is tagged private;       -- Formal tagged private type.
+    Default : Item_Type;
+    with package Stacker is new CC50A01_0 (Item_Type, Default);
+ procedure CC50A01_1 (S : in out Stacker.Stack; I : in Item_Type);
+ 
+ 
+      --==================================================================--
+ 
+ --
+ -- This generic procedure performs all of the testing of the
+ -- stack abstraction.
+ --
+ 
+ with Report;
+ procedure CC50A01_1 (S : in out Stacker.Stack; I : in Item_Type) is
+ begin
+    Stacker.Push (I, S);                    -- Push onto empty stack.
+    Stacker.Push (I, S);                    -- Push onto nonempty stack.
+ 
+    if Stacker.Size_Of (S) /= 2 then
+       Report.Failed ("   Wrong stack size after 2 Pushes");
+    end if;
+ 
+    -- Calls to View_Top must initialize a declared object of type Item_Type
+    -- because the type may be unconstrained.
+ 
+    declare
+       Buffer1 : Item_Type := Stacker.View_Top (S);
+    begin
+       Stacker.Pop (S);                     -- Pop item off nonempty stack.
+       if Buffer1 /= I then
+          Report.Failed ("   Wrong stack item value after 1st Pop");
+       end if;
+    end;
+ 
+    declare
+       Buffer2 : Item_Type := Stacker.View_Top (S);
+    begin
+       Stacker.Pop (S);                     -- Pop last item off stack.
+       if Buffer2 /= I then
+          Report.Failed ("   Wrong stack item value after 2nd Pop");
+       end if;
+    end;
+ 
+    if Stacker.Size_Of (S) /= 0 then
+       Report.Failed ("   Wrong stack size after 2 Pops");
+    end if;
+ 
+    declare
+       Buffer3 : Item_Type := Stacker.View_Top (S);
+    begin
+       if Buffer3 /= Default then
+          Report.Failed ("   Wrong result after Pop of empty stack");
+       end if;
+       Stacker.Pop (S);                     -- Pop off empty stack.
+    end;
+ 
+ end CC50A01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC50A00;
+ 
+ with CC50A01_0;
+ pragma Elaborate (CC50A01_0);
+ 
+ package CC50A01_2 is new CC50A01_0 (FC50A00.Count_Type,
+                                     FC50A00.TC_Default_Count);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC50A00;
+ 
+ with CC50A01_0;
+ pragma Elaborate (CC50A01_0);
+ 
+ package CC50A01_3 is new CC50A01_0 (FC50A00.Person_Type,
+                                     FC50A00.TC_Default_Person);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC50A00;   -- Tagged (actual) type declarations.
+ with CC50A01_0; -- Generic stack abstraction.
+ with CC50A01_1; -- Generic stack testing procedure.
+ with CC50A01_2;
+ with CC50A01_3;
+ 
+ with Report;
+ procedure CC50A01 is
+ 
+    package Count_Stacks  renames CC50A01_2;
+    package Person_Stacks renames CC50A01_3;
+ 
+ 
+    procedure TC_Count_Test is new CC50A01_1 (FC50A00.Count_Type,
+                                              FC50A00.TC_Default_Count,
+                                              Count_Stacks);
+    Count_Stack : Count_Stacks.Stack;
+ 
+  
+    procedure TC_Person_Test is new CC50A01_1 (FC50A00.Person_Type,
+                                               FC50A00.TC_Default_Person,
+                                               Person_Stacks);
+    Person_Stack : Person_Stacks.Stack;
+ 
+ begin
+    Report.Test ("CC50A01", "Check that a formal parameter of a " &
+                 "library-level generic unit may be a formal tagged " &
+                 "private type");
+ 
+    Report.Comment ("Testing definite tagged type..");
+    TC_Count_Test  (Count_Stack,  FC50A00.TC_Count_Item);
+ 
+    Report.Comment ("Testing indefinite tagged type..");
+    TC_Person_Test (Person_Stack, FC50A00.TC_Person_Item);
+ 
+    Report.Result;
+ end CC50A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc50a02.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc50a02.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc50a02.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc50a02.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,227 ----
+ -- CC50A02.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a nonlimited tagged type may be passed as an actual to a
+ --      formal (non-tagged) private type. Check that if the formal type has
+ --      an unknown discriminant part, a class-wide type may also be passed as
+ --      an actual.
+ --
+ -- TEST DESCRIPTION:
+ --      A generic package declares a formal private type and defines a
+ --      stack abstraction. Stacks are modeled as singly linked lists of
+ --      pointers to elements. Pointers are used because the elements may
+ --      be unconstrained.
+ --
+ --      A generic testing procedure pushes an item onto a stack, then views
+ --      the item on top of the stack.
+ --
+ --      The formal private type has an unknown discriminant part, and
+ --      is thus indefinite. This allows both definite and indefinite types
+ --      (including class-wide types) to be passed as actuals. For tagged types,
+ --      definite implies nondiscriminated, and indefinite implies discriminated
+ --      (with known/unknown discriminants). 
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FC50A00.A
+ --      -> CC50A02.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      10 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed use of formal package
+ --                          exception name in exception choice.
+ --
+ --!
+ 
+ generic        -- Generic stack abstraction.
+    type Item (<>) is private;                   -- Formal private type.
+ package CC50A02_0 is
+ 
+    type Stack is private;
+ 
+    procedure Push     (I : in Item; S : in out Stack);
+    function  View_Top (S : Stack) return Item;
+ 
+    -- ...Other stack operations...
+ 
+    Stack_Empty : exception;
+ 
+ private
+ 
+    type Item_Ptr is access Item;
+ 
+    type Stack_Item;
+    type Stack_Ptr is access Stack_Item;
+ 
+    type Stack_Item is record
+       Item : Item_Ptr;
+       Next : Stack_Ptr;
+    end record;
+ 
+    type Stack is record
+       Top  : Stack_Ptr := null;
+       Size : Natural   := 0;
+    end record;
+ 
+ end CC50A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC50A02_0 is
+ 
+    -- Link NewItem in at the top of the stack.
+ 
+    procedure Push (I : in Item; S : in out Stack) is
+       NewItem : Item_Ptr  := new Item'(I);
+       Element : Stack_Ptr := new Stack_Item'(Item => NewItem, Next => S.Top);
+    begin
+       S.Top   := Element;
+       S.Size  := S.Size + 1;
+    end Push;
+ 
+ 
+    -- Return (copy) of top item on stack. Do NOT remove from stack.
+ 
+    function View_Top (S : Stack) return Item is
+    begin
+       if S.Top = null then
+          raise Stack_Empty;
+       else
+          return S.Top.Item.all;
+       end if;
+    end View_Top;
+ 
+ end CC50A02_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- The formal package Stacker below is needed to gain access to the
+ -- appropriate version of the "generic" type Stack. It is provided with an
+ -- explicit actual part in order to restrict the packages that can be passed
+ -- as actuals to those which have been instantiated with the same actuals
+ -- which this generic procedure has been instantiated with.
+ 
+ with CC50A02_0;  -- Generic stack abstraction.
+ generic
+    type Item_Type (<>) is private;       -- Formal private type.
+    with package Stacker is new CC50A02_0 (Item_Type);
+ procedure CC50A02_1 (S : in out Stacker.Stack; I : in Item_Type);
+ 
+ 
+      --==================================================================--
+ 
+ --
+ -- This generic procedure performs all of the testing of the
+ -- stack abstraction.
+ --
+ 
+ with Report;
+ procedure CC50A02_1 (S : in out Stacker.Stack; I : in Item_Type) is
+ begin
+    Stacker.Push (I, S);                    -- Push onto empty stack.
+ 
+    -- Calls to View_Top must initialize a declared object of type Item_Type
+    -- because the type may be unconstrained.
+ 
+    declare
+       Buffer : Item_Type := Stacker.View_Top (S);
+    begin
+       if Buffer /= I then
+          Report.Failed ("   Expected item not on stack");
+       end if;
+    exception
+       when Constraint_Error =>
+          Report.Failed ("   Unexpected error: Tags of pushed and popped " &
+                         "items don't match");
+    end;
+ 
+ 
+ exception
+    when others =>
+       Report.Failed ("   Unexpected error: Item not pushed onto stack");
+ end CC50A02_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC50A00;   -- Tagged (actual) type declarations.
+ with CC50A02_0; -- Generic stack abstraction.
+ with CC50A02_1; -- Generic stack testing procedure.
+ 
+ with Report;
+ procedure CC50A02 is
+ 
+    --
+    -- Pass a nondiscriminated tagged actual:
+    --
+ 
+    package   Count_Stacks  is new CC50A02_0 (FC50A00.Count_Type);
+    procedure TC_Count_Test is new CC50A02_1 (FC50A00.Count_Type,
+                                              Count_Stacks);
+    Count_Stack : Count_Stacks.Stack;
+ 
+ 
+    --
+    -- Pass a discriminated tagged actual:
+    --
+  
+    package   Person_Stacks  is new CC50A02_0 (FC50A00.Person_Type);
+    procedure TC_Person_Test is new CC50A02_1 (FC50A00.Person_Type,
+                                               Person_Stacks);
+    Person_Stack : Person_Stacks.Stack;
+ 
+ 
+    --
+    -- Pass a class-wide actual:
+    --
+  
+    package   People_Stacks  is new CC50A02_0 (FC50A00.Person_Type'Class);
+    procedure TC_People_Test is new CC50A02_1 (FC50A00.Person_Type'Class,
+                                               People_Stacks);
+    People_Stack : People_Stacks.Stack;
+ 
+ begin
+    Report.Test ("CC50A02", "Check that tagged actuals may be passed " &
+                 "to a formal (nontagged) private type");
+ 
+    Report.Comment ("Testing definite tagged type..");
+    TC_Count_Test  (Count_Stack,  FC50A00.TC_Count_Item);
+ 
+    Report.Comment ("Testing indefinite tagged type..");
+    TC_Person_Test (Person_Stack, FC50A00.TC_Person_Item);
+ 
+    Report.Comment ("Testing class-wide type..");
+    TC_People_Test (People_Stack, FC50A00.TC_VIPerson_Item);
+ 
+    Report.Result;
+ end CC50A02;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51001.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51001.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51001.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51001.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,186 ----
+ -- CC51001.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a formal parameter of a generic package may be a formal
+ --      derived type. Check that the formal derived type may have an unknown
+ --      discriminant part. Check that the ancestor type in a formal derived
+ --      type definition may be a tagged type, and that the actual parameter
+ --      may be a descendant of the ancestor type. Check that the formal derived
+ --      type belongs to the derivation class rooted at the ancestor type;
+ --      specifically, that components of the ancestor type may be referenced
+ --      within the generic. Check that if a formal derived subtype is
+ --      indefinite then the actual may be either definite or indefinite.
+ --
+ -- TEST DESCRIPTION:
+ --      Define a class of tagged types with a definite root type. Extend the
+ --      root type with a discriminated component. Since discriminants of
+ --      tagged types may not have defaults, the type is indefinite.
+ --
+ --      Extend the extension with a second discriminated component, but with
+ --      a new discriminant part. Declare a generic package with a formal
+ --      derived type using the root type of the class as ancestor, and an
+ --      unknown discriminant part. Declare an operation in the generic which
+ --      accesses the common component of types in the class.
+ --
+ --      In the main program, instantiate the generic with each type in the
+ --      class and verify that the operation correctly accesses the common
+ --      component.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CC51001_0 is  -- Root type for message class.
+ 
+    subtype Msg_String is String (1 .. 20);
+ 
+    type Msg_Type is tagged record                          -- Root type of
+       Text : Msg_String := (others => ' ');                -- class (definite).
+    end record;
+ 
+ end CC51001_0;
+ 
+ 
+ -- No body for CC51001_0.
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51001_0;       -- Root type for message class.
+ package CC51001_1 is  -- Extensions to message class.
+ 
+    subtype Source_Length is Natural range 0 .. 10;
+ 
+    type From_Msg_Type (SLen : Source_Length) is            -- Direct derivative
+      new CC51001_0.Msg_Type with record                    -- of root type
+       From : String (1 .. SLen);                           -- (indefinite).
+    end record;
+ 
+    subtype Dest_Length is Natural range 0 .. 10;
+ 
+ 
+ 
+    type To_From_Msg_Type (DLen : Dest_Length) is           -- Indirect
+      new From_Msg_Type (SLen => 10) with record            -- derivative of
+       To : String (1 .. DLen);                             -- root type
+    end record;                                             -- (indefinite).
+ 
+ end CC51001_1;
+ 
+ 
+ -- No body for CC51001_1.
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51001_0;       -- Root type for message class.
+ generic               -- I/O operations for message class.
+    type Message_Type (<>) is new CC51001_0.Msg_Type with private;
+ package CC51001_2 is
+ 
+    -- This subprogram contains an artificial result for testing purposes:
+    -- the function returns the text of the message to the caller as a string.
+ 
+    function Print_Message (M : in Message_Type) return String;
+ 
+    -- ... Other operations.
+ 
+ end CC51001_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51001_2 is
+ 
+    -- The implementations of the operations below are purely artificial; the
+    -- validity of their implementations in the context of the abstraction is
+    -- irrelevant to the feature being tested.
+ 
+    function Print_Message (M : in Message_Type) return String is
+    begin
+       return M.Text;
+    end Print_Message;
+ 
+ end CC51001_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51001_0;  -- Root type for message class.
+ with CC51001_1;  -- Extensions to message class.
+ with CC51001_2;  -- I/O operations for message class.
+ 
+ with Report;
+ procedure CC51001 is
+ 
+    -- Instantiate for various types in the class:
+ 
+    package Msgs   is new CC51001_2 (CC51001_0.Msg_Type);         -- Definite.
+    package FMsgs  is new CC51001_2 (CC51001_1.From_Msg_Type);    -- Indefinite.
+    package TFMsgs is new CC51001_2 (CC51001_1.To_From_Msg_Type); -- Indefinite.
+ 
+ 
+ 
+    Msg   : CC51001_0.Msg_Type         := (Text => "This is message #001");
+    FMsg  : CC51001_1.From_Msg_Type    := (Text => "This is message #002",
+                                           SLen => 2,
+                                           From => "Me");
+    TFMsg : CC51001_1.To_From_Msg_Type := (Text => "This is message #003",
+                                           From => "You       ",
+                                           DLen => 4,
+                                           To   => "Them");
+ 
+    Expected_Msg   : constant String := "This is message #001";
+    Expected_FMsg  : constant String := "This is message #002";
+    Expected_TFMsg : constant String := "This is message #003";
+ 
+ begin
+    Report.Test ("CC51001", "Check that the formal derived type may have " &
+                 "an unknown discriminant part. Check that the ancestor " &
+                 "type in a formal derived type definition may be a " &
+                 "tagged type, and that the actual parameter may be any " &
+                 "definite or indefinite descendant of the ancestor type");
+ 
+    if (Msgs.Print_Message (Msg) /= Expected_Msg) then
+       Report.Failed ("Wrong result for definite root type");
+    end if;
+ 
+    if (FMsgs.Print_Message (FMsg) /= Expected_FMsg) then
+       Report.Failed ("Wrong result for direct indefinite derivative");
+    end if;
+ 
+    if (TFMsgs.Print_Message (TFMsg) /= Expected_TFMsg) then
+       Report.Failed ("Wrong result for Indirect indefinite derivative");
+    end if;
+ 
+    Report.Result;
+ end CC51001;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51002.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51002.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51002.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51002.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,198 ----
+ -- CC51002.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, for formal derived tagged types, the formal parameter
+ --      names and default expressions for a primitive subprogram in an
+ --      instance are determined by the primitive subprogram of the ancestor
+ --      type, but that the primitive subprogram body executed is that of the
+ --      actual type.
+ --
+ -- TEST DESCRIPTION:
+ --      Define a root tagged type in a library-level package and give it a
+ --      primitive subprogram. Provide a default expression for a non-tagged
+ --      parameter of the subprogram. Declare a library-level generic subprogram
+ --      with a formal derived type using the root type as ancestor. Call
+ --      the primitive subprogram of the root type using named association for
+ --      the tagged parameter, and provide no actual for the defaulted
+ --      parameter. Extend the root type in a second package and override the
+ --      root type's subprogram with one which has different parameter names
+ --      and no default expression for the non-tagged parameter. Instantiate
+ --      the generic subprogram for each of the tagged types in the class and
+ --      call the instances.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CC51002_0 is  -- Root message type and operations.
+ 
+    type Recipients is (None, Root, Sysop, Local, Remote);
+ 
+    type Msg_Type is tagged record                             -- Root type of
+       Text : String (1 .. 10);                                -- class.
+    end record;
+ 
+    function Send (Msg : in Msg_Type;                          -- Primitive
+                   To  : Recipients := Local) return Boolean;  -- subprogram.
+ 
+    -- ...Other message operations.
+ 
+ end CC51002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51002_0 is
+ 
+    -- The implementation of Send is purely artificial; the validity of
+    -- its implementation in the context of the abstraction is irrelevant to
+    -- the feature being tested.
+ 
+    function Send (Msg : in Msg_Type;
+                   To  : Recipients := Local) return Boolean is
+    begin
+       return (Msg.Text = "Greetings!" and To = Local);
+    end Send;
+ 
+ end CC51002_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51002_0;  -- Root message type and operations.
+ generic          -- Message class function.
+    type Msg_Block is new CC51002_0.Msg_Type with private;
+ function CC51002_1 (M : in Msg_Block) return Boolean;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ function CC51002_1 (M : in Msg_Block) return Boolean is
+    Okay : Boolean := False;
+ begin
+ 
+    -- The call to Send below uses the ancestor type's parameter name, which
+    -- should be legal even if the actual subprogram called does not have a
+    -- parameter of that name. Furthermore, it uses the ancestor type's default
+    -- expression for the second parameter, which should be legal even if the
+    -- the actual subprogram called has no such default expression.
+ 
+    Okay := Send (Msg => M);
+    -- ...Other processing.
+    return Okay;
+ 
+ end CC51002_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51002_0;       -- Root message type and operations.
+ package CC51002_2 is  -- Extended message type and operations.
+ 
+    type Sender_Type is (Inside, Outside);
+ 
+    type Who_Msg_Type is new CC51002_0.Msg_Type with record   -- Derivative of
+       From : Sender_Type;                                    -- root type of
+    end record;                                               -- class.
+ 
+ 
+    -- Note: this overriding version of Send has different parameter names
+    -- from the root type's function. It also has no default expression.
+ 
+    function Send (M : Who_Msg_Type;                          -- Overrides
+                   R : CC51002_0.Recipients) return Boolean;  -- root type's
+                                                              -- operation.
+    -- ...Other extended message operations.
+ 
+ end CC51002_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51002_2 is
+ 
+    -- The implementation of Send is purely artificial; the validity of
+    -- its implementation in the context of the abstraction is irrelevant to
+    -- the feature being tested.
+ 
+    function Send (M : Who_Msg_Type; R : CC51002_0.Recipients) return Boolean is
+       use type CC51002_0.Recipients;
+    begin
+       return (M.Text = "Willkommen"     and
+               M.From = Outside          and
+               R      = CC51002_0.Local);
+    end Send;
+ 
+ end CC51002_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51002_0;  -- Root message type and operations.
+ with CC51002_1;  -- Message class function.
+ with CC51002_2;  -- Extended message type and operations.
+ 
+ with Report;
+ procedure CC51002 is
+ 
+    function Send_Msg  is new CC51002_1 (CC51002_0.Msg_Type);
+    function Send_WMsg is new CC51002_1 (CC51002_2.Who_Msg_Type);
+ 
+    Mess  : CC51002_0.Msg_Type     := (Text => "Greetings!");
+    WMess : CC51002_2.Who_Msg_Type := (Text => "Willkommen",
+                                       From => CC51002_2.Outside);
+ 
+    TC_Okay_MStatus  : Boolean := False;
+    TC_Okay_WMStatus : Boolean := False;
+ 
+ begin
+    Report.Test ("CC51002", "Check that, for formal derived tagged types, " &
+                 "the formal parameter names and default expressions for "  &
+                 "a primitive subprogram in an instance are determined by " &
+                 "the primitive subprogram of the ancestor type, but that " &
+                 "the primitive subprogram body executed is that of the"    &
+                 "actual type");
+ 
+    TC_Okay_MStatus := Send_Msg (Mess);
+    if not TC_Okay_MStatus then
+       Report.Failed ("Wrong result from call to root type's operation");
+    end if;
+ 
+    TC_Okay_WMStatus := Send_WMsg (WMess);
+    if not TC_Okay_WMStatus then
+       Report.Failed ("Wrong result from call to derived type's operation");
+    end if;
+ 
+    Report.Result;
+ end CC51002;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51003.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51003.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51003.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51003.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,187 ----
+ -- CC51003.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the ancestor type of a formal derived type is a composite
+ --      type that is not an array type, the formal type inherits components,
+ --      including discriminants, from the ancestor type.
+ --
+ --      Check for the case where the ancestor type is a record type, and the
+ --      formal derived type is declared in a generic subprogram.
+ --
+ -- TEST DESCRIPTION:
+ --      Define a discriminated record type in a package. Declare a
+ --      library-level generic subprogram with a formal derived type using the
+ --      record type as ancestor. Give the generic subprogram an in out
+ --      parameter of the formal derived type. Inside the generic, use the
+ --      discriminant component and modify the remaining components of the
+ --      record parameter. In the main program, declare record objects with two
+ --      different discriminant values. Derive an indefinite type from the
+ --      record type with a new discriminant part. Instantiate the generic
+ --      subprogram for the root record subtype and the derived subtype. Call
+ --      the root subtype instance with actual parameters having the two
+ --      discriminant values. Also call the derived subtype instance with
+ --      an appropriate actual.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      03 Jan 95   SAIC    Removed unknown discriminant part from formal
+ --                          derived type.
+ --      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed constrained subtype
+ --                          instantiation and associated declarations.
+ --                          Modified commentary.
+ --
+ --!
+ 
+ 
+ -- Simulate a fragment of a matrix manipulation application.
+ 
+ package CC51003_0 is  -- Matrix types.
+ 
+    type Matrix is array (Natural range <>, Natural range <>) of Integer;
+ 
+    type Square (Side : Natural) is record
+       Mat : Matrix (1 .. Side, 1 .. Side);
+    end record;
+ 
+    type Double_Square (Number : Natural) is record
+       Left  : Square (Number);
+       Right : Square (Number);
+    end record;
+ 
+ end CC51003_0;
+ 
+ 
+ -- No body for CC51003_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51003_0;  -- Matrix types.
+ generic          -- Generic double-matrix "clear" operation.
+    type Dbl_Square is new CC51003_0.Double_Square;            -- Indefinite
+ procedure CC51003_1 (Dbl : in out Dbl_Square);                -- formal.
+ 
+ 
+      --==================================================================--
+ 
+ 
+ procedure CC51003_1 (Dbl : in out Dbl_Square) is
+ begin
+    for I in 1 .. Dbl.Number loop     -- Discriminants inherited from ancestor
+       for J in 1 .. Dbl.Number loop  -- type (should work even for derived type
+                                      -- declaring new discriminant part).
+          Dbl.Left.Mat (I, J)  := 0;  -- Other components inherited from
+          Dbl.Right.Mat (I, J) := 0;  -- ancestor type.
+ 
+       end loop;
+    end loop;
+ end CC51003_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51003_0;  -- Matrix types.
+ with CC51003_1;  -- Generic double-matrix "clear" operation.
+ 
+ with Report;
+ procedure CC51003 is
+ 
+    use CC51003_0;  -- "/=" operator directly visible for Double_Square.
+ 
+    -- Matrices of root type:
+ 
+    Mat_2x2      : Square(Side => 2)           := (Side => 2,
+                                                   Mat  => ( (1, 2), (3, 4) ));
+    Dbl_Mat_2x2  : Double_Square(Number => 2)  := (2, Mat_2x2, Mat_2x2);
+ 
+ 
+    Zero_2x2     : constant Square(2)        := (2, Mat => ( (0, 0), (0, 0) ));
+    Expected_2x2 : constant Double_Square(2) := (Number => 2,
+                                                 others => Zero_2x2);
+ 
+ 
+ 
+    Mat_3x3      : Square(Side => 3) := (Side => 3,
+                                         Mat  => (1      => (1, 4, 9),
+                                                  others => (1      => 5,
+                                                             others => 7)));
+    Dbl_Mat_3x3  : Double_Square(3)  := (Number => 3, others => Mat_3x3);
+ 
+ 
+    Zero_3x3     : constant Square(3) := (3, Mat => (others => (0,0,0)));
+    Expected_3x3 : constant Double_Square(Number => 3) :=
+                                         (3, Zero_3x3, Zero_3x3);
+ 
+ 
+    -- Derived type with new discriminant part (which constrains parent):
+ 
+    type New_Dbl_Sq (Num : Natural) is new Double_Square(Num);
+ 
+    New_Dbl_2x2      : New_Dbl_Sq (Num => 2) := (2, Mat_2x2, Mat_2x2);
+    Expected_New_2x2 : constant New_Dbl_Sq   := (Num => 2, others => Zero_2x2);
+ 
+ 
+ 
+    -- Instantiations:
+ 
+    procedure Clr_Dbl is new CC51003_1 (Double_Square);
+    procedure Clr_New_Dbl is new CC51003_1 (New_Dbl_Sq);
+ 
+ 
+ begin
+    Report.Test ("CC51003", "Check that a formal derived record type " &
+                            "inherits components, including discriminants, " &
+                            "from its ancestor type");
+ 
+    -- Simulate use of matrix manipulation operations.
+ 
+    Clr_Dbl (Dbl_Mat_2x2);
+ 
+    if (Dbl_Mat_2x2 /= Expected_2x2) then
+       Report.Failed ("Wrong result for root type (2x2 matrix)");
+    end if;
+ 
+ 
+    Clr_Dbl (Dbl_Mat_3x3);
+ 
+    if (Dbl_Mat_3x3 /= Expected_3x3) then
+       Report.Failed ("Wrong result for root type (3x3 matrix)");
+    end if;
+ 
+ 
+    Clr_New_Dbl (New_Dbl_2x2);
+ 
+    if (New_Dbl_2x2 /= Expected_New_2x2) then
+       Report.Failed ("Wrong result for derived type (2x2 matrix)");
+    end if;
+ 
+ 
+    Report.Result;
+ 
+ end CC51003;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51004.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51004.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51004.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51004.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,181 ----
+ -- CC51004.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that if the ancestor type of a formal derived type is a composite
+ --      type that is not an array type, the formal type inherits components,
+ --      including discriminants, from the ancestor type.
+ --
+ --      Check for the case where the ancestor type is a tagged type, and the
+ --      formal derived type is declared in a generic subprogram.
+ --
+ -- TEST DESCRIPTION:
+ --      Define a discriminated tagged type in a package. Declare a
+ --      library-level generic subprogram with a formal derived type using the
+ --      tagged type as ancestor. Give the generic subprogram an in out
+ --      parameter of the formal derived type. Inside the generic, use the
+ --      discriminant component and modify the remaining components of the
+ --      tagged parameter. In the main program, declare tagged record objects
+ --      with two different discriminant values. Derive an indefinite type from
+ --      the tagged type with a new discriminant part. Instantiate the
+ --      generic subprogram for the root tagged subtype and the derived subtype.
+ --      Call the root subtype instance with actual parameters having the two
+ --      discriminant values. Also call the derived subtype instance with an
+ --      appropriate actual.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      05 Jan 94   SAIC    Removed unknown discriminant part from formal
+ --                          derived type. Moved declaration of type
+ --                          New_Dbl_Sq from main subprogram to CC51004_0.
+ --      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed constrained subtype
+ --                          instantiation and associated declarations.
+ --                          Modified commentary.
+ --
+ --!
+ 
+ -- Simulate a fragment of a matrix manipulation application.
+ 
+ package CC51004_0 is  -- Matrix types.
+ 
+    type Matrix is array (Natural range <>, Natural range <>) of Integer;
+ 
+    type Square (Side : Natural) is record
+       Mat : Matrix (1 .. Side, 1 .. Side);
+    end record;
+ 
+    type Sq_Type (Num1 : Natural) is tagged record
+       One : Square (Num1);
+    end record;
+ 
+    -- Extended type with new discriminant part (which constrains parent):
+ 
+    type New_Dbl_Sq (Num2 : Natural) is new Sq_Type(Num2) with record
+       Two : Square (Num2);
+    end record;
+ 
+ end CC51004_0;
+ 
+ 
+ -- No body for CC51004_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51004_0;  -- Matrix types.
+ generic          -- Generic matrix "clear" operation.
+    type Squares is new CC51004_0.Sq_Type with private;       -- Indefinite
+ procedure CC51004_1 (Sq : in out Squares);                   -- formal.
+ 
+ 
+      --==================================================================--
+ 
+ 
+ procedure CC51004_1 (Sq : in out Squares) is
+ begin
+    for I in 1 .. Sq.Num1 loop        -- Discriminants inherited from ancestor
+       for J in 1 .. Sq.Num1 loop     -- type (should work even for derived type
+                                      -- declaring new discriminant part).
+          Sq.One.Mat (I, J) := 0;     -- Other components inherited from
+                                      -- ancestor type.
+       end loop;
+    end loop;
+ end CC51004_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51004_0;  -- Matrix types.
+ with CC51004_1;  -- Generic double-matrix "clear" operation.
+ 
+ with Report;
+ procedure CC51004 is
+ 
+    use CC51004_0;  -- "/=" operator directly visible for Sq_Type.
+ 
+    -- Matrices of root type:
+ 
+    Mat_2x2      : Square(Side => 2)  := (Side => 2, Mat => ( (1, 2), (3, 4) ));
+    One_Mat_2x2  : Sq_Type(Num1 => 2) := (2, Mat_2x2);
+ 
+    Zero_2x2     : constant Square(2)  := (2, Mat => ( (0, 0), (0, 0) ));
+    Expected_2x2 : constant Sq_Type(2) := (Num1 => 2, One => Zero_2x2);
+ 
+ 
+    Mat_3x3      : Square(Side => 3) := (Side => 3,
+                                         Mat  => (1      => (5, 2, 7),
+                                                  others => (1      => 4,
+                                                             others => 9)));
+    One_Mat_3x3  : Sq_Type(3)        := (Num1 => 3, One => Mat_3x3);
+ 
+    Zero_3x3     : constant Square(3)        := (3, Mat => (others => (0,0,0)));
+    Expected_3x3 : constant Sq_Type(Num1 => 3) := (3, Zero_3x3);
+ 
+ 
+    New_Dbl_2x2      : New_Dbl_Sq(Num2 => 2) := (2, others => Mat_2x2);
+    Expected_New_2x2 : constant New_Dbl_Sq := (2, Zero_2x2, Mat_2x2);
+ 
+ 
+ 
+    -- Instantiations:
+ 
+    procedure Clr_Mat is new CC51004_1 (Sq_Type);
+    procedure Clr_New_Dbl is new CC51004_1 (New_Dbl_Sq);
+ 
+ 
+ begin
+    Report.Test ("CC51004", "Check that a formal derived tagged type " &
+                            "inherits components, including discriminants, " &
+                            "from its ancestor type");
+ 
+    -- Simulate use of matrix manipulation operations.
+ 
+ 
+    Clr_Mat (One_Mat_2x2);
+ 
+    if (One_Mat_2x2 /= Expected_2x2) then
+       Report.Failed ("Wrong result root type (2x2 matrix)");
+    end if;
+ 
+ 
+    Clr_Mat (One_Mat_3x3);
+ 
+    if (One_Mat_3x3 /= Expected_3x3) then
+       Report.Failed ("Wrong result root type (3x3 matrix)");
+    end if;
+ 
+ 
+    Clr_New_Dbl (New_Dbl_2x2);
+ 
+    if (New_Dbl_2x2 /= Expected_New_2x2) then
+       Report.Failed ("Wrong result extended type (2x2 matrix)");
+    end if;
+ 
+ 
+    Report.Result;
+ end CC51004;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51006.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51006.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51006.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51006.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,224 ----
+ -- CC51006.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, in an instance, each implicit declaration of a primitive
+ --      subprogram of a formal (nontagged) derived type declares a view of
+ --      the corresponding primitive subprogram of the ancestor type, even if
+ --      the subprogram has been overridden for the actual type. Check that for
+ --      a formal derived type with no discriminant part, if the ancestor
+ --      subtype is an unconstrained scalar subtype then the actual may be
+ --      either constrained or unconstrained.
+ --
+ -- TEST DESCRIPTION:
+ --      The formal derived type has no discriminant part, but the ancestor
+ --      subtype is unconstrained, making the formal type unconstrained. Since
+ --      the ancestor subtype is a scalar subtype (not an access or composite
+ --      subtype), the actual may be either constrained or unconstrained.
+ --
+ --      Declare a root type of a class as an unconstrained scalar (use floating
+ --      point). Declare a primitive subprogram of the root type. Declare a
+ --      generic package which has a formal derived type with the scalar root
+ --      type as ancestor. Inside the generic, declare an operation which calls
+ --      the ancestor type's primitive subprogram. Derive both constrained and
+ --      unconstrained types from the root type and override the primitive
+ --      subprogram for each. Declare a constrained subtype of the unconstrained
+ --      derivative. Instantiate the generic package for the derived types and
+ --      the subtype and call the "generic" operation for each one. Confirm that
+ --      in all cases the root type's implementation of the primitive
+ --      subprogram is called.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ package CC51006_0 is  -- Weight class.
+ 
+    type Weight_Type is digits 3;         -- Root type of class (unconstrained).
+ 
+    function Weight_To_String (Wt : Weight_Type) return String;
+ 
+    -- ... Other operations.
+ 
+ end CC51006_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51006_0 is
+ 
+    -- The implementations of the operations below are purely artificial; the
+    -- validity of their implementations in the context of the abstraction is
+    -- irrelevant to the feature being tested.
+ 
+    function Weight_To_String (Wt : Weight_Type) return String is
+    begin
+       if Wt > 0.0 then         -- Always true for this test.
+          return ("Root type's implementation called");
+       else
+          return ("Unexpected result                ");
+       end if;
+    end Weight_To_String;
+ 
+ end CC51006_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51006_0;  -- Weight class.
+ generic          -- Generic weight operations. 
+    type Weight is new CC51006_0.Weight_Type;
+ package CC51006_1 is
+ 
+    procedure Output_Weight (Wt : in Weight; TC_Return : out String);
+ 
+    -- ... Other operations.
+ 
+ end CC51006_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51006_1 is
+ 
+ 
+    -- The implementation of this procedure is purely artificial, and contains
+    -- an artificial parameter for testing purposes: the procedure returns the
+    -- weight string to the caller.
+ 
+    procedure Output_Weight (Wt : in Weight; TC_Return : out String) is
+    begin
+       TC_Return := Weight_To_String (Wt);   -- Should always call root type's
+    end Output_Weight;                       -- implementation.
+ 
+ 
+ end CC51006_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51006_0;       -- Weight class.
+ use  CC51006_0;
+ package CC51006_2 is  -- Extensions to weight class.
+ 
+    type Grams is new Weight_Type;                         -- Unconstrained
+                                                           -- derivative.
+ 
+    function Weight_To_String (Wt : Grams) return String;  -- Overrides root
+                                                           -- type's operation.
+ 
+    subtype Milligrams is Grams                            -- Constrained
+      range 0.0 .. 0.999;                                  -- subtype (of der.).
+ 
+    type Pounds is new Weight_Type                         -- Constrained
+      range 0.0 .. 500.0;                                  -- derivative.
+ 
+    function Weight_To_String (Wt : Pounds) return String; -- Overrides root
+                                                           -- type's operation.
+ 
+ end CC51006_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51006_2 is
+ 
+    -- The implementations of the operations below are purely artificial; the
+    -- validity of their implementations in the context of the abstraction is
+    -- irrelevant to the feature being tested.
+ 
+    function Weight_To_String (Wt : Grams) return String is
+    begin
+       return ("GRAMS: Should never be called    ");
+    end Weight_To_String;
+ 
+ 
+    function Weight_To_String (Wt : Pounds) return String is
+    begin
+       return ("POUNDS: Should never be called   ");
+    end Weight_To_String;
+ 
+ end CC51006_2;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with CC51006_1; -- Generic weight operations.
+ with CC51006_2; -- Extensions to weight class.
+ 
+ with Report;
+ procedure CC51006 is
+ 
+    package Metric_Wts_G  is new CC51006_1 (CC51006_2.Grams);      -- Unconstr.
+    package Metric_Wts_MG is new CC51006_1 (CC51006_2.Milligrams); -- Constr.
+    package US_Wts        is new CC51006_1 (CC51006_2.Pounds);     -- Constr.
+ 
+    Gms : CC51006_2.Grams      := 113.451;
+    Mgm : CC51006_2.Milligrams := 0.549;
+    Lbs : CC51006_2.Pounds     := 24.52;
+ 
+ 
+    subtype TC_Buffers is String (1 .. 33);
+ 
+    TC_Expected : constant TC_Buffers := "Root type's implementation called";
+    TC_Buffer   :          TC_Buffers;
+ 
+ begin
+    Report.Test ("CC51006", "Check that, in an instance, each implicit "  &
+                 "declaration of a primitive subprogram of a formal "     &
+                 "(nontagged) type declares a view of the corresponding " &
+                 "primitive subprogram of the ancestor type");
+ 
+ 
+    Metric_Wts_G.Output_Weight (Gms, TC_Buffer);
+ 
+    if TC_Buffer /= TC_Expected then
+       Report.Failed ("Root operation not called for unconstrained derivative");
+    end if;
+ 
+ 
+    Metric_Wts_MG.Output_Weight (Mgm, TC_Buffer);
+ 
+    if TC_Buffer /= TC_Expected then
+       Report.Failed ("Root operation not called for constrained subtype");
+    end if;
+ 
+ 
+    US_Wts.Output_Weight (Lbs, TC_Buffer);
+ 
+    if TC_Buffer /= TC_Expected then
+       Report.Failed ("Root operation not called for constrained derivative");
+    end if;
+ 
+    Report.Result;
+ end CC51006;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51007.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51007.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51007.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51007.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,305 ----
+ -- CC51007.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that a generic formal derived tagged type is a private extension.
+ --      Specifically, check that, for a generic formal derived type whose
+ --      ancestor type has abstract primitive subprograms, neither the formal
+ --      derived type nor its descendants need be abstract. Check that objects
+ --      and components of the formal derived type and its nonabstract
+ --      descendants may be declared and allocated, as may nonabstract
+ --      functions returning these types, and that aggregates of nonabstract
+ --      descendants of the formal derived type are legal. Check that calls to
+ --      the abstract primitive subprograms of the ancestor dispatch to the 
+ --      bodies corresponding to the tag of the actual parameters.
+ --
+ -- TEST DESCRIPTION:
+ --      Although the ancestor type is abstract and has abstract primitive
+ --      subprograms, these subprograms, when inherited by a formal nonabstract
+ --      derived type, are not abstract, since the formal derived type is a
+ --      nonabstract private extension.  
+ --
+ --      Thus, derivatives of the formal derived type need not be abstract,
+ --      and both the formal derived type and its derivatives are considered
+ --      nonabstract types.
+ --
+ --      This test verifies that the restrictions placed on abstract types do
+ --      not apply to the formal derived type or its derivatives. Specifically,
+ --      objects of, components of, allocators of, and nonabstract functions
+ --      returning the formal derived type or its derivatives are legal. In
+ --      addition, the test verifies that a call within the instance to a
+ --      primitive subprogram of the (abstract) ancestor type dispatches to
+ --      the body corresponding to the tag of the actual parameter.
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      23 Dec 94   SAIC    Deleted illegal extension aggregate.  Corrected
+ --                          dispatching call. Editorial changes to commentary.
+ --      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Moved instantiation of CC51007_3
+ --                          to library level.
+ --      11 Aug 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
+ --                          clauses of CC51007_1 and CC51007_4.
+ --
+ --!
+ 
+ package CC51007_0 is
+ 
+    Max_Length : constant := 10;
+    type Text is new String(1 .. Max_Length);
+ 
+    type Alert is abstract tagged record              -- Root type of class
+       Message : Text := (others => '*');             -- (abstract).
+    end record;
+ 
+    procedure Handle (A: in out Alert) is abstract;   -- Abstract dispatching
+                                                      -- operation.
+ 
+ end CC51007_0;
+ 
+ -- No body for CC51007_0;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with CC51007_0;
+ 
+ with Ada.Calendar;
+ pragma Elaborate (Ada.Calendar);
+ 
+ package CC51007_1 is
+ 
+    type Low_Alert is new CC51007_0.Alert with record
+       Time_Of_Arrival : Ada.Calendar.Time := Ada.Calendar.Time_Of (1901, 8, 1);
+    end record;
+ 
+    procedure Handle (A: in out Low_Alert);           -- Overrides parent's
+                                                      -- implementation.
+    Low : Low_Alert;
+ 
+ end CC51007_1;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body CC51007_1 is
+ 
+    procedure Handle (A: in out Low_Alert) is         -- Artificial for
+    begin                                             -- testing.
+       A.Time_Of_Arrival := Ada.Calendar.Time_Of (1984, 1, 1);
+       A.Message := "Low Alert!";
+    end Handle;
+ 
+ end CC51007_1;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with CC51007_1;
+ package CC51007_2 is
+ 
+    type Person is (OOD, CO, CinC);
+ 
+    type Medium_Alert is new CC51007_1.Low_Alert with record
+       Action_Officer : Person := OOD;
+    end record;
+ 
+    procedure Handle (A: in out Medium_Alert);        -- Overrides parent's
+                                                      -- implementation.
+    Med : Medium_Alert;
+ 
+ end CC51007_2;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with Ada.Calendar;
+ package body CC51007_2 is
+ 
+    procedure Handle (A: in out Medium_Alert) is      -- Artificial for
+    begin                                             -- testing.
+       A.Action_Officer := CO;
+       A.Time_Of_Arrival := Ada.Calendar.Time_Of (2001, 1, 1);
+       A.Message := "Med Alert!";
+    end Handle;
+ 
+ end CC51007_2;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with CC51007_0;
+ generic
+    type Alert_Type is new CC51007_0.Alert with private;
+    Initial_State : in Alert_Type;
+ package CC51007_3 is
+ 
+    function Clear_Message (A: Alert_Type)                -- Function returning
+      return Alert_Type;                                  -- formal type.
+ 
+ 
+    Max_Note : Natural := 10;
+    type Note is new String (1 .. Max_Note);
+ 
+    type Extended_Alert is new Alert_Type with record
+       Addendum : Note := (others => '*');
+    end record;
+ 
+    -- In instance, inherits version of Handle from
+    -- actual corresponding to formal type.
+ 
+    function Annotate_Alert (A: in Alert_Type'Class)      -- Function returning
+      return Extended_Alert;                              -- derived type.
+ 
+ 
+    Init_Ext_Alert : constant Extended_Alert     :=       -- Object declaration.
+      (Initial_State with Addendum => "----------");      -- Aggregate.
+ 
+ 
+    type Alert_Type_Ptr is access constant Alert_Type;
+    type Ext_Alert_Ptr  is access          Extended_Alert;
+ 
+    Init_Alert_Ptr     : Alert_Type_Ptr := 
+      new Alert_Type'(Initial_State);                        -- Allocator.
+ 
+    Init_Ext_Alert_Ptr : Ext_Alert_Ptr  :=
+      new Extended_Alert'(Init_Ext_Alert);                -- Allocator.
+ 
+ 
+    type Alert_Pair is record
+       A  : Alert_Type;                                   -- Component.
+       EA : Extended_Alert;                               -- Component.
+    end record;
+ 
+ end CC51007_3;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ package body CC51007_3 is
+ 
+    function Clear_Message (A: Alert_Type) return Alert_Type is
+       Temp : Alert_Type := A;                       -- Object declaration.
+    begin
+       Temp.Message := (others => '-');
+       return Temp;
+    end Clear_Message;
+ 
+    function Annotate_Alert (A: in Alert_Type'Class) return Extended_Alert is
+       Temp : Alert_Type'Class := A;
+    begin
+       Handle (Temp);                                -- Dispatching call to
+                                                     -- operation of ancestor.
+       return (Alert_Type(Temp) with Addendum => "No comment");
+    end Annotate_Alert;
+ 
+ end CC51007_3;
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with CC51007_1;
+ 
+ with CC51007_3;
+ pragma Elaborate (CC51007_3);
+ 
+ package CC51007_4 is new CC51007_3 (CC51007_1.Low_Alert, CC51007_1.Low);
+ 
+ 
+      --===================================================================--
+ 
+ 
+ with CC51007_1;
+ with CC51007_2;
+ with CC51007_3;
+ with CC51007_4;
+ 
+ with Ada.Calendar;
+ with Report;
+ procedure CC51007 is
+ 
+    package Alert_Support renames CC51007_4;
+ 
+    Ext : Alert_Support.Extended_Alert;
+ 
+    TC_Result       : Alert_Support.Extended_Alert;
+ 
+    TC_Low_Expected : constant Alert_Support.Extended_Alert :=
+                        (Time_Of_Arrival => Ada.Calendar.Time_Of (1984, 1, 1),
+                         Message         => "Low Alert!",
+                         Addendum        => "No comment");
+ 
+    TC_Med_Expected : constant Alert_Support.Extended_Alert :=
+                        (Time_Of_Arrival => Ada.Calendar.Time_Of (2001, 1, 1),
+                         Message         => "Med Alert!",
+                         Addendum        => "No comment");
+ 
+    TC_Ext_Expected : constant Alert_Support.Extended_Alert := TC_Low_Expected;
+ 
+ 
+    use type Alert_Support.Extended_Alert;
+ 
+ begin
+    Report.Test ("CC51007", "Check that, for a generic formal derived type "  &
+                 "whose ancestor type has abstract primitive subprograms, "   &
+                 "neither the formal derived type nor its descendants need "  &
+                 "be abstract, and that objects of, components of, "          &
+                 "allocators of, aggregates of, and nonabstract functions "   &
+                 "returning these types are legal. Check that calls to the "  &
+                 "abstract primitive subprograms of the ancestor dispatch "   &
+                 "to the bodies corresponding to the tag of the actual "      &
+                 "parameters");
+ 
+ 
+    TC_Result := Alert_Support.Annotate_Alert (CC51007_1.Low);  -- Dispatching
+                                                                -- call.
+    if TC_Result /= TC_Low_Expected then
+       Report.Failed ("Wrong results from dispatching call (Low_Alert)");
+    end if;
+ 
+ 
+    TC_Result := Alert_Support.Annotate_Alert (CC51007_2.Med);  -- Dispatching
+                                                                -- call.
+    if TC_Result /= TC_Med_Expected then
+       Report.Failed ("Wrong results from dispatching call (Medium_Alert)");
+    end if;
+ 
+ 
+    TC_Result := Alert_Support.Annotate_Alert (Ext);   -- Results in dispatching
+                                                       -- call.
+    if TC_Result /= TC_Ext_Expected then
+       Report.Failed ("Wrong results from dispatching call (Extended_Alert)");
+    end if;
+ 
+ 
+    Report.Result;
+ end CC51007;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51008.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51008.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51008.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51008.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,124 ----
+ -- CC51008.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+ --     rights in the software and documentation contained herein. Unlimited
+ --     rights are the same as those granted by the U.S. Government for older
+ --     parts of the Ada Conformity Assessment Test Suite, and are defined
+ --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+ --     intends to confer upon all recipients unlimited rights equal to those
+ --     held by the ACAA. These rights include rights to use, duplicate,
+ --     release or disclose the released technical data and computer software
+ --     in whole or in part, in any manner and for any purpose whatsoever, and
+ --     to have or permit others to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --    Check that operations are inherited for a formal derived type whose
+ --    ancestor is also a formal type as described in the corrigendum.
+ --    (Defect Report 8652/0038, as reflected in Technical Corrigendum 1,
+ --    RM95 12.5.1(21/1)).
+ --
+ -- CHANGE HISTORY:
+ --    29 Jan 2001   PHL   Initial version.
+ --    30 Apr 2002   RLB   Readied for release.
+ --
+ --!
+ package CC51008_0 is
+ 
+     type R0 is
+ 	record
+ 	    C : Float;
+ 	end record;
+ 
+     procedure S (X : R0);
+ 
+ end CC51008_0;
+ 
+ with Report;
+ use Report;
+ package body CC51008_0 is
+     procedure S (X : R0) is
+     begin
+ 	Comment ("CC51008_0.S called");
+     end S;
+ end CC51008_0;
+ 
+ with CC51008_0;
+ generic
+     type F1 is new CC51008_0.R0;
+     type F2 is new F1;
+ package CC51008_1 is
+     procedure G (O1 : F1; O2 : F2);
+ end CC51008_1;
+ 
+ package body CC51008_1 is
+     procedure G (O1 : F1; O2 : F2) is
+     begin
+ 	S (O1);
+ 	S (O2);
+     end G;
+ end CC51008_1;
+ 
+ with CC51008_0;
+ package CC51008_2 is
+     type R2 is new CC51008_0.R0;
+     procedure S (X : out R2);
+ end CC51008_2;
+ 
+ with Report;
+ use Report;
+ package body CC51008_2 is
+     procedure S (X : out R2) is
+     begin
+ 	Failed ("CC51008_2.S called");
+     end S;
+ end CC51008_2;
+ 
+ with CC51008_2;
+ package CC51008_3 is
+     type R3 is new CC51008_2.R2;
+     procedure S (X : R3);
+ end CC51008_3;
+ 
+ with Report;
+ use Report;
+ package body CC51008_3 is
+     procedure S (X : R3) is
+     begin
+ 	Failed ("CC51008_3.S called");
+     end S;
+ end CC51008_3;
+ 
+ with CC51008_1;
+ with CC51008_2;
+ with CC51008_3;
+ with Report;
+ use Report;
+ procedure CC51008 is
+ 
+     package Inst is new CC51008_1 (CC51008_2.R2,
+ 				   CC51008_3.R3);
+ 
+     X2 : constant CC51008_2.R2 := (C => 2.0);
+     X3 : constant CC51008_3.R3 := (C => 3.0);
+ 
+ begin
+     Test ("CC51008",
+ 	  "Check that operations are inherited for a formal derived " &
+ 	     "type whose ancestor is also a formal type as described in " &
+ 	     "RM95 12.5.1(21/1)");
+     Inst.G (X2, X3);
+     Result;
+ end CC51008;
+ 
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51a01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51a01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51a01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51a01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,193 ----
+ -- CC51A01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, in an instance, each implicit declaration of a user-defined
+ --      subprogram of a formal derived record type declares a view of the
+ --      corresponding primitive subprogram of the ancestor, even if the
+ --      primitive subprogram has been overridden for the actual type.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a "fraction" type abstraction in a package (foundation code).
+ --      Declare a "fraction" I/O routine in a generic package with a formal
+ --      derived type whose ancestor type is the fraction type declared in
+ --      the first package. Within the I/O routine, call other operations of
+ --      ancestor type. Derive from the root fraction type in another package
+ --      and override one of the operations called in the generic I/O routine.
+ --      Derive from the derivative of the root fraction type. Instantiate
+ --      the generic package for each of the three types and call the I/O
+ --      routine.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FC51A00.A
+ --         CC51A01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with FC51A00;         -- Fraction type abstraction.
+ generic               -- Fraction I/O support.
+    type Fraction is new FC51A00.Fraction_Type;     -- Formal derived type of a
+ package CC51A01_0 is                               -- (private) record type.
+ 
+    -- Simulate writing a fraction to standard output. In a real application,
+    -- this subprogram might be a procedure which uses Text_IO routines. For
+    -- the purposes of the test, the "output" is returned to the caller as a
+    -- string.
+    function Put (Item : in Fraction) return String;
+ 
+    -- ... Other I/O operations for fractions.
+ 
+ end CC51A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51A01_0 is
+ 
+    function Put (Item : in Fraction) return String is
+       Num : constant String :=              -- Fraction's primitive subprograms
+         Integer'Image (Numerator (Item));   -- are inherited from its parent
+       Den : constant String :=              -- (FC51A00.Fraction_Type) and NOT
+         Integer'Image (Denominator (Item)); -- from the actual type.
+    begin
+       return (Num & '/' & Den);
+    end Put;
+ 
+ end CC51A01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC51A00;         -- Fraction type abstraction.
+ package CC51A01_1 is
+ 
+    -- Derive directly from the root type of the class and override one of the
+    -- primitive subprograms.
+ 
+    type Pos_Fraction is new FC51A00.Fraction_Type;     -- Derived directly from
+                                                        -- root type of class.
+    -- Inherits "/" from root type.
+    -- Inherits "-" from root type.
+    -- Inherits Numerator from root type.
+    -- Inherits Denominator from root type.
+ 
+    -- Return absolute value of numerator as integer.
+    function Numerator (Frac : Pos_Fraction)            -- Overrides parent's
+      return Integer;                                   -- operation.
+ 
+ end CC51A01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51A01_1 is
+ 
+    -- This body should never be called.
+    --
+    -- The test sends the function Numerator a fraction with a negative
+    -- numerator, and expects this negative numerator to be returned. This
+    -- version of the function returns the absolute value of the numerator.
+    -- Thus, a call to this version is detectable by examining the sign
+    -- of the return value.
+ 
+    function Numerator (Frac : Pos_Fraction) return Integer is
+       Converted_Frac : FC51A00.Fraction_Type := FC51A00.Fraction_Type (Frac);
+       Orig_Numerator : Integer := FC51A00.Numerator (Converted_Frac);
+    begin
+       return abs (Orig_Numerator);
+    end Numerator;
+ 
+ end CC51A01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC51A00;     -- Fraction type abstraction.
+ with CC51A01_0;   -- Fraction I/O support.
+ with CC51A01_1;   -- Positive fraction type abstraction.
+ 
+ with Report;
+ procedure CC51A01 is
+ 
+    type Distance is new CC51A01_1.Pos_Fraction;    -- Derived indirectly from
+                                                    -- root type of class.
+    -- Inherits "/" indirectly from root type.
+    -- Inherits "-" indirectly from root type.
+    -- Inherits Numerator directly from parent type.
+    -- Inherits Denominator indirectly from root type.
+ 
+    use FC51A00, CC51A01_1;                         -- All primitive subprograms
+                                                    -- directly visible.
+ 
+    package Fraction_IO     is new CC51A01_0 (Fraction_Type);
+    package Pos_Fraction_IO is new CC51A01_0 (Pos_Fraction);
+    package Distance_IO     is new CC51A01_0 (Distance);
+ 
+    -- For each of the instances above, the subprogram "Put" should produce
+    -- the same result. That is, the primitive subprograms called by Put
+    -- should in all cases be those of the type Fraction_Type, which is the
+    -- ancestor type for the formal derived type in the generic unit. In
+    -- particular, for Pos_Fraction_IO and Distance_IO, the versions of
+    -- Numerator called should NOT be those of the actual types, which override
+    -- Fraction_Type's version.
+ 
+    TC_Expected_Result : constant String := "-3/ 16";
+ 
+    TC_Root_Type_Of_Class  : Fraction_Type := -3/16;
+    TC_Direct_Derivative   : Pos_Fraction  := -3/16;
+    TC_Indirect_Derivative : Distance      := -3/16;
+ 
+ begin
+    Report.Test ("CC51A01", "Check that, in an instance, each implicit "     &
+                 "declaration of a user-defined subprogram of a formal "     &
+                 "derived record type declares a view of the corresponding " &
+                 "primitive subprogram of the ancestor, even if the "        &
+                 "primitive subprogram has been overridden for the actual "  &
+                 "type");
+ 
+    if (Fraction_IO.Put (TC_Root_Type_Of_Class) /= TC_Expected_Result) then
+       Report.Failed ("Wrong result for root type");
+    end if;
+ 
+    if (Pos_Fraction_IO.Put (TC_Direct_Derivative) /= TC_Expected_Result) then
+       Report.Failed ("Wrong result for direct derivative");
+    end if;
+ 
+    if (Distance_IO.Put (TC_Indirect_Derivative) /= TC_Expected_Result) then
+       Report.Failed ("Wrong result for INdirect derivative");
+    end if;
+ 
+    Report.Result;
+ end CC51A01;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51b03.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51b03.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51b03.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51b03.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,258 ----
+ -- CC51B03.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that the attribute S'Definite, where S is an indefinite formal
+ --      private or derived type, returns true if the actual corresponding to
+ --      S is definite, and returns false otherwise.
+ --
+ -- TEST DESCRIPTION:
+ --      A definite subtype is any subtype which is not indefinite. An
+ --      indefinite subtype is either:
+ --         a) An unconstrained array subtype.
+ --         b) A subtype with unknown discriminants (this includes class-wide
+ --            types).
+ --         c) A subtype with unconstrained discriminants without defaults.
+ --
+ --      The possible forms of indefinite formal subtype are as follows:
+ --
+ --         Formal derived types:
+ --          X - Ancestor is an unconstrained array type
+ --          * - Ancestor is a discriminated record type without defaults
+ --          X - Ancestor is a discriminated tagged type
+ --          * - Ancestor type has unknown discriminants
+ --            - Formal type has an unknown discriminant part
+ --          * - Formal type has a known discriminant part
+ --
+ --         Formal private types:
+ --            - Formal type has an unknown discriminant part
+ --          * - Formal type has a known discriminant part
+ --
+ --      The formal subtypes preceded by an 'X' above are not covered, because
+ --      other rules prevent a definite subtype from being passed as an actual.
+ --      The formal subtypes preceded by an '*' above are not covered, because
+ --      'Definite is less likely to be used for these formals.
+ --
+ --      The following kinds of actuals are passed to various of the formal
+ --      types listed above:
+ --
+ --            - Undiscriminated type
+ --            - Type with defaulted discriminants
+ --            - Type with undefaulted discriminants
+ --            - Class-wide type
+ --
+ --      A typical usage of S'Definite might be algorithm selection in a
+ --      generic I/O package, e.g., the use of fixed-length or variable-length
+ --      records depending on whether the actual is definite or indefinite.
+ --      In such situations, S'Definite would appear in if conditions or other
+ --      contexts requiring a boolean expression. This test checks S'Definite
+ --      in such usage contexts but, for brevity, omits any surrounding
+ --      usage code.
+ --      
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FC51B00.A
+ --      -> CC51B03.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --
+ --!
+ 
+ with FC51B00;  -- Indefinite subtype declarations.
+ package CC51B03_0 is
+ 
+    --
+    -- Formal private type cases:
+    --
+ 
+    generic
+       type Formal (<>) is private;              -- Formal has unknown
+    package PrivateFormalUnknownDiscriminants is -- discriminant part.
+       function Is_Definite return Boolean;
+    end PrivateFormalUnknownDiscriminants;
+ 
+ 
+    --
+    -- Formal derived type cases:
+    --
+ 
+    generic
+       type Formal (<>) is new FC51B00.Vector    -- Formal has an unknown disc.
+         with private;                           -- part; ancestor is tagged.
+    package TaggedAncestorUnknownDiscriminants is
+       function Is_Definite return Boolean;
+    end TaggedAncestorUnknownDiscriminants;
+ 
+ 
+ end CC51B03_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51B03_0 is
+ 
+    package body PrivateFormalUnknownDiscriminants is
+       function Is_Definite return Boolean is
+       begin
+          if Formal'Definite then                -- Attribute used in "if"
+             -- ...Execute algorithm #1...       -- condition inside subprogram.
+             return True;
+          else
+             -- ...Execute algorithm #2...
+             return False;
+          end if;
+       end Is_Definite;
+    end PrivateFormalUnknownDiscriminants;
+ 
+ 
+    package body TaggedAncestorUnknownDiscriminants is
+       function Is_Definite return Boolean is
+       begin
+          return Formal'Definite;                -- Attribute used in return
+       end Is_Definite;                          -- statement inside subprogram.
+    end TaggedAncestorUnknownDiscriminants;
+ 
+ 
+ end CC51B03_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC51B00;
+ package CC51B03_1 is
+ 
+    subtype Spin_Type is Natural range 0 .. 3;
+ 
+    type Extended_Vector (Spin : Spin_Type) is   -- Tagged type with
+      new FC51B00.Vector with null record;       -- discriminant (indefinite).
+       
+ 
+ end CC51B03_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC51B00;   -- Indefinite subtype declarations.
+ with CC51B03_0; -- Generic package declarations.
+ with CC51B03_1;
+ 
+ with Report;
+ procedure CC51B03 is
+ 
+    --
+    -- Instances for formal private type with unknown discriminants:
+    --
+ 
+    package PrivateFormal_UndiscriminatedTaggedActual is new
+      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector);
+ 
+    package PrivateFormal_ClassWideActual is new
+      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector'Class);
+ 
+    package PrivateFormal_DiscriminatedTaggedActual is new
+      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square_Pair);
+ 
+    package PrivateFormal_DiscriminatedUndefaultedRecordActual is new
+      CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square);
+ 
+ 
+    subtype Length is Natural range 0 .. 20;
+    type Message (Len : Length := 0) is record   -- Record type with defaulted
+       Text : String (1 .. Len);                 -- discriminant (definite).
+    end record;
+       
+    package PrivateFormal_DiscriminatedDefaultedRecordActual is new
+      CC51B03_0.PrivateFormalUnknownDiscriminants (Message);
+ 
+ 
+    --
+    -- Instances for formal derived tagged type with unknown discriminants:
+    --
+ 
+    package DerivedFormal_UndiscriminatedTaggedActual is new
+      CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector);
+ 
+    package DerivedFormal_ClassWideActual is new
+      CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector'Class);
+ 
+    package DerivedFormal_DiscriminatedTaggedActual is new
+      CC51B03_0.TaggedAncestorUnknownDiscriminants (CC51B03_1.Extended_Vector);
+ 
+ 
+ begin
+    Report.Test ("CC51B03", "Check that S'Definite returns true if the " &
+                 "actual corresponding to S is definite, and false otherwise");
+ 
+ 
+    if not PrivateFormal_UndiscriminatedTaggedActual.Is_Definite then
+       Report.Failed ("Formal private/unknown discriminants: wrong " &
+                      "result for undiscriminated tagged actual");
+    end if;  
+ 
+    if PrivateFormal_ClassWideActual.Is_Definite then
+       Report.Failed ("Formal private/unknown discriminants: wrong " &
+                      "result for class-wide actual");
+    end if;  
+ 
+    if PrivateFormal_DiscriminatedTaggedActual.Is_Definite then
+       Report.Failed ("Formal private/unknown discriminants: wrong " &
+                      "result for discriminated tagged actual");
+    end if;  
+ 
+    if PrivateFormal_DiscriminatedUndefaultedRecordActual.Is_Definite then
+       Report.Failed ("Formal private/unknown discriminants: wrong result " &
+                      "for record actual with undefaulted discriminants");
+    end if;  
+ 
+    if not PrivateFormal_DiscriminatedDefaultedRecordActual.Is_Definite then
+       Report.Failed ("Formal private/unknown discriminants: wrong result " &
+                      "for record actual with defaulted discriminants");
+    end if;  
+ 
+ 
+    if not DerivedFormal_UndiscriminatedTaggedActual.Is_Definite then
+       Report.Failed ("Formal derived/unknown discriminants: wrong result " &
+                      "for undiscriminated tagged actual");
+    end if;  
+ 
+    if DerivedFormal_ClassWideActual.Is_Definite then
+       Report.Failed ("Formal derived/unknown discriminants: wrong result " &
+                      "for class-wide actual");
+    end if;  
+ 
+    if DerivedFormal_DiscriminatedTaggedActual.Is_Definite then
+       Report.Failed ("Formal derived/unknown discriminants: wrong result " &
+                      "for discriminated tagged actual");
+    end if;  
+ 
+ 
+    Report.Result;
+ end CC51B03;
diff -Nrcpad gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51d01.a gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51d01.a
*** gcc-16-20250518/gcc/testsuite/ada/acats-2/tests/cc/cc51d01.a	Thu Jan  1 00:00:00 1970
--- gcc-16-20250525/gcc/testsuite/ada/acats-2/tests/cc/cc51d01.a	Sun May 25 22:32:07 2025
***************
*** 0 ****
--- 1,262 ----
+ -- CC51D01.A
+ --
+ --                             Grant of Unlimited Rights
+ --
+ --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+ --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+ --     unlimited rights in the software and documentation contained herein.
+ --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+ --     this public release, the Government intends to confer upon all 
+ --     recipients unlimited rights  equal to those held by the Government.  
+ --     These rights include rights to use, duplicate, release or disclose the 
+ --     released technical data and computer software in whole or in part, in 
+ --     any manner and for any purpose whatsoever, and to have or permit others 
+ --     to do so.
+ --
+ --                                    DISCLAIMER
+ --
+ --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+ --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+ --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+ --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+ --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+ --     PARTICULAR PURPOSE OF SAID MATERIAL.
+ --*
+ --
+ -- OBJECTIVE:
+ --      Check that, in an instance, each implicit declaration of a user-defined
+ --      subprogram of a formal private extension declares a view of the
+ --      corresponding primitive subprogram of the ancestor, and that if the
+ --      tag in a call is statically determined to be that of the formal type,
+ --      the body executed will be that corresponding to the actual type.
+ --
+ --      Check subprograms declared within a generic formal package. Check for
+ --      the case where the actual type passed to the formal private extension
+ --      is a specific tagged type. Check for several types in the same class.
+ --
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a list abstraction in a generic package which manages lists of
+ --      elements of any nonlimited type (foundation code). Declare a package
+ --      which declares a tagged type and a type derived from it. Declare an
+ --      operation for the root tagged type and override it for the derived
+ --      type. Derive a type from this derived type, but do not override the
+ --      operation. Declare a generic subprogram which operates on lists of
+ --      elements of tagged types. Provide the generic subprogram with two
+ --      formal parameters: (1) a formal derived tagged type which represents a
+ --      list element type, and (2) a generic formal package with the list
+ --      abstraction package as template. Use the formal derived type as the
+ --      generic formal actual part for the formal package. Within the generic
+ --      subprogram, call the operation of the root tagged type. In the main
+ --      program, instantiate the generic list package and the generic
+ --      subprogram with the root tagged type and each derivative, then call
+ --      each instance with an object of the appropriate type.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         FC51D00.A
+ --      -> CC51D01.A
+ --
+ --
+ -- CHANGE HISTORY:
+ --      06 Dec 94   SAIC    ACVC 2.0
+ --      04 Jan 95   SAIC    Moved declaration of type Ranked_ID_Type from
+ --                          main subprogram to package CC51D01_0. Removed
+ --                          case passing class-wide actual to instance.
+ --                          Updated test description and modified comments.
+ --
+ --!
+ 
+ package CC51D01_0 is -- This package simulates support for a personnel
+                      -- database.
+ 
+    type SSN_Type is new String (1 .. 9);
+ 
+    type Blind_ID_Type is tagged record                   -- Root type of
+       SSN : SSN_Type;                                    -- class.
+       -- ... Other components.
+    end record;
+ 
+    procedure Update_ID (Item : in out Blind_ID_Type);    -- Parent operation.
+ 
+    -- ... Other operations.
+ 
+ 
+    type Name_Type is new String (1 .. 9);
+ 
+    type Named_ID_Type is new Blind_ID_Type with record   -- Direct derivative
+       Name : Name_Type := "Doe      ";                   -- of root type.
+       -- ... Other components.
+    end record;
+ 
+    -- Inherits Update_ID from parent.
+ 
+    procedure Update_ID (Item : in out Named_ID_Type);    -- Overrides parent's
+                                                          -- implementation.
+ 
+ 
+    type Ranked_ID_Type is new Named_ID_Type with record
+       Level : Integer := 0;                              -- Indirect derivative
+       -- ... Other components.                           -- of root type.
+    end record;
+ 
+    -- Inherits Update_ID from parent.
+ 
+ end CC51D01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ package body CC51D01_0 is
+ 
+    -- The implementations of Update_ID are purely artificial; the validity of
+    -- their implementations in the context of the abstraction is irrelevant to
+    -- the feature being tested.
+ 
+    procedure Update_ID (Item : in out Blind_ID_Type) is
+    begin
+       Item.SSN := "111223333";
+    end Update_ID;
+ 
+ 
+    procedure Update_ID (Item : in out Named_ID_Type) is
+    begin
+       Item.SSN := "444556666";
+       -- ... Other stuff.
+    end Update_ID;
+ 
+ end CC51D01_0;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ --                           --
+ -- Formal package used here. --
+ --                           --
+ 
+ with FC51D00;    -- Generic list abstraction.
+ with CC51D01_0;  -- Tagged type declarations.
+ generic          -- This procedure simulates a generic operation for types
+                  -- in the class rooted at Blind_ID_Type.
+    type Elem_Type is new CC51D01_0.Blind_ID_Type with private;
+    with package List_Mgr is new FC51D00 (Elem_Type);
+ procedure CC51D01_1 (L : in out List_Mgr.List_Type; E : in Elem_Type);
+ 
+ 
+      --==================================================================--
+ 
+ 
+ -- The implementation of CC51D01_1 is purely artificial; the validity
+ -- of its implementation in the context of the abstraction is irrelevant
+ -- to the feature being tested.
+ --
+ -- The expected behavior here is as follows: for each actual type corresponding
+ -- to Elem_Type, the call to Update_ID should invoke the actual type's
+ -- implementation, which updates the object's SSN field. Write_Element then
+ -- adds the object to the list.
+ 
+ procedure CC51D01_1 (L : in out List_Mgr.List_Type; E : in Elem_Type) is
+    Element : Elem_Type := E;   -- Can't update IN parameter.
+ begin
+    Update_ID (Element);                    -- Executes actual type's version.
+    List_Mgr.Write_Element (1, L, Element); -- Executes actual type's version.
+ end CC51D01_1;
+ 
+ 
+      --==================================================================--
+ 
+ 
+ with FC51D00;    -- Generic list abstraction.
+ with CC51D01_0;  -- Tagged type declarations.
+ with CC51D01_1;  -- Generic operation.
+ 
+ with Report;
+ procedure CC51D01 is
+ 
+    use CC51D01_0;                                        -- All types & ops
+                                                          -- directly visible.
+ 
+    -- Begin test code declarations: --